pax_global_header00006660000000000000000000000064130345426300014512gustar00rootroot0000000000000052 comment=f468686c09996f77ccfa98c30ba98f8db2c8cfd9 hol-light/000077500000000000000000000000001303454263000127455ustar00rootroot00000000000000hol-light/100/000077500000000000000000000000001303454263000132455ustar00rootroot00000000000000hol-light/100/arithmetic.ml000066400000000000000000000012061303454263000157270ustar00rootroot00000000000000(* ========================================================================= *) (* Sum of an arithmetic series. *) (* ========================================================================= *) let ARITHMETIC_PROGRESSION_LEMMA = prove (`!n. nsum(0..n) (\i. a + d * i) = ((n + 1) * (2 * a + n * d)) DIV 2`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let ARITHMETIC_PROGRESSION = prove (`!n. 1 <= n ==> nsum(0..n-1) (\i. a + d * i) = (n * (2 * a + (n - 1) * d)) DIV 2`, INDUCT_TAC THEN REWRITE_TAC[ARITHMETIC_PROGRESSION_LEMMA; SUC_SUB1] THEN ARITH_TAC);; hol-light/100/arithmetic_geometric_mean.ml000066400000000000000000000112201303454263000207620ustar00rootroot00000000000000(* ========================================================================= *) (* Arithmetic-geometric mean inequality. *) (* ========================================================================= *) needs "Library/products.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* There's already one proof of this in "Library/agm.ml". This one is from *) (* an article by Michael Hirschhorn, Math. Intelligencer vol. 29, p7. *) (* ------------------------------------------------------------------------- *) let LEMMA_1 = prove (`!x n. x pow (n + 1) - (&n + &1) * x + &n = (x - &1) pow 2 * sum(1..n) (\k. &k * x pow (n - k))`, CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ADD_CLAUSES] THENL [REAL_ARITH_TAC; REWRITE_TAC[ARITH_RULE `1 <= SUC n`]] THEN SIMP_TAC[ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; SUB_REFL] THEN REWRITE_TAC[real_pow; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `k * x * x pow n = (k * x pow n) * x`] THEN ASM_REWRITE_TAC[SUM_RMUL; REAL_MUL_ASSOC; REAL_ADD_LDISTRIB] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_POW_ADD] THEN REAL_ARITH_TAC);; let LEMMA_2 = prove (`!n x. &0 <= x ==> &0 <= x pow (n + 1) - (&n + &1) * x + &n`, REPEAT STRIP_TAC THEN REWRITE_TAC[LEMMA_1] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE]);; let LEMMA_3 = prove (`!n x. 1 <= n /\ (!i. 1 <= i /\ i <= n + 1 ==> &0 <= x i) ==> x(n + 1) * (sum(1..n) x / &n) pow n <= (sum(1..n+1) x / (&n + &1)) pow (n + 1)`, REPEAT STRIP_TAC THEN ABBREV_TAC `a = sum(1..n+1) x / (&n + &1)` THEN ABBREV_TAC `b = sum(1..n) x / &n` THEN SUBGOAL_THEN `x(n + 1) = (&n + &1) * a - &n * b` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; LE_1; REAL_ARITH `~(&n + &1 = &0)`] THEN SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; SUM_SING_NUMSEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN (CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE_NUMSEG; REAL_ARITH_TAC]) THEN ASM_SIMP_TAC[ARITH_RULE `p <= n ==> p <= n + 1`]; ALL_TAC] THEN ASM_CASES_TAC `b = &0` THEN ASM_SIMP_TAC[REAL_POW_ZERO; LE_1; REAL_MUL_RZERO; REAL_POW_LE] THEN MP_TAC(ISPECL [`n:num`; `a / b`] LEMMA_2) THEN ASM_SIMP_TAC[REAL_LE_DIV] THEN REWRITE_TAC[REAL_ARITH `&0 <= x - a + b <=> a - b <= x`; REAL_POW_DIV] THEN SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_ADD] THEN UNDISCH_TAC `~(b = &0)` THEN CONV_TAC REAL_FIELD);; let AGM = prove (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) ==> product(1..n) a <= (sum(1..n) a / &n) pow n`, INDUCT_TAC THEN REWRITE_TAC[ARITH; PRODUCT_CLAUSES_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN X_GEN_TAC `x:num->real` THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH; SUM_SING_NUMSEG] THEN REAL_ARITH_TAC; REWRITE_TAC[ADD1] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x(n + 1) * (sum(1..n) x / &n) pow n` THEN ASM_SIMP_TAC[LEMMA_3; GSYM REAL_OF_NUM_ADD; LE_1; ARITH_RULE `i <= n ==> i <= n + 1`] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LE_REFL; LE_1; ARITH_RULE `i <= n ==> i <= n + 1`]]);; (* ------------------------------------------------------------------------- *) (* Finally, reformulate in the usual way using roots. *) (* ------------------------------------------------------------------------- *) needs "Library/transc.ml";; let AGM_ROOT = prove (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) ==> root n (product(1..n) a) <= sum(1..n) a / &n`, INDUCT_TAC THEN REWRITE_TAC[ARITH; ARITH_RULE `1 <= SUC n`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `root(SUC n) ((sum(1..SUC n) a / &(SUC n)) pow (SUC n))` THEN CONJ_TAC THENL [MATCH_MP_TAC ROOT_MONO_LE THEN ASM_SIMP_TAC[AGM; ARITH_RULE `1 <= SUC n`] THEN MATCH_MP_TAC PRODUCT_POS_LE THEN ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC POW_ROOT_POS THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; SUM_POS_LE_NUMSEG]]);; hol-light/100/ballot.ml000066400000000000000000000366421303454263000150670ustar00rootroot00000000000000(* ========================================================================= *) (* 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`, REWRITE_TAC[all_countings; CARD_NUMSEG_RESTRICT_EXTREMA; GSYM IN_NUMSEG; LET_DEF; LET_END_DEF; ADD_CLAUSES; VOTE_NOT_EQ] THEN REWRITE_TAC[FUNSPACE_FIXED; IN_INSERT] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH_SUC]);; 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);; hol-light/100/bernoulli.ml000066400000000000000000000276411303454263000156040ustar00rootroot00000000000000(* ========================================================================= *) (* Bernoulli numbers and polynomials; sum of kth powers. *) (* ========================================================================= *) needs "Library/binomial.ml";; needs "Library/analysis.ml";; needs "Library/transc.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* A couple of basic lemmas about new-style sums. *) (* ------------------------------------------------------------------------- *) let SUM_DIFFS = prove (`!a m n. m <= n + 1 ==> sum(m..n) (\i. a(i + 1) - a(i)) = a(n + 1) - a(m)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG] THENL [REWRITE_TAC[ARITH_RULE `m <= 0 + 1 <=> m = 0 \/ m = 1`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ARITH; ADD_CLAUSES; REAL_SUB_REFL]; SIMP_TAC[ARITH_RULE `m <= SUC n + 1 <=> m <= n + 1 \/ m = SUC n + 1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[ADD1] THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_SUB_REFL; ARITH_RULE `~((n + 1) + 1 <= n + 1)`] THEN MATCH_MP_TAC SUM_TRIV_NUMSEG THEN ARITH_TAC]);; let DIFF_SUM = prove (`!f f' a b. (!k. a <= k /\ k <= b ==> ((\x. f x k) diffl f'(k)) x) ==> ((\x. sum(a..b) (f x)) diffl (sum(a..b) f')) x`, REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH; DIFF_CONST; SUM_TRIV_NUMSEG; ARITH_RULE `~(a <= SUC b) ==> b < a`] THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_ADD THEN ASM_SIMP_TAC[LE_REFL; ARITH_RULE `k <= b ==> k <= SUC b`]);; (* ------------------------------------------------------------------------- *) (* Bernoulli numbers. *) (* ------------------------------------------------------------------------- *) let bernoulli = define `(bernoulli 0 = &1) /\ (!n. bernoulli(SUC n) = --sum(0..n) (\j. &(binom(n + 2,j)) * bernoulli j) / (&n + &2))`;; (* ------------------------------------------------------------------------- *) (* A slightly tidier-looking form of the recurrence. *) (* ------------------------------------------------------------------------- *) let BERNOULLI = prove (`!n. sum(0..n) (\j. &(binom(n + 1,j)) * bernoulli j) = if n = 0 then &1 else &0`, INDUCT_TAC THEN REWRITE_TAC[bernoulli; SUM_CLAUSES_NUMSEG; GSYM ADD1; ADD_CLAUSES; binom; REAL_MUL_LID; LE_0; NOT_SUC] THEN SIMP_TAC[BINOM_LT; ARITH_RULE `n < SUC n`; BINOM_REFL; REAL_ADD_LID] THEN REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN MATCH_MP_TAC(REAL_FIELD `x = &n + &2 ==> s + x * --s / (&n + &2) = &0`) THEN REWRITE_TAC[ADD1; BINOM_TOP_STEP_REAL; ARITH_RULE `~(n = n + 1)`] THEN REWRITE_TAC[BINOM_REFL] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Bernoulli polynomials. *) (* ------------------------------------------------------------------------- *) let bernpoly = new_definition `bernpoly n x = sum(0..n) (\k. &(binom(n,k)) * bernoulli k * x pow (n - k))`;; (* ------------------------------------------------------------------------- *) (* The key derivative recurrence. *) (* ------------------------------------------------------------------------- *) let DIFF_BERNPOLY = prove (`!n x. ((bernpoly (SUC n)) diffl (&(SUC n) * bernpoly n x)) x`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[bernpoly; SUM_CLAUSES_NUMSEG; LE_0] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[SUB_REFL; real_pow; DIFF_CONST] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC DIFF_SUM THEN REPEAT STRIP_TAC THEN REWRITE_TAC[ADD1; BINOM_TOP_STEP_REAL] THEN DIFF_TAC THEN ASM_SIMP_TAC[ARITH_RULE `k <= n ==> ~(k = n + 1)`] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN ASM_SIMP_TAC[ARITH_RULE `k <= n ==> (n + 1) - k - 1 = n - k`] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; ARITH_RULE `k <= n ==> k <= n + 1`] THEN UNDISCH_TAC `k <= n:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_LE] THEN ABBREV_TAC `z = x pow (n - k)` THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Hence the key stepping recurrence. *) (* ------------------------------------------------------------------------- *) let INTEGRALS_EQ = prove (`!f g. (!x. ((\x. f(x) - g(x)) diffl &0) x) /\ f(&0) = g(&0) ==> !x. f(x) = g(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x:real. f(x) - g(x)`; `x:real`; `&0`] DIFF_ISCONST_ALL) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let RECURRENCE_BERNPOLY = prove (`!n x. bernpoly n (x + &1) - bernpoly n x = &n * x pow (n - 1)`, INDUCT_TAC THENL [REWRITE_TAC[bernpoly; SUM_SING_NUMSEG; REAL_SUB_REFL; SUB_REFL; real_pow; REAL_MUL_LZERO]; ALL_TAC] THEN MATCH_MP_TAC INTEGRALS_EQ THEN CONJ_TAC THENL [X_GEN_TAC `x:real` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN DISCH_THEN(MP_TAC o AP_TERM `(*) (&(SUC n))`) THEN REWRITE_TAC[REAL_MUL_RZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REPEAT(MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC) THEN SIMP_TAC[SUC_SUB1; DIFF_CMUL; DIFF_POW; DIFF_BERNPOLY; ETA_AX] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC DIFF_CHAIN THEN REWRITE_TAC[DIFF_BERNPOLY] THEN DIFF_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[bernpoly; GSYM SUM_SUB_NUMSEG] THEN REWRITE_TAC[REAL_ADD_LID; REAL_POW_ONE; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; SUB_REFL; real_pow] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN SIMP_TAC[ARITH_RULE `i <= n ==> SUC n - i = SUC(n - i)`] THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_MUL_RID] THEN REWRITE_TAC[BERNOULLI; ADD1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH; real_pow; REAL_MUL_LID] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[ADD_SUB]);; (* ------------------------------------------------------------------------- *) (* Hence we get the main result. *) (* ------------------------------------------------------------------------- *) let SUM_OF_POWERS = prove (`!n. sum(0..n) (\k. &k pow m) = (bernpoly(SUC m) (&n + &1) - bernpoly(SUC m) (&0)) / (&m + &1)`, GEN_TAC THEN ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(0..n) (\i. bernpoly (SUC m) (&(i + 1)) - bernpoly (SUC m) (&i))` THEN CONJ_TAC THENL [REWRITE_TAC[RECURRENCE_BERNPOLY; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; SUC_SUB1]; SIMP_TAC[SUM_DIFFS; LE_0] THEN REWRITE_TAC[REAL_OF_NUM_ADD]]);; (* ------------------------------------------------------------------------- *) (* Now explicit computations of the various terms on specific instances. *) (* ------------------------------------------------------------------------- *) let SUM_CONV = let pth = prove (`sum(0..0) f = f 0 /\ sum(0..SUC n) f = sum(0..n) f + f(SUC n)`, SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0]) in let econv_0 = GEN_REWRITE_CONV I [CONJUNCT1 pth] and econv_1 = GEN_REWRITE_CONV I [CONJUNCT2 pth] in let rec sconv tm = (econv_0 ORELSEC (LAND_CONV(RAND_CONV num_CONV) THENC econv_1 THENC COMB2_CONV (RAND_CONV sconv) (RAND_CONV NUM_SUC_CONV))) tm in sconv;; let BINOM_CONV = let pth = prove (`a * b * x = FACT c ==> x = (FACT c) DIV (a * b)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN ARITH_TAC; POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[LT_NZ; MULT_ASSOC; MULT_CLAUSES] THEN MESON_TAC[LT_NZ; FACT_LT]]) in let match_pth = MATCH_MP pth and binom_tm = `binom` in fun tm -> let bop,lr = dest_comb tm in if bop <> binom_tm then failwith "BINOM_CONV" else let l,r = dest_pair lr in let n = dest_numeral l and k = dest_numeral r in if n let op,n = dest_comb tm in if op <> b_tm || not(is_numeral n) then failwith "BERNOULLI_CONV" else hd(BERNOULLIS(dest_small_numeral n));; let BERNPOLY_CONV = let conv_1 = REWR_CONV bernpoly THENC SUM_CONV THENC TOP_DEPTH_CONV BETA_CONV THENC NUM_REDUCE_CONV and conv_3 = ONCE_DEPTH_CONV BINOM_CONV THENC REAL_POLY_CONV in fun tm -> let n = dest_small_numeral(lhand tm) in let conv_2 = GEN_REWRITE_CONV ONCE_DEPTH_CONV (BERNOULLIS n) in (conv_1 THENC conv_2 THENC conv_3) tm;; let SOP_CONV = let pth = prove (`sum(0..n) (\k. &k pow m) = (\p. (p(&n + &1) - p(&0)) / (&m + &1)) (\x. bernpoly (SUC m) x)`, REWRITE_TAC[SUM_OF_POWERS]) in let conv_0 = REWR_CONV pth in REWR_CONV pth THENC RAND_CONV(ABS_CONV(LAND_CONV NUM_SUC_CONV THENC BERNPOLY_CONV)) THENC TOP_DEPTH_CONV BETA_CONV THENC REAL_POLY_CONV;; let SOP_NUM_CONV = let pth = prove (`sum(0..n) (\k. &k pow p) = &m ==> nsum(0..n) (\k. k EXP p) = m`, REWRITE_TAC[REAL_OF_NUM_POW; GSYM REAL_OF_NUM_SUM_NUMSEG; REAL_OF_NUM_EQ]) in let rule_1 = PART_MATCH (lhs o rand) pth in fun tm -> let th1 = rule_1 tm in let th2 = SOP_CONV(lhs(lhand(concl th1))) in MATCH_MP th1 th2;; (* ------------------------------------------------------------------------- *) (* The example Bernoulli bragged about. *) (* ------------------------------------------------------------------------- *) time SOP_NUM_CONV `nsum(0..1000) (\k. k EXP 10)`;; (* ------------------------------------------------------------------------- *) (* The general formulas for moderate powers. *) (* ------------------------------------------------------------------------- *) time SOP_CONV `sum(0..n) (\k. &k pow 0)`;; time SOP_CONV `sum(0..n) (\k. &k pow 1)`;; time SOP_CONV `sum(0..n) (\k. &k pow 2)`;; time SOP_CONV `sum(0..n) (\k. &k pow 3)`;; time SOP_CONV `sum(0..n) (\k. &k pow 4)`;; time SOP_CONV `sum(0..n) (\k. &k pow 5)`;; time SOP_CONV `sum(0..n) (\k. &k pow 6)`;; time SOP_CONV `sum(0..n) (\k. &k pow 7)`;; time SOP_CONV `sum(0..n) (\k. &k pow 8)`;; time SOP_CONV `sum(0..n) (\k. &k pow 9)`;; time SOP_CONV `sum(0..n) (\k. &k pow 10)`;; time SOP_CONV `sum(0..n) (\k. &k pow 11)`;; time SOP_CONV `sum(0..n) (\k. &k pow 12)`;; time SOP_CONV `sum(0..n) (\k. &k pow 13)`;; time SOP_CONV `sum(0..n) (\k. &k pow 14)`;; time SOP_CONV `sum(0..n) (\k. &k pow 15)`;; time SOP_CONV `sum(0..n) (\k. &k pow 16)`;; time SOP_CONV `sum(0..n) (\k. &k pow 17)`;; time SOP_CONV `sum(0..n) (\k. &k pow 18)`;; time SOP_CONV `sum(0..n) (\k. &k pow 19)`;; time SOP_CONV `sum(0..n) (\k. &k pow 20)`;; time SOP_CONV `sum(0..n) (\k. &k pow 21)`;; hol-light/100/bertrand.ml000066400000000000000000004036121303454263000154060ustar00rootroot00000000000000(* ========================================================================= *) (* Proof of Bertrand conjecture and weak form of prime number theorem. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/pocklington.ml";; needs "Library/analysis.ml";; needs "Library/transc.ml";; needs "Library/calc_real.ml";; needs "Library/floor.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* A ridiculous ommission from the OCaml Num library. *) (* ------------------------------------------------------------------------- *) let num_of_float = let p22 = Pervasives.( ** ) 2.0 22.0 and p44 = Pervasives.( ** ) 2.0 44.0 and p66 = Pervasives.( ** ) 2.0 66.0 and q22 = pow2 22 and q44 = pow2 44 and q66 = pow2 66 in fun x -> let y0,n = frexp x in let u0 = int_of_float(y0 *. p22) in let y1 = p22 *. y0 -. float_of_int u0 in let u1 = int_of_float(y1 *. p22) in let y2 = p22 *. y1 -. float_of_int u1 in let u2 = int_of_float(y2 *. p22) in let y3 = p22 *. y2 -. float_of_int u2 in if y3 <> 0.0 then failwith "num_of_float: inexactness!" else (Int u0 // q22 +/ Int u1 // q44 +/ Int u2 // q66) */ pow2 n;; (* ------------------------------------------------------------------------- *) (* Integer truncated square root *) (* ------------------------------------------------------------------------- *) let ISQRT = new_definition `ISQRT n = @m. m EXP 2 <= n /\ n < (m + 1) EXP 2`;; let ISQRT_WORKS = prove (`!n. ISQRT(n) EXP 2 <= n /\ n < (ISQRT(n) + 1) EXP 2`, GEN_TAC THEN REWRITE_TAC[ISQRT] THEN CONV_TAC SELECT_CONV THEN SUBGOAL_THEN `(?m. m EXP 2 <= n) /\ (?a. !m. m EXP 2 <= n ==> m <= a)` MP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[num_MAX] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[ARITH_RULE `~(m + 1 <= m)`; NOT_LE]] THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[ARITH; LE_0]; ALL_TAC] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN MESON_TAC[LE_SQUARE_REFL; EXP_2; LE_TRANS]);; let ISQRT_0 = prove (`ISQRT 0 = 0`, MP_TAC(SPEC `0` ISQRT_WORKS) THEN SIMP_TAC[ARITH_RULE `x <= 0 <=> (x = 0)`; EXP_EQ_0; ARITH_EQ]);; let ISQRT_UNIQUE = prove (`!m n. (ISQRT n = m) <=> m EXP 2 <= n /\ n < (m + 1) EXP 2`, REPEAT GEN_TAC THEN EQ_TAC THEN MP_TAC (SPEC `n:num` ISQRT_WORKS) THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(ISQRT n) EXP 2 < (m + 1) EXP 2 /\ m EXP 2 < (ISQRT n + 1) EXP 2` MP_TAC THENL [ASM_MESON_TAC[LT_SUC_LE; LE_SUC_LT; LET_TRANS; LTE_TRANS]; SIMP_TAC[num_CONV `2`; EXP_MONO_LT_SUC; GSYM LE_ANTISYM] THEN ARITH_TAC]);; let ISQRT_SUC = prove (`!n. ISQRT(SUC n) = if ?m. SUC n = m EXP 2 then SUC(ISQRT n) else ISQRT n`, GEN_TAC THEN REWRITE_TAC[ISQRT_UNIQUE] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[ISQRT_WORKS; ARITH_RULE `a <= n /\ n < b /\ ~(SUC n = a) /\ ~(SUC n = b) ==> a <= SUC n /\ SUC n < b`]] THEN CONJ_TAC THENL [ALL_TAC; MP_TAC(CONJUNCT2(SPEC `n:num` ISQRT_WORKS)) THEN REWRITE_TAC[EXP_2; GSYM ADD1; MULT_CLAUSES; ADD_CLAUSES; LT_SUC] THEN ARITH_TAC] THEN POP_ASSUM(X_CHOOSE_TAC `m:num`) THEN SUBGOAL_THEN `m = SUC(ISQRT n)` SUBST_ALL_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[LE_REFL]] THEN SUBGOAL_THEN `ISQRT(n) EXP 2 < m EXP 2 /\ m EXP 2 <= SUC(ISQRT n) EXP 2` MP_TAC THENL [ALL_TAC; REWRITE_TAC[num_CONV `2`; EXP_MONO_LE_SUC; EXP_MONO_LT_SUC] THEN ARITH_TAC] THEN MP_TAC(SPEC `n:num` ISQRT_WORKS) THEN REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[LT_SUC_LE; LE_SUC_LT]);; (* ------------------------------------------------------------------------- *) (* To allow us to deal with ln(2) numerically using standard conversion. *) (* ------------------------------------------------------------------------- *) let LN_2_COMPOSITION = prove (`ln(&2) = &7 * ln(&1 + inv(&8)) - &2 * ln(&1 + inv(&24)) - &4 * ln(&1 + inv(&80))`, CONV_TAC(GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4 [GSYM LN_POW; GSYM LN_MUL; GSYM LN_DIV; REAL_POW_LT; real_div; REAL_LT_ADD; REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; ARITH]) THEN AP_TERM_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Automatically process any ln(n) to allow us to use standard conversions. *) (* ------------------------------------------------------------------------- *) let LN_N_CONV = let pth = prove (`x = (&1 + inv(&8)) pow n * (x / (&1 + inv(&8)) pow n)`, CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN MATCH_MP_TAC REAL_POW_NZ THEN CONV_TAC REAL_RAT_REDUCE_CONV) and qth = prove (`&0 < x ==> (ln((&1 + inv(&8)) pow n * x / (&1 + inv(&8)) pow n) = &n * ln(&1 + inv(&8)) + ln(&1 + (x / (&1 + inv(&8)) pow n - &1)))`, REWRITE_TAC[REAL_ARITH `&1 + (x - &1) = x`] THEN SIMP_TAC[LN_MUL; LN_POW; REAL_LT_DIV; REAL_POW_LT; REAL_RAT_REDUCE_CONV `&0 < &1 + inv(&8)`]) and ln_tm = `ln` and x_tm = `x:real` and n_tm = `n:num` in fun tm0 -> let ltm,tm = dest_comb tm0 in if ltm <> ln_tm then failwith "expected ln(ratconst)" else let x = rat_of_term tm in let rec dlog n y = let y' = y +/ y // Int 8 in if y' (ln(&2 pow n * x / &2 pow n) = &n * ln(&2) + ln(&1 + (x / &2 pow n - &1)))`, REWRITE_TAC[REAL_ARITH `&1 + (x - &1) = x`] THEN SIMP_TAC[LN_MUL; LN_POW; REAL_LT_DIV; REAL_POW_LT; REAL_RAT_REDUCE_CONV `&0 < &2`]) and ln_tm = `ln` and x_tm = `x:real` and n_tm = `n:num` in fun tm0 -> let ltm,tm = dest_comb tm0 in if ltm <> ln_tm then failwith "expected ln(ratconst)" else let x = rat_of_term tm in let rec dlog n y = let y' = y */ Int 2 in if y' &2 * floor(&n / &r) <= floor(&(2 * n + d) / &r) /\ floor(&(2 * n + d) / &r) <= &2 * floor(&n / &r) + &1`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `floor(&n / &r) = floor((&n + &d / &2) / &r)` SUBST1_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN SUBGOAL_THEN `&2 * &n + &d = &2 * (&n + &d / &2)` SUBST1_TAC THENL [SIMP_TAC[REAL_ADD_LDISTRIB; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_MUL_ASSOC; real_div] THEN REWRITE_TAC[GSYM real_div; FLOOR_DOUBLE]] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN MP_TAC(SPEC `&n / &r` FLOOR) THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n / &r` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_LE_ADDR] THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_INV_EQ]; ALL_TAC] THEN UNDISCH_TAC `&n / &r < floor (&n / &r) + &1` THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT] THEN SIMP_TAC[REAL_LT_INTEGERS; FLOOR; INTEGER_CLOSED] THEN MATCH_MP_TAC(REAL_ARITH `b < a ==> n + a <= c ==> n + b < c`) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LT; ARITH]);; (* ------------------------------------------------------------------------- *) (* Range bounds on ln(n!). *) (* ------------------------------------------------------------------------- *) let LN_FACT = prove (`!n. ln(&(FACT n)) = sum(1,n) (\d. ln(&d))`, INDUCT_TAC THEN REWRITE_TAC[FACT; sum; LN_1] THEN SIMP_TAC[GSYM REAL_OF_NUM_MUL; LN_MUL; REAL_OF_NUM_LT; FACT_LT; LT_0] THEN ASM_REWRITE_TAC[ADD1] THEN REWRITE_TAC[ADD_AC; REAL_ADD_AC]);; let LN_FACT_BOUNDS = prove (`!n. ~(n = 0) ==> abs(ln(&(FACT n)) - (&n * ln(&n) - &n)) <= &1 + ln(&n)`, SUBGOAL_THEN `!n. ~(n = 0) ==> ?z. &n < z /\ z < &(n + 1) /\ (&(n + 1) * ln(&(n + 1)) - &n * ln(&n) = ln(z) + &1)` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. x * ln(x)`; `\x. ln(x) + &1`; `&n`; `&(n + 1)`] MVT_ALT) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `(n + &1) - n = &1`] THEN REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_ARITH `a < a + &1`] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MP_TAC(SPEC `x:real` (DIFF_CONV `\x. x * ln(x)`)) THEN SIMP_TAC[REAL_MUL_LID; REAL_MUL_RID; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `k:num->real`) THEN SUBGOAL_THEN `!n. &(n + 1) * ln(&(n + 1)) = sum(1,n) (\i. ln(k i) + &1)` MP_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[sum; ADD_CLAUSES; LN_1; REAL_MUL_RZERO] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = n + 2`; ARITH_RULE `SUC(n + 1) = n + 2`] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[REAL_ARITH `(a - b = c) <=> (a = b + c)`] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ADD_AC]; ALL_TAC] THEN REWRITE_TAC[SUM_ADD] THEN CONV_TAC(LAND_CONV(BINDER_CONV(RAND_CONV(RAND_CONV(LAND_CONV (LAND_CONV num_CONV)))))) THEN REWRITE_TAC[ADD1; SUM_REINDEX; SUM_CONST] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a = b + c * &1) <=> (b = a - c)`] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. abs(sum(1,n+1) (\i. ln(&i)) - (&(n + 1) * ln (&(n + 1)) - &(n + 1))) <= &1 + ln(&(n + 1))` ASSUME_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `abs(x - (y - z)) <= a ==> abs(x - (y - (z + &1))) <= &1 + a`) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM th]) THEN SUBGOAL_THEN `sum(1,n + 1) (\i. ln (&i)) = sum(1,n) (\i. ln(&(i + 1)))` SUBST1_TAC THENL [GEN_REWRITE_TAC RAND_CONV [SUM_DIFF] THEN REWRITE_TAC[SUM_1; ADD_CLAUSES; LN_1; REAL_SUB_RZERO] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [SYM(NUM_REDUCE_CONV `0 + 1`)] THEN REWRITE_TAC[SUM_REINDEX] THEN REWRITE_TAC[ADD_AC]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_SUB] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1,n) (\n. abs(ln(&(n + 1)) - ln(k n)))` THEN REWRITE_TAC[ABS_SUM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1,n) (\i. ln(&(i + 1)) - ln(&i))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a < b /\ b < c ==> abs(c - b) <= c - a`) THEN SUBGOAL_THEN `&0 < &r /\ &r < k r /\ k r < &(r + 1)` MP_TAC THENL [ALL_TAC; MESON_TAC[LN_MONO_LT; REAL_LT_TRANS]] THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH_RULE `0 < r <=> 1 <= r`; ARITH_RULE `~(r = 0) <=> 1 <= r`]; ALL_TAC] THEN REWRITE_TAC[SUM_SUB] THEN REWRITE_TAC[GSYM(SPECL [`f:num->real`; `m:num`; `1`] SUM_REINDEX)] THEN ONCE_REWRITE_TAC[SUM_DIFF] THEN REWRITE_TAC[ARITH; SUM_2; SUM_1; LN_1; REAL_ADD_RID] THEN ONCE_REWRITE_TAC[ARITH_RULE `2 + n = SUC(1 + n)`] THEN REWRITE_TAC[sum; ADD_CLAUSES] THEN REWRITE_TAC[ADD_AC] THEN REWRITE_TAC[REAL_ARITH `(a + b) - c - (a - c) = b`; REAL_LE_REFL]; ALL_TAC] THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN ASM_REWRITE_TAC[ADD1; LN_FACT]);; (* ------------------------------------------------------------------------- *) (* Some extra number-theoretic odds and ends are useful. *) (* ------------------------------------------------------------------------- *) let primepow = new_definition `primepow q <=> ?p k. 1 <= k /\ prime p /\ (q = p EXP k)`;; let aprimedivisor = new_definition `aprimedivisor q = @p. prime p /\ p divides q`;; let PRIMEPOW_GE_2 = prove (`!q. primepow q ==> 2 <= q`, REWRITE_TAC[primepow; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q:num`; `p:num`; `k:num`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p:num` THEN ASM_SIMP_TAC[PRIME_GE_2] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN REWRITE_TAC[LE_EXP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]);; let PRIMEPOW_0 = prove (`~(primepow 0)`, MESON_TAC[NUM_REDUCE_CONV `2 <= 0`; PRIMEPOW_GE_2]);; let APRIMEDIVISOR_PRIMEPOW = prove (`!p k. prime p /\ 1 <= k ==> (aprimedivisor(p EXP k) = p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[aprimedivisor] THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN X_GEN_TAC `q:num` THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `1 <= k ==> (k = SUC(k - 1))`)) THEN REWRITE_TAC[EXP] THEN ASM_MESON_TAC[DIVIDES_REFL; DIVIDES_RMUL; PRIME_DIVEXP; PRIME_DIVPROD; prime; PRIME_1]);; let APRIMEDIVISOR = prove (`!n. ~(n = 1) ==> prime(aprimedivisor n) /\ (aprimedivisor n) divides n`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[aprimedivisor] THEN CONV_TAC SELECT_CONV THEN ASM_SIMP_TAC[PRIME_FACTOR]);; let BIG_POWER_LEMMA = prove (`!m n. 2 <= m ==> ?k. n <= m EXP k`, REPEAT STRIP_TAC THEN EXISTS_TAC `SUC n` THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP (SUC n)` THEN ASM_REWRITE_TAC[EXP_MONO_LE_SUC] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH] THEN UNDISCH_TAC `n <= 2 EXP SUC n` THEN REWRITE_TAC[EXP] THEN MP_TAC(SPECL [`2:num`; `n:num`] EXP_EQ_0) THEN REWRITE_TAC[ARITH] THEN SPEC_TAC(`2 EXP n`,`m:num`) THEN ARITH_TAC);; let PRIME_PRIMEPOW = prove (`!p. prime p ==> primepow p`, MESON_TAC[prime; primepow; LE_REFL; EXP_1]);; (* ------------------------------------------------------------------------- *) (* Derive Bezout-type identity by finding gcd. *) (* ------------------------------------------------------------------------- *) let rec bezout (m,n) = if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0) else if m <=/ n then let q = quo_num n m and r = mod_num n m in let (x,y) = bezout(m,r) in (x -/ q */ y,y) else let (x,y) = bezout(n,m) in (y,x);; (* ------------------------------------------------------------------------- *) (* Conversion for "primepow" applied to particular numeral. *) (* ------------------------------------------------------------------------- *) let PRIMEPOW_CONV = let pth0 = prove (`primepow 0 <=> F`, REWRITE_TAC[primepow] THEN MESON_TAC[EXP_EQ_0; PRIME_0]) and pth1 = prove (`primepow 1 <=> F`, REWRITE_TAC[primepow] THEN MESON_TAC[EXP_EQ_1; PRIME_1; NUM_REDUCE_CONV `1 <= 0`]) and pth2 = prove (`prime p ==> 1 <= k /\ (q = p EXP k) ==> (primepow q <=> T)`, MESON_TAC[primepow]) and pth3 = prove (`(p * x = r * y + 1) /\ ~(p = 1) /\ ~(r = 1) /\ (q = p * r * d) ==> (primepow q <=> F)`, REPEAT STRIP_TAC THEN REWRITE_TAC[primepow] THEN DISCH_THEN(X_CHOOSE_THEN `P:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(SPEC `r:num` PRIME_FACTOR) THEN MP_TAC(SPEC `p:num` PRIME_FACTOR) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `P_p:num` MP_TAC) THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d_p:num` SUBST_ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `P_r:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d_r:num` SUBST_ALL_TAC) THEN SUBGOAL_THEN `P_p divides P /\ P_r divides P` ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `k:num` THEN ASM_MESON_TAC[divides; MULT_AC]; ALL_TAC] THEN SUBGOAL_THEN `(P_p = P) /\ (P_r = P:num)` (CONJUNCTS_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN ASM_MESON_TAC[DIVIDES_ADD_REVR; divides; MULT_AC; DIVIDES_ONE; prime]) and p_tm = `p:num` and k_tm = `k:num` and q_tm = `q:num` and r_tm = `r:num` and d_tm = `d:num` and x_tm = `x:num` and y_tm = `y:num` and primepow_tm = `primepow` in fun tm0 -> let ptm,tm = dest_comb tm0 in if ptm <> primepow_tm then failwith "expected primepow(numeral)" else let q = dest_numeral tm in if q =/ Int 0 then pth0 else if q =/ Int 1 then pth1 else match factor q with [] -> failwith "internal failure in PRIMEPOW_CONV" | [p,k] -> let th1 = INST [mk_numeral q,q_tm; mk_numeral p,p_tm; mk_numeral k,k_tm] pth2 in let th2 = MP th1 (EQT_ELIM(PRIME_CONV(lhand(concl th1)))) in MP th2 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th2)))) | (p,_)::(r,_)::_ -> let d = q // (p */ r) in let (x,y) = bezout(p,r) in let p,r,x,y = if x 1 <= k /\ (q = p EXP k) ==> (aprimedivisor q = p)`, MESON_TAC[APRIMEDIVISOR_PRIMEPOW]) and p_tm = `p:num` and k_tm = `k:num` and q_tm = `q:num` and aprimedivisor_tm = `aprimedivisor` in fun tm0 -> let ptm,tm = dest_comb tm0 in if ptm <> aprimedivisor_tm then failwith "expected primepow(numeral)" else let q = dest_numeral tm in if q =/ Int 0 then failwith "APRIMEDIVISOR_CONV: not a prime power" else match factor q with [p,k] -> let th1 = INST [mk_numeral q,q_tm; mk_numeral p,p_tm; mk_numeral k,k_tm] pth in let th2 = MP th1 (EQT_ELIM(PRIME_CONV(lhand(concl th1)))) in MP th2 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th2)))) | _ -> failwith "APRIMEDIVISOR_CONV: not a prime power";; (* ------------------------------------------------------------------------- *) (* The Mangoldt function. *) (* ------------------------------------------------------------------------- *) let mangoldt = new_definition `mangoldt d = if primepow d then ln(&(aprimedivisor d)) else &0`;; let MANGOLDT_POS = prove (`!d. &0 <= mangoldt d`, GEN_TAC THEN REWRITE_TAC[mangoldt] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[APRIMEDIVISOR_PRIMEPOW; ARITH_RULE `2 <= a ==> 1 <= a`; PRIME_GE_2; LN_POS; REAL_OF_NUM_LE; primepow]);; (* ------------------------------------------------------------------------- *) (* The key lemma. *) (* ------------------------------------------------------------------------- *) let LN_PRIMEFACT = prove (`!n. ~(n = 0) ==> (ln(&n) = sum(1,n) (\d. if primepow d /\ d divides n then ln(&(aprimedivisor d)) else &0))`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 1` THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1,n) (\d. &0)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUM_0; LN_1]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PRIMEPOW_GE_2; DIVIDES_LE; NUM_REDUCE_CONV `2 <= 1`; LE_TRANS]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [divides] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[ARITH_RULE `m < p * m <=> 1 * m < p * m`] THEN SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `1 < p <=> 2 <= p`] THEN ASM_SIMP_TAC[PRIME_GE_2]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN ASM_SIMP_TAC[LN_MUL; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `?k. 1 <= k /\ (p EXP k) divides (p * m)` MP_TAC THENL [EXISTS_TAC `1` THEN SIMP_TAC[EXP_1; DIVIDES_RMUL; DIVIDES_REFL; LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?k. !j. 1 <= j /\ (p EXP j) divides (p * m) ==> j <= k` MP_TAC THENL [MP_TAC(SPECL [`p:num`; `p * m:num`] BIG_POWER_LEMMA) THEN ASM_SIMP_TAC[PRIME_GE_2] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[MULT_EQ_0] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `p EXP k` THEN ASM_REWRITE_TAC[LT_EXP] THEN ASM_SIMP_TAC[PRIME_GE_2]; ALL_TAC] THEN GEN_REWRITE_TAC I [TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN GEN_REWRITE_TAC LAND_CONV [num_MAX] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `sum (1,m) (\d. if primepow d /\ d divides m then ln (&(aprimedivisor d)) else &0) = sum (1,p * m) (\d. if primepow d /\ d divides m then ln (&(aprimedivisor d)) else &0)` SUBST1_TAC THENL [ONCE_REWRITE_TAC[SUM_DIFF] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `1 + p * m = (1 + m) + (p * m - m)` SUBST1_TAC THENL [MATCH_MP_TAC(ARITH_RULE `1 * y <= x ==> (1 + x = (1 + y) + (x - y))`) THEN SIMP_TAC[LE_MULT_RCANCEL] THEN ASM_MESON_TAC[PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 <= p`]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM SUM_TWO] THEN MATCH_MP_TAC(REAL_ARITH `(b = &0) ==> (a = a + b)`) THEN SUBGOAL_THEN `!d. d >= 1 + m ==> ((if primepow d /\ d divides m then ln (&(aprimedivisor d)) else &0) = &0)` MP_TAC THENL [X_GEN_TAC `d:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `~(1 + m <= d /\ d <= m)`]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_ZERO) THEN DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[SUM_DIFF] THEN REWRITE_TAC[SUM_1] THEN REWRITE_TAC[PRIMEPOW_0; REAL_SUB_RZERO] THEN SUBGOAL_THEN `1 + p * m = p EXP k + 1 + (p * m - p EXP k)` SUBST1_TAC THENL [MATCH_MP_TAC(ARITH_RULE `k <= p ==> (1 + p = k + 1 + (p - k))`) THEN ASM_MESON_TAC[DIVIDES_LE; MULT_EQ_0]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_TWO] THEN MATCH_MP_TAC(REAL_ARITH `(a = a') /\ (l + b = c) ==> (l + a + b = a' + c)`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN STRIP_TAC THEN ASM_CASES_TAC `primepow d` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `d divides (p * m) <=> d divides m` (fun th -> REWRITE_TAC[th]) THEN UNDISCH_TAC `primepow d` THEN REWRITE_TAC[primepow] THEN DISCH_THEN(X_CHOOSE_THEN `q:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_CASES_TAC `q = p:num` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> (a <=> b)`) THEN REWRITE_TAC[DIVIDES_LMUL] THEN MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `p EXP (k - 1)` THEN CONJ_TAC THENL [REWRITE_TAC[divides] THEN EXISTS_TAC `p EXP ((k - 1) - j)` THEN REWRITE_TAC[GSYM EXP_ADD] THEN AP_TERM_TAC THEN UNDISCH_TAC `p EXP j < p EXP k` THEN ASM_REWRITE_TAC[LT_EXP] THEN ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `p EXP k divides (p * m)` THEN FIRST_ASSUM((fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) [th]) o MATCH_MP (ARITH_RULE `1 <= k ==> (k = SUC(k - 1))`)) THEN REWRITE_TAC[divides; EXP] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EQ_TAC THEN REWRITE_TAC[DIVIDES_LMUL] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(AP_TERM `(divides) p` th)) THEN SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN DISCH_TAC THEN SUBGOAL_THEN `p divides (q EXP j) \/ p divides r` MP_TAC THENL [ASM_MESON_TAC[PRIME_DIVPROD]; ALL_TAC] THEN DISCH_THEN DISJ_CASES_TAC THENL [SUBGOAL_THEN `p divides q` MP_TAC THENL [ASM_MESON_TAC[PRIME_DIVEXP]; ALL_TAC] THEN ASM_MESON_TAC[prime; PRIME_1]; ALL_TAC] THEN UNDISCH_TAC `p * m = q EXP j * r` THEN UNDISCH_TAC `p divides r` THEN REWRITE_TAC[divides] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c:num`] THEN SIMP_TAC[EQ_MULT_LCANCEL] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN REWRITE_TAC[SUM_1] THEN REWRITE_TAC[REAL_ADD_ASSOC] THEN BINOP_TAC THENL [SUBGOAL_THEN `primepow (p EXP k)` ASSUME_TAC THENL [ASM_MESON_TAC[primepow]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~((p EXP k) divides m)` ASSUME_TAC THENL [REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN MP_TAC(ARITH_RULE `~(k + 1 <= k)`) THEN REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ARITH_RULE `1 <= k + 1`] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[EXP_ADD; EXP_1] THEN MESON_TAC[MULT_ASSOC; DIVIDES_REFL; DIVIDES_RMUL]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[APRIMEDIVISOR_PRIMEPOW]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN STRIP_TAC THEN ASM_CASES_TAC `primepow d` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `d divides (p * m) <=> d divides m` (fun th -> REWRITE_TAC[th]) THEN UNDISCH_TAC `primepow d` THEN REWRITE_TAC[primepow] THEN DISCH_THEN(X_CHOOSE_THEN `q:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `q = p:num` THENL [UNDISCH_THEN `q = p:num` SUBST_ALL_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ ~a ==> (a <=> b)`) THEN REWRITE_TAC[DIVIDES_LMUL] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a + 1 <= b ==> a < b`)) THEN REWRITE_TAC[LT_EXP] THEN ASM_SIMP_TAC[PRIME_GE_2; NOT_LT]; ALL_TAC] THEN DISCH_THEN SUBST_ALL_TAC THEN EQ_TAC THEN REWRITE_TAC[DIVIDES_LMUL] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(AP_TERM `(divides) p` th)) THEN SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN DISCH_TAC THEN SUBGOAL_THEN `p divides (q EXP j) \/ p divides r` MP_TAC THENL [ASM_MESON_TAC[PRIME_DIVPROD]; ALL_TAC] THEN DISCH_THEN DISJ_CASES_TAC THENL [SUBGOAL_THEN `p divides q` MP_TAC THENL [ASM_MESON_TAC[PRIME_DIVEXP]; ALL_TAC] THEN ASM_MESON_TAC[prime; PRIME_1]; ALL_TAC] THEN UNDISCH_TAC `p * m = q EXP j * r` THEN UNDISCH_TAC `p divides r` THEN REWRITE_TAC[divides] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c:num`] THEN SIMP_TAC[EQ_MULT_LCANCEL] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* The key expansion using the Mangoldt function. *) (* ------------------------------------------------------------------------- *) let MANGOLDT = prove (`!n. ln(&(FACT n)) = sum(1,n) (\d. mangoldt(d) * floor(&n / &d))`, GEN_TAC THEN REWRITE_TAC[LN_FACT] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1,n) (\m. sum(1,n) (\d. if primepow d /\ d divides m then ln (&(aprimedivisor d)) else &0))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LN_PRIMEFACT; ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `d < n + 1 ==> (n = d + (n - d))`)) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN REWRITE_TAC[REAL_ARITH `(a = a + b) <=> (b = &0)`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1 + d,n - d) (\k. &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `1 <= d /\ 1 + d <= r /\ (r <= d \/ (d = 0)) ==> F`]; ALL_TAC] THEN ONCE_REWRITE_TAC[SUM_SWAP] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[mangoldt] THEN ASM_CASES_TAC `primepow d` THEN ASM_REWRITE_TAC[SUM_0; REAL_MUL_LZERO] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 <= d ==> ~(d = 0)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIVISION) THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN MAP_EVERY ABBREV_TAC [`q = n DIV d`; `r = n MOD d`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN SUBGOAL_THEN `floor (&(q * d + r) / &d) = &q` SUBST1_TAC THENL [ONCE_REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN REWRITE_TAC[INTEGER_CLOSED] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < d <=> 1 <= d`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN UNDISCH_TAC `r < d:num` THEN ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN MATCH_MP_TAC(REAL_ARITH `(b = &0) /\ (a = c) ==> (a + b = c)`) THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1 + q * d,r) (\x. &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[] THEN X_GEN_TAC `s:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `d divides s` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `t:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 + x <= y * z ==> x < z * y`)) THEN ASM_SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `1 <= d ==> ~(d = 0)`] THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST_ALL_TAC) THEN UNDISCH_TAC `d * (q + SUC e) < r + 1 + q * d` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_CLAUSES; GSYM ADD_ASSOC] THEN REWRITE_TAC[ARITH_RULE `d * q + x < y + 1 + q * d <=> x <= y`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `a + b <= c ==> a <= c:num`)) THEN ASM_REWRITE_TAC[NOT_LE]; ALL_TAC] THEN ONCE_REWRITE_TAC[SUM_DIFF] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM SUM_TWO] THEN SIMP_TAC[SUM_1; DIVIDES_0; DIVIDES_LMUL; DIVIDES_REFL] THEN REWRITE_TAC[REAL_ARITH `(a + b) - b = a`] THEN REWRITE_TAC[GSYM SUM_GROUP] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(0,q) (\x. ln (&(aprimedivisor d)))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_CONST; REAL_MUL_AC]] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 <= d ==> (d = 1 + (d - 1))`)) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[GSYM SUM_SPLIT; SUM_1] THEN SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN MATCH_MP_TAC(REAL_ARITH `(b = &0) ==> (a + b = a)`) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(m * d + 1,d - 1) (\x. &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:num` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN DISCH_THEN(X_CHOOSE_THEN `t:num` SUBST_ALL_TAC) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(d divides (t + 1))` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN UNDISCH_TAC `t + m * d + 1 < d - 1 + m * d + 1` THEN REWRITE_TAC[LT_ADD_RCANCEL] THEN UNDISCH_TAC `d divides (t + m * d + 1)` THEN ASM_CASES_TAC `t = 0` THEN ASM_REWRITE_TAC[ADD_CLAUSES] THENL [ASM_MESON_TAC[DIVIDES_REFL; DIVIDES_LMUL; DIVIDES_ADD_REVR; DIVIDES_ONE; PRIMEPOW_GE_2; NUM_REDUCE_CONV `2 <= 1`]; DISCH_TAC THEN ARITH_TAC]; ALL_TAC] THEN UNDISCH_TAC `d divides (t + m * d + 1)` THEN ONCE_REWRITE_TAC[ARITH_RULE `t + m * d + 1 = (t + 1) + m * d`] THEN MESON_TAC[DIVIDES_REFL; DIVIDES_LMUL; DIVIDES_ADD_REVL]);; (* ------------------------------------------------------------------------- *) (* The Chebyshev psi function. *) (* ------------------------------------------------------------------------- *) let psi = new_definition `psi(n) = sum(1,n) (\d. mangoldt(d))`;; (* ------------------------------------------------------------------------- *) (* The key bounds on the psi function. *) (* ------------------------------------------------------------------------- *) let PSI_BOUNDS_LN_FACT = prove (`!n. ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2))) <= psi(n) /\ psi(n) - psi(n DIV 2) <= ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2)))`, X_GEN_TAC `k:num` THEN MP_TAC(SPECL [`k:num`; `2`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN MAP_EVERY ABBREV_TAC [`n = k DIV 2`; `d = k MOD 2`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN ONCE_REWRITE_TAC[MULT_SYM] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC) THEN REWRITE_TAC[psi; MANGOLDT] THEN SUBGOAL_THEN `sum (1,n) (\d. mangoldt d * floor (&n / &d)) = sum (1,2 * n + d) (\d. mangoldt d * floor (&n / &d))` SUBST1_TAC THENL [REWRITE_TAC[ARITH_RULE `2 * n + d = n + (n + d)`] THEN ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN REWRITE_TAC[REAL_ARITH `(a = a + b) <=> (b = &0)`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1 + n,n + d) (\k. &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[FLOOR_EQ_0] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 + n <= r ==> 0 < r`)) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID; REAL_OF_NUM_LT] THEN UNDISCH_TAC `1 + n <= r` THEN ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_CMUL; GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `m * f - &2 * m * f' = m * (f - &2 * f')`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[MANGOLDT_POS] THEN MATCH_MP_TAC(REAL_ARITH `&2 * a <= b /\ b <= &2 * a + &1 ==> b - &2 * a <= &1`) THEN ASM_SIMP_TAC[FLOOR_DOUBLE_NUM; ARITH_RULE `0 < r <=> 1 <= r`]; ALL_TAC] THEN SUBGOAL_THEN `sum(1,2 * n + d) (\d. mangoldt d) - sum(1,n) (\d. mangoldt d) = sum(1,2 * n + d) (\d. if d <= n then &0 else mangoldt d)` SUBST1_TAC THENL [REWRITE_TAC[ARITH_RULE `2 * n + d = n + (n + d)`] THEN ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN MATCH_MP_TAC(REAL_ARITH `(c = &0) /\ (b = d) ==> ((a + b) - a = c + d)`) THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1,n) (\k. &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[ARITH_RULE `r < n + 1 <=> r <= n`]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[ARITH_RULE `1 + n <= r ==> ~(r <= n)`]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_CMUL; GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `m * a - &2 * m * b = m * (a - &2 * b)`] THEN COND_CASES_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[MANGOLDT_POS] THEN ASM_SIMP_TAC[REAL_SUB_LE; FLOOR_DOUBLE_NUM; ARITH_RULE `0 < r <=> 1 <= r`]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `a = a * &1`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[MANGOLDT_POS] THEN MATCH_MP_TAC(REAL_ARITH `(b = &0) /\ &1 <= a ==> &1 <= a - &2 * b`) THEN CONJ_TAC THENL [REWRITE_TAC[FLOOR_EQ_0] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < r <=> 1 <= r`] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_POS] THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_REWRITE_TAC[GSYM NOT_LE]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `(a = &1) ==> &1 <= a`) THEN REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < r <=> 1 <= r`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Map the middle term into multiples of log(n). *) (* ------------------------------------------------------------------------- *) let LN_FACT_DIFF_BOUNDS = prove (`!n. abs((ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2)))) - &n * ln(&2)) <= &4 * ln(if n = 0 then &1 else &n) + &3`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_SIMP_TAC[FACT; MULT_CLAUSES; LN_1; DIV_0; ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN ASM_REWRITE_TAC[ARITH_EQ] THEN MAP_EVERY ABBREV_TAC [`q = n DIV 2`; `r = n MOD 2`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_CASES_TAC `q = 0` THENL [UNDISCH_TAC `~(q * 2 + r = 0)` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ASM_SIMP_TAC[ARITH_RULE `r < 2 ==> ((r = 0) <=> ~(r = 1))`] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[num_CONV `1`; FACT; MULT_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[LN_1] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_SUB_RZERO] THEN REWRITE_TAC[REAL_NEG_0; REAL_SUB_LZERO; REAL_ADD_LID; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_NEG] THEN MATCH_MP_TAC(REAL_ARITH `x <= &2 ==> x <= &3`) THEN SUBST1_TAC(REAL_ARITH `&2 = &1 + &1`) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 ==> abs(x) <= &1 + &1`) THEN ASM_SIMP_TAC[LN_POS; LN_LE; REAL_OF_NUM_LE; ARITH; REAL_LE_ADDL]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!a'. abs((a' - b) - c) <= d - abs(a' - a) ==> abs((a - b) - c) <= d`) THEN EXISTS_TAC `ln(&(FACT(q * 2)))` THEN MP_TAC(SPEC `q:num` LN_FACT_BOUNDS) THEN MP_TAC(SPEC `q * 2` LN_FACT_BOUNDS) THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC(REAL_ARITH `abs(a - (a2 - &2 * a1)) <= b - &2 * b1 - b2 ==> abs(l2 - a2) <= b2 ==> abs(l1 - a1) <= b1 ==> abs((l2 - &2 * l1) - a) <= b`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN ASM_SIMP_TAC[LN_MUL; REAL_OF_NUM_LT; ARITH; ARITH_RULE `0 < q <=> ~(q = 0)`] THEN REWRITE_TAC[REAL_ARITH `(q * &2 + r) * l2 - ((q * &2) * (lq + l2) - q * &2 - &2 * (q * lq - q)) = r * l2`] THEN ONCE_REWRITE_TAC[REAL_ARITH `x <= a - b - c - d <=> x + b <= a - c - d`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `ln(&2) + ln(&q * &2 + &r)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 * y ==> abs(x) <= y`) THEN SIMP_TAC[LN_POS_LT; REAL_LT_IMP_LE; REAL_LE_RMUL_EQ; REAL_LE_MUL; REAL_POS; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `r < 2` THEN ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (ARITH_RULE `r < 2 ==> (r = 0) \/ (r = 1)`)) THENL [REWRITE_TAC[ADD_CLAUSES; REAL_SUB_REFL; REAL_ADD_RID; REAL_ABS_NUM] THEN MATCH_MP_TAC LN_POS THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_MUL] THEN UNDISCH_TAC `~(q = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN SIMP_TAC[GSYM REAL_OF_NUM_MUL; LN_MUL; REAL_OF_NUM_LT; FACT_LT; LT_0] THEN REWRITE_TAC[REAL_ARITH `abs(b - (a + b)) = abs a`] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(x) <= x`) THEN MATCH_MP_TAC LN_POS THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `l2 + lnn <= (&4 * lnn + &3) - a - b <=> a + b + l2 <= &3 * lnn + &3`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&3 * ln(&q * &2) + &3` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH] THEN ASM_SIMP_TAC[LN_MONO_LE; REAL_POS; REAL_OF_NUM_LT; ARITH_RULE `0 < q <=> ~(q = 0)`; REAL_ARITH `&0 < q /\ &0 <= r ==> &0 < q * &2 + r`; REAL_ARITH `&0 < q ==> &0 < q * &2`] THEN REWRITE_TAC[REAL_LE_ADDR; REAL_POS]] THEN ASM_SIMP_TAC[LN_MUL; REAL_OF_NUM_LT; ARITH; ARITH_RULE `0 < q <=> ~(q = 0)`] THEN SUBGOAL_THEN `&0 <= ln(&2)` (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN MATCH_MP_TAC LN_POS THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH]);; (* ------------------------------------------------------------------------- *) (* Hence overall bounds in terms of n * log(2) + constant. *) (* ------------------------------------------------------------------------- *) let PSI_BOUNDS_INDUCT = prove (`!n. &n * ln(&2) - (&4 * ln (if n = 0 then &1 else &n) + &3) <= psi(n) /\ psi(n) - psi(n DIV 2) <= &n * ln(&2) + (&4 * ln (if n = 0 then &1 else &n) + &3)`, MESON_TAC[PSI_BOUNDS_LN_FACT; LN_FACT_DIFF_BOUNDS; REAL_ARITH `m <= a /\ b <= m /\ abs(m - n) <= k ==> n - k <= a /\ b <= n + k`]);; (* ------------------------------------------------------------------------- *) (* Evaluation of mangoldt(numeral). *) (* ------------------------------------------------------------------------- *) let MANGOLDT_CONV = GEN_REWRITE_CONV I [mangoldt] THENC RATOR_CONV(LAND_CONV PRIMEPOW_CONV) THENC GEN_REWRITE_CONV I [COND_CLAUSES] THENC TRY_CONV(funpow 2 RAND_CONV APRIMEDIVISOR_CONV);; (* ------------------------------------------------------------------------- *) (* More efficient version without two primality tests. *) (* ------------------------------------------------------------------------- *) let MANGOLDT_CONV = let pth0 = prove (`mangoldt 0 = ln(&1)`, REWRITE_TAC[mangoldt; primepow; LN_1] THEN COND_CASES_TAC THEN ASM_MESON_TAC[EXP_EQ_0; PRIME_0]) and pth1 = prove (`mangoldt 1 = ln(&1)`, REWRITE_TAC[mangoldt; primepow; LN_1] THEN COND_CASES_TAC THEN ASM_MESON_TAC[EXP_EQ_1; PRIME_1; NUM_REDUCE_CONV `1 <= 0`]) and pth2 = prove (`prime p ==> 1 <= k /\ (q = p EXP k) ==> (mangoldt q = ln(&p))`, SIMP_TAC[mangoldt; APRIMEDIVISOR_PRIMEPOW] THEN COND_CASES_TAC THEN ASM_MESON_TAC[primepow]) and pth3 = prove (`(p * x = r * y + 1) /\ ~(p = 1) /\ ~(r = 1) /\ (q = p * r * d) ==> (mangoldt q = ln(&1))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(primepow q)` (fun th -> REWRITE_TAC[LN_1; th; mangoldt]) THEN REWRITE_TAC[primepow] THEN DISCH_THEN(X_CHOOSE_THEN `P:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(SPEC `r:num` PRIME_FACTOR) THEN MP_TAC(SPEC `p:num` PRIME_FACTOR) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `P_p:num` MP_TAC) THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d_p:num` SUBST_ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `P_r:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d_r:num` SUBST_ALL_TAC) THEN SUBGOAL_THEN `P_p divides P /\ P_r divides P` ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `k:num` THEN ASM_MESON_TAC[divides; MULT_AC]; ALL_TAC] THEN SUBGOAL_THEN `(P_p = P) /\ (P_r = P:num)` (CONJUNCTS_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN ASM_MESON_TAC[DIVIDES_ADD_REVR; divides; MULT_AC; DIVIDES_ONE; prime]) and p_tm = `p:num` and k_tm = `k:num` and q_tm = `q:num` and r_tm = `r:num` and d_tm = `d:num` and x_tm = `x:num` and y_tm = `y:num` and mangoldt_tm = `mangoldt` in fun tm0 -> let ptm,tm = dest_comb tm0 in if ptm <> mangoldt_tm then failwith "expected mangoldt(numeral)" else let q = dest_numeral tm in if q =/ Int 0 then pth0 else if q =/ Int 1 then pth1 else match factor q with [] -> failwith "internal failure in MANGOLDT_CONV" | [p,k] -> let th1 = INST [mk_numeral q,q_tm; mk_numeral p,p_tm; mk_numeral k,k_tm] pth2 in let th2 = MP th1 (EQT_ELIM(PRIME_CONV(lhand(concl th1)))) in MP th2 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th2)))) | (p,_)::(r,_)::_ -> let d = q // (p */ r) in let (x,y) = bezout(p,r) in let p,r,x,y = if x psi(n) <= &133 / &128 * &n`, let lemma = prove (`a <= b /\ l <= a /\ rest ==> l <= a /\ l <= b /\ rest`, MESON_TAC[REAL_LE_TRANS]) and tac = time (CONV_TAC(LAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in REWRITE_TAC[ARITH_RULE `n <= 128 <=> n < 129`] THEN CONV_TAC EXPAND_CASES_CONV THEN REWRITE_TAC(PSI_LIST_300) THEN REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT ((MATCH_MP_TAC lemma THEN CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) ORELSE (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) ORELSE tac));; (* ------------------------------------------------------------------------- *) (* As a multiple of log(2) is often more useful. *) (* ------------------------------------------------------------------------- *) let PSI_UBOUND_128_LOG = prove (`!n. n <= 128 ==> psi(n) <= (&3 / &2 * ln(&2)) * &n`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PSI_UBOUND_128) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV THENC REALCALC_REL_CONV));; (* ------------------------------------------------------------------------- *) (* Useful "overpowering" lemma. *) (* ------------------------------------------------------------------------- *) let OVERPOWER_LEMMA = prove (`!f g d a. f(a) <= g(a) /\ (!x. a <= x ==> ((\x. g(x) - f(x)) diffl (d(x)))(x)) /\ (!x. a <= x ==> &0 <= d(x)) ==> !x. a <= x ==> f(x) <= g(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x:real. g(x) - f(x)`; `d:real->real`; `a:real`; `x:real`] MVT_ALT) THEN UNDISCH_TAC `a <= x` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `x:real = a` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `fa <= ga /\ &0 <= d ==> (gx - fx - (ga - fa) = d) ==> fx <= gx`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Repeatedly extend range of explicit cases using recurrence. *) (* ------------------------------------------------------------------------- *) let DOUBLE_CASES_RULE th = let bod = snd(dest_forall(concl th)) in let ant,cons = dest_imp bod in let m = dest_numeral (rand ant) and c = rat_of_term (lhand(lhand(rand cons))) in let x = float_of_num(m +/ Int 1) in let d = (4.0 *. log x +. 3.0) /. (x *. log 2.0) in let c' = c // Int 2 +/ Int 1 +/ (floor_num(num_of_float(1024.0 *. d)) +/ Int 2) // Int 1024 in let c'' = max_num c c' in let tm = mk_forall (`n:num`, subst [mk_numeral(Int 2 */ m),rand ant; term_of_rat c'',lhand(lhand(rand cons))] bod) in prove(tm, REPEAT STRIP_TAC THEN ASM_CASES_TAC (mk_comb(`(<=) (n:num)`,mk_numeral m)) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP th) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC LN_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MP_TAC(SPEC `n:num` PSI_BOUNDS_INDUCT) THEN SUBGOAL_THEN `~(n = 0)` (fun th -> REWRITE_TAC[th]) THENL [FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `pn2 <= ((a - &1) * l2) * n - logtm ==> u <= v /\ pn - pn2 <= n * l2 + logtm ==> pn <= (a * l2) * n`) THEN MP_TAC(SPEC `n DIV 2` th) THEN ANTS_TAC THENL [ASM_SIMP_TAC[LE_LDIV_EQ; ARITH] THEN FIRST_ASSUM(UNDISCH_TAC o check ((not) o is_neg) o concl) THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN W(fun (asl,w) -> MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC(mk_comb(rator(lhand w),`&n / &2`))) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC LN_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_div] THEN MATCH_MP_TAC(REAL_ARITH `logtm <= ((c - a * b) * l2) * n ==> (a * l2) * n * b <= (c * l2) * n - logtm`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBST1_TAC(REAL_ARITH `&n = &1 + (&n - &1)`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n <= b) ==> b + 1 <= n`)) THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_OF_NUM_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a <= n ==> a - &1 <= n - &1`)) THEN ABBREV_TAC `x = &n - &1` THEN CONV_TAC(LAND_CONV NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) THEN SPEC_TAC(`x:real`,`x:real`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC OVERPOWER_LEMMA THEN W(fun (asl,w) -> let th = DIFF_CONV (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in MP_TAC th) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID; REAL_MUL_LID] THEN W(fun (asl,w) -> let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in DISCH_TAC THEN EXISTS_TAC tm) THEN CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_sub] THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN REWRITE_TAC[] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= x ==> inv(&1 + x) <= inv(&1 + a) /\ inv(&1 + a) <= b ==> inv(&1 + x) <= b`)) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV);; (* ------------------------------------------------------------------------- *) (* Bring it to the self-sustaining point. *) (* ------------------------------------------------------------------------- *) let PSI_UBOUND_1024_LOG = funpow 3 DOUBLE_CASES_RULE PSI_UBOUND_128_LOG;; (* ------------------------------------------------------------------------- *) (* A generic proof of the same kind that we're self-sustaining. *) (* ------------------------------------------------------------------------- *) let PSI_BOUNDS_SUSTAINED_INDUCT = prove (`&4 * ln(&1 + &2 pow j) + &3 <= (d * ln(&2)) * (&1 + &2 pow j) /\ &4 / (&1 + &2 pow j) <= d * ln(&2) /\ &0 <= c /\ c / &2 + d + &1 <= c ==> !k. j <= k /\ (!n. n <= 2 EXP k ==> psi(n) <= (c * ln(&2)) * &n) ==> !n. n <= 2 EXP (SUC k) ==> psi(n) <= (c * ln(&2)) * &n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n <= 2 EXP k` THEN ASM_SIMP_TAC[] THEN MP_TAC(SPEC `n:num` PSI_BOUNDS_INDUCT) THEN SUBGOAL_THEN `~(n = 0)` (fun th -> REWRITE_TAC[th]) THENL [MATCH_MP_TAC(ARITH_RULE `!a. ~(a = 0) /\ ~(n <= a) ==> ~(n = 0)`) THEN EXISTS_TAC `2 EXP k` THEN ASM_REWRITE_TAC[EXP_EQ_0; ARITH_EQ]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `pn2 <= ((a - &1) * l2) * n - logtm ==> u <= v /\ pn - pn2 <= n * l2 + logtm ==> pn <= (a * l2) * n`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 2`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[LE_LDIV_EQ; ARITH] THEN MATCH_MP_TAC(ARITH_RULE `n <= 2 * k ==> n < 2 * (k + 1)`) THEN ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN W(fun (asl,w) -> MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC(mk_comb(rator(lhand w),`&n / &2`))) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LN_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_div] THEN MATCH_MP_TAC(REAL_ARITH `logtm <= ((c - a * b) * l2) * n ==> (a * l2) * n * b <= (c * l2) * n - logtm`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d * ln (&2)) * &n` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[LN_POS; REAL_OF_NUM_LE; ARITH] THEN REWRITE_TAC[GSYM real_div] THEN ASM_REWRITE_TAC[REAL_ARITH `d <= c - &1 - c2 <=> c2 + d + &1 <= c`]] THEN SUBST1_TAC(REAL_ARITH `&n = &1 + (&n - &1)`) THEN SUBGOAL_THEN `&2 pow j <= &n - &1` MP_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow k` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n <= b) ==> b + 1 <= n`)) THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_OF_NUM_LE] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `x = &n - &1` THEN SPEC_TAC(`x:real`,`x:real`) THEN MATCH_MP_TAC OVERPOWER_LEMMA THEN W(fun (asl,w) -> let th = DIFF_CONV (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in MP_TAC th) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID; REAL_MUL_LID] THEN W(fun (asl,w) -> let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in DISCH_TAC THEN EXISTS_TAC tm) THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN REWRITE_TAC[] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REAL_ARITH `&0 < a ==> a <= x ==> &0 < &1 + x`) THEN SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= x ==> inv(&1 + x) <= inv(&1 + a) /\ inv(&1 + a) <= b ==> inv(&1 + x) <= b`)) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LE_LADD] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_ARITH `&0 < x ==> &0 < &1 + x`]; ALL_TAC] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN ASM_REWRITE_TAC[GSYM real_div]);; let PSI_BOUNDS_SUSTAINED = prove (`(!n. n <= 2 EXP k ==> psi(n) <= (c * ln(&2)) * &n) ==> &4 * ln(&1 + &2 pow k) + &3 <= ((c / &2 - &1) * ln(&2)) * (&1 + &2 pow k) /\ &4 / (&1 + &2 pow k) <= (c / &2 - &1) * ln(&2) /\ &0 <= c ==> !n. psi(n) <= (c * ln(&2)) * &n`, let lemma = prove (`c / &2 + (c / &2 - &1) + &1 <= c`, REWRITE_TAC[REAL_ARITH `c2 + (c2 - &1) + &1 = &2 * c2`] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ; REAL_LE_REFL]) in REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o C CONJ lemma) THEN ABBREV_TAC `d = c / &2 - &1` THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP PSI_BOUNDS_SUSTAINED_INDUCT) THEN X_GEN_TAC `m:num` THEN SUBGOAL_THEN `?j. m <= 2 EXP j` MP_TAC THENL [EXISTS_TAC `m:num` THEN SPEC_TAC(`m:num`,`m:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[EXP] THEN MATCH_MP_TAC(ARITH_RULE `~(a = 0) /\ m <= a ==> SUC m <= 2 * a`) THEN ASM_REWRITE_TAC[EXP_EQ_0; ARITH_EQ]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`m:num`,`m:num`) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP 0` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[LE_EXP; ARITH_EQ; LE_0]; ALL_TAC] THEN ASM_CASES_TAC `k <= j:num` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `2 EXP (SUC j) <= 2 EXP k` (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN ASM_REWRITE_TAC[LE_EXP; ARITH] THEN UNDISCH_TAC `~(k <= j:num)` THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Now apply it and get our reasonable bound. *) (* ------------------------------------------------------------------------- *) let PSI_UBOUND_LOG = prove (`!n. psi(n) <= (&4407 / &2048 * ln (&2)) * &n`, MP_TAC PSI_UBOUND_1024_LOG THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 EXP 10`)) THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP PSI_BOUNDS_SUSTAINED) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONJ_TAC THEN CONV_TAC REALCALC_REL_CONV);; let PSI_UBOUND_3_2 = prove (`!n. psi(n) <= &3 / &2 * &n`, GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&4407 / &2048 * ln (&2)) * &n` THEN REWRITE_TAC[PSI_UBOUND_LOG] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV);; (* ------------------------------------------------------------------------- *) (* Now get a lower bound. *) (* ------------------------------------------------------------------------- *) let PSI_LBOUND_3_5 = prove (`!n. 4 <= n ==> &3 / &5 * &n <= psi(n)`, let lemma = prove (`a <= b /\ b <= l /\ rest ==> a <= l /\ b <= l /\ rest`, MESON_TAC[REAL_LE_TRANS]) and tac = time (CONV_TAC(RAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in GEN_TAC THEN ASM_CASES_TAC `n < 300` THENL [POP_ASSUM MP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN REWRITE_TAC(PSI_LIST_300) THEN REWRITE_TAC[LN_1; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT ((MATCH_MP_TAC lemma THEN CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) ORELSE (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) ORELSE tac); ALL_TAC] THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(CONJUNCT1 (SPEC `n:num` PSI_BOUNDS_INDUCT)) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b <= x ==> a <= x`) THEN ASM_SIMP_TAC[ARITH_RULE `~(n < 300) ==> ~(n = 0)`] THEN MATCH_MP_TAC(REAL_ARITH `c <= n * (b - a) ==> a * n <= n * b - c`) THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &11 * &n` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[real_sub] THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV] THEN ABBREV_TAC `x = &n - &1` THEN SUBGOAL_THEN `&n = &1 + x` SUBST1_TAC THENL [EXPAND_TAC "x" THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&299 <= x` MP_TAC THENL [EXPAND_TAC "x" THEN REWRITE_TAC[REAL_LE_SUB_LADD] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; ARITH] THEN UNDISCH_TAC `~(n < 300)` THEN ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`x:real`,`x:real`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC OVERPOWER_LEMMA THEN W(fun (asl,w) -> let th = DIFF_CONV (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in MP_TAC th) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID; REAL_MUL_LID] THEN W(fun (asl,w) -> let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in DISCH_TAC THEN EXISTS_TAC tm) THEN CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN REWRITE_TAC[] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN REAL_ARITH_TAC; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1 + &299)` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; (* ========================================================================= *) (* Now the related theta function. *) (* ========================================================================= *) let theta = new_definition `theta(n) = sum(1,n) (\p. if prime p then ln(&p) else &0)`;; (* ------------------------------------------------------------------------- *) (* An optimized rule to give theta(n) for all n <= some N. *) (* ------------------------------------------------------------------------- *) let THETA_LIST = let THETA_0 = prove (`theta(0) = ln(&1)`, REWRITE_TAC[theta; sum; LN_1]) and THETA_SUC = prove (`theta(SUC n) = theta(n) + (if prime(SUC n) then ln(&(SUC n)) else &0)`, REWRITE_TAC[theta; sum; ADD1] THEN REWRITE_TAC[ADD_AC]) and n_tm = `n:num` and SIMPER_CONV = NUM_REDUCE_CONV THENC ONCE_DEPTH_CONV PRIME_CONV THENC GEN_REWRITE_CONV TOP_DEPTH_CONV [COND_CLAUSES; REAL_ADD_LID; REAL_ADD_RID] THENC SIMP_CONV [GSYM LN_MUL; REAL_OF_NUM_MUL; REAL_OF_NUM_LT; ARITH] in let rec THETA_LIST n = if n = 0 then [THETA_0] else let ths = THETA_LIST (n - 1) in let th1 = INST [mk_small_numeral(n-1),n_tm] THETA_SUC in let th2 = GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) [hd ths] th1 in CONV_RULE SIMPER_CONV th2::ths in THETA_LIST;; (* ------------------------------------------------------------------------- *) (* Split up the psi sum to show close relationship with theta. *) (* ------------------------------------------------------------------------- *) let PRIMEPOW_ODD_EVEN = prove (`!p q j k. ~(prime(p) /\ prime(q) /\ 1 <= j /\ (p EXP (2 * j) = q EXP (2 * k + 1)))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `q divides p` ASSUME_TAC THENL [MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `2 * j` THEN UNDISCH_TAC `p EXP (2 * j) = q EXP (2 * k + 1)` THEN REWRITE_TAC[EXP_ADD; EXP_1] THEN ASM_MESON_TAC[divides; MULT_SYM]; ALL_TAC] THEN SUBGOAL_THEN `q = p:num` SUBST_ALL_TAC THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN UNDISCH_TAC `p EXP (2 * j) = p EXP (2 * k + 1)` THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN REWRITE_TAC[LE_EXP] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN REWRITE_TAC[] THEN SUBGOAL_THEN `~(p = 1)` (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN REWRITE_TAC[LE_ANTISYM] THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN]);; let PSI_SPLIT = prove (`psi(n) = theta(n) + sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) then ln(&(aprimedivisor d)) else &0) + sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) then ln(&(aprimedivisor d)) else &0)`, REWRITE_TAC[psi; theta; GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[mangoldt; primepow] THEN ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP k)` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; SUBGOAL_THEN `~(?p k. 1 <= k /\ prime p /\ (r = p EXP (2 * k))) /\ ~(?p k. 1 <= k /\ prime p /\ (r = p EXP (2 * k + 1))) /\ ~(prime r)` (fun th -> REWRITE_TAC[th; REAL_ADD_LID]) THEN ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k /\ 1 <= 2 * k + 1`; EXP_1; LE_REFL]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` (X_CHOOSE_THEN `m:num` MP_TAC)) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(SPECL [`m:num`; `2`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN MAP_EVERY ABBREV_TAC [`k = m DIV 2`; `d = m MOD 2`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW] THEN FIRST_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP (ARITH_RULE `d < 2 ==> (d = 0) \/ (d = 1)`)) THEN ASM_REWRITE_TAC[PRIME_EXP; ADD_EQ_0; MULT_EQ_0; ARITH_EQ] THENL [UNDISCH_TAC `1 <= k * 2 + 0` THEN REWRITE_TAC[ADD_CLAUSES] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[ARITH] THEN DISCH_TAC THEN SUBGOAL_THEN `~(k * 2 = 1)` (fun th -> REWRITE_TAC[th]) THENL [DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; ARITH_EVEN]; ALL_TAC] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]) THEN ASM_MESON_TAC[PRIMEPOW_ODD_EVEN; MULT_SYM; ARITH_RULE `~(k = 0) ==> 1 <= k`]; ALL_TAC] THEN ASM_CASES_TAC `k = 0` THENL [MATCH_MP_TAC(REAL_ARITH `(a = a') /\ (b = &0) /\ (c = &0) ==> (a = a' + b + c)`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[ARITH; EXP_1]; ALL_TAC] THEN CONJ_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[PRIMEPOW_ODD_EVEN; MULT_SYM]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN STRIP_TAC THEN SUBGOAL_THEN `q divides p` ASSUME_TAC THENL [MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `k * 2 + 1` THEN UNDISCH_TAC `p EXP (k * 2 + 1) = q EXP (2 * j + 1)` THEN REWRITE_TAC[EXP_ADD; EXP_1] THEN ASM_MESON_TAC[divides; MULT_SYM]; ALL_TAC] THEN SUBGOAL_THEN `q = p:num` SUBST_ALL_TAC THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN UNDISCH_TAC `p EXP (k * 2 + 1) = p EXP (2 * j + 1)` THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN REWRITE_TAC[LE_EXP] THEN ASM_CASES_TAC `p = 0` THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `p = 1` THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN REWRITE_TAC[LE_ANTISYM] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= j ==> ~(1 = 2 * j + 1)`]; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `(k * 2 + 1 = 1) <=> (k = 0)`; ARITH_EQ] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]) THEN ASM_MESON_TAC[PRIMEPOW_ODD_EVEN; MULT_SYM; ARITH_RULE `~(k = 0) ==> 1 <= k`]);; (* ------------------------------------------------------------------------- *) (* General lemma about sums. *) (* ------------------------------------------------------------------------- *) let SUM_SURJECT = prove (`!f i m n p q. (!r. m <= r /\ r < m + n ==> &0 <= f(i r)) /\ (!s. p <= s /\ s < p + q /\ ~(f(s) = &0) ==> ?r. m <= r /\ r < m + n /\ (i r = s)) ==> sum(p,q) f <= sum(m,n) (\r. f(i r))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m,n) (\r. if p:num <= i(r) /\ i(r) < p + q then f(i(r)) else &0)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; ADD_AC]] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`q:num`,`q:num`) THEN INDUCT_TAC THENL [STRIP_TAC THEN REWRITE_TAC[sum] THEN REWRITE_TAC[ARITH_RULE `~(p <= q /\ q < p + 0)`] THEN REWRITE_TAC[SUM_0; REAL_LE_REFL]; ALL_TAC] THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN STRIP_ASSUME_TAC th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[ARITH_RULE `s < p + q ==> s < p + SUC q`]; ALL_TAC] THEN REWRITE_TAC[sum] THEN SUBGOAL_THEN `sum(m,n) (\r. if p <= i r /\ i r < p + SUC q then f (i r) else &0) = sum(m,n) (\r. if p <= i r /\ i r < p + q then f (i r) else &0) + sum(m,n) (\r. if i r = p + q then f(i r) else &0)` SUBST1_TAC THENL [REWRITE_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN ASM_CASES_TAC `(i:num->num) r = p + q` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[LE_ADD; LT_REFL; ARITH_RULE `p + q < p + SUC q`] THEN REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `r < p + SUC q <=> (r = p + q) \/ r < p + q`] THEN REWRITE_TAC[REAL_ADD_RID]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `f <= s'' ==> s <= s' ==> s + f <= s' + s''`) THEN UNDISCH_TAC `!s. p <= s /\ s < p + SUC q /\ ~(f s = &0) ==> (?r:num. m <= r /\ r < m + n /\ (i r = s))` THEN DISCH_THEN(MP_TAC o SPEC `p + q:num`) THEN ASM_CASES_TAC `f(p + q:num) = &0` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m,n) (\r. &0)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_0; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[ADD_SYM]; ALL_TAC] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `n = (s - m) + 1 + ((m + n) - (s + 1))` SUBST1_TAC THENL [MAP_EVERY UNDISCH_TAC [`m <= s:num`; `s < m + n:num`] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN ASM_SIMP_TAC[SUM_1; ARITH_RULE `m <= s ==> (m + (s - m) = s:num)`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y ==> a <= x + a + y`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m,s - m) (\r. &0)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_0; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC SUM_LE THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN MAP_EVERY UNDISCH_TAC [`m <= r:num`; `r < s - m + m:num`; `s < m + n:num`; `m <= s:num`] THEN ARITH_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(s + 1,(m + n) - (s + 1)) (\r. &0)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_0; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC SUM_LE THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN MAP_EVERY UNDISCH_TAC [`r < (m + n) - (s + 1) + s + 1:num`; `s + 1 <= r`; `s < m + n:num`; `m <= s:num`] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Apply this to show that one of the residuals is bounded by the other. *) (* ------------------------------------------------------------------------- *) let PSI_RESIDUES_COMPARE_2 = prove (`sum(2,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) then ln(&(aprimedivisor d)) else &0) <= sum(2,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) then ln(&(aprimedivisor d)) else &0)`, MP_TAC(SPECL [`\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) then ln(&(aprimedivisor d)) else &0`; `\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP k) then d * (aprimedivisor d) else d`; `2`; `n:num`; `2`; `n:num`] SUM_SURJECT) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `r:num` THEN STRIP_TAC THEN ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP k)` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k + 1`]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN SUBGOAL_THEN `p EXP k * p = p EXP (k + 1)` SUBST1_TAC THENL [REWRITE_TAC[EXP_ADD; EXP_1; MULT_AC]; ALL_TAC] THEN ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; ARITH_RULE `1 <= k + 1`] THEN ASM_MESON_TAC[LN_POS; REAL_OF_NUM_LE; PRIME_GE_2; REAL_LE_REFL; ARITH_RULE `2 <= n ==> 1 <= n`]; ALL_TAC] THEN X_GEN_TAC `s:num` THEN ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (s = p EXP (2 * k + 1))` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN EXISTS_TAC `p EXP (2 * k)` THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k`]] THEN ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; EXP_ADD; EXP_1; ARITH_RULE `1 <= k ==> 1 <= 2 * k`] THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `2 <= n <=> ~(n = 0) /\ ~(n = 1)`; EXP_EQ_0; EXP_EQ_1] THEN ASM_MESON_TAC[PRIME_1; PRIME_0; ARITH_RULE `1 <= k ==> ~(2 * k = 0)`]; ALL_TAC] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `p EXP (2 * k + 1)` THEN ASM_REWRITE_TAC[LE_EXP] THEN COND_CASES_TAC THEN UNDISCH_TAC `1 <= k` THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `b <= c ==> a <= b ==> a <= c`) THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP k)` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k /\ 1 <= 2 * k + 1`]] THEN FIRST_X_ASSUM(CHOOSE_THEN (K ALL_TAC)) THEN ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP (2 * k))` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; ARITH_RULE `1 <= k ==> 1 <= 2 * k`] THEN SUBGOAL_THEN `p EXP (2 * k) * p = p EXP (2 * k + 1)` SUBST1_TAC THENL [REWRITE_TAC[EXP_ADD; EXP_1; MULT_AC]; ALL_TAC] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; REAL_LE_REFL; ARITH_RULE `1 <= k ==> 1 <= 2 * k + 1`]; ALL_TAC] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN MATCH_MP_TAC(TAUT `(b ==> a) ==> ~a ==> b ==> c`) THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`p:num`; `k:num`] THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `r:num` APRIMEDIVISOR) THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN ABBREV_TAC `q = aprimedivisor r` THEN STRIP_TAC THEN SUBGOAL_THEN `q divides p` ASSUME_TAC THENL [MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `2 * k + 1` THEN ASM_MESON_TAC[divides; MULT_SYM]; ALL_TAC] THEN SUBGOAL_THEN `q = p:num` SUBST_ALL_TAC THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN UNDISCH_TAC `r * p = p EXP (2 * k + 1)` THEN REWRITE_TAC[EXP_ADD; EXP_1; EQ_MULT_RCANCEL] THEN ASM_MESON_TAC[PRIME_0]);; let PSI_RESIDUES_COMPARE = prove (`!n. sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) then ln(&(aprimedivisor d)) else &0) <= sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) then ln(&(aprimedivisor d)) else &0)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[sum; REAL_LE_REFL] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> (n = 1 + (n - 1))`)) THEN REWRITE_TAC[GSYM SUM_SPLIT; SUM_1] THEN MATCH_MP_TAC(REAL_ARITH `b <= d /\ (a = &0) /\ (c = &0) ==> a + b <= c + d`) THEN REWRITE_TAC[PSI_RESIDUES_COMPARE_2; ARITH] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_MESON_TAC[EXP_EQ_1; PRIME_1; ARITH_RULE `1 <= k ==> ~(2 * k = 0) /\ ~(2 * k + 1 = 0)`]);; (* ------------------------------------------------------------------------- *) (* The even residual reduces to the square root case. *) (* ------------------------------------------------------------------------- *) let PSI_SQRT = prove (`!n. psi(ISQRT(n)) = sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) then ln(&(aprimedivisor d)) else &0)`, REWRITE_TAC[psi] THEN INDUCT_TAC THEN REWRITE_TAC[ISQRT_0; sum; ISQRT_SUC] THEN ASM_CASES_TAC `?m. SUC n = m EXP 2` THENL [ALL_TAC; SUBGOAL_THEN `~(?p k. 1 <= k /\ prime p /\ (1 + n = p EXP (2 * k)))` ASSUME_TAC THENL [ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP_MULT] THEN ASM_MESON_TAC[ARITH_RULE `1 + n = SUC n`]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_ADD_RID]] THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL; sum] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `m:num`) THEN SUBGOAL_THEN `1 + ISQRT n = m` SUBST1_TAC THENL [SUBGOAL_THEN `(1 + ISQRT n) EXP 2 = SUC n` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[num_CONV `2`; GSYM LE_ANTISYM] THEN REWRITE_TAC[EXP_MONO_LE_SUC; EXP_MONO_LT_SUC]] THEN MP_TAC(SPEC `n:num` ISQRT_SUC) THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MP_TAC(SPEC `SUC n` ISQRT_WORKS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[num_CONV `2`; GSYM LE_ANTISYM] THEN REWRITE_TAC[EXP_MONO_LE_SUC; EXP_MONO_LT_SUC] THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN REWRITE_TAC[mangoldt; primepow] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP_MULT] THEN REWRITE_TAC[GSYM LE_ANTISYM; EXP_MONO_LE_SUC; num_CONV `2`] THEN REWRITE_TAC[LE_ANTISYM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[aprimedivisor] THEN REPEAT AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN DISCH_TAC THEN REWRITE_TAC[EXP; EXP_1] THEN ASM_MESON_TAC[DIVIDES_LMUL; PRIME_DIVPROD]);; (* ------------------------------------------------------------------------- *) (* Hence the main comparison result. *) (* ------------------------------------------------------------------------- *) let PSI_THETA = prove (`!n. theta(n) + psi(ISQRT n) <= psi(n) /\ psi(n) <= theta(n) + &2 * psi(ISQRT n)`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [PSI_SPLIT] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [PSI_SPLIT] THEN MP_TAC(SPEC `n:num` PSI_RESIDUES_COMPARE) THEN REWRITE_TAC[GSYM PSI_SQRT] THEN SIMP_TAC[REAL_MUL_2; GSYM REAL_ADD_ASSOC; REAL_LE_LADD; REAL_LE_ADDR] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_POS_GEN THEN X_GEN_TAC `r:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; ARITH_RULE `1 <= k ==> 1 <= 2 * k + 1`] THEN MATCH_MP_TAC LN_POS THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_MESON_TAC[PRIME_0; ARITH_RULE `~(p = 0) ==> 1 <= p`]);; (* ------------------------------------------------------------------------- *) (* A trivial one-way comparison is immediate. *) (* ------------------------------------------------------------------------- *) let THETA_LE_PSI = prove (`!n. theta(n) <= psi(n)`, GEN_TAC THEN REWRITE_TAC[theta; psi] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN ASM_CASES_TAC `prime p` THEN ASM_REWRITE_TAC[MANGOLDT_POS] THEN ASM_SIMP_TAC[mangoldt; PRIME_PRIMEPOW] THEN SUBGOAL_THEN `aprimedivisor p = p` (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN ASM_MESON_TAC[APRIMEDIVISOR_PRIMEPOW; EXP_1; LE_REFL]);; (* ------------------------------------------------------------------------- *) (* A tighter bound on psi on a smaller range, to reduce later case analysis. *) (* ------------------------------------------------------------------------- *) let PSI_UBOUND_30 = prove (`!n. n <= 30 ==> psi(n) <= &65 / &64 * &n`, let lemma = prove (`a <= b /\ l <= a /\ rest ==> l <= a /\ l <= b /\ rest`, MESON_TAC[REAL_LE_TRANS]) and tac = time (CONV_TAC(LAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in REWRITE_TAC[ARITH_RULE `n <= 30 <=> n < 31`] THEN CONV_TAC EXPAND_CASES_CONV THEN REWRITE_TAC(PSI_LIST_300) THEN REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT ((MATCH_MP_TAC lemma THEN CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) ORELSE (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) ORELSE tac));; (* ------------------------------------------------------------------------- *) (* Bounds for theta, derived from those for psi. *) (* ------------------------------------------------------------------------- *) let THETA_UBOUND_3_2 = prove (`!n. theta(n) <= &3 / &2 * &n`, MESON_TAC[REAL_LE_TRANS; PSI_UBOUND_3_2; THETA_LE_PSI]);; let THETA_LBOUND_1_2 = prove (`!n. 5 <= n ==> &1 / &2 * &n <= theta(n)`, let lemma = prove (`a <= b /\ b <= l /\ rest ==> a <= l /\ b <= l /\ rest`, MESON_TAC[REAL_LE_TRANS]) and tac = time (CONV_TAC(RAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `n >= 900` THENL [MP_TAC(CONJUNCT2(SPEC `n:num` PSI_THETA)) THEN MP_TAC(SPEC `n:num` PSI_LBOUND_3_5) THEN ASM_SIMP_TAC[ARITH_RULE `n >= 900 ==> 4 <= n`] THEN MATCH_MP_TAC(REAL_ARITH `d <= (a - b) * n ==> a * n <= ps ==> ps <= th + d ==> b * n <= th`) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&3 / &2 * &(ISQRT n)` THEN REWRITE_TAC[PSI_UBOUND_3_2] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBGOAL_THEN `&(ISQRT n) pow 2 <= (&n * &1 / &30) pow 2` MP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ISQRT_WORKS]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_2; REAL_ARITH `(a * b) * (a * b) = a * a * b * b`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `n >= 900` THEN ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `n < 413` THENL [UNDISCH_TAC `5 <= n` THEN UNDISCH_TAC `n < 413` THEN SPEC_TAC(`n:num`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC(THETA_LIST 412) THEN REWRITE_TAC[LN_1; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT ((MATCH_MP_TAC lemma THEN CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) ORELSE (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) ORELSE tac); ALL_TAC] THEN MP_TAC(CONJUNCT2(SPEC `n:num` PSI_THETA)) THEN MP_TAC(SPEC `n:num` PSI_LBOUND_3_5) THEN ASM_SIMP_TAC[ARITH_RULE `5 <= n ==> 4 <= n`] THEN MATCH_MP_TAC(REAL_ARITH `d <= (a - b) * n ==> a * n <= ps ==> ps <= th + d ==> b * n <= th`) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&65 / &64 * &(ISQRT n)` THEN CONJ_TAC THENL [MATCH_MP_TAC PSI_UBOUND_30 THEN SUBGOAL_THEN `(ISQRT n) EXP (SUC 1) <= 30 EXP (SUC 1)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[EXP_MONO_LE_SUC]] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[ARITH; ISQRT_WORKS] THEN UNDISCH_TAC `~(n >= 900)` THEN ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBGOAL_THEN `&(ISQRT n) pow 2 <= (&n * &16 / &325) pow 2` MP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ISQRT_WORKS]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_2; REAL_ARITH `(a * b) * (a * b) = a * a * b * b`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&413` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `~(n < 413)` THEN ARITH_TAC);; (* ========================================================================= *) (* Tighten the bounds on weak PNT to get the Bertrand conjecture. *) (* ========================================================================= *) let FLOOR_POS = prove (`!x. &0 <= x ==> &0 <= floor x`, GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `x < &1` THENL [ASM_MESON_TAC[FLOOR_EQ_0; REAL_LE_REFL]; ALL_TAC] THEN MP_TAC(last(CONJUNCTS(SPEC `x:real` FLOOR))) THEN UNDISCH_TAC `~(x < &1)` THEN REAL_ARITH_TAC);; let FLOOR_NUM_EXISTS = prove (`!x. &0 <= x ==> ?k. floor x = &k`, REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT1(SPEC `x:real` FLOOR)) THEN REWRITE_TAC[integer] THEN ASM_MESON_TAC[FLOOR_POS; REAL_ARITH `&0 <= x ==> (abs x = x)`]);; let FLOOR_DIV_INTERVAL = prove (`!n d k. ~(d = 0) ==> ((floor(&n / &d) = &k) = if k = 0 then &n < &d else &n / &(k + 1) < &d /\ &d <= &n / &k)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `k = 0` THENL [ASM_REWRITE_TAC[FLOOR_EQ_0] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < d <=> ~(d = 0)`] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID; REAL_OF_NUM_LT]; ALL_TAC] THEN REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < d <=> ~(d = 0)`; ARITH_RULE `0 < k + 1`] THEN REWRITE_TAC[REAL_MUL_AC; CONJ_ACI; REAL_OF_NUM_ADD]);; let FLOOR_DIV_EXISTS = prove (`!n d. ~(d = 0) ==> ?k. (floor(&n / &d) = &k) /\ d * k <= n /\ n < d * (k + 1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?k. floor (&n / &d) = &k` MP_TAC THENL [ASM_SIMP_TAC[FLOOR_NUM_EXISTS; REAL_LE_DIV; REAL_POS]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN SIMP_TAC[] THEN ASM_SIMP_TAC[FLOOR_DIV_INTERVAL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; LE_0; ADD_CLAUSES; REAL_OF_NUM_LT] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < k + 1 /\ (~(k = 0) ==> 0 < k)`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN REWRITE_TAC[CONJ_ACI]);; let FLOOR_HALF_INTERVAL = prove (`!n d. ~(d = 0) ==> (floor (&n / &d) - &2 * floor (&(n DIV 2) / &d) = if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k then &1 else &0)`, let lemma = prove(`ODD(k) ==> ~(k = 0)`,MESON_TAC[EVEN; NOT_EVEN]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP FLOOR_DIV_EXISTS) THEN FIRST_ASSUM(MP_TAC o SPEC `n DIV 2` o MATCH_MP FLOOR_DIV_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `k1:num` (CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `k2:num` (CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC)) THEN MAP_EVERY UNDISCH_TAC [`n DIV 2 < d * (k1 + 1)`; `d * k1 <= n DIV 2`] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a ==> ~(b /\ c))`] THEN SIMP_TAC[GSYM NOT_LE; LE_LDIV_EQ; LE_RDIV_EQ; ARITH_EQ; lemma; ADD_EQ_0] THEN REWRITE_TAC[NOT_LE; NOT_IMP] THEN DISCH_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `d * 2 * k1 < d * (k2 + 1) /\ d * k2 < d * 2 * (k1 + 1)` MP_TAC THENL [ASM_MESON_TAC[LET_TRANS; MULT_AC]; ALL_TAC] THEN ASM_REWRITE_TAC[LT_MULT_LCANCEL] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `2 * k1 < k2 + 1 /\ k2 < 2 * (k1 + 1) ==> (k2 = 2 * k1) \/ (k2 = 2 * k1 + 1)`)) THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL; REAL_ADD_SUB; REAL_SUB_REFL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `2 * k1 + 1`) THEN ASM_REWRITE_TAC[ARITH_ODD; ODD_ADD; ODD_MULT] THEN ASM_MESON_TAC[MULT_AC]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `k:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[ODD_EXISTS; ADD1] THEN DISCH_THEN(X_CHOOSE_THEN `k3:num` SUBST_ALL_TAC) THEN SUBGOAL_THEN `d * 2 * k1 < d * ((2 * k3 + 1) + 1) /\ d * (2 * k3 + 1) < d * 2 * (k1 + 1)` MP_TAC THENL [ASM_MESON_TAC[LET_TRANS; MULT_AC]; ALL_TAC] THEN ASM_REWRITE_TAC[LT_MULT_LCANCEL] THEN DISCH_THEN(SUBST_ALL_TAC o MATCH_MP (ARITH_RULE `2 * k1 < (2 * k3 + 1) + 1 /\ 2 * k3 + 1 < 2 * (k1 + 1) ==> (k3 = k1)`)) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; let SUM_EXPAND_LEMMA = prove (`!n m k. (m + 2 * k = n) ==> (sum (1,n DIV (2 * k + 1)) (\d. if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k then mangoldt d else &0) = sum (1,n) (\d. --(&1) pow (d + 1) * psi (n DIV d)) - sum (1,2 * k) (\d. --(&1) pow (d + 1) * psi (n DIV d)))`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_SIMP_TAC[DIV_0; ADD_EQ_0; ARITH_EQ; REAL_SUB_REFL; sum]; ALL_TAC] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THENL [DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[ADD_CLAUSES] THEN ASM_SIMP_TAC[DIV_REFL; SUM_1; DIV_1; REAL_SUB_REFL] THEN SUBGOAL_THEN `n DIV (n + 1) = 0` (fun th -> REWRITE_TAC[th; sum]) THEN ASM_MESON_TAC[DIV_EQ_0; ARITH_RULE `n < n + 1 /\ ~(n + 1 = 0)`]; ALL_TAC] THEN ASM_CASES_TAC `m = 1` THENL [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:num` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM ADD1; ARITH_RULE `1 + n = SUC n`] THEN SIMP_TAC[DIV_REFL; NOT_SUC; sum; SUM_1] THEN REWRITE_TAC[REAL_ADD_SUB; mangoldt] THEN CONV_TAC(ONCE_DEPTH_CONV PRIMEPOW_CONV) THEN REWRITE_TAC[COND_ID] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN SIMP_TAC[DIV_REFL; NOT_SUC] THEN REWRITE_TAC(LN_1::PSI_LIST 1); ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `m - 2`) THEN ASM_SIMP_TAC[ARITH_RULE `~(m = 0) ==> m - 2 < m`] THEN DISCH_TAC THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN ANTS_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV o TOP_DEPTH_CONV) [ARITH_RULE `2 * SUC k = SUC(SUC(2 * k))`; sum] THEN MATCH_MP_TAC(REAL_ARITH `(s - ss = x + y) ==> (ss = a - ((b + x) + y)) ==> (s = a - b)`) THEN REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; ARITH_EVEN; EVEN; EVEN_MULT] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; REAL_MUL_LNEG] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN REWRITE_TAC[psi; GSYM real_sub] THEN MATCH_MP_TAC(REAL_ARITH `!b. (a - b = d) /\ (b = c) ==> (a - c = d)`) THEN EXISTS_TAC `sum (1,n DIV (SUC (2 * k) + 1)) (\d. if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k then mangoldt d else &0)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_DIFFERENCES_EQ THEN CONJ_TAC THENL [MATCH_MP_TAC DIV_MONO2 THEN ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `r:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `2 * k + 1`) THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH_ODD] THEN ASM_REWRITE_TAC[ARITH_RULE `n <= r <=> n < 1 + r`] THEN ASM_REWRITE_TAC[ARITH_RULE `n < r <=> 1 + n <= r`] THEN ASM_REWRITE_TAC[ARITH_RULE `(2 * k + 1) + 1 = SUC(2 * k) + 1`]; ALL_TAC] THEN MATCH_MP_TAC SUM_MORETERMS_EQ THEN CONJ_TAC THENL [MATCH_MP_TAC DIV_MONO2 THEN ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ARITH_RULE `2 * SUC k + 1 = 2 * k + 3`] THEN REWRITE_TAC[ARITH_RULE `SUC(2 * k) + 1 = 2 * k + 2`] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `oj:num` MP_TAC) THEN REWRITE_TAC[ODD_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[ARITH_RULE `SUC(2 * k) + 1 = 2 * k + 2`] THEN REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 + a <= b ==> a < b`)) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a < 1 + b ==> a <= b`)) THEN SIMP_TAC[GSYM NOT_LE; LE_RDIV_EQ; LE_LDIV_EQ; ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[NOT_LE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(2 * j + 1) * r < (2 * k + 3) * r /\ (2 * k + 2) * r < (2 * j + 2) * r` MP_TAC THENL [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN ASM_CASES_TAC `r = 0` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST_ALL_TAC o MATCH_MP (ARITH_RULE `2 * j + 1 < 2 * k + 3 /\ 2 * k + 2 < 2 * j + 2 ==> (j = k)`)) THEN ASM_MESON_TAC[LET_TRANS; LT_REFL; MULT_AC]);; let FACT_EXPAND_PSI = prove (`!n. ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2))) = sum(1,n) (\d. --(&1) pow (d + 1) * psi(n DIV d))`, GEN_TAC THEN REWRITE_TAC[MANGOLDT] THEN SUBGOAL_THEN `sum (1,n DIV 2) (\d. mangoldt d * floor (&(n DIV 2) / &d)) = sum (1,n) (\d. mangoldt d * floor (&(n DIV 2) / &d))` SUBST1_TAC THENL [SUBGOAL_THEN `n = n DIV 2 + (n - n DIV 2)` (fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [th]) THENL [MESON_TAC[SUB_ADD; DIV_LE; ADD_SYM; NUM_REDUCE_CONV `2 = 0`]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN MATCH_MP_TAC(REAL_ARITH `(b = &0) ==> (a = a + b)`) THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE; FLOOR_EQ_0] THEN DISJ2_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN SUBGOAL_THEN `0 < r /\ n DIV 2 < r` MP_TAC THENL [UNDISCH_TAC `1 + n DIV 2 <= r` THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; REAL_MUL_LID]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_CMUL; GSYM SUM_SUB] THEN REWRITE_TAC[REAL_ARITH `m * x - &2 * m * y = m * (x - &2 * y)`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1,n) (\d. if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k then mangoldt d else &0)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[FLOOR_HALF_INTERVAL; ARITH_RULE `1 <= d ==> ~(d = 0)`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO]; ALL_TAC] THEN MP_TAC(SPECL [`n:num`; `n:num`; `0`] SUM_EXPAND_LEMMA) THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; sum; REAL_SUB_RZERO; DIV_1]);; (* ------------------------------------------------------------------------- *) (* Show that we can get bounds by cutting off at odd/even points. *) (* ------------------------------------------------------------------------- *) let PSI_MONO = prove (`!m n. m <= n ==> psi(m) <= psi(n)`, SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; psi] THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC SUM_POS_GEN THEN REWRITE_TAC[MANGOLDT_POS]);; let PSI_POS = prove (`!n. &0 <= psi(n)`, SUBGOAL_THEN `psi(0) = &0` (fun th -> MESON_TAC[th; PSI_MONO; LE_0]) THEN REWRITE_TAC(LN_1::PSI_LIST 0));; let PSI_EXPANSION_CUTOFF = prove (`!n m p. m <= p ==> sum(1,2 * m) (\d. --(&1) pow (d + 1) * psi(n DIV d)) <= sum(1,2 * p) (\d. --(&1) pow (d + 1) * psi(n DIV d)) /\ sum(1,2 * p + 1) (\d. --(&1) pow (d + 1) * psi(n DIV d)) <= sum(1,2 * m + 1) (\d. --(&1) pow (d + 1) * psi(n DIV d))`, GEN_TAC THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN X_GEN_TAC `m:num` THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN REWRITE_TAC[ARITH_RULE `2 * SUC n = SUC(SUC(2 * n))`; ARITH_RULE `SUC(SUC n) + 1 = SUC(SUC(n + 1))`; sum] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `s1 <= s1' /\ s2' <= s2 ==> &0 <= a + b /\ &0 <= --c + --d ==> s1 <= (s1' + a) + b /\ (s2' + c) + d <= s2`)) THEN REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; EVEN] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; REAL_MUL_LNEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_ARITH `&0 <= a + --b <=> b <= a`] THEN CONJ_TAC THEN MATCH_MP_TAC PSI_MONO THEN MATCH_MP_TAC DIV_MONO2 THEN ARITH_TAC);; let FACT_PSI_BOUND_ODD = prove (`!n k. ODD(k) ==> ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2))) <= sum(1,k) (\d. --(&1) pow (d + 1) * psi(n DIV d))`, REPEAT STRIP_TAC THEN REWRITE_TAC[FACT_EXPAND_PSI] THEN ASM_CASES_TAC `k <= n:num` THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `(b = a) ==> a <= b`) THEN MATCH_MP_TAC SUM_MORETERMS_EQ THEN ASM_SIMP_TAC[ARITH_RULE `~(k <= n) ==> n <= k:num`] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN SUBGOAL_THEN `n DIV r = 0` SUBST1_TAC THENL [ASM_MESON_TAC[DIV_EQ_0; ARITH_RULE `1 + n <= r ==> n < r /\ ~(r = 0)`]; REWRITE_TAC(LN_1::PSI_LIST 0)]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1,SUC(2 * n DIV 2)) (\d. -- &1 pow (d + 1) * psi (n DIV d))` THEN CONJ_TAC THENL [ALL_TAC; SUBGOAL_THEN `m <= n DIV 2` (fun th -> SIMP_TAC[th; ADD1; PSI_EXPANSION_CUTOFF]) THEN SIMP_TAC[LE_RDIV_EQ; ARITH_EQ] THEN POP_ASSUM MP_TAC THEN ARITH_TAC] THEN MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN MAP_EVERY ABBREV_TAC [`q = n DIV 2`; `r = n MOD 2`] THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [th]) MP_TAC) THEN REWRITE_TAC[ARITH_RULE `r < 2 <=> (r = 0) \/ (r = 1)`] THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN REWRITE_TAC[ADD1; MULT_AC; REAL_LE_REFL] THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; sum; REAL_LE_ADDR] THEN REWRITE_TAC[REAL_POW_NEG; EVEN; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; PSI_POS]);; let FACT_PSI_BOUND_EVEN = prove (`!n k. EVEN(k) ==> sum(1,k) (\d. --(&1) pow (d + 1) * psi(n DIV d)) <= ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[FACT_EXPAND_PSI] THEN ASM_CASES_TAC `k <= n:num` THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `(a = b) ==> a <= b`) THEN MATCH_MP_TAC SUM_MORETERMS_EQ THEN ASM_SIMP_TAC[ARITH_RULE `~(k <= n) ==> n <= k:num`] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN SUBGOAL_THEN `n DIV r = 0` SUBST1_TAC THENL [ASM_MESON_TAC[DIV_EQ_0; ARITH_RULE `1 + n <= r ==> n < r /\ ~(r = 0)`]; REWRITE_TAC(LN_1::PSI_LIST 0)]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1,2 * n DIV 2) (\d. -- &1 pow (d + 1) * psi (n DIV d))` THEN CONJ_TAC THENL [SUBGOAL_THEN `m <= n DIV 2` (fun th -> SIMP_TAC[th; ADD1; PSI_EXPANSION_CUTOFF]) THEN SIMP_TAC[LE_RDIV_EQ; ARITH_EQ] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN MAP_EVERY ABBREV_TAC [`q = n DIV 2`; `r = n MOD 2`] THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [th]) MP_TAC) THEN REWRITE_TAC[ARITH_RULE `r < 2 <=> (r = 0) \/ (r = 1)`] THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN REWRITE_TAC[ADD1; MULT_AC; ADD_CLAUSES; REAL_LE_REFL] THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; sum; REAL_LE_ADDR] THEN REWRITE_TAC[REAL_POW_NEG; EVEN; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; PSI_POS]);; (* ------------------------------------------------------------------------- *) (* In particular, we will use these. *) (* ------------------------------------------------------------------------- *) let FACT_PSI_BOUND_2_3 = prove (`!n. psi(n) - psi(n DIV 2) <= ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2))) /\ ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2))) <= psi(n) - psi(n DIV 2) + psi(n DIV 3)`, GEN_TAC THEN MP_TAC(SPECL [`n:num`; `2`] FACT_PSI_BOUND_EVEN) THEN MP_TAC(SPECL [`n:num`; `3`] FACT_PSI_BOUND_ODD) THEN REWRITE_TAC[ARITH] THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[ARITH; REAL_ADD_LID; DIV_1] THEN REWRITE_TAC[REAL_POW_NEG; ARITH; REAL_POW_ONE; REAL_MUL_LID] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence get a good lower bound on psi(n) - psi(n/2). *) (* ------------------------------------------------------------------------- *) let PSI_DOUBLE_LEMMA = prove (`!n. n >= 1200 ==> &n / &6 <= psi(n) - psi(n DIV 2)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `n:num` FACT_PSI_BOUND_2_3) THEN MATCH_MP_TAC(REAL_ARITH `b + p3 <= a ==> u <= v /\ a <= p - p2 + p3 ==> b <= p - p2`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n / &6 + &n / &2` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_LE_LADD] THEN MP_TAC(SPEC `n DIV 3` PSI_UBOUND_3_2) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&3 / &2 * &n / &3` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MP_TAC(SPECL [`n:num`; `3`] DIVISION) THEN ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_LE_REFL]]; ALL_TAC] THEN MP_TAC(SPEC `n:num` LN_FACT_DIFF_BOUNDS) THEN MATCH_MP_TAC(REAL_ARITH `ltm <= nl2 - a ==> abs(lf - nl2) <= ltm ==> a <= lf`) THEN ASM_SIMP_TAC[ARITH_RULE `n >= 1200 ==> ~(n = 0)`] THEN REWRITE_TAC[real_div; GSYM REAL_SUB_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n * &1 / &38` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN SIMP_TAC[REAL_LE_SUB_LADD] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC(RAND_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV] THEN SUBST1_TAC(REAL_ARITH `&n = &1 + (&n - &1)`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `n >= b ==> b <= n:num`)) THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_OF_NUM_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a <= n ==> a - &1 <= n - &1`)) THEN ABBREV_TAC `x = &n - &1` THEN CONV_TAC(LAND_CONV NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) THEN SPEC_TAC(`x:real`,`x:real`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC OVERPOWER_LEMMA THEN W(fun (asl,w) -> let th = DIFF_CONV (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in MP_TAC th) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID; REAL_MUL_LID] THEN W(fun (asl,w) -> let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in DISCH_TAC THEN EXISTS_TAC tm) THEN CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_sub] THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN REWRITE_TAC[] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= x ==> inv(&1 + x) <= inv(&1 + a) /\ inv(&1 + a) <= b ==> inv(&1 + x) <= b`)) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Hence show that theta changes (could get a lower bound like n/10). *) (* ------------------------------------------------------------------------- *) let THETA_DOUBLE_LEMMA = prove (`!n. n >= 1200 ==> theta(n DIV 2) < theta(n)`, REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT2 (SPEC `n:num` PSI_THETA)) THEN MP_TAC(CONJUNCT1 (SPEC `n DIV 2` PSI_THETA)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP PSI_DOUBLE_LEMMA) THEN MP_TAC(SPEC `ISQRT(n DIV 2)` PSI_POS) THEN SUBGOAL_THEN `&2 * psi (ISQRT n) < &n / &6` (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&3 / &2 * &(ISQRT n)` THEN REWRITE_TAC[PSI_UBOUND_3_2] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN SUBGOAL_THEN `(ISQRT n * 18) EXP (SUC 1) < n EXP (SUC 1)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[EXP_MONO_LT_SUC]] THEN REWRITE_TAC[EXP; EXP_1] THEN MATCH_MP_TAC(ARITH_RULE `324 * i * i < a ==> (i * 18) * (i * 18) < a`) THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `324 * n` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM EXP_2; ISQRT_WORKS; LE_MULT_LCANCEL]; REWRITE_TAC[LT_MULT_RCANCEL] THEN POP_ASSUM MP_TAC THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Hence Bertrand for sufficiently large n. *) (* ------------------------------------------------------------------------- *) let BIG_BERTRAND = prove (`!n. n >= 2400 ==> ?p. prime(p) /\ n <= p /\ p <= 2 * n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `2 * n` THETA_DOUBLE_LEMMA) THEN ANTS_TAC THENL [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[DIV_MULT; ARITH_EQ] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> b /\ c ==> ~a`] THEN DISCH_TAC THEN SUBGOAL_THEN `sum(n + 1,n) (\p. if prime p then ln (&p) else &0) = &0` MP_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(n + 1,n) (\r. &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[ARITH_RULE `n + 1 <= r /\ r < n + n + 1 ==> n <= r /\ r <= 2 * n`]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `(b + a = c) ==> (a = &0) ==> ~(b < c)`) THEN REWRITE_TAC[theta] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[SUM_SPLIT] THEN REWRITE_TAC[MULT_2]);; (* ------------------------------------------------------------------------- *) (* Landau trick. Should be automatic but ARITH_RULE is a bit slow. *) (* (Direct use of ARITH_RULE takes about 3 minutes on my current laptop.) *) (* ------------------------------------------------------------------------- *) let LANDAU_TRICK = prove (`!n. 0 < n /\ n < 2400 ==> n <= 2 /\ 2 <= 2 * n \/ n <= 3 /\ 3 <= 2 * n \/ n <= 5 /\ 5 <= 2 * n \/ n <= 7 /\ 7 <= 2 * n \/ n <= 13 /\ 13 <= 2 * n \/ n <= 23 /\ 23 <= 2 * n \/ n <= 43 /\ 43 <= 2 * n \/ n <= 83 /\ 83 <= 2 * n \/ n <= 163 /\ 163 <= 2 * n \/ n <= 317 /\ 317 <= 2 * n \/ n <= 631 /\ 631 <= 2 * n \/ n <= 1259 /\ 1259 <= 2 * n \/ n <= 2503 /\ 2503 <= 2 * n`, let lemma = TAUT `(p /\ b1 ==> a1) /\ (~b1 ==> a2) ==> p ==> b1 /\ a1 \/ a2` in GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> c \/ ~b`] THEN REWRITE_TAC[GSYM DISJ_ASSOC] THEN REPEAT(MATCH_MP_TAC lemma THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC]) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Bertrand for all nonzero n using "Landau trick". *) (* ------------------------------------------------------------------------- *) let BERTRAND = prove (`!n. ~(n = 0) ==> ?p. prime p /\ n <= p /\ p <= 2 * n`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n >= 2400 \/ n < 2400`) THEN ASM_SIMP_TAC[BIG_BERTRAND] THEN MP_TAC(SPEC `n:num` LANDAU_TRICK) THEN ASM_REWRITE_TAC[ARITH_RULE `0 < n <=> ~(n = 0)`] THEN STRIP_TAC THEN ASM_MESON_TAC(map (PRIME_CONV o curry mk_comb `prime` o mk_small_numeral) [2;3;5;7;13;23;43;83;163;317;631;1259;2503]));; (* ========================================================================= *) (* Weak form of the Prime Number Theorem. *) (* ========================================================================= *) let pii = new_definition `pii(n) = sum(1,n) (\p. if prime(p) then &1 else &0)`;; (* ------------------------------------------------------------------------- *) (* An optimized rule to give pii(n) for all n <= some N. *) (* ------------------------------------------------------------------------- *) let PII_LIST = let PII_0 = prove (`pii(0) = &0`, REWRITE_TAC[pii; sum]) and PII_SUC = prove (`pii(SUC n) = pii(n) + (if prime(SUC n) then &1 else &0)`, REWRITE_TAC[pii; sum; ADD1] THEN REWRITE_TAC[ADD_AC]) and n_tm = `n:num` and SIMPER_CONV = NUM_REDUCE_CONV THENC ONCE_DEPTH_CONV PRIME_CONV THENC GEN_REWRITE_CONV TOP_DEPTH_CONV [COND_CLAUSES] THENC REAL_RAT_REDUCE_CONV in let rec PII_LIST n = if n = 0 then [PII_0] else let ths = PII_LIST (n - 1) in let th1 = INST [mk_small_numeral(n-1),n_tm] PII_SUC in let th2 = GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) [hd ths] th1 in CONV_RULE SIMPER_CONV th2::ths in PII_LIST;; (* ------------------------------------------------------------------------- *) (* Prove the usual characterization. *) (* ------------------------------------------------------------------------- *) let PRIMES_FINITE = prove (`!n. FINITE {p | p <= n /\ prime(p)}`, GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p | p < SUC n}` THEN REWRITE_TAC[FINITE_NUMSEG_LT] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC);; let PII = prove (`!n. pii(n) = &(CARD {p | p <= n /\ prime(p)})`, INDUCT_TAC THENL [SUBGOAL_THEN `{p | p <= 0 /\ prime p} = {}` (fun th -> REWRITE_TAC(th::CARD_CLAUSES::PII_LIST 0)) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[LE; PRIME_0; NOT_IN_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `{p | p <= SUC n /\ prime p} = if prime(SUC n) then (SUC n) INSERT {p | p <= n /\ prime p} else {p | p <= n /\ prime p}` SUBST1_TAC THENL [COND_CASES_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN ASM_MESON_TAC[LE]; ALL_TAC] THEN REWRITE_TAC[pii; sum] THEN REWRITE_TAC[GSYM pii] THEN REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN SIMP_TAC[CARD_CLAUSES; PRIMES_FINITE] THEN COND_CASES_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_MESON_TAC[ARITH_RULE `~(SUC n <= n)`]; REWRITE_TAC[REAL_OF_NUM_SUC]]);; (* ------------------------------------------------------------------------- *) (* One bound is a simple consequence of the one for theta. *) (* ------------------------------------------------------------------------- *) let PII_LBOUND = prove (`!n. 3 <= n ==> &1 / &2 * (&n / ln(&n)) <= pii(n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; LN_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `3 <= n ==> 1 < n`] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN FIRST_X_ASSUM(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC o MATCH_MP (ARITH_RULE `3 <= n ==> (n = 3) \/ (n = 4) \/ 5 <= n`)) THEN ASM_REWRITE_TAC(PII_LIST 4) THENL [CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP THETA_LBOUND_1_2) THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> a <= x ==> a <= y`) THEN REWRITE_TAC[theta; pii; GSYM SUM_CMUL] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL] THEN SUBGOAL_THEN `&0 < &r /\ &r <= &n` (fun th -> MESON_TAC[th; LN_MONO_LE; REAL_LTE_TRANS]) THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN UNDISCH_TAC `1 <= r` THEN UNDISCH_TAC `r < n + 1` THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* First prove the upper bound for the first 50 numbers, to start with. *) (* ------------------------------------------------------------------------- *) let PII_UBOUND_CASES_50 = prove (`!n. n < 50 ==> 3 <= n ==> ln(&n) * pii(n) <= &5 * &n`, let tac = CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV THENC REALCALC_REL_CONV) in CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC(PII_LIST 49) THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT(CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) THEN tac);; (* ------------------------------------------------------------------------- *) (* An extra trivial pair of lemmas. *) (* ------------------------------------------------------------------------- *) let THETA_POS = prove (`!n. &0 <= theta n`, GEN_TAC THEN REWRITE_TAC[theta] THEN MATCH_MP_TAC SUM_POS_GEN THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LE_REFL; LN_POS; REAL_OF_NUM_LE]);; let PII_MONO = prove (`!m n. m <= n ==> pii(m) <= pii(n)`, SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; pii] THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC SUM_POS_GEN THEN GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let PII_POS = prove (`!n. &0 <= pii(n)`, SUBGOAL_THEN `pii(0) = &0` (fun th -> MESON_TAC[th; PII_MONO; LE_0]) THEN REWRITE_TAC(LN_1::PII_LIST 0));; (* ------------------------------------------------------------------------- *) (* The induction principle we can use. *) (* ------------------------------------------------------------------------- *) let PII_CHANGE = prove (`!m n. ~(m = 0) ==> ln(&m) * (pii n - pii m) <= &3 / &2 * &n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m <= n:num` THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a * (c - b) ==> a * (b - c) <= &0`) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[LN_POS; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC PII_MONO THEN UNDISCH_TAC `~(m <= n:num)` THEN ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `theta n` THEN REWRITE_TAC[THETA_UBOUND_3_2] THEN MP_TAC(SPEC `m:num` THETA_POS) THEN MATCH_MP_TAC(REAL_ARITH `a <= n - m ==> &0 <= m ==> a <= n`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[pii; theta; GSYM SUM_SPLIT; REAL_ADD_SUB] THEN REWRITE_TAC[GSYM SUM_CMUL] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL; REAL_MUL_RID] THEN SUBGOAL_THEN `&0 < &m /\ &m <= &r` (fun th -> MESON_TAC[th; LN_MONO_LE; REAL_LTE_TRANS]) THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN UNDISCH_TAC `1 + m <= r` THEN UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC);; let PII_ISQRT_INDUCT = prove (`!n. 50 <= n ==> ln(&n) * pii(n) <= &9 / &4 * (&3 / &2 * &n + ln(&(ISQRT(n))) * pii(ISQRT(n)))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC LAND_CONV [real_div] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MP_TAC(SPECL [`ISQRT n`; `n:num`] PII_CHANGE) THEN SUBGOAL_THEN `~(ISQRT n = 0)` ASSUME_TAC THENL [MP_TAC(SPEC `n:num` ISQRT_WORKS) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[ARITH] THEN DISCH_TAC THEN UNDISCH_TAC `50 <= n` THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a * p <= ls * p ==> ls * (p - ps) <= an ==> a * p <= an + ls * ps`) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[PII_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `ln((&(ISQRT n) + &1) pow 2)` THEN CONJ_TAC THENL [SUBGOAL_THEN `&0 < &n /\ &n <= (&(ISQRT n) + &1) pow 2` (fun th -> MESON_TAC[th; REAL_LTE_TRANS; LN_MONO_LE]) THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN SIMP_TAC[ISQRT_WORKS; LT_IMP_LE] THEN UNDISCH_TAC `50 <= n` THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[LN_POW; REAL_POS; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `a - b <= b * (d - &1) ==> a <= b * d`) THEN ASM_SIMP_TAC[GSYM LN_DIV; REAL_ARITH `&0 < x ==> &0 < x + &1`; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&(ISQRT n))` THEN ASM_SIMP_TAC[LN_LE; REAL_POS; REAL_LE_INV_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN SUBGOAL_THEN `&7 <= &(ISQRT n)` MP_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LE] THEN SUBGOAL_THEN `7 EXP 2 < (ISQRT n + 1) EXP 2` MP_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[ISQRT_WORKS] THEN CONV_TAC NUM_REDUCE_CONV THEN UNDISCH_TAC `50 <= n` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC] THEN ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`&(ISQRT n)`,`x:real`) THEN MATCH_MP_TAC OVERPOWER_LEMMA THEN W(fun (asl,w) -> let th = DIFF_CONV (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in MP_TAC th) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID; REAL_MUL_LID] THEN SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN W(fun (asl,w) -> let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in DISCH_TAC THEN EXISTS_TAC tm) THEN CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_sub] THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN REWRITE_TAC[] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN SIMP_TAC[LN_POS; REAL_LE_ADD; REAL_POS; REAL_ARITH `&7 <= x ==> &1 <= x`]);; (* ------------------------------------------------------------------------- *) (* Hence a bound by wellfounded induction. *) (* ------------------------------------------------------------------------- *) let PII_UBOUND_5 = prove (`!n. 3 <= n ==> pii(n) <= &5 * (&n / ln(&n))`, REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; LN_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `3 <= n ==> 1 < n`] THEN GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n < 50` THEN ASM_SIMP_TAC[PII_UBOUND_CASES_50] THEN DISCH_THEN(MP_TAC o SPEC `ISQRT n`) THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN SUBGOAL_THEN `7 <= ISQRT n` ASSUME_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LE] THEN SUBGOAL_THEN `7 EXP 2 < (ISQRT n + 1) EXP 2` MP_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[ISQRT_WORKS] THEN CONV_TAC NUM_REDUCE_CONV THEN UNDISCH_TAC `50 <= n` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC] THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `7 <= n ==> 3 <= n`; ARITH_RULE `50 <= n ==> 3 <= n`] THEN ANTS_TAC THENL [SUBGOAL_THEN `(ISQRT n) EXP 2 < n EXP 2` MP_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[ISQRT_WORKS] THEN REWRITE_TAC[EXP_2] THEN MATCH_MP_TAC(ARITH_RULE `1 * n < m ==> n < m`) THEN REWRITE_TAC[LT_MULT_RCANCEL] THEN UNDISCH_TAC `50 <= n` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PII_ISQRT_INDUCT) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&9 / &4 * (&3 / &2 * &n + &5 * &(ISQRT n))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_LE_LADD]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `i * (a * c) <= n * (d - a * b) ==> a * (b * n + c * i) <= d * n`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(ISQRT n) * &7` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `ISQRT n * ISQRT n` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[LE_MULT_LCANCEL]; REWRITE_TAC[GSYM EXP_2; ISQRT_WORKS]]);; hol-light/100/birthday.ml000066400000000000000000000256341303454263000154170ustar00rootroot00000000000000(* ========================================================================= *) (* Birthday problem. *) (* ========================================================================= *) 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)}`;; (* ------------------------------------------------------------------------- *) (* Sizes. *) (* ------------------------------------------------------------------------- *) 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[]);; (* ------------------------------------------------------------------------- *) (* The restriction to injective functions. *) (* ------------------------------------------------------------------------- *) let FACT_DIVIDES = prove (`!m n. m <= n ==> ?d. FACT(n) = d * FACT(m)`, REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT] THEN ASM_MESON_TAC[MULT_AC; MULT_CLAUSES]);; let FACT_DIV_MULT = prove (`!m n. m <= n ==> FACT n = (FACT(n) DIV FACT(m)) * FACT(m)`, REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP FACT_DIVIDES) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN ASM_SIMP_TAC[DIV_MULT; GSYM LT_NZ; FACT_LT]);; let HAS_SIZE_FUNSPACE_INJECTIVE = prove (`!s:A->bool t:B->bool m n. s HAS_SIZE m /\ t HAS_SIZE n ==> {f | f IN (s --> t) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)} HAS_SIZE (if n < m then 0 else (FACT n) DIV (FACT(n - 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 REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN ASM_SIMP_TAC[FINITE_RULES; CARD_CLAUSES; FACT] THEN SIMP_TAC[NOT_IN_EMPTY; LT; SUB_0; DIV_REFL; GSYM LT_NZ; FACT_LT] THEN REWRITE_TAC[ARITH]; ALL_TAC] THEN REWRITE_TAC[GSYM HAS_SIZE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `{f | f IN (x INSERT s) --> t /\ (!u v. u IN (x INSERT s) /\ v IN (x INSERT s) /\ f u = f v ==> u = v)} = IMAGE (\(y:B,g) u:A. if u = x then y else g(u)) {y,g | y IN t /\ g IN {f | f IN (s --> (t DELETE y)) /\ !u v. u IN s /\ v IN s /\ f u = f v ==> u = v}}` 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 [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN 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[]; REWRITE_TAC[IN_INSERT; IN_DELETE; 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[]]; 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; IN_INSERT; IN_DELETE] 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 SUBGOAL_THEN `(if n < SUC (CARD s) then 0 else FACT n DIV FACT (n - SUC (CARD s))) = n * (if (n - 1) < CARD(s:A->bool) then 0 else FACT(n - 1) DIV FACT (n - 1 - CARD s))` SUBST1_TAC THENL [ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LT_0] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> (n - 1 < m <=> n < SUC m)`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN REWRITE_TAC[ARITH_RULE `n - SUC(m) = n - 1 - m`] THEN UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[FACT; SUC_SUB1] THEN DISCH_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; FACT_LT; GSYM MULT_ASSOC] THEN AP_TERM_TAC THEN MATCH_MP_TAC FACT_DIV_MULT THEN ARITH_TAC; MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:B` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; CARD_DELETE]]);; (* ------------------------------------------------------------------------- *) (* So the actual birthday result. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_DIFF = prove (`!s t:A->bool m n. s SUBSET t /\ s HAS_SIZE m /\ t HAS_SIZE n ==> (t DIFF s) HAS_SIZE (n - m)`, SIMP_TAC[HAS_SIZE; FINITE_DIFF] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> t = s UNION (t DIFF s)`)) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN ASM_SIMP_TAC[CARD_UNION; FINITE_DIFF; ADD_SUB2; SET_RULE `s INTER (t DIFF s) = {}`]);; let BIRTHDAY_THM = prove (`!s:A->bool t:B->bool m n. s HAS_SIZE m /\ t HAS_SIZE n ==> {f | f IN (s --> t) /\ ?x y. x IN s /\ y IN s /\ ~(x = y) /\ f(x) = f(y)} HAS_SIZE (if m <= n then (n EXP m) - (FACT n) DIV (FACT(n - m)) else n EXP m)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `{f:A->B | f IN (s --> t) /\ ?x y. x IN s /\ y IN s /\ ~(x = y) /\ f(x) = f(y)} = (s --> t) DIFF {f | f IN (s --> t) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)}`] THEN REWRITE_TAC[ARITH_RULE `(if a <= b then x - y else x) = x - (if b < a then 0 else y)`] THEN MATCH_MP_TAC HAS_SIZE_DIFF THEN ASM_SIMP_TAC[HAS_SIZE_FUNSPACE_INJECTIVE; HAS_SIZE_FUNSPACE] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]);; (* ------------------------------------------------------------------------- *) (* The usual explicit instantiation. *) (* ------------------------------------------------------------------------- *) let FACT_DIV_SIMP = prove (`!m n. m < n ==> (FACT n) DIV (FACT m) = n * FACT(n - 1) DIV FACT(m)`, GEN_TAC THEN REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REWRITE_TAC[ARITH_RULE `(m + SUC d) - 1 - m = d`] THEN REWRITE_TAC[ARITH_RULE `(m + SUC d) - 1 = m + d`; ADD_SUB2] THEN GEN_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[FACT_LT; ARITH_RULE `x + 0 = x`] THEN REWRITE_TAC[FACT] THEN SIMP_TAC[GSYM MULT_ASSOC; GSYM FACT_DIV_MULT; LE_ADD] THEN REWRITE_TAC[ADD_CLAUSES; FACT]);; let BIRTHDAY_THM_EXPLICIT = prove (`!s t. s HAS_SIZE 23 /\ t HAS_SIZE 365 ==> 2 * CARD {f | f IN (s --> t) /\ ?x y. x IN s /\ y IN s /\ ~(x = y) /\ f(x) = f(y)} >= CARD (s --> t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BIRTHDAY_THM) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_SIZE_FUNSPACE) THEN CONV_TAC(ONCE_DEPTH_CONV NUM_SUB_CONV) THEN REPEAT(CHANGED_TAC (SIMP_TAC[FACT_DIV_SIMP; ARITH_LE; ARITH_LT] THEN CONV_TAC(ONCE_DEPTH_CONV NUM_SUB_CONV))) THEN SIMP_TAC[DIV_REFL; GSYM LT_NZ; FACT_LT] THEN REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV);; hol-light/100/cantor.ml000066400000000000000000000101641303454263000150670ustar00rootroot00000000000000(* ========================================================================= *) (* Cantor's theorem. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Ad hoc version for whole type. *) (* ------------------------------------------------------------------------- *) let CANTOR_THM_INJ = prove (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, REWRITE_TAC[INJECTIVE_LEFT_INVERSE; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(A->bool)->A`; `g:A->(A->bool)`] THEN DISCH_THEN(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN MESON_TAC[]);; let CANTOR_THM_SURJ = prove (`~(?f:A->(A->bool). !s. ?x. f x = s)`, REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:A->(A->bool)`; `f:(A->bool)->A`] THEN DISCH_THEN(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Proper version for any set, in terms of cardinality operators. *) (* ------------------------------------------------------------------------- *) let CANTOR = prove (`!s:A->bool. s <_c {t | t SUBSET s}`, GEN_TAC THEN REWRITE_TAC[lt_c] THEN CONJ_TAC THENL [REWRITE_TAC[le_c] THEN EXISTS_TAC `(=):A->A->bool` THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; SUBSET; IN] THEN MESON_TAC[]; REWRITE_TAC[LE_C; IN_ELIM_THM; SURJECTIVE_RIGHT_INVERSE] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `g:A->(A->bool)` THEN DISCH_THEN(MP_TAC o SPEC `\x:A. s(x) /\ ~(g x x)`) THEN REWRITE_TAC[SUBSET; IN; FUN_EQ_THM] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* More explicit "injective" version as in Paul Taylor's book. *) (* ------------------------------------------------------------------------- *) let CANTOR_THM_INJ' = prove (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, STRIP_TAC THEN ABBREV_TAC `(g:A->A->bool) = \a. { b | !s. f(s) = a ==> b IN s}` THEN MP_TAC(ISPEC `g:A->A->bool` (REWRITE_RULE[NOT_EXISTS_THM] CANTOR_THM_SURJ)) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Another sequence of versions (Lawvere, Cantor, Taylor) taken from *) (* http://ncatlab.org/nlab/show/Cantor%27s+theorem. *) (* ------------------------------------------------------------------------- *) let CANTOR_LAWVERE = prove (`!h:A->(A->B). (!f:A->B. ?x:A. h(x) = f) ==> !n:B->B. ?x. n(x) = x`, REPEAT STRIP_TAC THEN ABBREV_TAC `g:A->B = \a. (n:B->B) (h a a)` THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_MESON_TAC[]);; let CANTOR = prove (`!f:A->(A->bool). ~(!s. ?x. f x = s)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CANTOR_LAWVERE) THEN DISCH_THEN(MP_TAC o SPEC `(~)`) THEN MESON_TAC[]);; let CANTOR_TAYLOR = prove (`!f:(A->bool)->A. ~(!x y. f(x) = f(y) ==> x = y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\a:A. { b:A | !s. f(s) = a ==> b IN s}` (REWRITE_RULE[NOT_EXISTS_THM] CANTOR)) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let SURJECTIVE_COMPOSE = prove (`(!y. ?x. f(x) = y) /\ (!z. ?y. g(y) = z) ==> (!z. ?x. (g o f) x = z)`, MESON_TAC[o_THM]);; let INJECTIVE_SURJECTIVE_PREIMAGE = prove (`!f:A->B. (!x y. f(x) = f(y) ==> x = y) ==> !t. ?s. {x | f(x) IN s} = t`, REPEAT STRIP_TAC THEN EXISTS_TAC `IMAGE (f:A->B) t` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN ASM_MESON_TAC[]);; let CANTOR_JOHNSTONE = prove (`!i:B->S f:B->S->bool. ~((!x y. i(x) = i(y) ==> x = y) /\ (!s. ?z. f(z) = s))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(IMAGE (f:B->S->bool)) o (\s:S->bool. {x | i(x) IN s})` (REWRITE_RULE[NOT_EXISTS_THM] CANTOR)) THEN REWRITE_TAC[] THEN MATCH_MP_TAC SURJECTIVE_COMPOSE THEN ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN MATCH_MP_TAC INJECTIVE_SURJECTIVE_PREIMAGE THEN ASM_REWRITE_TAC[]);; hol-light/100/cayley_hamilton.ml000066400000000000000000000510251303454263000167630ustar00rootroot00000000000000(* ========================================================================= *) (* The Cayley-Hamilton theorem (for real matrices). *) (* ========================================================================= *) needs "Multivariate/complexes.ml";; (* ------------------------------------------------------------------------- *) (* Powers of a square matrix (mpow) and sums of matrices (msum). *) (* ------------------------------------------------------------------------- *) parse_as_infix("mpow",(24,"left"));; let mpow = define `(!A:real^N^N. A mpow 0 = (mat 1 :real^N^N)) /\ (!A:real^N^N n. A mpow (SUC n) = A ** A mpow n)`;; let msum = new_definition `msum = iterate (matrix_add)`;; let NEUTRAL_MATRIX_ADD = prove (`neutral((+):real^N^M->real^N^M->real^N^M) = mat 0`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[MATRIX_ADD_RID; MATRIX_ADD_LID]);; let MONOIDAL_MATRIX_ADD = prove (`monoidal((+):real^N^M->real^N^M->real^N^M)`, REWRITE_TAC[monoidal; NEUTRAL_MATRIX_ADD] THEN REWRITE_TAC[MATRIX_ADD_LID; MATRIX_ADD_ASSOC] THEN REWRITE_TAC[MATRIX_ADD_SYM]);; let MSUM_CLAUSES = prove (`(!(f:A->real^N^M). msum {} f = mat 0) /\ (!x (f:A->real^N^M) s. FINITE(s) ==> (msum (x INSERT s) f = if x IN s then msum s f else f(x) + msum s f))`, REWRITE_TAC[msum; GSYM NEUTRAL_MATRIX_ADD] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MATRIX_ADD]);; let MSUM_MATRIX_RMUL = prove (`!(f:A->real^N^M) (A:real^P^N) s. FINITE s ==> msum s (\i. f(i) ** A) = msum s f ** A`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[MSUM_CLAUSES; MATRIX_MUL_LZERO; MATRIX_ADD_RDISTRIB]);; let MSUM_MATRIX_LMUL = prove (`!(f:A->real^P^N) (A:real^N^M) s. FINITE s ==> msum s (\i. A ** f(i)) = A ** msum s f`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[MSUM_CLAUSES; MATRIX_MUL_RZERO; MATRIX_ADD_LDISTRIB]);; let MSUM_ADD = prove (`!f g s. FINITE s ==> (msum s (\x. f(x) + g(x)) = msum s f + msum s g)`, SIMP_TAC[msum; ITERATE_OP; MONOIDAL_MATRIX_ADD]);; let MSUM_CMUL = prove (`!(f:A->real^N^M) c s. FINITE s ==> msum s (\i. c %% f(i)) = c %% msum s f`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[MSUM_CLAUSES; MATRIX_CMUL_ADD_LDISTRIB; MATRIX_CMUL_RZERO]);; let MSUM_NEG = prove (`!(f:A->real^N^M) s. FINITE s ==> msum s (\i. --(f(i))) = --(msum s f)`, ONCE_REWRITE_TAC[MATRIX_NEG_MINUS1] THEN REWRITE_TAC[MSUM_CMUL]);; let MSUM_SUB = prove (`!f g s. FINITE s ==> (msum s (\x. f(x) - g(x)) = msum s f - msum s g)`, REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN SIMP_TAC[MSUM_ADD; MSUM_CMUL]);; let MSUM_CLAUSES_LEFT = prove (`!f m n. m <= n ==> msum(m..n) f = f(m) + msum(m+1..n) f`, SIMP_TAC[GSYM NUMSEG_LREC; MSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; let MSUM_SUPPORT = prove (`!f s. msum (support (+) f s) f = msum s f`, SIMP_TAC[msum; iterate; SUPPORT_SUPPORT]);; let MSUM_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (msum s f = msum s g)`, REWRITE_TAC[msum] THEN MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_MATRIX_ADD]);; let MSUM_RESTRICT_SET = prove (`!P s f. msum {x:A | x IN s /\ P x} f = msum s (\x. if P x then f(x) else mat 0)`, REWRITE_TAC[msum; GSYM NEUTRAL_MATRIX_ADD] THEN MATCH_MP_TAC ITERATE_RESTRICT_SET THEN REWRITE_TAC[MONOIDAL_MATRIX_ADD]);; let MSUM_SING = prove (`!f x. msum {x} f = f(x)`, SIMP_TAC[MSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; MATRIX_ADD_RID]);; let MSUM_IMAGE = prove (`!f g s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> (msum (IMAGE f s) g = msum s (g o f))`, REWRITE_TAC[msum; GSYM NEUTRAL_MATRIX_ADD] THEN MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_MATRIX_ADD]);; let MSUM_OFFSET = prove (`!p f m n. msum(m+p..n+p) f = msum(m..n) (\i. f(i + p))`, SIMP_TAC[NUMSEG_OFFSET_IMAGE; MSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[o_DEF]);; let MSUM_COMPONENT = prove (`!f:A->real^N^M i j s. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) /\ FINITE s ==> (msum s f)$i$j = sum s (\a. f(a)$i$j)`, REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[MSUM_CLAUSES; SUM_CLAUSES] THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; COND_ID]);; let MSUM_CLAUSES_NUMSEG = prove (`(!m. msum(m..0) f = if m = 0 then f(0) else mat 0) /\ (!m n. msum(m..SUC n) f = if m <= SUC n then msum(m..n) f + f(SUC n) else msum(m..n) f)`, REWRITE_TAC[MATCH_MP ITERATE_CLAUSES_NUMSEG MONOIDAL_MATRIX_ADD; NEUTRAL_MATRIX_ADD; msum]);; let MPOW_ADD = prove (`!A:real^N^N m n. A mpow (m + n) = A mpow m ** A mpow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; mpow; MATRIX_MUL_LID] THEN REWRITE_TAC[MATRIX_MUL_ASSOC]);; let MPOW_1 = prove (`!A:real^N^N. A mpow 1 = A`, REWRITE_TAC[num_CONV `1`; mpow] THEN REWRITE_TAC[SYM(num_CONV `1`); MATRIX_MUL_RID]);; let MPOW_SUC = prove (`!A:real^N^N n. A mpow (SUC n) = A mpow n ** A`, REWRITE_TAC[ADD1; MPOW_ADD; MPOW_1]);; (* ------------------------------------------------------------------------- *) (* The main lemma underlying the proof. *) (* ------------------------------------------------------------------------- *) let MATRIC_POLYFUN_EQ_0 = prove (`!n A:num->real^N^M. (!x. msum(0..n) (\i. x pow i %% A i) = mat 0) <=> (!i. i IN 0..n ==> A i = mat 0)`, SIMP_TAC[CART_EQ; MSUM_COMPONENT; MAT_COMPONENT; LAMBDA_BETA; FINITE_NUMSEG; COND_ID; ONCE_REWRITE_RULE[REAL_MUL_SYM] MATRIX_CMUL_COMPONENT] THEN REWRITE_TAC[MESON[] `(!x i. P i ==> !j. Q j ==> R x i j) <=> (!i. P i ==> !j. Q j ==> !x. R x i j)`] THEN REWRITE_TAC[REAL_POLYFUN_EQ_0] THEN MESON_TAC[]);; let MATRIC_POLY_LEMMA = prove (`!(A:real^N^N) B (C:real^N^N) n. (!x. msum (0..n) (\i. (x pow i) %% B i) ** (A - x %% mat 1) = C) ==> C = mat 0`, SIMP_TAC[GSYM MSUM_MATRIX_RMUL; FINITE_NUMSEG; MATRIX_SUB_LDISTRIB] THEN REWRITE_TAC[MATRIX_MUL_RMUL] THEN ONCE_REWRITE_TAC[MATRIX_MUL_LMUL] THEN ONCE_REWRITE_TAC[MATRIX_CMUL_ASSOC] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN SIMP_TAC[MSUM_SUB; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. msum(0..SUC n) (\i. x pow i %% (((if i = 0 then (--C:real^N^N) else mat 0) + (if i <= n then B i ** (A:real^N^N) else mat 0)) - (if i = 0 then mat 0 else B(i - 1) ** mat 1))) = mat 0` MP_TAC THENL [SIMP_TAC[MATRIX_CMUL_SUB_LDISTRIB; MSUM_SUB; FINITE_NUMSEG; MATRIX_CMUL_ADD_LDISTRIB; MSUM_ADD] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MATRIX_CMUL_RZERO] THEN ONCE_REWRITE_TAC[MESON[] `(if p then mat 0 else x) = (if ~p then x else mat 0)`] THEN REWRITE_TAC[GSYM MSUM_RESTRICT_SET; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `(0 <= i /\ i <= SUC n) /\ i = 0 <=> i = 0`; ARITH_RULE `(0 <= i /\ i <= SUC n) /\ i <= n <=> 0 <= i /\ i <= n`; ARITH_RULE `(0 <= i /\ i <= SUC n) /\ ~(i = 0) <=> 1 <= i /\ i <= SUC n`] THEN REWRITE_TAC[SING_GSPEC; GSYM numseg; MSUM_SING; real_pow] THEN REWRITE_TAC[MATRIX_CMUL_LID] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC ONCE_DEPTH_CONV [GSYM th]) THEN REWRITE_TAC[MATRIX_NEG_SUB] THEN REWRITE_TAC[MATRIX_SUB; AC MATRIX_ADD_AC `(((A:real^N^N) + --B) + B) + C = (--B + B) + A + C`] THEN REWRITE_TAC[MATRIX_ADD_LNEG; MATRIX_ADD_LID] THEN REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[ADD1; MSUM_OFFSET] THEN REWRITE_TAC[ADD_CLAUSES; ADD_SUB; MATRIX_ADD_RNEG]; REWRITE_TAC[MATRIC_POLYFUN_EQ_0; IN_NUMSEG; LE_0] THEN DISCH_TAC THEN SUBGOAL_THEN `!i:num. B(n - i) = (mat 0:real^N^N)` MP_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[LE_REFL; SUB_0; NOT_SUC; ARITH_RULE `~(SUC n <= n)`] THEN REWRITE_TAC[MATRIX_ADD_LID; SUC_SUB1; MATRIX_MUL_RID] THEN REWRITE_TAC[MATRIX_SUB_LZERO; MATRIX_NEG_EQ_0]; X_GEN_TAC `m:num` THEN DISCH_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n - SUC m = n - m \/ m < n`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - m:num`) THEN ASM_SIMP_TAC[ARITH_RULE `m < n ==> ~(n - m = 0)`; ARITH_RULE `n - m <= SUC n /\ n - m <= n`] THEN REWRITE_TAC[MATRIX_MUL_LZERO; MATRIX_ADD_LID; MATRIX_SUB_LZERO] THEN REWRITE_TAC[MATRIX_MUL_RID; MATRIX_NEG_EQ_0] THEN ASM_SIMP_TAC[ARITH_RULE `n - m - 1 = n - SUC m`]]; DISCH_THEN(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[SUB_REFL] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN ASM_REWRITE_TAC[LE_0; MATRIX_MUL_LZERO; MATRIX_ADD_RID] THEN REWRITE_TAC[MATRIX_SUB_RZERO; MATRIX_NEG_EQ_0]]]);; (* ------------------------------------------------------------------------- *) (* Show that cofactor and determinant are n-1 and n degree polynomials. *) (* ------------------------------------------------------------------------- *) let POLYFUN_N_CONST = prove (`!c n. ?b. !x. c = sum(0..n) (\i. b i * x pow i)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\i. if i = 0 then c else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `(0 <= i /\ i <= n) /\ i = 0 <=> i = 0`] THEN REWRITE_TAC[SING_GSPEC; SUM_SING; real_pow; REAL_MUL_RID]);; let POLYFUN_N_ADD = prove (`!f g. (?b. !x. f(x) = sum(0..n) (\i. b i * x pow i)) /\ (?c. !x. g(x) = sum(0..n) (\i. c i * x pow i)) ==> ?d. !x. f(x) + g(x) = sum(0..n) (\i. d i * x pow i)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\i. (b:num->real) i + c i` THEN ASM_REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ADD_RDISTRIB]);; let POLYFUN_N_CMUL = prove (`!f c. (?b. !x. f(x) = sum(0..n) (\i. b i * x pow i)) ==> ?b. !x. c * f(x) = sum(0..n) (\i. b i * x pow i)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\i. c * (b:num->real) i` THEN ASM_REWRITE_TAC[SUM_LMUL; GSYM REAL_MUL_ASSOC]);; let POLYFUN_N_SUM = prove (`!f s. FINITE s /\ (!a. a IN s ==> ?b. !x. f x a = sum(0..n) (\i. b i * x pow i)) ==> ?b. !x. sum s (f x) = sum(0..n) (\i. b i * x pow i)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; FORALL_IN_INSERT; NOT_IN_EMPTY; POLYFUN_N_CONST] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC POLYFUN_N_ADD THEN ASM_SIMP_TAC[]);; let POLYFUN_N_PRODUCT = prove (`!f s n. FINITE s /\ (!a:A. a IN s ==> ?c d. !x. f x a = c + d * x) /\ CARD(s) <= n ==> ?b. !x. product s (f x) = sum(0..n) (\i. b i * x pow i)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; POLYFUN_N_CONST; FORALL_IN_INSERT] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN INDUCT_TAC THENL [ARITH_TAC; REWRITE_TAC[LE_SUC]] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `b:num->real`) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `c:real` (X_CHOOSE_TAC `d:real`)) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `\i. (if i <= n then c * b i else &0) + (if ~(i = 0) then d * b(i - 1) else &0)` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG] THEN REWRITE_TAC[COND_RAND; COND_RATOR; GSYM SUM_LMUL; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `((0 <= i /\ i <= SUC n) /\ i <= n <=> 0 <= i /\ i <= n) /\ ((0 <= i /\ i <= SUC n) /\ ~(i = 0) <=> 1 <= i /\ i <= SUC n)`] THEN REWRITE_TAC[GSYM numseg] THEN REWRITE_TAC[MESON[num_CONV `1`; ADD1] `1..SUC n = 0+1..n+1`] THEN REWRITE_TAC[SUM_OFFSET; ADD_SUB; REAL_POW_ADD] THEN BINOP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REAL_ARITH_TAC);; let COFACTOR_ENTRY_AS_POLYFUN = prove (`!A:real^N^N x i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> ?c. !x. cofactor(A - x %% mat 1)$i$j = sum(0..dimindex(:N)-1) (\i. c(i) * x pow i)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA; det] THEN MATCH_MP_TAC POLYFUN_N_SUM THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; FORALL_IN_GSPEC] THEN X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN MATCH_MP_TAC POLYFUN_N_CMUL THEN SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN ASM_ARITH_TAC; SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG]] THEN ASM_REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN MATCH_MP_TAC POLYFUN_N_CMUL THEN MATCH_MP_TAC POLYFUN_N_PRODUCT THEN SIMP_TAC[CARD_DELETE; FINITE_DELETE; FINITE_NUMSEG] THEN ASM_REWRITE_TAC[IN_NUMSEG; IN_DELETE; CARD_NUMSEG_1; LE_REFL] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN ASM_SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN STRIP_TAC THEN ASM_CASES_TAC `(p:num->num) k = j` THEN ASM_REWRITE_TAC[] THENL [REPEAT(EXISTS_TAC `&0`) THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `a - x * d:real = a + (--d) * x`] THEN MESON_TAC[]);; let DETERMINANT_AS_POLYFUN = prove (`!A:real^N^N. ?c. !x. det(A - x %% mat 1) = sum(0..dimindex(:N)) (\i. c(i) * x pow i)`, GEN_TAC THEN REWRITE_TAC[det] THEN MATCH_MP_TAC POLYFUN_N_SUM THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; FORALL_IN_GSPEC] THEN X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN MATCH_MP_TAC POLYFUN_N_CMUL THEN MATCH_MP_TAC POLYFUN_N_PRODUCT THEN SIMP_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; LE_REFL; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN ASM_SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `a - x * d:real = a + (--d) * x`] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence define characteristic polynomial coefficients. *) (* ------------------------------------------------------------------------- *) let char_poly = new_specification ["char_poly"] (REWRITE_RULE[SKOLEM_THM] DETERMINANT_AS_POLYFUN);; (* ------------------------------------------------------------------------- *) (* Now the Cayley-Hamilton proof. *) (* ------------------------------------------------------------------------- *) let COFACTOR_AS_MATRIC_POLYNOMIAL = prove (`!A:real^N^N. ?C. !x. cofactor(A - x %% mat 1) = msum(0..dimindex(:N)-1) (\i. x pow i %% C i)`, GEN_TAC THEN SIMP_TAC[CART_EQ; MSUM_COMPONENT; FINITE_NUMSEG] THEN MP_TAC(ISPEC `A:real^N^N` COFACTOR_ENTRY_AS_POLYFUN) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[LAMBDA_SKOLEM] THEN DISCH_THEN(X_CHOOSE_THEN `c:(num->real)^N^N` ASSUME_TAC) THEN EXISTS_TAC `(\i. lambda j k. ((c:(num->real)^N^N)$j$k) i):num->real^N^N` THEN MAP_EVERY X_GEN_TAC [`x:real`; `i:num`] THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_CMUL_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);; let MATRIC_POWER_DIFFERENCE = prove (`!A:real^N^N x n. A mpow (SUC n) - x pow (SUC n) %% mat 1 = msum (0..n) (\i. x pow i %% A mpow (n - i)) ** (A - x %% mat 1)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[MSUM_CLAUSES_NUMSEG; real_pow; SUB_0; mpow] THEN REWRITE_TAC[MATRIX_MUL_RID; MATRIX_CMUL_LID; MATRIX_MUL_LID] THEN REWRITE_TAC[REAL_MUL_RID]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(A mpow SUC n - x pow SUC n %% mat 1) ** A + (x pow (SUC n) %% mat 1 :real^N^N) ** (A - x %% mat 1:real^N^N)` THEN CONJ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MPOW_SUC] THEN REWRITE_TAC[MATRIX_SUB_RDISTRIB; MATRIX_SUB_LDISTRIB] THEN REWRITE_TAC[MATRIX_SUB; MATRIX_MUL_LMUL; MATRIX_MUL_LID] THEN REWRITE_TAC[GSYM MATRIX_ADD_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[MATRIX_ADD_ASSOC; MATRIX_ADD_LNEG; MATRIX_ADD_LID] THEN REWRITE_TAC[real_pow; MATRIX_CMUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_AC]; ASM_REWRITE_TAC[MSUM_CLAUSES_NUMSEG; LE_0] THEN REWRITE_TAC[SUB_REFL; mpow; MATRIX_ADD_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[GSYM MSUM_MATRIX_RMUL; FINITE_NUMSEG] THEN MATCH_MP_TAC MSUM_EQ THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_MUL_LMUL] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[ARITH_RULE `i <= n ==> SUC n - i = SUC(n - i)`] THEN REWRITE_TAC[MPOW_SUC; GSYM MATRIX_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB; MATRIX_SUB_RDISTRIB] THEN REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_MUL_LMUL] THEN REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID]]]);; let MATRIC_CHARPOLY_DIFFERENCE = prove (`!A:real^N^N. ?B. !x. msum(0..dimindex(:N)) (\i. char_poly A i %% A mpow i) - sum(0..dimindex(:N)) (\i. char_poly A i * x pow i) %% mat 1 = msum(0..(dimindex(:N)-1)) (\i. x pow i %% B i) ** (A - x %% mat 1)`, GEN_TAC THEN SPEC_TAC(`dimindex(:N)`,`n:num`) THEN SPEC_TAC(`char_poly(A:real^N^N)`,`c:num->real`) THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[MSUM_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG; LE_0] THENL [EXISTS_TAC `(\i. mat 0):num->real^N^N` THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MSUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[real_pow; MATRIX_MUL_LMUL; MATRIX_MUL_LZERO; mpow; REAL_MUL_RID; MATRIX_CMUL_RZERO; MATRIX_SUB_REFL]; FIRST_X_ASSUM(X_CHOOSE_TAC `B:num->real^N^N`) THEN REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_ADD; MATRIX_CMUL_ADD_RDISTRIB] THEN ONCE_REWRITE_TAC[AC MATRIX_ADD_AC `(A + B) + (C + D):real^N^N = (A + C) + (B + D)`] THEN ASM_REWRITE_TAC[GSYM MATRIX_SUB] THEN REWRITE_TAC[GSYM MATRIX_CMUL_ASSOC; GSYM MATRIX_CMUL_SUB_LDISTRIB] THEN REWRITE_TAC[MATRIC_POWER_DIFFERENCE; SUC_SUB1] THEN EXISTS_TAC `(\i. (if i <= n - 1 then B i else mat 0) + c(SUC n) %% A mpow (n - i)):num->real^N^N` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[MATRIX_CMUL_ADD_LDISTRIB] THEN SIMP_TAC[MSUM_ADD; FINITE_NUMSEG; MATRIX_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM MATRIX_MUL_LMUL] THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THENL [REWRITE_TAC[COND_RAND; COND_RATOR; MATRIX_CMUL_RZERO] THEN REWRITE_TAC[GSYM MSUM_RESTRICT_SET; IN_NUMSEG] THEN REWRITE_TAC[numseg; ARITH_RULE `(0 <= i /\ i <= n) /\ i <= n - 1 <=> 0 <= i /\ i <= n - 1`]; SIMP_TAC[GSYM MSUM_CMUL; FINITE_NUMSEG; MATRIX_CMUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_SYM]]]);; let CAYLEY_HAMILTON = prove (`!A:real^N^N. msum(0..dimindex(:N)) (\i. char_poly A i %% A mpow i) = mat 0`, GEN_TAC THEN MATCH_MP_TAC MATRIC_POLY_LEMMA THEN MATCH_MP_TAC(MESON[] `!g. (!x. g x = k) /\ (?a b c. !x. f a b c x = g x) ==> ?a b c. !x. f a b c x = k`) THEN EXISTS_TAC `\x. (msum(0..dimindex(:N)) (\i. char_poly A i %% (A:real^N^N) mpow i) - sum(0..dimindex(:N)) (\i. char_poly A i * x pow i) %% mat 1) + sum(0..dimindex(:N)) (\i. char_poly A i * x pow i) %% mat 1` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[MATRIX_SUB; GSYM MATRIX_ADD_ASSOC; MATRIX_ADD_LNEG] THEN REWRITE_TAC[MATRIX_ADD_RID]; X_CHOOSE_THEN `B:num->real^N^N` (fun th -> ONCE_REWRITE_TAC[th]) (ISPEC `A:real^N^N` MATRIC_CHARPOLY_DIFFERENCE) THEN REWRITE_TAC[GSYM char_poly; GSYM MATRIX_MUL_LEFT_COFACTOR] THEN REWRITE_TAC[GSYM MATRIX_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM COFACTOR_TRANSP; TRANSP_MATRIX_SUB] THEN REWRITE_TAC[TRANSP_MATRIX_CMUL; TRANSP_MAT] THEN X_CHOOSE_THEN `C:num->real^N^N` (fun th -> ONCE_REWRITE_TAC[th]) (ISPEC `transp A:real^N^N` COFACTOR_AS_MATRIC_POLYNOMIAL) THEN MAP_EVERY EXISTS_TAC [`A:real^N^N`; `(\i. B i + C i):num->real^N^N`; `dimindex(:N)-1`] THEN SIMP_TAC[GSYM MSUM_ADD; FINITE_NUMSEG; MATRIX_CMUL_ADD_LDISTRIB]]);; hol-light/100/ceva.ml000066400000000000000000000246121303454263000145220ustar00rootroot00000000000000(* ========================================================================= *) (* #61: Ceva's theorem. *) (* ========================================================================= *) needs "Multivariate/convex.ml";; needs "Examples/sos.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* We use the notion of "betweenness". *) (* ------------------------------------------------------------------------- *) let BETWEEN_THM = prove (`between x (a,b) <=> ?u. &0 <= u /\ u <= &1 /\ x = u % a + (&1 - u) % b`, REWRITE_TAC[BETWEEN_IN_CONVEX_HULL] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN REWRITE_TAC[CONVEX_HULL_2_ALT; IN_ELIM_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Lemmas to reduce geometric concepts to more convenient forms. *) (* ------------------------------------------------------------------------- *) let NORM_CROSS = prove (`norm(a) * norm(b) * norm(c) = norm(d) * norm(e) * norm(f) <=> (a dot a) * (b dot b) * (c dot c) = (d dot d) * (e dot e) * (f dot f)`, let lemma = prove (`!x y. &0 <= x /\ &0 <= y ==> (x pow 2 = y pow 2 <=> x = y)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_POW_2] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN ASM_MESON_TAC[REAL_LT_MUL2; REAL_LT_REFL]) in REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_MUL] THEN MATCH_MP_TAC(GSYM lemma) THEN SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]);; let COLLINEAR = prove (`!a b c:real^2. collinear {a:real^2,b,c} <=> ((a$1 - b$1) * (b$2 - c$2) = (a$2 - b$2) * (b$1 - c$1))`, let lemma = prove (`~(y1 = &0) /\ x2 * y1 = x1 * y2 ==> ?c. x1 = c * y1 /\ x2 = c * y2`, STRIP_TAC THEN EXISTS_TAC `x1 / y1` THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD) in REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^2 = b` THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_MUL_LZERO] THEN REWRITE_TAC[COLLINEAR_SING; COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN REWRITE_TAC[collinear] THEN EQ_TAC THENL [DISCH_THEN(CHOOSE_THEN (fun th -> MP_TAC(SPECL [`a:real^2`; `b:real^2`] th) THEN MP_TAC(SPECL [`b:real^2`; `c:real^2`] th))) THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `a - b:real^2` THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; ARITH; DE_MORGAN_THM] THEN STRIP_TAC THEN SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; ARITH] THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN FIRST_X_ASSUM(CONJUNCTS_THEN(REPEAT_TCL STRIP_THM_THEN SUBST1_TAC)) THEN MATCH_MP_TAC lemma THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* More or less automatic proof of the main direction. *) (* ------------------------------------------------------------------------- *) let CEVA_WEAK = prove (`!A B C X Y Z P:real^2. ~(collinear {A,B,C}) /\ between X (B,C) /\ between Y (A,C) /\ between Z (A,B) /\ between P (A,X) /\ between P (B,Y) /\ between P (C,Z) ==> dist(B,X) * dist(C,Y) * dist(A,Z) = dist(X,C) * dist(Y,A) * dist(Z,B)`, REPEAT GEN_TAC THEN REWRITE_TAC[dist; NORM_CROSS; COLLINEAR; BETWEEN_THM] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o check (is_var o lhs o concl))) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* More laborious proof of equivalence. *) (* ------------------------------------------------------------------------- *) let CEVA = prove (`!A B C X Y Z:real^2. ~(collinear {A,B,C}) /\ between X (B,C) /\ between Y (C,A) /\ between Z (A,B) ==> (dist(B,X) * dist(C,Y) * dist(A,Z) = dist(X,C) * dist(Y,A) * dist(Z,B) <=> (?P. between P (A,X) /\ between P (B,Y) /\ between P (C,Z)))`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`A:real^2 = B`; `A:real^2 = C`; `B:real^2 = C`] THEN ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[BETWEEN_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `x:real`) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `y:real`) (X_CHOOSE_TAC `z:real`)) THEN REPEAT(FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC)) THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN REWRITE_TAC[dist] THEN REWRITE_TAC[VECTOR_ARITH `B - (x % B + (&1 - x) % C) = (&1 - x) % (B - C)`; VECTOR_ARITH `(x % B + (&1 - x) % C) - C = x % (B - C)`] THEN REWRITE_TAC[NORM_MUL] THEN REWRITE_TAC[REAL_ARITH `(a * a') * (b * b') * (c * c') = (a * b * c) * (a' * b' * c')`] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_MUL_RCANCEL; REAL_ENTIRE] THEN ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= &1 - x <=> x <= &1`; real_abs] THEN EQ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR]) THEN SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; FORALL_2; VECTOR_ADD_COMPONENT; CART_EQ; VECTOR_MUL_COMPONENT; ARITH] THEN CONV_TAC REAL_RING] THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN SUBGOAL_THEN `?u v w. w = (&1 - u) * (&1 - x) /\ v = (&1 - u) * x /\ u = (&1 - v) * (&1 - y) /\ u = (&1 - w) * z /\ v = (&1 - w) * (&1 - z) /\ w = (&1 - v) * y /\ &0 <= u /\ u <= &1 /\ &0 <= v /\ v <= &1 /\ &0 <= w /\ w <= &1` (STRIP_ASSUME_TAC o GSYM) THENL [ALL_TAC; EXISTS_TAC `u % A + v % B + w % C:real^2` THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`; EXISTS_TAC `w:real`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC] THEN REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(MESON[] `(!x. p x /\ q x ==> r x) /\ (?x. p x /\ q x) ==> (?x. p x /\ q x /\ r x)`) THEN CONJ_TAC THENL [GEN_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_neg o concl))) THEN REWRITE_TAC[IMP_IMP] THEN REPEAT(MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ (a /\ b /\ c ==> d) ==> a ==> b /\ c /\ d`) THEN CONJ_TAC THENL [CONV_TAC REAL_RING ORELSE CONV_TAC REAL_SOS; ALL_TAC]) THEN CONV_TAC REAL_SOS; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR]) THEN ASM_CASES_TAC `x = &0` THENL [EXISTS_TAC `&1 - y / (&1 - x + x * y)` THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_neg o concl))) THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN EXISTS_TAC `&1 - (&1 - z) / (x + (&1 - x) * (&1 - z))` THEN SUBGOAL_THEN `~(x + (&1 - x) * (&1 - z) = &0)` MP_TAC THENL [ALL_TAC; REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_neg o concl))) THEN CONV_TAC REAL_FIELD] THEN MATCH_MP_TAC(REAL_ARITH `z * (&1 - x) < &1 ==> ~(x + (&1 - x) * (&1 - z) = &0)`) THEN ASM_CASES_TAC `z = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LT_01] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1 * (&1 - x)` THEN ASM_SIMP_TAC[REAL_LE_RMUL; REAL_ARITH `x <= &1 ==> &0 <= &1 - x`] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Just for geometric intuition, verify metrical version of "between". *) (* This isn't actually needed in the proof. Moreover, this is now actually *) (* the definition of "between" so this is all a relic. *) (* ------------------------------------------------------------------------- *) let BETWEEN_SYM = prove (`!u v w. between v (u,w) <=> between v (w,u)`, REPEAT GEN_TAC THEN REWRITE_TAC[BETWEEN_THM] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN TRY VECTOR_ARITH_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let BETWEEN_METRICAL = prove (`!u v w:real^N. between v (u,w) <=> dist(u,v) + dist(v,w) = dist(u,w)`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[BETWEEN_SYM] THEN REWRITE_TAC[BETWEEN_THM; dist] THEN REWRITE_TAC[VECTOR_ARITH `x % u + (&1 - x) % v = v + x % (u - v)`] THEN SUBST1_TAC(VECTOR_ARITH `u - w:real^N = (u - v) + (v - w)`) THEN CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[NORM_TRIANGLE_EQ] THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `u - (u + x):real^N = --x`; NORM_NEG; VECTOR_ARITH `(u + c % (w - u)) - w = (&1 - c) % (u - w)`] THEN REWRITE_TAC[VECTOR_ARITH `a % --(c % (x - y)) = (a * c) % (y - x)`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; NORM_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `c <= &1 ==> abs(&1 - c) = &1 - c`; REAL_ARITH `&0 <= c ==> abs c = c`] THEN REWRITE_TAC[NORM_SUB; REAL_MUL_AC]] THEN DISCH_TAC THEN ASM_CASES_TAC `&0 < norm(u - v:real^N) + norm(v - w)` THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `~(&0 < x + y) ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN REWRITE_TAC[NORM_POS_LE; NORM_EQ_0; VECTOR_SUB_EQ] THEN STRIP_TAC THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS] THEN VECTOR_ARITH_TAC] THEN EXISTS_TAC `norm(u - v:real^N) / (norm(u - v) + norm(v - w))` THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_MUL_LZERO; REAL_MUL_LID; REAL_LE_ADDR; NORM_POS_LE] THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(u - v:real^N) + norm(v - w)` THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `x % (y + z % v) = x % y + (x * z) % v`] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_LMUL] THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN VECTOR_ARITH_TAC);; hol-light/100/chords.ml000066400000000000000000000055711303454263000150710ustar00rootroot00000000000000(* ========================================================================= *) (* #55: Theorem on product of segments of chords. *) (* ========================================================================= *) needs "Multivariate/convex.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Geometric concepts. *) (* ------------------------------------------------------------------------- *) let BETWEEN_THM = prove (`between x (a,b) <=> ?u. &0 <= u /\ u <= &1 /\ x = u % a + (&1 - u) % b`, REWRITE_TAC[BETWEEN_IN_CONVEX_HULL] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN REWRITE_TAC[CONVEX_HULL_2_ALT; IN_ELIM_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; let length = new_definition `length(A:real^2,B:real^2) = norm(B - A)`;; (* ------------------------------------------------------------------------- *) (* One more special reduction theorem to avoid square roots. *) (* ------------------------------------------------------------------------- *) let lemma = prove (`!x y. &0 <= x /\ &0 <= y ==> (x pow 2 = y pow 2 <=> x = y)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_POW_2] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN ASM_MESON_TAC[REAL_LT_MUL2; REAL_LT_REFL]);; let NORM_CROSS = prove (`norm(a) * norm(b) = norm(c) * norm(d) <=> (a dot a) * (b dot b) = (c dot c) * (d dot d)`, REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_MUL] THEN MATCH_MP_TAC(GSYM lemma) THEN SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]);; (* ------------------------------------------------------------------------- *) (* Now the main theorem. *) (* ------------------------------------------------------------------------- *) let SEGMENT_CHORDS = prove (`!centre radius q r s t b. between b (q,r) /\ between b (s,t) /\ length(q,centre) = radius /\ length(r,centre) = radius /\ length(s,centre) = radius /\ length(t,centre) = radius ==> length(q,b) * length(b,r) = length(s,b) * length(b,t)`, REPEAT GEN_TAC THEN REWRITE_TAC[length; NORM_CROSS; BETWEEN_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) MP_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) MP_TAC) THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (MP_TAC o AP_TERM `\x. x pow 2`)) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN REWRITE_TAC[NORM_POW_2] THEN ABBREV_TAC `rad = radius pow 2` THEN POP_ASSUM_LIST(K ALL_TAC) THEN SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN CONV_TAC REAL_RING);; hol-light/100/circle.ml000066400000000000000000000161371303454263000150500ustar00rootroot00000000000000(* ========================================================================= *) (* Area of a circle. *) (* ========================================================================= *) needs "Multivariate/measure.ml";; needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* Circle area. Should maybe extend WLOG tactics for such scaling. *) (* ------------------------------------------------------------------------- *) let AREA_UNIT_CBALL = prove (`measure(cball(vec 0:real^2,&1)) = pi`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE[`:1`,`:M`; `:2`,`:N`] FUBINI_SIMPLE_COMPACT) THEN EXISTS_TAC `1` THEN SIMP_TAC[DIMINDEX_1; DIMINDEX_2; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN SUBGOAL_THEN `!t. abs(t) <= &1 <=> t IN real_interval[-- &1,&1]` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; BALL_1] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. &2 * sqrt(&1 - t pow 2)` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN SIMP_TAC[IN_REAL_INTERVAL; MEASURE_INTERVAL] THEN REWRITE_TAC[REAL_BOUNDS_LE; VECTOR_ADD_LID; VECTOR_SUB_LZERO] THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) CONTENT_1 o rand o snd) THEN REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[REAL_POW_ONE] THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> --x <= x`) THEN ASM_SIMP_TAC[SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. asn(x) + x * sqrt(&1 - x pow 2)`; `\x. &2 * sqrt(&1 - x pow 2)`; `-- &1`; `&1`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN REWRITE_TAC[ASN_1; ASN_NEG_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_0; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `x / &2 - --(x / &2) = x`] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN SIMP_TAC[REAL_CONTINUOUS_ON_ASN; IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_POW; REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SQRT THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN REWRITE_TAC[REAL_ARITH `&0 <= &1 - x <=> x <= &1 pow 2`] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM] THEN REAL_ARITH_TAC; REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LT] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID; REAL_POW_1; REAL_MUL_RID] THEN REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RNEG; REAL_INV_MUL] THEN ASM_REWRITE_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1] THEN MATCH_MP_TAC(REAL_FIELD `s pow 2 = &1 - x pow 2 /\ x pow 2 < &1 ==> (inv s + x * --(&2 * x) * inv (&2) * inv s + s) = &2 * s`) THEN ASM_SIMP_TAC[ABS_SQUARE_LT_1; SQRT_POW_2; REAL_SUB_LE; REAL_LT_IMP_LE]]);; let AREA_CBALL = prove (`!z:real^2 r. &0 <= r ==> measure(cball(z,r)) = pi * r pow 2`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `r = &0` THENL [ASM_SIMP_TAC[CBALL_SING; REAL_POW_2; REAL_MUL_RZERO] THEN MATCH_MP_TAC MEASURE_UNIQUE THEN REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_SING]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`cball(vec 0:real^2,&1)`; `r:real`; `z:real^2`; `pi`] HAS_MEASURE_AFFINITY) THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_CBALL; AREA_UNIT_CBALL] THEN ASM_REWRITE_TAC[real_abs; DIMINDEX_2] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_CBALL_0; IN_IMAGE] THEN REWRITE_TAC[IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(z,a + z) = norm a`; NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `abs r * x <= r <=> abs r * x <= r * &1`] THEN ASM_SIMP_TAC[real_abs; REAL_LE_LMUL; dist] THEN X_GEN_TAC `w:real^2` THEN DISCH_TAC THEN EXISTS_TAC `inv(r) % (w - z):real^2` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_REWRITE_TAC[real_abs] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[]);; let AREA_BALL = prove (`!z:real^2 r. &0 <= r ==> measure(ball(z,r)) = pi * r pow 2`, SIMP_TAC[GSYM INTERIOR_CBALL; GSYM AREA_CBALL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; (* ------------------------------------------------------------------------- *) (* Volume of a ball too, just for fun. *) (* ------------------------------------------------------------------------- *) let VOLUME_CBALL = prove (`!z:real^3 r. &0 <= r ==> measure(cball(z,r)) = &4 / &3 * pi * r pow 3`, GEOM_ORIGIN_TAC `z:real^3` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_COMPACT) THEN EXISTS_TAC `1` THEN SIMP_TAC[DIMINDEX_2; DIMINDEX_3; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN SUBGOAL_THEN `!t. abs(t) <= r <=> t IN real_interval[--r,r]` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`]; ALL_TAC] THEN MP_TAC(ISPECL [`\t. pi * (r pow 2 * t - &1 / &3 * t pow 3)`; `\t. pi * (r pow 2 - t pow 2)`; `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC REAL_RING]);; let VOLUME_BALL = prove (`!z:real^3 r. &0 <= r ==> measure(ball(z,r)) = &4 / &3 * pi * r pow 3`, SIMP_TAC[GSYM INTERIOR_CBALL; GSYM VOLUME_CBALL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; hol-light/100/combinations.ml000066400000000000000000000130251303454263000162650ustar00rootroot00000000000000(* ========================================================================= *) (* Binomial coefficients and relation to number of combinations. *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* Binomial coefficients. *) (* ------------------------------------------------------------------------- *) let binom = define `(!n. binom(n,0) = 1) /\ (!k. binom(0,SUC(k)) = 0) /\ (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; let BINOM_LT = prove (`!n k. n < k ==> (binom(n,k) = 0)`, INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; let BINOM_REFL = prove (`!n. binom(n,n) = 1`, INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; (* ------------------------------------------------------------------------- *) (* Usual "factorial" definition. *) (* ------------------------------------------------------------------------- *) let BINOM_FACT = prove (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; let BINOM_EXPLICIT = prove (`!n k. binom(n,k) = if n < k then 0 else FACT(n) DIV (FACT(k) * FACT(n - k))`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[BINOM_LT] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_LT; LE_EXISTS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN SIMP_TAC[LT_MULT; FACT_LT; ADD_CLAUSES] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM BINOM_FACT] THEN REWRITE_TAC[MULT_AC]);; (* ------------------------------------------------------------------------- *) (* A tedious lemma. *) (* ------------------------------------------------------------------------- *) let lemma = prove (`~(a IN t) ==> {u | u SUBSET (a:A INSERT t) /\ u HAS_SIZE (SUC m)} = {u | u SUBSET t /\ u HAS_SIZE (SUC m)} UNION IMAGE (\u. a INSERT u) {u | u SUBSET t /\ u HAS_SIZE m}`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `u:A->bool` THEN ASM_CASES_TAC `(u:A->bool) SUBSET t` THEN ASM_REWRITE_TAC[] THENL [ASM_CASES_TAC `(u:A->bool) HAS_SIZE (SUC m)` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC `u DELETE (a:A)` THEN REPEAT (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_SIZE_SUC]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MATCH_MP_TAC) THEN ASM SET_TAC[]; CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE_CLAUSES] THEN EXISTS_TAC `a:A` THEN EXISTS_TAC `x':A->bool` THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The "number of combinations" formula. *) (* ------------------------------------------------------------------------- *) let BINOM_INDUCT = prove (`!P. (!n. P n 0) /\ (!k. P 0 (SUC k)) /\ (!n k. P n (SUC k) /\ P n k ==> P (SUC n) (SUC k)) ==> !m n. P m n`, GEN_TAC THEN STRIP_TAC THEN REPEAT INDUCT_TAC THEN ASM_MESON_TAC[]);; let NUMBER_OF_COMBINATIONS = prove (`!n m s:A->bool. s HAS_SIZE n ==> {t | t SUBSET s /\ t HAS_SIZE m} HAS_SIZE binom(n,m)`, MATCH_MP_TAC BINOM_INDUCT THEN REWRITE_TAC[binom] THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN CONV_TAC HAS_SIZE_CONV THEN EXISTS_TAC `{}:A->bool` THEN SIMP_TAC[EXTENSION; IN_SING; IN_ELIM_THM] THEN REWRITE_TAC[NOT_IN_EMPTY; HAS_SIZE_0] THEN SET_TAC[]; SIMP_TAC[HAS_SIZE_0; SUBSET_EMPTY; HAS_SIZE_SUC] THEN SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `m:num`] THEN STRIP_TAC THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_SIZE_CLAUSES] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:A`; `t:A->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC HAS_SIZE_UNION THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `~(a:A IN t)` THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; HAS_SIZE_SUC] THEN UNDISCH_TAC `~(a:A IN t)` THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Explicit version. *) (* ------------------------------------------------------------------------- *) let NUMBER_OF_COMBINATIONS_EXPLICIT = prove (`!n m s:A->bool. s HAS_SIZE n ==> {t | t SUBSET s /\ t HAS_SIZE m} HAS_SIZE (if n < m then 0 else FACT(n) DIV (FACT(m) * FACT(n - m)))`, REWRITE_TAC[REWRITE_RULE[BINOM_EXPLICIT] NUMBER_OF_COMBINATIONS]);; hol-light/100/constructible.ml000066400000000000000000001236471303454263000164740ustar00rootroot00000000000000(* ========================================================================= *) (* Non-constructibility of irrational cubic equation solutions. *) (* *) (* This gives the two classic impossibility results: trisecting an angle or *) (* constructing the cube using traditional geometric constructions. *) (* *) (* This elementary proof (not using field extensions etc.) is taken from *) (* Dickson's "First Course in the Theory of Equations", chapter III. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/floor.ml";; needs "Multivariate/transcendentals.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* The critical lemma. *) (* ------------------------------------------------------------------------- *) let STEP_LEMMA = prove (`!P. (!n. P(&n)) /\ (!x. P x ==> P(--x)) /\ (!x. P x /\ ~(x = &0) ==> P(inv x)) /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!x y. P x /\ P y ==> P(x * y)) ==> !a b c z u v s. P a /\ P b /\ P c /\ z pow 3 + a * z pow 2 + b * z + c = &0 /\ P u /\ P v /\ P(s * s) /\ z = u + v * s ==> ?w. P w /\ w pow 3 + a * w pow 2 + b * w + c = &0`, REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `v * s = &0` THENL [ASM_REWRITE_TAC[REAL_ADD_RID] THEN MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MAP_EVERY ABBREV_TAC [`A = a * s pow 2 * v pow 2 + &3 * s pow 2 * u * v pow 2 + a * u pow 2 + u pow 3 + b * u + c`; `B = s pow 2 * v pow 3 + &2 * a * u * v + &3 * u pow 2 * v + b * v`] THEN SUBGOAL_THEN `A + B * s = &0` ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC REAL_RING; ALL_TAC] THEN ASM_CASES_TAC `(P:real->bool) s` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `B = &0` ASSUME_TAC THENL [UNDISCH_TAC `~P(s:real)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_FIELD `A + B * s = &0 ==> ~(B = &0) ==> s = --A / B`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[real_div] THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXPAND_TAC ["A"; "B"] THEN REWRITE_TAC[REAL_ARITH `x pow 3 = x * x * x`; REAL_POW_2] THEN REPEAT(FIRST_ASSUM MATCH_ACCEPT_TAC ORELSE (FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC)); ALL_TAC] THEN EXISTS_TAC `--(a + &2 * u)` THEN ASM_SIMP_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check ((not) o is_forall o concl))) THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Instantiate to square roots. *) (* ------------------------------------------------------------------------- *) let STEP_LEMMA_SQRT = prove (`!P. (!n. P(&n)) /\ (!x. P x ==> P(--x)) /\ (!x. P x /\ ~(x = &0) ==> P(inv x)) /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!x y. P x /\ P y ==> P(x * y)) ==> !a b c z u v s. P a /\ P b /\ P c /\ z pow 3 + a * z pow 2 + b * z + c = &0 /\ P u /\ P v /\ P(s) /\ &0 <= s /\ z = u + v * sqrt(s) ==> ?w. P w /\ w pow 3 + a * w pow 2 + b * w + c = &0`, GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP STEP_LEMMA) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SQRT_POW_2; REAL_POW_2]);; (* ------------------------------------------------------------------------- *) (* Numbers definable by radicals involving square roots only. *) (* ------------------------------------------------------------------------- *) let radical_RULES,radical_INDUCT,radical_CASES = new_inductive_definition `(!x. rational x ==> radical x) /\ (!x. radical x ==> radical (--x)) /\ (!x. radical x /\ ~(x = &0) ==> radical (inv x)) /\ (!x y. radical x /\ radical y ==> radical (x + y)) /\ (!x y. radical x /\ radical y ==> radical (x * y)) /\ (!x. radical x /\ &0 <= x ==> radical (sqrt x))`;; let RADICAL_RULES = prove (`(!n. radical(&n)) /\ (!x. rational x ==> radical x) /\ (!x. radical x ==> radical (--x)) /\ (!x. radical x /\ ~(x = &0) ==> radical (inv x)) /\ (!x y. radical x /\ radical y ==> radical (x + y)) /\ (!x y. radical x /\ radical y ==> radical (x - y)) /\ (!x y. radical x /\ radical y ==> radical (x * y)) /\ (!x y. radical x /\ radical y /\ ~(y = &0) ==> radical (x / y)) /\ (!x n. radical x ==> radical(x pow n)) /\ (!x. radical x /\ &0 <= x ==> radical (sqrt x))`, SIMP_TAC[real_div; real_sub; radical_RULES; RATIONAL_NUM] THEN GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[radical_RULES; real_pow; RATIONAL_NUM]);; let RADICAL_TAC = REPEAT(MATCH_ACCEPT_TAC (CONJUNCT1 RADICAL_RULES) ORELSE (MAP_FIRST MATCH_MP_TAC(tl(tl(CONJUNCTS RADICAL_RULES))) THEN REPEAT CONJ_TAC));; (* ------------------------------------------------------------------------- *) (* Explicit "expressions" to support inductive proof. *) (* ------------------------------------------------------------------------- *) let expression_INDUCT,expression_RECURSION = define_type "expression = Constant real | Negation expression | Inverse expression | Addition expression expression | Multiplication expression expression | Sqrt expression";; (* ------------------------------------------------------------------------- *) (* Interpretation. *) (* ------------------------------------------------------------------------- *) let value = define `(value(Constant x) = x) /\ (value(Negation e) = --(value e)) /\ (value(Inverse e) = inv(value e)) /\ (value(Addition e1 e2) = value e1 + value e2) /\ (value(Multiplication e1 e2) = value e1 * value e2) /\ (value(Sqrt e) = sqrt(value e))`;; (* ------------------------------------------------------------------------- *) (* Wellformedness of an expression. *) (* ------------------------------------------------------------------------- *) let wellformed = define `(wellformed(Constant x) <=> rational x) /\ (wellformed(Negation e) <=> wellformed e) /\ (wellformed(Inverse e) <=> ~(value e = &0) /\ wellformed e) /\ (wellformed(Addition e1 e2) <=> wellformed e1 /\ wellformed e2) /\ (wellformed(Multiplication e1 e2) <=> wellformed e1 /\ wellformed e2) /\ (wellformed(Sqrt e) <=> &0 <= value e /\ wellformed e)`;; (* ------------------------------------------------------------------------- *) (* The set of radicals in an expression. *) (* ------------------------------------------------------------------------- *) let radicals = define `(radicals(Constant x) = {}) /\ (radicals(Negation e) = radicals e) /\ (radicals(Inverse e) = radicals e) /\ (radicals(Addition e1 e2) = (radicals e1) UNION (radicals e2)) /\ (radicals(Multiplication e1 e2) = (radicals e1) UNION (radicals e2)) /\ (radicals(Sqrt e) = e INSERT (radicals e))`;; let FINITE_RADICALS = prove (`!e. FINITE(radicals e)`, MATCH_MP_TAC expression_INDUCT THEN SIMP_TAC[radicals; FINITE_RULES; FINITE_UNION]);; let WELLFORMED_RADICALS = prove (`!e. wellformed e ==> !r. r IN radicals(e) ==> &0 <= value r`, MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[radicals; wellformed; NOT_IN_EMPTY; IN_UNION; IN_INSERT] THEN MESON_TAC[]);; let RADICALS_WELLFORMED = prove (`!e. wellformed e ==> !r. r IN radicals e ==> wellformed r`, MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[radicals; wellformed; NOT_IN_EMPTY; IN_UNION; IN_INSERT] THEN MESON_TAC[]);; let RADICALS_SUBSET = prove (`!e r. r IN radicals e ==> radicals(r) SUBSET radicals(e)`, MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[radicals; IN_UNION; NOT_IN_EMPTY; IN_INSERT; SUBSET] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Show that every radical is the interpretation of a wellformed expresion. *) (* ------------------------------------------------------------------------- *) let RADICAL_EXPRESSION = prove (`!x. radical x <=> ?e. wellformed e /\ x = value e`, GEN_TAC THEN EQ_TAC THEN SPEC_TAC(`x:real`,`x:real`) THENL [MATCH_MP_TAC radical_INDUCT THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_MESON_TAC[value; wellformed]; SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[value; wellformed] THEN SIMP_TAC[radical_RULES]]);; (* ------------------------------------------------------------------------- *) (* Nesting depth of radicals in an expression. *) (* ------------------------------------------------------------------------- *) let LT_MAX = prove (`!a b c. a < MAX b c <=> a < b \/ a < c`, ARITH_TAC);; let depth = define `(depth(Constant x) = 0) /\ (depth(Negation e) = depth e) /\ (depth(Inverse e) = depth e) /\ (depth(Addition e1 e2) = MAX (depth e1) (depth e2)) /\ (depth(Multiplication e1 e2) = MAX (depth e1) (depth e2)) /\ (depth(Sqrt e) = 1 + depth e)`;; let IN_RADICALS_SMALLER = prove (`!r s. s IN radicals(r) ==> depth(s) < depth(r)`, MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[radicals; depth] THEN REWRITE_TAC[IN_UNION; NOT_IN_EMPTY; IN_INSERT; LT_MAX] THEN MESON_TAC[ARITH_RULE `s = a \/ s < a ==> s < 1 + a`]);; let NOT_IN_OWN_RADICALS = prove (`!r. ~(r IN radicals r)`, MESON_TAC[IN_RADICALS_SMALLER; LT_REFL]);; let RADICALS_EMPTY_RATIONAL = prove (`!e. wellformed e /\ radicals e = {} ==> rational(value e)`, MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[wellformed; value; radicals; EMPTY_UNION; NOT_INSERT_EMPTY] THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[RATIONAL_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Crucial point about splitting off some "topmost" radical. *) (* ------------------------------------------------------------------------- *) let FINITE_MAX = prove (`!s. FINITE s ==> ~(s = {}) ==> ?b:num. b IN s /\ !a. a IN s ==> a <= b`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_INSERT_EMPTY; IN_INSERT] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `s:num->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; UNWIND_THM2; LE_REFL] THEN REWRITE_TAC[RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2] THEN MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; let RADICAL_TOP = prove (`!e. ~(radicals e = {}) ==> ?r. r IN radicals e /\ !s. s IN radicals(e) ==> ~(r IN radicals s)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `IMAGE depth (radicals e)` FINITE_MAX) THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY; FINITE_IMAGE; FINITE_RADICALS] THEN REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN MESON_TAC[IN_RADICALS_SMALLER; NOT_LT]);; (* ------------------------------------------------------------------------- *) (* By rearranging the expression we can use it in a canonical way. *) (* ------------------------------------------------------------------------- *) let RADICAL_CANONICAL_TRIVIAL = prove (`!e r. (r IN radicals e ==> (?a b. wellformed a /\ wellformed b /\ value e = value a + value b * sqrt (value r) /\ radicals a SUBSET radicals e DELETE r /\ radicals b SUBSET radicals e DELETE r /\ radicals r SUBSET radicals e DELETE r)) ==> wellformed e ==> ?a b. wellformed a /\ wellformed b /\ value e = value a + value b * sqrt (value r) /\ radicals a SUBSET (radicals e UNION radicals r) DELETE r /\ radicals b SUBSET (radicals e UNION radicals r) DELETE r /\ radicals r SUBSET (radicals e UNION radicals r) DELETE r`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r IN radicals e` THEN ASM_SIMP_TAC[] THENL [DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SET_TAC[]; DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`e:expression`; `Constant(&0)`] THEN ASM_REWRITE_TAC[wellformed; value; radicals] THEN REWRITE_TAC[RATIONAL_NUM; REAL_MUL_LZERO; REAL_ADD_RID] THEN UNDISCH_TAC `~(r IN radicals e)` THEN MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN SET_TAC[]]);; let RADICAL_CANONICAL = prove (`!e. wellformed e /\ ~(radicals e = {}) ==> ?r. r IN radicals(e) /\ ?a b. wellformed(Addition a (Multiplication b (Sqrt r))) /\ value e = value(Addition a (Multiplication b (Sqrt r))) /\ (radicals a) SUBSET (radicals(e) DELETE r) /\ (radicals b) SUBSET (radicals(e) DELETE r) /\ (radicals r) SUBSET (radicals(e) DELETE r)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP RADICAL_TOP) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:expression` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= value r /\ wellformed r` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[WELLFORMED_RADICALS; RADICALS_WELLFORMED]; ALL_TAC] THEN MAP_EVERY UNDISCH_TAC [`wellformed e`; `r IN radicals e`] THEN ASM_REWRITE_TAC[IMP_IMP; wellformed; value; GSYM CONJ_ASSOC] THEN SPEC_TAC(`e:expression`,`e:expression`) THEN MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[wellformed; radicals; value; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_INSERT; IN_UNION] THEN REPEAT CONJ_TAC THEN X_GEN_TAC `e1:expression` THEN TRY(X_GEN_TAC `e2:expression`) THENL [DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:expression`; `b:expression`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`Negation a`; `Negation b`] THEN ASM_REWRITE_TAC[value; wellformed; radicals] THEN REAL_ARITH_TAC; DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:expression`; `b:expression`] THEN ASM_CASES_TAC `value b * sqrt(value r) = value a` THENL [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MAP_EVERY EXISTS_TAC [`Inverse(Multiplication (Constant(&2)) a)`; `Constant(&0)`] THEN ASM_REWRITE_TAC[value; radicals; wellformed] THEN REWRITE_TAC[RATIONAL_NUM; EMPTY_SUBSET; CONJ_ASSOC] THEN CONJ_TAC THENL [UNDISCH_TAC `~(value a + value a = &0)` THEN CONV_TAC REAL_FIELD; REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]]; ALL_TAC] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`Multiplication a (Inverse (Addition (Multiplication a a) (Multiplication (Multiplication b b) (Negation r))))`; `Multiplication (Negation b) (Inverse (Addition (Multiplication a a) (Multiplication (Multiplication b b) (Negation r))))`] THEN ASM_REWRITE_TAC[value; wellformed; radicals; UNION_SUBSET] THEN UNDISCH_TAC `~(value b * sqrt (value r) = value a)` THEN UNDISCH_TAC `~(value e1 = &0)` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP SQRT_POW_2) THEN CONV_TAC REAL_FIELD; REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP RADICAL_CANONICAL_TRIVIAL)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a1:expression`; `b1:expression`; `a2:expression`; `b2:expression`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`Addition a1 a2`; `Addition b1 b2`] THEN ASM_REWRITE_TAC[value; wellformed; radicals] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN MP_TAC(SPECL [`e1:expression`; `r:expression`] RADICALS_SUBSET) THEN MP_TAC(SPECL [`e2:expression`; `r:expression`] RADICALS_SUBSET) THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP RADICAL_CANONICAL_TRIVIAL)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a1:expression`; `b1:expression`; `a2:expression`; `b2:expression`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`Addition (Multiplication a1 a2) (Multiplication (Multiplication b1 b2) r)`; `Addition (Multiplication a1 b2) (Multiplication a2 b1)`] THEN ASM_REWRITE_TAC[value; wellformed; radicals] THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP SQRT_POW_2) THEN CONV_TAC REAL_RING; ALL_TAC] THEN MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN MP_TAC(SPECL [`e1:expression`; `r:expression`] RADICALS_SUBSET) THEN MP_TAC(SPECL [`e2:expression`; `r:expression`] RADICALS_SUBSET) THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN MAP_EVERY EXISTS_TAC [`Constant(&0)`; `Constant(&1)`] THEN REWRITE_TAC[wellformed; value; REAL_ADD_LID; REAL_MUL_LID] THEN REWRITE_TAC[radicals; RATIONAL_NUM] THEN MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Now we quite easily get an inductive argument. *) (* ------------------------------------------------------------------------- *) let CUBIC_ROOT_STEP = prove (`!a b c. rational a /\ rational b /\ rational c ==> !e. wellformed e /\ ~(radicals e = {}) /\ (value e) pow 3 + a * (value e) pow 2 + b * (value e) + c = &0 ==> ?e'. wellformed e' /\ (radicals e') PSUBSET (radicals e) /\ (value e') pow 3 + a * (value e') pow 2 + b * (value e') + c = &0`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `e:expression` RADICAL_CANONICAL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `r:expression` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`eu:expression`; `ev:expression`] THEN STRIP_TAC THEN MP_TAC(SPEC `\x. ?ex. wellformed ex /\ radicals ex SUBSET (radicals(e) DELETE r) /\ value ex = x` STEP_LEMMA_SQRT) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN EXISTS_TAC `Constant(&n)` THEN REWRITE_TAC[wellformed; radicals; RATIONAL_NUM; value; EMPTY_SUBSET]; X_GEN_TAC `x:real` THEN DISCH_THEN(X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) THEN EXISTS_TAC `Negation ex` THEN ASM_REWRITE_TAC[wellformed; radicals; value]; X_GEN_TAC `x:real` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) THEN EXISTS_TAC `Inverse ex` THEN ASM_REWRITE_TAC[wellformed; radicals; value]; MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `ey:expression` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `Addition ex ey` THEN ASM_REWRITE_TAC[wellformed; radicals; value; UNION_SUBSET]; MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `ey:expression` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `Multiplication ex ey` THEN ASM_REWRITE_TAC[wellformed; radicals; value; UNION_SUBSET]]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`; `c:real`; `value e`; `value eu`; `value ev`; `value r`]) THEN ANTS_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `Constant a` THEN ASM_REWRITE_TAC[wellformed; radicals; EMPTY_SUBSET; value]; ALL_TAC] THEN CONJ_TAC THENL [EXISTS_TAC `Constant b` THEN ASM_REWRITE_TAC[wellformed; radicals; EMPTY_SUBSET; value]; ALL_TAC] THEN CONJ_TAC THENL [EXISTS_TAC `Constant c` THEN ASM_REWRITE_TAC[wellformed; radicals; EMPTY_SUBSET; value]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[wellformed]) THEN ASM_REWRITE_TAC[value] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e':expression` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence the main result. *) (* ------------------------------------------------------------------------- *) let CUBIC_ROOT_RADICAL_INDUCT = prove (`!a b c. rational a /\ rational b /\ rational c ==> !n e. wellformed e /\ CARD (radicals e) = n /\ (value e) pow 3 + a * (value e) pow 2 + b * (value e) + c = &0 ==> ?x. rational x /\ x pow 3 + a * x pow 2 + b * x + c = &0`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `e:expression` THEN STRIP_TAC THEN ASM_CASES_TAC `radicals e = {}` THENL [ASM_MESON_TAC[RADICALS_EMPTY_RATIONAL]; ALL_TAC] THEN MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] CUBIC_ROOT_STEP) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:expression`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e':expression` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(radicals e')`) THEN ANTS_TAC THENL [REWRITE_TAC[SYM(ASSUME `CARD(radicals e) = n`)] THEN MATCH_MP_TAC CARD_PSUBSET THEN ASM_REWRITE_TAC[FINITE_RADICALS]; DISCH_THEN MATCH_MP_TAC THEN EXISTS_TAC `e':expression` THEN ASM_REWRITE_TAC[]]);; let CUBIC_ROOT_RATIONAL = prove (`!a b c. rational a /\ rational b /\ rational c /\ (?x. radical x /\ x pow 3 + a * x pow 2 + b * x + c = &0) ==> (?x. rational x /\ x pow 3 + a * x pow 2 + b * x + c = &0)`, REWRITE_TAC[RADICAL_EXPRESSION] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] CUBIC_ROOT_RADICAL_INDUCT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`CARD(radicals e)`; `e:expression`] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Now go further to an *integer*, since the polynomial is monic. *) (* ------------------------------------------------------------------------- *) prioritize_num();; let RATIONAL_LOWEST_LEMMA = prove (`!p q. ~(q = 0) ==> ?p' q'. ~(q' = 0) /\ coprime(p',q') /\ p * q' = p' * q`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `q:num` THEN DISCH_TAC THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN ASM_CASES_TAC `coprime(p,q)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [coprime]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC) THEN ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[DIVIDES_ZERO] THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `p':num` SUBST_ALL_TAC) (CONJUNCTS_THEN2 (X_CHOOSE_THEN `q':num` SUBST_ALL_TAC) ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `q':num`) THEN RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [ARITH_RULE `a < b <=> 1 * a < b`] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN ASM_SIMP_TAC[ARITH_RULE `~(d = 0) /\ ~(d = 1) ==> 1 < d`] THEN DISCH_THEN(MP_TAC o SPEC `p':num`) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN CONV_TAC NUM_RING);; prioritize_real();; let RATIONAL_LOWEST = prove (`!x. rational x <=> ?p q. ~(q = 0) /\ coprime(p,q) /\ abs(x) = &p / &q`, GEN_TAC THEN REWRITE_TAC[RATIONAL_ALT] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN MP_TAC(SPECL [`p:num`; `q:num`] RATIONAL_LOWEST_LEMMA) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN UNDISCH_TAC `~(q = 0)` THEN SIMP_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN CONV_TAC REAL_FIELD);; let RATIONAL_ROOT_INTEGER = prove (`!a b c x. integer a /\ integer b /\ integer c /\ rational x /\ x pow 3 + a * x pow 2 + b * x + c = &0 ==> integer x`, REWRITE_TAC[RATIONAL_LOWEST; GSYM REAL_OF_NUM_EQ] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP(REAL_ARITH `abs x = a ==> x = a \/ x = --a`)) THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o check (is_eq o concl)) THEN ASM_SIMP_TAC[REAL_FIELD `~(q = &0) ==> ((p / q) pow 3 + a * (p / q) pow 2 + b * (p / q) + c = &0 <=> (p pow 3 = q * --(a * p pow 2 + b * p * q + c * q pow 2))) /\ ((--(p / q)) pow 3 + a * (--(p / q)) pow 2 + b * (--(p / q)) + c = &0 <=> p pow 3 = q * (a * p pow 2 - b * p * q + c * q pow 2))`] THEN (W(fun(asl,w) -> SUBGOAL_THEN(mk_comb(`integer`,rand(rand(lhand w)))) MP_TAC THENL [REPEAT(MAP_FIRST MATCH_MP_TAC (tl(CONJUNCTS INTEGER_CLOSED)) THEN REPEAT CONJ_TAC) THEN ASM_REWRITE_TAC[INTEGER_CLOSED]; ALL_TAC])) THEN REWRITE_TAC[integer] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN DISCH_THEN(MP_TAC o AP_TERM `abs`) THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NEG] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_EQ] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_SYM]) THEN DISCH_THEN(MP_TAC o SPEC `3` o MATCH_MP COPRIME_EXP) THEN REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `q:num`) THEN ASM_CASES_TAC `q = 1` THEN ASM_SIMP_TAC[REAL_DIV_1; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL] THEN MESON_TAC[divides; DIVIDES_REFL]);; (* ------------------------------------------------------------------------- *) (* Hence we have our big final theorem. *) (* ------------------------------------------------------------------------- *) let CUBIC_ROOT_INTEGER = prove (`!a b c. integer a /\ integer b /\ integer c /\ (?x. radical x /\ x pow 3 + a * x pow 2 + b * x + c = &0) ==> (?x. integer x /\ x pow 3 + a * x pow 2 + b * x + c = &0)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] CUBIC_ROOT_RATIONAL) THEN ASM_SIMP_TAC[RATIONAL_INTEGER] THEN ASM_MESON_TAC[RATIONAL_ROOT_INTEGER]);; (* ------------------------------------------------------------------------- *) (* Geometrical definitions. *) (* ------------------------------------------------------------------------- *) let length = new_definition `length(a:real^2,b:real^2) = norm(b - a)`;; let parallel = new_definition `parallel (a:real^2,b:real^2) (c:real^2,d:real^2) <=> (a$1 - b$1) * (c$2 - d$2) = (a$2 - b$2) * (c$1 - d$1)`;; let collinear3 = new_definition `collinear3 (a:real^2) b c <=> parallel (a,b) (a,c)`;; let is_intersection = new_definition `is_intersection p (a,b) (c,d) <=> collinear3 a p b /\ collinear3 c p d`;; let on_circle = new_definition `on_circle x (centre,pt) <=> length(centre,x) = length(centre,pt)`;; (* ------------------------------------------------------------------------- *) (* A trivial lemma. *) (* ------------------------------------------------------------------------- *) let SQRT_CASES_LEMMA = prove (`!x y. y pow 2 = x ==> &0 <= x /\ (sqrt(x) = y \/ sqrt(x) = --y)`, REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN MP_TAC(SPEC `y:real` (GEN_ALL POW_2_SQRT)) THEN MP_TAC(SPEC `--y` (GEN_ALL POW_2_SQRT)) THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_POW_NEG; ARITH] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Show that solutions to certain classes of equations are radical. *) (* ------------------------------------------------------------------------- *) let RADICAL_LINEAR_EQUATION = prove (`!a b x. radical a /\ radical b /\ ~(a = &0 /\ b = &0) /\ a * x + b = &0 ==> radical x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(a = &0) /\ x = --b / a` (fun th -> ASM_SIMP_TAC[th; RADICAL_RULES]) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; let RADICAL_SIMULTANEOUS_LINEAR_EQUATION = prove (`!a b c d e f x. radical a /\ radical b /\ radical c /\ radical d /\ radical e /\ radical f /\ ~(a * e = b * d /\ a * f = c * d /\ e * c = b * f) /\ a * x + b * y = c /\ d * x + e * y = f ==> radical(x) /\ radical(y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(a * e - b * d = &0) /\ x = (e * c - b * f) / (a * e - b * d) /\ y = (a * f - d * c) / (a * e - b * d)` STRIP_ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; ASM_SIMP_TAC[RADICAL_RULES]]);; let RADICAL_QUADRATIC_EQUATION = prove (`!a b c x. radical a /\ radical b /\ radical c /\ a * x pow 2 + b * x + c = &0 /\ ~(a = &0 /\ b = &0 /\ c = &0) ==> radical x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN MESON_TAC[RADICAL_LINEAR_EQUATION]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC RADICAL_LINEAR_EQUATION THEN EXISTS_TAC `&2 * a` THEN ASM_SIMP_TAC[RADICAL_RULES; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN SUBGOAL_THEN `&0 <= b pow 2 - &4 * a * c /\ ((&2 * a) * x + (b - sqrt(b pow 2 - &4 * a * c)) = &0 \/ (&2 * a) * x + (b + sqrt(b pow 2 - &4 * a * c)) = &0)` MP_TAC THENL [REWRITE_TAC[real_sub; REAL_ARITH `a + (b + c) = &0 <=> c = --(a + b)`] THEN REWRITE_TAC[REAL_EQ_NEG2] THEN MATCH_MP_TAC SQRT_CASES_LEMMA THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC REAL_RING; STRIP_TAC THENL [EXISTS_TAC `b - sqrt(b pow 2 - &4 * a * c)`; EXISTS_TAC `b + sqrt(b pow 2 - &4 * a * c)`] THEN ASM_REWRITE_TAC[] THEN RADICAL_TAC THEN ASM_REWRITE_TAC[]]);; let RADICAL_SIMULTANEOUS_LINEAR_QUADRATIC = prove (`!a b c d e f x. radical a /\ radical b /\ radical c /\ radical d /\ radical e /\ radical f /\ ~(d = &0 /\ e = &0 /\ f = &0) /\ (x - a) pow 2 + (y - b) pow 2 = c /\ d * x + e * y = f ==> radical x /\ radical y`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `d pow 2 + e pow 2` RADICAL_QUADRATIC_EQUATION) THEN DISCH_THEN MATCH_MP_TAC THENL [EXISTS_TAC `&2 * b * d * e - &2 * a * e pow 2 - &2 * d * f` THEN EXISTS_TAC `b pow 2 * e pow 2 + a pow 2 * e pow 2 + f pow 2 - c * e pow 2 - &2 * b * e * f`; EXISTS_TAC `&2 * a * d * e - &2 * b * d pow 2 - &2 * f * e` THEN EXISTS_TAC `a pow 2 * d pow 2 + b pow 2 * d pow 2 + f pow 2 - c * d pow 2 - &2 * a * d * f`] THEN (REPLICATE_TAC 3 (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING; ALL_TAC] THEN REWRITE_TAC[REAL_SOS_EQ_0] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING));; let RADICAL_SIMULTANEOUS_QUADRATIC_QUADRATIC = prove (`!a b c d e f x. radical a /\ radical b /\ radical c /\ radical d /\ radical e /\ radical f /\ ~(a = d /\ b = e /\ c = f) /\ (x - a) pow 2 + (y - b) pow 2 = c /\ (x - d) pow 2 + (y - e) pow 2 = f ==> radical x /\ radical y`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC RADICAL_SIMULTANEOUS_LINEAR_QUADRATIC THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`; `c:real`; `&2 * (d - a)`; `&2 * (e - b)`; `(d pow 2 - a pow 2) + (e pow 2 - b pow 2) + (c - f)`] THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 3 (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Analytic criterion for constructibility. *) (* ------------------------------------------------------------------------- *) let constructible_RULES,constructible_INDUCT,constructible_CASES = new_inductive_definition `(!x:real^2. rational(x$1) /\ rational(x$2) ==> constructible x) /\ // Intersection of two non-parallel lines AB and CD (!a b c d x. constructible a /\ constructible b /\ constructible c /\ constructible d /\ ~parallel (a,b) (c,d) /\ is_intersection x (a,b) (c,d) ==> constructible x) /\ // Intersection of a nontrivial line AB and circle with centre C, radius DE (!a b c d e x. constructible a /\ constructible b /\ constructible c /\ constructible d /\ constructible e /\ ~(a = b) /\ collinear3 a x b /\ length (c,x) = length(d,e) ==> constructible x) /\ // Intersection of distinct circles with centres A and D, radii BD and EF (!a b c d e f x. constructible a /\ constructible b /\ constructible c /\ constructible d /\ constructible e /\ constructible f /\ ~(a = d /\ length (b,c) = length (e,f)) /\ length (a,x) = length (b,c) /\ length (d,x) = length (e,f) ==> constructible x)`;; (* ------------------------------------------------------------------------- *) (* Some "coordinate geometry" lemmas. *) (* ------------------------------------------------------------------------- *) let RADICAL_LINE_LINE_INTERSECTION = prove (`!a b c d x. radical(a$1) /\ radical(a$2) /\ radical(b$1) /\ radical(b$2) /\ radical(c$1) /\ radical(c$2) /\ radical(d$1) /\ radical(d$2) /\ ~(parallel (a,b) (c,d)) /\ is_intersection x (a,b) (c,d) ==> radical(x$1) /\ radical(x$2)`, REPEAT GEN_TAC THEN REWRITE_TAC[parallel; collinear3; is_intersection] THEN STRIP_TAC THEN MATCH_MP_TAC RADICAL_SIMULTANEOUS_LINEAR_EQUATION THEN MAP_EVERY EXISTS_TAC [`(b:real^2)$2 - (a:real^2)$2`; `(a:real^2)$1 - (b:real^2)$1`; `(a:real^2)$2 * (a$1 - (b:real^2)$1) - (a:real^2)$1 * (a$2 - b$2)`; `(d:real^2)$2 - (c:real^2)$2`; `(c:real^2)$1 - (d:real^2)$1`; `(c:real^2)$2 * (c$1 - (d:real^2)$1) - (c:real^2)$1 * (c$2 - d$2)`] THEN REPLICATE_TAC 6 (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; let RADICAL_LINE_CIRCLE_INTERSECTION = prove (`!a b c d e x. radical(a$1) /\ radical(a$2) /\ radical(b$1) /\ radical(b$2) /\ radical(c$1) /\ radical(c$2) /\ radical(d$1) /\ radical(d$2) /\ radical(e$1) /\ radical(e$2) /\ ~(a = b) /\ collinear3 a x b /\ length(c,x) = length(d,e) ==> radical(x$1) /\ radical(x$2)`, REPEAT GEN_TAC THEN REWRITE_TAC[length; NORM_EQ; collinear3; parallel] THEN SIMP_TAC[CART_EQ; FORALL_2; dot; SUM_2; DIMINDEX_2; VECTOR_SUB_COMPONENT; GSYM REAL_POW_2] THEN STRIP_TAC THEN MATCH_MP_TAC RADICAL_SIMULTANEOUS_LINEAR_QUADRATIC THEN MAP_EVERY EXISTS_TAC [`(c:real^2)$1`; `(c:real^2)$2`; `((e:real^2)$1 - (d:real^2)$1) pow 2 + (e$2 - d$2) pow 2`; `(b:real^2)$2 - (a:real^2)$2`; `(a:real^2)$1 - (b:real^2)$1`; `a$2 * ((a:real^2)$1 - (b:real^2)$1) - a$1 * (a$2 - b$2)`] THEN REPLICATE_TAC 6 (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; let RADICAL_CIRCLE_CIRCLE_INTERSECTION = prove (`!a b c d e f x. radical(a$1) /\ radical(a$2) /\ radical(b$1) /\ radical(b$2) /\ radical(c$1) /\ radical(c$2) /\ radical(d$1) /\ radical(d$2) /\ radical(e$1) /\ radical(e$2) /\ radical(f$1) /\ radical(f$2) /\ length(a,x) = length(b,c) /\ length(d,x) = length(e,f) /\ ~(a = d /\ length(b,c) = length(e,f)) ==> radical(x$1) /\ radical(x$2)`, REPEAT GEN_TAC THEN REWRITE_TAC[length; NORM_EQ; collinear3; parallel] THEN SIMP_TAC[CART_EQ; FORALL_2; dot; SUM_2; DIMINDEX_2; VECTOR_SUB_COMPONENT; GSYM REAL_POW_2] THEN STRIP_TAC THEN MATCH_MP_TAC RADICAL_SIMULTANEOUS_QUADRATIC_QUADRATIC THEN MAP_EVERY EXISTS_TAC [`(a:real^2)$1`; `(a:real^2)$2`; `((c:real^2)$1 - (b:real^2)$1) pow 2 + (c$2 - b$2) pow 2`; `(d:real^2)$1`; `(d:real^2)$2`; `((f:real^2)$1 - (e:real^2)$1) pow 2 + (f$2 - e$2) pow 2`] THEN REPLICATE_TAC 6 (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* So constructible points have radical coordinates. *) (* ------------------------------------------------------------------------- *) let CONSTRUCTIBLE_RADICAL = prove (`!x. constructible x ==> radical(x$1) /\ radical(x$2)`, MATCH_MP_TAC constructible_INDUCT THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THENL [ASM_SIMP_TAC[RADICAL_RULES]; MATCH_MP_TAC RADICAL_LINE_LINE_INTERSECTION THEN ASM_MESON_TAC[]; MATCH_MP_TAC RADICAL_LINE_CIRCLE_INTERSECTION THEN ASM_MESON_TAC[]; MATCH_MP_TAC RADICAL_CIRCLE_CIRCLE_INTERSECTION THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Impossibility of doubling the cube. *) (* ------------------------------------------------------------------------- *) let DOUBLE_THE_CUBE_ALGEBRA = prove (`~(?x. radical x /\ x pow 3 = &2)`, STRIP_TAC THEN MP_TAC(SPECL [`&0`; `&0`; `-- &2`] CUBIC_ROOT_INTEGER) THEN SIMP_TAC[INTEGER_CLOSED; NOT_IMP] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN REWRITE_TAC[GSYM real_sub; REAL_SUB_0] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `abs`) THEN REWRITE_TAC[REAL_ABS_POW] THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[integer]) THEN REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_POW; REAL_OF_NUM_EQ] THEN MATCH_MP_TAC(ARITH_RULE `n EXP 3 <= 1 EXP 3 \/ 2 EXP 3 <= n EXP 3 ==> ~(n EXP 3 = 2)`) THEN REWRITE_TAC[num_CONV `3`; EXP_MONO_LE_SUC] THEN ARITH_TAC);; let DOUBLE_THE_CUBE = prove (`!x. x pow 3 = &2 ==> ~(constructible(vector[x; &0]))`, GEN_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONSTRUCTIBLE_RADICAL) THEN REWRITE_TAC[VECTOR_2; RADICAL_RULES] THEN ASM_MESON_TAC[DOUBLE_THE_CUBE_ALGEBRA]);; (* ------------------------------------------------------------------------- *) (* Impossibility of trisecting *) (* ------------------------------------------------------------------------- *) let COS_TRIPLE = prove (`!x. cos(&3 * x) = &4 * cos(x) pow 3 - &3 * cos(x)`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `&3 * x = x + x + x`; SIN_ADD; COS_ADD] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; let COS_PI3 = prove (`cos(pi / &3) = &1 / &2`, MP_TAC(SPEC `pi / &3` COS_TRIPLE) THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH; COS_PI] THEN REWRITE_TAC[REAL_RING `-- &1 = &4 * c pow 3 - &3 * c <=> c = &1 / &2 \/ c = -- &1`] THEN DISCH_THEN(DISJ_CASES_THEN2 ACCEPT_TAC MP_TAC) THEN MP_TAC(SPEC `pi / &3` COS_POS_PI) THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let TRISECT_60_DEGREES_ALGEBRA = prove (`~(?x. radical x /\ x pow 3 - &3 * x - &1 = &0)`, STRIP_TAC THEN MP_TAC(SPECL [`&0`; `-- &3`; `-- &1`] CUBIC_ROOT_INTEGER) THEN SIMP_TAC[INTEGER_CLOSED; NOT_IMP] THEN REWRITE_TAC[REAL_ADD_ASSOC] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; REAL_MUL_LNEG; GSYM real_sub] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `x pow 3 - &3 * x - &1 = &0 <=> x * (x pow 2 - &3) = &1`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `abs`) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[integer]) THEN REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC (ARITH_RULE `n = 0 \/ n = 1 \/ n = 2 + (n - 2)`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `(&2 + m) pow 2 - &3 = m pow 2 + &4 * m + &1`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_POW; REAL_ABS_NUM; REAL_OF_NUM_EQ; MULT_EQ_1] THEN ARITH_TAC);; let TRISECT_60_DEGREES = prove (`!y. ~(constructible(vector[cos(pi / &9); y]))`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONSTRUCTIBLE_RADICAL) THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[VECTOR_2] THEN DISCH_TAC THEN MP_TAC(SPEC `pi / &9` COS_TRIPLE) THEN SIMP_TAC[REAL_ARITH `&3 * x / &9 = x / &3`; COS_PI3] THEN REWRITE_TAC[REAL_ARITH `&1 / &2 = &4 * c pow 3 - &3 * c <=> (&2 * c) pow 3 - &3 * (&2 * c) - &1 = &0`] THEN ASM_MESON_TAC[TRISECT_60_DEGREES_ALGEBRA; RADICAL_RULES]);; hol-light/100/cosine.ml000066400000000000000000000235321303454263000150640ustar00rootroot00000000000000(* ========================================================================= *) (* The law of cosines, of sines, and sum of angles of a triangle. *) (* ========================================================================= *) needs "Multivariate/transcendentals.ml";; prioritize_vector();; (* ------------------------------------------------------------------------- *) (* Angle between vectors (always 0 <= angle <= pi). *) (* ------------------------------------------------------------------------- *) let vangle = new_definition `vangle x y = if x = vec 0 \/ y = vec 0 then pi / &2 else acs((x dot y) / (norm x * norm y))`;; (* ------------------------------------------------------------------------- *) (* Traditional geometric notion of angle (but always 0 <= theta <= pi). *) (* ------------------------------------------------------------------------- *) let angle = new_definition `angle(a,b,c) = vangle (a - b) (c - b)`;; (* ------------------------------------------------------------------------- *) (* Lemmas (more than we need for this result). *) (* ------------------------------------------------------------------------- *) let VANGLE = prove (`!x y:real^N. x dot y = norm(x) * norm(y) * cos(vangle x y)`, REPEAT GEN_TAC THEN REWRITE_TAC[vangle] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO; NORM_0; REAL_MUL_LZERO] THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO; NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c:real = c * a * b`] THEN ASM_SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT] THEN MATCH_MP_TAC(GSYM COS_ACS) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT; REAL_LT_MUL] THEN MP_TAC(SPECL [`x:real^N`; `y:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN REAL_ARITH_TAC);; let VANGLE_RANGE = prove (`!x y:real^N. &0 <= vangle x y /\ vangle x y <= pi`, REPEAT GEN_TAC THEN REWRITE_TAC[vangle] THEN COND_CASES_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN MATCH_MP_TAC ACS_BOUNDS THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> -- &1 * a <= x /\ x <= &1 * a`) THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_ABS]);; let ORTHOGONAL_VANGLE = prove (`!x y:real^N. orthogonal x y <=> vangle x y = pi / &2`, REPEAT STRIP_TAC THEN REWRITE_TAC[orthogonal; vangle] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN EQ_TAC THENL [SIMP_TAC[real_div; REAL_MUL_LZERO] THEN DISCH_TAC THEN REWRITE_TAC[GSYM real_div; GSYM COS_PI2] THEN MATCH_MP_TAC ACS_COS THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; MP_TAC(SPECL [`x:real^N`; `y:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN ASM_SIMP_TAC[COS_ACS; COS_PI2] THEN REWRITE_TAC[real_div; REAL_ENTIRE; REAL_INV_EQ_0] THEN ASM_REWRITE_TAC[NORM_EQ_0]]);; let VANGLE_EQ_PI = prove (`!x y:real^N. vangle x y = pi ==> norm(x) % y + norm(y) % x = vec 0`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real^N`; `y:real^N`] VANGLE) THEN ASM_REWRITE_TAC[COS_PI] THEN STRIP_TAC THEN MP_TAC(ISPECL [`x:real^N`; `--y:real^N`] NORM_CAUCHY_SCHWARZ_EQ) THEN REWRITE_TAC[NORM_NEG; DOT_RNEG; VECTOR_MUL_RNEG] THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN VECTOR_ARITH_TAC);; let ANGLE_EQ_PI = prove (`!A B C:real^N. angle(A,B,C) = pi ==> dist(A,C) = dist(A,B) + dist(B,C)`, REPEAT GEN_TAC THEN REWRITE_TAC[angle] THEN DISCH_THEN(MP_TAC o MATCH_MP VANGLE_EQ_PI) THEN REWRITE_TAC[VECTOR_ARITH `a + x % (b - c) = vec 0 <=> a = x % (c - b)`] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [NORM_SUB] THEN REWRITE_TAC[GSYM NORM_TRIANGLE_EQ] THEN REWRITE_TAC[VECTOR_ARITH `(B - A) + (C - B):real^N = C - A`] THEN REWRITE_TAC[dist; NORM_SUB]);; let SIN_ANGLE_POS = prove (`!A B C. &0 <= sin(angle(A,B,C))`, SIMP_TAC[SIN_POS_PI_LE; angle; VANGLE_RANGE]);; let ANGLE = prove (`!A B C. (A - C) dot (B - C) = dist(A,C) * dist(B,C) * cos(angle(A,C,B))`, REWRITE_TAC[angle; dist; GSYM VANGLE]);; let ANGLE_REFL = prove (`!A B. angle(A,A,B) = pi / &2 /\ angle(B,A,A) = pi / &2`, REWRITE_TAC[angle; vangle; VECTOR_SUB_REFL]);; let ANGLE_REFL_MID = prove (`!A B. ~(A = B) ==> angle(A,B,A) = &0`, SIMP_TAC[angle; vangle; VECTOR_SUB_EQ; GSYM NORM_POW_2; GSYM REAL_POW_2; REAL_DIV_REFL; ACS_1; REAL_POW_EQ_0; ARITH; NORM_EQ_0]);; let ANGLE_SYM = prove (`!A B C. angle(A,B,C) = angle(C,B,A)`, REWRITE_TAC[angle; vangle; VECTOR_SUB_EQ; DISJ_SYM; REAL_MUL_SYM; DOT_SYM]);; let ANGLE_RANGE = prove (`!A B C. &0 <= angle(A,B,C) /\ angle(A,B,C) <= pi`, REWRITE_TAC[angle; VANGLE_RANGE]);; (* ------------------------------------------------------------------------- *) (* The law of cosines. *) (* ------------------------------------------------------------------------- *) let LAW_OF_COSINES = prove (`!A B C:real^N. dist(B,C) pow 2 = dist(A,B) pow 2 + dist(A,C) pow 2 - &2 * dist(A,B) * dist(A,C) * cos(angle(B,A,C))`, REPEAT GEN_TAC THEN REWRITE_TAC[angle; ONCE_REWRITE_RULE[NORM_SUB] dist; GSYM VANGLE; NORM_POW_2] THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The law of sines. *) (* ------------------------------------------------------------------------- *) let LAW_OF_SINES = prove (`!A B C:real^N. sin(angle(A,B,C)) * dist(B,C) = sin(angle(B,A,C)) * dist(A,C)`, REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN SIMP_TAC[SIN_ANGLE_POS; DIST_POS_LE; REAL_LE_MUL; ARITH] THEN REWRITE_TAC[REAL_POW_MUL; MATCH_MP (REAL_ARITH `x + y = &1 ==> x = &1 - y`) (SPEC_ALL SIN_CIRCLE)] THEN ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[ANGLE_REFL; COS_PI2] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM VECTOR_SUB_EQ]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM NORM_EQ_0]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_RING `~(a = &0) ==> a pow 2 * x = a pow 2 * y ==> x = y`)) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM dist] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN REWRITE_TAC[REAL_RING `a * (&1 - x) * b = c * (&1 - y) * d <=> a * b - a * b * x = c * d - c * d * y`] THEN REWRITE_TAC[GSYM REAL_POW_MUL; GSYM ANGLE] THEN REWRITE_TAC[REAL_POW_MUL; dist; NORM_POW_2] THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Hence the sum of the angles of a triangle. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_ANGLE_SUM_LEMMA = prove (`!A B C:real^N. ~(A = B) /\ ~(A = C) /\ ~(B = C) ==> cos(angle(B,A,C) + angle(A,B,C) + angle(B,C,A)) = -- &1`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`C:real^N`; `B:real^N`; `A:real^N`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_SINES) THEN MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_SINES) THEN MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `A:real^N`] LAW_OF_SINES) THEN REWRITE_TAC[COS_ADD; SIN_ADD; dist; NORM_SUB] THEN MAP_EVERY (fun t -> MP_TAC(SPEC t SIN_CIRCLE)) [`angle(B:real^N,A,C)`; `angle(A:real^N,B,C)`; `angle(B:real^N,C,A)`] THEN REWRITE_TAC[COS_ADD; SIN_ADD; ANGLE_SYM] THEN CONV_TAC REAL_RING);; let COS_MINUS1_LEMMA = prove (`!x. cos(x) = -- &1 /\ &0 <= x /\ x < &3 * pi ==> x = pi`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?n. integer n /\ x = n * pi` (X_CHOOSE_THEN `nn:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN REWRITE_TAC[GSYM SIN_EQ_0] THENL [MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RING; ALL_TAC] THEN SUBGOAL_THEN `?n. nn = &n` (X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_MUL_POS_LE]) THEN SIMP_TAC[PI_POS; REAL_ARITH `&0 < p ==> ~(p < &0) /\ ~(p = &0)`] THEN ASM_MESON_TAC[INTEGER_POS; REAL_LT_LE]; ALL_TAC] THEN MATCH_MP_TAC(REAL_RING `n = &1 ==> n * p = p`) THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC(ARITH_RULE `n < 3 /\ ~(n = 0) /\ ~(n = 2) ==> n = 1`) THEN RULE_ASSUM_TAC(SIMP_RULE[REAL_LT_RMUL_EQ; PI_POS; REAL_OF_NUM_LT]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[COS_0; REAL_MUL_LZERO; COS_NPI] THEN REAL_ARITH_TAC);; let TRIANGLE_ANGLE_SUM = prove (`!A B C:real^N. ~(A = B) /\ ~(A = C) /\ ~(B = C) ==> angle(B,A,C) + angle(A,B,C) + angle(B,C,A) = pi`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COS_MINUS1_LEMMA THEN ASM_SIMP_TAC[TRIANGLE_ANGLE_SUM_LEMMA; REAL_LE_ADD; ANGLE_RANGE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= p /\ &0 <= y /\ y <= p /\ &0 <= z /\ z <= p /\ ~(x = p /\ y = p /\ z = p) ==> x + y + z < &3 * p`) THEN ASM_SIMP_TAC[ANGLE_RANGE] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ANGLE_EQ_PI)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM VECTOR_SUB_EQ])) THEN REWRITE_TAC[GSYM NORM_EQ_0; dist; NORM_SUB] THEN REAL_ARITH_TAC);; hol-light/100/cubic.ml000066400000000000000000000104371303454263000146710ustar00rootroot00000000000000(* ========================================================================= *) (* Cubic formula. *) (* ========================================================================= *) needs "Complex/complex_transc.ml";; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* Define cube roots (it doesn't matter which one we choose here) *) (* ------------------------------------------------------------------------- *) let ccbrt = new_definition `ccbrt(z) = if z = Cx(&0) then Cx(&0) else cexp(clog(z) / Cx(&3))`;; let CCBRT = prove (`!z. ccbrt(z) pow 3 = z`, GEN_TAC THEN REWRITE_TAC[ccbrt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN REWRITE_TAC[COMPLEX_FIELD `z pow 3 = z * z * z:complex`; GSYM CEXP_ADD] THEN REWRITE_TAC[COMPLEX_FIELD `z / Cx(&3) + z / Cx(&3) + z / Cx(&3) = z`] THEN ASM_SIMP_TAC[CEXP_CLOG]);; (* ------------------------------------------------------------------------- *) (* The reduction to a simpler form. *) (* ------------------------------------------------------------------------- *) let CUBIC_REDUCTION = COMPLEX_FIELD `~(a = Cx(&0)) /\ x = y - b / (Cx(&3) * a) /\ p = (Cx(&3) * a * c - b pow 2) / (Cx(&9) * a pow 2) /\ q = (Cx(&9) * a * b * c - Cx(&2) * b pow 3 - Cx(&27) * a pow 2 * d) / (Cx(&54) * a pow 3) ==> (a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0))`;; (* ------------------------------------------------------------------------- *) (* The solutions of the special form. *) (* ------------------------------------------------------------------------- *) let CUBIC_BASIC = COMPLEX_FIELD `!i t s. s pow 2 = q pow 2 + p pow 3 /\ (s1 pow 3 = if p = Cx(&0) then Cx(&2) * q else q + s) /\ s2 = --s1 * (Cx(&1) + i * t) / Cx(&2) /\ s3 = --s1 * (Cx(&1) - i * t) / Cx(&2) /\ i pow 2 + Cx(&1) = Cx(&0) /\ t pow 2 = Cx(&3) ==> if p = Cx(&0) then (y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0) <=> y = s1 \/ y = s2 \/ y = s3) else ~(s1 = Cx(&0)) /\ (y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0) <=> (y = s1 - p / s1 \/ y = s2 - p / s2 \/ y = s3 - p / s3))`;; (* ------------------------------------------------------------------------- *) (* Explicit formula for the roots (doesn't matter which square/cube roots). *) (* ------------------------------------------------------------------------- *) let CUBIC = prove (`~(a = Cx(&0)) ==> let p = (Cx(&3) * a * c - b pow 2) / (Cx(&9) * a pow 2) and q = (Cx(&9) * a * b * c - Cx(&2) * b pow 3 - Cx(&27) * a pow 2 * d) / (Cx(&54) * a pow 3) in let s = csqrt(q pow 2 + p pow 3) in let s1 = if p = Cx(&0) then ccbrt(Cx(&2) * q) else ccbrt(q + s) in let s2 = --s1 * (Cx(&1) + ii * csqrt(Cx(&3))) / Cx(&2) and s3 = --s1 * (Cx(&1) - ii * csqrt(Cx(&3))) / Cx(&2) in if p = Cx(&0) then a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> x = s1 - b / (Cx(&3) * a) \/ x = s2 - b / (Cx(&3) * a) \/ x = s3 - b / (Cx(&3) * a) else ~(s1 = Cx(&0)) /\ (a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> x = s1 - p / s1 - b / (Cx(&3) * a) \/ x = s2 - p / s2 - b / (Cx(&3) * a) \/ x = s3 - p / s3 - b / (Cx(&3) * a))`, DISCH_TAC THEN REPEAT LET_TAC THEN ABBREV_TAC `y = x + b / (Cx(&3) * a)` THEN SUBGOAL_THEN `a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0)` SUBST1_TAC THENL [MATCH_MP_TAC CUBIC_REDUCTION THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "y" THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN ONCE_REWRITE_TAC[COMPLEX_RING `x = a - b <=> x + b = (a:complex)`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CUBIC_BASIC THEN MAP_EVERY EXISTS_TAC [`ii`; `csqrt(Cx(&3))`; `csqrt (q pow 2 + p pow 3)`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CSQRT]; ASM_MESON_TAC[CCBRT]; MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_RING; ASM_MESON_TAC[CSQRT]]);; hol-light/100/derangements.ml000066400000000000000000000651351303454263000162650ustar00rootroot00000000000000(* ========================================================================= *) (* #88: Formula for the number of derangements: round[n!/e] *) (* ========================================================================= *) needs "Library/transc.ml";; needs "Library/calc_real.ml";; needs "Library/floor.ml";; let PAIR_BETA_THM = GEN_BETA_CONV `(\(x,y). P x y) (a,b)`;; (* ------------------------------------------------------------------------- *) (* Domain and range of a relation. *) (* ------------------------------------------------------------------------- *) let domain = new_definition `domain r = {x | ?y. r(x,y)}`;; let range = new_definition `range r = {y | ?x. r(x,y)}`;; (* ------------------------------------------------------------------------- *) (* Relational composition. *) (* ------------------------------------------------------------------------- *) parse_as_infix("%",(26, "right"));; let compose = new_definition `(r % s) (x,y) <=> ?z. r(x,z) /\ s(z,y)`;; (* ------------------------------------------------------------------------- *) (* Identity relation on a domain. *) (* ------------------------------------------------------------------------- *) let id = new_definition `id(s) (x,y) <=> x IN s /\ x = y`;; (* ------------------------------------------------------------------------- *) (* Converse relation. *) (* ------------------------------------------------------------------------- *) let converse = new_definition `converse(r) (x,y) = r(y,x)`;; (* ------------------------------------------------------------------------- *) (* Transposition. *) (* ------------------------------------------------------------------------- *) let swap = new_definition `swap(a,b) (x,y) <=> x = a /\ y = b \/ x = b /\ y = a`;; (* ------------------------------------------------------------------------- *) (* When a relation "pairs up" two sets bijectively. *) (* ------------------------------------------------------------------------- *) parse_as_infix("pairsup",(12,"right"));; let pairsup = new_definition `r pairsup (s,t) <=> (r % converse(r) = id(s)) /\ (converse(r) % r = id(t))`;; (* ------------------------------------------------------------------------- *) (* Special case of a permutation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("permutes",(12,"right"));; let permutes = new_definition `r permutes s <=> r pairsup (s,s)`;; (* ------------------------------------------------------------------------- *) (* Even more special case of derangement. *) (* ------------------------------------------------------------------------- *) parse_as_infix("deranges",(12,"right"));; let deranges = new_definition `r deranges s <=> r permutes s /\ !x. ~(r(x,x))`;; (* ------------------------------------------------------------------------- *) (* Trivial tactic for properties of relations. *) (* ------------------------------------------------------------------------- *) let REL_TAC = POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM; PAIR_BETA_THM; permutes; pairsup; domain; range; compose; id; converse; swap; deranges; IN_INSERT; IN_DELETE; NOT_IN_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[IN; EMPTY; INSERT; DELETE; UNION; IN_ELIM_THM; PAIR_EQ; id; converse; swap] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o check (is_var o lhs o concl))) THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o check (is_var o rhs o concl))) THEN ASM_MESON_TAC[];; let REL_RULE tm = prove(tm,REL_TAC);; (* ------------------------------------------------------------------------- *) (* Some general properties of relations. *) (* ------------------------------------------------------------------------- *) let CONVERSE_COMPOSE = prove (`!r s. converse(r % s) = converse(s) % converse(r)`, REL_TAC);; let CONVERSE_CONVERSE = prove (`!r. converse(converse r) = r`, REL_TAC);; (* ------------------------------------------------------------------------- *) (* More "explicit" definition of pairing and permutation. *) (* ------------------------------------------------------------------------- *) let PAIRSUP_EXPLICIT = prove (`!p s t. p pairsup (s,t) <=> (!x y. p(x,y) ==> x IN s /\ y IN t) /\ (!x. x IN s ==> ?!y. y IN t /\ p(x,y)) /\ (!y. y IN t ==> ?!x. x IN s /\ p(x,y))`, REL_TAC);; let PERMUTES_EXPLICIT = prove (`!p s. p permutes s <=> (!x y. p(x,y) ==> x IN s /\ y IN s) /\ (!x. x IN s ==> ?!y. y IN s /\ p(x,y)) /\ (!y. y IN s ==> ?!x. x IN s /\ p(x,y))`, REL_TAC);; (* ------------------------------------------------------------------------- *) (* Other low-level properties. *) (* ------------------------------------------------------------------------- *) let PAIRSUP_DOMRAN = prove (`!p s t. p pairsup (s,t) ==> domain p = s /\ range p = t`, REL_TAC);; let PERMUTES_DOMRAN = prove (`!p s. p permutes s ==> domain p = s /\ range p = s`, REL_TAC);; let PAIRSUP_FUNCTIONAL = prove (`!p s t. p pairsup (s,t) ==> !x y y'. p(x,y) /\ p(x,y') ==> y = y'`, REL_TAC);; let PERMUTES_FUNCTIONAL = prove (`!p s. p permutes s ==> !x y y'. p(x,y) /\ p(x,y') ==> y = y'`, REL_TAC);; let PAIRSUP_COFUNCTIONAL = prove (`!p s t. p pairsup (s,t) ==> !x x' y. p(x,y) /\ p(x',y) ==> x = x'`, REL_TAC);; let PERMUTES_COFUNCTIONAL = prove (`!p s. p permutes s ==> !x x' y. p(x,y) /\ p(x',y) ==> x = x'`, REL_TAC);; (* ------------------------------------------------------------------------- *) (* Some more abstract properties. *) (* ------------------------------------------------------------------------- *) let PAIRSUP_ID = prove (`!s. id(s) pairsup (s,s)`, REL_TAC);; let PERMUTES_ID = prove (`!s. id(s) permutes s`, REL_TAC);; let PAIRSUP_CONVERSE = prove (`!p s t. p pairsup (s,t) ==> converse(p) pairsup (t,s)`, REL_TAC);; let PERMUTES_CONVERSE = prove (`!p s. p permutes s ==> converse(p) permutes s`, REL_TAC);; let PAIRSUP_COMPOSE = prove (`!p p' s t u. p pairsup (s,t) /\ p' pairsup (t,u) ==> (p % p') pairsup (s,u)`, REL_TAC);; let PERMUTES_COMPOSE = prove (`!p p' s. p permutes s /\ p' permutes s ==> (p % p') permutes s`, REL_TAC);; (* ------------------------------------------------------------------------- *) (* Transpositions are permutations. *) (* ------------------------------------------------------------------------- *) let PERMUTES_SWAP = prove (`swap(a,b) permutes {a,b}`, REL_TAC);; (* ------------------------------------------------------------------------- *) (* Clausal theorems for cases on first set. *) (* ------------------------------------------------------------------------- *) let PAIRSUP_EMPTY = prove (`p pairsup ({},{}) <=> (p = {})`, REL_TAC);; let PAIRSUP_INSERT = prove (`!x:A s t:B->bool p. p pairsup (x INSERT s,t) <=> if x IN s then p pairsup (s,t) else ?y q. y IN t /\ p = (x,y) INSERT q /\ q pairsup (s,t DELETE y)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SET_RULE `x IN s ==> x INSERT s = s`] THEN EQ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `?y. y IN t /\ p(x:A,y:B)` MP_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REL_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:B` THEN STRIP_TAC THEN EXISTS_TAC `p DELETE (x:A,y:B)` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REL_TAC);; (* ------------------------------------------------------------------------- *) (* Number of pairings and permutations. *) (* ------------------------------------------------------------------------- *) let NUMBER_OF_PAIRINGS = prove (`!n s:A->bool t:B->bool. s HAS_SIZE n /\ t HAS_SIZE n ==> {p | p pairsup (s,t)} HAS_SIZE (FACT n)`, let lemma = prove (`{p | ?y. y IN t /\ A y p} = UNIONS {{p | A y p} | y IN t} /\ {p | ?q. p = (a,y) INSERT q /\ A y q} = IMAGE (\q. (a,y) INSERT q) {q | A y q}`, CONJ_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIONS; IN_IMAGE] THEN SET_TAC[]) in INDUCT_TAC THEN REPEAT GEN_TAC THENL [REWRITE_TAC[HAS_SIZE_CLAUSES] THEN SIMP_TAC[PAIRSUP_EMPTY; SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH; FACT]; ALL_TAC] THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [HAS_SIZE_CLAUSES] THEN REWRITE_TAC[HAS_SIZE_SUC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REWRITE_TAC[PAIRSUP_INSERT; RIGHT_EXISTS_AND_THM; lemma; FACT] THEN MATCH_MP_TAC HAS_SIZE_UNIONS THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE_SUC]; REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_SIMP_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; REPEAT STRIP_TAC THEN REWRITE_TAC[DISJOINT] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTER; IN_IMAGE; NOT_IN_EMPTY] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC]);; let NUMBER_OF_PERMUTATIONS = prove (`!s n. s HAS_SIZE n ==> {p | p permutes s} HAS_SIZE (FACT n)`, SIMP_TAC[permutes; NUMBER_OF_PAIRINGS]);; (* ------------------------------------------------------------------------- *) (* Number of derangements (we need to justify this later). *) (* ------------------------------------------------------------------------- *) let derangements = define `(derangements 0 = 1) /\ (derangements 1 = 0) /\ (derangements(n + 2) = (n + 1) * (derangements n + derangements(n + 1)))`;; let DERANGEMENT_INDUCT = prove (`!P. P 0 /\ P 1 /\ (!n. P n /\ P(n + 1) ==> P(n + 2)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN ASM_SIMP_TAC[ARITH]);; (* ------------------------------------------------------------------------- *) (* Expanding a derangement. *) (* ------------------------------------------------------------------------- *) let DERANGEMENT_ADD2 = prove (`!p s x y. p deranges s /\ ~(x IN s) /\ ~(y IN s) /\ ~(x = y) ==> ((x,y) INSERT (y,x) INSERT p) deranges (x INSERT y INSERT s)`, REL_TAC);; let DERANGEMENT_ADD1 = prove (`!p s y x. p deranges s /\ ~(y IN s) /\ p(x,z) ==> ((x,y) INSERT (y,z) INSERT (p DELETE (x,z))) deranges (y INSERT s)`, REL_TAC);; (* ------------------------------------------------------------------------- *) (* Number of derangements. *) (* ------------------------------------------------------------------------- *) let DERANGEMENT_EMPTY = prove (`!p. p deranges {} <=> p = {}`, REL_TAC);; let DERANGEMENT_SING = prove (`!x p. ~(p deranges {x})`, REL_TAC);; let NUMBER_OF_DERANGEMENTS = prove (`!n s:A->bool. s HAS_SIZE n ==> {p | p deranges s} HAS_SIZE (derangements n)`, MATCH_MP_TAC DERANGEMENT_INDUCT THEN REWRITE_TAC[derangements] THEN REPEAT CONJ_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REPEAT STRIP_TAC THEN EXISTS_TAC `{}:A#A->bool` THEN ASM_REWRITE_TAC[DERANGEMENT_EMPTY; EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[NOT_IN_EMPTY; IN_SING] THEN MESON_TAC[MEMBER_NOT_EMPTY]; CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[DERANGEMENT_SING] THEN SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN X_GEN_TAC `t:A->bool` THEN REWRITE_TAC[ARITH_RULE `n + 2 = SUC(n + 1)`; HAS_SIZE_CLAUSES] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `{p | p deranges (x:A INSERT s)} = (IMAGE (\(y,p). (x,y) INSERT (y,x) INSERT p) {(y,p) | y IN s /\ p IN {p | p deranges (s DELETE y)}}) UNION (IMAGE (\(y,p). let z = @z. p(x,z) in (x,y) INSERT (y,z) INSERT (p DELETE (x,z))) {(y,p) | y IN s /\ p IN {p | p deranges (x INSERT (s DELETE y))}})` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[TAUT `(a <=> b) <=> (b ==> a) /\ (a ==> b)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL [REWRITE_TAC[IN_UNION; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`; FORALL_AND_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; PAIR_BETA_THM; IN_ELIM_THM; PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`y:A`; `p:A#A->bool`] THEN STRIP_TAC THENL [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `y IN s ==> s = y INSERT (s DELETE y)`)) THEN MATCH_MP_TAC DERANGEMENT_ADD2 THEN ASM_REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `z = @z. p(x:A,z:A)` THEN SUBGOAL_THEN `(p:A#A->bool)(x:A,z:A)` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN CONV_TAC SELECT_CONV THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN SUBGOAL_THEN `z:A IN s` STRIP_ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN SUBGOAL_THEN `(x:A) INSERT s = y INSERT (x INSERT (s DELETE y))` SUBST1_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC DERANGEMENT_ADD1 THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_DELETE; IN_INSERT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `p:A#A->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `?y. y IN s /\ p(x:A,y:A)` STRIP_ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN REWRITE_TAC[IN_UNION] THEN ASM_CASES_TAC `(p:A#A->bool)(y,x)` THENL [DISJ1_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `y:A,(p DELETE (y,x)) DELETE (x:A,y:A)` THEN CONJ_TAC THENL [REWRITE_TAC[PAIR_BETA_THM] THEN MAP_EVERY UNDISCH_TAC [`(p:A#A->bool)(x,y)`; `(p:A#A->bool)(y,x)`] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN SUBGOAL_THEN `?z. p(y:A,z:A)` STRIP_ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN SUBGOAL_THEN `z:A IN s` ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN DISJ2_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_BETA_THM] THEN EXISTS_TAC `y:A` THEN EXISTS_TAC `(x:A,z:A) INSERT ((p DELETE (x,y)) DELETE (y,z))` THEN SUBGOAL_THEN `(@w:A. ((x,z) INSERT (p DELETE (x,y) DELETE (y,z))) (x,w)) = z` SUBST1_TAC THENL [MATCH_MP_TAC SELECT_UNIQUE THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; PAIR_BETA_THM] THEN REWRITE_TAC[IN; INSERT; DELETE; PAIR_BETA_THM; IN_ELIM_THM; PAIR_EQ] THEN MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN ASM_CASES_TAC `u:A = x` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN REWRITE_TAC[LEFT_ADD_DISTRIB] THEN MATCH_MP_TAC HAS_SIZE_UNION THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REWRITE_TAC[FUN_EQ_THM; INSERT; IN_ELIM_THM; FORALL_PAIR_THM; PAIR_EQ] THEN UNDISCH_TAC `~(x:A IN s)` THEN REL_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `(s:A->bool) HAS_SIZE (n + 1)` THEN SIMP_TAC[HAS_SIZE; FINITE_DELETE; CARD_DELETE] THEN ASM_REWRITE_TAC[ADD_SUB]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN MAP_EVERY X_GEN_TAC [`y:A`; `p:(A#A)->bool`; `y':A`; `p':(A#A->bool)`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN MAP_EVERY ABBREV_TAC [`z = @z. p(x:A,z:A)`; `z' = @z. p'(x:A,z:A)`] THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN SUBGOAL_THEN `p(x:A,z:A) /\ p'(x:A,z':A)` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN CONJ_TAC THEN CONV_TAC SELECT_CONV THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o SYM)) THEN SUBGOAL_THEN `z:A IN s /\ z':A IN s` STRIP_ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THEN MP_TAC th) THENL [DISCH_THEN(MP_TAC o C AP_THM `(x:A,y:A)`) THEN REWRITE_TAC[INSERT; DELETE; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_CASES_TAC `z':A = z` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM SUBST_ALL_TAC; DISCH_THEN(MP_TAC o C AP_THM `(y:A,z:A)`) THEN REWRITE_TAC[INSERT; DELETE; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `a INSERT b INSERT s = a INSERT b INSERT t ==> ~(a IN s) /\ ~(a IN t) /\ ~(b IN s) /\ ~(b IN t) ==> s = t`)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(s:A->bool) HAS_SIZE n + 1` THEN ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE] THEN ASM_SIMP_TAC[CARD_DELETE; CARD_CLAUSES; FINITE_DELETE] THEN ASM_REWRITE_TAC[IN_DELETE] THEN ARITH_TAC; REWRITE_TAC[DISJOINT] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[NOT_IN_EMPTY; IN_INTER; TAUT `~(a /\ b) <=> a ==> ~b`] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`y:A`; `p:A#A->bool`] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:A`; `q:A#A->bool`] THEN REWRITE_TAC[PAIR_BETA_THM; IN_ELIM_THM; PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ABBREV_TAC `w = @w. q(x:A,w:A)` THEN SUBGOAL_THEN `(q:A#A->bool)(x:A,w:A)` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN CONV_TAC SELECT_CONV THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN SUBGOAL_THEN `w:A IN s` STRIP_ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN ASM_CASES_TAC `w:A = z` THEN ASM_REWRITE_TAC[] THENL [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN ASM_CASES_TAC `w:A = y` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN ASM_CASES_TAC `y:A = z` THENL [FIRST_X_ASSUM SUBST_ALL_TAC; ALL_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC]);; (* ------------------------------------------------------------------------- *) (* Trivia. *) (* ------------------------------------------------------------------------- *) let SUM_1 = prove (`sum(0..1) f = f 0 + f 1`, REWRITE_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG; LE_0]);; let SUM_2 = prove (`sum(0..2) f = f 0 + f 1 + f 2`, SIMP_TAC[num_CONV `2`; num_CONV `1`; SUM_CLAUSES_NUMSEG; LE_0; REAL_ADD_AC]);; (* ------------------------------------------------------------------------- *) (* The key result. *) (* ------------------------------------------------------------------------- *) let DERANGEMENTS = prove (`!n. ~(n = 0) ==> &(derangements n) = &(FACT n) * sum(0..n) (\k. --(&1) pow k / &(FACT k))`, MATCH_MP_TAC DERANGEMENT_INDUCT THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[derangements; SUM_1] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[derangements; ARITH; SUM_2; SUM_1] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[ARITH_RULE `n + 2 = (n + 1) + 1`] THEN SIMP_TAC[SUM_ADD_SPLIT; LE_0; SUM_SING_NUMSEG] THEN REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[real_pow] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_ADD] THEN MP_TAC(SPEC `n:num` FACT_LT) THEN UNDISCH_TAC `~(n = 0)` THEN REWRITE_TAC[GSYM LT_NZ; REAL_POW_NEG; GSYM REAL_OF_NUM_LT; REAL_POW_ONE] THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* A more "explicit" formula. We could sharpen 1/2 to 0.3678794+epsilon *) (* ------------------------------------------------------------------------- *) let DERANGEMENTS_EXP = prove (`!n. ~(n = 0) ==> let e = exp(&1) in abs(&(derangements n) - &(FACT n) / e) < &1 / &2`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DERANGEMENTS; LET_DEF; LET_END_DEF] THEN REWRITE_TAC[real_div; GSYM REAL_EXP_NEG] THEN ASM_CASES_TAC `n < 5` THENL [FIRST_X_ASSUM(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP (ARITH_RULE `n < 5 ==> n = 0 \/ n = 1 \/ n = 2 \/ n = 3 \/ n = 4`)) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC(map (num_CONV o mk_small_numeral) (1--5)) THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `abs x < a <=> --a < x /\ x < a`] THEN REWRITE_TAC[real_sub] THEN CONJ_TAC THEN CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN MP_TAC(SPECL [`-- &1`; `n + 1`] MCLAURIN_EXP_LE) THEN SIMP_TAC[PSUM_SUM_NUMSEG; ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[ARITH_RULE `(0 + n + 1) - 1 = n`; GSYM real_div] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `abs(a * b - a * (b + c)) = abs(a * c)`] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_RID] THEN REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN SIMP_TAC[REAL_OF_NUM_LT; FACT_LT; REAL_FIELD `&0 < a ==> a * b / ((&n + &1) * a) = b / (&n + &1)`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `exp(&1)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_EXP_MONO_LE] THEN UNDISCH_TAC `abs(u) <= abs(-- &1)` THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&3` THEN CONJ_TAC THENL [CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN UNDISCH_TAC `~(n < 5)` THEN REWRITE_TAC[NOT_LT; GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence the critical "rounding" property. *) (* ------------------------------------------------------------------------- *) let round = new_definition `round x = @n. integer(n) /\ n - &1 / &2 <= x /\ x < n + &1 / &2`;; let ROUND_WORKS = prove (`!x. integer(round x) /\ round x - &1 / &2 <= x /\ x < round x + &1 / &2`, GEN_TAC THEN REWRITE_TAC[round] THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC `floor(x + &1 / &2)` THEN MP_TAC(SPEC `x + &1 / &2` FLOOR) THEN SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let DERANGEMENTS_EXP = prove (`!n. ~(n = 0) ==> let e = exp(&1) in &(derangements n) = round(&(FACT n) / e)`, REPEAT STRIP_TAC THEN LET_TAC THEN MATCH_MP_TAC REAL_EQ_INTEGERS_IMP THEN REWRITE_TAC[INTEGER_CLOSED; ROUND_WORKS] THEN MP_TAC(SPEC `&(FACT n) / e` ROUND_WORKS) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DERANGEMENTS_EXP) THEN ASM_REWRITE_TAC[LET_DEF; LET_END_DEF] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Put them together. *) (* ------------------------------------------------------------------------- *) let THE_DERANGEMENTS_FORMULA = prove (`!n s. s HAS_SIZE n /\ ~(n = 0) ==> FINITE {p | p deranges s} /\ let e = exp(&1) in &(CARD {p | p deranges s}) = round(&(FACT n) / e)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP NUMBER_OF_DERANGEMENTS) THEN ASM_SIMP_TAC[HAS_SIZE; DERANGEMENTS_EXP]);; hol-light/100/desargues.ml000066400000000000000000000377001303454263000155700ustar00rootroot00000000000000(* ========================================================================= *) (* #87: Desargues's theorem. *) (* ========================================================================= *) needs "Multivariate/cross.ml";; (* ------------------------------------------------------------------------- *) (* A lemma we want to justify some of the axioms. *) (* ------------------------------------------------------------------------- *) let NORMAL_EXISTS = prove (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN MP_TAC(ISPEC `{u:real^3,v}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; DIMINDEX_3] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD {u:real^3,v}` THEN CONJ_TAC THEN SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_EMPTY] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Type of directions. *) (* ------------------------------------------------------------------------- *) let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") (MESON[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] `?x:real^3. ~(x = vec 0)`);; parse_as_infix("||",(11,"right"));; parse_as_infix("_|_",(11,"right"));; let perpdir = new_definition `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; let pardir = new_definition `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; let DIRECTION_CLAUSES = prove (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, MESON_TAC[direction_tybij]);; let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) (`(!x. x || x) /\ (!x y. x || y <=> y || x) /\ (!x y z. x || y /\ y || z ==> x || z)`, REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let PARDIR_EQUIV = prove (`!x y. ((||) x = (||) y) <=> x || y`, REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS]);; let DIRECTION_AXIOM_1 = prove (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_2 = prove (`!l l'. ?p. p _|_ l /\ p _|_ l'`, REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; let DIRECTION_AXIOM_3 = prove (`?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN MAP_EVERY (fun t -> EXISTS_TAC t THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_3; ARITH]) [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN VEC3_TAC);; let DIRECTION_AXIOM_4_WEAK = prove (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 2) cross (l cross basis 3) = vec 0)` MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; let ORTHOGONAL_COMBINE = prove (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_4 = prove (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ p _|_ l /\ p' _|_ l /\ p'' _|_ l`, MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; let PERPDIR_WELLDEF = prove (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let perpl,perpl_th = lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) "perpl" PERPDIR_WELLDEF;; let line_lift_thm = lift_theorem line_tybij (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; let point_tybij = new_type_definition "point" ("mk_point","dest_point") (prove(`?x:line. T`,REWRITE_TAC[]));; parse_as_infix("on",(11,"right"));; let on = new_definition `p on l <=> perpl (dest_point p) l`;; let POINT_CLAUSES = prove (`((p = p') <=> (dest_point p = dest_point p')) /\ ((!p. P (dest_point p)) <=> (!l. P l)) /\ ((?p. P (dest_point p)) <=> (?l. P l))`, MESON_TAC[point_tybij]);; let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; let AXIOM_1 = prove (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ !l'. p on l' /\ p' on l' ==> (l' = l)`, POINT_TAC LINE_AXIOM_1);; let AXIOM_2 = prove (`!l l'. ?p. p on l /\ p on l'`, POINT_TAC LINE_AXIOM_2);; let AXIOM_3 = prove (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p on l /\ p' on l /\ p'' on l)`, POINT_TAC LINE_AXIOM_3);; let AXIOM_4 = prove (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p on l /\ p' on l /\ p'' on l`, POINT_TAC LINE_AXIOM_4);; (* ------------------------------------------------------------------------- *) (* Mappings from vectors in R^3 to projective lines and points. *) (* ------------------------------------------------------------------------- *) let projl = new_definition `projl x = mk_line((||) (mk_dir x))`;; let projp = new_definition `projp x = mk_point(projl x)`;; (* ------------------------------------------------------------------------- *) (* Mappings in the other direction, to (some) homogeneous coordinates. *) (* ------------------------------------------------------------------------- *) let PROJL_TOTAL = prove (`!l. ?x. ~(x = vec 0) /\ l = projl x`, GEN_TAC THEN SUBGOAL_THEN `?d. l = mk_line((||) d)` (CHOOSE_THEN SUBST1_TAC) THENL [MESON_TAC[fst line_tybij; snd line_tybij]; REWRITE_TAC[projl] THEN EXISTS_TAC `dest_dir d` THEN MESON_TAC[direction_tybij]]);; let homol = new_specification ["homol"] (REWRITE_RULE[SKOLEM_THM] PROJL_TOTAL);; let PROJP_TOTAL = prove (`!p. ?x. ~(x = vec 0) /\ p = projp x`, REWRITE_TAC[projp] THEN MESON_TAC[PROJL_TOTAL; point_tybij]);; let homop_def = new_definition `homop p = homol(dest_point p)`;; let homop = prove (`!p. ~(homop p = vec 0) /\ p = projp(homop p)`, GEN_TAC THEN REWRITE_TAC[homop_def; projp; MESON[point_tybij] `p = mk_point l <=> dest_point p = l`] THEN MATCH_ACCEPT_TAC homol);; (* ------------------------------------------------------------------------- *) (* Key equivalences of concepts in projective space and homogeneous coords. *) (* ------------------------------------------------------------------------- *) let parallel = new_definition `parallel x y <=> x cross y = vec 0`;; let ON_HOMOL = prove (`!p l. p on l <=> orthogonal (homop p) (homol l)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homop; homol] THEN REWRITE_TAC[on; projp; projl; REWRITE_RULE[] point_tybij] THEN REWRITE_TAC[GSYM perpl_th; perpdir] THEN BINOP_TAC THEN MESON_TAC[homol; homop; direction_tybij]);; let EQ_HOMOL = prove (`!l l'. l = l' <=> parallel (homol l) (homol l')`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [homol] THEN REWRITE_TAC[projl; MESON[fst line_tybij; snd line_tybij] `mk_line((||) l) = mk_line((||) l') <=> (||) l = (||) l'`] THEN REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir; parallel] THEN MESON_TAC[homol; direction_tybij]);; let EQ_HOMOP = prove (`!p p'. p = p' <=> parallel (homop p) (homop p')`, REWRITE_TAC[homop_def; GSYM EQ_HOMOL] THEN MESON_TAC[point_tybij]);; (* ------------------------------------------------------------------------- *) (* A "welldefinedness" result for homogeneous coordinate map. *) (* ------------------------------------------------------------------------- *) let PARALLEL_PROJL_HOMOL = prove (`!x. parallel x (homol(projl x))`, GEN_TAC THEN REWRITE_TAC[parallel] THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN ASM_REWRITE_TAC[CROSS_0] THEN MP_TAC(ISPEC `projl x` homol) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [projl] THEN DISCH_THEN(MP_TAC o AP_TERM `dest_line`) THEN REWRITE_TAC[MESON[fst line_tybij; snd line_tybij] `dest_line(mk_line((||) l)) = (||) l`] THEN REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir] THEN ASM_MESON_TAC[direction_tybij]);; let PARALLEL_PROJP_HOMOP = prove (`!x. parallel x (homop(projp x))`, REWRITE_TAC[homop_def; projp; REWRITE_RULE[] point_tybij] THEN REWRITE_TAC[PARALLEL_PROJL_HOMOL]);; let PARALLEL_PROJP_HOMOP_EXPLICIT = prove (`!x. ~(x = vec 0) ==> ?a. ~(a = &0) /\ homop(projp x) = a % x`, MP_TAC PARALLEL_PROJP_HOMOP THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[parallel; CROSS_EQ_0; COLLINEAR_LEMMA] THEN GEN_TAC THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN ASM_REWRITE_TAC[homop] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[homop; VECTOR_MUL_LZERO]);; (* ------------------------------------------------------------------------- *) (* Brackets, collinearity and their connection. *) (* ------------------------------------------------------------------------- *) let bracket = define `bracket[a;b;c] = det(vector[homop a;homop b;homop c])`;; let COLLINEAR = new_definition `COLLINEAR s <=> ?l. !p. p IN s ==> p on l`;; let COLLINEAR_SINGLETON = prove (`!a. COLLINEAR {a}`, REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[AXIOM_1; AXIOM_3]);; let COLLINEAR_PAIR = prove (`!a b. COLLINEAR{a,b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:point = b` THEN ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SINGLETON] THEN REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[AXIOM_1]);; let COLLINEAR_TRIPLE = prove (`!a b c. COLLINEAR{a,b,c} <=> ?l. a on l /\ b on l /\ c on l`, REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY]);; let COLLINEAR_BRACKET = prove (`!p1 p2 p3. COLLINEAR {p1,p2,p3} <=> bracket[p1;p2;p3] = &0`, let lemma = prove (`!a b c x y. x cross y = vec 0 /\ ~(x = vec 0) /\ orthogonal a x /\ orthogonal b x /\ orthogonal c x ==> orthogonal a y /\ orthogonal b y /\ orthogonal c y`, REWRITE_TAC[orthogonal] THEN VEC3_TAC) in REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[COLLINEAR_TRIPLE; bracket; ON_HOMOL; LEFT_IMP_EXISTS_THM] THEN MP_TAC homol THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[DET_3; orthogonal; DOT_3; VECTOR_3; CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT] THEN CONV_TAC REAL_RING; ASM_CASES_TAC `p1:point = p2` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_PAIR]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[parallel; COLLINEAR_TRIPLE; bracket; EQ_HOMOP; ON_HOMOL] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `mk_line((||) (mk_dir(homop p1 cross homop p2)))` THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `homop p1 cross homop p2` THEN ASM_REWRITE_TAC[ORTHOGONAL_CROSS] THEN REWRITE_TAC[orthogonal] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ONCE_REWRITE_TAC[CROSS_TRIPLE] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[DOT_CROSS_DET] THEN REWRITE_TAC[GSYM projl; GSYM parallel; PARALLEL_PROJL_HOMOL]]);; (* ------------------------------------------------------------------------- *) (* Rather crude shuffling of bracket triple into canonical order. *) (* ------------------------------------------------------------------------- *) let BRACKET_SWAP,BRACKET_SHUFFLE = (CONJ_PAIR o prove) (`bracket[x;y;z] = --bracket[x;z;y] /\ bracket[x;y;z] = bracket[y;z;x] /\ bracket[x;y;z] = bracket[z;x;y]`, REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; let BRACKET_SWAP_CONV = let conv = GEN_REWRITE_CONV I [BRACKET_SWAP] in fun tm -> let th = conv tm in let tm' = rand(rand(concl th)) in if term_order tm tm' then th else failwith "BRACKET_SWAP_CONV";; (* ------------------------------------------------------------------------- *) (* Direct proof following Richter-Gebert's "Meditations on Ceva's Theorem", *) (* except for a change of variable names. The degenerate conditions here are *) (* just those that naturally get used in the proof. *) (* ------------------------------------------------------------------------- *) let DESARGUES_DIRECT = prove (`~COLLINEAR {A',B,S} /\ ~COLLINEAR {A,P,C} /\ ~COLLINEAR {A,P,R} /\ ~COLLINEAR {A,C,B} /\ ~COLLINEAR {A,B,R} /\ ~COLLINEAR {C',P,A'} /\ ~COLLINEAR {C',P,B} /\ ~COLLINEAR {C',P,B'} /\ ~COLLINEAR {C',A',S} /\ ~COLLINEAR {C',A',B'} /\ ~COLLINEAR {P,C,A'} /\ ~COLLINEAR {P,C,B} /\ ~COLLINEAR {P,A',R} /\ ~COLLINEAR {P,B,Q} /\ ~COLLINEAR {P,Q,B'} /\ ~COLLINEAR {C,B,S} /\ ~COLLINEAR {A',Q,B'} ==> COLLINEAR {P,A',A} /\ COLLINEAR {P,B,B'} /\ COLLINEAR {P,C',C} /\ COLLINEAR {B,C,Q} /\ COLLINEAR {B',C',Q} /\ COLLINEAR {A,R,C} /\ COLLINEAR {A',C',R} /\ COLLINEAR {B,S,A} /\ COLLINEAR {A',S,B'} ==> COLLINEAR {Q,S,R}`, REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_BRACKET] THEN DISCH_TAC THEN SUBGOAL_THEN `(bracket[P;A';A] = &0 ==> bracket[P;A';R] * bracket[P;A;C] = bracket[P;A';C] * bracket[P;A;R]) /\ (bracket[P;B;B'] = &0 ==> bracket[P;B;Q] * bracket[P;B';C'] = bracket[P;B;C'] * bracket[P;B';Q]) /\ (bracket[P;C';C] = &0 ==> bracket[P;C';B] * bracket[P;C;A'] = bracket[P;C';A'] * bracket[P;C;B]) /\ (bracket[B;C;Q] = &0 ==> bracket[B;C;P] * bracket[B;Q;S] = bracket[B;C;S] * bracket[B;Q;P]) /\ (bracket[B';C';Q] = &0 ==> bracket[B';C';A'] * bracket[B';Q;P] = bracket[B';C';P] * bracket[B';Q;A']) /\ (bracket[A;R;C] = &0 ==> bracket[A;R;P] * bracket[A;C;B] = bracket[A;R;B] * bracket[A;C;P]) /\ (bracket[A';C';R] = &0 ==> bracket[A';C';P] * bracket[A';R;S] = bracket[A';C';S] * bracket[A';R;P]) /\ (bracket[B;S;A] = &0 ==> bracket[B;S;C] * bracket[B;A;R] = bracket[B;S;R] * bracket[B;A;C]) /\ (bracket[A';S;B'] = &0 ==> bracket[A';S;C'] * bracket[A';B';Q] = bracket[A';S;Q] * bracket[A';B';C'])` MP_TAC THENL [REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING; ALL_TAC] THEN REPEAT(MATCH_MP_TAC(TAUT `(c ==> d ==> b ==> e) ==> ((a ==> b) /\ c ==> a /\ d ==> e)`)) THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o MATCH_MP th)) THEN REPEAT(ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING `a = b /\ x:real = y ==> a * x = b * y`))) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[BRACKET_SHUFFLE] THEN CONV_TAC(ONCE_DEPTH_CONV BRACKET_SWAP_CONV) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_NEG_NEG; REAL_NEG_EQ_0] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `!b. (a ==> b) /\ (b ==> c) ==> a ==> c`) THEN EXISTS_TAC `bracket[B;Q;S] * bracket[A';R;S] = bracket[B;R;S] * bracket[A';Q;S]` THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; hol-light/100/descartes.ml000066400000000000000000001227751303454263000155720ustar00rootroot00000000000000(* ========================================================================= *) (* Rob Arthan's "Descartes's Rule of Signs by an Easy Induction". *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* A couple of handy lemmas. *) (* ------------------------------------------------------------------------- *) let OPPOSITE_SIGNS = prove (`!a b:real. a * b < &0 <=> &0 < a /\ b < &0 \/ a < &0 /\ &0 < b`, REWRITE_TAC[REAL_ARITH `a * b < &0 <=> &0 < a * --b`; REAL_MUL_POS_LT] THEN REAL_ARITH_TAC);; let VARIATION_SET_FINITE = prove (`FINITE s ==> FINITE {p,q | p IN s /\ q IN s /\ P p q}`, REWRITE_TAC[SET_RULE `{p,q | p IN s /\ q IN t /\ R p q} = {p,q | p IN s /\ q IN {q | q IN t /\ R p q}}`] THEN SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_RESTRICT]);; (* ------------------------------------------------------------------------- *) (* Variation in a sequence of coefficients. *) (* ------------------------------------------------------------------------- *) let variation = new_definition `variation s (a:num->real) = CARD {(p,q) | p IN s /\ q IN s /\ p < q /\ a(p) * a(q) < &0 /\ !i. i IN s /\ p < i /\ i < q ==> a(i) = &0 }`;; let VARIATION_EQ = prove (`!a b s. (!i. i IN s ==> a i = b i) ==> variation s a = variation s b`, REPEAT STRIP_TAC THEN REWRITE_TAC[variation] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN ASM_MESON_TAC[]);; let VARIATION_SUBSET = prove (`!a s t. t SUBSET s /\ (!i. i IN (s DIFF t) ==> a i = &0) ==> variation s a = variation t a`, REWRITE_TAC[IN_DIFF; SUBSET] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[variation] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN ASM_MESON_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL]);; let VARIATION_SPLIT = prove (`!a s n. FINITE s /\ n IN s /\ ~(a n = &0) ==> variation s a = variation {i | i IN s /\ i <= n} a + variation {i | i IN s /\ n <= i} a`, REWRITE_TAC[variation] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[VARIATION_SET_FINITE; FINITE_RESTRICT] THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM] THEN CONJ_TAC THENL [REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN REWRITE_TAC[IN_ELIM_THM] THEN ARITH_TAC; REWRITE_TAC[IN_UNION; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [STRIP_TAC; STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `n:num` th) THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC th) THEN SIMP_TAC[TAUT `~(a /\ b) <=> ~b \/ ~a`] THEN MATCH_MP_TAC MONO_OR] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN TRY(FIRST_ASSUM MATCH_MP_TAC) THEN FIRST_ASSUM(fun th -> MP_TAC(SPEC `n:num` th) THEN ASM_REWRITE_TAC[]) THEN ASM_ARITH_TAC]);; let VARIATION_SPLIT_NUMSEG = prove (`!a m n p. n IN m..p /\ ~(a n = &0) ==> variation(m..p) a = variation(m..n) a + variation(n..p) a`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> b /\ c ==> a ==> d`] VARIATION_SPLIT)) THEN REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN ASM_ARITH_TAC);; let VARIATION_1 = prove (`!a n. variation {n} a = 0`, REWRITE_TAC[variation; IN_SING] THEN REWRITE_TAC[ARITH_RULE `p:num = n /\ q = n /\ p < q /\ X <=> F`] THEN MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; NOT_IN_EMPTY]);; let VARIATION_2 = prove (`!a m n. variation {m,n} a = if a(m) * a(n) < &0 then 1 else 0`, GEN_TAC THEN MATCH_MP_TAC WLOG_LT THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[INSERT_AC; VARIATION_1; GSYM REAL_NOT_LE; REAL_LE_SQUARE]; REWRITE_TAC[INSERT_AC; REAL_MUL_SYM]; REPEAT STRIP_TAC THEN REWRITE_TAC[variation; IN_INSERT; NOT_IN_EMPTY] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> (a /\ b /\ c) /\ d /\ e`] THEN ASM_SIMP_TAC[ARITH_RULE `m:num < n ==> ((p = m \/ p = n) /\ (q = m \/ q = n) /\ p < q <=> p = m /\ q = n)`] THEN REWRITE_TAC[MESON[] `(p = m /\ q = n) /\ X p q <=> (p = m /\ q = n) /\ X m n`] THEN REWRITE_TAC[ARITH_RULE `(i:num = m \/ i = n) /\ m < i /\ i < n <=> F`] THEN ASM_CASES_TAC `a m * a(n:num) < &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[SET_RULE `{p,q | p = a /\ q = b} = {(a,b)}`] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH]; MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN SIMP_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; NOT_IN_EMPTY]]]);; let VARIATION_3 = prove (`!a m n p. m < n /\ n < p ==> variation {m,n,p} a = if a(n) = &0 then variation{m,p} a else variation {m,n} a + variation{n,p} a`, REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [MATCH_MP_TAC VARIATION_SUBSET THEN ASM SET_TAC[]; MP_TAC(ISPECL [`a:num->real`; `{m:num,n,p}`; `n:num`] VARIATION_SPLIT) THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN SUBST1_TAC THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN ASM_ARITH_TAC]);; let VARIATION_OFFSET = prove (`!p m n a. variation(m+p..n+p) a = variation(m..n) (\i. a(i + p))`, REPEAT GEN_TAC THEN REWRITE_TAC[variation] THEN MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN MAP_EVERY EXISTS_TAC [`\(i:num,j). i - p,j - p`; `\(i:num,j). i + p,j + p`] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN SIMP_TAC[VARIATION_SET_FINITE; FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG; PAIR_EQ] THEN REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y < &0 ==> x = y ==> x < &0`)) THEN BINOP_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `i - p:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC EQ_IMP] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The crucial lemma (roughly Lemma 2 in the paper). *) (* ------------------------------------------------------------------------- *) let ARTHAN_LEMMA = prove (`!n a b. ~(a n = &0) /\ (b n = &0) /\ (!m. sum(0..m) a = b m) ==> ?d. ODD d /\ variation (0..n) a = variation (0..n) b + d`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = 1 \/ 2 <= n`)) THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN REWRITE_TAC[VARIATION_2; OPPOSITE_SIGNS] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `0` th) THEN MP_TAC(SPEC `1` th)) THEN SIMP_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?p. 1 < p /\ p <= n /\ ~(a p = &0)` MP_TAC THENL [ASM_MESON_TAC[ARITH_RULE `2 <= n ==> 1 < n`; LE_REFL]; GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[TAUT `a ==> ~(b /\ c /\ ~d) <=> a /\ b /\ c ==> d`] THEN STRIP_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`(\i. if i + 1 = 1 then a 0 + a 1 else a(i + 1)):num->real`; `(\i. b(i + 1)):num->real`]) THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1) /\ n - 1 + 1 = n`] THEN REWRITE_TAC[GSYM(SPEC `1` VARIATION_OFFSET)] THEN ANTS_TAC THENL [X_GEN_TAC `m:num` THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(0..m+1) a` THEN CONJ_TAC THENL [SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH_RULE `0 + 1 <= n + 1`] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[ARITH_RULE `2 = 1 + 1`; SUM_OFFSET] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN ARITH_TAC; ASM_REWRITE_TAC[]]; ABBREV_TAC `a':num->real = \m. if m = 1 then a 0 + a 1 else a m` THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> n - 1 + 1 = n /\ n - 1 - 1 + 1 = n - 1`] THEN CONV_TAC NUM_REDUCE_CONV] THEN SUBGOAL_THEN `variation (1..n) a' = variation {1,p} a' + variation (p..n) a /\ variation (0..n) a = variation {0,1,p} a + variation (p..n) a` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC EQ_TRANS THENL [EXISTS_TAC `variation(1..p) a' + variation(p..n) a'`; EXISTS_TAC `variation(0..p) a + variation(p..n) a`] THEN (CONJ_TAC THENL [MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN EXPAND_TAC "a'" THEN REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; BINOP_TAC THENL [MATCH_MP_TAC VARIATION_SUBSET; MATCH_MP_TAC VARIATION_EQ] THEN EXPAND_TAC "a'" THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[IN_NUMSEG] THEN TRY(GEN_TAC THEN ASM_ARITH_TAC) THEN (CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[IN_DIFF]]) THEN REWRITE_TAC[IN_NUMSEG; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_ARITH_TAC]); ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (INT_ARITH `a + b:int = c + d ==> c = (a + b) - d`)) THEN REWRITE_TAC[INT_ARITH `a + b:int = c + d <=> d = (a + b) - c`] THEN ASM_CASES_TAC `a 0 + a 1 = &0` THENL [SUBGOAL_THEN `!i. 0 < i /\ i < p ==> b i = &0` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `i:num`) THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH_RULE `0 < i ==> 0 + 1 <= i`] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LID] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(b:num->real) p = a p` ASSUME_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN SIMP_TAC[SUM_CLAUSES_RIGHT; ASSUME `1 < p`; ARITH_RULE `1 < p ==> 0 < p /\ 0 <= p`] THEN ASM_REWRITE_TAC[REAL_EQ_ADD_RCANCEL_0] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `variation(0..n) b = variation {0,p} b + variation(1..n) b` SUBST1_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `variation(0..p) b + variation(p..n) b` THEN CONJ_TAC THENL [MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN REWRITE_TAC[IN_NUMSEG] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `p:num`) THEN SIMP_TAC[SUM_CLAUSES_RIGHT; ASSUME `1 < p`; ARITH_RULE `1 < p ==> 0 < p /\ 0 <= p`] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `~(ap = &0) ==> s = &0 ==> ~(s + ap = &0)`)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; BINOP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN MATCH_MP_TAC VARIATION_SUBSET THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_NUMSEG; IN_INSERT; NOT_IN_EMPTY] THEN (CONJ_TAC THENL [ASM_ARITH_TAC; REPEAT STRIP_TAC]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC]; SUBGOAL_THEN `variation(0..n) b = variation {0,1} b + variation(1..n) b` SUBST1_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `variation(0..1) b + variation(1..n) b` THEN CONJ_TAC THENL [MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN REWRITE_TAC[IN_NUMSEG] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `1`) THEN SIMP_TAC[SUM_CLAUSES_NUMSEG; num_CONV `1`] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]; AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VARIATION_SUBSET THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_NUMSEG; IN_INSERT; NOT_IN_EMPTY] THEN ARITH_TAC]; SUBGOAL_THEN `(b:num->real) 1 = a 0 + a 1` ASSUME_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN SIMP_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC]]] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `0`)) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[SUM_SING_NUMSEG] THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN ASM_SIMP_TAC[VARIATION_3; ARITH; OPPOSITE_SIGNS] THEN COND_CASES_TAC THEN REWRITE_TAC[VARIATION_2; OPPOSITE_SIGNS; REAL_LT_REFL] THEN EXPAND_TAC "a'" THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_SIMP_TAC[ARITH_RULE `1 < p ==> ~(p = 1)`; REAL_LT_REFL] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(BINDER_CONV(RAND_CONV(RAND_CONV INT_POLY_CONV))) THEN REWRITE_TAC[INT_ARITH `x:int = y + --z <=> x + z = y`] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN ASM_REWRITE_TAC[ODD_ADD; ARITH_ODD; ARITH_EVEN] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Relate even-ness or oddity of variation to signs of end coefficients. *) (* ------------------------------------------------------------------------- *) let VARIATION_OPPOSITE_ENDS = prove (`!a m n. m <= n /\ ~(a m = &0) /\ ~(a n = &0) ==> (ODD(variation(m..n) a) <=> a m * a n < &0)`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `n - m:num` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `!i:num. m < i /\ i < n ==> a i = &0` THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `ODD(variation {m,n} a)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC VARIATION_SUBSET THEN ASM_REWRITE_TAC[INSERT_SUBSET; IN_NUMSEG; IN_DIFF; EMPTY_SUBSET] THEN REWRITE_TAC[LE_REFL; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[VARIATION_2] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`n:num`; `p:num`] th) THEN MP_TAC(SPECL [`p:num`; `m:num`] th)) THEN ASM_SIMP_TAC[LT_IMP_LE] THEN REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `ODD(variation(m..p) a + variation(p..n) a)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN ASM_SIMP_TAC[LT_IMP_LE; IN_NUMSEG]; ASM_REWRITE_TAC[ODD_ADD; OPPOSITE_SIGNS] THEN ASM_REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Polynomial with odd variation has at least one positive root. *) (* This is the only "analytical" part of the proof. *) (* ------------------------------------------------------------------------- *) let REAL_POLYFUN_SGN_AT_INFINITY = prove (`!a n. ~(a n = &0) ==> ?B. &0 < B /\ !x. B <= abs x ==> real_sgn(sum(0..n) (\i. a i * x pow i)) = real_sgn(a n * x pow n)`, let lemma = prove (`abs(x) < abs(y) ==> real_sgn(x + y) = real_sgn y`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01; SUM_SING_NUMSEG]; ALL_TAC] THEN ABBREV_TAC `B = sum (0..n-1) (\i. abs(a i)) / abs(a n)` THEN SUBGOAL_THEN `&0 <= B` ASSUME_TAC THENL [EXPAND_TAC "B" THEN SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS; SUM_POS_LE_NUMSEG]; ALL_TAC] THEN EXISTS_TAC `&1 + B` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_0; LE_1] THEN MATCH_MP_TAC lemma THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(0..n-1) (\i. abs(a i)) * abs x pow (n - 1)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS; REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; SUBGOAL_THEN `(x:real) pow n = x * x pow (n - 1)` SUBST1_TAC THENL [SIMP_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC]]]);; let REAL_POLYFUN_HAS_POSITIVE_ROOT = prove (`!a n. a 0 < &0 /\ &0 < a n ==> ?x. &0 < x /\ sum(0..n) (\i. a i * x pow i) = &0`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?x. &0 < x /\ &0 <= sum(0..n) (\i. a i * x pow i)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`a:num->real`; `n:num`] REAL_POLYFUN_SGN_AT_INFINITY) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real`)) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `real_sgn(a n * x pow n) = &1` SUBST1_TAC THEN ASM_SIMP_TAC[REAL_SGN_EQ; REAL_LT_MUL; REAL_POW_LT; real_gt] THEN REWRITE_TAC[REAL_LT_IMP_LE]; MP_TAC(ISPECL [`\x. sum(0..n) (\i. a i * x pow i)`; `&0`; `x:real`; `&0`] REAL_IVT_INCREASING) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; IN_REAL_INTERVAL; REAL_POW_ZERO; COND_RAND] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG; LE_0] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real` THEN SIMP_TAC[REAL_LT_LE] THEN ASM_CASES_TAC `y:real = &0` THEN ASM_SIMP_TAC[REAL_POW_ZERO; COND_RAND; REAL_MUL_RZERO; REAL_MUL_RID] THEN REWRITE_TAC[SUM_DELTA; IN_NUMSEG; LE_0] THEN ASM_REAL_ARITH_TAC]]);; let ODD_VARIATION_POSITIVE_ROOT = prove (`!a n. ODD(variation(0..n) a) ==> ?x. &0 < x /\ sum(0..n) (\i. a i * x pow i) = &0`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?M. !i. i IN 0..n /\ ~(a i = &0) ==> i <= M` MP_TAC THENL [EXISTS_TAC `n:num` THEN SIMP_TAC[IN_NUMSEG]; ALL_TAC] THEN SUBGOAL_THEN `?i. i IN 0..n /\ ~(a i = &0)` MP_TAC THENL [MATCH_MP_TAC(MESON[] `((!i. P i ==> Q i) ==> F) ==> ?i. P i /\ ~Q i`) THEN DISCH_TAC THEN SUBGOAL_THEN `variation (0..n) a = variation {0} a` (fun th -> SUBST_ALL_TAC th THEN ASM_MESON_TAC[VARIATION_1; ODD]) THEN MATCH_MP_TAC VARIATION_SUBSET THEN ASM_SIMP_TAC[IN_DIFF] THEN REWRITE_TAC[IN_NUMSEG; SING_SUBSET; LE_0]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> a ==> a /\ b ==> c`] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[num_MAX] THEN REWRITE_TAC[TAUT `p ==> ~(q /\ r) <=> p /\ q ==> ~r`; IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN DISCH_THEN(X_CHOOSE_THEN `q:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `p:num <= q` ASSUME_TAC THENL [ASM_MESON_TAC[NOT_LT]; ALL_TAC] THEN SUBGOAL_THEN `(a:num->real) p * a q < &0` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM VARIATION_OPPOSITE_ENDS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `ODD p ==> p = q ==> ODD q`)) THEN MATCH_MP_TAC VARIATION_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG; IN_NUMSEG; IN_DIFF; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_ARITH_TAC; REPEAT STRIP_TAC] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_ARITH_TAC); ALL_TAC] THEN MP_TAC(ISPECL [`\i. (a:num->real)(p + i) / a q`; `q - p:num`] REAL_POLYFUN_HAS_POSITIVE_ROOT) THEN ASM_SIMP_TAC[ADD_CLAUSES; ARITH_RULE `p:num <= q ==> p + q - p = q`] THEN ANTS_TAC THENL [REWRITE_TAC[real_div; OPPOSITE_SIGNS; REAL_MUL_POS_LT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPPOSITE_SIGNS]) THEN REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`; GSYM REAL_INV_NEG] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_RING `!a. y = a * x ==> x = &0 ==> y = &0`) THEN EXISTS_TAC `(a:num->real) q * x pow p` THEN REWRITE_TAC[GSYM SUM_LMUL; REAL_ARITH `(aq * xp) * api / aq * xi:real = (aq / aq) * api * (xp * xi)`] THEN ASM_CASES_TAC `(a:num->real) q = &0` THENL [ASM_MESON_TAC[REAL_MUL_LZERO; REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_POW_ADD; REAL_DIV_REFL; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN MP_TAC(SPEC `p:num` SUM_OFFSET) THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[SUBSET_NUMSEG; IN_NUMSEG; IN_DIFF; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_ARITH_TAC; REPEAT STRIP_TAC] THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_ARITH_TAC));; (* ------------------------------------------------------------------------- *) (* Define root multiplicities. *) (* ------------------------------------------------------------------------- *) let multiplicity = new_definition `multiplicity f r = @k. ?a n. ~(sum(0..n) (\i. a i * r pow i) = &0) /\ !x. f(x) = (x - r) pow k * sum(0..n) (\i. a i * x pow i)`;; let MULTIPLICITY_UNIQUE = prove (`!f a r b m k. (!x. f(x) = (x - r) pow k * sum(0..m) (\j. b j * x pow j)) /\ ~(sum(0..m) (\j. b j * r pow j) = &0) ==> k = multiplicity f r`, let lemma = prove (`!i j f g. f real_continuous_on (:real) /\ g real_continuous_on (:real) /\ ~(f r = &0) /\ ~(g r = &0) ==> (!x. (x - r) pow i * f(x) = (x - r) pow j * g(x)) ==> j = i`, MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN MP_TAC(ISPECL [`atreal r`; `f:real->real`; `(f:real->real) r`; `&0`] REALLIM_UNIQUE) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_ATREAL] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_CONTINUOUS_ATREAL] THEN ASM_MESON_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; IN_UNIV]; MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\x:real. (x - r) pow (j - i) * g x` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; REAL_ARITH `&0 < abs(x - r) <=> ~(x = r)`] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_RING `!a. a * x = a * y /\ ~(a = &0) ==> x = y`) THEN EXISTS_TAC `(x - r:real) pow i` THEN ASM_REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD; REAL_POW_EQ_0] THEN ASM_SIMP_TAC[REAL_SUB_0; ARITH_RULE `i:num < j ==> i + j - i = j`]; SUBST1_TAC(REAL_ARITH `&0 = &0 * (g:real->real) r`) THEN MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THENL [REWRITE_TAC[] THEN MATCH_MP_TAC REALLIM_NULL_POW THEN REWRITE_TAC[GSYM REALLIM_NULL; REALLIM_ATREAL_ID] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM REAL_CONTINUOUS_ATREAL] THEN ASM_MESON_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; IN_UNIV]]]]) in REPEAT STRIP_TAC THEN REWRITE_TAC[multiplicity] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `j:num` THEN EQ_TAC THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL [REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; DISCH_THEN SUBST1_TAC THEN MAP_EVERY EXISTS_TAC [`b:num->real`; `m:num`] THEN ASM_REWRITE_TAC[]]);; let MULTIPLICITY_WORKS = prove (`!r n a. (?i. i IN 0..n /\ ~(a i = &0)) ==> ?b m. ~(sum(0..m) (\i. b i * r pow i) = &0) /\ !x. sum(0..n) (\i. a i * x pow i) = (x - r) pow multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r * sum(0..m) (\i. b i * x pow i)`, REWRITE_TAC[multiplicity] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN ASM_CASES_TAC `(a:num->real) n = &0` THENL [ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `a:num->real`) THEN ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_0; LE_1] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `i:num` MP_TAC) THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i:num = n` THENL [ASM_MESON_TAC[]; ASM_ARITH_TAC]; ALL_TAC] THEN DISCH_THEN(K ALL_TAC) THEN ASM_CASES_TAC `sum(0..n) (\i. a i * r pow i) = &0` THENL [ASM_CASES_TAC `n = 0` THENL [UNDISCH_TAC `sum (0..n) (\i. a i * r pow i) = &0` THEN ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2; SUM_SING] THEN REWRITE_TAC[real_pow; REAL_MUL_RID] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(GEN `x:real` (ISPECL [`a:num->real`; `x:real`; `r:real`; `n:num`] REAL_SUB_POLYFUN)) THEN ASM_SIMP_TAC[LE_1; REAL_SUB_RZERO] THEN ABBREV_TAC `b j = sum (j + 1..n) (\i. a i * r pow (i - j - 1))` THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `b:num->real`) THEN ANTS_TAC THENL [EXISTS_TAC `n - 1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_0] THEN EXPAND_TAC "b" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[SUB_ADD; LE_1; SUM_SING_NUMSEG; real_pow; REAL_MUL_RID; ARITH_RULE `n - (n - 1) - 1 = 0`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (fun th -> EXISTS_TAC `SUC k` THEN MP_TAC th)) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC]; MAP_EVERY EXISTS_TAC [`0`; `a:num->real`; `n:num`] THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]]);; let MULTIPLICITY_OTHER_ROOT = prove (`!a n r s. ~(r = s) /\ (?i. i IN 0..n /\ ~(a i = &0)) ==> multiplicity (\x. (x - r) pow m * sum(0..n) (\i. a i * x pow i)) s = multiplicity (\x. sum(0..n) (\i. a i * x pow i)) s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MULTIPLICITY_UNIQUE THEN REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real`; `n:num`; `a:num->real`] MULTIPLICITY_WORKS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:num->real`; `p:num`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `?b q. !x. sum(0..q) (\j. b j * x pow j) = (x - r) pow m * sum (0..p) (\i. c i * x pow i)` MP_TAC THENL [ALL_TAC; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_RING `r * x = s * r * y <=> r = &0 \/ s * y = x`] THEN ASM_REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_SUB_0]] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`c:num->real`; `p:num`; `m:num`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THEN REPEAT GEN_TAC THENL [MAP_EVERY EXISTS_TAC [`c:num->real`; `p:num`] THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:num`; `c:num->real`]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num->real`; `n:num`] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN EXISTS_TAC `\i. (if 0 < i then a(i - 1) else &0) - (if i <= n then r * a i else &0)` THEN EXISTS_TAC `n + 1` THEN REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG] THEN X_GEN_TAC `x:real` THEN BINOP_TAC THENL [MP_TAC(ARITH_RULE `0 <= n + 1`) THEN SIMP_TAC[SUM_CLAUSES_LEFT] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[SUM_OFFSET; LT_REFL] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; ARITH_RULE `0 < i + 1`] THEN REWRITE_TAC[GSYM SUM_LMUL; ADD_SUB; REAL_POW_ADD; REAL_POW_1]; SIMP_TAC[SUM_CLAUSES_RIGHT; LE_0; ARITH_RULE `0 < n + 1`] THEN REWRITE_TAC[ADD_SUB; ARITH_RULE `~(n + 1 <= n)`] THEN SIMP_TAC[REAL_MUL_LZERO; REAL_ADD_RID; GSYM SUM_LMUL]] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* The main lemmas to be applied iteratively. *) (* ------------------------------------------------------------------------- *) let VARIATION_POSITIVE_ROOT_FACTOR = prove (`!a n r. ~(a n = &0) /\ &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0 ==> ?b. ~(b(n - 1) = &0) /\ (!x. sum(0..n) (\i. a i * x pow i) = (x - r) * sum(0..n-1) (\i. b i * x pow i)) /\ ?d. ODD d /\ variation(0..n) a = variation(0..n-1) b + d`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; real_pow; REAL_MUL_RID] THEN MESON_TAC[]; STRIP_TAC] THEN ABBREV_TAC `b = \j. sum (j + 1..n) (\i. a i * r pow (i - j - 1))` THEN EXISTS_TAC `b:num->real` THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[SUB_ADD; LE_1] THEN ASM_SIMP_TAC[SUM_SING_NUMSEG; ARITH_RULE `n - (n - 1) - 1 = 0`] THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_RID]; MP_TAC(GEN `x:real` (SPECL [`a:num->real`; `x:real`; `r:real`; `n:num`] REAL_SUB_POLYFUN)) THEN ASM_SIMP_TAC[LE_1; REAL_SUB_RZERO] THEN DISCH_THEN(K ALL_TAC) THEN EXPAND_TAC "b" THEN REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(b:num->real) n = &0` ASSUME_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`n:num`; `\i. if i <= n then a i * (r:real) pow i else &0`; `\i. if i <= n then --b i * (r:real) pow (i + 1) else &0`] ARTHAN_LEMMA) THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_LT_IMP_NZ; REAL_NEG_0; LE_REFL] THEN ANTS_TAC THENL [X_GEN_TAC `j:num` THEN EXPAND_TAC "b" THEN REWRITE_TAC[] THEN ASM_CASES_TAC `j:num <= n` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `!i:num. i <= j ==> i <= n` MP_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC)] THEN REWRITE_TAC[REAL_ARITH `a:real = --b * c <=> a + b * c = &0`] THEN REWRITE_TAC[GSYM SUM_RMUL; GSYM REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN SIMP_TAC[ARITH_RULE `j + 1 <= k ==> k - j - 1 + j + 1 = k`] THEN ASM_SIMP_TAC[SUM_COMBINE_R; LE_0]; REWRITE_TAC[GSYM SUM_RESTRICT_SET; IN_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `~(j <= n) ==> ((0 <= i /\ i <= j) /\ i <= n <=> 0 <= i /\ i <= n)`] THEN ASM_REWRITE_TAC[GSYM numseg]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE `x':num = x /\ y' = y ==> x' = y' + d ==> x = y + d`) THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `variation(0..n) (\i. a i * r pow i)` THEN CONJ_TAC THENL [MATCH_MP_TAC VARIATION_EQ THEN SIMP_TAC[IN_NUMSEG]; ALL_TAC]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `variation(0..n) (\i. --b i * r pow (i + 1))` THEN CONJ_TAC THENL [MATCH_MP_TAC VARIATION_EQ THEN SIMP_TAC[IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `variation(0..n-1) (\i. --b i * r pow (i + 1))` THEN CONJ_TAC THENL [MATCH_MP_TAC VARIATION_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG; IN_DIFF; IN_NUMSEG] THEN CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `i:num` THEN STRIP_TAC] THEN SUBGOAL_THEN `i:num = n` SUBST_ALL_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; ALL_TAC]] THEN REWRITE_TAC[variation] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * x) * (b * x'):real = (x * x') * a * b`] THEN SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC; GSYM REAL_POW_ADD; REAL_ARITH `--x * --y:real = x * y`] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * y < &0 <=> &0 < x * --y`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_POW_LT] THEN ASM_SIMP_TAC[REAL_MUL_RNEG; REAL_ENTIRE; REAL_NEG_EQ_0; REAL_POW_EQ_0] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]]);; let VARIATION_POSITIVE_ROOT_MULTIPLE_FACTOR = prove (`!r n a. ~(a n = &0) /\ &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0 ==> ?b k m. 0 < k /\ m < n /\ ~(b m = &0) /\ (!x. sum(0..n) (\i. a i * x pow i) = (x - r) pow k * sum(0..m) (\i. b i * x pow i)) /\ ~(sum(0..m) (\j. b j * r pow j) = &0) /\ ?d. EVEN d /\ variation(0..n) a = variation(0..m) b + k + d`, GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN ASM_CASES_TAC `n = 0` THENL [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; real_pow; REAL_MUL_RID] THEN MESON_TAC[]; STRIP_TAC] THEN MP_TAC(ISPECL [`a:num->real`; `n:num`; `r:real`] VARIATION_POSITIVE_ROOT_FACTOR) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:num->real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `sum(0..n-1) (\i. c i * r pow i) = &0` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `c:num->real`)] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `e:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_ASSOC] THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[ADD1; ADD_ASSOC] THEN EXISTS_TAC `d - 1 + e`; MAP_EVERY EXISTS_TAC [`c:num->real`; `1`; `n - 1`] THEN ASM_REWRITE_TAC[REAL_POW_1] THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN EXISTS_TAC `d - 1`] THEN UNDISCH_TAC `ODD d` THEN GEN_REWRITE_TAC LAND_CONV [ODD_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN ASM_REWRITE_TAC[SUC_SUB1; EVEN_ADD; EVEN_MULT; ARITH] THEN ARITH_TAC);; let VARIATION_POSITIVE_ROOT_MULTIPLICITY_FACTOR = prove (`!r n a. ~(a n = &0) /\ &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0 ==> ?b m. m < n /\ ~(b m = &0) /\ (!x. sum(0..n) (\i. a i * x pow i) = (x - r) pow (multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r) * sum(0..m) (\i. b i * x pow i)) /\ ~(sum(0..m) (\j. b j * r pow j) = &0) /\ ?d. EVEN d /\ variation(0..n) a = variation(0..m) b + multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r + d`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP VARIATION_POSITIVE_ROOT_MULTIPLE_FACTOR) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real` THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r = k` (fun th -> ASM_REWRITE_TAC[th]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MULTIPLICITY_UNIQUE THEN MAP_EVERY EXISTS_TAC [`b:num->real`; `m:num`] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence the main theorem. *) (* ------------------------------------------------------------------------- *) let DESCARTES_RULE_OF_SIGNS = prove (`!f a n. f = (\x. sum(0..n) (\i. a i * x pow i)) /\ (?i. i IN 0..n /\ ~(a i = &0)) ==> ?d. EVEN d /\ variation(0..n) a = nsum {r | &0 < r /\ f(r) = &0} (\r. multiplicity f r) + d`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`a:num->real`; `n:num`] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN ASM_CASES_TAC `(a:num->real) n = &0` THENL [ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2] THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `a:num->real`)] THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_NUMSEG; ARITH_RULE `i <= n ==> i <= n - 1 \/ i = n`]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN ASM_SIMP_TAC[LE_0; LE_1; SUM_CLAUSES_RIGHT] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN MATCH_MP_TAC VARIATION_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG; IN_DIFF; IN_NUMSEG] THEN CONJ_TAC THENL [ASM_ARITH_TAC; X_GEN_TAC `i:num` THEN STRIP_TAC] THEN SUBGOAL_THEN `i:num = n` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM_ARITH_TAC]; DISCH_THEN(K ALL_TAC)] THEN ASM_CASES_TAC `{r | &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0} = {}` THENL [ASM_REWRITE_TAC[NSUM_CLAUSES; ADD_CLAUSES] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1] THEN ONCE_REWRITE_TAC[GSYM NOT_ODD] THEN DISCH_THEN(MP_TAC o MATCH_MP ODD_VARIATION_POSITIVE_ROOT) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`r:real`; `n:num`; `a:num->real`] VARIATION_POSITIVE_ROOT_MULTIPLICITY_FACTOR) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:num->real`; `m:num`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `b:num->real`) THEN ANTS_TAC THENL [EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_0]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d1:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d2:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN EXISTS_TAC `d1 + d2:num` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[EVEN_ADD]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `x + y = z ==> (x + d1) + (y + d2):num = z + d1 + d2`) THEN SUBGOAL_THEN `{r | &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0} = r INSERT {r | &0 < r /\ sum(0..m) (\i. b i * r pow i) = &0}` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `x IN s /\ s DELETE x = t ==> s = x INSERT t`) THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_SUB_0] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DELETE] THEN X_GEN_TAC `s:real` THEN FIRST_X_ASSUM(K ALL_TAC o SPEC_VAR) THEN ASM_CASES_TAC `s:real = r` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `FINITE {r | &0 < r /\ sum(0..m) (\i. b i * r pow i) = &0}` MP_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{r | sum(0..m) (\i. b i * r pow i) = &0}` THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_POLYFUN_FINITE_ROOTS] THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_0; LE_REFL]; SIMP_TAC[NSUM_CLAUSES; IN_ELIM_THM] THEN DISCH_TAC] THEN FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE `s1:num = s2 ==> s1 + m = m + s2`) THEN MATCH_MP_TAC NSUM_EQ THEN X_GEN_TAC `s:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun t -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [t]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MULTIPLICITY_OTHER_ROOT THEN REWRITE_TAC[MESON[] `(?i. P i /\ Q i) <=> ~(!i. P i ==> ~Q i)`] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `~(sum (0..m) (\j. b j * r pow j) = &0)` THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[REAL_MUL_LZERO; SUM_0]);; hol-light/100/dirichlet.ml000066400000000000000000003171671303454263000155650ustar00rootroot00000000000000(* ========================================================================= *) (* Dirichlet's theorem. *) (* ========================================================================= *) needs "Library/products.ml";; needs "Library/agm.ml";; needs "Multivariate/transcendentals.ml";; needs "Library/pocklington.ml";; needs "Library/multiplicative.ml";; needs "Examples/mangoldt.ml";; prioritize_real();; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* Rearranging a certain kind of double sum. *) (* ------------------------------------------------------------------------- *) let VSUM_VSUM_DIVISORS = prove (`!f x. vsum (1..x) (\n. vsum {d | d divides n} (f n)) = vsum (1..x) (\n. vsum (1..(x DIV n)) (\k. f (k * n) n))`, SIMP_TAC[VSUM; FINITE_DIVISORS; LE_1] THEN SIMP_TAC[VSUM; FINITE_NUMSEG; ITERATE_ITERATE_DIVISORS; MONOIDAL_VECTOR_ADD]);; (* ------------------------------------------------------------------------- *) (* Useful approximation lemmas. *) (* ------------------------------------------------------------------------- *) let REAL_EXP_1_LE_4 = prove (`exp(&1) <= &4`, ONCE_REWRITE_TAC[ARITH_RULE `&1 = &1 / &2 + &1 / &2`; REAL_EXP_ADD] THEN REWRITE_TAC[REAL_ARITH `&4 = &2 * &2`; REAL_EXP_ADD] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN MP_TAC(SPEC `&1 / &2` REAL_EXP_BOUND_LEMMA) THEN REAL_ARITH_TAC);; let DECREASING_LOG_OVER_N = prove (`!n. 4 <= n ==> log(&n + &1) / (&n + &1) <= log(&n) / &n`, REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. clog z / z`; `\z. (Cx(&1) - clog(z)) / z pow 2`; `Cx(&n)`; `Cx(&n + &1)`] COMPLEX_MVT_LINE) THEN REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN REWRITE_TAC[REAL_ARITH `~(n + &1 <= x /\ x <= n)`] THEN ANTS_TAC THENL [X_GEN_TAC `w:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN SUBGOAL_THEN `&0 < Re w` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_SIMP_TAC[RE_CX; REAL_LT_REFL] THEN DISCH_TAC THEN UNDISCH_TAC `~(w = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD; DISCH_THEN(X_CHOOSE_THEN `z:complex` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `&0 < &n /\ &0 < &n + &1` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_DIV; RE_CX; GSYM CX_SUB] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= --x ==> a - b = x ==> a <= b`) THEN REWRITE_TAC[RE_MUL_CX; GSYM REAL_MUL_LNEG] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN SUBGOAL_THEN `?u. z = Cx(u)` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[REAL; real]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IM_CX; RE_CX]) THEN UNDISCH_THEN `T` (K ALL_TAC) THEN SUBGOAL_THEN `&0 < u` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; RE_CX; real_div; GSYM REAL_MUL_LNEG; REAL_NEG_SUB; GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN REWRITE_TAC[REAL_SUB_LE] THEN GEN_REWRITE_TAC LAND_CONV [GSYM LOG_EXP] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN MP_TAC REAL_EXP_1_LE_4 THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* An ad-hoc fact about complex n'th roots. *) (* ------------------------------------------------------------------------- *) let EXISTS_COMPLEX_ROOT_NONTRIVIAL = prove (`!a n. 2 <= n ==> ?z. z pow n = a /\ ~(z = Cx(&1))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `2 <= n ==> ~(n = 0)`)) THEN ASM_CASES_TAC `a = Cx(&0)` THENL [EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_POW_ZERO] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN ASM_CASES_TAC `a = Cx(&1)` THENL [EXISTS_TAC `cexp(Cx(&2) * Cx pi * ii * Cx(&1 / &n))` THEN ASM_SIMP_TAC[COMPLEX_ROOT_UNITY_EQ_1; DIVIDES_ONE; ARITH_RULE `2 <= n ==> ~(n = 1)`; COMPLEX_ROOT_UNITY]; MATCH_MP_TAC(MESON[] `(!x. ~Q x ==> ~P x) /\ (?x. P x) ==> (?x. P x /\ Q x)`) THEN ASM_SIMP_TAC[COMPLEX_POW_ONE] THEN EXISTS_TAC `cexp(clog a / Cx(&n))` THEN ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[CEXP_CLOG]]);; (* ------------------------------------------------------------------------- *) (* Definition of a Dirichlet character mod d. *) (* ------------------------------------------------------------------------- *) let dirichlet_character = new_definition `dirichlet_character d (c:num->complex) <=> (!n. c(n + d) = c(n)) /\ (!n. c(n) = Cx(&0) <=> ~coprime(n,d)) /\ (!m n. c(m * n) = c(m) * c(n))`;; let DIRICHLET_CHARACTER_PERIODIC = prove (`!d c n. dirichlet_character d c ==> c(n + d) = c(n)`, SIMP_TAC[dirichlet_character]);; let DIRICHLET_CHARACTER_EQ_0 = prove (`!d c n. dirichlet_character d c ==> (c(n) = Cx(&0) <=> ~coprime(n,d))`, SIMP_TAC[dirichlet_character]);; let DIRICHLET_CHARACTER_MUL = prove (`!d c m n. dirichlet_character d c ==> c(m * n) = c(m) * c(n)`, SIMP_TAC[dirichlet_character]);; let DIRICHLET_CHARACTER_EQ_1 = prove (`!d c. dirichlet_character d c ==> c(1) = Cx(&1)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIRICHLET_CHARACTER_MUL) THEN DISCH_THEN(MP_TAC o repeat (SPEC `1`)) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_FIELD `a = a * a <=> a = Cx(&0) \/ a = Cx(&1)`] THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_EQ_0] THEN MESON_TAC[COPRIME_1; COPRIME_SYM]);; let DIRICHLET_CHARACTER_POW = prove (`!d c m n. dirichlet_character d c ==> c(m EXP n) = c(m) pow n`, REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[EXP; complex_pow] THENL [ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1]; ALL_TAC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN ASM_REWRITE_TAC[]);; let DIRICHLET_CHARACTER_PERIODIC_GEN = prove (`!d c m n. dirichlet_character d c ==> c(m * d + n) = c(n)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN GEN_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN ONCE_REWRITE_TAC[ARITH_RULE `(mk + d) + n:num = (mk + n) + d`] THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_PERIODIC]);; let DIRICHLET_CHARACTER_CONG = prove (`!d c m n. dirichlet_character d c /\ (m == n) (mod d) ==> c(m) = c(n)`, REWRITE_TAC[CONG_CASES] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_PERIODIC_GEN]);; let DIRICHLET_CHARACTER_ROOT = prove (`!d c n. dirichlet_character d c /\ coprime(d,n) ==> c(n) pow phi(d) = Cx(&1)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o GSYM o MATCH_MP DIRICHLET_CHARACTER_EQ_1) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP DIRICHLET_CHARACTER_POW th)]) THEN MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN EXISTS_TAC `d:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FERMAT_LITTLE THEN ASM_MESON_TAC[COPRIME_SYM]);; let DIRICHLET_CHARACTER_NORM = prove (`!d c n. dirichlet_character d c ==> norm(c n) = if coprime(d,n) then &1 else &0`, REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [ALL_TAC; REWRITE_TAC[COMPLEX_NORM_ZERO] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; COPRIME_SYM]] THEN ASM_CASES_TAC `d = 0` THENL [ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; COMPLEX_NORM_CX; REAL_ABS_NUM; COPRIME_0; COPRIME_SYM]; ALL_TAC] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`; `n:num`] DIRICHLET_CHARACTER_ROOT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN REWRITE_TAC[COMPLEX_NORM_POW; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN DISCH_TAC THEN MP_TAC(SPECL [`norm((c:num->complex) n)`; `phi d`] REAL_POW_EQ_1_IMP) THEN ASM_REWRITE_TAC[REAL_ABS_NORM] THEN ASM_MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_1]);; (* ------------------------------------------------------------------------- *) (* The principal character mod d. *) (* ------------------------------------------------------------------------- *) let chi_0 = new_definition `chi_0 d n = if coprime(n,d) then Cx(&1) else Cx(&0)`;; let DIRICHLET_CHARACTER_CHI_0 = prove (`dirichlet_character d (chi_0 d)`, REWRITE_TAC[dirichlet_character; chi_0] THEN REWRITE_TAC[NUMBER_RULE `coprime(n + d,d) <=> coprime(n,d)`; NUMBER_RULE `coprime(m * n,d) <=> coprime(m,d) /\ coprime(n,d)`] THEN CONV_TAC COMPLEX_RING);; let DIRICHLET_CHARACTER_EQ_PRINCIPAL = prove (`!d c. dirichlet_character d c ==> (c = chi_0 d <=> !n. coprime(n,d) ==> c(n) = Cx(&1))`, REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; chi_0] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0]);; let DIRICHLET_CHARACTER_NONPRINCIPAL = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> ?n. coprime(n,d) /\ ~(c n = Cx(&0)) /\ ~(c n = Cx(&1))`, MESON_TAC[DIRICHLET_CHARACTER_EQ_PRINCIPAL; DIRICHLET_CHARACTER_EQ_0]);; let DIRICHLET_CHARACTER_0 = prove (`!c. dirichlet_character 0 c <=> c = chi_0 0`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[DIRICHLET_CHARACTER_CHI_0] THEN DISCH_TAC THEN REWRITE_TAC[chi_0; FUN_EQ_THM; COPRIME_0] THEN X_GEN_TAC `n:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; DIRICHLET_CHARACTER_EQ_0; COPRIME_0]);; let DIRICHLET_CHARACTER_1 = prove (`!c. dirichlet_character 1 c <=> !n. c n = Cx(&1)`, GEN_TAC THEN REWRITE_TAC[dirichlet_character; COPRIME_1] THEN EQ_TAC THENL [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`1`; `1`]) THEN ASM_REWRITE_TAC[ARITH; COMPLEX_RING `x = x * x <=> x = Cx(&0) \/ x = Cx(&1)`] THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD1] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `0`)) THEN ASM_REWRITE_TAC[ARITH] THEN CONV_TAC COMPLEX_RING; DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING]);; let DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> ~(d = 0) /\ ~(d = 1)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[DIRICHLET_CHARACTER_0; TAUT `~(p /\ ~p)`] THEN ASM_CASES_TAC `d = 1` THEN ASM_REWRITE_TAC[DIRICHLET_CHARACTER_1; chi_0; FUN_EQ_THM; COPRIME_1] THEN CONV_TAC TAUT);; let DIRICHLET_CHARACTER_ZEROSUM = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> vsum(1..d) c = Cx(&0)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIRICHLET_CHARACTER_NONPRINCIPAL) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(COMPLEX_RING `!x. x * c = c /\ ~(x = Cx(&1)) ==> c = Cx(&0)`) THEN EXISTS_TAC `(c:num->complex) m` THEN ASM_SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN MATCH_MP_TAC(MESON[] `!t. vsum t f = vsum s f /\ vsum t g = vsum s g /\ vsum t f = vsum t g ==> vsum s f = vsum s g`) THEN EXISTS_TAC `{n | coprime(n,d) /\ n < d}` THEN REPEAT(CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_NUMSEG; LT_IMP_LE; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `r:num` THENL [ASM_CASES_TAC `r = 0` THENL [ALL_TAC; ASM_ARITH_TAC] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[COPRIME_0]; ASM_CASES_TAC `coprime(r,d)` THEN ASM_REWRITE_TAC[] THENL [ASM_CASES_TAC `r:num = d` THEN ASM_REWRITE_TAC[LT_REFL] THENL [ASM_MESON_TAC[COPRIME_REFL]; ASM_ARITH_TAC]; REWRITE_TAC[COMPLEX_VEC_0] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; COMPLEX_MUL_RZERO]]]; ALL_TAC]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP DIRICHLET_CHARACTER_MUL (CONJUNCT1 th))]) THEN SIMP_TAC[VSUM; PHI_FINITE_LEMMA] THEN MATCH_MP_TAC ITERATE_OVER_COPRIME THEN SIMP_TAC[MONOIDAL_VECTOR_ADD] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_CONG]);; let DIRICHLET_CHARACTER_ZEROSUM_MUL = prove (`!d c n. dirichlet_character d c /\ ~(c = chi_0 d) ==> vsum(1..d*n) c = Cx(&0)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; VSUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[ARITH; COMPLEX_VEC_0] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[VSUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; COMPLEX_ADD_LID] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[VSUM_OFFSET] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIRICHLET_CHARACTER_ZEROSUM) THEN MATCH_MP_TAC VSUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN EXISTS_TAC `d:num` THEN ASM_REWRITE_TAC[] THEN NUMBER_TAC);; let DIRICHLET_CHARACTER_SUM_MOD = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> vsum(1..n) c = vsum(1..(n MOD d)) c`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL) THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN SIMP_TAC[VSUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_ZEROSUM_MUL; COMPLEX_ADD_LID] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[VSUM_OFFSET] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIRICHLET_CHARACTER_ZEROSUM) THEN MATCH_MP_TAC VSUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN EXISTS_TAC `d:num` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUMBER_RULE);; (* ------------------------------------------------------------------------- *) (* Finiteness of the set of characters (later we could get size = phi(d)). *) (* ------------------------------------------------------------------------- *) let FINITE_DIRICHLET_CHARACTERS = prove (`!d. FINITE {c | dirichlet_character d c}`, GEN_TAC THEN ASM_CASES_TAC `d = 0` THENL [ASM_SIMP_TAC[DIRICHLET_CHARACTER_0; SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[FINITE_RULES]; ALL_TAC] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\c n. c(n MOD d)) {c | (!m. m IN {m | m < d} ==> c(m) IN (Cx(&0) INSERT {z | z pow (phi d) = Cx(&1)})) /\ (!m. ~(m IN {m | m < d}) ==> c(m) = Cx(&0))}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_FUNSPACE THEN ASM_SIMP_TAC[FINITE_NUMSEG_LT; FINITE_INSERT] THEN MATCH_MP_TAC FINITE_COMPLEX_ROOTS_UNITY THEN ASM_SIMP_TAC[PHI_LOWERBOUND_1_STRONG; LE_1]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `c:num->complex` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_INSERT] THEN EXISTS_TAC `\n:num. if n < d then c(n) else Cx(&0)` THEN ASM_SIMP_TAC[DIVISION; FUN_EQ_THM] THEN CONJ_TAC THEN X_GEN_TAC `m:num` THENL [MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN EXISTS_TAC `d:num` THEN ASM_MESON_TAC[CONG_MOD; CONG_SYM]; ASM_MESON_TAC[DIRICHLET_CHARACTER_ROOT; COPRIME_SYM; DIRICHLET_CHARACTER_EQ_0]]);; (* ------------------------------------------------------------------------- *) (* Very basic group structure. *) (* ------------------------------------------------------------------------- *) let DIRICHLET_CHARACTER_MUL_CNJ = prove (`!d c n. dirichlet_character d c /\ ~(c n = Cx(&0)) ==> cnj(c n) * c n = Cx(&1) /\ c n * cnj(c n) = Cx(&1)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `inv z = w /\ ~(z = Cx(&0)) ==> w * z = Cx(&1) /\ z * w = Cx(&1)`) THEN ASM_REWRITE_TAC[COMPLEX_INV_CNJ] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM COMPLEX_NORM_NZ]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LT_REFL; COMPLEX_POW_ONE] THEN REWRITE_TAC[COMPLEX_DIV_1]);; let DIRICHLET_CHARACTER_CNJ = prove (`!d c. dirichlet_character d c ==> dirichlet_character d (\n. cnj(c n))`, SIMP_TAC[dirichlet_character; CNJ_MUL; CNJ_EQ_CX]);; let DIRICHLET_CHARACTER_GROUPMUL = prove (`!d c1 c2. dirichlet_character d c1 /\ dirichlet_character d c2 ==> dirichlet_character d (\n. c1(n) * c2(n))`, SIMP_TAC[dirichlet_character; COMPLEX_ENTIRE] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; let DIRICHLET_CHARACTER_GROUPINV = prove (`!d c. dirichlet_character d c ==> (\n. cnj(c n) * c n) = chi_0 d`, REPEAT STRIP_TAC THEN REWRITE_TAC[chi_0; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [ASM_MESON_TAC[DIRICHLET_CHARACTER_MUL_CNJ; DIRICHLET_CHARACTER_EQ_0]; ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; COMPLEX_MUL_RZERO]]);; (* ------------------------------------------------------------------------- *) (* Orthogonality relations, a weak version of one first. *) (* ------------------------------------------------------------------------- *) let DIRICHLET_CHARACTER_SUM_OVER_NUMBERS = prove (`!d c. dirichlet_character d c ==> vsum (1..d) c = if c = chi_0 d then Cx(&(phi d)) else Cx(&0)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_ZEROSUM] THEN FIRST_X_ASSUM SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[chi_0] THEN SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_NUMSEG; GSYM COMPLEX_VEC_0] THEN SIMP_TAC[phi; VSUM_CONST; FINITE_RESTRICT; FINITE_NUMSEG] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN X_GEN_TAC `x:num` THEN ASM_CASES_TAC `coprime(x,d)` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_WEAK = prove (`!d n. vsum {c | dirichlet_character d c} (\x. x n) = Cx(&0) \/ coprime(n,d) /\ !c. dirichlet_character d c ==> c(n) = Cx(&1)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `coprime(n,d)` THENL [ALL_TAC; DISJ1_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC VSUM_EQ_0 THEN ASM_SIMP_TAC[IN_ELIM_THM; COMPLEX_VEC_0; DIRICHLET_CHARACTER_EQ_0]] THEN SUBGOAL_THEN `!c'. dirichlet_character d c' ==> vsum {c | dirichlet_character d c} ((\c. c(n)) o (\c n. c'(n) * c(n))) = vsum {c | dirichlet_character d c} (\c. c(n))` MP_TAC THENL [ALL_TAC; SIMP_TAC[o_DEF; FINITE_DIRICHLET_CHARACTERS; VSUM_COMPLEX_LMUL] THEN REWRITE_TAC[COMPLEX_RING `a * x = x <=> a = Cx(&1) \/ x = Cx(&0)`] THEN ASM_MESON_TAC[]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_INJECTION THEN REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM] THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_GROUPMUL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(\c n. cnj(c'(n:num)) * c n)`) THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `coprime(m,d)` THENL [ALL_TAC; ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN MATCH_MP_TAC(COMPLEX_RING `a * b = Cx(&1) ==> a * b * x = a * b * y ==> x = y`) THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; DIRICHLET_CHARACTER_MUL_CNJ]);; let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_POS = prove (`!d n. real(vsum {c | dirichlet_character d c} (\c. c n)) /\ &0 <= Re(vsum {c | dirichlet_character d c} (\c. c n))`, MP_TAC DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_WEAK THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; REAL_LE_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_VSUM; SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; RE_VSUM] THEN MATCH_MP_TAC SUM_POS_LE] THEN ASM_SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM; REAL_CX; RE_CX] THEN REWRITE_TAC[REAL_POS]);; (* ------------------------------------------------------------------------- *) (* A somewhat gruesome lemma about extending a character from a subgroup. *) (* ------------------------------------------------------------------------- *) let CHARACTER_EXTEND_FROM_SUBGROUP = prove (`!f h a d. h SUBSET {x | x < d /\ coprime(x,d)} /\ (1 IN h) /\ (!x y. x IN h /\ y IN h ==> ((x * y) MOD d) IN h) /\ (!x. x IN h ==> ?y. y IN h /\ (x * y == 1) (mod d)) /\ (!x. x IN h ==> ~(f x = Cx(&0))) /\ (!x y. x IN h /\ y IN h ==> f((x * y) MOD d) = f(x) * f(y)) /\ a IN {x | x < d /\ coprime(x,d)} DIFF h ==> ?f' h'. (a INSERT h) SUBSET h' /\ h' SUBSET {x | x < d /\ coprime(x,d)} /\ (!x. x IN h ==> f'(x) = f(x)) /\ ~(f' a = Cx(&1)) /\ 1 IN h' /\ (!x y. x IN h' /\ y IN h' ==> ((x * y) MOD d) IN h') /\ (!x. x IN h' ==> ?y. y IN h' /\ (x * y == 1) (mod d)) /\ (!x. x IN h' ==> ~(f' x = Cx(&0))) /\ (!x y. x IN h' /\ y IN h' ==> f'((x * y) MOD d) = f'(x) * f'(y))`, REWRITE_TAC[IN_ELIM_THM; IN_DIFF; SUBSET] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 < d` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LT_IMP_LE) THEN SUBGOAL_THEN `?m x. 0 < m /\ x IN h /\ (a EXP m == x) (mod d)` MP_TAC THENL [MAP_EVERY EXISTS_TAC [`phi d`; `1`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_1]; ALL_TAC] THEN MATCH_MP_TAC FERMAT_LITTLE THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x s. x IN h ==> ((x EXP s) MOD d) IN h` ASSUME_TAC THENL [REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[EXP; MOD_LT] THEN SUBGOAL_THEN `((x * (x EXP s) MOD d) MOD d) IN h` MP_TAC THEN ASM_MESON_TAC[MOD_MULT_RMOD; ASSUME `1 <= d`; LE_1]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `am:num` STRIP_ASSUME_TAC) MP_TAC) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `0 < m ==> m = 1 \/ 2 <= m`)) THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN UNDISCH_TAC `(a EXP 1 == am) (mod d)` THEN ASM_SIMP_TAC[EXP_1; GSYM CONG_MOD_LT; MOD_LT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN `r:num` o SPEC `r MOD m`) THEN ASM_SIMP_TAC[DIVISION; LE_1; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> b /\ c ==> ~a`] THEN DISCH_TAC THEN SUBGOAL_THEN `!r x. x IN h /\ (a EXP r == x) (mod d) ==> m divides r` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIVIDES_MOD; LE_1] THEN REWRITE_TAC[ARITH_RULE `n = 0 <=> ~(0 < n)`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(a EXP (r MOD m)) MOD d` THEN ASM_SIMP_TAC[CONG_RMOD; LE_1; CONG_REFL] THEN UNDISCH_TAC `!x. x IN h ==> (?y. y IN h /\ (x * y == 1) (mod d))` THEN DISCH_THEN(MP_TAC o SPEC `(a EXP (m * r DIV m)) MOD d`) THEN ANTS_TAC THENL [REWRITE_TAC[GSYM EXP_EXP] THEN SUBGOAL_THEN `(a EXP m) EXP (r DIV m) MOD d = (am EXP (r DIV m)) MOD d` (fun th -> ASM_SIMP_TAC[th]) THEN ASM_SIMP_TAC[GSYM CONG; LE_1] THEN ASM_SIMP_TAC[CONG_LMOD; CONG_EXP; LE_1]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(a EXP r == x) (mod d)` THEN MP_TAC(SPECL [`r:num`; `m:num`] DIVISION) THEN ASM_SIMP_TAC[LE_1] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP_ADD] THEN DISCH_THEN(MP_TAC o SPEC `y:num` o MATCH_MP (NUMBER_RULE `!a. (x:num == y) (mod n) ==> (a * x == a * y) (mod n)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE `(y * e * a == z) (mod n) ==> (e * y == 1) (mod n) ==> (a == z) (mod n)`)) THEN ANTS_TAC THENL [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `a EXP (m * r DIV m) MOD d * y` THEN ASM_SIMP_TAC[CONG_MULT; CONG_REFL; CONG_RMOD; LE_1]; ALL_TAC] THEN ASM_SIMP_TAC[CONG; LE_1]; ALL_TAC] THEN MP_TAC(SPECL [`(f:num->complex) am`; `m:num`] EXISTS_COMPLEX_ROOT_NONTRIVIAL) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?g. !x k. x IN h ==> g((x * a EXP k) MOD d) = f(x) * z pow k` MP_TAC THENL [REWRITE_TAC[MESON[] `(?g. !x a. p x ==> g(f a x) = h a x) <=> (?g. !y x a. p x /\ f a x = y ==> g y = h a x)`] THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN REWRITE_TAC[MESON[] `(!y. ?z. !x k. p x /\ f x k = y ==> z = g x k) <=> (!x k x' k'. p x /\ p x' /\ f x k = f x' k' ==> g x k = g x' k')`] THEN ONCE_REWRITE_TAC[MESON[] `(!x k y j. P x k y j) <=> (!k j x y. P x k y j)`] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:num`; `j:num`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN ASM_SIMP_TAC[GSYM CONG; LE_1] THEN STRIP_TAC THEN UNDISCH_TAC `k:num <= j` THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `i:num` SUBST_ALL_TAC) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `m divides i` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `!x. x IN h ==> (?y. y IN h /\ (x * y == 1) (mod d))` THEN DISCH_THEN(MP_TAC o SPEC `y:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(z * x) MOD d` THEN ASM_SIMP_TAC[CONG_RMOD; LE_1] THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `y * a EXP k` THEN REWRITE_TAC[COPRIME_LMUL] THEN CONJ_TAC THENL [ASM_MESON_TAC[COPRIME_EXP; COPRIME_SYM]; ALL_TAC] THEN UNDISCH_TAC `(x * a EXP k == y * a EXP (k + i)) (mod d)` THEN REWRITE_TAC[EXP_ADD] THEN UNDISCH_TAC `(y * z == 1) (mod d)` THEN CONV_TAC NUMBER_RULE; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[GSYM COMPLEX_POW_POW] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `f((y * (am EXP r) MOD d) MOD d):complex` THEN CONJ_TAC THENL [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[CONG_MOD_LT] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `y * (a EXP m) EXP r` THEN CONJ_TAC THENL [MATCH_MP_TAC CONG_MULT THEN ASM_SIMP_TAC[CONG_MULT; CONG_LMOD; CONG_REFL; LE_1] THEN MATCH_MP_TAC CONG_EXP THEN ASM_MESON_TAC[CONG_SYM]; ALL_TAC] THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a EXP k` THEN CONJ_TAC THENL [ASM_MESON_TAC[COPRIME_EXP; COPRIME_SYM]; ALL_TAC] THEN UNDISCH_TAC `(x * a EXP k == y * a EXP (k + m * r)) (mod d)` THEN REWRITE_TAC[EXP_ADD; EXP_EXP] THEN CONV_TAC NUMBER_RULE; ALL_TAC] THEN ASM_SIMP_TAC[] THEN AP_TERM_TAC THEN SPEC_TAC(`r:num`,`s:num`) THEN INDUCT_TAC THEN ASM_SIMP_TAC[EXP; MOD_LT; complex_pow; COMPLEX_MUL_RID] THENL [UNDISCH_TAC `!x y. x IN h /\ y IN h ==> f ((x * y) MOD d):complex = f x * f y` THEN DISCH_THEN(MP_TAC o SPECL [`1`; `1`]) THEN ASM_SIMP_TAC[MULT_CLAUSES; MOD_LT] THEN UNDISCH_TAC `!x:num. x IN h ==> ~(f x = Cx (&0))` THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `f((am * (am EXP s) MOD d) MOD d):complex` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[MOD_MULT_RMOD; ASSUME `1 <= d`; LE_1]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:num->complex` THEN DISCH_THEN (LABEL_TAC "*") THEN EXISTS_TAC `{(x * a EXP k) MOD d | x IN h /\ k IN (:num)}` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; IN_UNIV] THEN X_GEN_TAC `x:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY EXISTS_TAC [`1`; `1`]; MAP_EVERY EXISTS_TAC [`x:num`; `0`]] THEN ASM_SIMP_TAC[EXP_1; MULT_CLAUSES; EXP; MOD_LT]; REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:num`; `x:num`; `k:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[DIVISION; LE_1; COPRIME_MOD; COPRIME_LMUL] THEN ASM_MESON_TAC[COPRIME_EXP; COPRIME_SYM]; X_GEN_TAC `x:num` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPECL [`x:num`; `0`]) THEN ASM_SIMP_TAC[MOD_LT; EXP; MULT_CLAUSES; complex_pow; COMPLEX_MUL_RID]; REMOVE_THEN "*" (MP_TAC o SPECL [`1`; `1`]) THEN ASM_SIMP_TAC[EXP_1; MULT_CLAUSES; MOD_LT; COMPLEX_POW_1] THEN UNDISCH_TAC `!x y. x IN h /\ y IN h ==> f ((x * y) MOD d) = f x * f y` THEN DISCH_THEN(MP_TAC o SPECL [`1`; `1`]) THEN ASM_SIMP_TAC[MULT_CLAUSES; MOD_LT] THEN UNDISCH_TAC `~(z = Cx(&1))` THEN CONV_TAC COMPLEX_RING; REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MAP_EVERY EXISTS_TAC [`1`; `0`] THEN ASM_SIMP_TAC[EXP; MULT_CLAUSES; MOD_LT]; REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`r:num`; `s:num`; `x:num`; `k:num`; `y:num`; `j:num`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`(x * y) MOD d`; `j + k:num`] THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD; LE_1] THEN REWRITE_TAC[EXP_ADD; MULT_AC]; REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:num`; `x:num`; `k:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN UNDISCH_TAC `!x. x IN h ==> (?y. y IN h /\ (x * y == 1) (mod d))` THEN DISCH_THEN(MP_TAC o SPEC `x:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(z * a EXP ((phi d - 1) * k)) MOD d` THEN REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `(x * a EXP k) * (z * a EXP ((phi d - 1) * k))` THEN CONJ_TAC THENL [MATCH_MP_TAC CONG_MULT THEN ASM_SIMP_TAC[CONG_MOD; LE_1]; ALL_TAC] THEN ONCE_REWRITE_TAC[ARITH_RULE `(x * a) * (z * ak):num = (x * z) * (a * ak)`] THEN GEN_REWRITE_TAC (LAND_CONV) [ARITH_RULE `1 = 1 * 1`] THEN MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM EXP_ADD] THEN SUBGOAL_THEN `k + (phi d - 1) * k = phi(d) * k` SUBST1_TAC THENL [REWRITE_TAC[ARITH_RULE `k + a * k = (a + 1) * k`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[SUB_ADD; PHI_LOWERBOUND_1_STRONG]; ALL_TAC] THEN REWRITE_TAC[GSYM EXP_EXP] THEN SUBST1_TAC(SYM(SPEC `k:num` EXP_ONE)) THEN MATCH_MP_TAC CONG_EXP THEN ASM_SIMP_TAC[FERMAT_LITTLE]; REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0] THEN UNDISCH_TAC `!x:num. x IN h ==> ~(f x = Cx (&0))` THEN DISCH_THEN(MP_TAC o SPEC `am:num`) THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(ASSUME `z pow m = f(am:num)`)) THEN REWRITE_TAC[COMPLEX_POW_EQ_0] THEN ASM_SIMP_TAC[LE_1]; REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`r:num`; `s:num`; `x:num`; `k:num`; `y:num`; `j:num`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `g(((x * y) MOD d * a EXP (k + j)) MOD d):complex` THEN CONJ_TAC THENL [AP_TERM_TAC THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD; LE_1] THEN REWRITE_TAC[EXP_ADD; MULT_AC]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_MUL_AC]]);; (* ------------------------------------------------------------------------- *) (* Hence the key result that we can find a distinguishing character. *) (* ------------------------------------------------------------------------- *) let DIRICHLET_CHARACTER_DISCRIMINATOR = prove (`!d n. 1 < d /\ ~((n == 1) (mod d)) ==> ?c. dirichlet_character d c /\ ~(c n = Cx(&1))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LT_IMP_LE) THEN ASM_CASES_TAC `coprime(n,d)` THENL [ALL_TAC; EXISTS_TAC `chi_0 d` THEN ASM_REWRITE_TAC[DIRICHLET_CHARACTER_CHI_0; chi_0] THEN CONV_TAC COMPLEX_RING] THEN MP_TAC(ISPECL [`\n:num. Cx(&1)`; `{1}`; `n MOD d`; `d:num`] CHARACTER_EXTEND_FROM_SUBGROUP) THEN ASM_SIMP_TAC[IN_SING; IN_ELIM_THM; IN_DIFF] THEN ANTS_TAC THENL [ASM_SIMP_TAC[SUBSET; MULT_CLAUSES; MOD_LT; LE_1; IN_SING; IN_ELIM_THM; DIVISION; COPRIME_MOD; CONG_MOD_LT; COMPLEX_MUL_LID; CX_INJ; REAL_OF_NUM_EQ; ARITH] THEN ASM_MESON_TAC[COPRIME_1; COPRIME_SYM; CONG_REFL]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f0:num->complex`; `h0:num->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `!m. m <= CARD {x | x < d /\ coprime(x,d)} ==> ?f h. h SUBSET {x | x < d /\ coprime(x,d)} /\ (1 IN h) /\ (n MOD d) IN h /\ (!x y. x IN h /\ y IN h ==> ((x * y) MOD d) IN h) /\ (!x. x IN h ==> ?y. y IN h /\ (x * y == 1) (mod d)) /\ ~(f(n MOD d) = Cx(&1)) /\ (!x. x IN h ==> ~(f x = Cx(&0))) /\ (!x y. x IN h /\ y IN h ==> f((x * y) MOD d) = f(x) * f(y)) /\ m <= CARD h` MP_TAC THENL [MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN DISCH_THEN(LABEL_TAC "*") THEN DISCH_TAC THEN ASM_CASES_TAC `m = 0` THENL [MAP_EVERY EXISTS_TAC [`f0:num->complex`; `h0:num->bool`] THEN ASM_REWRITE_TAC[LE_0] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o C MATCH_MP (MATCH_MP (ARITH_RULE `~(m = 0) ==> m - 1 < m`) (ASSUME `~(m = 0)`))) THEN ASM_SIMP_TAC[ARITH_RULE `x <= n ==> x - 1 <= n`; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:num->complex`; `h:num->bool`] THEN STRIP_TAC THEN ASM_CASES_TAC `m <= CARD(h:num->bool)` THENL [MAP_EVERY EXISTS_TAC [`f:num->complex`; `h:num->bool`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ASSUME `h SUBSET {x | x < d /\ coprime (x,d)}`) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(s = t) ==> ?a. a IN t /\ ~(a IN s)`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `a:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:num->complex`; `h:num->bool`; `a:num`; `d:num`] CHARACTER_EXTEND_FROM_SUBGROUP) THEN ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `ff:num->complex` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `hh:num->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD((a:num) INSERT h)` THEN SUBGOAL_THEN `FINITE(h:num->bool)` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x | x IN {x | x < d} /\ coprime(x,d)}` THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG_LT] THEN ASM_REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN CONJ_TAC THENL [ASM_SIMP_TAC[CARD_CLAUSES] THEN UNDISCH_TAC `m - 1 <= CARD(h:num->bool)` THEN ARITH_TAC; MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x | x IN {x | x < d} /\ coprime(x,d)}` THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG_LT] THEN ASM_REWRITE_TAC[IN_ELIM_THM]]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `CARD {x | x < d /\ coprime(x,d)}`) THEN REWRITE_TAC[LE_REFL] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:num->complex`; `h:num->bool`] THEN ASM_CASES_TAC `h = {x | x < d /\ coprime (x,d)}` THENL [ALL_TAC; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC CARD_PSUBSET THEN ASM_REWRITE_TAC[PSUBSET] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:num | x < d}` THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG_LT] THEN SET_TAC[]] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN STRIP_TAC THEN EXISTS_TAC `\n. if coprime(n,d) then f(n MOD d) else Cx(&0)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[dirichlet_character] THEN REPEAT CONJ_TAC THEN X_GEN_TAC `x:num` THENL [REWRITE_TAC[NUMBER_RULE `coprime(x + d:num,d) <=> coprime(x,d)`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[GSYM CONG; LE_1] THEN CONV_TAC NUMBER_RULE; COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[COPRIME_MOD; DIVISION; LE_1]; X_GEN_TAC `y:num` THEN REWRITE_TAC[COPRIME_LMUL] THEN MAP_EVERY ASM_CASES_TAC [`coprime(x,d)`; `coprime(y,d)`] THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `f(((x MOD d) * (y MOD d)) MOD d):complex` THEN CONJ_TAC THENL [AP_TERM_TAC THEN ASM_SIMP_TAC[MOD_MULT_MOD2; LE_1]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[DIVISION; COPRIME_MOD; LE_1]]]);; (* ------------------------------------------------------------------------- *) (* Hence we get the full second orthogonality relation. *) (* ------------------------------------------------------------------------- *) let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_INEXPLICIT = prove (`!d n. vsum {c | dirichlet_character d c} (\c. c n) = if (n == 1) (mod d) then Cx(&(CARD {c | dirichlet_character d c})) else Cx(&0)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `d = 0` THENL [ASM_REWRITE_TAC[CONG_MOD_0; DIRICHLET_CHARACTER_0; SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[VSUM_CLAUSES; CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN REWRITE_TAC[chi_0; COPRIME_0; VECTOR_ADD_RID] THEN REWRITE_TAC[ARITH]; ALL_TAC] THEN ASM_CASES_TAC `d = 1` THENL [ASM_REWRITE_TAC[CONG_MOD_1; DIRICHLET_CHARACTER_1] THEN REWRITE_TAC[GSYM FUN_EQ_THM; ETA_AX] THEN ASM_REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[VSUM_CLAUSES; CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_ADD_RID; ARITH]; ALL_TAC] THEN COND_CASES_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum {c | dirichlet_character d c} (\c. Cx(&1))` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; DIRICHLET_CHARACTER_CONG]; SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; VSUM_CONST] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RID]]; MP_TAC(SPECL [`d:num`; `n:num`] DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_WEAK) THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_DISCRIMINATOR; ARITH_RULE `~(d = 0) /\ ~(d = 1) ==> 1 < d`]]);; let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS = prove (`!d n. 1 <= d ==> vsum {c | dirichlet_character d c} (\c. c(n)) = if (n == 1) (mod d) then Cx(&(phi d)) else Cx(&0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_INEXPLICIT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`\c n. (c:num->complex) n`; `{c | dirichlet_character d c}`; `1..d`;] VSUM_SWAP) THEN SIMP_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_INEXPLICIT; DIRICHLET_CHARACTER_SUM_OVER_NUMBERS; FINITE_NUMSEG; FINITE_DIRICHLET_CHARACTERS; ETA_AX] THEN REWRITE_TAC[VSUM_DELTA; GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[IN_ELIM_THM; DIRICHLET_CHARACTER_CHI_0] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_NUMSEG] THEN SUBGOAL_THEN `{j | j IN 1..d /\ (j == 1) (mod d)} = {1}` (fun th -> SIMP_TAC[th; VSUM_SING]) THEN REWRITE_TAC[EXTENSION; IN_SING; IN_ELIM_THM; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN EQ_TAC THEN ASM_SIMP_TAC[LE_REFL; CONG_REFL] THEN ASM_CASES_TAC `d = 1` THEN ASM_SIMP_TAC[CONG_MOD_1; LE_ANTISYM] THEN ASM_CASES_TAC `k:num = d` THENL [ASM_REWRITE_TAC[NUMBER_RULE `(d == 1) (mod d) <=> d divides 1`] THEN ASM_REWRITE_TAC[DIVIDES_ONE]; STRIP_TAC THEN MATCH_MP_TAC CONG_IMP_EQ THEN EXISTS_TAC `d:num` THEN ASM_REWRITE_TAC[LT_LE]]);; (* ------------------------------------------------------------------------- *) (* L-series, just at the point s = 1. *) (* ------------------------------------------------------------------------- *) let Lfunction_DEF = new_definition `Lfunction c = infsum (from 1) (\n. c(n) / Cx(&n))`;; let BOUNDED_LFUNCTION_PARTIAL_SUMS = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> bounded {vsum (1..n) c | n IN (:num)}`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_SUM_MOD th]) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (\n. vsum(1..n) c:complex) (0..d)` THEN SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[SIMPLE_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV; IN_IMAGE] THEN EXISTS_TAC `n MOD d` THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[LT_IMP_LE; DIVISION; DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL]);; let LFUNCTION = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> ((\n. c(n) / Cx(&n)) sums (Lfunction c)) (from 1)`, REPEAT GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[Lfunction_DEF; SUMS_INFSUM] THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC SERIES_DIRICHLET_COMPLEX THEN REPEAT(EXISTS_TAC `1`) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BOUNDED_LFUNCTION_PARTIAL_SUMS th]) THEN REWRITE_TAC[LIM_INV_N; GSYM CX_INV; REAL_CX; RE_CX] THEN SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; LE_ADD]);; (* ------------------------------------------------------------------------- *) (* Other properties of conjugate characters. *) (* ------------------------------------------------------------------------- *) let CNJ_CHI_0 = prove (`!d n. cnj(chi_0 d n) = chi_0 d n`, REPEAT GEN_TAC THEN REWRITE_TAC[chi_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CNJ_CX]);; let LFUNCTION_CNJ = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> Lfunction (\n. cnj(c n)) = cnj(Lfunction c)`, REPEAT STRIP_TAC THEN REWRITE_TAC[Lfunction_DEF] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN ONCE_REWRITE_TAC[GSYM CNJ_CX] THEN REWRITE_TAC[GSYM CNJ_DIV] THEN REWRITE_TAC[SUMS_CNJ; CNJ_CX; GSYM Lfunction_DEF] THEN ASM_MESON_TAC[LFUNCTION]);; (* ------------------------------------------------------------------------- *) (* Explicit bound on truncating the Lseries. *) (* ------------------------------------------------------------------------- *) let LFUNCTION_PARTIAL_SUM = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> ?B. &0 < B /\ !n. 1 <= n ==> norm(Lfunction c - vsum(1..n) (\n. c(n) / Cx(&n))) <= B / (&n + &1)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`c:num->complex`; `\n. inv(Cx(&n))`; `1`; `1`] SERIES_DIRICHLET_COMPLEX_EXPLICIT) THEN REWRITE_TAC[LE_REFL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BOUNDED_LFUNCTION_PARTIAL_SUMS th]) THEN REWRITE_TAC[LIM_INV_N; GSYM CX_INV; REAL_CX; RE_CX] THEN SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; LE_ADD] THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_INV; REAL_ABS_NUM] THEN REWRITE_TAC[CX_INV; GSYM complex_div; GSYM real_div] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. vsum(k+1..n) (\n. c(n) / Cx(&n))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP LFUNCTION) THEN MP_TAC(ISPECL [`sequentially`; `vsum (1..k) (\n. c n / Cx (&n))`] LIM_CONST) THEN REWRITE_TAC[GSYM IMP_CONJ_ALT; sums; FROM_INTER_NUMSEG] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `k + 1 <= m ==> k <= m`)) THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN ASM_SIMP_TAC[VSUM_ADD_SPLIT; ARITH_RULE `1 <= k ==> 1 <= k + 1`] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[ARITH_RULE `1 <= k + 1`; REAL_OF_NUM_ADD]]);; let LFUNCTION_PARTIAL_SUM_STRONG = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> ?B. &0 < B /\ !n. norm(Lfunction c - vsum(1..n) (\n. c(n) / Cx(&n))) <= B / (&n + &1)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LFUNCTION_PARTIAL_SUM) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `max B (norm(Lfunction c))` THEN ASM_SIMP_TAC[REAL_LT_MAX] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; VECTOR_SUB_RZERO; ARITH] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 < &n + &1`] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* First key bound, when the Lfunction is not zero (as indeed it isn't). *) (* ------------------------------------------------------------------------- *) let BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT_LEMMA = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> bounded { Lfunction(c) * vsum(1..x) (\n. c(n) * Cx(mangoldt n / &n)) - vsum(1..x) (\n. c(n) * Cx(log(&n) / &n)) | x IN (:num)}`, REWRITE_TAC[BOUNDED_POS; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN SIMP_TAC[LOG_MANGOLDT_SUM; real_div; CX_MUL; GSYM VSUM_CX; FINITE_DIVISORS; LE_1; GSYM VSUM_COMPLEX_LMUL; GSYM VSUM_COMPLEX_RMUL] THEN REWRITE_TAC[VSUM_VSUM_DIVISORS] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; COMPLEX_INV_MUL; CX_MUL; CX_INV] THEN ONCE_REWRITE_TAC[COMPLEX_RING `(ck * cn) * cm * k * n:complex = (ck * k) * (cn * cm * n)`] THEN SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_NUMSEG] THEN SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION_PARTIAL_SUM_STRONG) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&18 * B` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN X_GEN_TAC `x:num` THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_INV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[real_abs; MANGOLDT_POS_LE] THEN ASM_CASES_TAC `x = 0` THEN ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..x) (\n. B / &x * mangoldt n)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B / &x * &18 * &x` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[REWRITE_RULE[ETA_AX] PSI_BOUND]; ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> B / x * &18 * x = &18 * B`; REAL_OF_NUM_EQ; REAL_LE_REFL]]] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_MUL; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; MANGOLDT_POS_LE] THEN REWRITE_TAC[real_div; REAL_ARITH `a * b * c <= d <=> (a * c) * b <= d`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[MANGOLDT_POS_LE] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B / (&(x DIV n) + &1)` THEN ASM_REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INV_INV] THEN ONCE_REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SUBGOAL_THEN `1 <= x` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MP_TAC(SPECL [`x:num`; `n:num`] DIVISION) THEN ASM_ARITH_TAC);; let SUMMABLE_CHARACTER_LOG_OVER_N = prove (`!c d. dirichlet_character d c /\ ~(c = chi_0 d) ==> summable (from 1) (\n. c(n) * Cx(log(&n) / &n))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_DIRICHLET_COMPLEX THEN MAP_EVERY EXISTS_TAC [`4`; `1`] THEN REWRITE_TAC[REAL_CX] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BOUNDED_LFUNCTION_PARTIAL_SUMS th]) THEN CONJ_TAC THENL [SIMP_TAC[DECREASING_LOG_OVER_N; GSYM REAL_OF_NUM_ADD; RE_CX]; MP_TAC LIM_LOG_OVER_N THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN ASM_SIMP_TAC[CX_LOG; CX_DIV; LE_1; REAL_OF_NUM_LT]]);; let BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> bounded { Lfunction(c) * vsum(1..x) (\n. c(n) * Cx(mangoldt n / &n)) | x IN (:num)}`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT_LEMMA) THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_CHARACTER_LOG_OVER_N) THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_SUMS_BOUNDED) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN REWRITE_TAC[SIMPLE_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE; GSYM CONJ_ASSOC] THEN X_GEN_TAC `n:num` THEN REPEAT(EXISTS_TAC `n:num`) THEN VECTOR_ARITH_TAC);; let BOUNDED_DIRICHLET_MANGOLDT_NONZERO = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) /\ ~(Lfunction c = Cx(&0)) ==> bounded { vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) | x IN (:num)}`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT) THEN REWRITE_TAC[BOUNDED_POS; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; COMPLEX_NORM_NZ] THEN ASM_MESON_TAC[COMPLEX_NORM_NZ; REAL_LT_DIV]);; (* ------------------------------------------------------------------------- *) (* Now a bound when the Lfunction is zero (hypothetically). *) (* ------------------------------------------------------------------------- *) let MANGOLDT_LOG_SUM = prove (`!n. 1 <= n ==> mangoldt(n) = --(sum {d | d divides n} (\d. mobius(d) * log(&d)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n. mangoldt n`; `\n. log(&n)`] MOBIUS_INVERSION) THEN ASM_SIMP_TAC[LOG_MANGOLDT_SUM; LE_1] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {d | d divides n} (\x. mobius x * (log(&n) - log(&x)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[IN_ELIM_THM; DIVIDES_DIV_MULT] THEN ABBREV_TAC `q = n DIV d` THEN MAP_EVERY ASM_CASES_TAC [`q = 0`; `d = 0`] THEN ASM_SIMP_TAC[MULT_CLAUSES; LE_1] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_MUL; LOG_MUL; REAL_OF_NUM_LT; LE_1] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_SUB_LDISTRIB; SUM_SUB; FINITE_DIVISORS; LE_1] THEN ASM_SIMP_TAC[SUM_RMUL; REWRITE_RULE[ETA_AX] DIVISORSUM_MOBIUS] THEN MATCH_MP_TAC(REAL_ARITH `a = &0 ==> a - b = --b`) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LOG_1] THEN REAL_ARITH_TAC]);; let BOUNDED_DIRICHLET_MANGOLDT_LEMMA = prove (`!d c x. dirichlet_character d c /\ ~(c = chi_0 d) /\ 1 <= x ==> Cx(log(&x)) + vsum (1..x) (\n. c(n) * Cx(mangoldt n / &n)) = vsum (1..x) (\n. c(n) / Cx(&n) * vsum {d | d divides n} (\d. Cx(mobius(d) * log(&x / &d))))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MANGOLDT_LOG_SUM] THEN MATCH_MP_TAC(COMPLEX_RING `c - b = a ==> (a:complex) + b = c`) THEN SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN SIMP_TAC[CX_NEG; CX_DIV; GSYM VSUM_CX; FINITE_NUMSEG; FINITE_DIVISORS; LE_1] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `c / d * x - c * --y / d:complex = c / d * (x + y)`] THEN SIMP_TAC[GSYM VSUM_ADD; FINITE_DIVISORS; LE_1] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum (1..x) (\n. c n / Cx(&n) * vsum {d | d divides n} (\d. Cx(mobius d * log(&x))))` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN REWRITE_TAC[CX_MUL; GSYM COMPLEX_ADD_LDISTRIB] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM CX_ADD; CX_INJ] THEN ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[DIVIDES_ZERO; LE_1]; ALL_TAC] THEN ASM_SIMP_TAC[LOG_DIV; REAL_OF_NUM_LT; LE_1] THEN REAL_ARITH_TAC; SIMP_TAC[FINITE_DIVISORS; CX_MUL; SUM_RMUL; LE_1; VSUM_CX] THEN SIMP_TAC[REWRITE_RULE[ETA_AX] DIVISORSUM_MOBIUS] THEN SIMP_TAC[COND_RAND; COND_RATOR; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN ASM_SIMP_TAC[VSUM_DELTA; GSYM COMPLEX_VEC_0; IN_NUMSEG; LE_REFL] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] DIRICHLET_CHARACTER_EQ_1) THEN ASM_SIMP_TAC[COMPLEX_MUL_LID; COMPLEX_DIV_1]]);; let SUM_LOG_OVER_X_BOUND = prove (`!x. abs(sum(1..x) (\n. log(&x / &n) / &x)) <= &4`, X_GEN_TAC `x:num` THEN ASM_CASES_TAC `x = 0` THENL [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; REAL_ABS_NUM; REAL_POS]; ALL_TAC] THEN SIMP_TAC[real_div; SUM_RMUL; REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (1..x) (\n. abs(log(&x / &n)))` THEN REWRITE_TAC[SUM_ABS_NUMSEG] THEN ASM_SIMP_TAC[real_abs; LOG_POS; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE; LOG_DIV] THEN REWRITE_TAC[SUM_SUB_NUMSEG; GSYM LOG_FACT] THEN REWRITE_TAC[SUM_CONST_NUMSEG; ADD_SUB] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LOG_FACT_BOUNDS) THEN MATCH_MP_TAC(REAL_ARITH `&2 * l + abs(x) + &1 <= b ==> abs(lf - (xl - x + &1)) <= &2 * l ==> xl - lf <= b`) THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x /\ l <= x ==> &2 * l + abs(x) + &1 <= &4 * x`) THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_1; LOG_LE_REFL]);; let BOUNDED_DIRICHLET_MANGOLDT_ZERO = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) /\ Lfunction c = Cx(&0) ==> bounded { vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) + Cx(log(&x)) | x IN (:num)}`, ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION_PARTIAL_SUM_STRONG) THEN ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SIMP_TAC[SET_RULE `{f x | x IN (:num)} = f 0 INSERT {f x | ~(x = 0)}`] THEN REWRITE_TAC[BOUNDED_INSERT; ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] BOUNDED_DIRICHLET_MANGOLDT_LEMMA) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_DIVISORS; LE_1] THEN REWRITE_TAC[VSUM_VSUM_DIVISORS] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; CX_MUL; complex_div; COMPLEX_INV_MUL] THEN ONCE_REWRITE_TAC[COMPLEX_RING `((ck * cn) * k' * n') * m * l = (cn * m * n') * l * (ck * k')`] THEN REWRITE_TAC[GSYM complex_div] THEN SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN EXISTS_TAC `&4 * B` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN X_GEN_TAC `x:num` THEN DISCH_TAC THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..x) (\n. inv(&n) * log(&x / &n) * B / (&(x DIV n) + &1))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN FIRST_ASSUM(fun t -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM t]) THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_INV_EQ; REAL_POS] THEN REWRITE_TAC[REAL_MUL_LID; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_SIMP_TAC[REAL_FIELD `&1 <= n ==> inv(n) * n = &1`; REAL_OF_NUM_LE; REAL_ABS_MOBIUS]; SIMP_TAC[CX_LOG; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN SIMP_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; NORM_POS_LE] THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN ASM_SIMP_TAC[LOG_POS; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE]]; ALL_TAC] THEN SIMP_TAC[real_div; REAL_RING `a * l * B * i:real = ((l * i) * a) * B`] THEN REWRITE_TAC[SUM_RMUL] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..x) (\n. log(&x / &n) / &x)` THEN ASM_SIMP_TAC[REAL_ARITH `abs x <= a ==> x <= a`; SUM_LOG_OVER_X_BOUND] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[GSYM real_div; LOG_POS; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INV_INV] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MP_TAC(SPECL [`x:num`; `n:num`] DIVISION) THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Now the analogous result for the principal character. *) (* ------------------------------------------------------------------------- *) let BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL_LEMMA = prove (`!d. 1 <= d ==> norm(vsum(1..x) (\n. (chi_0 d n - Cx(&1)) * Cx(mangoldt n / &n))) <= sum {p | prime p /\ p divides d} (\p. log(&p))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {p | prime p /\ p divides d} (\p. sum {k | 1 <= k /\ p EXP k <= x} (\k. log(&p) / &p pow k))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_SPECIAL_DIVISORS; LE_1] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `2 <= p /\ 1 <= p /\ 1 < p` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 < p /\ 1 <= p`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..x) (\k. log(&p) / &p pow k)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN ASM_SIMP_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM; SUBSET; REAL_POW_LE; REAL_POS; REAL_LE_DIV; LOG_POS; REAL_OF_NUM_LE; PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 <= p`] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP k` THEN ASM_SIMP_TAC[LT_POW2_REFL; LT_IMP_LE; EXP_MONO_LE]; REWRITE_TAC[real_div; SUM_LMUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; LOG_POS_LT; REAL_OF_NUM_LT] THEN SIMP_TAC[GSYM REAL_POW_INV; SUM_GP; REAL_INV_EQ_1; REAL_OF_NUM_EQ] THEN COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT; REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[real_pow] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x * y /\ &2 * x <= &1 ==> x pow 1 - x * y <= &1 - x`) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS; REAL_LE_MUL] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LT; REAL_OF_NUM_LE; LE_1]]] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SUM_PRODUCT o rand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_SPECIAL_DIVISORS; LE_1] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..x` THEN SIMP_TAC[SUBSET; FINITE_NUMSEG; IN_NUMSEG; IN_ELIM_THM] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP k` THEN ASM_SIMP_TAC[LT_POW2_REFL; LT_IMP_LE; EXP_MONO_LE; PRIME_GE_2]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN REWRITE_TAC[chi_0; COND_RAND; COND_RATOR] THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_SUB_LZERO] THEN REWRITE_TAC[COMPLEX_NORM_CX; NORM_NEG; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN REWRITE_TAC[mangoldt; COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ABS_NUM] THEN REWRITE_TAC[TAUT `(if a then &0 else if b then x else &0) = (if ~a /\ b then x else &0)`] THEN SIMP_TAC[GSYM real_div; GSYM SUM_RESTRICT_SET; FINITE_NUMSEG] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN EXISTS_TAC `\(p,k). p EXP k` THEN REWRITE_TAC[EXISTS_UNIQUE; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG; PAIR_EQ] THEN CONJ_TAC THENL [X_GEN_TAC `y:num` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN UNDISCH_TAC `~(coprime(p EXP k,d))` THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_PRIMEPOW; LE_1] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`q:num`; `j:num`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[EQ_PRIME_EXP] THEN ASM_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_PRIMEPOW; LE_1] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[EXP_EQ_0; LE_1; PRIME_0]; ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = y ==> abs x = y`) THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; PRIME_IMP_NZ; LE_1] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `q:num` THEN REWRITE_TAC[] THEN EQ_TAC THENL [ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_PRIME_PRIME]; DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `k = SUC(k - 1)` SUBST1_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[EXP; DIVIDES_RMUL; DIVIDES_REFL]]]);; let BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL = prove (`!d. 1 <= d ==> bounded { vsum(1..x) (\n. chi_0 d n * Cx(mangoldt n / &n)) - Cx(log(&x)) | x IN (:num)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[bounded; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN EXISTS_TAC `abs(sum {p | prime p /\ p divides d} (\p. log(&p))) + abs(log(&0)) + &21` THEN X_GEN_TAC `x:num` THEN ASM_CASES_TAC `x = 0` THENL [ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; ARITH; VECTOR_SUB_LZERO] THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= a + b ==> x <= a + abs y + b`) THEN MATCH_MP_TAC(NORM_ARITH `!s'. norm(s') <= p /\ norm(s - s' - l) <= &21 ==> norm(s - l) <= abs p + &21`) THEN EXISTS_TAC `vsum(1..x) (\n. (chi_0 d n - Cx(&1)) * Cx(mangoldt n / &n))` THEN ASM_SIMP_TAC[BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL_LEMMA] THEN SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN REWRITE_TAC[COMPLEX_RING `c * x - (c - Cx(&1)) * x = x`] THEN SIMP_TAC[GSYM CX_SUB; VSUM_CX; FINITE_NUMSEG; COMPLEX_NORM_CX] THEN MATCH_MP_TAC MERTENS_LEMMA THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* The arithmetic-geometric mean that we want. *) (* ------------------------------------------------------------------------- *) let SUM_OF_NUMBERS = prove (`!n. nsum(0..n) (\i. i) = (n * (n + 1)) DIV 2`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let PRODUCT_POW_NSUM = prove (`!s. FINITE s ==> product s (\i. z pow (f i)) = z pow (nsum s f)`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; NSUM_CLAUSES; real_pow; REAL_POW_ADD]);; let PRODUCT_SPECIAL = prove (`!z i. product (0..n) (\i. z pow i) = z pow ((n * (n + 1)) DIV 2)`, SIMP_TAC[PRODUCT_POW_NSUM; FINITE_NUMSEG; SUM_OF_NUMBERS]);; let AGM_SPECIAL = prove (`!n t. &0 <= t ==> (&n + &1) pow 2 * t pow n <= (sum(0..n) (\k. t pow k)) pow 2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`n + 1`; `\k. (t:real) pow (k - 1)`] AGM) THEN ASM_SIMP_TAC[REAL_POW_LE; ARITH_RULE `1 <= n + 1`] THEN SUBGOAL_THEN `1..n+1 = 0+1..n+1` SUBST1_TAC THENL [REWRITE_TAC[ADD_CLAUSES]; ALL_TAC] THEN REWRITE_TAC[SUM_OFFSET; PRODUCT_OFFSET; ADD_SUB] THEN REWRITE_TAC[PRODUCT_SPECIAL] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_POW_LE2)) THEN DISCH_THEN(MP_TAC o SPEC `2`) THEN ASM_SIMP_TAC[PRODUCT_POS_LE_NUMSEG; REAL_POW_LE] THEN REWRITE_TAC[REAL_POW_POW] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN SUBGOAL_THEN `2 * (n * (n + 1)) DIV 2 = n * (n + 1)` SUBST1_TAC THENL [SUBGOAL_THEN `EVEN(n * (n + 1))` MP_TAC THENL [REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN CONV_TAC TAUT; SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; DIV_MULT; ARITH]]; REWRITE_TAC[GSYM REAL_POW_POW] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_POW_LE2_REV)) THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_POW_2; REAL_LE_SQUARE] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_OF_NUM_ADD] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[REAL_MUL_AC]]);; (* ------------------------------------------------------------------------- *) (* The trickiest part: the nonvanishing of L-series for real character. *) (* Proof from Monsky's article (AMM 1993, pp. 861-2). *) (* ------------------------------------------------------------------------- *) let DIVISORSUM_PRIMEPOW = prove (`!f p k. prime p ==> sum {m | m divides (p EXP k)} c = sum(0..k) (\i. c(p EXP i))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW; SET_RULE `{m | ?i. P i /\ m = f i} = IMAGE f {i | P i}`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[GSYM NUMSEG_LE] THEN MATCH_MP_TAC SUM_IMAGE THEN ASM_SIMP_TAC[IN_ELIM_THM; EQ_EXP; FINITE_NUMSEG_LE] THEN ASM_MESON_TAC[PRIME_0; PRIME_1]);; let DIVISORVSUM_PRIMEPOW = prove (`!f p k. prime p ==> vsum {m | m divides (p EXP k)} c = vsum(0..k) (\i. c(p EXP i))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW; SET_RULE `{m | ?i. P i /\ m = f i} = IMAGE f {i | P i}`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[GSYM NUMSEG_LE] THEN MATCH_MP_TAC VSUM_IMAGE THEN ASM_SIMP_TAC[IN_ELIM_THM; EQ_EXP; FINITE_NUMSEG_LE] THEN ASM_MESON_TAC[PRIME_0; PRIME_1]);; let DIRICHLET_CHARACTER_DIVISORSUM_EQ_1 = prove (`!d c p k. dirichlet_character d c /\ prime p /\ p divides d ==> vsum {m | m divides (p EXP k)} c = Cx(&1)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum {1} c : complex` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[VSUM_SING] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1]] THEN MATCH_MP_TAC VSUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_SING; IN_ELIM_THM; DIVIDES_1] THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:num`; `i:num`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[COMPLEX_VEC_0] THEN FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_EQ_0 th]) THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN REWRITE_TAC[COPRIME_REXP] THEN ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[EXP] THEN ASM_MESON_TAC[COPRIME_SYM; PRIME_COPRIME_EQ]);; let DIRICHLET_CHARACTER_REAL_CASES = prove (`!d c. dirichlet_character d c /\ (!n. real(c n)) ==> !n. c n = --Cx(&1) \/ c n = Cx(&0) \/ c n = Cx(&1)`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIRICHLET_CHARACTER_NORM) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[REAL_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` SUBST1_TAC) THEN REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_NEG; CX_INJ] THEN REAL_ARITH_TAC);; let DIRICHLET_CHARACTER_DIVISORSUM_PRIMEPOW_POS = prove (`!d c p k. dirichlet_character d c /\ (!n. real(c n)) /\ prime p ==> &0 <= Re(vsum {m | m divides (p EXP k)} c)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RE_VSUM; FINITE_DIVISORS; EXP_EQ_0; PRIME_IMP_NZ] THEN ASM_SIMP_TAC[DIVISORSUM_PRIMEPOW] THEN FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_POW th]) THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] DIRICHLET_CHARACTER_REAL_CASES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM CX_POW; RE_CX; SUM_POS_LE_NUMSEG; REAL_POW_LE; REAL_POS] THEN MATCH_MP_TAC(REAL_ARITH `(s = if EVEN k then &1 else &0) ==> &0 <= s`) THEN SPEC_TAC(`k:num`,`r:num`) THEN INDUCT_TAC THEN REWRITE_TAC[EVEN; SUM_CLAUSES_NUMSEG] THEN ASM_REWRITE_TAC[complex_pow; RE_CX; LE_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_POW_NEG; COMPLEX_POW_ONE; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG; COMPLEX_MUL_LID; RE_NEG; RE_CX] THEN REAL_ARITH_TAC);; let DIRICHLET_CHARACTER_DIVISORSUM_POS = prove (`!d c n. dirichlet_character d c /\ (!n. real(c n)) /\ ~(n = 0) ==> &0 <= Re(vsum {m | m divides n} c)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = 1 \/ 1 < n`)) THENL [ASM_SIMP_TAC[DIVIDES_ONE; SING_GSPEC; VSUM_SING] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; RE_CX; REAL_POS]; ALL_TAC] THEN UNDISCH_TAC `1 < n` THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIRICHLET_CHARACTER_DIVISORSUM_PRIMEPOW_POS]] THEN MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN MP_TAC(ISPEC `\m:num. Re(c m)` REAL_MULTIPLICATIVE_DIVISORSUM) THEN REWRITE_TAC[real_multiplicative] THEN ANTS_TAC THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; RE_CX; REAL; CX_MUL]; DISCH_THEN(MP_TAC o SPECL [`a:num`; `b:num`] o CONJUNCT2) THEN ASM_SIMP_TAC[GSYM RE_VSUM; FINITE_DIVISORS; MULT_EQ_0; ARITH_RULE `1 < n ==> ~(n = 0)`; REAL_LE_MUL]]);; let lemma = prove (`!x n. &0 <= x /\ x <= &1 ==> &1 - &n * x <= (&1 - x) pow n`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow] THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - x) * (&1 - &n * x)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= n * x * x ==> &1 - (n + &1) * x <= (&1 - x) * (&1 - n * x)`) THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_SQUARE]);; let LFUNCTION_NONZERO_REAL = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) /\ (!n. real(c n)) ==> ~(Lfunction c = Cx(&0))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `!z. norm(z) < &1 ==> summable (from 1) (\n. c(n) * z pow n / (Cx(&1) - z pow n))` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `2` THEN MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\n:num. Cx(&0)` THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; SUMMABLE_0] THEN ASM_SIMP_TAC[COMPLEX_VEC_0; COMPLEX_POW_ZERO; IN_FROM; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN EXISTS_TAC `\n. Cx(&2 * norm(z:complex) pow n)` THEN REWRITE_TAC[REAL_CX; RE_CX] THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; NORM_POS_LE] THEN ASM_SIMP_TAC[CX_MUL; CX_POW; SUMMABLE_COMPLEX_LMUL; COMPLEX_NORM_CX; REAL_ABS_NORM; SUMMABLE_GP] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_ABS_POS; REAL_LE_MUL] THEN REWRITE_TAC[TAUT `(p ==> (if q then x else T)) <=> p /\ q ==> x`] THEN MP_TAC(SPECL [`norm(z:complex)`; `&1 / &2`] REAL_ARCH_POW_INV) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; REAL_ABS_NUM; REAL_ABS_POW] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[complex_div; COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN SUBST1_TAC(REAL_ARITH `&2 = inv(&1 / &2)`) THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(NORM_ARITH `norm(z) <= norm(w) - h ==> h <= norm(w - z)`) THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(z:complex) pow N` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; ALL_TAC] THEN REWRITE_TAC[summable; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:complex->complex` (LABEL_TAC "+")) THEN ABBREV_TAC `b = \z n. inv(Cx(&n) * (Cx(&1) - z)) - z pow n / (Cx(&1) - z pow n)` THEN SUBGOAL_THEN `!z:complex. norm(z) < &1 ==> ((\n. c(n) * b z n) sums --(f z)) (from 1)` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "b" THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB; GSYM COMPLEX_SUB_LZERO] THEN MATCH_MP_TAC SERIES_SUB THEN ASM_SIMP_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN REWRITE_TAC[COMPLEX_INV_MUL; COMPLEX_MUL_ASSOC] THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = Cx(&0) * inv(Cx(&1) - z)`) THEN MATCH_MP_TAC SERIES_COMPLEX_RMUL THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION) THEN ASM_REWRITE_TAC[complex_div]; ALL_TAC] THEN SUBGOAL_THEN `!z. norm(z) < &1 ==> ((\n. vsum {d | d divides n} (\d. c d) * z pow n) sums f(z)) (from 1)` (LABEL_TAC "+") THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN SIMP_TAC[GSYM VSUM_COMPLEX_RMUL; FINITE_DIVISORS; LE_1] THEN REWRITE_TAC[VSUM_VSUM_DIVISORS] THEN REMOVE_THEN "+" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG; sums; FROM_INTER_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM COMPLEX_POW_POW] THEN REWRITE_TAC[VSUM_GP; ARITH_RULE `n < 1 <=> n = 0`] THEN SIMP_TAC[DIV_EQ_0; LE_1] THEN SIMP_TAC[GSYM NOT_LE] THEN SUBGOAL_THEN `!k. 1 <= k ==> ~(z pow k = Cx(&1))` (fun th -> SIMP_TAC[th]) THENL [ASM_MESON_TAC[COMPLEX_POW_EQ_1; LE_1; REAL_LT_REFL]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_POW_1; complex_div] THEN REWRITE_TAC[COMPLEX_RING `(zx * i - (zx - w) * i) = w * i`] THEN SIMP_TAC[COMPLEX_POW_POW] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\x. vsum (1..x) (\n. z pow x * c n * z pow (n - x MOD n) / (Cx(&1) - z pow n))` THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[COMPLEX_RING `(zx * cn) * zn = cn * zx * zn`] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN AP_TERM_TAC THEN REWRITE_TAC[MULT_CLAUSES] THEN MP_TAC(SPECL [`x:num`; `n:num`] DIVISION) THEN ASM_SIMP_TAC[LE_1] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\x. Cx(norm(z) / (&1 - norm z)) * Cx(&x) * z pow x` THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_DIV; REAL_ABS_NUM] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `a * &x * b = &x * a * b`] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN FIRST_ASSUM(fun t -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM t]) THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_DIV; REAL_ABS_POS; NORM_POS_LE; REAL_LE_MUL; REAL_MUL_LID; REAL_ABS_NORM] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN SIMP_TAC[complex_div; real_div; COMPLEX_NORM_MUL; COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[NORM_POS_LE; REAL_LE_INV_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_NORM_POW] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_POW_1] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN MATCH_MP_TAC(ARITH_RULE `m < r ==> 1 <= r - m`) THEN ASM_SIMP_TAC[DIVISION; LE_1]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_ARITH `&0 < abs(x - a) <=> ~(a = x)`] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(w) = &1 /\ norm(z) < &1 /\ norm(zn) <= norm(z) ==> abs(&1 - norm(z)) <= norm(w - zn)`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_NUM; COMPLEX_NORM_POW] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_POW_1] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; ALL_TAC] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN ASM_SIMP_TAC[LIM_N_TIMES_POWN]; ALL_TAC] THEN SUBGOAL_THEN `~(bounded { (f:complex->complex)(t) | real t /\ &0 <= Re t /\ norm(t) < &1 })` MP_TAC THENL [REWRITE_TAC[BOUNDED_POS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IMP_CONJ; FORALL_REAL] THEN REWRITE_TAC[COMPLEX_NORM_CX; RE_CX; IMP_IMP] THEN REWRITE_TAC[REAL_ARITH `&0 <= x /\ abs x < &1 <=> &0 <= x /\ x < &1`] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o MATCH_MP PRIME_FACTOR) THEN X_CHOOSE_TAC `N:num` (SPEC `&2 * (B + &1)` REAL_ARCH_SIMPLE) THEN SUBGOAL_THEN `0 < N` ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `t = &1 - inv(&(p EXP N)) / &2` THEN SUBGOAL_THEN `&0 <= t /\ t < &1` STRIP_ASSUME_TAC THENL [EXPAND_TAC "t" THEN MATCH_MP_TAC(REAL_ARITH `&0 < y /\ y <= &1 ==> &0 <= &1 - y / &2 /\ &1 - y / &2 < &1`) THEN ASM_SIMP_TAC[REAL_INV_LE_1; REAL_LT_INV_EQ; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; EXP_EQ_0; PRIME_IMP_NZ]; ALL_TAC] THEN REMOVE_THEN "+" (MP_TAC o SPEC `Cx t`) THEN REWRITE_TAC[COMPLEX_NORM_CX; NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[SERIES_FROM; LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` MP_TAC) THEN SUBGOAL_THEN `?n. M <= n /\ 1 <= n /\ p EXP N <= n` STRIP_ASSUME_TAC THENL [EXISTS_TAC `p EXP N + M + 1` THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `norm (f (Cx t):complex) <= B` THEN MATCH_MP_TAC(NORM_ARITH `B + &1 <= norm(x) ==> norm(y) <= B ==> ~(dist(x,y) < &1)`) THEN MATCH_MP_TAC(REAL_ARITH `a <= Re z /\ abs(Re z) <= norm z ==> a <= norm z`) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN SIMP_TAC[RE_VSUM; FINITE_NUMSEG; RE_MUL_CX; GSYM CX_POW] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (IMAGE (\k. p EXP k) (0..N)) (\x. Re (vsum {d | d divides x} (\d. c d)) * t pow x)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; IN_DIFF; SUBSET; IN_ELIM_THM; FORALL_IN_IMAGE] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] DIRICHLET_CHARACTER_DIVISORSUM_POS) THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; LE_1; ETA_AX] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP N` THEN ASM_SIMP_TAC[LE_EXP; PRIME_IMP_NZ]] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[EQ_EXP] THEN ASM_MESON_TAC[PRIME_0; PRIME_1]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (0..N) (\k. &1 * &1 / &2)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; GSYM REAL_OF_NUM_ADD] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [MP_TAC(SPECL [`d:num`; `c:num->complex`; `p:num`; `k:num`] DIRICHLET_CHARACTER_DIVISORSUM_EQ_1) THEN ASM_SIMP_TAC[ETA_AX; RE_CX; REAL_LE_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`inv(&(p EXP N)) / &2`; `p EXP k`] lemma) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[real_div; GSYM REAL_INV_MUL; REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM_SIMP_TAC[EXP_EQ_0; MULT_EQ_0; ARITH; PRIME_IMP_NZ]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `b <= a ==> a <= x ==> b <= x`) THEN MATCH_MP_TAC(REAL_ARITH `x * y <= &1 ==> &1 / &2 <= &1 - x * y / &2`) THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; EXP_EQ_0; PRIME_IMP_NZ] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE; LE_EXP] THEN ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] BOUNDED_LFUNCTION_PARTIAL_SUMS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN REWRITE_TAC[BOUNDED_POS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `&2 * B` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. vsum(from 1 INTER (0..n)) (\k. c k * b (z:complex) k :complex)` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN REWRITE_TAC[FROM_INTER_NUMSEG] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`c:num->complex`; `(b:complex->num->complex) z`; `B:real`; `1`] SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT) THEN ASM_REWRITE_TAC[LE_REFL] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `1`) THEN SUBGOAL_THEN `(b:complex->num->complex) z 1 = Cx(&1)` SUBST1_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_INV_MUL; complex_div] THEN REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_INV_1] THEN MATCH_MP_TAC COMPLEX_MUL_RINV THEN REWRITE_TAC[COMPLEX_SUB_0] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN UNDISCH_TAC `norm(Cx(&1)) < &1` THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_LT_REFL; REAL_ABS_NUM]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_NUM; REAL_MUL_RID] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LE_REFL]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` SUBST_ALL_TAC o GEN_REWRITE_RULE I [REAL_EXISTS]) THEN RULE_ASSUM_TAC(REWRITE_RULE[RE_CX; COMPLEX_NORM_CX]) THEN SUBGOAL_THEN `!n. &0 < sum(0..n) (\m. t pow m)` ASSUME_TAC THENL [GEN_TAC THEN SIMP_TAC[LE_0; SUM_CLAUSES_LEFT; real_pow] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN ASM_SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POW_LE]; ALL_TAC] THEN CONJ_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN EXPAND_TAC "b" THEN REWRITE_TAC[GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; GSYM CX_MUL; GSYM CX_INV; REAL_CX; RE_CX] THENL [ASM_SIMP_TAC[REAL_SUB_POW_L1; REAL_SUB_LE] THEN ASM_REWRITE_TAC[real_div; REAL_INV_MUL] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; LE_1; REAL_ARITH `abs t < &1 ==> &0 < &1 - t`] THEN ASM_SIMP_TAC[real_div; REAL_FIELD `abs(t) < &1 ==> (x * inv(&1 - t) * y) * (&1 - t) = x * y`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ONCE_REWRITE_TAC[REAL_ARITH `x / y * &n = (&n * x) / y`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..n-1) (\m. t pow n)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_CONST_NUMSEG; ARITH_RULE `1 <= n ==> n - 1 + 1 = n`; SUB_0; REAL_LE_REFL]; REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN REPEAT CONJ_TAC THEN TRY ASM_REAL_ARITH_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_SUB_POW_L1; ARITH_RULE `1 <= n + 1`] THEN REWRITE_TAC[ADD_SUB; REAL_INV_MUL; real_div] THEN REWRITE_TAC[REAL_ARITH `x * t - y * t * z <= u * t - v * t * w <=> t * (v * w - y * z) <= t * (u - x)`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_FIELD `&0 < y /\ &0 < z ==> x / y - w / z = (x * z - w * y) / (y * z)`] THEN SUBGOAL_THEN `t pow n * sum (0..n) (\m. t pow m) - t pow (n + 1) * sum (0..n - 1) (\m. t pow m) = t pow n` SUBST1_TAC THENL [REWRITE_TAC[GSYM SUM_LMUL; GSYM REAL_POW_ADD] THEN ONCE_REWRITE_TAC[ARITH_RULE `(n + 1) + x = n + x + 1`] THEN REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET); SUB_ADD; ADD_CLAUSES] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; GSYM SUM_LMUL; ADD_CLAUSES] THEN ASM_SIMP_TAC[SUB_ADD; REAL_POW_ADD] THEN REWRITE_TAC[REAL_ARITH `(x + y) - y:real = x`]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_MUL; GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_FIELD `&1 <= n ==> inv(n) - inv(n + &1) = inv(n * (n + &1))`] THEN MATCH_MP_TAC REAL_POW_LE2_REV THEN EXISTS_TAC `2` THEN REWRITE_TAC[ARITH] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN REWRITE_TAC[REAL_LE_INV_EQ]) THEN ASM_SIMP_TAC[REAL_POW_LE; SUM_POS_LE_NUMSEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPECL [`n:num`; `t:real`] AGM_SPECIAL) THEN MP_TAC(SPECL [`n - 1`; `t:real`] AGM_SPECIAL) THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; REAL_SUB_ADD] THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; LE_1; REAL_ARITH `&0 < &n + &1`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c /\ d ==> e <=> b /\ d ==> a /\ c ==> e`] REAL_LE_MUL2)) THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_ARITH `&0 <= &n + &1`] THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> b <= x ==> a <= y`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_MUL; REAL_POW_MUL] THEN REWRITE_TAC[REAL_MUL_AC]; REWRITE_TAC[GSYM REAL_POW_ADD; REAL_POW_POW] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Deduce nonvanishing of all the nonprincipal characters. *) (* ------------------------------------------------------------------------- *) let BOUNDED_DIFF_LOGMUL = prove (`!f a. bounded {f x - Cx(log(&x)) * a | x IN (:num)} ==> (!x. &0 <= Re(f x)) ==> &0 <= Re a`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(ISPEC `exp((B + &1) / --(Re a))` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN SUBGOAL_THEN `abs(Re(f n - Cx(log(&n)) * a)) <= B` MP_TAC THENL [ASM_MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[RE_SUB; RE_MUL_CX; REAL_NOT_LE] THEN MATCH_MP_TAC(REAL_ARITH `B < l * --a /\ &0 <= f ==> B < abs(f - l * a)`) THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_NEG_GT0] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `log(exp((B + &1) / --Re a))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[LOG_EXP; REAL_NEG_GT0; REAL_LT_DIV2_EQ] THEN REAL_ARITH_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REWRITE_TAC[REAL_EXP_POS_LT]]);; let LFUNCTION_NONZERO_NONPRINCIPAL = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> ~(Lfunction c = Cx(&0))`, let lemma = prove (`{a,b,c} SUBSET s ==> FINITE s ==> !f. sum s f = sum (s DIFF {a,b,c}) f + sum {a,b,c} f`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]) in GEN_TAC THEN ASM_CASES_TAC `d = 0` THENL [ASM_MESON_TAC[DIRICHLET_CHARACTER_0]; ALL_TAC] THEN MP_TAC(ISPECL [`\x c. vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) - Cx(log(&x)) * (if c = chi_0 d then Cx(&1) else if Lfunction c = Cx(&0) then --Cx(&1) else Cx(&0))`; `(:num)`; `{c | dirichlet_character d c}`] BOUNDED_SUMS_IMAGES) THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM] THEN X_GEN_TAC `c:num->complex` THEN ASM_CASES_TAC `c = chi_0 d` THEN ASM_SIMP_TAC[COMPLEX_MUL_RID; BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL; LE_1] THEN ASM_CASES_TAC `Lfunction c = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_RNEG; COMPLEX_MUL_RZERO; COMPLEX_MUL_RID; COMPLEX_SUB_RNEG] THEN ASM_MESON_TAC[BOUNDED_DIRICHLET_MANGOLDT_ZERO; BOUNDED_DIRICHLET_MANGOLDT_NONZERO; LE_1]; ALL_TAC] THEN SIMP_TAC[VSUM_SUB; FINITE_DIRICHLET_CHARACTERS; VSUM_COMPLEX_LMUL] THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_DIFF_LOGMUL) THEN REWRITE_TAC[IN_UNIV] THEN ANTS_TAC THENL [X_GEN_TAC `x:num` THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o funpow 2 rand o snd) THEN REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_DIRICHLET_CHARACTERS] THEN SIMP_TAC[RE_VSUM; FINITE_NUMSEG; RE_MUL_CX] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN SIMP_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_POS; REAL_LE_DIV; REAL_POS; MANGOLDT_POS_LE]; ALL_TAC] THEN SIMP_TAC[RE_VSUM; FINITE_DIRICHLET_CHARACTERS] THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN REWRITE_TAC[RE_NEG; RE_CX] THEN DISCH_TAC THEN X_GEN_TAC `c:num->complex` THEN STRIP_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LT]) THEN REWRITE_TAC[] THEN SUBGOAL_THEN `{chi_0 d,c,(\n. cnj(c n))} SUBSET {c | dirichlet_character d c}` MP_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_CHI_0; DIRICHLET_CHARACTER_CNJ]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC(REAL_ARITH `s <= &0 /\ t < &0 ==> s + t < &0`) THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= --x ==> x <= &0`) THEN REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_POS_LE THEN SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; FINITE_DIFF] THEN SIMP_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; IN_INSERT; NOT_IN_EMPTY; FINITE_RULES] THEN SUBGOAL_THEN `~(chi_0 d = (\n. cnj (c n)))` ASSUME_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `(\c n:num. cnj(c n))`) THEN REWRITE_TAC[CNJ_CNJ; FUN_EQ_THM; CNJ_CHI_0] THEN ASM_REWRITE_TAC[GSYM FUN_EQ_THM; ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `~(c = \n:num. cnj(c n))` ASSUME_TAC THENL [ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[GSYM REAL_CNJ; FUN_EQ_THM] THEN ASM_MESON_TAC[LFUNCTION_NONZERO_REAL]; ALL_TAC] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION_CNJ) THEN ASM_SIMP_TAC[CNJ_EQ_CX] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence derive our boundedness result for all nonprincipal characters. *) (* ------------------------------------------------------------------------- *) let BOUNDED_DIRICHLET_MANGOLDT_NONPRINCIPAL = prove (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) ==> bounded { vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) | x IN (:num)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_DIRICHLET_MANGOLDT_NONZERO THEN EXISTS_TAC `d:num` THEN ASM_MESON_TAC[LFUNCTION_NONZERO_NONPRINCIPAL]);; (* ------------------------------------------------------------------------- *) (* Hence the main sum result. *) (* ------------------------------------------------------------------------- *) let BOUNDED_SUM_OVER_DIRICHLET_CHARACTERS = prove (`!d l. 1 <= d /\ coprime(l,d) ==> bounded { vsum {c | dirichlet_character d c} (\c. c(l) * vsum(1..x) (\n. c n * Cx (mangoldt n / &n))) - Cx(log(&x)) | x IN (:num)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!x. Cx(log(&x)) = vsum {c | dirichlet_character d c} (\c. if c = chi_0 d then Cx(log(&x)) else Cx(&0))` (fun th -> ONCE_REWRITE_TAC[th]) THENL [SIMP_TAC[VSUM_DELTA; GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[IN_ELIM_THM; DIRICHLET_CHARACTER_CHI_0]; ALL_TAC] THEN SIMP_TAC[GSYM VSUM_SUB; FINITE_DIRICHLET_CHARACTERS] THEN MATCH_MP_TAC BOUNDED_SUMS_IMAGES THEN REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM] THEN X_GEN_TAC `c:num->complex` THEN DISCH_TAC THEN ASM_CASES_TAC `c = chi_0 d` THEN ASM_REWRITE_TAC[] THENL [FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL) THEN ASM_REWRITE_TAC[chi_0; COMPLEX_MUL_LID]; REWRITE_TAC[COMPLEX_SUB_RZERO] THEN MP_TAC(SPECL [`d:num`; `c:num->complex`] BOUNDED_DIRICHLET_MANGOLDT_NONPRINCIPAL) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BOUNDED_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_NORM_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN REAL_ARITH_TAC]);; let DIRICHLET_MANGOLDT = prove (`!d k. 1 <= d /\ coprime(k,d) ==> bounded { Cx(&(phi d)) * vsum {n | n IN 1..x /\ (n == k) (mod d)} (\n. Cx(mangoldt n / &n)) - Cx(log(&x)) | x IN (:num)}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?l. (k * l == 1) (mod d)` CHOOSE_TAC THENL [ASM_MESON_TAC[CONG_SOLVE]; ALL_TAC] THEN MP_TAC(SPECL [`d:num`; `l:num`] BOUNDED_SUM_OVER_DIRICHLET_CHARACTERS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(k * l == 1) (mod d)` THEN CONV_TAC NUMBER_RULE; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN X_GEN_TAC `x:num` THEN DISCH_THEN(K ALL_TAC) THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG; FINITE_RESTRICT] THEN SIMP_TAC[VSUM_RESTRICT_SET; FINITE_NUMSEG] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o lhand o snd) THEN REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN MP_TAC(GSYM(SPEC `d:num` DIRICHLET_CHARACTER_MUL)) THEN SIMP_TAC[IN_ELIM_THM] THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_DIRICHLET_CHARACTERS] THEN ASM_SIMP_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS] THEN SUBGOAL_THEN `(l * n == 1) (mod d) <=> (n == k) (mod d)` SUBST1_TAC THENL [UNDISCH_TAC `(k * l == 1) (mod d)` THEN CONV_TAC NUMBER_RULE; COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_VEC_0]]);; let DIRICHLET_MANGOLDT_EXPLICIT = prove (`!d k. 1 <= d /\ coprime (k,d) ==> ?B. &0 < B /\ !x. abs(sum {n | n IN 1..x /\ (n == k) (mod d)} (\n. mangoldt n / &n) - log(&x) / &(phi d)) <= B`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIRICHLET_MANGOLDT) THEN REWRITE_TAC[BOUNDED_POS] THEN SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN SIMP_TAC[VSUM_CX; FINITE_RESTRICT; FINITE_NUMSEG; GSYM CX_SUB; GSYM CX_MUL; COMPLEX_NORM_CX] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `B / &(phi d)` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; PHI_LOWERBOUND_1_STRONG; REAL_LE_RDIV_EQ] THEN X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ABS_NUM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; LE_1; PHI_LOWERBOUND_1_STRONG; REAL_OF_NUM_EQ]);; let DIRICHLET_STRONG = prove (`!d k. 1 <= d /\ coprime(k,d) ==> ?B. &0 < B /\ !x. abs(sum {p | p IN 1..x /\ prime p /\ (p == k) (mod d)} (\p. log(&p) / &p) - log(&x) / &(phi d)) <= B`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP DIRICHLET_MANGOLDT_EXPLICIT) THEN EXISTS_TAC `B + &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num`) THEN MATCH_MP_TAC(REAL_ARITH `abs(x - y) <= a ==> abs(x - z) <= b ==> abs(y - z) <= b + a`) THEN MP_TAC(SPECL [`x:num`; `{n | n IN 1..x /\ (n == k) (mod d)}`] MERTENS_MANGOLDT_VERSUS_LOG) THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[CONJ_ACI]);; (* ------------------------------------------------------------------------- *) (* Ignore the density details and prove the main result. *) (* ------------------------------------------------------------------------- *) let DIRICHLET = prove (`!d k. 1 <= d /\ coprime(k,d) ==> INFINITE {p | prime p /\ (p == k) (mod d)}`, REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MP_TAC(SPECL [`d:num`; `k:num`] DIRICHLET_STRONG) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `max (exp(&(phi d) * (&1 + B + sum {p | p IN 1..n /\ prime p /\ (p == k) (mod d)} (\p. log(&p) / &p)))) (max (&n) (&1))` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[NOT_EXISTS_THM; REAL_MAX_LE; REAL_OF_NUM_LE] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs(x - y) <= b ==> y < &1 + b + x`)) THEN ASM_SIMP_TAC[REAL_NOT_LT; REAL_LE_RDIV_EQ; PHI_LOWERBOUND_1_STRONG; REAL_OF_NUM_LT; LE_1] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LE_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x <= a ==> x = y ==> y <= a`)) THEN REPLICATE_TAC 4 AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN ASM_ARITH_TAC);; hol-light/100/div3.ml000066400000000000000000000022631303454263000144470ustar00rootroot00000000000000(* ========================================================================= *) (* #85: divisibility by 3 rule *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/pocklington.ml";; let EXP_10_CONG_3 = prove (`!n. (10 EXP n == 1) (mod 3)`, INDUCT_TAC THEN REWRITE_TAC[EXP; CONG_REFL] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `10 * 1` THEN CONJ_TAC THEN ASM_SIMP_TAC[CONG_MULT; CONG_REFL] THEN SIMP_TAC[CONG; ARITH] THEN CONV_TAC NUM_REDUCE_CONV);; let SUM_CONG_3 = prove (`!d n. (nsum(0..n) (\i. 10 EXP i * d(i)) == nsum(0..n) (\i. d i)) (mod 3)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THENL [REWRITE_TAC[EXP; MULT_CLAUSES; CONG_REFL]; ALL_TAC] THEN REWRITE_TAC[LE_0] THEN MATCH_MP_TAC CONG_ADD THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV) [ARITH_RULE `d = 1 * d`] THEN MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL; EXP_10_CONG_3]);; let DIVISIBILITY_BY_3 = prove (`3 divides (nsum(0..n) (\i. 10 EXP i * d(i))) <=> 3 divides (nsum(0..n) (\i. d i))`, MATCH_MP_TAC CONG_DIVIDES THEN REWRITE_TAC[SUM_CONG_3]);; hol-light/100/divharmonic.ml000066400000000000000000000073501303454263000161070ustar00rootroot00000000000000(* ========================================================================= *) (* Divergence of harmonic series. *) (* ========================================================================= *) prioritize_real();; let HARMONIC_DIVERGES = prove (`~(?s. !e. &0 < e ==> ?N. !n. N <= n ==> abs(sum(1..n) (\i. &1 / &i) - s) < e)`, STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1 / &4`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `N + 1`) THEN REWRITE_TAC[LE_ADD] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(N + 1) + (N + 1)`) THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= (N + 1) + 1`] THEN MATCH_MP_TAC(REAL_ARITH `&1 / &2 <= y ==> abs((x + y) - s) < &1 / &4 ==> ~(abs(x - s) < &1 / &4)`) THEN REWRITE_TAC[GSYM MULT_2] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum((N + 1) + 1 .. 2 * (N + 1)) (\i. &1 / &(2 * (N + 1)))` THEN CONJ_TAC THENL [SIMP_TAC[SUM_CONST_NUMSEG; ARITH_RULE `(2 * x + 1) - (x + 1) = x`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN MP_TAC(SPEC `n:num` REAL_POS) THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Formulation in terms of limits. *) (* ------------------------------------------------------------------------- *) needs "Library/analysis.ml";; let HARMONIC_DIVERGES' = prove (`~(convergent (\n. sum(1..n) (\i. &1 / &i)))`, REWRITE_TAC[convergent; SEQ; GE; HARMONIC_DIVERGES]);; (* ------------------------------------------------------------------------- *) (* Lower bound on the partial sums. *) (* ------------------------------------------------------------------------- *) let HARMONIC_LEMMA = prove (`!m. sum(1..2 EXP m) (\n. &1 / &n) >= &m / &2`, REWRITE_TAC[real_ge] THEN INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_2; SUM_SING_NUMSEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= 2 EXP m + 1`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `a <= x ==> b - a <= y ==> b <= x + y`)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM (CONJUNCT2 EXP); GSYM MULT_2] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(2 EXP m + 1..2 EXP (SUC m))(\n. &1 / &(2 EXP (SUC m)))` THEN CONJ_TAC THENL [SIMP_TAC[SUM_CONST_NUMSEG; EXP; ARITH_RULE `(2 * x + 1) - (x + 1) = x`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN MP_TAC(SPECL [`2`; `m:num`] EXP_EQ_0) THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Germ of an alternative proof. *) (* ------------------------------------------------------------------------- *) needs "Library/transc.ml";; let LOG_BOUND = prove (`&0 < x /\ x < &1 ==> ln(&1 + x) >= x / &2`, REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM LN_EXP] THEN ASM_SIMP_TAC[LN_MONO_LE; REAL_EXP_POS_LT; REAL_LT_ADD; REAL_LT_01] THEN MP_TAC(SPEC `x / &2` REAL_EXP_BOUND_LEMMA) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; hol-light/100/e_is_transcendental.ml000066400000000000000000004025511303454263000176120ustar00rootroot00000000000000(* * HOL Light proof that e is transcendental. * * This HOL Light proof and its relationship to the informal proof is * described in : * * "Formalizing a Proof that e is Transcendental", Journal of Formal * Reasoning, Vol 4, No 1. 2011. * * It follows the informal proof provided by the good folks at the * planetmath website: * * http://planetmath.org/encyclopedia/EIsTranscendental2.html * * Note: the original proof script linked to in the above paper * partitioned the proofs amongst several files, each encapsulated * in an Ocaml module. This file has simply concatenated those files * and hence the module structure persists. * * Jesse Bingham, Jan 2012 * jesse.d.bingham@intel.com * jesse.bingham@gmail.com *) (* this is needed since the sum from the HOL core (iter.ml, i think) * which is used below, gets overwritten when Library/analysis.ml is loaded. *) let OLD_SUM = sum;; (* required stuff from HOL Light library... *) needs "Library/binomial.ml";; needs "Library/analysis.ml";; needs "Library/transc.ml";; needs "Library/prime.ml";; needs "Library/iter.ml";; needs "Library/integer.ml";; needs "Library/floor.ml";; (* get def of transcendental from Harrison's Liouville proof *) needs "100/liouville.ml";; prioritize_real();; (* * A few misculaneous proof utility functions *) (* A listified version of ADD_ASSUM *) let ADD_ASSUMS lst thm = let f x y = ADD_ASSUM y x in List.fold_left f thm lst ;; (* A tactic that takes a goal with an assumption A /\ B and replaces * it with a goal with the two assumptions A and B *) let SPLIT_CONJOINED_ASSUMPT_TAC t = (UNDISCH_TAC t) THEN (ONCE_REWRITE_TAC [TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`]) THEN (DISCH_TAC THEN DISCH_TAC) ;; (* Adds an assumption and discharges it in one fell swoop *) let ADD_ASSUM_DISCH ass thm = DISCH ass (ADD_ASSUM ass thm);; (* BRW = Bolean ReWrite *) let BRW t f = ONCE_REWRITE_RULE [TAUT t] f;; (* Those two boolean rewrites come in handy *) let BRW0 f = BRW `(X ==> Y ==> Z) <=> (X /\ Y ==> Z)` f;; let BRW1 f = BRW `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)` f;; (* a bunch of trivial real theorems that are useful for * rewriting/simplifying/mesoning *) let rewrites0 = map REAL_ARITH [`&0 + (y:real) = y`;`(x:real) * &0 = &0`;`(&1:real) + &0 = &1`;`(x:real) * &1 = x`];; module Pm_lemma1 = struct let PDI_DEF = new_recursive_definition num_RECURSION ` (poly_diff_iter p 0 = p) /\ (poly_diff_iter p (SUC n) = poly_diff (poly_diff_iter p n)) ` let PDI_POLY_DIFF_COMM = prove( `! p n.(poly_diff_iter (poly_diff p) n) = (poly_diff (poly_diff_iter p n))`, STRIP_TAC THEN INDUCT_TAC THEN (ASM_SIMP_TAC [PDI_DEF]) ) let SODN = new_definition `SODN p n = iterate poly_add (0..n) (\i.poly_diff_iter p i)` ;; let SOD = new_definition `!p. SOD p = SODN p (LENGTH p)`;; let PHI = new_definition `Phi f x = (exp (-- x)) * (poly (SOD f) x)` let PLANETMATH_EQN_1_1_1 = prove( `! x f.((Phi f) diffl ((exp (--x)) * ((poly (poly_diff (SOD f)) x) - (poly (SOD f) x))) )(x)`, let lem1 = SPECL [`\x.exp (--x)`; `\x.poly (SOD f) x`; `--(exp (--x))`; `poly (poly_diff (SOD f)) x`; `x:real`] DIFF_MUL in let EXP_NEG_X_DIFF = prove( `!x. ((\x.exp (--x)) diffl (-- (exp (--x))))(x)`, STRIP_TAC THEN DIFF_TAC THEN REAL_ARITH_TAC) in let lem2 = SPEC `x:real` EXP_NEG_X_DIFF in let lem3 = SPECL [`SOD f`;`x:real`] POLY_DIFF in let lem4 = CONJ lem2 lem3 in let lem5 = BETA_RULE (MP lem1 lem4) in let lem6 = REAL_ARITH `(a*(b - c)) = (-- a*c) + (b*a)` in let PHI_abs = prove( `Phi f = \x.((exp (-- x)) * (poly (SOD f) x))`, (PURE_REWRITE_TAC [SYM (ABS `x:real` (SPEC_ALL PHI))]) THEN (ACCEPT_TAC (SYM (ETA_CONV `\x.(Phi f x)`)))) in (REPEAT STRIP_TAC) THEN (REWRITE_TAC [PHI_abs]) THEN (REWRITE_TAC [lem6]) THEN (ACCEPT_TAC lem5) ) let POLY_SUB = prove( `!p1 p2 x. poly (p1 ++ (neg p2)) x = poly p1 x - poly p2 x`, (REWRITE_TAC [POLY_ADD;poly_neg;POLY_CMUL]) THEN REAL_ARITH_TAC ) let ZERO_INSERT_NUMSEG = prove( `!n. (0..n) = (0 INSERT (1..n))`, let lem01 = SIMP_RULE [ARITH_RULE `0 <= n`] (SPECL [`0`;`n:num`] NUMSEG_LREC) in let lem02 = SIMP_RULE [ARITH_RULE `0 + 1 = 1`] lem01 in (ACCEPT_TAC (GEN_ALL (GSYM lem02))) ) let PDI_POLYDIFF_SUC_LEMMA = prove( `!f n .(poly_diff_iter (poly_diff f) n) = poly_diff_iter f (SUC n)`, STRIP_TAC THEN INDUCT_TAC THENL [ (SIMP_TAC [PDI_DEF]); (ONCE_REWRITE_TAC [PDI_DEF]) THEN (ONCE_REWRITE_TAC [PDI_DEF]) THEN (SIMP_TAC [PDI_POLY_DIFF_COMM]) ] ) let SOD_POLY_DIFF_ITERATE = prove( `!f .(SOD (poly_diff f)) = iterate (++) (1..(LENGTH f)) (\i.poly_diff_iter f i)`, let lemA1 = SPECL [`1`;`0`] NUMSEG_EMPTY in let lemA2 = SIMP_RULE [ARITH_RULE `0 < 1`] lemA1 in let lem1 = MATCH_MP ITERATE_IMAGE_NONZERO MONOIDAL_POLY_ADD in let lem2 = ISPECL [`poly_diff_iter f`;`SUC`;`0..(LENGTH (poly_diff f))`] lem1 in let lem3 = SIMP_RULE [FINITE_NUMSEG] lem2 in let lem4 = ONCE_REWRITE_RULE [ARITH_RULE `~(~(x=y) /\ (SUC x) = (SUC y))`] lem3 in let lem5 = SIMP_RULE [] lem4 in let lem6 = ISPECL [`0`;`n:num`;`1`] NUMSEG_OFFSET_IMAGE in let lem7 = SIMP_RULE [ARITH_RULE `!m.m+1 = SUC m`] lem6 in let lem8 = SIMP_RULE [ARITH_RULE `SUC 0 = 1`] lem7 in let lem9 = ONCE_REWRITE_RULE [ETA_CONV `(\i. SUC i)`] lem8 in let lem10 = ONCE_REWRITE_RULE [GSYM lem9] lem5 in let lem11 = ONCE_REWRITE_RULE [GSYM (ETA_CONV `(\i. poly_diff_iter f i)`)] lem10 in let lem12 = SIMP_RULE [o_DEF] lem11 in let lemma0 = prove( `! h t.SUC (LENGTH (poly_diff (CONS h t))) = LENGTH (CONS h t)`, (SIMP_TAC [LENGTH_POLY_DIFF;LENGTH;PRE]) ) in (ONCE_REWRITE_TAC [SOD]) THEN (ONCE_REWRITE_TAC [SODN]) THEN (ONCE_REWRITE_TAC [PDI_POLYDIFF_SUC_LEMMA ]) THEN LIST_INDUCT_TAC THENL [ (SIMP_TAC [poly_diff;LENGTH]) THEN (SIMP_TAC [GSYM lemma0;lem12]) THEN (SIMP_TAC [NUMSEG_SING;MONOIDAL_POLY_ADD;ITERATE_SING]) THEN (SIMP_TAC [lemA2;MATCH_MP ITERATE_CLAUSES_GEN MONOIDAL_POLY_ADD]) THEN (ONCE_REWRITE_TAC [POLY_ADD_IDENT]) THEN (SIMP_TAC [PDI_DEF;POLY_DIFF_CLAUSES]); (SIMP_TAC [lem12;GSYM lemma0]) ] ) let ZERO_ITERATE_POLYADD_LEMMA = prove( `!n f .iterate (++) (0 INSERT (1..n)) f = (f 0) ++ iterate (++) (1..n) f`, let lem0 = prove(`!n. ~(0 IN (1..n))`, STRIP_TAC THEN (ONCE_REWRITE_TAC [IN_NUMSEG]) THEN ARITH_TAC) in let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in let lem3 = CONJUNCT2 lem2 in let lem4 = ISPECL [`f:(num -> (real)list)`;`0`;`1..n`] lem3 in let lem5 = ISPECL [`poly_add`;`f:(num -> (real)list)`;`1..n` ] FINITE_SUPPORT in let lem6 = SIMP_RULE [FINITE_NUMSEG] lem5 in let lem7 = MP lem4 lem6 in let lem9 = SIMP_RULE [lem0] lem7 in (ACCEPT_TAC (GEN_ALL lem9)) ) let SOD_SOD_POLYDIFF = prove( `!f .(SOD f) = f ++ (SOD (poly_diff f))`, (ONCE_REWRITE_TAC [SOD_POLY_DIFF_ITERATE]) THEN (ONCE_REWRITE_TAC [SOD]) THEN (ONCE_REWRITE_TAC [SODN]) THEN (ONCE_REWRITE_TAC [ZERO_INSERT_NUMSEG]) THEN (ONCE_REWRITE_TAC [ZERO_ITERATE_POLYADD_LEMMA]) THEN (BETA_TAC) THEN (SIMP_TAC [PDI_DEF]) ) let SUC_INSERT_NUMSEG = prove( `!n. (0..(SUC n)) = (SUC n) INSERT (0..n)`, let lem01 = SIMP_RULE [ARITH_RULE `0 <= SUC n`] (SPECL [`0`;`n:num`] NUMSEG_REC) in ACCEPT_TAC (GEN_ALL lem01) ) let SUC_NOT_IN_NUMSEG = prove( `!m n. ~((SUC n) IN (m..n))`, STRIP_TAC THEN (ONCE_REWRITE_TAC [IN_NUMSEG]) THEN ARITH_TAC ) let SUC_ITERATE_PDI_POLYDIFF_LEMMA = prove( `iterate (++) ((SUC n) INSERT (0..n)) (\i.poly_diff_iter (poly_diff p) i) = (poly_diff_iter (poly_diff p) (SUC n)) ++ iterate (++) (0..n) (\i.poly_diff_iter (poly_diff p) i)`, let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in let lem3 = CONJUNCT2 lem2 in let lem4 = ISPECL [`(\i.poly_diff_iter (poly_diff p) i)`;`SUC n`;`0..n`] lem3 in let lem5 = ISPECL [`poly_add`;`\i.poly_diff_iter (poly_diff p) i`;`0..n` ] FINITE_SUPPORT in let lem6 = SIMP_RULE [FINITE_NUMSEG] lem5 in let lem7 = MP lem4 lem6 in let lem9 = SIMP_RULE [SPEC `0` SUC_NOT_IN_NUMSEG] lem7 in ACCEPT_TAC lem9 ) let SODN_POLY_DIFF_COMM = prove( `!n p.(SODN (poly_diff p) n) = poly_diff (SODN p n)`, let lem = MP (ISPEC `poly_add` ITERATE_SING) MONOIDAL_POLY_ADD in let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in let lem3 = CONJUNCT2 lem2 in let lem10 = SIMP_RULE [GSYM SUC_INSERT_NUMSEG] SUC_ITERATE_PDI_POLYDIFF_LEMMA in let lema00 = ISPECL [`(\i.poly_diff_iter (p) i)`;`SUC n`;`0..n`] lem3 in let lema0 = SIMP_RULE [GSYM SUC_INSERT_NUMSEG] lema00 in let lem15 = ISPECL [`poly_add`;`\i.poly_diff_iter (p) i`;`0..n` ] FINITE_SUPPORT in let lem16 = SIMP_RULE [FINITE_NUMSEG] lem15 in let lema1 = MP lema0 lem16 in let lema2 = SIMP_RULE [SPEC `0` SUC_NOT_IN_NUMSEG] lema1 in let lema3 = ONCE_REWRITE_RULE [GSYM SODN] lema2 in INDUCT_TAC THENL [ (ONCE_REWRITE_TAC [SODN]) THEN (SIMP_TAC [NUMSEG_SING;ITERATE_SING]) THEN (ONCE_REWRITE_TAC [lem]) THEN (BETA_TAC) THEN (SIMP_TAC [PDI_POLY_DIFF_COMM]) ; (ONCE_REWRITE_TAC [SODN]) THEN (ONCE_REWRITE_TAC [lem10]) THEN (ONCE_REWRITE_TAC [GSYM SODN]) THEN (ASM_SIMP_TAC []) THEN (ONCE_REWRITE_TAC [PDI_DEF ]) THEN (ONCE_REWRITE_TAC [PDI_POLY_DIFF_COMM]) THEN (ONCE_REWRITE_TAC [GSYM POLYDIFF_ADD]) THEN STRIP_TAC THEN AP_TERM_TAC THEN (ONCE_REWRITE_TAC [lema3]) THEN (SIMP_TAC [PDI_DEF]) ] ) let SUC_ITERATE_POLYADD_LEMMA = prove( `!n f .iterate (++) ((SUC n) INSERT (0..n)) f = (f (SUC n)) ++ iterate (++) (0..n) f`, let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in let lem3 = CONJUNCT2 lem2 in let lem4 = ISPECL [`f:(num -> (real)list)`;`SUC n`;`0..n`] lem3 in let lem5 = ISPECL [`poly_add`;`f:(num -> (real)list)`;`0..n` ] FINITE_SUPPORT in let lem6 = SIMP_RULE [FINITE_NUMSEG] lem5 in let lem7 = MP lem4 lem6 in let lem9 = SIMP_RULE [SPEC `0` SUC_NOT_IN_NUMSEG] lem7 in ACCEPT_TAC (GEN_ALL lem9) ) let NUMSEG_LENGTH_POLYDIFF_LEMMA = prove( `!f. (0..(LENGTH f)) = ((LENGTH f) INSERT (0..(LENGTH (poly_diff f))))`, (SIMP_TAC [LENGTH_POLY_DIFF]) THEN (LIST_INDUCT_TAC) THENL [ (SIMP_TAC [LENGTH;PRE]) THEN (SIMP_TAC [NUMSEG_CLAUSES]) THEN (SIMP_TAC [INSERT_DEF;NOT_IN_EMPTY;IN]); (SIMP_TAC [LENGTH;PRE]) THEN (SIMP_TAC [ARITH_RULE `0 <= SUC n`;NUMSEG_REC]) ] ) let POLY_DIFF_LENGTH_LT = prove( `!p. (~(p=[])) ==> (LENGTH (poly_diff p)) < (LENGTH p)`, SIMP_TAC [LENGTH_POLY_DIFF;LENGTH_EQ_NIL; ARITH_RULE `!n.(~(n=0)) ==> (PRE n) < n`] );; let POLY_DIFF_LENGTH_LE_SUC = prove( `! p n . (LENGTH p <= SUC n) ==> (LENGTH (poly_diff p) <= n)`, (REPEAT STRIP_TAC) THEN (ASM_CASES_TAC `p:(real)list =[]`) THENL [ (ASM_SIMP_TAC [poly_diff;LENGTH]) THEN (ARITH_TAC); (ASM_MESON_TAC [POLY_DIFF_LENGTH_LT;LT_SUC_LE;LTE_TRANS]) ] ) let PDI_LENGTH_AUX = prove( `! n p. (LENGTH p <= n) ==> poly_diff_iter p n = []`, INDUCT_TAC THENL [ MESON_TAC [PDI_DEF;LENGTH_EQ_NIL;ARITH_RULE `n <= 0 <=> n = 0`]; ASM_MESON_TAC [PDI_DEF;PDI_POLY_DIFF_COMM;POLY_DIFF_LENGTH_LE_SUC] ] ) let PDI_LENGTH_NIL = prove( `! p . poly_diff_iter p (LENGTH p) = []`, SIMP_TAC [PDI_LENGTH_AUX;LE_REFL] ) let SOD_POLYDIFF_THEOREM = prove( `!f .(SOD (poly_diff f)) = (poly_diff (SOD f))`, let lemmmag = prove( `0 INSERT (0..0) = (0..0)`, (SIMP_TAC [NUMSEG_SING]) THEN (SIMP_TAC [INSERT_DEF;NOT_IN_EMPTY;IN])) in let SUC_LENGTH_CONS = prove( `SUC (LENGTH (t:(real)list)) = (LENGTH (CONS h t))`, (SIMP_TAC [LENGTH])) in (ONCE_REWRITE_TAC [SOD]) THEN (ONCE_REWRITE_TAC [SODN_POLY_DIFF_COMM]) THEN (ONCE_REWRITE_TAC [SODN]) THEN (STRIP_TAC) THEN (CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [NUMSEG_LENGTH_POLYDIFF_LEMMA]))) THEN (SPEC_TAC (`f:(real)list`,`f:(real)list`)) THEN (LIST_INDUCT_TAC) THENL [ (SIMP_TAC [poly_diff]) THEN (SIMP_TAC [LENGTH]) THEN (SIMP_TAC [SUM_SING_NUMSEG ]) THEN (SIMP_TAC [lemmmag]) ; (SIMP_TAC [LENGTH_POLY_DIFF]) THEN (SIMP_TAC [LENGTH;PRE]) THEN (CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [SUC_ITERATE_POLYADD_LEMMA]))) THEN (SIMP_TAC [LENGTH;PRE]) THEN (SIMP_TAC [GSYM SODN]) THEN (ONCE_REWRITE_TAC [GSYM SODN]) THEN (ONCE_REWRITE_TAC [SUC_LENGTH_CONS]) THEN (ONCE_REWRITE_TAC [PDI_LENGTH_NIL]) THEN (SIMP_TAC [POLY_ADD_CLAUSES ]); ] ) let SOD_SOD_DIFF_LEMMA = prove( `!f x.(poly (SOD f) x) - (poly (poly_diff (SOD f)) x) = poly f x`, MESON_TAC [SOD_SOD_POLYDIFF; POLY_ADD ; POLY_SUB;SOD_POLYDIFF_THEOREM; REAL_ARITH `((x:real) + y) -y = x`] ) let PLANETMATH_EQN_1_1_2 = prove( `!f x. ((exp (--x)) * ((poly (poly_diff (SOD f)) x) - (poly (SOD f) x))) = (-- (exp (--x))) * (poly f x)`, let lem17 = prove(`!x y.(x - y) = (-- (y - x))`,REAL_ARITH_TAC) in (REPEAT STRIP_TAC) THEN (ONCE_REWRITE_TAC [lem17]) THEN (ONCE_REWRITE_TAC [SOD_SOD_DIFF_LEMMA]) THEN REAL_ARITH_TAC ) let PLANETMATH_EQN_1_1_3 = prove( `! x f.((Phi f) diffl (-- (exp (--x)) * (poly f x)))(x)`, (ONCE_REWRITE_TAC [GSYM PLANETMATH_EQN_1_1_2]) THEN (ACCEPT_TAC PLANETMATH_EQN_1_1_1) ) let PHI_CONTL = let lem0 = SPECL [`Phi f`;`-- (exp (--x)) * (poly f x)`;`x:real`] DIFF_CONT in GEN_ALL (MP lem0 (SPEC_ALL PLANETMATH_EQN_1_1_3)) let PHI_DIFFERENTIABLE = prove( `!f x.(Phi f) differentiable x`, (SIMP_TAC [differentiable]) THEN (REPEAT STRIP_TAC) THEN (EXISTS_TAC `((exp (--x)) * ((poly (poly_diff (SOD f)) x) - (poly (SOD f) x)))`) THEN (SIMP_TAC [PLANETMATH_EQN_1_1_1]) ) let PLANETMATH_EQN_1_2 = (* this one's a bit nasty *) let FO_LEMMA2 = GEN_ALL (prove( `((! l z. (C (l:real) (z:real)) ==> l = (l' z))) ==> ((? (l:real) (z:real) .(A z) /\ (B z) /\ (C l z) /\ (D l) ) ==> (? (z:real).((A z) /\ (B z) /\ (D (l' z)))))`, let lem0 = prove(`(! (l:real) z.(C l (z:real)) ==> l = (l' z)) ==> ((C l z) = ((C l z) /\ l = (l' z)))`, MESON_TAC[]) in let lem1 = UNDISCH lem0 in (STRIP_TAC THEN (ONCE_REWRITE_TAC [lem1]) THEN (MESON_TAC[])) )) in let PROP_LEMMA = TAUT `! a b c d.((a /\ b /\ c) ==> d) = (b ==> c ==> a ==> d)` in let MVT_SPEC = SPECL [`Phi f`;`&0`;`x:real`] MVT in let MVT_SPEC2 = ONCE_REWRITE_RULE [PROP_LEMMA] MVT_SPEC in let MVT_SPEC3 = UNDISCH MVT_SPEC2 in let MVT_SPEC4 = UNDISCH MVT_SPEC3 in let MVT_SPEC5 = UNDISCH MVT_SPEC4 in let lem0 = prove(`! x. x - &0 = x`,REAL_ARITH_TAC) in let MVT_SPEC6 = ONCE_REWRITE_RULE [lem0] MVT_SPEC5 in let DIFF_UNIQ_SPEC1 = SPEC `Phi f` DIFF_UNIQ in let DIFF_UNIQ_SPEC2 = SPEC `l:real` DIFF_UNIQ_SPEC1 in let DIFF_UNIQ_SPEC3 = SPEC ` (-- (exp (--x)) * (poly f x)) ` DIFF_UNIQ_SPEC2 in let DIFF_UNIQ_SPEC4 = SPEC `x:real` DIFF_UNIQ_SPEC3 in let lem8 = SIMP_RULE [PLANETMATH_EQN_1_1_3] DIFF_UNIQ_SPEC4 in let lem9 = GENL [`l:real`;`x:real`] lem8 in let lem10 = SPECL [`\l x.((Phi f diffl l) x)`;`\z.(&0) ? z. (Q z x f)) = (! (x:real) (f:(real)list). ? (z:real). (P x) ==> (Q z x f))`, MESON_TAC []) in ((CONV_RULE SKOLEM_CONV) (ONCE_REWRITE_RULE [FO_LEM] (GEN_ALL (DISCH_ALL PLANETMATH_EQN_1_2))))) let PLANETMATH_LEMMA_1 = prove( `!x f. &0 < x ==> poly (SOD f) (&0) * exp x = poly (SOD f) x + x * exp (x - xi x f) * poly f (xi x f)`, let lemA = CONJUNCT2 (CONJUNCT2 (UNDISCH (SPEC_ALL xi_DEF))) in let lemB = ONCE_REWRITE_RULE [PHI] lemA in let lemC = ONCE_REWRITE_RULE [REAL_ARITH `((A:real) - B = C) = (B = A - C)`] lemB in let lemD = SIMP_RULE [REAL_NEG_0;REAL_EXP_0;REAL_MUL_LID] lemC in let lem01 = ASSUME `A = ((exp (-- x))*B - (C *( -- (exp (-- y))) * D))` in let lem02 = DISJ2 `exp x = &0` lem01 in let lem03 = REWRITE_RULE [GSYM (SPEC `exp x` REAL_EQ_MUL_LCANCEL)] lem02 in let lem04 = SIMP_RULE [REAL_EXP_NEG_MUL;REAL_EXP_ADD_MUL] lem03 in let lem05 = SIMP_RULE [REAL_SUB_LDISTRIB] lem04 in let lem07 = SIMP_RULE [REAL_MUL_ASSOC;REAL_EXP_NEG_MUL;REAL_MUL_LID] lem05 in let fact00 = REAL_ARITH `(B:real) - ((expx * C) * (--expy)) * D = B + C * (expx * expy) * D` in let lem08 = ONCE_REWRITE_RULE [fact00] lem07 in let lem09 = SIMP_RULE [GSYM REAL_EXP_ADD] lem08 in let lem10 = SIMP_RULE [prove(`(x:real) + -- y = x - y`, REAL_ARITH_TAC)] lem09 in let lem11 = GEN_ALL (DISCH_ALL lem10) in let lem12 = SPECL [`poly (SOD f) (&0)`; `poly (SOD f) x`; `x:real`; `x:real`; `xi x f`; `poly f (xi x f)`] lem11 in let lem13 = MP lem12 lemD in let lem14 = SPECL [`exp x`;`poly (SOD f) (&0)`] REAL_MUL_SYM in ACCEPT_TAC (GEN_ALL (DISCH_ALL (ONCE_REWRITE_RULE [lem14] lem13))) ) end;; module Pm_lemma2 = struct let POLY_MCLAURIN = prove( `! p x. poly p x = psum (0, LENGTH p) (\m.poly (poly_diff_iter p m) (&0) / &(FACT m) * x pow m)`, let lem002 = SPECL [`poly p`;`\n.poly (poly_diff_iter p n)`] MCLAURIN_ALL_LE in let lem003 = SIMP_RULE [Pm_lemma1.PDI_DEF;POLY_DIFF] lem002 in let lem004 = REWRITE_RULE [ETA_CONV `(\x.poly l x)`] POLY_DIFF in let lem005 = MATCH_MP lem003 (GEN `m:num` (SPECL [`poly_diff_iter p m`] lem004)) in let lem007 = SPECL [`x:real`;`LENGTH (p:(real)list)`] lem005 in let lem008 = ONCE_REWRITE_RULE [Pm_lemma1.PDI_LENGTH_NIL] lem007 in let lem009 = ONCE_REWRITE_RULE [poly] lem008 in let lem010 = SIMP_RULE [REAL_ARITH `!x. ((&0)/x) = &0`] lem009 in let lem011 = SIMP_RULE [REAL_MUL_LZERO;REAL_ADD_RID] lem010 in let lem012 = prove(`(? t . (A t) /\ B) ==> B`, MESON_TAC []) in ACCEPT_TAC (GEN_ALL (MATCH_MP lem012 lem011)) ) let DIFF_ADD_CONST_COMMUTE = prove( `!f a l x . (f diffl l) (x + a) ==> ((\x. f (x + a)) diffl l) x`, let lem01 = CONJ (SPEC_ALL DIFF_X) (SPECL [`a:real`;`x:real`] DIFF_CONST) in let lem02 = BETA_RULE (MATCH_MP DIFF_ADD lem01) in let lem03 = ONCE_REWRITE_RULE [REAL_ARITH `&1 + &0 = &1`] lem02 in let lem04 = SPECL [`f:real->real`;`\(x:real).((x + a)):real`;`l:real`;`&1`] DIFF_CHAIN in let MUL_ONE = REAL_ARITH `! x.(&1) * x = x /\ x * (&1) = x` in let lem05 = ONCE_REWRITE_RULE [MUL_ONE] (BETA_RULE lem04) in let lem06 = GEN_ALL (SIMP_RULE [lem03] lem05) in ACCEPT_TAC lem06 ) let POLY_DIFF_ADD_CONST_COMMUTE = prove( `! p1 p2 a.(!x.(poly p2 x) = (poly p1 (x-a))) ==> (!x . ((poly (poly_diff p2) x) = (poly (poly_diff p1) (x-a))))`, let lem01 = SPECL [`\x.poly p1 x`;`-- a:real`;`l:real`;`x:real`] DIFF_ADD_CONST_COMMUTE in let lem02 = ONCE_REWRITE_RULE [REAL_ARITH `w + --v = w - v`] (BETA_RULE lem01) in let lem03 = SPECL [`p1:(real)list`;`(x:real) -a`] POLY_DIFF in let lem04 = MATCH_MP lem02 lem03 in let lem05 = ASSUME `!x.poly p2 x = poly p1 (x - a)` in let lem06 = ONCE_REWRITE_RULE [GSYM lem05] lem04 in let lem07 = SPECL [`p2:(real)list`;`x:real`] POLY_DIFF in let lem08 = MATCH_MP DIFF_UNIQ (CONJ lem07 lem06) in (REPEAT STRIP_TAC) THEN (ACCEPT_TAC lem08) ) let HARD_WON = prove( `! p1 p2 a n.(!x.(poly p2 x) = (poly p1 (x-a))) ==> ((\x.poly (poly_diff_iter p2 n) x) = (\x.(poly (poly_diff_iter p1 n) (x - a)))) `, let lem = SPECL [`poly_diff_iter p1 n`;`poly_diff_iter p2 n`;`a:real`] POLY_DIFF_ADD_CONST_COMMUTE in let tm = `(!x . poly p2 x = poly p1 (x -a )) ==> (\x.poly (poly_diff_iter p2 n) x) = (\x. poly (poly_diff_iter p1 n) (x - a))` in (STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC ) THEN (INDUCT_TAC) THENL [ SIMP_TAC [Pm_lemma1.PDI_DEF] ; STRIP_TAC THEN (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN (UNDISCH_TAC tm) THEN (ASM_REWRITE_TAC[FUN_EQ_THM]) THEN (ACCEPT_TAC lem) ] ) (* if f:real->real is a function, let us call the function g x = f (x+a), * where a is a constant, a "shifting" of f by a. if f is defined by a poly, * i.e. a (real)list, then (poly_shift f a) is the (real)list defining * the shifting of f by a. *) let POLY_SHIFT_DEF = new_recursive_definition list_RECURSION ` (poly_shift [] a = []) /\ (poly_shift (CONS c t) a = (CONS c (poly_shift t a)) ++ (a ## (poly_shift t a)))` (* POLY_SHIFT simply says that poly_shift does what is supposed to do *) let POLY_SHIFT = prove( `! p a x .(poly p (x + a)) = (poly (poly_shift p a) x)`, let lem01 = ASSUME `! a x . poly t (x + a) = poly (poly_shift t a ) x` in LIST_INDUCT_TAC THENL [ (ONCE_REWRITE_TAC [POLY_SHIFT_DEF;poly]) THEN (SIMP_TAC [poly]); (REPEAT STRIP_TAC) THEN (ONCE_REWRITE_TAC [POLY_SHIFT_DEF]) THEN (ONCE_REWRITE_TAC [POLY_ADD]) THEN (ONCE_REWRITE_TAC [POLY_CMUL]) THEN (ONCE_REWRITE_TAC [poly;GSYM lem01]) THEN (ONCE_REWRITE_TAC [GSYM lem01]) THEN (REAL_ARITH_TAC) ] ) let POLY_SHIFT_LENGTH = prove( `! p a . (LENGTH (poly_shift p a)) = (LENGTH p)`, (LIST_INDUCT_TAC) THENL [ (SIMP_TAC [POLY_SHIFT_DEF]); (SIMP_TAC [POLY_SHIFT_DEF]) THEN (ASM_SIMP_TAC [LENGTH;POLY_CMUL_LENGTH;POLY_ADD_LENGTH; ARITH_RULE `MAX (x:num) y = if (x > y) then x else y`; ARITH_RULE `! n. SUC n >n`]) ] ) let POLY_TAYLOR = prove( `! p x a. poly p x = psum (0,LENGTH p) (\m.poly (poly_diff_iter p m) a/ &(FACT m) * (x - a) pow m)`, let lem01 = SPEC `poly_shift p a` POLY_MCLAURIN in let lem02 = SPECL [`p:(real)list`;`poly_shift p a`;`-- a:real`;`n:num`] HARD_WON in let lem03 = GSYM ( SPECL [`p:(real)list`;`a:real`] POLY_SHIFT) in let lem04 = SIMP_RULE [REAL_ARITH `a - --b = a + b`] lem02 in let lem05 = ONCE_REWRITE_RULE [ETA_AX] (MP lem04 lem03) in let lem06 = BETA_RULE (ONCE_REWRITE_RULE [lem05] lem01) in let lem07 = ONCE_REWRITE_RULE [REAL_ARITH `&0 + a = a`] lem06 in let lem08 = ONCE_REWRITE_RULE [GSYM POLY_SHIFT] lem07 in let lem09 = ONCE_REWRITE_RULE [POLY_SHIFT_LENGTH] lem08 in let lem10 = RATOR_CONV (ONCE_REWRITE_CONV [REAL_ARITH `(x:real) = (x + a) - a`]) `x pow m` in let lem11 = ONCE_REWRITE_RULE [lem10] lem09 in let lem12 = SPEC `(x - a):real` lem11 in let lem13 = ONCE_REWRITE_RULE [REAL_ARITH `(x:real) - a + a = x`] lem12 in ACCEPT_TAC (GEN_ALL lem13 ) ) let PLANETMATH_LEMMA_2_A = prove( `! p a x . poly p x = ((\s .psum (0,LENGTH p) ((\m.poly (poly_diff_iter p m) a/ &(FACT m) * (s m)))) (\m.(x - a) pow m))`, BETA_TAC THEN (MATCH_ACCEPT_TAC POLY_TAYLOR) ) let ITERATE_SUC_REC = prove( `!(op:D -> D -> D) m n (f:num -> D) . monoidal op ==> (m <= SUC n) ==> iterate op (m..(SUC n)) f = op (f (SUC n)) (iterate op (m..n) f)`, let lem0 = UNDISCH_ALL (SPEC_ALL (GSYM NUMSEG_REC)) in let lem1 = ISPEC `op:D -> D -> D` ITERATE_CLAUSES_GEN in let lem2 = CONJUNCT2 (UNDISCH lem1) in let lem3 = ISPECL [`f:(num -> D)`;`SUC n`;`m..n`] lem2 in let lem4 = SIMP_RULE [] (DISCH_ALL lem3) in let lem50 = prove( `!m n. ~((SUC n) IN (m..n))`, STRIP_TAC THEN (ONCE_REWRITE_TAC [IN_NUMSEG]) THEN ARITH_TAC) in let lem5 = SIMP_RULE [lem50;FINITE_SUPPORT;FINITE_NUMSEG] lem4 in let lem6 = ADD_ASSUM `m <= SUC n` lem5 in let lem7 = ONCE_REWRITE_RULE [lem0] lem6 in SIMP_TAC [lem7] );; let ITERATE_POLY_ADD_PRE_REC = prove( `!f n . n > 0 ==> iterate (++) (0..n) f = (f n) ++ (iterate (++) (0..n-1) f)`, MESON_TAC [ITERATE_CLAUSES_NUMSEG; MONOIDAL_POLY_ADD; POLY_ADD_SYM; ARITH_RULE `0 <= x`; ARITH_RULE `n > 0 ==> n = SUC (n - 1)`] );; let PSUM_ITERATE = prove( `! n m f. psum (m,n) f = if (n > 0) then (iterate (+) (m..((n+m)-1)) f) else &0`, let lem01 = ARITH_RULE `~(n+m=0) ==> (SUC n + m) -1 = SUC ((n + m) -1)` in let lem02 = MP (ISPEC `(+)` ITERATE_SING) MONOIDAL_REAL_ADD in let lem03 = prove( `iterate (+) (m..SUC ((n + m) - 1)) f = f (SUC ((n+m)-1)) + iterate (+) (m..(n+m)-1) f`, MESON_TAC [ARITH_RULE `m <= SUC ((n+m)-1)`;ITERATE_CLAUSES_NUMSEG; MONOIDAL_REAL_ADD;REAL_ADD_SYM]) in let lem04 = UNDISCH (UNDISCH (ARITH_RULE `~(n+m=0) ==> n=0 ==> m-1 < m`)) in let lem05 = SIMP_RULE [lem04] (SPECL [`m:num`;`m-1`] NUMSEG_EMPTY) in INDUCT_TAC THENL [ SIMP_TAC [ARITH_RULE `~(0 > 0)`;sum_DEF]; (SIMP_TAC [ARITH_RULE `(SUC n) > 0`]) THEN (REPEAT STRIP_TAC) THEN (ASM_CASES_TAC `n + m =0`) THENL [ (REWRITE_TAC [UNDISCH (ARITH_RULE `n + m = 0 ==> n = 0`)]) THEN (REWRITE_TAC [lem02;NUMSEG_SING;ARITH_RULE `(SUC 0 +m) -1 = m`]) THEN (MESON_TAC [sum_DEF; ADD_CLAUSES;REAL_ARITH `&0 + x = x`]) ; (ONCE_REWRITE_TAC [sum_DEF;UNDISCH lem01]) THEN (REWRITE_TAC [lem03]) THEN (ASM_CASES_TAC `n = 0`) THEN (ASM_SIMP_TAC [ARITH_RULE `~(0 > 0)`;ADD_CLAUSES;REAL_ADD_LID;REAL_ADD_RID; lem05;ITERATE_CLAUSES_GEN; MONOIDAL_REAL_ADD;NEUTRAL_REAL_ADD; REAL_ADD_SYM;ADD_SYM;ARITH_RULE `~(n=0) ==> n>0 /\ SUC (n-1) = n`]) ] ] );; let FACT_DIV_RCANCELS = prove( `!n x. x / &(FACT n) * &(FACT n) = x`, MESON_TAC [REAL_ARITH `!x. &0 < x ==> ~(x = &0)`; REAL_DIV_RMUL;FACT_LT;REAL_OF_NUM_LT] ) let PLANETMATH_LEMMA_2_B = prove( `! p (x:real) a . poly (SOD p) a = ((\s .psum (0,LENGTH p) ((\m.poly (poly_diff_iter p m) a/ &(FACT m) * (s m)))) (\m. &(FACT m)))`, let lem6 = ISPECL [`(\i.poly_diff_iter p i)`;`LENGTH (p:(real)list)`] ITERATE_POLY_ADD_PRE_REC in let lem7 = UNDISCH lem6 in let lem8 = UNDISCH (ARITH_RULE `~(LENGTH (p:(real)list) > 0) ==> (LENGTH p = 0)`) in let lem9 = ONCE_REWRITE_RULE [LENGTH_EQ_NIL] lem8 in BETA_TAC THEN (REPEAT STRIP_TAC) THEN (ONCE_REWRITE_TAC [FACT_DIV_RCANCELS]) THEN (ONCE_REWRITE_TAC [PSUM_ITERATE]) THEN (ASM_CASES_TAC `LENGTH (p:(real)list) > 0`) THENL [ (ASM_SIMP_TAC [Pm_lemma1.SOD;Pm_lemma1.SODN;ITERATE_RADD_POLYADD;ARITH_RULE `x + 0 = x`]) THEN (AP_THM_TAC) THEN (AP_TERM_TAC) THEN (SIMP_TAC [lem7;Pm_lemma1.PDI_LENGTH_NIL;POLY_ADD_CLAUSES]); (ASM_SIMP_TAC []) THEN (SIMP_TAC [lem9;poly;Pm_lemma1.SOD;Pm_lemma1.SODN;NUMSEG_SING;MONOIDAL_POLY_ADD;ITERATE_SING;LENGTH;Pm_lemma1.PDI_DEF]) ] ) end;; module Pm_eqn4 = struct let N_IS_INT = prove( `!n . integer (&n)`, MESON_TAC [is_int] ) let NEG_N_IS_INT = prove( `!n . integer (--(&n))`, MESON_TAC [is_int] );; let PLANETMATH_EQN_3 = prove( `!f. 0 < nu ==> poly (SOD f) (&0) * exp (&nu) = poly (SOD f) (&nu) + &nu * exp (&nu - xi (&nu) f) * poly f (xi (&nu) f)`, let RW = SPECL [`0`;`nu:num`] REAL_OF_NUM_LT in ACCEPT_TAC (ONCE_REWRITE_RULE [RW] (SPEC `(&nu):real` Pm_lemma1.PLANETMATH_LEMMA_1)) ) (* the RHS of PLANETMATH_EQN_4 * TBD: mentioned in paper *) let LHS = new_definition `LHS c f = sum (0..(PRE (LENGTH c))) (\i.(EL i c)*(poly (SOD f) (&i)))` (* the LHS of PLANETMATH_EQN_4 * TBD: mentioned in paper *) let RHS = new_definition `RHS c f = -- sum (1..(PRE (LENGTH c)) ) (\i. (&i) * (EL i c) * (exp ((&i) - (xi (&i) f))) * (poly f (xi (&i) f)) )` let E_POW_N = prove( `!n.(exp (real_of_num 1)) pow n = exp(&n)`, SIMP_TAC [GSYM REAL_EXP_N;REAL_MUL_RID]) (* The proof was originally done with a slightly different transcendental * predicate than found in Harrison's 100/liouville.ml it turns out the difference * is that &0 satisfies my transcendental! Thankfully, it is easy to show that * e != 0, and hence the two notions of transcendence are equivalent for e. * So that I could eliminate even brining my muddled definition of * transcendental into the proof, this file ultimately proves * E_TRANSCENDENTAL_EQUIV, which allows the main proof to only mention * Harrison's transcendental predicate. *) let NO_CONST_TERM_POLY_ROOT = prove( `!p . (~(x = &0) /\ ((HD p) = &0) /\ (poly p x = &0) /\ ~(p = [])) ==> ((poly (TL p) x) = &0)`, LIST_INDUCT_TAC THEN (ASM_SIMP_TAC [HD;TL;NOT_CONS_NIL;poly]) THEN (MESON_TAC [REAL_ARITH `((&0):real) + x = x`;REAL_ENTIRE]) ) let NEGATED_POLY_ROOT = prove( `!p . (poly p x = &0) ==> (poly ((-- &1) ## p) x = &0)`, MESON_TAC [POLY_CMUL;REAL_ARITH `(-- &1) * ((&0):real) = &0`] ) (* changes a polynomial p to p/x^k, where k is the lowest power * of x where p has a non-zero coefficient. This amounts to * just stripping off all leading zeros from the head of the list p. *) let POLY_NUKE = new_recursive_definition list_RECURSION ` (poly_nuk [] = []) /\ (poly_nuk (CONS (c:real) t) = (if (c = &0) then (poly_nuk t) else (CONS c t)))` let POLY_NUKE_ROOT = prove( `!p . ((~(x = &0)) /\ (poly p x = &0)) ==> (poly (poly_nuk p) x = &0)`, LIST_INDUCT_TAC THENL [ SIMP_TAC[POLY_NUKE]; (ASM_CASES_TAC `(h:real) = &0`) THEN (ASM_MESON_TAC [HD;TL;POLY_NUKE;NOT_CONS_NIL;NO_CONST_TERM_POLY_ROOT]) ] ) let POLY_NUKE_ZERO = prove( `!p . (poly p = poly []) <=> (poly (poly_nuk p) = poly [])`, LIST_INDUCT_TAC THEN (ASM_MESON_TAC [POLY_ZERO;ALL;POLY_NUKE]) ) let POLY_CONST_NO_ROOTS = prove( `! c. ~(poly [c] = poly []) ==> ~(poly [c] x = &0)`, (MESON_TAC [poly;REAL_ENTIRE;POLY_ZERO;ALL; REAL_ARITH `(x:real) + &0 = x`; REAL_ARITH `(x:real) * &0 = &0`]) ) let LENGTH_1 = prove( `! lst . (LENGTH lst = 1) <=> (? x. lst = [x])`, LIST_INDUCT_TAC THEN (MESON_TAC [LENGTH;ARITH_RULE `SUC x = 1 <=> x = 0`;NOT_CONS_NIL;LENGTH_EQ_NIL]) ) let SOUP_LEMMA = prove( `!p . ~(x = &0) /\ ~(poly p = poly []) /\ (poly p x = &0) ==> LENGTH (poly_nuk p) > 1`, let l0 = ARITH_RULE `(~(n = 0) /\ ~(n = 1)) <=> n > 1` in let l1 = UNDISCH (UNDISCH (BRW1 (SPEC_ALL POLY_NUKE_ROOT))) in (ONCE_REWRITE_TAC [GSYM l0]) THEN (REPEAT STRIP_TAC) THENL [ (ASM_MESON_TAC [LENGTH;LENGTH_EQ_NIL;POLY_NUKE_ZERO]); (ASM_MESON_TAC [l1;POLY_CONST_NO_ROOTS;LENGTH_1;LENGTH;POLY_NUKE_ZERO]) ] ) let POLY_NUKE_HD_NONZERO = prove( `!p . ~(poly p = poly []) ==> ~((HD (poly_nuk p)) = &0)`, LIST_INDUCT_TAC THEN (ASM_CASES_TAC `(h:real) = &0`) THEN (ASM_SIMP_TAC [HD;POLY_ZERO;ALL;POLY_NUKE]) ) let IS_INT_POLY_NUKE = prove( `!p . (ALL integer p) ==> (ALL integer (poly_nuk p))`, LIST_INDUCT_TAC THEN (ASM_MESON_TAC [ALL;POLY_NUKE;N_IS_INT]) ) let POLY_X_NOT_POLY_NIL = prove( `~(poly [&0;&1] = poly [])`, (SIMP_TAC [FUN_EQ_THM;POLY_X;poly;prove(`(~ ! x .P x) <=> (? x. ~ P x)`,MESON_TAC[])] ) THEN (EXISTS_TAC `real_of_num 1`) THEN (REAL_ARITH_TAC) ) let NOT_TRANSCENDENTAL_ZERO = prove( `~ (transcendental (&0))`, (REWRITE_TAC [transcendental;algebraic]) THEN (EXISTS_TAC `[&0 ; &1]:(real)list`) THEN (MESON_TAC [POLY_X;POLY_X_NOT_POLY_NIL;ALL;N_IS_INT]) ) let ALL_IS_INT_POLY_CMUL = prove( `! p c. (integer c) /\ (ALL integer p) ==> (ALL integer (c ## p))`, (LIST_INDUCT_TAC) THEN (ASM_SIMP_TAC [poly_cmul;ALL;INTEGER_MUL]) ) (* * Harrison's transcendental predicate from 100/liouville.ml is equivalent * to my predicate conjoined with x != 0. *) let TRANSCENDENTAL_MY_TRANSCENDENTAL = prove( `!x. transcendental x <=> (~(x = &0) /\ ~ ? c. (ALL integer c) /\ ((LENGTH c) > 1) /\ ((poly c x) = &0) /\ (HD c) > &0 )`, let contra_pos = TAUT `(~X ==> ~Y /\ ~Z) <=> ((Y \/ Z) ==> X)` in let contra_pos2 = TAUT `((~X /\ ~Y) ==> ~Z) <=> (Z ==> ~X ==> Y)` in let l0 = prove(`!c . LENGTH c > 1 ==> HD c > &0 ==> ~(poly c = poly [])`, LIST_INDUCT_TAC THEN (ASM_MESON_TAC [LENGTH_EQ_NIL;ARITH_RULE `n > 1 ==> ~(n = 0)`; REAL_ARITH `(x:real) > &0 ==> ~(x = &0)`; HD;ALL;POLY_ZERO])) in let witness = `if ((&0) <= (HD (poly_nuk p))) then (poly_nuk p) else ((-- &1) ## (poly_nuk p))` in let l2 = REAL_ARITH `!(x:real). (&0 <= x) /\ ~(x = &0) ==> x > &0` in let l3 = prove( `! c p. LENGTH (c ## p) = LENGTH p`, STRIP_TAC THEN LIST_INDUCT_TAC THEN (ASM_SIMP_TAC [poly_cmul;LENGTH])) in let POLY_CMUL_HD = prove( `! x p . (~(p = [])) ==> HD (x ## p) = x * (HD p)`, STRIP_TAC THEN LIST_INDUCT_TAC THEN (SIMP_TAC [NOT_CONS_NIL;poly_cmul;HD]) ) in (REWRITE_TAC [transcendental;algebraic]) THEN (STRIP_TAC THEN EQ_TAC) THENL [ (ONCE_REWRITE_TAC [contra_pos]) THEN STRIP_TAC THENL [ASM_MESON_TAC [transcendental;algebraic; NOT_TRANSCENDENTAL_ZERO]; (EXISTS_TAC `c:(real)list`) THEN (ASM_MESON_TAC [l0; NOT_TRANSCENDENTAL_ZERO ])]; (REWRITE_TAC [contra_pos2]) THEN (STRIP_TAC THEN STRIP_TAC) THEN (ASM_SIMP_TAC [IS_INT_POLY_NUKE]) THEN (EXISTS_TAC witness) THEN (ASM_CASES_TAC `((&0) <= (HD (poly_nuk p)))`) THEN (ASM_MESON_TAC [ IS_INT_POLY_NUKE;ALL_IS_INT_POLY_CMUL;NEG_N_IS_INT; l2;POLY_NUKE_HD_NONZERO;NEGATED_POLY_ROOT;SOUP_LEMMA; l3;POLY_NUKE_ROOT;POLY_NUKE_ZERO;POLY_CMUL_HD; REAL_ARITH `~(&0 <= (x:real)) <=> ((-- &1) * x) > &0`]) ] ) let E_TRANSCENDENTAL_EQUIV = prove( `(transcendental (exp (&1))) <=> (~ ? c. (ALL integer c) /\ ((LENGTH c) > 1) /\ ((poly c (exp (&1))) = &0) /\ (HD c) > &0 )`, MESON_TAC[TRANSCENDENTAL_MY_TRANSCENDENTAL; REAL_EXP_POS_LT; REAL_ARITH `&0 < (x:real) ==> ~(&0 = x)`] ) (* TBD mentionedin paper *) let PLANETMATH_EQN_4 = prove( `(~ (transcendental (exp (&1)))) ==> ? c . ((ALL integer c) /\ ((LENGTH c) > 1) /\ ((EL 0 c) > &0) /\ (! f .((LHS c f) = (RHS c f))))`, let foo2 = prove( `(HD c) > (real_of_num 0) ==> EL 0 c > &0`,SIMP_TAC [EL]) in let lem01 = SPECL [`f:num->real`;`0`;`0`;`PRE (LENGTH (c:(real)list))`] SUM_COMBINE_R in let lem02 = ARITH_RULE `(0 <= 0 + 1 /\ 0 <= (PRE (LENGTH (c:(real)list))))` in let lem03 = GSYM (MP lem01 (lem02) ) in let lem06 = ISPECL [`f1:num->real`; `f2:num->real`; `1`;`(PRE (LENGTH (c:(real)list)))`] SUM_ADD in let new0 = SPECL [`f:num->real`;`1`;`PRE (LENGTH (c:(real)list))`] PSUM_SUM_NUMSEG in let new1 = SIMP_RULE [ARITH_RULE `~(1 = 0)`;ARITH_RULE `(1 + x) -1 = x`] new0 in let new2 = ONCE_REWRITE_RULE [new1] lem06 in let lem001 = REAL_ARITH `((A:real) * B * C * D + B * E) = (B * (A * C * D + E))` in let lem0 = REAL_ARITH `(x:real) = x * (&1) - (&0) * y` in let lem1 = GEN_ALL (ONCE_REWRITE_RULE [GSYM REAL_EXP_0] lem0) in let lem2 = SPECL [`poly (SOD f) (&0)`; ` exp (&0 - xi (&0) f) * poly f (xi (&0) f)`] lem1 in let PLANETMATH_EQN_3_TWEAKED = REWRITE_RULE [REAL_ARITH `((A:real) = B+C) <=> (B = A -C)`] PLANETMATH_EQN_3 in let lem21 = GEN `nu:num` (SPEC_ALL PLANETMATH_EQN_3_TWEAKED) in let lem3 = CONJ lem21 lem2 in let NUM_CASES_LEMMA = prove( ` !P .((! n .(0 < n) ==> (P n)) /\ (P 0) ==> ! n . P n)`, (REPEAT STRIP_TAC) THEN (SPEC_TAC (`n:num`,`n:num`)) THEN INDUCT_TAC THEN (ASM_SIMP_TAC[]) THEN (ASM_SIMP_TAC [ARITH_RULE `0 < (SUC n)`])) in let lem4 = SPEC `(\nu.poly (SOD f) (&nu) = poly (SOD f) (&0) * exp (&nu) - &nu * (exp ((&nu) - xi (&nu) f)) * poly f (xi (&nu) f))` NUM_CASES_LEMMA in let lem5 = BETA_RULE lem4 in let lem6 = MP lem5 lem3 in let lem100 = SIMP_RULE [ARITH_RULE `!n.0 <= n`;ARITH_RULE `(0:num) + 1 = 1`] (ISPECL [`f:num->real`;`0`;`0`;`PRE (LENGTH (c:(real)list))`] SUM_COMBINE_R) in let lem0001 = ASSUME `LENGTH (c:(real)list) > 1` in let lem0002 = MATCH_MP (ARITH_RULE `(x:num) > 1 ==> ~(x=0)`) lem0001 in let lem0003 = REWRITE_RULE [LENGTH_EQ_NIL] lem0002 in let lem0004 = MATCH_MP POLY_SUM_EQUIV lem0003 in let SUM_LMUL_NUMSEG = GEN_ALL (ISPECL [`f:num->real`;`c:real`;`n..m`] SUM_LMUL) in (ONCE_REWRITE_TAC [E_TRANSCENDENTAL_EQUIV]) THEN (ONCE_REWRITE_TAC [LHS;RHS]) THEN (REPEAT STRIP_TAC) THEN (EXISTS_TAC `c:(real)list`) THEN (ONCE_REWRITE_TAC [GSYM REAL_RNEG_UNIQ]) THEN (ONCE_REWRITE_TAC [lem03]) THEN (ONCE_REWRITE_TAC [NUMSEG_CONV `0..0`]) THEN (ONCE_REWRITE_TAC [SUM_SING] ) THEN (ASM_SIMP_TAC[foo2]) THEN (BETA_TAC) THEN (ONCE_REWRITE_TAC [ARITH_RULE `0 + 1 = 1`] ) THEN (ONCE_REWRITE_TAC [REAL_ARITH `(A:real) + B + C = (A + C) + B`] ) THEN (ONCE_REWRITE_TAC [GSYM new2]) THEN (BETA_TAC) THEN (ONCE_REWRITE_TAC [lem001]) THEN (CONV_TAC ((RAND_CONV o ABS_CONV o RATOR_CONV o RAND_CONV o RATOR_CONV) (PURE_ONCE_REWRITE_CONV [lem6]))) THEN (ONCE_REWRITE_TAC [REAL_ARITH `(A:real) + B - A = B`]) THEN (ONCE_REWRITE_TAC [REAL_ARITH `(EL 0 c) * (poly (SOD f) (&0)) = (EL 0 c) * (poly (SOD f) (&0)) * (&1)`]) THEN (ONCE_REWRITE_TAC [GSYM REAL_EXP_0]) THEN (ONCE_REWRITE_TAC [GSYM (BETA_CONV `(\x.(EL x c) * (poly (SOD f) (&0)) * exp (&x)) (0)`)]) THEN (ONCE_REWRITE_TAC [GSYM (ISPEC `\x.(EL x c) * (poly (SOD f) (&0)) * exp (&x)` SUM_SING)]) THEN (ONCE_REWRITE_TAC [GSYM (NUMSEG_CONV `0..0`)]) THEN (ONCE_REWRITE_TAC [REAL_ADD_AC]) THEN (ONCE_REWRITE_TAC [lem100]) THEN (ONCE_REWRITE_TAC [REAL_ARITH `(A:real) * B * C = B * A * C`]) THEN (ONCE_REWRITE_TAC [ SUM_LMUL_NUMSEG ]) THEN (ONCE_REWRITE_TAC [GSYM E_POW_N]) THEN (ONCE_REWRITE_TAC [GSYM lem0004]) THEN (ASM_SIMP_TAC[]) THEN (REAL_ARITH_TAC) ) end;; module Pm_eqn5 = struct let POLY_MUL_ITER = new_recursive_definition num_RECURSION `(poly_mul_iter f 0 = [&1]) /\ (!n . poly_mul_iter f (SUC n) = (f (SUC n)) ** (poly_mul_iter f n))` let PLANETMATH_EQN_5 = new_definition `g n p = (&1/(&(FACT (p -1)))) ## ((poly_exp [&0;&1] (p-1)) ** (poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p))` end;; module Pm_eqn4_rhs = struct let ABS_LE_MUL2 = prove( `!(w:real) x y z. abs(w) <= y /\ abs(x) <= z ==> abs(w * x) <= (y * z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[ABS_POS]) let SEPTEMBER_2009_LEMMA = prove( `!x f n n'. (!i.(0 <= i /\ i <= n) ==> (abs (poly (f i) x)) <= &(n')) ==> (abs (poly (poly_mul_iter f n) x)) <= (&(n') pow n)`, let lem0 = ASSUME `!i. 0 <= i /\ i <= SUC n ==> abs (poly (f i) x) <= &n'` in let lem1 = SPEC `SUC n` lem0 in let lem2 = SIMP_RULE [ARITH_RULE `0 <= SUC n /\ SUC n <= SUC n`] lem1 in let lem3 = prove(`(!i:num.(P0 i) ==> (P1 i)) ==> (!i:num.((P1 i) ==> (Q i))) ==> (!i:num.((P0 i) ==> (Q i)))`, MESON_TAC[]) in let lem4 = ARITH_RULE `!i.(0 <= i /\ i <= n) ==> (0 <= i /\ i <= SUC n)` in let lem5 = GEN `Q:num->bool` (MATCH_MP lem3 lem4) in let lem6 = ASSUME `!n'. (!i. 0 <= i /\ i <= n ==> abs (poly (f i) x) <= &n') ==> abs (poly (poly_mul_iter f n) x) <= &n' pow n` in let lem7 = SPEC `n':num` lem6 in let lem9 = UNDISCH (BETA_RULE (SPEC `\i. abs (poly (f (i:num)) x) <= &n'` lem5)) in let lem11 = MP (lem7) (lem9) in STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [ (REWRITE_TAC ([Pm_eqn5.POLY_MUL_ITER;poly;real_pow]@rewrites0)) THEN (REAL_ARITH_TAC); (STRIP_TAC) THEN (STRIP_TAC) THEN (REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER;POLY_MUL;real_pow]) THEN (MATCH_MP_TAC ABS_LE_MUL2) THEN (SIMP_TAC [lem2;lem11]) ] ) let SEPTEMBER_2009_LEMMA_2 = prove( `&0 < x /\ x < &n ==> (!i. 0 <= i /\ i <= n ==> abs(poly [-- &i; &1] x) <= &n)`, (REWRITE_TAC [GSYM REAL_LE]) THEN (REPEAT STRIP_TAC) THEN (REWRITE_TAC ([poly]@rewrites0)) THEN (REWRITE_TAC [REAL_ARITH `&0 <= -- &i + (x:real) <=> &i <= x`;real_abs]) THEN (ASM_CASES_TAC `&i <= (x:real)`) THENL [ (ASM_SIMP_TAC []) THEN (REWRITE_TAC [REAL_ARITH `-- &i + (x:real) = x - &i `]) THEN (ASM_REAL_ARITH_TAC); (ASM_SIMP_TAC []) THEN (REWRITE_TAC [REAL_ARITH `--(-- &i + (x:real)) = &i - x `]) THEN (ASM_REAL_ARITH_TAC) ] ) let FACT_DIV_LCANCELS = prove( `!n x. &(FACT n) * x / &(FACT n) = x`, let lem0 = SPECL [`0`;`FACT n`] REAL_OF_NUM_LT in let lem1 = ONCE_REWRITE_RULE [GSYM lem0] FACT_LT in let lem2 = SPECL [`x:real`;`(&(FACT n)):real`] REAL_DIV_LMUL in let lem3 = REAL_ARITH `!x:real. &0 < x ==> ~(x = &0)` in let lem4 = MATCH_MP lem3 (SPEC_ALL lem1) in ACCEPT_TAC (GEN_ALL (MP lem2 lem4)) ) let NOVEMBER_LEMMA_1 = prove( `p > 1 ==> &0 < x /\ x < &n ==> (abs(poly (g n p) x)) <= (&1/(&(FACT (p -1)))) * ((&n) pow (p - 1)) * ((&n pow n) pow p)`, let l0 = SPECL [`0`;`FACT (p-1)`] REAL_OF_NUM_LT in let l2 = snd (EQ_IMP_RULE l0) in let l3 = MP l2 (SPEC `(p:num) - 1` FACT_LT) in let l4 = SPEC `(&(FACT (p - 1))):real` REAL_LE_LCANCEL_IMP in let l5 = SIMP_RULE [l3] l4 in let ll0 = snd (EQ_IMP_RULE (SPEC_ALL REAL_ABS_REFL)) in let ll1 = IMP_TRANS (REAL_ARITH `(&0):real < x ==> &0 <= x`) ll0 in let ll2 = UNDISCH ll1 in let asses = [`(p:num) > 1`;`&0 < (x:real)`; `(x:real) < &n`] in let j0 = SPECL [`p - 1`;`x:real`;`(&n):real`] REAL_POW_LE2 in let j1 = REAL_ARITH `(&0) < (x:real) /\ x < (&n) ==> (&0 <=x /\ x <= (&n))` in let j2 = UNDISCH_ALL (BRW1 (IMP_TRANS j1 j0)) in let ll4 = SPECL [`(x:real) pow (p - 1)`;`((&n):real) pow (p - 1)`;`(abs (r:real)) pow p`] REAL_LE_MUL2 in let ll5 = (SPECL [`x:real`;`(p:num) - 1`] REAL_POW_LE) in let ll50 = UNDISCH (IMP_TRANS (REAL_ARITH `&0 < x ==> (&0) <= (x:real)`) ll5;) in let ll6 = ADD_ASSUMS asses ll4 in let ll7 = REAL_ARITH `(x:real) < y ==> x <= y` in let ll8 = SIMP_RULE [j2;ll50;ll7;REAL_POW_LE;REAL_ABS_POS] ll6 in let ll9 = ADD_ASSUM `p > 1` (SPEC `p:num` REAL_POW_LE2) in let ll10 = UNDISCH (ARITH_RULE `p > 1 ==> ~(p = 0)`) in let ll11 = SIMP_RULE [ll10] ll9 in let ll12 = SPEC `abs (r:real)` ll11 in let ll13 = SIMP_RULE [REAL_ABS_POS] ll12 in let lem0 = UNDISCH (UNDISCH (BRW1 SEPTEMBER_2009_LEMMA_2)) in let lem1 = MATCH_MP SEPTEMBER_2009_LEMMA lem0 in let lem2 = DISCH_ALL (DISCH `(&0) < (x:real)` lem1) in let lem3 = SPEC `SUC n` (GEN (`n:num`) lem2) in (STRIP_TAC) THEN (STRIP_TAC) THEN (ONCE_REWRITE_TAC [Pm_eqn5.PLANETMATH_EQN_5]) THEN (ONCE_REWRITE_TAC [POLY_CMUL]) THEN (ONCE_REWRITE_TAC [POLY_MUL]) THEN (ONCE_REWRITE_TAC [POLY_EXP]) THEN (ONCE_REWRITE_TAC [poly]) THEN (ONCE_REWRITE_TAC [poly]) THEN (ONCE_REWRITE_TAC [poly]) THEN (REWRITE_TAC rewrites0) THEN (ONCE_REWRITE_TAC [REAL_ABS_MUL]) THEN (ONCE_REWRITE_TAC [REAL_ABS_MUL]) THEN (ONCE_REWRITE_TAC [REAL_ABS_POW]) THEN (ONCE_REWRITE_TAC [REAL_ABS_DIV]) THEN (ONCE_REWRITE_TAC [ABS_N]) THEN (MATCH_MP_TAC l5) THEN (ONCE_REWRITE_TAC [REAL_MUL_ASSOC]) THEN (SIMP_TAC [FACT_DIV_LCANCELS;REAL_ARITH `&1 * (x:real) = x`]) THEN (SIMP_TAC [ll2]) THEN (MATCH_MP_TAC ll8) THEN (MATCH_MP_TAC ll13) THEN (UNDISCH_TAC `&0 < (x:real)`) THEN (UNDISCH_TAC `(x:real) < &n`) THEN (SPEC_TAC (`n:num`,`n:num`)) THEN INDUCT_TAC THENL [(REAL_ARITH_TAC); (ACCEPT_TAC lem3)] ) let NOVEMBER_LEMMA_2 = prove( ` 1 <= v /\ v <= n ==> ((&0) < ( xi (&v) f) /\ (xi (&v) f) < (&n))`, let l0 = SPECL [`(&v):real`;`f:(real)list`] Pm_lemma1.xi_DEF in let l1 = UNDISCH (ONCE_REWRITE_RULE [REAL_OF_NUM_LT] l0) in let [l2;l3;_] = CONJUNCTS l1 in let l4 = GEN_ALL (REAL_ARITH `(&v) <= y ==> z < (&v) ==> (z:real) < y`) in let l6 = SPECL [`v:num`;`z:real`;`(&n):real`] l4 in let l7 = UNDISCH l6 in (ONCE_REWRITE_TAC [ TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`;ARITH_RULE `1 <= v <=> 0 < v` ]) THEN (ONCE_REWRITE_TAC [GSYM REAL_OF_NUM_LE;GSYM REAL_OF_NUM_LT]) THEN (STRIP_TAC) THEN (STRIP_TAC) THEN (SIMP_TAC [l2]) THEN (MATCH_MP_TAC l7) THEN (ACCEPT_TAC l3) ) let REAL_LE_MUL3 = prove( `! w0 x0 y0 w1 x1 (y1:real). (&0 <= w0) ==> (&0 <= x0) ==> (&0 <= y0) ==> (w0 <= w1) ==> (x0 <= x1) ==> (y0 <= y1) ==> (w0 * x0 * y0) <= (w1 * x1 * y1)`, let lst = [`w0:real`;`w1:real`;`(x0 * y0):real`;`(x1 * y1):real`] in let c0 = SPECL lst REAL_LE_MUL2 in MESON_TAC [c0;REAL_LE_MUL2;REAL_LE_MUL] ) let MAX_ABS_DEF = new_recursive_definition list_RECURSION ` (max_abs [] = &0) /\ (max_abs (CONS h t) = real_max (real_abs h) (max_abs t))` let MAX_ABS_LE = prove( `! cs i. (0 <= i /\ i < (LENGTH cs) ==> (real_abs (EL i cs)) <= (max_abs cs))`, let l0 = UNDISCH (REAL_ARITH `~((abs h) <= max_abs t) ==> x <= (max_abs t) ==> x <= (abs h)`) in LIST_INDUCT_TAC THENL [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; INDUCT_TAC THENL [ (SIMP_TAC [HD;EL;MAX_ABS_DEF;REAL_MAX_MAX]); (SIMP_TAC [TL;EL;MAX_ABS_DEF;REAL_MAX_MAX;LENGTH;LT_SUC]) THEN (ASM_CASES_TAC `(real_abs h) <= (max_abs t)`) THEN (ASM_SIMP_TAC [real_max;ARITH_RULE `0 <= y`;l0]) ] ] ) let KEATS_PART_1 = prove( `1 <= i /\ i <= PRE (LENGTH c) ==> ( &i * abs (EL i c) <= &i * max_abs c)`, let keats12 = ARITH_RULE `1 <= i /\ i <= (PRE (LENGTH (c:(real)list))) ==> (0 <= i /\ i < LENGTH c)` in let keats13 = IMP_TRANS keats12 (SPECL [`c:(real)list`;`i:num`] MAX_ABS_LE) in let keats14 = SPECL [`real_of_num i`] REAL_LE_LMUL in let keats15 = ARITH_RULE `(&0) <= (real_of_num i)` in let keats16 = SIMP_RULE [keats15] keats14 in let keats17 = UNDISCH keats13 in let keats18 = MATCH_MP keats16 keats17 in ACCEPT_TAC (DISCH_ALL keats18) ) let KEATS_PART_2 = prove( `(1 <= v /\ v <= PRE (LENGTH (c:(real)list))) ==> abs (exp ((&v) - xi (&v) (g (PRE (LENGTH c)) p))) <= abs (exp (&(PRE (LENGTH (c:(real)list)))))`, let j0 = ASSUME `1 <= v /\ (v:num) <= (PRE (LENGTH (c:(real)list)))` in let j00 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_LE] (CONJUNCT2 j0) in let j1 = REAL_ARITH `!n .(real_of_num v <= &n) ==> (&0 > --xi (&v) (g n p)) ==> (&n) > (&v) - (xi (&v) (g n p))` in let j2 = MP (SPEC `PRE (LENGTH (c:(real)list))` j1) j00 in let g_term = `g (PRE (LENGTH (c:(real)list))) p` in let k33 = SPEC `PRE (LENGTH (c:(real)list))` (GEN `n:num` NOVEMBER_LEMMA_2) in let k34 = SPEC g_term (GEN `f:(real)list` k33) in let k35 = DISCH `1 <= v /\ v <= (PRE (LENGTH (c:(real)list)))` (CONJUNCT1 (UNDISCH k34)) in let k36 = UNDISCH (SPEC `PRE (LENGTH (c:(real)list))` (GEN `n:num` k35)) in let k37 = REAL_ARITH `!x. (real_of_num 0) < x ==> (real_of_num 0) > -- x` in let k38 = MATCH_MP k37 k36 in let k40 = MP j2 k38 in let k41 = REAL_ARITH `!x (y:real).x > y ==> y <= x` in let k42 = MATCH_MP k41 k40 in let k42 = ONCE_REWRITE_RULE [GSYM REAL_EXP_MONO_LE] k42 in let k43 = REAL_ARITH `!(x:real) . (&0) <= x ==> abs x = x` in let k44 = GEN `x:real` (MATCH_MP k43 (SPEC `x:real` REAL_EXP_POS_LE)) in let k45 = ONCE_REWRITE_RULE [GSYM k44] k42 in let k46 = DISCH_ALL k45 in let k47 = BRW0 (SIMP_RULE [ARITH_RULE `0 < v <=> 1 <= v`] k46) in ACCEPT_TAC k47 ) let KEATS_PART_3 = UNDISCH (prove( `p > 1 ==> (1 <= i /\ i <= PRE (LENGTH (c:(real)list))) ==> abs (poly (g (PRE (LENGTH c)) p) (xi (&i) (g (PRE (LENGTH c)) p))) <= &1 / &(FACT (p - 1)) * &(PRE (LENGTH c)) pow (p - 1) * &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p`, let k0 = UNDISCH NOVEMBER_LEMMA_2 in let k1 = UNDISCH NOVEMBER_LEMMA_1 in let k2 = GEN `x:real` k1 in let k3 = SPEC `xi (real_of_num i) f` k2 in let k5 = MATCH_MP k3 k0 in let g_term = `g (PRE (LENGTH (c:(real)list))) p` in let k6 = SPEC g_term (GEN `f:(real)list` k5) in let k7 = SPEC `PRE (LENGTH (c:(real)list))` (GEN `n:num` (DISCH `1 <= v /\ v <= n` k6)) in let k8 = DISCH `0 < v` k7 in let k9 = BRW0 (SIMP_RULE [ARITH_RULE `0 < v <=> 1 <= v`] k8) in MATCH_ACCEPT_TAC (DISCH_ALL k9) )) let RHS_4_F5_LE_SUM = prove( `abs (RHS c (g (PRE (LENGTH c)) p)) <= sum (1..PRE (LENGTH c)) (\i. &i * abs (EL i c) * abs (exp (&i - xi (&i) (g (PRE (LENGTH c)) p))) * abs (poly (g (PRE (LENGTH c)) p) (xi (&i) (g (PRE (LENGTH c)) p))))`, let keats4 = REFL `abs (RHS c f)` in let keats5 = (CONV_RULE (RAND_CONV (REWRITE_CONV [Pm_eqn4.RHS]))) keats4 in let keats6 = REWRITE_RULE [REAL_ABS_NEG] keats5 in let keats7 = SPECL [`(\i.(&i) * (EL i c) * (exp (&i - (xi (&i) f))) * (poly f (xi (&i) f)))`;`1`;`PRE (LENGTH (c:(real)list))`] SUM_ABS_NUMSEG in let keats8 = ONCE_REWRITE_RULE [GSYM keats6] keats7 in let keats9 = REWRITE_RULE [REAL_ABS_NUM;REAL_ABS_MUL] keats8 in let g_term = `g (PRE (LENGTH (c:(real)list))) p` in let keats10 = SPEC g_term (GEN `f:(real)list` keats9) in ACCEPT_TAC keats10 ) let RHS_4_BOUND_PRE = prove( `abs (RHS c (g (PRE (LENGTH c)) p)) <= (sum (1..PRE (LENGTH c)) &) * (max_abs c * abs (exp (&(PRE (LENGTH c)))) * &1 / &(FACT (p - 1)) * &(PRE (LENGTH c)) pow (p - 1) * &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p)`, let w0 = `(real_of_num i) * (real_abs (EL i c))` in let w1 = `(real_of_num i) * (max_abs c)` in let x0 = `abs (exp (&v - xi (&v) (g (PRE (LENGTH (c:(real)list))) p)))` in let x1 = `abs (exp (&(PRE (LENGTH (c:(real)list)))))` in let y0 = `abs (poly (g (PRE (LENGTH (c:(real)list))) p) (xi (&i) (g (PRE (LENGTH c)) p)))` in let y1 = ` &1 / &(FACT (p - 1)) * &(PRE (LENGTH (c:(real)list))) pow (p - 1) * &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p` in let rename_free_var oo nn tt = SPEC nn (GEN oo tt) in let v2i tt = rename_free_var `v:num` `i:num` tt in let josh0 = SPECL [w0;x0;y0;w1;x1;y1] REAL_LE_MUL3 in let josh2 = SPECL [`real_of_num i`;`real_abs (EL i c)`] REAL_LE_MUL in let josh3 = SIMP_RULE [REAL_ABS_POS;REAL_ARITH `(real_of_num 0) <= &i`] josh2 in let josh4 = v2i (SIMP_RULE [josh3;REAL_ABS_POS] josh0) in let josh5 = SIMP_RULE [UNDISCH KEATS_PART_1] josh4 in let josh6 = SIMP_RULE [UNDISCH (v2i KEATS_PART_2)] josh5 in let josh7 = SIMP_RULE [UNDISCH KEATS_PART_3] josh6 in let josh8 = DISCH `1 <= i /\ i <= (PRE (LENGTH (c:(real)list)))` josh7 in let f0 = `(\i. &i * abs (EL i c) * abs (exp (&i - xi (&i) (g (PRE (LENGTH c)) p))) * abs (poly (g (PRE (LENGTH c)) p) (xi (&i) (g (PRE (LENGTH c)) p))))` in let f1 = `(\i. (&i * max_abs c) * abs (exp (&(PRE (LENGTH c)))) * &1 / &(FACT (p - 1)) * &(PRE (LENGTH c)) pow (p - 1) * &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p)` in let josh9 = SPECL [f0;f1;`1`;`PRE (LENGTH (c:(real)list))`] SUM_LE_NUMSEG in let josh10 = REWRITE_RULE [GSYM REAL_MUL_ASSOC] (BETA_RULE josh9) in let josh11 = REWRITE_RULE [GSYM REAL_MUL_ASSOC] (GEN `i:num` josh8) in let josh12 = MP josh10 josh11 in let josh13 = CONJ RHS_4_F5_LE_SUM josh12 in let josh14 = MATCH_MP REAL_LE_TRANS josh13 in let josh15 = ONCE_REWRITE_RULE [SUM_RMUL] josh14 in ACCEPT_TAC josh15 ) (* A reviewer of the Journal of Formalized Reasoning paper for this proof * pointed out that the "abs" in "abs (exp (&(PRE (LENGTH c))))" of * RHS_4_BOUND_PRE is redundant. So here that theorem is rewritten to * remove that abs. *) let RHS_4_BOUND = let l1 = MATCH_MP (SPEC `&0:real` REAL_LT_IMP_LE) (SPEC `x:real` REAL_EXP_POS_LT) in let l2 = REWRITE_RULE [GSYM REAL_ABS_REFL] l1 in ONCE_REWRITE_RULE [l2] RHS_4_BOUND_PRE ;; let JESSE_POW_LEMMA = prove( `(p:num) > 1 ==> !x.real_pow x p = x * (real_pow x (p-1))`, let c0 = UNDISCH (ARITH_RULE `(p:num) > 1 ==> p = SUC (p - 1) `) in STRIP_TAC THEN STRIP_TAC THEN (CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [c0]))) THEN (SIMP_TAC [real_pow]) ) let JESSE_REAL_ABS_LE = prove( `!(x:real) y.(abs x) <= y ==> (abs x) <= (abs y)`, let int10 = UNDISCH (REAL_ARITH `(real_abs x) <= y ==> y = real_abs y`) in (REPEAT STRIP_TAC) THEN (ASM_SIMP_TAC [GSYM int10]) ) let OLDGERMAN_LEMMA = prove( ` !C2 C e. &0 < e ==> (?N . !n. n >= N ==> abs (C2 * inv (&(FACT n)) * C pow n - &0) < e)`, let w0 = MATCH_MP SUM_SUMMABLE (SPEC `C:real` REAL_EXP_CONVERGES) in let w1 = MATCH_MP SER_ZERO w0 in let w2 = BETA_RULE w1 in let w3 = SPEC `C2:real` SEQ_CONST in let w4 = CONJ w3 w2 in let w5 = BETA_RULE (MATCH_MP SEQ_MUL w4) in let w6 = ONCE_REWRITE_RULE [REAL_ARITH `(C2:real) * (&0) = &0`] w5 in let w7 = ONCE_REWRITE_RULE [SEQ] w6 in let w8 = GEN_ALL (BETA_RULE w7) in (REPEAT STRIP_TAC) THEN (CHOOSE_TAC (UNDISCH (SPEC_ALL w8))) THEN (EXISTS_TAC `SUC N`) THEN (ASM_SIMP_TAC [ARITH_RULE `n' >= SUC n ==> n' >= n`]) ) let RHS_4_LT_ONE_MESSY = prove( `?p0. !p. p > 1 ==> p> p0 ==> abs (RHS c (g (PRE (LENGTH c)) p)) < &1`, let c1 = ONCE_REWRITE_RULE [ UNDISCH JESSE_POW_LEMMA ] RHS_4_BOUND in let c2 = SPECL [`real_pow (&(PRE (LENGTH (c:(real)list)))) (p-1)`] REAL_MUL_SYM in let c3 = ONCE_REWRITE_RULE [ c2] c1 in let c4 = ONCE_REWRITE_RULE [ GSYM REAL_MUL_ASSOC ] c3 in let c5 = ONCE_REWRITE_RULE [ GSYM REAL_POW_MUL ] c4 in let c6 = ONCE_REWRITE_RULE [REAL_MUL_SYM] (CONJUNCT2 real_pow) in let c7 = ONCE_REWRITE_RULE [GSYM c6] c5 in let c8 = REAL_ARITH `!x. (real_of_num 1)/x = inv x` in let c9 = ONCE_REWRITE_RULE [c8] c7 in let c10 = REAL_ARITH `!x y z.(inv x) * y * z = y * inv x * z` in let c11 = ONCE_REWRITE_RULE [c10] c9 in let t0 = `sum (1..PRE (LENGTH c)) & * max_abs c * (exp (&(PRE (LENGTH c)))) * &(PRE (LENGTH c)) pow PRE (LENGTH c)` in let t1 = `real_of_num (PRE (LENGTH (c:(real)list))) pow SUC (PRE (LENGTH c))` in let int0 = SPECL [t0;t1;`real_of_num 1`] OLDGERMAN_LEMMA in let int1 = SIMP_RULE [REAL_ARITH `(real_of_num 0) < &1`] int0 in let int2 = SIMP_RULE [REAL_ARITH `x - (real_of_num 0) = x`] int1 in let t8 = `!n. n >= N ==> abs ((sum (1..PRE (LENGTH c)) & * max_abs c * (exp (&(PRE (LENGTH c)))) * &(PRE (LENGTH c)) pow PRE (LENGTH c)) * inv (&(FACT n)) * &(PRE (LENGTH c)) pow SUC (PRE (LENGTH c)) pow n) < &1` in let int5 = ASSUME t8 in let int50 = REAL_ARITH `((x:real) * y * z * w) * (a * b) = x * y * z * w * a * b` in let int51 = ONCE_REWRITE_RULE [int50] int5 in let int6 = SPEC `p - 1` int51 in let int7 = ARITH_RULE ` (p > N ==> p - 1 >= N)` in let int8 = UNDISCH (IMP_TRANS int7 int6) in let int9 = ARITH_RULE `(x:real) <= y ==> y < (real_of_num 1) ==> x < (&1)` in let int10 = MATCH_MP JESSE_REAL_ABS_LE c11 in let int11 = MATCH_MP int9 int10 in let int12 = MP int11 int8 in (CHOOSE_TAC int2) THEN (EXISTS_TAC `N:num`) THEN (STRIP_TAC) THEN (STRIP_TAC) THEN (ONCE_REWRITE_TAC [ARITH_RULE `p > 0 ==> ((p:num) > N <=> p - 1 >= N)`]) THEN (DISCH_TAC) THEN (MATCH_ACCEPT_TAC int12) ) let LT_ONE = prove( `!c. ?p0. !p. p> p0 ==> abs (RHS c (g (PRE (LENGTH c)) p)) < &1`, STRIP_TAC THEN (CHOOSE_TAC RHS_4_LT_ONE_MESSY) THEN (EXISTS_TAC `SUC p0`) THEN (ASM_MESON_TAC [ARITH_RULE `p > SUC p0 ==> (p > p0 /\ p > 1)`]) ) end;; module Pm_eqn4_lhs = struct let N_IS_INT = prove( `!n . integer (&n)`, MESON_TAC [is_int] ) let NEG_N_IS_INT = prove( `!n . integer (--(&n))`, MESON_TAC [is_int] ) let INT_OF_REAL_ADD = prove( `!x y.(integer x) /\ (integer y) ==> (int_of_real (x + y)) = (int_of_real x) + (int_of_real y)`, SIMP_TAC[integer;int_add;int_rep;N_IS_INT;NEG_N_IS_INT] ) let INT_OF_REAL_MUL = prove( `!x y.(integer x) /\ (integer y) ==> (int_of_real (x * y)) = (int_of_real x) * (int_of_real y)`, SIMP_TAC[is_int;int_mul;int_rep;N_IS_INT;NEG_N_IS_INT] ) let rec INT_OF_REAL_CONV_helper t = let real_op_2_int_op t = if (t = `real_add`) then `int_add` else if (t = `real_sub`) then `int_sub` else if (t = `real_mul`) then `int_mul` else if (t = `real_pow`) then `int_pow` else if (t = `real_neg`) then `int_neg` else t in if (is_var t) then (mk_comb (`int_of_real`,t),[],[t]) else if ((rator t) = `real_of_num`) then (mk_comb (`int_of_real`, t),[t],[]) else if ((rator t) = `real_neg`) then let rand1 = rand t in let (expr1,lst1,lst2) = INT_OF_REAL_CONV_helper rand1 in let lst = lst1 @ [t] in let expr = mk_comb (`int_neg`, expr1) in (expr,lst,lst2) else if ((rator (rator t)) = `real_pow`) then let rand1 = rand (rator t) in let exponent = rand t in let (expr1,lst1,lst2) = INT_OF_REAL_CONV_helper rand1 in let lst = lst1 @ [t] in let expr = mk_comb (mk_comb (`int_pow`,expr1),exponent) in (expr,lst,lst2) else if ( ((rator (rator t)) = `real_add`) || ((rator (rator t)) = `real_mul`) || ((rator (rator t)) = `real_sub`) ) then let int_op = real_op_2_int_op (rator (rator t)) in let rand1 = rand (rator t) in let rand2 = rand t in let (expr1,lst11,lst12) = INT_OF_REAL_CONV_helper rand1 in let (expr2,lst21,lst22) = INT_OF_REAL_CONV_helper rand2 in let lst1 = lst11 @ lst21 @ [t] in let lst2 = lst12 @ lst22 in let expr = mk_comb (mk_comb (int_op,expr1),expr2) in (expr,lst1,lst2) else (t,[],[t]) (* ------------------------------------------------------------------------- *) (* I wrote an initial version of this, but John Harrison proposed this *) (* version which is faster and also requires less theorems. *) (* ------------------------------------------------------------------------- *) let INT_OF_REAL_CONV = let final_tweak = MATCH_MP(MESON[int_tybij] `real_of_int x = y ==> int_of_real y = x`) in fun t -> let (exp,real_sub_terms,is_int_assumpts) = INT_OF_REAL_CONV_helper t in let is_int_assumpts = List.map (fun x -> mk_comb (`integer`,x)) is_int_assumpts in let fexp = rand(concl(PURE_REWRITE_CONV[GSYM int_of_num] exp)) in let rexp = mk_comb(`real_of_int`,fexp) and ths = map (GEN_REWRITE_RULE I [CONJUNCT2 int_tybij] o ASSUME) is_int_assumpts in let th3 = PURE_REWRITE_CONV(ths @ [int_pow_th; int_add_th; int_mul_th; int_sub_th; int_neg_th; int_of_num_th]) rexp in itlist DISCH is_int_assumpts (final_tweak th3) let ALL_IS_INT = prove( `! h t . (ALL integer (CONS h t)) ==> (integer h) /\ (ALL integer t)`, SIMP_TAC [ALL] ) let ALL_IS_INT_POLY_ADD = prove( `! p1 p2 . (ALL integer p1) /\ (ALL integer p2) ==> (ALL integer (p1 ++ p2))`, let lem01 = UNDISCH (SPECL [`h:real`;`t:(real)list`] ALL_IS_INT) in let [lem02;lem03] = CONJUNCTS lem01 in let lem04 = UNDISCH (SPECL [`h':real`;`t':(real)list`] ALL_IS_INT) in let [lem05;lem06] = CONJUNCTS lem04 in let lem07 = CONJ lem02 lem05 in let lem08 = MATCH_MP INTEGER_ADD lem07 in let lem09 = ASSUME `! p2. ALL integer t /\ ALL integer p2 ==> ALL integer (t ++ p2)` in let lem10 = SPEC `t':(real)list` lem09 in let lem11 = CONJ lem03 lem06 in let lem12 = MP lem10 lem11 in LIST_INDUCT_TAC THENL [ (SIMP_TAC [poly_add]); LIST_INDUCT_TAC THENL [ (SIMP_TAC [poly_add]); (SIMP_TAC [poly_add]) THEN (ONCE_REWRITE_TAC [NOT_CONS_NIL]) THEN (SIMP_TAC []) THEN (SIMP_TAC [HD;TL]) THEN (STRIP_TAC) THEN (SIMP_TAC [ALL]) THEN (CONJ_TAC) THENL [(ACCEPT_TAC lem08); (ACCEPT_TAC lem12)] ] ] ) let ALL_IS_INT_POLY_CMUL = prove( `! p c. (integer c) /\ (ALL integer p) ==> (ALL integer (c ## p))`, (LIST_INDUCT_TAC) THEN (ASM_SIMP_TAC [poly_cmul;ALL;INTEGER_MUL]) ) let ALL_IS_INT_POLY_MUL = prove( `! p1 p2 . (ALL integer p1) /\ (ALL integer p2) ==> (ALL integer (p1 ** p2))`, let lem01 = UNDISCH (SPECL [`h:real`;`t:(real)list`] ALL_IS_INT) in let lem02 = UNDISCH (SPECL [`h':real`;`t':(real)list`] ALL_IS_INT) in let [lem03;lem04] = CONJUNCTS lem01 in let [lem05;lem06] = CONJUNCTS lem02 in let lem07 = MATCH_MP INTEGER_MUL (CONJ lem03 lem05) in let lem08 = MATCH_MP ALL_IS_INT_POLY_CMUL (CONJ lem03 lem06) in let lem09 = ASSUME `! p2. ALL integer t /\ ALL integer p2 ==> ALL integer (t ** p2)` in let lem10 = SPEC `(CONS h' t'):(real)list` lem09 in LIST_INDUCT_TAC THENL [ (LIST_INDUCT_TAC THENL [(SIMP_TAC [ALL;poly_mul]);(SIMP_TAC [poly_mul])]); LIST_INDUCT_TAC THENL [ (SIMP_TAC [poly_mul]) THEN ((ASM_CASES_TAC `(t:(real)list) = []`) THENL [ (ASM_SIMP_TAC [ALL;poly_cmul]) THEN (SIMP_TAC [poly_cmul]); (ASM_SIMP_TAC [ALL;poly_cmul;poly_add]) THEN (SIMP_TAC [SPEC `0` N_IS_INT]) ]); (STRIP_TAC) THEN (ONCE_REWRITE_TAC [poly_mul] ) THEN (ASM_CASES_TAC `(t:(real)list) = []`) THENL [ (ASM_SIMP_TAC [ALL;poly_cmul]) THEN STRIP_TAC THENL [(ACCEPT_TAC lem07) ;(ACCEPT_TAC lem08)]; (ASM_SIMP_TAC []) THEN (MATCH_MP_TAC ALL_IS_INT_POLY_ADD) THEN (CONJ_TAC) THENL [ (MATCH_MP_TAC ALL_IS_INT_POLY_CMUL) THEN (CONJ_TAC) THENL [(ACCEPT_TAC lem03) ; (ASM_SIMP_TAC[])]; (SIMP_TAC [ALL]) THEN (CONJ_TAC) THENL [(ACCEPT_TAC (SPEC `0` N_IS_INT)); (ASM_SIMP_TAC [lem04;lem10])] ] ] ] ] ) let NOT_POLY_MUL_ITER_NIL = prove( `! n . ~((poly_mul_iter (\i.[ -- &i; &1]) n) = [])`, let lem02 = SIMP_RULE [NOT_CONS_NIL] (ISPEC `[ -- &(SUC n); &1]` NOT_POLY_MUL_NIL ) in let lem03 = ISPEC `(poly_mul_iter (\i.[ -- &i; &1]) n)` lem02 in let lem04 = UNDISCH lem03 in INDUCT_TAC THENL [ (SIMP_TAC [Pm_eqn5.POLY_MUL_ITER;NOT_CONS_NIL]); (SIMP_TAC [Pm_eqn5.POLY_MUL_ITER;lem04]) ] ) let ALL_IS_INT_POLY_MUL_ITER = prove( `! n. (ALL integer (poly_mul_iter (\i.[-- &i; &1]) n))`, let FOOBAR_LEMMA = prove( `ALL integer [-- &(SUC n); &1]`, (SIMP_TAC [ALL]) THEN (SIMP_TAC [N_IS_INT;NEG_N_IS_INT])) in INDUCT_TAC THENL [ (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN (ONCE_REWRITE_TAC [ALL]) THEN (SIMP_TAC [ALL;N_IS_INT]); (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN (BETA_TAC) THEN (MATCH_MP_TAC ALL_IS_INT_POLY_MUL) THEN (CONJ_TAC) THENL [(ACCEPT_TAC (FOOBAR_LEMMA)); (ASM_SIMP_TAC [])] ] ) let ALL_IS_INT_POLY_EXP = prove( `!n p. (ALL integer p) ==> (ALL integer (poly_exp p n))`, let lem01 = ASSUME `! p. ALL integer p ==> ALL integer (poly_exp p n)` in let lem02 = ASSUME ` ALL integer p` in let lem03 = MP (SPEC_ALL lem01) lem02 in let lem04 = CONJ lem02 lem03 in let lem05 = MATCH_MP ALL_IS_INT_POLY_MUL lem04 in INDUCT_TAC THENL [ (ONCE_REWRITE_TAC [poly_exp]) THEN (ONCE_REWRITE_TAC [ALL]) THEN (ONCE_REWRITE_TAC [ALL]) THEN (SIMP_TAC [SPEC `1` N_IS_INT]); (ONCE_REWRITE_TAC [poly_exp]) THEN (REPEAT STRIP_TAC) THEN (ACCEPT_TAC lem05) ] ) let BLAHBLAH = prove( `! p1 p2. (LENGTH p1 <= LENGTH p2) ==> (&0 ## p1 ++ p2) = p2`, LIST_INDUCT_TAC THENL [ (SIMP_TAC [LENGTH;poly_cmul;poly_add]); LIST_INDUCT_TAC THENL [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; (ASM_SIMP_TAC [poly_cmul;poly_add;NOT_CONS_NIL;HD;TL; REAL_ARITH `&0 * h + h' = h'`;LENGTH; ARITH_RULE `(SUC x) <= (SUC y) <=> x <= y`]) ] ] ) let BLAHBLAH3 = prove( `! n h t. (LENGTH t) <= LENGTH (poly_exp [&0;&1] n ** CONS h t)`, let lem04 = ASSUME `! h t . LENGTH t <= LENGTH (poly_exp [&0;&1] n ** CONS h t)` in let lem05 = SPECL [`h:real`;`t:(real)list`] lem04 in let lem06 = ARITH_RULE `!(x:num) y . x <= y ==> x <= SUC y` in let lem07 = MATCH_MP lem06 lem05 in let lem08 = GEN_ALL lem07 in INDUCT_TAC THENL [ (SIMP_TAC [poly_exp;poly_mul;poly_cmul;POLY_CMUL_LID;LENGTH]) THEN ARITH_TAC; (SIMP_TAC [POLY_EXP_X_REC;poly_mul;NOT_POLY_EXP_X_NIL;poly_cmul;poly_add;NOT_CONS_NIL;LENGTH;TL]) THEN (ASM_SIMP_TAC [BLAHBLAH]) THEN (ACCEPT_TAC lem08) ] ) let TELEVISION = prove ( `!n p.(~ (p = [])) ==> EL n (poly_exp [&0;&1] n ** p) = HD p`, let lem = MATCH_MP BLAHBLAH (SPEC_ALL BLAHBLAH3) in INDUCT_TAC THENL [ (SIMP_TAC [EL;poly_exp;POLY_MUL_CLAUSES]) THEN (LIST_INDUCT_TAC) THENL [ (SIMP_TAC[]); (SIMP_TAC [NOT_CONS_NIL;POLY_CMUL_LID])]; (SIMP_TAC [EL;POLY_EXP_X_REC;poly_mul;NOT_POLY_EXP_X_NIL]) THEN LIST_INDUCT_TAC THENL [ (SIMP_TAC []); (SIMP_TAC [poly_cmul;poly_add;NOT_CONS_NIL;TL;HD]) THEN (ASM_SIMP_TAC [lem;NOT_CONS_NIL;HD]) ] ] ) let JOSHUA = prove( `!i n p.(~ (p = [])) /\ (i < n) ==> EL i (poly_exp [&0;&1] n ** p) = &0`, let lem0000 = SPECL [`t:(real)list`;`poly_exp [&0;&1] n ** (CONS h t)`] BLAHBLAH in let lem0001 = MATCH_MP lem0000 (SPEC_ALL BLAHBLAH3) in let lem0002 = ASSUME `! n p . ~(p = []) /\ i < n ==> EL i (poly_exp [&0;&1] n ** p) = &0` in let lem0003 = SIMP_RULE [NOT_CONS_NIL] (SPECL [`n:num`;`(CONS (h:real) t)`] lem0002) in INDUCT_TAC THENL [ INDUCT_TAC THENL [ ARITH_TAC ; LIST_INDUCT_TAC THENL [ (SIMP_TAC[]); (SIMP_TAC [POLY_EXP_X_REC;EL;HD;poly_mul;NOT_POLY_EXP_NIL;NOT_CONS_NIL;HD_POLY_ADD;poly_cmul]) THEN REAL_ARITH_TAC ] ]; INDUCT_TAC THENL [ ARITH_TAC; (SIMP_TAC [EL;POLY_EXP_X_REC;poly_mul;NOT_POLY_EXP_NIL;NOT_CONS_NIL]) THEN LIST_INDUCT_TAC THENL [ (SIMP_TAC[]); (SIMP_TAC [poly_cmul;poly_add;NOT_CONS_NIL;TL;lem0001]) THEN (SIMP_TAC [ARITH_RULE `(SUC i) < (SUC n) <=> i < n`;lem0003]) ] ] ] ) let POLY_MUL_HD = prove( `! p1 p2. (~(p1 = []) /\ ~(p2 = [])) ==> (HD (p1 ** p2)) = (HD p1) * (HD p2)`, LIST_INDUCT_TAC THENL [ (SIMP_TAC[]); (LIST_INDUCT_TAC) THENL [ (SIMP_TAC[]); (SIMP_TAC [NOT_CONS_NIL]) THEN (ONCE_REWRITE_TAC [poly_mul]) THEN (ASM_CASES_TAC `(t:(real)list) = []`) THENL [ (ASM_SIMP_TAC [HD;poly_cmul]); (ASM_SIMP_TAC [HD;poly_cmul;poly_add]) THEN (SIMP_TAC [NOT_CONS_NIL;HD]) THEN (REAL_ARITH_TAC) ] ] ] ) let POLY_MUL_ITER_HD_FACTORIAL = prove( `! n. (HD (poly_mul_iter (\i.[-- &i; &1]) n)) = ((-- &1) pow n) * (&(FACT n))`, let lem01 = prove(`~([-- &(SUC n); &1] = [])`,SIMP_TAC [NOT_CONS_NIL]) in let lem02 = ISPECL [`[-- &(SUC n); &1]`;`poly_mul_iter (\i.[-- &i; &1]) n`] POLY_MUL_HD in let lem03 = CONJ lem01 (SPEC_ALL NOT_POLY_MUL_ITER_NIL) in let lem04 = MP lem02 lem03 in let lem05 = prove( `!n. ((-- &1) pow n) = -- ((-- &1) pow (SUC n))`, STRIP_TAC THEN (ONCE_REWRITE_TAC [pow]) THEN REAL_ARITH_TAC ) in INDUCT_TAC THENL [ (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN (SIMP_TAC [HD;FACT]) THEN REAL_ARITH_TAC; (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN BETA_TAC THEN (ONCE_REWRITE_TAC [lem04]) THEN (ONCE_REWRITE_TAC [HD]) THEN (ASM_SIMP_TAC []) THEN (ONCE_REWRITE_TAC [FACT]) THEN (ONCE_REWRITE_TAC [GSYM REAL_OF_NUM_MUL]) THEN (CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [lem05]))) THEN REAL_ARITH_TAC ] ) let PLANETMATH_THM_5_1 = prove( `! n p. p > 0 ==> n > 0 ==> ? As . ((g n p) = (&1/(&(FACT (p - 1)))) ## As) /\ (! i. i< (p-1) ==> (EL i As) = &0) /\ ((EL (p-1) As) = ((-- &1) pow (n * p)) * ((&(FACT n)) pow p)) /\ (ALL integer As)`, let lem01 = SPECL [`poly_exp [&0;&1] (p - 1)`;`poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p`] ALL_IS_INT_POLY_MUL in let lem02 = SPECL [`p-1`;`[&0;&1]`] ALL_IS_INT_POLY_EXP in let lem03 = prove(`ALL integer [&0;&1]`, (REWRITE_TAC [ALL]) THEN (SIMP_TAC [N_IS_INT])) in let lem04 = MP lem02 lem03 in let lem05 = SPECL [`p:num`;`poly_mul_iter (\i.[-- &i; &1]) n`] ALL_IS_INT_POLY_EXP in let lem06 = MP lem05 (SPEC_ALL ALL_IS_INT_POLY_MUL_ITER) in let lem07 = MP lem01 (CONJ lem04 lem06) in let lem08 = SPECL [`p-1`;`poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p`] TELEVISION in let lem09 = SIMP_RULE [ NOT_POLY_EXP_NIL;NOT_POLY_MUL_ITER_NIL] lem08 in let lem10 = SPECL [`i:num`;`p - 1`;`poly_exp (poly_mul_iter (\i. [ -- &i; &1]) n ) p`] JOSHUA in let lem11 = SIMP_RULE [NOT_POLY_MUL_ITER_NIL;NOT_POLY_EXP_NIL] lem10 in (REPEAT STRIP_TAC) THEN (EXISTS_TAC `((poly_exp [&0;&1] (p-1)) ** (poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p))`) THEN CONJ_TAC THENL [ (ONCE_REWRITE_TAC [Pm_eqn5.PLANETMATH_EQN_5]) THEN (SIMP_TAC[]); CONJ_TAC THENL [ (SIMP_TAC [lem11]); CONJ_TAC THENL [ (ONCE_REWRITE_TAC [lem09]) THEN (SPEC_TAC (`n:num`,`n:num`)) THEN (INDUCT_TAC) THENL [ (SIMP_TAC [NOT_CONS_NIL;HD_POLY_EXP;HD;Pm_eqn5.POLY_MUL_ITER;FACT;pow; REAL_POW_ONE;ARITH_RULE `0 * p = 0`;REAL_ARITH `&1 * &1 = &1`]); (SIMP_TAC [HD_POLY_EXP; NOT_POLY_MUL_ITER_NIL; POLY_MUL_ITER_HD_FACTORIAL]) THEN (SIMP_TAC [REAL_POW_MUL;REAL_POW_POW;BLAHBLAH3]) ]; ACCEPT_TAC lem07 ] ] ] ) let as_def = let ll01 = SPEC_ALL PLANETMATH_THM_5_1 in let FO_LEMMA1 = prove(`((p > 0) ==> (n > 0) ==> (? z. C p n z)) <=> (? z. (p > 0) ==> (n > 0) ==> C p n z)`,MESON_TAC[]) in let ll02 = GEN_ALL (SIMP_RULE [FO_LEMMA1] ll01) in let ll03 = ONCE_REWRITE_RULE [SKOLEM_CONV (concl ll02)] ll02 in new_specification ["As"] ll03 (* split up def of As into its four conjuncts *) let g_eq_As = (GEN_ALL o DISCH_ALL o CONJUNCT1 o UNDISCH o UNDISCH o SPEC_ALL) as_def let prefix_As_zero = (GEN_ALL o DISCH_ALL o CONJUNCT1 o CONJUNCT2 o UNDISCH o UNDISCH o SPEC_ALL) as_def let fact_As = (GEN_ALL o DISCH_ALL o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o UNDISCH o UNDISCH o SPEC_ALL) as_def let ALL_integer_As = (GEN_ALL o DISCH_ALL o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o UNDISCH o UNDISCH o SPEC_ALL) as_def let POLY_DIFF_AUX_LEM1 = prove( `! i p k. i < (LENGTH p) ==> EL i (poly_diff_aux k p) = (EL i p) * &(i + k)`, let lem0001 = ASSUME `! p k . i < LENGTH p ==> EL i (poly_diff_aux k p ) = EL i p * &(i + k)` in let lem0002 = SPECL [` t:(real)list`;`SUC k`] lem0001 in let lem0003 = prove(`SUC i < LENGTH (CONS (h:real) t) <=> i < LENGTH t`,(SIMP_TAC [LENGTH]) THEN ARITH_TAC) in INDUCT_TAC THENL [ LIST_INDUCT_TAC THENL [ (SIMP_TAC [poly_diff_aux;LENGTH]) THEN ARITH_TAC; (SIMP_TAC [poly_diff_aux;ARITH_RULE `0 + k = k`;poly_diff;LENGTH;EL;HD;TL]) THEN REAL_ARITH_TAC ]; LIST_INDUCT_TAC THENL [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; (SIMP_TAC [poly_diff_aux;EL;TL]) THEN STRIP_TAC THEN (SIMP_TAC [lem0003;lem0002;ARITH_RULE `i + SUC k = SUC i + k`]) ] ] ) let EL_POLY_DIFF = prove( `! i p. i < (LENGTH (poly_diff p)) ==> EL i (poly_diff p) = (EL (SUC i) p) * &(SUC i)`, let lem01 = SPECL [`SUC i`;`t:(real)list`;`1`] POLY_DIFF_AUX_LEM1 in INDUCT_TAC THENL [ LIST_INDUCT_TAC THENL [ ((SIMP_TAC [LENGTH;poly_diff]) THEN ARITH_TAC); (SIMP_TAC [LENGTH;PRE;EL;HD;TL;ARITH_RULE `SUC 0 = 1`;REAL_ARITH `x * &1 = x`;poly_diff;NOT_CONS_NIL]) THEN (SPEC_TAC (`t:(real)list`,`t:(real)list`)) THEN LIST_INDUCT_TAC THENL [(SIMP_TAC [LENGTH;poly_diff_aux]) THEN ARITH_TAC; (SIMP_TAC [HD;poly_diff_aux;REAL_ARITH `&1 * h = h`])] ]; LIST_INDUCT_TAC THENL [ ((SIMP_TAC [LENGTH;HD;poly_diff;REAL_ARITH `&1 * h = h`])) THEN ARITH_TAC; (SIMP_TAC [poly_diff;NOT_CONS_NIL;TL;LENGTH_POLY_DIFF_AUX ]) THEN (SIMP_TAC [lem01;EL;TL]) THEN ARITH_TAC ] ] ) let POLY_AT_ZERO = prove( `!p .(~(p = [])) ==> poly p (&0) = HD p`, LIST_INDUCT_TAC THENL [ SIMP_TAC []; (SIMP_TAC [poly;HD]) THEN REAL_ARITH_TAC ] ) let PDI_POLY_DIFF_COMM = prove( `! p n.(poly_diff_iter (poly_diff p) n) = (poly_diff (poly_diff_iter p n))`, STRIP_TAC THEN INDUCT_TAC THENL [(SIMP_TAC [Pm_lemma1.PDI_DEF]); (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN (ASM_SIMP_TAC [])] ) let EL_PDI_AT_ZERO = prove( `!i p. (i < (LENGTH p)) ==> ( poly (poly_diff_iter p i) (&0)) = ((EL i p) * (&(FACT i)))`, let lem03 = prove(`SUC i < LENGTH (CONS (h:real) t) <=> i < LENGTH t`,(SIMP_TAC [LENGTH]) THEN ARITH_TAC) in let lem04 = ASSUME `!p . i < LENGTH p ==> poly (poly_diff_iter p i) (&0) = EL i p * &(FACT i)` in let lem05 = SIMP_RULE [LENGTH_POLY_DIFF;LENGTH;PRE] (SPEC `poly_diff (CONS h t)` lem04) in let lem06 = prove(`i < LENGTH t ==> i < LENGTH (poly_diff (CONS h t))`,SIMP_TAC [LENGTH_POLY_DIFF;PRE;LENGTH]) in INDUCT_TAC THENL [ (LIST_INDUCT_TAC THENL [(SIMP_TAC [LENGTH]) THEN ARITH_TAC; (SIMP_TAC [Pm_lemma1.PDI_DEF;FACT;EL;NOT_CONS_NIL;POLY_AT_ZERO]) THEN REAL_ARITH_TAC]); LIST_INDUCT_TAC THENL [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; (SIMP_TAC [Pm_lemma1.PDI_DEF;GSYM PDI_POLY_DIFF_COMM;lem03;lem05]) THEN (SIMP_TAC [lem06;EL_POLY_DIFF;FACT;REAL_OF_NUM_MUL;GSYM REAL_MUL_ASSOC]) ] ] ) let EL_PDI_AT_ZERO2 = prove( `!i p. ((~ (p = [])) /\ (i <= (LENGTH p) - 1)) ==> ( poly (poly_diff_iter p i) (&0)) = ((EL i p) * (&(FACT i)))`, STRIP_TAC THEN LIST_INDUCT_TAC THEN (SIMP_TAC [NOT_CONS_NIL;LENGTH;ARITH_RULE `(i <= (SUC x) -1) <=> (i < (SUC x))`;EL_PDI_AT_ZERO]) ) let POLY_CMUL_PDI = prove( `!p c i. (poly_diff_iter (c ## p) i) = c ##(poly_diff_iter p i)`, STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN (ASM_SIMP_TAC [Pm_lemma1.PDI_DEF;POLY_CMUL_POLY_DIFF]) ) let LENGTH_g = prove( `! n p . (LENGTH (g n p)) >= p `, let lem00 = ARITH_RULE `SUC ((SUC p ) - 1) = SUC p` in let lem01 = prove(`! n p. ~((poly_exp (poly_mul_iter (\i.[-- &i; &1]) n ) (SUC p)) = [])`, SIMP_TAC [NOT_POLY_EXP_NIL; NOT_POLY_MUL_ITER_NIL]) in let lem02 = MATCH_MP POLY_MUL_LENGTH2 (SPEC_ALL lem01) in let lem03 = SPECL [`poly_exp [&0;&1] (SUC p - 1)`] lem02 in let lem04 = SIMP_RULE [POLY_EXP_X_LENGTH] lem03 in let lem05 = SIMP_RULE [lem00] lem04 in (SIMP_TAC [Pm_eqn5.PLANETMATH_EQN_5;POLY_CMUL_LENGTH]) THEN STRIP_TAC THEN INDUCT_TAC THENL [ ARITH_TAC; SIMP_TAC [lem05]] ) let LENGTH_As = prove( `! n p . p > 0 ==> n > 0 ==> LENGTH (As n p) >= p`, let lem50 = ADD_ASSUM `p > 0` (ADD_ASSUM `n > 0` (SPEC_ALL LENGTH_g)) in let lem51 = ONCE_REWRITE_RULE [UNDISCH_ALL (SPEC_ALL g_eq_As)] lem50 in let lem52 = ONCE_REWRITE_RULE [POLY_CMUL_LENGTH] lem51 in SIMP_TAC [lem52] ) let REAL_MUL_RDIV = prove( `!x y. ~(y = &0) ==> ((x * y) / y = x)`, SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_RID] ) let REAL_MUL_DIV_ASSOC = prove( `!x y z.((x * z) / y = x * (z / y))`, SIMP_TAC [real_div;GSYM REAL_MUL_ASSOC] ) let IS_INT_FACT_DIV = prove( `! n m. n >= m ==> integer ( (&(FACT n))/(&(FACT m)) )`, let lem0 = SPEC_ALL (ONCE_REWRITE_RULE [GSYM (SPECL [`FACT n`;`0`] REAL_OF_NUM_EQ)] FACT_NZ) in let lem1 = SPECL [`&(SUC n)`;`&(FACT n)`] REAL_MUL_RDIV in let lem2 = MP lem1 lem0 in let lem4 = ASSUME `! m. n >= m ==> integer (&(FACT n)/ &(FACT m))` in let lem5 = UNDISCH (SPEC_ALL lem4) in let lem6 = prove(`integer(&(SUC n))`,SIMP_TAC [N_IS_INT]) in let lem7 = CONJ lem6 lem5 in let lem8 = MATCH_MP INTEGER_MUL lem7 in let lem9 = UNDISCH_ALL (ARITH_RULE `(~(n >= m)) ==> (SUC n >= m) ==> m = SUC n`) in INDUCT_TAC THENL [ (SIMP_TAC [ARITH_RULE `0 >= m ==> m = 0`;FACT_NZ;REAL_OF_NUM_EQ;REAL_DIV_REFL;N_IS_INT]); (STRIP_TAC) THEN (ASM_CASES_TAC `(n:num) >= m`) THENL [ (ASM_SIMP_TAC [FACT;GSYM REAL_OF_NUM_MUL;lem2;N_IS_INT]) THEN (SIMP_TAC [FACT;GSYM REAL_OF_NUM_MUL;REAL_MUL_DIV_ASSOC;lem8]); (STRIP_TAC) THEN (SIMP_TAC [lem9;FACT_NZ;REAL_OF_NUM_EQ;REAL_DIV_REFL;N_IS_INT]) ] ] ) let SATURDAY_LEMMA = prove( `!x. p > 1 ==> m >= p ==> x * ((&(FACT m))/(&(FACT (p-1)))) = x * (&p) * ((&(FACT m))/(&(FACT p)))`, let lem01 = UNDISCH (ARITH_RULE `p > 1 ==> SUC (p -1) = p`) in let lem02 = ADD_ASSUM `p > 1` (SPEC `p - 1` (CONJUNCT2 FACT)) in let lem03 = GSYM (ONCE_REWRITE_RULE [lem01] lem02) in let lem04 = SPEC `&p` REAL_DIV_REFL in let lem05 = ADD_ASSUM `p > 1` (SPECL [`p:num`;`0`] REAL_OF_NUM_EQ) in let lem06 = SIMP_RULE [UNDISCH (ARITH_RULE `p > 1 ==> ~(p = 0)`)] lem05 in let lem07 = GSYM (MP lem04 lem06) in (REPEAT STRIP_TAC) THEN (CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [GSYM REAL_MUL_LID]))) THEN (ONCE_REWRITE_TAC [lem07]) THEN (ONCE_REWRITE_TAC [real_div]) THEN (ONCE_REWRITE_TAC [REAL_ARITH `((x1:real) * x2) * x * (x3 * x4) = x * x1 * (x3 * (x2 * x4))`]) THEN (ONCE_REWRITE_TAC [GSYM REAL_INV_MUL]) THEN (ONCE_REWRITE_TAC [REAL_OF_NUM_MUL]) THEN (SIMP_TAC [REAL_MUL_ASSOC;GSYM REAL_INV_MUL]) THEN (ONCE_REWRITE_TAC [lem03]) THEN (SIMP_TAC [REAL_MUL_ASSOC;GSYM REAL_OF_NUM_MUL]) ) let SHRIVER = prove( `!f0. (!i. m <= i /\ i <= SUC n ==> (f0 i)) ==> (!i. m <= i /\ i <= n ==> (f0 i)) `, let lem01 = UNDISCH_ALL (ARITH_RULE `i <= n ==> i <= SUC n`) in let lem02 = CONJ (ASSUME `(m:num) <= (i:num)`) lem01 in let lem03 = ASSUME `!i. m <= i /\ i <= SUC n ==> (f0 i)` in let lem04 = SPEC_ALL lem03 in let lem05 = MP lem04 lem02 in (REPEAT STRIP_TAC) THEN (ACCEPT_TAC lem05) ) let IS_INT_SUM = prove( `!f n m.(!i.m <= i /\ i <= n ==> integer (f i)) ==> integer (sum (m..n) f)`, let l0 = SPECL [`m:num`;`n:num`;`i:num`] IN_NUMSEG in let l1 = SPECL [`m:num`;`SUC n`] NUMSEG_EMPTY in let l2 = ADD_ASSUM `SUC n < m` l1 in let l3 = ASM_REWRITE_RULE [] l2 in let l4 = (UNDISCH o ARITH_RULE) `~(SUC n < m) ==> m <= SUC n` in let l5 = ONCE_REWRITE_RULE [GSYM IN_NUMSEG] SHRIVER in let l6 = SPEC `\(i:num).(integer (f i))` l5 in let l7 = BETA_RULE l6 in let l8 = ASSUME `! m. (!i. i IN m..n ==> integer (f i)) ==> integer (sum (m..n) f)` in let l9 = SPEC_ALL l8 in let l10 = UNDISCH (IMP_TRANS l7 l9) in let jj0 = ARITH_RULE `(~(SUC n < m)) ==> m <= SUC n /\ (SUC n) <= SUC n` in let jj1 = UNDISCH (ONCE_REWRITE_RULE [GSYM IN_NUMSEG] jj0) in let jj2 = SPEC `SUC n` (ASSUME `!i. i IN m.. SUC n ==> integer (f i)`) in let jj3 = (MP jj2 jj1) in let l18 = CONJ l10 jj3 in let l19 = MATCH_MP INTEGER_ADD l18 in let l20 = DISCH `!i. i IN m..SUC n ==> integer (f i)` l19 in let l21 = ASSUME `!i . i = 0 ==> integer (f 0)` in let l22 = SIMP_RULE [] (SPEC `0` l21) in (ONCE_REWRITE_TAC [GSYM l0]) THEN STRIP_TAC THEN INDUCT_TAC THENL [ STRIP_TAC THEN (ASM_CASES_TAC `m = 0`) THENL [ (ASM_SIMP_TAC []) THEN (ONCE_REWRITE_TAC [NUMSEG_CONV `0..0`]) THEN (ONCE_REWRITE_TAC [ SUM_SING]) THEN (SIMP_TAC [IN_SING]) THEN (DISCH_TAC) THEN (SIMP_TAC [l22]); (ASM_SIMP_TAC [NUMSEG_CLAUSES;SUM_CLAUSES;N_IS_INT]) ]; STRIP_TAC THEN (ASM_CASES_TAC `SUC n < m`) THENL [ (ASM_SIMP_TAC [l3;SUM_CLAUSES;N_IS_INT]); (ASM_SIMP_TAC [l4;SUM_CLAUSES_NUMSEG]) THEN (ACCEPT_TAC l20) ] ] ) let ALL_IMP_EL = prove( `! (l:(a)list) i P. (ALL P l) ==> (i < LENGTH l) ==> P (EL i l)`, SIMP_TAC[GSYM ALL_EL] ) let KEY_LEMMA = prove( `n > 0 ==> p > 0 ==> ! i . p <= i /\ i <= (LENGTH (As n p) - 1) ==> integer ((&(FACT i)/ &(FACT p)) * (EL i (As n p)))`, let jem0 = ISPECL [`(As n p)`;`i:num`;`integer`] ALL_IMP_EL in let jem1 = MP jem0 (UNDISCH (UNDISCH (SPEC_ALL ALL_integer_As))) in let jem3 = ARITH_RULE `LENGTH (As n p) > 0 ==> ((i < LENGTH (As n p)) <=> i <= LENGTH (As n p) - 1)` in let jem4 = UNDISCH_ALL ((SPEC_ALL LENGTH_As)) in let jem5 = UNDISCH (ARITH_RULE `p > 0 ==> (LENGTH (As n p) >= p) ==> (LENGTH (As n p) > 0)`) in let jem6 = MP jem5 jem4 in let jem7 = MP jem3 jem6 in let jem8 = ONCE_REWRITE_RULE [jem7] jem1 in let kem0 = SPECL [`i:num`;`p:num`] IS_INT_FACT_DIV in let kem1 = ADD_ASSUM `p <= (i:num)` (ADD_ASSUM `i <= (LENGTH (As n p) - 1)` kem0) in let kem2 = SIMP_RULE [UNDISCH_ALL (ARITH_RULE `p <= i ==> i <= LENGTH (As n p) -1 ==> i >= p`)] kem1 in (REPEAT STRIP_TAC) THEN (SIMP_TAC[UNDISCH jem8;kem2;INTEGER_MUL]) ) let KEY_LEMMA2 = prove( `p > 1 ==> n > 0 ==> ? K0 . integer K0 /\ (&1 / &(FACT ( p - 1))) * (sum (p.. LENGTH (As n p) -1) (\m. EL m (As n p) * &(FACT m))) = (&p) * K0`, let lem0000 = SPEC `EL m (As n p)` SATURDAY_LEMMA in let lem1000 = DISCH `m <= LENGTH (As n p) -1` (ADD_ASSUM `m <= LENGTH (As n p) -1` (UNDISCH_ALL lem0000)) in let lem2000 = DISCH `(m:num) >= p` lem1000 in let lem3000 = ONCE_REWRITE_RULE [ARITH_RULE `(m:num) >= p <=> p <= m`] lem2000 in let lem4000 = ONCE_REWRITE_RULE [TAUT `(a ==> b ==> c) <=> ((a /\ b) ==> c)`] (GEN `m:num` lem3000) in let lem5000 = MATCH_MP SUM_EQ_NUMSEG lem4000 in let nem2 = SPECL [`\x.(&(FACT x)/ &(FACT p)) * (EL x (As n p))`;`LENGTH (As n p) - 1`;`p:num`] IS_INT_SUM in let nem3 = BETA_RULE nem2 in let nem4 = SIMP_RULE [UNDISCH (UNDISCH KEY_LEMMA)] nem3 in let nem5 = ADD_ASSUM `p > 1` (DISCH `p > 0` nem4) in let nem6 = SIMP_RULE [(UNDISCH o ARITH_RULE) `(p:num) > 1 ==> p > 0`] nem5 in STRIP_TAC THEN STRIP_TAC THEN (ONCE_REWRITE_TAC [GSYM SUM_LMUL]) THEN (BETA_TAC) THEN (ONCE_REWRITE_TAC [real_div]) THEN (ONCE_REWRITE_TAC [REAL_MUL_LID]) THEN (ONCE_REWRITE_TAC [REAL_ARITH `(x1:real) * x2 * x3 = x2 * (x3 * x1)`]) THEN (ONCE_REWRITE_TAC [GSYM real_div]) THEN (ONCE_REWRITE_TAC [lem5000]) THEN (ONCE_REWRITE_TAC [REAL_ARITH `(x1:real) * x2 * x3 = x2 * (x3 * x1)`]) THEN (ONCE_REWRITE_TAC [SUM_LMUL]) THEN (EXISTS_TAC `sum (p .. LENGTH (As n p) -1) (\x. &(FACT x) / &(FACT p) * EL x (As n p))`) THEN (SIMP_TAC [nem6]) ) let NOT_g_NIL = prove( `!n p . ~ ((g n p ) = [])`, SIMP_TAC [Pm_eqn5.PLANETMATH_EQN_5; NOT_CONS_NIL; NOT_POLY_EXP_NIL; NOT_POLY_CMUL_NIL; NOT_POLY_MUL_NIL;NOT_POLY_MUL_ITER_NIL] ) let FACT_DIV_RCANCELS = prove( `!n x. x / &(FACT n) * &(FACT n) = x`, MESON_TAC [REAL_ARITH `!x. &0 < x ==> ~(x = &0)`; REAL_DIV_RMUL;FACT_LT;REAL_OF_NUM_LT] ) let PSUM_ITERATE = prove( `! n m f. psum (m,n) f = if (n > 0) then (iterate (+) (m..((n+m)-1)) f) else &0`, let lem01 = ARITH_RULE `~(n+m=0) ==> (SUC n + m) -1 = SUC ((n + m) -1)` in let lem02 = MP (ISPEC `(+)` ITERATE_SING) MONOIDAL_REAL_ADD in let lem03 = prove( `iterate (+) (m..SUC ((n + m) - 1)) f = f (SUC ((n+m)-1)) + iterate (+) (m..(n+m)-1) f`, MESON_TAC [ARITH_RULE `m <= SUC ((n+m)-1)`;ITERATE_CLAUSES_NUMSEG; MONOIDAL_REAL_ADD;REAL_ADD_SYM]) in let lem04 = UNDISCH (UNDISCH (ARITH_RULE `~(n+m=0) ==> n=0 ==> m-1 < m`)) in let lem05 = SIMP_RULE [lem04] (SPECL [`m:num`;`m-1`] NUMSEG_EMPTY) in INDUCT_TAC THENL [ SIMP_TAC [ARITH_RULE `~(0 > 0)`;sum_DEF]; (SIMP_TAC [ARITH_RULE `(SUC n) > 0`]) THEN (REPEAT STRIP_TAC) THEN (ASM_CASES_TAC `n + m =0`) THENL [ (REWRITE_TAC [UNDISCH (ARITH_RULE `n + m = 0 ==> n = 0`)]) THEN (REWRITE_TAC [lem02;NUMSEG_SING;ARITH_RULE `(SUC 0 +m) -1 = m`]) THEN (MESON_TAC [sum_DEF; ADD_CLAUSES;REAL_ARITH `&0 + x = x`]) ; (ONCE_REWRITE_TAC [sum_DEF;UNDISCH lem01]) THEN (REWRITE_TAC [lem03]) THEN (ASM_CASES_TAC `n = 0`) THEN (ASM_SIMP_TAC [ARITH_RULE `~(0 > 0)`;ADD_CLAUSES;REAL_ADD_LID;REAL_ADD_RID; lem05;ITERATE_CLAUSES_GEN; MONOIDAL_REAL_ADD;NEUTRAL_REAL_ADD; REAL_ADD_SYM;ADD_SYM;ARITH_RULE `~(n=0) ==> n>0 /\ SUC (n-1) = n`]) ] ] ) let PLANETMATH_EQN_5_2 = prove( `p > 1 ==> n > 0 ==> (? K0. integer K0 /\ poly (SOD (g n p)) (&0) = &(FACT n) pow p * -- &1 pow (n * p) + &p * K0)`, let lem01 = SPECL [`g n p`;`x:real`;`(&0):real`] Pm_lemma2.PLANETMATH_LEMMA_2_B in let lem02 = GEN_ALL lem01 in let lem03 = SPEC_ALL (BETA_RULE lem02) in let lem04 = SIMP_RULE [FACT_DIV_RCANCELS] lem03 in let lem05 = SIMP_RULE [PSUM_ITERATE] lem04 in let lem06 = SIMP_RULE [ARITH_RULE `(n:num) + 0 = n`] lem05 in let lem07 = ADD_ASSUM `n > 0` (ADD_ASSUM `p > 0` lem06) in let lem08 = REWRITE_RULE [GSYM LENGTH_EQ_NIL;ARITH_RULE `~(x = 0) <=> x > 0`] NOT_g_NIL in let lem09 = SIMP_RULE [lem08] lem07 in let lem10 = CONV_RULE (RAND_CONV (REWRITE_CONV [UNDISCH_ALL (SPEC_ALL g_eq_As)])) lem09 in let lem11 = SIMP_RULE [POLY_CMUL_LENGTH] lem10 in let lem12 = SPECL [`m:num`;`(As n p)`] EL_PDI_AT_ZERO in let lem13 = SIMP_RULE [POLY_CMUL_PDI;POLY_CMUL;lem12] lem11 in let lem14 = GSYM (BETA `(\m. poly (poly_diff_iter (As n p) m) (&0)) m`) in let lem15 = ISPECL [`(\m. poly (poly_diff_iter (As n p) m) (&0))`;`&1/ &(FACT (p - 1))`;`0..LENGTH (As n p) -1`] SUM_LMUL in let lem16 = ONCE_REWRITE_RULE [lem14] lem13 in let lem17 = ONCE_REWRITE_RULE [GSYM sum] lem16 in let lem18 = SIMP_RULE [GSYM lem17] lem15 in let lem20 = SPECL [`(\m. poly (poly_diff_iter (As n p) m) (&0))`;`(\m. EL m (As n p) * &(FACT m))`;`0`;`LENGTH (As n p) - 1`] SUM_EQ_NUMSEG in let lem21 = ONCE_REWRITE_RULE [ARITH_RULE `0 <= i`] (BETA_RULE lem20) in let lem22 = ADD_ASSUM `~(As n p = [])` (ONCE_REWRITE_RULE [EL_PDI_AT_ZERO2] lem21) in let lem30 = SPECL [`i:num`;`As n p`] EL_PDI_AT_ZERO2 in let lem31 = ASM_REWRITE_RULE [] (ADD_ASSUM `~(As n p = [])` lem30) in let lem23 = ONCE_REWRITE_RULE [lem31] lem22 in let lem24 = REWRITE_RULE [GSYM lem16] lem23 in let lem25 = ONCE_REWRITE_RULE [lem24] lem18 in let lem30 = ISPECL [`\m. EL m (As n p) * &(FACT m)`;`0`;`p-1`;`(LENGTH (As n p) - 1) - (p - 1)`] SUM_ADD_SPLIT in let lem31 = SIMP_RULE [ARITH_RULE `0 <= x`] lem30 in let lem32 = UNDISCH_ALL (ARITH_RULE `! x. x >= p ==> (p - 1) + (x - 1) - (p -1)= x - 1`) in let lem33 = UNDISCH_ALL (SPEC_ALL LENGTH_As) in let lem34 = SPEC `LENGTH (As n p)` lem32 in let lem35 = MP lem34 lem33 in let lem36 = ONCE_REWRITE_RULE [UNDISCH (ARITH_RULE `p > 1 ==> (p - 1) + 1 = p`);lem35] lem31 in let lem37 = ONCE_REWRITE_RULE [lem36] lem25 in let lem38 = SIMP_RULE [UNDISCH (ARITH_RULE `p > 1 ==> p > 0`)] (DISCH `p > 0` lem37) in let lem39 = ISPECL [`\m. EL m (As n p) * &(FACT m)`;`0`;`p-2`;`1`] SUM_ADD_SPLIT in let lem40 = ADD_ASSUM `n > 0` (ADD_ASSUM `p > 1` lem39) in let lem41 = SIMP_RULE (map (UNDISCH o ARITH_RULE) [`p > 1 ==> p - 2 + 1 = p-1`;`p > 1 ==> (p - 2) + 1 = p - 1`]) lem40 in let lem42 = SIMP_RULE [SUM_SING_NUMSEG;ARITH_RULE `0 <= x`] lem41 in let lem45 = ADD_ASSUM `p > 1` (SPEC_ALL prefix_As_zero) in let lem46 = SIMP_RULE [UNDISCH_ALL (ARITH_RULE `p > 1 ==> p > 0`)] lem45 in let lem47 = UNDISCH (ONCE_REWRITE_RULE [UNDISCH_ALL (ARITH_RULE `p > 1 ==> (i < p-1 <=> i <= p-2)`)] lem46) in let lem48 = SIMP_RULE [REAL_ARITH `((&0):real) + x = x`; SUM_EQ_0_NUMSEG;REAL_ARITH `((&0):real) * x = &0`;lem47] lem42 in let lem49 = SIMP_RULE [UNDISCH (ARITH_RULE `p > 1 ==> p > 0`)] (ADD_ASSUM `p > 1` (SPEC_ALL fact_As)) in let lem50 = SIMP_RULE [UNDISCH lem49] lem48 in let lem51 = ONCE_REWRITE_RULE [lem50] lem38 in let lem52 = SPECL [`p - 1`;`(&1):real`] FACT_DIV_RCANCELS in let lem53 = SIMP_RULE [REAL_ARITH `(x:real) * (y * z) = (x * z) * y`;lem52;REAL_ARITH `(x:real) * (y + z) = (x * y) + (x * z)`] lem51 in let lem54 = SIMP_RULE [REAL_ARITH `&1 * x = (x:real)`] lem53 in let josh0 = UNDISCH_ALL KEY_LEMMA2 in let josh1 = REAL_ARITH `!(y:real) x1 x2 . x1 = x2 <=> y + x1 = y + x2` in let josh2 = SPEC `(&(FACT n) pow p * -- &1 pow (n * p)):real` josh1 in let josh3 = ONCE_REWRITE_RULE [josh2] josh0 in let josh4 = ONCE_REWRITE_RULE [GSYM lem54] josh3 in let josh5 = DISCH `~ (As n p = [])` josh4 in let jem4 = ADD_ASSUM `p > 1` ((SPEC_ALL LENGTH_As)) in (* JOHN: the UNDISCH here is necessary... i don't think it should be *) let jem5 = UNDISCH (SIMP_RULE [UNDISCH (ARITH_RULE `(p:num) > 1 ==> p > 0`)] jem4) in let jem6 = UNDISCH (ARITH_RULE `p > 1 ==> (LENGTH (As n p) >= p) ==> ~((LENGTH (As n p) = 0))`) in let jem7 = MP jem6 jem5 in let jem8 = SIMP_RULE [LENGTH_EQ_NIL] jem7 in let josh6 = MP josh5 jem8 in let josh7 = DISCH_ALL josh6 in let josh11 = ONCE_REWRITE_RULE [GSYM OLD_SUM] lem17 in let josh12 = REWRITE_RULE [GSYM josh11] josh7 in let josh13 = SIMP_RULE [] (DISCH_ALL josh12) in let josh14 = BRW `(X ==> Y ==> Z ==> W) <=> ((X /\ Y /\ Z) ==> W)` josh13 in let josh15 = ONCE_REWRITE_RULE [ARITH_RULE `(p > 0 /\ n > 0 /\ p > 1) <=> (p > 1 /\ n > 0)`] (DISCH_ALL josh14) in let josh16 = BRW1 josh15 in let josh17 = SIMP_RULE [PSUM_ITERATE;ARITH_RULE `~(0 > 0)`] josh16 in ACCEPT_TAC josh17 ) let PLANETMATH_DIVIDES_FACT_PRIME_1 = prove ( `!p n. (prime p) /\ p > n ==> ~(num_divides p (FACT n))`, (SIMP_TAC [DIVIDES_FACT_PRIME]) THEN ARITH_TAC ) let INT_OF_REAL_NEG_NUM = prove( `!(n:num).int_of_real (-- (real_of_num n)) = -- (int_of_real (real_of_num n))`, SIMP_TAC [GSYM int_of_num;GSYM int_of_num_th;GSYM int_neg] ) let ABS_EQ_ONE = prove( `!(x:real) .((abs x) = &1) ==> ((x = &1) \/ (x = -- &1))`, ARITH_TAC ) let POW_NEG_1 = prove( `!(x:num). (((-- (&1 :real)) pow x) = -- &1) \/ (((-- (&1 : real)) pow x) = &1)`, let lem00 = ONCE_REWRITE_RULE [TAUT `x \/ y <=> y \/ x`] ABS_EQ_ONE in let lem01 = (SPEC `(-- (&1 :real)) pow x` lem00) in let lem02 = (SPEC `x:num` POW_M1) in let lem03 = MP lem01 lem02 in STRIP_TAC THEN (ACCEPT_TAC lem03) ) let NUM_DIVIDES_INT_DIVIDES = prove( `!(x:num) (y:num).(x divides y) <=> ((&x):int divides ((&y):int))`, (ONCE_REWRITE_TAC [num_divides]) THEN (SIMP_TAC []) ) let SON_OF_A_GUN = prove( `! (p:num) (n:num) . p > n ==> (prime p) ==> ~(int_divides (& p) (&(FACT n) pow p * -- &1 pow (n * p) ))`, let POW_INT_NEG_1 = INT_OF_REAL_THM POW_NEG_1 in let lem0000 = TAUT `(A /\ B ==> C) <=> (A ==> B ==> C)` in let lem0001 = ONCE_REWRITE_RULE [lem0000] PLANETMATH_DIVIDES_FACT_PRIME_1 in let lem0002 = UNDISCH_ALL (SPEC_ALL lem0001) in let lem0008 = ONCE_REWRITE_RULE [TAUT `(x /\ y ==> z) <=> (x ==> ~z ==> ~y)`] PRIME_DIVEXP in let lem0009 = SPECL [`p:num`;`p:num`;`FACT n`] lem0008 in let lem0010 = UNDISCH lem0009 in let lem0011 = MP lem0010 lem0002 in STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN (DISJ_CASES_TAC (SPEC `(n * p):num` POW_INT_NEG_1)) THENL [ (ASM_SIMP_TAC [INT_OF_NUM_POW; ARITH_RULE `x * (--(&1):int) = -- x`;ARITH_RULE `x * ((&1):int) = x`]) THEN (ONCE_REWRITE_TAC [GSYM INT_DIVIDES_RNEG]) THEN (ONCE_REWRITE_TAC [ARITH_RULE `-- -- (x:int) = x`]) THEN (ONCE_REWRITE_TAC [GSYM NUM_DIVIDES_INT_DIVIDES]) THEN (ACCEPT_TAC lem0011); (ASM_SIMP_TAC [INT_OF_NUM_POW; ARITH_RULE `x * (--(&1):int) = -- x`;ARITH_RULE `x * ((&1):int) = x`]) THEN (ONCE_REWRITE_TAC [GSYM NUM_DIVIDES_INT_DIVIDES]) THEN (ACCEPT_TAC lem0011) ] ) let MAY_LEMMA = prove( `(p:num) > (n:num) ==> (prime p) ==> ~(int_divides (& p) ((int_of_num (FACT n)) pow p * -- &1 pow (n * p) + &p * K0))`, let lem00 = BRW `(x /\ y ==> z) <=> (x ==> ~z ==> ~y)` INT_DIVIDES_ADD_REVR in let lem0 = prove(`int_divides ((&p):int) (&p * K0)`,INTEGER_TAC) in let lem1 = (UNDISCH_ALL o SPEC_ALL) SON_OF_A_GUN in let lem2 = SPECL [`(&p):int`;`((&p):int) * K0`; `(&(FACT n) pow p):int * -- &1 pow (n * p)` ] lem00 in let lem3 = MP (MP lem2 lem0) lem1 in let lem4 = (DISCH_ALL lem3) in let lem5 = ONCE_REWRITE_RULE [ARITH_RULE `(x:int) + y = y + x`] lem4 in (ACCEPT_TAC lem5) ) let PLANET_MATH_alpha_1 = prove( `n > 0 ==> p > n ==> prime p ==> (integer (poly (SOD (g n p )) (&0)))`, let a1 = UNDISCH (UNDISCH (ARITH_RULE `n > 0 ==> p > n ==> p > 1`)) in let a2 = UNDISCH (SIMP_RULE [] (DISCH `n > 0` (MP PLANETMATH_EQN_5_2 a1))) in let t1 = `integer K0 /\ poly (SOD (g n p)) (&0) = &(FACT n) pow p * -- &1 pow (n * p) + &p * K0` in (STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC) THEN (CHOOSE_TAC a2) THEN (SPLIT_CONJOINED_ASSUMPT_TAC t1) THEN (ASM_REWRITE_TAC[]) THEN (ASM_SIMP_TAC [N_IS_INT;INTEGER_ADD;NEG_N_IS_INT;INTEGER_POW;INTEGER_MUL]) ) let PLANET_MATH_alpha_2 = prove( `n > 0 ==> p > n ==> prime p ==> ( ~((&p) divides (int_of_real (poly (SOD (g n p )) (&0)))))`, let t1 = `integer K0 /\ poly (SOD (g n p)) (&0) = &(FACT n) pow p * -- &1 pow (n * p) + &p * K0` in let t = `((real_of_num (FACT n)) pow p) * (-- &1 pow (n * p)) + (&p * K0)` in let arch0 = INT_OF_REAL_CONV t in let a1 = UNDISCH (UNDISCH (ARITH_RULE `n > 0 ==> p > n ==> p > 1`)) in let a2 = UNDISCH (SIMP_RULE [] (DISCH `n > 0` (MP PLANETMATH_EQN_5_2 a1))) in let a3 = SPEC `int_of_real K0` (GEN `K0:int` MAY_LEMMA) in let a4 = GSYM (UNDISCH arch0) in let a5 = ONCE_REWRITE_RULE [a4] a3 in STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN (CHOOSE_TAC a2) THEN (SPLIT_CONJOINED_ASSUMPT_TAC t1) THEN (ASM_SIMP_TAC [a5]) ) let INT_OF_REAL_NEG_INT_OF_NUM = prove( `!n. int_of_real(-- (real_of_num n)) = -- int_of_num n`, SIMP_TAC [int_of_num;INT_OF_REAL_NEG_NUM] ) let PLANET_MATH_alpha_3 = prove( `n > 0 ==> p > n ==> prime p ==> (~((poly (SOD (g n p)) (&0)) = &0))`, let lem0 = prove( `!(x:num) (y:real). (x > 0) ==> (integer y) ==> (~(&x divides (int_of_real y))) ==> ~(y = &0)`, MESON_TAC [is_int;INT_OF_NUM_GT;INT_DIVIDES_RNEG;REAL_OF_NUM_EQ;int_of_num;INT_OF_REAL_NEG_INT_OF_NUM;INT_OF_NUM_EQ;INT_DIVIDES_0]) in let lem1 = ARITH_RULE `n > 0 ==> p > n ==> p > 0` in MESON_TAC [lem0;lem1; PLANET_MATH_alpha_1; PLANET_MATH_alpha_2] ) let PLANET_MATH_alpha = prove( `n > 0 ==> p > n ==> prime p ==> ( (integer (poly (SOD (g n p )) (&0))) /\ ~((&p) divides (int_of_real (poly (SOD (g n p )) (&0)))) /\ ~((poly (SOD (g n p)) (&0)) = &0))`, SIMP_TAC [PLANET_MATH_alpha_1; PLANET_MATH_alpha_2; PLANET_MATH_alpha_3] ) let REAL_FACT_NZ = prove( `~((&(FACT n)) = (real_of_num 0))`, let l0 = GSYM (SPECL [`FACT n`;`0`] REAL_OF_NUM_EQ) in ACCEPT_TAC (SPEC_ALL (ONCE_REWRITE_RULE [l0] FACT_NZ)) ) let IS_INT_FACT_DIV_FACT_DIV_FACT = prove( `! i k.integer ((&(FACT (i+k)))/(&(FACT i))/(&(FACT k)))`, let l0 = MATCH_MP (ARITH_RULE `(~(x=0)) ==> 0 < x`) (SPEC `k:num` FACT_NZ) in let l1 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_LT] l0 in let l2 = MATCH_MP REAL_EQ_LDIV_EQ l1 in (REPEAT STRIP_TAC) THEN (REWRITE_TAC [is_int;l2]) THEN (EXISTS_TAC ` (binom(i+k,k))`) THEN DISJ1_TAC THEN (MESON_TAC [BINOM_FACT;MULT_SYM;MULT_ASSOC;REAL_OF_NUM_MUL;REAL_OF_NUM_EQ]) ) (* if you replace the second SIMP_TAC with MESON_TAC, it fails!! * (i alwasy thought MESON_TAC was strictly stronger than SIMP_TAC *) let POLY_CMUL_EL = prove( `!p c i.(i < (LENGTH p)) ==> (EL i (c ## p)) = c * (EL i p)`, let l0 = ARITH_RULE `(SUC i) < (SUC j) <=> i < j` in LIST_INDUCT_TAC THENL [ (SIMP_TAC [LENGTH;ARITH_RULE `~(n < (0:num))`]); STRIP_TAC THEN INDUCT_TAC THENL [ (SIMP_TAC [poly_cmul;HD;EL]); (ASM_SIMP_TAC [LENGTH;poly_cmul;TL;EL;l0]) ] ] ) let PDI_COEFF_FACT = prove( `! k q i.(i < LENGTH (poly_diff_iter q k)) ==> (EL i (poly_diff_iter q k)) = ((&(FACT (i+k)))/(&(FACT i))) * (EL (i+k) q)`, let t0 = `!q i. i < LENGTH (poly_diff_iter q k) ==> EL i (poly_diff_iter q k) = &(FACT (i + k)) / &(FACT i) * EL (i + k) q` in let l0 = SPECL [`q:(real)list`;`SUC i`] ( ASSUME t0) in let l1 = ONCE_REWRITE_RULE [ARITH_RULE `(SUC i) < x <=> i < (PRE x)`] l0 in let l2 = ONCE_REWRITE_RULE [GSYM LENGTH_POLY_DIFF] l1 in let l3 = ONCE_REWRITE_RULE [FACT;GSYM REAL_OF_NUM_MUL] l2 in let l4 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_MUL] l3 in let l5 = REWRITE_RULE [real_div;REAL_INV_MUL] l4 in let l6 = REAL_ARITH `(w * (inv x) * y ) * z = (w * y * z) * (inv x)` in let l9 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_LT] (ARITH_RULE `0 < SUC i`) in let l10 = MATCH_MP REAL_EQ_RDIV_EQ l9 in let l11 = ONCE_REWRITE_RULE [l6] l5 in let l12 = ONCE_REWRITE_RULE [real_div] l10 in let l13 = ONCE_REWRITE_RULE [l12] l11 in INDUCT_TAC THENL [ (REWRITE_TAC [Pm_lemma1.PDI_DEF;ARITH_RULE `i + 0 = i`]) THEN (MESON_TAC [REAL_DIV_REFL;FACT_NZ;REAL_OF_NUM_EQ;REAL_ARITH `(real_of_num 1) * x = x`]); (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN (SIMP_TAC [EL_POLY_DIFF]) THEN (ONCE_REWRITE_TAC [ARITH_RULE `i + (SUC k) = (SUC i) + k`]) THEN (ONCE_REWRITE_TAC [FACT]) THEN (ONCE_REWRITE_TAC [real_div]) THEN (SIMP_TAC [l13;real_div;REAL_MUL_ASSOC]) ] ) (* I think this should hold if we replace [--a;&1] with an arbitrary polynomial q, * however the existing ORDER* theorems would not be sufficient to prove it and * I don't feel like putting in the effort right now *) let POLY_DIVIDES_POLY_DIFF = prove( `!p n a. (poly_divides (poly_exp [--a;&1] (SUC n)) p) ==> (poly_divides (poly_exp [--a;&1] n) (poly_diff p))`, let l0 = ARITH_RULE `op = SUC odp ==> SUC n <= op ==> n <= odp` in let l1 = ARITH_RULE `(SUC n <= m ) ==> ~(m = 0)` in MESON_TAC [l0;l1;POLY_DIFF_ZERO;ORDER_DIVIDES;ORDER_DIFF] ) let POLY_DIVIDES_MUL = prove( `!p1 p2 p3.poly_divides p1 p2 ==> poly_divides p1 (p2 ** p3)`, (ONCE_REWRITE_TAC [divides]) THEN (REPEAT STRIP_TAC) THEN (EXISTS_TAC `q ** p3`) THEN (ASM_MESON_TAC [FUN_EQ_THM;POLY_MUL;POLY_MUL_ASSOC]) ) let POLY_DIVIDES_MUL3 = prove( `!p1 p2 p3.(poly_divides p1 p2) ==> (poly_divides p1 (p3 ** p2))`, (ONCE_REWRITE_TAC [divides]) THEN (REPEAT STRIP_TAC) THEN (EXISTS_TAC `p3 ** q`) THEN (UNDISCH_TAC `poly (p2) = poly (p1 ** q)`) THEN (ONCE_REWRITE_TAC [FUN_EQ_THM]) THEN (REWRITE_TAC [POLY_MUL]) THEN (MESON_TAC [REAL_MUL_ASSOC;REAL_MUL_SYM]) ) let POLY_DIVIDES_POLY_MUL_ITER = prove( `!f n v. 1 <= v ==> v <= n ==> poly_divides (f v) (poly_mul_iter f n)`, let l1 = ARITH_RULE `~(v <= n) ==> (v <= SUC n) ==> v = SUC n` in let l2 = UNDISCH (UNDISCH l1) in STRIP_TAC THEN INDUCT_TAC THENL [ ARITH_TAC; (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN STRIP_TAC THEN (ASM_CASES_TAC `v <= (n:num)`) THENL [ ASM_MESON_TAC [POLY_DIVIDES_MUL3]; STRIP_TAC THEN STRIP_TAC THEN (MESON_TAC [l2;POLY_DIVIDES_MUL;POLY_DIVIDES_REFL]) ] ] ) (* * This one was suprisingly tricky to prove... *) let POLY_DIVIDES_POLY_EXP2 = prove( `!n p1 p2.(poly_divides p1 p2) ==> poly_divides (poly_exp p1 n) (poly_exp p2 n)`, let t0 = `!p1 p2. (?q. poly p2 = poly (p1 ** q)) ==> (?q. poly (poly_exp p2 n) = poly (poly_exp p1 n ** q))` in let l0 = ASSUME t0 in let l1 = UNDISCH (REWRITE_RULE [divides] (SPEC_ALL l0)) in let l3 = prove( `(x2 = x5 * x6 /\ x1 = x4 * x7) ==> (x1:real) * x2 = (x4 * x5) * x6 * x7`, MESON_TAC [REAL_MUL_SYM;REAL_MUL_ASSOC]) in (ONCE_REWRITE_TAC [divides]) THEN INDUCT_TAC THENL [ (MESON_TAC [divides;poly_exp;POLY_DIVIDES_REFL]); (STRIP_TAC THEN STRIP_TAC THEN DISCH_TAC) THEN (CHOOSE_TAC l1) THEN (UNDISCH_TAC `?q. poly p2 = poly (p1 ** q)`) THEN STRIP_TAC THEN (ONCE_REWRITE_TAC [poly_exp]) THEN (EXISTS_TAC `q ** q'`) THEN (REWRITE_TAC [poly_exp;FUN_EQ_THM;POLY_MUL]) THEN (ASM_MESON_TAC [l3;FUN_EQ_THM;POLY_MUL]) ] ) let POLY_EXP_ONE = prove( `!p .p = poly_exp p 1`, MESON_TAC [poly_exp;ARITH_RULE `1 = SUC 0`;POLY_MUL_RID] ) let POLY_DIVIDES_ROOT = prove( `!p a.poly_divides [--a;&1] p ==> (poly p a) = &0`, MESON_TAC [ORDER_ROOT;ORDER_DIVIDES;POLY_EXP_ONE; ARITH_RULE `1 <= ord ==> ~(ord = 0)`] ) let POLY_DIVIDES_PDI = prove( `!n p a. (poly_divides (poly_exp [--a;&1] (SUC n)) p) ==> (poly_divides [--a;&1] (poly_diff_iter p n))`, let t0 = `!p a. poly_divides (poly_exp [--a; &1] (SUC n)) p ==> poly_divides [--a; &1] (poly_diff_iter p n)` in let l0 = ASSUME t0 in let l1 = SPEC `poly_diff p` l0 in let l2 = SPECL [`p:(real)list`;`SUC n`;`a:real`] POLY_DIVIDES_POLY_DIFF in let l3 = UNDISCH l2 in let l4 = MATCH_MP l1 l3 in INDUCT_TAC THENL [ (SIMP_TAC [poly_exp;POLY_MUL_RID;Pm_lemma1.PDI_DEF]); (REPEAT STRIP_TAC) THEN (ASM_MESON_TAC [l4;Pm_lemma1.PDI_DEF;PDI_POLY_DIFF_COMM]) ] ) let POLY_DIVIDES_PDI2 = prove( `!n m p a. m > n ==> (poly_divides (poly_exp [--a;&1] m) p) ==> (poly_divides [--a;&1] (poly_diff_iter p n))`, MESON_TAC [POLY_EXP_DIVIDES;POLY_DIVIDES_PDI; ARITH_RULE `m > n <=> (SUC n) <= m`] ) let TAIL_GUNNER = prove( ` x < p ==> 1 <= v ==> v <= n ==> poly (poly_diff_iter (poly_exp [&0; &1] (p - 1) ** poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p) x) (&v) = &0 `, MESON_TAC [POLY_DIVIDES_ROOT; ARITH_RULE `x < p <=> (p:num) > x`; POLY_DIVIDES_PDI2; POLY_DIVIDES_MUL3; POLY_DIVIDES_POLY_EXP2; POLY_DIVIDES_POLY_MUL_ITER] ) let IS_INT_POLY = prove( `!p x.(integer x) ==> (ALL integer p) ==> integer (poly p x)`, LIST_INDUCT_TAC THEN (ASM_MESON_TAC [N_IS_INT;ALL;poly;INTEGER_ADD;INTEGER_MUL]) ) (* surprising the MESON needs so much help with the rewrites here * (i.e. i though i could just hit it with ASM_MESON_TAC with all four thms *) let INV_POLY_CMUL = prove( `!y x . (~(x = &0)) ==> (x) ## (inv x) ## y = y`, LIST_INDUCT_TAC THENL [ ASM_MESON_TAC [poly_cmul]; (REPEAT STRIP_TAC) THEN (REWRITE_TAC [poly_cmul;REAL_MUL_ASSOC]) THEN (ASM_MESON_TAC [REAL_MUL_RINV;REAL_MUL_LID]) ] ) let INV_POLY_CMUL2 = prove( `!y x . (~(x = &0)) ==> (inv x) ## (x) ## y = y`, MESON_TAC [INV_POLY_CMUL;REAL_INV_INV;REAL_INV_EQ_0] ) (* the final ASM_MESON_TAC fails if poly_cmul is rolled into the thm list *) let POLY_CMUL_EQUALS = prove( `!z x y. (~(z = &0)) ==> ((x = y) <=> (z ## x = z ## y))`, (REPEAT STRIP_TAC) THEN EQ_TAC THENL [ (SIMP_TAC[]); (SPEC_TAC (`x:(real)list`,`x:(real)list`)) THEN (SPEC_TAC (`y:(real)list`,`y:(real)list`)) THEN (LIST_INDUCT_TAC) THENL [ LIST_INDUCT_TAC THENL [ (SIMP_TAC [POLY_CMUL_CLAUSES]); (ASM_MESON_TAC [POLY_CMUL_CLAUSES;NOT_CONS_NIL])]; LIST_INDUCT_TAC THENL [ (ASM_MESON_TAC [POLY_CMUL_CLAUSES;NOT_CONS_NIL]); (ONCE_REWRITE_TAC [poly_cmul]) THEN (ASM_MESON_TAC [REAL_EQ_LCANCEL_IMP;CONS_11])] ] ] ) let PDI_LENGTH_THM = prove( `!f n. LENGTH(poly_diff_iter f n) = (LENGTH f) - n`, STRIP_TAC THEN INDUCT_TAC THENL [ (SIMP_TAC [Pm_lemma1.PDI_DEF;ARITH_RULE `(x:num) - 0 = x`]); (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN (ONCE_REWRITE_TAC [LENGTH_POLY_DIFF]) THEN ASM_ARITH_TAC ] ) let CAPTAINS_CLOTHES = prove( `! k q. (ALL integer q) ==> ? r .(ALL integer r) /\ r = (inv (&(FACT k))) ## (poly_diff_iter q k)` , let e0 = `(inv (&(FACT k))) ## (poly_diff_iter q k)` in let l1 = ONCE_REWRITE_RULE [GSYM (SPEC `inv (&(FACT k))` POLY_CMUL_LENGTH)] PDI_COEFF_FACT in let l2 = UNDISCH (SPEC_ALL l1) in let l3 = prove(`i < LENGTH( inv (&(FACT k)) ## poly_diff_iter q k) ==> (i + k) < LENGTH q`, MESON_TAC [PDI_LENGTH_THM;POLY_CMUL_LENGTH; ARITH_RULE `(i:num) < f -k ==> (i+k) < f`]) in (REPEAT STRIP_TAC) THEN (EXISTS_TAC e0) THEN (SIMP_TAC []) THEN (ASM_SIMP_TAC [ONCE_REWRITE_RULE [GSYM POLY_CMUL_LENGTH] POLY_CMUL_EL]) THEN (ONCE_REWRITE_TAC [GSYM ALL_EL]) THEN (REPEAT STRIP_TAC) THEN (ASM_SIMP_TAC [ONCE_REWRITE_RULE [GSYM POLY_CMUL_LENGTH] POLY_CMUL_EL]) THEN (ONCE_REWRITE_TAC [l2]) THEN (ONCE_REWRITE_TAC [REAL_MUL_ASSOC]) THEN (MATCH_MP_TAC INTEGER_MUL) THEN STRIP_TAC THENL [ (MESON_TAC [IS_INT_FACT_DIV_FACT_DIV_FACT;REAL_MUL_SYM;real_div;REAL_MUL_ASSOC]); (ASM_MESON_TAC [l3;ALL_IMP_EL]) ] ) let MESSY_JESSE2 = prove( `n > 0 ==> p > n ==> (? (Bs:num->num->real). ! v . (1 <= v) ==> (v <= n) ==> ( (! i . (integer (Bs v i))) /\ (poly (SOD (g n p)) (&v)) = ((real_of_num 1) / (&(FACT (p - 1)))) * (psum (0,LENGTH (g n p)) (\i. (&(FACT i)) * (Bs v i))) /\ (! i. (i < p) ==> (Bs v i) = &0) ))`, let root_canal = REAL_ARITH `(x:real) * (&0) = &0` in let bs = `\(v:num) . \(x:num). if (x <= (LENGTH (g n p)) ) then (poly ((inv (&(FACT x))) ## (poly_diff_iter (poly_exp [&0; &1] (p - 1) ** poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p) x)) (&v)) else (&0)` in let l0 = prove(`ALL integer [&0;&1]`,MESON_TAC [ALL;N_IS_INT]) in let t0 = `(poly_exp [&0; &1] (p - 1) ** poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p)` in let l2 = SPECL [`i:num`;t0] CAPTAINS_CLOTHES in let l3 = prove(`ALL integer (poly_exp [&0; &1] (p - 1) ** poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p)`,MESON_TAC[l0;ALL_IS_INT_POLY_MUL;ALL_IS_INT_POLY_EXP;ALL_IS_INT_POLY_MUL_ITER]) in let l4 = MP l2 l3 in let l7 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_EQ] FACT_NZ in let l8 = (SIMP_RULE [l7]) (SPEC `(&(FACT i)):real` POLY_CMUL_EQUALS) in (* these are not true for x =0, however we only use it for x= &(FACT i) *) let l10_0 = SPECL [`y:(real)list`;`(real_of_num (FACT i))`] INV_POLY_CMUL in let l12_0 = SPECL [`y:(real)list`;`(real_of_num (FACT i))`] INV_POLY_CMUL2 in let l10 = SIMP_RULE [REAL_FACT_NZ] l10_0 in let l12 = SIMP_RULE [REAL_FACT_NZ] l12_0 in let l9 = ONCE_REWRITE_RULE [l8] l4 in let l11 = GSYM (ONCE_REWRITE_RULE [l10] l9) in let l133 = prove(` (psum (0,m) (\i.(x i) * (if i <= m then (y i) else c))) = (psum (0,m) (\i.(x i) * (y i)))`, MESON_TAC [SUM_EQ;ARITH_RULE `(0 <= i /\ i < (m:num) + 0) ==> i <= m`]) in let l18 = MATCH_MP REAL_MUL_RINV (SPEC `i:num` l7) in let lass2 = SPECL [`g n p`;`x:real`;`v:real`] Pm_lemma2.PLANETMATH_LEMMA_2_B in let lass3 = BETA_RULE lass2 in let lass4 = CONV_RULE (RAND_CONV (RAND_CONV (REWRITE_CONV [Pm_eqn5.PLANETMATH_EQN_5]))) lass3 in let lass5 = REWRITE_RULE [POLY_CMUL;POLY_CMUL_PDI] lass4 in let lass6 = CONV_RULE (RAND_CONV (ONCE_REWRITE_CONV [GSYM (ISPEC `f:num->real` ETA_AX)])) (SPEC_ALL SUM_CMUL) in let lass7 = ONCE_REWRITE_RULE [GSYM REAL_MUL_ASSOC] lass5 in let lass8 = REWRITE_RULE [lass6] lass7 in let lass10 = ONCE_REWRITE_RULE [REAL_MUL_DIV_ASSOC] lass8 in let lass11 = ONCE_REWRITE_RULE [real_div] lass10 in let lass12 = REAL_ARITH `((w:real) * x * y) * z = w * x * y * z` in let lass13 = ONCE_REWRITE_RULE [lass12] lass11 in let lass14 = REWRITE_RULE [lass6] lass13 in let MUL_ONE = REAL_ARITH `! x.(&1) * x = x /\ x * (&1) = x` in let lass15 = SIMP_RULE [REAL_MUL_LINV;REAL_FACT_NZ;MUL_ONE] lass14 in STRIP_TAC THEN STRIP_TAC THEN (EXISTS_TAC bs) THEN (REPEAT STRIP_TAC) THENL [ (BETA_TAC THEN BETA_TAC) THEN (ASM_CASES_TAC `(i <= LENGTH (g n p))`) THENL [ (ASM_SIMP_TAC[]) THEN (ASM_CASES_TAC `((i:num) < p)`) THENL [ (ASM_MESON_TAC [POLY_CMUL;TAIL_GUNNER; N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]); (ASSUME_TAC (UNDISCH (ARITH_RULE `~(i < (p:num)) ==> (p <= i)`))) THEN (CHOOSE_TAC l11) THEN (SPLIT_CONJOINED_ASSUMPT_TAC (snd (dest_exists (concl l11)))) THEN (ASM_REWRITE_TAC[l12]) THEN (ASM_MESON_TAC [N_IS_INT;IS_INT_POLY]) ]; (ASM_MESON_TAC [N_IS_INT]) ]; (BETA_TAC) THEN (SIMP_TAC [l133]) THEN (SIMP_TAC [POLY_CMUL;l18;REAL_MUL_ASSOC;REAL_MUL_LID]) THEN (SIMP_TAC [lass15;REAL_INV_1OVER]); BETA_TAC THEN (ASM_MESON_TAC [TAIL_GUNNER;POLY_CMUL;root_canal]) ] ) let INTEGER_PSUM = prove( `!f m.(! i . i < m ==> integer (f i)) ==> (integer (psum (0,m) f))`, let l0 = ASSUME `!i. i < SUC m ==> integer (f i)` in let l1 = SPEC `m:num` l0 in let l2 = SIMP_RULE [ARITH_RULE `m < SUC m`] l1 in STRIP_TAC THEN INDUCT_TAC THENL [ (MESON_TAC [sum;int_of_num;int_of_num_th;N_IS_INT]); (SIMP_TAC [sum;ARITH_RULE `0 + (x:num) = x`]) THEN (STRIP_TAC) THEN (MATCH_MP_TAC INTEGER_ADD) THEN (ASM_MESON_TAC[l2;ARITH_RULE `(i:num) < m ==> i < SUC m`]) ] ) let INT_DIVIDES_PSUM = prove( `!f m p.(! i . i < m ==> ((integer (f i)) /\ (int_divides p (int_of_real (f i))))) ==> (int_divides p (int_of_real (psum (0,m) f)))`, let l0 = ASSUME `!i. i < SUC m ==> integer (f i) /\ p divides int_of_real (f i)` in let l1 = SPEC `m:num` l0 in let l2 = SIMP_RULE [ARITH_RULE `m < SUC m`] l1 in let l3 = ASSUME `(!i. i < m ==> integer (f i)) ==> integer (psum (0,m) f)` in let l4 = SPEC `i:num` l0 in let l5 = DISCH `i < SUC m` ((CONJUNCT1 (UNDISCH l4))) in let l8 = prove(`(!i.i < SUC m ==> (integer (f i))) ==> (!i.i < m ==> (integer (f i)))`, MESON_TAC [ARITH_RULE `i < m ==> i < SUC m`]) in let ll1 = MP l8 (GEN_ALL l5) in let ll2 = MP l3 ll1 in let ll3 = MATCH_MP INT_OF_REAL_ADD (CONJ ll2 (CONJUNCT1 l2)) in STRIP_TAC THEN INDUCT_TAC THENL [ (MESON_TAC [sum;int_of_num;int_of_num_th;INT_DIVIDES_0]); (SIMP_TAC [sum;ARITH_RULE `0 + (x:num) = x`]) THEN (ASSUME_TAC (SPECL [`f:num->real`;`m:num`] INTEGER_PSUM)) THEN (STRIP_TAC) THEN (STRIP_TAC) THEN (ONCE_REWRITE_TAC [ll3]) THEN (MATCH_MP_TAC INT_DIVIDES_ADD) THEN (CONJ_TAC) THENL [ (ASM_MESON_TAC [ARITH_RULE `i < m ==> i < SUC m`]); (ASM_MESON_TAC [ARITH_RULE `m < SUC m`]) ] ] ) let PLANET_MATH_beta = prove( `p > n ==> n > 0 ==> (! v. (1 <= v /\ v <= n) ==> ( (integer (poly (SOD (g n p )) (&v))) /\ ((&p) divides (int_of_real (poly (SOD (g n p )) (&v)))) ) )`, let l2 = GSYM (ONCE_REWRITE_RULE [REAL_MUL_SYM] real_div) in let ll3 = ARITH_RULE `(int_of_num p) * &0 = &0` in let l7 = UNDISCH (SPECL [`i:num`;`p:num`] IS_INT_FACT_DIV) in let l11 = prove(`p > 0 ==> FACT p = p * (FACT (p-1))`, MESON_TAC [FACT; ARITH_RULE `p > 0 ==> SUC (p -1) = p `]) in let l12 = UNDISCH (UNDISCH (ARITH_RULE `(p:num) > n ==> n > 0 ==> p > 0`)) in let l13 = MP l11 l12 in let t9 = `1 <= (v:num) ==> v <= (n:num) ==> (!v. 1 <= v ==> v <= n ==> (!i. integer (Bs v i)) /\ poly (SOD (g n p)) (&v) = &1 / &(FACT (p - 1)) * psum (0,LENGTH (g n p)) (\i. &(FACT i) * Bs v i) /\ (!i. i < p ==> Bs v i = &0)) ==> (integer (Bs v i))` in let lll0 = UNDISCH (UNDISCH (UNDISCH (prove(t9,MESON_TAC[])))) in let l8 = REWRITE_RULE [l13;real_div;REAL_INV_MUL] l7 in let l9 = REWRITE_RULE [N_IS_INT;GSYM REAL_OF_NUM_MUL] l8 in let l10 = REWRITE_RULE [REAL_INV_MUL] l9 in let l11 = MATCH_MP (INTEGER_MUL) (CONJ l10 lll0) in let l12 = MATCH_MP INT_OF_REAL_MUL (CONJ (SPEC `p:num` N_IS_INT) l11) in let l15 = GSYM l12 in let lll8 = ARITH_RULE `p > n ==> n > 0 ==> ~(p = 0)` in let lll9 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_EQ] lll8 in let lll10 = UNDISCH (UNDISCH lll9) in let sc1 = prove (`(~((x:real) = &0)) ==> (x * y * inv x) = y`, MESON_TAC [REAL_MUL_RID;REAL_MUL_ASSOC; REAL_MUL_SYM;REAL_MUL_LINV;REAL_MUL_LID]) in let sc2 = prove (`(~((x:real) = &0)) ==> (x * y * (inv x) * z) = y * z`, MESON_TAC [sc1;REAL_MUL_ASSOC]) in (REPEAT STRIP_TAC) THENL [ (CHOOSE_TAC (UNDISCH (UNDISCH MESSY_JESSE2))) THEN (ASM_SIMP_TAC []) THEN (ONCE_REWRITE_TAC [GSYM SUM_CMUL]) THEN (MATCH_MP_TAC INTEGER_PSUM) THEN (REPEAT STRIP_TAC) THEN BETA_TAC THEN (ASM_CASES_TAC `i < (p:num)`) THENL [ (ASM_SIMP_TAC [N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]); (ASSUME_TAC (UNDISCH (ARITH_RULE `(~((i:num) < p)) ==> i >= p-1`))) THEN (ASM_MESON_TAC [REAL_INV_1OVER;REAL_MUL_ASSOC; IS_INT_FACT_DIV; l2;INTEGER_MUL]) ]; (CHOOSE_TAC (UNDISCH (UNDISCH MESSY_JESSE2))) THEN (ASM_SIMP_TAC []) THEN (ONCE_REWRITE_TAC [GSYM SUM_CMUL]) THEN (MATCH_MP_TAC INT_DIVIDES_PSUM) THEN (REPEAT STRIP_TAC) THENL [ BETA_TAC THEN (ASM_CASES_TAC `i < (p:num)`) THENL [ (ASM_SIMP_TAC [N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]); (ASSUME_TAC (UNDISCH (ARITH_RULE `(~((i:num) < p)) ==> i >= p-1`))) THEN (ASM_MESON_TAC [REAL_INV_1OVER;REAL_MUL_ASSOC; IS_INT_FACT_DIV; l2;INTEGER_MUL]) ]; (ONCE_REWRITE_TAC [int_divides]) THEN BETA_TAC THEN (ASM_CASES_TAC `i < (p:num)`) THENL [ (ASM_SIMP_TAC [N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]) THEN (EXISTS_TAC `int_of_num 0`) THEN (MESON_TAC [ll3;int_of_num_th;int_of_num]); (ASSUME_TAC (UNDISCH (ARITH_RULE `(~((i:num) < p)) ==> i >= p`))) THEN (EXISTS_TAC `int_of_real (((&(FACT i))/(&(FACT p))) * (Bs (v:num) i))`) THEN (ONCE_REWRITE_TAC [int_of_num]) THEN (ONCE_REWRITE_TAC [l13]) THEN (ONCE_REWRITE_TAC [N_IS_INT;GSYM REAL_OF_NUM_MUL]) THEN (SIMP_TAC [ real_div]) THEN (ONCE_REWRITE_TAC [ REAL_INV_MUL]) THEN (ONCE_REWRITE_TAC [ REAL_MUL_LID]) THEN (ONCE_REWRITE_TAC [l15]) THEN (ASSUME_TAC lll10) THEN (ONCE_REWRITE_TAC [REAL_MUL_ASSOC]) THEN (ASM_MESON_TAC [sc2;REAL_MUL_SYM]) ] ] ] ) let JUNE_LEMMA = prove( `n > 0 ==> p > n ==> v <= n ==> integer (poly (SOD (g n p)) (&v))`, let lem0 = CONJUNCT1 (UNDISCH_ALL PLANET_MATH_alpha) in let lem1 = UNDISCH_ALL (SPEC_ALL (UNDISCH_ALL PLANET_MATH_beta)) in let lem2 = DISCH `1 <= v /\ v <= n` (CONJUNCT1 lem1) in let lem3 = SPEC `SUC v` (GEN `v:num` lem2) in let lem4 = SIMP_RULE [ARITH_RULE `1 <= SUC v`] lem3 in (STRIP_TAC THEN STRIP_TAC) THEN (SPEC_TAC (`v:num`,`v:num`)) THEN (INDUCT_TAC THENL [(SIMP_TAC [lem0]);(ACCEPT_TAC lem4)]) ) let DIVIDES_SUM_NOT_ZERO = prove( `!(x:int) (y:int) (z:int). (~(z divides x)) /\ (z divides y) ==> ~(x + y = &0)`, let l0 = ASSUME `(x:int) + y = &0` in let l1 = ONCE_REWRITE_RULE [ARITH_RULE `((x:int) + y = &0) <=> (x = --y)`] l0 in (REPEAT STRIP_TAC) THEN (UNDISCH_TAC `~((z:int) divides x)`) THEN (REWRITE_TAC [l1]) THEN (UNDISCH_TAC `((z:int) divides y)`) THEN (INTEGER_TAC) ) let NUM_OF_INT_ABS = prove( `!(x:num) (y:int).num_of_int (abs y) = x <=> abs y = &x`, (* stupid... *) let j0 = UNDISCH (prove(`(num_of_int (abs y) = x) ==> x = num_of_int (abs y)`,MESON_TAC [])) in let j1 = ARITH_RULE `&0 <= ((abs y):int)` in let j2 = MATCH_MP INT_OF_NUM_OF_INT j1 in (REPEAT STRIP_TAC) THEN EQ_TAC THENL [ (STRIP_TAC THEN SIMP_TAC [j0;j2]); (ASM_SIMP_TAC [NUM_OF_INT_OF_NUM])] ) let INT_DIVIDES_IMP_ABS_NUM_DIVIDES = prove( `! (x:int) (y:num). (x divides (&y)) ==> ((num_of_int (abs x)) divides y)`, let w0 = ARITH_RULE `((&0):int) <= abs x` in let w1 = fst (EQ_IMP_RULE (SPEC `abs (x:int)` NUM_OF_INT)) in let w2 = MP w1 w0 in let w3 = ARITH_RULE `((&0):int) <= x ==> abs x = x` in let w4 = ARITH_RULE `(~(((&0):int) <= x)) ==> abs x = -- x` in (REWRITE_TAC [int_divides;num_divides]) THEN (REPEAT STRIP_TAC) THEN (ASM_REWRITE_TAC [w2]) THEN (ASM_CASES_TAC `((&0):int) <= x`) THENL [ (ONCE_REWRITE_TAC [UNDISCH w3]) THEN (EXISTS_TAC `x':int`) THEN (REFL_TAC); (ONCE_REWRITE_TAC [UNDISCH w4]) THEN (EXISTS_TAC `--x':int`) THEN (ARITH_TAC) ] ) let INT_PRIME_NUM_PRIME = prove( `!p. int_prime (&p) <=> prime p`, (ONCE_REWRITE_TAC [int_prime;prime]) THEN (MESON_TAC [divides;num_divides; INT_ABS;INT_POS;INT_OF_NUM_EQ;INT_LT_IMP_NE;INT_GT; ARITH_RULE `2 <= p ==> abs((&p):int) > &1`; INT_DIVIDES_IMP_ABS_NUM_DIVIDES;NUM_OF_INT_ABS;PRIME_GE_2; prime;int_prime ]) ) let DIVIDES_INT_OF_REAL_ADD = prove( `!x y p.integer x /\ integer y /\ p divides (int_of_real x) /\ p divides (int_of_real y) ==> p divides (int_of_real (x + y))`, SIMP_TAC [INT_OF_REAL_ADD;INT_DIVIDES_ADD] ) let ITCHY_LEMMA = prove( `! f p n. (!v.1<= v /\ v <= n ==> integer (f v) /\ &p divides int_of_real (f v)) ==> (&p divides int_of_real (sum (1..n) f))`, let l0 = fst (EQ_IMP_RULE (SPECL [`1`;`0`] (GSYM NUMSEG_EMPTY))) in let l1 = INTEGER_RULE `&p divides ((&0))` in let l2 = SPEC `0` (GEN_ALL int_of_num) in let l3 = ONCE_REWRITE_RULE [l2] l1 in let l4 = SPECL [`f:num->real`;`n:num`;`1`] IS_INT_SUM in let l5 = prove(`(!v. 1 <= v /\ v <= SUC n ==> integer (f v)) ==> (!i. 1 <= i /\ i <= n ==> integer (f i))`,MESON_TAC [ARITH_RULE `v <= n ==> v <= SUC n`]) in let l6 = IMP_TRANS l5 l4 in let l7 = prove(`(!v. 1 <= v /\ v <= SUC n ==> (integer (f v)) /\ (&p) divides int_of_real (f v)) ==> (&p) divides int_of_real (f (SUC n))`,MESON_TAC [ARITH_RULE `1 <= (SUC n) /\ SUC n <= SUC n`]) in let l9 = prove(`(!v. 1 <= v /\ v <= SUC n ==> integer (f v)) ==> integer (f (SUC n))`,MESON_TAC [ARITH_RULE `1 <= SUC n /\ SUC n <= SUC n`]) in let tm = `\(v:num).integer (f v) /\ (&p) divides int_of_real (f v)` in let l10 = BETA_RULE (SPEC tm SHRIVER) in let l11 = UNDISCH (SPEC `1` (GEN `m:num` l10)) in STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [ SIMP_TAC [ARITH_RULE `0 < 1`;l0;SUM_CLAUSES;l3]; DISCH_TAC THEN (SIMP_TAC [SUM_CLAUSES_NUMSEG;ARITH_RULE `1 <= SUC n`]) THEN (MATCH_MP_TAC DIVIDES_INT_OF_REAL_ADD) THEN (CONJ_TAC) THENL [ ASM_SIMP_TAC [l6]; CONJ_TAC THENL [ ASM_SIMP_TAC [l9]; CONJ_TAC THENL [ ASM_SIMP_TAC [l11]; ASM_SIMP_TAC [l7] ]]]] ) let GOTTA_DO_DISHES_LEMMA = prove( `!(x:real) (y:real). (integer x) /\ (integer y) ==> (?(z:int).(~(z divides (int_of_real x))) /\ (z divides (int_of_real y))) ==> ~(x + y = &0)`, let mk_lemma x y = let lem0 = SPECL [x;y;`z:int`] DIVIDES_SUM_NOT_ZERO in let lem1 = TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)` in UNDISCH (UNDISCH (ONCE_REWRITE_RULE [lem1] lem0)) in let mk_tac x y = (ASM_REWRITE_TAC [GSYM int_of_num;INT_OF_REAL_NEG_INT_OF_NUM]) THEN (STRIP_TAC) THEN (REWRITE_TAC [GSYM int_neg_th;GSYM int_eq; GSYM int_add_th;GSYM int_of_num_th]) THEN (ACCEPT_TAC (mk_lemma x y)) in (ONCE_REWRITE_TAC [is_int]) THEN (STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC ) THENL [ mk_tac `(&n):int` `(&n'):int` ; mk_tac `(&n):int` `--(&n'):int` ; mk_tac `--(&n):int` `(&n'):int` ; mk_tac `--(&n):int` `--(&n'):int` ] ) let RAINY_DAY = prove( `! p x y. prime p ==> (&p) > x ==> integer x ==> x > (&0) ==> integer y ==> (((&p) divides (int_of_real (x * y))) <=> ((&p) divides int_of_real y))`, let ss3 = SPECL [`int_of_num n`;`(&p):int`] INT_PRIME_COPRIME_LT in let ss4 = ONCE_REWRITE_RULE [ARITH_RULE `abs ((&x):int) = &x`] ss3 in let ss40 = prove(`!(x:num) (y:num). (int_of_num x) < (int_of_num y) <=> (real_of_num x) < (real_of_num y)`,SIMP_TAC [INT_OF_NUM_LT;REAL_OF_NUM_LT]) in let ss5 = ONCE_REWRITE_RULE [ss40;INT_COPRIME_SYM;INT_PRIME_NUM_PRIME] ss4 in let ss6 = SPECL [`(&p):int`;`(&n):int`;`int_of_real y`] INT_COPRIME_DIVPROD in let ss7 = ONCE_REWRITE_RULE [TAUT `(X /\ Y ==> Z) <=> (Y ==> X ==> Z)`] ss6 in let ss8 = IMP_TRANS ss5 ss7 in let ss9 = ONCE_REWRITE_RULE [TAUT `(A /\ B /\ C ==> D ==> E) <=> (A ==> B ==> C ==> D ==> E)`] ss8 in let ss10 = UNDISCH ss9 in (REPEAT STRIP_TAC) THEN (ASM_SIMP_TAC [INT_OF_REAL_MUL]) THEN (EQ_TAC) THENL [ (SIMP_TAC [INT_DIVIDES_LMUL]) THEN (UNDISCH_TAC `integer x`) THEN (ONCE_REWRITE_TAC [is_int]) THEN (STRIP_TAC) THENL [ (ASM_REWRITE_TAC[]) THEN (ONCE_REWRITE_TAC [GSYM int_of_num]) THEN (UNDISCH_TAC `(&(p:num)) > (x:real)`) THEN (UNDISCH_TAC `(x:real) > &0`) THEN (ASM_REWRITE_TAC []) THEN (ONCE_REWRITE_TAC [REAL_ARITH `(y:real) > z <=> z < y`]) THEN (ACCEPT_TAC ss10); (ASM_ARITH_TAC) ]; (SIMP_TAC [INT_DIVIDES_LMUL]) ] ) let PLANET_MATH_gamma = prove( `n > 0 ==> p > n ==> prime p ==> &p > (EL 0 c) ==> (EL 0 c) > (&0) ==> n = PRE (LENGTH (c)) ==> (ALL integer c) ==> ( (integer (LHS c (g n p))) /\ ~((LHS c (g n p)) = &0))`, let lemma01 = SPECL [`\i. EL i c * poly (SOD (g n p)) (&i)`;`n:num`;`k:num` ] IS_INT_SUM in let lemma02 = BETA_RULE lemma01 in let lemma021 = UNDISCH JUNE_LEMMA in let lemma022 = UNDISCH_ALL (ARITH_RULE `n > 0 ==> p > n ==> p > 1`) in let lemma023 = DISCH_ALL (SIMP_RULE [lemma022] lemma021) in let lemma04 = UNDISCH (UNDISCH lemma023) in let lemma08 = ISPECL [`c:(real)list`;`v:num`;`integer`] ALL_IMP_EL in let lemma09 = ADD_ASSUM `n > 0` (UNDISCH lemma08) in let lemma10 = ADD_ASSUM `n = PRE (LENGTH (c:(real)list))` lemma09 in let lemma11 = ARITH_RULE `n > 0 ==> (n = PRE (LENGTH (c:(real)list))) ==> ((v < LENGTH c) <=> (v <= n))` in let lemma12 = UNDISCH (UNDISCH lemma11) in let lemma13 = ONCE_REWRITE_RULE [lemma12] lemma10 in let lemma15 = CONJ (UNDISCH (UNDISCH lemma04)) (UNDISCH lemma13) in let lemma16 = MATCH_MP INTEGER_MUL (ONCE_REWRITE_RULE [CONJ_SYM] lemma15) in let lemma17 = DISCH `v <= (n:num)` lemma16 in let lemma18 = ADD_ASSUM_DISCH `k <= (v:num)` lemma17 in let lemma19 = ONCE_REWRITE_RULE [TAUT `(X ==> Y ==> Z) <=> ((X /\ Y) ==> Z)`] lemma18 in let lemma20 = GEN `v:num` lemma19 in let lemma21 = GEN `k:num` (MATCH_MP lemma02 lemma20) in let lemma29 = SPEC `0` lemma21 in let lemma30 = GSYM (ASSUME `n = PRE (LENGTH (c:(real)list))`) in let lemma300 = SPECL [`f:(num -> real)`;`0`;`PRE (LENGTH (c:(real)list))`] SUM_CLAUSES_LEFT in let lemma31 = ADD_ASSUM `n > 0` (ADD_ASSUM `n = PRE (LENGTH (c:(real)list))` lemma300) in let lemma32 = MP lemma31 (ARITH_RULE `0 <= PRE (LENGTH (c:(real)list))`) in let lemma0000 = BRW `(X ==> Y ==> Z) <=> ((X /\ Y) ==> Z)` GOTTA_DO_DISHES_LEMMA in let lemmaa00 = UNDISCH PLANET_MATH_alpha in let lemmaa03 = ARITH_RULE `n >0 ==> ((n = PRE (LENGTH (c:(real)list))) ==> 0 < (LENGTH c))` in let lemmaa04 = ISPECL [`c:(real)list`;`0`;`integer`] ALL_IMP_EL in let lemmaa05 = MP (UNDISCH lemmaa04) (UNDISCH (UNDISCH lemmaa03)) in let c1 = ARITH_RULE `n > 0 ==> n = PRE (LENGTH (c:(real)list)) ==> 0 < (LENGTH (c:(real)list))` in let c2 = UNDISCH (UNDISCH c1) in let c3 = MP (UNDISCH lemmaa04) c2 in let c4 = CONJUNCT1 (UNDISCH (UNDISCH (UNDISCH PLANET_MATH_alpha))) in let c40 = CONJUNCT2 (UNDISCH (UNDISCH (UNDISCH PLANET_MATH_alpha))) in let c5 = SPECL [`p:num`;`(EL 0 c):real`;`poly (SOD (g n p)) (&0)`] RAINY_DAY in let c7 = ((UNDISCH (UNDISCH c5))) in let c8 = SIMP_RULE [c3] c7 in let c9 = UNDISCH c8 in let c10 = SIMP_RULE [c4] c9 in let d0 = UNDISCH PLANET_MATH_beta in let d1 = BRW `(X ==> Y ==> Z) <=> (Y ==> X ==> Z)` d0 in let d2 = SIMP_RULE [UNDISCH (ARITH_RULE `p > (n:num) ==> n > 0 ==> p > 1`)] d1 in let d3 = UNDISCH d2 in let d8 = CONJUNCT2 (UNDISCH (SPEC_ALL d3)) in let d9 = SPECL [`(&p):int`;`int_of_real (EL v c)`;`int_of_real (poly (SOD (g n p)) (&v))`] INT_DIVIDES_LMUL in let d10 = ADD_ASSUM `ALL integer c` d9 in let d11 = ADD_ASSUM `n = PRE (LENGTH (c:(real)list))` d10 in let d12 = ADD_ASSUM `1 <= v /\ v <= n` d11 in let d13 = CONJUNCT1 (UNDISCH (SPEC_ALL d3)) in let d14 = DISCH `1 <= v` (ADD_ASSUM `1 <= v` lemma13) in let d15 = BRW `(X ==> Y ==> Z) <=> (X /\ Y ==> Z)` d14 in let d16 = UNDISCH d15 in let d17 = CONJ d16 d13 in let d18 = GSYM (MATCH_MP INT_OF_REAL_MUL d17) in let d19 = ONCE_REWRITE_RULE [d18] d12 in let d20 = MP d19 d8 in let d21 = UNDISCH (SPECL [`1`;`v:num`] (GEN `k:num` lemma20)) in let d22 = CONJ d21 d20 in let d23 = DISCH `1 <=v /\ v <= n` d22 in let d24 = GEN `v:num` d23 in let d25 = MATCH_MP ITCHY_LEMMA d24 in ((REPEAT STRIP_TAC) THENL [ (ONCE_REWRITE_TAC [Pm_eqn4.LHS]) THEN (SIMP_TAC [lemma30;lemma29]); (UNDISCH_TAC `LHS c (g n p) = &0`) THEN (REWRITE_TAC [Pm_eqn4.LHS]) THEN (SIMP_TAC [lemma32;ARITH_RULE `0 + 1 = 1`]) THEN (ONCE_REWRITE_TAC [lemma30]) THEN (MATCH_MP_TAC lemma0000) THEN (CONJ_TAC) THENL [ (CONJ_TAC) THENL [ (MATCH_MP_TAC INTEGER_MUL) THEN (ASM_SIMP_TAC [lemmaa00;lemmaa05]); (ACCEPT_TAC (SPEC `1` lemma21)) ]; (EXISTS_TAC `(&p):int`) THEN (CONJ_TAC) THENL [(ONCE_REWRITE_TAC [c10]) THEN (ASM_SIMP_TAC [c40]); (ACCEPT_TAC d25) ] ] ] ) ) end;; module Finale = struct let IS_INT_NZ_ABS_GE_1 = prove ( `!x. ((integer x) /\ ~(x = &0)) ==> ~(abs x < &1)`, let lemmy0 = REAL_ARITH `(x:real) < y <=> ~(y <= x)` in let lemmy1 = ONCE_REWRITE_RULE [lemmy0] REAL_NZ_IMP_LT in let lemmy2 = REAL_ARITH `(real_neg x) = &0 <=> x = &0` in let lemmy3 = REAL_ARITH `&0 <= (real_neg x) <=> x <= &0` in (ONCE_REWRITE_TAC [is_int]) THEN (ONCE_REWRITE_TAC [TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`]) THEN (STRIP_TAC) THEN (STRIP_TAC) THENL [ (ASM_REWRITE_TAC[]) THEN (SIMP_TAC [REAL_ABS_NUM] ) THEN (ONCE_REWRITE_TAC [REAL_OF_NUM_LT;REAL_OF_NUM_EQ]) THEN (ARITH_TAC); (ASM_REWRITE_TAC[]) THEN (ONCE_REWRITE_TAC [real_abs]) THEN (ONCE_REWRITE_TAC [lemmy2;lemmy3]) THEN (ONCE_REWRITE_TAC [REAL_OF_NUM_EQ]) THEN (SIMP_TAC [lemmy1;REAL_NEG_NEG]) THEN (ONCE_REWRITE_TAC [REAL_OF_NUM_LT]) THEN (ARITH_TAC) ] ) let PBR_LEMMA = prove( `!n1 n2 n3 p. p > MAX n1 (MAX n2 n3) ==> (p > n1 /\ p > n2 /\ p > n3)`, (REWRITE_TAC [MAX]) THEN ARITH_TAC ) let BIGGER_PRIME_EXISTS = prove( `!(n:num). ?p. prime p /\ p > n`, let lem0 = prove(`{x | prime x} = prime`,SET_TAC[]) in let lem1 = ARITH_RULE `p > n <=> ~(p <= (n:num))` in MESON_TAC [PRIMES_INFINITE;lem0;lem1;IN_ELIM_THM;num_FINITE;INFINITE] ) let BUD_LEMMA = prove( `!(f:num->bool) (n1:num) (n2:num).((?(N:num) . !(p:num).p > N ==> f p) ==> (? (p0:num).prime p0 /\ p0 > n1 /\ p0 > n2 /\ f p0))`, let amigo3 = SPECL [`N:num`;`n1:num`;`n2:num`;`p:num`] PBR_LEMMA in let amigo4 = UNDISCH amigo3 in (REPEAT STRIP_TAC) THEN (CHOOSE_TAC (SPEC `MAX N (MAX n1 n2)` BIGGER_PRIME_EXISTS )) THEN (EXISTS_TAC `p:num`) THEN (UNDISCH_TAC `prime p /\ p > MAX N (MAX n1 n2)`) THEN (ONCE_REWRITE_TAC [TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`]) THEN (DISCH_TAC THEN DISCH_TAC) THEN (ASM_SIMP_TAC [amigo4]) ) let ALL_IMP_EL = prove( `! (l:(a)list) i P. (ALL P l) ==> (i < LENGTH l) ==> P (EL i l)`, SIMP_TAC[GSYM ALL_EL] ) let HAMMS_LEMMA = prove( `~(?c. ALL integer c /\ LENGTH c > 1 /\ EL 0 c > &0 /\ (!f. LHS c f = RHS c f))`, let erica0 = UNDISCH_ALL Pm_eqn4_lhs.PLANET_MATH_gamma in let erica1 = MATCH_MP IS_INT_NZ_ABS_GE_1 erica0 in let erica2 = ASM_REWRITE_RULE [] erica1 in let erica3 = SPEC_ALL Pm_eqn4_rhs.LT_ONE in let erica4 = MATCH_MP BUD_LEMMA erica3 in let erica5 = ADD_ASSUM `ALL integer c` erica4 in let erica8 = ARITH_RULE `(n = PRE (LENGTH (c:(real)list))) ==> n > 0 ==> 0 < (LENGTH c) ` in let erica9 = UNDISCH (UNDISCH erica8) in let erica10 = UNDISCH (ISPECL [`c:(real)list`;`0`;`integer`] ALL_IMP_EL) in let erica11 = MP erica10 erica9 in let erica12 = ONCE_REWRITE_RULE [is_int] erica11 in let erica13 = ARITH_RULE `!n. ~(( -- (real_of_num n)) > &0)` in let erica14 = prove( `n = PRE (LENGTH c) ==> n > 0 ==> ALL integer c ==> (EL 0 c) > &0 ==> ?n. EL 0 c = &n`, MESON_TAC [DISCH_ALL erica12;erica13] ) in let erica15 = UNDISCH_ALL erica14 in let sim0 = SELECT_RULE (ASSUME (concl erica15)) in let sim1 = DISCH (concl erica15) sim0 in let sim2 = MP sim1 erica15 in let erica18 = SPECL [`n:num`;`@n. EL 0 c = (real_of_num n)`] erica5 in let erica19 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_GT] erica18 in let erica20 = ONCE_REWRITE_RULE [GSYM sim2] erica19 in let erica21 = ONCE_REWRITE_RULE [REAL_OF_NUM_GT] erica20 in let erica22 = DISCH `(real_of_num p) > EL 0 c` erica2 in let erica23 = DISCH `(p:num) > n` erica22 in let erica24 = DISCH `prime (p:num)` erica23 in let erica25 = GEN `p:num` erica24 in let erica28 = UNDISCH (ARITH_RULE `n = PRE (LENGTH (c:(real)list)) ==> ((n > 0) <=> (LENGTH c) > 1)`) in let erica29 = UNDISCH (ONCE_REWRITE_RULE [erica28] (DISCH `n > 0` (erica25))) in let erica30 = UNDISCH (ONCE_REWRITE_RULE [erica28] (DISCH `n > 0` (erica21))) in (CONV_TAC NNF_CONV) THEN (REPEAT STRIP_TAC) THEN (ASM_MESON_TAC [DISCH_ALL erica29;DISCH_ALL erica30]) ) let TRANSCENDENTAL_E = prove( `transcendental (exp (&1))`, MESON_TAC [HAMMS_LEMMA;Pm_eqn4.PLANETMATH_EQN_4] ) end;; Finale.TRANSCENDENTAL_E;; hol-light/100/euler.ml000066400000000000000000000446201303454263000147210ustar00rootroot00000000000000(* ========================================================================= *) (* Euler's partition theorem and other elementary partition theorems. *) (* ========================================================================= *) loadt "Library/binary.ml";; (* ------------------------------------------------------------------------- *) (* Some lemmas. *) (* ------------------------------------------------------------------------- *) let NSUM_BOUND_LEMMA = prove (`!f a b n. nsum(a..b) f = n ==> !i. a <= i /\ i <= b ==> f(i) <= n`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN MATCH_MP_TAC NSUM_POS_BOUND THEN ASM_REWRITE_TAC[LE_REFL; FINITE_NUMSEG]);; let CARD_EQ_LEMMA = prove (`!f:A->B g s t. FINITE s /\ FINITE t /\ (!x. x IN s ==> f(x) IN t) /\ (!y. y IN t ==> g(y) IN s) /\ (!x. x IN s ==> g(f x) = x) /\ (!y. y IN t ==> f(g y) = y) ==> FINITE s /\ FINITE t /\ CARD s = CARD t`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN EXISTS_TAC `g:B->A` THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Breaking a number up into 2^something * odd_number. *) (* ------------------------------------------------------------------------- *) let index = define `index n = if n = 0 then 0 else if ODD n then 0 else SUC(index(n DIV 2))`;; let oddpart = define `oddpart n = if n = 0 then 0 else if ODD n then n else oddpart(n DIV 2)`;; let INDEX_ODDPART_WORK = prove (`!n. n = 2 EXP (index n) * oddpart n /\ (ODD(oddpart n) <=> ~(n = 0))`, MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[index; oddpart] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH; MULT_CLAUSES] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_ODD]) THEN SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; EXP; GSYM MULT_ASSOC; ARITH; ARITH_RULE `(2 * x) DIV 2 = x`; EQ_MULT_LCANCEL] THEN ASM_MESON_TAC[ARITH_RULE `~(n = 0) /\ n = 2 * m ==> m < n /\ ~(m = 0)`]);; let INDEX_ODDPART_DECOMPOSITION = prove (`!n. n = 2 EXP (index n) * oddpart n`, MESON_TAC[INDEX_ODDPART_WORK]);; let ODD_ODDPART = prove (`!n. ODD(oddpart n) <=> ~(n = 0)`, MESON_TAC[INDEX_ODDPART_WORK]);; let ODDPART_LE = prove (`!n. oddpart n <= n`, GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [INDEX_ODDPART_DECOMPOSITION] THEN MATCH_MP_TAC(ARITH_RULE `1 * x <= y * x ==> x <= y * x`) THEN REWRITE_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN REWRITE_TAC[EXP_EQ_0; ARITH]);; let INDEX_ODDPART_UNIQUE = prove (`!i m i' m'. ODD m /\ ODD m' ==> (2 EXP i * m = 2 EXP i' * m' <=> i = i' /\ m = m')`, REWRITE_TAC[ODD_EXISTS; ADD1] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM NUMPAIR; NUMPAIR_INJ] THEN ARITH_TAC);; let INDEX_ODDPART = prove (`!i m. ODD m ==> index(2 EXP i * m) = i /\ oddpart(2 EXP i * m) = m`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`i:num`; `m:num`; `index(2 EXP i * m)`; `oddpart(2 EXP i * m)`] INDEX_ODDPART_UNIQUE) THEN REWRITE_TAC[GSYM INDEX_ODDPART_DECOMPOSITION; ODD_ODDPART] THEN ASM_REWRITE_TAC[MULT_EQ_0; EXP_EQ_0; ARITH] THEN ASM_MESON_TAC[ODD]);; (* ------------------------------------------------------------------------- *) (* Partitions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("partitions",(12,"right"));; let partitions = new_definition `p partitions n <=> (!i. ~(p i = 0) ==> 1 <= i /\ i <= n) /\ nsum(1..n) (\i. p(i) * i) = n`;; let PARTITIONS_BOUND = prove (`!p n. p partitions n ==> !i. p(i) <= n`, REWRITE_TAC[GSYM NOT_LT] THEN SIMP_TAC[partitions] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 <= i /\ i <= n` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[ARITH_RULE `m < n ==> ~(n = 0)`]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `m = n ==> n < m ==> F`)) THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `nsum(1..n) (\j. if j = i then n else 0)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[NSUM_DELTA; IN_NUMSEG; LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC NSUM_LT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_0] THEN MATCH_MP_TAC LT_IMP_LE; EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC(ARITH_RULE `n < p /\ p * 1 <= p * k ==> n < p * k`) THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]);; let FINITE_PARTITIONS_LEMMA = prove (`!m n. FINITE {p | (!i. p(i) <= n) /\ !i. m <= i ==> p(i) = 0}`, INDUCT_TAC THEN GEN_TAC THENL [SIMP_TAC[LE_0; TAUT `a /\ b <=> ~(b ==> ~a)`] THEN SUBGOAL_THEN `{p | !i:num. p i = 0} = {(\n. 0)}` (fun th -> SIMP_TAC[th; FINITE_RULES]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN SUBGOAL_THEN `{p | (!i. p i <= n) /\ (!i. SUC m <= i ==> p i = 0)} = IMAGE (\(a,p) j. if j = m then a else p(j)) {a,p | a IN 0..n /\ p IN {p | (!i. p i <= n) /\ (!i. m <= i ==> p i = 0)}}` (fun t -> ASM_SIMP_TAC[t; FINITE_IMAGE; FINITE_PRODUCT; FINITE_NUMSEG]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN X_GEN_TAC `p:num->num` THEN EQ_TAC THENL [STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(p:num->num) m`; `\i:num. if i = m then 0 else p i`] THEN REWRITE_TAC[FUN_EQ_THM] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[PAIR_EQ; UNWIND_THM1; GSYM CONJ_ASSOC; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[LE; ARITH_RULE `m <= i /\ ~(i = m) ==> SUC m <= i`]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num`; `q:num->num`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN REWRITE_TAC[PAIR_EQ] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN ASM_MESON_TAC[ARITH_RULE `SUC m <= i ==> m <= i /\ ~(i = m)`]]);; let FINITE_PARTITIONS = prove (`!n. FINITE {p | p partitions n}`, GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p | (!i. p(i) <= n) /\ (!i. SUC n <= i ==> p(i) = 0)}` THEN SIMP_TAC[FINITE_PARTITIONS_LEMMA; IN_ELIM_THM; SUBSET; PARTITIONS_BOUND] THEN REWRITE_TAC[partitions; LE_SUC_LT] THEN MESON_TAC[NOT_LE]);; let FINITE_SUBSET_PARTITIONS = prove (`!P n. FINITE {p | p partitions n /\ P p}`, REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p | p partitions n}` THEN SIMP_TAC[FINITE_PARTITIONS; IN_ELIM_THM; SUBSET]);; (* ------------------------------------------------------------------------- *) (* Mappings between "odd only" and "all distinct" partitions. *) (* ------------------------------------------------------------------------- *) let odd_of_distinct = new_definition `odd_of_distinct p = \i. if ODD i then nsum {j | p(2 EXP j * i) = 1} (\j. 2 EXP j) else 0`;; let distinct_of_odd = new_definition `distinct_of_odd p = \i. if (index i) IN bitset (p(oddpart i)) then 1 else 0`;; (* ------------------------------------------------------------------------- *) (* The critical properties. *) (* ------------------------------------------------------------------------- *) let ODD_ODD_OF_DISTINCT = prove (`!p i. ~(odd_of_distinct p i = 0) ==> ODD i`, REWRITE_TAC[odd_of_distinct] THEN MESON_TAC[]);; let DISTINCT_DISTINCT_OF_ODD = prove (`!p i. distinct_of_odd p i <= 1`, REWRITE_TAC[distinct_of_odd] THEN ARITH_TAC);; let SUPPORT_ODD_OF_DISTINCT = prove (`!p. (!i. ~(p i = 0) ==> i <= n) ==> !i. ~(odd_of_distinct p i = 0) ==> 1 <= i /\ i <= n`, REPEAT STRIP_TAC THENL [ASM_MESON_TAC[ODD; ARITH_RULE `1 <= i <=> ~(i = 0)`; ODD_ODD_OF_DISTINCT]; FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))] THEN REWRITE_TAC[odd_of_distinct] THEN ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[LE_0] THEN SUBGOAL_THEN `FINITE {j | p (2 EXP j * i) = 1}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET] THEN X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_ELIM_THM; LE_0] THEN DISCH_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP j * i` THEN ASM_SIMP_TAC[ARITH_EQ] THEN MATCH_MP_TAC(ARITH_RULE `j < ej /\ ej * 1 <= ej * i ==> j <= ej * i`) THEN REWRITE_TAC[LT_POW2_REFL; LE_MULT_LCANCEL; EXP_EQ_0; ARITH] THEN UNDISCH_TAC `~(i = 0)` THEN ARITH_TAC; SIMP_TAC[ARITH_RULE `~((if p then x else 0) = 0) <=> p /\ ~(x = 0)`] THEN ASM_SIMP_TAC[NSUM_EQ_0_IFF; EXP_EQ_0; ARITH] THEN REWRITE_TAC[NOT_FORALL_THM; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `j:num`)) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP j * i` THEN ASM_SIMP_TAC[ARITH; ARITH_RULE `i <= j * i <=> 1 * i <= j * i`] THEN REWRITE_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= i <=> ~(i = 0)`] THEN REWRITE_TAC[EXP_EQ_0; ARITH]]);; let SUPPORT_DISTINCT_OF_ODD = prove (`!p. (!i. p(i) * i <= n) /\ (!i. ~(p i = 0) ==> ODD i) ==> !i. ~(distinct_of_odd p i = 0) ==> 1 <= i /\ i <= n`, REWRITE_TAC[distinct_of_odd] THEN REWRITE_TAC[ARITH_RULE `(if a then 1 else 0) = 0 <=> ~a`] THEN GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= i <=> ~(i = 0)`] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `index 0 IN bitset (p (oddpart 0))` THEN REWRITE_TAC[index; oddpart; ARITH] THEN UNDISCH_THEN `!i. ~(p i = 0) ==> ODD i` (MP_TAC o SPEC `0`) THEN SIMP_TAC[ARITH; BITSET_0; NOT_IN_EMPTY]; ALL_TAC] THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BITSET_BOUND_LEMMA) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p(oddpart i) * oddpart i` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [INDEX_ODDPART_DECOMPOSITION] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL]);; let ODD_OF_DISTINCT_OF_ODD = prove (`!p. (!i. ~(p(i) = 0) ==> ODD i) ==> odd_of_distinct (distinct_of_odd p) = p`, REWRITE_TAC[IN_ELIM_THM; odd_of_distinct; distinct_of_odd] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_SIMP_TAC[INDEX_ODDPART] THEN GEN_REWRITE_TAC RAND_CONV [GSYM BINARYSUM_BITSET] THEN REWRITE_TAC[binarysum] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ]);; let DISTINCT_OF_ODD_OF_DISTINCT = prove (`!p. (!i. ~(p i = 0) ==> 1 <= i /\ i <= n) /\ (!i. p(i) <= 1) ==> distinct_of_odd (odd_of_distinct p) = p`, REWRITE_TAC[distinct_of_odd; odd_of_distinct; IN_ELIM_THM] THEN REWRITE_TAC[partitions; ODD_ODDPART] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[BITSET_0; NOT_IN_EMPTY] THENL [ASM_MESON_TAC[ARITH_RULE `~(1 <= 0)`]; ALL_TAC] THEN SUBGOAL_THEN `FINITE {j | p (2 EXP j * oddpart i) = 1}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN REWRITE_TAC[LE_0] THEN MATCH_MP_TAC(ARITH_RULE `!x. y <= x /\ 1 <= x /\ x <= n ==> y <= n`) THEN EXISTS_TAC `2 EXP j * oddpart i` THEN ASM_SIMP_TAC[ARITH] THEN MATCH_MP_TAC(ARITH_RULE `j < ej /\ 1 * ej <= i * ej ==> j <= ej * i`) THEN REWRITE_TAC[LT_POW2_REFL; LE_MULT_RCANCEL] THEN ASM_MESON_TAC[ODD_ODDPART; ODD; ARITH_RULE `1 <= n <=> ~(n = 0)`]; ASM_SIMP_TAC[BITSET_BINARYSUM; GSYM binarysum; IN_ELIM_THM] THEN REWRITE_TAC[GSYM INDEX_ODDPART_DECOMPOSITION] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN ASM_MESON_TAC[ARITH_RULE `i <= 1 ==> i = 0 \/ i = 1`]]);; let NSUM_DISTINCT_OF_ODD = prove (`!p. (!i. ~(p i = 0) ==> 1 <= i /\ i <= n) /\ (!i. p(i) * i <= n) /\ (!i. ~(p(i) = 0) ==> ODD i) ==> nsum(1..n) (\i. distinct_of_odd p i * i) = nsum(1..n) (\i. p i * i)`, REPEAT STRIP_TAC THEN REWRITE_TAC[distinct_of_odd] THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV o LAND_CONV) [GSYM BINARYSUM_BITSET] THEN REWRITE_TAC[binarysum] THEN REWRITE_TAC[GSYM NSUM_RMUL] THEN SIMP_TAC[NSUM_NSUM_PRODUCT; FINITE_BITSET; FINITE_NUMSEG] THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM NSUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_ADD] THEN SUBGOAL_THEN `{x | x IN {i,j | i IN 1..n /\ j IN bitset(p i)} /\ ~((\(i,j). 2 EXP j * i) x = 0)} = {i,j | i IN 1..n /\ j IN bitset(p i)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_NUMSEG; EXP_EQ_0; MULT_EQ_0; ARITH] THEN MESON_TAC[ARITH_RULE `~(1 <= 0)`]; ALL_TAC] THEN SUBGOAL_THEN `{x | x IN 1 .. n /\ ~((if index x IN bitset (p (oddpart x)) then 1 else 0) * x = 0)} = {i | i IN 1..n /\ (index i) IN bitset (p(oddpart i))}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; MULT_EQ_0] THEN REWRITE_TAC[IN_NUMSEG; ARITH_RULE `(if p then 1 else 0) = 0 <=> ~p`] THEN MESON_TAC[ARITH_RULE `~(1 <= 0)`]; ALL_TAC] THEN MATCH_MP_TAC NSUM_EQ_GENERAL THEN EXISTS_TAC `\(i,b). 2 EXP b * i` THEN SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[ARITH_RULE `(if p then 1 else 0) * x * y = (if p then x * y else 0)`] THEN GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [IN_ELIM_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> a /\ b /\ (b ==> c)`] THEN SIMP_TAC[] THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN SUBGOAL_THEN `!i j. j IN bitset(p i) ==> ODD i` ASSUME_TAC THENL [ASM_MESON_TAC[BITSET_0; NOT_IN_EMPTY]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `m:num` THEN STRIP_TAC THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`oddpart m`; `index m`] THEN ASM_REWRITE_TAC[GSYM INDEX_ODDPART_DECOMPOSITION] THEN ASM_MESON_TAC[ODDPART_LE; LE_TRANS; ARITH_RULE `1 <= x <=> ~(x = 0)`; ODD_ODDPART; ODD]; ASM_MESON_TAC[INDEX_ODDPART_UNIQUE]]; MAP_EVERY X_GEN_TAC [`m:num`; `i:num`] THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INDEX_ODDPART]] THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN REWRITE_TAC[MULT_EQ_0; EXP_EQ_0; ARITH] THEN ASM_MESON_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`]; ASM_MESON_TAC[BITSET_BOUND_LEMMA; LE_MULT_RCANCEL; LE_TRANS]]]);; let DISTINCT_OF_ODD = prove (`!p. p IN {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i} ==> (distinct_of_odd p) IN {p | p partitions n /\ !i. p(i) <= 1}`, GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; partitions] THEN STRIP_TAC THEN REWRITE_TAC[DISTINCT_DISTINCT_OF_ODD] THEN CONJ_TAC THENL [MATCH_MP_TAC SUPPORT_DISTINCT_OF_ODD; FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC NSUM_DISTINCT_OF_ODD] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(p:num->num) i = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LE_0] THEN ASM_MESON_TAC[NSUM_BOUND_LEMMA]);; let ODD_OF_DISTINCT = prove (`!p. p IN {p | p partitions n /\ !i. p(i) <= 1} ==> (odd_of_distinct p) IN {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i}`, GEN_TAC THEN REWRITE_TAC[partitions; IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[ODD_ODD_OF_DISTINCT] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUPPORT_ODD_OF_DISTINCT]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `nsum(1..n) (\i. distinct_of_odd(odd_of_distinct p) i * i)` THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN ASM_MESON_TAC[DISTINCT_OF_ODD_OF_DISTINCT]] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC NSUM_DISTINCT_OF_ODD THEN REWRITE_TAC[ODD_ODD_OF_DISTINCT] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUPPORT_ODD_OF_DISTINCT]; ALL_TAC] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[odd_of_distinct] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_0; MULT_CLAUSES] THEN REWRITE_TAC[GSYM NSUM_RMUL] THEN SUBGOAL_THEN `FINITE {i:num | p(i) = 1}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..n` THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[o_DEF] `(\j. j) o (\j. 2 EXP j * i)`)] THEN ASM_SIMP_TAC[GSYM NSUM_IMAGE; INDEX_ODDPART_UNIQUE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `nsum {i | p(i) = 1} (\j. j)` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `nsum {i | p(i) = 1} (\j. p(j) * j)` THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_IMP_LE THEN MATCH_MP_TAC NSUM_EQ THEN SIMP_TAC[IN_ELIM_THM; MULT_CLAUSES]; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`]]);; (* ------------------------------------------------------------------------- *) (* Euler's partition theorem: *) (* *) (* The number of partitions into distinct numbers is equal to the number of *) (* partitions into odd numbers (and there are only finitely many of each). *) (* ------------------------------------------------------------------------- *) let EULER_PARTITION_THEOREM = prove (`FINITE {p | p partitions n /\ !i. p(i) <= 1} /\ FINITE {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i} /\ CARD {p | p partitions n /\ !i. p(i) <= 1} = CARD {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i}`, MATCH_MP_TAC CARD_EQ_LEMMA THEN REWRITE_TAC[FINITE_SUBSET_PARTITIONS] THEN MAP_EVERY EXISTS_TAC [`odd_of_distinct`; `distinct_of_odd`] THEN REWRITE_TAC[ODD_OF_DISTINCT; DISTINCT_OF_ODD] THEN CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM; partitions] THEN STRIP_TAC THENL [MATCH_MP_TAC DISTINCT_OF_ODD_OF_DISTINCT; MATCH_MP_TAC ODD_OF_DISTINCT_OF_ODD] THEN ASM_REWRITE_TAC[]);; hol-light/100/feuerbach.ml000066400000000000000000000255721303454263000155360ustar00rootroot00000000000000(* ========================================================================= *) (* Feuerbach's theorem. *) (* ========================================================================= *) needs "Multivariate/convex.ml";; (* ------------------------------------------------------------------------- *) (* Algebraic condition for two circles to be tangent to each other. *) (* ------------------------------------------------------------------------- *) let CIRCLES_TANGENT = prove (`!r1 r2 c1 c2. &0 <= r1 /\ &0 <= r2 /\ (dist(c1,c2) = r1 + r2 \/ dist(c1,c2) = abs(r1 - r2)) ==> c1 = c2 /\ r1 = r2 \/ ?!x:real^2. dist(c1,x) = r1 /\ dist(c2,x) = r2`, MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!x y. P x y <=> Q y x) ==> ((!x y. P x y) <=> (!x y. Q x y))`) THEN MESON_TAC[DIST_SYM; REAL_ADD_SYM; REAL_ABS_SUB]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `r1 = &0` THENL [ASM_REWRITE_TAC[DIST_EQ_0; MESON[] `(?!x. a = x /\ P x) <=> P a`] THEN REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `r2 = &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_ARITH `r1 <= r2 ==> abs(r1 - r2) = r2 - r1`] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THENL [DISJ2_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN EXISTS_TAC `c1 + r1 / (r1 + r2) % (c2 - c1):real^2` THEN CONJ_TAC THENL [REWRITE_TAC[dist; VECTOR_ARITH `c1 - (c1 + a % (x - y)):real^2 = a % (y - x)`; VECTOR_ARITH `z - (x + a % (z - x)):real^N = (a - &1) % (x - z)`] THEN ASM_REWRITE_TAC[NORM_MUL; GSYM dist] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NEG; REAL_FIELD `&0 < r1 /\ &0 < r2 ==> r1 / (r1 + r2) - &1 = --r2 / (r1 + r2)`] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LT_ADD] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; X_GEN_TAC `y:real^2` THEN STRIP_TAC THEN SUBGOAL_THEN `(y:real^2) IN segment[c1,c2]` MP_TAC THENL [ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN ASM_MESON_TAC[DIST_SYM]; REWRITE_TAC[IN_SEGMENT]] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `dist(c1:real^2,(&1 - u) % c1 + u % c2) = r1` THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % c1 + u % c2:real^N = c1 + u % (c2 - c1)`] THEN REWRITE_TAC[NORM_ARITH `dist(x:real^2,x + y) = norm y`] THEN ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN REWRITE_TAC[VECTOR_ARITH `--(a % (x - y)):real^N = a % (y - x)`] THEN ASM_REWRITE_TAC[NORM_MUL; GSYM dist; real_abs] THEN DISCH_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]; ASM_CASES_TAC `r1:real = r2` THENL [ASM_MESON_TAC[REAL_SUB_REFL; DIST_EQ_0]; DISJ2_TAC] THEN SUBGOAL_THEN `r1 < r2` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN EXISTS_TAC `c2 + r2 / (r2 - r1) % (c1 - c2):real^2` THEN CONJ_TAC THENL [REWRITE_TAC[dist; VECTOR_ARITH `c1 - (c1 + a % (x - y)):real^2 = --(a % (x - y)) /\ c1 - (c2 + a % (c1 - c2)):real^2 = (&1 - a) % (c1 - c2)`] THEN ASM_REWRITE_TAC[NORM_MUL; NORM_NEG; GSYM dist] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NEG; REAL_FIELD `r1 < r2 ==> &1 - r2 / (r2 - r1) = --(r1 / (r2 - r1))`] THEN ASM_SIMP_TAC[real_abs; REAL_SUB_LE; REAL_LT_IMP_LE] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; X_GEN_TAC `y:real^2` THEN STRIP_TAC THEN SUBGOAL_THEN `(c1:real^2) IN segment[c2,y]` MP_TAC THENL [ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_SEGMENT]] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `u = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; REAL_SUB_RZERO] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN ASM_MESON_TAC[DIST_EQ_0; REAL_SUB_0]; ALL_TAC] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `dist((&1 - u) % c2 + u % y:real^2,c2) = r2 - r1` THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % c1 + u % c2:real^N = c1 + u % (c2 - c1)`] THEN REWRITE_TAC[NORM_ARITH `dist(x + y:real^2,x) = norm y`] THEN ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN REWRITE_TAC[VECTOR_ARITH `--(a % (x - y)):real^N = a % (y - x)`] THEN ASM_REWRITE_TAC[NORM_MUL; GSYM dist; real_abs] THEN REWRITE_TAC[VECTOR_ARITH `c + v % ((c + u % (y - c)) - c):real^2 = c + v % u % (y - c)`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH `y:real^2 = c + u % v % (y - c) <=> (&1 - u * v) % (y - c) = vec 0`] THEN DISJ1_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]]);; (* ------------------------------------------------------------------------- *) (* Feuerbach's theorem *) (* *) (* Given a non-degenerate triangle abc, let the circle passing through *) (* the midpoints of its sides (the "9 point circle") have center "ncenter" *) (* and radius "nradius". Now suppose the circle with center "icenter" and *) (* radius "iradius" is tangent to three sides (either internally or *) (* externally to one side and two produced sides), meaning that it's either *) (* the inscribed circle or one of the three escribed circles. Then the two *) (* circles are tangent to each other, i.e. either they are identical or they *) (* touch at exactly one point. *) (* ------------------------------------------------------------------------- *) let FEUERBACH = prove (`!a b c mbc mac mab pbc pac pab ncenter icenter nradius iradius. ~(collinear {a,b,c}) /\ midpoint(a,b) = mab /\ midpoint(b,c) = mbc /\ midpoint(c,a) = mac /\ dist(ncenter,mbc) = nradius /\ dist(ncenter,mac) = nradius /\ dist(ncenter,mab) = nradius /\ dist(icenter,pbc) = iradius /\ dist(icenter,pac) = iradius /\ dist(icenter,pab) = iradius /\ collinear {a,b,pab} /\ orthogonal (a - b) (icenter - pab) /\ collinear {b,c,pbc} /\ orthogonal (b - c) (icenter - pbc) /\ collinear {a,c,pac} /\ orthogonal (a - c) (icenter - pac) ==> ncenter = icenter /\ nradius = iradius \/ ?!x:real^2. dist(ncenter,x) = nradius /\ dist(icenter,x) = iradius`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CIRCLES_TANGENT THEN POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ALL_TAC; ASM_MESON_TAC[DIST_POS_LE]]) [`&0 <= nradius`; `&0 <= iradius`] THEN ASM_REWRITE_TAC[dist; NORM_EQ_SQUARE] THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_ABS_POS; GSYM NORM_POW_2; GSYM dist] THEN REWRITE_TAC[REAL_POW2_ABS] THEN POP_ASSUM_LIST(K ALL_TAC) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> b /\ c /\ d /\ a /\ e`] THEN GEOM_ORIGIN_TAC `a:real^2` THEN GEOM_NORMALIZE_TAC `b:real^2` THEN CONJ_TAC THENL [REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^2` THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH; real_abs] THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC)) THEN REWRITE_TAC[COLLINEAR_3_2D] THEN REWRITE_TAC[orthogonal; dist; NORM_POW_2] THEN ASM_REWRITE_TAC[midpoint] THEN REWRITE_TAC[DOT_2; DOT_LSUB; DOT_RSUB] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VEC_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* As a little bonus, verify that the circle passing through the *) (* midpoints of the sides is indeed a 9-point circle, i.e. it passes *) (* through the feet of the altitudes and the midpoints of the lines joining *) (* the vertices to the orthocenter (where the alititudes intersect). *) (* ------------------------------------------------------------------------- *) let NINE_POINT_CIRCLE_1 = prove (`!a b c:real^2 mbc mac mab fbc fac fab ncenter nradius. ~(collinear {a,b,c}) /\ midpoint(a,b) = mab /\ midpoint(b,c) = mbc /\ midpoint(c,a) = mac /\ dist(ncenter,mbc) = nradius /\ dist(ncenter,mac) = nradius /\ dist(ncenter,mab) = nradius /\ collinear {a,b,fab} /\ orthogonal (a - b) (c - fab) /\ collinear {b,c,fbc} /\ orthogonal (b - c) (a - fbc) /\ collinear {c,a,fac} /\ orthogonal (c - a) (b - fac) ==> dist(ncenter,fab) = nradius /\ dist(ncenter,fbc) = nradius /\ dist(ncenter,fac) = nradius`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> b /\ c /\ d /\ a /\ e`] THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC)) THEN ASM_REWRITE_TAC[dist; NORM_EQ_SQUARE; REAL_POS] THEN REWRITE_TAC[COLLINEAR_3_2D] THEN REWRITE_TAC[orthogonal; dist; NORM_POW_2] THEN ASM_REWRITE_TAC[midpoint] THEN REWRITE_TAC[DOT_2; DOT_LSUB; DOT_RSUB] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN SIMP_TAC[] THEN CONV_TAC REAL_RING);; let NINE_POINT_CIRCLE_2 = prove (`!a b c:real^2 mbc mac mab fbc fac fab ncenter nradius. ~(collinear {a,b,c}) /\ midpoint(a,b) = mab /\ midpoint(b,c) = mbc /\ midpoint(c,a) = mac /\ dist(ncenter,mbc) = nradius /\ dist(ncenter,mac) = nradius /\ dist(ncenter,mab) = nradius /\ collinear {a,b,fab} /\ orthogonal (a - b) (c - fab) /\ collinear {b,c,fbc} /\ orthogonal (b - c) (a - fbc) /\ collinear {c,a,fac} /\ orthogonal (c - a) (b - fac) /\ collinear {oc,a,fbc} /\ collinear {oc,b,fac} /\ collinear{oc,c,fab} ==> dist(ncenter,midpoint(oc,a)) = nradius /\ dist(ncenter,midpoint(oc,b)) = nradius /\ dist(ncenter,midpoint(oc,c)) = nradius`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> b /\ c /\ d /\ a /\ e`] THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC)) THEN ASM_REWRITE_TAC[dist; NORM_EQ_SQUARE; REAL_POS] THEN REWRITE_TAC[COLLINEAR_3_2D] THEN REWRITE_TAC[orthogonal; dist; NORM_POW_2] THEN ASM_REWRITE_TAC[midpoint] THEN REWRITE_TAC[DOT_2; DOT_LSUB; DOT_RSUB] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN SIMP_TAC[] THEN CONV_TAC REAL_RING);; hol-light/100/four_squares.ml000066400000000000000000001301451303454263000163210ustar00rootroot00000000000000(* ========================================================================= *) (* Theorems about representations as sums of 2 and 4 squares. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/analysis.ml";; (*** only for REAL_ARCH_LEAST! ***) prioritize_num();; (* ------------------------------------------------------------------------- *) (* Definition of involution and various basic lemmas. *) (* ------------------------------------------------------------------------- *) let involution = new_definition `involution f s = !x. x IN s ==> f(x) IN s /\ (f(f(x)) = x)`;; let INVOLUTION_IMAGE = prove (`!f s. involution f s ==> (IMAGE f s = s)`, REWRITE_TAC[involution; EXTENSION; IN_IMAGE] THEN MESON_TAC[]);; let INVOLUTION_DELETE = prove (`involution f s /\ a IN s /\ (f a = a) ==> involution f (s DELETE a)`, REWRITE_TAC[involution; IN_DELETE] THEN MESON_TAC[]);; let INVOLUTION_STEPDOWN = prove (`involution f s /\ a IN s ==> involution f (s DIFF {a, (f a)})`, REWRITE_TAC[involution; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; let INVOLUTION_NOFIXES = prove (`involution f s ==> involution f {x | x IN s /\ ~(f x = x)}`, REWRITE_TAC[involution; IN_ELIM_THM] THEN MESON_TAC[]);; let INVOLUTION_SUBSET = prove (`!f s t. involution f s /\ (!x. x IN t ==> f(x) IN t) /\ t SUBSET s ==> involution f t`, REWRITE_TAC[involution; SUBSET] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Involution with no fixpoints can only occur on finite set of even card *) (* ------------------------------------------------------------------------- *) let INVOLUTION_EVEN_STEP = prove (`FINITE(s) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) /\ a IN s ==> FINITE(s DIFF {a, (f a)}) /\ involution f (s DIFF {a, (f a)}) /\ (!x:A. x IN (s DIFF {a, (f a)}) ==> ~(f x = x)) /\ (CARD s = CARD(s DIFF {a, (f a)}) + 2)`, SIMP_TAC[FINITE_DIFF; INVOLUTION_STEPDOWN; IN_DIFF] THEN STRIP_TAC THEN SUBGOAL_THEN `s = (a:A) INSERT (f a) INSERT (s DIFF {a, (f a)})` MP_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN ASM_MESON_TAC[involution]; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DIFF; FINITE_INSERT] THEN ASM_SIMP_TAC[IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN ARITH_TAC);; let INVOLUTION_EVEN_INDUCT = prove (`!n s. FINITE(s) /\ (CARD s = n) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) ==> EVEN(CARD s)`, MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[CARD_CLAUSES; ARITH] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EXTENSION]) THEN REWRITE_TAC[NOT_IN_EMPTY; NOT_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(s DIFF {a:A, (f a)})`) THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `s DIFF {a:A, (f a)}`) THEN MP_TAC INVOLUTION_EVEN_STEP THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n < n + 2`] THEN SIMP_TAC[EVEN_ADD; ARITH]);; let INVOLUTION_EVEN = prove (`!s. FINITE(s) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) ==> EVEN(CARD s)`, MESON_TAC[INVOLUTION_EVEN_INDUCT]);; (* ------------------------------------------------------------------------- *) (* So an involution with exactly one fixpoint has odd card domain. *) (* ------------------------------------------------------------------------- *) let INVOLUTION_FIX_ODD = prove (`FINITE(s) /\ involution f s /\ (?!a:A. a IN s /\ (f a = a)) ==> ODD(CARD s)`, REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN STRIP_TAC THEN SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; IN_DELETE; ODD; NOT_ODD] THEN MATCH_MP_TAC INVOLUTION_EVEN THEN ASM_SIMP_TAC[INVOLUTION_DELETE; FINITE_DELETE; IN_DELETE] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* And an involution on a set of odd finite card must have a fixpoint. *) (* ------------------------------------------------------------------------- *) let INVOLUTION_ODD = prove (`!n s. FINITE(s) /\ involution f s /\ ODD(CARD s) ==> ?a. a IN s /\ (f a = a)`, REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[INVOLUTION_EVEN]);; (* ------------------------------------------------------------------------- *) (* Consequently, if one involution has a unique fixpoint, other has one. *) (* ------------------------------------------------------------------------- *) let INVOLUTION_FIX_FIX = prove (`!f g s. FINITE(s) /\ involution f s /\ involution g s /\ (?!x. x IN s /\ (f x = x)) ==> ?x. x IN s /\ (g x = x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INVOLUTION_ODD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INVOLUTION_FIX_ODD THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Formalization of Zagier's "one-sentence" proof over the natural numbers. *) (* ------------------------------------------------------------------------- *) let zset = new_definition `zset(a) = {(x,y,z) | x EXP 2 + 4 * y * z = a}`;; let zag = new_definition `zag(x,y,z) = if x + z < y then (x + 2 * z,z,y - (x + z)) else if x < 2 * y then (2 * y - x, y, (x + z) - y) else (x - 2 * y,(x + z) - y, y)`;; let tag = new_definition `tag((x,y,z):num#num#num) = (x,z,y)`;; let ZAG_INVOLUTION_GENERAL = prove (`0 < x /\ 0 < y /\ 0 < z ==> (zag(zag(x,y,z)) = (x,y,z))`, REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[PAIR_EQ] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; let IN_TRIPLE = prove (`(a,b,c) IN {(x,y,z) | P x y z} <=> P a b c`, REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[]);; let PRIME_SQUARE = prove (`!n. ~prime(n * n)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[PRIME_0; MULT_CLAUSES] THEN REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[ARITH] THEN DISJ2_TAC THEN EXISTS_TAC `n:num` THEN ASM_SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [ARITH_RULE `n = n * 1`] THEN ASM_SIMP_TAC[EQ_MULT_LCANCEL]);; let PRIME_4X = prove (`!n. ~prime(4 * n)`, GEN_TAC THEN REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN DISJ2_TAC THEN EXISTS_TAC `2` THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN ASM_SIMP_TAC[GSYM MULT_ASSOC; DIVIDES_RMUL; DIVIDES_REFL; ARITH_EQ] THEN ASM_CASES_TAC `n = 0` THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let PRIME_XYZ_NONZERO = prove (`prime(x EXP 2 + 4 * y * z) ==> 0 < x /\ 0 < y /\ 0 < z`, CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM; ARITH_RULE `~(0 < x) = (x = 0)`] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES; PRIME_SQUARE; PRIME_4X]);; let ZAG_INVOLUTION = prove (`!p. prime(p) ==> involution zag (zset(p))`, REPEAT STRIP_TAC THEN REWRITE_TAC[involution; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN REWRITE_TAC[zset; IN_TRIPLE] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN CONJ_TAC THENL [REWRITE_TAC[zag] THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_TRIPLE] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN ASM_SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD; EXP_2; GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_SUB; LT_IMP_LE] THEN INT_ARITH_TAC; MATCH_MP_TAC ZAG_INVOLUTION_GENERAL THEN ASM_MESON_TAC[PRIME_XYZ_NONZERO]]);; let TAG_INVOLUTION = prove (`!a. involution tag (zset a)`, REWRITE_TAC[involution; tag; zset; FORALL_PAIR_THM] THEN REWRITE_TAC[IN_TRIPLE] THEN REWRITE_TAC[MULT_AC]);; let ZAG_LEMMA = prove (`(zag(x,y,z) = (x,y,z)) ==> (y = x)`, REWRITE_TAC[zag; INT_POW_2] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[PAIR_EQ]) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; let ZSET_BOUND = prove (`0 < y /\ 0 < z /\ (x EXP 2 + 4 * y * z = p) ==> x <= p /\ y <= p /\ z <= p`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONJ_TAC THENL [MESON_TAC[EXP_2; LE_SQUARE_REFL; ARITH_RULE `(a <= b ==> a <= b + c)`]; CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE `y <= z ==> y <= x + z`) THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MULT_SYM]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `y <= 4 * a * y <=> 1 * y <= (4 * a) * y`] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_SIMP_TAC[ARITH_RULE `0 < a ==> 1 <= 4 * a`]]);; let ZSET_FINITE = prove (`!p. prime(p) ==> FINITE(zset p)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `p + 1` FINITE_NUMSEG_LT) THEN DISCH_THEN(fun th -> MP_TAC(funpow 2 (MATCH_MP FINITE_PRODUCT o CONJ th) th)) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] FINITE_SUBSET) THEN REWRITE_TAC[zset; SUBSET; FORALL_PAIR_THM; IN_TRIPLE] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN REWRITE_TAC[IN_ELIM_THM; EXISTS_PAIR_THM; PAIR_EQ] THEN REWRITE_TAC[ARITH_RULE `x < p + 1 <=> x <= p`; PAIR_EQ] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:num`; `y:num`; `z:num`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MAP_EVERY EXISTS_TAC [`y:num`; `z:num`] THEN REWRITE_TAC[] THEN ASM_MESON_TAC[ZSET_BOUND; PRIME_XYZ_NONZERO]);; let SUM_OF_TWO_SQUARES = prove (`!p k. prime(p) /\ (p = 4 * k + 1) ==> ?x y. p = x EXP 2 + y EXP 2`, SIMP_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?t. t IN zset(p) /\ (tag(t) = t)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM; tag; PAIR_EQ] THEN REWRITE_TAC[zset; IN_TRIPLE; EXP_2] THEN ASM_MESON_TAC[ARITH_RULE `4 * x * y = (2 * x) * (2 * y)`]] THEN MATCH_MP_TAC INVOLUTION_FIX_FIX THEN EXISTS_TAC `zag` THEN ASM_SIMP_TAC[ZAG_INVOLUTION; TAG_INVOLUTION; ZSET_FINITE] THEN REWRITE_TAC[EXISTS_UNIQUE_ALT] THEN EXISTS_TAC `1,1,k:num` THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[zset; zag; IN_TRIPLE; ARITH] THEN REWRITE_TAC[MULT_CLAUSES; ARITH_RULE `~(1 + k < 1)`; PAIR_EQ] THEN ARITH_TAC] THEN REWRITE_TAC[zset; IN_TRIPLE] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST_ALL_TAC o MATCH_MP ZAG_LEMMA) THEN UNDISCH_TAC `x EXP 2 + 4 * x * z = 4 * k + 1` THEN REWRITE_TAC[EXP_2; ARITH_RULE `x * x + 4 * x * z = x * (4 * z + x)`] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `prime p` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[prime] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:num`)) THEN SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THENL [UNDISCH_TAC `4 * k + 1 = 1 * (4 * z + 1)` THEN REWRITE_TAC[MULT_CLAUSES; PAIR_EQ] THEN ARITH_TAC; ONCE_REWRITE_TAC[ARITH_RULE `(a = a * b) = (a * b = a * 1)`] THEN ASM_SIMP_TAC[EQ_MULT_LCANCEL] THEN STRIP_TAC THENL [UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0; ARITH_EQ]; UNDISCH_TAC `4 * z + x = 1` THEN REWRITE_TAC[PAIR_EQ] THEN ASM_CASES_TAC `z = 0` THENL [ALL_TAC; UNDISCH_TAC `~(z = 0)` THEN ARITH_TAC] THEN UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ASM_CASES_TAC `x = 1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MULT_CLAUSES] THEN ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* General pigeonhole lemma. *) (* ------------------------------------------------------------------------- *) let PIGEONHOLE_LEMMA = prove (`!f:A->B g s t. FINITE(s) /\ FINITE(t) /\ (!x. x IN s ==> f(x) IN t) /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\ (!x. x IN s ==> g(x) IN t) /\ (!x y. x IN s /\ y IN s /\ (g x = g y) ==> (x = y)) /\ CARD(t) < 2 * CARD(s) ==> ?x y. x IN s /\ y IN s /\ (f x = g y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (f:A->B) s`; `IMAGE (g:A->B) s`] CARD_UNION) THEN SUBGOAL_THEN `(CARD(IMAGE (f:A->B) s) = CARD s) /\ (CARD(IMAGE (g:A->B) s) = CARD s)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CARD_IMAGE_INJ]; ALL_TAC] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN MATCH_MP_TAC(TAUT `(~a ==> c) /\ ~b ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_INTER; IN_IMAGE; NOT_IN_EMPTY] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `!t. t < 2 * s /\ p <= t ==> ~(p = s + s)`) THEN EXISTS_TAC `CARD(t:B->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[SUBSET; IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* In particular, consider functions out of 0...(p-1)/2, mod p. *) (* ------------------------------------------------------------------------- *) let PIGEONHOLE_LEMMA_P12 = prove (`!f g p. ODD(p) /\ (!x. 2 * x < p ==> f(x) < p) /\ (!x y. 2 * x < p /\ 2 * y < p /\ (f x = f y) ==> (x = y)) /\ (!x. 2 * x < p ==> g(x) < p) /\ (!x y. 2 * x < p /\ 2 * y < p /\ (g x = g y) ==> (x = y)) ==> ?x y. 2 * x < p /\ 2 * y < p /\ (f x = g y)`, REPEAT GEN_TAC THEN REWRITE_TAC[ODD_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN MP_TAC(ISPECL [`f:num->num`; `g:num->num`; `{x:num | 2 * x < 2 * k + 1}`; `{x:num | x < 2 * k + 1}`] PIGEONHOLE_LEMMA) THEN REWRITE_TAC[ADD1; ARITH_RULE `2 * x < 2 * k + 1 <=> x < k + 1`] THEN REWRITE_TAC[FINITE_NUMSEG_LT; CARD_NUMSEG_LT] THEN REWRITE_TAC[IN_ELIM_THM; ARITH_RULE `2 * k + 1 < 2 * (k + 1)`]);; (* ------------------------------------------------------------------------- *) (* Show that \x. x^2 + a (mod p) satisfies the conditions. *) (* ------------------------------------------------------------------------- *) let SQUAREMOD_INJ_LEMMA = prove (`!p x d. prime(p) /\ 2 * (x + d) < p /\ ((x + d) * (x + d) + m * p = x * x + n * p) ==> (d = 0)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `p divides d \/ p divides (2 * x + d)` MP_TAC THENL [MATCH_MP_TAC PRIME_DIVPROD THEN ASM_REWRITE_TAC[divides] THEN EXISTS_TAC `n - m:num` THEN REWRITE_TAC[LEFT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `!a:num. (a + b + d = a + c) ==> (b = c - d)`) THEN EXISTS_TAC `x * x:num` THEN ONCE_REWRITE_TAC[MULT_SYM] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN ARITH_TAC; DISCH_THEN(DISJ_CASES_THEN(MP_TAC o MATCH_MP DIVIDES_LE)) THEN SIMP_TAC[ADD_EQ_0] THEN UNDISCH_TAC `2 * (x + d) < p` THEN ARITH_TAC]);; let SQUAREMOD_INJ = prove (`!p. prime(p) ==> (!x. 2 * x < p ==> (x EXP 2 + a) MOD p < p) /\ (!x y. 2 * x < p /\ 2 * y < p /\ ((x EXP 2 + a) MOD p = (y EXP 2 + a) MOD p) ==> (x = y))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `x < a ==> ~(a = 0)`)) THEN ASM_SIMP_TAC[DIVISION] THEN SUBGOAL_THEN `(x EXP 2 + a = (x EXP 2 + a) DIV p * p + (x EXP 2 + a) MOD p) /\ (y EXP 2 + a = (y EXP 2 + a) DIV p * p + (y EXP 2 + a) MOD p)` MP_TAC THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x2 + a = xp + b:num) /\ (y2 + a = yp + b) ==> (x2 + yp = y2 + xp)`)) THEN DISJ_CASES_THEN MP_TAC (SPECL [`x:num`; `y:num`] LE_CASES) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o REWRITE_RULE[LE_EXISTS]) THENL [ONCE_REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN REWRITE_TAC[EXP_2; ARITH_RULE `(x + d = x) = (d = 0)`] THEN ASM_MESON_TAC[SQUAREMOD_INJ_LEMMA]);; (* ------------------------------------------------------------------------- *) (* Show that also a reflection mod p retains this property. *) (* ------------------------------------------------------------------------- *) let REFLECT_INJ = prove (`(!x. 2 * x < p ==> f(x) < p) /\ (!x y. 2 * x < p /\ 2 * y < p /\ (f x = f y) ==> (x = y)) ==> (!x. 2 * x < p ==> p - 1 - f(x) < p) /\ (!x y. 2 * x < p /\ 2 * y < p /\ (p - 1 - f(x) = p - 1 - f(y)) ==> (x = y))`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[ARITH_RULE `2 * x < p ==> p - 1 - y < p`] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE `x < p /\ y < p /\ (p - 1 - x = p - 1 - y) ==> (x = y)`) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence the main result. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_LEMMA_ODD = prove (`!a p. prime(p) /\ ODD(p) ==> ?n x y. 2 * x < p /\ 2 * y < p /\ (n * p = x EXP 2 + y EXP 2 + a + 1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[ODD]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. (x EXP 2 + a) MOD p`; `\x. p - 1 - (x EXP 2 + 0) MOD p`; `p:num`] PIGEONHOLE_LEMMA_P12) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(a /\ b) /\ (c /\ d) ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REFLECT_INJ] THEN ASM_MESON_TAC[SQUAREMOD_INJ]; ALL_TAC] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `(x = p - 1 - y) ==> y < p ==> (x + y + 1 = p)`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[DIVISION]; ALL_TAC] THEN DISCH_THEN(MP_TAC o C AP_THM `p:num` o AP_TERM `(MOD)`) THEN SUBGOAL_THEN `((x EXP 2 + a) MOD p + (y EXP 2 + 0) MOD p + 1) MOD p = (x EXP 2 + y EXP 2 + a + 1) MOD p` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `(x EXP 2 + a) DIV p + (y EXP 2) DIV p` THEN REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `(x2 + a = xd * p + xm) /\ (y2 = yd * p + ym) ==> (x2 + y2 + a + 1 = (xm + ym + 1) + (xd + yd) * p)`) THEN ASM_MESON_TAC[DIVISION]; ALL_TAC] THEN SUBGOAL_THEN `p MOD p = 0` SUBST1_TAC THENL [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `1` THEN UNDISCH_TAC `~(p = 0)` THEN ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`(x EXP 2 + y EXP 2 + a + 1) DIV p`; `x:num`; `y:num`] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `x EXP 2 + y EXP 2 + a + 1` o MATCH_MP DIVISION) THEN ASM_REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Avoid the additional conditions. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_LEMMA = prove (`!a p. prime(p) ==> ?n x y. 2 * x <= p /\ 2 * y <= p /\ (n * p = x EXP 2 + y EXP 2 + a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `EVEN(p)` THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [prime]) THEN DISCH_THEN(MP_TAC o SPEC `2` o CONJUNCT2) THEN ANTS_TAC THENL [ASM_MESON_TAC[EVEN_EXISTS; divides]; ALL_TAC] THEN REWRITE_TAC[ARITH_EQ] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_CASES_TAC `EVEN(a)` THENL [UNDISCH_TAC `EVEN a` THEN REWRITE_TAC[EVEN_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`k:num`; `0`; `0`] THEN REWRITE_TAC[ARITH; ADD_CLAUSES] THEN ARITH_TAC; UNDISCH_TAC `~(EVEN(a))` THEN REWRITE_TAC[NOT_EVEN; ODD_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`k + 1`; `1`; `0`] THEN REWRITE_TAC[ARITH; ADD_CLAUSES] THEN ARITH_TAC]; ASM_CASES_TAC `a = 0` THENL [MAP_EVERY EXISTS_TAC [`0`; `0`; `0`] THEN ASM_REWRITE_TAC[LE_0; ADD_CLAUSES; MULT_CLAUSES; EXP_2]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(a = 0) ==> (a = (a - 1) + 1)`)) THEN MP_TAC(SPECL [`a - 1`; `p:num`] LAGRANGE_LEMMA_ODD) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[LT_IMP_LE]]);; (* ------------------------------------------------------------------------- *) (* Aubrey's lemma showing that rationals suffice for sums of 4 squares. *) (* ------------------------------------------------------------------------- *) prioritize_real();; let REAL_INTEGER_CLOSURES = prove (`(!n. ?p. abs(&n) = &p) /\ (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x + y) = &p) /\ (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x - y) = &p) /\ (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x * y) = &p) /\ (!x r. (?n. abs(x) = &n) ==> ?p. abs(x pow r) = &p) /\ (!x. (?n. abs(x) = &n) ==> ?p. abs(--x) = &p) /\ (!x. (?n. abs(x) = &n) ==> ?p. abs(abs x) = &p)`, MATCH_MP_TAC(TAUT `x /\ c /\ d /\ e /\ f /\ (a /\ e ==> b) /\ a ==> x /\ a /\ b /\ c /\ d /\ e /\ f`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_NUM] THEN MESON_TAC[]; REWRITE_TAC[REAL_ABS_MUL] THEN MESON_TAC[REAL_OF_NUM_MUL]; REWRITE_TAC[REAL_ABS_POW] THEN MESON_TAC[REAL_OF_NUM_POW]; REWRITE_TAC[REAL_ABS_NEG]; REWRITE_TAC[REAL_ABS_ABS]; REWRITE_TAC[real_sub] THEN MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[REAL_ARITH `&0 <= a ==> ((abs(x) = a) <=> (x = a) \/ (x = --a))`; REAL_POS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_OF_NUM_ADD] THENL [MESON_TAC[]; ALL_TAC; ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[REAL_ARITH `(--a + b = c) <=> (a + c = b)`; REAL_ARITH `(a + --b = c) <=> (b + c = a)`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN MESON_TAC[LE_EXISTS; ADD_SYM; LE_CASES]);; let REAL_NUM_ROUND = prove (`!x. &0 <= x ==> ?n. abs(x - &n) <= &1 / &2`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP REAL_ARCH_LEAST REAL_LT_01)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_MUL_RID] THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a <= x /\ x < a + &1 ==> abs(x - a) * &2 <= &1 \/ abs(x - (a + &1)) * &2 <= &1`)) THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN MESON_TAC[REAL_OF_NUM_ADD]);; let REAL_POS_ABS_MIDDLE = prove (`!x n. &0 <= x /\ (abs(x - &n) = &1 / &2) ==> (x = &(n - 1) + &1 / &2) \/ (x = &n + &1 / &2)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`1`; `n:num`] REAL_OF_NUM_SUB) THEN DISJ_CASES_TAC(ARITH_RULE `(n = 0) \/ 1 <= n`) THEN ASM_REWRITE_TAC[ARITH] THENL [MP_TAC(REAL_RAT_REDUCE_CONV `&0 <= &1 / &2`) THEN REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `n - &1 + a = n - (&1 - a)`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC]);; let REAL_RAT_ABS_MIDDLE = prove (`!m n p. (abs(&m / &p - &n) = &1 / &2) ==> (&m / &p = &(n - 1) + &1 / &2) \/ (&m / &p = &n + &1 / &2)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POS_ABS_MIDDLE THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS]);; let AUBREY_LEMMA_4 = prove (`!m n p q r. ~(m = 0) /\ ~(m = 1) /\ ((&n / &m) pow 2 + (&p / &m) pow 2 + (&q / &m) pow 2 + (&r / &m) pow 2 = &N) ==> ?m' n' p' q' r'. ~(m' = 0) /\ m' < m /\ ((&n' / &m') pow 2 + (&p' / &m') pow 2 + (&q' / &m') pow 2 + (&r' / &m') pow 2 = &N)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> p) ==> p`) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `?n' p' q' r'. (&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 < &1 \/ (((&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 = &1) /\ (m = 2) /\ (EVEN(n' + p' + q' + r') = EVEN(N)))` MP_TAC THENL [ASM_CASES_TAC `?n' p' q' r'. (&n / &m = &n' + &1 / &2) /\ (&p / &m = &p' + &1 / &2) /\ (&q / &m = &q' + &1 / &2) /\ (&r / &m = &r' + &1 / &2)` THENL [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`n':num`; `p':num`; `q':num`] THEN SUBGOAL_THEN `m = 2` SUBST_ALL_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`2`; `2 * n' + 1`; `2 * p' + 1`; `2 * q' + 1`; `2 * r' + 1`]) THEN REWRITE_TAC[ARITH_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(EVEN(n' + p' + q' + r') <=> EVEN(N)) \/ (EVEN(n' + p' + q' + r' + 1) <=> EVEN(N))` DISJ_CASES_TAC THENL [REWRITE_TAC[EVEN_ADD; ARITH_EVEN] THEN CONV_TAC TAUT; EXISTS_TAC `r':num` THEN DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `(a + b) - a = b`] THEN CONV_TAC REAL_RAT_REDUCE_CONV; EXISTS_TAC `r' + 1` THEN DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `(a + b) - a = b`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `(a + b) - (a + c) = b - c`] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; ALL_TAC] THEN MAP_EVERY (fun t -> MP_TAC(SPEC t REAL_NUM_ROUND)) [`&n / &m`; `&p / &m`; `&q / &m`; `&r / &m`] THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN MAP_EVERY (fun t -> DISCH_THEN(X_CHOOSE_TAC t)) [`r':num`; `q':num`; `p':num`; `n':num`] THEN MAP_EVERY EXISTS_TAC [`n':num`; `p':num`; `q':num`; `r':num`] THEN DISJ1_TAC THEN MATCH_MP_TAC(REAL_ARITH `!m. a <= m /\ b <= m /\ c <= m /\ d <= m /\ ~((a = m) /\ (b = m) /\ (c = m) /\ (d = m)) /\ &4 * m <= &1 ==> a + b + c + d < &1`) THEN EXISTS_TAC `(&1 / &2) pow 2` THEN ONCE_REWRITE_TAC[SYM(SPEC `a - b` REAL_POW2_ABS)] THEN ASM_SIMP_TAC[REAL_POW_LE2; REAL_ABS_POS; REAL_LE_DIV; REAL_POS] THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN REWRITE_TAC[REAL_POW_2; REAL_ARITH `(a * a = b * b) <=> ((a + b) * (a - b) = &0)`] THEN REWRITE_TAC[REAL_ENTIRE] THEN SIMP_TAC[REAL_ARITH `&0 <= x /\ &0 < y ==> ~(x + y = &0)`; REAL_ABS_POS; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_SUB_0] THEN FIRST_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (MP_TAC o MATCH_MP REAL_RAT_ABS_MIDDLE)) THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n':num`; `p':num`; `q':num`; `r':num`] THEN DISCH_TAC THEN ABBREV_TAC `s = &n - &m * &n'` THEN ABBREV_TAC `t = &p - &m * &p'` THEN ABBREV_TAC `u = &q - &m * &q'` THEN ABBREV_TAC `v = &r - &m * &r'` THEN ABBREV_TAC `N' = n' EXP 2 + p' EXP 2 + q' EXP 2 + r' EXP 2` THEN UNDISCH_TAC `n' EXP 2 + p' EXP 2 + q' EXP 2 + r' EXP 2 = N'` THEN DISCH_THEN(ASSUME_TAC o REWRITE_RULE [GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW]) THEN ABBREV_TAC `M = 2 * (n * n' + p * p' + q * q' + r * r')` THEN UNDISCH_TAC `2 * (n * n' + p * p' + q * q' + r * r') = M` THEN DISCH_THEN(ASSUME_TAC o REWRITE_RULE [GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW]) THEN ASM_CASES_TAC `(&n / &m = &n') /\ (&p / &m = &p') /\ (&q / &m = &q') /\ (&r / &m = &r')` THENL [MAP_EVERY EXISTS_TAC [`1`; `n':num`; `p':num`; `q':num`; `r':num`] THEN REWRITE_TAC[ARITH_EQ; REAL_DIV_1] THEN CONJ_TAC THENL [UNDISCH_TAC `~(m = 0)` THEN UNDISCH_TAC `~(m = 1)` THEN ARITH_TAC; UNDISCH_THEN `(&n / &m) pow 2 + (&p / &m) pow 2 + (&q / &m) pow 2 + (&r / &m) pow 2 = &N` (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `&0 < (&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2` MP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= w /\ &0 <= x /\ &0 <= y /\ &0 <= z /\ ~((w = &0) /\ (x = &0) /\ (y = &0) /\ (z = &0)) ==> &0 < w + x + y + z`) THEN REWRITE_TAC[REAL_POW_2; REAL_ENTIRE; REAL_LE_SQUARE] THEN ASM_REWRITE_TAC[REAL_SUB_0]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o check (is_disj o concl)) THEN SUBGOAL_THEN `(&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 = (s pow 2 + t pow 2 + u pow 2 + v pow 2) / &m pow 2` MP_TAC THENL [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&m pow 2` THEN ASM_SIMP_TAC[REAL_POW_EQ_0; REAL_DIV_RMUL; REAL_OF_NUM_EQ] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM REAL_POW_MUL; REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_POW_EQ_0; REAL_DIV_RMUL; REAL_OF_NUM_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 = (&N + &N') - &M / &m` ASSUME_TAC THENL [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&m pow 2` THEN ASM_SIMP_TAC[REAL_POW_EQ_0; REAL_DIV_RMUL; REAL_OF_NUM_EQ] THEN REWRITE_TAC[GSYM(ASSUME `(&n / &m) pow 2 + (&p / &m) pow 2 + (&q / &m) pow 2 + (&r / &m) pow 2 = &N`); GSYM(ASSUME `&n' pow 2 + &p' pow 2 + &q' pow 2 + &r' pow 2 = &N'`); GSYM(ASSUME `&2 * (&n * &n' + &p * &p' + &q * &q' + &r * &r') = &M`)] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM REAL_POW_MUL; REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_RMUL; REAL_OF_NUM_EQ; ASSUME `~(m = 0)`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_RMUL; REAL_OF_NUM_EQ; ASSUME `~(m = 0)`] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `(a + b) - c < &1 <=> (a + b) - &1 < c`; REAL_ARITH `((a + b) - c = &1) <=> ((a + b) - &1 = c)`; REAL_ARITH `&0 < a - b <=> b < a`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> ~(n = 0)`; ASSUME `~(m = 0)`] THEN REWRITE_TAC[REAL_ARITH `(a - &1) * m < M <=> a * m - M < m`; REAL_ARITH `((a - &1) * m = M) <=> (a * m - M = m)`] THEN REPEAT DISCH_TAC THEN UNDISCH_TAC `(&N + &N') - &M / &m = (s pow 2 + t pow 2 + u pow 2 + v pow 2) / &m pow 2` THEN ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH_RULE `0 < a <=> ~(a = 0)`] THEN REWRITE_TAC[REAL_POW_2; REAL_SUB_RDISTRIB; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_OF_NUM_EQ; GSYM REAL_POW_2] THEN ABBREV_TAC `m':num = (N + N') * m - M` THEN SUBGOAL_THEN `(&N + &N') * &m - &M = &m'` (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THENL [EXPAND_TAC "m'" THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `~(m' = 0)` ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[GSYM(ASSUME `(&N + &N') * &m - &M = &m'`)] THEN MATCH_MP_TAC(REAL_ARITH `b < a ==> ~(a - b = &0)`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!z. (&n' + s * z) pow 2 + (&p' + t * z) pow 2 + (&q' + u * z) pow 2 + (&r' + v * z) pow 2 - &N = (&m * z - &1) * (&m' * z + &N - &N')` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&m * &m' * z pow 2 + (&M - &2 * &m * &N') * z + &N' - &N` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POW_2; REAL_ARITH `(n + s * z) * (n + s * z) + (p + t * z) * (p + t * z) + (q + u * z) * (q + u * z) + (r + v * z) * (r + v * z) - N = (s * s + t * t + u * u + v * v) * (z * z) + (&2 * (n * s + p * t + q * u + r * v)) * z + ((n * n + p * p + q * q + r * r) - N)`] THEN ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC(REAL_ARITH `(a = c) /\ (b = d) ==> (a + b + n - m = c + d + n - m)`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM(ASSUME `&n' pow 2 + &p' pow 2 + &q' pow 2 + &r' pow 2 = &N'`); GSYM(ASSUME `&2 * (&n * &n' + &p * &p' + &q * &q' + &r * &r') = &M`)] THEN MAP_EVERY EXPAND_TAC ["s"; "t"; "u"; "v"] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_2; REAL_ARITH `(m * z - &1) * (m' * z + nn) = m * m' * z * z + (m * z * nn - m' * z) - nn`] THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[REAL_ARITH `(a + n' - n = b - (n - n')) <=> (a = b)`] THEN REWRITE_TAC[REAL_ARITH `a * z * b - c * z = (a * b - c) * z`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM(ASSUME `(&N + &N') * &m - &M = &m'`)] THEN REAL_ARITH_TAC]; ALL_TAC] THEN ABBREV_TAC `w = &n' + s * (&N' - &N) / &m'` THEN ABBREV_TAC `x = &p' + t * (&N' - &N) / &m'` THEN ABBREV_TAC `y = &q' + u * (&N' - &N) / &m'` THEN ABBREV_TAC `z = &r' + v * (&N' - &N) / &m'` THEN SUBGOAL_THEN `w pow 2 + x pow 2 + y pow 2 + z pow 2 = &N` (SUBST1_TAC o SYM) THENL [MAP_EVERY EXPAND_TAC ["w"; "x"; "y"; "z"] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a + b + c + d = e) <=> (a + b + c + d - e = &0)`] THEN FIRST_ASSUM(SUBST1_TAC o SPEC `(&N' - &N) / &m'`) THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL [EXISTS_TAC `m':num` THEN SUBGOAL_THEN `?a b c d. (abs(&n' * &m' + s * (&N' - &N)) = &a) /\ (abs(&p' * &m' + t * (&N' - &N)) = &b) /\ (abs(&q' * &m' + u * (&N' - &N)) = &c) /\ (abs(&r' * &m' + v * (&N' - &N)) = &d)` MP_TAC THENL [MAP_EVERY EXPAND_TAC ["s"; "t"; "u"; "v"] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN MESON_TAC[REAL_INTEGER_CLOSURES]; ALL_TAC] THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) [`a:num`; `b:num`; `c:num`; `d:num`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_OF_NUM_LT]) THEN REWRITE_TAC[REAL_POW_DIV; REAL_POW2_ABS] THEN REWRITE_TAC[GSYM REAL_POW_DIV] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN REWRITE_TAC[GSYM real_div; REAL_MUL_RID] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN DISCH_TAC THEN SUBGOAL_THEN `?n. abs((&N' - &N) / &2) = &n` ASSUME_TAC THENL [REWRITE_TAC[GSYM(ASSUME `&n' pow 2 + &p' pow 2 + &q' pow 2 + &r' pow 2 = &N'`)] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_ADD] THEN SUBGOAL_THEN `EVEN(n' EXP 2 + p' EXP 2 + q' EXP 2 + r' EXP 2) = EVEN N` MP_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[EVEN_ADD; EVEN_EXP; ARITH_EQ]; ALL_TAC] THEN DISJ_CASES_THEN MP_TAC (TAUT `EVEN(N) \/ ~EVEN(N)`) THEN SIMP_TAC[] THEN REWRITE_TAC[NOT_EVEN; EVEN_EXISTS; ODD_EXISTS] THEN REPEAT(DISCH_THEN(CHOOSE_THEN SUBST1_TAC)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_ARITH `(&2 * x + &1) - (&2 * y + &1) = &2 * (x - y)`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RID] THEN MESON_TAC[REAL_INTEGER_CLOSURES]; ALL_TAC] THEN EXISTS_TAC `1` THEN REWRITE_TAC[ARITH_EQ] THEN SUBGOAL_THEN `?a b c d. (abs(&n' + s * (&N' - &N) / &2) = &a) /\ (abs(&p' + t * (&N' - &N) / &2) = &b) /\ (abs(&q' + u * (&N' - &N) / &2) = &c) /\ (abs(&r' + v * (&N' - &N) / &2) = &d)` MP_TAC THENL [MAP_EVERY EXPAND_TAC ["s"; "t"; "u"; "v"] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN UNDISCH_TAC `?n. abs ((&N' - &N) / &2) = &n` THEN MESON_TAC[REAL_INTEGER_CLOSURES]; ALL_TAC] THEN REWRITE_TAC[ARITH; REAL_DIV_1] THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) [`a:num`; `b:num`; `c:num`; `d:num`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN ASM_REWRITE_TAC[REAL_POW2_ABS]);; (* ------------------------------------------------------------------------- *) (* Hence the main result. *) (* ------------------------------------------------------------------------- *) let AUBREY_THM_4 = prove (`(?q. ~(q = 0) /\ ?a b c d. (&a / &q) pow 2 + (&b / &q) pow 2 + (&c / &q) pow 2 + (&d / &q) pow 2 = &N) ==> ?a b c d. &a pow 2 + &b pow 2 + &c pow 2 + &d pow 2 = &N`, GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN ASM_CASES_TAC `m = 1` THENL [ASM_REWRITE_TAC[REAL_DIV_1; ARITH_EQ] THEN MESON_TAC[]; STRIP_TAC THEN MP_TAC(SPEC `m:num` AUBREY_LEMMA_4) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The algebraic lemma. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_IDENTITY = REAL_ARITH `(w1 pow 2 + x1 pow 2 + y1 pow 2 + z1 pow 2) * (w2 pow 2 + x2 pow 2 + y2 pow 2 + z2 pow 2) = (w1 * w2 - x1 * x2 - y1 * y2 - z1 * z2) pow 2 + (w1 * x2 + x1 * w2 + y1 * z2 - z1 * y2) pow 2 + (w1 * y2 - x1 * z2 + y1 * w2 + z1 * x2) pow 2 + (w1 * z2 + x1 * y2 - y1 * x2 + z1 * w2) pow 2`;; (* ------------------------------------------------------------------------- *) (* Now sum of 4 squares. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_REAL_NUM = prove (`!n. ?w x y z. &n = &w pow 2 + &x pow 2 + &y pow 2 + &z pow 2`, let lemma = prove (`(?a. abs(w) = &a) /\ (?b. abs(x) = &b) /\ (?c. abs(y) = &c) /\ (?d. abs(z) = &d) ==> ?a b c d. w pow 2 + x pow 2 + y pow 2 + z pow 2 = &a pow 2 + &b pow 2 + &c pow 2 + &d pow 2`, STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ABS_NUM] THEN MESON_TAC[]) in MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_CASES_TAC `n = 0` THENL [REPEAT(EXISTS_TAC `0`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ASM_CASES_TAC `n = 1` THENL [EXISTS_TAC `1` THEN REPEAT(EXISTS_TAC `0`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN ASM_CASES_TAC `m = 1` THENL [ALL_TAC; DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `p:num` th) THEN MP_TAC(SPEC `m:num` th)) THEN ONCE_REWRITE_TAC[ARITH_RULE `m < p * m <=> 1 * m < p * m`] THEN REWRITE_TAC[LT_MULT_RCANCEL] THEN ONCE_REWRITE_TAC[ARITH_RULE `p < p * m <=> p * 1 < p * m`] THEN REWRITE_TAC[LT_MULT_LCANCEL] THEN UNDISCH_TAC `~(p * m = 0)` THEN REWRITE_TAC[MULT_EQ_0] THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(p = 1)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `1 < x <=> ~(x = 0) /\ ~(x = 1)`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`w1:num`; `x1:num`; `y1:num`; `z1:num`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w2:num`; `x2:num`; `y2:num`; `z2:num`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[LAGRANGE_IDENTITY] THEN MATCH_MP_TAC lemma THEN REWRITE_TAC[REAL_OF_NUM_MUL] THEN MESON_TAC[REAL_INTEGER_CLOSURES]] THEN UNDISCH_TAC `m = 1` THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[MULT_CLAUSES] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LAGRANGE_LEMMA) THEN DISCH_THEN(MP_TAC o SPEC `1 EXP 2 + 0 EXP 2`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q:num`; `x:num`; `y:num`] THEN STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC AUBREY_THM_4 THEN SUBGOAL_THEN `q * p < p EXP 2` MP_TAC THENL [ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `(2 * x) * (2 * x) <= p * p /\ (2 * y) * (2 * y) <= p * p /\ 2 * 2 <= p * p ==> x * x + y * y + 1 < p * p`) THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`~(p = 0)`; `~(p = 1)`] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXP_2; LT_MULT_RCANCEL] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num`; `b:num`; `c:num`; `d:num`] THEN DISCH_TAC THEN SUBGOAL_THEN `~(q = 0)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `0 * p = x EXP 2 + y EXP 2 + 1 EXP 2 + 0 EXP 2` THEN DISCH_THEN(MP_TAC o SYM) THEN REWRITE_TAC[MULT_CLAUSES; EXP_2] THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN SUBGOAL_THEN `&p = &q * &(q * p) / &q pow 2` SUBST1_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_MUL_ASSOC; real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_POW_EQ_0; REAL_MUL_LINV; REAL_MUL_LID; ASSUME `~(q = 0)`; REAL_OF_NUM_EQ]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; LAGRANGE_IDENTITY] THEN SUBST1_TAC(SYM(ASSUME `&q = &a pow 2 + &b pow 2 + &c pow 2 + &d pow 2`)) THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div; GSYM REAL_POW_DIV] THEN EXISTS_TAC `q:num` THEN REWRITE_TAC[ASSUME `~(q = 0)`] THEN REWRITE_TAC[REAL_POW_DIV] THEN REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN REWRITE_TAC[REAL_INV_EQ_0; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ASSUME `~(q = 0)`] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC lemma THEN REWRITE_TAC[REAL_OF_NUM_MUL] THEN MESON_TAC[REAL_INTEGER_CLOSURES]);; (* ------------------------------------------------------------------------- *) (* Also prove it for the natural numbers. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_NUM = prove (`!n. ?w x y z. n = w EXP 2 + x EXP 2 + y EXP 2 + z EXP 2`, GEN_TAC THEN MP_TAC(SPEC `n:num` LAGRANGE_REAL_NUM) THEN REWRITE_TAC[REAL_POS; REAL_OF_NUM_POW; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ]);; (* ------------------------------------------------------------------------- *) (* And for the integers. *) (* ------------------------------------------------------------------------- *) prioritize_int();; let LAGRANGE_INT = prove (`!a. &0 <= a <=> ?w x y z. a = w pow 2 + x pow 2 + y pow 2 + z pow 2`, GEN_TAC THEN EQ_TAC THENL [SPEC_TAC(`a:int`,`a:int`) THEN REWRITE_TAC[GSYM INT_FORALL_POS] THEN X_GEN_TAC `n:num` THEN MP_TAC(SPEC `n:num` LAGRANGE_REAL_NUM) THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_POW; GSYM INT_OF_NUM_ADD] THEN MESON_TAC[]; STRIP_TAC THEN ASM_SIMP_TAC[INT_LE_SQUARE; INT_LE_ADD; INT_POW_2]]);; prioritize_num();; hol-light/100/fourier.ml000066400000000000000000007076511303454263000152720ustar00rootroot00000000000000(* ========================================================================= *) (* Square integrable functions R->R and basics of Fourier series. *) (* ========================================================================= *) needs "Multivariate/lpspaces.ml";; (* ------------------------------------------------------------------------- *) (* Somewhat general lemmas, but perhaps not enough to be installed. *) (* ------------------------------------------------------------------------- *) let SUM_NUMBERS = prove (`!n. sum(0..n) (\r. &r) = (&n * (&n + &1)) / &2`, INDUCT_TAC THEN ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC);; let REAL_INTEGRABLE_REFLECT_AND_ADD = prove (`!f a. f real_integrable_on real_interval[--a,a] ==> f real_integrable_on real_interval[&0,a] /\ (\x. f(--x)) real_integrable_on real_interval[&0,a] /\ (\x. f x + f(--x)) real_integrable_on real_interval[&0,a]`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN REPEAT CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[REAL_NEG_NEG; ETA_AX]; SIMP_TAC[REAL_INTEGRABLE_ADD]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REAL_ARITH_TAC);; let REAL_INTEGRAL_REFLECT_AND_ADD = prove (`!f a. f real_integrable_on real_interval[--a,a] ==> real_integral (real_interval[--a,a]) f = real_integral (real_interval[&0,a]) (\x. f x + f(--x))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= a` THENL [MP_TAC(SPECL [`f:real->real`; `--a:real`; `a:real`; `&0:real`] REAL_INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[REAL_INTEGRAL_ADD; REAL_INTEGRABLE_REFLECT_AND_ADD] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INTEGRAL_REFLECT] THEN REWRITE_TAC[REAL_NEG_NEG; ETA_AX; REAL_NEG_0; REAL_ADD_AC]; ASM_SIMP_TAC[REAL_INTEGRAL_NULL; REAL_ARITH `~(&0 <= a) ==> a <= --a /\ a <= &0`]]);; (* ------------------------------------------------------------------------- *) (* Square-integrable real->real functions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("square_integrable_on",(12,"right"));; let square_integrable_on = new_definition `f square_integrable_on s <=> f real_measurable_on s /\ (\x. f(x) pow 2) real_integrable_on s`;; let SQUARE_INTEGRABLE_IMP_MEASURABLE = prove (`!f s. f square_integrable_on s ==> f real_measurable_on s`, SIMP_TAC[square_integrable_on]);; let SQUARE_INTEGRABLE_LSPACE = prove (`!f s. f square_integrable_on s <=> (lift o f o drop) IN lspace (IMAGE lift s) (&2)`, REWRITE_TAC[square_integrable_on; lspace; IN_ELIM_THM] THEN REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; RPOW_POW] THEN REWRITE_TAC[o_THM; NORM_REAL; GSYM drop; LIFT_DROP] THEN REWRITE_TAC[REAL_POW2_ABS; o_DEF]);; let SQUARE_INTEGRABLE_0 = prove (`!s. (\x. &0) square_integrable_on s`, REWRITE_TAC[square_integrable_on; REAL_MEASURABLE_ON_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_INTEGRABLE_0]);; let SQUARE_INTEGRABLE_NEG_EQ = prove (`!f s. (\x. --(f x)) square_integrable_on s <=> f square_integrable_on s`, REWRITE_TAC[square_integrable_on; REAL_MEASURABLE_ON_NEG_EQ; REAL_POW_NEG; ARITH]);; let SQUARE_INTEGRABLE_NEG = prove (`!f s. f square_integrable_on s ==> (\x. --(f x)) square_integrable_on s`, REWRITE_TAC[SQUARE_INTEGRABLE_NEG_EQ]);; let SQUARE_INTEGRABLE_LMUL = prove (`!f s c. f square_integrable_on s ==> (\x. c * f(x)) square_integrable_on s`, SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_LMUL] THEN SIMP_TAC[REAL_POW_MUL; REAL_INTEGRABLE_LMUL]);; let SQUARE_INTEGRABLE_RMUL = prove (`!f s c. f square_integrable_on s ==> (\x. f(x) * c) square_integrable_on s`, SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_RMUL] THEN SIMP_TAC[REAL_POW_MUL; REAL_INTEGRABLE_RMUL]);; let SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_PRODUCT = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> (\x. f(x) * g(x)) absolutely_real_integrable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE] THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_MUL; SQUARE_INTEGRABLE_IMP_MEASURABLE] THEN MP_TAC(ISPECL [`IMAGE lift s`; `&2`; `&2`; `lift o f o drop`; `lift o g o drop`] LSPACE_INTEGRABLE_PRODUCT) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; REAL_INTEGRABLE_ON] THEN REWRITE_TAC[o_DEF; NORM_REAL; GSYM drop; LIFT_DROP; REAL_ABS_MUL]);; let SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> (\x. f(x) * g(x)) real_integrable_on s`, SIMP_TAC[SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_PRODUCT; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; let SQUARE_INTEGRABLE_ADD = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> (\x. f(x) + g(x)) square_integrable_on s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_ADD; SQUARE_INTEGRABLE_IMP_MEASURABLE] THEN SIMP_TAC[REAL_ARITH `(x + y) pow 2 = (x pow 2 + y pow 2) + &2 * x * y`] THEN MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT; REAL_INTEGRABLE_LMUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[square_integrable_on]) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ADD]);; let SQUARE_INTEGRABLE_SUB = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> (\x. f(x) - g(x)) square_integrable_on s`, SIMP_TAC[real_sub; SQUARE_INTEGRABLE_ADD; SQUARE_INTEGRABLE_NEG_EQ]);; let SQUARE_INTEGRABLE_ABS = prove (`!f g s. f square_integrable_on s ==> (\x. abs(f x)) square_integrable_on s`, SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_ABS; REAL_POW2_ABS]);; let SQUARE_INTEGRABLE_SUM = prove (`!f s t. FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) ==> (\x. sum t (\i. f i x)) square_integrable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SQUARE_INTEGRABLE_0; IN_INSERT; SQUARE_INTEGRABLE_ADD; ETA_AX; SUM_CLAUSES]);; let REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE = prove (`!f a b. f real_continuous_on real_interval[a,b] ==> f square_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[square_integrable_on] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN ASM_REWRITE_TAC[]]);; let SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove (`!f s. f square_integrable_on s /\ real_measurable s ==> f absolutely_real_integrable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN REWRITE_TAC[GSYM LSPACE_1] THEN MATCH_MP_TAC LSPACE_MONO THEN EXISTS_TAC `&2` THEN ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE; GSYM SQUARE_INTEGRABLE_LSPACE] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let SQUARE_INTEGRABLE_IMP_INTEGRABLE = prove (`!f s. f square_integrable_on s /\ real_measurable s ==> f real_integrable_on s`, SIMP_TAC[SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; (* ------------------------------------------------------------------------- *) (* The norm and inner product in L2. *) (* ------------------------------------------------------------------------- *) let l2product = new_definition `l2product s f g = real_integral s (\x. f(x) * g(x))`;; let l2norm = new_definition `l2norm s f = sqrt(l2product s f f)`;; let L2NORM_LNORM = prove (`!f s. f square_integrable_on s ==> l2norm s f = lnorm (IMAGE lift s) (&2) (lift o f o drop)`, REPEAT STRIP_TAC THEN REWRITE_TAC[l2norm; lnorm; l2product] THEN RULE_ASSUM_TAC(REWRITE_RULE[square_integrable_on]) THEN ASM_SIMP_TAC[GSYM REAL_POW_2; REAL_INTEGRAL] THEN REWRITE_TAC[NORM_REAL; o_DEF; GSYM drop; LIFT_DROP; RPOW_POW] THEN REWRITE_TAC[REAL_POW2_ABS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(GSYM RPOW_SQRT) THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; REAL_LE_POW_2] THEN FIRST_ASSUM(MP_TAC o REWRITE_RULE[REAL_INTEGRABLE_ON] o CONJUNCT2) THEN REWRITE_TAC[o_DEF]);; let L2PRODUCT_SYM = prove (`!s f g. l2product s f g = l2product s g f`, REWRITE_TAC[l2product; REAL_MUL_SYM]);; let L2PRODUCT_POS_LE = prove (`!s f. f square_integrable_on s ==> &0 <= l2product s f f`, REWRITE_TAC[square_integrable_on; l2product] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_POS THEN REWRITE_TAC[REAL_LE_SQUARE] THEN ASM_REWRITE_TAC[GSYM REAL_POW_2]);; let L2NORM_POW_2 = prove (`!s f. f square_integrable_on s ==> (l2norm s f) pow 2 = l2product s f f`, SIMP_TAC[l2norm; SQRT_POW_2; L2PRODUCT_POS_LE]);; let L2NORM_POS_LE = prove (`!s f. f square_integrable_on s ==> &0 <= l2norm s f`, SIMP_TAC[l2norm; SQRT_POS_LE; L2PRODUCT_POS_LE]);; let L2NORM_LE = prove (`!s f g. f square_integrable_on s /\ g square_integrable_on s ==> (l2norm s f <= l2norm s g <=> l2product s f f <= l2product s g g)`, SIMP_TAC[SQRT_MONO_LE_EQ; l2norm; SQRT_MONO_LE_EQ; L2PRODUCT_POS_LE]);; let L2NORM_EQ = prove (`!s f g. f square_integrable_on s /\ g square_integrable_on s ==> (l2norm s f = l2norm s g <=> l2product s f f = l2product s g g)`, SIMP_TAC[GSYM REAL_LE_ANTISYM; L2NORM_LE]);; let SCHWARTZ_INEQUALITY_STRONG = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> l2product s (\x. abs(f x)) (\x. abs(g x)) <= l2norm s f * l2norm s g`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE lift s`; `&2`; `&2`; `lift o f o drop`; `lift o g o drop`] HOELDER_INEQUALITY) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; GSYM L2NORM_LNORM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN REWRITE_TAC[l2product] THEN ASM_SIMP_TAC[REAL_INTEGRAL; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT; SQUARE_INTEGRABLE_ABS] THEN REWRITE_TAC[NORM_REAL; o_DEF; GSYM drop; LIFT_DROP; REAL_LE_REFL]);; let SCHWARTZ_INEQUALITY_ABS = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> abs(l2product s f g) <= l2norm s f * l2norm s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `l2product s (\x. abs(f x)) (\x. abs(g x))` THEN ASM_SIMP_TAC[SCHWARTZ_INEQUALITY_STRONG] THEN REWRITE_TAC[l2product] THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT; SQUARE_INTEGRABLE_ABS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_LE_REFL]);; let SCHWARTZ_INEQUALITY = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> l2product s f g <= l2norm s f * l2norm s g`, MESON_TAC[SCHWARTZ_INEQUALITY_ABS; REAL_ARITH `abs x <= a ==> x <= a`]);; let L2NORM_TRIANGLE = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> l2norm s (\x. f x + g x) <= l2norm s f + l2norm s g`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE lift s`; `&2`; `lift o f o drop`; `lift o g o drop`] LNORM_TRIANGLE) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; L2NORM_LNORM; SQUARE_INTEGRABLE_ADD] THEN REWRITE_TAC[o_DEF; LIFT_ADD]);; let L2PRODUCT_LADD = prove (`!s f g h. f square_integrable_on s /\ g square_integrable_on s /\ h square_integrable_on s ==> l2product s (\x. f x + g x) h = l2product s f h + l2product s g h`, SIMP_TAC[l2product; REAL_ADD_RDISTRIB; REAL_INTEGRAL_ADD; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; let L2PRODUCT_RADD = prove (`!s f g h. f square_integrable_on s /\ g square_integrable_on s /\ h square_integrable_on s ==> l2product s f (\x. g x + h x) = l2product s f g + l2product s f h`, SIMP_TAC[l2product; REAL_ADD_LDISTRIB; REAL_INTEGRAL_ADD; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; let L2PRODUCT_LSUB = prove (`!s f g h. f square_integrable_on s /\ g square_integrable_on s /\ h square_integrable_on s ==> l2product s (\x. f x - g x) h = l2product s f h - l2product s g h`, SIMP_TAC[l2product; REAL_SUB_RDISTRIB; REAL_INTEGRAL_SUB; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; let L2PRODUCT_RSUB = prove (`!s f g h. f square_integrable_on s /\ g square_integrable_on s /\ h square_integrable_on s ==> l2product s f (\x. g x - h x) = l2product s f g - l2product s f h`, SIMP_TAC[l2product; REAL_SUB_LDISTRIB; REAL_INTEGRAL_SUB; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; let L2PRODUCT_LZERO = prove (`!s f. l2product s (\x. &0) f = &0`, REWRITE_TAC[l2product; REAL_MUL_LZERO; REAL_INTEGRAL_0]);; let L2PRODUCT_RZERO = prove (`!s f. l2product s f (\x. &0) = &0`, REWRITE_TAC[l2product; REAL_MUL_RZERO; REAL_INTEGRAL_0]);; let L2PRODUCT_LSUM = prove (`!s f g t. FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) /\ g square_integrable_on s ==> l2product s (\x. sum t (\i. f i x)) g = sum t (\i. l2product s (f i) g)`, REPLICATE_TAC 3 GEN_TAC THEN ASM_CASES_TAC `g square_integrable_on s` THEN ASM_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[L2PRODUCT_LZERO; SUM_CLAUSES; L2PRODUCT_LADD; SQUARE_INTEGRABLE_SUM; ETA_AX; IN_INSERT]);; let L2PRODUCT_RSUM = prove (`!s f g t. FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) /\ g square_integrable_on s ==> l2product s g (\x. sum t (\i. f i x)) = sum t (\i. l2product s g (f i))`, ONCE_REWRITE_TAC[L2PRODUCT_SYM] THEN REWRITE_TAC[L2PRODUCT_LSUM]);; let L2PRODUCT_LMUL = prove (`!s c f g. f square_integrable_on s /\ g square_integrable_on s ==> l2product s (\x. c * f x) g = c * l2product s f g`, SIMP_TAC[l2product; GSYM REAL_MUL_ASSOC; REAL_INTEGRAL_LMUL; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; let L2PRODUCT_RMUL = prove (`!s c f g. f square_integrable_on s /\ g square_integrable_on s ==> l2product s f (\x. c * g x) = c * l2product s f g`, ONCE_REWRITE_TAC[L2PRODUCT_SYM] THEN SIMP_TAC[L2PRODUCT_LMUL]);; let L2NORM_LMUL = prove (`!f s c. f square_integrable_on s ==> l2norm s (\x. c * f(x)) = abs(c) * l2norm s f`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[l2norm; L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL] THEN ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL] THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_2] THEN REWRITE_TAC[SQRT_MUL; POW_2_SQRT_ABS]);; let L2NORM_RMUL = prove (`!f s c. f square_integrable_on s ==> l2norm s (\x. f(x) * c) = l2norm s f * abs(c)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[L2NORM_LMUL]);; let L2NORM_NEG = prove (`!f s. f square_integrable_on s ==> l2norm s (\x. --(f x)) = l2norm s f`, ONCE_REWRITE_TAC[REAL_ARITH `--x:real = --(&1) * x`] THEN SIMP_TAC[L2NORM_LMUL; REAL_ABS_NEG; REAL_ABS_NUM; REAL_MUL_LID]);; let L2NORM_SUB = prove (`!f g s. f square_integrable_on s /\ g square_integrable_on s ==> l2norm s (\x. f x - g x) = l2norm s (\x. g x - f x)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_NEG_SUB] THEN ASM_SIMP_TAC[L2NORM_NEG; SQUARE_INTEGRABLE_SUB; ETA_AX]);; let L2_SUMMABLE = prove (`!f s t. (!i. i IN t ==> (f i) square_integrable_on s) /\ real_summable t (\i. l2norm s (f i)) ==> ?g. g square_integrable_on s /\ ((\n. l2norm s (\x. sum (t INTER (0..n)) (\i. f i x) - g x)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n:num. (lift o f n o drop)`; `&2`; `IMAGE lift s`; `t:num->bool`] LSPACE_SUMMABLE) THEN ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL [UNDISCH_TAC `real_summable t (\i. l2norm s (f i))` THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[real_summable; real_sums; REALLIM_SEQUENTIALLY] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `N:num` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[GSYM L2NORM_LNORM; IN_INTER; ETA_AX]; DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` MP_TAC) THEN SUBGOAL_THEN `g = (lift o (drop o g o lift) o drop)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_DROP]; ALL_TAC] THEN ABBREV_TAC `h = drop o g o lift` THEN REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN DISCH_THEN(fun th -> EXISTS_TAC `h:real->real` THEN MP_TAC th) THEN ASM_CASES_TAC `h square_integrable_on s` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[o_DEF; GSYM LIFT_SUB; REWRITE_RULE[o_DEF] (GSYM LIFT_SUM); FINITE_NUMSEG; FINITE_INTER] THEN SUBGOAL_THEN `!f. (\x. lift(f(drop x))) = (lift o f o drop)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN MATCH_MP_TAC(GSYM L2NORM_LNORM) THEN MATCH_MP_TAC SQUARE_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);; let L2_COMPLETE = prove (`!f s. (!i. f i square_integrable_on s) /\ (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> l2norm s (\x. f m x - f n x) < e) ==> ?g. g square_integrable_on s /\ ((\n. l2norm s (\x. f n x - g x)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n:num. lift o f n o drop`; `&2`; `IMAGE lift s`] RIESZ_FISCHER) THEN ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN ANTS_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV; DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` MP_TAC) THEN SUBGOAL_THEN `g = (lift o (drop o g o lift) o drop)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_DROP]; ALL_TAC] THEN ABBREV_TAC `h = drop o g o lift` THEN REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN DISCH_THEN(fun th -> EXISTS_TAC `h:real->real` THEN MP_TAC th) THEN ASM_CASES_TAC `h square_integrable_on s` THEN ASM_REWRITE_TAC[]] THEN (SUBGOAL_THEN `!f g. (\x. (lift o f o drop) x - (lift o g o drop) x) = (lift o (\y. f y - g y) o drop)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB]; ASM_SIMP_TAC[GSYM L2NORM_LNORM; SQUARE_INTEGRABLE_SUB; ETA_AX]]) THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> abs(x - &0) = x`; GE; L2NORM_POS_LE; SQUARE_INTEGRABLE_SUB; ETA_AX]);; let SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove (`!f s e. real_measurable s /\ f square_integrable_on s /\ &0 < e ==> ?g. g real_continuous_on (:real) /\ g square_integrable_on s /\ l2norm s (\x. f x - g x) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `&2:real`; `e:real`] LSPACE_APPROXIMATE_CONTINUOUS) THEN ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; REAL_OF_NUM_LE; ARITH; GSYM REAL_MEASURABLE_MEASURABLE] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `drop o g o lift` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_DROP; ETA_AX; IMAGE_LIFT_UNIV]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SQUARE_INTEGRABLE_LSPACE; o_DEF; LIFT_DROP; ETA_AX]; DISCH_TAC THEN ASM_SIMP_TAC[L2NORM_LNORM; SQUARE_INTEGRABLE_SUB; ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> x = y ==> y < e`)) THEN REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB]]);; (* ------------------------------------------------------------------------- *) (* Orthonormal system of L2 functions and their Fourier coefficients. *) (* ------------------------------------------------------------------------- *) let orthonormal_system = new_definition `orthonormal_system s w <=> !m n. l2product s (w m) (w n) = if m = n then &1 else &0`;; let orthonormal_coefficient = new_definition `orthonormal_coefficient s w f (n:num) = l2product s (w n) f`;; let ORTHONORMAL_SYSTEM_L2NORM = prove (`!s w. orthonormal_system s w ==> !i. l2norm s (w i) = &1`, SIMP_TAC[orthonormal_system; l2norm; SQRT_1]);; let ORTHONORMAL_PARTIAL_SUM_DIFF = prove (`!s w a f t. orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ f square_integrable_on s /\ FINITE t ==> l2norm s (\x. f(x) - sum t (\i. a i * w i x)) pow 2 = (l2norm s f) pow 2 + sum t (\i. (a i) pow 2) - &2 * sum t (\i. a i * orthonormal_coefficient s w f i)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. sum t (\i:num. a i * w i x)) square_integrable_on s` ASSUME_TAC THENL [ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; ETA_AX; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL]; ALL_TAC] THEN ASM_SIMP_TAC[L2NORM_POW_2; SQUARE_INTEGRABLE_SUB; ETA_AX; L2PRODUCT_LSUB] THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; ETA_AX; L2PRODUCT_RSUB] THEN MATCH_MP_TAC(REAL_ARITH `x' = x /\ b - &2 * x = c ==> a - x - (x' - b) = a + c`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[L2PRODUCT_SYM]; ALL_TAC] THEN ASM_SIMP_TAC[L2PRODUCT_RSUM; ETA_AX; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; SQUARE_INTEGRABLE_SUM] THEN ASM_SIMP_TAC[L2PRODUCT_LSUM; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; ETA_AX] THEN ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN ASM_SIMP_TAC[L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA] THEN REWRITE_TAC[orthonormal_coefficient; REAL_MUL_RID; GSYM REAL_POW_2] THEN REWRITE_TAC[L2PRODUCT_SYM]);; let ORTHONORMAL_OPTIMAL_PARTIAL_SUM = prove (`!s w a f t. orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ f square_integrable_on s /\ FINITE t ==> l2norm s (\x. f(x) - sum t (\i. orthonormal_coefficient s w f i * w i x)) <= l2norm s (\x. f(x) - sum t (\i. a i * w i x))`, REPEAT STRIP_TAC THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [L2NORM_LE; SQUARE_INTEGRABLE_SUM; ETA_AX; FINITE_NUMSEG; GSYM L2NORM_POW_2; SQUARE_INTEGRABLE_LMUL; SQUARE_INTEGRABLE_SUB] THEN ASM_SIMP_TAC[ORTHONORMAL_PARTIAL_SUM_DIFF] THEN REWRITE_TAC[REAL_LE_LADD] THEN ASM_SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `b pow 2 - &2 * b * b <= a pow 2 - &2 * a * b <=> &0 <= (a - b) pow 2`] THEN REWRITE_TAC[REAL_LE_POW_2]);; let BESSEL_INEQUALITY = prove (`!s w f t. orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ f square_integrable_on s /\ FINITE t ==> sum t (\i. (orthonormal_coefficient s w f i) pow 2) <= l2norm s f pow 2`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_PARTIAL_SUM_DIFF) THEN DISCH_THEN(MP_TAC o SPEC `orthonormal_coefficient s w f`) THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `a + b - &2 * b = a - b`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= p ==> p = x - y ==> y <= x`) THEN REWRITE_TAC[REAL_LE_POW_2]);; let FOURIER_SERIES_SQUARE_SUMMABLE = prove (`!s w f t. orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ f square_integrable_on s ==> real_summable t (\i. (orthonormal_coefficient s w f i) pow 2)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_summable; real_sums; REALLIM_SEQUENTIALLY] THEN MP_TAC(ISPECL [`\n. sum(t INTER (0..n)) (\i. (orthonormal_coefficient s w f i) pow 2)`; `l2norm s f pow 2`] CONVERGENT_BOUNDED_MONOTONE) THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`s:real->bool`; `w:num->real->real`; `f:real->real`; `t INTER (0..n)`] BESSEL_INEQUALITY) THEN ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(x) <= y`) THEN SIMP_TAC[SUM_POS_LE; FINITE_INTER; FINITE_NUMSEG; REAL_LE_POW_2] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[FINITE_INTER; SUBSET_REFL; FINITE_NUMSEG; REAL_LE_POW_2]; DISJ1_TAC THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[INTER_SUBSET; FINITE_NUMSEG; REAL_LE_POW_2; FINITE_INTER] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u INTER s SUBSET u INTER t`) THEN REWRITE_TAC[SUBSET_NUMSEG] THEN ASM_ARITH_TAC]);; let ORTHONORMAL_FOURIER_PARTIAL_SUM_DIFF_SQUARED = prove (`!s w a f t. orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ f square_integrable_on s /\ FINITE t ==> l2norm s (\x. f x - sum t (\i. orthonormal_coefficient s w f i * w i x)) pow 2 = l2norm s f pow 2 - sum t (\i. orthonormal_coefficient s w f i pow 2)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_PARTIAL_SUM_DIFF) THEN DISCH_THEN(MP_TAC o SPEC `orthonormal_coefficient s w f`) THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `a + b - &2 * b = a - b`]);; let FOURIER_SERIES_L2_SUMMABLE = prove (`!s w f t. orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ f square_integrable_on s ==> ?g. g square_integrable_on s /\ ((\n. l2norm s (\x. sum (t INTER (0..n)) (\i. orthonormal_coefficient s w f i * w i x) - g(x))) ---> &0) sequentially`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC L2_COMPLETE THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `t:num->bool` o MATCH_MP FOURIER_SERIES_SQUARE_SUMMABLE) THEN REWRITE_TAC[REAL_SUMMABLE; summable; sums; CONVERGENT_EQ_CAUCHY] THEN REWRITE_TAC[cauchy; GE] THEN DISCH_THEN(MP_TAC o SPEC `(e:real) pow 2`) THEN ASM_SIMP_TAC[REAL_POW_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THENL [ASM_CASES_TAC `N:num <= m` THEN ASM_CASES_TAC `N:num <= n` THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC L2NORM_SUB THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN EXISTS_TAC `2` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `m:num`]) THEN SIMP_TAC[DIST_REAL; GSYM drop; DROP_VSUM; FINITE_INTER; FINITE_NUMSEG] THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN SUBGOAL_THEN `!f. sum (t INTER (0..n)) f - sum (t INTER (0..m)) f = sum (t INTER (m+1..n)) f` (fun th -> REWRITE_TAC[th]) THENL [X_GEN_TAC `h:num->real` THEN REWRITE_TAC[REAL_ARITH `a - b:real = c <=> b + c = a`] THEN MATCH_MP_TAC SUM_UNION_EQ THEN SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_UNION; IN_NUMSEG] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN t` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN ASM_SIMP_TAC[L2NORM_POW_2; SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN ASM_SIMP_TAC[L2PRODUCT_RSUM; ETA_AX; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; FINITE_INTER; SQUARE_INTEGRABLE_SUM] THEN ASM_SIMP_TAC[L2PRODUCT_LSUM; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; FINITE_INTER; ETA_AX] THEN ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN ASM_SIMP_TAC[L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA] THEN REWRITE_TAC[REAL_MUL_RID; REAL_POW_2; REAL_ARITH `x <= abs x`]);; let FOURIER_SERIES_L2_SUMMABLE_STRONG = prove (`!s w f t. orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ f square_integrable_on s ==> ?g. g square_integrable_on s /\ (!i. i IN t ==> orthonormal_coefficient s w (\x. f x - g x) i = &0) /\ ((\n. l2norm s (\x. sum (t INTER (0..n)) (\i. orthonormal_coefficient s w f i * w i x) - g(x))) ---> &0) sequentially`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `t:num->bool` o MATCH_MP FOURIER_SERIES_L2_SUMMABLE) THEN REWRITE_TAC[orthonormal_coefficient] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[orthonormal_coefficient] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN EXISTS_TAC `\n. l2product s (w i) (\x. (f x - sum (t INTER (0..n)) (\i. l2product s (w i) f * w i x)) + (sum (t INTER (0..n)) (\i. l2product s (w i) f * w i x) - g x))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC REALLIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN GEN_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [L2PRODUCT_RADD; SQUARE_INTEGRABLE_SUB; SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC REALLIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `i:num` THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[L2PRODUCT_RSUB; SQUARE_INTEGRABLE_SUM; L2PRODUCT_RSUM; FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN ASM_SIMP_TAC[L2PRODUCT_RMUL; ETA_AX] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_SIMP_TAC[SUM_DELTA; IN_INTER; IN_NUMSEG; LE_0; REAL_MUL_RID] THEN REWRITE_TAC[REAL_SUB_REFL]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REALLIM_NULL_COMPARISON)) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhand o rand) SCHWARTZ_INEQUALITY_ABS o lhand o snd) THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN ASM_SIMP_TAC[ORTHONORMAL_SYSTEM_L2NORM; REAL_MUL_LID]]);; (* ------------------------------------------------------------------------- *) (* Actual trigonometric orthogonality relations. *) (* ------------------------------------------------------------------------- *) let REAL_INTEGRABLE_ON_INTERVAL_TAC = MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC;; let HAS_REAL_INTEGRAL_SIN_NX = prove (`!n. ((\x. sin(&n * x)) has_real_integral &0) (real_interval[--pi,pi])`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0; REAL_MUL_LZERO; SIN_0] THEN MP_TAC(ISPECL [`\x. --(inv(&n) * cos(&n * x))`; `\x. sin(&n * x)`; `--pi`; `pi`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN SIMP_TAC[REAL_ARITH `&0 <= pi ==> --pi <= pi`; PI_POS_LE] THEN REWRITE_TAC[REAL_MUL_RNEG; SIN_NPI; COS_NPI; SIN_NEG; COS_NEG] THEN REWRITE_TAC[REAL_SUB_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REAL_DIFF_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN CONV_TAC REAL_FIELD);; let REAL_INTEGRABLE_SIN_CX = prove (`!c. (\x. sin(c * x)) real_integrable_on real_interval[--pi,pi]`, GEN_TAC THEN REAL_INTEGRABLE_ON_INTERVAL_TAC);; let REAL_INTEGRAL_SIN_NX = prove (`!n. real_integral (real_interval[--pi,pi]) (\x. sin(&n * x)) = &0`, GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_REAL_INTEGRAL_SIN_NX]);; let HAS_REAL_INTEGRAL_COS_NX = prove (`!n. ((\x. cos(&n * x)) has_real_integral (if n = 0 then &2 * pi else &0)) (real_interval[--pi,pi])`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[COS_0; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ARITH `&2 * pi = &1 * (pi - --pi)`] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; MP_TAC(ISPECL [`\x. inv(&n) * sin(&n * x)`; `\x. cos(&n * x)`; `--pi`; `pi`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN SIMP_TAC[REAL_ARITH `&0 <= pi ==> --pi <= pi`; PI_POS_LE] THEN REWRITE_TAC[REAL_MUL_RNEG; SIN_NPI; COS_NPI; SIN_NEG; COS_NEG] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_SUB_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REAL_DIFF_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN CONV_TAC REAL_FIELD]);; let REAL_INTEGRABLE_COS_CX = prove (`!c. (\x. cos(c * x)) real_integrable_on real_interval[--pi,pi]`, GEN_TAC THEN REAL_INTEGRABLE_ON_INTERVAL_TAC);; let REAL_INTEGRAL_COS_NX = prove (`!n. real_integral (real_interval[--pi,pi]) (\x. cos(&n * x)) = if n = 0 then &2 * pi else &0`, GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_REAL_INTEGRAL_COS_NX]);; let REAL_INTEGRAL_SIN_AND_COS = prove (`!m n. real_integral (real_interval[--pi,pi]) (\x. cos(&m * x) * cos(&n * x)) = (if m = n then if n = 0 then &2 * pi else pi else &0) /\ real_integral (real_interval[--pi,pi]) (\x. cos(&m * x) * sin(&n * x)) = &0 /\ real_integral (real_interval[--pi,pi]) (\x. sin(&m * x) * cos(&n * x)) = &0 /\ real_integral (real_interval[--pi,pi]) (\x. sin(&m * x) * sin(&n * x)) = (if m = n /\ ~(n = 0) then pi else &0)`, GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_SYM] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `m:num`] THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_SIN_COS; REAL_MUL_COS_SIN; REAL_MUL_COS_COS; REAL_MUL_SIN_SIN] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN SIMP_TAC[REAL_INTEGRAL_ADD; REAL_INTEGRAL_SUB; real_div; REAL_INTEGRABLE_SIN_CX; REAL_INTEGRABLE_COS_CX; REAL_INTEGRAL_RMUL; REAL_INTEGRABLE_SUB; REAL_INTEGRABLE_ADD] THEN ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_SUB] THEN REWRITE_TAC[REAL_INTEGRAL_SIN_NX; REAL_INTEGRAL_COS_NX] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_LZERO; REAL_ADD_LID] THEN ASM_SIMP_TAC[ARITH_RULE `n:num <= m ==> (m - n = 0 <=> m = n)`] THEN REWRITE_TAC[ADD_EQ_0] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ARITH `(a + a) * inv(&2) = a`; REAL_MUL_LZERO] THEN REAL_ARITH_TAC);; let REAL_INTEGRABLE_SIN_AND_COS = prove (`!m n a b. (\x. cos(&m * x) * cos(&n * x)) real_integrable_on real_interval[a,b] /\ (\x. cos(&m * x) * sin(&n * x)) real_integrable_on real_interval[a,b] /\ (\x. sin(&m * x) * cos(&n * x)) real_integrable_on real_interval[a,b] /\ (\x. sin(&m * x) * sin(&n * x)) real_integrable_on real_interval[a,b]`, REPEAT GEN_TAC THEN REPEAT CONJ_TAC THEN REAL_INTEGRABLE_ON_INTERVAL_TAC);; let trigonometric_set_def = new_definition `trigonometric_set n = if n = 0 then \x. &1 / sqrt(&2 * pi) else if ODD n then \x. sin(&(n DIV 2 + 1) * x) / sqrt(pi) else \x. cos(&(n DIV 2) * x) / sqrt(pi)`;; let trigonometric_set = prove (`trigonometric_set 0 = (\x. cos(&0 * x) / sqrt(&2 * pi)) /\ trigonometric_set (2 * n + 1) = (\x. sin(&(n + 1) * x) / sqrt(pi)) /\ trigonometric_set (2 * n + 2) = (\x. cos(&(n + 1) * x) / sqrt(pi))`, REWRITE_TAC[trigonometric_set_def; EVEN_ADD; EVEN_MULT; ARITH; ADD_EQ_0; GSYM NOT_EVEN] THEN REWRITE_TAC[ARITH_RULE `(2 * n + 1) DIV 2 = n`] THEN REWRITE_TAC[ARITH_RULE `(2 * n + 2) DIV 2 = n + 1`] THEN REWRITE_TAC[REAL_MUL_LZERO; COS_0]);; let TRIGONOMETRIC_SET_EVEN = prove (`!k. trigonometric_set(2 * k) = if k = 0 then \x. &1 / sqrt(&2 * pi) else \x. cos(&k * x) / sqrt pi`, INDUCT_TAC THEN REWRITE_TAC[ARITH; trigonometric_set; REAL_MUL_LZERO; COS_0] THEN REWRITE_TAC[NOT_SUC; ARITH_RULE `2 * SUC k = 2 * k + 2`] THEN REWRITE_TAC[trigonometric_set; GSYM ADD1]);; let ODD_EVEN_INDUCT_LEMMA = prove (`(!n:num. P 0) /\ (!n. P(2 * n + 1)) /\ (!n. P(2 * n + 2)) ==> !n. P n`, REWRITE_TAC[FORALL_SIMP] THEN STRIP_TAC THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(ISPEC `n:num` EVEN_OR_ODD) THEN REWRITE_TAC[EVEN_EXISTS; ODD_EXISTS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(2 * n) = 2 * n + 1 /\ SUC(2 * n + 1) = 2 * n + 2`]);; let ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET = prove (`orthonormal_system (real_interval[--pi,pi]) trigonometric_set`, REWRITE_TAC[orthonormal_system; l2product] THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REPEAT CONJ_TAC THEN X_GEN_TAC `m:num` THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REPEAT CONJ_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[trigonometric_set] THEN REWRITE_TAC[REAL_ARITH `a / k * b / l:real = (inv(k) * inv(l)) * a * b`] THEN SIMP_TAC[REAL_INTEGRAL_LMUL; REAL_INTEGRABLE_SIN_AND_COS] THEN REWRITE_TAC[REAL_INTEGRAL_SIN_AND_COS] THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_MUL_RZERO] THEN ASM_CASES_TAC `m:num = n` THEN TRY (COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN TRY (MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC) THEN ASM_REWRITE_TAC[ARITH_RULE `0 = a + b <=> a = 0 /\ b = 0`; EQ_ADD_RCANCEL; EQ_MULT_LCANCEL] THEN REWRITE_TAC[ARITH; REAL_MUL_RZERO] THEN REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_POW_2] THEN SIMP_TAC[SQRT_POW_2; REAL_LE_MUL; REAL_POS; PI_POS_LE] THEN MATCH_MP_TAC REAL_MUL_LINV THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let SQUARE_INTEGRABLE_TRIGONOMETRIC_SET = prove (`!i. (trigonometric_set i) square_integrable_on real_interval[--pi,pi]`, MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set] THEN REWRITE_TAC[real_div] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC);; (* ------------------------------------------------------------------------- *) (* Weierstrass for trigonometric polynomials. *) (* ------------------------------------------------------------------------- *) let WEIERSTRASS_TRIG_POLYNOMIAL = prove (`!f e. f real_continuous_on real_interval[--pi,pi] /\ f(--pi) = f pi /\ &0 < e ==> ?n a b. !x. x IN real_interval[--pi,pi] ==> abs(f x - sum(0..n) (\k. a k * sin(&k * x) + b k * cos(&k * x))) < e`, let lemma1 = prove (`!f. f real_continuous_on (:real) /\ (!x. f(x + &2 * pi) = f x) ==> !z. norm z = &1 ==> (f o Im o clog) real_continuous at z within {w | norm w = &1}`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `&0 <= Re z \/ Re z < &0`) THENL [ALL_TAC; REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS] THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN EXISTS_TAC `Cx o f o (\x. x + pi) o Im o clog o (--)` THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN STRIP_TAC THEN ASM_SIMP_TAC[CLOG_NEG; o_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IM_ADD; IM_SUB; IM_MUL_II; RE_CX; REAL_SUB_ADD] THEN ASM_REWRITE_TAC[REAL_ARITH `(x + pi) + pi = x + &2 * pi`]; REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN CONTINUOUS_TAC; REWRITE_TAC[GSYM o_ASSOC; GSYM REAL_CONTINUOUS_CONTINUOUS]]]] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_WITHIN_CLOG THEN REWRITE_TAC[GSYM real] THEN DISCH_TAC THEN UNDISCH_TAC `norm(z:complex) = &1` THEN ASM_SIMP_TAC[REAL_NORM; RE_NEG; REAL_NEG_GT0] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_COMPOSE THEN REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN] THEN TRY(MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]) THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN SIMP_TAC[IN_UNIV; WITHINREAL_UNIV]) in let lemma2 = prove (`!f. f real_continuous_on real_interval[--pi,pi] /\ f(--pi) = f pi ==> !z. norm z = &1 ==> (f o Im o clog) real_continuous at z within {w | norm w = &1}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`] REAL_TIETZE_PERIODIC_INTERVAL) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `g:real->real` lemma1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS] THEN MATCH_MP_TAC(REWRITE_RULE [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] CONTINUOUS_TRANSFORM_WITHIN) THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_REAL_INTERVAL; CLOG_WORKS; REAL_LT_IMP_LE]) in REPEAT STRIP_TAC THEN (CHOOSE_THEN MP_TAC o prove_inductive_relations_exist) `(!c. poly2 (\x. c)) /\ (!p q. poly2 p /\ poly2 q ==> poly2 (\x. p x + q x)) /\ (!p q. poly2 p /\ poly2 q ==> poly2 (\x. p x * q x)) /\ poly2 Re /\ poly2 Im` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (ASSUME_TAC o CONJUNCT1)) THEN MP_TAC(ISPECL [`poly2:(complex->real)->bool`; `{z:complex | norm z = &1}`] STONE_WEIERSTRASS) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN CONJ_TAC THENL [REWRITE_TAC[bounded; IN_ELIM_THM] THEN MESON_TAC[REAL_LE_REFL]; ONCE_REWRITE_TAC[SET_RULE `{x | p x} = {x | x IN UNIV /\ p x}`] THEN REWRITE_TAC[GSYM LIFT_EQ] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF; CLOSED_UNIV]]; MATCH_MP_TAC(MESON[] `(!x f. P f ==> R f x) ==> (!f. P f ==> !x. Q x ==> R f x)`) THEN GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_MUL] THEN REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN]; MAP_EVERY X_GEN_TAC [`w:complex`; `z:complex`] THEN REWRITE_TAC[IN_ELIM_THM; COMPLEX_EQ; DE_MORGAN_THM] THEN STRIP_TAC THENL [EXISTS_TAC `Re` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `Im` THEN ASM_REWRITE_TAC[]]]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`(f:real->real) o Im o clog`; `e:real`]) THEN ASM_SIMP_TAC[IN_ELIM_THM; lemma2] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `trigpoly = \f. ?n a b. f = \x. sum(0..n) (\k. a k * sin(&k * x) + b k * cos(&k * x))` THEN SUBGOAL_THEN `!c:real. trigpoly(\x:real. c)` ASSUME_TAC THENL [X_GEN_TAC `c:real` THEN EXPAND_TAC "trigpoly" THEN REWRITE_TAC[] THEN EXISTS_TAC `0` THEN REWRITE_TAC[SUM_SING_NUMSEG; REAL_MUL_LZERO; SIN_0; COS_0] THEN MAP_EVERY EXISTS_TAC [`(\n. &0):num->real`; `(\n. c):num->real`] THEN REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!f g:real->real. trigpoly f /\ trigpoly g ==> trigpoly(\x. f x + g x)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "trigpoly" THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n1:num`; `a1:num->real`; `b1:num->real`; `n2:num`; `a2:num->real`; `b2:num->real`] THEN DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN MAP_EVERY EXISTS_TAC [`MAX n1 n2`; `(\n. (if n <= n1 then a1 n else &0) + (if n <= n2 then a2 n else &0)):num->real`; `(\n. (if n <= n1 then b1 n else &0) + (if n <= n2 then b2 n else &0)):num->real`] THEN REWRITE_TAC[SUM_ADD_NUMSEG; FUN_EQ_THM; REAL_ADD_RDISTRIB] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a:real = e /\ b = g /\ c = f /\ d = h ==> (a + b) + (c + d) = (e + f) + (g + h)`) THEN REPEAT CONJ_TAC THEN REWRITE_TAC[COND_RATOR; COND_RAND; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!f s:num->bool. FINITE s /\ (!i. i IN s ==> trigpoly(f i)) ==> trigpoly(\x:real. sum s (\i. f i x))` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[SUM_CLAUSES; IN_INSERT; ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `!f:real->real c. trigpoly f ==> trigpoly (\x. c * f x)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "trigpoly" THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`; `b:num->real`] THEN DISCH_THEN SUBST1_TAC THEN MAP_EVERY EXISTS_TAC [`n:num`; `\i. c * (a:num->real) i`; `\i. c * (b:num->real) i`] THEN REWRITE_TAC[REAL_ADD_LDISTRIB; GSYM SUM_LMUL; GSYM REAL_MUL_ASSOC]; ALL_TAC] THEN SUBGOAL_THEN `!i. trigpoly(\x. sin(&i * x))` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "trigpoly" THEN MAP_EVERY EXISTS_TAC [`k:num`; `\i:num. if i = k then &1 else &0`; `\i:num. &0`] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; COND_RAND; COND_RATOR] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_LID; IN_NUMSEG; LE_0; LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!i. trigpoly(\x. cos(&i * x))` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "trigpoly" THEN MAP_EVERY EXISTS_TAC [`k:num`; `\i:num. &0`; `\i:num. if i = k then &1 else &0`] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; COND_RAND; COND_RATOR] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_LID; IN_NUMSEG; LE_0; LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!i j. trigpoly(\x. sin(&i * x) * sin(&j * x)) /\ trigpoly(\x. sin(&i * x) * cos(&j * x)) /\ trigpoly(\x. cos(&i * x) * sin(&j * x)) /\ trigpoly(\x. cos(&i * x) * cos(&j * x))` ASSUME_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI; REAL_MUL_AC]; ALL_TAC] THEN REWRITE_TAC[REAL_MUL_SIN_SIN; REAL_MUL_SIN_COS; REAL_MUL_COS_SIN; REAL_MUL_COS_COS] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN SIMP_TAC[REAL_OF_NUM_SUB; REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `x / &2 = inv(&2) * x`; REAL_ARITH `x - y:real = x + --(&1) * y`] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!f g:real->real. trigpoly f /\ trigpoly g ==> trigpoly(\x. f x * g x)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[] THEN DISCH_THEN(REPEAT_TCL STRIP_THM_THEN SUBST1_TAC) THEN REWRITE_TAC[REAL_MUL_SUM_NUMSEG] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(ai * si + bi * ci) * (aj * sj + bj * cj):real = ((ai * aj) * (si * sj) + (bi * bj) * (ci * cj)) + ((ai * bj) * (si * cj) + (aj * bi) * (ci * sj))`] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!f:complex->real. poly2 f ==> trigpoly(\x. f(cexp(ii * Cx x)))` (MP_TAC o SPEC `g:complex->real`) THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[RE_CEXP; IM_CEXP; RE_MUL_II; IM_CX; IM_MUL_II; RE_CX] THEN ONCE_REWRITE_TAC[MESON[REAL_MUL_LID] `cos x = cos(&1 * x) /\ sin x = sin(&1 * x)`] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "trigpoly" THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) [`n:num`; `a:num->real`; `b:num->real`] THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN X_GEN_TAC `r:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `cexp(ii * Cx r)`) THEN REWRITE_TAC[NORM_CEXP_II] THEN MATCH_MP_TAC(REAL_ARITH `x = x' ==> abs(x - y) < e ==> abs(x' - y) < e`) THEN REWRITE_TAC[o_DEF] THEN ASM_CASES_TAC `r = --pi` THENL [UNDISCH_THEN `r = --pi` SUBST_ALL_TAC THEN REWRITE_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN] THEN REWRITE_TAC[COS_NEG; SIN_NEG; SIN_PI; COS_PI] THEN REWRITE_TAC[CX_NEG; COMPLEX_MUL_RZERO; COMPLEX_NEG_0] THEN ASM_REWRITE_TAC[CLOG_NEG_1; COMPLEX_ADD_RID; IM_MUL_II; RE_CX]; ASM_SIMP_TAC[CLOG_CEXP; IM_MUL_II; RE_CX; REAL_LT_LE]]);; (* ------------------------------------------------------------------------- *) (* A bit of extra hacking round so that the ends of a function are OK. *) (* ------------------------------------------------------------------------- *) let REAL_INTEGRAL_TWEAK_ENDS = prove (`!a b d e. a < b /\ &0 < e ==> ?f. f real_continuous_on real_interval[a,b] /\ f(a) = d /\ f(b) = &0 /\ l2norm (real_interval[a,b]) f < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. (\x. if x <= a + inv(&n + &1) then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0) real_continuous_on real_interval[a,b]` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN SUBGOAL_THEN `a < a + inv(&n + &1)` ASSUME_TAC THENL [REWRITE_TAC[REAL_LT_ADDR; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `a + inv(&n + &1) <= b` THENL [SUBGOAL_THEN `real_interval[a,b] = real_interval[a,a + inv(&n + &1)] UNION real_interval[a + inv(&n + &1),b]` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_CASES THEN REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL [SIMP_TAC[real_div; REAL_CONTINUOUS_ON_MUL; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_ID]; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_CASES_TAC `x:real = a + inv(&n + &1)` THENL [ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_RZERO]; ASM_REAL_ARITH_TAC]]; MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THEN EXISTS_TAC `\x. ((&n + &1) * d) * ((a + inv(&n + &1)) - x)` THEN SIMP_TAC[real_div; REAL_CONTINUOUS_ON_MUL; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_ID] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MP_TAC (ISPECL [`\n x. (if x <= a + inv(&n + &1) then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0) pow 2`; `\x:real. if x = a then d pow 2 else &0`; `\x:real. (d:real) pow 2`; `real_interval[a,b]`] REAL_DOMINATED_CONVERGENCE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN ASM_SIMP_TAC[REAL_CONTINUOUS_ON_POW]; MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]; MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_POW] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_ABS] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_POS] THEN REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ARITH `d * x <= d <=> &0 <= d * (&1 - x)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN REWRITE_TAC[REAL_ARITH `&0 <= &1 - x * y <=> y * x <= &1`] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real = a` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN REWRITE_TAC[REAL_ADD_SUB] THEN SIMP_TAC[REAL_FIELD `&0 < x ==> (x * d) * inv x = d`; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[REALLIM_CONST]; MATCH_MP_TAC REALLIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(ISPEC `x - a:real` REAL_ARCH_INV) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN SUBGOAL_THEN `inv(&n + &1) <= inv(&N)` MP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `(e:real) pow 2`) THEN ASM_SIMP_TAC[REAL_POW_LT] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN MP_TAC(ISPEC `b - a:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?n:num. N <= n /\ M <= n` STRIP_ASSUME_TAC THENL [EXISTS_TAC `M + N:num` THEN ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `\x. if x <= a + inv(&n + &1) then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MP_TAC(REAL_ARITH `&0 < &n + &1`) THEN SIMP_TAC[REAL_LE_ADDR; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN CONV_TAC REAL_FIELD; SUBGOAL_THEN `inv(&n + &1) < b - a` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&M)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL [ASM_MESON_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[l2norm; l2product] THEN MATCH_MP_TAC SQRT_MONO_LT THEN REWRITE_TAC[GSYM REAL_POW_2] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(i - l) < e ==> &0 <= i /\ l = &0 ==> i < e`)) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_SIMP_TAC[REAL_INTEGRABLE_CONTINUOUS; REAL_CONTINUOUS_ON_POW] THEN REWRITE_TAC[REAL_LE_POW_2]; MP_TAC(ISPEC `real_interval[a,b]` REAL_INTEGRAL_0) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{a:real}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN SIMP_TAC[IN_DIFF; IN_SING]]]]);; let SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS_ENDS = prove (`!f a b e. f square_integrable_on real_interval[a,b] /\ a < b /\ &0 < e ==> ?g. g real_continuous_on real_interval[a,b] /\ g b = g a /\ g square_integrable_on real_interval[a,b] /\ l2norm (real_interval[a,b]) (\x. f x - g x) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `real_interval[a,b]`; `e / &2`] SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_MEASURABLE_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`a:real`; `b:real`; `(g:real->real) b - g a`; `e / &2`] REAL_INTEGRAL_TWEAK_ENDS) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `h:real->real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `h square_integrable_on real_interval[a,b]` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE]; ALL_TAC] THEN EXISTS_TAC `\x. (g:real->real) x + h x` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; REAL_ARITH_TAC; MATCH_MP_TAC SQUARE_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[REAL_ARITH `f - (g + h):real = (f - g) + --h`] THEN W(MP_TAC o PART_MATCH (lhand o rand) L2NORM_TRIANGLE o lhand o snd) THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; SQUARE_INTEGRABLE_NEG] THEN MATCH_MP_TAC(REAL_ARITH `y < e / &2 /\ z < e / &2 ==> x <= y + z ==> x < e`) THEN ASM_SIMP_TAC[L2NORM_NEG]]);; (* ------------------------------------------------------------------------- *) (* Hence the main approximation result. *) (* ------------------------------------------------------------------------- *) let WEIERSTRASS_L2_TRIG_POLYNOMIAL = prove (`!f e. f square_integrable_on real_interval[--pi,pi] /\ &0 < e ==> ?n a b. l2norm (real_interval[--pi,pi]) (\x. f x - sum(0..n) (\k. a k * sin(&k * x) + b k * cos(&k * x))) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `e / &2`] SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS_ENDS) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `--pi < pi <=> &0 < pi`; PI_POS] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real->real`; `e / &6`] WEIERSTRASS_TRIG_POLYNOMIAL) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) [`n:num`; `u:num->real`; `v:num->real`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN SUBGOAL_THEN `!n u v. (\x. sum(0..n) (\k. u k * sin(&k * x) + v k * cos(&k * x))) square_integrable_on (real_interval[--pi,pi])` ASSUME_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC; ALL_TAC] THEN EXISTS_TAC `l2norm (real_interval[--pi,pi]) (\x. f x - g x) + l2norm (real_interval[--pi,pi]) (\x. g x - sum(0..n) (\k. u k * sin(&k * x) + v k * cos(&k * x)))` THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (rand o rand) L2NORM_TRIANGLE o rand o snd) THEN REWRITE_TAC[REAL_ARITH `(f - g) + (g - h):real = f - h`] THEN ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y <= e / &2 ==> x + y < e`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[l2norm; l2product; GSYM REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN SUBGOAL_THEN `(\x. g x - sum(0..n) (\k. u k * sin(&k * x) + v k * cos(&k * x))) square_integrable_on (real_interval[--pi,pi])` MP_TAC THENL [ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB]; ALL_TAC] THEN REWRITE_TAC[square_integrable_on] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_INTEGRAL_POS; REAL_LE_POW_2] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `real_integral(real_interval[--pi,pi]) (\x. (e / &6) pow 2)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN MATCH_MP_TAC(REAL_ARITH `abs x < e ==> abs(x) <= abs e`) THEN ASM_SIMP_TAC[]; SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `--pi <= pi <=> &0 <= pi`; PI_POS_LE] THEN REWRITE_TAC[real_div; REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);; let WEIERSTRASS_L2_TRIGONOMETRIC_SET = prove (`!f e. f square_integrable_on real_interval[--pi,pi] /\ &0 < e ==> ?n a. l2norm (real_interval[--pi,pi]) (\x. f x - sum(0..n) (\k. a k * trigonometric_set k x)) < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP WEIERSTRASS_L2_TRIG_POLYNOMIAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`; `b:num->real`] THEN DISCH_TAC THEN EXISTS_TAC `2 * n + 1` THEN SUBST1_TAC(ARITH_RULE `0 = 2 * 0`) THEN REWRITE_TAC[SUM_PAIR; SUM_ADD_NUMSEG; trigonometric_set] THEN EXISTS_TAC `(\k. if k = 0 then sqrt(&2 * pi) * b 0 else if EVEN k then sqrt pi * b(k DIV 2) else if k <= 2 * n then sqrt pi * a((k + 1) DIV 2) else &0):num->real` THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> y = x ==> y < e`)) THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH; ADD_EQ_0; MULT_EQ_0] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN BINOP_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[LE_0; ARITH_RULE `2 * i <= 2 * n <=> i <= n`] THEN INDUCT_TAC THENL [REWRITE_TAC[trigonometric_set; ARITH; LE_0] THEN MATCH_MP_TAC(REAL_FIELD `&0 < s ==> (s * b) * c / s = b * c`) THEN MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_SUC; ARITH_RULE `2 * (SUC i) = 2 * i + 2`] THEN REWRITE_TAC[trigonometric_set; ARITH_RULE `(2 * i + 2) DIV 2 = SUC i`] THEN REWRITE_TAC[ADD1] THEN MATCH_MP_TAC(REAL_FIELD `&0 < s ==> (s * b) * c / s = b * c`) THEN MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]]; REWRITE_TAC[ARITH_RULE `2 * i + 1 = 2 * (i + 1) - 1`] THEN REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN REWRITE_TAC[GSYM ADD1; ARITH; SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n /\ 2 * SUC n - 1 = 2 * n + 1`] THEN REWRITE_TAC[ARITH_RULE `~(2 * n + 1 <= 2 * n)`; REAL_MUL_LZERO] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; REAL_ADD_RID] THEN SIMP_TAC[SIN_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID; ARITH] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> 2 * i - 1 <= 2 * n`] THEN INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[ARITH_RULE `SUC(2 * SUC i - 1) DIV 2 = SUC i`] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_FIELD `&0 < s ==> (s * b) * c / s = b * c`) THEN MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]]);; (* ------------------------------------------------------------------------- *) (* Convergence w.r.t. L2 norm of trigonometric Fourier series. *) (* ------------------------------------------------------------------------- *) let fourier_coefficient = new_definition `fourier_coefficient = orthonormal_coefficient (real_interval[--pi,pi]) trigonometric_set`;; let FOURIER_SERIES_L2 = prove (`!f. f square_integrable_on real_interval[--pi,pi] ==> ((\n. l2norm (real_interval[--pi,pi]) (\x. f(x) - sum(0..n) (\i. fourier_coefficient f i * trigonometric_set i x))) ---> &0) sequentially`, REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `e:real`] WEIERSTRASS_L2_TRIGONOMETRIC_SET) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:num->real` THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[fourier_coefficient] THEN MP_TAC(ISPECL [`real_interval[--pi,pi]`; `trigonometric_set`; `(\i. if i <= n then a i else &0):num->real`; `f:real->real`; `0..m`] ORTHONORMAL_OPTIMAL_PARTIAL_SUM) THEN ASM_REWRITE_TAC[FINITE_NUMSEG; ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET; SQUARE_INTEGRABLE_TRIGONOMETRIC_SET; REAL_SUB_RZERO] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a < e ==> x <= a ==> abs x < e`) THEN CONJ_TAC THENL [MATCH_MP_TAC L2NORM_POS_LE THEN MATCH_MP_TAC SQUARE_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SQUARE_INTEGRABLE_LMUL THEN REWRITE_TAC[ETA_AX; SQUARE_INTEGRABLE_TRIGONOMETRIC_SET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> y = x ==> y < e`)) THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_SIMP_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; LE_0] THEN SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; LE_0]]);; (* ------------------------------------------------------------------------- *) (* Fourier coefficients go to 0 (weak form of Riemann-Lebesgue). *) (* ------------------------------------------------------------------------- *) let TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE = prove (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] ==> (\x. trigonometric_set n x * f x) absolutely_real_integrable_on real_interval[--pi,pi]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set; real_div] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set; REAL_ABS_DIV] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`; SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);; let TRIGONOMETRIC_SET_MUL_INTEGRABLE = prove (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] ==> (\x. trigonometric_set n x * f x) real_integrable_on real_interval[--pi,pi]`, SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE]);; let ABSOLUTELY_INTEGRABLE_SIN_PRODUCT,ABSOLUTELY_INTEGRABLE_COS_PRODUCT = (CONJ_PAIR o prove) (`(!f k. f absolutely_real_integrable_on real_interval[--pi,pi] ==> (\x. sin(k * x) * f x) absolutely_real_integrable_on real_interval[--pi,pi]) /\ (!f k. f absolutely_real_integrable_on real_interval[--pi,pi] ==> (\x. cos(k * x) * f x) absolutely_real_integrable_on real_interval[--pi,pi])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN (ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set; real_div] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set; COS_BOUND; SIN_BOUND]]));; let FOURIER_PRODUCTS_INTEGRABLE_STRONG = prove (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] ==> f real_integrable_on real_interval[--pi,pi] /\ (!k. (\x. cos(k * x) * f x) real_integrable_on real_interval[--pi,pi]) /\ (!k. (\x. sin(k * x) * f x) real_integrable_on real_interval[--pi,pi])`, SIMP_TAC[ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; ABSOLUTELY_INTEGRABLE_COS_PRODUCT; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; let FOURIER_PRODUCTS_INTEGRABLE = prove (`!f. f square_integrable_on real_interval[--pi,pi] ==> f real_integrable_on real_interval[--pi,pi] /\ (!k. (\x. cos(k * x) * f x) real_integrable_on real_interval[--pi,pi]) /\ (!k. (\x. sin(k * x) * f x) real_integrable_on real_interval[--pi,pi])`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FOURIER_PRODUCTS_INTEGRABLE_STRONG THEN ASM_SIMP_TAC[REAL_MEASURABLE_REAL_INTERVAL; SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE]);; let ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove (`!f s e. real_measurable s /\ f absolutely_real_integrable_on s /\ &0 < e ==> ?g. g real_continuous_on (:real) /\ g absolutely_real_integrable_on s /\ real_integral s (\x. abs(f x - g x)) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `&1:real`; `e:real`] LSPACE_APPROXIMATE_CONTINUOUS) THEN ASM_REWRITE_TAC[LSPACE_1; GSYM ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_OF_NUM_LE; ARITH; GSYM REAL_MEASURABLE_MEASURABLE] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `drop o g o lift` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_DROP; ETA_AX; IMAGE_LIFT_UNIV]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX]; DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> x = y ==> y < e`)) THEN REWRITE_TAC[lnorm; REAL_INV_1; RPOW_POW; REAL_POW_1] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN ANTS_TAC THENL [SUBGOAL_THEN `(\x. f x - (drop o g o lift) x) absolutely_real_integrable_on s` MP_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_real_integrable_on]] THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ETA_AX]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF; NORM_LIFT; LIFT_DROP; NORM_REAL; GSYM drop; DROP_SUB; LIFT_SUB]]]);; let RIEMANN_LEBESGUE_SQUARE_INTEGRABLE = prove (`!s w f. orthonormal_system s w /\ (!i. w i square_integrable_on s) /\ f square_integrable_on s ==> (orthonormal_coefficient s w f ---> &0) sequentially`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(:num)` o MATCH_MP FOURIER_SERIES_SQUARE_SUMMABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMMABLE_IMP_TOZERO) THEN SIMP_TAC[IN_UNIV; REALLIM_NULL_POW_EQ; ARITH; ETA_AX]);; let RIEMANN_LEBESGUE = prove (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] ==> (fourier_coefficient f ---> &0) sequentially`, REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real->real`; `real_interval[--pi,pi]`; `e / &2`] ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN ASM_SIMP_TAC[REAL_HALF; REAL_MEASURABLE_REAL_INTERVAL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`real_interval[--pi,pi]`; `trigonometric_set`; `g:real->real`] RIEMANN_LEBESGUE_SQUARE_INTEGRABLE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET; SQUARE_INTEGRABLE_TRIGONOMETRIC_SET] THEN MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `N:num <= n` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e / &2 ==> abs(y - z) <= x ==> y < e / &2 ==> z < e`)) THEN MATCH_MP_TAC(REAL_ARITH `abs(x - y) <= r ==> abs(abs x - abs y) <= r`) THEN W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_SUB o rand o lhand o snd) THEN ASM_SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE] THEN REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN ASM_SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE]; SUBGOAL_THEN `(\x. (f:real->real) x - g x) absolutely_real_integrable_on real_interval[--pi,pi]` MP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB]; ALL_TAC] THEN SIMP_TAC[absolutely_real_integrable_on]; GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SUB] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set; REAL_ABS_DIV] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`; SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);; let RIEMANN_LEBESGUE_SIN = prove (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] ==> ((\n. real_integral (real_interval[--pi,pi]) (\x. sin(&n * x) * f x)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC)] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `2 * n + 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; trigonometric_set; l2product; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[REAL_ARITH `a / sqrt pi * b = inv(sqrt pi) * a * b`] THEN ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; SQRT_POS_LT; PI_POS; REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_ABS_DIV] THEN REWRITE_TAC[ADD1] THEN MATCH_MP_TAC(REAL_ARITH `d <= e ==> x < d ==> x < e`) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &4 ==> inv(&4) * abs x <= &1`) THEN SIMP_TAC[SQRT_POS_LE; PI_POS_LE] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);; let RIEMANN_LEBESGUE_COS = prove (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] ==> ((\n. real_integral (real_interval[--pi,pi]) (\x. cos(&n * x) * f x)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC)] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `2 * n + 2`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; trigonometric_set; l2product; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[REAL_ARITH `a / sqrt pi * b = inv(sqrt pi) * a * b`] THEN ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; SQRT_POS_LT; PI_POS; REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_ABS_DIV] THEN REWRITE_TAC[ADD1] THEN MATCH_MP_TAC(REAL_ARITH `d <= e ==> x < d ==> x < e`) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &4 ==> inv(&4) * abs x <= &1`) THEN SIMP_TAC[SQRT_POS_LE; PI_POS_LE] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);; let RIEMANN_LEBESGUE_SIN_HALF = prove (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] ==> ((\n. real_integral (real_interval[--pi,pi]) (\x. sin((&n + &1 / &2) * x) * f x)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN REWRITE_TAC[SIN_ADD; REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `(\n. real_integral (real_interval[--pi,pi]) (\x. sin(&n * x) * cos(&1 / &2 * x) * f x) + real_integral (real_interval[--pi,pi]) (\x. cos(&n * x) * sin(&1 / &2 * x) * f x))` THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_ADD; MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC RIEMANN_LEBESGUE_SIN; MATCH_MP_TAC RIEMANN_LEBESGUE_COS]] THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; ABSOLUTELY_INTEGRABLE_COS_PRODUCT]);; let FOURIER_SUM_LIMIT_PAIR = prove (`!f n t l. f absolutely_real_integrable_on real_interval [--pi,pi] ==> (((\n. sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> l) sequentially <=> ((\n. sum(0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> l) sequentially)`, REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "1")) THEN SUBGOAL_THEN `&0 < e / &2` (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "2")) THEN EXISTS_TAC `N1 + 2 * N2 + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN DISJ_CASES_THEN SUBST1_TAC (ARITH_RULE `n = 2 * n DIV 2 \/ n = SUC(2 * n DIV 2)`) THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THENL [MATCH_MP_TAC(REAL_ARITH `abs x < e / &2 ==> abs x < e`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `abs(x - l) < e / &2 /\ abs y < e / &2 ==> abs((x + y) - l) < e`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs(x * y) <= abs(x) * &1 /\ abs(x) < e ==> abs(x * y) < e`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN SPEC_TAC(`SUC(2 * n DIV 2)`,`r:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[ADD1; trigonometric_set; REAL_ABS_DIV] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`; SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Express Fourier sum in terms of the special expansion at the origin. *) (* ------------------------------------------------------------------------- *) let FOURIER_SUM_0 = prove (`!f n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = sum (0..n DIV 2) (\k. fourier_coefficient f (2 * k) * trigonometric_set (2 * k) (&0))`, REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (2 * 0..2 * (n DIV 2) + 1) (\k. fourier_coefficient f k * trigonometric_set k (&0))` THEN CONJ_TAC THENL [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[IN_NUMSEG; SUBSET; LE_0] THEN CONJ_TAC THENL [ARITH_TAC; GEN_TAC] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP (ARITH_RULE `x <= 2 * n DIV 2 + 1 /\ ~(x <= n) ==> x = 2 * n DIV 2 + 1`)); REWRITE_TAC[SUM_PAIR]] THEN REWRITE_TAC[trigonometric_set; real_div; REAL_MUL_RZERO; SIN_0; REAL_MUL_LZERO; REAL_ADD_RID]);; let FOURIER_SUM_0_EXPLICIT = prove (`!f n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = (fourier_coefficient f 0 / sqrt(&2) + sum (1..n DIV 2) (\k. fourier_coefficient f (2 * k))) / sqrt pi`, REPEAT GEN_TAC THEN REWRITE_TAC[FOURIER_SUM_0] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; real_div; REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN REWRITE_TAC[MULT_CLAUSES; trigonometric_set; REAL_MUL_LZERO; COS_0; real_div] THEN BINOP_TAC THENL [REWRITE_TAC[REAL_MUL_LID; SQRT_MUL; REAL_INV_MUL; GSYM REAL_MUL_ASSOC]; REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[trigonometric_set; ARITH_RULE `2 * SUC i = 2 * i + 2`] THEN REWRITE_TAC[REAL_MUL_RZERO; COS_0; real_div; REAL_MUL_LID]]);; let FOURIER_SUM_0_INTEGRALS = prove (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] ==> sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = (real_integral(real_interval[--pi,pi]) f / &2 + sum(1..n DIV 2) (\k. real_integral (real_interval[--pi,pi]) (\x. cos(&k * x) * f x))) / pi`, REPEAT STRIP_TAC THEN REWRITE_TAC[FOURIER_SUM_0_EXPLICIT] THEN REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN REWRITE_TAC[trigonometric_set] THEN BINOP_TAC THENL [REWRITE_TAC[COS_0; REAL_MUL_LZERO; real_div; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN REWRITE_TAC[REAL_ARITH `((a * b) * c) * d:real = b * a * c * d`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[GSYM SQRT_MUL; REAL_POS; PI_POS_LE; REAL_LE_MUL] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC POW_2_SQRT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; MATCH_MP_TAC SUM_EQ_NUMSEG THEN INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN STRIP_TAC THEN REWRITE_TAC[trigonometric_set; ARITH_RULE `2 * SUC i = 2 * i + 2`] THEN REWRITE_TAC[REAL_MUL_RZERO; COS_0; real_div; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN ONCE_REWRITE_TAC[REAL_ARITH `(i * x) * i:real = x * i * i`] THEN REWRITE_TAC[ADD1; GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC SQRT_POW_2 THEN REWRITE_TAC[PI_POS_LE]]);; let FOURIER_SUM_0_INTEGRAL = prove (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] ==> sum(0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = real_integral(real_interval[--pi,pi]) (\x. (&1 / &2 + sum(1..n DIV 2) (\k. cos(&k * x))) * f x) / pi`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_0_INTEGRALS] THEN ASM_SIMP_TAC[GSYM REAL_INTEGRAL_SUM; FINITE_NUMSEG; FOURIER_PRODUCTS_INTEGRABLE_STRONG; real_div; GSYM REAL_INTEGRAL_ADD; GSYM REAL_INTEGRAL_RMUL; REAL_INTEGRABLE_RMUL; ETA_AX; REAL_INTEGRABLE_SUM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; SUM_RMUL] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* How Fourier coefficients behave under addition etc. *) (* ------------------------------------------------------------------------- *) let FOURIER_COEFFICIENT_ADD = prove (`!f g i. f absolutely_real_integrable_on real_interval[--pi,pi] /\ g absolutely_real_integrable_on real_interval[--pi,pi] ==> fourier_coefficient (\x. f x + g x) i = fourier_coefficient f i + fourier_coefficient g i`, SIMP_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE; REAL_ADD_LDISTRIB; REAL_INTEGRAL_ADD]);; let FOURIER_COEFFICIENT_SUB = prove (`!f g i. f absolutely_real_integrable_on real_interval[--pi,pi] /\ g absolutely_real_integrable_on real_interval[--pi,pi] ==> fourier_coefficient (\x. f x - g x) i = fourier_coefficient f i - fourier_coefficient g i`, SIMP_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE; REAL_SUB_LDISTRIB; REAL_INTEGRAL_SUB]);; let FOURIER_COEFFICIENT_CONST = prove (`!c i. fourier_coefficient (\x. c) i = if i = 0 then c * sqrt(&2 * pi) else &0`, GEN_TAC THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product; trigonometric_set] THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `0` HAS_REAL_INTEGRAL_COS_NX) THEN DISCH_THEN(MP_TAC o SPEC `inv(sqrt(&2 * pi)) * c` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN MATCH_MP_TAC(REAL_FIELD `&0 < s /\ s pow 2 = &2 * pi ==> &2 * pi * inv(s) * c = c * s`) THEN SIMP_TAC[SQRT_POW_2; REAL_LT_MUL; REAL_LE_MUL; REAL_POS; REAL_OF_NUM_LT; ARITH; SQRT_POS_LT; PI_POS; REAL_LT_IMP_LE]; X_GEN_TAC `n:num` THEN MP_TAC(ISPEC `n + 1` HAS_REAL_INTEGRAL_SIN_NX) THEN DISCH_THEN(MP_TAC o SPEC `inv(sqrt pi) * c` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LZERO] THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_INTEGRAL_UNIQUE]; X_GEN_TAC `n:num` THEN MP_TAC(ISPEC `n + 1` HAS_REAL_INTEGRAL_COS_NX) THEN DISCH_THEN(MP_TAC o SPEC `inv(sqrt pi) * c` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LZERO] THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_INTEGRAL_UNIQUE; REAL_MUL_LZERO]]);; (* ------------------------------------------------------------------------- *) (* Shifting the origin for integration of periodic functions. *) (* ------------------------------------------------------------------------- *) let REAL_PERIODIC_INTEGER_MULTIPLE = prove (`!f:real->real a. (!x. f(x + a) = f x) <=> (!x n. integer n ==> f(x + n * a) = f x)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[INTEGER_CLOSED; REAL_MUL_LID]] THEN DISCH_TAC THEN SUBGOAL_THEN `!x n. f(x + &n * a) = (f:real->real) x` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_ADD_ASSOC; REAL_MUL_LID]; REWRITE_TAC[INTEGER_CASES] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_ARITH `(x + -- &n * a) + &n * a = x`]]);; let HAS_REAL_INTEGRAL_OFFSET = prove (`!f i a b c. (f has_real_integral i) (real_interval[a,b]) ==> ((\x. f(x + c)) has_real_integral i) (real_interval[a - c,b - c])`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`&1`; `c:real`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY)) THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_LID; REAL_INV_1] THEN REWRITE_TAC[REAL_ABS_1; REAL_MUL_LID; REAL_INV_1] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_REAL_INTERVAL; EXISTS_REFL; REAL_ARITH `x - c:real = y <=> x = y + c`] THEN REAL_ARITH_TAC);; let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_LEMMA = prove (`!f i a b c. (!x. f(x + (b - a)) = f(x)) /\ (f has_real_integral i) (real_interval[a,a+c]) ==> (f has_real_integral i) (real_interval[b,b+c])`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `a - b:real` o MATCH_MP HAS_REAL_INTEGRAL_OFFSET) THEN REWRITE_TAC[REAL_ARITH `a - (a - b):real = b /\ (a + c) - (a - b) = b + c`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_EQ) THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x + a - b:real`) THEN REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS = prove (`!f i a b c. (!x. f(x + (b - a)) = f x) /\ &0 <= c /\ a + c <= b /\ (f has_real_integral i) (real_interval[a,b]) ==> ((\x. f(x + c)) has_real_integral i) (real_interval[a,b])`, let tac = REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[a,b]` THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN CONJ_TAC THENL [ASM_MESON_TAC[real_integrable_on]; ASM_REAL_ARITH_TAC] in REPEAT STRIP_TAC THEN CONJUNCTS_THEN SUBST1_TAC (REAL_ARITH `a:real = (a + c) - c /\ b = (b + c) - c`) THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_OFFSET THEN SUBGOAL_THEN `((f has_real_integral (real_integral(real_interval[a,a+c]) f)) (real_interval[a,a+c]) /\ (f has_real_integral (real_integral(real_interval[a+c,b]) f)) (real_interval[a+c,b])) /\ ((f has_real_integral (real_integral(real_interval[a+c,b]) f)) (real_interval[a+c,b]) /\ (f has_real_integral (real_integral(real_interval[a,a+c]) f)) (real_interval[b,b+c]))` MP_TAC THENL [REPEAT CONJ_TAC THEN TRY tac THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_LEMMA THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[] THEN tac; DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `a /\ b /\ c /\ d ==> e <=> c /\ d ==> a /\ b ==> e`] HAS_REAL_INTEGRAL_COMBINE))) THEN REPEAT(ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; REAL_ADD_SYM]]);; let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_WEAK = prove (`!f i a b c. (!x. f(x + (b - a)) = f x) /\ abs(c) <= b - a /\ (f has_real_integral i) (real_interval[a,b]) ==> ((\x. f(x + c)) has_real_integral i) (real_interval[a,b])`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= c` THENL [MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`\x. (f:real->real)(--x)`; `i:real`; `--b:real`; `--a:real`; `--c:real`] HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS) THEN ASM_REWRITE_TAC[REAL_NEG_ADD; HAS_REAL_INTEGRAL_REFLECT] THEN REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN X_GEN_TAC `x:real` THEN FIRST_X_ASSUM(MP_TAC o SPEC `--x + (a - b):real`) THEN REWRITE_TAC[REAL_ARITH `--(--a - --b):real = a - b`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN REAL_ARITH_TAC]);; let HAS_REAL_INTEGRAL_PERIODIC_OFFSET = prove (`!f i a b c. (!x. f(x + (b - a)) = f x) /\ (f has_real_integral i) (real_interval[a,b]) ==> ((\x. f(x + c)) has_real_integral i) (real_interval[a,b])`, REPEAT GEN_TAC THEN DISJ_CASES_TAC (REAL_ARITH `b <= a \/ a < b`) THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_NULL_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `((\x. f(x + (b - a) * frac(c / (b - a)))) has_real_integral i) (real_interval[a,b])` MP_TAC THENL [MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_WEAK THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH `a < b /\ (b - a) * f < (b - a) * &1 ==> abs(b - a) * f <= b - a`) THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_LMUL_EQ] THEN ASM_REWRITE_TAC[real_abs; FLOOR_FRAC]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_EQ) THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN REWRITE_TAC[FRAC_FLOOR] THEN ASM_SIMP_TAC[REAL_FIELD `a < b ==> x + (b - a) * (c / (b - a) - f) = (x + c) + --f * (b - a)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_PERIODIC_INTEGER_MULTIPLE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[INTEGER_CLOSED; FLOOR]]);; let REAL_INTEGRABLE_PERIODIC_OFFSET = prove (`!f a b c. (!x. f(x + (b - a)) = f x) /\ f real_integrable_on real_interval[a,b] ==> (\x. f(x + c)) real_integrable_on real_interval[a,b]`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_PERIODIC_OFFSET]);; let ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET = prove (`!f a b c. (!x. f(x + (b - a)) = f x) /\ f absolutely_real_integrable_on real_interval[a,b] ==> (\x. f(x + c)) absolutely_real_integrable_on real_interval[a,b]`, REWRITE_TAC[absolutely_real_integrable_on] THEN REPEAT STRIP_TAC THEN MP_TAC(GEN `f:real->real` (SPEC_ALL REAL_INTEGRABLE_PERIODIC_OFFSET)) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let REAL_INTEGRAL_PERIODIC_OFFSET = prove (`!f a b c. (!x. f(x + (b - a)) = f x) /\ f real_integrable_on real_interval[a,b] ==> real_integral (real_interval[a,b]) (\x. f(x + c)) = real_integral (real_interval[a,b]) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);; let FOURIER_OFFSET_TERM = prove (`!f n t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f x) ==> fourier_coefficient (\x. f(x + t)) (2 * n + 2) * trigonometric_set (2 * n + 2) (&0) = fourier_coefficient f (2 * n + 1) * trigonometric_set (2 * n + 1) t + fourier_coefficient f (2 * n + 2) * trigonometric_set (2 * n + 2) t`, REPEAT STRIP_TAC THEN REWRITE_TAC[trigonometric_set; fourier_coefficient; orthonormal_coefficient] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; COS_0; REAL_MUL_RID] THEN REWRITE_TAC[l2product] THEN REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; GSYM REAL_INTEGRAL_RMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = (a * c) * b`] THEN REWRITE_TAC[REAL_MUL_SIN_SIN; REAL_MUL_COS_COS] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_ADD o rand o rand o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set; real_div] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; ASM_REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_sub] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= &1 /\ abs y <= &1 ==> abs((x + y) / &2) <= &1`) THEN REWRITE_TAC[SIN_BOUND; COS_BOUND; REAL_ABS_NEG]]); ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `(cm - cp) / &2 * f + (cm + cp) / &2 * f = cm * f`] THEN MP_TAC(ISPECL [`\x. cos(&(n + 1) * (x - t)) * f x`; `real_integral (real_interval[--pi,pi]) (\x. cos(&(n + 1) * (x - t)) * f x)`; `--pi`; `pi`; `t:real`] HAS_REAL_INTEGRAL_PERIODIC_OFFSET) THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(\x. cos (&(n + 1) * (x - t)) * f x) real_integrable_on real_interval[--pi,pi]` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN REWRITE_TAC[trigonometric_set; real_div] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; ASM_REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND]]; REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRAL] THEN DISCH_TAC] THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ARITH `n * ((x + &2 * pi) - t) = (&2 * n) * pi + n * (x - t)`] THEN REWRITE_TAC[COS_ADD; SIN_NPI; COS_NPI; REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_POW_NEG; REAL_MUL_LZERO; EVEN_MULT; ARITH] THEN REWRITE_TAC[REAL_POW_ONE; REAL_SUB_RZERO; REAL_MUL_LID]; REWRITE_TAC[REAL_ARITH `(x + t) - t:real = x`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = a * c * b`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]);; let FOURIER_SUM_OFFSET = prove (`!f n t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) = sum(0..2*n) (\k. fourier_coefficient (\x. f (x + t)) k * trigonometric_set k (&0))`, REPEAT STRIP_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN BINOP_TAC THENL [REWRITE_TAC[fourier_coefficient; trigonometric_set; l2product; orthonormal_coefficient; REAL_MUL_LZERO; COS_0] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC(SPECL [`\x:real. &1 / sqrt(&2 * pi) * f x`; `--pi`; `pi`; `t:real`] REAL_INTEGRAL_PERIODIC_OFFSET) THEN ASM_SIMP_TAC[REAL_ARITH `pi - --pi = &2 * pi`; REAL_INTEGRABLE_LMUL; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]; ALL_TAC] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; SUM_CLAUSES_NUMSEG; ARITH_EQ] THEN SUBGOAL_THEN `1..2*n = 2*0+1..(2*(n-1)+1)+1` SUBST1_TAC THENL [BINOP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SUM_OFFSET; SUM_PAIR] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[ARITH_RULE `(k + 1) + 1 = k + 2`] THEN ASM_SIMP_TAC[GSYM FOURIER_OFFSET_TERM] THEN REWRITE_TAC[trigonometric_set; REAL_MUL_RZERO; COS_0; SIN_0] THEN REAL_ARITH_TAC);; let FOURIER_SUM_OFFSET_UNPAIRED = prove (`!f n t. f absolutely_real_integrable_on real_interval [--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) = sum(0..n) (\k. fourier_coefficient (\x. f (x + t)) (2 * k) * trigonometric_set (2 * k) (&0))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(0..n) (\k. fourier_coefficient (\x. f (x + t)) (2 * k) * trigonometric_set (2 * k) (&0) + fourier_coefficient (\x. f (x + t)) (2 * k + 1) * trigonometric_set (2 * k + 1) (&0))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_PAIR] THEN REWRITE_TAC[GSYM ADD1; MULT_CLAUSES; SUM_CLAUSES_NUMSEG; LE_0]; MATCH_MP_TAC SUM_EQ_NUMSEG THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL_0]] THEN REWRITE_TAC[ADD1; trigonometric_set; real_div; REAL_MUL_RZERO] THEN REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID]);; (* ------------------------------------------------------------------------- *) (* Express partial sums using Dirichlet kernel. *) (* ------------------------------------------------------------------------- *) let dirichlet_kernel = new_definition `dirichlet_kernel n x = if x = &0 then &n + &1 / &2 else sin((&n + &1 / &2) * x) / (&2 * sin(x / &2))`;; let DIRICHLET_KERNEL_0 = prove (`!x. abs(x) < &2 * pi ==> dirichlet_kernel 0 x = &1 / &2`, REPEAT STRIP_TAC THEN REWRITE_TAC[dirichlet_kernel] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_SYM; REAL_MUL_RID] THEN MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> inv(&2 * x) * x = inv(&2)`) THEN DISCH_TAC THEN SUBGOAL_THEN `~(x * inv(&2) = &0)` MP_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[] THEN MATCH_MP_TAC SIN_EQ_0_PI] THEN ASM_REAL_ARITH_TAC);; let DIRICHLET_KERNEL_NEG = prove (`!n x. dirichlet_kernel n (--x) = dirichlet_kernel n x`, REPEAT GEN_TAC THEN REWRITE_TAC[dirichlet_kernel; REAL_NEG_EQ_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; real_div; SIN_NEG; REAL_INV_NEG; REAL_NEG_NEG]);; let DIRICHLET_KERNEL_CONTINUOUS_STRONG = prove (`!n. (dirichlet_kernel n) real_continuous_on real_interval(--(&2 * pi),&2 * pi)`, let lemma = prove (`f real_differentiable (atreal a) /\ f(a) = b ==> (f ---> b) (atreal a)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL) THEN REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN ASM_MESON_TAC[]) in SIMP_TAC[REAL_OPEN_REAL_INTERVAL; IN_REAL_INTERVAL; REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT] THEN MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[dirichlet_kernel] THEN ASM_CASES_TAC `x = &0` THENL [ALL_TAC; SUBGOAL_THEN `(\x. sin((&k + &1 / &2) * x) / (&2 * sin(x / &2))) real_continuous atreal x` MP_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_DIV THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REWRITE_TAC[NETLIMIT_ATREAL] THEN ASM_REAL_ARITH_TAC]; ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `abs x` THEN ASM_REAL_ARITH_TAC]] THEN ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\x. sin((&k + &1 / &2) * x) / (&2 * sin(x / &2))` THEN CONJ_TAC THENL [SIMP_TAC[EVENTUALLY_ATREAL; REAL_ARITH `&0 < abs(x - &0) <=> ~(x = &0)`] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]; ALL_TAC] THEN MATCH_MP_TAC LHOSPITAL THEN MAP_EVERY EXISTS_TAC [`\x. (&k + &1 / &2) * cos((&k + &1 / &2) * x)`; `\x. cos(x / &2)`; `&1`] THEN REWRITE_TAC[REAL_LT_01; REAL_SUB_RZERO] THEN REPEAT STRIP_TAC THENL [REAL_DIFF_TAC THEN REAL_ARITH_TAC; REAL_DIFF_TAC THEN REAL_ARITH_TAC; FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI) THEN MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC lemma THEN REWRITE_TAC[REAL_MUL_RZERO; SIN_0] THEN REAL_DIFFERENTIABLE_TAC; MATCH_MP_TAC lemma THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; real_div; SIN_0] THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_DIV_1] THEN MATCH_MP_TAC REALLIM_DIV THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN CONJ_TAC THEN MATCH_MP_TAC lemma THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; real_div; COS_0; REAL_MUL_RID] THEN REAL_DIFFERENTIABLE_TAC]);; let DIRICHLET_KERNEL_CONTINUOUS = prove (`!n. (dirichlet_kernel n) real_continuous_on real_interval[--pi,pi]`, GEN_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `real_interval(--(&2 * pi),&2 * pi)` THEN REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS_STRONG] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL = prove (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] ==> (\x. dirichlet_kernel n x * f x) absolutely_real_integrable_on real_interval[--pi,pi]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN ASM_REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS; ETA_AX; REAL_CLOSED_REAL_INTERVAL]; MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS; ETA_AX; REAL_COMPACT_INTERVAL]]);; let COSINE_SUM_LEMMA = prove (`!n x. (&1 / &2 + sum(1..n) (\k. cos(&k * x))) * sin(x / &2) = sin((&n + &1 / &2) * x) / &2`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL [ASM_REWRITE_TAC[REAL_ADD_LID; SUM_CLAUSES_NUMSEG; ARITH] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ADD_RID; REAL_MUL_SYM]; REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN REWRITE_TAC[REAL_MUL_COS_SIN; real_div; REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN `!k x. &k * x + x * inv(&2) = (&(k + 1) * x - x * inv(&2))` (fun th -> REWRITE_TAC[th; SUM_DIFFS_ALT]) THENL [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM real_div] THEN REWRITE_TAC[REAL_ARITH `&1 * x - x / &2 = x / &2`] THEN REWRITE_TAC[REAL_ARITH `(&n + &1) * x - x / &2 = (&n + &1 / &2) * x`] THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN REAL_ARITH_TAC]);; let DIRICHLET_KERNEL_COSINE_SUM = prove (`!n x. ~(x = &0) /\ abs(x) < &2 * pi ==> dirichlet_kernel n x = &1 / &2 + sum(1..n) (\k. cos(&k * x))`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN MATCH_MP_TAC(REAL_FIELD `~(y = &0) /\ z * y = x / &2 ==> x / (&2 * y) = z`) THEN REWRITE_TAC[COSINE_SUM_LEMMA] THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC);; let HAS_REAL_INTEGRAL_DIRICHLET_KERNEL = prove (`!n. (dirichlet_kernel n has_real_integral pi) (real_interval[--pi,pi])`, GEN_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `\x. &1 / &2 + sum(1..n) (\k. cos(&k * x))` THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN SIMP_TAC[REAL_ARITH `&0 < pi /\ --pi <= x /\ x <= pi ==> abs(x) < &2 * pi`; DIRICHLET_KERNEL_COSINE_SUM; PI_POS] THEN SUBGOAL_THEN `pi = pi + sum(1..n) (\k. &0)` MP_TAC THENL [REWRITE_TAC[SUM_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `pi = (&1 / &2) * (pi - --pi)`] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MP_TAC(SPEC `k:num` HAS_REAL_INTEGRAL_COS_NX) THEN ASM_SIMP_TAC[LE_1]]);; let HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF = prove (`!n. (dirichlet_kernel n has_real_integral (pi / &2)) (real_interval[&0,pi])`, GEN_TAC THEN MP_TAC(ISPECL [`dirichlet_kernel n`; `--pi`; `pi`; `&0`; `pi`] REAL_INTEGRABLE_SUBINTERVAL) THEN ANTS_TAC THENL [CONJ_TAC THENL [MESON_TAC[HAS_REAL_INTEGRAL_DIRICHLET_KERNEL; real_integrable_on]; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC]; REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRAL] THEN DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM HAS_REAL_INTEGRAL_REFLECT]) THEN REWRITE_TAC[DIRICHLET_KERNEL_NEG; ETA_AX; REAL_NEG_0] THEN DISCH_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL [ASM_MESON_TAC[real_integrable_on]; ALL_TAC] THEN MP_TAC(ISPECL [`dirichlet_kernel n`; `real_integral (real_interval [&0,pi]) (dirichlet_kernel n)`; `real_integral (real_interval [&0,pi]) (dirichlet_kernel n)`; `--pi`; `pi`; `&0`] HAS_REAL_INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[GSYM REAL_MUL_2] THEN ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN MATCH_MP_TAC(REAL_ARITH `x = pi ==> x = &2 * y ==> y = pi / &2`) THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_REAL_INTEGRAL_DIRICHLET_KERNEL]);; let FOURIER_SUM_OFFSET_DIRICHLET_KERNEL = prove (`!f n t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) = real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * f(x + t)) / pi`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_UNPAIRED] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH] THEN REWRITE_TAC[trigonometric_set; COS_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `fourier_coefficient (\x. f(x + t)) 0 * &1 / sqrt(&2 * pi) + sum (1..n) (\k. fourier_coefficient (\x. f(x + t)) (2 * k) / sqrt pi)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[TRIGONOMETRIC_SET_EVEN; LE_1; REAL_MUL_RZERO; COS_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[real_div; REAL_MUL_LID; fourier_coefficient; orthonormal_coefficient; trigonometric_set; l2product] THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [GSYM REAL_MUL_ASSOC; GSYM REAL_INTEGRAL_RMUL; GSYM REAL_INTEGRAL_ADD; ABSOLUTELY_INTEGRABLE_COS_PRODUCT; ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; ABSOLUTELY_REAL_INTEGRABLE_LMUL; TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; GSYM REAL_INTEGRAL_SUM; FINITE_NUMSEG; ABSOLUTELY_REAL_INTEGRABLE_RMUL; ABSOLUTELY_REAL_INTEGRABLE_SUM; ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL] THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{}:real->bool` THEN REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; COS_0; REAL_ARITH `a * b * c * b:real = (a * c) * b pow 2`] THEN SIMP_TAC[REAL_POW_INV; SQRT_POW_2; REAL_LE_MUL; REAL_POS; PI_POS_LE; REAL_LE_INV_EQ] THEN REWRITE_TAC[REAL_INV_MUL; REAL_ARITH `d * f * i = (&1 * f) * inv(&2) * i + y <=> i * f * (d - &1 / &2) = y`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1..n) (\k. inv pi * f(x + t) * cos(&k * x))` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_ARITH `x - &1 / &2 = y <=> x = &1 / &2 + y`] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[dirichlet_kernel] THENL [REWRITE_TAC[REAL_MUL_RZERO; COS_0; SUM_CONST_NUMSEG; ADD_SUB] THEN REAL_ARITH_TAC; MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN MATCH_MP_TAC(TAUT `a /\ b /\ ~d /\ (~c ==> e) ==> (a /\ b /\ c ==> d) ==> e`) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> (x / (&2 * y) = z <=> z * y = x / &2)`] THEN REWRITE_TAC[COSINE_SUM_LEMMA]]; MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[TRIGONOMETRIC_SET_EVEN; LE_1] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_RING `s * s:real = p ==> p * f * c = (c * s) * f * s`) THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; PI_POS_LE]]);; let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL = prove (`!f t l. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> (((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> l) sequentially <=> ((\n. real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * f(x + t))) ---> pi * l) sequentially)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL] THEN SUBGOAL_THEN `l = (l * pi) / pi` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN SIMP_TAC[real_div; REALLIM_RMUL_EQ; PI_NZ; REAL_INV_EQ_0] THEN REWRITE_TAC[REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* A directly deduced sufficient condition for convergence at a point. *) (* ------------------------------------------------------------------------- *) let SIMPLE_FOURIER_CONVERGENCE_PERIODIC = prove (`!f t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (\x. (f(x + t) - f(t)) / sin(x / &2)) absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> f(t)) sequentially`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REALLIM_NULL] THEN MP_TAC(ISPECL [`\x. (f:real->real)(x) - f(t)`; `t:real`; `&0`] FOURIER_SUM_LIMIT_DIRICHLET_KERNEL) THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN MATCH_MP_TAC(TAUT `(a ==> c) /\ b ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[FOURIER_COEFFICIENT_SUB; FOURIER_COEFFICIENT_CONST; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN MATCH_MP_TAC(REAL_ARITH `s:real = u /\ ft * t = x ==> (f0 - ft) * t + s = (f0 * t + u) - x`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[LE_1; ARITH; REAL_SUB_RZERO]; REWRITE_TAC[trigonometric_set; REAL_MUL_LZERO; COS_0] THEN MATCH_MP_TAC(REAL_FIELD `&0 < s ==> (f * s) * &1 / s = f`) THEN MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC]; MP_TAC(ISPECL [`\x. (f:real->real)(x) - f(t)`; `t:real`; `&0`] FOURIER_SUM_LIMIT_DIRICHLET_KERNEL) THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN SUBGOAL_THEN `!n. real_integral (real_interval [--pi,pi]) (\x. dirichlet_kernel n x * (f(x + t) - f(t))) = real_integral (real_interval [--pi,pi]) (\x. sin((&n + &1 / &2) * x) * inv(&2) * (f(x + t) - f(t)) / sin(x / &2))` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC]; ALL_TAC] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A more natural sufficient Hoelder condition at a point. *) (* ------------------------------------------------------------------------- *) let REAL_SIN_X2_ZEROS = prove (`{x | sin(x / &2) = &0} = IMAGE (\n. &2 * pi * n) integer`, CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; SIN_EQ_0; REAL_ARITH `y / &2 = n * pi <=> &2 * pi * n = y`] THEN REWRITE_TAC[PI_NZ; REAL_RING `&2 * pi * m = &2 * pi * n <=> pi = &0 \/ m = n`] THEN MESON_TAC[IN]);; let HOELDER_FOURIER_CONVERGENCE_PERIODIC = prove (`!f d M a t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) /\ &0 < d /\ &0 < a /\ (!x. abs(x - t) < d ==> abs(f x - f t) <= M * abs(x - t) rpow a) ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> f t) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_FOURIER_CONVERGENCE_PERIODIC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?e. &0 < e /\ !x. abs(x) < e ==> abs((f (x + t) - f t) / sin (x / &2)) <= &4 * abs M * abs(x) rpow (a - &1)` STRIP_ASSUME_TAC THENL [MP_TAC(REAL_DIFF_CONV `((\x. sin(x / &2)) has_real_derivative w) (atreal (&0))`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COS_0; REAL_MUL_RID] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL; REALLIM_ATREAL] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &4`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SIN_0; REAL_SUB_RZERO] THEN DISCH_THEN (X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_CASES_TAC `sin(x / &2) = &0` THENL [ONCE_REWRITE_TAC[real_div] THEN ASM_REWRITE_TAC[REAL_INV_0] THEN REWRITE_TAC[GSYM REAL_ABS_RPOW; GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_ADD_LID; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM REAL_ABS_RPOW; GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (REAL_ARITH `abs(x - &1 / &2) < &1 / &4 ==> &1 / &4 <= abs(x)`)) THEN SUBGOAL_THEN `abs((f(x + t) - f t) / sin (x / &2)) = abs(inv(sin(x / &2) / x)) * abs(f(x + t) - f t) / abs(x)` SUBST1_TAC THENL [REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_INV] THEN UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; REAL_LE_DIV] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_INV] THEN SUBST1_TAC(REAL_ARITH `&4 = inv(&1 / &4)`) THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM REAL_POW_1] THEN ASM_SIMP_TAC[GSYM RPOW_POW; GSYM RPOW_ADD; GSYM REAL_ABS_NZ] THEN REWRITE_TAC[REAL_ARITH `a - &1 + &1 = a`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `M * abs((x + t) - t) rpow a` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `(x + t) - t:real = x`] THEN REWRITE_TAC[GSYM REAL_ABS_RPOW] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REAL_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `real_bounded (IMAGE (\x. inv(sin(x / &2))) (real_interval[--pi,pi] DIFF real_interval(--e,e)))` MP_TAC THENL [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_ATREAL] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; DISCH_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[REAL_COMPACT_EQ_BOUNDED_CLOSED] THEN SIMP_TAC[REAL_CLOSED_DIFF; REAL_CLOSED_REAL_INTERVAL; REAL_OPEN_REAL_INTERVAL] THEN MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN EXISTS_TAC `real_interval[--pi,pi]` THEN REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET_DIFF]]; SIMP_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_REAL_INTERVAL; IN_DIFF] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\x:real. max (B * abs(f(x + t) - f t)) ((&4 * abs M) * abs(x) rpow (a - &1))` THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST]; MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[REAL_SIN_X2_ZEROS] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]]; MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_LMUL; ABSOLUTELY_REAL_INTEGRABLE_ABS; ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN MP_TAC(ISPECL [`\x. inv(a) * x rpow a`; `\x. x rpow (a - &1)`; `&0`; `pi`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN REWRITE_TAC[PI_POS_LE] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN MAP_EVERY UNDISCH_TAC [`&0 < a`; `&0 < x`] THEN CONV_TAC REAL_FIELD]; DISCH_THEN(ASSUME_TAC o MATCH_MP HAS_REAL_INTEGRAL_INTEGRABLE)] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE THEN SIMP_TAC[RPOW_POS_LE; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `&0` THEN REWRITE_TAC[REAL_NEG_LE0; PI_POS_LE] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_NEG_NEG; REAL_NEG_0]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_INTEGRABLE_EQ)) THEN SIMP_TAC[IN_REAL_INTERVAL; real_abs]; RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_CASES_TAC `abs(x) < e` THENL [MATCH_MP_TAC(REAL_ARITH `x <= b ==> x <= max a b`) THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC]; MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= max a b`) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* In particular, a Lipschitz condition at the point. *) (* ------------------------------------------------------------------------- *) let LIPSCHITZ_FOURIER_CONVERGENCE_PERIODIC = prove (`!f d M t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) /\ &0 < d /\ (!x. abs(x - t) < d ==> abs(f x - f t) <= M * abs(x - t)) ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> f t) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOELDER_FOURIER_CONVERGENCE_PERIODIC THEN MAP_EVERY EXISTS_TAC [`d:real`; `M:real`; `&1`] THEN ASM_REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LT_01]);; (* ------------------------------------------------------------------------- *) (* In particular, if left and right derivatives both exist. *) (* ------------------------------------------------------------------------- *) let BIDIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC = prove (`!f t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) /\ f real_differentiable (atreal t within {x | t < x}) /\ f real_differentiable (atreal t within {x | x < t}) ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> f t) sequentially`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[real_differentiable; HAS_REAL_DERIVATIVE_WITHINREAL] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `B1:real` (LABEL_TAC "1")) (X_CHOOSE_THEN `B2:real` (LABEL_TAC "2"))) THEN MATCH_MP_TAC LIPSCHITZ_FOURIER_CONVERGENCE_PERIODIC THEN REMOVE_THEN "1" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN REMOVE_THEN "2" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN MAP_EVERY EXISTS_TAC [`min d1 d2:real`; `abs B1 + abs B2 + &1`] THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `x = t \/ t < x \/ x < t`) THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_MUL_RZERO; REAL_LE_REFL]; ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_DIV; REAL_ARITH `t < x ==> &0 < abs(x - t)`] THEN REMOVE_THEN "1" (MP_TAC o SPEC `x:real`) THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_DIV; REAL_ARITH `x < t ==> &0 < abs(x - t)`] THEN REMOVE_THEN "2" (MP_TAC o SPEC `x:real`) THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* And in particular at points where the function is differentiable. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC = prove (`!f t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) /\ f real_differentiable (atreal t) ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> f t) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BIDIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN UNDISCH_TAC `f real_differentiable (atreal t)` THEN REWRITE_TAC[real_differentiable] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Use reflection to halve the region of integration. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED = prove (`!f n c. f absolutely_real_integrable_on real_interval [--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) ==> (\x. dirichlet_kernel n x * f(t + x)) absolutely_real_integrable_on real_interval[--pi,pi] /\ (\x. dirichlet_kernel n x * f(t - x)) absolutely_real_integrable_on real_interval[--pi,pi] /\ (\x. dirichlet_kernel n x * c) absolutely_real_integrable_on real_interval[--pi,pi]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THENL [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; REWRITE_TAC[absolutely_real_integrable_on] THEN ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]]);; let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART = prove (`!f n d c. f absolutely_real_integrable_on real_interval [--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) /\ d <= pi ==> (\x. dirichlet_kernel n x * f(t + x)) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. dirichlet_kernel n x * f(t - x)) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. dirichlet_kernel n x * c) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. dirichlet_kernel n x * (f(t + x) + f(t - x))) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. dirichlet_kernel n x * ((f(t + x) + f(t - x)) - c)) absolutely_real_integrable_on real_interval[&0,d]`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED) ASSUME_TAC) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c) /\ (a /\ b /\ c ==> d /\ e) ==> a /\ b /\ c /\ d /\ e`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[--pi,pi]` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; SIMP_TAC[REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB; ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_SUB]]);; let FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF = prove (`!f n t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) - l = real_integral (real_interval[&0,pi]) (\x. dirichlet_kernel n x * ((f(t + x) + f(t - x)) - &2 * l)) / pi`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL] THEN MATCH_MP_TAC(MATCH_MP (REAL_FIELD `&0 < pi ==> x = y + pi * l ==> x / pi - l = y / pi`) PI_POS) THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD; ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[MESON[REAL_ADD_SYM] `dirichlet_kernel n x * f(x + t) = dirichlet_kernel n x * f(t + x)`] THEN REWRITE_TAC[DIRICHLET_KERNEL_NEG; GSYM real_sub] THEN MP_TAC(SPEC `n:num` HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF) THEN DISCH_THEN(MP_TAC o SPEC `&2 * l` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN REWRITE_TAC[REAL_ARITH `pi / &2 * &2 * l = pi * l`] THEN DISCH_THEN(SUBST1_TAC o GSYM o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC(GSYM REAL_INTEGRAL_SUB) THEN MP_TAC(GEN `c:real` (ISPECL [`f:real->real`; `n:num`; `pi`; `c:real`] ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART)) THEN ASM_REWRITE_TAC[REAL_LE_REFL; FORALL_AND_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM REAL_ADD_LDISTRIB; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_HALF = prove (`!f t l. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> (((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> l) sequentially <=> ((\n. real_integral (real_interval[&0,pi]) (\x. dirichlet_kernel n x * ((f(t + x) + f(t - x)) - &2 * l))) ---> &0) sequentially)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN GEN_REWRITE_TAC LAND_CONV [REALLIM_NULL] THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_RMUL_EQ THEN MP_TAC PI_POS THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Localization principle: convergence only depends on values "nearby". *) (* ------------------------------------------------------------------------- *) let RIEMANN_LOCALIZATION_INTEGRAL = prove (`!d f g. f absolutely_real_integrable_on real_interval[--pi,pi] /\ g absolutely_real_integrable_on real_interval[--pi,pi] /\ &0 < d /\ (!x. abs(x) < d ==> f x = g x) ==> ((\n. real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * f(x)) - real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * g(x))) ---> &0) sequentially`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * f(x)) - real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * g(x)) = real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * (if abs(x) < d then &0 else f(x) - g(x)))` (fun th -> REWRITE_TAC[th]) THENL [ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; GSYM REAL_INTEGRAL_SUB] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{}:real->bool` THEN REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN AP_TERM_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_ARITH `&0 = x - y <=> x = y`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * (if abs x < d then &0 else f(x) - g(x))) = real_integral (real_interval[--pi,pi]) (\x. sin((&n + &1 / &2) * x) * inv(&2) * (if abs x < d then &0 else f(x) - g(x)) / sin(x / &2))` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC]; ALL_TAC] THEN MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN SUBGOAL_THEN `real_bounded (IMAGE (\x. inv(sin(x / &2))) (real_interval[--pi,pi] DIFF real_interval(--d,d)))` MP_TAC THENL [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_ATREAL] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; DISCH_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[REAL_COMPACT_EQ_BOUNDED_CLOSED] THEN SIMP_TAC[REAL_CLOSED_DIFF; REAL_CLOSED_REAL_INTERVAL; REAL_OPEN_REAL_INTERVAL] THEN MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN EXISTS_TAC `real_interval[--pi,pi]` THEN REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET_DIFF]]; SIMP_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_REAL_INTERVAL; IN_DIFF] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\x:real. B * abs(f(x) - g(x))` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN ASM_SIMP_TAC[INTEGRABLE_IMP_REAL_MEASURABLE; REAL_MEASURABLE_ON_0; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_REAL_INTEGRABLE_SUB] THEN SUBGOAL_THEN `{x | abs x < d} = real_interval(--d,d)` (fun th -> REWRITE_TAC[th; REAL_LEBESGUE_MEASURABLE_INTERVAL]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; SUBGOAL_THEN `{x | sin(x / &2) = &0} = IMAGE (\n. &2 * pi * n) integer` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; SIN_EQ_0; REAL_ARITH `y / &2 = n * pi <=> &2 * pi * n = y`] THEN REWRITE_TAC[PI_NZ; REAL_RING `&2 * pi * m = &2 * pi * n <=> pi = &0 \/ m = n`] THEN MESON_TAC[IN]; MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]]]; MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ABS; ABSOLUTELY_REAL_INTEGRABLE_SUB]; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN COND_CASES_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]]);; let RIEMANN_LOCALIZATION_INTEGRAL_RANGE = prove (`!d f. f absolutely_real_integrable_on real_interval[--pi,pi] /\ &0 < d /\ d <= pi ==> ((\n. real_integral (real_interval[--pi,pi]) (\x. dirichlet_kernel n x * f(x)) - real_integral (real_interval[--d,d]) (\x. dirichlet_kernel n x * f(x))) ---> &0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC (ISPECL[`d:real`; `f:real->real`; `\x. if x IN real_interval[--d,d] then f x else &0`] RIEMANN_LOCALIZATION_INTEGRAL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[MESON[] `(if p then if q then x else y else y) = (if p /\ q then x else y)`] THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV; GSYM IN_INTER] THEN REWRITE_TAC[INTER; IN_REAL_INTERVAL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < d /\ d <= pi ==> ((--pi <= x /\ x <= pi) /\ --d <= x /\ x <= d <=> --d <= x /\ x <= d)`] THEN REWRITE_TAC[GSYM real_interval] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC]; REWRITE_TAC[MESON[REAL_MUL_RZERO] `a * (if p then b else &0) = if p then a * b else &0`] THEN SUBGOAL_THEN `real_interval[--d,d] SUBSET real_interval[--pi,pi]` MP_TAC THENL [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_INTEGRAL_RESTRICT th])]]);; let RIEMANN_LOCALIZATION = prove (`!t d c f g. f absolutely_real_integrable_on real_interval[--pi,pi] /\ g absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) /\ (!x. g(x + &2 * pi) = g(x)) /\ &0 < d /\ (!x. abs(x - t) < d ==> f x = g x) ==> (((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> c) sequentially <=> ((\n. sum (0..n) (\k. fourier_coefficient g k * trigonometric_set k t)) ---> c) sequentially)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_LIMIT_DIRICHLET_KERNEL] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN MATCH_MP_TAC RIEMANN_LOCALIZATION_INTEGRAL THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Localize the earlier integral. *) (* ------------------------------------------------------------------------- *) let RIEMANN_LOCALIZATION_INTEGRAL_RANGE_HALF = prove (`!d f. f absolutely_real_integrable_on real_interval[--pi,pi] /\ &0 < d /\ d <= pi ==> ((\n. real_integral (real_interval[&0,pi]) (\x. dirichlet_kernel n x * (f(x) + f(--x))) - real_integral (real_interval[&0,d]) (\x. dirichlet_kernel n x * (f(x) + f(--x)))) ---> &0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC (SPECL [`d:real`; `f:real->real`] RIEMANN_LOCALIZATION_INTEGRAL_RANGE) THEN MP_TAC(GEN `n:num` (ISPECL [`f:real->real`; `n:num`] ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. (\x. dirichlet_kernel n x * f x) absolutely_real_integrable_on real_interval[--d,d]` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL) o SPEC `n:num`) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[DIRICHLET_KERNEL_NEG; GSYM REAL_ADD_LDISTRIB]]);; let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_PART = prove (`!f t l d. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) /\ &0 < d /\ d <= pi ==> (((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> l) sequentially <=> ((\n. real_integral (real_interval[&0,d]) (\x. dirichlet_kernel n x * ((f(t + x) + f(t - x)) - &2 * l))) ---> &0) sequentially)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_HALF] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN REWRITE_TAC[REAL_ARITH `(x + y) - &2 * l = (x - l) + (y - l)`] THEN MP_TAC(MESON[real_sub] `!x. (f:real->real)(t - x) = f(t + --x)`) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC RIEMANN_LOCALIZATION_INTEGRAL_RANGE_HALF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]);; (* ------------------------------------------------------------------------- *) (* Make a harmless simplifying tweak to the Dirichlet kernel. *) (* ------------------------------------------------------------------------- *) let REAL_INTEGRAL_DIRICHLET_KERNEL_MUL_EXPAND = prove (`!f n s. real_integral s (\x. dirichlet_kernel n x * f x) = real_integral s (\x. sin((&n + &1 / &2) * x) / (&2 * sin(x / &2)) * f x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN SIMP_TAC[IN_DIFF; IN_SING; dirichlet_kernel]);; let REAL_INTEGRABLE_DIRICHLET_KERNEL_MUL_EXPAND = prove (`!f n s. (\x. dirichlet_kernel n x * f x) real_integrable_on s <=> (\x. sin((&n + &1 / &2) * x) / (&2 * sin(x / &2)) * f x) real_integrable_on s`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_SPIKE THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN SIMP_TAC[IN_DIFF; IN_SING; dirichlet_kernel]);; let FOURIER_SUM_LIMIT_SINE_PART = prove (`!f t l d. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) /\ &0 < d /\ d <= pi ==> (((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> l) sequentially <=> ((\n. real_integral (real_interval[&0,d]) (\x. sin((&n + &1 / &2) * x) * ((f(t + x) + f(t - x)) - &2 * l) / x)) ---> &0) sequentially)`, let lemma0 = prove (`!x. abs(sin(x) - x) <= abs(x) pow 3`, GEN_TAC THEN MP_TAC(ISPECL [`0`; `Cx x`] TAYLOR_CSIN) THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1; IM_CX] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; COMPLEX_NORM_CX; REAL_ABS_0] THEN REWRITE_TAC[REAL_EXP_0; REAL_MUL_LID] THEN REAL_ARITH_TAC) in let lemma1 = prove (`!x. ~(x = &0) ==> abs(sin(x) / x - &1) <= x pow 2`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs x` THEN REWRITE_TAC[GSYM REAL_ABS_MUL; GSYM(CONJUNCT2 real_pow)] THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; ARITH] THEN ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; REAL_MUL_RID] THEN REWRITE_TAC[lemma0]) in let lemma2 = prove (`!x. abs(x) <= &1 / &2 ==> abs(x) / &2 <= abs(sin x)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` lemma0) THEN MATCH_MP_TAC(REAL_ARITH `&4 * x3 <= abs x ==> abs(s - x) <= x3 ==> abs(x) / &2 <= abs s`) THEN REWRITE_TAC[REAL_ARITH `&4 * x pow 3 <= x <=> x * x pow 2 <= x * (&1 / &2) pow 2`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC) in let lemma3 = prove (`!x. ~(x = &0) /\ abs x <= &1 / &2 ==> abs(inv(sin x) - inv x) <= &2 * abs x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(sin x)` THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ASM_CASES_TAC `sin x = &0` THENL [MP_TAC(SPEC `x:real` SIN_EQ_0_PI) THEN MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_SUB_LDISTRIB; REAL_MUL_RINV] THEN REWRITE_TAC[REAL_ARITH `abs(&1 - s * inv x) = abs(s / x - &1)`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(x:real) pow 2` THEN ASM_SIMP_TAC[lemma1] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN MP_TAC(ISPEC `x:real` lemma2) THEN ASM_REAL_ARITH_TAC]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `t:real`; `l:real`; `d:real`] FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_PART) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN EXISTS_TAC `\n. real_integral (real_interval[&0,d]) (\x. sin((&n + &1 / &2) * x) * (inv(&2 * sin(x / &2)) - inv x) * ((f(t + x) + f(t - x)) - &2 * l))` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL [EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_INTEGRAL_DIRICHLET_KERNEL_MUL_EXPAND] THEN REWRITE_TAC[REAL_ARITH `a * (inv y - inv x) * b:real = a / y * b - a / x * b`] THEN REWRITE_TAC[REAL_ARITH `sin(y) * (a - b) / x = sin(y) / x * (a - b)`] THEN MATCH_MP_TAC REAL_INTEGRAL_SUB THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_INTEGRABLE_DIRICHLET_KERNEL_MUL_EXPAND] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST]; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN EXISTS_TAC `\x. dirichlet_kernel n x * (&2 * sin(x / &2)) / x * ((f(t + x) + f(t - x)) - &2 * l)` THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN CONJ_TAC THENL [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL; REAL_MUL_ASSOC] THEN STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN MATCH_MP_TAC(REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> a / x = a / (&2 * y) * (&2 * y) / x`) THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING; SING_GSPEC] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; ALL_TAC]]] THEN SUBGOAL_THEN `real_bounded (IMAGE (\x. &1 + (x / &2) pow 2) (real_interval[--pi,pi]))` MP_TAC THENL [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[REAL_COMPACT_INTERVAL] THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RID] THEN ASM_REAL_ARITH_TAC; REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `abs(z - &1) <= y ==> abs(&1 + y) <= B ==> abs(z) <= B`) THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> (&2 * y) / x = y / (x / &2)`] THEN MATCH_MP_TAC lemma1 THEN ASM_REAL_ARITH_TAC]]; SUBGOAL_THEN `real_interval[&0,d] SUBSET real_interval[--pi,pi]` MP_TAC THENL [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC [GSYM(MATCH_MP REAL_INTEGRAL_RESTRICT th)])] THEN REWRITE_TAC[MESON[REAL_MUL_LZERO; REAL_MUL_RZERO] `(if p x then a x * b x * c x else &0) = a x * (if p x then b x else &0) * c x`] THEN MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN REWRITE_TAC[REAL_MEASURABLE_ON_0; SET_RULE `{x | x IN s} = s`; REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_SUB THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; REAL_CLOSED_UNIV] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[REAL_ARITH `&2 * x = &0 <=> x = &0`] THEN REWRITE_TAC[REAL_SIN_X2_ZEROS] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]]; ALL_TAC] THEN SUBGOAL_THEN `real_bounded(IMAGE (\x. inv (&2 * sin (x / &2)) - inv x) (real_interval[--pi,-- &1] UNION real_interval[&1,pi]))` MP_TAC THENL [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN SIMP_TAC[REAL_COMPACT_INTERVAL; REAL_COMPACT_UNION] THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_REAL_INTERVAL; IN_UNION] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `max B (&2)` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_CASES_TAC `abs(x) <= &1` THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `x <= B ==> x <= max B C`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC] THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_INV_0; SIN_0] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_INV_MUL] THEN MATCH_MP_TAC(REAL_ARITH `abs(is - &2 * ix) <= &1 ==> abs(inv(&2) * is - ix) <= max B (&2)`) THEN REWRITE_TAC[GSYM real_div] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * abs(x / &2)` THEN CONJ_TAC THENL [MATCH_MP_TAC lemma3; ASM_REAL_ARITH_TAC] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Dini's test. *) (* ------------------------------------------------------------------------- *) let FOURIER_DINI_TEST = prove (`!f t l d. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) /\ &0 < d /\ (\x. abs((f(t + x) + f(t - x)) - &2 * l) / x) real_integrable_on real_interval[&0,d] ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k t)) ---> l) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `t:real`; `l:real`; `pi`] FOURIER_SUM_LIMIT_SINE_PART) THEN ASM_REWRITE_TAC[PI_POS; REAL_LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT) THEN REWRITE_TAC[real_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN ASM_SIMP_TAC[IN_REAL_INTERVAL; REAL_LE_REFL; REAL_LT_IMP_LE] THEN SIMP_TAC[REAL_INTEGRAL_NULL; REAL_LE_REFL] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ABBREV_TAC `dd = min d (min (k / &2) pi)` THEN DISCH_THEN(MP_TAC o SPEC `dd:real`) THEN REWRITE_TAC[REAL_SUB_RZERO] THEN ANTS_TAC THENL [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < dd /\ dd <= d /\ dd <= pi /\ dd < k` STRIP_ASSUME_TAC THENL [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN SUBGOAL_THEN `(\x. ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on real_interval[&0,dd]` ASSUME_TAC THENL [REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; REAL_CLOSED_UNIV] THEN MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`--pi`; `pi`] THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_INTEGRABLE_ADD; REAL_INTEGRABLE_SUB; REAL_INTEGRABLE_CONST] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`&0:real`; `d:real`] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE [TAUT `p ==> q ==> r <=> q ==> p ==> r`] REAL_INTEGRABLE_SPIKE)) THEN EXISTS_TAC `{}:real->bool` THEN REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY] THEN SIMP_TAC[REAL_ABS_DIV; IN_REAL_INTERVAL; IN_DIFF] THEN SIMP_TAC[real_abs]; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `(\x. ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on real_interval[dd,pi]` ASSUME_TAC THENL [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; REAL_CLOSED_UNIV]; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `inv dd:real` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_ABS_INV] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[--pi,pi]` THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `(!n. (\x. sin((&n + &1 / &2) * x) * ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on real_interval[&0,dd]) /\ (!n. (\x. sin((&n + &1 / &2) * x) * ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on real_interval[dd,pi])` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[SIN_BOUND]]); ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\x. if abs x < dd then &0 else ((f:real->real)(t + x) - l) / x` RIEMANN_LEBESGUE_SIN_HALF) THEN SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[MESON[] `(if P x then if Q x then &0 else a x else &0) = (if P x /\ ~Q x then a x else &0)`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[MESON[REAL_MUL_RZERO; REAL_MUL_LZERO] `(if P x /\ Q x then a x * b x else &0) = (if Q x then a x else &0) * (if P x then b x else &0)`] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV; ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN REWRITE_TAC[REAL_MEASURABLE_ON_0] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_COMPL] THEN REWRITE_TAC[REAL_ARITH `abs x < d <=> --d < x /\ x < d`] THEN REWRITE_TAC[GSYM real_interval; REAL_LEBESGUE_MEASURABLE_INTERVAL]; GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; REAL_CLOSED_UNIV]]; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_UNIV] THEN EXISTS_TAC `inv dd:real` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_NOT_LT] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_ABS_NUM; REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_MUL_RNEG; SIN_NEG; REAL_MUL_LNEG] THEN REWRITE_TAC[GSYM real_sub; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_ARITH `(if p then &0 else a) - (if p then &0 else --b) = (if p then &0 else a + b)`] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[MESON[REAL_MUL_RZERO] `s * (if p then &0 else y) = (if ~p then s * y else &0)`] THEN ONCE_REWRITE_TAC[GSYM REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[MESON[] `(if p then if q then x else &0 else &0) = (if p /\ q then x else &0)`] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < dd /\ dd <= pi ==> ((&0 <= x /\ x <= pi) /\ ~(abs x < dd) <=> dd <= x /\ x <= pi)`] THEN REWRITE_TAC[GSYM IN_REAL_INTERVAL; REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[REAL_ARITH `(x - l) + (y - l) = (x + y) - &2 * l`] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `real_integral(real_interval[&0,dd]) f + real_integral(real_interval[dd,pi]) f = real_integral(real_interval[&0,pi]) f /\ abs(real_integral(real_interval[&0,dd]) f) < e / &2 ==> abs(real_integral(real_interval[dd,pi]) f - &0) < e / &2 ==> abs(real_integral(real_interval[&0,pi]) f) < e`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `dd:real` THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_LT_IMP_LE]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs x < e / &2 ==> abs y <= x ==> abs y < e / &2`)) THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`&0`; `d:real`] THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN SIMP_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ARITH `&0 <= x ==> abs x = x`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS; SIN_BOUND]]]);; (* ------------------------------------------------------------------------- *) (* Convergence for functions of bounded variation. *) (* ------------------------------------------------------------------------- *) let REAL_INTEGRAL_SIN_OVER_X_BOUND = prove (`!a b c. &0 <= a /\ &0 < c ==> (\x. sin(c * x) / x) real_integrable_on real_interval[a,b] /\ abs(real_integral (real_interval[a,b]) (\x. sin(c * x) / x)) <= &4`, let lemma0 = prove (`!a b. (\x. sin x) real_integrable_on (real_interval[a,b]) /\ abs(real_integral (real_interval[a,b]) (\x. sin x)) <= &2`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a <= b` THENL [MP_TAC(ISPECL [`\x. --(cos x)`; `\x. sin x`; `a:real`; `b:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= &1 /\ abs y <= &1 ==> abs(--y - --x) <= &2`) THEN REWRITE_TAC[COS_BOUND]]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; REAL_ABS_NUM; REAL_POS]]) in let lemma1 = prove (`!a b. &0 < a ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\ abs(real_integral (real_interval[a,b]) (\x. sin x / x)) <= &4 / a`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a <= b` THENL [MP_TAC(ISPECL [`\x. sin x`; `\x:real. --(inv x)`; `a:real`; `b:real`] REAL_SECOND_MEAN_VALUE_THEOREM_FULL) THEN ASM_REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; lemma0] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_LE_NEG2; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `c:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_NEG) THEN REWRITE_TAC[REAL_ARITH `--(--(inv y) * x):real = x / y`] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_NEG_NEG] THEN MATCH_MP_TAC(REAL_ARITH `inv b <= inv a /\ abs x <= inv a * &2 /\ abs y <= inv b * &2 ==> abs(x + y) <= &4 / a`) THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_ABS_MUL] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; lemma0] THEN ASM_REWRITE_TAC[real_abs; REAL_LE_REFL; REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; REAL_ABS_NUM; REAL_POS] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC]) in let lemma2 = prove (`!x. &0 <= x ==> sin(x) <= x`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x <= &1` THENL [ALL_TAC; ASM_MESON_TAC[SIN_BOUNDS; REAL_LE_TOTAL; REAL_LE_TRANS]] THEN MP_TAC(ISPECL [`1`; `Cx x`] TAYLOR_CSIN) THEN CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_MUL; GSYM CX_DIV; GSYM CX_NEG; GSYM CX_ADD; GSYM CX_SUB] THEN REWRITE_TAC[COMPLEX_NORM_CX; IM_CX; REAL_ABS_0; REAL_EXP_0] THEN SIMP_TAC[REAL_POW_1; REAL_DIV_1; real_pow; REAL_MUL_LNEG; REAL_MUL_LID] THEN MATCH_MP_TAC(REAL_ARITH `e <= t ==> abs(sin x - (x + --t)) <= e ==> sin x <= x`) THEN ASM_REWRITE_TAC[real_abs; REAL_ARITH `x pow 5 / &24 <= x pow 3 / &6 <=> x pow 3 * x pow 2 <= x pow 3 * &2 pow 2`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_POW_LE] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC) in let lemma3 = prove (`!x. &0 <= x /\ x <= &2 ==> abs(sin x / x) <= &1`, GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_SIMP_TAC[real_div; REAL_MUL_RZERO; REAL_INV_0; REAL_ABS_NUM; REAL_POS]; ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < abs x`] THEN MATCH_MP_TAC(REAL_ARITH `s <= x /\ &0 <= s ==> abs s <= abs x`) THEN ASM_SIMP_TAC[lemma2] THEN MATCH_MP_TAC SIN_POS_PI_LE THEN MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC]) in let lemma4 = prove (`!a b. &0 <= a /\ b <= &2 ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\ abs(real_integral (real_interval[a,b]) (\x. sin x / x)) <= &2`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL [MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `(\x. &1):real->real` THEN REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[lemma0]; MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; REWRITE_TAC[SING_GSPEC; REAL_NEGLIGIBLE_SING]]; REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma3 THEN ASM_REAL_ARITH_TAC]; DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `real_integral (real_interval [a,b]) (\x. &1)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma3 THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN ASM_REAL_ARITH_TAC]]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; REAL_ABS_NUM; REAL_POS]]) in let lemma5 = prove (`!a b. &0 <= a ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\ abs(real_integral (real_interval[a,b]) (\x. sin x / x)) <= &4`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `b <= &2` THENL [ASM_MESON_TAC[lemma4; REAL_ARITH `x <= &2 ==> x <= &4`]; ALL_TAC] THEN ASM_CASES_TAC `&2 <= a` THENL [MP_TAC(SPECL [`a:real`; `b:real`] lemma1) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&2 <= a ==> &0 < a`] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN MP_TAC(ISPECL [`\x. sin x / x`; `a:real`; `b:real`; `&2`] REAL_INTEGRABLE_COMBINE) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[lemma4; REAL_LE_REFL]; ASM_MESON_TAC[lemma1; REAL_ARITH `&0 < &2`]]; DISCH_TAC] THEN MP_TAC(ISPECL [`\x. sin x / x`; `a:real`; `b:real`; `&2`] REAL_INTEGRAL_COMBINE) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= &2 /\ abs(y) <= &2 ==> abs(x + y) <= &4`) THEN CONJ_TAC THENL [ASM_MESON_TAC[lemma4; REAL_LE_REFL]; GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &4 / &2`] THEN ASM_MESON_TAC[lemma1; REAL_ARITH `&0 < &2`]]) in REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL [MP_TAC(ISPECL [`c * a:real`; `c * b:real`] lemma5) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [HAS_REAL_INTEGRAL_INTEGRAL] THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_STRETCH)) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_ADD_RID; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN ASM_SIMP_TAC[IMAGE_STRETCH_REAL_INTERVAL; REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_FIELD `&0 < c ==> inv c * c * a = a`; REAL_INV_MUL; real_div; REAL_FIELD `&0 < c ==> c * s * inv c * inv x = s * inv x`; REAL_FIELD `&0 < c ==> c * inv c * i = i /\ abs c = c`] THEN REWRITE_TAC[GSYM real_div; REAL_INTERVAL_EQ_EMPTY] THEN ASM_SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_LMUL_EQ] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; REAL_ABS_NUM; REAL_POS]]);; let FOURIER_JORDAN_BOUNDED_VARIATION = prove (`!f x d. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f x) /\ &0 < d /\ f has_bounded_real_variation_on real_interval[x - d,x + d] ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k x)) ---> ((reallim (atreal x within {l | l <= x}) f + reallim (atreal x within {r | r >= x}) f) / &2)) sequentially`, let lemma = prove (`!f l d. &0 < d ==> ((f ---> l) (atreal (&0) within real_interval[&0,d]) <=> (f ---> l) (atreal (&0) within {x | &0 <= x}))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_WITHINREAL_SET THEN REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC) in MAP_EVERY X_GEN_TAC [`f:real->real`; `t:real`; `d0:real`] THEN STRIP_TAC THEN ABBREV_TAC `s = (reallim (atreal t within {l | l <= t}) f + reallim (atreal t within {r | r >= t}) f) / &2` THEN MP_TAC(SPECL [`f:real->real`; `t:real`; `s:real`; `min d0 pi`] FOURIER_SUM_LIMIT_SINE_PART) THEN ASM_REWRITE_TAC[REAL_LT_MIN; PI_POS; REAL_ARITH `min d0 pi <= pi`] THEN DISCH_THEN SUBST1_TAC THEN ABBREV_TAC `h = \u. ((f:real->real)(t + u) + f(t - u)) - &2 * s` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ABBREV_TAC `d = min d0 pi` THEN SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `h has_bounded_real_variation_on real_interval[&0,d]` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_REAL_VARIATION_DARBOUX]) THEN EXPAND_TAC "h" THEN REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_DARBOUX] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_REAL_INTERVAL] THEN MAP_EVERY X_GEN_TAC [`f1:real->real`; `f2:real->real`] THEN STRIP_TAC THEN EXISTS_TAC `\x. ((f1:real->real)(t + x) - f2(t - x)) - s` THEN EXISTS_TAC `\x. ((f2:real->real)(t + x) - f1(t - x)) + s` THEN ASM_REWRITE_TAC[REAL_ARITH `x - s <= y - s <=> x <= y`; REAL_LE_RADD] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `a <= a' /\ b' <= b ==> a - b <= a' - b'`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(h ---> &0) (atreal(&0) within {x | &0 <= x})` ASSUME_TAC THENL [EXPAND_TAC "h" THEN EXPAND_TAC "s" THEN REWRITE_TAC[REAL_ARITH `(f' + f) - &2 * (l + l') / &2 = (f - l) + (f' - l')`] THEN MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL [SUBGOAL_THEN `?l. (f ---> l) (atreal t within {l | l <= t})` MP_TAC THENL [MP_TAC(ISPECL [`f:real->real`; `t - d0:real`; `t + d0:real`; `t:real`] HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (fun th -> EXISTS_TAC `min d0 d1` THEN CONJUNCTS_THEN2 ASSUME_TAC MP_TAC th)) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM reallim] THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t - x:real` th)) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN REAL_ARITH_TAC]; SUBGOAL_THEN `?l. (f ---> l) (atreal t within {r | r >= t})` MP_TAC THENL [MP_TAC(ISPECL [`f:real->real`; `t - d0:real`; `t + d0:real`; `t:real`] HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (fun th -> EXISTS_TAC `min d0 d1` THEN CONJUNCTS_THEN2 ASSUME_TAC MP_TAC th)) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM reallim] THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t + x:real` th)) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN REAL_ARITH_TAC]]; ALL_TAC] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?k. &0 < k /\ k < d /\ !n. (\x. sin ((&n + &1 / &2) * x) * h x / x) real_integrable_on real_interval[&0,k] /\ abs(real_integral (real_interval[&0,k]) (\x. sin ((&n + &1 / &2) * x) * h x / x)) <= e / &2` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?h1 h2. (!x y. x IN real_interval[&0,d] /\ y IN real_interval[&0,d] /\ x <= y ==> h1 x <= h1 y) /\ (!x y. x IN real_interval[&0,d] /\ y IN real_interval[&0,d] /\ x <= y ==> h2 x <= h2 y) /\ (h1 ---> &0) (atreal (&0) within {x | &0 <= x}) /\ (h2 ---> &0) (atreal (&0) within {x | &0 <= x}) /\ (!x. h x = h1 x - h2 x)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`h:real->real`; `&0`; `d:real`] HAS_BOUNDED_REAL_VARIATION_DARBOUX) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h1:real->real`; `h2:real->real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h1:real->real`; `&0`; `d:real`; `&0`] INCREASING_RIGHT_LIMIT) THEN ASM_REWRITE_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN MP_TAC(ISPECL [`h2:real->real`; `&0`; `d:real`; `&0`] INCREASING_RIGHT_LIMIT) THEN ASM_REWRITE_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_TAC `l':real`) THEN SUBGOAL_THEN `l':real = l` SUBST_ALL_TAC THENL [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN MATCH_MP_TAC(ISPEC `atreal (&0) within {x | &0 <= x}` REALLIM_UNIQUE) THEN EXISTS_TAC `h:real->real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o rand o snd) THEN REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM; IN_SING] THEN EXISTS_TAC `&1` THEN REAL_ARITH_TAC; GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REALLIM_SUB THEN MAP_EVERY UNDISCH_TAC [`(h1 ---> l) (atreal(&0) within real_interval[&0,d])`; `(h2 ---> l') (atreal(&0) within real_interval[&0,d])`] THEN ASM_SIMP_TAC[lemma]]; EXISTS_TAC `\x. (h1:real->real)(x) - l` THEN EXISTS_TAC `\x. (h2:real->real)(x) - l` THEN ASM_REWRITE_TAC[REAL_ARITH `x - l <= y - l <=> x <= y`] THEN ASM_REWRITE_TAC[GSYM REALLIM_NULL] THEN MAP_EVERY UNDISCH_TAC [`(h1 ---> l) (atreal(&0) within real_interval[&0,d])`; `(h2 ---> l) (atreal(&0) within real_interval[&0,d])`] THEN ASM_SIMP_TAC[lemma] THEN REPEAT DISCH_TAC THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `?k. &0 < k /\ k < d /\ abs(h1 k) < e / &16 /\ abs(h2 k) < e / &16` MP_TAC THENL [UNDISCH_TAC `(h2 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN UNDISCH_TAC `(h1 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &16`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `k1:real` STRIP_ASSUME_TAC)] THEN DISCH_THEN(MP_TAC o SPEC `e / &16`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `k2:real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `min d (min k1 k2) / &2` THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`\x. sin((&n + &1 / &2) * x) / x`; `h1:real->real`; `&0`; `k:real`; `&0`; `(h1:real->real) k`] REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN ASM_SIMP_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LE_REFL; REAL_ADD_LID; REAL_ARITH `&0 < &n + &1 / &2`; REAL_MUL_LZERO] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN UNDISCH_TAC `(h1 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `--((h1:real->real) x)`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `dd:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `min d (min x dd) / &2`)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `h < &0 ==> h' <= h ==> ~(abs h' < --h)`)); ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `h * s / x:real = s * h / x`] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN(X_CHOOSE_THEN `c1:real` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`\x. sin((&n + &1 / &2) * x) / x`; `h2:real->real`; `&0`; `k:real`; `&0`; `(h2:real->real) k`] REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN ASM_SIMP_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LE_REFL; REAL_ADD_LID; REAL_ARITH `&0 < &n + &1 / &2`; REAL_MUL_LZERO] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN UNDISCH_TAC `(h2 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `--((h2:real->real) x)`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `dd:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `min d (min x dd) / &2`)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `h < &0 ==> h' <= h ==> ~(abs h' < --h)`)); ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `h * s / x:real = s * h / x`] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN(X_CHOOSE_THEN `c2:real` STRIP_ASSUME_TAC)] THEN REWRITE_TAC[REAL_ARITH `s * (h - h') / x:real = s * h / x - s * h' / x`] THEN ASM_SIMP_TAC[REAL_INTEGRABLE_SUB; REAL_INTEGRAL_SUB] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= e / &16 * &4 /\ abs(y) <= e / &16 * &4 ==> abs(x - y) <= e / &2`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LT_IMP_LE; REAL_ARITH `&0 < &n + &1 / &2`]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN SUBGOAL_THEN `(\x. h x / x) absolutely_real_integrable_on real_interval[k,d]` ASSUME_TAC THENL [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN EXISTS_TAC `inv k:real` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; EXPAND_TAC "h" THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[--pi,pi]` THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!n. (\x. sin((&n + &1 / &2) * x) * h x / x) absolutely_real_integrable_on real_interval[k,d]` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[SIN_BOUND]]; ALL_TAC] THEN MP_TAC(ISPEC `\x. if k <= x /\ x <= d then h x / x else &0` RIEMANN_LEBESGUE_SIN_HALF) THEN REWRITE_TAC[absolutely_real_integrable_on] THEN REWRITE_TAC[MESON[REAL_ABS_NUM] `abs(if p then x else &0) = if p then abs x else &0`] THEN ONCE_REWRITE_TAC[GSYM REAL_INTEGRAL_RESTRICT_UNIV; GSYM REAL_INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[MESON[REAL_MUL_RZERO] `(if P then s * (if Q then a else &0) else &0) = (if P /\ Q then s * a else &0)`] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REWRITE_TAC[MESON[] `(if P then if Q then x else &0 else &0) = (if P /\ Q then x else &0)`] THEN SUBGOAL_THEN `!x. (--pi <= x /\ x <= pi) /\ k <= x /\ x <= d <=> k <= x /\ x <= d` (fun th -> REWRITE_TAC[th]) THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM IN_REAL_INTERVAL; REAL_INTEGRAL_RESTRICT_UNIV; REAL_INTEGRABLE_RESTRICT_UNIV] THEN ASM_REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `n:num`) THEN MATCH_MP_TAC(REAL_ARITH `x + y = z ==> abs(x) <= e / &2 ==> abs(y) < e / &2 ==> abs(z) < e`) THEN REWRITE_TAC[REAL_SUB_RZERO] THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `k:real` THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN ASM_REAL_ARITH_TAC);; let FOURIER_JORDAN_BOUNDED_VARIATION_SIMPLE = prove (`!f x. f has_bounded_real_variation_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f x) ==> ((\n. sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k x)) ---> ((reallim (atreal x within {l | l <= x}) f + reallim (atreal x within {r | r >= x}) f) / &2)) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FOURIER_JORDAN_BOUNDED_VARIATION THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_REAL_VARIATION_DARBOUX]) THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INCREASING THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `!n. integer n ==> f has_bounded_real_variation_on real_interval [(&2 * n - &1) * pi,(&2 * n + &1) * pi]` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&2 * --n * pi` o MATCH_MP HAS_BOUNDED_REAL_VARIATION_TRANSLATION) THEN REWRITE_TAC[INTEGER_NEG; GSYM REAL_INTERVAL_TRANSLATION] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_PERIODIC_INTEGER_MULTIPLE]) THEN DISCH_THEN(MP_TAC o GEN `x:real` o SPECL [`x:real`; `--n:real`]) THEN ASM_REWRITE_TAC[REAL_ARITH `x + n * &2 * pi = &2 * n * pi + x`] THEN ASM_REWRITE_TAC[INTEGER_NEG] THEN DISCH_TAC THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. f has_bounded_real_variation_on real_interval[--pi,&(2 * n + 1) * pi]` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID] THEN MP_TAC(ISPECL [`f:real->real`; `--pi`; `&((2 + 2 * n) + 1) * pi`; `&(2 * n + 1) * pi`] HAS_BOUNDED_REAL_VARIATION_ON_COMBINE) THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ARITH `--pi = --(&1) * pi`] THEN SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_OF_NUM_LE] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ARITH_TAC]; DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_ARITH `(&2 * n + &1) * pi = (&2 * (n + &1) - &1) * pi`] THEN REWRITE_TAC[REAL_ARITH `((&2 + &2 * n) + &1) * pi = (&2 * (n + &1) + &1) * pi`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[INTEGER_CLOSED]]; ALL_TAC] THEN SUBGOAL_THEN `!m n. f has_bounded_real_variation_on real_interval[--(&(2 * m + 1)) * pi,&(2 * n + 1) * pi]` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID; REAL_MUL_LNEG] THEN X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`f:real->real`; `--(&((2 + 2 * m) + 1) * pi)`; `&(2 * n + 1) * pi`; `--(&(2 * m + 1) * pi)`] HAS_BOUNDED_REAL_VARIATION_ON_COMBINE) THEN ANTS_TAC THENL [REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_OF_NUM_LE] THEN REWRITE_TAC[REAL_LE_NEG2; REAL_ARITH `--a <= b <=> &0 <= a + b`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ARITH_TAC; DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_ARITH `--(&2 * m + &1) = &2 * --(m + &1) + &1`] THEN REWRITE_TAC[REAL_ARITH `--((&2 + &2 * m) + &1) = &2 * --(m + &1) - &1`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[INTEGER_CLOSED]]; ALL_TAC] THEN MP_TAC(ISPEC `&2 * pi` REAL_ARCH) THEN ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `abs x + &3`) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MATCH_MP_TAC HAS_BOUNDED_REAL_VARIATION_ON_SUBSET THEN EXISTS_TAC `real_interval[-- &(2 * N + 1) * pi,&(2 * N + 1) * pi]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Cesaro summability of Fourier series using Fejer kernel. *) (* ------------------------------------------------------------------------- *) let fejer_kernel = new_definition `fejer_kernel n x = if n = 0 then &0 else sum(0..n-1) (\r. dirichlet_kernel r x) / &n`;; let FEJER_KERNEL = prove (`fejer_kernel n x = if n = 0 then &0 else if x = &0 then &n / &2 else sin(&n / &2 * x) pow 2 / (&2 * &n * sin(x / &2) pow 2)`, REWRITE_TAC[fejer_kernel; dirichlet_kernel] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[SUM_0] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[SUM_ADD_NUMSEG; SUM_CONST_NUMSEG; REWRITE_RULE[ETA_AX] SUM_NUMBERS] THEN ASM_SIMP_TAC[SUB_ADD; GSYM REAL_OF_NUM_SUB; LE_1; SUB_0] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN ASM_CASES_TAC `sin(x / &2) = &0` THENL [ASM_REWRITE_TAC[REAL_POW_ZERO; ARITH_EQ; REAL_MUL_RZERO; real_div; REAL_INV_0; SUM_0; REAL_MUL_LZERO]; ALL_TAC] THEN MATCH_MP_TAC(REAL_FIELD `~(n = &0) /\ ~(s = &0) /\ &2 * s pow 2 * l = r ==> l / n = r / (&2 * n * s pow 2)`) THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; GSYM SUM_LMUL] THEN ASM_SIMP_TAC[REAL_FIELD `~(s = &0) ==> &2 * s pow 2 * a / (&2 * s) = s * a`] THEN REWRITE_TAC[REAL_MUL_SIN_SIN] THEN REWRITE_TAC[REAL_ARITH `x / &2 - (&n + &1 / &2) * x = --(&n * x)`; REAL_ARITH `x / &2 + (&n + &1 / &2) * x = (&n + &1) * x`] THEN REWRITE_TAC[real_div; SUM_RMUL; COS_NEG; REAL_OF_NUM_ADD] THEN REWRITE_TAC[SUM_DIFFS; LE_0; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[SUB_ADD; LE_1; REAL_SUB_COS] THEN REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; real_div; REAL_MUL_AC] THEN REAL_ARITH_TAC);; let FEJER_KERNEL_CONTINUOUS_STRONG = prove (`!n. (fejer_kernel n) real_continuous_on real_interval(--(&2 * pi),&2 * pi)`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[fejer_kernel] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN REWRITE_TAC[FINITE_NUMSEG; DIRICHLET_KERNEL_CONTINUOUS_STRONG]);; let FEJER_KERNEL_CONTINUOUS = prove (`!n. (fejer_kernel n) real_continuous_on real_interval[--pi,pi]`, GEN_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `real_interval(--(&2 * pi),&2 * pi)` THEN REWRITE_TAC[FEJER_KERNEL_CONTINUOUS_STRONG] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL = prove (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] ==> (\x. fejer_kernel n x * f x) absolutely_real_integrable_on real_interval[--pi,pi]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN ASM_REWRITE_TAC[FEJER_KERNEL_CONTINUOUS; ETA_AX; REAL_CLOSED_REAL_INTERVAL]; MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[FEJER_KERNEL_CONTINUOUS; ETA_AX; REAL_COMPACT_INTERVAL]]);; let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED = prove (`!f n c. f absolutely_real_integrable_on real_interval [--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) ==> (\x. fejer_kernel n x * f(t + x)) absolutely_real_integrable_on real_interval[--pi,pi] /\ (\x. fejer_kernel n x * f(t - x)) absolutely_real_integrable_on real_interval[--pi,pi] /\ (\x. fejer_kernel n x * c) absolutely_real_integrable_on real_interval[--pi,pi]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL THENL [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; REWRITE_TAC[absolutely_real_integrable_on] THEN ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]]);; let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART = prove (`!f n d c. f absolutely_real_integrable_on real_interval [--pi,pi] /\ (!x. f(x + &2 * pi) = f(x)) /\ d <= pi ==> (\x. fejer_kernel n x * f(t + x)) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. fejer_kernel n x * f(t - x)) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. fejer_kernel n x * c) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. fejer_kernel n x * (f(t + x) + f(t - x))) absolutely_real_integrable_on real_interval[&0,d] /\ (\x. fejer_kernel n x * ((f(t + x) + f(t - x)) - c)) absolutely_real_integrable_on real_interval[&0,d]`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED) ASSUME_TAC) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c) /\ (a /\ b /\ c ==> d /\ e) ==> a /\ b /\ c /\ d /\ e`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[--pi,pi]` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; SIMP_TAC[REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB; ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_SUB]]);; let FOURIER_SUM_OFFSET_FEJER_KERNEL_HALF = prove (`!f n t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) /\ 0 < n ==> sum(0..n-1) (\r. sum (0..2*r) (\k. fourier_coefficient f k * trigonometric_set k t)) / &n - l = real_integral (real_interval[&0,pi]) (\x. fejer_kernel n x * ((f(t + x) + f(t - x)) - &2 * l)) / pi`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LE_1; REAL_OF_NUM_EQ; REAL_FIELD `~(n = &0) ==> (x / n - l = y <=> x - n * l = n * y)`] THEN MP_TAC(ISPECL [`l:real`; `0`; `n - 1`] SUM_CONST_NUMSEG) THEN ASM_SIMP_TAC[SUB_ADD; LE_1; SUB_0] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF] THEN REWRITE_TAC[real_div; SUM_RMUL; REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_SUM o lhand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; FINITE_NUMSEG; REAL_LE_REFL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SUM_RMUL] THEN ASM_SIMP_TAC[GSYM REAL_INTEGRAL_LMUL; REAL_LE_REFL; ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_SIMP_TAC[fejer_kernel; LE_1] THEN MATCH_MP_TAC(REAL_FIELD `~(n = &0) ==> s * f = n * s / n * f`) THEN ASM_SIMP_TAC[LE_1; REAL_OF_NUM_EQ]);; let FOURIER_SUM_LIMIT_FEJER_KERNEL_HALF = prove (`!f t l. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f (x + &2 * pi) = f x) ==> (((\n. sum(0..n-1) (\r. sum (0..2*r) (\k. fourier_coefficient f k * trigonometric_set k t)) / &n) ---> l) sequentially <=> ((\n. real_integral (real_interval[&0,pi]) (\x. fejer_kernel n x * ((f(t + x) + f(t - x)) - &2 * l))) ---> &0) sequentially)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN GEN_REWRITE_TAC LAND_CONV [REALLIM_NULL] THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REALLIM_NULL_RMUL_EQ PI_NZ)] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN MATCH_MP_TAC REALLIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_FEJER_KERNEL_HALF; LE_1] THEN ASM_SIMP_TAC[PI_POS; REAL_LT_IMP_NZ; REAL_DIV_RMUL; REAL_SUB_REFL]);; let HAS_REAL_INTEGRAL_FEJER_KERNEL = prove (`!n. (fejer_kernel n has_real_integral (if n = 0 then &0 else pi)) (real_interval[--pi,pi])`, GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[fejer_kernel] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0] THEN SUBGOAL_THEN `pi = sum(0..n-1) (\r. pi) / &n` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL [ASM_SIMP_TAC[SUM_CONST_NUMSEG; SUB_ADD; LE_1; SUB_0] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN CONV_TAC REAL_FIELD; REWRITE_TAC[real_div] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN REWRITE_TAC[FINITE_NUMSEG; HAS_REAL_INTEGRAL_DIRICHLET_KERNEL]]);; let HAS_REAL_INTEGRAL_FEJER_KERNEL_HALF = prove (`!n. (fejer_kernel n has_real_integral (if n = 0 then &0 else pi / &2)) (real_interval[&0,pi])`, GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[fejer_kernel] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0] THEN SUBGOAL_THEN `pi / &2 = sum(0..n-1) (\r. pi / &2) / &n` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL [ASM_SIMP_TAC[SUM_CONST_NUMSEG; SUB_ADD; LE_1; SUB_0] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN CONV_TAC REAL_FIELD; REWRITE_TAC[real_div] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[FINITE_NUMSEG; HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF]]);; let FEJER_KERNEL_POS_LE = prove (`!n x. &0 <= fejer_kernel n x`, REPEAT GEN_TAC THEN REWRITE_TAC[FEJER_KERNEL] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV]) THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_POW_2] THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS]) THEN REWRITE_TAC[REAL_LE_POW_2]);; let FOURIER_FEJER_CESARO_SUMMABLE = prove (`!f x l r. f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!x. f(x + &2 * pi) = f x) /\ (f ---> l) (atreal x within {x' | x' <= x}) /\ (f ---> r) (atreal x within {x' | x' >= x}) ==> ((\n. sum(0..n-1) (\m. sum (0..2*m) (\k. fourier_coefficient f k * trigonometric_set k x)) / &n) ---> (l + r) / &2) sequentially`, MAP_EVERY X_GEN_TAC [`f:real->real`; `t:real`; `l:real`; `r:real`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_LIMIT_FEJER_KERNEL_HALF] THEN REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN ABBREV_TAC `h = \u. ((f:real->real)(t + u) + f(t - u)) - (l + r)` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `(h ---> &0) (atreal(&0) within {x | &0 <= x})` ASSUME_TAC THENL [EXPAND_TAC "h" THEN REWRITE_TAC[REAL_ARITH `(f' + f) - (l + l'):real = (f - l) + (f' - l')`] THEN MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL [UNDISCH_TAC `(f ---> l) (atreal t within {x' | x' <= t})` THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t - x:real` th)) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN REAL_ARITH_TAC; UNDISCH_TAC `(f ---> r) (atreal t within {x' | x' >= t})` THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t + x:real` th)) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?k. &0 < k /\ k < pi /\ (!x. &0 < x /\ x <= k ==> abs(h x) < e / &2 / pi)` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `(h ---> &0) (atreal (&0) within {x | &0 <= x})` THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / pi`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; PI_POS; IN_ELIM_THM; REAL_SUB_RZERO; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN EXISTS_TAC `min k pi / &2` THEN REPEAT(CONJ_TAC THENL [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `((\n. real_integral (real_interval[k,pi]) (\x. fejer_kernel n x * h x)) ---> &0) sequentially` MP_TAC THENL [MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN EXISTS_TAC `\n. real_integral (real_interval[k,pi]) (\x. abs(h x) / (&2 * sin(x / &2) pow 2)) / &n` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_N]] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[FEJER_KERNEL; LE_1] THEN SUBGOAL_THEN `(\x. h x / (&2 * sin(x / &2) pow 2)) absolutely_real_integrable_on real_interval[k,pi]` MP_TAC THENL [REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN REWRITE_TAC[GSYM real_div] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS; MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[REAL_COMPACT_INTERVAL]; EXPAND_TAC "h" THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ADD THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; REWRITE_TAC[real_sub; absolutely_real_integrable_on] THEN ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]]; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]] THEN (REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[REAL_RING `&2 * x pow 2 = &0 <=> x = &0`] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REAL_ARITH_TAC]); DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP ABSOLUTELY_REAL_INTEGRABLE_ABS th)) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_POW] THEN REWRITE_TAC[REAL_POW2_ABS] THEN DISCH_TAC] THEN GEN_REWRITE_TAC RAND_CONV [real_div] THEN ASM_SIMP_TAC[GSYM REAL_INTEGRAL_RMUL; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_SIMP_TAC[REAL_INTEGRABLE_RMUL; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_ABS_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1 * y`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; ABS_SQUARE_LE_1; SIN_BOUND] THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ &0 <= x ==> abs x <= y`) THEN REWRITE_TAC[GSYM real_div; REAL_LE_INV_EQ] THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_POW_2] THEN REWRITE_TAC[REAL_MUL_AC]; DISCH_TAC] THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. abs(h x) / (&2 * sin(x / &2) pow 2) * inv(&n)` THEN ASM_SIMP_TAC[REAL_INTEGRABLE_RMUL; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN EXISTS_TAC `\x. sin(&n / &2 * x) pow 2 / (&2 * &n * sin(x / &2) pow 2) * h(x)` THEN CONJ_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `s * t * n * i * h:real = n * s * h * (t * i)`] THEN MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; ABS_SQUARE_LE_1; SIN_BOUND]]; ALL_TAC] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `MAX 1 N` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[ARITH_RULE `MAX a b <= x <=> a <= x /\ b <= x`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`\x. fejer_kernel n x * h x`; `&0`; `pi`; `k:real`] REAL_INTEGRAL_COMBINE) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "h" THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= e / &2 ==> x + y = z ==> abs y < e / &2 ==> abs z < e`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `real_integral (real_interval[&0,k]) (\x. fejer_kernel n x * e / &2 / pi)` THEN CONJ_TAC THENL [SUBGOAL_THEN `real_integral (real_interval [&0,k]) (\x. fejer_kernel n x * h x) = real_integral (real_interval [&0,k]) (\x. fejer_kernel n x * (if x = &0 then &0 else h x))` SUBST1_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{&0}` THEN SIMP_TAC[IN_DIFF; IN_SING] THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING]; ALL_TAC] THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN MAP_EVERY EXISTS_TAC [`\x. fejer_kernel n x * h x`; `{&0}`] THEN SIMP_TAC[IN_DIFF; IN_SING; REAL_NEGLIGIBLE_SING] THEN EXPAND_TAC "h" THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_LT_IMP_LE]; MP_TAC(ISPECL [`\x:real. e / &2 / pi`; `n:num`; `k:real`; `&0`] ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART) THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST; REAL_LT_IMP_LE; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; REAL_ARITH `abs x <= x <=> &0 <= x`] THEN REWRITE_TAC[FEJER_KERNEL_POS_LE] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_ABS_NUM; REAL_POS; PI_POS_LE; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; MP_TAC(SPEC `n:num` HAS_REAL_INTEGRAL_FEJER_KERNEL_HALF) THEN ASM_SIMP_TAC[LE_1] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `real_integral (real_interval[&0,pi]) (\x. fejer_kernel n x * e / &2 / pi)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `real_interval[&0,pi]` THEN CONJ_TAC THENL [ASM_MESON_TAC[real_integrable_on]; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[real_integrable_on]; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[FEJER_KERNEL_POS_LE] THEN REPEAT(MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC) THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC]; FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / pi`) THEN SIMP_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN REPEAT STRIP_TAC THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> pi / &2 * e / &2 / pi = e / &4`] THEN ASM_REAL_ARITH_TAC]]);; let FOURIER_FEJER_CESARO_SUMMABLE_SIMPLE = prove (`!f x l r. f real_continuous_on (:real) /\ (!x. f(x + &2 * pi) = f x) ==> ((\n. sum(0..n-1) (\m. sum (0..2*m) (\k. fourier_coefficient f k * trigonometric_set k x)) / &n) ---> f(x)) sequentially`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [REAL_ARITH `x = (x + x) / &2`] THEN MATCH_MP_TAC FOURIER_FEJER_CESARO_SUMMABLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS THEN ASM_MESON_TAC[REAL_CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; CONJ_TAC THEN MATCH_MP_TAC REALLIM_ATREAL_WITHINREAL THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_ATREAL] THEN ASM_MESON_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; IN_UNIV]]);; hol-light/100/friendship.ml000066400000000000000000001107551303454263000157430ustar00rootroot00000000000000(* ========================================================================= *) (* The friendship theorem. *) (* *) (* Proof from "Combinatorics Tutorial 2: Friendship Theorem", copyright *) (* MathOlymp.com, 2001. Apparently due to J. Q. Longyear and T. D. Parsons. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/pocklington.ml";; (* ------------------------------------------------------------------------- *) (* Useful inductive breakdown principle ending at gcd. *) (* ------------------------------------------------------------------------- *) let GCD_INDUCT = prove (`!P. (!m n. P m /\ P (m + n) ==> P n) ==> !m n. P m /\ P n ==> P (gcd(m,n))`, GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN WF_INDUCT_TAC `m + n:num` THEN REPEAT(POP_ASSUM MP_TAC) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`n:num`; `m:num`] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI; GCD_SYM; ADD_SYM]; REPEAT STRIP_TAC] THEN ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[GCD_0]; ALL_TAC] THEN UNDISCH_TAC `!m n:num. P m /\ P (m + n) ==> P n` THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `n - m:num`]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[SUB_ADD; LT_IMP_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n - m:num`]) THEN REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[ADD_SUB2; GCD_ADD]);; (* ------------------------------------------------------------------------- *) (* General theorems about loops in a sequence. *) (* ------------------------------------------------------------------------- *) let LOOP_GCD = prove (`!x m n. (!i. x(i + m) = x(i)) /\ (!i. x(i + n) = x(i)) ==> !i. x(i + gcd(m,n)) = x(i)`, GEN_TAC THEN MATCH_MP_TAC GCD_INDUCT THEN MESON_TAC[ADD_AC]);; let LOOP_COPRIME = prove (`!x m n. (!i. x(i + m) = x(i)) /\ (!i. x(i + n) = x(i)) /\ coprime(m,n) ==> !i. x i = x 0`, REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN REWRITE_TAC[ADD1] THEN ASM_MESON_TAC[LOOP_GCD; COPRIME_GCD]);; (* ------------------------------------------------------------------------- *) (* General theorem about partition into equally-sized eqv classes. *) (* ------------------------------------------------------------------------- *) let EQUIVALENCE_UNIFORM_PARTITION = prove (`!R s k. FINITE s /\ (!x. x IN s ==> R x x) /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x:A. x IN s ==> CARD {y | y IN s /\ R x y} = k) ==> k divides (CARD s)`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(s:A->bool)` THEN ASM_CASES_TAC `s:A->bool = {}` THENL [ASM_MESON_TAC[CARD_CLAUSES; DIVIDES_0]; REPEAT STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `{y:A | y IN s /\ ~(R (a:A) y)}`) THEN REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL [ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM_SIMP_TAC[PSUBSET; SUBSET; EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[]; GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (ANTE_RES_THEN MP_TAC) ASSUME_TAC) THEN DISCH_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `CARD(s) = CARD {y | y IN s /\ (R:A->A->bool) a y} + CARD {y | y IN s /\ ~(R a y)}` (fun th -> ASM_SIMP_TAC[th; DIVIDES_ADD; DIVIDES_REFL]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* With explicit restricted quantification. *) (* ------------------------------------------------------------------------- *) let EQUIVALENCE_UNIFORM_PARTITION_RESTRICT = prove (`!R s k. FINITE s /\ (!x. x IN s ==> R x x) /\ (!x y. x IN s /\ y IN s /\ R x y ==> R y x) /\ (!x y z. x IN s /\ y IN s /\ z IN s /\ R x y /\ R y z ==> R x z) /\ (!x:A. x IN s ==> CARD {y | y IN s /\ R x y} = k) ==> k divides (CARD s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQUIVALENCE_UNIFORM_PARTITION THEN EXISTS_TAC `\x y:A. x IN s /\ y IN s /\ R x y` THEN SIMP_TAC[] THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* General theorem about pairing up elements of a set. *) (* ------------------------------------------------------------------------- *) let ELEMENTS_PAIR_UP = prove (`!s r. FINITE s /\ (!x. x IN s ==> ~(r x x)) /\ (!x y. x IN s /\ y IN s /\ r x y ==> r y x) /\ (!x:A. x IN s ==> ?!y. y IN s /\ r x y) ==> EVEN(CARD s)`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(s:A->bool)` THEN STRIP_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[CARD_CLAUSES; ARITH] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN MP_TAC(ASSUME `!x:A. x IN s ==> (?!y:A. y IN s /\ r x y)`) THEN DISCH_THEN(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[ASSUME `a:A IN s`] THEN DISCH_THEN(MP_TAC o EXISTENCE) THEN DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A) DELETE b`) THEN REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL [ALL_TAC; DISCH_TAC THEN SUBGOAL_THEN `s = (a:A) INSERT b INSERT (s DELETE a DELETE b)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; FINITE_INSERT] THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[EVEN]] THEN ASM_SIMP_TAC[FINITE_DELETE; IN_DELETE] THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:A` THEN STRIP_TAC THEN MP_TAC(ASSUME `!x:A. x IN s ==> (?!y. y IN s /\ r x y)`) THEN DISCH_THEN(MP_TAC o SPEC `x:A`) THEN REWRITE_TAC[ASSUME `x:A IN s`] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:A` THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cycles and paths. *) (* ------------------------------------------------------------------------- *) let cycle = new_definition `cycle r k x <=> (!i. r (x i) (x(i + 1))) /\ (!i. x(i + k) = x(i))`;; let path = new_definition `path r k x <=> (!i. i < k ==> r (x i) (x(i + 1))) /\ (!i. k < i ==> x(i) = @x. T)`;; (* ------------------------------------------------------------------------- *) (* Lemmas about these concepts. *) (* ------------------------------------------------------------------------- *) let CYCLE_OFFSET = prove (`!r k x:num->A. cycle r k x ==> !i m. x(m * k + i) = x(i)`, REPEAT GEN_TAC THEN REWRITE_TAC[cycle] THEN STRIP_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN ASM_MESON_TAC[ADD_AC]);; let CYCLE_MOD = prove (`!r k x:num->A. cycle r k x /\ ~(k = 0) ==> !i. x(i MOD k) = x(i)`, MESON_TAC[CYCLE_OFFSET; DIVISION]);; let PATHS_MONO = prove (`(!x y. r x y ==> s x y) ==> {x | path r k x} SUBSET {x | path s k x}`, REWRITE_TAC[path; IN_ELIM_THM; SUBSET] THEN MESON_TAC[]);; let HAS_SIZE_PATHS = prove (`!N m r k. (:A) HAS_SIZE N /\ (!x. {y | r x y} HAS_SIZE m) ==> {x:num->A | path r k x} HAS_SIZE (N * m EXP k)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_CLAUSES] THENL [SUBGOAL_THEN `{x:num->A | path r 0 x} = IMAGE (\a i. if i = 0 then a else @x. T) (:A)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV; path; LT] THEN REWRITE_TAC[FUN_EQ_THM; LT_NZ] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `{x:num->A | path r (SUC k) x} = IMAGE (\(x,a) i. if i = SUC k then a else x i) {x,a | x IN {x | path r k x} /\ a IN {u | r (x k) u}}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN X_GEN_TAC `x:num->A` THEN REWRITE_TAC[PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REWRITE_TAC[FUN_EQ_THM; path; LT] THEN EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC `\i. if i = SUC k then @x. T else x(i):A` THEN EXISTS_TAC `x(SUC k):A` THEN SIMP_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[ARITH_RULE `~(k = SUC k) /\ (i < k ==> ~(i = SUC k))`] THEN ASM_SIMP_TAC[ADD1; ARITH_RULE `i < k ==> ~(i + 1 = SUC k)`] THEN ASM_MESON_TAC[ARITH_RULE `k < i /\ ~(i = k + 1) ==> SUC k < i`]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:num->A`; `a:A`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[ARITH_RULE `i = k \/ i < k ==> ~(i = SUC k)`] THEN REWRITE_TAC[ARITH_RULE `i + 1 = SUC k <=> i = k`] THEN ASM_MESON_TAC[ARITH_RULE `SUC k < i ==> ~(i = SUC k) /\ k < i`]; ALL_TAC] THEN ONCE_REWRITE_TAC[ARITH_RULE `N * m * m EXP k = (N * m EXP k) * m`] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM] THEN REWRITE_TAC[FUN_EQ_THM; path; PAIR_EQ] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i = SUC k` THEN ASM_MESON_TAC[ARITH_RULE `k < SUC k`]; ALL_TAC] THEN ASM_SIMP_TAC[HAS_SIZE_PRODUCT_DEPENDENT]);; let FINITE_PATHS = prove (`!r k. FINITE(:A) ==> FINITE {x:num->A | path r k x}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:num->A | path (\a b. T) k x}` THEN SIMP_TAC[PATHS_MONO] THEN MP_TAC(ISPECL [`CARD(:A)`; `CARD(:A)`; `\a:A b:A. T`; `k:num`] HAS_SIZE_PATHS) THEN ANTS_TAC THEN ASM_SIMP_TAC[HAS_SIZE; SET_RULE `{y | T} = (:A)`]);; let HAS_SIZE_CYCLES = prove (`!r k. FINITE(:A) /\ ~(k = 0) ==> {x:num->A | cycle r k x} HAS_SIZE CARD{x:num->A | path r k x /\ x(k) = x(0)}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x:num->A | cycle r k x} = IMAGE (\x i. x(i MOD k)) {x | path r k x /\ x(k) = x(0)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:num->A` THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `\i. if i <= k then x(i):A else @x. T` THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[FUN_EQ_THM; LT_IMP_LE; DIVISION] THEN ASM_MESON_TAC[CYCLE_MOD]; SIMP_TAC[path; LT_IMP_LE] THEN REWRITE_TAC[GSYM NOT_LT] THEN SIMP_TAC[ARITH_RULE `i < k ==> ~(k < i + 1)`] THEN ASM_MESON_TAC[cycle]; REWRITE_TAC[LE_0; LE_REFL] THEN ASM_MESON_TAC[cycle; ADD_CLAUSES]]; REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:num->A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[cycle] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THENL [ALL_TAC; AP_TERM_TAC THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `1` THEN REWRITE_TAC[MULT_CLAUSES]] THEN SUBGOAL_THEN `y((i + 1) MOD k):A = y(i MOD k + 1)` SUBST1_TAC THENL [ALL_TAC; ASM_MESON_TAC[path; DIVISION]] THEN SUBGOAL_THEN `(i + 1) MOD k = (i MOD k + 1) MOD k` SUBST1_TAC THENL [MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `i DIV k` THEN REWRITE_TAC[ARITH_RULE `i + 1 = (m + 1) + ik <=> i = ik + m`] THEN ASM_MESON_TAC[DIVISION]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o CONJUNCT2 o SPEC `i:num` o MATCH_MP DIVISION) THEN SPEC_TAC(`i MOD k`,`j:num`) THEN GEN_TAC THEN ONCE_REWRITE_TAC[ARITH_RULE `j < k <=> j + 1 < k \/ j + 1 = k`] THEN STRIP_TAC THEN ASM_SIMP_TAC[MOD_LT] THEN AP_TERM_TAC THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `1` THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC]; ALL_TAC] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:num->A | path r k x}` THEN ASM_SIMP_TAC[FINITE_PATHS] THEN SET_TAC[]] THEN MAP_EVERY X_GEN_TAC [`x:num->A`; `y:num->A`] THEN SIMP_TAC[IN_ELIM_THM] THEN REWRITE_TAC[path; FUN_EQ_THM] THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`i:num`; `k:num`] LT_CASES) THENL [ASM_MESON_TAC[MOD_LT]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN ASM_MESON_TAC[MOD_0]);; let FINITE_CYCLES = prove (`!r k. FINITE(:A) /\ ~(k = 0) ==> FINITE {x:num->A | cycle r k x}`, MESON_TAC[HAS_SIZE_CYCLES; HAS_SIZE]);; let CARD_PATHCYCLES_STEP = prove (`!N m r k. (:A) HAS_SIZE N /\ ~(k = 0) /\ ~(m = 0) /\ (!x:A. {y | r x y} HAS_SIZE m) /\ (!x y. r x y ==> r y x) /\ (!x y. ~(x = y) ==> ?!z. r x z /\ r z y) ==> {x | path r (k + 2) x /\ x(k + 2) = x(0)} HAS_SIZE (m * CARD {x | path r k x /\ x(k) = x(0)} + CARD {x | path r (k) x /\ ~(x(k) = x(0))})`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `{x | path r (k + 2) x /\ x(k + 2) = x(0)} = {x | path r (k + 2) x /\ x k = x 0 /\ x(k + 2) = x(0)} UNION {x | path r (k + 2) x /\ ~(x k = x 0) /\ x(k + 2) = x(0)}`] THEN MATCH_MP_TAC HAS_SIZE_UNION THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN CONJ_TAC THENL [SUBGOAL_THEN `{x:num->A | path r (k + 2) x /\ x k = x 0 /\ x (k + 2) = x 0} = IMAGE (\(x,a) i. if i = k + 1 then a else if i = k + 2 then x(0) else x(i)) {x,a | x IN {x | path r k x /\ x(k) = x(0)} /\ a IN {u | r (x k) u}}` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; FUN_EQ_THM; PAIR_EQ] THEN MAP_EVERY X_GEN_TAC [`y:num->A`; `a:A`; `z:num->A`; `b:A`] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th THENL [ALL_TAC; MESON_TAC[]]) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> X_GEN_TAC `i:num` THEN MP_TAC th) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `0` th)) THEN REWRITE_TAC[ARITH_RULE `~(0 = k + 1) /\ ~(0 = k + 2)`] THEN DISCH_TAC THEN ASM_CASES_TAC `k:num < i` THENL [ASM_MESON_TAC[path]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_MESON_TAC[ARITH_RULE `k < k + 1 /\ k < k + 2`]; ALL_TAC] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:num->A | path r k x}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN ASM_MESON_TAC[HAS_SIZE; FINITE_PATHS]] THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN X_GEN_TAC `x:num->A` THEN EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC `\i. if i <= k then x(i):A else @x. T` THEN EXISTS_TAC `(x:num->A) (k + 1)` THEN REWRITE_TAC[IN_ELIM_THM; LE_REFL; LE_0] THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[path; ARITH_RULE `k < k + 2`]] THEN CONJ_TAC THENL [ALL_TAC; UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN SIMP_TAC[path; LT_IMP_LE; ARITH_RULE `i < k ==> i + 1 <= k`] THEN SIMP_TAC[GSYM NOT_LT] THEN MESON_TAC[ARITH_RULE `i < k ==> i < k + 2`]] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i = k + 2` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `i:num` o CONJUNCT2) THEN ASM_REWRITE_TAC[ARITH_RULE `k + 2 < i <=> ~(i <= k) /\ ~(i = k + 1) /\ ~(i = k + 2)`]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:num->A`; `b:A`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `0` th)) THEN REWRITE_TAC[COND_ID; ARITH_RULE `~(0 = k + 1)`] THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(LABEL_TAC "*") THEN CONJ_TAC THENL [ALL_TAC; REMOVE_THEN "*" (MP_TAC o SPEC `k + 2`) THEN ASM_REWRITE_TAC[ARITH_RULE `~(k + 2 = k + 1)`]] THEN CONJ_TAC THENL [ALL_TAC; REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[ARITH_RULE `~(k = k + 2) /\ ~(k = k + 1)`]] THEN UNDISCH_TAC `path r k (z:num->A)` THEN ASM_REWRITE_TAC[path] THEN SIMP_TAC[ARITH_RULE `k + 2 < i ==> k < i /\ ~(i = k + 1) /\ ~(i = k + 2)`] THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[ARITH_RULE `i < k + 2 ==> ~(i = k + 2)`] THEN REWRITE_TAC[ARITH_RULE `i + 1 = k + 2 <=> i = k + 1`] THEN ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[ARITH_RULE `~(x + 1 = x)`]; ALL_TAC] THEN REWRITE_TAC[EQ_ADD_RCANCEL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[ARITH_RULE `i < k + 2 /\ ~(i = k) /\ ~(i = k + 1) ==> i < k`]; ALL_TAC] THEN SUBGOAL_THEN `{x:num->A | path r (k + 2) x /\ ~(x k = x 0) /\ x (k + 2) = x 0} = IMAGE (\x i. if i = k + 1 then @z. r (x k) z /\ r z (x 0) else if i = k + 2 then x(0) else x(i)) {x | path r k x /\ ~(x(k) = x(0))}` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:num->A | path r k x}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN ASM_MESON_TAC[HAS_SIZE; FINITE_PATHS]] THEN MAP_EVERY X_GEN_TAC [`x:num->A`; `y:num->A`] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `k:num < i` THENL [ASM_MESON_TAC[path]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_MESON_TAC[ARITH_RULE `k < k + 1 /\ k < k + 2`]] THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:num->A` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC `\i. if i <= k then x(i):A else @x. T` THEN ASM_REWRITE_TAC[LE_REFL; LE_0] THEN CONJ_TAC THENL [ALL_TAC; UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN SIMP_TAC[path; LT_IMP_LE; ARITH_RULE `i < k ==> i + 1 <= k`] THEN SIMP_TAC[GSYM NOT_LT] THEN MESON_TAC[ARITH_RULE `i < k ==> i < k + 2`]] THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SELECT_UNIQUE THEN UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN REWRITE_TAC[path] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `k:num` th) THEN MP_TAC(SPEC `k + 1` th)) THEN REWRITE_TAC[ARITH_RULE `k < k + 2 /\ k + 1 < k + 2`] THEN REWRITE_TAC[GSYM ADD_ASSOC; ARITH] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `i = k + 2` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN REWRITE_TAC[path] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_MESON_TAC[ARITH_RULE `~(i <= k) /\ ~(i = k + 1) /\ ~(i = k + 2) ==> k + 2 < i`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `y:num->A` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[ARITH_RULE `~(k + 2 = k + 1) /\ ~(0 = k + 1) /\ ~(0 = k + 2) /\ ~(k = k + 1) /\ ~(k = k + 2)`] THEN REWRITE_TAC[path] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THENL [REWRITE_TAC[ARITH_RULE `i + 1 = k + 2 <=> i = k + 1`] THEN ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[ARITH_RULE `(k + 1) + 1 = k + 1 <=> F`] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `i < k + 2 ==> ~(i = k + 2)`] THEN REWRITE_TAC[EQ_ADD_RCANCEL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN UNDISCH_TAC `path r k (y:num->A)` THEN REWRITE_TAC[path] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN MAP_EVERY UNDISCH_TAC [`~(i:num = k)`; `~(i = k + 1)`; `i < k + 2`] THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `k + 2 < i ==> ~(i = k + 1) /\ ~(i = k + 2)`] THEN ASM_MESON_TAC[path; ARITH_RULE `k + 2 < i ==> k < i`]);; (* ------------------------------------------------------------------------- *) (* The first lemma about the number of cycles. *) (* ------------------------------------------------------------------------- *) let shiftable = new_definition `shiftable x y <=> ?k. !i. x(i) = y(i + k)`;; let SHIFTABLE_REFL = prove (`!x. shiftable x x`, REWRITE_TAC[shiftable] THEN MESON_TAC[ADD_CLAUSES]);; let SHIFTABLE_TRANS = prove (`!x y z. shiftable x y /\ shiftable y z ==> shiftable x z`, REWRITE_TAC[shiftable] THEN MESON_TAC[ADD_ASSOC]);; let SHIFTABLE_LOCAL = prove (`!x y p r. cycle r p x /\ cycle r p y /\ ~(p = 0) ==> (shiftable x y <=> ?k. k < p /\ !i. x(i) = y(i + k))`, REPEAT STRIP_TAC THEN REWRITE_TAC[shiftable] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN EXISTS_TAC `k MOD p` THEN FIRST_ASSUM(MP_TAC o SPEC `k:num` o MATCH_MP DIVISION) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN ASM_MESON_TAC[CYCLE_OFFSET; ADD_AC]);; let SHIFTABLE_SYM = prove (`!x y p r. cycle r p x /\ cycle r p y /\ ~(p = 0) /\ shiftable x y ==> shiftable y x`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ b /\ c) /\ d`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SHIFTABLE_LOCAL) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN REWRITE_TAC[shiftable] THEN EXISTS_TAC `p - k:num` THEN ASM_SIMP_TAC[ARITH_RULE `k < p ==> (i + (p - k)) + k = i + p:num`] THEN ASM_MESON_TAC[cycle]);; let CYCLES_PRIME_LEMMA = prove (`!r p x. FINITE(:A) /\ prime p /\ (!x. ~(r x x)) ==> p divides CARD {x:num->A | cycle r p x}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN STRIP_TAC THEN MATCH_MP_TAC EQUIVALENCE_UNIFORM_PARTITION_RESTRICT THEN EXISTS_TAC `shiftable:(num->A)->(num->A)->bool` THEN ASM_SIMP_TAC[IN_ELIM_THM; FINITE_CYCLES] THEN CONJ_TAC THENL [MESON_TAC[SHIFTABLE_REFL]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[SHIFTABLE_SYM]; ALL_TAC] THEN CONJ_TAC THENL [MESON_TAC[SHIFTABLE_TRANS]; ALL_TAC] THEN X_GEN_TAC `x:num->A` THEN DISCH_TAC THEN SUBGOAL_THEN `{y:num->A | cycle r p y /\ shiftable x y} HAS_SIZE p` (fun th -> MESON_TAC[HAS_SIZE; th]) THEN SUBGOAL_THEN `{y:num->A | cycle r p y /\ shiftable x y} = IMAGE (\k i. x(i + k)) {k | k < p}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `y:num->A` THEN REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL [ASM_MESON_TAC[SHIFTABLE_LOCAL; SHIFTABLE_SYM]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cycle]) THEN ASM_REWRITE_TAC[cycle] THEN MESON_TAC[ADD_AC]; ALL_TAC] THEN MATCH_MP_TAC SHIFTABLE_SYM THEN MAP_EVERY EXISTS_TAC [`p:num`; `r:A->A->bool`] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cycle]) THEN ASM_REWRITE_TAC[cycle; shiftable] THEN MESON_TAC[ADD_AC]; ALL_TAC] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_LT] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC WLOG_LE THEN REWRITE_TAC[FUN_EQ_THM] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:num`; `l:num`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `!i. x(i):A = x(0)` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[cycle]] THEN MATCH_MP_TAC LOOP_COPRIME THEN EXISTS_TAC `p:num` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[cycle]; ALL_TAC] THEN EXISTS_TAC `l + (p - k):num` THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN ONCE_REWRITE_TAC[ARITH_RULE `i + l + pk = (i + pk) + l:num`] THEN ASSUM_LIST(REWRITE_TAC o map GSYM) THEN SIMP_TAC[ARITH_RULE `k < p ==> (i + p - k) + k = i + p:num`; ASSUME `k < p:num`] THEN ASM_MESON_TAC[cycle]; ALL_TAC] THEN SUBGOAL_THEN `l + p - k = p + l - k:num` SUBST1_TAC THENL [MAP_EVERY UNDISCH_TAC [`k < p:num`; `k <= l:num`] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NUMBER_RULE `coprime(p,p + d) <=> coprime(d,p)`] THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The theorem itself. *) (* ------------------------------------------------------------------------- *) let FRIENDSHIP = prove (`!friend:person->person->bool. FINITE(:person) /\ (!x. ~(friend x x)) /\ (!x y. friend x y ==> friend y x) /\ (!x y. ~(x = y) ==> ?!z. friend x z /\ friend y z) ==> ?u. !v. ~(v = u) ==> friend u v`, REPEAT STRIP_TAC THEN UNDISCH_TAC `!x y:person. ~(x = y) ==> ?!z:person. friend x z /\ friend y z` THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM; RIGHT_IMP_FORALL_THM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `mutualfriend:person->person->person`) THEN SUBGOAL_THEN `!s:person->bool. FINITE s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_UNIV; FINITE_SUBSET]; ALL_TAC] THEN ABBREV_TAC `degree = \p:person. CARD {q:person | friend p q}` THEN SUBGOAL_THEN `!x y:person. ~(friend x y) ==> degree(x):num <= degree(y)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:person = y` THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN EXPAND_TAC "degree" THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (\u. (mutualfriend:person->person->person) u y) {q | friend (x:person) q})` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_SUBSET THEN ASM SET_TAC[]] THEN MATCH_MP_TAC EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`u1:person`; `u2:person`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:person`; `(mutualfriend:person->person->person) u1 y`; `u1:person`; `u2:person`]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x y:person. ~(friend x y) ==> degree x:num = degree y` ASSUME_TAC THENL [ASM_MESON_TAC[LE_ANTISYM]; ALL_TAC] THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN GEN_REWRITE_TAC RAND_CONV [NOT_EXISTS_THM] THEN DISCH_THEN(ASSUME_TAC o REWRITE_RULE[NOT_FORALL_THM; NOT_IMP]) THEN SUBGOAL_THEN `?m:num. !x:person. degree(x) = m` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(X_CHOOSE_THEN `b:person` STRIP_ASSUME_TAC o SPEC `a:person`) THEN ABBREV_TAC `c = (mutualfriend:person->person->person) a b` THEN ABBREV_TAC `k = (degree:person->num) a` THEN EXISTS_TAC `k:num` THEN SUBGOAL_THEN `(degree:person->num)(b) = k /\ ~(friend a b) /\ friend a c /\ friend b c` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:person. ~(x = c) ==> degree x = (k:num)` ASSUME_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!p:person. {q:person | friend p q} HAS_SIZE m` ASSUME_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN SUBGOAL_THEN `~(m = 0)` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `!p:person. {q:person | friend p q} HAS_SIZE m` THEN ASM_REWRITE_TAC[HAS_SIZE_0; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `EVEN(m)` ASSUME_TAC THENL [UNDISCH_TAC `!x:person. degree x = (m:num)` THEN DISCH_THEN(SUBST1_TAC o SYM o SPEC `a:person`) THEN EXPAND_TAC "degree" THEN MATCH_MP_TAC ELEMENTS_PAIR_UP THEN EXISTS_TAC `\x y:person. friend a x /\ friend a y /\ friend x y` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN ABBREV_TAC `N = CARD(:person)` THEN SUBGOAL_THEN `N = m * (m - 1) + 1` ASSUME_TAC THENL [ABBREV_TAC `t = {q:person | friend (a:person) q}` THEN SUBGOAL_THEN `FINITE(t:person->bool) /\ CARD t = m` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN ABBREV_TAC `u = \b:person. {c:person | friend b c /\ ~(c IN (a INSERT t))}` THEN EXPAND_TAC "N" THEN SUBGOAL_THEN `(:person) = (a INSERT t) UNION UNIONS {u(b) | b IN t}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_UNIV; IN_UNION; IN_UNIONS] THEN MAP_EVERY EXPAND_TAC ["t"; "u"] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:person` THEN MATCH_MP_TAC(TAUT `(~a /\ ~b ==> c) ==> (a \/ b) \/ c`) THEN STRIP_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[IN_ELIM_THM; IN_INSERT; DE_MORGAN_THM] THEN EXISTS_TAC `mutualfriend (a:person) (x:person) :person` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `m * (m - 1) + 1 = (m + 1) + m * (m - 2)` SUBST1_TAC THENL [SIMP_TAC[ARITH_RULE `a + 1 = (m + 1) + m * c <=> a = m * (1 + c)`] THEN AP_TERM_TAC THEN UNDISCH_TAC `EVEN m` THEN ASM_CASES_TAC `m = 1` THEN ASM_REWRITE_TAC[ARITH] THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC [`~(m = 0)`; `~(m = 1)`] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `m + 1 = CARD((a:person) INSERT t)` SUBST1_TAC THENL [ASM_SIMP_TAC[CARD_CLAUSES; ADD1] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `UNIONS {u b :person->bool | (b:person) IN t} HAS_SIZE m * (m - 2)` MP_TAC THENL [MATCH_MP_TAC HAS_SIZE_UNIONS THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "u" THEN REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER] THEN REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM; IN_INSERT] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]] THEN REPEAT STRIP_TAC THEN MP_TAC(ASSUME `(b:person) IN t`) THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `u (b:person) = {q:person | friend q b} DELETE a DELETE (mutualfriend a b)` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["u"; "t"] THEN REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_ELIM_THM] THEN X_GEN_TAC `x:person` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:person`; `b:person`; `(mutualfriend:person->person->person) a b`; `x:person`]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_DELETE; HAS_SIZE] THEN REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SUBGOAL_THEN `{q:person | friend q (b:person)} = {q | friend b q}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `m - 1 - 1 = m - 2`] THEN ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN MATCH_MP_TAC CARD_UNION THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_INSERT; IN_INTER; NOT_IN_EMPTY; IN_UNIONS] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN MAP_EVERY EXPAND_TAC ["u"; "t"] THEN REWRITE_TAC[IN_ELIM_THM; IN_INSERT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(m = 2)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN SUBGOAL_THEN `(:person) HAS_SIZE 3` MP_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:person`; `b:person`; `c:person`] THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN UNDISCH_TAC `!u:person. ?v:person. ~(v = u) /\ ~friend u v` THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM] THEN EXISTS_TAC `a:person` THEN UNDISCH_TAC `!p:person. {q:person | friend p q} HAS_SIZE 2` THEN DISCH_THEN(MP_TAC o SPEC `a:person`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:person`; `y:person`] THEN STRIP_TAC THEN X_GEN_TAC `z:person` THEN UNDISCH_TAC `!x:person. x = a \/ x = b \/ x = c` THEN DISCH_THEN(fun th -> MAP_EVERY (fun x -> MP_TAC(SPEC x th)) [`x:person`; `y:person`; `z:person`]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `m - 1` PRIME_FACTOR) THEN ANTS_TAC THENL [UNDISCH_TAC `~(m = 2)` THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(p divides 1)` MP_TAC THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN REWRITE_TAC[] THEN MATCH_MP_TAC(NUMBER_RULE `!x. p divides (x + 1) /\ p divides x ==> p divides 1`) THEN EXISTS_TAC `m - 1` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ARITH_RULE `~(m = 0) ==> m - 1 + 1 = m`] THEN MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `p - 2` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NUMBER_RULE `!q c K1 K2. p divides q /\ p divides c /\ c = (q + 1) * K1 + K2 /\ K1 + K2 = ((q + 1) * q + 1) * nep2 ==> p divides nep2`) THEN MAP_EVERY EXISTS_TAC [`m - 1`; `CARD {x:num->person | cycle friend p x}`; `CARD {x:num->person | path friend (p-2) x /\ x (p-2) = x 0}`; `CARD {x:num->person | path friend (p-2) x /\ ~(x (p-2) = x 0)}`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CYCLES_PRIME_LEMMA THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `3 <= p` ASSUME_TAC THENL [MATCH_MP_TAC(ARITH_RULE `2 <= p /\ ~(p = 2) ==> 3 <= p`) THEN ASM_SIMP_TAC[PRIME_GE_2] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM DIVIDES_2]) THEN MP_TAC(DIVIDES_CONV `2 divides 1`) THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(NUMBER_RULE `!q. t divides q /\ m = q + 1 ==> t divides m ==> t divides w`) THEN EXISTS_TAC `m - 1` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `~(m = 0) ==> m - 1 + 1 = m`] THEN CONJ_TAC THENL [MP_TAC(ISPECL[`friend:person->person->bool`; `p:num`] HAS_SIZE_CYCLES) THEN ANTS_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN SIMP_TAC[HAS_SIZE] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC HAS_SIZE_CARD THEN SUBGOAL_THEN `p = (p - 2) + 2` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_MESON_TAC[PRIME_GE_2; SUB_ADD]; ALL_TAC] THEN MATCH_MP_TAC CARD_PATHCYCLES_STEP THEN EXISTS_TAC `N:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN UNDISCH_TAC `3 <= p` THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`N:num`; `m:num`; `friend:person->person->bool`; `p - 2`] HAS_SIZE_PATHS) THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN ASM_REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[FINITE_PATHS] THEN SET_TAC[]);; hol-light/100/fta.ml000066400000000000000000000202341303454263000143520ustar00rootroot00000000000000(* ========================================================================= *) (* The fundamental theorem of arithmetic (unique prime factorization). *) (* ========================================================================= *) needs "Library/prime.ml";; prioritize_num();; (* ------------------------------------------------------------------------- *) (* Definition of iterated product. *) (* ------------------------------------------------------------------------- *) let nproduct = new_definition `nproduct = iterate ( * )`;; let NPRODUCT_CLAUSES = prove (`(!f. nproduct {} f = 1) /\ (!x f s. FINITE(s) ==> (nproduct (x INSERT s) f = if x IN s then nproduct s f else f(x) * nproduct s f))`, REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; let NPRODUCT_EQ_1_EQ = prove (`!s f. FINITE s ==> (nproduct s f = 1 <=> !x. x IN s ==> f(x) = 1)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[NPRODUCT_CLAUSES; IN_INSERT; MULT_EQ_1; NOT_IN_EMPTY] THEN ASM_MESON_TAC[]);; let NPRODUCT_SPLITOFF = prove (`!x:A f s. FINITE s ==> nproduct s f = (if x IN s then f(x) else 1) * nproduct (s DELETE x) f`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[MULT_CLAUSES; SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN SUBGOAL_THEN `s = (x:A) INSERT (s DELETE x)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [th] THEN ASM_SIMP_TAC[NPRODUCT_CLAUSES; FINITE_DELETE; IN_DELETE]) THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]);; let NPRODUCT_SPLITOFF_HACK = prove (`!x:A f s. nproduct s f = if FINITE s then (if x IN s then f(x) else 1) * nproduct (s DELETE x) f else nproduct s f`, REPEAT STRIP_TAC THEN MESON_TAC[NPRODUCT_SPLITOFF]);; let NPRODUCT_EQ = prove (`!f g s. FINITE s /\ (!x. x IN s ==> f x = g x) ==> nproduct s f = nproduct s g`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; IN_INSERT]);; let NPRODUCT_EQ_GEN = prove (`!f g s t. FINITE s /\ s = t /\ (!x. x IN s ==> f x = g x) ==> nproduct s f = nproduct t g`, MESON_TAC[NPRODUCT_EQ]);; let PRIME_DIVIDES_NPRODUCT = prove (`!p s f. prime p /\ FINITE s /\ p divides (nproduct s f) ==> ?x. x IN s /\ p divides (f x)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[PRIME_DIVPROD; DIVIDES_ONE; PRIME_1]);; let NPRODUCT_CANCEL_PRIME = prove (`!s p m f j. p EXP j * nproduct (s DELETE p) (\p. p EXP (f p)) = p * m ==> prime p /\ FINITE s /\ (!x. x IN s ==> prime x) ==> ~(j = 0) /\ p EXP (j - 1) * nproduct (s DELETE p) (\p. p EXP (f p)) = m`, REPEAT GEN_TAC THEN ASM_CASES_TAC `j = 0` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(j = 0) ==> j = SUC(j - 1)`)) THEN REWRITE_TAC[SUC_SUB1; EXP; GSYM MULT_ASSOC; EQ_MULT_LCANCEL] THEN MESON_TAC[PRIME_0]] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[EXP; MULT_CLAUSES] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:num`; `s DELETE (p:num)`; `\p. p EXP (f p)`] PRIME_DIVIDES_NPRODUCT) THEN ANTS_TAC THENL [ASM_MESON_TAC[divides; FINITE_DELETE]; ALL_TAC] THEN REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[PRIME_1; prime; PRIME_DIVEXP]);; (* ------------------------------------------------------------------------- *) (* Fundamental Theorem of Arithmetic. *) (* ------------------------------------------------------------------------- *) let FTA = prove (`!n. ~(n = 0) ==> ?!i. FINITE {p | ~(i p = 0)} /\ (!p. ~(i p = 0) ==> prime p) /\ n = nproduct {p | ~(i p = 0)} (\p. p EXP (i p))`, ONCE_REWRITE_TAC[ARITH_RULE `n = nproduct s f <=> nproduct s f = n`] THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN ASM_CASES_TAC `n = 1` THENL [ASM_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN SIMP_TAC[NPRODUCT_EQ_1_EQ; EXP_EQ_1; IN_ELIM_THM] THEN REWRITE_TAC[FUN_EQ_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [EXISTS_TAC `\n:num. 0` THEN REWRITE_TAC[SET_RULE `{p | F} = {}`; FINITE_RULES]; REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `q:num` THEN ASM_CASES_TAC `q = 1` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PRIME_1]]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN REWRITE_TAC[divides; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:num`; `m:num`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ANTS_TAC THENL [ASM_MESON_TAC[PRIME_FACTOR_LT]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `i:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\q:num. if q = p then i(q) + 1 else i(q)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `p INSERT {p:num | ~(i p = 0)}` THEN ASM_SIMP_TAC[SUBSET; FINITE_INSERT; IN_INSERT; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN CONJ_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN MP_TAC(ISPEC `p:num` NPRODUCT_SPLITOFF_HACK) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; ADD_EQ_0; ARITH] THEN REWRITE_TAC[MULT_ASSOC] THEN BINOP_TAC THENL [ASM_CASES_TAC `(i:num->num) p = 0` THEN ASM_REWRITE_TAC[EXP_ADD; EXP_1; EXP; MULT_AC]; ALL_TAC] THEN MATCH_MP_TAC NPRODUCT_EQ_GEN THEN RULE_ASSUM_TAC(SIMP_RULE[]) THEN ASM_SIMP_TAC[FINITE_DELETE; IN_DELETE; EXTENSION; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[ADD_EQ_0; ARITH] THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `p:num` NPRODUCT_SPLITOFF_HACK) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[TAUT `p /\ q /\ ((if p then x else y) = z) <=> p /\ q /\ x = z`] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[MESON[EXP] `(if ~(x = 0) then p EXP x else 1) = p EXP x`] THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`j:num->num`; `k:num->num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\i:num. if i = p then j(i) - 1 else j(i)`; `\i:num. if i = p then k(i) - 1 else k(i)`]) THEN REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP NPRODUCT_CANCEL_PRIME)) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `!j k. {q | ~((if q = p then j q else k q) = 0)} DELETE p = {q | ~(k q = 0)} DELETE p`] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`~(j(p:num) = 0)`; `~(k(p:num) = 0)`] THEN ARITH_TAC] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p:num | ~(j p = 0)}` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; ASM_MESON_TAC[SUB_0]; FIRST_X_ASSUM(fun th -> SUBST1_TAC(SYM th) THEN AP_TERM_TAC) THEN MATCH_MP_TAC NPRODUCT_EQ_GEN THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN SIMP_TAC[IN_DELETE; IN_ELIM_THM]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p:num | ~(k p = 0)}` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; ASM_MESON_TAC[SUB_0]; FIRST_X_ASSUM(fun th -> SUBST1_TAC(SYM th) THEN AP_TERM_TAC) THEN MATCH_MP_TAC NPRODUCT_EQ_GEN THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN SIMP_TAC[IN_DELETE; IN_ELIM_THM]]);; hol-light/100/gcd.ml000066400000000000000000000034131303454263000143350ustar00rootroot00000000000000(* ========================================================================= *) (* Euclidean GCD algorithm. *) (* ========================================================================= *) needs "Library/prime.ml";; let egcd = define `egcd(m,n) = if m = 0 then n else if n = 0 then m else if m <= n then egcd(m,n - m) else egcd(m - n,n)`;; (* ------------------------------------------------------------------------- *) (* Main theorems. *) (* ------------------------------------------------------------------------- *) let EGCD_INVARIANT = prove (`!m n d. d divides egcd(m,n) <=> d divides m /\ d divides n`, GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `m + n` THEN GEN_TAC THEN ONCE_REWRITE_TAC[egcd] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THEN COND_CASES_TAC THEN (W(fun (asl,w) -> FIRST_X_ASSUM(fun th -> MP_TAC(PART_MATCH (lhs o snd o dest_forall o rand) th (lhand w)))) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN ASM_MESON_TAC[DIVIDES_SUB; DIVIDES_ADD; SUB_ADD; LE_CASES]);; (* ------------------------------------------------------------------------- *) (* Hence we get the proper behaviour, and it's equal to the real GCD. *) (* ------------------------------------------------------------------------- *) let EGCD_GCD = prove (`!m n. egcd(m,n) = gcd(m,n)`, ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN MESON_TAC[EGCD_INVARIANT; DIVIDES_REFL]);; let EGCD = prove (`!a b. (egcd (a,b) divides a /\ egcd (a,b) divides b) /\ (!e. e divides a /\ e divides b ==> e divides egcd (a,b))`, REWRITE_TAC[EGCD_GCD; GCD]);; hol-light/100/heron.ml000066400000000000000000000034601303454263000147150ustar00rootroot00000000000000(* ========================================================================= *) (* Heron's formula for the area of a triangle. *) (* ========================================================================= *) needs "Multivariate/measure.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Eliminate square roots from formula by the usual method. *) (* ------------------------------------------------------------------------- *) let SQRT_ELIM_TAC = let sqrt_tm = `sqrt:real->real` in let is_sqrt tm = is_comb tm && rator tm = sqrt_tm in fun (asl,w) -> let stms = setify(find_terms is_sqrt w) in let gvs = map (genvar o type_of) stms in (MAP_EVERY (MP_TAC o C SPEC SQRT_POW_2 o rand) stms THEN EVERY (map2 (fun s v -> SPEC_TAC(s,v)) stms gvs)) (asl,w);; (* ------------------------------------------------------------------------- *) (* Main result. *) (* ------------------------------------------------------------------------- *) let HERON = prove (`!A B C:real^2. let a = dist(C,B) and b = dist(A,C) and c = dist(B,A) in let s = (a + b + c) / &2 in measure(convex hull {A,B,C}) = sqrt(s * (s - a) * (s - b) * (s - c))`, REPEAT GEN_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN REWRITE_TAC[MEASURE_TRIANGLE] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_UNIQUE THEN SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS; REAL_POS] THEN REWRITE_TAC[REAL_POW_DIV; REAL_POW2_ABS] THEN REWRITE_TAC[dist; vector_norm] THEN REWRITE_TAC[dot; SUM_2; DIMINDEX_2] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; ARITH; DIMINDEX_2] THEN SQRT_ELIM_TAC THEN SIMP_TAC[REAL_LE_SQUARE; REAL_LE_ADD] THEN CONV_TAC REAL_RING);; hol-light/100/inclusion_exclusion.ml000066400000000000000000000514341303454263000177020ustar00rootroot00000000000000(* ========================================================================= *) (* Inclusion-exclusion principle, the usual and generalized forms. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Simple set theory lemmas. *) (* ------------------------------------------------------------------------- *) let SUBSET_INSERT_EXISTS = prove (`!s x:A t. s SUBSET (x INSERT t) <=> s SUBSET t \/ ?u. u SUBSET t /\ s = x INSERT u`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC(TAUT `(a /\ ~b ==> c) ==> a ==> b \/ c`) THEN DISCH_TAC THEN EXISTS_TAC `s DELETE (x:A)` THEN ASM SET_TAC[]);; let FINITE_SUBSETS_RESTRICT = prove (`!s:A->bool p. FINITE s ==> FINITE {t | t SUBSET s /\ p t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{t:A->bool | t SUBSET s}` THEN ASM_SIMP_TAC[FINITE_POWERSET] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Versions for additive real functions, where the additivity applies only *) (* to some specific subsets (e.g. cardinality of finite sets, measurable *) (* sets with bounded measure). *) (* ------------------------------------------------------------------------- *) let INCLUSION_EXCLUSION_REAL_RESTRICTED_INDEXED = prove (`!P (f:(A->bool)->real) (A:I->bool) (x:I->(A->bool)). (!s t. P s /\ P t /\ DISJOINT s t ==> f(s UNION t) = f(s) + f(t)) /\ P {} /\ (!s t. P s /\ P t ==> P(s INTER t) /\ P(s UNION t) /\ P(s DIFF t)) /\ FINITE A /\ (!a. a IN A ==> P(x a)) ==> f(UNIONS(IMAGE x A)) = sum {B | B SUBSET A /\ ~(B = {})} (\B. (-- &1) pow (CARD B + 1) * f(INTERS(IMAGE x B)))`, let lemma = prove (`{t | t SUBSET (a INSERT s) /\ P t} = {t | t SUBSET s /\ P t} UNION {a INSERT t |t| t SUBSET s /\ P(a INSERT t)}`, REWRITE_TAC[SUBSET_INSERT_EXISTS] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]) in REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[HAS_SIZE] `(!n s. s HAS_SIZE n ==> P s) ==> (!s. FINITE s ==> P s)`) THEN MATCH_MP_TAC num_WF THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[HAS_SIZE_CLAUSES; LEFT_IMP_EXISTS_THM] THEN CONJ_TAC THENL [DISCH_THEN(K ALL_TAC) THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; TAUT `~(p /\ ~p)`] THEN ASM_REWRITE_TAC[EMPTY_GSPEC; SUM_CLAUSES] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`{}:A->bool`; `{}:A->bool`])) THEN ASM_SIMP_TAC[UNION_EMPTY; DISJOINT_EMPTY] THEN REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A0:I->bool`; `a:I`; `A:I->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `x:I->A->bool` THEN REWRITE_TAC[FORALL_IN_INSERT] THEN STRIP_TAC THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(f(x a) + f(UNIONS (IMAGE (x:I->(A->bool)) A))) - f(x a INTER UNIONS (IMAGE x A)):real` THEN CONJ_TAC THENL [SUBGOAL_THEN `P(x a) /\ P(UNIONS(IMAGE (x:I->(A->bool)) A))` MP_TAC THENL [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `!b. b IN A ==> P((x:I->(A->bool)) b)` THEN SUBGOAL_THEN `FINITE(A:I->bool)` MP_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN SPEC_TAC(`A:I->bool`,`u:I->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[IMAGE_CLAUSES; UNIONS_0; UNIONS_INSERT; FORALL_IN_INSERT]; SPEC_TAC(`UNIONS(IMAGE (x:I->(A->bool)) A)`,`t:A->bool`) THEN SPEC_TAC(`(x:I->(A->bool)) a`,`s:A->bool`) THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `!s t:A->bool. P s /\ P t /\ DISJOINT s t ==> f(s UNION t):real = f(s) + f(t)` THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`s INTER t:A->bool`; `t DIFF s:A->bool`] th) THEN MP_TAC(ISPECL [`s:A->bool`; `t DIFF s:A->bool`] th)) THEN ASM_SIMP_TAC[SET_RULE `s UNION (t DIFF s) = s UNION t`; SET_RULE `(s INTER t) UNION (t DIFF s) = t`] THEN REPEAT(ANTS_TAC THENL [SET_TAC[]; DISCH_TAC]) THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[INTER_UNIONS; SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[LT] THEN DISCH_THEN(MP_TAC o SPEC `A:I->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `\s. (x:I->(A->bool)) a INTER x s` th) THEN MP_TAC(ISPEC `x:I->(A->bool)` th)) THEN ASM_SIMP_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [HAS_SIZE]) THEN REWRITE_TAC[lemma] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_UNION o rand o snd) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT; FINITE_IMAGE] THEN REWRITE_TAC[GSYM SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IN_DISJOINT; EXISTS_IN_GSPEC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[NOT_INSERT_EMPTY; REAL_ARITH `(fa + s) - fas:real = s + s' <=> fa - fas = s'`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `f((x:I->(A->bool)) a) + sum {B | B SUBSET A /\ ~(B = {})} (\B. --(&1) pow (CARD B) * f(INTERS(IMAGE x (a INSERT B))))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `x - a:real = x + b <=> b = --a`] THEN REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IMAGE_CLAUSES; INTERS_INSERT; o_DEF; FORALL_IN_GSPEC] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; REWRITE_TAC[SET_RULE `{s | P s /\ ~(s = e)} = {s | P s} DELETE e`] THEN ASM_SIMP_TAC[SUM_DELETE_CASES; GSYM DELETE; FINITE_POWERSET] THEN REWRITE_TAC[IN_ELIM_THM; EMPTY_SUBSET; IMAGE_CLAUSES] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SIMPLE_IMAGE_GEN] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[o_DEF; INTERS_1; CARD_CLAUSES; real_pow; REAL_MUL_LID] THEN REWRITE_TAC[REAL_SUB_ADD2] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC; REAL_POW_ADD; REAL_POW_1] THEN X_GEN_TAC `B:I->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `FINITE(B:I->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_CLAUSES; REAL_POW_ADD; real_pow] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMAGE_CLAUSES; real_pow] THEN REAL_ARITH_TAC]);; let INCLUSION_EXCLUSION_REAL_RESTRICTED = prove (`!P (f:(A->bool)->real) (A:(A->bool)->bool). (!s t. P s /\ P t /\ DISJOINT s t ==> f(s UNION t) = f(s) + f(t)) /\ P {} /\ (!s t. P s /\ P t ==> P(s INTER t) /\ P(s UNION t) /\ P(s DIFF t)) /\ FINITE A /\ (!a. a IN A ==> P(a)) ==> f(UNIONS A) = sum {B | B SUBSET A /\ ~(B = {})} (\B. (-- &1) pow (CARD B + 1) * f(INTERS B))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`P:(A->bool)->bool`; `f:(A->bool)->real`; `A:(A->bool)->bool`; `\x:A->bool. x`] INCLUSION_EXCLUSION_REAL_RESTRICTED_INDEXED) THEN ASM_REWRITE_TAC[IMAGE_ID]);; (* ------------------------------------------------------------------------- *) (* Versions for unrestrictedly additive functions. *) (* ------------------------------------------------------------------------- *) let INCLUSION_EXCLUSION_REAL_INDEXED = prove (`!(f:(A->bool)->real) (A:I->bool) (x:I->(A->bool)). (!s t. DISJOINT s t ==> f(s UNION t) = f(s) + f(t)) /\ FINITE A ==> f(UNIONS(IMAGE x A)) = sum {B | B SUBSET A /\ ~(B = {})} (\B. (-- &1) pow (CARD B + 1) * f(INTERS(IMAGE x B)))`, MP_TAC(ISPEC `\x:A->bool. T` INCLUSION_EXCLUSION_REAL_RESTRICTED_INDEXED) THEN REWRITE_TAC[]);; let INCLUSION_EXCLUSION_REAL = prove (`!(f:(A->bool)->real) (A:(A->bool)->bool). (!s t. DISJOINT s t ==> f(s UNION t) = f(s) + f(t)) /\ FINITE A ==> f(UNIONS A) = sum {B | B SUBSET A /\ ~(B = {})} (\B. (-- &1) pow (CARD B + 1) * f(INTERS B))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:(A->bool)->real`; `A:(A->bool)->bool`; `\x:A->bool. x`] INCLUSION_EXCLUSION_REAL_INDEXED) THEN ASM_REWRITE_TAC[IMAGE_ID]);; (* ------------------------------------------------------------------------- *) (* Special case of cardinality, the most common case. *) (* ------------------------------------------------------------------------- *) let INCLUSION_EXCLUSION = prove (`!s:(A->bool)->bool. FINITE s /\ (!k. k IN s ==> FINITE k) ==> &(CARD(UNIONS s)) = sum {t | t SUBSET s /\ ~(t = {})} (\t. (-- &1) pow (CARD t + 1) * &(CARD(INTERS t)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\s:A->bool. FINITE s`; `\s:A->bool. &(CARD s)`; `s:(A->bool)->bool`] INCLUSION_EXCLUSION_REAL_RESTRICTED) THEN ASM_SIMP_TAC[FINITE_INTER; FINITE_UNION; FINITE_DIFF; FINITE_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[CARD_UNION; DISJOINT; REAL_OF_NUM_ADD]);; (* ------------------------------------------------------------------------- *) (* A more conventional form. *) (* ------------------------------------------------------------------------- *) let INCLUSION_EXCLUSION_USUAL = prove (`!s:(A->bool)->bool. FINITE s /\ (!k. k IN s ==> FINITE k) ==> &(CARD(UNIONS s)) = sum (1..CARD s) (\n. (-- &1) pow (n + 1) * sum {t | t SUBSET s /\ t HAS_SIZE n} (\t. &(CARD(INTERS t))))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INCLUSION_EXCLUSION] THEN W(MP_TAC o PART_MATCH (lhs o rand) (ISPEC `CARD` SUM_IMAGE_GEN) o lhand o snd) THEN ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(MESON[] `s = t /\ sum t f = sum t g ==> sum s f = sum t g`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG; IN_ELIM_THM] THEN REWRITE_TAC[ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN ASM_MESON_TAC[CHOOSE_SUBSET; CARD_SUBSET; FINITE_SUBSET; CARD_EQ_0; HAS_SIZE]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[IN_ELIM_THM; HAS_SIZE] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[CARD_EQ_0; ARITH_RULE `~(1 <= 0)`; FINITE_SUBSET]);; (* ------------------------------------------------------------------------- *) (* A combinatorial lemma about subsets of a finite set. *) (* ------------------------------------------------------------------------- *) let FINITE_SUBSETS_RESTRICT = prove (`!s:A->bool p. FINITE s ==> FINITE {t | t SUBSET s /\ p t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{t:A->bool | t SUBSET s}` THEN ASM_SIMP_TAC[FINITE_POWERSET] THEN SET_TAC[]);; let CARD_ADJUST_LEMMA = prove (`!f:A->B s x y. FINITE s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ x = y + CARD (IMAGE f s) ==> x = y + CARD s`, MESON_TAC[CARD_IMAGE_INJ]);; let CARD_SUBSETS_STEP = prove (`!x:A s. FINITE s /\ ~(x IN s) /\ u SUBSET s ==> CARD {t | t SUBSET (x INSERT s) /\ u SUBSET t /\ ODD(CARD t)} = CARD {t | t SUBSET s /\ u SUBSET t /\ ODD(CARD t)} + CARD {t | t SUBSET s /\ u SUBSET t /\ EVEN(CARD t)} /\ CARD {t | t SUBSET (x INSERT s) /\ u SUBSET t /\ EVEN(CARD t)} = CARD {t | t SUBSET s /\ u SUBSET t /\ EVEN(CARD t)} + CARD {t | t SUBSET s /\ u SUBSET t /\ ODD(CARD t)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE[`:A`,`:B`] CARD_ADJUST_LEMMA) THEN EXISTS_TAC `\u. (x:A) INSERT u` THEN ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT; FINITE_INSERT] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER] THEN REWRITE_TAC[TAUT `~(a /\ b) <=> b ==> ~a`; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `t:A->bool` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION; SUBSET_INSERT_EXISTS] THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[RIGHT_OR_DISTRIB; LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `v:A->bool` THEN ASM_CASES_TAC `t = (x:A) INSERT v` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(v:A->bool) SUBSET s` THEN ASM_REWRITE_TAC[] THEN BINOP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[CARD_CLAUSES; EVEN; NOT_ODD; FINITE_SUBSET; SUBSET] THEN ASM_MESON_TAC[CARD_CLAUSES; EVEN; NOT_ODD; FINITE_SUBSET; SUBSET]));; let CARD_SUBSUPERSETS_EVEN_ODD = prove (`!s u:A->bool. FINITE u /\ s PSUBSET u ==> CARD {t | s SUBSET t /\ t SUBSET u /\ EVEN(CARD t)} = CARD {t | s SUBSET t /\ t SUBSET u /\ ODD(CARD t)}`, ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(u:A->bool)` THEN REWRITE_TAC[PSUBSET_MEMBER] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`)) THEN MP_TAC(SET_RULE `~((x:A) IN (u DELETE x))`) THEN ABBREV_TAC `v:A->bool = u DELETE x` THEN STRIP_TAC THEN SUBGOAL_THEN `FINITE v /\ (s:A->bool) SUBSET v` STRIP_ASSUME_TAC THENL [ASM SET_TAC[FINITE_INSERT]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_SUBSETS_STEP] THEN ASM_CASES_TAC `s:A->bool = v` THENL [REWRITE_TAC[CONJ_ASSOC; SUBSET_ANTISYM_EQ] THEN MATCH_ACCEPT_TAC ADD_SYM; ASM_SIMP_TAC[CARD_CLAUSES; LT; PSUBSET]]);; let SUM_ALTERNATING_CANCELS = prove (`!s:A->bool f. FINITE s /\ CARD {x | x IN s /\ EVEN(f x)} = CARD {x | x IN s /\ ODD(f x)} ==> sum s (\x. (-- &1) pow (f x)) = &0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {x | x IN s /\ EVEN(f x)} (\x. (-- &1) pow (f x)) + sum {x:A | x IN s /\ ODD(f x)} (\x. (-- &1) pow (f x))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN ASM_SIMP_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNION; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_POW_NEG; REAL_POW_ONE; GSYM NOT_EVEN; SUM_CONST; FINITE_RESTRICT; REAL_ARITH `x * &1 + x * -- &1 = &0`]);; (* ------------------------------------------------------------------------- *) (* Hence a general "Moebius inversion" inclusion-exclusion principle. *) (* This "symmetric" form is from Ira Gessel: "Symmetric Inclusion-Exclusion" *) (* ------------------------------------------------------------------------- *) let INCLUSION_EXCLUSION_SYMMETRIC = prove (`!f g:(A->bool)->real. (!s. FINITE s ==> g(s) = sum {t | t SUBSET s} (\t. (-- &1) pow (CARD t) * f(t))) ==> !s. FINITE s ==> f(s) = sum {t | t SUBSET s} (\t. (-- &1) pow (CARD t) * g(t))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {t:A->bool | t SUBSET s} (\t. (-- &1) pow (CARD t) * sum {u | u IN {u | u SUBSET s} /\ u SUBSET t} (\u. (-- &1) pow (CARD u) * f(u)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; SET_RULE `s SUBSET t ==> (u SUBSET t /\ u SUBSET s <=> u SUBSET s)`] THEN ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_SUM_RESTRICT o lhs o snd) THEN ASM_SIMP_TAC[FINITE_POWERSET] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUM_RMUL; IN_ELIM_THM] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {u | u SUBSET s} (\u:A->bool. if u = s then f(s) else &0)` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUM_DELTA; IN_ELIM_THM; SUBSET_REFL]] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `u:A->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[SUBSET_ANTISYM_EQ; SET_RULE `{x | x = a} = {a}`] THEN REWRITE_TAC[SUM_SING; REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; REAL_POW_ONE; REAL_MUL_LID]; ALL_TAC] THEN REWRITE_TAC[REAL_ENTIRE] THEN REPEAT DISJ1_TAC THEN MATCH_MP_TAC SUM_ALTERNATING_CANCELS THEN ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN MATCH_MP_TAC CARD_SUBSUPERSETS_EVEN_ODD THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* The more typical non-symmetric version. *) (* ------------------------------------------------------------------------- *) let INCLUSION_EXCLUSION_MOBIUS = prove (`!f g:(A->bool)->real. (!s. FINITE s ==> g(s) = sum {t | t SUBSET s} f) ==> !s. FINITE s ==> f(s) = sum {t | t SUBSET s} (\t. (-- &1) pow (CARD s - CARD t) * g(t))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\t. -- &1 pow CARD(t:A->bool) * f t`; `g:(A->bool)->real`] INCLUSION_EXCLUSION_SYMMETRIC) THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN ANTS_TAC THENL [ASM_SIMP_TAC[EVEN_ADD; REAL_POW_ONE; REAL_POW_NEG; REAL_MUL_LID; ETA_AX]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `s:A->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `(*) ((-- &1) pow (CARD(s:A->bool)))`) THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD; GSYM MULT_2] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `u:A->bool` THEN REWRITE_TAC[IN_ELIM_THM; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_POW_SUB; REAL_ARITH `~(-- &1 = &0)`; CARD_SUBSET] THEN REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A related principle for real functions. *) (* ------------------------------------------------------------------------- *) (*** Not clear how useful this is needs "Library/products.ml";; let INCLUSION_EXCLUSION_REAL_FUNCTION = prove (`!f s:A->bool. FINITE s ==> product s (\x. &1 - f x) = sum {t | t SUBSET s} (\t. (-- &1) pow (CARD t) * product t f)`, let lemma = prove (`{t | ?u. u SUBSET s /\ t = x INSERT u} = IMAGE (\s. x INSERT s) {t | t SUBSET s}`, GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[]) in GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; SUBSET_EMPTY; SUM_SING; CARD_CLAUSES; real_pow; SET_RULE `{x | x = a} = {a}`; REAL_MUL_RID] THEN REWRITE_TAC[SUBSET_INSERT_EXISTS] THEN MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `{t | p t \/ q t} = {t | p t} UNION {t | q t}`] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_UNION o rand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_POWERSET; lemma; FINITE_IMAGE] THEN REWRITE_TAC[GSYM lemma] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_LMUL; REAL_SUB_RDISTRIB; REAL_MUL_LID; real_sub] THEN AP_TERM_TAC THEN REWRITE_TAC[lemma] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[o_THM; IN_ELIM_THM] THEN X_GEN_TAC `t:A->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `FINITE(t:A->bool) /\ ~(x IN t)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; FINITE_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[PRODUCT_CLAUSES; CARD_CLAUSES; real_pow] THEN REAL_ARITH_TAC);; ***) hol-light/100/independence.ml000066400000000000000000001212451303454263000162250ustar00rootroot00000000000000(* ========================================================================= *) (* Independence of the parallel postulate. The statement and some ideas are *) (* taken from Tim Makarios's MSc thesis "A mechanical verification of the *) (* independence of Tarski's Euclidean axiom". *) (* *) (* In the file Multivariate/tarski.ml it is shown that all 11 of Tarski's *) (* axioms for geometry hold for the Euclidean plane `:real^2`, with *) (* betweenness and congruence of segments as: *) (* *) (* B x y z <=> between y (x,z) *) (* ab == pq <=> dist(a,b) = dist(p,q) *) (* *) (* The present file shows that the Klein model of the hyperbolic plane (type *) (* `:plane`) satisfies all Tarski's axioms except that it satisfies the *) (* negation of the Euclidean axiom (10), with betweenness and congruence of *) (* segments as: *) (* *) (* B x y z <=> pbetween y (x,z) *) (* ab == pq <=> pdist(a,b) = pdist(p,q) *) (* *) (* Collectively, these two results show that the Euclidean axiom is *) (* independent of the others. For more references regarding Tarski's axioms *) (* for geometry see "http://en.wikipedia.org/wiki/Tarski's_axioms". *) (* ========================================================================= *) needs "Multivariate/tarski.ml";; needs "Multivariate/cauchy.ml";; (* ------------------------------------------------------------------------- *) (* The semimetric we will use, directly on real^N first. Choose a sensible *) (* default outside unit ball so some handy theorems become unconditional. *) (* ------------------------------------------------------------------------- *) let ddist = new_definition `ddist(x:real^N,y:real^N) = if norm(x) < &1 /\ norm(y) < &1 then (&1 - x dot y) pow 2 / ((&1 - norm(x) pow 2) * (&1 - norm(y) pow 2)) - &1 else dist(x,y)`;; let DDIST_INCREASES_ONLINE = prove (`!a b x:real^N. norm a < &1 /\ norm b < &1 /\ norm x < &1 /\ between x (a,b) /\ ~(x = b) ==> ddist(a,x) < ddist(a,b)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_MESON_TAC[BETWEEN_REFL_EQ]; ALL_TAC] THEN ASM_SIMP_TAC[ddist; real_div; REAL_INV_MUL] THEN SUBGOAL_THEN `norm(a:real^N) pow 2 < &1 /\ norm(b:real^N) pow 2 < &1 /\ norm(x:real^N) pow 2 < &1` MP_TAC THENL [ASM_SIMP_TAC[ABS_SQUARE_LT_1; REAL_ABS_NORM]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `a * inv x * inv b - &1 < c * inv x * d - &1 <=> (a / b) / x < (c * d) / x`] THEN SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * inv b) * c:real = (a * c) / b`] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN SUBGOAL_THEN `(a:real^N) dot b < &1 /\ (a:real^N) dot x < &1` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC(MESON[REAL_LET_TRANS; NORM_CAUCHY_SCHWARZ] `norm(x) * norm(y) < &1 ==> (x:real^N) dot y < &1`) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_IN_SEGMENT]) THEN REWRITE_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real` THEN ASM_CASES_TAC `u = &1` THEN ASM_SIMP_TAC[VECTOR_ARITH `(&1 - &1) % a + &1 % b:real^N = b`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[VECTOR_ARITH `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN ABBREV_TAC `c:real^N = b - a` THEN SUBGOAL_THEN `b:real^N = a + c` SUBST_ALL_TAC THENL [EXPAND_TAC "c" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(SIMP_RULE[VECTOR_ARITH `a + c:real^N = a <=> c = vec 0`]) THEN REWRITE_TAC[NORM_POW_2; VECTOR_ARITH `(a + b:real^N) dot (a + b) = a dot a + &2 * a dot b + b dot b`] THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN REWRITE_TAC[DOT_LMUL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(&1 - (a + x * b)) pow 2 * (&1 - (a + &2 * b + c)) < (&1 - (a + b)) pow 2 * (&1 - (a + &2 * x * b + x * x * c)) <=> &0 < (&1 - a - b * x) * ((&1 - a) * c + b pow 2) * (&1 - x) + (&1 - a - b) * ((&1 - a) * c + b pow 2) * (&1 - x) * x`] THEN MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC); REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC)] THEN TRY ASM_REAL_ARITH_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN MATCH_MP_TAC REAL_LTE_ADD THEN REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[DOT_POS_LT; REAL_SUB_LT]);; let DDIST_REFL = prove (`!x:real^N. ddist(x,x) = &0`, GEN_TAC THEN REWRITE_TAC[ddist; DIST_REFL; NORM_POW_2; NORM_LT_SQUARE] THEN CONV_TAC REAL_FIELD);; let DDIST_SYM = prove (`!x y:real^N. ddist(x,y) = ddist(y,x)`, REWRITE_TAC[ddist; CONJ_ACI; REAL_MUL_AC; DIST_SYM; DOT_SYM]);; let DDIST_POS_LT = prove (`!x y:real^N. ~(x = y) ==> &0 < ddist(x,y)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `norm(x:real^N) < &1 /\ norm(y:real^N) < &1` THENL [ASM_MESON_TAC[DDIST_INCREASES_ONLINE; DDIST_REFL; BETWEEN_REFL]; ASM_SIMP_TAC[ddist; DIST_POS_LT]]);; let DDIST_POS_LE = prove (`!x y:real^N. &0 <= ddist(x,y)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DDIST_REFL; DDIST_POS_LT; REAL_LE_LT]);; let DDIST_EQ_0 = prove (`!x y:real^N. ddist(x,y) = &0 <=> x = y`, MESON_TAC[DDIST_REFL; DDIST_POS_LT; REAL_LT_REFL]);; let BETWEEN_COLLINEAR_DDIST_EQ = prove (`!a b x:real^N. norm(a) < &1 /\ norm(b) < &1 /\ norm(x) < &1 ==> (between x (a,b) <=> collinear {a, x, b} /\ ddist(x,a) <= ddist (a,b) /\ ddist(x,b) <= ddist(a,b))`, REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL [SIMP_TAC[BETWEEN_IMP_COLLINEAR]; REWRITE_TAC[COLLINEAR_BETWEEN_CASES]] THEN ASM_MESON_TAC[DDIST_INCREASES_ONLINE; DDIST_SYM; REAL_LT_IMP_LE; REAL_LE_REFL; BETWEEN_SYM; REAL_NOT_LE; BETWEEN_REFL]);; let CONTINUOUS_AT_LIFT_DDIST = prove (`!a x:real^N. norm(a) < &1 /\ norm(x) < &1 ==> (\x. lift(ddist(a,x))) continuous at x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_AT THEN EXISTS_TAC `\x:real^N. lift((&1 - a dot x) pow 2 / ((&1 - norm a pow 2) * (&1 - norm x pow 2)) - &1)` THEN EXISTS_TAC `&1 - norm(x:real^N)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `dist(y,x) < &1 - norm x ==> norm y < &1`)) THEN ASM_SIMP_TAC[ddist]; REWRITE_TAC[LIFT_SUB; real_div; LIFT_CMUL; REAL_INV_MUL] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN SIMP_TAC[CONTINUOUS_CONST] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_MUL THEN CONJ_TAC) THEN SIMP_TAC[CONTINUOUS_CONST; o_DEF; REAL_POW_2; LIFT_CMUL] THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_MUL); MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV)] THEN ASM_SIMP_TAC[REAL_ARITH `x < &1 * &1 ==> ~(&1 - x = &0)`; REAL_LT_MUL2; NORM_POS_LE; LIFT_SUB] THEN SIMP_TAC[GSYM REAL_POW_2; NORM_POW_2; CONTINUOUS_CONST; CONTINUOUS_AT_ID; CONTINUOUS_SUB; CONTINUOUS_LIFT_DOT2]]);; let HYPERBOLIC_MIDPOINT = prove (`!a b:real^N. norm a < &1 /\ norm b < &1 ==> ?x. between x (a,b) /\ ddist(x,a) = ddist(x,b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. lift(ddist(x,a) - ddist(x,b))`; `segment[a:real^N,b]`] CONNECTED_CONTINUOUS_IMAGE) THEN ANTS_TAC THENL [REWRITE_TAC[CONNECTED_SEGMENT; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN ONCE_REWRITE_TAC[DDIST_SYM] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_LIFT_DDIST THEN ASM_MESON_TAC[BETWEEN_NORM_LT; BETWEEN_IN_SEGMENT]; REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; LIFT_DROP] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `lift(&0)`]) THEN ASM_SIMP_TAC[DDIST_REFL; LIFT_DROP; ENDS_IN_SEGMENT; IN_IMAGE] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_ARITH `&0 - x <= &0 <=> &0 <= x`] THEN ASM_SIMP_TAC[DDIST_POS_LE; LIFT_EQ; BETWEEN_IN_SEGMENT] THEN ASM_MESON_TAC[REAL_SUB_0; DDIST_SYM]]);; let DDIST_EQ_ORIGIN = prove (`!x:real^N y:real^N. norm x < &1 /\ norm y < &1 ==> (ddist(vec 0,x) = ddist(vec 0,y) <=> norm x = norm y)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ddist; NORM_0; REAL_LT_01] THEN REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_EQ_INV2; REAL_ARITH `x - &1 = y - &1 <=> x = y`] THEN REWRITE_TAC[REAL_ARITH `&1 - x = &1 - y <=> x = y`; GSYM REAL_EQ_SQUARE_ABS; REAL_ABS_NORM]);; let DDIST_CONGRUENT_TRIPLES_0 = prove (`!a b:real^N a' b':real^N. norm a < &1 /\ norm b < &1 /\ norm a' < &1 /\ norm b' < &1 ==> (ddist(vec 0,a) = ddist(vec 0,a') /\ ddist(a,b) = ddist(a',b') /\ ddist(b,vec 0) = ddist(b',vec 0) <=> dist(vec 0,a) = dist(vec 0,a') /\ dist(a,b) = dist(a',b') /\ dist(b,vec 0) = dist(b',vec 0))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DDIST_EQ_ORIGIN; REWRITE_RULE[DDIST_SYM] DDIST_EQ_ORIGIN] THEN REWRITE_TAC[DIST_0; NORM_0; REAL_LT_01] THEN MATCH_MP_TAC(TAUT `(a /\ b ==> (x <=> y)) ==> (a /\ x /\ b <=> a /\ y /\ b)`) THEN STRIP_TAC THEN ASM_SIMP_TAC[ddist; DIST_EQ; real_div; REAL_INV_MUL; REAL_RING `x * a * b - &1 = y * a * b - &1 <=> x = y \/ a = &0 \/ b = &0`] THEN REWRITE_TAC[dist; NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REWRITE_TAC[GSYM REAL_EQ_SQUARE_ABS; NORM_POW_2] THEN ASM_SIMP_TAC[REAL_INV_EQ_0; real_abs; REAL_SUB_LE; REAL_SUB_0] THEN ASM_SIMP_TAC[ABS_SQUARE_LT_1; REAL_ABS_NORM; REAL_LT_IMP_NE; REAL_LT_IMP_LE; MESON[NORM_CAUCHY_SCHWARZ; REAL_LET_TRANS; NORM_POS_LE; REAL_LT_MUL2; REAL_MUL_RID; REAL_LT_IMP_LE] `norm x < &1 /\ norm y < &1 ==> x dot y < &1`] THEN RULE_ASSUM_TAC(REWRITE_RULE[NORM_EQ]) THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Deduce existence of hyperbolic translations via the Poincare disc model. *) (* Use orthogonal projection onto a hemisphere touching the unit disc, *) (* then stereographic projection back from the other pole of the sphere plus *) (* scaling. See Greenberg's "Euclidean & Non-Euclidean Geometries" fig 7.13. *) (* ------------------------------------------------------------------------- *) let kleinify = new_definition `kleinify z = Cx(&2 / (&1 + norm(z) pow 2)) * z`;; let poincarify = new_definition `poincarify x = Cx((&1 - sqrt(&1 - norm(x) pow 2)) / norm(x) pow 2) * x`;; let KLEINIFY_0,POINCARIFY_0 = (CONJ_PAIR o prove) (`kleinify (Cx(&0)) = Cx(&0) /\ poincarify (Cx(&0)) = Cx(&0)`, REWRITE_TAC[kleinify; poincarify; COMPLEX_MUL_RZERO]);; let NORM_KLEINIFY = prove (`!z. norm(kleinify z) = (&2 * norm(z)) / (&1 + norm(z) pow 2)`, REWRITE_TAC[kleinify; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_DIV] THEN SIMP_TAC[REAL_LE_POW_2; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`] THEN REAL_ARITH_TAC);; let NORM_KLEINIFY_LT = prove (`!z. norm(kleinify z) < &1 <=> ~(norm z = &1)`, ASM_SIMP_TAC[NORM_KLEINIFY; REAL_LE_POW_2; REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_ARITH `&0 <= x ==> &0 < &1 + x`] THEN SIMP_TAC[REAL_ARITH `&2 * z < (&1 + z pow 2) <=> &0 < (z - &1) pow 2`] THEN REWRITE_TAC[REAL_POW_2; REAL_LT_SQUARE] THEN REAL_ARITH_TAC);; let NORM_POINCARIFY_LT = prove (`!x. norm(x) < &1 ==> norm(poincarify x) < &1`, REPEAT STRIP_TAC THEN REWRITE_TAC[poincarify; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `x * y <= &1 * y /\ y < &1 ==> x * y < &1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_POW] THEN ASM_CASES_TAC `x:real^2 = vec 0` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; REAL_POW_LT; NORM_0] THENL [REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LID]] THEN MATCH_MP_TAC(REAL_ARITH `s <= &1 /\ &1 - x <= s ==> abs(&1 - s) <= x`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LSQRT; MATCH_MP_TAC REAL_LE_RSQRT] THEN REWRITE_TAC[REAL_SUB_LE; REAL_POS; REAL_MUL_LID; REAL_POW_ONE] THEN ASM_SIMP_TAC[REAL_ARITH `(&1 - x) pow 2 <= &1 - x <=> &0 <= x * (&1 - x)`; REAL_ARITH `&1 - x <= &1 <=> &0 <= x`; REAL_LE_MUL; REAL_POW_LE; REAL_SUB_LE; ABS_SQUARE_LE_1; REAL_LT_IMP_LE; REAL_ABS_NORM; NORM_POS_LE]);; let KLEINIFY_POINCARIFY = prove (`!x. norm(x) < &1 ==> kleinify(poincarify x) = x`, REPEAT STRIP_TAC THEN REWRITE_TAC[kleinify; poincarify] THEN MATCH_MP_TAC (COMPLEX_RING `(~(x = Cx(&0)) ==> w * z = Cx(&1)) ==> w * z * x = x`) THEN DISCH_TAC THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_POW] THEN ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD `~(y = &0) ==> (&1 + (a / y pow 2 * y) pow 2) = (y pow 2 + a pow 2) / y pow 2`] THEN REWRITE_TAC[REAL_POW2_ABS; real_div; REAL_INV_MUL; REAL_INV_INV] THEN ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD `~(y = &0) ==> (&2 * x * y pow 2) * z * inv(y pow 2) = &2 * x * z`] THEN MATCH_MP_TAC(REAL_FIELD `&0 < y /\ &2 * y = x ==> &2 * inv(x) * y = &1`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LT_LSQRT THEN REWRITE_TAC[REAL_POS; REAL_ARITH `&1 - x < &1 pow 2 <=> &0 < x`] THEN ASM_SIMP_TAC[REAL_POW_LT; COMPLEX_NORM_NZ]; SUBGOAL_THEN `sqrt(&1 - norm(x:real^2) pow 2) pow 2 = &1 - norm x pow 2` MP_TAC THENL [MATCH_MP_TAC SQRT_POW_2; CONV_TAC REAL_FIELD]] THEN ASM_SIMP_TAC[REAL_SUB_LE; ABS_SQUARE_LE_1; REAL_ABS_NORM; REAL_LT_IMP_LE]);; let POINCARIFY_KLEINIFY = prove (`!x. norm(x) < &1 ==> poincarify(kleinify x) = x`, REPEAT STRIP_TAC THEN REWRITE_TAC[kleinify; poincarify] THEN MATCH_MP_TAC(COMPLEX_RING `(~(x = Cx(&0)) ==> w * z = Cx(&1)) ==> w * z * x = x`) THEN DISCH_TAC THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; GSYM REAL_MUL_ASSOC; REAL_INV_POW; REAL_POW_MUL] THEN MATCH_MP_TAC(REAL_FIELD `~(c = &0) /\ abs d < &1 /\ a * b = &2 * c pow 2 * (&1 + d) ==> a * inv(&2) pow 2 * b * inv(c) pow 2 * &2 * inv(&1 + d) = &1`) THEN ASM_REWRITE_TAC[REAL_ABS_POW; COMPLEX_NORM_ZERO; ABS_SQUARE_LT_1] THEN ASM_SIMP_TAC[REAL_ABS_NORM; REAL_POW_LE; NORM_POS_LE; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`] THEN MATCH_MP_TAC(REAL_FIELD `~(x = &0) /\ abs x < &1 /\ a = &2 * x / (&1 + x) ==> a * (&1 + x) pow 2 = &2 * x * (&1 + x)`) THEN ASM_REWRITE_TAC[REAL_ABS_NORM; COMPLEX_NORM_ZERO; REAL_ABS_POW; ABS_SQUARE_LT_1; REAL_POW_EQ_0] THEN MATCH_MP_TAC(REAL_ARITH `x = &1 - y ==> &1 - x = y`) THEN MATCH_MP_TAC SQRT_UNIQUE THEN REWRITE_TAC[REAL_ARITH `&0 <= &1 - &2 * x / y <=> (&2 * x) / y <= &1`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LE; NORM_POS_LE; REAL_ARITH `&0 <= x ==> &0 < &1 + x`] THEN REWRITE_TAC[REAL_ARITH `&2 * x <= &1 * (&1 + x) <=> x <= &1`] THEN ASM_SIMP_TAC[ABS_SQUARE_LE_1; REAL_ABS_NORM; REAL_LT_IMP_LE] THEN SUBGOAL_THEN `~(&1 + norm(x:complex) pow 2 = &0)` MP_TAC THENL [ALL_TAC; CONV_TAC REAL_FIELD] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) < &1 ==> ~(&1 + x = &0)`) THEN ASM_REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NORM; ABS_SQUARE_LT_1]);; let DDIST_KLEINIFY = prove (`!w z. ~(norm w = &1) /\ ~(norm z = &1) ==> ddist(kleinify w,kleinify z) = &4 * (&1 / &2 + norm(w - z) pow 2 / ((&1 - norm w pow 2) * (&1 - norm z pow 2))) pow 2 - &1`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(&4 * norm(w - z:real^2) pow 2 * ((&1 - norm w pow 2) * (&1 - norm z pow 2) + norm(w - z) pow 2)) / ((&1 - norm w pow 2) pow 2 * (&1 - norm z pow 2) pow 2)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[ddist; NORM_KLEINIFY_LT] THEN MATCH_MP_TAC(REAL_FIELD `~(y = &0) /\ z = (w + &1) * y ==> z / y - &1 = w`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THEN MATCH_MP_TAC (REAL_ARITH `x < &1 ==> ~(&1 - x = &0)`) THEN ASM_SIMP_TAC[REAL_POW_1_LT; NORM_KLEINIFY_LT; NORM_POS_LE; ARITH]; REWRITE_TAC[kleinify; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN REWRITE_TAC[GSYM COMPLEX_CMUL; DOT_LMUL] THEN REWRITE_TAC[DOT_RMUL] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_POW_LE; NORM_POS_LE; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`] THEN MATCH_MP_TAC(REAL_FIELD `(~(y' = &0) /\ ~(y = &0)) /\ (y * y' - &4 * d) pow 2 = b * (y pow 2 - &4 * x pow 2) * (y' pow 2 - &4 * x' pow 2) ==> (&1 - &2 / y * &2 / y' * d) pow 2 = b * (&1 - (&2 / y * x) pow 2) * (&1 - (&2 / y' * x') pow 2)`) THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH `~(abs x = &1) ==> ~(&1 + x = &0)`) THEN ASM_SIMP_TAC[REAL_ABS_POW; REAL_POW_EQ_1; REAL_ABS_NORM] THEN ARITH_TAC; REWRITE_TAC[REAL_RING `(&1 + x) pow 2 - &4 * x = (&1 - x) pow 2`] THEN MATCH_MP_TAC(REAL_FIELD `(~(y = &0) /\ ~(y' = &0)) /\ a - y * y' = b ==> a = (b / (y * y') + &1) * y * y'`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_POW_EQ_0; REAL_POW_EQ_1; REAL_ABS_NORM; ARITH; REAL_ARITH `&1 - x = &0 <=> x = &1`]; REWRITE_TAC[NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC]]]; REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[NORM_EQ_SQUARE; GSYM NORM_POW_2] THEN CONV_TAC REAL_FIELD]);; let DDIST_KLEINIFY_EQ = prove (`!w z w' z'. ~(norm w = &1) /\ ~(norm z = &1) /\ ~(norm w' = &1) /\ ~(norm z' = &1) /\ norm(w - z) pow 2 * (&1 - norm w' pow 2) * (&1 - norm z' pow 2) = norm(w' - z') pow 2 * (&1 - norm w pow 2) * (&1 - norm z pow 2) ==> ddist(kleinify w,kleinify z) = ddist(kleinify w',kleinify z')`, SIMP_TAC[DDIST_KLEINIFY; NORM_EQ_SQUARE; GSYM NORM_POW_2; REAL_POS] THEN CONV_TAC REAL_FIELD);; let NORM_KLEINIFY_MOEBIUS_LT = prove (`!w x. norm w < &1 /\ norm x < &1 ==> norm(kleinify(moebius_function (&0) w x)) < &1`, SIMP_TAC[MOEBIUS_FUNCTION_NORM_LT_1; NORM_KLEINIFY_LT; REAL_LT_IMP_NE]);; let DDIST_KLEINIFY_MOEBIUS = prove (`!w x y. norm w < &1 /\ norm x < &1 /\ norm y < &1 ==> ddist(kleinify(moebius_function (&0) w x), kleinify(moebius_function (&0) w y)) = ddist(kleinify x,kleinify y)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DDIST_KLEINIFY_EQ THEN ASM_SIMP_TAC[MOEBIUS_FUNCTION_NORM_LT_1; REAL_LT_IMP_NE] THEN REWRITE_TAC[MOEBIUS_FUNCTION_SIMPLE] THEN SUBGOAL_THEN `~(Cx(&1) - cnj w * x = Cx(&0)) /\ ~(Cx(&1) - cnj w * y = Cx(&0))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[REAL_LT_REFL] `norm(x) < norm(y) ==> ~(y = x)`) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_NORM_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REWRITE_TAC[COMPLEX_NORM_CNJ]; ASM_SIMP_TAC[COMPLEX_FIELD `~(Cx(&1) - cnj w * x = Cx(&0)) /\ ~(Cx(&1) - cnj w * y = Cx(&0)) ==> (x - w) / (Cx (&1) - cnj w * x) - (y - w) / (Cx (&1) - cnj w * y) = ((Cx(&1) - w * cnj w) * (x - y)) / ((Cx (&1) - cnj w * x) * (Cx (&1) - cnj w * y))`] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD `~(y = &0) /\ ~(y' = &0) ==> (&1 - (x / y) pow 2) * (&1 - (x' / y') pow 2) = ((y pow 2 - x pow 2) * (y' pow 2 - x' pow 2)) / (y * y') pow 2`] THEN REWRITE_TAC[REAL_POW_DIV; COMPLEX_NORM_MUL] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_RING `x * y:real = w * z ==> (x * i) * y = w * z * i`) THEN REWRITE_TAC[GSYM COMPLEX_NORM_MUL] THEN REWRITE_TAC[NORM_POW_2; DOT_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; complex_sub; complex_mul; CX_DEF; complex_add; RE; IM; cnj; complex_neg] THEN REAL_ARITH_TAC]);; let COLLINEAR_KLEINIFY_MOEBIUS = prove (`!w x y z. norm w < &1 /\ norm x < &1 /\ norm y < &1 /\ norm z < &1 ==> (collinear {kleinify(moebius_function (&0) w x), kleinify(moebius_function (&0) w y), kleinify(moebius_function (&0) w z)} <=> collinear {kleinify x,kleinify y,kleinify z})`, REPEAT STRIP_TAC THEN REWRITE_TAC[COLLINEAR_3_2D; kleinify; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX] THEN SIMP_TAC[NORM_POS_LE; REAL_POW_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`; REAL_FIELD `~(nx = &0) /\ ~(ny = &0) /\ ~(nz = &0) ==> ((&2 / nz * rz - &2 / nx * rx) * (&2 / ny * iy - &2 / nx * ix) = (&2 / ny * ry - &2 / nx * rx) * (&2 / nz * iz - &2 / nx * ix) <=> (nx * rz - nz * rx) * (nx * iy - ny * ix) = (nx * ry - ny * rx) * (nx * iz - nz * ix))`] THEN REWRITE_TAC[COMPLEX_NORM_DIV; MOEBIUS_FUNCTION_SIMPLE] THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN REWRITE_TAC[RE_DIV_CX; GSYM CX_POW; IM_DIV_CX] THEN SUBGOAL_THEN `~(Cx (&1) - cnj w * x = Cx(&0)) /\ ~(Cx (&1) - cnj w * y = Cx(&0)) /\ ~(Cx (&1) - cnj w * z = Cx(&0))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_SUB_0] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC(MESON[REAL_LT_REFL] `norm x < norm y ==> ~(y = x)`) THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; COMPLEX_NORM_CX] THEN ONCE_REWRITE_TAC[REAL_ARITH `abs(&1) = &1 * &1`] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD `~(nx = &0) /\ ~(ny = &0) /\ ~(nz = &0) ==>(((&1 + (nxw / nx) pow 2) * rz / nz pow 2 - (&1 + (nzw / nz) pow 2) * rx / nx pow 2) * ((&1 + (nxw / nx) pow 2) * iy / ny pow 2 - (&1 + (nyw / ny) pow 2) * ix / nx pow 2) = ((&1 + (nxw / nx) pow 2) * ry / ny pow 2 - (&1 + (nyw / ny) pow 2) * rx / nx pow 2) * ((&1 + (nxw / nx) pow 2) * iz / nz pow 2 - (&1 + (nzw / nz) pow 2) * ix / nx pow 2) <=> ((nx pow 2 + nxw pow 2) * rz - (nz pow 2 + nzw pow 2) * rx) * ((nx pow 2 + nxw pow 2) * iy - (ny pow 2 + nyw pow 2) * ix) = ((nx pow 2 + nxw pow 2) * ry - (ny pow 2 + nyw pow 2) * rx) * ((nx pow 2 + nxw pow 2) * iz - (nz pow 2 + nzw pow 2) * ix))`] THEN REWRITE_TAC[COMPLEX_SQNORM; complex_sub; complex_mul; complex_add; complex_neg; cnj; CX_DEF; RE; IM] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN MATCH_MP_TAC(REAL_RING `!a b. a * lhs = b * rhs /\ ~(a = &0) /\ ~(b = &0) ==> (lhs = &0 <=> rhs = &0)`) THEN EXISTS_TAC `Re x pow 2 + Im x pow 2 + &1` THEN EXISTS_TAC `--(Re w pow 2 + Im w pow 2 - &1) pow 3 * ((&1 - Re(x) pow 2 - Im(x) pow 2) * (&1 - Re(w) pow 2 - Im(w) pow 2) + &2 * (Re w - Re x) pow 2 + &2 * (Im w - Im x) pow 2)` THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM; REAL_POW_EQ_0; ARITH_EQ] THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `&0 <= x + y ==> ~(x + y + &1 = &0)`) THEN ASM_SIMP_TAC[GSYM COMPLEX_SQNORM; REAL_LE_POW_2]; MATCH_MP_TAC(REAL_ARITH `x + y < &1 ==> ~(--(x + y - &1) = &0)`) THEN ASM_SIMP_TAC[GSYM COMPLEX_SQNORM; REAL_POW_1_LT; NORM_POS_LE; ARITH]; MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 <= y ==> ~(x + y = &0)`) THEN SIMP_TAC[REAL_LE_ADD; REAL_LE_MUL; REAL_POS; REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < &1 - x - y <=> x + y < &1`] THEN ASM_SIMP_TAC[GSYM COMPLEX_SQNORM; REAL_POW_1_LT; NORM_POS_LE; ARITH]]);; let BETWEEN_KLEINIFY_MOEBIUS = prove (`!w x y z. norm w < &1 /\ norm x < &1 /\ norm y < &1 /\ norm z < &1 ==> (between (kleinify(moebius_function (&0) w x)) (kleinify(moebius_function (&0) w y), kleinify(moebius_function (&0) w z)) <=> between (kleinify x) (kleinify y,kleinify z))`, SIMP_TAC[BETWEEN_COLLINEAR_DDIST_EQ; NORM_KLEINIFY_MOEBIUS_LT; NORM_KLEINIFY_LT; REAL_LT_IMP_NE; COLLINEAR_KLEINIFY_MOEBIUS; DDIST_KLEINIFY_MOEBIUS]);; let hyperbolic_isometry = new_definition `hyperbolic_isometry (f:real^2->real^2) <=> (!x. norm x < &1 ==> norm(f x) < &1) /\ (!x y. norm x < &1 /\ norm y < &1 ==> ddist(f x,f y) = ddist(x,y)) /\ (!x y z. norm x < &1 /\ norm y < &1 /\ norm z < &1 ==> (between (f x) (f y,f z) <=> between x (y,z)))`;; let HYPERBOLIC_TRANSLATION = prove (`!w. norm w < &1 ==> ?f:real^2->real^2 g:real^2->real^2. hyperbolic_isometry f /\ hyperbolic_isometry g /\ f(w) = vec 0 /\ g(vec 0) = w /\ (!x. norm x < &1 ==> f(g x) = x) /\ (!x. norm x < &1 ==> g(f x) = x)`, REPEAT STRIP_TAC THEN SIMP_TAC[hyperbolic_isometry] THEN MAP_EVERY EXISTS_TAC [`\x. kleinify(moebius_function(&0) (poincarify w) (poincarify x))`; `\x. kleinify(moebius_function(&0) (--(poincarify w)) (poincarify x))`] THEN ASM_SIMP_TAC[NORM_KLEINIFY_MOEBIUS_LT; NORM_POINCARIFY_LT; DDIST_KLEINIFY_MOEBIUS; KLEINIFY_POINCARIFY; VECTOR_NEG_NEG; BETWEEN_KLEINIFY_MOEBIUS; NORM_NEG; MOEBIUS_FUNCTION_COMPOSE; POINCARIFY_KLEINIFY; MOEBIUS_FUNCTION_NORM_LT_1] THEN ASM_SIMP_TAC[MOEBIUS_FUNCTION_SIMPLE; COMPLEX_SUB_REFL; complex_div; COMPLEX_VEC_0; KLEINIFY_0; POINCARIFY_0; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_SUB_LZERO; COMPLEX_NEG_NEG; COMPLEX_SUB_RZERO; COMPLEX_INV_1; COMPLEX_MUL_RID; KLEINIFY_POINCARIFY]);; (* ------------------------------------------------------------------------- *) (* Our model. *) (* ------------------------------------------------------------------------- *) let plane_tybij = let th = prove (`?x:real^2. norm x < &1`, EXISTS_TAC `vec 0:real^2` THEN NORM_ARITH_TAC) in new_type_definition "plane" ("mk_plane","dest_plane") th;; let pbetween = new_definition `pbetween y (x,z) <=> between (dest_plane y) (dest_plane x,dest_plane z)`;; let pdist = new_definition `pdist(x,y) = ddist(dest_plane x,dest_plane y)`;; let DEST_PLANE_NORM_LT = prove (`!x. norm(dest_plane x) < &1`, MESON_TAC[plane_tybij]);; let DEST_PLANE_EQ = prove (`!x y. dest_plane x = dest_plane y <=> x = y`, MESON_TAC[plane_tybij]);; let FORALL_DEST_PLANE = prove (`!P. (!x. P(dest_plane x)) <=> (!x. norm x < &1 ==> P x)`, MESON_TAC[plane_tybij]);; let EXISTS_DEST_PLANE = prove (`!P. (?x. P(dest_plane x)) <=> (?x. norm x < &1 /\ P x)`, MESON_TAC[plane_tybij]);; (* ------------------------------------------------------------------------- *) (* Axiom 1 (reflexivity for equidistance). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_1_NONEUCLIDEAN = prove (`!a b. pdist(a,b) = pdist(b,a)`, REWRITE_TAC[pdist; DDIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Axiom 2 (transitivity for equidistance). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_2_NONEUCLIDEAN = prove (`!a b p q r s. pdist(a,b) = pdist(p,q) /\ pdist(a,b) = pdist(r,s) ==> pdist(p,q) = pdist(r,s)`, REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Axiom 3 (identity for equidistance). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_3_NONEUCLIDEAN = prove (`!a b c. pdist(a,b) = pdist(c,c) ==> a = b`, SIMP_TAC[FORALL_DEST_PLANE; pdist; DDIST_REFL; DDIST_EQ_0; DEST_PLANE_EQ]);; (* ------------------------------------------------------------------------- *) (* Axiom 4 (segment construction). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_4_NONEUCLIDEAN = prove (`!a q b c. ?x. pbetween a (q,x) /\ pdist(a,x) = pdist(b,c)`, REWRITE_TAC[pbetween; pdist; FORALL_DEST_PLANE; EXISTS_DEST_PLANE] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `?d:real^2. norm d < &1 /\ ddist(b:real^2,c) = ddist(vec 0,d)` STRIP_ASSUME_TAC THENL [MP_TAC(SPEC `b:real^2` HYPERBOLIC_TRANSLATION) THEN ASM_REWRITE_TAC[hyperbolic_isometry] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `norm(a:real^2) < &1 /\ norm(q:real^2) < &1 /\ norm(d:real^2) < &1` MP_TAC THENL [ASM_REWRITE_TAC[]; REPEAT(POP_ASSUM(K ALL_TAC))] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`d:real^2`; `q:real^2`; `a:real^2`] THEN MATCH_MP_TAC(MESON[] `P(vec 0) /\ (P(vec 0) ==> !x. P x) ==> !x. P x`) THEN REWRITE_TAC[NORM_0; REAL_LT_01] THEN CONJ_TAC THENL [MP_TAC(ISPEC `vec 0:real^2` TARSKI_AXIOM_4_EUCLIDEAN) THEN MESON_TAC[DIST_0; DDIST_EQ_ORIGIN]; DISCH_THEN(LABEL_TAC "*") THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `a:real^2` HYPERBOLIC_TRANSLATION) THEN ASM_REWRITE_TAC[hyperbolic_isometry; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^2->real^2`; `g:real^2->real^2`] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPECL [`(f:real^2->real^2) q`; `d:real^2`]) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^2` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:real^2->real^2) x` THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Axiom 5 (five-segments axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_5_NONEUCLIDEAN = prove (`!a b c x a' b' c' x'. ~(a = b) /\ pdist(a,b) = pdist(a',b') /\ pdist(a,c) = pdist(a',c') /\ pdist(b,c) = pdist(b',c') /\ pbetween b (a,x) /\ pbetween b' (a',x') /\ pdist(b,x) = pdist(b',x') ==> pdist(c,x) = pdist(c',x')`, REWRITE_TAC[FORALL_DEST_PLANE; pdist; pbetween; GSYM DEST_PLANE_EQ] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `b':real^2` HYPERBOLIC_TRANSLATION) THEN MP_TAC(ISPEC `b:real^2` HYPERBOLIC_TRANSLATION) THEN ASM_REWRITE_TAC[RIGHT_IMP_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[hyperbolic_isometry] THEN MAP_EVERY X_GEN_TAC [`f:real^2->real^2`; `f':real^2->real^2`; `g:real^2->real^2`; `g':real^2->real^2`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^2->real^2) x`; `(f:real^2->real^2) c`; `(g:real^2->real^2) x'`; `(g:real^2->real^2) c'`] DDIST_CONGRUENT_TRIPLES_0) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(p ==> r) /\ q ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [ASM_MESON_TAC[DDIST_SYM]; ALL_TAC] THEN MP_TAC(ISPECL [`(f:real^2->real^2) a`; `(f:real^2->real^2) c`; `(g:real^2->real^2) a'`; `(g:real^2->real^2) c'`] DDIST_CONGRUENT_TRIPLES_0) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM DDIST_CONGRUENT_TRIPLES_0] THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM(ASSUME `(f:complex->complex) b = vec 0`)] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM(ASSUME `(g:complex->complex) b' = vec 0`)] THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[DDIST_SYM]; STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^2->real^2) a`; `(f:real^2->real^2) b`; `(f:real^2->real^2) c`; `(f:real^2->real^2) x`;`(g:real^2->real^2) a'`; `(g:real^2->real^2) b'`; `(g:real^2->real^2) c'`; `(g:real^2->real^2) x'`] TARSKI_AXIOM_5_EUCLIDEAN) THEN SUBGOAL_THEN `ddist((f:real^2->real^2) b,f x) = ddist((g:real^2->real^2) b',g x')` MP_TAC THENL [ASM_SIMP_TAC[]; ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DDIST_EQ_ORIGIN] THEN DISCH_TAC] THEN ASM_MESON_TAC[DIST_SYM; DIST_0]]);; (* ------------------------------------------------------------------------- *) (* Axiom 6 (identity for between-ness). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_6_NONEUCLIDEAN = prove (`!a b. pbetween b (a,a) ==> a = b`, REWRITE_TAC[pbetween; FORALL_DEST_PLANE; GSYM DEST_PLANE_EQ] THEN MESON_TAC[TARSKI_AXIOM_6_EUCLIDEAN]);; (* ------------------------------------------------------------------------- *) (* Axiom 7 (Pasch's axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_7_NONEUCLIDEAN = prove (`!a b c p q. pbetween p (a,c) /\ pbetween q (b,c) ==> ?x. pbetween x (p,b) /\ pbetween x (q,a)`, REWRITE_TAC[pbetween; FORALL_DEST_PLANE; EXISTS_DEST_PLANE] THEN MESON_TAC[BETWEEN_NORM_LT; TARSKI_AXIOM_7_EUCLIDEAN]);; (* ------------------------------------------------------------------------- *) (* Axiom 8 (lower 2-dimensional axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_8_NONEUCLIDEAN = prove (`?a b c. ~pbetween b (a,c) /\ ~pbetween c (b,a) /\ ~pbetween a (c,b)`, REWRITE_TAC[pbetween; EXISTS_DEST_PLANE; NORM_LT_SQUARE; NORM_POW_2] THEN MAP_EVERY (fun t -> EXISTS_TAC t THEN SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_2; ARITH] THEN REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV) [`vec 0:real^2`; `(&1 / &2) % basis 1:real^2`; `(&1 / &2) % basis 2:real^2`] THEN REPEAT CONJ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR) THEN SIMP_TAC[COLLINEAR_3_2D; VECTOR_MUL_COMPONENT; VEC_COMPONENT; ARITH; BASIS_COMPONENT; DIMINDEX_2] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Axiom 9 (upper 2-dimensional axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_9_NONEUCLIDEAN = prove (`!p q a b c. ~(p = q) /\ pdist(a,p) = pdist(a,q) /\ pdist(b,p) = pdist(b,q) /\ pdist(c,p) = pdist(c,q) ==> pbetween b (a,c) \/ pbetween c (b,a) \/ pbetween a (c,b)`, REWRITE_TAC[pdist; pbetween; FORALL_DEST_PLANE; GSYM DEST_PLANE_EQ] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:real^2`; `q:real^2`] HYPERBOLIC_MIDPOINT) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN MP_TAC(ISPEC `x:real^2` HYPERBOLIC_TRANSLATION) THEN SUBGOAL_THEN `norm(x:real^2) < &1` ASSUME_TAC THENL [ASM_MESON_TAC[BETWEEN_NORM_LT]; ONCE_REWRITE_TAC[BETWEEN_SYM]] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; hyperbolic_isometry] THEN REWRITE_TAC[GSYM COLLINEAR_BETWEEN_CASES] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `collinear{(f:real^2->real^2) b,f c,f a}` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[COLLINEAR_BETWEEN_CASES]] THEN SUBGOAL_THEN `ddist(f a,f p) = ddist(f a,f q) /\ ddist(f b,f p) = ddist(f b,f q) /\ ddist(f c,f p) = ddist(f c,f q) /\ ~((f:real^2->real^2) q = f p)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^2->real^2) q = --(f p)` SUBST1_TAC THENL [SUBGOAL_THEN `between ((f:real^2->real^2) x) (f p,f q) /\ ddist(f x,f p) = ddist(f x,f q)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DDIST_EQ_ORIGIN] THEN REWRITE_TAC[GSYM MIDPOINT_BETWEEN; midpoint; NORM_ARITH `norm(a:real^N) = norm b <=> dist(a,vec 0) = dist(vec 0,b)`] THEN VECTOR_ARITH_TAC; REWRITE_TAC[ddist] THEN ASM_SIMP_TAC[NORM_NEG; real_div; REAL_INV_MUL] THEN ASM_SIMP_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1; REAL_ABS_NORM; REAL_FIELD `&0 < x /\ &0 < y ==> (a * inv x * inv y - &1 = b * inv x * inv y - &1 <=> a = b)`] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `--x:real^N = x <=> x = vec 0`] THEN REWRITE_TAC[COLLINEAR_3_2D; VECTOR_SUB_COMPONENT; DOT_2; GSYM DOT_EQ_0; VECTOR_NEG_COMPONENT] THEN CONV_TAC REAL_RING]);; (* ------------------------------------------------------------------------- *) (* Axiom 10 (Euclidean axiom). *) (* ------------------------------------------------------------------------- *) let NOT_TARSKI_AXIOM_10_NONEUCLIDEAN = prove (`~(!a b c d t. pbetween d (a,t) /\ pbetween d (b,c) /\ ~(a = d) ==> ?x y. pbetween b (a,x) /\ pbetween c (a,y) /\ pbetween t (x,y))`, REWRITE_TAC[pbetween; FORALL_DEST_PLANE; EXISTS_DEST_PLANE; GSYM DEST_PLANE_EQ; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^2`; `&1 / &2 % basis 1:real^2`; `&1 / &2 % basis 2:real^2`; `&1 / &4 % basis 1 + &1 / &4 % basis 2:real^2`; `&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2`]) THEN REWRITE_TAC[NOT_IMP; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN REWRITE_TAC[IMP_CONJ] THEN REPEAT(GEN_TAC THEN DISCH_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN SIMP_TAC[COLLINEAR_3_2D; BASIS_COMPONENT; DIMINDEX_2; ARITH; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_ARITH `&0 = &1 / &2 * x <=> x = &0`] THEN REWRITE_TAC[REAL_ENTIRE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC(ISPECL [`x:real^2`; `1`] COMPONENT_LE_NORM) THEN MP_TAC(ISPECL [`y:real^2`; `2`] COMPONENT_LE_NORM) THEN SIMP_TAC[DIMINDEX_2; ARITH; BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `norm(&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2) pow 2 <= &1 / &2` MP_TAC THENL [SUBGOAL_THEN `(&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2)$2 = (&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2)$1` MP_TAC THENL [SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; ARITH; BASIS_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN ASM_SIMP_TAC[DIMINDEX_2; FORALL_2; DOT_2; VECTOR_ADD_COMPONENT; ARITH; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a * &0 + y = x + b * &0 ==> abs x + abs y <= (&1 - u) * &1 + u * &1 ==> abs x <= abs(&1 / &2) /\ abs y <= abs(&1 / &2)`)) THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN REAL_ARITH_TAC]; ALL_TAC]] THEN SIMP_TAC[NORM_LT_SQUARE; NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LZERO; DOT_LMUL; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_2; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `&5 / &12`; EXISTS_TAC `&1 / &2`; ALL_TAC] THEN SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; ARITH; BASIS_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Axiom 11 (Continuity). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_11_NONEUCLIDEAN = prove (`!X Y. (?a. !x y. x IN X /\ y IN Y ==> pbetween x (a,y)) ==> (?b. !x y. x IN X /\ y IN Y ==> pbetween b (x,y))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `X:plane->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `Y:plane->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[pbetween; EXISTS_DEST_PLANE] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^2` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`IMAGE dest_plane X`; `IMAGE dest_plane Y`] TARSKI_AXIOM_11_EUCLIDEAN) THEN REWRITE_TAC[IN_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; DEST_PLANE_NORM_LT; BETWEEN_NORM_LT]);; hol-light/100/isosceles.ml000066400000000000000000000255131303454263000155760ustar00rootroot00000000000000(* ========================================================================= *) (* Isosceles triangle theorem. *) (* ========================================================================= *) needs "Multivariate/geom.ml";; (* ------------------------------------------------------------------------- *) (* The theorem, according to Wikipedia. *) (* ------------------------------------------------------------------------- *) let ISOSCELES_TRIANGLE_THEOREM = prove (`!A B C:real^N. dist(A,C) = dist(B,C) ==> angle(C,A,B) = angle(A,B,C)`, MP_TAC(INST_TYPE [`:N`,`:M`] CONGRUENT_TRIANGLES_SSS) THEN MESON_TAC[DIST_SYM; ANGLE_SYM]);; (* ------------------------------------------------------------------------- *) (* The obvious converse. *) (* ------------------------------------------------------------------------- *) let ISOSCELES_TRIANGLE_CONVERSE = prove (`!A B C:real^N. angle(C,A,B) = angle(A,B,C) /\ ~(collinear {A,B,C}) ==> dist(A,C) = dist(B,C)`, MP_TAC(INST_TYPE [`:N`,`:M`] CONGRUENT_TRIANGLES_ASA_FULL) THEN MESON_TAC[DIST_SYM; ANGLE_SYM]);; (* ------------------------------------------------------------------------- *) (* Some other equivalents sometimes called the ITT (see the Web page *) (* http://www.sonoma.edu/users/w/wilsonst/Courses/Math_150/Theorems/itt.html *) (* ------------------------------------------------------------------------- *) let lemma = prove (`!A B C D:real^N. between D (A,B) ==> (orthogonal (A - B) (C - D) <=> angle(A,D,C) = pi / &2 /\ angle(B,D,C) = pi / &2)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `D:real^N = A` THENL [DISCH_TAC THEN ASM_SIMP_TAC[ANGLE_REFL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ORTHOGONAL_LNEG] THEN REWRITE_TAC[VECTOR_NEG_SUB; ORTHOGONAL_VECTOR_ANGLE; angle]; ALL_TAC] THEN ASM_CASES_TAC `D:real^N = B` THENL [DISCH_TAC THEN ASM_SIMP_TAC[ANGLE_REFL] THEN REWRITE_TAC[ORTHOGONAL_VECTOR_ANGLE; angle]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `D:real^N`; `C:real^N`] ANGLES_ALONG_LINE) THEN ASM_REWRITE_TAC[ORTHOGONAL_VECTOR_ANGLE] THEN MATCH_MP_TAC(REAL_ARITH `x = z ==> x + y = p ==> (z = p / &2 <=> x = p / &2 /\ y = p / &2)`) THEN REWRITE_TAC[angle] THEN MATCH_MP_TAC VECTOR_ANGLE_EQ_0_RIGHT THEN ONCE_REWRITE_TAC[GSYM VECTOR_ANGLE_NEG2] THEN REWRITE_TAC[VECTOR_NEG_SUB; GSYM angle] THEN ASM_MESON_TAC[ANGLE_EQ_PI_OTHERS; BETWEEN_ANGLE]);; let ISOSCELES_TRIANGLE_1 = prove (`!A B C D:real^N. dist(A,C) = dist(B,C) /\ D = midpoint(A,B) ==> angle(A,C,D) = angle(B,C,D)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`A:real^N`; `D:real^N`; `C:real^N`; `B:real^N`; `D:real^N`; `C:real^N`] CONGRUENT_TRIANGLES_SSS_FULL) THEN ASM_REWRITE_TAC[DIST_MIDPOINT] THEN ASM_MESON_TAC[DIST_SYM; ANGLE_SYM]);; let ISOSCELES_TRIANGLE_2 = prove (`!A B C D:real^N. between D (A,B) /\ dist(A,C) = dist(B,C) /\ angle(A,C,D) = angle(B,C,D) ==> orthogonal (A - B) (C - D)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOSCELES_TRIANGLE_THEOREM) THEN MP_TAC(ISPECL [`D:real^N`; `C:real^N`; `A:real^N`; `D:real^N`; `C:real^N`; `B:real^N`] CONGRUENT_TRIANGLES_SAS_FULL) THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM; ANGLE_SYM]; ALL_TAC] THEN ASM_CASES_TAC `D:real^N = B` THEN ASM_SIMP_TAC[DIST_EQ_0; DIST_REFL; VECTOR_SUB_REFL; ORTHOGONAL_0] THEN ASM_CASES_TAC `D:real^N = A` THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN ASM_SIMP_TAC[lemma] THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `D:real^N`; `C:real^N`] ANGLES_ALONG_LINE) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let ISOSCELES_TRIANGLE_3 = prove (`!A B C D:real^N. between D (A,B) /\ dist(A,C) = dist(B,C) /\ orthogonal (A - B) (C - D) ==> D = midpoint(A,B)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^N = B` THEN ASM_SIMP_TAC[BETWEEN_REFL_EQ; MIDPOINT_REFL] THEN ASM_CASES_TAC `D:real^N = A` THENL [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] PYTHAGORAS) THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_LNEG; VECTOR_NEG_SUB]; ALL_TAC] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[GSYM dist] THEN ASM_REWRITE_TAC[REAL_RING `a = x pow 2 + a <=> x = &0`; DIST_EQ_0]; ALL_TAC] THEN ASM_CASES_TAC `D:real^N = B` THENL [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] PYTHAGORAS) THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_LNEG; VECTOR_NEG_SUB]; ALL_TAC] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[GSYM dist] THEN ASM_REWRITE_TAC[REAL_RING `a = x pow 2 + a <=> x = &0`; DIST_EQ_0]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[lemma; MIDPOINT_COLLINEAR; BETWEEN_IMP_COLLINEAR] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOSCELES_TRIANGLE_THEOREM) THEN MP_TAC(ISPECL [`A:real^N`; `C:real^N`; `D:real^N`; `B:real^N`; `C:real^N`; `D:real^N`] CONGRUENT_TRIANGLES_SAS) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`A:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a:real = a' /\ b = b' ==> a + x + b = p ==> a' + x' + b' = p ==> x' = x`) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ANGLE_SYM]] THEN CONV_TAC SYM_CONV THEN UNDISCH_TAC `angle(C:real^N,A,B) = angle (A,B,C)` THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_MP_TAC ANGLE_EQ_0_LEFT; GEN_REWRITE_TAC RAND_CONV [ANGLE_SYM] THEN MATCH_MP_TAC ANGLE_EQ_0_RIGHT] THEN ASM_MESON_TAC[ANGLE_EQ_PI_OTHERS; BETWEEN_ANGLE]);; (* ------------------------------------------------------------------------- *) (* Now the converses to those as well. *) (* ------------------------------------------------------------------------- *) let ISOSCELES_TRIANGLE_4 = prove (`!A B C D:real^N. D = midpoint(A,B) /\ orthogonal (A - B) (C - D) ==> dist(A,C) = dist(B,C)`, REPEAT GEN_TAC THEN ASM_SIMP_TAC[IMP_CONJ; BETWEEN_MIDPOINT; lemma] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC CONGRUENT_TRIANGLES_SAS THEN MAP_EVERY EXISTS_TAC [`D:real^N`; `D:real^N`] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "D" THEN REWRITE_TAC[DIST_MIDPOINT]);; let ISOSCELES_TRIANGLE_5 = prove (`!A B C D:real^N. ~collinear{D,C,A} /\ between D (A,B) /\ angle(A,C,D) = angle(B,C,D) /\ orthogonal (A - B) (C - D) ==> dist(A,C) = dist(B,C)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `C:real^N = D` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN UNDISCH_TAC `~(C:real^N = D)` THEN REWRITE_TAC[GSYM IMP_CONJ_ALT; GSYM CONJ_ASSOC] THEN ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `C:real^N = A` THENL [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[ANGLE_REFL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_ANGLE]) THEN ASM_CASES_TAC `D:real^N = A` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `D:real^N = B` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ARITH `x / &2 = &0 <=> x = &0`; PI_NZ] THEN DISCH_THEN(MP_TAC o MATCH_MP ANGLE_EQ_PI_OTHERS) THEN MP_TAC PI_NZ THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `C:real^N = B` THENL [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[ANGLE_REFL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_ANGLE]) THEN ASM_CASES_TAC `D:real^N = B` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `D:real^N = A` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ARITH `&0 = x / &2 <=> x = &0`; PI_NZ] THEN DISCH_THEN(MP_TAC o MATCH_MP ANGLE_EQ_PI_OTHERS) THEN MP_TAC PI_NZ THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[IMP_CONJ; lemma] THEN REPEAT DISCH_TAC THEN MP_TAC( ISPECL [`D:real^N`; `C:real^N`; `A:real^N`; `D:real^N`; `C:real^N`; `B:real^N`] CONGRUENT_TRIANGLES_ASA_FULL) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN ONCE_REWRITE_TAC[ANGLE_SYM] THEN ASM_REWRITE_TAC[]);; let ISOSCELES_TRIANGLE_6 = prove (`!A B C D:real^N. ~collinear{D,C,A} /\ D = midpoint(A,B) /\ angle(A,C,D) = angle(B,C,D) ==> dist(A,C) = dist(B,C)`, REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`A:real^N`; `C:real^N`; `D:real^N`] LAW_OF_SINES) THEN MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `D:real^N`] LAW_OF_SINES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "D" THEN REWRITE_TAC[DIST_MIDPOINT] THEN ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_HALF; DIST_POS_LT; SIN_ANGLE_EQ] THEN STRIP_TAC THENL [MP_TAC(ISPECL [`D:real^N`; `C:real^N`; `A:real^N`; `D:real^N`; `C:real^N`; `B:real^N`] CONGRUENT_TRIANGLES_AAS) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ANGLE_SYM] THEN ASM_REWRITE_TAC[]; MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] TRIANGLE_ANGLE_SUM) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `angle(A:real^N,B,C) = angle(C,B,D) /\ angle(B,A,C) = angle(C,A,D)` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [ANGLE_SYM] THEN MATCH_MP_TAC ANGLE_EQ_0_LEFT THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`] BETWEEN_MIDPOINT) THEN ASM_REWRITE_TAC[BETWEEN_ANGLE] THEN EXPAND_TAC "D" THEN REWRITE_TAC[MIDPOINT_EQ_ENDPOINT] THEN ASM_REWRITE_TAC[] THEN MESON_TAC[ANGLE_EQ_PI_OTHERS]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_ARITH `a + pi - a + x = pi <=> x = &0`] THEN MAP_EVERY ASM_CASES_TAC [`B:real^N = C`; `A:real^N = C`] THEN ASM_REWRITE_TAC[ANGLE_REFL; REAL_ARITH `p / &2 = &0 <=> p = &0`] THEN ASM_REWRITE_TAC[PI_NZ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `A:real^N`] COLLINEAR_ANGLE) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~collinear{D:real^N,C,A}` THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> ~p ==> q ==> r`) THEN ONCE_REWRITE_TAC[SET_RULE `{bd,c,a} = {c,a,bd}`] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN EXPAND_TAC "D" THEN REWRITE_TAC[midpoint] THEN REWRITE_TAC[VECTOR_ARITH `inv(&2) % (A + B) - A = inv(&2) % (B - A)`] THEN MESON_TAC[VECTOR_MUL_ASSOC]]);; hol-light/100/konigsberg.ml000066400000000000000000000240471303454263000157400ustar00rootroot00000000000000(* ========================================================================= *) (* Impossibility of Eulerian path for bridges of Koenigsberg. *) (* ========================================================================= *) let edges = new_definition `edges(E:E->bool,V:V->bool,Ter:E->V->bool) = E`;; let vertices = new_definition `vertices(E:E->bool,V:V->bool,Ter:E->V->bool) = V`;; let termini = new_definition `termini(E:E->bool,V:V->bool,Ter:E->V->bool) = Ter`;; (* ------------------------------------------------------------------------- *) (* Definition of an undirected graph. *) (* ------------------------------------------------------------------------- *) let graph = new_definition `graph G <=> !e. e IN edges(G) ==> ?a b. a IN vertices(G) /\ b IN vertices(G) /\ termini G e = {a,b}`;; let TERMINI_IN_VERTICES = prove (`!G e v. graph G /\ e IN edges(G) /\ v IN termini G e ==> v IN vertices G`, REWRITE_TAC[graph; EXTENSION; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Connection in a graph. *) (* ------------------------------------------------------------------------- *) let connects = new_definition `connects G e (a,b) <=> termini G e = {a,b}`;; (* ------------------------------------------------------------------------- *) (* Delete an edge in a graph. *) (* ------------------------------------------------------------------------- *) let delete_edge = new_definition `delete_edge e (E,V,Ter) = (E DELETE e,V,Ter)`;; let DELETE_EDGE_CLAUSES = prove (`(!G. edges(delete_edge e G) = (edges G) DELETE e) /\ (!G. vertices(delete_edge e G) = vertices G) /\ (!G. termini(delete_edge e G) = termini G)`, REWRITE_TAC[FORALL_PAIR_THM; delete_edge; edges; vertices; termini]);; let GRAPH_DELETE_EDGE = prove (`!G e. graph G ==> graph(delete_edge e G)`, REWRITE_TAC[graph; DELETE_EDGE_CLAUSES; IN_DELETE] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Local finiteness: set of edges with given endpoint is finite. *) (* ------------------------------------------------------------------------- *) let locally_finite = new_definition `locally_finite G <=> !v. v IN vertices(G) ==> FINITE {e | e IN edges G /\ v IN termini G e}`;; (* ------------------------------------------------------------------------- *) (* Degree of a vertex. *) (* ------------------------------------------------------------------------- *) let localdegree = new_definition `localdegree G v e = if termini G e = {v} then 2 else if v IN termini G e then 1 else 0`;; let degree = new_definition `degree G v = nsum {e | e IN edges G /\ v IN termini G e} (localdegree G v)`;; let DEGREE_DELETE_EDGE = prove (`!G e:E v:V. graph G /\ locally_finite G /\ e IN edges(G) ==> degree G v = if termini G e = {v} then degree (delete_edge e G) v + 2 else if v IN termini G e then degree (delete_edge e G) v + 1 else degree (delete_edge e G) v`, REPEAT STRIP_TAC THEN REWRITE_TAC[degree; DELETE_EDGE_CLAUSES; IN_DELETE] THEN SUBGOAL_THEN `{e:E | e IN edges G /\ (v:V) IN termini G e} = if v IN termini G e then e INSERT {e' | (e' IN edges G /\ ~(e' = e)) /\ v IN termini G e'} else {e' | (e' IN edges G /\ ~(e' = e)) /\ v IN termini G e'}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INSERT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(v:V) IN termini G (e:E)` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; COND_CASES_TAC THENL [ASM_MESON_TAC[IN_SING; EXTENSION]; ALL_TAC] THEN MATCH_MP_TAC NSUM_EQ THEN REWRITE_TAC[IN_ELIM_THM; localdegree] THEN REWRITE_TAC[DELETE_EDGE_CLAUSES]] THEN SUBGOAL_THEN `FINITE {e':E | (e' IN edges G /\ ~(e' = e)) /\ (v:V) IN termini G e'}` (fun th -> SIMP_TAC[NSUM_CLAUSES; th]) THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{e:E | e IN edges G /\ (v:V) IN termini G e}` THEN SIMP_TAC[IN_ELIM_THM; SUBSET] THEN ASM_MESON_TAC[locally_finite; TERMINI_IN_VERTICES]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[localdegree] THEN SUBGOAL_THEN `nsum {e':E | (e' IN edges G /\ ~(e' = e)) /\ (v:V) IN termini G e'} (localdegree (delete_edge e G) v) = nsum {e' | (e' IN edges G /\ ~(e' = e)) /\ v IN termini G e'} (localdegree G v)` SUBST1_TAC THENL [ALL_TAC; COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ARITH_TAC] THEN MATCH_MP_TAC NSUM_EQ THEN SIMP_TAC[localdegree; DELETE_EDGE_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Definition of Eulerian path. *) (* ------------------------------------------------------------------------- *) let eulerian_RULES,eulerian_INDUCT,eulerian_CASES = new_inductive_definition `(!G a. a IN vertices G /\ edges G = {} ==> eulerian G [] (a,a)) /\ (!G a b c e es. e IN edges(G) /\ connects G e (a,b) /\ eulerian (delete_edge e G) es (b,c) ==> eulerian G (CONS e es) (a,c))`;; let EULERIAN_FINITE = prove (`!G es ab. eulerian G es ab ==> FINITE (edges G)`, MATCH_MP_TAC eulerian_INDUCT THEN SIMP_TAC[DELETE_EDGE_CLAUSES; FINITE_DELETE; FINITE_RULES]);; (* ------------------------------------------------------------------------- *) (* The main result. *) (* ------------------------------------------------------------------------- *) let EULERIAN_ODD_LEMMA = prove (`!G:(E->bool)#(V->bool)#(E->V->bool) es ab. eulerian G es ab ==> graph G ==> FINITE(edges G) /\ !v. v IN vertices G ==> (ODD(degree G v) <=> ~(FST ab = SND ab) /\ (v = FST ab \/ v = SND ab))`, MATCH_MP_TAC eulerian_INDUCT THEN CONJ_TAC THENL [SIMP_TAC[degree; NOT_IN_EMPTY; SET_RULE `{x | F} = {}`] THEN SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; ARITH]; ALL_TAC] THEN SIMP_TAC[GRAPH_DELETE_EDGE; FINITE_DELETE; DELETE_EDGE_CLAUSES] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[GRAPH_DELETE_EDGE] THEN STRIP_TAC THEN X_GEN_TAC `v:V` THEN DISCH_TAC THEN MP_TAC(ISPECL [`G:(E->bool)#(V->bool)#(E->V->bool)`; `e:E`; `v:V`] DEGREE_DELETE_EDGE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[locally_finite] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `edges(G:(E->bool)#(V->bool)#(E->V->bool))` THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(ISPECL [`G:(E->bool)#(V->bool)#(E->V->bool)`; `e:E`] TERMINI_IN_VERTICES) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connects]) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN ASM_CASES_TAC `b:V = a` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[SET_RULE `{a,a} = {v} <=> v = a`] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ODD_ADD; ARITH]; ALL_TAC] THEN ASM_REWRITE_TAC[SET_RULE `{a,b} = {v} <=> a = b /\ a = v`] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ODD_ADD; ARITH] THEN ASM_MESON_TAC[]);; let EULERIAN_ODD = prove (`!G es a b. graph G /\ eulerian G es (a,b) ==> !v. v IN vertices G ==> (ODD(degree G v) <=> ~(a = b) /\ (v = a \/ v = b))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP EULERIAN_ODD_LEMMA) THEN ASM_SIMP_TAC[FST; SND]);; (* ------------------------------------------------------------------------- *) (* Now the actual Koenigsberg configuration. *) (* ------------------------------------------------------------------------- *) let KOENIGSBERG = prove (`!G. vertices(G) = {0,1,2,3} /\ edges(G) = {10,20,30,40,50,60,70} /\ termini G (10) = {0,1} /\ termini G (20) = {0,2} /\ termini G (30) = {0,3} /\ termini G (40) = {1,2} /\ termini G (50) = {1,2} /\ termini G (60) = {2,3} /\ termini G (70) = {2,3} ==> ~(?es a b. eulerian G es (a,b))`, GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `G:(num->bool)#(num->bool)#(num->num->bool)` EULERIAN_ODD) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[graph] THEN GEN_TAC THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN ASM_REWRITE_TAC[SET_RULE `{a,b} = {x,y} <=> a = x /\ b = y \/ a = y /\ b = x`] THEN MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN ASM_REWRITE_TAC[degree; edges] THEN SIMP_TAC[TAUT `a IN s /\ k IN t <=> ~(a IN s ==> ~(k IN t))`] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN REWRITE_TAC[DE_MORGAN_THM] THEN REWRITE_TAC[SET_RULE `{x | x = a \/ P(x)} = a INSERT {x | P(x)}`] THEN REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[NSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN ASM_REWRITE_TAC[localdegree; IN_INSERT; NOT_IN_EMPTY; ARITH] THEN REWRITE_TAC[SET_RULE `{a,b} = {x} <=> x = a /\ a = b`] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `0` th) THEN MP_TAC(SPEC `1` th) THEN MP_TAC(SPEC `2` th) THEN MP_TAC(SPEC `3` th)) THEN REWRITE_TAC[ARITH] THEN ARITH_TAC);; (****** Maybe for completeness I should show the contrary: existence of Eulerian circuit/walk if we do have the right properties, assuming the graph is connected; cf: http://math.arizona.edu/~lagatta/class/fa05/m105/graphtheorynotes.pdf *****) hol-light/100/lagrange.ml000066400000000000000000000264731303454263000153730ustar00rootroot00000000000000(* ========================================================================= *) (* Very trivial group theory, just to reach Lagrange theorem. *) (* ========================================================================= *) loadt "Library/prime.ml";; (* ------------------------------------------------------------------------- *) (* Definition of what a group is. *) (* ------------------------------------------------------------------------- *) let group = new_definition `group(g,( ** ),i,(e:A)) <=> (e IN g) /\ (!x. x IN g ==> i(x) IN g) /\ (!x y. x IN g /\ y IN g ==> (x ** y) IN g) /\ (!x y z. x IN g /\ y IN g /\ z IN g ==> (x ** (y ** z) = (x ** y) ** z)) /\ (!x. x IN g ==> (x ** e = x) /\ (e ** x = x)) /\ (!x. x IN g ==> (x ** i(x) = e) /\ (i(x) ** x = e))`;; (* ------------------------------------------------------------------------- *) (* Notion of a subgroup. *) (* ------------------------------------------------------------------------- *) let subgroup = new_definition `subgroup h (g,( ** ),i,(e:A)) <=> h SUBSET g /\ group(h,( ** ),i,e)`;; (* ------------------------------------------------------------------------- *) (* Lagrange theorem, introducing the coset representatives. *) (* ------------------------------------------------------------------------- *) let GROUP_LAGRANGE_COSETS = prove (`!g h ( ** ) i e. group (g,( ** ),i,e:A) /\ subgroup h (g,( ** ),i,e) /\ FINITE g ==> ?q. (CARD(g) = CARD(q) * CARD(h)) /\ (!b. b IN g ==> ?a x. a IN q /\ x IN h /\ (b = a ** x))`, REPEAT GEN_TAC THEN REWRITE_TAC[group; subgroup; SUBSET] THEN STRIP_TAC THEN ABBREV_TAC `coset = \a:A. {b:A | b IN g /\ (?x:A. x IN h /\ (b = a ** x))}` THEN SUBGOAL_THEN `!a:A. a IN g ==> a IN (coset a)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "coset" THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(h:A->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!a. FINITE((coset:A->A->bool) a)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "coset" THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `g:A->bool` THEN ASM_SIMP_TAC[IN_ELIM_THM; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!a:A x:A y. a IN g /\ x IN g /\ y IN g /\ ((a ** x) :A = a ** y) ==> (x = y)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `(e:A ** x:A):A = e ** y` (fun th -> ASM_MESON_TAC[th]) THEN SUBGOAL_THEN `((i(a):A ** a:A) ** x) = (i(a) ** a) ** y` (fun th -> ASM_MESON_TAC[th]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!a:A. a IN g ==> (CARD(coset a :A->bool) = CARD(h:A->bool))` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `(coset:A->A->bool) (a:A) = IMAGE (\x. a ** x) (h:A->bool)` SUBST1_TAC THENL [EXPAND_TAC "coset" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:A y. x IN g /\ y IN g ==> (i(x ** y) = i(y) ** i(x))` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(x:A ** y:A) :A` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(x:A ** (y ** i(y))) ** i(x)` THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:A. x IN g ==> (i(i(x)) = x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(i:A->A)(x)` THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!a b. a IN g /\ b IN g ==> ((coset:A->A->bool) a = coset b) \/ ((coset a) INTER (coset b) = {})` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `((i:A->A)(b) ** a:A) IN (h:A->bool)` THENL [DISJ1_TAC THEN EXPAND_TAC "coset" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `!x:A. x IN h ==> (b ** (i(b) ** a:A) ** x = a ** x) /\ (a ** i(i(b) ** a) ** x = b ** x)` (fun th -> EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[th]) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISJ2_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER] THEN X_GEN_TAC `x:A` THEN EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[TAUT `(a /\ b) /\ (a /\ c) <=> a /\ b /\ c`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `z:A` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `(i(b:A) ** a ** y):A = i(b) ** b ** z` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(i(b:A) ** a:A ** y):A = e ** z` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(i(b:A) ** a:A ** y):A = z` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `((i(b:A) ** a:A) ** y):A = z` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `((i(b:A) ** a:A) ** y) ** i(y) = z ** i(y)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(i(b:A) ** a:A) ** (y ** i(y)) = z ** i(y)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(i(b:A) ** a:A) ** e = z ** i(y)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(i(b:A) ** a:A):A = z ** i(y)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `{c:A | ?a:A. a IN g /\ (c = (@)(coset a))}` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> b /\ a`) THEN CONJ_TAC THENL [X_GEN_TAC `b:A` THEN DISCH_TAC THEN EXISTS_TAC `(@)((coset:A->A->bool) b)` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `b:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(@)((coset:A->A->bool) b) IN (coset b)` MP_TAC THENL [REWRITE_TAC[IN] THEN MATCH_MP_TAC SELECT_AX THEN ASM_MESON_TAC[IN]; ALL_TAC] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RATOR_CONV) [SYM th]) THEN REWRITE_TAC[] THEN ABBREV_TAC `C = (@)((coset:A->A->bool) b)` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `c:A` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(i:A->A)(c)` THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `q = {c:A | ?a:A. a IN g /\ (c = (@)(coset a))}` THEN DISCH_TAC THEN SUBGOAL_THEN `!a:A b. a IN g /\ b IN g /\ a IN coset(b) ==> b IN coset(a)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `c:A` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(i:A->A) c` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!a:A b c. a IN coset(b) /\ b IN coset(c) /\ c IN g ==> a IN coset(c)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!a:A b:A. a IN coset(b) ==> a IN g` ASSUME_TAC THENL [EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!a:A b. a IN coset(b) /\ b IN g ==> (coset a = coset b)` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION] THEN MAP_EVERY UNDISCH_TAC [`!a:A b:A. a IN coset(b) ==> a IN g`; `!a:A b c. a IN coset(b) /\ b IN coset(c) /\ c IN g ==> a IN coset(c)`; `!a:A b. a IN g /\ b IN g /\ a IN coset(b) ==> b IN coset(a)`] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!a:A. a IN g ==> (@)(coset a):A IN (coset a)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN UNDISCH_TAC `!a:A. a IN g ==> a IN coset a` THEN DISCH_THEN(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN; SELECT_AX]; ALL_TAC] THEN SUBGOAL_THEN `!a:A. a IN q ==> a IN g` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!a:A x:A a' x'. a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ ((a' ** x') :A = a ** x) ==> (a' = a) /\ (x' = x)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `(c ==> a /\ b ==> d) ==> a /\ b /\ c ==> d`) THEN STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a1:A` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `a2:A` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `a:A IN g /\ a' IN g` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `((coset:A->A->bool) a1 = coset a) /\ (coset a2 = coset a')` MP_TAC THENL [CONJ_TAC THEN CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN ONCE_ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(x:A ** (i:A->A)(x')):A` THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `(a':A ** x':A):A = a ** x` THEN DISCH_THEN(MP_TAC o C AP_THM `(i:A->A) x'` o AP_TERM `(**):A->A->A`) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `g = IMAGE (\(a:A,x:A). (a ** x):A) {(a,x) | a IN q /\ x IN h}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[EXISTS_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[PAIR_EQ] THEN REWRITE_TAC[CONJ_ASSOC; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `CARD {(a:A,x:A) | a IN q /\ x IN h}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[PAIR_EQ] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC FINITE_PRODUCT THEN CONJ_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `g:A->bool` THEN ASM_REWRITE_TAC[SUBSET]; ALL_TAC] THEN MATCH_MP_TAC CARD_PRODUCT THEN CONJ_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `g:A->bool` THEN ASM_REWRITE_TAC[SUBSET]);; (* ------------------------------------------------------------------------- *) (* Traditional statement is only part of this. *) (* ------------------------------------------------------------------------- *) let GROUP_LAGRANGE = prove (`!g h ( ** ) i e. group (g,( ** ),i,e:A) /\ subgroup h (g,( ** ),i,e) /\ FINITE g ==> (CARD h) divides (CARD g)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP GROUP_LAGRANGE_COSETS) THEN MESON_TAC[DIVIDES_LMUL; DIVIDES_REFL]);; hol-light/100/leibniz.ml000066400000000000000000000347701303454263000152460ustar00rootroot00000000000000(* ========================================================================= *) (* #26: Leibniz's series for pi *) (* ========================================================================= *) needs "Library/transc.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Summability of alternating series. *) (* ------------------------------------------------------------------------- *) let ALTERNATING_SUM_BOUNDS = prove (`!a. (!n. a(2 * n + 1) <= &0 /\ &0 <= a(2 * n)) /\ (!n. abs(a(n + 1)) <= abs(a(n))) ==> !m n. (EVEN m ==> &0 <= sum(m,n) a /\ sum(m,n) a <= a(m)) /\ (ODD m ==> a(m) <= sum(m,n) a /\ sum(m,n) a <= &0)`, GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN REWRITE_TAC[ODD; EVEN] THENL [SIMP_TAC[sum; ODD_EXISTS; EVEN_EXISTS; LEFT_IMP_EXISTS_THM; ADD1] THEN ASM_SIMP_TAC[REAL_LE_REFL]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[ARITH_RULE `SUC n = 1 + n`; GSYM SUM_SPLIT] THEN FIRST_X_ASSUM(MP_TAC o check (is_conj o concl) o SPEC `SUC m`) THEN REWRITE_TAC[ODD; EVEN; SUM_1] THEN REWRITE_TAC[ADD1; GSYM NOT_EVEN] THEN UNDISCH_THEN `!n. abs(a(n + 1)) <= abs(a n)` (MP_TAC o SPEC `m:num`) THEN ASM_CASES_TAC `EVEN m` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN REWRITE_TAC[ODD_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN REAL_ARITH_TAC]);; let ALTERNATING_SUM_BOUND = prove (`!a. (!n. a(2 * n + 1) <= &0 /\ &0 <= a(2 * n)) /\ (!n. abs(a(n + 1)) <= abs(a(n))) ==> !m n. abs(sum(m,n) a) <= abs(a m)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ALTERNATING_SUM_BOUNDS) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[GSYM NOT_EVEN] THEN ASM_CASES_TAC `EVEN m` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let SUMMABLE_ALTERNATING = prove (`!v. (!n. a(2 * n + 1) <= &0 /\ &0 <= a(2 * n)) /\ (!n. abs(a(n + 1)) <= abs(a(n))) /\ a tends_num_real &0 ==> summable a`, REPEAT STRIP_TAC THEN REWRITE_TAC[SER_CAUCHY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [SEQ]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN ASM_MESON_TAC[ALTERNATING_SUM_BOUND; REAL_LET_TRANS]);; (* ------------------------------------------------------------------------- *) (* Another version of the atan series. *) (* ------------------------------------------------------------------------- *) let REAL_ATN_POWSER_ALT = prove (`!x. abs(x) < &1 ==> (\n. (-- &1) pow n / &(2 * n + 1) * x pow (2 * n + 1)) sums (atn x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_ATN_POWSER) THEN FIRST_ASSUM(MP_TAC o C CONJ (ARITH_RULE `0 < 2`) o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_GROUP) THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN REWRITE_TAC[SUM_2; EVEN_MULT; EVEN_ADD; ARITH_EVEN; ADD_SUB] THEN ONCE_REWRITE_TAC[ARITH_RULE `n * 2 = 2 * n`] THEN SIMP_TAC[DIV_MULT; ARITH_EQ; REAL_MUL_LZERO; REAL_ADD_LID]);; (* ------------------------------------------------------------------------- *) (* Summability of the same series for x = 1. *) (* ------------------------------------------------------------------------- *) let SUMMABLE_LEIBNIZ = prove (`summable (\n. (-- &1) pow n / &(2 * n + 1))`, MATCH_MP_TAC SUMMABLE_ALTERNATING THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[REAL_POW_ADD; REAL_POW_MUL; GSYM REAL_POW_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE; real_div; REAL_MUL_LID; REAL_MUL_LNEG] THEN REWRITE_TAC[REAL_LE_LNEG; REAL_ADD_RID; REAL_LE_INV_EQ; REAL_POS]; GEN_TAC THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; REWRITE_TAC[SEQ; REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_POW] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_POW_ONE] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 1`] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&1` o MATCH_MP REAL_ARCH) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&1 < x * e ==> e * x <= y ==> &1 < y`)) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The tricky sum-bounding lemma. *) (* ------------------------------------------------------------------------- *) let SUM_DIFFERENCES = prove (`!a m n. m <= n + 1 ==> sum(m..n) (\i. a(i) - a(i+1)) = a(m) - a(n + 1)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `m <= 0 + 1 <=> m = 0 \/ m = 1`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN ASM_SIMP_TAC[SUM_TRIV_NUMSEG; ARITH; REAL_SUB_REFL]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `m <= SUC n + 1 <=> m <= n + 1 \/ m = SUC n + 1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[SUM_TRIV_NUMSEG; ARITH_RULE `n < n + 1`; REAL_SUB_REFL] THEN ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `m <= n + 1 ==> m <= SUC n /\ m <= SUC n + 1`] THEN REWRITE_TAC[ADD1] THEN REAL_ARITH_TAC);; let SUM_REARRANGE_LEMMA = prove (`!a v m n. m <= n + 1 ==> sum(m..n+1) (\i. a i * v i) = sum(m..n) (\k. sum(m..k) a * (v(k) - v(k+1))) + sum(m..n+1) a * v(n+1)`, REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[SUM_CLAUSES_NUMSEG; num_CONV `1`; ADD_CLAUSES] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ADD_CLAUSES; SUM_CLAUSES_NUMSEG] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_CASES_TAC `m = SUC(n + 1)` THENL [ASM_REWRITE_TAC[LE_SUC; ARITH_RULE `~(n + 1 <= n)`] THEN ASM_SIMP_TAC[SUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n /\ n < SUC(n + 1)`] THEN REAL_ARITH_TAC; ALL_TAC] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE `m <= SUC n <=> m <= SUC(n + 1) /\ ~(m = SUC(n + 1))`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_RDISTRIB; REAL_EQ_ADD_RCANCEL] THEN REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `m <= SUC(n + 1) /\ ~(m = SUC(n + 1)) ==> m <= SUC n`] THEN REWRITE_TAC[REAL_ARITH `(s1 * (v - w) + x) + (s2 + y) * w = (x + y * w) + (v - w) * s1 + w * s2`] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[REAL_ADD_LDISTRIB; GSYM SUM_CMUL; GSYM SUM_ADD_NUMSEG] THEN REWRITE_TAC[REAL_SUB_ADD; REAL_SUB_RDISTRIB] THEN REAL_ARITH_TAC);; let SUM_BOUNDS_LEMMA = prove (`!a v l u m n. m <= n /\ (!i. m <= i /\ i <= n ==> &0 <= v(i) /\ v(i+1) <= v(i)) /\ (!k. m <= k /\ k <= n ==> l <= sum(m..k) a /\ sum(m..k) a <= u) ==> l * v(m) <= sum(m..n) (\i. a(i) * v(i)) /\ sum(m..n) (\i. a(i) * v(i)) <= u * v(m)`, REPLICATE_TAC 5 GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[LE; SUM_CLAUSES_NUMSEG] THEN SIMP_TAC[ARITH_RULE `m <= i /\ i = 0 <=> m = 0 /\ i = 0`] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN SIMP_TAC[REAL_LE_RMUL]; POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[ADD1]] THEN SIMP_TAC[SUM_REARRANGE_LEMMA] THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m..n) (\k. l * (v(k) - v(k + 1))) + l * v(n+1)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_LMUL; SUM_DIFFERENCES] THEN REAL_ARITH_TAC; ALL_TAC]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m..n) (\k. u * (v(k) - v(k + 1))) + u * v(n+1)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_LMUL; SUM_DIFFERENCES] THEN REAL_ARITH_TAC]] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC[REAL_LE_RMUL; LE_REFL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_SUB_LE; ARITH_RULE `k <= n ==> k <= n + 1`]);; let SUM_BOUND_LEMMA = prove (`!a v b m n. m <= n /\ (!i. m <= i /\ i <= n ==> &0 <= v(i) /\ v(i+1) <= v(i)) /\ (!k. m <= k /\ k <= n ==> abs(sum(m..k) a) <= b) ==> abs(sum(m..n) (\i. a(i) * v(i))) <= b * abs(v m)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `--b * k <= a /\ a <= b * k ==> abs(a) <= b * k`) THEN ASM_SIMP_TAC[LE_REFL; real_abs] THEN MATCH_MP_TAC SUM_BOUNDS_LEMMA THEN ASM_REWRITE_TAC[REAL_BOUNDS_LE]);; (* ------------------------------------------------------------------------- *) (* Hence the final theorem. *) (* ------------------------------------------------------------------------- *) let LEIBNIZ_PI = prove (`(\n. (-- &1) pow n / &(2 * n + 1)) sums (pi / &4)`, REWRITE_TAC[GSYM ATN_1] THEN ASSUME_TAC(MATCH_MP SUMMABLE_SUM SUMMABLE_LEIBNIZ) THEN ABBREV_TAC `s = suminf(\n. (-- &1) pow n / &(2 * n + 1))` THEN SUBGOAL_THEN `s = atn(&1)` (fun th -> ASM_MESON_TAC[th]) THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(x - y)) ==> x = y`) THEN ABBREV_TAC `e = abs(s - atn(&1))` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN REWRITE_TAC[SER_CAUCHY] THEN DISCH_THEN(MP_TAC o SPEC `e / &7`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(\x. sum(0,N) (\n. (-- &1) pow n / &(2 * n + 1) * x pow (2 * n + 1))) contl (&1)` MP_TAC THENL [MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `sum(0,N) (\n. (-- &1) pow n * &1 pow (2 * n))` THEN MATCH_MP_TAC DIFF_SUM THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC DIFF_CMUL THEN MP_TAC(SPECL [`2 * k + 1`; `&1`] DIFF_POW) THEN DISCH_THEN(MP_TAC o SPEC `inv(&(2 * k + 1))` o MATCH_MP DIFF_CMUL) THEN MATCH_MP_TAC(TAUT `a = b ==> a ==> b`) THEN REWRITE_TAC[ADD_SUB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_POW_ONE] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN SUBGOAL_THEN `atn contl (&1)` MP_TAC THENL [MESON_TAC[DIFF_CONT; DIFF_ATN]; ALL_TAC] THEN REWRITE_TAC[CONTL_LIM; LIM] THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &6`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; GSYM SUM_SUB] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN REWRITE_TAC[GSYM SUM_NEG; REAL_NEG_SUB; GSYM REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_POW_ONE; GSYM REAL_SUB_LDISTRIB] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN ABBREV_TAC `x = &1 - min (min (d1 / &2) (d2 / &2)) (&1 / &2)` THEN REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN SUBGOAL_THEN `&0 < x /\ x < &1 /\ abs x < &1` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_ALT) THEN REWRITE_TAC[sums; SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &6`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [sums]) THEN REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &6`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `N + N1 + N2:num`) THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN REWRITE_TAC[ADD_CLAUSES] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(sum(N,N1+N2) (\n. -- &1 pow n / &(2 * n + 1) * x pow (2 * n + 1))) < e / &6` ASSUME_TAC THENL [ASM_CASES_TAC `N1 + N2 = 0` THENL [ASM_SIMP_TAC[sum; REAL_LT_DIV; REAL_OF_NUM_LT; REAL_ABS_NUM; ARITH]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= e / &7 /\ &0 < e ==> x < e / &6`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e / &7 * abs(x pow (2 * N + 1))` THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_POW_1_LE THEN MAP_EVERY UNDISCH_TAC [`&0 < x`; `x < &1`] THEN REAL_ARITH_TAC] THEN ASM_SIMP_TAC[PSUM_SUM_NUMSEG] THEN MATCH_MP_TAC SUM_BOUND_LEMMA THEN CONJ_TAC THENL [UNDISCH_TAC `~(N1 + N2 = 0)` THEN ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_POW_LT]; REWRITE_TAC[ARITH_RULE `2 * (m + 1) + 1 = (2 * m + 1) + 2`] THEN GEN_REWRITE_TAC LAND_CONV [REAL_POW_ADD] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_POW_1_LE; REAL_LT_IMP_LE]; MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `(k - N:num) + 1`]) THEN SIMP_TAC[PSUM_SUM_NUMSEG; ADD_EQ_0; ARITH_EQ] THEN ASM_SIMP_TAC[ARITH_RULE `N <= k ==> (N + (k - N) + 1) - 1 = k`] THEN REWRITE_TAC[GE; LE_REFL; REAL_LT_IMP_LE]]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `N1 + N2:num`]) THEN REWRITE_TAC[GE; LE_REFL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs((slo + shi) - s) < e / &6 ==> ~(abs(slo - s) < e / &3) ==> ~(abs(shi) < e / &7)`)) THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_SUB_LDISTRIB; SUM_SUB; REAL_MUL_RID]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(s1 - sx) < e / &6 ==> ~(abs(sx - s) < e / &2) ==> ~(abs(s1 - s) < e / &3)`)) THEN ASM_REAL_ARITH_TAC);; hol-light/100/lhopital.ml000066400000000000000000000227201303454263000154160ustar00rootroot00000000000000(* ========================================================================= *) (* #64: L'Hopital's rule. *) (* ========================================================================= *) needs "Library/analysis.ml";; override_interface ("-->",`(tends_real_real)`);; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Cauchy mean value theorem. *) (* ------------------------------------------------------------------------- *) let MVT2 = prove (`!f g a b. a < b /\ (!x. a <= x /\ x <= b ==> f contl x /\ g contl x) /\ (!x. a < x /\ x < b ==> f differentiable x /\ g differentiable x) ==> ?z f' g'. a < z /\ z < b /\ (f diffl f') z /\ (g diffl g') z /\ (f b - f a) * g' = (g b - g a) * f'`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x:real. f(x) * (g(b) - g(a)) - g(x) * (f(b) - f(a))`; `a:real`; `b:real`] MVT) THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONT_SUB; CONT_MUL; CONT_CONST] THEN X_GEN_TAC `x:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[differentiable] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f':real`) (X_CHOOSE_TAC `g':real`)) THEN EXISTS_TAC `f' * (g(b:real) - g a) - g' * (f b - f a)` THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] DIFF_CMUL; DIFF_SUB]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real` THEN REWRITE_TAC[REAL_ARITH `(fb * (gb - ga) - gb * (fb - fa)) - (fa * (gb - ga) - ga * (fb - fa)) = y <=> y = &0`] THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0; REAL_LT_IMP_NE] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN UNDISCH_THEN `l = &0` SUBST_ALL_TAC THEN UNDISCH_TAC `!x. a < x /\ x < b ==> f differentiable x /\ g differentiable x` THEN DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[differentiable] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f':real`) (X_CHOOSE_TAC `g':real`)) THEN MAP_EVERY EXISTS_TAC [`f':real`; `g':real`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `\x:real. f(x) * (g(b) - g(a)) - g(x) * (f(b) - f(a))` THEN EXISTS_TAC `z:real` THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] DIFF_CMUL; DIFF_SUB]);; (* ------------------------------------------------------------------------- *) (* First, assume f and g actually take value zero at c. *) (* ------------------------------------------------------------------------- *) let LHOPITAL_WEAK = prove (`!f g f' g' c L d. &0 < d /\ (!x. &0 < abs(x - c) /\ abs(x - c) < d ==> (f diffl f'(x)) x /\ (g diffl g'(x)) x /\ ~(g'(x) = &0)) /\ f(c) = &0 /\ g(c) = &0 /\ (f --> &0) c /\ (g --> &0) c /\ ((\x. f'(x) / g'(x)) --> L) c ==> ((\x. f(x) / g(x)) --> L) c`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. &0 < abs(x - c) /\ abs(x - c) < d ==> ?z. &0 < abs(z - c) /\ abs(z - c) < abs(x - c) /\ f(x) * g'(z) = f'(z) * g(x)` (LABEL_TAC "*") THENL [X_GEN_TAC `x:real` THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&0 < abs(x - c) /\ abs(x - c) < d ==> c < x /\ x < c + d \/ c - d < x /\ x < c`)) THEN STRIP_TAC THENL [MP_TAC(SPECL [`f:real->real`; `g:real->real`; `c:real`; `x:real`] MVT2) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o funpow 2 LAND_CONV) [REAL_LE_LT] THEN ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_IMP_LE; differentiable; REAL_ARITH `c < z /\ z <= x /\ x < c + d ==> &0 < abs(z - c) /\ abs(z - c) < d`]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN GEN_REWRITE_TAC (funpow 4 RAND_CONV) [REAL_MUL_SYM] THEN REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC) THEN ASM_MESON_TAC[DIFF_UNIQ; REAL_ARITH `c < z /\ z < x /\ x < c + d ==> &0 < abs(z - c) /\ abs(z - c) < d`]]; MP_TAC(SPECL [`f:real->real`; `g:real->real`; `x:real`; `c:real`] MVT2) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV o RAND_CONV) [REAL_LE_LT] THEN ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_IMP_LE; differentiable; REAL_ARITH `c - d < x /\ x <= z /\ z < c ==> &0 < abs(z - c) /\ abs(z - c) < d`]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_LNEG; REAL_EQ_NEG2] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN GEN_REWRITE_TAC (funpow 4 RAND_CONV) [REAL_MUL_SYM] THEN REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC) THEN ASM_MESON_TAC[DIFF_UNIQ; REAL_ARITH `c - d < x /\ x < z /\ z < c ==> &0 < abs(z - c) /\ abs(z - c) < d`]]]; ALL_TAC] THEN REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `((\x. f' x / g' x) --> L) c` THEN REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d:real`; `r:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN UNDISCH_TAC `!x. &0 < abs(x - c) /\ abs(x - c) < r ==> abs(f' x / g' x - L) < e` THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - l) < e ==> abs(y - l) < e`) THEN MATCH_MP_TAC(REAL_FIELD `~(gz = &0) /\ ~(gx = &0) /\ fx * gz = fz * gx ==> fz / gz = fx / gx`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN MP_TAC(ASSUME `&0 < abs(x - c)`) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&0 < abs(x - c) ==> c < x \/ x < c`)) THEN REPEAT STRIP_TAC THENL [MP_TAC(SPECL [`g:real->real`; `c:real`; `x:real`] ROLLE) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [REAL_LE_LT] THEN ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_TRANS; REAL_ARITH `c < z /\ z <= x /\ abs(x - c) < d ==> &0 < abs(z - c) /\ abs(z - c) < d`]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[differentiable; REAL_LT_TRANS; REAL_ARITH `c < z /\ z < x /\ abs(x - c) < d ==> &0 < abs(z - c) /\ abs(z - c) < d`]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `w:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[DIFF_UNIQ]; MP_TAC(SPECL [`g:real->real`; `x:real`; `c:real`] ROLLE) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_LE_LT] THEN ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_TRANS; REAL_ARITH `x <= z /\ z < c /\ z < c /\ abs(x - c) < d ==> &0 < abs(z - c) /\ abs(z - c) < d`]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[differentiable; REAL_LT_TRANS; REAL_ARITH `x < z /\ z < c /\ abs(x - c) < d ==> &0 < abs(z - c) /\ abs(z - c) < d`]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `w:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[DIFF_UNIQ]]);; (* ------------------------------------------------------------------------- *) (* Now generalize by continuity extension. *) (* ------------------------------------------------------------------------- *) let LHOPITAL = prove (`!f g f' g' c L d. &0 < d /\ (!x. &0 < abs(x - c) /\ abs(x - c) < d ==> (f diffl f'(x)) x /\ (g diffl g'(x)) x /\ ~(g'(x) = &0)) /\ (f --> &0) c /\ (g --> &0) c /\ ((\x. f'(x) / g'(x)) --> L) c ==> ((\x. f(x) / g(x)) --> L) c`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`\x:real. if x = c then &0 else f(x)`; `\x:real. if x = c then &0 else g(x)`; `f':real->real`; `g':real->real`; `c:real`; `L:real`; `d:real`] LHOPITAL_WEAK) THEN SIMP_TAC[LIM; REAL_ARITH `&0 < abs(x - c) ==> ~(x = c)`] THEN REWRITE_TAC[diffl] THEN STRIP_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[diffl] THENL [MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\h. (f(x + h) - f x) / h`; MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\h. (g(x + h) - g x) / h`; ASM_MESON_TAC[]] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < abs(x - c) ==> ~(x = c)`] THEN REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `abs(x - c)` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < abs(x - c) /\ &0 < abs z /\ abs z < abs(x - c) ==> ~(x + z = c)`] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM]);; hol-light/100/liouville.ml000066400000000000000000000517611303454263000156150ustar00rootroot00000000000000(* ========================================================================= *) (* Liouville approximation theorem. *) (* ========================================================================= *) needs "Library/floor.ml";; needs "Library/poly.ml";; (* ------------------------------------------------------------------------- *) (* Definition of algebraic and transcendental. *) (* ------------------------------------------------------------------------- *) let algebraic = new_definition `algebraic(x) <=> ?p. ALL integer p /\ ~(poly p = poly []) /\ poly p x = &0`;; let transcendental = new_definition `transcendental(x) <=> ~(algebraic x)`;; (* ------------------------------------------------------------------------- *) (* Some trivialities. *) (* ------------------------------------------------------------------------- *) let REAL_INTEGER_EQ_0 = prove (`!x. integer x /\ abs(x) < &1 ==> x = &0`, MESON_TAC[REAL_ABS_INTEGER_LEMMA; REAL_NOT_LE]);; let FACT_LE_REFL = prove (`!n. n <= FACT n`, INDUCT_TAC THEN REWRITE_TAC[FACT; ARITH] THEN MATCH_MP_TAC(ARITH_RULE `x * 1 <= a ==> x <= a`) THEN REWRITE_TAC[LE_MULT_LCANCEL; NOT_SUC; FACT_LT; ARITH_RULE `1 <= n <=> 0 < n`]);; let EXP_LE_REFL = prove (`!a. 1 < a ==> !n. n <= a EXP n`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `n <= x ==> 1 * x < y ==> SUC n <= y`)) THEN REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Archimedian properties taken from Multivariate/misc.ml *) (* ------------------------------------------------------------------------- *) let REAL_POW_LBOUND = prove (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; let REAL_ARCH_POW = prove (`!x y. &1 < x ==> ?n. y < x pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 + &n * (x - &1)` THEN ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH `&1 < x ==> &0 <= x - &1`]);; (* ------------------------------------------------------------------------- *) (* Inequality variant of mean value theorem. *) (* ------------------------------------------------------------------------- *) let MVT_INEQ = prove (`!f f' a d M. &0 < M /\ &0 < d /\ (!x. abs(x - a) <= d ==> (f diffl f'(x)) x /\ abs(f' x) < M) ==> !x. abs(x - a) <= d ==> abs(f x - f a) < M * d`, REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `x = a \/ x < a \/ a < x`) THENL [ASM_SIMP_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_MUL]; MP_TAC(SPECL [`f:real->real`; `f':real->real`; `x:real`; `a:real`] MVT_ALT); MP_TAC(SPECL [`f:real->real`; `f':real->real`; `a:real`; `x:real`] MVT_ALT)] THEN (ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC]) THEN STRIP_TAC THENL [ONCE_REWRITE_TAC[REAL_ABS_SUB]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d * abs(f'(z:real))` THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL; MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC]) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Appropriate multiple of poly on rational is an integer. *) (* ------------------------------------------------------------------------- *) let POLY_MULTIPLE_INTEGER = prove (`!p q l. ALL integer l ==> integer(&q pow (LENGTH l) * poly l (&p / &q))`, GEN_TAC THEN GEN_TAC THEN ASM_CASES_TAC `q = 0` THENL [LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_MUL_RZERO; INTEGER_CLOSED] THEN ASM_REWRITE_TAC[LENGTH; real_pow; REAL_MUL_LZERO; INTEGER_CLOSED]; ALL_TAC] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_MUL_RZERO; INTEGER_CLOSED] THEN REWRITE_TAC[LENGTH; real_pow; ALL] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `(q * qp) * (h + pq * pol) = q * h * qp + (q * pq) * (qp * pol)`] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN MATCH_MP_TAC(el 1 (CONJUNCTS INTEGER_CLOSED)) THEN ASM_SIMP_TAC[INTEGER_CLOSED]);; (* ------------------------------------------------------------------------- *) (* First show any root is surrounded by an other-root-free zone. *) (* ------------------------------------------------------------------------- *) let SEPARATE_FINITE_SET = prove (`!a s. FINITE s ==> ~(a IN s) ==> ?d. &0 < d /\ !x. x IN s ==> d <= abs(x - a)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `min d (abs(x - a))` THEN ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; GSYM REAL_ABS_NZ; REAL_SUB_0] THEN ASM_MESON_TAC[REAL_LE_REFL]);; let POLY_ROOT_SEPARATE_LE = prove (`!p x. poly p x = &0 /\ ~(poly p = poly []) ==> ?d. &0 < d /\ !x'. &0 < abs(x' - x) /\ abs(x' - x) < d ==> ~(poly p x' = &0)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `{x | poly p x = &0} DELETE x`] SEPARATE_FINITE_SET) THEN ASM_SIMP_TAC[POLY_ROOTS_FINITE_SET; FINITE_DELETE; IN_DELETE] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_SUB_0] THEN MESON_TAC[REAL_NOT_LT]);; let POLY_ROOT_SEPARATE_LT = prove (`!p x. poly p x = &0 /\ ~(poly p = poly []) ==> ?d. &0 < d /\ !x'. &0 < abs(x' - x) /\ abs(x' - x) <= d ==> ~(poly p x' = &0)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP POLY_ROOT_SEPARATE_LE) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_MESON_TAC[REAL_ARITH `&0 < d ==> &0 < d / &2 /\ (x <= d / &2 ==> x < d)`]);; (* ------------------------------------------------------------------------- *) (* And also there is a positive bound on a polynomial in an interval. *) (* ------------------------------------------------------------------------- *) let POLY_BOUND_INTERVAL = prove (`!p d x. ?M. &0 < M /\ !x'. abs(x' - x) <= d ==> abs(poly p x') < M`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`poly p`; `x - d`; `x + d`] CONT_BOUNDED_ABS) THEN REWRITE_TAC[REWRITE_RULE[ETA_AX] (SPEC_ALL POLY_CONT)] THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN EXISTS_TAC `&1 + abs M` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `M:real` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC; ALL_TAC] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Now put these together to get the interval we need. *) (* ------------------------------------------------------------------------- *) let LIOUVILLE_INTERVAL = prove (`!p x. poly p x = &0 /\ ~(poly p = poly []) ==> ?c. &0 < c /\ (!x'. abs(x' - x) <= c ==> abs(poly(poly_diff p) x') < &1 / c) /\ (!x'. &0 < abs(x' - x) /\ abs(x' - x) <= c ==> ~(poly p x' = &0))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:real list`; `x:real`] POLY_ROOT_SEPARATE_LT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`poly_diff p`; `d:real`; `x:real`] POLY_BOUND_INTERVAL) THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN EXISTS_TAC `min d (inv M)` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LE_MIN; REAL_LT_INV_EQ] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `M:real` THEN ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN] THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Liouville's approximation theorem. *) (* ------------------------------------------------------------------------- *) let LIOUVILLE = prove (`!x. algebraic x ==> ?n c. c > &0 /\ !p q. ~(q = 0) ==> &p / &q = x \/ abs(x - &p / &q) > c / &q pow n`, GEN_TAC THEN REWRITE_TAC[algebraic; real_gt] THEN DISCH_THEN(X_CHOOSE_THEN `l:real list` STRIP_ASSUME_TAC) THEN EXISTS_TAC `LENGTH(l:real list)` THEN MP_TAC(SPECL [`l:real list`; `x:real`] LIOUVILLE_INTERVAL) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN MAP_EVERY X_GEN_TAC [`p:num`; `q:num`] THEN DISCH_TAC THEN ASM_CASES_TAC `&p / &q = x` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `!x'. &0 < abs(x' - x) /\ abs(x' - x) <= c ==> ~(poly l x' = &0)` THEN DISCH_THEN(MP_TAC o SPEC `&p / &q`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_SUB_0]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(x - y) <= d ==> d <= e ==> abs(y - x) <= e`)) THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; REAL_LE_LDIV_EQ; LT_NZ] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_POW_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `~(q = 0)` THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&q pow (LENGTH(l:real list)) * poly l (&p / &q) = &0` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_OF_NUM_EQ]] THEN MATCH_MP_TAC REAL_INTEGER_EQ_0 THEN ASM_SIMP_TAC[POLY_MULTIPLE_INTEGER] THEN MP_TAC(SPECL [`poly l`; `poly(poly_diff l)`; `x:real`; `c / &q pow (LENGTH(l:real list))`; `&1 / c`] MVT_INEQ) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LT_NZ; REAL_POW_LT] THEN ANTS_TAC THENL [REWRITE_TAC[REWRITE_RULE[ETA_AX] (SPEC_ALL POLY_DIFF)] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x <= d ==> d <= e ==> x <= e`)) THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; REAL_LE_LDIV_EQ; LT_NZ] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_POW_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `~(q = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[GSYM real_div] THEN DISCH_THEN(MP_TAC o SPEC `&p / &q`) THEN REWRITE_TAC[REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; REAL_LT_RDIV_EQ; LT_NZ] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* Corollary for algebraic irrationals. *) (* ------------------------------------------------------------------------- *) let LIOUVILLE_IRRATIONAL = prove (`!x. algebraic x /\ ~rational x ==> ?n c. c > &0 /\ !p q. ~(q = 0) ==> abs(x - &p / &q) > c / &q pow n`, REWRITE_TAC[RATIONAL_ALT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LIOUVILLE) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM_MESON_TAC[LIOUVILLE; REAL_ABS_DIV; REAL_ABS_NUM]);; (* ------------------------------------------------------------------------- *) (* Liouville's constant. *) (* ------------------------------------------------------------------------- *) let liouville = new_definition `liouville = suminf (\n. &1 / &10 pow (FACT n))`;; (* ------------------------------------------------------------------------- *) (* Some bounds on the partial sums and hence convergence. *) (* ------------------------------------------------------------------------- *) let LIOUVILLE_SUM_BOUND = prove (`!d n. ~(n = 0) ==> sum(n..n+d) (\k. &1 / &10 pow FACT k) <= &2 / &10 pow (FACT n)`, INDUCT_TAC THEN GEN_TAC THEN DISCH_TAC THENL [REWRITE_TAC[ADD_CLAUSES; SUM_SING_NUMSEG; real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_OF_NUM_LE; ARITH]; ALL_TAC] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_ADD] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_ARITH `y <= x ==> &1 * x + y <= &2 * x`) THEN REWRITE_TAC[ARITH_RULE `n + SUC d = (n + 1) + d`; GSYM real_div] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN REWRITE_TAC[ADD_EQ_0; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH; FACT_MONO; LE_ADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&10 pow 1` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_POW_MONO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM ADD1; FACT] THEN MATCH_MP_TAC(ARITH_RULE `1 * x <= SUC n * x /\ ~(n * x = 0) ==> 1 <= SUC n * x - x`) THEN ASM_SIMP_TAC[LE_MULT_RCANCEL; MULT_EQ_0] THEN REWRITE_TAC[GSYM LT_NZ; FACT_LT] THEN ARITH_TAC);; let LIOUVILLE_PSUM_BOUND = prove (`!n d. ~(n = 0) ==> sum(n,d) (\k. &1 / &10 pow FACT k) <= &2 / &10 pow (FACT n)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `d = 0` THEN ASM_SIMP_TAC[sum; REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN ASM_SIMP_TAC[PSUM_SUM_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `~(d = 0) ==> (n + d) - 1 = n + (d - 1)`] THEN ASM_SIMP_TAC[LIOUVILLE_SUM_BOUND]);; let LIOUVILLE_SUMS = prove (`(\k. &1 / &10 pow FACT k) sums liouville`, REWRITE_TAC[liouville] THEN MATCH_MP_TAC SUMMABLE_SUM THEN REWRITE_TAC[SER_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `inv(e)` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `2 * N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &10 pow (FACT m)` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> abs x <= a`) THEN ASM_SIMP_TAC[SUM_POS; REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN MATCH_MP_TAC LIOUVILLE_PSUM_BOUND THEN UNDISCH_TAC `2 * N + 1 <= m` THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e * &(2 * N + 1)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `&1 < (n + &1 / &2) * e ==> &2 < e * (&2 * n + &1)`) THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; real_div; REAL_MUL_LID] THEN UNDISCH_TAC `inv(e) <= &N` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `10 EXP m` THEN REWRITE_TAC[FACT_LE_REFL; LE_EXP; ARITH] THEN SIMP_TAC[EXP_LE_REFL; ARITH]);; let LIOUVILLE_PSUM_LE = prove (`!n. sum(0,n) (\k. &1 / &10 pow FACT k) <= liouville`, GEN_TAC THEN REWRITE_TAC[suminf] THEN MATCH_MP_TAC SEQ_LE THEN EXISTS_TAC `\j:num. sum(0,n) (\k. &1 / &10 pow FACT k)` THEN EXISTS_TAC `\n:num. sum(0,n) (\k. &1 / &10 pow FACT k)` THEN REWRITE_TAC[SEQ_CONST; GSYM sums; LIOUVILLE_SUMS] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN SIMP_TAC[GE; LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM SUM_SPLIT; ADD_CLAUSES; REAL_LE_ADDR] THEN SIMP_TAC[SUM_POS; REAL_LE_DIV; REAL_POW_LE; REAL_POS]);; let LIOUVILLE_PSUM_LT = prove (`!n. sum(0,n) (\k. &1 / &10 pow FACT k) < liouville`, GEN_TAC THEN MP_TAC(SPEC `SUC n` LIOUVILLE_PSUM_LE) THEN SIMP_TAC[sum] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> x + e <= y ==> x < y`) THEN SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]);; let LIOVILLE_PSUM_DIFF = prove (`!n. ~(n = 0) ==> liouville <= sum(0,n) (\k. &1 / &10 pow FACT k) + &2 / &10 pow (FACT n)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SEQ_LE THEN EXISTS_TAC `\n. sum(0,n) (\k. &1 / &10 pow FACT k)` THEN EXISTS_TAC `\j:num. sum (0,n) (\k. &1 / &10 pow FACT k) + &2 / &10 pow FACT n` THEN REWRITE_TAC[SEQ_CONST; GSYM sums; LIOUVILLE_SUMS] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN SIMP_TAC[GE; LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM SUM_SPLIT; REAL_LE_LADD] THEN ASM_SIMP_TAC[ADD_CLAUSES; LIOUVILLE_PSUM_BOUND]);; (* ------------------------------------------------------------------------- *) (* Main proof. *) (* ------------------------------------------------------------------------- *) let TRANSCENDENTAL_LIOUVILLE = prove (`transcendental(liouville)`, REWRITE_TAC[transcendental] THEN DISCH_THEN(MP_TAC o MATCH_MP LIOUVILLE) THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN MAP_EVERY X_GEN_TAC [`m:num`; `c:real`] THEN REWRITE_TAC[DE_MORGAN_THM; real_gt; REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(SPECL [`&10`; `&2 / c`] REAL_ARCH_POW) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN ABBREV_TAC `n = m + k + 1` THEN EXISTS_TAC `nsum(0..n-1) (\i. 10 EXP (FACT(n-1) - FACT i))` THEN EXISTS_TAC `10 EXP (FACT(n-1))` THEN REWRITE_TAC[EXP_EQ_0; ARITH] THEN SUBGOAL_THEN `&(nsum(0..n-1) (\i. 10 EXP (FACT(n-1) - FACT i))) / &(10 EXP (FACT(n-1))) = sum(0..n-1) (\k. &1 / &10 pow (FACT k))` SUBST1_TAC THENL [REWRITE_TAC[real_div] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_OF_NUM_SUM_NUMSEG; GSYM SUM_LMUL] THEN SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH; FACT_MONO; real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; REAL_POW_EQ_0; ARITH] THEN REWRITE_TAC[REAL_MUL_LID]; ALL_TAC] THEN MP_TAC(GEN `f:num->real` (SPECL [`f:num->real`; `0`; `m + k + 1`] PSUM_SUM_NUMSEG)) THEN REWRITE_TAC[ADD_EQ_0; ARITH; ADD_CLAUSES] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN SIMP_TAC[LIOUVILLE_PSUM_LT; REAL_LT_IMP_NE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN REWRITE_TAC[REAL_SUB_LE; LIOUVILLE_PSUM_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &10 pow (FACT n)` THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN CONJ_TAC THENL [MATCH_MP_TAC LIOVILLE_PSUM_DIFF THEN EXPAND_TAC "n" THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[LIOVILLE_PSUM_DIFF] THEN REWRITE_TAC[REAL_OF_NUM_POW; GSYM EXP_MULT] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LT_NZ; EXP_EQ_0; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&10 pow k` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LT_NZ; EXP_EQ_0; ARITH] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN REWRITE_TAC[GSYM EXP_ADD; LE_EXP; ARITH_EQ] THEN EXPAND_TAC "n" THEN REWRITE_TAC[ARITH_RULE `(m + k + 1) - 1 = m + k`] THEN REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; FACT] THEN REWRITE_TAC[ARITH_RULE `k + f * m <= SUC(m + k) * f <=> k <= (k + 1) * f`] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `k = k * 1`] THEN MATCH_MP_TAC LE_MULT2 THEN REWRITE_TAC[LE_ADD] THEN REWRITE_TAC[FACT_LT; ARITH_RULE `1 <= x <=> 0 < x`]);; hol-light/100/minkowski.ml000066400000000000000000000337661303454263000156310ustar00rootroot00000000000000(* ========================================================================= *) (* Minkowski's convex body theorem. *) (* ========================================================================= *) needs "Multivariate/measure.ml";; (* ------------------------------------------------------------------------- *) (* An ad hoc lemma. *) (* ------------------------------------------------------------------------- *) let LEMMA = prove (`!f:real^N->bool t s:real^N->bool. FINITE { u | u IN f /\ ~(t u = {})} /\ measurable s /\ &1 < measure s /\ (!u. u IN f ==> measurable(t u)) /\ s SUBSET UNIONS (IMAGE t f) /\ (!u v. u IN f /\ v IN f /\ ~(u = v) ==> DISJOINT (t u) (t v)) /\ (!u. u IN f ==> (IMAGE (\x. x - u) (t u)) SUBSET interval[vec 0,vec 1]) ==> ?u v. u IN f /\ v IN f /\ ~(u = v) /\ ~(DISJOINT (IMAGE (\x. x - u) (t u)) (IMAGE (\x. x - v) (t v)))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN PURE_REWRITE_TAC[NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ ~c /\ ~d) <=> a /\ b /\ ~c ==> d`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\u:real^N. IMAGE (\x:real^N. x - u) (t u)`; `f:real^N->bool`] HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `x - u:real^N = --u + x`] THEN ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ]; ALL_TAC] THEN MP_TAC(ISPECL [`vec 0:real^N`; `vec 1:real^N`] (CONJUNCT1 HAS_MEASURE_INTERVAL)) THEN REWRITE_TAC[CONTENT_UNIT] THEN MATCH_MP_TAC(TAUT `(b /\ a ==> F) ==> a ==> ~b`) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_MEASURE_SUBSET)) THEN ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; REAL_NOT_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&1 < a ==> a <= b ==> &1 < b`)) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(UNIONS (IMAGE (t:real^N->real^N->bool) f))` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `UNIONS (IMAGE (t:real^N->real^N->bool) f) = UNIONS (IMAGE t {u | u IN f /\ ~(t u = {})})` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[NOT_IN_EMPTY]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`t:real^N->real^N->bool`; `f:real^N->bool`] HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; NOT_IMP] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN REWRITE_TAC[VECTOR_ARITH `x - u:real^N = --u + x`] THEN ASM_SIMP_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* This is also interesting, and Minkowski follows easily from it. *) (* ------------------------------------------------------------------------- *) let BLICHFELDT = prove (`!s:real^N->bool. bounded s /\ measurable s /\ &1 < measure s ==> ?x y. x IN s /\ y IN s /\ ~(x = y) /\ !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i - y$i)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{ u:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i) }`; `\u. {x | (x:real^N) IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> (u:real^N)$i <= x$i /\ x$i < u$i + &1 }`; `s:real^N->bool`] LEMMA) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `x - u:real^N = y - v <=> x + (v - u) = y`] THEN REWRITE_TAC[UNWIND_THM1] THEN STRIP_TAC THEN EXISTS_TAC `x + (v - u):real^N` THEN ASM_REWRITE_TAC[VECTOR_ARITH `x = x + (v - u) <=> v:real^N = u`] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `x - (x + v - u):real = u - v`; INTEGER_CLOSED]] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `?N. !x:real^N i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) < &N` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN MP_TAC(SPEC `B:real` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS]; ALL_TAC] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{u:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer (u$i) /\ abs(u$i) <= &N}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN STRIP_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `k:num`]) THEN ASM_SIMP_TAC[] THEN REAL_ARITH_TAC; X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURABLE_ALMOST THEN EXISTS_TAC `s INTER interval[u:real^N,u + vec 1]` THEN ASM_SIMP_TAC[MEASURABLE_INTER_INTERVAL] THEN EXISTS_TAC `interval[u:real^N,u + vec 1] DIFF interval(u,u + vec 1)` THEN REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN MATCH_MP_TAC(SET_RULE `s' SUBSET i /\ j INTER s' = j INTER s ==> (s INTER i) UNION (i DIFF j) = s' UNION (i DIFF j)`) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL; IN_INTER; EXTENSION; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN TRY EQ_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC; REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(lambda i. floor((x:real^N)$i)):real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA; FLOOR]; MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[CART_EQ; REAL_EQ_INTEGERS] THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP; REAL_NOT_LT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[DISJOINT] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `u:real^N` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_INTERVAL] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VEC_COMPONENT] THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The usual form of the theorem. *) (* ------------------------------------------------------------------------- *) let MINKOWSKI = prove (`!s:real^N->bool. convex s /\ bounded s /\ (!x. x IN s ==> (--x) IN s) /\ &2 pow dimindex(:N) < measure s ==> ?u. ~(u = vec 0) /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ u IN s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^N. (&1 / &2) % x) s` BLICHFELDT) THEN ASM_SIMP_TAC[MEASURABLE_SCALING; MEASURE_SCALING; MEASURABLE_CONVEX; BOUNDED_SCALING] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div; REAL_POW_INV] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `inv(&2) % x:real^N = inv(&2) % y <=> x = y`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; GSYM REAL_SUB_LDISTRIB] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `inv(&2) % (u - v):real^N` THEN ASM_SIMP_TAC[VECTOR_ARITH `inv(&2) % (u - v):real^N = vec 0 <=> u = v`] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[VECTOR_SUB; VECTOR_ADD_LDISTRIB] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* A slightly sharper variant for use when the set is also closed. *) (* ------------------------------------------------------------------------- *) let MINKOWSKI_COMPACT = prove (`!s:real^N->bool. convex s /\ compact s /\ (!x. x IN s ==> (--x) IN s) /\ &2 pow dimindex(:N) <= measure s ==> ?u. ~(u = vec 0) /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ u IN s`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; MEASURE_EMPTY; REAL_LT_POW2]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN s` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = inv(&2) % a + inv(&2) % --a`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `{u | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)} DELETE (vec 0:real^N)`] SEPARATE_COMPACT_CLOSED) THEN REWRITE_TAC[EXTENSION; IN_DELETE; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY] THEN MATCH_MP_TAC(TAUT `(~e ==> c) /\ a /\ b /\ (d ==> e) ==> (a /\ b /\ c ==> d) ==> e`) THEN CONJ_TAC THENL [MESON_TAC[]; ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL [MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_DELETE; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[CART_EQ; REAL_NOT_LT; NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((y - x:real^N)$k)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM; VECTOR_SUB_COMPONENT] THEN ASM_MESON_TAC[REAL_EQ_INTEGERS; REAL_NOT_LE]; ALL_TAC] THEN SIMP_TAC[dist] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^N. (&1 + d / &2 / B) % x) s` MINKOWSKI) THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONVEX_SCALING; BOUNDED_SCALING; COMPACT_IMP_BOUNDED] THEN ASM_SIMP_TAC[MEASURABLE_COMPACT; MEASURE_SCALING] THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; IN_IMAGE] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH `--(a % x):real^N = a % y <=> a % (x + y) = vec 0`] THEN ASM_MESON_TAC[VECTOR_ADD_RINV]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d <= m ==> m < n ==> d < n`)) THEN REWRITE_TAC[REAL_ARITH `m < a * m <=> &0 < m * (a - &1)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [ASM_SIMP_TAC[MEASURABLE_COMPACT; MEASURABLE_MEASURE_POS_LT] THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN DISCH_THEN(SUBST_ALL_TAC o MATCH_MP MEASURE_UNIQUE) THEN ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_POW2]; ALL_TAC] THEN REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_POW_LT_1 THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> c /\ b /\ a`] THEN REWRITE_TAC[EXISTS_IN_IMAGE; VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N`; `(&1 + d / &2 / B) % u:real^N`]) THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN REWRITE_TAC[VECTOR_ARITH `u - (&1 + e) % u:real^N = --(e % u)`] THEN REWRITE_TAC[NORM_NEG; NORM_MUL] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(d / &2 / B) * B` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN ASM_REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC);; hol-light/100/morley.ml000066400000000000000000000534521303454263000151170ustar00rootroot00000000000000(* ========================================================================= *) (* Formalization of Alain Connes's paper "A new proof of Morley's theorem". *) (* ========================================================================= *) needs "Library/iter.ml";; needs "Multivariate/geom.ml";; (* ------------------------------------------------------------------------- *) (* Reflection about the line[0,e^{i t}] *) (* ------------------------------------------------------------------------- *) let reflect2d = new_definition `reflect2d t = rotate2d t o cnj o rotate2d(--t)`;; let REFLECT2D_COMPOSE = prove (`!s t. reflect2d s o reflect2d t = rotate2d (&2 * (s - t))`, REWRITE_TAC[FUN_EQ_THM; o_THM; reflect2d] THEN REPEAT GEN_TAC THEN REWRITE_TAC[ROTATE2D_COMPLEX; CNJ_CEXP; CNJ_MUL; CNJ_CNJ] THEN REWRITE_TAC[CNJ_II; CNJ_CX; CNJ_NEG; COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM CEXP_ADD] THEN REWRITE_TAC[CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; CX_MUL] THEN AP_TERM_TAC THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Rotation about point "a" by angle "t". *) (* ------------------------------------------------------------------------- *) let rotate_about = new_definition `rotate_about a t x = a + rotate2d t (x - a)`;; (* ------------------------------------------------------------------------- *) (* Reflection across line (a,b). *) (* ------------------------------------------------------------------------- *) let reflect_across = new_definition `reflect_across (a,b) x = a + reflect2d (Arg(b - a)) (x - a)`;; let REFLECT_ACROSS_COMPOSE = prove (`!a b c. ~(b = a) /\ ~(c = a) ==> reflect_across(a,b) o reflect_across(a,c) = rotate_about a (&2 * Arg((b - a) / (c - a)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[reflect_across; FUN_EQ_THM; o_THM; rotate_about] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN REWRITE_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM] REFLECT2D_COMPOSE] THEN X_GEN_TAC `x:complex` THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_2; ROTATE2D_ADD] THEN ASM_SIMP_TAC[ROTATE2D_SUB_ARG; COMPLEX_SUB_0]);; let REFLECT_ACROSS_COMPOSE_ANGLE = prove (`!a b c. ~(b = a) /\ ~(c = a) /\ &0 <= Im((c - a) / (b - a)) ==> reflect_across(a,c) o reflect_across(a,b) = rotate_about a (&2 * angle(c,a,b))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ANGLE_SYM] THEN ASM_SIMP_TAC[REFLECT_ACROSS_COMPOSE] THEN ASM_SIMP_TAC[angle; VECTOR_ANGLE_ARG; COMPLEX_SUB_0; REAL_SUB_ARG; ARG_LE_PI]);; let REFLECT_ACROSS_COMPOSE_INVOLUTION = prove (`!a b. ~(a = b) ==> reflect_across(a,b) o reflect_across(a,b) = I`, SIMP_TAC[REFLECT_ACROSS_COMPOSE; COMPLEX_DIV_REFL; COMPLEX_SUB_0] THEN REWRITE_TAC[ARG_NUM; REAL_MUL_RZERO; rotate_about; FUN_EQ_THM] THEN REWRITE_TAC[ROTATE2D_ZERO; I_THM] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let REFLECT_ACROSS_SYM = prove (`!a b. reflect_across(a,b) = reflect_across(b,a)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:complex = b` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FUN_EQ_THM; reflect_across; reflect2d; o_THM] THEN REWRITE_TAC[ROTATE2D_COMPLEX; CNJ_CEXP; CNJ_MUL; CNJ_CX; CNJ_II] THEN REWRITE_TAC[CX_NEG; COMPLEX_RING `--ii * --z = ii * z`] THEN SUBGOAL_THEN `cexp(ii * Cx(Arg(b - a))) = (b - a) / Cx(norm(b - a)) /\ cexp(ii * Cx(Arg(a - b))) = (a - b) / Cx(norm(a - b))` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(a = Cx(&0)) /\ a * b = c ==> b = c / a`) THEN ASM_REWRITE_TAC[GSYM ARG; CX_INJ; NORM_EQ_0; VECTOR_SUB_EQ]; REWRITE_TAC[COMPLEX_RING `a * a * cnj b = a pow 2 * cnj b`] THEN SUBST1_TAC(ISPECL [`a:complex`; `b:complex`] NORM_SUB) THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC(COMPLEX_RING `b - a = ((b - a) * n) pow 2 * (cnj za - cnj zb) ==> a + ((b - a) * n) pow 2 * cnj za = b + ((a - b) * n) pow 2 * cnj zb`) THEN REWRITE_TAC[CNJ_SUB; COMPLEX_RING `(z - a) - (z - b):complex = b - a`] THEN MATCH_MP_TAC(COMPLEX_FIELD `(b' - a') * (b - a) = n pow 2 /\ ~(n = Cx(&0)) ==> b - a = ((b - a) * inv n) pow 2 * (b' - a')`) THEN REWRITE_TAC[GSYM CNJ_SUB; COMPLEX_MUL_CNJ; CX_INJ] THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; COMPLEX_SUB_0]]);; (* ------------------------------------------------------------------------- *) (* Some additional lemmas. *) (* ------------------------------------------------------------------------- *) let ITER_ROTATE_ABOUT = prove (`!n a t. ITER n (rotate_about a t) = rotate_about a (&n * t)`, REWRITE_TAC[FUN_EQ_THM; rotate_about] THEN REWRITE_TAC[VECTOR_ARITH `a + b:real^N = a + c <=> b = c`] THEN INDUCT_TAC THEN REWRITE_TAC[ITER_ALT; REAL_MUL_LZERO; ROTATE2D_ZERO] THEN REWRITE_TAC[VECTOR_ARITH `a + x - a:real^N = x`; GSYM REAL_OF_NUM_SUC] THEN ASM_REWRITE_TAC[REAL_ADD_RDISTRIB; ROTATE2D_ADD] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[rotate_about; REAL_MUL_LID] THEN VECTOR_ARITH_TAC);; let REAL_LE_IM_DIV_CYCLIC = prove (`!a b c. &0 <= Im ((c - a) / (b - a)) <=> &0 <= Im((a - b) / (c - b))`, REWRITE_TAC[IM_COMPLEX_DIV_GE_0] THEN REWRITE_TAC[complex_mul; IM; IM_SUB; RE_SUB; IM_CNJ; CNJ_SUB; RE_CNJ] THEN REAL_ARITH_TAC);; let ROTATE_ABOUT_INVERT = prove (`rotate_about a t w = z <=> w = rotate_about a (--t) z`, MATCH_MP_TAC(MESON[] `(!x. f(g x) = x) /\ (!y. g(f y) = y) ==> (f x = y <=> x = g y)`) THEN REWRITE_TAC[rotate_about; VECTOR_ADD_SUB; GSYM ROTATE2D_ADD] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_RINV] THEN REWRITE_TAC[ROTATE2D_ZERO] THEN VECTOR_ARITH_TAC);; let ROTATE_EQ_REFLECT_LEMMA = prove (`!a b z t. ~(b = a) /\ &2 * Arg((b - a) / (z - a)) = t ==> rotate_about a t z = reflect_across (a,b) z`, REPEAT STRIP_TAC THEN REWRITE_TAC[rotate_about; reflect_across] THEN AP_TERM_TAC THEN REWRITE_TAC[ROTATE2D_COMPLEX; reflect2d; o_THM] THEN REWRITE_TAC[CNJ_MUL; COMPLEX_MUL_ASSOC; CNJ_CEXP; CNJ_II] THEN REWRITE_TAC[CNJ_CX; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG; GSYM CEXP_ADD; CX_NEG] THEN REWRITE_TAC[COMPLEX_RING `ii * a + ii * a = ii * Cx(&2) * a`] THEN ASM_CASES_TAC `z:complex = a` THEN ASM_REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; COMPLEX_SUB_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (COMPLEX_RING `~(z = a) ==> c * (z - a) pow 2 = b * cnj (z - a) * (z - a) ==> c * (z - a) = b * cnj(z - a)`)) THEN REWRITE_TAC[COMPLEX_MUL_CNJ] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [ARG] THEN MATCH_MP_TAC(COMPLEX_RING `(e1:complex) * e2 pow 2 = e3 ==> e1 * (n * e2) pow 2 = e3 * n pow 2`) THEN REWRITE_TAC[GSYM CEXP_ADD; GSYM CEXP_N; CEXP_EQ] THEN REWRITE_TAC[COMPLEX_RING `ii * t + Cx(&2) * ii * z = ii * u + v * ii <=> t + Cx(&2) * z - u = v`] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; GSYM CX_ADD; CX_INJ] THEN EXPAND_TAC "t" THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_ARITH `&2 * a = &2 * b <=> a = b`] THEN ONCE_REWRITE_TAC[REAL_ARITH `a + (b - c):real = a - (c - b)`] THEN ASM_SIMP_TAC[REAL_SUB_ARG; COMPLEX_SUB_0] THEN COND_CASES_TAC THENL [EXISTS_TAC `&0`; EXISTS_TAC `&2`] THEN SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let ROTATE_EQ_REFLECT_PI_LEMMA = prove (`!a b z t. ~(b = a) /\ &2 * Arg((b - a) / (z - a)) = &4 * pi + t ==> rotate_about a t z = reflect_across (a,b) z`, REWRITE_TAC[REAL_ARITH `a = &4 * pi + t <=> t = a + --(&4 * pi)`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `rotate_about a (&2 * Arg((b - a) / (z - a))) z` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC ROTATE_EQ_REFLECT_LEMMA THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[rotate_about; ROTATE2D_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[ROTATE2D_COMPLEX] THEN REWRITE_TAC[EULER; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; COS_NEG; SIN_NEG] THEN REWRITE_TAC[SIN_NPI; COS_NPI; REAL_EXP_NEG; REAL_EXP_0; CX_NEG] THEN REWRITE_TAC[COMPLEX_NEG_0; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Algebraic characterization of equilateral triangle. *) (* ------------------------------------------------------------------------- *) let EQUILATERAL_TRIANGLE_ALGEBRAIC = prove (`!A B C j. j pow 3 = Cx(&1) /\ ~(j = Cx(&1)) /\ A + j * B + j pow 2 * C = Cx(&0) ==> dist(A,B) = dist(B,C) /\ dist(C,A) = dist(B,C)`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[dist] THEN SUBGOAL_THEN `C - A:complex = j * (B - C) /\ A - B = j pow 2 * (B - C)` (CONJUNCTS_THEN SUBST1_TAC) THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN SUBGOAL_THEN `norm(j pow 3) = &1` MP_TAC THENL [ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]; REWRITE_TAC[COMPLEX_NORM_POW; REAL_POW_EQ_1; ARITH; REAL_ABS_NORM] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1)] THEN ASM_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The main algebraic lemma. *) (* ------------------------------------------------------------------------- *) let AFFINE_GROUP_ITER_3 = prove (`ITER 3 (\z. a * z + b) = (\z. a pow 3 * z + b * (Cx(&1) + a + a pow 2))`, REWRITE_TAC[TOP_DEPTH_CONV num_CONV `3`] THEN REWRITE_TAC[ITER; FUN_EQ_THM] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC COMPLEX_RING);; let AFFINE_GROUP_COMPOSE = prove (`(\z. a1 * z + b1) o (\z. a2 * z + b2) = (\z. (a1 * a2) * z + (b1 + a1 * b2))`, REWRITE_TAC[o_THM; FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING);; let AFFINE_GROUP_I = prove (`I = (\z. Cx(&1) * z + Cx(&0))`, REWRITE_TAC[I_THM; FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING);; let AFFINE_GROUP_EQ = prove (`!a b a' b. (\z. a * z + b) = (\z. a' * z + b') <=> a = a' /\ b = b'`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[FUN_EQ_THM] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&1)`) THEN CONV_TAC COMPLEX_RING);; let AFFINE_GROUP_ROTATE_ABOUT = prove (`!a t. rotate_about a t = (\z. cexp(ii * Cx(t)) * z + (Cx(&1) - cexp(ii * Cx(t))) * a)`, REWRITE_TAC[rotate_about; FUN_EQ_THM; ROTATE2D_COMPLEX] THEN CONV_TAC COMPLEX_RING);; let ALGEBRAIC_LEMMA = prove (`!a1 a2 a3 b1 b2 b3 A B C. (\z. a3 * z + b3) ((\z. a1 * z + b1) B) = B /\ (\z. a1 * z + b1) ((\z. a2 * z + b2) C) = C /\ (\z. a2 * z + b2) ((\z. a3 * z + b3) A) = A /\ ITER 3 (\z. a1 * z + b1) o ITER 3 (\z. a2 * z + b2) o ITER 3 (\z. a3 * z + b3) = I /\ ~(a1 * a2 * a3 = Cx(&1)) /\ ~(a1 * a2 = Cx(&1)) /\ ~(a2 * a3 = Cx(&1)) /\ ~(a3 * a1 = Cx(&1)) ==> (a1 * a2 * a3) pow 3 = Cx (&1) /\ ~(a1 * a2 * a3 = Cx (&1)) /\ C + (a1 * a2 * a3) * A + (a1 * a2 * a3) pow 2 * B = Cx(&0)`, REWRITE_TAC[AFFINE_GROUP_ITER_3; AFFINE_GROUP_COMPOSE; AFFINE_GROUP_I; AFFINE_GROUP_EQ] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN SUBGOAL_THEN `(a1 * a2 * a3) * a1 pow 2 * a2 * (a1 - a1 * a2 * a3) * (a2 - a1 * a2 * a3) * (a3 - a1 * a2 * a3) * (C + (a1 * a2 * a3) * A + (a1 * a2 * a3) pow 2 * B) = Cx(&0)` MP_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP (COMPLEX_FIELD `a3 * (a1 * B + b1) + b3 = B ==> ~(a1 * a3 = Cx(&1)) ==> B = (a3 * b1 + b3) / (Cx(&1) - a1 * a3)`))) THEN REPEAT(ANTS_TAC THENL [ASM_MESON_TAC[COMPLEX_MUL_SYM]; DISCH_THEN SUBST1_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (COMPLEX_RING `s = Cx(&0) ==> s + t = Cx(&0) ==> t = Cx(&0)`)); REWRITE_TAC[COMPLEX_ENTIRE]] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD);; (* ------------------------------------------------------------------------- *) (* A tactic to avoid some duplication over cyclic permutations. *) (* ------------------------------------------------------------------------- *) let CYCLIC_PERM_SUBGOAL_THEN = let lemma = MESON[] `(!A B C P Q R a b c g1 g2 g3. Ant A B C P Q R a b c g1 g2 g3 ==> Cns A B C P Q R a b c g1 g2 g3) ==> (!A B C P Q R a b c g1 g2 g3. Ant A B C P Q R a b c g1 g2 g3 ==> Ant B C A Q R P b c a g2 g3 g1) ==> (!A B C P Q R a b c g1 g2 g3. Ant A B C P Q R a b c g1 g2 g3 ==> Cns A B C P Q R a b c g1 g2 g3 /\ Cns B C A Q R P b c a g2 g3 g1 /\ Cns C A B R P Q c a b g3 g1 g2)` and vars = [`A:complex`; `B:complex`; `C:complex`; `P:complex`; `Q:complex`; `R:complex`; `a:real`; `b:real`; `c:real`; `g1:complex->complex`; `g2:complex->complex`; `g3:complex->complex`] in fun t ttac (asl,w) -> let asm = list_mk_conj (map (concl o snd) (rev asl)) in let gnw = list_mk_forall(vars,mk_imp(asm,t)) in let th1 = MATCH_MP lemma (ASSUME gnw) in let tm1 = fst(dest_imp(concl th1)) in let th2 = REWRITE_CONV[INSERT_AC; CONJ_ACI; ANGLE_SYM; EQ_SYM_EQ] tm1 in let th3 = DISCH_ALL(MP th1 (EQT_ELIM th2)) in (MP_TAC th3 THEN ANTS_TAC THENL [POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT GEN_TAC THEN STRIP_TAC; DISCH_THEN(MP_TAC o SPEC_ALL) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_THEN(CONJUNCTS_THEN2 ttac MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN ttac)]]) (asl,w);; (* ------------------------------------------------------------------------- *) (* Morley's theorem a la Connes. *) (* ------------------------------------------------------------------------- *) let MORLEY = prove (`!A B C:real^2 P Q R. ~collinear{A,B,C} /\ {P,Q,R} SUBSET convex hull {A,B,C} /\ angle(A,B,R) = angle(A,B,C) / &3 /\ angle(B,A,R) = angle(B,A,C) / &3 /\ angle(B,C,P) = angle(B,C,A) / &3 /\ angle(C,B,P) = angle(C,B,A) / &3 /\ angle(C,A,Q) = angle(C,A,B) / &3 /\ angle(A,C,Q) = angle(A,C,B) / &3 ==> dist(R,P) = dist(P,Q) /\ dist(Q,R) = dist(P,Q)`, MATCH_MP_TAC(MESON[] `(!A B C. &0 <= Im((C - A) / (B - A)) \/ &0 <= Im((B - A) / (C - A))) /\ (!A B C. Property A B C ==> Property A C B) /\ (!A B C. &0 <= Im((C - A) / (B - A)) ==> Property A B C) ==> !A B C. Property A B C`) THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM IM_COMPLEX_INV_LE_0] THEN REWRITE_TAC[COMPLEX_INV_DIV] THEN REAL_ARITH_TAC; REPEAT GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`P:real^2`; `Q:real^2`; `R:real^2`] THEN REWRITE_TAC[ANGLE_SYM; DIST_SYM; INSERT_AC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`P:real^2`; `R:real^2`; `Q:real^2`]) THEN REWRITE_TAC[ANGLE_SYM; DIST_SYM; INSERT_AC] THEN MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC]) [`A:real^2 = B`; `A:real^2 = C`; `B:real^2 = C`] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> let th' = GEN_REWRITE_RULE I [REAL_LE_IM_DIV_CYCLIC] th in let th'' = GEN_REWRITE_RULE I [REAL_LE_IM_DIV_CYCLIC] th' in ASSUME_TAC th' THEN ASSUME_TAC th'') THEN ABBREV_TAC `a = angle(C:real^2,A,B) / &3` THEN ABBREV_TAC `b = angle(A:real^2,B,C) / &3` THEN ABBREV_TAC `c = angle(B:real^2,C,A) / &3` THEN ABBREV_TAC `g1 = rotate_about A (&2 * a)` THEN ABBREV_TAC `g2 = rotate_about B (&2 * b)` THEN ABBREV_TAC `g3 = rotate_about C (&2 * c)` THEN CYCLIC_PERM_SUBGOAL_THEN `ITER 3 g1 o ITER 3 g2 o ITER 3 g3 = (I:real^2->real^2)` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["g1"; "g2"; "g3"] THEN REWRITE_TAC[ITER_ROTATE_ABOUT] THEN MAP_EVERY EXPAND_TAC ["a"; "b"; "c"] THEN REWRITE_TAC[REAL_ARITH `&3 * &2 * a / &3 = &2 * a`] THEN ASM_SIMP_TAC[GSYM REFLECT_ACROSS_COMPOSE_ANGLE] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; REFLECT_ACROSS_SYM] THEN ASM_SIMP_TAC[REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM] REFLECT_ACROSS_COMPOSE_INVOLUTION]; ALL_TAC] THEN CYCLIC_PERM_SUBGOAL_THEN `&0 <= Im((P - B) / (C - B))` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INSERT_SUBSET]) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[CONVEX_HULL_3; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[VECTOR_ARITH `(u % A + v % B + w % C) - B:real^N = u % (A - B) + w % (C - B) + ((u + v + w) - &1) % B`] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB; IM_ADD; COMPLEX_CMUL] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[IM_MUL_CX; COMPLEX_DIV_REFL; COMPLEX_SUB_0; IM_CX] THEN SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN CYCLIC_PERM_SUBGOAL_THEN `&0 <= Im((B - C) / (P - C))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM IM_COMPLEX_INV_LE_0; COMPLEX_INV_DIV] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INSERT_SUBSET]) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[CONVEX_HULL_3; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[VECTOR_ARITH `(u % A + v % B + w % C) - C:real^N = v % (B - C) + u % (A - C) + ((u + v + w) - &1) % C`] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB; IM_ADD; COMPLEX_CMUL] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[IM_MUL_CX; COMPLEX_DIV_REFL; COMPLEX_SUB_0; IM_CX] THEN SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= u * --a ==> u * a <= &0`) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `&0 <= --x <=> x <= &0`] THEN ASM_REWRITE_TAC[GSYM IM_COMPLEX_INV_GE_0; COMPLEX_INV_DIV]; ALL_TAC] THEN CYCLIC_PERM_SUBGOAL_THEN `~(P:real^2 = B) /\ ~(P = C)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `!x y z. ~(angle(x:real^2,y,z) / &3 = pi / &2)` (fun th -> ASM_MESON_TAC[th; ANGLE_REFL]) THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a <= pi /\ &0 < pi ==> ~(a / &3 = pi / &2)`) THEN REWRITE_TAC[ANGLE_RANGE; PI_POS]; ALL_TAC] THEN CYCLIC_PERM_SUBGOAL_THEN `(g3:complex->complex)(g1(Q)) = Q` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["g1"; "g3"] THEN ONCE_REWRITE_TAC[ROTATE_ABOUT_INVERT] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `reflect_across(A,C) Q` THEN CONJ_TAC THENL [MATCH_MP_TAC ROTATE_EQ_REFLECT_LEMMA THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [SYM(ASSUME `angle(C:real^2,A,Q) = a`)] THEN REWRITE_TAC[angle] THEN ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN ASM_SIMP_TAC[VECTOR_ANGLE_ARG; COMPLEX_SUB_0]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[REFLECT_ACROSS_SYM] THEN MATCH_MP_TAC ROTATE_EQ_REFLECT_PI_LEMMA THEN ASM_REWRITE_TAC[GSYM REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_ARITH `&2 * a = &4 * pi + &2 * --c <=> a = &2 * pi - c`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM(ASSUME `angle(B:real^2,C,A) / &3 = c`)] THEN ONCE_REWRITE_TAC[ANGLE_SYM] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[angle] THEN ASM_SIMP_TAC[VECTOR_ANGLE_ARG; COMPLEX_SUB_0] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_INV_DIV] THEN MATCH_MP_TAC ARG_INV THEN REWRITE_TAC[GSYM ARG_EQ_0] THEN DISCH_TAC THEN SUBGOAL_THEN `angle(A:real^2,C,Q) = &0` MP_TAC THENL [REWRITE_TAC[angle] THEN ASM_SIMP_TAC[VECTOR_ANGLE_ARG; COMPLEX_SUB_0]; ASM_REWRITE_TAC[REAL_ARITH `a / &3 = &0 <=> a = &0`]] THEN ASM_MESON_TAC[COLLINEAR_ANGLE; ANGLE_SYM; INSERT_AC]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [AFFINE_GROUP_ROTATE_ABOUT])) THEN CYCLIC_PERM_SUBGOAL_THEN `~(cexp(ii * Cx(&2 * a)) * cexp(ii * Cx(&2 * b)) = Cx(&1)) /\ ~(cexp(ii * Cx(&2 * a)) * cexp(ii * Cx(&2 * b)) * cexp(ii * Cx(&2 * c)) = Cx(&1))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM CEXP_ADD; GSYM COMPLEX_ADD_LDISTRIB; GSYM CX_ADD] THEN MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 < pi /\ &3 * a + &3 * b + &3 * c = pi /\ ~(&3 * c = pi) ==> (&0 < &2 * a + &2 * b /\ &2 * a + &2 * b < &2 * pi) /\ (&0 < &2 * a + &2 * b + &2 * c /\ &2 * a + &2 * b + &2 * c < &2 * pi)`) THEN ANTS_TAC THENL [MAP_EVERY EXPAND_TAC ["a"; "b"; "c"] THEN REWRITE_TAC[REAL_ARITH `&3 * x / &3 = x`; PI_POS] THEN SIMP_TAC[ANGLE_RANGE; REAL_LE_DIV; REAL_POS] THEN CONJ_TAC THENL [ASM_MESON_TAC[TRIANGLE_ANGLE_SUM; ADD_AC; ANGLE_SYM]; ASM_MESON_TAC[COLLINEAR_ANGLE; ANGLE_SYM; INSERT_AC]]; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN REWRITE_TAC[CEXP_II_NE_1; GSYM CX_ADD]]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`a1 = cexp(ii * Cx(&2 * a))`; `a2 = cexp(ii * Cx(&2 * b))`; `a3 = cexp(ii * Cx(&2 * c))`; `b1 = (Cx (&1) - a1) * A`; `b2 = (Cx (&1) - a2) * B`; `b3 = (Cx (&1) - a3) * C`] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC EQUILATERAL_TRIANGLE_ALGEBRAIC THEN EXISTS_TAC `a1 * a2 * a3:complex` THEN MATCH_MP_TAC ALGEBRAIC_LEMMA THEN MAP_EVERY EXISTS_TAC [`b1:complex`; `b2:complex`; `b3:complex`] THEN PURE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[]);; hol-light/100/pascal.ml000066400000000000000000000637221303454263000150540ustar00rootroot00000000000000(* ========================================================================= *) (* Pascal's hexagon theorem for projective and affine planes. *) (* ========================================================================= *) needs "Multivariate/cross.ml";; (* ------------------------------------------------------------------------- *) (* A lemma we want to justify some of the axioms. *) (* ------------------------------------------------------------------------- *) let NORMAL_EXISTS = prove (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN MP_TAC(ISPEC `{u:real^3,v}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; DIMINDEX_3] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD {u:real^3,v}` THEN CONJ_TAC THEN SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_EMPTY] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Type of directions. *) (* ------------------------------------------------------------------------- *) let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") (MESON[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] `?x:real^3. ~(x = vec 0)`);; parse_as_infix("||",(11,"right"));; parse_as_infix("_|_",(11,"right"));; let perpdir = new_definition `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; let pardir = new_definition `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; let DIRECTION_CLAUSES = prove (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, MESON_TAC[direction_tybij]);; let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) (`(!x. x || x) /\ (!x y. x || y <=> y || x) /\ (!x y z. x || y /\ y || z ==> x || z)`, REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let PARDIR_EQUIV = prove (`!x y. ((||) x = (||) y) <=> x || y`, REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS]);; let DIRECTION_AXIOM_1 = prove (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_2 = prove (`!l l'. ?p. p _|_ l /\ p _|_ l'`, REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; let DIRECTION_AXIOM_3 = prove (`?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN MAP_EVERY (fun t -> EXISTS_TAC t THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_3; ARITH]) [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN VEC3_TAC);; let DIRECTION_AXIOM_4_WEAK = prove (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 2) cross (l cross basis 3) = vec 0)` MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; let ORTHOGONAL_COMBINE = prove (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_4 = prove (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ p _|_ l /\ p' _|_ l /\ p'' _|_ l`, MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; let PERPDIR_WELLDEF = prove (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let perpl,perpl_th = lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) "perpl" PERPDIR_WELLDEF;; let line_lift_thm = lift_theorem line_tybij (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; let point_tybij = new_type_definition "point" ("mk_point","dest_point") (prove(`?x:line. T`,REWRITE_TAC[]));; parse_as_infix("on",(11,"right"));; let on = new_definition `p on l <=> perpl (dest_point p) l`;; let POINT_CLAUSES = prove (`((p = p') <=> (dest_point p = dest_point p')) /\ ((!p. P (dest_point p)) <=> (!l. P l)) /\ ((?p. P (dest_point p)) <=> (?l. P l))`, MESON_TAC[point_tybij]);; let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; let AXIOM_1 = prove (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ !l'. p on l' /\ p' on l' ==> (l' = l)`, POINT_TAC LINE_AXIOM_1);; let AXIOM_2 = prove (`!l l'. ?p. p on l /\ p on l'`, POINT_TAC LINE_AXIOM_2);; let AXIOM_3 = prove (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p on l /\ p' on l /\ p'' on l)`, POINT_TAC LINE_AXIOM_3);; let AXIOM_4 = prove (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p on l /\ p' on l /\ p'' on l`, POINT_TAC LINE_AXIOM_4);; (* ------------------------------------------------------------------------- *) (* Mappings from vectors in R^3 to projective lines and points. *) (* ------------------------------------------------------------------------- *) let projl = new_definition `projl x = mk_line((||) (mk_dir x))`;; let projp = new_definition `projp x = mk_point(projl x)`;; (* ------------------------------------------------------------------------- *) (* Mappings in the other direction, to (some) homogeneous coordinates. *) (* ------------------------------------------------------------------------- *) let PROJL_TOTAL = prove (`!l. ?x. ~(x = vec 0) /\ l = projl x`, GEN_TAC THEN SUBGOAL_THEN `?d. l = mk_line((||) d)` (CHOOSE_THEN SUBST1_TAC) THENL [MESON_TAC[fst line_tybij; snd line_tybij]; REWRITE_TAC[projl] THEN EXISTS_TAC `dest_dir d` THEN MESON_TAC[direction_tybij]]);; let homol = new_specification ["homol"] (REWRITE_RULE[SKOLEM_THM] PROJL_TOTAL);; let PROJP_TOTAL = prove (`!p. ?x. ~(x = vec 0) /\ p = projp x`, REWRITE_TAC[projp] THEN MESON_TAC[PROJL_TOTAL; point_tybij]);; let homop_def = new_definition `homop p = homol(dest_point p)`;; let homop = prove (`!p. ~(homop p = vec 0) /\ p = projp(homop p)`, GEN_TAC THEN REWRITE_TAC[homop_def; projp; MESON[point_tybij] `p = mk_point l <=> dest_point p = l`] THEN MATCH_ACCEPT_TAC homol);; (* ------------------------------------------------------------------------- *) (* Key equivalences of concepts in projective space and homogeneous coords. *) (* ------------------------------------------------------------------------- *) let parallel = new_definition `parallel x y <=> x cross y = vec 0`;; let ON_HOMOL = prove (`!p l. p on l <=> orthogonal (homop p) (homol l)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homop; homol] THEN REWRITE_TAC[on; projp; projl; REWRITE_RULE[] point_tybij] THEN REWRITE_TAC[GSYM perpl_th; perpdir] THEN BINOP_TAC THEN MESON_TAC[homol; homop; direction_tybij]);; let EQ_HOMOL = prove (`!l l'. l = l' <=> parallel (homol l) (homol l')`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [homol] THEN REWRITE_TAC[projl; MESON[fst line_tybij; snd line_tybij] `mk_line((||) l) = mk_line((||) l') <=> (||) l = (||) l'`] THEN REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir; parallel] THEN MESON_TAC[homol; direction_tybij]);; let EQ_HOMOP = prove (`!p p'. p = p' <=> parallel (homop p) (homop p')`, REWRITE_TAC[homop_def; GSYM EQ_HOMOL] THEN MESON_TAC[point_tybij]);; (* ------------------------------------------------------------------------- *) (* A "welldefinedness" result for homogeneous coordinate map. *) (* ------------------------------------------------------------------------- *) let PARALLEL_PROJL_HOMOL = prove (`!x. parallel x (homol(projl x))`, GEN_TAC THEN REWRITE_TAC[parallel] THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN ASM_REWRITE_TAC[CROSS_0] THEN MP_TAC(ISPEC `projl x` homol) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [projl] THEN DISCH_THEN(MP_TAC o AP_TERM `dest_line`) THEN REWRITE_TAC[MESON[fst line_tybij; snd line_tybij] `dest_line(mk_line((||) l)) = (||) l`] THEN REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir] THEN ASM_MESON_TAC[direction_tybij]);; let PARALLEL_PROJP_HOMOP = prove (`!x. parallel x (homop(projp x))`, REWRITE_TAC[homop_def; projp; REWRITE_RULE[] point_tybij] THEN REWRITE_TAC[PARALLEL_PROJL_HOMOL]);; let PARALLEL_PROJP_HOMOP_EXPLICIT = prove (`!x. ~(x = vec 0) ==> ?a. ~(a = &0) /\ homop(projp x) = a % x`, MP_TAC PARALLEL_PROJP_HOMOP THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[parallel; CROSS_EQ_0; COLLINEAR_LEMMA] THEN GEN_TAC THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN ASM_REWRITE_TAC[homop] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[homop; VECTOR_MUL_LZERO]);; (* ------------------------------------------------------------------------- *) (* Brackets, collinearity and their connection. *) (* ------------------------------------------------------------------------- *) let bracket = define `bracket[a;b;c] = det(vector[homop a;homop b;homop c])`;; let COLLINEAR = new_definition `COLLINEAR s <=> ?l. !p. p IN s ==> p on l`;; let COLLINEAR_SINGLETON = prove (`!a. COLLINEAR {a}`, REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[AXIOM_1; AXIOM_3]);; let COLLINEAR_PAIR = prove (`!a b. COLLINEAR{a,b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:point = b` THEN ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SINGLETON] THEN REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[AXIOM_1]);; let COLLINEAR_TRIPLE = prove (`!a b c. COLLINEAR{a,b,c} <=> ?l. a on l /\ b on l /\ c on l`, REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY]);; let COLLINEAR_BRACKET = prove (`!p1 p2 p3. COLLINEAR {p1,p2,p3} <=> bracket[p1;p2;p3] = &0`, let lemma = prove (`!a b c x y. x cross y = vec 0 /\ ~(x = vec 0) /\ orthogonal a x /\ orthogonal b x /\ orthogonal c x ==> orthogonal a y /\ orthogonal b y /\ orthogonal c y`, REWRITE_TAC[orthogonal] THEN VEC3_TAC) in REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[COLLINEAR_TRIPLE; bracket; ON_HOMOL; LEFT_IMP_EXISTS_THM] THEN MP_TAC homol THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[DET_3; orthogonal; DOT_3; VECTOR_3; CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT] THEN CONV_TAC REAL_RING; ASM_CASES_TAC `p1:point = p2` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_PAIR]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[parallel; COLLINEAR_TRIPLE; bracket; EQ_HOMOP; ON_HOMOL] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `mk_line((||) (mk_dir(homop p1 cross homop p2)))` THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `homop p1 cross homop p2` THEN ASM_REWRITE_TAC[ORTHOGONAL_CROSS] THEN REWRITE_TAC[orthogonal] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ONCE_REWRITE_TAC[CROSS_TRIPLE] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[DOT_CROSS_DET] THEN REWRITE_TAC[GSYM projl; GSYM parallel; PARALLEL_PROJL_HOMOL]]);; (* ------------------------------------------------------------------------- *) (* Conics and bracket condition for 6 points to be on a conic. *) (* ------------------------------------------------------------------------- *) let homogeneous_conic = new_definition `homogeneous_conic con <=> ?a b c d e f. ~(a = &0 /\ b = &0 /\ c = &0 /\ d = &0 /\ e = &0 /\ f = &0) /\ con = {x:real^3 | a * x$1 pow 2 + b * x$2 pow 2 + c * x$3 pow 2 + d * x$1 * x$2 + e * x$1 * x$3 + f * x$2 * x$3 = &0}`;; let projective_conic = new_definition `projective_conic con <=> ?c. homogeneous_conic c /\ con = {p | (homop p) IN c}`;; let HOMOGENEOUS_CONIC_BRACKET = prove (`!con x1 x2 x3 x4 x5 x6. homogeneous_conic con /\ x1 IN con /\ x2 IN con /\ x3 IN con /\ x4 IN con /\ x5 IN con /\ x6 IN con ==> det(vector[x6;x1;x4]) * det(vector[x6;x2;x3]) * det(vector[x5;x1;x3]) * det(vector[x5;x2;x4]) = det(vector[x6;x1;x3]) * det(vector[x6;x2;x4]) * det(vector[x5;x1;x4]) * det(vector[x5;x2;x3])`, REPEAT GEN_TAC THEN REWRITE_TAC[homogeneous_conic; EXTENSION] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[IN_ELIM_THM; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; let PROJECTIVE_CONIC_BRACKET = prove (`!con p1 p2 p3 p4 p5 p6. projective_conic con /\ p1 IN con /\ p2 IN con /\ p3 IN con /\ p4 IN con /\ p5 IN con /\ p6 IN con ==> bracket[p6;p1;p4] * bracket[p6;p2;p3] * bracket[p5;p1;p3] * bracket[p5;p2;p4] = bracket[p6;p1;p3] * bracket[p6;p2;p4] * bracket[p5;p1;p4] * bracket[p5;p2;p3]`, REPEAT GEN_TAC THEN REWRITE_TAC[bracket; projective_conic] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC HOMOGENEOUS_CONIC_BRACKET THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Pascal's theorem with all the nondegeneracy principles we use directly. *) (* ------------------------------------------------------------------------- *) let PASCAL_DIRECT = prove (`!con x1 x2 x3 x4 x5 x6 x6 x8 x9. ~COLLINEAR {x2,x5,x7} /\ ~COLLINEAR {x1,x2,x5} /\ ~COLLINEAR {x1,x3,x6} /\ ~COLLINEAR {x2,x4,x6} /\ ~COLLINEAR {x3,x4,x5} /\ ~COLLINEAR {x1,x5,x7} /\ ~COLLINEAR {x2,x5,x9} /\ ~COLLINEAR {x1,x2,x6} /\ ~COLLINEAR {x3,x6,x8} /\ ~COLLINEAR {x2,x4,x5} /\ ~COLLINEAR {x2,x4,x7} /\ ~COLLINEAR {x2,x6,x8} /\ ~COLLINEAR {x3,x4,x6} /\ ~COLLINEAR {x3,x5,x8} /\ ~COLLINEAR {x1,x3,x5} ==> projective_conic con /\ x1 IN con /\ x2 IN con /\ x3 IN con /\ x4 IN con /\ x5 IN con /\ x6 IN con /\ COLLINEAR {x1,x9,x5} /\ COLLINEAR {x1,x8,x6} /\ COLLINEAR {x2,x9,x4} /\ COLLINEAR {x2,x7,x6} /\ COLLINEAR {x3,x8,x4} /\ COLLINEAR {x3,x7,x5} ==> COLLINEAR {x7,x8,x9}`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e /\ f /\ g /\ h ==> p <=> a /\ b /\ c /\ d /\ e /\ f /\ g ==> h ==> p`] THEN DISCH_THEN(MP_TAC o MATCH_MP PROJECTIVE_CONIC_BRACKET) THEN REWRITE_TAC[COLLINEAR_BRACKET; IMP_IMP; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `!q. (p ==> q) /\ (q ==> r) ==> p ==> r`) THEN EXISTS_TAC `bracket[x1;x2;x5] * bracket[x1;x3;x6] * bracket[x2;x4;x6] * bracket[x3;x4;x5] = bracket[x1;x2;x6] * bracket[x1;x3;x5] * bracket[x2;x4;x5] * bracket[x3;x4;x6] /\ bracket[x1;x5;x7] * bracket[x2;x5;x9] = --bracket[x1;x2;x5] * bracket[x5;x9;x7] /\ bracket[x1;x2;x6] * bracket[x3;x6;x8] = bracket[x1;x3;x6] * bracket[x2;x6;x8] /\ bracket[x2;x4;x5] * bracket[x2;x9;x7] = --bracket[x2;x4;x7] * bracket[x2;x5;x9] /\ bracket[x2;x4;x7] * bracket[x2;x6;x8] = --bracket[x2;x4;x6] * bracket[x2;x8;x7] /\ bracket[x3;x4;x6] * bracket[x3;x5;x8] = bracket[x3;x4;x5] * bracket[x3;x6;x8] /\ bracket[x1;x3;x5] * bracket[x5;x8;x7] = --bracket[x1;x5;x7] * bracket[x3;x5;x8]` THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ] THEN REPEAT(ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING `a = b /\ x:real = y ==> a * x = b * y`))) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_NEG_NEG] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BRACKET]) THEN REWRITE_TAC[REAL_MUL_AC] THEN ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* With longer but more intuitive non-degeneracy conditions, basically that *) (* the 6 points divide into two groups of 3 and no 3 are collinear unless *) (* they are all in the same group. *) (* ------------------------------------------------------------------------- *) let PASCAL = prove (`!con x1 x2 x3 x4 x5 x6 x6 x8 x9. ~COLLINEAR {x1,x2,x4} /\ ~COLLINEAR {x1,x2,x5} /\ ~COLLINEAR {x1,x2,x6} /\ ~COLLINEAR {x1,x3,x4} /\ ~COLLINEAR {x1,x3,x5} /\ ~COLLINEAR {x1,x3,x6} /\ ~COLLINEAR {x2,x3,x4} /\ ~COLLINEAR {x2,x3,x5} /\ ~COLLINEAR {x2,x3,x6} /\ ~COLLINEAR {x4,x5,x1} /\ ~COLLINEAR {x4,x5,x2} /\ ~COLLINEAR {x4,x5,x3} /\ ~COLLINEAR {x4,x6,x1} /\ ~COLLINEAR {x4,x6,x2} /\ ~COLLINEAR {x4,x6,x3} /\ ~COLLINEAR {x5,x6,x1} /\ ~COLLINEAR {x5,x6,x2} /\ ~COLLINEAR {x5,x6,x3} ==> projective_conic con /\ x1 IN con /\ x2 IN con /\ x3 IN con /\ x4 IN con /\ x5 IN con /\ x6 IN con /\ COLLINEAR {x1,x9,x5} /\ COLLINEAR {x1,x8,x6} /\ COLLINEAR {x2,x9,x4} /\ COLLINEAR {x2,x7,x6} /\ COLLINEAR {x3,x8,x4} /\ COLLINEAR {x3,x7,x5} ==> COLLINEAR {x7,x8,x9}`, REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_THEN(fun th -> MATCH_MP_TAC(TAUT `(~p ==> p) ==> p`) THEN DISCH_TAC THEN MP_TAC th THEN MATCH_MP_TAC PASCAL_DIRECT THEN ASSUME_TAC(funpow 7 CONJUNCT2 th)) THEN REPEAT CONJ_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[COLLINEAR_BRACKET; bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Homogenization and hence mapping from affine to projective plane. *) (* ------------------------------------------------------------------------- *) let homogenize = new_definition `(homogenize:real^2->real^3) x = vector[x$1; x$2; &1]`;; let projectivize = new_definition `projectivize = projp o homogenize`;; let HOMOGENIZE_NONZERO = prove (`!x. ~(homogenize x = vec 0)`, REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT; VECTOR_3; homogenize] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Conic in affine plane. *) (* ------------------------------------------------------------------------- *) let affine_conic = new_definition `affine_conic con <=> ?a b c d e f. ~(a = &0 /\ b = &0 /\ c = &0 /\ d = &0 /\ e = &0 /\ f = &0) /\ con = {x:real^2 | a * x$1 pow 2 + b * x$2 pow 2 + c * x$1 * x$2 + d * x$1 + e * x$2 + f = &0}`;; (* ------------------------------------------------------------------------- *) (* Relationships between affine and projective notions. *) (* ------------------------------------------------------------------------- *) let COLLINEAR_PROJECTIVIZE = prove (`!a b c. collinear{a,b,c} <=> COLLINEAR{projectivize a,projectivize b,projectivize c}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN REWRITE_TAC[COLLINEAR_BRACKET; projectivize; o_THM; bracket] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `det(vector[homogenize a; homogenize b; homogenize c]) = &0` THEN CONJ_TAC THENL [REWRITE_TAC[homogenize; DOT_2; VECTOR_SUB_COMPONENT; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING; MAP_EVERY (MP_TAC o C SPEC PARALLEL_PROJP_HOMOP) [`homogenize a`; `homogenize b`; `homogenize c`] THEN MAP_EVERY (MP_TAC o C SPEC HOMOGENIZE_NONZERO) [`a:real^2`; `b:real^2`; `c:real^2`] THEN MAP_EVERY (MP_TAC o CONJUNCT1 o C SPEC homop) [`projp(homogenize a)`; `projp(homogenize b)`; `projp(homogenize c)`] THEN REWRITE_TAC[parallel; cross; CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3; DET_3; VEC_COMPONENT] THEN CONV_TAC REAL_RING]);; let AFFINE_PROJECTIVE_CONIC = prove (`!con. affine_conic con <=> ?con'. projective_conic con' /\ con = {x | projectivize x IN con'}`, REWRITE_TAC[affine_conic; projective_conic; homogeneous_conic] THEN GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(?con' con a b c d e f. P con' con a b c d e f) <=> (?a b d e f c con' con. P con' con a b c d e f)`] THEN MAP_EVERY (fun s -> AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC(mk_var(s,`:real`)) THEN REWRITE_TAC[]) ["a"; "b"; "c"; "d"; "e"; "f"] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; GSYM CONJ_ASSOC] THEN REWRITE_TAC[IN_ELIM_THM; projectivize; o_THM] THEN BINOP_TAC THENL [CONV_TAC TAUT; AP_TERM_TAC] THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `x:real^2` THEN MP_TAC(SPEC `x:real^2` HOMOGENIZE_NONZERO) THEN DISCH_THEN(MP_TAC o MATCH_MP PARALLEL_PROJP_HOMOP_EXPLICIT) THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[homogenize; VECTOR_3] THEN UNDISCH_TAC `~(k = &0)` THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Hence Pascal's theorem for the affine plane. *) (* ------------------------------------------------------------------------- *) let PASCAL_AFFINE = prove (`!con x1 x2 x3 x4 x5 x6 x7 x8 x9:real^2. ~collinear {x1,x2,x4} /\ ~collinear {x1,x2,x5} /\ ~collinear {x1,x2,x6} /\ ~collinear {x1,x3,x4} /\ ~collinear {x1,x3,x5} /\ ~collinear {x1,x3,x6} /\ ~collinear {x2,x3,x4} /\ ~collinear {x2,x3,x5} /\ ~collinear {x2,x3,x6} /\ ~collinear {x4,x5,x1} /\ ~collinear {x4,x5,x2} /\ ~collinear {x4,x5,x3} /\ ~collinear {x4,x6,x1} /\ ~collinear {x4,x6,x2} /\ ~collinear {x4,x6,x3} /\ ~collinear {x5,x6,x1} /\ ~collinear {x5,x6,x2} /\ ~collinear {x5,x6,x3} ==> affine_conic con /\ x1 IN con /\ x2 IN con /\ x3 IN con /\ x4 IN con /\ x5 IN con /\ x6 IN con /\ collinear {x1,x9,x5} /\ collinear {x1,x8,x6} /\ collinear {x2,x9,x4} /\ collinear {x2,x7,x6} /\ collinear {x3,x8,x4} /\ collinear {x3,x7,x5} ==> collinear {x7,x8,x9}`, REWRITE_TAC[COLLINEAR_PROJECTIVIZE; AFFINE_PROJECTIVE_CONIC] THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP PASCAL) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Special case of a circle where nondegeneracy is simpler. *) (* ------------------------------------------------------------------------- *) let COLLINEAR_NOT_COCIRCULAR = prove (`!r c x y z:real^2. dist(c,x) = r /\ dist(c,y) = r /\ dist(c,z) = r /\ ~(x = y) /\ ~(x = z) /\ ~(y = z) ==> ~collinear {x,y,z}`, ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DOT_EQ_0] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; DOT_2] THEN REWRITE_TAC[dist; NORM_EQ_SQUARE; CART_EQ; DIMINDEX_2; FORALL_2; DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);; let PASCAL_AFFINE_CIRCLE = prove (`!c r x1 x2 x3 x4 x5 x6 x7 x8 x9:real^2. PAIRWISE (\x y. ~(x = y)) [x1;x2;x3;x4;x5;x6] /\ dist(c,x1) = r /\ dist(c,x2) = r /\ dist(c,x3) = r /\ dist(c,x4) = r /\ dist(c,x5) = r /\ dist(c,x6) = r /\ collinear {x1,x9,x5} /\ collinear {x1,x8,x6} /\ collinear {x2,x9,x4} /\ collinear {x2,x7,x6} /\ collinear {x3,x8,x4} /\ collinear {x3,x7,x5} ==> collinear {x7,x8,x9}`, GEN_TAC THEN GEN_TAC THEN MP_TAC(SPEC `{x:real^2 | dist(c,x) = r}` PASCAL_AFFINE) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[PAIRWISE; ALL; IN_ELIM_THM] THEN GEN_REWRITE_TAC LAND_CONV [IMP_IMP] THEN DISCH_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT CONJ_TAC THEN MATCH_MP_TAC COLLINEAR_NOT_COCIRCULAR THEN MAP_EVERY EXISTS_TAC [`r:real`; `c:real^2`] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[affine_conic; dist; NORM_EQ_SQUARE] THEN ASM_CASES_TAC `&0 <= r` THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY EXISTS_TAC [`&1`; `&1`; `&0`; `-- &2 * (c:real^2)$1`; `-- &2 * (c:real^2)$2`; `(c:real^2)$1 pow 2 + (c:real^2)$2 pow 2 - r pow 2`] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; REPLICATE_TAC 5 (EXISTS_TAC `&0`) THEN EXISTS_TAC `&1` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]]);; hol-light/100/perfect.ml000066400000000000000000000317731303454263000152420ustar00rootroot00000000000000(* ========================================================================= *) (* Perfect number theorems. *) (* ========================================================================= *) needs "Library/prime.ml";; prioritize_num();; (* ------------------------------------------------------------------------- *) (* The sum-of-divisors function. *) (* ------------------------------------------------------------------------- *) let sigma = new_definition `sigma(n) = if n = 0 then 0 else nsum {d | d divides n} (\i. i)`;; (* ------------------------------------------------------------------------- *) (* Definition of perfection. *) (* ------------------------------------------------------------------------- *) let perfect = new_definition `perfect n <=> ~(n = 0) /\ sigma(n) = 2 * n`;; (* ------------------------------------------------------------------------- *) (* Various number-theoretic lemmas. *) (* ------------------------------------------------------------------------- *) let ODD_POW2_MINUS1 = prove (`!k. ~(k = 0) ==> ODD(2 EXP k - 1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `EVEN(2 EXP k) <=> EVEN((2 EXP k - 1) + 1)` MP_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[ARITH_RULE `k = k - 1 + 1 <=> ~(k = 0)`] THEN REWRITE_TAC[EXP_EQ_0; ARITH]; ASM_REWRITE_TAC[GSYM NOT_EVEN; EVEN_ADD; EVEN_EXP; ARITH]]);; let EVEN_ODD_DECOMP = prove (`!n. ~(n = 0) ==> ?r s. ODD s /\ n = 2 EXP r * s`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN MP_TAC(SPEC `n:num` EVEN_OR_ODD) THEN REWRITE_TAC[EVEN_EXISTS; ODD_EXISTS] THEN DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `m:num` SUBST_ALL_TAC)) THENL [DISCH_THEN(MP_TAC o SPEC `m:num`) THEN REWRITE_TAC[MULT_EQ_0; ARITH; ARITH_RULE `m < 2 * m <=> ~(m = 0)`] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:num` THEN DISCH_THEN(X_CHOOSE_TAC `r:num`) THEN EXISTS_TAC `SUC r` THEN ASM_REWRITE_TAC[EXP; GSYM MULT_ASSOC]; REPEAT(DISCH_THEN(K ALL_TAC)) THEN EXISTS_TAC `0` THEN REWRITE_TAC[EXP; MULT_CLAUSES] THEN MESON_TAC[]]);; let FINITE_DIVISORS = prove (`!n. ~(n = 0) ==> FINITE {d | d divides n}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{d | d <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[DIVIDES_LE]);; let MULT_EQ_COPRIME = prove (`!a b x y. a * b = x * y /\ coprime(a,x) ==> ?d. y = a * d /\ b = x * d`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `x:num`; `y:num`] COPRIME_DIVPROD) THEN MP_TAC(SPECL [`x:num`; `a:num`; `b:num`] COPRIME_DIVPROD) THEN REPEAT(ANTS_TAC THENL [ASM_MESON_TAC[DIVIDES_REFL; DIVIDES_RMUL; COPRIME_SYM]; REWRITE_TAC[divides] THEN STRIP_TAC]) THEN UNDISCH_TAC `a * b = x * y` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(a * x * u = x * a * v) <=> (a * x) * u = (a * x) * v`] THEN REWRITE_TAC[EQ_MULT_LCANCEL; MULT_EQ_0] THEN ASM_MESON_TAC[]);; let COPRIME_ODD_POW2 = prove (`!k n. ODD(n) ==> coprime(2 EXP k,n)`, SIMP_TAC[coprime; PRIME_2; DIVIDES_PRIMEPOW] THEN REWRITE_TAC[divides] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `ODD n` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[ODD_MULT; ODD_EXP; ARITH]);; let MULT_NSUM = prove (`!s t. FINITE s /\ FINITE t ==> nsum s f * nsum t g = nsum {(x:A,y:B) | x IN s /\ y IN t} (\(x,y). f(x) * g(y))`, SIMP_TAC[GSYM NSUM_NSUM_PRODUCT; NSUM_LMUL; NSUM_RMUL]);; (* ------------------------------------------------------------------------- *) (* Some elementary properties of the sigma function. *) (* ------------------------------------------------------------------------- *) let SIGMA_0 = prove (`sigma 0 = 0`, REWRITE_TAC[sigma]);; let SIGMA_1 = prove (`sigma(1) = 1`, REWRITE_TAC[sigma; DIVIDES_ONE; SET_RULE `{d | d = 1} = {1}`] THEN REWRITE_TAC[ARITH; NSUM_SING]);; let SIGMA_LBOUND = prove (`!n. 1 < n ==> n + 1 <= sigma(n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 0)`)) THEN ASM_REWRITE_TAC[sigma] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `nsum {1,n} (\i. i)` THEN CONJ_TAC THENL [SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN ASM_ARITH_TAC; MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[FINITE_DIVISORS] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT] THEN MESON_TAC[DIVIDES_1; DIVIDES_REFL]]);; let SIGMA_MULT = prove (`!a b. 1 < a /\ 1 < b ==> 1 + b + a * b <= sigma(a * b)`, REPEAT STRIP_TAC THEN EVERY_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 0)`)) THEN ASM_REWRITE_TAC[sigma] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `nsum {1,b,a*b} (\i. i)` THEN CONJ_TAC THENL [SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN ONCE_REWRITE_TAC[ARITH_RULE `x = a * b <=> a * b = 1 * x`] THEN ASM_REWRITE_TAC[EQ_MULT_RCANCEL] THEN REWRITE_TAC[MULT_CLAUSES; MULT_EQ_1] THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[MULT_EQ_0] THEN MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[FINITE_DIVISORS; MULT_EQ_0] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT] THEN MESON_TAC[DIVIDES_1; DIVIDES_REFL; DIVIDES_LMUL]]);; let SIGMA_PRIME = prove (`!p. prime(p) ==> sigma(p) = p + 1`, GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0; SIGMA_0; ARITH] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1; SIGMA_1; ARITH] THEN DISCH_TAC THEN ASM_REWRITE_TAC[sigma] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `nsum {1,p} (\i. i)` THEN CONJ_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[prime; DIVIDES_1; DIVIDES_REFL]; ASM_SIMP_TAC[NSUM_CLAUSES; IN_SING; FINITE_RULES; NOT_IN_EMPTY] THEN ARITH_TAC]);; let SIGMA_PRIME_EQ = prove (`!p. prime(p) <=> sigma(p) = p + 1`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SIGMA_PRIME] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[prime; DE_MORGAN_THM] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[SIGMA_1; ARITH] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; divides; DE_MORGAN_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `b:num` SUBST_ALL_TAC) THEN MP_TAC(SPECL [`a:num`; `b:num`] SIGMA_MULT) THEN ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; SIGMA_0; ARITH] THEN ASM_CASES_TAC `b = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; SIGMA_0; ARITH] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[MULT_EQ_1] THEN ONCE_REWRITE_TAC[ARITH_RULE `a = a * b <=> a * b = a * 1`] THEN REWRITE_TAC[EQ_MULT_LCANCEL] THEN ARITH_TAC);; let SIGMA_POW2 = prove (`!k. sigma(2 EXP k) = 2 EXP (k + 1) - 1`, GEN_TAC THEN REWRITE_TAC[sigma; EXP_EQ_0; ARITH] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `nsum {2 EXP i | i <= k} (\i. i)` THEN CONJ_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[DIVIDES_PRIMEPOW; PRIME_2; EXTENSION; IN_ELIM_THM]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `x + 1 = y ==> x = y - 1`) THEN SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[LE] THENL [REWRITE_TAC[SET_RULE `{2 EXP i | i = 0} = {2 EXP 0}`] THEN REWRITE_TAC[ARITH; NSUM_SING]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{2 EXP i | i = SUC k \/ i <= k} = (2 EXP (SUC k)) INSERT {2 EXP i | i <= k}`] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[SET_RULE `{2 EXP i | i <= k} = IMAGE (\i. 2 EXP i) {i | i <= k}`] THEN SIMP_TAC[NSUM_CLAUSES; FINITE_IMAGE; FINITE_NUMSEG_LE] THEN REWRITE_TAC[IN_IMAGE; GSYM LE_ANTISYM; LE_EXP; ARITH] THEN REWRITE_TAC[LE_ANTISYM; IN_ELIM_THM; UNWIND_THM1] THEN REWRITE_TAC[ARITH_RULE `~(SUC k <= k)`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[EXP; EXP_ADD; ARITH] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Multiplicativity of sigma, the most interesting property. *) (* ------------------------------------------------------------------------- *) let SIGMA_MULTIPLICATIVE = prove (`!a b. coprime(a,b) ==> sigma(a * b) = sigma(a) * sigma(b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[SIGMA_0; MULT_CLAUSES] THEN ASM_CASES_TAC `b = 0` THEN ASM_REWRITE_TAC[SIGMA_0; MULT_CLAUSES] THEN DISCH_TAC THEN ASM_REWRITE_TAC[sigma; MULT_EQ_0] THEN ASM_SIMP_TAC[FINITE_DIVISORS; MULT_NSUM] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `nsum (IMAGE (\(x,y). x * y) {x,y | x divides a /\ y divides b}) (\i. i)` THEN CONJ_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN X_GEN_TAC `n:num` THEN EQ_TAC THEN REWRITE_TAC[DIVISION_DECOMP] THEN REWRITE_TAC[divides] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MESON_TAC[MULT_AC]; ALL_TAC] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (lhs o rand) NSUM_IMAGE (lhand w))) THEN REWRITE_TAC[o_DEF; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`w:num`; `x:num`; `y:num`; `z:num`] THEN REWRITE_TAC[PAIR_EQ] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o check (is_var o rand o concl))) THEN REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN ASM_MESON_TAC[COPRIME_DIVISORS; COPRIME_SYM; COPRIME_DIVPROD; DIVIDES_RMUL; DIVIDES_REFL; MULT_SYM]);; (* ------------------------------------------------------------------------- *) (* Hence the main theorems. *) (* ------------------------------------------------------------------------- *) let PERFECT_EUCLID = prove (`!k. prime(2 EXP k - 1) ==> perfect(2 EXP (k - 1) * (2 EXP k - 1))`, GEN_TAC THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[ARITH; PRIME_0] THEN DISCH_TAC THEN SUBGOAL_THEN `coprime(2 EXP (k - 1),2 EXP k - 1)` ASSUME_TAC THENL [MATCH_MP_TAC COPRIME_ODD_POW2 THEN ASM_SIMP_TAC[ODD_POW2_MINUS1]; ALL_TAC] THEN ASM_SIMP_TAC[perfect; SIGMA_MULTIPLICATIVE; SIGMA_PRIME; SIGMA_POW2] THEN ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> k - 1 + 1 = k`; EXP_EQ_0; MULT_EQ_0; ARITH] THEN CONJ_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN AP_TERM_TAC THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC);; let PERFECT_EULER = prove (`!n. EVEN(n) /\ perfect(n) ==> ?k. prime(2 EXP k - 1) /\ n = 2 EXP (k - 1) * (2 EXP k - 1)`, GEN_TAC THEN MP_TAC(SPEC `n:num` EVEN_ODD_DECOMP) THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[perfect]; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM NOT_EVEN] THEN MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[EVEN_EXP; EVEN_MULT; ARITH] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[perfect] THEN ASM_SIMP_TAC[SIGMA_MULTIPLICATIVE; SIGMA_POW2; COPRIME_ODD_POW2; GSYM NOT_EVEN] THEN DISCH_TAC THEN EXISTS_TAC `r + 1` THEN REWRITE_TAC[ADD_SUB; EQ_MULT_LCANCEL] THEN REWRITE_TAC[EXP_EQ_0; ARITH] THEN FIRST_X_ASSUM(MP_TAC o check(is_eq o concl)) THEN REWRITE_TAC[MULT_ASSOC; GSYM(CONJUNCT2 EXP); ADD1] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] MULT_EQ_COPRIME)) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_ODD_POW2 THEN SIMP_TAC[ODD_POW2_MINUS1; ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC) THEN ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THENL [ASM_MESON_TAC[EVEN]; ALL_TAC] THEN ASM_CASES_TAC `d = 1` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; SIGMA_PRIME_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN MATCH_MP_TAC(GSYM SUB_ADD) THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; EXP_EQ_0; ARITH]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN MP_TAC(SPECL [`2 EXP (r + 1) - 1`; `d:num`] SIGMA_MULT) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ ~b ==> (a ==> b) ==> c`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `2 EXP 1 < a ==> 1 < a - 1`) THEN REWRITE_TAC[LT_EXP; ARITH] THEN UNDISCH_TAC `~(r = 0)` THEN ARITH_TAC; MAP_EVERY UNDISCH_TAC [`~(d = 0)`; `~(d = 1)`] THEN ARITH_TAC; REWRITE_TAC[NOT_LE] THEN EXPAND_TAC "s" THEN REWRITE_TAC[RIGHT_SUB_DISTRIB; MULT_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `1 * d < x * d ==> x * d < 1 + d + x * d - d`) THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN MATCH_MP_TAC(ARITH_RULE `2 EXP 0 < a ==> 1 < a`) THEN REWRITE_TAC[LT_EXP] THEN UNDISCH_TAC `~(r = 0)` THEN ARITH_TAC]);; hol-light/100/pick.ml000066400000000000000000005545431303454263000145450ustar00rootroot00000000000000(* ========================================================================= *) (* Pick's theorem. *) (* ========================================================================= *) needs "Multivariate/polytope.ml";; needs "Multivariate/measure.ml";; needs "Multivariate/moretop.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Misc lemmas. *) (* ------------------------------------------------------------------------- *) let COLLINEAR_IMP_NEGLIGIBLE = prove (`!s:real^2->bool. collinear s ==> negligible s`, REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN MESON_TAC[NEGLIGIBLE_AFFINE_HULL_2; NEGLIGIBLE_SUBSET]);; let CONVEX_HULL_3_0 = prove (`!a b:real^N. convex hull {vec 0,a,b} = {x % a + y % b | &0 <= x /\ &0 <= y /\ x + y <= &1}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{c,a,b} = {a,b,c}`] THEN REWRITE_TAC[CONVEX_HULL_3; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; EXISTS_TAC `&1 - x - y` THEN ASM_ARITH_TAC]);; let INTERIOR_CONVEX_HULL_3_0 = prove (`!a b:real^2. ~(collinear {vec 0,a,b}) ==> interior(convex hull {vec 0,a,b}) = {x % a + y % b | &0 < x /\ &0 < y /\ x + y < &1}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{c,a,b} = {a,b,c}`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3] THEN REWRITE_TAC[TAUT `a /\ x = &1 /\ b <=> x = &1 /\ a /\ b`] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `x + y + z = &1 <=> &1 - x - y = z`; UNWIND_THM1] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let MEASURE_CONVEX_HULL_2_TRIVIAL = prove (`(!a:real^2. measure(convex hull {a}) = &0) /\ (!a b:real^2. measure(convex hull {a,b}) = &0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_EQ_0 THEN MATCH_MP_TAC COLLINEAR_IMP_NEGLIGIBLE THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_HULL_SING] THEN REWRITE_TAC[COLLINEAR_SING; COLLINEAR_SEGMENT]);; let NEGLIGIBLE_SEGMENT_2 = prove (`!a b:real^2. negligible(segment[a,b])`, SIMP_TAC[COLLINEAR_IMP_NEGLIGIBLE; COLLINEAR_SEGMENT]);; (* ------------------------------------------------------------------------- *) (* Decomposing an additive function on a triangle. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_DECOMPOSITION = prove (`!a b c d:real^2. d IN convex hull {a,b,c} ==> (convex hull {a,b,c} = convex hull {d,b,c} UNION convex hull {d,a,c} UNION convex hull {d,a,b})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN MP_TAC(ISPECL [`{a:real^2,b,c}`; `d:real^2`; `x:real^2`] IN_CONVEX_HULL_EXCHANGE) THEN ASM_REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY; IN_UNION] THEN REPEAT(MATCH_MP_TAC MONO_OR THEN CONJ_TAC) THEN SPEC_TAC(`x:real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; SIMP_TAC[SUBSET_HULL; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT]]);; let TRIANGLE_ADDITIVE_DECOMPOSITION = prove (`!f:(real^2->bool)->real a b c d. (!s t. compact s /\ compact t ==> f(s UNION t) = f(s) + f(t) - f(s INTER t)) /\ ~(a = b) /\ ~(a = c) /\ ~(b = c) /\ ~affine_dependent {a,b,c} /\ d IN convex hull {a,b,c} ==> f(convex hull {a,b,c}) = (f(convex hull {a,b,d}) + f(convex hull {a,c,d}) + f(convex hull {b,c,d})) - (f(convex hull {a,d}) + f(convex hull {b,d}) + f(convex hull {c,d})) + f(convex hull {d})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP TRIANGLE_DECOMPOSITION) THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [COMPACT_UNION; COMPACT_INTER; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY; UNION_OVER_INTER] THEN MP_TAC(ISPECL [`{a:real^2,b,c}`; `d:real^2`] CONVEX_HULL_EXCHANGE_INTER) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT; NOT_IN_EMPTY; SET_RULE `s SUBSET u /\ t SUBSET u ==> (s INTER t) SUBSET u`] THEN ASM_REWRITE_TAC[INSERT_INTER; IN_INSERT; NOT_IN_EMPTY; INTER_EMPTY] THEN DISCH_TAC THEN REWRITE_TAC[INSERT_AC] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Vectors all of whose coordinates are integers. *) (* ------------------------------------------------------------------------- *) let integral_vector = define `integral_vector(x:real^N) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i)`;; let INTEGRAL_VECTOR_VEC = prove (`!n. integral_vector(vec n)`, REWRITE_TAC[integral_vector; VEC_COMPONENT; INTEGER_CLOSED]);; let INTEGRAL_VECTOR_STDBASIS = prove (`!i. integral_vector(basis i:real^N)`, REWRITE_TAC[integral_vector] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN REWRITE_TAC[INTEGER_CLOSED]);; let INTEGRAL_VECTOR_ADD = prove (`!x y:real^N. integral_vector x /\ integral_vector y ==> integral_vector(x + y)`, SIMP_TAC[integral_vector; VECTOR_ADD_COMPONENT; INTEGER_CLOSED]);; let INTEGRAL_VECTOR_SUB = prove (`!x y:real^N. integral_vector x /\ integral_vector y ==> integral_vector(x - y)`, SIMP_TAC[integral_vector; VECTOR_SUB_COMPONENT; INTEGER_CLOSED]);; let INTEGRAL_VECTOR_ADD_LCANCEL = prove (`!x y:real^N. integral_vector x ==> (integral_vector(x + y) <=> integral_vector y)`, MESON_TAC[INTEGRAL_VECTOR_ADD; INTEGRAL_VECTOR_SUB; VECTOR_ARITH `(x + y) - x:real^N = y`]);; let FINITE_BOUNDED_INTEGER_POINTS = prove (`!s:real^N->bool. bounded s ==> FINITE {x | x IN s /\ integral_vector x}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; integral_vector] THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) /\ (a:real^N)$i <= x$i /\ x$i <= (b:real^N)$i}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_INTSEG]; ASM SET_TAC[]]);; let FINITE_TRIANGLE_INTEGER_POINTS = prove (`!a b c:real^N. FINITE {x | x IN convex hull {a,b,c} /\ integral_vector x}`, REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_BOUNDED_INTEGER_POINTS THEN SIMP_TAC[FINITE_IMP_BOUNDED_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Properties of a basis for the integer lattice. *) (* ------------------------------------------------------------------------- *) let LINEAR_INTEGRAL_VECTOR = prove (`!f:real^N->real^N. linear f ==> ((!x. integral_vector x ==> integral_vector(f x)) <=> (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> integer(matrix f$i$j)))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN ABBREV_TAC `M = matrix(f:real^N->real^N)` THEN SIMP_TAC[integral_vector; matrix_vector_mul; LAMBDA_BETA] THEN EQ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THENL [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis j:real^N`) THEN REWRITE_TAC[GSYM integral_vector; INTEGRAL_VECTOR_STDBASIS] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[BASIS_COMPONENT; COND_RAND; COND_RATOR] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG; REAL_MUL_RID]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC INTEGER_SUM THEN ASM_SIMP_TAC[INTEGER_CLOSED; IN_NUMSEG]]);; let INTEGRAL_BASIS_UNIMODULAR = prove (`!f:real^N->real^N. linear f /\ IMAGE f integral_vector = integral_vector ==> abs(det(matrix f)) = &1`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> integer(matrix(f:real^N->real^N)$i$j)` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM LINEAR_INTEGRAL_VECTOR]; ALL_TAC] THEN SUBGOAL_THEN `?g:real^N->real^N. linear g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN CONJ_TAC THENL [ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]; ALL_TAC] THEN SUBGOAL_THEN `!y. y:real^N IN span(IMAGE f (:real^N))` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; SPAN_UNIV] THEN SET_TAC[]] THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[INTEGRAL_VECTOR_STDBASIS]; ALL_TAC] THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> integer(matrix(g:real^N->real^N)$i$j)` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM LINEAR_INTEGRAL_VECTOR] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `det(matrix(f:real^N->real^N)) * det(matrix(g:real^N->real^N)) = det(matrix(I:real^N->real^N))` MP_TAC THENL [ASM_SIMP_TAC[GSYM DET_MUL; GSYM MATRIX_COMPOSE] THEN REPEAT AP_TERM_TAC THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `abs:real->real`) THEN REWRITE_TAC[MATRIX_I; DET_I; REAL_ABS_NUM] THEN ASM_SIMP_TAC[INTEGER_DET; INTEGER_ABS_MUL_EQ_1]);; (* ------------------------------------------------------------------------- *) (* Pick's theorem for an elementary triangle. *) (* ------------------------------------------------------------------------- *) let PICK_ELEMENTARY_TRIANGLE_0 = prove (`!a b:real^2. {x | x IN convex hull {vec 0,a,b} /\ integral_vector x} = {vec 0,a,b} ==> measure(convex hull {vec 0,a,b}) = if collinear {vec 0,a,b} then &0 else &1 / &2`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[MEASURE_EQ_0; COLLINEAR_IMP_NEGLIGIBLE; COLLINEAR_CONVEX_HULL_COLLINEAR] THEN POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC]) [`a:real^2 = vec 0`; `b:real^2 = vec 0`; `a:real^2 = b`] THEN DISCH_TAC THEN SUBGOAL_THEN `independent {a:real^2,b}` ASSUME_TAC THENL [UNDISCH_TAC `~collinear{vec 0:real^2, a, b}` THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN REWRITE_TAC[dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{c,a,b} = {c,b,a}`]; ALL_TAC] THEN ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a IN s ==> s SUBSET t ==> a IN t`)) THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `span{a,b} = (:real^2)` ASSUME_TAC THENL [MP_TAC(ISPECL [`(:real^2)`; `{a:real^2,b}`] CARD_EQ_DIM) THEN ASM_REWRITE_TAC[SUBSET_UNIV; SUBSET; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[HAS_SIZE; FINITE_INSERT; FINITE_EMPTY] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; DIM_UNIV; DIMINDEX_2; ARITH]; ALL_TAC] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_INSERT; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT] THEN STRIP_TAC THEN MP_TAC(ISPEC `\x:real^2. transp(vector[a;b]:real^2^2) ** x` INTEGRAL_BASIS_UNIMODULAR) THEN REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[DET_2; MEASURE_TRIANGLE; VECTOR_2; DET_TRANSP; VEC_COMPONENT] THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[IN] THEN SIMP_TAC[LINEAR_INTEGRAL_VECTOR; MATRIX_VECTOR_MUL_LINEAR; LAMBDA_BETA; MATRIX_OF_MATRIX_VECTOR_MUL; transp; DIMINDEX_2; ARITH] THEN MAP_EVERY UNDISCH_TAC [`integral_vector(a:real^2)`; `integral_vector(b:real^2)`] THEN REWRITE_TAC[integral_vector; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; FORALL_2; DIMINDEX_2; VECTOR_2] THEN REWRITE_TAC[CONJ_ACI]; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE] THEN REWRITE_TAC[IN] THEN X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_VECTOR_2] THEN REWRITE_TAC[MATRIX_VECTOR_COLUMN; TRANSP_TRANSP] THEN REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_2; integral_vector; FORALL_2] THEN SUBGOAL_THEN `(x:real^2) IN span{a,b}` MP_TAC THENL [ASM_REWRITE_TAC[IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[SPAN_2; IN_UNIV; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `frac u % a + frac v % b:real^2`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(&1 - frac u) % a + (&1 - frac v) % b:real^2`) THEN MATCH_MP_TAC(TAUT `b' /\ (b' ==> b) /\ (a \/ a') /\ (c \/ c' ==> x) ==> (a /\ b ==> c) ==> (a' /\ b' ==> c') ==> x`) THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `integral_vector(floor u % a + floor v % b:real^2)` MP_TAC THENL [MAP_EVERY UNDISCH_TAC [`integral_vector(a:real^2)`; `integral_vector(b:real^2)`] THEN SIMP_TAC[integral_vector; DIMINDEX_2; FORALL_2; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[FLOOR; INTEGER_CLOSED]; UNDISCH_TAC `integral_vector(x:real^2)` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_VECTOR_SUB) THEN ASM_REWRITE_TAC[VECTOR_ARITH `(x % a + y % b) - (u % a + v % b) = (x - u) % a + (y - v) % b`] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_ARITH `u - x:real = y <=> u = x + y`] THEN REWRITE_TAC[GSYM FLOOR_FRAC]]; REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + (&1 - v) % b = (a + b) - (u % a + v % b)`] THEN ASM_SIMP_TAC[INTEGRAL_VECTOR_ADD; INTEGRAL_VECTOR_SUB]; REWRITE_TAC[CONVEX_HULL_3_0; IN_ELIM_THM] THEN SUBGOAL_THEN `&0 <= frac u /\ &0 <= frac v /\ frac u + frac v <= &1 \/ &0 <= &1 - frac u /\ &0 <= &1 - frac v /\ (&1 - frac u) + (&1 - frac v) <= &1` MP_TAC THENL [MP_TAC(SPEC `u:real` FLOOR_FRAC) THEN MP_TAC(SPEC `v:real` FLOOR_FRAC) THEN REAL_ARITH_TAC; MESON_TAC[]]; REWRITE_TAC [VECTOR_ARITH `x % a + y % b = a <=> (x - &1) % a + y % b = vec 0`; VECTOR_ARITH `x % a + y % b = b <=> x % a + (y - &1) % b = vec 0`] THEN ASM_SIMP_TAC[INDEPENDENT_2; GSYM REAL_FRAC_EQ_0] THEN MP_TAC(SPEC `u:real` FLOOR_FRAC) THEN MP_TAC(SPEC `v:real` FLOOR_FRAC) THEN REAL_ARITH_TAC]);; let PICK_ELEMENTARY_TRIANGLE = prove (`!a b c:real^2. {x | x IN convex hull {a,b,c} /\ integral_vector x} = {a,b,c} ==> measure(convex hull {a,b,c}) = if collinear {a,b,c} then &0 else &1 / &2`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> (!x. x IN s <=> x IN t) /\ s = t`)) THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(MP_TAC o SPEC `a:real^2`) THEN REWRITE_TAC[IN_INSERT; IN_ELIM_THM] THEN GEOM_ORIGIN_TAC `a:real^2`THEN SIMP_TAC[INTEGRAL_VECTOR_ADD_LCANCEL; VECTOR_ADD_RID] THEN REWRITE_TAC[PICK_ELEMENTARY_TRIANGLE_0]);; (* ------------------------------------------------------------------------- *) (* Our form of Pick's theorem holds degenerately for a flat triangle. *) (* ------------------------------------------------------------------------- *) let PICK_TRIANGLE_FLAT = prove (`!a b c:real^2. integral_vector a /\ integral_vector b /\ integral_vector c /\ c IN segment[a,b] ==> measure(convex hull {a,b,c}) = &(CARD {x | x IN convex hull {a,b,c} /\ integral_vector x}) - (&(CARD {x | x IN convex hull {b,c} /\ integral_vector x}) + &(CARD {x | x IN convex hull {a,c} /\ integral_vector x}) + &(CARD {x | x IN convex hull {a,b} /\ integral_vector x})) / &2 + &1 / &2`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN SUBGOAL_THEN `convex hull {a:real^2,b,c} = segment[a,b]` SUBST1_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULLS_EQ THEN ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN SIMP_TAC[ENDS_IN_SEGMENT; HULL_INC; IN_INSERT]; ALL_TAC] THEN SUBGOAL_THEN `measure(segment[a:real^2,b]) = &0` SUBST1_TAC THENL [MATCH_MP_TAC MEASURE_EQ_0 THEN MATCH_MP_TAC COLLINEAR_IMP_NEGLIGIBLE THEN REWRITE_TAC[COLLINEAR_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&0 = c - (a + b + c) / &2 + &1 / &2 <=> a + b = c + &1`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN SUBGOAL_THEN `segment[a:real^2,b] = segment[b,c] UNION segment[a,c]` SUBST1_TAC THENL [ASM_MESON_TAC[SEGMENT_SYM; UNION_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{x | x IN (s UNION t) /\ P x} = {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN SIMP_TAC[CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT] THEN MATCH_MP_TAC(ARITH_RULE `z:num <= x /\ z = 1 ==> x + y = (x + y) - z + 1`) THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_SUBSET THEN SIMP_TAC[FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT] THEN SET_TAC[]; REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} INTER {x | x IN t /\ P x} = {x | x IN (s INTER t) /\ P x}`] THEN SUBGOAL_THEN `segment[b:real^2,c] INTER segment[a,c] = {c}` SUBST1_TAC THENL [ASM_MESON_TAC[INTER_SEGMENT; SEGMENT_SYM]; ALL_TAC] THEN SUBGOAL_THEN `{x:real^2 | x IN {c} /\ integral_vector x} = {c}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; ARITH; NOT_IN_EMPTY]]);; (* ------------------------------------------------------------------------- *) (* Pick's theorem for a triangle. *) (* ------------------------------------------------------------------------- *) let PICK_TRIANGLE_ALT = prove (`!a b c:real^2. integral_vector a /\ integral_vector b /\ integral_vector c ==> measure(convex hull {a,b,c}) = &(CARD {x | x IN convex hull {a,b,c} /\ integral_vector x}) - (&(CARD {x | x IN convex hull {b,c} /\ integral_vector x}) + &(CARD {x | x IN convex hull {a,c} /\ integral_vector x}) + &(CARD {x | x IN convex hull {a,b} /\ integral_vector x})) / &2 + &1 / &2`, let tac a bc = MATCH_MP_TAC CARD_PSUBSET THEN REWRITE_TAC[FINITE_TRIANGLE_INTEGER_POINTS] THEN REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> {x | x IN s /\ P x} SUBSET {x | x IN t /\ P x}`) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN ASM_SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT; HULL_INC]; DISCH_TAC] THEN SUBGOAL_THEN(subst[bc,`bc:real^2->bool`] `convex hull {a:real^2,b,c} = convex hull bc`) ASSUME_TAC THENL [MATCH_MP_TAC CONVEX_HULLS_EQ THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT; INSERT_SUBSET; EMPTY_SUBSET] THEN SUBGOAL_THEN(subst [a,`x:real^2`] `x IN convex hull {a:real^2,b,c}`) MP_TAC THENL [SIMP_TAC[HULL_INC; IN_INSERT]; ASM SET_TAC[]]; ALL_TAC] THEN MP_TAC(ISPECL [`{a:real^2,b,c}`; a] EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT) THEN ASM_REWRITE_TAC[IN_INSERT] THEN DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] in REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD {x:real^2 | x IN convex hull {a,b,c} /\ integral_vector x}` THEN ASM_CASES_TAC `collinear{a:real^2,b,c}` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_BETWEEN_CASES]) THEN REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`b:real^2`; `c:real^2`; `a:real^2`] PICK_TRIANGLE_FLAT); MP_TAC(ISPECL [`a:real^2`; `c:real^2`; `b:real^2`] PICK_TRIANGLE_FLAT); MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`] PICK_TRIANGLE_FLAT)] THEN (ANTS_TAC THENL [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER P`] THEN REWRITE_TAC[INSERT_AC; REAL_ADD_AC]); ALL_TAC] THEN UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC]) [`a:real^2 = b`; `a:real^2 = c`; `b:real^2 = c`] THEN DISCH_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `{x:real^2 | x IN convex hull {a, b, c} /\ integral_vector x} = {a,b,c}` THENL [ASM_SIMP_TAC[PICK_ELEMENTARY_TRIANGLE] THEN SUBGOAL_THEN `{x | x IN convex hull {b,c} /\ integral_vector x} = {b,c} /\ {x | x IN convex hull {a,c} /\ integral_vector x} = {a,c} /\ {x | x IN convex hull {a,b} /\ integral_vector x} = {a:real^2,b}` (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL [REPEAT CONJ_TAC THEN (FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `{x | x IN cs /\ P x} = s ==> t SUBSET s /\ t SUBSET ct /\ ct SUBSET cs /\ (s DIFF t) INTER ct = {} ==> {x | x IN ct /\ P x} = t`)) THEN REPEAT CONJ_TAC THENL [SET_TAC[]; MATCH_ACCEPT_TAC HULL_SUBSET; MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; ASM_REWRITE_TAC[INSERT_DIFF; IN_INSERT; NOT_IN_EMPTY; EMPTY_DIFF] THEN MATCH_MP_TAC(SET_RULE `~(x IN s) ==> {x} INTER s = {}`) THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; GSYM BETWEEN_IN_SEGMENT] THEN DISCH_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR) THEN UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[INSERT_AC]]); SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV]; ALL_TAC] THEN SUBGOAL_THEN `?d:real^2. d IN convex hull {a, b, c} /\ integral_vector d /\ ~(d = a) /\ ~(d = b) /\ ~(d = c)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = t) ==> t SUBSET s ==> ?d. d IN s /\ ~(d IN t)`)) THEN REWRITE_TAC[SUBSET; FORALL_IN_INSERT; IN_ELIM_THM] THEN ASM_SIMP_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[HULL_INC; IN_INSERT]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_3_EQ_AFFINE_DEPENDENT]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`measure:(real^2->bool)->real`; `a:real^2`; `b:real^2`; `c:real^2`; `d:real^2`] TRIANGLE_ADDITIVE_DECOMPOSITION) THEN SIMP_TAC[MEASURE_UNION; MEASURABLE_COMPACT] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[MEASURE_CONVEX_HULL_2_TRIVIAL; REAL_ADD_RID; REAL_SUB_RZERO] THEN MP_TAC(ISPECL [`\s. &(CARD {x:real^2 | x IN s /\ integral_vector x})`; `a:real^2`; `b:real^2`; `c:real^2`; `d:real^2`] TRIANGLE_ADDITIVE_DECOMPOSITION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN (s UNION t) /\ P x} = {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`; SET_RULE `{x | x IN (s INTER t) /\ P x} = {x | x IN s /\ P x} INTER {x | x IN t /\ P x}`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `x:real = y + z - w <=> x + w = y + z`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN MATCH_MP_TAC(ARITH_RULE `x:num = (y + z) - w /\ w <= z ==> x + w = y + z`) THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_UNION_GEN; MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[INTER_SUBSET]] THEN ASM_SIMP_TAC[FINITE_BOUNDED_INTEGER_POINTS; COMPACT_IMP_BOUNDED]; DISCH_THEN SUBST1_TAC] THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `d:real^2`] th) THEN MP_TAC(ISPECL [`a:real^2`; `c:real^2`; `d:real^2`] th) THEN MP_TAC(ISPECL [`b:real^2`; `c:real^2`; `d:real^2`] th)) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [tac `a:real^2` `{b:real^2,c,d}`; DISCH_THEN SUBST1_TAC] THEN ANTS_TAC THENL [tac `b:real^2` `{a:real^2,c,d}`; DISCH_THEN SUBST1_TAC] THEN ANTS_TAC THENL [tac `c:real^2` `{a:real^2,b,d}`; DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `{x:real^2 | x IN convex hull {d} /\ integral_vector x} = {d}` SUBST1_TAC THENL [REWRITE_TAC[CONVEX_HULL_SING] THEN ASM SET_TAC[]; ALL_TAC] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER P`] THEN REWRITE_TAC[INSERT_AC] THEN REAL_ARITH_TAC);; let PICK_TRIANGLE = prove (`!a b c:real^2. integral_vector a /\ integral_vector b /\ integral_vector c ==> measure(convex hull {a,b,c}) = if collinear {a,b,c} then &0 else &(CARD {x | x IN interior(convex hull {a,b,c}) /\ integral_vector x}) + &(CARD {x | x IN frontier(convex hull {a,b,c}) /\ integral_vector x}) / &2 - &1`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[MEASURE_EQ_0; COLLINEAR_IMP_NEGLIGIBLE; COLLINEAR_CONVEX_HULL_COLLINEAR] THEN ASM_SIMP_TAC[PICK_TRIANGLE_ALT] THEN REWRITE_TAC[INTERIOR_OF_TRIANGLE; FRONTIER_OF_TRIANGLE] THEN REWRITE_TAC[SET_RULE `{x | x IN (s DIFF t) /\ P x} = {x | x IN s /\ P x} DIFF {x | x IN t /\ P x}`] THEN MATCH_MP_TAC(REAL_ARITH `i + c = s /\ ccc = c + &3 ==> s - ccc / &2 + &1 / &2 = i + c / &2 - &1`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN MATCH_MP_TAC(ARITH_RULE `y:num <= x /\ x - y = z ==> z + y = x`) THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_SUBSET; MATCH_MP_TAC(GSYM CARD_DIFF)] THEN ASM_SIMP_TAC[FINITE_BOUNDED_INTEGER_POINTS; FINITE_IMP_BOUNDED_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> {x | x IN s /\ P x} SUBSET {x | x IN t /\ P x}`) THEN REWRITE_TAC[UNION_SUBSET; SEGMENT_CONVEX_HULL] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; REWRITE_TAC[SET_RULE `{x | x IN (s UNION t) /\ P x} = {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN SIMP_TAC[CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; FINITE_INTER; FINITE_UNION; BOUNDED_SEGMENT; UNION_OVER_INTER] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} INTER {x | x IN t /\ P x} = {x | x IN (s INTER t) /\ P x}`] THEN SUBGOAL_THEN `segment[b:real^2,c] INTER segment [c,a] = {c} /\ segment[a,b] INTER segment [b,c] = {b} /\ segment[a,b] INTER segment [c,a] = {a}` (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[INTER_SEGMENT; SEGMENT_SYM; INSERT_AC]; ALL_TAC] THEN ASM_SIMP_TAC[SET_RULE `P a ==> {x | x IN {a} /\ P x} = {a}`] THEN ASM_CASES_TAC `b:real^2 = a` THENL [ASM_MESON_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {b} INTER {a} = {}`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES; SUB_0] THEN MATCH_MP_TAC(ARITH_RULE `c:num <= ca /\ a <= ab /\ b <= bc /\ bc' + ac' + ab' + a + b + c = ab + bc + ca + 3 ==> bc' + ac' + ab' = (ab + (bc + ca) - c) - (b + a) + 3`) THEN ASM_SIMP_TAC[CARD_SUBSET; SING_SUBSET; IN_ELIM_THM; ENDS_IN_SEGMENT; FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT] THEN SIMP_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER P`] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; INSERT_AC] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Parity lemma for segment crossing a polygon. *) (* ------------------------------------------------------------------------- *) let PARITY_LEMMA = prove (`!a b c d p x:real^2. simple_path(p ++ linepath(a,b)) /\ pathstart p = b /\ pathfinish p = a /\ segment(a,b) INTER segment(c,d) = {x} /\ segment[c,d] INTER path_image p = {} ==> (c IN inside(path_image(p ++ linepath(a,b))) <=> d IN outside(path_image(p ++ linepath(a,b))))`, let lemma = prove (`!a b x y:real^N. collinear{y,a,b} /\ between x (a,b) /\ dist(y,x) < dist(x,b) /\ dist(y,x) < dist(x,a) ==> y IN segment(a,b)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_DIST_IN_OPEN_SEGMENT THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC) and symlemma = prove (`(!n. P(--n) <=> P (n)) /\ (!n. &0 < n dot x ==> P n) ==> !n:real^N. ~(n dot x = &0) ==> P n`, STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[REAL_ARITH `~(x = &0) <=> &0 < x \/ &0 < --x`] THEN REWRITE_TAC[GSYM DOT_LNEG] THEN ASM_MESON_TAC[]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:real^1->real^2`; `linepath(a:real^2,b)`] SIMPLE_PATH_JOIN_LOOP_EQ) THEN FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN STRIP_TAC THEN MP_TAC(ISPECL [`(a:real^2) INSERT b INSERT c INSERT d INSERT path_image p`; `x:real^2`] DISTANCE_ATTAINS_INF) THEN REWRITE_TAC[FORALL_IN_INSERT] THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT b INSERT c INSERT d INSERT s = {a,b,c,d} UNION s`] THEN ASM_SIMP_TAC[CLOSED_UNION; FINITE_IMP_CLOSED; CLOSED_PATH_IMAGE; FINITE_INSERT; FINITE_EMPTY] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `cp:real^2` MP_TAC) THEN DISJ_CASES_TAC(NORM_ARITH `cp = x \/ &0 < dist(x:real^2,cp)`) THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(TAUT `~a ==> a /\ b ==> c`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `a = {x} ==> x IN a`)) THEN REWRITE_TAC[open_segment; IN_DIFF; IN_UNION; IN_INSERT; NOT_IN_EMPTY; IN_INTER; DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p INTER s SUBSET u ==> x IN (s DIFF u) ==> ~(x IN p)`)) THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; PATH_IMAGE_LINEPATH]; ALL_TAC] THEN ABBREV_TAC `e = dist(x:real^2,cp)` THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN RULE_ASSUM_TAC(REWRITE_RULE[ARC_LINEPATH_EQ]) THEN MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`; `d:real^2`] FINITE_INTER_COLLINEAR_OPEN_SEGMENTS) THEN MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `d:real^2`; `c:real^2`] FINITE_INTER_COLLINEAR_OPEN_SEGMENTS) THEN SUBST1_TAC(MESON[SEGMENT_SYM] `segment(d:real^2,c) = segment(c,d)`) THEN ASM_REWRITE_TAC[FINITE_SING; NOT_INSERT_EMPTY] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `~(a IN segment[c:real^2,d]) /\ ~(b IN segment[c,d])` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; IN_INTER; NOT_IN_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `~(c:real^2 = a) /\ ~(c = b) /\ ~(d = a) /\ ~(d = b)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN SUBGOAL_THEN `x IN segment(a:real^2,b) /\ x IN segment(c,d)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_OPEN_SEGMENT_ALT] THEN STRIP_TAC THEN SUBGOAL_THEN `{c,d} INTER path_image(p ++ linepath(a:real^2,b)) = {}` ASSUME_TAC THENL [ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN REWRITE_TAC[SET_RULE `{c,d} INTER (s UNION t) = {} <=> (~(c IN s) /\ ~(d IN s)) /\ ~(c IN t) /\ ~(d IN t)`] THEN CONJ_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT; IN_INTER; NOT_IN_EMPTY]; REWRITE_TAC[PATH_IMAGE_LINEPATH; GSYM BETWEEN_IN_SEGMENT] THEN CONJ_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR) THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN ASM_MESON_TAC[]]; ALL_TAC] THEN MP_TAC(ISPEC `b - x:real^2` ORTHOGONAL_TO_VECTOR_EXISTS) THEN REWRITE_TAC[DIMINDEX_2; LE_REFL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:real^2` THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^2) IN segment(a,b) /\ x IN segment(c,d)` MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_OPEN_SEGMENT_ALT; GSYM BETWEEN_IN_SEGMENT] THEN STRIP_TAC] THEN SUBGOAL_THEN `~collinear{a:real^2, b, c, d}` ASSUME_TAC THENL [UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COLLINEAR_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(n dot (d - x:real^2) = &0)` MP_TAC THENL [REWRITE_TAC[GSYM orthogonal] THEN DISCH_TAC THEN MP_TAC(SPECL [`n:real^2`; `d - x:real^2`; `b - x:real^2`] ORTHOGONAL_TO_ORTHOGONAL_2D) THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN REWRITE_TAC[GSYM COLLINEAR_3] THEN DISCH_TAC THEN UNDISCH_TAC `~collinear{a:real^2, b, c, d}` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {b,d,a,c}`] THEN ASM_SIMP_TAC[COLLINEAR_4_3] THEN CONJ_TAC THENL [MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{b:real^2,x,a,d}` THEN CONJ_TAC THENL [ASM_SIMP_TAC[COLLINEAR_4_3]; SET_TAC[]] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,b,a}`] THEN ASM_SIMP_TAC[BETWEEN_IMP_COLLINEAR]; MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{d:real^2,x,b,c}` THEN CONJ_TAC THENL [ASM_SIMP_TAC[COLLINEAR_4_3]; SET_TAC[]] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,b,a}`] THEN ASM_SIMP_TAC[BETWEEN_IMP_COLLINEAR]]; ALL_TAC] THEN DISCH_THEN(fun th -> POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN MP_TAC th) THEN SPEC_TAC(`n:real^2`,`n:real^2`) THEN MATCH_MP_TAC symlemma THEN CONJ_TAC THENL [REWRITE_TAC[ORTHOGONAL_RNEG; VECTOR_NEG_EQ_0]; ALL_TAC] THEN GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `n dot (c - x:real^2) < &0` ASSUME_TAC THENL [UNDISCH_TAC `&0 < n dot (d - x:real^2)` THEN SUBGOAL_THEN `(x:real^2) IN segment(c,d)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `d - ((&1 - u) % c + u % d):real^N = (&1 - u) % (d - c) /\ c - ((&1 - u) % c + u % d) = --u % (d - c)`] THEN REWRITE_TAC[DOT_RMUL; REAL_MUL_LNEG; REAL_ARITH `--x < &0 <=> &0 < x`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_SUB_LT]; ALL_TAC] THEN SUBGOAL_THEN `!y. y IN ball(x:real^2,e) ==> y IN segment(a,b) \/ &0 < n dot (y - x) \/ n dot (y - x) < &0` ASSUME_TAC THENL [REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~c /\ ~b ==> a) ==> a \/ b \/ c`) THEN REWRITE_TAC[REAL_ARITH `~(x < &0) /\ ~(&0 < x) <=> x = &0`] THEN REWRITE_TAC[GSYM orthogonal] THEN DISCH_TAC THEN MP_TAC(SPECL [`n:real^2`; `y - x:real^2`; `b - x:real^2`] ORTHOGONAL_TO_ORTHOGONAL_2D) THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN REWRITE_TAC[GSYM COLLINEAR_3] THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `x:real^2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LTE_TRANS; DIST_SYM]] THEN ONCE_REWRITE_TAC[SET_RULE `{y,a,b} = {a,b,y}`] THEN MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `x:real^2` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `collinear{y:real^2, x, b}` THEN MP_TAC(MATCH_MP BETWEEN_IMP_COLLINEAR (ASSUME `between (x:real^2) (a,b)`)) THEN SIMP_TAC[INSERT_AC]; ALL_TAC] THEN MP_TAC(SPEC `p ++ linepath(a:real^2,b)` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH] THEN STRIP_TAC THEN SUBGOAL_THEN `~(connected_component((:real^2) DIFF path_image(p ++ linepath (a,b))) c d)` MP_TAC THENL [DISCH_TAC; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o SPEC `path_image(p ++ linepath(a:real^2,b))` o MATCH_MP (SET_RULE `~(x IN s <=> y IN t) ==> !p. s UNION t = (:real^2) DIFF p /\ {x,y} INTER p = {} ==> x IN s /\ y IN s \/ x IN t /\ y IN t`)) THEN ASM_REWRITE_TAC[connected_component] THEN ASM_REWRITE_TAC[SET_RULE `t SUBSET UNIV DIFF s <=> t INTER s = {}`] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; OUTSIDE_NO_OVERLAP]] THEN MP_TAC(SPEC `p ++ linepath(a:real^2,b)` JORDAN_DISCONNECTED) THEN ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN SUBGOAL_THEN `!u v. u IN inside(path_image(p ++ linepath(a,b))) /\ v IN outside(path_image(p ++ linepath(a,b))) ==> connected_component ((:real^2) DIFF path_image (p ++ linepath (a,b))) u v` ASSUME_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM(ASSUME `inside (path_image (p ++ linepath (a,b))) UNION outside (path_image (p ++ linepath (a,b))) = (:real^2) DIFF path_image (p ++ linepath (a,b))`)] THEN REWRITE_TAC[IN_UNION; CONNECTED_IFF_CONNECTED_COMPONENT] THEN STRIP_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `inside(path_image(p ++ linepath(a:real^2,b)))`; ASM_MESON_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_SYM]; REWRITE_TAC[connected_component] THEN EXISTS_TAC `outside(path_image(p ++ linepath(a:real^2,b)))`] THEN ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN REWRITE_TAC[OUTSIDE_NO_OVERLAP; INSIDE_NO_OVERLAP]] THEN SUBGOAL_THEN `(x:real^2) IN path_image(p ++ linepath(a,b))` ASSUME_TAC THENL [ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN REWRITE_TAC[IN_UNION; PATH_IMAGE_LINEPATH] THEN DISJ2_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[open_segment]) THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN STRIP_TAC THEN UNDISCH_TAC `frontier(inside(path_image(p ++ linepath(a:real^2,b)))) = path_image(p ++ linepath(a,b))` THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^2`) THEN ASM_REWRITE_TAC[frontier] THEN REWRITE_TAC[IN_DIFF; CLOSURE_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN CONJ_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `inside(path_image(p ++ linepath(a:real^2,b)))` THEN ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN REWRITE_TAC[INSIDE_NO_OVERLAP]; ALL_TAC] THEN UNDISCH_TAC `frontier(outside(path_image(p ++ linepath(a:real^2,b)))) = path_image(p ++ linepath(a,b))` THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^2`) THEN ASM_REWRITE_TAC[frontier] THEN REWRITE_TAC[IN_DIFF; CLOSURE_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^2` THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `z:real^2` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[connected_component] THEN EXISTS_TAC `outside(path_image(p ++ linepath(a:real^2,b)))` THEN ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN REWRITE_TAC[OUTSIDE_NO_OVERLAP]] THEN SUBGOAL_THEN `!y. dist(y,x) < e /\ ~(y IN path_image(p ++ linepath (a,b))) ==> connected_component ((:real^2) DIFF path_image(p ++ linepath(a,b))) c y` ASSUME_TAC THENL [ALL_TAC; MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `c:real^2` THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_COMPONENT_SYM; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; OUTSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]] THEN X_GEN_TAC `y:real^2` THEN STRIP_TAC THEN SUBGOAL_THEN `segment[c,d] INTER path_image(p ++ linepath(a,b)) = {x:real^2}` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `{c,d} INTER p = {} /\ (segment[c,d] DIFF {c,d}) INTER p = {x} ==> segment[c,d] INTER p = {x}`) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATH_LINEPATH] THEN MATCH_MP_TAC(SET_RULE `cd INTER p = {} /\ l INTER (cd DIFF {c,d}) = {x} ==> (cd DIFF {c,d}) INTER (p UNION l) = {x}`) THEN ASM_REWRITE_TAC[GSYM open_segment; PATH_IMAGE_LINEPATH] THEN MATCH_MP_TAC(SET_RULE `~(a IN segment[c,d]) /\ ~(b IN segment[c,d]) /\ segment(a,b) INTER segment(c,d) = {x} /\ segment(a,b) = segment[a,b] DIFF {a,b} /\ segment(c,d) = segment[c,d] DIFF {c,d} ==> segment[a,b] INTER segment(c,d) = {x}`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[open_segment]; ALL_TAC] THEN UNDISCH_THEN `!y. y IN ball(x:real^2,e) ==> y IN segment(a,b) \/ &0 < n dot (y - x) \/ n dot (y - x) < &0` (MP_TAC o SPEC `y:real^2`) THEN REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THENL [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN UNDISCH_TAC `~(y IN path_image(p ++ linepath(a:real^2,b)))` THEN ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN SIMP_TAC[CONTRAPOS_THM; open_segment; IN_DIFF; IN_UNION; PATH_IMAGE_LINEPATH]; DISCH_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `d:real^2` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `x + min (&1 / &2) (e / &2 / norm(d - x)) % (d - x):real^2` THEN REWRITE_TAC[connected_component] THEN CONJ_TAC THENL [EXISTS_TAC `segment[x:real^2,d] DELETE x` THEN SIMP_TAC[CONVEX_SEMIOPEN_SEGMENT; CONVEX_CONNECTED] THEN ASM_REWRITE_TAC[IN_DELETE; ENDS_IN_SEGMENT] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `cd INTER p = {x} ==> xd SUBSET cd ==> (xd DELETE x) SUBSET (UNIV DIFF p)`)) THEN REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN UNDISCH_TAC `segment (a,b) INTER segment (c,d) = {x:real^2}` THEN REWRITE_TAC[open_segment] THEN SET_TAC[]; REWRITE_TAC[IN_SEGMENT; VECTOR_ARITH `x + a % (y - x):real^N = (&1 - a) % x + a % y`] THEN EXISTS_TAC `min (&1 / &2) (e / &2 / norm(d - x:real^2))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_LE_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `x + a:real^N = x <=> a = vec 0`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min (&1 / &2) x = &0)`) THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ]]; EXISTS_TAC `ball(x,e) INTER {w:real^2 | &0 < n dot (w - x)}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONVEX_CONNECTED THEN MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[CONVEX_BALL; DOT_RSUB; REAL_SUB_LT] THEN REWRITE_TAC[GSYM real_gt; CONVEX_HALFSPACE_GT]; ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN MATCH_MP_TAC(SET_RULE `p SUBSET (UNIV DIFF b) /\ l INTER w = {} ==> (b INTER w) SUBSET (UNIV DIFF (p UNION l))`) THEN ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN MATCH_MP_TAC(SET_RULE `!t. t INTER u = {} /\ s SUBSET t ==> s INTER u = {}`) THEN EXISTS_TAC `affine hull {x:real^2,b}` THEN CONJ_TAC THENL [REWRITE_TAC[AFFINE_HULL_2; FORALL_IN_GSPEC; SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN REWRITE_TAC[DOT_RMUL; VECTOR_ARITH `((&1 - v) % x + v % b) - x:real^N = v % (b - x)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal]) THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL]; REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN SIMP_TAC[SUBSET_HULL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN SIMP_TAC[HULL_INC; IN_INSERT] THEN ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL] THEN ONCE_REWRITE_TAC[SET_RULE `{x,b,a} = {a,x,b}`] THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM; dist] THEN REWRITE_TAC[NORM_ARITH `norm(x - (x + a):real^N) = norm a`] THEN REWRITE_TAC[VECTOR_ARITH `(x + a) - x:real^N = a`] THEN CONJ_TAC THENL [ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < e ==> abs(min (&1 / &2) x) < e`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; REAL_LT_DIV2_EQ] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[DOT_RMUL] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; REAL_LT_01]]; REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[]]]; DISCH_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `x + min (&1 / &2) (e / &2 / norm(c - x)) % (c - x):real^2` THEN REWRITE_TAC[connected_component] THEN CONJ_TAC THENL [EXISTS_TAC `segment[x:real^2,c] DELETE x` THEN SIMP_TAC[CONVEX_SEMIOPEN_SEGMENT; CONVEX_CONNECTED] THEN ASM_REWRITE_TAC[IN_DELETE; ENDS_IN_SEGMENT] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `cd INTER p = {x} ==> xd SUBSET cd ==> (xd DELETE x) SUBSET (UNIV DIFF p)`)) THEN REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN UNDISCH_TAC `segment (a,b) INTER segment (c,d) = {x:real^2}` THEN REWRITE_TAC[open_segment] THEN SET_TAC[]; REWRITE_TAC[IN_SEGMENT; VECTOR_ARITH `x + a % (y - x):real^N = (&1 - a) % x + a % y`] THEN EXISTS_TAC `min (&1 / &2) (e / &2 / norm(c - x:real^2))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_LE_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `x + a:real^N = x <=> a = vec 0`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min (&1 / &2) x = &0)`) THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ]]; EXISTS_TAC `ball(x,e) INTER {w:real^2 | n dot (w - x) < &0}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONVEX_CONNECTED THEN MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[CONVEX_BALL; DOT_RSUB; REAL_ARITH `a - b < &0 <=> a < b`; CONVEX_HALFSPACE_LT]; ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN MATCH_MP_TAC(SET_RULE `p SUBSET (UNIV DIFF b) /\ l INTER w = {} ==> (b INTER w) SUBSET (UNIV DIFF (p UNION l))`) THEN ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN MATCH_MP_TAC(SET_RULE `!t. t INTER u = {} /\ s SUBSET t ==> s INTER u = {}`) THEN EXISTS_TAC `affine hull {x:real^2,b}` THEN CONJ_TAC THENL [REWRITE_TAC[AFFINE_HULL_2; FORALL_IN_GSPEC; SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN REWRITE_TAC[DOT_RMUL; VECTOR_ARITH `((&1 - v) % x + v % b) - x:real^N = v % (b - x)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal]) THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL]; REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN SIMP_TAC[SUBSET_HULL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN SIMP_TAC[HULL_INC; IN_INSERT] THEN ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL] THEN ONCE_REWRITE_TAC[SET_RULE `{x,b,a} = {a,x,b}`] THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM; dist] THEN REWRITE_TAC[NORM_ARITH `norm(x - (x + a):real^N) = norm a`] THEN REWRITE_TAC[VECTOR_ARITH `(x + a) - x:real^N = a`] THEN CONJ_TAC THENL [ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < e ==> abs(min (&1 / &2) x) < e`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; REAL_LT_DIV2_EQ] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[DOT_RMUL; REAL_ARITH `x * y < &0 <=> &0 < x * --y`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < --x <=> x < &0`] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; REAL_LT_01]]; REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[]]]]);; (* ------------------------------------------------------------------------- *) (* Polygonal path; 0 in the empty case is just for linear invariance. *) (* Note that we *are* forced to assume non-emptiness for translation. *) (* ------------------------------------------------------------------------- *) let polygonal_path = define `polygonal_path[] = linepath(vec 0,vec 0) /\ polygonal_path[a] = linepath(a,a) /\ polygonal_path [a;b] = linepath(a,b) /\ polygonal_path (CONS a (CONS b (CONS c l))) = linepath(a,b) ++ polygonal_path(CONS b (CONS c l))`;; let POLYGONAL_PATH_CONS_CONS = prove (`!a b p. ~(p = []) ==> polygonal_path(CONS a (CONS b p)) = linepath(a,b) ++ polygonal_path(CONS b p)`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[polygonal_path]);; let POLYGONAL_PATH_TRANSLATION = prove (`!a b p. polygonal_path (MAP (\x. a + x) (CONS b p)) = (\x. a + x) o (polygonal_path (CONS b p))`, GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[MAP; polygonal_path; LINEPATH_TRANSLATION] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC list_INDUCT THEN ASM_SIMP_TAC[MAP; polygonal_path; LINEPATH_TRANSLATION] THEN REWRITE_TAC[JOINPATHS_TRANSLATION]);; add_translation_invariants [POLYGONAL_PATH_TRANSLATION];; let POLYGONAL_PATH_LINEAR_IMAGE = prove (`!f p. linear f ==> polygonal_path (MAP f p) = f o polygonal_path p`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; MAP] THEN CONJ_TAC THENL [REWRITE_TAC[LINEPATH_REFL; o_DEF; FUN_EQ_THM] THEN ASM_MESON_TAC[LINEAR_0]; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; MAP] THEN CONJ_TAC THENL [ASM_MESON_TAC[LINEPATH_LINEAR_IMAGE]; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; MAP] THEN ASM_SIMP_TAC[GSYM JOINPATHS_LINEAR_IMAGE; GSYM LINEPATH_LINEAR_IMAGE]);; add_linear_invariants [POLYGONAL_PATH_LINEAR_IMAGE];; let PATHSTART_POLYGONAL_PATH = prove (`!p. pathstart(polygonal_path p) = if p = [] then vec 0 else HD p`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; NOT_CONS_NIL; HD] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; HD; PATHSTART_JOIN]);; let PATHFINISH_POLYGONAL_PATH = prove (`!p. pathfinish(polygonal_path p) = if p = [] then vec 0 else LAST p`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATHFINISH_LINEPATH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATHFINISH_LINEPATH; NOT_CONS_NIL; LAST] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATHFINISH_LINEPATH; PATHFINISH_JOIN]);; let VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH = prove (`!p:(real^N)list. set_of_list p SUBSET path_image (polygonal_path p)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[set_of_list; EMPTY_SUBSET] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[set_of_list; polygonal_path; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[SEGMENT_REFL; INSERT_AC; SUBSET_REFL] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[set_of_list; polygonal_path] THEN CONJ_TAC THENL [REWRITE_TAC[PATH_IMAGE_LINEPATH; INSERT_SUBSET; ENDS_IN_SEGMENT] THEN REWRITE_TAC[EMPTY_SUBSET]; REPEAT GEN_TAC THEN REPLICATE_TAC 3 DISCH_TAC THEN ONCE_REWRITE_TAC[INSERT_SUBSET] THEN SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL; IN_UNION; ENDS_IN_SEGMENT; PATH_IMAGE_LINEPATH] THEN ASM SET_TAC[]]);; let ARC_POLYGONAL_PATH_IMP_DISTINCT = prove (`!p:(real^N)list. arc(polygonal_path p) ==> PAIRWISE (\x y. ~(x = y)) p`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; ARC_LINEPATH_EQ] THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; ARC_LINEPATH_EQ] THEN X_GEN_TAC `b:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; ARC_LINEPATH_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[PAIRWISE; ALL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN REPLICATE_TAC 3 DISCH_TAC THEN SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL; ARC_LINEPATH_EQ] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[PAIRWISE] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[ALL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[IN_INTER; IN_SING; ENDS_IN_SEGMENT; PATH_IMAGE_LINEPATH] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] (REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH))) THEN ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM; DE_MORGAN_THM; GSYM ALL_MEM] THEN MESON_TAC[]);; let PATH_POLYGONAL_PATH = prove (`!p:(real^N)list. path(polygonal_path p)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATH_LINEPATH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATH_LINEPATH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; PATH_LINEPATH] THEN SIMP_TAC[PATH_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD; PATH_LINEPATH]);; let PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL = prove (`!p. ~(p = []) ==> path_image(polygonal_path p) SUBSET convex hull (set_of_list p)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[NOT_CONS_NIL] THEN CONJ_TAC THENL [REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH; set_of_list] THEN REWRITE_TAC[SEGMENT_REFL; CONVEX_HULL_SING] THEN SET_TAC[]; GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path] THEN CONJ_TAC THENL [REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH; set_of_list] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; SUBSET_REFL]; REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL; set_of_list] THEN SIMP_TAC[HULL_MONO; INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[set_of_list] THEN SET_TAC[]]]);; let PATH_IMAGE_POLYGONAL_PATH_SUBSET_SEGMENTS = prove (`!p x:real^N. arc(polygonal_path p) /\ 3 <= LENGTH p /\ x IN path_image(polygonal_path p) ==> ?a b. MEM a p /\ MEM b p /\ x IN segment[a,b] /\ segment[a,b] SUBSET path_image(polygonal_path p) /\ ~(pathstart(polygonal_path p) IN segment[a,b] /\ pathfinish(polygonal_path p) IN segment[a,b])`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `b:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `c:real^N` THEN X_GEN_TAC `p:(real^N)list` THEN REPEAT DISCH_TAC THEN REWRITE_TAC[polygonal_path] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; ARC_JOIN_EQ; NOT_CONS_NIL; HD] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATH_IMAGE_LINEPATH; ARC_LINEPATH] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC LAND_CONV [IN_UNION] THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[MEM; SUBSET_UNION; ENDS_IN_SEGMENT] THEN FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS) THEN REWRITE_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL] THEN DISCH_TAC THEN REWRITE_TAC[ARC_LINEPATH_EQ] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `!p b. (s INTER p) SUBSET {b} /\ x IN p /\ b IN s /\ ~(x = b) ==> ~(x IN s)`) THEN MAP_EVERY EXISTS_TAC [`path_image(polygonal_path (CONS (b:real^N) (CONS c p)))`; `b:real^N`] THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; PATHFINISH_IN_PATH_IMAGE]; FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[ARITH_RULE `3 <= SUC(SUC p) <=> ~(p = 0)`] THEN REWRITE_TAC[LENGTH_EQ_NIL] THEN ASM_CASES_TAC `p:(real^N)list = []` THENL [ASM_REWRITE_TAC[LENGTH; polygonal_path] THEN REWRITE_TAC[PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN UNDISCH_TAC `x IN path_image(polygonal_path (CONS (b:real^N) (CONS c p)))` THEN ASM_REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`b:real^N`; `c:real^N`] THEN ASM_REWRITE_TAC[MEM; SUBSET_UNION; ENDS_IN_SEGMENT] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[ARC_LINEPATH_EQ] THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS) THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN SET_TAC[]; ASM_REWRITE_TAC[LENGTH_EQ_NIL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real^N` THEN REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[MEM]; ASM_MESON_TAC[MEM]; ASM_REWRITE_TAC[]; ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(sab INTER p) SUBSET {b} ==> !sde a. sde SUBSET p /\ ~(b IN sde) /\ d IN sde /\ a IN sde /\ a IN sab ==> F`) o el 2 o CONJUNCTS) THEN MAP_EVERY EXISTS_TAC [`segment[d:real^N,e]`; `a:real^N`] THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT] THEN ASM_MESON_TAC[]]]]);; (* ------------------------------------------------------------------------- *) (* Rotating the starting point to move a preferred vertex forward. *) (* ------------------------------------------------------------------------- *) let SET_OF_LIST_POLYGONAL_PATH_ROTATE = prove (`!p. ~(p = []) ==> set_of_list(CONS (LAST p) (BUTLAST p)) = set_of_list p`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM(MATCH_MP APPEND_BUTLAST_LAST th)]) THEN REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list] THEN SET_TAC[]);; let PROPERTIES_POLYGONAL_PATH_SNOC = prove (`!p d:real^N. 2 <= LENGTH p ==> path_image(polygonal_path(APPEND p [d])) = path_image(polygonal_path p ++ linepath(LAST p,d)) /\ (arc(polygonal_path(APPEND p [d])) <=> arc(polygonal_path p ++ linepath(LAST p,d))) /\ (simple_path(polygonal_path(APPEND p [d])) <=> simple_path(polygonal_path p ++ linepath(LAST p,d)))`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `b:real^N` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL [REWRITE_TAC[APPEND; polygonal_path; LAST; NOT_CONS_NIL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN REWRITE_TAC[APPEND] THEN ONCE_REWRITE_TAC[LAST] THEN REWRITE_TAC[NOT_CONS_NIL] THEN ONCE_REWRITE_TAC[polygonal_path] THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[APPEND; LENGTH; ARITH_RULE `2 <= SUC(SUC n)`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SIMP_TAC[GSYM ARC_ASSOC; GSYM SIMPLE_PATH_ASSOC; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; NOT_CONS_NIL; HD] THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; NOT_CONS_NIL; HD] THEN REWRITE_TAC[UNION_ACI]; ALL_TAC] THEN ASM_CASES_TAC `a:real^N = d` THENL [MATCH_MP_TAC(TAUT `(~p /\ ~p') /\ (q <=> q') ==> (p <=> p') /\ (q <=> q')`) THEN CONJ_TAC THENL [REWRITE_TAC[ARC_SIMPLE_PATH; PATHSTART_JOIN; PATHFINISH_JOIN] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[PATHFINISH_POLYGONAL_PATH; NOT_CONS_NIL; LAST; APPEND_EQ_NIL; LAST_APPEND]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_JOIN_LOOP_EQ o lhs o snd) THEN ANTS_TAC THENL [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[PATHFINISH_POLYGONAL_PATH; PATHSTART_LINEPATH] THEN REWRITE_TAC[NOT_CONS_NIL; HD; LAST; LAST_APPEND; APPEND_EQ_NIL]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_JOIN_LOOP_EQ o rhs o snd) THEN ANTS_TAC THENL [REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN REWRITE_TAC[NOT_CONS_NIL; HD; LAST; LAST_APPEND; APPEND_EQ_NIL]; DISCH_THEN SUBST1_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[PATHSTART_JOIN; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]; MATCH_MP_TAC(TAUT `((q <=> p) /\ (q' <=> p')) /\ (p <=> p') ==> (p <=> p') /\ (q <=> q')`) THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC SIMPLE_PATH_EQ_ARC THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN ASM_REWRITE_TAC[NOT_CONS_NIL; HD; LAST; LAST_APPEND; APPEND_EQ_NIL]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) ARC_JOIN_EQ o lhs o snd) THEN ANTS_TAC THENL [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[NOT_CONS_NIL; HD]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) ARC_JOIN_EQ o rhs o snd) THEN ANTS_TAC THENL [SIMP_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_LINEPATH; PATHSTART_JOIN; NOT_CONS_NIL; HD]; DISCH_THEN SUBST1_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[PATHSTART_JOIN; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]]);; let PATH_IMAGE_POLYGONAL_PATH_ROTATE = prove (`!p:(real^N)list. 2 <= LENGTH p /\ LAST p = HD p ==> path_image(polygonal_path(APPEND (TL p) [HD(TL p)])) = path_image(polygonal_path p)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[HD; TL] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN CONJ_TAC THENL [REWRITE_TAC[LAST; APPEND; NOT_CONS_NIL] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[LAST; NOT_CONS_NIL] THEN ONCE_REWRITE_TAC[GSYM LAST] THEN DISCH_TAC THEN SIMP_TAC[PROPERTIES_POLYGONAL_PATH_SNOC; LENGTH; ARITH_RULE `2 <= SUC(SUC n)`] THEN ONCE_REWRITE_TAC[LAST] THEN ASM_REWRITE_TAC[NOT_CONS_NIL] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [polygonal_path] THEN RULE_ASSUM_TAC(REWRITE_RULE[LAST]) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; LAST; NOT_CONS_NIL; HD] THEN REWRITE_TAC[UNION_ACI]);; let SIMPLE_PATH_POLYGONAL_PATH_ROTATE = prove (`!p:(real^N)list. 2 <= LENGTH p /\ LAST p = HD p ==> (simple_path(polygonal_path(APPEND (TL p) [HD(TL p)])) = simple_path(polygonal_path p))`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[HD; TL] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN CONJ_TAC THENL [REWRITE_TAC[LAST; APPEND; NOT_CONS_NIL] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[LAST; NOT_CONS_NIL] THEN ONCE_REWRITE_TAC[GSYM LAST] THEN DISCH_TAC THEN SIMP_TAC[PROPERTIES_POLYGONAL_PATH_SNOC; LENGTH; ARITH_RULE `2 <= SUC(SUC n)`] THEN ONCE_REWRITE_TAC[LAST] THEN ASM_REWRITE_TAC[NOT_CONS_NIL] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [polygonal_path] THEN RULE_ASSUM_TAC(REWRITE_RULE[LAST]) THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; LAST; NOT_CONS_NIL; HD] THEN REWRITE_TAC[INSERT_AC; INTER_ACI; CONJ_ACI]);; let ROTATE_LIST_TO_FRONT_1 = prove (`!P l a:A. (!l. P(l) ==> 3 <= LENGTH l /\ LAST l = HD l) /\ (!l. P(l) ==> P(APPEND (TL l) [HD(TL l)])) /\ P l /\ MEM a l ==> ?l'. EL 1 l' = a /\ P l'`, let lemma0 = prove (`!P. (!i. P i /\ 0 < i ==> P(i - 1)) /\ (?k. 0 < k /\ P k) ==> P 1`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i:num. i < k ==> P(k - i)` MP_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_0] THEN DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `k - SUC i = k - i - 1`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `k - 1`) THEN ASM_SIMP_TAC[ARITH_RULE `0 < k ==> k - 1 < k /\ k - (k - 1) = 1`]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `?i l'. 0 < i /\ i < LENGTH l' /\ P l' /\ EL i l' = (a:A)` MP_TAC THENL [SUBGOAL_THEN `~(l:A list = [])` ASSUME_TAC THENL [ASM_MESON_TAC[LENGTH; ARITH_RULE `~(3 <= 0)`]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEM_EXISTS_EL]) THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC (ARITH_RULE `i = 0 \/ 0 < i`) THENL [EXISTS_TAC `LENGTH(l:A list) - 2` THEN EXISTS_TAC `(APPEND (TL l) [HD(TL l):A])` THEN ASM_SIMP_TAC[LENGTH_APPEND; LENGTH_TL; EL_APPEND] THEN REWRITE_TAC[LT_REFL; LENGTH; SUB_REFL; EL; HD] THEN SUBGOAL_THEN `3 <= LENGTH(l:A list)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> n - 2 < n - 1`] THEN ASM_SIMP_TAC[EL_TL; ARITH_RULE `3 <= n ==> n - 2 + 1 = n - 1`] THEN ASM_MESON_TAC[LAST_EL]; MAP_EVERY EXISTS_TAC [`i:num`; `l:A list`] THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] lemma0)) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN X_GEN_TAC `k:num` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `m:A list` STRIP_ASSUME_TAC) THEN EXISTS_TAC `APPEND (TL m) [HD(TL m):A]` THEN SUBGOAL_THEN `~(m:A list = [])` ASSUME_TAC THENL [ASM_MESON_TAC[LENGTH; ARITH_RULE `~(3 <= 0)`]; ALL_TAC] THEN ASM_SIMP_TAC[LENGTH_APPEND; LENGTH_TL; EL_APPEND] THEN ASM_REWRITE_TAC[LENGTH] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN ASM_SIMP_TAC[EL_TL; ARITH_RULE `0 < k ==> k - 1 + 1 = k`]]);; let ROTATE_LIST_TO_FRONT_0 = prove (`!P l a:A. (!l. P(l) ==> 3 <= LENGTH l /\ LAST l = HD l) /\ (!l. P(l) ==> P(APPEND (TL l) [HD(TL l)])) /\ P l /\ MEM a l ==> ?l'. HD l' = a /\ P l'`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`P:A list->bool`; `l:A list`; `a:A`] ROTATE_LIST_TO_FRONT_1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l':A list` THEN STRIP_TAC THEN EXISTS_TAC `APPEND (TL l') [HD(TL l'):A]` THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `EL 1 l' = (a:A)` THEN SUBGOAL_THEN `3 <= LENGTH(l':A list)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SPEC_TAC(`l':A list`,`p:A list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN REWRITE_TAC[APPEND; HD; TL; num_CONV `1`; EL]);; (* ------------------------------------------------------------------------- *) (* We can pick a transformation to make all y coordinates distinct. *) (* ------------------------------------------------------------------------- *) let DISTINGUISHING_ROTATION_EXISTS_PAIR = prove (`!x y. ~(x = y) ==> FINITE {t | &0 <= t /\ t < &2 * pi /\ (rotate2d t x)$2 = (rotate2d t y)$2}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN ONCE_REWRITE_TAC[GSYM ROTATE2D_SUB] THEN REWRITE_TAC[GSYM IM_DEF; GSYM real; GSYM ARG_EQ_0_PI] THEN REWRITE_TAC[FINITE_UNION; SET_RULE `{x | p x /\ q x /\ (r x \/ s x)} = {x | p x /\ q x /\ r x} UNION {x | p x /\ q x /\ s x}`] THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET] `(?a. s SUBSET {a}) ==> FINITE s`) THEN MATCH_MP_TAC(SET_RULE `(!x y. x IN s /\ y IN s ==> x = y) ==> ?a. s SUBSET {a}`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ARG_ROTATE2D_UNIQUE_2PI THEN EXISTS_TAC `x - y:complex` THEN ASM_REWRITE_TAC[COMPLEX_SUB_0]);; let DISTINGUISHING_ROTATION_EXISTS = prove (`!s. FINITE s ==> ?t. pairwise (\x y. ~(x$2 = y$2)) (IMAGE (rotate2d t) s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `INFINITE ({t | &0 <= t /\ t < &2 * pi} DIFF UNIONS (IMAGE (\(x,y). {t | &0 <= t /\ t < &2 * pi /\ (rotate2d t x)$2 = (rotate2d t y)$2}) ({(x,y) | x IN s /\ y IN s /\ ~(x = y)})))` MP_TAC THENL [MATCH_MP_TAC INFINITE_DIFF_FINITE THEN REWRITE_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN CONJ_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FINITE_UNIONS] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{(x:real^2,y:real^2) | x IN s /\ y IN s}` THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT] THEN SET_TAC[]; REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[DISTINGUISHING_ROTATION_EXISTS_PAIR]]; DISCH_THEN(MP_TAC o MATCH_MP (MESON[FINITE_EMPTY; INFINITE] `INFINITE s ==> ~(s = {})`)) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN REWRITE_TAC[UNIONS_IMAGE; EXISTS_IN_GSPEC] THEN REWRITE_TAC[pairwise; IN_ELIM_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[ROTATE2D_EQ] THEN MESON_TAC[]]);; let DISTINGUISHING_ROTATION_EXISTS_POLYGON = prove (`!p:(real^2)list. ?f q. (?g. orthogonal_transformation g /\ f = MAP g) /\ (!x y. MEM x q /\ MEM y q /\ ~(x = y) ==> ~(x$2 = y$2)) /\ f q = p`, GEN_TAC THEN MP_TAC(ISPEC `set_of_list(p:(real^2)list)` DISTINGUISHING_ROTATION_EXISTS) THEN REWRITE_TAC[FINITE_SET_OF_LIST; pairwise] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_SET_OF_LIST; ROTATE2D_EQ] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; GSYM CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `MAP (rotate2d(--t))` THEN EXISTS_TAC `MAP (rotate2d t) p` THEN REWRITE_TAC[GSYM MAP_o; o_DEF; GSYM ROTATE2D_ADD] THEN REWRITE_TAC[REAL_ADD_LINV; ROTATE2D_ZERO; MAP_ID] THEN CONJ_TAC THENL [MESON_TAC[ORTHOGONAL_TRANSFORMATION_ROTATE2D]; ALL_TAC] THEN REWRITE_TAC[GSYM IN_SET_OF_LIST; SET_OF_LIST_MAP] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IN_SET_OF_LIST; ROTATE2D_EQ] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Proof that we can chop a polygon's inside in two. *) (* ------------------------------------------------------------------------- *) let POLYGON_CHOP_IN_TWO = prove (`!p:(real^2)list. simple_path(polygonal_path p) /\ pathfinish(polygonal_path p) = pathstart(polygonal_path p) /\ 5 <= LENGTH p ==> ?a b. ~(a = b) /\ MEM a p /\ MEM b p /\ segment(a,b) SUBSET inside(path_image(polygonal_path p))`, let wlog_lemma = MESON[] `(!x. ?f:A->A y. transform f /\ nice y /\ f y = x) ==> !P. (!f x. transform f ==> (P(f x) <=> P x)) /\ (!x. nice x ==> P x) ==> !x. P x` in let between_lemma = prove (`!a c u v m:real^N. collinear {a,c,u,v,m} /\ m IN segment[u,v] /\ m IN segment(a,c) ==> u IN segment(a,c) \/ v IN segment(a,c) \/ segment[a,c] SUBSET segment[u,v]`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN REWRITE_TAC[INSERT_SUBSET; LEFT_IMP_EXISTS_THM; EMPTY_SUBSET] THEN MAP_EVERY X_GEN_TAC [`origin:real^N`; `dir:real^N`] THEN GEOM_ORIGIN_TAC `origin:real^N` THEN REWRITE_TAC[AFFINE_HULL_2; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `dir:real^N = vec 0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; SEGMENT_REFL; SUBSET_REFL]; ALL_TAC] THEN REWRITE_TAC[SUBSET_SEGMENT] THEN ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM] THEN ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REAL_ARITH_TAC) in MATCH_MP_TAC(MATCH_MP wlog_lemma DISTINGUISHING_ROTATION_EXISTS_POLYGON) THEN CONJ_TAC THENL [REWRITE_TAC[MESON[] `(!x y. (?z. P z /\ x = f z) ==> Q x y) <=> (!z y. P z ==> Q (f z) y)`] THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN GEOM_TRANSFORM_TAC []; ALL_TAC] THEN X_GEN_TAC `q:(real^2)list` THEN DISCH_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `?b:real^2. MEM b q /\ !d. MEM d q ==> b$2 <= d$2` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `IMAGE (\x:real^2. x$2) (set_of_list q)` INF_FINITE) THEN SIMP_TAC[FINITE_SET_OF_LIST; FINITE_IMAGE] THEN REWRITE_TAC[IMAGE_EQ_EMPTY; SET_OF_LIST_EQ_EMPTY] THEN UNDISCH_TAC `5 <= LENGTH(q:(real^2)list)` THEN ASM_CASES_TAC `q:(real^2)list = []` THEN ASM_REWRITE_TAC[LENGTH; ARITH; FORALL_IN_IMAGE] THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; IN_SET_OF_LIST] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^2` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?p:(real^2)list. EL 1 p = b /\ LAST p = HD p /\ LENGTH p = LENGTH q /\ set_of_list p = set_of_list q /\ path_image(polygonal_path p) = path_image(polygonal_path q) /\ simple_path(polygonal_path p) /\ pathfinish(polygonal_path p) = pathstart(polygonal_path p)` MP_TAC THENL [MATCH_MP_TAC ROTATE_LIST_TO_FRONT_1 THEN EXISTS_TAC `q:(real^2)list` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN MAP_EVERY UNDISCH_TAC [`pathfinish(polygonal_path(q:(real^2)list)) = pathstart(polygonal_path q)`; `5 <= LENGTH(q:(real^2)list)`] THEN ASM_CASES_TAC `q:(real^2)list = []` THEN ASM_REWRITE_TAC[LENGTH; ARITH] THEN ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `l:(real^2)list` THEN REWRITE_TAC[APPEND_EQ_NIL; NOT_CONS_NIL] THEN ASM_CASES_TAC `l:(real^2)list = []` THENL [ASM_MESON_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(TL l:(real^2)list = [])` ASSUME_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `LENGTH:(real^2)list->num`) THEN ASM_SIMP_TAC[LENGTH; LENGTH_TL] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LAST_APPEND; LENGTH_APPEND; LENGTH_TL; NOT_CONS_NIL] THEN ASM_REWRITE_TAC[LAST; HD_APPEND; LENGTH] THEN REPEAT CONJ_TAC THENL [ASM_ARITH_TAC; MAP_EVERY UNDISCH_TAC [`HD(l:(real^2)list) = LAST l`; `5 <= LENGTH(q:(real^2)list)`; `~(l:(real^2)list = [])`] THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`l:(real^2)list`,`l:(real^2)list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[HD; TL; APPEND] THEN REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s ==> s UNION {a} = b INSERT s`) THEN ASM_REWRITE_TAC[LAST] THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[LAST] THEN UNDISCH_TAC `5 <= LENGTH(CONS (h:real^2) t)` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH] THEN REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL; LENGTH] THEN DISCH_TAC THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[EL] THEN ASM_ARITH_TAC; EXISTS_TAC `LENGTH(t:(real^2)list) - 1` THEN ASM_SIMP_TAC[LAST_EL] THEN ASM_ARITH_TAC]; MATCH_MP_TAC PATH_IMAGE_POLYGONAL_PATH_ROTATE THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; MP_TAC(ISPEC `l:(real^2)list` SIMPLE_PATH_POLYGONAL_PATH_ROTATE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN UNDISCH_THEN `pathfinish(polygonal_path(q:(real^2)list)) = pathstart(polygonal_path q)` (K ALL_TAC) THEN UNDISCH_THEN `simple_path(polygonal_path(q:(real^2)list))` (K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `r:(real^2)list` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [EXTENSION] THEN REWRITE_TAC[IN_SET_OF_LIST] THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> REWRITE_TAC[GSYM th] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN UNDISCH_THEN `MEM (b:real^2) r` (K ALL_TAC) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN SPEC_TAC(`r:(real^2)list`,`r:(real^2)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a:real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `b':real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `c:real^2` THEN X_GEN_TAC `p:(real^2)list` THEN REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN REWRITE_TAC[num_CONV `1`; EL; HD; TL] THEN ASM_CASES_TAC `b':real^2 = b` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `5 <= SUC(SUC(SUC n)) <=> ~(n = 0) /\ 2 <= n`] THEN ASM_CASES_TAC `p:(real^2)list = []` THEN ASM_REWRITE_TAC[LENGTH_EQ_NIL] THEN ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS; LAST; NOT_CONS_NIL] THEN REWRITE_TAC[PATHSTART_JOIN; PATHSTART_LINEPATH] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^2`) THEN REWRITE_TAC[MESON[MEM] `MEM b (CONS a (CONS b l))`] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN STRIP_TAC THEN MP_TAC(ISPECL [`linepath(a:real^2,b)`; `polygonal_path(CONS (b:real^2) (CONS c p))`] SIMPLE_PATH_JOIN_IMP) THEN ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS] THEN REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_JOIN; PATHSTART_LINEPATH] THEN REWRITE_TAC[ARC_LINEPATH_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> ASSUME_TAC th THEN MP_TAC th) MP_TAC) THEN SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN REWRITE_TAC[ARC_LINEPATH_EQ; GSYM CONJ_ASSOC; PATH_IMAGE_LINEPATH] THEN SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL] THEN REWRITE_TAC[SET_RULE `s INTER (t UNION u) SUBSET v <=> s INTER t SUBSET v /\ s INTER u SUBSET v`] THEN ASM_CASES_TAC `a:real^2 = c` THENL [DISCH_THEN(MP_TAC o CONJUNCT1) THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_SYM; INTER_ACI] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_SEGMENT; FINITE_INSERT; FINITE_EMPTY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN STRIP_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `CONS (b:real^2) (CONS c p)` ARC_POLYGONAL_PATH_IMP_DISTINCT) THEN ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS] THEN REWRITE_TAC[PAIRWISE; ALL] THEN REWRITE_TAC[GSYM ALL_MEM] THEN REWRITE_TAC[MESON[] `(!x. P x ==> ~(a = x)) <=> ~(P a)`] THEN STRIP_TAC THEN SUBGOAL_THEN `(b:real^2)$2 < (a:real^2)$2 /\ (b:real^2)$2 < (c:real^2)$2 /\ (!v. MEM v p ==> (b:real^2)$2 < (v:real^2)$2)` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[MEM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~collinear{a:real^2,b,c}` ASSUME_TAC THENL [REWRITE_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_IN_SEGMENT] THEN SUBGOAL_THEN `FINITE(segment[a:real^2,b] INTER segment[b,c])` MP_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{a:real^2,b}` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THENL [SUBGOAL_THEN `segment[a:real^2,b] INTER segment[b,c] = segment[a,b]` (fun th -> ASM_REWRITE_TAC[FINITE_SEGMENT; th]) THEN REWRITE_TAC[SET_RULE `s INTER t = s <=> s SUBSET t`] THEN ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; DISCH_TAC THEN UNDISCH_TAC `b IN segment[c:real^2,a]` THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT] THEN ASM_REWRITE_TAC[IN_SEGMENT; NOT_IN_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^2. x$2`) THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH `(&1 - u) * b < (&1 - u) * c /\ u * b < u * a ==> ~(b = (&1 - u) * c + u * a)`) THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_SUB_LT]; SUBGOAL_THEN `segment[a:real^2,b] INTER segment[b,c] = segment[b,c]` (fun th -> ASM_REWRITE_TAC[FINITE_SEGMENT; th]) THEN REWRITE_TAC[SET_RULE `s INTER t = t <=> t SUBSET s`] THEN ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]]; ALL_TAC] THEN SUBGOAL_THEN `?e. &0 < e /\ e <= (a:real^2)$2 - (b:real^2)$2 /\ e <= (c:real^2)$2 - (b:real^2)$2 /\ !v. MEM v p ==> e <= (v:real^2)$2 - (b:real^2)$2` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `IMAGE (\v. (v:real^2)$2 - (b:real^2)$2) (set_of_list(CONS a (CONS b (CONS c p))) DELETE b)` INF_FINITE) THEN ASM_SIMP_TAC[FINITE_SET_OF_LIST; FINITE_IMAGE; FINITE_DELETE] THEN ANTS_TAC THENL [REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REWRITE_TAC[set_of_list; GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a:real^2` THEN ASM_REWRITE_TAC[IN_DELETE; IN_INSERT]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN ASM_REWRITE_TAC[set_of_list; FORALL_IN_INSERT; IMP_CONJ; IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^2` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC) THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_SET_OF_LIST] THEN DISCH_TAC THEN EXISTS_TAC `(d:real^2)$2 - (b:real^2)$2` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INSERT; IN_SET_OF_LIST]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`a':real^2 = (&1 - e / (a$2 - b$2)) % b + e / (a$2 - b$2) % a`; `c':real^2 = (&1 - e / (c$2 - b$2)) % b + e / (c$2 - b$2) % c`] THEN SUBGOAL_THEN `a' IN segment[b:real^2,a] /\ c' IN segment[b,c]` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN REWRITE_TAC[IN_SEGMENT] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % b = (&1 - v) % a + v % b <=> (u - v) % (b - a) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN REWRITE_TAC[UNWIND_THM1] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; REAL_SUB_LE; REAL_LE_LDIV_EQ; REAL_SUB_LT; REAL_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `~(a':real^2 = b) /\ ~(c':real^2 = b)` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LT_IMP_NZ]; ALL_TAC] THEN SUBGOAL_THEN `~collinear{a':real^2,b,c'}` ASSUME_TAC THENL [UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[CONTRAPOS_THM] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN REWRITE_TAC[VECTOR_ARITH `((&1 - u) % b + u % a) - b = u % (a - b)`] THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; DOT_LMUL; DOT_RMUL] THEN MATCH_MP_TAC(REAL_FIELD `~(a = &0) /\ ~(c = &0) ==> (a * c * x) pow 2 = (a * a * y) * (c * c * z) ==> x pow 2 = y * z`) THEN ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LT_IMP_NZ]; ALL_TAC] THEN SUBGOAL_THEN `~(a':real^2 = c')` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `~collinear{a':real^2,b,c'}` THEN ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN SUBGOAL_THEN `~affine_dependent{a':real^2,b,c'}` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3]; ALL_TAC] THEN MP_TAC(ISPEC `{a':real^2,b,c'}` INTERIOR_CONVEX_HULL_EQ_EMPTY) THEN REWRITE_TAC[DIMINDEX_2; HAS_SIZE; ARITH; FINITE_INSERT; FINITE_EMPTY] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN DISCH_TAC THEN SUBGOAL_THEN `convex hull {a,b,c} INTER {x:real^2 | x$2 - b$2 <= e} = convex hull {a',b,c'}` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN REWRITE_TAC[CONVEX_HULL_3_ALT] THEN REWRITE_TAC[SUBSET; IN_INTER; FORALL_IN_GSPEC; IMP_CONJ] THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN MAP_EVERY X_GEN_TAC [`s:real`; `t:real`] THEN REPLICATE_TAC 3 DISCH_TAC THEN MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN REWRITE_TAC[VECTOR_ARITH `((&1 - u) % b + u % a) - b:real^N = u % (a - b)`] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[REAL_ADD_SUB; VECTOR_SUB_COMPONENT] THEN STRIP_TAC THEN EXISTS_TAC `(s * ((a:real^2)$2 - (b:real^2)$2)) / e` THEN EXISTS_TAC `(t * ((c:real^2)$2 - (b:real^2)$2)) / e` THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_SUB_LT; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `a / e + b / e:real = (a + b) / e`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(REAL_FIELD `y < x /\ &0 < e ==> s = (s * (x - y)) / e * e / (x - y)`) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTER; IN_ELIM_THM] THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT; REAL_SUB_REFL; REAL_LT_IMP_LE] THEN SIMP_TAC[REAL_LE_SUB_RADD; CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LE; CONVEX_CONVEX_HULL] THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `a' IN segment[b:real^2,a]` THEN SPEC_TAC(`a':real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; EXPAND_TAC "a'"; UNDISCH_TAC `c' IN segment[b:real^2,c]` THEN SPEC_TAC(`c':real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; EXPAND_TAC "c'"] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `(&1 - u) * b + u * a <= e + b <=> (a - b) * u <= e`] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN REWRITE_TAC[REAL_LE_REFL]]; ALL_TAC] THEN SUBGOAL_THEN `interior(convex hull {a,b,c}) INTER {x:real^2 | x$2 - b$2 < e} = interior(convex hull {a',b,c'})` ASSUME_TAC THENL [REWRITE_TAC[REAL_LT_SUB_RADD; GSYM INTERIOR_HALFSPACE_COMPONENT_LE] THEN ASM_REWRITE_TAC[GSYM INTERIOR_INTER; GSYM REAL_LE_SUB_RADD]; ALL_TAC] THEN SUBGOAL_THEN `?d:real^2. d IN interior(convex hull {a',b,c'}) /\ ~(d$1 = b$1)` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `~(interior(convex hull {a':real^2,b,c'}) = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^2)$1 = (b:real^2)$1` THENL [ALL_TAC; EXISTS_TAC `x:real^2` THEN ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `x + k / &2 % basis 1:real^2`) THEN ANTS_TAC THENL [REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x,x + e) = norm e`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; ARITH] THEN UNDISCH_TAC `&0 < k` THEN REAL_ARITH_TAC; DISCH_TAC] THEN EXISTS_TAC `x + k / &2 % basis 1:real^2` THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; ARITH; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> ~(b + k / &2 = b)`] THEN REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `k / &2` THEN ASM_REWRITE_TAC[REAL_HALF; SUBSET] THEN X_GEN_TAC `y:real^2` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL] THEN MATCH_MP_TAC(NORM_ARITH `!a. dist(x + a,y) < k / &2 /\ norm(a) = k / &2 ==> dist(x,y) < k`) THEN EXISTS_TAC `k / &2 % basis 1:real^2` THEN ASM_REWRITE_TAC[NORM_MUL] THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN UNDISCH_TAC `&0 < k` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `path_image(polygonal_path(CONS a (CONS b (CONS c p)))) SUBSET {x:real^2 | x$2 >= b$2}` MP_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull(set_of_list(CONS (a:real^2) (CONS b (CONS c p))))` THEN SIMP_TAC[PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL; NOT_CONS_NIL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[set_of_list; INSERT_SUBSET; IN_ELIM_THM; EMPTY_SUBSET] THEN ASM_SIMP_TAC[SUBSET; IN_SET_OF_LIST; real_ge; IN_ELIM_THM; REAL_LT_IMP_LE; REAL_LE_REFL]; GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS; NOT_CONS_NIL] THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_TAC] THEN SUBGOAL_THEN `(:real^2) DIFF {x | x$2 >= b$2} SUBSET outside(path_image (linepath(a,b) ++ linepath(b,c) ++ polygonal_path(CONS c p)))` MP_TAC THENL [MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_GE] THEN ASM_REWRITE_TAC[SUBSET; real_ge; IN_ELIM_THM]; REWRITE_TAC[SUBSET; real_ge; IN_ELIM_THM; IN_UNIV; IN_DIFF; REAL_NOT_LE] THEN DISCH_TAC] THEN ABBREV_TAC `d':real^2 = d - (&1 + (d:real^2)$2 - (b:real^2)$2) % basis 2` THEN SUBGOAL_THEN `(d':real^2) IN outside(path_image (linepath(a,b) ++ linepath(b,c) ++ polygonal_path(CONS c p)))` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "d'" THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(a':real^2)$2 - (b:real^2)$2 = e /\ (c':real^2)$2 - (b:real^2)$2 = e` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `((&1 - u) * b + u * a) - b = u * (a - b)`] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_ARITH `b < a ==> ~(a - b = &0)`]; ALL_TAC] THEN SUBGOAL_THEN `(b:real^2)$2 < (d:real^2)$2 /\ (d:real^2)$2 < (b:real^2)$2 + e` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `(d:real^2) IN interior(convex hull {a',b,c'})` THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3_MINIMAL] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`r:real`; `s:real`; `t:real`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_EQ_SUB_RADD]) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH `r + s + t = &1 ==> s = &1 - (r + t)`)) THEN REWRITE_TAC[REAL_ARITH `b < r * x + (&1 - (r + t)) * b + t * x <=> (r + t) * b < (r + t) * x`; REAL_ARITH `r * (e + b) + (&1 - (r + t)) * b + t * (e + b) < b + e <=> (r + t) * e < &1 * e`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_ADD; REAL_LT_RMUL_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(d':real^2)$2 + &1 = (b:real^2)$2` ASSUME_TAC THENL [EXPAND_TAC "d'" THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `convex hull {a':real^2,b,c'} SUBSET convex hull {a,b,c}` ASSUME_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN SIMP_TAC[HULL_INC; IN_INSERT] THEN CONJ_TAC THENL [UNDISCH_TAC `(a':real^2) IN segment[b,a]` THEN SPEC_TAC(`a':real^2`,`x:real^2`); UNDISCH_TAC `(c':real^2) IN segment[b,c]` THEN SPEC_TAC(`c':real^2`,`x:real^2`)] THEN REWRITE_TAC[GSYM SUBSET] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(d' IN convex hull {a:real^2,b,c})` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ ~(x IN t) ==> ~(x IN s)`) THEN EXISTS_TAC `{x | (x:real^2)$2 >= (b:real^2)$2}` THEN SIMP_TAC[SUBSET_HULL; CONVEX_HALFSPACE_COMPONENT_GE] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; real_ge] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(d' IN convex hull {a':real^2,b,c'})` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(segment[d:real^2,d'] INTER frontier(convex hull {a',b,c'}) = {})` MP_TAC THENL [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN CONJ_TAC THENL [EXISTS_TAC `d:real^2` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; EXISTS_TAC `d':real^2` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; IN_DIFF]]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^2` MP_TAC) THEN REWRITE_TAC[IN_INTER] THEN ASM_CASES_TAC `x:real^2 = d` THENL [ASM_REWRITE_TAC[IN_DIFF; frontier]; ALL_TAC] THEN ASM_CASES_TAC `x:real^2 = d'` THENL [ASM_REWRITE_TAC[IN_DIFF; frontier] THEN SUBGOAL_THEN `closure(convex hull {a':real^2,b,c'}) = convex hull {a',b,c'}` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MESON_TAC[COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_RULES]; ALL_TAC] THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN SUBGOAL_THEN `(d':real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL [EXPAND_TAC "d'" THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(x:real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `x:real^2`] SEGMENT_VERTICAL) THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(x:real^2 = b)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^2)$2 < (b:real^2)$2 + e` ASSUME_TAC THENL [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `x:real^2`] SEGMENT_VERTICAL) THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(x:real^2 = a) /\ ~(x = c)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(x:real^2) IN (segment(b,a) UNION segment(b,c))` ASSUME_TAC THENL [UNDISCH_TAC `(x:real^2) IN frontier(convex hull {a':real^2,b,c'})` THEN ASM_SIMP_TAC[open_segment; IN_UNION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN MATCH_MP_TAC(SET_RULE `~(x IN u) /\ s SUBSET s' /\ t SUBSET t' ==> x IN (s UNION t UNION u) ==> x IN s' \/ x IN t'`) THEN ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN DISCH_TAC THEN MP_TAC(ISPECL [`c':real^2`; `a':real^2`; `x:real^2`] SEGMENT_HORIZONTAL) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `segment[d:real^2,d'] INTER path_image(polygonal_path(CONS c p)) = {}` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `!u. t SUBSET u /\ s INTER u = {} ==> s INTER t = {}`) THEN EXISTS_TAC `{x:real^2 | x$2 >= (b:real^2)$2 + e}` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull(set_of_list(CONS c p)) :real^2->bool` THEN SIMP_TAC[PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL; NOT_CONS_NIL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_GE; set_of_list; INSERT_SUBSET] THEN REWRITE_TAC[SUBSET; IN_SET_OF_LIST; IN_ELIM_THM] THEN ASM_SIMP_TAC[real_ge; REAL_ARITH `b + e <= x <=> e <= x - b`]; REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN MP_TAC(ISPECL[`d:real^2`; `d':real^2`; `y:real^2`] SEGMENT_VERTICAL) THEN ASM_REWRITE_TAC[IN_ELIM_THM; real_ge] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `(d:real^2) IN interior(convex hull {a,b,c})` ASSUME_TAC THENL [UNDISCH_TAC `(d:real^2) IN interior(convex hull {a', b, c'})` THEN SPEC_TAC(`d:real^2`,`d:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(d':real^2 = d)` ASSUME_TAC THENL [ASM_MESON_TAC[IN_SEGMENT]; ALL_TAC] THEN SUBGOAL_THEN `!y:real^2. y IN segment[d,d'] /\ y IN (segment (b,a) UNION segment (b,c)) ==> y = x` ASSUME_TAC THENL [GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `collinear {d:real^2,x,y}` MP_TAC THENL [REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN MAP_EVERY EXISTS_TAC [`d:real^2`; `d':real^2`] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC (REWRITE_RULE[SUBSET] CONVEX_HULL_SUBSET_AFFINE_HULL) THEN ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; ENDS_IN_SEGMENT] THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION]; ALL_TAC] THEN REWRITE_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_IN_SEGMENT] THEN ASM_SIMP_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN ASM_CASES_TAC `x:real^2 = y` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(x:real^2) IN frontier(convex hull {a,b,c}) /\ (y:real^2) IN frontier(convex hull {a,b,c})` MP_TAC THENL [REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_UNION]) THEN ASM_MESON_TAC[SEGMENT_SYM]; REWRITE_TAC[frontier; IN_DIFF]] THEN ASM_CASES_TAC `y:real^2 = d` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [MAP_EVERY UNDISCH_TAC [`(d:real^2) IN segment (x,y)`; `(y:real^2) IN segment [d,d']`; `(x:real^2) IN segment(d,d')`] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN REPLICATE_TAC 2 (STRIP_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `d = (&1 - w) % ((&1 - u) % d + u % d') + w % ((&1 - v) % d + v % d') <=> ((&1 - w) * u + w * v) % (d' - d) = vec 0`] THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN REWRITE_TAC[REAL_ENTIRE] THEN ASM_REAL_ARITH_TAC; UNDISCH_TAC `~(x IN interior(convex hull {a:real^2, b, c}))` THEN UNDISCH_TAC `x IN segment (y:real^2,d)` THEN SPEC_TAC(`x:real^2`,`x:real^2`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL]; UNDISCH_TAC `~(y IN interior(convex hull {a:real^2, b, c}))` THEN UNDISCH_TAC `y IN segment (d:real^2,x)` THEN SPEC_TAC(`y:real^2`,`y:real^2`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL]]; ALL_TAC] THEN SUBGOAL_THEN `pathfinish(polygonal_path p) = (a:real^2)` ASSUME_TAC THENL [ASM_REWRITE_TAC[PATHFINISH_POLYGONAL_PATH]; ALL_TAC] THEN SUBGOAL_THEN `segment(a:real^2,b) INTER segment(b,c) = {}` ASSUME_TAC THENL [UNDISCH_TAC `segment[a:real^2,b] INTER segment[b,c] SUBSET {a, b}` THEN REWRITE_TAC[SUBSET; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(d:real^2) IN inside(path_image (linepath(a,b) ++ linepath(b,c) ++ polygonal_path(CONS c p)))` ASSUME_TAC THENL [UNDISCH_TAC `x IN segment(b:real^2,a) UNION segment (b,c)` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL [MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `d:real^2`; `d':real^2`; `linepath(b:real^2,c) ++ polygonal_path(CONS c p)`; `x:real^2`] PARITY_LEMMA) THEN SUBGOAL_THEN `path_image((linepath(b:real^2,c) ++ polygonal_path(CONS c p)) ++ linepath(a,b)) = path_image(linepath(a,b) ++ linepath(b:real^2,c) ++ polygonal_path(CONS c p))` SUBST1_TAC THENL [MATCH_MP_TAC PATH_IMAGE_SYM THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN UNDISCH_TAC `pathfinish(linepath(a,b) ++ linepath (b,c) ++ polygonal_path(CONS c p)):real^2 = a` THEN ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_POLYGONAL_PATH]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_SYM o snd) THEN ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[PATHFINISH_POLYGONAL_PATH] THEN ASM_REWRITE_TAC[NOT_CONS_NIL; LAST]; REWRITE_TAC[PATHSTART_JOIN; PATHSTART_LINEPATH]; REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_POLYGONAL_PATH] THEN ASM_REWRITE_TAC[NOT_CONS_NIL; LAST]; MATCH_MP_TAC(SET_RULE `x IN s /\ x IN t /\ (!y. y IN s /\ y IN t ==> y = x) ==> s INTER t = {x}`) THEN SUBST1_TAC(ISPECL[`a:real^2`; `b:real^2`] (CONJUNCT2 SEGMENT_SYM)) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[SEGMENT_CLOSED_OPEN]) THEN ASM SET_TAC[]; SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN ASM_REWRITE_TAC[SET_RULE `s INTER (t UNION u) = {} <=> s INTER t = {} /\ s INTER u = {}`] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^2` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `(y:real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `y:real^2`] SEGMENT_VERTICAL) THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN ASM_CASES_TAC `y:real^2 = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(SUBS[ISPECL [`a:real^2`; `b:real^2`] (CONJUNCT2 SEGMENT_SYM)]) THEN ASM_CASES_TAC `y:real^2 = c` THENL [ALL_TAC; ASM SET_TAC[]] THEN UNDISCH_THEN `y:real^2 = c` SUBST_ALL_TAC THEN MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `c:real^2`] SEGMENT_VERTICAL) THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC]; MP_TAC(ISPECL [`b:real^2`; `c:real^2`; `d:real^2`; `d':real^2`; `polygonal_path(CONS c p) ++ linepath(a:real^2,b)`; `x:real^2`] PARITY_LEMMA) THEN SUBGOAL_THEN `path_image((polygonal_path (CONS c p) ++ linepath (a,b)) ++ linepath(b:real^2,c)) = path_image(linepath(a,b) ++ linepath(b:real^2,c) ++ polygonal_path(CONS c p))` SUBST1_TAC THENL [ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; NOT_CONS_NIL; HD; LAST] THEN REWRITE_TAC[UNION_ACI]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) (GSYM SIMPLE_PATH_ASSOC) o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_SYM o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) (GSYM SIMPLE_PATH_ASSOC) o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC]] THEN ASM_SIMP_TAC[GSYM SIMPLE_PATH_ASSOC;PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; NOT_CONS_NIL; HD; LAST]; REWRITE_TAC[PATHSTART_JOIN; PATHSTART_POLYGONAL_PATH] THEN REWRITE_TAC[NOT_CONS_NIL; HD]; REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH]; MATCH_MP_TAC(SET_RULE `x IN s /\ x IN t /\ (!y. y IN s /\ y IN t ==> y = x) ==> s INTER t = {x}`) THEN SUBST1_TAC(ISPECL[`a:real^2`; `b:real^2`] (CONJUNCT2 SEGMENT_SYM)) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[SEGMENT_CLOSED_OPEN]) THEN ASM SET_TAC[]; ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; NOT_CONS_NIL; HD; PATH_IMAGE_LINEPATH; PATHFINISH_POLYGONAL_PATH; LAST] THEN ASM_REWRITE_TAC[SET_RULE `s INTER (t UNION u) = {} <=> s INTER t = {} /\ s INTER u = {}`] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^2` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `(y:real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `y:real^2`] SEGMENT_VERTICAL) THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN ASM_CASES_TAC `y:real^2 = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(SUBS[ISPECL [`a:real^2`; `b:real^2`] (CONJUNCT2 SEGMENT_SYM)]) THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_CASES_TAC `y:real^2 = a` THENL [ALL_TAC; ASM SET_TAC[]] THEN UNDISCH_THEN `y:real^2 = a` SUBST_ALL_TAC THEN MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `a:real^2`] SEGMENT_VERTICAL) THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `~affine_dependent{a:real^2,b,c}` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3]; ALL_TAC] THEN ASM_CASES_TAC `path_image(polygonal_path(CONS c p)) INTER convex hull {a,b,c} SUBSET {a:real^2,c}` THENL [MAP_EVERY EXISTS_TAC [`a:real^2`; `c:real^2`] THEN ASM_REWRITE_TAC[MEM] THEN X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN EXISTS_TAC `d:real^2` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `segment[d:real^2,y]` THEN REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {a:real^2,b,c} DIFF (segment[a,b] UNION segment[b,c])` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH; PATHSTART_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t INTER s SUBSET c ==> c SUBSET (a UNION b) ==> s DIFF (a UNION b) SUBSET UNIV DIFF (a UNION b UNION t)`)) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_UNION; ENDS_IN_SEGMENT]] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IN_DIFF] THEN CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `~(d IN frontier(convex hull {a:real^2,b,c}))` MP_TAC THENL [ASM_REWRITE_TAC[frontier; IN_DIFF]; REWRITE_TAC[FRONTIER_OF_TRIANGLE; SEGMENT_CONVEX_HULL] THEN SET_TAC[]]; REWRITE_TAC[IN_DIFF; IN_UNION] THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `y IN segment(a:real^2,c)` THEN REWRITE_TAC[open_segment; IN_DIFF; SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s /\ P x ==> x IN t`) THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `y:real^2` THEN MAP_EVERY UNDISCH_TAC [`y IN convex hull {a:real^2, b}`; `y IN segment(a:real^2,c)`] THEN REWRITE_TAC[open_segment; GSYM SEGMENT_CONVEX_HULL; IN_DIFF] THEN REWRITE_TAC[DE_MORGAN_THM; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IMP_IMP; GSYM BETWEEN_IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN REWRITE_TAC[INSERT_AC; IMP_IMP]; UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,c,a}`] THEN MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `y:real^2` THEN MAP_EVERY UNDISCH_TAC [`y IN convex hull {b:real^2, c}`; `y IN segment(a:real^2,c)`] THEN REWRITE_TAC[open_segment; GSYM SEGMENT_CONVEX_HULL; IN_DIFF] THEN REWRITE_TAC[DE_MORGAN_THM; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IMP_IMP; GSYM BETWEEN_IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN REWRITE_TAC[INSERT_AC; IMP_IMP]]; REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = (s DIFF t) INTER (s DIFF u)`] THEN MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THENL [MP_TAC(ISPECL [`convex hull {a:real^2,b,c}`; `convex hull{a:real^2,b}`] FACE_OF_STILLCONVEX) THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r /\ s) ==> r`) THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN EXISTS_TAC `{a:real^2,b}` THEN SET_TAC[]; MP_TAC(ISPECL [`convex hull {a:real^2,b,c}`; `convex hull{b:real^2,c}`] FACE_OF_STILLCONVEX) THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r /\ s) ==> r`) THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN EXISTS_TAC `{b:real^2,c}` THEN SET_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `?n:real^2. ~(n = vec 0) /\ orthogonal n (c - a) /\ &0 < n dot (c - b)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?n:real^2. ~(n = vec 0) /\ orthogonal n (c - a)` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN MATCH_MP_TAC ORTHOGONAL_TO_VECTOR_EXISTS THEN REWRITE_TAC[DIMINDEX_2; LE_REFL]; ALL_TAC] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `&0 < n dot (c - b) \/ &0 < --(n dot (c - b)) \/ (n:real^2) dot (c - b) = &0`) THENL [EXISTS_TAC `n:real^2` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `--n:real^2` THEN ASM_REWRITE_TAC[DOT_LNEG] THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; ORTHOGONAL_LNEG]; UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN MATCH_MP_TAC ORTHOGONAL_TO_ORTHOGONAL_2D THEN EXISTS_TAC `n:real^2` THEN ONCE_REWRITE_TAC[GSYM ORTHOGONAL_RNEG] THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB] THEN ASM_REWRITE_TAC[orthogonal]]; ALL_TAC] THEN SUBGOAL_THEN `n dot (a - b:real^2) = n dot (c - b)` ASSUME_TAC THENL [REWRITE_TAC[DOT_RSUB; real_sub; REAL_EQ_ADD_RCANCEL] THEN ONCE_REWRITE_TAC[REAL_ARITH `x = y <=> y - x = &0`] THEN ASM_REWRITE_TAC[GSYM DOT_RSUB; GSYM orthogonal]; ALL_TAC] THEN SUBGOAL_THEN `!y:real^2. y IN convex hull {a,b,c} /\ ~(y = b) ==> &0 < n dot (y - b)` ASSUME_TAC THENL [REWRITE_TAC[CONVEX_HULL_3_ALT; FORALL_IN_GSPEC; IMP_CONJ] THEN REWRITE_TAC[VECTOR_ARITH `(a + u % (b - a) + v % (c - a)) - b = (&1 - u - v) % (a - b) + v % (c - b)`] THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MAP_EVERY X_GEN_TAC [`r:real`; `s:real`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(&1 - u - v) * x + v * x = (&1 - u) * x`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `r = &1 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN UNDISCH_TAC `~(a + r % (b - a) + s % (c - a):real^2 = b)` THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_SUB_LT] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!y:real^2. y IN convex hull {a,b,c} ==> &0 <= n dot (y - b)` ASSUME_TAC THENL [GEN_TAC THEN ASM_CASES_TAC `y:real^2 = b` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO; REAL_LE_REFL] THEN ASM_MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `!y:real^2. y IN convex hull {a,b,c} ==> n dot (y - b) <= n dot (c - b)` ASSUME_TAC THENL [REWRITE_TAC[CONVEX_HULL_3_ALT; FORALL_IN_GSPEC] THEN REWRITE_TAC[VECTOR_ARITH `(a + u % (b - a) + v % (c - a)) - b = (&1 - u - v) % (a - b) + v % (c - b)`] THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL; REAL_ARITH `(&1 - u - v) * x + v * x <= x <=> &0 <= u * x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`\x:real^2. n dot (x - b)`; `path_image (polygonal_path(CONS c p)) INTER convex hull {a:real^2,b,c}`] CONTINUOUS_ATTAINS_INF) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC COMPACT_INTER THEN SIMP_TAC[COMPACT_PATH_IMAGE; PATH_POLYGONAL_PATH] THEN SIMP_TAC[COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]; ASM SET_TAC[]; SUBGOAL_THEN `(\x:real^2. n dot (x - b)) = (\x. n dot x) o (\x. x - b)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `?mx:real^2. ~(mx = a) /\ ~(mx = c) /\ mx IN path_image(polygonal_path(CONS c p)) INTER convex hull {a, b, c} /\ (!y. y IN path_image(polygonal_path(CONS c p)) INTER convex hull {a, b, c} ==> n dot (mx - b) <= n dot (y - b))` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `mx:real^2` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `n dot (mx - b:real^2) <= n dot (c - b)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL [EXISTS_TAC `mx:real^2` THEN ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN UNDISCH_TAC `~(path_image(polygonal_path(CONS c p)) INTER convex hull {a, b, c} SUBSET {a:real^2, c})` THEN REWRITE_TAC[SUBSET; NOT_FORALL_THM; NOT_IMP; IN_INSERT; NOT_IN_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `my:real^2` THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^2` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `n dot (mx - b:real^2)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]; FIRST_X_ASSUM(CHOOSE_THEN (K ALL_TAC))] THEN ABBREV_TAC `m = (n:real^2) dot (mx - b)` THEN SUBGOAL_THEN `&0 < m` ASSUME_TAC THENL [EXPAND_TAC "m" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST_ALL_TAC] THEN UNDISCH_TAC `segment[b:real^2,c] INTER path_image (polygonal_path (CONS c p)) SUBSET {c}` THEN REWRITE_TAC[SUBSET; IN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `b:real^2`) THEN ASM_REWRITE_TAC[IN_SING; ENDS_IN_SEGMENT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?z:real^2. MEM z p /\ z IN (convex hull {a,b,c} DIFF {a,c}) /\ n dot (z - b) = m` STRIP_ASSUME_TAC THENL [ALL_TAC; MAP_EVERY EXISTS_TAC [`b:real^2`; `z:real^2`] THEN ASM_REWRITE_TAC[MEM] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; DISCH_TAC] THEN X_GEN_TAC `w:real^2` THEN DISCH_TAC THEN MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN EXISTS_TAC `d:real^2` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(z:real^2 = a) /\ ~(z = c)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(z:real^2) IN path_image(polygonal_path(CONS c p)) /\ (z:real^2) IN path_image(polygonal_path p)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC (REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM]; ALL_TAC] THEN SUBGOAL_THEN `~(z IN segment[a:real^2,b]) /\ ~(z IN segment[b,c])` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~collinear{b:real^2,a,z} /\ ~collinear{b,c,z}` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN MATCH_MP_TAC(SET_RULE `!c. x IN c /\ ~(x IN (a INTER c)) /\ ~(x IN (b INTER c)) ==> ~(x IN a) /\ ~(x IN b)`) THEN EXISTS_TAC `convex hull {a:real^2,b,c}` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL; INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT] THEN ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment(b:real^2,z) INTER segment[a,b] = {} /\ segment(b,z) INTER segment[b,c] = {}` STRIP_ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN CONJ_TAC THEN X_GEN_TAC `v:real^2` THEN STRIP_TAC THENL [UNDISCH_TAC `~collinear{b:real^2,a,z}`; UNDISCH_TAC `~collinear{b:real^2,c,z}`] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `v:real^2` THEN UNDISCH_TAC `v IN segment(b:real^2,z)` THEN REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[DE_MORGAN_THM; IMP_CONJ] THENL [UNDISCH_TAC `v IN segment[a:real^2,b]`; UNDISCH_TAC `v IN segment[b:real^2,c]`] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN REWRITE_TAC[INSERT_AC] THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment[b:real^2,z] SUBSET convex hull {a,b,c}` ASSUME_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN SIMP_TAC[HULL_INC; IN_INSERT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment(b:real^2,z) SUBSET convex hull {a,b,c}` ASSUME_TAC THENL [REWRITE_TAC[open_segment] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment(b:real^2,z) INTER path_image(polygonal_path(CONS c p)) = {}` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `v:real^2` THEN STRIP_TAC THEN SUBGOAL_THEN `m <= n dot (v - b:real^2)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LE] THEN UNDISCH_TAC `v IN segment(b:real^2,z)` THEN REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[DOT_RMUL; VECTOR_ARITH `((&1 - t) % a + t % b) - a:real^N = t % (b - a)`] THEN ONCE_REWRITE_TAC[REAL_ARITH `t * m < m <=> &0 < m * (&1 - t)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT]; ALL_TAC] THEN SUBGOAL_THEN `segment(b:real^2,z) SUBSET interior(convex hull {a,b,c})` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(convex hull {a:real^2,b,c}) DIFF frontier(convex hull {a,b,c})` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF (u DIFF t) SUBSET t`) THEN REWRITE_TAC[CLOSURE_SUBSET]] THEN REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN MATCH_MP_TAC(SET_RULE `s INTER a = {} /\ s INTER b = {} /\ s INTER c = {} /\ s SUBSET u ==> s SUBSET u DIFF (a UNION b UNION c)`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `v:real^2` THEN REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^2. n dot (x - b)`) THEN REWRITE_TAC[VECTOR_ARITH `((&1 - u) % c + u % a) - b = (&1 - u) % (c - b) + u % (a - b)`] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_ADD_LID; VECTOR_MUL_RZERO] THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < m * (&1 - t) /\ m <= x ==> ~((&1 - s) * x + s * x = t * m)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[IN_INTER; IN_INSERT; HULL_INC] THEN MATCH_MP_TAC (REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN REWRITE_TAC[set_of_list; IN_INSERT]; ALL_TAC] THEN SUBGOAL_THEN `?y:real^2. y IN segment(b,z) /\ y IN interior(convex hull {a',b,c'})` STRIP_ASSUME_TAC THENL [REWRITE_TAC[INTER; GSYM(ASSUME `interior(convex hull {a, b, c}) INTER {x:real^2 | x$2 - b$2 < e} = interior(convex hull {a', b, c'})`)] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(SET_RULE `(?y. y IN s /\ P y) /\ s SUBSET t ==> ?y. y IN s /\ y IN t /\ P y`) THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `b + min (&1 / &2) (e / &2 / norm(z - b)) % (z - b):real^2` THEN CONJ_TAC THENL [EXISTS_TAC `min (&1 / &2) (e / &2 / norm (z - b:real^2))` THEN REPEAT CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC; VECTOR_ARITH_TAC] THEN REWRITE_TAC[REAL_LT_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_ADD_SUB] THEN MATCH_MP_TAC(REAL_ARITH `abs(x$2) <= norm x /\ norm x <= e / &2 /\ &0 < e ==> x$2 < e`) THEN SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_2; ARITH] THEN ASM_REWRITE_TAC[NORM_MUL] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(min (&1 / &2) x) <= x`) THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ]]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `y:real^2` THEN CONJ_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `interior(convex hull {a':real^2,b,c'})` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERIOR; CONVEX_CONVEX_HULL] THEN SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF (a UNION b UNION c) <=> s INTER a = {} /\ s INTER b = {} /\ s INTER c = {}`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t INTER u = {} ==> s INTER u = {}`) THEN EXISTS_TAC `interior(convex hull {a:real^2,b,c})` THEN ASM_SIMP_TAC[SUBSET_INTERIOR] THEN MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`] FRONTIER_OF_TRIANGLE) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; frontier] THEN MATCH_MP_TAC(SET_RULE `!s. i SUBSET s /\ s SUBSET c ==> c DIFF i = a UNION b ==> i INTER a = {}`) THEN EXISTS_TAC `convex hull {a:real^2,b,c}` THEN REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]; MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t INTER u = {} ==> s INTER u = {}`) THEN EXISTS_TAC `interior(convex hull {a:real^2,b,c})` THEN ASM_SIMP_TAC[SUBSET_INTERIOR] THEN MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`] FRONTIER_OF_TRIANGLE) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; frontier] THEN MATCH_MP_TAC(SET_RULE `!s. i SUBSET s /\ s SUBSET c ==> c DIFF i = a UNION b UNION d ==> i INTER b = {}`) THEN EXISTS_TAC `convex hull {a:real^2,b,c}` THEN REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]; MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ u INTER t = {} ==> s INTER u = {}`) THEN EXISTS_TAC `{x | (x:real^2)$2 - (b:real^2)$2 < e}` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; REAL_NOT_LT; IN_UNIV] THEN MP_TAC(ISPEC `CONS (c:real^2) p` PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL) THEN REWRITE_TAC[NOT_CONS_NIL] THEN MATCH_MP_TAC(SET_RULE `t SUBSET {x | P x} ==> s SUBSET t ==> !x. x IN s ==> P x`) THEN REWRITE_TAC[REAL_ARITH `e <= x - b <=> x >= b + e`] THEN SIMP_TAC[SUBSET_HULL; CONVEX_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[set_of_list; REAL_ARITH `x >= b + e <=> e <= x - b`] THEN ASM_REWRITE_TAC[INSERT_SUBSET; IN_ELIM_THM] THEN ASM_REWRITE_TAC[SUBSET; IN_SET_OF_LIST; IN_ELIM_THM]]; REWRITE_TAC[connected_component] THEN EXISTS_TAC `segment(b:real^2,z)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONNECTED_SEGMENT] THEN SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN ASM SET_TAC[]]] THEN SUBGOAL_THEN `?u v:real^2. MEM u (CONS c p) /\ MEM v (CONS c p) /\ mx IN segment[u,v] /\ segment[u,v] SUBSET path_image(polygonal_path(CONS c p)) /\ ~(a IN segment[u,v] /\ c IN segment[u,v]) /\ n dot (u - b) <= m` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`CONS (c:real^2) p`; `mx:real^2`] PATH_IMAGE_POLYGONAL_PATH_SUBSET_SEGMENTS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[LENGTH; ARITH_RULE `3 <= SUC n <=> 2 <= n`] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN ASM_REWRITE_TAC[NOT_CONS_NIL; LAST; HD] THEN STRIP_TAC THEN SUBGOAL_THEN `n dot (u - b) <= m \/ n dot (v - b:real^2) <= m` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_NOT_LT; GSYM DE_MORGAN_THM] THEN STRIP_TAC THEN UNDISCH_TAC `n dot (mx - b:real^2) = m` THEN UNDISCH_TAC `(mx:real^2) IN segment[u,v]` THEN REWRITE_TAC[IN_SEGMENT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `((&1 - u) % x + u % y) - a:real^N = (&1 - u) % (x - a) + u % (y - a)`] THEN MATCH_MP_TAC(REAL_ARITH `--x < --m ==> ~(x = m)`) THEN REWRITE_TAC[GSYM DOT_LNEG] THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REWRITE_TAC[DOT_LNEG; REAL_LT_NEG2] THEN ASM_REAL_ARITH_TAC; MAP_EVERY EXISTS_TAC [`u:real^2`; `v:real^2`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[]; MAP_EVERY EXISTS_TAC [`v:real^2`; `u:real^2`] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `n dot (u - b:real^2) < n dot (c - b)` THENL [SUBGOAL_THEN `~(u:real^2 = a) /\ ~(u = c)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN UNDISCH_TAC `MEM (u:real^2) (CONS c p)` THEN ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN EXISTS_TAC `u:real^2` THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM_CASES_TAC `mx:real^2 = u` THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [DISCH_TAC THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM]; ALL_TAC] THEN MP_TAC(ISPECL [`segment(u:real^2,mx)`; `convex hull {a:real^2,b,c}`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_SEGMENT] THEN MATCH_MP_TAC(SET_RULE `(s SUBSET c ==> u IN c) /\ s INTER f = {} /\ ~(s INTER c = {}) ==> (~(s INTER c = {}) /\ ~(s DIFF c = {}) ==> ~(s INTER f = {})) ==> u IN c`) THEN REPEAT CONJ_TAC THENL [DISCH_TAC THEN SUBGOAL_THEN `closure(segment(u:real^2,mx)) SUBSET convex hull {a,b,c}` MP_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN SIMP_TAC[FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]; ASM_REWRITE_TAC[SUBSET; CLOSURE_SEGMENT] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ENDS_IN_SEGMENT]]; REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN MATCH_MP_TAC(SET_RULE `!a b c t u. s SUBSET t /\ t SUBSET u /\ a IN ca /\ c IN ca /\ ab INTER u SUBSET {a,b} /\ bc INTER u SUBSET {c} /\ ~(b IN u) /\ s INTER ca = {} ==> s INTER (ab UNION bc UNION ca) = {}`) THEN MAP_EVERY EXISTS_TAC [`a:real^2`; `b:real^2`; `c:real^2`; `segment[u:real^2,v]`; `path_image(polygonal_path(CONS (c:real^2) p))`] THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; SUBSET_SEGMENT] THEN CONJ_TAC THENL [MP_TAC(ISPEC `CONS (c:real^2) p` PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL) THEN REWRITE_TAC[NOT_CONS_NIL] THEN MATCH_MP_TAC(SET_RULE `~(x IN t) ==> s SUBSET t ==> ~(x IN s)`) THEN MATCH_MP_TAC(SET_RULE `!t. ~(b IN t) /\ s SUBSET t ==> ~(b IN s)`) THEN EXISTS_TAC `{x:real^2 | (x:real^2)$2 >= (b:real^2)$2 + e}` THEN ASM_REWRITE_TAC[IN_ELIM_THM; real_ge; REAL_NOT_LE; REAL_LT_ADDR] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[GSYM real_ge; CONVEX_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[SUBSET; set_of_list; FORALL_IN_INSERT; IN_ELIM_THM] THEN ASM_REWRITE_TAC[IN_SET_OF_LIST; REAL_ARITH `x >= b + e <=> e <= x - b`]; REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^2` THEN REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^2. n dot (x - b)`) THEN REWRITE_TAC[VECTOR_ARITH `((&1 - u) % c + u % a) - b = (&1 - u) % (c - b) + u % (a - b)`] THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `(&1 - t) * a < (&1 - t) * m /\ t * b <= t * m ==> ~((&1 - s) * m + s * m = (&1 - t) * a + t * b)`) THEN ASM_SIMP_TAC[REAL_LT_LMUL; REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN SIMP_TAC[IN_INTER; HULL_INC; IN_INSERT] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN REWRITE_TAC[set_of_list; IN_INSERT]]; ALL_TAC] THEN ASM_CASES_TAC `mx IN interior(convex hull {a:real^2,b,c})` THENL [UNDISCH_TAC `mx IN interior(convex hull {a:real^2,b,c})` THEN REWRITE_TAC[IN_INTERIOR_CBALL; SUBSET; IN_CBALL] THEN DISCH_THEN(X_CHOOSE_THEN `ee:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN REWRITE_TAC[MESON[] `(?x. (?u. P u /\ Q u /\ x = f u) /\ R x) <=> (?u. P u /\ Q u /\ R(f u))`] THEN EXISTS_TAC `min (&1 / &2) (ee / norm(u - mx:real^2))` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < min (&1 / &2) x`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[dist; VECTOR_ARITH `a - ((&1 - u) % a + u % b):real^N = u % (a - b)`] THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> abs(min (&1 / &2) x) <= x`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]; ALL_TAC] THEN MP_TAC(ISPEC `{a:real^2,b,c}` AFFINE_INDEPENDENT_SPAN_EQ) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DIMINDEX_2] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN REWRITE_TAC[AFFINE_HULL_3; IN_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `u:real^2`) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`r:real`; `s:real`; `t:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `mx IN convex hull {a:real^2,b,c}` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN REWRITE_TAC[CONVEX_HULL_3] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[IN_INTER; EXISTS_IN_GSPEC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`rx:real`; `sx:real`; `tx:real`] THEN ASM_CASES_TAC `rx = &0` THENL [ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_LID] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN STRIP_TAC THEN UNDISCH_TAC `segment[b:real^2,c] INTER path_image(polygonal_path(CONS c p)) SUBSET {c}` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `mx:real^2`) THEN MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN REWRITE_TAC[IN_SING] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTER; SEGMENT_CONVEX_HULL] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[CONVEX_HULL_2; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `rx = &1` THENL [ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `sx = &0 /\ tx = &0` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_RID]; ALL_TAC] THEN ASM_CASES_TAC `tx = &0` THENL [ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_RID] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN STRIP_TAC THEN UNDISCH_TAC `segment[a:real^2,b] INTER path_image(polygonal_path(CONS c p)) SUBSET {a,b}` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `mx:real^2`) THEN MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST_ALL_TAC] THEN UNDISCH_TAC `n dot (b - b:real^2) = m` THEN REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_INTER; SEGMENT_CONVEX_HULL] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[CONVEX_HULL_2; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `tx = &1` THENL [ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `sx = &0 /\ rx = &0` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID]; ALL_TAC] THEN ASM_CASES_TAC `sx = &1` THENL [ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `rx = &0 /\ tx = &0` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `n dot (b - b:real^2) = m` THEN REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `sx = &0` THENL [ALL_TAC; STRIP_TAC THEN UNDISCH_TAC `~(mx IN interior(convex hull {a:real^2, b, c}))` THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`rx:real`; `sx:real`; `tx:real`] THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN UNDISCH_THEN `sx = &0` SUBST_ALL_TAC THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; REAL_LE_REFL] THEN REWRITE_TAC[REAL_ADD_LID] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < rx /\ rx < &1 /\ &0 < tx /\ tx < &1` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN SUBGOAL_THEN `?q. q * (rx - r) <= rx /\ q * (tx - t) <= tx /\ &0 < q /\ q < &1` STRIP_ASSUME_TAC THENL [EXISTS_TAC `min (&1 / &2) (min (if rx:real = r then &1 / &2 else rx / abs(rx - r)) (if tx:real = t then &1 / &2 else tx / abs(tx - t)))` THEN REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT CONJ_TAC THENL [ASM_CASES_TAC `r:real = rx` THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `~(x = y) ==> &0 < abs(x - y)`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= x /\ &0 <= b ==> abs(min a (min x b)) <= x`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ASM_CASES_TAC `t:real = tx` THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `~(x = y) ==> &0 < abs(x - y)`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= x /\ &0 <= b ==> abs(min a (min b x)) <= x`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV; COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`(&1 - q) * rx + q * r`; `q * s:real`; `(&1 - q) * tx + q * t:real`] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `((&1 - q) * rx + q * r) + q * s + ((&1 - q) * tx + q * t) = (rx + tx) + q * ((r + s + t) - (rx + tx))`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `&0 <= (&1 - q) * r + q * s <=> q * (r - s) <= r`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN UNDISCH_TAC `n dot (u - b:real^2) < n dot (c - b)` THEN ASM_REWRITE_TAC[VECTOR_ARITH `(r % a + s % b + t % c) - b = r % (a - b) + t % (c - b) + ((r + s + t) - &1) % b`] THEN REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN REWRITE_TAC[REAL_ARITH `r * x + s * x < x <=> &0 < (&1 - r - s) * x`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `n dot (u - b) = m /\ n dot (c - b) = m` MP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `!mx. n dot (u - b) <= m /\ ~(n dot (u - b) < n dot (c - b)) /\ n dot (mx - b) = m /\ n dot (mx - b) <= n dot (c - b) ==> n dot (u - b) = m /\ n dot (c - b) = m`) THEN EXISTS_TAC `mx:real^2` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[IN_INTER; HULL_INC; IN_INSERT] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN REWRITE_TAC[set_of_list; IN_INSERT]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)) THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`m <= m`; `~(m < m)`] THEN SUBGOAL_THEN `collinear {a:real^2,mx,c} /\ collinear {a,u,c}` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `!y:real^2. n dot (y - b) = m ==> collinear {a,y,c}` (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN ASM_REWRITE_TAC[]) THEN X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN MATCH_MP_TAC ORTHOGONAL_TO_ORTHOGONAL_2D THEN EXISTS_TAC `n:real^2` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM ORTHOGONAL_RNEG] THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB] THEN MAP_EVERY UNDISCH_TAC [`n dot (y - b:real^2) = m`; `n dot (c - b:real^2) = m`] THEN REWRITE_TAC[orthogonal; DOT_RSUB] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `mx:real^2 = u` THENL [UNDISCH_THEN `mx:real^2 = u` SUBST_ALL_TAC THEN UNDISCH_TAC `MEM (u:real^2) (CONS c p)` THEN ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN EXISTS_TAC `u:real^2` THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `mx:real^2 = v` THENL [UNDISCH_THEN `mx:real^2 = v` SUBST_ALL_TAC THEN UNDISCH_TAC `MEM (v:real^2) (CONS c p)` THEN ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN EXISTS_TAC `v:real^2` THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `collinear {a:real^2,c,mx,u}` ASSUME_TAC THENL [ASM_SIMP_TAC[COLLINEAR_4_3] THEN ONCE_REWRITE_TAC[SET_RULE `{a,c,b} = {a,b,c}`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `collinear {a:real^2,u,v}` ASSUME_TAC THENL [MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `mx:real^2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{a:real^2,c,mx,u}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]]; ALL_TAC] THEN SUBGOAL_THEN `collinear {c:real^2,u,v}` ASSUME_TAC THENL [MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `mx:real^2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{a:real^2,c,mx,u}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]]; ALL_TAC] THEN ASM_CASES_TAC `u:real^2 = v` THENL [UNDISCH_THEN `u:real^2 = v` SUBST_ALL_TAC THEN ASM_MESON_TAC[SEGMENT_REFL; IN_SING]; ALL_TAC] THEN SUBGOAL_THEN `collinear {a:real^2,v,c}` ASSUME_TAC THENL [MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `u:real^2` THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN ASM_REWRITE_TAC[INSERT_AC]; ALL_TAC] THEN MP_TAC(ISPECL [`a:real^2`; `c:real^2`; `u:real^2`; `v:real^2`; `mx:real^2`] between_lemma) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MP_TAC(ISPECL [`{a:real^2,b,c}`; `{a:real^2,c}`] AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL) THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN ANTS_TAC THENL [SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL] THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{a:real^2,c,mx,u}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; ALL_TAC] THEN STRIP_TAC THENL [EXISTS_TAC `u:real^2` THEN MP_TAC(ASSUME `u IN segment(a:real^2,c)`) THEN REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN UNDISCH_TAC `MEM (u:real^2) (CONS c p)` THEN ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(u:real^2) IN segment[a,c]` THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN SPEC_TAC(`u:real^2`,`u:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; EXISTS_TAC `v:real^2` THEN MP_TAC(ASSUME `v IN segment(a:real^2,c)`) THEN REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN UNDISCH_TAC `MEM (v:real^2) (CONS c p)` THEN ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [UNDISCH_TAC `(v:real^2) IN segment[a,c]` THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN SPEC_TAC(`v:real^2`,`v:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; UNDISCH_TAC `collinear {a:real^2, v, c}` THEN ONCE_REWRITE_TAC[SET_RULE `{a,v,c} = {a,c,v}`] THEN ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `(u % a + v % c) - b:real^N = u % (a - b) + v % (c - b) + ((u + v) - &1) % b`] THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL; REAL_SUB_REFL] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; GSYM REAL_ADD_RDISTRIB; REAL_MUL_LID]]; UNDISCH_TAC `segment[a:real^2,c] SUBSET segment[u,v]` THEN ASM_REWRITE_TAC[SUBSET_SEGMENT]]);; (* ------------------------------------------------------------------------- *) (* Hence the final Pick theorem by induction on number of polygon segments. *) (* ------------------------------------------------------------------------- *) let PICK = prove (`!p:(real^2)list. (!x. MEM x p ==> integral_vector x) /\ simple_path (polygonal_path p) /\ pathfinish (polygonal_path p) = pathstart (polygonal_path p) ==> measure(inside(path_image(polygonal_path p))) = &(CARD {x | x IN inside(path_image(polygonal_path p)) /\ integral_vector x}) + &(CARD {x | x IN path_image(polygonal_path p) /\ integral_vector x}) / &2 - &1`, GEN_TAC THEN WF_INDUCT_TAC `LENGTH(p:(real^2)list)` THEN DISJ_CASES_TAC (ARITH_RULE `LENGTH(p:(real^2)list) <= 4 \/ 5 <= LENGTH p`) THENL [UNDISCH_TAC `LENGTH(p:(real^2)list) <= 4` THEN POP_ASSUM(K ALL_TAC) THEN SPEC_TAC(`p:(real^2)list`,`p:(real^2)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; SIMPLE_PATH_LINEPATH_EQ] THEN X_GEN_TAC `a:real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; SIMPLE_PATH_LINEPATH_EQ] THEN X_GEN_TAC `b:real^2` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL [REWRITE_TAC[polygonal_path; SIMPLE_PATH_LINEPATH_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^2` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL [REPLICATE_TAC 4 (DISCH_THEN(K ALL_TAC)) THEN REWRITE_TAC[polygonal_path] THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_CASES_TAC `c:real^2 = a` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[ARC_LINEPATH_EQ] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN SUBST1_TAC(ISPECL [`b:real^2`; `a:real^2`] (CONJUNCT1 SEGMENT_SYM)) THEN REWRITE_TAC[INTER_IDEMPOT] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN ASM_REWRITE_TAC[FINITE_SEGMENT; FINITE_INSERT; FINITE_EMPTY]; ALL_TAC] THEN X_GEN_TAC `d:real^2` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL [REPLICATE_TAC 5 (DISCH_THEN(K ALL_TAC)); REWRITE_TAC[LENGTH; ARITH_RULE `~(SUC(SUC(SUC(SUC(SUC n)))) <= 4)`]] THEN REWRITE_TAC[polygonal_path; PATHSTART_JOIN; PATHFINISH_JOIN] THEN REWRITE_TAC[GSYM IN_SET_OF_LIST; set_of_list] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_CASES_TAC `d:real^2 = a` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM SUBST1_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATH_IMAGE_JOIN; PATHSTART_LINEPATH; ARC_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_LINEPATH] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[INSIDE_OF_TRIANGLE] THEN REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE] THEN SIMP_TAC[MEASURE_INTERIOR; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CONVEX_HULL; FINITE_IMP_BOUNDED_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY] THEN ASM_SIMP_TAC[PICK_TRIANGLE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARC_LINEPATH_EQ] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[UNION_OVER_INTER] THEN REWRITE_TAC[UNION_SUBSET] THEN STRIP_TAC THEN SUBGOAL_THEN `segment[b:real^2,c] INTER segment [c,a] = segment[b,c] \/ segment[b,c] INTER segment [c,a] = segment[c,a] \/ segment[a,b] INTER segment [b,c] = segment[b,c]` (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL [REWRITE_TAC[SET_RULE `s INTER t = s <=> s SUBSET t`; SET_RULE `s INTER t = t <=> t SUBSET s`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_BETWEEN_CASES]) THEN REWRITE_TAC[SUBSET_SEGMENT; BETWEEN_IN_SEGMENT; ENDS_IN_SEGMENT] THEN REWRITE_TAC[SEGMENT_SYM; DISJ_ACI]; UNDISCH_TAC `segment [b,c] SUBSET {c:real^2}`; UNDISCH_TAC `segment [c,a] SUBSET {c:real^2}`; UNDISCH_TAC `segment [b,c] SUBSET {a:real^2, b}`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN ASM_REWRITE_TAC[FINITE_SEGMENT; FINITE_INSERT; FINITE_EMPTY]; STRIP_TAC] THEN MP_TAC(ISPEC `p:(real^2)list` POLYGON_CHOP_IN_TWO) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^2`;`b:real^2`] THEN STRIP_TAC THEN SUBGOAL_THEN `?p':(real^2)list. HD p' = a /\ LENGTH p' = LENGTH p /\ path_image(polygonal_path p') = path_image(polygonal_path p) /\ set_of_list p' = set_of_list p /\ simple_path(polygonal_path p') /\ pathfinish(polygonal_path p') = pathstart(polygonal_path p')` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC ROTATE_LIST_TO_FRONT_0 THEN EXISTS_TAC `p:(real^2)list` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_SIMP_TAC[ARITH_RULE `5 <= p ==> 3 <= p`] THEN REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LENGTH] THEN ASM_ARITH_TAC; ALL_TAC] THEN MAP_EVERY UNDISCH_TAC [`pathfinish(polygonal_path(p:(real^2)list)) = pathstart(polygonal_path p)`; `5 <= LENGTH(p:(real^2)list)`] THEN ASM_CASES_TAC `p:(real^2)list = []` THEN ASM_REWRITE_TAC[LENGTH; ARITH] THEN ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `l:(real^2)list` THEN REWRITE_TAC[APPEND_EQ_NIL; NOT_CONS_NIL] THEN ASM_CASES_TAC `l:(real^2)list = []` THENL [ASM_MESON_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(TL l:(real^2)list = [])` ASSUME_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `LENGTH:(real^2)list->num`) THEN ASM_SIMP_TAC[LENGTH; LENGTH_TL] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LAST_APPEND; LENGTH_APPEND; LENGTH_TL; NOT_CONS_NIL] THEN ASM_REWRITE_TAC[LAST; HD_APPEND; LENGTH] THEN REPEAT CONJ_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC PATH_IMAGE_POLYGONAL_PATH_ROTATE THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; MAP_EVERY UNDISCH_TAC [`HD(l:(real^2)list) = LAST l`; `5 <= LENGTH(p:(real^2)list)`; `~(l:(real^2)list = [])`] THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`l:(real^2)list`,`l:(real^2)list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[HD; TL; APPEND] THEN REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s ==> s UNION {a} = b INSERT s`) THEN ASM_REWRITE_TAC[LAST] THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[LAST] THEN UNDISCH_TAC `5 <= LENGTH(CONS (h:real^2) t)` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH] THEN REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL; LENGTH] THEN DISCH_TAC THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[EL] THEN ASM_ARITH_TAC; EXISTS_TAC `LENGTH(t:(real^2)list) - 1` THEN ASM_SIMP_TAC[LAST_EL] THEN ASM_ARITH_TAC]; MP_TAC(ISPEC `l:(real^2)list` SIMPLE_PATH_POLYGONAL_PATH_ROTATE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^2. MEM x p <=> MEM x p'` (fun th -> REWRITE_TAC[th] THEN RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL [ASM_REWRITE_TAC[GSYM IN_SET_OF_LIST]; ALL_TAC] THEN MAP_EVERY (C UNDISCH_THEN (SUBST_ALL_TAC o SYM)) [`set_of_list(p':(real^2)list) = set_of_list p`; `path_image(polygonal_path(p':(real^2)list)) = path_image (polygonal_path p)`; `LENGTH(p':(real^2)list) = LENGTH(p:(real^2)list)`] THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`simple_path(polygonal_path(p:(real^2)list))`; `pathfinish(polygonal_path(p:(real^2)list)) = pathstart(polygonal_path p)`] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN SPEC_TAC(`p':(real^2)list`,`p:(real^2)list`) THEN GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `?q r. 2 <= LENGTH q /\ 2 <= LENGTH r /\ LENGTH q + LENGTH r = LENGTH p + 1 /\ set_of_list q UNION set_of_list r = set_of_list p /\ pathstart(polygonal_path q) = pathstart(polygonal_path p) /\ pathfinish(polygonal_path q) = (b:real^2) /\ pathstart(polygonal_path r) = b /\ pathfinish(polygonal_path r) = pathfinish(polygonal_path p) /\ simple_path(polygonal_path q ++ polygonal_path r) /\ path_image(polygonal_path q ++ polygonal_path r) = path_image(polygonal_path p)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `simple_path(polygonal_path p) /\ 2 <= LENGTH p /\ MEM (b:real^2) p /\ ~(pathstart(polygonal_path p) = b) /\ ~(pathfinish(polygonal_path p) = b)` MP_TAC THENL [ASM_SIMP_TAC[ARITH_RULE `5 <= p ==> 2 <= p`] THEN ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; CONJ_ASSOC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MEM]; POP_ASSUM_LIST(K ALL_TAC)] THEN WF_INDUCT_TAC `LENGTH(p:(real^2)list)` THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`p:(real^2)list`,`p:(real^2)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a:real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `x:real^2` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL [REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; MEM] THEN MESON_TAC[]; REWRITE_TAC[LENGTH; ARITH]] THEN MAP_EVERY X_GEN_TAC [`y:real^2`; `l:(real^2)list`] THEN REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN DISCH_TAC THEN REWRITE_TAC[polygonal_path] THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ONCE_REWRITE_TAC[MEM] THEN ASM_CASES_TAC `a:real^2 = b` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MEM] THEN ASM_CASES_TAC `x:real^2 = b` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl) THEN STRIP_TAC THEN EXISTS_TAC `[a:real^2;b]` THEN EXISTS_TAC `CONS (b:real^2) (CONS y l)` THEN ASM_REWRITE_TAC[polygonal_path; LENGTH] THEN REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REPEAT(CONJ_TAC THENL [ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[set_of_list] THEN SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CONS (x:real^2) (CONS y l)`) THEN REWRITE_TAC[LENGTH; ARITH_RULE `n < SUC n`] THEN ANTS_TAC THENL [REWRITE_TAC[ARITH_RULE `2 <= SUC(SUC n)`] THEN ONCE_REWRITE_TAC[MEM] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SIMPLE_PATH_JOIN_IMP)) THEN ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN SIMP_TAC[PATHFINISH_LINEPATH; ARC_IMP_SIMPLE_PATH]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q:(real^2)list`; `r:(real^2)list`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`CONS (a:real^2) q`; `r:(real^2)list`] THEN ASM_REWRITE_TAC[LENGTH; NOT_CONS_NIL; HD] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[set_of_list; SET_RULE `(a INSERT s) UNION t = a INSERT (s UNION t)`]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]; ALL_TAC] THEN CONJ_TAC THENL [UNDISCH_TAC `pathfinish(polygonal_path q) = (b:real^2)` THEN REWRITE_TAC[PATHFINISH_POLYGONAL_PATH; LAST; NOT_CONS_NIL] THEN UNDISCH_TAC `2 <= LENGTH(q:(real^2)list)` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH]; ALL_TAC] THEN SUBGOAL_THEN `polygonal_path(CONS (a:real^2) q) = linepath(a,x) ++ polygonal_path q` SUBST1_TAC THENL [MAP_EVERY UNDISCH_TAC [`pathstart(polygonal_path q) = pathstart(polygonal_path (CONS (x:real^2) (CONS y l)))`; `2 <= LENGTH(q:(real^2)list)`] THEN SPEC_TAC(`q:(real^2)list`,`q:(real^2)list`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH; polygonal_path] THEN SIMP_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]; ALL_TAC] THEN SUBGOAL_THEN `pathstart(polygonal_path(CONS x (CONS y l))) = (x:real^2)` (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THENL [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]; ALL_TAC] THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (rand o rand) SIMPLE_PATH_ASSOC o snd) THEN ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN UNDISCH_TAC `simple_path(linepath(a:real^2,x) ++ polygonal_path (CONS x (CONS y l)))` THEN ASM_CASES_TAC `pathfinish(polygonal_path r) = (a:real^2)` THENL [SUBGOAL_THEN `pathfinish(polygonal_path(CONS (x:real^2) (CONS y l))) = a` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHFINISH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH] THEN STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN ASM_MESON_TAC[ARC_LINEPATH_EQ]; SUBGOAL_THEN `~(pathfinish(polygonal_path(CONS (x:real^2) (CONS y l))) = a)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SIMPLE_PATH_EQ_ARC; PATHSTART_JOIN; PATHSTART_LINEPATH; PATHFINISH_JOIN] THEN ASM_SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_JOIN] THEN REWRITE_TAC[ARC_LINEPATH_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `arc(polygonal_path q ++ polygonal_path r:real^1->real^2)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_JOIN]] THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS) THEN REWRITE_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]]; ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_JOIN; PATHFINISH_LINEPATH] THEN SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; NOT_CONS_NIL; HD; PATHSTART_POLYGONAL_PATH] THEN UNDISCH_THEN `path_image(polygonal_path q ++ polygonal_path r) = path_image(polygonal_path(CONS (x:real^2) (CONS y l)))` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_JOIN; PATHFINISH_LINEPATH] THEN SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `pathstart(polygonal_path p) = (a:real^2)` SUBST_ALL_TAC THENL [UNDISCH_TAC `5 <= LENGTH(p:(real^2)list)` THEN REWRITE_TAC[PATHSTART_POLYGONAL_PATH] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH]; ALL_TAC] THEN UNDISCH_THEN `pathfinish (polygonal_path p) = (a:real^2)` SUBST_ALL_TAC THEN UNDISCH_THEN `path_image(polygonal_path q ++ polygonal_path r):real^2->bool = path_image(polygonal_path p)` (SUBST_ALL_TAC o SYM) THEN SUBGOAL_THEN `(!x:real^2. MEM x q ==> integral_vector x) /\ (!x:real^2. MEM x r ==> integral_vector x)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM IN_SET_OF_LIST] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM IN_SET_OF_LIST; IN_UNION] THEN UNDISCH_THEN `(set_of_list q UNION set_of_list r):real^2->bool = set_of_list p` (SUBST_ALL_TAC o SYM) THEN ASM_REWRITE_TAC[IN_UNION]; ALL_TAC] THEN ABBREV_TAC `n = LENGTH(p:(real^2)list)` THEN SUBGOAL_THEN `integral_vector(a:real^2) /\ integral_vector(b:real^2)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`!x:real^2. MEM x p ==> integral_vector x`; `MEM (a:real^2) p`; `MEM (b:real^2) p`; `HD p = (a:real^2)`; `(set_of_list q UNION set_of_list r):real^2->bool = set_of_list p`; `simple_path(polygonal_path p :real^1->real^2)`] THEN SUBGOAL_THEN `3 <= LENGTH(q:(real^2)list)` ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl)) THEN REPEAT(POP_ASSUM MP_TAC) THEN SPEC_TAC(`q:(real^2)list`,`q:(real^2)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a0:real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a1:real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH; ARITH_RULE `3 <= SUC(SUC(SUC n))`] THEN REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REPEAT STRIP_TAC THEN UNDISCH_THEN `a0:real^2 = a` SUBST_ALL_TAC THEN UNDISCH_THEN `a1:real^2 = b` SUBST_ALL_TAC THEN UNDISCH_TAC `segment(a:real^2,b) SUBSET inside(path_image(linepath(a,b) ++ polygonal_path r))` THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH; PATHFINISH_LINEPATH] THEN MATCH_MP_TAC(SET_RULE `inside(s' UNION t) INTER (s' UNION t) = {} /\ ~(s = {}) /\ s SUBSET s' ==> ~(s SUBSET inside(s' UNION t))`) THEN REWRITE_TAC[INSIDE_NO_OVERLAP] THEN ASM_REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SEGMENT_EQ_EMPTY]; UNDISCH_THEN `2 <= LENGTH(q:(real^2)list)` (K ALL_TAC)] THEN SUBGOAL_THEN `3 <= LENGTH(r:(real^2)list)` ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl)) THEN REPEAT(POP_ASSUM MP_TAC) THEN SPEC_TAC(`r:(real^2)list`,`r:(real^2)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a0:real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `a1:real^2` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH; ARITH_RULE `3 <= SUC(SUC(SUC n))`] THEN REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REPEAT STRIP_TAC THEN UNDISCH_THEN `a0:real^2 = b` SUBST_ALL_TAC THEN UNDISCH_THEN `a1:real^2 = a` SUBST_ALL_TAC THEN UNDISCH_TAC `segment(a:real^2,b) SUBSET inside(path_image(polygonal_path q ++ linepath(b,a)))` THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH; PATHSTART_LINEPATH] THEN ONCE_REWRITE_TAC[CONJUNCT1 SEGMENT_SYM] THEN MATCH_MP_TAC(SET_RULE `inside(t UNION s') INTER (t UNION s') = {} /\ ~(s = {}) /\ s SUBSET s' ==> ~(s SUBSET inside(t UNION s'))`) THEN REWRITE_TAC[INSIDE_NO_OVERLAP] THEN ASM_REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SEGMENT_EQ_EMPTY]; UNDISCH_THEN `2 <= LENGTH(r:(real^2)list)` (K ALL_TAC)] THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPEC `CONS (a:real^2) r` th) THEN MP_TAC(ISPEC `CONS (b:real^2) q` th)) THEN REWRITE_TAC[LENGTH] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `polygonal_path(CONS (b:real^2) q) = linepath(b,a) ++ polygonal_path q` SUBST_ALL_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`q:(real^2)list`,`q:(real^2)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH; polygonal_path] THEN SIMP_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]; ALL_TAC] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[MEM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[PATHSTART_LINEPATH]] THEN UNDISCH_TAC `simple_path(polygonal_path q ++ polygonal_path r :real^1->real^2)` THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; ARC_LINEPATH_EQ] THEN STRIP_TAC THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET i ==> c INTER i = {} ==> (s UNION {a,b}) INTER c SUBSET {b,a}`)) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN MATCH_MP_TAC(SET_RULE `inside(s UNION t) INTER (s UNION t) = {} ==> s INTER inside(s UNION t) = {}`) THEN REWRITE_TAC[INSIDE_NO_OVERLAP]; STRIP_TAC] THEN REWRITE_TAC[LENGTH] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `polygonal_path(CONS (a:real^2) r) = linepath(a,b) ++ polygonal_path r` SUBST_ALL_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`r:(real^2)list`,`r:(real^2)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH; polygonal_path] THEN SIMP_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]; ALL_TAC] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[MEM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[PATHSTART_LINEPATH]] THEN UNDISCH_TAC `simple_path(polygonal_path q ++ polygonal_path r :real^1->real^2)` THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; ARC_LINEPATH_EQ] THEN STRIP_TAC THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET i ==> c INTER i = {} ==> (s UNION {a,b}) INTER c SUBSET {a,b}`)) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN MATCH_MP_TAC(SET_RULE `inside(s UNION t) INTER (s UNION t) = {} ==> t INTER inside(s UNION t) = {}`) THEN REWRITE_TAC[INSIDE_NO_OVERLAP]; STRIP_TAC] THEN MP_TAC(ISPECL [`polygonal_path q:real^1->real^2`; `reversepath(polygonal_path r):real^1->real^2`; `linepath(a:real^2,b)`; `a:real^2`; `b:real^2`] SPLIT_INSIDE_SIMPLE_CLOSED_CURVE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; SIMPLE_PATH_LINEPATH_EQ] THEN UNDISCH_TAC `simple_path(polygonal_path q ++ polygonal_path r :real^1->real^2)` THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATH_IMAGE_LINEPATH] THEN ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH; ARC_IMP_SIMPLE_PATH; SIMPLE_PATH_REVERSEPATH] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s INTER t SUBSET {a,b} /\ a IN s /\ b IN s /\ a IN t /\ b IN t ==> s INTER t = {a,b}`) THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN UNDISCH_TAC `segment(a:real^2,b) SUBSET inside(path_image(polygonal_path q ++ polygonal_path r))` THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN MATCH_MP_TAC(SET_RULE `a IN t /\ b IN t /\ inside(t UNION u) INTER (t UNION u) = {} ==> s SUBSET inside(t UNION u) ==> t INTER (s UNION {a,b}) = {a,b}`) THEN REWRITE_TAC[INSIDE_NO_OVERLAP] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN UNDISCH_TAC `segment(a:real^2,b) SUBSET inside(path_image(polygonal_path q ++ polygonal_path r))` THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN MATCH_MP_TAC(SET_RULE `a IN u /\ b IN u /\ inside(t UNION u) INTER (t UNION u) = {} ==> s SUBSET inside(t UNION u) ==> u INTER (s UNION {a,b}) = {a,b}`) THEN REWRITE_TAC[INSIDE_NO_OVERLAP] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET i ==> inside(q UNION r) INTER (q UNION r) = {} /\ inside(q UNION r) = i /\ ~(s = {}) ==> ~((s UNION {a,b}) INTER inside(q UNION r) = {})`)) THEN ASM_REWRITE_TAC[INSIDE_NO_OVERLAP; SEGMENT_EQ_EMPTY] THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN]]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (free_in `measure:(real^2->bool)->real` o concl))) THEN UNDISCH_TAC `segment(a:real^2,b) SUBSET inside(path_image (polygonal_path q ++ polygonal_path r))` THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH] THEN SUBST1_TAC(ISPECL [`b:real^2`; `a:real^2`] (CONJUNCT1 SEGMENT_SYM)) THEN REPEAT STRIP_TAC THEN SUBST1_TAC(SYM(ASSUME `inside(path_image(polygonal_path q) UNION segment [a,b]) UNION inside(path_image(polygonal_path r) UNION segment [a,b]) UNION (segment [a:real^2,b] DIFF {a, b}) = inside (path_image(polygonal_path q) UNION path_image(polygonal_path r))`)) THEN REWRITE_TAC[SET_RULE `{x | x IN (s UNION t) /\ P x} = {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure(inside(path_image(polygonal_path q) UNION segment[a:real^2,b])) + measure(inside(path_image (polygonal_path r) UNION segment [a,b]) UNION segment [a,b] DIFF {a, b})` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_INSIDE THEN MATCH_MP_TAC COMPACT_UNION THEN SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_SEGMENT; PATH_POLYGONAL_PATH]; MATCH_MP_TAC MEASURABLE_UNION THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_INSIDE THEN MATCH_MP_TAC COMPACT_UNION THEN SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_SEGMENT; PATH_POLYGONAL_PATH]; MATCH_MP_TAC MEASURABLE_DIFF THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN REWRITE_TAC[COMPACT_SEGMENT] THEN MATCH_MP_TAC FINITE_IMP_COMPACT THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]]; ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_EMPTY] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `segment[a:real^2,b]` THEN REWRITE_TAC[NEGLIGIBLE_SEGMENT_2] THEN SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure(inside(path_image(polygonal_path q) UNION segment[a:real^2,b])) + measure(inside(path_image(polygonal_path r) UNION segment[a,b]))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `segment[a:real^2,b]` THEN REWRITE_TAC[NEGLIGIBLE_SEGMENT_2] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN ONCE_REWRITE_TAC[SET_RULE `s UNION segment[a,b] = segment[a,b] UNION s`] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `CARD({x | x IN inside(segment[a,b] UNION path_image(polygonal_path q)) /\ integral_vector x} UNION {x | x IN inside(segment[a,b] UNION path_image(polygonal_path r)) /\ integral_vector x} UNION {x | x IN segment[a,b] DIFF {a, b} /\ integral_vector x}) = CARD {x | x IN inside(segment[a,b] UNION path_image(polygonal_path q)) /\ integral_vector x} + CARD {x | x IN inside(segment[a,b] UNION path_image(polygonal_path r)) /\ integral_vector x} + CARD {x:real^2 | x IN segment[a,b] DIFF {a, b} /\ integral_vector x}` SUBST1_TAC THENL [(CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; FINITE_UNION; BOUNDED_INSIDE; BOUNDED_UNION; BOUNDED_SEGMENT; BOUNDED_PATH_IMAGE; BOUNDED_DIFF; PATH_POLYGONAL_PATH] THEN MATCH_MP_TAC(ARITH_RULE `pr = 0 /\ qrp = 0 ==> (q + (r + p) - pr) - qrp = q + r + p`) THEN REWRITE_TAC[UNION_OVER_INTER] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} INTER {x | x IN t /\ P x} = {x | x IN (s INTER t) /\ P x}`] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE [SET_RULE `s UNION segment[a,b] = segment[a,b] UNION s`]) THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; UNION_EMPTY] THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN MATCH_MP_TAC(SET_RULE `inside(s UNION t) INTER (s UNION t) = {} ==> {x | x IN inside(s UNION t) INTER (s DIFF ab) /\ P x} = {}`) THEN REWRITE_TAC[INSIDE_NO_OVERLAP]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `q + r = &2 * x + y + &2 ==> (iq + q / &2 - &1) + (ir + r / &2 - &1) = ((iq + ir + x) + y / &2 - &1)`) THEN REWRITE_TAC[SET_RULE `{x | x IN (s UNION t) /\ P x} = {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT; BOUNDED_PATH_IMAGE; PATH_POLYGONAL_PATH; GSYM REAL_OF_NUM_SUB; INTER_SUBSET; CARD_SUBSET; ARITH_RULE `x:num <= y ==> x <= y + z`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `&2 * ab + qr = &2 * x + qab + rab + &2 ==> ((ab + q) - qab) + ((ab + r) - rab) = &2 * x + ((q + r) - qr) + &2`) THEN SUBGOAL_THEN `{x | x IN segment[a,b] /\ integral_vector x} INTER {x | x IN path_image(polygonal_path q) /\ integral_vector x} = {a,b} /\ {x:real^2 | x IN segment[a,b] /\ integral_vector x} INTER {x | x IN path_image(polygonal_path r) /\ integral_vector x} = {a,b}` (CONJUNCTS_THEN SUBST1_TAC) THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET inside(q UNION r) ==> s = c DIFF {a,b} /\ a IN q /\ b IN q /\ a IN r /\ b IN r /\ inside(q UNION r) INTER (q UNION r) = {} /\ P a /\ P b /\ a IN c /\ b IN c ==> {x | x IN c /\ P x} INTER {x | x IN q /\ P x} = {a,b} /\ {x | x IN c /\ P x} INTER {x | x IN r /\ P x} = {a,b}`)) THEN ASM_REWRITE_TAC[open_segment; INSIDE_NO_OVERLAP; ENDS_IN_SEGMENT] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `{x:real^2 | x IN path_image(polygonal_path q) /\ integral_vector x} INTER {x | x IN path_image(polygonal_path r) /\ integral_vector x} = {a,b}` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SIMPLE_PATH_JOIN_IMP)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN MATCH_MP_TAC(SET_RULE `P a /\ P b /\ a IN q /\ b IN q /\ a IN r /\ b IN r ==> (q INTER r) SUBSET {a,b} ==> {x | x IN q /\ P x} INTER {x | x IN r /\ P x} = {a,b}`) THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `x = y + &2 ==> &2 * x + &2 = &2 * y + &2 + &2 + &2`) THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN SUBGOAL_THEN `(segment(a,b) UNION {a, b}) DIFF {a, b} = segment(a:real^2,b)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `~(a IN s) /\ ~(b IN s) ==> (s UNION {a,b}) DIFF {a,b} = s`) THEN REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SET_RULE `P a /\ P b ==> {x | x IN s UNION {a,b} /\ P x} = a INSERT b INSERT {x | x IN s /\ P x}`] THEN SIMP_TAC[CARD_CLAUSES; FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT; FINITE_INSERT] THEN ASM_REWRITE_TAC[IN_INSERT; IN_ELIM_THM; ENDS_NOT_IN_SEGMENT] THEN REWRITE_TAC[REAL_OF_NUM_ADD; ARITH_RULE `SUC(SUC n) = n + 2`]);; hol-light/100/piseries.ml000066400000000000000000004642731303454263000154420ustar00rootroot00000000000000(* ========================================================================= *) (* Taylor series for tan and cot, via partial fractions expansion of cot. *) (* ========================================================================= *) needs "Library/analysis.ml";; needs "Library/transc.ml";; needs "Library/floor.ml";; needs "Library/poly.ml";; needs "Examples/machin.ml";; needs "Library/iter.ml";; (* ------------------------------------------------------------------------- *) (* Compatibility stuff for some old proofs. *) (* ------------------------------------------------------------------------- *) let REAL_LE_1_POW2 = prove (`!n. &1 <= &2 pow n`, REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> 0 < n`; EXP_LT_0; ARITH]);; let REAL_LT_1_POW2 = prove (`!n. &1 < &2 pow n <=> ~(n = 0)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&2 pow 0`)) THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let REAL_POW2_CLAUSES = prove (`(!n. &0 <= &2 pow n) /\ (!n. &0 < &2 pow n) /\ (!n. &0 <= inv(&2 pow n)) /\ (!n. &0 < inv(&2 pow n)) /\ (!n. inv(&2 pow n) <= &1) /\ (!n. &1 - inv(&2 pow n) <= &1) /\ (!n. &1 <= &2 pow n) /\ (!n. &1 < &2 pow n <=> ~(n = 0)) /\ (!n. &0 <= &1 - inv(&2 pow n)) /\ (!n. &0 <= &2 pow n - &1) /\ (!n. &0 < &1 - inv(&2 pow n) <=> ~(n = 0))`, SIMP_TAC[REAL_LE_1_POW2; REAL_LT_1_POW2; REAL_SUB_LE; REAL_SUB_LT; REAL_INV_LE_1] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_INV_EQ; REAL_POW_LT; REAL_POW_LE; REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH; REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2 pow 1)` THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_POW_MONO; REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let REAL_INTEGER_CLOSURES = prove (`(!n. ?p. abs(&n) = &p) /\ (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x + y) = &p) /\ (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x - y) = &p) /\ (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x * y) = &p) /\ (!x r. (?n. abs(x) = &n) ==> ?p. abs(x pow r) = &p) /\ (!x. (?n. abs(x) = &n) ==> ?p. abs(--x) = &p) /\ (!x. (?n. abs(x) = &n) ==> ?p. abs(abs x) = &p)`, REWRITE_TAC[GSYM integer; INTEGER_CLOSED]);; let PI_APPROX_25_BITS = time PI_APPROX_BINARY_RULE 25;; (* ------------------------------------------------------------------------- *) (* Convert a polynomial into a "canonical" list-based form. *) (* ------------------------------------------------------------------------- *) let POLYMERIZE_CONV = let pth = prove (`a = poly [a] x`, REWRITE_TAC[poly; REAL_MUL_RZERO; REAL_ADD_RID]) and qth = prove (`x * poly p x = poly (CONS (&0) p) x`, REWRITE_TAC[poly; REAL_ADD_LID]) in let conv_base = GEN_REWRITE_CONV I [pth] and conv_zero = GEN_REWRITE_CONV I [qth] and conv_step = GEN_REWRITE_CONV I [GSYM(CONJUNCT2 poly)] in let is_add = is_binop `(+):real->real->real` and is_mul = is_binop `(*):real->real->real` in let rec conv tm = if is_add tm then let l,r = dest_comb tm in let r1,r2 = dest_comb r in let th1 = AP_TERM l (AP_TERM r1 (conv r2)) in TRANS th1 (conv_step(rand(concl th1))) else if is_mul tm then let th1 = AP_TERM (rator tm) (conv (rand tm)) in TRANS th1 (conv_zero(rand(concl th1))) else conv_base tm in conv;; (* ------------------------------------------------------------------------- *) (* Basic definition of cotangent. *) (* ------------------------------------------------------------------------- *) let cot = new_definition `cot x = cos x / sin x`;; let COT_TAN = prove (`cot(x) = inv(tan(x))`, REWRITE_TAC[cot; tan; REAL_INV_DIV]);; (* ------------------------------------------------------------------------- *) (* We need to reverse sums to prove the grisly lemma below. *) (* ------------------------------------------------------------------------- *) let SUM_PERMUTE_0 = prove (`!n p. (!y. y < n ==> ?!x. x < n /\ (p(x) = y)) ==> !f. sum(0,n)(\n. f(p n)) = sum(0,n) f`, INDUCT_TAC THEN GEN_TAC THEN TRY(REWRITE_TAC[sum] THEN NO_TAC) THEN DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[LESS_SUC_REFL] THEN CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC RAND_CONV [sum] THEN REWRITE_TAC[ADD_CLAUSES] THEN ABBREV_TAC `q:num->num = \r. if r < k then p(r) else p(SUC r)` THEN SUBGOAL_THEN `!y:num. y < n ==> ?!x. x < n /\ (q x = y)` MP_TAC THENL [X_GEN_TAC `y:num` THEN DISCH_TAC THEN (MP_TAC o ASSUME) `!y. y < (SUC n) ==> ?!x. x < (SUC n) /\ (p x = y)` THEN DISCH_THEN(MP_TAC o SPEC `y:num`) THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C MP th))] THEN CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN DISCH_THEN(X_CHOOSE_THEN `x:num` STRIP_ASSUME_TAC o CONJUNCT1) THEN CONJ_TAC THENL [DISJ_CASES_TAC(SPECL [`x:num`; `k:num`] LTE_CASES) THENL [EXISTS_TAC `x:num` THEN EXPAND_TAC "q" THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&k` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN UNDISCH_TAC `k < (SUC n)` THEN REWRITE_TAC[GSYM LT_SUC_LE; LE_ADD2]; MP_TAC(ASSUME `k <= x:num`) THEN REWRITE_TAC[LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST_ALL_TAC) THENL [EXISTS_TAC `x - 1` THEN EXPAND_TAC "q" THEN BETA_TAC THEN UNDISCH_TAC `k < x:num` THEN DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[SUC_SUB1] THEN RULE_ASSUM_TAC(REWRITE_RULE[LT_SUC]) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN UNDISCH_TAC `(k + d) < k:num` THEN REWRITE_TAC[GSYM LE_SUC_LT] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[GSYM NOT_LT; REWRITE_RULE[ADD_CLAUSES] LESS_ADD_SUC]; SUBST_ALL_TAC(ASSUME `(p:num->num) x = n`) THEN UNDISCH_TAC `y < n:num` THEN ASM_REWRITE_TAC[LT_REFL]]]; SUBGOAL_THEN `!z. q z :num = p(if z < k then z else SUC z)` MP_TAC THENL [GEN_TAC THEN EXPAND_TAC "q" THEN BETA_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[]; DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN MAP_EVERY X_GEN_TAC [`x1:num`; `x2:num`] THEN STRIP_TAC THEN UNDISCH_TAC `!y. y < (SUC n) ==> ?!x. x < (SUC n) /\ (p x = y)` THEN DISCH_THEN(MP_TAC o SPEC `y:num`) THEN REWRITE_TAC[MATCH_MP LESS_SUC (ASSUME `y < n:num`)] THEN CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN DISCH_THEN(MP_TAC o SPECL [`if x1 < k then x1 else SUC x1`; `if x2 < k then x2 else SUC x2`] o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LT_SUC] THEN MATCH_MP_TAC LESS_SUC THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[SUC_INJ] THENL [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `~(x2 < k:num)` THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC x2` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; DISCH_THEN(SUBST_ALL_TAC o SYM) THEN UNDISCH_TAC `~(x1 < k:num)` THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC x1` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]]]]; DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN BETA_TAC THEN UNDISCH_TAC `k < (SUC n)` THEN REWRITE_TAC[LE_SUC; LT_SUC_LE; LE_ADD2] THEN DISCH_THEN(X_CHOOSE_TAC `d:num` o MATCH_MP LESS_EQUAL_ADD) THEN GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) [ASSUME `n = k + d:num`] THEN REWRITE_TAC[GSYM SUM_TWO] THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ASSUME `n = k + d:num`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD_SUC)] THEN REWRITE_TAC[GSYM SUM_TWO; sum; ADD_CLAUSES] THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN BINOP_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN EXPAND_TAC "q" THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN REWRITE_TAC[ASSUME `(p:num->num) k = n`; REAL_EQ_LADD] THEN REWRITE_TAC[ADD1; SUM_REINDEX] THEN BETA_TAC THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN BETA_TAC THEN REWRITE_TAC[GSYM NOT_LT] THEN DISCH_TAC THEN EXPAND_TAC "q" THEN BETA_TAC THEN ASM_REWRITE_TAC[ADD1]]]);; let SUM_REVERSE_0 = prove (`!n f. sum(0,n) f = sum(0,n) (\k. f((n - 1) - k))`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`n:num`; `\x. (n - 1) - x`] SUM_PERMUTE_0) THEN REWRITE_TAC[] THEN W(C SUBGOAL_THEN (fun th -> SIMP_TAC[th]) o funpow 2 lhand o snd) THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN DISCH_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `n - 1 - m` THEN CONJ_TAC THEN REPEAT GEN_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let SUM_REVERSE = prove (`!n m f. sum(m,n) f = sum(m,n) (\k. f(((n + 2 * m) - 1) - k))`, REPEAT GEN_TAC THEN SUBST1_TAC(ARITH_RULE `m = 0 + m`) THEN REWRITE_TAC[SUM_REINDEX] THEN GEN_REWRITE_TAC LAND_CONV [SUM_REVERSE_0] THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ THEN GEN_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN DISCH_THEN(fun th -> AP_TERM_TAC THEN MP_TAC th) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Following is lifted from fsincos taylor series. *) (* ------------------------------------------------------------------------- *) let MCLAURIN_SIN = prove (`!x n. abs(sin x - sum(0,n) (\m. (if EVEN m then &0 else -- &1 pow ((m - 1) DIV 2) / &(FACT m)) * x pow m)) <= inv(&(FACT n)) * abs(x) pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`sin`; `\n x. if n MOD 4 = 0 then sin(x) else if n MOD 4 = 1 then cos(x) else if n MOD 4 = 2 then --sin(x) else --cos(x)`] MCLAURIN_ALL_LE) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [CONJ_TAC THENL [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN MP_TAC(SYM th)) THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN UNDISCH_TAC `r MOD 4 < 4` THEN SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN SIMP_TAC[ARITH_RULE `(x + 1) - 1 = x`; ARITH_RULE `(x + 3) - 1 = x + 2`; ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`; ARITH_RULE `x * 4 = 2 * 2 * x`] THEN SIMP_TAC[DIV_MULT; ARITH_EQ] THEN REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POS] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_POW; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* The formulas marked with a star on p. 205 of Knopp's book. *) (* ------------------------------------------------------------------------- *) let COT_HALF_TAN = prove (`~(integer x) ==> (cot(pi * x) = &1 / &2 * (cot(pi * x / &2) - tan(pi * x / &2)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[cot; tan] THEN REWRITE_TAC[REAL_MUL_RID] THEN SUBGOAL_THEN `pi * x = &2 * pi * x / &2` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN ABBREV_TAC `y = pi * x / &2` THEN REWRITE_TAC[COS_DOUBLE; SIN_DOUBLE] THEN SUBGOAL_THEN `~(sin y = &0) /\ ~(cos y = &0)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "y" THEN REWRITE_TAC[SIN_ZERO; COS_ZERO; real_div] THEN CONJ_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b * c = d) <=> (b * a * c = d)`] THEN SIMP_TAC[GSYM REAL_MUL_LNEG; REAL_EQ_MUL_RCANCEL; REAL_ENTIRE; REAL_INV_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ; REAL_LT_IMP_NZ; PI_POS] THEN REWRITE_TAC[OR_EXISTS_THM] THEN REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN DISCH_THEN(CHOOSE_THEN(DISJ_CASES_THEN (MP_TAC o AP_TERM `abs`) o CONJUNCT2)) THEN UNDISCH_TAC `~(integer x)` THEN SIMP_TAC[integer; REAL_ABS_NEG; REAL_ABS_NUM; NOT_EXISTS_THM]; ALL_TAC] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&2 * sin y * cos y` THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `(h * (c * s' - s * c')) * t * s * c = (t * h) * (c * c * s * s' - s * s * c * c')`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID; REAL_POW_2]);; let COT_HALF_POS = prove (`~(integer x) ==> (cot(pi * x) = &1 / &2 * (cot(pi * x / &2) + cot(pi * (x + &1) / &2)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[cot; COS_ADD; SIN_ADD; COS_PI2; SIN_PI2] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; REAL_SUB_LZERO] THEN REWRITE_TAC[REAL_MUL_RID] THEN SUBGOAL_THEN `pi * x = &2 * pi * x / &2` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN ABBREV_TAC `y = pi * x / &2` THEN REWRITE_TAC[COS_DOUBLE; SIN_DOUBLE] THEN SUBGOAL_THEN `~(sin y = &0) /\ ~(cos y = &0)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "y" THEN REWRITE_TAC[SIN_ZERO; COS_ZERO; real_div] THEN CONJ_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b * c = d) <=> (b * a * c = d)`] THEN SIMP_TAC[GSYM REAL_MUL_LNEG; REAL_EQ_MUL_RCANCEL; REAL_ENTIRE; REAL_INV_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ; REAL_LT_IMP_NZ; PI_POS] THEN REWRITE_TAC[OR_EXISTS_THM] THEN REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN DISCH_THEN(CHOOSE_THEN(DISJ_CASES_THEN (MP_TAC o AP_TERM `abs`) o CONJUNCT2)) THEN UNDISCH_TAC `~(integer x)` THEN SIMP_TAC[integer; REAL_ABS_NEG; REAL_ABS_NUM; NOT_EXISTS_THM]; ALL_TAC] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&2 * sin y * cos y` THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `(h * c * s' + h * --s * c') * t * s * c = (t * h) * (c * c * s * s' - s * s * c * c')`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID; REAL_POW_2]);; let COT_HALF_NEG = prove (`~(integer x) ==> (cot(pi * x) = &1 / &2 * (cot(pi * x / &2) + cot(pi * (x - &1) / &2)))`, STRIP_TAC THEN ASM_SIMP_TAC[COT_HALF_POS] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBST1_TAC(REAL_ARITH `x + &1 = (x - &1) + &2`) THEN ABBREV_TAC `y = x - &1` THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[cot; SIN_ADD; COS_ADD; SIN_PI; COS_PI] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_SUB_RZERO] THEN REWRITE_TAC[real_div; REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_INV_NEG] THEN REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* By induction, the formula marked with the dagger. *) (* ------------------------------------------------------------------------- *) let COT_HALF_MULTIPLE = prove (`~(integer x) ==> !n. cot(pi * x) = sum(0,2 EXP n) (\k. cot(pi * (x + &k) / &2 pow n) + cot(pi * (x - &k) / &2 pow n)) / &2 pow (n + 1)`, DISCH_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[EXP; real_pow; REAL_DIV_1; ADD_CLAUSES; REAL_POW_1] THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[real_div; REAL_ADD_RID; REAL_SUB_RZERO; GSYM REAL_MUL_2] THEN REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID; REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(0,2 EXP n) (\k. &1 / &2 * (cot (pi * (x + &k) / &2 pow n / &2) + cot (pi * ((x + &k) / &2 pow n + &1) / &2)) + &1 / &2 * (cot (pi * (x - &k) / &2 pow n / &2) + cot (pi * ((x - &k) / &2 pow n - &1) / &2))) / &2 pow (n + 1)` THEN CONJ_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN BINOP_TAC THENL [MATCH_MP_TAC COT_HALF_POS THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = &2 pow n * (x + &k) / &2 pow n - &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; MATCH_MP_TAC COT_HALF_NEG THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = &2 pow n * (x - &k) / &2 pow n + &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; SUM_CMUL] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN BINOP_TAC THENL [ALL_TAC; REWRITE_TAC[real_pow; REAL_POW_ADD; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN SUBGOAL_THEN `!k. (x + &k) / &2 pow n + &1 = (x + &(2 EXP n + k)) / &2 pow n` (fun th -> ONCE_REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&2 pow n` THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_MUL_RID; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_ADD_AC]; ALL_TAC] THEN SUBGOAL_THEN `!k. (x - &k) / &2 pow n - &1 = (x - &(2 EXP n + k)) / &2 pow n` (fun th -> ONCE_REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&2 pow n` THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; REAL_SUB_LDISTRIB] THEN REWRITE_TAC[REAL_MUL_RID; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXP; MULT_2; GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM(CONJUNCT2 real_pow))] THEN REWRITE_TAC[SUM_ADD] THEN CONV_TAC(ONCE_DEPTH_CONV (ALPHA_CONV `j:num`)) THEN REWRITE_TAC[REAL_ADD_AC; ADD_AC]);; let COT_HALF_KNOPP = prove (`~(integer x) ==> !n. cot(pi * x) = cot(pi * x / &2 pow n) / &2 pow n + sum(1,2 EXP n - 1) (\k. cot(pi * (x + &k) / &2 pow (n + 1)) + cot(pi * (x - &k) / &2 pow (n + 1))) / &2 pow (n + 1)`, DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM(SUBST1_TAC o SPEC `n:num` o MATCH_MP COT_HALF_MULTIPLE) THEN SUBGOAL_THEN `!f. sum(0,2 EXP n) f = f 0 + sum(1,2 EXP n - 1) f` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [GEN_TAC THEN SUBGOAL_THEN `2 EXP n = 1 + (2 EXP n - 1)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [SIMP_TAC[ARITH_RULE `~(x = 0) ==> (1 + (x - 1) = x)`; EXP_EQ_0; ARITH_EQ]; ALL_TAC] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN REWRITE_TAC[SUM_1; REAL_ADD_AC]; ALL_TAC] THEN REWRITE_TAC[REAL_ADD_RID; REAL_SUB_RZERO; GSYM REAL_MUL_2] THEN GEN_REWRITE_TAC LAND_CONV [real_div] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(&2 * cot (pi * x / &2 pow n)) / &2 pow (n + 1) + sum(1,2 EXP n - 1) (\k. &1 / &2 * (cot (pi * (x + &k) / &2 pow n / &2) + cot (pi * ((x + &k) / &2 pow n - &1) / &2)) + &1 / &2 * (cot (pi * (x - &k) / &2 pow n / &2) + cot (pi * ((x - &k) / &2 pow n + &1) / &2))) / &2 pow (n + 1)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN BINOP_TAC THENL [MATCH_MP_TAC COT_HALF_NEG THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = &2 pow n * (x + &k) / &2 pow n - &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; MATCH_MP_TAC COT_HALF_POS THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = &2 pow n * (x - &k) / &2 pow n + &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; SUM_CMUL] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (a + c) + (b + d)`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUM_ADD] THEN GEN_REWRITE_TAC (funpow 2 (LAND_CONV o RAND_CONV) o RAND_CONV) [SUM_REVERSE] THEN SUBGOAL_THEN `(2 EXP n - 1 + 2 * 1) - 1 = 2 EXP n` SUBST1_TAC THENL [SUBGOAL_THEN `~(2 EXP n = 0)` MP_TAC THENL [REWRITE_TAC[EXP_EQ_0; ARITH_EQ]; SPEC_TAC(`2 EXP n`,`m:num`) THEN ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_ADD] THEN BINOP_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[LE_0; ADD_CLAUSES] THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_div] THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `(a = e) /\ (d = e) /\ (b = f) /\ (c = f) ==> ((a + b) + (c + d) = (e + f) * &2)`) THEN UNDISCH_TAC `k < 2 EXP n - 1 + 1` THEN SIMP_TAC[ARITH_RULE `~(p = 0) ==> (k < p - 1 + 1 <=> k < p)`; EXP_EQ_0; ARITH_EQ] THEN DISCH_TAC THEN SUBGOAL_THEN `!x. (x / &2 pow n + &1 = (x + &2 pow n) / &2 pow n) /\ (x / &2 pow n - &1 = (x - &2 pow n) / &2 pow n)` (fun th -> REWRITE_TAC[th]) THENL [SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_POW2_CLAUSES; REAL_ADD_RDISTRIB; REAL_SUB_RDISTRIB; REAL_MUL_LID; REAL_DIV_RMUL; REAL_LT_IMP_NZ]; ALL_TAC] THEN SUBGOAL_THEN `!x. x / &2 pow n / &2 = x / &2 pow (n + 1)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_POW_1; REAL_INV_MUL; GSYM REAL_MUL_ASSOC]; ALL_TAC] THEN ASM_SIMP_TAC[LT_IMP_LE; GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN CONJ_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Bounds on the terms in this series. *) (* ------------------------------------------------------------------------- *) let SIN_SUMDIFF_LEMMA = prove (`!x y. sin(x + y) * sin(x - y) = (sin x + sin y) * (sin x - sin y)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_ARITH `(x + y) * (x - y) = x * x - y * y`] THEN REWRITE_TAC[SIN_ADD; real_sub; SIN_NEG; COS_NEG] THEN REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; GSYM REAL_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_ARITH `(a = sx * sx + --(sy * sy)) <=> (a + sy * sy + --(sx * sx) = &0)`] THEN REWRITE_TAC[REAL_ARITH `a + --(sx * cy * cx * sy) + cx * sy * sx * cy + b = a + b`] THEN REWRITE_TAC[REAL_ARITH `(sx * cy * sx * cy + --(cx * sy * cx * sy)) + sy * sy + --(sx * sx) = (sy * sy + (sx * sx + cx * cx) * (cy * cy)) - (sx * sx + (sy * sy + cy * cy) * (cx * cx))`] THEN REWRITE_TAC[REWRITE_RULE[REAL_POW_2] SIN_CIRCLE; REAL_MUL_LID] THEN REWRITE_TAC[REAL_SUB_REFL]);; let SIN_ZERO_LEMMA = prove (`!x. (sin(pi * x) = &0) <=> integer(x)`, REWRITE_TAC[integer; SIN_ZERO; EVEN_EXISTS] THEN ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c * d = c * b * a * d`] THEN SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_MUL_RNEG] THEN SIMP_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB; REAL_EQ_MUL_LCANCEL; PI_POS; REAL_LT_IMP_NZ] THEN REWRITE_TAC[NOT_IMP; NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN REWRITE_TAC[REAL_MUL_RNEG; OR_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `(abs(x) = a) <=> &0 <= a /\ ((x = a) \/ (x = --a))`] THEN REWRITE_TAC[REAL_POS]);; let NOT_INTEGER_LEMMA = prove (`~(x = &0) /\ abs(x) < &1 ==> ~(integer x)`, ONCE_REWRITE_TAC[GSYM REAL_ABS_ZERO] THEN CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[integer; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_LT] THEN ARITH_TAC);; let NOT_INTEGER_DIV_POW2 = prove (`~(integer x) ==> ~(integer(x / &2 pow n))`, REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = &2 pow n * x / &2 pow n` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES]; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]);; let SIN_ABS_LEMMA = prove (`!x. abs(x) < pi ==> (abs(sin x) = sin(abs x))`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[SIN_0; REAL_ABS_NUM] THEN REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `&0 <= x` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [SUBGOAL_THEN `&0 < sin x` (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE]) THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[REAL_LT_LE]; SUBGOAL_THEN `&0 < --(sin x)` (fun th -> SIMP_TAC[th; SIN_NEG; REAL_ARITH `&0 < --x ==> ~(&0 <= x)`]) THEN REWRITE_TAC[GSYM SIN_NEG] THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_SIMP_TAC[REAL_ARITH `~(x = &0) /\ ~(&0 <= x) ==> &0 < --x`]]);; let SIN_EQ_LEMMA = prove (`!x y. &0 <= x /\ x < pi / &2 /\ &0 <= y /\ y < pi / &2 ==> ((sin x = sin y) <=> (x = y))`, SUBGOAL_THEN `!x y. &0 <= x /\ x < pi / &2 /\ &0 <= y /\ y < pi / &2 /\ x < y ==> sin x < sin y` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_ARITH `~(x = y) <=> x < y \/ y < x`] THEN ASM_MESON_TAC[]] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`sin`; `cos`; `x:real`; `y:real`] MVT_ALT) THEN ASM_REWRITE_TAC[DIFF_SIN; REAL_EQ_SUB_RADD] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `x < a + x <=> &0 < a`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC COS_POS_PI2 THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_LT_TRANS]);; let KNOPP_TERM_EQUIVALENT = prove (`~(integer x) /\ k < 2 EXP n ==> ((cot(pi * (x + &k) / &2 pow (n + 1)) + cot(pi * (x - &k) / &2 pow (n + 1))) / &2 pow (n + 1) = cot(pi * x / &2 pow (n + 1)) / &2 pow n / (&1 - sin(pi * &k / &2 pow (n + 1)) pow 2 / sin(pi * x / &2 pow (n + 1)) pow 2))`, let lemma = prove (`~(x = &0) /\ (x * a = b) ==> (a = b / x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `x:real` THEN ASM_SIMP_TAC[REAL_DIV_LMUL]) in REPEAT STRIP_TAC THEN SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_POW2_CLAUSES] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_POW_ADD] THEN REWRITE_TAC[REAL_POW_1; real_div] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `((a * b') * c) * b * &2 = (&2 * a) * c * b * b'`] THEN SIMP_TAC[REAL_MUL_RINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[real_div; REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB; REAL_ADD_RDISTRIB; REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_RID; GSYM real_div] THEN ABBREV_TAC `a = pi * x / &2 pow (n + 1)` THEN ABBREV_TAC `b = pi * &k / &2 pow (n + 1)` THEN SUBGOAL_THEN `~(sin(a + b) = &0) /\ ~(sin a = &0) /\ ~(sin(a - b) = &0) /\ ~(&1 - sin(b) pow 2 / sin(a) pow 2 = &0)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(TAUT `(a /\ b /\ c) /\ (b ==> d) ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[SIN_ZERO_LEMMA] THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC NOT_INTEGER_DIV_POW2 THEN ASM_REWRITE_TAC[] THENL [UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = (x + &k) - &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = (x - &k) + &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) (sin(a) pow 2)`) THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; REAL_MUL_RID] THEN REWRITE_TAC[REAL_POW_2] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * a = b * b) <=> ((a + b) * (a - b) = &0)`] THEN REWRITE_TAC[GSYM SIN_SUMDIFF_LEMMA] THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN MAP_EVERY EXPAND_TAC ["a"; "b"] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[SIN_ZERO_LEMMA] THEN REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THEN MATCH_MP_TAC NOT_INTEGER_DIV_POW2 THENL [UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = (x + &k) - &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SUBGOAL_THEN `x = (x - &k) + &k` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; ALL_TAC] THEN REWRITE_TAC[cot; TAN_ADD; real_sub] THEN REWRITE_TAC[GSYM real_sub] THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `sin(a + b)` THEN ASM_SIMP_TAC[REAL_ADD_LDISTRIB; REAL_DIV_LMUL] THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `sin(a - b)` THEN ONCE_REWRITE_TAC[REAL_ARITH `a * (b + c * d) = a * b + c * a * d`] THEN ASM_SIMP_TAC[REAL_ADD_LDISTRIB; REAL_DIV_LMUL] THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&1 - sin(b) pow 2 / sin(a) pow 2` THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c * da = b * c * a * da`] THEN ASM_SIMP_TAC[REAL_DIV_LMUL] THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `sin(a) pow 2` THEN ASM_REWRITE_TAC[REAL_POW_2; REAL_ENTIRE] THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `((sa * sa) * (&1 - sb2 * sa' * sa') * others = (sa * sa) * v * w * x * y * sa') = (others * (sa * sa - sb2 * (sa * sa') * (sa * sa')) = sa * v * w * x * y * sa * sa')`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; REAL_MUL_RID] THEN SUBGOAL_THEN `sin(a - b) * cos(a + b) + sin(a + b) * cos(a - b) = sin(&2 * a)` SUBST1_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SIN_ADD] THEN AP_TERM_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SIN_DOUBLE] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `sa * samb * sapb * &2 * ca = (&2 * sa * ca) * samb * sapb`] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[SIN_SUMDIFF_LEMMA] THEN REAL_ARITH_TAC);; let SIN_LINEAR_ABOVE = prove (`!x. abs(x) < &1 ==> abs(sin x) <= &2 * abs(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `2`] MCLAURIN_SIN) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[real_pow; REAL_POW_1] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1; REAL_MUL_LID; REAL_POW_1; REAL_ADD_LID] THEN MATCH_MP_TAC(REAL_ARITH `abs(a) <= abs(x) ==> abs(s - x) <= a ==> abs(s) <= &2 * abs(x)`) THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC; REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_ABS] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &2 * &1` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let SIN_LINEAR_BELOW = prove (`!x. abs(x) < &2 ==> abs(sin x) >= abs(x) / &3`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `3`] MCLAURIN_SIN) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[real_pow; REAL_POW_1] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1; REAL_MUL_LID; REAL_POW_1; REAL_ADD_LID] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN SIMP_TAC[real_ge; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `&3 * abs(a) <= &2 * abs(x) ==> abs(s - x) <= a ==> abs(x) <= abs(s) * &3`) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_ABS; REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC(LAND_CONV(RAND_CONV(RAND_CONV num_CONV))) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE]);; let KNOPP_TERM_BOUND_LEMMA = prove (`~(integer x) /\ k < 2 EXP n /\ &6 * abs(x) < &k ==> abs(a / (&1 - sin(pi * &k / &2 pow (n + 1)) pow 2 / sin(pi * x / &2 pow (n + 1)) pow 2)) <= abs(a) / ((&k / (&6 * x)) pow 2 - &1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL [UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_DIV] THEN ONCE_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NUM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC REAL_POW_LT2 THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN UNDISCH_TAC `&6 * abs(x) < &k` THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN MATCH_MP_TAC REAL_LT_RDIV_EQ THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; GSYM REAL_ABS_NZ]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> x - &1 <= abs(&1 - y)`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_POW_DIV] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(abs(pi * &k / &2 pow (n + 1)) / &3) * inv(&2 * abs(pi * x / &2 pow (n + 1)))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `p * k * q' * k1 * k2 * p' * x' * q = k * (k1 * k2) * x' * (p * p') * (q * q')`] THEN SIMP_TAC[REAL_INV_INV; REAL_MUL_RINV; REAL_ABS_ZERO; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; PI_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ABS_DIV] THEN GEN_REWRITE_TAC RAND_CONV [real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_DIV; REAL_LE_MUL; REAL_ABS_POS; REAL_POS] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM real_ge] THEN MATCH_MP_TAC SIN_LINEAR_BELOW THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_POW2_CLAUSES] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `pi * &2 pow n` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LT_LMUL_EQ; PI_POS; REAL_OF_NUM_POW; REAL_OF_NUM_LT]; ALL_TAC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW2_CLAUSES] THEN MATCH_MP_TAC(C MATCH_MP PI_APPROX_25_BITS (REAL_ARITH `abs(p - y) <= e ==> y + e <= a ==> p <= a`)) THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[GSYM REAL_ABS_NZ; SIN_ZERO_LEMMA] THEN ASM_SIMP_TAC[NOT_INTEGER_DIV_POW2] THEN MATCH_MP_TAC SIN_LINEAR_ABOVE THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_POW2_CLAUSES] THEN REWRITE_TAC[REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&6)` THEN CONV_TAC (LAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(&k * pi)` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN SIMP_TAC[PI_POS; REAL_ARITH `&0 < x ==> &0 < abs x`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(&2 pow n * pi)` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[LT_IMP_LE]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_POW_ADD; REAL_ABS_POW; REAL_ABS_NUM; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW2_CLAUSES] THEN MATCH_MP_TAC(C MATCH_MP PI_APPROX_25_BITS (REAL_ARITH `abs(p - y) <= e ==> abs y + e <= a ==> abs p <= a`)) THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let KNOPP_TERM_BOUND = prove (`~(integer x) /\ k < 2 EXP n /\ &6 * abs(x) < &k ==> abs((cot(pi * (x + &k) / &2 pow (n + 1)) + cot(pi * (x - &k) / &2 pow (n + 1))) / &2 pow (n + 1)) <= abs(cot(pi * x / &2 pow (n + 1)) / &2 pow n) * (&36 * x pow 2) / (&k pow 2 - &36 * x pow 2)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[KNOPP_TERM_EQUIVALENT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(cot(pi * x / &2 pow (n + 1)) / &2 pow n) / ((&k / (&6 * x)) pow 2 - &1)` THEN ASM_SIMP_TAC[KNOPP_TERM_BOUND_LEMMA] THEN GEN_REWRITE_TAC LAND_CONV [real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN AP_TERM_TAC THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&6 pow 2`)) THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_POW_DIV] THEN SUBGOAL_THEN `&0 < (&6 * x) pow 2` (fun th -> SIMP_TAC[th; REAL_EQ_RDIV_EQ; REAL_SUB_RDISTRIB; REAL_MUL_LID; REAL_DIV_RMUL; REAL_LT_IMP_NZ]) THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; (* ------------------------------------------------------------------------- *) (* Show that the series we're looking at do in fact converge... *) (* ------------------------------------------------------------------------- *) let SUMMABLE_INVERSE_SQUARES_LEMMA = prove (`(\n. inv(&(n + 1) * &(n + 2))) sums &1`, REWRITE_TAC[sums] THEN SUBGOAL_THEN `!n. sum(0,n) (\m. inv(&(m + 1) * &(m + 2))) = &1 - inv(&(n + 1))` (fun th -> REWRITE_TAC[th]) THENL [INDUCT_TAC THEN REWRITE_TAC[sum] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[REAL_ARITH `(&1 - a + b = &1 - c) <=> (b + c = a)`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV_UNIQ THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_INV_MUL; REAL_MUL_ASSOC; REAL_ADD_LDISTRIB] THEN SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_RULE `~(n + 1 = 0)`] THEN REWRITE_TAC[REAL_MUL_LID; ARITH_RULE `SUC(n + 1) = n + 2`] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(n + 2)` THEN SIMP_TAC[REAL_ADD_RDISTRIB; real_div; GSYM REAL_MUL_ASSOC; REAL_OF_NUM_EQ; REAL_MUL_LINV; ARITH_RULE `~(n + 2 = 0)`; REAL_MUL_LID; REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN MATCH_MP_TAC SEQ_SUB THEN REWRITE_TAC[SEQ_CONST] THEN MATCH_MP_TAC SEQ_INV0 THEN X_GEN_TAC `x:real` THEN X_CHOOSE_TAC `N:num` (SPEC `x:real` REAL_ARCH_SIMPLE) THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[real_gt; GE] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH_RULE `a < b + 1 <=> a <= b`]);; let SUMMABLE_INVERSE_SQUARES = prove (`summable (\n. inv(&n pow 2))`, MATCH_MP_TAC SUM_SUMMABLE THEN EXISTS_TAC `sum(0,2) (\n. inv(&n pow 2)) + suminf (\n. inv(&(n + 2) pow 2))` THEN MATCH_MP_TAC SER_OFFSET_REV THEN MATCH_MP_TAC SER_ACONV THEN MATCH_MP_TAC SER_COMPARA THEN EXISTS_TAC `\n. inv(&(n + 1) * &(n + 2))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_SUMMABLE THEN EXISTS_TAC `&1` THEN REWRITE_TAC[SUMMABLE_INVERSE_SQUARES_LEMMA]] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_POW_2; REAL_INV_MUL; REAL_ABS_INV; REAL_ABS_NUM; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC);; let SUMMABLE_INVERSE_POWERS = prove (`!m. 2 <= m ==> summable (\n. inv(&(n + 1) pow m))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\m. inv (&(m + 1) pow 2)` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 1`] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; REWRITE_TAC[summable] THEN EXISTS_TAC `suminf (\m. inv (&m pow 2)) - sum(0,1) (\m. inv (&m pow 2))` THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] SER_OFFSET) THEN REWRITE_TAC[SUMMABLE_INVERSE_SQUARES]]);; let COT_TYPE_SERIES_CONVERGES = prove (`!x. ~(integer x) ==> summable (\n. inv(&n pow 2 - x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_ACONV THEN MATCH_MP_TAC SER_COMPARA THEN EXISTS_TAC `\n. &2 / &n pow 2` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_SUMMABLE THEN EXISTS_TAC `&2 * suminf (\n. inv(&n pow 2))` THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC SER_CMUL THEN MATCH_MP_TAC SUMMABLE_SUM THEN REWRITE_TAC[SUMMABLE_INVERSE_SQUARES]] THEN MP_TAC(SPEC `&2 * abs x + &1` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < &n pow 2` (fun th -> SIMP_TAC[th; REAL_LE_RDIV_EQ]) THENL [MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `&2 * abs x + &1 <= &N` THEN REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `&0 < abs(&n pow 2 - x)` (fun th -> SIMP_TAC[REAL_LE_LDIV_EQ; th]) THENL [REWRITE_TAC[GSYM REAL_ABS_NZ] THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN DISCH_TAC THEN SUBST1_TAC(REAL_ARITH `x = &n pow 2 - (&n pow 2 - x)`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN SIMP_TAC[integer; REAL_INTEGER_CLOSURES]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&2 * abs(x) + &1 <= a ==> a <= &2 * abs(a - x)`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N pow 2` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; EXP_2; LE_SQUARE_REFL]; ASM_SIMP_TAC[REAL_POW_LE2; REAL_OF_NUM_LE; LE_0]]);; (* ------------------------------------------------------------------------- *) (* Now the rather tricky limiting argument gives the result. *) (* ------------------------------------------------------------------------- *) let SIN_X_RANGE = prove (`!x. abs(sin(x) - x) <= abs(x) pow 2 / &2`, GEN_TAC THEN MP_TAC(SPECL [`x:real`; `2`] MCLAURIN_SIN) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[ARITH; REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1; REAL_POW_1; REAL_MUL_LID] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_AC]);; let SIN_X_X_RANGE = prove (`!x. ~(x = &0) ==> abs(sin(x) / x - &1) <= abs(x) / &2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[GSYM REAL_ABS_MUL; GSYM REAL_ABS_NZ] THEN ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_POW_2; SIN_X_RANGE; GSYM real_div]);; let SIN_X_LIMIT = prove (`((\x. sin(x) / x) tends_real_real &1)(&0)`, REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) / &2` THEN ASM_SIMP_TAC[SIN_X_X_RANGE; REAL_ABS_NZ] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < e` THEN REAL_ARITH_TAC);; let COT_X_LIMIT = prove (`((\x. x * cot(x)) tends_real_real &1)(&0)`, SUBGOAL_THEN `(cos tends_real_real &1)(&0)` MP_TAC THENL [MP_TAC(SPEC `&0` DIFF_COS) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CONT) THEN REWRITE_TAC[contl; REAL_ADD_LID; COS_0] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o C CONJ SIN_X_LIMIT) THEN DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(&1 = &0)`)) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_DIV) THEN REWRITE_TAC[REAL_DIV_1; cot] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC; REAL_INV_INV]);; let COT_LIMIT_LEMMA = prove (`!x. ~(x = &0) ==> (\n. (x / &2 pow n) * cot(x / &2 pow n)) tends_num_real &1`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC COT_X_LIMIT THEN REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_TAC THEN X_CHOOSE_TAC `N:num` (SPEC `abs(x) / d` REAL_ARCH_POW2) THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_POW2_CLAUSES; REAL_LT_DIV; GSYM REAL_ABS_NZ] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW2_CLAUSES] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow N` THEN ASM_REWRITE_TAC[REAL_POW2_THM]);; let COT_LIMIT_LEMMA1 = prove (`~(x = &0) ==> (\n. (pi / &2 pow (n + 1)) * cot(pi * x / &2 pow (n + 1))) tends_num_real (inv(x))`, DISCH_TAC THEN MP_TAC(SPEC `pi * x * inv(&2)` COT_LIMIT_LEMMA) THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ; PI_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `p * x * a * b * c = x * (p * (a * b)) * c`] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ADD1; GSYM real_div] THEN DISCH_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM REAL_MUL_LID] THEN FIRST_ASSUM(SUBST1_TAC o GSYM o MATCH_MP REAL_MUL_LINV) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `x * p * q * c = x * (p * q) * c`] THEN ASM_REWRITE_TAC[GSYM real_div]);; let COT_X_BOUND_LEMMA_POS = prove (`?M. !x. &0 < x /\ abs(x) <= &1 ==> abs(x * cot(x)) <= M`, MP_TAC COT_X_LIMIT THEN REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`\x. x * cot(x)`; `d:real`; `&1`] CONT_BOUNDED_ABS) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC CONT_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `&1` THEN REWRITE_TAC[DIFF_X]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[cot] THEN MATCH_MP_TAC CONT_DIV THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `cos x` THEN REWRITE_TAC[DIFF_SIN]; MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC SIN_POS_PI THEN SUBGOAL_THEN `&1 < pi` (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS; REAL_LTE_TRANS]) THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `&1 + e < a ==> abs(p - a) <= e ==> &1 < p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN EXISTS_TAC `abs M + &2` THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN DISJ_CASES_TAC(SPECL [`abs x`; `d:real`] REAL_LTE_TOTAL) THENL [MATCH_MP_TAC(REAL_ARITH `abs(x - &1) < &1 ==> abs(x) <= abs(m) + &2`) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs(x)`]; MATCH_MP_TAC(REAL_ARITH `x <= m ==> x <= abs(m) + &2`) THEN FIRST_ASSUM MATCH_MP_TAC THEN MAP_EVERY UNDISCH_TAC [`&0 < x`; `abs(x) <= &1`; `d <= abs(x)`] THEN REAL_ARITH_TAC]);; let COT_X_BOUND_LEMMA = prove (`?M. !x. ~(x = &0) /\ abs(x) <= &1 ==> abs(x * cot(x)) <= M`, X_CHOOSE_TAC `M:real` COT_X_BOUND_LEMMA_POS THEN EXISTS_TAC `M:real` THEN X_GEN_TAC `x:real` THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `x * cot(x) = --x * cot(--x)` SUBST1_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_ABS_NEG]] THEN REWRITE_TAC[cot; SIN_NEG; COS_NEG; real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let COT_PARTIAL_FRACTIONS = prove (`~(integer x) ==> (\n. (&2 * x pow 2) / (x pow 2 - &n pow 2)) sums ((pi * x) * cot(pi * x) + &1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL [UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]; ALL_TAC] THEN ABBREV_TAC `A = \n k. (pi * x / &2 pow n) * cot(pi * x / &2 pow n) + (pi * x / &2 pow (n + 1)) * sum(1,k) (\m. cot (pi * (x + &m) / &2 pow (n + 1)) + cot (pi * (x - &m) / &2 pow (n + 1)))` THEN ABBREV_TAC `B = \n k. (pi * x / &2 pow (n + 1)) * sum(k + 1,2 EXP n - 1 - k) (\m. cot(pi * (x + &m) / &2 pow (n + 1)) + cot(pi * (x - &m) / &2 pow (n + 1)))` THEN SUBGOAL_THEN `!n. ~(x - &n = &0)` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN DISCH_TAC THEN SUBGOAL_THEN `x = (x - &n) + &n` SUBST1_TAC THENL [REAL_ARITH_TAC; ASM_SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~(x + &n = &0)` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN DISCH_TAC THEN SUBGOAL_THEN `x = (x + &n) - &n` SUBST1_TAC THENL [REAL_ARITH_TAC; ASM_SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~(x pow 2 - &n pow 2 = &0)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * a - b * b = (a + b) * (a - b)`] THEN ASM_REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM]; ALL_TAC] THEN SUBGOAL_THEN `!n. (&2 * x) / (x pow 2 - &n pow 2) = inv(x + &n) + inv(x - &n)` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `x pow 2 - &n pow 2` THEN ASM_SIMP_TAC[REAL_DIV_LMUL] THEN REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * a - b * b = (a + b) * (a - b)`] THEN ONCE_REWRITE_TAC[REAL_ARITH `(p * m) * p' + (p * m) * m' = m * p * p' + p * m * m'`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!k. (\n. A n k) tends_num_real (&1 + sum(1,k) (\n. (&2 * x pow 2) / (x pow 2 - &n pow 2)))` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "A" THEN REWRITE_TAC[] THEN MATCH_MP_TAC SEQ_ADD THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC COT_LIMIT_LEMMA THEN ASM_SIMP_TAC[REAL_ENTIRE; PI_POS; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_CMUL] THEN MATCH_MP_TAC SEQ_SUM THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_POW_2; real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x * x) * d = x * (&2 * x) * d`] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM real_div] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `(p * x * d) * cc = x * (p * d) * cc`] THEN CONJ_TAC THEN MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[COT_LIMIT_LEMMA1]; ALL_TAC] THEN SUBGOAL_THEN `!k n. &6 * abs(x) < &k ==> abs(B n k) <= abs((pi * x / &2 pow (n + 1)) * cot(pi * x / &2 pow (n + 1))) * sum(k + 1,2 EXP n - 1 - k) (\m. (&72 * x pow 2) / (&m pow 2 - &36 * x pow 2))` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "B" THEN REWRITE_TAC[GSYM SUM_CMUL] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH lhand SUM_ABS_LE (lhand w))) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ARITH_RULE `k + 1 <= r /\ r < (p - 1 - k) + k + 1 <=> k < r /\ r < p`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `abs(inv(&2 pow (n + 1)))` THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs(x)`; REAL_LT_INV_EQ; REAL_POW2_CLAUSES] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(cot (pi * x / &2 pow (n + 1)) / &2 pow n) * (&36 * x pow 2) / (&r pow 2 - &36 * x pow 2)` THEN CONJ_TAC THENL [MATCH_MP_TAC KNOPP_TERM_BOUND THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&k` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT]; ALL_TAC] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_POW_ADD; REAL_ABS_MUL; REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `a * b * c * d * e = b * c * d * a * e`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_AC; REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!e. &0 < e ==> ?N. !n k:num. N <= k /\ pi * abs(x) <= &2 pow (n + 1) ==> abs(B n k) < e` ASSUME_TAC THENL [X_CHOOSE_TAC `Bd:real` COT_X_BOUND_LEMMA THEN SUBGOAL_THEN `!k n. &9 * abs x < &k ==> abs(sum(k + 1,2 EXP n - 1 - k) (\m. (&72 * x pow 2) / (&m pow 2 - &36 * x pow 2))) <= &144 * x pow 2 / &k` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; SUM_CMUL] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_POW; REAL_POW2_ABS] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `&144 * x * y = &72 * x * &2 * y`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_SQUARE; REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * sum(k + 1,2 EXP n - 1 - k) (\m. inv(&m * &m))` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_CMUL] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH lhand SUM_ABS_LE (lhand w))) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `&0 < &r * &r - &36 * x * x` ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2] THEN REWRITE_TAC[REAL_ARITH `&0 < r * r - &36 * x * x <=> (&6 * x) * (&6 * x) < r * r`] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&k` THEN ASM_REWRITE_TAC[REAL_ABS_NUM] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[REAL_ARITH `&9 * abs(x) < a ==> &6 * abs(x) < a`] THEN UNDISCH_TAC `k + 1 <= r` THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LE_INV_EQ] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `&0 < &r` ASSUME_TAC THENL [UNDISCH_TAC `k + 1 <= r` THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_MUL] THEN REWRITE_TAC[REAL_ARITH `&1 * x <= &2 * (x - y) <=> &2 * y <= x`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &81 * x <= y ==> &2 * &36 * x <= y`) THEN REWRITE_TAC[REAL_LE_SQUARE] THEN REWRITE_TAC[REAL_ARITH `&81 * x * x = (&9 * x) * (&9 * x)`] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&k` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN UNDISCH_TAC `k + 1 <= r` THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[SUM_REINDEX] THEN SUBGOAL_THEN `?d. k = 1 + d` (CHOOSE_THEN SUBST1_TAC) THENL [REWRITE_TAC[GSYM LE_EXISTS] THEN MATCH_MP_TAC(ARITH_RULE `0 < k ==> 1 <= k`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN UNDISCH_TAC `&9 * abs(x) < &k` THEN REAL_ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`2 EXP n - 1 - (1 + d)`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o LAND_CONV) [ADD_SYM] THEN REWRITE_TAC[SUM_REINDEX] THEN REWRITE_TAC[ARITH_RULE `(r + 1) + 1 = r + 2`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(d,n) (\r. inv(&(r + 1) * &(r + 2)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN REPEAT STRIP_TAC THEN SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_INV_EQ; REAL_OF_NUM_LT; REAL_INV_MUL; ARITH_RULE `0 < n + 2`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. sum(d,n) (\r. inv (&(r + 1) * &(r + 2))) = inv(&(d + 1)) - inv(&(d + n + 1))` (fun th -> REWRITE_TAC[th]) THENL [INDUCT_TAC THEN REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN ASM_REWRITE_TAC[REAL_ARITH `((a - x) + y = a - z) <=> (y + z = x)`] THEN REWRITE_TAC[GSYM ADD_ASSOC; REAL_INV_MUL; ARITH_RULE `SUC(d + n + 1) = d + n + 2`] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(d + n + 1) * &(d + n + 2)` THEN REWRITE_TAC[REAL_ARITH `(dn1' * dn2' + dn2') * (dn1 * dn2) = (dn1 * dn1' + dn1) * (dn2 * dn2')`] THEN SIMP_TAC[REAL_ENTIRE; REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_RULE `~(d + n + 1 = 0) /\ ~(d + n + 2 = 0)`] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_OF_NUM_EQ; ARITH_RULE `~(d + n + 1 = 0)`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ADD_AC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> x - y <= x`) THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?N. &9 * abs(x) + &1 <= &N /\ (Bd * &144 * x pow 2) / e + &1 <= &N` (X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THENL [X_CHOOSE_TAC `N1:num` (SPEC `&9 * abs(x) + &1` REAL_ARCH_SIMPLE) THEN X_CHOOSE_TAC `N2:num` (SPEC `(Bd * &144 * x pow 2) / e + &1` REAL_ARCH_SIMPLE) THEN EXISTS_TAC `N1 + N2:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN ASM_MESON_TAC[REAL_POS; REAL_ARITH `a <= m /\ b <= n /\ &0 <= m /\ &0 <= n ==> a <= m + n /\ b <= m + n`]; ALL_TAC] THEN EXISTS_TAC `N:num` THEN MAP_EVERY X_GEN_TAC [`n:num`; `k:num`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs((pi * x / &2 pow (n + 1)) * cot (pi * x / &2 pow (n + 1))) * sum(k + 1,2 EXP n - 1 - k) (\m. (&72 * x pow 2) / (&m pow 2 - &36 * x pow 2))` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `&9 * abs x + &1 <= &N` THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `Bd * &144 * x pow 2 / &k` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `&0 < &k` (fun th -> SIMP_TAC[REAL_LT_LDIV_EQ; th]) THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `&9 * abs x + &1 <= &N` THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[REAL_ARITH `x + &1 <= y ==> x < y`]] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_ABS] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[real_div; REAL_ENTIRE; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; REAL_MUL_ASSOC; REAL_LT_INV_EQ; PI_POS] THEN SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW2_CLAUSES; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_MUL] THEN SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS] THEN ASM_REWRITE_TAC[GSYM real_abs]; ALL_TAC] THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N:real` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `&9 * abs x + &1 <= &N` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n k. k < 2 EXP n ==> ((pi * x) * (cot (pi * x / &2 pow n) / &2 pow n + sum (1,2 EXP n - 1) (\k. cot(pi * (x + &k) / &2 pow (n + 1)) + cot(pi * (x - &k) / &2 pow (n + 1))) / &2 pow (n + 1)) = A n k + B n k)` MP_TAC THENL [REPEAT GEN_TAC THEN DISCH_TAC THEN MAP_EVERY EXPAND_TAC ["A"; "B"] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; GSYM REAL_ADD_LDISTRIB] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV o funpow 3 LAND_CONV) [ARITH_RULE `x = 0 + x`] THEN REWRITE_TAC[SUM_REINDEX] THEN ONCE_REWRITE_TAC [REWRITE_RULE[REAL_ARITH `(a = b - c) <=> (c + a = b)`] SUM_DIFF] THEN ASM_SIMP_TAC[ARITH_RULE `n < p ==> (n + p - 1 - n = p - 1)`] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV o funpow 3 LAND_CONV) [ARITH_RULE `x = 0 + x`] THEN REWRITE_TAC[SUM_REINDEX] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COT_HALF_KNOPP) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN DISCH_TAC THEN REWRITE_TAC[sums; SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `!e. &0 < e ==> ?N. !n k:num. N <= k /\ pi * abs(x) <= &2 pow (n + 1) ==> abs (B n k) < e` THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N1 + 1` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN UNDISCH_TAC `!k. (\n. A n k) tends_num_real &1 + sum (1,k) (\n. (&2 * x pow 2) / (x pow 2 - &n pow 2))` THEN DISCH_THEN(MP_TAC o SPEC `n - 1`) THEN REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN SUBGOAL_THEN `?m. n - 1 < 2 EXP m /\ N2 <= m /\ pi * abs(x) <= &2 pow (m + 1)` MP_TAC THENL [SUBGOAL_THEN `?m. &(n - 1) + &1 <= &m /\ &N2 <= &m /\ pi * abs(x) <= &m` MP_TAC THENL [X_CHOOSE_TAC `m1:num` (SPEC `&(n - 1) + &1` REAL_ARCH_SIMPLE) THEN X_CHOOSE_TAC `m2:num` (SPEC `&N2` REAL_ARCH_SIMPLE) THEN X_CHOOSE_TAC `m3:num` (SPEC `pi * abs(x)` REAL_ARCH_SIMPLE) THEN EXISTS_TAC `m1 + m2 + m3:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `x <= a /\ y <= b /\ z <= c /\ &0 <= a /\ &0 <= b /\ &0 <= c ==> x <= a + b + c /\ y <= a + b + c /\ z <= a + b + c`) THEN ASM_REWRITE_TAC[REAL_POS]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN MATCH_MP_TAC(REAL_ARITH `m <= m2 /\ m2 <= m22 ==> x1 + &1 <= m /\ x2 <= m /\ x3 <= m ==> x1 < m2 /\ x2 <= m /\ x3 <= m22`) THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN REWRITE_TAC[REAL_ARITH `x <= x * &2 <=> &0 <= x`] THEN REWRITE_TAC[REAL_POW2_CLAUSES] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_POW] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`m:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `SUC(2 EXP n)` THEN ASM_REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[MULT_2; ADD1; LE_ADD_LCANCEL] THEN REWRITE_TAC[num_CONV `1`; LE_SUC_LT; EXP_LT_0; ARITH_EQ]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e / &2 + e / &2` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[REAL_LE_REFL; GSYM REAL_MUL_2; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ]] THEN UNDISCH_TAC `!n k. k < 2 EXP n ==> ((pi * x) * cot (pi * x) = A n k + B n k)` THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `n - 1`]) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(REAL_ARITH `abs(b) < e /\ abs((s - &1) - a) < e ==> abs(s - ((a + b) + &1)) < e + e`) THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `N1 + 1 <= n` THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `sum (0,n) (\r. (&2 * x pow 2) / (x pow 2 - &r pow 2)) - &1 = &1 + sum(1,n-1) (\r. (&2 * x pow 2) / (x pow 2 - &r pow 2))` SUBST1_TAC THENL [SUBGOAL_THEN `n = 1 + (n - 1)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [UNDISCH_TAC `N1 + 1 <= n` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN MATCH_MP_TAC(REAL_ARITH `(a = &2) ==> ((x + a) - &1 = &1 + x)`) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_DIV_REFL; REAL_POW_EQ_0] THEN REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Expansion of each term as a power series. *) (* ------------------------------------------------------------------------- *) let COT_PARTIAL_FRACTIONS_SUBTERM = prove (`abs(x) < &n ==> (\k. --(&2) * (x pow 2 / &n pow 2) pow (k + 1)) sums ((&2 * x pow 2) / (x pow 2 - &n pow 2))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < &n` ASSUME_TAC THENL [UNDISCH_TAC `abs(x) < &n` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(\k. (x pow 2 / &n pow 2) pow k) sums inv(&1 - (x pow 2 / &n pow 2))` MP_TAC THENL [MATCH_MP_TAC GP THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_POW_LT2; REAL_ABS_POS; ARITH_EQ]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `--(&2) * (x pow 2 / &n pow 2)` o MATCH_MP SER_CMUL) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ADD1]; ALL_TAC] THEN REWRITE_TAC[real_div; GSYM REAL_INV_MUL; GSYM REAL_MUL_ASSOC; REAL_MUL_LNEG] THEN REWRITE_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN ASM_SIMP_TAC[GSYM real_div; REAL_DIV_LMUL; REAL_POW_LT; REAL_LT_IMP_NZ]);; (* ------------------------------------------------------------------------- *) (* General theorem about swapping a double series of positive terms. *) (* ------------------------------------------------------------------------- *) let SEQ_LE_CONST = prove (`!a x l N. (!n. n >= N ==> x(n) <= a) /\ x tends_num_real l ==> l <= a`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC [`x:num->real`; `\n:num. a:real`] THEN ASM_REWRITE_TAC[SEQ_CONST] THEN ASM_MESON_TAC[]);; let SEQ_GE_CONST = prove (`!a x l N. (!n. n >= N ==> a <= x(n)) /\ x tends_num_real l ==> a <= l`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC [`\n:num. a:real`; `x:num->real`] THEN ASM_REWRITE_TAC[SEQ_CONST] THEN ASM_MESON_TAC[]);; let SUM_SWAP_0 = prove (`!m n. sum(0,m) (\i. sum(0,n) (\j. a i j)) = sum(0,n) (\j. sum(0,m) (\i. a i j))`, INDUCT_TAC THEN ASM_SIMP_TAC[sum; SUM_CONST; REAL_MUL_RZERO; SUM_ADD]);; let SUM_SWAP = prove (`!m1 m2 n1 n2. sum(m1,m2) (\i. sum(n1,n2) (\j. a i j)) = sum(n1,n2) (\j. sum(m1,m2) (\i. a i j))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o LAND_CONV) [ARITH_RULE `m = 0 + m`] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [ARITH_RULE `m = 0 + m`] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV o LAND_CONV o LAND_CONV) [ARITH_RULE `m = 0 + m`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV o LAND_CONV o LAND_CONV) [ARITH_RULE `m = 0 + m`] THEN REWRITE_TAC[SUM_REINDEX; SUM_SWAP_0]);; let SER_SWAPDOUBLE_POS = prove (`!z a l. (!m n. &0 <= a m n) /\ (!m. (a m) sums (z m)) /\ z sums l ==> ?s. (!n. (\m. a m n) sums (s n)) /\ s sums l`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!m:num n. sum(0,n) (a m) <= z m` ASSUME_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC SEQ_GE_CONST THEN EXISTS_TAC `\n. sum(0,n) (a(m:num))` THEN ASM_REWRITE_TAC[GSYM sums] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `p:num` THEN SIMP_TAC[GE; LEFT_IMP_EXISTS_THM; LE_EXISTS] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ASM_SIMP_TAC[GSYM SUM_DIFF; SUM_POS]; ALL_TAC] THEN SUBGOAL_THEN `!m:num. &0 <= z m` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,n) (a(m:num))` THEN ASM_SIMP_TAC[SUM_POS]; ALL_TAC] THEN SUBGOAL_THEN `!n. sum(0,n) z <= l` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC SEQ_GE_CONST THEN EXISTS_TAC `\n. sum(0,n) z` THEN ASM_REWRITE_TAC[GSYM sums] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `p:num` THEN SIMP_TAC[GE; LEFT_IMP_EXISTS_THM; LE_EXISTS] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ASM_SIMP_TAC[GSYM SUM_DIFF; SUM_POS]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= l` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,n) z` THEN ASM_SIMP_TAC[SUM_POS]; ALL_TAC] THEN SUBGOAL_THEN `!e. &0 < e ==> ?M N. !m n. M <= m /\ N <= n ==> l - e <= sum(0,m) (\i. sum(0,n) (\j. a i j)) /\ sum(0,m) (\i. sum(0,n) (\j. a i j)) <= l` ASSUME_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `z sums l` THEN REWRITE_TAC[sums; SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; GE; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN SUBGOAL_THEN `?N. !m n. m < M /\ n >= N ==> abs(sum (0,n) (a m) - z m) < e / (&2 * &(M + 1))` MP_TAC THENL [SUBGOAL_THEN `&0 < e / (&2 * &(M + 1))` MP_TAC THENL [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_MUL; ARITH; ARITH_RULE `0 < n + 1`]; ALL_TAC] THEN SPEC_TAC(`e / (&2 * &(M + 1))`,`d:real`) THEN SPEC_TAC(`M:num`,`n:num`) THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN UNDISCH_TAC `!m:num. (a m) sums (z m)` THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[sums; SEQ] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN FIRST_X_ASSUM(X_CHOOSE_TAC `N1:num`) THEN EXISTS_TAC `N0 + N1:num` THEN X_GEN_TAC `m:num` THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[LT] THEN ASM_MESON_TAC[ARITH_RULE `a >= m + n ==> a >= m /\ a >= n:num`]; ALL_TAC] THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MAP_EVERY EXISTS_TAC [`M:num`; `N:num`] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!s0. s0 <= s /\ s <= l /\ abs(s0 - l) < e ==> l - e <= s /\ s <= l`) THEN EXISTS_TAC `sum(0,M) (\i. sum (0,n) (\j. a i j))` THEN CONJ_TAC THENL [UNDISCH_TAC `M <= m:num` THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[GSYM SUM_DIFF] THEN ASM_SIMP_TAC[SUM_POS]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (0,m) z` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_LE THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e / &2 + e / &2` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[REAL_LE_REFL; GSYM REAL_MUL_2; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ]] THEN MATCH_MP_TAC(REAL_ARITH `!z. abs(x - z) <= e /\ abs(z - y) < e ==> abs(x - y) < e + e`) THEN EXISTS_TAC `sum(0,M) z` THEN ASM_SIMP_TAC[LE_REFL] THEN REWRITE_TAC[GSYM SUM_SUB] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&M * e / (&2 * &(M + 1))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (b * c) * a * d`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_POS] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 1`] THEN REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE; LE_ADD]] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH lhand SUM_ABS_LE (lhand w))) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,M) (\n. e / (&2 * &(M + 1)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ASM_SIMP_TAC[ADD_CLAUSES; REAL_LT_IMP_LE]; REWRITE_TAC[SUM_CONST; REAL_LE_REFL]]; ALL_TAC] THEN SUBGOAL_THEN `!m n. sum(0,m) (\i. (a:num->num->real) i n) <= l` ASSUME_TAC THENL [REPEAT GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,M+m) (\i. sum(0,N+n+1) (\j. a i j))` THEN ASM_SIMP_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ &0 <= z ==> x <= z + y`) THEN ASM_SIMP_TAC[SUM_POS] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ &0 <= z ==> x <= y + z`) THEN ASM_SIMP_TAC[SUM_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(n,1) (\j. a (r:num) j)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_1; REAL_LE_REFL]; ALL_TAC] THEN SUBST1_TAC(ARITH_RULE `n = 0 + n`) THEN REWRITE_TAC[SUM_REINDEX] THEN ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN ASM_SIMP_TAC[SUM_POS; REAL_LE_ADDL]; ALL_TAC] THEN SUBGOAL_THEN `!n:num. ?s. (\m. a m n) sums s` MP_TAC THENL [GEN_TAC THEN REWRITE_TAC[sums; GSYM convergent] THEN MATCH_MP_TAC SEQ_BCONV THEN CONJ_TAC THENL [MATCH_MP_TAC SEQ_BOUNDED_2 THEN MAP_EVERY EXISTS_TAC [`&0`; `l:real`] THEN ASM_SIMP_TAC[SUM_POS]; REWRITE_TAC[mono] THEN DISJ1_TAC THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN ASM_SIMP_TAC[SUM_POS; REAL_LE_ADDL]]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:num->real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!e. &0 < e ==> ?N. !n. N <= n ==> l - e <= sum (0,n) s /\ sum(0,n) s <= l` ASSUME_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN ONCE_REWRITE_TAC[SUM_SWAP_0] THEN DISCH_TAC THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `!s0. l - e <= s0 /\ s0 <= s ==> l - e <= s`) THEN EXISTS_TAC `sum (0,n) (\j. sum (0,M) (\i. a i j))` THEN ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC SEQ_GE_CONST THEN EXISTS_TAC `\m. sum(0,m) (\m. a m (r:num))` THEN EXISTS_TAC `M:num` THEN ASM_REWRITE_TAC[GSYM sums] THEN SIMP_TAC[GE; LEFT_IMP_EXISTS_THM; LE_EXISTS] THEN ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN ASM_SIMP_TAC[SUM_POS; REAL_LE_ADDL]; ALL_TAC] THEN MATCH_MP_TAC SEQ_LE_CONST THEN EXISTS_TAC `\m. sum (0,n) (\j. sum (0,m) (\i. a i j))` THEN REWRITE_TAC[] THEN EXISTS_TAC `0` THEN CONJ_TAC THENL [X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[SUM_SWAP_0] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,m) z` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SEQ_SUM THEN X_GEN_TAC `m:num` THEN ASM_REWRITE_TAC[GSYM sums]; ALL_TAC] THEN REWRITE_TAC[sums; SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `!e. &0 < e ==> (?N. !n. N <= n ==> l - e <= sum (0,n) s /\ sum (0,n) s <= l)` THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `d < e ==> l - d <= x /\ x <= l ==> abs(x - l) < e`) THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence we get a power series for cot with nice convergence property. *) (* ------------------------------------------------------------------------- *) let COT_PARTIAL_FRACTIONS_FROM1 = prove (`~integer x ==> (\n. (&2 * x pow 2) / (x pow 2 - &(n + 1) pow 2)) sums (pi * x) * cot (pi * x) - &1`, DISCH_TAC THEN SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL [UNDISCH_TAC `~(integer x)` THEN REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COT_PARTIAL_FRACTIONS) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[SUM_1] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b * b) * c = a * (b * b) * c`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ENTIRE; REAL_MUL_RID] THEN REAL_ARITH_TAC);; let COT_ALT_POWSER = prove (`!x. &0 < abs(x) /\ abs(x) < &1 ==> ?s. (!n. (\m. &2 * (x pow 2 / &(m + 1) pow 2) pow (n + 1)) sums s n) /\ s sums --((pi * x) * cot(pi * x) - &1)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_SWAPDOUBLE_POS THEN EXISTS_TAC `\n. (--(&2) * x pow 2) / (x pow 2 - &(n + 1) pow 2)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[REAL_POS; REAL_POW_LE; REAL_LE_MUL; REAL_POW_2; REAL_LE_DIV; REAL_LE_SQUARE]; X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV) [GSYM REAL_NEG_NEG] THEN REWRITE_TAC[real_div; REAL_MUL_LNEG] THEN MATCH_MP_TAC SER_NEG THEN REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC COT_PARTIAL_FRACTIONS_SUBTERM THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; REWRITE_TAC[real_div; REAL_MUL_LNEG] THEN MATCH_MP_TAC SER_NEG THEN REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC COT_PARTIAL_FRACTIONS_FROM1 THEN UNDISCH_TAC `&0 < abs x` THEN UNDISCH_TAC `abs x < &1` THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> ~c <=> c ==> ~(a /\ b)`] THEN SIMP_TAC[integer; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* General unpairing result. *) (* ------------------------------------------------------------------------- *) let SER_INSERTZEROS = prove (`(\n. c(2 * n)) sums l ==> (\n. if ODD n then &0 else c(n)) sums l`, REWRITE_TAC[sums; SEQ; GE] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `2 * N` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN DISJ_CASES_THEN MP_TAC (SPEC `n:num` EVEN_OR_ODD) THENL [REWRITE_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[MULT_SYM] (GSYM SUM_GROUP)] THEN REWRITE_TAC[SUM_2; ODD_ADD; ODD_MULT; ARITH_ODD; REAL_ADD_RID] THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `2 * N <= 2 * m` THEN ARITH_TAC; REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[GSYM ODD_EXISTS] THEN REWRITE_TAC[sum] THEN REWRITE_TAC[ONCE_REWRITE_RULE[MULT_SYM] (GSYM SUM_GROUP)] THEN REWRITE_TAC[SUM_2; ODD_ADD; ODD_MULT; ARITH_ODD; REAL_ADD_RID] THEN ONCE_REWRITE_TAC[ARITH_RULE `0 + 2 * m = 2 * (0 + m)`] THEN REWRITE_TAC[GSYM(CONJUNCT2 sum)] THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `2 * N <= SUC(2 * m)` THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Mangle this into a standard power series. *) (* ------------------------------------------------------------------------- *) let COT_POWSER_SQUARED_FORM = prove (`!x. &0 < abs(x) /\ abs(x) < pi ==> (\n. &2 * (x / pi) pow (2 * (n + 1)) * suminf (\m. inv (&(m + 1) pow (2 * (n + 1))))) sums --(x * cot x - &1)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x / pi` COT_ALT_POWSER) THEN REWRITE_TAC[REAL_ABS_DIV] THEN SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS] THEN REWRITE_TAC[GSYM real_abs] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; PI_POS] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; PI_POS] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `s sums --(x * cot(x) - &1)` THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN FIRST_ASSUM(MP_TAC o MATCH_MP SER_CMUL o SPEC `n:num`) THEN DISCH_THEN(MP_TAC o SPEC `inv(&2 * (x / pi) pow (2 * (n + 1)))`) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ABS_CONV o RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_DIV] THEN REWRITE_TAC[REAL_POW_POW] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ABS_CONV o RAND_CONV o ONCE_DEPTH_CONV) [real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * &2 * b * c = c * ((&2 * b) * a)`] THEN SUBGOAL_THEN `~(&2 * (x / pi) pow (2 * (n + 1)) = &0)` ASSUME_TAC THENL [REWRITE_TAC[REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ; REAL_POW_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[real_div; REAL_ENTIRE; REAL_INV_EQ_0] THEN ASM_SIMP_TAC[PI_POS; REAL_LT_IMP_NZ; snd(EQ_IMP_RULE(SPEC_ALL REAL_ABS_NZ))]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) (&2 * (x / pi) pow (2 * (n + 1)))`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [AC REAL_MUL_AC `a * b * c = (a * b) * c`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC]);; let COT_POWSER_SQUAREDAGAIN = prove (`!x. &0 < abs(x) /\ abs(x) < pi ==> (\n. (if n = 0 then &1 else --(&2) * suminf (\m. inv (&(m + 1) pow (2 * n))) / pi pow (2 * n)) * x pow (2 * n)) sums (x * cot(x))`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COT_POWSER_SQUARED_FORM) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN SUBGOAL_THEN `(\n. if n = 0 then &1 else --(&2 * (x / pi) pow (2 * n) * suminf (\m. inv (&(m + 1) pow (2 * n))))) sums (sum(0,1) (\n. if n = 0 then &1 else --(&2 * (x / pi) pow (2 * n) * suminf (\m. inv (&(m + 1) pow (2 * n))))) + suminf (\n. if n + 1 = 0 then &1 else --(&2 * (x / pi) pow (2 * (n + 1)) * suminf (\m. inv (&(m + 1) pow (2 * (n + 1)))))))` MP_TAC THENL [MATCH_MP_TAC SER_OFFSET_REV THEN REWRITE_TAC[ARITH_RULE `~(n + 1 = 0)`] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `x * cot(x) - &1` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUM_1; ARITH_RULE `~(n + 1 = 0)`] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN REWRITE_TAC[REAL_ARITH `&1 + x - &1 = x`] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; real_pow; REAL_MUL_LID] THEN REWRITE_TAC[REAL_POW_DIV; REAL_MUL_LNEG] THEN AP_TERM_TAC THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_MUL_AC]);; let COT_X_POWSER = prove (`!x. &0 < abs(x) /\ abs(x) < pi ==> (\n. (if n = 0 then &1 else if ODD n then &0 else --(&2) * suminf (\m. inv (&(m + 1) pow n)) / pi pow n) * x pow n) sums (x * cot(x))`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COT_POWSER_SQUAREDAGAIN) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(n = 0) <=> (2 * n = 0)`] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_INSERTZEROS) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO]);; (* ------------------------------------------------------------------------- *) (* Hence use the double-angle formula to get a series for tangent. *) (* ------------------------------------------------------------------------- *) let TAN_COT_DOUBLE = prove (`!x. &0 < abs(x) /\ abs(x) < pi / &2 ==> (tan(x) = cot(x) - &2 * cot(&2 * x))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(sin x = &0)` ASSUME_TAC THENL [REWRITE_TAC[SIN_ZERO] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN REWRITE_TAC[OR_EXISTS_THM] THEN REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; REAL_MUL_LZERO; REAL_LT_REFL] THEN DISJ1_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(cos x = &0)` ASSUME_TAC THENL [REWRITE_TAC[COS_ZERO] THEN MAP_EVERY UNDISCH_TAC [`abs x < pi / &2`; `&0 < abs x`] THEN REWRITE_TAC[IMP_IMP] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN REWRITE_TAC[OR_EXISTS_THM; NOT_EVEN] THEN REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN DISJ2_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(sin(&2 * x) = &0)` ASSUME_TAC THENL [REWRITE_TAC[SIN_ZERO] THEN MAP_EVERY UNDISCH_TAC [`abs x < pi / &2`; `&0 < abs x`] THEN REWRITE_TAC[IMP_IMP] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN REWRITE_TAC[OR_EXISTS_THM] THEN REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; REAL_MUL_LZERO; REAL_LT_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN SIMP_TAC[REAL_LT_DIV2_EQ; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH; REAL_OF_NUM_LT] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN SIMP_TAC[REAL_LT_RMUL_EQ; PI_POS; REAL_OF_NUM_LT] THEN UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[tan; cot] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `sin(&2 * x)` THEN ASM_REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `(d * e - &2 * f * g) * h = h * d * e - &2 * f * (h * g)`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `sin(x)` THEN ASM_SIMP_TAC[REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID] THEN GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `a * b * c * d = a * c * d * b`] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `cos(x)` THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID] THEN REWRITE_TAC[SIN_DOUBLE; COS_DOUBLE; REAL_POW_2] THEN REWRITE_TAC[REAL_ARITH `((&2 * s * c) * c - &2 * (c * c - s * s) * s) * c = &2 * c * s * s * s`] THEN REWRITE_TAC[REAL_MUL_AC]);; let TAN_POWSER_WEAK = prove (`!x. &0 < abs(x) /\ abs(x) < pi / &2 ==> (\n. (if EVEN n then &0 else &2 * (&2 pow (n + 1) - &1) * suminf (\m. inv (&(m + 1) pow (n + 1))) / pi pow (n + 1)) * x pow n) sums (tan x)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` COT_X_POWSER) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `pi / &2` THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `inv(x)` o MATCH_MP SER_CMUL) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ABS_NZ; REAL_MUL_LID] THEN MP_TAC(SPEC `&2 * x` COT_X_POWSER) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `inv(x)` o MATCH_MP SER_CMUL) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [AC REAL_MUL_AC `a * (b * c) * d = (a * c) * b * d`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ABS_NZ; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN ASM_SIMP_TAC[GSYM TAN_COT_DOUBLE] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN DISCH_THEN(ASSUME_TAC o SYM o MATCH_MP SUM_UNIQ) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN ASM_REWRITE_TAC[SUM_1] THEN REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_SUB_REFL; REAL_SUB_RZERO] THEN REWRITE_TAC[ODD_ADD; ARITH_ODD; ADD_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[NOT_ODD] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `x' * m2 * s * xp * x - x' * m2 * s * pn * t * xp * x = (x' * x) * --m2 * (t * pn - &1) * s * xp`] THEN ASM_SIMP_TAC[REAL_NEG_NEG; REAL_MUL_LINV; REAL_ABS_NZ; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_AC]);; let TAN_POWSER = prove (`!x. abs(x) < pi / &2 ==> (\n. (if EVEN n then &0 else &2 * (&2 pow (n + 1) - &1) * suminf (\m. inv (&(m + 1) pow (n + 1))) / pi pow (n + 1)) * x pow n) sums (tan x)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < abs(x)` THEN ASM_SIMP_TAC[TAN_POWSER_WEAK] THEN DISCH_THEN(K ALL_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_ABS_NZ] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[TAN_0] THEN W(fun (asl,w) -> MP_TAC(SPECL [lhand w; `0`] SER_0)) THEN REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN UNDISCH_TAC `~(EVEN n)` THEN REWRITE_TAC[NOT_EVEN; ODD_EXISTS; real_pow; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* Add polynomials to differentiator's known functions, for next proofs. *) (* ------------------------------------------------------------------------- *) let th = prove (`(f diffl l)(x) ==> ((\x. poly p (f x)) diffl (l * poly (poly_diff p) (f x)))(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MP_TAC(SPECL [`\x. poly p x`; `f:real->real`; `poly (poly_diff p) (f(x:real))`; `l:real`; `x:real`] DIFF_CHAIN) THEN ASM_REWRITE_TAC[POLY_DIFF]) in add_to_diff_net th;; (* ------------------------------------------------------------------------- *) (* Main recurrence relation. *) (* ------------------------------------------------------------------------- *) let DIFF_CHAIN_TAN = prove (`~(cos x = &0) ==> ((\x. poly p (tan x)) diffl (poly ([&1; &0; &1] ** poly_diff p) (tan x))) (x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[tan] THEN W(MP_TAC o SPEC `x:real` o DIFF_CONV o lhand o rator o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[POLY_MUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[poly; REAL_MUL_RID; REAL_MUL_RZERO; REAL_ADD_RID; REAL_ADD_LID] THEN REWRITE_TAC[REAL_ARITH `a - --s * s = (s * s + a)`] THEN REWRITE_TAC[GSYM REAL_POW_2; SIN_CIRCLE] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_POW2_ABS] THEN ASM_SIMP_TAC[REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_EQ_LDIV_EQ] THEN REWRITE_TAC[REAL_POW2_ABS] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM REAL_POW_MUL] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[SIN_CIRCLE]);; (* ------------------------------------------------------------------------- *) (* Define tangent polynomials and tangent numbers on this pattern. *) (* ------------------------------------------------------------------------- *) let tanpoly = new_recursive_definition num_RECURSION `(tanpoly 0 = [&0; &1]) /\ (!n. tanpoly (SUC n) = [&1; &0; &1] ** poly_diff(tanpoly n))`;; let TANPOLYS_RULE = let pth1,pth2 = CONJ_PAIR tanpoly in let base = [pth1] and rule = GEN_REWRITE_RULE LAND_CONV [GSYM pth2] in let poly_diff_tm = `poly_diff` and poly_mul_tm = `( ** ) [&1; &0; &1]` in let rec tanpolys n = if n < 0 then [] else if n = 0 then base else let thl = tanpolys (n - 1) in let th1 = AP_TERM poly_diff_tm (hd thl) in let th2 = TRANS th1 (POLY_DIFF_CONV (rand(concl th1))) in let th3 = AP_TERM poly_mul_tm th2 in let th4 = TRANS th3 (POLY_MUL_CONV (rand(concl th3))) in let th5 = rule th4 in let th6 = CONV_RULE (LAND_CONV(RAND_CONV NUM_SUC_CONV)) th5 in th6::thl in rev o tanpolys;; let TANPOLY_CONV = let tanpoly_tm = `tanpoly` in fun tm -> let l,r = dest_comb tm in if l <> tanpoly_tm then failwith "TANPOLY_CONV" else last(TANPOLYS_RULE(dest_small_numeral r));; let tannumber = new_definition `tannumber n = poly (tanpoly n) (&0)`;; let TANNUMBERS_RULE,TANNUMBER_CONV = let POLY_0_THM = prove (`(poly [] (&0) = &0) /\ (poly (CONS h t) (&0) = h)`, REWRITE_TAC[poly; REAL_MUL_LZERO; REAL_ADD_RID]) in let poly_tm = `poly` and zero_tm = `&0` and tannumber_tm = `tannumber` and depoly_conv = GEN_REWRITE_CONV I [POLY_0_THM] and tannumber_rule = GEN_REWRITE_RULE LAND_CONV [GSYM tannumber] in let process th = let th1 = AP_THM (AP_TERM poly_tm th) zero_tm in let th2 = TRANS th1 (depoly_conv (rand(concl th1))) in let th3 = tannumber_rule th2 in th3 in let TANNUMBERS_RULE = map process o TANPOLYS_RULE and TANNUMBER_CONV tm = let l,r = dest_comb tm in if l <> tannumber_tm then failwith "TANNUMBER_CONV" else process(last(TANPOLYS_RULE(dest_small_numeral r))) in TANNUMBERS_RULE,TANNUMBER_CONV;; (* ------------------------------------------------------------------------- *) (* Chaining rules using the tangent polynomials. *) (* ------------------------------------------------------------------------- *) let DIFF_CHAIN_TAN_TANPOLYS = prove (`~(cos x = &0) ==> ((\x. poly (tanpoly n) (tan x)) diffl (poly (tanpoly(SUC n)) (tan x))) (x)`, REWRITE_TAC[tanpoly; DIFF_CHAIN_TAN]);; let th = prove (`(f diffl l)(x) /\ ~(cos(f x) = &0) ==> ((\x. poly (tanpoly n) (tan(f x))) diffl (l * poly (tanpoly(SUC n)) (tan(f x))))(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MP_TAC(SPECL [`\x. poly (tanpoly n) (tan x)`; `f:real->real`; `poly (tanpoly(SUC n)) (tan(f(x:real)))`; `l:real`; `x:real`] DIFF_CHAIN) THEN ASM_SIMP_TAC[DIFF_CHAIN_TAN_TANPOLYS]) in add_to_diff_net th;; (* ------------------------------------------------------------------------- *) (* Hence rewrite coefficients of tan and cot series in terms of tannumbers. *) (* ------------------------------------------------------------------------- *) let TERMDIFF_ALT = prove (`!f f' c k. (!x. abs(x) < k ==> (\n. c(n) * x pow n) sums f(x)) ==> (!x. abs(x) < k ==> (f diffl f'(x))(x)) ==> (!x. abs(x) < k ==> (\n. (diffs c)(n) * x pow n) sums f'(x))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `summable (\n. diffs c n * x pow n) /\ (f'(x) = suminf (\n. diffs c n * x pow n))` MP_TAC THENL [ALL_TAC; SIMP_TAC[SUMMABLE_SUM]] THEN CONJ_TAC THENL [UNDISCH_TAC `abs(x) < k` THEN SPEC_TAC(`x:real`,`x:real`) THEN MATCH_MP_TAC TERMDIFF_CONVERGES THEN REPEAT STRIP_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `(f:real->real) x` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN MATCH_MP_TAC DIFF_LCONST THEN EXISTS_TAC `\x. f x - suminf (\n. c(n) * x pow n)` THEN EXISTS_TAC `x:real` THEN CONJ_TAC THENL [MATCH_MP_TAC DIFF_SUB THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC TERMDIFF_STRONG THEN EXISTS_TAC `(abs(x) + k) / &2` THEN CONJ_TAC THENL [REWRITE_TAC[summable] THEN EXISTS_TAC `(f:real->real)((abs(x) + k) / &2)` THEN FIRST_ASSUM MATCH_MP_TAC; ALL_TAC] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < k` THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `k - abs(x)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `(a = b) /\ (c = d) ==> (a - b = c - d)`) THEN CONJ_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `abs(x - y) < k - abs(x)` THEN REAL_ARITH_TAC);; let TAN_DERIV_POWSER = prove (`!n x. abs(x) < pi / &2 ==> (\m. ITER n diffs (\i. if EVEN i then &0 else &2 * (&2 pow (i + 1) - &1) * suminf (\m. inv (&(m + 1) pow (i + 1))) / pi pow (i + 1)) m * x pow m) sums (poly (tanpoly n) (tan x))`, INDUCT_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[ITER; tanpoly; poly] THEN REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RZERO; REAL_MUL_RID] THEN ASM_SIMP_TAC[TAN_POWSER]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP TERMDIFF_ALT) THEN REWRITE_TAC[ITER] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CHAIN_TAN_TANPOLYS THEN REWRITE_TAC[COS_ZERO] THEN UNDISCH_TAC `abs x < pi / &2` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN REWRITE_TAC[OR_EXISTS_THM; NOT_EVEN] THEN REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN ARITH_TAC);; let ITER_DIFFS_LEMMA = prove (`!n c. ITER n diffs c 0 = &(FACT n) * c(n)`, INDUCT_TAC THEN ASM_REWRITE_TAC[ITER_ALT; diffs; FACT; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_MUL_AC]);; let TANNUMBER_HARMONICSUMS = prove (`!n. ODD n ==> (&2 * (&2 pow (n + 1) - &1) * &(FACT n) * suminf (\m. inv (&(m + 1) pow (n + 1))) / pi pow (n + 1) = tannumber n)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `&0`] TAN_DERIV_POWSER) THEN SIMP_TAC[REAL_ABS_NUM; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN REWRITE_TAC[TAN_0; GSYM tannumber] THEN MP_TAC(SPECL [`\m. ITER n diffs (\i. if EVEN i then &0 else &2 * (&2 pow (i + 1) - &1) * suminf (\m. inv (&(m + 1) pow (i + 1))) / pi pow (i + 1)) m * &0 pow m`; `1`] SER_0) THEN REWRITE_TAC[SUM_1] THEN SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL REAL_POW_EQ_0)); ARITH_RULE `1 <= n ==> ~(n = 0)`] THEN REWRITE_TAC[REAL_MUL_RZERO; real_pow] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_UNIQ) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ITER_DIFFS_LEMMA; REAL_MUL_RID] THEN ASM_REWRITE_TAC[GSYM NOT_ODD] THEN REWRITE_TAC[REAL_MUL_AC]);; let HARMONICSUMS_TANNUMBER = prove (`!n. EVEN n /\ ~(n = 0) ==> (suminf (\m. inv (&(m + 1) pow n)) / pi pow n = tannumber(n - 1) / (&2 * &(FACT(n - 1)) * (&2 pow n - &1)))`, INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; EVEN; NOT_EVEN] THEN REWRITE_TAC[SUC_SUB1] THEN SIMP_TAC[GSYM TANNUMBER_HARMONICSUMS] THEN REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (a * c * b) * d`] THEN REWRITE_TAC[real_div] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b * c) * d = a * (b * c) * d`] THEN REWRITE_TAC[GSYM real_div] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; FACT_LT] THEN REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[REAL_POW2_CLAUSES; ADD_EQ_0; ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* For uniformity, show that even tannumbers are zero. *) (* ------------------------------------------------------------------------- *) let ODD_POLY_DIFF = prove (`(!x. poly p (--x) = poly p x) ==> (!x. poly (poly_diff p) (--x) = --(poly(poly_diff p) x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `\x. poly p (--x)` THEN EXISTS_TAC `--x` THEN CONJ_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM o HALF_MK_ABS o GSYM) THEN REWRITE_TAC[CONV_RULE(ONCE_DEPTH_CONV ETA_CONV) POLY_DIFF]; MP_TAC(SPECL [`\x. poly p x`; `\x. --x`; `poly (poly_diff p) x`; `--(&1)`; `--x`] DIFF_CHAIN) THEN REWRITE_TAC[POLY_DIFF; REAL_MUL_RNEG; REAL_MUL_RID; REAL_NEG_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN W(MP_TAC o SPEC `--x` o DIFF_CONV o lhand o rator o snd) THEN REWRITE_TAC[]]);; let EVEN_POLY_DIFF = prove (`(!x. poly p (--x) = --(poly p x)) ==> (!x. poly (poly_diff p) (--x) = poly(poly_diff p) x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `\x. poly p x` THEN EXISTS_TAC `--x` THEN REWRITE_TAC[POLY_DIFF] THEN FIRST_ASSUM(MP_TAC o ONCE_REWRITE_RULE[REAL_ARITH `(a = --b) <=> (--a = b)`]) THEN DISCH_THEN(SUBST1_TAC o HALF_MK_ABS o GSYM) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_NEG_NEG] THEN MATCH_MP_TAC DIFF_NEG THEN MP_TAC(SPECL [`\x. poly p x`; `\x. --x`; `poly (poly_diff p) x`; `--(&1)`; `--x`] DIFF_CHAIN) THEN REWRITE_TAC[POLY_DIFF; REAL_MUL_RNEG; REAL_MUL_RID; REAL_NEG_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN W(MP_TAC o SPEC `--x` o DIFF_CONV o lhand o rator o snd) THEN REWRITE_TAC[]);; let TANPOLY_ODD_EVEN = prove (`!n x. (poly (tanpoly n) (--x) = if EVEN n then --(poly (tanpoly n) x) else poly (tanpoly n) x)`, INDUCT_TAC THENL [REWRITE_TAC[EVEN; tanpoly] THEN CONV_TAC(ONCE_DEPTH_CONV POLY_DIFF_CONV) THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[EVEN] THEN ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[tanpoly; POLY_MUL; ODD_POLY_DIFF; EVEN_POLY_DIFF] THEN REWRITE_TAC[REAL_MUL_RNEG] THEN TRY AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; let TANNUMBER_EVEN = prove (`!n. EVEN n ==> (tannumber n = &0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[tannumber] THEN MATCH_MP_TAC(REAL_ARITH `(x = --x) ==> (x = &0)`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_NEG_0] THEN ASM_SIMP_TAC[TANPOLY_ODD_EVEN]);; (* ------------------------------------------------------------------------- *) (* Hence get tidy series. *) (* ------------------------------------------------------------------------- *) let TAYLOR_TAN_CONVERGES = prove (`!x. abs(x) < pi / &2 ==> (\n. tannumber n / &(FACT n) * x pow n) sums (tan x)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP TAN_POWSER) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[real_div; TANNUMBER_EVEN; REAL_MUL_LZERO; REAL_MUL_RZERO]; ALL_TAC] THEN ASM_SIMP_TAC[HARMONICSUMS_TANNUMBER; EVEN_ADD; ARITH; ADD_EQ_0] THEN REWRITE_TAC[ADD_SUB; real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * a' * d * b' * e = (c * d * e) * ((a * a') * (b * b'))`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN AP_TERM_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_RINV THEN SIMP_TAC[REAL_ARITH `&1 < x ==> ~(x - &1 = &0)`; REAL_POW2_CLAUSES; ADD_EQ_0; ARITH_EQ]);; let TAYLOR_X_COT_CONVERGES = prove (`!x. &0 < abs(x) /\ abs(x) < pi ==> (\n. (if n = 0 then &1 else tannumber (n - 1) / ((&1 - &2 pow n) * &(FACT(n - 1)))) * x pow n) sums (x * cot(x))`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COT_X_POWSER) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `ODD n` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `tannumber(n - 1) = &0` (fun th -> SIMP_TAC[th; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]) THEN MATCH_MP_TAC TANNUMBER_EVEN THEN UNDISCH_TAC `ODD n` THEN SUBGOAL_THEN `n = SUC(n - 1)` MP_TAC THENL [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[ODD; NOT_ODD]; ALL_TAC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[HARMONICSUMS_TANNUMBER; GSYM NOT_ODD] THEN REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `--(&2) * x * y * z * a = (&2 * y) * x * --a * z`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_INV_NEG; REAL_NEG_SUB; REAL_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Get a simple bound on the tannumbers. *) (* ------------------------------------------------------------------------- *) let TANNUMBER_BOUND = prove (`!n. abs(tannumber n) <= &4 * &(FACT n) * (&2 / pi) pow (n + 1)`, GEN_TAC THEN DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THEN ASM_SIMP_TAC[TANNUMBER_EVEN; GSYM TANNUMBER_HARMONICSUMS] THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [REAL_ABS_NUM; REAL_LE_MUL; REAL_POW_LE; REAL_POS; REAL_LE_DIV; PI_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e = (a * d) * c * b * e`] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `&2 * x <= &4 <=> x <= &2`] THEN MP_TAC(SPEC `\m. inv (&(m + 1) pow (n + 1))` SER_ABS) THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM; REAL_ABS_POW] THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN UNDISCH_TAC `ODD n` THEN SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `b <= c ==> a <= b ==> a <= c`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `suminf (\m. inv(&(m + 1) pow 2))` THEN CONJ_TAC THENL [MATCH_MP_TAC SER_LE THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 1`] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `ODD n` THEN SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN ARITH_TAC; MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN UNDISCH_TAC `ODD n` THEN SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN ARITH_TAC; MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN REWRITE_TAC[LE_REFL]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,1) (\n. inv(&(n + 1) pow 2)) + suminf (\n. inv(&((n + 1) + 1) pow 2))` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `(y = x) ==> x <= y`) THEN MATCH_MP_TAC SUM_UNIQ THEN MATCH_MP_TAC SER_OFFSET_REV THEN REWRITE_TAC[summable] THEN EXISTS_TAC `suminf (\n. inv(&(n + 1) pow 2)) - sum(0,1) (\n. inv(&(n + 1) pow 2))` THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] SER_OFFSET) THEN MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN REWRITE_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[SUM_1; ADD_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 + x <= &2 <=> x <= &1`] THEN SUBST1_TAC(MATCH_MP SUM_UNIQ SUMMABLE_INVERSE_SQUARES_LEMMA) THEN MATCH_MP_TAC SER_LE THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `m:num` THEN REWRITE_TAC[REAL_POW_2] THEN REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = n + 2`] THEN REWRITE_TAC[REAL_POW_2; REAL_INV_MUL; REAL_ABS_INV; REAL_ABS_NUM; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; REWRITE_TAC[summable] THEN EXISTS_TAC `suminf (\n. inv(&(n + 1) pow 2)) - sum(0,1) (\n. inv(&(n + 1) pow 2))` THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] SER_OFFSET) THEN MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN REWRITE_TAC[LE_REFL]; REWRITE_TAC[summable] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[SUMMABLE_INVERSE_SQUARES_LEMMA]]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[REAL_POW_MUL; REAL_POW_INV] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN SIMP_TAC[real_abs; PI_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM real_abs] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LT; REAL_LT_IMP_LE; PI_POS] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> abs(x - &1) <= x`) THEN REWRITE_TAC[REAL_POW2_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Also get some harmonic sums. *) (* ------------------------------------------------------------------------- *) let HARMONIC_SUMS = prove (`!n. (\m. inv (&(m + 1) pow (2 * (n + 1)))) sums (pi pow (2 * (n + 1)) * tannumber(2 * n + 1) / (&2 * (&2 pow (2 * (n + 1)) - &1) * &(FACT(2 * n + 1))))`, GEN_TAC THEN SUBGOAL_THEN `summable (\m. inv (&(m + 1) pow (2 * (n + 1))))` MP_TAC THENL [MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; REAL_POW_LT; PI_POS] THEN REWRITE_TAC[ARITH_RULE `2 * n + 1 = 2 * (n + 1) - 1`] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = a * c * b`] THEN MATCH_MP_TAC HARMONICSUMS_TANNUMBER THEN REWRITE_TAC[MULT_EQ_0; ADD_EQ_0; ARITH; EVEN_MULT]);; let mk_harmonic = let pth = prove (`x * &1 / n = x / n`, REWRITE_TAC[real_div; REAL_MUL_LID]) in let final_RULE = CONV_RULE(TRY_CONV(GEN_REWRITE_CONV RAND_CONV [pth])) in fun n -> let th1 = SPEC(mk_small_numeral((n-1)/2)) HARMONIC_SUMS in let th2 = CONV_RULE NUM_REDUCE_CONV th1 in let th3 = CONV_RULE(ONCE_DEPTH_CONV TANNUMBER_CONV) th2 in let th4 = CONV_RULE REAL_RAT_REDUCE_CONV th3 in final_RULE th4;; (* ------------------------------------------------------------------------- *) (* A little test. *) (* ------------------------------------------------------------------------- *) map (fun n -> time mk_harmonic (2 * n)) (0--8);; (* ------------------------------------------------------------------------- *) (* Isolate the most famous special case. *) (* ------------------------------------------------------------------------- *) let EULER_HARMONIC_SUM = mk_harmonic 2;; (* ------------------------------------------------------------------------- *) (* Canonical Taylor series for tan and cot with truncation bounds. *) (* ------------------------------------------------------------------------- *) let TAYLOR_TAN_BOUND_GENERAL = prove (`!x n. abs(x) <= &1 ==> abs(tan x - sum (0,n) (\m. tannumber m / &(FACT m) * x pow m)) <= &12 * (&2 / &3) pow (n + 1) * abs(x) pow n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(x) < pi / &2` MP_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP TAYLOR_TAN_CONVERGES) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP SER_OFFSET) THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_ABS_IMP) THEN REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC SEQ_LE_CONST THEN EXISTS_TAC `\r. abs(sum(0,r) (\m. (tannumber(m + n) / &(FACT(m + n))) * x pow (m + n)))` THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN W(MP_TAC o PART_MATCH lhand SUM_ABS_LE o lhand o snd) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,m) (\r. &4 * (&2 / pi) pow (r + n + 1) * abs(x pow (r + n)))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; FACT_LT] THEN MP_TAC(SPEC `r + n:num` TANNUMBER_BOUND) THEN REWRITE_TAC[REAL_MUL_AC; GSYM ADD_ASSOC]; ALL_TAC] THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES] THEN REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ABS_POW; GSYM REAL_POW_MUL] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC] THEN REWRITE_TAC[SUM_CMUL] THEN SUBGOAL_THEN `&2 / pi * abs(x) < &2 / &3` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / pi * &1` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; PI_POS]; ALL_TAC] THEN REWRITE_TAC[REAL_MUL_RID] THEN SIMP_TAC[REAL_LT_LDIV_EQ; PI_POS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `~(&2 / pi * abs(x) = &1)` ASSUME_TAC THENL [UNDISCH_TAC `&2 / pi * abs x < &2 / &3` THEN ONCE_REWRITE_TAC[TAUT `a ==> ~b <=> b ==> ~a`] THEN SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_POW_MUL; GSYM REAL_ABS_POW; REAL_ABS_MUL; REAL_ABS_ABS] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_MUL; real_div; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e <= a ==> abs(p - a) <= e ==> b <= abs p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `&4 * x * y <= &12 * z <=> x * y <= z * &3`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_MUL; real_div; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e <= a ==> abs(p - a) <= e ==> b <= abs p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ASM_SIMP_TAC[GP_FINITE] THEN REWRITE_TAC[REAL_ABS_DIV] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 ==> abs(&1 - x) <= &1`) THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [REAL_POW_LE; REAL_LE_DIV; REAL_LE_MUL; REAL_POS; REAL_ABS_POS; PI_POS; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_POW_1_LE THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [REAL_POW_LE; REAL_LE_DIV; REAL_LE_MUL; REAL_POS; REAL_ABS_POS; PI_POS; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / pi * &1` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; PI_POS] THEN SIMP_TAC[REAL_MUL_RID; REAL_LE_LDIV_EQ; PI_POS] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e <= a ==> abs(p - a) <= e ==> b <= &1 * p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_INV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `x <= (&1 - a) * &1 ==> a <= abs(&1 - x)`) THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS] THEN SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; PI_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e <= a ==> abs(p - a) <= e ==> b <= p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let TAYLOR_TAN_BOUND = prove (`!x n k. abs(x) <= inv(&2 pow k) ==> abs(tan x - sum (0,n) (\m. tannumber(m) / &(FACT(m)) * x pow m)) <= &12 * (&2 / &3) pow (n + 1) * inv(&2 pow (k * n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&12 * (&2 / &3) pow (n + 1) * abs(x) pow n` THEN CONJ_TAC THENL [MATCH_MP_TAC TAYLOR_TAN_BOUND_GENERAL THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN REWRITE_TAC[REAL_POW2_THM; LE_0]; REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_LE_DIV; REAL_POS] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN ONCE_REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]]);; let TAYLOR_TANX_BOUND = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) ==> abs(tan x / x - sum (0,n) (\m. tannumber(m+1) / &(FACT(m+1)) * x pow m)) <= &12 * (&2 / &3) pow (n + 2) * inv(&2 pow (k * n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_DIV_RMUL] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_CMUL] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [AC REAL_MUL_AC `a * b * c = b * (a * c)`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ADD1; SPECL [`f:num->real`; `n:num`; `1`] SUM_OFFSET] THEN REWRITE_TAC[SUM_1] THEN CONV_TAC(ONCE_DEPTH_CONV TANNUMBER_CONV) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[real_pow] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RZERO] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&12 * (&2 / &3) pow ((n + 1) + 1) * abs(x) pow (n + 1)` THEN CONJ_TAC THENL [MATCH_MP_TAC TAYLOR_TAN_BOUND_GENERAL THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = n + 2`] THEN REWRITE_TAC[GSYM ADD1; real_pow] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `(a * b * c) * d = (a * b * d) * c`] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [REAL_LE_MUL; REAL_POW_LE; REAL_ABS_POS; REAL_LE_DIV; REAL_POS] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN ONCE_REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; let TAYLOR_TANX_SQRT_BOUND = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ &0 < x ==> abs(tan (sqrt x) / sqrt(x) - sum(0,n) (\m. tannumber(2 * m + 1) / &(FACT(2 * m + 1)) * x pow m)) <= &12 * (&2 / &3) pow (2 * n + 2) * inv(&2 pow (k DIV 2 * 2 * n))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`sqrt x`; `2 * n`; `k DIV 2`] TAYLOR_TANX_BOUND) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_SIMP_TAC[SQRT_POS_LT; REAL_LT_IMP_NZ; DIV_EQ_0; ARITH_EQ; NOT_LT] THEN SUBGOAL_THEN `&2 pow (k DIV 2) = sqrt(&2 pow (2 * (k DIV 2)))` SUBST1_TAC THENL [SIMP_TAC[SQRT_EVEN_POW2; EVEN_MULT; ARITH_EVEN; DIV_MULT; ARITH_EQ]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM SQRT_INV; REAL_LT_IMP_LE; REAL_POW2_CLAUSES] THEN ASM_SIMP_TAC[real_abs; SQRT_POS_LT; REAL_LT_IMP_LE] THEN MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_POW2_CLAUSES] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN MESON_TAC[LE_ADD; DIVISION; NUM_EQ_CONV `2 = 0`; MULT_SYM]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM SUM_GROUP] THEN SIMP_TAC[SUM_2; TANNUMBER_EVEN; ARITH_EVEN; EVEN_ADD; EVEN_MULT] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ADD_RID] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[GSYM REAL_POW_POW; SQRT_POW_2; REAL_LT_IMP_LE]);; let TAYLOR_COT_BOUND_GENERAL = prove (`!x n. abs(x) <= &1 /\ ~(x = &0) ==> abs((&1 / x - cot x) - sum (0,n) (\m. (tannumber m / ((&2 pow (m+1) - &1) * &(FACT(m)))) * x pow m)) <= &4 * (abs(x) / &3) pow n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN ASM_SIMP_TAC[REAL_DIV_LMUL] THEN REWRITE_TAC[GSYM SUM_CMUL] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `x * a * y = a * x * y`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ADD1] THEN REWRITE_TAC[SUM_1; REAL_MUL_LZERO; REAL_SUB_RZERO; real_pow] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RZERO] THEN SUBGOAL_THEN `abs(x) < pi` MP_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ABS_NZ]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP TAYLOR_X_COT_CONVERGES) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN DISCH_THEN(ASSUME_TAC o SYM o MATCH_MP SUM_UNIQ) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN ASM_REWRITE_TAC[SUM_1; ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[real_pow; REAL_MUL_LID] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN REWRITE_TAC[REAL_NEG_SUB] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_RNEG] THEN REWRITE_TAC[GSYM REAL_INV_NEG] THEN REWRITE_TAC[GSYM real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[ADD_SUB] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP SER_OFFSET) THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_ABS_IMP) THEN REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC SEQ_LE_CONST THEN FIRST_ASSUM(fun th -> EXISTS_TAC(lhand(concl th)) THEN EXISTS_TAC `0` THEN CONJ_TAC THENL [ALL_TAC; ACCEPT_TAC th]) THEN X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH lhand SUM_ABS_LE o lhand o snd) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,m) (\r. &4 * (&2 / pi) pow (r + n + 1) / (&2 pow (r + n + 1) - &1) * abs(x pow (r + n + 1)))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `a * b * c = (c * a) * b`] THEN REWRITE_TAC[REAL_MUL_ASSOC; real_abs; REAL_SUB_LE] THEN REWRITE_TAC[REAL_POW2_CLAUSES] THEN REWRITE_TAC[GSYM real_abs] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_SUB_LE; REAL_POW2_CLAUSES] THEN SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; FACT_LT] THEN MP_TAC(SPEC `r + n:num` TANNUMBER_BOUND) THEN REWRITE_TAC[REAL_MUL_AC; GSYM ADD_ASSOC]; ALL_TAC] THEN REWRITE_TAC[real_div] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [AC REAL_MUL_AC `a * (b * c) * d = a * c * (b * d)`] THEN REWRITE_TAC[REAL_ABS_POW; GSYM REAL_POW_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,m) (\r. &8 * inv(&2 pow (r + n + 1)) * ((&2 * inv pi) * abs x) pow (r + n + 1))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `&4 * x <= &8 * y <=> x <= &2 * y`] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [REAL_POW_LE; REAL_LE_MUL; REAL_ABS_POS; REAL_POS; REAL_LT_IMP_LE; PI_POS; REAL_LE_INV_EQ] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_INV_INV] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; ARITH; REAL_POW_LT] THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; real_pow] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 * x <= &2 * x - &1 <=> &1 <= x`] THEN REWRITE_TAC[REAL_POW2_CLAUSES]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_POW_INV; GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `(&1 * x) * y = y * x`] THEN REWRITE_TAC[GSYM real_div] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_ADD] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN REWRITE_TAC[SUM_CMUL] THEN SUBGOAL_THEN `(&4 * abs x) * (abs x * &1 / &3) pow n = &12 * (abs x / &3) pow (n + 1)` SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `a * b * c * d * e = (a * e) * d * b * c`] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&8 * &3 / &2`)) THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_ABS] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e <= a ==> abs(p - a) <= e ==> b <= abs p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `abs(x) / pi < &1 / &3` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1 / pi` THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; PI_POS] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `~(abs(x) / pi = &1)` ASSUME_TAC THENL [UNDISCH_TAC `abs x / pi < &1 / &3` THEN ONCE_REWRITE_TAC[TAUT `a ==> ~b <=> b ==> ~a`] THEN SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ASM_SIMP_TAC[GP_FINITE] THEN ONCE_REWRITE_TAC[REAL_ARITH `x - &1 = --(&1 - x)`] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_NEG_NEG] THEN REWRITE_TAC[REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 ==> abs(&1 - x) <= &1`) THEN SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_ABS_POS; REAL_LT_IMP_LE; PI_POS] THEN MATCH_MP_TAC REAL_POW_1_LE THEN SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; REAL_LE_INV_EQ; REAL_LT_IMP_LE; PI_POS] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; PI_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[] THEN MP_TAC PI_APPROX_25_BITS THEN MATCH_MP_TAC(REAL_ARITH `b + e <= a ==> abs(p - a) <= e ==> b <= &1 * p`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM real_div] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> b <= &1 - a ==> b <= abs(&1 - x)`)) THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let TAYLOR_COT_BOUND = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) ==> abs((&1 / x - cot x) - sum (0,n) (\m. (tannumber m / ((&2 pow (m+1) - &1) * &(FACT(m)))) * x pow m)) <= &4 / &3 pow n * inv(&2 pow (k * n))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(x) <= &1 /\ ~(x = &0)` MP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP TAYLOR_COT_BOUND_GENERAL) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[real_div; REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[GSYM REAL_POW_INV; GSYM REAL_POW_POW] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN MATCH_MP_TAC REAL_POW_LE2 THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; REAL_ABS_POS] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV]);; let TAYLOR_COTX_BOUND = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) ==> abs((&1 / x - cot x) / x - sum (0,n) (\m. (tannumber(m+1) / ((&2 pow (m+2) - &1) * &(FACT(m+1)))) * x pow m)) <= (&4 / &3) / &3 pow n * inv(&2 pow (k * n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_DIV_RMUL] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_CMUL] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [AC REAL_MUL_AC `a * b * c = b * (a * c)`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ARITH_RULE `n + 2 = (n + 1) + 1`] THEN REWRITE_TAC[ADD1; SPECL [`f:num->real`; `n:num`; `1`] SUM_OFFSET] THEN REWRITE_TAC[SUM_1] THEN CONV_TAC(ONCE_DEPTH_CONV TANNUMBER_CONV) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[real_pow] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RZERO] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN `abs(x) <= &1 /\ ~(x = &0)` MP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `n + 1` o MATCH_MP TAYLOR_COT_BOUND_GENERAL) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = ((a * d) * b) * c`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_POW_MUL; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM REAL_POW_POW; GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_INV_MUL; REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; REAL_LE_DIV; REAL_POS] THEN REWRITE_TAC[REAL_INV_MUL] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let TAYLOR_COTXX_BOUND = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) ==> abs((&1 - x * cot(x)) - sum(0,n) (\m. (tannumber (m-1) / ((&2 pow m - &1) * &(FACT(m-1)))) * x pow m)) <= &12 / &3 pow n * inv(&2 pow (k * n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `abs(inv x)` THEN ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_INV_EQ_0] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_RDISTRIB] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) [AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN `abs(x) <= &1 /\ ~(x = &0)` MP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `n - 1` o MATCH_MP TAYLOR_COT_BOUND_GENERAL) THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[sum] THEN REWRITE_TAC[real_pow; real_div; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; MULT_CLAUSES; REAL_INV_MUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_DIV] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow 0)` THEN REWRITE_TAC[REAL_POW2_THM; LE_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `n = (n - 1) + 1` MP_TAC THENL [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN REWRITE_TAC[SUB_0; ADD_SUB; SUM_1] THEN SIMP_TAC[TANNUMBER_EVEN; EVEN] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ADD_RID] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_CMUL] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC(REAL_ARITH `(s1 = s2) /\ a <= b ==> s1 <= a ==> s2 <= b`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; GSYM REAL_MUL_ASSOC] THEN REPEAT AP_TERM_TAC THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID]; ALL_TAC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC; real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_POW_MUL; REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN REWRITE_TAC[GSYM REAL_POW_INV] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD1] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS; REAL_POW_INV]);; let TAYLOR_COTXX_SQRT_BOUND = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ &0 < x ==> abs((&1 - sqrt(x) * cot(sqrt(x))) - sum(0,n) (\m. (tannumber (2*m-1) / ((&2 pow (2*m) - &1) * &(FACT(2*m-1)))) * x pow m)) <= &12 / &3 pow (2 * n) * inv(&2 pow (k DIV 2 * 2 * n))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`sqrt x`; `2 * n`; `k DIV 2`] TAYLOR_COTXX_BOUND) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_SIMP_TAC[SQRT_POS_LT; REAL_LT_IMP_NZ; DIV_EQ_0; ARITH_EQ; NOT_LT] THEN SUBGOAL_THEN `&2 pow (k DIV 2) = sqrt(&2 pow (2 * (k DIV 2)))` SUBST1_TAC THENL [SIMP_TAC[SQRT_EVEN_POW2; EVEN_MULT; ARITH_EVEN; DIV_MULT; ARITH_EQ]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM SQRT_INV; REAL_LT_IMP_LE; REAL_POW2_CLAUSES] THEN ASM_SIMP_TAC[real_abs; SQRT_POS_LT; REAL_LT_IMP_LE] THEN MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_POW2_CLAUSES] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN MESON_TAC[LE_ADD; DIVISION; NUM_EQ_CONV `2 = 0`; MULT_SYM]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM SUM_GROUP] THEN SUBGOAL_THEN `!n. EVEN(((n * 2) + 1) - 1)` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; SUC_SUB1; SUB_0; MULT_CLAUSES; SUB_REFL; ADD_SUB] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_2; TANNUMBER_EVEN; ARITH_EVEN; EVEN_ADD; EVEN_MULT] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ADD_RID] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[GSYM REAL_POW_POW; SQRT_POW_2; REAL_LT_IMP_LE]);; hol-light/100/platonic.ml000066400000000000000000003411321303454263000154140ustar00rootroot00000000000000(* ========================================================================= *) (* The five Platonic solids exist and there are no others. *) (* ========================================================================= *) needs "100/polyhedron.ml";; needs "Multivariate/cross.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Some standard regular polyhedra (vertex coordinates from Wikipedia). *) (* ------------------------------------------------------------------------- *) let std_tetrahedron = new_definition `std_tetrahedron = convex hull {vector[&1;&1;&1],vector[-- &1;-- &1;&1], vector[-- &1;&1;-- &1],vector[&1;-- &1;-- &1]}:real^3->bool`;; let std_cube = new_definition `std_cube = convex hull {vector[&1;&1;&1],vector[&1;&1;-- &1], vector[&1;-- &1;&1],vector[&1;-- &1;-- &1], vector[-- &1;&1;&1],vector[-- &1;&1;-- &1], vector[-- &1;-- &1;&1],vector[-- &1;-- &1;-- &1]}:real^3->bool`;; let std_octahedron = new_definition `std_octahedron = convex hull {vector[&1;&0;&0],vector[-- &1;&0;&0], vector[&0;&0;&1],vector[&0;&0;-- &1], vector[&0;&1;&0],vector[&0;-- &1;&0]}:real^3->bool`;; let std_dodecahedron = new_definition `std_dodecahedron = let p = (&1 + sqrt(&5)) / &2 in convex hull {vector[&1;&1;&1],vector[&1;&1;-- &1], vector[&1;-- &1;&1],vector[&1;-- &1;-- &1], vector[-- &1;&1;&1],vector[-- &1;&1;-- &1], vector[-- &1;-- &1;&1],vector[-- &1;-- &1;-- &1], vector[&0;inv p;p],vector[&0;inv p;--p], vector[&0;--inv p;p],vector[&0;--inv p;--p], vector[inv p;p;&0],vector[inv p;--p;&0], vector[--inv p;p;&0],vector[--inv p;--p;&0], vector[p;&0;inv p],vector[--p;&0;inv p], vector[p;&0;--inv p],vector[--p;&0;--inv p]}:real^3->bool`;; let std_icosahedron = new_definition `std_icosahedron = let p = (&1 + sqrt(&5)) / &2 in convex hull {vector[&0; &1; p],vector[&0; &1; --p], vector[&0; -- &1; p],vector[&0; -- &1; --p], vector[&1; p; &0],vector[&1; --p; &0], vector[-- &1; p; &0],vector[-- &1; --p; &0], vector[p; &0; &1],vector[--p; &0; &1], vector[p; &0; -- &1],vector[--p; &0; -- &1]}:real^3->bool`;; (* ------------------------------------------------------------------------- *) (* Slightly ad hoc conversions for computation in Q[sqrt(5)]. *) (* Numbers are canonically represented as either a rational constant r or an *) (* expression r1 + r2 * sqrt(5) where r2 is nonzero but r1 may be zero and *) (* must be present. *) (* ------------------------------------------------------------------------- *) let REAL_RAT5_OF_RAT_CONV = let pth = prove (`p = p + &0 * sqrt(&5)`, REAL_ARITH_TAC) in let conv = REWR_CONV pth in fun tm -> if is_ratconst tm then conv tm else REFL tm;; let REAL_RAT_OF_RAT5_CONV = let pth = prove (`p + &0 * sqrt(&5) = p`, REAL_ARITH_TAC) in GEN_REWRITE_CONV TRY_CONV [pth];; let REAL_RAT5_ADD_CONV = let pth = prove (`(a1 + b1 * sqrt(&5)) + (a2 + b2 * sqrt(&5)) = (a1 + a2) + (b1 + b2) * sqrt(&5)`, REAL_ARITH_TAC) in REAL_RAT_ADD_CONV ORELSEC (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC GEN_REWRITE_CONV I [pth] THENC LAND_CONV REAL_RAT_ADD_CONV THENC RAND_CONV(LAND_CONV REAL_RAT_ADD_CONV) THENC REAL_RAT_OF_RAT5_CONV);; let REAL_RAT5_SUB_CONV = let pth = prove (`(a1 + b1 * sqrt(&5)) - (a2 + b2 * sqrt(&5)) = (a1 - a2) + (b1 - b2) * sqrt(&5)`, REAL_ARITH_TAC) in REAL_RAT_SUB_CONV ORELSEC (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC GEN_REWRITE_CONV I [pth] THENC LAND_CONV REAL_RAT_SUB_CONV THENC RAND_CONV(LAND_CONV REAL_RAT_SUB_CONV) THENC REAL_RAT_OF_RAT5_CONV);; let REAL_RAT5_MUL_CONV = let pth = prove (`(a1 + b1 * sqrt(&5)) * (a2 + b2 * sqrt(&5)) = (a1 * a2 + &5 * b1 * b2) + (a1 * b2 + a2 * b1) * sqrt(&5)`, MP_TAC(ISPEC `&5` SQRT_POW_2) THEN CONV_TAC REAL_FIELD) in REAL_RAT_MUL_CONV ORELSEC (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC GEN_REWRITE_CONV I [pth] THENC LAND_CONV(COMB_CONV (RAND_CONV REAL_RAT_MUL_CONV) THENC RAND_CONV REAL_RAT_MUL_CONV THENC REAL_RAT_ADD_CONV) THENC RAND_CONV(LAND_CONV (BINOP_CONV REAL_RAT_MUL_CONV THENC REAL_RAT_ADD_CONV)) THENC REAL_RAT_OF_RAT5_CONV);; let REAL_RAT5_INV_CONV = let pth = prove (`~(a pow 2 = &5 * b pow 2) ==> inv(a + b * sqrt(&5)) = a / (a pow 2 - &5 * b pow 2) + --b / (a pow 2 - &5 * b pow 2) * sqrt(&5)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_SUB_0] THEN SUBGOAL_THEN `a pow 2 - &5 * b pow 2 = (a + b * sqrt(&5)) * (a - b * sqrt(&5))` SUBST1_TAC THENL [MP_TAC(SPEC `&5` SQRT_POW_2) THEN CONV_TAC REAL_FIELD; REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONV_TAC REAL_FIELD]) in fun tm -> try REAL_RAT_INV_CONV tm with Failure _ -> let th1 = PART_MATCH (lhs o rand) pth tm in let th2 = MP th1 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th1)))) in let th3 = CONV_RULE(funpow 2 RAND_CONV (funpow 2 LAND_CONV REAL_RAT_NEG_CONV)) th2 in let th4 = CONV_RULE(RAND_CONV(RAND_CONV(LAND_CONV (RAND_CONV(LAND_CONV REAL_RAT_POW_CONV THENC RAND_CONV(RAND_CONV REAL_RAT_POW_CONV THENC REAL_RAT_MUL_CONV) THENC REAL_RAT_SUB_CONV) THENC REAL_RAT_DIV_CONV)))) th3 in let th5 = CONV_RULE(RAND_CONV(LAND_CONV (RAND_CONV(LAND_CONV REAL_RAT_POW_CONV THENC RAND_CONV(RAND_CONV REAL_RAT_POW_CONV THENC REAL_RAT_MUL_CONV) THENC REAL_RAT_SUB_CONV) THENC REAL_RAT_DIV_CONV))) th4 in th5;; let REAL_RAT5_DIV_CONV = GEN_REWRITE_CONV I [real_div] THENC RAND_CONV REAL_RAT5_INV_CONV THENC REAL_RAT5_MUL_CONV;; let REAL_RAT5_LE_CONV = let lemma = prove (`!x y. x <= y * sqrt(&5) <=> x <= &0 /\ &0 <= y \/ &0 <= x /\ &0 <= y /\ x pow 2 <= &5 * y pow 2 \/ x <= &0 /\ y <= &0 /\ &5 * y pow 2 <= x pow 2`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `&5` SQRT_POW_2) THEN REWRITE_TAC[REAL_POS] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_LE_SQUARE_ABS] THEN MP_TAC(ISPECL [`sqrt(&5)`; `y:real`] (CONJUNCT1 REAL_LE_MUL_EQ)) THEN SIMP_TAC[SQRT_POS_LT; REAL_OF_NUM_LT; ARITH] THEN REAL_ARITH_TAC) in let pth = prove (`(a1 + b1 * sqrt(&5)) <= (a2 + b2 * sqrt(&5)) <=> a1 <= a2 /\ b1 <= b2 \/ a2 <= a1 /\ b1 <= b2 /\ (a1 - a2) pow 2 <= &5 * (b2 - b1) pow 2 \/ a1 <= a2 /\ b2 <= b1 /\ &5 * (b2 - b1) pow 2 <= (a1 - a2) pow 2`, REWRITE_TAC[REAL_ARITH `a + b * x <= a' + b' * x <=> a - a' <= (b' - b) * x`] THEN REWRITE_TAC[lemma] THEN REAL_ARITH_TAC) in REAL_RAT_LE_CONV ORELSEC (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC GEN_REWRITE_CONV I [pth] THENC REAL_RAT_REDUCE_CONV);; let REAL_RAT5_EQ_CONV = GEN_REWRITE_CONV I [GSYM REAL_LE_ANTISYM] THENC BINOP_CONV REAL_RAT5_LE_CONV THENC GEN_REWRITE_CONV I [AND_CLAUSES];; (* ------------------------------------------------------------------------- *) (* Conversions for operations on 3D vectors with coordinates in Q[sqrt(5)] *) (* ------------------------------------------------------------------------- *) let VECTOR3_SUB_CONV = let pth = prove (`vector[x1;x2;x3] - vector[y1;y2;y3]:real^3 = vector[x1-y1; x2-y2; x3-y3]`, SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3] THEN REWRITE_TAC[VECTOR_3; VECTOR_SUB_COMPONENT]) in GEN_REWRITE_CONV I [pth] THENC RAND_CONV(LIST_CONV REAL_RAT5_SUB_CONV);; let VECTOR3_CROSS_CONV = let pth = prove (`(vector[x1;x2;x3]) cross (vector[y1;y2;y3]) = vector[x2 * y3 - x3 * y2; x3 * y1 - x1 * y3; x1 * y2 - x2 * y1]`, REWRITE_TAC[cross; VECTOR_3]) in GEN_REWRITE_CONV I [pth] THENC RAND_CONV(LIST_CONV(BINOP_CONV REAL_RAT5_MUL_CONV THENC REAL_RAT5_SUB_CONV));; let VECTOR3_EQ_0_CONV = let pth = prove (`vector[x1;x2;x3]:real^3 = vec 0 <=> x1 = &0 /\ x2 = &0 /\ x3 = &0`, SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3] THEN REWRITE_TAC[VECTOR_3; VEC_COMPONENT]) in GEN_REWRITE_CONV I [pth] THENC DEPTH_BINOP_CONV `(/\)` REAL_RAT5_EQ_CONV THENC REWRITE_CONV[];; let VECTOR3_DOT_CONV = let pth = prove (`(vector[x1;x2;x3]:real^3) dot (vector[y1;y2;y3]) = x1*y1 + x2*y2 + x3*y3`, REWRITE_TAC[DOT_3; VECTOR_3]) in GEN_REWRITE_CONV I [pth] THENC DEPTH_BINOP_CONV `(+):real->real->real` REAL_RAT5_MUL_CONV THENC RAND_CONV REAL_RAT5_ADD_CONV THENC REAL_RAT5_ADD_CONV;; (* ------------------------------------------------------------------------- *) (* Put any irrational coordinates in our standard form. *) (* ------------------------------------------------------------------------- *) let STD_DODECAHEDRON = prove (`std_dodecahedron = convex hull { vector[&1; &1; &1], vector[&1; &1; -- &1], vector[&1; -- &1; &1], vector[&1; -- &1; -- &1], vector[-- &1; &1; &1], vector[-- &1; &1; -- &1], vector[-- &1; -- &1; &1], vector[-- &1; -- &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)]}`, let golden_inverse = prove (`inv((&1 + sqrt(&5)) / &2) = -- &1 / &2 + &1 / &2 * sqrt(&5)`, MP_TAC(ISPEC `&5` SQRT_POW_2) THEN CONV_TAC REAL_FIELD) in REWRITE_TAC[std_dodecahedron] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN REWRITE_TAC[golden_inverse] THEN REWRITE_TAC[REAL_ARITH `(&1 + s) / &2 = &1 / &2 + &1 / &2 * s`] THEN REWRITE_TAC[REAL_ARITH `--(a + b * sqrt(&5)) = --a + --b * sqrt(&5)`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[]);; let STD_ICOSAHEDRON = prove (`std_icosahedron = convex hull { vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1]}`, REWRITE_TAC[std_icosahedron] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN REWRITE_TAC[REAL_ARITH `(&1 + s) / &2 = &1 / &2 + &1 / &2 * s`] THEN REWRITE_TAC[REAL_ARITH `--(a + b * sqrt(&5)) = --a + --b * sqrt(&5)`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Explicit computation of facets. *) (* ------------------------------------------------------------------------- *) let COMPUTE_FACES_2 = prove (`!f s:real^3->bool. FINITE s ==> (f face_of (convex hull s) /\ aff_dim f = &2 <=> ?x y z. x IN s /\ y IN s /\ z IN s /\ let a = (z - x) cross (y - x) in ~(a = vec 0) /\ let b = a dot x in ((!w. w IN s ==> a dot w <= b) \/ (!w. w IN s ==> a dot w >= b)) /\ f = convex hull (s INTER {x | a dot x = b}))`, REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL [STRIP_TAC THEN SUBGOAL_THEN `?t:real^3->bool. t SUBSET s /\ f = convex hull t` MP_TAC THENL [MATCH_MP_TAC FACE_OF_CONVEX_HULL_SUBSET THEN ASM_SIMP_TAC[FINITE_IMP_COMPACT]; DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool` MP_TAC)] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_CONVEX_HULL]) THEN MP_TAC(ISPEC `t:real^3->bool` AFFINE_BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^3->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(u:real^3->bool) HAS_SIZE 3` MP_TAC THENL [ASM_SIMP_TAC[HAS_SIZE; AFFINE_INDEPENDENT_IMP_FINITE] THEN REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN MATCH_MP_TAC(INT_ARITH `aff_dim(u:real^3->bool) = &2 /\ aff_dim u = &(CARD u) - &1 ==> &(CARD u):int = &3`) THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_AFFINE_HULL]; ASM_MESON_TAC[AFF_DIM_UNIQUE]]; ALL_TAC] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN REPLICATE_TAC 3 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REPEAT LET_TAC THEN SUBGOAL_THEN `~collinear{x:real^3,y,z}` MP_TAC THENL [ASM_REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `{x,y,z} = {z,x,y}`] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN ASM_REWRITE_TAC[GSYM CROSS_EQ_0] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(a:real^3) dot y = b /\ (a:real^3) dot z = b` STRIP_ASSUME_TAC THENL [MAP_EVERY UNDISCH_TAC [`(z - x) cross (y - x) = a`; `(a:real^3) dot x = b`] THEN VEC3_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`convex hull s:real^3->bool`; `convex hull t:real^3->bool`] EXPOSED_FACE_OF_POLYHEDRON) THEN ASM_SIMP_TAC[POLYHEDRON_CONVEX_HULL; exposed_face_of] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a':real^3`; `b':real`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `aff_dim(t:real^3->bool) <= aff_dim({x:real^3 | a dot x = b} INTER {x | a' dot x = b'})` MP_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `t:real^3->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull t:real^3->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFF_DIM_HYPERPLANE; AFFINE_HYPERPLANE; DIMINDEX_3] THEN REPEAT(COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_HYPERPLANES]) THEN ASM_REWRITE_TAC[HYPERPLANE_EQ_EMPTY] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC (MP_TAC o SYM)) THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTER_UNIV]) THEN SUBGOAL_THEN `s SUBSET {x:real^3 | a dot x = b}` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull s:real^3->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `affine hull t:real^3->bool` THEN REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN ASM_SIMP_TAC[real_ge; REAL_LE_REFL]; ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`]]; ALL_TAC] THEN DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN CONJ_TAC THENL [MATCH_MP_TAC(TAUT `(~p /\ ~q ==> F) ==> p \/ q`) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_ge; REAL_NOT_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `u:real^3`) (X_CHOOSE_TAC `v:real^3`)) THEN SUBGOAL_THEN `(a':real^3) dot u < b' /\ a' dot v < b'` ASSUME_TAC THENL [REWRITE_TAC[REAL_LT_LE] THEN REWRITE_TAC [SET_RULE `f x <= b /\ ~(f x = b) <=> x IN {x | f x <= b} /\ ~(x IN {x | f x = b})`] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NE] THEN SUBGOAL_THEN `(u:real^3) IN convex hull s /\ v IN convex hull s` MP_TAC THENL [ASM_SIMP_TAC[HULL_INC]; ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `?w:real^3. w IN segment[u,v] /\ w IN {w | a' dot w = b'}` MP_TAC THENL [ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN MAP_EVERY EXISTS_TAC [`v:real^3`; `u:real^3`] THEN ASM_SIMP_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT; REAL_LT_IMP_LE]; REWRITE_TAC[IN_SEGMENT; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[UNWIND_THM2; DOT_RADD; DOT_RMUL; CONJ_ASSOC] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> a = b ==> F`) THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET_INTER] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull t:real^3->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[SUBSET_INTER] THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN REPEAT LET_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `convex hull (s INTER {x:real^3 | a dot x = b}) = (convex hull s) INTER {x | a dot x = b}` SUBST1_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [SIMP_TAC[SUBSET_INTER; HULL_MONO; INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]; ALL_TAC] THEN ASM_CASES_TAC `s SUBSET {x:real^3 | a dot x = b}` THENL [ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull (convex hull (s INTER {x:real^3 | a dot x = b}) UNION convex hull (s DIFF {x | a dot x = b})) INTER {x | a dot x = b}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (s INTER u) SUBSET (t INTER u)`) THEN MATCH_MP_TAC HULL_MONO THEN MATCH_MP_TAC(SET_RULE `s INTER t SUBSET (P hull (s INTER t)) /\ s DIFF t SUBSET (P hull (s DIFF t)) ==> s SUBSET (P hull (s INTER t)) UNION (P hull (s DIFF t))`) THEN REWRITE_TAC[HULL_SUBSET]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) CONVEX_HULL_UNION_NONEMPTY_EXPLICIT o lhand o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[CONVEX_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`p:real^3`; `u:real`; `q:real^3`] THEN REPLICATE_TAC 4 DISCH_TAC THEN ASM_CASES_TAC `u = &0` THEN ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % p + &0 % q:real^N = p`] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x < y ==> ~(x = y)`) THEN MATCH_MP_TAC(REAL_ARITH `(&1 - u) * p = (&1 - u) * b /\ u * q < u * b ==> (&1 - u) * p + u * q < b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN SET_TAC[]; SIMP_TAC[IN_ELIM_THM]]; MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `(a:real^3) dot q < b <=> q IN {x | a dot x < b}`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LT] THEN ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; REAL_LT_LE]]; MATCH_MP_TAC(REAL_ARITH `x > y ==> ~(x = y)`) THEN MATCH_MP_TAC(REAL_ARITH `(&1 - u) * p = (&1 - u) * b /\ u * b < u * q ==> (&1 - u) * p + u * q > b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN SET_TAC[]; SIMP_TAC[IN_ELIM_THM]]; MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM real_gt]] THEN ONCE_REWRITE_TAC[SET_RULE `(a:real^3) dot q > b <=> q IN {x | a dot x > b}`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GT] THEN RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; real_gt; REAL_LT_LE]]]; ALL_TAC] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LE] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GE] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]]; REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim {x:real^3 | a dot x = b}` THEN CONJ_TAC THENL [MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN SET_TAC[]; ASM_SIMP_TAC[AFF_DIM_HYPERPLANE; DIMINDEX_3] THEN INT_ARITH_TAC]; MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim {x:real^3,y,z}` THEN CONJ_TAC THENL [SUBGOAL_THEN `~collinear{x:real^3,y,z}` MP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{x,y,z} = {z,x,y}`] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN ASM_REWRITE_TAC[GSYM CROSS_EQ_0]; REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT; DE_MORGAN_THM] THEN STRIP_TAC] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN CONV_TAC INT_REDUCE_CONV; MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM_REWRITE_TAC[INSERT_SUBSET] THEN REWRITE_TAC[EMPTY_SUBSET] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN MAP_EVERY UNDISCH_TAC [`(z - x) cross (y - x) = a`; `(a:real^3) dot x = b`] THEN VEC3_TAC]]]]);; let COMPUTE_FACES_2_STEP_1 = prove (`!f v s t:real^3->bool. (?x y z. x IN (v INSERT s) /\ y IN (v INSERT s) /\ z IN (v INSERT s) /\ let a = (z - x) cross (y - x) in ~(a = vec 0) /\ let b = a dot x in ((!w. w IN t ==> a dot w <= b) \/ (!w. w IN t ==> a dot w >= b)) /\ f = convex hull (t INTER {x | a dot x = b})) <=> (?y z. y IN s /\ z IN s /\ let a = (z - v) cross (y - v) in ~(a = vec 0) /\ let b = a dot v in ((!w. w IN t ==> a dot w <= b) \/ (!w. w IN t ==> a dot w >= b)) /\ f = convex hull (t INTER {x | a dot x = b})) \/ (?x y z. x IN s /\ y IN s /\ z IN s /\ let a = (z - x) cross (y - x) in ~(a = vec 0) /\ let b = a dot x in ((!w. w IN t ==> a dot w <= b) \/ (!w. w IN t ==> a dot w >= b)) /\ f = convex hull (t INTER {x | a dot x = b}))`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_INSERT] THEN MATCH_MP_TAC(MESON[] `(!x y z. Q x y z ==> Q x z y) /\ (!x y z. Q x y z ==> Q y x z) /\ (!x z. ~(Q x x z)) ==> ((?x y z. (x = v \/ P x) /\ (y = v \/ P y) /\ (z = v \/ P z) /\ Q x y z) <=> (?y z. P y /\ P z /\ Q v y z) \/ (?x y z. P x /\ P y /\ P z /\ Q x y z))`) THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN REWRITE_TAC[VECTOR_SUB_REFL; CROSS_0] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN MAP_EVERY (SUBST1_TAC o VEC3_RULE) [`(z - y) cross (x - y) = --((z - x) cross (y - x))`; `(y - x) cross (z - x) = --((z - x) cross (y - x))`] THEN REWRITE_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2; real_ge] THEN REWRITE_TAC[DISJ_ACI] THEN REWRITE_TAC[VEC3_RULE `((z - x) cross (y - x)) dot y = ((z - x) cross (y - x)) dot x`]);; let COMPUTE_FACES_2_STEP_2 = prove (`!f u v s:real^3->bool. (?y z. y IN (u INSERT s) /\ z IN (u INSERT s) /\ let a = (z - v) cross (y - v) in ~(a = vec 0) /\ let b = a dot v in ((!w. w IN t ==> a dot w <= b) \/ (!w. w IN t ==> a dot w >= b)) /\ f = convex hull (t INTER {x | a dot x = b})) <=> (?z. z IN s /\ let a = (z - v) cross (u - v) in ~(a = vec 0) /\ let b = a dot v in ((!w. w IN t ==> a dot w <= b) \/ (!w. w IN t ==> a dot w >= b)) /\ f = convex hull (t INTER {x | a dot x = b})) \/ (?y z. y IN s /\ z IN s /\ let a = (z - v) cross (y - v) in ~(a = vec 0) /\ let b = a dot v in ((!w. w IN t ==> a dot w <= b) \/ (!w. w IN t ==> a dot w >= b)) /\ f = convex hull (t INTER {x | a dot x = b}))`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_INSERT] THEN MATCH_MP_TAC(MESON[] `(!x y. Q x y ==> Q y x) /\ (!x. ~(Q x x)) ==> ((?y z. (y = u \/ P y) /\ (z = u \/ P z) /\ Q y z) <=> (?z. P z /\ Q u z) \/ (?y z. P y /\ P z /\ Q y z))`) THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN REWRITE_TAC[CROSS_REFL] THEN REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN SUBST1_TAC (VEC3_RULE `(x - v) cross (y - v) = --((y - v) cross (x - v))`) THEN REWRITE_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2; real_ge] THEN REWRITE_TAC[DISJ_ACI]);; let COMPUTE_FACES_TAC = let lemma = prove (`(x INSERT s) INTER {x | P x} = if P x then x INSERT (s INTER {x | P x}) else s INTER {x | P x}`, COND_CASES_TAC THEN ASM SET_TAC[]) in SIMP_TAC[COMPUTE_FACES_2; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[COMPUTE_FACES_2_STEP_1] THEN REWRITE_TAC[COMPUTE_FACES_2_STEP_2] THEN REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_CROSS_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN REWRITE_TAC[real_ge] THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_LE_CONV) THEN REWRITE_TAC[INSERT_AC] THEN REWRITE_TAC[DISJ_ACI] THEN REPEAT(CHANGED_TAC (ONCE_REWRITE_TAC[lemma] THEN CONV_TAC(ONCE_DEPTH_CONV (LAND_CONV VECTOR3_DOT_CONV THENC REAL_RAT5_EQ_CONV))) THEN REWRITE_TAC[]) THEN REWRITE_TAC[INTER_EMPTY] THEN REWRITE_TAC[INSERT_AC] THEN REWRITE_TAC[DISJ_ACI];; (* ------------------------------------------------------------------------- *) (* Apply this to our standard Platonic solids to derive facets. *) (* Note: this is quite slow and can take a couple of hours. *) (* ------------------------------------------------------------------------- *) let TETRAHEDRON_FACETS = time prove (`!f:real^3->bool. f face_of std_tetrahedron /\ aff_dim f = &2 <=> f = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1]} \/ f = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1], vector[&1; &1; &1]} \/ f = convex hull {vector[-- &1; -- &1; &1], vector[&1; -- &1; -- &1], vector[&1; &1; &1]} \/ f = convex hull {vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1], vector[&1; &1; &1]}`, GEN_TAC THEN REWRITE_TAC[std_tetrahedron] THEN COMPUTE_FACES_TAC);; let CUBE_FACETS = time prove (`!f:real^3->bool. f face_of std_cube /\ aff_dim f = &2 <=> f = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1], vector[-- &1; &1; &1]} \/ f = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1], vector[&1; -- &1; -- &1], vector[&1; -- &1; &1]} \/ f = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1], vector[&1; &1; -- &1]} \/ f = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; &1], vector[&1; -- &1; &1], vector[&1; &1; &1]} \/ f = convex hull {vector[-- &1; &1; -- &1], vector[-- &1; &1; &1], vector[&1; &1; -- &1], vector[&1; &1; &1]} \/ f = convex hull {vector[&1; -- &1; -- &1], vector[&1; -- &1; &1], vector[&1; &1; -- &1], vector[&1; &1; &1]}`, GEN_TAC THEN REWRITE_TAC[std_cube] THEN COMPUTE_FACES_TAC);; let OCTAHEDRON_FACETS = time prove (`!f:real^3->bool. f face_of std_octahedron /\ aff_dim f = &2 <=> f = convex hull {vector[-- &1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; -- &1]} \/ f = convex hull {vector[-- &1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; &1]} \/ f = convex hull {vector[-- &1; &0; &0], vector[&0; &1; &0], vector[&0; &0; -- &1]} \/ f = convex hull {vector[-- &1; &0; &0], vector[&0; &1; &0], vector[&0; &0; &1]} \/ f = convex hull {vector[&1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; -- &1]} \/ f = convex hull {vector[&1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; &1]} \/ f = convex hull {vector[&1; &0; &0], vector[&0; &1; &0], vector[&0; &0; -- &1]} \/ f = convex hull {vector[&1; &0; &0], vector[&0; &1; &0], vector[&0; &0; &1]}`, GEN_TAC THEN REWRITE_TAC[std_octahedron] THEN COMPUTE_FACES_TAC);; let ICOSAHEDRON_FACETS = time prove (`!f:real^3->bool. f face_of std_icosahedron /\ aff_dim f = &2 <=> f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]}`, GEN_TAC THEN REWRITE_TAC[STD_ICOSAHEDRON] THEN COMPUTE_FACES_TAC);; let DODECAHEDRON_FACETS = time prove (`!f:real^3->bool. f face_of std_dodecahedron /\ aff_dim f = &2 <=> f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1; &1; -- &1], vector[-- &1; &1; &1]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[-- &1; -- &1; &1], vector[-- &1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[-- &1; -- &1; -- &1], vector[-- &1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[-- &1; -- &1; -- &1], vector[&1; -- &1; -- &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[-- &1; -- &1; &1], vector[&1; -- &1; &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1; -- &1; -- &1], vector[&1; -- &1; &1]} \/ f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1; &1; -- &1], vector[&1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1; &1; &1], vector[&1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1; &1; -- &1], vector[&1; &1; &1]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[&1; -- &1; &1], vector[&1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1; -- &1; -- &1], vector[&1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]}`, GEN_TAC THEN REWRITE_TAC[STD_DODECAHEDRON] THEN COMPUTE_FACES_TAC);; (* ------------------------------------------------------------------------- *) (* Given a coplanar set, return a hyperplane containing it. *) (* Maps term s to theorem |- !x. x IN s ==> n dot x = d *) (* Currently assumes |s| >= 3 but it would be trivial to do other cases. *) (* ------------------------------------------------------------------------- *) let COPLANAR_HYPERPLANE_RULE = let rec allsets m l = if m = 0 then [[]] else match l with [] -> [] | h::t -> map (fun g -> h::g) (allsets (m - 1) t) @ allsets m t in let mk_sub = mk_binop `(-):real^3->real^3->real^3` and mk_cross = mk_binop `cross` and mk_dot = mk_binop `(dot):real^3->real^3->real` and zerovec_tm = `vector[&0;&0;&0]:real^3` and template = `(!x:real^3. x IN s ==> n dot x = d)` and s_tm = `s:real^3->bool` and n_tm = `n:real^3` and d_tm = `d:real` in let mk_normal [x;y;z] = mk_cross (mk_sub y x) (mk_sub z x) in let eval_normal t = (BINOP_CONV VECTOR3_SUB_CONV THENC VECTOR3_CROSS_CONV) (mk_normal t) in let check_normal t = let th = eval_normal t in let n = rand(concl th) in if n = zerovec_tm then failwith "check_normal" else n in fun tm -> let s = dest_setenum tm in if length s < 3 then failwith "COPLANAR_HYPERPLANE_RULE: trivial" else let n = tryfind check_normal (allsets 3 s) in let d = rand(concl(VECTOR3_DOT_CONV(mk_dot n (hd s)))) in let ptm = vsubst [tm,s_tm; n,n_tm; d,d_tm] template in EQT_ELIM ((REWRITE_CONV[FORALL_IN_INSERT; NOT_IN_EMPTY] THENC DEPTH_BINOP_CONV `/\` (LAND_CONV VECTOR3_DOT_CONV THENC REAL_RAT5_EQ_CONV) THENC GEN_REWRITE_CONV DEPTH_CONV [AND_CLAUSES]) ptm);; (* ------------------------------------------------------------------------- *) (* Explicit computation of edges, assuming hyperplane containing the set. *) (* ------------------------------------------------------------------------- *) let COMPUTE_FACES_1 = prove (`!s:real^3->bool n d. (!x. x IN s ==> n dot x = d) ==> FINITE s /\ ~(n = vec 0) ==> !f. f face_of (convex hull s) /\ aff_dim f = &1 <=> ?x y. x IN s /\ y IN s /\ let a = n cross (y - x) in ~(a = vec 0) /\ let b = a dot x in ((!w. w IN s ==> a dot w <= b) \/ (!w. w IN s ==> a dot w >= b)) /\ f = convex hull (s INTER {x | a dot x = b})`, REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN SUBGOAL_THEN `?t:real^3->bool. t SUBSET s /\ f = convex hull t` MP_TAC THENL [MATCH_MP_TAC FACE_OF_CONVEX_HULL_SUBSET THEN ASM_SIMP_TAC[FINITE_IMP_COMPACT]; DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool` MP_TAC)] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_CONVEX_HULL]) THEN MP_TAC(ISPEC `t:real^3->bool` AFFINE_BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^3->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(u:real^3->bool) HAS_SIZE 2` MP_TAC THENL [ASM_SIMP_TAC[HAS_SIZE; AFFINE_INDEPENDENT_IMP_FINITE] THEN REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN MATCH_MP_TAC(INT_ARITH `aff_dim(u:real^3->bool) = &1 /\ aff_dim u = &(CARD u) - &1 ==> &(CARD u):int = &2`) THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_AFFINE_HULL]; ASM_MESON_TAC[AFF_DIM_UNIQUE]]; ALL_TAC] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`x:real^3`; `y:real^3`] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN SUBGOAL_THEN `(x:real^3) IN s /\ y IN s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT LET_TAC THEN MP_TAC(ISPECL [`n:real^3`; `y - x:real^3`] NORM_AND_CROSS_EQ_0) THEN ASM_SIMP_TAC[DOT_RSUB; VECTOR_SUB_EQ; REAL_SUB_0] THEN DISCH_TAC THEN SUBGOAL_THEN `(a:real^3) dot y = b` ASSUME_TAC THENL [MAP_EVERY UNDISCH_TAC [`n cross (y - x) = a`; `(a:real^3) dot x = b`] THEN VEC3_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`convex hull s:real^3->bool`; `convex hull t:real^3->bool`] EXPOSED_FACE_OF_POLYHEDRON) THEN ASM_SIMP_TAC[POLYHEDRON_CONVEX_HULL; EXPOSED_FACE_OF_PARALLEL] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a':real^3`; `b':real`] THEN SUBGOAL_THEN `~(convex hull t:real^3->bool = {})` ASSUME_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^3` THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ASM_CASES_TAC `convex hull t:real^3->bool = convex hull s` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM AFFINE_HULL_CONVEX_HULL]) THEN UNDISCH_THEN `convex hull t:real^3->bool = convex hull s` (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN RULE_ASSUM_TAC(REWRITE_RULE[AFFINE_HULL_CONVEX_HULL]) THEN REWRITE_TAC[SET_RULE `s = s INTER t <=> s SUBSET t`] THEN STRIP_TAC THEN SUBGOAL_THEN `s SUBSET {x:real^3 | a dot x = b}` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `affine hull s:real^3->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN ASM SET_TAC[]; CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN ASM_SIMP_TAC[real_ge; REAL_LE_REFL]; AP_TERM_TAC THEN ASM SET_TAC[]]]; STRIP_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[AFFINE_HULL_CONVEX_HULL]) THEN SUBGOAL_THEN `aff_dim(t:real^3->bool) <= aff_dim(({x:real^3 | a dot x = b} INTER {x:real^3 | a' dot x = b'}) INTER {x | n dot x = d})` MP_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[SUBSET_INTER; INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `(x:real^3) IN convex hull t /\ y IN convex hull t` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ASM SET_TAC[]]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFF_DIM_HYPERPLANE; AFFINE_HYPERPLANE; DIMINDEX_3; AFFINE_INTER] THEN ASM_CASES_TAC `{x:real^3 | a dot x = b} SUBSET {v | a' dot v = b'}` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; REPEAT(COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s INTER t SUBSET u ==> !x. x IN s /\ x IN t ==> x IN u`)) THEN DISCH_THEN(MP_TAC o SPEC `x + n:real^3`) THEN MATCH_MP_TAC(TAUT `p /\ q /\ ~r ==> (p /\ q ==> r) ==> s`) THEN ASM_SIMP_TAC[IN_ELIM_THM; DOT_RADD] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "a" THEN VEC3_TAC; ALL_TAC; ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL_0; DOT_EQ_0]] THEN SUBGOAL_THEN `a' dot (x:real^3) = b'` SUBST1_TAC THENL [SUBGOAL_THEN `(x:real^3) IN convex hull t` MP_TAC THENL [MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(n:real^3) dot (x + a') = n dot x` MP_TAC THENL [ALL_TAC; SIMP_TAC[DOT_RADD] THEN REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x:real = d /\ y = d ==> x = y`) THEN SUBGOAL_THEN `affine hull s SUBSET {x:real^3 | n dot x = d}` MP_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_SIMP_TAC[HULL_INC]]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_HYPERPLANES]) THEN ASM_REWRITE_TAC[HYPERPLANE_EQ_EMPTY; HYPERPLANE_EQ_UNIV] THEN DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC(SYM th)) THEN DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN CONJ_TAC THENL [MATCH_MP_TAC(TAUT `(~p /\ ~q ==> F) ==> p \/ q`) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_ge; REAL_NOT_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `u:real^3`) (X_CHOOSE_TAC `v:real^3`)) THEN SUBGOAL_THEN `(a':real^3) dot u < b' /\ a' dot v < b'` ASSUME_TAC THENL [REWRITE_TAC[REAL_LT_LE] THEN REWRITE_TAC [SET_RULE `f x <= b /\ ~(f x = b) <=> x IN {x | f x <= b} /\ ~(x IN {x | f x = b})`] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NE] THEN SUBGOAL_THEN `(u:real^3) IN convex hull s /\ v IN convex hull s` MP_TAC THENL [ASM_SIMP_TAC[HULL_INC]; ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `?w:real^3. w IN segment[u,v] /\ w IN {w | a' dot w = b'}` MP_TAC THENL [ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN MAP_EVERY EXISTS_TAC [`v:real^3`; `u:real^3`] THEN ASM_SIMP_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT; REAL_LT_IMP_LE]; REWRITE_TAC[IN_SEGMENT; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[UNWIND_THM2; DOT_RADD; DOT_RMUL; CONJ_ASSOC] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> a = b ==> F`) THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REAL_ARITH_TAC]; FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET_INTER] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull t:real^3->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; ASM_REWRITE_TAC[SUBSET_INTER] THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`] THEN REPEAT LET_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `convex hull (s INTER {x:real^3 | a dot x = b}) = (convex hull s) INTER {x | a dot x = b}` SUBST1_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [SIMP_TAC[SUBSET_INTER; HULL_MONO; INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]; ALL_TAC] THEN ASM_CASES_TAC `s SUBSET {x:real^3 | a dot x = b}` THENL [ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull (convex hull (s INTER {x:real^3 | a dot x = b}) UNION convex hull (s DIFF {x | a dot x = b})) INTER {x | a dot x = b}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (s INTER u) SUBSET (t INTER u)`) THEN MATCH_MP_TAC HULL_MONO THEN MATCH_MP_TAC(SET_RULE `s INTER t SUBSET (P hull (s INTER t)) /\ s DIFF t SUBSET (P hull (s DIFF t)) ==> s SUBSET (P hull (s INTER t)) UNION (P hull (s DIFF t))`) THEN REWRITE_TAC[HULL_SUBSET]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) CONVEX_HULL_UNION_NONEMPTY_EXPLICIT o lhand o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[CONVEX_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`p:real^3`; `u:real`; `q:real^3`] THEN REPLICATE_TAC 4 DISCH_TAC THEN ASM_CASES_TAC `u = &0` THEN ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % p + &0 % q:real^N = p`] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x < y ==> ~(x = y)`) THEN MATCH_MP_TAC(REAL_ARITH `(&1 - u) * p = (&1 - u) * b /\ u * q < u * b ==> (&1 - u) * p + u * q < b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN SET_TAC[]; SIMP_TAC[IN_ELIM_THM]]; MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `(a:real^3) dot q < b <=> q IN {x | a dot x < b}`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LT] THEN ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; REAL_LT_LE]]; MATCH_MP_TAC(REAL_ARITH `x > y ==> ~(x = y)`) THEN MATCH_MP_TAC(REAL_ARITH `(&1 - u) * p = (&1 - u) * b /\ u * b < u * q ==> (&1 - u) * p + u * q > b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN SET_TAC[]; SIMP_TAC[IN_ELIM_THM]]; MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM real_gt]] THEN ONCE_REWRITE_TAC[SET_RULE `(a:real^3) dot q > b <=> q IN {x | a dot x > b}`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GT] THEN RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; real_gt; REAL_LT_LE]]]; ALL_TAC] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LE] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GE] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]]; ASM_REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim{x:real^3,y}` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[AFF_DIM_2] THEN ASM_MESON_TAC[CROSS_0; VECTOR_SUB_REFL; INT_LE_REFL]; MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN MAP_EVERY UNDISCH_TAC [`n cross (y - x) = a`; `(a:real^3) dot x = b`] THEN VEC3_TAC]] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim({x:real^3 | a dot x = b} INTER {x | n dot x = d})` THEN CONJ_TAC THENL [MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE; DIMINDEX_3] THEN REPEAT(COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x + n:real^3` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_SIMP_TAC[IN_ELIM_THM; DOT_RADD; REAL_EQ_ADD_LCANCEL_0; DOT_EQ_0] THEN EXPAND_TAC "a" THEN VEC3_TAC]]);; (* ------------------------------------------------------------------------- *) (* Given a coplanar set, return exhaustive edge case theorem. *) (* ------------------------------------------------------------------------- *) let COMPUTE_EDGES_CONV = let lemma = prove (`(x INSERT s) INTER {x | P x} = if P x then x INSERT (s INTER {x | P x}) else s INTER {x | P x}`, COND_CASES_TAC THEN ASM SET_TAC[]) in fun tm -> let th1 = MATCH_MP COMPUTE_FACES_1 (COPLANAR_HYPERPLANE_RULE tm) in let th2 = MP (CONV_RULE(LAND_CONV (COMB2_CONV (RAND_CONV(PURE_REWRITE_CONV[FINITE_INSERT; FINITE_EMPTY])) (RAND_CONV VECTOR3_EQ_0_CONV THENC GEN_REWRITE_CONV I [NOT_CLAUSES]) THENC GEN_REWRITE_CONV I [AND_CLAUSES])) th1) TRUTH in CONV_RULE (BINDER_CONV(RAND_CONV (REWRITE_CONV[RIGHT_EXISTS_AND_THM] THENC REWRITE_CONV[EXISTS_IN_INSERT; NOT_IN_EMPTY] THENC REWRITE_CONV[FORALL_IN_INSERT; NOT_IN_EMPTY] THENC ONCE_DEPTH_CONV VECTOR3_SUB_CONV THENC ONCE_DEPTH_CONV VECTOR3_CROSS_CONV THENC ONCE_DEPTH_CONV let_CONV THENC ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV THENC REWRITE_CONV[real_ge] THENC ONCE_DEPTH_CONV VECTOR3_DOT_CONV THENC ONCE_DEPTH_CONV let_CONV THENC ONCE_DEPTH_CONV REAL_RAT5_LE_CONV THENC REWRITE_CONV[INSERT_AC] THENC REWRITE_CONV[DISJ_ACI] THENC REPEATC(CHANGED_CONV (ONCE_REWRITE_CONV[lemma] THENC ONCE_DEPTH_CONV(LAND_CONV VECTOR3_DOT_CONV THENC REAL_RAT5_EQ_CONV) THENC REWRITE_CONV[])) THENC REWRITE_CONV[INTER_EMPTY] THENC REWRITE_CONV[INSERT_AC] THENC REWRITE_CONV[DISJ_ACI] ))) th2;; (* ------------------------------------------------------------------------- *) (* Use this to prove the number of edges per face for each Platonic solid. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_LEMMA = prove (`!x s n. 0 < n /\ ~(x IN s) /\ s HAS_SIZE (n - 1) ==> (x INSERT s) HAS_SIZE n`, REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT] THEN ASM_ARITH_TAC);; let EDGES_PER_FACE_TAC th = REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `CARD {e:real^3->bool | e face_of f /\ aff_dim(e) = &1}` THEN CONJ_TAC THENL [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_FACE; FACE_OF_TRANS; FACE_OF_IMP_SUBSET]; ALL_TAC] THEN MP_TAC(ISPEC `f:real^3->bool` th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN W(fun (_,w) -> REWRITE_TAC[COMPUTE_EDGES_CONV(find_term is_setenum w)]) THEN REWRITE_TAC[SET_RULE `x = a \/ x = b <=> x IN {a,b}`] THEN REWRITE_TAC[GSYM IN_INSERT; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC (MESON[HAS_SIZE] `s HAS_SIZE n ==> CARD s = n`) THEN REPEAT (MATCH_MP_TAC CARD_EQ_LEMMA THEN REPEAT CONJ_TAC THENL [CONV_TAC NUM_REDUCE_CONV THEN NO_TAC; REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; SEGMENT_EQ; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `~(a = c /\ b = d) /\ ~(a = d /\ b = c) /\ ~(a = b /\ c = d) ==> ~({a,b} = {c,d})`) THEN PURE_ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN REWRITE_TAC[] THEN NO_TAC; ALL_TAC]) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 HAS_SIZE_CLAUSES];; let TETRAHEDRON_EDGES_PER_FACE = prove (`!f. f face_of std_tetrahedron /\ aff_dim(f) = &2 ==> CARD {e | e face_of std_tetrahedron /\ aff_dim(e) = &1 /\ e SUBSET f} = 3`, EDGES_PER_FACE_TAC TETRAHEDRON_FACETS);; let CUBE_EDGES_PER_FACE = prove (`!f. f face_of std_cube /\ aff_dim(f) = &2 ==> CARD {e | e face_of std_cube /\ aff_dim(e) = &1 /\ e SUBSET f} = 4`, EDGES_PER_FACE_TAC CUBE_FACETS);; let OCTAHEDRON_EDGES_PER_FACE = prove (`!f. f face_of std_octahedron /\ aff_dim(f) = &2 ==> CARD {e | e face_of std_octahedron /\ aff_dim(e) = &1 /\ e SUBSET f} = 3`, EDGES_PER_FACE_TAC OCTAHEDRON_FACETS);; let DODECAHEDRON_EDGES_PER_FACE = prove (`!f. f face_of std_dodecahedron /\ aff_dim(f) = &2 ==> CARD {e | e face_of std_dodecahedron /\ aff_dim(e) = &1 /\ e SUBSET f} = 5`, EDGES_PER_FACE_TAC DODECAHEDRON_FACETS);; let ICOSAHEDRON_EDGES_PER_FACE = prove (`!f. f face_of std_icosahedron /\ aff_dim(f) = &2 ==> CARD {e | e face_of std_icosahedron /\ aff_dim(e) = &1 /\ e SUBSET f} = 3`, EDGES_PER_FACE_TAC ICOSAHEDRON_FACETS);; (* ------------------------------------------------------------------------- *) (* Show that the Platonic solids are all full-dimensional. *) (* ------------------------------------------------------------------------- *) let POLYTOPE_3D_LEMMA = prove (`(let a = (z - x) cross (y - x) in ~(a = vec 0) /\ ?w. w IN s /\ ~(a dot w = a dot x)) ==> aff_dim(convex hull (x INSERT y INSERT z INSERT s:real^3->bool)) = &3`, REPEAT GEN_TAC THEN LET_TAC THEN STRIP_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM DIMINDEX_3; AFF_DIM_LE_UNIV]; ALL_TAC] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim {w:real^3,x,y,z}` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[AFF_DIM_INSERT] THEN COND_CASES_TAC THENL [SUBGOAL_THEN `w IN {w:real^3 | a dot w = a dot x}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN UNDISCH_TAC `~(a:real^3 = vec 0)` THEN EXPAND_TAC "a" THEN VEC3_TAC; ASM_REWRITE_TAC[IN_ELIM_THM]]; UNDISCH_TAC `~(a:real^3 = vec 0)` THEN EXPAND_TAC "a" THEN REWRITE_TAC[CROSS_EQ_0; GSYM COLLINEAR_3] THEN REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT; INSERT_AC; DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN INT_ARITH_TAC]);; let POLYTOPE_FULLDIM_TAC = MATCH_MP_TAC POLYTOPE_3D_LEMMA THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_CROSS_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN CONJ_TAC THENL [CONV_TAC(RAND_CONV VECTOR3_EQ_0_CONV) THEN REWRITE_TAC[]; CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) THEN REWRITE_TAC[]];; let STD_TETRAHEDRON_FULLDIM = prove (`aff_dim std_tetrahedron = &3`, REWRITE_TAC[std_tetrahedron] THEN POLYTOPE_FULLDIM_TAC);; let STD_CUBE_FULLDIM = prove (`aff_dim std_cube = &3`, REWRITE_TAC[std_cube] THEN POLYTOPE_FULLDIM_TAC);; let STD_OCTAHEDRON_FULLDIM = prove (`aff_dim std_octahedron = &3`, REWRITE_TAC[std_octahedron] THEN POLYTOPE_FULLDIM_TAC);; let STD_DODECAHEDRON_FULLDIM = prove (`aff_dim std_dodecahedron = &3`, REWRITE_TAC[STD_DODECAHEDRON] THEN POLYTOPE_FULLDIM_TAC);; let STD_ICOSAHEDRON_FULLDIM = prove (`aff_dim std_icosahedron = &3`, REWRITE_TAC[STD_ICOSAHEDRON] THEN POLYTOPE_FULLDIM_TAC);; (* ------------------------------------------------------------------------- *) (* Complete list of edges for each Platonic solid. *) (* ------------------------------------------------------------------------- *) let COMPUTE_EDGES_TAC defn fulldim facets = GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC (vsubst[lhs(concl defn),`p:real^3->bool`] `?f:real^3->bool. (f face_of p /\ aff_dim f = &2) /\ (e face_of f /\ aff_dim e = &1)`) THEN CONJ_TAC THENL [EQ_TAC THENL [STRIP_TAC; MESON_TAC[FACE_OF_TRANS]] THEN MP_TAC(ISPECL [lhs(concl defn); `e:real^3->bool`] FACE_OF_POLYHEDRON_SUBSET_FACET) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[defn] THEN MATCH_MP_TAC POLYHEDRON_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[facet_of] THEN REWRITE_TAC[fulldim] THEN CONV_TAC INT_REDUCE_CONV THEN ASM_MESON_TAC[FACE_OF_FACE]]; REWRITE_TAC[facets] THEN REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN CONV_TAC(LAND_CONV(DEPTH_BINOP_CONV `\/` (fun tm -> REWR_CONV (COMPUTE_EDGES_CONV(rand(rand(lhand tm)))) tm))) THEN REWRITE_TAC[INSERT_AC] THEN REWRITE_TAC[DISJ_ACI]];; let TETRAHEDRON_EDGES = prove (`!e. e face_of std_tetrahedron /\ aff_dim e = &1 <=> e = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1]} \/ e = convex hull {vector[-- &1; -- &1; &1], vector[&1; -- &1; -- &1]} \/ e = convex hull {vector[-- &1; -- &1; &1], vector[&1; &1; &1]} \/ e = convex hull {vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1]} \/ e = convex hull {vector[-- &1; &1; -- &1], vector[&1; &1; &1]} \/ e = convex hull {vector[&1; -- &1; -- &1], vector[&1; &1; &1]}`, COMPUTE_EDGES_TAC std_tetrahedron STD_TETRAHEDRON_FULLDIM TETRAHEDRON_FACETS);; let CUBE_EDGES = prove (`!e. e face_of std_cube /\ aff_dim e = &1 <=> e = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1]} \/ e = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; &1; -- &1]} \/ e = convex hull {vector[-- &1; -- &1; -- &1], vector[&1; -- &1; -- &1]} \/ e = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; &1]} \/ e = convex hull {vector[-- &1; -- &1; &1], vector[&1; -- &1; &1]} \/ e = convex hull {vector[-- &1; &1; -- &1], vector[-- &1; &1; &1]} \/ e = convex hull {vector[-- &1; &1; -- &1], vector[&1; &1; -- &1]} \/ e = convex hull {vector[-- &1; &1; &1], vector[&1; &1; &1]} \/ e = convex hull {vector[&1; -- &1; -- &1], vector[&1; -- &1; &1]} \/ e = convex hull {vector[&1; -- &1; -- &1], vector[&1; &1; -- &1]} \/ e = convex hull {vector[&1; -- &1; &1], vector[&1; &1; &1]} \/ e = convex hull {vector[&1; &1; -- &1], vector[&1; &1; &1]}`, COMPUTE_EDGES_TAC std_cube STD_CUBE_FULLDIM CUBE_FACETS);; let OCTAHEDRON_EDGES = prove (`!e. e face_of std_octahedron /\ aff_dim e = &1 <=> e = convex hull {vector[-- &1; &0; &0], vector[&0; -- &1; &0]} \/ e = convex hull {vector[-- &1; &0; &0], vector[&0; &1; &0]} \/ e = convex hull {vector[-- &1; &0; &0], vector[&0; &0; -- &1]} \/ e = convex hull {vector[-- &1; &0; &0], vector[&0; &0; &1]} \/ e = convex hull {vector[&1; &0; &0], vector[&0; -- &1; &0]} \/ e = convex hull {vector[&1; &0; &0], vector[&0; &1; &0]} \/ e = convex hull {vector[&1; &0; &0], vector[&0; &0; -- &1]} \/ e = convex hull {vector[&1; &0; &0], vector[&0; &0; &1]} \/ e = convex hull {vector[&0; -- &1; &0], vector[&0; &0; -- &1]} \/ e = convex hull {vector[&0; -- &1; &0], vector[&0; &0; &1]} \/ e = convex hull {vector[&0; &1; &0], vector[&0; &0; -- &1]} \/ e = convex hull {vector[&0; &1; &0], vector[&0; &0; &1]}`, COMPUTE_EDGES_TAC std_octahedron STD_OCTAHEDRON_FULLDIM OCTAHEDRON_FACETS);; let DODECAHEDRON_EDGES = prove (`!e. e face_of std_dodecahedron /\ aff_dim e = &1 <=> e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[-- &1; -- &1; &1]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[-- &1; &1; &1]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[-- &1; -- &1; -- &1]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[-- &1; &1; -- &1]} \/ e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1; -- &1; -- &1]} \/ e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1; -- &1; &1]} \/ e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1; &1; -- &1]} \/ e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1; &1; &1]} \/ e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[-- &1; -- &1; -- &1]} \/ e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[-- &1; -- &1; &1]} \/ e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[-- &1; &1; -- &1]} \/ e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[-- &1; &1; &1]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[&1; -- &1; &1]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[&1; &1; &1]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&1; -- &1; -- &1]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&1; &1; -- &1]} \/ e = convex hull {vector[-- &1; -- &1; -- &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1; -- &1; &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; -- &1; -- &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; -- &1; &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]}`, COMPUTE_EDGES_TAC STD_DODECAHEDRON STD_DODECAHEDRON_FULLDIM DODECAHEDRON_FACETS);; let ICOSAHEDRON_EDGES = prove (`!e. e face_of std_icosahedron /\ aff_dim e = &1 <=> e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ e = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ e = convex hull {vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]}`, COMPUTE_EDGES_TAC STD_ICOSAHEDRON STD_ICOSAHEDRON_FULLDIM ICOSAHEDRON_FACETS);; (* ------------------------------------------------------------------------- *) (* Enumerate all the vertices. *) (* ------------------------------------------------------------------------- *) let COMPUTE_VERTICES_TAC defn fulldim edges = GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC (vsubst[lhs(concl defn),`p:real^3->bool`] `?e:real^3->bool. (e face_of p /\ aff_dim e = &1) /\ (v face_of e /\ aff_dim v = &0)`) THEN CONJ_TAC THENL [EQ_TAC THENL [STRIP_TAC; MESON_TAC[FACE_OF_TRANS]] THEN MP_TAC(ISPECL [lhs(concl defn); `v:real^3->bool`] FACE_OF_POLYHEDRON_SUBSET_FACET) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[defn] THEN MATCH_MP_TAC POLYHEDRON_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV]; REWRITE_TAC[facet_of] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^3->bool` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`f:real^3->bool`; `v:real^3->bool`] FACE_OF_POLYHEDRON_SUBSET_FACET) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_POLYHEDRON_POLYHEDRON THEN FIRST_ASSUM(fun th -> EXISTS_TAC (rand(concl th)) THEN CONJ_TAC THENL [ALL_TAC; ACCEPT_TAC th]) THEN REWRITE_TAC[defn] THEN MATCH_MP_TAC POLYHEDRON_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; ASM_MESON_TAC[FACE_OF_FACE]; DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV; DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[facet_of] THEN ASM_REWRITE_TAC[fulldim] THEN CONV_TAC INT_REDUCE_CONV THEN ASM_MESON_TAC[FACE_OF_FACE; FACE_OF_TRANS]]; REWRITE_TAC[edges] THEN REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN REWRITE_TAC[AFF_DIM_EQ_0; RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `v face_of s /\ v = {a} <=> {a} face_of s /\ v = {a}`] THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; FACE_OF_SING] THEN REWRITE_TAC[EXTREME_POINT_OF_SEGMENT] THEN REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN REWRITE_TAC[DISJ_ACI]];; let TETRAHEDRON_VERTICES = prove (`!v. v face_of std_tetrahedron /\ aff_dim v = &0 <=> v = {vector [-- &1; -- &1; &1]} \/ v = {vector [-- &1; &1; -- &1]} \/ v = {vector [&1; -- &1; -- &1]} \/ v = {vector [&1; &1; &1]}`, COMPUTE_VERTICES_TAC std_tetrahedron STD_TETRAHEDRON_FULLDIM TETRAHEDRON_EDGES);; let CUBE_VERTICES = prove (`!v. v face_of std_cube /\ aff_dim v = &0 <=> v = {vector [-- &1; -- &1; -- &1]} \/ v = {vector [-- &1; -- &1; &1]} \/ v = {vector [-- &1; &1; -- &1]} \/ v = {vector [-- &1; &1; &1]} \/ v = {vector [&1; -- &1; -- &1]} \/ v = {vector [&1; -- &1; &1]} \/ v = {vector [&1; &1; -- &1]} \/ v = {vector [&1; &1; &1]}`, COMPUTE_VERTICES_TAC std_cube STD_CUBE_FULLDIM CUBE_EDGES);; let OCTAHEDRON_VERTICES = prove (`!v. v face_of std_octahedron /\ aff_dim v = &0 <=> v = {vector [-- &1; &0; &0]} \/ v = {vector [&1; &0; &0]} \/ v = {vector [&0; -- &1; &0]} \/ v = {vector [&0; &1; &0]} \/ v = {vector [&0; &0; -- &1]} \/ v = {vector [&0; &0; &1]}`, COMPUTE_VERTICES_TAC std_octahedron STD_OCTAHEDRON_FULLDIM OCTAHEDRON_EDGES);; let DODECAHEDRON_VERTICES = prove (`!v. v face_of std_dodecahedron /\ aff_dim v = &0 <=> v = {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)]} \/ v = {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ v = {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ v = {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ v = {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ v = {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ v = {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)]} \/ v = {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ v = {vector[-- &1; -- &1; -- &1]} \/ v = {vector[-- &1; -- &1; &1]} \/ v = {vector[-- &1; &1; -- &1]} \/ v = {vector[-- &1; &1; &1]} \/ v = {vector[&1; -- &1; -- &1]} \/ v = {vector[&1; -- &1; &1]} \/ v = {vector[&1; &1; -- &1]} \/ v = {vector[&1; &1; &1]} \/ v = {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ v = {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ v = {vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ v = {vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]}`, COMPUTE_VERTICES_TAC STD_DODECAHEDRON STD_DODECAHEDRON_FULLDIM DODECAHEDRON_EDGES);; let ICOSAHEDRON_VERTICES = prove (`!v. v face_of std_icosahedron /\ aff_dim v = &0 <=> v = {vector [-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1]} \/ v = {vector [-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1]} \/ v = {vector [&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1]} \/ v = {vector [&1 / &2 + &1 / &2 * sqrt (&5); &0; &1]} \/ v = {vector [-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ v = {vector [-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ v = {vector [&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ v = {vector [&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ v = {vector [&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ v = {vector [&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ v = {vector [&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ v = {vector [&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]}`, COMPUTE_VERTICES_TAC STD_ICOSAHEDRON STD_ICOSAHEDRON_FULLDIM ICOSAHEDRON_EDGES);; (* ------------------------------------------------------------------------- *) (* Number of edges meeting at each vertex. *) (* ------------------------------------------------------------------------- *) let EDGES_PER_VERTEX_TAC defn edges verts = REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC (vsubst[lhs(concl defn),`p:real^3->bool`] `CARD {e | (e face_of p /\ aff_dim(e) = &1) /\ (v:real^3->bool) face_of e}`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_FACE]; ALL_TAC] THEN MP_TAC(ISPEC `v:real^3->bool` verts) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[edges] THEN REWRITE_TAC[SET_RULE `{e | (P e \/ Q e) /\ R e} = {e | P e /\ R e} UNION {e | Q e /\ R e}`] THEN REWRITE_TAC[MESON[FACE_OF_SING] `e = a /\ {x} face_of e <=> e = a /\ x extreme_point_of a`] THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; EXTREME_POINT_OF_SEGMENT] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN REWRITE_TAC[EMPTY_GSPEC; UNION_EMPTY] THEN REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN REWRITE_TAC[SET_RULE `{x} UNION s = x INSERT s`] THEN MATCH_MP_TAC (MESON[HAS_SIZE] `s HAS_SIZE n ==> CARD s = n`) THEN REPEAT (MATCH_MP_TAC CARD_EQ_LEMMA THEN REPEAT CONJ_TAC THENL [CONV_TAC NUM_REDUCE_CONV THEN NO_TAC; REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; SEGMENT_EQ] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `~(a = c /\ b = d) /\ ~(a = d /\ b = c) /\ ~(a = b /\ c = d) ==> ~({a,b} = {c,d})`) THEN PURE_ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN REWRITE_TAC[] THEN NO_TAC; ALL_TAC]) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 HAS_SIZE_CLAUSES];; let TETRAHEDRON_EDGES_PER_VERTEX = prove (`!v. v face_of std_tetrahedron /\ aff_dim(v) = &0 ==> CARD {e | e face_of std_tetrahedron /\ aff_dim(e) = &1 /\ v SUBSET e} = 3`, EDGES_PER_VERTEX_TAC std_tetrahedron TETRAHEDRON_EDGES TETRAHEDRON_VERTICES);; let CUBE_EDGES_PER_VERTEX = prove (`!v. v face_of std_cube /\ aff_dim(v) = &0 ==> CARD {e | e face_of std_cube /\ aff_dim(e) = &1 /\ v SUBSET e} = 3`, EDGES_PER_VERTEX_TAC std_cube CUBE_EDGES CUBE_VERTICES);; let OCTAHEDRON_EDGES_PER_VERTEX = prove (`!v. v face_of std_octahedron /\ aff_dim(v) = &0 ==> CARD {e | e face_of std_octahedron /\ aff_dim(e) = &1 /\ v SUBSET e} = 4`, EDGES_PER_VERTEX_TAC std_octahedron OCTAHEDRON_EDGES OCTAHEDRON_VERTICES);; let DODECAHEDRON_EDGES_PER_VERTEX = prove (`!v. v face_of std_dodecahedron /\ aff_dim(v) = &0 ==> CARD {e | e face_of std_dodecahedron /\ aff_dim(e) = &1 /\ v SUBSET e} = 3`, EDGES_PER_VERTEX_TAC STD_DODECAHEDRON DODECAHEDRON_EDGES DODECAHEDRON_VERTICES);; let ICOSAHEDRON_EDGES_PER_VERTEX = prove (`!v. v face_of std_icosahedron /\ aff_dim(v) = &0 ==> CARD {e | e face_of std_icosahedron /\ aff_dim(e) = &1 /\ v SUBSET e} = 5`, EDGES_PER_VERTEX_TAC STD_ICOSAHEDRON ICOSAHEDRON_EDGES ICOSAHEDRON_VERTICES);; (* ------------------------------------------------------------------------- *) (* Number of Platonic solids. *) (* ------------------------------------------------------------------------- *) let MULTIPLE_COUNTING_LEMMA = prove (`!R:A->B->bool s t. FINITE s /\ FINITE t /\ (!x. x IN s ==> CARD {y | y IN t /\ R x y} = m) /\ (!y. y IN t ==> CARD {x | x IN s /\ R x y} = n) ==> m * CARD s = n * CARD t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`R:A->B->bool`; `\x:A y:B. 1`; `s:A->bool`; `t:B->bool`] NSUM_NSUM_RESTRICT) THEN ASM_SIMP_TAC[NSUM_CONST; FINITE_RESTRICT] THEN ARITH_TAC);; let SIZE_ZERO_DIMENSIONAL_FACES = prove (`!s:real^N->bool. polyhedron s ==> CARD {f | f face_of s /\ aff_dim f = &0} = CARD {v | v extreme_point_of s} /\ (FINITE {f | f face_of s /\ aff_dim f = &0} <=> FINITE {v | v extreme_point_of s}) /\ (!n. {f | f face_of s /\ aff_dim f = &0} HAS_SIZE n <=> {v | v extreme_point_of s} HAS_SIZE n)`, REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `{f | f face_of s /\ aff_dim f = &0} = IMAGE (\v:real^N. {v}) {v | v extreme_point_of s}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[AFF_DIM_SING; FACE_OF_SING; IN_ELIM_THM] THEN REWRITE_TAC[AFF_DIM_EQ_0] THEN MESON_TAC[]; REPEAT STRIP_TAC THENL [MATCH_MP_TAC CARD_IMAGE_INJ; MATCH_MP_TAC FINITE_IMAGE_INJ_EQ; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ_EQ] THEN ASM_SIMP_TAC[FINITE_POLYHEDRON_EXTREME_POINTS] THEN SET_TAC[]]);; let PLATONIC_SOLIDS_LIMITS = prove (`!p:real^3->bool m n. polytope p /\ aff_dim p = &3 /\ (!f. f face_of p /\ aff_dim(f) = &2 ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ e SUBSET f} = m) /\ (!v. v face_of p /\ aff_dim(v) = &0 ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ v SUBSET e} = n) ==> m = 3 /\ n = 3 \/ // Tetrahedron m = 4 /\ n = 3 \/ // Cube m = 3 /\ n = 4 \/ // Octahedron m = 5 /\ n = 3 \/ // Dodecahedron m = 3 /\ n = 5 // Icosahedron`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `p:real^3->bool` EULER_RELATION) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `m * CARD {f:real^3->bool | f face_of p /\ aff_dim f = &2} = 2 * CARD {e | e face_of p /\ aff_dim e = &1} /\ n * CARD {v | v face_of p /\ aff_dim v = &0} = 2 * CARD {e | e face_of p /\ aff_dim e = &1}` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC MULTIPLE_COUNTING_LEMMA THENL [EXISTS_TAC `\(f:real^3->bool) (e:real^3->bool). e SUBSET f`; EXISTS_TAC `\(v:real^3->bool) (e:real^3->bool). v SUBSET e`] THEN ONCE_REWRITE_TAC[SET_RULE `f face_of s <=> f IN {f | f face_of s}`] THEN ASM_SIMP_TAC[FINITE_POLYTOPE_FACES; FINITE_RESTRICT] THEN ASM_REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC] THEN X_GEN_TAC `e:real^3->bool` THEN STRIP_TAC THENL [MP_TAC(ISPECL [`p:real^3->bool`; `e:real^3->bool`] POLYHEDRON_RIDGE_TWO_FACETS) THEN ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON] THEN ANTS_TAC THENL [CONV_TAC INT_REDUCE_CONV THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EMPTY]) THEN ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f1:real^3->bool`; `f2:real^3->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `CARD {f1:real^3->bool,f2}` THEN CONJ_TAC THENL [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[CARD_CLAUSES; IN_INSERT; FINITE_RULES; NOT_IN_EMPTY; ARITH]]]; SUBGOAL_THEN `?a b:real^3. e = segment[a,b]` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC COMPACT_CONVEX_COLLINEAR_SEGMENT THEN REPEAT CONJ_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EMPTY]) THEN ASM_INT_ARITH_TAC; MATCH_MP_TAC FACE_OF_IMP_COMPACT THEN EXISTS_TAC `p:real^3->bool` THEN ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_COMPACT]; ASM_MESON_TAC[FACE_OF_IMP_CONVEX]; MP_TAC(ISPEC `e:real^3->bool` AFF_DIM) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^3->bool` MP_TAC) THEN ASM_REWRITE_TAC[INT_ARITH `&1:int = b - &1 <=> b = &2`] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN ASM_CASES_TAC `FINITE(b:real^3->bool)` THENL [ALL_TAC; ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]] THEN REWRITE_TAC[INT_OF_NUM_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `(b:real^3->bool) HAS_SIZE 2` MP_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE]; CONV_TAC(LAND_CONV HAS_SIZE_CONV)] THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM_MESON_TAC[HULL_SUBSET]]; ASM_CASES_TAC `a:real^3 = b` THENL [UNDISCH_TAC `aff_dim(e:real^3->bool) = &1` THEN ASM_REWRITE_TAC[SEGMENT_REFL; AFF_DIM_SING; INT_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `CARD {v:real^3 | v extreme_point_of segment[a,b]}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN EXISTS_TAC `\v:real^3. {v}` THEN REWRITE_TAC[IN_ELIM_THM; FACE_OF_SING; AFF_DIM_SING] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[EXTREME_POINT_OF_SEGMENT] THEN REWRITE_TAC[SET_RULE `{x | x = a \/ x = b} = {a,b}`] THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; X_GEN_TAC `v:real^3` THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN ASM_MESON_TAC[FACE_OF_TRANS; FACE_OF_IMP_SUBSET]; X_GEN_TAC `s:real^3->bool` THEN REWRITE_TAC[AFF_DIM_EQ_0] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^3` SUBST_ALL_TAC) THEN REWRITE_TAC[EXISTS_UNIQUE] THEN EXISTS_TAC `v:real^3` THEN ASM_REWRITE_TAC[GSYM FACE_OF_SING] THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_FACE]; SET_TAC[]]]; ASM_REWRITE_TAC[EXTREME_POINT_OF_SEGMENT] THEN REWRITE_TAC[SET_RULE `{x | x = a \/ x = b} = {a,b}`] THEN ASM_SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; ARITH]]]]; ALL_TAC] THEN STRIP_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (ARITH_RULE `(a + b) - c = 2 ==> a + b = c + 2`)) THEN SUBGOAL_THEN `4 <= CARD {v:real^3->bool | v face_of p /\ aff_dim v = &0}` ASSUME_TAC THENL [ASM_SIMP_TAC[SIZE_ZERO_DIMENSIONAL_FACES; POLYTOPE_IMP_POLYHEDRON] THEN MP_TAC(ISPEC `p:real^3->bool` POLYTOPE_VERTEX_LOWER_BOUND) THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[INT_OF_NUM_LE]; ALL_TAC] THEN SUBGOAL_THEN `4 <= CARD {f:real^3->bool | f face_of p /\ aff_dim f = &2}` ASSUME_TAC THENL [MP_TAC(ISPEC `p:real^3->bool` POLYTOPE_FACET_LOWER_BOUND) THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN ASM_REWRITE_TAC[INT_OF_NUM_LE; facet_of] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN CONV_TAC INT_REDUCE_CONV THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[INT_ARITH `~(&2:int = -- &1)`; AFF_DIM_EMPTY]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `v + f = e + 2 ==> 4 <= v /\ 4 <= f ==> 6 <= e`)) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `CARD {e:real^3->bool | e face_of p /\ aff_dim e = &1} = 0` THEN ASM_REWRITE_TAC[ARITH] THEN DISCH_TAC THEN SUBGOAL_THEN `3 <= m` ASSUME_TAC THENL [ASM_CASES_TAC `{f:real^3->bool | f face_of p /\ aff_dim f = &2} = {}` THENL [UNDISCH_TAC `4 <= CARD {f:real^3->bool | f face_of p /\ aff_dim f = &2}` THEN ASM_REWRITE_TAC[CARD_CLAUSES] THEN ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^3->bool` MP_TAC) THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN FIRST_X_ASSUM(SUBST1_TAC o SYM o C MATCH_MP th)) THEN MP_TAC(ISPEC `f:real^3->bool` POLYTOPE_FACET_LOWER_BOUND) THEN ASM_REWRITE_TAC[facet_of] THEN CONV_TAC INT_REDUCE_CONV THEN ANTS_TAC THENL [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE]; ALL_TAC] THEN REWRITE_TAC[INT_OF_NUM_LE] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN CONV_TAC INT_REDUCE_CONV THEN X_GEN_TAC `e:real^3->bool` THEN EQ_TAC THEN ASM_CASES_TAC `e:real^3->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THENL [ASM_MESON_TAC[FACE_OF_TRANS; FACE_OF_IMP_SUBSET]; ASM_MESON_TAC[FACE_OF_FACE]]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `3 <= m ==> ~(m = 0)`)) THEN ASM_CASES_TAC `n = 0` THENL [UNDISCH_THEN `n = 0` SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `0 * x = 2 * e ==> e = 0`)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (NUM_RING `v + f = e + 2 ==> !m n. m * n * v + n * m * f = m * n * (e + 2)`)) THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `m * 2 * e + n * 2 * e = m * n * (e + 2) <=> e * 2 * (m + n) = m * n * (e + 2)`] THEN ABBREV_TAC `E = CARD {e:real^3->bool | e face_of p /\ aff_dim e = &1}` THEN ASM_CASES_TAC `n = 1` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; ARITH_RULE `E * 2 * (n + 1) = n * (E + 2) <=> E * (n + 2) = 2 * n`] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN MATCH_MP_TAC(ARITH_RULE `n:num < m ==> ~(m = n)`) THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `2 * (m + 2)` THEN CONJ_TAC THENL [ARITH_TAC; MATCH_MP_TAC LE_MULT2 THEN ASM_ARITH_TAC]; ALL_TAC] THEN ASM_CASES_TAC `n = 2` THENL [ASM_REWRITE_TAC[ARITH_RULE `E * 2 * (n + 2) = n * 2 * (E + 2) <=> E = n`] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (NUM_RING `E * c = 2 * E ==> E = 0 \/ c = 2`)) THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `3 <= n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `m * n < 2 * (m + n)` THENL [DISCH_TAC; DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN SUBGOAL_THEN `E * 2 * (m + n) <= E * m * n` MP_TAC THENL [REWRITE_TAC[LE_MULT_LCANCEL] THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[ARITH_RULE `m * n * (E + 2) <= E * m * n <=> 2 * m * n = 0`] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[MULT_EQ_0] THEN ASM_ARITH_TAC]] THEN SUBGOAL_THEN `&m - &2:real < &4 /\ &n - &2 < &4` MP_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&n - &2`; MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&m - &2`] THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_OF_NUM_LT; ARITH_RULE `2 < n <=> 3 <= n`] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&4` THEN REWRITE_TAC[REAL_ARITH `(m - &2) * (n - &2) < &4 <=> m * n < &2 * (m + n)`] THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB; REAL_LE_SUB_LADD] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_LT_SUB_RADD; REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN REWRITE_TAC[ARITH_RULE `m < 4 + 2 <=> m <= 5`] THEN ASM_SIMP_TAC[ARITH_RULE `3 <= m ==> (m <= 5 <=> m = 3 \/ m = 4 \/ m = 5)`] THEN STRIP_TAC THEN UNDISCH_TAC `E * 2 * (m + n) = m * n * (E + 2)` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* If-and-only-if version. *) (* ------------------------------------------------------------------------- *) let PLATONIC_SOLIDS = prove (`!m n. (?p:real^3->bool. polytope p /\ aff_dim p = &3 /\ (!f. f face_of p /\ aff_dim(f) = &2 ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ e SUBSET f} = m) /\ (!v. v face_of p /\ aff_dim(v) = &0 ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ v SUBSET e} = n)) <=> m = 3 /\ n = 3 \/ // Tetrahedron m = 4 /\ n = 3 \/ // Cube m = 3 /\ n = 4 \/ // Octahedron m = 5 /\ n = 3 \/ // Dodecahedron m = 3 /\ n = 5 // Icosahedron`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; PLATONIC_SOLIDS_LIMITS] THEN STRIP_TAC THENL [EXISTS_TAC `std_tetrahedron` THEN ASM_REWRITE_TAC[TETRAHEDRON_EDGES_PER_VERTEX; TETRAHEDRON_EDGES_PER_FACE; STD_TETRAHEDRON_FULLDIM] THEN REWRITE_TAC[std_tetrahedron] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; EXISTS_TAC `std_cube` THEN ASM_REWRITE_TAC[CUBE_EDGES_PER_VERTEX; CUBE_EDGES_PER_FACE; STD_CUBE_FULLDIM] THEN REWRITE_TAC[std_cube] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; EXISTS_TAC `std_octahedron` THEN ASM_REWRITE_TAC[OCTAHEDRON_EDGES_PER_VERTEX; OCTAHEDRON_EDGES_PER_FACE; STD_OCTAHEDRON_FULLDIM] THEN REWRITE_TAC[std_octahedron] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; EXISTS_TAC `std_dodecahedron` THEN ASM_REWRITE_TAC[DODECAHEDRON_EDGES_PER_VERTEX; DODECAHEDRON_EDGES_PER_FACE; STD_DODECAHEDRON_FULLDIM] THEN REWRITE_TAC[STD_DODECAHEDRON] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; EXISTS_TAC `std_icosahedron` THEN ASM_REWRITE_TAC[ICOSAHEDRON_EDGES_PER_VERTEX; ICOSAHEDRON_EDGES_PER_FACE; STD_ICOSAHEDRON_FULLDIM] THEN REWRITE_TAC[STD_ICOSAHEDRON] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]]);; (* ------------------------------------------------------------------------- *) (* Show that the regular polyhedra do have all edges and faces congruent. *) (* ------------------------------------------------------------------------- *) parse_as_infix("congruent",(12,"right"));; let congruent = new_definition `(s:real^N->bool) congruent (t:real^N->bool) <=> ?c f. orthogonal_transformation f /\ t = IMAGE (\x. c + f x) s`;; let CONGRUENT_SIMPLE = prove (`(?A:real^3^3. orthogonal_matrix A /\ IMAGE (\x:real^3. A ** x) s = t) ==> (convex hull s) congruent (convex hull t)`, REPEAT GEN_TAC THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[congruent] THEN EXISTS_TAC `vec 0:real^3` THEN EXISTS_TAC `\x:real^3. (A:real^3^3) ** x` THEN REWRITE_TAC[VECTOR_ADD_LID; ORTHOGONAL_TRANSFORMATION_MATRIX] THEN ASM_SIMP_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR]);; let CONGRUENT_SEGMENTS = prove (`!a b c d:real^N. dist(a,b) = dist(c,d) ==> segment[a,b] congruent segment[c,d]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`b - a:real^N`; `d - c:real^N`] ORTHOGONAL_TRANSFORMATION_EXISTS) THEN ANTS_TAC THENL [POP_ASSUM MP_TAC THEN NORM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[congruent] THEN EXISTS_TAC `c - (f:real^N->real^N) a` THEN EXISTS_TAC `f:real^N->real^N` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN SUBGOAL_THEN `(\x. (c - f a) + (f:real^N->real^N) x) = (\x. (c - f a) + x) o f` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CONVEX_HULL_LINEAR_IMAGE; SEGMENT_CONVEX_HULL; IMAGE_o; GSYM CONVEX_HULL_TRANSLATION] THEN REWRITE_TAC[IMAGE_CLAUSES] THEN AP_TERM_TAC THEN BINOP_TAC THENL [VECTOR_ARITH_TAC; AP_THM_TAC THEN AP_TERM_TAC] THEN REWRITE_TAC[VECTOR_ARITH `d:real^N = c - a + b <=> b - a = d - c`] THEN ASM_MESON_TAC[LINEAR_SUB]);; let compute_dist = let mk_sub = mk_binop `(-):real^3->real^3->real^3` and dot_tm = `(dot):real^3->real^3->real` in fun v1 v2 -> let vth = VECTOR3_SUB_CONV(mk_sub v1 v2) in let dth = CONV_RULE(RAND_CONV VECTOR3_DOT_CONV) (MK_COMB(AP_TERM dot_tm vth,vth)) in rand(concl dth);; let le_rat5 = let mk_le = mk_binop `(<=):real->real->bool` and t_tm = `T` in fun r1 r2 -> rand(concl(REAL_RAT5_LE_CONV(mk_le r1 r2))) = t_tm;; let three_adjacent_points s = match s with | x::t -> let (y,_)::(z,_)::_ = sort (fun (_,r1) (_,r2) -> le_rat5 r1 r2) (map (fun y -> y,compute_dist x y) t) in x,y,z | _ -> failwith "three_adjacent_points: no points";; let mk_33matrix = let a11_tm = `a11:real` and a12_tm = `a12:real` and a13_tm = `a13:real` and a21_tm = `a21:real` and a22_tm = `a22:real` and a23_tm = `a23:real` and a31_tm = `a31:real` and a32_tm = `a32:real` and a33_tm = `a33:real` and pat_tm = `vector[vector[a11; a12; a13]; vector[a21; a22; a23]; vector[a31; a32; a33]]:real^3^3` in fun [a11;a12;a13;a21;a22;a23;a31;a32;a33] -> vsubst[a11,a11_tm; a12,a12_tm; a13,a13_tm; a21,a21_tm; a22,a22_tm; a23,a23_tm; a31,a31_tm; a32,a32_tm; a33,a33_tm] pat_tm;; let MATRIX_VECTOR_MUL_3 = prove (`(vector[vector[a11;a12;a13]; vector[a21; a22; a23]; vector[a31; a32; a33]]:real^3^3) ** (vector[x1;x2;x3]:real^3) = vector[a11 * x1 + a12 * x2 + a13 * x3; a21 * x1 + a22 * x2 + a23 * x3; a31 * x1 + a32 * x2 + a33 * x3]`, SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_3; FORALL_3; SUM_3; VECTOR_3]);; let MATRIX_LEMMA = prove (`!A:real^3^3. A ** x1 = x2 /\ A ** y1 = y2 /\ A ** z1 = z2 <=> (vector [x1; y1; z1]:real^3^3) ** (row 1 A:real^3) = vector [x2$1; y2$1; z2$1] /\ (vector [x1; y1; z1]:real^3^3) ** (row 2 A:real^3) = vector [x2$2; y2$2; z2$2] /\ (vector [x1; y1; z1]:real^3^3) ** (row 3 A:real^3) = vector [x2$3; y2$3; z2$3]`, SIMP_TAC[CART_EQ; transp; matrix_vector_mul; row; VECTOR_3; LAMBDA_BETA] THEN REWRITE_TAC[FORALL_3; DIMINDEX_3; VECTOR_3; SUM_3] THEN REAL_ARITH_TAC);; let MATRIX_BY_CRAMER_LEMMA = prove (`!A:real^3^3. ~(det(vector[x1; y1; z1]:real^3^3) = &0) ==> (A ** x1 = x2 /\ A ** y1 = y2 /\ A ** z1 = z2 <=> A = lambda m k. det((lambda i j. if j = k then (vector[x2$m; y2$m; z2$m]:real^3)$i else (vector[x1; y1; z1]:real^3^3)$i$j) :real^3^3) / det(vector[x1;y1;z1]:real^3^3))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [MATRIX_LEMMA] THEN ASM_SIMP_TAC[CRAMER] THEN REWRITE_TAC[CART_EQ; row] THEN SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_3; FORALL_3]);; let MATRIX_BY_CRAMER = prove (`!A:real^3^3 x1 y1 z1 x2 y2 z2. let d = det(vector[x1; y1; z1]:real^3^3) in ~(d = &0) ==> (A ** x1 = x2 /\ A ** y1 = y2 /\ A ** z1 = z2 <=> A$1$1 = (x2$1 * y1$2 * z1$3 + x1$2 * y1$3 * z2$1 + x1$3 * y2$1 * z1$2 - x2$1 * y1$3 * z1$2 - x1$2 * y2$1 * z1$3 - x1$3 * y1$2 * z2$1) / d /\ A$1$2 = (x1$1 * y2$1 * z1$3 + x2$1 * y1$3 * z1$1 + x1$3 * y1$1 * z2$1 - x1$1 * y1$3 * z2$1 - x2$1 * y1$1 * z1$3 - x1$3 * y2$1 * z1$1) / d /\ A$1$3 = (x1$1 * y1$2 * z2$1 + x1$2 * y2$1 * z1$1 + x2$1 * y1$1 * z1$2 - x1$1 * y2$1 * z1$2 - x1$2 * y1$1 * z2$1 - x2$1 * y1$2 * z1$1) / d /\ A$2$1 = (x2$2 * y1$2 * z1$3 + x1$2 * y1$3 * z2$2 + x1$3 * y2$2 * z1$2 - x2$2 * y1$3 * z1$2 - x1$2 * y2$2 * z1$3 - x1$3 * y1$2 * z2$2) / d /\ A$2$2 = (x1$1 * y2$2 * z1$3 + x2$2 * y1$3 * z1$1 + x1$3 * y1$1 * z2$2 - x1$1 * y1$3 * z2$2 - x2$2 * y1$1 * z1$3 - x1$3 * y2$2 * z1$1) / d /\ A$2$3 = (x1$1 * y1$2 * z2$2 + x1$2 * y2$2 * z1$1 + x2$2 * y1$1 * z1$2 - x1$1 * y2$2 * z1$2 - x1$2 * y1$1 * z2$2 - x2$2 * y1$2 * z1$1) / d /\ A$3$1 = (x2$3 * y1$2 * z1$3 + x1$2 * y1$3 * z2$3 + x1$3 * y2$3 * z1$2 - x2$3 * y1$3 * z1$2 - x1$2 * y2$3 * z1$3 - x1$3 * y1$2 * z2$3) / d /\ A$3$2 = (x1$1 * y2$3 * z1$3 + x2$3 * y1$3 * z1$1 + x1$3 * y1$1 * z2$3 - x1$1 * y1$3 * z2$3 - x2$3 * y1$1 * z1$3 - x1$3 * y2$3 * z1$1) / d /\ A$3$3 = (x1$1 * y1$2 * z2$3 + x1$2 * y2$3 * z1$1 + x2$3 * y1$1 * z1$2 - x1$1 * y2$3 * z1$2 - x1$2 * y1$1 * z2$3 - x2$3 * y1$2 * z1$1) / d)`, REPEAT GEN_TAC THEN CONV_TAC let_CONV THEN DISCH_TAC THEN ASM_SIMP_TAC[MATRIX_BY_CRAMER_LEMMA] THEN REWRITE_TAC[DET_3; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_3; ARITH; VECTOR_3] THEN REWRITE_TAC[FORALL_3; ARITH; VECTOR_3] THEN REWRITE_TAC[CONJ_ACI]);; let CONGRUENT_EDGES_TAC edges = REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[edges] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONGRUENT_SEGMENTS THEN REWRITE_TAC[DIST_EQ] THEN REWRITE_TAC[dist; NORM_POW_2] THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) THEN REWRITE_TAC[];; let CONGRUENT_FACES_TAC facets = REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[facets] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN W(fun (asl,w) -> let t1 = rand(lhand w) and t2 = rand(rand w) in let (x1,y1,z1) = three_adjacent_points (dest_setenum t1) and (x2,y2,z2) = three_adjacent_points (dest_setenum t2) in let th1 = SPECL [`A:real^3^3`;x1;y1;z1;x2;y2;z2] MATRIX_BY_CRAMER in let th2 = REWRITE_RULE[VECTOR_3; DET_3] th1 in let th3 = CONV_RULE (DEPTH_CONV REAL_RAT5_MUL_CONV) th2 in let th4 = CONV_RULE (DEPTH_CONV (REAL_RAT5_ADD_CONV ORELSEC REAL_RAT5_SUB_CONV)) th3 in let th5 = CONV_RULE let_CONV th4 in let th6 = CONV_RULE(ONCE_DEPTH_CONV REAL_RAT5_DIV_CONV) th5 in let th7 = CONV_RULE(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) th6 in let th8 = MP th7 (EQT_ELIM(REWRITE_CONV[] (lhand(concl th7)))) in let tms = map rhs (conjuncts(rand(concl th8))) in let matt = mk_33matrix tms in MATCH_MP_TAC CONGRUENT_SIMPLE THEN EXISTS_TAC matt THEN CONJ_TAC THENL [REWRITE_TAC[ORTHOGONAL_MATRIX; CART_EQ] THEN SIMP_TAC[transp; LAMBDA_BETA; matrix_mul; mat] THEN REWRITE_TAC[DIMINDEX_3; SUM_3; FORALL_3; VECTOR_3; ARITH] THEN CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_MUL_CONV) THEN CONV_TAC(DEPTH_CONV REAL_RAT5_ADD_CONV) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) THEN REWRITE_TAC[] THEN NO_TAC; REWRITE_TAC[IMAGE_CLAUSES; MATRIX_VECTOR_MUL_3] THEN CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_MUL_CONV) THEN CONV_TAC(DEPTH_CONV REAL_RAT5_ADD_CONV) THEN REWRITE_TAC[INSERT_AC]]);; let TETRAHEDRON_CONGRUENT_EDGES = prove (`!e1 e2. e1 face_of std_tetrahedron /\ aff_dim e1 = &1 /\ e2 face_of std_tetrahedron /\ aff_dim e2 = &1 ==> e1 congruent e2`, CONGRUENT_EDGES_TAC TETRAHEDRON_EDGES);; let TETRAHEDRON_CONGRUENT_FACETS = prove (`!f1 f2. f1 face_of std_tetrahedron /\ aff_dim f1 = &2 /\ f2 face_of std_tetrahedron /\ aff_dim f2 = &2 ==> f1 congruent f2`, CONGRUENT_FACES_TAC TETRAHEDRON_FACETS);; let CUBE_CONGRUENT_EDGES = prove (`!e1 e2. e1 face_of std_cube /\ aff_dim e1 = &1 /\ e2 face_of std_cube /\ aff_dim e2 = &1 ==> e1 congruent e2`, CONGRUENT_EDGES_TAC CUBE_EDGES);; let CUBE_CONGRUENT_FACETS = prove (`!f1 f2. f1 face_of std_cube /\ aff_dim f1 = &2 /\ f2 face_of std_cube /\ aff_dim f2 = &2 ==> f1 congruent f2`, CONGRUENT_FACES_TAC CUBE_FACETS);; let OCTAHEDRON_CONGRUENT_EDGES = prove (`!e1 e2. e1 face_of std_octahedron /\ aff_dim e1 = &1 /\ e2 face_of std_octahedron /\ aff_dim e2 = &1 ==> e1 congruent e2`, CONGRUENT_EDGES_TAC OCTAHEDRON_EDGES);; let OCTAHEDRON_CONGRUENT_FACETS = prove (`!f1 f2. f1 face_of std_octahedron /\ aff_dim f1 = &2 /\ f2 face_of std_octahedron /\ aff_dim f2 = &2 ==> f1 congruent f2`, CONGRUENT_FACES_TAC OCTAHEDRON_FACETS);; let DODECAHEDRON_CONGRUENT_EDGES = prove (`!e1 e2. e1 face_of std_dodecahedron /\ aff_dim e1 = &1 /\ e2 face_of std_dodecahedron /\ aff_dim e2 = &1 ==> e1 congruent e2`, CONGRUENT_EDGES_TAC DODECAHEDRON_EDGES);; let DODECAHEDRON_CONGRUENT_FACETS = prove (`!f1 f2. f1 face_of std_dodecahedron /\ aff_dim f1 = &2 /\ f2 face_of std_dodecahedron /\ aff_dim f2 = &2 ==> f1 congruent f2`, CONGRUENT_FACES_TAC DODECAHEDRON_FACETS);; let ICOSAHEDRON_CONGRUENT_EDGES = prove (`!e1 e2. e1 face_of std_icosahedron /\ aff_dim e1 = &1 /\ e2 face_of std_icosahedron /\ aff_dim e2 = &1 ==> e1 congruent e2`, CONGRUENT_EDGES_TAC ICOSAHEDRON_EDGES);; let ICOSAHEDRON_CONGRUENT_FACETS = prove (`!f1 f2. f1 face_of std_icosahedron /\ aff_dim f1 = &2 /\ f2 face_of std_icosahedron /\ aff_dim f2 = &2 ==> f1 congruent f2`, CONGRUENT_FACES_TAC ICOSAHEDRON_FACETS);; hol-light/100/pnt.ml000066400000000000000000006467611303454263000144240ustar00rootroot00000000000000(* ========================================================================= *) (* "Second proof" of Prime Number Theorem from Newman's book. *) (* ========================================================================= *) needs "Multivariate/cauchy.ml";; needs "Library/pocklington.ml";; needs "Examples/mangoldt.ml";; prioritize_real();; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* A few miscelleneous lemmas. *) (* ------------------------------------------------------------------------- *) let LT_NORM_CPOW_NUM = prove (`!n s. &0 < Re s /\ 2 <= n ==> &1 < norm(Cx(&n) cpow s)`, SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `2 <= n ==> 0 < n`] THEN REWRITE_TAC[GSYM REAL_EXP_0; REAL_EXP_MONO_LT] THEN SIMP_TAC[REAL_LT_MUL; LOG_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `2 <= n ==> 1 < n`]);; let CPOW_NUM_NE_1 = prove (`!n s. &0 < Re s /\ 2 <= n ==> ~(Cx(&n) cpow s = Cx(&1))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM o AP_TERM `norm:complex->real`) THEN ASM_SIMP_TAC[LT_NORM_CPOW_NUM; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_LT_IMP_NE]);; let FINITE_ATMOST = prove (`!P n. FINITE {m:num | P m /\ m <= n}`, REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN SIMP_TAC[LE_0; FINITE_NUMSEG; SUBSET; IN_ELIM_THM; IN_NUMSEG]);; let PRIME_ATMOST_ALT = prove (`{p | prime p /\ p <= n} = {p | p IN 1..n /\ prime p}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN ASM_CASES_TAC `prime p` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* An auxiliary zeta function that's analytic in the right halfplane. *) (* ------------------------------------------------------------------------- *) let nearzeta = new_definition `nearzeta n s = infsum (from n) (\m. (s - Cx(&1)) / Cx(&m) cpow s - (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(m+1)) cpow (s - Cx(&1))))`;; (* ------------------------------------------------------------------------- *) (* The actual zeta function, with analyticity of z_n(s) - 1/(s - 1)^{n-1} *) (* ------------------------------------------------------------------------- *) let genzeta = new_definition `genzeta n s = if s = Cx(&1) then complex_derivative (nearzeta n) (Cx(&1)) else (nearzeta n s + Cx(&1) / Cx(&n) cpow (s - Cx(&1))) / (s - Cx(&1))`;; let zeta = new_definition `zeta s = genzeta 1 s`;; (* ------------------------------------------------------------------------- *) (* Lemmas about convergence and analyticity of the series. *) (* ------------------------------------------------------------------------- *) let NEARZETA_BOUND_LEMMA = prove (`!s n. ~(n = 0) /\ &0 <= Re s + &1 ==> norm((s - Cx(&1)) / Cx(&n) cpow s - (Cx(&1) / Cx(&n) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(n + 1)) cpow (s - Cx(&1)))) <= norm(s * (s - Cx(&1)) / Cx(&n) cpow (s + Cx(&1)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n z. if n = 0 then Cx(&1) / z cpow (s - Cx(&1)) else if n = 1 then (Cx(&1) - s) / z cpow s else s * (s - Cx(&1)) / z cpow (s + Cx(&1))`; `1`; `segment[Cx(&n),Cx(&n) + Cx(&1)]`; `norm(s * (s - Cx (&1)) / Cx(&n) cpow (s + Cx(&1)))`] COMPLEX_TAYLOR) THEN REWRITE_TAC[ARITH] THEN ANTS_TAC THENL [REWRITE_TAC[CONVEX_SEGMENT] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`i:num`; `z:complex`] THEN STRIP_TAC; X_GEN_TAC `z:complex` THEN DISCH_TAC] THEN (SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL [MATCH_MP_TAC RE_POS_SEGMENT THEN MAP_EVERY EXISTS_TAC [`Cx(&n)`; `Cx(&n) + Cx(&1)`] THEN ASM_REWRITE_TAC[RE_ADD; RE_CX; REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[RE_CX; REAL_LT_REFL]; ALL_TAC]) THENL [FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP (ARITH_RULE `i <= 1 ==> i = 0 \/ i = 1`)) THEN ASM_REWRITE_TAC[ARITH] THEN COMPLEX_DIFF_TAC THEN ASM_REWRITE_TAC[CPOW_EQ_0] THEN SIMP_TAC[COMPLEX_POW_2; CPOW_ADD; CPOW_SUB; CPOW_N; COMPLEX_POW_1] THEN (SUBGOAL_THEN `~(z cpow s = Cx(&0))` MP_TAC THENL [ASM_REWRITE_TAC[CPOW_EQ_0]; UNDISCH_TAC `~(z = Cx(&0))`]) THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ; CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ] THEN SUBGOAL_THEN `real z` ASSUME_TAC THENL [MATCH_MP_TAC REAL_SEGMENT THEN MAP_EVERY EXISTS_TAC [`Cx(&n)`; `Cx(&n) + Cx(&1)`] THEN ASM_SIMP_TAC[REAL_CX; REAL_ADD]; ALL_TAC] THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[RE_ADD; RE_CX] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LT_NZ] THEN UNDISCH_TAC `z IN segment[Cx (&n),Cx (&n) + Cx (&1)]` THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[RE_CMUL; RE_ADD; RE_CX] THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NUMSEG_CONV `0..1`] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_RULES] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1; COMPLEX_MUL_RID] THEN DISCH_THEN(MP_TAC o SPECL [`Cx(&n)`; `Cx(&n) + Cx(&1)`]) THEN REWRITE_TAC[ENDS_IN_SEGMENT; COMPLEX_NORM_CX; COMPLEX_ADD_SUB] THEN REWRITE_TAC[VECTOR_ADD_RID; COMPLEX_MUL_LID] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_DIV_1; REAL_MUL_RID] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD; complex_div] THEN CONV_TAC COMPLEX_RING);; let NORM_CPOW_LOWERBOUND = prove (`!m s n. &m <= Re s /\ ~(n = 0) ==> &n pow m <= norm(Cx(&n) cpow s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `exp(&m * log(&n))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_OF_NUM_LT; LT_NZ; REAL_LE_REFL]; REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[REAL_EXP_0; EXP_LOG; REAL_OF_NUM_LT; LT_NZ] THEN SIMP_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]);; let ZETATERM_BOUND = prove (`!s n m. &m <= Re s /\ ~(n = 0) ==> norm(Cx(&1) / Cx(&n) cpow s) <= inv(&n pow m)`, REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_POW_LT; NORM_CPOW_LOWERBOUND; REAL_OF_NUM_LT; LT_NZ]);; let ZETA_CONVERGES_LEMMA = prove (`!n s. &2 <= Re s ==> summable (from n) (\m. Cx(&1) / Cx(&m) cpow s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `\n. inv(&n - &1) - inv(&(n + 1) - &1)` THEN CONJ_TAC THENL [EXISTS_TAC `lift(inv(&n - &1))` THEN MP_TAC(ISPECL [`\n. lift(inv(&n - &1))`; `n:num`] SERIES_DIFFS) THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SEQ_OFFSET_REV THEN EXISTS_TAC `1` THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN REWRITE_TAC[SEQ_HARMONIC]; ALL_TAC] THEN EXISTS_TAC `2` THEN REWRITE_TAC[GE; IN_FROM] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_FIELD `&2 <= x ==> inv(x - &1) - inv((x + &1) - &1) = inv(x * (x - &1))`] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&n pow 2 <= x ==> &n * (&n - &1) <= x`) THEN MATCH_MP_TAC NORM_CPOW_LOWERBOUND THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let ZETADIFF_CONVERGES = prove (`!n s. &0 < Re(s) ==> ((\m. Cx(&1) / Cx(&m) cpow s - Cx(&1) / Cx(&(m + 1)) cpow s) sums Cx(&1) / Cx(&n) cpow s) (from n)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\m. Cx(&1) / Cx(&m) cpow s`; `n:num`] SERIES_DIFFS) THEN REWRITE_TAC[CPOW_1; COMPLEX_DIV_1] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\n. lift(&1 / exp (Re s * log (&n)))` THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; VECTOR_SUB_REFL; LE_1]; ALL_TAC] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. &1 / (Re s * log(&n))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LIFT] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_EXP; real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ (&0 <= x ==> &1 + u <= v) ==> &0 < x /\ u <= v`) THEN REWRITE_TAC[REAL_EXP_LE_X] THEN ASM_SIMP_TAC[LOG_POS_LT; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH_RULE `2 <= n ==> 1 < n`]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC(SPEC `exp(inv(Re s * e))` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 2` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN SUBGOAL_THEN `&0 < log(&n)` ASSUME_TAC THENL [MATCH_MP_TAC LOG_POS_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `N + 2 <= n` THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ARITH `&0 < x ==> abs x = x`] THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LT] THEN ASM_REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN ASM_SIMP_TAC[REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[ARITH_RULE `N + 2 <= n ==> N <= n`] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXP_LOG THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC);; let NEARZETA_CONVERGES_LEMMA = prove (`!n s. &1 <= Re s ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) sums nearzeta n s) (from n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; SUMS_INFSUM] THEN REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `\m. norm(s * (s - Cx(&1)) / Cx(&m) cpow (s + Cx(&1)))` THEN CONJ_TAC THENL [ALL_TAC; EXISTS_TAC `1` THEN ASM_SIMP_TAC[IN_FROM; GE; LE_1; NEARZETA_BOUND_LEMMA; REAL_ARITH `&1 <= s ==> &0 <= s + &1`]] THEN SUBGOAL_THEN `summable (from n) (\m. lift(((Cx (norm s) * Cx (norm (s - Cx (&1)))) * Cx (&1) / Cx (&m) cpow Cx (Re s + &1))$1))` MP_TAC THENL [MATCH_MP_TAC SUMMABLE_COMPONENT THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN MATCH_MP_TAC ZETA_CONVERGES_LEMMA THEN REWRITE_TAC[RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM summable] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN EXISTS_TAC `1` THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_FROM; o_THM] THEN DISCH_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM RE_DEF] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; RE_MUL_CX; complex_div] THEN REWRITE_TAC[COMPLEX_NORM_MUL; REAL_MUL_LID; COMPLEX_NORM_INV] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[NORM_CPOW_REAL; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[GSYM CX_INV; RE_CX; RE_ADD]);; let GENZETA_CONVERGES = prove (`!n s. &1 < Re s ==> ((\m. Cx(&1) / Cx(&m) cpow s) sums genzeta n s) (from n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP NEARZETA_CONVERGES_LEMMA o MATCH_MP REAL_LT_IMP_LE) THEN MP_TAC(SPECL [`n:num`; `s - Cx(&1)`] ZETADIFF_CONVERGES) THEN ANTS_TAC THENL [REWRITE_TAC[RE_SUB; RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN REWRITE_TAC[COMPLEX_RING `a + (b - a) = b:complex`; genzeta] THEN COND_CASES_TAC THENL [UNDISCH_TAC `&1 < Re s` THEN ASM_REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `inv(s - Cx(&1))` o MATCH_MP SERIES_COMPLEX_LMUL) THEN SUBGOAL_THEN `~(s - Cx(&1) = Cx(&0))` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_SUB_0] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[complex_div; COMPLEX_MUL_ASSOC; COMPLEX_MUL_LINV] THEN REWRITE_TAC[COMPLEX_MUL_AC; COMPLEX_ADD_AC]);; let ZETA_CONVERGES = prove (`!s. &1 < Re s ==> ((\n. Cx(&1) / Cx(&n) cpow s) sums zeta(s)) (from 1)`, REWRITE_TAC[zeta; GENZETA_CONVERGES]);; (* ------------------------------------------------------------------------- *) (* We need the series for the derivative at one stage, so do this now. *) (* ------------------------------------------------------------------------- *) let COMPLEX_DERIVATIVE_ZETA_CONVERGES = prove (`!s. &1 < Re s ==> ((\n. --clog(Cx(&n)) / Cx(&n) cpow s) sums complex_derivative zeta s) (from 1)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n z. Cx(&1) / Cx(&n) cpow z`; `\n z. --clog(Cx(&n)) / Cx(&n) cpow z`; `{s | Re s > &1}`; `from 1`] SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX) THEN REWRITE_TAC[OPEN_HALFSPACE_RE_GT; IN_ELIM_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[IN_FROM] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; LE_1]; ALL_TAC] THEN POP_ASSUM(K ALL_TAC) THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[real_gt] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(Re z - &1) / &2`; `\n. Cx(&1) / Cx(&n) cpow (Cx(&1 + (Re z - &1) / &2))`; `42`] THEN ASM_SIMP_TAC[REAL_HALF; REAL_SUB_LT] THEN CONJ_TAC THENL [MP_TAC(SPEC `Cx(&1 + (Re z - &1) / &2)` ZETA_CONVERGES) THEN ANTS_TAC THENL [REWRITE_TAC[RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MESON_TAC[summable]; ALL_TAC] THEN ASM_SIMP_TAC[IN_FROM; CPOW_REAL_REAL; REAL_OF_NUM_LT; RE_CX; REAL_CX; LE_1; COMPLEX_NORM_DIV; NORM_CPOW_REAL] THEN REWRITE_TAC[GSYM CX_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_CX; RE_CX; real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_EXP_POS_LE] THEN REWRITE_TAC[REAL_ABS_EXP; GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `--(a * x) <= --(b * x) <=> b * x <= a * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN MP_TAC(SPEC `z - y:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_NORM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; real_gt] THEN MAP_EVERY X_GEN_TAC [`f:complex->complex`; `g:complex->complex`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `s:complex`) THEN SIMP_TAC[ASSUME `&1 < Re s`] THEN DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN FIRST_ASSUM(MP_TAC o SPEC `s:complex`) THEN SIMP_TAC[ASSUME `&1 < Re s`] THEN DISCH_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `b /\ c /\ d ==> e <=> b /\ c ==> d ==> e`] HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT) THEN EXISTS_TAC `Re s - &1` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN MAP_EVERY EXISTS_TAC [`\n. Cx(&1) / Cx(&n) cpow z`; `from 1`] THEN SUBGOAL_THEN `&1 < Re z` (fun th -> ASM_SIMP_TAC[th; ZETA_CONVERGES]) THEN MP_TAC(SPEC `z - s:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The zeta function is actually analytic on a larger set. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_NEARZETA_LEMMA = prove (`!n. 1 <= n ==> ?g g'. !s. s IN {s | Re(s) > &0} ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) sums g s) (from n) /\ ((\m. (Cx(&1) - (s - Cx(&1)) * clog(Cx(&m))) / Cx(&m) cpow s - (clog(Cx(&(m + 1))) / Cx(&(m + 1)) cpow (s - Cx(&1)) - clog(Cx(&m)) / Cx(&m) cpow (s - Cx(&1)))) sums g' s) (from n) /\ (g has_complex_derivative g' s) (at s)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX THEN REWRITE_TAC[OPEN_HALFSPACE_RE_GT] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `s:complex`] THEN REWRITE_TAC[IN_ELIM_THM; real_gt; from] THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN ASM_REWRITE_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `s:complex` THEN REWRITE_TAC[IN_ELIM_THM; real_gt] THEN DISCH_TAC THEN EXISTS_TAC `min (Re s / &2) (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; REAL_HALF] THEN EXISTS_TAC `\n. Cx(norm(s) + &2) pow 2 / Cx(&n) cpow Cx((Re s / &2 + &1))` THEN EXISTS_TAC `1` THEN CONJ_TAC THENL [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN MP_TAC(SPECL [`n:num`; `Cx(Re s / &2 + &1)`] GENZETA_CONVERGES) THEN REWRITE_TAC[RE_CX] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN MESON_TAC[summable]; ALL_TAC] THEN CONJ_TAC THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[from; IN_ELIM_THM] THENL [DISCH_TAC THEN SUBGOAL_THEN `1 <= m` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LE_1; GSYM CX_DIV; GSYM CX_POW] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN MATCH_MP_TAC REAL_POW_LE THEN NORM_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_BALL; dist] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) NEARZETA_BOUND_LEMMA o lhand o snd) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN MATCH_MP_TAC(NORM_ARITH `norm(w) = &1 /\ norm(z) <= x + &1 ==> norm z <= abs(x + &2) /\ norm(z - w) <= abs(x + &2)`) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN ASM_NORM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_NORM_INV; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LE_1] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; RE_ADD; RE_CX] THEN MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC);; let HOLOMORPHIC_NEARZETA_STRONG = prove (`!n s. 1 <= n /\ &0 < Re s ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) sums (nearzeta n s)) (from n) /\ ((\m. (Cx(&1) - (s - Cx(&1)) * clog(Cx(&m))) / Cx(&m) cpow s - (clog(Cx(&(m + 1))) / Cx(&(m + 1)) cpow (s - Cx(&1)) - clog(Cx(&m)) / Cx(&m) cpow (s - Cx(&1)))) sums (complex_derivative(nearzeta n) s)) (from n) /\ ((nearzeta n) has_complex_derivative complex_derivative(nearzeta n) s) (at s)`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_NEARZETA_LEMMA) THEN REWRITE_TAC[IN_ELIM_THM; real_gt; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:complex->complex`; `g':complex->complex`] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [FORALL_AND_THM; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN STRIP_TAC THEN SUBGOAL_THEN `!s. &0 < Re s ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) sums nearzeta n s) (from n)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; SUMS_INFSUM] THEN ASM_MESON_TAC[summable]; ALL_TAC] THEN SUBGOAL_THEN `!z. &0 < Re z ==> nearzeta n z = g z` ASSUME_TAC THENL [ASM_MESON_TAC[SERIES_UNIQUE]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `!z. &0 < Re z ==> ((nearzeta n) has_complex_derivative g' z) (at z)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`g:complex->complex`; `Re z`] THEN ASM_SIMP_TAC[dist] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC(SPEC `w - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DERIVATIVE]);; let NEARZETA_CONVERGES = prove (`!n s. &0 < Re s ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) sums nearzeta n s) (from n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; SUMS_INFSUM] THEN MATCH_MP_TAC SUMMABLE_EQ_COFINITE THEN EXISTS_TAC `from(n + 1)` THEN SUBGOAL_THEN `from(n + 1) DIFF from n UNION from n DIFF from(n + 1) = {n}` (fun th -> REWRITE_TAC[th; FINITE_INSERT; FINITE_RULES]) THENL [SIMP_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_SING] THEN ARITH_TAC; MP_TAC(SPECL [`n + 1`; `s:complex`] HOLOMORPHIC_NEARZETA_STRONG) THEN ASM_REWRITE_TAC[summable] THEN ANTS_TAC THENL [ARITH_TAC; MESON_TAC[]]]);; let SUMS_COMPLEX_DERIVATIVE_NEARZETA = prove (`!n s. 1 <= n /\ &0 < Re s ==> ((\m. (Cx(&1) - (s - Cx(&1)) * clog(Cx(&m))) / Cx(&m) cpow s - (clog(Cx(&(m + 1))) / Cx(&(m + 1)) cpow (s - Cx(&1)) - clog(Cx(&m)) / Cx(&m) cpow (s - Cx(&1)))) sums (complex_derivative (nearzeta n) s)) (from n)`, SIMP_TAC[HOLOMORPHIC_NEARZETA_STRONG]);; let HOLOMORPHIC_NEARZETA = prove (`!n. 1 <= n ==> (nearzeta n) holomorphic_on {s | Re(s) > &0}`, SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; IN_ELIM_THM] THEN REWRITE_TAC[real_gt] THEN MESON_TAC[HOLOMORPHIC_NEARZETA_STRONG]);; let COMPLEX_DIFFERENTIABLE_NEARZETA = prove (`!n s. 1 <= n /\ &0 < Re s ==> (nearzeta n) complex_differentiable (at s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HOLOMORPHIC_NEARZETA_STRONG) THEN MESON_TAC[complex_differentiable]);; let NEARZETA_1 = prove (`!n. 1 <= n ==> nearzeta n (Cx(&1)) = Cx(&0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; COMPLEX_SUB_REFL] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n:num. (vec 0:complex)` THEN REWRITE_TAC[SERIES_0; GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[COMPLEX_VEC_0; IN_FROM; complex_div] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `~(m = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[complex_pow] THEN CONV_TAC COMPLEX_RING);; let HOLOMORPHIC_ZETA = prove (`zeta holomorphic_on {s | Re(s) > &0 /\ ~(s = Cx(&1))}`, GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[zeta; genzeta] THEN MATCH_MP_TAC HOLOMORPHIC_TRANSFORM THEN EXISTS_TAC `\z. (nearzeta 1 z + Cx(&1) / Cx(&1) cpow (z - Cx(&1))) / (z - Cx(&1))` THEN SIMP_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[IN_ELIM_THM; COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `{s | Re s > &0}` THEN SIMP_TAC[HOLOMORPHIC_NEARZETA; LE_REFL; ETA_AX] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN REWRITE_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]]);; let COMPLEX_DIFFERENTIABLE_AT_ZETA = prove (`!s. &0 < Re s /\ ~(s = Cx(&1)) ==> zeta complex_differentiable at s`, MP_TAC HOLOMORPHIC_ZETA THEN REWRITE_TAC[SET_RULE `{s | P s /\ ~(s = a)} = {s | P s} DELETE a`] THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DELETE; OPEN_HALFSPACE_RE_GT] THEN REWRITE_TAC[complex_differentiable; IN_ELIM_THM; IN_DELETE; real_gt]);; (* ------------------------------------------------------------------------- *) (* Euler product formula. Nice proof from Ahlfors' book avoiding any *) (* messing round with the geometric series. *) (* ------------------------------------------------------------------------- *) let SERIES_DIVISORS_LEMMA = prove (`!x p l k. ((\n. x(p * n)) sums l) k ==> ~(p = 0) /\ (!n. (p * n) IN k <=> n IN k) ==> (x sums l) {n | n IN k /\ p divides n}`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `p * N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n DIV p`) THEN ASM_SIMP_TAC[LE_RDIV_EQ] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (rand o rand) VSUM_IMAGE (lhand w))) THEN ASM_SIMP_TAC[FINITE_INTER_NUMSEG; EQ_MULT_LCANCEL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTER; IN_NUMSEG] THEN ASM_SIMP_TAC[LE_RDIV_EQ; divides; LE_0] THEN ASM_MESON_TAC[]);; let EULER_PRODUCT_LEMMA = prove (`!s ps. &1 < Re s /\ FINITE ps /\ (!p. p IN ps ==> prime p) ==> ((\n. Cx(&1) / Cx(&n) cpow s) sums (cproduct ps (\p. Cx(&1) - inv(Cx(&p) cpow s)) * zeta s)) {n | 1 <= n /\ !p. prime p /\ p divides n ==> ~(p IN ps)}`, let lemma = prove (`(x sums (k + l)) (s UNION t) /\ s INTER t = {} ==> (x sums k) s ==> (x sums l) t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REWRITE_TAC[VECTOR_ADD_SUB] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_SIMP_TAC[SET_RULE `s INTER t = {} ==> t INTER u = (((s UNION t) INTER u) DIFF (s INTER u))`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_DIFF THEN REWRITE_TAC[FINITE_INTER_NUMSEG] THEN SET_TAC[]) in REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES] THEN ASM_SIMP_TAC[ZETA_CONVERGES; COMPLEX_MUL_LID; NOT_IN_EMPTY; GSYM from] THEN MAP_EVERY X_GEN_TAC [`p:num`; `ps:num->bool`] THEN REWRITE_TAC[IN_INSERT; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `inv(Cx(&p) cpow s)` o MATCH_MP SERIES_COMPLEX_LMUL) THEN REWRITE_TAC[complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_RING `x * Cx(&1) * y = Cx(&1) * x * y`] THEN REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[GSYM CPOW_MUL_REAL; REAL_CX; RE_CX; REAL_POS] THEN REWRITE_TAC[GSYM CX_MUL; REAL_OF_NUM_MUL] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[] (ISPEC `\n. Cx(&1) / Cx(&n) cpow s` SERIES_DIVISORS_LEMMA))) THEN ANTS_TAC THENL [SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[PRIME_DIVPROD_EQ] THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PRIME_PRIME_FACTOR; PRIME_1]; ALL_TAC] THEN MATCH_MP_TAC lemma THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `a * x + (Cx(&1) - a) * x = x`] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC) THEN SET_TAC[]);; let SUMMABLE_SUBZETA = prove (`!s t. &1 < Re s /\ ~(0 IN t) ==> summable t (\n. Cx (&1) / Cx (&n) cpow s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN EXISTS_TAC `from 1` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_FROM] THEN ASM_MESON_TAC[LE_1]; ALL_TAC] THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN EXISTS_TAC `\n. Cx(&1) / Cx(&n) cpow (Cx(Re s))` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[summable] THEN EXISTS_TAC `zeta (Cx(Re s))` THEN MATCH_MP_TAC ZETA_CONVERGES THEN ASM_REWRITE_TAC[RE_CX]; SIMP_TAC[IN_FROM; LE_1; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; GSYM CX_DIV; REAL_LE_DIV; REAL_POS; REAL_EXP_POS_LE]; EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0; IN_FROM] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0; NORM_POS_LE] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_LE_REFL; REAL_OF_NUM_LT; LE_1]]);; let EULER_PRODUCT_MULTIPLY = prove (`!s. &1 < Re s ==> ((\n. cproduct {p | prime p /\ p <= n} (\p. Cx(&1) - inv(Cx(&p) cpow s)) * zeta s) --> Cx(&1)) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. infsum {m | 1 <= m /\ !p. prime p /\ p divides m ==> ~(p IN {p | prime p /\ p <= n})} (\n. Cx (&1) / Cx (&n) cpow s)` THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC EULER_PRODUCT_LEMMA THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[FINITE_NUMSEG] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; LE_0; IN_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN SUBGOAL_THEN `?l. ((\n. Cx (&1) / Cx (&n) cpow Cx(Re s)) sums l) (from 1)` MP_TAC THENL [MP_TAC(SPEC `Cx(Re s)` ZETA_CONVERGES) THEN ASM_SIMP_TAC[RE_CX] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[SERIES_CAUCHY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:complex`; `{m | 1 <= m /\ (!p. prime p /\ p divides m ==> n < p)}`] SUMMABLE_SUBZETA) THEN ASM_REWRITE_TAC[IN_ELIM_THM; ARITH] THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (MP_TAC o SPEC `N1 + N2 + 1`)) THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN SIMP_TAC[NOT_LE] THEN MATCH_MP_TAC(REAL_ARITH `dist(x,z) < e / &2 /\ dist(y,z) <= dist(x,y) + dist(x,z) ==> dist(x,y) < e / &2 ==> dist(y,z) < e`) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIST_TRIANGLE; DIST_SYM]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `N1 + N2 + 1`) THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN REWRITE_TAC[dist] THEN SUBGOAL_THEN `vsum ({m | 1 <= m /\ (!p. prime p /\ p divides m ==> n < p)} INTER (0..N1 + N2 + 1)) (\n. Cx (&1) / Cx (&n) cpow s) - Cx(&1) = vsum (({m | 1 <= m /\ (!p. prime p /\ p divides m ==> n < p)} INTER (0..N1 + N2 + 1)) DELETE 1) (\n. Cx (&1) / Cx (&n) cpow s)` SUBST1_TAC THENL [SIMP_TAC[VSUM_DELETE_CASES; FINITE_INTER_NUMSEG] THEN REWRITE_TAC[IN_ELIM_THM; DIVIDES_ONE; IN_INTER] THEN REWRITE_TAC[CPOW_1; COMPLEX_DIV_1] THEN REWRITE_TAC[MESON[] `(!x. P x /\ x = 1 ==> Q x) <=> P 1 ==> Q 1`] THEN REWRITE_TAC[PRIME_1; IN_NUMSEG; ARITH; ARITH_RULE `1 <= a + b + 1`]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_NORM_VSUM_BOUND_SUBSET THEN REWRITE_TAC[FINITE_INTER_NUMSEG] THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; IN_DELETE; IN_INTER; IN_ELIM_THM; IN_NUMSEG; IN_FROM] THEN ASM_MESON_TAC[PRIME_FACTOR; DIVIDES_LE; NUM_REDUCE_CONV `1 <= 0`; LT_IMP_LE; LE_TRANS]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_INTER; IN_FROM] THEN STRIP_TAC THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID; COMPLEX_NORM_INV] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LE_1; NORM_CPOW_REAL] THEN SIMP_TAC[REAL_INV; REAL_CX; GSYM CX_INV; RE_CX; REAL_LE_REFL]);; let ZETA_NONZERO_LEMMA = prove (`!s. &1 < Re s ==> ~(zeta s = Cx(&0))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP EULER_PRODUCT_MULTIPLY) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &2`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; LE_REFL] THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; COMPLEX_NORM_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let EULER_PRODUCT = prove (`!s. &1 < Re s ==> ((\n. cproduct {p | prime p /\ p <= n} (\p. inv(Cx(&1) - inv(Cx(&p) cpow s)))) --> zeta(s)) sequentially`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (PAT_CONV `\x. ((\n. x) --> x) sq`) [GSYM COMPLEX_INV_INV] THEN MATCH_MP_TAC LIM_COMPLEX_INV THEN ASM_SIMP_TAC[COMPLEX_INV_EQ_0; ZETA_NONZERO_LEMMA] THEN FIRST_ASSUM(MP_TAC o MATCH_MP EULER_PRODUCT_MULTIPLY) THEN DISCH_THEN(MP_TAC o SPEC `inv(zeta(s))` o MATCH_MP LIM_COMPLEX_RMUL) THEN REWRITE_TAC[COMPLEX_MUL_LID; GSYM COMPLEX_MUL_ASSOC] THEN ASM_SIMP_TAC[ZETA_NONZERO_LEMMA; COMPLEX_MUL_RINV; COMPLEX_MUL_RID] THEN ASM_SIMP_TAC[GSYM CPRODUCT_INV; FINITE_ATMOST; COMPLEX_INV_INV]);; (* ------------------------------------------------------------------------- *) (* Show that s = 1 is not a zero, just for tidiness. *) (* ------------------------------------------------------------------------- *) let SUMS_GAMMA = prove (`((\n. Cx(sum(1..n) (\i. &1 / &i - (log(&(i + 1)) - log(&i))))) --> complex_derivative (nearzeta 1) (Cx(&1))) sequentially`, MP_TAC(SPECL [`1`; `Cx(&1)`] SUMS_COMPLEX_DERIVATIVE_NEARZETA) THEN SIMP_TAC[GSYM VSUM_CX; FINITE_NUMSEG; RE_CX; REAL_LT_01; LE_REFL] THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; CPOW_N; sums] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[FROM_INTER_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_NUMSEG; CX_INJ; REAL_OF_NUM_EQ; ADD_EQ_0; ARITH; REAL_OF_NUM_LT; ARITH_RULE `1 <= i ==> 0 < i /\ ~(i = 0)`; GSYM CX_LOG; ARITH_RULE `0 < i + 1`] THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_SUB_RZERO] THEN REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; REAL_DIV_1]);; let ZETA_1_NZ = prove (`~(zeta(Cx(&1)) = Cx(&0))`, REWRITE_TAC[zeta; genzeta] THEN DISCH_TAC THEN SUBGOAL_THEN `&1 - log(&2) <= Re(complex_derivative (nearzeta 1) (Cx(&1)))` MP_TAC THENL [REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_LBOUND) THEN EXISTS_TAC `\n. Cx(sum(1..n) (\i. &1 / &i - (log(&(i + 1)) - log(&i))))` THEN REWRITE_TAC[SUMS_GAMMA; TRIVIAL_LIMIT_SEQUENTIALLY; DIMINDEX_2; ARITH] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[GSYM RE_DEF; RE_CX] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH; REAL_DIV_1; LOG_1] THEN REWRITE_TAC[REAL_ARITH `a - b <= a - (b - &0) + c <=> &0 <= c`] THEN MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN SIMP_TAC[REAL_SUB_LE; GSYM LOG_DIV; REAL_OF_NUM_LT; ARITH_RULE `2 <= x ==> 0 < x /\ 0 < x + 1`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN SIMP_TAC[REAL_FIELD `&0 < x ==> (x + &1) / x = &1 + &1 / x`; REAL_OF_NUM_LT; ARITH_RULE `2 <= x ==> 0 < x`] THEN SIMP_TAC[LOG_LE; REAL_LE_DIV; REAL_POS]; ASM_REWRITE_TAC[RE_CX; REAL_NOT_LE; REAL_SUB_LT] THEN GEN_REWRITE_TAC I [GSYM REAL_EXP_MONO_LT] THEN SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; ARITH] THEN SUBGOAL_THEN `(&1 + &1 / &2) pow 2 <= exp(&1 / &2) pow 2` MP_TAC THENL [MATCH_MP_TAC REAL_POW_LE2 THEN CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[REAL_EXP_LE_X]; ALL_TAC] THEN SIMP_TAC[GSYM REAL_EXP_N; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Lack of zeros on Re(s) >= 1. Nice proof from Bak & Newman. *) (* ------------------------------------------------------------------------- *) let ZETA_MULTIPLE_BOUND = prove (`!x y. real x /\ real y /\ &1 < Re x ==> &1 <= norm(zeta(x) pow 3 * zeta(x + ii * y) pow 4 * zeta(x + Cx(&2) * ii * y) pow 2)`, let lemma1 = prove (`&0 <= a /\ &0 <= b /\ &0 <= c /\ c * (&2 * a + b) pow 3 / &27 <= x ==> c * a pow 2 * b <= x`, REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b <= x ==> a <= x`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `a pow 2 * b <= (&2 * a + b) pow 3 / &27 <=> &0 <= (&8 / &27 * a + &1 / &27 * b) * (a - b) pow 2`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN ASM_REAL_ARITH_TAC) and lemma2 = prove (`-- &1 <= t /\ t <= &1 ==> &0 <= &1 + r pow 2 - &2 * r * t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= (&1 - t) * (&1 + t) /\ &0 <= (r - t) pow 2 ==> &0 <= &1 + r pow 2 - &2 * r * t`) THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_LBOUND) THEN EXISTS_TAC `\n. cproduct {p | prime p /\ p <= n} (\p. inv(Cx(&1) - inv(Cx(&p) cpow x))) pow 3 * cproduct {p | prime p /\ p <= n} (\p. inv(Cx(&1) - inv(Cx(&p) cpow (x + ii * y)))) pow 4 * cproduct {p | prime p /\ p <= n} (\p. inv(Cx(&1) - inv(Cx(&p) cpow (x + Cx(&2) * ii * y)))) pow 2` THEN REWRITE_TAC[eventually; TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC) THEN MATCH_MP_TAC LIM_COMPLEX_POW THEN MATCH_MP_TAC EULER_PRODUCT THEN RULE_ASSUM_TAC(REWRITE_RULE[real]) THEN ASM_REWRITE_TAC[RE_ADD; RE_MUL_CX; RE_MUL_II; REAL_NEG_0; REAL_ADD_RID; REAL_MUL_RZERO]; ALL_TAC] THEN EXISTS_TAC `0` THEN REWRITE_TAC[SEQUENTIALLY; GE; LE_0] THEN X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[GSYM COMPLEX_NORM_INV; COMPLEX_NORM_NZ; COMPLEX_INV_EQ_0] THEN ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0; ARITH; COMPLEX_INV_EQ_0; CPRODUCT_EQ_0; IN_ELIM_THM; FINITE_ATMOST] THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) - x = Cx(&0) <=> x = Cx(&1)`] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM] THEN CONJ_TAC THENL [REWRITE_TAC[TAUT `(~p \/ ~q) \/ ~r <=> p /\ q ==> ~r`] THEN REPEAT CONJ_TAC THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `(norm:complex->real) o inv`) THEN REWRITE_TAC[COMPLEX_NORM_INV; o_THM; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_INV_INV; REAL_INV_1] THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_OF_NUM_LT; PRIME_IMP_NZ; LT_NZ; REAL_EXP_EQ_1; REAL_CX; RE_CX] THEN RULE_ASSUM_TAC(REWRITE_RULE[real]) THEN ASM_REWRITE_TAC[REAL_ENTIRE; RE_ADD; RE_MUL_CX; RE_MUL_II; REAL_NEG_0; REAL_ADD_RID; REAL_MUL_RZERO] THEN MATCH_MP_TAC(REAL_ARITH `&1 < x /\ &0 < y ==> ~(x = &0 \/ y = &0)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOG_POS_LT THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CPRODUCT_POW; FINITE_ATMOST; GSYM CPRODUCT_MUL] THEN SIMP_TAC[GSYM CPRODUCT_INV; COMPLEX_INV_INV; FINITE_ATMOST] THEN REWRITE_TAC[COMPLEX_INV_MUL; GSYM COMPLEX_POW_INV; COMPLEX_INV_INV] THEN SIMP_TAC[NORM_CPRODUCT; FINITE_ATMOST; REAL_INV_1] THEN MATCH_MP_TAC PRODUCT_LE_1 THEN SIMP_TAC[NORM_POS_LE; FINITE_ATMOST] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[CPOW_ADD; COMPLEX_MUL_2; GSYM COMPLEX_POW_2] THEN REWRITE_TAC[COMPLEX_INV_MUL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN ASM_REWRITE_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ] THEN REWRITE_TAC[GSYM CEXP_NEG; GSYM CEXP_N] THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM o CONV_RULE(REWR_CONV REAL))) THEN SIMP_TAC[GSYM CX_MUL; GSYM CX_NEG; GSYM CX_EXP; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `--(ii * x) = ii * --x`] THEN REWRITE_TAC[COMPLEX_RING `--(Cx(&2) * ii * x) = ii * Cx(&2) * --x`] THEN REWRITE_TAC[CEXP_EULER] THEN REWRITE_TAC[CCOS_NEG; CSIN_NEG; GSYM CX_SIN; GSYM CX_COS; GSYM CX_NEG; GSYM CX_MUL] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN SIMP_TAC[REAL_RING `(z:real) pow 4 = (z pow 2) pow 2`; COMPLEX_SQNORM] THEN REWRITE_TAC[COMPLEX_SQNORM] THEN REWRITE_TAC[RE_SUB; RE_CX; RE_MUL_CX; RE_ADD; RE_MUL_II; IM_SUB; IM_CX; IM_MUL_CX; IM_ADD; IM_MUL_II] THEN REWRITE_TAC[REAL_NEG_0; REAL_ADD_RID; REAL_SUB_LZERO; REAL_ADD_LID] THEN REWRITE_TAC[REAL_RING `(&1 - r * c) pow 2 + --(r * s) pow 2 = &1 + r pow 2 * (s pow 2 + c pow 2) - &2 * r * c`] THEN REWRITE_TAC[SIN_CIRCLE; REAL_POW_NEG; ARITH] THEN ABBREV_TAC `r = exp(--(Re x * log(&p)))` THEN REWRITE_TAC[COS_DOUBLE_COS; COS_NEG; GSYM CX_SUB; COMPLEX_NORM_CX] THEN ABBREV_TAC `t = cos(Re y * log(&p))` THEN REWRITE_TAC[REAL_MUL_RID; REAL_ARITH `x - &2 * r * (&2 * y - &1) = x + &2 * r - &4 * r * y`] THEN MP_TAC(SPEC `Re y * log(&p)` COS_BOUNDS) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 < r /\ r < &1` MP_TAC THENL [EXPAND_TAC "r" THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN SUBST1_TAC(GSYM REAL_EXP_0) THEN REWRITE_TAC[REAL_EXP_MONO_LT] THEN REWRITE_TAC[REAL_LT_LNEG; REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[LOG_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `1 < t <=> 2 <= t`; PRIME_GE_2] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[REAL_ARITH `r < &1 ==> abs(&1 - r) = (&1 - r)`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN MATCH_MP_TAC lemma1 THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_SUB_LE; lemma2] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `&1 + s + &2 * r - &4 * r * t = &1 + s - &2 * r * (&2 * t - &1)`] THEN MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `-- &1 <= &2 * x pow 2 - &1 <=> &0 <= x * x`; REAL_ARITH `&2 * t pow 2 - &1 <= &1 <=> t pow 2 <= &1 pow 2`; REAL_LE_SQUARE] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `x pow 3 * y pow 3 / &27 <= &1 <=> (x * y) pow 3 <= &3 pow 3`] THEN MATCH_MP_TAC REAL_POW_LE2_ODD THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[REAL_ARITH `&2 * (&1 + r pow 2 - &2 * r * t) + &1 + r pow 2 + &2 * r - &4 * r * t pow 2 = (&3 + &3 * r pow 2) - &2 * r * (&2 * t pow 2 + &2 * t - &1)`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - r) * ((&3 + &3 * r pow 2) + &3 * r)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_ARITH `c - &2 * r * y <= c + &3 * r <=> &0 <= r * (&2 * y + &3)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `&0 <= &2 * (&2 * t pow 2 + &2 * t - &1) + &3 <=> &0 <= (t + &1 / &2) pow 2`] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= r pow 3` MP_TAC THENL [ASM_SIMP_TAC[REAL_POW_LE]; REAL_ARITH_TAC]);; let ZETA_NONZERO = prove (`!s. &1 <= Re s ==> ~(zeta s = Cx(&0))`, REWRITE_TAC[REAL_ARITH `&1 <= x <=> &1 < x \/ x = &1`] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[ZETA_NONZERO_LEMMA] THEN SUBST1_TAC(SPEC `s:complex` COMPLEX_EXPAND) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `y = Im s` THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; ZETA_1_NZ] THEN DISCH_TAC THEN SUBGOAL_THEN `~(&1 <= norm((Cx(&0) * complex_derivative (\x. zeta(x + ii * Cx y)) (Cx(&1)) pow 4) * zeta (Cx(&1) + Cx (&2) * ii * Cx(y)) pow 2))` MP_TAC THENL [REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_MUL_LZERO] THEN REAL_ARITH_TAC; SIMP_TAC[]] THEN MATCH_MP_TAC(ISPEC `at (Cx(&1)) within {s | real s /\ &1 < Re s}` LIM_NORM_LBOUND) THEN EXISTS_TAC `\x. zeta (x) pow 3 * zeta (x + ii * Cx(y)) pow 4 * zeta (x + Cx (&2) * ii * Cx(y)) pow 2` THEN REWRITE_TAC[eventually; TRIVIAL_LIMIT_WITHIN; WITHIN; AT] THEN SUBGOAL_THEN `Cx(&1) limit_point_of {s | real s /\ &1 < Re s}` ASSUME_TAC THENL [REWRITE_TAC[LIMPT_APPROACHABLE_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `Cx(&1 + e)` THEN REWRITE_TAC[dist; CX_INJ; IN_ELIM_THM; REAL_CX; RE_CX] THEN REWRITE_TAC[GSYM CX_SUB; REAL_ADD_SUB; COMPLEX_NORM_CX] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[IN_ELIM_THM; REAL_CX; ZETA_MULTIPLE_BOUND] THEN MAP_EVERY EXISTS_TAC [`Cx(&3)`; `Cx(&2)`] THEN REWRITE_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX; REAL_CX; RE_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM CONTINUOUS_WITHIN] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_POW THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_ZETA THEN REWRITE_TAC[RE_ADD; RE_MUL_CX; RE_MUL_II; RE_II; RE_CX] THEN REWRITE_TAC[COMPLEX_RING `x + y = x <=> y = Cx(&0)`] THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ; REAL_OF_NUM_EQ; ARITH] THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\x. (zeta x pow 3 * (x - Cx(&1)) pow 4) * (zeta(x + ii * Cx y) / (x - Cx(&1))) pow 4` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SIMP_TAC[LIM_WITHIN; GSYM DIST_NZ; COMPLEX_SUB_0; COMPLEX_FIELD `~(x = Cx(&0)) ==> (y * x pow 4) * (z / x) pow 4 - y * z pow 4 = Cx(&0)`] THEN SIMP_TAC[dist; COMPLEX_VEC_0; COMPLEX_SUB_REFL; COMPLEX_NORM_0] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LIM_COMPLEX_POW THEN SUBGOAL_THEN `((\x. zeta (x + ii * Cx y)) has_complex_derivative complex_derivative (\x. zeta (x + ii * Cx y)) (Cx (&1))) (at (Cx (&1)) within {s | real s /\ &1 < Re s})` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN; COMPLEX_SUB_RZERO]] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN SIMP_TAC[COMPLEX_DIFFERENTIABLE_ADD; COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_ZETA THEN ASM_REWRITE_TAC[RE_ADD; RE_MUL_II; COMPLEX_RING `x + y = x <=> y = Cx(&0)`; IM_CX; COMPLEX_ENTIRE; II_NZ; RE_CX; CX_INJ] THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\x. (nearzeta 1 (x) + Cx(&1)) pow 3 * (x - Cx(&1))` THEN CONJ_TAC THENL [SIMP_TAC[LIM_WITHIN; CPOW_1; GSYM DIST_NZ; zeta; genzeta; COMPLEX_DIV_1; COMPLEX_FIELD `~(x:complex = a) ==> b * (x - a) - (c / (x - a)) pow 3 * (x - a) pow 4 = (b - c pow 3) * (x - a)`] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_REFL] THEN SIMP_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO; COMPLEX_NORM_0] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MATCH_MP_TAC LIM_AT_WITHIN THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = (nearzeta 1 (Cx(&1)) + Cx(&1)) pow 3 * (Cx(&1) - Cx(&1))`) THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN SIMP_TAC[LIM_SUB; LIM_CONST; LIM_AT_ID] THEN MATCH_MP_TAC LIM_COMPLEX_POW THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[GSYM CONTINUOUS_AT] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_NEARZETA; RE_CX; REAL_OF_NUM_LT; ARITH]);; let NEARZETA_NONZERO = prove (`!s. &1 <= Re s ==> ~(nearzeta 1 s + Cx (&1) = Cx(&0))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ZETA_NONZERO) THEN REWRITE_TAC[zeta; genzeta] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NEARZETA_1; ARITH; CPOW_1] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD);; (* ------------------------------------------------------------------------- *) (* The logarithmic derivative of the zeta function. *) (* ------------------------------------------------------------------------- *) let NORM_CLOG_BOUND = prove (`norm(z) <= &1 / &2 ==> norm(clog(Cx(&1) - z)) <= &2 * norm(z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. clog(Cx(&1) - z)`; `\z. inv(z - Cx(&1))`; `cball(Cx(&0),&1 / &2)`; `&2`] COMPLEX_DIFFERENTIABLE_BOUND) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPECL [`z:complex`; `Cx(&0)`]) THEN REWRITE_TAC[COMPLEX_SUB_RZERO; CLOG_1] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_CBALL] THEN REWRITE_TAC[IN_CBALL] THEN ASM_REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN REWRITE_TAC[CONVEX_CBALL; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN CONJ_TAC THENL [COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_RING `(Cx(&0) - Cx(&1)) * x = --x`] THEN REWRITE_TAC[COMPLEX_NEG_INV; COMPLEX_NEG_SUB] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[RE_SUB; REAL_SUB_LT] THEN MP_TAC(SPEC `w:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&1 / &2)`)) THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN MP_TAC(SPEC `1` COMPLEX_NORM_NUM) THEN ASM_NORM_ARITH_TAC);; let LOGZETA_EXISTS = prove (`?logzeta logzeta'. !s. s IN {s | Re s > &1} ==> ((\p. clog(Cx(&1) - inv(Cx(&p) cpow s))) sums logzeta(s)) {p | prime p} /\ ((\p. clog(Cx(&p)) / (Cx(&p) cpow s - Cx(&1))) sums logzeta'(s)) {p | prime p} /\ (logzeta has_complex_derivative logzeta'(s)) (at s)`, MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX THEN REWRITE_TAC[OPEN_HALFSPACE_RE_GT] THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM; real_gt] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ; COMPLEX_SUB_LZERO; COMPLEX_MUL_LID; COMPLEX_FIELD `~(x = Cx(&0)) ==> --(a * x) / x pow 2 = --(a / x)`] THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_INV_MUL] THEN ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ; COMPLEX_FIELD `~(y = Cx(&0)) ==> y * (Cx(&1) - inv(y)) = y - Cx(&1)`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[RE_SUB; REAL_SUB_LT] THEN MATCH_MP_TAC(REAL_ARITH `!y. abs x <= y /\ y < w ==> x < w`) THEN EXISTS_TAC `norm(inv (Cx (&p) cpow s))` THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN REWRITE_TAC[RE_CX] THEN ASM_SIMP_TAC[COMPLEX_NORM_INV; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ] THEN REWRITE_TAC[GSYM REAL_EXP_NEG; GSYM REAL_EXP_0; REAL_EXP_MONO_LT] THEN REWRITE_TAC[REAL_LT_LNEG; REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[LOG_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `1 < p <=> 2 <= p`; PRIME_GE_2] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM; real_gt] THEN X_GEN_TAC `s:complex` THEN DISCH_TAC THEN EXISTS_TAC `(Re(s) - &1) / &2` THEN EXISTS_TAC `\p. Cx(&2) / Cx(&p) cpow (Cx(&1 + (Re(s) - &1) / &2))` THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT; RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN MATCH_MP_TAC SUMMABLE_SUBSET_COMPLEX THEN EXISTS_TAC `from 1` THEN SIMP_TAC[CPOW_REAL_REAL; IN_FROM; REAL_CX; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> 1 <= n`; GSYM CX_INV; REAL_LE_INV_EQ; REAL_EXP_POS_LE] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_FROM; PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 <= p`] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `zeta(Cx(&1 + (Re s - &1) / &2))` THEN ONCE_REWRITE_TAC[COMPLEX_RING `inv(x) = Cx(&1) * inv x`] THEN REWRITE_TAC[GSYM complex_div] THEN MATCH_MP_TAC ZETA_CONVERGES THEN REWRITE_TAC[RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [SIMP_TAC[CPOW_REAL_REAL; IN_FROM; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ; GSYM CX_DIV; REAL_CX; REAL_LE_DIV; REAL_POS; REAL_EXP_POS_LE]; ALL_TAC] THEN SUBGOAL_THEN `summable (from 1) (\n. Cx (&1) / Cx (&n) cpow (Cx(&1 + (Re s - &1) / &2)))` MP_TAC THENL [REWRITE_TAC[summable] THEN EXISTS_TAC `zeta(Cx(&1 + (Re s - &1) / &2))` THEN MATCH_MP_TAC ZETA_CONVERGES THEN REWRITE_TAC[RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &2` o MATCH_MP SERIES_GOESTOZERO) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:num` THEN DISCH_THEN(fun th -> X_GEN_TAC `y:complex` THEN STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[IN_FROM; PRIME_IMP_NZ; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * norm(inv(Cx(&p) cpow y))` THEN CONJ_TAC THENL [MATCH_MP_TAC NORM_CLOG_BOUND THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> y <= x ==> y <= a`)) THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID]; SIMP_TAC[complex_div; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS]] THEN REWRITE_TAC[GSYM CPOW_NEG] THEN ASM_SIMP_TAC[NORM_CPOW_REAL_MONO; REAL_CX; RE_CX; REAL_OF_NUM_LT; PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 < p`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_BALL_RE) THEN REWRITE_TAC[RE_NEG; RE_CX] THEN REAL_ARITH_TAC);; let LOGZETA_PROPERTIES = new_specification ["logzeta"; "logzeta'"] LOGZETA_EXISTS;; let [LOGZETA_CONVERGES; LOGZETA'_CONVERGES; HAS_COMPLEX_DERIVATIVE_LOGZETA] = CONJUNCTS(REWRITE_RULE[IN_ELIM_THM; FORALL_AND_THM; real_gt; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] LOGZETA_PROPERTIES);; let CEXP_LOGZETA = prove (`!s. &1 < Re s ==> cexp(--(logzeta s)) = zeta s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. cexp(vsum({p | prime p} INTER (0..n)) (\p. --clog(Cx(&1) - inv(Cx(&p) cpow s))))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`cexp`; `--logzeta s`] CONTINUOUS_AT_SEQUENTIALLY) THEN REWRITE_TAC[CONTINUOUS_AT_CEXP; o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[GSYM sums] THEN MATCH_MP_TAC SERIES_NEG THEN ASM_SIMP_TAC[LOGZETA_CONVERGES]; SIMP_TAC[CEXP_VSUM; FINITE_INTER_NUMSEG] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\n. cproduct {p | prime p /\ p <= n} (\p. inv(Cx(&1) - inv(Cx(&p) cpow s)))` THEN ASM_SIMP_TAC[EULER_PRODUCT] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[VECTOR_SUB_EQ; numseg; LE_0] THEN REWRITE_TAC[SET_RULE `{x | P x} INTER {x | Q x} = {x | P x /\ Q x}`] THEN MATCH_MP_TAC CPRODUCT_EQ THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM; CEXP_NEG] THEN STRIP_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CEXP_CLOG THEN REWRITE_TAC[COMPLEX_SUB_0] THEN DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; REAL_OF_NUM_LT; RE_CX; REAL_ABS_NUM; COMPLEX_NORM_INV; PRIME_IMP_NZ; LT_NZ; COMPLEX_NORM_CX; REAL_EXP_EQ_1] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM REAL_EXP_0; GSYM REAL_EXP_NEG; REAL_EXP_INJ] THEN REWRITE_TAC[REAL_NEG_EQ_0; REAL_ENTIRE] THEN ASM_SIMP_TAC[REAL_ARITH `&1 < s ==> ~(s = &0)`] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC LOG_POS_LT THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC]);; let HAS_COMPLEX_DERIVATIVE_ZETA = prove (`!s. &1 < Re s ==> (zeta has_complex_derivative (--(logzeta'(s)) * zeta(s))) (at s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN EXISTS_TAC `\s. cexp(--(logzeta s))` THEN EXISTS_TAC `Re s - &1` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CEXP_LOGZETA THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_BALL_RE) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN ASM_SIMP_TAC[GSYM CEXP_LOGZETA; HAS_COMPLEX_DERIVATIVE_CEXP] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_NEG THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_LOGZETA]);; let COMPLEX_DERIVATIVE_ZETA = prove (`!s. &1 < Re s ==> complex_derivative zeta s = --(logzeta'(s)) * zeta(s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_ZETA]);; let CONVERGES_LOGZETA'' = prove (`!s. &1 < Re s ==> ((\p. Cx(log(&p)) / (Cx(&p) cpow s - Cx(&1))) sums (--(complex_derivative zeta s / zeta s))) {p | prime p}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `--(complex_derivative zeta s / zeta s) = logzeta'(s)` SUBST1_TAC THENL [ASM_SIMP_TAC[ZETA_NONZERO_LEMMA; COMPLEX_DERIVATIVE_ZETA; COMPLEX_FIELD `~(b = Cx(&0)) ==> (--(a / b) = c <=> a = --c * b)`]; MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\p. clog(Cx(&p)) / (Cx(&p) cpow s - Cx(&1))` THEN ASM_SIMP_TAC[LOGZETA'_CONVERGES; IN_ELIM_THM] THEN SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ]]);; (* ------------------------------------------------------------------------- *) (* Some lemmas about negating a path. *) (* ------------------------------------------------------------------------- *) let VALID_PATH_NEGATEPATH = prove (`!g. valid_path g ==> valid_path ((--) o g)`, REWRITE_TAC[valid_path; o_DEF] THEN ASM_SIMP_TAC[PIECEWISE_DIFFERENTIABLE_NEG]);; let PATHSTART_NEGATEPATH = prove (`!g. pathstart((--) o g) = --(pathstart g)`, REWRITE_TAC[pathstart; o_THM]);; let PATHFINISH_NEGATEPATH = prove (`!g. pathfinish((--) o g) = --(pathfinish g)`, REWRITE_TAC[pathfinish; o_THM]);; let PATH_IMAGE_NEGATEPATH = prove (`!g. path_image((--) o g) = IMAGE (--) (path_image g)`, REWRITE_TAC[path_image; IMAGE_o]);; let HAS_PATH_INTEGRAL_NEGATEPATH = prove (`!g z. valid_path g /\ ((\z. f(--z)) has_path_integral (--i)) g ==> (f has_path_integral i) ((--) o g)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[has_path_integral] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_NEG) THEN REWRITE_TAC[VECTOR_NEG_NEG] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN FIRST_ASSUM MP_TAC THEN REWRITE_TAC[valid_path; piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NEGLIGIBLE_FINITE] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[o_DEF; GSYM COMPLEX_MUL_RNEG] THEN AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[DROP_VEC; REAL_LT_01] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_NEG THEN ASM_SIMP_TAC[GSYM VECTOR_DERIVATIVE_WORKS; DIFFERENTIABLE_AT_WITHIN]);; let WINDING_NUMBER_NEGATEPATH = prove (`!g z. valid_path g /\ ~(Cx(&0) IN path_image g) ==> winding_number((--) o g,Cx(&0)) = winding_number(g,Cx(&0))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; VALID_PATH_NEGATEPATH; PATH_IMAGE_NEGATEPATH; IN_IMAGE; UNWIND_THM2; COMPLEX_RING `Cx(&0) = --x <=> x = Cx(&0)`] THEN AP_TERM_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_NEGATEPATH THEN ASM_REWRITE_TAC[COMPLEX_RING `--z - Cx(&0) = --(z - Cx(&0))`] THEN REWRITE_TAC[complex_div; COMPLEX_INV_NEG; COMPLEX_MUL_RNEG] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_NEG THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN ASM_SIMP_TAC[GSYM complex_div; PATH_INTEGRABLE_INVERSEDIFF]);; let PATH_INTEGRABLE_NEGATEPATH = prove (`!g z. valid_path g /\ (\z. f(--z)) path_integrable_on g ==> f path_integrable_on ((--) o g)`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_NEGATEPATH; COMPLEX_NEG_NEG]);; (* ------------------------------------------------------------------------- *) (* Some bounding lemmas given by Newman. BOUND_LEMMA_2 is my variant since I *) (* use a slightly different contour. *) (* ------------------------------------------------------------------------- *) let BOUND_LEMMA_0 = prove (`!z R. norm(z) = R ==> Cx(&1) / z + z / Cx(R) pow 2 = Cx(&2 * Re z / R pow 2)`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN REWRITE_TAC[GSYM complex_div] THEN ASM_REWRITE_TAC[COMPLEX_INV_CNJ] THEN ASM_REWRITE_TAC[complex_div; GSYM COMPLEX_ADD_RDISTRIB] THEN REWRITE_TAC[COMPLEX_ADD_CNJ; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_INV; COMPLEX_NORM_POW] THEN REWRITE_TAC[CX_MUL; CX_DIV; CX_POW; complex_div; GSYM COMPLEX_MUL_ASSOC]);; let BOUND_LEMMA_1 = prove (`!z R. norm(z) = R ==> norm(Cx(&1) / z + z / Cx(R) pow 2) = &2 * abs(Re z) / R pow 2`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BOUND_LEMMA_0; COMPLEX_NORM_CX] THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN ASM_MESON_TAC[NORM_ARITH `norm z = R ==> abs R = R`]);; let BOUND_LEMMA_2 = prove (`!R x z. Re(z) = --x /\ abs(Im(z)) = R /\ &0 <= x /\ &0 < R ==> norm (Cx (&1) / z + z / Cx R pow 2) <= &2 * x / R pow 2`, REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LE_SQUARE; COMPLEX_SQNORM; DOT_SQUARE_NORM] THEN REWRITE_TAC[REAL_ARITH `&0 <= &2 * x <=> &0 <= x`] THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV; REAL_LT_IMP_LE; REAL_POW_LT] THEN REWRITE_TAC[complex_div] THEN SUBST1_TAC(SPEC `z:complex` COMPLEX_INV_CNJ) THEN ASM_SIMP_TAC[cnj; RE; IM; COMPLEX_MUL_LID; REAL_LE_MUL; REAL_POS] THEN REWRITE_TAC[GSYM CX_POW; COMPLEX_SQNORM; RE; IM] THEN ASM_REWRITE_TAC[REAL_RING `(--x:real) pow 2 = x pow 2`] THEN REWRITE_TAC[GSYM CX_INV; complex_div] THEN REWRITE_TAC[complex_mul; complex_add; RE; IM; RE_CX; IM_CX; REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_ADD_LID] THEN ASM_REWRITE_TAC[REAL_RING `(--x:real) pow 2 = x pow 2`; REAL_RING `(--x * a + --x * b:real) pow 2 = x pow 2 * (a + b) pow 2`; REAL_RING `(--R * a + R * b:real) pow 2 = R pow 2 * (b - a) pow 2`] THEN SUBGOAL_THEN `&0 < x pow 2 + R pow 2` ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 < y ==> &0 < x + y`) THEN ASM_SIMP_TAC[REAL_POW_LT] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]; ALL_TAC] THEN SUBGOAL_THEN `Im z pow 2 = R pow 2` SUBST1_TAC THENL [ASM_MESON_TAC[REAL_POW2_ABS]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_FIELD `&0 < R pow 2 /\ &0 < x pow 2 + R pow 2 ==> x pow 2 * (inv (x pow 2 + R pow 2) + inv (R pow 2)) pow 2 + R pow 2 * (inv (R pow 2) - inv (x pow 2 + R pow 2)) pow 2 = (x pow 4 + &5 * R pow 2 * x pow 2 + &4 * R pow 4) / (x pow 2 + R pow 2) pow 2 * (x pow 2 / R pow 4)`] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_FIELD `&0 < R pow 2 ==> (&2 * x / R pow 2) pow 2 = &4 * x pow 2 / R pow 4`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN CONV_TAC(RAND_CONV REAL_POLY_CONV) THEN REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN ASM_SIMP_TAC[REAL_POS; REAL_POW_LE; REAL_LT_IMP_LE]);; let BOUND_LEMMA_3 = prove (`!a n. (!m. 1 <= m ==> norm(a(m)) <= &1) /\ 1 <= n /\ &1 <= Re w /\ &0 < Re z ==> norm(vsum(1..n) (\n. a(n) / Cx(&n) cpow (w - z))) <= exp(Re(z) * log(&n)) * (&1 / &n + &1 / Re(z))`, let lemma1 = prove (`!n x. &1 <= x ==> sum(1..n) (\n. exp((x - &1) * log(&n))) <= exp(x * log(&n + &1)) / x`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL [ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUM_CLAUSES] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN UNDISCH_TAC `&1 <= x` THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\n. n cpow (Cx(x) - Cx(&1))`; `\n. n cpow (Cx(x)) / (Cx(x))`; `1`; `n:num`] SUM_INTEGRAL_UBOUND_INCREASING) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(Cx x = Cx(&0))` MP_TAC THENL [REWRITE_TAC[CX_INJ] THEN UNDISCH_TAC `&1 <= x` THEN REAL_ARITH_TAC; CONV_TAC COMPLEX_FIELD]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `&1 <= b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_SUB; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_ARITH `&1 <= x ==> &0 < x`] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ u <= v ==> x <= u ==> y <= v`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[GSYM CX_SUB]; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> 1 <= n`; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[CPOW_1] THEN REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> x - y <= x`) THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN UNDISCH_TAC `&1 <= x` THEN REAL_ARITH_TAC) and lemma1' = prove (`!n x. &0 < x /\ x <= &1 ==> sum(1..n) (\n. exp((x - &1) * log(&n))) <= exp(x * log(&n)) / x`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL [ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUM_CLAUSES] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_EXP_POS_LE; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT] THEN REWRITE_TAC[LOG_1; REAL_MUL_RZERO; REAL_EXP_0; ARITH] THEN ASM_CASES_TAC `2 <= n` THENL [ALL_TAC; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN SIMP_TAC[GSYM NUMSEG_EMPTY; SUM_CLAUSES] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `n = 1` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LOG_1; REAL_MUL_RZERO; REAL_EXP_0; real_div; REAL_MUL_LID; REAL_ADD_RID; REAL_INV_1_LE]] THEN MP_TAC(ISPECL [`\n. n cpow (Cx(x) - Cx(&1))`; `\n. n cpow (Cx(x)) / (Cx(x))`; `2`; `n:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN REWRITE_TAC[RE_CX] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(Cx x = Cx(&0))` MP_TAC THENL [REWRITE_TAC[CX_INJ] THEN UNDISCH_TAC `&0 < x` THEN REAL_ARITH_TAC; CONV_TAC COMPLEX_FIELD]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `&1 <= b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_SUB; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_ARITH `&1 <= x ==> &0 < x`] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC(REAL_ARITH `(&1 - x) * a <= (&1 - x) * b ==> (x - &1) * b <= (x - &1) * a`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ &1 + u <= v ==> x <= u ==> &1 + y <= v`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CPOW_1] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[GSYM CX_SUB]; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `2 <= i ==> 0 < i`] THEN REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 + a - x <= a`) THEN ASM_SIMP_TAC[REAL_INV_1_LE; real_div; REAL_MUL_LID]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..n) (\n. exp((Re(z) - &1) * log(&n)))` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `0 < k <=> 1 <= k`] THEN REWRITE_TAC[real_div; GSYM REAL_EXP_NEG] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_EXP_POS_LE; REAL_EXP_MONO_LE] THEN REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; GSYM RE_NEG; COMPLEX_NEG_SUB] THEN REWRITE_TAC[RE_SUB] THEN UNDISCH_TAC `&1 <= Re w` THEN REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `x = Re z` THEN DISJ_CASES_TAC(ARITH_RULE `x <= &1 \/ &1 <= x`) THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `exp(x * log(&n)) / x` THEN ASM_SIMP_TAC[lemma1'] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_ARITH `x <= a + x <=> &0 <= a`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_EXP_POS_LE; REAL_LE_INV_EQ; REAL_POS]; ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_1] THEN MATCH_MP_TAC(REAL_ARITH `b <= x * a /\ c <= x * d ==> c + b <= x * (a + d)`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_EXP_SUB; REAL_MUL_LID] THEN ASM_SIMP_TAC[real_div; REAL_MUL_LID; EXP_LOG; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> 1 <= n`; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `exp(x * log(&(n - 1) + &1)) / x` THEN CONJ_TAC THEN ASM_SIMP_TAC[lemma1] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= n ==> n - 1 + 1 = n`] THEN REWRITE_TAC[REAL_LE_REFL; real_div; REAL_MUL_LID]]);; let BOUND_LEMMA_4 = prove (`!a n m. (!m. 1 <= m ==> norm(a(m)) <= &1) /\ 1 <= n /\ &1 <= Re w /\ &0 < Re z ==> norm(vsum(n+1..m) (\n. a(n) / Cx(&n) cpow (w + z))) <= &1 / (Re z * exp(Re z * log(&n)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(n+1..m) (\n. &1 / exp((Re(z) + &1) * log(&n)))` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN SUBGOAL_THEN `0 < r /\ 1 <= r` STRIP_ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT] THEN REWRITE_TAC[real_div; GSYM REAL_EXP_NEG] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_EXP_POS_LE; REAL_EXP_MONO_LE] THEN REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; RE_NEG; COMPLEX_NEG_SUB] THEN REWRITE_TAC[RE_ADD; REAL_LE_NEG2] THEN UNDISCH_TAC `&1 <= Re w` THEN REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `x = Re z` THEN ASM_CASES_TAC `n + 1 <= m` THENL [ALL_TAC; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN SIMP_TAC[GSYM NUMSEG_EMPTY; SUM_CLAUSES] THEN DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_LE_MUL; REAL_EXP_POS_LE; REAL_LT_IMP_LE]] THEN MP_TAC(ISPECL [`\n. n cpow (--(Cx(x) + Cx(&1)))`; `\n. --(n cpow (--(Cx(x)))) / Cx(x)`; `n + 1`; `m:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN ANTS_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN REWRITE_TAC[RE_CX] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_RING `--x - Cx(&1) = --(x + Cx(&1))`] THEN SUBGOAL_THEN `~(Cx x = Cx(&0))` MP_TAC THENL [REWRITE_TAC[CX_INJ] THEN UNDISCH_TAC `&0 < x` THEN REAL_ARITH_TAC; CONV_TAC COMPLEX_FIELD]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < a /\ &0 < b` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC(REAL_ARITH `x * a <= x * b ==> --x * b <= --x * a`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ u <= v ==> x <= u ==> y <= v`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG] THEN SUBGOAL_THEN `&0 < &k` ASSUME_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX] THEN REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_EXP_NEG] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[CPOW_NEG] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `n + 1 <= m ==> 0 < m`)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 <= n ==> 0 < n`)) THEN ASM_SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX; REAL_OF_NUM_LT] THEN REWRITE_TAC[GSYM CX_INV; GSYM CX_SUB; RE_CX; GSYM CX_DIV; GSYM CX_NEG] THEN REWRITE_TAC[real_div; REAL_MUL_LNEG; REAL_SUB_NEG2; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC(REAL_ARITH `x = z /\ &0 <= y ==> x - y <= z`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_EXP_POS_LE]);; (* ------------------------------------------------------------------------- *) (* Our overall bound does go to zero as N increases. *) (* ------------------------------------------------------------------------- *) let OVERALL_BOUND_LEMMA = prove (`!d M R. &0 < d ==> !e. &0 < e ==> ?N. !n. N <= n ==> abs(&2 * pi / &n + &6 * M * R / (d * exp (d * log (&n))) + &4 * M / (R * log (&n)) pow 2) < e`, ONCE_REWRITE_TAC[REAL_ARITH `abs x = abs(x - &0)`] THEN REWRITE_TAC[GSYM REALLIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN REPEAT(MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC) THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_INV] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_N] THENL [MP_TAC(SPEC `Cx d` LIM_1_OVER_POWER) THEN ASM_REWRITE_TAC[RE_CX] THEN REWRITE_TAC[REALLIM_COMPLEX; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX; REAL_OF_NUM_LT; CX_INV; LE_1; complex_div; COMPLEX_MUL_LID]; MATCH_MP_TAC REALLIM_NULL_POW THEN REWRITE_TAC[REAL_INV_MUL; ARITH] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_LOG]]);; (* ------------------------------------------------------------------------- *) (* Newman/Ingham analytic lemma (as in Newman's book). *) (* ------------------------------------------------------------------------- *) let NEWMAN_INGHAM_THEOREM = prove (`!f a. (!n. 1 <= n ==> norm(a(n)) <= &1) /\ f analytic_on {z | Re(z) >= &1} /\ (!z. Re(z) > &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)) ==> !z. Re(z) >= &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)`, REWRITE_TAC[real_ge; analytic_on; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `&1 <= w ==> w > &1 \/ w = &1`)) THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ABBREV_TAC `R = max (&3 / e) (&1)` THEN SUBGOAL_THEN `&0 < R` ASSUME_TAC THENL [EXPAND_TAC "R" THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?d. &0 < d /\ d <= R /\ (\z. f(w + z)) holomorphic_on {z | Re(z) >= --d /\ abs(Im z) <= R}` (X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))) THENL [SUBGOAL_THEN `?d. &0 < d /\ (\z. f(w + z)) holomorphic_on {z | Re(z) >= --d /\ abs(Im z) <= R}` (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THENL [ALL_TAC; EXISTS_TAC `min d R` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `{z | Re(z) >= --d /\ abs(Im z) <= R}` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC] THEN ABBREV_TAC `g = \z. (f:complex->complex) (w + z)` THEN SUBGOAL_THEN `!z. &0 <= Re z ==> ?e. &0 < e /\ g holomorphic_on ball (z,e)` MP_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN UNDISCH_TAC `!z. &1 <= Re z ==> (?e. &0 < e /\ f holomorphic_on ball (z,e))` THEN DISCH_THEN(MP_TAC o SPEC `w + z:complex`) THEN ASM_SIMP_TAC[RE_ADD;REAL_ARITH `&0 <= z ==> &1 <= &1 + z`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "g" THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN UNDISCH_TAC `f holomorphic_on ball(w + z,d)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_BALL; IN_IMAGE] THEN REWRITE_TAC[COMPLEX_RING `x:complex = w + y <=> x - w = y`] THEN REWRITE_TAC[UNWIND_THM1] THEN NORM_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `bs:complex->real`) THEN MP_TAC(ISPECL [`complex(&0,--R)`; `complex(&0,R)`] COMPACT_INTERVAL) THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\z. {w | abs(Re(z - w)) < bs z / &2 /\ abs(Im(z - w)) < bs z / &2}) (interval[complex(&0,--R),complex(&0,R)])`) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[RE_SUB; IM_SUB; REAL_ARITH `abs(x - a) < e /\ abs(y - b) < e <=> a < x + e /\ a > x - e /\ b < y + e /\ b > y - e`] THEN SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REPEAT(MATCH_MP_TAC OPEN_INTER THEN STRIP_TAC) THEN REWRITE_TAC[OPEN_HALFSPACE_IM_GT; OPEN_HALFSPACE_IM_LT; OPEN_HALFSPACE_RE_GT; OPEN_HALFSPACE_RE_LT]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> x IN g x) ==> s SUBSET (UNIONS (IMAGE g s))`) THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; IN_ELIM_THM] THEN ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN ASM_MESON_TAC[REAL_HALF]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> c /\ b /\ a`] THEN REWRITE_TAC[FINITE_SUBSET_IMAGE; RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> d /\ a /\ b /\ c`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `t:complex->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inf (IMAGE (bs:complex->real) t) / &2` THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s SUBSET UNIONS (IMAGE g t) ==> ~(s = {}) ==> ~(t = {})`)) THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `complex(&0,&0)` THEN REWRITE_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC; DISCH_TAC] THEN REWRITE_TAC[REAL_HALF] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t SUBSET s ==> (!x. x IN s ==> P x) ==> (!x. x IN t ==> P x)`)) THEN REWRITE_TAC[IN_INTERVAL; FORALL_2; GSYM RE_DEF; DIMINDEX_2] THEN REWRITE_TAC[RE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN ASM_CASES_TAC `&0 <= Re z` THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable; OPEN_BALL; CENTRE_IN_BALL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `complex(&0,Im z)` o MATCH_MP (SET_RULE `i SUBSET UNIONS s ==> !x. x IN i ==> x IN UNIONS s`)) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN UNDISCH_TAC `abs(Im z) <= R` THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `v:complex` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `Re v = &0` ASSUME_TAC THENL [UNDISCH_TAC `(v:complex) IN t` THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t SUBSET s ==> (x IN s ==> P x) ==> (x IN t ==> P x)`)) THEN REWRITE_TAC[IN_INTERVAL; FORALL_2; GSYM RE_DEF; DIMINDEX_2] THEN REWRITE_TAC[RE] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[IN_ELIM_THM; RE_SUB; IM_SUB; RE; IM] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN UNDISCH_TAC `!z. &0 <= Re z ==> &0 < bs z /\ g holomorphic_on ball (z,bs z)` THEN DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; GSYM complex_differentiable] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL] THEN REWRITE_TAC[dist; complex_norm] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x < abs e ==> x < e`) THEN ASM_REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LT THEN MATCH_MP_TAC(REAL_ARITH `&0 < b * b /\ x <= (b / &2) pow 2 /\ y <= (b / &2) pow 2 ==> x + y < b pow 2`) THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_LE_SQUARE_ABS] THEN ASM_SIMP_TAC[IM_SUB; REAL_ARITH `&0 < b ==> abs(b / &2) = b / &2`] THEN ASM_SIMP_TAC[RE_SUB; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `--(x / &2) <= z ==> &2 * --z <= x`)) THEN ASM_SIMP_TAC[REAL_LE_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(&0 <= Re z)` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?M. &0 < M /\ !z. Re z >= --d /\ abs (Im z) <= R /\ Re(z) <= R ==> norm(f(w + z):complex) <= M` (X_CHOOSE_THEN `M:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2a"))) THENL [MP_TAC(ISPEC `IMAGE (\z. f (w + z):complex) {z | Re z >= --d /\ abs (Im z) <= R /\ Re(z) <= R}` COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] CONTINUOUS_ON_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(Cx(&0),&2 * R + d)` THEN REWRITE_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL; dist] THEN REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; IN_ELIM_THM] THEN MP_TAC COMPLEX_NORM_LE_RE_IM THEN MATCH_MP_TAC MONO_FORALL THEN UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_ARITH `x <= Im z <=> Im z >= x`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REPEAT(MATCH_MP_TAC CLOSED_INTER THEN CONJ_TAC) THEN REWRITE_TAC[CLOSED_HALFSPACE_RE_LE; CLOSED_HALFSPACE_IM_LE; CLOSED_HALFSPACE_RE_GE; CLOSED_HALFSPACE_IM_GE]; ALL_TAC] THEN MP_TAC(SPECL [`d:real`; `M:real`; `R:real`] OVERALL_BOUND_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `&2 / &3 * e * pi`) THEN ASM_SIMP_TAC[REAL_LT_MUL; PI_POS; REAL_ARITH `&0 < &2 / &3`] THEN DISCH_THEN(X_CHOOSE_THEN `N0:num` (LABEL_TAC "X")) THEN EXISTS_TAC `N0 + 2` THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN REMOVE_THEN "X" (MP_TAC o SPEC `N:num`) THEN ASM_SIMP_TAC[ARITH_RULE `N0 + 2 <= N ==> N0 <= N`] THEN DISCH_TAC THEN SUBGOAL_THEN `~(N = 0) /\ 1 < N` STRIP_ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FROM_INTER_NUMSEG] THEN ABBREV_TAC `S_N(w) = vsum(1..N) (\n. a(n) / Cx(&n) cpow w)` THEN REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ABBREV_TAC `r_N(w) = (f:complex->complex)(w) - S_N(w)` THEN ABBREV_TAC `A = partcirclepath(Cx(&0),R,--(pi / &2),pi / &2)` THEN SUBGOAL_THEN `valid_path A /\ pathstart A = complex(&0,--R) /\ pathfinish A = complex(&0,R) /\ &0 < Re(winding_number(A,Cx(&0)))` STRIP_ASSUME_TAC THENL [EXPAND_TAC "A" THEN REWRITE_TAC[VALID_PATH_PARTCIRCLEPATH] THEN REWRITE_TAC[PATHSTART_PARTCIRCLEPATH; PATHFINISH_PARTCIRCLEPATH] THEN REWRITE_TAC[CEXP_EULER; SIN_NEG; COS_NEG; SIN_PI2; COS_PI2; GSYM CX_SIN; GSYM CX_COS] THEN REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_EQ; RE_MUL_CX; RE_II; IM_II; IM_MUL_CX; RE; IM] THEN REPEAT(CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC WINDING_NUMBER_PARTCIRCLEPATH_POS_LT THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_REFL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `path_image A SUBSET {z | Re(z) >= &0 /\ norm(z) = R}` ASSUME_TAC THENL [EXPAND_TAC "A" THEN ASM_SIMP_TAC[PATH_IMAGE_PARTCIRCLEPATH; REAL_LT_IMP_LE; PI_POS; REAL_ARITH `--p < p <=> &0 < p`; REAL_HALF] THEN REWRITE_TAC[SUBSET; COMPLEX_ADD_LID; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[RE_MUL_CX; RE_CEXP] THEN REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; COMPLEX_NORM_CX; RE_MUL_II] THEN REWRITE_TAC[IM_CX; REAL_NEG_0; REAL_EXP_0; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`; real_ge] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN REWRITE_TAC[IM_MUL_II; RE_CX] THEN ASM_SIMP_TAC[COS_POS_PI_LE]; ALL_TAC] THEN SUBGOAL_THEN `~(Cx(&0) IN path_image A)` ASSUME_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`)) THEN REWRITE_TAC[IN_ELIM_THM; COMPLEX_NORM_0] THEN UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `B = linepath(complex(&0,R),complex(--d,R)) ++ linepath(complex(--d,R),complex(--d,--R)) ++ linepath(complex(--d,--R),complex(&0,--R))` THEN SUBGOAL_THEN `valid_path B /\ ~(Cx(&0) IN path_image B) /\ &0 < Re(winding_number(B,Cx(&0)))` STRIP_ASSUME_TAC THENL [EXPAND_TAC "B" THEN REPEAT(MATCH_MP_TAC WINDING_NUMBER_JOIN_POS_COMBINED THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN CONJ_TAC) THEN (REWRITE_TAC[VALID_PATH_LINEPATH] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC WINDING_NUMBER_LINEPATH_POS_LT THEN REWRITE_TAC[complex_mul; RE; IM; RE_SUB; RE_CNJ; IM_SUB; IM_CNJ; RE_CX; IM_CX] THEN CONV_TAC(RAND_CONV REAL_POLY_CONV) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH]]) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; segment; IN_ELIM_THM] THEN REWRITE_TAC[COMPLEX_EQ; RE_CMUL; RE_ADD; RE_CX; RE; IM_CMUL; IM_ADD; IM_CX; IM] THEN REWRITE_TAC[REAL_ARITH `&0 = (&1 - u) * x + u * x <=> x = &0`] THEN ASM_SIMP_TAC[REAL_NEG_EQ_0; REAL_LT_IMP_NZ]; ALL_TAC] THEN SUBGOAL_THEN `pathstart B = complex(&0,R) /\ pathfinish B = complex(&0,--R)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "B" THEN SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH]; ALL_TAC] THEN SUBGOAL_THEN `path_image B SUBSET {z | --d <= Re z /\ Re(z) <= &0 /\ abs(Im z) <= R}` ASSUME_TAC THENL [SUBGOAL_THEN `convex {z | --d <= Re z /\ Re z <= &0 /\ abs (Im z) <= R}` ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_BOUNDS_LE; SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REPEAT(MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC) THEN REWRITE_TAC[REWRITE_RULE[real_ge] CONVEX_HALFSPACE_RE_GE; REWRITE_RULE[real_ge] CONVEX_HALFSPACE_IM_GE; CONVEX_HALFSPACE_RE_LE; CONVEX_HALFSPACE_IM_LE]; ALL_TAC] THEN EXPAND_TAC "B" THEN REPEAT(MATCH_MP_TAC(SET_RULE `path_image(p1 ++ p2) SUBSET path_image p1 UNION path_image p2 /\ path_image p1 SUBSET s /\ path_image p2 SUBSET s ==> path_image(p1 ++ p2) SUBSET s`) THEN REWRITE_TAC[PATH_IMAGE_JOIN_SUBSET] THEN CONJ_TAC) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[RE; IM] THEN MAP_EVERY UNDISCH_TAC [`&0 < d`; `&0 < R`] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `valid_path(A ++ B) /\ pathstart(A ++ B) = complex(&0,--R) /\ pathfinish(A ++ B) = complex(&0,--R) /\ ~(Cx(&0) IN path_image(A ++ B))` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; IN_UNION; VALID_PATH_IMP_PATH]; ALL_TAC] THEN SUBGOAL_THEN `winding_number(A++B,Cx(&0)) = Cx(&1)` ASSUME_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_EQ_1 THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH; PATH_IMAGE_JOIN; IN_UNION; WINDING_NUMBER_JOIN; REAL_LT_ADD; RE_ADD] THEN MATCH_MP_TAC(REAL_ARITH `x < &1 /\ y < &1 ==> x + y < &2`) THEN CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_1 THENL [EXISTS_TAC `--Cx(&1)`; EXISTS_TAC `Cx(&1)`] THEN ASM_SIMP_TAC[] THEN (CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC]) THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`)) THEN REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_SUB_RZERO; IN_ELIM_THM] THEN REWRITE_TAC[COMPLEX_MUL_RNEG; GSYM CX_MUL; RE_CX; IM_CX; RE_NEG] THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `((\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx(R) pow 2)) has_path_integral (Cx(&2) * Cx pi * ii * f(w))) (A ++ B)` ASSUME_TAC THENL [MP_TAC(ISPECL [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) + z pow 2 / Cx(R) pow 2)`; `{z | Re(z) >= --d /\ abs(Im z) <= R}`; `A ++ B:real^1->complex`; `Cx(&0)`] CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN ASM_REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_LID; CPOW_N] THEN ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; complex_pow] THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) + Cx(&0) pow 2 * z = Cx(&1)`] THEN REWRITE_TAC[COMPLEX_MUL_RID] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN UNDISCH_TAC `~(z = Cx(&0))` THEN REWRITE_TAC[] THEN ABBREV_TAC `wever = inv(Cx R pow 2)` THEN CONV_TAC COMPLEX_FIELD] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `abs(x) <= a <=> x >= --a /\ x <= a`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[CONVEX_HALFSPACE_RE_GE] THEN MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[CONVEX_HALFSPACE_IM_GE; CONVEX_HALFSPACE_IM_LE]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ADD] THEN REWRITE_TAC[holomorphic_on] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXISTS_TAC `clog(Cx(&N)) * Cx(&N) cpow z` THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT THEN ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `min d R:real` THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN REWRITE_TAC[SUBSET; IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(n1) <= n /\ abs(n2) <= n ==> n < min d R ==> n1 >= --d /\ abs n2 <= R`) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM]; ALL_TAC] THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; VALID_PATH_IMP_PATH; UNION_SUBSET] THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `~(x IN s) /\ s SUBSET t ==> s SUBSET (t DELETE x)`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THENL [ALL_TAC; REAL_ARITH_TAC] THEN MP_TAC COMPLEX_NORM_GE_RE_IM THEN MATCH_MP_TAC MONO_FORALL THEN UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE) THEN ASM_SIMP_TAC[PATH_INTEGRABLE_JOIN; IMP_CONJ] THEN REWRITE_TAC[path_integrable_on] THEN DISCH_THEN(X_CHOOSE_THEN `integral_fA:complex` (LABEL_TAC "fA")) THEN DISCH_THEN(X_CHOOSE_THEN `integral_fB:complex` (LABEL_TAC "fB")) THEN SUBGOAL_THEN `integral_fA + integral_fB = Cx(&2) * Cx pi * ii * f(w:complex)` ASSUME_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; `A ++ B:real^1->complex`] THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_JOIN]; ALL_TAC] THEN ABBREV_TAC `A' = (--) o (A:real^1->complex)` THEN SUBGOAL_THEN `valid_path A' /\ pathstart A' = complex(&0,R) /\ pathfinish A' = complex(&0,--R) /\ ~(Cx(&0) IN path_image A') /\ &0 < Re(winding_number(A',Cx(&0)))` STRIP_ASSUME_TAC THENL [EXPAND_TAC "A'" THEN ASM_SIMP_TAC[VALID_PATH_NEGATEPATH; PATHSTART_NEGATEPATH; PATHFINISH_NEGATEPATH; WINDING_NUMBER_NEGATEPATH; PATH_IMAGE_NEGATEPATH] THEN REWRITE_TAC[IN_IMAGE; COMPLEX_RING `Cx(&0) = --x <=> x = Cx(&0)`] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[COMPLEX_EQ; RE_NEG; IM_NEG; RE; IM; REAL_NEG_0; REAL_NEGNEG]; ALL_TAC] THEN SUBGOAL_THEN `valid_path(A ++ A') /\ pathstart(A ++ A') = complex(&0,--R) /\ pathfinish(A ++ A') = complex(&0,--R) /\ ~(Cx(&0) IN path_image(A ++ A')) /\ path_image(A ++ A') = path_image A UNION path_image A'` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; IN_UNION; PATH_IMAGE_JOIN; VALID_PATH_IMP_PATH]; ALL_TAC] THEN SUBGOAL_THEN `path_image A' SUBSET {z | Re z <= &0 /\ norm z = R}` ASSUME_TAC THENL [EXPAND_TAC "A'" THEN REWRITE_TAC[path_image; IMAGE_o; SUBSET] THEN ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[GSYM path_image] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN REWRITE_TAC[IN_ELIM_THM; RE_NEG; NORM_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `winding_number(A++A',Cx(&0)) = Cx(&1)` ASSUME_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_EQ_1 THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH; IN_UNION; VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; WINDING_NUMBER_JOIN; REAL_LT_ADD; RE_ADD] THEN MATCH_MP_TAC(REAL_ARITH `x < &1 /\ y < &1 ==> x + y < &2`) THEN CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_1 THENL [EXISTS_TAC `--Cx(&1)`; EXISTS_TAC `Cx(&1)`] THEN ASM_SIMP_TAC[] THEN (CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC]) THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`)) THEN REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_SUB_RZERO; IN_ELIM_THM] THEN REWRITE_TAC[COMPLEX_MUL_RNEG; GSYM CX_MUL; RE_CX; IM_CX; RE_NEG] THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(\z. S_N (w + z) * Cx (&N) cpow z * (Cx (&1) + z pow 2 * inv (Cx R pow 2))) holomorphic_on (:complex)` ASSUME_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL [REWRITE_TAC[GSYM(ASSUME `!w. vsum (1..N) (\n. a n / Cx (&n) cpow w) = S_N w`)] THEN MATCH_MP_TAC HOLOMORPHIC_ON_VSUM THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV; MATCH_MP_TAC HOLOMORPHIC_ON_MUL] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_CPOW_RIGHT; HOLOMORPHIC_ON_ID; CPOW_EQ_0; HOLOMORPHIC_ON_CONST; REAL_OF_NUM_EQ; HOLOMORPHIC_ON_MUL; ARITH_RULE `~(n = 0) <=> 1 <= n`; HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_POW; CX_INJ]; ALL_TAC] THEN SUBGOAL_THEN `((\z. S_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx(R) pow 2)) has_path_integral (Cx(&2) * Cx pi * ii * S_N(w))) (A ++ A')` MP_TAC THENL [MP_TAC(ISPECL [`\z. S_N(w + z) * Cx(&N) cpow z * (Cx(&1) + z pow 2 / Cx(R) pow 2)`; `cball(Cx(&0),R)`; `A ++ A':real^1->complex`; `Cx(&0)`] CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN ASM_REWRITE_TAC[CONVEX_CBALL; INTERIOR_CBALL; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_LID; CPOW_N] THEN ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; complex_pow] THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) + Cx(&0) pow 2 * z = Cx(&1)`] THEN REWRITE_TAC[COMPLEX_MUL_RID] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN UNDISCH_TAC `~(z = Cx(&0))` THEN REWRITE_TAC[] THEN ABBREV_TAC `wever = inv(Cx R pow 2)` THEN CONV_TAC COMPLEX_FIELD] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN ASM_REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `~(x IN s) /\ s SUBSET t ==> s SUBSET (t DELETE x)`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE) THEN ASM_SIMP_TAC[PATH_INTEGRABLE_JOIN; IMP_CONJ] THEN REWRITE_TAC[path_integrable_on] THEN DISCH_THEN(X_CHOOSE_THEN `integral_sA:complex` (LABEL_TAC "sA")) THEN DISCH_THEN(X_CHOOSE_THEN `integral_sA':complex` (LABEL_TAC "sA'")) THEN SUBGOAL_THEN `integral_sA + integral_sA' = Cx(&2) * Cx pi * ii * S_N(w:complex)` ASSUME_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC [`\z. S_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; `A ++ A':real^1->complex`] THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_JOIN]; ALL_TAC] THEN SUBGOAL_THEN `((\z. S_N(w - z) * Cx (&N) cpow (--z) * (Cx (&1) / z + z / Cx R pow 2)) has_path_integral integral_sA') A` (LABEL_TAC "s'A") THENL [SUBGOAL_THEN `(A:real^1->complex) = (--) o (--) o A` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_DEF; COMPLEX_NEG_NEG]; ALL_TAC] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_NEGATEPATH THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM COMPLEX_NEG_NEG] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_NEG THEN REMOVE_THEN "sA'" MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; COMPLEX_SUB_RNEG; COMPLEX_NEG_NEG] THEN REWRITE_TAC[complex_div; COMPLEX_INV_NEG; COMPLEX_MUL_LID] THEN REWRITE_TAC[GSYM COMPLEX_NEG_ADD; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[COMPLEX_NEG_NEG]; ALL_TAC] THEN SUBGOAL_THEN `(\z. r_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx(R) pow 2)) path_integrable_on A` MP_TAC THENL [REWRITE_TAC[GSYM(ASSUME `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN REWRITE_TAC[COMPLEX_SUB_RDISTRIB] THEN MATCH_MP_TAC PATH_INTEGRABLE_SUB THEN REWRITE_TAC[path_integrable_on] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `integral_rA:complex` THEN DISCH_THEN(LABEL_TAC "rA") THEN SUBGOAL_THEN `integral_fA - integral_sA:complex = integral_rA` ASSUME_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC [`\z. r_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; `A:real^1->complex`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM(ASSUME `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN REWRITE_TAC[COMPLEX_SUB_RDISTRIB] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `r_N(w:complex) = ((integral_rA - integral_sA') + integral_fB) / (Cx(&2) * Cx(pi) * ii)` SUBST1_TAC THENL [SIMP_TAC[COMPLEX_FIELD `~(z = Cx(&0)) ==> (x = y / z <=> z * x = y)`; CX_2PII_NZ] THEN REWRITE_TAC[GSYM(ASSUME `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB; GSYM COMPLEX_MUL_ASSOC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_eq o concl))) THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II; REAL_MUL_RID; REAL_ABS_PI; REAL_ABS_NUM] THEN SIMP_TAC[REAL_LT_LDIV_EQ; PI_POS; REAL_ARITH `&0 < &2 * p <=> &0 < p`] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&4 * pi / R + &2 * pi / &N + &6 * M * R / (d * exp(d * log(&N))) + &4 * M / (R * log(&N)) pow 2` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `&4 * pi / R <= &4 * pi * (e / &3) /\ y < &2 / &3 * e * pi ==> &4 * pi / R + y < e * &2 * pi`) THEN ASM_SIMP_TAC[REAL_ARITH `abs x < e ==> x < e`] THEN SIMP_TAC[real_div; REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; PI_POS] THEN REWRITE_TAC[GSYM real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN EXPAND_TAC "R" THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(x) <= &2 * a /\ norm(y) <= &2 * a + b /\ norm(z) <= c ==> norm(x - y + z) <= &4 * a + b + c`) THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPECL [`\z. r_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; `integral_rA:complex`; `Cx(&0)`; `R:real`; `--(pi / &2)`; `pi / &2`; `&2 / R pow 2`; `{complex(&0,R),complex(&0,--R)}`] HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG) THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `p / &2 - --(p / &2) = p`; PI_POS_LE; REAL_ARITH `--(p / &2) <= (p / &2) <=> &0 <= p`] THEN ASM_SIMP_TAC[REAL_FIELD `~(r = &0) ==> &2 / r pow 2 * r * x = &2 * x / r`; REAL_LT_IMP_NZ] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `norm(z) = R /\ &0 < Re z` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `path_image A SUBSET {z | Re z >= &0 /\ norm z = R}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; real_ge] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_SIMP_TAC[REAL_LT_LE] THEN REWRITE_TAC[NORM_EQ_SQUARE; DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[REAL_RING `&0 pow 2 + x pow 2 = y pow 2 <=> x = y \/ x = --y`] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN UNDISCH_TAC `~(z = complex(&0,--R))` THEN UNDISCH_TAC `~(z = complex(&0,R))` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / (Re z * exp(Re z * log(&N))) * exp(Re z * log(&N)) * (&2 * abs(Re z) / R pow 2)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_ARITH `&0 < z ==> abs z = z`] THEN ASM_SIMP_TAC[REAL_EXP_NZ; REAL_LE_REFL; REAL_FIELD `&0 < z /\ ~(e = &0) ==> &1 / (z * e) * e * &2 * z / R pow 2 = &2 / R pow 2`]] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LE_REFL; NORM_CPOW_REAL; BOUND_LEMMA_1; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ]] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. vsum(1..n) (\n. a n / Cx (&n) cpow (w + z)) - S_N(w + z)` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM(ASSUME `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN MP_TAC(SPEC `w + z:complex` (ASSUME `!z. Re z > &1 ==> ((\n. a n / Cx(&n) cpow z) sums f z) (from 1)`)) THEN SIMP_TAC[RE_ADD; REAL_ARITH `&0 < z ==> &1 + z > &1`; ASSUME `Re w = &1`; ASSUME `&0 < Re z`] THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG]; ALL_TAC] THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM(ASSUME `!w. vsum (1..N) (\n. a n / Cx (&n) cpow w) = S_N w`)] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum(N+1..n) (\n. a n / Cx(&n) cpow (w + z)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC BOUND_LEMMA_4 THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= N <=> ~(N = 0)`]] THEN MATCH_MP_TAC(NORM_ARITH `y + z = x ==> norm(x - y) <= norm(z)`) THEN MP_TAC(SPECL [`1`; `N:num`; `n:num`] NUMSEG_COMBINE_R) THEN ANTS_TAC THENL [MAP_EVERY UNDISCH_TAC [`~(N = 0)`; `N + 1 <= n`] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_UNION THEN REWRITE_TAC[FINITE_NUMSEG; DISJOINT_NUMSEG] THEN ARITH_TAC; MP_TAC(ISPECL [`\z. S_N(w - z) * Cx(&N) cpow (--z) * (Cx(&1) / z + z / Cx R pow 2)`; `integral_sA':complex`; `Cx(&0)`; `R:real`; `--(pi / &2)`; `pi / &2`; `&2 / R pow 2 + &2 / (&N * R)`; `{complex(&0,R),complex(&0,--R)}`] HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG) THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `&0 < R /\ ~(N = &0) ==> (&2 / R pow 2 + &2 / (N * R)) * R * (p / &2 - --(p / &2)) = &2 * p / R + &2 * p / N`] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_DIV; REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_SIMP_TAC[PI_POS; REAL_ARITH `&0 < x ==> --(x / &2) <= x / &2`] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `norm(z) = R /\ &0 < Re z` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `path_image A SUBSET {z | Re z >= &0 /\ norm z = R}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; real_ge] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_SIMP_TAC[REAL_LT_LE] THEN REWRITE_TAC[NORM_EQ_SQUARE; DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[REAL_RING `&0 pow 2 + x pow 2 = y pow 2 <=> x = y \/ x = --y`] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN UNDISCH_TAC `~(z = complex(&0,--R))` THEN UNDISCH_TAC `~(z = complex(&0,R))` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(exp (Re z * log (&N)) * (&1 / &N + &1 / Re z)) * inv(exp(Re z * log(&N))) * (&2 * abs(Re z) / R pow 2)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_ARITH `&0 < z ==> abs z = z`] THEN ASM_SIMP_TAC[REAL_EXP_NZ; REAL_FIELD `~(e = &0) ==> (e * x) * inv(e) * y = x * y`] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < x ==> (n + &1 / x) * &2 * x / y = &2 / y + &2 * x * n / y`] THEN REWRITE_TAC[REAL_LE_LADD] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; LT_NZ; REAL_FIELD `&0 < n /\ &0 < r ==> (&2 * z * &1 / n / r pow 2) * n * r = &2 * z / r`] THEN MATCH_MP_TAC(REAL_ARITH `x <= &1 ==> &2 * x <= &2`) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM(ASSUME `!w. vsum (1..N) (\n. a n / Cx (&n) cpow w) = S_N w`)] THEN MATCH_MP_TAC BOUND_LEMMA_3 THEN ASM_REWRITE_TAC[REAL_LE_REFL; ARITH_RULE `1 <= N <=> ~(N = 0)`]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LE_REFL; NORM_CPOW_REAL; BOUND_LEMMA_1; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN REWRITE_TAC[RE_NEG; REAL_MUL_LNEG; REAL_EXP_NEG; REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `(\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)) path_integrable_on B` MP_TAC THENL [ASM_MESON_TAC[path_integrable_on]; ALL_TAC] THEN EXPAND_TAC "B" THEN SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; VALID_PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[path_integrable_on; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `integral_fC:complex` THEN DISCH_TAC THEN X_GEN_TAC `integral_fD:complex` THEN DISCH_TAC THEN X_GEN_TAC `integral_fC':complex` THEN DISCH_TAC THEN SUBGOAL_THEN `integral_fB:complex = integral_fC + integral_fD + integral_fC'` SUBST1_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; `B:real^1->complex`] THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "B" THEN REPEAT(MATCH_MP_TAC HAS_PATH_INTEGRAL_JOIN THEN ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH; PATHFINISH_JOIN; VALID_PATH_LINEPATH; PATHSTART_LINEPATH]); ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(y) <= a /\ norm(x) <= &2 * b /\ norm(z) <= &2 * b ==> norm(x + y + z) <= a + &4 * b`) THEN CONJ_TAC THENL [MP_TAC(SPECL [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; `integral_fD:complex`; `complex (--d,R)`; `complex (--d,--R)`; `M * inv(exp(d * log(&N))) * &3 / d`] HAS_PATH_INTEGRAL_BOUND_LINEPATH) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; SUBGOAL_THEN `complex (--d,--R) - complex (--d,R) = Cx(&2) * ii * Cx(--R)` SUBST1_TAC THENL [REWRITE_TAC[COMPLEX_EQ; RE_SUB; IM_SUB; RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX; RE_MUL_II; IM_MUL_II; RE; IM] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a = b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < R ==> abs(--R) = R`; REAL_ABS_NUM] THEN CONV_TAC REAL_FIELD] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_EXP_POS_LE; REAL_LE_DIV; REAL_POS]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `Re z = --d` ASSUME_TAC THENL [UNDISCH_TAC `z IN segment[complex(--d,R),complex(--d,--R)]` THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[RE_CMUL; RE_ADD; RE] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `segment[complex(--d,R),complex(--d,--R)] SUBSET {z | abs(Im z) <= R}` MP_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[REAL_ARITH `abs(x) <= r <=> x >= --r /\ x <= r`] THEN SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`; CONVEX_INTER; CONVEX_HALFSPACE_IM_LE; CONVEX_HALFSPACE_IM_GE] THEN REWRITE_TAC[SET_RULE `{a,b} SUBSET s <=> a IN s /\ b IN s`] THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER; IM] THEN UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[real_ge; REAL_LE_REFL] THEN MAP_EVERY UNDISCH_TAC [`&0 < R`; `&0 < d`] THEN REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [ASM_SIMP_TAC[CPOW_REAL_REAL; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_EXP_NEG; REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `Re z = --d` THEN ASM_REWRITE_TAC[RE_CX] THEN UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD `~(z = Cx(&0)) /\ ~(R = Cx(&0)) ==> Cx(&1) / z + z / R pow 2 = (Cx(&1) + (z / R) pow 2) * inv(z)`] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `norm(i) = &1 /\ norm(z) <= &2 ==> norm(i + z) <= &3`) THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_POW; REAL_ABS_NUM] THEN REWRITE_TAC[COMPLEX_NORM_DIV; REAL_POW_DIV] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ; REAL_POW_LT; CX_INJ; REAL_LT_IMP_NZ] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_POW2_ABS] THEN ASM_REWRITE_TAC[COMPLEX_SQNORM] THEN MATCH_MP_TAC(REAL_ARITH `d pow 2 <= R pow 2 /\ i pow 2 <= R pow 2 ==> --d pow 2 + i pow 2 <= &2 * R pow 2`) THEN ONCE_REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN MAP_EVERY UNDISCH_TAC [`&0 < d`; `&0 < R`; `d <= R`; `abs(Im z) <= R`] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(Re z)` THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\z. --(inv(clog(Cx(&N)) pow 2)) * (Cx(&1) + z * clog(Cx(&N))) * Cx(&N) cpow (--z)`; `\z. z * Cx(&N) cpow (--z)`; `linepath(Cx(&0),Cx(d))`; `(:complex)`] PATH_INTEGRAL_PRIMITIVE) THEN REWRITE_TAC[VALID_PATH_LINEPATH; SUBSET_UNIV; IN_UNIV] THEN ANTS_TAC THENL [X_GEN_TAC `z:complex` THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_ADD_LID; COMPLEX_MUL_LNEG] THEN ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ] THEN SUBGOAL_THEN `~(clog(Cx(&N)) = Cx(&0))` MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ; CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC LOG_POS_LT THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT]; ALL_TAC] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[COMPLEX_NEG_0; COMPLEX_MUL_LID; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN REWRITE_TAC[COMPLEX_RING `--x * y - --x * z:complex = x * (z - y)`] THEN ASM_REWRITE_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; complex_pow] THEN ASM_SIMP_TAC[CPOW_NEG; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ; GSYM CX_LOG; GSYM CX_MUL; GSYM CX_INV; GSYM CX_ADD; GSYM CX_SUB; GSYM CX_POW] THEN REWRITE_TAC[REAL_ARITH `&1 - (&1 + d) = --d`] THEN ABBREV_TAC `integral_bound = inv(log(&N) pow 2) * (&1 - (&1 + d * log(&N)) * inv(exp(d * log (&N))))` THEN SUBGOAL_THEN `&0 <= integral_bound /\ integral_bound <= inv(log(&N) pow 2)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "integral_bound" THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_DIV2_EQ; REAL_LE_RDIV_EQ; REAL_POW_LT; LOG_POS_LT; REAL_OF_NUM_LT] THEN REWRITE_TAC[REAL_ARITH `&0 * x <= &1 - y /\ &1 - y <= &1 <=> &0 <= y /\ y <= &1`] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_EXP_POS_LT] THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_POS]; REWRITE_TAC[REAL_EXP_LE_X]] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; LOG_POS_LT; REAL_OF_NUM_LT]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&2) * Cx(M) / Cx(R) pow 2`) THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [UNDISCH_TAC `((\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)) has_path_integral integral_fC) (linepath (complex (&0,R),complex (--d,R)))`; UNDISCH_TAC `((\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)) has_path_integral integral_fC') (linepath (complex(--d,--R),complex(&0,--R)))`] THEN REWRITE_TAC[HAS_PATH_INTEGRAL; VECTOR_DERIVATIVE_LINEPATH_AT] THENL [ALL_TAC; DISCH_THEN(MP_TAC o C CONJ (ARITH_RULE `~(-- &1 = &0)`)) THEN DISCH_THEN(MP_TAC o SPEC `vec 1:real^1` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LNEG; VECTOR_NEG_0; VECTOR_ADD_LID; VECTOR_NEG_NEG; REAL_POW_ONE; REAL_INV_1] THEN REWRITE_TAC[VECTOR_ARITH `--x + y:real^1 = y - x`; VECTOR_SUB_REFL]] THEN (SUBGOAL_THEN `(!x. linepath(complex (&0,R),complex (--d,R)) x = ii * Cx(R) - Cx(d * drop x)) /\ (!x. linepath(Cx (&0),Cx d) x = Cx(d * drop x)) /\ (complex(--d,R) - complex(&0,R) = --Cx(d)) /\ (!x. linepath(complex (--d,--R),complex(&0,--R)) (vec 1 - x) = --ii * Cx(R) - Cx(d * drop x)) /\ (complex(&0,--R) - complex(--d,--R) = Cx(d))` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[linepath; COMPLEX_EQ; IM_CMUL; RE_CMUL; IM; RE; RE_SUB; IM_SUB; IM_ADD; RE_ADD; RE_MUL_II; IM_MUL_II; RE_MUL_CX; RE_II; IM_II; IM_MUL_CX; IM_CX; RE_CX; RE_NEG; IM_NEG; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[TAUT `a /\ b /\ c /\ d /\ e ==> f <=> c /\ d ==> a /\ b /\ e ==> f`] HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT)) THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[GSYM RE_DEF] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_MUL; GSYM CX_DIV; RE_CX] THEN REWRITE_TAC[real_div; GSYM REAL_POW_INV; REAL_POW_MUL; REAL_INV_MUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= (M * R) * (b - i) ==> (&2 * M * R) * i <= &2 * M * R * b`) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_MUL; REAL_POW_LE; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[REAL_POW_INV]] THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; CPOW_REAL_REAL; LT_NZ] THEN REWRITE_TAC[RE_MUL_II; RE_NEG; RE_II; RE_MUL_CX; RE_SUB; RE_CX; IM_CX] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_NEG_0; COMPLEX_SUB_RZERO; REAL_ARITH `&0 - d * x = --(d * x)`] THEN GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [GSYM CX_MUL; GSYM CX_INV; GSYM CX_POW; GSYM CX_DIV; RE_CX] THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> abs d = d`; REAL_LE_RMUL_EQ; REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_MUL_LNEG] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_EXP_POS_LT] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `&2 * M * r * d * x = M * (&2 * (d * x) * r)`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE; GSYM real_div] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[RE_MUL_II; IM_MUL_II; RE_SUB; IM_SUB; RE_CX; IM_CX; COMPLEX_MUL_LNEG; RE_NEG; IM_NEG] THEN SUBGOAL_THEN `&0 <= d * x /\ d * x <= d * &1` MP_TAC THENL [ALL_TAC; MAP_EVERY UNDISCH_TAC [`&0 < d`; `d <= R`] THEN REAL_ARITH_TAC] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LE_LMUL_EQ]; ALL_TAC] THEN MATCH_MP_TAC BOUND_LEMMA_2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_MUL] THEN REWRITE_TAC[RE_MUL_II; IM_MUL_II; RE_SUB; IM_SUB; RE_CX; IM_CX; COMPLEX_MUL_LNEG; RE_NEG; IM_NEG] THEN UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC));; (* ------------------------------------------------------------------------- *) (* The application is to any bounded a_n, not |a_n| <= 1, so... *) (* ------------------------------------------------------------------------- *) let NEWMAN_INGHAM_THEOREM_BOUND = prove (`!f a b. &0 < b /\ (!n. 1 <= n ==> norm(a(n)) <= b) /\ f analytic_on {z | Re(z) >= &1} /\ (!z. Re(z) > &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)) ==> !z. Re(z) >= &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\z:complex. inv(Cx(b)) * f z`; `\n:num. inv(Cx(b)) * a n`] NEWMAN_INGHAM_THEOREM) THEN ASM_SIMP_TAC[ANALYTIC_ON_MUL; ANALYTIC_ON_CONST] THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[SERIES_COMPLEX_LMUL] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_INV] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ARITH `&0 < b ==> abs b = b`; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:complex` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `Cx b` o MATCH_MP SERIES_COMPLEX_LMUL) THEN ASM_SIMP_TAC[complex_div; COMPLEX_MUL_ASSOC; COMPLEX_MUL_RINV; CX_INJ; REAL_LT_IMP_NZ; COMPLEX_MUL_LID]);; let NEWMAN_INGHAM_THEOREM_STRONG = prove (`!f a b. (!n. 1 <= n ==> norm(a(n)) <= b) /\ f analytic_on {z | Re(z) >= &1} /\ (!z. Re(z) > &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)) ==> !z. Re(z) >= &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC NEWMAN_INGHAM_THEOREM_BOUND THEN EXISTS_TAC `abs b + &1` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[REAL_ARITH `x <= b ==> x <= abs b + &1`]);; (* ------------------------------------------------------------------------- *) (* Newman's analytic function "f", re-using our "nearzeta" stuff. *) (* ------------------------------------------------------------------------- *) let GENZETA_BOUND_LEMMA = prove (`!n s m. ~(n = 0) /\ &1 < Re s /\ n + 1 <= m ==> sum(n..m) (\x. norm(Cx(&1) / Cx(&x) cpow s)) <= (&1 / &n + &1 / (Re s - &1)) * exp((&1 - Re s) * log(&n))`, REPEAT STRIP_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; MATCH_MP (ARITH_RULE `n + 1 <= m ==> n <= m`) (ASSUME `n + 1 <= m`)] THEN MATCH_MP_TAC(REAL_ARITH `y <= a - x ==> x + y <= a`) THEN MP_TAC(SPECL [`\z. Cx(&1) / z cpow (Cx(Re s))`; `\z. Cx(&1) / ((Cx(&1) - (Cx(Re s))) * z cpow (Cx(Re s) - Cx(&1)))`; `n + 1`; `m:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(n + &1) - &1 = n`] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN COMPLEX_DIFF_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX_GEN]) THEN STRIP_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM LT_NZ]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL [ASM_MESON_TAC[RE_CX; REAL_LT_REFL]; ALL_TAC] THEN ASM_REWRITE_TAC[CPOW_N; CPOW_SUB; COMPLEX_POW_1] THEN REWRITE_TAC[COMPLEX_ENTIRE; complex_div] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [UNDISCH_TAC `~(z = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD; ASM_REWRITE_TAC[COMPLEX_INV_EQ_0; CPOW_EQ_0; COMPLEX_SUB_0] THEN REWRITE_TAC[CX_INJ] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < x /\ &0 < y` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT; GSYM LT_NZ]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX; GSYM CX_DIV] THEN SIMP_TAC[real_div; REAL_MUL_LID; GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= s * (y - x) ==> --(s * y) <= --(s * x)`) THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> x <= a ==> y <= b`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN SUBGOAL_THEN `0 < r` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; COMPLEX_NORM_DIV; NORM_CPOW_REAL] THEN REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_DIV; RE_CX; REAL_ABS_NUM]; ALL_TAC] THEN REWRITE_TAC[RE_SUB] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ --y <= e ==> x - y <= e`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `n + 1 <= m ==> 0 < m`)) THEN ASM_SIMP_TAC[GSYM CX_SUB; CPOW_REAL_REAL; REAL_CX; RE_CX; COMPLEX_NORM_DIV; REAL_OF_NUM_LT; NORM_CPOW_REAL; LT_NZ] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_DIV; RE_CX] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_INV_NEG] THEN REWRITE_TAC[GSYM REAL_MUL_LNEG; REAL_NEG_SUB] THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_MUL; REAL_EXP_POS_LE; REAL_SUB_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_INV_MUL; GSYM REAL_EXP_NEG] THEN REWRITE_TAC[GSYM REAL_MUL_LNEG; REAL_NEG_SUB] THEN MATCH_MP_TAC(REAL_ARITH `x <= n * e ==> i * e <= (n + i) * e - x`) THEN REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_EXP_SUB; REAL_MUL_LID] THEN ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LT_NZ; REAL_EXP_POS_LT; REAL_FIELD `&0 < x /\ &0 < z ==> inv(x) * x / z = inv(z)`] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_EXP_NEG; REAL_LE_REFL]);; let GENZETA_BOUND = prove (`!n s. ~(n = 0) /\ &1 < Re s ==> norm(genzeta n s) <= (&1 / &n + &1 / (Re s - &1)) * exp((&1 - Re s) * log(&n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\m. vsum(n..m) (\r. Cx(&1) / Cx(&r) cpow s)` THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP GENZETA_CONVERGES) THEN SIMP_TAC[sums; FROM_INTER_NUMSEG; TRIVIAL_LIMIT_SEQUENTIALLY] THEN DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN ASM_SIMP_TAC[GENZETA_BOUND_LEMMA]);; let NEARZETA_BOUND_SHARP = prove (`!n s. ~(n = 0) /\ &0 < Re s ==> norm(nearzeta n s) <= norm(s * (s - Cx(&1))) * (&1 / &n + &1 / Re s) / exp(Re s * log(&n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\m. vsum(n..m) (\r. (s - Cx(&1)) / Cx(&r) cpow s - (Cx(&1) / Cx(&r) cpow (s - Cx(&1)) - Cx(&1) / Cx(&(r + 1)) cpow (s - Cx(&1))))` THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP NEARZETA_CONVERGES) THEN SIMP_TAC[sums; FROM_INTER_NUMSEG; TRIVIAL_LIMIT_SEQUENTIALLY] THEN DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (n..m) (\r. norm(s * (s - Cx (&1)) / Cx(&r) cpow (s + Cx(&1))))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC NEARZETA_BOUND_LEMMA THEN CONJ_TAC THENL [ASM_ARITH_TAC; ASM_REAL_ARITH_TAC]; ALL_TAC] THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a / b = a * Cx(&1) / b`] THEN REWRITE_TAC[SUM_LMUL; COMPLEX_NORM_MUL; GSYM REAL_MUL_ASSOC] THEN REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE]) THEN W(MP_TAC o PART_MATCH (lhand o rand) GENZETA_BOUND_LEMMA o lhand o snd) THEN ASM_REWRITE_TAC[RE_ADD; REAL_LT_ADDL; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[REAL_ARITH `(x + &1) - &1 = x`; REAL_ARITH `(&1 - (s + &1)) * x = --(s * x)`] THEN REWRITE_TAC[real_div; REAL_EXP_NEG; REAL_LE_REFL]);; let NEARZETA_BOUND = prove (`!n s. ~(n = 0) /\ &0 < Re s ==> norm(nearzeta n s) <= ((norm(s) + &1) pow 3 / Re s) / exp (Re s * log (&n))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP NEARZETA_BOUND_SHARP) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_EXP_POS_LE; REAL_MUL_LID] THEN REWRITE_TAC[REAL_RING `(x pow 3):real = x * x * x`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LE_ADD; REAL_LE_INV_EQ; REAL_POS; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LE_ADD; REAL_LE_INV_EQ; REAL_POS; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `norm(y) = b ==> norm(x - y) <= norm(x) + b`) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `a + y <= (x + &1) * y <=> a <= x * y`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1)` THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM_SIMP_TAC[REAL_INV_1; GSYM real_div; REAL_LE_RDIV_EQ] THEN MP_TAC(SPEC `s:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC);; let NEARNEWMAN_EXISTS = prove (`?f. !s. s IN {s | Re(s) > &1 / &2} ==> ((\p. clog(Cx(&p)) / Cx(&p) * nearzeta p s - clog(Cx(&p)) / (Cx(&p) cpow s * (Cx(&p) cpow s - Cx(&1)))) sums (f s)) {p | prime p} /\ f complex_differentiable (at s)`, MATCH_MP_TAC SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX THEN REWRITE_TAC[OPEN_HALFSPACE_RE_GT] THEN REWRITE_TAC[IN_ELIM_THM; real_gt] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN CONJ_TAC THENL [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_MUL_AT THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_NEARZETA THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC]; ALL_TAC] THEN COMPLEX_DIFFERENTIABLE_TAC THEN ASM_SIMP_TAC[COMPLEX_ENTIRE; CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; COMPLEX_SUB_0; PRIME_IMP_NZ; PRIME_GE_2; CPOW_NUM_NE_1; REAL_ARITH `&1 / &2 < x ==> &0 < x`]; ALL_TAC] THEN X_GEN_TAC `s:complex` THEN STRIP_TAC THEN EXISTS_TAC `min (&1 / &2) ((Re s - &1 / &2) / &2)` THEN EXISTS_TAC `\p. Cx(&2 * (norm(s:complex) + &2) pow 3 + &2) * clog(Cx(&p)) / Cx(&p) cpow (Cx(&1 + (Re s - &1 / &2) / &4))` THEN EXISTS_TAC `5` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN MATCH_MP_TAC SUMMABLE_SUBSET_COMPLEX THEN EXISTS_TAC `from 1` THEN SIMP_TAC[IN_FROM; SUBSET; IN_ELIM_THM; GSYM CX_LOG; CPOW_REAL_REAL; RE_CX; REAL_CX; REAL_OF_NUM_LT; LE_1; PRIME_IMP_NZ] THEN SIMP_TAC[GSYM CX_DIV; REAL_CX; RE_CX; LOG_POS; REAL_OF_NUM_LE; REAL_LE_DIV; REAL_EXP_POS_LE] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `--(complex_derivative zeta (Cx(&1 + (Re s - &1 / &2) / &4)))` THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM COMPLEX_NEG_NEG] THEN MATCH_MP_TAC SERIES_NEG THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_LNEG] THEN REWRITE_TAC[GSYM complex_div] THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_ZETA_CONVERGES THEN REWRITE_TAC[RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THEN X_GEN_TAC `p:num` THENL [SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ; GSYM CX_DIV; GSYM CX_MUL] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 <= &2 * x + &2`) THEN MATCH_MP_TAC REAL_POW_LE THEN NORM_ARITH_TAC; MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; PRIME_GE_2]]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_BALL; REAL_LT_MIN; dist] THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `x <= a * b /\ a * b <= abs a * b ==> x <= abs a * b`) THEN SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; REAL_ABS_LE] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC(NORM_ARITH `norm(x) <= a /\ norm(y) <= b ==> norm(x - y) <= a + b`) THEN CONJ_TAC THENL [REWRITE_TAC[CPOW_ADD; CX_ADD; CPOW_N; CX_INJ; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_MUL_ASSOC] THEN ASM_SIMP_TAC[PRIME_IMP_NZ; GSYM complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN REWRITE_TAC[COMPLEX_POW_1; real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `x * a * b:real = a * x * b`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN W(MP_TAC o PART_MATCH (lhand o rand) NEARZETA_BOUND o lhand o snd) THEN ASM_SIMP_TAC[PRIME_IMP_NZ] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[PRIME_IMP_NZ] THEN MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x) * y = x * &2 * y`] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE; REAL_LE_INV_EQ; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_POS; REAL_LE_ADD; GSYM REAL_INV_MUL; REAL_EXP_POS_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE2 THEN ASM_NORM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_EXP_POS_LE] THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; PRIME_IMP_NZ; LT_NZ] THEN REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN REWRITE_TAC[REAL_ARITH `--(a * p) <= --(b * p) <=> b * p <= a * p`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; PRIME_GE_2] THEN MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!y:complex. norm(x) <= &2 * norm(y) /\ norm(y) <= a ==> norm(x) <= &2 * a`) THEN EXISTS_TAC `clog(Cx(&p)) / Cx(&p) cpow (z + z)` THEN CONJ_TAC THENL [REWRITE_TAC[CPOW_ADD; complex_div; COMPLEX_MUL_ASSOC; COMPLEX_INV_MUL] THEN REWRITE_TAC[GSYM complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_DIV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INV_INV] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_ARITH `&0 < x * inv(&2) <=> &0 < x`; COMPLEX_NORM_NZ] THEN ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ; COMPLEX_VEC_0] THEN MATCH_MP_TAC(NORM_ARITH `&2 <= norm(a) /\ norm(b) = &1 ==> norm(a) * inv(&2) <= norm(a - b)`) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `5 <= p ==> 0 < p`] THEN SUBST1_TAC(SYM(MATCH_MP EXP_LOG (REAL_ARITH `&0 < &2`))) THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &2 * log(&4)` THEN SIMP_TAC[REAL_ARITH `l <= &1 / &2 * x <=> &2 * l <= x`; GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; LOG_POS; REAL_OF_NUM_LE; ARITH; LOG_MONO_LE_IMP; REAL_OF_NUM_LT; ARITH_RULE `5 <= p ==> 4 <= p`] THEN MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_DIV; real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `5 <= p ==> 0 < p`] THEN REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN REWRITE_TAC[REAL_ARITH `--(a * p) <= --(b * p) <=> b * p <= a * p`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; PRIME_GE_2] THEN MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB; RE_ADD] THEN ASM_REAL_ARITH_TAC);; let nearnewman = new_specification ["nearnewman"] NEARNEWMAN_EXISTS;; let [CONVERGES_NEARNEWMAN; COMPLEX_DIFFERENTIABLE_NEARNEWMAN] = CONJUNCTS(REWRITE_RULE[FORALL_AND_THM; IN_ELIM_THM; real_gt; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] nearnewman);; let newman = new_definition `newman(s) = (nearnewman(s) - (complex_derivative zeta s / zeta s)) / (s - Cx(&1))`;; (* ------------------------------------------------------------------------- *) (* Careful correlation of singularities of the various functions. *) (* ------------------------------------------------------------------------- *) let COMPLEX_DERIVATIVE_ZETA = prove (`!s. &0 < Re s /\ ~(s = Cx(&1)) ==> complex_derivative zeta s = complex_derivative (nearzeta 1) s / (s - Cx(&1)) - (nearzeta 1 s + Cx(&1)) / (s - Cx(&1)) pow 2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] (GEN_ALL zeta); REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] (GEN_ALL genzeta)] THEN REWRITE_TAC[CPOW_1; complex_div; COMPLEX_MUL_LID; COMPLEX_INV_1] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN EXISTS_TAC `\s. (nearzeta 1 s + Cx(&1)) * inv(s - Cx(&1))` THEN EXISTS_TAC `dist(Cx(&1),s)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LT_REFL]; ALL_TAC] THEN MP_TAC(SPECL [`\z. nearzeta 1 z + Cx(&1)`; `complex_derivative(nearzeta 1) s`; `\z. inv(z - Cx(&1))`; `--Cx(&1) / (s - Cx(&1)) pow 2`; `s:complex`] HAS_COMPLEX_DERIVATIVE_MUL_AT) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMPLE_COMPLEX_ARITH_TAC] THEN CONJ_TAC THENL [ALL_TAC; COMPLEX_DIFF_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; ETA_AX] THEN MP_TAC(SPEC `1` HOLOMORPHIC_NEARZETA) THEN SIMP_TAC[ARITH; HOLOMORPHIC_ON_OPEN; OPEN_HALFSPACE_RE_GT] THEN ASM_SIMP_TAC[IN_ELIM_THM; GSYM complex_differentiable; real_gt]);; let ANALYTIC_ZETA_DERIVDIFF = prove (`?a. (\z. if z = Cx(&1) then a else (z - Cx(&1)) * complex_derivative zeta z - complex_derivative zeta z / zeta z) analytic_on {s | Re(s) >= &1}`, EXISTS_TAC `complex_derivative (\z. (Cx(&1) - inv(nearzeta 1 z + Cx(&1))) * ((z - Cx(&1)) * complex_derivative (nearzeta 1) z - (nearzeta 1 z + Cx(&1)))) (Cx(&1))` THEN MATCH_MP_TAC POLE_THEOREM_ANALYTIC_0 THEN MAP_EVERY EXISTS_TAC [`\z. (Cx(&1) - inv(nearzeta 1 z + Cx(&1))) * ((z - Cx(&1)) * complex_derivative (nearzeta 1) z - (nearzeta 1 z + Cx(&1)))`; `Cx(&1)`] THEN SIMP_TAC[NEARZETA_1; ARITH] THEN REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_INV_1; COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO] THEN CONJ_TAC THENL [MATCH_MP_TAC ANALYTIC_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC ANALYTIC_ON_SUB THEN REWRITE_TAC[ANALYTIC_ON_CONST] THEN MATCH_MP_TAC ANALYTIC_ON_INV THEN ASM_SIMP_TAC[IN_ELIM_THM; real_ge; NEARZETA_NONZERO] THEN MATCH_MP_TAC ANALYTIC_ON_ADD THEN REWRITE_TAC[ANALYTIC_ON_CONST; ETA_AX]; MATCH_MP_TAC ANALYTIC_ON_SUB THEN CONJ_TAC THENL [MATCH_MP_TAC ANALYTIC_ON_MUL THEN SIMP_TAC[ETA_AX; ANALYTIC_ON_SUB; ANALYTIC_ON_CONST; ANALYTIC_ON_ID] THEN MATCH_MP_TAC ANALYTIC_COMPLEX_DERIVATIVE; MATCH_MP_TAC ANALYTIC_ON_ADD THEN REWRITE_TAC[ANALYTIC_ON_CONST; ETA_AX]]] THEN MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN EXISTS_TAC `{s | Re(s) > &0}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN SIMP_TAC[ETA_AX; ANALYTIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; HOLOMORPHIC_NEARZETA; LE_REFL] THEN REAL_ARITH_TAC; X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP NEARZETA_NONZERO) THEN MP_TAC(ISPECL [`\z. nearzeta 1 z + Cx(&1)`; `z:complex`; `Cx(&0)`] CONTINUOUS_AT_AVOID) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_ADD THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_CONST; ETA_AX] THEN MP_TAC(SPEC `1` HOLOMORPHIC_NEARZETA) THEN SIMP_TAC[ARITH; HOLOMORPHIC_ON_OPEN; OPEN_HALFSPACE_RE_GT] THEN REWRITE_TAC[complex_differentiable; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min e (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN REWRITE_TAC[BALL_MIN_INTER; IN_INTER; IN_BALL; REAL_LT_MIN] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < Re w` ASSUME_TAC THENL [MP_TAC(SPEC `z - w:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN ASM_NORM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_DERIVATIVE_ZETA] THEN ASM_REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM] zeta; genzeta] THEN REWRITE_TAC[CPOW_1; COMPLEX_DIV_1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(w = Cx(&1))` THEN CONV_TAC COMPLEX_FIELD]);; let ANALYTIC_NEWMAN_VARIANT = prove (`?c a. (\z. if z = Cx(&1) then a else newman z + complex_derivative zeta z + c * zeta z) analytic_on {s | Re(s) >= &1}`, X_CHOOSE_TAC `c:complex` ANALYTIC_ZETA_DERIVDIFF THEN EXISTS_TAC `--(c + nearnewman(Cx(&1)))` THEN EXISTS_TAC `complex_derivative (\z. nearnewman z + (if z = Cx(&1) then c else (z - Cx(&1)) * complex_derivative zeta z - complex_derivative zeta z / zeta z) + --(c + nearnewman (Cx(&1))) * (nearzeta 1 z + Cx(&1))) (Cx(&1))` THEN MATCH_MP_TAC POLE_THEOREM_ANALYTIC_0 THEN MAP_EVERY EXISTS_TAC [`\z. nearnewman z + (if z = Cx(&1) then c else (z - Cx(&1)) * complex_derivative zeta z - complex_derivative zeta z / zeta z) + --(c + nearnewman(Cx(&1))) * (nearzeta 1 z + Cx(&1))`; `Cx(&1)`] THEN SIMP_TAC[NEARZETA_1; LE_REFL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ANALYTIC_ON_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN EXISTS_TAC `{s | Re(s) > &1 / &2}` THEN SIMP_TAC[SUBSET; IN_ELIM_THM; ANALYTIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; HOLOMORPHIC_ON_OPEN; real_gt; GSYM complex_differentiable; COMPLEX_DIFFERENTIABLE_NEARNEWMAN] THEN REAL_ARITH_TAC; MATCH_MP_TAC ANALYTIC_ON_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ANALYTIC_ON_MUL THEN REWRITE_TAC[ANALYTIC_ON_CONST] THEN MATCH_MP_TAC ANALYTIC_ON_ADD THEN REWRITE_TAC[ANALYTIC_ON_CONST] THEN MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN EXISTS_TAC `{s | Re(s) > &0}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN SIMP_TAC[ETA_AX; ANALYTIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; HOLOMORPHIC_NEARZETA; LE_REFL] THEN REAL_ARITH_TAC]; REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN REWRITE_TAC[newman] THEN GEN_REWRITE_TAC (funpow 4 RAND_CONV o ONCE_DEPTH_CONV) [zeta] THEN ASM_REWRITE_TAC[genzeta; CPOW_1; COMPLEX_DIV_1] THEN UNDISCH_TAC `~(w = Cx(&1))` THEN CONV_TAC COMPLEX_FIELD; SIMPLE_COMPLEX_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Hence apply the analytic lemma. *) (* ------------------------------------------------------------------------- *) let CONVERGES_NEWMAN_PRIME = prove (`!s. &1 < Re s ==> ((\p. clog(Cx(&p)) / Cx(&p) * genzeta p s) sums newman(s)) {p | prime p}`, X_GEN_TAC `s:complex` THEN ASM_CASES_TAC `s = Cx(&1)` THEN ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL; genzeta; newman] THEN DISCH_TAC THEN REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC SERIES_COMPLEX_RMUL THEN REWRITE_TAC[GSYM complex_div] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGES_LOGZETA'') THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGES_NEARNEWMAN o MATCH_MP (REAL_ARITH `&1 < x ==> &1 / &2 < x`)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN REWRITE_TAC[GSYM complex_sub] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC SUMS_IFF THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC(COMPLEX_RING `c - b = a * m ==> (a:complex) * n - b + c = a * (n + m)`) THEN ASM_SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ; complex_div] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_SUB_LDISTRIB] THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID; GSYM COMPLEX_INV_MUL] THEN ASM_SIMP_TAC[CPOW_SUB; CPOW_N; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ] THEN REWRITE_TAC[COMPLEX_POW_1] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(ps = Cx(&1)) /\ ~(ps = Cx(&0)) /\ ~(p = Cx(&0)) ==> inv(ps - Cx(&1)) - inv(ps * (ps - Cx(&1))) = inv(p * ps / p)`) THEN ASM_SIMP_TAC[CPOW_NUM_NE_1; PRIME_GE_2; REAL_ARITH `&1 < x ==> &0 < x`] THEN ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ]);; (* ------------------------------------------------------------------------- *) (* Now swap the order of summation in the series. *) (* ------------------------------------------------------------------------- *) let GENZETA_OFFSET = prove (`!m n s. &1 < Re s /\ m <= n ==> genzeta m s - vsum(m..n) (\k. Cx(&1) / Cx(&k) cpow s) = genzeta (n + 1) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN MAP_EVERY EXISTS_TAC [`\k. Cx(&1) / Cx(&k) cpow s`; `from(n + 1)`] THEN ASM_SIMP_TAC[GENZETA_CONVERGES] THEN GEN_REWRITE_TAC (PAT_CONV `\n. (f sums (a - vsum(m..n) s)) k`) [ARITH_RULE `n = (n + 1) - 1`] THEN MATCH_MP_TAC SUMS_OFFSET THEN ASM_SIMP_TAC[GENZETA_CONVERGES] THEN ASM_ARITH_TAC);; let NEWMAN_CONVERGES = prove (`!s. &1 < Re s ==> ((\n. vsum {p | prime p /\ p <= n} (\p. clog(Cx(&p)) / Cx(&p)) / Cx(&n) cpow s) sums (newman s)) (from 1)`, let lemma = prove (`vsum (1..n) (\m. vsum {p | prime p /\ p <= m} (\p. f p m)) = vsum {p | prime p /\ p <= n} (\p. vsum (p..n) (\m. f p m))`, SIMP_TAC[VSUM_VSUM_PRODUCT; FINITE_NUMSEG; FINITE_ATMOST] THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN REPEAT(EXISTS_TAC `\(x:num,y:num). (y,x)`) THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ASM_ARITH_TAC) in REPEAT STRIP_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG; LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGES_NEWMAN_PRIME) THEN GEN_REWRITE_TAC LAND_CONV [sums] THEN SUBGOAL_THEN `!n. {p | prime p} INTER (0..n) = {p | prime p /\ p <= n}` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_NUMSEG; LE_0]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN REWRITE_TAC[dist] THEN DISCH_THEN(X_CHOOSE_THEN `N0:num` (LABEL_TAC "0")) THEN SUBGOAL_THEN `((\n. Cx(&1 + &1 / (Re s - &1)) * (clog(Cx(&n)) + Cx(&24)) / Cx(&n) cpow (s - Cx(&1))) --> Cx(&0)) sequentially` MP_TAC THENL [MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN CONJ_TAC THENL [REWRITE_TAC[GSYM complex_div] THEN MATCH_MP_TAC LIM_LOG_OVER_POWER_N; MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv x = Cx(&1) / x`] THEN MATCH_MP_TAC LIM_1_OVER_POWER] THEN REWRITE_TAC[RE_SUB; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY; dist; COMPLEX_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "1")) THEN EXISTS_TAC `N0 + N1 + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REMOVE_THEN "0" (MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(x - y) <= e / &2 ==> norm(x - a) < e / &2 ==> norm(y - a) < e`) THEN SIMP_TAC[complex_div; GSYM VSUM_COMPLEX_RMUL; FINITE_ATMOST] THEN REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[lemma] THEN SIMP_TAC[FINITE_ATMOST; GSYM VSUM_SUB] THEN SIMP_TAC[complex_div] THEN SIMP_TAC[COMPLEX_MUL_ASSOC; VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN SIMP_TAC[GSYM complex_div] THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv x = Cx(&1) / x`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum {p | prime p /\ p <= n} (\p. clog(Cx(&p)) / Cx(&p) * genzeta (n + 1) s))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; GENZETA_OFFSET]; ALL_TAC] THEN SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_ATMOST] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `y <= x ==> x < e ==> y <= e`) THEN REWRITE_TAC[complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = b * a * c`] THEN REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN SUBGOAL_THEN `~(n = 0) /\ 1 <= n` STRIP_ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP MERTENS) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs(x - y) <= e ==> &0 <= y ==> abs(x) <= y + e`)) THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE] THEN MATCH_MP_TAC(REAL_ARITH `x' <= x /\ y' = y ==> abs x <= y ==> x' <= y'`) THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_NORM_LE THEN SIMP_TAC[FINITE_ATMOST; IN_ELIM_THM] THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ] THEN REWRITE_TAC[GSYM CX_DIV; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x <= x`) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; LOG_POS; REAL_OF_NUM_LE; LE_1]; ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ] THEN REWRITE_TAC[GSYM CX_ADD; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x = x`) THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_POS; LOG_POS; REAL_OF_NUM_LE; LE_1]]; MP_TAC(SPECL [`n + 1`; `s:complex`] GENZETA_BOUND) THEN ASM_REWRITE_TAC[ADD_EQ_0; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[complex_div; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_DIV; REAL_POS; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_EXP_POS_LE] THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `a <= &1 ==> a + b <= abs(&1 + b)`) THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_NORM_INV; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE; RE_SUB; RE_CX] THEN REWRITE_TAC[REAL_ARITH `(&1 - s) * l <= --((s - &1) * m) <=> (s - &1) * m <= (s - &1) * l`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_SUB_LT] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LT_NZ] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Hence the main result of the analytic part. *) (* ------------------------------------------------------------------------- *) let MAIN_RESULT = prove (`?c. summable (from 1) (\n. (vsum {p | prime p /\ p <= n} (\p. clog(Cx(&p)) / Cx(&p)) - clog(Cx(&n)) + c) / Cx(&n))`, MP_TAC ANALYTIC_NEWMAN_VARIANT THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:complex`; `singval:complex`] THEN DISCH_TAC THEN EXISTS_TAC `c:complex` THEN MP_TAC(SPECL [`\z. if z = Cx(&1) then singval else newman z + complex_derivative zeta z + c * zeta z`; `\n. vsum {p | prime p /\ p <= n} (\p. clog(Cx(&p)) / Cx(&p)) - clog(Cx(&n)) + c`; `&24 + norm(c:complex)`] NEWMAN_INGHAM_THEOREM_STRONG) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `Cx(&1)`) THEN REWRITE_TAC[RE_CX; real_ge; REAL_LE_REFL] THEN DISCH_THEN(MP_TAC o MATCH_MP SUMS_SUMMABLE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ) THEN SIMP_TAC[IN_FROM; CPOW_N; CX_INJ; REAL_OF_NUM_EQ] THEN SIMP_TAC[LE_1; COMPLEX_POW_1]] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(x - y) <= &24 ==> norm(x - y + c) <= &24 + norm c`) THEN MP_TAC(SPEC `n:num` MERTENS) THEN ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= a ==> y <= a`) THEN REWRITE_TAC[GSYM COMPLEX_NORM_CX] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM VSUM_CX; CX_SUB; FINITE_ATMOST] THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LE_1] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM CX_LOG; CX_DIV; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[real_gt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL] THEN DISCH_TAC THEN REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB; COMPLEX_SUB_RDISTRIB] THEN REWRITE_TAC[COMPLEX_ADD_ASSOC] THEN MATCH_MP_TAC SERIES_ADD THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SERIES_COMPLEX_LMUL THEN FIRST_ASSUM(MP_TAC o MATCH_MP ZETA_CONVERGES) THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID]] THEN REWRITE_TAC[complex_sub] THEN MATCH_MP_TAC SERIES_ADD THEN REWRITE_TAC[GSYM complex_div] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_LNEG] THEN REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[COMPLEX_DERIVATIVE_ZETA_CONVERGES]] THEN ASM_SIMP_TAC[NEWMAN_CONVERGES]);; (* ------------------------------------------------------------------------- *) (* The theorem relating summability and convergence. *) (* ------------------------------------------------------------------------- *) let SUM_GOESTOZERO_LEMMA = prove (`!a M N. abs(sum(M..N) (\i. a(i) / &i)) <= d ==> 0 < M /\ M < N /\ (!n. a(n) + log(&n) <= a(n + 1) + log(&n + &1)) ==> a(M) <= d * &N / (&N - &M) + (&N - &M) / &M /\ --a(N) <= d * &N / (&N - &M) + (&N - &M) / &M`, REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `0 < N` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT]) THEN MATCH_MP_TAC(REAL_ARITH `!a. a <= b /\ x <= a /\ y <= a ==> x <= b /\ y <= b`) THEN EXISTS_TAC `d * &N / (&N - &M) + log(&N / &M)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_LE_LADD] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < m /\ &0 < n ==> n / m = &1 + (n - m) / m`] THEN MATCH_MP_TAC LOG_LE THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN SUBGOAL_THEN `!m n. &m <= &n ==> a m + log(&m) <= a n + log(&n)` ASSUME_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THEN (MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d * &N) / (&N - &M + &1)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ (&0 <= x ==> x <= y) ==> x <= y`) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `m < n ==> &0 < n - m + &1`; REAL_LE_DIV; REAL_LE_MUL; REAL_MUL_LZERO; REAL_POS] THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `(x * y) * z:real = y * (x * z)`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(sum(M..N) (\i. a(i) / &i))` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`); MATCH_MP_TAC(REAL_ARITH `a <= --x ==> x <= abs a`)] THEN (SUBGOAL_THEN `&N - &M + &1 = &((N + 1) - M)` SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_LE; REAL_ARITH `m < n ==> m <= n + &1`] THEN REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[GSYM SUM_CONST_NUMSEG; GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN (SUBGOAL_THEN `&0 < &n` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[GSYM REAL_MUL_LNEG; REAL_NEG_SUB; REAL_SUB_RNEG] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `(a M - log(&N * inv(&M))) * inv(&n)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN ASM_SIMP_TAC[GSYM real_div; LOG_DIV] THEN MATCH_MP_TAC(REAL_ARITH `!x'. x' <= x /\ a - (x' - m) <= b ==> a - (x - m) <= b`) THEN EXISTS_TAC `log(&n)` THEN CONJ_TAC THENL [MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_ARITH `a - (x - y) <= b <=> a + y <= b + x`]; EXISTS_TAC `(log(&N * inv(&M)) + a N) * inv(&n)` THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[REAL_ARITH `a * x <= a * y <=> --a * y <= --a * x`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[GSYM real_div; REAL_ARITH `--(x + y:real) = --y - x`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN ASM_SIMP_TAC[GSYM real_div; LOG_DIV] THEN MATCH_MP_TAC(REAL_ARITH `!x'. x <= x' /\ a <= y - x' + b ==> a <= y - x + b`) THEN EXISTS_TAC `log(&n)` THEN CONJ_TAC THENL [MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_ARITH `a <= x - y + b <=> a + y <= b + x`]]);; let SUM_GOESTOZERO_THEOREM = prove (`!a c. ((\i. a(i) / &i) real_sums c) (from 1) /\ (!n. a(n) + log(&n) <= a(n + 1) + log(&n + &1)) ==> (a ---> &0) sequentially`, let lemma = prove (`(!e. &0 < e /\ e < &1 / &4 ==> ?N:num. !n. N <= n ==> f(n) < e) ==> (!e. &0 < e ==> ?N. !n. N <= n ==> f(n) < e)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &5)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MESON_TAC[REAL_LT_MIN]) in REWRITE_TAC[LEFT_FORALL_IMP_THM; LEFT_EXISTS_AND_THM] THEN REWRITE_TAC[REAL_SERIES_CAUCHY] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN MATCH_MP_TAC lemma THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(e / &8) pow 2`) THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `e / &4` REAL_ARCH_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `2 * N0 + N1 + 7` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MP_TAC(SPEC `&n * e / &4` FLOOR) THEN MP_TAC(SPEC `&n * e / &4` FLOOR_POS) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN STRIP_TAC THEN SUBGOAL_THEN `0 < k /\ 4 * k <= n` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[LT_NZ] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&n * e / &4 < &0 + &1` THEN REWRITE_TAC[REAL_NOT_LT; REAL_ADD_LID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N1 * e / &4` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LT_NZ] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_ARITH `&4 * x <= y <=> x <= y * inv(&4)`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n * e / &4` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LT] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`n - k:num`; `n:num`]); FIRST_ASSUM(MP_TAC o SPECL [`n:num`; `n + k:num`])] THEN (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FROM_INTER_NUMSEG_GEN] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_GOESTOZERO_LEMMA) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THENL [DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> --x <= a ==> --b < x`); DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> x <= a ==> x < b`)] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; ARITH_RULE `4 * k <= n ==> k <= n`; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `n - (n - k):real = k`; REAL_ARITH `(n + k) - n:real = k`] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `(e / &8) pow 2 * x < e / &2 <=> e * e / &16 * x < e * &2`] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_SUB_LT; REAL_OF_NUM_LT; ARITH_RULE `0 < k /\ 4 * k <= n ==> k < n`; ARITH_RULE `~(n < 1) ==> 0 < n`] THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `n * e / &4 < k + &1 /\ &1 <= k ==> e / &16 * n < &2 * k`) THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&n * e / &4` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `n * e / &4 < e / &2 * m <=> e * n < e * &2 * m`] THEN REWRITE_TAC[REAL_ARITH `n < &2 * (n - k) <=> &2 * k < n`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `n * e / &4 < k + &1 /\ &1 <= k /\ (&1 / &4 + e / &16) * k < &1 * k ==> e / &16 * (n + k) < &2 * k`) THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH_RULE `1 <= n <=> 0 < n`] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `k <= n * e / &4 /\ &0 < n * e ==> k < e / &2 * n`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH_RULE `~(n < 1) ==> 0 < n`]]);; (* ------------------------------------------------------------------------- *) (* Hence transform into the desired limit. *) (* ------------------------------------------------------------------------- *) let MERTENS_LIMIT = prove (`?c. ((\n. sum {p | prime p /\ p <= n} (\p. log(&p) / &p) - log(&n)) ---> c) sequentially`, X_CHOOSE_THEN `c:complex` MP_TAC MAIN_RESULT THEN REWRITE_TAC[summable] THEN DISCH_THEN(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `--Re(c)` THEN ONCE_REWRITE_TAC[REALLIM_NULL] THEN MATCH_MP_TAC SUM_GOESTOZERO_THEOREM THEN EXISTS_TAC `Re l` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP REAL_SUMS_RE) THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_SUMS_EQ) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN ASM_SIMP_TAC[RE_ADD; RE_DIV_CX; RE_SUB; REAL_SUB_RNEG] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LE_1; RE_CX] THEN SIMP_TAC[RE_VSUM; FINITE_ATMOST] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[IN_ELIM_THM; GSYM CX_LOG; REAL_OF_NUM_LT; PRIME_IMP_NZ; LT_NZ; GSYM CX_DIV; RE_CX]; GEN_TAC THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `s <= s' ==> (s - l - c) + l <= (s' - l' - c) + l'`) THEN MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[FINITE_ATMOST] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `p:num` THEN ASM_CASES_TAC `prime p` THEN ASM_REWRITE_TAC[] THENL [ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC LOG_POS THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Reformulate the PNT using partial summation. *) (* ------------------------------------------------------------------------- *) let PNT_PARTIAL_SUMMATION = prove (`&(CARD {p | prime p /\ p <= n}) = sum(1..n) (\k. &k / log (&k) * (sum {p | prime p /\ p <= k} (\p. log (&p) / &p) - sum {p | prime p /\ p <= k - 1} (\p. log (&p) / &p)))`, REWRITE_TAC[PRIME_ATMOST_ALT] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG; FINITE_RESTRICT] THEN SIMP_TAC[FINITE_NUMSEG; SUM_RESTRICT_SET] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (PAT_CONV `\x. l = a * (sum(1..x) f - s)`) [MATCH_MP (ARITH_RULE `1 <= p ==> p = SUC(p - 1)`) th]) THEN SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[REAL_ADD_SUB] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= p ==> SUC(p - 1) = p`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN MATCH_MP_TAC(REAL_FIELD `&0 < x /\ &0 < y ==> &1 = x / y * y / x`) THEN ASM_SIMP_TAC[LOG_POS_LT; REAL_OF_NUM_LT; LE_1; PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 < p`]);; let SUM_PARTIAL_LIMIT = prove (`!f e c M. (!k. M <= k ==> &0 < f k) /\ (!k. M <= k ==> f(k) <= f(k + 1)) /\ ((\k. inv(f k)) ---> &0) sequentially /\ (e ---> c) sequentially ==> ((\n. (sum(1..n) (\k. e(k) * (f(k + 1) - f(k))) - e(n) * f(n + 1)) / f(n + 1)) ---> &0) sequentially`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "g") (LABEL_TAC "e")) THEN SUBGOAL_THEN `!k:num. M <= k ==> &0 <= f k` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN SIMP_TAC[tendsto_real] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?N. (!k. N <= k ==> &0 < f k) /\ (!k. N <= k ==> f(k) <= f(k + 1)) /\ (!k. N <= k ==> abs(e k - c) < d / &4)` (X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THENL [USE_THEN "e" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `d / &4`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN ASM_MESON_TAC[ARITH_RULE `M + N <= (n:num) ==> M <= n /\ N <= n`]; ALL_TAC] THEN SUBGOAL_THEN `!n. N + 1 <= n ==> abs((sum((N+1)..n) (\k. e k * (f (k + 1) - f k)) - e(n) * f(n + 1)) + c * f(N + 1)) <= d / &2 * f(n + 1)` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\k. (e k - c:real) * (f (k + 1) - f k)`; `\k. d / &4 * (f (k + 1) - f k)`; `(N+1)..n`] SUM_ABS_LE) THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_ABS_MUL; ARITH_RULE `N + 1 <= n ==> N <= n`; REAL_ARITH `a <= b ==> abs(b - a) = b - a`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; ARITH_RULE `N + 1 <= n ==> N <= n`]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_SUB_RDISTRIB] THEN REWRITE_TAC[SUM_SUB_NUMSEG] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SUM_PARTIAL_SUC] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) [SUM_PARTIAL_SUC] THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= d * f1 /\ &0 <= dd /\ abs(en - cn) <= d / &4 * f1 ==> abs(s - (cn - cN)) <= d / &4 * f1 - dd ==> abs(s - en + cN) <= d / &2 * f1`) THEN REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_SUB_RDISTRIB] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_DIV; REAL_LT_IMP_LE; REAL_OF_NUM_LT; ARITH; LE_ADD; ARITH_RULE `N + 1 <= n ==> N <= n + 1`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; ARITH_RULE `N + 1 <= n ==> N <= n`; ARITH_RULE `N + 1 <= n ==> N <= n + 1`]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN USE_THEN "g" (MP_TAC o MATCH_MP REALLIM_LMUL) THEN DISCH_THEN(MP_TAC o SPEC `sum(1..N) (\k. e k * (f (k + 1) - f k)) - c * f(N + 1)`) THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP REAL_SEQ_OFFSET) THEN REWRITE_TAC[REAL_MUL_RZERO; tendsto_real; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `N + 1 <= n`)) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_INV] THEN ASM_SIMP_TAC[GSYM real_div; REAL_ARITH `&0 < x ==> abs x = x`; ARITH_RULE `N + 1 <= n ==> N <= n + 1`; REAL_LT_LDIV_EQ] THEN SUBGOAL_THEN `1 <= N + 1 /\ N <= n` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN REAL_ARITH_TAC);; let SUM_PARTIAL_LIMIT_ALT = prove (`!f e b c M. (!k. M <= k ==> &0 < f k) /\ (!k. M <= k ==> f(k) <= f(k + 1)) /\ ((\k. inv(f k)) ---> &0) sequentially /\ ((\n. f(n + 1) / f n) ---> b) sequentially /\ (e ---> c) sequentially ==> ((\n. (sum(1..n) (\k. e(k) * (f(k + 1) - f(k))) - e(n) * f(n + 1)) / f(n)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. ((sum(1..n) (\k. e(k) * (f(k + 1) - f(k))) - e(n) * f(n + 1)) / f(n + 1)) * (f(n + 1) / f(n))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `M:num` THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_FIELD `&0 < a /\ &0 < b ==> x / b * b / a = x / a`; ARITH_RULE `M <= n ==> M <= n + 1`]; ALL_TAC] THEN SUBST1_TAC(REAL_ARITH `&0 = &0 * b`) THEN MATCH_MP_TAC REALLIM_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_PARTIAL_LIMIT THEN ASM_MESON_TAC[]);; let REALLIM_NA_OVER_N = prove (`!a. ((\n. (&n + a) / &n) ---> &1) sequentially`, GEN_TAC THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n:num. &1` THEN REWRITE_TAC[REALLIM_CONST] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_N]]);; let REALLIM_N_OVER_NA = prove (`!a. ((\n. &n / (&n + &1)) ---> &1) sequentially`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_1] THEN MATCH_MP_TAC REALLIM_INV THEN REWRITE_TAC[REALLIM_NA_OVER_N] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let REALLIM_LOG1_OVER_LOG = prove (`((\n. log(&n + &1) / log(&n)) ---> &1) sequentially`, MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. &1 + log(&1 + &1 / &n) / log(&n)` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LOG_POS_LT; REAL_ARITH `&2 <= x ==> &1 < x`; REAL_FIELD `&0 < x ==> (&1 + a / x = b / x <=> x + a = b)`] THEN ASM_SIMP_TAC[GSYM LOG_MUL; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; REAL_LE_DIV; REAL_POS; REAL_ARITH `&2 <= x ==> &0 < x`] THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[REALLIM_CONST] THEN MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN EXISTS_TAC `\n. inv(&n)` THEN REWRITE_TAC[REALLIM_1_OVER_N] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[real_div; REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN ASM_SIMP_TAC[LOG_POS; REAL_LE_INV_EQ; REAL_POS; REAL_ARITH `&0 <= x ==> &1 <= &1 + x`] THEN MATCH_MP_TAC LOG_LE THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * log(&2)` THEN CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= abs b`) THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC);; let REALLIM_LOG_OVER_LOG1 = prove (`((\n. log(&n) / log(&n + &1)) ---> &1) sequentially`, ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_1] THEN MATCH_MP_TAC REALLIM_INV THEN REWRITE_TAC[REALLIM_LOG1_OVER_LOG] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ADHOC_BOUND_LEMMA = prove (`!k. 1 <= k ==> abs((&k + &1) * (log(&k + &1) - log(&k)) - &1) <= &2 / &k`, REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`\n z. if n = 0 then clog z else if n = 1 then inv z else --inv(z pow 2)`; `Cx(&k + &1)`; `Cx(&k)`; `1`] COMPLEX_TAYLOR_MVT) THEN REWRITE_TAC[ARITH; ADD_EQ_0] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_RULES] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_DIV_1; complex_pow; COMPLEX_POW_1; COMPLEX_VEC_0] THEN REWRITE_TAC[GSYM CX_SUB; COMPLEX_ADD_RID; REAL_ARITH `k - (k + &1) = -- &1`] THEN REWRITE_TAC[CX_SUB; CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG; COMPLEX_MUL_RID] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`n:num`; `z:complex`] THEN REWRITE_TAC[ARITH_RULE `n <= 1 <=> n = 0 \/ n = 1`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[ARITH] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID; complex_div; COMPLEX_MUL_LNEG] THEN REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX_GEN]) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:complex` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX_GEN]) THEN STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < &k /\ &0 < &k + &1` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[RE_ADD] THEN ONCE_REWRITE_TAC[REAL_RING `w:real = z + u <=> w - z = u`] THEN ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_INV; GSYM CX_ADD; GSYM CX_SUB; GSYM CX_NEG; RE_CX] THEN DISCH_THEN(MP_TAC o AP_TERM `(*) (&k + &1)`) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < x ==> x * (y - (z + --inv x)) = &1 - x * (z - y)`] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM CX_SUB; GSYM CX_MUL; GSYM CX_POW; GSYM CX_INV; RE_CX] THEN REWRITE_TAC[REAL_POW_2; GSYM REAL_POW_INV; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c * d = (a * b:real) * (c * d)`] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> abs x = x`] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC);; let REALLIM_MUL_SERIES = prove (`!x y z B. eventually (\n. &0 < x n) sequentially /\ eventually (\n. &0 < y n) sequentially /\ eventually (\n. &0 < z n) sequentially /\ ((\n. inv(z n)) ---> &0) sequentially /\ eventually (\n. abs(sum (1..n) x / z(n)) <= B) sequentially /\ ((\n. y(n) / x(n)) ---> &0) sequentially ==> ((\n. sum (1..n) y / z(n)) ---> &0) sequentially`, REWRITE_TAC[CONJ_ASSOC; GSYM EVENTUALLY_AND] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[tendsto_real] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ASSUME `eventually (\n. &0 < x n /\ &0 < y n /\ &0 < z n) sequentially`) THEN MP_TAC(ASSUME `((\n. y n / x n) ---> &0) sequentially`) THEN REWRITE_TAC[tendsto_real] THEN DISCH_THEN(MP_TAC o SPEC `e / (&2 * (&1 + abs B))`) THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_HALF; IMP_IMP; GSYM EVENTUALLY_AND] THEN GEN_REWRITE_TAC LAND_CONV [EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN MP_TAC(ASSUME `((\n. inv (z n)) ---> &0) sequentially`) THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_LMUL) THEN DISCH_THEN(MP_TAC o SPEC `e / (&2 * (&1 + abs B)) * abs(sum(1..N) x) + abs(sum(1..N) y)`) THEN REWRITE_TAC[REAL_MUL_RZERO; tendsto_real; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MP_TAC(ASSUME `eventually (\n. abs (sum (1..n) x / z n) <= B) sequentially`) THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `1 <= N + 1 /\ N <= n` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `!x. abs(x) / z(n:num) = abs(x / z n)` (fun th -> REWRITE_TAC[th]) THENL [ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ARITH `&0 < n ==> abs n = n`; ARITH_RULE `N + 1 <= n ==> N <= n`]; ALL_TAC] THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM real_div] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!y'. abs(y) <= y' /\ abs(x) + y' < e ==> abs(x + y) < e`) THEN EXISTS_TAC `e / (&2 * (&1 + abs B)) * sum(N+1..n) x / z n` THEN CONJ_TAC THENL [REWRITE_TAC[real_div; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_ABS_LE THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ABS_MUL; REAL_ABS_INV; REAL_ARITH `&0 < n ==> abs n = n`; ARITH_RULE `N + 1 <= n ==> N <= n`; REAL_LE_RMUL_EQ; REAL_LT_INV_EQ; REAL_MUL_ASSOC; GSYM REAL_LE_LDIV_EQ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ abs x < y ==> x <= y`) THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; ARITH_RULE `N + 1 <= n ==> N <= n`]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(d * abs xN + abs yN) < e / &2 ==> d * abs xN = abs(d * xN) /\ abs(d * xN + xn) <= e / &2 ==> abs(yN) + xn < e`)) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM; GSYM REAL_ADD_LDISTRIB; REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < n ==> abs n = n`; REAL_ARITH `abs(&1 + abs B) = &1 + abs B`] THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `(e * inv(&2) * i) * x = (e * inv(&2)) * x * i`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs B`] THEN ASM_REAL_ARITH_TAC);; let REALLIM_MUL_SERIES_LIM = prove (`!x y z l. eventually (\n. &0 < x n) sequentially /\ eventually (\n. &0 < y n) sequentially /\ eventually (\n. &0 < z n) sequentially /\ ((\n. inv(z n)) ---> &0) sequentially /\ ((\n. sum (1..n) x / z(n)) ---> l) sequentially /\ ((\n. y(n) / x(n)) ---> &0) sequentially ==> ((\n. sum (1..n) y / z(n)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_MUL_SERIES THEN EXISTS_TAC `x:num->real` THEN MP_TAC(MATCH_MP REAL_CONVERGENT_IMP_BOUNDED (ASSUME `((\n. sum (1..n) x / z n) ---> l) sequentially`)) THEN REWRITE_TAC[real_bounded] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[ALWAYS_EVENTUALLY; FORALL_IN_IMAGE; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Finally, the Prime Number Theorem! *) (* ------------------------------------------------------------------------- *) let PNT = prove (`((\n. &(CARD {p | prime p /\ p <= n}) / (&n / log(&n))) ---> &1) sequentially`, REWRITE_TAC[PNT_PARTIAL_SUMMATION] THEN REWRITE_TAC[SUM_PARTIAL_PRE] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; SUB_REFL; CONJUNCT1 LE] THEN SUBGOAL_THEN `{p | prime p /\ p = 0} = {}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN MESON_TAC[PRIME_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[SUM_CLAUSES; REAL_MUL_RZERO; REAL_SUB_RZERO] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. ((&n + &1) / log(&n + &1) * sum {p | prime p /\ p <= n} (\p. log(&p) / &p) - sum (1..n) (\k. sum {p | prime p /\ p <= k} (\p. log(&p) / &p) * ((&k + &1) / log(&k + &1) - &k / log(&k)))) / (&n / log(&n))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REALLIM_TRANSFORM THEN EXISTS_TAC `\n. ((&n + &1) / log(&n + &1) * log(&n) - sum (1..n) (\k. log(&k) * ((&k + &1) / log(&k + &1) - &k / log(&k)))) / (&n / log(&n))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `(a * x - s) / b - (a * x' - s') / b:real = ((s' - s) - (x' - x) * a) / b`] THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN MATCH_MP_TAC SUM_PARTIAL_LIMIT_ALT THEN EXISTS_TAC `&1` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `16` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[MERTENS_LIMIT] THEN REWRITE_TAC[REAL_INV_DIV] THEN SIMP_TAC[REAL_LT_DIV; LOG_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `16 <= n ==> 0 < n /\ 1 < n`] THEN REWRITE_TAC[REALLIM_LOG_OVER_N] THEN CONJ_TAC THENL [ALL_TAC; MP_TAC(CONJ REALLIM_LOG_OVER_LOG1 (SPEC `&1` REALLIM_NA_OVER_N)) THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_MUL) THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_ADD_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_MUL_AC]] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MP_TAC(SPECL [`\z. z / clog z`; `\z. inv(clog z) - inv(clog z) pow 2`; `Cx(&n)`; `Cx(&n + &1)`] COMPLEX_MVT_LINE) THEN REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN REWRITE_TAC[REAL_ARITH `~(n + &1 <= x /\ x <= n)`] THEN ANTS_TAC THENL [X_GEN_TAC `z:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `~(z = Cx(&0))` MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_ARITH `&16 <= x ==> &0 < x`] THEN REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC LOG_POS_LT THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:complex` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SUBGOAL_THEN `&0 < Re z /\ &0 < &n /\ &0 < &n + &1` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_POW; GSYM CX_INV; GSYM CX_SUB; GSYM CX_DIV; RE_CX; GSYM CX_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_LE] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_SUB; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_ARITH `x pow 2 <= x <=> x * x <= x * &1`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC LOG_POS THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN ONCE_REWRITE_TAC[SUM_PARTIAL_SUC] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. ((&n + &1) / log(&n + &1) * (log(&n) - log(&n + &1)) + sum(1..n) (\k. (&k + &1) / log(&k + &1) * (log(&k + &1) - log(&k)))) / (&n / log(&n))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[REAL_OF_NUM_ADD; LOG_1; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_SEQ_OFFSET_REV THEN EXISTS_TAC `1` THEN REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC i`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `a * (x - y) + s + a * (y - x):real = s`] THEN MATCH_MP_TAC REALLIM_TRANSFORM THEN EXISTS_TAC `\n. sum(1..n) (\k. &1 / log(&k + &1) - &1 / log(&k + &1) pow 2) / ((&n + &1) / log(&n + &1))` THEN REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC REALLIM_TRANSFORM_STRADDLE THEN EXISTS_TAC `\n. ((&n + &2) / log (&n + &2) + (sum(1..15) (\k. &1 / log(&k + &1) - &1 / log(&k + &1) pow 2) - &17 / log (&17))) / ((&n + &1) / log (&n + &1))` THEN EXISTS_TAC `\n. ((&n + &1) / log(&n + &1) + (sum(1..15) (\k. &1 / log(&k + &1) - &1 / log(&k + &1) pow 2) - &16 / log (&16))) / ((&n + &1) / log (&n + &1))` THEN MP_TAC(GEN `n:num` (ISPECL [`\z. Cx(&1) / clog(z + Cx(&1)) - Cx(&1) / (clog(z + Cx(&1))) pow 2`; `\z. (z + Cx(&1)) / clog(z + Cx(&1))`; `16`; `n:num`] SUM_INTEGRAL_BOUNDS_DECREASING)) THEN MATCH_MP_TAC(MESON[] `(!n. P n ==> Q n) /\ ((!n. P n ==> R n) ==> s) ==> (!n. P n /\ Q n ==> R n) ==> s`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN DISCH_TAC THEN CONJ_TAC THENL [X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN STRIP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[RE_ADD; RE_CX; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `~(z + Cx(&1) = Cx(&0))` MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN SIMP_TAC[RE_ADD; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[GSYM CX_ADD; GSYM CX_LOG; RE_CX; REAL_CX; REAL_ARITH `&15 <= z ==> &0 < z + &1`; CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC LOG_POS_LT THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `&15 <= y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_ADD; GSYM CX_LOG; RE_CX; REAL_ARITH `&15 <= x ==> &0 < x + &1`] THEN REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; RE_CX; GSYM CX_POW] THEN REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_POW_INV] THEN REWRITE_TAC[REAL_ARITH `x - x pow 2 <= y - y pow 2 <=> (x + y) * (y - x) <= &1 * (y - x)`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN MATCH_MP_TAC(REAL_ARITH `x <= inv(&2) /\ y <= x ==> y + x <= &1 /\ &0 <= x - y`) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC LOG_POS_LT THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [REWRITE_TAC[GSYM real_div]; REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LOG_POS THEN REAL_ARITH_TAC] THEN SUBGOAL_THEN `1 <= 15 + 1 /\ 15 <= n` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o C MATCH_MP (ASSUME `16 <= n`)) THEN REWRITE_TAC[GSYM CX_ADD; REAL_ARITH `(n + &1) + &1 = n + &2`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; ARITH; REAL_ARITH `&0 < &n + &1 /\ &0 < &n + &2`] THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN REAL_ARITH_TAC; REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ADD_RDISTRIB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL [MP_TAC(CONJ REALLIM_LOG_OVER_LOG1 (SPEC `&1` REALLIM_NA_OVER_N)) THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_MUL) THEN REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP REAL_SEQ_OFFSET) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_ADD_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[GSYM real_div; REAL_INV_DIV] THEN MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_LOG_OVER_N)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD]; REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [REWRITE_TAC[GSYM real_div]; REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LOG_POS THEN REAL_ARITH_TAC] THEN SUBGOAL_THEN `1 <= 15 + 1 /\ 15 <= n` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN FIRST_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP (ASSUME `16 <= n`)) THEN REWRITE_TAC[GSYM CX_ADD; REAL_ARITH `(n + &1) + &1 = n + &2`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; ARITH; REAL_ARITH `&0 < &n + &1 /\ &0 < &n + &2`] THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN REAL_ARITH_TAC; REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ADD_RDISTRIB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n:num. &1` THEN REWRITE_TAC[REALLIM_CONST] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < log(&n + &1)` ASSUME_TAC THENL [ALL_TAC; POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD] THEN MATCH_MP_TAC LOG_POS_LT THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[GSYM real_div; REAL_INV_DIV] THEN MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_LOG_OVER_N)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD]]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN EXISTS_TAC `\n. sum(1..n) (\k. &1 / log(&k + &1) pow 2 + &2 / (&k * log(&k + &1))) / ((&n + &1) / log(&n + &1))` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL [EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_INV_DIV; REAL_ARITH `abs x <= x <=> &0 <= x`] THEN MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL [MATCH_MP_TAC LOG_POS; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ abs(a - b) <= y ==> abs(a - x - b) <= x + y`) THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC LOG_POS THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&1 / l - m1 / l * x:real = --((m1 * x - &1) / l)`] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_MUL; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[GSYM real_div; ADHOC_BOUND_LEMMA] THEN REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`; REAL_LE_INV_EQ] THEN MATCH_MP_TAC LOG_POS THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN EXISTS_TAC `\n. sum(1..n) (\k. &3 / log(&k + &1) pow 2) / ((&n + &1) / log(&n + &1))` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL [EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_INV_DIV; REAL_ARITH `abs x <= x <=> &0 <= x`] THEN MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL [MATCH_MP_TAC LOG_POS; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ y <= x ==> abs(&1 * x + &2 * y) <= &3 * x`) THEN SUBGOAL_THEN `&0 < log(&m + &1)` ASSUME_TAC THENL [MATCH_MP_TAC LOG_POS_LT THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_POW_2; REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC LOG_LE THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN REWRITE_TAC[real_div; SUM_LMUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REALLIM_MUL_SERIES_LIM THEN MAP_EVERY EXISTS_TAC [`\n. &1 / log(&n + &1) - &1 / log(&n + &1) pow 2`; `&1`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LT_INV2 THEN SUBGOAL_THEN `&1 < log(&n + &1)` (fun th -> SIMP_TAC[th; REAL_ARITH `&1 < x ==> &0 < x`; REAL_SUB_LT; REAL_LT_MUL; REAL_ARITH `x < x pow 2 <=> &0 < x * (x - &1)`]) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC LOG_MONO_LT_IMP THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[REAL_LT_INV_EQ; LOG_POS_LT; REAL_POW_LT; REAL_ARITH `&1 <= x ==> &1 < x + &1`; REAL_OF_NUM_LE]; REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[REAL_LT_INV_EQ; LOG_POS_LT; REAL_POW_LT; REAL_ARITH `&1 <= x ==> &1 < x + &1`; REAL_OF_NUM_LE; REAL_LT_DIV; REAL_ARITH `&0 < &n + &1`]; MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_LOG_OVER_N)) THEN REWRITE_TAC[REAL_INV_DIV; GSYM REAL_OF_NUM_ADD]; ALL_TAC] THEN MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN EXISTS_TAC `\n. &2 / log(&n + &1)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_1_OVER_LOG)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD]] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `42` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `&2 < log(&n + &1)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC LOG_MONO_LT_IMP THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_INV; REAL_ABS_POW; REAL_ARITH `&2 < x ==> abs x = x`] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_ARITH `&2 < x ==> &0 < x`] THEN ASM_SIMP_TAC[REAL_FIELD `&2 < l ==> (inv(l) * &2) * l pow 2 = inv(inv(&2 * l))`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_INV_MUL; real_div; GSYM REAL_POW_INV; REAL_MUL_LID] THEN MATCH_MP_TAC(REAL_ARITH `l pow 2 <= l / &2 ==> inv(&2) * l <= abs(l - l pow 2)`) THEN REWRITE_TAC[REAL_ARITH `l pow 2 <= l / &2 <=> &0 <= (&1 / &2 - l) * l`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_SUB_LE; ARITH_RULE `&2 < x ==> &0 <= x`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC);; hol-light/100/polyhedron.ml000066400000000000000000003321011303454263000157620ustar00rootroot00000000000000(* ========================================================================= *) (* Formalization of Jim Lawrence's proof of Euler's relation. *) (* ========================================================================= *) needs "Multivariate/polytope.ml";; needs "Library/binomial.ml";; needs "100/inclusion_exclusion.ml";; needs "100/combinations.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Interpret which "side" of a hyperplane a point is on. *) (* ------------------------------------------------------------------------- *) let hyperplane_side = new_definition `hyperplane_side (a,b) (x:real^N) = real_sgn (a dot x - b)`;; (* ------------------------------------------------------------------------- *) (* Equivalence relation imposed by a hyperplane arrangement. *) (* ------------------------------------------------------------------------- *) let hyperplane_equiv = new_definition `hyperplane_equiv A x y <=> !h. h IN A ==> hyperplane_side h x = hyperplane_side h y`;; let HYPERPLANE_EQUIV_REFL = prove (`!A x. hyperplane_equiv A x x`, REWRITE_TAC[hyperplane_equiv]);; let HYPERPLANE_EQUIV_SYM = prove (`!A x y. hyperplane_equiv A x y <=> hyperplane_equiv A y x`, REWRITE_TAC[hyperplane_equiv; EQ_SYM_EQ]);; let HYPERPLANE_EQUIV_TRANS = prove (`!A x y z. hyperplane_equiv A x y /\ hyperplane_equiv A y z ==> hyperplane_equiv A x z`, REWRITE_TAC[hyperplane_equiv] THEN MESON_TAC[]);; let HYPERPLANE_EQUIV_UNION = prove (`!A B x y. hyperplane_equiv (A UNION B) x y <=> hyperplane_equiv A x y /\ hyperplane_equiv B x y`, REWRITE_TAC[hyperplane_equiv; IN_UNION] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cells of a hyperplane arrangement. *) (* ------------------------------------------------------------------------- *) let hyperplane_cell = new_definition `hyperplane_cell A c <=> ?x. c = hyperplane_equiv A x`;; let HYPERPLANE_CELL = prove (`hyperplane_cell A c <=> ?x. c = {y | hyperplane_equiv A x y}`, REWRITE_TAC[EXTENSION; hyperplane_cell; IN_ELIM_THM; IN] THEN MESON_TAC[]);; let NOT_HYPERPLANE_CELL_EMPTY = prove (`!A. ~(hyperplane_cell A {})`, REWRITE_TAC[hyperplane_cell; EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[HYPERPLANE_EQUIV_REFL; IN]);; let NONEMPTY_HYPERPLANE_CELL = prove (`!A c. hyperplane_cell A c ==> ~(c = {})`, MESON_TAC[NOT_HYPERPLANE_CELL_EMPTY]);; let UNIONS_HYPERPLANE_CELLS = prove (`!A. UNIONS {c | hyperplane_cell A c} = (:real^N)`, REWRITE_TAC[EXTENSION; IN_UNIONS; IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[hyperplane_cell] THEN MESON_TAC[HYPERPLANE_EQUIV_REFL; IN]);; let DISJOINT_HYPERPLANE_CELLS = prove (`!A c1 c2. hyperplane_cell A c1 /\ hyperplane_cell A c2 /\ ~(c1 = c2) ==> DISJOINT c1 c2`, REWRITE_TAC[hyperplane_cell] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN ASM_REWRITE_TAC[IN_DISJOINT; IN; EXTENSION] THEN ASM_MESON_TAC[HYPERPLANE_EQUIV_TRANS; HYPERPLANE_EQUIV_SYM]);; let DISJOINT_HYPERPLANE_CELLS_EQ = prove (`!A c1 c2. hyperplane_cell A c1 /\ hyperplane_cell A c2 ==> (DISJOINT c1 c2 <=> ~(c1 = c2))`, MESON_TAC[NONEMPTY_HYPERPLANE_CELL; DISJOINT_HYPERPLANE_CELLS; SET_RULE `DISJOINT s s <=> s = {}`]);; let HYPERPLANE_CELL_EMPTY = prove (`hyperplane_cell {} c <=> c = (:real^N)`, REWRITE_TAC[HYPERPLANE_CELL; NOT_IN_EMPTY; hyperplane_equiv] THEN SET_TAC[]);; let HYPERPLANE_CELL_SING_CASES = prove (`!a b c:real^N->bool. hyperplane_cell {(a,b)} c ==> c = {x | a dot x = b} \/ c = {x | a dot x < b} \/ c = {x | a dot x > b}`, REWRITE_TAC[HYPERPLANE_CELL; hyperplane_equiv] THEN REWRITE_TAC[FORALL_UNWIND_THM2; IN_SING; hyperplane_side] THEN REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC (SPEC `(a:real^N) dot y - b` REAL_SGN_CASES) THEN ASM_REWRITE_TAC[REAL_SGN_EQ] THEN SIMP_TAC[REAL_SUB_0; REAL_SUB_LT; real_gt; REAL_ARITH `x - y < &0 <=> x < y`]);; let HYPERPLANE_CELL_SING = prove (`!a b c. hyperplane_cell {(a,b)} c <=> if a = vec 0 then c = (:real^N) else c = {x | a dot x = b} \/ c = {x | a dot x < b} \/ c = {x | a dot x > b}`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [REWRITE_TAC[hyperplane_cell; hyperplane_equiv; EXTENSION; IN_UNIV] THEN REWRITE_TAC[IN] THEN REWRITE_TAC[hyperplane_equiv] THEN ASM_SIMP_TAC[IN_SING; FORALL_UNWIND_THM2] THEN REWRITE_TAC[hyperplane_side; DOT_LZERO]; EQ_TAC THEN REWRITE_TAC[HYPERPLANE_CELL_SING_CASES] THEN STRIP_TAC THEN ASM_REWRITE_TAC[hyperplane_cell; EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN] THEN REWRITE_TAC[hyperplane_equiv] THEN ASM_SIMP_TAC[IN_SING; FORALL_UNWIND_THM2] THEN REWRITE_TAC[hyperplane_side] THEN ONCE_REWRITE_TAC[REAL_ARITH `a dot x = b <=> a dot x - b = &0`; REAL_ARITH `a > b <=> a - b > &0`; REAL_ARITH `a < b <=> a - b < &0`] THEN ONCE_REWRITE_TAC[GSYM REAL_SGN_EQ] THEN REWRITE_TAC[REAL_SUB_0] THEN MATCH_MP_TAC(MESON[] `(?x. f x = a) ==> (?x. !y. f y = a <=> f x = f y)`) THEN REWRITE_TAC[REAL_SGN_EQ] THENL [EXISTS_TAC `b / (a dot a) % a:real^N`; EXISTS_TAC `(b - &1) / (a dot a) % a:real^N`; EXISTS_TAC `(b + &1) / (a dot a) % a:real^N`] THEN ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);; let HYPERPLANE_CELL_UNION = prove (`!A B c:real^N->bool. hyperplane_cell (A UNION B) c <=> ~(c = {}) /\ ?c1 c2. hyperplane_cell A c1 /\ hyperplane_cell B c2 /\ c = c1 INTER c2`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N->bool = {}` THENL [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[HYPERPLANE_CELL; HYPERPLANE_EQUIV_UNION] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REWRITE_TAC[MESON[] `(?c1 c2. (?x. c1 = f x) /\ (?y. c2 = g y) /\ P c1 c2) <=> (?x y. P (f x) (g y))`] THEN EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN MESON_TAC[HYPERPLANE_EQUIV_TRANS; HYPERPLANE_EQUIV_SYM]);; let FINITE_HYPERPLANE_CELLS = prove (`!A. FINITE A ==> FINITE {c:real^N->bool | hyperplane_cell A c}`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[HYPERPLANE_CELL_EMPTY; SING_GSPEC; FINITE_SING] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `A:(real^N#real)->bool`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{ c1 INTER c2:real^N->bool | c1 IN {c | hyperplane_cell A c} /\ c2 IN {c | hyperplane_cell {(a,b)} c}}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{{x:real^N | a dot x = b},{x | a dot x < b},{x | a dot x > b}}` THEN REWRITE_TAC[SUBSET; IN_SING; HYPERPLANE_CELL_SING_CASES; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY; FINITE_INSERT; FINITE_EMPTY]; REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN MESON_TAC[INTER_COMM]]);; let FINITE_RESTRICT_HYPERPLANE_CELLS = prove (`!P A. FINITE A ==> FINITE {c:real^N->bool | hyperplane_cell A c /\ P c}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{c:real^N->bool | hyperplane_cell A c}` THEN ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLS] THEN SET_TAC[]);; let FINITE_SET_OF_HYPERPLANE_CELLS = prove (`!A C. FINITE A /\ (!c:real^N->bool. c IN C ==> hyperplane_cell A c) ==> FINITE C`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{c:real^N->bool | hyperplane_cell A c}` THEN ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLS] THEN ASM SET_TAC[]);; let PAIRWISE_DISJOINT_HYPERPLANE_CELLS = prove (`!A C. (!c. c IN C ==> hyperplane_cell A c) ==> pairwise DISJOINT C`, REWRITE_TAC[pairwise] THEN MESON_TAC[DISJOINT_HYPERPLANE_CELLS]);; let HYPERPLANE_CELL_INTER_OPEN_AFFINE = prove (`!A c:real^N->bool. FINITE A /\ hyperplane_cell A c ==> ?s t. open s /\ affine t /\ c = s INTER t`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [REWRITE_TAC[HYPERPLANE_CELL_EMPTY] THEN REPEAT STRIP_TAC THEN REPEAT(EXISTS_TAC `(:real^N)`) THEN ASM_REWRITE_TAC[AFFINE_UNIV; OPEN_UNIV; INTER_UNIV]; ALL_TAC] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `A:real^N#real->bool`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN X_GEN_TAC `c':real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c1:real^N->bool`; `c:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN REWRITE_TAC[HYPERPLANE_CELL_SING] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THENL [MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN ASM_REWRITE_TAC[INTER_UNIV]; MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `{x:real^N | a dot x = b} INTER t`] THEN ASM_REWRITE_TAC[INTER_ACI] THEN MATCH_MP_TAC AFFINE_INTER THEN ASM_REWRITE_TAC[AFFINE_HYPERPLANE]; MAP_EVERY EXISTS_TAC [`{x:real^N | a dot x < b} INTER s`; `t:real^N->bool`] THEN ASM_REWRITE_TAC[INTER_ACI] THEN MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[OPEN_HALFSPACE_LT]; MAP_EVERY EXISTS_TAC [`{x:real^N | a dot x > b} INTER s`; `t:real^N->bool`] THEN ASM_REWRITE_TAC[INTER_ACI] THEN MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[OPEN_HALFSPACE_GT]]);; let HYPERPLANE_CELL_RELATIVELY_OPEN = prove (`!A c:real^N->bool. FINITE A /\ hyperplane_cell A c ==> open_in (subtopology euclidean (affine hull c)) c`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HYPERPLANE_CELL_INTER_OPEN_AFFINE) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THEN ASM_REWRITE_TAC[OPEN_IN_EMPTY] THEN SUBGOAL_THEN `affine hull (s INTER t:real^N->bool) = t` SUBST1_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `affine hull t:real^N->bool` THEN ASM_REWRITE_TAC[AFFINE_HULL_EQ] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[INTER_COMM] AFFINE_HULL_CONVEX_INTER_OPEN) THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX]; ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]]);; let HYPERPLANE_CELL_RELATIVE_INTERIOR = prove (`!A c:real^N->bool. FINITE A /\ hyperplane_cell A c ==> relative_interior c = c`, MESON_TAC[RELATIVE_INTERIOR_OPEN_IN; HYPERPLANE_CELL_RELATIVELY_OPEN]);; let HYPERPLANE_CELL_CONVEX = prove (`!A c:real^N->bool. hyperplane_cell A c ==> convex c`, REPEAT GEN_TAC THEN REWRITE_TAC[HYPERPLANE_CELL] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` SUBST1_TAC) THEN REWRITE_TAC[hyperplane_equiv] THEN ONCE_REWRITE_TAC[SET_RULE `f x = f y <=> y IN {y | f x = f y}`] THEN REWRITE_TAC[GSYM INTERS_IMAGE] THEN MATCH_MP_TAC CONVEX_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[hyperplane_side] THEN REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC (SPEC `(a:real^N) dot c - b` REAL_SGN_CASES) THEN ASM_REWRITE_TAC[REAL_SGN_EQ] THEN SIMP_TAC[REAL_SUB_0; REAL_ARITH `a - b > &0 <=> a > b`; REAL_ARITH `a - b < &0 <=> a < b`] THEN REWRITE_TAC[CONVEX_HALFSPACE_LT; CONVEX_HALFSPACE_GT; CONVEX_HYPERPLANE]);; let HYPERPLANE_CELL_INTERS = prove (`!A C. (!c:real^N->bool. c IN C ==> hyperplane_cell A c) /\ ~(C = {}) /\ ~(INTERS C = {}) ==> hyperplane_cell A (INTERS C)`, REPEAT GEN_TAC THEN REWRITE_TAC[HYPERPLANE_CELL; GSYM MEMBER_NOT_EMPTY] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_INTERS] THEN DISCH_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_TAC `c:real^N->bool`); X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[HYPERPLANE_EQUIV_SYM; HYPERPLANE_EQUIV_TRANS]);; let HYPERPLANE_CELL_INTER = prove (`!A s t:real^N->bool. hyperplane_cell A s /\ hyperplane_cell A t /\ ~(s INTER t = {}) ==> hyperplane_cell A (s INTER t)`, REWRITE_TAC[GSYM INTERS_2] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HYPERPLANE_CELL_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; NOT_INSERT_EMPTY]);; (* ------------------------------------------------------------------------- *) (* A cell complex is considered to be a union of such cells. *) (* ------------------------------------------------------------------------- *) let hyperplane_cellcomplex = new_definition `hyperplane_cellcomplex A s <=> ?t. (!c. c IN t ==> hyperplane_cell A c) /\ s = UNIONS t`;; let HYPERPLANE_CELLCOMPLEX_EMPTY = prove (`!A:real^N#real->bool. hyperplane_cellcomplex A {}`, GEN_TAC THEN REWRITE_TAC[hyperplane_cellcomplex] THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0]);; let HYPERPLANE_CELL_CELLCOMPLEX = prove (`!A c:real^N->bool. hyperplane_cell A c ==> hyperplane_cellcomplex A c`, REPEAT STRIP_TAC THEN REWRITE_TAC[hyperplane_cellcomplex] THEN EXISTS_TAC `{c:real^N->bool}` THEN ASM_SIMP_TAC[IN_SING; UNIONS_1]);; let HYPERPLANE_CELLCOMPLEX_UNIONS = prove (`!A C. (!s:real^N->bool. s IN C ==> hyperplane_cellcomplex A s) ==> hyperplane_cellcomplex A (UNIONS C)`, REPEAT GEN_TAC THEN REWRITE_TAC[hyperplane_cellcomplex] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:(real^N->bool)->(real^N->bool)->bool` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (f:(real^N->bool)->(real^N->bool)->bool) C)` THEN REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[UNIONS_IMAGE]] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN ASM SET_TAC[]);; let HYPERPLANE_CELLCOMPLEX_UNION = prove (`!A s t. hyperplane_cellcomplex A s /\ hyperplane_cellcomplex A t ==> hyperplane_cellcomplex A (s UNION t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let HYPERPLANE_CELLCOMPLEX_UNIV = prove (`!A. hyperplane_cellcomplex A (:real^N)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_HYPERPLANE_CELLS] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN REWRITE_TAC[IN_ELIM_THM; HYPERPLANE_CELL_CELLCOMPLEX]);; let HYPERPLANE_CELLCOMPLEX_INTERS = prove (`!A C. (!s:real^N->bool. s IN C ==> hyperplane_cellcomplex A s) ==> hyperplane_cellcomplex A (INTERS C)`, let lemma = prove (`UNIONS s = UNIONS {t | t IN s /\ ~(t = {})}`, REWRITE_TAC[UNIONS_GSPEC] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[NOT_IN_EMPTY]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `C:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; HYPERPLANE_CELLCOMPLEX_UNIV] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [hyperplane_cellcomplex] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:(real^N->bool)->(real^N->bool)->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `C = {UNIONS((f:(real^N->bool)->(real^N->bool)->bool) s) | s IN C}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTERS_OVER_UNIONS] THEN ONCE_REWRITE_TAC[lemma] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HYPERPLANE_CELL_CELLCOMPLEX THEN MATCH_MP_TAC HYPERPLANE_CELL_INTERS THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]);; let HYPERPLANE_CELLCOMPLEX_INTER = prove (`!A s t. hyperplane_cellcomplex A s /\ hyperplane_cellcomplex A t ==> hyperplane_cellcomplex A (s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let HYPERPLANE_CELLCOMPLEX_COMPL = prove (`!A s. hyperplane_cellcomplex A s ==> hyperplane_cellcomplex A ((:real^N) DIFF s)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [hyperplane_cellcomplex] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `C:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[UNIONS_INTERS; COMPL_COMPL] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `(:real^N) DIFF c = UNIONS {c' | hyperplane_cell A c' /\ ~(c' = c)}` SUBST1_TAC THENL [SUBST1_TAC(SYM(ISPEC `A:real^N#real->bool` UNIONS_HYPERPLANE_CELLS)) THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `c':real^N->bool` THEN REWRITE_TAC[] THEN MP_TAC(ISPECL [`A:real^N#real->bool`; `c:real^N->bool`; `c':real^N->bool`] DISJOINT_HYPERPLANE_CELLS_EQ) THEN ASM_SIMP_TAC[] THEN SET_TAC[]; MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX; IN_ELIM_THM]]);; let HYPERPLANE_CELLCOMPLEX_DIFF = prove (`!A s t. hyperplane_cellcomplex A s /\ hyperplane_cellcomplex A t ==> hyperplane_cellcomplex A (s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[HYPERPLANE_CELLCOMPLEX_COMPL; HYPERPLANE_CELLCOMPLEX_INTER]);; let HYPERPLANE_CELLCOMPLEX_MONO = prove (`!A B s:real^N->bool. hyperplane_cellcomplex A s /\ A SUBSET B ==> hyperplane_cellcomplex B s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [hyperplane_cellcomplex]) THEN DISCH_THEN(X_CHOOSE_THEN `C:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `B:(real^N#real)->bool = A UNION (B DIFF A)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[hyperplane_cellcomplex; HYPERPLANE_CELL_UNION] THEN EXISTS_TAC `{c' INTER c:real^N->bool |c'| hyperplane_cell (B DIFF A) c' /\ ~(c' INTER c = {})}` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `c':real^N->bool`] THEN ASM_REWRITE_TAC[INTER_COMM]; GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [DISCH_TAC; MESON_TAC[]] THEN MP_TAC(ISPEC `B DIFF A:(real^N#real)->bool` UNIONS_HYPERPLANE_CELLS) THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN ASM SET_TAC[]]);; let FINITE_HYPERPLANE_CELLCOMPLEXES = prove (`!A. FINITE A ==> FINITE {c:real^N->bool | hyperplane_cellcomplex A c}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE UNIONS {t | t SUBSET {c:real^N->bool | hyperplane_cell A c}}` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET; FINITE_HYPERPLANE_CELLS] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM; hyperplane_cellcomplex] THEN MESON_TAC[]);; let FINITE_RESTRICT_HYPERPLANE_CELLCOMPLEXES = prove (`!P A. FINITE A ==> FINITE {c:real^N->bool | hyperplane_cellcomplex A c /\ P c}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{c:real^N->bool | hyperplane_cellcomplex A c}` THEN ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLCOMPLEXES] THEN SET_TAC[]);; let FINITE_SET_OF_HYPERPLANE_CELLS = prove (`!A C. FINITE A /\ (!c:real^N->bool. c IN C ==> hyperplane_cellcomplex A c) ==> FINITE C`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{c:real^N->bool | hyperplane_cellcomplex A c}` THEN ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLCOMPLEXES] THEN ASM SET_TAC[]);; let CELL_SUBSET_CELLCOMPLEX = prove (`!A s c:real^N->bool. hyperplane_cell A c /\ hyperplane_cellcomplex A s ==> (c SUBSET s <=> ~(DISJOINT c s))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [hyperplane_cellcomplex]) THEN DISCH_THEN(X_CHOOSE_THEN `C:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN EQ_TAC THENL [ASM_CASES_TAC `c:real^N->bool = {}` THENL [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ASM SET_TAC[]]; REWRITE_TAC[DISJOINT; INTER_UNIONS; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `c':real^N->bool`] THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN MP_TAC(ISPECL [`A:(real^N#real)->bool`; `c:real^N->bool`; `c':real^N->bool`] DISJOINT_HYPERPLANE_CELLS_EQ) THEN ASM_SIMP_TAC[] THEN ASM_CASES_TAC `c':real^N->bool = c` THENL [DISCH_THEN(K ALL_TAC); ASM SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `c IN C ==> c SUBSET UNIONS C`) THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Euler characteristic. *) (* ------------------------------------------------------------------------- *) let euler_characteristic = new_definition `euler_characteristic A (s:real^N->bool) = sum {c | hyperplane_cell A c /\ c SUBSET s} (\c. (-- &1) pow (num_of_int(aff_dim c)))`;; let EULER_CHARACTERISTIC_EMPTY = prove (`euler_characteristic A {} = &0`, REWRITE_TAC[euler_characteristic; SUBSET_EMPTY] THEN MATCH_MP_TAC SUM_EQ_0 THEN MATCH_MP_TAC(MESON[] `~(?x. x IN s) ==> (!x. x IN s ==> P x)`) THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[NONEMPTY_HYPERPLANE_CELL]);; let EULER_CHARACTERISTIC_CELL_UNIONS = prove (`!A C. (!c:real^N->bool. c IN C ==> hyperplane_cell A c) ==> euler_characteristic A (UNIONS C) = sum C (\c. (-- &1) pow (num_of_int(aff_dim c)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[euler_characteristic] THEN MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N->bool` THEN EQ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `~(c:real^N->bool = {})` MP_TAC THENL [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ALL_TAC] THEN REWRITE_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_UNIONS] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c':real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(DISJOINT (c:real^N->bool) c')` MP_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[DISJOINT_HYPERPLANE_CELLS_EQ]]);; let EULER_CHARACTERISTIC_CELL = prove (`!A c. hyperplane_cell A c ==> euler_characteristic A c = (-- &1) pow (num_of_int(aff_dim c))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM UNIONS_1] THEN ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELL_UNIONS; IN_SING; SUM_SING]);; let EULER_CHARACTERISTIC_CELLCOMPLEX_UNION = prove (`!A s t:real^N->bool. FINITE A /\ hyperplane_cellcomplex A s /\ hyperplane_cellcomplex A t /\ DISJOINT s t ==> euler_characteristic A (s UNION t) = euler_characteristic A s + euler_characteristic A t`, REPEAT STRIP_TAC THEN REWRITE_TAC[euler_characteristic] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT_HYPERPLANE_CELLS] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNION] THEN CONJ_TAC THEN X_GEN_TAC `c:real^N->bool` THENL [ASM_CASES_TAC `c:real^N->bool = {}` THENL [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ASM SET_TAC[]]; ASM_CASES_TAC `hyperplane_cell A (c:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `A:(real^N#real)->bool` CELL_SUBSET_CELLCOMPLEX) THEN ASM_SIMP_TAC[HYPERPLANE_CELLCOMPLEX_UNION] THEN SET_TAC[]]);; let EULER_CHARACTERISTIC_CELLCOMPLEX_UNIONS = prove (`!A C. FINITE A /\ (!c:real^N->bool. c IN C ==> hyperplane_cellcomplex A c) /\ pairwise DISJOINT C ==> euler_characteristic A (UNIONS C) = sum C (\c. euler_characteristic A c)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `FINITE(C:(real^N->bool)->bool)` THENL [UNDISCH_TAC `FINITE(C:(real^N->bool)->bool)`; ASM_MESON_TAC[FINITE_SET_OF_HYPERPLANE_CELLS]] THEN SPEC_TAC(`C:(real^N->bool)->bool`,`C:(real^N->bool)->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[EULER_CHARACTERISTIC_EMPTY; SUM_CLAUSES; UNIONS_0] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS_INSERT] THEN W(MP_TAC o PART_MATCH (lhs o rand) EULER_CHARACTERISTIC_CELLCOMPLEX_UNION o lhs o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[DISJOINT; INTER_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[INTER_COMM]]; DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN ASM_REWRITE_TAC[pairwise] THEN ASM SET_TAC[]]);; let EULER_CHARACTERISTIC = prove (`!A s:real^N->bool. FINITE A ==> euler_characteristic A s = sum (0..dimindex(:N)) (\d. (-- &1) pow d * &(CARD {c | hyperplane_cell A c /\ c SUBSET s /\ aff_dim c = &d}))`, REPEAT STRIP_TAC THEN REWRITE_TAC[euler_characteristic] THEN MP_TAC(ISPECL [`\c:real^N->bool. aff_dim c`; `\c:real^N->bool. (-- &1) pow (num_of_int(aff_dim c))`; `{c:real^N->bool | hyperplane_cell A c /\ c SUBSET s}`; `IMAGE int_of_num (0..dimindex(:N))`] SUM_GROUP) THEN SIMP_TAC[SUM_IMAGE; INT_OF_NUM_EQ; o_DEF; NUM_OF_INT_OF_NUM] THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT_HYPERPLANE_CELLS] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0] THEN REWRITE_TAC[GSYM INT_OF_NUM_LE; INT_EXISTS_POS] THEN EXISTS_TAC `aff_dim(c:real^N->bool)` THEN REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_POS_LE] THEN ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC] THEN ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT_HYPERPLANE_CELLS] THEN REWRITE_TAC[REAL_MUL_AC]]);; (* ------------------------------------------------------------------------- *) (* Show that the characteristic is invariant w.r.t. hyperplane arrangement. *) (* ------------------------------------------------------------------------- *) let HYPERPLANE_CELLS_DISTINCT_LEMMA = prove (`!a b. {x | a dot x = b} INTER {x | a dot x < b} = {} /\ {x | a dot x = b} INTER {x | a dot x > b} = {} /\ {x | a dot x < b} INTER {x | a dot x = b} = {} /\ {x | a dot x < b} INTER {x | a dot x > b} = {} /\ {x | a dot x > b} INTER {x | a dot x = b} = {} /\ {x | a dot x > b} INTER {x | a dot x < b} = {}`, REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let EULER_CHARACTERSTIC_LEMMA = prove (`!A h s:real^N->bool. FINITE A /\ hyperplane_cellcomplex A s ==> euler_characteristic (h INSERT A) s = euler_characteristic A s`, REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`A:(real^N#real)->bool`; `a:real^N`; `b:real`; `s:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[hyperplane_cellcomplex] THEN DISCH_THEN(X_CHOOSE_THEN `C:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `!c:real^N->bool. c IN C ==> hyperplane_cellcomplex A c /\ hyperplane_cellcomplex ((a,b) INSERT A) c` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN EXISTS_TAC `A:(real^N#real)->bool` THEN ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `pairwise DISJOINT (C:(real^N->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[PAIRWISE_DISJOINT_HYPERPLANE_CELLS]; ALL_TAC] THEN ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELLCOMPLEX_UNIONS; FINITE_INSERT] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `hyperplane_cell ((a,b) INSERT A) (c:real^N->bool)` THEN ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELL] THEN SUBGOAL_THEN `~(a:real^N = vec 0)` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN SIMP_TAC[CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN REWRITE_TAC[HYPERPLANE_CELL_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN CONJ_TAC THENL [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[INTER_UNIV; UNWIND_THM1] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[euler_characteristic] THEN ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {c' INTER c |c'| hyperplane_cell {(a,b)} c' /\ ~(c' INTER c = {})} (\c:real^N->bool. (-- &1) pow (num_of_int(aff_dim c)))` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `c':real^N->bool` THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c1:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `c2:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(DISJOINT c2 (c:real^N->bool))` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[DISJOINT_HYPERPLANE_CELLS_EQ]]; DISCH_THEN(X_CHOOSE_THEN `c1:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN MAP_EVERY EXISTS_TAC [`c1:real^N->bool`; `c:real^N->bool`] THEN ASM_SIMP_TAC[]]; ALL_TAC] THEN ASM_REWRITE_TAC[HYPERPLANE_CELL_SING] THEN SUBGOAL_THEN `~(c:real^N->bool = {})` ASSUME_TAC THENL [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ALL_TAC] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {c} (\c:real^N->bool. (-- &1) pow num_of_int (aff_dim c))` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUM_SING]] THEN MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `c':real^N->bool` THEN REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2; GSYM CONJ_ASSOC] THEN EQ_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN MP_TAC(ISPECL [`a:real^N`; `b:real`] HYPERPLANE_CELLS_DISTINCT_LEMMA) THEN ASM SET_TAC[]; ALL_TAC]) [`c SUBSET {x:real^N | a dot x < b}`; `c SUBSET {x:real^N | a dot x > b}`; `c SUBSET {x:real^N | a dot x = b}`] THEN SUBGOAL_THEN `~(c INTER {x:real^N | a dot x = b} = {})` ASSUME_TAC THENL [SUBGOAL_THEN `?u v:real^N. u IN c /\ ~(a dot u < b) /\ v IN c /\ ~(a dot v > b)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[real_gt; REAL_NOT_LT; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN SIMP_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `(a:real^N) dot u = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(a:real^N) dot v = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `v + (b - a dot v) / (a dot u - a dot v) % (u - v):real^N` THEN SUBGOAL_THEN `(a:real^N) dot v < a dot u` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[DOT_RADD; DOT_RMUL; DOT_RSUB; REAL_DIV_RMUL; REAL_SUB_LT; REAL_LT_IMP_NZ; REAL_SUB_ADD2] THEN REWRITE_TAC[VECTOR_ARITH `v + a % (u - v):real^N = (&1 - a) % v + a % u`] THEN MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_MESON_TAC[HYPERPLANE_CELL_CONVEX]; ALL_TAC] THEN SUBGOAL_THEN `~(c INTER {x:real^N | a dot x < b} = {}) /\ ~(c INTER {x:real^N | a dot x > b} = {})` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?u v:real^N. u IN c /\ a dot u = b /\ v IN c /\ ~(a dot v = b) /\ ~(u = v)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean (affine hull c)) (c:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[HYPERPLANE_CELL_RELATIVELY_OPEN]; ALL_TAC] THEN REWRITE_TAC[open_in] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `u:real^N`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `u - e / &2 / norm(v - u) % (v - u):real^N`)) THEN ANTS_TAC THENL [REWRITE_TAC[NORM_ARITH `dist(u - a:real^N,u) = norm a`] THEN REWRITE_TAC[VECTOR_ARITH `x - a % (y - z):real^N = x + a % (z - y)`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REWRITE_TAC[REAL_ARITH `abs e / &2 < e <=> &0 < e`] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC]; DISCH_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN SUBGOAL_THEN `(a:real^N) dot v < b \/ a dot v > b` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `u - e / &2 / norm(v - u) % (v - u):real^N` THEN ASM_REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN REWRITE_TAC[REAL_ARITH `b - x * y > b <=> &0 < x * --y`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]] THEN EXISTS_TAC `u - e / &2 / norm(v - u) % (v - u):real^N` THEN ASM_REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN REWRITE_TAC[REAL_ARITH `b - x * y > b <=> &0 < x * --y`; REAL_ARITH `b - x < b <=> &0 < x`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {{x | a dot x = b} INTER c, {x | a dot x > b} INTER c, {x | a dot x < b} INTER c} (\c:real^N->bool. (-- &1) pow (num_of_int(aff_dim c)))` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `c':real^N->bool` THEN REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC TAUT; ALL_TAC] THEN SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_SIMP_TAC[HYPERPLANE_CELLS_DISTINCT_LEMMA; REAL_ADD_RID; SET_RULE `s INTER t = {} /\ ~(c INTER s = {}) ==> ~(c INTER s = c INTER t)`] THEN SUBGOAL_THEN `aff_dim (c INTER {x:real^N | a dot x < b}) = aff_dim c /\ aff_dim (c INTER {x:real^N | a dot x > b}) = aff_dim c` (CONJUNCTS_THEN SUBST1_TAC) THENL [ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN CONJ_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN ASM_REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN ASM_MESON_TAC[HYPERPLANE_CELL_CONVEX]; ALL_TAC] THEN SUBGOAL_THEN `aff_dim c = aff_dim(c INTER {x:real^N | a dot x = b}) + &1` SUBST1_TAC THENL [MP_TAC(ISPECL [`A:real^N#real->bool`; `c:real^N->bool`] HYPERPLANE_CELL_INTER_OPEN_AFFINE) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SUBGOAL_THEN `affine hull (s INTER t) = affine hull t /\ affine hull ((s INTER t) INTER {x:real^N | a dot x = b}) = affine hull (t INTER {x:real^N | a dot x = b})` (CONJUNCTS_THEN SUBST1_TAC) THENL [REWRITE_TAC[INTER_ASSOC] THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM] THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; AFFINE_IMP_CONVEX] THEN ASM SET_TAC[]; REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_SUB_ADD]) THEN ASM SET_TAC[]]; SUBGOAL_THEN `&0 <= aff_dim (c INTER {x:real^N | a dot x = b})` MP_TAC THENL [REWRITE_TAC[AFF_DIM_POS_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN SPEC_TAC(`aff_dim (c INTER {x:real^N | a dot x = b})`,`i:int`) THEN REWRITE_TAC[GSYM INT_FORALL_POS] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM; INT_OF_NUM_ADD] THEN REWRITE_TAC[REAL_POW_ADD] THEN REAL_ARITH_TAC]);; let EULER_CHARACTERSTIC_INVARIANT = prove (`!A B h s:real^N->bool. FINITE A /\ FINITE B /\ hyperplane_cellcomplex A s /\ hyperplane_cellcomplex B s ==> euler_characteristic A s = euler_characteristic B s`, SUBGOAL_THEN `!A s:real^N->bool. FINITE A /\ hyperplane_cellcomplex A s ==> !B. FINITE B ==> euler_characteristic (A UNION B) s = euler_characteristic A s` ASSUME_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_REWRITE_TAC[UNION_EMPTY] THEN MAP_EVERY X_GEN_TAC [`h:real^N#real`; `B:real^N#real->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN REWRITE_TAC[SET_RULE `s UNION (x INSERT t) = x INSERT (s UNION t)`] THEN MATCH_MP_TAC EULER_CHARACTERSTIC_LEMMA THEN ASM_REWRITE_TAC[FINITE_UNION] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN EXISTS_TAC `A:real^N#real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `euler_characteristic (A UNION B) (s:real^N->bool)` THEN ASM_MESON_TAC[UNION_COMM]]);; let EULER_CHARACTERISTIC_INCLUSION_EXCLUSION = prove (`!A s:(real^N->bool)->bool. FINITE A /\ FINITE s /\ (!k. k IN s ==> hyperplane_cellcomplex A k) ==> euler_characteristic A (UNIONS s) = sum {t | t SUBSET s /\ ~(t = {})} (\t. (-- &1) pow (CARD t + 1) * euler_characteristic A (INTERS t))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`hyperplane_cellcomplex A :(real^N->bool)->bool`; `euler_characteristic A :(real^N->bool)->real`; `s:(real^N->bool)->bool`] INCLUSION_EXCLUSION_REAL_RESTRICTED) THEN ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELLCOMPLEX_UNION] THEN SIMP_TAC[HYPERPLANE_CELLCOMPLEX_EMPTY; HYPERPLANE_CELLCOMPLEX_INTER; HYPERPLANE_CELLCOMPLEX_UNION; HYPERPLANE_CELLCOMPLEX_DIFF]);; (* ------------------------------------------------------------------------- *) (* Euler-type relation for full-dimensional proper polyhedral cones. *) (* ------------------------------------------------------------------------- *) let EULER_POLYHEDRAL_CONE = prove (`!s. polyhedron s /\ conic s /\ ~(interior s = {}) /\ ~(s = (:real^N)) ==> sum (0..dimindex(:N)) (\d. (-- &1) pow d * &(CARD {f | f face_of s /\ aff_dim f = &d })) = &0`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `affine hull s = (:real^N)` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ s SUBSET t ==> t = UNIV`) THEN EXISTS_TAC `affine hull (interior s:real^N->bool)` THEN SIMP_TAC[INTERIOR_SUBSET; HULL_MONO] THEN MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]; ALL_TAC] THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN ASM_REWRITE_TAC[INTER_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `H:(real^N->bool)->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(vec 0:real^N) IN s` ASSUME_TAC THENL [ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN ASM_MESON_TAC[SUBSET_EMPTY; INTERIOR_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!h:real^N->bool. h IN H ==> ?a. ~(a = vec 0) /\ h = {x | a dot x <= &0}` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `b = &0` SUBST_ALL_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= b /\ ~(&0 < b) ==> b = &0`) THEN CONJ_TAC THENL [SUBGOAL_THEN `(vec 0:real^N) IN INTERS H` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTERS]] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `H DELETE (h:real^N->bool)`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[PSUBSET_ALT]] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC o CONJUNCT2) THEN SUBGOAL_THEN `?e. &0 < e /\ e < &1 /\ (e % x:real^N) IN h` STRIP_ASSUME_TAC THENL [EXISTS_TAC `min (&1 / &2) (b / ((a:real^N) dot x))` THEN ASM_REWRITE_TAC[IN_ELIM_THM; DOT_RMUL] THEN SUBGOAL_THEN `&0 < (a:real^N) dot x` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~((x:real^N) IN s)` THEN EXPAND_TAC "s" THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `H:(real^N->bool)->bool = h INSERT (H DELETE h)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTERS_INSERT; IN_INTER] THEN ASM_REWRITE_TAC[IN_ELIM_THM]; ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_MIN_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC]; UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `x:real^N = inv e % e % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[conic]) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_INV_EQ] THEN EXPAND_TAC "s" THEN SUBGOAL_THEN `H:(real^N->bool)->bool = h INSERT (H DELETE h)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTERS_INSERT; IN_INTER] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN UNDISCH_TAC `(x:real^N) IN INTERS (H DELETE h)` THEN REWRITE_TAC[IN_INTERS] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:real^N->bool` THEN REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a':real^N`; `b':real`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(REAL_ARITH `(&0 <= x ==> y <= x) /\ (&0 <= --x ==> &0 <= --y) /\ &0 <= b ==> x <= b ==> y <= b`) THEN REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_ARITH `e * x <= x <=> &0 <= x * (&1 - e)`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN SUBGOAL_THEN `(vec 0:real^N) IN INTERS H` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTERS]] THEN DISCH_THEN(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]]]; FIRST_X_ASSUM(K ALL_TAC o SPEC `h:real^N->bool`)] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `fa:(real^N->bool)->real^N` THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o funpow 2 RAND_CONV) [EQ_SYM_EQ] THEN DISCH_TAC THEN ABBREV_TAC `A = IMAGE (\h. (fa:(real^N->bool)->real^N) h,&0) H` THEN SUBGOAL_THEN `FINITE(A:real^N#real->bool)` ASSUME_TAC THENL [EXPAND_TAC "A" THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `euler_characteristic A (s:real^N->bool)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[EULER_CHARACTERISTIC] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT_HYPERPLANE_CELLS] THEN EXISTS_TAC `relative_interior:(real^N->bool)->(real^N->bool)` THEN EXISTS_TAC `closure:(real^N->bool)->(real^N->bool)` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `f:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `closure(relative_interior f):real^N->bool = f` ASSUME_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `closure f:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_CLOSURE_RELATIVE_INTERIOR THEN ASM_MESON_TAC[FACE_OF_IMP_CONVEX]; REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC FACE_OF_IMP_CLOSED THEN ASM_MESON_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX]]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ONCE_REWRITE_TAC[GSYM AFFINE_HULL_CLOSURE] THEN ASM_REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET_TRANS; FACE_OF_IMP_SUBSET]] THEN SUBGOAL_THEN `~(f:real^N->bool = {})` ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM AFF_DIM_POS_LE; INT_POS]; ALL_TAC] THEN SUBGOAL_THEN `?J. J SUBSET H /\ f = INTERS {{x:real^N | fa h dot x <= &0} | h IN H} INTER INTERS {{x | fa(h:real^N->bool) dot x = &0} | h IN J}` ASSUME_TAC THENL [ASM_CASES_TAC `f:real^N->bool = s` THENL [EXISTS_TAC `{}:(real^N->bool)->bool` THEN REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY; INTERS_0; INTER_UNIV; SET_RULE `{f x | x | F} = {}`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SYM(ASSUME `INTERS H = (s:real^N->bool)`)] THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = x) ==> s = {f x | x IN s}`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN EXISTS_TAC `{h:real^N->bool | h IN H /\ f SUBSET s INTER {x:real^N | fa h dot x = &0}}` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `H:(real^N->bool)->bool`; `fa:(real^N->bool)->real^N`; `\h:real^N->bool. &0`] FACE_OF_POLYHEDRON_EXPLICIT) THEN ASM_SIMP_TAC[INTER_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `f:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `INTERS {{x:real^N | fa(h:real^N->bool) dot x <= &0} | h IN H} = s` ASSUME_TAC THENL [EXPAND_TAC "s" THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = x) ==> {f x | x IN s} = s`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `{h:real^N->bool | h IN H /\ f SUBSET s INTER {x:real^N | fa h dot x = &0}} = {}` THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; INTERS_0] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_INTER] THEN ASM_CASES_TAC `(y:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `H' = IMAGE (\h:real^N->bool. {x:real^N | --(fa h) dot x <= &0}) H` THEN SUBGOAL_THEN `?J. FINITE J /\ J SUBSET (H UNION H') /\ f:real^N->bool = affine hull f INTER INTERS J` MP_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `J:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `H UNION IMAGE (\h:real^N->bool. {x:real^N | --(fa h) dot x <= &0}) J` THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[FINITE_UNION] THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_MESON_TAC[FINITE_SUBSET]; EXPAND_TAC "H'" THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `s SUBSET f /\ s = t ==> s = f INTER t`) THEN REWRITE_TAC[HULL_SUBSET] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REWRITE_TAC[INTERS_UNION] THEN MATCH_MP_TAC(SET_RULE `s = s' /\ (!x. x IN s ==> (x IN t <=> x IN t')) ==> s INTER t = s' INTER t'`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = x) ==> {f x | x IN s} = s`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTERS] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; DOT_LNEG] THEN REWRITE_TAC[REAL_ARITH `--x <= &0 <=> &0 <= x`] THEN ASM SET_TAC[]]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [MESON[HAS_SIZE] `(?f. FINITE f /\ P f) <=> (?n f. f HAS_SIZE n /\ P f)`] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `nn:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `J:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!J'. J' PSUBSET J ==> (f:real^N->bool) PSUBSET (affine hull f INTER INTERS J')` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(J':(real^N->bool)->bool)`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CARD_PSUBSET; HAS_SIZE]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM; HAS_SIZE] THEN DISCH_THEN(MP_TAC o SPEC `J':(real^N->bool)->bool`) THEN MATCH_MP_TAC(TAUT `a /\ b /\ (~c ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN CONJ_TAC THENL [ASM_MESON_TAC[PSUBSET; FINITE_SUBSET; HAS_SIZE]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = t) ==> s PSUBSET t`) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!h:real^N->bool. h IN J ==> ?a. {x | a dot x <= &0} = h /\ (h IN H /\ a = fa h \/ ?h'. h' IN H /\ a = --(fa h'))` MP_TAC THENL [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `(h:real^N->bool) IN (H UNION H')` MP_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "H'"] THEN UNDISCH_THEN `(h:real^N->bool) IN J` (K ALL_TAC) THEN SPEC_TAC(`h:real^N->bool`,`h:real^N->bool`) THEN REWRITE_TAC[IN_UNION; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`; FORALL_AND_THM; FORALL_IN_IMAGE] THEN CONJ_TAC THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THENL [EXISTS_TAC `(fa:(real^N->bool)->real^N) h` THEN ASM_SIMP_TAC[]; EXISTS_TAC `--((fa:(real^N->bool)->real^N) h)` THEN REWRITE_TAC[] THEN DISJ2_TAC THEN ASM_MESON_TAC[]]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `ga:(real^N->bool)->real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->bool`; `J:(real^N->bool)->bool`; `ga:(real^N->bool)->real^N`; `\h:real^N->bool. &0`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ASM_MESON_TAC[]; ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_NEG_EQ_0; SUBSET]]; DISCH_TAC THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `!h:real^N->bool. h IN J ==> h IN H /\ ga h:real^N = fa h` ASSUME_TAC THENL [SUBGOAL_THEN `~(relative_interior f:real^N->bool = {})` MP_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; FACE_OF_IMP_CONVEX]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN SUBGOAL_THEN `(z:real^N) IN f /\ z IN s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; FACE_OF_IMP_SUBSET; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `h':real^N->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(z:real^N) IN relative_interior f` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[DOT_LNEG] THEN UNDISCH_TAC `(z:real^N) IN s` THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h':real^N->bool`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `h':real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM(CONJUNCT2 th)]) THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th] THEN MP_TAC(SYM th)) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `K:(real^N->bool)->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC(SYM th) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[IN_INTER; IN_INTERS; FORALL_IN_GSPEC; GSYM CONJ_ASSOC] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `~(relative_interior f:real^N->bool = {})` ASSUME_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; FACE_OF_IMP_CONVEX]; ALL_TAC] THEN SUBGOAL_THEN `DISJOINT (J:(real^N->bool)->bool) K` ASSUME_TAC THENL [UNDISCH_TAC `~(relative_interior f:real^N->bool = {})` THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN REWRITE_TAC[IN_DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN SUBGOAL_THEN `relative_interior f = INTERS {(if (h:real^N->bool) IN J then {x | fa h dot x < &0} else if h IN K then {x:real^N | fa h dot x = &0} else if relative_interior f SUBSET {x | fa h dot x = &0} then {x | fa h dot x = &0} else {x | fa h dot x < &0}) | h IN H}` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; AND_FORALL_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN ASM_CASES_TAC `(h:real^N->bool) IN H` THENL [ALL_TAC; DISCH_THEN(K ALL_TAC) THEN ASM SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(h:real^N->bool) IN J` THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE] THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(h:real^N->bool) IN K` THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_REFL] THEN COND_CASES_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC] THEN GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN REPEAT(COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_LE] THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SET_RULE `~(s SUBSET t) <=> ?y. y IN s /\ ~(y IN t)`]) THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x:real = &0) ==> ~(x <= &0) \/ x < &0`)) THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ASSUME `(x:real^N) IN relative_interior f`) THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[SUBSET; IN_INTER; IN_CBALL] THEN SUBGOAL_THEN `~(y:real^N = x)` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `x + e / norm(y - x) % (x - y):real^N`) THEN SUBGOAL_THEN `(x:real^N) IN affine hull f /\ y IN affine hull f` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET; HULL_SUBSET]; ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL]] THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + r) = norm r`] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_SUB; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN SUBGOAL_THEN `(x + e / norm(y - x) % (x - y):real^N) IN s` MP_TAC THENL [ASM_MESON_TAC[SUBSET; FACE_OF_IMP_SUBSET]; ALL_TAC] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM(CONJUNCT2(MATCH_MP th (ASSUME `(h:real^N->bool) IN H`)))]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; DOT_RADD; REAL_ADD_LID; DOT_RMUL] THEN ASM_REWRITE_TAC[DOT_RSUB; REAL_SUB_LZERO; REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `~(relative_interior f:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; hyperplane_cell] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN GEN_REWRITE_TAC RAND_CONV [EXTENSION] THEN ONCE_ASM_REWRITE_TAC[] THEN EXPAND_TAC "A" THEN REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN MP_TAC th) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [IN] THEN REWRITE_TAC[hyperplane_equiv; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(MESON[] `(!h. P h ==> (Q h <=> R h)) ==> (!h. P h) ==> ((!h. Q h) <=> (!h. R h))`) THEN X_GEN_TAC `h:real^N->bool` THEN ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[hyperplane_side; REAL_SUB_RZERO] THEN REPEAT(COND_CASES_TAC THEN SIMP_TAC[IN_ELIM_THM] THENL [MESON_TAC[REAL_SGN_EQ]; ALL_TAC]) THEN MESON_TAC[REAL_SGN_EQ]; X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN REWRITE_TAC[AFFINE_HULL_CLOSURE] THEN ASM_REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `relative_interior c:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_RELATIVE_INTERIOR_CLOSURE THEN ASM_MESON_TAC[HYPERPLANE_CELL_CONVEX]; ASM_MESON_TAC[HYPERPLANE_CELL_RELATIVE_INTERIOR]]] THEN SUBGOAL_THEN `?J. J SUBSET H /\ c = INTERS {{x | (fa(h:real^N->bool)) dot x < &0} | h IN J} INTER INTERS {{x:real^N | (fa h) dot x = &0} | h IN (H DIFF J)}` MP_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HYPERPLANE_CELL]) THEN EXPAND_TAC "A" THEN REWRITE_TAC[hyperplane_equiv; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REWRITE_TAC[hyperplane_side; REAL_SUB_RZERO] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN EXISTS_TAC `{h:real^N->bool | h IN H /\ real_sgn(fa h dot (z:real^N)) = -- &1}` THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} SUBSET s`] THEN REWRITE_TAC[GSYM INTERS_UNION] THEN EXPAND_TAC "c" THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM; IN_INTERS] THEN REWRITE_TAC[IN_UNION] THEN REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`; FORALL_AND_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN REWRITE_TAC[TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN REWRITE_TAC[AND_FORALL_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `h:real^N->bool` THEN ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `(fa:(real^N->bool)->real^N) h dot z` REAL_SGN_CASES) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SGN_EQ] THEN SUBGOAL_THEN `?x:real^N. x IN c /\ x IN s` MP_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; NONEMPTY_HYPERPLANE_CELL]; MATCH_MP_TAC(TAUT `~p ==> p ==> q`)] THEN MAP_EVERY EXPAND_TAC ["s"; "c"] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM; NOT_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[REAL_SGN_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN EXPAND_TAC "c" THEN W(MP_TAC o PART_MATCH (lhand o rand) CLOSURE_INTER_CONVEX o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[CONVEX_INTERS; FORALL_IN_GSPEC; CONVEX_HALFSPACE_LT; CONVEX_HYPERPLANE] THEN W(MP_TAC o PART_MATCH (lhand o rand) RELATIVE_INTERIOR_OPEN o lhand o lhand o rand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC OPEN_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_HALFSPACE_LT] THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_MESON_TAC[FINITE_SUBSET]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) RELATIVE_INTERIOR_OPEN_IN o rand o lhand o rand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC(MESON[OPEN_IN_SUBTOPOLOGY_REFL] `s SUBSET topspace tp /\ t = s ==> open_in (subtopology tp t) s`) THEN REWRITE_TAC[SUBSET_UNIV; TOPSPACE_EUCLIDEAN] THEN REWRITE_TAC[AFFINE_HULL_EQ] THEN SIMP_TAC[AFFINE_INTERS; AFFINE_HYPERPLANE; FORALL_IN_GSPEC]; DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[CLOSURE_INTERS_CONVEX_OPEN; FORALL_IN_GSPEC; CONVEX_HALFSPACE_LT; OPEN_HALFSPACE_LT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_FACE_OF; INTER_EMPTY] THEN SUBGOAL_THEN `IMAGE closure {{x | fa h dot x < &0} | h IN J} = {{x | (fa:(real^N->bool)->real^N) h dot x <= &0} | h IN J}` SUBST1_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC CLOSURE_HALFSPACE_LT THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `closure (INTERS {{x | fa h dot x = &0} | h IN H DIFF J}) = INTERS {{x | (fa:(real^N->bool)->real^N) h dot x = &0} | h IN H DIFF J}` SUBST1_TAC THENL [REWRITE_TAC[CLOSURE_EQ] THEN SIMP_TAC[CLOSED_INTERS; FORALL_IN_GSPEC; CLOSED_HYPERPLANE]; ALL_TAC] THEN ASM_CASES_TAC `J:(real^N->bool)->bool = H` THENL [ASM_REWRITE_TAC[DIFF_EQ_EMPTY; INTER_UNIV; NOT_IN_EMPTY; SET_RULE `{f x | x | F} = {}`; INTERS_0] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_REFL o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN EXPAND_TAC "s" THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = x) ==> s = {f x | x IN s}`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `INTERS {{x | fa(h:real^N->bool) dot x <= &0} | h IN J} INTER INTERS {{x:real^N | fa h dot x = &0} | h IN H DIFF J} = INTERS {s INTER {x | fa h dot x = &0} | h IN H DIFF J}` SUBST1_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[INTERS_IMAGE] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_CASES_TAC `(y:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(TAUT `a ==> (a /\ b <=> b)`) THEN UNDISCH_TAC `(y:real^N) IN s` THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; SET_TAC[]]; UNDISCH_TAC `~((y:real^N) IN s)` THEN MATCH_MP_TAC (TAUT `~q /\ (p ==> r) ==> ~r ==> (p <=> q)`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM(CONJUNCT2 th)]) THEN ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN ASM_CASES_TAC `(h:real^N->bool) IN J` THEN ASM_SIMP_TAC[REAL_LE_REFL]]; ALL_TAC] THEN MATCH_MP_TAC FACE_OF_INTERS THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX] THEN X_GEN_TAC `y:real^N` THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM(CONJUNCT2 th)]) THEN REWRITE_TAC[IN_ELIM_THM]]; ALL_TAC] THEN SUBGOAL_THEN `!h. h IN H ==> hyperplane_cellcomplex A ((:real^N) DIFF h)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN EXISTS_TAC `{((fa:(real^N->bool)->real^N) h,&0)}` THEN CONJ_TAC THENL [MATCH_MP_TAC HYPERPLANE_CELL_CELLCOMPLEX THEN ASM_SIMP_TAC[HYPERPLANE_CELL_SING] THEN REPEAT DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM(CONJUNCT2 th)]) THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC; EXPAND_TAC "A" THEN REWRITE_TAC[IN_IMAGE; SUBSET; FORALL_UNWIND_THM2; IN_SING] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!h:real^N->bool. h IN H ==> hyperplane_cellcomplex A h` ASSUME_TAC THENL [ASM_MESON_TAC[HYPERPLANE_CELLCOMPLEX_COMPL; COMPL_COMPL]; ALL_TAC] THEN SUBGOAL_THEN `hyperplane_cellcomplex A (s:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_INTERS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`A:real^N#real->bool`; `INTERS H:real^N->bool`; `(:real^N) DIFF INTERS H`] EULER_CHARACTERISTIC_CELLCOMPLEX_UNION) THEN REWRITE_TAC[SET_RULE `DISJOINT s (UNIV DIFF s)`] THEN ANTS_TAC THENL [ASM_SIMP_TAC[HYPERPLANE_CELLCOMPLEX_DIFF; HYPERPLANE_CELLCOMPLEX_UNIV]; REWRITE_TAC[SET_RULE `s UNION (UNIV DIFF s) = UNIV`]] THEN REWRITE_TAC[DIFF_INTERS] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x = (--(&1)) pow (dimindex(:N)) /\ y = (--(&1)) pow (dimindex(:N)) ==> x = s + y ==> s = &0`) THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `euler_characteristic {} (:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC EULER_CHARACTERSTIC_INVARIANT THEN ASM_REWRITE_TAC[FINITE_EMPTY] THEN CONJ_TAC THENL [MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN EXISTS_TAC `{}:real^N#real->bool` THEN REWRITE_TAC[EMPTY_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC HYPERPLANE_CELL_CELLCOMPLEX THEN REWRITE_TAC[HYPERPLANE_CELL_EMPTY]; SIMP_TAC[EULER_CHARACTERISTIC_CELL; HYPERPLANE_CELL_EMPTY] THEN REWRITE_TAC[AFF_DIM_UNIV; NUM_OF_INT_OF_NUM]]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) EULER_CHARACTERISTIC_INCLUSION_EXCLUSION o lhand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {t | t SUBSET {(:real^N) DIFF t | t IN H} /\ ~(t = {})} (\t. -- &1 pow (CARD t + 1) * (--(&1)) pow (dimindex(:N)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[SIMPLE_IMAGE; IMP_CONJ; FORALL_SUBSET_IMAGE] THEN X_GEN_TAC `J:(real^N->bool)->bool` THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_TAC THEN AP_TERM_TAC THEN ABBREV_TAC `B = IMAGE (\h:real^N->bool. fa h:real^N,&0) J` THEN SUBGOAL_THEN `(B:real^N#real->bool) SUBSET A` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `INTERS (IMAGE (\t. (:real^N) DIFF t) H) = IMAGE (--) (interior s)` ASSUME_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `H:(real^N->bool)->bool`; `fa:(real^N->bool)->real^N`; `\h:real^N->bool. &0`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ASM_SIMP_TAC[INTER_UNIV] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR] THEN DISCH_THEN(K ALL_TAC) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[VECTOR_ARITH `--x:real^N = y <=> x = --y`; EXISTS_REFL] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_DIFF; IN_UNIV] THEN MATCH_MP_TAC(TAUT `(c ==> b) /\ (a <=> c) ==> (a <=> b /\ c)`) THEN CONJ_TAC THENL [EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[REAL_LT_IMP_LE]; MATCH_MP_TAC(MESON[] `(!h. P h ==> (Q h <=> R h)) ==> ((!h. P h ==> Q h) <=> (!h. P h ==> R h))`) THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM(CONJUNCT2(MATCH_MP th (ASSUME `(h:real^N->bool) IN H`)))]) THEN REWRITE_TAC[IN_ELIM_THM; DOT_RNEG] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `hyperplane_cell B (INTERS (IMAGE (\t. (:real^N) DIFF t) J))` ASSUME_TAC THENL [SUBGOAL_THEN `~(INTERS (IMAGE (\t. (:real^N) DIFF t) J) = {})` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[hyperplane_cell; GSYM MEMBER_NOT_EMPTY; IN_INTERS] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_UNIV; IN_DIFF] THEN GEN_REWRITE_TAC RAND_CONV [EXTENSION] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN MP_TAC th) THEN REWRITE_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_DIFF; IN_UNIV] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [IN] THEN REWRITE_TAC[hyperplane_equiv] THEN EXPAND_TAC "B" THEN REWRITE_TAC[FORALL_IN_IMAGE; hyperplane_side] THEN MATCH_MP_TAC(MESON[] `(!h. P h ==> (Q h <=> R h)) ==> (!h. P h) ==> ((!h. Q h) <=> (!h. R h))`) THEN X_GEN_TAC `h:real^N->bool` THEN ASM_CASES_TAC `(h:real^N->bool) IN J` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(h:real^N->bool) IN H` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP (ASSUME `(h:real^N->bool) IN H`)) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO; REAL_NOT_LE] THEN MESON_TAC[REAL_SGN_EQ; real_gt]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `euler_characteristic B (INTERS (IMAGE (\t. (:real^N) DIFF t) J))` THEN CONJ_TAC THENL [MATCH_MP_TAC EULER_CHARACTERSTIC_INVARIANT THEN ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX] THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN EXISTS_TAC `B:real^N#real->bool` THEN ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX]; ALL_TAC] THEN ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELL] THEN AP_TERM_TAC THEN MATCH_MP_TAC(MESON[NUM_OF_INT_OF_NUM] `i = &n ==> num_of_int i = n`) THEN REWRITE_TAC[AFF_DIM_EQ_FULL] THEN MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ t = UNIV ==> s = UNIV`) THEN EXISTS_TAC `affine hull (INTERS (IMAGE (\t. (:real^N) DIFF t) H))` THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY; OPEN_NEGATIONS; OPEN_INTERIOR]; ALL_TAC] THEN REWRITE_TAC[SUM_RMUL] THEN MATCH_MP_TAC(REAL_RING `s = &1 ==> s * t = t`) THEN MP_TAC(ISPECL [`\t:(real^N->bool)->bool. CARD t`; `\t:(real^N->bool)->bool. (-- &1) pow (CARD t + 1)`; `{t | t SUBSET {(:real^N) DIFF t | t IN H} /\ ~(t = {})}`; `1..CARD(H:(real^N->bool)->bool)`] SUM_GROUP) THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{t | t SUBSET {(:real^N) DIFF t | t IN H}}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC FINITE_POWERSET THEN REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE]; GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_NUMSEG] THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_SUBSET_IMAGE; IMP_CONJ] THEN X_GEN_TAC `J:(real^N->bool)->bool` THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_TAC THEN SUBGOAL_THEN `FINITE(J:(real^N->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_EQ_0; FINITE_IMAGE; ARITH_RULE `1 <= n <=> ~(n = 0)`; IMAGE_EQ_EMPTY] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(J:(real^N->bool)->bool)` THEN ASM_SIMP_TAC[CARD_SUBSET; CARD_IMAGE_LE]]; REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (1..CARD(H:(real^N->bool)->bool)) (\n. -- &1 pow (n + 1) * &(binom(CARD H,n)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN SIMP_TAC[IN_ELIM_THM] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_CONST o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{t | t SUBSET {(:real^N) DIFF t | t IN H}}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC FINITE_POWERSET THEN REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE]; DISCH_THEN SUBST1_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `CARD {t | t SUBSET {(:real^N) DIFF t | t IN H} /\ t HAS_SIZE n}` THEN CONJ_TAC THENL [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `t:(real^N->bool)->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `t:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_EMPTY] THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(p ==> r) ==> (p /\ q <=> p /\ r /\ q)`) THEN SPEC_TAC(`t:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_SUBSET_IMAGE] THEN ASM_MESON_TAC[FINITE_IMAGE; FINITE_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`CARD(H:(real^N->bool)->bool)`; `n:num`; `{(:real^N) DIFF t | t IN H}`] NUMBER_OF_COMBINATIONS) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[HAS_SIZE]] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[GSYM FINITE_HAS_SIZE] THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`CARD(H:(real^N->bool)->bool)`; `--(&1)`; `&1`] REAL_BINOMIAL_THEOREM) THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID; REAL_ADD_LINV] THEN SIMP_TAC[SUM_CLAUSES_LEFT; REAL_POW_ADD; REAL_POW_ONE; LE_0] THEN REWRITE_TAC[REAL_ARITH `(x * --(&1) pow 1) * y = --(y * x)`] THEN REWRITE_TAC[real_pow; SUM_NEG; ADD_CLAUSES; REAL_MUL_RID] THEN REWRITE_TAC[binom] THEN MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x = &1 + y ==> --y = &1`) THEN REWRITE_TAC[REAL_POW_ZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `CARD(H:(real^N->bool)->bool) = 0` THEN ASM_SIMP_TAC[CARD_EQ_0] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Euler-Poincare relation for special (n-1)-dimensional polytope. *) (* ------------------------------------------------------------------------- *) let EULER_POINCARE_LEMMA = prove (`!p:real^N->bool. 2 <= dimindex(:N) /\ polytope p /\ affine hull p = {x | x$1 = &1} ==> sum (0..dimindex(:N)-1) (\d. (-- &1) pow d * &(CARD {f | f face_of p /\ aff_dim f = &d })) = &1`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`basis 1:real^N`; `&1`] AFF_DIM_HYPERPLANE) THEN SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN ASM_CASES_TAC `p:real^N->bool = {}` THENL [ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN REWRITE_TAC[INT_ARITH `--(&1):int = x - &1 <=> x = &0`] THEN SIMP_TAC[INT_OF_NUM_EQ; LE_1; DIMINDEX_GE_1]; DISCH_TAC] THEN ABBREV_TAC `s:real^N->bool = conic hull p` THEN MP_TAC(ISPEC `s:real^N->bool` EULER_POLYHEDRAL_CONE) THEN SUBGOAL_THEN `!f. f SUBSET {x:real^N | x$1 = &1} ==> (conic hull f) INTER {x:real^N | x$1 = &1} = f` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[HULL_SUBSET; SUBSET_INTER] THEN REWRITE_TAC[SUBSET; CONIC_HULL_EXPLICIT; IN_INTER; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_RID; VECTOR_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "s" THEN FIRST_X_ASSUM(X_CHOOSE_THEN `k:real^N->bool` MP_TAC o GEN_REWRITE_RULE I [polytope]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> SUBST1_TAC th THEN ASSUME_TAC th) THEN MP_TAC(ISPEC `k:real^N->bool` CONVEX_CONE_HULL_SEPARATE_NONEMPTY) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVEX_HULL_EQ_EMPTY]; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC POLYHEDRON_CONVEX_CONE_HULL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN SUBGOAL_THEN `conic(s:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CONIC_CONIC_HULL]; ALL_TAC] THEN SUBGOAL_THEN `~(s = (:real^N))` ASSUME_TAC THENL [DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^N->bool`) THEN ANTS_TAC THENL [ASM_MESON_TAC[HULL_SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[INTER_UNIV] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `polytope(p:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(lambda i. if i = 1 then &1 else B + &1):real^N`) THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_GE_1; LE_REFL; IN_ELIM_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN MP_TAC(ISPECL [`(lambda i. if i = 1 then &1 else B + &1):real^N`; `2`] COMPONENT_LE_NORM) THEN ASM_SIMP_TAC[ARITH; LAMBDA_BETA; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(s:real^N->bool = {})` ASSUME_TAC THENL [ASM_MESON_TAC[CONIC_HULL_EQ_EMPTY]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^N->bool` CONIC_CONTAINS_0) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `~(interior(s:real^N->bool) = {})` ASSUME_TAC THENL [DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` EMPTY_INTERIOR_SUBSET_HYPERPLANE) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `s SUBSET {x:real^N | x$1 = &1}` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET h' ==> h SUBSET h' /\ ~(h PSUBSET h') ==> s SUBSET h`)) THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HULL_SUBSET]; DISCH_TAC THEN MP_TAC(ISPECL [`a:real^N`; `b:real`] AFF_DIM_HYPERPLANE) THEN MP_TAC(ISPECL [`basis 1:real^N`; `&1`] AFF_DIM_HYPERPLANE) THEN ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC(INT_ARITH `a:int < b ==> a = n ==> ~(b = n)`) THEN MATCH_MP_TAC AFF_DIM_PSUBSET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s PSUBSET t ==> s' = s /\ t' = t ==> s' PSUBSET t'`)) THEN REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_HYPERPLANE] THEN MP_TAC(ISPECL [`basis 1:real^N`; `&1`] AFFINE_HYPERPLANE) THEN SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_GE_1; LE_REFL]]; REWRITE_TAC[SUBSET; NOT_FORALL_THM; NOT_IMP] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM; VEC_COMPONENT] THEN REAL_ARITH_TAC]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!x:real^N. x IN s /\ ~(x = vec 0) ==> &0 < x$1` ASSUME_TAC THENL [EXPAND_TAC "s" THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_GSPEC; VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN affine hull p` MP_TAC THENL [ASM_MESON_TAC[HULL_SUBSET; SUBSET]; ASM_REWRITE_TAC[]] THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_01]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= x$1` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS; REAL_LT_IMP_LE]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_CLAUSES_LEFT o lhand o lhand o snd) THEN REWRITE_TAC[LE_0] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[AFF_DIM_EQ_0; real_pow; REAL_MUL_LID] THEN SUBGOAL_THEN `{f | f face_of s /\ (?a:real^N. f = {a})} = {{vec 0}}` (fun th -> REWRITE_TAC[th]) THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_SING] THEN X_GEN_TAC `f:real^N->bool` THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `a:real^N`)) THEN ASM_REWRITE_TAC[FACE_OF_SING] THEN ASM_MESON_TAC[EXTREME_POINT_OF_CONIC]; DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_REWRITE_TAC[FACE_OF_SING; extreme_point_of; IN_SEGMENT] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `u:real` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VEC_COMPONENT] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SUBGOAL_THEN `&0 < (a:real^N)$1 \/ &0 < (b:real^N)$1` DISJ_CASES_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(&0 = a + b)`); MATCH_MP_TAC(REAL_ARITH `&0 < b /\ &0 <= a ==> ~(&0 = a + b)`)] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LT_MUL; REAL_SUB_LT]]; ALL_TAC] THEN SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY; GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC(REAL_ARITH `s = --t ==> (&0 + &1) + s = &0 ==> t = &1`) THEN SUBGOAL_THEN `dimindex(:N) = (dimindex(:N)-1)+1` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SUM_OFFSET; GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN EXISTS_TAC `\f:real^N->bool. f INTER {x | x$1 = &1}` THEN EXISTS_TAC `\f:real^N->bool. conic hull f` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [DISJ1_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{f:real^N->bool | f face_of s}` THEN ASM_SIMP_TAC[FINITE_POLYHEDRON_FACES] THEN SET_TAC[]; REWRITE_TAC[IN_ELIM_THM; GSYM INT_OF_NUM_ADD]] THEN SUBGOAL_THEN `!f:real^N->bool. f face_of p ==> conic hull f INTER {x | x$1 = &1} = f` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `affine hull p:real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET_TRANS]; ASM_REWRITE_TAC[SUBSET_REFL]]; ASM_SIMP_TAC[]] THEN SUBGOAL_THEN `!f:real^N->bool. f face_of s ==> f INTER {x | x$1 = &1} face_of p` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `p = conic hull p INTER {x:real^N | x$1 = &1}` SUBST1_TAC THENL [ASM_MESON_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]; ALL_TAC] THEN MATCH_MP_TAC FACE_OF_SLICE THEN ASM_REWRITE_TAC[CONVEX_STANDARD_HYPERPLANE]; ASM_SIMP_TAC[]] THEN SUBGOAL_THEN `!f. f face_of s /\ &0 < aff_dim f ==> conic hull (f INTER {x:real^N | x$1 = &1}) = f` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; CONIC_HULL_EXPLICIT; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_CONIC; conic]; REWRITE_TAC[SUBSET; CONIC_HULL_EXPLICIT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [SUBGOAL_THEN `?y:real^N. y IN f /\ ~(y = vec 0)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `a IN s /\ ~(s = {a}) ==> ?y. y IN s /\ ~(y = a)`) THEN ASM_MESON_TAC[AFF_DIM_EQ_0; INT_LT_REFL]; SUBGOAL_THEN `&0 < (y:real^N)$1` ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO] THEN EXISTS_TAC `inv(y$1) % y:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN ASM_MESON_TAC[FACE_OF_CONIC; conic; REAL_LE_INV_EQ; REAL_LT_IMP_LE]]; SUBGOAL_THEN `&0 < (x:real^N)$1` ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN EXISTS_TAC `(x:real^N)$1` THEN EXISTS_TAC `inv(x$1) % x:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV; REAL_LT_IMP_LE; REAL_LT_IMP_NZ; VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN ASM_MESON_TAC[FACE_OF_CONIC; conic; REAL_LE_INV_EQ; REAL_LT_IMP_LE]]]; ASM_SIMP_TAC[INT_ARITH `&0:int < &d + &1`]] THEN SUBGOAL_THEN `!f:real^N->bool. f face_of p ==> (conic hull f) face_of s` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `f:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; EMPTY_FACE_OF] THEN REWRITE_TAC[face_of] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC HULL_MONO THEN ASM_MESON_TAC[FACE_OF_IMP_SUBSET]; ASM_MESON_TAC[CONVEX_CONIC_HULL; FACE_OF_IMP_CONVEX]; ALL_TAC] THEN EXPAND_TAC "s" THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`ca:real`; `a:real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`cb:real`; `b:real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`cx:real`; `x:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `cx % x:real^N = vec 0` THENL [ASM_REWRITE_TAC[IN_SEGMENT] THEN MATCH_MP_TAC(TAUT `(a ==> ~b) ==> a /\ b ==> c`) THEN DISCH_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VEC_COMPONENT] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN ONCE_REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN SUBGOAL_THEN `&0 < (ca % a:real^N)$1 \/ &0 < (cb % b:real^N)$1` DISJ_CASES_TAC THENL [SUBGOAL_THEN `(ca % a:real^N) IN s /\ (cb % b:real^N) IN s` (fun th -> ASM_MESON_TAC[th]) THEN ASM_MESON_TAC[conic; HULL_SUBSET; SUBSET]; MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(&0 = a + b)`); MATCH_MP_TAC(REAL_ARITH `&0 < b /\ &0 <= a ==> ~(&0 = a + b)`)] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LT_MUL; REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_SUB_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[conic; HULL_SUBSET; SUBSET]; ALL_TAC] THEN UNDISCH_TAC `~(cx % x:real^N = vec 0)` THEN REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = a` THENL [REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` MP_TAC)) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH `x % a:real^N = y % a + z % b <=> (x - y) % a = z % b`] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN SUBGOAL_THEN `(a:real^N) IN affine hull p /\ b IN affine hull p` MP_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`ca:real`; `a:real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL]]; CONJ_TAC THENL [EXISTS_TAC `ca:real`; EXISTS_TAC `cb:real`] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `x:real^N = b` THENL [REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` MP_TAC)) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH `x % b:real^N = y % a + z % b <=> (x - z) % b = y % a`] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN SUBGOAL_THEN `(a:real^N) IN affine hull p /\ b IN affine hull p` MP_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_ENTIRE; REAL_LT_IMP_NE; REAL_SUB_0] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL]; MAP_EVERY EXISTS_TAC [`cb:real`; `b:real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; CONJ_TAC THENL [EXISTS_TAC `ca:real`; EXISTS_TAC `cb:real`] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^N) IN segment(a,b)` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_OPEN_SEGMENT]) THEN ASM_REWRITE_TAC[IN_OPEN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SUBGOAL_THEN `(x:real^N) IN affine hull p /\ a IN affine hull p /\ b IN affine hull p` MP_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THEN REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN DISCH_THEN(MP_TAC o AP_TERM `(%) (inv cx) :real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `inv(cx) * u * cb` THEN REWRITE_TAC[REAL_ARITH `inv(cx) * x:real = x / cx`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_LE] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a + b = cx ==> &0 <= a ==> b <= &1 * cx`)) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB] THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MAP_EVERY UNDISCH_TAC [`(&1 - u) * ca + u * cb = cx`; `~(cx = &0)`] THEN CONV_TAC REAL_FIELD]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [face_of]) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `x:real^N`]) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]; ASM_SIMP_TAC[]] THEN SUBGOAL_THEN `!f:real^N->bool. f face_of p /\ ~(f = {}) ==> aff_dim(conic hull f) = aff_dim f + &1` (LABEL_TAC "*") THENL [ALL_TAC; CONJ_TAC THEN X_GEN_TAC `f:real^N->bool` THEN STRIP_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `f INTER {x:real^N | x$1 = &1}`) THEN ASM_SIMP_TAC[INT_ARITH `&0:int < &d + &1`; INT_EQ_ADD_RCANCEL] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN SUBGOAL_THEN `?y:real^N. y IN f /\ ~(y = vec 0)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `a IN s /\ ~(s = {a}) ==> ?y. y IN s /\ ~(y = a)`) THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] FACE_OF_CONIC) THEN ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN REPEAT DISCH_TAC; DISCH_TAC] THEN UNDISCH_TAC `aff_dim(f:real^N->bool) = &d + &1` THEN ASM_REWRITE_TAC[AFF_DIM_SING; AFF_DIM_EMPTY] THEN INT_ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN SUBGOAL_THEN `&0 < (y:real^N)$1` ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN EXISTS_TAC `inv(y$1) % y:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] FACE_OF_CONIC) THEN ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN REWRITE_TAC[conic] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]]; REMOVE_THEN "*" (MP_TAC o SPEC `f:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN DISCH_TAC THEN UNDISCH_TAC `aff_dim(f:real^N->bool) = &d` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN INT_ARITH_TAC]] THEN X_GEN_TAC `f:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC(INT_ARITH `f < a /\ a <= f + &1 ==> a:int = f + &1`) THEN CONJ_TAC THENL [MATCH_MP_TAC AFF_DIM_PSUBSET THEN SIMP_TAC[PSUBSET; HULL_MONO; HULL_SUBSET] THEN REWRITE_TAC[EXTENSION; NOT_FORALL_THM] THEN EXISTS_TAC `vec 0:real^N` THEN MATCH_MP_TAC(TAUT `~p /\ q ==> ~(p <=> q)`) THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. ~(x IN t) /\ s SUBSET t ==> ~(x IN s)`) THEN EXISTS_TAC `affine hull p:real^N->bool` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_ELIM_THM; VEC_COMPONENT] THEN REAL_ARITH_TAC; MATCH_MP_TAC HULL_MONO THEN ASM_MESON_TAC[FACE_OF_IMP_SUBSET]]; MATCH_MP_TAC(SET_RULE `x IN s /\ s SUBSET P hull s ==> x IN P hull s`) THEN ASM_SIMP_TAC[CONIC_CONTAINS_0; HULL_SUBSET; CONIC_CONIC_HULL] THEN ASM_REWRITE_TAC[CONIC_HULL_EQ_EMPTY]]; MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim((vec 0:real^N) INSERT (affine hull f))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[AFF_DIM_INSERT; AFF_DIM_AFFINE_HULL] THEN INT_ARITH_TAC] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL; SUBSET; CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `c % x:real^N = vec 0 + c % (x - vec 0)`] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC; IN_INSERT]]);; let EULER_POINCARE_SPECIAL = prove (`!p:real^N->bool. 2 <= dimindex(:N) /\ polytope p /\ affine hull p = {x | x$1 = &0} ==> sum (0..dimindex(:N)-1) (\d. (-- &1) pow d * &(CARD {f | f face_of p /\ aff_dim f = &d })) = &1`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^N. basis 1 + x) p` EULER_POINCARE_LEMMA) THEN ASM_REWRITE_TAC[POLYTOPE_TRANSLATION_EQ; AFFINE_HULL_TRANSLATION] THEN ANTS_TAC THENL [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[EXISTS_REFL; VECTOR_ARITH `a + x:real^N = y <=> x = y - a`] THEN SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC; REWRITE_TAC[SET_RULE `{f | f face_of s /\ P f} = {f | f IN {f | f face_of s} /\ P f}`] THEN REWRITE_TAC[FACES_OF_TRANSLATION] THEN REWRITE_TAC[SET_RULE `{y | y IN IMAGE f s /\ P y} = {f x |x| x IN s /\ P(f x)}`] THEN REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; IN_ELIM_THM] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SIMPLE_IMAGE_GEN] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `(!x y. Q x y ==> x = y) ==> (!x y. P x /\ P y /\ Q x y ==> x = y)`) THEN REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{f:real^N->bool | f face_of p}` THEN ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Now Euler-Poincare for a general full-dimensional polytope. *) (* ------------------------------------------------------------------------- *) let EULER_POINCARE_FULL = prove (`!p:real^N->bool. polytope p /\ aff_dim p = &(dimindex(:N)) ==> sum (0..dimindex(:N)) (\d. (-- &1) pow d * &(CARD {f | f face_of p /\ aff_dim f = &d })) = &1`, REPEAT STRIP_TAC THEN ABBREV_TAC `f:real^N->real^(N,1)finite_sum = \x. lambda i. if i = 1 then &0 else x$(i-1)` THEN ABBREV_TAC `s = IMAGE (f:real^N->real^(N,1)finite_sum) p` THEN MP_TAC(ISPEC `s:real^(N,1)finite_sum->bool` EULER_POINCARE_SPECIAL) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; ADD_SUB] THEN REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `2 <= n + 1 <=> 1 <= n`] THEN SUBGOAL_THEN `linear(f:real^N->real^(N,1)finite_sum)` ASSUME_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[linear] THEN SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC; ALL_TAC] THEN EXPAND_TAC "s" THEN ASM_SIMP_TAC[POLYTOPE_LINEAR_IMAGE; AFFINE_HULL_LINEAR_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EQ_FULL]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `y:real^(N,1)finite_sum` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `x:real^N` SUBST1_TAC) THEN EXPAND_TAC "f" THEN SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_GE_1]; DISCH_TAC THEN EXISTS_TAC `(lambda i. (y:real^(N,1)finite_sum)$(i+1)):real^N` THEN EXPAND_TAC "f" THEN REWRITE_TAC[CART_EQ; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_GE_1; ARITH_RULE `1 <= i /\ ~(i = 1) ==> 1 <= i - 1`; ARITH_RULE `1 <= n /\ i <= n + 1 ==> i - 1 <= n`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ASM_ARITH_TAC]; DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `!x y. (f:real^N->real^(N,1)finite_sum) x = f y <=> x = y` ASSUME_TAC THENL [EXPAND_TAC "f" THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_GE_1; ARITH_RULE `1 <= i /\ ~(i = 1) ==> 1 <= i - 1`; ARITH_RULE `1 <= n /\ i <= n + 1 ==> i - 1 <= n`] THEN REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i + 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ADD_SUB] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN EXPAND_TAC "s" THEN MP_TAC(ISPECL [`f:real^N->real^(N,1)finite_sum`; `p:real^N->bool`] FACES_OF_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `{f | f face_of s /\ P f} = {f | f IN {f | f face_of s} /\ P f}`] THEN ASM_REWRITE_TAC[SET_RULE `{y | y IN IMAGE f s /\ P y} = {f x |x| x IN s /\ P(f x)}`] THEN ASM_SIMP_TAC[AFF_DIM_INJECTIVE_LINEAR_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SIMPLE_IMAGE_GEN] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `(!x y. Q x y ==> x = y) ==> (!x y. P x /\ P y /\ Q x y ==> x = y)`) THEN ASM_REWRITE_TAC[INJECTIVE_IMAGE]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{f:real^N->bool | f face_of p}` THEN ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* In particular the Euler relation in 3D. *) (* ------------------------------------------------------------------------- *) let EULER_RELATION = prove (`!p:real^3->bool. polytope p /\ aff_dim p = &3 ==> (CARD {v | v face_of p /\ aff_dim(v) = &0} + CARD {f | f face_of p /\ aff_dim(f) = &2}) - CARD {e | e face_of p /\ aff_dim(e) = &1} = 2`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `p:real^3->bool` EULER_POINCARE_FULL) THEN ASM_REWRITE_TAC[DIMINDEX_3] THEN REWRITE_TAC[TOP_DEPTH_CONV num_CONV `3`; SUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LNEG] THEN SUBGOAL_THEN `{f:real^3->bool | f face_of p /\ aff_dim f = &3} = {p}` (fun th -> SIMP_TAC[th; NOT_IN_EMPTY; FINITE_EMPTY; CARD_CLAUSES]) THENL [MATCH_MP_TAC(SET_RULE `P a /\ (!x. P x ==> x = a) ==> {x | P x} = {a}`) THEN ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX] THEN X_GEN_TAC `f:real^3->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^3->bool`; `p:real^3->bool`] FACE_OF_AFF_DIM_LT) THEN ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; INT_LT_REFL]; REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_LID] THEN REWRITE_TAC[REAL_ARITH `((x + --y) + z) + -- &1:real = &1 <=> x + z = y + &2`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ADD_SUB2]]);; hol-light/100/primerecip.ml000066400000000000000000000243741303454263000157500ustar00rootroot00000000000000(* ========================================================================= *) (* Divergence of prime reciprocal series. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Now load other stuff needed. *) (* ------------------------------------------------------------------------- *) needs "100/bertrand.ml";; needs "100/divharmonic.ml";; (* ------------------------------------------------------------------------- *) (* Variant of induction. *) (* ------------------------------------------------------------------------- *) let INDUCTION_FROM_1 = prove (`!P. P 0 /\ P 1 /\ (!n. 1 <= n /\ P n ==> P(SUC n)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[num_CONV `1`; ARITH_RULE `n = 0 \/ 1 <= n`]);; (* ------------------------------------------------------------------------- *) (* Evaluate sums over explicit intervals. *) (* ------------------------------------------------------------------------- *) let SUM_CONV = let pth = prove (`sum(1..1) f = f 1 /\ sum(1..SUC n) f = sum(1..n) f + f(SUC n)`, SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; ARITH_RULE `1 <= SUC n`; SUM_SING_NUMSEG]) in let econv_0 = GEN_REWRITE_CONV I [CONJUNCT1 pth] and econv_1 = GEN_REWRITE_CONV I [CONJUNCT2 pth] in let rec sconv tm = (econv_0 ORELSEC (LAND_CONV(RAND_CONV num_CONV) THENC econv_1 THENC COMB2_CONV (RAND_CONV sconv) (RAND_CONV NUM_SUC_CONV))) tm in sconv;; (* ------------------------------------------------------------------------- *) (* Lower bound relative to harmonic series. *) (* ------------------------------------------------------------------------- *) let PRIMERECIP_HARMONIC_LBOUND = prove (`!n. (&3 / (&16 * ln(&32))) * sum(1..n) (\i. &1 / &i) <= sum(1..32 EXP n) (\i. if prime(i) then &1 / &i else &0)`, MATCH_MP_TAC INDUCTION_FROM_1 THEN CONJ_TAC THENL [SIMP_TAC[SUM_TRIV_NUMSEG; ARITH; SUM_SING_NUMSEG; REAL_MUL_RZERO] THEN REWRITE_TAC[PRIME_1; REAL_LE_REFL]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[ARITH; SUM_SING_NUMSEG] THEN CONV_TAC(RAND_CONV SUM_CONV) THEN REWRITE_TAC[] THEN CONV_TAC(ONCE_DEPTH_CONV PRIME_CONV) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SYM(REAL_RAT_REDUCE_CONV `&2 pow 5`)] THEN SIMP_TAC[LN_POW; REAL_OF_NUM_LT; ARITH; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LN_2_COMPOSITION; real_div; real_sub] THEN CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `b - a <= s2 - s1 ==> a <= s1 ==> b <= s2`) THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; REAL_ADD_SUB; ARITH_RULE `1 <= SUC n`] THEN MP_TAC(SPEC `32 EXP n` PII_UBOUND_5) THEN ANTS_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `32 EXP 1` THEN ASM_REWRITE_TAC[LE_EXP] THEN REWRITE_TAC[ARITH]; ALL_TAC] THEN MP_TAC(SPEC `32 EXP (SUC n)` PII_LBOUND) THEN ANTS_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `32 EXP 1` THEN ASM_REWRITE_TAC[LE_EXP] THEN REWRITE_TAC[ARITH] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP(REAL_ARITH `a <= s1 /\ s2 <= b ==> a - b <= s1 - s2`)) THEN SIMP_TAC[pii; PSUM_SUM_NUMSEG; EXP_EQ_0; ARITH; ADD_SUB2] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[EXP; ARITH_RULE `32 * n = n + 31 * n`] THEN SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; REAL_ADD_SUB] THEN REWRITE_TAC[ARITH_RULE `n + 31 * n = 32 * n`] THEN REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&32 pow (SUC n)) * sum(32 EXP n + 1 .. 32 EXP SUC n) (\i. if prime i then &1 else &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; REAL_MUL_RZERO] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN UNDISCH_TAC `32 EXP n + 1 <= i` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[ARITH_RULE `~(0 < i) <=> i = 0`] THEN REWRITE_TAC[LE; ARITH; ADD_EQ_0]] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM real_div; REAL_POW_LT; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= x ==> b <= a ==> b <= x`)) THEN SIMP_TAC[LN_POW; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_pow; GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[REAL_FIELD `&1 / &2 * (&32 * n32) / (n1 * l) - &5 * n32 / (n * l) = (n32 / l) * (&16 / n1 - &5 / n)`] THEN REWRITE_TAC[REAL_FIELD `(&3 / (&16 * l) * i) * &32 * n32 = (n32 / l) * (&6 * i)`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; LN_POS; REAL_OF_NUM_LE; ARITH] THEN REWRITE_TAC[real_div; REAL_ARITH `&6 * &1 * n1 <= &16 * n1 - &5 * n <=> n <= inv(inv(&2)) * n1`] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence an overall lower bound. *) (* ------------------------------------------------------------------------- *) let PRIMERECIP_LBOUND = prove (`!n. &3 / (&32 * ln(&32)) * &n <= sum (1 .. 32 EXP (2 EXP n)) (\i. if prime i then &1 / &i else &0)`, GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&3 / (&16 * ln(&32)) * sum (1 .. 2 EXP n) (\i. &1 / &i)` THEN REWRITE_TAC[PRIMERECIP_HARMONIC_LBOUND] THEN REWRITE_TAC[REAL_FIELD `&3 / (&32 * ln(&32)) * &n = &3 / (&16 * ln(&32)) * (&n / &2)`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REWRITE_RULE[real_ge] HARMONIC_LEMMA] THEN SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; LN_POS; REAL_OF_NUM_LE; ARITH]);; (* ------------------------------------------------------------------------- *) (* General lemma. *) (* ------------------------------------------------------------------------- *) let UNBOUNDED_DIVERGENT = prove (`!s. (!k. ?N. !n. n >= N ==> sum(1..n) s >= k) ==> ~(convergent(\n. sum(1..n) s))`, REWRITE_TAC[convergent; SEQ] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `l + &1`) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD; ONCE_REWRITE_RULE[ADD_SYM] LE_ADD; GE] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence divergence. *) (* ------------------------------------------------------------------------- *) let PRIMERECIP_DIVERGES_NUMSEG = prove (`~(convergent (\n. sum (1..n) (\i. if prime i then &1 / &i else &0)))`, MATCH_MP_TAC UNBOUNDED_DIVERGENT THEN X_GEN_TAC `k:real` THEN MP_TAC(SPEC `&3 / (&32 * ln(&32))` REAL_ARCH) THEN SIMP_TAC[REAL_LT_DIV; LN_POS_LT; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(MP_TAC o SPEC `k:real`) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `32 EXP (2 EXP N)` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; real_ge] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N * &3 / (&32 * ln (&32))` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1 .. 32 EXP (2 EXP N)) (\i. if prime i then &1 / &i else &0)` THEN REWRITE_TAC[PRIMERECIP_LBOUND] THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; REAL_LE_ADDR] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS]);; (* ------------------------------------------------------------------------- *) (* A perhaps more intuitive formulation. *) (* ------------------------------------------------------------------------- *) let PRIMERECIP_DIVERGES = prove (`~(convergent (\n. sum {p | prime p /\ p <= n} (\p. &1 / &p)))`, MP_TAC PRIMERECIP_DIVERGES_NUMSEG THEN MATCH_MP_TAC(TAUT `(a <=> b) ==> ~a ==> ~b`) THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL [SUBGOAL_THEN `{p | prime p /\ p <= 0} = {}` (fun th -> SIMP_TAC[SUM_CLAUSES; SUM_TRIV_NUMSEG; th; ARITH]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LE] THEN MESON_TAC[PRIME_0]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN SUBGOAL_THEN `{p | prime p /\ p <= SUC n} = if prime(SUC n) then (SUC n) INSERT {p | prime p /\ p <= n} else {p | prime p /\ p <= n}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; LE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN SUBGOAL_THEN `FINITE {p | prime p /\ p <= n}` (fun th -> SIMP_TAC[SUM_CLAUSES; th]) THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..n` THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; IN_ELIM_THM; SUBSET] THEN MESON_TAC[PRIME_0; ARITH_RULE `1 <= i <=> ~(i = 0)`]; REWRITE_TAC[IN_ELIM_THM; ARITH_RULE `~(SUC n <= n)`; REAL_ADD_AC]]);; hol-light/100/ptolemy.ml000066400000000000000000000064321303454263000152750ustar00rootroot00000000000000(* ========================================================================= *) (* Ptolemy's theorem. *) (* ========================================================================= *) needs "Multivariate/transcendentals.ml";; (* ------------------------------------------------------------------------- *) (* Some 2-vector special cases. *) (* ------------------------------------------------------------------------- *) let DOT_VECTOR = prove (`(vector [x1;y1] :real^2) dot (vector [x2;y2]) = x1 * x2 + y1 * y2`, REWRITE_TAC[dot; DIMINDEX_2; SUM_2; VECTOR_2]);; (* ------------------------------------------------------------------------- *) (* Lemma about distance between points with polar coordinates. *) (* ------------------------------------------------------------------------- *) let DIST_SEGMENT_LEMMA = prove (`!a1 a2. &0 <= a1 /\ a1 <= a2 /\ a2 <= &2 * pi /\ &0 <= radius ==> dist(centre + radius % vector [cos(a1);sin(a1)] :real^2, centre + radius % vector [cos(a2);sin(a2)]) = &2 * radius * sin((a2 - a1) / &2)`, REPEAT STRIP_TAC THEN REWRITE_TAC[dist; vector_norm] THEN MATCH_MP_TAC SQRT_UNIQUE THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `(c + r % x) - (c + r % y) = r % (x - y)`] THEN REWRITE_TAC[VECTOR_ARITH `(r % x) dot (r % x) = (r pow 2) * (x dot x)`] THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_VECTOR] THEN SUBST1_TAC(REAL_ARITH `a1 = &2 * a1 / &2`) THEN SUBST1_TAC(REAL_ARITH `a2 = &2 * a2 / &2`) THEN REWRITE_TAC[REAL_ARITH `(&2 * x - &2 * y) / &2 = x - y`] THEN REWRITE_TAC[SIN_SUB; SIN_DOUBLE; COS_DOUBLE] THEN MP_TAC(SPEC `a1 / &2` SIN_CIRCLE) THEN MP_TAC(SPEC `a2 / &2` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Hence the overall theorem. *) (* ------------------------------------------------------------------------- *) let PTOLEMY = prove (`!A B C D:real^2 a b c d centre radius. A = centre + radius % vector [cos(a);sin(a)] /\ B = centre + radius % vector [cos(b);sin(b)] /\ C = centre + radius % vector [cos(c);sin(c)] /\ D = centre + radius % vector [cos(d);sin(d)] /\ &0 <= radius /\ &0 <= a /\ a <= b /\ b <= c /\ c <= d /\ d <= &2 * pi ==> dist(A,C) * dist(B,D) = dist(A,B) * dist(C,D) + dist(A,D) * dist(B,C)`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o check (is_var o lhs o concl))) THEN REPEAT (W(fun (asl,w) -> let t = find_term (fun t -> can (PART_MATCH (lhs o rand) DIST_SEGMENT_LEMMA) t) w in MP_TAC (PART_MATCH (lhs o rand) DIST_SEGMENT_LEMMA t) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC])) THEN REWRITE_TAC[REAL_ARITH `(x - y) / &2 = x / &2 - y / &2`] THEN MAP_EVERY (fun t -> MP_TAC(SPEC t SIN_CIRCLE)) [`a / &2`; `b / &2`; `c / &2`; `d / &2`] THEN REWRITE_TAC[SIN_SUB; SIN_ADD; COS_ADD; SIN_PI; COS_PI] THEN CONV_TAC REAL_RING);; hol-light/100/pythagoras.ml000066400000000000000000000025561303454263000157700ustar00rootroot00000000000000(* ========================================================================= *) (* A "proof" of Pythagoras's theorem. Of course something similar is *) (* implicit in the definition of "norm", but maybe this is still nontrivial. *) (* ========================================================================= *) needs "Multivariate/misc.ml";; needs "Multivariate/vectors.ml";; (* ------------------------------------------------------------------------- *) (* Direct vector proof (could replace 2 by N and the proof still runs). *) (* ------------------------------------------------------------------------- *) let PYTHAGORAS = prove (`!A B C:real^2. orthogonal (A - B) (C - B) ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, REWRITE_TAC[NORM_POW_2; orthogonal; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* A more explicit and laborious "componentwise" specifically for 2-vectors. *) (* ------------------------------------------------------------------------- *) let PYTHAGORAS = prove (`!A B C:real^2. orthogonal (A - B) (C - B) ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, SIMP_TAC[NORM_POW_2; orthogonal; dot; SUM_2; DIMINDEX_2; VECTOR_SUB_COMPONENT; ARITH] THEN CONV_TAC REAL_RING);; hol-light/100/quartic.ml000066400000000000000000000206551303454263000152570ustar00rootroot00000000000000prioritize_real();; (* ------------------------------------------------------------------------- *) (* First the R = 0 case. *) (* ------------------------------------------------------------------------- *) let QUARTIC_1 = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ R = &0 /\ s pow 2 = y pow 2 - &4 * d /\ D pow 2 = &3 * a pow 2 / &4 - &2 * b + &2 * s /\ x = --a / &4 + R / &2 + D / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_RING);; let QUARTIC_2 = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ R = &0 /\ s pow 2 = y pow 2 - &4 * d /\ D pow 2 = &3 * a pow 2 / &4 - &2 * b + &2 * s /\ x = --a / &4 + R / &2 - D / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_RING);; let QUARTIC_3 = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ R = &0 /\ s pow 2 = y pow 2 - &4 * d /\ E pow 2 = &3 * a pow 2 / &4 - &2 * b - &2 * s /\ x = --a / &4 - R / &2 + E / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_RING);; let QUARTIC_4 = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ R = &0 /\ s pow 2 = y pow 2 - &4 * d /\ E pow 2 = &3 * a pow 2 / &4 - &2 * b - &2 * s /\ x = --a / &4 - R / &2 - E / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* The R nonzero case. *) (* ------------------------------------------------------------------------- *) let QUARTIC_1' = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ ~(R = &0) /\ D pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b + (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ x = --a / &4 + R / &2 + D / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_FIELD);; let QUARTIC_2' = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ ~(R = &0) /\ D pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b + (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ x = --a / &4 + R / &2 - D / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_FIELD);; let QUARTIC_3' = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ ~(R = &0) /\ E pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b - (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ x = --a / &4 - R / &2 + E / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_FIELD);; let QUARTIC_4' = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ ~(R = &0) /\ E pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b - (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ x = --a / &4 - R / &2 - E / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Combine them. *) (* ------------------------------------------------------------------------- *) let QUARTIC_1 = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ s pow 2 = y pow 2 - &4 * d /\ (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ x = --a / &4 + R / &2 + D / &2 ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* A case split. *) (* ------------------------------------------------------------------------- *) let QUARTIC_1 = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ s pow 2 = y pow 2 - &4 * d /\ (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b - (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ (x = --a / &4 + R / &2 + D / &2 \/ x = --a / &4 - R / &2 + E / &2) ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* More general case split. *) (* ------------------------------------------------------------------------- *) let QUARTIC_CASES = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ s pow 2 = y pow 2 - &4 * d /\ (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b - (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ (x = --a / &4 + R / &2 + D / &2 \/ x = --a / &4 + R / &2 - D / &2 \/ x = --a / &4 - R / &2 + E / &2 \/ x = --a / &4 - R / &2 - E / &2) ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Even this works --- great, that's nearly what we wanted. *) (* ------------------------------------------------------------------------- *) let QUARTIC_CASES = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ s pow 2 = y pow 2 - &4 * d /\ (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b - (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) ==> (x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0 <=> x = --a / &4 + R / &2 + D / &2 \/ x = --a / &4 + R / &2 - D / &2 \/ x = --a / &4 - R / &2 + E / &2 \/ x = --a / &4 - R / &2 - E / &2)`, COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* This is the automatic proof. *) (* ------------------------------------------------------------------------- *) let QUARTIC_CASES = prove (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ R pow 2 = a pow 2 / &4 - b + y /\ s pow 2 = y pow 2 - &4 * d /\ (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s else &3 * a pow 2 / &4 - R pow 2 - &2 * b - (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) ==> (x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0 <=> x = --a / &4 + R / &2 + D / &2 \/ x = --a / &4 + R / &2 - D / &2 \/ x = --a / &4 - R / &2 + E / &2 \/ x = --a / &4 - R / &2 - E / &2)`, CONV_TAC REAL_FIELD);; hol-light/100/ramsey.ml000066400000000000000000001462611303454263000151110ustar00rootroot00000000000000(* ======================================================================== *) (* Infinite Ramsey's theorem. *) (* *) (* Port to HOL Light of a HOL88 proof done on 9th May 1994 *) (* ======================================================================== *) (* ------------------------------------------------------------------------- *) (* HOL88 compatibility. *) (* ------------------------------------------------------------------------- *) let is_neg_imp tm = is_neg tm || is_imp tm;; let dest_neg_imp tm = try dest_imp tm with Failure _ -> try (dest_neg tm,mk_const("F",[])) with Failure _ -> failwith "dest_neg_imp";; (* ------------------------------------------------------------------------- *) (* These get overwritten by the subgoal stuff. *) (* ------------------------------------------------------------------------- *) let PROVE = prove;; let prove_thm((s:string),g,t) = prove(g,t);; (* ------------------------------------------------------------------------- *) (* The quantifier movement conversions. *) (* ------------------------------------------------------------------------- *) let (CONV_OF_RCONV: conv -> conv) = let rec get_bv tm = if is_abs tm then bndvar tm else if is_comb tm then try get_bv (rand tm) with Failure _ -> get_bv (rator tm) else failwith "" in fun conv tm -> let v = get_bv tm in let th1 = conv tm in let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in TRANS th1 th2;; let (CONV_OF_THM: thm -> conv) = CONV_OF_RCONV o REWR_CONV;; let (X_FUN_EQ_CONV:term->conv) = fun v -> (REWR_CONV FUN_EQ_THM) THENC GEN_ALPHA_CONV v;; let (FUN_EQ_CONV:conv) = fun tm -> let vars = frees tm in let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in if op = "fun" then let varnm = if (is_vartype ty1) then "x" else hd(explode(fst(dest_type ty1))) in let x = variant vars (mk_var(varnm,ty1)) in X_FUN_EQ_CONV x tm else failwith "FUN_EQ_CONV";; let (SINGLE_DEPTH_CONV:conv->conv) = let rec SINGLE_DEPTH_CONV conv tm = try conv tm with Failure _ -> (SUB_CONV (SINGLE_DEPTH_CONV conv) THENC (TRY_CONV conv)) tm in SINGLE_DEPTH_CONV;; let (SKOLEM_CONV:conv) = SINGLE_DEPTH_CONV (REWR_CONV SKOLEM_THM);; let (X_SKOLEM_CONV:term->conv) = fun v -> SKOLEM_CONV THENC GEN_ALPHA_CONV v;; let EXISTS_UNIQUE_CONV tm = let v = bndvar(rand tm) in let th1 = REWR_CONV EXISTS_UNIQUE_THM tm in let tm1 = rhs(concl th1) in let vars = frees tm1 in let v = variant vars v in let v' = variant (v::vars) v in let th2 = (LAND_CONV(GEN_ALPHA_CONV v) THENC RAND_CONV(BINDER_CONV(GEN_ALPHA_CONV v') THENC GEN_ALPHA_CONV v)) tm1 in TRANS th1 th2;; let NOT_FORALL_CONV = CONV_OF_THM NOT_FORALL_THM;; let NOT_EXISTS_CONV = CONV_OF_THM NOT_EXISTS_THM;; let RIGHT_IMP_EXISTS_CONV = CONV_OF_THM RIGHT_IMP_EXISTS_THM;; let FORALL_IMP_CONV = CONV_OF_RCONV (REWR_CONV TRIV_FORALL_IMP_THM ORELSEC REWR_CONV RIGHT_FORALL_IMP_THM ORELSEC REWR_CONV LEFT_FORALL_IMP_THM);; let EXISTS_AND_CONV = CONV_OF_RCONV (REWR_CONV TRIV_EXISTS_AND_THM ORELSEC REWR_CONV LEFT_EXISTS_AND_THM ORELSEC REWR_CONV RIGHT_EXISTS_AND_THM);; let LEFT_IMP_EXISTS_CONV = CONV_OF_THM LEFT_IMP_EXISTS_THM;; let LEFT_AND_EXISTS_CONV tm = let v = bndvar(rand(rand(rator tm))) in (REWR_CONV LEFT_AND_EXISTS_THM THENC TRY_CONV (GEN_ALPHA_CONV v)) tm;; let RIGHT_AND_EXISTS_CONV = CONV_OF_THM RIGHT_AND_EXISTS_THM;; let AND_FORALL_CONV = CONV_OF_THM AND_FORALL_THM;; (* ------------------------------------------------------------------------- *) (* The slew of named tautologies. *) (* ------------------------------------------------------------------------- *) let AND1_THM = TAUT `!t1 t2. t1 /\ t2 ==> t1`;; let AND2_THM = TAUT `!t1 t2. t1 /\ t2 ==> t2`;; let AND_IMP_INTRO = TAUT `!t1 t2 t3. t1 ==> t2 ==> t3 = t1 /\ t2 ==> t3`;; let AND_INTRO_THM = TAUT `!t1 t2. t1 ==> t2 ==> t1 /\ t2`;; let BOOL_EQ_DISTINCT = TAUT `~(T <=> F) /\ ~(F <=> T)`;; let EQ_EXPAND = TAUT `!t1 t2. (t1 <=> t2) <=> t1 /\ t2 \/ ~t1 /\ ~t2`;; let EQ_IMP_THM = TAUT `!t1 t2. (t1 <=> t2) <=> (t1 ==> t2) /\ (t2 ==> t1)`;; let FALSITY = TAUT `!t. F ==> t`;; let F_IMP = TAUT `!t. ~t ==> t ==> F`;; let IMP_DISJ_THM = TAUT `!t1 t2. t1 ==> t2 <=> ~t1 \/ t2`;; let IMP_F = TAUT `!t. (t ==> F) ==> ~t`;; let IMP_F_EQ_F = TAUT `!t. t ==> F <=> (t <=> F)`;; let LEFT_AND_OVER_OR = TAUT `!t1 t2 t3. t1 /\ (t2 \/ t3) <=> t1 /\ t2 \/ t1 /\ t3`;; let LEFT_OR_OVER_AND = TAUT `!t1 t2 t3. t1 \/ t2 /\ t3 <=> (t1 \/ t2) /\ (t1 \/ t3)`;; let NOT_AND = TAUT `~(t /\ ~t)`;; let NOT_F = TAUT `!t. ~t ==> (t <=> F)`;; let OR_ELIM_THM = TAUT `!t t1 t2. t1 \/ t2 ==> (t1 ==> t) ==> (t2 ==> t) ==> t`;; let OR_IMP_THM = TAUT `!t1 t2. (t1 <=> t2 \/ t1) <=> t2 ==> t1`;; let OR_INTRO_THM1 = TAUT `!t1 t2. t1 ==> t1 \/ t2`;; let OR_INTRO_THM2 = TAUT `!t1 t2. t2 ==> t1 \/ t2`;; let RIGHT_AND_OVER_OR = TAUT `!t1 t2 t3. (t2 \/ t3) /\ t1 <=> t2 /\ t1 \/ t3 /\ t1`;; let RIGHT_OR_OVER_AND = TAUT `!t1 t2 t3. t2 /\ t3 \/ t1 <=> (t2 \/ t1) /\ (t3 \/ t1)`;; (* ------------------------------------------------------------------------- *) (* This is an overwrite -- is there any point in what I have? *) (* ------------------------------------------------------------------------- *) let is_type = can get_type_arity;; (* ------------------------------------------------------------------------- *) (* I suppose this is also useful. *) (* ------------------------------------------------------------------------- *) let is_constant = can get_const_type;; (* ------------------------------------------------------------------------- *) (* Misc. *) (* ------------------------------------------------------------------------- *) let null l = l = [];; (* ------------------------------------------------------------------------- *) (* Syntax. *) (* ------------------------------------------------------------------------- *) let type_tyvars = type_vars_in_term o curry mk_var "x";; let find_match u = let rec find_mt t = try term_match [] u t with Failure _ -> try find_mt(rator t) with Failure _ -> try find_mt(rand t) with Failure _ -> try find_mt(snd(dest_abs t)) with Failure _ -> failwith "find_match" in fun t -> let _,tmin,tyin = find_mt t in tmin,tyin;; let rec mk_primed_var(name,ty) = if can get_const_type name then mk_primed_var(name^"'",ty) else mk_var(name,ty);; let subst_occs = let rec subst_occs slist tm = let applic,noway = partition (fun (i,(t,x)) -> aconv tm x) slist in let sposs = map (fun (l,z) -> let l1,l2 = partition ((=) 1) l in (l1,z),(l2,z)) applic in let racts,rrest = unzip sposs in let acts = filter (fun t -> not (fst t = [])) racts in let trest = map (fun (n,t) -> (map (C (-) 1) n,t)) rrest in let urest = filter (fun t -> not (fst t = [])) trest in let tlist = urest @ noway in if acts = [] then if is_comb tm then let l,r = dest_comb tm in let l',s' = subst_occs tlist l in let r',s'' = subst_occs s' r in mk_comb(l',r'),s'' else if is_abs tm then let bv,bod = dest_abs tm in let gv = genvar(type_of bv) in let nbod = vsubst[gv,bv] bod in let tm',s' = subst_occs tlist nbod in alpha bv (mk_abs(gv,tm')),s' else tm,tlist else let tm' = (fun (n,(t,x)) -> subst[t,x] tm) (hd acts) in tm',tlist in fun ilist slist tm -> fst(subst_occs (zip ilist slist) tm);; (* ------------------------------------------------------------------------- *) (* Note that the all-instantiating INST and INST_TYPE are not overwritten. *) (* ------------------------------------------------------------------------- *) let INST_TY_TERM(substl,insttyl) th = let th' = INST substl (INST_TYPE insttyl th) in if hyp th' = hyp th then th' else failwith "INST_TY_TERM: Free term and/or type variables in hypotheses";; (* ------------------------------------------------------------------------- *) (* Conversions stuff. *) (* ------------------------------------------------------------------------- *) let RIGHT_CONV_RULE (conv:conv) th = TRANS th (conv(rhs(concl th)));; (* ------------------------------------------------------------------------- *) (* Derived rules. *) (* ------------------------------------------------------------------------- *) let NOT_EQ_SYM = let pth = GENL [`a:A`; `b:A`] (GEN_REWRITE_RULE I [GSYM CONTRAPOS_THM] (DISCH_ALL(SYM(ASSUME`a:A = b`)))) and aty = `:A` in fun th -> try let l,r = dest_eq(dest_neg(concl th)) in MP (SPECL [r; l] (INST_TYPE [type_of l,aty] pth)) th with Failure _ -> failwith "NOT_EQ_SYM";; let NOT_MP thi th = try MP thi th with Failure _ -> try let t = dest_neg (concl thi) in MP(MP (SPEC t F_IMP) thi) th with Failure _ -> failwith "NOT_MP";; let FORALL_EQ x = let mkall = AP_TERM (mk_const("!",[type_of x,mk_vartype "A"])) in fun th -> try mkall (ABS x th) with Failure _ -> failwith "FORALL_EQ";; let EXISTS_EQ x = let mkex = AP_TERM (mk_const("?",[type_of x,mk_vartype "A"])) in fun th -> try mkex (ABS x th) with Failure _ -> failwith "EXISTS_EQ";; let SELECT_EQ x = let mksel = AP_TERM (mk_const("@",[type_of x,mk_vartype "A"])) in fun th -> try mksel (ABS x th) with Failure _ -> failwith "SELECT_EQ";; let RIGHT_BETA th = try TRANS th (BETA_CONV(rhs(concl th))) with Failure _ -> failwith "RIGHT_BETA";; let rec LIST_BETA_CONV tm = try let rat,rnd = dest_comb tm in RIGHT_BETA(AP_THM(LIST_BETA_CONV rat)rnd) with Failure _ -> REFL tm;; let RIGHT_LIST_BETA th = TRANS th (LIST_BETA_CONV(snd(dest_eq(concl th))));; let LIST_CONJ = end_itlist CONJ ;; let rec CONJ_LIST n th = try if n=1 then [th] else (CONJUNCT1 th)::(CONJ_LIST (n-1) (CONJUNCT2 th)) with Failure _ -> failwith "CONJ_LIST";; let rec BODY_CONJUNCTS th = if is_forall(concl th) then BODY_CONJUNCTS (SPEC_ALL th) else if is_conj (concl th) then BODY_CONJUNCTS (CONJUNCT1 th) @ BODY_CONJUNCTS (CONJUNCT2 th) else [th];; let rec IMP_CANON th = let w = concl th in if is_conj w then IMP_CANON (CONJUNCT1 th) @ IMP_CANON (CONJUNCT2 th) else if is_imp w then let ante,conc = dest_neg_imp w in if is_conj ante then let a,b = dest_conj ante in IMP_CANON (DISCH a (DISCH b (NOT_MP th (CONJ (ASSUME a) (ASSUME b))))) else if is_disj ante then let a,b = dest_disj ante in IMP_CANON (DISCH a (NOT_MP th (DISJ1 (ASSUME a) b))) @ IMP_CANON (DISCH b (NOT_MP th (DISJ2 a (ASSUME b)))) else if is_exists ante then let x,body = dest_exists ante in let x' = variant (thm_frees th) x in let body' = subst [x',x] body in IMP_CANON (DISCH body' (NOT_MP th (EXISTS (ante, x') (ASSUME body')))) else map (DISCH ante) (IMP_CANON (UNDISCH th)) else if is_forall w then IMP_CANON (SPEC_ALL th) else [th];; let LIST_MP = rev_itlist (fun x y -> MP y x);; let DISJ_IMP = let pth = TAUT`!t1 t2. t1 \/ t2 ==> ~t1 ==> t2` in fun th -> try let a,b = dest_disj(concl th) in MP (SPECL [a;b] pth) th with Failure _ -> failwith "DISJ_IMP";; let IMP_ELIM = let pth = TAUT`!t1 t2. (t1 ==> t2) ==> ~t1 \/ t2` in fun th -> try let a,b = dest_imp(concl th) in MP (SPECL [a;b] pth) th with Failure _ -> failwith "IMP_ELIM";; let DISJ_CASES_UNION dth ath bth = DISJ_CASES dth (DISJ1 ath (concl bth)) (DISJ2 (concl ath) bth);; let MK_ABS qth = try let ov = bndvar(rand(concl qth)) in let bv,rth = SPEC_VAR qth in let sth = ABS bv rth in let cnv = ALPHA_CONV ov in CONV_RULE(BINOP_CONV cnv) sth with Failure _ -> failwith "MK_ABS";; let HALF_MK_ABS th = try let th1 = MK_ABS th in CONV_RULE(LAND_CONV ETA_CONV) th1 with Failure _ -> failwith "HALF_MK_ABS";; let MK_EXISTS qth = try let ov = bndvar(rand(concl qth)) in let bv,rth = SPEC_VAR qth in let sth = EXISTS_EQ bv rth in let cnv = GEN_ALPHA_CONV ov in CONV_RULE(BINOP_CONV cnv) sth with Failure _ -> failwith "MK_EXISTS";; let LIST_MK_EXISTS l th = itlist (fun x th -> MK_EXISTS(GEN x th)) l th;; let IMP_CONJ th1 th2 = let A1,C1 = dest_imp (concl th1) and A2,C2 = dest_imp (concl th2) in let a1,a2 = CONJ_PAIR (ASSUME (mk_conj(A1,A2))) in DISCH (mk_conj(A1,A2)) (CONJ (MP th1 a1) (MP th2 a2));; let EXISTS_IMP x = if not (is_var x) then failwith "EXISTS_IMP: first argument not a variable" else fun th -> try let ante,cncl = dest_imp(concl th) in let th1 = EXISTS (mk_exists(x,cncl),x) (UNDISCH th) in let asm = mk_exists(x,ante) in DISCH asm (CHOOSE (x,ASSUME asm) th1) with Failure _ -> failwith "EXISTS_IMP: variable free in assumptions";; let CONJUNCTS_CONV (t1,t2) = let rec build_conj thl t = try let l,r = dest_conj t in CONJ (build_conj thl l) (build_conj thl r) with Failure _ -> find (fun th -> concl th = t) thl in try IMP_ANTISYM_RULE (DISCH t1 (build_conj (CONJUNCTS (ASSUME t1)) t2)) (DISCH t2 (build_conj (CONJUNCTS (ASSUME t2)) t1)) with Failure _ -> failwith "CONJUNCTS_CONV";; let CONJ_SET_CONV l1 l2 = try CONJUNCTS_CONV (list_mk_conj l1, list_mk_conj l2) with Failure _ -> failwith "CONJ_SET_CONV";; let FRONT_CONJ_CONV tml t = let rec remove x l = if hd l = x then tl l else (hd l)::(remove x (tl l)) in try CONJ_SET_CONV tml (t::(remove t tml)) with Failure _ -> failwith "FRONT_CONJ_CONV";; let CONJ_DISCH = let pth = TAUT`!t t1 t2. (t ==> (t1 <=> t2)) ==> (t /\ t1 <=> t /\ t2)` in fun t th -> try let t1,t2 = dest_eq(concl th) in MP (SPECL [t; t1; t2] pth) (DISCH t th) with Failure _ -> failwith "CONJ_DISCH";; let rec CONJ_DISCHL l th = if l = [] then th else CONJ_DISCH (hd l) (CONJ_DISCHL (tl l) th);; let rec GSPEC th = let wl,w = dest_thm th in if is_forall w then GSPEC (SPEC (genvar (type_of (fst (dest_forall w)))) th) else th;; let ANTE_CONJ_CONV tm = try let (a1,a2),c = (dest_conj F_F I) (dest_imp tm) in let imp1 = MP (ASSUME tm) (CONJ (ASSUME a1) (ASSUME a2)) and imp2 = LIST_MP [CONJUNCT1 (ASSUME (mk_conj(a1,a2))); CONJUNCT2 (ASSUME (mk_conj(a1,a2)))] (ASSUME (mk_imp(a1,mk_imp(a2,c)))) in IMP_ANTISYM_RULE (DISCH_ALL (DISCH a1 (DISCH a2 imp1))) (DISCH_ALL (DISCH (mk_conj(a1,a2)) imp2)) with Failure _ -> failwith "ANTE_CONJ_CONV";; let bool_EQ_CONV = let check = let boolty = `:bool` in check (fun tm -> type_of tm = boolty) in let clist = map (GEN `b:bool`) (CONJUNCTS(SPEC `b:bool` EQ_CLAUSES)) in let tb = hd clist and bt = hd(tl clist) in let T = `T` and F = `F` in fun tm -> try let l,r = (I F_F check) (dest_eq tm) in if l = r then EQT_INTRO (REFL l) else if l = T then SPEC r tb else if r = T then SPEC l bt else fail() with Failure _ -> failwith "bool_EQ_CONV";; let COND_CONV = let T = `T` and F = `F` and vt = genvar`:A` and vf = genvar `:A` in let gen = GENL [vt;vf] in let CT,CF = (gen F_F gen) (CONJ_PAIR (SPECL [vt;vf] COND_CLAUSES)) in fun tm -> let P,(u,v) = try dest_cond tm with Failure _ -> failwith "COND_CONV: not a conditional" in let ty = type_of u in if (P=T) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CT)) else if (P=F) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CF)) else if (u=v) then SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) else if (aconv u v) then let cnd = AP_TERM (rator tm) (ALPHA v u) in let thm = SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) in TRANS cnd thm else failwith "COND_CONV: can't simplify conditional";; let SUBST_MATCH eqth th = let tm_inst,ty_inst = find_match (lhs(concl eqth)) (concl th) in SUBS [INST tm_inst (INST_TYPE ty_inst eqth)] th;; let SUBST thl pat th = let eqs,vs = unzip thl in let gvs = map (genvar o type_of) vs in let gpat = subst (zip gvs vs) pat in let ls,rs = unzip (map (dest_eq o concl) eqs) in let ths = map (ASSUME o mk_eq) (zip gvs rs) in let th1 = ASSUME gpat in let th2 = SUBS ths th1 in let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in let th4 = INST (zip ls gvs) th3 in MP (rev_itlist (C MP) eqs th4) th;; (* let GSUBS = ... *) (* let SUBS_OCCS = ... *) (* A poor thing but mine own. The old ones use mk_thm and the commented out functions are bogus. *) let SUBST_CONV thvars template tm = let thms,vars = unzip thvars in let gvs = map (genvar o type_of) vars in let gtemplate = subst (zip gvs vars) template in SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; (* ------------------------------------------------------------------------- *) (* Filtering rewrites. *) (* ------------------------------------------------------------------------- *) let FILTER_PURE_ASM_REWRITE_RULE f thl th = PURE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_ASM_REWRITE_RULE f thl th = REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_PURE_ONCE_ASM_REWRITE_RULE f thl th = PURE_ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_ONCE_ASM_REWRITE_RULE f thl th = ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th;; let (FILTER_PURE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> PURE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) and (FILTER_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) and (FILTER_PURE_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> PURE_ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) and (FILTER_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w);; (* ------------------------------------------------------------------------- *) (* Tacticals. *) (* ------------------------------------------------------------------------- *) let (X_CASES_THENL: term list list -> thm_tactic list -> thm_tactic) = fun varsl ttacl -> end_itlist DISJ_CASES_THEN2 (map (fun (vars,ttac) -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) (zip varsl ttacl));; let (X_CASES_THEN: term list list -> thm_tactical) = fun varsl ttac -> end_itlist DISJ_CASES_THEN2 (map (fun vars -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) varsl);; let (CASES_THENL: thm_tactic list -> thm_tactic) = fun ttacl -> end_itlist DISJ_CASES_THEN2 (map (REPEAT_TCL CHOOSE_THEN) ttacl);; (* ------------------------------------------------------------------------- *) (* Tactics. *) (* ------------------------------------------------------------------------- *) let (DISCARD_TAC: thm_tactic) = let truth = `T` in fun th (asl,w) -> if exists (aconv (concl th)) (truth::(map (concl o snd) asl)) then ALL_TAC (asl,w) else failwith "DISCARD_TAC";; let (CHECK_ASSUME_TAC: thm_tactic) = fun gth -> FIRST [CONTR_TAC gth; ACCEPT_TAC gth; DISCARD_TAC gth; ASSUME_TAC gth];; let (FILTER_GEN_TAC: term -> tactic) = fun tm (asl,w) -> if is_forall w && not (tm = fst(dest_forall w)) then GEN_TAC (asl,w) else failwith "FILTER_GEN_TAC";; let (FILTER_DISCH_THEN: thm_tactic -> term -> tactic) = fun ttac tm (asl,w) -> if is_neg_imp w && not (free_in tm (fst(dest_neg_imp w))) then DISCH_THEN ttac (asl,w) else failwith "FILTER_DISCH_THEN";; let FILTER_STRIP_THEN ttac tm = FIRST [FILTER_GEN_TAC tm; FILTER_DISCH_THEN ttac tm; CONJ_TAC];; let FILTER_DISCH_TAC = FILTER_DISCH_THEN STRIP_ASSUME_TAC;; let FILTER_STRIP_TAC = FILTER_STRIP_THEN STRIP_ASSUME_TAC;; (* ------------------------------------------------------------------------- *) (* Conversions for quantifier movement using proforma theorems. *) (* ------------------------------------------------------------------------- *) (* let ....... *) (* ------------------------------------------------------------------------- *) (* Resolution stuff. *) (* ------------------------------------------------------------------------- *) let RES_CANON = let not_elim th = if is_neg (concl th) then true,(NOT_ELIM th) else (false,th) in let rec canon fl th = let w = concl th in if (is_conj w) then let (th1,th2) = CONJ_PAIR th in (canon fl th1) @ (canon fl th2) else if ((is_imp w) && not(is_neg w)) then let ante,conc = dest_neg_imp w in if (is_conj ante) then let a,b = dest_conj ante in let cth = NOT_MP th (CONJ (ASSUME a) (ASSUME b)) in let th1 = DISCH b cth and th2 = DISCH a cth in (canon true (DISCH a th1)) @ (canon true (DISCH b th2)) else if (is_disj ante) then let a,b = dest_disj ante in let ath = DISJ1 (ASSUME a) b and bth = DISJ2 a (ASSUME b) in let th1 = DISCH a (NOT_MP th ath) and th2 = DISCH b (NOT_MP th bth) in (canon true th1) @ (canon true th2) else if (is_exists ante) then let v,body = dest_exists ante in let newv = variant (thm_frees th) v in let newa = subst [newv,v] body in let th1 = NOT_MP th (EXISTS (ante, newv) (ASSUME newa)) in canon true (DISCH newa th1) else map (GEN_ALL o (DISCH ante)) (canon true (UNDISCH th)) else if (is_eq w && (type_of (rand w) = `:bool`)) then let (th1,th2) = EQ_IMP_RULE th in (if fl then [GEN_ALL th] else []) @ (canon true th1) @ (canon true th2) else if (is_forall w) then let vs,body = strip_forall w in let fvs = thm_frees th in let vfn = fun l -> variant (l @ fvs) in let nvs = itlist (fun v nv -> let v' = vfn nv v in (v'::nv)) vs [] in canon fl (SPECL nvs th) else if fl then [GEN_ALL th] else [] in fun th -> try let args = map (not_elim o SPEC_ALL) (CONJUNCTS (SPEC_ALL th)) in let imps = flat (map (map GEN_ALL o (uncurry canon)) args) in check (fun l -> l <> []) imps with Failure _ -> failwith "RES_CANON: no implication is derivable from input thm.";; let IMP_RES_THEN,RES_THEN = let MATCH_MP impth = let sth = SPEC_ALL impth in let matchfn = (fun (a,b,c) -> b,c) o term_match [] (fst(dest_neg_imp(concl sth))) in fun th -> NOT_MP (INST_TY_TERM (matchfn (concl th)) sth) th in let check st l = (if l = [] then failwith st else l) in let IMP_RES_THEN ttac impth = let ths = try RES_CANON impth with Failure _ -> failwith "IMP_RES_THEN: no implication" in ASSUM_LIST (fun asl -> let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asl)) ths [] in let res = check "IMP_RES_THEN: no resolvents " l in let tacs = check "IMP_RES_THEN: no tactics" (mapfilter ttac res) in EVERY tacs) in let RES_THEN ttac (asl,g) = let asm = map snd asl in let ths = itlist (@) (mapfilter RES_CANON asm) [] in let imps = check "RES_THEN: no implication" ths in let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asm)) imps [] in let res = check "RES_THEN: no resolvents " l in let tacs = check "RES_THEN: no tactics" (mapfilter ttac res) in EVERY tacs (asl,g) in IMP_RES_THEN,RES_THEN;; let IMP_RES_TAC th g = try IMP_RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) th g with Failure _ -> ALL_TAC g;; let RES_TAC g = try RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) g with Failure _ -> ALL_TAC g;; (* ------------------------------------------------------------------------- *) (* Stuff for handling type definitions. *) (* ------------------------------------------------------------------------- *) let prove_rep_fn_one_one th = try let thm = CONJUNCT1 th in let A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl thm))))) in let _,[aty;rty] = dest_type (type_of R) in let a = mk_primed_var("a",aty) in let a' = variant [a] a in let a_eq_a' = mk_eq(a,a') and Ra_eq_Ra' = mk_eq(mk_comb(R,a),mk_comb (R,a')) in let th1 = AP_TERM A (ASSUME Ra_eq_Ra') in let ga1 = genvar aty and ga2 = genvar aty in let th2 = SUBST [SPEC a thm,ga1;SPEC a' thm,ga2] (mk_eq(ga1,ga2)) th1 in let th3 = DISCH a_eq_a' (AP_TERM R (ASSUME a_eq_a')) in GEN a (GEN a' (IMP_ANTISYM_RULE (DISCH Ra_eq_Ra' th2) th3)) with Failure _ -> failwith "prove_rep_fn_one_one";; let prove_rep_fn_onto th = try let [th1;th2] = CONJUNCTS th in let r,eq = (I F_F rhs)(dest_forall(concl th2)) in let RE,ar = dest_comb(lhs eq) and sr = (mk_eq o (fun (x,y) -> y,x) o dest_eq) eq in let a = mk_primed_var ("a",type_of ar) in let sra = mk_eq(r,mk_comb(RE,a)) in let ex = mk_exists(a,sra) in let imp1 = EXISTS (ex,ar) (SYM(ASSUME eq)) in let v = genvar (type_of r) and A = rator ar and s' = AP_TERM RE (SPEC a th1) in let th = SUBST[SYM(ASSUME sra),v](mk_eq(mk_comb(RE,mk_comb(A,v)),v))s' in let imp2 = CHOOSE (a,ASSUME ex) th in let swap = IMP_ANTISYM_RULE (DISCH eq imp1) (DISCH ex imp2) in GEN r (TRANS (SPEC r th2) swap) with Failure _ -> failwith "prove_rep_fn_onto";; let prove_abs_fn_onto th = try let [th1;th2] = CONJUNCTS th in let a,(A,R) = (I F_F ((I F_F rator)o dest_comb o lhs)) (dest_forall(concl th1)) in let thm1 = EQT_ELIM(TRANS (SPEC (mk_comb (R,a)) th2) (EQT_INTRO (AP_TERM R (SPEC a th1)))) in let thm2 = SYM(SPEC a th1) in let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) in let ex = mk_exists(r,mk_conj(mk_eq(a,mk_comb(A,r)),mk_comb(P,r))) in GEN a (EXISTS(ex,mk_comb(R,a)) (CONJ thm2 thm1)) with Failure _ -> failwith "prove_abs_fn_onto";; let prove_abs_fn_one_one th = try let [th1;th2] = CONJUNCTS th in let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) and A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl th1))))) in let r' = variant [r] r in let as1 = ASSUME(mk_comb(P,r)) and as2 = ASSUME(mk_comb(P,r')) in let t1 = EQ_MP (SPEC r th2) as1 and t2 = EQ_MP (SPEC r' th2) as2 in let eq = (mk_eq(mk_comb(A,r),mk_comb(A,r'))) in let v1 = genvar(type_of r) and v2 = genvar(type_of r) in let i1 = DISCH eq (SUBST [t1,v1;t2,v2] (mk_eq(v1,v2)) (AP_TERM R (ASSUME eq))) and i2 = DISCH (mk_eq(r,r')) (AP_TERM A (ASSUME (mk_eq(r,r')))) in let thm = IMP_ANTISYM_RULE i1 i2 in let disch = DISCH (mk_comb(P,r)) (DISCH (mk_comb(P,r')) thm) in GEN r (GEN r' disch) with Failure _ -> failwith "prove_abs_fn_one_one";; (* ------------------------------------------------------------------------- *) (* AC rewriting needs to be wrapped up as a special conversion. *) (* ------------------------------------------------------------------------- *) let AC_CONV(assoc,sym) = let th1 = SPEC_ALL assoc and th2 = SPEC_ALL sym in let th3 = GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) [th2] th1 in let th4 = SYM th1 in let th5 = GEN_REWRITE_RULE RAND_CONV [th4] th3 in EQT_INTRO o AC(end_itlist CONJ [th2; th4; th5]);; let AC_RULE ths = EQT_ELIM o AC_CONV ths;; (* ------------------------------------------------------------------------- *) (* The order of picking conditionals is different! *) (* ------------------------------------------------------------------------- *) let (COND_CASES_TAC :tactic) = let is_good_cond tm = try not(is_const(fst(dest_cond tm))) with Failure _ -> false in fun (asl,w) -> let cond = find_term (fun tm -> is_good_cond tm && free_in tm w) w in let p,(t,u) = dest_cond cond in let inst = INST_TYPE [type_of t, `:A`] COND_CLAUSES in let (ct,cf) = CONJ_PAIR (SPEC u (SPEC t inst)) in DISJ_CASES_THEN2 (fun th -> SUBST1_TAC (EQT_INTRO th) THEN SUBST1_TAC ct THEN ASSUME_TAC th) (fun th -> SUBST1_TAC (EQF_INTRO th) THEN SUBST1_TAC cf THEN ASSUME_TAC th) (SPEC p EXCLUDED_MIDDLE) (asl,w) ;; (* ------------------------------------------------------------------------- *) (* MATCH_MP_TAC allows universals on the right of implication. *) (* Here's a crude hack to allow it. *) (* ------------------------------------------------------------------------- *) let MATCH_MP_TAC th = MATCH_MP_TAC th ORELSE MATCH_MP_TAC(PURE_REWRITE_RULE[RIGHT_IMP_FORALL_THM] th);; (* ------------------------------------------------------------------------- *) (* Various theorems have different names. *) (* ------------------------------------------------------------------------- *) let ZERO_LESS_EQ = LE_0;; let LESS_EQ_MONO = LE_SUC;; let NOT_LESS = NOT_LT;; let LESS_0 = LT_0;; let LESS_EQ_REFL = LE_REFL;; let LESS_EQUAL_ANTISYM = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ANTISYM)));; let NOT_LESS_0 = GEN_ALL(EQF_ELIM(SPEC_ALL(CONJUNCT1 LT)));; let LESS_TRANS = LT_TRANS;; let LESS_LEMMA1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL(CONJUNCT2 LT))));; let LESS_SUC_REFL = prove(`!n. n < SUC n`,REWRITE_TAC[LT]);; let FACT_LESS = FACT_LT;; let LESS_EQ_SUC_REFL = prove(`!n. n <= SUC n`,REWRITE_TAC[LE; LE_REFL]);; let LESS_EQ_ADD = LE_ADD;; let GREATER_EQ = GE;; let LESS_EQUAL_ADD = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_EXISTS)));; let LESS_EQ_IMP_LESS_SUC = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_SUC_LE)));; let LESS_IMP_LESS_OR_EQ = LT_IMP_LE;; let LESS_MONO_ADD = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_ADD_RCANCEL)));; let LESS_SUC = prove(`!m n. m < n ==> m < (SUC n)`,MESON_TAC[LT]);; let LESS_CASES = LTE_CASES;; let LESS_EQ = GSYM LE_SUC_LT;; let LESS_OR_EQ = LE_LT;; let LESS_ADD_1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL (REWRITE_RULE[ADD1] LT_EXISTS))));; let SUC_SUB1 = prove(`!m. SUC m - 1 = m`, REWRITE_TAC[num_CONV `1`; SUB_SUC; SUB_0]);; let LESS_MONO_EQ = LT_SUC;; let LESS_ADD_SUC = prove (`!m n. m < m + SUC n`, REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE; LE_ADD]);; let LESS_REFL = LT_REFL;; let INV_SUC_EQ = SUC_INJ;; let LESS_EQ_CASES = LE_CASES;; let LESS_EQ_TRANS = LE_TRANS;; let LESS_THM = CONJUNCT2 LT;; let GREATER = GT;; let LESS_EQ_0 = CONJUNCT1 LE;; let OR_LESS = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_SUC_LT)));; let SUB_EQUAL_0 = SUB_REFL;; let SUB_MONO_EQ = SUB_SUC;; let NOT_SUC_LESS_EQ = prove (`!n m. ~(SUC n <= m) <=> m <= n`, REWRITE_TAC[NOT_LE; LT] THEN MESON_TAC[LE_LT]);; let SUC_NOT = GSYM NOT_SUC;; let LESS_LESS_CASES = prove(`!m n:num. (m = n) \/ m < n \/ n < m`, MESON_TAC[LT_CASES]);; let NOT_LESS_EQUAL = NOT_LE;; let LESS_EQ_EXISTS = LE_EXISTS;; let LESS_MONO_ADD_EQ = LT_ADD_RCANCEL;; let LESS_LESS_EQ_TRANS = LTE_TRANS;; let SUB_SUB = ARITH_RULE `!b c. c <= b ==> (!a:num. a - (b - c) = (a + c) - b)`;; let LESS_CASES_IMP = ARITH_RULE `!m n:num. ~(m < n) /\ ~(m = n) ==> n < m`;; let SUB_LESS_EQ = ARITH_RULE `!n m:num. (n - m) <= n`;; let SUB_EQ_EQ_0 = ARITH_RULE `!m n:num. (m - n = m) <=> (m = 0) \/ (n = 0)`;; let SUB_LEFT_LESS_EQ = ARITH_RULE `!m n p:num. m <= (n - p) <=> (m + p) <= n \/ m <= 0`;; let SUB_LEFT_GREATER_EQ = ARITH_RULE `!m n p:num. m >= (n - p) <=> (m + p) >= n`;; let LESS_EQ_LESS_TRANS = LET_TRANS;; let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; let LESS_OR = ARITH_RULE `!m n. m < n ==> (SUC m) <= n`;; let SUB = ARITH_RULE `(!m. 0 - m = 0) /\ (!m n. (SUC m) - n = (if m < n then 0 else SUC(m - n)))`;; let LESS_MULT_MONO = prove (`!m i n. ((SUC n) * m) < ((SUC n) * i) <=> m < i`, REWRITE_TAC[LT_MULT_LCANCEL; NOT_SUC]);; let LESS_MONO_MULT = prove (`!m n p. m <= n ==> (m * p) <= (n * p)`, SIMP_TAC[LE_MULT_RCANCEL]);; let LESS_MULT2 = prove (`!m n. 0 < m /\ 0 < n ==> 0 < (m * n)`, REWRITE_TAC[LT_MULT]);; let SUBSET_FINITE = prove (`!s. FINITE s ==> (!t. t SUBSET s ==> FINITE t)`, MESON_TAC[FINITE_SUBSET]);; let LESS_EQ_SUC = prove (`!n. m <= SUC n <=> (m = SUC n) \/ m <= n`, REWRITE_TAC[LE]);; let ANTE_RES_THEN ttac th = FIRST_ASSUM(fun t -> ttac (MATCH_MP t th));; let IMP_RES_THEN ttac th = FIRST_ASSUM(fun t -> ttac (MATCH_MP th t));; (* ------------------------------------------------------------------------ *) (* Set theory lemmas. *) (* ------------------------------------------------------------------------ *) let INFINITE_MEMBER = prove( `!s. INFINITE(s:A->bool) ==> ?x. x IN s`, GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `~(s:A->bool = {})` MP_TAC THENL [UNDISCH_TAC `INFINITE (s:A->bool)` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INFINITE; FINITE_EMPTY]; REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN PURE_ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN REWRITE_TAC[]]);; let INFINITE_CHOOSE = prove( `!s:A->bool. INFINITE(s) ==> ((@) s) IN s`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_MEMBER) THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[IN] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[]);; let INFINITE_DELETE = prove( `!(t:A->bool) x. INFINITE (t DELETE x) = INFINITE(t)`, REWRITE_TAC[INFINITE; FINITE_DELETE]);; let INFINITE_INSERT = prove( `!(x:A) t. INFINITE(x INSERT t) = INFINITE(t)`, REWRITE_TAC[INFINITE; FINITE_INSERT]);; let SIZE_INSERT = prove( `!(x:A) t. ~(x IN t) /\ t HAS_SIZE n ==> (x INSERT t) HAS_SIZE (SUC n)`, SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_RULES]);; let SIZE_DELETE = prove( `!(x:A) t. x IN t /\ t HAS_SIZE (SUC n) ==> (t DELETE x) HAS_SIZE n`, SIMP_TAC[HAS_SIZE_SUC]);; let SIZE_EXISTS = prove( `!s N. s HAS_SIZE (SUC N) ==> ?x:A. x IN s`, SIMP_TAC[HAS_SIZE_SUC; GSYM MEMBER_NOT_EMPTY]);; let SUBSET_DELETE = prove( `!s t (x:A). s SUBSET t ==> (s DELETE x) SUBSET t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:A->bool` THEN ASM_REWRITE_TAC[DELETE_SUBSET]);; let INFINITE_FINITE_CHOICE = prove( `!n (s:A->bool). INFINITE(s) ==> ?t. t SUBSET s /\ t HAS_SIZE n`, INDUCT_TAC THEN GEN_TAC THEN DISCH_TAC THENL [EXISTS_TAC `{}:A->bool` THEN REWRITE_TAC[HAS_SIZE; EMPTY_SUBSET; HAS_SIZE_0]; FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `s DELETE ((@) s :A)`) THEN ASM_REWRITE_TAC[INFINITE_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `((@) s :A) INSERT t` THEN CONJ_TAC THENL [REWRITE_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC INFINITE_CHOOSE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[IN_DELETE] THEN CONV_TAC(EQT_INTRO o TAUT)]; MATCH_MP_TAC SIZE_INSERT THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `t SUBSET (s DELETE ((@) s:A))` THEN REWRITE_TAC[SUBSET; IN_DELETE] THEN DISCH_THEN(IMP_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]);; let IMAGE_WOP_LEMMA = prove( `!N (t:num->bool) (u:A->bool). u SUBSET (IMAGE f t) /\ u HAS_SIZE (SUC N) ==> ?n v. (u = (f n) INSERT v) /\ !y. y IN v ==> ?m. (y = f m) /\ n < m`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\n:num. ?y:A. y IN u /\ (y = f n)` num_WOP) THEN BETA_TAC THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN FIRST_ASSUM(X_CHOOSE_TAC `y:A` o MATCH_MP SIZE_EXISTS) THEN FIRST_ASSUM(MP_TAC o SPEC `y:A` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [MAP_EVERY EXISTS_TAC [`n:num`; `y:A`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`m:num`; `u DELETE (x:A)`] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INSERT_DELETE THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_ACCEPT_TAC; X_GEN_TAC `z:A` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `z:A` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[GSYM NOT_LESS_EQUAL] THEN REWRITE_TAC[LESS_OR_EQ; DE_MORGAN_THM] THEN CONJ_TAC THENL [DISCH_THEN(ANTE_RES_THEN (MP_TAC o CONV_RULE NOT_EXISTS_CONV)) THEN DISCH_THEN(MP_TAC o SPEC `z:A`) THEN REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `~(z:A = x)` THEN ASM_REWRITE_TAC[]]]);; (* ------------------------------------------------------------------------ *) (* Lemma about finite colouring of natural numbers. *) (* ------------------------------------------------------------------------ *) let COLOURING_LEMMA = prove( `!M col s. (INFINITE(s) /\ !n:A. n IN s ==> col(n) <= M) ==> ?c t. t SUBSET s /\ INFINITE(t) /\ !n:A. n IN t ==> (col(n) = c)`, INDUCT_TAC THENL [REWRITE_TAC[LESS_EQ_0] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`0`; `s:A->bool`] THEN ASM_REWRITE_TAC[SUBSET_REFL]; REPEAT STRIP_TAC THEN SUBGOAL_THEN `INFINITE { x:A | x IN s /\ (col x = SUC M) } \/ INFINITE { x:A | x IN s /\ col x <= M}` DISJ_CASES_TAC THENL [UNDISCH_TAC `INFINITE(s:A->bool)` THEN REWRITE_TAC[INFINITE; GSYM DE_MORGAN_THM; GSYM FINITE_UNION] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP SUBSET_FINITE) THEN REWRITE_TAC[SUBSET; IN_UNION] THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM LESS_EQ_SUC] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MAP_EVERY EXISTS_TAC [`SUC M`; `{ x:A | x IN s /\ (col x = SUC M)}`] THEN ASM_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `!n:A. n IN { x | x IN s /\ col x <= M } ==> col(n) <= M` MP_TAC THENL [GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MATCH_ACCEPT_TAC o CONJUNCT2); FIRST_X_ASSUM(MP_TAC o SPECL [`col:A->num`; `{ x:A | x IN s /\ col x <= M}`]) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `(c ==> d) ==> (b ==> c) ==> b ==> d`) THEN DISCH_THEN(X_CHOOSE_THEN `c:num` (X_CHOOSE_TAC `t:A->bool`)) THEN MAP_EVERY EXISTS_TAC [`c:num`; `t:A->bool`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `{ x:A | x IN s /\ col x <= M }` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]]);; let COLOURING_THM = prove( `!M col. (!n. col n <= M) ==> ?c s. INFINITE(s) /\ !n:num. n IN s ==> (col(n) = c)`, REPEAT STRIP_TAC THEN MP_TAC (ISPECL [`M:num`; `col:num->num`; `UNIV:num->bool`] COLOURING_LEMMA) THEN ASM_REWRITE_TAC[num_INFINITE] THEN DISCH_THEN(X_CHOOSE_THEN `c:num` (X_CHOOSE_TAC `t:num->bool`)) THEN MAP_EVERY EXISTS_TAC [`c:num`; `t:num->bool`] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------ *) (* Simple approach via lemmas then induction over size of coloured sets. *) (* ------------------------------------------------------------------------ *) let RAMSEY_LEMMA1 = prove( `(!C s. INFINITE(s:A->bool) /\ (!t. t SUBSET s /\ t HAS_SIZE N ==> C(t) <= M) ==> ?t c. INFINITE(t) /\ t SUBSET s /\ (!u. u SUBSET t /\ u HAS_SIZE N ==> (C(u) = c))) ==> !C s. INFINITE(s:A->bool) /\ (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) ==> ?t c. INFINITE(t) /\ t SUBSET s /\ ~(((@) s) IN t) /\ (!u. u SUBSET t /\ u HAS_SIZE N ==> (C(((@) s) INSERT u) = c))`, DISCH_THEN((THEN) (REPEAT STRIP_TAC) o MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `\u. C (((@) s :A) INSERT u):num`) THEN DISCH_THEN(MP_TAC o SPEC `s DELETE ((@)s:A)`) THEN BETA_TAC THEN ASM_REWRITE_TAC[INFINITE_DELETE] THEN W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [UNDISCH_TAC `t SUBSET (s DELETE ((@) s :A))` THEN REWRITE_TAC[SUBSET; IN_INSERT; IN_DELETE; NOT_IN_EMPTY] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC INFINITE_CHOOSE; FIRST_ASSUM(ANTE_RES_THEN ASSUME_TAC)] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC SIZE_INSERT THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `t SUBSET (s DELETE ((@) s :A))` THEN ASM_REWRITE_TAC[SUBSET; IN_DELETE] THEN DISCH_THEN(MP_TAC o SPEC `(@)s:A`) THEN ASM_REWRITE_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `t:A->bool` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:num` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`t:A->bool`; `c:num`] THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN(fun th -> REWRITE_TAC[th])); DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]);; let RAMSEY_LEMMA2 = prove( `(!C s. INFINITE(s:A->bool) /\ (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) ==> ?t c. INFINITE(t) /\ t SUBSET s /\ ~(((@) s) IN t) /\ (!u. u SUBSET t /\ u HAS_SIZE N ==> (C(((@) s) INSERT u) = c))) ==> !C s. INFINITE(s:A->bool) /\ (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) ==> ?t x col. (!n. col n <= M) /\ (!n. (t n) SUBSET s) /\ (!n. t(SUC n) SUBSET (t n)) /\ (!n. ~((x n) IN (t n))) /\ (!n. x(SUC n) IN (t n)) /\ (!n. (x n) IN s) /\ (!n u. u SUBSET (t n) /\ u HAS_SIZE N ==> (C((x n) INSERT u) = col n))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:A->bool`; `\s (n:num). @t:A->bool. ?c:num. INFINITE(t) /\ t SUBSET s /\ ~(((@) s) IN t) /\ !u. u SUBSET t /\ u HAS_SIZE N ==> (C(((@) s) INSERT u) = c)`] num_Axiom) THEN DISCH_THEN(MP_TAC o BETA_RULE o EXISTENCE) THEN DISCH_THEN(X_CHOOSE_THEN `f:num->(A->bool)` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n:num. (f n) SUBSET (s:A->bool) /\ ?c. INFINITE(f(SUC n)) /\ f(SUC n) SUBSET (f n) /\ ~(((@)(f n)) IN (f(SUC n))) /\ !u. u SUBSET (f(SUC n)) /\ u HAS_SIZE N ==> (C(((@)(f n)) INSERT u) = c:num)` MP_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC[SUBSET_REFL]; FIRST_ASSUM(SUBST1_TAC o SPEC `0`) THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `f(n:num):A->bool` THEN CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM(SUBST1_TAC o SPEC `SUC n`) THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC SUBSET_TRANS THEN FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC])) THEN MATCH_ACCEPT_TAC SUBSET_REFL]; PURE_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; FORALL_AND_THM] THEN DISCH_THEN(REPEAT_TCL (CONJUNCTS_THEN2 ASSUME_TAC) MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `col:num->num` o CONV_RULE SKOLEM_CONV) THEN MAP_EVERY EXISTS_TAC [`\n:num. f(SUC n):A->bool`; `\n:num. (@)(f n):A`] THEN BETA_TAC THEN EXISTS_TAC `col:num->num` THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_FINITE_CHOICE o SPEC `n:num`) THEN DISCH_THEN(CHOOSE_THEN MP_TAC o SPEC `N:num`) THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN ANTE_RES_THEN MP_TAC th) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN EXISTS_TAC `n:num` THEN MATCH_MP_TAC INFINITE_CHOOSE THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `f(SUC n):A->bool` THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC SIZE_INSERT THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `!n:num. ~(((@)(f n):A) IN (f(SUC n)))` THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_ACCEPT_TAC o REWRITE_RULE[SUBSET])]; REPEAT CONJ_TAC THEN TRY (FIRST_ASSUM MATCH_ACCEPT_TAC) THENL [GEN_TAC; INDUCT_TAC THENL [ASM_REWRITE_TAC[]; FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN EXISTS_TAC `SUC n`]] THEN MATCH_MP_TAC INFINITE_CHOOSE THEN ASM_REWRITE_TAC[]]]);; let RAMSEY_LEMMA3 = prove( `(!C s. INFINITE(s:A->bool) /\ (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) ==> ?t x col. (!n. col n <= M) /\ (!n. (t n) SUBSET s) /\ (!n. t(SUC n) SUBSET (t n)) /\ (!n. ~((x n) IN (t n))) /\ (!n. x(SUC n) IN (t n)) /\ (!n. (x n) IN s) /\ (!n u. u SUBSET (t n) /\ u HAS_SIZE N ==> (C((x n) INSERT u) = col n))) ==> !C s. INFINITE(s:A->bool) /\ (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) ==> ?t c. INFINITE(t) /\ t SUBSET s /\ (!u. u SUBSET t /\ u HAS_SIZE (SUC N) ==> (C(u) = c))`, DISCH_THEN((THEN) (REPEAT STRIP_TAC) o MP_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`C:(A->bool)->num`; `s:A->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:num->(A->bool)` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:num->A` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `col:num->num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`M:num`; `col:num->num`; `UNIV:num->bool`] COLOURING_LEMMA) THEN ASM_REWRITE_TAC[num_INFINITE] THEN DISCH_THEN(X_CHOOSE_THEN `c:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:num->bool` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`IMAGE (x:num->A) t`; `c:num`] THEN SUBGOAL_THEN `!m n. m <= n ==> (t n:A->bool) SUBSET (t m)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[LESS_EQ_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUBSET_REFL] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `t(m + d):A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m < n ==> (x n:A) IN (t m)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN FIRST_ASSUM(MP_TAC o SPECL [`m:num`; `m + d`]) THEN REWRITE_TAC[LESS_EQ_ADD; SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM ADD1; ADD_CLAUSES]; ALL_TAC] THEN SUBGOAL_THEN `!m n. ((x:num->A) m = x n) <=> (m = n)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`m:num`; `n:num`] LESS_LESS_CASES) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST1_TAC THEN REFL_TAC]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `INFINITE(t:num->bool)` THEN MATCH_MP_TAC INFINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET; IN_IMAGE] THEN GEN_TAC THEN DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o CONJUNCT1)) THEN ASM_REWRITE_TAC[]; GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP IMAGE_WOP_LEMMA) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `v:A->bool` MP_TAC)) THEN DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `c = (col:num->num) n` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `u SUBSET (IMAGE (x:num->A) t)` THEN REWRITE_TAC[SUBSET; IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `(x:num->A) n`) THEN ASM_REWRITE_TAC[IN_INSERT] THEN DISCH_THEN(CHOOSE_THEN STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `v = u DELETE ((x:num->A) n)` SUBST1_TAC THENL [ASM_REWRITE_TAC[] THEN REWRITE_TAC[DELETE_INSERT] THEN REWRITE_TAC[EXTENSION; IN_DELETE; TAUT `(a <=> a /\ b) <=> a ==> b`] THEN GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[LESS_REFL]; MATCH_MP_TAC SIZE_DELETE THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_INSERT]; FIRST_ASSUM MATCH_ACCEPT_TAC]]]]]);; let RAMSEY = prove( `!M N C s. INFINITE(s:A->bool) /\ (!t. t SUBSET s /\ t HAS_SIZE N ==> C(t) <= M) ==> ?t c. INFINITE(t) /\ t SUBSET s /\ (!u. u SUBSET t /\ u HAS_SIZE N ==> (C(u) = c))`, GEN_TAC THEN INDUCT_TAC THENL [REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`s:A->bool`; `(C:(A->bool)->num) {}`] THEN ASM_REWRITE_TAC[HAS_SIZE_0] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL]; MAP_EVERY MATCH_MP_TAC [RAMSEY_LEMMA3; RAMSEY_LEMMA2; RAMSEY_LEMMA1] THEN POP_ASSUM MATCH_ACCEPT_TAC]);; hol-light/100/ratcountable.ml000066400000000000000000000061751303454263000162730ustar00rootroot00000000000000(* ========================================================================= *) (* Theorem 3: countability of rational numbers. *) (* ========================================================================= *) needs "Library/card.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Definition of rational and countable. *) (* ------------------------------------------------------------------------- *) let rational = new_definition `rational(r) <=> ?p q. ~(q = 0) /\ (abs(r) = &p / &q)`;; let countable = new_definition `countable s <=> s <=_c (UNIV:num->bool)`;; (* ------------------------------------------------------------------------- *) (* Proof of the main result. *) (* ------------------------------------------------------------------------- *) let COUNTABLE_RATIONALS = prove (`countable { x:real | rational(x)}`, REWRITE_TAC[countable] THEN TRANS_TAC CARD_LE_TRANS `{ x:real | ?p q. x = &p / &q } *_c (UNIV:num->bool)` THEN CONJ_TAC THENL [REWRITE_TAC[LE_C; EXISTS_PAIR_THM; mul_c] THEN EXISTS_TAC `\(x,b). if b = 0 then x else --x` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM; rational; IN_UNIV; PAIR_EQ] THEN MESON_TAC[REAL_ARITH `(abs(x) = a) ==> (x = a) \/ x = --a`]; ALL_TAC] THEN MATCH_MP_TAC CARD_MUL_ABSORB_LE THEN REWRITE_TAC[num_INFINITE] THEN TRANS_TAC CARD_LE_TRANS `(UNIV *_c UNIV):num#num->bool` THEN CONJ_TAC THENL [REWRITE_TAC[LE_C; EXISTS_PAIR_THM; mul_c; IN_UNIV] THEN EXISTS_TAC `\(p,q). &p / &q` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM; rational] THEN MESON_TAC[]; MESON_TAC[CARD_MUL_ABSORB_LE; CARD_LE_REFL; num_INFINITE]]);; (* ------------------------------------------------------------------------- *) (* Maybe I should actually prove equality? *) (* ------------------------------------------------------------------------- *) let denumerable = new_definition `denumerable s <=> s =_c (UNIV:num->bool)`;; let DENUMERABLE_RATIONALS = prove (`denumerable { x:real | rational(x)}`, REWRITE_TAC[denumerable; GSYM CARD_LE_ANTISYM] THEN REWRITE_TAC[GSYM countable; COUNTABLE_RATIONALS] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `&` THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV; REAL_OF_NUM_EQ; rational] THEN X_GEN_TAC `p:num` THEN MAP_EVERY EXISTS_TAC [`p:num`; `1`] THEN REWRITE_TAC[REAL_DIV_1; REAL_ABS_NUM; ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* Expand out the cardinal comparison definitions for explicitness. *) (* ------------------------------------------------------------------------- *) let DENUMERABLE_RATIONALS_EXPAND = prove (`?rat:num->real. (!n. rational(rat n)) /\ (!x. rational x ==> ?!n. x = rat n)`, MP_TAC DENUMERABLE_RATIONALS THEN REWRITE_TAC[denumerable] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[eq_c] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);; hol-light/100/realsuncountable.ml000066400000000000000000000275361303454263000171620ustar00rootroot00000000000000(* ========================================================================= *) (* #22: non-denumerability of continuum (= uncountability of the reals). *) (* ========================================================================= *) needs "Library/card.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Definition of countability. *) (* ------------------------------------------------------------------------- *) let countable = new_definition `countable s <=> s <=_c (UNIV:num->bool)`;; (* ------------------------------------------------------------------------- *) (* Set of repeating digits and its countability. *) (* ------------------------------------------------------------------------- *) let repeating = new_definition `repeating = {s:num->bool | ?n. !m. m >= n ==> s m}`;; let BINARY_BOUND = prove (`!n. nsum(0..n) (\i. if b(i) then 2 EXP i else 0) < 2 EXP (n + 1)`, INDUCT_TAC THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THENL [COND_CASES_TAC THEN REWRITE_TAC[ARITH]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[LE_0; EXP_ADD; EXP_1; EXP] THEN ARITH_TAC);; let BINARY_DIV_POW2 = prove (`!n. (nsum(0..n) (\i. if b(i) then 2 EXP i else 0)) DIV (2 EXP (SUC n)) = 0`, SIMP_TAC[ADD1; DIV_LT; BINARY_BOUND]);; let PLUS_MOD_REFL = prove (`!a b. ~(b = 0) ==> (a + b) MOD b = a MOD b`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_EQ THEN MESON_TAC[MULT_CLAUSES]);; let BINARY_PLUS_DIV_POW2 = prove (`!n. (nsum(0..n) (\i. if b(i) then 2 EXP i else 0) + 2 EXP (SUC n)) DIV (2 EXP (SUC n)) = 1`, GEN_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `nsum(0..n) (\i. if b(i) then 2 EXP i else 0)` THEN ASM_REWRITE_TAC[BINARY_BOUND; ADD1] THEN REWRITE_TAC[ADD_AC; MULT_CLAUSES]);; let BINARY_UNIQUE_LEMMA = prove (`!n. nsum(0..n) (\i. if b(i) then 2 EXP i else 0) = nsum(0..n) (\i. if c(i) then 2 EXP i else 0) ==> !i. i <= n ==> (b(i) <=> c(i))`, INDUCT_TAC THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THENL [SIMP_TAC[LE] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]); REWRITE_TAC[LE_0]] THEN REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THENL [UNDISCH_THEN `i = SUC n` SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x DIV (2 EXP (SUC n))`) THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; BINARY_DIV_POW2; BINARY_PLUS_DIV_POW2] THEN REWRITE_TAC[ARITH_EQ]; FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x MOD (2 EXP (SUC n))`) THEN REPEAT COND_CASES_TAC THEN SIMP_TAC[ADD_CLAUSES; BINARY_BOUND; MOD_LT; PLUS_MOD_REFL; EXP_EQ_0; ARITH; ADD1] THEN ASM_MESON_TAC[LE_REFL]]);; let COUNTABLE_REPEATING = prove (`countable repeating`, REWRITE_TAC[countable] THEN TRANS_TAC CARD_LE_TRANS `(UNIV:num->bool) *_c (UNIV:num->bool)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_SQUARE_NUM]] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\s:num->bool. let n = minimal n. !m. m >= n ==> s m in n,nsum(0..n) (\i. if s(i) then 2 EXP i else 0)` THEN REWRITE_TAC[repeating; IN_ELIM_THM] THEN CONJ_TAC THENL [GEN_TAC THEN LET_TAC THEN REWRITE_TAC[mul_c; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`s:num->bool`; `t:num->bool`] THEN ONCE_REWRITE_TAC[MINIMAL] THEN ABBREV_TAC `k = minimal n. !m. m >= n ==> s m` THEN ABBREV_TAC `l = minimal n. !m. m >= n ==> t m` THEN ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; PAIR_EQ] THEN REPEAT(POP_ASSUM(K ALL_TAC)) THEN ASM_CASES_TAC `l:num = k` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[FUN_EQ_THM; GE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BINARY_UNIQUE_LEMMA) THEN ASM_MESON_TAC[LE_CASES]);; (* ------------------------------------------------------------------------- *) (* Canonical digits and their uncountability. *) (* ------------------------------------------------------------------------- *) let canonical = new_definition `canonical = {s:num->bool | !n. ?m. m >= n /\ ~(s m)}`;; let UNCOUNTABLE_CANONICAL = prove (`~countable canonical`, REWRITE_TAC[countable] THEN STRIP_TAC THEN MP_TAC (INST_TYPE [`:num`,`:A`] CANTOR_THM_UNIV) THEN REWRITE_TAC[CARD_NOT_LT] THEN MP_TAC(ISPECL [`canonical`; `repeating`] CARD_DISJOINT_UNION) THEN ANTS_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM; canonical; repeating; GE] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `canonical UNION repeating = UNIV` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; canonical; repeating; GE; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN TRANS_TAC CARD_LE_TRANS `canonical +_c repeating` THEN ASM_SIMP_TAC[CARD_EQ_IMP_LE] THEN TRANS_TAC CARD_LE_TRANS `(UNIV:num->bool) +_c (UNIV:num->bool)` THEN CONJ_TAC THENL [ASM_MESON_TAC[countable; COUNTABLE_REPEATING; CARD_LE_ADD]; MATCH_MP_TAC CARD_ADD_ABSORB_LE THEN REWRITE_TAC[num_INFINITE; CARD_LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Injection of canonical digits into the reals. *) (* ------------------------------------------------------------------------- *) needs "Library/analysis.ml";; prioritize_real();; let SUM_BINSEQUENCE_LBOUND = prove (`!m n. &0 <= sum(m,n) (\i. if s(i) then inv(&2 pow i) else &0)`, MATCH_MP_TAC SUM_POS THEN GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; REAL_LE_INV_EQ] THEN SIMP_TAC[REAL_POW_LE; REAL_POS]);; let SUM_BINSEQUENCE_UBOUND_SHARP = prove (`!s m n. sum(m,n) (\i. if s(i) then inv(&2 pow i) else &0) <= &2 / &2 pow m - &2 / &2 pow (m + n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN REWRITE_TAC[ADD_CLAUSES; REAL_SUB_REFL; REAL_LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x + y <= a ==> x + (if b then y else &0) <= a`) THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x <= a ==> a + y <= b ==> x + y <= b`)) THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC);; let SUMMABLE_BINSEQUENCE = prove (`!s. summable (\i. if s(i) then inv(&2 pow i) else &0)`, GEN_TAC THEN REWRITE_TAC[summable; sums; GSYM convergent] THEN MATCH_MP_TAC SEQ_ICONV THEN REWRITE_TAC[MR1_BOUNDED] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`&2`; `0`] THEN REWRITE_TAC[GE; LE_0; LE_REFL] THEN X_GEN_TAC `n:num` THEN MP_TAC(SPECL [`s:num->bool`; `0`; `n:num`] SUM_BINSEQUENCE_UBOUND_SHARP) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a < b ==> x <= a ==> abs x < b`) THEN REWRITE_TAC[SUM_BINSEQUENCE_LBOUND; real_pow; REAL_DIV_1; ADD_CLAUSES] THEN REWRITE_TAC[REAL_ARITH `a - x < a <=> &0 < x`] THEN SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; GEN_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; LE_EXISTS] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> a + x >= a`) THEN REWRITE_TAC[SUM_BINSEQUENCE_LBOUND]]);; let SUMS_BINSEQUENCE = prove (`!s. (\i. if s(i) then inv(&2 pow i) else &0) sums (suminf (\i. if s(i) then inv(&2 pow i) else &0))`, SIMP_TAC[SUMMABLE_SUM; SUMMABLE_BINSEQUENCE]);; let SUM_BINSEQUENCE_UBOUND_LE = prove (`!s m n. sum(m,n) (\i. if s(i) then inv(&2 pow i) else &0) <= &2 / &2 pow m`, MP_TAC SUM_BINSEQUENCE_UBOUND_SHARP THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= b ==> x <= a - b ==> x <= a`) THEN SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS]);; (* ------------------------------------------------------------------------- *) (* The main injection and hence main theorem. *) (* ------------------------------------------------------------------------- *) let SUMINF_INJ_LEMMA = prove (`!s t n. ~(s n) /\ t n /\ (!m. m < n ==> (s(m) <=> t(m))) /\ (!n. ?m. m >= n /\ ~(s m)) ==> suminf(\n. if s n then inv (&2 pow n) else &0) < suminf(\n. if t n then inv (&2 pow n) else &0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `sum(0,n+1) (\n. if t n then inv (&2 pow n) else &0)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC [`\k:num. sum(0,n+1) (\n. if t n then inv (&2 pow n) else &0)`; `\n:num. sum(0,n) (\n. if t n then inv (&2 pow n) else &0)`] THEN REWRITE_TAC[SEQ_CONST; GSYM sums; SUMS_BINSEQUENCE] THEN EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GE; LE_EXISTS] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[GSYM ADD1] THEN REWRITE_TAC[GSYM SUM_SPLIT; REAL_LE_ADDR; SUM_BINSEQUENCE_LBOUND]] THEN ASM_REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN UNDISCH_THEN `!n:num. ?m. m >= n /\ ~s m` (MP_TAC o SPEC `n + 1`) THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(0,m) (\n. if s n then inv (&2 pow n) else &0) + inv(&2 pow m)` THEN CONJ_TAC THENL [MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC [`\n:num. sum(0,n) (\n. if s n then inv (&2 pow n) else &0)`; `\k:num. sum(0,m) (\n. if s n then inv(&2 pow n) else &0) + inv(&2 pow m)`] THEN REWRITE_TAC[SEQ_CONST; GSYM sums; SUMS_BINSEQUENCE] THEN EXISTS_TAC `m:num` THEN REWRITE_TAC[GE; LE_REFL] THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM SUM_SPLIT; REAL_LE_LADD; ADD_CLAUSES] THEN DISJ_CASES_THEN SUBST_ALL_TAC (ARITH_RULE `p = 0 \/ p = 1 + PRE p`) THEN SIMP_TAC[sum; REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN ASM_REWRITE_TAC[SUM_1; REAL_ADD_LID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &2 pow (m + 1)` THEN REWRITE_TAC[SUM_BINSEQUENCE_UBOUND_LE] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUM_1; REAL_ADD_RID] THEN MATCH_MP_TAC(REAL_ARITH `a = b /\ c < e - d ==> (a + c) + d < b + e`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[LE_0; ADD_CLAUSES]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow (n + 1) - &2 / &2 pow ((n + 1) + r)` THEN REWRITE_TAC[SUM_BINSEQUENCE_UBOUND_SHARP] THEN MATCH_MP_TAC(REAL_ARITH `a = b /\ d < c ==> a - c < b - d`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC(REAL_FIELD `&0 < inv(x) ==> inv(x) < &2 / x`) THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]]);; let UNCOUNTABLE_REALS = prove (`~countable(UNIV:real->bool)`, MP_TAC UNCOUNTABLE_CANONICAL THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[countable] THEN DISCH_TAC THEN TRANS_TAC CARD_LE_TRANS `UNIV:real->bool` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\s. suminf(\n. if s(n) then inv(&2 pow n) else &0)` THEN REWRITE_TAC[IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`s:num->bool`; `t:num->bool`] THEN REWRITE_TAC[canonical; IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_REWRITE_TAC I [MESON[] `(!x. P x) <=> ~(?x. ~P x)`] THEN ONCE_REWRITE_TAC[MINIMAL] THEN ABBREV_TAC `n = minimal x. ~(s x <=> t x)` THEN FIRST_X_ASSUM(K ALL_TAC o check (is_var o rhs o concl)) THEN ASM_CASES_TAC `(t:num->bool) n` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM) THENL [MATCH_MP_TAC(REAL_ARITH `b < a ==> a = b ==> F`); MATCH_MP_TAC(REAL_ARITH `a < b ==> a = b ==> F`)] THEN MATCH_MP_TAC SUMINF_INJ_LEMMA THEN ASM_MESON_TAC[]);; hol-light/100/reciprocity.ml000066400000000000000000001112711303454263000161360ustar00rootroot00000000000000(* ========================================================================= *) (* Quadratic reciprocity. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/pocklington.ml";; prioritize_num();; (* ------------------------------------------------------------------------- *) (* Misc. lemmas. *) (* ------------------------------------------------------------------------- *) let IN_NUMSEG_1 = prove (`!p i. i IN 1..p - 1 <=> 0 < i /\ i < p`, REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; let EVEN_DIV = prove (`!n. EVEN n <=> n = 2 * (n DIV 2)`, GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN MP_TAC(SPEC `n:num` (MATCH_MP DIVISION (ARITH_RULE `~(2 = 0)`))) THEN ARITH_TAC);; let CONG_MINUS1_SQUARE = prove (`2 <= p ==> ((p - 1) * (p - 1) == 1) (mod p)`, SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[cong; nat_mod; ARITH_RULE `(2 + x) - 1 = x + 1`] THEN MAP_EVERY EXISTS_TAC [`0`; `d:num`] THEN ARITH_TAC);; let CONG_EXP_MINUS1 = prove (`!p n. 2 <= p ==> ((p - 1) EXP n == if EVEN n then 1 else p - 1) (mod p)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH; CONG_REFL] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `(p - 1) * (if EVEN n then 1 else p - 1)` THEN ASM_SIMP_TAC[CONG_MULT; CONG_REFL; EVEN] THEN ASM_CASES_TAC `EVEN n` THEN ASM_SIMP_TAC[MULT_CLAUSES; CONG_REFL; CONG_MINUS1_SQUARE]);; let NOT_CONG_MINUS1 = prove (`!p. 3 <= p ==> ~(p - 1 == 1) (mod p)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(2 == 0) (mod p)` MP_TAC THENL [MATCH_MP_TAC CONG_ADD_LCANCEL THEN EXISTS_TAC `p - 1` THEN ONCE_REWRITE_TAC[CONG_SYM] THEN ASM_SIMP_TAC[ADD_CLAUSES; ARITH_RULE `3 <= p ==> (p - 1) + 2 = p + 1`] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `0 + 1` THEN CONJ_TAC THENL [ASM_MESON_TAC[ADD_CLAUSES]; ALL_TAC] THEN MATCH_MP_TAC CONG_ADD THEN MESON_TAC[CONG_0; CONG_SYM; DIVIDES_REFL; CONG_REFL]; REWRITE_TAC[CONG_0] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_ARITH_TAC]);; let CONG_COND_LEMMA = prove (`!p x y. 3 <= p /\ ((if x then 1 else p - 1) == (if y then 1 else p - 1)) (mod p) ==> (x <=> y)`, REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_MESON_TAC[CONG_SYM; NOT_CONG_MINUS1]);; let FINITE_SUBCROSS = prove (`!s:A->bool t:B->bool. FINITE s /\ FINITE t ==> FINITE {x,y | x IN s /\ y IN t /\ P x y}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `(s:A->bool) CROSS (t:B->bool)` THEN ASM_SIMP_TAC[FINITE_CROSS; SUBSET; IN_CROSS; FORALL_PAIR_THM; IN_ELIM_PAIR_THM]);; let CARD_SUBCROSS_DETERMINATE = prove (`FINITE s /\ FINITE t /\ (!x. x IN s /\ p(x) ==> f(x) IN t) ==> CARD {(x:A),(y:B) | x IN s /\ y IN t /\ y = f x /\ p x} = CARD {x | x IN s /\ p(x)}`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN EXISTS_TAC `\(x:A,y:B). x` THEN ASM_SIMP_TAC[FINITE_SUBCROSS; FORALL_PAIR_THM; EXISTS_UNIQUE_THM] THEN REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN SIMP_TAC[IN_ELIM_THM; PAIR_EQ] THEN ASM_MESON_TAC[]);; let CARD_SUBCROSS_SWAP = prove (`CARD {y,x | y IN 1..m /\ x IN 1..n /\ P x y} = CARD {x,y | x IN 1..n /\ y IN 1..m /\ P x y}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN EXISTS_TAC `\(x:num,y:num). (y,x)` THEN ASM_SIMP_TAC[FINITE_SUBCROSS; FINITE_NUMSEG] THEN REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN SIMP_TAC[IN_ELIM_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* What it means to be a quadratic residue. I keep in the "mod p" as what *) (* I think is a more intuitive notation. *) (* *) (* We might explicitly assume that the two numbers are coprime, ruling out *) (* the degenerate case of 0 as a quadratic residue. But this seems simpler. *) (* ------------------------------------------------------------------------- *) parse_as_infix("is_quadratic_residue",(12,"right"));; let is_quadratic_residue = new_definition `y is_quadratic_residue rel <=> ?x. (x EXP 2 == y) (rel)`;; (* ------------------------------------------------------------------------- *) (* Alternative formulation for special cases. *) (* ------------------------------------------------------------------------- *) let IS_QUADRATIC_RESIDUE = prove (`!a p. ~(p = 0) /\ ~(p divides a) ==> (a is_quadratic_residue (mod p) <=> ?x. 0 < x /\ x < p /\ (x EXP 2 == a) (mod p))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_quadratic_residue; EXP_2] THEN DISCH_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN EXISTS_TAC `x MOD p` THEN ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL [ASM_MESON_TAC[LT_NZ; GSYM DIVIDES_MOD; CONG_DIVIDES; DIVIDES_LMUL]; UNDISCH_TAC `(x * x == a) (mod p)` THEN ASM_SIMP_TAC[CONG; MOD_MULT_MOD2]]);; let IS_QUADRATIC_RESIDUE_COMMON = prove (`!a p. prime p /\ coprime(a,p) ==> (a is_quadratic_residue (mod p) <=> ?x. 0 < x /\ x < p /\ (x EXP 2 == a) (mod p))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IS_QUADRATIC_RESIDUE THEN ASM_MESON_TAC[COPRIME_PRIME; DIVIDES_REFL; PRIME_0]);; (* ------------------------------------------------------------------------- *) (* Some lemmas about dual pairs; these would be more natural over Z. *) (* ------------------------------------------------------------------------- *) let QUADRATIC_RESIDUE_PAIR_ADD = prove (`!p x y. prime p ==> (((x + y) EXP 2 == x EXP 2) (mod p) <=> p divides y \/ p divides (2 * x + y))`, REWRITE_TAC[NUM_RING `(x + y) EXP 2 = y * (y + 2 * x) + x EXP 2`] THEN SIMP_TAC[CONG_ADD_RCANCEL_EQ_0; CONG_0; PRIME_DIVPROD_EQ; ADD_SYM]);; let QUADRATIC_RESIDUE_PAIR = prove (`!p x y. prime p ==> ((x EXP 2 == y EXP 2) (mod p) <=> p divides (x + y) \/ p divides (dist(x,y)))`, GEN_TAC THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM; CONG_SYM; ADD_SYM]; ALL_TAC] THEN REWRITE_TAC[LE_EXISTS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN ASM_SIMP_TAC[QUADRATIC_RESIDUE_PAIR_ADD] THEN REWRITE_TAC[DIST_RADD_0; ARITH_RULE `x + x + d = 2 * x + d`; DISJ_ACI]);; let IS_QUADRATIC_RESIDUE_PAIR = prove (`!a p. prime p /\ coprime(a,p) ==> (a is_quadratic_residue (mod p) <=> ?x y. 0 < x /\ x < p /\ 0 < y /\ y < p /\ x + y = p /\ (x EXP 2 == a) (mod p) /\ (y EXP 2 == a) (mod p) /\ !z. 0 < z /\ z < p /\ (z EXP 2 == a) (mod p) ==> z = x \/ z = y)`, SIMP_TAC[IS_QUADRATIC_RESIDUE_COMMON] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `x:num` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`x:num`; `p - x:num`] THEN ASM_SIMP_TAC[ARITH_RULE `0 < x /\ x < p ==> 0 < p - x /\ p - x < p /\ x + (p - x) = p`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP QUADRATIC_RESIDUE_PAIR) THENL [DISCH_THEN(MP_TAC o SPECL [`x:num`; `p - x:num`]) THEN ASM_SIMP_TAC[ARITH_RULE `x < p ==> x + (p - x) = p`; DIVIDES_REFL] THEN ASM_MESON_TAC[CONG_TRANS; CONG_SYM]; DISCH_THEN(MP_TAC o SPECL [`x:num`; `z:num`]) THEN SUBGOAL_THEN `(x EXP 2 == z EXP 2) (mod p)` (fun th -> SIMP_TAC[th]) THENL [ASM_MESON_TAC[CONG_TRANS; CONG_SYM]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN (MP_TAC o MATCH_MP DIVIDES_CASES)) THEN REWRITE_TAC[ADD_EQ_0; DIST_EQ_0] THEN REWRITE_TAC[dist] THEN ASM_ARITH_TAC]);; let QUADRATIC_RESIDUE_PAIR_PRODUCT = prove (`!p x. 0 < x /\ x < p /\ (x EXP 2 == a) (mod p) ==> (x * (p - x) == (p - 1) * a) (mod p)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MP (ARITH_RULE `x < p ==> 1 <= p`)) THEN SUBGOAL_THEN `(x * (p - x) + x EXP 2 == a * (p - 1) + a * 1) (mod p)` MP_TAC THENL [ASM_SIMP_TAC[LEFT_SUB_DISTRIB; EXP_2; SUB_ADD; LE_MULT_LCANCEL; LT_IMP_LE] THEN REWRITE_TAC[cong; nat_mod] THEN ASM_MESON_TAC[ADD_SYM; MULT_SYM]; REWRITE_TAC[MULT_CLAUSES] THEN ASM_MESON_TAC[CONG_ADD; CONG_TRANS; CONG_SYM; CONG_REFL; MULT_SYM; CONG_ADD_RCANCEL]]);; (* ------------------------------------------------------------------------- *) (* Define the Legendre symbol. *) (* ------------------------------------------------------------------------- *) let legendre = new_definition `(legendre:num#num->int)(a,p) = if ~(coprime(a,p)) then &0 else if a is_quadratic_residue (mod p) then &1 else --(&1)`;; (* ------------------------------------------------------------------------- *) (* Definition of iterated product. *) (* ------------------------------------------------------------------------- *) let nproduct = new_definition `nproduct = iterate ( * )`;; let NPRODUCT_CLAUSES = prove (`(!f. nproduct {} f = 1) /\ (!x f s. FINITE(s) ==> (nproduct (x INSERT s) f = if x IN s then nproduct s f else f(x) * nproduct s f))`, REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; let NPRODUCT_DELETE = prove (`!s. FINITE s /\ a IN s ==> f(a) * nproduct(s DELETE a) f = nproduct s f`, SIMP_TAC[nproduct; ITERATE_DELETE; MONOIDAL_MUL]);; let CONG_NPRODUCT = prove (`!f g s. FINITE s /\ (!x. x IN s ==> (f x == g x) (mod n)) ==> (nproduct s f == nproduct s g) (mod n)`, REWRITE_TAC[nproduct] THEN MATCH_MP_TAC(MATCH_MP ITERATE_RELATED MONOIDAL_MUL) THEN SIMP_TAC[CONG_REFL; CONG_MULT]);; let NPRODUCT_MULT = prove (`!f g s. FINITE s ==> nproduct s (\x. f x * g x) = nproduct s f * nproduct s g`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; MULT_AC; MULT_CLAUSES]);; let NPRODUCT_INJECTION = prove (`!f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> nproduct s (f o p) = nproduct s f`, REWRITE_TAC[nproduct] THEN MATCH_MP_TAC ITERATE_INJECTION THEN REWRITE_TAC[MONOIDAL_MUL]);; let NPRODUCT_CONST = prove (`!c s. FINITE s ==> nproduct s (\x. c) = c EXP (CARD s)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; CARD_CLAUSES; EXP]);; let NPRODUCT_DELTA_CONST = prove (`!c s. FINITE s ==> nproduct s (\x. if p(x) then c else 1) = c EXP (CARD {x | x IN s /\ p(x)})`, let lemma1 = prove (`{x | x IN a INSERT s /\ p(x)} = if p(a) then a INSERT {x | x IN s /\ p(x)} else {x | x IN s /\ p(x)}`, COND_CASES_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN ASM_MESON_TAC[]) and lemma2 = prove (`FINITE s ==> FINITE {x | x IN s /\ p(x)}`, MATCH_MP_TAC(ONCE_REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] FINITE_SUBSET) THEN SIMP_TAC[SUBSET; IN_ELIM_THM]) in GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; CARD_CLAUSES; EXP; NOT_IN_EMPTY; SET_RULE `{x | F} = {}`; lemma1] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; IN_ELIM_THM; lemma2; EXP; MULT_CLAUSES]);; let COPRIME_NPRODUCT = prove (`!f p s. FINITE s /\ (!x. x IN s ==> coprime(p,f x)) ==> coprime(p,nproduct s f)`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; COPRIME_1; IN_INSERT; COPRIME_MUL]);; (* ------------------------------------------------------------------------- *) (* Factorial in terms of products. *) (* ------------------------------------------------------------------------- *) let FACT_NPRODUCT = prove (`!n. FACT(n) = nproduct(1..n) (\i. i)`, INDUCT_TAC THEN REWRITE_TAC[FACT; NUMSEG_CLAUSES; ARITH; NPRODUCT_CLAUSES] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= SUC n`; NPRODUCT_CLAUSES; FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* General "pairing up" theorem for products. *) (* ------------------------------------------------------------------------- *) let NPRODUCT_PAIRUP_INDUCT = prove (`!f r n s k. s HAS_SIZE (2 * n) /\ (!x:A. x IN s ==> ?!y. y IN s /\ ~(y = x) /\ (f(x) * f(y) == k) (mod r)) ==> (nproduct s f == k EXP n) (mod r)`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `s:A->bool` THEN GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_SIMP_TAC[MULT_CLAUSES; HAS_SIZE_0; NPRODUCT_CLAUSES; EXP; CONG_REFL]; ALL_TAC] THEN ASM_CASES_TAC `s:A->bool = {}` THENL [ASM_MESON_TAC[HAS_SIZE_0; ARITH_RULE `2 * n = 0 <=> n = 0`; HAS_SIZE]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 < n`] THEN FIRST_ASSUM(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[ASSUME `(a:A) IN s`] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`(s DELETE a) DELETE (b:A)`; `k:num`]) THEN SUBGOAL_THEN `s = (a:A) INSERT (b INSERT (s DELETE a DELETE b))` (ASSUME_TAC o SYM) THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [CONJ_TAC THENL [UNDISCH_TAC `(s:A->bool) HAS_SIZE 2 * n` THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SYM th]) THEN SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES; FINITE_DELETE; IMP_CONJ; IN_DELETE; IN_INSERT] THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:A` THEN ASM_REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(x:A) IN s`)) THEN REWRITE_TAC[EXISTS_UNIQUE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:A` THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THENL [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(b:A) IN s`)) THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a:A`; `x:A`] o CONJUNCT2) THEN ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN DISCH_TAC THEN EXPAND_TAC "s" THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE[HAS_SIZE]) THEN SIMP_TAC[NPRODUCT_CLAUSES; FINITE_INSERT; FINITE_DELETE] THEN REWRITE_TAC[IN_INSERT; IN_DELETE; MULT_CLAUSES] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = SUC(n - 1)`)) THEN ASM_REWRITE_TAC[MULT_ASSOC; EXP] THEN DISCH_TAC THEN MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* The two cases. *) (* ------------------------------------------------------------------------- *) let QUADRATIC_NONRESIDUE_FACT = prove (`!a p. prime p /\ ODD(p) /\ coprime(a,p) /\ ~(a is_quadratic_residue (mod p)) ==> (a EXP ((p - 1) DIV 2) == FACT(p - 1)) (mod p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[FACT_NPRODUCT] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN MATCH_MP_TAC NPRODUCT_PAIRUP_INDUCT THEN CONJ_TAC THENL [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN SIMP_TAC[SUC_SUB1; DIV_MULT; ARITH] THEN REWRITE_TAC[HAS_SIZE; FINITE_NUMSEG; CARD_NUMSEG; ADD_SUB]; ALL_TAC] THEN ASM_CASES_TAC `p = 0` THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN ASM_SIMP_TAC[IN_NUMSEG; ARITH_RULE `1 <= x <=> 0 < x`; ARITH_RULE `~(p = 0) ==> (x <= p - 1 <=> x < p)`] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `p:num`; `x:num`] CONG_SOLVE_UNIQUE_NONTRIVIAL) THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[is_quadratic_residue; EXP_2]);; let QUADRATIC_RESIDUE_FACT = prove (`!a p. prime p /\ ODD(p) /\ coprime(a,p) /\ a is_quadratic_residue (mod p) ==> (a EXP ((p - 1) DIV 2) == FACT(p - 2)) (mod p)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONG_SYM] THEN SUBGOAL_THEN `3 <= p /\ ~(p = 0)` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN UNDISCH_TAC `ODD(p)` THEN ASM_CASES_TAC `p = 2` THEN ASM_REWRITE_TAC[ARITH] THEN UNDISCH_TAC `~(p = 2)` THEN ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `a is_quadratic_residue (mod p)` THEN ASM_SIMP_TAC[EXP_2; IS_QUADRATIC_RESIDUE_PAIR; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `~(x:num = y)` ASSUME_TAC THENL [ASM_MESON_TAC[ODD_ADD]; ALL_TAC] THEN MP_TAC(ISPECL [`\i:num. i`; `p:num`; `(p - 3) DIV 2`; `(1..p-1) DELETE x DELETE y`; `a:num`] NPRODUCT_PAIRUP_INDUCT) THEN ANTS_TAC THENL [ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG_1; CARD_DELETE; IN_DELETE; CARD_NUMSEG_1] THEN SIMP_TAC[ARITH_RULE `p - 1 - 1 - 1 = p - 3`] THEN ASM_SIMP_TAC[GSYM EVEN_DIV; EVEN_SUB; ARITH; NOT_EVEN] THEN X_GEN_TAC `u:num` THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `p:num`; `u:num`] CONG_SOLVE_UNIQUE_NONTRIVIAL) THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN ASM_MESON_TAC[CONG_SOLVE_UNIQUE; PRIME_0; PRIME_COPRIME_LT]; ALL_TAC] THEN MP_TAC(SPECL [`p:num`; `x:num`] QUADRATIC_RESIDUE_PAIR_PRODUCT) THEN ASM_SIMP_TAC[EXP_2; IMP_IMP; ARITH_RULE `x + y = p ==> p - x = y`] THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_MULT) THEN ASM_SIMP_TAC[NPRODUCT_DELETE; GSYM MULT_ASSOC; IN_DELETE; FINITE_DELETE; IN_NUMSEG_1; FINITE_NUMSEG] THEN ASM_SIMP_TAC[GSYM(CONJUNCT2 EXP); GSYM FACT_NPRODUCT; ARITH_RULE `3 <= p ==> SUC((p - 3) DIV 2) = (p - 1) DIV 2`] THEN ASM_SIMP_TAC[FACT; ARITH_RULE `3 <= p ==> p - 1 = SUC(p - 2)`] THEN ASM_SIMP_TAC[ARITH_RULE `3 <= p ==> SUC(p - 2) = p - 1`] THEN ASM_MESON_TAC[COPRIME_MINUS1; CONG_MULT_LCANCEL; CONG_SYM]);; (* ------------------------------------------------------------------------- *) (* We immediately get one part of Wilson's theorem. *) (* ------------------------------------------------------------------------- *) let WILSON_LEMMA = prove (`!p. prime(p) ==> (FACT(p - 2) == 1) (mod p)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONG_SYM] THEN FIRST_ASSUM(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC o MATCH_MP PRIME_ODD) THENL [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC CONG_CONV; ALL_TAC] THEN MP_TAC(SPECL [`1`; `p:num`] QUADRATIC_RESIDUE_FACT) THEN ASM_MESON_TAC[is_quadratic_residue; COPRIME_SYM; COPRIME_1; CONG_REFL; EXP_ONE; CONG_SYM]);; let WILSON_IMP = prove (`!p. prime(p) ==> (FACT(p - 1) == p - 1) (mod p)`, SIMP_TAC[FACT; PRIME_GE_2; ARITH_RULE `2 <= p ==> p - 1 = SUC(p - 2)`] THEN MESON_TAC[CONG_MULT; MULT_CLAUSES; WILSON_LEMMA; CONG_REFL]);; let WILSON = prove (`!p. ~(p = 1) ==> (prime p <=> (FACT(p - 1) == p - 1) (mod p))`, X_GEN_TAC `n:num` THEN DISCH_TAC THEN EQ_TAC THEN SIMP_TAC[WILSON_IMP] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[LE_LT] THEN ASM_CASES_TAC `n:num = p` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `x < y ==> x <= y - 1`)) THEN ASM_SIMP_TAC[GSYM DIVIDES_FACT_PRIME] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN SUBGOAL_THEN `p divides FACT(n - 1) <=> p divides (n - 1)` SUBST1_TAC THENL [MATCH_MP_TAC CONG_DIVIDES THEN MATCH_MP_TAC CONG_MOD_MULT THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `p divides 1` MP_TAC THENL [MATCH_MP_TAC DIVIDES_ADD_REVR THEN EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`]; REWRITE_TAC[DIVIDES_ONE] THEN ASM_MESON_TAC[PRIME_1]]);; (* ------------------------------------------------------------------------- *) (* Using Wilson's theorem we can get the Euler criterion. *) (* ------------------------------------------------------------------------- *) let EULER_CRITERION = prove (`!a p. prime p /\ coprime(a,p) ==> (a EXP ((p - 1) DIV 2) == (if a is_quadratic_residue (mod p) then 1 else p - 1)) (mod p)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC o MATCH_MP PRIME_ODD) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COND_ID; EXP; CONG_REFL] THEN ASM_MESON_TAC[WILSON_LEMMA; WILSON_IMP; CONG_TRANS; CONG_SYM; QUADRATIC_RESIDUE_FACT; QUADRATIC_NONRESIDUE_FACT]);; (* ------------------------------------------------------------------------- *) (* Gauss's Lemma. *) (* ------------------------------------------------------------------------- *) let GAUSS_LEMMA_1 = prove (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p ==> nproduct(1..r) (\x. let b = (a * x) MOD p in if b <= r then b else p - b) = nproduct(1..r) (\x. x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN REWRITE_TAC[I_DEF] THEN MATCH_MP_TAC NPRODUCT_INJECTION THEN REWRITE_TAC[FINITE_NUMSEG] THEN ABBREV_TAC `f = \x. let b = (a * x) MOD p in if b <= r then b else p - b` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [GEN_TAC THEN EXPAND_TAC "f" THEN REWRITE_TAC[IN_NUMSEG] THEN LET_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN REPEAT STRIP_TAC THENL [ALL_TAC; EXPAND_TAC "p" THEN ARITH_TAC] THEN REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION; NOT_LE; SUB_EQ_0; PRIME_0]] THEN EXPAND_TAC "b" THEN ASM_SIMP_TAC[GSYM DIVIDES_MOD; PRIME_IMP_NZ] THEN ASM_SIMP_TAC[PRIME_DIVPROD_EQ] THEN STRIP_TAC THENL [ASM_MESON_TAC[coprime; DIVIDES_REFL; PRIME_1]; ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `~(1 <= 0)`; ARITH_RULE `~(2 * r + 1 <= i /\ i <= r)`]]; REWRITE_TAC[LET_DEF; LET_END_DEF] THEN DISCH_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_IMP_EQ THEN EXISTS_TAC `p:num` THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `i <= r ==> i < 2 * r + 1`] ; ALL_TAC]) THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a:num` THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `(if a then x else p - x) = (if b then y else p - y) ==> x < p /\ y < p ==> x = y \/ x + y = p`)) THEN ASM_SIMP_TAC[DIVISION] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[CONG]; ALL_TAC] THEN DISCH_THEN(MP_TAC o C AP_THM `p:num` o AP_TERM `(MOD)`) THEN ASM_SIMP_TAC[MOD_ADD_MOD] THEN ASM_SIMP_TAC[GSYM CONG] THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_DIVIDES) THEN ASM_SIMP_TAC[GSYM LEFT_ADD_DISTRIB; PRIME_DIVPROD_EQ; DIVIDES_REFL] THEN STRIP_TAC THENL [ASM_MESON_TAC[coprime; DIVIDES_REFL; PRIME_1]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_SIMP_TAC[ARITH_RULE `1 <= i ==> ~(i + j = 0)`] THEN MAP_EVERY UNDISCH_TAC [`i <= r`; `j <= r`; `2 * r + 1 = p`] THEN ARITH_TAC);; let GAUSS_LEMMA_2 = prove (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p ==> (nproduct(1..r) (\x. let b = (a * x) MOD p in if b <= r then b else p - b) == (p - 1) EXP (CARD {x | x IN 1..r /\ r < (a * x) MOD p}) * a EXP r * nproduct(1..r) (\x. x)) (mod p)`, REPEAT STRIP_TAC THEN ABBREV_TAC `s = {x | x IN 1..r /\ (a * x) MOD p <= r}` THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `nproduct(1..r) (\x. (if x IN s then 1 else p - 1) * (a * x) MOD p)` THEN CONJ_TAC THENL [MATCH_MP_TAC CONG_NPRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN LET_TAC THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; CONG_REFL] THEN REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN MATCH_MP_TAC CONG_SUB THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL; MULT_CLAUSES; CONG_REFL] THEN REWRITE_TAC[ARITH_RULE `b <= p /\ (1 <= p \/ b = 0) <=> b <= p`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN DISCH_THEN(MP_TAC o SPEC `a * i:num` o MATCH_MP DIVISION o MATCH_MP (ARITH_RULE `2 <= p ==> ~(p = 0)`)) THEN ASM_SIMP_TAC[LT_IMP_LE; cong; nat_mod] THEN DISCH_THEN(K ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`b:num`; `1`] THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[NPRODUCT_MULT; FINITE_NUMSEG] THEN MATCH_MP_TAC CONG_MULT THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM COND_SWAP] THEN SIMP_TAC[NPRODUCT_DELTA_CONST; FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP_CONG THEN AP_TERM_TAC THEN AP_TERM_TAC THEN EXPAND_TAC "s" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[NOT_LT]; ALL_TAC] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `nproduct(1..r) (\x. a * x)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[CONG_MOD; PRIME_IMP_NZ; CONG_NPRODUCT; FINITE_NUMSEG]; SIMP_TAC[NPRODUCT_MULT; FINITE_NUMSEG; NPRODUCT_CONST; CARD_NUMSEG_1] THEN REWRITE_TAC[CONG_REFL]]);; let GAUSS_LEMMA_3 = prove (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p ==> ((p - 1) EXP CARD {x | x IN 1..r /\ r < (a * x) MOD p} * (if a is_quadratic_residue mod p then 1 else p - 1) == 1) (mod p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `(p - 1) EXP CARD {x | x IN 1..r /\ r < (a * x) MOD p} * a EXP r` THEN ONCE_REWRITE_TAC[CONG_SYM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL] THEN SUBGOAL_THEN `r = (p - 1) DIV 2` (fun th -> ASM_SIMP_TAC[th; EULER_CRITERION]) THEN EXPAND_TAC "p" THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONG_MULT_RCANCEL THEN EXISTS_TAC `nproduct (1..r) (\x. x)` THEN ASM_SIMP_TAC[MULT_CLAUSES; GSYM MULT_ASSOC; SIMP_RULE[GAUSS_LEMMA_1] GAUSS_LEMMA_2] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_NPRODUCT THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let GAUSS_LEMMA_4 = prove (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p ==> ((if EVEN(CARD{x | x IN 1..r /\ r < (a * x) MOD p}) then 1 else p - 1) * (if a is_quadratic_residue mod p then 1 else p - 1) == 1) (mod p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `(p - 1) EXP CARD {x | x IN 1..r /\ r < (a * x) MOD p} * (if a is_quadratic_residue mod p then 1 else p - 1)` THEN ASM_SIMP_TAC[GAUSS_LEMMA_3] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN ASM_SIMP_TAC[CONG_EXP_MINUS1; CONG_MULT; CONG_REFL; PRIME_GE_2]);; let GAUSS_LEMMA = prove (`!a p r. prime p /\ coprime(a,p) /\ 2 * r + 1 = p ==> (a is_quadratic_residue (mod p) <=> EVEN(CARD {x | x IN 1..r /\ r < (a * x) MOD p}))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONG_COND_LEMMA THEN EXISTS_TAC `p:num` THEN CONJ_TAC THENL [FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN EXPAND_TAC "p" THEN ASM_CASES_TAC `r = 0` THENL [REWRITE_TAC[ASSUME `r = 0`; ARITH; PRIME_1]; UNDISCH_TAC `~(r = 0)` THEN ARITH_TAC]; FIRST_ASSUM(MP_TAC o MATCH_MP GAUSS_LEMMA_4) THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[CONG_REFL]) THEN REWRITE_TAC[MULT_CLAUSES] THEN MESON_TAC[CONG_SYM]]);; (* ------------------------------------------------------------------------- *) (* A more symmetrical version. *) (* ------------------------------------------------------------------------- *) let GAUSS_LEMMA_SYM = prove (`!p q r s. prime p /\ prime q /\ coprime(p,q) /\ 2 * r + 1 = p /\ 2 * s + 1 = q ==> (q is_quadratic_residue (mod p) <=> EVEN(CARD {x,y | x IN 1..r /\ y IN 1..s /\ q * x < p * y /\ p * y <= q * x + r}))`, ONCE_REWRITE_TAC[COPRIME_SYM] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`q:num`; `p:num`; `r:num`] GAUSS_LEMMA) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `CARD {x,y | x IN 1..r /\ y IN 1..s /\ y = (q * x) DIV p + 1 /\ r < (q * x) MOD p}` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBCROSS_DETERMINATE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; ARITH_RULE `1 <= x + 1`] THEN X_GEN_TAC `x:num` THEN STRIP_TAC THEN SUBGOAL_THEN `p * (q * x) DIV p + r < q * r` MP_TAC THENL [MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `q * x` THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN ASM_MESON_TAC[PRIME_IMP_NZ; LT_ADD_LCANCEL; DIVISION]; MAP_EVERY EXPAND_TAC ["p"; "q"] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(2 * r + 1) * d + r < (2 * s + 1) * r ==> (2 * r) * d < (2 * r) * s`)) THEN SIMP_TAC[LT_MULT_LCANCEL; ARITH_RULE `x < y ==> x + 1 <= y`]]; AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MP_TAC(MATCH_MP PRIME_IMP_NZ (ASSUME `prime p`)) THEN DISCH_THEN(MP_TAC o SPEC `q * x` o MATCH_MP DIVISION) THEN FIRST_ASSUM(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN UNDISCH_TAC `2 * r + 1 = p` THEN ARITH_TAC; MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ALL_TAC; DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC(ARITH_RULE `!p d. 2 * r + 1 = p /\ p * (d + 1) <= (d * p + m) + r ==> r < m`) THEN MAP_EVERY EXISTS_TAC [`p:num`; `(q * x) DIV p`] THEN ASM_MESON_TAC[DIVISION; PRIME_IMP_NZ]] THEN MATCH_MP_TAC(ARITH_RULE `~(x <= y) /\ ~(y + 2 <= x) ==> x = y + 1`) THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `y * p <= ((q * x) DIV p) * p` MP_TAC THENL [ASM_SIMP_TAC[LE_MULT_RCANCEL; PRIME_IMP_NZ]; ALL_TAC]; SUBGOAL_THEN `((q * x) DIV p + 2) * p <= y * p` MP_TAC THENL [ASM_SIMP_TAC[LE_MULT_RCANCEL; PRIME_IMP_NZ]; ALL_TAC]] THEN MP_TAC(MATCH_MP PRIME_IMP_NZ (ASSUME `prime p`)) THEN DISCH_THEN(MP_TAC o SPEC `q * x` o MATCH_MP DIVISION) THEN ASM_ARITH_TAC]]);; let GAUSS_LEMMA_SYM' = prove (`!p q r s. prime p /\ prime q /\ coprime(p,q) /\ 2 * r + 1 = p /\ 2 * s + 1 = q ==> (p is_quadratic_residue (mod q) <=> EVEN(CARD {x,y | x IN 1..r /\ y IN 1..s /\ p * y < q * x /\ q * x <= p * y + s}))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`q:num`; `p:num`; `s:num`; `r:num`] GAUSS_LEMMA_SYM) THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [CARD_SUBCROSS_SWAP] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_PAIR_THM; CONJ_ACI]);; (* ------------------------------------------------------------------------- *) (* The main result. *) (* ------------------------------------------------------------------------- *) let RECIPROCITY_SET_LEMMA = prove (`!a b c d r s. a UNION b UNION c UNION d = (1..r) CROSS (1..s) /\ PAIRWISE DISJOINT [a;b;c;d] /\ CARD b = CARD c ==> ((EVEN(CARD a) <=> EVEN(CARD d)) <=> ~(ODD r /\ ODD s))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `CARD(a:num#num->bool) + CARD(b:num#num->bool) + CARD(c:num#num->bool) + CARD(d:num#num->bool) = r * s` (fun th -> MP_TAC(AP_TERM `EVEN` th) THEN ASM_REWRITE_TAC[EVEN_ADD; GSYM NOT_EVEN; EVEN_MULT] THEN CONV_TAC TAUT) THEN SUBGOAL_THEN `FINITE(a:num#num->bool) /\ FINITE(b:num#num->bool) /\ FINITE(c:num#num->bool) /\ FINITE(d:num#num->bool)` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `(1..r) CROSS (1..s)` THEN SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `CARD:(num#num->bool)->num`) THEN SIMP_TAC[CARD_CROSS; CARD_NUMSEG_1; FINITE_NUMSEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PAIRWISE]) THEN REWRITE_TAC[PAIRWISE; DISJOINT; ALL] THEN ASM_SIMP_TAC[CARD_UNION; FINITE_UNION; SET_RULE `a INTER (b UNION c) = {} <=> a INTER b = {} /\ a INTER c = {}`]);; let RECIPROCITY_SIMPLE = prove (`!p q r s. prime p /\ prime q /\ coprime (p,q) /\ 2 * r + 1 = p /\ 2 * s + 1 = q ==> ((q is_quadratic_residue (mod p) <=> p is_quadratic_residue (mod q)) <=> ~(ODD r /\ ODD s))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:num`; `q:num`; `r:num`; `s:num`] GAUSS_LEMMA_SYM) THEN MP_TAC(SPECL [`p:num`; `q:num`; `r:num`; `s:num`] GAUSS_LEMMA_SYM') THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN MATCH_MP_TAC RECIPROCITY_SET_LEMMA THEN EXISTS_TAC `{x,y | x IN 1..r /\ y IN 1..s /\ q * x + r < p * y}` THEN EXISTS_TAC `{x,y | x IN 1..r /\ y IN 1..s /\ p * y + s < q * x}` THEN REPEAT CONJ_TAC THEN REWRITE_TAC[PAIRWISE; DISJOINT; EXTENSION; NOT_IN_EMPTY; FORALL_PAIR_THM; ALL; IN_UNION; IN_CROSS; IN_ELIM_PAIR_THM; IN_INTER] THENL [MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN MAP_EVERY ASM_CASES_TAC [`x IN 1..r`; `y IN 1..s`] THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `~(q * x = p * y)` (fun th -> MP_TAC th THEN ARITH_TAC) THEN DISCH_THEN(MP_TAC o AP_TERM `(divides) p`) THEN ASM_SIMP_TAC[PRIME_DIVPROD_EQ; DIVIDES_REFL] THEN STRIP_TAC THENL [ASM_MESON_TAC[DIVIDES_REFL; PRIME_1; coprime]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN UNDISCH_TAC `x IN 1..r` THEN REWRITE_TAC[IN_NUMSEG] THEN EXPAND_TAC "p" THEN ARITH_TAC; ARITH_TAC; MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN REPEAT(EXISTS_TAC `\(x,y). (r + 1) - x,(s + 1) - y`) THEN SIMP_TAC[FINITE_SUBCROSS; FINITE_NUMSEG] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_NUMSEG; PAIR_EQ] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN SIMP_TAC[ARITH_RULE `x <= y ==> (y + 1) - ((y + 1) - x) = x`] THEN SIMP_TAC[ARITH_RULE `1 <= x /\ x <= y ==> 1 <= (y + 1) - x /\ (y + 1) - x <= y`] THEN REWRITE_TAC[LEFT_SUB_DISTRIB] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE `x <= y /\ v + y + z < x + u ==> (y - x) + z < u - v`) THEN ASM_SIMP_TAC[LE_MULT_LCANCEL; ARITH_RULE `x <= r ==> x <= r + 1`] THEN REWRITE_TAC[ARITH_RULE `a + x < y + a <=> x < y`] THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* In terms of the Legendre symbol. *) (* ------------------------------------------------------------------------- *) let RECIPROCITY_LEGENDRE = prove (`!p q. prime p /\ prime q /\ ODD p /\ ODD q /\ ~(p = q) ==> legendre(p,q) * legendre(q,p) = --(&1) pow ((p - 1) DIV 2 * (q - 1) DIV 2)`, REPEAT STRIP_TAC THEN MAP_EVERY UNDISCH_TAC [`ODD q`; `ODD p`] THEN REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN REWRITE_TAC[ADD1] THEN REPEAT(DISCH_THEN (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th))) THEN REWRITE_TAC[ARITH_RULE `((2 * s + 1) - 1) DIV 2 = s`] THEN MP_TAC(SPECL [`p:num`; `q:num`; `r:num`; `s:num`] RECIPROCITY_SIMPLE) THEN ASM_SIMP_TAC[DISTINCT_PRIME_COPRIME; INT_POW_NEG; EVEN_MULT; legendre] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_ODD; INT_POW_ONE] THEN MAP_EVERY ASM_CASES_TAC [`EVEN r`; `EVEN s`] THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[TAUT `~(a <=> b) <=> (a <=> ~b)`] THEN DISCH_THEN(K ALL_TAC) THEN ASM_CASES_TAC `p is_quadratic_residue (mod q)` THEN ASM_REWRITE_TAC[INT_MUL_LNEG; INT_MUL_RNEG; INT_NEG_NEG; INT_MUL_LID]);; hol-light/100/sqrt.ml000066400000000000000000000043421303454263000145730ustar00rootroot00000000000000(* ========================================================================= *) (* Irrationality of sqrt(2) and more general results. *) (* ========================================================================= *) needs "Library/prime.ml";; (* For number-theoretic lemmas *) needs "Library/floor.ml";; (* For definition of rationals *) needs "Multivariate/vectors.ml";; (* For square roots *) (* ------------------------------------------------------------------------- *) (* Most general irrationality of square root result. *) (* ------------------------------------------------------------------------- *) let IRRATIONAL_SQRT_NONSQUARE = prove (`!n. rational(sqrt(&n)) ==> ?m. n = m EXP 2`, REWRITE_TAC[rational] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN SIMP_TAC[SQRT_POW_2; REAL_POS] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [integer])) THEN ASM_REWRITE_TAC[REAL_ABS_DIV] THEN DISCH_THEN(MP_TAC o MATCH_MP(REAL_FIELD `p = (n / m) pow 2 ==> ~(m = &0) ==> m pow 2 * p = n pow 2`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_ZERO]; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN ASM_MESON_TAC[EXP_MULT_EXISTS; REAL_ABS_ZERO; REAL_OF_NUM_EQ]);; (* ------------------------------------------------------------------------- *) (* In particular, prime numbers. *) (* ------------------------------------------------------------------------- *) let IRRATIONAL_SQRT_PRIME = prove (`!p. prime p ==> ~rational(sqrt(&p))`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP IRRATIONAL_SQRT_NONSQUARE) THEN REWRITE_TAC[PRIME_EXP; ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* In particular, sqrt(2) is irrational. *) (* ------------------------------------------------------------------------- *) let IRRATIONAL_SQRT_2 = prove (`~rational(sqrt(&2))`, SIMP_TAC[IRRATIONAL_SQRT_PRIME; PRIME_2]);; hol-light/100/stirling.ml000066400000000000000000000707351303454263000154460ustar00rootroot00000000000000(* ========================================================================= *) (* Stirling's approximation. *) (* ========================================================================= *) needs "Library/analysis.ml";; needs "Library/transc.ml";; override_interface("-->",`(tends_num_real)`);; (* ------------------------------------------------------------------------- *) (* This is a handy induction for Wallis's product below. *) (* ------------------------------------------------------------------------- *) let ODDEVEN_INDUCT = prove (`!P. P 0 /\ P 1 /\ (!n. P n ==> P(n + 2)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN ASM_SIMP_TAC[ARITH]);; (* ------------------------------------------------------------------------- *) (* A particular limit we need below. *) (* ------------------------------------------------------------------------- *) let LN_LIM_BOUND = prove (`!n. ~(n = 0) ==> abs(&n * ln(&1 + &1 / &n) - &1) <= &1 / (&2 * &n)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`&1 / &n`; `2`] MCLAURIN_LN_POS) THEN ASM_SIMP_TAC[SUM_2; REAL_LT_DIV; REAL_OF_NUM_LT; LT_NZ; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; REAL_ADD_LID] THEN REWRITE_TAC[REAL_POW_1; REAL_POW_2; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG; REAL_MUL_LID; REAL_INV_1; REAL_POW_NEG; REAL_POW_ONE; ARITH; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `~(x = &0) ==> x * (inv(x) + a) - &1 = x * a`] THEN REWRITE_TAC[REAL_ARITH `n * --((i * i) * a) = --((n * i) * a * i)`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_MUL] THEN ONCE_REWRITE_TAC[REAL_INV_MUL] THEN REWRITE_TAC[REAL_ABS_MUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_POS] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_ABS_MUL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_POS] THEN UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC);; let LN_LIM_LEMMA = prove (`(\n. &n * ln(&1 + &1 / &n)) --> &1`, GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [REAL_ARITH `a = (a - &1) + &1`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_LID] THEN MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[SEQ_CONST] THEN MATCH_MP_TAC SEQ_LE_0 THEN EXISTS_TAC `\n. &1 / &n` THEN REWRITE_TAC[SEQ_HARMONIC] THEN EXISTS_TAC `1` THEN REWRITE_TAC[ARITH_RULE `n >= 1 <=> ~(n = 0)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / (&2 * &n)` THEN ASM_SIMP_TAC[LN_LIM_BOUND] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `~(n = 0)` THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Lemma for proving inequality via derivative and limit at infinity. *) (* ------------------------------------------------------------------------- *) let POSITIVE_DIFF_LEMMA = prove (`!f f'. (!x. &0 < x ==> (f diffl f'(x)) x /\ f'(x) < &0) /\ (\n. f(&n)) --> &0 ==> !n. ~(n = 0) ==> &0 < f(&n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `!m p. n <= m /\ m < p ==> (f:real->real)(&p) < f(&m)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:real->real`; `f':real->real`; `&m`; `&p`] MVT_ALT) THEN ANTS_TAC THENL [ASM_MESON_TAC[LT_NZ; LTE_TRANS; REAL_OF_NUM_LT; REAL_LTE_TRANS]; ALL_TAC] THEN REWRITE_TAC[REAL_EQ_SUB_RADD] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 < z * --y ==> z * y + a < a`) THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT; REAL_OF_NUM_LT] THEN REWRITE_TAC[REAL_ARITH `&0 < --x <=> x < &0`] THEN ASM_MESON_TAC[LT_NZ; LTE_TRANS; REAL_OF_NUM_LT; REAL_LT_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `f(&(n + 1)) < &0` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPECL [`n:num`; `n + 1`]) THEN ANTS_TAC THENL [ARITH_TAC; UNDISCH_TAC `f(&n) <= &0` THEN REAL_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SEQ]) THEN DISCH_THEN(MP_TAC o SPEC `--f(&(n + 1))`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_ARITH `&0 < --x <=> x < &0`] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` (MP_TAC o SPEC `n + p + 2`)) THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `y < &0 /\ z < y ==> abs(z) < --y ==> F`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Auxiliary definition. *) (* ------------------------------------------------------------------------- *) let stirling = new_definition `stirling n = ln(&(FACT n)) - ((&n + &1 / &2) * ln(&n) - &n)`;; (* ------------------------------------------------------------------------- *) (* This difference is a decreasing sequence. *) (* ------------------------------------------------------------------------- *) let STIRLING_DIFF = prove (`!n. ~(n = 0) ==> stirling(n) - stirling(n + 1) = (&n + &1 / &2) * ln((&n + &1) / &n) - &1`, REPEAT STRIP_TAC THEN REWRITE_TAC[stirling] THEN MATCH_MP_TAC(REAL_ARITH `(f' - f) + x = (nl' - nl) /\ n' = n + &1 ==> (f - (nl - n)) - (f' - (nl' - n')) = x - &1`) THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[REWRITE_RULE[ADD1] FACT; GSYM REAL_OF_NUM_MUL] THEN SIMP_TAC[LN_MUL; FACT_LT; ADD_EQ_0; ARITH; LT_NZ; REAL_OF_NUM_LT] THEN ASM_SIMP_TAC[LN_DIV; REAL_OF_NUM_LT; ADD_EQ_0; ARITH; LT_NZ] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC);; let STIRLING_DELTA_DERIV = prove (`!x. &0 < x ==> ((\x. ln ((x + &1) / x) - &1 / (x + &1 / &2)) diffl (-- &1 / (x * (x + &1) * (&2 * x + &1) pow 2))) x`, GEN_TAC THEN DISCH_TAC THEN W(fun (asl,w) -> MP_TAC(SPEC(rand w) (DIFF_CONV(lhand(rator w))))) THEN REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_DIV) THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_2] THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; let STIRLING_DELTA_LIMIT = prove (`(\n. ln ((&n + &1) / &n) - &1 / (&n + &1 / &2)) --> &0`, GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN MATCH_MP_TAC SEQ_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SEQ_LE_0 THEN EXISTS_TAC `\n. &1 / &n` THEN REWRITE_TAC[SEQ_HARMONIC] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; GSYM REAL_OF_NUM_LE] THEN DISCH_TAC THEN MATCH_MP_TAC (REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN CONJ_TAC THENL [MATCH_MP_TAC LN_POS THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `&1 <= x ==> &0 < x`] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_FIELD `&1 <= x ==> (x + &1) / x = &1 + &1 / x`] THEN MATCH_MP_TAC LN_LE THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS]; MATCH_MP_TAC REAL_LE_DIV THEN REAL_ARITH_TAC; REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]);; let STIRLING_DECREASES = prove (`!n. ~(n = 0) ==> stirling(n + 1) < stirling(n)`, ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN SIMP_TAC[STIRLING_DIFF] THEN REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1 / &2`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN MATCH_MP_TAC POSITIVE_DIFF_LEMMA THEN EXISTS_TAC `\x. -- &1 / (x * (x + &1) * (&2 * x + &1) pow 2)` THEN SIMP_TAC[STIRLING_DELTA_DERIV; STIRLING_DELTA_LIMIT] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LNEG; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `--x < &0 <=> &0 < x`; REAL_LT_INV_EQ] THEN REWRITE_TAC[REAL_POW_2] THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* However a slight tweak gives an *increasing* sequence. *) (* ------------------------------------------------------------------------- *) let OTHER_DERIV_LEMMA = prove (`!x. &0 < x ==> ((\x. &1 / (&12 * x * (x + &1) * (x + &1 / &2))) diffl --(&3 * x pow 2 + &3 * x + &1 / &2) / (&12 * (x * (x + &1) * (x + &1 / &2)) pow 2)) x`, REPEAT STRIP_TAC THEN W(fun (asl,w) -> MP_TAC(SPEC(rand w) (DIFF_CONV(lhand(rator w))))) THEN REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ENTIRE] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_2] THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; let STIRLING_INCREASES = prove (`!n. ~(n = 0) ==> stirling(n + 1) - &1 / (&12 * (&(n + 1))) > stirling(n) - &1 / (&12 * &n)`, REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `a - b > c - d <=> c - a < d - b`] THEN SIMP_TAC[REAL_FIELD `~(&n = &0) ==> &1 / (&12 * &n) - &1 / (&12 * (&n + &1)) = &1 / (&12 * &n * (&n + &1))`] THEN SIMP_TAC[REAL_OF_NUM_EQ; STIRLING_DIFF] THEN REWRITE_TAC[REAL_ARITH `a * b - &1 < c <=> b * a < c + &1`] THEN SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ARITH `&0 < &n + &1 / &2`] THEN REWRITE_TAC[REAL_ARITH `(&1 / x + &1) / y = &1 / x / y + &1 / y`] THEN REWRITE_TAC[REAL_ARITH `a < b + c <=> &0 < b - (a - c)`] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC POSITIVE_DIFF_LEMMA THEN EXISTS_TAC `\x. &1 / (x * (x + &1) * (&2 * x + &1) pow 2) - (&3 * x pow 2 + &3 * x + &1 / &2) / (&12 * (x * (x + &1) * (x + &1 / &2)) pow 2)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN MATCH_MP_TAC SEQ_SUB THEN REWRITE_TAC[STIRLING_DELTA_LIMIT] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_LID] THEN REWRITE_TAC[REAL_FIELD `inv(&12) * x * y * inv(&n + inv(&2)) = x * y * inv(&12 * &n + &6)`] THEN GEN_REWRITE_TAC RAND_CONV [SYM(REAL_RAT_REDUCE_CONV `&0 * &0 * &0`)] THEN REPEAT(MATCH_MP_TAC SEQ_MUL THEN CONJ_TAC) THEN MP_TAC(SPEC `&1` SEQ_HARMONIC) THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUBSEQ) THENL [DISCH_THEN(MP_TAC o SPECL [`1`; `1`]); DISCH_THEN(MP_TAC o SPECL [`12`; `6`])] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; ARITH; MULT_CLAUSES]] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&1 / x - y / z = --y / z - -- &1 / x`] THEN MATCH_MP_TAC DIFF_SUB THEN ASM_SIMP_TAC[STIRLING_DELTA_DERIV; OTHER_DERIV_LEMMA]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `a - b < &0 <=> a < b`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; REAL_FIELD `&0 < x ==> &1 / (x * (x + &1) * (&2 * x + &1) pow 2) = (&3 * x * (x + &1)) / (&12 * (x * (x + &1) * (x + &1 / &2)) * (x * (x + &1) * (x + &1 / &2)))`] THEN ONCE_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_POW_2] THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence it converges to *something*. *) (* ------------------------------------------------------------------------- *) let STIRLING_UPPERBOUND = prove (`!n. stirling(SUC n) <= &1`, INDUCT_TAC THENL [REWRITE_TAC[stirling] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `stirling(SUC n)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = SUC n + 1`] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC STIRLING_DECREASES THEN ARITH_TAC);; let STIRLING_LOWERBOUND = prove (`!n. -- &1 <= stirling(SUC n)`, GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `stirling(SUC n) - &1 / (&12 * &(SUC n))` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[REAL_ARITH `a - b <= a <=> &0 <= b`] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_POS]] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[stirling] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `stirling(SUC n) - &1 / (&12 * &(SUC n))` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = SUC n + 1`] THEN MATCH_MP_TAC(REAL_ARITH `b > a ==> a <= b`) THEN MATCH_MP_TAC STIRLING_INCREASES THEN ARITH_TAC);; let STIRLING_MONO = prove (`!m n. ~(m = 0) /\ m <= n ==> stirling n <= stirling m`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `stirling(m + d)` THEN ASM_SIMP_TAC[ADD1; REAL_LT_IMP_LE; STIRLING_DECREASES; ADD_EQ_0]);; let STIRLING_CONVERGES = prove (`?c. stirling --> c`, ONCE_REWRITE_TAC[SEQ_SUC] THEN REWRITE_TAC[GSYM convergent] THEN MATCH_MP_TAC SEQ_BCONV THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[mono; real_ge] THEN DISJ2_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC STIRLING_MONO THEN POP_ASSUM MP_TAC THEN ARITH_TAC] THEN REWRITE_TAC[MR1_BOUNDED; GE; LE_REFL] THEN MAP_EVERY EXISTS_TAC [`&2`; `0`] THEN REWRITE_TAC[LE_0] THEN SIMP_TAC[REAL_ARITH `-- &1 <= x /\ x <= &1 ==> abs(x) < &2`; STIRLING_UPPERBOUND; STIRLING_LOWERBOUND]);; (* ------------------------------------------------------------------------- *) (* Now derive Wallis's infinite product. *) (* ------------------------------------------------------------------------- *) let [PI2_LT; PI2_LE; PI2_NZ] = (CONJUNCTS o prove) (`&0 < pi / &2 /\ &0 <= pi / &2 /\ ~(pi / &2 = &0)`, MP_TAC PI_POS THEN REAL_ARITH_TAC);; let WALLIS_PARTS = prove (`!n. (&n + &2) * integral(&0,pi / &2) (\x. sin(x) pow (n + 2)) = (&n + &1) * integral(&0,pi / &2) (\x. sin(x) pow n)`, GEN_TAC THEN MP_TAC(SPECL [`\x. sin(x) pow (n + 1)`; `\x. --cos(x)`; `\x. (&n + &1) * sin(x) pow n * cos(x)`; `\x. sin(x)`; `&0`; `pi / &2`] INTEGRAL_BY_PARTS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [SIMP_TAC[REAL_LT_IMP_LE; PI_POS; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC(ONCE_DEPTH_CONV INTEGRABLE_CONV) THEN REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN DIFF_TAC THEN REWRITE_TAC[REAL_OF_NUM_ADD; ADD_SUB] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SIN_PI2; COS_PI2; SIN_0; COS_0] THEN REWRITE_TAC[REAL_ARITH `s pow k * s = s * s pow k`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow); ARITH_RULE `SUC(n + 1) = n + 2`] THEN REWRITE_TAC[GSYM ADD1; real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_NEG_0; REAL_SUB_LZERO] THEN REWRITE_TAC[C MATCH_MP (SPEC_ALL SIN_CIRCLE) (REAL_RING `sin(x) pow 2 + cos(x) pow 2 = &1 ==> (n * sn * cos(x)) * --cos(x) = (n * sn) * (sin(x) pow 2 - &1)`)] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; GSYM REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN REWRITE_TAC[REAL_MUL_RID] THEN SUBGOAL_THEN `integral(&0,pi / &2) (\x. (&n + &1) * sin x pow (n + 2) - (&n + &1) * sin x pow n) = (&n + &1) * (integral(&0,pi / &2) (\x. sin(x) pow (n + 2)) - integral(&0,pi / &2) (\x. sin(x) pow n))` (fun th -> SUBST1_TAC th THEN REAL_ARITH_TAC) THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(&n + &1) * integral(&0,pi / &2) (\x. sin x pow (n + 2) - sin x pow n)` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_CMUL; AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SUB] THEN CONV_TAC(ONCE_DEPTH_CONV INTEGRABLE_CONV) THEN SIMP_TAC[PI2_LE]);; let WALLIS_PARTS' = prove (`!n. integral(&0,pi / &2) (\x. sin(x) pow (n + 2)) = (&n + &1) / (&n + &2) * integral(&0,pi / &2) (\x. sin(x) pow n)`, MP_TAC WALLIS_PARTS THEN MATCH_MP_TAC MONO_FORALL THEN CONV_TAC REAL_FIELD);; let WALLIS_0 = prove (`integral(&0,pi / &2) (\x. sin(x) pow 0) = pi / &2`, REWRITE_TAC[real_pow; REAL_DIV_1; REAL_MUL_LID] THEN SIMP_TAC[INTEGRAL_CONST; REAL_LT_IMP_LE; PI_POS; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_MUL_LID; REAL_SUB_RZERO]);; let WALLIS_1 = prove (`integral(&0,pi / &2) (\x. sin(x) pow 1) = &1`, MATCH_MP_TAC DEFINT_INTEGRAL THEN REWRITE_TAC[PI2_LE; REAL_POW_1] THEN MP_TAC(SPECL [`\x. --cos(x)`; `\x. sin x`; `&0`; `pi / &2`] FTC1) THEN REWRITE_TAC[COS_0; COS_PI2] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[PI2_LE] THEN REPEAT STRIP_TAC THEN DIFF_TAC THEN REAL_ARITH_TAC);; let WALLIS_EVEN = prove (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n)) = (&(FACT(2 * n)) / (&2 pow n * &(FACT n)) pow 2) * pi / &2`, INDUCT_TAC THENL [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[WALLIS_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `2 * SUC n = 2 * n + 2`; WALLIS_PARTS'] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x) * y * z = (&2 * y) * (x * z)`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_MUL] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[ARITH_RULE `2 * n + 2 = SUC(SUC(2 * n))`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_POW_2; FACT; GSYM REAL_OF_NUM_MUL] THEN CONV_TAC REAL_FIELD);; let WALLIS_ODD = prove (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n + 1)) = (&2 pow n * &(FACT n)) pow 2 / &(FACT(2 * n + 1))`, INDUCT_TAC THENL [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[WALLIS_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `2 * SUC n + 1 = (2 * n + 1) + 2`; WALLIS_PARTS'] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x) * y * z = (x * z) * (&2 * y)`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_MUL] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[ARITH_RULE `n + 2 = SUC(SUC n)`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_POW_2; FACT; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN MP_TAC(SPEC `2 * n + 1` FACT_LT) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN CONV_TAC REAL_FIELD);; let WALLIS_QUOTIENT = prove (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n)) / integral(&0,pi / &2) (\x. sin(x) pow (2 * n + 1)) = (&(FACT(2 * n)) * &(FACT(2 * n + 1))) / (&2 pow n * &(FACT n)) pow 4 * pi / &2`, GEN_TAC THEN REWRITE_TAC[WALLIS_EVEN; WALLIS_ODD] THEN REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_POW_INV; REAL_INV_INV] THEN REAL_ARITH_TAC);; let WALLIS_QUOTIENT' = prove (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n)) / integral(&0,pi / &2) (\x. sin(x) pow (2 * n + 1)) * &2 / pi = (&(FACT(2 * n)) * &(FACT(2 * n + 1))) / (&2 pow n * &(FACT n)) pow 4`, GEN_TAC THEN REWRITE_TAC[WALLIS_QUOTIENT] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM REAL_INV_DIV] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_DIV_RMUL THEN MP_TAC PI2_NZ THEN CONV_TAC REAL_FIELD);; let WALLIS_MONO = prove (`!m n. m <= n ==> integral(&0,pi / &2) (\x. sin(x) pow n) <= integral(&0,pi / &2) (\x. sin(x) pow m)`, REWRITE_TAC[LE_EXISTS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_LE THEN CONV_TAC(ONCE_DEPTH_CONV INTEGRABLE_CONV) THEN REWRITE_TAC[PI2_LE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_POW_ADD] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE; MATCH_MP_TAC REAL_POW_1_LE] THEN REWRITE_TAC[SIN_BOUNDS] THEN (MP_TAC(SPEC `x:real` SIN_POS_PI_LE) THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC PI2_LT THEN REAL_ARITH_TAC));; let WALLIS_LT = prove (`!n. &0 < integral(&0,pi / &2) (\x. sin(x) pow n)`, MATCH_MP_TAC ODDEVEN_INDUCT THEN REWRITE_TAC[WALLIS_0; WALLIS_1; PI2_LT; REAL_OF_NUM_LT; ARITH] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[WALLIS_PARTS'] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_DIV THEN REAL_ARITH_TAC);; let WALLIS_NZ = prove (`!n. ~(integral(&0,pi / &2) (\x. sin(x) pow n) = &0)`, MP_TAC WALLIS_LT THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let WALLIS_BOUNDS = prove (`!n. integral(&0,pi / &2) (\x. sin(x) pow (n + 1)) <= integral(&0,pi / &2) (\x. sin(x) pow n) /\ integral(&0,pi / &2) (\x. sin(x) pow n) <= (&n + &2) / (&n + &1) * integral(&0,pi / &2) (\x. sin(x) pow (n + 1))`, GEN_TAC THEN SIMP_TAC[WALLIS_MONO; LE_ADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&n + &2) / (&n + &1) * integral (&0,pi / &2) (\x. sin x pow (n + 2))` THEN CONJ_TAC THENL [REWRITE_TAC[WALLIS_PARTS'] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[WALLIS_MONO; ARITH_RULE `n + 1 <= n + 2`] THEN MATCH_MP_TAC REAL_LE_DIV THEN REAL_ARITH_TAC);; let WALLIS_RATIO_BOUNDS = prove (`!n. &1 <= integral(&0,pi / &2) (\x. sin(x) pow n) / integral(&0,pi / &2) (\x. sin(x) pow (n + 1)) /\ integral(&0,pi / &2) (\x. sin(x) pow n) / integral(&0,pi / &2) (\x. sin(x) pow (n + 1)) <= (&n + &2) / (&n + &1)`, GEN_TAC THEN CONJ_TAC THENL [SIMP_TAC[REAL_LE_RDIV_EQ; WALLIS_LT; REAL_MUL_LID; WALLIS_BOUNDS]; SIMP_TAC[REAL_LE_LDIV_EQ; WALLIS_LT; WALLIS_BOUNDS]]);; let WALLIS = prove (`(\n. (&2 pow n * &(FACT n)) pow 4 / (&(FACT(2 * n)) * &(FACT(2 * n + 1)))) --> pi / &2`, ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN MATCH_MP_TAC SEQ_INV THEN CONJ_TAC THENL [ALL_TAC; MP_TAC PI2_NZ THEN CONV_TAC REAL_FIELD] THEN REWRITE_TAC[GSYM WALLIS_QUOTIENT'] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [REAL_ARITH `x = (x - &1) + &1`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_LID] THEN MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[SEQ_CONST] THEN MATCH_MP_TAC SEQ_LE_0 THEN EXISTS_TAC `\n. &1 / &n` THEN REWRITE_TAC[SEQ_HARMONIC] THEN EXISTS_TAC `1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!d. &1 <= x /\ x <= d /\ d - &1 <= e ==> abs(x - &1) <= e`) THEN EXISTS_TAC `(&(2 * n) + &2) / (&(2 * n) + &1)` THEN REWRITE_TAC[WALLIS_RATIO_BOUNDS] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_FIELD `(&2 * &n + &2) / (&2 * &n + &1) - &1 = &1 / (&2 * &n + &1)`] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_INV2 THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence determine the actual value of the limit. *) (* ------------------------------------------------------------------------- *) let LN_WALLIS = prove (`(\n. &4 * &n * ln(&2) + &4 * ln(&(FACT n)) - (ln(&(FACT(2 * n))) + ln(&(FACT(2 * n + 1))))) --> ln(pi / &2)`, REWRITE_TAC[REAL_ARITH `&4 * x + &4 * y - z = &4 * (x + y) - z`] THEN SUBGOAL_THEN `!n. &0 < &2 pow n` (fun th -> SIMP_TAC[th; GSYM LN_POW; REAL_OF_NUM_LT; ARITH; GSYM LN_MUL; FACT_LT; REAL_POW_LT; REAL_LT_MUL; GSYM LN_DIV]) THEN SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC CONTL_SEQ THEN REWRITE_TAC[WALLIS] THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(pi / &2)` THEN MP_TAC(SPEC `pi / &2` (DIFF_CONV `\x. ln(x)`)) THEN SIMP_TAC[ETA_AX; PI2_LT; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_MUL_RID]);; let STIRLING = prove (`(\n. ln(&(FACT n)) - ((&n + &1 / &2) * ln(&n) - &n + ln(&2 * pi) / &2)) --> &0`, REWRITE_TAC[REAL_ARITH `a - (b - c + d) = (a - (b - c)) - d`] THEN SUBST1_TAC(SYM(SPEC `ln(&2 * pi) / &2` REAL_SUB_REFL)) THEN MATCH_MP_TAC SEQ_SUB THEN REWRITE_TAC[SEQ_CONST] THEN X_CHOOSE_THEN `C:real` MP_TAC STIRLING_CONVERGES THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[stirling] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`2`; `1`] o MATCH_MP SEQ_SUBSEQ) THEN FIRST_ASSUM(MP_TAC o SPECL [`2`; `0`] o MATCH_MP SEQ_SUBSEQ) THEN REWRITE_TAC[ARITH; ADD_CLAUSES; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_ADD) THEN FIRST_ASSUM(MP_TAC o MATCH_MP SEQ_MUL o CONJ (SPEC `&4` SEQ_CONST)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUB) THEN MP_TAC LN_WALLIS THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUB) THEN REWRITE_TAC[ARITH_RULE `(a + &4 * x - (y + z)) - (&4 * (x - b) - ((y - c) + (z - d))) = (a + &4 * b) - (c + d)`] THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN SUBGOAL_THEN `C = ln(&2 * pi) / &2` (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM(MP_TAC o CONJ (SPEC `&2 * ln(&2)` SEQ_CONST)) THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_ADD) THEN SIMP_TAC[LN_DIV; PI_POS; REAL_OF_NUM_LT; ARITH; LN_MUL] THEN REWRITE_TAC[REAL_ARITH `&2 * l + p - l - (&4 * C - (C + C)) = (l + p) - &2 * C`] THEN SIMP_TAC[REAL_ARITH `C = (l + p) / &2 <=> (l + p) - &2 * C = &0`] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] SEQ_UNIQ) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_ARITH `a + (b + &4 * (c - x)) - ((d - &2 * x) + (e - (&2 * x + &1))) = (a + b + &4 * c + &1) - (d + e)`] THEN REWRITE_TAC[REAL_ARITH `&2 * l + &4 * n * l + &4 * (n + &1 / &2) * x + &1 = (&4 * n + &2) * (l + x) + &1`] THEN ONCE_REWRITE_TAC[SEQ_SUC] THEN SIMP_TAC[GSYM LN_MUL; REAL_OF_NUM_LT; ARITH; LT_0] THEN REWRITE_TAC[GSYM SEQ_SUC] THEN CONV_TAC(LAND_CONV(GEN_ALPHA_CONV `n:num`)) THEN REWRITE_TAC[REAL_ARITH `((&4 * n + &2) * l + &1) - ((&2 * n + &1 / &2) * l + z) = (&2 * n + &3 / &2) * l + &1 - z`] THEN REWRITE_TAC[REAL_ARITH `(&2 * n + &3 / &2) * l + &1 - ((&2 * n + &1) + &1 / &2) * l' = (&2 * n + &3 / &2) * (l - l') + &1`] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&0 = -- &1 + &1`] THEN MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[SEQ_CONST] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * (b - c) = --(a * (c - b))`] THEN REWRITE_TAC[GSYM SEQ_NEG] THEN ONCE_REWRITE_TAC[SEQ_SUC] THEN SIMP_TAC[GSYM LN_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; LT_0; ARITH; REAL_ARITH `&0 < &2 * &n + &1`] THEN SIMP_TAC[REAL_OF_NUM_LT; LT_0; REAL_FIELD `&0 < x ==> (&2 * x + &1) / (&2 * x) = &1 + &1 / (&2 * x)`] THEN REWRITE_TAC[GSYM SEQ_SUC] THEN CONV_TAC(LAND_CONV(GEN_ALPHA_CONV `n:num`)) THEN MP_TAC SEQ_SUBSEQ THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(MP_TAC o GENL [`f:num->real`; `l:real`] o SPECL [`f:num->real`; `l:real`; `2`; `0`]) THEN REWRITE_TAC[ADD_CLAUSES; ARITH; REAL_OF_NUM_MUL] THEN DISCH_THEN MATCH_MP_TAC THEN CONV_TAC(LAND_CONV(GEN_ALPHA_CONV `n:num`)) THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&1 = &1 + &3 / &2 * &0`] THEN MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[LN_LIM_LEMMA] THEN MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN MP_TAC LN_LIM_LEMMA THEN MP_TAC(SPEC `&1` SEQ_HARMONIC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_MUL) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SEQ_SUC] THEN SIMP_TAC[real_div; REAL_MUL_LID; REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID; REAL_OF_NUM_EQ; NOT_SUC]);; hol-light/100/subsequence.ml000066400000000000000000000153211303454263000161230ustar00rootroot00000000000000(* ========================================================================= *) (* #73: Erdos-Szekeres theorem on ascending / descending subsequences. *) (* ========================================================================= *) let lemma = prove (`!f s. s = UNIONS (IMAGE (\a. {x | x IN s /\ f(x) = a}) (IMAGE f s))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN GEN_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_IMAGE] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2; GSYM CONJ_ASSOC; IN_ELIM_THM] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Pigeonhole lemma. *) (* ------------------------------------------------------------------------- *) let PIGEONHOLE_LEMMA = prove (`!f:A->B s n. FINITE s /\ (n - 1) * CARD(IMAGE f s) < CARD s ==> ?t a. t SUBSET s /\ t HAS_SIZE n /\ (!x. x IN t ==> f(x) = a)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`f:A->B`; `s:A->bool`] lemma) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [th]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT] THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN MATCH_MP_TAC (REWRITE_RULE[SET_RULE `{t x | x IN s} = IMAGE t s`] CARD_UNIONS_LE) THEN ASM_SIMP_TAC[HAS_SIZE; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `~(n <= x) ==> x <= n - 1`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN MP_TAC(ISPEC `{y | y IN s /\ (f:A->B) y = f x}` CHOOSE_SUBSET) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Abbreviation for "monotonicity of f on s w.r.t. ordering r". *) (* ------------------------------------------------------------------------- *) let mono_on = define `mono_on (f:num->real) r s <=> !i j. i IN s /\ j IN s /\ i <= j ==> r (f i) (f j)`;; let MONO_ON_SUBSET = prove (`!s t. t SUBSET s /\ mono_on f r s ==> mono_on f r t`, REWRITE_TAC[mono_on; SUBSET] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* The main result. *) (* ------------------------------------------------------------------------- *) let ERDOS_SZEKERES = prove (`!f:num->real m n. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE (m + 1) /\ mono_on f (<=) s) \/ (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE (n + 1) /\ mono_on f (>=) s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i. i IN (1..m*n+1) ==> ?k. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE k /\ mono_on f (<=) s /\ i IN s /\ (!j. j IN s ==> i <= j)) /\ (!l. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE l /\ mono_on f (<=) s /\ i IN s /\ (!j. j IN s ==> i <= j)) ==> l <= k)` MP_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM num_MAX] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`1`; `{i:num}`] THEN ASM_SIMP_TAC[SUBSET; IN_SING; LE_REFL; HAS_SIZE; FINITE_INSERT] THEN SIMP_TAC[FINITE_RULES; CARD_CLAUSES; NOT_IN_EMPTY; ARITH] THEN SIMP_TAC[mono_on; IN_SING; REAL_LE_REFL]; EXISTS_TAC `CARD(1..m*n+1)` THEN ASM_MESON_TAC[CARD_SUBSET; FINITE_NUMSEG; HAS_SIZE]]; REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `t:num->num` (LABEL_TAC "*" ))] THEN ASM_CASES_TAC `?i. i IN (1..m*n+1) /\ m + 1 <= t(i)` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->bool` STRIP_ASSUME_TAC o CONJUNCT1) THEN MP_TAC(ISPEC `s:num->bool` CHOOSE_SUBSET) THEN ASM_MESON_TAC[HAS_SIZE; MONO_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!i. i IN (1..m*n+1) ==> 1 <= t i /\ t i <= m` ASSUME_TAC THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_FORALL) THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `1` o CONJUNCT2) THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `~(m + 1 <= n) ==> n <= m`]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `{i:num}` THEN ASM_SIMP_TAC[SUBSET; IN_SING; LE_REFL; HAS_SIZE; FINITE_INSERT] THEN SIMP_TAC[FINITE_RULES; CARD_CLAUSES; NOT_IN_EMPTY; ARITH] THEN SIMP_TAC[mono_on; IN_SING; REAL_LE_REFL]; ALL_TAC] THEN DISJ2_TAC THEN SUBGOAL_THEN `?s k:num. s SUBSET (1..m*n+1) /\ s HAS_SIZE (n + 1) /\ !i. i IN s ==> t(i) = k` MP_TAC THENL [MATCH_MP_TAC PIGEONHOLE_LEMMA THEN REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; ADD_SUB] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n * CARD(1..m)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CARD_NUMSEG_1] THEN ARITH_TAC] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->bool` THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[mono_on] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REWRITE_TAC[LE_LT; real_ge] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN REMOVE_THEN "*" (fun th -> MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th)) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->bool` STRIP_ASSUME_TAC o CONJUNCT1) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `k + 1` o CONJUNCT2) THEN ASM_SIMP_TAC[ARITH_RULE `~(k + 1 <= k)`; GSYM REAL_NOT_LT] THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN EXISTS_TAC `(i:num) INSERT s` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[HAS_SIZE_CLAUSES; GSYM ADD1] THEN ASM_MESON_TAC[NOT_LT]; ALL_TAC; REWRITE_TAC[IN_INSERT]; ASM_MESON_TAC[IN_INSERT; LE_REFL; LT_IMP_LE; LE_TRANS]] THEN RULE_ASSUM_TAC(REWRITE_RULE[mono_on]) THEN REWRITE_TAC[mono_on; IN_INSERT] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS; REAL_LT_IMP_LE; NOT_LE; LT_REFL; LE_TRANS]);; hol-light/100/thales.ml000066400000000000000000000077241303454263000150710ustar00rootroot00000000000000(* ========================================================================= *) (* Thales's theorem. *) (* ========================================================================= *) needs "Multivariate/convex.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Geometric concepts. *) (* ------------------------------------------------------------------------- *) let BETWEEN_THM = prove (`between x (a,b) <=> ?u. &0 <= u /\ u <= &1 /\ x = u % a + (&1 - u) % b`, REWRITE_TAC[BETWEEN_IN_CONVEX_HULL] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN REWRITE_TAC[CONVEX_HULL_2_ALT; IN_ELIM_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; let length_def = new_definition `length(A:real^2,B:real^2) = norm(B - A)`;; let is_midpoint = new_definition `is_midpoint (m:real^2) (a,b) <=> m = (&1 / &2) % (a + b)`;; (* ------------------------------------------------------------------------- *) (* This formulation works. *) (* ------------------------------------------------------------------------- *) let THALES = prove (`!centre radius a b c. length(a,centre) = radius /\ length(b,centre) = radius /\ length(c,centre) = radius /\ is_midpoint centre (a,b) ==> orthogonal (c - a) (c - b)`, REPEAT GEN_TAC THEN REWRITE_TAC[length_def; BETWEEN_THM; is_midpoint] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x pow 2`)) THEN REWRITE_TAC[NORM_POW_2] THEN FIRST_ASSUM(MP_TAC o SYM) THEN ABBREV_TAC `rad = radius pow 2` THEN POP_ASSUM_LIST(K ALL_TAC) THEN SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; orthogonal; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* But for another natural version, we need to use the reals. *) (* ------------------------------------------------------------------------- *) needs "Examples/sos.ml";; (* ------------------------------------------------------------------------- *) (* The following, which we need as a lemma, needs the reals specifically. *) (* ------------------------------------------------------------------------- *) let MIDPOINT = prove (`!m a b. between m (a,b) /\ length(a,m) = length(b,m) ==> is_midpoint m (a,b)`, REPEAT GEN_TAC THEN REWRITE_TAC[length_def; BETWEEN_THM; is_midpoint; NORM_EQ] THEN SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; orthogonal; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_SOS);; (* ------------------------------------------------------------------------- *) (* Now we get a more natural formulation of Thales's theorem. *) (* ------------------------------------------------------------------------- *) let THALES = prove (`!centre radius a b c:real^2. length(a,centre) = radius /\ length(b,centre) = radius /\ length(c,centre) = radius /\ between centre (a,b) ==> orthogonal (c - a) (c - b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `is_midpoint centre (a,b)` MP_TAC THENL [MATCH_MP_TAC MIDPOINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN UNDISCH_THEN `between (centre:real^2) (a,b)` (K ALL_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x pow 2`)) THEN REWRITE_TAC[length_def; is_midpoint; orthogonal; NORM_POW_2] THEN ABBREV_TAC `rad = radius pow 2` THEN POP_ASSUM_LIST(K ALL_TAC) THEN SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; orthogonal; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN CONV_TAC REAL_RING);; hol-light/100/triangular.ml000066400000000000000000000065701303454263000157570ustar00rootroot00000000000000(* ========================================================================= *) (* Sum of reciprocals of triangular numbers. *) (* ========================================================================= *) needs "Multivariate/misc.ml";; (*** Just for REAL_ARCH_INV! ***) prioritize_real();; (* ------------------------------------------------------------------------- *) (* Definition of triangular numbers. *) (* ------------------------------------------------------------------------- *) let triangle = new_definition `triangle n = (n * (n + 1)) DIV 2`;; (* ------------------------------------------------------------------------- *) (* Mapping them into the reals: division is exact. *) (* ------------------------------------------------------------------------- *) let REAL_TRIANGLE = prove (`&(triangle n) = (&n * (&n + &1)) / &2`, MATCH_MP_TAC(REAL_ARITH `&2 * x = y ==> x = y / &2`) THEN REWRITE_TAC[triangle; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN SUBGOAL_THEN `EVEN(n * (n + 1))` MP_TAC THENL [REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH] THEN CONV_TAC TAUT; REWRITE_TAC[EVEN_EXISTS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC DIV_MULT THEN REWRITE_TAC[ARITH]]);; (* ------------------------------------------------------------------------- *) (* Sum of a finite number of terms. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_FINITE_SUM = prove (`!n. sum(1..n) (\k. &1 / &(triangle k)) = &2 - &2 / (&n + &1)`, INDUCT_TAC THEN ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_TRIANGLE; GSYM REAL_OF_NUM_SUC] THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Hence limit. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_CONVERGES = prove (`!e. &0 < e ==> ?N. !n. n >= N ==> abs(sum(1..n) (\k. &1 / &(triangle k)) - &2) < e`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `2 * N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[TRIANGLE_FINITE_SUM; REAL_ARITH `abs(x - y - x) = abs y`] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* In terms of limits. *) (* ------------------------------------------------------------------------- *) needs "Library/analysis.ml";; override_interface ("-->",`(tends_num_real)`);; let TRIANGLE_CONVERGES' = prove (`(\n. sum(1..n) (\k. &1 / &(triangle k))) --> &2`, REWRITE_TAC[SEQ; TRIANGLE_CONVERGES]);; hol-light/100/two_squares.ml000066400000000000000000000271741303454263000161660ustar00rootroot00000000000000(* ========================================================================= *) (* Representation of primes == 1 (mod 4) as sum of 2 squares. *) (* ========================================================================= *) needs "Library/prime.ml";; prioritize_num();; (* ------------------------------------------------------------------------- *) (* Definition of involution and various basic lemmas. *) (* ------------------------------------------------------------------------- *) let involution = new_definition `involution f s = !x. x IN s ==> f(x) IN s /\ (f(f(x)) = x)`;; let INVOLUTION_IMAGE = prove (`!f s. involution f s ==> (IMAGE f s = s)`, REWRITE_TAC[involution; EXTENSION; IN_IMAGE] THEN MESON_TAC[]);; let INVOLUTION_DELETE = prove (`involution f s /\ a IN s /\ (f a = a) ==> involution f (s DELETE a)`, REWRITE_TAC[involution; IN_DELETE] THEN MESON_TAC[]);; let INVOLUTION_STEPDOWN = prove (`involution f s /\ a IN s ==> involution f (s DIFF {a, (f a)})`, REWRITE_TAC[involution; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; let INVOLUTION_NOFIXES = prove (`involution f s ==> involution f {x | x IN s /\ ~(f x = x)}`, REWRITE_TAC[involution; IN_ELIM_THM] THEN MESON_TAC[]);; let INVOLUTION_SUBSET = prove (`!f s t. involution f s /\ (!x. x IN t ==> f(x) IN t) /\ t SUBSET s ==> involution f t`, REWRITE_TAC[involution; SUBSET] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Involution with no fixpoints can only occur on finite set of even card *) (* ------------------------------------------------------------------------- *) let INVOLUTION_EVEN_STEP = prove (`FINITE(s) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) /\ a IN s ==> FINITE(s DIFF {a, (f a)}) /\ involution f (s DIFF {a, (f a)}) /\ (!x:A. x IN (s DIFF {a, (f a)}) ==> ~(f x = x)) /\ (CARD s = CARD(s DIFF {a, (f a)}) + 2)`, SIMP_TAC[FINITE_DIFF; INVOLUTION_STEPDOWN; IN_DIFF] THEN STRIP_TAC THEN SUBGOAL_THEN `s = (a:A) INSERT (f a) INSERT (s DIFF {a, (f a)})` MP_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN ASM_MESON_TAC[involution]; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DIFF; FINITE_INSERT] THEN ASM_SIMP_TAC[IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN ARITH_TAC);; let INVOLUTION_EVEN_INDUCT = prove (`!n s. FINITE(s) /\ (CARD s = n) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) ==> EVEN(CARD s)`, MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[CARD_CLAUSES; ARITH] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EXTENSION]) THEN REWRITE_TAC[NOT_IN_EMPTY; NOT_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(s DIFF {a:A, (f a)})`) THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `s DIFF {a:A, (f a)}`) THEN MP_TAC INVOLUTION_EVEN_STEP THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n < n + 2`] THEN SIMP_TAC[EVEN_ADD; ARITH]);; let INVOLUTION_EVEN = prove (`!s. FINITE(s) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) ==> EVEN(CARD s)`, MESON_TAC[INVOLUTION_EVEN_INDUCT]);; (* ------------------------------------------------------------------------- *) (* So an involution with exactly one fixpoint has odd card domain. *) (* ------------------------------------------------------------------------- *) let INVOLUTION_FIX_ODD = prove (`FINITE(s) /\ involution f s /\ (?!a:A. a IN s /\ (f a = a)) ==> ODD(CARD s)`, REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN STRIP_TAC THEN SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; IN_DELETE; ODD; NOT_ODD] THEN MATCH_MP_TAC INVOLUTION_EVEN THEN ASM_SIMP_TAC[INVOLUTION_DELETE; FINITE_DELETE; IN_DELETE] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* And an involution on a set of odd finite card must have a fixpoint. *) (* ------------------------------------------------------------------------- *) let INVOLUTION_ODD = prove (`!n s. FINITE(s) /\ involution f s /\ ODD(CARD s) ==> ?a. a IN s /\ (f a = a)`, REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[INVOLUTION_EVEN]);; (* ------------------------------------------------------------------------- *) (* Consequently, if one involution has a unique fixpoint, other has one. *) (* ------------------------------------------------------------------------- *) let INVOLUTION_FIX_FIX = prove (`!f g s. FINITE(s) /\ involution f s /\ involution g s /\ (?!x. x IN s /\ (f x = x)) ==> ?x. x IN s /\ (g x = x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INVOLUTION_ODD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INVOLUTION_FIX_ODD THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Formalization of Zagier's "one-sentence" proof over the natural numbers. *) (* ------------------------------------------------------------------------- *) let zset = new_definition `zset(a) = {(x,y,z) | x EXP 2 + 4 * y * z = a}`;; let zag = new_definition `zag(x,y,z) = if x + z < y then (x + 2 * z,z,y - (x + z)) else if x < 2 * y then (2 * y - x, y, (x + z) - y) else (x - 2 * y,(x + z) - y, y)`;; let tag = new_definition `tag((x,y,z):num#num#num) = (x,z,y)`;; let ZAG_INVOLUTION_GENERAL = prove (`0 < x /\ 0 < y /\ 0 < z ==> (zag(zag(x,y,z)) = (x,y,z))`, REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[PAIR_EQ] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; let IN_TRIPLE = prove (`(a,b,c) IN {(x,y,z) | P x y z} <=> P a b c`, REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[]);; let PRIME_SQUARE = prove (`!n. ~prime(n * n)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[PRIME_0; MULT_CLAUSES] THEN REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[ARITH] THEN DISJ2_TAC THEN EXISTS_TAC `n:num` THEN ASM_SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [ARITH_RULE `n = n * 1`] THEN ASM_SIMP_TAC[EQ_MULT_LCANCEL]);; let PRIME_4X = prove (`!n. ~prime(4 * n)`, GEN_TAC THEN REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN DISJ2_TAC THEN EXISTS_TAC `2` THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN ASM_SIMP_TAC[GSYM MULT_ASSOC; DIVIDES_RMUL; DIVIDES_REFL; ARITH_EQ] THEN ASM_CASES_TAC `n = 0` THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let PRIME_XYZ_NONZERO = prove (`prime(x EXP 2 + 4 * y * z) ==> 0 < x /\ 0 < y /\ 0 < z`, CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM; ARITH_RULE `~(0 < x) = (x = 0)`] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES; PRIME_SQUARE; PRIME_4X]);; let ZAG_INVOLUTION = prove (`!p. prime(p) ==> involution zag (zset(p))`, REPEAT STRIP_TAC THEN REWRITE_TAC[involution; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN REWRITE_TAC[zset; IN_TRIPLE] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN CONJ_TAC THENL [REWRITE_TAC[zag] THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_TRIPLE] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN ASM_SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD; EXP_2; GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_SUB; LT_IMP_LE] THEN INT_ARITH_TAC; MATCH_MP_TAC ZAG_INVOLUTION_GENERAL THEN ASM_MESON_TAC[PRIME_XYZ_NONZERO]]);; let TAG_INVOLUTION = prove (`!a. involution tag (zset a)`, REWRITE_TAC[involution; tag; zset; FORALL_PAIR_THM] THEN REWRITE_TAC[IN_TRIPLE] THEN REWRITE_TAC[MULT_AC]);; let ZAG_LEMMA = prove (`(zag(x,y,z) = (x,y,z)) ==> (y = x)`, REWRITE_TAC[zag; INT_POW_2] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[PAIR_EQ]) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; let ZSET_BOUND = prove (`0 < y /\ 0 < z /\ (x EXP 2 + 4 * y * z = p) ==> x <= p /\ y <= p /\ z <= p`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONJ_TAC THENL [MESON_TAC[EXP_2; LE_SQUARE_REFL; ARITH_RULE `(a <= b ==> a <= b + c)`]; CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE `y <= z ==> y <= x + z`) THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MULT_SYM]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `y <= 4 * a * y <=> 1 * y <= (4 * a) * y`] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_SIMP_TAC[ARITH_RULE `0 < a ==> 1 <= 4 * a`]]);; let ZSET_FINITE = prove (`!p. prime(p) ==> FINITE(zset p)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `p + 1` FINITE_NUMSEG_LT) THEN DISCH_THEN(fun th -> MP_TAC(funpow 2 (MATCH_MP FINITE_PRODUCT o CONJ th) th)) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] FINITE_SUBSET) THEN REWRITE_TAC[zset; SUBSET; FORALL_PAIR_THM; IN_TRIPLE] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN REWRITE_TAC[IN_ELIM_THM; EXISTS_PAIR_THM; PAIR_EQ] THEN REWRITE_TAC[ARITH_RULE `x < p + 1 <=> x <= p`; PAIR_EQ] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:num`; `y:num`; `z:num`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MAP_EVERY EXISTS_TAC [`y:num`; `z:num`] THEN REWRITE_TAC[] THEN ASM_MESON_TAC[ZSET_BOUND; PRIME_XYZ_NONZERO]);; let SUM_OF_TWO_SQUARES = prove (`!p k. prime(p) /\ (p = 4 * k + 1) ==> ?x y. p = x EXP 2 + y EXP 2`, SIMP_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?t. t IN zset(p) /\ (tag(t) = t)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM; tag; PAIR_EQ] THEN REWRITE_TAC[zset; IN_TRIPLE; EXP_2] THEN ASM_MESON_TAC[ARITH_RULE `4 * x * y = (2 * x) * (2 * y)`]] THEN MATCH_MP_TAC INVOLUTION_FIX_FIX THEN EXISTS_TAC `zag` THEN ASM_SIMP_TAC[ZAG_INVOLUTION; TAG_INVOLUTION; ZSET_FINITE] THEN REWRITE_TAC[EXISTS_UNIQUE_ALT] THEN EXISTS_TAC `1,1,k:num` THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[zset; zag; IN_TRIPLE; ARITH] THEN REWRITE_TAC[MULT_CLAUSES; ARITH_RULE `~(1 + k < 1)`; PAIR_EQ] THEN ARITH_TAC] THEN REWRITE_TAC[zset; IN_TRIPLE] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST_ALL_TAC o MATCH_MP ZAG_LEMMA) THEN UNDISCH_TAC `x EXP 2 + 4 * x * z = 4 * k + 1` THEN REWRITE_TAC[EXP_2; ARITH_RULE `x * x + 4 * x * z = x * (4 * z + x)`] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `prime p` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[prime] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:num`)) THEN SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THENL [UNDISCH_TAC `4 * k + 1 = 1 * (4 * z + 1)` THEN REWRITE_TAC[MULT_CLAUSES; PAIR_EQ] THEN ARITH_TAC; ONCE_REWRITE_TAC[ARITH_RULE `(a = a * b) = (a * b = a * 1)`] THEN ASM_SIMP_TAC[EQ_MULT_LCANCEL] THEN STRIP_TAC THENL [UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0; ARITH_EQ]; UNDISCH_TAC `4 * z + x = 1` THEN REWRITE_TAC[PAIR_EQ] THEN ASM_CASES_TAC `z = 0` THENL [ALL_TAC; UNDISCH_TAC `~(z = 0)` THEN ARITH_TAC] THEN UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ASM_CASES_TAC `x = 1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MULT_CLAUSES] THEN ARITH_TAC]]);; hol-light/100/wilson.ml000066400000000000000000000231371303454263000151200ustar00rootroot00000000000000(* ========================================================================= *) (* Wilson's theorem. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/pocklington.ml";; prioritize_num();; (* ------------------------------------------------------------------------- *) (* Definition of iterated product. *) (* ------------------------------------------------------------------------- *) let product = new_definition `product = iterate ( * )`;; let PRODUCT_CLAUSES = prove (`(!f. product {} f = 1) /\ (!x f s. FINITE(s) ==> (product (x INSERT s) f = if x IN s then product s f else f(x) * product s f))`, REWRITE_TAC[product; GSYM NEUTRAL_MUL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; (* ------------------------------------------------------------------------- *) (* Factorial in terms of products. *) (* ------------------------------------------------------------------------- *) let FACT_PRODUCT = prove (`!n. FACT(n) = product(1..n) (\i. i)`, INDUCT_TAC THEN REWRITE_TAC[FACT; NUMSEG_CLAUSES; ARITH; PRODUCT_CLAUSES] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= SUC n`; PRODUCT_CLAUSES; FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; let FACT_PRODUCT_ALT = prove (`!n. FACT(n) = product(2..n) (\i. i)`, GEN_TAC THEN REWRITE_TAC[FACT_PRODUCT] THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THEN ASM_REWRITE_TAC[num_CONV `1`; NUMSEG_CLAUSES] THEN REWRITE_TAC[ARITH; PRODUCT_CLAUSES; FACT] THEN ASM_SIMP_TAC[GSYM NUMSEG_LREC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; MULT_CLAUSES] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* General "pairing up" theorem for products. *) (* ------------------------------------------------------------------------- *) let PRODUCT_PAIRUP_INDUCT = prove (`!f r n s. FINITE s /\ CARD s = n /\ (!x:A. x IN s ==> ?!y. y IN s /\ ~(y = x) /\ (f(x) * f(y) == 1) (mod r)) ==> (product s f == 1) (mod r)`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `s:A->bool` THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[PRODUCT_CLAUSES; CONG_REFL] THEN STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[CARD_EQ_0]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN FIRST_ASSUM(MP_TAC o SPEC `n - 2`) THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 2 < n`] THEN FIRST_ASSUM(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[ASSUME `(a:A) IN s`] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(s DELETE a) DELETE (b:A)`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FINITE_DELETE] THEN SIMP_TAC[FINITE_DELETE; ASSUME `FINITE(s:A->bool)`; CARD_DELETE] THEN ASM_REWRITE_TAC[IN_DELETE] THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:A` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(x:A) IN s`)) THEN REWRITE_TAC[EXISTS_UNIQUE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:A` THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THENL [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(b:A) IN s`)) THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a:A`; `x:A`] o CONJUNCT2) THEN ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `s = (a:A) INSERT (b INSERT (s DELETE a DELETE b))` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_INSERT; FINITE_DELETE; ASSUME `FINITE(s:A->bool)`] THEN ASM_REWRITE_TAC[IN_INSERT; IN_DELETE; MULT_CLAUSES] THEN REWRITE_TAC[MULT_ASSOC] THEN ONCE_REWRITE_TAC[SYM(NUM_REDUCE_CONV `1 * 1`)] THEN MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[]);; let PRODUCT_PAIRUP = prove (`!f r s. FINITE s /\ (!x:A. x IN s ==> ?!y. y IN s /\ ~(y = x) /\ (f(x) * f(y) == 1) (mod r)) ==> (product s f == 1) (mod r)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_PAIRUP_INDUCT THEN EXISTS_TAC `CARD(s:A->bool)` THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence Wilson's theorem. *) (* ------------------------------------------------------------------------- *) let WILSON = prove (`!p. prime(p) ==> (FACT(p - 1) == p - 1) (mod p)`, GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `p = 0` THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN ASM_CASES_TAC `p = 1` THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN ASM_CASES_TAC `p = 2` THENL [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[CONG_REFL]; ALL_TAC] THEN SUBGOAL_THEN `FACT(p - 1) = FACT(p - 2) * (p - 1)` SUBST1_TAC THENL [SUBGOAL_THEN `p - 1 = SUC(p - 2)` (fun th -> REWRITE_TAC[th; FACT; MULT_AC]) THEN ASM_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `x = 1 * x`] THEN MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL] THEN REWRITE_TAC[FACT_PRODUCT_ALT] THEN MATCH_MP_TAC PRODUCT_PAIRUP THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `x:num` THEN STRIP_TAC THEN MP_TAC(SPECL [`p:num`; `x:num`] CONG_UNIQUE_INVERSE_PRIME) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC MONO_EXISTS; REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC] THEN X_GEN_TAC `y:num` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_CASES_TAC `y = 1` THEN ASM_REWRITE_TAC[ARITH_RULE `2 <= y <=> 0 < y /\ ~(y = 1)`] THEN UNDISCH_TAC `(x * y == 1) (mod p)` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN ASM_SIMP_TAC[CONG; MOD_LT; ARITH_RULE `x <= p - 2 /\ ~(p = 0) ==> x < p`; ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 1 < p`] THEN UNDISCH_TAC `2 <= x` THEN ARITH_TAC; MATCH_MP_TAC(ARITH_RULE `y < p /\ ~(y = p - 1) ==> y <= p - 2`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `(x * y == 1) (mod p)` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `(x + 1 == 0) (mod p)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[CONG_0] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN MAP_EVERY UNDISCH_TAC [`2 <= x`; `x <= p - 2`] THEN ARITH_TAC] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `x * p:num` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CONG_0] THEN MESON_TAC[divides; MULT_SYM]] THEN SUBGOAL_THEN `x * p = x + x * (p - 1)` SUBST1_TAC THENL [REWRITE_TAC[LEFT_SUB_DISTRIB; MULT_CLAUSES] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_MP_TAC(GSYM SUB_ADD) THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `x = x * 1`] THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN UNDISCH_TAC `~(p = 0)` THEN ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN MATCH_MP_TAC CONG_ADD THEN ASM_REWRITE_TAC[CONG_REFL]; FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `((x + 1) * (x - 1) == 0) (mod p)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[CONG_0] THEN DISCH_THEN(MP_TAC o CONJ (ASSUME `prime p`)) THEN DISCH_THEN(MP_TAC o MATCH_MP PRIME_DIVPROD) THEN DISCH_THEN(DISJ_CASES_THEN (MP_TAC o MATCH_MP DIVIDES_LE)) THEN MAP_EVERY UNDISCH_TAC [`2 <= x`; `x <= p - 2`; `~(p = 1)`; `~(p = 0)`] THEN ARITH_TAC] THEN ONCE_REWRITE_TAC[GSYM(SPEC `1` CONG_ADD_LCANCEL_EQ)] THEN SUBGOAL_THEN `1 + (x + 1) * (x - 1) = x * x` (fun th -> ASM_REWRITE_TAC[th; ARITH]) THEN REWRITE_TAC[LEFT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `(x + 1) * 1 <= (x + 1) * x ==> 1 + (x + 1) * x - (x + 1) * 1 = x * x`) THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN UNDISCH_TAC `2 <= x` THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* And in fact we have a converse. *) (* ------------------------------------------------------------------------- *) let WILSON_EQ = prove (`!p. ~(p = 1) ==> (prime p <=> (FACT(p - 1) == p - 1) (mod p))`, X_GEN_TAC `n:num` THEN DISCH_TAC THEN EQ_TAC THEN SIMP_TAC[WILSON] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[LE_LT] THEN ASM_CASES_TAC `n:num = p` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `x < y ==> x <= y - 1`)) THEN ASM_SIMP_TAC[GSYM DIVIDES_FACT_PRIME] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN SUBGOAL_THEN `p divides FACT(n - 1) <=> p divides (n - 1)` SUBST1_TAC THENL [MATCH_MP_TAC CONG_DIVIDES THEN MATCH_MP_TAC CONG_MOD_MULT THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `p divides 1` MP_TAC THENL [MATCH_MP_TAC DIVIDES_ADD_REVR THEN EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`]; REWRITE_TAC[DIVIDES_ONE] THEN ASM_MESON_TAC[PRIME_1]]);; hol-light/Arithmetic/000077500000000000000000000000001303454263000150365ustar00rootroot00000000000000hol-light/Arithmetic/arithprov.ml000066400000000000000000000567201303454263000174200ustar00rootroot00000000000000(* ========================================================================= *) (* Proof that provability is definable; weak form of Godel's theorem. *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* Auxiliary predicate: all numbers in an iterated-pair "list". *) (* ------------------------------------------------------------------------- *) let ALLN_DEF = let th = prove (`!P. ?ALLN. !z. ALLN z <=> if ?x y. z = NPAIR x y then P (@x. ?y. NPAIR x y = z) /\ ALLN (@y. ?x. NPAIR x y = z) else T`, GEN_TAC THEN MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN BINOP_TAC THENL [ALL_TAC; FIRST_ASSUM MATCH_MP_TAC] THEN FIRST_ASSUM(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[NPAIR_INJ; RIGHT_EXISTS_AND_THM; EXISTS_REFL; SELECT_REFL; NPAIR_LT; LEFT_EXISTS_AND_THM]) in new_specification ["ALLN"] (REWRITE_RULE[SKOLEM_THM] th);; let ALLN = prove (`(ALLN P 0 <=> T) /\ (ALLN P (NPAIR x y) <=> P x /\ ALLN P y)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [ALLN_DEF] THEN REWRITE_TAC[NPAIR_NONZERO] THEN REWRITE_TAC[NPAIR_INJ; LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[EXISTS_REFL; GSYM EXISTS_REFL]);; (* ------------------------------------------------------------------------- *) (* Valid term. *) (* ------------------------------------------------------------------------- *) let TERM1 = new_definition `TERM1 x y <=> (?l u. (x = l) /\ (y = NPAIR (NPAIR 0 u) l)) \/ (?l. (x = l) /\ (y = NPAIR (NPAIR 1 0) l)) \/ (?t l. (x = NPAIR t l) /\ (y = NPAIR (NPAIR 2 t) l)) \/ (?n s t l. ((n = 3) \/ (n = 4)) /\ (x = NPAIR s (NPAIR t l)) /\ (y = NPAIR (NPAIR n (NPAIR s t)) l))`;; let TERM = new_definition `TERM n <=> RTC TERM1 0 (NPAIR n 0)`;; let isagterm = new_definition `isagterm n <=> ?t. n = gterm t`;; let TERM_LEMMA1 = prove (`!x y. TERM1 x y ==> ALLN isagterm x ==> ALLN isagterm y`, REPEAT GEN_TAC THEN REWRITE_TAC[TERM1] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN; isagterm] THEN MESON_TAC[gterm; NUMBER_SURJ]);; let TERM_LEMMA2 = prove (`!t a. RTC TERM1 a (NPAIR (gterm t) a)`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[gterm] THEN MESON_TAC[RTC_INC; RTC_TRANS; TERM1]);; let TERM_THM = prove (`!n. TERM n <=> ?t. n = gterm t`, GEN_TAC THEN REWRITE_TAC[TERM] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[TERM_LEMMA2]] THEN SUBGOAL_THEN `!x y. RTC TERM1 x y ==> ALLN isagterm x ==> ALLN isagterm y` (fun th -> MESON_TAC[ALLN; isagterm; th]) THEN MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[TERM_LEMMA1] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Valid formula. *) (* ------------------------------------------------------------------------- *) let FORM1 = new_definition `FORM1 x y <=> (?l. (x = l) /\ (y = NPAIR (NPAIR 0 0) l)) \/ (?l. (x = l) /\ (y = NPAIR (NPAIR 0 1) l)) \/ (?n s t l. ((n = 1) \/ (n = 2) \/ (n = 3)) /\ TERM s /\ TERM t /\ (x = l) /\ (y = NPAIR (NPAIR n (NPAIR s t)) l)) \/ (?p l. (x = NPAIR p l) /\ (y = NPAIR (NPAIR 4 p) l)) \/ (?n p q l. ((n = 5) \/ (n = 6) \/ (n = 7) \/ (n = 8)) /\ (x = NPAIR p (NPAIR q l)) /\ (y = NPAIR (NPAIR n (NPAIR p q)) l)) \/ (?n u p l. ((n = 9) \/ (n = 10)) /\ (x = NPAIR p l) /\ (y = NPAIR (NPAIR n (NPAIR u p)) l))`;; let FORM = new_definition `FORM n <=> RTC FORM1 0 (NPAIR n 0)`;; let isagform = new_definition `isagform n <=> ?t. n = gform t`;; let FORM_LEMMA1 = prove (`!x y. FORM1 x y ==> ALLN isagform x ==> ALLN isagform y`, REPEAT GEN_TAC THEN REWRITE_TAC[FORM1] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN; isagform] THEN MESON_TAC[gform; TERM_THM; NUMBER_SURJ]);; (*** Following really blows up if we just use FORM1 *** instead of manually breaking up the conjuncts ***) let FORM_LEMMA2 = prove (`!p a. RTC FORM1 a (NPAIR (gform p) a)`, MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[gform] THEN REPEAT CONJ_TAC THEN MESON_TAC[RTC_INC; RTC_TRANS; TERM_THM; REWRITE_RULE[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] (snd(EQ_IMP_RULE (SPEC_ALL FORM1)))]);; let FORM_THM = prove (`!n. FORM n <=> ?p. n = gform p`, GEN_TAC THEN REWRITE_TAC[FORM] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FORM_LEMMA2]] THEN SUBGOAL_THEN `!x y. RTC FORM1 x y ==> ALLN isagform x ==> ALLN isagform y` (fun th -> MESON_TAC[ALLN; isagform; th]) THEN MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FORM_LEMMA1] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Term without particular variable. *) (* ------------------------------------------------------------------------- *) let FREETERM1 = new_definition `FREETERM1 m x y <=> (?l u. ~(u = m) /\ (x = l) /\ (y = NPAIR (NPAIR 0 u) l)) \/ (?l. (x = l) /\ (y = NPAIR (NPAIR 1 0) l)) \/ (?t l. (x = NPAIR t l) /\ (y = NPAIR (NPAIR 2 t) l)) \/ (?n s t l. ((n = 3) \/ (n = 4)) /\ (x = NPAIR s (NPAIR t l)) /\ (y = NPAIR (NPAIR n (NPAIR s t)) l))`;; let FREETERM = new_definition `FREETERM m n <=> RTC (FREETERM1 m) 0 (NPAIR n 0)`;; let isafterm = new_definition `isafterm m n <=> ?t. ~(m IN IMAGE number (FVT t)) /\ (n = gterm t)`;; let ISAFTERM = prove (`(~(number x = m) ==> isafterm m (NPAIR 0 (number x))) /\ isafterm m (NPAIR 1 0) /\ (isafterm m t ==> isafterm m (NPAIR 2 t)) /\ (isafterm m s /\ isafterm m t ==> isafterm m (NPAIR 3 (NPAIR s t))) /\ (isafterm m s /\ isafterm m t ==> isafterm m (NPAIR 4 (NPAIR s t)))`, REWRITE_TAC[isafterm; gterm] THEN REPEAT CONJ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `V x`; EXISTS_TAC `Z`; DISCH_THEN(X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC) THEN EXISTS_TAC `Suc t`; DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `s ++ t`; DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `s ** t`] THEN ASM_REWRITE_TAC[gterm; FVT; IMAGE_UNION; NOT_IN_EMPTY; IN_SING; IN_UNION; IMAGE_CLAUSES]);; let FREETERM_LEMMA1 = prove (`!m x y. FREETERM1 m x y ==> ALLN (isafterm m) x ==> ALLN (isafterm m) y`, REPEAT GEN_TAC THEN REWRITE_TAC[FREETERM1] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN MESON_TAC[ISAFTERM; NUMBER_SURJ]);; let FREETERM_LEMMA2 = prove (`!m t a. ~(m IN IMAGE number (FVT t)) ==> RTC (FREETERM1 m) a (NPAIR (gterm t) a)`, GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[gterm; FVT; NOT_IN_EMPTY; IN_SING; IN_UNION; IMAGE_CLAUSES; IMAGE_UNION] THEN REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT CONJ_TAC THEN TRY(REPEAT GEN_TAC THEN DISCH_THEN (fun th -> GEN_TAC THEN STRIP_TAC THEN MP_TAC th)) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[RTC_INC; RTC_TRANS; FREETERM1]);; let FREETERM_THM = prove (`!m n. FREETERM m n <=> ?t. ~(m IN IMAGE number (FVT(t))) /\ (n = gterm t)`, REPEAT GEN_TAC THEN REWRITE_TAC[FREETERM] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FREETERM_LEMMA2]] THEN SUBGOAL_THEN `!x y. RTC (FREETERM1 m) x y ==> ALLN (isafterm m) x ==> ALLN (isafterm m) y` (fun th -> MESON_TAC[ALLN; isagterm; isafterm; th]) THEN MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FREETERM_LEMMA1] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Formula without particular free variable. *) (* ------------------------------------------------------------------------- *) let FREEFORM1 = new_definition `FREEFORM1 m x y <=> (?l. (x = l) /\ (y = NPAIR (NPAIR 0 0) l)) \/ (?l. (x = l) /\ (y = NPAIR (NPAIR 0 1) l)) \/ (?n s t l. ((n = 1) \/ (n = 2) \/ (n = 3)) /\ FREETERM m s /\ FREETERM m t /\ (x = l) /\ (y = NPAIR (NPAIR n (NPAIR s t)) l)) \/ (?p l. (x = NPAIR p l) /\ (y = NPAIR (NPAIR 4 p) l)) \/ (?n p q l. ((n = 5) \/ (n = 6) \/ (n = 7) \/ (n = 8)) /\ (x = NPAIR p (NPAIR q l)) /\ (y = NPAIR (NPAIR n (NPAIR p q)) l)) \/ (?n u p l. ((n = 9) \/ (n = 10)) /\ (x = NPAIR p l) /\ (y = NPAIR (NPAIR n (NPAIR u p)) l)) \/ (?n p l. ((n = 9) \/ (n = 10)) /\ (x = l) /\ FORM p /\ (y = NPAIR (NPAIR n (NPAIR m p)) l))`;; let FREEFORM = new_definition `FREEFORM m n <=> RTC (FREEFORM1 m) 0 (NPAIR n 0)`;; let isafform = new_definition `isafform m n <=> ?p. ~(m IN IMAGE number (FV p)) /\ (n = gform p)`;; let ISAFFORM = prove (`isafform m (NPAIR 0 0) /\ isafform m (NPAIR 0 1) /\ (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 1 (NPAIR s t))) /\ (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 2 (NPAIR s t))) /\ (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 3 (NPAIR s t))) /\ (isafform m p ==> isafform m (NPAIR 4 p)) /\ (isafform m p /\ isafform m q ==> isafform m (NPAIR 5 (NPAIR p q))) /\ (isafform m p /\ isafform m q ==> isafform m (NPAIR 6 (NPAIR p q))) /\ (isafform m p /\ isafform m q ==> isafform m (NPAIR 7 (NPAIR p q))) /\ (isafform m p /\ isafform m q ==> isafform m (NPAIR 8 (NPAIR p q))) /\ (isafform m p ==> isafform m (NPAIR 9 (NPAIR x p))) /\ (isafform m p ==> isafform m (NPAIR 10 (NPAIR x p))) /\ (isagform p ==> isafform m (NPAIR 9 (NPAIR m p))) /\ (isagform p ==> isafform m (NPAIR 10 (NPAIR m p)))`, let tac0 = DISCH_THEN(X_CHOOSE_THEN `p:form` STRIP_ASSUME_TAC) and tac1 = DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) and tac2 = DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `p:form` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `q:form` STRIP_ASSUME_TAC)) in REWRITE_TAC[isafform; gform; isagform; isafterm] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `False`; EXISTS_TAC `True`; tac1 THEN EXISTS_TAC `s === t`; tac1 THEN EXISTS_TAC `s << t`; tac1 THEN EXISTS_TAC `s <<= t`; tac0 THEN EXISTS_TAC `Not p`; tac2 THEN EXISTS_TAC `p && q`; tac2 THEN EXISTS_TAC `p || q`; tac2 THEN EXISTS_TAC `p --> q`; tac2 THEN EXISTS_TAC `p <-> q`; tac0 THEN EXISTS_TAC `!!(denumber x) p`; tac0 THEN EXISTS_TAC `??(denumber x) p`; tac0 THEN EXISTS_TAC `!!(denumber m) p`; tac0 THEN EXISTS_TAC `??(denumber m) p`] THEN ASM_REWRITE_TAC[FV; IN_DELETE; NOT_IN_EMPTY; IN_SING; IN_UNION; gform; NUMBER_DENUMBER; IMAGE_CLAUSES; IMAGE_UNION] THEN ASM SET_TAC[NUMBER_DENUMBER]);; let FREEFORM_LEMMA1 = prove (`!x y. FREEFORM1 m x y ==> ALLN (isafform m) x ==> ALLN (isafform m) y`, REPEAT GEN_TAC THEN REWRITE_TAC[FREEFORM1] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN REWRITE_TAC[FREETERM_THM; GSYM isafterm] THEN REWRITE_TAC[FORM_THM; GSYM isagform] THEN MESON_TAC[ISAFFORM]);; let FREEFORM_LEMMA2 = prove (`!m p a. ~(m IN IMAGE number (FV p)) ==> RTC (FREEFORM1 m) a (NPAIR (gform p) a)`, let lemma = prove (`m IN IMAGE number (s DELETE k) <=> m IN IMAGE number s /\ ~(m = number k)`, SET_TAC[NUMBER_INJ]) in GEN_TAC THEN MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[gform; FV; NOT_IN_EMPTY; IN_DELETE; IN_SING; IN_UNION; lemma; IMAGE_UNION; IMAGE_CLAUSES] THEN REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT CONJ_TAC THEN TRY(REPEAT GEN_TAC THEN DISCH_THEN (fun th -> GEN_TAC THEN STRIP_TAC THEN MP_TAC th)) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[RTC_INC; RTC_TRANS; FORM_THM; REWRITE_RULE[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`; FREETERM_THM] (snd(EQ_IMP_RULE (SPEC_ALL FREEFORM1)))]);; let FREEFORM_THM = prove (`!m n. FREEFORM m n <=> ?p. ~(m IN IMAGE number (FV p)) /\ (n = gform p)`, REPEAT GEN_TAC THEN REWRITE_TAC[FREEFORM] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FREEFORM_LEMMA2]] THEN SUBGOAL_THEN `!x y. RTC (FREEFORM1 m) x y ==> ALLN (isafform m) x ==> ALLN (isafform m) y` (fun th -> MESON_TAC[ALLN; isagform; isafform; th]) THEN MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FREEFORM_LEMMA1] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Arithmetization of logical axioms --- autogenerated. *) (* ------------------------------------------------------------------------- *) let AXIOM,AXIOM_THM = let th0 = prove (`((?x p. P (number x) (gform p) /\ ~(x IN FV(p))) <=> (?x p. FREEFORM x p /\ P x p)) /\ ((?x t. P (number x) (gterm t) /\ ~(x IN FVT(t))) <=> (?x t. FREETERM x t /\ P x t))`, REWRITE_TAC[FREETERM_THM; FREEFORM_THM] THEN CONJ_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2; IN_IMAGE] THEN ASM_MESON_TAC[IN_IMAGE; NUMBER_DENUMBER]) and th1 = prove (`((?p. P(gform p)) <=> (?p. FORM(p) /\ P p)) /\ ((?t. P(gterm t)) <=> (?t. TERM(t) /\ P t))`, MESON_TAC[FORM_THM; TERM_THM]) and th2 = prove (`(?x. P(number x)) <=> (?x. P x)`, MESON_TAC[NUMBER_DENUMBER]) in let th = (REWRITE_CONV[GSYM GFORM_INJ] THENC REWRITE_CONV[gform; gterm] THENC REWRITE_CONV[th0] THENC REWRITE_CONV[th1] THENC REWRITE_CONV[th2] THENC REWRITE_CONV[RIGHT_AND_EXISTS_THM]) (rhs(concl(SPEC `a:form` axiom_CASES))) in let dtm = mk_eq(`(AXIOM:num->bool) a`, subst [`a:num`,`gform a`] (rhs(concl th))) in let AXIOM = new_definition dtm in let AXIOM_THM = prove (`!p. AXIOM(gform p) <=> axiom p`, REWRITE_TAC[axiom_CASES; AXIOM; th]) in AXIOM,AXIOM_THM;; (* ------------------------------------------------------------------------- *) (* Prove also that all AXIOMs are in fact numbers of formulas. *) (* ------------------------------------------------------------------------- *) let GTERM_CASES_ALT = prove (`(gterm u = NPAIR 0 x <=> u = V(denumber x))`, REWRITE_TAC[GSYM GTERM_CASES; NUMBER_DENUMBER]);; let GFORM_CASES_ALT = prove (`(gform r = NPAIR 9 (NPAIR x n) <=> (?p. r = !!(denumber x) p /\ gform p = n)) /\ (gform r = NPAIR 10 (NPAIR x n) <=> (?p. r = ??(denumber x) p /\ gform p = n))`, REWRITE_TAC[GSYM GFORM_CASES; NUMBER_DENUMBER]);; let AXIOM_FORMULA = prove (`!a. AXIOM a ==> ?p. a = gform p`, REWRITE_TAC[AXIOM; FREEFORM_THM; FREETERM_THM; FORM_THM; TERM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC(BINDER_CONV SYM_CONV) THEN REWRITE_TAC[GFORM_CASES; GTERM_CASES; GTERM_CASES_ALT; GFORM_CASES_ALT] THEN MESON_TAC[NUMBER_DENUMBER]);; let AXIOM_THM_STRONG = prove (`!a. AXIOM a <=> ?p. axiom p /\ (a = gform p)`, MESON_TAC[AXIOM_THM; AXIOM_FORMULA]);; (* ------------------------------------------------------------------------- *) (* Arithmetization of the full logical inference rules. *) (* ------------------------------------------------------------------------- *) let PROV1 = new_definition `PROV1 A x y <=> (?a. (AXIOM a \/ a IN A) /\ (y = NPAIR a x)) \/ (?p q l. (x = NPAIR (NPAIR 7 (NPAIR p q)) (NPAIR p l)) /\ (y = NPAIR q l)) \/ (?p u l. (x = NPAIR p l) /\ (y = NPAIR (NPAIR 9 (NPAIR u p)) l))`;; let PROV = new_definition `PROV A n <=> RTC (PROV1 A) 0 (NPAIR n 0)`;; let isaprove = new_definition `isaprove A n <=> ?p. (gform p = n) /\ A |-- p`;; let PROV_LEMMA1 = prove (`!A p q. PROV1 (IMAGE gform A) x y ==> ALLN (isaprove A) x ==> ALLN (isaprove A) y`, REPEAT GEN_TAC THEN REWRITE_TAC[PROV1] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN REWRITE_TAC[isaprove] THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[AXIOM_THM_STRONG; proves_RULES]; ASM_MESON_TAC[IN_IMAGE; GFORM_INJ; proves_RULES; gform]; ALL_TAC; ASM_MESON_TAC[NUMBER_DENUMBER; IN_IMAGE; GFORM_INJ; proves_RULES; gform]] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[gform; NPAIR_INJ; ARITH_EQ] THEN MAP_EVERY X_GEN_TAC [`P:form`; `Q:form`] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (STRIP_ASSUME_TAC o GSYM) MP_TAC) THEN ASM_REWRITE_TAC[GFORM_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2] THEN ASM_MESON_TAC[proves_RULES]);; let PROV_LEMMA2 = prove (`!A p. A |-- p ==> !a. RTC (PROV1 (IMAGE gform A)) a (NPAIR (gform p) a)`, GEN_TAC THEN MATCH_MP_TAC proves_INDUCT THEN REWRITE_TAC[gform] THEN MESON_TAC[RTC_INC; RTC_TRANS; PROV1; IN_IMAGE; AXIOM_THM]);; let PROV_THM_STRONG = prove (`!A n. PROV (IMAGE gform A) n <=> ?p. A |-- p /\ (gform p = n)`, REPEAT GEN_TAC THEN REWRITE_TAC[PROV] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[PROV_LEMMA2]] THEN SUBGOAL_THEN `!x y. RTC (PROV1 (IMAGE gform A)) x y ==> ALLN (isaprove A) x ==> ALLN (isaprove A) y` (fun th -> MESON_TAC[ALLN; isaprove; GFORM_INJ; th]) THEN MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[PROV_LEMMA1] THEN MESON_TAC[]);; let PROV_THM = prove (`!A p. PROV (IMAGE gform A) (gform p) <=> A |-- p`, MESON_TAC[PROV_THM_STRONG; GFORM_INJ]);; (* ------------------------------------------------------------------------- *) (* Now really objectify all that. *) (* ------------------------------------------------------------------------- *) let arith_term1,ARITH_TERM1 = OBJECTIFY [] "arith_term1" TERM1;; let FV_TERM1 = prove (`!s t. FV(arith_term1 s t) = (FVT s) UNION (FVT t)`, FV_TAC[arith_term1; FVT_PAIR; FVT_NUMERAL]);; let arith_term,ARITH_TERM = OBJECTIFY_RTC ARITH_TERM1 "arith_term" TERM;; let FV_TERM = prove (`!t. FV(arith_term t) = FVT t`, FV_TAC[arith_term; FV_RTC; FV_TERM1; FVT_PAIR; FVT_NUMERAL]);; let arith_form1,ARITH_FORM1 = OBJECTIFY [ARITH_TERM] "arith_form1" FORM1;; let FV_FORM1 = prove (`!s t. FV(arith_form1 s t) = (FVT s) UNION (FVT t)`, FV_TAC[arith_form1; FV_TERM; FVT_PAIR; FVT_NUMERAL]);; let arith_form,ARITH_FORM = OBJECTIFY_RTC ARITH_FORM1 "arith_form" FORM;; let FV_FORM = prove (`!t. FV(arith_form t) = FVT t`, FV_TAC[arith_form; FV_RTC; FV_FORM1; FVT_PAIR; FVT_NUMERAL]);; let arith_freeterm1,ARITH_FREETERM1 = OBJECTIFY [] "arith_freeterm1" FREETERM1;; let FV_FREETERM1 = prove (`!s t u. FV(arith_freeterm1 s t u) = (FVT s) UNION (FVT t) UNION (FVT u)`, FV_TAC[arith_freeterm1; FVT_PAIR; FVT_NUMERAL]);; let arith_freeterm,ARITH_FREETERM = OBJECTIFY_RTCP ARITH_FREETERM1 "arith_freeterm" FREETERM;; let FV_FREETERM = prove (`!s t. FV(arith_freeterm s t) = (FVT s) UNION (FVT t)`, FV_TAC[arith_freeterm; FV_RTCP; FV_FREETERM1; FVT_PAIR; FVT_NUMERAL]);; let arith_freeform1,ARITH_FREEFORM1 = OBJECTIFY [ARITH_FREETERM; ARITH_FORM] "arith_freeform1" FREEFORM1;; let FV_FREEFORM1 = prove (`!s t u. FV(arith_freeform1 s t u) = (FVT s) UNION (FVT t) UNION (FVT u)`, FV_TAC[arith_freeform1; FV_FREETERM; FV_FORM; FVT_PAIR; FVT_NUMERAL]);; let arith_freeform,ARITH_FREEFORM = OBJECTIFY_RTCP ARITH_FREEFORM1 "arith_freeform" FREEFORM;; let FV_FREEFORM = prove (`!s t. FV(arith_freeform s t) = (FVT s) UNION (FVT t)`, FV_TAC[arith_freeform; FV_RTCP; FV_FREEFORM1; FVT_PAIR; FVT_NUMERAL]);; let arith_axiom,ARITH_AXIOM = OBJECTIFY [ARITH_FORM; ARITH_FREEFORM; ARITH_FREETERM; ARITH_TERM] "arith_axiom" AXIOM;; let FV_AXIOM = prove (`!t. FV(arith_axiom t) = FVT t`, FV_TAC[arith_axiom; FV_FREETERM; FV_FREEFORM; FV_TERM; FV_FORM; FVT_PAIR; FVT_NUMERAL]);; (* ------------------------------------------------------------------------- *) (* Parametrization by A means it's easier to do these cases manually. *) (* ------------------------------------------------------------------------- *) let arith_prov1,ARITH_PROV1 = let PROV1' = REWRITE_RULE[IN] PROV1 in OBJECTIFY [ASSUME `!v n. holds v (A n) <=> Ax (termval v n)`; ARITH_AXIOM] "arith_prov1" PROV1';; let ARITH_PROV1 = prove (`(!v t. holds v (A t) <=> Ax(termval v t)) ==> (!v s t. holds v (arith_prov1 A s t) <=> PROV1 Ax (termval v s) (termval v t))`, REWRITE_TAC[arith_prov1; holds; HOLDS_FORMSUBST] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[termval; valmod; o_THM; ARITH_EQ; ARITH_PAIR; TERMVAL_NUMERAL; ARITH_AXIOM] THEN REWRITE_TAC[PROV1; IN]);; let FV_PROV1 = prove (`(!t. FV(A t) = FVT t) ==> !s t. FV(arith_prov1 A s t) = FVT(s) UNION FVT(t)`, FV_TAC[arith_prov1; FV_AXIOM; FVT_NUMERAL; FVT_PAIR]);; let arith_prov = new_definition `arith_prov A n = formsubst ((0 |-> n) V) (arith_rtc (arith_prov1 A) (numeral 0) (arith_pair (V 0) (numeral 0)))`;; let ARITH_PROV = prove (`!Ax A. (!v t. holds v (A t) <=> Ax(termval v t)) ==> !v n. holds v (arith_prov A n) <=> PROV Ax (termval v n)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ARITH_PROV1) THEN DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN CONV_TAC(TOP_DEPTH_CONV ETA_CONV) THEN DISCH_TAC THEN ASM_REWRITE_TAC[arith_prov; HOLDS_FORMSUBST] THEN REWRITE_TAC[termval; valmod; o_DEF; TERMVAL_NUMERAL; ARITH_PAIR] THEN REWRITE_TAC[PROV]);; let FV_PROV = prove (`(!t. FV(A t) = FVT t) ==> !t. FV(arith_prov A t) = FVT t`, FV_TAC[arith_prov; FV_PROV1; FV_RTC; FVT_NUMERAL; FVT_PAIR]);; (* ------------------------------------------------------------------------- *) (* Our final conclusion. *) (* ------------------------------------------------------------------------- *) let PROV_DEFINABLE = prove (`!Ax. definable {gform p | p IN Ax} ==> definable {gform p | Ax |-- p}`, GEN_TAC THEN REWRITE_TAC[definable; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `A:form` (X_CHOOSE_TAC `x:num`)) THEN MP_TAC(SPECL [`IMAGE gform Ax`; `\t. formsubst ((x |-> t) V) A`] ARITH_PROV) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[HOLDS_FORMSUBST] THEN REWRITE_TAC[o_THM; VALMOD_BASIC; IMAGE; IN_ELIM_THM]; ALL_TAC] THEN REWRITE_TAC[PROV_THM_STRONG] THEN DISCH_TAC THEN EXISTS_TAC `arith_prov (\t. formsubst ((x |-> t) V) A) (V x)` THEN ASM_REWRITE_TAC[termval] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* The crudest conclusion: truth undefinable, provability not, so: *) (* ------------------------------------------------------------------------- *) let GODEL_CRUDE = prove (`!Ax. definable {gform p | p IN Ax} ==> ?p. ~(true p <=> Ax |-- p)`, REPEAT STRIP_TAC THEN MP_TAC TARSKI_THEOREM THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PROV_DEFINABLE) THEN MATCH_MP_TAC(TAUT `(~c ==> (a <=> b)) ==> a ==> ~b ==> c`) THEN SIMP_TAC[NOT_EXISTS_THM]);; hol-light/Arithmetic/definability.ml000066400000000000000000000674421303454263000200500ustar00rootroot00000000000000(* ========================================================================= *) (* Definability in arithmetic of important notions. *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* Pairing operation. *) (* ------------------------------------------------------------------------- *) let NPAIR = new_definition `NPAIR x y = (x + y) EXP 2 + x + 1`;; let NPAIR_NONZERO = prove (`!x y. ~(NPAIR x y = 0)`, REWRITE_TAC[NPAIR; ADD_EQ_0; ARITH]);; let NPAIR_INJ_LEMMA = prove (`x1 + y1 < x2 + y2 ==> NPAIR x1 y1 < NPAIR x2 y2`, STRIP_TAC THEN REWRITE_TAC[NPAIR; EXP_2] THEN REWRITE_TAC[ARITH_RULE `x + y + 1 < u + v + 1 <=> x + y < u + v`] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `SUC(x1 + y1) * SUC(x1 + y1)` THEN CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[LE_TRANS; LE_ADD; LE_MULT2; LE_SUC_LT]]);; let NPAIR_INJ = prove (`(NPAIR x y = NPAIR x' y') <=> (x = x') /\ (y = y')`, EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `x' + y' = x + y` ASSUME_TAC THENL [ASM_MESON_TAC[LT_CASES; NPAIR_INJ_LEMMA; LT_REFL]; UNDISCH_TAC `NPAIR x y = NPAIR x' y'` THEN UNDISCH_TAC `x' + y' = x + y` THEN SIMP_TAC[NPAIR; EXP_2] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Decreasingness. *) (* ------------------------------------------------------------------------- *) let NPAIR_LT = prove (`!x y. x < NPAIR x y /\ y < NPAIR x y`, REPEAT GEN_TAC THEN REWRITE_TAC[NPAIR] THEN REWRITE_TAC[ARITH_RULE `x < a + x + 1`] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `(x + y) + x + 1` THEN REWRITE_TAC[LE_ADD_RCANCEL; EXP_2; LE_SQUARE_REFL] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Auxiliary concepts needed. NB: these are Delta so can be negated freely. *) (* ------------------------------------------------------------------------- *) let primepow = new_definition `primepow p x <=> prime(p) /\ ?n. x = p EXP n`;; let divides_DELTA = prove (`m divides n <=> ?x. x <= n /\ n = m * x`, REWRITE_TAC[divides] THEN ASM_CASES_TAC `m = 0` THENL [ASM_REWRITE_TAC[MULT_CLAUSES] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(m = 0) ==> 1 <= m`)) THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN MESON_TAC[]);; let prime_DELTA = prove (`prime(p) <=> 2 <= p /\ !n. n < p ==> n divides p ==> n = 1`, ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[ARITH; PRIME_0] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[ARITH; PRIME_1] THEN EQ_TAC THENL [ASM_MESON_TAC[prime; LT_REFL; PRIME_GE_2]; ASM_MESON_TAC[prime; DIVIDES_LE; LE_LT]]);; let primepow_DELTA = prove (`primepow p x <=> prime(p) /\ ~(x = 0) /\ !z. z <= x ==> z divides x ==> z = 1 \/ p divides z`, REWRITE_TAC[primepow; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN ASM_CASES_TAC `prime(p)` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN ASM_REWRITE_TAC[EXP_EQ_0] THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `z:num` o MATCH_MP PRIME_COPRIME) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `p divides z` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP COPRIME_EXP) THEN ASM_MESON_TAC[COPRIME; DIVIDES_REFL]; SPEC_TAC(`x:num`,`x:num`) THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = 1` THENL [EXISTS_TAC `0` THEN ASM_REWRITE_TAC[EXP]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC o MATCH_MP PRIME_FACTOR) THEN STRIP_TAC THEN UNDISCH_TAC `!z. z <= x ==> z divides x /\ ~(z = 1) ==> p divides z` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `q = 1` THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `q <= x` ASSUME_TAC THENL [ASM_MESON_TAC[DIVIDES_LE]; ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `p divides x` MP_TAC THENL [ASM_MESON_TAC[DIVIDES_TRANS]; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_TAC `y:num`) THEN SUBGOAL_THEN `y < x` (ANTE_RES_THEN MP_TAC) THENL [MATCH_MP_TAC PRIME_FACTOR_LT THEN EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `y = 0` THENL [UNDISCH_TAC `x = p * y` THEN ASM_REWRITE_TAC[MULT_CLAUSES]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!z. z <= y ==> z divides y /\ ~(z = 1) ==> p divides z` (fun th -> REWRITE_TAC[th]) THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE [IMP_IMP]) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `y:num` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `y = 1 * y`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_REWRITE_TAC[GSYM NOT_LT] THEN REWRITE_TAC[num_CONV `1`; LT; DE_MORGAN_THM] THEN ASM_MESON_TAC[PRIME_0; PRIME_1]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVIDES_LMUL THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[EXP]]]);; (* ------------------------------------------------------------------------- *) (* Sigma-representability of reflexive transitive closure. *) (* ------------------------------------------------------------------------- *) let PSEQ = new_recursive_definition num_RECURSION `(PSEQ p f m 0 = 0) /\ (PSEQ p f m (SUC n) = f m + p * PSEQ p f (SUC m) n)`;; let PSEQ_SPLIT = prove (`!f p n m r. PSEQ p f m (n + r) = PSEQ p f m n + p EXP n * PSEQ p f (m + n) r`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP; MULT_CLAUSES; PSEQ] THEN ASM_REWRITE_TAC[GSYM ADD_ASSOC; EQ_ADD_LCANCEL] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_AC; ADD_CLAUSES]);; let PSEQ_1 = prove (`PSEQ p f m 1 = f m`, REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; MULT_CLAUSES; PSEQ]);; let PSEQ_BOUND = prove (`!n. ~(p = 0) /\ (!i. i < n ==> f i < p) ==> PSEQ p f 0 n < p EXP n`, ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THEN INDUCT_TAC THENL [REWRITE_TAC[PSEQ; EXP; ARITH]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(SPECL [`f:num->num`; `p:num`; `n:num`; `0`; `1`] PSEQ_SPLIT) THEN SIMP_TAC[ADD1; ADD_CLAUSES] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `p EXP n + p EXP n * PSEQ p f n 1` THEN ASM_SIMP_TAC[LT_ADD_RCANCEL; ARITH_RULE `i < n ==> i < SUC n`] THEN REWRITE_TAC[ARITH_RULE `p + p * q = p * (q + 1)`] THEN ASM_REWRITE_TAC[EXP_ADD; LE_MULT_LCANCEL; EXP_EQ_0] THEN MATCH_MP_TAC(ARITH_RULE `x < p ==> x + 1 <= p`) THEN ASM_SIMP_TAC[EXP_1; PSEQ_1; LT]);; let RELPOW_LEMMA_1 = prove (`(f 0 = x) /\ (f n = y) /\ (!i. i < n ==> R (f i) (f(SUC i))) ==> ?p. (?i. i <= n /\ p <= SUC(FACT(f i))) /\ prime p /\ (?m. m < p EXP (SUC n) /\ x < p /\ y < p /\ (?qx. m = x + p * qx) /\ (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\ !q. q < p EXP n ==> primepow p q ==> ?r. r < q /\ ?a. a < p /\ ?b. b < p /\ R a b /\ ?s. s <= m /\ (m = r + q * (a + p * (b + p * s))))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?j. j <= n /\ !i. i <= n ==> f i <= f j` MP_TAC THENL [SPEC_TAC(`n:num`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THENL [SIMP_TAC[LE] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN DISJ_CASES_TAC(ARITH_RULE `f(SUC n) <= f(j) \/ f(j) <= f(SUC n)`) THENL [EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[ARITH_RULE `j <= n ==> j <= SUC n`] THEN REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; EXISTS_TAC `SUC n` THEN REWRITE_TAC[LE_REFL] THEN REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LE_REFL] THEN ASM_MESON_TAC[LE_TRANS]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `ibig:num` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `(f:num->num) ibig` EUCLID_BOUND) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `p:num` THEN CONJ_TAC THENL [EXISTS_TAC `ibig:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN SUBGOAL_THEN `!i. i <= n ==> f i < p` ASSUME_TAC THENL [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN EXISTS_TAC `PSEQ p f 0 (SUC n)` THEN CONJ_TAC THENL [MATCH_MP_TAC PSEQ_BOUND THEN ASM_SIMP_TAC[LT_SUC_LE]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[LE_0]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[PSEQ] THEN MESON_TAC[]; MP_TAC(SPECL [`f:num->num`; `p:num`; `n:num`; `0`; `1`] PSEQ_SPLIT) THEN ASM_SIMP_TAC[ADD1; ADD_CLAUSES] THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f 0 n` THEN ASM_SIMP_TAC[PSEQ_BOUND; PSEQ_1; LT_IMP_LE]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN ASM_SIMP_TAC[primepow; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[LT_EXP] THEN STRIP_TAC THEN MP_TAC(SPECL [`f:num->num`; `p:num`; `i:num`; `0`; `SUC n - i`] PSEQ_SPLIT) THEN ASM_SIMP_TAC[ARITH_RULE `i < n ==> (i + SUC n - i = SUC n)`] THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f 0 i` THEN REWRITE_TAC[EQ_ADD_LCANCEL] THEN ASM_REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; ADD_CLAUSES] THEN CONJ_TAC THENL [ASM_MESON_TAC[PSEQ_BOUND; LT_TRANS; LT_IMP_LE]; ALL_TAC] THEN MP_TAC(SPECL [`f:num->num`; `p:num`; `1`; `i:num`; `n - i`] PSEQ_SPLIT) THEN ASM_SIMP_TAC[ARITH_RULE `i < n ==> (1 + n - i = SUC n - i)`] THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f i 1` THEN ASM_REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL; EXP_1] THEN ASM_SIMP_TAC[PSEQ_1; LT_IMP_LE] THEN MP_TAC(SPECL [`f:num->num`; `p:num`; `1`; `i + 1`; `n - i - 1`] PSEQ_SPLIT) THEN ASM_SIMP_TAC[ARITH_RULE `i < n ==> (1 + n - i - 1 = n - i)`] THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f (i + 1) 1` THEN ASM_REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL; EXP_1] THEN ASM_SIMP_TAC[PSEQ_1; ARITH_RULE `i < n ==> i + 1 <= n`] THEN ASM_SIMP_TAC[GSYM ADD1] THEN REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC; ADD_ASSOC] THEN MATCH_MP_TAC(ARITH_RULE `1 * a <= c ==> a <= b + c`) THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; EXP_EQ_0]);; let RELPOW_LEMMA_2 = prove (`prime p /\ x < p /\ y < p /\ (?qx. m = x + p * qx) /\ (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\ (!q. q < p EXP n ==> primepow p q ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\ r < q /\ a < p /\ b < p /\ R a b) ==> RELPOW n R x y`, STRIP_TAC THEN REWRITE_TAC[RELPOW_SEQUENCE] THEN EXISTS_TAC `\i. (m DIV (p EXP i)) MOD p` THEN SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN REWRITE_TAC[EXP; DIV_1] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `qx:num` THEN ASM_REWRITE_TAC[ADD_AC; MULT_AC]; MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[ASSUME `y < p`; MULT_CLAUSES; ADD_CLAUSES] THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `ry:num` THEN REWRITE_TAC[ASSUME `m = ry + p EXP n * y`] THEN ASM_REWRITE_TAC[ADD_AC; MULT_AC]; ALL_TAC] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p EXP i`) THEN ASM_SIMP_TAC[LT_EXP; PRIME_GE_2] THEN ASM_REWRITE_TAC[primepow] THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(R:num->num->bool) a b` THEN MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN BINOP_TAC THENL [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `b + p * s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ADD_AC; MULT_AC]; MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `s:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `r + a * p EXP i` THEN CONJ_TAC THENL [REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[ADD_AC; MULT_AC]; ALL_TAC] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `p EXP i + a * p EXP i` THEN ASM_REWRITE_TAC[LT_ADD_RCANCEL] THEN REWRITE_TAC[ARITH_RULE `p + q * p = (q + 1) * p`] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL; EXP_EQ_0] THEN UNDISCH_TAC `a < p` THEN ARITH_TAC]);; let RELPOW_LEMMA = prove (`RELPOW n R x y <=> ?m p. prime p /\ x < p /\ y < p /\ (?qx. m = x + p * qx) /\ (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\ !q. q < p EXP n ==> primepow p q ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\ r < q /\ a < p /\ b < p /\ R a b`, EQ_TAC THENL [ALL_TAC; REWRITE_TAC[RELPOW_LEMMA_2; LEFT_IMP_EXISTS_THM]] THEN REWRITE_TAC[RELPOW_SEQUENCE] THEN DISCH_THEN(CHOOSE_THEN(MP_TAC o GEN_ALL o MATCH_MP RELPOW_LEMMA_1)) THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN MESON_TAC[]);; let RTC_SIGMA = prove (`RTC R x y <=> ?m p Q. primepow p Q /\ x < p /\ y < p /\ (?s. m = x + p * s) /\ (?r. r < Q /\ (m = r + Q * y)) /\ !q. q < Q ==> primepow p q ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\ r < q /\ a < p /\ b < p /\ R a b`, REWRITE_TAC[RTC_RELPOW] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN REWRITE_TAC[RELPOW_LEMMA] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `p EXP n` THEN ASM_REWRITE_TAC[primepow] THEN MESON_TAC[]; REWRITE_TAC[primepow] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[GSYM primepow] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 3 BINDER_CONV) [LEFT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM RELPOW_LEMMA]]);; (* ------------------------------------------------------------------------- *) (* Partially automate actual definability in object language. *) (* ------------------------------------------------------------------------- *) let arith_pair = new_definition `arith_pair s t = (s ++ t) ** (s ++ t) ++ s ++ Suc Z`;; let ARITH_PAIR = prove (`!s t v. termval v (arith_pair s t) = NPAIR (termval v s) (termval v t)`, REWRITE_TAC[termval; arith_pair; NPAIR; EXP_2; ARITH_SUC]);; let FVT_PAIR = prove (`FVT(arith_pair s t) = FVT(s) UNION FVT(t)`, REWRITE_TAC[arith_pair; FVT] THEN SET_TAC[]);; let OBJECTIFY = let is_add = is_binop `(+):num->num->num` and is_mul = is_binop `(*):num->num->num` and is_le = is_binop `(<=):num->num->bool` and is_lt = is_binop `(<):num->num->bool` and zero_tm = `0` and suc_tm = `SUC` and osuc_tm = `Suc` and oz_tm = `Z` and ov_tm = `V` and oadd_tm = `(++)` and omul_tm = `(**)` and oeq_tm = `(===)` and ole_tm = `(<<=)` and olt_tm = `(<<)` and oiff_tm = `(<->)` and oimp_tm = `(-->)` and oand_tm = `(&&)` and oor_tm = `(||)` and onot_tm = `Not` and oall_tm = `!!` and oex_tm = `??` and numeral_tm = `numeral` and assign_tm = `(|->):num->term->(num->term)->(num->term)` and term_ty = `:term` and form_ty = `:form` and num_ty = `:num` and formsubst_tm = `formsubst` and holdsv_tm = `holds v` and v_tm = `v:num->num` in let objectify1 fn op env tm = mk_comb(op,fn env (rand tm)) in let objectify2 fn op env tm = mk_comb(mk_comb(op,fn env (lhand tm)),fn env (rand tm)) in fun defs -> let defs' = [TERMVAL_NUMERAL; ARITH_PAIR] @ defs in let rec objectify_term env tm = if is_var tm then mk_comb(ov_tm,apply env tm) else if tm = zero_tm then oz_tm else if is_numeral tm then mk_comb(numeral_tm,tm) else if is_add tm then objectify2 objectify_term oadd_tm env tm else if is_mul tm then objectify2 objectify_term omul_tm env tm else if is_comb tm && rator tm = suc_tm then objectify1 objectify_term osuc_tm env tm else let f,args = strip_comb tm in let args' = map (objectify_term env) args in try let dth = find (fun th -> fst(strip_comb(rand(snd(strip_forall(concl th))))) = f) defs' in let l,r = dest_eq(snd(strip_forall(concl dth))) in list_mk_comb(fst(strip_comb(rand l)),args') with Failure _ -> let ty = itlist (mk_fun_ty o type_of) args' form_ty in let v = mk_var(fst(dest_var f),ty) in list_mk_comb(v,args') in let rec objectify_formula env fm = if is_forall fm then let x,bod = dest_forall fm in let n = mk_small_numeral (itlist (max o dest_small_numeral) (ran env) 0 + 1) in mk_comb(mk_comb(oall_tm,n),objectify_formula ((x |-> n) env) bod) else if is_exists fm then let x,bod = dest_exists fm in let n = mk_small_numeral (itlist (max o dest_small_numeral) (ran env) 0 + 1) in mk_comb(mk_comb(oex_tm,n),objectify_formula ((x |-> n) env) bod) else if is_iff fm then objectify2 objectify_formula oiff_tm env fm else if is_imp fm then objectify2 objectify_formula oimp_tm env fm else if is_conj fm then objectify2 objectify_formula oand_tm env fm else if is_disj fm then objectify2 objectify_formula oor_tm env fm else if is_neg fm then objectify1 objectify_formula onot_tm env fm else if is_le fm then objectify2 objectify_term ole_tm env fm else if is_lt fm then objectify2 objectify_term olt_tm env fm else if is_eq fm then objectify2 objectify_term oeq_tm env fm else objectify_term env fm in fun nam th -> let ptm,tm = dest_eq(snd(strip_forall(concl th))) in let vs = filter (fun v -> type_of v = num_ty) (snd(strip_comb ptm)) in let ns = 1--(length vs) in let env = itlist2 (fun v n -> v |-> mk_small_numeral n) vs ns undefined in let otm = objectify_formula env tm in let vs' = map (fun v -> mk_var(fst(dest_var v),term_ty)) vs in let stm = itlist2 (fun v n a -> mk_comb(mk_comb(mk_comb(assign_tm,mk_small_numeral n),v),a)) vs' ns ov_tm in let rside = mk_comb(mk_comb(formsubst_tm,stm),otm) in let vs'' = subtract (frees rside) vs' @ vs' in let lty = itlist (mk_fun_ty o type_of) vs'' (type_of rside) in let lside = list_mk_comb(mk_var(nam,lty),vs'') in let def = mk_eq(lside,rside) in let dth = new_definition def in let clside = lhs(snd(strip_forall(concl dth))) in let etm = mk_comb(holdsv_tm,clside) in let thm = (REWRITE_CONV ([dth; holds; HOLDS_FORMSUBST] @ defs') THENC REWRITE_CONV [termval; ARITH_EQ; o_THM; valmod] THENC GEN_REWRITE_CONV I [GSYM th]) etm in dth,DISCH_ALL (GENL (v_tm::vs') thm);; (* ------------------------------------------------------------------------- *) (* Some sort of common tactic for free variables. *) (* ------------------------------------------------------------------------- *) let FV_TAC ths = let ths' = ths @ [FV; FORMSUBST_FV; FVT; TERMSUBST_FVT; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNION; IN_DELETE; IN_SING] and tac = REWRITE_TAC[DISJ_ACI; TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC; UNWIND_THM2; ARITH_EQ] THEN REWRITE_TAC[valmod; ARITH_EQ; FVT] THEN REWRITE_TAC[DISJ_ACI] in REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN ASM_REWRITE_TAC ths' THEN tac THEN ASM_SIMP_TAC ths' THEN tac;; (* ------------------------------------------------------------------------- *) (* So do the formula-level stuff (more) automatically. *) (* ------------------------------------------------------------------------- *) let arith_divides,ARITH_DIVIDES = OBJECTIFY [] "arith_divides" divides_DELTA;; let FV_DIVIDES = prove (`!s t. FV(arith_divides s t) = FVT(s) UNION FVT(t)`, FV_TAC[arith_divides]);; let arith_prime,ARITH_PRIME = OBJECTIFY [ARITH_DIVIDES] "arith_prime" prime_DELTA;; let FV_PRIME = prove (`!t. FV(arith_prime t) = FVT(t)`, FV_TAC[arith_prime; FVT_NUMERAL; FV_DIVIDES]);; let arith_primepow,ARITH_PRIMEPOW = OBJECTIFY [ARITH_PRIME; ARITH_DIVIDES] "arith_primepow" primepow_DELTA;; let FV_PRIMEPOW = prove (`!s t. FV(arith_primepow s t) = FVT(s) UNION FVT(t)`, FV_TAC[arith_primepow; FVT_NUMERAL; FV_DIVIDES; FV_PRIME]);; let arith_rtc,ARITH_RTC = OBJECTIFY [ARITH_PRIMEPOW; ASSUME `!v s t. holds v (R s t) <=> r (termval v s) (termval v t)`] "arith_rtc" RTC_SIGMA;; let FV_RTC = prove (`!R. (!s t. FV(R s t) = FVT(s) UNION FVT(t)) ==> !s t. FV(arith_rtc R s t) = FVT(s) UNION FVT(t)`, FV_TAC[arith_rtc; FV_PRIMEPOW]);; (* ------------------------------------------------------------------------- *) (* Automate RTC constructions, including parametrized ones. *) (* ------------------------------------------------------------------------- *) let OBJECTIFY_RTC = let pth = prove (`(!v x y. holds v (f x y) <=> f' (termval v x) (termval v y)) ==> !g. (!n. g n = formsubst ((0 |-> n) V) (arith_rtc f (numeral 0) (arith_pair (V 0) (numeral 0)))) ==> !v n. holds v (g n) <=> RTC f' 0 (NPAIR (termval v n) 0)`, DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN SIMP_TAC[HOLDS_FORMSUBST] THEN REWRITE_TAC[termval; o_DEF; ARITH_EQ; valmod; ARITH_PAIR; TERMVAL_NUMERAL]) in fun def nam th -> let th1 = MATCH_MP pth def in let v = fst(dest_forall(concl th1)) in let th2 = SPEC (mk_var(nam,type_of v)) th1 in let dth = new_definition (fst(dest_imp(concl th2))) in dth,ONCE_REWRITE_RULE[GSYM th] (MATCH_MP th2 dth);; let RTCP = new_definition `RTCP R m x y <=> RTC (R m) x y`;; let RTCP_SIGMA = REWRITE_RULE[GSYM RTCP] (INST [`(R:num->num->num->bool) m`,`R:num->num->bool`] RTC_SIGMA);; let arith_rtcp,ARITH_RTCP = OBJECTIFY [ARITH_PRIMEPOW; ASSUME `!v m s t. holds v (R m s t) <=> r (termval v m) (termval v s) (termval v t)`] "arith_rtcp" RTCP_SIGMA;; let ARITH_RTC_PARAMETRIZED = REWRITE_RULE[RTCP] ARITH_RTCP;; let FV_RTCP = prove (`!R. (!s t u. FV(R s t u) = FVT(s) UNION FVT(t) UNION FVT(u)) ==> !s t u. FV(arith_rtcp R s t u) = FVT(s) UNION FVT(t) UNION FVT(u)`, FV_TAC[arith_rtcp; FV_PRIMEPOW]);; let OBJECTIFY_RTCP = let pth = prove (`(!v m x y. holds v (f m x y) <=> f' (termval v m) (termval v x) (termval v y)) ==> !g. (!m n. g m n = formsubst ((1 |-> m) ((0 |-> n) V)) (arith_rtcp f (V 1) (numeral 0) (arith_pair (V 0) (numeral 0)))) ==> !v m n. holds v (g m n) <=> RTC (f' (termval v m)) 0 (NPAIR (termval v n) 0)`, DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC_PARAMETRIZED) THEN SIMP_TAC[HOLDS_FORMSUBST] THEN REWRITE_TAC[termval; o_DEF; ARITH_EQ; valmod; ARITH_PAIR; TERMVAL_NUMERAL]) in fun def nam th -> let th1 = MATCH_MP pth def in let v = fst(dest_forall(concl th1)) in let th2 = SPEC (mk_var(nam,type_of v)) th1 in let dth = new_definition (fst(dest_imp(concl th2))) in dth,ONCE_REWRITE_RULE[GSYM th] (MATCH_MP th2 dth);; (* ------------------------------------------------------------------------- *) (* Generic result about primitive recursion. *) (* ------------------------------------------------------------------------- *) let PRIMREC_SIGMA = prove (`(fn 0 = e) /\ (!n. fn (SUC n) = f (fn n) n) ==> !x y. RTC (\x y. ?n r. (x = NPAIR n r) /\ (y = NPAIR (SUC n) (f r n))) (NPAIR 0 e) (NPAIR x y) <=> (fn(x) = y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[RTC_CASES_L] THEN ASM_REWRITE_TAC[NPAIR_INJ; NOT_SUC] THEN REWRITE_TAC[SUC_INJ; RIGHT_AND_EXISTS_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN ASM_MESON_TAC[]);; let arith_primrecstep = new_definition `arith_primrecstep R s t = (formsubst ((0 |-> s) ((1 |-> t) V)) (?? 2 (?? 3 (?? 4 (V 0 === arith_pair (V 2) (V 3) && V 1 === arith_pair (Suc(V 2)) (V 4) && R (V 3) (V 2) (V 4))))))`;; let ARITH_PRIMRECSTEP = prove (`(!v x y z. holds v (R x y z) <=> (f (termval v x) (termval v y) = termval v z)) ==> !v s t. holds v (arith_primrecstep R s t) <=> ?n r. (termval v s = NPAIR n r) /\ (termval v t = NPAIR (SUC n) (f r n))`, STRIP_TAC THEN ASM_REWRITE_TAC[arith_primrecstep; holds; HOLDS_FORMSUBST] THEN ASM_REWRITE_TAC[termval; valmod; o_DEF; ARITH_EQ; ARITH_PAIR] THEN MESON_TAC[]);; let FV_PRIMRECSTEP = prove (`!R. (!s t u. FV(R s t u) SUBSET (FVT(s) UNION FVT(t) UNION FVT(u))) ==> !s t. FV(arith_primrecstep R s t) = FVT(s) UNION FVT(t)`, REWRITE_TAC[SUBSET; IN_UNION] THEN FV_TAC[arith_primrecstep; FVT_PAIR] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `~a ==> (a \/ b <=> b)`) THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2(ANTE_RES_THEN MP_TAC) ASSUME_TAC)) THEN ASM_REWRITE_TAC[FVT; IN_SING]);; let arith_primrec = new_definition `arith_primrec R c s t = arith_rtc (arith_primrecstep R) (arith_pair Z c) (arith_pair s t)`;; let ARITH_PRIMREC = prove (`!fn e f R c. (fn 0 = e) /\ (!n. fn (SUC n) = f (fn n) n) /\ (!v. termval v c = e) /\ (!v x y z. holds v (R x y z) <=> (f (termval v x) (termval v y) = termval v z)) ==> !v s t. holds v (arith_primrec R c s t) <=> (fn(termval v s) = termval v t)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ARITH_PRIMRECSTEP) THEN DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN CONV_TAC(TOP_DEPTH_CONV ETA_CONV) THEN SIMP_TAC[arith_primrec; ARITH_PAIR; termval] THEN ASM_SIMP_TAC[PRIMREC_SIGMA]);; let FV_PRIMREC = prove (`!R c. (FVT c = {}) /\ (!s t u. FV(R s t u) SUBSET (FVT(s) UNION FVT(t) UNION FVT(u))) ==> !s t. FV(arith_primrec R c s t) = FVT(s) UNION FVT(t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[arith_primrec] THEN ASM_SIMP_TAC[FV_RTC; FVT_PAIR; FV_PRIMRECSTEP; UNION_EMPTY; UNION_ACI; FVT]);; hol-light/Arithmetic/derived.ml000066400000000000000000001165541303454263000170260ustar00rootroot00000000000000(* ========================================================================= *) (* Derived properties of provability. *) (* ========================================================================= *) let negativef = new_definition `negativef p = ?q. p = q --> False`;; let negatef = new_definition `negatef p = if negativef p then @q. p = q --> False else p --> False`;; (* ------------------------------------------------------------------------- *) (* The primitive basis, separated into its named components. *) (* ------------------------------------------------------------------------- *) let axiom_addimp = prove (`!A p q. A |-- p --> (q --> p)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_distribimp = prove (`!A p q r. A |-- (p --> q --> r) --> (p --> q) --> (p --> r)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_doubleneg = prove (`!A p. A |-- ((p --> False) --> False) --> p`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_allimp = prove (`!A x p q. A |-- (!!x (p --> q)) --> (!!x p) --> (!!x q)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_impall = prove (`!A x p. ~(x IN FV p) ==> A |-- p --> !!x p`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_existseq = prove (`!A x t. ~(x IN FVT t) ==> A |-- ??x (V x === t)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_eqrefl = prove (`!A t. A |-- t === t`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_funcong = prove (`(!A s t. A |-- s === t --> Suc s === Suc t) /\ (!A s t u v. A |-- s === t --> u === v --> s ++ u === t ++ v) /\ (!A s t u v. A |-- s === t --> u === v --> s ** u === t ** v)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_predcong = prove (`(!A s t u v. A |-- s === t --> u === v --> s === u --> t === v) /\ (!A s t u v. A |-- s === t --> u === v --> s << u --> t << v) /\ (!A s t u v. A |-- s === t --> u === v --> s <<= u --> t <<= v)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_iffimp1 = prove (`!A p q. A |-- (p <-> q) --> p --> q`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_iffimp2 = prove (`!A p q. A |-- (p <-> q) --> q --> p`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_impiff = prove (`!A p q. A |-- (p --> q) --> (q --> p) --> (p <-> q)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_true = prove (`A |-- True <-> (False --> False)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_not = prove (`!A p. A |-- Not p <-> (p --> False)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_and = prove (`!A p q. A |-- (p && q) <-> (p --> q --> False) --> False`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_or = prove (`!A p q. A |-- (p || q) <-> Not(Not p && Not q)`, MESON_TAC[proves_RULES; axiom_RULES]);; let axiom_exists = prove (`!A x p. A |-- (??x p) <-> Not(!!x (Not p))`, MESON_TAC[proves_RULES; axiom_RULES]);; let assume = prove (`!A p. p IN A ==> A |-- p`, MESON_TAC[proves_RULES]);; let modusponens = prove (`!A p. A |-- (p --> q) /\ A |-- p ==> A |-- q`, MESON_TAC[proves_RULES]);; let gen = prove (`!A p x. A |-- p ==> A |-- !!x p`, MESON_TAC[proves_RULES]);; (* ------------------------------------------------------------------------- *) (* Some purely propositional schemas and derived rules. *) (* ------------------------------------------------------------------------- *) let iff_imp1 = prove (`!A p q. A |-- p <-> q ==> A |-- p --> q`, MESON_TAC[modusponens; axiom_iffimp1]);; let iff_imp2 = prove (`!A p q. A |-- p <-> q ==> A |-- q --> p`, MESON_TAC[modusponens; axiom_iffimp2]);; let imp_antisym = prove (`!A p q. A |-- p --> q /\ A |-- q --> p ==> A |-- p <-> q`, MESON_TAC[modusponens; axiom_impiff]);; let add_assum = prove (`!A p q. A |-- q ==> A |-- p --> q`, MESON_TAC[modusponens; axiom_addimp]);; let imp_refl = prove (`!A p. A |-- p --> p`, MESON_TAC[modusponens; axiom_distribimp; axiom_addimp]);; let imp_add_assum = prove (`!A p q r. A |-- q --> r ==> A |-- (p --> q) --> (p --> r)`, MESON_TAC[modusponens; axiom_distribimp; add_assum]);; let imp_unduplicate = prove (`!A p q. A |-- p --> p --> q ==> A |-- p --> q`, MESON_TAC[modusponens; axiom_distribimp; imp_refl]);; let imp_trans = prove (`!A p q. A |-- p --> q /\ A |-- q --> r ==> A |-- p --> r`, MESON_TAC[modusponens; imp_add_assum]);; let imp_swap = prove (`!A p q r. A |-- p --> q --> r ==> A |-- q --> p --> r`, MESON_TAC[imp_trans; axiom_addimp; modusponens; axiom_distribimp]);; let imp_trans_chain_2 = prove (`!A p q1 q2 r. A |-- p --> q1 /\ A |-- p --> q2 /\ A |-- q1 --> q2 --> r ==> A |-- p --> r`, ASM_MESON_TAC[imp_trans; imp_swap; imp_unduplicate]);; let imp_trans_th = prove (`!A p q r. A |-- (q --> r) --> (p --> q) --> (p --> r)`, MESON_TAC[imp_trans; axiom_addimp; axiom_distribimp]);; let imp_add_concl = prove (`!A p q r. A |-- p --> q ==> A |-- (q --> r) --> (p --> r)`, MESON_TAC[modusponens; imp_swap; imp_trans_th]);; let imp_trans2 = prove (`!A p q r s. A |-- p --> q --> r /\ A |-- r --> s ==> A |-- p --> q --> s`, MESON_TAC[imp_add_assum; modusponens; imp_trans_th]);; let imp_swap_th = prove (`!A p q r. A |-- (p --> q --> r) --> (q --> p --> r)`, MESON_TAC[imp_trans; axiom_distribimp; imp_add_concl; axiom_addimp]);; let contrapos = prove (`!A p q. A |-- p --> q ==> A |-- Not q --> Not p`, MESON_TAC[imp_trans; iff_imp1; axiom_not; imp_add_concl; iff_imp2]);; let imp_truefalse = prove (`!p q. A |-- (q --> False) --> p --> (p --> q) --> False`, MESON_TAC[imp_trans; imp_trans_th; imp_swap_th]);; let imp_insert = prove (`!A p q r. A |-- p --> r ==> A |-- p --> q --> r`, MESON_TAC[imp_trans; axiom_addimp]);; let imp_mono_th = prove (`A |-- (p' --> p) --> (q --> q') --> (p --> q) --> (p' --> q')`, MESON_TAC[imp_trans; imp_swap; imp_trans_th]);; let ex_falso = prove (`!A p. A |-- False --> p`, MESON_TAC[imp_trans; axiom_addimp; axiom_doubleneg]);; let imp_contr = prove (`!A p q. A |-- (p --> False) --> (p --> r)`, MESON_TAC[imp_add_assum; ex_falso]);; let imp_contrf = prove (`!A p r. A |-- p --> negatef p --> r`, REPEAT GEN_TAC THEN REWRITE_TAC[negatef; negativef] THEN COND_CASES_TAC THEN POP_ASSUM STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[form_INJ] THEN ASM_MESON_TAC[imp_contr; imp_swap]);; let contrad = prove (`!A p. A |-- (p --> False) --> p ==> A |-- p`, MESON_TAC[modusponens; axiom_distribimp; imp_refl; axiom_doubleneg]);; let bool_cases = prove (`!p q. A |-- p --> q /\ A |-- (p --> False) --> q ==> A |-- q`, MESON_TAC[contrad; imp_trans; imp_add_concl]);; let imp_false_rule = prove (`!p q r. A |-- (q --> False) --> p --> r ==> A |-- ((p --> q) --> False) --> r`, MESON_TAC[imp_add_concl; imp_add_assum; ex_falso; axiom_addimp; imp_swap; imp_trans; axiom_doubleneg; imp_unduplicate]);; let imp_true_rule = prove (`!A p q r. A |-- (p --> False) --> r /\ A |-- q --> r ==> A |-- (p --> q) --> r`, MESON_TAC[imp_insert; imp_swap; modusponens; imp_trans_th; bool_cases]);; let truth = prove (`!A. A |-- True`, MESON_TAC[modusponens; axiom_true; imp_refl; iff_imp2]);; let and_left = prove (`!A p q. A |-- p && q --> p`, MESON_TAC[imp_add_assum; axiom_addimp; imp_trans; imp_add_concl; axiom_doubleneg; imp_trans; iff_imp1; axiom_and]);; let and_right = prove (`!A p q. A |-- p && q --> q`, MESON_TAC[axiom_addimp; imp_trans; imp_add_concl; axiom_doubleneg; iff_imp1; axiom_and]);; let and_pair = prove (`!A p q. A |-- p --> q --> p && q`, MESON_TAC[iff_imp2; axiom_and; imp_swap_th; imp_add_assum; imp_trans2; modusponens; imp_swap; imp_refl]);; let META_AND = prove (`!A p q. A |-- p && q <=> A |-- p /\ A |-- q`, MESON_TAC[and_left; and_right; and_pair; modusponens]);; let shunt = prove (`!A p q r. A |-- p && q --> r ==> A |-- p --> q --> r`, MESON_TAC[modusponens; imp_add_assum; and_pair]);; let ante_conj = prove (`!A p q r. A |-- p --> q --> r ==> A |-- p && q --> r`, MESON_TAC[imp_trans_chain_2; and_left; and_right]);; let not_not_false = prove (`!A p. A |-- (p --> False) --> False <-> p`, MESON_TAC[imp_antisym; axiom_doubleneg; imp_swap; imp_refl]);; let iff_sym = prove (`!A p q. A |-- p <-> q <=> A |-- q <-> p`, MESON_TAC[iff_imp1; iff_imp2; imp_antisym]);; let iff_trans = prove (`!A p q r. A |-- p <-> q /\ A |-- q <-> r ==> A |-- p <-> r`, MESON_TAC[iff_imp1; iff_imp2; imp_trans; imp_antisym]);; let not_not = prove (`!A p. A |-- Not(Not p) <-> p`, MESON_TAC[iff_trans; not_not_false; axiom_not; imp_antisym; imp_add_concl; iff_imp1; iff_imp2]);; let contrapos_eq = prove (`!A p q. A |-- Not p --> Not q <=> A |-- q --> p`, MESON_TAC[contrapos; not_not; iff_imp1; iff_imp2; imp_trans]);; let or_left = prove (`!A p q. A |-- q --> p || q`, MESON_TAC[imp_trans; not_not; iff_imp2; and_right; contrapos; axiom_or]);; let or_right = prove (`!A p q. A |-- p --> p || q`, MESON_TAC[imp_trans; not_not; iff_imp2; and_left; contrapos; axiom_or]);; let ante_disj = prove (`!A p q r. A |-- p --> r /\ A |-- q --> r ==> A |-- p || q --> r`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM contrapos_eq] THEN MESON_TAC[imp_trans; imp_trans_chain_2; and_pair; contrapos_eq; not_not; axiom_or; iff_imp1; iff_imp2; imp_trans]);; let iff_def = prove (`!A p q. A |-- (p <-> q) <-> (p --> q) && (q --> p)`, MESON_TAC[imp_antisym; imp_trans_chain_2; axiom_iffimp1; axiom_iffimp2; and_pair; axiom_impiff; imp_trans_chain_2; and_left; and_right]);; let iff_refl = prove (`!A p. A |-- p <-> p`, MESON_TAC[imp_antisym; imp_refl]);; (* ------------------------------------------------------------------------- *) (* Equality rules. *) (* ------------------------------------------------------------------------- *) let eq_sym = prove (`!A s t. A |-- s === t --> t === s`, MESON_TAC[axiom_eqrefl; modusponens; imp_swap; axiom_predcong]);; let icongruence_general = prove (`!A p x s t tm. A |-- s === t --> termsubst ((x |-> s) v) tm === termsubst ((x |-> t) v) tm`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[termsubst] THEN REPEAT CONJ_TAC THENL [MESON_TAC[axiom_eqrefl; add_assum]; GEN_TAC THEN REWRITE_TAC[valmod] THEN COND_CASES_TAC THEN REWRITE_TAC[imp_refl] THEN MESON_TAC[axiom_eqrefl; add_assum]; MESON_TAC[imp_trans; axiom_funcong]; MESON_TAC[imp_trans; axiom_funcong; imp_swap; imp_unduplicate]; MESON_TAC[imp_trans; axiom_funcong; imp_swap; imp_unduplicate]]);; let icongruence = prove (`!A x s t tm. A |-- s === t --> termsubst (x |=> s) tm === termsubst (x |=> t) tm`, REWRITE_TAC[assign; icongruence_general]);; let icongruence_var = prove (`!A x t tm. A |-- V x === t --> tm === termsubst (x |=> t) tm`, MESON_TAC[icongruence; TERMSUBST_TRIV; ASSIGN_TRIV]);; (* ------------------------------------------------------------------------- *) (* First-order rules. *) (* ------------------------------------------------------------------------- *) let gen_right = prove (`!A x p q. ~(x IN FV(p)) /\ A |-- p --> q ==> A |-- p --> !!x q`, MESON_TAC[axiom_allimp; modusponens; gen; imp_trans; axiom_impall]);; let genimp = prove (`!x p q. A |-- p --> q ==> A |-- (!!x p) --> (!!x q)`, MESON_TAC[modusponens; axiom_allimp; gen]);; let eximp = prove (`!x p q. A |-- p --> q ==> A |-- (??x p) --> (??x q)`, MESON_TAC[contrapos; genimp; contrapos; imp_trans; iff_imp1; iff_imp2; axiom_exists]);; let exists_imp = prove (`!A x p q. A |-- ??x (p --> q) /\ ~(x IN FV(q)) ==> A |-- (!!x p) --> q`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `A |-- (q --> False) --> !!x (p --> Not(p --> q))` ASSUME_TAC THENL [MATCH_MP_TAC gen_right THEN ASM_REWRITE_TAC[FV; IN_UNION; NOT_IN_EMPTY] THEN ASM_MESON_TAC[iff_imp2; axiom_not; imp_trans2; imp_truefalse]; ALL_TAC] THEN SUBGOAL_THEN `A |-- (q --> False) --> !!x p --> !!x (Not(p --> q))` ASSUME_TAC THENL [ASM_MESON_TAC[imp_trans; axiom_allimp]; ALL_TAC] THEN SUBGOAL_THEN `A |-- ((q --> False) --> !!x (Not(p --> q))) --> (q --> False) --> False` ASSUME_TAC THENL [ASM_MESON_TAC[modusponens; iff_imp1; axiom_exists; axiom_not; imp_trans_th]; ALL_TAC] THEN ASM_MESON_TAC[imp_trans; imp_swap; axiom_doubleneg]);; let subspec = prove (`!A x t p q. ~(x IN FVT(t)) /\ ~(x IN FV(q)) /\ A |-- V x === t --> p --> q ==> A |-- (!!x p) --> q`, MESON_TAC[exists_imp; modusponens; eximp; axiom_existseq]);; let subalpha = prove (`!A x y p q. ((x = y) \/ ~(x IN FV(q)) /\ ~(y IN FV(p))) /\ A |-- V x === V y --> p --> q ==> A |-- (!!x p) --> (!!y q)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = y:num` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[genimp; modusponens; axiom_eqrefl]; ALL_TAC] THEN MATCH_MP_TAC gen_right THEN ASM_REWRITE_TAC[FV; IN_DELETE] THEN MATCH_MP_TAC subspec THEN EXISTS_TAC `V y` THEN ASM_REWRITE_TAC[FVT; IN_SING]);; (* ------------------------------------------------------------------------- *) (* We'll perform induction on this measure. *) (* ------------------------------------------------------------------------- *) let complexity = new_recursive_definition form_RECURSION `(complexity False = 1) /\ (complexity True = 1) /\ (!s t. complexity (s === t) = 1) /\ (!s t. complexity (s << t) = 1) /\ (!s t. complexity (s <<= t) = 1) /\ (!p. complexity (Not p) = complexity p + 3) /\ (!p q. complexity (p && q) = complexity p + complexity q + 6) /\ (!p q. complexity (p || q) = complexity p + complexity q + 16) /\ (!p q. complexity (p --> q) = complexity p + complexity q + 1) /\ (!p q. complexity (p <-> q) = 2 * (complexity p + complexity q) + 9) /\ (!x p. complexity (!!x p) = complexity p + 1) /\ (!x p. complexity (??x p) = complexity p + 8)`;; let COMPLEXITY_FORMSUBST = prove (`!p i. complexity(formsubst i p) = complexity p`, MATCH_MP_TAC form_INDUCT THEN SIMP_TAC[formsubst; complexity; LET_DEF; LET_END_DEF]);; let isubst_general = prove (`!A p x v s t. A |-- s === t --> formsubst ((x |-> s) v) p --> formsubst ((x |-> t) v) p`, GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `complexity p` THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`p:form`,`p:form`) THEN MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[formsubst; complexity] THEN REPEAT CONJ_TAC THENL [MESON_TAC[imp_refl; add_assum]; MESON_TAC[imp_refl; add_assum]; MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general]; MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general]; MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general]; X_GEN_TAC `p:form` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o SPEC `p --> False`) THEN REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[formsubst] THEN MESON_TAC[axiom_not; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(p --> q --> False) --> False`) THEN REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[formsubst] THEN MESON_TAC[axiom_and; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o SPEC `Not(Not p && Not q)`) THEN REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[formsubst] THEN MESON_TAC[axiom_or; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `p:form` th) THEN MP_TAC(SPEC `q:form` th)) THEN REWRITE_TAC[ARITH_RULE `p < p + q + 1 /\ q < p + q + 1`] THEN MESON_TAC[imp_mono_th; eq_sym; imp_trans; imp_trans_chain_2]; MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(p --> q) && (q --> p)`) THEN REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[formsubst] THEN MESON_TAC[iff_def; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; ALL_TAC; MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o SPEC `Not(!!x (Not p))`) THEN REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[formsubst] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[FV] THEN REPEAT LET_TAC THEN ASM_MESON_TAC[axiom_exists; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]] THEN MAP_EVERY X_GEN_TAC [`u:num`; `p:form`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `a < b + 1 <=> a <= b`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`v:num`; `i:num->term`; `s:term`; `t:term`] THEN MAP_EVERY ABBREV_TAC [`x = if ?y. y IN FV (!! u p) /\ u IN FVT ((v |-> s) i y) then VARIANT (FV (formsubst ((u |-> V u) ((v |-> s) i)) p)) else u`; `y = if ?y. y IN FV (!! u p) /\ u IN FVT ((v |-> t) i y) then VARIANT (FV (formsubst ((u |-> V u) ((v |-> t) i)) p)) else u`] THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN SUBGOAL_THEN `~(x IN FV(formsubst ((v |-> s) i) (!!u p))) /\ ~(y IN FV(formsubst ((v |-> t) i) (!!u p)))` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["x"; "y"] THEN CONJ_TAC THEN (COND_CASES_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM]] THEN MATCH_MP_TAC NOT_IN_VARIANT THEN REWRITE_TAC[FV_FINITE] THEN REWRITE_TAC[SUBSET; FORMSUBST_FV; IN_ELIM_THM; FV; IN_DELETE] THEN REWRITE_TAC[valmod] THEN MESON_TAC[FVT; IN_SING]); ALL_TAC] THEN ASM_CASES_TAC `v:num = u` THENL [ASM_REWRITE_TAC[VALMOD_VALMOD_BASIC] THEN MATCH_MP_TAC add_assum THEN MATCH_MP_TAC subalpha THEN ASM_SIMP_TAC[LE_REFL] THEN ASM_CASES_TAC `y:num = x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [UNDISCH_TAC `~(x IN FV (formsubst ((v |-> s) i) (!! u p)))`; UNDISCH_TAC `~(y IN FV (formsubst ((v |-> t) i) (!! u p)))`] THEN ASM_REWRITE_TAC[FORMSUBST_FV; FV; IN_ELIM_THM; IN_DELETE] THEN MATCH_MP_TAC MONO_NOT THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:num` THEN ASM_CASES_TAC `w:num = u` THEN ASM_REWRITE_TAC[VALMOD_BASIC; FVT; IN_SING] THEN ASM_REWRITE_TAC[valmod; FVT; IN_SING]; ALL_TAC] THEN SUBGOAL_THEN `?z. ~(z IN FVT s) /\ ~(z IN FVT t) /\ A |-- !!x (formsubst ((u |-> V x) ((v |-> s) i)) p) --> !!z (formsubst ((u |-> V z) ((v |-> s) i)) p) /\ A |-- !!z (formsubst ((u |-> V z) ((v |-> t) i)) p) --> !!y (formsubst ((u |-> V y) ((v |-> t) i)) p)` MP_TAC THENL [ALL_TAC; DISCH_THEN(X_CHOOSE_THEN `z:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC imp_trans THEN EXISTS_TAC `(!!z (formsubst ((v |-> s) ((u |-> V z) i)) p)) --> (!!z (formsubst ((v |-> t) ((u |-> V z) i)) p))` THEN CONJ_TAC THENL [MATCH_MP_TAC imp_trans THEN EXISTS_TAC `!!z (formsubst ((v |-> s) ((u |-> V z) i)) p --> formsubst ((v |-> t) ((u |-> V z) i)) p)` THEN REWRITE_TAC[axiom_allimp] THEN ASM_SIMP_TAC[complexity; LE_REFL; FV; IN_UNION; gen_right]; ALL_TAC] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP VALMOD_SWAP th]) THEN ASM_MESON_TAC[imp_mono_th; modusponens]] THEN MP_TAC(SPEC `FVT(s) UNION FVT(t) UNION FV(formsubst ((u |-> V x) ((v |-> s) i)) p) UNION FV(formsubst ((u |-> V y) ((v |-> t) i)) p)` VARIANT_FINITE) THEN REWRITE_TAC[FINITE_UNION; FV_FINITE; FVT_FINITE] THEN W(fun (_,w) -> ABBREV_TAC(mk_comb(`(=) (z:num)`,lhand(rand(lhand w))))) THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN EXISTS_TAC `z:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC subalpha THEN ASM_SIMP_TAC[LE_REFL] THENL [ASM_CASES_TAC `z:num = x` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(x IN FV (formsubst ((v |-> s) i) (!! u p)))`; ASM_CASES_TAC `z:num = y` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(y IN FV (formsubst ((v |-> t) i) (!! u p)))`] THEN ASM_REWRITE_TAC[FORMSUBST_FV; FV; IN_ELIM_THM; IN_DELETE] THEN MATCH_MP_TAC MONO_NOT THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:num` THEN ASM_CASES_TAC `w:num = u` THEN ASM_REWRITE_TAC[VALMOD_BASIC; FVT; IN_SING] THEN ASM_REWRITE_TAC[valmod; FVT; IN_SING]);; let isubst = prove (`!A p x s t. A |-- s === t --> formsubst (x |=> s) p --> formsubst (x |=> t) p`, REWRITE_TAC[assign; isubst_general]);; let isubst_var = prove (`!A p x t. A |-- V x === t --> p --> formsubst (x |=> t) p`, MESON_TAC[FORMSUBST_TRIV; ASSIGN_TRIV; isubst]);; let alpha = prove (`!A x z p. ~(z IN FV p) ==> A |-- (!!x p) --> !!z (formsubst (x |=> V z) p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC subalpha THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[isubst_var]] THEN REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN] THEN ASM_MESON_TAC[IN_SING; FVT]);; (* ------------------------------------------------------------------------- *) (* To conclude cleanly, useful to have all variables. *) (* ------------------------------------------------------------------------- *) let VARS = new_recursive_definition form_RECURSION `(VARS False = {}) /\ (VARS True = {}) /\ (VARS (s === t) = FVT s UNION FVT t) /\ (VARS (s << t) = FVT s UNION FVT t) /\ (VARS (s <<= t) = FVT s UNION FVT t) /\ (VARS (Not p) = VARS p) /\ (VARS (p && q) = VARS p UNION VARS q) /\ (VARS (p || q) = VARS p UNION VARS q) /\ (VARS (p --> q) = VARS p UNION VARS q) /\ (VARS (p <-> q) = VARS p UNION VARS q) /\ (VARS (!! x p) = x INSERT VARS p) /\ (VARS (?? x p) = x INSERT VARS p)`;; let VARS_FINITE = prove (`!p. FINITE(VARS p)`, MATCH_MP_TAC form_INDUCT THEN ASM_SIMP_TAC[VARS; FINITE_RULES; FVT_FINITE; FINITE_UNION; FINITE_DELETE]);; let FV_SUBSET_VARS = prove (`!p. FV(p) SUBSET VARS(p)`, REWRITE_TAC[SUBSET] THEN MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[FV; VARS] THEN REWRITE_TAC[IN_INSERT; IN_UNION; IN_DELETE] THEN MESON_TAC[]);; let TERMSUBST_TWICE_GENERAL = prove (`!x z t v s. ~(z IN FVT s) ==> (termsubst ((x |-> t) v) s = termsubst ((z |-> t) v) (termsubst (x |=> V z) s))`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[termsubst; ASSIGN; valmod; FVT; IN_SING; IN_UNION] THEN MESON_TAC[termsubst; ASSIGN]);; let TERMSUBST_TWICE = prove (`!x z t s. ~(z IN FVT s) ==> (termsubst (x |=> t) s = termsubst (z |=> t) (termsubst (x |=> V z) s))`, MESON_TAC[assign; TERMSUBST_TWICE_GENERAL]);; let FORMSUBST_TWICE_GENERAL = prove (`!p i j. (!x. x IN VARS p ==> safe_for x i) ==> formsubst j (formsubst i p) = formsubst (termsubst j o i) p`, MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[VARS; FORALL_IN_INSERT; IN_UNION; NOT_IN_EMPTY; FORALL_AND_THM; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN SIMP_TAC[FORMSUBST_SAFE_FOR] THEN REWRITE_TAC[formsubst; TERMSUBST_TERMSUBST] THEN SIMP_TAC[] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`i:num->term`; `j:num->term`] THEN STRIP_TAC THEN REWRITE_TAC[FV; FORMSUBST_FV; TERMSUBST_FVT; o_THM; IN_ELIM_THM; IN_DELETE] THEN (SUBGOAL_THEN `(?y. ((?y'. y' IN FV p /\ y IN FVT ((x |-> V x) i y')) /\ ~(y = x)) /\ x IN FVT (j y)) <=> (?y. (y IN FV p /\ ~(y = x)) /\ (?y'. y' IN FVT (i y) /\ x IN FVT (j y')))` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:num` THEN ASM_CASES_TAC `y IN FV p` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `y:num = x` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VALMOD; FVT; IN_SING] THEN MESON_TAC[]; ALL_TAC] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `z:num` THEN ASM_CASES_TAC `x IN FVT(j(z:num))` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VALMOD] THEN ASM_MESON_TAC[safe_for]; ALL_TAC] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `{x' | ?y. (?y'. y' IN FV p /\ y IN FVT ((x |-> V x) i y')) /\ x' IN FVT ((x |-> V x) j y)} = {x' | ?y. y IN FV p /\ x' IN FVT ((x |-> V x) (termsubst j o i) y)}` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:num` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:num` THEN ASM_CASES_TAC `y IN FV p` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `y:num = x` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VALMOD; FVT; IN_SING; UNWIND_THM2] THEN REWRITE_TAC[o_THM; TERMSUBST_FVT; IN_ELIM_THM] THEN ASM_MESON_TAC[safe_for]; ABBREV_TAC `z = VARIANT {x' | ?y. y IN FV p /\ x' IN FVT ((x |-> V x) (termsubst j o i) y)}`]; ALL_TAC]) THEN AP_TERM_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhs o rand) th o lhs o snd)) THEN ASM_SIMP_TAC[SAFE_FOR_VALMOD; FVT; IN_SING] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC FORMSUBST_EQ THEN X_GEN_TAC `y:num` THEN DISCH_TAC THEN REWRITE_TAC[VALMOD; o_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[termsubst; VALMOD] THEN MATCH_MP_TAC TERMSUBST_EQ THEN X_GEN_TAC `w:num` THEN REWRITE_TAC[VALMOD] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[safe_for]);; let FORMSUBST_TWICE = prove (`!z p x t. ~(z IN VARS p) ==> (formsubst (z |=> t) (formsubst (x |=> V z) p) = formsubst (x |=> t) p)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) FORMSUBST_TWICE_GENERAL o lhs o snd) THEN REWRITE_TAC[SAFE_FOR_ASSIGN; FVT; IN_SING] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC FORMSUBST_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM; VALMOD; ASSIGN] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[termsubst; ASSIGN] THEN ASM_MESON_TAC[FV_SUBSET_VARS; SUBSET]);; let ispec_lemma = prove (`!A x p t. ~(x IN FVT(t)) ==> A |-- !!x p --> formsubst (x |=> t) p`, REPEAT STRIP_TAC THEN MATCH_MP_TAC subspec THEN EXISTS_TAC `t:term` THEN ASM_REWRITE_TAC[isubst_var] THEN ASM_REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN] THEN ASM_MESON_TAC[FVT; IN_SING]);; let ispec = prove (`!A x p t. A |-- !!x p --> formsubst (x |=> t) p`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x IN FVT(t)` THEN ASM_SIMP_TAC[ispec_lemma] THEN ABBREV_TAC `z = VARIANT (FVT t UNION VARS p)` THEN MATCH_MP_TAC imp_trans THEN EXISTS_TAC `!!z (formsubst (x |=> V z) p)` THEN CONJ_TAC THENL [MATCH_MP_TAC alpha THEN EXPAND_TAC "z" THEN MATCH_MP_TAC NOT_IN_VARIANT THEN REWRITE_TAC[FINITE_UNION; SUBSET; IN_UNION] THEN MESON_TAC[SUBSET; FVT_FINITE; VARS_FINITE; FV_SUBSET_VARS]; SUBGOAL_THEN `formsubst (x |=> t) p = formsubst (z |=> t) (formsubst (x |=> V z) p)` SUBST1_TAC THENL [MATCH_MP_TAC(GSYM FORMSUBST_TWICE); MATCH_MP_TAC ispec_lemma] THEN EXPAND_TAC "z" THEN MATCH_MP_TAC NOT_IN_VARIANT THEN REWRITE_TAC[VARS_FINITE; FVT_FINITE; FINITE_UNION] THEN SIMP_TAC[SUBSET; IN_UNION]]);; let spec = prove (`!A x p t. A |-- !!x p ==> A |-- formsubst (x |=> t) p`, MESON_TAC[ispec; modusponens]);; let spec_var = prove (`!A x p. A |-- !!x p ==> A |-- p`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `V x` o MATCH_MP spec) THEN SIMP_TAC[ASSIGN_TRIV; FORMSUBST_TRIVIAL]);; let instantiation = prove (`!A v p. A |-- p ==> A |-- formsubst v p`, let lemma = prove (`!A p v. (!x y. x IN FV p /\ y IN FV p /\ x IN FVT(v y) ==> x = y /\ v x = V x) /\ A |-- p ==> A |-- formsubst v p`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD {x | x IN FV(p) /\ ~(v x = V x)}` THEN ASM_CASES_TAC `!x. x IN FV p ==> v x = V x` THEN ASM_SIMP_TAC[FORMSUBST_TRIVIAL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:form`; `(x |-> V x) v`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN SIMP_TAC[FINITE_RESTRICT; FV_FINITE] THEN REWRITE_TAC[PSUBSET_ALT] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; VALMOD; IN_ELIM_THM] THEN ASM_MESON_TAC[]; EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[VALMOD; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[VALMOD] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[FVT; IN_SING] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `formsubst v p = formsubst ((x |-> v x) v) p` SUBST1_TAC THENL [SIMP_TAC[VALMOD_TRIVIAL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `x:num` o MATCH_MP gen) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] modusponens) THEN MATCH_MP_TAC exists_imp THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; NOT_EXISTS_THM; VALMOD] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC modusponens THEN EXISTS_TAC `??x (V x === v x)` THEN SIMP_TAC[eximp; isubst_general] THEN ASM_MESON_TAC[axiom_existseq]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `?n. !x. x IN VARS p \/ x IN FV(formsubst v p) ==> x < n` STRIP_ASSUME_TAC THENL [EXISTS_TAC `SUC(SETMAX(VARS p UNION FV(formsubst v p)))` THEN REWRITE_TAC[GSYM IN_UNION; LT_SUC_LE] THEN MATCH_MP_TAC SETMAX_MEMBER THEN REWRITE_TAC[FINITE_UNION; VARS_FINITE; FV_FINITE]; ALL_TAC] THEN SUBGOAL_THEN `formsubst v p = formsubst (\i. v(i - n)) (formsubst (\i. V(i + n)) p)` SUBST1_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) FORMSUBST_TWICE_GENERAL o rand o snd) THEN REWRITE_TAC[safe_for; FVT; IN_SING] THEN ANTS_TAC THENL [ASM_MESON_TAC[ARITH_RULE `~(x + n:num < n)`]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF; termsubst; ADD_SUB; ETA_AX]]; MATCH_MP_TAC lemma THEN REWRITE_TAC[FVT] THEN CONJ_TAC THENL [REWRITE_TAC[FORMSUBST_FV; FVT; IN_SING] THEN REWRITE_TAC[SET_RULE `{x | ?y. y IN s /\ x = f y} = IMAGE f s`] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:num` THEN DISCH_TAC THEN REWRITE_TAC[ADD_SUB; FVT] THEN X_GEN_TAC `y:num` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x + n:num`) THEN MATCH_MP_TAC(TAUT `~p /\ q ==> (r \/ q ==> p) ==> s`) THEN CONJ_TAC THENL [ARITH_TAC; REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM]] THEN ASM_MESON_TAC[]; MATCH_MP_TAC lemma THEN REWRITE_TAC[FVT; IN_SING] THEN ASM_MESON_TAC[ARITH_RULE `x < n /\ y < n ==> ~(x = y + n)`; FV_SUBSET_VARS; SUBSET]]]);; (* ------------------------------------------------------------------------- *) (* Monotonicity and the deduction theorem. *) (* ------------------------------------------------------------------------- *) let PROVES_MONO = prove (`!A B p. A SUBSET B /\ A |-- p ==> B |-- p`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC proves_INDUCT THEN ASM_MESON_TAC[proves_RULES; SUBSET]);; let DEDUCTION_LEMMA = prove (`!A p q. p INSERT A |-- q /\ closed p ==> A |-- p --> q`, GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC proves_INDUCT THEN REPEAT CONJ_TAC THEN X_GEN_TAC `r:form` THENL [REWRITE_TAC[IN_INSERT] THEN MESON_TAC[proves_RULES; add_assum; imp_refl]; MESON_TAC[modusponens; axiom_distribimp]; ASM_MESON_TAC[gen_right; closed; NOT_IN_EMPTY]]);; let DEDUCTION = prove (`!A p q. closed p ==> (A |-- p --> q <=> p INSERT A |-- q)`, MESON_TAC[DEDUCTION_LEMMA; modusponens; IN_INSERT; proves_RULES; PROVES_MONO; SUBSET]);; (* ------------------------------------------------------------------------- *) (* A few more derived rules. *) (* ------------------------------------------------------------------------- *) let eq_trans = prove (`!A s t u. A |-- s === t --> t === u --> s === u`, MESON_TAC[axiom_predcong; modusponens; imp_swap; axiom_eqrefl; imp_trans; eq_sym]);; let spec_right = prove (`!A p q x. A |-- p --> !!x q ==> A |-- p --> formsubst (x |=> t) q`, MESON_TAC[imp_trans; ispec]);; let eq_trans_rule = prove (`!A s t u. A |-- s === t /\ A |-- t === u ==> A |-- s === u`, MESON_TAC[modusponens; eq_trans]);; let eq_sym_rule = prove (`!A s t. A |-- s === t <=> A |-- t === s`, MESON_TAC[modusponens; eq_sym]);; let allimp = prove (`!A x p q. A |-- p --> q ==> A |-- !!x p --> !!x q`, MESON_TAC[axiom_allimp; modusponens; gen]);; let alliff = prove (`!A x p q. A |-- p <-> q ==> A |-- !!x p <-> !!x q`, MESON_TAC[allimp; iff_imp1; iff_imp2; imp_antisym]);; let exiff = prove (`!A x p q. A |-- p <-> q ==> A |-- ??x p <-> ??x q`, MESON_TAC[eximp; iff_imp1; iff_imp2; imp_antisym]);; let cong_suc = prove (`!A s t. A |-- s === t ==> A |-- Suc s === Suc t`, MESON_TAC[modusponens; axiom_funcong]);; let cong_add = prove (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s ++ u === t ++ v`, MESON_TAC[modusponens; axiom_funcong]);; let cong_mul = prove (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s ** u === t ** v`, MESON_TAC[modusponens; axiom_funcong]);; let cong_eq = prove (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s === u <-> t === v`, REPEAT STRIP_TAC THEN MATCH_MP_TAC imp_antisym THEN ASM_MESON_TAC[modusponens; axiom_predcong; eq_sym]);; let cong_le = prove (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s <<= u <-> t <<= v`, REPEAT STRIP_TAC THEN MATCH_MP_TAC imp_antisym THEN ASM_MESON_TAC[modusponens; axiom_predcong; eq_sym]);; let cong_lt = prove (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s << u <-> t << v`, REPEAT STRIP_TAC THEN MATCH_MP_TAC imp_antisym THEN ASM_MESON_TAC[modusponens; axiom_predcong; eq_sym]);; let iexists = prove (`!A x t p. A |-- formsubst (x |=> t) p --> ??x p`, REPEAT GEN_TAC THEN TRANS_TAC imp_trans `Not(!!x (Not p))` THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[axiom_exists; iff_imp2]] THEN TRANS_TAC imp_trans `Not(formsubst (x |=> t) (Not p))` THEN REWRITE_TAC[contrapos_eq; ispec] THEN REWRITE_TAC[formsubst] THEN MESON_TAC[not_not; iff_imp2]);; let exists_intro = prove (`!A x t p. A |-- formsubst (x |=> t) p ==> A |-- ??x p`, MESON_TAC[iexists; modusponens]);; let impex = prove (`!A x p. ~(x IN FV p) ==> A |-- (??x p) --> p`, REPEAT STRIP_TAC THEN TRANS_TAC imp_trans `Not(Not p)` THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[not_not; iff_imp1]] THEN TRANS_TAC imp_trans `Not(!!x (Not p))` THEN ASM_SIMP_TAC[contrapos_eq; axiom_impall; FV] THEN MESON_TAC[axiom_exists; iff_imp1]);; let ichoose = prove (`!A x p q. A |-- !!x (p --> q) /\ ~(x IN FV q) ==> A |-- (??x p) --> q`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP spec_var) THEN DISCH_THEN(MP_TAC o SPEC `x:num` o MATCH_MP eximp) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] imp_trans) THEN ASM_SIMP_TAC[impex]);; let eq_trans_imp = prove (`A |-- s === s' /\ A |-- t === t' ==> A |-- s === t --> s' === t'`, MESON_TAC[axiom_predcong; modusponens]);; (* ------------------------------------------------------------------------- *) (* Some conversions for performing explicit substitution operations in what *) (* we hope is the common case where no variable renaming occurs. *) (* ------------------------------------------------------------------------- *) let fv_theorems = ref [FV; FV_AXIOM; FV_DIAGONALIZE; FV_DIVIDES; FV_FINITE; FV_FIXPOINT; FV_FORM; FV_FORM1; FV_FREEFORM; FV_FREEFORM1; FV_FREETERM; FV_FREETERM1; FV_GNUMERAL; FV_GNUMERAL1; FV_GNUMERAL1'; FV_GSENTENCE; FV_HSENTENCE; FV_PRIME; FV_PRIMEPOW; FV_PRIMREC; FV_PRIMRECSTEP; FV_PROV; FV_PROV1; FV_QDIAG; FV_QSUBST; FV_RTC; FV_RTCP; FV_SUBSET_VARS; FV_TERM; FV_TERM1; FVT; FVT_NUMERAL];; let IN_FV_RULE ths tm = try EQT_ELIM ((GEN_REWRITE_CONV TOP_DEPTH_CONV ([IN_UNION; IN_DELETE; NOT_IN_EMPTY; IN_INSERT] @ ths @ !fv_theorems) THENC NUM_REDUCE_CONV) tm) with Failure _ -> ASSUME tm;; let rec SAFE_FOR_RULE tm = try PART_MATCH I SAFE_FOR_V tm with Failure _ -> try let th1 = PART_MATCH lhand SAFE_FOR_ASSIGN tm in let th2 = IN_FV_RULE [] (rand(concl th1)) in EQ_MP (SYM th1) th2 with Failure _ -> let th1 = PART_MATCH rand SAFE_FOR_VALMOD tm in let l,r = dest_conj(lhand(concl th1)) in let th2 = CONJ (SAFE_FOR_RULE l) (IN_FV_RULE [] r) in MP th1 th2;; let VALMOD_CONV = GEN_REWRITE_CONV TOP_DEPTH_CONV [ASSIGN; VALMOD] THENC NUM_REDUCE_CONV;; let TERMSUBST_NUMERAL = prove (`!v n. termsubst v (numeral n) = numeral n`, SIMP_TAC[TERMSUBST_TRIVIAL; FVT_NUMERAL; NOT_IN_EMPTY]);; let rec TERMSUBST_CONV tm = (GEN_REWRITE_CONV I [CONJ TERMSUBST_NUMERAL (CONJUNCT1 termsubst)] ORELSEC (GEN_REWRITE_CONV I [el 1 (CONJUNCTS termsubst)] THENC VALMOD_CONV) ORELSEC (GEN_REWRITE_CONV I [el 2 (CONJUNCTS termsubst)] THENC RAND_CONV TERMSUBST_CONV) ORELSEC (GEN_REWRITE_CONV I [funpow 3 CONJUNCT2 termsubst] THENC BINOP_CONV TERMSUBST_CONV)) tm;; let rec FORMSUBST_CONV tm = (GEN_REWRITE_CONV I [el 0 (CONJUNCTS formsubst); el 1 (CONJUNCTS formsubst)] ORELSEC (GEN_REWRITE_CONV I [el 2 (CONJUNCTS formsubst); el 3 (CONJUNCTS formsubst); el 4 (CONJUNCTS formsubst)] THENC BINOP_CONV TERMSUBST_CONV) ORELSEC (GEN_REWRITE_CONV I [el 5 (CONJUNCTS formsubst)] THENC RAND_CONV FORMSUBST_CONV) ORELSEC (GEN_REWRITE_CONV I [el 6 (CONJUNCTS formsubst); el 7 (CONJUNCTS formsubst); el 8 (CONJUNCTS formsubst); el 9 (CONJUNCTS formsubst)] THENC BINOP_CONV FORMSUBST_CONV) ORELSEC ((fun tm -> let th = try PART_MATCH (lhand o rand) (CONJUNCT1 FORMSUBST_SAFE_FOR) tm with Failure _ -> PART_MATCH (lhand o rand) (CONJUNCT2 FORMSUBST_SAFE_FOR) tm in MP th (SAFE_FOR_RULE (lhand(concl th)))) THENC RAND_CONV FORMSUBST_CONV)) tm;; (* ------------------------------------------------------------------------- *) (* Hence a more convenient specialization rule. *) (* ------------------------------------------------------------------------- *) let spec_var_rule th = MATCH_MP spec_var th;; let spec_all_rule = repeat spec_var_rule;; let instantiate_rule ilist th = let v_tm = `(|->):num->term->(num->term)->(num->term)` in let v = itlist (fun (t,x) v -> mk_comb(mk_comb(mk_comb(v_tm,mk_small_numeral x),t),v)) ilist `V` in CONV_RULE (RAND_CONV FORMSUBST_CONV) (SPEC v (MATCH_MP instantiation th));; let specl_rule tms th = let avs = striplist (dest_binop `!!`) (rand(concl th)) in let vs = fst(chop_list(length tms) avs) in let ilist = map2 (fun t v -> (t,dest_small_numeral v)) tms vs in instantiate_rule ilist (funpow (length vs) spec_var_rule th);; let spec_rule t th = specl_rule [t] th;; let gen_rule t th = SPEC (mk_small_numeral t) (MATCH_MP gen th);; let gens_tac ns (asl,w) = let avs,bod = nsplit dest_forall ns w in let nvs = map (curry mk_comb `V` o mk_small_numeral) ns in let bod' = subst (zip nvs avs) bod in let th = GENL avs (instantiate_rule (zip avs ns) (ASSUME bod')) in MATCH_MP_TAC (DISCH_ALL th) (asl,w);; let gen_tac n = gens_tac [n];; hol-light/Arithmetic/fol.ml000066400000000000000000000533371303454263000161630ustar00rootroot00000000000000(* ========================================================================= *) (* First order logic based on the language of arithmetic. *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* Syntax of terms. *) (* ------------------------------------------------------------------------- *) parse_as_infix("++",(20,"right"));; parse_as_infix("**",(22,"right"));; let term_INDUCT,term_RECURSION = define_type "term = Z | V num | Suc term | ++ term term | ** term term";; let term_CASES = prove_cases_thm term_INDUCT;; let term_DISTINCT = distinctness "term";; let term_INJ = injectivity "term";; (* ------------------------------------------------------------------------- *) (* Syntax of formulas. *) (* ------------------------------------------------------------------------- *) parse_as_infix("===",(18,"right"));; parse_as_infix("<<",(18,"right"));; parse_as_infix("<<=",(18,"right"));; parse_as_infix("&&",(16,"right"));; parse_as_infix("||",(15,"right"));; parse_as_infix("-->",(14,"right"));; parse_as_infix("<->",(13,"right"));; let form_INDUCT,form_RECURSION = define_type "form = False | True | === term term | << term term | <<= term term | Not form | && form form | || form form | --> form form | <-> form form | !! num form | ?? num form";; let form_CASES = prove_cases_thm form_INDUCT;; let form_DISTINCT = distinctness "form";; let form_INJ = injectivity "form";; (* ------------------------------------------------------------------------- *) (* Semantics of terms and formulas in the standard model. *) (* ------------------------------------------------------------------------- *) parse_as_infix("|->",(22,"right"));; let valmod = new_definition `(x |-> a) (v:A->B) = \y. if y = x then a else v(y)`;; let termval = new_recursive_definition term_RECURSION `(termval v Z = 0) /\ (termval v (V n) = v(n)) /\ (termval v (Suc t) = SUC (termval v t)) /\ (termval v (s ++ t) = termval v s + termval v t) /\ (termval v (s ** t) = termval v s * termval v t)`;; let holds = new_recursive_definition form_RECURSION `(holds v False <=> F) /\ (holds v True <=> T) /\ (holds v (s === t) <=> (termval v s = termval v t)) /\ (holds v (s << t) <=> (termval v s < termval v t)) /\ (holds v (s <<= t) <=> (termval v s <= termval v t)) /\ (holds v (Not p) <=> ~(holds v p)) /\ (holds v (p && q) <=> holds v p /\ holds v q) /\ (holds v (p || q) <=> holds v p \/ holds v q) /\ (holds v (p --> q) <=> holds v p ==> holds v q) /\ (holds v (p <-> q) <=> (holds v p <=> holds v q)) /\ (holds v (!! x p) <=> !a. holds ((x|->a) v) p) /\ (holds v (?? x p) <=> ?a. holds ((x|->a) v) p)`;; let true_def = new_definition `true p <=> !v. holds v p`;; let VALMOD = prove (`!v x y a. ((x |-> y) v) a = if a = x then y else v(a)`, REWRITE_TAC[valmod]);; let VALMOD_BASIC = prove (`!v x y. (x |-> y) v x = y`, REWRITE_TAC[valmod]);; let VALMOD_VALMOD_BASIC = prove (`!v a b x. (x |-> a) ((x |-> b) v) = (x |-> a) v`, REWRITE_TAC[valmod; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; let VALMOD_REPEAT = prove (`!v x. (x |-> v(x)) v = v`, REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; let FORALL_VALMOD = prove (`!x. (!v a. P((x |-> a) v)) <=> (!v. P v)`, MESON_TAC[VALMOD_REPEAT]);; let VALMOD_SWAP = prove (`!v x y a b. ~(x = y) ==> ((x |-> a) ((y |-> b) v) = (y |-> b) ((x |-> a) v))`, REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; let VALMOD_TRIVIAL = prove (`!v x. v x = t ==> (x |-> t) v = v`, REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Assignment. *) (* ------------------------------------------------------------------------- *) parse_as_infix("|=>",(22,"right"));; let assign = new_definition `(x |=> a) = (x |-> a) V`;; let ASSIGN = prove (`!x y a. (x |=> a) y = if y = x then a else V(y)`, REWRITE_TAC[assign; valmod]);; let ASSIGN_TRIV = prove (`!x. (x |=> V x) = V`, REWRITE_TAC[VALMOD_REPEAT; assign]);; (* ------------------------------------------------------------------------- *) (* Variables in a term and free variables in a formula. *) (* ------------------------------------------------------------------------- *) let FVT = new_recursive_definition term_RECURSION `(FVT Z = {}) /\ (FVT (V n) = {n}) /\ (FVT (Suc t) = FVT t) /\ (FVT (s ++ t) = (FVT s) UNION (FVT t)) /\ (FVT (s ** t) = (FVT s) UNION (FVT t))`;; let FV = new_recursive_definition form_RECURSION `(FV False = {}) /\ (FV True = {}) /\ (FV (s === t) = (FVT s) UNION (FVT t)) /\ (FV (s << t) = (FVT s) UNION (FVT t)) /\ (FV (s <<= t) = (FVT s) UNION (FVT t)) /\ (FV (Not p) = FV p) /\ (FV (p && q) = (FV p) UNION (FV q)) /\ (FV (p || q) = (FV p) UNION (FV q)) /\ (FV (p --> q) = (FV p) UNION (FV q)) /\ (FV (p <-> q) = (FV p) UNION (FV q)) /\ (FV (!!x p) = (FV p) DELETE x) /\ (FV (??x p) = (FV p) DELETE x)`;; let FVT_FINITE = prove (`!t. FINITE(FVT t)`, MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[FVT; FINITE_RULES; FINITE_INSERT; FINITE_UNION]);; let FV_FINITE = prove (`!p. FINITE(FV p)`, MATCH_MP_TAC form_INDUCT THEN SIMP_TAC[FV; FVT_FINITE; FINITE_RULES; FINITE_DELETE; FINITE_UNION]);; (* ------------------------------------------------------------------------- *) (* Logical axioms. *) (* ------------------------------------------------------------------------- *) let axiom_RULES,axiom_INDUCT,axiom_CASES = new_inductive_definition `(!p q. axiom(p --> (q --> p))) /\ (!p q r. axiom((p --> q --> r) --> (p --> q) --> (p --> r))) /\ (!p. axiom(((p --> False) --> False) --> p)) /\ (!x p q. axiom((!!x (p --> q)) --> (!!x p) --> (!!x q))) /\ (!x p. ~(x IN FV p) ==> axiom(p --> !!x p)) /\ (!x t. ~(x IN FVT t) ==> axiom(??x (V x === t))) /\ (!t. axiom(t === t)) /\ (!s t. axiom((s === t) --> (Suc s === Suc t))) /\ (!s t u v. axiom(s === t --> u === v --> s ++ u === t ++ v)) /\ (!s t u v. axiom(s === t --> u === v --> s ** u === t ** v)) /\ (!s t u v. axiom(s === t --> u === v --> s === u --> t === v)) /\ (!s t u v. axiom(s === t --> u === v --> s << u --> t << v)) /\ (!s t u v. axiom(s === t --> u === v --> s <<= u --> t <<= v)) /\ (!p q. axiom((p <-> q) --> p --> q)) /\ (!p q. axiom((p <-> q) --> q --> p)) /\ (!p q. axiom((p --> q) --> (q --> p) --> (p <-> q))) /\ axiom(True <-> (False --> False)) /\ (!p. axiom(Not p <-> (p --> False))) /\ (!p q. axiom((p && q) <-> (p --> q --> False) --> False)) /\ (!p q. axiom((p || q) <-> Not(Not p && Not q))) /\ (!x p. axiom((??x p) <-> Not(!!x (Not p))))`;; (* ------------------------------------------------------------------------- *) (* Deducibility from additional set of nonlogical axioms. *) (* ------------------------------------------------------------------------- *) parse_as_infix("|--",(11,"right"));; let proves_RULES,proves_INDUCT,proves_CASES = new_inductive_definition `(!p. axiom p \/ p IN A ==> A |-- p) /\ (!p q. A |-- (p --> q) /\ A |-- p ==> A |-- q) /\ (!p x. A |-- p ==> A |-- (!!x p))`;; (* ------------------------------------------------------------------------- *) (* Some lemmas. *) (* ------------------------------------------------------------------------- *) let TERMVAL_VALUATION = prove (`!t v v'. (!x. x IN FVT(t) ==> (v'(x) = v(x))) ==> (termval v' t = termval v t)`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[termval; FVT; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[]);; let HOLDS_VALUATION = prove (`!p v v'. (!x. x IN (FV p) ==> (v'(x) = v(x))) ==> (holds v' p <=> holds v p)`, MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[FV; holds; IN_UNION; IN_DELETE] THEN SIMP_TAC[TERMVAL_VALUATION] THEN REWRITE_TAC[valmod] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; let TERMVAL_VALMOD_OTHER = prove (`!v x a t. ~(x IN FVT t) ==> (termval ((x |-> a) v) t = termval v t)`, MESON_TAC[TERMVAL_VALUATION; VALMOD]);; let HOLDS_VALMOD_OTHER = prove (`!v x a p. ~(x IN FV p) ==> (holds ((x |-> a) v) p <=> holds v p)`, MESON_TAC[HOLDS_VALUATION; VALMOD]);; (* ------------------------------------------------------------------------- *) (* Proof of soundness. *) (* ------------------------------------------------------------------------- *) let AXIOMS_TRUE = prove (`!p. axiom p ==> true p`, MATCH_MP_TAC axiom_INDUCT THEN REWRITE_TAC[true_def] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[holds] THENL [CONV_TAC TAUT; CONV_TAC TAUT; SIMP_TAC[]; REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN REWRITE_TAC[valmod] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[]; EXISTS_TAC `termval v t` THEN REWRITE_TAC[termval; valmod] THEN MATCH_MP_TAC TERMVAL_VALUATION THEN GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_MESON_TAC[]; SIMP_TAC[termval]; SIMP_TAC[termval]; SIMP_TAC[termval]; SIMP_TAC[termval]; SIMP_TAC[termval]; SIMP_TAC[termval]; SIMP_TAC[termval]; SIMP_TAC[termval]; CONV_TAC TAUT; CONV_TAC TAUT; CONV_TAC TAUT; MESON_TAC[]]);; let THEOREMS_TRUE = prove (`!A p. (!q. q IN A ==> true q) /\ A |-- p ==> true p`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC proves_INDUCT THEN ASM_SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[IN; AXIOMS_TRUE] THEN SIMP_TAC[holds; true_def]);; (* ------------------------------------------------------------------------- *) (* Variant variables for use in renaming substitution. *) (* ------------------------------------------------------------------------- *) let MAX_SYM = prove (`!x y. MAX x y = MAX y x`, ARITH_TAC);; let MAX_ASSOC = prove (`!x y z. MAX x (MAX y z) = MAX (MAX x y) z`, ARITH_TAC);; let SETMAX = new_definition `SETMAX s = ITSET MAX s 0`;; let VARIANT = new_definition `VARIANT s = SETMAX s + 1`;; let SETMAX_LEMMA = prove (`(SETMAX {} = 0) /\ (!x s. FINITE s ==> (SETMAX (x INSERT s) = if x IN s then SETMAX s else MAX x (SETMAX s)))`, REWRITE_TAC[SETMAX] THEN MATCH_MP_TAC FINITE_RECURSION THEN REWRITE_TAC[MAX] THEN REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`x:num <= s`; `y:num <= s`; `x:num <= y`; `y <= x`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LE_CASES; LE_TRANS; LE_ANTISYM]);; let SETMAX_MEMBER = prove (`!s. FINITE s ==> !x. x IN s ==> x <= SETMAX s`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC [SETMAX_LEMMA] THEN ASM_REWRITE_TAC[MAX] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_REFL] THEN ASM_MESON_TAC[LE_CASES; LE_TRANS]);; let SETMAX_THM = prove (`(SETMAX {} = 0) /\ (!x s. FINITE s ==> (SETMAX (x INSERT s) = MAX x (SETMAX s)))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC [SETMAX_LEMMA] THEN COND_CASES_TAC THEN REWRITE_TAC[MAX] THEN COND_CASES_TAC THEN ASM_MESON_TAC[SETMAX_MEMBER]);; let SETMAX_UNION = prove (`!s t. FINITE(s UNION t) ==> (SETMAX(s UNION t) = MAX (SETMAX s) (SETMAX t))`, let lemma = prove(`(x INSERT s) UNION t = x INSERT (s UNION t)`,SET_TAC[]) in SUBGOAL_THEN `!t. FINITE(t) ==> !s. FINITE(s) ==> (SETMAX(s UNION t) = MAX (SETMAX s) (SETMAX t))` (fun th -> MESON_TAC[th; FINITE_UNION]) THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNION_EMPTY; SETMAX_THM] THEN CONJ_TAC THENL [REWRITE_TAC[MAX; LE_0]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[lemma] THEN ASM_SIMP_TAC [SETMAX_THM; FINITE_UNION] THEN REWRITE_TAC[MAX_ASSOC]);; let VARIANT_FINITE = prove (`!s:num->bool. FINITE(s) ==> ~(VARIANT(s) IN s)`, REWRITE_TAC[VARIANT] THEN MESON_TAC[SETMAX_MEMBER; ARITH_RULE `~(x + 1 <= x)`]);; let VARIANT_THM = prove (`!p. ~(VARIANT(FV p) IN FV(p))`, GEN_TAC THEN MATCH_MP_TAC VARIANT_FINITE THEN REWRITE_TAC[FV_FINITE]);; let NOT_IN_VARIANT = prove (`!s t. FINITE s /\ t SUBSET s ==> ~(VARIANT(s) IN t)`, MESON_TAC[SUBSET; VARIANT_FINITE]);; (* ------------------------------------------------------------------------- *) (* Substitution within terms. *) (* ------------------------------------------------------------------------- *) let termsubst = new_recursive_definition term_RECURSION `(termsubst v Z = Z) /\ (!x. termsubst v (V x) = v(x)) /\ (!t. termsubst v (Suc t) = Suc(termsubst v t)) /\ (!s t. termsubst v (s ++ t) = termsubst v s ++ termsubst v t) /\ (!s t. termsubst v (s ** t) = termsubst v s ** termsubst v t)`;; let TERMVAL_TERMSUBST = prove (`!v i t. termval v (termsubst i t) = termval (termval v o i) t`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termval; termsubst; o_THM]);; let TERMSUBST_TERMSUBST = prove (`!i j t. termsubst j (termsubst i t) = termsubst (termsubst j o i) t`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termval; termsubst; o_THM]);; let TERMSUBST_TRIV = prove (`!t. termsubst V t = t`, MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termsubst]);; let TERMSUBST_EQ = prove (`!t v v'. (!x. x IN (FVT t) ==> (v'(x) = v(x))) ==> (termsubst v' t = termsubst v t)`, MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termsubst; FVT; IN_SING; IN_UNION] THEN MESON_TAC[]);; let TERMSUBST_FVT = prove (`!t i. FVT(termsubst i t) = {x | ?y. y IN FVT(t) /\ x IN FVT(i y)}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[FVT; termsubst] THEN REWRITE_TAC[IN_UNION; IN_SING; NOT_IN_EMPTY] THEN MESON_TAC[]);; let TERMSUBST_ASSIGN = prove (`!x s t. ~(x IN FVT t) ==> (termsubst (x |=> s) t = t)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM TERMSUBST_TRIV] THEN MATCH_MP_TAC TERMSUBST_EQ THEN REWRITE_TAC[ASSIGN] THEN ASM_MESON_TAC[]);; let TERMSUBST_TRIVIAL = prove (`!v t. (!x. x IN FVT t ==> v x = V x) ==> termsubst v t = t`, MESON_TAC[TERMSUBST_EQ; TERMSUBST_TRIV]);; (* ------------------------------------------------------------------------- *) (* Formula substitution --- somewhat less trivial. *) (* ------------------------------------------------------------------------- *) let formsubst = new_recursive_definition form_RECURSION `(formsubst v False = False) /\ (formsubst v True = True) /\ (formsubst v (s === t) = termsubst v s === termsubst v t) /\ (formsubst v (s << t) = termsubst v s << termsubst v t) /\ (formsubst v (s <<= t) = termsubst v s <<= termsubst v t) /\ (formsubst v (Not p) = Not(formsubst v p)) /\ (formsubst v (p && q) = formsubst v p && formsubst v q) /\ (formsubst v (p || q) = formsubst v p || formsubst v q) /\ (formsubst v (p --> q) = formsubst v p --> formsubst v q) /\ (formsubst v (p <-> q) = formsubst v p <-> formsubst v q) /\ (formsubst v (!!x q) = let z = if ?y. y IN FV(!!x q) /\ x IN FVT(v(y)) then VARIANT(FV(formsubst ((x |-> V x) v) q)) else x in !!z (formsubst ((x |-> V(z)) v) q)) /\ (formsubst v (??x q) = let z = if ?y. y IN FV(??x q) /\ x IN FVT(v(y)) then VARIANT(FV(formsubst ((x |-> V x) v) q)) else x in ??z (formsubst ((x |-> V(z)) v) q))`;; let FORMSUBST_PROPERTIES = prove (`!p. (!i. FV(formsubst i p) = {x | ?y. y IN FV(p) /\ x IN FVT(i y)}) /\ (!i v. holds v (formsubst i p) = holds (termval v o i) p)`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[FV; holds; formsubst; TERMSUBST_FVT; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNION; TERMVAL_TERMSUBST] THEN REPEAT(CONJ_TAC THENL [MESON_TAC[];ALL_TAC]) THEN CONJ_TAC THEN (MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN STRIP_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num->term` THEN LET_TAC THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN SUBGOAL_THEN `~(?y. y IN (FV(p) DELETE x) /\ z IN FVT(i y))` ASSUME_TAC THENL [EXPAND_TAC "z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `formsubst ((x |-> V x) i) p` VARIANT_THM) THEN ASM_REWRITE_TAC[valmod; IN_DELETE; CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; ALL_TAC] THEN CONJ_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[FV; IN_DELETE; holds] THENL [REWRITE_TAC[LEFT_AND_EXISTS_THM; valmod] THEN AP_TERM_TAC THEN ABS_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[FVT; IN_SING; IN_DELETE]; AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HOLDS_VALUATION THEN GEN_TAC THEN REWRITE_TAC[valmod; o_DEF] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[termval] THEN DISCH_TAC THEN MATCH_MP_TAC TERMVAL_VALUATION THEN GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_MESON_TAC[IN_DELETE]]));; let FORMSUBST_FV = prove (`!p i. FV(formsubst i p) = {x | ?y. y IN FV(p) /\ x IN FVT(i y)}`, REWRITE_TAC[FORMSUBST_PROPERTIES]);; let HOLDS_FORMSUBST = prove (`!p i v. holds v (formsubst i p) <=> holds (termval v o i) p`, REWRITE_TAC[FORMSUBST_PROPERTIES]);; let FORMSUBST_EQ = prove (`!p i j. (!x. x IN FV(p) ==> (i(x) = j(x))) ==> (formsubst i p = formsubst j p)`, MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[FV; formsubst; IN_UNION; IN_DELETE] THEN SIMP_TAC[] THEN REWRITE_TAC[CONJ_ASSOC] THEN GEN_REWRITE_TAC I [GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MESON_TAC[TERMSUBST_EQ]; ALL_TAC] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN (DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`i:num->term`; `j:num->term`] THEN DISCH_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF; form_INJ] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; DISCH_THEN(K ALL_TAC) THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[valmod] THEN ASM_SIMP_TAC[]] THEN AP_THM_TAC THEN BINOP_TAC THENL [ASM_MESON_TAC[]; AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[valmod] THEN ASM_MESON_TAC[]]));; let FORMSUBST_TRIV = prove (`!p. formsubst V p = p`, MATCH_MP_TAC form_INDUCT THEN SIMP_TAC[formsubst; TERMSUBST_TRIV] THEN REWRITE_TAC[FVT; IN_SING; FV; IN_DELETE] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; VALMOD_REPEAT] THEN ASM_MESON_TAC[]);; let FORMSUBST_TRIVIAL = prove (`!v p. (!x. x IN FV(p) ==> v x = V x) ==> formsubst v p = p`, MESON_TAC[FORMSUBST_EQ; FORMSUBST_TRIV]);; (* ------------------------------------------------------------------------- *) (* Predicate ensuring that a substitution will not cause variable renaming. *) (* ------------------------------------------------------------------------- *) let safe_for = new_definition `safe_for x v <=> !y. x IN FVT(v y) ==> y = x`;; let SAFE_FOR_V = prove (`!x. safe_for x V`, SIMP_TAC[safe_for; FVT; IN_SING]);; let SAFE_FOR_VALMOD = prove (`!v x y t. safe_for x v /\ (x IN FVT t ==> y = x) ==> safe_for x ((y |-> t) v)`, REWRITE_TAC[safe_for; VALMOD] THEN MESON_TAC[]);; let SAFE_FOR_ASSIGN = prove (`!x y t. safe_for x (y |=> t) <=> x IN FVT t ==> y = x`, REWRITE_TAC[safe_for; ASSIGN] THEN MESON_TAC[FVT; IN_SING]);; let FORMSUBST_SAFE_FOR = prove (`(!v x p. safe_for x v ==> formsubst v (!! x p) = !!x (formsubst ((x |-> V x) v) p)) /\ (!v x p. safe_for x v ==> formsubst v (?? x p) = ??x (formsubst ((x |-> V x) v) p))`, REWRITE_TAC[safe_for; formsubst; LET_DEF; LET_END_DEF; FV] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Quasi-substitution. *) (* ------------------------------------------------------------------------- *) let qsubst = new_definition `qsubst (x,t) p = ??x (V x === t && p)`;; let FV_QSUBST = prove (`!x n p. FV(qsubst (x,t) p) = (FV(p) UNION FVT(t)) DELETE x`, REWRITE_TAC[qsubst; FV; FVT] THEN SET_TAC[]);; let HOLDS_QSUBST = prove (`!v t p v. ~(x IN FVT(t)) ==> (holds v (qsubst (x,t) p) <=> holds ((x |-> termval v t) v) p)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!v z. termval ((x |-> z) v) t = termval v t` ASSUME_TAC THENL [REWRITE_TAC[valmod] THEN ASM_MESON_TAC[TERMVAL_VALUATION]; ASM_REWRITE_TAC[holds; qsubst; termval; VALMOD_BASIC; UNWIND_THM2]]);; (* ------------------------------------------------------------------------- *) (* The numeral mapping. *) (* ------------------------------------------------------------------------- *) let numeral = new_recursive_definition num_RECURSION `(numeral 0 = Z) /\ (!n. numeral (SUC n) = Suc(numeral n))`;; let TERMVAL_NUMERAL = prove (`!v n. termval v (numeral n) = n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[termval;numeral]);; let FVT_NUMERAL = prove (`!n. FVT(numeral n) = {}`, INDUCT_TAC THEN ASM_REWRITE_TAC[FVT; numeral]);; (* ------------------------------------------------------------------------- *) (* Closed-ness. *) (* ------------------------------------------------------------------------- *) let closed = new_definition `closed p <=> (FV p = {})`;; hol-light/Arithmetic/godel.ml000066400000000000000000000573241303454263000164750ustar00rootroot00000000000000(* ========================================================================= *) (* Godel's theorem in its true form. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Classes of formulas, via auxiliary "shared" inductive definition. *) (* ------------------------------------------------------------------------- *) let sigmapi_RULES,sigmapi_INDUCT,sigmapi_CASES = new_inductive_definition `(!b n. sigmapi b n False) /\ (!b n. sigmapi b n True) /\ (!b n s t. sigmapi b n (s === t)) /\ (!b n s t. sigmapi b n (s << t)) /\ (!b n s t. sigmapi b n (s <<= t)) /\ (!b n p. sigmapi (~b) n p ==> sigmapi b n (Not p)) /\ (!b n p q. sigmapi b n p /\ sigmapi b n q ==> sigmapi b n (p && q)) /\ (!b n p q. sigmapi b n p /\ sigmapi b n q ==> sigmapi b n (p || q)) /\ (!b n p q. sigmapi (~b) n p /\ sigmapi b n q ==> sigmapi b n (p --> q)) /\ (!b n p q. (!b. sigmapi b n p) /\ (!b. sigmapi b n q) ==> sigmapi b n (p <-> q)) /\ (!n x p. sigmapi T n p /\ ~(n = 0) ==> sigmapi T n (??x p)) /\ (!n x p. sigmapi F n p /\ ~(n = 0) ==> sigmapi F n (!!x p)) /\ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) ==> sigmapi b n (??x (V x << t && p))) /\ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) ==> sigmapi b n (??x (V x <<= t && p))) /\ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) ==> sigmapi b n (!!x (V x << t --> p))) /\ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) ==> sigmapi b n (!!x (V x <<= t --> p))) /\ (!b c n p. sigmapi b n p ==> sigmapi c (n + 1) p)`;; let SIGMA = new_definition `SIGMA = sigmapi T`;; let PI = new_definition `PI = sigmapi F`;; let DELTA = new_definition `DELTA n p <=> SIGMA n p /\ PI n p`;; let SIGMAPI_PROP = prove (`(!n b. sigmapi b n False <=> T) /\ (!n b. sigmapi b n True <=> T) /\ (!n b s t. sigmapi b n (s === t) <=> T) /\ (!n b s t. sigmapi b n (s << t) <=> T) /\ (!n b s t. sigmapi b n (s <<= t) <=> T) /\ (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\ (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\ (sigmapi b n q /\ sigmapi (~b) n q))`, REWRITE_TAC[sigmapi_RULES] THEN GEN_REWRITE_TAC DEPTH_CONV [AND_FORALL_THM] THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_SUB1] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN REWRITE_TAC[form_DISTINCT; form_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1; FORALL_BOOL_THM] THEN REWRITE_TAC[ARITH_RULE `~(0 = n + 1)`] THEN REWRITE_TAC[ARITH_RULE `(SUC m = n + 1) <=> (n = m)`; UNWIND_THM2] THEN ASM_REWRITE_TAC[] THEN BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[ADD1] THEN REWRITE_TAC[CONJ_ACI] THEN REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN MESON_TAC[sigmapi_RULES]);; let SIGMAPI_MONO_LEMMA = prove (`(!b n p. sigmapi b n p ==> sigmapi b (n + 1) p) /\ (!b n p. ~(n = 0) /\ sigmapi b (n - 1) p ==> sigmapi b n p) /\ (!b n p. ~(n = 0) /\ sigmapi (~b) (n - 1) p ==> sigmapi b n p)`, CONJ_TAC THENL [REPEAT STRIP_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> (n = (n - 1) + 1)`))] THEN POP_ASSUM MP_TAC THEN ASM_MESON_TAC[sigmapi_RULES]);; let SIGMAPI_REV_EXISTS = prove (`!n b x p. sigmapi b n (??x p) ==> sigmapi b n p`, MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN REWRITE_TAC[form_DISTINCT; form_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIGMAPI_PROP] THEN ASM_MESON_TAC[ARITH_RULE `n < n + 1`; sigmapi_RULES]);; let SIGMAPI_REV_FORALL = prove (`!n b x p. sigmapi b n (!!x p) ==> sigmapi b n p`, MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN REWRITE_TAC[form_DISTINCT; form_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIGMAPI_PROP] THEN ASM_MESON_TAC[ARITH_RULE `n < n + 1`; sigmapi_RULES]);; let SIGMAPI_CLAUSES_CODE = prove (`(!n b. sigmapi b n False <=> T) /\ (!n b. sigmapi b n True <=> T) /\ (!n b s t. sigmapi b n (s === t) <=> T) /\ (!n b s t. sigmapi b n (s << t) <=> T) /\ (!n b s t. sigmapi b n (s <<= t) <=> T) /\ (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\ (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\ (sigmapi b n q /\ sigmapi (~b) n q)) /\ (!n b x p. sigmapi b n (??x p) <=> if b /\ ~(n = 0) \/ ?q t. (p = (V x << t && q) \/ p = (V x <<= t && q)) /\ ~(x IN FVT t) then sigmapi b n p else ~(n = 0) /\ sigmapi (~b) (n - 1) (??x p)) /\ (!n b x p. sigmapi b n (!!x p) <=> if ~b /\ ~(n = 0) \/ ?q t. (p = (V x << t --> q) \/ p = (V x <<= t --> q)) /\ ~(x IN FVT t) then sigmapi b n p else ~(n = 0) /\ sigmapi (~b) (n - 1) (!!x p))`, REWRITE_TAC[SIGMAPI_PROP] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN REWRITE_TAC[form_DISTINCT; form_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN ONCE_REWRITE_TAC[TAUT `a \/ b \/ c \/ d <=> (b \/ c) \/ (a \/ d)`] THEN REWRITE_TAC[CONJ_ASSOC; OR_EXISTS_THM; GSYM RIGHT_OR_DISTRIB] THEN REWRITE_TAC[TAUT `(if b /\ c \/ d then e else c /\ f) <=> d /\ e \/ c /\ ~d /\ (if b then e else f)`] THEN MATCH_MP_TAC(TAUT `(a <=> a') /\ (~a' ==> (b <=> b')) ==> (a \/ b <=> a' \/ b')`) THEN (CONJ_TAC THENL [REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[SIGMAPI_PROP] THEN SIMP_TAC[]; ALL_TAC]) THEN (ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH_RULE `~(0 = n + 1)`]) THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> (n = m + 1 <=> m = n - 1)`] THEN REWRITE_TAC[UNWIND_THM2] THEN W(fun (asl,w) -> ASM_CASES_TAC (find_term is_exists w)) THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THENL [DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_EXISTS)) THEN DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]; ASM_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THENL [DISCH_THEN(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_EXISTS)) THEN DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]; REWRITE_TAC[EXISTS_BOOL_THM] THEN REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN ONCE_REWRITE_TAC[sigmapi_CASES] THEN REWRITE_TAC[form_DISTINCT; form_INJ] THEN ASM_MESON_TAC[]]; DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_FORALL)) THEN DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]; ASM_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THENL [REWRITE_TAC[EXISTS_BOOL_THM] THEN REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN ONCE_REWRITE_TAC[sigmapi_CASES] THEN REWRITE_TAC[form_DISTINCT; form_INJ] THEN ASM_MESON_TAC[]; DISCH_THEN(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_FORALL)) THEN DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]]]);; let SIGMAPI_CLAUSES = prove (`(!n b. sigmapi b n False <=> T) /\ (!n b. sigmapi b n True <=> T) /\ (!n b s t. sigmapi b n (s === t) <=> T) /\ (!n b s t. sigmapi b n (s << t) <=> T) /\ (!n b s t. sigmapi b n (s <<= t) <=> T) /\ (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\ (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\ (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\ (sigmapi b n q /\ sigmapi (~b) n q)) /\ (!n b x p. sigmapi b n (??x p) <=> if b /\ ~(n = 0) \/ ?q t. (p = (V x << t && q) \/ p = (V x <<= t && q)) /\ ~(x IN FVT t) then sigmapi b n p else 2 <= n /\ sigmapi (~b) (n - 1) p) /\ (!n b x p. sigmapi b n (!!x p) <=> if ~b /\ ~(n = 0) \/ ?q t. (p = (V x << t --> q) \/ p = (V x <<= t --> q)) /\ ~(x IN FVT t) then sigmapi b n p else 2 <= n /\ sigmapi (~b) (n - 1) p)`, REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SIGMAPI_CLAUSES_CODE] THEN REWRITE_TAC[] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [SIGMAPI_CLAUSES_CODE] THEN ASM_REWRITE_TAC[ARITH_RULE `~(n - 1 = 0) <=> 2 <= n`] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Show that it respects substitution. *) (* ------------------------------------------------------------------------- *) let SIGMAPI_FORMSUBST = prove (`!p v n b. sigmapi b n p ==> sigmapi b n (formsubst v p)`, MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[SIGMAPI_CLAUSES; formsubst] THEN SIMP_TAC[] THEN REWRITE_TAC[AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN MATCH_MP_TAC(TAUT `(a ==> b /\ c) ==> (a ==> b) /\ (a ==> c)`) THEN DISCH_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`i:num->term`; `n:num`; `b:bool`] THEN REWRITE_TAC[FV] THEN LET_TAC THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN REWRITE_TAC[SIGMAPI_CLAUSES] THEN ONCE_REWRITE_TAC[TAUT `((if p \/ q then x else y) ==> (if p \/ q' then x' else y')) <=> (p /\ x ==> x') /\ (~p ==> (if q then x else y) ==> (if q' then x' else y'))`] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(TAUT `(p ==> p') /\ (x ==> x') /\ (y ==> y') /\ (y ==> x) ==> (if p then x else y) ==> (if p' then x' else y')`) THEN ASM_SIMP_TAC[SIGMAPI_MONO_LEMMA; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[formsubst; form_INJ; termsubst] THEN REWRITE_TAC[form_DISTINCT] THEN ONCE_REWRITE_TAC[TAUT `((a /\ b) /\ c) /\ d <=> b /\ c /\ a /\ d`] THEN REWRITE_TAC[UNWIND_THM1; termsubst; VALMOD_BASIC] THEN REWRITE_TAC[TERMSUBST_FVT; IN_ELIM_THM; NOT_EXISTS_THM] THEN X_GEN_TAC `y:num` THEN REWRITE_TAC[valmod] THEN (COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [SYM th]) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[FV; FVT] THEN REWRITE_TAC[IN_DELETE; IN_UNION; IN_SING; GSYM DISJ_ASSOC] THEN REWRITE_TAC[TAUT `(a \/ b \/ c) /\ ~a <=> ~a /\ b \/ ~a /\ c`] THEN (COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN W(fun (asl,w) -> let t = lhand(rand w) in MP_TAC(SPEC (rand(rand t)) VARIANT_THM) THEN SPEC_TAC(t,`u:num`)) THEN REWRITE_TAC[CONTRAPOS_THM; FORMSUBST_FV; IN_ELIM_THM; FV] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `y:num` THEN ASM_REWRITE_TAC[valmod; IN_UNION]);; (* ------------------------------------------------------------------------- *) (* Hence all our main concepts are OK. *) (* ------------------------------------------------------------------------- *) let SIGMAPI_TAC ths = REPEAT STRIP_TAC THEN REWRITE_TAC ths THEN TRY(MATCH_MP_TAC SIGMAPI_FORMSUBST) THEN let ths' = ths @ [SIGMAPI_CLAUSES; form_DISTINCT; form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1; GSYM EXISTS_REFL; FVT; IN_SING; ARITH_EQ] in REWRITE_TAC ths' THEN ASM_SIMP_TAC ths';; let SIGMAPI_DIVIDES = prove (`!n s t. sigmapi b n (arith_divides s t)`, SIGMAPI_TAC[arith_divides]);; let SIGMAPI_PRIME = prove (`!n t. sigmapi b n (arith_prime t)`, SIGMAPI_TAC[arith_prime; SIGMAPI_DIVIDES]);; let SIGMAPI_PRIMEPOW = prove (`!n s t. sigmapi b n (arith_primepow s t)`, SIGMAPI_TAC[arith_primepow; SIGMAPI_DIVIDES; SIGMAPI_PRIME]);; let SIGMAPI_RTC = prove (`(!s t. sigmapi T 1 (R s t)) ==> !s t. sigmapi T 1 (arith_rtc R s t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[arith_rtc] THEN MATCH_MP_TAC SIGMAPI_FORMSUBST THEN REWRITE_TAC[SIGMAPI_CLAUSES; form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1; GSYM EXISTS_REFL; FVT; IN_SING; ARITH_EQ; SIGMAPI_DIVIDES; SIGMAPI_PRIME; SIGMAPI_PRIMEPOW; form_DISTINCT] THEN ASM_REWRITE_TAC[]);; let SIGMAPI_RTCP = prove (`(!s t u. sigmapi T 1 (R s t u)) ==> !s t u. sigmapi T 1 (arith_rtcp R s t u)`, REPEAT STRIP_TAC THEN REWRITE_TAC[arith_rtcp] THEN MATCH_MP_TAC SIGMAPI_FORMSUBST THEN REWRITE_TAC[SIGMAPI_CLAUSES; form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1; GSYM EXISTS_REFL; FVT; IN_SING; ARITH_EQ; SIGMAPI_DIVIDES; SIGMAPI_PRIME; SIGMAPI_PRIMEPOW; form_DISTINCT] THEN ASM_REWRITE_TAC[]);; let SIGMAPI_TERM1 = prove (`!s t. sigmapi T 1 (arith_term1 s t)`, SIGMAPI_TAC[arith_term1]);; let SIGMAPI_TERM = prove (`!t. sigmapi T 1 (arith_term t)`, SIGMAPI_TAC[arith_term; SIGMAPI_RTC; SIGMAPI_TERM1]);; let SIGMAPI_FORM1 = prove (`!s t. sigmapi T 1 (arith_form1 s t)`, SIGMAPI_TAC[arith_form1; SIGMAPI_TERM]);; let SIGMAPI_FORM = prove (`!t. sigmapi T 1 (arith_form t)`, SIGMAPI_TAC[arith_form; SIGMAPI_RTC; SIGMAPI_FORM1]);; let SIGMAPI_FREETERM1 = prove (`!s t u. sigmapi T 1 (arith_freeterm1 s t u)`, SIGMAPI_TAC[arith_freeterm1]);; let SIGMAPI_FREETERM = prove (`!s t. sigmapi T 1 (arith_freeterm s t)`, SIGMAPI_TAC[arith_freeterm; SIGMAPI_FREETERM1; SIGMAPI_RTCP]);; let SIGMAPI_FREEFORM1 = prove (`!s t u. sigmapi T 1 (arith_freeform1 s t u)`, SIGMAPI_TAC[arith_freeform1; SIGMAPI_FREETERM; SIGMAPI_FORM]);; let SIGMAPI_FREEFORM = prove (`!s t. sigmapi T 1 (arith_freeform s t)`, SIGMAPI_TAC[arith_freeform; SIGMAPI_FREEFORM1; SIGMAPI_RTCP]);; let SIGMAPI_AXIOM = prove (`!t. sigmapi T 1 (arith_axiom t)`, SIGMAPI_TAC[arith_axiom; SIGMAPI_FREEFORM; SIGMAPI_FREETERM; SIGMAPI_FORM; SIGMAPI_TERM]);; let SIGMAPI_PROV1 = prove (`!A. (!t. sigmapi T 1 (A t)) ==> !s t. sigmapi T 1 (arith_prov1 A s t)`, SIGMAPI_TAC[arith_prov1; SIGMAPI_AXIOM]);; let SIGMAPI_PROV = prove (`(!t. sigmapi T 1 (A t)) ==> !t. sigmapi T 1 (arith_prov A t)`, SIGMAPI_TAC[arith_prov; SIGMAPI_PROV1; SIGMAPI_RTC]);; let SIGMAPI_PRIMRECSTEP = prove (`(!s t u. sigmapi T 1 (R s t u)) ==> !s t. sigmapi T 1 (arith_primrecstep R s t)`, SIGMAPI_TAC[arith_primrecstep]);; let SIGMAPI_PRIMREC = prove (`(!s t u. sigmapi T 1 (R s t u)) ==> !s t. sigmapi T 1 (arith_primrec R c s t)`, SIGMAPI_TAC[arith_primrec; SIGMAPI_PRIMRECSTEP; SIGMAPI_RTC]);; let SIGMAPI_GNUMERAL1 = prove (`!s t. sigmapi T 1 (arith_gnumeral1 s t)`, SIGMAPI_TAC[arith_gnumeral1]);; let SIGMAPI_GNUMERAL = prove (`!s t. sigmapi T 1 (arith_gnumeral s t)`, SIGMAPI_TAC[arith_gnumeral; arith_gnumeral1'; SIGMAPI_GNUMERAL1; SIGMAPI_RTC]);; let SIGMAPI_QSUBST = prove (`!x n p. sigmapi T 1 p ==> sigmapi T 1 (qsubst(x,n) p)`, SIGMAPI_TAC[qsubst]);; let SIGMAPI_QDIAG = prove (`!x s t. sigmapi T 1 (arith_qdiag x s t)`, SIGMAPI_TAC[arith_qdiag; SIGMAPI_GNUMERAL]);; let SIGMAPI_DIAGONALIZE = prove (`!x p. sigmapi T 1 p ==> sigmapi T 1 (diagonalize x p)`, SIGMAPI_TAC[diagonalize; SIGMAPI_QDIAG; SIGMAPI_FORMSUBST; LET_DEF; LET_END_DEF]);; let SIGMAPI_FIXPOINT = prove (`!x p. sigmapi T 1 p ==> sigmapi T 1 (fixpoint x p)`, SIGMAPI_TAC[fixpoint; qdiag; SIGMAPI_QSUBST; SIGMAPI_DIAGONALIZE]);; (* ------------------------------------------------------------------------- *) (* The Godel sentence, "H" being Sigma and "G" being Pi. *) (* ------------------------------------------------------------------------- *) let hsentence = new_definition `hsentence Arep = fixpoint 0 (arith_prov Arep (arith_pair (numeral 4) (V 0)))`;; let gsentence = new_definition `gsentence Arep = Not(hsentence Arep)`;; let FV_HSENTENCE = prove (`!Arep. (!t. FV(Arep t) = FVT t) ==> (FV(hsentence Arep) = {})`, SIMP_TAC[hsentence; FV_FIXPOINT; FV_PROV] THEN REWRITE_TAC[FVT_PAIR; FVT_NUMERAL; FVT; UNION_EMPTY; DELETE_INSERT; EMPTY_DELETE]);; let FV_GSENTENCE = prove (`!Arep. (!t. FV(Arep t) = FVT t) ==> (FV(gsentence Arep) = {})`, SIMP_TAC[gsentence; FV_HSENTENCE; FV]);; let SIGMAPI_HSENTENCE = prove (`!Arep. (!t. sigmapi T 1 (Arep t)) ==> sigmapi T 1 (hsentence Arep)`, SIGMAPI_TAC[hsentence; SIGMAPI_FIXPOINT; SIGMAPI_PROV]);; let SIGMAPI_GSENTENCE = prove (`!Arep. (!t. sigmapi T 1 (Arep t)) ==> sigmapi F 1 (gsentence Arep)`, SIGMAPI_TAC[gsentence; SIGMAPI_HSENTENCE]);; (* ------------------------------------------------------------------------- *) (* Hence the key fixpoint properties. *) (* ------------------------------------------------------------------------- *) let HSENTENCE_FIX_STRONG = prove (`!A Arep. (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A) ==> !v. holds v (hsentence Arep) <=> A |-- Not(hsentence Arep)`, REWRITE_TAC[hsentence; true_def; HOLDS_FIXPOINT] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ARITH_PROV) THEN REWRITE_TAC[IN] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN DISCH_TAC THEN ASM_REWRITE_TAC[ARITH_PAIR; TERMVAL_NUMERAL] THEN REWRITE_TAC[termval; valmod; GSYM gform] THEN REWRITE_TAC[PROV_THM]);; let HSENTENCE_FIX = prove (`!A Arep. (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A) ==> (true(hsentence Arep) <=> A |-- Not(hsentence Arep))`, REWRITE_TAC[true_def] THEN MESON_TAC[HSENTENCE_FIX_STRONG]);; let GSENTENCE_FIX = prove (`!A Arep. (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A) ==> (true(gsentence Arep) <=> ~(A |-- gsentence Arep))`, REWRITE_TAC[true_def; holds; gsentence] THEN MESON_TAC[HSENTENCE_FIX_STRONG]);; (* ------------------------------------------------------------------------- *) (* Auxiliary concepts. *) (* ------------------------------------------------------------------------- *) let ground = new_definition `ground t <=> (FVT t = {})`;; let complete_for = new_definition `complete_for P A <=> !p. P p /\ true p ==> A |-- p`;; let sound_for = new_definition `sound_for P A <=> !p. P p /\ A |-- p ==> true p`;; let consistent = new_definition `consistent A <=> ~(?p. A |-- p /\ A |-- Not p)`;; let CONSISTENT_ALT = prove (`!A p. A |-- p /\ A |-- Not p <=> A |-- False`, MESON_TAC[proves_RULES; axiom_RULES]);; (* ------------------------------------------------------------------------- *) (* The purest and most symmetric and beautiful form of G1. *) (* ------------------------------------------------------------------------- *) let DEFINABLE_BY_ONEVAR = prove (`definable_by (SIGMA 1) s <=> ?p x. SIGMA 1 p /\ (FV p = {x}) /\ !v. holds v p <=> (v x) IN s`, REWRITE_TAC[definable_by; SIGMA] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `p:form` (X_CHOOSE_TAC `x:num`)) THEN EXISTS_TAC `(V x === V x) && formsubst (\y. if y = x then V x else Z) p` THEN EXISTS_TAC `x:num` THEN ASM_SIMP_TAC[SIGMAPI_CLAUSES; SIGMAPI_FORMSUBST] THEN ASM_REWRITE_TAC[HOLDS_FORMSUBST; FORMSUBST_FV; FV; holds] THEN REWRITE_TAC[COND_RAND; EXTENSION; IN_ELIM_THM; IN_SING; FVT; IN_UNION; COND_EXPAND; NOT_IN_EMPTY; o_THM; termval] THEN MESON_TAC[]);; let CLOSED_NOT_TRUE = prove (`!p. closed p ==> (true(Not p) <=> ~(true p))`, REWRITE_TAC[closed; true_def; holds] THEN MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);; let G1 = prove (`!A. definable_by (SIGMA 1) (IMAGE gform A) ==> ?G. PI 1 G /\ closed G /\ (sound_for (PI 1 INTER closed) A ==> true G /\ ~(A |-- G)) /\ (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`, GEN_TAC THEN REWRITE_TAC[sound_for; INTER; IN_ELIM_THM; DEFINABLE_BY_ONEVAR] THEN DISCH_THEN(X_CHOOSE_THEN `Arep:form` (X_CHOOSE_THEN `a:num` STRIP_ASSUME_TAC)) THEN MP_TAC(SPECL [`A:form->bool`; `\t. formsubst ((a |-> t) V) Arep`] GSENTENCE_FIX) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[HOLDS_FORMSUBST] THEN REWRITE_TAC[termval; valmod; o_THM]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `gsentence (\t. formsubst ((a |-> t) V) Arep)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c /\ d) ==> a /\ b /\ c /\ d`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[PI] THEN MATCH_MP_TAC SIGMAPI_GSENTENCE THEN RULE_ASSUM_TAC(REWRITE_RULE[SIGMA]) THEN ASM_SIMP_TAC[SIGMAPI_FORMSUBST]; REWRITE_TAC[closed] THEN MATCH_MP_TAC FV_GSENTENCE THEN ASM_REWRITE_TAC[FORMSUBST_FV; EXTENSION; IN_ELIM_THM; IN_SING; valmod; UNWIND_THM2]; ALL_TAC] THEN ABBREV_TAC `G = gsentence (\t. formsubst ((a |-> t) V) Arep)` THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN SUBGOAL_THEN `true(Not G)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN REWRITE_TAC[SIGMA; SIGMAPI_CLAUSES] THEN ASM_MESON_TAC[closed; FV; PI]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP CLOSED_NOT_TRUE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `true False` MP_TAC THENL [ALL_TAC; REWRITE_TAC[true_def; holds]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[closed; IN; SIGMA; SIGMAPI_CLAUSES; FV] THEN ASM_MESON_TAC[CONSISTENT_ALT]);; (* ------------------------------------------------------------------------- *) (* Some more familiar variants. *) (* ------------------------------------------------------------------------- *) let COMPLETE_SOUND_SENTENCE = prove (`consistent A /\ complete_for (sigmapi (~b) n INTER closed) A ==> sound_for (sigmapi b n INTER closed) A`, REWRITE_TAC[consistent; sound_for; complete_for; IN; INTER; IN_ELIM_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> X_GEN_TAC `p:form` THEN MP_TAC(SPEC `Not p` th)) THEN REWRITE_TAC[SIGMAPI_CLAUSES] THEN REWRITE_TAC[closed; FV; true_def; holds] THEN ASM_MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);; let G1_TRAD = prove (`!A. consistent A /\ complete_for (SIGMA 1 INTER closed) A /\ definable_by (SIGMA 1) (IMAGE gform A) ==> ?G. PI 1 G /\ closed G /\ true G /\ ~(A |-- G) /\ (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`, REWRITE_TAC[SIGMA] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `A:form->bool` G1) THEN ASM_REWRITE_TAC[SIGMA; PI] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[COMPLETE_SOUND_SENTENCE]);; hol-light/Arithmetic/make.ml000066400000000000000000000023661303454263000163140ustar00rootroot00000000000000prioritize_num();; (* ------------------------------------------------------------------------- *) (* Some additional mathematical background. *) (* ------------------------------------------------------------------------- *) loadt "Library/rstc.ml";; loadt "Library/prime.ml";; (* ------------------------------------------------------------------------- *) (* The basics of first order logic and our inference system. *) (* ------------------------------------------------------------------------- *) loadt "Arithmetic/fol.ml";; (* ------------------------------------------------------------------------- *) (* The incompleteness results. *) (* ------------------------------------------------------------------------- *) loadt "Arithmetic/definability.ml";; loadt "Arithmetic/tarski.ml";; loadt "Arithmetic/arithprov.ml";; loadt "Arithmetic/godel.ml";; (* ------------------------------------------------------------------------- *) (* Sigma-1 completeness of Robinson arithmetic. *) (* ------------------------------------------------------------------------- *) loadt "Arithmetic/derived.ml";; loadt "Arithmetic/sigmacomplete.ml";; hol-light/Arithmetic/pa.ml000066400000000000000000000074641303454263000160030ustar00rootroot00000000000000(* ========================================================================= *) (* Two interesting axiom systems: full Peano Arithmetic and Robinson's Q. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* We define PA as an "inductive" predicate because the pattern-matching *) (* is a bit nicer, but of course we could just define the term explicitly. *) (* In effect, the returned PA_CASES would be our explicit definition. *) (* *) (* The induction axiom is done a little strangely in order to avoid using *) (* substitution as a primitive concept. *) (* ------------------------------------------------------------------------- *) let PA_RULES,PA_INDUCT,PA_CASES = new_inductive_definition `(!s. PA(Not (Z === Suc(s)))) /\ (!s t. PA(Suc(s) === Suc(t) --> s === t)) /\ (!t. PA(t ++ Z === t)) /\ (!s t. PA(s ++ Suc(t) === Suc(s ++ t))) /\ (!t. PA(t ** Z === Z)) /\ (!s t. PA(s ** Suc(t) === s ** t ++ s)) /\ (!p i j. ~(j IN FV(p)) ==> PA ((??i (V i === Z && p)) && (!!j (??i (V i === V j && p) --> ??i (V i === Suc(V j) && p))) --> !!i p))`;; let PA_SOUND = prove (`!A p. (!a. a IN A ==> true a) /\ (PA UNION A) |-- p ==> true p`, REPEAT STRIP_TAC THEN MATCH_MP_TAC THEOREMS_TRUE THEN EXISTS_TAC `PA UNION A` THEN ASM_SIMP_TAC[IN_UNION; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC PA_INDUCT THEN REWRITE_TAC[true_def; holds; termval] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; EXP; SUC_INJ; NOT_SUC] THEN ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`q:form`; `i:num`; `j:num`] THEN ASM_CASES_TAC `j:num = i` THEN ASM_REWRITE_TAC[VALMOD; VALMOD_VALMOD_BASIC] THEN SIMP_TAC[HOLDS_VALMOD_OTHER] THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[UNWIND_THM2] THEN DISCH_TAC THEN SUBGOAL_THEN `!a b v. holds ((i |-> a) ((j |-> b) v)) q <=> holds ((i |-> a) v) q` (fun th -> REWRITE_TAC[th]) THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLDS_VALUATION THEN ASM_REWRITE_TAC[valmod] THEN ASM_MESON_TAC[]; GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Robinson's axiom system Q. *) (* *) (* <<(forall m n. S(m) = S(n) ==> m = n) /\ *) (* (forall n. ~(n = 0) <=> exists m. n = S(m)) /\ *) (* (forall n. 0 + n = n) /\ *) (* (forall m n. S(m) + n = S(m + n)) /\ *) (* (forall n. 0 * n = 0) /\ *) (* (forall m n. S(m) * n = n + m * n) /\ *) (* (forall m n. m <= n <=> exists d. m + d = n) /\ *) (* (forall m n. m < n <=> S(m) <= n)>>;; *) (* ------------------------------------------------------------------------- *) let robinson = new_definition `robinson = (!!0 (!!1 (Suc(V 0) === Suc(V 1) --> V 0 === V 1))) && (!!1 (Not(V 1 === Z) <-> ??0 (V 1 === Suc(V 0)))) && (!!1 (Z ++ V 1 === V 1)) && (!!0 (!!1 (Suc(V 0) ++ V 1 === Suc(V 0 ++ V 1)))) && (!!1 (Z ** V 1 === Z)) && (!!0 (!!1 (Suc(V 0) ** V 1 === V 1 ++ V 0 ** V 1))) && (!!0 (!!1 (V 0 <<= V 1 <-> ??2 (V 0 ++ V 2 === V 1)))) && (!!0 (!!1 (V 0 << V 1 <-> Suc(V 0) <<= V 1)))`;; hol-light/Arithmetic/sigmacomplete.ml000066400000000000000000000773441303454263000202400ustar00rootroot00000000000000(* ========================================================================= *) (* Sigma_1 completeness of Robinson's axioms Q. *) (* ========================================================================= *) let robinson = new_definition `robinson = (!!0 (!!1 (Suc(V 0) === Suc(V 1) --> V 0 === V 1))) && (!!1 (Not(V 1 === Z) <-> ??0 (V 1 === Suc(V 0)))) && (!!1 (Z ++ V 1 === V 1)) && (!!0 (!!1 (Suc(V 0) ++ V 1 === Suc(V 0 ++ V 1)))) && (!!1 (Z ** V 1 === Z)) && (!!0 (!!1 (Suc(V 0) ** V 1 === V 1 ++ V 0 ** V 1))) && (!!0 (!!1 (V 0 <<= V 1 <-> ??2 (V 0 ++ V 2 === V 1)))) && (!!0 (!!1 (V 0 << V 1 <-> Suc(V 0) <<= V 1)))`;; (* ------------------------------------------------------------------------- *) (* Individual "axioms" and their instances. *) (* ------------------------------------------------------------------------- *) let [suc_inj; num_cases; add_0; add_suc; mul_0; mul_suc; le_def; lt_def] = CONJUNCTS(REWRITE_RULE[META_AND] (GEN_REWRITE_RULE RAND_CONV [robinson] (MATCH_MP assume (SET_RULE `robinson IN {robinson}`))));; let suc_inj' = prove (`!s t. {robinson} |-- Suc(s) === Suc(t) --> s === t`, REWRITE_TAC[specl_rule [`s:term`; `t:term`] suc_inj]);; let num_cases' = prove (`!t z. ~(z IN FVT t) ==> {robinson} |-- (Not(t === Z) <-> ??z (t === Suc(V z)))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `t:term` (MATCH_MP spec num_cases)) THEN REWRITE_TAC[formsubst] THEN CONV_TAC(ONCE_DEPTH_CONV TERMSUBST_CONV) THEN REWRITE_TAC[FV; FVT; SET_RULE `({1} UNION {0}) DELETE 0 = {1} DIFF {0}`] THEN REWRITE_TAC[IN_DIFF; IN_SING; UNWIND_THM2; GSYM CONJ_ASSOC; ASSIGN] THEN REWRITE_TAC[ARITH_EQ] THEN LET_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] iff_trans) THEN SUBGOAL_THEN `~(z' IN FVT t)` ASSUME_TAC THENL [EXPAND_TAC "z'" THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> s UNION {a} = s`; VARIANT_FINITE; FVT_FINITE]; MATCH_MP_TAC imp_antisym THEN ASM_CASES_TAC `z':num = z` THEN ASM_REWRITE_TAC[imp_refl] THEN CONJ_TAC THEN MATCH_MP_TAC ichoose THEN ASM_REWRITE_TAC[FV; IN_DELETE; IN_UNION; IN_SING; FVT] THEN MATCH_MP_TAC gen THEN MATCH_MP_TAC imp_trans THENL [EXISTS_TAC `formsubst (z |=> V z') (t === Suc(V z))`; EXISTS_TAC `formsubst (z' |=> V z) (t === Suc(V z'))`] THEN REWRITE_TAC[iexists] THEN REWRITE_TAC[formsubst] THEN ASM_REWRITE_TAC[termsubst; ASSIGN] THEN MATCH_MP_TAC(MESON[imp_refl] `p = q ==> A |-- p --> q`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC TERMSUBST_TRIVIAL THEN REWRITE_TAC[ASSIGN] THEN ASM_MESON_TAC[]]);; let add_0' = prove (`!t. {robinson} |-- Z ++ t === t`, REWRITE_TAC[spec_rule `t:term` add_0]);; let add_suc' = prove (`!s t. {robinson} |-- Suc(s) ++ t === Suc(s ++ t)`, REWRITE_TAC[specl_rule [`s:term`; `t:term`] add_suc]);; let mul_0' = prove (`!t. {robinson} |-- Z ** t === Z`, REWRITE_TAC[spec_rule `t:term` mul_0]);; let mul_suc' = prove (`!s t. {robinson} |-- Suc(s) ** t === t ++ s ** t`, REWRITE_TAC[specl_rule [`s:term`; `t:term`] mul_suc]);; let lt_def' = prove (`!s t. {robinson} |-- (s << t <-> Suc(s) <<= t)`, REWRITE_TAC[specl_rule [`s:term`; `t:term`] lt_def]);; (* ------------------------------------------------------------------------- *) (* All ground terms can be evaluated by proof. *) (* ------------------------------------------------------------------------- *) let SIGMA1_COMPLETE_ADD = prove (`!m n. {robinson} |-- numeral m ++ numeral n === numeral(m + n)`, INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; numeral] THEN ASM_MESON_TAC[add_0'; add_suc'; axiom_funcong; eq_trans; modusponens]);; let SIGMA1_COMPLETE_MUL = prove (`!m n. {robinson} |-- (numeral m ** numeral n === numeral(m * n))`, INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; numeral] THENL [ASM_MESON_TAC[mul_0']; ALL_TAC] THEN GEN_TAC THEN MATCH_MP_TAC eq_trans_rule THEN EXISTS_TAC `numeral(n) ++ numeral(m * n)` THEN CONJ_TAC THENL [ASM_MESON_TAC[mul_suc'; eq_trans_rule; axiom_funcong; imp_trans; modusponens; imp_swap;add_assum; axiom_eqrefl]; ASM_MESON_TAC[SIGMA1_COMPLETE_ADD; ADD_SYM; eq_trans_rule]]);; let SIGMA1_COMPLETE_TERM = prove (`!v t n. FVT t = {} /\ termval v t = n ==> {robinson} |-- (t === numeral n)`, let lemma = prove(`(!n. p /\ (x = n) ==> P n) <=> p ==> P x`,MESON_TAC[]) in GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[termval;FVT; NOT_INSERT_EMPTY] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[numeral] THEN MESON_TAC[axiom_eqrefl; add_assum]; ALL_TAC] THEN REWRITE_TAC[lemma] THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN RULE_ASSUM_TAC(REWRITE_RULE[EMPTY_UNION]) THEN ASM_REWRITE_TAC[numeral] THEN MESON_TAC[SIGMA1_COMPLETE_ADD; SIGMA1_COMPLETE_MUL; cong_suc; cong_add; cong_mul; eq_trans_rule]);; (* ------------------------------------------------------------------------- *) (* Convenient stepping theorems for atoms and other useful lemmas. *) (* ------------------------------------------------------------------------- *) let canonize_clauses = let lemma0 = MESON[imp_refl; imp_swap; modusponens; axiom_doubleneg] `!A p. A |-- (p --> False) --> False <=> A |-- p` and lemma1 = MESON[iff_imp1; iff_imp2; modusponens; imp_trans] `A |-- p <-> q ==> (A |-- p <=> A |-- q) /\ (A |-- p --> False <=> A |-- q --> False)` in itlist (CONJ o MATCH_MP lemma1 o SPEC_ALL) [axiom_true; axiom_not; axiom_and; axiom_or; iff_def; axiom_exists] lemma0 and false_imp = MESON[imp_truefalse; modusponens] `A |-- p /\ A |-- q --> False ==> A |-- (p --> q) --> False` and true_imp = MESON[axiom_addimp; modusponens; ex_falso; imp_trans] `A |-- p --> False \/ A |-- q ==> A |-- p --> q`;; let CANONIZE_TAC = REWRITE_TAC[canonize_clauses; imp_refl] THEN REPEAT((MATCH_MP_TAC false_imp THEN CONJ_TAC) ORELSE MATCH_MP_TAC true_imp THEN REWRITE_TAC[canonize_clauses; imp_refl]);; let suc_inj_eq = prove (`!s t. {robinson} |-- Suc s === Suc t <-> s === t`, MESON_TAC[suc_inj'; axiom_funcong; imp_antisym]);; let suc_le_eq = prove (`!s t. {robinson} |-- Suc s <<= Suc t <-> s <<= t`, gens_tac [0;1] THEN TRANS_TAC iff_trans `??2 (Suc(V 0) ++ V 2 === Suc(V 1))` THEN REWRITE_TAC[itlist spec_rule [`Suc(V 1)`; `Suc(V 0)`] le_def] THEN TRANS_TAC iff_trans `??2 (V 0 ++ V 2 === V 1)` THEN GEN_REWRITE_TAC RAND_CONV [iff_sym] THEN REWRITE_TAC[itlist spec_rule [`V 1`; `V 0`] le_def] THEN MATCH_MP_TAC exiff THEN TRANS_TAC iff_trans `Suc(V 0 ++ V 2) === Suc(V 1)` THEN REWRITE_TAC[suc_inj_eq] THEN MATCH_MP_TAC cong_eq THEN REWRITE_TAC[axiom_eqrefl; add_suc']);; let le_iff_lt = prove (`!s t. {robinson} |-- s <<= t <-> s << Suc t`, REPEAT GEN_TAC THEN TRANS_TAC iff_trans `Suc s <<= Suc t` THEN ONCE_REWRITE_TAC[iff_sym] THEN REWRITE_TAC[suc_le_eq; lt_def']);; let suc_lt_eq = prove (`!s t. {robinson} |-- Suc s << Suc t <-> s << t`, MESON_TAC[iff_sym; iff_trans; le_iff_lt; lt_def']);; let not_suc_eq_0 = prove (`!t. {robinson} |-- Suc t === Z --> False`, gen_tac 1 THEN SUBGOAL_THEN `{robinson} |-- Not(Suc(V 1) === Z)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[canonize_clauses]] THEN SUBGOAL_THEN `{robinson} |-- ?? 0 (Suc(V 1) === Suc(V 0))` MP_TAC THENL [MATCH_MP_TAC exists_intro THEN EXISTS_TAC `V 1` THEN CONV_TAC(RAND_CONV FORMSUBST_CONV) THEN REWRITE_TAC[axiom_eqrefl]; MESON_TAC[iff_imp2; modusponens; spec_rule `Suc(V 1)` num_cases]]);; let not_suc_le_0 = prove (`!t. {robinson} |-- Suc t <<= Z --> False`, X_GEN_TAC `s:term` THEN SUBGOAL_THEN `{robinson} |-- !!0 (Suc(V 0) <<= Z --> False)` MP_TAC THENL [ALL_TAC; DISCH_THEN(ACCEPT_TAC o spec_rule `s:term`)] THEN MATCH_MP_TAC gen THEN SUBGOAL_THEN `{robinson} |-- ?? 2 (Suc (V 0) ++ V 2 === Z) --> False` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN MATCH_MP_TAC iff_imp1 THEN ACCEPT_TAC(itlist spec_rule [`Z`; `Suc(V 0)`] le_def)] THEN MATCH_MP_TAC ichoose THEN REWRITE_TAC[FV; NOT_IN_EMPTY] THEN MATCH_MP_TAC gen THEN TRANS_TAC imp_trans `Suc(V 0 ++ V 2) === Z` THEN REWRITE_TAC[not_suc_eq_0] THEN MATCH_MP_TAC iff_imp1 THEN MATCH_MP_TAC cong_eq THEN REWRITE_TAC[axiom_eqrefl] THEN REWRITE_TAC[add_suc']);; let not_lt_0 = prove (`!t. {robinson} |-- t << Z --> False`, MESON_TAC[not_suc_le_0; lt_def'; imp_trans; iff_imp1]);; (* ------------------------------------------------------------------------- *) (* Evaluation of atoms built from numerals by proof. *) (* ------------------------------------------------------------------------- *) let add_0_right = prove (`!n. {robinson} |-- numeral n ++ Z === numeral n`, GEN_TAC THEN MP_TAC(ISPECL [`n:num`; `0`] SIGMA1_COMPLETE_ADD) THEN REWRITE_TAC[numeral; ADD_CLAUSES]);; let ATOM_EQ_FALSE = prove (`!m n. ~(m = n) ==> {robinson} |-- numeral m === numeral n --> False`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[eq_sym; imp_trans]; ALL_TAC] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN INDUCT_TAC THEN REWRITE_TAC[numeral; not_suc_eq_0; LT_SUC; SUC_INJ] THEN ASM_MESON_TAC[suc_inj_eq; imp_trans; iff_imp1; iff_imp2]);; let ATOM_LE_FALSE = prove (`!m n. n < m ==> {robinson} |-- numeral m <<= numeral n --> False`, INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN INDUCT_TAC THEN REWRITE_TAC[numeral; not_suc_le_0; LT_SUC] THEN ASM_MESON_TAC[suc_le_eq; imp_trans; iff_imp1; iff_imp2]);; let ATOM_LT_FALSE = prove (`!m n. n <= m ==> {robinson} |-- numeral m << numeral n --> False`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LT_SUC_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP ATOM_LE_FALSE) THEN REWRITE_TAC[numeral] THEN ASM_MESON_TAC[lt_def'; imp_trans; iff_imp1; iff_imp2]);; let ATOM_EQ_TRUE = prove (`!m n. m = n ==> {robinson} |-- numeral m === numeral n`, MESON_TAC[axiom_eqrefl]);; let ATOM_LE_TRUE = prove (`!m n. m <= n ==> {robinson} |-- numeral m <<= numeral n`, SUBGOAL_THEN `!m n. {robinson} |-- numeral m <<= numeral(m + n)` MP_TAC THENL [ALL_TAC; MESON_TAC[LE_EXISTS]] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC modusponens THEN EXISTS_TAC `?? 2 (numeral m ++ V 2 === numeral(m + n))` THEN CONJ_TAC THENL [MP_TAC(itlist spec_rule [`numeral(m + n)`; `numeral m`] le_def) THEN MESON_TAC[iff_imp2]; MATCH_MP_TAC exists_intro THEN EXISTS_TAC `numeral n` THEN CONV_TAC(RAND_CONV FORMSUBST_CONV) THEN REWRITE_TAC[SIGMA1_COMPLETE_ADD]]);; let ATOM_LT_TRUE = prove (`!m n. m < n ==> {robinson} |-- numeral m << numeral n`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LE_SUC_LT] THEN DISCH_THEN(MP_TAC o MATCH_MP ATOM_LE_TRUE) THEN REWRITE_TAC[numeral] THEN ASM_MESON_TAC[lt_def'; modusponens; iff_imp1; iff_imp2]);; (* ------------------------------------------------------------------------- *) (* A kind of case analysis rule; might make it induction in case of PA. *) (* ------------------------------------------------------------------------- *) let FORMSUBST_FORMSUBST_SAME_NONE = prove (`!s t x p. FVT t = {x} /\ FVT s = {} ==> formsubst (x |=> s) (formsubst (x |=> t) p) = formsubst (x |=> termsubst (x |=> s) t) p`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!y. safe_for y (x |=> termsubst (x |=> s) t)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[SAFE_FOR_ASSIGN; TERMSUBST_FVT; ASSIGN] THEN ASM SET_TAC[FVT]; ALL_TAC] THEN MATCH_MP_TAC form_INDUCT THEN ASM_SIMP_TAC[FORMSUBST_SAFE_FOR; SAFE_FOR_ASSIGN; IN_SING; NOT_IN_EMPTY] THEN SIMP_TAC[formsubst] THEN MATCH_MP_TAC(TAUT `(p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN BINOP_TAC THEN REWRITE_TAC[TERMSUBST_TERMSUBST] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[o_DEF; FUN_EQ_THM] THEN X_GEN_TAC `y:num` THEN REWRITE_TAC[ASSIGN] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[termsubst; ASSIGN]; CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`y:num`; `p:form`] THEN DISCH_TAC THEN (ASM_CASES_TAC `y:num = x` THENL [ASM_REWRITE_TAC[assign; VALMOD_VALMOD_BASIC] THEN SIMP_TAC[VALMOD_TRIVIAL; FORMSUBST_TRIV]; SUBGOAL_THEN `!u. (y |-> V y) (x |=> u) = (x |=> u)` (fun th -> ASM_REWRITE_TAC[th]) THEN GEN_TAC THEN MATCH_MP_TAC VALMOD_TRIVIAL THEN ASM_REWRITE_TAC[ASSIGN]])]);; let num_cases_rule = prove (`!p x. {robinson} |-- formsubst (x |=> Z) p /\ {robinson} |-- formsubst (x |=> Suc(V x)) p ==> {robinson} |-- p`, let lemma = prove (`!A p x t. A |-- formsubst (x |=> t) p ==> A |-- V x === t --> p`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] modusponens) THEN MATCH_MP_TAC imp_swap THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM FORMSUBST_TRIV] THEN CONV_TAC(funpow 3 RAND_CONV(SUBS_CONV[SYM(SPEC `x:num` ASSIGN_TRIV)])) THEN TRANS_TAC imp_trans `t === V x` THEN REWRITE_TAC[isubst; eq_sym]) in REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM FORMSUBST_TRIV] THEN CONV_TAC(RAND_CONV(SUBS_CONV[SYM(SPEC `x:num` ASSIGN_TRIV)])) THEN SUBGOAL_THEN `?z. ~(z = x) /\ ~(z IN VARS p)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `VARIANT(x INSERT VARS p)` THEN REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM IN_INSERT] THEN MATCH_MP_TAC NOT_IN_VARIANT THEN SIMP_TAC[VARS_FINITE; FINITE_INSERT; SUBSET_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP FORMSUBST_TWICE th)]) THEN SUBGOAL_THEN `~(x IN FV(formsubst (x |=> V z) p))` MP_TAC THENL [REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN; NOT_EXISTS_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FVT] THEN ASM SET_TAC[]; ALL_TAC] THEN SPEC_TAC(`formsubst (x |=> V z) p`,`p:form`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC spec THEN MATCH_MP_TAC gen THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP lemma) THEN DISCH_THEN(MP_TAC o SPEC `x:num` o MATCH_MP gen) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ichoose)) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP lemma) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP ante_disj) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] modusponens) THEN MP_TAC(ISPECL [`V z`; `x:num`] num_cases') THEN ASM_REWRITE_TAC[FVT; IN_SING] THEN DISCH_THEN(MP_TAC o MATCH_MP iff_imp1) THEN REWRITE_TAC[canonize_clauses] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] imp_trans) THEN MESON_TAC[imp_swap; axiom_not; iff_imp1; imp_trans]);; (* ------------------------------------------------------------------------- *) (* Now full Sigma-1 completeness. *) (* ------------------------------------------------------------------------- *) let SIGMAPI1_COMPLETE = prove (`!v p b. sigmapi b 1 p /\ closed p ==> (b /\ holds v p ==> {robinson} |-- p) /\ (~b /\ ~holds v p ==> {robinson} |-- p --> False)`, let lemma1 = prove (`!x n p. (!m. m < n ==> {robinson} |-- formsubst (x |=> numeral m) p) ==> {robinson} |-- !!x (V x << numeral n --> p)`, GEN_TAC THEN INDUCT_TAC THEN X_GEN_TAC `p:form` THEN DISCH_TAC THEN REWRITE_TAC[numeral] THENL [ASM_MESON_TAC[gen; imp_trans; ex_falso; not_lt_0]; ALL_TAC] THEN MATCH_MP_TAC gen THEN MATCH_MP_TAC num_cases_rule THEN EXISTS_TAC `x:num` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[formsubst] THEN MATCH_MP_TAC add_assum THEN REWRITE_TAC[GSYM numeral] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[formsubst; termsubst; TERMSUBST_NUMERAL; ASSIGN] THEN TRANS_TAC imp_trans `V x << numeral n` THEN CONJ_TAC THENL [MESON_TAC[suc_lt_eq; iff_imp1]; ALL_TAC] THEN MATCH_MP_TAC spec_var THEN EXISTS_TAC `x:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC m`) THEN ASM_REWRITE_TAC[LT_SUC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) FORMSUBST_FORMSUBST_SAME_NONE o rand o snd) THEN REWRITE_TAC[FVT; FVT_NUMERAL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[termsubst; ASSIGN; numeral]) in let lemma2 = prove (`!x n p. (!m. m <= n ==> {robinson} |-- formsubst (x |=> numeral m) p) ==> {robinson} |-- !!x (V x <<= numeral n --> p)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`x:num`; `SUC n`; `p:form`] lemma1) THEN ASM_REWRITE_TAC[LT_SUC_LE] THEN DISCH_TAC THEN MATCH_MP_TAC gen THEN FIRST_ASSUM(MP_TAC o MATCH_MP spec_var) THEN REWRITE_TAC[numeral] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN MESON_TAC[iff_imp1; le_iff_lt]) in let lemma3 = prove (`!v x t p. FVT t = {} /\ (!m. m < termval v t ==> {robinson} |-- formsubst (x |=> numeral m) p) ==> {robinson} |-- !!x (V x << t --> p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC gen THEN FIRST_ASSUM(MP_TAC o MATCH_MP spec_var o MATCH_MP lemma1) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN MATCH_MP_TAC iff_imp1 THEN MATCH_MP_TAC cong_lt THEN REWRITE_TAC[axiom_eqrefl] THEN MATCH_MP_TAC SIGMA1_COMPLETE_TERM THEN ASM_MESON_TAC[]) and lemma4 = prove (`!v x t p. FVT t = {} /\ (!m. m <= termval v t ==> {robinson} |-- formsubst (x |=> numeral m) p) ==> {robinson} |-- !!x (V x <<= t --> p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC gen THEN FIRST_ASSUM(MP_TAC o MATCH_MP spec_var o MATCH_MP lemma2) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN MATCH_MP_TAC iff_imp1 THEN MATCH_MP_TAC cong_le THEN REWRITE_TAC[axiom_eqrefl] THEN MATCH_MP_TAC SIGMA1_COMPLETE_TERM THEN ASM_MESON_TAC[]) and lemma5 = prove (`!A x p q. A |-- !!x (p --> Not q) ==> A |-- !!x (Not(p && q))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC gen THEN FIRST_ASSUM(MP_TAC o MATCH_MP spec_var) THEN REWRITE_TAC[canonize_clauses] THEN MESON_TAC[imp_trans; axiom_not; iff_imp1; iff_imp2]) in GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[closed] THEN WF_INDUCT_TAC `complexity p` THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`p:form`,`p:form`) THEN MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[SIGMAPI_CLAUSES; complexity; ARITH] THEN REWRITE_TAC[MESON[] `(if p then q else F) <=> p /\ q`] THEN ONCE_REWRITE_TAC [TAUT `a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ k /\ l <=> (a /\ b) /\ (c /\ d /\ e) /\ f /\ (g /\ h /\ i /\ j) /\ (k /\ l)`] THEN CONJ_TAC THENL [CONJ_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[holds] THEN MESON_TAC[imp_refl; truth]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`s:term`; `t:term`] THEN DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `b:bool` THEN REWRITE_TAC[FV; EMPTY_UNION] THEN STRIP_TAC THEN MP_TAC(ISPECL [`v:num->num`; `t:term`; `termval v t`] SIGMA1_COMPLETE_TERM) THEN MP_TAC(ISPECL [`v:num->num`; `s:term`; `termval v s`] SIGMA1_COMPLETE_TERM) THEN ASM_REWRITE_TAC[IMP_IMP] THENL [DISCH_THEN(MP_TAC o MATCH_MP cong_eq); DISCH_THEN(MP_TAC o MATCH_MP cong_lt); DISCH_THEN(MP_TAC o MATCH_MP cong_le)] THEN STRIP_TAC THEN REWRITE_TAC[holds; NOT_LE; NOT_LT] THEN (REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] modusponens) o MATCH_MP iff_imp2); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] imp_trans) o MATCH_MP iff_imp1)]) THEN ASM_SIMP_TAC[ATOM_EQ_FALSE; ATOM_EQ_TRUE; ATOM_LT_FALSE; ATOM_LT_TRUE; ATOM_LE_FALSE; ATOM_LE_TRUE]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `p:form` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o SPEC `p:form`) THEN ANTS_TAC THENL [ARITH_TAC; DISCH_TAC] THEN X_GEN_TAC `b:bool` THEN REWRITE_TAC[FV] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `~b`) THEN ASM_REWRITE_TAC[holds] THEN BOOL_CASES_TAC `b:bool` THEN CANONIZE_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN X_GEN_TAC `b:bool` THEN REWRITE_TAC[FV; EMPTY_UNION] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `p:form` th) THEN MP_TAC(SPEC `q:form` th)) THEN (ANTS_TAC THENL [ARITH_TAC; ALL_TAC]) THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN (ANTS_TAC THENL [ARITH_TAC; ASM_REWRITE_TAC[IMP_IMP]]) THEN ASM_REWRITE_TAC[holds; canonize_clauses] THENL [DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `b:bool`)); DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `b:bool`)); DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `~b`) (MP_TAC o SPEC `b:bool`)); DISCH_THEN(CONJUNCTS_THEN(fun th -> MP_TAC(SPEC `~b` th) THEN MP_TAC(SPEC `b:bool` th)))] THEN ASM_REWRITE_TAC[] THEN BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CANONIZE_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `~(p <=> q) ==> (p /\ ~q ==> r) /\ (~p /\ q ==> s) ==> r \/ s`)) THEN REPEAT STRIP_TAC THEN CANONIZE_TAC) THEN ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[canonize_clauses; holds] THEN DISCH_TAC THEN X_GEN_TAC `b:bool` THENL [BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; FV] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q:form`; `t:term`] THEN DISCH_THEN (CONJUNCTS_THEN2 (DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THEN REWRITE_TAC[SIGMAPI_CLAUSES; FV; holds] THEN (ASM_CASES_TAC `FVT t = {}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN (ASM_CASES_TAC `FV(q) SUBSET {x}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT2)) THEN ABBREV_TAC `n = termval v t` THEN ASM_SIMP_TAC[TERMVAL_VALMOD_OTHER; termval; VALMOD] THENL [DISCH_TAC THEN MATCH_MP_TAC lemma3; DISCH_TAC THEN MATCH_MP_TAC lemma4] THEN EXISTS_TAC `v:num->num` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral m) q`) THEN REWRITE_TAC[complexity; COMPLEXITY_FORMSUBST] THEN (ANTS_TAC THENL [ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `T`)]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SIGMAPI_FORMSUBST] THEN REWRITE_TAC[FORMSUBST_FV; ASSIGN] THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN REWRITE_TAC[FVT_NUMERAL; NOT_IN_EMPTY; FVT; IN_SING] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HOLDS_FORMSUBST] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN X_GEN_TAC `y:num` THEN (ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]]) THEN ASM_REWRITE_TAC[o_DEF; ASSIGN; VALMOD; TERMVAL_NUMERAL]; STRIP_TAC THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC imp_trans THEN EXISTS_TAC `formsubst (x |=> numeral n) p` THEN REWRITE_TAC[ispec] THEN FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral n) p`) THEN REWRITE_TAC[COMPLEXITY_FORMSUBST; ARITH_RULE `n < n + 1`] THEN DISCH_THEN(MP_TAC o SPEC `F`) THEN ASM_SIMP_TAC[SIGMAPI_FORMSUBST; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [UNDISCH_TAC `FV (!! x p) = {}` THEN REWRITE_TAC[FV; FORMSUBST_FV; SET_RULE `s DELETE a = {} <=> s = {} \/ s = {a}`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_SING; EMPTY_GSPEC; ASSIGN; UNWIND_THM2; FVT_NUMERAL]; UNDISCH_TAC `~holds((x |-> n) v) p` THEN REWRITE_TAC[HOLDS_FORMSUBST; CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN RULE_ASSUM_TAC(REWRITE_RULE[FV]) THEN X_GEN_TAC `y:num` THEN ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[o_THM; ASSIGN; VALMOD; TERMVAL_NUMERAL]]]; BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[FV] THEN STRIP_TAC THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral n) (Not p)`) THEN REWRITE_TAC[COMPLEXITY_FORMSUBST; complexity] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `F`)] THEN ASM_SIMP_TAC[IMP_IMP; SIGMAPI_CLAUSES; SIGMAPI_FORMSUBST] THEN ANTS_TAC THENL [REWRITE_TAC[FORMSUBST_FV; ASSIGN] THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN REWRITE_TAC[FVT_NUMERAL; NOT_IN_EMPTY; FVT; FV; IN_SING] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN UNDISCH_TAC `holds ((x |-> n) v) p` THEN REWRITE_TAC[formsubst; holds; HOLDS_FORMSUBST] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN RULE_ASSUM_TAC(REWRITE_RULE[FV]) THEN X_GEN_TAC `y:num` THEN ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[o_THM; ASSIGN; VALMOD; TERMVAL_NUMERAL]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN REWRITE_TAC[ispec]]; REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; FV] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q:form`; `t:term`] THEN DISCH_THEN (CONJUNCTS_THEN2 (DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THEN REWRITE_TAC[SIGMAPI_CLAUSES; FV; holds] THEN (ASM_CASES_TAC `FVT t = {}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN (ASM_CASES_TAC `FV(q) SUBSET {x}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT2)) THEN ABBREV_TAC `n = termval v t` THEN ASM_SIMP_TAC[TERMVAL_VALMOD_OTHER; termval; VALMOD] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN DISCH_TAC THEN MATCH_MP_TAC lemma5 THENL [MATCH_MP_TAC lemma3; MATCH_MP_TAC lemma4] THEN EXISTS_TAC `v:num->num` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral m) (Not q)`) THEN REWRITE_TAC[complexity; COMPLEXITY_FORMSUBST] THEN (ANTS_TAC THENL [ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `T`)]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SIGMAPI_FORMSUBST; SIGMAPI_CLAUSES] THEN REWRITE_TAC[FORMSUBST_FV; FV; ASSIGN] THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN REWRITE_TAC[FVT_NUMERAL; NOT_IN_EMPTY; FVT; IN_SING] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HOLDS_FORMSUBST; holds; CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN X_GEN_TAC `y:num` THEN (ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]]) THEN ASM_REWRITE_TAC[o_DEF; ASSIGN; VALMOD; TERMVAL_NUMERAL]]]);; (* ------------------------------------------------------------------------- *) (* Hence a nice alternative form of Goedel's theorem for any consistent *) (* sigma_1-definable axioms A that extend (i.e. prove) the Robinson axioms. *) (* ------------------------------------------------------------------------- *) let G1_ROBINSON = prove (`!A. definable_by (SIGMA 1) (IMAGE gform A) /\ consistent A /\ A |-- robinson ==> ?G. PI 1 G /\ closed G /\ true G /\ ~(A |-- G) /\ (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC G1_TRAD THEN ASM_REWRITE_TAC[complete_for; INTER; IN_ELIM_THM] THEN X_GEN_TAC `p:form` THEN REWRITE_TAC[IN; true_def] THEN STRIP_TAC THEN MATCH_MP_TAC modusponens THEN EXISTS_TAC `robinson` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PROVES_MONO THEN EXISTS_TAC `{}:form->bool` THEN REWRITE_TAC[EMPTY_SUBSET] THEN W(MP_TAC o PART_MATCH (lhs o rand) DEDUCTION o snd) THEN MP_TAC(ISPECL [`I:num->num`; `p:form`; `T`] SIGMAPI1_COMPLETE) THEN ASM_REWRITE_TAC[GSYM SIGMA] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[robinson; closed; FV; FVT] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* More metaproperties of axioms systems now we have some derived rules. *) (* ------------------------------------------------------------------------- *) let complete = new_definition `complete A <=> !p. closed p ==> A |-- p \/ A |-- Not p`;; let sound = new_definition `sound A <=> !p. A |-- p ==> true p`;; let semcomplete = new_definition `semcomplete A <=> !p. true p ==> A |-- p`;; let generalize = new_definition `generalize vs p = ITLIST (!!) vs p`;; let closure = new_definition `closure p = generalize (list_of_set(FV p)) p`;; let TRUE_GENERALIZE = prove (`!vs p. true(generalize vs p) <=> true p`, REWRITE_TAC[generalize; true_def] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ITLIST; holds] THEN GEN_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MESON_TAC[VALMOD_REPEAT]);; let PROVABLE_GENERALIZE = prove (`!A p vs. A |-- generalize vs p <=> A |-- p`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[generalize] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ITLIST] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MESON_TAC[spec; gen; FORMSUBST_TRIV; ASSIGN_TRIV]);; let FV_GENERALIZE = prove (`!p vs. FV(generalize vs p) = FV(p) DIFF (set_of_list vs)`, GEN_TAC THEN REWRITE_TAC[generalize] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[set_of_list; DIFF_EMPTY; ITLIST] THEN ASM_REWRITE_TAC[FV] THEN SET_TAC[]);; let CLOSED_CLOSURE = prove (`!p. closed(closure p)`, REWRITE_TAC[closed; closure; FV_GENERALIZE] THEN SIMP_TAC[SET_OF_LIST_OF_SET; FV_FINITE; DIFF_EQ_EMPTY]);; let TRUE_CLOSURE = prove (`!p. true(closure p) <=> true p`, REWRITE_TAC[closure; TRUE_GENERALIZE]);; let PROVABLE_CLOSURE = prove (`!A p. A |-- closure p <=> A |-- p`, REWRITE_TAC[closure; PROVABLE_GENERALIZE]);; let DEFINABLE_DEFINABLE_BY = prove (`definable = definable_by (\x. T)`, REWRITE_TAC[FUN_EQ_THM; definable; definable_by]);; let DEFINABLE_ONEVAR = prove (`definable s <=> ?p x. (FV p = {x}) /\ !v. holds v p <=> (v x) IN s`, REWRITE_TAC[definable] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `p:form` (X_CHOOSE_TAC `x:num`)) THEN EXISTS_TAC `(V x === V x) && formsubst (\y. if y = x then V x else Z) p` THEN EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[HOLDS_FORMSUBST; FORMSUBST_FV; FV; holds] THEN REWRITE_TAC[COND_RAND; EXTENSION; IN_ELIM_THM; IN_SING; FVT; IN_UNION; COND_EXPAND; NOT_IN_EMPTY; o_THM; termval] THEN MESON_TAC[]);; let CLOSED_TRUE_OR_FALSE = prove (`!p. closed p ==> true p \/ true(Not p)`, REWRITE_TAC[closed; true_def; holds] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);; let SEMCOMPLETE_IMP_COMPLETE = prove (`!A. semcomplete A ==> complete A`, REWRITE_TAC[semcomplete; complete] THEN MESON_TAC[CLOSED_TRUE_OR_FALSE]);; let SOUND_CLOSED = prove (`sound A <=> !p. closed p /\ A |-- p ==> true p`, REWRITE_TAC[sound] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MESON_TAC[TRUE_CLOSURE; PROVABLE_CLOSURE; CLOSED_CLOSURE]);; let SOUND_IMP_CONSISTENT = prove (`!A. sound A ==> consistent A`, REWRITE_TAC[sound; consistent; CONSISTENT_ALT] THEN SUBGOAL_THEN `~(true False)` (fun th -> MESON_TAC[th]) THEN REWRITE_TAC[true_def; holds]);; let SEMCOMPLETE_SOUND_EQ_CONSISTENT = prove (`!A. semcomplete A ==> (sound A <=> consistent A)`, REWRITE_TAC[semcomplete] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[SOUND_IMP_CONSISTENT] THEN REWRITE_TAC[consistent; SOUND_CLOSED] THEN ASM_MESON_TAC[CLOSED_TRUE_OR_FALSE]);; hol-light/Arithmetic/tarski.ml000066400000000000000000000345571303454263000167030ustar00rootroot00000000000000(* ========================================================================= *) (* Arithmetization of syntax and Tarski's theorem. *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* This is to fake the fact that we might really be using strings. *) (* ------------------------------------------------------------------------- *) let number = new_definition `number(x) = 2 * (x DIV 2) + (1 - x MOD 2)`;; let denumber = new_definition `denumber = number`;; let NUMBER_DENUMBER = prove (`(!s. denumber(number s) = s) /\ (!n. number(denumber n) = n)`, REWRITE_TAC[number; denumber] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN SIMP_TAC[ARITH_RULE `x < 2 ==> (2 * y + x) DIV 2 = y`; MOD_MULT_ADD; MOD_LT; GSYM DIVISION; ARITH_EQ; ARITH_RULE `1 - m < 2`; ARITH_RULE `x < 2 ==> 1 - (1 - x) = x`]);; let NUMBER_INJ = prove (`!x y. number(x) = number(y) <=> x = y`, MESON_TAC[NUMBER_DENUMBER]);; let NUMBER_SURJ = prove (`!y. ?x. number(x) = y`, MESON_TAC[NUMBER_DENUMBER]);; (* ------------------------------------------------------------------------- *) (* Arithmetization. *) (* ------------------------------------------------------------------------- *) let gterm = new_recursive_definition term_RECURSION `(gterm (V x) = NPAIR 0 (number x)) /\ (gterm Z = NPAIR 1 0) /\ (gterm (Suc t) = NPAIR 2 (gterm t)) /\ (gterm (s ++ t) = NPAIR 3 (NPAIR (gterm s) (gterm t))) /\ (gterm (s ** t) = NPAIR 4 (NPAIR (gterm s) (gterm t)))`;; let gform = new_recursive_definition form_RECURSION `(gform False = NPAIR 0 0) /\ (gform True = NPAIR 0 1) /\ (gform (s === t) = NPAIR 1 (NPAIR (gterm s) (gterm t))) /\ (gform (s << t) = NPAIR 2 (NPAIR (gterm s) (gterm t))) /\ (gform (s <<= t) = NPAIR 3 (NPAIR (gterm s) (gterm t))) /\ (gform (Not p) = NPAIR 4 (gform p)) /\ (gform (p && q) = NPAIR 5 (NPAIR (gform p) (gform q))) /\ (gform (p || q) = NPAIR 6 (NPAIR (gform p) (gform q))) /\ (gform (p --> q) = NPAIR 7 (NPAIR (gform p) (gform q))) /\ (gform (p <-> q) = NPAIR 8 (NPAIR (gform p) (gform q))) /\ (gform (!! x p) = NPAIR 9 (NPAIR (number x) (gform p))) /\ (gform (?? x p) = NPAIR 10 (NPAIR (number x) (gform p)))`;; (* ------------------------------------------------------------------------- *) (* Injectivity. *) (* ------------------------------------------------------------------------- *) let GTERM_INJ = prove (`!s t. (gterm s = gterm t) <=> (s = t)`, MATCH_MP_TAC term_INDUCT THEN REPEAT CONJ_TAC THENL [ALL_TAC; GEN_TAC; GEN_TAC THEN DISCH_TAC; REPEAT GEN_TAC THEN STRIP_TAC; REPEAT GEN_TAC THEN STRIP_TAC] THEN MATCH_MP_TAC term_INDUCT THEN ASM_REWRITE_TAC[term_DISTINCT; term_INJ; gterm; NPAIR_INJ; NUMBER_INJ; ARITH_EQ]);; let GFORM_INJ = prove (`!p q. (gform p = gform q) <=> (p = q)`, MATCH_MP_TAC form_INDUCT THEN REPEAT CONJ_TAC THENL [ALL_TAC; ALL_TAC; GEN_TAC THEN GEN_TAC; GEN_TAC THEN GEN_TAC; GEN_TAC THEN GEN_TAC; REPEAT GEN_TAC THEN STRIP_TAC; REPEAT GEN_TAC THEN STRIP_TAC; REPEAT GEN_TAC THEN STRIP_TAC; REPEAT GEN_TAC THEN STRIP_TAC; REPEAT GEN_TAC THEN STRIP_TAC; REPEAT GEN_TAC THEN STRIP_TAC; REPEAT GEN_TAC THEN STRIP_TAC] THEN MATCH_MP_TAC form_INDUCT THEN ASM_REWRITE_TAC[form_DISTINCT; form_INJ; gform; NPAIR_INJ; ARITH_EQ] THEN REWRITE_TAC[GTERM_INJ; NUMBER_INJ]);; (* ------------------------------------------------------------------------- *) (* Useful case theorems. *) (* ------------------------------------------------------------------------- *) let GTERM_CASES = prove (`((gterm u = NPAIR 0 (number x)) <=> (u = V x)) /\ ((gterm u = NPAIR 1 0) <=> (u = Z)) /\ ((gterm u = NPAIR 2 n) <=> (?t. (u = Suc t) /\ (gterm t = n))) /\ ((gterm u = NPAIR 3 (NPAIR m n)) <=> (?s t. (u = s ++ t) /\ (gterm s = m) /\ (gterm t = n))) /\ ((gterm u = NPAIR 4 (NPAIR m n)) <=> (?s t. (u = s ** t) /\ (gterm s = m) /\ (gterm t = n)))`, STRUCT_CASES_TAC(SPEC `u:term` term_CASES) THEN ASM_REWRITE_TAC[gterm; NPAIR_INJ; ARITH_EQ; NUMBER_INJ; term_DISTINCT; term_INJ] THEN MESON_TAC[]);; let GFORM_CASES = prove (`((gform r = NPAIR 0 0) <=> (r = False)) /\ ((gform r = NPAIR 0 1) <=> (r = True)) /\ ((gform r = NPAIR 1 (NPAIR m n)) <=> (?s t. (r = s === t) /\ (gterm s = m) /\ (gterm t = n))) /\ ((gform r = NPAIR 2 (NPAIR m n)) <=> (?s t. (r = s << t) /\ (gterm s = m) /\ (gterm t = n))) /\ ((gform r = NPAIR 3 (NPAIR m n)) <=> (?s t. (r = s <<= t) /\ (gterm s = m) /\ (gterm t = n))) /\ ((gform r = NPAIR 4 n) = (?p. (r = Not p) /\ (gform p = n))) /\ ((gform r = NPAIR 5 (NPAIR m n)) <=> (?p q. (r = p && q) /\ (gform p = m) /\ (gform q = n))) /\ ((gform r = NPAIR 6 (NPAIR m n)) <=> (?p q. (r = p || q) /\ (gform p = m) /\ (gform q = n))) /\ ((gform r = NPAIR 7 (NPAIR m n)) <=> (?p q. (r = p --> q) /\ (gform p = m) /\ (gform q = n))) /\ ((gform r = NPAIR 8 (NPAIR m n)) <=> (?p q. (r = p <-> q) /\ (gform p = m) /\ (gform q = n))) /\ ((gform r = NPAIR 9 (NPAIR (number x) n)) <=> (?p. (r = !!x p) /\ (gform p = n))) /\ ((gform r = NPAIR 10 (NPAIR (number x) n)) <=> (?p. (r = ??x p) /\ (gform p = n)))`, STRUCT_CASES_TAC(SPEC `r:form` form_CASES) THEN ASM_REWRITE_TAC[gform; NPAIR_INJ; ARITH_EQ; NUMBER_INJ; form_DISTINCT; form_INJ] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Definability of "godel number of numeral n". *) (* ------------------------------------------------------------------------- *) let gnumeral = new_definition `gnumeral m n = (gterm(numeral m) = n)`;; let arith_gnumeral1 = new_definition `arith_gnumeral1 a b = formsubst ((3 |-> a) ((4 |-> b) V)) (??0 (??1 (V 3 === arith_pair (V 0) (V 1) && V 4 === arith_pair (Suc(V 0)) (arith_pair (numeral 2) (V 1)))))`;; let ARITH_GNUMERAL1 = prove (`!v a b. holds v (arith_gnumeral1 a b) <=> ?x y. termval v a = NPAIR x y /\ termval v b = NPAIR (SUC x) (NPAIR 2 y)`, REWRITE_TAC[arith_gnumeral1; holds; HOLDS_FORMSUBST] THEN REWRITE_TAC[termval; ARITH_EQ; o_THM; valmod; ARITH_PAIR; TERMVAL_NUMERAL]);; let FV_GNUMERAL1 = prove (`!s t. FV(arith_gnumeral1 s t) = FVT s UNION FVT t`, REWRITE_TAC[arith_gnumeral1] THEN FV_TAC[FVT_PAIR; FVT_NUMERAL]);; let arith_gnumeral1' = new_definition `arith_gnumeral1' x y = arith_rtc arith_gnumeral1 x y`;; let ARITH_GNUMERAL1' = prove (`!v s t. holds v (arith_gnumeral1' s t) <=> RTC (\a b. ?x y. a = NPAIR x y /\ b = NPAIR (SUC x) (NPAIR 2 y)) (termval v s) (termval v t)`, REWRITE_TAC[arith_gnumeral1'] THEN MATCH_MP_TAC ARITH_RTC THEN REWRITE_TAC[ARITH_GNUMERAL1]);; let FV_GNUMERAL1' = prove (`!s t. FV(arith_gnumeral1' s t) = FVT s UNION FVT t`, SIMP_TAC[arith_gnumeral1'; FV_RTC; FV_GNUMERAL1]);; let arith_gnumeral = new_definition `arith_gnumeral n p = formsubst ((0 |-> n) ((1 |-> p) V)) (arith_gnumeral1' (arith_pair Z (numeral 3)) (arith_pair (V 0) (V 1)))`;; let ARITH_GNUMERAL = prove (`!v s t. holds v (arith_gnumeral s t) <=> gnumeral (termval v s) (termval v t)`, REWRITE_TAC[arith_gnumeral; holds; HOLDS_FORMSUBST; ARITH_GNUMERAL1'; ARITH_PAIR; TERMVAL_NUMERAL] THEN REWRITE_TAC[termval; ARITH_EQ; o_THM; valmod] THEN MP_TAC(INST [`(gterm o numeral)`,`fn:num->num`; `3`,`e:num`; `\a:num b:num. NPAIR 2 a`,`f:num->num->num`] PRIMREC_SIGMA) THEN ANTS_TAC THENL [REWRITE_TAC[gterm; numeral; o_THM] THEN REWRITE_TAC[NPAIR; ARITH]; SIMP_TAC[gnumeral; o_THM]]);; let FV_GNUMERAL = prove (`!s t. FV(arith_gnumeral s t) = FVT(s) UNION FVT(t)`, REWRITE_TAC[arith_gnumeral] THEN FV_TAC[FV_GNUMERAL1'; FVT_PAIR; FVT_NUMERAL]);; (* ------------------------------------------------------------------------- *) (* Diagonal substitution. *) (* ------------------------------------------------------------------------- *) let qdiag = new_definition `qdiag x q = qsubst (x,numeral(gform q)) q`;; let arith_qdiag = new_definition `arith_qdiag x s t = formsubst ((1 |-> s) ((2 |-> t) V)) (?? 3 (arith_gnumeral (V 1) (V 3) && arith_pair (numeral 10) (arith_pair (numeral(number x)) (arith_pair (numeral 5) (arith_pair (arith_pair (numeral 1) (arith_pair (arith_pair (numeral 0) (numeral(number x))) (V 3))) (V 1)))) === V 2))`;; let QDIAG_FV = prove (`FV(qdiag x q) = FV(q) DELETE x`, REWRITE_TAC[qdiag; FV_QSUBST; FVT_NUMERAL; UNION_EMPTY]);; let HOLDS_QDIAG = prove (`!v x q. holds v (qdiag x q) = holds ((x |-> gform q) v) q`, SIMP_TAC[qdiag; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY; TERMVAL_NUMERAL]);; let ARITH_QDIAG = prove (`(termval v s = gform p) ==> (holds v (arith_qdiag x s t) <=> (termval v t = gform(qdiag x p)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[qdiag; qsubst; arith_qdiag; gform; gterm] THEN ASM_REWRITE_TAC[HOLDS_FORMSUBST; holds; termval; TERMVAL_NUMERAL; gnumeral; ARITH_GNUMERAL; ARITH_PAIR] THEN ASM_REWRITE_TAC[o_DEF; valmod; ARITH_EQ; termval] THEN MESON_TAC[]);; let FV_QDIAG = prove (`!x s t. FV(arith_qdiag x s t) = FVT(s) UNION FVT(t)`, REWRITE_TAC[arith_qdiag; FORMSUBST_FV; FV; FV_GNUMERAL; FVT_PAIR; UNION_EMPTY; FVT_NUMERAL; FVT; TERMSUBST_FVT] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[DISJ_ACI; IN_DELETE; IN_UNION; IN_SING] THEN REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC; UNWIND_THM2; ARITH_EQ] THEN REWRITE_TAC[valmod; ARITH_EQ; DISJ_ACI]);; (* ------------------------------------------------------------------------- *) (* Hence diagonalization of a predicate. *) (* ------------------------------------------------------------------------- *) let diagonalize = new_definition `diagonalize x q = let y = VARIANT(x INSERT FV(q)) in ??y (arith_qdiag x (V x) (V y) && formsubst ((x |-> V y) V) q)`;; let FV_DIAGONALIZE = prove (`!x q. FV(diagonalize x q) = x INSERT (FV q)`, REPEAT GEN_TAC THEN REWRITE_TAC[diagonalize] THEN LET_TAC THEN REWRITE_TAC[FV; FV_QDIAG; FORMSUBST_FV; EXTENSION; IN_INSERT; IN_DELETE; IN_UNION; IN_ELIM_THM; FVT; NOT_IN_EMPTY] THEN X_GEN_TAC `u:num` THEN SUBGOAL_THEN `~(y = x) /\ !z. z IN FV(q) ==> ~(y = z)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT]; ALL_TAC] THEN ASM_CASES_TAC `u:num = x` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `u:num = y` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[valmod; COND_RAND; FVT; IN_SING; COND_EXPAND] THEN ASM_MESON_TAC[]);; let ARITH_DIAGONALIZE = prove (`(v x = gform p) ==> !q. holds v (diagonalize x q) <=> holds ((x |-> gform(qdiag x p)) v) q`, REPEAT STRIP_TAC THEN REWRITE_TAC[diagonalize] THEN LET_TAC THEN REWRITE_TAC[holds] THEN SUBGOAL_THEN `!a. holds ((y |-> a) v) (arith_qdiag x (V x) (V y)) <=> (termval ((y |-> a) v) (V y) = gform(qdiag x p))` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC ARITH_QDIAG THEN REWRITE_TAC[termval; valmod] THEN SUBGOAL_THEN `~(x:num = y)` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT]; ALL_TAC] THEN REWRITE_TAC[HOLDS_FORMSUBST; termval; VALMOD_BASIC; UNWIND_THM2] THEN MATCH_MP_TAC HOLDS_VALUATION THEN X_GEN_TAC `u:num` THEN DISCH_TAC THEN REWRITE_TAC[o_THM; termval; valmod] THEN COND_CASES_TAC THEN REWRITE_TAC[termval] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT]);; (* ------------------------------------------------------------------------- *) (* And hence the fixed point. *) (* ------------------------------------------------------------------------- *) let fixpoint = new_definition `fixpoint x q = qdiag x (diagonalize x q)`;; let FV_FIXPOINT = prove (`!x p. FV(fixpoint x p) = FV(p) DELETE x`, REWRITE_TAC[fixpoint; FV_QDIAG; QDIAG_FV; FV_DIAGONALIZE; FVT_NUMERAL] THEN SET_TAC[]);; let HOLDS_FIXPOINT = prove (`!x p v. holds v (fixpoint x p) <=> holds ((x |-> gform(fixpoint x p)) v) p`, REPEAT GEN_TAC THEN SIMP_TAC[fixpoint; holds; HOLDS_QDIAG] THEN SUBGOAL_THEN `((x |-> gform(diagonalize x p)) v) x = gform (diagonalize x p)` MP_TAC THENL [REWRITE_TAC[VALMOD_BASIC]; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ARITH_DIAGONALIZE th]) THEN REWRITE_TAC[VALMOD_VALMOD_BASIC]);; let HOLDS_IFF_FIXPOINT = prove (`!x p v. holds v (fixpoint x p <-> qsubst (x,numeral(gform(fixpoint x p))) p)`, SIMP_TAC[holds; HOLDS_FIXPOINT; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY; TERMVAL_NUMERAL]);; let CARNAP = prove (`!x q. ?p. (FV(p) = FV(q) DELETE x) /\ true (p <-> qsubst (x,numeral(gform p)) q)`, REPEAT GEN_TAC THEN EXISTS_TAC `fixpoint x q` THEN REWRITE_TAC[true_def; HOLDS_IFF_FIXPOINT; FV_FIXPOINT]);; (* ------------------------------------------------------------------------- *) (* Hence Tarski's theorem on the undefinability of truth. *) (* ------------------------------------------------------------------------- *) let definable_by = new_definition `definable_by P s <=> ?p x. P p /\ (!v. holds v p <=> (v(x)) IN s)`;; let definable = new_definition `definable s <=> ?p x. !v. holds v p <=> (v(x)) IN s`;; let TARSKI_THEOREM = prove (`~(definable {gform p | true p})`, REWRITE_TAC[definable; IN_ELIM_THM; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:form`; `x:num`] THEN DISCH_TAC THEN MP_TAC(SPECL [`x:num`; `Not p`] CARNAP) THEN DISCH_THEN(X_CHOOSE_THEN `q:form` (MP_TAC o CONJUNCT2)) THEN SIMP_TAC[true_def; holds; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY] THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[VALMOD_BASIC; TERMVAL_NUMERAL] THEN REWRITE_TAC[true_def; GFORM_INJ] THEN MESON_TAC[]);; hol-light/Boyer_Moore/000077500000000000000000000000001303454263000151665ustar00rootroot00000000000000hol-light/Boyer_Moore/README000066400000000000000000000011051303454263000160430ustar00rootroot00000000000000 BOYER-MOORE AUTOMATION (c) Petros Papapanagiotou 2008-2009 University of Edinburgh This code implements and extends for HOL Light some of the classic techniques due to Boyer and Moore for automating inductive proofs. It is described in the MSc thesis "On the Automation of Inductive Proofs in HOL Light", available online: http://www.inf.ed.ac.uk/publications/thesis/online/IM070466.pdf The code builds on earlier work by Richard Boulton in HOL88 (see "Boyer-Moore automation for the HOL System"). hol-light/Boyer_Moore/boyer-moore.ml000066400000000000000000000014411303454263000177570ustar00rootroot00000000000000(******************************************************************************) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) let paths = [".";!hol_dir ^ "/Boyer_Moore"] in map (fun st -> load_on_path paths st) ["support.ml"; "struct_equal.ml"; "shells.ml"; "environment.ml"; "clausal_form.ml"; "waterfall.ml"; "rewrite_rules.ml"; "definitions.ml"; "terms_and_clauses.ml"; "equalities.ml"; "induction.ml"; "counterexample.ml"; "generalize.ml"; "irrelevance.ml"; "main.ml"];; hol-light/Boyer_Moore/clausal_form.ml000066400000000000000000000425361303454263000202010ustar00rootroot00000000000000(******************************************************************************) (* FILE : clausal_form.ml *) (* DESCRIPTION : Functions for putting a formula into clausal form. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 13th May 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 12th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) let IMP_DISJ_THM = TAUT `!t1 t2. t1 ==> t2 <=> ~t1 \/ t2`;; let RIGHT_OR_OVER_AND = TAUT `!t1 t2 t3. t2 /\ t3 \/ t1 <=> (t2 \/ t1) /\ (t3 \/ t1)`;; let LEFT_OR_OVER_AND = TAUT `!t1 t2 t3. t1 \/ t2 /\ t3 <=> (t1 \/ t2) /\ (t1 \/ t3)`;; (*============================================================================*) (* Theorems for normalizing Boolean terms *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* EQ_EXPAND = |- (x = y) = ((~x \/ y) /\ (~y \/ x)) *) (*----------------------------------------------------------------------------*) let EQ_EXPAND = prove (`(x = y) = ((~x \/ y) /\ (~y \/ x))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `y:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* IMP_EXPAND = |- (x ==> y) = (~x \/ y) *) (*----------------------------------------------------------------------------*) let IMP_EXPAND = SPEC `y:bool` (SPEC `x:bool` IMP_DISJ_THM);; (*----------------------------------------------------------------------------*) (* COND_EXPAND = |- (x => y | z) = ((~x \/ y) /\ (x \/ z)) *) (*----------------------------------------------------------------------------*) let COND_EXPAND = prove (`(if x then y else z) = ((~x \/ y) /\ (x \/ z))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `y:bool` THEN BOOL_CASES_TAC `z:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* NOT_NOT_NORM = |- ~~x = x *) (*----------------------------------------------------------------------------*) let NOT_NOT_NORM = SPEC `x:bool` (CONJUNCT1 NOT_CLAUSES);; (*----------------------------------------------------------------------------*) (* NOT_CONJ_NORM = |- ~(x /\ y) = (~x \/ ~y) *) (*----------------------------------------------------------------------------*) let NOT_CONJ_NORM = CONJUNCT1 (SPEC `y:bool` (SPEC `x:bool` DE_MORGAN_THM));; (*----------------------------------------------------------------------------*) (* NOT_DISJ_NORM = |- ~(x \/ y) = (~x /\ ~y) *) (*----------------------------------------------------------------------------*) let NOT_DISJ_NORM = CONJUNCT2 (SPEC `y:bool` (SPEC `x:bool` DE_MORGAN_THM));; (*----------------------------------------------------------------------------*) (* LEFT_DIST_NORM = |- x \/ (y /\ z) = (x \/ y) /\ (x \/ z) *) (*----------------------------------------------------------------------------*) let LEFT_DIST_NORM = SPEC `z:bool` (SPEC `y:bool` (SPEC `x:bool` LEFT_OR_OVER_AND));; (*----------------------------------------------------------------------------*) (* RIGHT_DIST_NORM = |- (x /\ y) \/ z = (x \/ z) /\ (y \/ z) *) (*----------------------------------------------------------------------------*) let RIGHT_DIST_NORM = SPEC `y:bool` (SPEC `x:bool` (SPEC `z:bool` RIGHT_OR_OVER_AND));; (*----------------------------------------------------------------------------*) (* CONJ_ASSOC_NORM = |- (x /\ y) /\ z = x /\ (y /\ z) *) (*----------------------------------------------------------------------------*) let CONJ_ASSOC_NORM = SYM (SPEC `z:bool` (SPEC `y:bool` (SPEC `x:bool` CONJ_ASSOC)));; (*----------------------------------------------------------------------------*) (* DISJ_ASSOC_NORM = |- (x \/ y) \/ z = x \/ (y \/ z) *) (*----------------------------------------------------------------------------*) let DISJ_ASSOC_NORM = SYM (SPEC `z:bool` (SPEC `y:bool` (SPEC `x:bool` DISJ_ASSOC)));; (*============================================================================*) (* Conversions for rewriting Boolean terms *) (*============================================================================*) let COND_EXPAND_CONV = REWR_CONV COND_EXPAND;; let CONJ_ASSOC_NORM_CONV = REWR_CONV CONJ_ASSOC_NORM;; let DISJ_ASSOC_NORM_CONV = REWR_CONV DISJ_ASSOC_NORM;; let EQ_EXPAND_CONV = REWR_CONV EQ_EXPAND;; let IMP_EXPAND_CONV = REWR_CONV IMP_EXPAND;; let LEFT_DIST_NORM_CONV = REWR_CONV LEFT_DIST_NORM;; let NOT_CONJ_NORM_CONV = REWR_CONV NOT_CONJ_NORM;; let NOT_DISJ_NORM_CONV = REWR_CONV NOT_DISJ_NORM;; let NOT_NOT_NORM_CONV = REWR_CONV NOT_NOT_NORM;; let RIGHT_DIST_NORM_CONV = REWR_CONV RIGHT_DIST_NORM;; (*----------------------------------------------------------------------------*) (* NOT_CONV : conv *) (* *) (* |- !t. ~~t = t *) (* |- ~T = F *) (* |- ~F = T *) (*----------------------------------------------------------------------------*) let NOT_CONV = try ( let [th1;th2;th3] = CONJUNCTS NOT_CLAUSES in fun tm -> (let arg = dest_neg tm in if (is_T arg) then th2 else if (is_F arg) then th3 else SPEC (dest_neg arg) th1 ) ) with Failure _ -> failwith "NOT_CONV";; (*----------------------------------------------------------------------------*) (* AND_CONV : conv *) (* *) (* |- T /\ t = t *) (* |- t /\ T = t *) (* |- F /\ t = F *) (* |- t /\ F = F *) (* |- t /\ t = t *) (*----------------------------------------------------------------------------*) let AND_CONV = try ( let [th1;th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL AND_CLAUSES)) in fun tm -> (let (arg1,arg2) = dest_conj tm in if (is_T arg1) then SPEC arg2 th1 else if (is_T arg2) then SPEC arg1 th2 else if (is_F arg1) then SPEC arg2 th3 else if (is_F arg2) then SPEC arg1 th4 else if (arg1 = arg2) then SPEC arg1 th5 else failwith "" ) ) with Failure _ -> failwith "AND_CONV" ;; (*----------------------------------------------------------------------------*) (* OR_CONV : conv *) (* *) (* |- T \/ t = T *) (* |- t \/ T = T *) (* |- F \/ t = t *) (* |- t \/ F = t *) (* |- t \/ t = t *) (*----------------------------------------------------------------------------*) let OR_CONV = try ( let [th1;th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL OR_CLAUSES)) in fun tm -> (let (arg1,arg2) = dest_disj tm in if (is_T arg1) then SPEC arg2 th1 else if (is_T arg2) then SPEC arg1 th2 else if (is_F arg1) then SPEC arg2 th3 else if (is_F arg2) then SPEC arg1 th4 else if (arg1 = arg2) then SPEC arg1 th5 else failwith "" ) ) with Failure _ -> failwith "OR_CONV";; (*============================================================================*) (* Conversions for obtaining `clausal' form *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* EQ_IMP_COND_ELIM_CONV : (term -> bool) -> conv *) (* *) (* Eliminates Boolean equalities, Boolean conditionals, and implications from *) (* terms consisting of =,==>,COND,/\,\/,~ and atoms. The atoms are specified *) (* by the predicate that the conversion takes as its first argument. *) (*----------------------------------------------------------------------------*) let rec EQ_IMP_COND_ELIM_CONV is_atom tm = try (if (is_atom tm) then ALL_CONV tm else if (is_neg tm) then (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) tm else if (is_eq tm) then ((RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) THENC EQ_EXPAND_CONV) tm else if (is_imp tm) then ((RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) THENC IMP_EXPAND_CONV) tm else if (is_cond tm) then ((RATOR_CONV (RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)))) THENC (RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) THENC COND_EXPAND_CONV) tm else ((RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) tm ) with Failure _ -> failwith "EQ_IMP_COND_ELIM_CONV";; (*----------------------------------------------------------------------------*) (* MOVE_NOT_DOWN_CONV : (term -> bool) -> conv -> conv *) (* *) (* Moves negations down through a term consisting of /\,\/,~ and atoms. The *) (* atoms are specified by a predicate (first argument). When a negation has *) (* reached an atom, the conversion `conv' (second argument) is applied to the *) (* negation of the atom. `conv' is also applied to any non-negated atoms *) (* encountered. T and F are eliminated. *) (*----------------------------------------------------------------------------*) let rec MOVE_NOT_DOWN_CONV is_atom conv tm = try (if (is_atom tm) then (conv tm) else if (is_neg tm) then ((let tm' = rand tm in if (is_atom tm') then ((conv THENC (TRY_CONV NOT_CONV)) tm) else if (is_neg tm') then (NOT_NOT_NORM_CONV THENC (MOVE_NOT_DOWN_CONV is_atom conv)) tm else if (is_conj tm') then (NOT_CONJ_NORM_CONV THENC (RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) THENC (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC (TRY_CONV AND_CONV)) tm else if (is_disj tm') then (NOT_DISJ_NORM_CONV THENC (RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) THENC (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC (TRY_CONV OR_CONV)) tm else failwith "")) else if (is_conj tm) then ((RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) THENC (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC (TRY_CONV AND_CONV)) tm else if (is_disj tm) then ((RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) THENC (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC (TRY_CONV OR_CONV)) tm else failwith "" ) with Failure _ -> failwith "MOVE_NOT_DOWN_CONV";; (*----------------------------------------------------------------------------*) (* CONJ_LINEAR_CONV : conv *) (* *) (* Linearizes conjuncts using the following conversion applied recursively: *) (* *) (* "(x /\ y) /\ z" *) (* ================================ *) (* |- (x /\ y) /\ z = x /\ (y /\ z) *) (*----------------------------------------------------------------------------*) let rec CONJ_LINEAR_CONV tm = try (if ((is_conj tm) && (is_conj (rand (rator tm)))) then (CONJ_ASSOC_NORM_CONV THENC (RAND_CONV (TRY_CONV CONJ_LINEAR_CONV)) THENC (TRY_CONV CONJ_LINEAR_CONV)) tm else failwith "" ) with Failure _ -> failwith "CONJ_LINEAR_CONV";; (*----------------------------------------------------------------------------*) (* CONJ_NORM_FORM_CONV : conv *) (* *) (* Puts a term involving /\ and \/ into conjunctive normal form. Anything *) (* other than /\ and \/ is taken to be an atom and is not processed. *) (* *) (* The conjunction returned is linear, i.e. the conjunctions are associated *) (* to the right. Each conjunct is a linear disjunction. *) (*----------------------------------------------------------------------------*) let rec CONJ_NORM_FORM_CONV tm = try (if (is_disj tm) then (if (is_conj (rand (rator tm))) then ((RATOR_CONV (RAND_CONV ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC (RAND_CONV CONJ_NORM_FORM_CONV)))) THENC (RAND_CONV CONJ_NORM_FORM_CONV) THENC RIGHT_DIST_NORM_CONV THENC (RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC (RAND_CONV CONJ_NORM_FORM_CONV) THENC (TRY_CONV CONJ_LINEAR_CONV)) tm else if (is_conj (rand tm)) then ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC (RAND_CONV ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC (RAND_CONV CONJ_NORM_FORM_CONV))) THENC LEFT_DIST_NORM_CONV THENC (RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC (RAND_CONV CONJ_NORM_FORM_CONV) THENC (TRY_CONV CONJ_LINEAR_CONV)) tm else if (is_disj (rand (rator tm))) then (DISJ_ASSOC_NORM_CONV THENC CONJ_NORM_FORM_CONV) tm else (let th = RAND_CONV CONJ_NORM_FORM_CONV tm in let tm' = rhs (concl th) in if (is_conj (rand tm')) then (TRANS th (CONJ_NORM_FORM_CONV tm')) else th)) else if (is_conj tm) then ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC (RAND_CONV CONJ_NORM_FORM_CONV) THENC (TRY_CONV CONJ_LINEAR_CONV)) tm else ALL_CONV tm ) with Failure _ -> failwith "CONJ_NORM_FORM_CONV";; (*----------------------------------------------------------------------------*) (* has_boolean_args_and_result : term -> bool *) (* *) (* Yields true if and only if the term is of type ":bool", and if it is a *) (* function application, all the arguments are of type ":bool". *) (*----------------------------------------------------------------------------*) let has_boolean_args_and_result tm = try (let args = snd (strip_comb tm) in let types = (type_of tm)::(map type_of args) in (subtract (setify types) [`:bool`]) = [] ) with Failure _ -> (type_of tm = `:bool`);; (*----------------------------------------------------------------------------*) (* CLAUSAL_FORM_CONV : conv *) (* *) (* Puts into clausal form terms consisting of =,==>,COND,/\,\/,~ and atoms. *) (*----------------------------------------------------------------------------*) let CLAUSAL_FORM_CONV tm = try ( let is_atom tm = (not (has_boolean_args_and_result tm)) || (is_var tm) || (is_const tm) in ((EQ_IMP_COND_ELIM_CONV is_atom) THENC (MOVE_NOT_DOWN_CONV is_atom ALL_CONV) THENC CONJ_NORM_FORM_CONV) tm ) with Failure _ -> failwith "CLAUSAL_FORM_CONV";; hol-light/Boyer_Moore/counterexample.ml000066400000000000000000000247231303454263000205630ustar00rootroot00000000000000(******************************************************************************) (* FILE : counterexample.ml *) (* DESCRIPTION : Simple counterexample checker *) (* Based on ideas and suggestions from S. Wilson *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) (*----------------------------------------------------------------------------*) (* Reference of how many examples will be tried on each check. *) (* Set to 0 to turn off counterexample checker. *) (*----------------------------------------------------------------------------*) let counter_check_num = ref 5;; let counter_checks t = counter_check_num := t;; (*----------------------------------------------------------------------------*) (* Reference to count how many counterexamples were found during a proof. *) (*----------------------------------------------------------------------------*) let counterexamples = ref 0;; let inc_counterexamples () = counterexamples := !counterexamples + 1 ; ();; (*----------------------------------------------------------------------------*) (* inst_type *) (*----------------------------------------------------------------------------*) (* Hacky function to instantiate types. *) (* I'm surprised there is no such function in HOL Light (or perhaps I just *) (* haven't found it yet?). *) (*----------------------------------------------------------------------------*) (* Creates a variable of the given type. Instantiates the term using "inst" *) (* then returns the type of the resulting term. *) (*----------------------------------------------------------------------------*) let inst_type : (hol_type * hol_type) list -> hol_type -> hol_type = fun ins ty -> let tm = mk_var ("x",ty) in let itm = inst ins tm in type_of itm;; (*----------------------------------------------------------------------------*) (* shell_type_match *) (*----------------------------------------------------------------------------*) (* Does a deep search to check if a type can be properly grounded to a *) (* combination of types defined in the shell. *) (* Returns the type instantiation pairs to make it happen. *) (* Variable types are instantiated by `:num`. *) (*----------------------------------------------------------------------------*) (* If the type is an instance of a type constructor (is_type) then it is *) (* split. The name of the constructor is looked up in the system shells list. *) (* The arguments are checked recursively. *) (* If it's not an instance of a type constructor, we try to replace it by *) (* `:num`. *) (*----------------------------------------------------------------------------*) let rec shell_type_match : hol_type -> (hol_type * hol_type) list = fun ty -> if (is_type ty) then let tys,tyargs = dest_type ty in let info = try sys_shell_info tys with Failure _ -> failwith ("No shell defined for type '" ^ (string_of_type ty) ^ "'") in itlist union (map shell_type_match tyargs) [] else try type_match ty `:num` [] with Failure _ -> failwith ("Unknown type '" ^ (string_of_type ty) ^ "' that doesn't match 'num'!");; (*----------------------------------------------------------------------------*) (* HL_rewrite_ground_term : term -> term *) (* *) (* Uses HOL Light's REWRITE_CONV to rewrite a ground term. *) (* The function and accessor definitions are used as rewrite rules. *) (* This reduces valid expressions to `T`. *) (*----------------------------------------------------------------------------*) let HL_rewrite_ground_term tm = (* ((proof_print_newline) o (proof_print_term) o (proof_print_string "Checking:")) tm ;*) if (frees tm = []) then (* let rules = (union ((flat o defs) ()) (all_accessor_thms ())) *) (* let rules = (union (rewrite_rules ()) (all_accessor_thms ())) *) let numred = try (rhs o concl o NUM_REDUCE_CONV) tm with Failure _ -> tm in if (is_T numred) then numred else let rew = REWRITE_CONV (union (rewrite_rules ()) (all_accessor_thms ())) in (rhs o concl o rew) tm else failwith ("rewrite_ground_term: free vars in term: " ^ (string_of_term tm));; let HL_rewrite_ground_term' tm = if (frees tm = []) then (* let rules = (union ((flat o defs) ()) (all_accessor_thms ())) *) let rules = (union ((flat o defs) ()) (all_accessor_thms ())) in let arith_rules = [PRE;ADD;MULT;EXP;EVEN;ODD;LE;LT;GE;GT;SUB] in (* Need to apply preprocessing similar to add_def in environment.ml *) let rew = REWRITE_CONV (ARITH :: (subtract rules arith_rules)) in (rhs o concl o rew) tm else failwith ("rewrite_ground_term: free vars in term: " ^ (string_of_term tm));; (*----------------------------------------------------------------------------*) (* random_example : int -> hol_type -> term *) (*----------------------------------------------------------------------------*) (* Creates a random example of a given type. *) (* The first argument is a maximum depth so as to control the size of the *) (* example. *) (*----------------------------------------------------------------------------*) (* Uses "shell_type_match" in order to ground the type to a combination of *) (* types defined as shells. Therefore, all variable types are instantiated to *) (* `:num`. *) (* Instantiates the arg_types of the shell for each constructor, then uses *) (* mk_cons_type to create proper types for the constructors. Having those and *) (* by using mk_mconst creates the constructors as terms. *) (* random_example is called recursively for every constructor argument, while *) (* decreasing the maxdepth to ensure termination. *) (* If maxdepth is reached, we just pick randomly one of the base *) (* constructors. *) (*----------------------------------------------------------------------------*) (* NOTE: The current version can still afford a few optimisations. *) (* eg. The preprocessing so as to ground the given type should only happen *) (* once. *) (* NOTE: We could optimise this function further by accommodating the *) (* constructors as terms (rather than or in addition to strings) within the *) (* shell. *) (*----------------------------------------------------------------------------*) let random_example : int -> hol_type -> term = let rec random_example': int->int->hol_type->term = fun origdepth maxdepth ty -> let tyi = shell_type_match ty in let ty' = inst_type tyi ty in let tystr,typarams = dest_type ty' in let sinfo = sys_shell_info tystr in let ocons = shell_constructors sinfo in let sh_arg_types = shell_arg_types sinfo in let arg_type_pairs = zip sh_arg_types typarams in let arg_types_matches = try itlist (fun (x,y) l -> type_match x y l) arg_type_pairs tyi with Failure _ -> failwith "Shell argument types cannot be matched." in let mk_cons_type = fun arglist -> List.fold_left (fun ty i -> mk_type ("fun",[i;ty])) ty' (rev arglist) in let inst_cons = map (fun x,y,_ -> x,map (inst_type arg_types_matches) y) ocons in let mk_cons = fun x,y -> try let n = num_of_string x in (mk_numeral n),y with Failure _ -> mk_mconst(x,(mk_cons_type y)),y in let cons = map mk_cons inst_cons in let terminal_filter = fun (_,l) -> (l=[]) in let tcons,ntcons = partition terminal_filter cons in if (maxdepth > 1) then let prob = 200/((maxdepth-1)*3) in (* let newdepth = origdepth / (length cons) in*) let newdepth = maxdepth - 1 in let selcons = if ((Random.int 100) <= prob) then tcons else ntcons in let cconstm,cconsargs = List.nth selcons (Random.int (length selcons)) in let args = (map (random_example' origdepth newdepth) cconsargs) in List.fold_left (fun x y -> mk_comb (x,y)) cconstm args else (fst o hd) tcons in fun maxdepth ty -> random_example' maxdepth maxdepth ty;; (* print_string "*" ; print_term cconstm ; print_string "*" ; print_type (type_of cconstm); print_newline (); *) (* map (fun x -> print_term x ; print_string ":" ; print_type (type_of x); print_newline()) args ; *) (* print_newline (); *) let random_grounding maxdepth tm = let vars = frees tm in let types = map type_of vars in let examples = map (random_example maxdepth) types in let pairs = zip vars examples in let insts = map (fun v,e -> term_match [] v e) pairs in itlist instantiate insts tm;; let counter_check_once maxdepth tm = let tm' = random_grounding maxdepth tm in let tm'' = HL_rewrite_ground_term tm' in if (is_T(tm'')) then true else let junk = warn (!proof_printing) ("Found counterexample for " ^ string_of_term(tm) ^ " : " ^ string_of_term(tm')) in inc_counterexamples() ; false;; let rec counter_check_n maxdepth n tm = if (n<=0) then true else if (counter_check_once maxdepth tm) then counter_check_n maxdepth (n-1) tm else false;; let counter_check maxdepth tm = counter_check_n maxdepth !counter_check_num tm;; hol-light/Boyer_Moore/definitions.ml000066400000000000000000000174521303454263000200440ustar00rootroot00000000000000(******************************************************************************) (* FILE : definitions.ml *) (* DESCRIPTION : Using definitions. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 6th June 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 3rd August 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) (*----------------------------------------------------------------------------*) (* recursive_calls : string -> term -> term list *) (* *) (* Function to compute the occurrences of applications of a constant in a *) (* term. The first argument is the name of the constant. The second argument *) (* is the term to be examined. If there are no occurrences, an empty list is *) (* returned. The function assumes that the term does not contain *) (* abstractions. *) (*----------------------------------------------------------------------------*) let rec recursive_calls name tm = try (let (f,args) = strip_comb tm in if (try(fst (dest_const f) = name) with Failure _ -> false) then [tm] else itlist List.append (map (recursive_calls name) args) []) with Failure _ -> [];; (*----------------------------------------------------------------------------*) (* is_subterm : term -> term -> bool *) (* *) (* Function to compute whether one term is a subterm of another. *) (*----------------------------------------------------------------------------*) let rec is_subterm subterm tm = try( if (tm = subterm) then true else ((is_subterm subterm (rator tm)) || (is_subterm subterm (rand tm))) )with Failure _ -> false;; (*----------------------------------------------------------------------------*) (* no_new_terms : term -> term -> bool *) (* *) (* Function to determine whether all of the arguments of an application *) (* "f x1 ... xn" are subterms of a term. *) (*----------------------------------------------------------------------------*) let no_new_terms app tm = try (let args = snd (strip_comb app) in itlist (fun x y -> x && y) (map (fun arg -> is_subterm arg tm) args) true ) with Failure _ -> failwith "no_new_terms";; (*----------------------------------------------------------------------------*) (* hide_fun_call : term -> term -> term *) (* *) (* Function to replace occurrences of a particular function call in a term *) (* with a genvar, so that `no_new_terms' can be used to look for arguments in *) (* a term less the original call. *) (*----------------------------------------------------------------------------*) let hide_fun_call app tm = let var = genvar (type_of app) in subst [(var,app)] tm;; (*----------------------------------------------------------------------------*) (* is_explicit_value : term -> bool *) (* *) (* Function to compute whether a term is an explicit value. An explicit value *) (* is either T or F or an application of a shell constructor to explicit *) (* values. A `bottom object' corresponds to an application to no arguments. *) (* I have also made numeric constants explicit values, since they are *) (* equivalent to some number of applications of SUC to 0. *) (*----------------------------------------------------------------------------*) let is_explicit_value tm = let rec is_explicit_value' constructors tm = (is_T tm) || (is_F tm) || ((is_const tm) && (type_of tm = `:num`)) || (let (f,args) = strip_comb tm in (try(mem (fst (dest_const f)) constructors) with Failure _ -> false) & (forall (is_explicit_value' constructors) args)) in is_explicit_value' (all_constructors ()) tm;; (*----------------------------------------------------------------------------*) (* more_explicit_values : term -> term -> bool *) (* *) (* Returns true if and only if a new function call (second argument) has more *) (* arguments that are explicit values than the old function call (first *) (* argument). *) (*----------------------------------------------------------------------------*) let more_explicit_values old_call new_call = try (let (f1,args1) = strip_comb old_call and (f2,args2) = strip_comb new_call in if (f1 = f2) then let n1 = length (filter is_explicit_value args1) and n2 = length (filter is_explicit_value args2) in n2 > n1 else failwith "" ) with Failure _ -> failwith "more_explicit_values";; (*----------------------------------------------------------------------------*) (* good_properties : term list -> term -> term -> term -> bool *) (* *) (* Function to determine whether the recursive calls in the expansion of a *) (* function call have good properties. The first argument is a list of *) (* assumptions currently being made. The second argument is the original *) (* call. The third argument is the (simplified) expansion of the call, and *) (* the fourth argument is the term currently being processed and which *) (* contains the function call. *) (*----------------------------------------------------------------------------*) (*< Boyer and Moore's heuristic let good_properties assumps call body_of_call tm = let rec in_assumps tm assumps = if (assumps = []) then false else if (is_subterm tm (hd assumps)) then true else in_assumps tm (tl assumps) in (let name = fst (dest_const (fst (strip_comb call))) and body_less_call = hide_fun_call call tm in let rec_calls = recursive_calls name body_of_call in let bools = map (fun rc -> (no_new_terms rc body_less_call) || (in_assumps rc assumps) || (more_explicit_values call rc)) rec_calls in itlist (fun x y -> x && y) bools true ) with Failure _ -> failwith "good_properties";; >*) (* For HOL implementation, the restricted form of definitions allows all *) (* recursive calls to be considered to have good properties. *) let good_properties assumps call body_of_call tm = true;; hol-light/Boyer_Moore/environment.ml000066400000000000000000000343511303454263000200720ustar00rootroot00000000000000(******************************************************************************) (* FILE : environment.ml *) (* DESCRIPTION : Environment of definitions and pre-proved theorems for use *) (* in automation. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 8th May 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 12th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) let my_gen_terms = ref ([]:term list);; let bm_steps = ref (0,0);; let rec GSPEC th = let wl,w = dest_thm th in if is_forall w then GSPEC (SPEC (genvar (type_of (fst (dest_forall w)))) th) else th;; let LIST_CONJ = end_itlist CONJ ;; let rec CONJ_LIST n th = try if n=1 then [th] else (CONJUNCT1 th)::(CONJ_LIST (n-1) (CONJUNCT2 th)) with Failure _ -> failwith "CONJ_LIST";; (*----------------------------------------------------------------------------*) (* Reference variable to hold the defining theorems for operators currently *) (* defined within the system. Each definition is stored as a triple. The *) (* first component is the name of the operator. The second is the number of *) (* the recursive argument. If the operator is not defined recursively, this *) (* number is zero. The third component is a list of pairs of type constructor *) (* names and the theorems that define the behaviour of the operator for each *) (* constructor. If the operator is not recursive, the constructor names are *) (* empty (null) strings. *) (*----------------------------------------------------------------------------*) let system_defs = ref ([] : (string * (int * (string * thm) list)) list);; (*----------------------------------------------------------------------------*) (* new_def : thm -> void *) (* *) (* Make a new definition available. Checks that theorem has no hypotheses, *) (* then splits it into conjuncts. The variables for each conjunct are *) (* specialised and then the conjuncts are made into equations. *) (* *) (* For each equation, a triple is obtained, consisting of the name of the *) (* function on the LHS, the number of the recursive argument, and the name of *) (* the constructor used in that argument. This process fails if the LHS is *) (* not an application of a constant (possibly to zero arguments), or if more *) (* than one of the arguments is anything other than a variable. The argument *) (* that is not a variable must be an application of a constructor. If the *) (* function is not recursive, the argument number returned is zero. *) (* *) (* Having obtained a triple for each equation, a check is made that the first *) (* two components are the same for each equation. Then, the equations are *) (* saved together with constructor names for each, and the name of the *) (* operator being defined, and the number of the recursive argument. *) (*----------------------------------------------------------------------------*) let new_def th = try (let make_into_eqn th = let tm = concl th in if (is_eq tm) then th else if (is_neg tm) then EQF_INTRO th else EQT_INTRO th and get_constructor th = let tm = lhs (concl th) in let (f,args) = strip_comb tm in let name = fst (dest_const f) in let bools = number_list (map is_var args) in let i = itlist (fun (b,i) n -> if ((not b) && (n = 0)) then i else if b then n else failwith "") bools 0 in if (i = 0) then ((name,i),"") else ((name,i),fst (dest_const (fst (strip_comb (el (i-1) args))))) in let ([],tm) = dest_thm th in let ths = CONJ_LIST (length (conj_list tm)) th in let ths' = map SPEC_ALL ths in let eqs = map make_into_eqn ths' in let constructs = map get_constructor eqs in let (xl,yl) = hashI setify (List.split constructs) in let (name,i) = if (length xl = 1) then (hd xl) else failwith "" in system_defs := (name,(i,List.combine yl eqs))::(!system_defs) ) with Failure _ -> failwith "new_def";; (*----------------------------------------------------------------------------*) (* defs : void -> thm list list *) (* *) (* Returns a list of lists of theorems currently being used as definitions. *) (* Each list in the list is for one operator. *) (*----------------------------------------------------------------------------*) let defs () = map ((map snd) o snd o snd) (!system_defs);; let defs_names () = map fst (!system_defs);; (*----------------------------------------------------------------------------*) (* get_def : string -> (string # int # (string # thm) list) *) (* *) (* Function to obtain the definition information of a named operator. *) (*----------------------------------------------------------------------------*) let get_def name = try ( assoc name (!system_defs) ) with Failure _ -> failwith "get_def";; (*----------------------------------------------------------------------------*) (* Reference variable for a list of theorems currently proved in the system. *) (* These theorems are available to the automatic proof procedures for use as *) (* rewrite rules. The elements of the list are actually pairs of theorems. *) (* The first theorem is that specified by the user. The second is an *) (* equivalent theorem in a standard form. *) (*----------------------------------------------------------------------------*) let system_rewrites = ref ([] : (thm * thm) list);; (*----------------------------------------------------------------------------*) (* CONJ_IMP_IMP_IMP = |- x /\ y ==> z = x ==> y ==> z *) (*----------------------------------------------------------------------------*) let CONJ_IMP_IMP_IMP = prove (`((x /\ y) ==> z) = (x ==> (y ==> z))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `y:bool` THEN BOOL_CASES_TAC `z:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* CONJ_UNDISCH : thm -> thm *) (* *) (* Undischarges the conjuncts of the antecedant of an implication. *) (* e.g. |- x /\ (y /\ z) /\ w ==> x ---> x, y /\ z, w |- x *) (* *) (* Has to check for negations, because UNDISCH processes them when we don't *) (* want it to. *) (*----------------------------------------------------------------------------*) let rec CONJ_UNDISCH th = try (let th' = CONV_RULE (REWR_CONV CONJ_IMP_IMP_IMP) th in let th'' = UNDISCH th' in CONJ_UNDISCH th'') with Failure _ -> try (if not (is_neg (concl th)) then UNDISCH th else failwith "") with Failure _ -> failwith "CONJ_UNDISCH";; (*----------------------------------------------------------------------------*) (* new_rewrite_rule : thm -> void *) (* *) (* Make a new rewrite rule available. Checks that theorem has no hypotheses. *) (* The theorem is saved together with an equivalent theorem in a standard *) (* form. Theorems are fully generalized, then specialized with unique *) (* variable names (genvars), and then standardized as follows: *) (* *) (* |- (h1 /\ ... /\ hn) ==> (l = r) ---> h1, ..., hn |- l = r *) (* |- (h1 /\ ... /\ hn) ==> ~b ---> h1, ..., hn |- b = F *) (* |- (h1 /\ ... /\ hn) ==> b ---> h1, ..., hn |- b = T *) (* |- l = r ---> |- l = r *) (* |- ~b ---> |- b = F *) (* |- b ---> |- b = T *) (* *) (* A conjunction of rules may be given. The function will treat each conjunct *) (* in the theorem as a separate rule. *) (*----------------------------------------------------------------------------*) let rec new_rewrite_rule th = try (if (is_conj (concl th)) then (map new_rewrite_rule (CONJUNCTS th); ()) else let ([],tm) = dest_thm th in let th' = GSPEC (GEN_ALL th) in let th'' = try (CONJ_UNDISCH th') with Failure _ -> th' in let tm'' = concl th'' in let th''' = (if (is_eq tm'') then th'' else if (is_neg tm'') then EQF_INTRO th'' else EQT_INTRO th'') in system_rewrites := (th,th''')::(!system_rewrites) ) with Failure _ -> failwith "new_rewrite_rule";; (*----------------------------------------------------------------------------*) (* rewrite_rules : void -> thm list *) (* *) (* Returns the list of theorems currently being used as rewrites, in the form *) (* they were originally given by the user. *) (*----------------------------------------------------------------------------*) let rewrite_rules () = map fst (!system_rewrites);; (*----------------------------------------------------------------------------*) (* Reference variable to hold the generalisation lemmas currently known to *) (* the system. *) (*----------------------------------------------------------------------------*) let system_gen_lemmas = ref ([] : thm list);; (*----------------------------------------------------------------------------*) (* new_gen_lemma : thm -> void *) (* *) (* Make a new generalisation lemma available. *) (* Checks that the theorem has no hypotheses. *) (*----------------------------------------------------------------------------*) let new_gen_lemma th = if ((hyp th) = []) then system_gen_lemmas := th::(!system_gen_lemmas) else failwith "new_gen_lemma";; (*----------------------------------------------------------------------------*) (* gen_lemmas : void -> thm list *) (* *) (* Returns the list of theorems currently being used as *) (* generalisation lemmas. *) (*----------------------------------------------------------------------------*) let gen_lemmas () = !system_gen_lemmas;; (*----------------------------------------------------------------------------*) (* max_var_depth : term -> int *) (* *) (* Returns the maximum depth of any variable in a term. *) (* eg. max_var_depth `PRE (a + SUC c)` = 4 *) (* max_var_depth `a` = 1 *) (* max_var_depth `PRE (5 + SUC 2)` = 0 *) (* max_var_depth `PRE (a + SUC 2)` = 3 *) (*----------------------------------------------------------------------------*) (* This is primarily used to limit non-termination. If max_var_depth exceeds *) (* a limit the system will fail. *) (* The algorithm is simple: *) (* if constant,numeral,etc then 0 *) (* else if variable then 1 *) (* else if definition,constructor,accessor then *) (* if (max_var_depth of arguments) > 0 then result + 1 *) (* else 0 *) (* else if any other combination then max_var_depth of arguments *) (*----------------------------------------------------------------------------*) let rec max_var_depth tm = if (is_var tm) then 1 else if ((is_numeral tm) || (is_const tm) || (is_T tm) || (is_F tm)) then 0 else try let (f,args) = strip_comb tm in let fn = (fst o dest_const) f in let l = flat [defs_names();all_constructors();all_accessors()] in if (mem fn l) then let x = itlist max (map max_var_depth args) 0 in if (x>0) then x+1 else 0 else itlist max (map max_var_depth args) 0 with Failure _ -> 0;; hol-light/Boyer_Moore/equalities.ml000066400000000000000000000253521303454263000176740ustar00rootroot00000000000000(******************************************************************************) (* FILE : equalities.ml *) (* DESCRIPTION : Using equalities. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 19th June 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 7th August 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) (*----------------------------------------------------------------------------*) (* is_explicit_value_template : term -> bool *) (* *) (* Function to compute whether a term is an explicit value template. *) (* An explicit value template is a non-variable term composed entirely of *) (* T or F or variables or applications of shell constructors. *) (* A `bottom object' corresponds to an application to no arguments. I have *) (* also made numeric constants valid components of explicit value templates, *) (* since they are equivalent to some number of applications of SUC to 0. *) (*----------------------------------------------------------------------------*) let is_explicit_value_template tm = let rec is_explicit_value_template' constructors tm = (is_T tm) || (is_F tm) || ((is_const tm) && (type_of tm = `:num`)) || (is_var tm) || (is_numeral tm) || (let (f,args) = strip_comb tm in (try(mem (fst (dest_const f)) constructors) with Failure _ -> false) & (forall (is_explicit_value_template' constructors) args)) in (not (is_var tm)) & (is_explicit_value_template' (all_constructors ()) tm);; (*----------------------------------------------------------------------------*) (* subst_conv : thm -> conv *) (* *) (* Substitution conversion. Given a theorem |- l = r, it replaces all *) (* occurrences of l in the term with r. *) (*----------------------------------------------------------------------------*) let subst_conv th tm = SUBST_CONV [(th,lhs (concl th))] tm tm;; (*----------------------------------------------------------------------------*) (* use_equality_subst : bool -> bool -> thm -> conv *) (* *) (* Function to perform substitution when using equalities. The first argument *) (* is a Boolean that controls which side of an equation substitution is to *) (* take place on. The second argument is also a Boolean, indicating whether *) (* or not we have decided to cross-fertilize. The third argument is a *) (* substitution theorem of the form: *) (* *) (* t' = s' |- t' = s' *) (* *) (* If we are not cross-fertilizing, s' is substituted for t' throughout the *) (* term. If we are cross-fertilizing, the behaviour depends on the structure *) (* of the term, tm: *) (* *) (* (a) if tm is "l = r", substitute s' for t' in either r or l. *) (* (b) if tm is "~(l = r)", substitute s' for t' throughout tm. *) (* (c) otherwise, do not substitute. *) (*----------------------------------------------------------------------------*) (* The heuristic above is modified so that in case (c) a substitution does *) (* take place. This reduces the chances of an invalid subgoal (clause) being *) (* generated, and has been shown to be a better option for certain examples. *) let use_equality_subst right cross_fert th tm = try (if cross_fert then if (is_eq tm) then (if right then RAND_CONV (subst_conv th) tm else RATOR_CONV (RAND_CONV (subst_conv th)) tm) else if ((is_neg tm) && (try(is_eq (rand tm)) with Failure _ -> false)) then subst_conv th tm else (* ALL_CONV tm *) subst_conv th tm else subst_conv th tm ) with Failure _ -> failwith "use_equality_subst";; (*----------------------------------------------------------------------------*) (* EQ_EQ_IMP_DISJ_EQ = *) (* |- !x x' y y'. (x = x') /\ (y = y') ==> (x \/ y = x' \/ y') *) (*----------------------------------------------------------------------------*) let EQ_EQ_IMP_DISJ_EQ = prove (`!x x' y y'. (x = x') /\ (y = y') ==> ((x \/ y) = (x' \/ y'))`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* DISJ_EQ : thm -> thm -> thm *) (* *) (* |- x = x' |- y = y' *) (* ------------------------ *) (* |- (x \/ y) = (x' \/ y') *) (*----------------------------------------------------------------------------*) let DISJ_EQ th1 th2 = try (let (x,x') = dest_eq (concl th1) and (y,y') = dest_eq (concl th2) in MP (SPECL [x;x';y;y'] EQ_EQ_IMP_DISJ_EQ) (CONJ th1 th2) ) with Failure _ -> failwith "DISJ_EQ";; (*----------------------------------------------------------------------------*) (* use_equality_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* Heuristic for using equalities, and in particular for cross-fertilizing. *) (* Given a clause, the function looks for a literal of the form ~(s' = t') *) (* where t' occurs in another literal and is not an explicit value template. *) (* If no such literal is present, the function looks for a literal of the *) (* form ~(t' = s') where t' occurs in another literal and is not an explicit *) (* value template. If a substitution literal of one of these two forms is *) (* found, substitution takes place as follows. *) (* *) (* If the clause is an induction step, and there is an equality literal *) (* mentioning t' on the RHS (or LHS if the substitution literal was *) (* ~(t' = s')), and s' is not an explicit value, the function performs a *) (* cross-fertilization. The substitution function is called for each literal *) (* other than the substitution literal. Each call results in a theorem of the *) (* form: *) (* *) (* t' = s' |- old_lit = new_lit *) (* *) (* If the clause is an induction step and s' is not an explicit value, the *) (* substitution literal is rewritten to F, and so will subsequently be *) (* eliminated. Otherwise this literal is unchanged. The theorems for each *) (* literal are recombined using the DISJ_EQ rule, and the new clause is *) (* returned. See the comments for the substitution heuristic for a *) (* description of how the original clause is proved from the new clause. *) (*----------------------------------------------------------------------------*) let use_equality_heuristic (tm,(ind:bool)) = try (let checkx (tml1,tml2) t' = (not (is_explicit_value_template t')) & ((exists (is_subterm t') tml1) || (exists (is_subterm t') tml2)) in let rec split_disjuncts side prevl tml = if (can (check (checkx (prevl,tl tml)) o side o dest_neg) (hd tml)) then (prevl,tml) else split_disjuncts side ((hd tml)::prevl) (tl tml) in let is_subterm_of_side side subterm tm = (try(is_subterm subterm (side tm)) with Failure _ -> false) in let literals = disj_list tm in let (right,(overs,neq'::unders)) = try (true,(hashI rev) (split_disjuncts rhs [] literals)) with Failure _ -> (false,(hashI rev) (split_disjuncts lhs [] literals)) in let side = if right then rhs else lhs in let flipth = if right then ALL_CONV neq' else RAND_CONV SYM_CONV neq' in let neq = rhs (concl flipth) in let eq = dest_neg neq in let (s',t') = dest_eq eq in let delete = ind && (not (is_explicit_value s')) in let cross_fert = delete & ((exists (is_subterm_of_side side t') overs) || (exists (is_subterm_of_side side t') unders)) in let sym_eq = mk_eq (t',s') in let sym_neq = mk_neg sym_eq in let ass1 = EQ_MP (SYM flipth) (NOT_EQ_SYM (ASSUME sym_neq)) and ass2 = ASSUME sym_eq in let subsfun = use_equality_subst right cross_fert ass2 in let overths = map subsfun overs and neqth = if delete then TRANS (RAND_CONV (RAND_CONV (subst_conv ass2)) neq) (ISPEC s' NOT_EQ_F) else ADD_ASSUM sym_eq (REFL neq) and underths = map subsfun unders in let neqth' = TRANS flipth neqth in let th1 = itlist DISJ2 overs (try DISJ1 ass1 (list_mk_disj unders) with Failure _ -> ass1) and th2 = itlist DISJ_EQ overths (end_itlist DISJ_EQ (neqth'::underths)) and th3 = SPEC sym_eq EXCLUDED_MIDDLE in let tm' = rhs (concl th2) in let proof th = DISJ_CASES th3 (EQ_MP (SYM th2) th) th1 in (proof_print_string_l "-> Use Equality Heuristic" () ; ([(tm',ind)],apply_proof (proof o hd) [tm'])) ) with Failure _ -> failwith "use_equality_heuristic`"; hol-light/Boyer_Moore/generalize.ml000066400000000000000000000712161303454263000176540ustar00rootroot00000000000000(******************************************************************************) (* FILE : generalize.ml *) (* DESCRIPTION : Generalization. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 21st June 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 12th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) (*----------------------------------------------------------------------------*) (* is_generalizable : string list -> term -> bool *) (* *) (* Function to determine whether or not a term has the correct properties to *) (* be generalizable. It takes a list of accessor function names as its first *) (* argument. This is for efficiency. It could compute them itself, but if an *) (* external function is going to call is_generalizable many times it is *) (* better for the external function to compute the list of accessors. *) (*----------------------------------------------------------------------------*) let is_generalizable accessors tm = not ((is_var tm) || (is_explicit_value_template tm) || (is_eq tm) || (try(mem ((fst o dest_const o fst o strip_comb) tm) accessors) with Failure _ -> false));; (*----------------------------------------------------------------------------*) (* generalizable_subterms : string list -> term -> term list *) (* *) (* Computes the generalizable subterms of a literal, given a list of accessor *) (* function names. *) (*----------------------------------------------------------------------------*) let generalizable_subterms accessors tm = try (setify (find_bm_terms (is_generalizable accessors) tm) ) with Failure _ -> failwith "generalizable_subterms";; (*----------------------------------------------------------------------------*) (* minimal_common_subterms : term list -> term list *) (* *) (* Given a list of terms, this function removes from the list any term that *) (* has one of the other terms as a proper subterm. It also eliminates any *) (* duplicates. *) (*----------------------------------------------------------------------------*) let minimal_common_subterms tml = let tml' = setify tml in filter (fun tm -> not (exists (fun tm' -> (is_subterm tm' tm) && (not (tm' = tm))) tml')) tml';; (*----------------------------------------------------------------------------*) (* to_be_generalized : term -> term list -> term -> bool *) (* *) (* This function decides whether a subterm of a literal should be generalized.*) (* It takes a literal, a list of other literals, and a subterm of the literal *) (* as arguments. The subterm should be generalized if it occurs in one of the *) (* other literals, or if the literal is an equality and it occurs on both *) (* sides, or if the literal is the negation of an equality and the subterm *) (* occurs on both sides. *) (*----------------------------------------------------------------------------*) let to_be_generalized tm tml gen = try (let (l,r) = dest_eq (dest_neg tm) in if ((is_subterm gen l) && (is_subterm gen r)) then true else failwith "") with Failure _ -> try (let (l,r) = dest_eq tm in if ((is_subterm gen l) && (is_subterm gen r)) then true else failwith "") with Failure _ -> (exists (is_subterm gen) tml);; (*----------------------------------------------------------------------------*) (* terms_to_be_generalized : term -> term list *) (* *) (* Given a clause, this function determines the subterms of the clause that *) (* are to be generalized. For each literal, the function computes the *) (* generalizable subterms. It then filters out those subterms that are not to *) (* be generalized. It only looks at the remaining literals when doing this, *) (* not at those already processed. This is legitimate because if the subterm *) (* occurs in a previous literal, it would have already been added to the main *) (* list of subterms that should be generalized. Before returning this main *) (* list, the function removes any non-minimal common subterms. This operation *) (* also removes any duplicates. *) (*----------------------------------------------------------------------------*) let terms_to_be_generalized tm = let accessors = (all_accessors ()) @ (all_constructors()) in let rec terms_to_be_generalized' tml = if (tml = []) then [] else let h::t = tml in let gens = generalizable_subterms accessors h in let gens' = filter (to_be_generalized h t) gens in gens' @ (terms_to_be_generalized' t) in minimal_common_subterms (terms_to_be_generalized' (disj_list tm));; (*----------------------------------------------------------------------------*) (* distinct_var : term list -> type -> term *) (* *) (* Function to generate a sensibly-named variable of a specified type. *) (* Variables that the new variable must be distinct from can be specified in *) (* the first argument. The new variable will be named according to the first *) (* letter of the top-level constructor in the specified type, or if the type *) (* is a simple polymorphic type, the name `x' is used. The actual name will *) (* be this name followed by zero or more apostrophes. *) (*----------------------------------------------------------------------------*) let distinct_var vars ty = let letter = try((hd o explode o fst o dest_type) ty) with Failure _ -> "x" in variant vars (mk_var (letter,ty));; (*----------------------------------------------------------------------------*) (* distinct_vars : term list -> type list -> term list *) (* *) (* Generates new variables using `distinct_var' for each of the types in the *) (* given list. The function ensures that each of the new variables are *) (* distinct from each other, as well as from the argument list of variables. *) (*----------------------------------------------------------------------------*) let rec distinct_vars vars tyl = if (tyl = []) then [] else let var = distinct_var vars (hd tyl) in var::(distinct_vars (var::vars) (tl tyl));; (*----------------------------------------------------------------------------*) (* apply_gen_lemma : term -> thm -> thm *) (* *) (* Given a term to be generalized and a generalization lemma, this function *) (* tries to apply the lemma to the term. The result, if successful, is a *) (* specialization of the lemma. *) (* *) (* The function checks that the lemma has no hypotheses, and then extracts a *) (* list of subterms of the conclusion that match the given term and contain *) (* all the free variables of the conclusion. The second condition prevents *) (* new variables being introduced into the goal clause. The ordering of the *) (* subterms in the list is dependent on the implementation of `find_terms', *) (* but probably doesn't matter anyway, because the function tries each of *) (* them until it finds one that is acceptable. *) (* *) (* Each subterm is tried as follows. A matching between the subterm and the *) (* term to be generalized is obtained. This is used to instantiate the lemma. *) (* The function then checks that when the conclusion of this new theorem is *) (* generalized (by replacing the term to be generalized with a variable), the *) (* function symbol of the term to be generalized no longer appears in it. *) (*----------------------------------------------------------------------------*) let apply_gen_lemma tm th = try (let apply_gen_lemma' subtm = (let (_,tm_bind,ty_bind) = term_match [] subtm tm in let (insts,vars) = List.split tm_bind in let th' = ((SPECL insts) o (GENL vars) o (INST_TYPE ty_bind)) th in let gen_conc = subst [(genvar (type_of tm),tm)] (concl th') and f = fst (strip_comb tm) in if (is_subterm f gen_conc) then failwith "" else th') in let ([],conc) = dest_thm th in let conc_vars = frees conc in let good_subterm subtm = ((can (term_match [] subtm) tm) && ((subtract conc_vars (frees subtm)) = [])) in let subtms = rev (find_terms good_subterm conc) in tryfind apply_gen_lemma' subtms ) with Failure _ -> failwith "apply_gen_lemma";; (*----------------------------------------------------------------------------*) (* applicable_gen_lemmas : term list -> thm list *) (* *) (* Computes instantiations of generalization lemmas applicable to a list of *) (* terms, the terms to be generalized. *) (*----------------------------------------------------------------------------*) let applicable_gen_lemmas tml = flat (map (fun tm -> mapfilter (apply_gen_lemma tm) (gen_lemmas ())) tml);; (*----------------------------------------------------------------------------*) (* generalize_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* Generalization heuristic. *) (* *) (* This function first computes the terms to be generalized in a clause. It *) (* fails if there are none. It then obtains a list of instantiated *) (* generalization lemmas for these terms. Each of these lemmas is transformed *) (* to a theorem of the form |- x = F. If the original lemma was a negation, *) (* x is the argument of the negation. Otherwise x is the negation of the *) (* original lemma. *) (* *) (* The negated lemmas are added to the clause, and the result is generalized *) (* by replacing each of the terms to be generalized by new distinct *) (* variables. This generalized clause is returned together with a proof of *) (* the original clause from it. *) (* *) (* The proof begins by specializing the variables that were used to replace *) (* the generalized terms. The theorem is then of the form: *) (* *) (* |- lemma1 \/ lemma2 \/ ... \/ lemman \/ original_clause (1) *) (* *) (* We have a theorem |- lemmai = F for each i between 1 and n. Consider the *) (* first of these. From it, the following theorem can be obtained: *) (* *) (* |- lemma1 \/ lemma2 \/ ... \/ lemman \/ original_clause = *) (* F \/ lemma2 \/ ... \/ lemman \/ original_clause *) (* *) (* Simplifying using |- F \/ x = x, this gives: *) (* *) (* |- lemma1 \/ lemma2 \/ ... \/ lemman \/ original_clause = *) (* lemma2 \/ ... \/ lemman \/ original_clause *) (* *) (* From this theorem and (1), we obtain: *) (* *) (* |- lemma2 \/ ... \/ lemman \/ original_clause *) (* *) (* Having repeated this process for each of the lemmas, the proof eventually *) (* returns a theorem for the original clause, i.e. |- original_clause. *) (*----------------------------------------------------------------------------*) let generalize_heuristic (tm,(ind:bool)) = try (let NEGATE th = let ([],tm) = dest_thm th in if (is_neg tm) then EQF_INTRO th else EQF_INTRO (CONV_RULE (REWR_CONV (SYM (SPEC_ALL (hd (CONJUNCTS NOT_CLAUSES))))) th) and ELIM_LEMMA lemma th = let rest = snd (dest_disj (concl th)) in EQ_MP (CONV_RULE (RAND_CONV (REWR_CONV F_OR)) (AP_THM (AP_TERM `(\/)` lemma) rest)) th in let gen_terms = check (fun l -> not (l = [])) (terms_to_be_generalized tm) in let lemmas = map NEGATE (applicable_gen_lemmas gen_terms) in let tm' = itlist (curry mk_disj) (map (lhs o concl) lemmas) tm in let new_vars = distinct_vars (frees tm') (map type_of gen_terms) in let tm'' = subst (lcombinep (new_vars,gen_terms)) tm' in let countercheck = try counter_check 5 tm'' with Failure _ -> warn true "Could not generate counter example!" ; true in if (countercheck = true) then let proof th'' = let th' = SPECL gen_terms (GENL new_vars th'') in rev_itlist ELIM_LEMMA lemmas th' in (proof_print_string_l "-> Generalize Heuristic"() ; my_gen_terms := tm''::!my_gen_terms ; ([(tm'',ind)],apply_proof (proof o hd) [tm''])) else failwith "Counter example failure!" ) with Failure _ -> failwith "generalize_heuristic";; (* Implementation of Aderhold's Generalization techniques: *) let is_constructor_eq constructor v tm = try ( let (a,b) = dest_eq tm in let cand_c = ( if ( v = a ) then b else if ( v = b ) then a else failwith "" ) in let cand_name = (fst o dest_const o fst o strip_comb) cand_c in constructor = cand_name (* then cand_name else failwith ""*) ) with Failure _ -> false;; let is_constructor_neq constructor v tm = try ( let tm' = dest_neg tm in let (a,b) = dest_eq tm' in let cand_c = ( if ( v = a ) then b else if ( v = b ) then a else failwith "" ) in let cand_name = (fst o dest_const o fst o strip_comb) cand_c in constructor = cand_name ) with Failure _ -> false;; let infer_constructor v tm = try ( print_term v;print_string " XXX ";print_term tm;print_newline(); let v_ty = (fst o dest_type) (type_of v) in let clist = map fst3 ((shell_constructors o sys_shell_info) v_ty) in let conjs = conj_list tm in let check_constructor_eq c v tms = let res = map (is_constructor_eq c v) tms in if (mem true res) then true else false in let check_constructor_neq c v tms = let res = map (is_constructor_neq c v) tms in if (mem true res) then true else false in let check_constructor c all_constr v tms = if (check_constructor_eq c v tms) then true else let constrs = subtract all_constr [c] in let res = map (fun c -> check_constructor_neq c v tms) constrs in if (mem false res) then false else true in let res = map (fun c -> check_constructor c clist v conjs) clist in let reslist = List.combine res clist in assoc true reslist ) with Failure _ -> failwith "infer_constructor";; let get_rec_pos_of_fun f = try ( (fst o get_def o fst o dest_const) f ) with Failure _ -> 0;; let rec is_in_rec_pos subtm tm = let (op,args) = strip_comb tm in try ( let rec_argn = get_rec_pos_of_fun op in if ( (el (rec_argn - 1) args) = subtm ) then true else failwith "" ) with Failure _ -> mem true (map (is_in_rec_pos subtm) args) ;; let is_var_in_rec_pos v tm = try ( if (not (is_var v)) then false else if (not (mem v (frees tm))) then false else is_in_rec_pos v tm ) with Failure _ -> false;; let eliminateSelectors tm = try ( let vars = frees tm in let vars' = filter (not o (fun v -> is_var_in_rec_pos v tm )) vars in if (vars' = []) then tm else let rec find_candidate vars tm = if ( vars = [] ) then failwith "find_candidate" else let var = (hd vars) in try ( (var,infer_constructor var tm) ) with Failure _ -> find_candidate (tl vars) tm in let (var,constr) = find_candidate vars' tm in let v_ty = (fst o dest_type) (type_of var) in let s_info = sys_shell_info v_ty in let new_vars = distinct_vars vars (shell_constructor_arg_types constr s_info) in let new_subtm = list_mk_icomb constr new_vars in let new_tm = subst [new_subtm,var] tm in (snd o dest_eq o concl) (REWRITE_CONV (map snd (shell_constructor_accessors constr s_info)) new_tm) ) with Failure _ -> failwith "eliminateSelectors";; let all_variables = let rec vars(acc,tm) = if is_var tm then tm::acc else if is_const tm then acc else if is_abs tm then let v,bod = dest_abs tm in vars(v::acc,bod) else let l,r = dest_comb tm in vars(vars(acc,r),l) in fun tm -> vars([],tm);; let all_equations = let rec eqs(acc,tm) = if is_eq tm then tm::acc else if is_var tm then acc else if is_const tm then acc else if is_abs tm then let v,bod = dest_abs tm in eqs(acc,bod) else let l,r = dest_comb tm in eqs(eqs(acc,r),l) in fun tm -> eqs([],tm);; let rec contains_any tm args = if is_var tm then false else if is_numeral tm then false else if is_const tm then mem ((fst o dest_const) tm) args else if is_abs tm then let v,bod = dest_abs tm in contains_any v args else let l,r = dest_comb tm in (contains_any l args) || (contains_any r args);; let is_rec_type tm = try( mem ((fst o dest_type o type_of) tm) (shells()) ) with Failure _ -> false;; let is_generalizable_subterm bad tm = (is_rec_type tm) & not ( (is_var tm) || (is_const tm) || (is_numeral tm) || (contains_any tm bad) );; (*----------------------------------------------------------------------------*) (* A set S of terms is called a suitable proposal for some formula phi if each*) (* t' in S is a generalizable subterm of phi and if there is some t' in S that*) (* occurs at least twice in phi. *) (* Here gens is assumed to be the generalizable subterms of phi as found by *) (* find_bm_terms. This means that it will contain t' as many times as it was *) (* found in phi. Therefore, the occurences of t' in gens are equivalent to its*) (* occurences in phi. *) (*----------------------------------------------------------------------------*) let is_suitable_proposal s phi gens = ( forall (fun tm -> mem tm gens) s ) && (exists (fun tm -> lcount tm gens > 1) s);; let checksuitableeq = ref true;; (* equation criterion *) let newisgen = ref true;; (* Use Aderhold's (true) or Boulton's (false) is_generalizable for terms *) let is_eq_suitable t eq = if (not !checksuitableeq) then true else if (not (is_eq eq)) then false else let l,r = dest_eq eq in if ((is_subterm t r) && (is_subterm t l)) then true else length(find_bm_terms ((=) t) eq) > 1;; let generateProposals tm phi = let rec generateProposals' bad tm phi gens = let p = [] in if (is_eq tm) then let (t1,t2) = dest_eq tm in let p1 = (generateProposals' bad t1 phi gens) in let p1' = if (is_suitable_proposal [t1] phi gens) then p1@[[t1]] else p1 in let p = p @ filter (exists (fun t -> is_eq_suitable t tm)) p1' in let p2 = (generateProposals' bad t2 phi gens) in let p2' = if (is_suitable_proposal [t2] phi gens) then p2@[[t2]] else p2 in p @ filter (exists (fun t -> is_eq_suitable t tm)) p2' else if (is_comb tm) then let (op,args) = strip_comb tm in let recpos = get_rec_pos_of_fun op in let s = if (recpos > 0) then [el (recpos-1) args] else [] in let p = if (is_suitable_proposal s phi gens) then p@[s] else p in p @ flat (map (fun tm -> generateProposals' bad tm phi gens) args) else p in let bad = (all_accessors()) @ (all_constructors()) in let gens = if (!newisgen) then find_bm_terms (is_generalizable_subterm bad) phi else find_bm_terms (is_generalizable bad) phi in generateProposals' bad tm phi gens;; let proposal_induction_test s phi = let newvars = distinct_vars (frees phi) (map (type_of) s) in let subs = List.combine newvars s in let newterm = subst subs phi in let (unfl,fl) = possible_inductions newterm in if (exists (fun v -> (mem v (unfl@fl)) ) newvars ) then true else false;; let get_proposal_term_occs s phi = let gens = find_bm_terms (fun tm -> true) phi in let scount = map (fun tm -> lcount tm gens) s in itlist (+) scount 0;; let organizeProposals s phi = let stest = map (fun prop -> (prop,proposal_induction_test prop phi)) s in let indok = filter (((=) true) o snd) stest in let s' = if (indok = []) then (proof_print_string_l "Weak Generalization" (map fst stest)) else (map fst indok) in if (length s' = 1) then hd s' else let scounted = (rev o sort_on_snd) (map (fun prop -> (prop,lcount prop s')) s') in let smax = (snd o hd) scounted in let s'' = map fst (filter (((=) smax) o snd) scounted) in if (length s'' = 1) then hd s'' else let soccscounted = (rev o sort_on_snd) (map (fun prop -> (prop,get_proposal_term_occs prop phi)) s'') in (fst o hd) soccscounted;; let generalizeCommonSubterms tm = let props = generateProposals tm tm in if (props = []) then failwith "" else let s = organizeProposals props tm in let newvars = distinct_vars (frees tm) (map type_of s) in let varcomb = List.combine newvars s in (subst varcomb tm,varcomb);; let rec separate f v v' allrpos tm = let replace tm v v' rpos = if (not rpos) then tm else if (tm = v) then v' else (separate f v v' allrpos tm) in if (is_comb tm) then ( let (op,args) = strip_comb tm in let recpos = get_rec_pos_of_fun op in if ((allrpos) && not (op = `(=)`)) then (list_mk_comb (op,(map (fun (t,i) -> replace t v v' ((i = recpos) || (recpos = 0))) (number_list args)))) else if (op = `(=)`) then (list_mk_comb(op,[replace (hd args) v v' true;replace ((hd o tl) args) v v' true])) else if (op = f) then (list_mk_comb (op,(map (fun (t,i) -> replace t v v' (i = recpos)) (number_list args)))) else (list_mk_comb (op,(map (separate f v v' allrpos) args))) ) else tm;; let rec generalized_apart_successfully v v' tm tm' = if (tm' = v') then true else if (is_eq tm) then ( let (tm1,tm2) = dest_eq tm in let (tm1',tm2') = dest_eq tm' in (generalized_apart_successfully v v' tm1 tm1') && (generalized_apart_successfully v v' tm2 tm2') ) else ( let av = all_variables tm in let av' = all_variables tm' in let varsub = List.combine av av' in ((mem (v,v') varsub) && (mem v av')) );; let useful_apart_generalization v v' tm gen = let eqssub = List.combine (all_equations tm) (all_equations gen) in let eqsok = forall (fun (x,y) -> (x=y) || (generalized_apart_successfully v v' x y)) eqssub in let countercheck = try counter_check 5 gen with Failure s -> warn true ("Could not generate counter example: " ^ s) ; true in eqsok && (generalized_apart_successfully v v' tm gen) && countercheck;; let generalize_Apart tm = let is_fun tm = (try( mem ((fst o dest_const o fst o strip_comb) tm) (defs_names ()) ) with Failure _ -> false) in let fs = find_bm_terms is_fun tm in let dfs = map strip_comb fs in let find_f (op,args) dfs = ( let r = get_rec_pos_of_fun op in let arg_filter args args' = (let v = el (r-1) args in (is_var v) && (mem v (snd (remove_el r args')))) in let match_filter (op',args') = ((op' = op) && (arg_filter args args')) in can (find match_filter) dfs ) in let (f,args) = try( find (fun (op,args) -> find_f (op,args) dfs) dfs ) with Failure _ -> failwith "" in let v = el ((get_rec_pos_of_fun f) -1) args in let v' = distinct_var (flat (map frees args)) (type_of v) in let gen = separate f v v' false tm in if (useful_apart_generalization v v' tm gen) then (gen,[v',v]) else let pcs = map fst dfs in let restpcs = subtract pcs [f] in let recposs = map get_rec_pos_of_fun restpcs in let recpos = try (find ((<) 0) recposs) with Failure _ -> 0 in let gen = if (forall (fun x -> (x = 0) || (x = recpos)) recposs) then separate f v v' true tm else failwith "not same recpos for all functions" in if (useful_apart_generalization v v' tm gen) then (gen,[v',v]) else failwith "failed";; (*----------------------------------------------------------------------------*) (* Reference flag to check if a term has already been generalized so as to *) (* avoid multiple proposal generalization because of the waterfall loop. *) (*----------------------------------------------------------------------------*) let checkgen = ref true;; let generalize_heuristic_ext (tm,(ind:bool)) = if (mem tm !my_gen_terms && !checkgen) then failwith "" else try (let ELIM_LEMMA lemma th = let rest = snd (dest_disj (concl th)) in EQ_MP (CONV_RULE (RAND_CONV (REWR_CONV F_OR)) (AP_THM (AP_TERM `(\/)` lemma) rest)) th in let (tm',subs) = try( generalize_Apart tm ) with Failure _ -> (tm,[]) in let (new_vars,gen_terms) = List.split subs in let (tm'',subs) = try( generalizeCommonSubterms tm' ) with Failure _ -> (tm',[]) in if (tm = tm'') then failwith "" else let (new_vars',gen_terms') = List.split subs in let gen_terms = gen_terms@gen_terms' and new_vars = new_vars @ new_vars' in let lemmas = [] in let countercheck = try counter_check 5 tm'' with Failure s -> warn true ("Could not generate counter example: " ^ s) ; true in if (countercheck = true) then let proof th'' = let th' = SPECL gen_terms (GENL new_vars th'') in rev_itlist ELIM_LEMMA lemmas th' in (proof_print_string_l "-> Generalize Heuristic"() ; my_gen_terms := tm''::!my_gen_terms ; ([(tm'',ind)],apply_proof (proof o hd) [tm''])) else failwith "Counter example failure!" ) with Failure _ -> failwith "generalize_heuristic";; hol-light/Boyer_Moore/induction.ml000066400000000000000000000217511303454263000175220ustar00rootroot00000000000000(******************************************************************************) (* FILE : induction.ml *) (* DESCRIPTION : Induction. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 26th June 1991 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) let (CONV_OF_RCONV: conv -> conv) = let rec get_bv tm = if is_abs tm then bndvar tm else if is_comb tm then try get_bv (rand tm) with Failure _ -> get_bv (rator tm) else failwith "" in fun conv tm -> let v = get_bv tm in let th1 = conv tm in let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in TRANS th1 th2;; let (CONV_OF_THM: thm -> conv) = CONV_OF_RCONV o REWR_CONV;; let RIGHT_IMP_FORALL_CONV = CONV_OF_THM RIGHT_IMP_FORALL_THM;; (* Does this work?? *) (*----------------------------------------------------------------------------*) (* is_rec_const_app : term -> bool *) (* *) (* This function returns true if the term it is given is an application of a *) (* currently known recursive function constant. *) (*----------------------------------------------------------------------------*) let is_rec_const_app tm = try (let (f,args) = strip_comb tm in let (n,defs) = (get_def o fst o dest_const) f in (n > 0) & ((length o snd o strip_comb o lhs o concl o snd o hd) defs = length args) ) with Failure _ -> false;; (*----------------------------------------------------------------------------*) (* possible_inductions : term -> (term list # term list) *) (* *) (* Function to compute two lists of variables on which induction could be *) (* performed. The first list of variables for which the induction is unflawed *) (* and the second is of variables for which the induction is flawed. *) (* *) (* From a list of applications of recursive functions, the arguments are *) (* split into those that are in a recursive argument position and those that *) (* are not. Possible inductions are on the variables in the recursive *) (* argument positions, but if the variable also appears in a non-recursive *) (* argument position then the induction is flawed. *) (*----------------------------------------------------------------------------*) let possible_inductions tm = let apps = find_bm_terms is_rec_const_app tm in let (rec_args,other_args) = List.split (map (fun app -> let (f,args) = strip_comb app in let name = fst (dest_const f) in let n = (fst o get_def) name in remove_el n args) apps) in let vars = setify (filter is_var rec_args) in let others = setify (flat other_args) in partition (fun v -> not (mem v others)) vars;; (*----------------------------------------------------------------------------*) (* DEPTH_FORALL_CONV : conv -> conv *) (* *) (* Given a term of the form "!x1 ... xn. t", this function applies the *) (* argument conversion to "t". *) (*----------------------------------------------------------------------------*) let rec DEPTH_FORALL_CONV conv tm = if (is_forall tm) then RAND_CONV (ABS_CONV (DEPTH_FORALL_CONV conv)) tm else conv tm;; (*----------------------------------------------------------------------------*) (* induction_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* Heuristic for induction. It performs one of the possible unflawed *) (* inductions on a clause, or failing that, one of the flawed inductions. *) (* The heuristic fails if no inductions are possible. *) (* *) (* Having obtained a variable on which to perform induction, the function *) (* computes the name of the top-level type constructor in the type of the *) (* variable. The appropriate induction theorem is then obtained from the *) (* shell environment. The theorem is specialised for the argument clause and *) (* beta-reduction is performed at the appropriate places. *) (* *) (* The resulting theorem will be of the form: *) (* *) (* |- (case1 /\ ... /\ casen) ==> (!x. f[x]) ( * ) *) (* *) (* So, if we can establish casei for each i, we shall have |- !x. f[x]. When *) (* specialised with the induction variable, this theorem has the original *) (* clause as its conclusion. Each casei is of one of these forms: *) (* *) (* !x1 ... xn. s ==> (!y1 ... ym. t) *) (* !x1 ... xn. t *) (* *) (* where the yi's do not appear in s. We simplify the casei's that have the *) (* first form by proving theorems like: *) (* *) (* |- (!x1 ... xn. s ==> (!y1 ... ym. t)) = *) (* (!x1 ... xn y1 ... ym. s ==> t) *) (* *) (* For consistency, theorems of the form |- (!x1 ... xn. t) = (!x1 ... xn. t) *) (* are proved for the casei's that have the second form. The bodies of the *) (* right-hand sides of these equations are returned as the new goal clauses. *) (* A body that is an implication is taken to be an inductive step and so is *) (* returned paired with true. Bodies that are not implications are paired *) (* with false. *) (* *) (* The proof of the original clause from these new clauses proceeds as *) (* follows. The universal quantifications that were stripped from the *) (* right-hand sides are restored by generalizing the theorems. From the *) (* equations we can then obtain theorems for the left-hand sides. These are *) (* conjoined and used to satisfy the antecedant of the theorem ( * ). As *) (* described above, specialising the resulting theorem gives a theorem for *) (* the original clause. *) (*----------------------------------------------------------------------------*) let induction_heuristic (tm,(ind:bool)) = try (let (unflawed,flawed) = possible_inductions tm in let var = try (hd unflawed) with Failure _ -> (hd flawed) in let ty_name = fst (dest_type (type_of var)) in let induct_thm = (sys_shell_info ty_name).induct in let P = mk_abs (var,tm) in let th1 = ISPEC P induct_thm in let th2 = CONV_RULE (ONCE_DEPTH_CONV (fun tm -> if (rator tm = P) then BETA_CONV tm else failwith "")) th1 in let new_goals = conj_list (rand (rator (concl th2))) in let ths = map (REPEATC (DEPTH_FORALL_CONV RIGHT_IMP_FORALL_CONV)) new_goals in let (varsl,tml) = List.split (map (strip_forall o rhs o concl) ths) in let proof thl = let thl' = map (uncurry GENL) (lcombinep (varsl,thl)) in let thl'' = map (fun (eq,th) -> EQ_MP (SYM eq) th) (lcombinep (ths,thl')) in SPEC var (MP th2 (LIST_CONJ thl'')) in (map (fun tm -> (tm,((is_imp tm) && (not (is_neg tm))))) tml, apply_proof proof tml) ) with Failure _ -> failwith "induction_heuristic";; hol-light/Boyer_Moore/irrelevance.ml000066400000000000000000000346641303454263000200340ustar00rootroot00000000000000(******************************************************************************) (* FILE : irrelevance.ml *) (* DESCRIPTION : Eliminating irrelevance. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 25th June 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 12th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) let DISJ_IMP = let pth = TAUT`!t1 t2. t1 \/ t2 ==> ~t1 ==> t2` in fun th -> try let a,b = dest_disj(concl th) in MP (SPECL [a;b] pth) th with Failure _ -> failwith "DISJ_IMP";; let IMP_ELIM = let pth = TAUT`!t1 t2. (t1 ==> t2) ==> ~t1 \/ t2` in fun th -> try let a,b = dest_imp(concl th) in MP (SPECL [a;b] pth) th with Failure _ -> failwith "IMP_ELIM";; (*----------------------------------------------------------------------------*) (* partition_literals : (term # int) list -> (term # int) list list *) (* *) (* Function to partition a list of numbered terms into lists that share *) (* variables. A term in one partition has no variables in common with any *) (* term in one of the other partitions. Within a partition the terms are *) (* ordered as they were in the input list. *) (* *) (* The function begins by putting every term in a separate partition. It then *) (* tries to merge the first partition with one of the others. Two partitions *) (* can be merged if they have at least one variable in common. If a merge can *) (* be done, the process is repeated for the new head of the partition list. *) (* This continues until a merge cannot take place (this causes a failure in *) (* `merge_partitions' due to an attempt to split an empty list into a head *) (* and a tail). When this happens, the head partition is separated from the *) (* others because it cannot have any variables in common with the others. The *) (* entire process is repeated for the remaining partitions. This goes on *) (* until the list is exhausted. *) (* *) (* When as much merging as possible has been done, the terms within each *) (* partition are sorted based on the number they are paired with. *) (*----------------------------------------------------------------------------*) let partition_literals tmnl = let rec merge_partitions partition partitions = if (partitions = []) then failwith "merge_partitions" else let h::t = partitions in if ((intersect ((freesl o map fst) partition) ((freesl o map fst) h)) = []) then h::(merge_partitions partition t) else (partition @ h)::t and repeated_merge partitions = if (partitions = []) then [] else let h::t = partitions in try repeated_merge (merge_partitions h t) with Failure _ -> h::(repeated_merge t) in map sort_on_snd (repeated_merge (map (fun tmn -> [tmn]) tmnl));; (*----------------------------------------------------------------------------*) (* contains_recursive_fun : term list -> bool *) (* *) (* Determines whether a list of terms (a partition) mentions a recursive *) (* function. A constant that does not have a definition in the environment is *) (* taken to be non-recursive. *) (*----------------------------------------------------------------------------*) let contains_recursive_fun tml = let consts = flat (mapfilter (find_terms is_const) tml) in let names = setify (map (fst o dest_const) consts) in exists (fun name -> not (try ((fst o get_def) name = 0) with Failure _ -> true)) names;; (*----------------------------------------------------------------------------*) (* is_singleton_rec_app : term list -> bool *) (* *) (* Returns true if the list of terms (a partition) given as argument is a *) (* single literal whose atom is of the form (f v1 ... vn) where f is a *) (* recursive function and the vi are distinct variables. *) (*----------------------------------------------------------------------------*) let is_singleton_rec_app tml = try ( match (tml) with | [tm] -> let tm' = if (is_neg tm) then (rand tm) else tm in let (f,args) = strip_comb tm' in let name = fst (dest_const f) in (not ((fst o get_def) name = 0)) & (forall is_var args) & (distinct args) | _ -> false ) with Failure _ -> false;; (*----------------------------------------------------------------------------*) (* merge_numbered_lists : ( # int) list -> ( # int) list -> ( # int) list *) (* *) (* Merges two numbered lists. The lists must be in increasing order by the *) (* number, and no number may appear more than once in a list or appear in *) (* both lists. The result will then be ordered by the numbers. *) (*----------------------------------------------------------------------------*) let rec merge_numbered_lists xnl1 xnl2 = if (xnl1 = []) then xnl2 else if (xnl2 = []) then xnl1 else let ((x1,n1)::t1) = xnl1 and ((x2,n2)::t2) = xnl2 in if (n1 < n2) then (x1,n1)::(merge_numbered_lists t1 xnl2) else (x2,n2)::(merge_numbered_lists xnl1 t2);; (*----------------------------------------------------------------------------*) (* find_irrelevant_literals : term -> ((term # int) list # (term # int) list) *) (* *) (* Given a clause, this function produces two lists of term/integer pairs. *) (* The first list is of literals deemed to be irrelevant. The second list is *) (* the remaining literals. The number with each literal is its position in *) (* the original clause. *) (*----------------------------------------------------------------------------*) let find_irrelevant_literals tm = let can_be_falsified tmnl = let tml = map fst tmnl in (not (contains_recursive_fun tml)) || (is_singleton_rec_app tml) and tmnll = partition_literals (number_list (disj_list tm)) in let (irrels,rels) = partition can_be_falsified tmnll in (itlist merge_numbered_lists irrels [], itlist merge_numbered_lists rels []);; (*----------------------------------------------------------------------------*) (* DISJ_UNDISCH : thm -> thm *) (* *) (* A |- x \/ y *) (* ------------- DISJ_UNDISCH *) (* A, ~x |- y *) (*----------------------------------------------------------------------------*) let DISJ_UNDISCH th = try UNDISCH (DISJ_IMP th) with Failure _ -> failwith "DISJ_UNDISCH";; (*----------------------------------------------------------------------------*) (* DISJ_DISCH : term -> thm -> thm *) (* *) (* A, ~x |- y *) (* ------------- DISJ_DISCH "x:bool" *) (* A |- x \/ y *) (*----------------------------------------------------------------------------*) let DISJ_DISCH tm th = try (CONV_RULE (RATOR_CONV (RAND_CONV (REWR_CONV NOT_NOT_NORM))) (IMP_ELIM (DISCH (mk_neg tm) th)) ) with Failure _ -> failwith "DISJ_DISCH";; (*----------------------------------------------------------------------------*) (* BUILD_DISJ : ((term # int) list # (term # int) list) -> thm -> thm *) (* *) (* Function to build a disjunctive theorem from another theorem that has as *) (* its conclusion a subset of the disjuncts. The first argument is a pair of *) (* term/integer lists. Each list contains literals (disjuncts) and their *) (* position within the required result. The first list is of those disjuncts *) (* not in the theorem. The second list is of disjuncts in the theorem. Both *) (* lists are assumed to be ordered by their numbers (increasing order). *) (* *) (* Example: *) (* *) (* BUILD_DISJ ([("x2",2);("x5",5);("x6",6)],[("x1",1);("x3",3);("x4",4)]) *) (* |- x1 \/ x3 \/ x4 *) (* *) (* The required result is: *) (* *) (* |- x1 \/ x2 \/ x3 \/ x4 \/ x5 \/ x6 *) (* *) (* The first step is to undischarge all the disjuncts except for the last: *) (* *) (* ~x1, ~x3 |- x4 *) (* *) (* The disjuncts not in the theorem, and which are to come after x4, are now *) (* `added' to the theorem. (Note that we have to undischarge all but the last *) (* disjunct in order to get the correct associativity of OR (\/) at this *) (* stage): *) (* *) (* ~x1, ~x3 |- x4 \/ x5 \/ x6 *) (* *) (* We now repeatedly either discharge one of the assumptions, or add a *) (* disjunct from the `outs' list, according to the values of the numbers *) (* associated with the terms: *) (* *) (* ~x1 |- x3 \/ x4 \/ x5 \/ x6 *) (* *) (* ~x1 |- x2 \/ x3 \/ x4 \/ x5 \/ x6 *) (* *) (* |- x1 \/ x2 \/ x3 \/ x4 \/ x5 \/ x6 *) (*----------------------------------------------------------------------------*) let BUILD_DISJ (outs,ins) inth = try (let rec rebuild rev_outs rev_ins th = if (rev_ins = []) then if (rev_outs = []) then th else rebuild (tl rev_outs) rev_ins (DISJ2 (fst (hd rev_outs)) th) else if (rev_outs = []) then rebuild rev_outs (tl rev_ins) (DISJ_DISCH (fst (hd rev_ins)) th) else let (inh::int) = rev_ins and (outh::outt) = rev_outs in if (snd inh > snd outh) then rebuild rev_outs int (DISJ_DISCH (fst inh) th) else rebuild outt rev_ins (DISJ2 (fst outh) th) in let last_in = snd (last ins) in let (under_outs,over_outs) = partition (fun (_,n) -> n > last_in) outs in let over_ins = butlast ins in let th1 = funpow (length over_ins) DISJ_UNDISCH inth in let th2 = try (DISJ1 th1 (list_mk_disj (map fst under_outs))) with Failure _ -> th1 in rebuild (rev over_outs) (rev over_ins) th2 ) with Failure _ -> failwith "BUILD_DISJ";; (*----------------------------------------------------------------------------*) (* irrelevance_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* Heuristic for eliminating irrelevant literals. The function splits the *) (* literals into two sets: those that are irrelevant and those that are not. *) (* If there are no relevant terms left, the heuristic fails in a way that *) (* indicates the conjecture cannot be proved. If there are no irrelevant *) (* literals, the function fails indicating that it cannot do anything with *) (* the clause. In all other circumstances the function returns a new clause *) (* consisting of only the relevant literals, together with a proof of the *) (* original clause from this new clause. *) (*----------------------------------------------------------------------------*) let irrelevance_heuristic (tm,(ind:bool)) = let (outs,ins) = find_irrelevant_literals tm in if (ins = []) then failwith "cannot prove" else if (outs = []) then failwith "irrelevance_heuristic" else let tm' = list_mk_disj (map fst ins) and proof = BUILD_DISJ (outs,ins) in (proof_print_string_l "-> Irrelevance Heuristic" () ; ([(tm',ind)],apply_proof (proof o hd) [tm']));; hol-light/Boyer_Moore/main.ml000066400000000000000000000231151303454263000164460ustar00rootroot00000000000000(******************************************************************************) (* FILE : main.ml *) (* DESCRIPTION : The main functions for the Boyer-Moore-style prover. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 27th June 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 13th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) (*----------------------------------------------------------------------------*) (* BOYER_MOORE : conv *) (* *) (* Boyer-Moore-style automatic theorem prover. *) (* Given a term "tm", attempts to prove |- tm. *) (*----------------------------------------------------------------------------*) let BOYER_MOORE_MESON tm = my_gen_terms := []; counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline (FILTERED_WATERFALL [taut_heuristic; clausal_form_heuristic; setify_heuristic; meson_heuristic; subst_heuristic; HL_simplify_heuristic; use_equality_heuristic; generalize_heuristic_ext; irrelevance_heuristic] induction_heuristic [] (tm,false)) ) with Failure _ -> failwith "BOYER_MOORE";; let BOYER_MOORE_GEN tm = my_gen_terms := []; counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline (FILTERED_WATERFALL [taut_heuristic; clausal_form_heuristic; setify_heuristic; subst_heuristic; HL_simplify_heuristic; use_equality_heuristic; generalize_heuristic_ext; irrelevance_heuristic] induction_heuristic [] (tm,false)) ) with Failure _ -> failwith "BOYER_MOORE";; let BOYER_MOORE_EXT tm = my_gen_terms := []; counterexamples := 0; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline (FILTERED_WATERFALL [taut_heuristic; clausal_form_heuristic; setify_heuristic; subst_heuristic; use_equality_heuristic; HL_simplify_heuristic; (* meson_heuristic; *) generalize_heuristic; irrelevance_heuristic] induction_heuristic [] (tm,false)) ) with Failure _ -> failwith "BOYER_MOORE";; let BOYER_MOORE tm = counterexamples := 0; my_gen_terms := []; proof_print_depth := 0; bm_steps := (0,0); try (proof_print_newline (WATERFALL [clausal_form_heuristic; subst_heuristic; simplify_heuristic; use_equality_heuristic; generalize_heuristic; irrelevance_heuristic] induction_heuristic (tm,false)) ) with Failure _ -> failwith "BOYER_MOORE";; (*----------------------------------------------------------------------------*) (* BOYER_MOORE_CONV : conv *) (* *) (* Boyer-Moore-style automatic theorem prover. *) (* Given a term "tm", attempts to prove |- tm = T. *) (*----------------------------------------------------------------------------*) let BOYER_MOORE_CONV tm = try (EQT_INTRO (BOYER_MOORE tm)) with Failure _ -> failwith "BOYER_MOORE_CONV";; (*----------------------------------------------------------------------------*) (* HEURISTIC_TAC : *) (* ((term # bool) -> ((term # bool) list # proof)) list -> tactic *) (* *) (* Tactic to do automatic proof using a list of heuristics. The tactic will *) (* fail if it thinks the goal is not a theorem. Otherwise it will either *) (* prove the goal, or return as subgoals the conjectures it couldn't handle. *) (* *) (* If the `proof_printing' flag is set to true, the tactic displays each new *) (* conjecture it generates, prints blank lines between subconjectures which *) (* resulted from a split, and prints a final blank line when it can do no *) (* more. *) (* *) (* Given a goal, the tactic constructs an implication from it, so that the *) (* hypotheses are made available. It then tries to prove this implication. *) (* When it can do no more, the function splits the clauses that it couldn't *) (* prove into disjuncts. The last disjunct is assumed to be a conclusion, and *) (* the rest are taken to be hypotheses. These new goals are returned together *) (* with a proof of the original goal. *) (* *) (* The proof takes a list of theorems for the subgoals and discharges the *) (* hypotheses so that the theorems are in clausal form. These clauses are *) (* then used to prove the implication that was constructed from the original *) (* goal. Finally the antecedants of this implication are undischarged to give *) (* a theorem for the original goal. *) (*----------------------------------------------------------------------------*) let HEURISTIC_TAC heuristics (asl,w) = proof_print_depth := 0; try (let negate tm = if (is_neg tm) then (rand tm) else (mk_neg tm) and NEG_DISJ_DISCH tm th = if (is_neg tm) then DISJ_DISCH (rand tm) th else CONV_RULE (REWR_CONV IMP_DISJ_THM) (DISCH tm th) in let tm = list_mk_imp (asl,w) in let tree = proof_print_newline (waterfall (clausal_form_heuristic::heuristics) (tm,false)) in let tml = map fst (fringe_of_clause_tree tree) in let disjsl = map disj_list tml in let goals = map (fun disjs -> (map negate (butlast disjs),last disjs)) disjsl in let proof thl = let thl' = map (fun (th,goal)-> itlist NEG_DISJ_DISCH (fst goal) th) (lcombinep (thl,goals)) in funpow (length asl) UNDISCH (prove_clause_tree tree thl') in (goals,proof) ) with Failure _ -> failwith "HEURISTIC_TAC";; (*----------------------------------------------------------------------------*) (* BOYER_MOORE_TAC : tactic *) (* *) (* Tactic to do automatic proof using Boyer & Moore's heuristics. The tactic *) (* will fail if it thinks the goal is not a theorem. Otherwise it will either *) (* prove the goal, or return as subgoals the conjectures it couldn't handle. *) (*----------------------------------------------------------------------------*) let BOYER_MOORE_TAC aslw = try (HEURISTIC_TAC [subst_heuristic; simplify_heuristic; use_equality_heuristic; generalize_heuristic; irrelevance_heuristic; induction_heuristic] aslw ) with Failure _ -> failwith "BOYER_MOORE_TAC";; (*----------------------------------------------------------------------------*) (* BM_SIMPLIFY_TAC : tactic *) (* *) (* Tactic to do automatic simplification using Boyer & Moore's heuristics. *) (* The tactic will fail if it thinks the goal is not a theorem. Otherwise, it *) (* will either prove the goal or return the simplified conjectures as *) (* subgoals. *) (*----------------------------------------------------------------------------*) let BM_SIMPLIFY_TAC aslw = try (HEURISTIC_TAC [subst_heuristic;simplify_heuristic] aslw ) with Failure _ -> failwith "BM_SIMPLIFY_TAC";; (*----------------------------------------------------------------------------*) (* BM_INDUCT_TAC : tactic *) (* *) (* Tactic which attempts to do a SINGLE induction using Boyer & Moore's *) (* heuristics. The cases of the induction are returned as subgoals. *) (*----------------------------------------------------------------------------*) let BM_INDUCT_TAC aslw = try (let induct = ref true in let once_induction_heuristic x = if !induct then (induct := false; induction_heuristic x) else failwith "" in HEURISTIC_TAC [once_induction_heuristic] aslw ) with Failure _ -> failwith "BM_INDUCT_TAC";; hol-light/Boyer_Moore/make.ml000066400000000000000000000200661303454263000164410ustar00rootroot00000000000000(* ========================================================================= *) (* Load in Petros Papapanagiotou's Boyer-Moore code and try examples. *) (* ========================================================================= *) loads "Boyer_Moore/boyer-moore.ml";; (* ------------------------------------------------------------------------- *) (* Slight variant of Petros's eval.ml file. *) (* ------------------------------------------------------------------------- *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Shortcuts for the various evaluation versions: *) (* ------------------------------------------------------------------------- *) let BM = BOYER_MOORE;; (* Pure re-implementation of R.Boulton's work. *) let BME = BOYER_MOORE_EXT;; (* Extended with early termination heuristics and HOL Light features. *) let BMG = BOYER_MOORE_GEN;; (* Further extended with M.Aderhold's generalization techniques. *) let RBM = new_rewrite_rule o BOYER_MOORE;; let RBME = new_rewrite_rule o BOYER_MOORE_EXT;; let RBMG = new_rewrite_rule o BOYER_MOORE_GEN;; (* ------------------------------------------------------------------------- *) (* Add a theorem as a new function definition and rewrite rule. *) (* Adding it as a rewrite rule should no longer be necessary after the *) (* latest (July 2009) bugfixes but it doesn't do any harm either. *) (* ------------------------------------------------------------------------- *) let new_stuff x = (new_def x ; new_rewrite_rule x);; (* ------------------------------------------------------------------------- *) (* Test sets extracted from the proven theorems in HOL Light's arith.ml and *) (* list.ml. *) (* ------------------------------------------------------------------------- *) loads "Boyer_Moore/testset/arith.ml";; (* Arithmetic test set *) loads "Boyer_Moore/testset/list.ml";; (* List test set *) (* ------------------------------------------------------------------------- *) (* Reloads all the necessary definitions and rules for the evaluation of the *) (* test sets above. *) (* ------------------------------------------------------------------------- *) let bm_reset () = system_defs := []; system_rewrites := []; new_stuff ADD; new_stuff MULT; new_stuff SUB; new_stuff LE; new_stuff LT; new_stuff GE; new_stuff GT; new_rewrite_rule (ARITH_RULE `1=SUC(0)`); new_stuff EXP; new_stuff FACT; new_stuff ODD; new_stuff EVEN; new_rewrite_rule NOT_SUC; new_rewrite_rule SUC_INJ; new_rewrite_rule PRE; new_stuff HD; new_stuff TL; new_stuff APPEND; new_stuff REVERSE; new_stuff LENGTH; new_stuff MAP; new_stuff LAST; new_stuff REPLICATE; new_stuff NULL; new_stuff ALL; new_stuff EX; new_stuff ITLIST; new_stuff MEM; new_stuff ALL2_DEF; new_rewrite_rule ALL2; new_stuff MAP2_DEF; new_rewrite_rule MAP2; new_stuff EL; new_stuff FILTER; new_stuff ASSOC; new_stuff ITLIST2_DEF; new_rewrite_rule ITLIST2; new_stuff ZIP_DEF; new_rewrite_rule ZIP; new_rewrite_rule NOT_CONS_NIL; new_rewrite_rule CONS_11 ;; bm_reset();; (* ------------------------------------------------------------------------- *) (* Test functions. They use the Unix library to measure time. *) (* Unfortunately this means that they do not load properly in Cygwin. *) (* ------------------------------------------------------------------------- *) #load "unix.cma";; open Unix;; open Printf;; (* ------------------------------------------------------------------------- *) (* Reference of the remaining theory to be proven. Load a list of theorems *) (* that you want the evaluation to run through. *) (* eg. remaining_theory := !mytheory;; *) (* Then use nexttm (see below) to evaluate one of the BOYER_MOORE_* *) (* procedures over the list. *) (* ------------------------------------------------------------------------- *) let remaining_theory = ref ([]:term list);; let currenttm = ref `p`;; (* ------------------------------------------------------------------------- *) (* Tries a theorem-proving procedure f on arg. *) (* Returns a truth value of whether the procedure succeeded in finding a *) (* proof and a pair of timestamps taken from the start and the end of the *) (* procedure. *) (* ------------------------------------------------------------------------- *) let bm_time f arg = let t1=Unix.times () in let resu = try (if (can dest_thm (f arg)) then true else false) with Failure _ -> false in let t2=Unix.times () in (resu,(t1,t2));; (* printf "User time: %f - system time: %f\n%!" (t2.tms_utime -. t1.tms_utime) (t2.tms_stime -. t1.tms_stime);; *) (* ------------------------------------------------------------------------- *) (* Uses bm_time to try a Boyer-Moore theorem-proving procedure f on tm. *) (* Prints out all the evaluation information that is collected and returns *) (* the list of generalizations made during the proof. *) (* ------------------------------------------------------------------------- *) let bm_test f tm = let pfpt = (print_term tm ; print_newline() ; proof_printer false) in let (resu,(t1,t2)) = bm_time f tm in let pfpt = proof_printer pfpt in printf "Proven: %b - Time: %f - Steps: %d - Inductions: %d - Gen terms: %d - Over gens: %d \\\\\n" resu (t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; !my_gen_terms;; (* ------------------------------------------------------------------------- *) (* Another version of bm_test but with a more compact printout. *) (* Returns unit (). *) (* ------------------------------------------------------------------------- *) let bm_test2 f tm = let pfpt = (print_term tm ; print_newline() ; proof_printer false) in let (resu,(t1,t2)) = bm_time f tm in let pfpt = proof_printer pfpt in printf "& %b & %f & %d & %d & %d & %d \\\\\n" resu (t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; ();; (* ------------------------------------------------------------------------- *) (* Convenient function for evaluation. *) (* Uses f to try and prove the next term in !remaining_theory by bm_test2 *) (* ------------------------------------------------------------------------- *) let nexttm f = if (!remaining_theory = []) then failwith "No more" else currenttm := hd !remaining_theory ; remaining_theory := tl !remaining_theory ; bm_test2 f !currenttm;; (* ------------------------------------------------------------------------- *) (* Reruns evaluation on the same term that was last loaded with nexttm. *) (* ------------------------------------------------------------------------- *) let sametm f = bm_test2 f !currenttm;; (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Just one example. *) (* ------------------------------------------------------------------------- *) bm_test BME `m + n:num = n + m`;; (* ------------------------------------------------------------------------- *) (* Note that these don't all terminate, so need more delicacy really. *) (* Should carefully reconstruct the cases in Petros's thesis, also maybe *) (* using a timeout. *) (* ------------------------------------------------------------------------- *) (**** do_list (bm_test BME) (!mytheory);; do_list (bm_test BME) (!mytheory2);; ****) hol-light/Boyer_Moore/rewrite_rules.ml000066400000000000000000000434001303454263000204140ustar00rootroot00000000000000(******************************************************************************) (* FILE : rewrite_rules.ml *) (* DESCRIPTION : Using axioms and lemmas as rewrite rules. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 14th May 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 15th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) (*----------------------------------------------------------------------------*) (* is_permutative : term -> bool *) (* *) (* Determines whether or not an equation is permutative (the left-hand and *) (* right-hand sides are instances of one another). A permutative equation may *) (* cause looping when it is used for rewriting. *) (*----------------------------------------------------------------------------*) let is_permutative tm = try (let (l,r) = dest_eq tm in let bind1 = term_match [] l r and bind2 = term_match [] r l in true ) with Failure _ -> false;; (*----------------------------------------------------------------------------*) (* lex_smaller_term : term -> term -> bool *) (* *) (* Computes whether the first term is `alphabetically' smaller than the *) (* second term. Used to avoid looping when rewriting with permutative rules. *) (* *) (* A constant is considered to be smaller than a variable which in turn is *) (* considered to be smaller than an application. Two variables or two *) (* constants are compared alphabetically by name. An application (f1 x1) is *) (* considered to be smaller than another application (f2 x2) if either f1 is *) (* smaller than f2, or f1 equals f2 and x1 is smaller than x2. *) (*----------------------------------------------------------------------------*) let rec lex_smaller_term tm1 tm2 = try (if (is_const tm1) then (if (is_const tm2) then let (name1,type1) = dest_const tm1 and (name2,type2) = dest_const tm2 in (if (type1 = type2) then name1 < name2 else failwith "" ) else true) else if (is_var tm1) then (if (is_const tm2) then false else if (is_var tm2) then let (name1,type1) = dest_var tm1 and (name2,type2) = dest_var tm2 in (if (type1 = type2) then name1 < name2 else failwith "" ) else true) else if (is_comb tm1) then (if (is_comb tm2) then let (rator1,rand1) = dest_comb tm1 and (rator2,rand2) = dest_comb tm2 in (lex_smaller_term rator1 rator2) || ((rator1 = rator2) && (lex_smaller_term rand1 rand2)) else false) else failwith "" ) with Failure _ -> failwith "lex_smaller_term";; (*----------------------------------------------------------------------------*) (* inst_eq_thm : ((term # term) list # (type # type) list) -> thm -> thm *) (* *) (* Instantiates a theorem (possibly having hypotheses) with a binding. *) (* Assumes the conclusion is an equality, so that discharging then undisching *) (* cannot cause parts of the conclusion to be moved into the hypotheses. *) (*----------------------------------------------------------------------------*) let inst_eq_thm (tm_bind,ty_bind) th = let (insts,vars) = List.split tm_bind in (UNDISCH_ALL o (SPECL insts) o (GENL vars) o (INST_TYPE ty_bind) o DISCH_ALL) th;; (*----------------------------------------------------------------------------*) (* applicable_rewrites : term -> thm list *) (* *) (* Returns the results of rewriting the term with those rewrite rules that *) (* are applicable to it. A rewrite rule is not applicable if it's permutative *) (* and the rewriting does not produce an alphabetically smaller term. *) (*----------------------------------------------------------------------------*) let applicable_rewrites tm = let applicable_rewrite tm th = let conc = concl th in let (_,tm_bind,ty_bind) = term_match [] (lhs conc) tm in let instth = inst_eq_thm (tm_bind,ty_bind) th in if (is_permutative conc) then (let (l,r) = dest_eq (concl instth) in if (lex_smaller_term r l) then instth else failwith "") else instth in mapfilter ((applicable_rewrite tm) o snd) !system_rewrites;; (*----------------------------------------------------------------------------*) (* ARGS_CONV : conv -> conv *) (* *) (* Applies a conversion to every argument of an application of the form *) (* "f x1 ... xn". *) (*----------------------------------------------------------------------------*) let rec ARGS_CONV conv tm = try ( ((RATOR_CONV (ARGS_CONV conv)) THENC (RAND_CONV conv)) tm ) with Failure _ -> ALL_CONV tm;; (*----------------------------------------------------------------------------*) (* assump_inst_hyps : term list -> *) (* term -> *) (* term list -> *) (* ((term # term) list # (type # type) list) *) (* *) (* Searches a list of hypotheses for one that matches the specified *) (* assumption such that the variables instantiated are precisely those in the *) (* list of variables given. If such a hypothesis is found, the binding *) (* produced by the match is returned. *) (*----------------------------------------------------------------------------*) let rec assump_inst_hyps vars assump hyps = try(let (_,tm_bind,ty_bind) = term_match [] (hd hyps) assump in let bind = (tm_bind,ty_bind) in if (set_eq vars (map snd (fst bind))) then bind else failwith "") with Failure _ -> try (assump_inst_hyps vars assump (tl hyps)) with Failure _ -> failwith "assump_inst_hyps";; (*----------------------------------------------------------------------------*) (* assumps_inst_hyps : term list -> *) (* term list -> *) (* term list -> *) (* ((term # term) list # (type # type) list) *) (* *) (* Searches a list of hypotheses and a list of assumptions for a pairing that *) (* match (the assumption is an instance of the hypothesis) such that the *) (* variables instantiated are precisely those in the list of variables given. *) (* If such a pair is found, the binding produced by the match is returned. *) (*----------------------------------------------------------------------------*) let rec assumps_inst_hyps vars assumps hyps = try (assump_inst_hyps vars (hd assumps) hyps) with Failure _ -> try (assumps_inst_hyps vars (tl assumps) hyps) with Failure _ -> failwith "assumps_inst_hyps";; (*----------------------------------------------------------------------------*) (* inst_frees_in_hyps : term list -> thm -> thm *) (* *) (* Takes a theorem (possibly with hypotheses) and computes a list of *) (* variables that are free in the hypotheses but not in the conclusion. *) (* If this list of variables is empty the original theorem is returned. *) (* The function also takes a list of assumptions as another argument. Once it *) (* has the list of variables it searches for an assumption and a hypothesis *) (* such that the hypothesis matches the assumption binding precisely those *) (* variables in the list. If this is successful the original theorem is *) (* returned having had the variables in the list instantiated. *) (*----------------------------------------------------------------------------*) let inst_frees_in_hyps assumps th = try (let hyps = hyp th in let hyp_frees = setify (flat (map frees hyps)) in let vars = subtract hyp_frees (frees (concl th)) in if (vars = []) then th else let bind = assumps_inst_hyps vars assumps hyps in inst_eq_thm bind th ) with Failure _ -> failwith "inst_frees_in_hyps";; (*----------------------------------------------------------------------------*) (* NOT_IMP_EQ_EQ_EQ_OR = |- (~x ==> (y = y')) = ((y \/ x) = (y' \/ x)) *) (*----------------------------------------------------------------------------*) let NOT_IMP_EQ_EQ_EQ_OR = prove (`(~x ==> (y = y')) = ((y \/ x) = (y' \/ x))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `y:bool` THEN BOOL_CASES_TAC `y':bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* IMP_EQ_EQ_EQ_OR_NOT = |- (x ==> (y = y')) = ((y \/ ~x) = (y' \/ ~x)) *) (*----------------------------------------------------------------------------*) let IMP_EQ_EQ_EQ_OR_NOT = prove (`(x ==> (y = y')) = ((y \/ ~x) = (y' \/ ~x))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `y:bool` THEN BOOL_CASES_TAC `y':bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* NOT_IMP_EQ_OR_EQ_EQ_OR_OR = *) (* |- (~x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (x \/ t)) = (y' \/ (x \/ t))) *) (*----------------------------------------------------------------------------*) let NOT_IMP_EQ_OR_EQ_EQ_OR_OR = prove (`(~x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (x \/ t)) = (y' \/ (x \/ t)))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `y:bool` THEN BOOL_CASES_TAC `y':bool` THEN BOOL_CASES_TAC `t:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* IMP_EQ_OR_EQ_EQ_OR_NOT_OR = *) (* |- (x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (~x \/ t)) = (y' \/ (~x \/ t))) *) (*----------------------------------------------------------------------------*) let IMP_EQ_OR_EQ_EQ_OR_NOT_OR = prove (`(x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (~x \/ t)) = (y' \/ (~x \/ t)))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `y:bool` THEN BOOL_CASES_TAC `y':bool` THEN BOOL_CASES_TAC `t:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* IMP_EQ_EQ_EQ_NOT_OR = |- (x ==> (t = t')) = ((~x \/ t) = (~x \/ t')) *) (*----------------------------------------------------------------------------*) let IMP_EQ_EQ_EQ_NOT_OR = prove (`(x ==> (t = t')) = ((~x \/ t) = (~x \/ t'))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `t:bool` THEN BOOL_CASES_TAC `t':bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* IMP_NOT_EQ_EQ_EQ_OR = |- (~x ==> (t = t')) = ((x \/ t) = (x \/ t')) *) (*----------------------------------------------------------------------------*) let IMP_NOT_EQ_EQ_EQ_OR = prove (`(~x ==> (t = t')) = ((x \/ t) = (x \/ t'))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `t:bool` THEN BOOL_CASES_TAC `t':bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* T_OR = |- T \/ t = T *) (* OR_T = |- t \/ T = T *) (* F_OR = |- F \/ t = t *) (* OR_F = |- t \/ F = t *) (*----------------------------------------------------------------------------*) let [T_OR;OR_T;F_OR;OR_F;_] = CONJUNCTS (SPEC_ALL OR_CLAUSES);; (*----------------------------------------------------------------------------*) (* UNDER_DISJ_DISCH : term -> thm -> thm *) (* *) (* A, ~x |- y \/ t = y' \/ t A, x |- y \/ t = y' \/ t *) (* ------------------------------- --------------------------------- *) (* A |- y \/ x \/ t = y' \/ x \/ t A |- y \/ ~x \/ t = y' \/ ~x \/ t *) (* *) (* A, ~x |- y = y' A, x |- y = y' *) (* --------------------- ----------------------- *) (* A |- y \/ x = y' \/ x A |- y \/ ~x = y' \/ ~x *) (* *) (* The function assumes that y is a literal, so it is valid to test the LHS *) (* of the theorem to see if it is a disjunction in order to determine which *) (* rule to use. *) (*----------------------------------------------------------------------------*) let UNDER_DISJ_DISCH tm th = try (let rewrite = if (is_disj (lhs (concl th))) then if (is_neg tm) then NOT_IMP_EQ_OR_EQ_EQ_OR_OR else IMP_EQ_OR_EQ_EQ_OR_NOT_OR else if (is_neg tm) then NOT_IMP_EQ_EQ_EQ_OR else IMP_EQ_EQ_EQ_OR_NOT in CONV_RULE (REWR_CONV rewrite) (DISCH tm th) ) with Failure _ -> failwith "UNDER_DISJ_DISCH";; (*----------------------------------------------------------------------------*) (* OVER_DISJ_DISCH : term -> thm -> thm *) (* *) (* A, ~x |- t = t' A, x |- t = t' *) (* --------------------- ----------------------- *) (* A |- x \/ t = x \/ t' A |- ~x \/ t = ~x \/ t' *) (*----------------------------------------------------------------------------*) let OVER_DISJ_DISCH tm th = try (let rewrite = if (is_neg tm) then IMP_NOT_EQ_EQ_EQ_OR else IMP_EQ_EQ_EQ_NOT_OR in CONV_RULE (REWR_CONV rewrite) (DISCH tm th) ) with Failure _ -> failwith "OVER_DISJ_DISCH";; (*----------------------------------------------------------------------------*) (* MULTI_DISJ_DISCH : (term list # term list) -> thm -> thm *) (* *) (* Examples: *) (* *) (* MULTI_DISJ_DISCH (["x1"; "x2"],["~x3"; "x4"]) x1, ~x3, x4, x2 |- y = y' *) (* ---> *) (* |- ~x1 \/ ~x2 \/ y \/ x3 \/ ~x4 = ~x1 \/ ~x2 \/ y' \/ x3 \/ ~x4 *) (* *) (* *) (* MULTI_DISJ_DISCH (["x1"; "x2"],["~x3"; "x4"]) x1, ~x3, x4, x2 |- y = F *) (* ---> *) (* |- ~x1 \/ ~x2 \/ y \/ x3 \/ ~x4 = ~x1 \/ ~x2 \/ x3 \/ ~x4 *) (* *) (* *) (* MULTI_DISJ_DISCH (["x1"; "x2"],["~x3"; "x4"]) x1, ~x3, x4, x2 |- y = T *) (* ---> *) (* |- ~x1 \/ ~x2 \/ y \/ x3 \/ ~x4 = T *) (*----------------------------------------------------------------------------*) let MULTI_DISJ_DISCH (overs,unders) th = try (let th1 = itlist UNDER_DISJ_DISCH unders th in let tm1 = rhs (concl th1) in let th2 = if (try(is_T (fst (dest_disj tm1))) with Failure _ -> false) then (CONV_RULE (RAND_CONV (REWR_CONV T_OR)) th1) else if (try(is_F (fst (dest_disj tm1))) with Failure _ -> false) then (CONV_RULE (RAND_CONV (REWR_CONV F_OR)) th1) else th1 in let tm2 = rhs (concl th2) in let rule = if (is_T tm2) then CONV_RULE (RAND_CONV (REWR_CONV OR_T)) else I in itlist (fun tm th -> rule (OVER_DISJ_DISCH tm th)) overs th2 ) with Failure _ -> failwith "MULTI_DISJ_DISCH";; hol-light/Boyer_Moore/shells.ml000066400000000000000000000407051303454263000170200ustar00rootroot00000000000000(******************************************************************************) (* FILE : shells.ml *) (* DESCRIPTION : Vague approximation in ML to Boyer-Moore "shell" principle *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 8th May 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 12th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) (*----------------------------------------------------------------------------*) (* ML datatype for holding information about a recursive logical type. *) (*----------------------------------------------------------------------------*) type constructor_info = string * (* Constructor name *) hol_type list * (* Argument types *) (string * thm) list;; (* Accessor functions *) type shell_info = {arg_types : hol_type list; (* Argument types for type constructor *) constructors : constructor_info list; (* Constructors for the type *) axiom : thm; (* Type axiom *) induct : thm; (* Induction theorem *) cases : thm; (* Cases theorem *) distinct : thm list; (* Constructors distinct *) one_one : thm list; (* Constructors one-one *) struct_conv : conv -> conv};; type shell = Shell of string * shell_info;; (*----------------------------------------------------------------------------*) (* Reference variable holding the currently defined system shells. *) (*----------------------------------------------------------------------------*) let system_shells = ref ([]:shell list);; (*----------------------------------------------------------------------------*) (* Function to find the details of a named shell from a list of shells. *) (*----------------------------------------------------------------------------*) let rec shell_info (shl:shell list) name = if (shl = []) then failwith "shell_info" else match (hd shl) with Shell (sh_name,info) -> (if (sh_name = name) then info else shell_info (tl shl) name);; (*----------------------------------------------------------------------------*) (* Function to find the details of a named shell from the shells currently *) (* defined in the system. *) (*----------------------------------------------------------------------------*) let sys_shell_info name = shell_info !system_shells name;; (*----------------------------------------------------------------------------*) (* Functions to extract the components of shell information. *) (*----------------------------------------------------------------------------*) let shell_constructors info = info.constructors;; let shell_accessor_thms info = ((map snd) o flat o (map thd3) o shell_constructors) info;; let shell_arg_types info = info.arg_types;; (* let shell_arg_types info = fst info and shell_constructors info = (fst o snd) info and shell_axiom info = (fst o snd o snd) info and shell_induct info = (fst o snd o snd o snd) info and shell_cases info = (fst o snd o snd o snd o snd) info and shell_distinct info = (fst o snd o snd o snd o snd o snd) info and shell_one_one info = (fst o snd o snd o snd o snd o snd o snd) info and shell_struct_conv info = (snd o snd o snd o snd o snd o snd o snd) info;; *) (*----------------------------------------------------------------------------*) (* Function to extract details of a named constructor from shell information. *) (*----------------------------------------------------------------------------*) let shell_constructor name (info:shell_info) = let rec shell_constructor' name triples = if (triples = []) then failwith "shell_constructor" else let (con_name,arg_types,accessors) = (hd triples) in if (con_name = name) then (arg_types,accessors) else shell_constructor' name (tl triples) in shell_constructor' name (info.constructors);; (*----------------------------------------------------------------------------*) (* Functions to extract the argument types and the accessor functions for a *) (* particular constructor. The source is a set of shell information. *) (*----------------------------------------------------------------------------*) let shell_constructor_arg_types name info = fst (shell_constructor name info) and shell_constructor_accessors name info = snd (shell_constructor name info);; (*----------------------------------------------------------------------------*) (* shells : void -> string list *) (* *) (* Function to compute the names of the currently defined system shells. *) (*----------------------------------------------------------------------------*) let shells () = let rec shells' shl = if (shl = []) then [] else match (hd shl) with (Shell (name,_)) -> (name::(shells' (tl shl))) in shells' !system_shells;; (*----------------------------------------------------------------------------*) (* all_constructors : void -> string list *) (* *) (* Returns a list of all the shell constructors (and bottom values) available *) (* in the system. *) (*----------------------------------------------------------------------------*) let all_constructors () = flat (map (map fst3 o shell_constructors o sys_shell_info) (shells ()));; (*----------------------------------------------------------------------------*) (* all_accessors : void -> string list *) (* *) (* Returns a list of all the shell accessors available in the system. *) (*----------------------------------------------------------------------------*) let all_accessors () = flat (map (flat o map (map fst o thd3) o shell_constructors o sys_shell_info) (shells ()));; let all_accessor_thms () = flat (map (shell_accessor_thms o sys_shell_info) (shells ()));; (*----------------------------------------------------------------------------*) (* `Shell' for natural numbers. *) (*----------------------------------------------------------------------------*) let num_shell = let axiom = num_Axiom and induct = num_INDUCTION and cases = num_CASES and distinct = [NOT_SUC] and one_one = [SUC_INJ] (* and pre = PRE *) in Shell ("num", {arg_types = []; constructors = [("0",[],[]);("SUC",[`:num`],[("PRE",CONJUNCT2 PRE)])]; axiom = axiom; induct = induct; cases = cases; distinct = distinct; one_one = one_one; struct_conv = ONE_STEP_RECTY_EQ_CONV (induct,distinct,one_one)});; (*----------------------------------------------------------------------------*) (* `Shell' for lists. *) (*----------------------------------------------------------------------------*) let list_shell = let axiom = new_axiom `!x f. ?!fn1. (fn1 [] = x) /\ (!h t. fn1 (CONS h t) = f (fn1 t) h t)` (* |- !x f. ?!fn1. (fn1 [] = x) /\ (!h t. fn1 (CONS h t) = f (fn1 t) h t) *) and induct = list_INDUCT and cases = list_CASES and distinct = [NOT_CONS_NIL] and one_one = [CONS_11] in Shell ("list", {arg_types = [`:'a`]; constructors = [("NIL",[],[]); ("CONS", [`:'a`;`:('a)list`],[("HD",HD);("TL",TL)])]; axiom = axiom; induct = induct; cases = cases; distinct = distinct; one_one = one_one; struct_conv = ONE_STEP_RECTY_EQ_CONV (induct,distinct,one_one)});; (*----------------------------------------------------------------------------*) (* Set-up the system shell to reflect the basic HOL system. *) (*----------------------------------------------------------------------------*) system_shells := [list_shell;num_shell];; (*----------------------------------------------------------------------------*) (* define_shell : string -> string -> (string # string list) list -> void *) (* *) (* Function for defining a new HOL type together with accessor functions, and *) (* making a new Boyer-Moore shell from these definitions. If the type already *) (* exists the function attempts to load the corresponding theorems from the *) (* current theory hierarchy and use them to make the shell. *) (* *) (* The first two arguments correspond to the arguments taken by `define_type' *) (* and the third argument defines the accessor functions. This is a list of *) (* constructor names each with names of accessors. The function assumes that *) (* there are no accessors for a constructor that doesn't appear in the list, *) (* so it is not necessary to include an entry for a nullary constructor. For *) (* other constructors there must be one accessor name for each argument and *) (* they should be given in the correct order. The function ignores any item *) (* in the list with a constructor name that does not belong to the type. *) (* *) (* The constructor and accessor names must all be distinct and must not be *) (* the names of existing constants. *) (* *) (* Example: *) (* *) (* define_shell `sexp` `sexp = Nil | Atom * | Cons sexp sexp` *) (* [(`Atom`,[`Tok`]);(`Cons`,[`Car`;`Cdr`])];; *) (* *) (* This results in the following theorems being stored in the current theory *) (* (or these are the theorems the function would expect to find in the theory *) (* hierarchy if the type already exists): *) (* *) (* sexp (type axiom) *) (* sexp_Induct (induction theorem) *) (* sexp_one_one (injectivity of constructors) *) (* sexp_distinct (distinctness of constructors) *) (* sexp_cases (cases theorem) *) (* *) (* The following definitions for the accessor functions are also stored: *) (* *) (* Tok |- !x. Tok(Atom x) = x *) (* Car |- !s1 s2. Car(Cons s1 s2) = s1 *) (* Cdr |- !s1 s2. Cdr(Cons s1 s2) = s2 *) (* *) (* In certain cases the distinctness or injectivity theorems may not exist, *) (* when nothing is saved for them. *) (* *) (* Finally, a new Boyer-Moore shell is added based on the definitions and *) (* theorems. *) (*----------------------------------------------------------------------------*) (* let define_shell name syntax accessors = let find_theory s = letrec f s l = if (null l) then failwith `find_theory` else if can (theorem (hd l)) s then hd l else f s (tl l) in f s (ancestry ()) in let mk_def_eq (name,comb,arg) = let ty = mk_type(`fun`,[type_of comb;type_of arg]) in mk_eq(mk_comb(mk_var(name,ty),comb),arg) in let define_accessor axiom (name,tm) = (name,new_recursive_definition false axiom name tm) in let define_accessors axiom (comb,specs) = map (\(name,arg). define_accessor axiom (name,mk_def_eq (name,comb,arg))) specs in if (mem name (shells ())) then failwith `define_shell -- shell already exists` else let defined = is_type name in let theory = if defined then (find_theory name ? failwith (`define_shell -- no axiom found for type ` ^ name)) else current_theory () in let name_Axiom = if defined then theorem theory name else define_type name syntax in let name_Induct = if defined then theorem theory (name ^ `_Induct`) else save_thm((name ^ `_Induct`),prove_induction_thm name_Axiom) and name_one_ones = if defined then (CONJUNCTS (theorem theory (name ^ `_one_one`)) ?\s if (can prove_constructors_one_one name_Axiom) then failwith s else []) else ((CONJUNCTS o save_thm) ((name ^ `_one_one`),prove_constructors_one_one name_Axiom) ? []) and name_distincts = if defined then (CONJUNCTS (theorem theory (name ^ `_distinct`)) ?\s if (can prove_constructors_distinct name_Axiom) then failwith s else []) else ((CONJUNCTS o save_thm) ((name ^ `_distinct`),prove_constructors_distinct name_Axiom) ? []) in let name_cases = if defined then theorem theory (name ^ `_cases`) else save_thm((name ^ `_cases`),prove_cases_thm name_Induct) in let ty = (type_of o fst o dest_forall o concl) name_cases in let ty_args = snd (dest_type ty) in let cases = (disjuncts o snd o dest_forall o concl) name_cases in let combs = map (rhs o snd o strip_exists) cases in let constrs_and_args = map (((fst o dest_const) # I) o strip_comb) combs in let (constrs,arg_types) = split (map (I # (map type_of)) constrs_and_args) in let acc_specs = map (\(c,args). combine((snd (assoc c accessors) ? []),args) ? failwith (`define_shell -- ` ^ `incorrect number of accessors for constructor ` ^ c)) constrs_and_args in let acc_defs = if defined then map (map ((\acc. (acc,definition theory acc)) o fst)) acc_specs else map (define_accessors name_Axiom) (combine (combs,acc_specs)) in let name_shell = Shell (name,ty_args,combine(constrs,combine(arg_types,acc_defs)), name_Axiom,name_Induct,name_cases, name_distincts,name_one_ones, ONE_STEP_RECTY_EQ_CONV (name_Induct,name_distincts,name_one_ones)) in do (system_shells := name_shell.system_shells);; *) hol-light/Boyer_Moore/struct_equal.ml000066400000000000000000000472421303454263000202440ustar00rootroot00000000000000(******************************************************************************) (* FILE : struct_equal.ml *) (* DESCRIPTION : Proof procedure for simplifying an equation between two *) (* data-structures of the same type. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton & T.F.Melham *) (* DATE : 4th June 1992 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 14th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) let subst_occs = let rec subst_occs slist tm = let applic,noway = partition (fun (i,(t,x)) -> aconv tm x) slist in let sposs = map (fun (l,z) -> let l1,l2 = partition ((=) 1) l in (l1,z),(l2,z)) applic in let racts,rrest = unzip sposs in let acts = filter (fun t -> not (fst t = [])) racts in let trest = map (fun (n,t) -> (map (C (-) 1) n,t)) rrest in let urest = filter (fun t -> not (fst t = [])) trest in let tlist = urest @ noway in if acts = [] then if is_comb tm then let l,r = dest_comb tm in let l',s' = subst_occs tlist l in let r',s'' = subst_occs s' r in mk_comb(l',r'),s'' else if is_abs tm then let bv,bod = dest_abs tm in let gv = genvar(type_of bv) in let nbod = vsubst[gv,bv] bod in let tm',s' = subst_occs tlist nbod in alpha bv (mk_abs(gv,tm')),s' else tm,tlist else let tm' = (fun (n,(t,x)) -> subst[t,x] tm) (hd acts) in tm',tlist in fun ilist slist tm -> fst(subst_occs (zip ilist slist) tm);; let GSUBS substfn ths th = let ls = map (lhs o concl) ths in let vars = map (genvar o type_of) ls in let w = substfn (List.combine ls vars) (concl th) in SUBST (List.combine ths vars) w th ;; let SUBS_OCCS nlths th = try (let (nll, ths) = unzip nlths in GSUBS (subst_occs nll) ths th ) with Failure _ -> failwith "SUBS_OCCS";; (*----------------------------------------------------------------------------*) (* VAR_NOT_EQ_STRUCT_OF_VAR_CONV : (thm # thm list # thm list) -> conv *) (* *) (* Proof method developed through discussion between *) (* R. Boulton, T. Melham and A. Pitts. *) (* *) (* This conversion can be used to prove that a variable is not equal to a *) (* structure containing that variable as a proper subterm. The structures are *) (* restricted to applications of constructors from a single recursive type. *) (* The leaf nodes must be either variables or 0-ary constructors of the type. *) (* *) (* The theorems taken as arguments are the induction, distinctness and *) (* injectivity theorems for the recursive type, as proved by the functions: *) (* *) (* prove_induction_thm *) (* prove_constructors_distinct *) (* prove_constructors_one_one *) (* *) (* Since the latter two functions may fail, the distinctness and injectivity *) (* theorems are passed around as lists of conjuncts, so that a failure *) (* results in an empty list. *) (* *) (* Examples of input terms: *) (* *) (* ~(l = CONS h l) *) (* ~(CONS h1 (CONS h2 l) = l) *) (* ~(n = SUC(SUC(SUC n))) *) (* ~(t = TWO (ONE u) (THREE v (ONE t) (TWO u (ONE t)))) *) (* *) (* where the last example is for the type defined by: *) (* *) (* test = ZERO | ONE test | TWO test test | THREE test test test *) (* *) (* The procedure works by first generalising the structure to eliminate any *) (* irrelevant substructures. If the variable occurs more than once in the *) (* structure the more deeply nested occurrences are replaced by new variables *) (* because multiple occurrences of the variable prevent the induction from *) (* working. The generalised term for the last example is: *) (* *) (* TWO a (THREE v (ONE t) b) *) (* *) (* The procedure then forms a conjunction of the inequalities for this term *) (* and all of its `rotations': *) (* *) (* !t. (!a v b. ~(t = TWO a (THREE v (ONE t) b))) /\ *) (* (!a v b. ~(t = THREE v (ONE (TWO a t)) b)) /\ *) (* (!a v b. ~(t = ONE (TWO a (THREE v t b)))) *) (* *) (* This can be proved by a straightforward structural induction. The reason *) (* for including the rotations is that the induction hypothesis required for *) (* the proof of the original generalised term is the rotation of it. *) (* *) (* The procedure could be optimised by detecting duplicated rotations. For *) (* example it is not necessary to prove: *) (* *) (* !n. ~(n = SUC(SUC(SUC n))) /\ *) (* ~(n = SUC(SUC(SUC n))) /\ *) (* ~(n = SUC(SUC(SUC n))) *) (* *) (* in order to prove "~(n = SUC(SUC(SUC n)))" because the structure is its *) (* own rotations. It is sufficient to prove: *) (* *) (* !n. ~(n = SUC(SUC(SUC n))) *) (* *) (* The procedure currently uses backwards proof. It would probably be more *) (* efficient to use forwards proof. *) (*----------------------------------------------------------------------------*) let VAR_NOT_EQ_STRUCT_OF_VAR_CONV = try( let number_list l = let rec number_list' n l = if (l = []) then [] else (hd l,n)::(number_list' (n + 1) (tl l)) in number_list' 1 l in let name = fst o dest_const in let occurrences constrs v st = let rec occurrences' v st path = if (not (type_of st = type_of v)) then [] else if (st = v) then [rev path] else if (is_var st) then [] else let (f,args) = (check ( ((can (C assoc constrs)) o name o fst) )) (strip_comb st) (* Boulton was using hashI here... but I don't know why *) in flat (map (fun (arg,n) -> occurrences' v arg (n::path)) (number_list args)) in occurrences' v st [] in let min_length l = let rec min_length' (x,n) l = if (l = []) then x else if (length (hd l) < n) then min_length' (hd l,length (hd l)) (tl l) else min_length' (x,n) (tl l) in if (l = []) then failwith "min_length" else min_length' (hd l,length (hd l)) (tl l) in let rec generalise (st,occ) = let rec replace_side_structs (n,argn',binding) m args = if (args = []) then ([],[]) else let m' = m + 1 and arg = hd args in let (rest,bind) = replace_side_structs (n,argn',binding) m' (tl args) in if (m' = n) then ((argn'::rest),(binding @ bind)) else if (is_var arg) then ((arg::rest),((arg,arg)::bind)) else let var = genvar (type_of arg) in ((var::rest),((var,arg)::bind)) in if (occ = []) then (st,[]) else let (f,args) = strip_comb st and (n::occ') = occ in let (argn',binding) = generalise (el (n-1) args,occ') in let (args',bind) = replace_side_structs (n,argn',binding) 0 args in (list_mk_comb (f,args'),bind) in let rec constr_apps v (st,occ) = let rec replace_argn (n,argn') m args = if (args = []) then [] else let m' = m + 1 in if (m' = n) then argn'::(tl args) else (hd args)::(replace_argn (n,argn') m' (tl args)) in if (occ = []) then [] else let (f,args) = strip_comb st and (n::occ') = occ in let args' = replace_argn (n,v) 0 args in (list_mk_comb (f,args'))::(constr_apps v (el (n-1) args,occ')) in let rotations l = let rec rotations' l n = if (n < 1) then [] else l::(rotations' ((tl l) @ [hd l]) (n - 1)) in rotations' l (length l) in let two_constrs = (hash (fst o strip_comb) (fst o strip_comb)) o dest_eq o dest_neg o snd o strip_forall o concl in let flip (x,y) = (y,x) in let DEPTH_SYM = GEN_ALL o NOT_EQ_SYM o SPEC_ALL in let rec arg_types ty = try (match (dest_type ty) with | ("fun",[argty;rest]) -> argty::(arg_types rest) | _ -> []) with Failure _ -> [] in let name_and_args = ((hash I) arg_types) o dest_const in fun (induction,distincts,oneOnes) -> let half_distincts = map (fun th -> ((hash name) name) (two_constrs th), th) distincts in let distincts = half_distincts @ (map ((hash flip) DEPTH_SYM) half_distincts) in let ind_goals = (conjuncts o fst o dest_imp o snd o dest_forall o concl) induction in let constrs = map (name_and_args o fst o strip_comb o rand o snd o strip_forall o snd o (splitlist dest_imp) o snd o strip_forall) ind_goals in fun tm -> (let (l,r) = dest_eq (dest_neg tm) in let (flipped,v,st) = if (is_var l) then if (is_var r) then failwith "" else (false,l,r) else if (is_var r) then (true,r,l) else failwith "" in let occ = min_length (occurrences constrs v st) in let (st',bind) = generalise (st,occ) in let (vars,subterms) = List.split bind in let apps = constr_apps v (st',occ) in let rotats = map (end_itlist (fun t1 t2 -> subst [(t2,v)] t1)) (rotations apps) in let uneqs = map (mk_neg o (curry mk_eq v)) rotats in let conj = mk_forall (v,list_mk_conj (map (curry list_mk_forall vars) uneqs)) in let th1 = prove (conj,INDUCT_TAC_ induction THEN ASM_REWRITE_TAC (oneOnes @ (map snd distincts))) in let th2 = (hd o CONJUNCTS o (SPEC v)) th1 in let th3 = SPECL subterms th2 in let th4 = if flipped then (NOT_EQ_SYM th3) else th3 in EQT_INTRO (CONV_RULE (C ALPHA tm) th4) )) with Failure _ -> failwith "VAR_NOT_EQ_STRUCT_OF_VAR_CONV";; (*----------------------------------------------------------------------------*) (* CONJS_CONV : conv -> conv *) (* *) (* Written by T.F.Melham. *) (* Modified by R.J.Boulton. *) (* *) (* Apply a given conversion to a sequence of conjuncts. *) (* *) (* * need to check T case *) (* * need to flatten conjuncts on RHS *) (*----------------------------------------------------------------------------*) let CONJS_CONV = try( let is st th = try(fst(dest_const(rand(concl th))) = st) with Failure _ -> false in let v1 = genvar `:bool` and v2 = genvar `:bool` in let fthm1 = let th1 = ASSUME (mk_eq(v1,`F`)) in let cnj = mk_conj(v1,v2) in let th1 = DISCH cnj (EQ_MP th1 (CONJUNCT1 (ASSUME cnj))) in let th2 = DISCH `F` (CONTR cnj (ASSUME `F`)) in DISCH (mk_eq(v1,`F`)) (IMP_ANTISYM_RULE th1 th2) in let fthm2 = CONV_RULE(ONCE_DEPTH_CONV(REWR_CONV CONJ_SYM)) fthm1 in let fandr th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] fthm1) th in let fandl th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] fthm2) th in let tthm1 = let th1 = ASSUME (mk_eq(v1,`T`)) in let th2 = SUBS_OCCS [[2],th1] (REFL (mk_conj(v1,v2))) in DISCH (mk_eq(v1,`T`)) (ONCE_REWRITE_RULE [] th2) in let tthm2 = CONV_RULE(ONCE_DEPTH_CONV(REWR_CONV CONJ_SYM)) tthm1 in let tandr th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] tthm1) th in let tandl th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] tthm2) th in let rec cconv conv tm = (let (c,cs) = dest_conj tm in let cth = conv c in if (is "F" cth) then fandr cth cs else let csth = cconv conv cs in if (is "F" csth) then fandl csth c else if (is "T" cth) then TRANS (tandr cth cs) csth else if (is "T" csth) then TRANS (tandl csth c) cth else try (MK_COMB((AP_TERM `(/\)` cth),csth)) with Failure _ -> conv tm ) in fun conv tm -> cconv conv tm) with Failure _ -> failwith "CONJS_CONV";; (*----------------------------------------------------------------------------*) (* ONE_STEP_RECTY_EQ_CONV : (thm # thm list # thm list) -> conv -> conv *) (* *) (* Single step conversion for equality between structures of a single *) (* recursive type. *) (* *) (* Based on code written by T.F.Melham. *) (* *) (* The theorems taken as arguments are the induction, distinctness and *) (* injectivity theorems for the recursive type, as proved by the functions: *) (* *) (* prove_induction_thm *) (* prove_constructors_distinct *) (* prove_constructors_one_one *) (* *) (* Since the latter two functions may fail, the distinctness and injectivity *) (* theorems are passed around as lists of conjuncts. *) (* *) (* If one side of the equation is a variable and that variable appears in the *) (* other side (nested in a structure) the equation is proved false. *) (* *) (* If the top-level constructors on the two sides of the equation are *) (* distinct the equation is proved false. *) (* *) (* If the top-level constructors on the two sides of the equation are the *) (* same a conjunction of equations is generated, one equation for each *) (* argument of the constructor. The conversion given as argument is then *) (* applied to each conjunct. If any of the applications of this conversion *) (* fail, so will the entire call. *) (* *) (* In other conditions the function fails. *) (*----------------------------------------------------------------------------*) (* Taken from HOL90 *) let ONE_STEP_RECTY_EQ_CONV (induction,distincts,oneOnes) = let NOT_EQ_CONV = EQF_INTRO o EQT_ELIM o (VAR_NOT_EQ_STRUCT_OF_VAR_CONV (induction,distincts,oneOnes)) o mk_neg in let INJ_REW = GEN_REWRITE_CONV I oneOnes (* Deleted empty_rewrites - GEN_REWRITE_CONV different in hol light - hope it works *) in let ths1 = map SPEC_ALL distincts in let ths2 = map (GEN_ALL o EQF_INTRO o NOT_EQ_SYM) ths1 in let dths = ths2 @ (map (GEN_ALL o EQF_INTRO) ths1) in let DIST_REW = GEN_REWRITE_CONV I dths in fun conv -> NOT_EQ_CONV ORELSEC DIST_REW ORELSEC (INJ_REW THENC (CONJS_CONV conv)) ORELSEC (fun tm -> failwith "ONE_STEP_RECTY_EQ_CONV") (*----------------------------------------------------------------------------*) (* RECTY_EQ_CONV : (thm # thm list # thm list) -> conv *) (* *) (* Function to simplify as far as possible an equation between two structures *) (* of some type, the type being specified by the triple of theorems. The *) (* structures may involve variables. The result may be a conjunction of *) (* equations simpler than the original. *) (*----------------------------------------------------------------------------*) let RECTY_EQ_CONV (induction,distincts,oneOnes) = try ( let one_step_conv = ONE_STEP_RECTY_EQ_CONV (induction,distincts,oneOnes) and REFL_CONV tm = let (l,r) = dest_eq tm in if (l = r) then EQT_INTRO (REFL l) else failwith "REFL_CONV" in let rec conv tm = (one_step_conv conv ORELSEC REFL_CONV ORELSEC ALL_CONV) tm in fun tm -> conv tm ) with Failure _ -> failwith "RECTY_EQ_CONV";; hol-light/Boyer_Moore/support.ml000066400000000000000000000234111303454263000172350ustar00rootroot00000000000000(******************************************************************************) (* FILE : support.ml *) (* DESCRIPTION : Miscellaneous supporting definitions for Boyer-Moore *) (* style prover in HOL. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 6th June 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 21st June 1991 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : 2008 *) (******************************************************************************) let SUBST thl pat th = let eqs,vs = unzip thl in let gvs = map (genvar o type_of) vs in let gpat = subst (zip gvs vs) pat in let ls,rs = unzip (map (dest_eq o concl) eqs) in let ths = map (ASSUME o mk_eq) (zip gvs rs) in let th1 = ASSUME gpat in let th2 = SUBS ths th1 in let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in let th4 = INST (zip ls gvs) th3 in MP (rev_itlist (C MP) eqs th4) th;; let SUBST_CONV thvars template tm = let thms,vars = unzip thvars in let gvs = map (genvar o type_of) vars in let gtemplate = subst (zip gvs vars) template in SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; let CONTRAPOS = let a = `a:bool` and b = `b:bool` in let pth = ITAUT `(a ==> b) ==> (~b ==> ~a)` in fun th -> try let P,Q = dest_imp(concl th) in MP (INST [P,a; Q,b] pth) th with Failure _ -> failwith "CONTRAPOS";; let NOT_EQ_SYM = let pth = GENL [`a:A`; `b:A`] (CONTRAPOS(DISCH_ALL(SYM(ASSUME`a:A = b`)))) and aty = `:A` in fun th -> try let l,r = dest_eq(dest_neg(concl th)) in MP (SPECL [r; l] (INST_TYPE [type_of l,aty] pth)) th with Failure _ -> failwith "NOT_EQ_SYM";; let hash f g (x,y) = (f x,g y);; let hashI f (x,y) = hash f I (x,y);; let fst3 (x,_,_) = x;; let snd3 (_,x,_) = x;; let thd3 (_,_,x) = x;; let lcombinep (x,y) = List.combine x y;; let lcount x l = length ( filter ((=) x) l );; let list_mk_imp (tms,tm) = if (tms = []) then tm else try itlist (fun p q -> mk_imp (p,q)) tms tm with Failure _ -> failwith "list_mk_imp";; let INDUCT_TAC_ thm = MATCH_MP_TAC thm THEN CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN GEN_TAC THEN DISCH_TAC] ;; (*--------------------------------------------------------------------------*) (* distinct : ''a list -> bool *) (* *) (* Checks whether the elements of a list are all distinct. *) (*--------------------------------------------------------------------------*) let rec distinct x = if (x = []) then true else not (mem (hd x) (tl x)) && distinct (tl x);; (*----------------------------------------------------------------------------*) (* Discriminator functions for T (true) and F (false) *) (*----------------------------------------------------------------------------*) let is_T = let T = `T` in fun tm -> tm = T and is_F = let F = `F` in fun tm -> tm = F;; (*--------------------------------------------------------------------------*) (* conj_list : term -> term list *) (* *) (* Splits a conjunction into conjuncts. Only recursively splits the right *) (* conjunct. *) (*--------------------------------------------------------------------------*) let rec conj_list tm = try( let (tm1,tm2) = dest_conj tm in tm1::(conj_list tm2) ) with Failure _ -> [tm];; (*--------------------------------------------------------------------------*) (* disj_list : term -> term list *) (* *) (* Splits a disjunction into disjuncts. Only recursively splits the right *) (* disjunct. *) (*--------------------------------------------------------------------------*) let rec disj_list tm = try( let (tm1,tm2) = dest_disj tm in tm1::(disj_list tm2) ) with Failure _ -> [tm];; (*----------------------------------------------------------------------------*) (* number_list : * list -> ( * # int) list *) (* *) (* Numbers a list of elements, *) (* e.g. [`a`;`b`;`c`] ---> [(`a`,1);(`b`,2);(`c`,3)]. *) (*----------------------------------------------------------------------------*) let number_list l = let rec number_list' n l = if ( l = [] ) then [] else (hd l,n)::(number_list' (n + 1) (tl l)) in number_list' 1 l;; (*----------------------------------------------------------------------------*) (* insert_on_snd : ( * # int) -> ( * # int) list -> ( * # int) list *) (* *) (* Insert a numbered element into an ordered list, *) (* e.g. insert_on_snd (`c`,3) [(`a`,1);(`b`,2);(`d`,4)] ---> *) (* [(`a`,1); (`b`,2); (`c`,3); (`d`,4)] *) (*----------------------------------------------------------------------------*) let rec insert_on_snd (x,n) l = if (l = []) then [(x,n)] else let h = hd l in if (n < snd h) then (x,n)::l else h::(insert_on_snd (x,n) (tl l));; (*----------------------------------------------------------------------------*) (* sort_on_snd : ( * # int) list -> ( * # int) list *) (* *) (* Sort a list of pairs, of which the second component is an integer, *) (* e.g. sort_on_snd [(`c`,3);(`d`,4);(`a`,1);(`b`,2)] ---> *) (* [(`a`,1); (`b`,2); (`c`,3); (`d`,4)] *) (*----------------------------------------------------------------------------*) let rec sort_on_snd l = if (l = []) then [] else (insert_on_snd (hd l) (sort_on_snd (tl l)));; (*----------------------------------------------------------------------------*) (* conj_list : term -> term list *) (* *) (* Splits a conjunction into conjuncts. Only recursively splits the right *) (* conjunct. *) (*----------------------------------------------------------------------------*) let rec conj_list tm = try (let (tm1,tm2) = dest_conj tm in tm1::(conj_list tm2)) with Failure _ -> [tm];; (*----------------------------------------------------------------------------*) (* disj_list : term -> term list *) (* *) (* Splits a disjunction into disjuncts. Only recursively splits the right *) (* disjunct. *) (*----------------------------------------------------------------------------*) let rec disj_list tm = try (let (tm1,tm2) = dest_disj tm in tm1::(disj_list tm2)) with Failure _ -> [tm];; (*----------------------------------------------------------------------------*) (* find_bm_terms : (term -> bool) -> term -> term list *) (* *) (* Function to find all subterms in a term that satisfy a given predicate p, *) (* breaking down terms as if they were Boyer-Moore logic expressions. *) (* In particular, the operator of a function application is only processed if *) (* it is of zero arity, i.e. there are no arguments. *) (*----------------------------------------------------------------------------*) let find_bm_terms p tm = try (let rec accum tml p tm = let tml' = if (p tm) then (tm::tml) else tml in ( let args = snd (strip_comb tm) in ( try ( rev_itlist (fun tm tml -> accum tml p tm) args tml' ) with Failure _ -> tml' ) ) in accum [] p tm ) with Failure _ -> failwith "find_bm_terms";; (*----------------------------------------------------------------------------*) (* remove_el : int -> * list -> ( * # * list) *) (* *) (* Removes a specified (by numerical position) element from a list. *) (*----------------------------------------------------------------------------*) let rec remove_el n l = if ((l = []) || (n < 1)) then failwith "remove_el" else if (n = 1) then (hd l,tl l) else let (x,l') = remove_el (n - 1) (tl l) in (x,(hd l)::l');; hol-light/Boyer_Moore/terms_and_clauses.ml000066400000000000000000001256051303454263000212240ustar00rootroot00000000000000(******************************************************************************) (* FILE : terms_and_clauses.ml *) (* DESCRIPTION : Rewriting terms and simplifying clauses. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 7th June 1991 *) (* *) (* MODIFIED : R.J.Boulton *) (* DATE : 16th October 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) let SUBST_CONV thvars template tm = let thms,vars = unzip thvars in let gvs = map (genvar o type_of) vars in let gtemplate = subst (zip gvs vars) template in SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; let bool_EQ_CONV = let check = let boolty = `:bool` in check (fun tm -> type_of tm = boolty) in let clist = map (GEN `b:bool`) (CONJUNCTS(SPEC `b:bool` EQ_CLAUSES)) in let tb = hd clist and bt = hd(tl clist) in let T = `T` and F = `F` in fun tm -> try let l,r = (I F_F check) (dest_eq tm) in if l = r then EQT_INTRO (REFL l) else if l = T then SPEC r tb else if r = T then SPEC l bt else fail() with Failure _ -> failwith "bool_EQ_CONV";; (*----------------------------------------------------------------------------*) (* rewrite_with_lemmas : (term list -> term list -> conv) -> *) (* term list -> term list -> conv *) (* *) (* Function to rewrite with known lemmas (rewrite rules) in the reverse order *) (* in which they were introduced. Applies the first applicable lemma, or if *) (* none are applicable it leaves the term unchanged. *) (* *) (* A rule is applicable if its LHS matches the term, and it does not violate *) (* the `alphabetical' ordering rule if it is a permutative rule. To be *) (* applicable, the hypotheses of the rules must be satisfied. The function *) (* takes a general rewrite rule, a chain of hypotheses and a list of *) (* assumptions as arguments. It uses these to try to satisfy the hypotheses. *) (* If a hypotheses is in the assumption list, it is assumed. Otherwise a *) (* check is made that the hypothesis is not already a goal of the proof *) (* procedure. This is to prevent looping. If it's not already a goal, the *) (* function attempts to rewrite the hypotheses, with it added to the chain of *) (* hypotheses. *) (* *) (* Before trying to establish the hypotheses of a rewrite rule, it is *) (* necessary to instantiate any free variables in the hypotheses. This is *) (* done by trying to find an instantiation that makes one of the hypotheses *) (* equal to a term in the assumption list. *) (*----------------------------------------------------------------------------*) let rewrite_with_lemmas rewrite hyp_chain assumps tm = let rewrite_hyp h = try (EQT_INTRO (ASSUME (find (fun tm -> tm = h) assumps))) with Failure _ -> (if (mem h hyp_chain) then ALL_CONV h else rewrite (h::hyp_chain) assumps h) in let rec try_rewrites assumps ths = if (ths = []) then failwith "try_rewrites" else (try (let th = inst_frees_in_hyps assumps (hd ths) in let hyp_ths = map (EQT_ELIM o rewrite_hyp) (hyp th) in itlist PROVE_HYP hyp_ths th) with Failure _ -> (try_rewrites assumps (tl ths)) ) in try (try_rewrites assumps (applicable_rewrites tm)) with Failure _ -> ALL_CONV tm;; (*----------------------------------------------------------------------------*) (* rewrite_explicit_value : conv *) (* *) (* Explicit values are normally unchanged by rewriting, but in the case of a *) (* numeric constant, it is expanded out into SUC form. *) (*----------------------------------------------------------------------------*) let rec rewrite_explicit_value tm = let rec conv tm = (num_CONV THENC TRY_CONV (RAND_CONV conv)) tm in ((TRY_CONV conv) THENC (TRY_CONV (ARGS_CONV rewrite_explicit_value))) tm;; (*----------------------------------------------------------------------------*) (* COND_T = |- (T => t1 | t2) = t1 *) (* COND_F = |- (F => t1 | t2) = t2 *) (*----------------------------------------------------------------------------*) let [COND_T;COND_F] = CONJUNCTS (SPEC_ALL COND_CLAUSES);; (*----------------------------------------------------------------------------*) (* COND_LEFT = *) (* |- !b x x' y. (b ==> (x = x')) ==> ((b => x | y) = (b => x' | y)) *) (*----------------------------------------------------------------------------*) let COND_LEFT = prove (`!b x x' (y:'a). (b ==> (x = x')) ==> ((if b then x else y) = (if b then x' else y))`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* COND_RIGHT = *) (* |- !b y y' x. (~b ==> (y = y')) ==> ((b => x | y) = (b => x | y')) *) (*----------------------------------------------------------------------------*) let COND_RIGHT = prove (`!b y y' (x:'a). (~b ==> (y = y')) ==> ((if b then x else y) = (if b then x else y'))`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* COND_ID = |- !b t. (b => t | t) = t *) (*----------------------------------------------------------------------------*) (* Already defined in HOL *) (*----------------------------------------------------------------------------*) (* COND_RIGHT_F = |- (b => b | F) = b *) (*----------------------------------------------------------------------------*) let COND_RIGHT_F = prove (`(if b then b else F) = b`, BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* COND_T_F = |- (b => T | F) = b *) (*----------------------------------------------------------------------------*) let COND_T_F = prove (`(if b then T else F) = b`, BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* rewrite_conditional : (term list -> conv) -> term list -> conv *) (* *) (* Rewriting conditionals. Takes a general rewrite function and a list of *) (* assumptions as arguments. *) (* *) (* The function assumes that the term it is given is of the form "b => x | y" *) (* First it recursively rewrites b to b'. If b' is T or F, the conditional is *) (* reduced to x or y, respectively. The result is then rewritten recursively. *) (* If b' is not T or F, both x and y are rewritten, under suitable additional *) (* assumptions about b'. An attempt is then made to rewrite the new *) (* conditional with one of the following: *) (* *) (* (b => x | x) ---> x *) (* (b => b | F) ---> b *) (* (b => T | F) ---> b *) (* *) (* The three rules are tried in the order shown above. *) (*----------------------------------------------------------------------------*) let rewrite_conditional rewrite assumps tm = try (let th1 = RATOR_CONV (RATOR_CONV (RAND_CONV (rewrite assumps))) tm in let tm1 = rhs (concl th1) in let (b',(x,y)) = dest_cond tm1 in if (is_T b') then TRANS th1 (((REWR_CONV COND_T) THENC (rewrite assumps)) tm1) else if (is_F b') then TRANS th1 (((REWR_CONV COND_F) THENC (rewrite assumps)) tm1) else let th2 = DISCH b' (rewrite (b'::assumps) x) in let x' = rand (rand (concl th2)) in let th3 = MP (ISPECL [b';x;x';y] COND_LEFT) th2 in let tm3 = rhs (concl th3) in let notb' = mk_neg b' in let th4 = DISCH notb' (rewrite (notb'::assumps) y) in let y' = rand (rand (concl th4)) in let th5 = MP (ISPECL [b';y;y';x'] COND_RIGHT) th4 in let th6 = ((REWR_CONV COND_ID) ORELSEC (REWR_CONV COND_RIGHT_F) ORELSEC (TRY_CONV (REWR_CONV COND_T_F))) (rhs (concl th5)) in TRANS (TRANS (TRANS th1 th3) th5) th6 ) with Failure _ -> failwith "rewrite_conditional";; (*----------------------------------------------------------------------------*) (* EQ_T = |- (x = T) = x *) (*----------------------------------------------------------------------------*) let EQ_T = prove (`(x = T) = x`, BOOL_CASES_TAC `x:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* EQ_EQ = |- (x = (y = z)) = ((y = z) => (x = T) | (x = F)) *) (*----------------------------------------------------------------------------*) let EQ_EQ = prove (`(x = ((y:'a) = z)) = (if (y = z) then (x = T) else (x = F))`, BOOL_CASES_TAC `x:bool` THEN BOOL_CASES_TAC `(y:'a) = z` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* EQ_F = |- (x = F) = (x => F | T) *) (*----------------------------------------------------------------------------*) let EQ_F = prove (`(x = F) = (if x then F else T)`, BOOL_CASES_TAC `x:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* prove_terms_not_eq : term -> term -> thm *) (* *) (* Function to prove that the left-hand and right-hand sides of an equation *) (* are not equal. Works with Boolean constants, explicit values, and terms *) (* involving constructors and variables. *) (*----------------------------------------------------------------------------*) let prove_terms_not_eq l r = let rec STRUCT_CONV tm = (bool_EQ_CONV ORELSEC NUM_EQ_CONV ORELSEC (fun tm -> let (l,r) = dest_eq tm in let ty_name = (fst o dest_type) (type_of l) in let (ty_info:shell_info) = sys_shell_info ty_name in let ty_conv = ty_info.struct_conv in ty_conv STRUCT_CONV tm) ORELSEC (* REFL_CONV ORELSEC Omitted because it cannot generate false *) ALL_CONV) tm in try(let th = STRUCT_CONV (mk_eq (l,r)) in if (is_F (rhs (concl th))) then th else failwith "" ) with Failure _ -> failwith "prove_terms_not_eq";; (*----------------------------------------------------------------------------*) (* rewrite_equality : (term list -> term list -> conv) -> *) (* term list -> term list -> conv *) (* *) (* Function for rewriting equalities. Takes a general rewrite function, a *) (* chain of hypotheses and a list of assumptions as arguments. *) (* *) (* The left-hand and right-hand sides of the equality are rewritten *) (* recursively. If the two sides are then identical, the term is rewritten to *) (* T. If it can be shown that the two sides are not equal, the term is *) (* rewritten to F. Otherwise, the function rewrites with the first of the *) (* following rules that is applicable (or it leaves the term unchanged if *) (* none are applicable): *) (* *) (* (x = T) ---> x *) (* (x = (y = z)) ---> ((y = z) => (x = T) | (x = F)) *) (* (x = F) ---> (x => F | T) *) (* *) (* The result is then rewritten using the known lemmas (rewrite rules). *) (*----------------------------------------------------------------------------*) let rewrite_equality rewrite hyp_chain assumps tm = try (let th1 = ((RATOR_CONV (RAND_CONV (rewrite hyp_chain assumps))) THENC (RAND_CONV (rewrite hyp_chain assumps))) tm in let tm1 = rhs (concl th1) in let (l,r) = dest_eq tm1 in if (l = r) then TRANS th1 (EQT_INTRO (ISPEC l EQ_REFL)) else try(TRANS th1 (prove_terms_not_eq l r)) with Failure _ -> (let th2 = ((REWR_CONV EQ_T) ORELSEC (REWR_CONV EQ_EQ) ORELSEC (TRY_CONV (REWR_CONV EQ_F))) tm1 in let th3 = rewrite_with_lemmas rewrite hyp_chain assumps (rhs (concl th2)) in TRANS (TRANS th1 th2) th3) ) with Failure _ -> failwith "rewrite_equality";; (*----------------------------------------------------------------------------*) (* rewrite_application : *) (* (term -> string list -> term list -> term list -> conv) -> *) (* term -> string list -> term list -> term list -> conv *) (* *) (* Function for rewriting applications. It takes a general rewriting function,*) (* a literal (the literal containing the function call), a list of names of *) (* functions that are tentatively being opened up, a chain of hypotheses, and *) (* a list of assumptions as arguments. *) (* *) (* The function begins by rewriting the arguments. It then determines the *) (* name of the function being applied. If this is a constructor, no further *) (* rewriting is done. Otherwise, from the function name, the number of the *) (* argument used for recursion (or zero if the definition is not recursive) *) (* and expansion theorems for each possible constructor are obtained. If the *) (* function is not recursive the call is opened up and the body is rewritten. *) (* If the function has no definition, the application is rewritten using the *) (* known lemmas. *) (* *) (* If the definition is recursive, but this function has already been *) (* tentatively opened up, the version of the application with the arguments *) (* rewritten is returned. *) (* *) (* Otherwise, the application is rewritten with the known lemmas. If any of *) (* the lemmas are applicable the result of the rewrite is returned. Otherwise *) (* the function determines the name of the constructor appearing in the *) (* recursive argument, and looks up its details. If this process fails due to *) (* either the recursive argument not being an application of a constructor, *) (* or because the constructor is not known, the function call cannot be *) (* expanded, so the original call (with arguments rewritten) is returned. *) (* *) (* Provided a valid constructor is present in the recursive argument position *) (* the call is tentatively opened up. The body is rewritten with the name of *) (* the function added to the `tentative openings' list. (Actually, the name *) (* is not added to the list if the recursive argument of the call was an *) (* explicit value). The result is compared with the unopened call to see if *) (* it has good properties. If it does, the simplified body is returned. *) (* Otherwise the unopened call is returned. *) (*----------------------------------------------------------------------------*) let rewrite_application rewrite lit funcs hyp_chain assumps tm = try (let th1 = ARGS_CONV (rewrite lit funcs hyp_chain assumps) tm in let tm1 = rhs (concl th1) in let (f,args) = strip_comb tm1 in let name = fst (dest_const f) in if (mem name (all_constructors ())) then th1 else try (let (i,constructors) = get_def name in if (i = 0) then (let th2 = REWR_CONV (snd (hd constructors)) tm1 in let th3 = rewrite lit funcs hyp_chain assumps (rhs (concl th2)) in TRANS (TRANS th1 th2) th3) else if (mem name funcs) then th1 else let th2 = rewrite_with_lemmas (rewrite lit funcs) hyp_chain assumps tm1 in let tm2 = rhs (concl th2) in if (tm2 = tm1) then try (let argi = el (i-1) args in let constructor = (try (fst (dest_const (fst (strip_comb argi)))) with Failure _ -> "") in (let th = assoc constructor constructors in let th3 = REWR_CONV th tm1 in let tm3 = rhs (concl th3) in let funcs' = if (is_explicit_value argi) then funcs else name::funcs in let th4 = rewrite lit funcs' hyp_chain assumps tm3 in let tm4 = rhs (concl th4) in if (good_properties assumps tm1 tm4 lit) then TRANS (TRANS th1 th3) th4 else th1) ) with Failure _ -> th1 else TRANS th1 th2) with Failure "get_def" -> (TRANS th1 (rewrite_with_lemmas (rewrite lit funcs) hyp_chain assumps tm1)) ) with Failure _ -> failwith "rewrite_application";; (*----------------------------------------------------------------------------*) (* rewrite_term : term -> string list -> term list -> term list -> conv *) (* *) (* Function for rewriting a term. Arguments are as follows: *) (* *) (* lit : the literal containing the term to be rewritten. *) (* funcs : names of functions that have been tentatively opened up. *) (* hyp_chain : hypotheses that we are trying to satisfy by parent calls. *) (* assumps : a list of assumptions. *) (* tm : the term to be rewritten. *) (*----------------------------------------------------------------------------*) let rec rewrite_term lit funcs hyp_chain assumps tm = try (EQT_INTRO (ASSUME (find (fun t -> t = tm) assumps))) with Failure _ -> try (EQF_INTRO (ASSUME (find (fun t -> t = mk_neg tm) assumps))) with Failure _ -> try (let rewrite = rewrite_term lit funcs in if (is_var tm) then ALL_CONV tm else if (is_explicit_value tm) then rewrite_explicit_value tm else if (is_cond tm) then rewrite_conditional (rewrite hyp_chain) assumps tm else if (is_eq tm) then rewrite_equality rewrite hyp_chain assumps tm else rewrite_application rewrite_term lit funcs hyp_chain assumps tm ) with Failure _ -> failwith "rewrite_term";; (*----------------------------------------------------------------------------*) (* COND_RAND = |- !f b x y. f (b => x | y) = (b => f x | f y) *) (*----------------------------------------------------------------------------*) (* Already defined in HOL *) (*----------------------------------------------------------------------------*) (* COND_RATOR = |- !b f g x. (b => f | g) x = (b => f x | g x) *) (*----------------------------------------------------------------------------*) (* Already defined in HOL *) (*----------------------------------------------------------------------------*) (* MOVE_COND_UP_CONV : conv *) (* *) (* Moves all conditionals in a term up to the top-level. Checks to see if the *) (* term contains any conditionals before it starts to do inference. This *) (* improves the performance significantly. Alternatively, failure could be *) (* used to avoid rebuilding unchanged sub-terms. This would be even more *) (* efficient. *) (*----------------------------------------------------------------------------*) let rec MOVE_COND_UP_CONV tm = try(if (not (can (find_term is_cond) tm)) then ALL_CONV tm else if (is_cond tm) then ((RATOR_CONV (RATOR_CONV (RAND_CONV MOVE_COND_UP_CONV))) THENC (RATOR_CONV (RAND_CONV MOVE_COND_UP_CONV)) THENC (RAND_CONV MOVE_COND_UP_CONV)) tm else if (is_comb tm) then (let (op,arg) = dest_comb tm in if (is_cond op) then ((REWR_CONV COND_RATOR) THENC MOVE_COND_UP_CONV) tm else if (is_cond arg) then ((REWR_CONV COND_RAND) THENC MOVE_COND_UP_CONV) tm else (let th = ((RATOR_CONV MOVE_COND_UP_CONV) THENC (RAND_CONV MOVE_COND_UP_CONV)) tm in let tm' = rhs (concl th) in if (tm' = tm) then th else TRANS th (MOVE_COND_UP_CONV tm'))) else ALL_CONV tm ) with Failure _ -> failwith "MOVE_COND_UP_CONV";; (*----------------------------------------------------------------------------*) (* COND_OR = |- (b => x | y) \/ z = (~b \/ x \/ z) /\ (b \/ y \/ z) *) (*----------------------------------------------------------------------------*) let COND_OR = prove (`(if b then x else y) \/ z <=> ((~b \/ x \/ z) /\ (b \/ y \/ z))`, BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC []);; (*----------------------------------------------------------------------------*) (* COND_EXPAND = |- (x => y | z) = ((~x \/ y) /\ (x \/ z)) *) (*----------------------------------------------------------------------------*) (* Already proved *) (*----------------------------------------------------------------------------*) (* NOT_NOT_NORM = |- ~~x = x *) (*----------------------------------------------------------------------------*) (* Already proved *) (*----------------------------------------------------------------------------*) (* LEFT_OR_OVER_AND = |- !t1 t2 t3. t1 \/ t2 /\ t3 = (t1 \/ t2) /\ (t1 \/ t3) *) (*----------------------------------------------------------------------------*) (* Already available in HOL *) (*----------------------------------------------------------------------------*) (* MOVE_NOT_THRU_CONDS_CONV : conv *) (* *) (* Function to push a negation down through (possibly) nested conditionals. *) (* Eliminates any double-negations that may be introduced. *) (*----------------------------------------------------------------------------*) let rec MOVE_NOT_THRU_CONDS_CONV tm = try (if (is_neg tm) then if (is_cond (rand tm)) then ((REWR_CONV COND_RAND) THENC (RATOR_CONV (RAND_CONV MOVE_NOT_THRU_CONDS_CONV)) THENC (RAND_CONV MOVE_NOT_THRU_CONDS_CONV)) tm else TRY_CONV (REWR_CONV NOT_NOT_NORM) tm else ALL_CONV tm ) with Failure _ -> failwith "MOVE_NOT_THRU_CONDS_CONV";; (*----------------------------------------------------------------------------*) (* EXPAND_ONE_COND_CONV : conv *) (* *) (* The function takes a term which it assumes to be either a conditional or *) (* the disjunction of a conditional and some other term, and applies one of *) (* the following rewrites as appropriate: *) (* *) (* |- (b => x | y) = (~b \/ x) /\ (b \/ y) *) (* *) (* |- (b => x | y) \/ z = (~b \/ x \/ z) /\ (b \/ y \/ z) *) (* *) (* If b happens to be a conditional, the negation of ~b is moved down through *) (* the conditional (and any nested conditionals). *) (*----------------------------------------------------------------------------*) let EXPAND_ONE_COND_CONV tm = try (((REWR_CONV COND_OR) ORELSEC (REWR_CONV COND_EXPAND)) THENC (RATOR_CONV (RAND_CONV (RATOR_CONV (RAND_CONV MOVE_NOT_THRU_CONDS_CONV))))) tm with Failure _ -> failwith "EXPAND_ONE_COND_CONV";; (*----------------------------------------------------------------------------*) (* OR_OVER_ANDS_CONV : conv -> conv *) (* *) (* Distributes an OR over an arbitrary tree of conjunctions and applies a *) (* conversion to each of the disjunctions that make up the new conjunction. *) (*----------------------------------------------------------------------------*) let rec OR_OVER_ANDS_CONV conv tm = if (is_disj tm) then if (is_conj (rand tm)) then ((REWR_CONV LEFT_OR_OVER_AND) THENC (RATOR_CONV (RAND_CONV (OR_OVER_ANDS_CONV conv))) THENC (RAND_CONV (OR_OVER_ANDS_CONV conv))) tm else conv tm else ALL_CONV tm;; (*----------------------------------------------------------------------------*) (* EXPAND_COND_CONV : conv *) (* *) (* The function takes a term which it assumes to be either a conditional or *) (* the disjunction of a conditional and some other term, and expands the *) (* conditional into a disjunction using one of: *) (* *) (* |- (b => x | y) = (~b \/ x) /\ (b \/ y) *) (* *) (* |- (b => x | y) \/ z = (~b \/ x \/ z) /\ (b \/ y \/ z) *) (* *) (* The b, x and y may themselves be conditionals. If so, the function expands *) (* these as well, and so on, until there are no more conditionals. At each *) (* stage disjunctions are distributed over conjunctions so that the final *) (* result is a conjunction `tree' where each of the conjuncts is a *) (* disjunction. The depth of a disjunction in the conjunction tree indicates *) (* the number of literals that have been added to the disjunction compared to *) (* the original term. *) (*----------------------------------------------------------------------------*) let rec EXPAND_COND_CONV tm = try (EXPAND_ONE_COND_CONV THENC (RATOR_CONV (RAND_CONV ((RAND_CONV EXPAND_COND_CONV) THENC (OR_OVER_ANDS_CONV EXPAND_COND_CONV)))) THENC (RAND_CONV ((RAND_CONV EXPAND_COND_CONV) THENC (OR_OVER_ANDS_CONV EXPAND_COND_CONV)))) tm with Failure _ -> ALL_CONV tm;; (*----------------------------------------------------------------------------*) (* SPLIT_CLAUSE_ON_COND_CONV : int -> conv *) (* *) (* The function takes a number n and a term which it assumes to be a *) (* disjunction of literals in which the (n-1)th argument has had all *) (* conditionals moved to the top level. *) (* *) (* The function dives down to the (n-1)th literal (disjunct) and expands the *) (* conditionals into disjunctions, resulting in a conjunction `tree' in which *) (* each conjunct is a disjunction. *) (* *) (* As the function `backs out' from the (n-1)th literal it distributes the *) (* ORs over the conjunction tree. *) (*----------------------------------------------------------------------------*) let SPLIT_CLAUSE_ON_COND_CONV n tm = try (funpow n (fun conv -> (RAND_CONV conv) THENC (OR_OVER_ANDS_CONV ALL_CONV)) EXPAND_COND_CONV tm ) with Failure _ -> failwith "SPLIT_CLAUSE_ON_COND_CONV";; (*----------------------------------------------------------------------------*) (* simplify_one_literal : int -> term -> (thm # int) *) (* *) (* Attempts to simplify one literal of a clause assuming the negations of the *) (* other literals. The number n specifies which literal to rewrite. If n = 0, *) (* the first literal is rewritten. The function fails if n is out of range. *) (* *) (* If the literal to be simplified is negative, the function simplifies the *) (* corresponding atom, and negates the result. If this new result is T or F, *) (* the clause is rebuilt by discharging the assumptions. This process may *) (* reduce the number of literals in the clause, so the theorem returned is *) (* paired with -1 (except when processing the last literal of a clause in *) (* which case returning 0 will, like -1, cause a failure when an attempt is *) (* made to simplify the next literal, but is safer because it can't cause *) (* looping if the literal has not been removed. This is the case when the *) (* last literal has been rewritten to F. In this situation, the discharging *) (* function does not eliminate the literal). *) (* *) (* If the simplified literal contains conditionals, these are brought up to *) (* the top-level. The clause is then rebuilt by discharging. If no *) (* conditionals were present the theorem is returned with 0, indicating that *) (* the number of literals has not changed. Otherwise the clause is split into *) (* a conjunction of clauses, so that the conditionals are eliminated, and the *) (* result is returned with the number 1 to indicate that the number of *) (* literals has increased. *) (*----------------------------------------------------------------------------*) let simplify_one_literal n tm = try (let negate tm = if (is_neg tm) then (rand tm) else (mk_neg tm) and NEGATE th = let tm = rhs (concl th) and th' = AP_TERM `(~)` th in if (is_T tm) then TRANS th' (el 1 (CONJUNCTS NOT_CLAUSES)) else if (is_F tm) then TRANS th' (el 2 (CONJUNCTS NOT_CLAUSES)) else th' in let (overs,y,unders) = match (chop_list n (disj_list tm)) with | (overs,y::unders) -> (overs,y,unders) | _ -> failwith "" (* ) with Failure _ -> failwith "" *) in let overs' = map negate overs and unders' = map negate unders in let th1 = if (is_neg y) then NEGATE (rewrite_term y [] [] (overs' @ unders') (rand y)) else rewrite_term y [] [] (overs' @ unders') y in let tm1 = rhs (concl th1) in if ((is_T tm1) || (is_F tm1)) then (MULTI_DISJ_DISCH (overs',unders') th1, if (unders = []) then 0 else (-1)) else let th2 = TRANS th1 (MOVE_COND_UP_CONV tm1) in let tm2 = rhs (concl th2) in let th3 = MULTI_DISJ_DISCH (overs',unders') th2 in if (is_cond tm2) then (CONV_RULE (RAND_CONV (SPLIT_CLAUSE_ON_COND_CONV n)) th3,1) else (th3,0) ) with Failure _ -> failwith "simplify_one_literal";; (*----------------------------------------------------------------------------*) (* simplify_clause : int -> term -> (term list # proof) *) (* simplify_clauses : int -> term -> (term list # proof) *) (* *) (* Functions for simplifying a clause by rewriting each literal in turn *) (* assuming the negations of the others. *) (* *) (* The integer argument to simplify_clause should be zero initially. It will *) (* then attempt to simplify the first literal. If the result is true, no new *) (* clauses are produced. Otherwise, the function proceeds to simplify the *) (* next literal. This has to be done differently according to the changes *) (* that took place when simplifying the first literal. *) (* *) (* If there was a reduction in the number of literals, this must have been *) (* due to the literal being shown to be false, because the true case has *) (* already been eliminated. So, there must be one less literal, and so n is *) (* unchanged on the recursive call. If there was no change in the number of *) (* literals, n is incremented by 1. Otherwise, not only have new literals *) (* been introduced, but also the clause has been split into a conjunction of *) (* clauses. simplify_clauses is called to handle this case. *) (* *) (* When all the literals have been processed, n will become out of range and *) (* cause a failure. This is trapped, and the simplified clause is returned. *) (* *) (* When the clause has been split into a conjunction of clauses, the depth of *) (* a clause in the tree of conjunctions indicates how many literals have been *) (* added to that clause. simplify_clauses recursively splits conjunctions, *) (* incrementing n as it proceeds, until it reaches a clause. It then calls *) (* simplify_clause to deal with the clause. *) (*----------------------------------------------------------------------------*) let rec simplify_clause n tm = try (let (th,change_flag) = simplify_one_literal n tm in let tm' = rhs (concl th) in if (is_T tm') then ([],apply_proof ( fun ths -> EQT_ELIM th) []) else let (tms,proof) = if (change_flag < 0) then simplify_clause n tm' else if (change_flag = 0) then simplify_clause (n + 1) tm' else simplify_clauses (n + 1) tm' in (tms,(fun ths -> EQ_MP (SYM th) (proof ths)))) with Failure _ -> ([tm],apply_proof hd [tm]) and simplify_clauses n tm = try (let (tm1,tm2) = dest_conj tm in let (tms1,proof1) = simplify_clauses (n + 1) tm1 and (tms2,proof2) = simplify_clauses (n + 1) tm2 in (tms1 @ tms2, fun ths -> let (ths1,ths2) = chop_list (length tms1) ths in CONJ (proof1 ths1) (proof2 ths2))) with Failure _ -> (simplify_clause n tm);; let HL_simplify_clause tm = try ( let rules = itlist union [rewrite_rules();flat (defs());all_accessor_thms()] [] in let th = SIMP_CONV rules tm in let tm' = rhs (concl th) in let tmc = try (rand o concl o COND_ELIM_CONV) tm' with Failure _ -> tm' in if (is_T tm') then ([],apply_proof ( fun ths -> EQT_ELIM th ) []) else ([tm'],apply_proof ((EQ_MP (SYM th)) o hd) [tm']) ) with Failure _ -> ([tm],apply_proof hd [tm]) (*----------------------------------------------------------------------------*) (* simplify_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* Wrapper for simplify_clause. This function has the correct type and *) (* properties to be used as a `heuristic'. In particular, if the result of *) (* simplify_clause is a single clause identical to the input clause, *) (* a failure is generated. *) (*----------------------------------------------------------------------------*) let simplify_heuristic (tm,(ind:bool)) = try (let (tms,proof) = simplify_clause 0 tm in if (tms = [tm]) then failwith "" else (proof_print_string_l "-> Simplify Heuristic" () ; (map (fun tm -> (tm,ind)) tms,proof)) ) with Failure _ -> failwith "simplify_heuristic";; let HL_simplify_heuristic (tm,(ind:bool)) = try (let (tms,proof) = HL_simplify_clause tm in if (tms = [tm]) then failwith "" else (proof_print_string_l "-> HL Simplify Heuristic" () ; (map (fun tm -> (tm,ind)) tms,proof)) ) with Failure _ -> failwith "HL_simplify_heuristic";; (*----------------------------------------------------------------------------*) (* NOT_EQ_F = |- !x. ~(x = x) = F *) (*----------------------------------------------------------------------------*) let NOT_EQ_F = GEN_ALL (TRANS (AP_TERM `(~)` (SPEC_ALL REFL_CLAUSE)) (el 1 (CONJUNCTS NOT_CLAUSES)));; (*----------------------------------------------------------------------------*) (* subst_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* `Heuristic' for eliminating from a clause, a negated equality between a *) (* variable and another term not containing the variable. For example, given *) (* the clause: *) (* *) (* x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 *) (* *) (* the function returns the clause: *) (* *) (* x1 \/ F \/ x3 \/ f t \/ x5 *) (* *) (* So, all occurrences of x are replaced by t, and the equality x = t is *) (* `thrown away'. The F could be eliminated, but the simplification heuristic *) (* will deal with it, so there is no point in duplicating the code. *) (* *) (* The function fails if there are no equalities that can be eliminated. *) (* *) (* The function proves the following three theorems: *) (* *) (* ~(x = t) |- x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 *) (* *) (* x = t |- x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 = *) (* x1 \/ F \/ x3 \/ f t \/ x5 *) (* *) (* |- (x = t) \/ ~(x = t) *) (* *) (* and returns the term "x1 \/ F \/ x3 \/ f t \/ x5" to be proved. When given *) (* this term as a theorem, it is possible to prove from the second theorem: *) (* *) (* x = t |- x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 *) (* *) (* which together with the first and third theorems yields a theorem for the *) (* original clause. *) (*----------------------------------------------------------------------------*) let subst_heuristic (tm,(ind:bool)) = try (let checkx (v,t) = (is_var v) && (not (mem v (frees t))) in let rec split_disjuncts tml = if (can (check (checkx o dest_eq o dest_neg)) (hd tml)) then ([],tml) else (fun (l1,l2) -> ((hd tml)::l1,l2)) (split_disjuncts (tl tml)) in let (overs,neq::unders) = split_disjuncts (disj_list tm) in let eq = dest_neg neq in let (v,t) = dest_eq eq in let ass = ASSUME neq in let th1 = itlist DISJ2 overs (try DISJ1 ass (list_mk_disj unders) with Failure _ -> ass) and th2 = SUBS [ISPEC t NOT_EQ_F] (SUBST_CONV [(ASSUME eq,v)] tm tm) and th3 = SPEC eq EXCLUDED_MIDDLE in let tm' = rhs (concl th2) in let proof th = DISJ_CASES th3 (EQ_MP (SYM th2) th) th1 in (proof_print_string_l "-> Subst Heuristic" () ; ([(tm',ind)],apply_proof (proof o hd) [tm'])) ) with Failure _ -> failwith "subst_heuristic";; hol-light/Boyer_Moore/testset/000077500000000000000000000000001303454263000166615ustar00rootroot00000000000000hol-light/Boyer_Moore/testset/arith.ml000066400000000000000000000072771303454263000203370ustar00rootroot00000000000000let mytheory = ref [ `m + 0 = m`; `m + (SUC n) = SUC(m + n)`; `m + n = n + m`; `m + (n + p) = (m + n) + p`; `(m + n) + p = m + (n + p)`; `(m + n = 0) <=> (m = 0) /\ (n = 0)`; `(m + n = m + p) <=> (n = p)`; `(m + p = n + p) <=> (m = n)`; `(m + n = m) <=> (n = 0)`; `(m + n = n) <=> (m = 0)`; `SUC m = m + SUC(0)`; `m * 0 = 0`; `m * (SUC n) = m + (m * n)`; `(0 * n = 0) /\ (m * 0 = 0) /\ (1 * n = n) /\ (m * 1 = m) /\ ((SUC m) * n = (m * n) + n) /\ (m * (SUC n) = m + (m * n))`; `m * n = n * m`; `m * (n + p) = (m * n) + (m * p)`; `(m + n) * p = (m * p) + (n * p)`; `m * (n * p) = (m * n) * p`; `(m * n = 0) <=> (m = 0) \/ (n = 0)`; `(m * n = m * p) <=> (m = 0) \/ (n = p)`; `(m * p = n * p) <=> (m = n) \/ (p = 0)`; `SUC(SUC(0)) * n = n + n`; `(m * n = SUC(0)) <=> (m = SUC(0)) /\ (n = SUC(0))`; `(m EXP n = 0) <=> (m = 0) /\ ~(n = 0)`; `m EXP (n + p) = (m EXP n) * (m EXP p)`; `SUC(0) EXP n = SUC(0)`; `n EXP SUC(0) = n`; `n EXP SUC(SUC(0)) = n * n`; `(m * n) EXP p = m EXP p * n EXP p`; `m EXP (n * p) = (m EXP n) EXP p`; `(SUC m <= n) <=> (m < n)`; `(m < SUC n) <=> (m <= n)`; `(SUC m <= SUC n) <=> (m <= n)`; `(SUC m < SUC n) <=> (m < n)`; `0 <= n`; `0 < SUC n`; `n <= n`; `~(n < n)`; `(m <= n /\ n <= m) <=> (m = n)`; `~(m < n /\ n < m)`; `~(m <= n /\ n < m)`; `~(m < n /\ n <= m)`; `m <= n /\ n <= p ==> m <= p`; `m < n /\ n < p ==> m < p`; `m <= n /\ n < p ==> m < p`; `m < n /\ n <= p ==> m < p`; `m <= n \/ n <= m`; `(m < n) \/ (n < m) \/ (m = n)`; `m <= n \/ n < m`; `m < n \/ n <= m`; `0 < n <=> ~(n = 0)`; `(m <= n) <=> (m < n) \/ (m = n)`; `(m < n) <=> (m <= n) /\ ~(m = n)`; `~(m <= n) <=> (n < m)`; `~(m < n) <=> n <= m`; `m < n ==> m <= n`; `(m = n) ==> m <= n`; `m <= m + n`; `n <= m + n`; `(m < m + n) <=> (0 < n)`; `(n < m + n) <=> (0 < m)`; `(m + n) <= (m + p) <=> n <= p`; `(m + p) <= (n + p) <=> (m <= n)`; `(m + n) < (m + p) <=> n < p`; `(m + p) < (n + p) <=> (m < n)`; `m <= p /\ n <= q ==> m + n <= p + q`; `m <= p /\ n < q ==> m + n < p + q`; `m < p /\ n <= q ==> m + n < p + q`; `m < p /\ n < q ==> m + n < p + q`; `(0 < m * n) <=> (0 < m) /\ (0 < n)`; `m <= n /\ p <= q ==> m * p <= n * q`; `~(m = 0) /\ n < p ==> m * n < m * p`; `(m * n) <= (m * p) <=> (m = 0) \/ n <= p`; `(m * p) <= (n * p) <=> (m <= n) \/ (p = 0)`; `(m * n) < (m * p) <=> ~(m = 0) /\ n < p`; `(m * p) < (n * p) <=> (m < n) /\ ~(p = 0)`; `(SUC m = SUC n) <=> (m = n)`; `m < n /\ p < q ==> m * p < n * q`; `n <= n * n`; `(P m n <=> P n m) /\ (m <= n ==> P m n) ==> P m n`; `(P m m) /\ (P m n <=> P n m) /\ (m < n ==> P m n) ==> P m y`; `((m < n ==> P m) ==> P n) ==> P n`; `~(EVEN n) <=> ODD n`; `~(ODD n) <=> EVEN n`; `EVEN n \/ ODD n`; `~(EVEN n /\ ODD n)`; `EVEN(m + n) <=> (EVEN m <=> EVEN n)`; `EVEN(m * n) <=> EVEN(m) \/ EVEN(n)`; `EVEN(m EXP n) <=> EVEN(m) /\ ~(n = 0)`; `ODD(m + n) <=> ~(ODD m <=> ODD n)`; `ODD(m * n) <=> ODD(m) /\ ODD(n)`; `ODD(m EXP n) <=> ODD(m) \/ (n = 0)`; `EVEN(SUC(SUC(0)) * n)`; `ODD(SUC(SUC(SUC(0)) * n))`; `(0 - m = 0) /\ (m - 0 = m)`; `PRE(SUC m - n) = m - n`; `SUC m - SUC n = m - n`; `n - n = 0`; `(m + n) - n = m`; `(m + n) - m = n`; `(m - n = 0) <=> m <= n`; `m - (m + n) = 0`; `n - (m + n) = 0`; `n <= m ==> ((m - n) + n = m)`; `(m + n) - (m + p) = n - p`; `(m + p) - (n + p) = m - n`; `m * (n - p) = m * n - m * p`; `(m - n) * p = m * p - n * p`; `!n. SUC n - SUC(0) = n`; `EVEN(m - n) <=> m <= n \/ (EVEN(m) <=> EVEN(n))`; `ODD(m - n) <=> n < m /\ ~(ODD m <=> ODD n)`; `0 < FACT n`; `1 <= FACT n`; `m <= n ==> FACT m <= FACT n`; `0 < x EXP n <=> ~(x = 0) \/ (n = 0)`; `x EXP m < x EXP n <=> SUC(SUC(0)) <= x /\ m < n \/ (x = 0) /\ ~(m = 0) /\ (n = 0)`; `x EXP m <= x EXP n <=> if x = 0 then (m = 0) ==> (n = 0) else (x = 1) \/ m <= n`; `~(p = 0) /\ m <= n ==> m DIV p <= n DIV p`; `P(PRE n) <=> n = SUC m \/ m = 0 /\ n = 0 ==> P m` ] hol-light/Boyer_Moore/testset/list.ml000066400000000000000000000044501303454263000201710ustar00rootroot00000000000000let mytheory2 = ref [ `(ZIP [] [] = []) /\ (ZIP (CONS h1 t1) (CONS h2 t2) = CONS (h1,h2) (ZIP t1 t2))`; `~(CONS h t = [])`; `(LAST [h:A] = h) /\ (LAST (CONS h (CONS k t)) = LAST (CONS k t))`; `APPEND (l:A list) [] = l`; `APPEND (l:A list) (APPEND m n) = APPEND (APPEND l m) n`; `REVERSE (APPEND (l:A list) m) = APPEND (REVERSE m) (REVERSE l)`; `REVERSE(REVERSE (l:A list)) = l`; `(CONS h1 t1 = CONS h2 t2) <=> (h1 = h2) /\ (t1 = t2)`; `LENGTH(APPEND (l:A list) (m:A list)) = LENGTH l + LENGTH m`; `MAP (f:A->B) (APPEND l1 l2) = APPEND (MAP f l1) (MAP f l2)`; `LENGTH (MAP (f:A->B) l) = LENGTH l`; `(LENGTH (l:A list) = 0) <=> (l = [])`; `(LENGTH l = SUC n) /\ (l = CONS h t) ==> (LENGTH t = n)`; `ALL (\x. f x = g x) l ==> (MAP f l = MAP g l)`; `(MEM x l /\ P x ==> Q x) /\ ALL P l ==> ALL Q l`; `~(EX P l) <=> ALL (\x. ~(P x)) l`; `~(ALL P l) <=> EX (\x. ~(P x)) l`; `ALL P (MAP f l) <=> ALL (P o f) l`; `ALL (\x. T) l`; `ALL2 (\x y. f x = f y) l m ==> (MAP f l = MAP f m)`; `ALL2 P (MAP f l) l <=> ALL (\a. P (f a) a) l`; `ALL (\x. f(x) = x) l ==> (MAP f l = l)`; `ALL2 (\x y. P x /\ Q x y) l m <=> ALL P l /\ ALL2 Q l m`; `ITLIST f (APPEND l1 l2) a = ITLIST f l1 (ITLIST f l2 a)`; `ITLIST f (APPEND l [a]) b = ITLIST f l (f a b)`; `ALL (\x. P x ==> Q x) l /\ ALL P l ==> ALL Q l`; `ALL P l /\ ALL Q l <=> ALL (\x. P x /\ Q x) l`; `(MEM x l /\ P x ==> Q x) /\ EX P l ==> EX Q l`; `(MEM x l ==> P x) <=> ALL P l`; `LENGTH(REPLICATE n x) = n`; `EX P (MAP f l) <=> EX (P o f) l`; `(ALL (P x) l) <=> ALL (\s. P x s) l`; `MEM x (APPEND l1 l2) <=> MEM x l1 \/ MEM x l2`; `FILTER P (APPEND l1 l2) = APPEND (FILTER P l1) (FILTER P l2)`; `FILTER P (MAP f l) = MAP f (FILTER (P o f) l)`; `MEM x (FILTER P l) <=> P x /\ MEM x l`; `(LENGTH l1 = LENGTH l2) ==> (MAP FST (ZIP l1 l2) = l1)`; `(LENGTH l1 = LENGTH l2) ==> (MAP SND (ZIP l1 l2) = l2)`; `MEM (x,ASSOC x l) l <=> MEM x (MAP FST l)`; `ALL P (APPEND l1 l2) <=> ALL P l1 /\ ALL P l2`; `n < LENGTH l ==> MEM (EL n l) l`; `ALL2 P (MAP f l) (MAP g m) = ALL2 (\x y. P (f x) (g y)) l m`; `ALL2 P l m /\ ALL2 Q l m <=> ALL2 (\x y. P x y /\ Q x y) l m`; `ALL2 P l l <=> ALL (\x. P x x) l`; `(APPEND l m = []) <=> (l = []) /\ (m = [])`; `(LENGTH l = LENGTH m) ==> (LENGTH(MAP2 f l m) = LENGTH m)`; `(P x ==> Q x) ==> ALL P l ==> ALL Q l`; `((P:A->B->bool) x y ==> Q x y) ==> ALL2 P l l' ==> ALL2 Q l l'` ] hol-light/Boyer_Moore/testset/res1.pdf000066400000000000000000007127651303454263000202500ustar00rootroot00000000000000%PDF-1.4 %âãÏÓ 5949 0 obj <> endobj xref 5949 16 0000000016 00000 n 0000001130 00000 n 0000001374 00000 n 0000001653 00000 n 0000002136 00000 n 0000002359 00000 n 0000002437 00000 n 0000003692 00000 n 0000004672 00000 n 0000005700 00000 n 0000006773 00000 n 0000007910 00000 n 0000009027 00000 n 0000010144 00000 n 0000000861 00000 n 0000000630 00000 n trailer <<6BB558C31BD2064797BAA6A3BE943081>]>> startxref 0 %%EOF 5964 0 obj<>stream xÚb```b``)g`a`YÅÀË€¼@& 8džžÎ¯“¾``ø€©òù˜¸0àb?nIµN£‡s7?n)°cßµ,ÁÉÀ0ÛH3ñ6 vg`ÜÜÄv ƒ5DûìO`6£ø¸ÁÞ Œ‡%4#0;àF endstream endobj 5963 0 obj<>/Size 5949/Type/XRef>>stream xÚìÑ¡0 ð4xÿ³ýº3V à¬ö¤ÉhKs=à!<ă‡xðâ!<ă‡xðâ!<ă‡xðâÁC<ă‡xðâÁC<ă‡xðâÁC>/Outlines 9 0 R/Metadata 74 0 R/PieceInfo<>>>/Pages 73 0 R/PageLayout/SinglePage/StructTreeRoot 76 0 R/Type/Catalog/PageLabels 71 0 R>> endobj 5951 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 5952 0 obj<> endobj 5953 0 obj<> endobj 5954 0 obj<> endobj 5955 0 obj<>stream H‰”—Mo7 †ïû+tkŒ¶²(‘”¤)à=àéÍ— ÙºNa-š__ŽfvÖ¨—;Ôe?†˜G"Å÷•Üç ¸·9¿¹ îóó&GG裗_ÁWvOÛÍ'y<þL!ø\$ >ó«(ôµ( ²ªï2VŸÕws"__ yD—"û !–×QŠ¾°Íe"¢WßÄ‚>ªQŠÉWuNT‚Oj”CôŒj4’'u\föXÔh)^ f€qÉ_E[CŒÿÚ#. ›^Ãq¨ã±ÊmÉÆ ÔV„ãÁcá”`’!µJhÓª>©óÉà‹Š•,“:IS2†VG%['+AÉ2jó‰’¦º"QÒTc’%«ó‘,AdÉÚ|’¤ Ú˜IÒÔ¨I² Ú|’dIê›’ePç#i’:u™Se½™1½›QrT»SÒ»%IõE*z7£ä¨v3–¤w3Jšj7S(j7“d©v3I–j7ŸWîíÛóÛËß®\pïÞ]\]ºÍŠχàÀ Ÿ6Á HhøG>Üðì ŒßßÇGOò‘Ç]ãçöÜÈ%®.%Y’T³v›7þ½ýøëÙðes=l®oe€—£‚2êQ0æàcFnàáa·u÷ožïÏ4vìaSÍ>4ËȾû¶ýëYæ¬x~#Þl·Oþ|øþáÛÃ×G•vű©Eiq*Åöi§ÉNLÒc™gæÅ­FäbŠ^:fⵆÌHÊ>C­3òFC–¤¨2 ìó¾ùAcV;AŽL!Ö•Z‚¦ºcHw—©Lšš™UÎnœÖŠ &)MH’½Ct”W« &!ÍP9:Q‘-r¥œú!Yõ¼LS¯f‡€8H51¯—³CBE”Xx½œ"b’Ž§°Ú"b±£ «J‡ q÷ÀµrÆeâz9£IEä,=º‘h3Ô:õçÎý(¡_ÜΩp“žx’KG)4õ•ûwû¬ƒMš:€¥¹jd4€MÊ:€Ûy#³lÒ×,k%À&‘-`„àa†Ÿ”Z³J6)í@–K[‰sË k­Qe›$w`¹®å¹3F¶À“Ê6iïÐÒÒsyÉFõPdÒàQö²0±Y…vjp<Â¥:C]½Ô§=–¼R^›iŸîåJ—fÝéÐ>Í1_–^P¡}zcÙ%¡¦¼íÓZ–qm¦}2ËI.uÞÓt¨M_²èi´óÿÛúÝï—îQ¬}ü¾oOïÏT J6Áí›liÝÛЦ¶Ülž nŒ6Å-àfóó±ì4ئºÜl>Wئ¼=¸Ù¼,ö¦eyU¢M€ »= “O=Út¸°›ÑϽ1²ó £G›—&ŸŒ~A—Sh›(tóùÓ6‡’l._hÚ'½ÙåO3©Ou“ÉϪӡ}Š›L~ß*´Om“ÉÇë¤>¥M&k3í“Ølò°µi+”òˆÉÿ(ßúùlÛ0;ÜŒlòZÀÍØ öK6-Üæë³KžÛt¶€G_‡`¸É°Ml{0ʽŽáp€gªUEÛ$· ›­ÓÞÖRÍêé’_*Ïý'Àí’Èl endstream endobj 5956 0 obj<>stream H‰”–=oÛ0@wÿ Ž ÚÒwÇÏâ ù:tÓèµ 8Щÿ¾”d]ë <Ê2ßÓ§ ºéç\ñ\Ý×å»Ð×ÒceKnº>ÁÌÀ%ßM¿/Óáåû“;§gwüþôíÙåàŸÛÕÇ©}0b'ª>4î¡£ ]ÀS ¼°‘»Ôd£2ù ˜*A—šMÔŒÉ'ä0º×b£ö™ ¨ÕFÍÐbZ³.”mÐ<2ñ>´€ Z {DÜiA4´mÅ€(© 1ú¸¸”=p»43/î³{moîäÎëÙùn9ï.¦sn[,ùº}÷çÇï>Xgœ€›Ì`tNÑ·}`w®èCR€uêmàˆà±Äz P`èvd_©l=†Ô¶uÙ:…=·^î:•rÕÉ([|)=ea§=¶ÎIa—è ¥•Ý}ÌÕè$1âjs¯½àó¬³MÀê̳Î8«3Ï:ë¬Î<ëÌÛÀ¦Ì³N@a[2Ï:…}›ù¼GÖÉ([Ü’yÖ9)lUæÙè¤*ó6ùtG°™§ =‚M;]élÎéR`N×z›jºØ#è$Ëì6Ù?õ§öñý页~>:žÏ×kýuòm+®É<î‚N=!/ÍÏ°N?/Í/Š·¢NA!/Ño󙂬Óp#¯Õgi\%®¥×Ù(ðö@¨P¸ÂÛ%Þaëœ6Ï”“°Ë[g¦ìö@í da×=¶ÎOa—Ùϸ>ê¾N‚2ù|­)aŸj“0cò‰¸ ±6s`_ ¤!Öæßÿk2úé#›{sü BQmÞ-ñ'Þ«M¸9þ`ô¢"j-:…;ñ¿,ãýü˜Ïúƒ>’N½m-ý¤¤OÈêQIçžÕ³>’Î?!«‡}$‚ùý´ÛÜúpˆ7îÏ/•Ú…¿™÷÷ßWA'¥lôw¨öà:7>‡¿¦õ·Äþ³F9çðCX·5ö[l®åÇ!ÕæàþÜžékp É£I:Øä[§þ8Ši°‰·Nýax¯6ãÖ©GSÔ©ÆóØÆñCøßZê_%ü—嬿–νm­ÿÃïþ 0ÁæÇ] endstream endobj 5957 0 obj<>stream H‰”—¹r1@óý …œ²ºuuWÙ|ŽX>ªÖDü=iF ’º×zm¿•gôÞ´Þ˜×æíùûéù|z~y4§›ó“¹½½yyüôd  ¹¿x*o?œËOÎ΀9;9“-“ùX¿–÷8XÌŒG²ì]0çËéÍìuà,g—à XpT8 R»Ž˜)áIl ËÍipÈŽsóÎÞ2$>àœx²pR±£Çr¡£ã Í:tv)´-‚ã«Ëh“ö¥Ñ± Â&ˆ6¢kWaŒÕ ˜<ÛTÞZQuö¥ä,åòGvBÕ©—È[`ŸWTwÙ% €Ëµê„˾l.v¼¢ŠLòÄÙ›˜¬ãýn]Ì{ójîÌÅÜÞÝ×WnÜ¢(²®Žwh‰(¶ÈýúúsBIw%oÁGNryw%·â“„,RïJnÉg Yd_'·æû#Ë.óx³$‘„Wxm~¤£¾´“Çp‘‹W8± yß!ŽÄ4Y¹HÉë6/›$ú}ä)[$æ•]«ïw1iŒUšY«¿?½gXˆµú%* ;~ô%…­úWجS°e?ì›bLÕéײ¼¢êÔkÙ‡åZuÎíÙ‡U&°EÏøßì¿Öì_æÙÏ2ïŽÏù;û³Ù6ˤëàZ}"X¦]oÑOŒ°L¼ÞšïXr)dêà–ü#ø˜ÆM&™~]ƒÇ ¢Œ‚œÇn“̯ÁßGºOå‘Æp™Œ}ƒoÁÇLB¸ÌɯÅß‚“—”R–âG¦°*>élÅO¸Äê lÅ_/V§_ >¬fgÒ¹WƒO{ï&Tx5øŽVkes5ø”Vs>Ëdó`óö»ÿó—Çšù-üÛëIîYfÝñ)-÷(™kY¦\'×Þ X&]×ÞG”eÞur ~ò²L½ƒ\‹Ÿò‘eWž<Î2Ë ìðÚ|×Oå{öc¸LįÍ?&¯S¸ÌǾÇkócèð<£“iÙá9”{œ‡OtJ-9[çwÙ'T†åÐg9ÆåZu ¦,ø%T§_ëýjG§S¯ øûSdBÕi×zÏ˵ê|k½§Å±L´íñ?½¿˜wåG³±Ì´ƒ.ï<‚L³N–vAfZ‹; ³­“ÅGwÿí¼Gæ8†ËÌëðrA0¹cü.ÿÏ 2ÿ:»f>Ä~(ñ“C ‚LþµÛhßÙ8eËdìì­òm GZ¥Šµñ»àªNÁÖø¼€¢Î¾–ø˜VÔ?Õ3¿C*€ endstream endobj 5958 0 obj<>stream H‰”—=7@ûû,í(æqø1œ|WøÎE WQ:µIød®òïÃ%w©É™æt’€ÇÅŠïqöñ|vÌù¯g²e2ê_g|Œ˜Á :K9&s~{xçÞŸÿ~ø|~øüåÅ<<ž_ÍÇ_^~{5Þ{óüüéµ|üé\¾YR)”<¯¨AEÍ-,¯5ê¨ÁYÏVÔ$¢&´˜Ù”Çå“ùf~1¿ÿñb®æɼ™“ÙÞ_Íx!Ô,œ·D)Ô•Ì?þ˜€³ ìɲÇ(“ œ¢eÌ(³ L`£,§GpÖýêÈ3ј *rdKÛ/ÞØ#ç0fË$<ØÄ6æ}g6Î~Ì–©xlï²9’Ï$dË„<عøH®Ýo?2è„doS\RUö!$›ý’ªR[äõ¥ª´k¡‡¶` U)W;O{çÆШҭfÞÑêJ£Ê´ZyB^AeŠ![HtŸyW³þT¾~¼\jä]}7^K¦Ü±V+=%AÞ¢L¸N®©gI‘£LºNÞZŸIÈ2ñ:y‹=KÈ2ùr«}ð½m™ódÃÈ$ìðüt„3ºÄÇp™Œ^‹¿ïÈ!áI&eßê[òtvæ0>©’ÌÍήÉíÇŒãÃ5)í,ÍGm_Ç<ÆêDlÑßû<Ãê,lÕÏ~‰Õ)x7àÏè¤ÓïnÀŸPuêÝ øªÎ¹»B•ÉVºƒè§ Kÿµ¼¾C„2ãŽZð£$ø(ó­“kð“$ø(S®“ëp’à£ÌºN®Ó}–eâä|ä[ði|”é×á5øp ¾›evx ~ìÁ/‹M¢Œ2ûo3~g‡)[¦dgoÁϼ >*¬Cþþh9Áfˆ-ø).±: [ð÷Ac†Õ)Ø‚ïÒbÒÍ:ýöIÕ™×&ý¼¼Trû¨+ªÌ5ŽåHúŸÞ_Þ]ÍÉ|¿¼/Ýoý?Õ×ïã.e™€ÇŠŠ?ËôëdùÀŸevòÝÀÿõÛ·Éí ™…]Ê"´ÌÄ!–Aá‚籎$Ó±³ëàŽÓ¥ŒoŒãMI2+;œÐ†#Òæ&O›$S³ow_ö;„ !Ëôìä­ýö!orŸ•~nÃ>€_bu¢‹6{Ú7ô‡É]Ð)ˆ>[L×\€µþp1ì²Î½­þüj„fvÈÛµBXÞÖ)—!X‚püfc¬H¶P©ÄeÛü÷¸”3àd®¥þ[ñŸöòŸêÀ¤K,’°¯ØN€œf‘„7r=H2§³Èùž®HÄwËy8”E*vr­?øÔë'õg‘Ž7v­?âQÿ2ó¦<‚÷“•æ_©ìÇ÷ endstream endobj 5959 0 obj<>stream H‰”—»n9Eóù †+¯MñQ¬ )°ä`G;Î&Ý «‘Gþ{³I6Ù"»HÐh0§=<÷Vysþ÷ä Yaó©üv&:´I˜ °X æü|úÃ}DL,rsþïôå|úòõÑœnÏOæîîöëã_OùSÞ<<|~Êÿþ|Îïœñ3x lSô¼Ã Yh kpr60PÇ8ÆÆ5¬‹.@Å KXôɦàêsÆ4Ʀ5l‹Â‡T\£¢³L)¬SiÊÑz‰|Då%*å?¼õ^'_—¬Qc>\’?4§z§¢z±ŽMBë¤}[Ï惹æŸWso.õÕ妼_Mgß~µ,”e†T.g~üó}BÖ©×ÉÙk 5d}œÀ "kÈ:;™½uŽDCÖ9¸“Á;ë±G¨'ǑשØá –CÐü|p ×Ùá%üÛ q 3á:1ûaßÂ?ÐÎŽ=Î~¯Ó³³·ì'izŽ³$,ú™³? Õs aŒ]±d¿OµRpü€Ãš…5ûc8Ä®)XÃßÕC1ykú•ðg9‚®™W²ßQ½Õqû…5åJö3ú#ªÎµèmJœÞÉþûüöÝýƒy.].·íã+êܯXò_bT$^Ðé×É[þG9ê ìä-ÿ)µÎúÿåeR‡QgaGoࣦ£NÄ\ €€{x¡ñÌu:vx)‚½Ð ŒeÔYÙáŒ6¦–£æÁO_Ô©Ùû–þàöj‰Æ¥u†vøÿÒ¾Ê8N¾¸¨è6úçYòhôk¢KÛLóiòˆ×,ÜòŸ¼OG· k –üçÕãj…5û¶üŽŽV X3e»WL‡Ö¤Û* ¯ ‡w«³ ÀºÈðn<—‘ÿ÷˜äèLܯZkšã×— Xga—HAÖyØÁoJ` Ö™ØÁ¥’æQèTÜÁµpi; u¶åàOþxÍA}S×R¯ó=uîW}»ÌRu vp)€ˆ °NÂ.š%uvri¯hÔ™¸ƒk„½ ·ÌÄGÔùØá¥öYšf9Çl•]VJŠuföÓ^âŸ÷øç$¹†pÒ Úáeð>©,Z4´Ä›Õiÿ´¦`]Ú|0›SiÍÀšÿRŸÂdâ 5ÿê ÐnwB]s¯®mP×Ä«+@2¦v͹ºàáÝêlÃœ”ÂñMüýíÑ\Êow¹iëÀÕü™~½šù)ÀÓâ endstream endobj 5960 0 obj<>stream H‰”—;O^G†{~Å–¶c/;;³—‘€Â@‘ÂR$–RÐ&EŒ¥TiòÛ³÷€”=g¦±€ÏzÎr˜ç}gon®¿Üÿü`0±¹»ûüpo®>_®®/gÀ\~¿r&YÎæSû׌Ù2g4è¼ÍÙsy¾zgþþí/óþòÇÕãåêñKA\_ÌÍ$g§#ûò…‡(!ƒŽÈrôYBö:r버Œ*2³ƒod÷Ñ–ïᤃÛ ‰˜y:xfKiLH…ûÓG<”! _ü€tìD6ùÃ=4ë œ¬CêoöT…ØrÀ(ëŒDÒU'_ŒÎæ5{ªN¼˜ÑBæ3¨Î¹ä¢—Nª“-¡³>G8£Ê,+C©¤TˆÖ|ƒ>›滹5_¿Ý—ÿrs{gž×w×OO¯>Û?]¦á|zoîh¾¿€e.p+Ž°ÌîÐGÛüùòòã,Sq[Œ,=:19™ŽÜ ${Ï:Hžíá2+¼6€3ù)2¥=[ææbçh1àXî`?väd‚®¡¯é4KC`Š{¸ÌÓOÕÓÔß ¼i¥¨ìmtÔMõÛ–%§3° mò¾O‡ùtðŠuFd[ÒN«Ó¯µ@ö'5HNç^mïŸPA'^äzV§¯tÎÕ"(ÁyzZ™mŒe(‹ðÛ"xüõ—÷ÿÕ@¯€žÞµ?½?øud2η`ì¾2¹– .2¸•ÀPü¸d>.t­ÞœZfä$·Hqö€'à¸]O d^.xëy àýž-³s±kDô€—ºf¾ö­ú¢P>Ù åeš.xíÉ°ï¯ô´öŒK(œVgaëtç=àu¶(·Óãê l=Àã¸ûIó:ùzŒëÀU'^ï|Þ^ç\ëp§§ÙVöK˜ÿ§jâÿd~”Ä¿5³>Œ¯rE*ÎÇöwÆãØC‘† Ü:`èr‰¸À­HR(Rq[‹È"'¹ßx®½Ç°g‹Œ\ì~È3Jø`÷E‘—‹Ý.„‚@‘škØ}™v˜«Ç1Xäæ¿Éþ}ê¡ÎÍ×ÑÜ–J*õÄÉO*ñ¢O6†±bUÚõà}†÷ë ©”k¹˜Î *ÛZì³ä¨D+ej3„ùçÚSeŠA‰Gxû_¿Ý—Oæ  ·ŒL¸ñ˜óÙA“L¸ ®1ïA²ë“̹ ®1EýdÚMpy‡’kO‰7À=åÃLyWÖmÞÏtÙ7Ù5å!ñb‡C¶LÂÉÎ\î·c6*;²e.Îñ®‹¾Ç…NÌû…)È|œèTâs ï™:9Y‡Ô_EÜCUîEà²7â¦ùW€¡Çµ endstream endobj 5961 0 obj<>stream H‰”—»n]7E{}K9é>gI…%) ð5B­S‘dÀ•ÿ><|ÅHÂÙF8¸)^®½ç<}z0W.æööç‡_Mˆdîï?>–?^Êo.`Ð\þ¸“-“y_‚ H–‘L Á¢Çl./W×éÝåÏ«§ËÕÓ¡¬‚&°”!V(,¡ TPò‰wLÔ03$‹·u*¨ë¨ldõ"¨Gë9³‰É—è«yúý7óùËCùƒ;ójÖkÕœ%rmçæÇ×ï'ä¨#»r6Î; 9éÈ1X.·XBÎ:2¡ˆQB–97ȃMú]¾ä˜×l™z“ØŽ¯n°CnÉÎ2'›Ø†ìÓ€ûãÓ5\¦â¼àåŠD—Ü„Ó)\¦ä„çâdæv,˜×X¥”ìläԬĸÆêàœOà2#'üHÿ4&°›rá9®'F’‰9/{M žOá2?'¼¦ŸܺY)hMÿvûÜzÐc†5ü¡{ïO°: køSN[¬NÁþ7ÑÇ:ýZøû°£êÔkám¯k-Xç\ ÿ›'T™l%ô},Uùsø?_¿A_"ÿ(o%ø_úÓÿíi½®Ìñn+öû¬f™ƒ\K€ÓAfá%Ð Ýüõö¶>Š2'¸v@fZ&ã@·ˆsÖMÌ9¬á2%'¼–@¦÷Xrz™ydfN8ÐïÇ=ÂÉ™Èìœ7Þ•+cJ8'Ë ä#þÛðï—so¥¢%þPê¥ùt&6»Ô_hߟœ‚NÀä²A}†E~µ¸Ï`ëk†:÷Ž(cÞQuÚ%.{%œÎ¸Œ¥ ÇW¶ÆÊ\KdÉÿ«Zâ?_#ÿ·:ü·OvùQfáX³å?í_"Ê$œàšÿÝ–s°Là ®/} ÛÄ4ÊTœèÖ(BËlèÖaÌ»JçÒîdNNx9û¾á&#¯Ù23'»@Óó˜v2;çu¯€YB–ù9É­š÷y9OF§ô³@iÒr¤ŽN§`+€ì¶)åtöÈ{®NÀÖm»ëru:õj`Ÿª—/‚Ñé¬k 8¯®€s»ð2×Jìx,¯j?Àç/%òoïJâßÞÝåi½L½±PKýÔ¥þñõû Y¦Þ$×Ø—ùœ,³o’kîSeNr}Ž²LÁA®©ŸaŒæ@™)pó·›æË¿ endstream endobj 5962 0 obj<>stream H‰”—»n1@ûý — ÇÏû–$)(R±|H@AÅßãØïŠÇ÷yKÇÖŒÏñÍóåôüòhN÷—'s>ß¿<~~29¢yxøôT~ýéRþrqÆ›Ë÷“3h™Ì‡úÙ™DÞF`RbK!&sùyzçÎÁ–þ–X€5ýÀ«quöõô‡•têµôCÛëü}‘ι–þžÍªÌ6OóÛéß—ÿ(ü$“o[«…¿ÏtÇy&™yƒ\ßAB–É7È5ü]¾Yæß ïÊL–)¸‘ÿ›ú=–Áq>+LÄßOý˜Ó¼ý$óqÀ÷SDÇi¾s–i9Žúnê_lœeröíÔP=VÚy;õüÂ:wS 9Vgánê?ÂêNý¬Ó¯¥5ô³Î¼ÝÐ@Õ)·ú¨2×¢·!–±é¶üîxÂ'3mC·Ð{Á„NæÙ ×ÐÁ„N¦Ú ×ÐGÁNfÛ ×Ð'”eÂmäzèEs¾©uàdÖ ökç= x*‡ešKp2ù¼v¾5\&á8صó‘náÓKœÌÅÇdÑ÷y`:âƒSºÈh]ì³Ýœêu‚gË9®öêu BJÖÇ®àU§_‹üv"æTz=ò´¢ê´k•§å^uÂõÊ¿q#™ $ß¿³ endstream endobj 1 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 2 0 obj<>stream H‰”—?·†ûû[Æ€Lq†ät*üA W¾têÛH“ «œ"Ÿ=Crɽ³5Ë™æô»[ýž%wù¼|é_àøçñðö¯?úã—ÏHèø“w•Žß~zø™ÿÜ>ï].|\¦?_ErÅ« ]!ñj.®J£®FñjŒNäÆŠWWÅ'~Uœm*Þñ»äÑ‘8dÂä’8*ŠÕeù»D.Š£¢Rœx1´·*] é˯€DûÍ>ðêøÉò8¾|­RD_¼¾º¥‹íßRºyñIÃT]Ç“Á˳ âxxšÒ-‘g‰âEìY¸È³Di<ÈÓßò4ÅkÀ·ÿÛþôÿÈ-ƒ¿î?ýѸ-˜óùá/þxwüø÷oÇWOÿzøþéáû˜þò– Üò ÔÀ‘]ŠÏ|üþÓgŠ(òÚA({h0@û£{f40ùï#ì¡Ià9W¸Oô—õƨ5I\2py‡,çCel‰µd › ØÂ;S>W@ãúnÑs/®ø’[$n5psthpE HÚ}‰XÑ¥z¾0ð"Ò Au5“¯"Ñàqáƒp¾~™hŠÈ»²^¼H4èDÃP*lˆ—²çÔóy7FƒE9xõ3Gd¢J ÊÍ,ÔzEóÇãÝã].«ô™ÔÍü´¶á*}·§3Ÿö‘¯’hqG@Ÿ©ÿñ“ŒU‰´°¯2ú«²ibGJGšñÄ붊i‚*­ºu^ÉE´Ê¯…naMüáDó­jÑ*ÑÖ"îyñ%ZµÊ¸…î‘}¬¸· Í¹ša< q{E“q#µÏG@"ÓdÛ™Û÷È`­÷Z"ÓdÙˆî7L“b#¼iŒD¦É­ß)m˜*©xl®\ùý¿-¾’«Jª…~âÿþôéW™¬rê"·‡5d•Y¹9;»MÜ ²ëâ>'Õs3¿åª [Üè[”s‡xÏÕO<¨<»À|X%nà °J¶ Ü;w™›x¬EÌÚ¨’îZÌ-Ç Ž­’ï…(ÉyN´ñ@¾–‡Ñ¿‚Ž_bØbmî$ÞÑÎœ1|£Í; ÕåYIo¨6ç(+˜öÀ¦/*¸ÅÚŒëÉü¨z(A“ͶíÁŸ&Cu¦ñNÎÛÅ‹hÕüí‡Goéí÷÷üó®¯'yó^=ëk ŠDN:ï¹e}@Ôuê-rËúìq›ÉIçÞâ¶Ö>í¹:û&·g}:WÞm$'€ ÌYŸ¢¬Spkàww6Îã€ò9#é4\‹; ÿ%‘M:/o8és¥]pQÇ–ôˆi‹µ™×“>¦a:ˆ§²Yד±î¨6ãzÒG¿6ázÒ—°Ý@Èæ[Oú8–xÐ$›j=èq Õiøiæš_uøçÖágÔÏ7mžtÂÍ›Œ6_5m>ë|[ä–ð˜5m>ë”[ä–ð”öm>ëœ[Ü–ð>íÛ|ÖY7¹=áÏÅq›ÃYçÝⶀ÷¤ëÌ[àVæ ÍF.3I¬…Y§ßZÕ½ÌWXìT“DY§áeL‹xÜ–ùl±E<ì›l¶©×#>äÆÁKÔbÓ®G<œ‹ø†jS®G|Øgq±×#>Ӷ̛p£Ì—rÇÅf[Ïx8óL†êL‹Ñ…Ä]äÿ¨ ù¢snÞÅòEgÜ"ëC¾è¤[äW!OÖy·È=æƒæPSuîMòzÀ} W~ Ü“g„ªp ¹@¨8#T‚ka#9`†—1œñ%lk|5ŠØkºÌÛékÓŽ0;Ê°­Í¹žò)Âk®§|¥íCoÓªw\M¶Û=x›mŸg`ŽWÆê\ãŒ/—£Øço³¼Î¼yC؃׹·Ðú´¯óo¡õq^çàBëó¼ÎÉÖ>xŠ‹¬N|ð:Yù:×Wg>€ÎÈK]è•T¦>€ÍAmìØÔæ>€Í>mðØÔS'?ؼS'?جÓ&?蔣Ê'†—Éÿºâ?¿ïçñQ¼ê4œwë@ ç"ùý§Ï7d†‹Üò?DÒu".r‹ÿ|žZ7:ºÅ?Z§ãDGðòxµþ/µ–,³uJ.v¬®àyþ "{D2\çå‚·= ‘&©QgæZêmʲÎÍEÎÞáÌkt³¢#ˆÃ¨"6Ø$ì;@@Ü&T°)Øw€óžkÈsh ¬—¡6õ¨‡ÒŽj³®…©q_‚͸þqþAçÇN®¼E½ ÿ+û¯è¿Kþ “oÞÊüA'ß"ë“?èü[äWÉÿñ“ Ž:¸çþ̸[°NÁ ©O3™}ªµÊqu.xýŠ'œ›IÍrìG ^ª‹åé䃃ŸtæÁÅO:íàä'uhó¦±q©”Gómoþ×ooÿûþ¯Ÿooöû¿_Óo}Jï~IóÝôï?þ:1ý„ܳO„1…Ü«Ÿ BÆr~a€L˜„‹5.ÏÃgßmLÌaÇLxdSÚxŸpÎ\ÒŽé(ðÂ&æŸá´‡cNÊ!¯‡$=}q:~qÌKagk|±ãÇtqUzɾ橌sí¿¡NDrÉ$GñŠÕYH ñ'¬NA"kJv#vOÕéG%W˜/Ô¬S/ÛZR[nß5ëœË¡®ìnTL¶Ú %¿ ýYýÇæÿñÖþmÿY˜{ë³Æäˆ]ÆÌrK˜É¸1ù„ÜÒŸi^W??`L?·ò;bŒ ¸À#üy峎,&·‡c ¼>ŽªÃ<„ï1åÃ¥’1…ݺ_¢ÜXNÝ/˜“rÎ[÷eû#SSà=üsH§Véf ?ÙùKÞcuöð·íÝ ½?Eç` Ý|Åêìá/6\²WtöõðsÉ7ªN½~7_ÔO@ç\?'¾Q1Û8Ö¯ø[øÝo¹ÿï÷ïmø÷öŸ†?c®|­ÿŸŸŸ¿hÌ?A÷ü{¡1Ýû¿ÞáN™fÌB÷þ[àbaÌÃŽ6›ì|Yùæ쌩(äH&;2¦£[úÙÉÅÌi¿Ÿ³RNzK ,pâ´ßüŒÉùÐ(›ó<_OD©gñ&úyѸÁê,ìñ~„/ø=Vg`¿Ÿ§ù„ÕÙGÉ™RM¹?|DõH Xz½ÿ1Œ7µÃCÐi×ú_ãæoTH¹úßÆˤô¿§þëh}»ê]Po‚ýÇ@òÉÇôê—Ì@šƒ…Ô{ [õ}*²ïnÕ¯—/‚v€të¾uBC º—?Ìzìsp‡r+¿#ìB†L| ™@–2$ãã€{2Ö»„!!ŸÔ©Í/×ä§4²'?ò«Sl49ÎUzäêü#Ÿ ßW'_~}A¹r½Î¼}N÷çàuÚ[Ã.—;W']vÁ”¸¤û²ÇbÆ9®C¥¾|ýþçîœÂï1ýÖÇhÂï1ÿ­¿Ç´"üÓPЊð{ÌÄ…V„ßc. Àl2þ€ù(ÀŒ|¨ƒ…?(DÃt Âá:ÿàð|pøƒÎ<8üA§þ “ ÄŒ ΤTâ#ü½úoµùcøï¿xÄÌ[ŸðÚü¿ÿøë@ÆÌrO>ÆÜp ~¶Ó韟0&Ÿ€[îM³o£‹†œ?¥}wž¹ì٘ŽlŠO~²}HLiÇ4xaóÔ¥Á‰)îᘋr¸ëIÁÆço~€cB <[ãKBúýIJ!Ù²ã‡ôvOÕIH.™äÊxÌÞï±:)°©?]±:ÿˆ¬)9 ³Ï@'•`ûx£êÌËu™;7'Ëá èœË¡.N7*&[Œu ¾ÆþŒ}ÂŒ[Ÿ ˆ}Ât2{„0{Âœ0{¬[àè¬qyµÞúÀL{6¦ž°{ì-xrÌûóG˜ﱧ p:Â1åp·ØûRžánÇ|xý|OsûxRHîïhãˆì/lÒIHu3r‚÷PTÿàÂLýžšuòÒ§tirÖ™7J½?²N»Qúù&²?YY'\/=Ïåv b¦ÕÂ×k>¼ÌúùÿœŸ1Ñ{4~þfçgÌ2!÷ÆÏ3v!c¢ ¹EžÖ[Ù™ŒÉ&äVy[‹)cÆ-òØôvÕÒy:lú‚y'ìžù(˘êÖØK]0ý>6ýbg{dcÊÁî•g’/žpÌE÷ÊOÃÃ>E)cŸôsaøý HÑy86ýÜZ'¬N±éçõqÂê œ›þÖ¹¢³o”ÞÝš\tæÍMû®¬snlú’oTL6ª©ä*”þ'PzÆd[ìQú˜¶1fš{éÒcÆdò(ý}t3f›p{çsÀ˜o Ü×üºšên uq§=³Nà½óvuÞ–È%ïá˜|ç`Øy©-Þ§˜1åXß~FyU Ú³£ÅDvϼátÛh•&ÖÌ'.ãjr[Á£ÕI8Ö<ÅóðŽV'à˜óéÕ¹7ÙÝÑêÌ÷áFÕi7ÏçG«óm4ž/÷Q´˜h591×ñõ¼ægâ¿~|«ÿãë!öÑbÆ­±/@ìk±tä{b¦œ[ì³Æwt˜uBn¹wÞ!d̼Eî½Ïa%9Ô²Åíʪï:xïýZÇ™cÉ{»æ¡°û¬/8ᘎrÄÛ®Î?÷o;ÑaV ¼?Ž3Ó«Ô²ïz7Î5mïìèt"Ž]?Bû£áuŽ]Ÿã«Sp4nÄý]êuúæÏiq êÔÍw×ïªs®7Ÿm¸Q1ÛÚ¦JÏÍÿùæÿØ·ÈcÖ­ymþŸŸŸ¿hÌ9A÷èAhÌ;A÷‰é:Å£ÇÌpßø‘ïà€¹·ÀuFÓ¨ÛÛ·zîɘ~BŽd²]/Rg2¦ [îKZï%¾Ô7¦í«C ˜‰rº{îKx<Â1!ê$c³›çãËá‰(•,ÞÔ 9ݹ: {ðCº‡}A‚ÎÀüìæi>auöQr¦/OáðtöQÑ)“¿>Þ¨“¯W?”résԉתܼNTHºúòbÚïð4ôGð{ùõò÷¿"!×'õò³Cöm„ìpë~ðCú ¸oý %B ¹o}‡‘!¹o}’É\ æölHDa÷©/‹¹ÔžlÈEa2¡& ¸U$£pOõQÇ€€!Ü&>Ï6ó~‹'má»y˜ó~3'•{d£ÉžË5tIeùl(ùpǪ¼ëŸçÚÚ‡.©”kûÞ»ë¾O*ÛˆÛ7õ÷ $©DË.˜ââú¹öTL1Wûè2¿¶¾%¾~µþÇøëö£“n}ÔkìÏ#L;A÷™ÏSOÈ}å0Æ ³OÀ}åç€1ÿx¬üL@ÜSPÈ}åäý0…ÜW~Y·ˆs–Ëþ!ÌG9âmåק"pw„cV>üi+?^e'¥–}ä¯cwàfƒcäó¸ Üþ*É:ÿÆÈŸ‡ù„ÕÉ7F~ž‚ν±ñóýêË:õúÆvœ·§ê´ŸoP̸àLàüÏÿ:ñO ?cö­Õ·XâSOÈ}㻈1û„ÜGþz¹<ß'PÐ}å[ I¸ÐcæÏSmß}NõqÇTxßùóhÛ÷D™žÌG÷¡¿îïãÅR0#å˜÷¥BƬrŸúóå$å=VéeßúóPGÚcuα ^Ñ)8ƾKw®NÀ±öC¹ sÖ¹7æþ|59PuÚ½ïî€uÆÍÁÛûŒ©+,×tÿ¾÷_çþií3fÞú ×îŸCǘz‚îkíÐ ÓOÐcîûû*gL@÷¹O c .ð˜ûT€Â1&¡ûÜ_ÛöDNQÈ}îçu™øby_Ðd1å„·¹˜A8&åCŸ6÷ƒ¿Éž¬R˱÷Ý«³pìý2n©°½°“Õ8öþ<Í'¬Î¾¹÷§ “oîý;V§^Ÿûáÿ”—»rå6å¦^Ë4ž ÊÚ/QêÌ–´åȉ¿Ýƒ×Ü¥ªœÉ¨ š\^vÏ€ ³'Ñè´ëëþ¨Ûšj1åbݬîÝÿ㕃ÿûÛ[]ô_?¯­ý¿ö??ùâÇú YÌÅy×>(«-æ¡€Ûîp1…Û6ÿq݃1Üöþ„<1¦â·­?ÏżXÏ“©¬á˜¯[¿7óHáù[^ï¤ÑbV ¼xãc77/øÖlLMùܽ«¿# Ûîؘ Ân›¿í߈7K¬SZ7ÓÇ–[žÛ¢ÓØ€†uNœÎ¿6LˆG¬N¿¶÷gÛ_‚]SuߌUtCÕ‰×êoóñYuÆÕú»’≊©Æs/{¶`Qÿ{üOíw˜‚óžxû柀Ñö{L@áÂí÷˜ƒ†Ûï1 '8Øp‘Í~¶ßQY‡Ãc* »¥ßÍÝ{*aÇŒx;Hù½)>®Ù˜—ò­·ýÿ™~W¶pLO·ö›þän}¬ðJ?[ûçηyÍ:{ücOTXO*¯°Ç¸Á#þö¾ “¯Æß–r jЙ7âoKzÐ9×ã?’¹¡b²qu¼åIòsü—›ÿ)þ“pÞÀ0ÿ€(\8þsPÀpüfáYüMÉ%¯;1~_üyÝ-q½øGLI·ú{-™GËÚ̈™)_{Ëÿh^…Ç-Tà5ÿyì|n}¢ˆJC[þ‰ŽX„=ÿaT6X‚=ÿα:[þÓ1ÔQ§_Ï:méQç^Ï?ž•tÒõüÇÓ$̶â¯TRXä_WÂœ·ÄëO˜FëO˜€Â…ëO˜‚†ëO˜„¬«?a* ükýÍ®þ„)ð{ýùPÜŽ‰)û½þ!»¿D›/Í‘ ¹ø¤Öà‡Ü<û¬Kyü )ù„sð=ï/yU:™3ÿxe¼ ³v=ëä#ËŸ[‰ap×ï¸èÔ#ùÂÒ™«¯5?xýŠNºÚ|gÆò¹¡ê„kÍwÑŸ¨:Ójó½ñåDÅLcÁRü¹ù¼ñ¿rÜkæ?ëåÜù¿õ?ßùb³ôÌÄyמþ±o<þúøøÜ 1ÝÚï„Æ\t‹¿ÁИŽ‚®õ7Ùhî· LºÌœ…ß­Ù€1%ˆ·;‚Ș–BÎtyJ!cjÊçîè2œ}„Œéù)^&çñIÿ¶á*Íî Þ\‚üÿã ŸÎ\äÒE‰€çÕÉGÑ^9ŽÕ–«3ˆ˜9·w\«ÓŽŠ¹Š îÌÕY—¬¿r ù¼k,¦œ·—ólšÌÿÞx¼>ÌÛ/mð€Àïã`°©“Å„œ÷í“`œdï0检Û ÎŒ )àÛ`Ÿj‹9)èvðÓr¢û!`ï^,‹”âš©)ìP®ì< xp…_üŽù)ð: "Y Ø3T>ù: ì4iOÆ2Ÿ\g¹Í«pJG‹»XƒØ±aÕ)Ø&lL›R9mÄp.«Ó ØŽ¥cݪS¯lŒ'ªÎº:xÏ¥ó+Ð׆€ Òmü/ÀIµ endstream endobj 3 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 4 0 obj<>stream H‰”—Ío·‡ïú+öh2ÅáÇlbEiDéé½Iж”øP¤‡üí~,÷UâYÎ\¤WZéYrwžß íöó lÿÞnîþú½Ý~þr“ÜÃÐúdMÁí×o~¢_×ÞZ“2]“ðÏWšìØ«Ñ™ŒìÕ”Má.L ìÕ Ë 9Ç^Λ®8ÒC(ìnc¶Æ³ÿ‹Öd—Œ.šÈ® C1‰ÿ_DØUaΆ½˜ê[å®úøõW@Q²ôGí=YZÇׯlè«×ÀwÑA}#ÌEO·ä®*>n9‹ñìz˜Ìbi—ž]m“»¥£]:ö¢k™¹H»tÜzm“}#Ž¶É^£]"»Ú%°ë¡]"·OÛîžž¶ÉQ=íÒrëñ´ËÈþ'íÒ²ë¡mFv=ìköùb6óÕhl5ïùj´Iöcæ«9ÐÙjÙóÕh›l5G›ÙjŽ´K¶š#í’­æ»Ç‡ííÛ»oßÿía³Ûýý7ï·›oé÷vƒíñ§»=þ‹.=þ—¾l_6°õûÿê¯~¥/©fð›öÕn•[ƒÙÐ~ºyõiûËöy{ûn«žéÃ=}zGw¹Üõ ÏÛëÇÿÜ|x¼ùð-Ý÷z1À,æ+÷óæ¹Ä~ÏíóËt ¦£¢òÔjWL¯`ÖWbZ2ƒ‚Iß,àzïQÎ ` $ÄÆ´·P\IÀqQÁ¥Æ™ ×¹!Y"sܤàæDCäÆuÆÒ¬‚9pà,G*‚HyÖÁ·6'Ìžã7YÒ5wn`‰À ù5d¡ÆŽwæÙ§ ­Æ›ƒoHö‚B+¤!Æ¡K¦B+DkrJ]ÇRÑ[6Pb\J%K™¡¯Y¢B¦ä©†ŠK ¢H£Bs›/åep×¼¦>‚»ýX“û¹e8{K‘`û-{vû¸Ì/ù5±-¾}^·‘cÛ|¼ÆíãÓß¿œÈ´ n1îD`‘n;¸e9–02×͉E‹¬›èçGš#U#KÙ7É™æ FQÜ_lNäà¬o‡ô”÷Aá”+2qrkž—Ø“2Zª“±&:tf`w*ÛÐCÁÑ»Äö†ß¾J6tÉ`ô°¢z•k-Ö˘ÀØéUšÕ`wàË‚©2 K]§_n^åV:&@Ü_ iÔ| ÐÇ?æWsùï—Wm4¿¼Þî.—v‘ /²nÞV<Ÿ{‘uW<£‹Ä;¸/æôÓ0ö"ýr‹y/"‹œä>³Ã>²S'¶¾ƒÈÃÝrÞïÇ€ùdl"vKz$rIy”z‹zL°HÌܲËbÐJ3[ØŽç3KÕ‰×ã~´è“l :ïzÞ‡´Äê´ëŸÎ‡î ®þj’:×zâ‡ÙEÙu¢õÐÏyúQ¦C$ÿi¨9ÓÓO5ï)þŸGü³·• ¸ßV<ØG™“+ì£ÌÀÉ}1ÚŸqeNn‹ü}–=ü(Óp'ÈÏûhŸ±DvNŒ2'»e~Ø É½K–-sr$dã}êO$°P™“*Î{”I9Á×yÀR•R^ç}dŸ,êœC Z+#ï?4 N¹–÷!/G\Ô×ó~FøG Ó­¾-°€êLK”ÐàR/.¶å£N±–öWi2¹<˜œ¨yδÿþ‡÷[èë÷Ï#íßÑ'ö>2ßöû´xÏû ðÛ_Xp’ù6Á5ß]Ì°L¹ ®’ˤ›Üð6ƒ,Ón·|Dzg°GeòeîMvËw·£]*…M‹$3p¢s1!ʨl½×©þ—í]ËøcÆÿ… ¢,³n¿£x”Ï2ã&W:Êg™t“+å³Ì»É}1ÊŸp‹L½Ûù¸Ïñ˜È XdNtËù„ƒ>Q9²l™‡³ëlW†Œ‹Ìà ­ ïÇü·>ÒŠÙ3B‘é8Ùm”wY‹ÒÇ:ÊÛÒ«8° ºèœCˆµÓõ¢H,ü!ûgò=àäleî·­ /ÈÓ(sp‚kð^§Qfá׆Üç`™‡\;@š5Xfân Ž{v8ˆ2';eƒ9¨c©(Óq#dãCZRe:Nj;Ät·)Úäù2+'¼öQ˜o%¨Ô²°?‰Rx¬N;ªµ2ì sÏÕY‡>Ò k®Nº~"@\dêŒë'‚¸J}ÔéÖO¾§þI}éDë'‚q–å©I$š£%&*­#õÿðÏç€<<œ%|Y7oÑ>…oŸžžOÐ"çtÍxgS~Yw€kÆ£EXäÝ®om€EâMp°ÉÐÄ9Å=زH½ƒ\G|7ÈöÖS5F~šK"xñtôe‡{[øèL"Ú®q?TM*ñù™D6^yÅýq¿ávVúXãÞ†Îõ|$eƒmÄwP–XuÄÇRÒ«³#˜\ÍZ>\|=î­_Ä}Ö™×ârYQuÖÕ¸weÚxªL7(ÆùWqß3¾¦ý~þ2ëö[hâ>ˤ›hqÜ™u,Žû"ón‚Åq_dæí`EÜ™|“ü2î%2ò‘\dNx.&$Ÿ'Ná2gq·¼Ç \¹ÌÇà üXp™IEid |×¹Žï«EgaüugX=ð³[`)duØø1¯®³:ýjàÓ“Kç!ZECíŸm¤>|µ~\´geÂy0 ®¤üår·ïé<¤ºCÏûyOÍM‡nyïÖ±ì¬Lº nyï\™u“ÛâÞKÀ2ïvp{ë¸w So’[Ü2…¦-3—ù7á-îqöô1ñp™†³´ûxŸ¯á'+ÿ?ååÏ#ÇÄѯ2¡lI-þ' Ð*±•ú„;œá`RgÞ•GNî³YÕ¬Ù“ŽÍ_%Ò¬VxÝèé÷ªˆÙøðfì÷Ûõ>x£Ž\{Yêüò0¼MA‰}¨[¬M¿ûꀻµÉ'±oÀ³µÉ'Û½÷›€z›y{Ú`³Nbßv#$`º¥tŒAþXîï3÷îwÉýý‡õE0í΋Hî£Gr0ç&™kï÷í ˜sË­÷ àbÖM.·ÞW€‹iwr%õÀb?„·p9ôç«L½‰æÌ'!¾\²1çKÍ•¯cGLCfDÞ¥m‰¢ÍCŽ|lXÛMâIäϼ]QMÒ =m©&ç$ñe{X Ѥœ¬ó”7ÕŒ&ß$ðm76¢I6é{ÙMˆiÖÃ^j£o–ùû›çÛÛQöÛǧO7þ§çÇÇ‹?bΫJñ+!ÅO˜ŠæäÏsßUCf ‚9ús»c*˜«_2Æ<œ`É~i@÷梒9üeîÉ9ºXæf¤Â9ý”ž/ᘙú¾öÇ l"¿^ð&èÃ¥Ñþ¼ßB“ÑQŽÿ¹ÝÆ‹Ga“PêŸi‡Í6eÅu‹µéÇý~?X³Í>YñÓnmÎ6õxŒµdCµi7F@t~7¬2æ[¡Ãç~Öý~üøí¸ß?lG@ÆDœW•Ð*22æ¡¢yÌUá*¨QÁ<€õç\¿ Õfž €”wT›u2¢ßQ1ÝzuJìþ~|þíË·#àÃý~ûÏýÍËíéæúoÖ×Ælœ×æ1Ð÷;d TLFEó à$P1<Æ@uÀI b>*xÌ@ÅŒœ`žÙ!'ŠI©ä1¢›5m!´š×pLM…óˆó$Ð|mµ,á 3Tßz> œÞ;w—pLÔ‡RcÐþ(ÐŒªŽAÐKæ–õ ØlÊ ÚbmÊ ¨u‹µù'ƒ ï'A³é'“  w½o4›{2 í¨6ïdä¼£bÂQ:¼= þñóÏ<ÞêèíÿøÌ?ŒO/WS€0çuå0P¡)@˜‰Šæ))@˜Š æÃ@¦a2*˜O˜„é8Ár(È ÌH%ói èNûi`ÝR´Tø˜•’ ùõˆ!ÌN}ãy èI£GðêÆ1G6!÷C€Œ–òi  7Ò MBç@¼ÂÚ”!ëkÓO†€O»‡Û×e—‡@’!°YÑÙÔ“!hGµi'CÀçò­ÿ·#S™ß uÈGž²P/)ýou›¼±išÀr¸‚.ÇÿlÒ%ØC>Àž„‡4TpòîðóÐâÞù”©¶5’ñçþ‡ÙÿÔŽË¥$zÈÈœûŸgÿSotôk8$æãeýÜx\W7éù`WwôSɹù­Ëç~öüój]cmrþ}I[¬ÍÀ‘ÿ.JØbm–âŽVÏô­ß†`³oÄß·ótAµ©Çñwm{¯6çFüûYÄ礼lžWû-~ÿÏ¿}ù&ÿ÷û‡žþ§Ûz}Œ“p^”óOÈtÀ TðÈÿx°{0æ ‚GÿkØïè1`*xôß#+`N°ô?ΊzJT/ÞÌF…÷ÇJñsîÇÝuE#椲Gþ›®ûú¿niÄÔÔ×]Ö=¸Äx Ç U8÷?Ë,OĨ(¯ÿç7™–§•mÊúïýkSPúßh‹µ (ý/²¦_þõïŸÎ?]rX_ “o^‹³_+Ñ„‰§à‘}_ÅêÛ_¿þyÆäSôÿÜ3¦Ÿ‚›;ˆÎ„^ƒ1'˜ÃŸK™áÏ‘êZÄi¨ðTŽ2¦Û'±$LE%ì—“ÜoÛõ¥'­á˜‘ú–óÖÇÄTøÈ~Í¢{\O“l4³…#’Poï×Ï9Û$”µ?ŸËi^cm JöÏ!u…µé'Ùwh·¦ÚÜ+¥¿‰ÚþÙÚÔ“ð‡ÝâŸmÎáß-þó-¥ÃÅ×á—ÅÿÑýoêÕÿŒY8/)ýÏÀ®›1Ìý?—ƒMÿ f¡¢¹ÿ 8QÌCsÿ0 fâKÿó™:G}[ëX0•ÍùoÈÁ”T2çÿ$o ]0/õ]çü»¦pº„cz*œóÏòkô“óïÓ¶QÅ&¡ôÛéb3PòïÛ[möqþ;w“ÿjSOòßÂöÑV›y’G›PW›sœÿF»¡R1ßzö³ïšiþ]Ï·§þ»÷{ÿô¾zê¯/„¹7/Äѧxvîïßÿº câ)yT,°sOÉ#ú5W„ŒÙ§äæç !dÌÀIæì×ó¥îÝï3”Ö1j˜‡ Ot´¨uµ´­á˜Ž éoq.ç®UjëKÃœÔ÷|¤?fz ¯k8¦¦ÂGú[;…_÷©ݤpwžà®°6¹ü!Å-Ö¦áHuÁo±6eó?³wAµù×7ŒÃS¥Õæž„¿ìî•lÒÉÞŸwÃ0ÛúÌëÒ†Gø¿üóó¹ëè÷MŸ³ß?­“D˜{óRœþ–‘ô&ž’GúCAÒO˜{Jé/µ!dL?%ô»†¤Ÿ0'YÒïéODëŒ0>Ò‚¦?wxXÃ1N±Ü‡•ÞZ³1)õE¡“Tvr˜šÊ®é¨áYËA˜œQMª‡K^ÞåJÎfañÔŸƒK;ªÍÀÒ×S··j“Oš¿«sr6ñ¤ù%î¨6é¤ùi{¯6Û¤ùq3I’Ã4ëÅIµocÚüYûñ÷˶÷ÉaÆÍËHï°6÷bÙÈÜû T9yÌ9%Kï0¦‚%÷!cêM2ç¾îËý¤°Þô“ÇT¸ä^£Y¨­«é1•=ýz¾ã‘/á˜úŽE?Ôð¾.³Ç´T8÷þœ°·lÔrô~ìÅ×SÄÛ,äÞçóA¬©Áf ôþ4ð‚j³O‚?߈5Õ¦ž?nçlÚIðýö^m¾IðÝn8Ì´±Nå×ÁáÀ?õ߭јg-‘?îí¯_ÿ¼@c–)š+‘1Ó”<*Ÿ "c¶)¹¹>¹ „Ž˜rÝw‡cìò‚þä/¾Ãˆi§äTŽBó`vMÆÔSr+G?Àz„Œé§¯t(‡ósR_“1²äÃÕ3˜Ý—5×(a GϬßsmö]þ¨CÛ-צ_ õ(%÷k“¯#¾Ö=צ^éKs&—·Üdó®PWÚÇ=Ö&]õñhqJ÷~…ŒëÇ•c|Zúû›çÛÛÛËý‡³øÏ7™7¯ Á¯P–dž’e«‡Àz æ¥>B`È=óRï Ú'ȾI–Ø·ä-Aú)˜[ž6`È?Ô›!ýô…C>Lé™o~Ÿ·l+Ÿ¬É:‰|ÙÇ-›”“Æp·&á8ñÙïŸMºIáðL®Ià›5‰&}§mß3f™oãéÿþ¹þe}ã3n^â ÿ÷ï]1å”Ì…o!cÖ)™OPã fž¢9òCcöMtòéèfŸgÈw®«Hk6¦ ²ÍŸĽó¾Q k8&¢Ây¯ŸKÑe• 梾߼×{ä”S0•\ÝæyÒ—5Ö($…þ’>}êÑÿxYýŠ‰7¯"ÕoÉ\ÅÌS4g¿Ù§hî~‚Ð 3PÑÜ}ì<Ò0 'š·û4ª—‘k˜†Jîë}uc&*˜×{ìá ³Q_oÞðÏrlȘqÆŠöž7£¼ãçýÆØl Ê’?×£+®Í?n~uÿ¥¼Üqì¸(º•‰¸Áâ¿/Áðj,@‘vo²HÖÓ y+’äàt»_ŸÛ‡ÀýÚ䙕Ë6óFççû©„mÚЯùεI'»õ(¹ÇbÊÅF+m½?íþ+÷ûþï/¹·.ñ9õ?þ=€1õ,“¿òåÆÜS° ~©È*3¦Ÿ¢eð—ÖÇ{Æü[àHî¡œýJñL\ö¡È˜„ ÿÜùÁ·3綔’ÃLT8ÜùÉa.êËÝ^Ö# 1p,{6棲{é×87l=É}”Ò÷c>‚ÛcmŽÒw×ÕOΦ`ÜRÀóõvmJè×y»‡gks¯‡>ñ¬ÏÕ&ž„~)×ÃNr6çJpOpîv·„É–ºc¿ïý¼÷‰0ëÖ%ÆÞ'¤iaÒ)Z?D‰§hÙ|ÂИ|Š®- ˜„Æü[h‰üPí$LA%·Èϼ^ë3ÓPɲ÷8˜$ÂTÔ—»W>1p2I„ÉøÒ¦U~ákÕ%oÔQ*ÿN\›ƒ£òã}”¼M@©ü\€ûµÙ7*)O\›z£ò=ðlÞÊOñεY'•ôc²ÇbʵÿûFË¿¯þŸïoßßÞß¿¾õàÿèóÿÖÿËþJ˜‚ëJ2þL|íÛä1ܧ?xLA÷á/KÁ#sPÁ=õÉ"`.°¤~™_Á–úÅq‰{8f¢Â{êÏþlÍÜØ1ì٘ʮüÄR<†ÊáÇ”Ôw\bŸVíçš+o@)`^*|Ôþèô@Œ^JíÓ8WÅ}>›„™ÒÓ¾péz·6{ì·$ï]â-6Ú”Ø/ñºÑf߈ý@7ªM½âÚ’]ïÕæ\O}ÏnTÜþ犘mmvµO´Žþ+óWòÿäïG€CŠFÌ¿u¹‘ýó¥{ûõíçŒÉ§d™~—2柒eû§—2˜ƒŠîë߆ù¾þ³pÇú»µs®D®{æ¢Âeý}]Ÿï¹ÒŽ)©p ÿ„V¦¥¾êÁ·ßQ?Z>–?an*Z–þŽ”÷X£œ²üsKép·6 ¥ûãD²Ø—¿¸2Âá“lúÉò×4VêðšÙÌëËï]H7ªM»^üµúr}´Ùf\ßþàRº|Q2¦‡§ô/ôÿ¶ÿÇÜþÝþQÿûËaþ­Ë}ÞþóŽfÌ?E÷ñ÷S”sPÑ}ýsÂИ‡Š–õBc..ttåqqvîyE3¦£’cn–¯¯á™Œ)©ä¾üÙG„Œi©/ºÏó3óÎ䂉ùR(=®†|¾Õ¬þ‰>ß7ºØ”éo'¬;×&`öåÉ…€ûµÙ—=5Í#Õ‘kS/·ªNœç`ó®˜8Þ¹6ë …§,×ýî±r©P|i?±~¾¿}‘åÿC—ÿ‹”ÿó°JòP/7¾ÈÝ iøËþ3À…4|qeü×ÏyC¾ÀpøWHDGŠO¦yJlmZ›ïÙŒ/v{>Ç4Ù>gÞ§n…„|±+?±ÔUç¾ý;ï²BV¾^óöz¤@^áÌy_QRó—öŸÜkTSÚ~gOX›‚™Ò“hF˜ß)Ø&`oÿÌ3ÀNX›Òþ%Î#Åžj“¯·?ñÌÕf^i!¢ë½Úœëåïyú| b¶Q}Jú}÷{ù·Æo›ßwþ}î}¯þãî3æߺÜØýBHè2fŸ¢eù¡3c*Y¶ŠsÆT²Œ¿cæáBK÷‡ ÔyÛ¹ufê<;LG%K÷#\LH}É¥úDƤ|éÓ«Ÿ®UšQK©þ{ífgóoTÿý4‘M>©þÌÀýÚÔÕ?§ôȵ‰7ª?ÞŸÙ¬Õ¿]²)'ÑxÝî‹ùèñ¡uüÿþç/‰üþ§kãÿq¸sL½u‰1øîž·™0ó,s?_¸_ß~À˜z –µ÷!cò)YÖ>„Œé·Èч'ÖXgÖ:·mÚL˜€JŽüT¯ÁìˆxŒÈ„Y¨pIýP1¸ÇTÔ—»§~;¤€pLH…—¶£4¿û‡í>rÿf—‘´§Úl¿ÊÃi>ˆÕæ_Žñ¡nP›{£òÃxÛ“Nö6ïFåûp£Úœ•ï®÷jóM*¿Î¥ÿDýO€Æ< Ó endstream endobj 5 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 6 0 obj<>stream H‰¬—Ao¹…ïó+x´E‹Edm%Èa'žÝÍan‰¼ÙÀ’¼v€89ø·§Ød÷H²ª»hÏÁ3í¦ú›"›ïÕ£3¿ì¼ùÕìÎÿðÆ™_>c±Å8[È|¸Þ½å»õ28gSæÁl ~9 d3ˆ£l&q4ñmiÖÛÒ(¢¹˜Ñ‚8!Ø"V‰¿ÄÙÆìlŸ%–Ä’ ¢bU„Å&ùY"‹bU”³“÷6‰%§Ÿ~¼êÿ\ã{þ£i€W–ëxz¬Ð´DOŽyW,¢4¾¾a0ðOJcÈ›O*Çóš%ñÉLV¬µë$*øi©„Áà-Jä}'E²AüIÊUD _±žª8Ÿ ŽSãY&©žÀ³©žÀ³W=ð4A¬‡§™¤1¾ôb=ðGªUMŸÎTn5X^ÕýÍîÙÕOW2‡g7æÌÜž›‹—æ†?Í­9Îy`¿™îO—õžïÿµ»Úï®~à:îç…âžøýÀ&Kl5˜Û;‘ L`SüZ·˜a€Y_IŠi“‰̺¿n¯Žäµf>Ì‹{&—:$7rÈ¡h“:¤6‚Ĺ=nÖ†¤VM¾¸Ô<ˆÌ!•Q í¹›òZ¥C£R+-›Ð!q%ÏG¾àçRE¨JZž›Ë>ýÞ±»ÿþw/÷ló"Z¥®=YyÆžsÿ{ýQ«äuW3‡˜`•ÄŽàé°¤)X%²#·z¹Ë^Vél7//sæõ)q/*µÙ5§wstß*QD«DwDרž0-lW0Šl•ôŽºÆuHǺÃZÝ*ÙSdïä…” §öXzC±]à˜ú¦àîcsvS6ŽI¯fw>WáuLw-¾»¶‚Ý”àsñÐ1ÁM!Þ¥´Þƒâ˜Ò¦Ÿ)l@uóÅr·¸gìžSú–³GÆf¶ÞÙ£N` XíìQ§±¬uö¨SÙÂU;{Ô m?rvp¹(·¨“ÛÂ~èìœTP<=Fèô#gÏì¾òŽÖioÙÑœ=§•ºI'Á…ýÀÙÅ~Aƒ¼ïìÁ‰Ô1õ=tv±_Иô:»LÓÎÙiLt:g§1ÁéœÆ”¦svÒi,x^Ê’ŽÎ~SýÖ¼xqÙüýFáô¤ÓÜü[“ÓèÆùîîî½HN:Å-äjõÁ‘†¬SÝBž¼>«È:å-äÉíçÓâ:Y§¾™Œ.Y‡ØÔg.½“Á:.`$›\Tpu\¸™l nBë`—Ý d(À:-e­Ës8“±ƒjÌ`Ê6vLxäЦ~ ›ÇTG,Íýy ;&9Š|SØÄŽé([rn{ÆÄFÅqÊÚÄŽI-ù`3ƹZ‘ª¢ ±ÐÑí¹0ŸÌÕß^³»_°å><ûd^wxn‡óÚŒ¬•¬áü£Íö穬ÅÚ¬áž\V÷*X'Ã\M?Í;p¬â®žïsÜgð”ðSÉsÂϼà$²uz\Ø5á˜O}ñâé¡èD¹°kÄïëQÑÄä²uÂ\özMø!ÑÌŽq­Sç® ¿ôNåÅT''|r¹íg”k“ß”ðGÔ1íÕ„Ÿ\H[Ô1áM ?{¿q˘覄_J\‡z7¦¸)âû¼QªwcZ›2~¡ƒƒw:•ÅP©ñhûŸf¿ùmç1qƒiCÉ0€Îò1çÃõîgs»Íåu\j`î$üÍ£)[Hضd=i˜“ÆËc]ùšÊø•Zt¹gšÖOY‹©ãßüør¨4G€¾à'-ŠßdDl¾s.‹3ë|&8eQ-PŸ-ç’¡’Šç¯9“ñ9ö¤Û <Ó¡/×ùá0R°§8€ºóoOZ?4<¹¡Ò؃²›45 ž²0Þ»~nmn¨,BÞœN¾Á€ø0K¿ê5&Ï-¥g óù”U±5ºÙφŠÊΦm¥núû;ãäwæídÿ˜Ädx¾!ß;]Üâ×Ð2~î¦y·Õ嬭ù\P`uA«ckº'—X]ÒêØšíçãå»»»÷+\]ÖjÜ)ÚÇzŽMsF­ \ÍÛ5–Þ(=_újN2[—»:;' ó6ؘÈbL"ÛëÒWcsœµ¥”~ð»ô+»ØëòWçRä“NiKíC‘©ºüÕ©™%c3ïWÖ`DqÄ]ˆÓW³ _œL‘A²ü¯kãle]G7Åú~T‰#b›2=ë`‹9"´ä<{5u5¬,èˆÄ’6eìâL†ê´•‚Ï—µÃÌfs?ÜP²éQûáEÒ´ŸJ†¯ËôíÑÇ™þaêúÖÂØ3yÆþ«*ó¬£\žÎôß\²¼Cž;ö¯o‡Jã^”òœn†®o.,9Ë'™<’¹æ'9sAÌ3×·WÄ‘ ÛdÿýÏ¡ŠXï¡äöú¯oÍÍIW ¸ÅBCét~-Rúû{Áëö´•!Yò™¾¢²Èý!Îqþú„%ET¿ªàwc%‹Û¶úx}âí¹z#ö6;TGŠðÅöÛ+*6S¡±ÓX¶ ;q¸'Á3`Z¼ä'“½å4/vÐ¥ªŒl-ç2ÛäJ.]¨êØ–âAÕ¥ªŽm)ž4ytÁªƒùUJŽŠzuɪa[Œ/=Ås/$'AÐ¥«NFÞ5ê44_€d´.fut&½"hƒ.j5nä=¡;A- D­ \Í]l[(§8Ю-À§£áQΛaDoä¸÷Ï­c%j‡µQ(–JoÝk•Žh­å÷жÈÌ™M ¾ø¸ÅÑ•Z§Û>½„}¥À;ª„ÍJuÂ*dcd“úJ%¾6‡g¯ÿz5ùEo~|ɇ[Ætœ9?¦ûnŠ¯ù®\†N‡sÕô‹ƒ°ívA§Â\m`p5þ Š6…:5.à̉‰c ¬Sä ž¬?‡ÙíºRde¢N™ ¼º ìp}IrcADx®‰­,ì°ÊÖIu@íØ `®Sì¯] `ƒû cEË}€jN™°rÇÂ1’Ü{òZÃŽI°övô‰àÔ rôÎ$_Rã˜új?×]v…:&½äØf6kÓ\íÁõ>³B]ÄöÛœ³&RÖœ&Àñî cÃø?íåÒ×qDá¿r—6"_õû˜™HÈa:YD£]b¥,Â…²ÉoOõ«†4Ü·O9£…™ñð›öLçTýíÏwÐ&Ñÿ.f%T^.7ÿÿyÈ0 ZZ¾ÿ 9Qô»þ×ëÖND–zãÈNDÉŸtèËÖÕ%ÏDIÖÚüŽ3eO£w9/z¢HÿîË.Í’#i¥÷²·\üLšFa£{C ï·Öa&]þL:íÉõ˜;}õæÝí½èXÎQX|c¹°ÇØõ EGò~~l—<“{ ©ÝÕ'}úZtªi:Ò—?TÈ»Íéwÿ~äŸÖ_àX¹ü]?Öƒ‘ÉP™å.ÿû•vgtÿýŒì÷3:R¸/Æ„=™~­¤¿Ÿ)sq²ùò_–7;a¿V2M°{°®UÔ«K*øF²Ðo•ð¬Åé¿À½Šyʸþ] ƒæ÷=Ägø¡Ÿ4Çí½›Hø÷6[¹¯óUÍCK‰¡¡É*³§˜{hÿçÿ>àBûÈàÒª“ûºÀBûÈÀz·ç€q¡…dpiRÊ„ m$ë´¢Á¯ß~õJ©œsš£¡­d ‹í:š6æ”):@«É@§¼»Ð/Å í'íé^xc,ˆ†–”Žnº;mçL+aRu)Û§´¦D¹ óž}ˆ¦D·@£—¶z…”¨Vw^¾s¦D³²ñjª¨S¢XÝwUXžSâVÙvMê›Èœ1©èÊ'ò¾ÔJñ¿BÿÛƳía{¢ âý‡£@˜`ãcj¤§€,‹˜_L®¡ž#BÆ,crÉõ¨2BÆ\crIv{Ä„`gìî²õífNƼcrIvÓ/ ‘u¹5s8& ÃK¶'@8f"ßð’î¶oj>¯»ˆ)Éð’ïcÐSjJYÞ…°¢Ê¬üò¬2ÿjÊ;WT™{5èùFÌ©2ïJÔ›¾3@eÎÕ¬×yyT™o5ís2+*&šÓ»-õó´{}ÿÓöþáEýÃöútÚê \ýÁ?·§Ó×TW/þs}užZ 3tœª”CVÉÄéÉäRÎZ€œ1E™\Ê!91M™\ÊÁx¤*3¦ê ×ÁŸÆ§‘„‘^œ'aÆŒex)›¹z¨+†èŒ‰ËðRcu+ðtÇf)JA8ŸÃýŽyÌðX<Ž=Ê祖…"—†ð~5¯g™ˆµ!¢Í+ªLÂÚÞøcªQ2kCd½‡KÚ‹¨µ!V †Q2ñjE˜´<«Ì¸RVÅ3ÍÛ=Ñ¥zÑ×ww7·ßo´ Pþ?NsÈ(L¸ñmp@Â…ÙÆäº ø„1á˜\ò>`0 “ŽÉ%ïtdÌ»®q²å\3¡i4¦Ãë>`ÛS(Lw £1 ™]Ò>:^è³²›Ã1ù‚—´7‘«Äùœç¡¤1%^×>aN«Õh¡“%ìmjßGœSeÖ°÷±ý„÷Bf` {Û < Êì«aÏ7bN•™WžƜÅ>`´L»¶èÕYÌ·¶¨Å>` fZ»µ³´?‡·OuòïOOç·|¤×?̓Ê`JŽSÔ>ˆ‰@ƒùÈäÚcJ2¸ÖFÆ´dr­ ,CÆ`jrëƒs¬Zs0çƒÊðÒ:‚…`0Q^ !Œ©Œà1g=‡c¾²µ פOGp‹iËðRÚÛE!X¡¶µì*d­LÃVÆ­¨2[!èT¦_í¾sªL½Ú)ÙU¦]í–g•ùVû ùÕJa1Ñb"yi³}Þ?ÞüõæÇû›_Çþ³:ï(/ŸŸ=Ò³ùy07ÇyZ3$$ &&“K3èì2&'“k5(1A™\«A#{“Ã$äV &÷ ÔÊå4Ÿ¸&+Ãé 1ÞÞÑÙäùë0e™ý²œIÙÎ;Íaæ² /›ÁQaÚƒo˜á‘Ž½ÌÁ™…g³Ó?í—4óv2ƒö»×*VìÁ7ìe›÷’_be ¶zèKÈü;ð2ýZ=8»¢ÊÔkõаù"êeεzÐnEÅlËz/³â¤žÿµÄüÓ0ýƧõµH;©Çàº(¤U B®Ye÷iL~ýoÞÝÞoz{Ò”÷í‰ÙžÌöíÕwåå«òôõéÔþ;½>?ä$Ÿ¡BÖ ÈÀ y&—F°éš9y&—FˆN#dHË3¹4‚öH‹EÈL&×FˆadŸò.çù¼!?ÏðÒtY¹nÔQÝDÈÓ3¼4BÒ‰áúž ]Ï ”J°Î‚pÈÚ3¼TBŠí×4jŽj›ã®zÑœUæ!-M9vI•9œÛµëix@•ùWë õÛ6‡ÊÔ«u³[QeÚÕ:ww•éVÛ Sã/¨˜g:ì4¸¾lƒ·7·üéO´\ßÝÝÜ~O ÀǺô×·?Œ‡ç •1Çç×&H.Ù—1™\wtLÆTdrÝ Ò1ó‘Éu7€ŽŒ)9Àm5Èœxôbžj3“áµ — ]¨ù¢š1A™]z öûAp*°ƒ˘§|ùëj¹Á¼>„c¾2<º=ÕàßµÐ×R6…cªU2 køÞYT™µl7ð€*³¯ö߈9Uf^+»¨«dÚµ"Ð˳Ê|kM ÌŠŠ™FDKÉð¼ ~¸¾Û~~Vz{4µ ú §þŽGM¯ò“ò–ùi05ÇiZ/`&¶ ó’ɵ¢CȘ›L®½<@Ö˜ŸL®½–´stÛ† 2ç«9o«1U^‹Árx{{¯VcÆ2¼6C8×UƒžÃ1qY†Ú 4ö ¸?<9æ/Ãk3èx<“î2j]Ô*õÌÃÖ i•áZæ`k†îàUæ_k†~#æWÁÈÜkÍàâ"mÌ»Ö v•áF&\k†Õæa fšÓ»Ñ4ÿæŽÐ3ÿå‚0ÿDL¿ñ‰-ý=’ÑsÉ5ý’¤óÉ5ýcDȘƒLn[°ÐÿˆÜÓŸ`C¿sœÃ1ÞÖ‚ÄÕªÅbV2¼¦¿!k8&'_ø¶œK1Â1GÞö‚¼È>+t´îy•¨Væaß –g•9ØÒ?¬v+ó¯¥ÿ¸sªÌ½¾äUæ]K³<«L¸žþ ¨ÃDóv4PýVø?Rä«íÛ«ïê£÷æqä0ïÆgµØOH8;L:&×ØÏH8;L<&—Øô‚ŒÉÇäûÙ€æß·Ô§€éñf)ÞÜŽiÈðšúcä×*ätÀÆddv ý„Â1'ù¢—Ð/ëӀǜæ¡ï05IÍä\Ï7 /”3›=¨¾Iaeíw¯³_be›éA´K¬ÌÀü.,rÏËìëÁ¿JS/S¯¿^žUæ\ ~µZ&{óîö~{Øž¶+jƒþ.zBÓ²Ÿ¢VB¿‰Ç!è1#·‚ ÌÉ®}Ð/ùŒY9Àµ²ÌËnuл‘ê@›œÓœÉ9Ø¥ ʾ9&iuT5St°K$¢1OÇݯ]Q6fë`—ùߪÆ>€Êd-ã¿k²ú9S¤^þCÿ "ïêìïºwsh9W`Ü„9S¤[É£ìjD"Õjü›UNG‘b%ü­R«J‰˜[1íÁ¿ ÿë·o·ÓW§Óç}ûyûLáþËöùôu‰Êü®ïèÕRåÑ/ôh~LÁ~‚ü©¿ŸþuÀÅôÜü i”ˆ)8À5ø¡#bp ~£Æ\ì`§Ý̸Ž¯T =`ŠN˜‘]s?ŒÜ×´Ÿ¦ùÀ—03»æ~ʃM±1Aǽ/Áï´ÿåå®×±DÑ_9¡‚«ã~?K€+0 CXÁîÜ€Q¦C*ñ·»úUCRîî]‰=âHkšgzí]Åì¼dc¢vÙ²k‰¢ãœ*3µ$¿ï_ââëÉW£?ª¸ƒŠÌkÑŸí*²®EÚEjײ?ì"5‰lkÙïw'Í"ÏZøÛ´ƒb‚e}êò[=Oÿë›Ï?Sì?Ô™ÿR €bÿ®V@ùIi‡K/ƒòšÞZt@Æl)%ǯ·,Œ©ÈàÒÎiŒÙÈàÒ©K¾cF2¸¶€Cfå×ñ?yÑIÑÅøŸ1;^{ Ž¬6ôç`çpÌR†—"ÈÊ3Ü/ᘭì@m«!¸S˜µ ¯;@Ÿ‚§Mà”PÛlΠû7©§ß¡S2 IËО*30Ø|FݧšVæÖNÉäà Á)™yX#8%S«§ ×è[¥+Eíù¼þþøßù?÷ÈïËÁß—¾Ì?R?³­j¿P„ÉÀuPÀà4¤à\— ,NCÞÈ%ÿµ¶§!™\ º‘tÊÓ çpÈÇœˆ !:‡<Ï; Yyc×E@3šFáŹ!7o÷½Ä¿µ¼d»„CŠÞàeHÁí²O -ù¯ú9_0œ–iXóŸ¸ÖÈ$,rŽ[¬ÌÀZ1nÒÏÈä+ùO÷Ëï¨2ñjþk·ƒÊ„+ño²ÙU•ÁTÓ%öi#{ÿcä/ùOUÇ¿ÁŸ‰Ç¿Áôc0ÿ3ÉxüLB&ãño1Yÿ³‘á¯ãß/âßbR2ûUü/Úbjò}·´xÒ„þ>gc†2»¦l÷Zç9V¨hKÿmL[™…-ýÍ6¦­ÌÁ:þ«îà +°§ß*æT™|-þƒÝdª“‰×ã7¨;™q-ÿí®UæZ™‚â«üoñ}óùÃåøzpÊvxÐeˆšÃ1M^ú€Ö¸Ï&e?‡cº²eœ*Ãg‡Ó@µ‚cÖ2¼,9µaÄÎó0 µ¥ 螇n^ Ifa]¬M[¬ÌÁ²DÝ· Vf`]R»óu0ËìkÝŽ*S¯UB_çP™r­Ü–Š¹¨ 4]ÔáBЃ¿VÁÏTc/¸?ëÛ_{zë~½!dLËqŽº!d½OÁŒÉÜRV#ëAƤdri„hºAÛ&ðóÁµ úªºLU¯1™\› i„ŒÙÈäÚÙ dLÈAvÚÁ¨0š Ä<ԼƬdv)ëxó0Ô2ÓÙÊkLN†×"èÁ5ÁíŽ9Ê÷¾AÎÏá‹“cª2¼.&íŠÀ]­Ëjµ«§ƒ!…ºt>©¿[¿Ì¯†‘Iœ;µë.¨2Ûjàw!hdòµÝÀíÛÈÄk»ÙžU¦\[ú˜» b®eUòì‡0­Žïe x:~º^;úÿ÷ÚßxS¸ÐŸÊ{õ_ÜÕ·æÂü*åUßX—å`07\ÊÁ¹áÍÑó“Ñ¥’ÁИ£Œ.õ` 0¦é·=!Úžƒôسws8f+Ã]8£îÕs¼§ÑdNÆŒer §Ú dÌZ6Á ¶Y2f.“©l?òê ÍMæt&÷güvqZ™€A¹3úq™W\™ÁÄ3D·?¯“ÉWš!ëÞ7ó&w2ïB 1!‡ýSp2íBy¡“ßseÆEmÏ4Âííœ ÙF‹êéè~½h‡_¿|úõ÷/´ \ß|¸\>þöËñ CÍpOÛ¿K?¼Þþîƒ9îéoÌÏ9Êçi›CNÀ°ì GoäÚ Yäéü¢ÖdÈÔ¹vƒEV¹ÊäZÉù±:8˜ç¸‡„½Áëî5ï%&çùLë!ooðº;䱘¨Hãý|õ¼7ÊîàŒe¸^Â!ƒoðº;x³ò½PáOåÛ‘ã*ó°nQûUæ`ݼÒ;ªÌ¿¶94±wX¦^[ân÷2íÚâ6Ð Ó­í nKÅ<ÓþÌ”;»f8þwÿÊý?^4½ÿ•ÊâU!ÌÈqŒ¶-˜[ÎÁ˜ ®}`<­’ɵl@Ș•L®}àv ˜™ƒÜú pdkêƒ4‡c‚2¼öAŠXLT†—>ÈúÙvÙó•%¨}`3V6ó–á‘æpÛçZ?§ ½­u°íƒ(Ó°õA ªÌÁÖf×2Qæ_탬wÑeîµBè“é‚*ó®BÚžU&\k„¸ƒb¢‘N§}ðáÓ'Šúëõé<.ÇÓñîÝûãîx¢Ô8~º^òö…^—Ÿ—×wôz~ ÌÈ~Š¾´üóqŽM˜‹[ÊÀf kÂtàÚ i™„9Àµ 4R2 “²ƒ[Ž<úΓ›³15»[‡N1G3gc‚vÝ ’f6íó’I˜¦ãî×BmÏÉ:Øu+èÓ‚YœXfk6gн»FÙ(`¼ÉzGÍ"ù‚Í'å`ÞREæµ­À™Mf‘u­Ì.Y³È¸Öz{R‘j¥hÌú—ºúgÖ]ð endstream endobj 7 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 8 0 obj<>stream H‰”—Oo7Åïú<*@Òbñ–Åž8$CŽç,消‚]hãE|Xí~ú-’Ý5 ¬j/Ò¨9z]Íæï½*k~¿ósqõþ³5¿½ÈÎÄ`\ŽKtÆ.˜ÌŸ¿]<ÒåúÑ[»äB«a‰éÛU—–âÄÕè–’ÄÕ\”ƒ q5„EÔ %,N\Î/(VýŸ6»xñ“uKKN.ÖËÒjÀ%Ëÿ›ÒĪR)‹¸˜–,–œ}|ýШÙ®ô¥¶@;Ku¼¾†©mÑ«k`q AZtP߈°èé–ÒZ Ã'•/Ö“a)¢,=¥ë¡Ç”néè)¸HO™¥z=¥“êqô˜âqô˜â=e롧±zÊ$Õãé1Aº§§Ç”T==¥•êñô”QúÏ«ã;óæÍÕýÛïŒ577?¾{k.~<Òõ£5`ŽÖÿNKÇÿÐsüjÀÖßÿ«—þ¤¹RýCûiMÕ­¨/ôŸÿº¸¼½»3æÉ\N¦~þDŸß\ߴϧËÓéy¡åç¶üÉ<Ÿ¾£åïŽÿ¼8/÷TÆËÚ@¨í•Û{r ´Z æ/¢¦›Ðtä¨ÊPÓOhÖ7R 5Ä&ý²ÎÅ¡fÔk Hp¾IÚïmJˆ’jšP%_.žèë²ÞŒ éæ ]¬)„øRW’-zÙH –…rqB7Û…<¡ë‚¸± ±ùš$RZBègÀYQr©±~=;’D%O¹ F’@¥d)µr_VœÀ)¿8q 8S¶dŽn}9²âHÙSëd= U!µžØa?]ÞîÉ¢»‡W³¾&ÿîf]¯~m_/ÒÇO{®‚m+ {xû-¨XcÙfãÅ£AÅË6'/c×u*æX¶™yo‚Sq·É°  ›¡C@,¢´Š?–®¦6Ow¾`ò¢²ŠCV.ÔçbH,1QZ$öfí^V-K«ÈdiêÿsXM.‹šsl6{ÇîÅ ¿¸)ÞºÁ¯{°#:E[·ø€Q?ÅZ3ytnßîühÍæÁææeÝè××$kNáÕ­~uEYSP}ô‘½~sújæÕé·NýaÇÕ½Š4¾WµõRpl”^…ÙY·úºCE{®Bí¬[=Ûq^xmgÝêì`û Žu›µ³“Ùⱈ®TØ¥«µ;Ï\2Æ$j«ð;kWsÏɽԖëVax>ÞÕÝ·Ö­Âñ¬]›÷Ý7œ˜taH2øˆk>;yæÐkë¼µ£:^µø´ò¼#:G]³øìÖæ«hÞæxk&oG&çH«._é@T‡àBÉñÂåïß6§Ë_wÞÞæÖÎ_Óoñf:涛u›_Góßß¾ÊÂ:àX¸ùüÚ`î ë˜cájô)…°;®NoSTëÈÛ„›Õ§­ .¾ ŠF€¬Ý¼Þò„щÚ:Y»y½çŒ QtΨÑyóú˜X›&±“O:*Y»¶òPº¶ i’JÌ‹ÝÚnñí¥9úh8X0ÆQ¥sä¥ð+y²èuÝè·³ ŠÎ×â@tŽ¶fô`G•ÎaÖ¾ ÆŽ¤ãËm%æ³Ñ~¥Îýtyû`Í|íçéâéòÁ|1tAnë“Ž»ížÍï1øa;›u̱nµ{ÒXW‡붶~Lwuuä±nkë£btðmº½­ìõÉ"‚¨­cµ›×—Íë=fY[‡"kW¯/›ÕC¦k¢Õg|Ì«Õ{G —=m—¬ÝÚú5³A4»< &µõÉ® ¢Ùç9ôZ[ïµ–9ðz[y¤:‡]·û5íÄ3Væ˜ëvã@t¸n÷a`÷eŽ´f÷èv_tˆQûˆél÷·wwÍÚŸ›±W¯ïWN§¯ Á³ùºëøE‡ßvÛîøvìtE‡ë6Ç·iÜ.},Ü,²BX 7Ïw8Fƒ›p7ýÕ/ªéÎ风DÖ¦Ýp)!›~’gÔñÈÒèiD6}Œ;Ò:*ù¬{Gï0:–;Ò:6YºY~YmEÕI8›å§4°|œc¯[þÚmí¨Î‘W-?[#Õ9ìºåãÀq¹nù÷ìoÝóÓ`n¨3À”j3ý8H°:ÈÈ틧Ýd׿?Ü“µŸ.oß™'0Onmõû]9®¶?œhN`u,n´(Ya{`u(²rŸ‚ÕÑÈÂ-¬Ó(ëˆdå–à5Ê:*7åŽÛÜHݹÈ&Xœ,ÞZöSêM¨’Åu²xíýs.,NI 6’:Vùü·î߆—ârå C–Å[øþ6ýN̶͓0èØ:ù‡-  ”¡ì„}XÍpOvÁ~äÜ0‡_ÏçGªsèõ<°ÃZç˜kyPp”2 ƒ-áâáeüôáîxø…úýo"áÚ¬Nç/=-¼ü»~Q¬ÉéÝjê ‘Æ#8Ÿ,Übíªö…u„²p ˆ´ŽO_¾ü{GYG)+×€°%ë8Ý„[>¤¸¡ÍK‘Åu´²xbáVÞ!îhë˜eí’¨AZÛMsCþ/+ë¸eZ6¸-x"•íœ,®Ã—Å[6Ä~F@Î7ÉoËß_#xQÖÏ!˜lXò¶Ç?È;ìç죂ï›àwªÃ¯…CY'GqV?‡^‡Ñ~Ž»„5ÈJoír5¼…^mUu°‘ëdÄðj<Üß>˜GóÔ’¡æ 8]>˜/æ‘–žöòÀë¸ÜŠ¨y€Öæ±z“,\ó €BW%ëÖ8( ° Ã’…k8PìDй ·4(nkèiªÄ"¢ Ã“Åë´àÃæ«Ôsb–y :JY¼N %·˜eÓ:Xùø·D@dq¿+®#–Åk"lóªÛÙíIdk"Ô9´ÙÖŽì„m\ áf4aÁž †²söDðÝ å°søÕDpÖ7&«Î±×ÆgG9ç kãâ(£Ž6¤~.£?çÁýáÞ<ÿe Ãs}CŸžÍÕédúžd‡Š:·;·¡s[_ÔaÈÂ5|.šæ=êPdéš9ªæ‚¨Ã‘¥k€×Iëܤ[ä­w·„ÞNóu\²vH„{pŠæ=éØdå:¤5dÊ:>ùÌ»D¡»NJe£¬œ©ËëùȲê$£Å-Ám#ãN‡™æl3AÈ~¬;`ryI õÎÑW3aëidÕ9ðR¢–A± sÔÕ¹k;Ô#.ƒ§æ+mõŠ²Y…›£¬ÊÔaœƒàîðñýñgó4 lŸ¹¦$¨³ÁOŸûðP¿ðäÚÌ@Ÿä*Thr-JÆq(d™gá ®8…° γp„T’Æ·³ŠÏ³t› ™U€²p „”×@ Éc”µUžµël˜Vñz¹[É*VÏâ5¢…sg­çãß·4Ñ":¹yÍ*dÏâu0(k,ìlu™D¶Ö÷ ²!–9[,l{¼ã[eŽÀ>¬ ND™ã¯ƒÁ Ì¡W@ìèÉ#W™ã®FBÉ%·vŽ¹:x ½ZùÔl€‹ó4g(áóÇwß&‚Ûy6˜[=<ŒM°è dá–+=»Â¨Ã’…["xÕü:4Yº%dEÍ:87áž[kõ½Ë€QžP‡(‹·H›·ÒøNf u¤²xnbw#u´òù¯‘À‰lF»³%:bY»%‚í}N'œD–!âڌ٠pŽÁ–uùÎ!X#!ýŸòrÙ¬X¢èðgF_©9ä;2%@². ÜMY0»u‡4ÓFbbÿ=‘Ï2‚ÌÜ1ꪲµ*û8Wìؼ}ÔãN‡·Q2K$PÛ§Á(™{5í¨2ñj$ØmW2Jæ\Ž“ÚŽgæTL6«ùïÿ6>Üà¡ÿòþîçŸúïñr<ñØ:¾É‘À?yáŸõ²2ÿzÌÈþõ% ’ßg'£ œ³€ç6Æ„àœä÷Û(LÉÎI ò(0';Ø)þć:Bx¿äñÊSeJטšƒîè ZÕ¡ªO¯ìI4ÝÆôH§i}‰oŠá£Ót-63uÜýÒR}âö½ ÁÅiézËŸÑ×kÂâq }- ¡µ^šX-ó0hÏÉèëÐ Óô2Zfáß-°2O-çô&– (òòÝvy½¸Â2ýˆwz­Ûžß]#Ó®¦AœóKk0ÝœËÝèwÇ…GþÝårÏe ×€œõGüÉ××k3ïÆ`J¶Ôj Úp}ýõÏÓ±ƒK5ÐcBvp­3²sK/hw|ÆœlàÚ Z0ª÷Ú›´Ó`bvv©}¿æe%y?GcvvtL§£v3ölLÑ~íK-°£*%·b[LÔÎε€ZªÛU&ji­šùŸÏŠì+!À£jK©W*ALnKyWAhÛð|ªZ‘t¥ôÐ^@E•ùß3p™VÆ4vÅã¹Ïá÷fþ>¾9î?þðËܾmàúîþáøÜŠÁü+1õúWÖ‰ß:ØñôüüÇí0óºÌ| 4¦ß@—©¯04æà@Gu¦=„ÆDìè\”m›Èñ/ús2&ã ;~‘H#dÌÈAæ¶b=BÆ´—Ë„ÒÑ"dÌÍ›FþTÛ²ñÕ‚+Ô3šÓå]yË•9”;É9³åz™€Áp5ì3zÉ•Ù¼>£K¶s`™{!ð"LÚX&^Hì´n;×’+ÓŽ´=£¥~Þ9s.¤S{¾¶ok€)=àÃÝåøT&}ýÛñû­þðz}9^Ïò»ŸŽ—ò{¿¯×ÿ”¬øýúÅâ¿ŒYÛÏVò"uk??/À˜´œÓÂFh¤{ÌÛÎiAéSw sMÐBÌÞŽvÚAëÔ¶b~>i¾¾ÌàÁæ¼ å#0{¦ð ç¼Á!dLâaEÎ ƒQÀ,`®VQ½Ò~¾ ¡Å%-Ü~˜™5-Èî¹2kZ$à¼2ûrSHÚÔt[Ü`™x5*ôþ)̺v¿;̸Á0ÝxìéQÁÃþøúz­±ðXÞþ[Jð?å×ó«š‹ÿ)æi?RNˆ¤zØ®‚0O8'„ëCk=k su sBD µ ÂtèœciÜ 1c;Úiujêa8 ÂÜ/¬ìœÝÚõ¸%ÌÜAÎ AÉžˆ¹;dÈ a-’=³wsDh[—æX¡½9",0Ä¢LÁÞîÿ(3°Dà¼2ýjD´ÝÏÌ©2ójDðdÚ•ˆ0j_×¢L¹®o8󈈘oÉZÿkD<õL¨‘Pá¥ÄÀôK¦bÿÒRboF«H˜‰œC {VÀ¯¿þ¹ c2r΀€ÜJ˜œ@%À˜Ž\‚²-Tp)ÍÙ˜’ƒíÒs=\ø?pÌÌétDºÁ5Q";‡czŽûÎ7Äç½ÏgJÂp¾}µïé8Ç Mæ ª=­ VÉ, ÚŸ^ÇÍa­’)l:Cò{¬Ì¿‘l»sªL¾í©“ö;ªÌò8gRš—‡I9Ø%¨7ct óå03<—ƒ¨Ì€Û%t\ùœ9O18fé€Vã+|NõBKs¨ú‡Ôó&ãe –n` m±2K (à´2ýJ7 J›ÍØËÜËÀ7w·o{™x¥h·=«L¹œ¦Ìs͹SÙ&ÀkÏ€ãõ–¦ÄÀÓ—·÷õýü˜“ý5 <0[=æã—4è«Îzw˜”]òÀZ™9Ð%4†Æììè’ !† i stÀ]`õuÖ÷€y:È¥1WÇý7áTÆj„Œù:È9 \» ó,B_£9éOb±_™‚¥¸6³–\™ÁÐíÏK2ýr$•âf’̼x9ˆqÿH¦]n‰#aÏ•GÚr7êØ·Ô¿¶››ù endstream endobj 9 0 obj<> endobj 10 0 obj<> endobj 11 0 obj<> endobj 12 0 obj<>stream xÚ„ÝÝŽ$×u¦á[©;¨øÖÚñ“€ @¶1À@¶Gø€à­é‘ Ñl£ÕXw?;»ã Œ™0ã@ÚKTÅ^YùîªÊüò]Á}{[Þöý-K¿íÇ[zÛoyôÛ±¼Õ:—¼Õž·£Þº··£ßÖcþ£c¼%ë˜ÿ÷ú–½–õíØÞªzoÇþ¼nÅ1‹±Ì‹Ïb=ÞÏ-×,o<‹­Þ5‹-ãm6œÅ¶½=Æ,öÌ/^ŸÅ>¿xî¼5¿ø¹ó1[<ž;?j{sɳǣŸOà³Çc>_Éì±/cö¨åYÍg#õ剳ÇÜsVó{MÍ{­³GÍ{Ïï!µ>«ùì¦f}ÌÇ–ùÔÌj›=fïÚ×Ù3õì±Îç3ýì±Í½ÒÏÛ>{ô³Ç>¿&ýì±OÞég£g~ö8ŽçùxöxŒ|9)³š¸Ò³Ç±ŒÙc>×u'ÏïyVóÐeîYÇ:¿×ŒgõyPdzÇ6¿‡¬ÏÛ<’YŸ=öùز>{ìóÄ={×qÌžóœ>«yž²>{<æ^YgÇ2ÏJ&ãYͯÉ|ëñ<™qVÛì1ÿSšl³åYÍšynëÑ“YæY˜Õ>{Ìçºc²Èü^fõüYÚž=Öùg{öXŸ?4Û³Ç6Ÿ»lÏÛü‘Èþì±Ïç$û³Ç>üü™šÕ1¿×ìÏy–³?{<ÖçOÜúÖË2Ïè¯~õþÛçïòöû÷ß}ÿéÃOŸ¿ùôáÃó'ù¿þ“þðŸŸûáoó¤½ÿþãþéûÿxþ˜?¿æ›¿ýLJ÷?|þô×?~ùÂßüøùýïüþ/y~ÍüÉš_óë_i3æwöe×·}ûRüáý_>~úó¿~üøç/_ñÏý÷¿|»=SÌÿómþ®xÇó—ųx<Y<‹ùst|Ùá»/×}3Ûß}üÏ÷ÿñßþúéõçû?üð¿ü¿üÛ‡Ÿßÿðáó¿þíûùh¿~áמ?ýû÷?>Iyœÿëý¿ÿÛÇ¿~~ÿ—O?|þá§?ýÓÇÿýáý?}ó¯ïÿó§øéÃo~üáO?ÍoøûOŸßÿîÇüó×ð›ÿóùç_ÿúÛù[éë£ÅªØûYÔã,zQDQŠVØ°mØ6lö¡°ó°ó°ó°ó°ó°ó8w«Ø»âPh±h±h±h±h±h±xð‹¿xð‹¿Ø9vιóØ®¢­ Þ><ácóà·³ÅØ…w;ïvÞí¼Ûy·ónçº -Ààp¸Üîw€;Ààp¸Üî·W1«bSìŠC¡¸Üîw€;Ààp¸Ü^Û¢ˆ¢<¸ nƒÛà6¸ nƒÛà6¸ nƒÛàv]…à6¸ nƒÛà6¸ nƒÛà6¸ nƒÛà6¸ îüS¢(E+†bUlŠ]q(´·ÁmpÜ·ÁmpÜùúJ¡¸n[à¸n[à¸n[à¸n;_I*´·À-p Ü·À-p Ü·À-p Ü·À-ps(‹"ŠR´b(VŦ؇ƒ·À-p Ü·À}¾´9 -À ¸7àÜ€pnÀ ¸7àÜ€pŸ¯cÏB pnÀ ¸7àÜ€pnÀ ¸7àÜ帊Cq¶XÀ]À]À]À]À]À]À]À]À]À ¸7àÜe½ -À]À]À]À]À]À]À]À]À]À]À]À]À]À]À]¢(-À]À]À]À]À]À]À]À]À]À]À]À]À]À]N¸ó¥ÍUlŠ]q(gqÂE¥hÅPØùaç‡vwwYì¼^…«««««««¿yð›7;ovÞì¼Ùy³ófç\…Ñ¢´(-J‹Ò¢´(-J‹²sÙ¹ìÜvn;·O¸ã8®b(VŦ؇âlq€{€{€{€{€{€{€{€{€{<ì<«àààààààààààààààÎwÙ -À=À=À=À=À=À=À=À=À=À=À=À=À=À=ÀÝ«(E+†bUlŠ]q(Î;¸;¸;¸;¸;¸;¸;¸;¸û¸ -ÀÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝÁÝsZ€»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»ƒ»íŠcQDQŠV ŪØ»âPØÜ Ü Ü Ü Ü Üm\…ànànànànànànànànànànànànànànàn¹ -ÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀÝÀ]÷«8g‹ÜÜÜÜÜÜÜÜÜÜÜÜÜ\±Æk ±Æ,´wwwwwwwwwwwwW¬1ÄC¬1 -À]Á]Á]Á]Á]Á]Á]Á]Á]Á]Á]Á]Ák ±ÆkŒîw€;Ààp¸Üîw€;ÀàpÅC¬1ijÐÜîw€;Ààp¸Üîw€;Àk ±Æk̇¬¸Üîw€;Ààp¸Üîw€+Öb!֘Ŧ؇âlÑà6¸ nƒÛà6¸ nƒÛà6¸b!ÖbYhnƒÛà6¸ nƒÛà6¸ nƒÛà6¸ýîwß¹Æk ¹Æ,ô@·ÑmtÝF·ÑmtÝF·ÑmtÝFW®1äC®1‹¡X›bWŠ³E¡[躅n¡[躅®\cÈ5†\cº…n¡[躅n¡[躅n¡[躅®\cÈ5†\c¸n[à¸n[à¸n[ฮ\cÈ5†\cÜ€pnÀ ¸7àÜ€pnÀ ¸r!×rpnÀ ¸7àÜ€pnÀ ¸7àÊ5†\cÈ5FÀ ¸7àÜ€pnÀ ¸7àÜ€+×r!טE¥hÅP¬ŠMagppppppåC®1®\cwwwwwwwwwwwww9á¶\cÈ5Æ•k,à.à.à.à.à.à.à.à.à.à.à.à.à.'Ü–k´\£å³8¾‹î,¢(E+†Âλw;ïvÞí|Øù°s_…­EkÑZ´­EkÑZ -†‡‡‡‡‡O¸-×h¹FË5ú±h±h±h±h±h±h±h±xð‹¿Ø9vŽcçnË5Z®ÑrYl ÜÜÜÜÜÜÜÜÜÜÜ\¹FË5Z®1 -À=À=À=À=À=À=À=À=À=À=À=À=À•k´\£å³8Z€{€{€{€{€{€{€{€{€{€{€{€+×h¹FË5f1<¸;¸;¸;¸;¸;¸;¸;¸;¸;¸;¸;¸r–k´\c¾êÖÜÜÜÜÜÜÜÜÜÜÜÜ\¹FË5Z®1‹M±+…àîàîàîàîàîàîàîàîàîàÊ5Z®ÑrY”ƒwwwwwwwwwwwW®Ñr–kÌB p7p7p7p7p7p7p7p7p7p7p7p7på-×h¹Æ,†bUlŠ]q(´wwwwwwwW®Ñr–kô î î î .¦Ù0͆i6Ì,ì î î î î ®\£å-ט…à®à2ošyÓÌ›fÞ4ó¦™7ͼiæM3ošyÓÌ›–k´\£å³(E+†bUlŠ]q(k;×ësGžëõ‰©Ï7}ªéc`Úúö\¯©}n|®×Çë> ÷÷¹^^€OèÏõ2HÔ.s‚ q®l‰Ëô8WÆ娰NΕ]sÉ5çJ­¹´ ~!Š¾DH:W*Öeb+ërȨ_çzÙo\µse×]ÚÉŽ•È!džë¥JÒÏ•Šy9žüËs½ìTÂè¹^^-ç•éJ &òRsÏõR™¹ÄçJ¾Liôiis¼/Åû\ Þ—œN7çç³éùñ§Ào àš8WÓ×$ƒI„s½†0ÌNœÃ†<®éC¦dÌ´˜R9×kbÇXÍ9÷c"è52t®×”¦s½Æ»Ì`™¼2ªf°Ì¨Ø¹^ufÛÎõš4°g(ï\¯!FS„çjÎðš‘4þh^Ôt§yÍs5Úy¥ž«¹Îk Ödì¹^£ÀFyÏÕð5ÃlÙжkCÓçzÍ›ò>WCã×À»ñôs½FõÍÓŸëu“·p#wNpŸw.8×ë¾nµp®×)Ü?Â="Îõº•†›Zœëu÷åp7·/q³·9W7¹nŽr®î[rÝÖÅZÎÕ i®ûÑœ«»Ñ\wÒqK÷rÇ÷ð9Ww/ºn^t®n]tÝvÉÝ’Îõºa”Û;«R]wºr_*wòrß-wÒ:×ëöbnýu®n_vÝÍ=ËÎõº£››¬ëu/:÷‰sw8·Ósó;·³;×ëöî¿w®nŸwÝ]ÐÏ;~Ùï»_ýêý7oë™X¼ÿýùo†xÿíÛòþ»·ÓÿÃû7ÿðþ»?½í׿.âË5ûϯÉý5Ûϯ©ûkÖŸ_Ó÷׌Ÿ_3î¯éŸ_³Þ_S?¿f»¿&?¿f¿¿fùù5Çí5_OâÿÍãþš—sûƒÐ¯áþ$ôËIÈýQè—£û³Ð/g!÷‡¡_CîOC¿œ†Ü‡~9ùzú—.z99n/ª—‘ÇýE/'¢–û‹^NDåþ¢×ß uÑˉ¨¾¿èåDÔ¸¿èåDÔzÑˉ¨íþ¢—Q÷'¢^NDÝŸˆ¼œˆº?y9}"òr"úþDäåDôý‰È럋û‘—Ñ_OÄø¥‹^ND¯÷½œˆÞî/z9½ß_ôr"ú¸½hy9ý¸¿èåDŒåþ¢—1rÑˉuÑˉ}Ñë+ˆû±¼œˆq"–—1îOÄòr"Æý‰X^Nĸ=§wû_.zÜ_ôr"Öåþ¢—±~=ë/]ôr"Öº¿èåD¬}ÑˉXÇýE¯/*×û‹^NĺÝ_ôr"Öýþ¢—±·/'b}Ü_ôr"¶åþ¢—±ÝŸˆãåDl÷'âx9Ûý‰8^NÄv"Ž—±ÝŸˆãõ}Æý‰8^NÄv"Ž—±}=Û/\´¿œˆíqÑˉؗû‹^NÄžû‹^NÄ^÷½œˆ½ï/z9û¸¿èåDìëýE/'bßî/z}ë¹ß_ôr"öû±½œˆýþDl/'â¸?Ûˉ8îOÄör"Žû±½œˆãþDl/'â¸?Ûˉ8¾žˆý—.z9ÇvÑˉ8öû‹^ӈ㿿èÿ ÇHÐ| endstream endobj 13 0 obj<>stream xÚ„—KŽG D¯’7èä'™™€ Àv Áö¼òƆÝá`·´q@‹žÊ©ŽÇb‘oc»Æ¶÷XË6 ×;lásæps\mx-\}„!sbÄ6\s¤'®k$JØ)”A¹ƒrÈØ9£¢ïßQù;ÇNÔÁy_Ô¿>N?÷Ƹ¹›ãVç™ÖÁê†:‰oÍ;ŠÇw»Ö¼›x £Ÿ #.h9PÓ'€Ìš\³Ã(ºV‡Q¹f‡Q«ªÃ¨¼­Ã·‚°õ«8ÂÖ<‡qa{¶‚°eWïp½®¾Ûa|Ý-8Fæ¾:Œ»b¸&êŽ_²o»ã°ÆKúòFQyõ仃Š£rãëFå};Œ»g!ŒñûÅ[>GsW?K›è×ÑwÌB8kì'£hØîpxÖÀ¶ÂO‡Ïˆˆ_n·9G$¶‡~qÀø=QyaŽV¢0HOT®êðjC:ŒÊ»:ŒÊ§_.Qùì£òí6*ßÞ ^ gop9½ATOë ®V­7ˆåeÿðU#£7ˆÉfô×™=u¼6ÖÞÒΑë9?T^½ÁBåê Èê *ï|ž»7X¨|zƒVÞÞ`¡òí âMàÂ{âÐÄc–õ·ãÐÄg}_½AŒx†ýáÃãüe ½9~|züöõÛ¿ýóøuœûø2 ­÷ý?~~|ù{<ûøñtþÝ©¡Mi¨r -‚BCIPj(Zr‚JCFÐÖÐ$èH(Ɉ«H2¦V"7SÚ‰,¦^RœwÔb*4•L¥¦‚©¥)gª4eLmMM¦Ž¤â2u5ÅnØÔ»a¦)vôÁn˜v#Ø Ón»aÚ`7L»ì†i7‚Ý0톳örã¾£Ø Ÿšb7Ü4Ån¸kŠÝðлá©)v×¦Ø /M±¾5Ånø‘”±®Ý0v#´Æn„vÃØÐn»Ú c7B»aìFh7ŒÝˆ§ßùŠÝˆ­)v#Ž¤&»WSìFNM±išb7Ò5ÅndhŠÝÈÔ»‘KSìFj7&»‘ÚÉn¤t£ÿ/'êjŠÝXSSìÆ2M±Ë5Ån¬—öŽb7VjŠÝXKSìÆ*M±kkŠÝXGR‡ÝXWSìFMM±ešb7Ê5Ån”vã°¥Ý8ìFi7»QÚÃn”vã°¥ÝØìFi76»±_nø;ŠÝئ)vc»¦Øšb7vjŠÝØKSìÆ.M±{kŠÝØGRÅnì«)vãh7ŠÝ8Úb7Žv£Ø£Ý(vãh7ŠÝ8Úb7Žv£Øór#ÞQìÆ9?§þ`£ôŽŽ endstream endobj 14 0 obj<>stream xÚ„’KŠ\I E·;ÈÐ?ŒÁ´gSØÞ€Gžtcðþ–*éÑ…¼“ÊxïÝ£RHG+×^ZµÂûç,Ù§ï’Ô¥§?Iö¯ô»>]¦;¶¬³z|¹M.–ŸÉe—™\—»“;+}rwÕîÜÝ«¢sWÖ‘Î]]';wm]é\3·&݇N0§¡IÖ±‰v‹r&Û=ªwC{÷¡ƒ¶e‰Åîƒ.ñí}°>Äéƒ/ ™pWŽœpÎ'Ü•³&Ü•K'Ü•k®Ú-ʱKW>ݼu ¹ÞaéÊ·{1éžvL8zV{Â9C›p-U™p·«9á»Ôt†ØW²½iOÖ­ÃýV½çijKÃÎsÐq'Ü•Ó'œ³† wåŠ Ïp÷„ïL¿Ã6ÃêÌd¦Öa›kw13›ÛvØÞ/0á˜æ&<Õ}Â5µ&üž›?w™÷Dm>{oÏ\–…ÌS¿ÞŸyWξ¥Íh²&Ü•K'œ£Ê„»ò™ÿ¾Œ]·•½ûùðýñãóãíתyúøñêu7§ )áT"¥œ ¤ŒSŽ”sÊ N)RÉ)Aª8µ‘:”rtãr7ÜÐÍÝðBŠ»á‰wÃ)î†;RO7üeH§©ä” UœÚHJÙEêr ÝÍ)tC„Sè†(§Ð 1N¡ÂÝ0tC¸†nwÃÐ ánº!Ü E7„»¡è†r7ÝЧñŠB7T9…n¨q ÝP纡Á)tC“S膧Р=”tC/§Ð ÛœB7Œ»!è†q7Ý0ÆÝtø‚nwCÐ ãnºaO7òµÑ »œB7|s ÝpáºáÊ)tÃSè†;§Ð N¡žœB7¼8…n8u#/ºá—SèFlN¡!œB7B9…n„q ÝçºO7ê…nDr ݈⺇R݈Ë)t#7§ÐN¡©œB7Ò8…n¤s ÝHîÆA7’»qÐänt#¹…n$w£ÐânºQÜB7êéÆyE¡eœB7Ê9…nTp ݨäºQÅ)t£¥ݨË)tãlN¡G8…nîF¢‡»‘èÆán$ºq¸‰nîF¢‡»‘èÆyáÆ_} ‘g endstream endobj 15 0 obj<>stream xÚ„˜ÍŽ\Ç …_…O0s‹?õb{ç "YZ(ñ 6,gIâ·Ù}XZ03µª§ÅsºnÕG²êÊèt‘ŒA¦>Lj×ôqQëL2/âÖ}lÄÃæÇ7å+SI%âŒtF\w›ˆs»q“ºFÜ¢qyܺh˜Ç­F³yÜbšÝã–Ðjçš5"Î|=&‘ƒZ“õ)¶±>GV&½.ÿàz5jb—`jzùÜ.ñ6)þhÖ"Ø­GpGŒ`wî#‚Ýyp»óðGUŸb›âÁͧO^Ý¢-õàæÎËç¢M‰/‹`óµº"¸Ç¢Eð æÁÓ?ô^ÄÂì?ÌâK¯ì+«âÁþ-k¬' ±‰ûB³­vç®Üc"؇E°;Ï+‚Ýyú–…/Ÿ‚Š;/ß´Û];å»vù¶i¬c“6ÿ0#¸ÇÆFðð+‚}‰E#x‘ÄŠjl¬úî©6óµQ_}1ß?Uwîþ”êK#}D°;Žà¨Dðn"8€˜¼bÇ=Øbƒc­ÅyðmAcMbe=øö´±ƒf±óŽ´óŽà0´?ãÁ± ;Ø[ü·kÔ»{twž¾Øêà Ä×æâݽsÌ°ê?è›×-¶©/êÃ!R_Ù>ã¹Fs¶#Æ{pÄ ¡¡·uÜo1FcxÌ7ß<þ‰¬ûô.úÛã÷yþôû‡?úÞ­Ç7þ£÷ÿxûøÓoþE#þúöÛTÍ¢Z×Y5ªªU½ªø¬²ª’³J«JÏ*©*;«¸ªúYÕªjœUWUÍ£J+ë̆6ä:³¡£ªÎlh¯ª3jUufCµªÎl¨TÕ™ 媺±!×kªVU㬺ªjU²ªjU•vU•ÖΪÊF㳪²Ñ䬪l4=«*ÍΪÊF;³!•vfC*íÌW6Ú™ ®lð™ ®lð™ ®lð™ ®lðöšª²ÁzVU6ØΪÊ÷³ª²Á㬪lð<ªZeƒ×YUÙ묪lH;«*ÂgUeCÎl´Ê†œÙh• 9³Ñ*rf£U6äÌF«lÈ™«²!g6®Ê†ÞÙà×T• mgUeCù¬ªl¨œU• Õ³ª²¡vVU6´ŸU• gUeCçIe«²¡ë¬ªlØuVU6¬U• 㳪²arVU6LϪʆÙYUÙ°~VU6,؈Kï+ªÊ†Í£jV6lU•~U•ÞΪÊF糪²Ñ嬪lt=«*ÝΪÊFïgUe£ŸÙ˜•~fcT6ú™QÙg6FecœÙ•qb#Þ!Ñëh|÷üéç§Oo¿üññéñíóÇ_Æ7ß?|þôîzðÕ½ÿ{ÿø×Ç?øãù?_ñÓ/¿þó·?}þLíáºyýøNï·áÛ˵ûØ1Œãº÷7·×j÷‘1 Føü ~?ƒŸÁ¯ßüÞßYò‘¿.Ï=|ž>>>>ó˜×À¼æ50¯y ø ø ø øMøMøMøMøMøMøMøMøMøMø-ø-ø-ø-ø-ø-ø-ø-ø-øÝû'Ù½ûúØ02FÁ¨ cÇ80NŒðkðkðkðkðkðkðkðkðkðkðcø1ü~ ?†ÃáÇðcø1ü~?ŸÀOà'ðø ü~?…ŸÂOá§ðC^ò†¼0ä…!/ yaÈ C^ò†¼0ä…!/ yaÈ ëðëðëðëðëðëðC~òÆü0ä‡!? ùaÈC~òÕŒP •”P‡ UœÐ„ÐÝ‹Ðû“Ðw ]›Ðó 'ÂyƒpZ!œu'%Â9‹pJ#œñ'DÂù’p:%œm 'c¹šp*'œé 7Â}‚p!Üe7!Â=Šp #Üá7@Âý‘pû$Ü] 7_½™pë&ÜÙ 7~ÂûÂÛ» ›Â{Â[–|ý˜/<òŠ•‡ºì#÷újY_?üããÓ­Ä~íß=ÿ÷ÉC_ìXcxâ Ñöõdyà«¿¿÷Œ]¨ßåÛÇ¿?úíó/OO_ÐVlsºAݤnTÁêÿ­ýa‘©¿s'ÿÎþþ;ÿwØ`—€]vØU`—]v!Ø•¥à¥éfå¶,Ý–µÛ²xÛ®Þ»|ïú½ ø®à»„ﾋø®â»Œï:¾ 9*ù‹ÓÍ¢YY4·LsË´ïâ—”å%û¯e¶ìÀ–-ز[6aË.lÙ†-û°¡¿8Ýì šAM<4ñPÙÅ<8ñÐÄCM<4ñÐÝ#v“Ø]b·‰;/MW²lIÖ-I<$ñÄCÖîM»9å'šxh⡉‡&šxh⡉‡ÞñxqºÙu$ÛŽ$’xHâ!‰‡ôÝkó‘I<$ñÄCI<$ñÄCÆ«©&yh<5Hâ!‰‡ìƒÃ>9ì£Ã׳Cþð>=ìãÃ>?ìÄ>A$’xˆ¾šjœ=³©qâÁ‰'œxpâÁk…öY(8ñÄCI<$ñÄC®WSóHÂy&áăN<8ñàăîûh—”xpâÁ‰'œxpâÁã…TûŸrægØ endstream endobj 16 0 obj<>stream xÚ|ÛM®ì¸•…Ñ©Ä ’܇ž@u Wõ Ï%éÅj¦:6ßM™¼¡X‚_|{}Úgìýé{^ÿ}>5ï??3ןOûìvýùôϹÿùɧ·û‚SŸžçŠñéã¹d~ú|®Y÷^÷O®M¿Ï5ç“þ\óý$÷5ßöɸ¯ùöOÖ}Í7Ÿœûšo}ò}®ŸêÏ5óSõ\³îßîþÉþÔz®¹~ßó\óýŒv]óüã\ÿ1[ÿŒÚ÷OòsÞ?©ëƒ=׌û7¸rÿá¹fÝŸ÷þÉþÌñ\s>s=×\·bß×ôëßûšÞ?«ß×ô|VÝ×ôú¬ñ\3>k=×ÌÏ:Ï5뾃÷Oög÷çšóÙõ\óýìû.Ï\wù¾Í3ý³ïû<“ϹïóL}NžkÆçŒçšù9ó¹fÝßÉý“ý9ßçšóùöçšïç{ßçYíó½ïó¬þùÞ÷yV>ßû>ϪÏ÷û\s}ƒ­?]_a«çªõ|Ï÷Ï®/±­çºs­ÎsÝ÷Óûs·G»VÏíýZ=÷{\FúsÃÇ…¤?w|\gôç–ëŒ<÷|¬‡Ðý³ëŒ_ú¹?ßÃZüûg×óù&ÖuÆz¾Šu±žïb_g¬çËØ×ëù6öuÆz¾Ž}±žïc_gìçû¸þÔ÷ý}üãýϮߠ®gõß·Ža1-–Ŷ8ßßâÂð[t‹Xعì\v.;—ËÎõìüß¿þõëÙà¯ÿýëÿþýÏþùuûù|}ñÝ"e1,¦Å²ØÇÂGj>Ró‘šÔ|¤æ#µùúëNOOOOiùHËGZ>Òò‘–´ì¼ì¼ì¼ì¼ì¼í¼ûë¯ÇÁxt<:ŽGÇ£ãÑñèxt<:ŽGÇ£ÿáñw¿n;¿ƒÛ9¿ƒ †GãáÑðhx4< ŽGÇ£ãÑÿðøÛ_w:x:†GãáÑðhx4< †GãáÑðhx´õú¨µîà8†GãáÑðhx4< †GãáÑðhx´z{Ô®ÿ×þsðµXÛâX|‹kÑ-bQÃÂÎ_;íüµ3 Öúë¯;<<<<<<<<}¤å#-;/;/;/;/;/;¯ýúëvwwÇÁqpÇÁqp;ÇαsÙ¹ì\v®·GíúËáïàs†Å´XÛâXü>x<ƒÇÁãàqð8xœï÷õמÆãàqð8x<ƒÇÁãàqð8x<g½>j§;¸;ƒÇÁãàqð8x<ƒÇÁãàqð8xœz}Ôöù¼O,ÊbXL‹e±-ŽÅïàÇÆcã±ñØxl<6ûûú¨íáàá`<6ÇÆcã±ñØxl<6ÇÆcã±×룶»ƒ»ƒñØxl<6ÇÆcã±ñØxl<6ÇÎ룶öïàëoÈÝ"e1,¦Å²ØÇÂÎx,< …Çú¾>j×ßí× ã±ðXx,< …ÇÂcá±ðXx,< µ^µÕÜŒÇÂcá±ðXx,< …ÇÂcá±ðXx,jÙ¿ƒ³cQÃbZ,‹mq,~à<‚GðÁ#çõQ3T†j#xà<‚GðÁ#xà<‚GðÈ|}Ô Õ†¡ÚÁ#xà<‚GðÁ#xà<Ò_5Cµa¨6:ŽGÇ£ãÑñèxt<:ŽGÇ£ãÑñèçõQ3T†j£ãÑñèxt<:ŽGÇ£ãÑñèxt<:>_5Cµa¨6:ŽGÇ£ãÑñèxt<:ŽGÇ£ãÑñèýõQ3T†j£áÑðhx4< †GãáÑðhx4< v^5Cµa¨6 †GãáÑðhx4< †GãáÑðhãíQ+Cµa¨6 †GãáÑðhx4< †GãáÑðh}¾þº¿¡ZªÕo¨v/ŽÅ÷·øñ¸Ý"e1,ì¼í¼í¼í¼í|ì|úë¯[.—ƒËÁåàrp9¸\vvvvvvoZª•¡Zý†j×ÿ²9¸9¸9¸9¸9¸9¸9¸ùHÍGjvîvîvîvîõúëþ†je¨VƒÇÁãàqð8x<ƒÇÁãàqð8xœýú¨ª•¡Z<ƒÇÁãàqð8x<ƒÇÁãàqÆë£f¨V†jµñØxl<ƒÇÁãàqð8x<ƒÇ鯚¡ZªÕÆcã±ñØxl<6ÇÆcã±ñØxl<6{¿>j†je¨VÇÆcã±ñØxl<6ÇÆcã±ñØxìñú¨ª•¡Z-< …ÇÂcã±ñØxl<6ÇÆcã±Ûë£f¨V†jµðXx,< …ÇÂcá±ðXx,< …ÇÚ¯š¡ZªÕÂcá±ðXx,< …ÇÂcá±ðXx,<k¼>j†je¨V‰ÇÄcâ1ñ˜xL< …ÇÂcá±ðXx¬öú¨ª•¡ZM<&‰ÇÄcâ1ñ˜xL<&‰ÇÄcâ1÷ë£f¨V†j5ñ˜xL<&‰ÇÄcâ1ñ˜xL<&‰Ç|­EÊP­ Õjà1ðx <ÇÀcà1ñ˜xL<&ùZ‹”¡ZªÕÀcà1ðx <ÇÀcà1ðx <ãµ)Cµ2T«ÇÀcà1ðx <ÇÀcà1ðx <Æk-R†je¨V…GáQx…GáQx…GáQx <ñZ‹”¡ZªUáQx…GáQx…GáQx…GáQxÔk-R†je¨V…GáQx…GáQx…GáQx…GáQ¯µHª•¡Zà<‚GðÁ#xà<‚Gð(<êµ)Cµ2T«à<‚GðÁ#xà<‚GðÁ#¯µHª•¡Zà<‚‡±¤ˆ%E,)bIKŠXRÄ’"–±¤ˆ•×Z¤ ÕÊP­:ŽGÇCŠXRÄ’"–±¤ˆ%E,)bIKŠXRÄ꯵Hª•¡Zu<:Ž‡±¤ˆ%E,)bIKŠXRÄ’"–±¤ˆÕ_k‘2T+Cµêxt<:)bIKŠXRÄ’"–±¤ˆ%E,)bI«¿Ö"e¨V†jÕðhx4<RÄ’"–±¤ˆ%E,)bIKŠXRÄ’"V{­EÊP­ ÕªáÑðhx4<¤ˆ%E,)bIKŠXRÄ’"–±¤ˆ%E¬öZ‹”¡ZªUãáÑðhxHKŠXRÄ’"–±¤ˆ%E,)bIKŠXíµ‰¡Z ÕòªÝ‹X”Å°˜Ëb[ ;íüµó×Î_;íüZ‹ÄP-†jù Õî…ƒ‡ƒ§ƒ§ƒ§ƒ§ƒ§ƒ§§§§§—_k‘ªÅP-¿¡Ú½ppwpwpwpwpwp;Çαsì;ÇίµH Õb¨–ƒÇÁãàqð"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜óZ‹ÄP-†j9x<)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆ9¯µH Õb¨–ƒÇÁãàqð"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜óZ‹ÄP-†jÙxl<6)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆÙ¯µH Õb¨–ÇÆcã±ñ"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜ýZ‹ÄP-†jÙxl<6)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆÙ¯µH Õb¨–…ÇÂcá±ð"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜õZ‹ÄP-†jYx,< )b¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆY¯µH Õb¨–…ÇÂcá±ð"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜õZ‹ÄP-†j™xL<&)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆ™¯µH Õb¨–‰ÇÄcâ1ñ"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜ùZ‹ÄP-†j™xL<&)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆ™¯µH Õb¨–ÇÀcà1ð"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜ñZ‹ÄP-†jx <)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆ¯µH Õb¨–ÇÀcà1ð"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜ñZ‹ÄP-†j)< £ð"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"FŠ˜z­Eb¨Cµ…GáQxH#EŒ1RÄH#EŒ1RÄH#EL½Ö"1T‹¡Z £ð(<¤ˆ‘"FŠ)b¤ˆ‘"FŠ)b¤ˆ‘"¦^k‘ªÅP-Á#xà!EŒ1RÄH#EŒ1RÄH#EŒ1y­Eb¨Cµx¿7Þï÷{ãýÞH#EŒ1RÄH#EŒ1RÄH#EL^k‘ªÅP-Þï÷{ãýÞx¿7RÄH#EŒ1RÄH#EŒ1RÄH“×Z$†j1T‹÷{ãýÞx¿7Þï1RÄH#EŒ1RÄH#EŒ1RÄô×Z$†j1T‹÷{ãýÞx¿7Þï1RÄH#EŒ1RÄH#EŒ1RÄô×Z$†j1T‹÷{ãýÞx¿7Þï1RÄH#EŒ1RÄH#EŒ1RÄô×Z$†j1T‹÷{ãýÞx¿7Þï1RÄH#EŒ1RÄH#EŒ1RÄ´×Z$†j1T‹÷{ãýÞx¿7Þï1RÄH#EŒ1RÄH#EŒ1RÄ´×Z¤ªuCµîýÞîýÞîýÞîýÞ.EŒ1RÄH#EŒ1RÄH#EŒ1íµé†jÝP­{¿·{¿·{¿·{¿·K»±K»±K»±K»±K»±_k‘n¨Ö Õº÷{»÷{»÷{»÷{»±K»±K»±K»±K»±Kû÷µé†jÝP­{¿·{¿·{¿·{¿·K»±K»±K»±K»±K»±_k‘n¨Ö Õº÷{»÷{»÷{»÷{»±K»±K»±K»±K»±Kûù»Zäÿ·) endstream endobj 17 0 obj<>stream xÚìšÁ®lµEÅ_Àµ«Êe[BH„̈ÌP‚Bò$ þ>v÷^-¡Ö==ŽÄྪûží:§kí>ÇÛ¯,µô1J}ÇY¼ŸßW鶟µŒºŸ­ÌóïÓJ«gÀôÒì6"J‹Û^Z¿É³Öù›½èº™ÅÚmÌ*fg̪ÅâŒY­Xž1ËŠÍ3fy±uÅÛmL/î·1y®îüÍ(ž·1ûzçmÌ*Q÷˜Üÿ¶ÿÈÚJø8c%ºûN¼Dî‚Y£ÄŒµ“½D­c'YzË3x”îvÏÒcžÁû£H߃ÛísÙƒ[;×´7;¿ìÁçÇúÜI”Œ–;ÙÿÜÇþíü2ü Ü3ç¾ïls¦q¯2lWNÛŸ²çl­Œn{ðþ¹?üÜ—2¦ïÁe¬u÷2[?ƒ³L?—`£Ìgð,óü‘¶v»vÒk™+ö`oeµýIä¾”e¹ïOdž–ôØÉØw꽬ngpîd#‘>Ê:k侂•»ççƒXûZ÷]Öì~îÛ-kÆ^yÿ¬¹{•±W^çwáÝö݈Œ~²sÕ±é¨í|æ1Nv.eÝ×v>ÄÝ”å^7µUßQöv²³p?ôÝ.µûáp¯ýÔ8SöS#×™qjŒqkÁÎf?3NegÆ®±/fÏصw¶YÏÜ5Z;=Í]£Ùþ¸2wæçJwkvvn#ÒZô3c×hÝÏŒ]£(2çÉN#óÔ§åãÔ§;ãÔ˜çJÇ©1ÇŒ­Ý®§ÆÚú:\7«{å?~ûü›ÛŒZ¾,; ’N’$ƒd’,%»}J‰‘°²³²³²³²³²³²ßVþöí‹­¦Ûo_½}ýå'ŸÜ/÷0q7V%i$Fâ$AÒI’dLn©rK•[ªÜRå–*·Tûååv w w w wn)¹¥ä–’[Jn)¹¥dådådådådåÁÊ£]^®QØ( <x ðà1Àc€Ç<x ðà1ÀcÜñxïrsªpÎI¢Â          <x ðw<Þ½ÜNáNaðHðHðHðHðHðHðHðHðHðHðHðHðHðȼ”Úy€ÜÇ…Á#Á#Á#Á#Á#Á#Á#Á#Á#Á#Á#Á#Á#Á#ýRjç á6î¼!($“D…;xtðèàÑÁ£ƒG<:xtðHðÈz)µÞ)Ü) <:xtðèàÑÁ£ƒG<:xtðèàÑÁ£ç¥Ôz£p£0xtðèàÑÁ£ƒG<:xtðèàÑÁ£ƒGî—R‹©ÂûEŒ¤“$É ™$*àààààààààëRjîÈK©E£p£0xxxxxxxxxxxxxx„_Jͧ û4' ’N’$ƒd’¨°ƒ‡ƒ‡ƒ‡ƒ‡ƒ‡ƒ‡ƒ‡¯K©yP8( ž—RóFáFaðpðpðpðpðpðpðpðpðpðpðpðpðpðp»”š ÞÛA’Fb$N$$IÉ$aeð0ð0ð0ð0ð°u)µ½Õ¸ 0xxxxxxxxxxxxxxX^JÍ……ÁÃÀÃÀÃÀÃÀÃÀÃÀÃÀÃÀÃÀÃÀÃÀÃÀÃÀÃìRjû}ø>nï+HT¸G <x4ðhàÑÀ£G <x´u)µýE§qAaðhàÑÀ£G <x4ðhàÑÀ£G­_Jmoˆ5®Q<x4ðhàÑÀ£G <x4ðhàÑÀ£G³K©Õ¡Âu$É ™$*\Á£‚G <*xTð¨àQÁ£‚Gº.¥VƒÂAað¨àQÁ£‚G <*xTð¨àQÁ£‚G µ_Jíø`÷q•ÂàQÁ£‚G <*xTð¨àQÁ£‚G <ª]Im{Ý5B±+¦âPœŠ÷ŠKX,Q±ÅKH,±ÄK8¬y¥¬åªª&–HXa‰ƒ% –(X‚`‰%–X`©ÿKí_êþêWBZUÕªª©óK_êûRÛ—º¾Ôô¥ž/µ|©ãK _ê÷R»—º½ÔìeWº™w¤ÌaŠ®Š]1‡âT¼W›êôT§§:=Õé©NOuzªÓs^É? ;LnX™êôT§§:=Õé©NOuzªÓSžêôT§§:=Õé©NÏ~¥ ì/Ü/™_;ªš:=Õé©NOuzªÓSžêôT§§:=Õé©NOuz¶+UàvavÉëÚÑ]1»b*Å©¨õÔé¡Nuz¨ÓCóJ˜[x[²¶vT5uz¨ÓCêôP§‡:=Ôé¡Nuz¨ÓCêôèWªÀËÂÊ’“uNUMêôP§‡:=Ôé¡Nuz¨ÓCêôP§G»RÖΕŒ«›û}MÑ]1»b*j=u:ÕéT§SNu:ç•*pª0ªäSÝÎ9îQÕÔéT§SNu:ÕéT§SNu:ÕéT§SÎX—ßwúÚ¹}UòÍ«/Ì{à¡¡ïø{ày§ÇÒ=ðx}<·y¦*úõ‹ / Š·-Þ„xÿÑkÛãå‘×8ÅÇË0o£Š¼6>ÞÀy¹Öž ^ï`Ø9(²Éxl›Ø)>¶ìç´ e[ûØÕ*²§}ìÒÙe+^{lr±@p@Ö ŽˆâÃ*ÂØQ|X_øS²Õ0ÜNv›b\{šx‰Šÿ“kTña'ãð*>ìqŒjŇÝ'ï®øâpƒCEŽ)œ‘(>†8êQäTèqΥȑ‡\œqqÄ5¯®Ž×ÞþÙ²5Ä8À7ÀUÂTÂrÄq”FM5iÔ¤QÓ¼IvyŽeÒ¨I£&š4jÒ(ÛvÿlþÙû³õgçÏÆŸ}?Û~výlúµçïê¤Q|l\™;ªŠ4jÒ¨I£&š4jÒ¨I£&š¾ÐMj´Ë#K“FM5iÔ¤Q“Fqz0zðy°ypy0yðx°xpx0xðwdï¼wuÒ(–Ž†üžó¿(UE5iÔ¤Q“FM5iÔ¤QÓ£Ú¤FWÏ “FM5iÔ¤Q“F1õðô°ôpô0ôðó°ópó0óðò°òää½wuÒ(îæÞž¬½UE5iÔ¤Q—F]uiÔ¥Q—F]OL—½^=+\uiÔ¥Q—F]ſžŽżŻźŹŸŷŶŵ•iûÞÕI£¹ø¸Ø¸rq‹K£.º4êÒ¨K£.º4êÒ¨K£®'¦KWÏ —F]uiÔ¥Q—F±êqê1êñé±éqé1éñè±èqè1èåÏ¿wuÒ(ž=–=Ž½ ûâÒ¨K£.º4êÒ¨K£.º4êÒ¨ë‰éR£«g…K£.º4êÒ¨K£œÊp(Ù G2œÈp Ãy Ç1œÆpÃYŒŽbÞ»:i”ãNg8œÑÙÌŽª"†4ÒhH£!†4ÒhH£¡'fHQ¯ž!†4ÒhH£!rÇùÇoœ¾qøÆÙGoœ¼qðƹÇn:u{ïê¤QNâ8ˆãNÇp;ªŠ4ÒhH£!†4ÒhH£!†ž˜!5F¼ÿ¬ø´è?:¼}öö×?ÿû»ŸÞ>?ÿßpÍû‡yÆþùí‹”ÛE<&õçIëå¤xš4ëËIþ<©½œdÏ“ìå¤ö<É_NªÏ“âÕ¤ûÑï'õ—“æó¤|9i-ú¢¿ûÍû÷{}ÿ[w=?RÓ^Nz~¤¦¿œôüHÍx9éù‘šýå¤çGjæËIÏÔ/'=?Rs¾œôüHÍõþ¤ÿ 0ÌàÂÒ endstream endobj 18 0 obj<>stream xÚìVËŽE ýAnùU®’¢H!ì@1Ù!…ˆ+MÂ"ÏqϬðL¼FêŨÜw|NûqÊî“ÍrűˆÇʼn}Ó\ƒ„'“LÇ)¤¼p*i0N#Ãéä4k’ƒp® é‰[’þ›Ö€ß´À97ÓvømÁûŽ[‰yÀsŒ•®N,3}'±j:±e4QÚJç sÞÍÓ &ž0ÀsÃóæÌQ2åÔbÉÐäY0|ŒÄ“³ˆ.%3"Á›ƒ•D‘e°‘Xƒ†ƒˆ æ#BTM&ž‚Áœé†€ùˆPÀ¼ pD)O!`ÞH7P[‘ÎŽÂ[:OR‘tR|ÔW5Òy“º:qÁY™tf`(±fC³qgd«KÓÌ{¤3˜÷D:dƒµ`L¤£›PxÀQã@:Æh»¿­ˆsh\'×Éurå]£P~˜ïñìÔ]£®TæTW*KŠ]W*k ª+•­Õ•ÊÞ‚êJåù<è_\)e endstream endobj 19 0 obj<>stream xÚì™Ën1 …_ÅOÀ$Ží8Bâ²¢ì  ¿Ô–oÏñ´+ÜÖk¤YTãNýqâCb‰9Í9IN½ž‹º.šÞˆ;ãÙ‰MñdÝñ4fÇSHXðTHL7È@Î'Y踓yðÐRp«‘ä¯N«#o1-0sø.—Pï#2•:÷H5+r'õa‘Œ"E"9ªD9ÞZ”+:u›øHcêS ””}*(/ Ê +ó6‰ÛÜ vo ëèôØTç;À!ˆí`Æ—½â¡PF•,Põ®°LïF¬ ¼CY ʨ’ ¿y‡ò^!Cy2”ʱ”¨’÷ ñ–—ÇÖŽÆ X±ï-’ ÁŒäIƒ5’Æ‘¼h–âhÀtÈñv(Úèm³ä±÷­ïMÑ%ÇÛáÉP^#’'Ië‘ì ËÁ[A3ȱ#‚mEÐÑ÷( m†K\ ê@K@>stream xÚì–Ín1 …_ÅOÀ$þIb !AÙQvˆ¢ WjaÁÛs<í Óz4‹*¹Sç:ö¹ñ¬9¨Ñš“L°,êm`uêæ´V#ÃÊ$}a’Ù±*)+V#…ÄZ2[CÌZ‹†@o9ÍÐñFÏ–ƒàœÉñ.øÞŽ@Wl<"z:¨³Fì¤.ÁHR<‚‘¥NH´†tuaÓ©$ä©O<öå‰3zƒò²†²sCÙq2o“¸IP äîÍqn$æ= €ì¼£¬ÐÁ1˜ñÍÞ…XB°+±BÕ»acPÆIØ@x‡²á Ž¢ñÀ'ïPÊ8 O†2CyÏ¡¼ÊxÊ‘¦ã$¼gÈFÒ 84@‚š„bDðÂfE°“È@0 *–NbHÓm3ôÀAÊ@#§•© 剡M}p¨n/Ò¦ì¤iF«´O¤2RpelàW!•H ­R¤*PGÕT÷NOR A´J mt…ò0(”'Zäø 3NŠÊêBù¾Ô5 lPŽÒºAyÏÐ`·†²9k!ˆêÛž!Ük U –DÙ¥1…/|06pºCÔ ªŽÙ6²Ù"ÊsEp89z /Z”-¾x´H ]-NŠ_€í°aŒ²ùø¾p¤‚@<1(=~¼=ÝÛèív¶½:]ÿxµ½@t{=Ýÿq¾½{¾½ùLŸž<¹ƒV†¬„f†F Ͳ ­Ò y I‚f+!ÎP/¡ž!.¡–!© •1KG¬ìˆù°#ž®/.¯Ïþ¾ºÜÎOW_/îžœ®N×ïÛ#¤~û÷a{½½üøûôëç]Ä»/_?}ûqysCýQ;´­CëÐú¯µžî¯8_ z{¿Ë½·n¼ %HJ(TÕÊ#U­„òHÕQBy¤ê,¡>stream xÚì™Án7 †_…O•H‘¢€ @šÞZ¤Aœ[ÑCÐiP· 8É!oß_çæ¹Àv†;«ï'GúGCÃk5Zs’œœzsœucZÞˆ»á܉máÌ$¼¯ ÉTœ ÆxW³ÜH:9|–;Ù€¼/²%´V£9 ·:ùÖYL¾Àïß&¸5_,¥Þy4êÜöЉ`Qv± Ei ÚlGªD„ƒé¾Ÿ&Ô§l冃÷  ïË‚˜ÄM‚pD+®-LÀØã€1ïD­c2X·^gbi›è‚(Tú =E4ƒ0bå Cc–;r˜µ0ṟ FŽ³ib›`äXû¶¤xiJÒB“%=já‰Èƒu,—…Þ"Ù&LFß„tD¾ ˆÚ& kQ&Lf܇ njـ€¸ká4vሢ½^ £ÏMŒƒDõƒ ‹×QT1b= 4¢LöÐÄDt¨ ‡qÈaÞ—ŒcU9f܇"‡M(rxÔ‚…KƒPÒ°@Crmá …Q{̾j· a±ö5LJÔbQ¬YU5!Õð Wã ÃVÈ1gûaˆ 0uºâ>ð0YX´AÊZ8bv²¾ÂM‡³§I8R&álýù÷¿·Ÿ?SÖN­SëÔ:µþ×Z/ë‡TÖ±Á·'ÞIJ2Å5å™’šš™5e™ÒšÒLYMLÍš’LyMq¦VMå—kk5•ß®­ö熫ÕÞàÜqµÚœ[®V{ƒsÏÕjopnºZí Î]W{Úç.vjZ§Ö©uì 3¿]çÞãõá/ûÇ÷ݙ߮Sk*¿]§ÕTÏÔ¬©ÜyM/)Ë×\5•;/o5•;/ï5•;/çšÊ—KMeoxí ËÞðÚ–½áµ7,{ÃkoXö†×ÞÐì ¯½¡tåO{ãÜÅN­SëÔ:µbÝÿ-ûqÕc÷ÇvÐÿr;ü endstream endobj 22 0 obj<>stream xÚì–ËŠ\G †_EOà.]« ŒÁqv ‰Éx²0ñàÓ0v~ûH:“MdZkÃènÕ´>IUú»tpLƒ8æ•ø\þ¯¹b1€ÐÂ@ ¾‹€)œ€€p:+ÈJgóxéìw:/0Iç s„ó05œ7ÂÂpÞËÂy3ìÄÍô[ó%Z„Ú$_2%á…sº _ʤ°P#9Fb‹âq0à ¾œ3 ϱ4 _nJb‘Ärk%±ýL¢t7(j÷?·¢xDb Ù­¬H( u+£ø¶H9 Ï¡+ Ïa’„ç°Ü‡o‹¦Ažce-ä9–Ažcc¾-Ú–„JÂÜšIL`<¢,ï_ÖB˜ãH‡[ÑKd–ЂŸ'°rì¶8ôrÙVžcfì9Vîƒ=ÇÎÓ`ϱWd„’Ð*ñ…[B„oUh!ìÊ꽡"Y½¸œ$«Ñì‡L·²o¨'á9,£øB=Ç Y 7TŽ®ªçعß lKBAGÖâ ÕaI¸hãˆÝZn¥6tƒRž†c^J† œQ|ƒ*Y‹1¨f?\ ztÕ<‡¥6|ƒ:% ϱðIʺvžcgþC³‘û˜†y.$ÃTÄd0J]ù᧲§úïË%ðüùåå!Û¿]^]~¹>~zûpùÉ{¹.¯=þÊ/î.o~¼¼~«/þ£¬R»§´P6zJ*…=Å•¢ž¢JqOa¥¤§F¥´£âÚ*”õÔªÔ쩪 [=Uµa»§ª6æ詪‰=Uµ1©§ª6æmmüp}|wÿx÷åëÃýåîúðáÝÓ^]®¿g.€ãõÇå×ËÏo¿^ÿùòäñæ¯~üûþógÀgãŒuÆ:c±¾ëX/‡¸ÿß rÜñóÆœ”:]{ªNW¡–â:]…{ªNW‘žªÓU´§êtë©:]eöT®²zªNWÙ=Uµ¡½6¸jC{mpÕ†öÚ ª íµAUÚkƒ¾ñTÞkƒ¾ñT~[ç-vÆ:c±ÎXÇ :ë JÇo7îÝY§+IOÕéJÚSuº’õT®4{ªNWZ=U§+í–²:]yôT®Œ=U§+SOUmp¯ «Úà^VµÁ½6¬jƒ{mXÕ÷Ú°ª îµaU|[ç-vÆ:c±¾ËXÿ 0±} ¨ endstream endobj 23 0 obj<>stream xÚì–ÍŽ\E …_ÅO[¶«ì*)ŠÂ“b‘Qˆhiy{N¹G,ð¨½aƒtsÇ·ÛŸªNW™Ù1»,üŸÄ,âÙaÌF¢sL²dBÚ·óTêm;ñp4Z8 g'ãpžd΋\¶ójä;/¦©ÛáçÜÎKiõí¼:­΃¸¿¶Cä_N, ÂÈŠX¨[„ìÊúhÛbâ!¶-8Û~HSX;»48û9¦çÕ‚@Ž5ƒ˜  ë&‹³°°:²k,XÏÖ ¿NÒûfyŒ¨«"cá$v‚fA ‡ó&9Ü7!È1£4-snBcE-XS,Aƒ´õ Ö ÂI9VC&i4-²`E4­µ(cs÷f›)ª°¶Ð©YÈárL9fTÁèŠ>tA#±xtÞRඔEv±MthIû&ðè]‚°¢zlwQ}wêÕc9»Å~täð¨.Ým9fDÈ1C9–lÛݯ»:¶b£´?Ú ÂipÔ‚ðã*®±hìP,hhhÃV¬¤>:oÂVDAûØÞðC‹ýÀë¸îª!‡‡6Ðþ˜r¬­lÁ+dº gXQ$`}¸’I¬^MC>È:tõòåñÍåñÃýãÝ—¯÷ÇÝåáÓ‡§OÞ\.?·žþ~9~<¾ÿõò×—'w¿}úõ÷?ï?&~Ñ^½B¬×W‘7úéxsüpyüãýÃñ4eÇ[Ô:â‹»ãÝ·ÇÛoÿPø‘$ÊkjfjÖ”gjÕ”%Š[MLqMõLIMi¦´¦$S½¦8S£¦²6¸ÔÆ>¤å5•µÁ³¦²6xÕTÖ†´šÊÚ®©¬ ¹­ÿò~Æ:c±ÎXÿ×X¯¯#ã¿NP™×3¾ß¸»zº]eµš’LqMq¦¤¦Z¦´¤teª×ÔÌÔ¨)ϔՔeÊkjdjÖTÖƪµ¡yòjµ64O^­Ö†æÉ«ÕÚÐg¦òZòÌT^kCž™Êokã<ÅÎXg¬3Öëz‚z¾]ýzÆës×óíêZSùvõ^SùvõQSùvu«©>stream xÚì–ÏŽ]5 Æ_ÅOГø_©ªe‚Šé±¨è*®4-‹¾=_|G°ðÕ˜e%Îb2ιþÙqòøtN:A°ðR7ÞÆ"fLx6⹟ÌN"Û3YšBªº %]áldO'oá<È=œ'Î ©¶3bLÞΫӌì‹iÉv^Bknç…¡Ix¬îpíþÃ5ÄügXÔe“†Hjm[}WåÛ‚³ïAšÀÚåJƒó° cJp^-äX3ˆIÜ,lN—Mtì÷Mô¾7l‰Å7Ñ…X÷ꕳ®xfĦáçÄÞ‚°b9F 9FDá}}ŒslEc·6Áȱ¢LQU+Ö‚¢‘;ˆk1 ¾A,i슱MŽY# ±X‹¬}‚¢%ÎÞ$C‚@ŽÙƒ@Ž9ƒ@ŽåA,Ò+À =êÐ+vC™”·“T¶šö ÊA¬„“Úbz¬ƒŽX½"LjÕã¸uÆyrÌX©«oÂcEl¶µP„A²mád×Sµ+êÀqk V¬囄®¼“é–Ï>nÓІ ^Ø $7ó Ã# ¦6b-Ž#ÎåÛõT9VhSÈt£ÃÚÊ,Ü{({9Ç 0u‰:†‘+vãåËãëËãûûÇ»OŸî»ËÇ÷OO^_.?µžþ~>~8¾{÷ùòק'·¿}øå÷?ï?~¤þ¢½zõÇúêú¢5úñx}|yüãÝÃñ-Þ,;Þ`¯?Üo¿9ÞüJ¶gÿR=S^S-S£¤pQ$jÖÔÌÔª©‘(o5å™ê5e™âšÒLIMI¦´¦²6¼ÖFËÚðZ-kÃKmìF•¨YSY¾j*kc´šÊÚÏkãÿpóœ±ÎXg¬3ÖùBÑ|ƒÊõŽïÏôÍÝUVMå¦rwÕ^S¹»*×Tî®*5•»«jIIî®j5•»«zMå¦²6´Ö†dmh­ ÉÚ°Z’µaµ6äÆWy­ ¹ñU^kCn|•?¯ó;c±ÎXg¬ë :ó Ê×;¾=sïŽÜ]™k*wW–šÊÝ•µ¦rwe«©Ü]Ùk*wW5•»+ÏšÊÝ•WMåî*­¦²6¤Ö†gmH­ ÏÚZžµ!µ6üÆWy­ ¿ñU^kó6äymœ·ØëŒõ…Äú[€«Ü" endstream endobj 25 0 obj<>stream xÚì—A\5 Ç¿Š?A_Çv,U• Ü@P±½!]AÕ-#mË¡ßÛ³ˆƒGkqæö­óÆ?Ûqþ“dT`’*¸åÿ7 Ï0 æôí4V1pc¢|C°vú,àÔf`‹8[@8=ðß œÎÃÙl gC°Î6Á4œG¦7Žî ˆ”þþ@K@çJ§%aQ¾¿[Ã]VT±Æ´$,%ñXÃsHÌwE}ÊIxŽMI¸³$<‡í$6ÌÁIxw0z°pxŸ0ÄèX>»IÌEAà‚ɘ»eILYùNݲôóÊÉzŽxoi„ͬÅKÓ’0 ZA¸3]F¾Î+»AˆGä98£ø¤I²òJÉzŽ\ÒEžcï$<‡IÞá üá] b¡[YËÆk bQÈ*¬˜´[ì–%!°X“PX²’Ø°t&á9ö?˽vVϞòzo§ – xdîÂC“pÍbFaq+Á <)‰íV®*0å<|úœÂ\‚.ü¬ÅÃ3§®Äs0áÓgImˆçì† ž“ðzâ9vÖ"žÃr=|(×UUt+µáÓLe+ÌT¶…RÙÊ !ï—/o/ïïï¾|}¸?î.Þ?½y}y¸<þ2^ xúûõøéøáÝ×Ë__ž<Þþñá·Þþ øb¼zuÆúϱ¾¹~Ùü|¼>~¼<~z÷p|ïûÆ:Þø*[~pw¼ýîxó;pŒþ¥¨RÜS³RÒSX)í©Q©ÝRÃ*e=µ …£§´RØSR©ÙS\)ꩪ ìµ1ª6°×ƨÚÀ^£j{mŒª lµ‡u¡¬§ª6æóÚ8w±3ÖëŒuƺîÖ«ì ¸¯{ü~f_Z©ÝSR)ë©rºúﱞZ•Âž¢JÍžš•¢žÂJ­ž•â–"«”ôTÕ†õÚ ª ëµAUÖkƒêÍkôÚ ·ò^tãVÞkƒnÜÊŸ×ƹ‹±ÎXg¬3ÖuÝõtÕë¯Ïì»»ž®Š=UOW-¥õtUê©zºêê©zº*÷T=]UzªÞ¼T{ªÞ¼t÷T½y©õTÕÆU»×†Vmì^Rµ±{mÈ[y¯ ¹q+ïµ!7nåÏkãÜÅÎXÿ»X 0.ð endstream endobj 26 0 obj<>stream xÚì–ËŽ\5†_ÅOc×ͶE‚°AÄd‡XDdQ&´4 ‹¼=U„Dµ¦VlÐYŒ§Nw}u±ÿv!ÓZoCæl°ðµ¡äÆnDxÕwqc4^‰ºóâ¦ìÎKš®øD›IøX³KÄYmõpÞm¾{ÛÃ÷hÛÜyãû>Ü{3¬éîePø+¬¨`ã‘8ˆ k…%ˆ Ë]´»³v·†÷ŸÁÅ|ÑŽ {SÅ-äXœw9ö b5ê¶gxŠˆ¼ ÷̉AØœÜH؉!|¥°vÖÈ,ˆÙhJÈ1£ú+ª'äØ^¤r쨀ç2œ †QH BaM¹6Íq’JVôGfbÊZÐ4‹8Á8èØN?\V—ƒ2rXìšf³ cF,¼¢FŽµ‚EŽ8Uåݤ»*‹Œá„ X~ÜŠ¦…Ì á&`‰>DaÅnˆAu3ˆÙÄ$ˆÕdRȱü¸Ñ9¡È±£z,ÐB|Éö¨ÇsVVTYb_ƒ˜°®QDŠÐ k9z=U°¢·z‘°Ã¢´¯º2ä˜=䘡 CŽ»äºfȱ# !S÷›VœÚ·ë©NnF¡ <‡²güø¨½|y|{y|ÿx÷åëÃýqwyøðþé“×—‡Ëã/ýEoO¿??¼ûzùëË“ÇÛ?>üöñÏûÏŸÛxÑ_½:cýob}s½pzûùx}üxyüôîáøޞǛ¸½ý‹»ãíwǛߛúÓ?”fJjJ2¥5Å™²š¢LÍš™Z5Õ3µK ãß”õšZ™553E5•µaµ6zÖ†ÕÚèYVk£gmX­žµaµ6zÖ†ÕÚèYö¼6Î[ìŒuÆ:c±®7¨æ”¯w¼>sïJž®>stream xÚì–ÍŽE …_ÅO.—«ì*)ŠaJ"&;Ä""#ˆ¸Ò$Yäísì;‚…£ëÔ‹éq÷õçS?§ËÍÓ”ñ4#Dø¿pélêÝoV#iÃ&Yž»:éÉKhŠ'¯AÚ"y’®HV2‰'(¼#gÑAmÚÍëìF{zòfâ¼g6õô-ÄÌž¿‘ÂÀ$î=üÐc¬Ûˆ%±q++ˆM<uá´AcŽåQÿç µx†›‘%Á¢Ôö‹6hìÄ¢ÞfX'¸a¥Ø f_3'¸SŸ‡²P¾ʃúä &¢„RW ¨Û‹ƒ€ÆŠÑwhìaašOK{G4} ]H8FŠÅÌߣIÒÙëuE¤Ó##‘¨Œ1öh“ _SŤe˜k4f¬V|›ACÅ50iÑå ñ+4l eñ {DަѺ›2Ø·B# 5Lzô˜J éNŒAØÀ &¢„Âv3£áB´hX ¶œ˜ÐXêÄ„Æ'`éÙØ Í£Çvc;|…æD´ƒUš=\!,ATYˆÂXØ9Ü ª ‘ú AhΨŒíž3öR¡á›‡j® ˜k€¼n®¡ÐXâ å/Ž*4®c†åád×ÀFÁ^¥ô:f,1¼àU /_—Þ>öüùñýåñýýãݧ/÷ÇÝåáÃû§'//—Ç_Ú³FO¿¯ŸÞ}¹|þô”ñö¿ýù÷ýÇÄÏÚ‹g­³Ö\ë»ë¡×èçãåñêòø×»‡ãGô~¼ñ÷#~¸;Þþp¼ù¦ßýKY¦¤¦4S£¦f¦fMLiMI¦¬¦z¦VMq¦vMµDq+)œÔ‰âšÊÞàÚ-{ƒko´ì ®½Ñ²7¸öFËÞàÚ-{ƒko´ì ¾íó;kµÎZg­ë :Ó º®G|¿qìÎÔ\—ÖPê­ËJh¤ÖºV ¥Îºv ¥Æº[ ¥¾º¹†R[ݽ†RWÝRC©©îQCÉ»vÄHŽØµ#FrÄ®!É»v„$GìÚòÏðÚòÏðÛž8­³ÖYë¬uÖºž + z=áùƱ»RSÕ]C©©Z«¡ÔTk(5Uë5”šªI ¥¦j£„,5U›5”šªi ¥¦jVCÉV;Â’#¬v„%G¬Ú–±jGXþð®aùûv„åïÛŽ8­ÿA­¯ ôýU endstream endobj 28 0 obj<>stream xÚì–ÏŽG Æ_¥ž€®òß* !r JP–[” +@Ùd¤¼}>׬rÀÒX9§Ûëž©ßg—û›rsk½ soˆð¶¡ÁjD¸±Ùw‰`4ž±vRÅ“›r,žÒ¬ïÅÚâAo/ö6y/žmÎÁjK‚Z½­¥Œ6º¿ðùè#"F¤!µp¡îa1mÕE¾`‹ 2"ÃÂERÞ{lG#‚¨Æî¼GnñµvDqa‹g({‡è®Ø#ù²­2uÙ,ú3F£#Šr} ôÌ‚Ôˆ%H‘PC­Mh#õMX#“Mx#ß•ä˜}È1=BŽ¥A@Š;A„hÆ.‰š, ¢»„Ó®” Q4Ñɳl½ÙX¢9)ÊŒ­±iGsX5ràé²ÈÁÈa»ŒQ$"äpxÂ<驉|­™‘cqäàÕ,”¥#Ú5£4*ð‚ YqAˆ š›Ð&b›0ØŽ7áMllb"Z›@¸"Ç ƒ¹"ÇÚ•ÂÒ²v°UíÌ¥C6¡M‰6aˆyuy¸<þÖŸõöô÷ûñËñúÝ·Ë×/O+Þ~üôÇŸßþÜƳþâÅ©ujýOµ^^ÞÞ~=^?_ÿz÷pü„3ãx?àýùÝñöÇã͇¦q÷/„sû{ˆjh&ˆkÈ$5d ÒÒY I‚¼†8A³†(A«†Æ÷õJŽ°Ú=9ÂjGôä«Ñ“#¬vDOŽ°Ú=9ÂjGôä»íˆóÐ:µN­SëÔº šPÞ绯§®¦‘ÊZCi¤²ÕP©ì5”F*Ï’4RyÕP©Òk(T5”FªP ¥‘*\CÉR;B’#¤v„$GHíIŽÚ’!µ#89BjGp~í¾íˆóÐ:µN­SëÔº 3 ãz¾Ï§îL#uÌJ#u¬J#•z ¥‘J£†ÒH%ª¡4R‰k(T’J#•´„>stream xÚì˜ËŠG †_¥žÀ-©¤º€18Î.!1±w! ‰É$ÆÎÂoŸ_:ÁGf´õ¢¦Gç´>]JW5ÃsŽFçœ þ®Æ&nì&‚sQë¤npëË}—45w^½Ywç¥mP8[+œâ…ól«‡ój›Ãy·½Üyã>©;m†µý¦_X=Âî°¶“Eƒ°Æ‚À…îÙX£À —ka{£ /h¹³ v —Áê°1¦[È1…Üò³»…K†[~Á:À‚ó6¿ B=âaØo,&XËYf,š9N¥w'¸7QvÉÑFÖÄF£ÉèAÌ&“ƒ@ŽX’Åȱ¢R)[ŒØ X;Êí­ótB´u”à–ÁŠêÑLÇ[VT€ÑvÕ 6¬ˆÒ1iS'Ð`¾8 ãíÃœ@€>£Žs+jÁˆ8äØrìÄnJ±·ÒrÉ•#ŠBOµ AE#n),—ÀRkª#ˆÝi³é ¬r\'hȱ¢CŽ«©¹–A´40mÆ„5 b@Ò!4m=ª·ÕL£zŒÖ4ª‡¶Íb—YT0c˜­Íˆ2c†"Ъ¹`!Çuª¸ØŽ>rìÄƳµLò§Ê Œvpwb ¬ÐZ«1ñôÉ_Çåùóã»ËÃû»‡7Ÿ>ßßo.÷Þ?~óêryø•žQ{üýíøùøñÝçË¿Ÿ=Þþùá÷¿þ¹ûø±ñ3zñâŒuÆ:c}S±^^7j¿¯ŽŸ.¿»?~ht¼Æ^3ãë7ÇÛï×4óOÿ3|ËpÍÐ-#%ƒá†é5³n­™yËXÍŒ[fÔŒÝ2³fô–Y5Óo™]3I\ ³j%pR×R $®µ@I \‹’¸V%5ðÓr8·ª3ÖëŒuƺn –ÓÇSa|±ƒö/¶]³LõšÒLiMõLYMI¦FMq¦fMQ¦VIéÎÔ®©t´¡šš™âšÊÚZšµ!µ64kCjmhÖ†ÔÚЬ ©µ¡YRkC³6äimœ»ØëŒuÆ:c]wÐvPÛ×=ÞžØw×ÎÔ¨©•©YSùß{ÕÔÈÔ®©|ºÕT>]‰k*Ÿ®$5•OWê5•OWҚʧ+ÕÚ˜ùÍ‹jmÌüæEµ6f~ó¢Z3¿yQ­ù•·òZó+oåOkã›Ü-þ`ÏëM endstream endobj 30 0 obj<>stream xÚì–KnG †¯Â¸‹ÅGÃ@âìØFä]… ‰%Èö·7É…aÐ µØ3üøhþSlÜKaîµÀ-ÿ¿e†a0§ßì=€‡@;|÷–pÞBá¼t¤³€îtV—Î 6¥óÃt6°Îæß oC@äp7÷@ËÏprúù-@MÜÊÔæÆ$–[×(Q;&an-'l¸‹N ËshÔoj‡å9VÔbÙ!'!OámÄE’X0ÇHb»%IøÂŒâe̵b<´À¼ÓIñ`2 S0 qË’P˜ªIxŽ•x scž#Û·é9l11æÄœ@8ƒ˜äV´o“n//Xõ++paʦ$<ÇÎ(þ°ÅRê9Ì’Øþ Ê©ªböáãV” ‚&oßåÄ"P |PJ©å??ö§ñòåñãåñãýãÝ—o÷ÇÝåáÓǧO^_.¿žþ~?Þ¿|øvùúåÉãý_ŸþøûßûÏŸ_ŒW¯ÎXg¬3ÖëÄúẀüz¼>Þ\ÿùðpüì'á>ÞùõúÅÝñþ§ãÝŸ@q÷E•²žš…Ú£§°RØS£R³¥|ŠzjWŠ{jUJzJ+¥=%•Z=Uµ±{m`ÕÆîµUÖk«6¬×VmX¯Qµa½6FÕ†ÝÖÆyŠ±ÎXg¬3Öõ•z‚êõŒ§ç®Ôíª³§êvUꩺ]•{ªnW•žªÛUµ§êvÕÕSu»ê]ÕZŠëv]£§ª6V¯ ®ÚX½6¸jcõÚàªÕkƒŸy+ïµÁϼ•÷Úàªu[ç)vÆ:c±ÎX×Ôê Ê×3~Þ8w­nW–žªÛ•µ¥vÝ®¼zªnWÞ=U·+[OÕí*£§êv쩺]eöTÝ®B=Uµ!½6vÕ†ôÚØUÒkcUmH¯Uµ!½6VÕ†ôÚXϼ•ßÐÆwì2 endstream endobj 31 0 obj<>stream xÚì–ÁŠ]7 †_EOcY²-C´é®% ìJ¡ÚÐi/L’EÞ>¿tºÐpµ.œÅxtÎÕ'Éö,ó^“ñ^‹`á¿îƦÞñ°­‘4uƒIÌ}­“w6¡!îlJ³…ó iá</œ™„³ÑæpÞä¼7~oÓ½7³ºû†Gg÷ßË÷†‹h¼·ðãŽ`*ŽäÛkŸAlâ‰(½¹ó\Í-äX]Ý‚ËÂDa!‡a°Ê,äØļ&‡µ0h¸B:X çîCcöE‹wp‘é~,ÔUœe„>4°vpž3äXœƒ@‹ :œwÌ£³ï‡½“pw¢ ¬í&(ãÖ ‘Ä$ÑÄ"¼ Â`Eõ}“̨^°Ós:+ȱ¢,Ž¬å„ ‡EA³ cKÈá» k‘¶˜&­m±I9jÁÂ*F·ÖpÎ*¾`MV¬†*©ö ¬ˆ‚IëˆZ9fì½îª"‡5'Hm91c'0 Ÿ4,ˆ–£ÈgpÌc =VÃPÄX4´a°,ˆMX4'0Œ)NL¦±¢zl÷XQýD‹ê±œÃb?&rì¨.Ã?"X ßÍ5ŠÁ EÌM“Õ l÷¼îêbš=æéOiN,µ üÔÐÕÂç§õòåñãåñãýãÝ—o÷ÇÝåáÓǧ7¯/—ÇßÚ‹FO¿o_>|»|ýòäñþ¯OüýïýçÏÄ/Ú«Wg¬3ÖëŒõ?Žõõ 6úõx}¼¹<þóááø'þ:ÞùÙ?Üï:ÞýIâOÿQ#SVSš©]S’(i5Õ3Å5Å™ê5Õ2%%…KL¢´¦,S£¦V¦fMemH­ ÎÚZœµ!µ68kCkmpÖ†ÖÚଠ­µÁYz[ç)vÆ:c±ÎX×t支g|»qîŽÜ]™k*wWî5•»+KMåîÊZS¹»ò¨©Ü]yÖTj*wW¶šÊÝ•wMemôZšµÑkmhÖF¯µ¡Y½Ö†>s+¯µ¡ÏÜÊkmè3·òÛÚ8O±3ÖëŒuƺž ; ºãŒŸûƹ»%SZS=S£¦8S³¦Z¦VIÙΔՔej×Tî®­ÕTî®k*w×Ök*w×VkÃòÍ«ÕÚ°|ójµ6,ß¼Z­ Ë7¯vCß^cE endstream endobj 32 0 obj<>stream xÚì–ÁŽE †_¥ž S®²]e)Š ›â‘UˆXiy{~»— ^Æg¤>l¯gÆßowÕßå}iëmôµš°ÿßúöÀmÿfãgõ”MmNõ`4¦áÁl¼=‰¢‘,M9’µ-ŠäÕ–Eòn[#Ùš±'[G­áÙFˆÌÓ‘J´<ßf£Á7š#iÄ=EÛj$Ѳ¡wÑ`ѼzyB2éê¡ÆrÔD„E„{Pcï PÃ8Ô0 bA”ƒØ‡.†‹8AH~!"D¾äë3É“i" Â…£’6„ƒÅE‡ëj¨ËZA Æ'|™l81° =:6{Üǘm’¯V¬Í1ƒlWBí V›,Aì6eamjtljt?QcE÷Xœ¹|?h¢ÆŽ€Í½ƒ@ cÚb5îÄFdA÷…e,¥G„(zA2O_0b -xÄy!ˆb5°`,#ÔÐC54zaÔX±(ÄÇ® jXl™ †¹ŸIf“î†öo‘4ÑP"<3VM ‡#ÄšHø "îkø Þwc¬'ËMŠ;º‡€ìè^Qâ{Ü X쇮¦=:€€úÈšR¨À*JáˆEM‡8­ÐcW×D÷ye Â?H½|yy}<ýýtysùáúøÇû‡Ëw¸ó}y‹~î.ï¾½¼ýئzõêjgÊnRß\?Ü?Þ}ùúp¹»>|úðôÍ›ëÃõñçþ¢·§¿_.?^¾ÿõú×—§Œw¿}úõ÷?ï?nô¢ŸZ§Ö©ujý¯µ^Ãõ_'(/tÿ÷¹ëÃ9Q«¦4S»¦$SVSœ¨ÝkjfŠjjdjÔejÖTÏ—Y¦¤¦²7ví ÊÞص7({c×Þ ì]{ƒ²7¬öeoXí ÊÞ°ÛÞ8O±SëÔ:µN­ãÕ|‚ÊqƯç®æ骽¦òtU*)ÉÓUGMå骳¦òtU®©<]Uj*OWÕšÊÓUWMå骻¦²7´ö†do¬Ú’½±jopöƪ½Áϼ•×ÞàgÞÊkoð3oå·½qžb§Ö©ujZÇ jùåãŒ×ç®åéʳ¦òte®©<]Yj*OWÖšÊÓ•WMåéÊ»¤vž®l5•§«ôšÊÓU¨¦²7¤öÆÎÞÚ;{Cnxão^`E endstream endobj 33 0 obj<>stream xÚì–ÍŽAÇ_…'° (¨ªÄ˜øqÓ¨q½F7j\dw=øö­dÎ&}ØYfšÐÔ¿¡ ‡BÂ1@ºÿŸ€mº±•Ì˜~YÝ@ ¿°ºÏdèÝ©ÙAÈý¦€¬pVÐÎFç “ÂyÁjáÎ -©¸·ÅG$w_ HÍýW7+ªXÈ„vbJT¼¬t‰’—×î5“åAÍ-Ë1ͲÓ£x"+0˱z–c­ ˜Gž¨±ÌòZìûŸë©h.ŒN ›å ´ ‚ ‰(^¤D-h9T‚µ¯ƒ#žå˜Í oîœNŸ‚8Av ƨÀn14fbw bšµ‚X`-uÂR²v'GToÍáÕ³å˜Q½¥äéçAl9VTÀ–cÍ ô¶G™f­ t;$³¬±=N•:š÷aνaÔMOµ˜ªz§ Ĭ„B ÂrHtÃ¥+a9FD±D}D-b9fœ‡‰«ï§* ÒBÖli+S-jjBîAØÁQ)÷!Ë’è†6 E(‚‰Î k¶ 6©å®lƒL ŸŒ¨ÞnPVT¯´Eõ–\[œ‡.PŒ L¶ê¢6 A)¢XråPÄ`³Ô kŽî§:Ä, uÿþöp<¼ÚoÏO×_ß]mO­k²½?n¿p±½~²½üáöàÁoŠ2¥5…™5Õ25ÏRN×.¯/n\]n§«Ï~ýòøtuº~ÓîYÀýïíöb{öîÇéûí/ן>¿ÿòíòæð^;b±ŽXG¬ÿ:ÖÃ}iÿ=AiŸñòï¹ëK?QZS3S£¦F¦fMi¦VMI¢¸ÕTÏÖTÞ®L5•·+sMåíʽ¦²6¸Öfmp­ ÌÚàZ˜µÁµ60kƒkm`ÖF¯µYý¼6Ž)vÄ:b±ŽXûÕãû™¹«y»¶USy»b«©¼]k*oW¤’’¼]‘k*oWì5•·+JMåíŠZSy»â¨©¬ ¬µ!YXkC²6¨Ö†dmP­ ¹ã­¼ÖF¿ã­¼ÖF¿ã­ü¼6Ž)vÄ:b±ŽXû]i‚òÚg<Ÿ™»kdŠjJ3Å5%™ê5Õ3%5řҚ¢LšÂLÍšj™Z%5óvm­¦òvmg´ñS€WŽ‰ endstream endobj 34 0 obj<>stream xÚì™ÍŽG …_¥ž€.—ªJBH„ì%(Ã.Ê…A ¹Ò@¼}Ž}'<Œ×‘zÁÅ÷v}öéªÓvK3Æ´ÖÛs6ÿ5ê˃ÝÈ‚…ËdPÓ×®ÑxøâÅMzü"Mf¬Ñ¦”5žgÍ6{,^m®X¼ÛR_¼{Ûì‹7¡hTÝÃËûòÍÈ|ý–FƒÐFLA¢Äl$¤«áÚ]3C™‹æŽÓUsG‰ûD„Ë0ÒZA Æ– Pcï f]‚Àõ 6"¿ &/éLØ¡áZB$“Äø˜ñd¡ˆVøªjØ5 0 -„Ó.,ö|5¶§â {;1¸A­¸AÔ BqH¡%yÄ}ŒÙ˜c7p4,Än¬žŠ¹#ÚN05¶é6‡§:Á¨±B=äbëã7ÔØ¡ÇÃ{;á‰P¹Òw» El¬ · !R'°X®&ðÇ} %#EZ Wtº‚@ ã PÃb7P€Š+²À“²B‹¢ÆŽó€ßõzª ×Rxª£ÂD«©'@´ñ„S5îÃQìJ-aÜt†¯`\ 5Ö 5¶1›õPo Q¨·ÝŒB=Ê(Îc¦PáæÆDĈ" 6Ç$1R=~¼¼>z½ýv¼:~¹Üz{wü„óÇk¨ä¸ps¼ùñxý¾Å·/þ£,S\Sš)©)É”ÖgÊjjdj>Iýp¹w{óåëÝíqs¹ûðîá—W—»ËýïýYoÿþ8~=~~ûõòÏ—‡oþúðçÇ¿o?nô¬Ÿ¹Î\g®3×ÿ:×ËëËÀ7³':èø~ßõ—‰DiMõLYIáe&Q³¦V¦VMÍLíšJÓ•W¯)ÍÕ”djÔgŠk*{cÕÞÙ«öÆÈÞXµ7({cÕÞ ìU{ƒ²7Ví ÊÞØO{ãìbg®3×™ëÌuí –;¨^{<=Ñw-OW]5•§«îšÊÓÕzMåéjTSyºÚ¨©<]KJót5©©<]Mk*OW³šÊÞ°Úš½aµ74{ÃjohöƬ½¡¼•×ÞÐGÞÊkoè#oåO{ãìbg®3×™ëÌÔÿ\öm•kïOôݧ«PMåé*£¦òt®©<]Ej*OWÑšÊÓU¬¦òt•YSyºÊú>õ¯Øgº endstream endobj 35 0 obj<>stream xÚì–ÍŽE …_ÅO.Ûåú‘¢H!Ù b²C,"2‚ˆ Wš„EÞžcßaƒgÆk¤^L»¯?ÛUuÚnÑ9¨‘èœdÝÿ/â¶ÜØÄC`,üÌà &™î»„TÜy)9£S×p6²À× [á3iŒ M8›»ón´–;o¦=Üy ²w÷ÞJÌ‘vwX;üXFƒX{“¸K¨¼ï PºM½5,¢/·˜xzѽ!Çœñ 9–†r,” 9¶WÐrìÄ$i×(¸p bÃ2'Îâ—ÎØ ñuôX;Áê{éû„ᲂÀ­iÈa+\F9fDñΨEcù)tËîOp Ío;¨ma¤<RªX“T£Y¤=Ö!Vì†6Rs teÒ¡N`st6'4ŽÚ ”‹c9vTsÅþdzIØÍð[°v°›°f‡ÅZœè +¢Àè k8£í±èÞ V¬Kí&A ‡E-8”>4äÛ $à„!ÇŒÝ0äXæ„!ÇŽ(Xªµ¨ÅB´ÁBµ×S5¼Ú@‘¦-ˆ ËEÝ!hó ,&³¨/‹XÇPX±ƒÍPÄ0‚@ŽÍA ÇÞA,m±ipTCÕO¦!Q=„„ƒqv*¬¨›3®âš Q^¾<^_ߪF?oŽ/÷Ÿ?Üßã¤÷ñµµøáæxÿöx÷;©ß½zõ/Õe­¤ðN'ŠkjeJjjfJkjdª×”eÊjªgj¯³‹±ÎXg¬3ÖµƒŽÜA۵ǯgúîÈӵ͚ÊÓµ­šÊÓµíšÊÓ•[MåéÊ\Syº²ÔTž®¬5•§+÷’²<]Ùj*kƒkmXÖ×Ú°¬ ®µaY\kÃù*¯µa|•×Ú°G¾ÊŸ×ÆÙÅÎXg¬3Ö+:¨µÔAe]{ü|ºïZKÓUv«©–)®¨¾w¦¤¦V¦´¦f¦zMLÙÓÔ? ]4® endstream endobj 36 0 obj<>stream xÚì™Án1 †_%OÀĉí$B‚r¢ÜD+@VjáÀÛóÛS.5­ÏHsèÖÝõg;Î?öJm<´ÔÒxŒ"l¿g¡:ÍX…´Á˜ø˜Ô *m˜ïl¥7sž½ôaΓ ww–ÂÓñÜyÝñYt¹Ï*CZµL¶8‹ÊjæŒÏ×2çÕQÆ0ïÅ…ˆÝ] 5Ï êÕk8ÂYœ@åÒ@\H+›E°ì$R[¡!jrL«ZàBsú{ȱØýc-gGi•=^¨:±`y‚s³!ô§©—NFP‡eç²Â›rÛU±¾Hw9d:e'C­b½bDCŽéQ\–×ÒcÙ5šÓ«]£4)-2KqYÕ‰k:1KïâÄ*½8w?Œt‚åÝ@sºš¤ÛM÷¹—Û'9s9K…«Wg®^}_…É«Gc¹ù}0Áò àÌÝ&Üayˆ‚¹9=ñpB ï·ÊÈ!~\ kw9ÔkA"FrŒede!ȱ¼htä„hÁ߃hÉk<ä÷"e¿UY§7N`„,Sµ MàÐ^D½`2üŠûÊtE(r,×0­Í‰…§Å”-xÒ”LÙ2¨hóêi÷êG‡åÕ£9Ê~C`!ÔãÇÛÓýq©åív¶½:]ÿxµ½€Jt{SìlöÁùöîùöæséöד')ŽÔÈ©©™S-R+§è.…QS5R”RUj95#ÕsjDŠsJ#%RÏN×—×ç?_]n秫¯·ïœ®N×ïë#4jÿù°½Þ^~ü}úõóÖãÝ—¯Ÿ¾ý¸¼¹)ô¨±ŽXG¬#ÖëéþååîûŒ×ûç®}ù TÏ©¸]çTÜ®Cr*nס9E‘9U#5Sª­H­œ ۵͚S#R”SQ3×F‹Ú˜¹6ZÔÆ̵Ѣ6f®µ1sm´¨™k£EṁµqL±#ÖëˆuÄÚ'èˆTö/Ì]ÛU4§âv•‘Sq»ÊÌ©¸]eåTÜ®Zs*nW¥œŠÛU[NÅíª=§âvUΩ¨ ͵!QškC¢64׆Dmh® ‰ÚÐ\òoå¹6äßÊÖÆ1ÅŽXG¬#ÖË'¨ýíîíûŒçûç®Ö¸]ûÊ©¸]¹æTÜ®L9·+·û©? Š­î endstream endobj 37 0 obj<>stream xÚì–ËnA E¥¾ ]¶Ëõ"’b D`¤‹ü=×î°Á$^#õ"Oívݱ›uôR ëE›ýŸ…ê4cê câkêfPáa¾“‹°9O)2Ìy¶Òĵ´éÎñÜ—;ÏÒ›;¯2_µÌj>‹ÊF-.K-ΔÁæ –¨º»Âšîß ±:0 ‰g^(¼yå •7TÄÁI{5‹ð4ÒÍâBƒØ,ä¨ rÌîr¬ær¬å÷FáÚÜ”eÖ‚et‚3Û¥úÃÅ AkAø¢± k:a NŒ½C°ìÒœ@Ž¾Œ`85‚‘cZ7:Ãeª93r,‚®JõZXaMg{?ÈÎÇ&NÌ"BN,XË©EZ7B¨ˆzh¬ì Nº{7HÆp9fs9;k91K«Ã‰Uyõhlc¯¾,½{Ô&~M`y rjìôÔ< 5e'¬érì§Ú£ûs #9†×IµiºêŠ«µ·åÚP-Z½8P­Ý ¨–ö(³({-º`ùyÓýT;Aæ® ´XÕdÝ»5éÁj°†È1¼< ŠwÂ~Þ ¤„~X4-†zŒT #ggÄ‚7ÍA7ýžÂB¨G¶'ûÏ –7Û³íÕéæÛûëíT'Û9ªlþÅÅvù|;ÿTÄ>=~ü‡š‘j95"¥9Õ#ÕsJ#5rªEjæ”DjåJkNQ¤(§j¤8¥fÔ†æÚ˜Qú°6žžn>^Ý\ü¼½¾Ú.N×_>ÞÝyvº>ݼ­g(~ÿ{·½Þ^¾¿=ýúyçqùùˇ¯ß¯~ü(tVXG¬#Öë¿Žõd)ú{‚ò>ãåþ¹k/U✊ە%§âvå–Sq»²æTÜ®Üs*nW9·+ÏœŠÛ•WJqÜ®Rs*jCrmpÔ†äÚਠɵÁQ’kƒ£6$×GmH® ŽÚ‡µqL±#ÖëˆuÄÚ'舴î3ž˜»#nת9·kí)Õãv­#§âv­3§âv­+§âv¥šSq»åTÜ®Ä9·+INEmP®µA¹6zÔåÚШ ʵ¡Q”kC£6(׆þã­üamSìˆuÄ:b±|‚Ž&(Í}ÆÓýswTÔÌ©©u?õ[€µŠ endstream endobj 38 0 obj<>stream xÚì–ÍŽ\E …_ÅO[¶Ë?%E‘BØ b²C,"2 Q&´4 ‹¼=.ß°Áh¼Fº‹éqwû;vU._RS@j2÷¾ƒ¨Çר;@ Û¹NÀ´“m'û„É™,0=“5ô29„W&;èÌä6vò`²“‚'¾VV_ Ë7(ÝBK‘3] 3ß"ò¢oÖ$¢ñ¹KÛ€²[·…8í¨ê;b@›sGQÃ)‰¨á+‰¨±, 3‰xÁ‘Ÿ­ˆvë†Ñ~1Œí¡ÝíÖ7Qª`|1) ‰È“ˆ·ÂID ñ$öbfë\*Y¶&û…¢†MP¤¸l‚¢ÆÚ%mŸÉÒ$x¤J”dÌ^È"ZÉzœŸ¥Þæ¹ Às‹cDkq$,¶ ŽƒÖì ÚeËupÔðÜ8vK"j,IÂaNbÁŒ#Œ(eÆFïaRvMNÎî'G”ÝÇ¡Ì™‹ža§™D“S( ‹èT‰ÊIDm§Ü¦yžªD ËuHÔpÙ„D•½D“si20‰ðìHoH˜s7¢IAKbPª&œ½(n—o6~*ržª2ˆ¤7 ¢œDÔHûX,PÌ“ˆžDIY¹] #w#ŽGG:ÂÓWa$¥t¶1(§³cs”ÓÙ&ñû ©çÏ—§½ür¼:~º=~zûpü~Çëè ó‹»ãÍ÷Çë÷i/^üCQ¥°§°RÔS£RÜQûç]¨ÙS^)é)«”ö”VÊzJ*å=5+µzªxƒÆè)ªöVŠzjTêio|w{|wÿx÷åëÃýqw{øðîÛ'¯n·Ç_dz<ÿ~;~>~|ûõö×—ooþøðûÇ?ï?|6.­KëÒº´þ×Z/χ­O;ïøñÄLæ:] {ªNW£žªÓÕ¸§êtµÙSuºšôT®¦=UŸ¼Ìzª>y™÷T}ò²ÕSÕÞ{ƒª7¼÷Uoxï ªÞðÞT½á½7¨zÃ{oPõ†?íë»´.­KëÒ:oP«7¨ä?×÷®Õé*³§êté©:]E{ªNW±–Ò:]Å{ªNWY=U§«ŽžªÓU±§êtUê©ê í½¡ÕÚ{C«7´÷†Vohï ­ÞÐÞR½¡½7¤zCŸöÆu‹]Z—Ö¥uiå ê£Þ |Þñþ_7èß Âmh endstream endobj 39 0 obj<>stream xÚì–ËŽTG †_ÅOÀ)_«JBHv‰”aeÂ(AÒÒ@¼}l7lâQ{tÓã™öçKù?åCs  9'¨Äï8VÐÈå_£…þ¾‹€)œÏp^Âé¬ +Í㥳Þé¼À$7ÌÎ{ÀÔpÞ Ãy, çÍ°wG¦ßêÖNÎÑ"Ôž€$ xÝLIxáì.´Æ”Ia! Fò剽- ‹§»¸å9âÜòK“ð›’˜@c$᎕Äö3‰Ò³lŠ…~<Å/ôŒÁ"»• !”„º•Q¢-å$<‡®$üÃ$ ÏaÙG¶¥A^Ëu+\4ò;R®hk[ <( sk&1ñeùü²ÚÀ³X<ÜŠY.F` -,Ÿ(+Á>hAx¹l+ Ï1³ö+û`ϱó4Øsì•Ä¡¤åä A(Ždy«B;a×PVïÉêÅå$Y½ˆæP–„‹¿±bjC7(åi8æ¥aÊÅTÉZŒA5çábÐëTÍsXjÃÔ)IxŽ”Àò”ºvžcgþ ÙÈ>&‚až† É01ŒRW~8Æ©ì©þ|¹ž??^^e;à×ãÕñóåñ㻇ãG*æñâ1ˆ/¯7Ç_/^|£¬R«§´R»§¤P2zŠ+…=E•¢žÂJqOJIGŵU(í©U)멪 ™=Uµ!«§ª6d÷TÕ†ŽžªÚP쩪 ½­.ïïï>y¸?î.ÞýÏ«ËÃåñ·ñÌpýùýøåøéÝ—Ë¿Ÿ¿z¼ýëÃÿsÿéà³qÆ:c±ÎXßu¬—×—¸ÿß x½ãç=)u»Ò詺] [Šëv%ꩺ]‰{ªnW’žªÛ•´§êv%멺]iöTÝ®´zªjƒzmpÕ÷ÚઠîµAUÜkƒª6¸×=ñVÞkƒžx+¿­ó;c±ÎXg¬ë :ë :®w¼Ý¸wgÝ®ƒ{ªn×!=U·ëОªÛuXOÕí:fOÕí:VKYÝ®c÷TÝ®8zªnWÄžªÚÀ^Vµ½6¬j{mXÕöÚ°'ÞÊ{mXÕöÚ°ª ¼­ó;c±ÎXße¬ÿ°ô- endstream endobj 40 0 obj<>stream xÚì–ÍŠG …_¥žÀ]Uú+18ö.!1ïB&“q.Œ…ß>Gu‡,FpµÉ&Ћ;£þùŽTêÓ¥žË´õ6—YC„ÿ«éxk"X¸LÁˆ?ñ›xP#ç¸1[Ò¤‡ÞÒ&BXÓÊ@UByy³ÊÞ‘3”}´5BÙg[ÊNÍç¾ÄÍ-(—6ºìSÚÆ }—¡Øy=Ê^‘ÏQ7EGƒ£rï£ #¢‰%!¢6T)"nÃhȱÆ&#ÊB„®›@…7›Çb`­Ãƒùµ{¬&G„›É‚8dêáfŽJ} +Bn‘µõCyF„CÝʘñŠ(Ý#ÇŒþIä˜t-Qjä@ç¨GrŸŠH#Ç´FךçBd‘…†2J£kÍh,q#‡îJ9,üë‚vŽ†G'aH^[­ã(rx˜ØQ¸ôp±‹5»²…–’FŽËÜÓÑäZ³NDáe‡¥„·2 —k͸ â¡‚G!ª›EãM Çš›@Ž0õt,PÜ‚€¥´sxd:⥈ :·Œm‡™4%TúòåñÝåñãýãÝ×o÷ÇÝåáÓǧ3o.—Ç_ú‹Þž~¿??|øvùûëÓïÿøôÛŸÝùÒÆ‹þê´^_MÞÛÏÇ›ãÇËãçÇ÷mÉñË”}þîxÿöx÷{£8úÂ;òÒZ ²²­Òy ÉsÈ{ q‚F Q‚f ÍQ q %GxéˆØ™ŸCZCÉn5”᫆’#Ük(9ûFMq¦n{â¿|¥O­SëÔ:µþ¯Z¯¯ßˆÏvP½îð|cjqªê5”†ªõJCÕF ¥¡j³„( U£JCÕ¸†ÒP5©¡4TMk( U³JŽ°Ú”aµ#(9bÕŽ äˆU;‚ò‡w툙?¼kGÌüá}Ûç¦ujZ§Ö©uÝ@-m rÝßéÆ®ki¤Ê¬¡4R…j(TáJ#U¤†ÒH­¡4RÅj(TY5”Fªx i©Úk(9BkGhr„ÖŽÐä­¡ÉZ;Bógwí͟ݵ#49Bo;âÜ´N­SëÔº©õïÂûY endstream endobj 41 0 obj<>stream xÚì˜ÍŠ\G …_¥žÀ]ú«0ÇÙ%$&ã]ÈÂÄCb2IÃØYøís¤;A+KCîbu÷ýŽTªÓ¥¢yÏÑzã=gC„ÿ«‘±»1/ /ò€šˆzÀMÖô@šªÓK›nñÀš©ë¬Ñlof!¸V›Ý<Ømš+ïÞ¹ò¦¶†+on›\b{ºòÖF]z¢¨qFÄ.¾g#Ѻ2‘•Äf“Þ{#ñˆ°ª¾=bD¨‘4ƒfþýé(×FìÌ@Ž{>c…;±¶ÂX‚ípç¤6¢±}r(܉ea;‚°6}ùòòÍõñÃýãÝç/÷—»ëÃÇOï¼¹>\î/z{úûåòãåû÷_®~zâÝïýã¯ûOŸ½è¯^}ÅZ¯/Zo?]Þ\~¸>þùþáòüzy‹öïß]Þ}{yû[õ/D ²ê %„-}ÍZ Z54´kh<‡´×%ˆjHÄ5$ ’JŽÐÚ=9BkGôä­³é94k(9BW %G计ä»íˆÿÃAsjZ§Ö©õ_.$šP:Îwº1I4TZ5”F*íJ#•{ ¥‘ÊTCi¤2×P©,%$i¤²ÖP©l5”F*JŽàÚ’Áµ#$9‚kGHr„ÔŽ|í®!ùÚ];Bòµû¶#ÎCëÔ:µN­Së8@W:@ã½ß8tgš¨T3y ÖLþÑ¢fòo5“¦©ÕL¦£fÒ,5“F骙4IwÍ$Pm„‘P;a$'Pm…‘¬@µF¾l×fù²]»aäËöm;œGÕ©uj}%Zÿ0]óóô endstream endobj 42 0 obj<>stream xÚì–ËŽ\E †_ÅOãKÙU%E‘’°AÄd‡XDdQZš„EÞÛ= ·ÆbÍYÌŸn¾Tý]eÁi€ 8'¸åÿr˜—+¾aH¾,†!ù‰ÀXé3@GPKAwÄY¦éì¯ø‚©é¼aQ8o„eá¼ 6‡ófØ3œ·a¦ßí•î D’þæÖN`ñH çÄ’ˆBˆ@#ª ¤hËÂb ó‡[žÃ¼_·<ÇÔ$<Ç’$<ÇÆ$<Ç^I,`Ô$|u(Ö€}(¢X± ¼; ‚xH4€•’P·vl#?›níôóS“õ++ðµñÀA°çØ…=Ƕ X¼i‚c!fêì#›^ILÎZbay'±AdØ“óÀ Ä÷yäjˆ»(!žC3J4mY‹xŽ)Éú#·Ô×Ý­•„?¶%±aàÂ#šv‹ÜÊ \6ƒ³!!« ü1'¡ní$ †Î$& I,““ð+«÷í+«Wϱ³z_N¬ (fî¢8“pÍæÒ‘š[© ,I,·rWuƒJöáí«ì Œ\øY‹‡WM]™çP ÂÛWKm˜ç°\ ¼NJÂsÌkϱ²ó;÷Ã_íº«“ÜJmxûF©ì)`œÊöW“Üä©`Ã+xùòxsyüxÿx÷õÛÃýqwyøôñé“·—‡Ëã/øáéï×ã§ã‡ß.}òxÿǧß>ÿuÿå Ð |õêŒõŸc½¾þØ~>Þ?^ÿüðp|ïûÆÇ»PM~qw¼ÿîx÷;P¼ýKI¥¤§¸R£§¨RÚSX)k)Ü•š=µ*µzjVj÷”Š±§´RÔSUÜk«6¸×Vmp¯ ¬Úà^XµÁ­6â².Ô쩪 ~^ç)vÆ:c±ÎX×Óz”T÷õŒ_ÏœñcVÊzÊ*5{J+µzjTj÷T½]{ªÞ®H=UoW䞪·+JKI½]qôT½]±×†ÔÉ {mH¼°×†ÔÉ {mH¼°×†Ü˜Ê{mÈ©üymœ§ØëŒuÆ:c]OÐUNP×3~>sî.ªÔî©r»ê–š»RÔSuòZÜSuòZÒSuòZ£§êäµ´§ê䵬§¤R³§ª6V¯Yµ±zm̪Ýkê6v¯ »1•÷Ú°Sy¯ »1•?¯ó;cýïbý#Àaa endstream endobj 43 0 obj<>stream xÚì–ÏŽ]5 Æ_%OГøOœHU¥¶ì@P1Ý!AÕ+MË¢oÏgß‘Xxt½bƒÎ¢©Ï=þÙNò}xØl½ñ0k°ðÿjCÉ݈Œ…×]Üýa,j¢î¼¸)»ó’¦+~Ñ6%|f›;(–ˆ³Úêá¼Û |÷¶‡;ïÑötçMmôáÞ›a™»#Êþ +*س â Ö •³±aÁ…©÷6D»[Ã÷¿!ÇôB¨#ÇĆa!‡©¸…‹ƒ@ŽÝƒ@Ž½‚X Aàx†W@Øùkø‘91¨O'7vbH#A(¬Äl4gÖÈ$ä°¨~ ÇŠê 9¶_2ÁŠ Î}8A +¢ ¡~‡AÄ‹ KìÙãņµø¦Eœ`\´l'ürÕå@Œ3NÃ7=gÈaÅ—µ0r¬,–¸Uâݤ»*‹Œá„ XÛ lZh:!Ü„£,"±QXq2¡: šL b51 9Vw&˵ŒÓn²£z,Ú£z…d{TëÖ÷¡ +*€,5–Ô`]£,ˆ<¡Örôz«sÀŠ}àºUʼn‰3jÁöu†®&rX9,´1‘cÅi ¹. 9vDÁ#dê~6`Å}`ûóz«ÆmRh“ã’-þø¨½|y¼¹<~¼¼ûúíáþ¸»<|úøôËÛËÃåñ—þ¢·§¿??|øvùûë“Çû?>ýöù¯û/_ÚxÑ_½:cýob½¾6œÞ~>Þ?^ÿüðp|}Žãt}}qw¼ÿîx÷{þô/¥™¢š’LqMq¦¤¦(SZS#S³¦z¦¬¤00µjjej×”%ÊzMemX­žµaµ6zÖ†ÕÚèYVk£gmX­žµaµ6zÖ†ÝÖÆÙÅÎXg¬3ÖëÚA5wP¹öx½Ñw%OWÑšÊÓUfMåé*VSyºÊª©<]e×Tž®Úk*OW5•§«RMåéª\SYZkƒ³6´Ögmh­ ÎÚÐZœµ¡µ68kCkmð3_å·µqv±3ÖëŒuƺvЕ;(]{¼Üè»+OWZ5•§+íšÊÓ•{MåéÊ£¤,OW¦šÊÓ•¹¦òte©©<]Yk*OWž5•µÁµ6,kƒkmXÖ×Ú°¬ ©µaÏ|•×Ú˜Ï|•×Ú˜Ï|•ßÖÆÙÅÎXÿY¬L®q endstream endobj 44 0 obj<>stream xÚì–ÍŽE Ç_ÅOöG¹Ê%E‘’pAÄæ†8DdQFÚ„CÞÛ³¯Æ'.¨[ëžñÏv¹þSmá5Ax-pËÿr˜Í ó¯q„A ñÀÆ04œM@%œmÀÄtV˜–Ζä'x§¤6lŒ8ak8oÂäÝ“p†û ¢ðßí•€1'1ÝZI, É"¶—.–Äà ñ<4<€[žC‡…å9¦/nyŽ¹ò3ϱ4ý<‡I²žcûâ–çØ–„£&áý! ‚Ð;EAEÏ‚ –؇è„ÐVJBÝÚILà9“XÀk$á9Œ’ð–Õ³çØY=û)`VϾ`œƒ°€çŽxÑšI¨7"£pžkëéQâdó0½Y #÷›_ˆçЬ%«;ñSƒç…IxŽ•Ýw1JÂsØ5Š/;k‘ ó<|yª2È­†x¢Á3ˆ!à¥áËœ„º•¸x†æ>Æ‚1³¾ŒÅIx Y‰9,Ä,ê9v¨Y|QÌM«k–²z?n¥¬^”³zo§rž‡®ÐvÆ3·V¼-ALt+1 TcûqÜz=Õé9fî÷¯s'á9VÖâáÕRWÓsØLÂsìÔÆô;»á’w™±È­ŒâÛŸ”µ,Éyþ8¯§ºü×7\/_o.ïï¾~{¸?î.Ÿ>>}òöòpyü_ <ýýzütüðáÛåï¯OïÿøôÛç¿î¿|z¯^±ÎXÿq¬××KáçãíñãåñÏÇ÷ñ+=Þù/Oò‹»ãýwÇ»ßâé_jUŠzjVŠ{J+%=5*5zJ*¥=Å•š=E•Z=…•²–ò—f¡vOUmp¯ ¬Úà^XµÁ½6°jƒ{m`Õ÷ÚÀª îµU|[ç-vÆ:c±ÎX×TË :öõŽç÷®R¥FOa¥´¥Æ®Ôì)«Ôê©U)ë©Y©ÝSõíŠØSõíŠÔSõíŠÜSõ튽6F¼°×ƨ“öÚ:ya¯ ©“öÚ:ya¯ ©“ÞÖÆy‹±ÎXg¬3Öõµúv]×;žnÜ»¦•Z=5*e=%•Ú=U'/Þª“—QOÕÉ˸¥V¼LzªN^6zªN^¦=Uµa½6VÕ†õÚXUÖkcUmX¯õÌTÞkc=3•÷ÚXÏLå·µqÞbÿƒXÿ0"“ endstream endobj 45 0 obj<>stream xÚì–ÁŽE †_¥ž ].Ûå*)Šá‚ˆÍ qˆÈ ¢liy{~{Vðj,ÎôakÝ=þlWÕ?ö0Ûl½1›5Xø¿épc·1Œ…»¸A-x&ê΋›²;/i³‡³¶¹Ây"^8[[Ϋ­ovÛâ>xÚÛ©MzdÝ£uwß +"li4(…5ƒ˜xa°¢t„"á 6,/CzÇvx¹…Šð°cÊt 9 .°Ã4äXïc÷ðCŽ½‚]mtx8b'¨ã¤È "?3'h´ÁÓ â6$*À†R k1Û˜3kÃ$äXr¬íÄ@ŽmN òëp·OQý`XQýÀ2ü&d(¬¨`øáPæÄzr–±±˜?ú¦ã:…‘Ccþ8Å FŽµø¦M‚PWDp^rì8 ßôžAì†öwXpJî'+î›–¸UnˆîñMÃRX;ˆ ÙYÖdFXÄb‚+NC‘c¹"D‘c»®‹öØ´B³äz˜Ò B›Ž¨‹rT¯+ªÇu«Ä}è†@˜ª~°2 VDÁaë ELä˜Ë Ðë­Nä°Ø®[—;jÁöu‡®æÆW‰œÀEÍÚ0j“â4|’9aÜæˆ(xœµ¾}.ï—/o/ïïï¾|}¸?î.Þ?½y}y¸<þÒ_ôöô÷ëñÓñû¯—¿¾Þ 7\?¸;Þ~w¼ù½‘?ýC¡qÿ›š½¦V¦¨¦,S£¦f¦¸¦4SRS’)­)ÎÔ¬©‘)«)ÊÔª©¬Yk£gmX­žµaµ6zÖ†ÕÚèYVk£gmX­žµa·µqv±3ÖëŒuƺvPÍT¢Ç}£ïjž®Â5•§«HMåé*ZSyºÊ,)ÉÓU¬¦òt•USyºÊ®©<]µ×Tž®J5•µ¡µ6$kCkmHÖ†ÖÚ¬ ­µ!Ïü*¯µÁYZkƒ³6ô¶6Î.vÆ:c±ÎX׺r׿nôÝ•§ë˜5•§ë°šÊÓu¬šÊÓuìšÊÓ•{MåéÊTSyºò¨©<]™KÊòte©©¬ ®µaY\kò6¸Ö†emp­ ËÚàZö̯òZö̯òÛÚ8»Øˆõ·(¾® endstream endobj 46 0 obj<>stream xÚì–Án7 †_…O%R”€ @’ÞZ´A[ÑCÐm· 8é!oߟ\=ÐX^s˜ƒÇœ]~$%ýKqˆMj4ÄŒ`áÿ"ÖîƦÞŒ…¯›¸Á4üEV'Qw^ƒt¸óš-œ•æ ç‰xál´F8/ÚΛörç݈›øG›am÷Ú˜ÕÁ=ˆ{$ÞKƒPâAàÌcaÄÒƒ@íbAl_mÈ¡(rL¯DrL$‡…&ârØ9–»ûeQo~Ø ÎrÃV±ÇcöMsEö1àA]†,ÔýKaE<©Ï„Q7 9k;ömNtöóp¢Ã™ý¡}ÀŠê;œ{Tߕƈê;ckØœ¨ Žv±ŸBépWä˜ñêÇ'ª9,Öዶr¬¨Å7v· ck‹¤µ 6¬Ø i$ÌNÊ(X´ô¨EɈóÀCâTUÖbBw„‘L 9¬+*€| ;'9vì8w'¢eו¢HìuJد &$=‚0BµA,XQ½nRê±ðpv2éŒ à¢Óœ˜Èae"‡…"&r, 9®§:‘cÇ:°üÙZVÔ‚ð“CWÆ°¦Xþì¡ °b7 ù9zøù ¢¼|y¼¹<~¼¼ûúíáþ¸»<|úøôÉÛËÃåñ·ö¢ÑÓßïÇ/ÇO¾]þýúäñþ¯O|þçþËâíÕ«3ÖëŒõ]Åz}íØ~=Þ?_ÿþðpüˆ»Žwä=Þ¿¸;Þÿp¼û“Øßþ§8S»¦Z¢¸•.¯DqM­Lõš²Lšš™’šÒLiMI¦fMLYMemp­ ÎÚàZœµÑkm´¬^k£emôZ-k£×ÚhYý¶6Î.vÆ:c±ÎXת©ƒŽ}íñóFßUÍT¯)ÉÔ¨©‘)©©ž)­)ÎÔ¬©–)+)Ù™Z5µ2µk*ß®­ÕT¾][­ É“W«µ!yòjµ6$O^­Ö†<3•×Úg¦òZ’'¯v[g;c±ÎXg¬kÝùvµk×}wåÛÕ´¦òíj³¦,SVSyò²USyò²]SyòZ­¦ò䵸¦òäµzMåÉkšÊÚXµ6,kcÕÚ°¬Ukò6V­ ËÚXµ6,kcÕÚ°g¦òÛÚø.»Å Ir endstream endobj 47 0 obj<>stream xÚì–ÁŽE †_ÅO.»\®*)Šá‚ˆÍ qˆÈ "FÚ„CÞžßî•8xµæú0=üw¹û˜Fú˜“`á{qc“È‚±ðwS7˜ºßŒ%¤ÃW§ÑÝy)Y çA¶ÂÙ/œ'­΋6‡ó¦½Üy7âfî½™˜ÕÝ·ÀÚñ[' ?%îÍÑ=`EêmÄÊALXg¯ƒØ°&kÈabn!‡yý†P<»º…Ók1¬—k{1IZ bÁA`ƒ8¢  ¯Å˜}ÓœÅJ¥›ÇãN¢Ý V’ÁA X;#1 9fT€%Èâ cùn˜ ÇžN{?œ8³_L:¬í„ÀaÜÔ{TïËר^&¬¨>ZËÁnXQAog"XÈaÅÛ;ÝÙ:rÌå„/:zj9V¬Ão·;jÁ¢µ 6¡YN ÉÊ. S&•Ø ,ZÅœÐNÚ# .ªQ‹XÑ,ZÏ®ê$´<ä˜r¬æ­ËÕl9vT€Ëh±ŽÑrìÆPX¡ˆ1hÈ éĤ¡-ˆk±iŒ¨—aQ½1¬¨íFyÎr̨ÂÄcr¬ˆ‚͆ºƒ@Ž½ƒXx‚¢«¶ Šrí†Rœ˜LhŒX>úéÄì„>ÙÙ(ìzxü»ñúõñííñãýãÝ—¯÷ÇÝíáÓǧ_ÞÞn¿´Wž>¿??|øzûçË“Çû?>ýöçß÷Ÿ?¿joÞ\±®XW¬+ÖÿˆõÍ9€ý|¼=~¼=þõááøÞß%Žw8_Ï?îŽ÷ßï~'ö»ÿ¨ž©US’©]Sœ(k5Õ2Å%…ž(©©•©^S3SZS–©QS#SVSYVkƒ³6¬ÖgmX­ ÎÚ˜µ68kcÖÚhY³ÖFËÚ˜/kã:Å®XW¬+ÖëAõ<ãû çîÈÓU¹¦òtU©©<]µ×Tž®ª5•§«ŽšÊÓU­¦òtÕYSyºê*)ÍÓUwMemŒZšµ1jmhÖƨµ¡Y£Ö†>óV^kCŸy+¯µ¡Ï¼•¿¬ë»b]±®XW¬óÝù•óŒ—Îݧ«hMåé*£¤Vž®b5•§«ÌšÊÓUVMåé*»¦òtí­¦òtí\Syºv©©¬^kcemôZ+k£×Ú˜Y½ÖÆÌÚèµ6fÖF¯µ1³6ú ÚøW€9d endstream endobj 48 0 obj<>stream xÚì—A\5 Ç¿Š?A_œ8±#U• Ü@P±½!]AÅÂHÛrè·çoÏH ä°ˆ2àbrì>ˆ]Õ¡$-æIKÛAlŽZ°°Ò]N* k:g. •+VC„ŽnMX“–µr¬Ø rÝUAsm(‰¹šu"Çv9+L܉ ÑrTùLŽyÌI³Çj`˜#&=•¦´ –± ‹æ†¹|Òº˜¦FõØî©QýB‹ê±œÓb?rì¨.s[ŠïÍ5ŠÁ E¬M‹Å l÷ºîª2­>o[±FsB¬¨á—„®_?A¨×¯o/ÏŸ¾|}z<.OŸ>ÞÞ¼½<]ži¯Ýþ~=~:~øðõòÏ—›Çû?>ýöçߟ?¿joÞœ±ÎXg¬3Öÿ8Ö7×K°ÑÏÇÛãÇËó_žŽïq‹®ãÎ}ŽŽ÷ßï~§xúš™Òš’LYMLíšê‰âVSœ)®©–©^Rhb5jÊ2%5¥™š5•µÁµ68kƒkmpÖ×Úଠ®µÁY½ÖgmôZœµÑ_ÖÆyŠ±ÎXg¬3Öõ]éÅoÿ8AÛ çîL·kß­¦,S\Sš©^S+S£¦f¦¤¦$S³¦F¦VMõLiMq¦¬¦²6v­ ÉW«µ!¹ójµ6$w^­Ö†ÜéÊkmÈ®¼Ö†ÜéÊ_ÖÆyŠ±ÎXg¬3ÖõÝùvÕ8ão?ñ;ß®:j*ß®*5•oW5•oW]%e¹óR­©Üy©ÕTî¼t×TÕTk*kÃjmXÖ†ÕÚ°¬ «µaYVkÃîtå/hã_fí¡ endstream endobj 49 0 obj<>stream xÚì–AŽ\G†¯Â ü (J²,9Î.Qbe¼‹²°â‘ce’–ÆηГM˜4ëHo1=t7PÔÿ çZ æZ „ã¿ cZ|bHÃÅæÔ0)Œ lá쎢é, œÎ ÓyÁÚél`šÎ6‡óž‹Â{£[;ÜÝq…ÿž€Älœ”„òHBÝÊŠ÷”,y{í¢ÉzñéÍQ×Ës¬ˆbÃsÄAÝò6),Ïa–„çØœ„çØ;‰48 ò¢ÃÚnIèòÃB·¢æý¡‰Aàt+£ qÖ‚$œ¬zw)â¡çЄçX+ Ïa„·‰6A~ #+lä9hÂÄè†Åi&!~]# ñ×°L–$üEf¦fõiV?=ÇÊê£9+îÃæ| e‰YžcçÛƶ$ðà$Ì­ÄvÅä9¼±ì­ ÝÊZÜ™gÊØå%„ÅÀLIˆ[Ù o %á9ôÅshÖžcå}x"¾ÞªxŽÚ0ñ;ôl2AFÚ¼a‚3 ¡¬ÀxŠ$ü‰˜Ù /R8!DRW@$tmŠ®ý¶¹ôd…²M=‡eõ@,«Wϱ³z? ì¼] #+ð:v3ŠKE1±”$¿ ½Þêšnå9<¼2&Ÿ‡zùòx}}†üt¼9~¸<þñþáøÎÕ´Ž·~êëwÇ»o·ãÝ«WÿPV)»I}syüpÿx÷åëÃýqwyøôáé“7—‡ËãÏãÅ€§¿_Žïß½üõåÉãÝoŸ~ýýÏûÏŸ_Œ3ÖëŒuÆú_Çz}]®ÿž "9Aí¿çn,çBiOi¥VOI¥¬§¸R»§f¡tôU { +E=5*5[ ëvU íµUÚk«6´×Vmh¯ ¬ÚÐ^Xµ±zm`Õƺ­sŠ±ÎXg¬3Öu‚j ó:ã×¹«u»ÎÝSu»òh)©Û•±§êveꩺ]yöTÝ®Ì=U·+KOÕíÊÚSu»òꩪ îµ!UÜkCª6¤×WmH¯ ~æWy¯ ~æWy¯ ~æWùmmœSìŒuÆ:c±®t× Jׯ7æî®Û•¨§êv¥ÙSu»÷TÝ®$=U·+iOÕíJ«¥¬nW²žªÛ•vOÕí:GOUmÌ^Vµ1{mXÕƼ¡¿£åà endstream endobj 50 0 obj<>stream xÚì–ÍŽE Ç_ÅO)Wù£,E‘B¸ bsC"²  #mÂ!oí^.xŸ‘ú°³îÿl—ëßåZ[¬­ LñŽ†Êtc˜(a LËoüCÂg/ jðŒ0›-DÓYA)7ì™Î6ÂÙ˜†³¡'åðöøˆ3ÜmÎþFnípqH+ ä¬Ø¼tÎ’-jš#ŠŽ°<‡F~žC}nyŽQÌaÔì–ç0JÂs˜%¡à¥$±½# s+j1ôù—ay‡¦æ p¹0$˜4“`˜œQ¼ÈÉY zád=‡®Œç9ö›;³ï6c8ˆéc1,Ì b˜ë˜ kJþ¸V ‹0 $KÂÀ[D¤ b!,Íê£9šÕ/ϱ³úE‡*Üâ§G[ñÃNBÆe»eIo’[ÞXÊ]5B·rîL ƒ ×ÓÊZ\UD3 vK“ žIxÎnø¦dròšQ<iÖžcç~¸¸èØU^À#µáÍæaI¸jQ’2%á/ÄÊ ¼H^¹6I²2€9!.º ¼Ù¬!lÏ¡¡lóä¼9‰x3²z_ [V/ 2²zO.#÷C ³—­ ¡23Š'—•ŠÐå–áÍ‘cW•ÝòP/_^^¯ç€Ÿ.o.?\ÿxÿpùΕH—·±ÖüáîòîÛËÛ€ñôêÕ?Ô¬÷VJzjTJoRß\?Ü?Þ}ùúp¹»>|úðôÍ›ëÃõñçñ¿\~¼|ÿþëõ¯/Oï~ûôëïÞþ øbœ±ÎXg¬3Öÿ:ÖëchÿûÇÏÿ}îÆÐ/÷Ô®”ô”VJ{J*µ{Š+e=E…ÂÑSuº"öT®8{ªNW\=Uµ½6°j{m`ÕöÚÀª ìµUØk«6°×VmÌÛÚ8O±3ÖëŒuÆ:NP)'(î㌧箬Jížš•²ž*ÓmôÔ¨¶[¥fOíJ­žÒJQOI¥¸§¸RÒSUÖkƒ«6¬×WmX¯ ®7¯ÑkƒŸ¹•÷Ú gnå½6è™[ùmmœ§ØëŒuÆ:c'¨ÕéªÇ¿nœ»V§«bOÕ骳§êtÕÕSuº*õT®Ê=U§«JOÕ›—jOÕ›—î–Úõæ¥ÖSUû†6þ`¥¤™ endstream endobj 51 0 obj<>stream xÚì–ÁŽE †_¥ž ]¶Ë®*)Š ›â‘D,Œ´ ‡¼=¿=ËoÆg¤>쬧ǟí.ÿm·ìi­7Ùs6þ5êËÝÈÆêÉÜ ÆÓ}.³;/i£Ç•ÑÆ mªAY3ö8k¶ÙÃyµ¹Ây·¥î¼{ÛâΛ4²nöôî¾¥™ûïш%m$„ÁZAÌFÂ@é:‚ðÚQ3Šë°P4,䘨rLÜ',äX¨r¬rìrxrX³qA,FbÃR'„‹ná„Øœ@‘,ä ¬éƃƒPX+k¬rØ5 rXÔBÈ1ÍYFŽ%‘c“Œ~†°¤I7'¼-4‚P4)*@JḞM$NÃ[3F»‰²‚£Óí„P›Nx{¦:!ȱ¢z”‹£kȱ£úhÏ vâ#*ˆrw» Š(~°8J·–®'gï*,èIâ>\àè–ŠZ¼\å CWøjrXœ†'š +r¬ˆMŽµ(rìèô®×®*TK¡ 4T¹‡ïÖj*ÄÆC@˜ªqF°â4Ð(µP„IÓº‚ðcȱVȱ-ˆÙ¬Gõ¶`Eõ¶›QTFE?&áaŠ P¸¡Õn ¬ˆ‚ñŠ˜ ¡^¾<^_½Þ~:Þ?\ÿ|ÿp|Óñ÷*ñÃÝñîÛãíoüÛ«WÿR–)®)Í”ÔÔÈÔ¨)É”ÖgÊnRß\?Ü?Þ}þòpÜ]>~xºòæòpyü¹¿èíéï—ãÇãû÷_.~òx÷ûÇ_ÿøëþÓ§F/úëŒuÆ:cý¯c½¾¾ üw‚êuÆóWçn¼L$jÔTÏ”–^fe5µ25k*oW]5•·«îšÊÛÕzMåíjTSy»×TÖ†ÕÚଠ«µÁYVkƒ²6¬ÖemX­ ÊÚ°Z”µa·µqN±3ÖëŒuƺNPËT®3žnÌ]ËÛUfMåí*«¦òv•]Sy»Ž^Sy»ª©¼]—”æí:¤¦òv£¦òvZSY£Ö†fmŒZšµ1jmhÖƨµ¡Ï¼•×ÚÐgÞÊkmè3oå·µqN±3ÖëŒuÆŠ J=OPºÎø~cîî¼]¹×TÞ®L5•·+sMåíÊRSy»ò¨©¼]Yk*oW¶šÊÛ•çש\JJ endstream endobj 52 0 obj<>stream xÚì™ÁŽG†_…'pPTdYrœ[¢ÄÊúå`Å+Çò:#­ƒß>À8—Å»œ#õagén> ªþ–fŽ½`À{ƒÌø¯€CÃ0ÀEnèÂíðU¦pVÞá¬~Åé, ‰ëÑôÙ°VR ›3Žb8ÛÕp6[áläÙgxb¦µé–¥¿ÒJ`òLbNJÂ+Ÿ–„—.Û Ã15,ÜQ4ϱwÞóÊéç9ÔKvËsXT€Ãs˜%±Æ5Šú^Œ$Ì- }üfX¾Aë@_1ìVÖ‚hRâ–&±€„“ð¢IxŽ5“ð;£øig-ä94NÉsØŒxäÇ0(_ ÇF¸%À¸“X~Z’Ä欀xæ:ÈÜÊÝà,¡d^„oïçQáå²JžÃ²z?W6?i·ü#OY¯Çè–ùGVš,/&IÄ‹¥²o»[îÌ9ŽÖ×–?˜¹§@0rLÿ܃8”E‘czе#G,uSä°5žF"ÒPüÒ0ïyPÓô Ñ®¨ÀT²4×e6/H(×!Â+´Ì( ‚¸cXä–±dí ¼pÙ3 Ï¡”„ç°‘„ç°„Â’„Á¬Þ¸0w|#ø"ƒu!-J•xøÅY©òâÔÆXÓ7çùóãåõ[5à·ãÕñËåþÓÛ»ã'ÿöèñÚW8òÁÍñæÇãõ{H·/þ£F¥¬¥|R¼ûvçÕåîrÿûxæÜõïã×ãç·_/ÿ|ùæñæ¯~üûöógÀgãŒuÆ:c±þ×±^^_2vБ=~Øã}7^R Å=E•š=U§ëžªÓu¬–¢:]Çî©:]‡öT®ÃzªNW=U§+bOUm`¯ ªÚÀ^Tµ½6¨j{mPÕöÚÀª ìµUø´6Î.vÆ:c±ÎX׺JÕk‹×'Úî*ÃUW•Ùª»‡ÊhUí¡2YÕz¨ V=Tæªa•±jÔCeª·”¡j³‡Š"¬W„EX¯)Š°^Ra½"¤(ÂzEÈw^Ã{IÈw^ßÖÄÙ¶ÎXg¬3Ö+;(ÒA×µÃïÇÛ.2T—õPª{tPüîóÂ*CuS•¡º¹‡ÊPÝóqè_ÎV‚ endstream endobj 53 0 obj<>stream xÚì–ÁŽU7 †_ÅOÀíØI$„Dé®E »ª TFuÚ+ °àíû;6cÍx]é,Fã{O¾ßNòûvN:A¦ñ7`ÛB0 KLâòŒ@IGЩKÏ!…À¡ÂsoÁ9ÉçÖY4,ðÕhjP‹iq,^BkÆâ¥QF¬^˜u/7bá½Þ­ bõM ðÞ7•G}ÒZì!jkLì£E$Ä£{DÈ1E"BŽ9,"äX²YäXØ2¢AX»U&"lÑ¡ôÐã8”‹ç#[Ç%‚2)‰Zä@áÒ[ä`C ì$Æ‘ƒ‘Ã}øþÍ«ëÝõþ÷ö gtüýqùíòëûoׯ_¾¯x÷ק?ÿþ÷öógâgíÔ:µN­Së­õòøÉò ÚÑßýñ®¿xBRCi¤šÖP©Ök(T³J#Õ¼†ÒHµQB’FªÍJ#ÕV ¥‘ê­†’#¼v„$GxíIŽðÚ’áµ#$9ÂkGHr„׎äÚgÓ:µN­SëÔ:èH TþnOt]O#U­†ÒHU¯¡4RuÔP©:k(T]5”Fjo5”FjçJ#µK ¥‘Úµ†’#zíKŽèµ#,9¢×Ž°äˆ^;Â’#zíKŽèµ#,ÿì~ÚgÓ:µN­SëÔÚ T[j |ô÷þx×Õ–F*ÏJ#•W ¥‘*­†ÒH~úO€¤ŸU endstream endobj 54 0 obj<>stream xÚì–ÍŽT9 …_%OÀíØI$„ÄÏŽƒ¦Ùf† Jj˜oϱo³ -:w;Ò]T·«n¾ãØ>•Tãn¥–ƽÿ? Uó`Ò‰`ÔÂÄPaS¸ ¤H'þøkà9¤ô\x@x¸òÅÄ•Ç,=g-}¸Î¤2ÌñÉe6§¦`ä«gC4c¹"‹õVˆ[½pØ¸Ì °óÖAH­¨¡ ¨ù¥r¡Žˆ££|DÈ14ä˜rÌëzá*ñt ¡2ѯFÈÛãU¡?ì»TÇ^ "),¾S¡†h¡› +¶†9TcrR"B3×CÜ!…9º¹ #ÇÀDÈ1ÐDÈ1} ÂZP•«°aXlG4ƒEDÀ°S÷ˆŠhuE‹v'“6uBf.A Lj¢2FÈ15X%¼%r›”æ®aÚxw"¹[¼7,zÕ°¤¹1¥á­’wÃËRó¼ÞÄ}ª ˜ Ï¡XÒ=y”Õ£/>Ú}¾.5«çðfÏè$ÊÒR˜¶ÆÌ®%§£(ÇôQ–ºš`(*ᣢ-fd\TÃ&EÍ .ð´ZxßírŒp JÐIA Ç ¿Ø,V£C½£hjì˜Ú8úÒ_¦ðxoÅày¾woO÷¯A-mÏ·W—ÛÏoo¶—ðäö¶øüj{ób{ý¾¿{òä'4$k¨'¨­!K®!M­¡– ¾†$Ac q‚æ¢ûÔ5TDKh$GÈÚ#9BvijËí»ëÛ«oßo®·«ËÍÇwwŸ<¿Ü\nÿ®°óýõÏöçöÇÛï—ÿ¾Ý­xóáã¿Ÿ¾\ýZèQ=µN­SëÔú_k=ÝÝ;@÷ã]~èúϨ{ ­™|¡®™tŸÊšI×i[3é6Õ5“.S[3é.ík&]¥cÉpºIçšI> µ8aíNN µ8YÖ^àäZ›“híNn ‡ípU§Ö©ujZûÚÓªs¿´ø—T§þzòöt§Z­‡ÀšA:ÚÌ GåØ3Ø–A=jíØ2Ø’ÁqÌ?Äê!çXvrŽeçÐ!çhvrŽfçÐ!çhvrŽfçÐÒ9çÁwjZ§Ö©‡h«éÕ±Ÿ÷ôàéÛªfP-ƒíAð‡á›ò endstream endobj 55 0 obj<>stream xÚì˜Ao7 „ÿŠ~AV¢DR‚izkÑunEAc¤Aœ>ÀIù÷Ñs/¥SóZ`†é·úf´ÜYñÁ£»•ZFw/êü=KkƒÅ*ÍŠY‹ÈdÑŠLe!¥aÑK_‹5Z´u= O/&Tž³×õ¹Š*¯Z|Qyµ2—–”¥¤V/­ ×À†*Ý–¢ò½ÞJÝ€—Öû&°ñQ7ìqŒZKS¬ZiÖ+á}UVðpì<¦m«oŠԶ Gµ61‹´á¬šRyµ±=ÖX¡?½‘m‚Ê•U/2:•!%·ŽJ 6OßÃ6PÁÃŒoôhðp¶e¼{øäÕåîrÿk}ÍëÏoÇÏÇo¿^þúò°âÍ~ÿøçíçÏ¥=«§Ö©ujZÿk­—ׯeÿ>DízÞ×ÿžÛ=Ž_³ǯy Œã×f Œã×V Œã×k Œã×[ Œã×%Æñë=Æñë#Æäx*9“ã©äHLŽ§’#19žJŽÄäx*9“3SÉ‘˜œùdr΃ïÔ:µN­Sëzˆz>stream xÚì–ÁŽG E¥¾€v¹Ê®* !Ù%"(Ã.Ê…Q‚˜äIYð÷Ü[lðˆñ©£q¿îã[vÝ.wïË”ÞÇ(6ø–Z;ƒUꨦÕÉ Æ@KëÊ •¶æ ¬Xm ù˜xŽâÊÌsçs}®2:3/)c1óªe3/-«2ójeÍ}«—*NlWÆ”ËKÕJ¹5­ `ÝÍ7…÷Ή”j*Œ*"`ˆ´Tʨ¡À>Acê& ±dÐXc£¨Ø&fѪ›X艨ìŽWFhO«¼‹ ´ cÔŠöF=UVŽÈŠZgf” Že ‚†;u‘@.Ac j Ê-`_L¡±:5› B ”ÐĨ¡VZe‡LÑ 6¡ißwgiM7»°“ÂÌM êB¨™‘À›+‰!$4ÆÜ4¦m«m—"›À"en—uwˆ›§|ĸý>1ú¨í¾tÚÆIìÍSV´ û.ŠñÆŠ:øÚ,4†±k,k 3órÒ/fÐXJ]nÞìʾ3©uDtŽ-»û£×Ô@Yè5lôh,ê£6 «Ý–¯ÅhDŠh’fîÌŒeØ`# eÙ¬›€Æ\›€ÆòMà;‰U¼náÝñºHà%Ä D¶õ¶ƒ õ¾;ƒ8ÍÈŠóòéÓãùÕ¶R~;^¯.÷ÿ¼½;~fÇë‡yãæxóÓñú/¬ÂÏžýz[ ´öØ#h)°EÐS Fp¤ÀÁ™%‚+ò8ûì’gk ŒÎ隣szKÑ9½§Àèœn)0:§{ ŒÎé:çÅåþÝíýͧÏw·ÇÍåîý»¯¿¼¼Ü]î—'ðÆõïã×ã—·Ÿ/ÿ}úúÄ›¿ßÿùáßÛK}"g®3×™ëÌõCçz~ýèûö­×ó~|Šö8~«¥À8~«gÀÇo)0Žß:S`¿u¥À8~UR`¿ZS`¿ª)0Ž_m)0:GSÎiÑ9šrN‹ÎÑ”s4:GSÎÑèM9G£s4å}à“ÿQçœß™ëÌuæ:s]ÑQŸûõÃ"8S`àJqüŠ¤À8~¥¦À8~ES`¿Ò2 Çñ+=Æñ+–ãøOqüJÊ9?Ü$ån’rŽGçÔ”süOþ”süOþ”süOþGs|g®3×™ë‡ÌõE€t­0ò endstream endobj 57 0 obj<>stream xÚì–A]5 …ÿJ~AobÇv,U•JÙ bºC,*:*Oš–Eÿ=Çy#x4㤻èôèå~Ç7Îyñ›bÚz›bÖ ðÿjƒ9„·á±²z£i!Fã>CPc!ðàX!ð±IiÂB›,aMg8¯Õ¬‡3>6 gدÎ>Ú²pvjÎáìÜ|…³Ï6ú k—6íE…ò ZdaêñÞ3 :^|í½ é#Ԁ¡¨ Åmy(ÔX}¨±Ö&PÃeÖ¨ó&V£Ñ7áP+ˆîP4CÇhÄÄ (¼8£w²Wg#”@éfµ‘…B µpF;±! …æQ—PcI…Þ£0rÄ8–è‹Ò„²¨íóà¨A åQƒ¬1E‡”VcîQÛg^±Ê½1Ž&ŽY8œyŸsÔÅöYWX`ÓM ÆâM †M †û&°Ðu(‰šX È‹N¼.íÅ[[‘…Ý—ëÁo"$vY´±W±`;Šm-ÚÀjE.5ÚîQR{ä%^ºD]ü‘1ÆÕT†F Afi'/´û‚–ÇTÊ£Â+sg/²;„–ˆhÔPÔØ›QØÇ/T8k|/,êâa¤{«!—›p(-A*‚ÀÃ8Ï ŒÎ$DÝ _tdÒ°i/_ß\î?ÜÞß|ùzw{Ü\î>}xøäÍåîrÿsÑÛÿ_Žïß½üõåá‰w¿}úõ÷?o?nãEõ ^¯¯!ïí§ãÍñÃåþ÷wÇwèq?Þ¢«²nŽwßo?b?xO|ðˆïIG \¤h䨜%P2(%pfPK gÐJ ep•À‘A/99^INÜâ %0'Ç©æä8—ÀœŸ%0'Ç¥æäø³Éù//…Óëô:½N¯ÿ«×ëë¯Ì_¢z½ïçÓ3mæñ«³æñ«RóøU-yüªU@ÎãWW ÌãW½æñk½æñk£æñkTsr¬”ÎɱRr8'ÇJÉáœ+%‡sr¬”ÊɱRr('ÇžMÎyñ^§×éuz]/QË—è¼Þ÷üôíkyüN+yüÎUóø^óø•^óø•Qóø*yü —À<~eV@ÍãW¤æäH)9š“#¥ähNŽ”’£99RJŽ>ò“¿”}ä')9úÈOþg“s^|§×éuz=éõ·÷G%ý endstream endobj 58 0 obj<>stream xÚì–ÏnUG Æ_ež€ã㙑R »V-"ì T¢¸R  Þ¾Ÿ'‘X8"^"õ,rãdîÏß±ç;ã1Þ¨™Ñá÷lÜ%‚ÕD&‚IMf€›Z,MiºVÚ¬5­uÖzë#òMo.#‚ÑbÁlÃ8‚ÕÆŠÌ‹Úì‘yq[™—´å‘yic’H½ QùêÙ"ùrD+²ãƒeìU<¸ÚfWcäD(†8"F„Icï4†¬ˆ 1iИsÐX}£ é&f¦M ;]ŒöˆÁÜD5Ô"ýø›A°5éæõ&N{Õ9Eø@1,"hLÌ[€þ!‚ƲÐl¡DŠ¨‡†XSæÐ@ùÊÑ—&ªhh`;Tfh`_U-4P¾Úî¾¢ÖC’Ú5VÎÁ¢|=EᡫИº h,ÞÄkl ä›À£qgÄæ¡mA…D„ Ë ÃãÚîP®.7Þßÿçùåærû†žP»ÿy{üyüþîÛå߯÷ßxýχ¿>~¾þò¥ñzöì'ÎõËÝ‹FíÕñüøãrûéÝÍñ[¸êxØ WÇëÇË¿Ñgôÿør•J e+ NŒJ œÔ82h%Ð3ØK`Ï —@Ëà(šÁY³s´äÊα’s(;Ç*Ήy–@)Ù9¦%0;ǬfçØ£Îù?Vg®3×™ëÌU¹ÔX>Dùî¼çOËã—µæñËVóøå^óøe/yüò(yüò¬€šÇ/¯˜Ç¯P ÌãW¸fçHÉ9š#%çhvŽ”œ£Ù9RrŽ>på/9G³s¤äÍΑGs|g®3×™ëÌuwˆÎtˆêº;ïéǧïXô838JàÈà,žÁUóø%*yü—À<~IJ`¿¤%0_²˜Ç/•œãùâF%çx¾¸QÉ9ž/nTrŽç‹•œã\ùKÎñ®ü:ç<øÎ\g®Ÿ$× +„%5 endstream endobj 59 0 obj<>stream xÚì–ÍŽT7…_ÅOÀµ]?®’!» eØEY 0”IZ`ÁÛç”{¤,jÄTÖ¹ †R»¿s®Ë纚×ÒÖ¯µ*üomÈŒÂÛœ†Âz£ÎQŒFß5¬ÓŠ‚û^â&2¢¦}SÚT% Ï4k!ŠÂ›QxyoæÅh.¡ì³ÞCŸ®¡ ƒ1fˆ» Z¡îÚƤ÷…ÊCßñäÄaàÞO¬ZïØMQ TØ$*x¨PTðXÓ£‚‡õMÀÃlðpÙÄj³Ó&¬ÍÑ7ö bt4Jƒ£MŠÆؘmò&[ƒÛÝ„´©¼ E…G%{!€ ¦ÁNxøÔ¨àáÑwCSq.=*Båá;¹ÑŽJÍÀhjxÌÕˆv_p°DqŒ†íSxΙ=<-»Cáí“Ú^…ÇÒ`qdÊ8Nò¾Ø>¹o ]7yªx\´-*<ÚŒìï4Á°d‚± sx\ÙŠ]›ˆ€È&ìºATððD,¸ÄŽH~¬"ÑÒWìÛ’AÁ¢M2,º†¶Ë KmB;/8x! yüÑ5ˆ ¯ðÐŽ¼ïäààEv_ÐÑØ‚)ø¤ z œ ´^GG 윰{©Z¹® J Ô j ” ®˜“c¥äôœ+%§çäx)9='ÇKÉé99^INLöR ÌÉñ'“s^|§Ö©ujZ×k›ó%ª×ûÞ¾ßs¿:K`¿J%0_å˜Ç¯J ÌãWµæñ««æñ«VóøU¯€”Çïê%0'g•’C99«”ÊÉY¥äPNÎ*%‡ùÉ_J=ò“¿”ÊÉYO&ç¼øN­SëÔ:µ®—¨åK”¯÷ýúþíkyü²”À<~Y+àÊã—W Ìã—­æñË^óø•^óø•Qóø•Yóø*99RJÎÊÉ‘RrVNŽ”’£99RJŽæäH)9š“#¥äè#?ùŸLÎyñZÿ;­l'» endstream endobj 60 0 obj<>stream xÚì–Ïj^7Å_EO;4’B Mw m¨³+]„Æ$¡n?p’EÞ¾gôºϦ›r¶Öý͹+©¯9µ¾ælPø»›„ð&² 5¥‚›®xvaÜâá¥Í4^½ÙòÖFßC£MÒQxS«-ž!¼­š+‡àæ+¼\S·PÚ˜)j{‡²(îÖX8ªû€šQÞgcÕ¨ïxs]aàÞ¸w88fCŠ¡0I(x ÓPð˜â¡à±ÈBÁ#f ·MÌ&¤›XM˜6öð ‚ A07Q ‚¥Iç ðKz´Æ¹7±± k2ú&F“É›€ÇôMÀc…‚G˜wxøˆ $X(,”6eÊÒ¡ÐD(k*=|e44h„šP#<°°Ú%<0}í»/h¢š†ÖDÍË«£‡¦¯swèáK]ºGá„‚‡{TŽá«x îAt  m¡P^<ˆ@éPxµéñX<“MÀÒ|sxݹ;¯¶d~]Úî{`÷ŸYH´1ÇŒ°ðÆc"³"1#3¨µÙ@ÇëÆ›zT¶Õ¬ï¼ „fåh³]ÃÂÛð@Klìä Å6w_°d6=<°ð¶âÃr´Ä|gÌw‡ðBƒ$<†CyŒ¢%ƒg°“Û‹ÊSÚP _„ôøÀ-}nŸa2ÏŸ?\îßßÞß|ùvw{Ü\î>½øÏ«ËÝåþ7zFíáç÷ã—ãõ»o—¯_žxûñÓþ}ûùsãgôâÅYëSëåuáöëñêøùrÿ×»»ã'ìóxƒ¯è:ps¼ýñxó¹DÞðAËà*=ƒ^5J%P2È%3(%2¨Û@{ \´838J`NŽ–’C99ZJåäh)9”“ÓKÉ¡œœ^JåäôRr('§?™œsã;kµÎZg­ë&jyåë~oßß}{>~™K`>~YJ`>~YK`>~¹—À|ü²•À|üò(ùøåYóñË«æã—½æäH)9š“#¥ähNŽ”’£99RJŽ>rå/%G¹ò—’£\ùŸLιñµÎZg­³Öu]i¿î÷ýû»ïÒ ö(´È%28+àô ®¸2è%0¿D%0¿Ä%0¿$%0¿TJÎÌ7*%gæ‹•’3óÅJÉ™ùâF¥äŒ|q£RrF¾¸Ñ“É97¾³ÖVëJ&ç endstream endobj 61 0 obj<>stream xÚì–Ín\7 …_EOK‰HÓ]ƒ6¨³+º# êv'Yäí{¨1И›nŠ»ð˜éã‘çŠW–[£&˽!ÂÿÙºŽVc"˜Ô˜$‚ÞxÆÞ‰uÍ“›rlžÒŒöfm6÷fk.=$^{i¶©Áj«µ¨-[ôÖiDÆ5!-"n½KÈ-A´<"m}h¤_Ö:÷È…ÎPé2Ba-Dø•JD8¯ˆ ¡ÀAÔ#‚†½ I4&ŽŠK="oƒx³N›@}ú ¢*eAà æ p¾!=| ™AtiCmÚ†É&¬ †¯M@cÚ& ±$ˆM 8Ñ@HcuŒ†ĉ#ò`‡4L)¢™QXf‘ˆ¼±P袳,:#Zµ‡0V ††íº »(nhàøì,áƒÐ`hÌ]!†Æê¡ãstšB¶Y4­A EÙ"Bóp¸ˆàö ^D‚ÀÏ›@Cum1ßÌຠẖ‰0Ò®ÒÕLjâ¨,­}×%?Ȇʼn`Køx¯b=NÇÞ,RÉÚ©P•ÈlØlÛ/Ñx³ÐïQµHê†s;'?w]¢$KBà … l;¡ñÖw…PëÞ›}´Çx‹v›PdFIL>stream xÚì–ÍŽ\E …_ÅOë¿ú“¢H!ì@1Ù!AÄ@K“°ÈÛs\=bãVƬ¹‹î>êªÏ¾å:×UG'¦Æc~'IÓ‹T'Äd2öB6cîTò“§Q³˜<:ïÉúÜ“;âíɃ¦íɓ沋V‹¡Å$Ì#”@õà–’ˆJ(ƒt9‰Z Õ Vd\Ä|…$ΑaáÙ½GŠµbÈøPXrtóPÈÑ‘ 9†ÏPÈ1¹…BŽ9÷(r¬¶ÙAÊf¡&©ð …É B¥êAˆš!Jê¾Ôg⤭o¢‘vßD'² äkÈ1û&cy»u‰âX,JɤŊÔÈTö¨CõX‘62ÓÍv(lÔ s‹ÈØZ”¯‡Zd­E^CŽ.Q5CŽÞ#¶×†F,ßÆ® ŠhÓ"6ÅæŠØb[aÁòw…09ÒÅcÔ™e %P+"cÀmD^7r÷ Üá1ÝDƒZ›èä}l9FÛrLÝr,¾Â9ÒÂH»B×G "–ªá—]:ÝuiX‚µM`À%Vïcb i¬¨á«Í`ÃÛÝ£j±ñƒ#rÇä±ý&œyÃÔsDÕbãW¼Q%YÛ9(qç]lYÛB-êû1%éº=„]w…ð@Ý4r £î¼GñöùvàõkXÌË—Ç7—Ç÷wŸ¿<Üw—‡žþysy¸<þÌ/˜ž>¿?ß¿ÿrùûóÓŒw¿üõ¿î?}"yÁ¯^±ÎXÿÓX¯¯—é§ãÍñÃåñÏ÷Çwèõíx‹®s¸;Þ}{¼ý o4š þøDïN`/3ƒ£Ž ÎØ3¸J`K q ô J ´ j Ô Z ” z Ìα’s8;ÇJÎáì+9‡³s¬äÎα’s8;ÇKÎáìÖ9gã;c±ÎXg¬km¹‰òî÷c}½û¶|üò*ùø.ùø)ùø­€ž_±˜_ñ˜_i%0¿ÒK`>~e”Àì)9dzs¤äÏÎÑ’s<;GKÎñWþ’sìÆ•¿ä»qåÖ9gã;c±ÎXg¬k©‰Êºöûùõî;Gµö Z lôèl%Ð2ØK fp”@Éà,œÁUG>~™K`>~¹äœ‘/n\rÎÈ7.9gä‹—œ3n\ùKÎ7®ü%çŒ|qãgs6¾ÿë L# endstream endobj 63 0 obj<>stream xÚì–Ín\7 …_…O+ñOHÓ]‹6¨³+º£ êv']äí{¨1Ð1—YÜ…ÇÇ–>òŠ:C^ëé‘õ1 ¿'u㋘'Äl$MCt’{'“ZlžB&±y*yÛ›|îÍŽx{ó ){ó¤Õ÷æEkÆæÕ¨7µPzo±¸ÊV(¡Î=È¥PCBu‘» ±¡uÕȹâÙ[µ  9¸!‡w …>8r ^¡càQ¡cª„BŽ 9–Pƒ°w¯NâÞ6‹Åy £TÞCub‘ pRÖ>Xg]‰Í7aÄ®›pâÑ7cm9¦o9VTˆ9nƒÀ‡´3Iº0 k¬„ʼnؠ|¯:‰rœˆÔØì$1ÑP jEdV\£j‚£E^\¯ ªáø2{ä†ÒGAŽµë‚+–µ"Ž¯M#‡LÒÖaYP»BÚHã€PjŪÂOHJW‘q¡Šg ePkNêcÈ1lÈ1yȱÂCŒ]#CÊfAlO‡sØäzµP±07£ÊöKøZw]ââ­o æq¢0¦s¬†·}ƉâXC‚2U‹²ÏH‰[&[Û/qñË#/>¼q<‚â{9|’÷í\¼÷]”Ä÷àr‰/ÃÀ.ÛC¸x×]!”ÄuDŽ¯Ÿá0/_ß]?Ü?Þ}þòpÜ]>~xúÏ›ËÃåñ×ö¢ÑÓÏoÇÏÇï¿\þýü´ãÝŸÿëŸûOŸ¨¿h¯^±ÎXg¬o*ÖëkóoôËñæøéòø÷û‡ãL2=ÞR´÷X¸;Þ}¼ý=ÿøì´Ø2èC#£Î Î82¸J 'p¶hì%P3È%P2(%0;g–œÓ³sfÉ9=;g–œÓ²sfÉ9-;g–œÓ²sfÉ9-;g=뜳ñ±ÎXg¬3Öµ‰Zn¢ví÷þõîkyüÚ,yüÚ*yüz+yüz/yü:—À<~]* æñëZóøu+yüº—Àì/9G³s¼äÍÎñ’s4;g”œ£7^ùKÎѯü%çèWþgs6¾3ÖëŒuƺ6Ñ•›¨^û½}½ûÎ<~µ—À<~•K`¿*%0_՘ǯZ ÌãW½æñ«£æñ«³æñ««fçXÉ9#;ÇJÎÙ9VrÎÈα’sÆWþ’sÆWþ’sÆWþgóM6˜ÿ`Ž$ endstream endobj 64 0 obj<>stream xÚì–Ënœ7 …_EO_¼èB ¤»mPgWt4FÄíNºÈÛ÷c  >À¿ð˜éã¥3¢¯Ùz¼VC„ÿ»Ñ`¬1o»7éê5Ù>wsÓá“·´!>yk›=&6wLžÈ“WÛ“w3ŠÉÖlûdëúôÙFH}º1"[I#1ª„È£h;)¢í‰Í×.æ‘!”!sø:;4u ±æò›Õ#hlTˆ&Û#h$­ÆÝ·EP%S7°A´}I™§³X$‹xfTÊJ®‹Öíiã1ƒ§1/ Ë‚€ÆžA@ÃÔ öS`'ðm'˜¨8iÂêŠá FíALDÃ+âÕdPŒnDË+bk2ÙYÆܾk¥žÇ‹C÷]hìẠ#ß5†-×Àkw¿xùÚc_°‰ŠCòÈ™kàql®òUb‡0Ee¹$U5FcgQ¾óÌй\W¡±FÐØ4¬;µåÄÀÒº{HüðHœp3pw"̵ƒðåÆùÒT‚@©#üâ#öe „9po/rÂ~Ū|`‡Æ„ÆÂím±~ðủ_K¬ &œ0õ¤„µÉQ9¶drÔ-ž¾Ùˆ‘Ũ´©qæŸ#*Zøù ˆ¿|y¼¹<~¼¼ûúíáþ¸»<|úøôÍÛËÃåñ·þ¢·§¿ß_ŽŸ>|»üûõiÆû¿>ýñùŸû/_½è¯^¹Î\g®3W!×ëkêí×ãíñóåñïÇèâr¼Ã}}¸;Þÿp¼ûw!.g|ñ?(ÔÈ%28K`Ï઀èç Ü%pgÐJàJ ô83H%pdK`vŽ”œCÙ9RreçHÉ9”#%çPvŽ”œÓ³s¤äœž#ßuÎyñ¹Î\g®3×õùí×û^ž¿}Gn¿}•ÀÜ~û.¹ýv+¹ýR/¹ý•ÀÜ~‰K`n¿$%0·_Ò ¨¹ýÒ(Ù9TrŽfçPÉ9šC%çhv•œ£7žü%çè'É9zãÉÿ]çœß™ëÌuæ:s]/QK—è¾^÷üüåk©ûZ/q©ùU¸z¯q‰K­×¤Ä¥ÎkZâRãµQâRßµYâRÛµUâR×µ]â’_¬ä—_k½d˜_k½ä˜•_k½d™uã_ò̺ñÎ/™fÝxç?ïšÿU‡!› endstream endobj 65 0 obj<>stream xÚì–ÍŠG …_EOà.•~ª Œ!qv ‰Éx²0ñ˜Lraì,üö9¥X0Ö6Ћ¹S÷¢OGª:]j“áÔÈd  ÿ'±õ½XÔûÄb6’¦{Á´¿`ÑImOÁÇžJÞ"ØÈg;òEð )”¶J7ÁL]‚@§]Bƒ…ºîª”•ºiFÝ{Ð-hŒÐ`hœU14VôÑ÷)ìεãÚ>í„÷Ah’U!©HôÑ «è¼;Iì•öAbÄÄj±H<ªhŒÐhÄñ)’âà7!Ич@ã¬J ±BI±‡A ¬¢s™¤a&•Eè`A=›P&=÷Já'‰ÎUH5úÀvªÆîªm·  …ƈªP¸ŽèC¡1}çaLvžà.ã¬Ê`ZŽ> !=:7ÛFÂOÓ`5ðUB,ú°EvújoιWçá ¯«CcFU»ðŽGãßþùôñö¿ýù÷ýÇÄ/Ú«WW®+וëÊõ?ÎõÍ9ý|¼>~¼=þõîáøžF?Þì1¿ßo¿;ÞüŽËÚâ‡ÿ8Kœ”8Mœ–8Iœ•¸ž8/qœ¸QâZâf…Ã+Í—Ü*qóKn¶7Ç%.ùe–üÂÉ/³äN~™%¿pòË,ù…“_fÉ/œü2K~áä—ùU¿\÷Ü•ëÊuåºrw¨§;Ôλ¾=÷Zš¹æ%.Í\%.Í\›%.Í\[%.Í\o%.Í\ç—f®÷—f®K‰K3×µÄ%¿xÉ/šüâ%¿hò‹—ü¢É/^ò‹&¿xÉ/šßéK~ÑüNÿU¿\÷Ü•ëÊuåºrwèJw¨Ä]ïëù»w¥™+«Ä¥™«­Ä¥™«\âÒÌÕ^áfš¹*%.Í\Õ—f®Z‰K3W½Ä¥™«£Ä%¿hÉ/3ùEK~™É/VòËL~±’_f~§Þ/ÿ 0Û2¦ endstream endobj 66 0 obj<>stream xÚì™ÁnV9 …_ÅOÀãØI¤ ‰Ý M»«X¨D‡fÁÛϱoA¨–hl•›ÏÇIÎuÚ¿ÚºQ!m½“šÿÄ\=˜Äc …ª5˜¤ùÜQ©±OBmúäç“•¬Åd£^cr§>cò Ñcò¤Ù|ò,Ä¥úìÉP->阻ϟB\ÕÙˆ¥¡Ä­aˆ,ˆN¬QÎDíÅ›Š¤l^žht¯_ 4¢&-Ю¡HʳiAÕRƒèˆzƒ*Šñh"òRÆU_µ2S_‡b«øŽ* Õ7ª¬ˆ¢*^Í‚€F—  18hŒÐ@u¯ªâJ¬£Vö•kD~Ší”jA(‰DUÕpp±ŽÚÅʱ9{¥u’˜Ÿ‡J!éØDÐècÐcБY 1kŒAcö3jE\M:¢éj2à“æj2 ¸ o527¦&ìDƒŸ ì Õª(¼¹Ñ)5O…:ƒ€†í4zh4hŒê„BcL'³;á‡\Ô EáŠ{Uªˆb~d¢AàhÄØÍ€hâ[TåGfñÀ˜´ÇÊ ;aÐà ?² K!·5›‘‰±N¾÷·ÇØbl’Ul (ˆ<•v&qq™‰ÅSÁ«†ÍFÔEi¯ŸÊÙÙöd‡ ý½=Ýþ:Ýþ{u³ý‰µm/±uûøùvñl{ùeaŸ0ðøñ7n$®=Äýqº}{}{þåëÍõv~ºyÿönäééæt{Yºûzµ½Øž_}=ý÷ånÆÅ?ïß|øxýù3ñ£rä:r¹Ž\¿u®'û{¯‡VŽ:~Ú{ýŠ¾ÏÕ%Î'Kœ&®-q-qºÄIâl‰«‰ëK'n,q%qs…ãtçJYâ’_dÉ/œü"K~áäYò '¿È’_8ùE–üÂÉ/²äN~‘ýrô¹#בëÈuäÚ{¨¥º·úþóÖkéÊÕ%,ݸ¶‚iºpû–îÛ±„¥ëv.aé¶å²Ä¥Û–y‰K·-×%.ݶ,K\r /YE“UxÉ+š¼ÂKfiÉ,¼ä––ÜÂKviÉ.¼ä—–›Ð/G‡;r¹Ž\G®³h•ö½Uîmõ2>)ÇØþA9‚W?6ØrÊ}ù2>~¿K )/%(ßpJPWì¿îÿ'¸Ÿ@Jð+·øÅvqõyÀžºúHíPXSø_€@FH endstream endobj 67 0 obj<>stream xÚì“AN\A D¯â@»í¶»%Ä"ÙFÊ‚ì¢,¢€”‘€,¸}Êx1ƒªžÿëþ³V† Y+S0áï]³†#sn {ˆ ¯AÅve÷_Þ&Ë*¼]b0¼$6ÃÃ)ÛÞr”á#gWø Ñ•>*ª^ñ3E§Vþ¦S…ã¢l,Qw6¢ž“ÄtØÀ³G²qDÓш{zMØqðvœ²a2Gé §N6ÄQGÀFÊ´ÅÆ–éÆh•tèÀTÖ¡*3J;`:³¼C±c—x(vìÍvœ`#êtÙH1U66¦ÃÆ›eP5+ó˜¸/ó˜S™Ç4±UæU šÏ%–4ŸQÇvlšCÕÍç4·!®47ÅDs¨ú¤¹™¸ÑÜ\Üin Í¡Šw‚šÛOšv$Í¡ê›æŽ‡æŽÈ ¹ã…4/U¥¹/Y“æõº±‘˜h^ªNs?¸xš¯ñï 0©¬¤y©&Ívlš/DÍ^ÛAs¨âŽÙHÁ=±±'ÌÆœR5  ¿j„ ž¬1ôj„IÍ¡AóÀŽ¤yDýHØÀŽCs¨Æ¡yÉAó’JóTÉIs¨æ¤yš¤Ñ<]ÒižK‡%77×.Ï÷Ïw¯oO×w—§Çû÷ÿ|¼<]ž¿Ž«!ïŸoן¯?}»üy}O|ùùøã×Ñ«q{Û¬f5«YÍjV³šÕ¬f5«YÍjV³šÕ¬f5«YÍjV³šÕ¬f5«YÍúÖ_Š'}5 endstream endobj 68 0 obj<>stream xÚì“AnTA D¯â$í¶Ûî–¢,`‹Ä"ì D"1R¹=å"à^Œ¦þ¨ªü_·gE† Y‘)PøÞ¢k–82ç†ØClx ÛåÝS|•y›,+óv‰Aó’z€ôÑœ²æ-Gi>rv™ÏQêe?StjùA µ`b‰º3õžL$ÔaïÉÄMG"fìé¥0ãà 3NÑæ0™£p„S' àƒ‰¨#`"eÚbbËtc´ :u@uªÊŒÂNÎ,îTÌØžŠ{3'˜ˆ:]&RL•‰ u˜8b³È¨fEž×àEžsByN[Ež@µ ù\bIòuqL`Æ&9Pí|ñArâJrS(’Õ'ÉÍÄäæâNr[P$*v‚‰’ÛO’f$Éê›äŽ‡äË ¹c¡É UIîKÖ$¹G­ EòBu’û‘µH¾j-H¾ôß @•…ä 36,‡ä k;HTl2)¡$_[b’| #9PÃH*á$)±H&$jÉ3’äõ'a3ÉŠ­eâ6¯9;S‰TÁmW¨¸±J¤ ΚX.8/&–€ÔåææúÃåùþáùîõíéáúîòôxÿþËÇËÓåùë¸òþùvýùúÓ÷·ËŸ×wÇ—Ÿ?~ý~xy½··ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]ÝÕ]Ýõÿ]è}™ endstream endobj 69 0 obj<>stream xÚìÓ=N]A à­x0þÛ#!Š¤”‚tQŠ( åI@ vû„d.¾ÈçÌûîv„Ó¢TSýNâ-=Ér‘.ëI³wSÈv/§ÒÖ^N#_XÞä‰e¯>,¥b9é0–ì峈—÷öab¶^?B,ÜûGk:8F¬ŽÄ&6CÂûs"5$ê³{ qˆÃ*‘«ÎH±žêŒS5Õ§µ¹”d57K(,Hì‚/$¼_A¢‰$1E¢^Ðntòª©ÕÉLâÍÎ’J´;¹ÎèÇšêŒL$êŒãHx¿]$‚”‰¬é qH¥åYTÕ–§Ô×`-O‘šZž¢¤»åMU‡\6i@.Þ_uFB^T=Ë![ë"cÈ•k‚¼¨&«’)äjd¹îš /jÝ $‚Ì!×$ ȵÎÈ‹j ¹Õr«•¹Õ…Z7•!·M[ 7ïë†DÔyS r;´7ä»VòÍu ÿw§;±õý1w­Èw]ÛyQë&#ä ùNr|r…¼¨®;“ä.ärWr‡¼¨î{»÷? uƼ¨~ ÷C± EÁSäE <”B!£0ÈcSÔË¢››ë—çû‡ç»×·§‡ë»ËÓãýû_>^ž.Ï_×Õ¢÷Ÿoן¯?}»üy}ßøòóñǯß//ÄWëövº¦kº¦kº¦kº¦kº¦kº¦kº¦kº¦kº¦kº¦kº¦kº¦kº¦kº¦kºþ¿ë¯F}ý endstream endobj 70 0 obj<>stream xÚì’½j[A…_ežÀÚùÙÝ0.’6àÂéBŠ b"|Av ¿½gz‚ÔS‰ós¿½;}/4}oJ•ßN<¥Dˆ§ðA:¬“zy]Èf™]ij™Ýh ˜'-‡yeÌ›\av †9(¼Ì1ˆÇ*w01[ÙCˆ…Ëš**F¬ ‰Il†ÄªçDb§ $òÙ×F"ˆ·e"Fn¸X©Ü¨Ÿ©r#Š6†’ŒÂ$$f‚$V›D'NbŠDÐ,èà‘ª¨ƒ™dv‘Ê.îàÜðÎ:†T¹ ‰U§‹Ä&eFÂSA*E‰ªZä!ù¬ÈC$U‘‡(é,òHT] —IºA.«^¹á OT K ë c+§y¢š€\•LA®Ff ×™ 䉚w‰M¶@®N¶A®¹±Až¨æ ·Ü[ZÈ-/Ôy¡2ÈmÒÛªë†ÄNòBµ$¿¿?}9®ÏçëÓûÇå|z:./Ï·¾—ãúcÜ º}~žOß~}ÿÞoŽï^~ÿ}=¿½߇‡îê®îê®îê®îê®îê®îê®îê®îê®îê®îê®îú¿®OKV§¼ endstream endobj 71 0 obj<> endobj 72 0 obj<> endobj 73 0 obj<> endobj 74 0 obj<>stream Acrobat Distiller 7.0.5 (Windows) Acrobat PDFMaker 7.0.7 for Excel 2007-08-23T07:39:38+01:00 2007-08-23T07:39:35+01:00 2007-08-23T07:39:38+01:00 application/pdf res1.xls Papapanagiotou Petros uuid:b8a46495-9a35-449d-86f0-14be5f100082 uuid:92f7140f-6d37-4dd3-8a86-246e9d39df1c Metronet endstream endobj 75 0 obj<> endobj xref 0 5949 0000000000 65535 f 0000011161 00000 n 0000011370 00000 n 0000018457 00000 n 0000018666 00000 n 0000026174 00000 n 0000026383 00000 n 0000034681 00000 n 0000034891 00000 n 0000039971 00000 n 0000040037 00000 n 0000040101 00000 n 0000040153 00000 n 0000047903 00000 n 0000048999 00000 n 0000050078 00000 n 0000052137 00000 n 0000056581 00000 n 0000059723 00000 n 0000060731 00000 n 0000061734 00000 n 0000062737 00000 n 0000063740 00000 n 0000064735 00000 n 0000065741 00000 n 0000066742 00000 n 0000067739 00000 n 0000068741 00000 n 0000069759 00000 n 0000070775 00000 n 0000071786 00000 n 0000072789 00000 n 0000073778 00000 n 0000074780 00000 n 0000075771 00000 n 0000076776 00000 n 0000077774 00000 n 0000078775 00000 n 0000079767 00000 n 0000080759 00000 n 0000081758 00000 n 0000082776 00000 n 0000083789 00000 n 0000084784 00000 n 0000085783 00000 n 0000086787 00000 n 0000087790 00000 n 0000088786 00000 n 0000089788 00000 n 0000090783 00000 n 0000091784 00000 n 0000092779 00000 n 0000093777 00000 n 0000094789 00000 n 0000095804 00000 n 0000096817 00000 n 0000097842 00000 n 0000098864 00000 n 0000099894 00000 n 0000100924 00000 n 0000101955 00000 n 0000102988 00000 n 0000104018 00000 n 0000105044 00000 n 0000106076 00000 n 0000107101 00000 n 0000108098 00000 n 0000109115 00000 n 0000109799 00000 n 0000110484 00000 n 0000111164 00000 n 0000111721 00000 n 0000111756 00000 n 0000111780 00000 n 0000111858 00000 n 0000115712 00000 n 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f trailer <> startxref 116 %%EOF hol-light/Boyer_Moore/testset/res2.pdf000066400000000000000000004007331303454263000202360ustar00rootroot00000000000000%PDF-1.4 %âãÏÓ 3244 0 obj <> endobj xref 3244 16 0000000016 00000 n 0000001089 00000 n 0000001333 00000 n 0000001611 00000 n 0000002092 00000 n 0000002315 00000 n 0000002393 00000 n 0000003542 00000 n 0000004606 00000 n 0000005675 00000 n 0000006791 00000 n 0000007826 00000 n 0000008876 00000 n 0000009871 00000 n 0000000856 00000 n 0000000629 00000 n trailer <]>> startxref 0 %%EOF 3259 0 obj<>stream xÚb```b`` b`a`Qcàe@^  PœcC«æo†?L•À`àb?nI6Ž¸oóþð•¯7<µÉ,ÁÊÀ ¤™x3k00|:ö›Áˆ9¢€˜AaƸÁ: ŒLá@šˆ?Ó‚ endstream endobj 3258 0 obj<>/Size 3244/Type/XRef>>stream xÚìÑ¡0 ð4hÿóý:´ ü€Õž4mi®<ă‡xðâÁC<ă‡xðâÁC<ă‡xðâÁC>/Outlines 5 0 R/Metadata 43 0 R/PieceInfo<>>>/Pages 42 0 R/PageLayout/SinglePage/StructTreeRoot 45 0 R/Type/Catalog/PageLabels 40 0 R>> endobj 3246 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 3247 0 obj<> endobj 3248 0 obj<> endobj 3249 0 obj<> endobj 3250 0 obj<>stream H‰”—[kGFßçWô£…ͨëÒ7°Ð“A@ã7½9kãà•Œ6$$¿ÞÕ³ZK3R•khVSÚÓEÏw¦»cø2@ø†Ó×1|Ù ‰CIcåÇ–Cf!‡ûÍðy ÇR—Uñ¡˜ó¸þêÏ" %g­Xy$TŠ i$uL¢5¶ßyÀÆ4ªµŒJ%E£öµÄýF6Fœ[ïlþŸ§ÕØFV«¹µV«qD½Zã˜õj£«œÁê*Õ£Õ¡Õ•<>£+ ««HFW©±ÑU’Lé]%y¼zW)'£«”’Õg«+ÊVWX¬® X]ÅbtÅ­]q­FW\¬´÷ÛzWœ¬´s²ÒÎl¥ÉJ;£•v+í­´S³ÒNÕJ;+í”­´S²ÒNl¥ÈJ;¡•v+í­´c³ÒŽÕJ;+혭´c²ÒŽl¥ÉJ;¢•v+íVÚ1Zi‡f¥ª•v(VÚ![i‡d¥ØJ;•v@+íVÚ!ZioVØ«•õòrÔO§‹ðöíéÕùï!†÷ïÏ.ÎÃp6Éý)Óç!†é“”¦åW˜vÒ`¿þßo݇26¡ÉÏü$#…Z“Mʦ‡Z˜¶Ã«?îïþÙüùÛÉô×p9 —W2ÀÓQáÅQW`‰Hƒ´äN_·›pójws¢¡ÑfYñ¸,Ù×o¾ï4,y°ò¤ä!/ 6·*“L‡ek'ïð‚û)ØÜo5bòÌ«´¥§ã‘yv¥³‡(Û)Zñ.5`ñe_ØZÏ”§Åêy4}¯òÁ×dó 嵋9‚¯IxY´²ïÓ0’³KðhIJ*eŒÅÙ¦GŸ$¯+®±yÛô¸“ò›\s£PfµC·áµÔß…mPÙ‡HÎM–ðÿ6;ë‰úå(¬Ë&YÞ ËÁso"ÔÖŠŠöxÅ}Å÷Ÿ¡“Ì=©h—`ò¿Bg•é2¬T‰W[Í„:èRLÞÑœ+®¦@ezë™Rsñ2]Ž| xzêÃõÇóp+NôëÍ|çöæDMzÜÛû!š.³‚Œ.íf?ŽÂº´›ýà¼Äv?šázÔ{ðž¡åȨû.õö~¬Ðªèrnö£f/ÓåÜìGáÕ¨Û"s{?Ró2]Îü#hÈ?ýènÜÊU_3ÈãßÞ *ˬð’KµÙ‰£°.Õf'VÔ_-ä±m¯DKÏЦä²mVWh5¾äÒ¬+!r"]–ÍF¬£¦§×cÙÞˆJN&»,;‘YŽ #^‡ïbÅãjÑÿVÇrÍf;r[fŘ]ÒÍv…uI×í½êÛ·=¢¨hx <æŒõ:Sk*Ù%ÞlGNK²Ît7Û±Bªïv ×í(´ž•é1n¶£ÉÖÅÉtw°#±¬™rÄêÈ¥ýœq°E+yL|´ãé`ßîî ®Ëºýã(®K»Ç*.,¸á‡lǨ3 endstream endobj 3251 0 obj<>stream H‰”×;oÛ0†áÝ¿‚cz ÍCñ $r:dª»ym‡¢v tê¿ï!eÉ"ƒ#|FÛIð2‘øˆäÝŽŒú´ÿ½yÝo^ßžÕf»QÛ·ço/Êj·{záï>íù{£Hím¢ÎIþªoœÉ:SL*x§£5ƒÚ7w«Y‡d]ÐÑçÜfÕ½\õH58MÆ&¼j ÚY¾Zp5Uo¼’o£+Í„4ƒ6™_ƒóš¬qµyT_ÔI=òï<<îÔ±¾Û—ï‰ãe`¼ÿ"Ší€ÿ~þ³Á Ù_òMYB²Ñë@¾­š¯dSNbØ"„Œ¶6S_¶ÆäÅ4ÄϿضlå?²¶9w—×’…èe¯]ìšFL"î†6Ë> ogÅýïa |hìÛD|ä6„o¦ãsKÛŸñd v1ñdë.±<éBWyønÖ‰Oy"ÄÜÈÃõwMŽBæ&)–3L¼¬Ÿùçk+bïÊbY_¾q›Yà]ˆÛÄb™å©kcÎâ³weѵÏY>stream H‰”×¹n1…á^OÁÒ‰šûØ.¼)\EéÔ&EËRåísIJò¯ÏÀ°å ?~Còz¿WB‹ýÏM”9 Eõ«¼Ô*háC’Ö¨$ö/›«ß¯¯oâÓþ×æi¿yz~›ëý£¸¹¹~~øú(´5âîîþ‘~}¿§¿L¶¼˜ua‹„£’É'Ó‡ï´bºè:•eÖQ¯éz¤ë‚Œ>]ñ…É$ݸñýe³ɦ q~E6YOÓÌ&7Ü4®š‘j*—WŸd4*×è‹ø,Žâ–>?‹—ùN!s­êжáï?LWÃ8Æ.ÃAꢗA©Ð‡ÕŽÌæ4O#îšíû4ëÃAî¼–9Ò3¥ë5¯BꈇÊëªÜ‰¢%¯ëB –XÖðeWí ­éÁ‚@tZIc|Û:éçíA¬`ÒpgÝüD• †ÑI“Ë⺬j¦ 1¼Qº÷aEzeÌÆÂQᙠݹhhºäÒv]ÿ“až× 1ÚÈèØÊ­/ ’ØÄäYbc|ŸU;ëcv~ÞF0žÀè±mbÌž™„ƦO3 L†V/~¸u&Ì«ÂæeˆÎ›ˆÁÆE·m¾feÈà™‹Òåüc/\ÊìØq9V.oü “£ï+ÌrT~ß”!‡uCÖ…!‰åÈÌf7M¡X7cåÉ·¢ 1,‡–`‡.·mÊÀzj pÕ(ˆ`=µÐƒÏ"Û±¥lÇ–Y® )»Ñ¸-“QÀâ$ÒóiEòWV–@¤ëªJ6§8o#ëÊ¢iJmmé~ÌÛò²„á²õôÑjd0&zLÛ~ªˆ ›&©W endstream endobj 3253 0 obj<>stream H‰Œ×;o9†á^¿‚¥ÕŽy¿’ŠØ.¶ °…Ú¤"ÛÀVÛìo_òÐ3" ðøƒ ˼$fæ’wêþük÷|Þ=y»‡ó“8¾<þõ$´Lâtúü”ýùœÿr–B‰óÏ]XR2Ñ›Üb½öùƒZœVFœ¯»;9* D KˆJÁQ…Dý"S™qTKÒÊRó*>‰qß¾?æÿ;Oâºýôp¹4›®Át‹’^õ£ÿûã¦k®)ßÆîï××7&l‘p”‹´Îõa¹÷^§yÙ!OŒLKRa¸'Å]bt]Î…äûn ój@ªÞæÇ&˜¾*þd&Q6QêáòΣˆE—2üe¦ª!Œ«› ssóü÷WÒqSSÅüw¹£__î™q¯DFå›Ô Ì’ÑÅB&]žŒ†,µ¨ ú®Ü+eR4ó4¢‘Ìè!Í’ÑÅB&êáÞ2À51“QRھʑÑD"c†ìœŒFV2iˆrS… ®d¼^By+ÞȈ·¬ã(VDŸÞ?1 A¤ÖE&º~Ü—W& A¤5&„>˃1ÄÆ]¹·!%=mÄâû"Ó§Y0rHkLó*ÄÖ?Ü7Œ0ôl·Y=" +7D¹©B W0Î,ª,÷%Z÷]ë:óÁ.Ì . ¼˜Û~vI±¼"$”MBÛå…Xˆ^â¼ïÃr/IÉÍÛˆ>"" ¿¶Í±½|3-½…Úî|M±¼B„ÞAm”#b!yDDŽ×wEÜ?Þ4nª¼•ˆ5åHT£/Ä£Ò8f&ó!…•Gê‡àu@êHGº¼± nqyoÕ‡³oÓüys¼Š#©>Íâp:Z@äp-Ôü¥ì r¤£k«œ¡#yOÔ_ßy!Wu„!ÊM2·ê0¦l”àãRÚu•ý#Å!«”¨ûñX*X©¨¾ûÈ -$媷áLE•Ë6m{„aµ\ßf­xÈ -$ÉôÝ9ܨ´QŽŠ‡nTºë;"þnTÚ(7UàJEÛrâ©ÑK>ždH=ˆ·#IÁòÁáÄ#Bëá$ßøn\îpâ!‰t8ÉoÉ.Ë‹ñE:œä¿ çÓIcæ§h¬§“¼ìwmVL€$Òê’Ÿ­®ëæÇ“9¤ã‰îG&@‰Ìp ̼‰0¬§“áaà& 1\Á([N<‘¢•Ç宬&o´®\ß*` ˆÑ–vLK€ nXÚ,%@ 7,mXí•qQϱâ KÛæ±@7,m7Íg!‚–¶Êa‰ÁK[#pÃÒ6¹‰BW,å Ö*Q´l¾®âPö^‡ã©|äv`AY…èÔÄîÀ"$ˆŒÝˆø_€½i¯Õ endstream endobj 3254 0 obj<>stream H‰”×=o[!†áÝ¿‚±‘Ü^¾‘ù:dª»em‡ªI*uêÒß^àä` åõEŠíDºÂ\N»‡Ç;±»>Ý‹ÃáúñîÓ½PÁ‰ãñö>ýùö”þs’‚ÄéÛÎ/1™~Êíi!§”0Ò.¤(ŠÓóîƒÜËcpW§ï»‡ÿ¶=Ð62.‘”îÛG’bÞ H×Ò½é³JÏ£‰:³ÈH¾¯Šó±F‰d£]Œ7n˜ßy”€¨M-íå冪ªK—D²Ý¢Ïâ >¹/âpséÓMz;ŽF–\´T±Ðﯿ˜®Aº:¿ŒÝ¯¯?™°}‘.,÷Êùhã¼ø«Fº6k$BöÞŒtY;!x›‘®ÊèmFúùEµDàU#]t>T-!y›‘`—˜VDnfìDKÄã›êÆ1Ñâ·2鳬-!~E ™®›6•Ÿ§€+²]š3¢%d/}›†´î²S"ZBî Õ•¢%¯±ÃÜΛˆºÈð}1%HÝæûE÷>zœB$žu4bu„®êh²¼‚ÔUM7ëÐ1Η!ðÎ:š4«ƒ tUG“e† ‰«:š&§ƒ sUG;·ó&"ir…Èm:œ[¼J‹¬ ôÂ^¡wYCJ÷eVƒ‚e >¼« )«'ªn&ö’\šŸy‘fH.ŠŒÿ§mÒFdæmˆZ6!ýО£P4RË)8 IË&œ&aÞDœYò‹BÐ6Ö§«Ì†·nó8ne‘Ám]¿âV\xýž.䭸ȇÖn6öR&Ó›†Öˆ¹ÕEÆØ.†ùjÓ¹â m5BؼYT°Ã$Ó|½iH[¡Æ)žGm« çv…¸m2ŒO˜·æË…ÝB#æênÑ–ùÕ i«»EÛåOâ–YØ úpÞ.,·]„\9=É û6{|2·r|J—Ê®;wf gùüâ0Xîe iå¥ÆùGhååÆ/*$mC‘ךJ‚ýó”]ˆ—§+¦Ž«0Ú: Ã@Þ*Œ¶{$®ÂhÃÏQAw†Ñ¶YWa´Ý9 i«0Ú(ÃBÞ*Œn~çQDÛFå† qÛ`¨ï+kôyÝ-®ŸžDÙ8òçcúÍn!q˜¥¥ëY÷<–Š…æ9‰c—§b!ƒ™Š§¾+÷ÊPtzžF)jH³PÐRzQÃWjü¼ ñKRHJÓW9)˜¥=dçR¯HñqˆrC…ümR(߻ҽ/EÅ_oè­Ü endstream endobj 3255 0 obj<>stream H‰”×;o1†á~…Ë -Ž/Ç7)›BAA·å¶P – QÑðÛñx2³>¾(R²J¢×Ö¬Ÿ=3w¿/wWõ ¾«ûË¥~P×Ëõæüõðá|øðé½:ÜŸŸÔÃÃý§÷Ÿ”A=>¾{ª¿~w®9eÕùË!é’•©_í…7A[‹ò6ëä©óõp÷ëóO¡‘®_~ŒÝoÏÏ?„pBÂÉj£ãas 1ëçí ´É]lô¼ýh°ç‚tƒÕ%ež-qM‰FÒ¦„Ä«êí|¯É"Ù4¥‡ë;: ê)󉆨´UTc½í m -º9¡H½ I¿’|˜¤¯)q¯ Cü’Ñ9ä!,žä„è[…¤üš.$¢N¡ û3¯±Æe<›!z9jrÁ¿"‹ÐkJràU) Ñ{AâJÑ#¹9ÉH2¢qGÂV'I†ðm“„ue#·M6G"_¼›·û$amÑI†ü½L–MÂf!|Û$aUñ8Cø¶I¯ï4Zzû$aQa«’·!Éõms.¶(#'õCN꺾œ¯‡ lV¬±|AÑJ .VÊØ•­a³Rÿ•…ͱ›jsÞF®Vƶh¥@+Ù:Þuv^…6,«JX dpÁ’íp,ˆÀK¢ó­’îXŒö–î–k§"H!ƒÈì¤t«IRÈ@oRà.$p’<ñ®9ºRßá0o#É]?ñÊضõF/M’®ƒexW}šW!‚‰´+õA”Uçid ‚m°øa¯S+d€Á&Šóp¸Q©·ãõ±'ýc®`V,óf¥_N<Ó2¸[é»âT! !ܧJ®S¥ÞîåùѳÄÛTéÛÒT! !ܧJßµóƒb!~ûTé«ÂT! ùÛ§ »Àó(Âï6Uú¨´UÈßF%Úåá'ÿ=UN æJ¿œHÅAw*}W¦â ƒ)èh–ã܇ÍÑ»XæcÅ! ›W§&K‹R$°I²®Ì£¿¥Þ©±ªÅAþ”ú¡Ï/ï<Šè[¡ä!*mâ·A©—7tP–™r¹Ü¯R®Â"ˆÆæÃÄÂW‘}@îyìÊ><¯’èx¸úˆ¡ÐˆGì­£$zÞxÞzÏų4}>!©k@BâU ˆ‡Üµ{®å,³ë;"êV 4D¥­Bì6 d—‡žÒM’•Çòêª3óÅë ©ï [M„â!€mŒÝÿ@¶”ú¡ÈÂöXbçnÚ&á:I–OѾ-B! %ˆ†‹ai~ühñ§þ0Å˱’ endstream endobj 3256 0 obj<>stream H‰”×;oÛ0†áÝ¿‚c¤4o‡ÀöËÐ!›F¯íPÔIN]úÛKJ¦DªÐé'h‚})Èç1ɧ—gqxÇaPB‹áÛ!È…ÊÆ_œwR+å„qZ&c’n‡Oâ³x¾^‡Ãë[þÿÇáEœNÇ·ç//Â9+.—§ÿeIí*«¶£ˆ’"iCZE¹G%¤ê¥Jù§±FÚ½‰ÓY¼‹ëõ˜ÿ>‰³†Ö°ùɵò©_äÇÇÇO&°-?̾pDÂAÉHq¾hÅt2*ɤCÜÑ%…t—Òêy¹9&dG&îÈ$½t†ìŽ,¢n©¯rQH]õaŒ ÆV‹Ž3ǃ‚ fß_1YH݈c•åm„.h©½7]W?zåùí4Ânâám—æu@ê\dûÏP›¸õ¹lC%§»*7ÃWvŽºèö¾ámӾѿSî1!jU…¶R«§çYœÎñçúé]œ…º>0ë ú&F÷ ±6Rµjk³]…Ü'M,ßÈ`5@ð Oë÷°EÜ‘2Ä|¸C£¼ªDYIµy?[&Ë>rå߶WCLŽV´ýrìLÈ`±’Ö]~# ‚%:]W=g’·ÛiÄḑ˜UšÝHD°0‰fõ‰Zf !|ó%¤­r[I€ôÍ—îýnF#‚o¹„´QæQ#¤ïE'›?6kšSÖÝIáq¼^ËÎ2Záv–ˆØœµtk²Z"¤°j麼–1¼kéºùÛ?CÚÀˆ@¬Zº4«%B«–®Ë|ýGÈ`ÕÒU9-BXµôïw;ŠœµtQæQd°j‰.ßsîÑÆi’QÌd9ÜÅ$!,§Ó—£~%~–„o<~©}aH_P2’_…ÙQN¾ébB»º<çe °êrÃœ y³8 Ñ‹^:cÒŽ,BoTï³\²W•äCh¾öØFI‹äÌ(!…p\”´+±ÃL â7+Ù†øÍJÚ07ͤ}‹¼ 雕´]fîòDíRg!|³8‹à[”´Y® Ù«J<•kkN^çåäµ½"qÒ.Âϱ†äÍ@v„!y36̲Fà-@ð.oÒv¹‘Ó»œ…ÜÍ@à,ânÒf¹*Ä®!*÷ ä ÑÂH»w! Á}¬»¬ñW€M‡­0 endstream endobj 3257 0 obj<>stream H‰”×½nÛ0†áÝWÁ±E[šÿ‡ù:dÓ5t(ê$÷?•¢Dš"àƒÉ`^ Êy| o”¸^Ÿ__Äéy9—E -–?'’) •ËKZê`£ÐÞKo¬ËíôMýT*åŸïËßÓÛrz{Ï‘óò*.—óûËïWáÚN%™ôؾj%w ÒõA:íéØu£‰'Ur鿘kuH6yéˆÆûû8ê¨W^Zo,w©©†|ò«v^&c}‰ÞÄåIÜÄñÁÔ ´|ÍZ™tÌÿûüüb ÛüBq.œ JFï†0;¾!·³˜êBÜ\äýÐå&ØBÚ Œñþ²YÈ[̈¶YÄ[¡õ±ÊE!oU† ÒÖè Ã"î6ëèóü[ˆ\‘Asaˆ\‘a‡0?Áˆ¸M†™é:H\‘á†.7kWdŒ÷—ÍBàV:ÑD·-äŽY® y«4L¾Å&Ïû¾4v—§kþË gÄ!7#AÏáGÙAøV#ÑÌ…!|ÅH4Ç0?ˈ½Íé™.d¯IC—›:ÑËFòÚŸÉBôÊöÈ£ƒgzÛöpÃ?«BòªM2»Q]ƒ‘s Bñn¤?‡eákF&¾f¤³³ì{w#x²×Œô]vê zÍš ½fÎ"ôîFú,W…äU#ŠÖ'Ú÷Èæ£@ù*PÊGfîr“Bt<è,Rì\"X¤¤!ÌNt@nRb˜éBW)A ×ËΰH±a" ,RÖoN4KÀMŠ†š«Bþv)‰ÖœØ ¬>2 å¶}||¢²AéãÇ™ €ÕÉDòW™ô]vš Ñ×”àY_EÒgÙ©ƒèU#p’W‰ÀU^ÒW™h„Øí@b\sb¿IŽ‹„Û#¡ØxôGñc!v•ÇDbWyô]vŽ#¢®ñÀ³ºÊ£Ïr#!t•\…ÐUpA×xôU. ™ÛyP\ŸpR¿?ŽëƒÛ ØxôGñcœ v•ÇDbWyô]vŽ¢®ñÀ³ºÊ£Ïr#— t•\…ÐUpA×xôÕcTü`n v endstream endobj 1 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 2 0 obj<>stream H‰”×MoÇà;Å%Yö÷ ò`Qrp"@tÃÞ ÙpR”u”ƒ{ªkv{º[êâ;0 ~ ñv{·ž­*µüv¥—ß—«ë¿~PËo_®¼[¢_âÖ–àÜê–?>^ýze•ZcêžÙÕ]Z»†0{Â:¤î*¿ž<£Ó§©.˜Ù“äV;{è•^Õ,Ó»ÚÙÿ£wå7QçU¹Å…\þ’ÿ¨}ªrùûÉÓ󚄧j5ó§I­aþ4jáV!héV^K·rFº•5Ò­èån¥­t+e…[ùì„[y*€ù­<½½ó[ùà…[yï¥[¹ ÝÊéV&J·ÒQº•ŠÂ­\N­\J­\”ª½üz~+ç¥jw^ªvç¤jwVªvg¤jwZªv§¤j·Yªv›¤j·Qªv¤j·^ªvë¤j·Vªvk¤j·Zªv«¤j7Yªv“¤j7Qªv¤j7^ªvã¤j7VªvCŸüÔgO©=z3{ªé³=ÏŸÒ§wÓ§Á”Ž5{êÍêæOéÓ;ÍŸR×6ó§zúRhUÆ‚ÉCúhž¾JɯÓW»î7Ï®ïï–7o®zû·»E-··?Þ½]®~¼§ßß«E/÷¿^©åþztÿ_úg¹ÿB—+_ÿW~õÇ×Liôãꩃ›2Ü?\½xXÞÜ,OËõé´<–o?/77·ËÃòÃöã}óyyyÿï«w÷Wï~¢ƒÛÛèïÞ¦?ÐÒt£µõí¡ÿùôéijP[¾d<Ô"¡QQ¥ø.ôV«i¦2MCÙd0Ó#™ÔccÝ=—¿L#ܪUv`dD"SX©Ke02‘žJÉfÚÈybFYu¼h”þŽ‡žÃs¾sÆ¡=U¬] 1«"ð\HZEÑæJ%¬k» 8âVi´±BÙi\Õ¦Bæ*4a·iS…P^a²]uÃdÚ5žc‚À¬LºSå¾ñ»09 ñ»0ér¥z6ˆ¾Ê…ô]˜t±Béß… œ á»0S|•I—*„Bö˜ í@Þ(ó-“CJ ârWÒ*W3¤¯*s-¤¯*is¥r¶¾]  á«JÚX¡ò,d¯*AS!{U šŠØÛ•´©B(D•DKoÙ9P‘†‡å·’Ûeû©˜)ß=ÎCHnB”í”+’ÇBÂûõã—y,Œ±â‚¸sZ­Æ$?¼ì¯UôÄ| Ùc$4štÑBá9ˆ^Lkt.õ©qš Á+D ½ ðMx^Ç5©0ÜTM3!v,„>'¬¡Ê­[É#£xjç­WÛôͼ•8DåEçŠP¡ÄC¹@–b‡\Q pk%Oõ?Fâ†Ë ¥ç!zÜI" Éc%¥õ£©ˆ=n$)¯« Ñc&Þ•5ÇqàŸ'’r³¨ÓË:s=U)ç.3/<àô¹êµÒ&ç4ÏFà9­V£“þ&Û¤œÃ<ÒGo¨ã±¶ÍöóPÈ^L”• ÑË~u¡”s÷*ÌCy^Ç5&Z¹ÐP^1âs,ëN<·“Kó(MåórÃJöóY¨>Dem%Ý©âG>ýù‘^r$rxi&]°ô©¯5â°v“¹ÁK;ér…h­!~—~‚ÇB/ EÖŽÒÅJ©Aæ’bÙ{'–6Â.„.¢‰Å…Ê45uñÏ”/®¸ˆ^ 6¸âÂëáÆbýÄ»(-ò@.ä­¸ðfÈ•*Í@ÜÈ…Êãë+ÆBÜŠ ýX„»ˆqxÓ¤TH»ˆ±¬9[âéÅ{jÛõž¾>Ð RšÊ©4˜"æ†ПЃú½p „çÖ[h8ì®òøIˆ…hA9ë±Ì2‡%údêbiV²4+¹i¶Elòf­³©ñæ4Ÿn,äÓëÒh‡l-¤B:£[-ÝnH^g™Ä’îjç¡MžÄr߸y(“ …TÖŸÌEÄÀibéë¼:-Bš-Ú_»;IEo!¢6­J•vÇBD‹¥\¦Ê6–,yz£Ì<qÊ–hD³u ˜×§ƒœKÙÙf^KZ,•ZîRµž§BB‹¥¬†»ÎF‡-–’*cO÷âÎC! lÉ—ÍNŸ»Ñ@¥BÙÉÍÇ!€÷Ŧ9X³±î5x.$±®5M®8e9Dâ¾ÕÀ±ºÔ4±Ò4ä!~u§AS!~u¥AS~ûFÓ¤J¡?–âòªÏ¾û绿Ÿ[Í?îî$¡¸¯5Í!rõzH[Ýjš\©xȯ4ôÁÕ¦ŠÅëjÜAtð]¬zmÍnþùé!nÅ…+³H-Ö¤ˆÉ¦OµóOåaãFYøªÁ¶ c¶On Qc6Ó‚¤Ï,6 EÅÈüÄÝ΢=Ev oÕE,Á· £eÜ.£ÍU¯Ó9ÌÇô©«4Úl±à qÕFkæÃU€ÄUèe#bn×ѽ¾óPˆó0Üç·À³‰Óéú¹¦/V›lèc¥Tˆ!‹Qº,8ƒ˜W£˜2„=+aº‰¡u¦;XhFAÙKØÆŠ^Œ‚ FÊ .õÁêµ 9;7ÏF,nfÆlÉŒQE¯©ÝÒªÔåºiç2 ’HdTvÃ;'Ô¶QÄìWi‚ïb§‹QˆCí*]bXÀ¸¬ËÎãz0ïþõ~$SÆ2Ò—›EÑ“ùÑˆÕ 5íîøgêòÈpÜ¡` ‰,&¨!X,n€ÜÐЧñ\ci4A÷•Ê[C¹Ñ¸p ÂÈ&ê±Æ­Ñ„ÔÇJ©Fv“tÙ†¶Ä²®ô“I)¿Üf³ó6#‹pÝÌ”Òn~¦´!ŒlF †0òp†`±¶ bq3ãÑ\È"gq¸¯T…¢ÈfT8 Q܆3} ¡¸™1©•R!‰l&š²ùÎÌ>›m`JŸa0‰ˆÒºËt§ÊUm ‡—]æH0äð²ËtÁrY# ë.ƒçZˆáe—ér¥´ÂË.ƒÇB /» ‹(¬»L+¥B™K0e; —v2ÛÀ”]†§2áL„è>“µçÊum!‰u&; I¬3Y,6qŸÉð\bÉÚ\©ä°Îdp,ä°Îdp,âpŸÉÚX)bÈ`¼-ÛQhw™?¿=ÿ[¶–ÿS^o»qG€ŸÀï°—ŠLú|H‚Ä™°ä ˆ7— DK.ä?{ªªwg§[èÒ?†!ñ¤š3õMU=×ç°€Ød'¦F×_\È3Éqø5t&ò—iiŒô»uÁæÆ[«Ÿg#…Š¡ß¯ËV©ˆ`¤á#%ßçZ3O…’S¸lSµ’ŽÀ—¸¤»<Eø‰“ä†Pí¨>qf’ÃpV%±m^rõホ†fÈž(q÷Ÿ"¿ÜŸ á™ë®}4¯»Œxl; ¿‘¶WSë9CþdEsõf’!€ %Qóî‚ϳ×JF¶5…׉m¶ÚL2žg°ÜY·¹e Éã^RÝpX­—dˆž ‰ãý‡"ò¤—äñ¡iG…è‰xé©’xñÁ?}_HA,6!6öWR…Hžsu!¢'BLéƒIˆ)4oͳ}Mˆ©}¶*¤@òDó6×ÍC!v"ćՄÞÚFºû;EØ5!ãCÓŽ ¹!\À—Ä'ÁÓÖ<±×–ZûtUE…´É2æê**ÄM–êú`RáèטA×–êûlUE…´‰ ;<Â4…¨‰ 3VSQ!l¢Â÷wŠPk;Èøд£BÖX…§óFç$ðøìtøQ†ªç¶1¿Â®µ _»‹<}RR!rÒ0|tU†79é.t¹æÆšXËt òA×ÚÅ­¹ðò&KGp]¬óóPÛ¥[lCÞ@Ú.Í¢;ê<¡¶öŠm¦vPˆš (‘v˜oQœÅ|ŽòQwE±¹ˆÖ0¼¬5}ìwT@ÚD½Ï¶¹Ô.|QÖ opM­ŒÛhU……°I·ˆýSœ.ÞBÒE誡°5A‘‡{;ÏD 5ÃóÒ I9ÑÎâ¬$žÖùéöî'rq«Â°ˆ¼#ùþBz [HœÐpû‚!sÙ,%–!X¯`Ä\ƒ‘÷ä:\HKŽuÈÕÊØAà‡5Tjx,d®còŽX)!ô±Z*ÄN„$º¿îlŽ…\{‡¶ix‡¼öíUÔÆá vkãØæê:ÄníÛ`nYk‘wmÛl]$oíÛÜéZä=ÄnmÛP­=ÄníÝý‡"è®ícª2':b¦Ýå²à:<âï¬c¸ŠªÃCêÖec›«ëð»uÛØ“G[Rpˆ¼óºûlU‡‡Ô‰.ämnœ‡BäD‡«é:Ñ‘Æû;EÈ5ãCÓŽ ™!óãÏ:hž¢eCF+´~”aë¤\aØ”Ü_L/æé%a_0Ä'¬d†`µ’¢¯ ©iO.$'¬d‡óªÅ Á“ +¤±=™°²Åc#B¯MX©ô±Z*dO”p¡]¯ýãÒK~—^½E)¼ˆ˜lTòpEµŸDˆ Hsu)"(ý„ßwÛ`ê')×Rçو¦eÌVµDH¡ôÞŸ¶¹Êa!‚ÒOrìCÕ¢†r?)f¼¿óP`ë'ãUŽš "ÅÞnÂFÊïg)O«”Ö\æWC\^¥l¯¨JIÀUÊ6W—’ ‚«”m°¹±6Ò¤7ÏF^¥l³U) íRsq}®MóTÈŸP¡JíR5* (£W)à ž‡"þ•0„jG… [xÕ‰’x:<"/V"Ï¥¡ðßJåef£B¯ÜîŠzIgÈ X±û‚!„<Å<«õœƒW'x.äç¯X†ój!~2Ù°#ò'ómIx,â¯Í_´…v±Z*P¨Ðs³—Dî*/dþbwg"ÜQt*ÌF…7ŠíŸ>Íc $P ðßÆêP $PšŠw}°¹¡×{ qž lX¼ï³U,B(M%ö±!ÏC!ÒSÜðà´š.@é)4Uv±nŠøk=Å¡ÚQ!~ ÅÕÊ«O’Äw¿¾–ÂYPæW@(2q»«¨8 sŒ#S‹ïbuRÇ8èÙu¹´š[ë|Ú¯ˆ;±aÒpÃU2Ç«‰¡WU—;¯· c<Òv¡š ‘ÃÝG"ÜDFž˜vNˆ›À(•7–xÿû·‡k¹½û‰šÈ-9_Ò7äû'ùº|È?4?‚SúŠµµ?Çwj2ÙÖ•!X3Y!“<€¥<Ü7­¾ƒAHkç¨j»\s2½¼§&ƒLò–èmÚe+e D2‡ÅóôÜÅú2O…L¶Ìî8,b2Ú¼“úT;Ï„P6?†×Ÿ,?¿y3ðy:ܘ—ÇãáÏ£|»éá4<Á €Ïx†C¨xèŠãÙ ©>~Öù ,¥í8·#ÖB*ENŽ«£…@Êú’w¤BEN;bm{©Ã½ÕR!b‡ªö¡ÒÞu$寯^¿W¦±`–mU¡íâõâµ7™Çò¾`ˆ«ˆ~ÖËÑÖöäBÚ˜E ÃyµJs6YUrØ ic4ÙîˆE¸µe…­.VK…´‰‹dyýi‰–°ïÁpˆ¹+Œm¾^¿·ÂØ ‰[alƒÕv¸+ <·ÂØ檥y[a ±ò¶Â€coWÛX-â&0¢åõ§Jây3¹£qJxœ(AØæ*W»ëéõì!2W¥}Á@™«Ü¬´G¶¹ŠÆ¹@¬üp^µô 2X%·#ò'“UÉxl@üµÉª„>VK…ø ”`y®ëdõõpÿÏÞFH m"_wCûÇñø’ ”ççM¤öÖ ;@Û&²/¢Ø6‘!X­ì€H9þÀ'3‡vq™¢ßEú§üß1èÞ¸…dÐípnI‰º¨ÜcÝF„4ûHc Ïs{’!Ω,ÉÓ¯×'«<"Â9˜¼¤Ó®`ȳŒti<±VugéÆg§¥Bš¥QÙñÁi±ˆæhüb½¯ñXH³È³ž#C/ﮣw|ößÿœy}yüðt8ɇ<ø5G>~þ ß·‘Oõþùe@$qÓc&äquF·!šÇ ¼:Û“ ^uÉ*‡„¾:Û ^uÁJ%ˆïÅœ é]Á±ß«38âËÎlõK¹D>©‡_îÇí™w¶“ø9­ìi…Æ*ç§@´·±'yú4ÍNkñ}¬N(C83m¯™pvÁæÆÐÎPÃ<áنĜúlQ†tÒ"QK }®õóTˆf›ûP­*3$³Æ…†¾þîÎ#–m¡îªvN¥è)³$þëo‡ßþÍÿßñ …¿t|öúç·ïöðÅòjuþÔ¾8úôî ŸŸ=Ú›G'ß?þÀÿìÒ­¾ØöƒóÓ"Ö×fesXbð¥=¬?>|V‚!¾Ü«½òv0;㙢 &gô²¨ežÖ,ôšÎßd»RkœgC†©0‚)CöœZç²d— ùeiÔ×ú›0ÏDôF›—\B„C!¿BÞ6•Þ±øçEÑá‹`Ó|D³t!C“w½Š!w܆ʾ\ˆ½xè®Ï¥ 6ó¢¨;¡áBü&XgW!vLÃæ!ÛÎC!oLÃ'8âÆ2r(ÃM˜‡"Ü„Fõ…¼ Hýíø÷WïÞ~{ä&ô(=H¾°z9ð¿Ã—ã_¤ýl¿-_WfE°žç¹ÚŸJ­ø •n_.$”ûLñÃ]¤‚/¦¥à¥‚ÉÓV4f{£ô™h ¨2Ó•!ÛÖy*D”5ñÊ×¥Nß)Ñ@D™S‰n¸ óPÄ(s¢Ñk¼·óPȨp 4Ò„ y¯îß¾9|lSÝÇi­ýŸòºém"ÂüWöŽXüý!ÑJEp€‚ZÄ)gÄaÓrèÿžñ†ØŽÆ¼¹TÙÍê]Çõã—®2Ô,5¯˜-a¯ r\dnŠ…ÄqF»`KM’Ï9ÈѺڀ•³ËíK´¸w{™ã"£úhѱ×5n¿R?Q΄¤q÷Eg½v äLZí¾‚F3!gL–¿#‰ãùãiyæR²_/œÊýgyjÄ$¡Q9¤nÓÕ­!‹„&†xC,d‘Ñt¡´ß—s…“ƒ•ŒñcôœŒ†4ò‘Å÷Ñ2C&ãºHyÓ0Bcú… ¯nƒ(¬b 0RÈbJ°R5ïñðóðøta4`ÎOÐíËÕ6iƼAðZeÖ©iÒaMÉYÏ2]æBi˨äÜ ±d?ÖôÁ´ÎKOiälĦÓn Þ§«ì`²Ü7H'ÊÃ|Ȇ ä²–>S.;rɈÂ8b¨EdVEÞ¡Mf¤âj’µB¦m™EÀî&öo›®e éûWbð\ß^cÚÔÿV‹è»™1;M³!}t` ~ÈÖ“T¡ý¢M•‘X^­4Ã,È™¼jDS+†:Éq ç¼ßž–ßzyÕÅE½0Ë«YÞßÝÓí;º|w<ÖïË}ùõÑzžI±Ât};È#ŸgnŠ…8›Xº—6vw#W‡ˆd7Æù1:Úò;ähˆ$±‰ÑuÑf²n ‹¤ÆzÓ…Ê%ÐA Í0ÎÉ0‡l&fB‰LJ«Jeú)ïËááÓÏ×ÍÙ~[Þœ?žäè­•KišÚ×O×µ‡2—!v{yù3É…r™Q©Ë¥ÃŒËÙËÑÅÒ*­Y«ÜEßk51ĺ0]¶6V>uxÈ_p¥9ÐýP—·“‘B+–anåL /ËËÆáÿ5(D¸”ÝÂ¥²±Pà×ß—_½l¦?ÌÔ'6Íg™ýÂÌŽ2q[ñØ~0S<2ÉxnŠ…L²àºXª5vVk²öh)_EçY‹ –ìG÷ÑrYI.5ªŸ Ùd€Lr–M—9ùíˆÈÚŸÅØOk›ùW€jºœž endstream endobj 3 0 obj<>/ProcSet[/PDF/Text]/ExtGState<>>>/Type/Page>> endobj 4 0 obj<>stream H‰”×]oTGà{ÿŠ¾$Rrèï #$›–Y)R&d³»pVZÈE~ûV×›Ó Uû®°™cÞ)ŸéçT•5o/œù§¹xøüµ5o?\¤hBŠ‹Æ.-›ÓR²ùý׋›‹`íRêt9.õ|5„%gñjÎËÑ÷W£M‹ø_cŒJpÌ^¼TãīɺŊ±É‡%ˆ¿+½J/×MÌ­ÿ(ÿÌöªmK¯æÖ–ª\µým¥«Õ.Y¾ZœRUÎN«*9­ªèµª‚ת¢û©Tå‚V• JU©E¥ªDg@®*•¤T•èìËU¥”´ªbÖª Y«Ê­*W´ªlQªŠ­*UÅZ•ªbÑN{Y®*&í´Ç¤öµÓƒvÚ£×N{tÚiV;í¡i§=Tí´‡¢öµÓ~~ }qõáá™yôèáõÓÏŒ5ÿ쩹øþ@¯¬qæpsaÍáïtéðúË>gû×?úK¿›²4J£?üMÊ‹£§›ïOÏû‹W»—Ï?˜ãƒë'{scNÇoÌ¥9¿x2ßþu±;\ì®é·e¸¯–1¾S ¿³ax·O¿~3=’ú—1ót{û›PzªºLw~j¿µ>µ–¥ÜäFêÍù´Í}ì¬XkB2éó‹.†m¦XdF©óÙ†"Íwb‰lôl-y¼ŸR`¤PÆH.±!‰¬€žÅ[·up¢ÓoÍ£ËÇüÝO?˾.ñkrßJCà Y¬`ŽU8HCHyÌ% 1´ÅhÄØjaŽÖ48ˆ 5­”8Æ:/†BƘDšˆ‚ÂAÐXEî­‰@[]L¿¼R&d­ËÈ-,î+2^ÿí©yoü¯§yùÚüÃüÛ\—óOÑ?è'Ä ›ŒÆÑU¨²ØÑ´9VEã!ŒMqÓM#4ŽÐT1ñÈh<Ñ¢54²Ø{ˆSÅ¢oA$3Îú©TÅŒ‡$v35M©"8d4u¾©J¡DVC“aòvíOO®®h¨:?.4U}$oÍGš­NŒåË$±÷™ó˜ìŠ 9,u)q mb&äÅôÓ=Ü1QØ·ÒÒZA3!… †–¥v—GÈœ¸¿ì»’òŠÕôW:¨ýÙOÿž.Él‚–Ùx †:6Âêb­-x*„±«©ý¬lS{—ÉJ—‰ÈèìâC¬s´Ï®e'FC ¹Ó”6F‹j"D±Ä%Ø2'߈"³‰qºb&B±³©Ö74¢Èl¨×oçý¹û‘Y<:³8÷œ?÷çv#¾¢tÝ_úç·}Kå,Gȯ/eúE´Æ!xÜX(mˆ%"ÙÓÜ'F#ú˜ˆ÷mŽöζ,ž¼éã &Õ1Z>Î rGF|£‡û*ÂK<^`ìT©xžâŽ[Kmóg&fBîØHŠ}%Š«‘»ÞÑ‘ÔHBH~6²}KÅH‚äÝÙ¦ªÛJ‚ìu$t³ÇÜÿ…$!þx[qs´¶­$È©~Œu☔!utÜlKÓ‡¦¬+bÇBjJ3u¼®”8e*…Bì˜HìãÏ9pB3غ™‹Ï eonÍ %#.W(TßðÆ ” ñc($N…ø1“âÇTbR©£¼¤PÊíZmr2¥Ðš0$Ë­$Cü¸•¸é¸¸,…ˆ_‡’ëT©øØ/¾µ•ÐïfBøØIH}ëI÷NÎíã ’(ˆÃ•DŸê·ï¡>å D­£(uÊÕ&¬Y+v©iŽÕžðÁ¶NW”6ĶH»M£!l1/%Ñ68D+ÏùA+u)L©bG*³J«’ë ¬´"Ð=X¦[+fBÐ…O}§¹GáWæÓBí㣹¤¿?±wæ’ɹ­Ðëëwïä_ qÉn|hcÊC¿BC]¬ O…,öVRi1RéyOϪ"ÎñÈpBïRctŽµY92Ù{I³StûÒH½$𨼠"œ a콤¦©R/f";›jC3D‘Ù¸Üלü™Í8t6c×ñøfáË7æ ]z£¶›†Èý¼ªlËPxƒ0Þ¯*ÛT­Ù4HcwSh#b©+оXÅ™¦!$׆ãÛí}iY<â "É3íKC´<ƒ5#Ï`!M¡â´Ø Œ¼¬Ø©R±54Äâ:ƒµù33!‹ìÆæ¾ü”y[{ÍG¦1ö™Š³W¶âbßZ±â,D°cár«a¡ùÖB ÈÛµDjÿr6"‘7–ÜÂœí‚mâÁv’عÔ)YÖâ,dÛŒî…"-¥°—:Ý91¸Žg9Á¡Â&µÒ— ò•ùlOfæ}½›ÑîºÎžþÕ¯ñÿxÅ—äb½ë¤æÒXÆÈA:yT£´!V]œœƒ|²#z0 ÁöÛà\Kâàb4Ú¶¢!Y[žœƒtò¤æꘛ¢œ ÁÌ‘Fê¦Cª²Ž8Ñ숚Ÿb•ûŠÈLtÆB­S¨V*d“ÕÒצʉ/W/^¨¿<Ùïw/Ÿ™“3'ßg3j8÷WéÅãçŸ=yžÜäZÒk3¢§ûPÚ5¤“»Ñÿ•ë!ž÷Š¶¹Ô’oMþ´="”»Qñé‹ìLo(GC@¹e?F+ÃC@K]J Ó͇7ç!Ÿ¼õø:†9ѹ®=ôÔo­ édG¥ô=Jtd~zó3)ùep´®>æG(¯|ÚT†Ö„<¤’õÐô2Äêz •]Oí=s›K'œð4q=¡i ]}Bt_d»Ø”a.@2风¾LÙòAIÖ“¦›!“ IÖãtäP„䪇>a4"ÉzríÛT›·Ÿ>Éõ­çÕy:On<Å]ž'ºWÚ&À«žÔÆ24=BÉzÒôÛ©z¤’{OW¹Í¥mÅæVå©( 2W=¶}‘ÝaÊÍ'B2×U¨ŽÙ^>é2É»P–lS•–!”ë.4Õ*õˆ \—¡2pr(„’ý$z†ÐpqÇg³å°»ígÃê¼ 1+¹DðʧŸÇMšž¡d=%á©É’–ìšR©9«ŒVQ¹Ê srˆ±E¹CDåýÔ¶‰vr½ ÒÈnúж õòaLFn;nº r&BqUÓ š Id4±-îœw|p½»&+›±íôWv?Þ÷úVm9 QËf<ÙmÚéNÄPËŸé&õt{û›’ Yäy-Œ·¬T™>9m[³ÙD?vV©ÒØ'µÆŠ•R!†9Òs.Ž¥šïäJ3ä°“ieº·r&Â0Ñé mú¼´B!‡l&4ڛܚxG¦«èdîºÌ^ã‘ŸÌÃÒï§ùȺÞSjµáXˆ]ç‘‹cÉG¥L>t¡ÇmÅõ§ß˜œmÉËÙ½ÞW í¸C¶r*D‹ovúì¼r |I.S­²“‚ØãÖR³ƒC!|ìÄÓcí.ðj÷òùá¾þºÛ_½xúä°3ï¹³\ÒWùÍ”+[Æ7TwŒd)s®ÞJ D­Œ±$Å'Ú/ädD!w’éΫ¤@þz#q®¹J©<ê$¶¹©X­•H/-qº¹r&âŽ[Ét ”:+Änbi¢Q±'òxE3Ø“½¹1'’ñh´ŽöæÖÜèKJET®KŠ›ÞW{ôWÈo)ýa·ÕT`_TlËc0I¡‘Kžü+B¡xÇh•J…òšâý˜ëd+ÈVú©Ù¦jV*D7?Å:9ø_Êën7Ž"ˆððs‡‘–MÿÿHÉ"N‚d™5ö —$7AÊýöTUïÚÓ ]œ½b׬ÎvfæÛ:Õ°”!T;*DP¸P åÇK"—,¦ñ$0Nµk½Xׯ{ib_u1QÚFK¾ZS!ˆ2Y¸ÚmcÕ‰U!‰2XÌ6—ÁäZæb*‚QJ˜svÌv´8¤y±©F)a±¶Ê!ŠÒÁ\R•£Be¾ ™óH„ak`eøçÏgV… cyõñ›Me½¸:®oß.vytÇ)s\bì²®oNoœò,"b¾TÛChϸ3I±s^.dRì”>ÖìèO5‡y4²Ñ1qÌödu¾¿8±:>ôÙ~:pxæ¡vìðÍ÷þÇ¡ûKÎ:}ÐA@÷— ‡B$YO¨–¢ ï~¾y¸þUÚèr9þa}ýУ¥ÿ±}Ïœ Ý<ùÚKEÎ@L…“·x¬…”Š¦PúXšDÕÓà›g#R…¯pC¶ ±æ2φ¨ 'RÝeÏû?o §’‡{gý<B*œâxÖy(b´q¢m …Œ §by}ú§×…çri¯_àlVÍEH·å‡JFwõA‡XÊò“ò±KöC÷¡¥gœÚV™?7±)~<ý: ÙôÓXÓ´tqõC÷_úl7 RI~¼±Ã½³J*¤Rª\Î:§î”â§æáÆ͇¼ƒPŠŸìxŸŠ]™{0Ç*Ǜϛu=µ¸ùcè¸ M¾\{ºdQÐßÇ>~ùò· i6>öÁ4v¨iÕy{qÉ`*ÝPŸúìiNs=Ä‘înpq8óü°r˜·ïá°Ë÷ÊY!ˆL¦ä!v^¶<â0ÒCæËxaµ£BÅLr¼Q%I¼¹¾}ÿð{Ûårzí–KÞhì¼» O¿ý|Ø;z5?·•6¾·Ûƒh~<Äò´u±ºÁlµ­Ï5»`lõófåšÂÇѺH¥¶XúÜ8 2I|¨ª÷Mã •2qÆë«œ1)|²Bµ£B(…Oô¼R!|îeø8åˆaæcj­ýA4>RÉ|rþ}:Ÿ¹d>‘Ü.˜ýxÚ{æÙMñcJì³U@rù²ñlsã¼ñˆ%’g›ªŠKdJ;•(¥!T;*ÄRÏKT~élëÅÓîêþþ—Ÿ¸œñ^#¥íÔæNsHÝv"·7Z5ºhr"RŠ›µgÄB ¥¶QuìbÝ®VüGĤl;|Ѻl»‹©æ4ïå2ò>ú2\§ÅB$iÝqR·±Y¹Éj÷ÆóµM óe2!"£õ{ª.ïüç#A$÷¼AµÄ«›ÚmÖ‹«ÃášFÍiÈ°žö¿è/¼÷ß(“'!zÛäɱ?ÄóŸ_•\È¥Œžór!˜RÜø‡q›kv6Ñ2çÙˆNd©ÊÙžž;eN$H'OŸ”†l¯œrÉ€ õÇ.ÕÍwª±äᓬ®Ã<QmÞgºGhh†P x›*í'zùᥴµÎ&Ãèúfùë8‡æ߈€m‹Žóý·ê•*CL9/’˜Í¾Ä0«}*#ÛžãÏÊ…†´Ï1¹Z£Ê@ÙtÆë«ÆBKÚgò±A©jÅ„>VK… x{ª§iãdÜp#û(BÚëOËçשãèëú´<ïå³—'ùܧåyýNL}^¿™­ ’[‹Ãñ´ÂU ®ÒãøáßÆêª ÄUšœ}0ÍŠ˜«Òä "Vd9ŸúlUVÄò ¢Ÿ‚>7ΧE¼,k†+¬(WžAe¸óiY« •ë3µƒBRÅ?½ƒ)Rq*jn¹“·ÿʼnþ#»ãW “r"D¹Pr~8•F©BB}Ù™|ÛXR…Œ2¥Â}}lvΗšæ+oE˜ %O›n—­RªQ¦T}èsøÊ”ìpã4JÊ”êpÔùæVžB©ö‘Ú9!ž,ÉÓa£s=¤Ç—õGà46Oz›«ÞÖæBî¾V•ä¡Ã­|›ª­>Þ@sÜ'Cerkv&ÕZçɈ@Y|hó’©vÐÊ2†2”úCÛ2…ôñÚSmítŽyá“­§—wž‰Ð“¥§äŒfBô„I‰TŽL‡ëÛ·28.—ßÿ+í%–ã_ç_ŠØl3…>ºýbý‘†üÉL9+(…nbIJ¡_…ù£g„Bŧ0D;K¿›óÐB ¥žÕ>ÚM¨½…üºÅýãì<ò'å, až‰ðc*Ÿ‚fBü„JN´A9+7×·ï>ãKâA^Žod÷q¼Éú³ùÐü ˆÙ6g¨¤v‡Q»“·K5á¼`Hf6û’̬'ošRÈ,u <×A.CÚçd‡ó*ÝÉ;Ȥ,7! ©,i\¶gÄ".Û‚“J«¥B2EQ¢ëëŽ,× .`ìæNjØå±qW;½¾SÊ™wˆ^AÃu¸ûn¥yYd2•z Iä™Ãål›J3Ç­ž9Äb«g!ŽÙŽ0%?φ<ÒÝ 6ÙóÒç!ŒÒÏRîC•‚æ!‹> endobj 6 0 obj<> endobj 7 0 obj<> endobj 8 0 obj<>stream xÚ„ÛïŽÜÆ•Æá[é;è:õ— N‚N²†m  P¼³Ž`ÅÈò"¾ûeÍÔÓ؈»"`ÈG3ýYÝïï4yøª¶[ºÕ~‹”ouÜ¢ô[Ýn1Ê­î·\Ê­¥[nq;þ+Ño-ßZß÷[+‡¢mãÖê¡Éc»µv¥¤ã÷³ØŽÎåj©·¶Íb;ÔûQ´²ÝzšÅžn=æ!k¾õ<‹½Þú±rÇõ¹òØÏ•·ãú\yOÇkæÊû±~?V®)ŽuöYÚq¬\ã8Ó³8~>Ž•kÎùvìé(F»cåZòv;ê£Øâ6Ž•ë<Õ1fqìkÌ•[M·1Wn{¹mså~œØ6WžoÂ6WÇ[²Í•·ÔnÛ\y;ö»Í•÷ˆÛ6WÞ½kFK1nÛ6‹ã<·cå¹ÜŽ÷á(ŽsØ•[Îûmϳ8Ö?Ž­”v;Þ™£8´û±r«5n{ŸÅñó}®ÜŽoŸ+÷”nû\¹¿|Fsé‘æç;×óHsñ-Ž?Ó\}›ïošËï±ÍOuVóÝ›ªžòñ›4f5ß›t¼¢Çñ)GÚg5w~¼ýÑóaœ8ö{Ts_sõ^ŽÏ5¢Ìjžu+õ:ÝÇßz›gómš(æ1ú<Ò<‹Þ§EbcÌò<ƘÈóÛüMžÇØæÇ›ç1ö|¬:϶ïóÛ©¯Î}Vó£ÉÇêÇrÇŸyz<æ¼Û1r®K³šoëTR§[ÕGïØÂQ½¸üXi´ùN”yŒöêá£êñbÙY½8tcÌ3/óãÅóÛ<£:±½¸kcŸGšgq8~zçXiKÇ Ÿ}vÿrò™n_ß¿zóþéçß¾zš¨þëOþüôÏ_>ýv÷¯Ÿß=ýéÍ?&Æó%ßþö§û7ÞÿúÃËë¾~~þpÿý»7¿üòòš}¾æóÏ_r˜åeÑ[m/Å7÷¿<¿ÿé¯ÏÏ?½¼âÏ¿þý—ïêìÇ/omö‚YôÙ Žâû—}{œÇïžÿyÿ··?þúþé±Àýoÿûå/¿üíééÃý›§Ž?þöæ8µ×¾àùýßß¼›ÇIýÇýo~{þõÃý/ïß~xûózþϧûßû×û¿ÿüîíÏO_¼{ûãÏÇîÞ¼ÿpÿÝ»ç~zýÁÿõáéýçŸwXñõd"+Š¢®bøÕð«ñøUStÅPlŠ}[ZE#o休7òFÞÉ»sîN¬òB^È+y%¯äÕ¾ª ò Ïä™<“gòLží+;±DžÈy"Oä‰<=äö•Ö‰Œ(Š¢*š¢+†â!_ûû:±ÑÉ;y'ï伓ò 'VÉ+y%¯ä¼‘7òf_Ü22y&/ä…¼òB^ì‹[Fyyy<äöÅ-DDD}oŠ®Š‡Ü¾¸¥­­­­­­íøP81 u u u u u u õn_ÜÒÖÖÖÖÖÖÖ«}qKZZZZZZϹ}qKZZZZZZO¹}qKZZZZZZZÓr·4 5 5 5 5 5 5 5m¹qKZZZZZZZÓ–·4 5 5 5 5 5 µòÛ·4 5 5 5 5 5 µxÈí‹[*Ð*Ð*Ð*Ð*Ð*ÐК¶Ü¸¥­­­­­­­jË•[*Ð*Ð*Ð*Ð*Ð*Ð*Ъ¶\¹¥­­­­­­Ö‡Ü¾¸¥­­­­­­æ‡Ü¾¸¥­­­­­­­jË•[ РРРРРРЊ¶\¸¥­­­­­­­hË…[ Ð Ð Ð Ð Ð ÐJ{Èí‹[ Ð Ð Ð Ð Ð ÐJyÈí‹[ РРРРРРЊ¶\¸%---­­­­hË…[2Ð2Ð2Ð2Ð2Ð2Ð2в¶œ¹%------÷‡Ü¾¸%------ׇܾ¸%-------kË™[2Ð2Ð2Ð2Ð2Ð2Ð2в¶œ¹%€@  Ðh´ZhËÁ-´Z-€@  Åxȇ‰-€@  ÐhÑrûâ–Z-€@  Ðh¡-·Ðh´Z-€@ m9¸%--€@  Ðh¡-·$ % % % % % ¥í! '´´´´´´Ôòµ¯Ä- h h h h h h hI[NÜ’€–€–€–€–€–€–€–´åÄ- h h h h h h hI[NË-±/ÐŽ"YQUÑùPl«äƒ|òA>ÈÇC¾¯bsb¼‘7òFÞÈy'ïöÕX!/ä…¼WòJ^É«}U'äAžÉ3y&Ïä™<ÛWvb‰<‘'òDžÈyzÈík¹åè¯YQUÑ]1ùÚ×Æ-['ï伓wòN>ÈW[óŸØ*y%¯ä•¼‘7òFÞì‹[¶LžÉ y!/ä…¼ûâ–-ȃ<ȃ<ȃ<rûâ–´´´´´´±?äöÅ-hhhhhhhcµå0ÿ™ãU9ÐÐÐÐÐF·/n@@@@@@@Õ¾¸emmmmmmä‡Ü¾¸emmmmmm¤‡Ü¾^ÝòýwÑ‘Ö‘Ö‘Ö‘Ö‘Ö‘Ö‘Öõe 9žW#­#­#­#­#­ëË@Ñ‘Ö‘Ö‘Ö‘Ö‘Ö‘Ö‘Öõe èHëHëHëHëHëHëå!·/véHëHëHëHëHëHëñÛ»4¤5¤5¤5¤5¤5¤u¤u}Ùè¸ä#GZCZCZCZCZCZÓ— €Ž«Jr¤5¤5¤5¤5¤5¤5}Ù(ÒÒÒÒÒÒZ}Èí‹[ÒÒÒÒÒÒZ~Èí‹[ÒÒÒÒÒÒš¾Üôe ¨@«@«@«@«@«@«@«ú²PT U U U U U U U}Ù(*Ð*Ð*Ð*Ð*Ð*Ðj{Èí‹[*Ð*Ð*Ð*Ð*Ð*ÐjyÈí‹[*Ð*Ð*Ð*Ð*Ð*Ð*Ъ¾ltÜËtÅPl r U U U}Ùè¸]"ZZZZZZÑ– €Ž1r     •þÛ·      •úÛ·       mÙ( РРРРРРЊ¶lhhhhhhhY[6Š ´ ´ ´ ´ ´ ´<ò¡pb@Ë@Ë@Ë@Ë@Ë@Ëí!·/nÉ@Ë@Ë@Ë@Ë@Ë@Ë@ËÚ²Ðq“N´ ´ ´ ´ ´ ´¬-E-€––––––µe  Ðh´Z-¶‡|(œÐh´Z-€ý!_û2ŠZ-€@  Ðh¡-E-€@  Ðh´Ð– €"€@  Ðh´ZhË@Ç2IŠ¬(ŠªhŠ‡|(Ö‰% % % % % % ¥ñ¯}EZZZZZZZÒ– €"-------iË@‘€–€–€–€–€–€–€–´e H@K@K@K@K@K@Ké!·¯å–}q¶/ÌöEÙ¾ ÛcûBlßè^÷cî³/¼öE×¾àÚ[ûBk_dí ¬}uaãž}Qµ/¨öÅÔ¾ÚQûj_<í«ùšòì ¦}±´/”öEÒ¾@ÚGûÂh_=×pg_ í ¡}´/€öÅϾðÙƒnÿ2€ìŠèŠäʶ¸Ù6Û¢fÛéÖù¯Ï]¬EªE¨E¦E¤E¢E e[ÕGšE˜E–E”E’EEŽe[ýÔàFˆE†E„E‚E€E~E|e[mÔ¼FvEtErEpEnElEje[ÝÓ˜FdEbE`E^E\EZEXe[MÓtFREPENELEJEHEFe¬^i(# "Ÿ"ž""œ"›"š2V‹4‹‘KK‘JJ‘II‘H«3Áˆ£H££È¢ˆ¢H¢¢ŒÕM^¤P„PdPDP$PPäOÆêƒ.Â'²'¢'’'‚'r'b'cµ?s™‘‰yqi“¾úžéŠ¨‰¤‰ ‰œ‰˜‰”‰I_}ÏPEÂDÀD¾D¼DºD¸D¶¤¯¾g–"X"W"V"U"T"S"RÒWß3B‘''‘&&‘%%‘$é«ï™œˆ‘H‘‘ȈH´Õ÷ L¤G„GdGDG$GGäFÚê{kNòýwËçËæËåÍÉ­c®­­¬7h½?ëí^Ÿúú—w–5–—á–— ÎÅÚB|¼Åê «Ý¬n³š×ê¡«%®N¼íêç«}¯o…õ¥°¾cÖWÝúæZ_˜ëûp}í®oÙõå½¾»] ¸Fq±á’ÇÕŒ+(—K.È\¹ÐsêJÒõ¬KU—Ç®…]m»ØvïîÂm‚›÷!î}Ü踕r'åÍ­£{@w¢n2Ýغ‹uŸì6Ùý·¹€|cS # C3ÃCÓ3$ã!#)ó'..“3=£9B³?óFÃEãKÓKcQãZsWÓ_ƒ]Ãd“cÃi³iCoÃxSu³}c{ <ðäÁƒO4ä¦Ä¦¤¦„¦d¦ÊâÌЈЄЀÐ|ÐxÐtÐpÐlP6L4L2L0L.L,L*L(¬,> AÍ@@M@ @Í??M? ?…ßdßDß$ßßäÞÄÞ¤ÞÊâÔ×׌׈ׄ׀×|×x×tWºO¸O¶O´O²O°O®O¬¯,>Œ±M± ±Í°°M° °Í¯¯Å¥…eE%åËâÜޘޔÞތވބހÞ|^>SÖ”KÍ«;ÿ·¦^k¶5íZ3>ÖôkMÿX3®5ícÍv­©köMþ”æäƒH×¢³âZtrBäkÑÉ Q.Eù䅨ע“¢]‹Nnˆ~-:Ù!Ƶèä‡x5Dù”èdˆØ¯E'Gät-:9"ǵèÜòµèäˆ\.EqrD®×¢“#r»‘ûµèäˆüêˆú)ÑÉy»‘÷kÑÉ%]‹NŽ(q-:9¢äkÑùë¢\ŠÒÉ¥^‹NŽ(íZtrDyuDû”èäˆ2®E'G”íZtrDÙ¯E'GÔt-:9¢Æµè䈚¯E'GÔr%Z÷Ïÿ"ª×¢“#ê«#ú§D'GÔ~-:9¢ŽkÑÉu»Q÷kÑÉ-]‹NŽhq-:9¢åkÑÉ­\Š¶“#Ú«#ƧDç‹Êv-:9¢õkÑÉm\‹NŽhÛµè䈶_‹NŽèéZtrDkÑÉ=_‹NŽè¯ŽØ>!'Gôz-:9¢·kÑù>£_‹NŽèãZtrDß®E'GôýZtrÄH×¢“#F\‹NŽ¯ŽØ?%:9b”KQ?9bÔkÑÉ£]‹NŽýZt¾õ×¢“#Æv-:9bì×¢“#¶t-:9b{qÄü?¢“#¶|-:9b+—¢vrÄV¯E'GlíZtrÄÖ¯E'GlãZtžFl×¢“#¶ýZtrÄþâˆú>þg€Uôã endstream endobj 9 0 obj<>stream xÚ„˜=®7„¯Â,û—M@`H™C°}GNlÐýWïʉ Úö ‡[_ ‡ü6yâ±öφËY²×Z×»Tã½4WY&ý.;‚«-WÇÕ—°¨éyÔUçÏJCOÔÊkÏÎÓÏȽj#—² Œ¤®»‘K[Itné ¾Üý¤ÄªD;ŠY9Å:Ô:Œ-L¼ˆ9 ØEø`펗ÓßøszµÑáî’g·w¸g¥ÃÕ7ÆM)¦ ÍU÷çZô4ÕßÛÒí—cp;Ø´èp.ÕÝáƒAïgÕR“cc­_åbg]»U0èE]]zû9 ^.šÓ:Œæ¼Fóñ£ùÜ£¹úq£wcz£ùbƒm[€nœÚÆn)6°w½p N‡cV†AbÐo€ 3ëpaÐkÁ™ãôTö²@«bû,"žŽXî–͉Tñ6¤Ãh>§Ãh.í0šëtÍ×:Œæûܤ½|ã;â»_WuùSCmÕ°p…o®ñÜÑå&N ²Ãg¹K‡ ƒÓá»<0­†æÀéõKzâÕÐœÏs@óÁ ªµÅ½£øÚ+:Œæ»;Œæ®…WïðÅ'¨¾Wˆöé 8AœçŠ~²¢4´qÇï><~ÁŽãç³×ïOß¾~û÷¯¿®+/+ÐÐó<þüüøò÷²¾ûøñHÒÚÙa»„|†Š ˜¡CPÎPtf(ªr‚îÒwýÉÞ3¥LÉL S:S›))»LùLS1S‡©œ©dêÌT0õRÃÞQÎÔ)vCöL±"3ÅnˆÎ»!6RÊnˆÏ»!1Sì†äL±òrÃßQì†ÔL±rgŠÝÐ=Sì†ÊL±ª3Ån¨”°ê3ÅnhÌ»¡/7âÅnè™)vCk¦Ø ½3ÅnØž)vÃd¦Ø Ó™b7ÌFj³æ3ÅnØË|G±–3ÅnØ™)vÃj¦Ø »3Ånøž)vÃe¦Ø ×™b7Ü&j_vÃ_nœw»á1Sì†çL±~fŠÝðš)vÃïL±±gŠÝ™)v#t¦Øx¹Qo¨b7ÂgŠÝˆ˜)v#r¦Ø83ÅnDÍ»w¦ØÜ3Ån¤Ì»‘/7î;ŠÝH©Ãn¤Ï»‘1SìFæL±yfŠÝÈš)v#ïL±gÏ»qžn|ÿ/ÄO(vãèL±ÇF*Ùã3Ånœ˜)vãäL±çÌ»qj¦ØsgŠÝ¨§!ï(v£d¦ØÒ™b7ÊF*Øò™b7*fŠÝ¨œ)v£ÎL±U3ÅnÔË }G±wÿœúO€Õ0ŠQ endstream endobj 10 0 obj<>stream xÚ„—;®GE·Ò;`×·«A€ae Áö)±aÀû|‹´]ˆ Ùù§¦»ê¼à©ÇÚK=W8¾Î’]ø®%©ø¾K%—"WÈ2E.tÙA.l¹!Ö«s2C¹Û¹³Ò;WëìÎÝuðLs¯äRV%rx×äÒÖ=Èá7ÙÚÁè u2—ˆu[”ê,ö¨Þá‹ÅÍçÅž[•%¾F-q¼\- Aø rd‡£ØaTÎÓaT>ÚaT>ÕaT.C;º*_Gå^„Ë–nôC ¿ÊîptÓ:Œ•,²Ã¸L;ŒÆÞ¬]Ô Wºíßî“!x­†»îdz‡£Ùáç:|zsîê=²{»V.{æÐÛÚÆÔ𠇳mËÄú¿Ju8z°ÆM¿ÁeæÆåOôbé&gÑ‚Ê‘]DU,Ðuñíh‡£Ué0nÊ:ŒÊUÆu½Ã¨|o¿y/ߘ ©,—Þšå‚ šB5í÷à$Þ:˜FË×áÄâtø,wípaQ¾Ë4´ØÍ6CåÄ ç÷DÛÌPù´ÑÖw,Zç£òí£*ßìp­ØÚá‹&ˆÞ¬”7,0AÑB­ÛfX`‚†÷…a‚><~éf+þæ~üúøíŸÿþú×ã3\’Ç—ÿ?øãñç§Ç—oËúîãÇï”0¥3µ™²‘Â>Q>SÅTÌÔa*g*™:3LÕ“²w”3ugÊ~¤tï™R¦d¦„)©Í””]¦|¦Š©˜©ÃTÎT2õrÃßQÁTÍ”3ugŠÝ=Sì†ÈL±¢3Ånˆ”²â3ÅnHÌ»!/7âÅnÈ™)vCj¦Ø ¹3Ånèž)vCe¦Ø Õ™b7ÔFJØ õ™b7ôåF¾£Ø Í™b7ôÌ»¡5Sì†Þ™b7lÏ»a2Sì†éL±f#µÙ {¹qÞQì†ÅL±–3ÅnØ™)vÃj¦Ø »3Ånøž)vÃe¦Ø ×™b7üåFý”Â?4ì†ûL±3Ånxλág¦Ø ¯™b7üλ{¦Ø™b7âåÆ}G±a#UìFøL±3ÅnDλg¦Ø¨™b7âλ‘{¦Ø|º‘ûÅn¤Î»‘6R‡ÝHŸ)v#c¦ØÌ™b7òÌ»‘5SìFÞ™b7ÎÓ”w»qd¦Ø£3Ån©d7ŽÏ»qb¦Ø“3Ånœ3SìÆ©™b7ÎË }G±µgŠÝ(™)v£t¦Ø²‘ v£|¦ØŠ™b7*gŠÝ¨3SìF½Ü°w»Qw¦Ø»Ný'À%Ž= endstream endobj 11 0 obj<>stream xÚ„XÁŽåÆ ü}ÁŒXl²[€a vn$FÖ@‹=¬ãAlxív7@ü÷a¿Wi<é0è=²Z¢ŠERÞbÛ7o¹E«¥o¶ZÇf‰Z –›Ç¾¡—YØæ(»¨ßzÙ…oÍk_¾mL»(˜iWpÇ´ë[¶i7¶¾O»cëõ›ç¾ +»´mdÙÕY‡•]úvô²«k¶cƼ¡i™›™OÓºEÓ¶îmµ9ʸîÐæ­z·ÍÚ^Æ…e­÷î›…Í».äÈió§q!gŸÆ…Ü1nOf}LãB^Æu6Ž2…|´2®Ÿí8Êxø†}Æc´ŠÕ>cmçØ4îµÉi<68¦qvžìŠæe|Xm Ãl/㣣þóŠ$²M㘯ar¯àûQÈGm ùÀ¼rÔ+©X·²k·´[mêä6¯¶zEm¯«óJ½·¬—ÐöºÚ+ê­ Þd¯MýÑV|ˆ½Oœc «{nõæ›f¶ÅŒD«ÈF«çnæ[r=vd=S³¢D¯'hÅ£u¿ÍŠû¼»zãió^ìØêUr½ô:§ÁŠ8…Ú*X…ÑêÙêN ¹ø—½~oˆ-Gý׊(y ë¯ïÌVo±›r…¦£Þà qwŸ±±­·¢Íämb+»>YÚŠ^½ÇŒVl}LN—g?ŠÄÍû6öœÅÜœ´?¶"R+¾ÉÁÖŠÌ­ÏcQüjÍ‹ÞŦVŒ½¸óÕWϪ÷TtÙ·¿?ûü××O¿~øøü¦®Ùów1¿ýðöùû??÷¯íöß×_ËËV/\{í«—_zUâ/^íÚk¬^qíÕW¯¼öÊÕ«ß¼Ú™W¬^ãÚ«­^ǵ—ÿ¿—ïûµV/»ö²Õ ×^ûêå—^~¬^íÚk¬^qíÕW¯;7âÌ+W¯~í«×¸öj«×qíµrÃök¯•f×^+7 ×^+7Ì/½°rÃÚµ×Ê »s#ϼVnX^{­Ü°~íµrÃƵ×Ê ;®½Vn`¿öZ¹»öZ¹\{­Ü€_zÙÊ Ü¹ÑϼVn ®½Vn ¯½Vn _{­ÜÀ¸öZ¹ãÚkå†ï×^+7Ü®½Vn8®½VnøäÆlU{í+7¼]{­Üð¸öZ¹áyíµrÃûµ×Ê ×^+7ü¸öZ¹Ñö ¯9I,NvêôÍë§_>½ýòûÇ—ç·¯þ‘W¾}ýøúéÝþTïÿþ÷þùoÏùðûë¿¿ÐâûŸ~þç/¿½|þ¼ÙÓ~ÃzónÎF…|îëq_«qWçÚ¸Þ"üþvËC·üÇãÝyõæÝœ‚¦ý‚î«sm\ƒkrí\×û}µ;¿o³Ï}%žψgÄ3âñŒxF<Äñ@<Äñ@<Äsâ9ñœxN<'žωçÄsâ9ñññññññññññ‚xA¼ ^/ˆÄ âñ‚xA¼$^/‰—ÄKâ%ñ’xI¼$^¯¯¯¯¯¯¯¯¯¯oooooooyјyјyјyјí ÞA¼ƒxñî™Q£ýÎÕ¸‚«sm\ƒkrí\Wâ1?‚ùÌ`~ó#˜ÁüæG0?‚ùÌ`~ó#˜ÁüæG0?‚ùÌ`~ó#˜ÁüæG0?‚ùÌ`~ó#˜ÁüæG0?‚ùÌ`~ó#˜ÁüæG0?‚ùÌ`~ó#˜ÁüæG0?‚ùÌ`~óƒÃµÆ/5èjáTäU¦¾¶;U¦¾~øáãËMbÿPøo^ÿó.ü©Jœ>ž0¨^ÚSV‚tìOÕ5¾¿kþÿ„º Õ/þãõÓ/Ÿzyù²€Až×Æ´6®M{¨ý¢Ë¡ËÉ[›Ð&µéÚ mnî)üð˜h4 †@SÏ—z¾û›yxŒ Ôêu666Å )í>stream xÚ|™KŽ,» D·¢åV®;vÌV>s윭ÜZ»f+Ÿ5ö±V>{ìk­ü©Okå_õZù´ÖZ­üo¯þéô'}µòù*²[ù;ƒÜý‰ûs–ý÷ûÏû§ïœ®û÷߈Ùß‘ßø¾þDŸe¬øþ^#vWÝïñÕØû¼#º¢1ûËË®_LQ]­ïJâtm¢¿ó¸õ£:röuG_[Ãý‰nƒ\}M1käî+ˆ¾ÚôŸ?Ý‘ñ}ÊæÈüûú³¾cu³äéÓÛ#ïOÛø¨éþÓ?eû{svóìïÍ5ê«FtK•¯ïÍwÔ÷‰è*û€Ñ]Võïê–«ŸËÝ£NW+ºñêžïÍ1άïÍ9ŽÕ÷æê¾ÌïÍgœþÂzqÇùÚ4º;»³úÍÛÆÉîïú§ÖW¿îæcßo¼ÿ«è8÷|¿Éqg~¿©qíì+¹ëGðŽ»?AŸã~ýÝïÑ?Üì†ïq«Ï7º÷ôåþùçû÷šýeÍñîìþ²~Ö_–Æb±Ø,œE°ÈoñŸ?þÞ-ø#ùÇ?ÿø×?þúK‡9ÇX,›…³É¢XœçaÑD4MDÑD4©Aª³æó0Ž¨#êˆ:¢Ž¨#Ô ¨A¬ça¢ Ñ…èBt#ºÝÔ`SƒíÏÃLD'¢†¨!jˆ¢F ŒØ«ìÞÿ‰öÂX,›…³É¢Xœça ÑB´-D ÑB´‹«Å™Ïâh ˆ¢hRƒ¤¹ž‡ÙˆnD7¢QGÔujàÔÀýyCÔ]ˆ.D¢ ÑE 5XND'¢щèDtRƒI 泎ÐÒ‹ÍÂY‹dQ, ÕàÜg œD4MDÑD4­ÉÂX<[à8¢Ž¨#ꈢhPƒ ñl³]ˆnD7¢Ñ覛ìg CÔ5D QCÔ5j`ÔÀž-P ¥@K–-Z ´”°Ô`>[ @K–-Z ´h)…¡•Â°Ï(ÐR ¥@K–-Z*©ARƒ|¶@–-Z ´h)ÐRN œø³ ´h)ÐR ¥@K–ZÔ`QƒõnÐR ¥@K–-ZjRƒI ìÙ Z´$hIÐ’ %AK†Iæ}¶@‚–- Z´$hIÐ’„a†YÏHÐ’ %AK‚–- Z’0LÂ0ãÙ Z´$hIÐ’ %AK†Iæ~¶@‚–- Z´$hIÐ’„a†¹ž- %@K€–-Z´$a˜„aÎg h Р%@K€–-AaçÙZ´h Р%@K†AF>[ @K€–-Z´h Â0Ãðg h Р%@K€–-AaûÝ %@K€–-Z´a„aس´8hqÐâ ÅA‹ƒ' 0ôûl-Z´8hqÐâ Å C' ½ž-à ÅA‹ƒ-Z´8a脡dz´8hqÐâ ÅA‹ƒ' 0t¶€ƒ-Z´8hqÐâ„¡†¾ž-°AË-´lÐâ ÅA‹†Nú|¶À-´lвAË-´lÂp†û<[`ƒ– Z6hÙ eƒ– Z6a¸ ÃÏØ eƒ– Z6hÙ eƒ–MnÂpdz6hÙ eƒ– Z6hÙ e†›0ÜûÝ eƒ– Z6hÙ eƒ–MnÂpÛ³hY e–ZhY e†‹0\÷Ù ´,в@Ë- ´,вÃE®z¶À- ´,в@Ë- ´,Âp†+Ÿ-°@Ë- ´,в@Ë-‹0\„áòg ,в@Ë- ´,в@Ë" a¸Ö³ ´hY e–ZhY„á" ×s:hZ ´h1Ðb Å@‹†FÚs:hZ ´h1Ðb Å@‹†FÚs:hZ ´h1Ðb Å@‹†FÚs:hZ ´h1Ðb Å@‹†FÚ~·h1Ðb Å@‹-Fahïéà-´LÐ2AË-´LÂp†ó=œ e‚– Z&h™ e‚–INÂp¾§ƒ´LÐ2AË-´LÐ2 ÃIÎ÷tp‚– Z&h™ e‚– Z&a8 ÃùžNÐ2AË-´LÐ2AË$ 'a8ßÓÁ Z&h™ e‚– Z&h™„á$ çs:xE–+°\qå +WT¹‚ÊU ^…à}¯€rÅ“+œ\Ñä &W,¹ ¿«ì»ÏYàG®0rE‘+ˆ\1ä !W™wy÷9¼ÂÇ=®àqÅŽ+t\‘ã*ê®’î>'WÔ¸‚Æ3®qEŒ+`\%ÜUÀÝçÀïG¬8BÅ)Ž@qĉ£`;ʵûœó1âG„8ÄŽðp”gGqvžã½#4‘á G\8ÂÂŽbì(ÅÎsªwD„# ñàG48‚ÁQz…×yóŽ@pÄ# QàG 8 ­£Ì:ÏÞ‘ÿìäþ#óyÿÈúGYuUç9º+9¿äü’óKÎ/9¿äüRD•ªž»’óKÎ/9¿äü’óKÎ/%S)˜ê9¨+9¿äü’óKÎ/9¿äüR •ò¨žó¹’óKÎ/9¿äü’óKÎ/åP)†ê9–+9¿äü’óKÎ/9¿äüRü”Ò§žÓ¸”óSÎO9?åü”óSÎ/¥N)tê9„K9?åü”óSÎO9?åüTÚ¤Ò&Ÿ³·”óSÎO9?åü”óSÎO¥M*mò9rK9?åü”óSÎO9?åüTÚ¤Ò&Ÿ“¶”óSÎO9?åü”óSÎO¥M*mò9`K9?åü”óSÎO9?åüTÚ¤Ò&ŸsµóCÎ9?äüóCÎ¥M(mâ9N 9?äüóCÎ9?äüPÚ„Ò&žS4[¾V”סÓSmT ÕýUn:Bí¨îR««“e#¹F}ùˆˆ\‘¨(艸¬hþŠrG!§ÌR€*ÎÊbÿë^…[ÝéöF÷Zº•Ò}œnÛtøåÞ™»Üß;gîعç±€gž=ž7ÏÜ¢óöûŒÆ#!O{>stream xÚì—ÍŽT7…_ÅO@ÛuªÊ¶„Ù%ˆa‡X €Ê$# dÁÛ§ªû(Rbæz•ÅH½hlÝ©sÎ-ÿ|ݘZ©ÅÔËÔzicÄ8Š ‰qt/fµh2kÅ<êLŠ[ÔJ¹™–¡Yga“u^ZE†a“¬¥‰dé, -j½–¦-Š½•f5Š]b2£ØQšO9gµ>²ØòŲ8œgÏâ^¤zÇ»6ÏâYDš‹7É?õVïÜ%&©ê(¢Òc¢1IÃnE ˆ‰Ç$³z8;fL¹Ÿ ùÏð ŒH¶ÎSC«„Ú¢x &3Š‡´žÅV šÅ^Éâ“\ÏXc¨¤*Xs¥g-0„­¹às–X]-uÚ⎶¢;ãUŠÆ ÅEµŽ˜hLF[QC‰Çd¦ªõèÔ£N}¦<œ{œ Í‹% ŸÎ#öÞ[8Ï4lá>stream xÚì—ÁnI †_¥ž€¶ËU¶KBHÀÞvµ‹7ÄAˆ°#öÀÛïâÌøÄ!¨IW'þþ*»í¿gtÌFM‡¶)¸XcR\½ñ\¸®Ö¹7Ôº;®ÜD®½ ÌdÄÏÑ抸ÙT#N›ˆ³æ=â¼ùŠ¸Õ4U ûe,ŽToÌT üY±w†ˆN,Ô°ÐÆr¸a19îÅã(¸pàƒ²pƒ²(ƒ²ErØ;‚ Ê‹"ÊË#X[§Á†„[˜c¡A¡=rtÔ cÐ¥ãðÞ±€†º´>:ï‹ôÙúÞ¡¬!èPŽ;E»iàPvµ ¼"Óå…;E-…®.iÂÁk4éÁ $§¨§HÊ°ˆL—7ø‡2¢&Sð0P™ØÐPt<ÁŽ”CÌÊACEÄцՇòZAyd¼Ú`t!¥Ñ;‚™öD0údªe,hÁHi TÂx¶1‘©¡Žc®À­ E‡R‘1” }fxÀÃC°CÙ£“Pë±Bgš„³Òž„b90(4pLq¦)ÁŽ…Gðj›5CiæDÛš0(­AtFï›@9ÊfxfÓÐÞ&Pv”Ä : lå…t ™ÌuD7R±˜ ÁÃh‹gÖ1[6ÐCxr§ydúôéöü8AÔ^o/·¿·ßÞßlâø¶½Âo=þãj{óÇöêSã¸{öìâ y Q†Va¦îCB¡‡Û×·W?~Þ\oW‡›/ïþòòps¸}KOpŠÓÏ»íŸí¯÷?ÿý¸‹xóùˇ¯ÿ^ÿÞø íZ»Ö/×z~´þû Îrlðy~*ðâHÐ(!ÉÐ,¡l¬%”í­„²=°Wf{àUBžˆJÈ2Ä¡}v­GdD+Û>stream xÚì—ßn\E Æ_ÅOÐñŸ±Gª*A¹AEz‡¸¨hUSVJËEߞϛˆg×·VJt¼ÿ¾c{f¾sâj4Èu‘ãG¦1®AÌë&ŽInƒD×IŽ+“*0Ò-¸*YJ˜‘í뢕:†Üa¸B뤳)ò»5h ¸5iŽ`1‚@æš_ûRš,™k4efòB™Œ*U!¿ÁNj£ní>h®Ü¡¼P–;”}@Ç¡œ7v‡r¤ C9 êh}ît'3u0€±ÇÀ£ü‘d胅‘Œ`ggB¬PõPb³L6â5p‹X,)({vPÎv=N³EñÊV|Cy3ŠßPÞ)ˆÙÊ`Rd¦ º•‰¢|/Ü cm$© Ñì+ Š¢b`Ù,gŽ‰ÈCÀ$>'(çŒc@9¦#°\ÛÊ›‡òÆlbéàÔÙÐwÌA:SZ:ÑSLl NALVQÅ&™ÀѤêNj‘ÚÊd']šÉPvÎd(gOX´À ᘵn,H &è4Ûm`Ø?ÛÄ& ^0ÈÀ°ŒÅcûŸ7™`#‡ lÒ„V :°æ½h ›9°ÉͳSôf9’(Gd2”·erÖ6“7¬p Û5ñ)t"ÈN±™ãhJYŒ• t‹˜ôòåáÛãýûÛû›/_ïn7Ç»ï¿y}¼;Þÿ2^ züýõðÓá‡w_}yÌxûLJß>þyûù3ÍãÕ«±Ö7§ƒ;èçÃëÃÇûOïîßcÍãðË2N¸9¼ýîðæwšùéH+´[H 䣅¸B³…f…¸…F…¤ƒpl ¤-²ò ­‹Ðÿa_µþ3FÕìä)sŸ?Qíaªö°f U{XÜA^íaI U{XÚBÕ–µÐªÐj¡'~º†«Öó1¢| /Fôà)qöTäK|få¿âªö`ÒBÕL[¨ÚƒY U{°ÕBõ}Ò¼…žx`ÄEèz®ZÏȈfµ}ð?oD³Úƒr U{Pi¡jª-TíA­…ª=èj¡jê-Tß'5Z¨>0t_„®‡áªõŒŒHª=ȃ§¬ó§Bª=ˆ´PµÑªö ÖBÕdµPµñªö ÑBõ}RvñŒqº†«Ö32"«öÀžbçO…U{`m¡jl-TíW U{`o¡j¤ÕxŸ‡þ`¥Ú' endstream endobj 16 0 obj<>stream xÚì—±nG †_…Oà#‡ä §K‘» … Ž%ÈNá·ÏÏ“*SÒT.l!,÷ÄïŸ!—óï]˜SØ$W\ O\ƒ$®IÙT W!¤û äñ‰<7šZyNK*oÒÊÊ[Ѐnidå'%4c2Öa€S€ ¨ˆ0Ò¦"ÀÇ1d”ØtJs’hÉáFLJû´,B`Љ'sÌG¢æ¨2±žM3PžA(/ÌY(G b=«ý&zm‰’xœÎ˜µDÙ.ZÉN>¸’1À#*ya’½’ƒÜ´’ÚŸÜ ” ‚ª»ô‰ÙO­AFÛ€/Œw*”-I´Ïk€S¡\å&*ñ¼&MÆ$D§h ·Ð(7m ¨J1¯S1°‰jQ±ÒË—§×—ÆôÛéÍé—óí?ïoN?¡y|z‹²üò«Ó»Oo?’ÔÝ«W÷Ðê< ýp¾ýp}{õåëÍõéê|óéÃý'oÎ7çÛßùÓýߧ_O?¿ÿzþïË}Æ»¿>ýù÷¿×Ÿ?“¼àCëÐúîZ¯/ý퀋]Ü?0øù’Í-ÄZ;FÚ ØBÝ$·P·‡Á[hvH¶wh< ‡áÐzFF”ÝøÎSôñS‘Ýxî èöÀk u{àØBÝ8·P·á-ÔíAd Y‡Æzà…¡OBÇa8´žÕ®o?Í.>=õs­Ak ­ÅšÊ-Ôíy u{`ÙBÝxl¡þ}’u =ð°'¡ã0ZÏȈF·‡¸óyüTŒn[È;”[ȺñÒÉ[H:¤[ˆ;d;Hxaø“Ðq­gdDÖíaÝy ?~*¬ÛÃÊ-Ôí!x u{ÙBÝbl¡n¡;H»=„m¡þ}2| =ð˜OBÇa8´¾›Öÿ Øèä endstream endobj 17 0 obj<>stream xÚì—Ïn]5Æ_ež ×žöHU¥Rv ¨HwˆEE£R¸RZ}{>ûF,˜äΑÎ"òäÄ¿oÆcû;'¡FB†cÔ90Nê“1±…5â91ví™$£‚ S²32< sò¥cƒF[ü¤14ñ,só¼So LÌt¡Þñ8\QŠ¬¹¶jàN]tQ¨Rå:ÊT]xP·†‚GC€*b@ÙJPö%8 <:ŠPKp@yB5°ôºðAÜú¢&‚µÂt¨ÆD m ¬ƒ…1 b LžB¬hML%¶ +a[ Nì}áPv,.ÐF}é@y ðˆÕÜ%Pž(*Ê«×BÒ:(Ez†`,ÊIx­4‰Èš<±9mM( ­m$†¦#ÂÎyßÏ°w¾ZØ 'ƒ÷@~¬v4ì–LÞÌ‹ 2„l)V™{Ó´é"°:í[¥wD±æu&åÕð†”*ºôÐzUÞ„‘ZÛ„#›¤n›˜¤cWБcì 9殉tî Ð1]#ÇZ4¢u· Yo›pDû ¡‘Æ}ÑE%ÈdwC™êbÑL³¾ô„Å"pZÍסj‚C7“7sW€"-v2ÉÛ®@Ñ®@yßày_ǶáÜ9o$wÞÝP%_{úòåé›óý‡Ûû›/_ïnO7ç»Ož¼9ßïn/=üürúñôýû¯ç¿¾<Ìx÷Û§_ÿóöógê/Ú«WÐz½ïW£ŸNoN?œïÿxwú‡!NoѶظ9½ûöôö#õõÛ?'h´êê%Ô2Äd‘!)¡™!-¡‘!+!Ï—eh\…þ˃rhZÿ§ÖëýMFtñ”ùô­˜Ù¼WÐÈöà\BÙ\J(Ûƒk e{p+¡lî%¤%ôÈ c^…ŽËph=##Šlvñ”ñô­ˆlÆ%”íÁ¤„²=˜–P¶³Êö`^BÙl”Pþž´YBù…aq:.áõ|Œhÿüï®Sñ'¯Åþ:QRSÙ!Tk*[„ZMeP¯©l:j*»„ΚÊß•%Õys´«Ôq+­çäH’]B.ÞbWî…d—­©ìb5•]B¼¦²KȨ©ì2KŠ³KHÔTþÀÔVS¼AúU긇Ösr$Ë.ÁoÑ+÷²K°ÕTv öšÊ.Á£¤4»ÏšÊ.ÁQSÙ%¤ÕTþΔ^S¼Aøiêo"ÌÝ endstream endobj 18 0 obj<>stream xÚì—ÏŠG Æ_EO°-•JõŒÁqn ‰Éúr0öâ¯3°Þüöù¤D“©“}˜õŒ~’J_O W#&áÚ¨7ÿì$VÜTÊpc’r…aL:Üׄª¹3MÝÙ”»³Uj#œºÆ7<çӨA šq&MsçæWÁ7ñ·r~qÿ¦°º»48—ˆÑŒDKøáRg°(½öˆ‡K³ &I+Nx€ÎNtäè݉ŽËtä˜Q˜QA7* 3%pïTP‚[èìQ&:m@wÐ3'†PÑêÄ(TjD +Zó"y G«Xé%äè3ä=ä˜Õ‰‰)pT0VT€ *QÁTXQÁ¬¤%*˜kÑHuÒ å1`Å4'm³€åQ„‘£Å(à¬1QaäRÝBŽ1ƒ@ŽÙ‚hT¹Ñ©Š1`Í &ÕâÀ¤ªCÆqR¯@¤P­Q(,· Qµˆ"«ŸE©â\ÀA Gߣ ÇðnÚYcªRcúÁ‹'EÉD@; cuË` ÎvTP:Y °V£‚2É,*P†¨5uÉ1^'9zt?XLU9†sÒ±@Ñ ´¸ÅTqª©‰ŸNÁ[Q'ªPSvA›'*–¯š8HÍèÅ‹í‡ÓÓ‡‡§ûçoÛýéñÓ‡ó7¯O§§ßùŽéüúcûuûùÝ·ÓßÏg·~zÿù¯‡¯_IîøåË#Öë;Çzµ‹2ÓoÛëí—ÓÓ—wÛOÐ1ÛÞ`W5~¸ßÞþ¸½ùHáö/Å™jK 7…Dõ5525ÖTÏÔ\S-Q…×”eJÖTÍTYSš)½J[qĺ%EY%x×–re/FV îk*«5•U‚çšÊ*!¼¦²Jˆ¬©¬RÖTÉ”®© wz•:¶âˆuCŠäTÿ9áeîÚ"ÿ¿þ@–¨±¦,SsMe•`^SY%XÖTV .k*«ëšÊÿ3¹®( N”]¥Ž­8bÝ’"•¬c×¾²M¥fj®)ÍŠÄkªdJÖ”dª¬)Δ.)™™ªkjdÊÖÔ…;H»J[qĺ%EªY%ºkK=ߌ/ïEÍ*1xMe•²¦²JŒ²¤4«ÄÐ5•UbÔ5•UbØšÊÿ3G[Sî ý*ulÅë–©e•è»¶ŒK'üÏ·<Ñ endstream endobj 19 0 obj<>stream xÚì—ÍŽG …_ÅO@Wù¯ª$„DÈ.Q‚2ì #@™äJYðö±Ýw…‡ö ‰‘z1=ž¹õÙ§«ìÓ}{g½³‚°ÿÐÛôÀ.Š,À®H¾V:úbA á‹…€É[ \dÆÕ  Š<fÅ æôÅöùR_¬Ýª³¯ŽÒQVÉ.Q×—`V±(*«-¡(­¦œföïY–E‹¯ Äï©«¡Í‰a,ÃjŒ¸ÿa—IΫ±šçvY3ˆØ$ˆi»BAØþ`wbÚa(˜BaH¡` ‡Û”P0Å" BuÏb54vÃöGÂj —kŠgdYVcÅn,;†Öœ]d‘ËíV’ü|,;- B¨1,šAL k‰+@KE›Ýì¤Õ É%uجÆ@õˆýøƒ°“‚°q¨Ø¬Æâ &pÛ³,‹|7|Ã8{Fö|ÖÖENtï§åDg`A°H ¬¡ ‹B¥ç ºÕ¡­Æ h5ærÂÒóŠ,HÖªíÚR§Šh]Û{6}Ï2@po½ §Š¸lZ¼;ÑZEx9Aì(°v´ís‚¬Æ@'LšŒP@>¡À¦AV( «±BMÐ hYäíVR{dánQì†Ý–Æ©"“EÞÖ] dYž>ÝžïSÕà¯íÅöÇåþŸ·wÛoÞMÛK»ÿÜl¯~Ý^~€î={v¥l(…553E552Å5¥™’š’LiMq¦FMQ¦æ!õËåþýíýÍ—¯w·ÛÍåîÓûë^\î.÷¯Û;ÊýçÍöçöûÛ¯—ÿ¾\W¼úøéÝßÿÞ~þ ýI;s¹~x®çûCïÛ×Ý[ÆÁ\ŒìŠ5•]B©¦²K(×Tv •šÊ.¡ZSÙ%tÔfjÖTÏÔ:¤Î©8s=&GZÙ%d÷=˜‹•]B¨¦²K×Tv ‘šÊ.!ZSÙ%dÔTv ™5•ß3e•Ô|à Ò©s*Î\È‘ü ë·λ·È÷ç¿ð&Šk*»KMe—`­©ì>stream xÚì—ÏŽG Æ_ÅO@Ûe»Ê%!$þÜÄrCPX%ˆ%#-äÀÛÇv¯)^ºÎõagÝ3þ}ö¸ª¾ž¦& Ô¤Ãèñi‹À 5‹`£x l‘«¢‘ì‰Ê‘¬ jùŽ@—ÌQè3)–Ðц™l`;>aR$w„Ù#¹RdwÏÄè D#ÓdoÔ#âbÝ/y&áËHÂ/U“˜@½#˯1²þðKˆװ”™ ¯1Gî*ãœÁðñ'1=² üƒ¶7isÖ  kìÑ =ð±$¡à@^c´$¼Æ˜Ix ËÌkÌì`z™LòuÉ\”1;˜ L„Ž)U¦·œ†_ò¾”sx¤I°ì*¾ÎÓ`ô…Îådô=–‚}t<Ø"òF‘×°™„ט¹ØAP’Í|Ï@H3o‚´è€½ÄNðÈwSþ"œ*Ä ÓðoãÑHB}×µ$¼FßU¼F·Ìó¹ªþ­A,v%»€L ¢yi²oÅDó=KDЖ4õ(;ða+gmx”xq•ì M,FPM&r^\sU™½FÝÉ>b©Â^ÃrŽi®*󀎘zæÑHbB' Â7Ro„ô±GÍ£ì@Ø\v qø¼ƒ§O·—ûO·÷7ßÜÝn7—»ÏŸÞyy¹»Ü¿Ç'¶×Û¯\þþþñîÏÏ¿ùëöÛ7 'øìÙ©õ¿Ñz¾"ÂÛíåöÛåþëÇ»í÷®¾½0¦øàf{÷j{óP\ýKY¥Æš•²5Õ+5×”ªáš’JÑšâJµ5Õ*ÅkŠ*%‡Ôy*N­kr$«.»·ÐÁ¹°êhkªºÎ5U]‚pMU— ZSÕ%¨­©êÄk +%Kj>stream xÚì—ÏŽG Æ_¥ž€®*ÿ©* !¹%JË å€`ˆ%#-äÀÛç³{¹à¥­8¬Ô‡õôøg{ìò×=XJ-X‹°ý¥Õi^´›±Jo CjéÃ|¥êæ,½põ+Tx¸£DŠv‹#ZFuçQÆtçY¦¸ó*‹ÌYq¹zVm°<­½4Ï«Ë+âtϬk8a.{”NÓ |ÀìÄ‚µŒ°âQr(›ß6º±9ƲxÎs8KœÐÒkwb Õ‰ Ë+hP÷ ðõz÷ f+¼‚Ùay“Jgk+M.]<ÊXÞ `]›È¡êrŒ= rLïÆBŽ¹Œ]ȱì«ÞRe#jݤ¤¶œŒk8¡…|°´FAy~mÂò Ö*-X›)æÆfaÔÚ¬pF‡»YÈ1¬Œ¹’Ï”+rLr9Ö9Öt¿‰s¢Î®Âø6°à½Ñ¬eDÃyò§0³pañ šÀò ÐV¯  X^\xx 9Æ4àéQ:rLëcÜìSåNEªMÆ‘’êQºiâ~XŸ*÷Q„ªÇ›°¦ ëbÇ–©âÄ“ÔŠh3˜¨W@È1¼”&Ã+ ä˜^0Y^!Ç'fѺGY°¼8êSen°ìtZs´{¦¢äÝÀPÔãÇÛÓ}õjy¹=ßþ¼Ü~~s³ýŽ3ÎÛ tbøW۫߶ïK³wOž|§$R’S)Í)ŠÔÈ©©™S-Rëzv¹}w}{õõÛÍõvu¹ùøîîÊóËÍåöu}TËÝßßÛ_Ûo¾]þýzçñêÃÇ·Ÿþ¹þò¥´GõŒuÆú属î7§O¸v?áz°#ª„RNE•PΩ¨*9UB5§¢JèÈ©¨:sªFj¥N‚"ÕCêÜŠ3ÖCR¤UBvm‘ƒ½XQ%„s*ª„HNE•Í©¨2r*ª„Ì”šQ%dåÔŒŠTsêž;H;¤Î­8c= E²–?žpÞµ…¾öÃ4P’SQ%Xs*ª”ªQ%xæTT ^9UBjNÅçLi9uϤRçVœ±’"QT Úµ…ö‚¢J¦T*A#§¢JÐÌ©¨´r*ªלŠ*Á-§âs&÷œºçB‡Ô¹g¬‡¤HU¢ïÚÒö‚£Jô‘SQ%úÌ©¨}åTT ª9U‚ZNE• žSñ9“(§î¹ƒð!unÅÿˆõŸŸd endstream endobj 22 0 obj<>stream xÚì—ÁŽ\E EÅ_.—ËU.)Ša‚ˆÉ±ˆÈ¢Lhiù{®Ý-!á¡-–#½Åôøu×¹®ç²ïëæ1”ñ“Öôÿ‹X»F½››¤ ÚHÌ×*Óx§Ó0_£B:œÒAº]G•¦Æb_ðEKc±‘q,ÞdÓÏF;ðÉÄ}ÑÄeÛÎM!æåR—} ÄÒƒÀ¥ì °ó±‚À¥Fò¹‰gdwér¬È¿ð²b 9¬·«€…ÊBŽðÂl bQoÊÕ(ª€âôî›ÆÔe¸°>Ø DÛ Ôu¡ ˆI}Å 9–oÈKÛ­ûmrDyläØ¢!ÇÆì¢8!'¶ ÚN t„’ôÄDtQY$¢±ÎH†‹sÖ=m8hÅÖ1ÉôCцK¼9r‹GÈarÄ jCŽ½ƒ]4Úð£hFÇêÑF„ÁÎÞ\ÑM€í$¡Œ—!~2ʃÆeVBç¹Ê‰Þ ä˜+XäX#ä0ï E9Q9':rl?UÅØ­=Ëͳu4-«³] ”ßQŸˆf¨,R”Ò#CÍÕ·÷»ß‘4D¡,Lê‹!Ç eVçr=Ì‹.užš‹;j€Âê¶ ŒfÓ 6Mö“V4ÒD³yĈ¼Ã|Ú¦°³8ø)Q4Ò¸­—/Oßžßß?Þ}ùúpº;?|x}çõùáüøK{Ñèú÷ëé§Óﾞÿúr]ñö¿}üóþógâíÕ«Cëk}s1£F?Ÿ^Ÿ~>stream xÚì—ÍŽ9 …_%O@%ñO !³›Ñ ¢Ù¡Y h¢™+5Ì‚·Ÿcl®Ey5‹Fµèjßê|DZË9u» K©¥ k²ß£´ªL\–«ôÖH-}Ú]i…”-è…Ùh ÒŒ.²|±U_¬e°/ev_<Ë\¾x•Å–Bq»Vô!‹[5žšýA,io&¦XÒuX%r]ûHʰļ+Û¥›ÞÀ­¦2pÑaì@Žáe6»-_Õ \ÖtBK¯âÄ@3še‘:‹u¯~¢CÝSëÔ­¢Ù™”L*»U4‘+O)]È*šÈ¡®<‘C§ë!ÇPWAŽIþHcyr¬e:NÕ!‹ 56bq¡ÞœDV´ ëDÝÙÈ{°f!&WYˆ°I´©Ò½adÉu{èÝ"äPˆ"BŽáíDÃhÚì(†‡VwäXËÙY¸'Vá&F TîÝˆÖ 6`ÆŒiÑ“E– ¥2Oc›ë¢Ùlå#…ÕÆKQ*ër=äbcÁÓ•;rL±ŠðPx¹26)Õ&LÑ©ÓT0*dgq º÷›jNLDÓ‰UpdŒ@ë0õFPC´,ä1«Ær¨÷e*„Ó&L! 0=BŽÕ¬"ˆçäÊ« ÿVäÑ9SæVP½éáQ`ߦÂTÑX4Ô(oO÷ãYËËíùöçåþó›»í÷2ÆöÍQ¿³½úm{ñ¾4ûôäɨhæP ÐJ!Ð+hÖCèÙåþÝíýÍ×ow·ÛÍåîã»ïwž_î.÷¯ë#lbÿù{ûkûãÍ·Ë¿_¿¯xõáãÛOÿÜ~ùRÚ£zjZÿ»ÖÓýr5àJ>àrp*ðþ¹†8‡(@’CÁTs(؃Ž ö 3…4؃®šÁˆjµCè< §ÖC2¢ìAvOáƒS±‚=ˆäP°Ñ ö #…f°™9ìAV{КC –Cñ…Ñ¡ó0œZȈì_½«çÝSèç§ÂþS¼†4…j°9ìg{à•CÁ¤æP°i9¾OJÏ¡ø Cè< §ÖC2¢ìvO駢{ ‘CÁhæP°Z9ìk{à–CÁ¸çPø>É”Cñ…Á‡ÐyN­‡dDì¡ïžÒN{è3‡‚=ô•CÁ¨æP°j9ìz{ Ê¡ð}’8…(¾0ä:Ã/ õŸ¶PÙ endstream endobj 24 0 obj<>stream xÚì—Án7 †_EOEŠ¤€ @“ÞZ¤A[ÑCÐI· 8é!oŸŸE–íjŽu»ÛœÑ|$E‘ÿŒI¥—ZHE‹iüµB½…á¥5c”æ£×Â,aPa·0Z ºs‘ÁaHé~z/}Œ0´ètØ­Xíax±Ýá(ÞÃÖ28pÅíZS ÕãqÅÅ‚*‚7ž˜&`ì“À‚È|iˈL =¶¤iÖøe´' 1¬F¶†KëáÅ€9E¾†4 3¦g³Ò*M(O[6Ô‡"zEÉ$l¯q ¬„siÔ¥´.“è¥iÏ)¬™*ÛöB9bØ,Ç̺ ÄðYcÖ` Ƙ™"!ÞóÃöyÏoôÂ{~C ïù!!Þókæ‡Ó♟¡L<ó3¤ÆÚzX­p\ÂB ÃÂB §¹Ú£#ÊÉ£M1¶Ë‹T™žGŠS0ª°boFT¤‘„…vjc®¢Ÿ8ŽÖ° "á¤SÄ%…5&aEæÑÄdˆá-ˆ†>‚ÀVeôÈ ½Ò\eXQkhZjÁb«™â²·èmk+*d‡ŽÂ„5ÐæÕà +†Á˜JïѬƈ¡žÑÔÝf…08ÝÆ$Ãuˆ1f]ÐÔhƒI8¬1‰QtŽ¢! mqú†&Ô6ë‚’(·`á@Ù#S‘¢WOŸnÏO÷ooïo>¹»ÝnNwÞ>Üyqº;ÝÿRŸÔòðóëöÓöã›/§???<ñúý‡ß>þqûéS¡'õÙ³±¯ïv!¨åçíÅöòtÿû›»íÌìö ­Pçý›íõ÷Û«w…âê/H4ÖŸC­®¡– ZC” ¶†j‚x AñÎ!YCž ¾†,Azú?4ðÕ×Gˆ<ÉԆ“:P]CIˆÖPRjKÈ’:¯¡¤$k(©õ5¤ Ò5”ßvºÎÂÕ×#Ò¡øD?kð]RüŸ‡"¾÷χbÅÄ ç/ô5“´×L’Y3IúšI k&}GÚšIï ¿È\gàêë1é%]è¾ Ù7ÎMô¢$}ÔC eY&F;ö ò!P2(‡@Î`?¶ ê!2h+ð:0W_I¬8K‡ïš£—§ƒ³t8³tx;fép>fép9féð~ÌÒáz¬´#`û›—Ž¯ÀëÀ\}=&±êY:lל~y:z–k‡À,ƇÀ,&‡À,ÖY:L€’¥Ãì"øU€•êÿu endstream endobj 25 0 obj<>stream xÚì—Ín\7 …_EO‘ø'¤é®EÔÙ]Ñu;€“.òö=Ô¸›Ððh“…»ð5g¤”(òèΘ¢­·1ÅšÎüÇ4¼X#ÑÈ †öÆBiŒ&ÃÓ &‘“•Açd•f²&k›´&[›±&Ïæø†·k(ZXÀ0 ³Ë9-Ê…¤OÃǹ8C,Ò hpÄc¤Œ}â!¶XÄS^žñ°‘QsyIÌñ0yNÄpIbâ#‰ ÷‹ÐF]s¡Ó¾F'¬•éˆ‹‘çJñ æôìÖJS#Ñ ‰m‘öL… ,_£šÉ],bLNÏØ ùJ#†û"#rûgÂ}å›A ’‚I7&É•"8s_£ kå%,Op±ÖÌ•âlXyyX™!ïˆaYÞcvM 1r[°óX¼#F0§¥MzfÈRº/b¢LlÞ„xÑ„G£Ãò$pŒ"Y4¹iѾFVæÅQŒb#Y£XcÓ29=c@2M°Ã%ãâ%z-¶*1s”FÓž•ã(JœžqxJ™!'å‹Ð¦¬‹@C/b6Õ±‡å‹ˆ¦–•ãp…ÒÏQ,HçÊ #F.bxœÃ•¥gFŒXÂq[Ï–r$Çzd6ض»F£eå8ŽÛ˜Ò³ ô×Ê0“—6ÍÎrA÷–ñòåéõ¥…{ûåôæôÓùþï÷w§°>?½Eu ÜœÞ}zûGVŒå¯^ýÎ Æ5ð»óý‡Ûû›Ï_înO7绾ys¾;ßÿÚ_ôöð÷ÛéçÓï¿œÿýü0ãÝŸÿëŸÛOŸÚxÑ_‡¯oîëõEò¿.r£UäòtwàÖ( o£‚²ö êˆë¯€¶Vé°¹Vé0ß­‚±j«~ <æðõœÄ*ªtèEsøéîˆ**; WéPÝ«t¨mU:tnU:Ô·À*[ T±ê[à#—θ søzFb•?ò¾.r¹h=Ùù;±€ºVéÛ«tÈÜ«tˆoU:$¶À*Ú·Àú¾ªc |äÒ¡kàÑ0‡¯ç$VT¥ƒ/š3žîªÒÁ¶Véà¹Vé`ß«tplU:¤oU:dlõ}Uh\:| <æðõœÄJªtÐEsúÓÝ!U:hnU:È·À*[`•î[`•; Wé`Úëû*óøÈ¥#×À£a_ßÌ× ûCR™ endstream endobj 26 0 obj<>stream xÚì—ÍŽ[U Ç_åÌ3—ÀpÉÃ(OK™˜Ç%NLÏóÉQ7ÀYeV'Qô²í¢¬O¢$†ÍFPæ¬Pã°ÌŒ¬áÍóE1ófPµ¼~¥srËëñµY3ªaí®¨ œ²‰èR×î‡Í°< Ãì^¶2f¥FaÙöò@ÙM‰ä(¾ÙÈ¡œ•Zä°¹#GŽ}1ÉÑ1ózäpËn8Æáí]cÍ•l$_83²sX»C.c-Ù„ŽEk6ﾸ‡Aã®Ç–l§G—"¥9Ô¶7rØÚÓ92|X‘ÃcÂ’Až–†•r°\iyLtÃ' BNoI+gÆãR‰ #Ϙ'Êy´X6Áƒdm"rèÜDäPÛDäØâ3rxNŽcäpMo¼eȾ8bXžlÄ“²Ò¸@FÈÈS‹Ù¡lq ræ[ÆK³hƒ‰·×sNŽÇFy{T"‡ìÅÅ°r±Il¹N¾"‡ï¾D춉X M虓“'ó4z>w_ÂÊeòY”•ÆÀ AF¦ÖîP ¿p´äåËÃWÇÇ÷wŸ¿<ÜîŽ?œ?ys|8>þ/`œÿ~:|øöý—㟟Ï'Þýúñçßþ¸ÿôiÌðêUÄz}ZB?Þ¾;>þþþáðMôNoãÞøvÜÞ}}xûKLZTü b­Î z „"tÀ³ÿàlVAlZÁÕ¥‚Ô¹‚| ü/‡éëëÿŒõúôôý÷ÃIsìòvX•ð¨U:&´À*s¶À*[`•Ž¹Z`•ŽI-*È-ð‰‡Ž\o s‹õœÄÊ‹tŸ4G/o‡WéhU:`¶À*€-°J¬X¥¨Vénõû*H |â¡£×ÀÛÂÜb=#±ÊßÛE¬Nš#·#²p¶@® ¶@ªàj«‚Ô±‚Üg¥BµÂ»Þæë9‰ÕªÒa'ÍáËÛ±ªt¶À*¶Z`•£X¥Ã¸Vé0é€X¥Ã´Z­Ö‡Žù5ð¶0·XÏI¬¸J‡ž4‡.oWéÐÕ«t(µÀ*ʪt¨´À*ª-°J‡Z ¬ßWÕ[à¸þ%À[°Z endstream endobj 27 0 obj<>stream xÚì—Ín7 …_EO+ñO"hÓ]‹6¨³+º£ âôNºÈÛ÷×@ÒõÕ¦ ³°MôñHñÌÌpÑÖÛp±6-þÎ6”"XhEà» ÐÞxÅ\M4&c¢rLVnÖc²J³•“µM ±çÐl W¬æ#)onŽÀµSd4 }qD˜1$ä ÿŸ!3ÍE"–d E^‹¥÷Ð4èéLSLƒ˜H5)ˆ‰)«1¡±V™”c™3Vï9ªzÖ•¡Ñ“ˆBÒgÔ‡2³G¥b¥øEÌ¡‹¤Ä©5’™£ÜH%XTˆŒ"ó‚†ey4fŠ/h,MžuYqzŽ»Ðg>Ž•:!òåÆ”u8s·Ëf˜£ˆîÖX(2£œ,Y!ˆ³rnŠ¤Ô;4 åD)4Öðˆ ±<ŠƒcÁQNDÚ¤KÖdP‘'±šP–EÆ‘¡>:¢£ÇIPD„ƒÕƒG¬G$MlDæ C…Acrèb@f”©h,ËQh¸‹­jLF4yè¢ì:,,RI‚ ‰sœ„"ò$¬©Ì$fS¥X)úAuå¨7µ¬ Ccö`± +ÅuÈÌÐXY!”XB·LóÆw6´åèl68ÙÕŒFfvDY!lÆØ‚@K™HBÍ4ë‚e˜zØŒŽüË—§oÏ÷ïoïo¾|½»=Ýœï>¼¸òú|w¾ÿ¥¿èíáç×ÓO§Þ}=ÿõåaÆÛ?>üöñÏÛÏŸÛxÑ_½:r¹þç\ß\L¹·ŸO¯O?žï?½»;}^çÓ¸çÀÍéíw§7¿‡»Y\øì”}R@ÝWm œœ[ UpmZAߥ€³o\Áq <æÈõœÌjUëЋçÐÓݱªu¨nÕ:Ô¶Àj:·Àjº¶Àjê[`µë[ Upl'¤c̉A„ÁÓ2sÜF¦Tc8.f”óIÄ,²Ø&d°Ê&t°Ñ&¢†¥LˆQÃy¯F•ºàŒK’80; ±%o÷̆S!œ1´˜²Çt ™Ìiò^µˆÖf}Ûμ†ÈV(ˆÎ$¢!1H"€ØÖ%$—$BbYsQcå¹3Â{Õ"ÚºEÙì¯Å1Ði™™q(m…SÊAB¦¡Ì©F4®’¼|yx}:U0~;¼9ür¼ÿòþîðSjxû^¸9¼ûñðöcÌIþ¸ðêÕ’='´@¯ ¶@«àlZAjRAn\AiTA½þp¼ÿp{óíûÝíáæx÷éÃÕ7Ç»ãýïð"nñéïß?þóíaÇ»¿>ýùùïÛ¯_¾€k®k®ÿ<×ëÓÃðñÃÉsìüé°j-°Zb ¬Ö³Vë@jÕ:[`µ”8+¨-+h—Àë¹æzNfµªuÀÉsôüéXÕ:[`µ˜-°ZP ¬ÖÜ«u€´Àj -°~_ë€þÄCÇ/×sÍõŒÌ*þ>rZ'Ï‘³§#Ap¶@ª µÀYAnXAiPA퀰*h-Ð+è-Ð*¸.×sÍõœÌŠªuøÉsøüé jN-°Z‡s ¬ÖáÒgµ×X­Ã­VëpoZÁÕŸxèÀ%ðz`®¹ž“YIµ;y?R­Ã¸rµ“X­Ã´Vë0kÕ:Ì[`µ[-°~_uhO>stream xÚì—ÍjY …_å>ëêïþ@$Î.!ÆÙ ³3câ¤ÁI~û© #Ó}·=ÔÂöÁªOº¥’Nu3©•Z˜´•Þüo/dìbæáb© aµÈðkŠš_Œ Müb“bcºÐÒ4BVzž8¨^u£Œ g™BˆÏᵪ8"Ž @M›âîI›õ‚­RÂO^ƒP=ˆYp­½êìDG>üŒ5†F5fõSâ`4ÍÙŽ¤•üœÞ˜Ú=s$®tÿ5¼nGRVï‚7G(¸X¦³ížy Eoù)A›A У+5†Àä PczœÒŸ†G'AE_&ñÎCI&?)Š 7Ï<­ˆD‡fƒòy;EÅ»âbQ‚EÑ"3jLïÊ „$«Ó $5Ì,«¬>ÆA”?dFÛM%¢*ú‚o{A²Vý¤‚­yfL²õèVãçuÅ÷B¼He³F5涕V›gFsE‡d”æ·5¡F W-¸q'”°^JÇkæëÄx<Í|rüfZÃ1^¼Ø^>ß>Üüx¼¿Ýn÷wŸŸþs}¸?<üQ¯jyúùsûm{÷éñðóÇÓÿ¹ûëË·Ûïß ]Õ—/÷\ÿ›\¯Ž†XËïÛõöþððõÓýö›®ÛìGàfûøfûð7¼N…ü Ž ÚØ3Ø–À–Á¾ZǨœK $°×%3HK eÏûÂì¹.ɬF¶;zÞŽ‘­ÃÚ˜­Ãú˜­ÃƘ­Ã昭£Õ%0[G£%°fWÀþÌKGÎûÂì¹.Ȭü+Ї\žSOn‡‹J`_³uèX³uè\³uX]³u-€þ¥4¼æÏ«&Kà3/=î ³çº$³âlž#óô"s¶K`¶™K`¶­+ eëPZ³u(/Ù:T–ÀüyUu |æ¥cçÀ}aö\—dVš­ƒž3No‡fëà¹J¶©K`¶¡%0[‡ð˜­Cd ÌÖ!ºæÏ«bKà3/vÜfÏuIfeÙ:èè9ýôvX¶®K`¶¦“à/ê1CT endstream endobj 30 0 obj<>stream xÚì—OoœE Æ¿Ê|‚®=þ33RU©”*ÒâPÑ*+¥åÐoÏãÙp©£¬9pˆô²ñ®çgÏxìçÝí]­Që]½Ùˆÿ£1k³ñà0^&þ 릅ÁM´‡Ñ›òvIÓ”)ÂD<³æˆ ÃÛè{ñhcíųͱ¯¶"hwjL=V;ÚVl¯ÀZ±9×Æ‘–5Ží¹ÃòˆëغöØ Þ²ÎH꫱Iœ»bçðâTì+ØÃ#ò@Ž©‘;ãÅ›@Žµ6­Ñ.ÆÀbÖMDʾ‰] zx ïÄbÙ‰m¨Ç2 lÂa‘£ž¾Ë3‘Ã/¡`HTcbñäí…cÆÛ¾cyDÆ„v…Vo(FK`­ \ú® Ž ¢›ð¸¸M Xq˜Ž+“í]°¢.BÔÄÑ°c……— 9fTÙaEqKd‰„åM‰¶wÀš›èß‘WÓ¦¦ÂAàU £ªF]¡¦A Õy+GpT²½È1¢.‚>Ô©›EŽE±SU—EäÎÍ(*$(¶Ñˆ¼¸Õ½òÕ«AË ”@Í –@É •ÀžA/œÁq üæ|ÿáöþæó—»ÛÓÍùî㇇OÞœïÎ÷?Ó j¿œ~<}ÿþËùïÏ+Þýþñ×?þºýô©ñ :b±þ÷X¯/«¯›œi7¹?=#Ks ÌÒÁ½fé`)Y:XK`–¶˜¥ƒ½RGÄטÎkà10G¬ç$V+K]4ÇžžŽ•¥ƒz ÌÒAR³t–À,d%0KyœY:h”À™ÁYóC‡Ö5ð˜#Ö3«øúU“Cv“ë“Ó¿q(%3¨%2hV½Î Ž828K gp•ÀG:t <æˆõœÄJ²tÌ‹æÈÓÓ!Y:¦VÀž¥cZ ÌÒ1½f阣f阳ZW Ô,VTyèð5ð˜#Ös+ÍÒ1.šÓŸžÍÒ1¬fé^³tŒQ³tŒY³tŒU³tL*ùûêäøÈC§_ù±þ`£c ‡ endstream endobj 31 0 obj<>stream xÚì—Íj\G…_¥žÀÓ]Ý Æ`;»„ÄDÞ…,L,c%²³ðÛçT £ÊRp™º_UßêêsgXÔ¨‹: ÿƒºqˆIÌ3Ä"i adƵÖIe„`ÒµCB†O!”¼eFî‰9Ú 1VˆIS¢–-šK ¼Ñòy§Þ40gê#¥ ÔŠr®ÔylÀ¨Ç œºò&båmjlbQw‰Žµ":PcÄÝÉ@Ù‚EÒ>=V9PcõÈ[tHj8Ú …C%jÌè‹6Ô˜H …klÂWÌP5wtöè ÞC­Í.Âfa¥Úf¨G澧©…Â8)G]T£MÈ@j¾£¨á²YÔ=2wÔÑ!EÛuú&V eÜÉÚ m·îA0f–cr”joÞšD_”jmv©ÅJqƒ˜òyAí¡Åæu±eæ±ñ*¨1lGQcÆä(†ÐV‹Ì‚kw7ãÍ71È»lb’óî –á¯¸‘‡êäq P 5vTÈm÷Eqø #ðòåéÍùþãíýÍ×ow·§›óݧŸ¼=ßïi/=üýzúéôÇoç¿¿>\ñþO¿}þëöËê/Ú«WG®ÿëõÅŒý|z{úñ|ÿ燻Ó÷8çvz3¿7§÷ßÞýŽ“ GÀÿ‚žA/–ÁQ5ƒ³JW äŽV{{ lä M <æÈõœÌjfë°‹ç´ë§cfë°Q³uØ,Ù:l•ÀlÞJ`¶ïpdëp.3ƒRyèèSàq`Ž\ÏȬâçLJ\·çðºz:âLg ÌÖ¡«fë°Vã§X{ ÌÖa\³u˜”Àü}Õ´>òб§ÀãÀ¹ž“Yq¶¹xμnœ­CVìÙ:´•ÀlÚK`¶å˜­C¥fëP-ùûªZ |ä¡ãOÇ9r='³’l|ñœqýtH¶i%0[‡ô˜­C¸fë)Ù:DK`¶±˜¿¯Š—ÀG:ã)ð80G®çdV–­ƒ/žã×O‡eëà^³u0—Àl,%0[ëUðãö,· endstream endobj 32 0 obj<>stream xÚì—ÍŽ\E …_¥ž ].—JŠ"…°AÄd‡XDd-MÂ"oϱ{ØÄ£éÚ°tÝãi×gûúÚçv9¥õ6æÔ&­Í0¼‘Q«á0¤7îájìÉhS4 nÂ#ŒÙ´çaiêyX›i¶æœ‡½-Êë-Eô ?õ>%XÎa($@eX+ŠÓÙhHDUiÄå©ÂÒH©(} µKOï‚eÁr¨Dd\Ùˆ¼†Þƒ0äpÂce+ ŽÎI 4êIÀA•RŽ‘ÞlPToÌÁF(^Q©KÇ`á°ds¢1¢‘×ñ¦#Ž8‚êJ/˜%‹]22r¬ìЊ»ÐƒX¸ =ʘk4¦ìËâƃƒ@ræž„ÀÒ¨tiã9Òk°²/HÉÂÉ.XŠ"‘C1#šÈ¤dÃM…N+,äð•^äX–¬¶Ù1E°¬M=i%±ÚÑX¡Þ&G_·qâðbžzÄ1Y=¬Ù0éXÑ!ä0N9,Ú$„>32r¬èàRqõ‘wPõhXÖJ/†–brd̆WDÆø`#/š-¼’°&1*°¼‰d_0>¢#4[¬‚ÄbrbÄ)½ÈáÙ´XVì‘0r¬¸ñ‚uÐ>#2†F{vˆ½)ÅR!{ÓAÑ ¬Ž™Ô”cr˜Î‘'7•ì.A#ðòåéõe={ûéôæôÃùþÏ÷w§ï0§rz‹; é¸9½ûöôö7LÌÌ^½ú¤ êØ+h; D¦€~ üæ|ÿáöþæó—»ÛÓÍùî㇇OÞœïÎ÷?÷(æòúåôãéû÷_Î~8ñî÷¿þñ×í§O^ô#Öë?õúò@ùzȉrÈåéí€èpl\AÞ«tÐÜ«tlU:Hw@­ÒA¶z} ´ ®kà±0G¬ç$V«JG¿hÎ|z;V•ŽÎ[`•Ž>·À*]v@¯ÒÑu ¬ÒÑm ¬ÒÑ} Ô ®-ð‘‡N¿ sÄzFb?!¿rZÍá'·#~…pî€}UP¶@¯ nVAÛµ‚¾J×X¿¯ö¾>òСkà±0G¬ç$V£J‡_4g<½£J‡ËX¥Ãu ¬Òá¶Vépßg×ÈU¬ú8*H[à#q <æˆõœÄjVé°‹æÐÓÛ1«t˜nU:̶À*æ[`•[[`•ï[`•§-°~_õ±ò#¾ ó?ˆõ€d8› endstream endobj 33 0 obj<>stream xÚì—ÍŽ\E …_¥ž ·ÊU%E‘BØ b²C,"2‚ˆ–&a‘·çØ=õxÉ@/Fcµïg»\ö¹Ý¤¢­7R±6ÍÿÏ6”ÜXh¹±-…¡½±¸KGã½Ý &ê”rÓÁnHÓéñT›ÑtÚ-qc¶)ÃÕÖ×nk;e½mó€6ÚèâÉŒÚäÃÚþ¼I4Ð6X‚°6„‚@å²¼>[8‡wÃÚ^!Š¦ÎNä˜ÃkœÈ1Í##èXäUNäXËóNäØìðÆô^<Üw°p ‹ÈHDÑ—'<o'¼ ‰Ž,>·FA póºà˜^ä˜Ñ–µ¼óÁâ‘ݽRO¾Í#oÜBm‚å)0ìÝ@r¦^…µ‚µÆlíd‰íÕXG‚’u\´y_¬#Çv 9ÖØn!Çò–XGŽÍáUŸˆî–5éìl‚ËtkÁ²ˆ¼›wÈpBÓ"…™ÜÂ8I/Ê6¡íâóK›˜wÈrÌrÌr, 9¶8A½iN MÚ}r¼í˜ÔðúÌz_ ¯$q)Ú”»WJK=2¦XÅ;dXì‡ç¥Ý0üÞ „R?>,ä0¿xÃa0=ÍÁ½{^FŽÝƒ@Žà_Ă3±°7#ˆíä•â0ˆé^ìžðJ1p&¾N†ë1Ù^)Ž`¾x/__î?ÜÞß|þrw{Üœî>~xøäÍéîtÿcÑÛÃßOÇ÷Ç·ï¿œþüüðÄ»_?þüÛ·Ÿ>µñ¢¿zõ/Žõú,½ýp¼9¾;Ýÿþþîø[nÇ[ÌVÇÍñîëãí/Øl>ø” ÎÈ\%2¸KàHàì%°gpT@s©® r œ”§ÀÿÃ_cýwÄjeéÐÐœ±/oÇÊÒ¡«féÐ]³tX¯€3K‡˜¥Ã¨fé0.–A)¼tô)ðº0×XÏH¬ü«ÿ?‡\Κ³.n‡ÿzHà.€þ$‰U/Y:t”À,J%0K‡r ÌÒ¡Ró÷UÕøÈKÇž¯ sõœÄjdéà³æÌËb5²tH/Y:d”À,B%0K‡p ÌÒ!R³tˆ–Àü}U¬>òÒ™O×…¹ÆzNbÅY:ø¬9vy;8K˜¥ƒ©fé`.Y:XJ`–Ö˜¥ƒ­æï«<+ =òÒYO×…¹ÆzNb¥Y:è¬9zy;4KQ ÌÒA\³t”À,¤%0KY”,4/‚ 0°$á endstream endobj 34 0 obj<>stream xÚì—ÍŽT9 …_%OÀµóg[BHüì1hšÝhhºˆ†’fÁÛsìÛ³i£ªlX´tUeUòù$N|nU}*uöY†ø§æî¶1¼M¼•Ö«\:«µtóÉ£öÉ£O…`©1y±˜,Eñ--Æ1dÅfd§ÂT›ŒH›GÕâ9gCd¾¸Ù ×á‚snÌMD£XzŸÁbí£Ef+<ÙU±<žæ„@C¦ íN4Œh˜7¾PÁÒ˜bG5{ª5X Tõ•ú[kžY!Ô¢4Š}¸®ok—B104FǾ}DH*Í3ûf4 ¤˜¬4l:3iuÁfP'¬"2'¬•V»o˜èÑ@6q‚;!ˆ$-mÔ ‘/HÓZ>€"1 õ Ò7«âÑ(0€h"’ ×d¡¥×„•ÞÈ &D^Á1öî§%Øtï^{áVú \Æ>w~AC8hì«Â…ìèêE” ¢r¸”ƒýFo°ß©½Œ:ƒe´¢‡68öU¡LcHVÆŒ7Bû€øÐhÐ 4öZ5hXì£Ac_Ž{RhàÒ`“AhÁ… Âʬ¡ãž-ªÛQTǃÞuËE:ÑÑ}^«§O·ç{ Sùk{¹½9Ý}y»½F÷èöÖO%®¶w¯¶·üÆLÿâÙ³ÿAÉ ]_œî®oÿ¸½Ù®N·Ÿ®ï¿yyº=ÝýMO¨Ü¿þÙþÜþxÿãôß÷ûï>~ú÷ó×›oß ?¡#בë·çz¾[þÃKÎ5.y?߰Ͷ%3Ø—@ÊàXñøKà\³u°,Ù:X—À™A[G6+º säzLfeÙ:h÷œv¾;,[õP³uÐX³uÐ\³u,Ù:H—ÀldK`ÏfEKà/:| <æÈõˆÌÊÿä=¸ä¶[N=Ûþ7ñ!7–¸d6—¸ä&K\² Ó%.¹†Ù—Mƒh Ì¿T‰—À_>stream xÚì—ËŠ\G †_EOàS¥[©À{—˜Œw! ‰É8 cgá·J5AÉbà,¦G4úôKuùÏi,Ð+ ]ÿtÂt³L@f¤µ•+HV² p_ÉBÀº’…A0’Ä"YAwò€•ÅÀZ$O0[ÉÚ`êJÖ½ÑÊV„Þ£¶’Gщ2tÔdu„z«wÎ!àtÞÄ„.ÑühÐ5º®±;®1Bc¸Æˆ†kØ&\c††—ïs1Û“]dE¾>3¯y÷ Y÷(º2OfY„ ÄÜkf‰9L54Ì“u®±*FØ®±»šž|»üýõ!ãýŸ~ûó¯Û/_ ¿h¯^y­×û6øùxsüx¹ÿüáîøtï|[g|s¼{¼ûÝšûˆñ/‡‰³×7K\{ÌVád&®—8K–¸‘8*qš8.q’8yŠû/ÏÐYë¬õÖz½ºÎ¸l¯±ëwÃ’gȬp#y†¶—>stream xÚì—ÍN\1 …_ÅOÀ“ØI$„ÔÒ]«‚:ì‹iA-ꔩºàí{ì;ýÑD*wѪB `2þΉ}£k kV*j¿ ±D *ÅX-h”BF Rµ\aÊbÉH”dÉ’Hƒ%K&­ž,T²'C¸yr¡êÊR©ÍÉšZ²â-[‘oD#1»¸&DÕ$sœ !N®¯JœÙ l=7'*ŠP'±f# <Š{xÌ[*ð°ˆàÑb±­úšP É×\¹àOξfý ¾Ö‰¹Yw›[eDÅÜL*gs«‰¢D#¬CÒœ€‡'RÄ “N ¥¹G…G3ËÚð‚Ñ6Ž(RâäŸ&JØ´E‘÷  %|Y¤„¦5‹ ¢ÄUJ̲áAK4£ b<ÔúbÛ@AÉ"x”èŸf;l<¼9-À£‰çÊaÖ«”yÖkˆ¬9å(F0Ž“ï¯q¤ìûkœYsÚ‰Ãæ„PÖä„R.ì<Š7‡áaÇ›.Öï¡võu}Gq8ü‡¡5´†ÖÐZCkh ­¡5´†ÖÐê´¾ 0¸€7 endstream endobj 37 0 obj<>stream xÚì“KjAD¯’'ÐTVþª@xao ^È;ã…±ä…nïÈ@ðj1LÒÄ‹ì×Õ=·‡ ™ÛS*û¿Dcö°dÎÕÃŽ!†Øêl¨xtÁ°‡IŽ‡K.†} §,c¸d+ÃKöbx‹Žì4’ªÞñTѩωi7&jÙÂêN"ú>I$¦M÷žEb‰–“ÀŽ5›(ìØ£‰ÂŽMÛê–ÉTú“ÂýH lT®’ét.„ƒÒµ1ѺÃIí¥2‹Þ áEñ…‹æ Ó|E?])¦4_…‰æÛ¤ùÂ)Í7ŽÁi¾Í¶ ù6±¤ùv±¢ùŽ>8رh¾±cÓ|/ñAó½Åæ6v… &œõ„9¦)n0ÇdâsLŽi‘ˆ~'H¤x‰/%µH`ÇÊ&;¶7¡*1´ „c´ÌP“ÐlB]b:‰è×DbÚ$J‹Ē'±%r6pÔhbbGU;V41±cÏ&ÎAóý&“HI¥ù,ÉIs„Óh>7&šÛtš›JÍΤ¹áËHšvÍ-ú#!›æ†<ÆaKjÐܶ”Òáš4wÅDsŸRFs7)§9Â…‡%··—×çû‡ç»×·§‡ËÝõéñþýʧëÓõùÛ¸òþû~ùrùüãíú÷õ=ñõ×ãÏß^^DoƇ§ët®ÓuºN×é:]§ët®ÓuºN×é:]§ët®ÓuºN×é:]§ët®Óuºþ¿ëŸ"Œ{å endstream endobj 38 0 obj<>stream xÚì“Mn”A D¯â$íö_[Š²€-‹°C,‰DDÄHIXäöØEÀ¼˜kôª<¯¿Yj´H–:…÷gÛîáÐÞ§‡ì·zYq§YcRk¸@“†MÈWæä°U`§#€ƒ’Ê8‰—7]$³6îL¼¹yß5e\ˆÅ;Q0«"aý;‘ðš‰úíHâP$jÇÙˆÚ‘«Q;¶ïÝÚ ßЇpXN[ A[áu@éÈš`]ðvh¦ð>µã@üÔŽó‚wÂüXŸ.3ÌOÔó†7ÌO=y¬0O® æ ÌSHæYpÀ<­˜gíH˜ç!]0Ï$å6ç‚•ÛœW=ëÝæ¼6©´9/!Õ6oXõ a}'pR$‚4‰Ú‰ÚqÚœ¹vd›33Ùbè×…‚ ³q›×½ ÛŠ„õu[ÿŽÉ$‘2 $™)IæmÎ[´yÝ©šÚœwí8mλvd›sÁ¾`¾­o2NÎ0ßA¾a^° ÌwÖsYä sarƒyÁî0—úg8Ì¥vÌÅúO‚DíH˜KíH˜Ë¡X0—¤`˜æÊ5Á\7…À\…Ba^pÔaÑÍÍõ‡ËóýÃóÝëÛÓÃõÝåéñþý›—§Ëó×uµèýõíúóõ§ïo—?¯ïÄ—Ÿ?~ý~xy!¾Z··Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Ó5]Óõÿ]—çzZ endstream endobj 39 0 obj<>stream xÚì“MjA …¯¢xªô[“E² dáìB!6ÄÄdÀv¾}¤‡O´˜1|ï©¿®nÙj´H¶:…÷oÐ6îáóé!I–Ö`Åfm“ZÚ4lB¾6%?€­ú;”ð¡<€“öò¦‹Ü[÷M›wóÎ5e\h‹w¢à­Š„õu"á5%uíHÚ¡HԎÈڑ«Q;¶ó‚nñ†oh‰C8¬oN,PŽ V8GÝ ƒtdM°.˜Úg¼Oí8?µãÀ¼`N˜뻋DÃ0?Q_0o˜a~êæY°Â=Þ¿ÿóéút}þ¶n½¾_¾\>ÿx»þ}}'¾þzüùûÏÃË í›õáÃtM×tM×tM×tM×tM×tM×tM×tM×tM×tM×tM×tM×tM×tM×ÿÞõO€÷ÿ_â endstream endobj 40 0 obj<> endobj 41 0 obj<> endobj 42 0 obj<> endobj 43 0 obj<>stream Acrobat Distiller 7.0.5 (Windows) Acrobat PDFMaker 7.0.7 for Excel 2007-08-23T08:21:10+01:00 2007-08-23T08:21:08+01:00 2007-08-23T08:21:10+01:00 application/pdf res2.xls Papapanagiotou Petros uuid:442b2eb0-3b8c-4e98-8e27-22a7e6e5e594 uuid:2d7ec191-2850-4a40-baec-e3f5d9948b81 Metronet endstream endobj 44 0 obj<> endobj xref 0 3244 0000000000 65535 f 0000010752 00000 n 0000010960 00000 n 0000017938 00000 n 0000018146 00000 n 0000023096 00000 n 0000023160 00000 n 0000023222 00000 n 0000023275 00000 n 0000027889 00000 n 0000028983 00000 n 0000030071 00000 n 0000032552 00000 n 0000035323 00000 n 0000036773 00000 n 0000037792 00000 n 0000038821 00000 n 0000039826 00000 n 0000040869 00000 n 0000041866 00000 n 0000042898 00000 n 0000043898 00000 n 0000044924 00000 n 0000045953 00000 n 0000046984 00000 n 0000048030 00000 n 0000049063 00000 n 0000050125 00000 n 0000051145 00000 n 0000052196 00000 n 0000053225 00000 n 0000054271 00000 n 0000055311 00000 n 0000056351 00000 n 0000057402 00000 n 0000058421 00000 n 0000059453 00000 n 0000060358 00000 n 0000061035 00000 n 0000061712 00000 n 0000062383 00000 n 0000062418 00000 n 0000062442 00000 n 0000062508 00000 n 0000066362 00000 n 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f 0000000000 65535 f trailer <> startxref 116 %%EOF hol-light/Boyer_Moore/waterfall.ml000066400000000000000000001066201303454263000175060ustar00rootroot00000000000000(******************************************************************************) (* FILE : waterfall.ml *) (* DESCRIPTION : `Waterfall' of heuristics. Clauses pour over. *) (* Some evaporate. Others collect in a pool to be cleaned up. *) (* Heuristics that act on a clause send the new clauses to *) (* the top of the waterfall. *) (* *) (* READS FILES : *) (* WRITES FILES : *) (* *) (* AUTHOR : R.J.Boulton *) (* DATE : 9th May 1991 *) (* *) (* LAST MODIFIED : R.J.Boulton *) (* DATE : 12th August 1992 *) (* *) (* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) (* DATE : July 2009 *) (******************************************************************************) (*============================================================================*) (* Some auxiliary functions *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* proves : thm -> term -> bool *) (* *) (* Returns true if and only if the theorem proves the term without making any *) (* assumptions. *) (*----------------------------------------------------------------------------*) let proves th tm = (let (hyp,concl) = dest_thm th in (hyp = []) && (concl = tm));; (*----------------------------------------------------------------------------*) (* apply_proof : proof -> term list -> proof *) (* *) (* Converts a proof into a new proof that checks that the theorems it is *) (* given have no hypotheses and have conclusions equal to the specified *) (* terms. Used to make a proof robust. *) (*----------------------------------------------------------------------------*) let apply_proof f tms ths = try (if (itlist (fun (tm,th) b -> (proves th tm) && b) (List.combine tms ths) true) then (f ths) else failwith "" ) with Failure _ -> failwith "apply_proof";; (*============================================================================*) (* The `waterfall' for heuristics *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* proof_printing : bool *) (* *) (* Assignable variable. If true, clauses are printed as they are `poured' *) (* over the waterfall. *) (*----------------------------------------------------------------------------*) let proof_printing = ref false;; (*----------------------------------------------------------------------------*) (* proof_printer : bool -> bool *) (* *) (* Function for setting the flag that controls the printing of clauses as *) (* are `poured' over the waterfall. *) (*----------------------------------------------------------------------------*) let proof_printer state = let old_state = !proof_printing in proof_printing := state; old_state;; (*----------------------------------------------------------------------------*) (* proof_print_depth : int *) (* *) (* Assignable variable. A number indicating the `depth' of the proof and more *) (* practically the number of spaces printed before a term. *) (*----------------------------------------------------------------------------*) let proof_print_depth = ref 0;; (*----------------------------------------------------------------------------*) (* inc_print_depth : * -> * *) (* *) (* Identity function that has the side-effect of incrementing the *) (* print_proof_depth. *) (*----------------------------------------------------------------------------*) let inc_print_depth x = (proof_print_depth := !proof_print_depth + 1; x);; (*----------------------------------------------------------------------------*) (* dec_print_depth : * -> * *) (* *) (* Identity function that has the side-effect of decrementing the *) (* print_proof_depth. *) (*----------------------------------------------------------------------------*) let dec_print_depth x = if (!proof_print_depth < 1) then (proof_print_depth := 0; x) else (proof_print_depth := !proof_print_depth - 1; x);; (*----------------------------------------------------------------------------*) (* proof_print_term : term -> term *) (* *) (* Identity function on terms that has the side effect of printing the term *) (* if the `proof_printing' flag is set to true. *) (*----------------------------------------------------------------------------*) let proof_print_term tm = if !proof_printing then (print_string (implode (replicate " " !proof_print_depth)); print_term tm; print_newline () ; tm) else tm;; let proof_print_thm thm = if !proof_printing then ( print_thm thm; print_newline (); print_newline());; let proof_print_tmi (tm,i) = if !proof_printing then ( proof_print_term tm; print_string " ("; print_bool i; print_string ")"; (tm,i) ) else (tm,i);; (* let proof_print_clause cl = if !proof_printing then ( match cl with | Clause_proved thm -> (print_thm thm; print_newline (); cl) | _ -> cl ) else cl;; *) (*----------------------------------------------------------------------------*) (* proof_print_newline : * -> * *) (* *) (* Identity function that has the side effect of printing a newline if the *) (* `proof_printing' flag is set to true. *) (*----------------------------------------------------------------------------*) let proof_print_newline x = if !proof_printing then (print_newline (); x) else x;; let proof_print_string s x = if !proof_printing then (print_string s; x) else x;; let proof_print_string_l s x = if !proof_printing then (print_string s; print_newline (); x) else x;; (*----------------------------------------------------------------------------*) (* Recursive type for holding partly processed clauses. *) (* *) (* A clause is either still to be proved, has been proved, or can be proved *) (* once sub-clauses have been. A clause that is still to be proved carries a *) (* flag indicating whether or not it is an induction step. *) (*----------------------------------------------------------------------------*) type clause_tree = Clause of (term * bool) | Clause_proved of thm | Clause_split of clause_tree list * (thm list -> thm);; let rec proof_print_clausetree cl = if !proof_printing then ( proof_print_string_l "Clause tree:" (); match cl with | Clause (tm,bool) -> (print_term tm; print_newline ()) | Clause_proved thm -> (print_thm thm; print_newline()) | Clause_split (tlist,proof) -> (print_string "Split -> "; print_int (length tlist); print_newline () ; let void = map proof_print_clausetree tlist in () ));; (*----------------------------------------------------------------------------*) (* waterfall : ((term # bool) -> ((term # bool) list # proof)) list -> *) (* (term # bool) -> *) (* clause_tree *) (* *) (* `Waterfall' of heuristics. Takes a list of heuristics and a term as *) (* arguments. Each heuristic should fail if it can do nothing with its input. *) (* Otherwise the heuristic should return a list of new clauses to be proved *) (* together with a proof of the original clause from these new clauses. *) (* *) (* Clauses that are not processed by any of the heuristics are placed in a *) (* leaf node of the tree, to be proved later. The heuristics are attempted in *) (* turn. If a heuristic returns an empty list of new clauses, the proof is *) (* applied to an empty list, and the resultant theorem is placed in the tree *) (* as a leaf node. Otherwise, the tree is split, and each of the new clauses *) (* is passed to ALL of the heuristics. *) (*----------------------------------------------------------------------------*) let nth_tail n l = if (n > length l) then [] else let rec repeattl l i = if ( i = 0 ) then l else tl (repeattl l (i-1)) in repeattl l n;; let rec waterfall heuristics tmi = bm_steps := hashI ((+) 1) !bm_steps; let rec flow_on_down rest_of_heuristics tmi = if (is_F (fst tmi)) then (failwith "cannot prove") else if (rest_of_heuristics = []) then (Clause tmi) else try ((let (tms,f) = hd rest_of_heuristics tmi in if (tms = []) then (proof_print_string "Proven:" (); proof_print_thm (f []) ; Clause_proved (f [])) else if ((tl tms) = []) then (Clause_split ([waterfall heuristics (hd tms)],f)) else Clause_split ((dec_print_depth o map (waterfall heuristics o proof_print_newline) o inc_print_depth) tms, f)) )with Failure s -> (if (s = "cannot prove") then failwith s else (flow_on_down (tl rest_of_heuristics) tmi) ) in flow_on_down heuristics (proof_print_tmi tmi);; let rec filtered_waterfall heuristics warehouse tmi = bm_steps := hashI ((+) 1) !bm_steps; if (max_var_depth (fst tmi) > 12) then let void = (warn true "Reached maximum depth!") in failwith "cannot prove" else let heurn = try (assoc (fst tmi) warehouse) with Failure _ -> 0 in let warehouse = (if (heurn > 0) then let void = proof_print_string ("Warehouse kicking in! Skipping " ^ string_of_int(heurn) ^ " heuristic(s)") () ; in let void = proof_print_newline () in (List.remove_assoc (fst tmi) warehouse) else (warehouse)) in let rec flow_on_down rest_of_heuristics tmi it = if (is_F (fst tmi)) then (failwith "cannot prove") else let rest_of_heuristics = nth_tail heurn rest_of_heuristics in if (rest_of_heuristics = []) then (Clause tmi) else try (let (tms,f) = hd rest_of_heuristics tmi in if (tms = []) then (proof_print_string "Proven:" (); proof_print_thm (f []) ; Clause_proved (f [])) else if ((tl tms) = []) then Clause_split ([filtered_waterfall heuristics (((fst tmi),it)::warehouse) (hd tms)],f) else Clause_split ((dec_print_depth o map (filtered_waterfall heuristics (((fst tmi),it)::warehouse) o proof_print_newline) o inc_print_depth) tms, f) )with Failure s -> ( if (s = "cannot prove") then failwith s else (flow_on_down (tl rest_of_heuristics) tmi (it+1)) ) in flow_on_down heuristics ((hashI proof_print_term) tmi) 1;; (* in let fringe = fringe_of_clause_tree restree in if (fringe = []) then restree else ( waterfall_warehouse := ((fst tmi),it)::(!waterfall_warehouse) ; restree ) *) (*----------------------------------------------------------------------------*) (* fringe_of_clause_tree : clause_tree -> (term # bool) list *) (* *) (* Computes the fringe of a clause_tree, including in the resultant list only *) (* those clauses that remain to be proved. *) (*----------------------------------------------------------------------------*) let rec fringe_of_clause_tree tree = match tree with | (Clause tmi) -> [tmi] | (Clause_proved _) -> [] | (Clause_split (trees,_)) -> (flat (map fringe_of_clause_tree trees));; (*----------------------------------------------------------------------------*) (* prove_clause_tree : clause_tree -> proof *) (* *) (* Given a clause_tree, returns a proof that if given theorems for the *) (* unproved clauses in the tree, returns a theorem for the clause at the root *) (* of the tree. The list of theorems must be in the same order as the clauses *) (* appear in the fringe of the tree. *) (*----------------------------------------------------------------------------*) let prove_clause_tree tree ths = try( let rec prove_clause_trees trees ths = if (trees = []) then ([],ths) else let (th,ths') = prove_clause_tree' (hd trees) ths in let (thl,ths'') = prove_clause_trees (tl trees) ths' in (th::thl,ths'') and prove_clause_tree' tree ths = match tree with | (Clause (tm,_)) -> (let th = hd ths in if (proves th tm) then (th,tl ths) else failwith "prove_clause_tree") | (Clause_proved th) -> (th,ths) | (Clause_split (trees,f)) -> (let (thl,ths') = prove_clause_trees trees ths in (f thl,ths')) in (let (th,[]) = (prove_clause_tree' tree ths) in th) ) with Failure _ -> failwith "prove_clause_tree";; (*============================================================================*) (* Eliminating instances in the `pool' of clauses remaining to be proved *) (* *) (* Constructing partial orderings is probably overkill. It may only be *) (* necessary to split the clauses into two sets, one of most general clauses *) (* and the rest. This would still be computationally intensive, but it would *) (* avoid comparing two clauses that are both instances of some other clause. *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* inst_of : term -> term -> thm -> thm *) (* *) (* Takes two terms and computes whether the first is an instance of the *) (* second. If this is the case, a proof of the first term from the second *) (* (assuming they are formulae) is returned. Otherwise the function fails. *) (*----------------------------------------------------------------------------*) let inst_of tm patt = try( (let (_,tm_bind,ty_bind) = term_match [] patt tm in let (insts,vars) = List.split tm_bind in let f = (SPECL insts) o (GENL vars) o (INST_TYPE ty_bind) in fun th -> apply_proof (f o hd) [patt] [th] )) with Failure _ -> failwith "inst_of";; (*----------------------------------------------------------------------------*) (* Recursive datatype for a partial ordering of terms using the *) (* `is an instance of' relation. *)let proof_print_thm thm = if !proof_printing then ( print_thm thm; print_newline (); print_newline());; (* *) (* The leaf nodes of the tree are terms that have no instances. The other *) (* nodes have a list of instance trees and proofs of each instance from the *) (* term at that node. *) (* *) (* Each term carries a number along with it. This is used to keep track of *) (* where the term came from in a list. The idea is to take the fringe of a *) (* clause tree, number the elements, then form partial orderings so that *) (* only the most general theorems have to be proved. *) (*----------------------------------------------------------------------------*) type inst_tree = No_insts of (term * int) | Insts of (term * int * (inst_tree * (thm -> thm)) list);; (*----------------------------------------------------------------------------*) (* insert_into_inst_tree : (term # int) -> inst_tree -> inst_tree *) (* insert_into_inst_trees : (term # int # (thm -> thm)) -> *) (* (inst_tree # (thm -> thm)) list -> *) (* (inst_tree # (thm -> thm)) list *) (* *) (* Mutually recursive functions for constructing partial orderings, ordered *) (* by `is an instance of' relation. The algorithm is grossly inefficient. *) (* Structures are repeatedly destroyed and rebuilt. Reference variables *) (* should be used for efficiency. *) (* *) (* Inserting into a single tree: *) (* *) (* If tm' is an instance of tm, tm is put in the root node, with the old tree *) (* as its single child. If tm is not an instance of tm', the function fails. *) (* Assume now that tm is an instance of tm'. If the tree is a leaf, it is *) (* made into a branch and tm is inserted as the one and only child. If the *) (* tree is a branch, an attempt is made to insert tm in the list of *) (* sub-trees. If this fails, tm is added as a leaf to the list of instances. *) (* Note that if tm is not an instance of tm', then it cannot be an instance *) (* of the instances of tm'. *) (* *) (* Inserting into a list of trees: *) (* *) (* The list of trees carry proofs with them. The list is split into those *) (* whose root is an instance of tm, and those whose root is not. The proof *) (* associated with a tree that is an instance is replaced by a proof of the *) (* term from tm. If the list of trees that are instances is non-empty, they *) (* are made children of a node containing tm, and this new tree is added to *) (* the list of trees that are n't instances. If tm has instances in the list, *) (* it cannot be the case that tm is an instance of one of the other trees in *) (* the list, for the trees in a list must be unrelated. *) (* *) (* If there are no instances of tm in the list of trees, an attempt is made *) (* to insert tm into the list. If it is unrelated to all of the trees, this *) (* attempt fails, in which case tm is made into a leaf and added to the list. *) (*----------------------------------------------------------------------------*) let rec insert_into_inst_tree (tm,n) tree = match tree with | (No_insts (tm',n')) -> (try ( (let f = inst_of tm' tm in Insts (tm,n,[No_insts (tm',n'),f])) ) with Failure _ -> try( let f = inst_of tm tm' in Insts (tm',n',[No_insts (tm,n),f])) with Failure _ -> failwith "insert_into_inst_tree" ) | (Insts (tm',n',insts)) -> (try (let f = inst_of tm' tm in Insts (tm,n,[Insts (tm',n',insts),f])) with Failure _ -> try(let f = inst_of tm tm' in try( Insts (tm',n',insert_into_inst_trees (tm,n,f) insts)) with Failure _ -> (Insts (tm',n',(No_insts (tm,n),f)::insts)) ) with Failure _ -> failwith "insert_into_inst_tree" ) and insert_into_inst_trees (tm,n,f) insts = let rec instances (tm,n) insts = if (insts = []) then ([],[]) else let (not_instl,instl) = instances (tm,n) (tl insts) and (h,f) = hd insts in let (tm',n') = match h with | (No_insts (tm',n')) -> (tm',n') | (Insts (tm',n',_)) -> (tm',n') in (try( (let f' = inst_of tm' tm in (not_instl,(h,f')::instl)) ) with Failure _ -> ((h,f)::not_instl,instl) ) and insert_into_inst_trees' (tm,n) trees = if (trees = []) then failwith "insert_into_inst_trees'" else (try( ((insert_into_inst_tree (tm,n) (hd trees))::(tl trees)) ) with Failure _ -> ((hd trees)::(insert_into_inst_trees' (tm,n) (tl trees))) ) in let (not_instl,instl) = instances (tm,n) insts in if (instl = []) then try( (lcombinep o (hashI (insert_into_inst_trees' (tm,n)))) (List.split insts) ) with Failure _ -> ((No_insts (tm,n),f)::insts) else (Insts (tm,n,instl),f)::not_instl;; (*----------------------------------------------------------------------------*) (* mk_inst_trees : (term # int) list -> inst_tree list *) (* *) (* Constructs a partial ordering of terms under the `is an instance of' *) (* relation from a list of numbered terms. *) (* *) (* A dummy proof is passed to the call of insert_into_inst_trees. The result *) (* of the call has a proof associated with the root of each tree. These *) (* proofs are dummies and so are discarded before the final result is *) (* returned. *) (*----------------------------------------------------------------------------*) let mk_inst_trees tmnl = let rec mk_inst_trees' insts tmnl = if (tmnl = []) then insts else let (tm,n) = hd tmnl in mk_inst_trees' (insert_into_inst_trees (tm,n,I) insts) (tl tmnl) in map fst (mk_inst_trees' [] tmnl);; (*----------------------------------------------------------------------------*) (* roots_of_inst_trees : inst_tree list -> term list *) (* *) (* Computes the terms at the roots of a list of partial orderings. *) (*----------------------------------------------------------------------------*) let rec roots_of_inst_trees trees = if (trees = []) then [] else let tm = match (hd trees) with | (No_insts (tm,_)) -> tm | (Insts (tm,_,_)) -> tm in tm::(roots_of_inst_trees (tl trees));; (*----------------------------------------------------------------------------*) (* prove_inst_tree : inst_tree -> thm -> (thm # int) list *) (* *) (* Given a partial ordering of terms and a theorem for its root, returns a *) (* list of theorems for the terms in the tree. *) (*----------------------------------------------------------------------------*) let rec prove_inst_tree tree th = match tree with | (No_insts (tm,n)) -> (if (proves th tm) then [(th,n)] else failwith "prove_inst_tree") | (Insts (tm,n,insts)) -> (if (proves th tm) then (th,n)::(flat (map (fun (tr,f) -> prove_inst_tree tr (f th)) insts)) else failwith "prove_inst_tree");; (*----------------------------------------------------------------------------*) (* prove_inst_trees : inst_tree list -> thm list -> thm list *) (* *) (* Given a list of partial orderings of terms and a list of theorems for *) (* their roots, returns a sorted list of theorems for the terms in the trees. *) (* The sorting is done based on the integer labels attached to each term in *) (* the trees. *) (*----------------------------------------------------------------------------*) let prove_inst_trees trees ths = try ( map fst (sort_on_snd (flat (map (uncurry prove_inst_tree) (lcombinep (trees,ths))))) ) with Failure _ -> failwith "prove_inst_trees";; (*----------------------------------------------------------------------------*) (* prove_pool : conv -> term list -> thm list *) (* *) (* Attempts to prove the pool of clauses left over from the waterfall, by *) (* applying the conversion, conv, to the most general clauses. *) (*----------------------------------------------------------------------------*) let prove_pool conv tml = let tmnl = number_list tml in let trees = mk_inst_trees tmnl in let most_gen_terms = roots_of_inst_trees trees in let ths = map conv most_gen_terms in prove_inst_trees trees ths;; (*============================================================================*) (* Boyer-Moore prover *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* WATERFALL : ((term # bool) -> ((term # bool) list # proof)) list -> *) (* ((term # bool) -> ((term # bool) list # proof)) -> *) (* (term # bool) -> *) (* thm *) (* *) (* Boyer-Moore style automatic proof procedure. Takes a list of heuristics, *) (* and a single heuristic that does induction, as arguments. The result is a *) (* function that, given a term and a Boolean, attempts to prove the term. The *) (* Boolean is used to indicate whether the term is the step of an induction. *) (* It will normally be set to false for an external call. *) (*----------------------------------------------------------------------------*) let rec WATERFALL heuristics induction (tm,(ind:bool)) = let conv tm = proof_print_string "Doing induction on:" () ; bm_steps := hash ((+) 1) ((+) 1) !bm_steps ; let void = proof_print_term tm ; proof_print_newline () in let (tmil,proof) = induction (tm,false) in dec_print_depth (proof (map (WATERFALL heuristics induction) (inc_print_depth tmil))) in let void = proof_print_newline () in let tree = waterfall heuristics (tm,ind) in let tmil = fringe_of_clause_tree tree in let thl = prove_pool conv (map fst tmil) in prove_clause_tree tree thl;; let rec FILTERED_WATERFALL heuristics induction warehouse (tm,(ind:bool)) = let conv tm = (* let constr_check = ind && not((find_bm_terms (fun t -> count_constructors t > 5) tm) = []) in *) let constr_check = (max_var_depth tm > 12) in if (constr_check) then let void = (warn true "Reached maximum depth!") in failwith "cannot prove" else let heurn = try (assoc tm warehouse) with Failure _ -> 0 in let warehouse = (if (heurn > 0) then (List.remove_assoc tm warehouse) else (warehouse)) in if (heurn > length heuristics) then ( warn true "Induction loop detected."; failwith "cannot prove" ) else proof_print_string "Doing induction on:" (); bm_steps := hash ((+) 1) ((+) 1) !bm_steps ; let void = proof_print_term tm ; proof_print_newline () in let (tmil,proof) = induction (tm,false) in dec_print_depth (proof (map (FILTERED_WATERFALL heuristics induction ((tm,(length heuristics) + 1)::warehouse)) (inc_print_depth tmil))) in let void = proof_print_newline () in let tree = filtered_waterfall heuristics [] (tm,ind) (* in let void = proof_print_clausetree tree *) in let tmil = fringe_of_clause_tree tree in let thl = prove_pool conv (map fst tmil) in prove_clause_tree tree thl;; (*============================================================================*) (* Some sample heuristics *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* conjuncts_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* `Heuristic' for splitting a conjunction into a list of conjuncts. *) (* Right conjuncts are split recursively. *) (* Fails if the argument term is not a conjunction. *) (*----------------------------------------------------------------------------*) let conjuncts_heuristic (tm,(i:bool)) = let tms = conj_list tm in if (length tms = 1) then failwith "conjuncts_heuristic" else (map (fun tm -> (tm,i)) tms,apply_proof LIST_CONJ tms);; (*----------------------------------------------------------------------------*) (* refl_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* `Heuristic' for proving that terms of the form "x = x" are true. Fails if *) (* the argument term is not of this form. Otherwise it returns an empty list *) (* of new clauses, and a proof of the original term. *) (*----------------------------------------------------------------------------*) let refl_heuristic (tm,(i:bool)) = try(if (lhs tm = rhs tm) then (([]:(term * bool) list),apply_proof (fun ths -> REFL (lhs tm)) []) else failwith "" ) with Failure _ -> failwith "refl_heuristic";; (*----------------------------------------------------------------------------*) (* clausal_form_heuristic : (term # bool) -> ((term # bool) list # proof) *) (* *) (* `Heuristic' that tests a term to see if it is in clausal form, and if not *) (* converts it to clausal form and returns the resulting clauses as new *) (* `goals'. It is critical for efficiency that the normalization is only done *) (* if the term is not in clausal form. Note that the functions `conjuncts' *) (* and `disjuncts' are not used for the testing because they split trees of *) (* conjuncts (disjuncts) rather than simply `linear' con(dis)junctions. *) (* If the term is in clausal form, but is not a single clause, it is split *) (* into single clauses. If the term is in clausal form but contains Boolean *) (* constants, the normalizer is applied to it. A single new goal will be *) (* produced in this case unless the result of the normalization was true. *) (*----------------------------------------------------------------------------*) let clausal_form_heuristic (tm,(i:bool)) = try (let is_atom tm = (not (has_boolean_args_and_result tm)) || (is_var tm) || (is_const tm) in let is_literal tm = (is_atom tm) || ((is_neg tm) && (try (is_atom (rand tm)) with Failure _ -> false)) in let is_clause tm = forall is_literal (disj_list tm) in let result_string = fun tms -> let s = length tms in let plural = if (s=1) then "" else "s" in ("-> Clausal Form Heuristic (" ^ string_of_int(s) ^ " clause" ^ plural ^ ")") in if (forall is_clause (conj_list tm)) & (not (free_in `T` tm)) && (not (free_in `F` tm)) then if (is_conj tm) then let tms = conj_list tm in (proof_print_string_l (result_string tms) () ; (map (fun tm -> (tm,i)) tms,apply_proof LIST_CONJ tms)) else failwith "" else let th = CLAUSAL_FORM_CONV tm in let tm' = rhs (concl th) in if (is_T tm') then (proof_print_string_l "-> Clausal Form Heuristic" () ; ([],apply_proof (fun _ -> EQT_ELIM th) [])) else let tms = conj_list tm' in (proof_print_string_l (result_string tms) () ; (map (fun tm -> (tm,i)) tms, apply_proof ((EQ_MP (SYM th)) o LIST_CONJ) tms)) ) with Failure _ -> failwith "clausal_form_heuristic";; let meson_heuristic (tm,(i:bool)) = try( let meth = MESON (rewrite_rules()) tm in (([]:(term * bool) list),apply_proof (fun ths -> meth) []) ) with Failure _ -> failwith "meson_heuristic";; let taut_heuristic (tm,(i:bool)) = try( let tautthm = TAUT tm in (proof_print_string_l "-> Tautology Heuristic" () ; (([]:(term * bool) list),apply_proof (fun ths -> tautthm) [])) ) with Failure _ -> failwith "taut_heuristic";; let setify_heuristic (tm,(i:bool)) = try ( if (not (is_disj tm)) then failwith "" else let tms = disj_list tm in let tms' = setify tms in let tm' = list_mk_disj tms' in if ((length tms) = (length tms')) then failwith "" else let th = TAUT (mk_imp (tm',tm)) in (proof_print_string_l "-> Setify Heuristic" () ; ([tm',i],apply_proof ((MP th) o hd) [tm'])) ) with Failure _ -> failwith "setify_heuristic";; hol-light/CHANGES000066400000000000000000017403521303454263000137540ustar00rootroot00000000000000 * ***************************************************************** * NB: This CHANGES file no longer gives a comprehensive list of * * changes made to the system. In particular, most changes in the * * Multivariate theories are excluded, simply because there are * * so many of them that tracking them would be tedious. For more * * detailed update lists, consult the git logs ("git log" if you * * have the system downloaed) or the list of commits on the Web * * page: https://github.com/jrh13/hol-light/commits/master * * ***************************************************************** Fri 6th Jan 2017 iterate.ml, 100/cayley_hamilton.ml Added two more generic "iterate" theorems that were already there in specific instances, and re-derived the special cases from them: ITERATE_RESTRICT_SET = |- !op. monoidal op ==> !P s f. iterate op {x | x IN s /\ P x} f = iterate op s (\x. if P x then f x else neutral op) ITERATE_IMAGE_GEN = |- !op. monoidal op ==> !f g. FINITE s ==> iterate op s g = iterate op (IMAGE f s) (\y. iterate op {x | x IN s /\ f x = y} g) Sun 4th Dec 2016 iterate.ml Added a generic "iterate" version of a theorem already present in various instantiations (SUM_SWAP etc.) ITERATE_SWAP = |- !op. monoidal op ==> (!f s t. FINITE s /\ FINITE t ==> iterate op s (\i. iterate op t (f i)) = iterate op t (\j. iterate op s (\i. f i j))) Thu 17th Nov 2016 arith.ml, real.ml, int.ml, iterate.ml Added a miscellany of trivial but handy theorems: INTER_NUMSEG = |- !m n p q. (m..n) INTER (p..q) = MAX m p..MIN n q INT_SGNS_EQ = |- !x y. int_sgn x = int_sgn y <=> (x = &0 <=> y = &0) /\ (x > &0 <=> y > &0) /\ (x < &0 <=> y < &0) INT_SGNS_EQ_ALT = |- !x y. int_sgn x = int_sgn y <=> (x = &0 ==> y = &0) /\ (x > &0 ==> y > &0) /\ (x < &0 ==> y < &0) LDIV_LT_EQ = |- !a b n. ~(a = 0) ==> (n < b DIV a <=> a * (n + 1) <= b) RDIV_LT_EQ = |- !a b n. ~(a = 0) ==> (b DIV a < n <=> b < a * n) REAL_SGNS_EQ = |- !x y. real_sgn x = real_sgn y <=> (x = &0 <=> y = &0) /\ (x > &0 <=> y > &0) /\ (x < &0 <=> y < &0) REAL_SGNS_EQ_ALT = |- !x y. real_sgn x = real_sgn y <=> (x = &0 ==> y = &0) /\ (x > &0 ==> y > &0) /\ (x < &0 ==> y < &0) Mon 24th Oct 2016 wf.ml Added the following theorem about defining recursive functions based on an existential condition, after finally getting tired of effectively proving special cases using the same reasoning: WF_REC_EXISTS : thm = |- WF (<<) ==> (!P. (!f g x y. (!z. z << x ==> f z = g z) ==> (P f x y <=> P g x y)) /\ (!f x. (!z. z << x ==> P f z (f z)) ==> (?y. P f x y)) ==> (?f. !x. P f x (f x))) Sun 23rd Oct 2016 sets.ml, Library/isum.ml, Library/products.ml Added the following occasionally handy manipulative theorem for iterated operations, the generic one and various instances: ITERATE_UNIV = |- !op. monoidal op ==> (!f s. support op f (:A) SUBSET s ==> iterate op s f = iterate op (:A) f) NSUM_UNIV = |- !f s. support (+) f (:A) SUBSET s ==> nsum s f = nsum (:A) f SUM_UNIV = |- !f s. support (+) f (:A) SUBSET s ==> sum s f = sum (:A) f ISUM_UNIV = |- !f s. support (+) f (:A) SUBSET s ==> isum s f = isum (:A) f NPRODUCT_UNIV = |- !f s. support (*) f (:A) SUBSET s ==> nproduct s f = nproduct (:A) f PRODUCT_UNIV = |- !f s. support (*) f (:A) SUBSET s ==> product s f = product (:A) f Thu 6th Oct 2016 preterm.ml, bool.ml, impconv.ml, nums.ml Removed a few bindings that generate "unused variable" warnings from OCaml. Thu 6th Oct 2016 calc_rat.ml, Multivariate/complexes.ml Improved REAL_FIELD so that it does a somewhat better job of handling denominators of the form "c pow n" where c is a rational number and n is non-constant (actually the new version marginally improves the case where c is variable too, e.g. REAL_FIELD `&n pow n / &n pow n = &1`). The main differences are that prenormalization does not distribute "inv" through "pow" in the case of a non-constant power, and then the nonzeroness-proving logic uses obvious facts like ~(x = 0) ==> ~(x^n = 0). For instance things like this now just work: REAL_FIELD `&2 pow m * x / &2 pow (n + m) * &2 pow n = x`;; Also made a completely analogous change to COMPLEX_FIELD so for example COMPLEX_FIELD `Cx(&2) pow n / Cx(&2) pow n = Cx(&1)`;; Tue 4th Oct 2016 int.ml Added the trivial but convenient theorem: INTEGER_REAL_OF_INT = |- !x. integer(real_of_int x) Tue 4th Oct 2016 Minisat/minisat_prove.ml Fixed a long-standing and trivial bug in the preprocessing into clause form, where definitionalization was missing a "mk_neg" in the code processing implications, meaning they were partly confused with disjunctions. This must have been able to lurk for such a long time because most of the tests are already in clausal form. Tue 27th Sep 2016 Library/floor.ml Added a few more theorems about the "floor" function: REAL_FLOOR_FLOOR_DIV = |- !x n. floor (floor x / &n) = floor (x / &n) REAL_FLOOR_LT = |- !x n. integer n ==> (floor x < n <=> x < n) REAL_FLOOR_TRIANGLE = |- !x y. floor x + floor y <= floor (x + y) /\ floor (x + y) <= (floor x + floor y) + &1 REAL_LT_FLOOR = |- !x n. integer n ==> (n < floor x <=> n <= x - &1) and renamed the existing REAL_FLOOR_LT to REAL_FLOOR_LT_REFL: |- !x. floor x < x <=> ~integer x Fri 9th Sep 2016 passim Changed all (?) instances of "&" to "&&" and "or" to "||" to avoid any OCaml "deprecated" warnings which will presumably soon enough become actual errors. Fri 9th Sep 2016 parser.ml, theorems.ml, help.ml, Examples/mizar.ml, Examples/sos.ml, miz3/miz3.ml, Help/*.doc Renamed the parser "or" combinator from "||" to "|||", which is a bit of a mouthful but still quite intuitive. This seemed worth doing in principle given that "||" is overwriting an OCaml builtin, and I was more motivated because the word "or" is now depracated in favour of "||" for the logical "or" operation. Fri 2nd Sep 2016 Library/card.ml Added a couple more lemmas about bounding cardinalities of "sequences" (expressed via cardinal exponentiation for maximum generality): CARD_EXP_LE_REAL = |- !s t. s <=_c (:real) /\ COUNTABLE t ==> s ^_c t <=_c (:real) CARD_EXP_EQ_REAL = |- !s. COUNTABLE s /\ ~(s = {}) ==> (:real) ^_c s =_c (:real) Thu 25th Aug 2016 Library/sets.ml Added a number of simple results about the COUNTABLE case of the new constructs "UNION_OF" and "INTERSECTION_OF". This is the immediately most useful case in topology, but one could of course reasonably add "FINITE" or more general variants too. COUNTABLE_INTERSECTION_OF_COMPLEMENT = |- !P s. (COUNTABLE INTERSECTION_OF P) s <=> (COUNTABLE UNION_OF (\s. P((:A) DIFF s))) ((:A) DIFF s) COUNTABLE_INTERSECTION_OF_IDEMPOT = |- !P:(A->bool)->bool. COUNTABLE INTERSECTION_OF COUNTABLE INTERSECTION_OF P = COUNTABLE INTERSECTION_OF P COUNTABLE_INTERSECTION_OF_INC = |- !P s:A->bool. P s ==> (COUNTABLE INTERSECTION_OF P) s COUNTABLE_INTERSECTION_OF_INTER = |- !P s t. (COUNTABLE INTERSECTION_OF P) s /\ (COUNTABLE INTERSECTION_OF P) t ==> (COUNTABLE INTERSECTION_OF P) (s INTER t) COUNTABLE_INTERSECTION_OF_INTERS = |- !P u:(A->bool)->bool. COUNTABLE u /\ (!s. s IN u ==> (COUNTABLE INTERSECTION_OF P) s) ==> (COUNTABLE INTERSECTION_OF P) (INTERS u) COUNTABLE_INTERSECTION_OF_UNION = |- !P:(A->bool)->bool. (!s t. P s /\ P t ==> P(s UNION t)) ==> (!s t. (COUNTABLE INTERSECTION_OF P) s /\ (COUNTABLE INTERSECTION_OF P) t ==> (COUNTABLE INTERSECTION_OF P) (s UNION t)) COUNTABLE_UNION_OF_ASCENDING = |- !P s:A->bool. P {} /\ (!t u. P t /\ P u ==> P(t UNION u)) ==> ((COUNTABLE UNION_OF P) s <=> ?t. (!n. P(t n)) /\ (!n. t n SUBSET t(SUC n)) /\ UNIONS {t n | n IN (:num)} = s) COUNTABLE_UNION_OF_COMPLEMENT = |- !P s. (COUNTABLE UNION_OF P) s <=> (COUNTABLE INTERSECTION_OF (\s. P((:A) DIFF s))) ((:A) DIFF s) COUNTABLE_UNION_OF_EXPLICIT = |- !P s:A->bool. P {} ==> ((COUNTABLE UNION_OF P) s <=> ?t. (!n. P(t n)) /\ UNIONS {t n | n IN (:num)} = s) COUNTABLE_UNION_OF_IDEMPOT = |- !P:(A->bool)->bool. COUNTABLE UNION_OF COUNTABLE UNION_OF P = COUNTABLE UNION_OF P COUNTABLE_UNION_OF_INC = |- !P s:A->bool. P s ==> (COUNTABLE UNION_OF P) s COUNTABLE_UNION_OF_INTER = |- !P:(A->bool)->bool. (!s t. P s /\ P t ==> P(s INTER t)) ==> (!s t. (COUNTABLE UNION_OF P) s /\ (COUNTABLE UNION_OF P) t ==> (COUNTABLE UNION_OF P) (s INTER t)) COUNTABLE_UNION_OF_UNION = |- !P s t. (COUNTABLE UNION_OF P) s /\ (COUNTABLE UNION_OF P) t ==> (COUNTABLE UNION_OF P) (s UNION t) COUNTABLE_UNION_OF_UNIONS = |- !P u:(A->bool)->bool. COUNTABLE u /\ (!s. s IN u ==> (COUNTABLE UNION_OF P) s) ==> (COUNTABLE UNION_OF P) (UNIONS u) Fri 19th Aug 2016 sets.ml Added a few basic theorems, one trivial but very useful fact that complementation is an involution, and a few basic general properties of the "UNION_OF" and "INTERSECTION_OF" constructs: COMPL_COMPL = |- !s. (:A) DIFF ((:A) DIFF s) = s INTERSECTION_OF_INC = |- !P Q s:A->bool. P {s} /\ Q s ==> (P INTERSECTION_OF Q) s INTERSECTION_OF_MONO = |- !P Q Q' s:A->bool. (P INTERSECTION_OF Q) s /\ (!x. Q x ==> Q' x) ==> (P INTERSECTION_OF Q') s UNION_OF_INC = |- !P Q s:A->bool. P {s} /\ Q s ==> (P UNION_OF Q) s UNION_OF_MONO = |- !P Q Q' s:A->bool. (P UNION_OF Q) s /\ (!x. Q x ==> Q' x) ==> (P UNION_OF Q') s Fri 12th Aug 2016 sets.ml Added two natural infix constants "UNION_OF" and "INTERSECTION_OF" for the useful and otherwise longwinded idiom that a set is a suitable (e.g. finite or countable or pairwise disjoint) union/intersection of "somethings". Typical examples are topological: `fsigma = COUNTABLE UNION_OF closed` etc. UNION_OF = |- !P Q. P UNION_OF Q = (\s. ?u. P u /\ (!c. c IN u ==> Q c) /\ UNIONS u = s) INTERSECTION_OF = |- !P Q. P INTERSECTION_OF Q = (\s. ?u. P u /\ (!c. c IN u ==> Q c) /\ INTERS u = s) Sat 9th Jul 2016 Makefile Added yet another disjunct to the OCaml and camlp5 version case split for 4.03 and 6.15 respectively (Flemming Andersen pointed out that this combination failed). Sun 3rd Jul 2016 cart.ml Added a finite-forcing Cartesian product for type indices (a natural thing to have by analogy with finite_sum and finite_diff, and also requested on hol-info by Abid Rauf): finite_prod_tybij = |- (!a. mk_finite_prod(dest_finite_prod a) = a) /\ (!r. r IN 1..dimindex(:A) * dimindex(:B) <=> dest_finite_prod(mk_finite_prod r) = r) FINITE_PROD_IMAGE = |- (:(A,B)finite_prod) = IMAGE mk_finite_prod (1..dimindex(:A) * dimindex(:B)) DIMINDEX_HAS_SIZE_FINITE_PROD = |- (:(M,N)finite_prod) HAS_SIZE dimindex(:M) * dimindex(:N) DIMINDEX_FINITE_PROD = |- dimindex(:(M,N)finite_prod) = dimindex(:M) * dimindex(:N) Sun 3rd Jul 2016 sets.ml, cart.ml Added analogous theorems about distributing intersections over Cartesian products, in two forms: CROSS_INTERS = |- (!s f. s CROSS (INTERS f) = if f = {} then s CROSS UNIV else INTERS {s CROSS t | t IN f}) /\ (!f t. (INTERS f) CROSS t = if f = {} then UNIV CROSS t else INTERS {s CROSS t | s IN f}) CROSS_INTERS_INTERS = |- !f g. (INTERS f) CROSS (INTERS g) = if f = {} then INTERS {UNIV CROSS t | t IN g} else if g = {} then INTERS {s CROSS UNIV | s IN f} else INTERS {s CROSS t | s IN f /\ t IN g} PCROSS_INTERS = |- (!s f. s PCROSS (INTERS f) = if f = {} then s PCROSS UNIV else INTERS {s PCROSS t | t IN f}) /\ (!f t. (INTERS f) PCROSS t = if f = {} then UNIV PCROSS t else INTERS {s PCROSS t | s IN f}) PCROSS_INTERS_INTERS = |- !f g. (INTERS f) PCROSS (INTERS g) = if f = {} then INTERS {UNIV PCROSS t | t IN g} else if g = {} then INTERS {s PCROSS UNIV | s IN f} else INTERS {s PCROSS t | s IN f /\ t IN g} Fri 24th Jun 2016 lists.ml Added a definition of "list_of_seq" mapping a sequence s and length n to the list [s_0,...,s_{n-1}], and various basic list theorems: APPEND_LCANCEL = |- !l1 l2 l3. APPEND l1 l2 = APPEND l1 l3 <=> l2 = l3 APPEND_RCANCEL = |- !l1 l2 l3. APPEND l1 l3 = APPEND l2 l3 <=> l1 = l2 BUTLAST_APPEND = |- !l m. BUTLAST (APPEND l m) = (if m = [] then BUTLAST l else APPEND l (BUTLAST m)) EL_LIST_OF_SEQ = |- !s m n. m < n ==> EL m (list_of_seq s n) = s m LENGTH_LIST_OF_SEQ = |- !s n. LENGTH (list_of_seq s n) = n LIST_EQ = |- !l1 l2. l1 = l2 <=> LENGTH l1 = LENGTH l2 /\ (!n. n < LENGTH l2 ==> EL n l1 = EL n l2) LIST_OF_SEQ_EQ_NIL = |- !s n. list_of_seq s n = [] <=> n = 0 list_of_seq = |- list_of_seq s 0 = [] /\ list_of_seq s (SUC n) = APPEND (list_of_seq s n) [s n] Fri 24th Jun 2016 sets.ml Added a few more handy set lemmas INTER_INTERS = |- (!f s. s INTER INTERS f = if f = {} then s else INTERS {s INTER t | t IN f}) /\ (!f s. INTERS f INTER s = if f = {} then s else INTERS {t INTER s | t IN f}) FINITE_UNIV_PAIR = |- FINITE(:A#A) <=> FINITE(:A) INFINITE_UNIV_PAIR = |- INFINITE(:A#A) <=> INFINITE(:A) Tue 14th Jun 2016 sets.ml Added a few handy set theory lemmas, mainly on a theme of finite subsets of the union of a chain: CARD_LE_UNIONS_CHAIN = |- !f n. (!t u. t IN f /\ u IN f ==> t SUBSET u \/ u SUBSET t) /\ (!t. t IN f ==> FINITE t /\ CARD t <= n) ==> FINITE (UNIONS f) /\ CARD (UNIONS f) <= n CHOOSE_SUBSET_EQ = |- !n s. FINITE s ==> n <= CARD s <=> (?t. t SUBSET s /\ t HAS_SIZE n) FINITE_SUBSET_UNIONS = |- !f s. FINITE s /\ s SUBSET UNIONS f ==> (?f'. FINITE f' /\ f' SUBSET f /\ s SUBSET UNIONS f') FINITE_SUBSET_UNIONS_CHAIN = |- !f s. FINITE s /\ s SUBSET UNIONS f /\ ~(f = {}) /\ (!t u. t IN f /\ u IN f ==> t SUBSET u \/ u SUBSET t) ==> (?t. t IN f /\ s SUBSET t) INTERS_IN_CHAIN = |- !f. FINITE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> INTERS f IN f UNIONS_IN_CHAIN = |- !f. FINITE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> UNIONS f IN f Sat 4th Jun 2016 Examples/division_algebras.ml [new file] Added a new example with two nonexistence proofs for division algebras in higher dimensions; these are fairly straightforward corollaries of some Multivariate results like the global inverse function theorem. Sat 4th Jun 2016 sets.ml Added an equivalential form of an existing theorem: INFINITE_ENUMERATE_EQ = |- !s. INFINITE s <=> (?r. (!m n. m < n ==> r m < r n) /\ IMAGE r (:num) = s) Wed 25th May 2016 sets.ml Added the simple fact that the "proper subset" relation on a finite set is wellfounded: WF_PSUBSET = |- !s. FINITE s ==> WF (\t1 t2. t1 PSUBSET t2 /\ t2 SUBSET s) Sat 7th May 2016 Library/floor.ml Added RATIONAL_BETWEEN_EQ = |- !a b. (?q. rational q /\ a < q /\ q < b) <=> a < b Fri 29th Apr 2016 Library/card.ml Added two theorems asserting that a countable chain has an "equivalent" omega-indexed chain: COUNTABLE_ASCENDING_CHAIN = |- !f:(A->bool)->bool. COUNTABLE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(n) SUBSET u(SUC n)) /\ UNIONS {u n | n IN (:num)} = UNIONS f COUNTABLE_DESCENDING_CHAIN = |- !f:(A->bool)->bool. COUNTABLE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(SUC n) SUBSET u(n)) /\ INTERS {u n | n IN (:num)} = INTERS f Sat 23rd Apr 2016 Library/products.ml Added two obvious theorems about the sizes of cartesian products: HAS_SIZE_CART = |- !P m. (!i. 1 <= i /\ i <= dimindex (:N) ==> {x | P i x} HAS_SIZE m i) ==> {v | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (v$i)} HAS_SIZE nproduct (1..dimindex (:N)) m CARD_CART = |- !P. (!i. 1 <= i /\ i <= dimindex (:N) ==> FINITE {x | P i x}) ==> CARD {v | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (v$i)} = nproduct (1..dimindex (:N)) (\i. CARD {x | P i x}) Wed 13th Apr 2016 Library/wo.ml, Library/card.ml Added a few basic theorems including the fact that a toset contains a cofinal woset. COUNTABLE_FL = |- !l. COUNTABLE(fl l) <=> COUNTABLE l FINITE_FL = |- !l. FINITE(fl l) <=> FINITE l FL = |- !l. fl l = {x | ?y. l(x,y) \/ l(y,x)} FL_SUBSET = |- !l r. l SUBSET r ==> fl l SUBSET fl r TOSET_COFINAL_WOSET = |- !l. toset l ==> ?w. w SUBSET l /\ woset w /\ !x. x IN fl l ==> ?y. y IN fl w /\ l(x,y) Wed 13th Apr 2016 sets.ml Added one more trivial set theorem: INTERS_EQ_UNIV = |- !f. INTERS f = (:A) <=> !s. s IN f ==> s = (:A) Fri 8th Apr 2016 iterate.ml, Library/products.ml Added some theorems about "reflecting" (= reindexing in reverse order) various iterated constructs: ITERATE_REFLECT = |- !op:A->A->A. monoidal op ==> !x m n. iterate op (m..n) x = if n < m then neutral op else iterate op (0..n-m) (\i. x(n - i)) NSUM_REFLECT = |- !x m n. nsum(m..n) x = if n < m then 0 else nsum(0..n-m) (\i. x(n - i)) SUM_REFLECT = |- !x m n. sum(m..n) x = if n < m then &0 else sum(0..n-m) (\i. x(n - i)) NPRODUCT_REFLECT = |- !x m n. nproduct(m..n) x = if n < m then 1 else nproduct(0..n-m) (\i. x(n - i)) PRODUCT_REFLECT = |- !x m n. product(m..n) x = if n < m then &1 else product(0..n-m) (\i. x(n - i)) Sun 20th Mar 2016 class.ml, sets.ml, Library/card.ml Added a few handy trivialities: COND_SWAP = |- !p x y. (if ~p then x else y) = (if p then y else x) num_INFINITE_EQ = |- !s:num->bool. INFINITE s <=> !N. ?n. N <= n /\ n IN s CARD_POWERSET_CONG = |- !s t. s =_c t ==> {u | u SUBSET s} =_c {v | v SUBSET t} Fri 26th Feb 2016 real.ml, int.ml Added another simple lemma about the sign function for reals and integers: REAL_SGN_ABS_ALT = |- !x. real_sgn x * x = abs x INT_SGN_ABS_ALT = |- !x. int_sgn x * x = abs x Wed 17th Feb 2016 metis.ml Hid or removed some local theorems inside the Metis module so that they don't show up in "search" results: Metis_reconstruct.EXCLUDED_MIDDLE Metis_reconstruct.IMPL_NOT_L Metis_reconstruct.IMPL_NOT_R Metis_reconstruct.RESOLVE_1 Metis_reconstruct.RESOLVE_2L Metis_reconstruct.RESOLVE_2R Metis_reconstruct.RESOLVE_3 Wed 17th Feb 2016 Permutation/morelist.ml, Permutation/permutation.ml Added a few more lemmas based on the concepts in the Permutation library: LIST_UNIQ_EQ_PAIRWISE_DISTINCT = |- LIST_UNIQ = PAIRWISE (\x y. ~(x = y)) ORDERED_PAIRWISE = |- ORDERED = PAIRWISE PERMUTED_APPEND_CONG = |- !l1 l1' l2 l2'. l1 PERMUTED l1' /\ l2 PERMUTED l2' ==> APPEND l1 l2 PERMUTED APPEND l1' l2' PERMUTED_APPEND_LCANCEL = |- !l1 l2 l3. APPEND l1 l2 PERMUTED APPEND l1 l3 <=> l2 PERMUTED l3 PERMUTED_APPEND_RCANCEL = |- !l1 l2 l3. APPEND l1 l3 PERMUTED APPEND l2 l3 <=> l1 PERMUTED l2 PERMUTED_LENGTH_MEM = |- !l l'. LIST_UNIQ l /\ LENGTH l = LENGTH l' /\ (!x. MEM x l <=> MEM x l') ==> l PERMUTED l' Wed 17th Feb 2016 lists.ml, sets.ml Added a few elementary list theorems and moved the definition of (list) PAIRWISE from sets.ml to lists.ml, which seems a more thematic home. New theorems: LENGTH_ZIP = |- !l1 l2. LENGTH l1 = LENGTH l2 ==> LENGTH (ZIP l1 l2) = LENGTH l2 PAIRWISE_APPEND = |- !R l m. PAIRWISE R (APPEND l m) <=> PAIRWISE R l /\ PAIRWISE R m /\ (!x y. MEM x l /\ MEM y m ==> R x y) PAIRWISE_IMPLIES = |- !R R' l. PAIRWISE R l /\ (!x y. MEM x l /\ MEM y l /\ R x y ==> R' x y) ==> PAIRWISE R' l PAIRWISE_MAP = |- !R f l. PAIRWISE R (MAP f l) <=> PAIRWISE (\x y. R (f x) (f y)) l PAIRWISE_TRANSITIVE = |- !R x y l. (!x y z. R x y /\ R y z ==> R x z) ==> (PAIRWISE R (CONS x (CONS y l)) <=> R x y /\ PAIRWISE R (CONS y l)) Fri 12th Feb 2016 Minisat/README, Minisat/zc2mso/zc2mso.C, Formal_ineqs/examples_flyspeck.hl, Formal_ineqs/docs/FormalVerifier.tex Fixed a few broken URLs (including changing Flyspeck from Google Code to the new Github repo: https://github.com/flyspeck/flyspeck), and added a line to Minisat/zc2mso/zc2mso.C to make it compile out of the box with a recent g++. Thu 11th Feb 2016 fusion.ml, nums.ml, calc_num.ml Slightly tweaked "MK_COMB" to compare the types of the right-hand sides of the equations rather than the left (on the expectation that in typical uses the RHS will be simpler and therefore quicker to type). Also made a couple of tiny efficiency tweaks to ensure the :num and :num->num types in "NUMERAL", "BIT0" and "BIT1" are actually pointer ==. Tue 9th Feb 2016 metis.ml [new file], meson.ml, passim Installed Michael Färber and Cezary Kaliszyk's OCaml and HOL Light version of Joe Leslie-Hurd's Metis prover. This provides alternatives to the various MESON functions with the same naming convention: ASM_METIS_TAC, METIS_TAC and METIS. Slightly reorganized meson.ml as part of this installation into a module so that some of the "hidden" functions can be re-used, and changed a few MESON calls to METIS where it is obviously faster (no doubt there are many more, and many opportunities to prove things automatically that are currently manual). Fri 29th Jan 2016 cart.ml Added a "subtraction" on type indices, with a type constructor "finite_diff" analogous to "finite_sum", with the following type definition theorem and other lemmas: finite_diff_tybij = |- (!a. mk_finite_diff (dest_finite_diff a) = a) /\ (!r. r IN 1.. (if dimindex (:B) < dimindex (:A) then dimindex (:A) - dimindex (:B) else 1) <=> dest_finite_diff (mk_finite_diff r) = r) FINITE_DIFF_IMAGE = |- (:(A,B)finite_diff) = IMAGE mk_finite_diff (1.. (if dimindex (:B) < dimindex (:A) then dimindex (:A) - dimindex (:B) else 1)) DIMINDEX_HAS_SIZE_FINITE_DIFF = |- (:(M,N)finite_diff) HAS_SIZE (if dimindex (:N) < dimindex (:M) then dimindex (:M) - dimindex (:N) else 1) DIMINDEX_FINITE_DIFF = |- dimindex (:(M,N)finite_diff) = (if dimindex (:N) < dimindex (:M) then dimindex (:M) - dimindex (:N) else 1) FINITE_DIFF_IMAGE = |- (:(A,B)finite_diff) = IMAGE mk_finite_diff (1.. (if dimindex (:B) < dimindex (:A) then dimindex (:A) - dimindex (:B) else 1)) DIMINDEX_HAS_SIZE_FINITE_DIFF = |- (:(M,N)finite_diff) HAS_SIZE (if dimindex (:N) < dimindex (:M) then dimindex (:M) - dimindex (:N) else 1) This can occasionally be useful to make "size-lowering" arguments. Fri 29th Jan 2016 sets.ml Incompatibly improved (by making the hypotheses sharper) the following two theorems (formerly, the antecendent did not have the set membership assertions in their own antecedent): IMAGE_DIFF_INJ = |- !f s t. (!x y. x IN s /\ y IN t /\ f x = f y ==> x = y) ==> IMAGE f (s DIFF t) = IMAGE f s DIFF IMAGE f t IMAGE_DELETE_INJ = |- !f s a. (!x. x IN s /\ f x = f a ==> x = a) ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a Also added the following two variants: IMAGE_DIFF_INJ_ALT = |- !f s t. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ t SUBSET s ==> IMAGE f (s DIFF t) = IMAGE f s DIFF IMAGE f t IMAGE_DELETE_INJ_ALT = |- !f s a. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ a IN s ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a Thu 28th Jan 2016 Makefile Updated the Makefile with yet more cases, to work with OCaml 4.02 and with camlp5 6.15. HOL Light has been tested with OCaml 4.02.3 and camlp5 6.15 (under Cygwin64), so the combination of the two seems to work. Thu 17th Dec 2015 Help/*.doc Fixed several documentation errors pointed out by Marco Maggesi. Thu 17th Dec 2015 Library/card.ml Added a few more fairly basic cardinality lemmas: COUNTABLE_CARD_ADD = |- !s t. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE (s +_c t) COUNTABLE_CARD_ADD_EQ = |- !s t. COUNTABLE (s +_c t) <=> COUNTABLE s /\ COUNTABLE t CARD_LE_EXISTS = |- !s t. s <=_c t <=> (?u. t =_c s +_c u) CARD_LT_IMP_SUC_LE = |- !s t a. s <_c t ==> s +_c {a} <=_c t Thu 17th Dec 2015 real.ml, int.ml Added two theorems characterizing sign equality as an inequality for R and Z: REAL_SGN_EQ_INEQ = |- !x y. real_sgn x = real_sgn y <=> x = y \/ abs (x - y) < max (abs x) (abs y) INT_SGN_EQ_INEQ = |- !x y. int_sgn x = int_sgn y <=> x = y \/ abs (x - y) < max (abs x) (abs y) Thu 17th Dec 2015 sets.ml Added a new and stronger form of INTERS_SUBSET INTERS_SUBSET_STRONG = |- !u s. (?t. t IN u /\ t SUBSET s) ==> INTERS u SUBSET s and fixed a quantifier fumble in IMAGE_INTERS_SUBSET (now quantifies over all the free variables and not the spurious "s"). Both these improvements were pointed out by Joe Hurd. Thu 3rd Dec 2015 Multivariate/cvectors.ml [new file], holtest, holtest.mk Added a new contribution from Sanaz Khan Afshar and Vincent Aravantinos (with contributions also from Harsh Singhal), a full theory of *complex* vectors analogous to the real theory already in that directory. Fri 20th Nov 2015 Library/products.ml Added POLYNOMIAL_FUNCTION_PRODUCT = |- !s p. FINITE s /\ (!i. i IN s ==> polynomial_function (\x. p x i)) ==> polynomial_function (\x. product s (p x)) Fri 20th Nov 2015 Library/floor.ml Added the following natural analog of INTEGER_SUM: RATIONAL_SUM = |- !s x. (!i. i IN s ==> rational(x i)) ==> rational(sum s x) Fri 20th Nov 2015 sets.ml Added a few miscellaneous set theorems, especially about images of saturated intersections. IMAGE_INTERS_SATURATED = |- !f g s. ~(g = {}) /\ (!t. t IN g DELETE s ==> {x | f x IN IMAGE f t} SUBSET t) ==> IMAGE f (INTERS g) = INTERS (IMAGE (IMAGE f) g) IMAGE_INTERS_SATURATED_GEN = |- !f g s u. ~(g = {}) /\ (!t. t IN g ==> t SUBSET u) /\ (!t. t IN g DELETE s ==> {x | x IN u /\ f x IN IMAGE f t} SUBSET t) ==> IMAGE f (INTERS g) = INTERS (IMAGE (IMAGE f) g) IMAGE_INTERS_SUBSET = |- !f s. IMAGE f (INTERS g) SUBSET INTERS (IMAGE (IMAGE f) g) IMAGE_INTER_SATURATED = |- !f s t. {x | f x IN IMAGE f s} SUBSET s \/ {x | f x IN IMAGE f t} SUBSET t ==> IMAGE f (s INTER t) = IMAGE f s INTER IMAGE f t IMAGE_INTER_SATURATED_GEN = |- !f s t u. {x | x IN u /\ f x IN IMAGE f s} SUBSET s /\ t SUBSET u \/ {x | x IN u /\ f x IN IMAGE f t} SUBSET t /\ s SUBSET u ==> IMAGE f (s INTER t) = IMAGE f s INTER IMAGE f t IMAGE_INTER_SUBSET = |- !f s t. IMAGE f (s INTER t) SUBSET IMAGE f s INTER IMAGE f t PSUBSET_UNIONS_PAIRWISE_DISJOINT = |- !u v. pairwise DISJOINT v /\ u PSUBSET v DELETE {} ==> UNIONS u PSUBSET UNIONS v UNIONS_DELETE_EMPTY = |- !s. UNIONS (s DELETE {}) = UNIONS s UNIONS_INSERT_EMPTY = |- !s. UNIONS ({} INSERT s) = UNIONS s Sun 15th Nov 2015 Library/wo.ml, Library/card.ml Added a few basic ordinal and cardinal lemmas, such as that every set is the same size as an ordinal (on the same type) and that strict cardinal comparability is, on a given type, wellfounded. CARD_EQ_ORDINAL_EXISTS = |- !s. ?l. ordinal l /\ fl l =_c s INSEG_FL_SUBSET = |- !l m. l inseg m ==> fl l SUBSET fl m ORDINAL_FL_SUBSET_EQ = |- !l m. ordinal l /\ ordinal m ==> (fl l SUBSET fl m <=> l inseg m) ORDINAL_IMP_WOSET = |- !l. ordinal l ==> woset l SUBWOSET_ISO_INSEG = |- !l s. woset l /\ fl l = (:A) ==> ?f. (!x y. x IN s /\ y IN s ==> (l (f x,f y) <=> l (x,y))) /\ (!x y. y IN IMAGE f s /\ l (x,y) ==> x IN IMAGE f s) WF_CARD_LT = |- WF (<_c) Fri 6th Nov 2015 Makefile, pa_j_3.1x_6.11.ml, README Made two changes suggested by Randy Pollack so that HOL Light makes use of the non-mutable strings in OCaml 4.02 in the build process for the camlp5 syntax extension. First, modified the Makefile to explicitly build with the "-safe-string" option for OCaml >= 4.02, and recoded the "implode" function in pa_j_3.1x_6.11.ml to avoid the use of imperative features. Also added a recommendation to the README file to use the "-safe-string" option in the main HOL Light session itself. Wed 22nd Jul 2015 Library/wo.ml Added the basic fact that a finite toset is a woset: WOSET_FINITE_TOSET = |- !l. toset l /\ FINITE (fl l) ==> woset l Mon 20th Jul 2015 sets.ml Added a series of theorems about injectivity and surjectivity of the "preimage" construct. These are a natural dual to existing "IMAGE" versions, and essentially show that the preimage map is injective/surjective when the function itself is surjective/injective. INJECTIVE_ON_PREIMAGE = |- !f:A->B s u. (!t t'. t SUBSET u /\ t' SUBSET u /\ {x | x IN s /\ f x IN t} = {x | x IN s /\ f x IN t'} ==> t = t') <=> u SUBSET IMAGE f s SURJECTIVE_ON_PREIMAGE = |- !f s u. (!k. k SUBSET s ==> ?t. t SUBSET u /\ {x | x IN s /\ f x IN t} = k) <=> IMAGE f s SUBSET u /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) INJECTIVE_PREIMAGE = |- !f. (!t t'. {x | f x IN t} = {x | f x IN t'} ==> t = t') <=> IMAGE f UNIV = UNIV SURJECTIVE_PREIMAGE = |- !f. (!k. ?t. {x | f x IN t} = k) <=> (!x y. f x = f y ==> x = y) Sun 19th Jul 2015 Library/card.ml Renamed CARD_ADD_ABSORB to CARD_ADD_ABSORB_LEFT and added a few more basic theorems: CARD_ADD_ABSORB_RIGHT = |- !s t. INFINITE s /\ t <=_c s ==> s +_c t =_c s CARD_DIFF_ABSORB = |- !s t. INFINITE s /\ t <_c s ==> s DIFF t =_c s CARD_UNION_ABSORB_LEFT = |- !s t. INFINITE t /\ s <=_c t ==> s UNION t =_c t CARD_UNION_ABSORB_RIGHT = |- !s t. INFINITE s /\ t <=_c s ==> s UNION t =_c s Fri 17th Jul 2015 Library/floor.ml Added one more theorem about the rationals: INFINITE_RATIONAL_IN_RANGE = |- !a b. a < b ==> INFINITE {q | rational q /\ a < q /\ q < b} Mon 13th Jul 2015 Library/prime.ml Added one more natural theorem about primality on N, as well as slightly reorganizing a couple of existing proofs: PRIME_IRREDUCIBLE = |- !p. prime p <=> p > 1 /\ (!a b. p divides a * b ==> p divides a \/ p divides b) Fri 10th Jul 2015 Library/floor.ml Added a couple more rational approximation theorems: RATIONAL_APPROXIMATION_ABOVE = |- !x e. &0 < e ==> (?q. rational q /\ x < q /\ q < x + e) RATIONAL_APPROXIMATION_BELOW = |- !x e. &0 < e ==> (?q. rational q /\ x - e < q /\ q < x) Fri 10th Jul 2015 Library/wo.ml, Library/card.ml Added a few new theorems about ordered sets, ordinals and cardinals, including slightly reshuffling things between these two files. Tukey's lemma is the only real "named" theorem. Several of these slightly fill out the rather sparse theory of ordinals (for example showing they are themselves wellordered by "initial segment of"), which however remains pretty sparse. INSEG_ANTISYM = |- !l m. l inseg m /\ m inseg l ==> l = m INSEG_ORDINAL = |- !l m. m inseg l /\ ordinal l ==> ordinal m INSEG_REFL = |- !l. l inseg l INSEG_TRANS = |- !l m n. l inseg m /\ m inseg n ==> l inseg n LE_C_IMAGE_SUBSET = |- !s t. s <=_c t <=> (?f. s SUBSET IMAGE f t) ORDINAL_FL_SUBSET = |- !l m. ordinal l /\ ordinal m /\ fl l SUBSET fl m ==> l inseg m ORDINAL_FL_UNIQUE = |- !l m. ordinal l /\ ordinal m /\ fl l = fl m ==> l = m TUKEY = |- !s. ~(s = {}) /\ (!t. (!c. FINITE c /\ c SUBSET t ==> c IN s) <=> t IN s) ==> (?u. u IN s /\ (!v. v IN s /\ u SUBSET v ==> u = v)) WF_INSEG_WOSET = |- WF (\x y. woset x /\ woset y /\ x inseg y /\ ~(x = y)) WOSET_INSEG_ORDINAL = |- woset (\(x,y). ordinal x /\ ordinal y /\ x inseg y) WOSET_WF = |- !l. woset l <=> WF (\x y. l(x,y) /\ ~(x = y)) /\ (!x y. fl l x /\ fl l y ==> l(x,y) \/ l(y,x)) Fri 10th Jul 2015 wf.ml Added the simple fact that a wellfounded relation is antisymmetric WF_ANTISYM = |- !(<<) x y. WF (<<) ==> ~(x << y /\ y << x) Tue 30th Jun 2015 sets.ml Added a variety of set theorems, mostly basic properties of CROSS that are near-clones of existing theorems for PCROSS, many with the same proof. CROSS_DIFF = |- (!s t u. s CROSS (t DIFF u) = s CROSS t DIFF s CROSS u) /\ (!s t u. (s DIFF t) CROSS u = s CROSS u DIFF t CROSS u) CROSS_EQ = |- !s s' t t'. s CROSS t = s' CROSS t' <=> (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/ s = s' /\ t = t' CROSS_INTER = |- (!s t u. s CROSS (t INTER u) = s CROSS t INTER s CROSS u) /\ (!s t u. (s INTER t) CROSS u = s CROSS u INTER t CROSS u) CROSS_MONO = |- !s t s' t'. s SUBSET s' /\ t SUBSET t' ==> s CROSS t SUBSET s' CROSS t' CROSS_UNION = |- (!s t u. s CROSS (t UNION u) = s CROSS t UNION s CROSS u) /\ (!s t u. (s UNION t) CROSS u = s CROSS u UNION t CROSS u) CROSS_UNIONS = |- (!s f. s CROSS UNIONS f = UNIONS {s CROSS t | t IN f}) /\ (!f t. UNIONS f CROSS t = UNIONS {s CROSS t | s IN f}) CROSS_UNIONS_UNIONS = |- !f g. UNIONS f CROSS UNIONS g = UNIONS {s CROSS t | s IN f /\ t IN g} EXISTS_IN_CROSS = |- !P s t. (?z. z IN s CROSS t /\ P z) <=> (?x y. x IN s /\ y IN t /\ P (x,y)) FORALL_IN_CROSS = |- !P s t. (!z. z IN s CROSS t ==> P z) <=> (!x y. x IN s /\ y IN t ==> P (x,y)) IMAGE_FST_CROSS = |- !s t. IMAGE FST (s CROSS t) = (if t = {} then {} else s) IMAGE_SND_CROSS = |- !s t. IMAGE SND (s CROSS t) = (if s = {} then {} else t) INTER_CROSS = |- !s s' t t'. s CROSS t INTER s' CROSS t' = (s INTER s') CROSS (t INTER t') SUBSET_CROSS = |- !s t s' t'. s CROSS t SUBSET s' CROSS t' <=> s = {} \/ t = {} \/ s SUBSET s' /\ t SUBSET t' UNIONS_UNIV = |- UNIONS (:A->bool) = (:A) Fri 12th Jun 2015 sets.ml Added two useful rewrites for sup and inf on finite sets from Marco Maggesi. Note that they don't a priori require the set to be finite, so they are easy to apply. INF_INSERT_INSERT = |- !a b s. inf (b INSERT a INSERT s) = inf (min a b INSERT s) SUP_INSERT_INSERT = |- !a b s. sup (b INSERT a INSERT s) = sup (max a b INSERT s) Fri 29th May 2015 Library/card.ml Added two more theorems about representing countable sets as images: COUNTABLE_AS_IMAGE_NUM_SUBSET = |- !s. COUNTABLE s <=> (?f k. s = IMAGE f k) COUNTABLE_AS_INJECTIVE_IMAGE_SUBSET = |- !s. COUNTABLE s <=> (?f k. s = IMAGE f k /\ (!m n. m IN k /\ n IN k /\ f m = f n ==> m = n)) Fri 15th May 2015 pair.ml, arith.ml, sets.ml Added a few useful theorems from Marco Maggesi: CHOICE_PAIRED_THM = |- !P Q. (?x y. P x y) /\ (!x y. P x y ==> Q (x,y)) ==> Q (@(x,y). P x y) CHOICE_UNPAIR_THM = |- !P. (@(x,y). P x y) = (@p. P (FST p) (SND p)) INTERS_SUBSET = |- !u s. ~(u = {}) /\ (!t. t IN u ==> t SUBSET s) ==> INTERS u SUBSET s LAMBDA_UNPAIR_THM = |- !f. (\(x,y). f x y) = (\p. f (FST p) (SND p)) LE_INDUCT = |- !P. (!m. P m m) /\ (!m n. m <= n /\ P m n ==> P m (SUC n)) ==> (!m n. m <= n ==> P m n) Fri 24th Apr 2015 sets.ml Slightly sharpened PAIRWISE_IMP to |- !P Q s. pairwise P s /\ (!x y. x IN s /\ y IN s /\ P x y /\ ~(x = y) ==> Q x y) ==> pairwise Q s and added one more trivial but useful theorem about "pairwise": PAIRWISE_CHAIN_UNIONS = |- !R c. (!s. s IN c ==> pairwise R s) /\ (!s t. s IN c /\ t IN c ==> s SUBSET t \/ t SUBSET s) ==> pairwise R (UNIONS c) Fri 17th Apr 2015 calc_rat.ml, int.ml Added a few equivalential forms of transitivity; the first few in particular can be useful for epsilon-delta arguments in analysis. REAL_LE_TRANS_LE = |- !x y:real. x <= y <=> (!z. y <= z ==> x <= z) REAL_LE_TRANS_LTE = |- !x y:real. x <= y <=> (!z. y < z ==> x <= z) REAL_LE_TRANS_LT = |- !x y:real. x <= y <=> (!z. y < z ==> x < z) INT_LE_TRANS_LE = |- !x y:int x <= y <=> (!z. y <= z ==> x <= z) INT_LE_TRANS_LT = |- !x y:int. x <= y <=> (!z. y < z ==> x < z) Mon 30th Mar 2015 sets.ml Added a simple lemma about "pairwise": PAIRWISE_UNION = |- !R s t. pairwise R (s UNION t) <=> pairwise R s /\ pairwise R t /\ (!x y. x IN s DIFF t /\ y IN t DIFF s ==> R x y /\ R y x) Fri 20th Mar 2015 sets.ml, Library/card.ml Added a few convenient rewrites extending existing ones with an injectivity assumption: EXISTS_COUNTABLE_SUBSET_IMAGE_INJ = |- !P f s. (?t. COUNTABLE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. COUNTABLE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) /\ P (IMAGE f t)) EXISTS_FINITE_SUBSET_IMAGE_INJ = |- !P f s. (?t. FINITE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. FINITE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) /\ P (IMAGE f t)) EXISTS_SUBSET_IMAGE_INJ = |- !P f s. (?t. t SUBSET IMAGE f s /\ P t) <=> (?t. t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) /\ P (IMAGE f t)) FORALL_COUNTABLE_SUBSET_IMAGE_INJ = |- !P f s. (!t. COUNTABLE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. COUNTABLE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) ==> P (IMAGE f t)) FORALL_FINITE_SUBSET_IMAGE_INJ = |- !P f s. (!t. FINITE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. FINITE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) ==> P (IMAGE f t)) FORALL_SUBSET_IMAGE_INJ = |- !P f s. (!t. t SUBSET IMAGE f s ==> P t) <=> (!t. t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) ==> P (IMAGE f t)) SUBSET_IMAGE_INJ = |- !f s t. s SUBSET IMAGE f t <=> (?u. u SUBSET t /\ (!x y. x IN u /\ y IN u ==> (f x = f y <=> x = y)) /\ s = IMAGE f u) Wed 11th Mar 2015 sets.ml Added a couple of trivial but convenient sup/inf theorems: ELEMENT_LE_SUP = |- !s a. (?b. !x. x IN s ==> x <= b) /\ a IN s ==> a <= sup s INF_LE_ELEMENT = |- !s a. (?b. !x. x IN s ==> b <= x) /\ a IN s ==> inf s <= a Fri 6th Mar 2015 sets.ml Added PAIRWISE_AND = |- !R R' s. pairwise R s /\ pairwise R' s <=> pairwise (\x y. R x y /\ R' x y) s Fri 6th Feb 2015 iterate.ml Added two rather trivial but occasionally useful results: NSUM_MUL_BOUND = |- !a b s. FINITE s ==> nsum s (\i. a i * b i) <= nsum s a * nsum s b SUM_MUL_BOUND = |- !a b s. FINITE s /\ (!i. i IN s ==> &0 <= a i /\ &0 <= b i) ==> sum s (\i. a i * b i) <= sum s a * sum s b Fri 30th Jan 2015 sets.ml Added the following, which is convenient to avoid manual reshuffling around FORALL_IN_IMAGE: FORALL_IN_IMAGE_2 = |- !f P s. (!x y. x IN IMAGE f s /\ y IN IMAGE f s ==> P x y) <=> (!x y. x IN s /\ y IN s ==> P (f x) (f y)) Fri 23rd Jan 2015 Library/card.ml Added CARD_MUL_FINITE_EQ = |- !s t. FINITE (s *_c t) <=> s = {} \/ t = {} \/ FINITE s /\ FINITE t Fri 23rd Jan 2015 sets.ml Added three more simple theorems: CROSS_EMPTY = |- (!s. s CROSS {} = {}) /\ (!t. {} CROSS t = {}) FINITE_CROSS_EQ = |- !s t. FINITE (s CROSS t) <=> s = {} \/ t = {} \/ FINITE s /\ FINITE t PAIRWISE_IMP = |- !P Q s. pairwise P s /\ (!x y. P x y /\ ~(x = y) ==> Q x y) ==> pairwise Q s Mon 12th Jan 2015 sets.ml Added another related theorem to the previous addition: INTER_UNIONS_PAIRWISE_DISJOINT = |- !s t. pairwise DISJOINT (s UNION t) ==> UNIONS s INTER UNIONS t = UNIONS (s INTER t) Fri 9th Jan 2015 sets.ml Added this fairly obvious theorem: DIFF_UNIONS_PAIRWISE_DISJOINT = |- !s t. pairwise DISJOINT s /\ t SUBSET s ==> UNIONS s DIFF UNIONS t = UNIONS(s DIFF t) Sat 27th Dec 2014 Quaternions/* Added a substantial new theory of quaternions from Marco Maggesi. This includes basic operations, automatic normalization, quaternionic analysis and the relation of quaternions to orthogonal transformations. Sat 13th Dec 2014 theorems.ml Added CLAIM_TAC from Marco Maggesi. This combines SUBGOAL_THEN and DESTRUCT_TAC in a natural way so one can make a labelled claim with a subproof. Sat 6th Dec 2014 IEEE/* [new directory] Added an extensive formal theory of IEEE floating-point arithmetic, written by Charlie Jacobsen. This includes theories of fixed-point numbers, generalized floating-point numbers (with any even radix >= 2 and any precision >= 2) and then the properties of the usual IEEE floating-point numbers. Sun 30th Nov 2014 lists.ml, Help/dest_char.doc [new file], Help/mk_char.doc [new file], Help/dest_string.doc [new file], Help/mk_string.doc [new file], Help/CHAR_EQ_CONV.doc [new file], Help/STRING_EQ_CONV.doc [new file] Added a systematic set of syntax constructors, destructors and comparison conversions for characters and for strings (== char lists), written by Marco Maggesi: dest_char mk_char dest_string mk_string CHAR_EQ_CONV STRING_EQ_CONV Sun 30th Nov 2014 parser.ml Fixed a bug in the parsing of HOL strings where the special handling of a quotation with just a single identifier (designed to allow one to omit the parantheses round infixes in this special case) was accidentally catching strings as well. Sun 23rd Nov 2014 sets.ml Added this, a natural dual to the existing INTERS_OVER_UNIONS UNIONS_OVER_INTERS = |- !f s. UNIONS {INTERS (f x) | x IN s} = INTERS {UNIONS {g x | x IN s} | g | !x. x IN s ==> g x IN f x} Fri 7th Nov 2014 Examples/misiurewicz.ml [new file] Added a new example, a formalization (suggested on the FOM list by Lasse Rempe-Gillen) of Misiurewicz's original proof that the complex exponential map is topologically transitive. See "On iterates of e^z", Ergodic Theory and Dynamical Systems, vol 1, pp. 103-106, 1981. Fri 7th Nov 2014 Library/iter.ml Added ITER_ADD_POINTLESS = |- !m n. ITER (m + n) f = ITER m f o ITER n f Fri 7th Nov 2014 sets.ml Added FINITE_SUBSET_NUMSEG = |- !s. FINITE s <=> (?n. s SUBSET 0..n) Fri 31st Oct 2014 sets.ml Added the following, both stronger and more convenient than the existing INFINITE_IMAGE_INJ (which is kept for compatibility): INFINITE_IMAGE |- !f s. INFINITE s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> INFINITE (IMAGE f s) Fri 31st Oct 2014 theorems.ml, ind_defs.ml Added a general form of "without loss of generality" lemmas like REAL_WLOG_LE, as well as reshuffling other theorems from ind_defs.ml to theorems.ml. WLOG_RELATION = |- !R P. (!x y. P x y ==> P y x) /\ (!x y. R x y \/ R y x) /\ (!x y. R x y ==> P x y) ==> (!x y. P x y) Sun 12th Oct 2014 theorems.ml, Help/DESTRUCT_TAC/doc, Help/FIX_TAX.doc, Help/HYP_TAC.doc [new file] Added a new tactic HYP_TAC from Marco Maggesi. This fits into the existing suite of tatics (FIX_TAC, DESTRUCT_TAC etc.) for manipulations via brief strings, now applying to a named hypothesis. Also added a few improvements to the existing suite and their documentation. Sun 12th Oct 2014 Library/integer.ml Removed the theorem INT_CONG_0, which as pointed out by Marco Maggesi is the same as INT_CONG_0_DIVIDES except for the order of quantification. The longer name was kept because it fits the natural number case which is called CONG_DIVIDES_0, and it is actually used elsewhere. Thu 9th Oct 2014 iterate.ml Added variants of "grouping" theorems for sums, not requiring an explicit function: NSUM_GROUP_RELATION = |- !R g s t. FINITE s /\ (!x. x IN s ==> (?!y. y IN t /\ R x y)) ==> nsum t (\y. nsum {x | x IN s /\ R x y} g) = nsum s g SUM_GROUP_RELATION = |- !R g s t. FINITE s /\ (!x. x IN s ==> (?!y. y IN t /\ R x y)) ==> sum t (\y. sum {x | x IN s /\ R x y} g) = sum s g Sat 4th Oct 2014 Functionspaces/README, Functionspaces/make.ml, Functionspaces/utils.ml, Functionspaces/cfunspace.ml [new files], Jordan/float.ml Added a new library by Mohamed Yousri Mahmoud and Vincent Aravantinos of vector spaces of complex functions, building on top of the Multivariate theories. Sat 4th Oct 2014 system.ml Added another form to the quotation expander so that any quotation ending in a colon, i.e. of the form `....:`, will just be parsed as an (escaped) string. This is convenient for use with the new Library/q.ml file so that potential issues with capturing backslashes in plain strings can be avoided. It seems quite an intuitive syntax since one is then expecting the system to infer the type from context. Tweaked cases in Jordan/float.ml where there was already a colon at the end of a quotation, just adding spaces around the body. Fri 26th Sep 2014 sets.ml Added the following, a natural complement to IMAGE_UNIONS and IMAGE_INTER: IMAGE_INTERS = |- !f s. ~(s = {}) /\ (!x y. x IN UNIONS s /\ y IN UNIONS s /\ f x = f y ==> x = y) ==> IMAGE f (INTERS s) = INTERS(IMAGE (IMAGE f) s) Fri 19th Sep 2014 Library/q.ml [new file] Added a file from Vincent Aravantinos with Pa.xxx variants of many standard HOL Light functions, taking strings instead of terms and inferring types appropriately. This is similar to the Q module in HOL4. Thu 18th Sep 2014 sets.ml Added a couple more set theory rewrites: FORALL_SUBSET_INSERT = |- !a t. (!s. s SUBSET a INSERT t ==> P s) <=> (!s. s SUBSET t ==> P s /\ P (a INSERT s)) EXISTS_SUBSET_INSERT = |- !a t. (?s. s SUBSET a INSERT t /\ P s) <=> (?s. s SUBSET t /\ (P s \/ P (a INSERT s))) Tue 16th Sep 2014 Library/permutations.ml Added a couple more theorems about permutations: PERMUTES_ID = |- !s. (\x. x) permutes s REAL_SGN_SIGN = |- !p. real_sgn (sign p) = sign p Tue 9th Sep 2014 Library/card.ml Added a few more general lemma about cardinal operations CARD_EMPTY_LE = |- !s. {} <=_c s CARD_EQ_REFL_IMP = |- !s t. s = t ==> s =_c t CARD_LE_FINITE_INFINITE = |- !s t. FINITE s /\ INFINITE t ==> s <=_c t CARD_MUL_C = |- !s t. FINITE s /\ FINITE t ==> CARD (s *_c t) = CARD s * CARD t CARD_SING_LE = |- !a s. {a} <=_c s <=> ~(s = {}) LE_C_IMAGE = |- !s t. s <=_c t <=> s = {} \/ (?f. IMAGE f t = s) together with a definition of cardinal exponentiation and its basic properties: exp_c = |- !s t. s ^_c t = {f | (!x. x IN t ==> f x IN s) /\ (!x. ~(x IN t) ==> f x = (@y. F))} CARD_EQ_COUNTABLE_SUBSETS_SUBREAL = |- !s. INFINITE s /\ s <=_c (:real) ==> {t | t SUBSET s /\ COUNTABLE t} =_c (:real) CARD_EQ_FULLSIZE_POWERSET = |- !s. INFINITE s ==> {t | t SUBSET s /\ t =_c s} =_c {t | t SUBSET s} CARD_EQ_LIMITED_POWERSET = |- !s t. INFINITE s ==> (if t <=_c s then {k | k SUBSET s /\ k <=_c t} =_c s ^_c t else {k | k SUBSET s /\ k <=_c t} =_c (:bool) ^_c s) CARD_EQ_RESTRICTED_POWERSET = |- !s t. INFINITE s ==> {k | k SUBSET s /\ k =_c t} =_c (if t <=_c s then s ^_c t else {}) CARD_EXP_0 = |- !s c. s ^_c {} =_c {c}; CARD_EXP_ABSORB = |- !s t. INFINITE t /\ (:bool) <=_c s /\ s <=_c (:bool) ^_c t ==> s ^_c t =_c (:bool) ^_c t CARD_EXP_ADD = |- !s t u. s ^_c (t +_c u) =_c s ^_c t *_c s ^_c u CARD_EXP_C = |- !s t. FINITE s /\ FINITE t ==> CARD (s ^_c t) = CARD s EXP CARD t CARD_EXP_CANTOR = |- !s. s <_c (:bool) ^_c s CARD_EXP_CONG = |- !s s' t t'. s =_c s' /\ t =_c t' ==> s ^_c t =_c s' ^_c t' CARD_EXP_FINITE = |- !s t. FINITE s /\ FINITE t ==> FINITE (s ^_c t) CARD_EXP_GRAPH = |- !s t. s ^_c t =_c {R | (!x y. R x y ==> x IN t /\ y IN s) /\ (!x. x IN t ==> (?!y. R x y))} CARD_EXP_GRAPH_PAIRED = |- !s t. s ^_c t =_c {R | (!x y. R (x,y) ==> x IN t /\ y IN s) /\ (!x. x IN t ==> (?!y. R (x,y)))} CARD_EXP_MUL = |- !s t u. s ^_c (t *_c u) =_c s ^_c t ^_c u CARD_EXP_POWERSET = |- !s. (:bool) ^_c s =_c {t | t SUBSET s} CARD_EXP_SING = |- !s b. s ^_c {b} =_c s CARD_EXP_UNIV = |- (:A) ^_c (:B) = (:B->A) CARD_EXP_ZERO = |- !s c. {} ^_c s =_c (if s = {} then {c} else {}) CARD_LE_EXP = |- !s s' t t'. ~(s = {}) /\ s <=_c s' /\ t <=_c t' ==> s ^_c t <=_c s' ^_c t' CARD_LE_EXP_LEFT = |- !s s' t. s <=_c s' ==> s ^_c t <=_c s' ^_c t CARD_LE_EXP_RIGHT = |- !s t t'. ~(s = {}) /\ t <=_c t' ==> s ^_c t <=_c s ^_c t' CARD_MUL_EXP = |- !s t u. (s *_c t) ^_c u =_c s ^_c u *_c t ^_c u Tue 9th Sep 2014 Library/products.ml Added two straightforward "finite support" generalizations of existing theorems about products: NPRODUCT_MUL_GEN = |- !f g s. FINITE {x | x IN s /\ ~(f x = 1)} /\ FINITE {x | x IN s /\ ~(g x = 1)} ==> nproduct s (\x. f x * g x) = nproduct s f * nproduct s g PRODUCT_MUL_GEN = |- !f g s. FINITE {x | x IN s /\ ~(f x = &1)} /\ FINITE {x | x IN s /\ ~(g x = &1)} ==> product s (\x. f x * g x) = product s f * product s g Tue 19th Aug 2014 Library/floor.ml Added NONNEGATIVE_INTEGER = |- !x. integer x /\ &0 <= x <=> ?n. x = &n NONPOSITIVE_INTEGER = |- !x. integer x /\ x <= &0 <=> ?n. x = -- &n NONPOSITIVE_INTEGER_ALT = |- !x. integer x /\ x <= &0 <=> ?n. x + &n = &0 REAL_FLOOR_NEG = |- !x. floor(--x) = if integer x then --x else --(floor x + &1) FRAC_NEG = |- !x. frac(--x) = if integer x then &0 else &1 - frac x Tue 19th Aug 2014 iterate.ml Added REAL_OF_NUM_SUM_GEN = |- !f s. FINITE {i | i IN s /\ ~(f i = 0)} ==> &(nsum s f) = sum s (\x. &(f x))`, Tue 19th Aug 2014 real.ml Added REAL_OF_NUM_SUB_CASES = |- `!m n. &m - &n = if n <= m then &(m - n) else -- &(n - m) Sun 13th Jul 2014 Formal_ineqs/* [new files] Added Alexey Solovyev's formal inequality prover (used extensively in the Flyspeck project) to the HOL Light distribution. Thu 10th Jul 2014 Library/products.ml Added a couple more trivial theorems about products: NPRODUCT_DELTA = |- !s a. nproduct s (\x. if x = a then b else 1) = (if a IN s then b else 1) PRODUCT_DELTA = |- !s a. product s (\x. if x = a then b else &1) = (if a IN s then b else &1) Tue 1st Jul 2014 Library/floor.ml Added clauses for "max" and "min" to INTEGER_CLOSED, so it is now: INTEGER_CLOSED = |- (!n. integer (&n)) /\ (!x y. integer x /\ integer y ==> integer (x + y)) /\ (!x y. integer x /\ integer y ==> integer (x - y)) /\ (!x y. integer x /\ integer y ==> integer (x * y)) /\ (!x r. integer x ==> integer (x pow r)) /\ (!x. integer x ==> integer (--x)) /\ (!x. integer x ==> integer (abs x)) /\ (!x y. integer x /\ integer y ==> integer (max x y)) /\ (!x y. integer x /\ integer y ==> integer (min x y)) Tue 1st Jul 2014 sets.ml Added CROSS_UNIV = |- (:A) CROSS (:B) = (:A#B) Tue 27th May 2014 Library/permutations.ml Added three more lemmas about permutations: CARD_EVEN_PERMUTATIONS = |- !s. FINITE s /\ 2 <= CARD s ==> 2 * CARD {p | p permutes s /\ evenperm p} = FACT (CARD s) PERMUTES_INVOLUTION = |- !p s. (!x. p (p x) = x) /\ (!x. ~(x IN s) ==> p x = x) ==> p permutes s SIGN_INVOLUTION = |- !p s. FINITE s /\ (!x. p (p x) = x) /\ (!x. ~(x IN s) ==> p x = x) ==> sign p = -- &1 pow (CARD {x | ~(p x = x)} DIV 2) Tue 27th May 2014 Library/floor.ml Added the following theorem, a natural counterpart for FLOOR_DIV_DIV FRAC_DIV_MOD = |- !m n. ~(n = 0) ==> frac(&m / &n) = &(m MOD n) / &n Mon 12th May 2014 Examples/gcdrecurrence.ml [new file] Added a new file with the cute result that the gcd operation "commutes" with certain integer sequences, with applications to the Mersenne numbers, the Fibonacci series, and solutions to the Pell equation. Sat 10th May 2014 int.ml, real.ml, Library/prime.ml, Library/integer.ml Added a few miscellaneous trivial theorems: DIVIDES_GCD_LEFT = |- !m n. m divides n <=> gcd (m,n) = m DIVIDES_GCD_RIGHT = |- !m n. n divides m <=> gcd (m,n) = n INT_DIVIDES_ANTISYM_DIVISORS = |- !a b. a divides b /\ b divides a <=> (!d. d divides a <=> d divides b) INT_DIVIDES_GCD_LEFT = |- !m n. m divides n <=> gcd (m,n) = abs m INT_DIVIDES_GCD_RIGHT = |- !m n. n divides m <=> gcd (m,n) = abs n INT_EQ_SGN_ABS = |- !x y. x = y <=> int_sgn x = int_sgn y /\ abs x = abs y REAL_EQ_SGN_ABS = |- !x y. x = y <=> real_sgn x = real_sgn y /\ abs x = abs y Sat 10th May 2014 Examples/dickson.ml Added a proof of Dickson's Lemma, plus the Nash-Williams minimal bad sequence property in a bit more generality (for a "safety property" of sequences in the Lamport/Alpern/Schneider sense). Fri 9th May 2014 Library/card.ml Added COUNTABLE_SUBSET_NUM = |- !s:num->bool. COUNTABLE s Sun 27th Apr 2014 Library/permutations.ml Added PERMUTES_BIJECTIONS = |- !p q. (!x. x IN s ==> p x IN s) /\ (!x. ~(x IN s) ==> p x = x) /\ (!x. x IN s ==> q x IN s) /\ (!x. ~(x IN s) ==> q x = x) /\ (!x. p(q x) = x) /\ (!x. q(p x) = x) ==> p permutes s Sat 19th Apr 2014 sets.ml Added another clause to FORALL_IN_GSPEC and EXISTS_IN_GSPEC for the case of 4 bound variables, so they have now become: FORALL_IN_GSPEC = |- (!P f. (!z. z IN {f x | P x} ==> Q z) <=> (!x. P x ==> Q(f x))) /\ (!P f. (!z. z IN {f x y | P x y} ==> Q z) <=> (!x y. P x y ==> Q(f x y))) /\ (!P f. (!z. z IN {f w x y | P w x y} ==> Q z) <=> (!w x y. P w x y ==> Q(f w x y))) /\ (!P f. (!z. z IN {f v w x y | P v w x y} ==> Q z) <=> (!v w x y. P v w x y ==> Q(f v w x y))) EXISTS_IN_GSPEC = |- (!P f. (?z. z IN {f x | P x} /\ Q z) <=> (?x. P x /\ Q(f x))) /\ (!P f. (?z. z IN {f x y | P x y} /\ Q z) <=> (?x y. P x y /\ Q(f x y))) /\ (!P f. (?z. z IN {f w x y | P w x y} /\ Q z) <=> (?w x y. P w x y /\ Q(f w x y))) /\ (!P f. (?z. z IN {f v w x y | P v w x y} /\ Q z) <=> (?v w x y. P v w x y /\ Q(f v w x y))) Sat 19th Apr 2014 pair.ml Added "unpair" theorems: FORALL_UNPAIR_THM = |- (!x y. P x y) <=> (!z. P (FST z) (SND z)) EXISTS_UNPAIR_THM = |- (?x y. P x y) <=> (?z. P (FST z) (SND z)) Tue 15th Apr 2014 bool.ml Did a little more rationalization of the Boolean rule, recoding MP so that it produces precisely the union of the two assumption lists, as the documentation claims. Mon 14th Apr 2014 Examples/lucas_lehmer.ml, 100/sqrt.ml [new file] Added a new file containing a formalization of the Lucas-Lehmer test for primality of Mersenne numbers, and a derived rule for applying it in particular cases. This is quite a bit faster than the usual PRIME_CONV (in this special case 2^p-1), and also scales better because it doesn't rely on factorization at all. This uses as a lemma the fact that sqrt(3) is not rational, so also added a file with a trivial proof that sqrt(p) is irrational for prime p. Mon 14th Apr 2014 int.ml, Library/prime.ml, Library/iter.ml, Library/pocklington.ml, Library/primitive.ml Moved this very basic result out of the Library/prime.ml file into the main core DIVIDES_LE = |- !m n. m divides n ==> m <= n \/ n = 0 Added some theorems to Library/iter.ml about the "order" or "characteristic" in a general setting val ORDER_EXISTENCE_GEN = |- !P f. P (f 0) /\ (!m n. P (f m) /\ ~(m = 0) ==> (P (f (m + n)) <=> P (f n))) ==> ?d. !n. P (f n) <=> d divides n val ORDER_EXISTENCE_ITER = |- !R f z. R z z /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R x y ==> R (f x) (f y)) ==> ?d. !n. R (ITER n f z) z <=> d divides n val ORDER_EXISTENCE_CARD = |- !R f z k. FINITE {R (ITER n f z) | n IN (:num)} /\ CARD {R (ITER n f z) | n IN (:num)} <= k /\ R z z /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R (f x) (f y) <=> R x y) ==> ?d. 0 < d /\ d <= k /\ (!n. R (ITER n f z) z <=> d divides n) val ORDER_EXISTENCE_FINITE = |- !R f z. FINITE {R (ITER n f z) | n IN (:num)} /\ R z z /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R (f x) (f y) <=> R x y) ==> ?d. 0 < d /\ (!n. R (ITER n f z) z <=> d divides n) Changed the definition of "order" in Library/pocklington.ml to use that as the basis, as well as adding three basic new theorems: EXP_ITER = |- !x n. x EXP n = ITER n (\y. x * y) 1 PHI_EQ_0 = |- !n. phi n = 0 <=> n = 0 ORDER_1 = |- !n. order n 1 = 1 Fri 11th Apr 2014 bool.ml Bill Richter pointed out that IMP_ANTISYM_RULE could sometimes give fewer assumptions than its documentation (with a simple union of the two lists) suggested. Fixed this, as well as a similar problem with CONJ, and a few related documentation issues also uncovered by Bill. Wed 9th Apr 2014 equal.ml Made a few minor optimizations to some functions here, using more pattern-matching in place of destructors and adding partial evaluation to AP_TERM. Fri 4th Apr 2014 arith.ml Added MOD_REFL = |- !n. ~(n = 0) ==> n MOD n = 0 Thu 3rd Apr 2014 nums.ml, calc_num.ml Completely rewrote the conversions NUM_SUC_CONV, NUM_ADD_CONV and NUM_MULT_CONV to improve efficiency, as well as the auxiliary syntax function mk_numeral. The new versions do addition in larger blocks for a decent constant factor improvement and the multiplication routine uses squaring as the core with quite tight coding and the use of 2-part and 3-part interpolation. Also rewrote the main relational conversions NUM_LT_CONV, NUM_LE_CONV and NUM_EQ_CONV to call addition directly, which is (now) much more efficient than what was used before, though it could still be optimized a bit more. Tue 1st Apr 2014 fusion.ml Made another rather minor optimization, this time making the check for type compatibility in the "vsubst" outer wrapper marginally more efficient. Thu 27th Mar 2014 fusion.ml Made a small change to the "type_of" function to use an explicit match in the Comb case instead of applying "hd" and "tl". Although perhaps marginally uglier, it is somewhat more efficient and gets two more library functions (hd and tl) out of the core. Sun 23rd Mar 2014 Examples/harmonicsum.ml [new file] Added a new file with a rather trivial but nice result that a non-trivial contiguous segment of the harmonic series never sums to an integer. Tue 18th Mar 2014 iterate.ml Added a definition of a "polynomial function" (R->R) with various basic closure properties. This is a sufficiently useful concept that it seems worth having in the core, not just in the analytical theories. polynomial_function = |- !p. polynomial_function p <=> (?m c. !x. p x = sum (0..m) (\i. c i * x pow i)) POLYNOMIAL_FUNCTION_ADD = |- !p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (\x. p x + q x) POLYNOMIAL_FUNCTION_CONST = |- !c. polynomial_function (\x. c) POLYNOMIAL_FUNCTION_FINITE_ROOTS = |- !p a. polynomial_function p ==> (FINITE {x | p x = a} <=> ~(!x. p x = a)) POLYNOMIAL_FUNCTION_I = |- polynomial_function I POLYNOMIAL_FUNCTION_ID = |- polynomial_function (\x. x) POLYNOMIAL_FUNCTION_INDUCT = |- !P. P (\x. x) /\ (!c. P (\x. c)) /\ (!p q. P p /\ P q ==> P (\x. p x + q x)) /\ (!p q. P p /\ P q ==> P (\x. p x * q x)) ==> (!p. polynomial_function p ==> P p) POLYNOMIAL_FUNCTION_LMUL = |- !p c. polynomial_function p ==> polynomial_function (\x. c * p x) POLYNOMIAL_FUNCTION_MUL = |- !p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (\x. p x * q x) POLYNOMIAL_FUNCTION_NEG = |- !p. polynomial_function (\x. --p x) <=> polynomial_function p POLYNOMIAL_FUNCTION_POW = |- !p n. polynomial_function p ==> polynomial_function (\x. p x pow n) POLYNOMIAL_FUNCTION_RMUL = |- !p c. polynomial_function p ==> polynomial_function (\x. p x * c) POLYNOMIAL_FUNCTION_SUB = |- !p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (\x. p x - q x) POLYNOMIAL_FUNCTION_SUM = |- !s p. FINITE s /\ (!i. i IN s ==> polynomial_function (\x. p x i)) ==> polynomial_function (\x. sum s (p x)) POLYNOMIAL_FUNCTION_o = |- !p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (p o q) Tue 18th Mar 2014 iterate.ml Added a conversion EXPAND_SUM_CONV to expand "sum (m..n) f" where m and n are particular numerals. Tue 18th Mar 2014 Library/binomial.ml Added one more lemma about binomial coefficients, a characteristic property of Appell sequences: APPELL_SEQUENCE = |- !c n x y. sum (0..n) (\k. &(binom (n,k)) * sum (0..k) (\l. &(binom (k,l)) * c l * x pow (k - l)) * y pow (n - k)) = sum (0..n) (\k. &(binom (n,k)) * c k * (x + y) pow (n - k)) Sun 16th Mar 2014 Multivariate/gamma.ml [new file] Added a new file giving a definition of the complex and real gamma functions and proofs of some basic properties. Mon 10th Mar 2014 Library/binomial.ml Added a couple more lemmas: BINOM_SYM = |- !n k. binom(n,n - k) = (if k <= n then binom(n,k) else 1) BINOM_MUL_SHIFT = |- !m n k. k <= m ==> binom(n,m) * binom(m,k) = binom(n,k) * binom(n - k,m - k) as well as putting a simple symmetry optimization into NUM_BINOM_CONV for the case of NUM_BINOM_CONV `binom(n,k)` where k is small. Sat 8th Mar 2014 printer.ml Added two improvements from Joe Hurd to the treatment of printing. First, user printers are generalized over the formatter so that they will respect the overall output formatter settings. Moreover, the "print_to_string" function now takes the margin into account. Fri 28th Feb 2014 Library/prime.ml Added a few more number-theory results, mainly concerning the "index": INDEX_REFL = |- !n. index n n = (if n <= 1 then 0 else 1) INDEX_EQ_0 = |- !p n. index p n = 0 <=> n = 0 \/ p = 1 \/ ~(p divides n) INDEX_TRIVIAL_BOUND = |- !n p. index p n <= n INDEX_DECOMPOSITION = |- !n p. ?m. p EXP index p n * m = n /\ (n = 0 \/ p = 1 \/ ~(p divides m)) INDEX_DECOMPOSITION_PRIME = |- !n p. prime p ==> (?m. p EXP index p n * m = n /\ (n = 0 \/ coprime (p,m))) DIVIDES_NSUM = |- !n f s. FINITE s /\ (!i. i IN s ==> n divides f i) ==> n divides nsum s f Fri 28th Feb 2014 real.ml Added REAL_LT_POW_2 = |- |- !x. &0 < x pow 2 <=> ~(x = &0) Fri 28th Feb 2014 Library/products.ml Added a few more basic theorems about products: NPRODUCT_FACT = |- !n. nproduct (1..n) (\m. m) = FACT n NPRODUCT_PAIR = |- !f m n. nproduct (2 * m..2 * n + 1) f = nproduct (m..n) (\i. f (2 * i) * f (2 * i + 1)) NPRODUCT_DELETE = |- !f s a. FINITE s /\ a IN s ==> f a * nproduct (s DELETE a) f = nproduct s f PRODUCT_PAIR = |- !f m n. product (2 * m..2 * n + 1) f = product (m..n) (\i. f (2 * i) * f (2 * i + 1)) PRODUCT_DELETE = |- !f s a. FINITE s /\ a IN s ==> f a * product (s DELETE a) f = product s f Sat 22nd Feb 2014 impconv.ml, Help/CASE_REWRITE_TAC.doc, Help/HINT_EXISTS_TAC.doc, Help/IMP_REWRITE_TAC.doc, Help/SEQ_IMP_REWRITE_TAC.doc, Help/TARGET_REWRITE_TAC.doc [new files], hol.ml Added a new file from Vincent Aravantinos containing several powerful new tactics: IMP_REWRITE_TAC, TARGET_REWRITE_TAC, CASE_REWRITE_TAC, SEQ_IMP_REWRITE_TAC and HINT_EXISTS_TAC. Sat 22nd Feb 2014 arith.ml, Library/binary.ml, Library/prime.ml Added the rather trivial "finite Cantor's theorem", which is otherwise defined in several different places and is useful enough: LT_POW2_REFL = |- !n. n < 2 EXP n Deleted it from other places now that it's in the core. Sun 16th Feb 2014 real.ml Added the following additional properties of the signum function: INT_SGN_POW = |- !x n. int_sgn(x pow n) = int_sgn(x) pow n INT_SGN_POW_2 = |- !x. int_sgn(x pow 2) = int_sgn(abs x) INT_SGN_REAL_SGN = |- int_sgn(int_sgn x) = int_sgn x REAL_INV_SGN = |- !x. inv (real_sgn x) = real_sgn x REAL_SGN_POW = |- !x n. real_sgn(x pow n) = real_sgn(x) pow n REAL_SGN_POW_2 = |- !x. real_sgn(x pow 2) = real_sgn(abs x) REAL_SGN_REAL_SGN = |- real_sgn(real_sgn x) = real_sgn x Sun 16th Feb 2014 Library/prime.ml Added a conversion LCM_CONV to compute LCMs of particular numerals, plus a few more theorems including a definition of "index": PRIMEPOW_DIVIDES_PROD = |- !p k m n. prime p /\ (p EXP k) divides (m * n) ==> ?i j. (p EXP i) divides m /\ (p EXP j) divides n /\ k = i + j FINITE_EXP_LE = |- !P p n. 2 <= p ==> FINITE {j | P j /\ p EXP j <= n} FINITE_INDICES = |- !P p n. 2 <= p /\ ~(n = 0) ==> FINITE {j | P j /\ p EXP j divides n} index_def = |- index p n = if p <= 1 \/ n = 0 then 0 else CARD {j | 1 <= j /\ p EXP j divides n} INDEX_0 = |- !p. index p 0 = 0 PRIMEPOW_DIVIDES_INDEX = |- !n p k. p EXP k divides n <=> n = 0 \/ p = 1 \/ k <= index p n LE_INDEX = |- !n p k. k <= index p n <=> (n = 0 \/ p = 1 ==> k = 0) /\ p EXP k divides n INDEX_1 = |- !p. index p 1 = 0 INDEX_MUL = |- !m n. prime p /\ ~(m = 0) /\ ~(n = 0) ==> index p (m * n) = index p m + index p n INDEX_EXP = |- !p n k. prime p ==> index p (n EXP k) = k * index p n INDEX_FACT = |- !p n. prime p ==> index p (FACT n) = nsum(1..n) (\m. index p m) INDEX_FACT_ALT = |- !p n. prime p ==> index p (FACT n) = nsum {j | 1 <= j /\ p EXP j <= n} (\j. n DIV (p EXP j)) INDEX_FACT_UNBOUNDED = |- !p n. prime p ==> index p (FACT n) = nsum {j | 1 <= j} (\j. n DIV (p EXP j)) PRIMEPOW_DIVIDES_FACT = |- !p n k. prime p ==> (p EXP k divides FACT n <=> k <= nsum {j | 1 <= j /\ p EXP j <= n} (\j. n DIV (p EXP j))) Sun 16th Feb 2014 iterate.ml Added a slightly more delicate "finite support" vesion of sum comparison: NSUM_LE_GEN = |- !f g s. (!x. x IN s ==> f x <= g x) /\ FINITE {x | x IN s /\ ~(g x = 0)} ==> nsum s f <= nsum s g Wed 12th Feb 2014 Library/floor.ml Added INTEGER_DIV = |- !m n. integer(&m / &n) <=> n = 0 \/ n divides m Wed 12th Feb 2014 int.ml, Library/prime.ml Moved the theorem "divides" out of Library/prime.ml into the core, since it seems silly not to have such a basic fact available. Wed 12th Feb 2014 Library/binomial.ml Added BINOM_0 = |- !n. binom(0,n) = if n = 0 then 1 else 0 BINOM_GE_TOP = |- !m n. 1 <= m /\ m < n ==> n <= binom(n,m) Wed 12th Feb 2014 Library/products.ml Added NPRODUCT_SUPPORT = |- !f s. nproduct (support ( * ) f s) f = nproduct s f NPRODUCT_SUPERSET = |- !f u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f(x) = 1) ==> nproduct v f = nproduct u f` PRODUCT_SUPPORT = |- !f s. product (support ( * ) f s) f = product s f PRODUCT_SUPERSET = |- !f:A->real u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f(x) = &1) ==> product v f = product u f Wed 12th Feb 2014 iterate.ml Added a couple of convenient theorems about when sums are stricly positive: NSUM_POS_LT_ALL = |- !s f. FINITE s /\ ~(s = {}) /\ (!i. i IN s ==> 0 < f i) ==> 0 < nsum s f SUM_POS_LT_ALL = |- !s f. FINITE s /\ ~(s = {}) /\ (!i. i IN s ==> &0 < f i) ==> &0 < sum s f Thu 6th Feb 2014 int.ml Added INT_LE_DISCRETE = |- !x y:int. x <= y <=> x < y + &1 Thu 6th Feb 2014 Library/prime.ml Added a definition of lcm to this file, and a suite of theorems mainly about that. Also added "symmetric" clauses to GCD_0 and GCD_1. DIVIDES_LCM = |- !m n r. r divides m \/ r divides n ==> r divides lcm (m,n) DIVIDES_LCM_GCD = |- !m n d. d divides lcm (m,n) <=> d * gcd (m,n) divides m * n DIVISORS_EQ = |- !m n. m = n <=> (!d. d divides m <=> d divides n) GCD_LCM_DISTRIB = |- !a b c. gcd (a,lcm (b,c)) = lcm (gcd (a,b),gcd (a,c)) lcm = |- !m n. lcm (m,n) = (if m * n = 0 then 0 else (m * n) DIV gcd (m,n)) LCM = |- !m n. m divides lcm (m,n) /\ n divides lcm (m,n) /\ (!d. m divides d /\ n divides d ==> lcm (m,n) divides d) LCM_0 = |- (!n. lcm (0,n) = 0) /\ (!n. lcm (n,0) = 0) LCM_1 = |- (!n. lcm (1,n) = n) /\ (!n. lcm (n,1) = n) LCM_ASSOC = |- !m n p. lcm (m,lcm (n,p)) = lcm (lcm (m,n),p) LCM_DIVIDES = |- !m n d. lcm (m,n) divides d <=> m divides d /\ n divides d LCM_EQ = |- !x y u v. (!d. x divides d /\ y divides d <=> u divides d /\ v divides d) ==> lcm (x,y) = lcm (u,v) LCM_EXP = |- !n a b. lcm (a EXP n,b EXP n) = lcm (a,b) EXP n LCM_GCD_DISTRIB = |- !a b c. lcm (a,gcd (b,c)) = gcd (lcm (a,b),lcm (a,c)) LCM_LMUL = |- !a b c. lcm (c * a,c * b) = c * lcm (a,b) LCM_MULTIPLE = |- !a b. lcm (b,a * b) = a * b LCM_REFL = |- !n. lcm (n,n) = n LCM_RMUL = |- !a b c. lcm (a * c,b * c) = c * lcm (a,b) LCM_SYM = |- !m n. lcm (m,n) = lcm (n,m) LCM_UNIQUE = |- !d m n. m divides d /\ n divides d /\ (!e. m divides e /\ n divides e ==> d divides e) <=> d = lcm (m,n) LCM_ZERO = |- !m n. lcm (m,n) = 0 <=> m = 0 \/ n = 0 MULTIPLES_EQ = |- !m n. m = n <=> (!d. m divides d <=> n divides d) PRIMEPOW_DIVIDES_LCM = |- !m n p k. prime p ==> (p EXP k divides lcm (m,n) <=> p EXP k divides m \/ p EXP k divides n) PRIMEPOW_DIVISORS_DIVIDES = |- !m n. m divides n <=> (!p k. prime p /\ p EXP k divides m ==> p EXP k divides n) PRIMEPOW_DIVISORS_EQ = |- !m n. m = n <=> (!p k. prime p ==> (p EXP k divides m <=> p EXP k divides n)) Wed 5th Feb 2014 Library/products.ml Added natural number products to "Library/products.ml", with all the analogous theorems that are meaningful for their real counterparts: nproduct = |- nproduct = iterate (*) NPRODUCT_ADD_SPLIT = |- !f m n p. m <= n + 1 ==> nproduct (m..n + p) f = nproduct (m..n) f * nproduct (n + 1..n + p) f NPRODUCT_CLAUSES = |- (!f. nproduct {} f = 1) /\ (!x f s. FINITE s ==> nproduct (x INSERT s) f = (if x IN s then nproduct s f else f x * nproduct s f)) NPRODUCT_CLAUSES_LEFT = |- !f m n. m <= n ==> nproduct (m..n) f = f m * nproduct (m + 1..n) f NPRODUCT_CLAUSES_NUMSEG = |- (!m. nproduct (m..0) f = (if m = 0 then f 0 else 1)) /\ (!m n. nproduct (m..SUC n) f = (if m <= SUC n then nproduct (m..n) f * f (SUC n) else nproduct (m..n) f)) NPRODUCT_CLAUSES_RIGHT = |- !f m n. 0 < n /\ m <= n ==> nproduct (m..n) f = nproduct (m..n - 1) f * f n NPRODUCT_CLOSED = |- !P f s. P 1 /\ (!x y. P x /\ P y ==> P (x * y)) /\ (!a. a IN s ==> P (f a)) ==> P (nproduct s f) NPRODUCT_CONST = |- !c s. FINITE s ==> nproduct s (\x. c) = c EXP CARD s NPRODUCT_CONST_NUMSEG = |- !c m n. nproduct (m..n) (\x. c) = c EXP ((n + 1) - m) NPRODUCT_CONST_NUMSEG_1 = |- !c n. nproduct (1..n) (\x. c) = c EXP n NPRODUCT_EQ = |- !f g s. (!x. x IN s ==> f x = g x) ==> nproduct s f = nproduct s g NPRODUCT_EQ_0 = |- !f s. FINITE s ==> (nproduct s f = 0 <=> (?x. x IN s /\ f x = 0)) NPRODUCT_EQ_0_NUMSEG = |- !f m n. nproduct (m..n) f = 0 <=> (?x. m <= x /\ x <= n /\ f x = 0) NPRODUCT_EQ_1 = |- !f s. (!x. x IN s ==> f x = 1) ==> nproduct s f = 1 NPRODUCT_EQ_1_NUMSEG = |- !f m n. (!i. m <= i /\ i <= n ==> f i = 1) ==> nproduct (m..n) f = 1 NPRODUCT_EQ_NUMSEG = |- !f g m n. (!i. m <= i /\ i <= n ==> f i = g i) ==> nproduct (m..n) f = nproduct (m..n) g NPRODUCT_IMAGE = |- !f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> nproduct (IMAGE f s) g = nproduct s (g o f) NPRODUCT_LE = |- !f s. FINITE s /\ (!x. x IN s ==> 0 <= f x /\ f x <= g x) ==> nproduct s f <= nproduct s g NPRODUCT_LE_NUMSEG = |- !f m n. (!i. m <= i /\ i <= n ==> 0 <= f i /\ f i <= g i) ==> nproduct (m..n) f <= nproduct (m..n) g NPRODUCT_MUL = |- !f g s. FINITE s ==> nproduct s (\x. f x * g x) = nproduct s f * nproduct s g NPRODUCT_MUL_NUMSEG = |- !f g m n. nproduct (m..n) (\x. f x * g x) = nproduct (m..n) f * nproduct (m..n) g NPRODUCT_OFFSET = |- !f m p. nproduct (m + p..n + p) f = nproduct (m..n) (\i. f (i + p)) NPRODUCT_ONE = |- !s. nproduct s (\n. 1) = 1 NPRODUCT_POS_LT = |- !f s. FINITE s /\ (!x. x IN s ==> 0 < f x) ==> 0 < nproduct s f NPRODUCT_POS_LT_NUMSEG = |- !f m n. (!x. m <= x /\ x <= n ==> 0 < f x) ==> 0 < nproduct (m..n) f NPRODUCT_SING = |- !f x. nproduct {x} f = f x NPRODUCT_SING_NUMSEG = |- !f n. nproduct (n..n) f = f n NPRODUCT_UNION = |- !f s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> nproduct (s UNION t) f = nproduct s f * nproduct t f REAL_OF_NUM_NPRODUCT = |- !f s. FINITE s ==> &(nproduct s f) = product s (\x. &(f x)) Thu 23rd Jan 2014 iterate.ml, Library/isum.ml Made the incompatible "improvement" of removing the finiteness hypothesis from SUM_POS_LE, as well as adding two theorems about how sums of natural numbers and integers collapse in the degenerate case of infinite support: NSUM_DEGENERATE = |- !f s. ~FINITE {x | x IN s /\ ~(f x = 0)} ==> nsum s f = 0 SUM_DEGENERATE = |- !f s. ~FINITE {x | x IN s /\ ~(f x = &0)} ==> sum s f = &0 Although I didn't explicitly change the file Library/isum.ml, the theorem ISUM_POS_LE automatically inherits the removal of the finiteness hypothesis. Thu 16th Jan 2014 sets.ml Added a few more basic properties of sup and inf: REAL_LE_SUP = |- !s a b y. y IN s /\ a <= y /\ (!x. x IN s ==> x <= b) ==> a <= sup s REAL_INF_LE = |- !s a b y. y IN s /\ y <= b /\ (!x. x IN s ==> a <= x) ==> inf s <= b REAL_SUP_LE_EQ = |- !s y. ~(s = {}) /\ (?b. !x. x IN s ==> x <= b) ==> (sup s <= y <=> (!x. x IN s ==> x <= y)) REAL_LE_INF_EQ = |- !s t. ~(s = {}) /\ (?b. !x. x IN s ==> b <= x) ==> (y <= inf s <=> (!x. x IN s ==> y <= x)) SUP_UNIQUE = |- !s b. (!c. (!x. x IN s ==> x <= c) <=> b <= c) ==> sup s = b INF_UNIQUE = |- !s b. (!c. (!x. x IN s ==> c <= x) <=> c <= b) ==> inf s = b SUP_UNION = |- !s t. ~(s = {}) /\ ~(t = {}) /\ (?b. !x. x IN s ==> x <= b) /\ (?c. !x. x IN t ==> x <= c) ==> sup (s UNION t) = max (sup s) (sup t) INF_UNION = |- !s t. ~(s = {}) /\ ~(t = {}) /\ (?b. !x. x IN s ==> b <= x) /\ (?c. !x. x IN t ==> c <= x) ==> inf (s UNION t) = min (inf s) (inf t) Thu 9th Jan 2014 class.ml, sets.ml Added a few theorems, two trivial but useful decomposition theorems for quantifiers over set unions, and two forms of the Axiom of Dependent Choice. These are a bit gratuitously overparameterized by "n", but this gives wider applicability and still works in the standard unparameterized case. FORALL_IN_UNION = |- !P s t. (!x. x IN s UNION t ==> P x) <=> (!x. x IN s ==> P x) /\ (!x. x IN t ==> P x) EXISTS_IN_UNION = |- !P s t. (?x. x IN s UNION t /\ P x) <=> (?x. x IN s /\ P x) \/ (?x. x IN t /\ P x) DEPENDENT_CHOICE_FIXED = |- !P R a. P 0 a /\ (!n x. P n x ==> (?y. P (SUC n) y /\ R n x y)) ==> ?f. f 0 = a /\ (!n. P n (f n)) /\ (!n. R n (f n) (f (SUC n))) DEPENDENT_CHOICE = |- !P R. (?a. P 0 a) /\ (!n x. P n x ==> (?y. P (SUC n) y /\ R n x y)) ==> ?f. (!n. P n (f n)) /\ (!n. R n (f n) (f (SUC n))) Mon 6th Jan 2014 holtest, holtest.mk [new file], holtest_parallel [new file] Added a new parallel version of holtest from Hendrik Tews, which is able to distribute tests over available processors/threads and is in general quite a bit faster. Also unified this and the old serial "holtest" over what to use as the HOL image: just use "hol-light" if it exists; make a "hol" executable if ckpt is available, otherwise just use ocaml directly. Fri 3rd Jan 2014 sets.ml, Permutation/morelist.ml Added a couple of simple lemmas about "list_of_set", for the simple case where there is no question about ordering: LIST_OF_SET_EMPTY = |- list_of_set {} = [] LIST_OF_SET_SING = |- !x. list_of_set {a} = [a] and a couple more related theorems in the Permutations library: LIST_UNIQ_APPEND = |- !l m. LIST_UNIQ (APPEND l m) <=> LIST_UNIQ l /\ LIST_UNIQ m /\ (!x. ~(MEM x l /\ MEM x m)) LIST_UNIQ_LIST_OF_SET = |- !s. FINITE s ==> LIST_UNIQ (list_of_set s) Sun 27th Oct 2013 class.ml Added a slightly more refined variant of SKOLEM_THM: SKOLEM_THM_GEN = |- !P s. (!x. P x ==> ?y. R x y) <=> (?f. !x. P x ==> R x (f x)) Sun 27th Oct 2013 cart.ml Added PCROSS_DIFF = |- (!s t u. s PCROSS (t DIFF u) = s PCROSS t DIFF s PCROSS u) /\ (!s t u. (s DIFF t) PCROSS u = s PCROSS u DIFF t PCROSS u) Wed 23rd Oct 2013 Makefile, pa_j_3.1x_6.11.ml [new file] Added yet another pa_j file, created by Freek Wiedijk, that appears to work correctly for all camlp5 versions 6.07 - 6.11 (current one), and modified the Makefile to select appropriately. Mon 23rd Sep 2013 nums.ml Made a modification from Tom Hales to "new_specification", simply using the names of the constants instead of some hidden counter to make the definitions unique. Fri 6th Sep 2013 cart.ml Added INTER_PCROSS = |- !s s' t t'. (s PCROSS t) INTER (s' PCROSS t') = (s INTER s') PCROSS (t INTER t') Mon 26th Aug 2013 sets.ml Added INFINITE_ENUMERATE = |- !s:num->bool. INFINITE s ==> ?r:num->num. (!m n. m < n ==> r(m) < r(n)) /\ IMAGE r (:num) = s Thu 15th Aug 2013 Library/card.ml Added CARD_LE_RELATIONAL_FULL = |- !R:A->B->bool s t. (!y. y IN t ==> ?x. x IN s /\ R x y) /\ (!x y y'. x IN s /\ y IN t /\ y' IN t /\ R x y /\ R x y' ==> y = y') ==> t <=_c s Wed 17th Jul 2013 Library/floor.ml Added INTEGER_ROUND = |- !x. ?n. integer n /\ abs(x - n) <= &1 / &2 Fri 12th Jul 2013 Library/floor.ml Added a few theorems asserting that there are integers between well-spaced pairs of reals: INTEGER_EXISTS_BETWEEN = |- !x y. x + &1 <= y ==> ?n. integer n /\ x <= n /\ n < y INTEGER_EXISTS_BETWEEN_ABS = |- !x y. &1 <= abs(x - y) ==> ?n. integer n /\ (x <= n /\ n < y \/ y <= n /\ n < x) INTEGER_EXISTS_BETWEEN_ABS_LT = |- !x y. &1 < abs(x - y) ==> ?n. integer n /\ (x < n /\ n < y \/ y < n /\ n < x) INTEGER_EXISTS_BETWEEN_ALT = |- !x y. x + &1 <= y ==> ?n. integer n /\ x < n /\ n <= y INTEGER_EXISTS_BETWEEN_LT = |- !x y. x + &1 < y ==> ?n. integer n /\ x < n /\ n < y Thu 11th Jul 2013 sets.ml Added a couple of slightly technical set lemmas: FINITE_TRANSITIVITY_CHAIN = |- !R s. FINITE s /\ (!x. ~(R x x)) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x. x IN s ==> ?y. y IN s /\ R x y) ==> s = {} UNIONS_MAXIMAL_SETS = |- !f. FINITE f ==> UNIONS {t | t IN f /\ !u. u IN f ==> ~(t PSUBSET u)} = UNIONS f Mon 8th Jul 2013 int.ml Added a trivial but useful theorem: INT_OF_NUM_EXISTS = |- !x. (?n. x = &n) <=> &0 <= x Wed 3rd Jul 2013 real.ml, int.ml Added two simple clausal theorems for "signs of signs" REAL_SGN_INEQS = |- (!x. &0 <= real_sgn x <=> &0 <= x) /\ (!x. &0 < real_sgn x <=> &0 < x) /\ (!x. &0 >= real_sgn x <=> &0 >= x) /\ (!x. &0 > real_sgn x <=> &0 > x) /\ (!x. &0 = real_sgn x <=> &0 = x) /\ (!x. real_sgn x <= &0 <=> x <= &0) /\ (!x. real_sgn x < &0 <=> x < &0) /\ (!x. real_sgn x >= &0 <=> x >= &0) /\ (!x. real_sgn x > &0 <=> x > &0) /\ (!x. real_sgn x = &0 <=> x = &0) INT_SGN_INEQS = |- (!x. &0 <= int_sgn x <=> &0 <= x) /\ (!x. &0 < int_sgn x <=> &0 < x) /\ (!x. &0 >= int_sgn x <=> &0 >= x) /\ (!x. &0 > int_sgn x <=> &0 > x) /\ (!x. &0 = int_sgn x <=> &0 = x) /\ (!x. int_sgn x <= &0 <=> x <= &0) /\ (!x. int_sgn x < &0 <=> x < &0) /\ (!x. int_sgn x >= &0 <=> x >= &0) /\ (!x. int_sgn x > &0 <=> x > &0) /\ (!x. int_sgn x = &0 <=> x = &0) Wed 3rd Jul 2013 int.ml Fixed a bug in INT_OF_REAL_THM where theorems with more than 2 conjuncts were not being transformed correctly. Sat 29th Jun 2013 miz3/miz3.ml, miz3/bin/miz3 Made a couple of improvements to the portability of miz3 to Mac OS X, based on suggestions from Josh Jordan. Replaced the explicit signal number 12 by Sys.sigusr2, and replace realpath (which doesn't exist by default in OS X) by a line of Perl from Freek Wiedijk. Fri 28th Jun 2013 tactics.ml, Library/card.ml Moved TRANS_TAC from the cardinality theories to the main core. Fri 21st Jun 2013 Library/products.ml Added the obvious theorems about products of negations: PRODUCT_NEG = |- !f s. FINITE s ==> product s (\i. --f i) = -- &1 pow CARD s * product s f PRODUCT_NEG_NUMSEG = |- !f m n. product (m..n) (\i. --f i) = -- &1 pow ((n + 1) - m) * product (m..n) f PRODUCT_NEG_NUMSEG_1 = |- !f n. product (1..n) (\i. --f i) = -- &1 pow n * product (1..n) f Tue 4th Jun 2013 cart.ml Added a 4-element type and corresponding theorems HAS_SIZE_4 = |- (:4) HAS_SIZE 4 DIMINDEX_4 = |- dimindex (:4) = 4 Fri 31st May 2013 cart.ml Added: PCROSS_INTER = |- (!s t u. s PCROSS (t INTER u) = (s PCROSS t) INTER (s PCROSS u)) /\ (!s t u. (s INTER t) PCROSS u = (s PCROSS u) INTER (t PCROSS u)) PCROSS_UNION = |- (!s t u. s PCROSS (t UNION u) = (s PCROSS t) UNION (s PCROSS u)) /\ (!s t u. (s UNION t) PCROSS u = (s PCROSS u) UNION (t PCROSS u)) PCROSS_UNIONS_UNIONS = |- !f g. (UNIONS f) PCROSS (UNIONS g) = UNIONS {s PCROSS t | s IN f /\ t IN g} PCROSS_UNIONS = |- (!s f. s PCROSS (UNIONS f) = UNIONS {s PCROSS t | t IN f}) /\ (!f t. (UNIONS f) PCROSS t = UNIONS {s PCROSS t | s IN f}) Thu 30th May 2013 Library/card.ml Added some analogs of theorems already there for FINITE COUNTABLE_SUBSET_IMAGE = |- !f s t. COUNTABLE t /\ t SUBSET IMAGE f s <=> (?s'. COUNTABLE s' /\ s' SUBSET s /\ t = IMAGE f s') EXISTS_COUNTABLE_SUBSET_IMAGE = |- !P f s. (?t. COUNTABLE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. COUNTABLE t /\ t SUBSET s /\ P (IMAGE f t)) FORALL_COUNTABLE_SUBSET_IMAGE = |- !P f s. (!t. COUNTABLE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. COUNTABLE t /\ t SUBSET s ==> P (IMAGE f t)) Thu 30th May 2013 sets.ml Added the following FORALL_SUBSET_UNION = |- !t u:A->bool. (!s. s SUBSET t UNION u ==> P s) <=> (!t' u'. t' SUBSET t /\ u' SUBSET u ==> P(t' UNION u')) EXISTS_SUBSET_UNION = |- !t u:A->bool. (?s. s SUBSET t UNION u /\ P s) <=> (?t' u'. t' SUBSET t /\ u' SUBSET u /\ P(t' UNION u')) Sun 26th May 2013 hol.ml Added an extra line from Hendrik Tews to make things work more smoothly with OCaml 4.xx: #directory "+compiler-libs";; Fri 24th May 2013 Library/iter.ml Addded ITER_1 = |- !f x. ITER 1 f x = f x Mon 20th May 2013 Library/card.ml Added COUNTABLE_IMP_CARD_LT_REAL = |- !s. COUNTABLE s ==> s <_c (:real) Thu 2nd May 2013 sets.ml Added CARD_SING = |- !a. CARD {a} = 1 Wed 1st May 2013 cart.ml Added: PCROSS_EQ = |- !s s' t t'. s PCROSS t = s' PCROSS t' <=> (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/ s = s' /\ t = t' Tue 30th Apr 2013 cart.ml Added: IMAGE_FSTCART_PCROSS = |- !s t. IMAGE fstcart (s PCROSS t) = if t = {} then {} else s IMAGE_SNDCART_PCROSS = |- !s t. IMAGE sndcart (s PCROSS t) = if s = {} then {} else t Fri 5th Apr 2013 Examples/inverse_bug_puzzle_tac.ml Updated this file to a new version from Bill Richter using some slightly different constructs. Fri 5th Apr 2013 Examples/prover9.ml Fixed a bug in the prover9 interface pointed out by Keiichi Tsujimoto, where the initial preprocessing could cause the initial goal to collapse to `T` or `F`, which is then not handled properly by the main prover9 step. The fix is to treat this specially in the preprocessing phase. Sun 31st Mar 2013 Examples/inverse_bug_puzzle_miz3.ml Made an update to Bill Richter's miz3 version of the inverse bug puzzle. Sat 23rd Mar 2013 Examples/inverse_bug_puzzle_tac.ml, Examples/inverse_bug_puzzle_miz3.ml Added a tactic version Examples/inverse_bug_puzzle_tac.ml of Bill Richter's inverse bug puzzle solution, and renamed the earlier one as Examples/inverse_bug_puzzle_miz3.ml. Sat 23rd Mar 2013 Makefile Incorporated a change from Jack Pappas to ensure that the Makefile handles non-standard locations for camlp4, using "`camlp[45] -where`" instead of "+camlp[45]". Fri 22nd Mar 2013 cart.ml, Library/card.ml Added EXISTS_IN_PCROSS = |- (?z. z IN s PCROSS t /\ P z) <=> (?x y. x IN s /\ y IN t /\ P (pastecart x y)) PCROSS_MONO = |- !s t s' t'. s SUBSET s' /\ t SUBSET t' ==> s PCROSS t SUBSET s' PCROSS t' SUBSET_PCROSS = |- !s t s' t'. s PCROSS t SUBSET s' PCROSS t' <=> s = {} \/ t = {} \/ s SUBSET s' /\ t SUBSET t' UNIV_PCROSS_UNIV = |- (:A^M) PCROSS (:A^N) = (:A^(M,N)finite_sum) FINITE_PCROSS_EQ = |- !s t. FINITE (s PCROSS t) <=> s = {} \/ t = {} \/ FINITE s /\ FINITE t COUNTABLE_CARD_MUL = |- !s t. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE (s *_c t); COUNTABLE_CARD_MUL_EQ = |- !s t. COUNTABLE (s *_c t) <=> s = {} \/ t = {} \/ COUNTABLE s /\ COUNTABLE t CARD_EQ_PCROSS = |- !s t. s PCROSS t =_c s *_c t COUNTABLE_PCROSS_EQ = |- !s t. COUNTABLE (s PCROSS t) <=> s = {} \/ t = {} \/ COUNTABLE s /\ COUNTABLE t COUNTABLE_PCROSS = |- !s t. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE (s PCROSS t) Thu 21st Mar 2013 cart.ml Added more theorems about PCROSS: PCROSS_EQ_EMPTY = |- !s t. s PCROSS t = {} <=> s = {} \/ t = {} HAS_SIZE_PCROSS = |- !s t m n. s HAS_SIZE m /\ t HAS_SIZE n ==> s PCROSS t HAS_SIZE m * n FINITE_PCROSS = |- !s t. FINITE s /\ FINITE t ==> FINITE (s PCROSS t) PCROSS_EMPTY = |- (!s. s PCROSS {} = {}) /\ (!t. {} PCROSS t = {}) Wed 20th Mar 2013 cart.ml Added a definition of a variant notion of product using pasting of vectors, called PCROSS, plus two elementary theorems: PCROSS = |- s PCROSS t = {pastecart (x:A^M) (y:A^N) | x IN s /\ y IN t} FORALL_IN_PCROSS = |- (!z. z IN s PCROSS t ==> P z) <=> (!x y. x IN s /\ y IN t ==> P(pastecart x y)) PASTECART_IN_PCROSS = |- !s t x y. (pastecart x y) IN (s PCROSS t) <=> x IN s /\ y IN t Mon 18th Mar 2013 preterm.ml Added a slight update from Vincent Aravantinos to the typechecking error messages, to handle additional cases. Fri 15th Mar 2013 iterate.ml Added a couple of strict positivity theorems for sums: NSUM_POS_LT = |- !f s. FINITE s /\ (?x. x IN s /\ 0 < f x) ==> 0 < nsum s f SUM_POS_LT = |- !f s. FINITE s /\ (!x. x IN s ==> &0 <= f x) /\ (?x. x IN s /\ &0 < f x) ==> &0 < sum s f Fri 15th Feb 2013 Examples/inverse_bug_puzzle.ml [new file] Added a new file due to Bill Richter giving a solution to the inverse bug puzzle in the tutorial, using miz3 and the vector theories. Fri 15th Feb 2013 tactics.ml Improved the error reporting in EXISTS_TAC, X_CHOOSE_TAC and X_GEN_TAC, which now in particular specify the expected and received types of the terms when they don't agree. Wed 13th Feb 2013 real.ml Added the following obvious theorem (which does depend on the choice of 1/0): REAL_DIV_EQ_0 = |- !x y. x / y = &0 <=> x = &0 \/ y = &0 Fri 18th Jan 2013 lists.ml, Library/prime.ml, Library/pocklington.ml, Permutation/permuted.ml Added a miscellany of theorems: APPEND_SING = |- !h t. APPEND [h] t = CONS h t MEM_APPEND_DECOMPOSE_LEFT = |- !x l. MEM x l <=> (?l1 l2. ~MEM x l1 /\ l = APPEND l1 (CONS x l2)) MEM_APPEND_DECOMPOSE = |- !x l. MEM x l <=> (?l1 l2. l = APPEND l1 (CONS x l2)) PERMUTED_APPEND_SWAP = |- !l1 l2. (APPEND l1 l2) PERMUTED (APPEND l2 l1) DIVIDES_EXP_MINUS1 = |- !k n. n - 1 divides n EXP k - 1 DIVIDES_EXP_PLUS1 = |- !n k. ODD k ==> n + 1 divides n EXP k + 1 PRIME_DIVEXP_EQ = |- !n p x. prime p ==> (p divides x EXP n <=> p divides x /\ ~(n = 0)) PRIME_POWER_EXISTS = |- !q. prime q ==> ((?i. n = q EXP i) <=> (!p. prime p /\ p divides n ==> p = q)) Thu 17th Jan 2013 Library/products.ml Added PRODUCT_CLAUSES_LEFT = |- !f m n. m <= n ==> product (m..n) f = f m * product (m + 1..n) f PRODUCT_CLAUSES_RIGHT = |- !f m n. 0 < n /\ m <= n ==> product (m..n) f = product (m..n - 1) f * f n Wed 16th Jan 2013 sets.ml Added UNIONS_MONO = |- (!x. x IN s ==> (?y. y IN t /\ x SUBSET y)) ==> UNIONS s SUBSET UNIONS t UNIONS_MONO_IMAGE = |- (!x. x IN s ==> f x SUBSET g x) ==> UNIONS (IMAGE f s) SUBSET UNIONS (IMAGE g s) Sun 6th Jan 2013 miz3/Samples/icms.ml Removed the load of Multivariate/misc.ml from this example, putting the proof of the Archimedian lemma directly in this file. There is now an incompatibility with the Multivariate use of "from" as a constant with the use as a miz3 reserved word. This should probably be dealt with more systematically, perhaps by renaming the constant to FROM. Fri 4th Jan 2013 tactics.ml, theorems.ml, help.ml, Help/DESTRUCT_TAC.doc [new file], Help/FIX_TAC.doc [new file], Help/HYP.doc [new file], Help/INTRO_TAC.doc [new file] Added four new tactic constructs from Marco Maggesi. HYP is analogous to ASM but restricting to named (labelled) assumptions. DESTRUCT_TAC, FIX_TAC and INTRO_TAC give more concise and elegant ways of fixing variables, performing introduction on a goal or elimination on a theorem, labelling assumptions in the process. Fri 4th Jan 2013 Multivariate/tarski.ml, 100/independence.ml Added two files showing Tarski's 11 axioms for geometry hold in the Euclidean plane but all except axiom 10 hold in the Klein model of the hyperbolic plane. This effectively proves the independence of the parallel postulate. Fri 4th Jan 2013 Library/floor.ml Added RATIONAL_BETWEEN = |- !a b. a < b ==> ?q. rational q /\ a < q /\ q < b Fri 4th Jan 2013 cart.ml Added PASTECART_INJ = |- !x y w z. pastecart x y = pastecart w z <=> x = w /\ y = z Wed 2nd Jan 2013 system.ml, miz3/miz3.ml Extended the regular quotation parser to pass quotations of the form `;....` to miz3's "parse_qproof". This makes it more convenient to load files with miz3 proofs in without first setting up the new parser before the file is loaded. Thu 20th Dec 2012 sets.ml Added SUBSET_INTERS = |- !s f. s SUBSET INTERS f <=> (!t. t IN f ==> s SUBSET t) Wed 19th Dec 2012 sets.ml Renamed the existing DIFF_UNIONS to UNIONS_DIFF and added the following: DIFF_UNIONS = |- !u s. u DIFF UNIONS s = u INTER INTERS {u DIFF t | t IN s} DIFF_UNIONS_NONEMPTY = |- !u s. ~(s = {}) ==> u DIFF UNIONS s = INTERS {u DIFF t | t IN s} This seems more consistent with the naming of DIFF_INTERS. Mon 17th Dec 2012 Library/wo.ml Added the definition of total order and a proof of the order extension theorem: toset = |- toset l <=> poset l /\ !x y. x IN fl(l) /\ y IN fl(l) ==> l(x,y) \/ l(y,x) OEP = |- !p. poset p ==> ?t. toset t /\ fl(t) = fl(p) /\ p SUBSET t Fri 14th Dec 2012 preterm.ml Updated the typechecker with a new version from Vincent Aravantinos that gives more useful error messages when typechecking fails. Wed 5th Dec 2012 sets.ml Added a couple of reformulations of injectivity. This is useful since the left-hand characterization can make the simplifier get very slow. INJECTIVE_ON_ALT = |- !P f. (!x y. P x /\ P y /\ f x = f y ==> x = y) <=> (!x y. P x /\ P y ==> (f x = f y <=> x = y)) INJECTIVE_ALT = |- !f. (!x y. f x = f y ==> x = y) <=> (!x y. f x = f y <=> x = y) Fri 16th Nov 2012 tactics.ml, Help/STRUCT_CASES_THEN.doc [new file] At the suggestion of Petros Papapanagiotou, made a theorem-tactic form STRUCT_CASES_THEN of STRUCT_CASES_TAC, to allow for more flexibility in how the resulting theorems get used. Fri 16th Nov 2012 IsabelleLight/*, RichterHilbertAxiomGeometry/* Brought these up to date with recent changes by their respective authors. Fri 16th Nov 2012 hol.ml, preterm.ml, parser.ml, printer.ml Reshuffled a few preliminaries between these files so that "printer.ml" could be loaded before the other two. This is a prelude to putting in code from Vincent Aravantinos for better error messages from typechecking, where it's useful to have functions from "printer.ml" for the error reporting. Fri 16th Nov 2012 sets.ml, cart.ml Added a few simple theorems about cardinalities of finite universe sets, and also a natural counterpart UNIV_GSPEC to EMPTY_GSPEC. New theorems: CARD_BOOL = |- CARD (:bool) = 2 CARD_CART_UNIV = |- FINITE (:A) ==> CARD (:A^N) = CARD (:A) EXP dimindex (:N) CARD_FUNSPACE_UNIV = |- FINITE (:A) /\ FINITE (:B) ==> CARD (:A->B) = CARD (:B) EXP CARD (:A) FINITE_BOOL = |- FINITE (:bool) FINITE_CART_UNIV = |- FINITE (:A) ==> FINITE (:A^N) FINITE_FUNSPACE_UNIV = |- FINITE (:A) /\ FINITE (:B) ==> FINITE (:A->B) HAS_SIZE_BOOL = |- (:bool) HAS_SIZE 2 HAS_SIZE_CART_UNIV = |- !m. (:A) HAS_SIZE m ==> (:A^N) HAS_SIZE m EXP dimindex (:N) HAS_SIZE_FUNSPACE_UNIV = |- !m n. (:A) HAS_SIZE m /\ (:B) HAS_SIZE n ==> (:A->B) HAS_SIZE n EXP m UNIV_GSPEC = |- {x | T} = UNIV Tue 13th Nov 2012 sets.ml, Library/card.ml Added three new theorems about COUNTABLE in exact analogy with FINITE, and also cleaned up the FINITE proof of one of them based on the pattern. COUNTABLE_IMAGE_INJ = |- !f A. (!x y. f x = f y ==> x = y) /\ COUNTABLE A ==> COUNTABLE {x | f x IN A} COUNTABLE_IMAGE_INJ_EQ = |- !f s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (COUNTABLE (IMAGE f s) <=> COUNTABLE s) COUNTABLE_IMAGE_INJ_GENERAL = |- !f A s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ COUNTABLE A ==> COUNTABLE {x | x IN s /\ f x IN A} Fri 28th Sep 2012 pair.ml, int.ml, sets.ml, database.ml, Library/card.ml Added a few miscellaneous little theorems: CHOOSE_SUBSET_BETWEEN = |- !n s u. s SUBSET u /\ FINITE s /\ CARD s <= n /\ (FINITE u ==> n <= CARD u) ==> (?t. s SUBSET t /\ t SUBSET u /\ t HAS_SIZE n) EXISTS_CURRY = |- !P. (?f. P f) <=> (?f. P (\(a,b). f a b)) FORALL_CURRY = |- !P. (!f. P f) <=> (!f. P (\(a,b). f a b)) FORALL_FINITE_SUBSET_IMAGE = |- !P f s. (!t. FINITE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. FINITE t /\ t SUBSET s ==> P (IMAGE f t)) INFINITE_SUPERSET = |- !s t. INFINITE s /\ s SUBSET t ==> INFINITE t INF_SING = |- !a. inf {a} = a PAIRED_ETA_THM = |- (!f. (\(x,y). f (x,y)) = f) /\ (!f. (\(x,y,z). f (x,y,z)) = f) /\ (!f. (\(w,x,y,z). f (w,x,y,z)) = f) SUP_SING = |- !a. sup {a} = a as well as slightly reshuffling some existing theorems and adding new cardinality theorems. Thu 6th Sep 2012 update_database.ml Fixed the update_database code for OCaml 4.00. This entails making a couple more things conditional on the version number (using the exec "code" method already used in Roland Zumkeller's original code). First, the "Tvar" constructor now takes an argument (and because of the way OCaml's internal representation works with different sequences for nullary and non-nullary, this changes some of the constructor numbers). Second, the tbl type has changed to the use of EnvTbl that effectively wraps up the core type 'a into 'a * bool ref. Fri 31st Aug 2012 Makefile, README Fixed up the Makefile both for recent camlp5s (not exhaustively tested, but I think it is right) and also for OCaml 4.00, as well as making the instructions in the README file a bit more up-to-date. Fri 1st Jun 2012 100/descartes.ml [new file] Added a proof of Descartes's rule of signs, based on Rob Arthan's paper "Descartes's Rule of Signs by an Easy Induction". Wed 30th May 2012 100/cayley_hamilton.ml [new file] Added a proof of the Cayley-Hamilton theorem for real matrices. Wed 30th May 2012 100/feuerbach.ml [new file] Added a proof of Feuerbach's theorem. Tue 29th May 2012 Examples/sylvester_gallai.ml [new file] Added a proof of the Sylvester-Gallai theorem. Mon 28th May 2012 100/morley.ml [new file] Added a proof of Morley's theorem, following Alain Connes's paper "A new proof of Morley's theorem". Sun 27th May 2012 Examples/brunn_minkowski.ml [new file] Added a proof of the Brunn-Minkowski theorem. Sat 26th May 2012 100/platonic.ml [new file] Added a proof that the Platonic solids are limited to the classic five, and that those all do exist and are regular. Because of the rather crude way in which the computations of facial structure are done, this proof takes quite a long time to load. Sat 26th May 2012 QBF/* [new files] Added Ondrej Kuncar's code for constructing proofs of quantified boolean formulas in HOL Light using proof traces from Squolem. Fri 25th May 2012 100/polyhedron.ml [new file] Added a proof of Euler's polyhedron formula for convex polytopes, and indeed the general Euler-Poincare relation. This follows Jim Lawrence's "A short proof of Euler's relation for convex polytopes" (Canadian Math Bulletin, 1997). This proof was mostly quite easy and natural to formalize, except for some slightly tedious switching between open and closed cells at one point. Wed 16th May 2012 Makefile Added a test to the Makefile to catch camlp5 6.05 and use the pa_j.ml designed for 6.02.2, which according to a test by Bill Richter works fine. I could probably also add the intermediate versions 6.03 and 6.04, but I didn't do so for now. Wed 16th May 2012 miz3/miz3.ml, miz3/test.ml, holtest Made a small tweak to miz3.ml from Freek, and removed the test run in the final line. Also replaced the former test.ml file with the former Samples/ALL (which is no longer there now), and made "holtest" run it twice in case cacheing changes things. Mon 7th May 2012 sets.ml Added the trivial but sometimes useful lemma INFINITE_SUPERSET = |- !s t. INFINITE s /\ s SUBSET t ==> INFINITE t Fri 4th May 2012 miz3/* [new files], passim Added Freek Wiedijk's miz3 mode, and since there I first made a tweak of open_in -> Pervasives.open_in (to avoid possible namespace conflicts with Multivariate/topology.ml) made a similar change in a few other places too. Fri 27th Apr 2012 sets.ml, Help/new_inductive_set.doc [new file] Added a function from Marco Maggesi for defining sets inductively by analogy with new_inductive_definition for relations. Fri 27th Apr 2012 preterm.ml, Help/the_implicit_types.doc [new file], Help/passim Added another extra feature to term parsing from Marco Maggesi, a list of implicit type schemes for variables in quotations, "the_implicit_types". Thu 26th Apr 2012 preterm.ml, Help/type_invention_error.doc [new file], type_invention_warning.doc Added code from Marco Maggesi to incorporate an additional option "type_invention_error" that forces type variables to be an error, not merely be warned about. Added a corresponding documentation file and some cross-referencing w.r.t the existing file "type_invention_warning.doc". Thu 26th Apr 2012 holtest Incorporated some changes from Hendrik Tews to make "holtest" a bit more robust and keep it consistent with the HOL Light debian package. Tue 24th Apr 2012 Help/new_axiom.doc Made a couple of small fixes to the "new_axiom" documentation, removing a stray paren and adding a cross-reference to "axioms". Fri 30th Mar 2012 Permutation/permuted.ml Added a couple of lemmas about list permutations preserving "PAIRWISE" for a symmetric relation, plus strong induction PERMUTED_INDUCT_STRONG: PERMUTED_IMP_PAIRWISE = |- !P l l'. (!x y. P x y ==> P y x) /\ l PERMUTED l' /\ PAIRWISE P l ==> PAIRWISE P l' PERMUTED_PAIRWISE = |- !P l l'. (!x y. P x y ==> P y x) /\ l PERMUTED l' ==> (PAIRWISE P l <=> PAIRWISE P l') Thu 29th Mar 2012 Library/card.ml Added a few new theorems about cardinal arithmetic: CARD_LE_RELATIONAL = |- !R. (!x y y'. x IN s /\ R x y /\ R x y' ==> y = y') ==> {y | ?x. x IN s /\ R x y} <=_c s CARD_LT_FINITE_INFINITE = |- !s t. FINITE s /\ INFINITE t ==> s <_c t CARD_ADD2_ABSORB_LT = |- !s t u. INFINITE u /\ s <_c u /\ t <_c u ==> s +_c t <_c u CARD_ADD_FINITE_EQ = |- !s t. FINITE (s +_c t) <=> FINITE s /\ FINITE t CARD_ADD_C = |- !s t. FINITE s /\ FINITE t ==> CARD (s +_c t) = CARD s + CARD t CARD_LT_ADD = |- !s s' t t'. s <_c s' /\ t <_c t' ==> s +_c t <_c s' +_c t' Fri 9th Mar 2012 Library/card.ml Added a few more trivial lemmas about cardinality: CARD_LT_LE = |- !s t. s <_c t <=> s <=_c t /\ ~(s =_c t) CARD_LE_LT = |- !s t. s <=_c t <=> s <_c t \/ s =_c t COUNTABLE_ALT = |- !s. COUNTABLE s <=> s <=_c (:num) COUNTABLE_CASES = |- !s. COUNTABLE s <=> FINITE s \/ s =_c (:num) Sun 26th Feb 2012 sets.ml Added CARD_IMAGE_EQ_INJ = |- !f:A->B s. FINITE s ==> (CARD(IMAGE f s) = CARD s <=> !x y. x IN s /\ y IN s /\ f x = f y ==> x = y) PAIRWISE_IMAGE = |- !r f. pairwise r (IMAGE f s) <=> pairwise (\x y. ~(f x = f y) ==> r (f x) (f y)) s Thu 23rd Feb 2012 sets.ml Added PAIRWISE_INSERT = |- !r x s. pairwise r (x INSERT s) <=> (!y. y IN s /\ ~(y = x) ==> r x y /\ r y x) /\ pairwise r s Tue 21st Feb 2012 sets.ml, Library/card.ml Added two direct equality results for sups and infs: SUP_EQ = |- !s t. (!b. (!x. x IN s ==> x <= b) <=> (!x. x IN t ==> x <= b)) ==> sup s = sup t INF_EQ = |- !s t. (!a. (!x. x IN s ==> a <= x) <=> (!x. x IN t ==> a <= x)) ==> inf s = inf t and a few basic lemmas about cardinality: CARD_LE_COUNTABLE = |- !s t. COUNTABLE t /\ s <=_c t ==> COUNTABLE s CARD_COUNTABLE_CONG = |- !s t. s =_c t ==> (COUNTABLE s <=> COUNTABLE t) CARD_EQ_FINITE = |- !s t. FINITE t /\ s =_c t ==> FINITE s CARD_EQ_COUNTABLE = |- !s t. COUNTABLE t /\ s =_c t ==> COUNTABLE s CARD_EQ_IMAGE = |- !f s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f s =_c s CARD_EQ_REAL_IMP_UNCOUNTABLE = |- !s. s =_c (:real) ==> ~COUNTABLE s Sat 11th Feb 2012 Library/floor.ml Added the obvious facts that the integer and rational valued reals are both infinite: INFINITE_INTEGER = |- INFINITE integer INFINITE_RATIONAL = |- INFINITE rational Thu 2nd Feb 2012 iterate.ml Added two theorems about pushing MODs through sums of natural numbers: MOD_NSUM_MOD = |- !f n s. FINITE s /\ ~(n = 0) ==> nsum s f MOD n = nsum s (\i. f i MOD n) MOD n MOD_NSUM_MOD_NUMSEG = |- !f a b n. ~(n = 0) ==> nsum (a..b) f MOD n = nsum (a..b) (\i. f i MOD n) MOD n Wed 1st Feb 2012 arith.ml Added a theorem that's a trivial consequence of DIVISION, but sometimes a bit more convenient DIVISION_SIMP = |- (!m n. ~(n = 0) ==> m DIV n * n + m MOD n = m) /\ (!m n. ~(n = 0) ==> n * m DIV n + m MOD n = m) Wed 1st Feb 2012 Mizarlight/Makefile Fixed up the Makefile to choose camlp5 versus camlp4 in a correct way as in the main system Makefile (previously this failed for OCaml >= 3.12). Tue 31st Jan 2012 sets.ml Added one more set lemma, analogous to INTER_UNIONS: DIFF_UNIONS = |- !s t. (UNIONS s) DIFF t = UNIONS {x DIFF t | x IN s} Thu 26th Jan 2012 cart.ml Added a somewhat technical lemma, a generalization of FINITE_INDEX_INRANGE that is useful for obscure situations to get rid of range conditions in doubly indexed cartesian products: FINITE_INDEX_INRANGE_2 = |- !i. ?k. 1 <= k /\ k <= dimindex(:N) /\ (!x:A^N. x$i = x$k) /\ (!y:B^N. y$i = y$k) Thu 19th Jan 2012 Library/card.ml Generalized COUNTABLE_PRODUCT_DEPENDENT to have the same form as FINITE_PRODUCT_DEPENDENT instead of being tied specifically to pairs. Sat 14th Jan 2012 sets.ml Added "localized" forms of the theorems about factoring functions through each other: FUNCTION_FACTORS_LEFT_GEN = |- !P f g. (!x y. P x /\ P y /\ g x = g y ==> f x = f y) <=> (?h. !x. P x ==> f(x) = h(g x)) FUNCTION_FACTORS_RIGHT_GEN = |- !P f g. (!x. P x ==> ?y. g(y) = f(x)) <=> (?h. !x. P x ==> f(x) = g(h x)) Mon 9th Jan 2012 list.ml Added two new list theorems MAP_REVERSE = |- !f l. REVERSE(MAP f l) = MAP f (REVERSE l) ALL_FILTER = |- !P Q l. ALL P (FILTER Q l) <=> ALL (\x. Q x ==> P x) l Thu 23rd Dec 2011 Library/card.ml Added CARD_LE_UNIV = |- !s:A->bool. s <=_c (:A) Wed 22nd Dec 2011 sets.ml, iterate.ml, define.ml, Library/permutations.ml, Library/products.ml, Library/iter.ml, Multivariate/ passim Did a bit of cleaning up of theorems to remove redundant quantifiers (put there by accident for variables that aren't free in the body). This includes the following and numerous theorems in the Multivariate theories: ========= sets.ml ============ SIMPLE_IMAGE_GEN HAS_SIZE_0 ========= iterate.ml ============ NSUM_BOUND_GEN NSUM_BOUND_LT_GEN NSUM_EQ_0_NUMSEG SUM_BOUND_GEN SUM_BOUND_LT_GEN SUM_EQ_0_NUMSEG ========= define.ml ============ ADMISSIBLE_MATCH ========= Library/permutations.ml ============ PERMUTES_COMPOSE ========= Library/products.ml ============ PRODUCT_EQ_1_NUMSEG ========= Library/iter.ml ============ ITER_ALT_POINTLESS Sun 18th Dec 2011 cart.ml Added a convenient set elimination theorem for pasted vectors: IN_ELIM_PASTECART_THM = |- !P a b. pastecart a b IN {pastecart x y | P x y} <=> P a b Thu 1st Dec 2011 Library/card.ml Added a few more theorems on cardinality of list and cartesian product types and also the cardinality and uncountability of the reals. This last fact is done in a primitive way to avoid depending on the analytical theories. The theorem UNCOUNTABLE_REAL has been taken out of the Multivariate theories now in consequence. CARD_EQ_LIST = |- INFINITE (:A) ==> (:(A)list) =_c (:A) CARD_EQ_CART = |- INFINITE (:A) ==> (:A^N) =_c (:A) CARD_EQ_REAL = |- (:real) =_c (:num->bool) UNCOUNTABLE_REAL = |- ~COUNTABLE (:real) Thu 1st Dec 2011 sets.ml Moved all the definitions and basic theorems about sup and inf to the end of this file from Multivariate/misc.ml: inf = |- !s. inf s = (@a. (!x. x IN s ==> a <= x) /\ (!b. (!x. x IN s ==> b <= x) ==> b <= a)) sup = |- !s. sup s = (@a. (!x. x IN s ==> x <= a) /\ (!b. (!x. x IN s ==> x <= b) ==> a <= b)))] INF = |- !s. ~(s = {}) /\ (?b. !x. x IN s ==> b <= x) ==> (!x. x IN s ==> inf s <= x) /\ (!b. (!x. x IN s ==> b <= x) ==> b <= inf s) INF_FINITE = |- !s. FINITE s /\ ~(s = {}) ==> inf s IN s /\ (!x. x IN s ==> inf s <= x) INF_FINITE_LEMMA = |- !s. FINITE s /\ ~(s = {}) ==> (?b. b IN s /\ (!x. x IN s ==> b <= x)) INF_INSERT_FINITE = |- !x s. FINITE s ==> inf (x INSERT s) = (if s = {} then x else min x (inf s)) INF_UNIQUE_FINITE = |- !s. FINITE s /\ ~(s = {}) ==> (inf s = a <=> a IN s /\ (!y. y IN s ==> a <= y)) REAL_ABS_INF_LE = |- !s a. ~(s = {}) /\ (!x. x IN s ==> abs x <= a) ==> abs (inf s) <= a REAL_ABS_SUP_LE = |- !s a. ~(s = {}) /\ (!x. x IN s ==> abs x <= a) ==> abs (sup s) <= a REAL_INF_ASCLOSE = |- !s l e. ~(s = {}) /\ (!x. x IN s ==> abs (x - l) <= e) ==> abs (inf s - l) <= e REAL_INF_BOUNDS = |- !s a b. ~(s = {}) /\ (!x. x IN s ==> a <= x /\ x <= b) ==> a <= inf s /\ inf s <= b REAL_INF_LE_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (inf s <= a <=> (?x. x IN s /\ x <= a)) REAL_INF_LT_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (inf s < a <=> (?x. x IN s /\ x < a)) REAL_INF_UNIQUE = |- !s b. (!x. x IN s ==> b <= x) /\ (!b'. b < b' ==> (?x. x IN s /\ x < b')) ==> inf s = b REAL_LE_INF = |- !b. ~(s = {}) /\ (!x. x IN s ==> b <= x) ==> b <= inf s REAL_LE_INF_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (a <= inf s <=> (!x. x IN s ==> a <= x)) REAL_LE_INF_SUBSET = |- !s t. ~(t = {}) /\ t SUBSET s /\ (?b. !x. x IN s ==> b <= x) ==> inf s <= inf t REAL_LE_SUP_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (a <= sup s <=> (?x. x IN s /\ a <= x)) REAL_LT_INF_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (a < inf s <=> (!x. x IN s ==> a < x)) REAL_LT_SUP_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (a < sup s <=> (?x. x IN s /\ a < x)) REAL_SUP_ASCLOSE = |- !s l e. ~(s = {}) /\ (!x. x IN s ==> abs (x - l) <= e) ==> abs (sup s - l) <= e REAL_SUP_BOUNDS = |- !s a b. ~(s = {}) /\ (!x. x IN s ==> a <= x /\ x <= b) ==> a <= sup s /\ sup s <= b REAL_SUP_EQ_INF = |- !s. ~(s = {}) /\ (?B. !x. x IN s ==> abs x <= B) ==> (sup s = inf s <=> (?a. s = {a})) REAL_SUP_LE = |- !b. ~(s = {}) /\ (!x. x IN s ==> x <= b) ==> sup s <= b REAL_SUP_LE_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (sup s <= a <=> (!x. x IN s ==> x <= a)) REAL_SUP_LE_SUBSET = |- !s t. ~(s = {}) /\ s SUBSET t /\ (?b. !x. x IN t ==> x <= b) ==> sup s <= sup t REAL_SUP_LT_FINITE = |- !s a. FINITE s /\ ~(s = {}) ==> (sup s < a <=> (!x. x IN s ==> x < a)) REAL_SUP_UNIQUE = |- !s b. (!x. x IN s ==> x <= b) /\ (!b'. b' < b ==> (?x. x IN s /\ b' < x)) ==> sup s = b SUP = |- !s. ~(s = {}) /\ (?b. !x. x IN s ==> x <= b) ==> (!x. x IN s ==> x <= sup s) /\ (!b. (!x. x IN s ==> x <= b) ==> sup s <= b) SUP_FINITE = |- !s. FINITE s /\ ~(s = {}) ==> sup s IN s /\ (!x. x IN s ==> x <= sup s) SUP_FINITE_LEMMA = |- !s. FINITE s /\ ~(s = {}) ==> (?b. b IN s /\ (!x. x IN s ==> x <= b)) SUP_INSERT_FINITE = |- !x s. FINITE s ==> sup (x INSERT s) = (if s = {} then x else max x (sup s)) SUP_UNIQUE_FINITE = |- !s. FINITE s /\ ~(s = {}) ==> (sup s = a <=> a IN s /\ (!y. y IN s ==> y <= a)) Thu 1st Dec 2011 real.ml Moved three basic Archimedian properties back to here from Multivariate/misc.ml: REAL_ARCH_SIMPLE = |- !x. ?n. x <= &n REAL_ARCH_LT = |- !x. ?n. x < &n REAL_ARCH = |- !x. &0 < x ==> (!y. ?n. y < &n * x) Thu 1st Dec 2011 list.ml Added EL_MAP = |- !f n l. n < LENGTH l ==> EL n (MAP f l) = f (EL n l) Mon 21st Nov 2011 iterate.ml Added a few lemmas about the behaviour of real polynomial functions, since these are quite often useful: REAL_SUB_POLYFUN = |- !a x y n. 1 <= n ==> sum(0..n) (\i. a i * x pow i) - sum(0..n) (\i. a i * y pow i) = (x - y) * sum(0..n - 1) (\j. sum(j + 1..n) (\i. a i * y pow (i - j - 1)) * x pow j) REAL_SUB_POLYFUN_ALT = |- !a x y n. 1 <= n ==> sum(0..n) (\i. a i * x pow i) - sum(0..n) (\i. a i * y pow i) = (x - y) * sum(0..n - 1) (\j. sum(0..n - j - 1) (\k. a (j + k + 1) * y pow k) * x pow j) REAL_POLYFUN_ROOTBOUND = |- !n c. ~(!i. i IN 0..n ==> c i = &0) ==> FINITE {x | sum(0..n) (\i. c i * x pow i) = &0} /\ CARD {x | sum(0..n) (\i. c i * x pow i) = &0} <= n REAL_POLYFUN_FINITE_ROOTS = |- !n c. FINITE {x | sum(0..n) (\i. c i * x pow i) = &0} <=> (?i. i IN 0..n /\ ~(c i = &0)) REAL_POLYFUN_EQ_0 = |- !n c. (!x. sum(0..n) (\i. c i * x pow i) = &0) <=> (!i. i IN 0..n ==> c i = &0) REAL_POLYFUN_EQ_CONST = |- !n c k. (!x. sum(0..n) (\i. c i * x pow i) = k) <=> c 0 = k /\ (!i. i IN 1..n ==> c i = &0) Thu 3rd Nov 2011 arith.ml Added another somewhat intricate DIV/MOD theorem: MOD_MOD_EXP_MIN = |- !x p m n. ~(p = 0) ==> x MOD p EXP m MOD p EXP n = x MOD p EXP MIN m n Tue 1st Nov 2011 arith.ml Added the following, a natural counterpart to MOD_MULT_ADD: DIV_MULT_ADD = |- !a b n. ~(n = 0) ==> (a * n + b) DIV n = a + b DIV n Thu 20th Oct 2011 hol.ml, class.ml, nums.ml, arith.ml, recursion.ml, pair.ml Based on an idea discussed with Mark Adams, changed "new_specification" to exploit dummy quantifiers and numeral tags to avoid provable equalities between different constants introduced with new_specification based on the same (or a provably equivalent) existence theorem. Since this requires the existence of numerals, quite a bit of build order reshuffling was necessary, and two former uses of new_specification (IND_SUC/IND_0 and BIT0_DEF) are now done "manually". Fri 7th Oct 2011 Makefile Made a fix to the Makefile from Ramana Kumar on the hol-light page (see issue 2). This uses the file pa_j_3.1x_6.02.2.ml for version 6.03 of OCaml as well. I just tried it with Ocaml 3.12.1 and camlp5 6.02.3, and it seems to work fine. Mon 29th Aug 2011 calc_rat.ml Changed REAL_RAT_DIV_CONV not to fail if it is given a canonical rational; instead used CHANGED_CONV in the depth conversion in REAL_RAT_REDUCE_CONV. This is consistent with the use of REAL_RAT_NEG_CONV, makes REAL_RAT_DIV_CONV a more convenient building block, and agrees with the current documentation. Wed 24th Aug 2011 real.ml, int.ml Added theorems about the real and integer sign function: REAL_SGN_CASES = |- !x. real_sgn x = &0 \/ real_sgn x = &1 \/ real_sgn x = -- &1 REAL_SGN_EQ = |- (!x. real_sgn x = &0 <=> x = &0) /\ (!x. real_sgn x = &1 <=> x > &0) /\ (!x. real_sgn x = -- &1 <=> x < &0) with INT_SGN_CASES and INT_SGN_EQ being the same for integers. Wed 24th Aug 2011 sets.ml Added two natural theorems about intersections of unions INTERS_UNION = |- !s t. INTERS (s UNION t) = INTERS s INTER INTERS t INTERS_OVER_UNIONS = |- !f s. INTERS {UNIONS (f x) | x IN s} = UNIONS {INTERS {g x | x IN s} | g | !x. x IN s ==> g x IN f x} Thu 18th Aug 2011 100/inclusion_exclusion.ml Added versions of inclusion-exclusion for additive real functions (INCLUSION_EXCLUSION_REAL_RESTRICTED_INDEXED, INCLUSION_EXCLUSION_REAL_RESTRICTED, INCLUSION_EXCLUSION_REAL_INDEXED and INCLUSION_EXCLUSION_REAL), deriving the cardinality version from those. Renamed the old INCLUSION_EXCLUSION_REAL as INCLUSION_EXCLUSION_REAL_FUNCTION and commented it out together with its dependency on Library/products.ml Sun 31st Jul 2011 IsabelleLight/* [new files] Installed "Isabelle Light" from Petros Papapanagiotou and Jacques Fleuriot, which consists of implementations of Isabelle-style tactics and other user-friendly shortcuts. Sun 10th Jul 2011 100/fourier.ml [new file] Added a file with some material on L_p spaces and Fourier series. Tue 28th Jun 2011 pair.ml, parser.ml Fixed a LET_TAC bug pointed out by Vu Khac Ky: failures were occurring if the same variable was used on the left and right of a pattern (except if they are a trivial let, i.e. corresponding lefts and rights exactly equal), e.g. g `v IN V DIFF (let k,ul = (P:num#(real^3)list->num#(real^3)list) (k,ul) in (Q:num#(real^3)list->real^3->bool) (k,ul)) ==> F`;; e LET_TAC;; Now the abbreviating variables are renamed as necessary to avoid clashes with free variables of the goal or each other (some of this would previously happen later in the ABBREV_TAC step anyway in some cases, but not this one). Looking at such corner cases made me add a parsing warning if there are multiple uses of the same variable in different arms of a simultaneous let binding, e.g. `let x = 1 and x = 2 in x = 42`, in which case the first one is hidden. Thu 9th Jun 2011 realarith.ml Made a change in the variable-choosing heuristic in Fourier-Motzkin, motivated by the disastrous slowness of this trivial example: time REAL_ARITH `c < e / &3 /\ i1 < e / &12 /\ i3 < e / &12 /\ i2 < e / &12 /\ i4 < e / &12 ==> (i1 + i2) + (c + i3 + i4) <= &2 * e / &3`;; The previous heuristic chose a variable that minimized the number of inequalities after elimination, which is p * n + z where p, n and z are the number of current inequalities where that variable occurs positively, negatively and not at all respectively. The downside is that it doesn't take any account of the complexity of the resulting inequalities, so in a prototypical example like the above x1 < e /\ .... /\ xn < e ==> x1 + ... + xn < n * e all variables give equal blowup of n, and so e may get chosen from among the available alternatives. That's something of a disaster since from that point on you get doubly exponential blowup per stage. The new heuristic is simply p * n, counting the number of new inequalities created by the elimination step. It makes this sort of example, which is probably pretty common, dramatically better. It also seems to lead to a small but notable average speedup. Mon 23rd May 2011 Library/floor.ml, Library/sets.ml Added COUNTABLE_RESTRICT = |- !s P. COUNTABLE s ==> COUNTABLE {x | x IN s /\ P x} RATIONAL_APPROXIMATION_STRADDLE = |- !x e. &0 < e ==> ?a b. rational a /\ rational b /\ a < x /\ x < b /\ abs(b - a) < e Sun 22nd May 2011 sets.ml Added the following duality for unions and intersections: DIFF_INTERS = |- !u s. u DIFF INTERS s = UNIONS {u DIFF t | t IN s} INTERS_UNIONS = |- !s. INTERS s = UNIV DIFF (UNIONS {UNIV DIFF t | t IN s}) UNIONS_INTERS = |- !s. UNIONS s = UNIV DIFF (INTERS {UNIV DIFF t | t IN s}) Thu 12th May 2011 Library/floor.ml FRAC_UNIQUE = |- !x a. integer(x - a) /\ &0 <= a /\ a < &1 <=> frac x = a REAL_FRAC_EQ = |- !x. frac x = x <=> &0 <= x /\ x < &1 Tue 5th Apr 2011 Library/floor.ml REAL_FLOOR_LE = |- !x n. integer n ==> (floor x <= n <=> x - &1 < n) HAS_SIZE_INTSEG_INT = |- !a b. integer a /\ integer b ==> {x | integer x /\ a <= x /\ x <= b} HAS_SIZE (if b < a then 0 else num_of_int(int_of_real(b - a + &1))) CARD_INTSEG_INT = |- !a b. integer a /\ integer b ==> CARD {x | integer x /\ a <= x /\ x <= b} = (if b < a then 0 else num_of_int(int_of_real(b - a + &1))) REAL_CARD_INTSEG_INT = |- !a b. integer a /\ integer b ==> &(CARD {x | integer x /\ a <= x /\ x <= b}) = (if b < a then &0 else b - a + &1) Tue 5th Apr 2011 sets.ml Added POWERSET_CLAUSES = |- {s | s SUBSET {}} = {{}} /\ (!a t. {s | s SUBSET a INSERT t} = {s | s SUBSET t} UNION IMAGE (\s. a INSERT s) {s | s SUBSET t}) Fri 1st Apr 2011 Makefile, pa_j_3.1x_6.02.2.ml [new file] Once again there is an incompatibility with the latest version of camlp5, this time 6.02.2, as was reported by Kevin S. Van Horn. Made yet another appropriate version of pa_j.ml, and put another case split in the Makefile. Fri 1st Apr 2011 Minisat/minisat_parse.ml Rewrote readTrace_aux in a slightly different style, avoiding wrapping an exception handler round the recursive calls, since this had the effect of making it not be tail-recursive. Thu 31st Mar 2011 sets.ml Added the following IMAGE_INJECTIVE_IMAGE_OF_SUBSET = |- !f s. ?t. t SUBSET s /\ IMAGE f s = IMAGE f t /\ (!x y. x IN t /\ y IN t /\ f x = f y ==> x = y) Tue 22nd Mar 2011 sets.ml Added the following, a natural dual of EXISTS_SUBSET_IMAGE: FORALL_SUBSET_IMAGE = |- !P f s. (!t. t SUBSET IMAGE f s ==> P t) <=> (!t. t SUBSET s ==> P (IMAGE f t)) Tue 15th Mar 2011 fusion.ml Made a small but significant change to the kernel, based on an observation by Ondrej Kuncar, optimizing the pointer-EQ shortcut in "orda" so that it does not require an empty environment but merely one full of identical pairs. This can substantially speed up many derived rules by allowing efficient use of proformas even inside bound variables. Sat 5th Mar 2011 bool.ml Noticed that GEN is not constant-time, which is bad. On closer inspection the problem was that the abstraction that's used to instantiate the proforma is created separately from the abstracted input theorem, so the pointer-EQ subterms are hidden under an abstraction. As well as fixing that, made it more efficient in two other ways: used EQ_MP instead of PROVE_HYP, and added partial evaluation based on the first argument. Fri 25th Feb 2011 Library/poly.ml Fixed an error where override_interface was used for "divides", hiding all the other desired overloadings. Also added many new polynomial theorems from Jesse Bingham's e-transcendence proof: HD_POLY_ADD HD_POLY_CMUL HD_POLY_EXP HD_POLY_EXP_X_SUC HD_POLY_MUL HD_POLY_MUL_X ITERATE_RADD_POLYADD MONOIDAL_POLY_ADD NOT_POLY_CMUL_NIL NOT_POLY_EXP_NIL NOT_POLY_EXP_X_NIL NOT_POLY_MUL_NIL POLYDIFF_ADD POLY_ADD_ASSOC POLY_ADD_IDENT POLY_ADD_LENGTH POLY_ADD_NEUTRAL POLY_ADD_SYM POLY_CMUL_LENGTH POLY_CMUL_LID POLY_CMUL_POLY_DIFF POLY_DIFF_AUX_ADD_LEMMA POLY_DIFF_AUX_POLY_CMUL POLY_EXP_X_LENGTH POLY_EXP_X_REC POLY_MUL_LENGTH POLY_MUL_LENGTH2 POLY_MUL_LID POLY_MUL_RID POLY_SUM_EQUIV TL_POLY_CMUL TL_POLY_EXP_X_SUC TL_POLY_MUL_X Fri 25th Feb 2011 fusion.ml, ind_defs.ml, simp.ml, define.ml, Library/analysis.ml, Library/transc.ml Removed a few unused variables in these files, after noticing OCaml warnings about them. It makes things minutely smaller and faster, I suppose. Tue 22nd Feb 2011 lists.ml Added two additional list lemmas taken from Jesse Bingham's e-transcendence proof, which seem to be quite generally useful. ALL_EL = |- !P l. (!i. i < LENGTH l ==> P (EL i l)) <=> ALL P l CONS_HD_TL = |- !l. ~(l = []) ==> l = CONS (HD l) (TL l) Thu 17th Feb 2011 Examples/sos.ml Renamed a few of the ML operations on vectors since the existing names can lead to annoying name clashes with the names of theorems in the Multivariate/vectors.ml theories. vector_0 -> vec_0 dim -> vec_dim vector_const -> vec_const vector_1 -> vec_1 vector_cmul -> vec_cmul vector_neg -> vec_neg vector_add -> vec_add vector_sub -> vec_sub vector_dot -> vec_dot vector_of_list -> vec_of_list Of course, it is arguable that all this should be hidden anyway, but since this file is still somewhat experimental I don't want to tidy up and modularize the namespace just yet. Mon 14th Feb 2011 int.ml, Library/floor.ml Removed the constant "is_int" and replaced it with "integer", moving the definition of that back from the "Library/floor.ml" file to the "int.ml" file. Kept the theorem "is_int" for compatibility, with just the different constant, and removed the now redundant/meaningless INTEGER_IS_INT. Tue 8th Feb 2011 Makefile, pa_j_3.1x_6.02.1.ml [new file] Added (directly from Ondrej Kuncar) an updated version of pa_j for the latest sub-version of camlp5, and modified the Makefile to use it as needed (though this selection logic is starting to get ugly). Tue 21st Dec 2010 real.ml, database.ml Added a lemma from Valentina Bruno used in the Multivariate complex analysis theories, plus other variants. REAL_LT_LINV = |- !x y. &0 < y /\ inv y < x ==> inv x < y REAL_LT_RINV = |- !x y. &0 < x /\ x < inv y ==> y < inv x REAL_LE_LINV = |- !x y. &0 < y /\ inv y <= x ==> inv x <= y REAL_LE_RINV = |- !x y. &0 < x /\ x <= inv y ==> y <= inv x Wed 15th Dec 2010 system.ml At the suggestion of Ondrej Kuncar, switched from fun set_jrh_lexer -> set_jrh_lexer;; to just set_jrh_lexer;; This magic variable gets mapped to a constant anyway, so there is no need for this elaborate expression, which moreover generates a warning about a non-exhaustive match. Mon 13th Dec 2010 sets.ml Added SET_PAIR_THM = |- !P. {p | P p} = {a,b | P (a,b)} Thu 2nd Dec 2010 Makefile, Proofrecording/hol_light/Makefile, pa_j_3.1x_5.xx.ml [new file], pa_j_3.1x_6.xx.ml [new file], pa_j_3.10.ml [deleted], pa_j_3.11.ml [deleted] Ondrej Kuncar pointed out that the system doesn't build with the new camlp5 6.0. So now for OCaml >= 3.10 I need to start distinguishing only based on the camlp5 version. Modified the Makefile accordingly, making the two current versions for < 6.0 and >= 6.0 of camlp5 called pa_j_3.1x_5.xx.ml (what used to be pa_j_3.10.ml and pa_j_3.11.ml) and pa_j_3.1x_6.xx.ml (a new one derived by modifying the source to camlp5 6.02.0). Thu 18th Nov 2010 real.ml Finally added the theorem REAL_LE_POW_2 = |- !x. &0 <= x pow 2. Even though REAL_LE_SQUARE is close, it's nice not to have to make trivial rewrites back and forth just to use it. Thu 28th Oct 2010 Library/rstc.ml Noticed that the theorems RTC_INDUCT_L and RTC_INDUCT_R both had the hypothesis (!x y. R x y ==> P x y), which is redundant since it follows from the other two. So I just removed it; as far as I can see there are no proof changes needed. Thu 28th Oct 2010 arith.ml, passim Joe Hurd pointed out that EQ_SUC proved in arith.ml was just a duplicate of the theorem SUC_INJ from nums.ml, so I removed its proof and replaced EQ_SUC by SUC_INJ everywhere it was used. Fri 8th Oct 2010 README Updated the README file with a few modernizations, in particular a more careful discussion of checkpointing options in the light of the fact that it seems hard to get ckpt working on recent Linuxes. Fri 8th Oct 2010 theorems.ml Joe Hurd pointed out that EQ_REFL_T is a duplicate of REFL_CLAUSE, so I removed EQ_REFL_T. Fri 8th Oct 2010 Makefile, hol.ml There was a problem pointed out by Anthony V. Pulido with OCaml 3.12 because a couple of tests had equality tests for 3.10 or 3.11. Replaced this with a simple test of the first digit after the decimal point of the OCaml version in the Makefile and a string inequality comparison in "hol.ml". Wed 9th Jun 2010 nums.ml, arith.ml Made some changes suggested by Joe Hurd to allow cleaner separation into theories by avoiding the use of addition when defining the numeral constants BIT0 and BIT1. Now those are defined directly using primitive recursion (BIT0_DEF and BIT1_DEF) and the former definitions BIT0 and BIT1 are derived from those later. Wed 24th Mar 2010 nums.ml, 100/four_squares.ml, 100/ramsey.ml, Complex/complexnumbers.ml, Examples/mccarthy.ml, Examples/multiwf.ml, Mizarlight/duality_holby.ml, Model/modelset.ml, Multivariate/clifford.ml, Multivariate/topology.ml, Rqe/asym.ml, Rqe/examples.ml, Rqe/rol.ml Made changes essentially corresponding to the steps of hol-online's "hol-preparse-patch", fixing some bugs, removing redundant material and regularizing some syntax: * Replaced a = by <=> in "100/four_squares.ml" (I'd left this out of my test suite, which is why it hadn't been spotted before). * Added a couple of missing real numeral coercions "&" in "Rqe/examples.ml". * Removed duplicate definition for degree in "Rqe/asym.ml" (it's already defined in "Library/poly.ml"). * Removed terms with antiquotation, an unused relic from HOL88 in "100/ramsey.ml". * Avoided programmatically created terms in "Examples/mccarthy.ml", "Mizarlight/duality_holby.ml" and "Rqe/rol.ml". * Added IND_SUC_SPEC to regularize new_specification syntax in "nums.ml" * Stylistic change to type definition in "Complex/complexnumbers.ml", "Examples/multiwf.ml", "Mizarlight/duality_holby.ml", "Model/modelset.ml", "Multivariate/clifford.ml", "Multivariate/topology.ml". Tue 23rd Mar 2010 lists.ml Added several miscellaneous lemmas about lists: LENGTH_TL = |- !l. ~(l = []) ==> LENGTH (TL l) = LENGTH l - 1 EL_APPEND = |- !k l m. EL k (APPEND l m) = (if k < LENGTH l then EL k l else EL (k - LENGTH l) m) EL_TL = |- !n. EL n (TL l) = EL (n + 1) l EL_CONS = |- !n h t. EL n (CONS h t) = (if n = 0 then h else EL (n - 1) t) LAST_EL = |- !l. ~(l = []) ==> LAST l = EL (LENGTH l - 1) l HD_APPEND = |- !l m. HD (APPEND l m) = (if l = [] then HD m else HD l) Tue 23rd Mar 2010 sets.ml Added SET_OF_LIST_EQ_EMPTY = |- !l. set_of_list l = {} <=> l = [] Mon 22nd Mar 2010 lists.ml Added one more simple list lemma: LAST_APPEND = |- !p q. LAST(APPEND p q) = (if q = [] then LAST p else LAST q) Sat 20th Mar 2010 lists.ml, Rqe/work_thms.ml Moved the definition of BUTLAST from Rqe into the core, and added one trivial theorem about it: BUTLAST = |- BUTLAST [] = [] /\ BUTLAST (CONS h t) = (if t = [] then [] else CONS h (BUTLAST t)) APPEND_BUTLAST_LAST = |- !l. ~(l = []) ==> APPEND (BUTLAST l) [LAST l] = l Fri 12th Mar 2010 sets.ml Added CHOOSE_SUBSET_STRONG = |- !n s. (FINITE s ==> n <= CARD s) ==> (?t. t SUBSET s /\ t HAS_SIZE n) Thu 11th Mar 2010 ints.ml Made a further small stylistic change following hol-online to make the integer type bijection at the top level instead of hiding it. This introduces a new theorem int_tybij. Tue 9th Mar 2010 lists.ml Added a couple of trivial lemmas about MAP: MAP_ID = |- !l. MAP (\x. x) l = l MAP_I = |- MAP I = I Mon 8th Mar 2010 bool.ml, ind_types.ml, cart.ml, int.ml, realax.ml Made minor stylistic changes following hol-online. These essentially make it easier to recognize parsing directives and definitions. Mon 8th Mar 2010 Proofrecording/diffs/basics.ml [new file] Chantal Keller pointed out that the "needs" directive is wrong in the proof-recording version where separate type, term and theorem files are used in place of fusion. Fixed this by putting the version of basics.ml without the "needs" line in the diffs directory. Sun 7th Mar 2010 passim Moved more hol-online changes upstream, adding explicit "needs" directives to the core files in the toplevel directory. Also modified the "make_database_assignment" function in "update_database.ml" so that it adds such a directive at the top of any file it creates. Sat 6th Mar 2010 Examples/vitali.ml [new file] Added a simple example, the existence of a non-measurable set. Since it doesn't seem likely to be useful for anything, I didn't put it in the Multivariate measure theory itself. Tue 2nd Mar 2010 class.ml Jeremy Bem had pointed out that TAUT has an implicit dependency on the current default rewrites because of the embedded REWRITE_TAC[]. This can make it do more than it should if the rewrites are expanded, or stop working if they are contracted. Fixed this by partially evaluating the REWRITE_TAC[] in the definition, though this means defining it twice in class.ml, once as a sort of bootstrapping version without the COND rewrites, and one after. Mon 1st Mar 2010 update_database.ml Added alphabetic sorting of the results to the "search" function. Note that the reference variable "theorems" itself is not sorted, but sorting is imposed afterwards on the filtered results (likewise in "make_database_assignment"). Thu 25th Feb 2010 real.ml, int.ml Added the definitions of the real and integer signum function. I was tempted to add the interface "sgn" for both of them, but perhaps one doesn't want to be deprived of that as a variable name. New theorems (and of course INT_OF_REAL_THM is updated): real_sgn REAL_ABS_SGN REAL_SGN REAL_SGN_0 REAL_SGN_ABS REAL_SGN_DIV REAL_SGN_INV REAL_SGN_MUL REAL_SGN_NEG int_sgn int_sgn_th INT_ABS_SGN INT_SGN INT_SGN_0 INT_SGN_ABS INT_SGN_MUL INT_SGN_NEG Thu 25th Feb 2010 Examples/sos.ml Replaced a couple of explicit uses of the Empty constructor for finite partial functions by "undefined" and "is_undefined". This was causing a clash with the Empty constructor for the tbl type in the new update_database.ml, and avoiding the constructors is good practice anyway (maybe I should make it an abstract type). Wed 24th Feb 2010 basics.ml Tweaked "subst" to filter out trivial substitutions from the instantiation list first. This is a small thing but was actually ultimately responsible for some extreme slowness of UNWIND_CONV on very large terms owing to the underlying REWR_CONV SWAP_EXISTS_THM. For example defining the following let test n = let t = `m < n + 1` in let tm = funpow n (fun x -> mk_conj(x,t)) t in let et = list_mk_exists([`m:num`;`n:num`],tm) in time (REWR_CONV SWAP_EXISTS_THM) et; 1;; then "test 100000" used to take 9.5 seconds, and now takes 0.5. There are still some wasteful things going, so it might be worth explicitly optimizing UNWIND_CONV, but this is much better than before and might have beneficial effects elsewhere too. Fri 19th Feb 2010 update_database.ml, Examples/update_database.ml [new file] Moved the old update_database.ml script back into Examples and installed instead the somewhat nicer one from Roland Zumkeller, which doesn't rely on the OCaml sources. Fri 19th Feb 2010 sets.ml Added some theorems showing that surjectivity is exactly equivalent to inserting the function in universal and existential quantifiers and gives rise to a related property for set comprehensions: SURJECTIVE_FORALL_THM = |- !f. (!y. ?x. f x = y) <=> (!P. (!x. P (f x)) <=> (!y. P y)) SURJECTIVE_EXISTS_THM = |- !f. (!y. ?x. f x = y) <=> (!P. (?x. P (f x)) <=> (?y. P y)) SURJECTIVE_IMAGE_THM = |- !f. (!y. ?x. f x = y) <=> (!P. IMAGE f {x | P (f x)} = {x | P x}) Fri 19th Feb 2010 lists.ml Added one trivial lemma and a couple of theorems showing that injectivity and surjectivity are preserved by the MAP construct: MAP_EQ_NIL = |- !f l. MAP f l = [] <=> l = [] INJECTIVE_MAP = |- !f. (!l m. MAP f l = MAP f m ==> l = m) <=> (!x y. f x = f y ==> x = y) SURJECTIVE_MAP = |- !f. (!m. ?l. MAP f l = m) <=> (!y. ?x. f x = y) Tue 16th Feb 2010 Proofrecording/README Proofrecording/diffs/equal.ml, Proofrecording/diffs/hol.ml, Proofrecording/diffs/proofobjects_dummy.ml, Proofrecording/diffs/proofobjects_init.ml, Proofrecording/diffs/proofobjects_trt.ml, Proofrecording/hol_light/Makefile, Proofrecording/diffs/depgraph.ml [new file], Proofrecording/diffs/proofobjects_coq.ml [new file] Installed several updates from Chantal Keller to the proof-recording infrastructure, slightly tweaked and merged with my latest updates. This fixes a few incompatibilities and also extends the proof-recording infrastructure to produce Coq proofs (set HOLPROOFOBJECTS=COQ). The new code uses the ocamlgraph library, so there is a new entry "top" in the Makefile to make it. ********************** FIRST GOOGLE CODE VERSION ********************** Fri 12th Feb 2010 passim Moved many of the files from Examples into a new Library directory, and changed the names of various others, to support easier native-code compilation. Most of these changes are again modelled on Jeremy Bem's hol1process.sh file, though a few of the new names are different. The basic idea is to make the names of files distinct from each other and give rise to valid module names that are distinct from built-in OCaml modules, while moreover avoiding directory dependencies (e.g. between files in Examples and Multivariate). Here's a complete list of the changes: ind-defs.ml -> ind_defs.ml ind-types.ml -> ind_types.ml iter.ml -> iterate.ml list.ml -> lists.ml num.ml -> nums.ml sys.ml -> system.ml 100/2squares.ml -> 100/two_squares.ml 100/4squares.ml -> 100/four_squares.ml 100/agm.ml -> 100/arithmetic_geometric_mean.ml Complex/complex.ml -> Complex/complexnumbers.ml Complex/grobner.ml -> Complex/complex_grobner.ml Complex/real.ml -> Complex/complex_real.ml Complex/transc.ml -> Complex/complex_transc.ml Examples/agm.ml -> Library/agm.ml Examples/analysis.ml -> Library/analysis.ml Examples/binary.ml -> Library/binary.ml Examples/binomial.ml -> Library/binomial.ml Examples/calc_real.ml -> Library/calc_real.ml Examples/card.ml -> Library/card.ml Examples/floor.ml -> Library/floor.ml Examples/integer.ml -> Library/integer.ml Examples/isum.ml -> Library/isum.ml Examples/iter.ml -> Library/iter.ml Examples/lagrange.ml -> Examples/lagrange_lemma.ml Examples/multiplicative.ml -> Library/multiplicative.ml Examples/permutations.ml -> Library/permutations.ml Examples/pocklington.ml -> Library/pocklington.ml Examples/poly.ml -> Library/poly.ml Examples/pratt.ml -> Library/pratt.ml Examples/prime.ml -> Library/prime.ml Examples/primitive.ml -> Library/primitive.ml Examples/products.ml -> Library/products.ml Examples/rstc.ml -> Library/rstc.ml Examples/transc.ml -> Library/transc.ml Examples/update_database.ml -> update_database.ml Examples/wo.ml -> Library/wo.ml Jordan/num_calc_simp.ml -> Rqe/num_calc_simp.ml Minisat/SatSolvers.ml -> Minisat/sat_solvers.ml Minisat/dimacsTools.ml -> Minisat/dimacs_tools.ml Minisat/minisatParse.ml -> Minisat/minisat_parse.ml Minisat/minisatProve.ml -> Minisat/minisat_prove.ml Minisat/minisatResolve.ml -> Minisat/minisat_resolve.ml Minisat/satCommonTools.ml -> Minisat/sat_common_tools.ml Minisat/satScript.ml -> Minisat/sat_script.ml Minisat/satTools.ml -> Minisat/sat_tools.ml Model/set.ml -> Model/modelset.ml Multivariate/analysis.ml -> Multivariate/derivatives.ml Multivariate/complex.ml -> Multivariate/complexes.ml Multivariate/real.ml -> Multivariate/realanalysis.ml Multivariate/transc.ml -> Multivariate/transcendentals.ml Rqe/lib.ml -> Rqe/rqe_lib.ml Rqe/list.ml -> Rqe/rqe_list.ml Rqe/main.ml -> Rqe/rqe_main.ml Rqe/num.ml -> Rqe/rqe_num.ml Rqe/real.ml -> Rqe/rqe_real.ml Rqe/tactics-ext.ml -> Rqe/rqe_tactics_ext.ml Fri 12th Feb 2010 Examples/sos.ml, Minisat/minisatParse.ml, Rqe/main.ml, Rqe/matinsert.ml, Unity/mk_unless.ml Made some small changes based on the hol1process.sh file in Jeremy Bem's hol-online, mainly connected with eliminating unused state or dead code. Also removed the following files that are not runnable as they stand and were probably not intended to be in the final version: Complex/maple.ml Complex/geom.ml Boyer_Moore/induct_then.ml Boyer_Moore/testset/eval.ml Mon 25th Jan 2010 sets.ml Added the following, which is really just plugging two existing results together, but in a way that's not completely trivial for the built-in automation: HAS_SIZE_IMAGE_INJ_EQ = |- !f s n. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (IMAGE f s HAS_SIZE n <=> s HAS_SIZE n) Tue 12th Jan 2010 sets.ml Added some trivial but useful theorems about infiniteness of various real intervals. FINITE_REAL_INTERVAL = |- (!a. ~FINITE {x | a < x}) /\ (!a. ~FINITE {x | a <= x}) /\ (!b. ~FINITE {x | x < b}) /\ (!b. ~FINITE {x | x <= b}) /\ (!a b. FINITE {x | a < x /\ x < b} <=> b <= a) /\ (!a b. FINITE {x | a <= x /\ x < b} <=> b <= a) /\ (!a b. FINITE {x | a < x /\ x <= b} <=> b <= a) /\ (!a b. FINITE {x | a <= x /\ x <= b} <=> b <= a) as well as the trivial consequence real_INFINITE = |- INFINITE(:real) Fri 8th Jan 2010 pair.ml When rerunning some files I noticed a subtle issue in the benignity checking of definitions: when recreating the desired definition from the old one, it is only quantified over the explicitly quantified variables in the input term. Changed this to finally generalize afterwards over all the (remaining) free variables, which makes it completely identical with the theorem returned by the original invocation of the same definition. Fri 8th Jan 2010 sets.ml, passim Modified SET_TAC so that it throws away the assumption list. Until recently I had been under the impression that this was the actual behaviour, and was using ASM SET_TAC explicitly when I wanted the assumptions included. Needless to say, there were a few places where I'd relied on the old behaviour, so I changed SET_TAC to ASM SET_TAC in those places. Fri 8th Jan 2010 parser.ml Added an additional clause to the toplevel function "parse_preterm" so that it accepts an identifier (i.e. anything except a reserved word) as the entire string to be parsed. This was mainly intended as a convenience for the search function, so that one can do, say search [`UNION`];; instead of the slightly longer-to-type search [`(UNION)`];; Mon 28th Dec 2009 sets.ml Added a few theorems about injectivity and surjectivity of the image under a map: INJECTIVE_ON_IMAGE = |- !f u. (!s t. s SUBSET u /\ t SUBSET u /\ IMAGE f s = IMAGE f t ==> s = t) <=> (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) INJECTIVE_IMAGE = |- !f. (!s t. IMAGE f s = IMAGE f t ==> s = t) <=> (!x y. f x = f y ==> x = y) SURJECTIVE_ON_IMAGE = |- !f u v. (!t. t SUBSET v ==> (?s. s SUBSET u /\ IMAGE f s = t)) <=> (!y. y IN v ==> (?x. x IN u /\ f x = y)) SURJECTIVE_IMAGE = |- !f. (!t. ?s. IMAGE f s = t) <=> (!y. ?x. f x = y) Sun 27th Dec 2009 sets.ml Added FINITE_HAS_SIZE = |- !s. FINITE s <=> s HAS_SIZE CARD s and generalized the theorem FINITE_PRODUCT_DEPENDENT from pairs to the application of any function: FINITE_PRODUCT_DEPENDENT = |- !f s t. FINITE s /\ (!x. x IN s ==> FINITE (t x)) ==> FINITE {f x y | x IN s /\ y IN t x} Fri 20th Nov 2009 sets.ml Noticed that FINITE_UNIONS could be stronger (funny that I only just noticed this). Changed the name of the former FINITE_UNIONS to FINITE_FINITE_UNIONS and made FINITE_UNIONS the stronger theorem. I hope that most proofs will not break after this change because it's usually used with SIMP_TAC. FINITE_FINITE_UNIONS = |- !s. FINITE s ==> (FINITE (UNIONS s) <=> (!t. t IN s ==> FINITE t)) FINITE_UNIONS = |- !s. FINITE (UNIONS s) <=> FINITE s /\ (!t. t IN s ==> FINITE t) Fri 20th Nov 2009 Examples/floor.ml Added RATIONAL_ALT for use in some places where I'd used that as an adhoc definition (100/constructible.ml and 100/liouville.ml). RATIONAL_ALT = |- !x. rational x <=> (?p q. ~(q = 0) /\ abs x = &p / &q) Tue 17th Nov 2009 Examples/floor.ml Added a definition of "rational" and closure theorems, corresponding as appropriate to those for "integer". Mon 16th Nov 2009 real.ml Added a suite of theorems to complement REAL_POW_LE2_ODD (which is still there but with a simpler proof, the complicated one now reserved for REAL_POW_LT2_ODD). REAL_POW_LT2_ODD = |- !n x y. x < y /\ ODD n ==> x pow n < y pow n REAL_POW_LT2_ODD_EQ = |- !n x y. ODD n ==> (x pow n < y pow n <=> x < y) REAL_POW_LE2_ODD_EQ = |- !n x y. ODD n ==> (x pow n <= y pow n <=> x <= y) REAL_POW_EQ_ODD_EQ = |- !n x y. ODD n ==> (x pow n = y pow n <=> x = y) REAL_POW_EQ_ODD = |- !n x y. ODD n /\ x pow n = y pow n ==> x = y REAL_POW_EQ_EQ = |- !n x y. x pow n = y pow n <=> (if EVEN n then n = 0 \/ abs x = abs y else x = y) Wed 11th Nov 2009 sets.ml Added PAIRWISE_MONO = |- !r s t. pairwise r s /\ t SUBSET s ==> pairwise r t Tue 3rd Nov 2009 Proofrecording/diffs/thm.ml Added a new version of thm.ml from Chantal Keller, which makes things basically compatible with the new core, though it's still implemented via separate type.ml, term.ml and thm.ml files instead of a single fusion.ml; at some point I should go through and make it all perfectly compatible. Wed 21st Oct 2009 Examples/primitive.ml [new file] Added a file giving the usual existence results for primitive roots. Mon 19th Oct 2009 theorems.ml Added universally quantified versions of unwinding theorems, since I often seem to use these and have to laboriously use SIMP_TAC[] then LEFT_FORALL_IMP_THM and EXISTS_REFL. FORALL_UNWIND_THM1 = |- !P a. (!x. a = x ==> P x) <=> P a FORALL_UNWIND_THM2 = |- !P a. (!x. x = a ==> P x) <=> P a Wed 14th Oct 2009 Examples/integer.ml Added a couple of theorems to help transfer solutions of congruences back to the natural numbers: INT_LINEAR_CONG_POS = |- !n a x. ~(n = &0) ==> (?y. &0 <= y /\ (a * x == a * y) (mod n)) INT_CONG_SOLVE_POS = |- !a b n. coprime (a,n) /\ ~(n = &0 /\ abs a = &1) ==> (?x. &0 <= x /\ (a * x == b) (mod n)) Tue 13th Oct 2009 int.ml Added outer quantifiers to these two theorems: INT_FORALL_POS = |- !P. (!n. P(&n)) <=> (!i. &0 <= i ==> P i) INT_EXISTS_POS = |- !P. (?n. P(&n)) <=> (?i. &0 <= i /\ P i) and added the following two analogous ones: INT_FORALL_ABS = |- !P. (!n. P(&n)) <=> (!x. P (abs x)) INT_EXISTS_ABS = |- !P. (?n. P(&n)) <=> (?x. P (abs x)) Tue 13th Oct 2009 Examples/pratt.ml, Examples/pocklington.ml Renamed PHI_PRIME to PHI_PRIME_EQ PHI_PRIME_EQ = |- !n. phi n = n - 1 /\ ~(n = 0) /\ ~(n = 1) <=> prime n and made PHI_PRIME the following: PHI_PRIME = |- !p. prime p ==> phi p = p - 1 Tue 13th Oct 2009 sets.ml Added the following, which is a bit more convenient than manually chaining two lemmas: CARD_SUBSET_IMAGE = |- !f s t. FINITE t /\ s SUBSET IMAGE f t ==> CARD s <= CARD t Tue 13th Oct 2009 Examples/update_database.ml Propagated an earlier fix from the "search" implementation in "help.ml", to ignore pure variables in patterns. Mon 12th Oct 2009 iter.ml Added the following about finiteness of integer segments; although trivial-looking it's actually quite a bit of work to derive from scratch: FINITE_INTSEG = |- (!l r. FINITE {x:int | l <= x /\ x <= r}) /\ (!l r. FINITE {x:int | l <= x /\ x < r}) /\ (!l r. FINITE {x:int | l < x /\ x <= r}) /\ (!l r. FINITE {x:int | l < x /\ x < r}) Thu 27th Aug 2009 sets.ml Added two more lemmas about subsets of images: EXISTS_SUBSET_IMAGE = |- !P f s. (?t. t SUBSET IMAGE f s /\ P t) <=> (?t. t SUBSET s /\ P (IMAGE f t)) EXISTS_FINITE_SUBSET_IMAGE = |- !P f s. (?t. FINITE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. FINITE t /\ t SUBSET s /\ P (IMAGE f t)) Sun 23rd Aug 2009 sets.ml Added CROSS_EQ_EMPTY = |- !s t. s CROSS t = {} <=> s = {} \/ t = {} Sat 22nd Aug 2009 iter.ml Added two general number-segment theorems for the general "iterate": ITERATE_CLAUSES_NUMSEG = |- !op. monoidal op ==> (!m. iterate op (m..0) f = (if m = 0 then f 0 else neutral op)) /\ (!m n. iterate op (m..SUC n) f = (if m <= SUC n then op (iterate op (m..n) f) (f (SUC n)) else iterate op (m..n) f)) ITERATE_PAIR = |- !op. monoidal op ==> (!f m n. iterate op (2 * m..2 * n + 1) f = iterate op (m..n) (\i. op (f (2 * i)) (f (2 * i + 1)))) and two instances of the latter: NSUM_PAIR = |- !f m n. nsum (2 * m..2 * n + 1) f = nsum (m..n) (\i. f (2 * i) + f (2 * i + 1)) SUM_PAIR = |- !f m n. sum (2 * m..2 * n + 1) f = sum (m..n) (\i. f (2 * i) + f (2 * i + 1)) Fri 21st Aug 2009 sets.ml Added the following for dealing with unions and intersections of images (explicit or implicit), which can otherwise be a bit tedious: UNIONS_IMAGE = |- !f s. UNIONS (IMAGE f s) = {y | ?x. x IN s /\ y IN f x} INTERS_IMAGE = |- !f s. INTERS (IMAGE f s) = {y | !x. x IN s ==> y IN f x} UNIONS_GSPEC = |- (!P f. UNIONS {f x | P x} = {a | ?x. P x /\ a IN f x}) /\ (!P f. UNIONS {f x y | P x y} = {a | ?x y. P x y /\ a IN f x y}) /\ (!P f. UNIONS {f x y z | P x y z} = {a | ?x y z. P x y z /\ a IN f x y z}) INTERS_GSPEC = |- (!P f. INTERS {f x | P x} = {a | !x. P x ==> a IN f x}) /\ (!P f. INTERS {f x y | P x y} = {a | !x y. P x y ==> a IN f x y}) /\ (!P f. INTERS {f x y z | P x y z} = {a | !x y z. P x y z ==> a IN f x y z}) Tue 18th Aug 2009 sets.ml Removed the theorem FINITE_SUBSETS, which is just a duplicate of FINITE_POWERSET. Mon 17th Aug 2009 sets.ml Added the following, which is somewhat trivial but quite laborious to derive: SET_PROVE_CASES = |- !P. P {} /\ (!a s. ~(a IN s) ==> P (a INSERT s)) ==> (!s. P s) Mon 10th Aug 2009 basics.ml Norbert Voelker pointed out that list_mk_icomb can give unexpected "capture" of type variables because of the iterative implementation instantiating part at a time using mk_icomb. For example list_mk_icomb "," [`b:B`;`c:C`];; formerly gave `(b:C,c:C)`. I changed to a different implementation that computes the type instantiation once and for all. Sat 8th Aug 2009 iter.ml Got rid of ITERATE_CLOSED_GEN and made simple ITERATE_CLOSED still stronger without any finiteness hypothesis: ITERATE_CLOSED = |- !op. monoidal op ==> (!P. P(neutral op) /\ (!x y. P x /\ P y ==> P(op x y)) ==> (!f s. (!x. x IN s /\ ~(f x = neutral op) ==> P(f x)) ==> P(iterate op s f))) Also added two special cases: NSUM_CLOSED = |- !P f s. P 0 /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!a. a IN s ==> P(f a)) ==> P(nsum s f) SUM_CLOSED = |- !P f s. P(&0) /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!a. a IN s ==> P(f a)) ==> P(sum s f) Sun 26th Jul 2009 class.ml Shortened the proof of EXCLUDED_MIDDLE using a method shown to me by Mark Adams, which uses a smaller and simpler select-term in the main step. Thu 23rd Jul 2009 hol.ml Roland Zumkeller pointed out to me that "fusion.ml" is loaded by #use, whereas it should be loads to be consistent with the others and make it work even when not in the current directory. Tue 21st Jul 2009 iter.ml Removed the unnecessary finiteness hypotheses from NSUM_RESTRICT_SET = |- !P s f. nsum {x | x IN s /\ P x} f = nsum s (\x. if P x then f x else 0) SUM_RESTRICT_SET = |- !P s f. sum {x | x IN s /\ P x} f = sum s (\x. if P x then f x else &0) Tue 21st Jul 2009 iter.ml Added another useful lemma for computing slightly tweaked sums: SUM_CASES_1 = |- !s a. FINITE s /\ a IN s ==> sum s (\x. if x = a then y else f x) = sum s f + y - f a Mon 20th Jul 2009 iter.ml Added the following; even though it's rarely needed the derivation is surprisingly painful: ITERATE_OP_GEN = |- !op. monoidal op ==> (!f g s. FINITE (support op f s) /\ FINITE (support op g s) ==> iterate op s (\x. op (f x) (g x)) = op (iterate op s f) (iterate op s g)) and then the two usual instances: NSUM_ADD_GEN = |- !f g s. FINITE {x | x IN s /\ ~(f x = 0)} /\ FINITE {x | x IN s /\ ~(g x = 0)} ==> nsum s (\x. f x + g x) = nsum s f + nsum s g SUM_ADD_GEN = |- !f g s. FINITE {x | x IN s /\ ~(f x = &0)} /\ FINITE {x | x IN s /\ ~(g x = &0)} ==> sum s (\x. f x + g x) = sum s f + sum s g Wed 8th Jul 2009 ind-defs.ml Added derive_strong_induction, which is pretty much the same thing as the function of that name in Tom Melham's original inductive definitions package. In fact, this was about the only significant respect in which my package was not a generalization of it. This was inspired by Sean McLaughlin's observation that the Coq inductive definitions package gives you this automatically, and it can be quite useful. Tue 7th Jul 2009 class.ml Freek and Cezary pointed out that I have duplicates of the two basic_rewrites |- ~T <=> F and |- ~F <=> T, because I add NOT_CLAUSES_WEAK and then later NOT_CLAUSES. Changed the latter to CONJUNCT1 NOT_CLAUSES. Mon 6th Jul 2009 pair.ml Added the following, for constructs that are otherwise painful: FORALL_PAIRED_THM = |- !P. (!(x,y). P x y) <=> (!x y. P x y) EXISTS_PAIRED_THM = |- !P. (?(x,y). P x y) <=> (?x y. P x y) FORALL_TRIPLED_THM = |- !P. (!(x,y,z). P x y z) <=> (!x y z. P x y z) EXISTS_TRIPLED_THM = |- !P. (?(x,y,z). P x y z) <=> (?x y z. P x y z) Also added outer quantifiers to FORALL_PAIR_THM, EXISTS_PAIR_THM and LAMBDA_PAIR_THM, also changing the variable from P to t in the last. Tue 30th Jun 2009 tactics.ml Dan Synek pointed out some issues over using REPEAT_GTCL on IMP_RES_THEN. I decided that things like this would work properly if IMP_RES_THEN checked its list of derived tactics to make sure it's nonempty, so that it will actually fail in such cases instead of running an empty tactic. So I made this change in ANTE_RES_THEN and IMP_RES_THEN. Tue 30th Jun 2009 hol.ml Sean McLaughlin pointed out that relocation of hol_dir also spoils the list of loaded files in "loaded_files", which uses absolute paths. I changed this so that the filenames just have the "basename", and it seems to work well. Sat 27th Jun 2009 make.ml Changed "checkpoint" to use the "-l" option to CryoPID, since it does seem to give at least some measure of portability in the resulting binaries, though problems over exceptions and general unpredictability remain. Sat 27th Jun 2009 hol.ml, help.ml Sean McLaughlin pointed out that the "help" function doesn't adjust dynamically to the change of !hol_dir, so I changed it to redo more stuff dynamically per argument. It also seemed worth making help_path an assignable reference variable so people can add more help entries (maybe indeed I should do this for some non-core extensions). I was now also dissatisfied that load_path needs changing separately. So I set up a scheme where a new function "hol_expand_directory" is applied dynamically to help_path and load_path, inside "help" and "file_on_path" (hence derivatives like "loadt"). It maps an initial $ into !hol_dir. Tue 16th Jun 2009 100/lagrange.ml [new file] Freek was asking me about Lagrange's theorem, and I realized I don't have it in the standard system anywhere (this and a few others oddments were in Work/group.ml). So I put it here. Tue 16th Jun 2009 help.ml Sean McLaughlin pointed out that the use of "cat" in the help system won't work on Windows unless you are inside Cygwin. It wasn't really needed anyway to do "cat file | sed -f script": I replaced it by "sed -f script file". Mon 1st Jun 2009 Examples/multiwf.ml Renamed two theorems here that now overwrite other theorems in the main system: FINITE_EMPTY->EMPTY_IS_FINITE and FINITE_SING->SING_IS_FINITE. Tue 26th May 2009 Ntrie/ntrie.ml, Ntrie/ntrie_tests.ml [new files] Added a nice new library by Clelia Lomuto and Marco Maggesi that performs efficient set operations on sets of natural numbers using a trie representation internally. Mon 25th May 2009 Complex/cpoly.ml, Complex/fundamental.ml Added more "needs" directives to these files so that you can load more things individually without special measures. This was inspired by a bug report from Loic Pottier who tried to load Complex/grobner.ml directly. Mon 25th May 2009 pair.ml Added an outer universal quantifier over P to the theorem pair_INDUCT; Norbert Voelker had pointed out that it didn't fit the pattern of all the other induction theorems that have this quantifier. Sat 16th May 2009 help.ml Modified "search" function so it ignores pure variables, with a warning, and also returns the empty list if the input list is nonempty but entirely full of variables. Sat 16th May 2009 real.ml, int.ml Added the following two to complete the suite with LE and LT variants: REAL_EQ_SQUARE_ABS = |- !x y. abs x = abs y <=> x pow 2 = y pow 2 INT_EQ_SQUARE_ABS = |- !x y. abs x = abs y <=> x pow 2 = y pow 2 Thu 14th May 2009 sets.ml Added the following, which is potentially quite useful for otherwise tedious reasoning patterns: SURJECTIVE_IMAGE_EQ = |- !s t. (!y. y IN t ==> (?x. f x = y)) /\ (!x. f x IN t <=> x IN s) ==> IMAGE f s = t Sat 9th May 2009 Examples/update_database.ml Made a small tweak so that "make_database_assignment" applies "uniq" to its list. Some duplicates do otherwise happen, and now they are mostly deliberate overwritings like num_Axiom. Tue 5th May 2009 cart.ml Added a couple of theorems that are trivial, but can be used to eliminate conditions on indices in some interesting situations, e.g. in vector arithmetic operations. CART_EQ_FULL = |- !x y. x = y <=> (!i. x$i = y$i) FINITE_INDEX_INRANGE = |- !i. ?k. 1 <= k /\ k <= dimindex(:N) /\ (!x:A^N. x$i = x$k) Sat 2nd May 2009 sets.ml Added a trivial theorem that I sometimes want: FINITE_EMPTY = |- FINITE {} Of course, it already exists, but CONJUNCT1 FINITE_RULES is slightly more to type, while just FINITE_RULES can make the simplifier work much harder trying to backchain. Mon 20th Apr 2009 sets.ml Added a couple of potentially useful theorems; there are similar things in Examples/card.ml, but not the "universal" form and it seems natural for it to be in the core. BIJECTIVE_ON_LEFT_RIGHT_INVERSE = |- !f s t. (!x. x IN s ==> f x IN t) ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (!y. y IN t ==> (?x. x IN s /\ f x = y)) <=> (?g. (!y. y IN t ==> g y IN s) /\ (!y. y IN t ==> f (g y) = y) /\ (!x. x IN s ==> g (f x) = x))) BIJECTIVE_LEFT_RIGHT_INVERSE = |- !f. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) <=> (?g. (!y. f (g y) = y) /\ (!x. g (f x) = x)) Fri 17th Apr 2009 sets.ml Added two degenerate cases for "pairwise", which are trivial to prove but where you wouldn't really want to divert a proof to do so: PAIRWISE_EMPTY = |- !r. pairwise r {} <=> T PAIRWISE_SING = |- !r x. pairwise r {x} <=> T Tue 14th Apr 2009 equal.ml Changed the implementation of CACHE_CONV slightly so that it pushes the function ALPHA_HACK inside the term net. The motivation was that Freek discovered a problem when adding definitions to constants in theorems: in the existing implementation this was comparing theorems when inserting things into the list at a particular net node, when used in the real arithmetic decision procedure. Actually, since it's almost always used with functions now, maybe I should just simplify the code by forgetting about eliminating duplicates in this list. Sat 11th Apr 2009 pa_j_3.11.ml (new file) Just to avoid generating a harmless error message, copied "pa_j_3.10.ml" to "pa_j_3.11.ml". Fortunately no changes are needed for the latest camlp5 (I just tried camlp5 5.11 and it's fine) so maybe thanks to camlp5 I'll be able to stop continually having to release new syntax extension files for each major OCaml release. Tue 31st Mar 2009 Examples/moebius.ml Added a new file Examples/moebius.ml by Gianni Ciolli, Graziano Gentili and Marco Maggesi defining Moebius functions and proving they are the biholomorphisms of the unit disc. This uses Cartan's theorem, which they also contributed and I installed in the Multivariate theories. Tue 17th Mar 2009 basics.ml Added "mk_let", which Roland Zumkeller had pointed out was missing, even though there was a dead link to documentation for it (of course, I now added the documentation too). Also made dest_let a bit fussier: it used not to check that the head operator was in fact "LET". Tue 24th Feb 2009 basics.ml, ind-defs.ml Fixed a bug in subst pointed out by Mark Adams, where for example: subst [v,`1`] (mk_exists(v,`1 + 1 = 2`));; where v happens to be the next genvar to be generated. Just used "variants" to avoid the existing variables in the term when creating intermediate variables. (To do this, I moved "variables" from ind-defs.ml, which is hardly a natural place for it anyway, and moved back the definition of "variants" within "basics.ml".) There must be a few other places where such genvar coincidences would kill things too. Sun 22nd Feb 2009 sets.ml Finally added these, which I seem to generate quite a bit at the moment: IMAGE_ID = |- !s. IMAGE (\x. x) s = s IMAGE_I = |- !s. IMAGE I s = s Fri 20th Feb 2009 sets.ml Added natural duals to corresponding FORALL_xxx theorems: EXISTS_IN_INSERT = |- !P a s. (?x. x IN a INSERT s /\ P x) <=> P a \/ (?x. x IN s /\ P x) EXISTS_IN_GSPEC = |- (!P f. (?z. z IN {f x | P x} /\ Q z) <=> (?x. P x /\ Q (f x))) /\ (!P f. (?z. z IN {f x y | P x y} /\ Q z) <=> (?x y. P x y /\ Q (f x y))) /\ (!P f. (?z. z IN {f w x y | P w x y} /\ Q z) <=> (?w x y. P w x y /\ Q (f w x y))) Fri 13th Feb 2009 sets.ml Added IMAGE_INTER_INJ = |- !f s t. (!x y. f x = f y ==> x = y) ==> IMAGE f (s INTER t) = IMAGE f s INTER IMAGE f t and also added outer universal quantifiers to similar theorems IMAGE_DIFF_INJ and IMAGE_DELETE_INJ. Thu 15th Jan 2009 Examples/borsuk.ml Added a proof of the Borsuk-Ulam theorem, so far just for the ordinary 2-sphere in real^3. Wed 14th Jan 2009 sets.ml Added FUN_IN_IMAGE = |- !f s x. x IN s ==> f x IN IMAGE f s Wed 14th Jan 2009 sets.ml Added PSUBSET_ALT = |- !s t:A->bool. s PSUBSET t <=> s SUBSET t /\ (?a. a IN t /\ ~(a IN s)) Thu 25th Dec 2008 sets.ml Added SET_OF_LIST_MAP = |- !f l. set_of_list (MAP f l) = IMAGE f (set_of_list l) Wed 24th Dec 2008 list.ml Added the following useful theorem, which is actually one of very few about EL: MEM_EXISTS_EL = |- !l x. MEM x l <=> (?i. i < LENGTH l /\ x = EL i l) Sun 21st Dec 2008 sets.ml Added the following, not in wf.ml because it needs set notions like "FINITE": WF_FINITE = |- !(<<). (!x. ~(x << x)) /\ (!x y z. x << y /\ y << z ==> x << z) /\ (!x. FINITE {y | y << x}) ==> WF (<<) Sun 21st Dec 2008 arith.ml, sets.ml Moved the following theorems from "sets.ml" back to "arith.ml": TRANSITIVE_STEPWISE_LT_EQ, TRANSITIVE_STEPWISE_LT, TRANSITIVE_STEPWISE_LE_EQ, TRANSITIVE_STEPWISE_LE. This was mainly so I could exploit them sooner, but in any case they seem to belong there more naturally. Sat 20th Dec 2008 Examples/card.ml Added a few more general lemmas and particularly a few non-trivial results about countable sets. Sat 20th Dec 2008 sets.ml, Examples/card.ml It seemed ugly having these hardly-used relations like CARD_GE that are then superseded by >=_c etc. in Examples/card.ml. So I replaced the definitions in sets.ml with those <=_c forms, adding >= and >, also moving LE_C and proving GE_C which is essentially a replacement for the old CARD_GE. Deleted the little-used theorems CARD_GE_REFL, CARD_GE_TRANS and FINITE_HAS_SIZE_LEMMA (these would belong in Examples/card.ml) but put copies in Jordan for now. Fri 19th Dec 2008 sets.ml Added the following, which is actually often nicer than using SIMPLE_IMAGE, and applicable to cases with 1, 2 or 3 parameters: FORALL_IN_GSPEC = |- (!P f. (!z. z IN {f x | P x} ==> Q z) <=> (!x. P x ==> Q (f x))) /\ (!P f. (!z. z IN {f x y | P x y} ==> Q z) <=> (!x y. P x y ==> Q (f x y))) /\ (!P f. (!z. z IN {f w x y | P w x y} ==> Q z) <=> (!w x y. P w x y ==> Q (f w x y))) Tue 16th Dec 2008 Makefile Made a few small tweaks to the Makefile, in particular forcing loading Examples/update_database.ml right at the end of the loads for each image. I had earlier encountered problems with duplicates because of the explicit assignment of theorems in "multivariate_database.ml" etc. Sun 14th Dec 2008 sets.ml Added the following, which saves some trivial "unwinding" FORALL_IN_INSERT = |- !P a s. (!x. x IN a INSERT s ==> P x) <=> P a /\ (!x. x IN s ==> P x) Tue 9th Dec 2008 cart.ml Added "vector", which was formerly defined in the multivariate theories and for the special type real. Here generalized it to type A, and eliminated special choice of zero for higher elements (which is irrelevant anyway and doesn't really generalize). The immediate impetus was that I wanted to use it to define matrices. Fri 5th Dec 2008 iter.ml Added the following theorems about differences of powers. Could add the sums of powers too, but they would hardly be nicer than just instantiating one of these with a negated argument. REAL_SUB_POW = |- !x y n. 1 <= n ==> x pow n - y pow n = (x - y) * sum (0..n - 1) (\i. x pow i * y pow (n - 1 - i)) REAL_SUB_POW_R1 = |- !x n. 1 <= n ==> x pow n - &1 = (x - &1) * sum (0..n - 1) (\i. x pow i) REAL_SUB_POW_L1 = |- !x n. 1 <= n ==> &1 - x pow n = (&1 - x) * sum (0..n - 1) (\i. x pow i) Fri 5th Dec 2008 arith.ml Added EXP_ZERO = |- !n. 0 EXP n = (if n = 0 then 1 else 0) Thu 4th Dec 2008 int.ml Added another forgotten analog of a real theorem: INT_POW_ZERO = |- !n. &0 pow n = (if n = 0 then &1 else &0) Thu 4th Dec 2008 Examples/mangoldt.ml Examples/agm.ml Examples/multiplicative.ml [new files] Added three new files to Examples with stuff that is generally useful. The mangoldt.ml one is essentially common to 100/pnt.ml and 100/dirichlet.ml, so it makes sense to have it common. The agm.ml one was already basically there in 100/agm.ml, but I factored out the explicit use of roots so this version is more portable. The multiplicative.ml defines the notion for both N and R and has the Mobius function for R. Wed 4th Dec 2008 100/dirichlet.ml [new file] Added the proof of Dirichlet's theorem to the Great 100 Theorems directory. Wed 3rd Dec 2008 iter.ml Changed the quantification in NSUM_OFFSET and SUM_OFFSET. Previously one variable was left free, and it was inconvenient to have the "offset" variable at the end of the list because that is often necessary to instantiate in order to get higher order matching working. Wed 3rd Dec 2008 sets.ml Added a lemma that I seem to regenerate quite often. I'm not very keen on the name but it's consistent with EMPTY_GSPEC, which admittedly I don't use much. SING_GSPEC = |- (!a. {x | x = a} = {a}) /\ (!a. {x | a = x} = {a}) Also added the following, which I seem to want quite often: FINITE_SING = |- !a. FINITE {a} Sat 29th Nov 2008 real.ml Added a few useful theorems that are obvious holes in the current pattern: REAL_INV_POW = |- !x n. inv (x pow n) = inv x pow n REAL_INV_LT_1 = |- !x. &1 < x ==> inv x < &1 REAL_INV_1_LT = |- !x. &0 < x /\ x < &1 ==> &1 < inv x Thu 27th Nov 2008 passim Changed a lot of instances of GSYM IMP_IMP to IMP_CONJ, and likewise changed explicit TAUT calls to IMP_CONJ, IMP_CONJ_ALT. Even caught one or two instances of IMP_IMP and EQ_IMP replacing explicit tautologies. Wed 26th Nov 2008 theorems.ml Added the following, which I keep regenerating ad hoc: IMP_CONJ_ALT = |- p /\ q ==> r <=> q ==> p ==> r Wed 26th Nov 2008 iter.ml Added two theorems relating explicit number segments to the m..n notation: NUMSEG_LE = |- !n. {x | x <= n} = 0..n NUMSEG_LT = |- !n. {x | x < n} = (if n = 0 then {} else 0..n - 1) Mon 24th Nov 2008 drule.ml Changed two instances of "=" between terms (when checking whether the result needs non-trivial alpha-conversion) to Pervasives.compare, one each in PART_MATCH and GEN_PART_MATCH. This came up when checking some big tables where this step was taking half a second. Then wondered about matching itself. Although in this case it's not the bottleneck, I made some corresponding changes inside term_match (more of them). Sun 23rd Nov 2008 real.ml, Examples/isum.ml Added a version of telescoping the other way round, otherwise it's tedious to apply it. SUM_DIFFS_ALT = |- !m n. sum(m..n) (\k. f (k + 1) - f k) = (if m <= n then f (n + 1) - f m else &0) ISUM_DIFFS_ALT = |- !m n. isum(m..n) (\k. f (k + 1) - f k) = (if m <= n then f (n + 1) - f m else &0) Sun 23rd Nov 2008 int.ml Added the following, which had somehow got left out: INT_SUB_RDISTRIB = |- !x y z. (x - y) * z = x * z - y * z Sun 23rd Nov 2008 Examples/isum.ml [new file] Added a new file of theorems about integer sums. I decided to do it by generalizing INT_OF_REAL_THM, which works quite nicely, and would be quicker if I ever rolled it into the core. The generalized INT_OF_REAL_THM could conceivably be useful in itself. Sun 23rd Nov 2008 int.ml Surprisingly, found that my last change had broken INTEGER_TAC, which was sometimes calling int_ideal_cofactors in cases where not all the terms are integers. Put in filtering, but really I should think more about how this happens, since it may be indicative of some more systematic improvements I could make. Sat 22nd Nov 2008 calc_rat.ml, int.ml Modified "int_ideal_cofactors" and "real_ideal_cofactors" to give a clearer error messages if the types of the terms are unexpected. This was stimulated by a report from Loic Pottier who tried the example from the reference manual. Anyway I also added a "prioritize_real()" to the help entry for "int_ideal_cofactors". Fri 21st Nov 2008 calc_rat.ml Made a change corresponding to what I did for num's MAX and MIN: added conversions REAL_RAT_MAX_CONV and REAL_RAT_MIN_CONV and rolled them into REAL_RAT_RED_CONV and hence REAL_RAT_REDUCE_CONV. Did likewise over integers, adding conversions INT_MAX_CONV and INT_MIN_CONV and rolled them into INT_RED_CONV and hence INT_REDUCE_CONV. Also added two supporting pseudo-definitions: INT_MAX = |- !x y. max x y = (if x <= y then y else x) INT_MIN = |- !x y. min x y = (if x <= y then x else y) Fri 21st Nov 2008 Examples/schnirelmann.ml [new file] Added my little file of properties of Schnirelmann density to Examples, since it is relatively self-contained and potentially useful. Wed 19th Nov 2008 iter.ml Added the following; the "sum" analog was already there but now I needed the natural number version: NSUM_IMAGE_NONZERO = |- !d i s. FINITE s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d (i x) = 0) ==> nsum (IMAGE i s) d = nsum s (d o i) Tue 18th Nov 2008 iter.ml Added a result about enumerating elements of a finite set in order; it's strange I'd never wanted this before! TOPOLOGICAL_SORT = |- !(<<). (!x y. x << y /\ y << x ==> x = y) /\ (!x y z. x << y /\ y << z ==> x << z) ==> (!n s. s HAS_SIZE n ==> (?f. s = IMAGE f (1..n) /\ (!j k. j IN 1..n /\ k IN 1..n /\ j < k ==> ~(f k << f j)))) Mon 17th Nov 2008 calc_num.ml Added NUM_MAX_CONV and NUM_MIN_CONV and rolled them into NUM_RED_CONV and NUM_REDUCE_CONV. Mon 17th Nov 2008 real.ml Added two more theorems that I was surprised weren't (quite) already there. REAL_POW_EQ_1_IMP = |- !x n. ~(n = 0) /\ x pow n = &1 ==> abs x = &1 REAL_POW_EQ_1 = |- !x n. x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) \/ n = 0 Fri 14th Nov 2008 Makefile Changed the Makefile to load the dynamic database update into the basic hol image, not only the extra builds on top. Put a final "search" in those, however, so that the very first search is not slow. Fri 14th Nov 2008 sets.ml Added three more theorems about unions that I was rather surprised I'd never done before: CARD_UNION_GEN = |- !s t. FINITE s /\ FINITE t ==> CARD(s UNION t) = (CARD s + CARD t) - CARD(s INTER t) CARD_UNION_OVERLAP_EQ = |- !s t. FINITE s /\ FINITE t ==> (CARD(s UNION t) = CARD s + CARD t <=> s INTER t = {}) CARD_UNION_OVERLAP = |- !s t. FINITE s /\ FINITE t /\ CARD(s UNION t) < CARD s + CARD t ==> ~(s INTER t = {}) Wed 12th Nov 2008 int.ml Added a dual to the existing theorem for the universal quantifier: INT_EXISTS_POS = |- (?n. P (&n)) <=> (?i. &0 <= i /\ P i) Wed 12th Nov 2008 int.ml Changed the definition of (a == b) to assume both sides have the same type. This is a useful type constraint and I can't imagine the accidental generality ever actually being useful. Tue 11th Nov 2008 arith.ml, real.ml, int.ml, passim Finally added natural number MAX and MIN: MAX = |- !m n. MAX m n = (if m <= n then n else m) MIN = |- !m n. MIN m n = (if m <= n then m else n) and some basic supporting theorems, just enough to roll it into ARITH_RULE etc. REAL_OF_NUM_MAX = |- !m n. max (&m) (&n) = &(MAX m n) REAL_OF_NUM_MIN = |- !m n. min (&m) (&n) = &(MIN m n) INT_OF_NUM_MAX = |- !m n. max (&m) (&n) = &(MAX m n) INT_OF_NUM_MIN = |- !m n. min (&m) (&n) = &(MIN m n) Removed corresponding or slightly different definitions from the places where it was already used, and occasionally simplified proofs just to use the enhanced ARITH_TAC. Sun 2nd Nov 2008 Mizarlight/make.ml There was still an issue with getting Pa_j when not in the HOL directory, so added the line: Topdirs.dir_directory (!hol_dir);; Sun 2nd Nov 2008 Mizarlight/make.ml Changed "#load" to my own explicit path version so it works wherever HOL Light is installed. Sat 1st Nov 2008 Minisat/make.ml, Boyer_Moore/make.ml Changed "#use" into "loads" so that it will find the path wherever HOL Light is installed. Sat 1st Nov 2008 Examples/pratt.ml, Examples/pocklington.ml Added "2>/dev/null" to the GP invocations so we avoid the "reading .gprc" messages. Sat 25th Oct 2008 Makefile, Multivariate/make.ml, Multivariate/make_complex.ml, Multivariate/multivariate_database.ml [new file], Multivariate/complex_database.ml [new file] Added pre-built databases for the multivariate and complex-multivariate theories, as a convenience for people who aren't able to use the dynamic updating. Sat 25th Oct 2008 Examples/sos.ml Put preprocessing of DECIMAL (i.e. the #x.y notation) into REAL_SOS in exactly the same way as REAL_ARITH. This was motivated by the example of using REAL_SQRTSOSFIELD on `&2 * #1.255 < sqrt(&8)` that I mentioned on the Flyspeck list. Sat 25th Oct 2008 set.ml Added these two lemmas, which came up naturally in a query from Truong Nguyen on the Flyspeck list. CARD_SET_OF_LIST_LE = |- !l. CARD(set_of_list l) <= LENGTH l HAS_SIZE_SET_OF_LIST = |- !l. (set_of_list l) HAS_SIZE (LENGTH l) <=> PAIRWISE (\x y. ~(x = y)) l Fri 24th Oct 2008 drule.ml, simp.ml, tactics.ml Since the change to PART_MATCH on 22nd Sep was breaking too much stuff, I restored the old version but added a new one GEN_PART_MATCH with the new behaviour, and used that so far just in congruence rule handling in the simplifier. Tue 21st Oct 2008 Examples/pratt.ml, Examples/pocklington.ml When trying out HOL Light on a new platform (my own little Debian thing inside Virtualbox) I hit a problem with the PARI/GP interface because I was looking for the first "[" to find the output, yet in this case that occurred in the startup banner. Made the chopping of the output slightly less unintelligent by starting at the rightmost "]" then the rightmost "[". Wed 24th Sep 2008 Examples/analysis.ml Made the overload skeleton and overloading instances of "sum" more general; before the overload skeleton was restricted to sums out of a set of numbers. This was pointed out by Tom Hales. Tue 23rd Sep 2008 tactics.ml Fixed a bug in FREEZE_THEN: the implementation using SUBGOAL_THEN was presuming two subgoals afterwards, yet it's possible that the ttac will solve the original goal completely and just leave the trivial one. This actually came up when I used FREEZE_THEN(fun t -> SIMP_TAC[t]) in order to fix some cases where things coincidentally worked thanks to the old PART_MATCH behaviour. Tue 23rd Sep 2008 tactics.ml I had compensated for the modified PART_MATCH and its consequent effect on MATCH_MP_TAC by tweaking a few proofs. But it was getting a bit tedious, and it didn't actually seem that the new behaviour was beneficial in this context since the invented variables are effectively frozen and so almost certainly not what's wanted. It seemed surprisingly difficult to put a basic wrapper round the existing PART_MATCH (I wanted some FREEZE-type thing, but you need to watch out for type instantiation and theorems with hypotheses). So I basically just copied the old PART_MATCH into this code. Mon 22nd Sep 2008 drule.ml Changed PART_MATCH so that it renames even free variables in the theorem if necessary when they would otherwise be uninstantiated (because they don't occur in the bit actually being matched) and clash with some post-instantiation variables. This is exemplified by the following: let th = TAUT `(g = g') ==> (g' ==> (t = t')) ==> (~g' ==> (e = e')) ==> ((if g then t else e) = (if g' then t' else e'))`;; let tm = `if CONS h' t' = [] then a else CONS h' t'`;; PART_MATCH (lhs o funpow 3 rand) th tm;; which used to give |- (CONS h' t' = [] <=> g') ==> (g' ==> a = t') ==> (~g' ==> CONS h' t' = e') ==> (if CONS h' t' = [] then a else CONS h' t') = (if g' then t' else e') but now gives |- (CONS h' t' = [] <=> g') ==> (g' ==> a = t'') ==> (~g' ==> CONS h' t' = e') ==> (if CONS h' t' = [] then a else CONS h' t') = (if g' then t'' else e') This was originally found by Jesse Bingham, who encountered a case where SIMP_CONV returned the "wrong" left-hand side thanks to this congruence rule instantiation. Tue 19th Aug 2008 lib.ml Removed a stray ";" in the definition of "mem'", pointed out by Mark Adams. For some reason OCaml didn't complain. Mon 11th Aug 2008 Boyer_Moore/* [new directory] Added a new directory containing code for Boyer-Moore automation. This was written by Petros Papapanagiotou, working with Jacques Fleuriot and starting from Richard Boulton's HOL88 code. Petros's thesis describing the setup is available at "http://www.inf.ed.ac.uk/publications/thesis/online/IM070466.pdf". Mon 11th Aug 2008 Examples/iter.ml [new file] Added a new file with theorems about the function iterator, from Marco et al. Occasionally I had used something similar but called it FUNPOW. Mon 11th Aug 2008 sets.ml Added SING_SUBSET = |- !s x. {x} SUBSET s <=> x IN s which was used in Marco et al's Cartan proof. Fri 8th Aug 2008 arith.ml, int.ml Changed the natural number and integer modulus operations so that n MOD 0 = n and n rem 0 = n. This was with the idea of removing the ~(n = 0) hypothesis from (a == b) (mod n) <=> (a MOD n = b MOD n) and others, though I didn't actually do that now. Thu 7th Aug 2008 int.ml Added INT_DIV_CONV and INT_REM_CONV for explicit calculations, and rolled these into INT_RED_CONV and INT_REDUCE_CONV. I should do something for INT_ARITH at some stage too. Thu 7th Aug 2008 int.ml Added definitions of "div" and "rem", using what Raymond Boute calls the "Euclidean" definition. Also added some supporting theorems, so we have: INT_WOP = |- (?x. &0 <= x /\ P x) <=> (?x. &0 <= x /\ P x /\ (!y. &0 <= y /\ P y ==> x <= y)) INT_DIVMOD_EXIST_0 = |- !m n. ?q r. if n = &0 then q = &0 /\ r = &0 else &0 <= r /\ r < abs n /\ m = q * n + r INT_DIVISION_0 = |- !m n. if n = &0 then m div n = &0 /\ m rem n = &0 else &0 <= m rem n /\ m rem n < abs n /\ m = m div n * n + m rem n INT_DIVISION = |- !m n. ~(n = &0) ==> m = m div n * n + m rem n /\ &0 <= m rem n /\ m rem n < abs n INT_DIVMOD_UNIQ = |- !m n q r. m = q * n + r /\ &0 <= r /\ r < abs n ==> m div n = q /\ m rem n = r Thu 7th Aug 2008 int.ml Added more forgotten analogues of real theorems, including the most recent set just below but also with one other strange omission: INT_LE_RMUL = |- !x y z. x <= y /\ &0 <= z ==> x * z <= y * z INT_POW_LE2_REV = |- !n x y. ~(n = 0) /\ &0 <= y /\ x pow n <= y pow n ==> x <= y INT_POW_LT2_REV = |- !n x y. &0 <= y /\ x pow n < y pow n ==> x < y INT_POW_EQ = |- !n x y. ~(n = 0) /\ &0 <= x /\ &0 <= y /\ x pow n = y pow n ==> x = y INT_POW_EQ_ABS = |- !n x y. ~(n = 0) /\ x pow n = y pow n ==> abs x = abs y Tue 22nd Apr 2008 real.ml Added a few theorems that seem like glaring omissions, even though they're not really hard to derive when needed: REAL_POW_LE2_REV = |- !n x y. ~(n = 0) /\ &0 <= y /\ x pow n <= y pow n ==> x <= y REAL_POW_LT2_REV = |- !n x y. &0 <= y /\ x pow n < y pow n ==> x < y REAL_POW_EQ = |- !n x y. ~(n = 0) /\ &0 <= x /\ &0 <= y /\ x pow n = y pow n ==> x = y REAL_POW_EQ_ABS = |- !n x y. ~(n = 0) /\ x pow n = y pow n ==> abs x = abs y Mon 21st Apr 2008 lib.ml Made a few small optimizations to the FPF code, basically inlining "ldb" and "is_undefined" to reduce function call overhead. Fri 29th Feb 2008 arith.ml Yet more simplifications suggested by Mark Bouler, though not using the same techniques, just more efficiently exploiting DIVMOD_UNIQ. Now the pairs DIV_0/MOD_0, DIV_1/MOD_1 and DIV_MULT/MOD_MULT are proved together using that and split into pairs. Tue 26th Feb 2008 arith.ml Simplified several proofs, this time of DIV_MOD, DIV_MONO, DIV_MOD_LT and DIV_LE_EXCLUSION_EXCLUSION using Mark Bouler's method. The only price was that the proof of the core lemma LE_RDIV_EQ became slightly longer so as not to rely on DIV_MONO. Also took the chance to slightly reorder things to separate the second suite of theorems about EXP from those about DIV and MOD. Sat 23rd Feb 2008 arith.ml Greatly simplified the proof of DIV_DIV using a trick that Mark Bouler showed me yesterday, using indirect equality (easy by MESON) and then the "Galois connection" lemma LE_RDIV_EQ. I should maybe see if this is more widely applicable. Tue 19th Feb 2008 arith.ml I always seem to be inventing ad-hoc lemmas to shuffle between different formulations of a natural number being strictly positive, so I added the following. Of course it will somewhat expand the search space in the simplifier but cuts through all the mess by having implications between all 6 pairs of formulations: LE_1 = |- (!n. ~(n = 0) ==> 0 < n) /\ (!n. ~(n = 0) ==> 1 <= n) /\ (!n. 0 < n ==> ~(n = 0)) /\ (!n. 0 < n ==> 1 <= n) /\ (!n. 1 <= n ==> 0 < n) /\ (!n. 1 <= n ==> ~(n = 0)) Sun 17th Feb 2008 iter.ml Slighly weakened hypothesis inequalities, formerly "m <= p" and "p <= n", in NUMSEG_COMBINE_R = |- !m p n. m <= p + 1 /\ p <= n ==> ((m..p) UNION ((p+1)..n) = m..n) NUMSEG_COMBINE_L = |- !m p n. m <= p /\ p <= n + 1 ==> ((m..(p-1)) UNION (p..n) = m..n) and added two combinations with sums: SUM_COMBINE_L = |- !f m n p. 0 < n /\ m <= n /\ n <= p + 1 ==> sum (m..n - 1) f + sum (n..p) f = sum (m..p) f SUM_COMBINE_R = |- !f m n p. m <= n + 1 /\ n <= p ==> sum (m..n) f + sum (n + 1..p) f = sum (m..p) f and an unrelated but useful theorem: SUM_ABS_LE = |- !f g s. FINITE s /\ (!x. x IN s ==> abs (f x) <= g x) ==> abs (sum s f) <= sum s g Wed 13th Feb 2008 iter.ml Added two forms of partial summation: SUM_PARTIAL_SUC = |- !f g m n. sum (m..n) (\k. f k * (g(k + 1) - g k)) = (if m <= n then f(n + 1) * g(n + 1) - f m * g m - sum (m..n) (\k. g(k + 1) * (f(k + 1) - f k)) else &0) SUM_PARTIAL_PRE = |- !f g m n. sum (m..n) (\k. f k * (g k - g(k - 1))) = (if m <= n then f(n + 1) * g n - f m * g(m - 1) - sum (m..n) (\k. g k * (f(k + 1) - f k)) else &0) Tue 12th Feb 2008 itab.ml So it turns out that my tweak on 31st Jan last year was not right after all. Sean McLaughlin pointed out that the following now didn't work: ITAUT `(((~ ~ (p \/ ~p)) ==> (p \/ ~p)) ==> (p \/ ~p))`;; So I just went back to the old code in this respect, putting back FIRST_ASSUM instead of FIRST_X_ASSUM. Tue 5th Feb 2008 real.ml Added: REAL_EQ_INV2 = |- !x y. inv x = inv y <=> x = y REAL_INV_EQ_1 = |- !x. inv x = &1 <=> x = &1 Tue 5th Feb 2008 arith.ml Added a bunch of theorems that are an obvious gap in the arithmetic suite; several variants of these are in Examples/prime.ml, but often decorated with "SUC". So I added "SUC" suffixes to those versions. EXP_EQ_1 = |- !x n. x EXP n = 1 <=> x = 1 \/ n = 0 EXP_MONO_LE_IMP = |- !x y n. x <= y ==> x EXP n <= y EXP n EXP_MONO_LT_IMP = |- !x y n. x < y /\ ~(n = 0) ==> x EXP n < y EXP n EXP_MONO_LE = |- !x y n. x EXP n <= y EXP n <=> x <= y \/ n = 0 EXP_MONO_LT = |- !x y n. x EXP n < y EXP n <=> x < y /\ ~(n = 0) EXP_MONO_EQ = |- !x y n. x EXP n = y EXP n <=> x = y \/ n = 0 Mon 4th Feb 2008 calc_rat.ml, int.ml Added something I should probably have done a long time ago: ASM_ARITH_TAC ASM_INT_ARITH_TAC ASM_REAL_ARITH_TAC These basically pop every assumption that isn't universally quantified and use them as additional hypotheses. I was getting sick of using repeated idioms like "REPEAT(POP_ASSUM MP_TAC) THEN ARITH_TAC". Mon 4th Feb 2008 arith.ml Added MULT_DIV_LE = |- !m n p. ~(p = 0) ==> m * (n DIV p) <= (m * n) DIV p Sun 3rd Feb 2008 arith.ml Added EQ_EXP = |- !x m n. x EXP m = x EXP n <=> (if x = 0 then m = 0 <=> n = 0 else x = 1 \/ m = n) Tue 29th Jan 2008 sets.ml Added: FINITE_FINITE_PREIMAGE_GENERAL = |- !f s t. FINITE t /\ (!y. y IN t ==> FINITE {x | x IN s /\ f x = y}) ==> FINITE {x | x IN s /\ f x IN t} FINITE_FINITE_PREIMAGE = |- !f t. FINITE t /\ (!y. y IN t ==> FINITE {x | f x = y}) ==> FINITE {x | f x IN t} Thu 24th Jan 2008 Unity/make.ml, Unity/mk_unity_prog.ml Made a fix indicated by Flemming to the "mk_unity_prog.ml" file so that now it loads unproblematically, and hence uncommented its load in the "make.ml" root. Fri 18th Jan 2008 Unity [new directory] Added the first version of Flemming Andersen's Unity theory, which he has ported to HOL Light. Wed 16th Jan 2008 real.ml Added REAL_POW_ZERO = |- !n. &0 pow n = (if n = 0 then &1 else &0) REAL_POW_MONO_INV = |- !m n x. &0 <= x /\ x <= &1 /\ n <= m ==> x pow m <= x pow n Tue 15th Jan 2008 arith.ml Finally added FACT_NZ = |- !n. ~(FACT n = 0). Of course it's trivial to generate, but I seem to be doing it quite often. Wed 7th Jan 2008 hol.ml Changed (back?) from Filename.temp_dir to "/tmp", since I just discovered on getting a new laptop that the OCaml in Cygwin, still 3.08, doesn't have that. It seems a pity to force people to upgrade their OCaml just for this slightly more elegant solution. Maybe in a year or two I'll change it back. Wed 2nd Jan 2008 define.ml Put in a rewritten version of this stuff, with a few new proforma theorems and a somewhat different (simpler?) method for hacking the proformas to include many variables. Most notably, this adds support for the new "match" and "function" constructs, but has some other enhancements too such as "MAP". Also the "instantiate_casewise_recursion" folds in the tupling of multiple arguments, which was otherwise only done in functions further out. Sat 29th Dec 2007 Permutation/*.ml Installed new version of the Permutation material from Marco Maggesi. Thu 27th Dec 2007 sets.ml Added SIMPLE_IMAGE_GEN = |- !f p. {f x | P x} = IMAGE f {x | P x} Sun 23rd Dec 2007 iter.ml Added SUM_IMAGE_LE = |- !f g s. FINITE s /\ (!x. x IN s ==> &0 <= g(f x)) ==> sum (IMAGE f s) g <= sum s (g o f) and IN_NUMSEG_0 = |- !m n. m IN 0..n <=> m <= n Sun 23rd Dec 2007 sets.ml Added EXISTS_IN_UNIONS = |- !P s. (?x. x IN UNIONS s /\ P x) <=> (?t x. t IN s /\ x IN t /\ P x) Tue 18th Dec 2007 realarith.ml Tweaked the "eliminate_construct" subfunction in GEN_REAL_ARITH to check that the term it's finding is actually free in the whole term. Previously, it could go into an infinite loop in cases like this by repeatedly attempting to replace non-free subterms: REAL_ARITH `&0 <= abs(sum s (\x. abs x))`;; Tue 18th Dec 2007 real.ml Added REAL_POW_1_LT = |- !n x. ~(n = 0) /\ &0 <= x /\ x < &1 ==> x pow n < &1 REAL_POW_LT_1 = |- !n x. ~(n = 0) /\ &1 < x ==> &1 < x pow n which I was a bit surprised not to have already, and also the integer counterparts INT_POW_1_LT and INT_POW_LT_1. Tue 18th Dec 2007 Examples/floor.ml To be more consistent with other names, redefined: REAL_EQ_INTEGERS = |- !x y. integer x /\ integer y ==> (x = y <=> abs (x - y) < &1) and renamed the old theorem that had that name: REAL_EQ_INTEGERS_IMP = |- !x y. integer x /\ integer y /\ abs (x - y) < &1 ==> x = y Sun 16th Dec 2007 cart.ml Added this finiteness theorem (which is actually quite tedious to prove!) FINITE_CART = |- !P. (!i. 1 <= i /\ i <= dimindex (:N) ==> FINITE {x | P i x}) ==> FINITE {v | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (v$i)} Mon 10th Dec 2007 iter.ml Added two slighly generalized forms of [N]SUM_IMAGE_GEN: NSUM_GROUP = |- !f g s t. FINITE s /\ IMAGE f s SUBSET t ==> nsum t (\y. nsum {x | x IN s /\ f x = y} g) = nsum s g SUM_GROUP = |- !f g s t. FINITE s /\ IMAGE f s SUBSET t ==> sum t (\y. sum {x | x IN s /\ f x = y} g) = sum s g Sat 8th Dec 2007 sets.ml Added UNIONS_UNION = |- !s t. UNIONS (s UNION t) = UNIONS s UNION UNIONS t Tue 4th Dec 2007 iter.ml Added the following (maybe should also do an ITERATE version sometime). NSUM_UNIONS_NONZERO = |- !f s. FINITE s /\ (!t. t IN s ==> FINITE t) /\ (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 ==> f x = 0) ==> nsum (UNIONS s) f = nsum s (\t. nsum t f) SUM_UNIONS_NONZERO = |- !f s. FINITE s /\ (!t. t IN s ==> FINITE t) /\ (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 ==> f x = &0) ==> sum (UNIONS s) f = sum s (\t. sum t f) Tue 4th Dec 2007 sets.ml Added SUBSET_CARD_EQ = |- !s t. FINITE t /\ s SUBSET t ==> (CARD s = CARD t <=> s = t) Mon 3rd Dec 2007 wf.ml, define.ml, passim Changed "measure" to "MEASURE" (both the constant name and the ML binding of its definition). This frees up lowercase "measure" for Lebesgue measure, which I've finally started seriously working with. Sun 2nd Dec 2007 set.ml Added UNIONS_SUBSET = |- !f t. UNIONS f SUBSET t <=> (!s. s IN f ==> s SUBSET t) SUBSET_UNIONS = |- !f g. f SUBSET g ==> UNIONS f SUBSET UNIONS g Fri 23rd Nov 2007 iter.ml Added CARD_UNIONS = |- !s. FINITE s /\ (!t. t IN s ==> FINITE t) /\ (!t u. t IN s /\ u IN s /\ ~(t = u) ==> t INTER u = {}) ==> CARD(UNIONS s) = nsum s CARD Thu 22nd Nov 2007 sets.ml To celebrate Thanksgiving I proved that integrals of arbitrary functions over a set of measure zero are 0. I ended up using a lemma about sums, and I thought I'd add it to the core. In one sense it's a bit ad hoc, but corresponds to a very straightforward intuition: all elements of one sum are dominated by some of another, and the rest of the second sum are nonnegative. SUM_LE_INCLUDED = |- !f g s t i. FINITE s /\ FINITE t /\ (!y. y IN t ==> &0 <= g y) /\ (!x. x IN s ==> (?y. y IN t /\ i y = x /\ f x <= g y)) ==> sum s f <= sum t g Tue 20th Nov 2007 int.ml Added integer versions of some recent additions I'd forgotten, including the latest: INT_BOUNDS_LE = |- !x k. --k <= x /\ x <= k <=> abs x <= k INT_BOUNDS_LT = |- !x k. --k < x /\ x < k <=> abs x < k INT_MUL_POS_LT = |- !x y. &0 < x * y <=> &0 < x /\ &0 < y \/ x < &0 /\ y < &0 INT_MUL_POS_LE = |- !x y. &0 <= x * y <=> x = &0 \/ y = &0 \/ &0 < x /\ &0 < y \/ x < &0 /\ y < &0 INT_LE_MUL_EQ = |- (!x y. &0 < x ==> (&0 <= x * y <=> &0 <= y)) /\ (!x y. &0 < y ==> (&0 <= x * y <=> &0 <= x)) INT_LT_MUL_EQ = |- (!x y. &0 < x ==> (&0 < x * y <=> &0 < y)) /\ (!x y. &0 < y ==> (&0 < x * y <=> &0 < x)) To get the last two I had to add a little tweak to INT_OF_REAL_THM to handle conjunctive equations; previously it only worked if all the universal quantifiers were at the outside. Tue 20th Nov 2007 real.ml Added two theorems that I keep regenerating: REAL_BOUNDS_LE = |- !x k. --k <= x /\ x <= k <=> abs x <= k REAL_BOUNDS_LT = |- !x k. --k < x /\ x < k <=> abs x < k The symmetric form of the first one was already there as REAL_ABS_BOUNDS, but I've never actually used it (however, since it's used by Freek and Tom, I didn't delete it). Mon 19th Nov 2007 real.ml Added REAL_MUL_POS_LT = |- !x y. &0 < x * y <=> &0 < x /\ &0 < y \/ x < &0 /\ y < &0 REAL_MUL_POS_LE = |- !x y. &0 <= x * y <=> x = &0 \/ y = &0 \/ &0 < x /\ &0 < y \/ x < &0 /\ y < &0 Wed 14th Nov 2007 ind-types.ml Added a trivial tweak in "prove_cases_thm" so that it works on num_INDUCTION, where one of the "constructors" 0 is not really a constant. Just check for reflexivity in "prove_triv" subfunction. Wed 14th Nov 2007 calc_rat.ml Added a little extra feature to REAL_FIELD so that it uses any strict inequality hypotheses s < t to add a hypothesis ~(s = t). Previously, this only happened if there was a correlation in a branch with an explicit equation (s = t), e.g. introduced in the elimination of inverses. Now, for example, we solve this which failed before: REAL_FIELD `&0 < x ==> x * y = x * z ==> y = z`;; Tue 13th Nov 2007 sets.ml Added SUBSET_ANTISYM_EQ = |- !s t. s SUBSET t /\ t SUBSET s <=> s = t Tue 13th Nov 2007 Modified "pa_j_3.10.ml" for the latest version of camlp5 (5.02). Needed a bit of grubbing round; in particular I had to add "translate_operator" into the new "val_ident" clause. Mon 12th Nov 2007 Added FORALL_UNWIND_CONV; I wanted some such operation inside the new "define" wellfoundedness-guessing, and it seemed useful and general enough to do properly. Wed 7th Nov 2007 sets.ml Added SUBSET_INTER = |- !s t u. s SUBSET t INTER u <=> s SUBSET t /\ s SUBSET u Tue 6th Nov 2007 printer.ml Modified the printer so that when trying to print a "function" or "match" construct it *first* makes sure the construct is in the canonical form before printing anything. Otherwise the kind of more general cases that crop up in admissibility lemmas show up as an exception when printing. Tue 30th Oct 2007 Makefile Changed "[ ... ]" to "test", and "==" to "=" in the Makefile, which for some reason barfed on my new Ubuntu box but not on other platforms. Anyway it seems more correct/portable. Wed 17th Oct 2007 pair.ml, ind-types.ml Changed the definitions of _MATCH and _FUNCTION from |- _MATCH = \e r. (@) (r e) |- _FUNCTION = \r x. (@) (r x) to |- _MATCH = \e r. if (?!) (r e) then (@) (r e) else @z. F |- _FUNCTION = \r x. if (?!) (r x) then (@) (r x) else @z. F I'd discovered painfully that the former does not interact well with the special treatment of tail recursion in the "define.ml" setup, because in general there is some nondeterminacy there. The new definition clears up this problem, and is also perhaps a little more satisfying on general grounds anyway, because it avoids any "accidental" assignments in cases where the match isn't really well-defined, and so provides a bit more automatic debugging. The only changes necessary were to the newish MATCH_CONV. They were fairly non-invasive and should only have a small efficiency cost (the expensive unwinding etc. is only done once even though the predicate appears twice in the underlying expression). Tue 16th Oct 2007 sets.ml Added the infinitude of the new string type: string_INFINITE = |- INFINITE (:(char)list) Fri 12th Oct 2007 printer.ml, parser.ml Finished the job, more or less, by adding printer support for strings too, and also improving the treatment of escapes so they correspond to OCaml (or at least to the OCaml manual). That should more or less give a parse/print equivalence. Fri 12th Oct 2007 list.ml, parser.ml Added a new type "char" defined like the old HOL88 type "ascii" with a constructor ASCII taking 8 Booleans, together with the abbreviation of "string" for "char list" (not a separate type, which aids orthogonality). Added support for strings in the parser. I should probably do a more systematic set of escape sequences; as it is I only have \n, \\ and \". Mon 8th Oct 2007 Examples/sos.ml I'd noticed that my REAL_SOSFIELD was in step with an earlier mistaken optimization of REAL_FIELD, which generated fewer cases but was not in general complete. It probably doesn't matter, but now it's fixed. Mon 8th Oct 2007 Examples/sos.ml I wanted to take a careful look at the iterative deepening I was doing in SOS w.r.t. strict inequalities to make absolutely sure that it was indeed theoretically complete. It does seem all right in principle, though I can think of other state space explorations that might be more efficient to try. But anyway I did spot one little error in the case where there are no strict inequalities in the hypotheses. Changed maximal degree of the polynomial to consider from 0 to 1, since otherwise one is simply duplicating work. From let k = if e = 0 then 1 else d / e in to let k = if e = 0 then 0 else d / e in Tue 11th Sep 2007 basics.ml Removed duplicate definitions of "dest_forall" and "strip_forall" inside the "dest_gabs" function. These were, I guess, a relic of the time when these functions too were defined in "bool.ml", as "mk_forall" still is. This was pointed out by Viorel Preoteasa. Tue 11th Sep 2007 ind-types.ml Added UNWIND_CONV (which was useful as a subroutine in the following, and seems useful enough to expose) and MATCH_CONV to reduce matches applied to specific cases. Also added the "simple" case of MATCH_CONV, where an unambiguous reduction is achieved automatically, to the default conversions. Sat 8th Sep 2007 ind-defs.ml, sets.ml, recursion.ml Added a list "the_inductive_definitions" and associated benignity checking. This was a reaction to the observation by Norbert Voelker that reloading "sets.ml" gives an error because of the inductive definition of FINITE. (For extra credit, I could search for redefinition in exactly the same form with variables in the input, in case it's generated other than by the quotation parser.) However, I had also to add a type constraint to make sure the types in the empty and insert claises really are the same and hence it is an instance. I also discovered I still need benignity checking in "recursion.ml" to handle FINREC. So I added that too, though didn't expose the theorem list in this case. And once again I needed to add a type constrain (many from "list.ml" won't work because the types are insufficiently constrained). All a bit crude and inadequate, but it does solve the top-level problem: "sets.ml" *can* now be reloaded. Fri 7th Sep 2007 Examples/prover9.ml [new file] Added to the standard release the simple prover9 interface I hacked up at Marktoberdorf and slightly refined more recently. It could still use more work (e.g. a disjunctive splitter, and more systematic treatment of "pure equality islands") but it's nice to have. Fri 7th Sep 2007 Examples/update_database.ml Switched the load order of "env.cmo" and "clflags.cmo", so the latter now comes first. This seems to be necessary for 3.10.0? Fri 7th Sep 2007 Examples/pratt.ml, Examples/pocklington.ml Renamed the image name just "gp" not "parigp", which seems to be what it (now) is OOTB. Fri 7th Sep 2007 make.ml Added (and documented) a "checkpoint" function to create a checkpoint with CryoPID. This is a temporary compromise since I have trouble getting it to work cleanly in a batch build. Wed 5th Sep 2007 hol.ml, passim Changed "temp_path" to read the OCaml Filename.temp_dir_name at the outset, though the user can set it. Also modified a few bits and pieces to use this interface consistently (e.g. SOS and Minisat) where previously there was a hardwired "/tmp" pathname. Tue 4th Sep 2007 preterm.ml Added some error traps to produce a "Typechecking error" report rather than the less helpful "not found". Mon 3rd Sep 2007 tactics.ml Put in a fix for an assumption of equality instead of alpha-convertibility of hypotheses into VALID, which indirectly affects "e". Previously, for example, if a goal had an assumption `!x. x = 1`, then using ASSUME(`!z. z = 1`) would give a validty failure. Possibly a more systematic approach would be to replace each "union" with "term_union", but I wanted to be minimally invasive. Mon 3rd Sep 2007 printer.ml Fixed something pointed out by Carl Witty a while ago: a construct `DECIMAL mmm nnn` where nnn is a numeral but not a power of 10 prints misleadingly, e.g. `DECIMAL 99 77` as `#.19`. Mon 3rd Sep 2007 preterm.ml, parser.ml Added a warning if something starting with a digit is not a valid numeral, e.g. `0xgh` or `0b12`. It seems unintuitive to parse this as a variable without any warning. To support this change I moved the character discrimination functions back from "parser.ml" to "preterm.ml". Mon 3rd Sep 2007 bool.ml Recoded IMP_TRANS and EQ_IMP_RULE with more elaborate versions that correspond exactly (I hope) to their specification, taking the union of the assumption list even if some of the implication components are in the assumptions; with the old implementations one could sometimes get fewer assumptions. The case of IMP_TRANS was pointed out on info-hol by Tony Johnson (complaining about HOL4, but it also applies to HOL Light), and I noticed a similar problem with EQ_IMP_RULE when I dived in to fix that. Mon 3rd Sep 2007 printer.ml Modified the printer so it prints parentheses exactly round generalized varstructs and not regular ones. This fixes one flat bug where an iterated mixture of generalized and non-generalized abstractions would print without the parentheses necessary to re-parse the same thing, e.g. `\x y,z. bod` instead of `\x (y,z). bod`. It also seems nice to have a visual cue that generalized and non-generalized abstractions differ even in the unit variable case. I would have liked to establish the same thing on input, but that's not completely trivial given that for a long time things exist as preterms and only get mapped to any sort of abstraction later on. Fri 31st Aug 2007 tactics.ml Fixed a bug in the printing of goalstacks where the boxes inside hypotheses were getting offset by 2, e.g. 1 [`i IN 1 .. dimindex (:?162964) /\ j IN 1 .. dimindex (:?162964) /\ ~(i = j)`] It turns out I'd misunderstood what "print_as" does: it doesn't print a string in a fixed field but just sets the counts as if it did. So I added my own custom function to print the assumption number padded up to 3 digits if it would otherwise be shorter. Fri 31st Aug 2007 make.ml Thanks to an email from Vic Zandy, I finally solved the problem of incorrect PIDs on recent Linuxes. The issue seems to be that the glibc implementation of getpid is cacheing the PID in userspace, so all you have to do is use some other method of getting the PID. Vic suggested reading /proc/self/stat, but for my application it's even easier to look at $PPID. Also, experimenting on Knoppix I found that adding a 1-second sleep before the kill call deals with the intermittent race issue. I don't really understand this but I put it in anyway. Thu 30th Aug 2007 basics.ml, equal.ml Changed "mk_primed_var" so that it ignores hidden constants. This entailed moving it forward a bit till after the "hide" stuff, and therefore I moved it from "basics.ml" to "equal.ml". Thu 30th Aug 2007 lib.ml, grobner.ml, help.ml, meson.ml, tactics.ml A suggestion from Jesse Alama was a quiet loading mode. When experimenting with this I noticed quite a few places where I used raw "print_string" (and occasionally "print_newline" and maybe others) instead of their Format versions, so fixed that for consistency. Tue 28th Aug 2007 parser.ml Fixed a bug in pfrees where "can int_of_string" actually built in a size limitation so large numerals would be treated as variables! Now uses "num_of_string" instead. Tue 28th Aug 2007 parser.ml, pair.ml, printer.ml Added OCaml-like pattern-matching constructs to the parser, together with definitions in "pair.ml" for the supporting constants _SEQPATTERN, _UNGUARDED_PATTERN, _GUARDED_PATTERN, _MATCH and _FUNCTION. The main incompatible change is making the following reserved words: match with function -> when Tue 28th Aug 2007 parser.ml Modified the "nocommapreterm" so it won't fail if "," doesn't have infix parse status (just a trivial little bug I noticed). Tue 28th Aug 2007 realarith.ml Changed some quotations in GEN_LINEAR_PROVER to force them to evaluate here. Although they get partially evaluated anyway when this is applied to the first argument (like LINEAR_PROVER), that still introduces a nasty dependency on the overload prioritization, and I hit this while checking Lars's more general code, discovering that with prioritize_int() set even "GEN_REAL_ARITH REAL_LINEAR_PROVER tm" fails. Mon 27th Aug 2007 meson.ml Removed the default "time" inside the core function so it doesn't automatically report CPU times; I felt the output was already quite verbose enough. Fri 24th Aug 2007 int.ml Fixed bug of using int_sub instead of INT_SUB in the definition of INT_RED_CONV, which was causing evaluation of integer constant expressions to fail. This and the last item while getting my car serviced. Fri 24th Aug 2007 Examples/integer.ml [new file] Put in a convenient place the basic development of divisibility properties over Z. Much of it is automatic with INTEGER_TAC but some slightly tedious hacking is needed for signs of GCDs and suchlike. Fri 24th Aug 2007 fusion.ml Added back an internal list of definitions (called "the_definitions", but not exported and distinct from the same thing defined later) and a function "definitions" to get at them. Mark Adams pointed out that otherwise you can't distinguish axioms that should be sound from those that aren't because they clash with definitions. Thu 23rd Aug 2007 sets.ml Added two theorems that I can hardly believe I'd never wanted before: CARD_DIFF = |- !s t. FINITE s /\ t SUBSET s ==> CARD(s DIFF t) = CARD s - CARD t HAS_SIZE_DIFF = |- !s t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ t SUBSET s ==> s DIFF t HAS_SIZE m - n Sun 29th Jul 2007 Makefile, hol.ml Modified things so that camlp5 more or less automatically gets used if the OCaml version is >= 3.10. Also reduced the proliferation of pa_j files by employing "cut" on the version number to look at the major number only. Wed 25th Jul 2007 real.ml, int.ml Added REAL_LT_SQUARE_ABS = |- !x y. abs x < abs y <=> x pow 2 < y pow 2 and INT_LT_SQUARE_ABS = |- !x y. abs x < abs y <=> x pow 2 < y pow 2 Mon 23rd Jul 2007 iter.ml, passim Added a theorem from Lars Schewe, though this time with a different proof using SUM_POS_EQ_0. SUM_ZERO_EXISTS = |- !u s. FINITE s /\ sum s u = &0 ==> (!i. i IN s ==> u i = &0) \/ (?j k. j IN s /\ u j < &0 /\ k IN s /\ u k > &0) Added Lars to copyright for this file and took the chance to update all the others from "2006" to "2007". Mon 23rd Jul 2007 hol.ml and a few others Changed HOLDIR to HOLLIGHT_DIR at Hasan's request, to make it easier to work in a multi-HOL environment. Mon 23rd Jul 2007 Minisat/zc2mso [new directory] Added Hasan's new "zc2mso" translator, the C++ source and README. Also slightly modified the main README to point out its existence. Fri 13th Jul 2007 real.ml Added REAL_LE_MUL_EQ = |- (!x y. &0 < x ==> (&0 <= x * y <=> &0 <= y)) /\ (!x y. &0 < y ==> (&0 <= x * y <=> &0 <= x)) REAL_LT_MUL_EQ = |- (!x y. &0 < x ==> (&0 < x * y <=> &0 < y)) /\ (!x y. &0 < y ==> (&0 < x * y <=> &0 < x)) Wed 11th Jul 2007 sets.ml Fixed FINITE_RESTRICT to |- !s P. FINITE s ==> FINITE {x | x IN s /\ P x} instead of vacuous quantifeer |- !s p. FINITE s ==> FINITE {x | x IN s /\ P x} as pointed out by Lars Schewe. Wed 11th Jul 2007 iter.ml Added some new theorems about sums, based on Lars Schewe's files, and using some of the same proofs modulo trivial changes. First of all, renamed the old ITERATE_CASES -> ITERATE_EXPAND_CASES in order to make the more natural namespace available. Then added ITERATE_INCL_EXCL = |- !op. monoidal op ==> (!s t f. FINITE s /\ FINITE t ==> op (iterate op s f) (iterate op t f) = op (iterate op (s UNION t) f) (iterate op (s INTER t) f)) ITERATE_CASES = |- !op. monoidal op ==> (!s P f g. FINITE s ==> iterate op s (\x. if P x then f x else g x) = op (iterate op {x | x IN s /\ P x} f) (iterate op {x | x IN s /\ ~P x} g)) as well as versions for natural number sums NSUM_INCL_EXCL = |- !s t f. FINITE s /\ FINITE t ==> nsum s f + nsum t f = nsum (s UNION t) f + nsum (s INTER t) f NSUM_CASES = |- !s P f g. FINITE s ==> nsum s (\x. if P x then f x else g x) = nsum {x | x IN s /\ P x} f + nsum {x | x IN s /\ ~P x} g and real sums: SUM_INCL_EXCL = |- !s t f. FINITE s /\ FINITE t ==> sum s f + sum t f = sum (s UNION t) f + sum (s INTER t) f SUM_CASES = |- !s P f g. FINITE s ==> sum s (\x. if P x then f x else g x) = sum {x | x IN s /\ P x} f + sum {x | x IN s /\ ~P x} g Wed 11th Jul 2007 calc_rat.ml, Complex/complex.ml Undid the change to the two FIELD rules made on 23rd Feb 06, though keeping the two later tweaks (inverse-inverse and checking freeness). The problem is that sometimes the "inefficient" case split is necessary to pick up correlations between nonzeroness assumptions. I thought this was more important than efficiency. For example, the following previously failed: REAL_FIELD `~(c = &0) /\ ~(c' = &0) /\ ~(c * c' - s * s' = &0) ==> (s * c' + c * s') / (c * c' - s * s') = (s / c + s' / c') / (&1 - s / c * s' / c')`;; even though both the following worked: REAL_FIELD `~(c = &0) /\ ~(c' = &0) /\ ~(c * c' - s * s' = &0) /\ ~(&1 - s / c * s' / c' = &0) ==> (s * c' + c * s') / (c * c' - s * s') = (s / c + s' / c') / (&1 - s / c * s' / c')`;; REAL_FIELD `~(c = &0) /\ ~(c' = &0) /\ ~(c * c' - s * s' = &0) ==> ~(&1 - s / c * s' / c' = &0)`;; Now they all work, albeit a bit more slowly. Wed 23rd May 2007 Multivariate/vectors.ml Installed NORM_ARITH in the main file and already used it in several places in place of explicit proofs. Tue 22nd May 2007 Examples/sos.ml Added a little wrapper REAL_NONLINEAR_SUBST_PROVER round REAL_NONLINEAR_PROVER, which tries to first substitute variables in equations. This must almost invariably be a good idea. The particular motivation was the application of Solovay's procedure to the triangle law, which gives rise to the real problem: |- &0 <= c /\ &0 <= z /\ z pow 2 = h pow 2 * d + c /\ &0 <= y /\ y pow 2 = d /\ &0 <= x /\ x pow 2 = d + &2 * h * d + h pow 2 * d + c /\ y + z < x ==> F With the substitution this takes about 18 seconds; without it about 180. So here it's worthwhile, and I guess this is true more generally. Tue 1st May 2007 simp.ml Well, backed off that change for a while, since it broke things in Jordan/metric_spaces.ml and I ended up not really using it myself. Tue 24th Apr 2007 simp.ml Modified ONCE_DEPTH_SQCONV and ONCE_SIMPLIFY_CONV so that the prover list in the subcalls is modified to try assumption if all else fails. Then modified ONCE_SIMP_TAC (and so implicitly ONCE_ASM_SIMP_TAC) so that they handle the possible new assumption and split it off as a subgoal. The net effect, I hope, is that ONCE_SIMP_TAC will now actually be useful for cases where you really want to split off the lemma. Tue 13th Mar 2007 iter.ml Added SUM_DELETE_CASES = |- !f s a. FINITE s ==> sum (s DELETE a) f = (if a IN s then sum s f - f a else sum s f) Tue 13th Feb 2007 Added a theorem that only recently occurred to me; it can occasionally be useful not to have to discharge a nonnegativity assumption when the exponent is odd. REAL_POW_LE2_ODD = |- !n x y. x <= y /\ ODD n ==> x pow n <= y pow n Added the counterpart for the integers and also some other theorems I seem to have forgotten to transfer: INT_LE_SQUARE_ABS = |- !x y. abs x <= abs y <=> x pow 2 <= y pow 2 INT_SOS_EQ_0 = |- !x y. x pow 2 + y pow 2 = &0 <=> x = &0 /\ y = &0 INT_POW_LE2_ODD = |- !n x y. x <= y /\ ODD n ==> x pow n <= y pow n Sat 3rd Feb 2007 tactics.ml Realized I'd put the tweaked error message only in a place where failure will occur if there is a current goal but it has no subgoals. Reworded that one slightly and added it where I should have, in "refine". Thu 1st Feb 2007 iter.ml Added SUM_DIFFS = |- !m n. sum (m..n) (\k. f k - f (k + 1)) = (if m <= n then f m - f (n + 1) else &0) Wed 31st Jan 2007 itab.ml Made a small tweak to the G3 implementation, which I noticed when reminding myself about stuff in order to answer a question on hol-info. In the left-implication rule, I was using FIRST_ASSUM, but it should/could be FIRST_X_ASSUM, I guess. Wed 31st Jan 2007 Makefile Added "hol.complex" to the Makefile, since I'm using it heavily at the moment, and it's becoming non-trivial. Wed 31st Jan 2007 parser.ml, tactics.ml Changed some annoying error messages, the "unexpected junk" to "unparsed input" and also a more informative error than "hd" when trying to apply a tactic with no goals. Mon 22nd Jan 2007 simp.ml Fixed a plain bug in ABBREV_TAC which failed when abbreviations had more than one argument due to a trivial blunder. Sun 21st Jan 2007 sets.ml Added a suite of theorems to capture a pattern of reasoning I seem to go through very often: TRANSITIVE_STEPWISE_LE = |- !R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!n. R n (SUC n)) ==> (!m n. m <= n ==> R m n) TRANSITIVE_STEPWISE_LT = |- !R. (!x y z. R x y /\ R y z ==> R x z) /\ (!n. R n (SUC n)) ==> (!m n. m < n ==> R m n) TRANSITIVE_STEPWISE_LE_EQ = |- !R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) ==> ((!m n. m <= n ==> R m n) <=> (!n. R n (SUC n))) TRANSITIVE_STEPWISE_LT_EQ = |- !R. (!x y z. R x y /\ R y z ==> R x z) ==> ((!m n. m < n ==> R m n) <=> (!n. R n (SUC n))) Sat 20th Jan 2007 sets.ml Added IMAGE_UNIONS = |- !f s. IMAGE f (UNIONS s) = UNIONS (IMAGE (IMAGE f) s) Tue 16th Jan 2007 iter.ml Added four new theorems relevant to iterated operations: MONOIDAL_AC = |- !op. monoidal op ==> (!a. op (neutral op) a = a) /\ (!a. op a (neutral op) = a) /\ (!a b. op a b = op b a) /\ (!a b c. op (op a b) c = op a (op b c)) /\ (!a b c. op a (op b c) = op b (op a c)) ITERATE_OP = |- !op. monoidal op ==> (!f g s. FINITE s ==> iterate op s (\x. op (f x) (g x)) = op (iterate op s f) (iterate op s g)) ITERATE_SUPERSET = |- !op. monoidal op ==> (!f u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f x = neutral op) ==> iterate op v f = iterate op u f) ITERATE_IMAGE_NONZERO = |- !op. monoidal op ==> (!g f s. FINITE s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) /\ f x = f y ==> g (f x) = neutral op) ==> iterate op (IMAGE f s) g = iterate op s (g o f)) The penultimate one made me realize that the finiteness condition on NSUM_SUPERSET and SUM_SUPERSET was superfluous, so I removed it. Mon 15th Jan 07 pair.ml, wf.ml, Examples/hol88.ml, passim Retired PAIRED_BETA_CONV, moving it from "pair.ml" just into the HOL88 compatibility files. In a handful of modern proofs scrubbed it when it's now subsumed by rewrites; in older files mechanically changed to "GEN_BETA_CONV". In the process, I've quietly generalized let_CONV to work over other varstructs subject to analogous restrictions to the pair instance. Mon 15th Jan 07 class.ml, trivia.ml, pair.ml, num.ml, ind-types.ml Changed "inductive_type_store" to be built up one at a time as the new types are added, really just so that GEN_BETA_CONV on pairs already works inside the pairs file plus a bit of intellectual consistency. Mon 15th Jan 07 pair.ml Added LAMBDA_PAIR_THM = |- (\p. P p) = (\(x,y). P (x,y)) Mon 15th Jan 07 iter.ml Added the following suite, which are just tedious enough not to want to derive by hand when needed: ITERATE_UNION_NONZERO = |- !op. monoidal op ==> (!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f x = neutral op) ==> iterate op (s UNION t) f = op (iterate op s f) (iterate op t f)) NSUM_UNION_NONZERO = |- !f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f x = 0) ==> nsum (s UNION t) f = nsum s f + nsum t f SUM_UNION_NONZERO = |- !f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f x = &0) ==> sum (s UNION t) f = sum s f + sum t f Sat 13th Jan 07 iter.ml Added the following; I already have the vector version, and I didn't yet decide to add the natural number version. Should really do a generic one. SUM_IMAGE_NONZERO = |- !d i s. FINITE s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d (i x) = &0) ==> sum (IMAGE i s) d = sum s (d o i) Thu 11th Jan 07 sets.ml Added another theorem: INTER_UNIONS = |- (!s t. UNIONS s INTER t = UNIONS {x INTER t | x IN s}) /\ (!s t. t INTER UNIONS s = UNIONS {t INTER x | x IN s}) Wed 13th Dec 06 Examples/hol88.ml, Examples/analysis.ml Fixed bugs in the local MK_ABS and MK_EXISTS (which is not the usual version). In both cases they had SUB_CONV instead of BINOP_CONV; this was formerly masked because until I recoded it, SUB_CONV would quietly return a reflexive theorem if the core conversion failed. Thu 7th Dec 06 term.ml Again inspired by work on Holst, recoded "vsubst" to avoid using set operations, via a generalization of "variant" (and consequently "variants" too) to avoid all free variables of the terms in the avoid list. This is doubly nicer since it avoids set operations and corresponds better to what I've actually verified in Model; those could be brought closer in step. Also, orthogonally really, made Boultonization work properly in the abstraction case. Wed 6th Dec 06 Examples/sos.ml Recoded REAL_NONLINEAR_PROVER to do a better job with trivial hypotheses. This was stimulated by a failure Laurent hit experimenting with the Coq port: REAL_SOS `&0 <= (r - r1) * (r1 - r) ==> &0 <= (r0 - r2) * (r2 - r0) ==> r1 * (r0 - r2) + r * (r2 - r2) + r1 * (r2 - r0) = &0 ==> r1 - r = &0`;; The fact that one hypothesis is trivial caused all the parameters of the ideal cofactor to "disappear" and give lookup failures afterwards. Tue 28th Nov 06 bool.ml Recoded GEN in a more elegant and efficient way. The old version was an MP relic, and it didn't do alpha-conversion very cleverly. Also tweaked EXISTS to use PROVE_HYP rather than MP. Nearly did the same to CHOOSE, but I was getting too tired to figure out for sure whether we can guarantee that PROVE_HYP will be non-trivial (all this is on the train back to Nice). Did do the same to DISJ1 and DISJ2; also fixed the exception from the latter, which was a cut-and-paste error of "DISJ1", and a similar one in "NOT_INTRO" which was a cut-and-paste "NOT_ELIM". Tue 28th Nov 06 equal.ml Recoded SUB_CONV, BINOP_CONV and DEPTH_BINOP_CONV to be a little more delicate, not that it really matters. Mon 20th Nov 06 define.ml Added clauses to scrub distinctness theorems of the form "2 * n + 1 = 2 * m + 1". This was a bit ad hoc to make "recounting the rationals" work as given, but it's reasonable as a general idea. Sun 19th Nov 06 thm.ml Recoded several primitive rules to use pattern-matching rather than the destructor functions. The efficiency gain seems real though unspectacular (around 4%) and in any case the result is slightly shorter and arguably clearer. Sun 19th Nov 06 thm.ml Changed "rator" and "rand" to use pattern-matching. Also noticed this as a result of Holst. Fri 17th Nov 06 term.ml Slightly recoded variant to use pattern-matching and the Var constructor directly (might as well since we're here!) Came across these while starting Holst on the train from Nice to Lyon. Mon 23rd Oct 06 iter.ml Fixed some faulty trivial quantifiers in NUMSEG_COMBINE_L and NUMSEG_COMBINE_R, pointed out by Lars Schewe. Mon 9th Oct 06 lib.ml, nets.ml Decommissioned the orderings like "=?" and " &0 < x / y`;; REAL_SOSFIELD `&0 <= x /\ &0 < y ==> &0 <= x / y`;; REAL_SOSFIELD `&1 < y /\ ~(z = &0) /\ abs z <= x ==> ~(x <= x / y)`;; I also noticed that there's an unused expression in the existing REAL_FIELD (I must have condensed it into the next expression and not deleted the abbreviation) which I deleted. Thu 13th Jul 06 bool.ml, calc_int.ml, calc_rat.ml, sys.ml, hol.ml, Examples/poly.ml Fixed the permissions on these files, which were unreadable for "other" users. This was pointed out by Nobuki Takayama as part of the ICMS preparation. ********************** RELEASE OF VERSION 2.20 ********************** Wed 17th May 06 tactics.ml After doing enough regression testing (particularly no changes at all to the Jordan proof), I plucked up the courage and inserted the new CONJUNCTS_THEN2 implementation which ASSUMEs the two conjuncts. I hope this will be a less invasive way of counteracting the counterintuitive effects of spurious free variables "hiding" in the goal. Wed 17th May 06 class.ml Added a quite distinct benignity mechanism and a list "the_specifications" (the old one was lost in the last change and perhaps wasn't entirely satisfactory since the original plan was not to expose the underlying definition). Wed 17th May 06 drule.ml, pair.ml Moved all the benignity, including the definition of the initial (now somewhat larger) list "the_definitions", into "pair.ml" so it directly returns the theorems from that, which is what's mainly used later. Tue 16th May 06 drule.ml Changed "the_definitions" to be as entered by the user, since Steve Brackin preferred this and I don't have any reason for this other than checking benignity. Tue 16th May 06 realax.ml Changed one proof not to rely on the fact that CONJUNCTS_THEN doesn't use ASSUMEd conjuncts. This is in the hope that I may actually manage to switch over to that, avoiding most of the confusion currently caused. Fri 12th May 06 parser.ml Changed the internal definition of "pfrees" used in set abstractions to check also whether some name has an interface mapping and if so count it as a constant. Otherwise there could be issues with overloaded constants being treated as variables in set abstractions, e.g. `onorm (f:real^M->real^N) = sup { norm(f x) | norm(x) = &1 }`;; Fri 12th May 06 preterm.ml Added a flag "type_invention_warning" to control the "inventing type variables" warning. This was inspired by Cezary, who wanted to disable these warnings and had rewritten some of the code himself to remove it; this would now have required even more duplicate-and-tweak now that "stvs_translated" is hidden. Thu 11th May 06 realax.ml Removed "real_lift_function", replacing the only uses by mapping the definition over lists. Thu 11th May 06 define.ml Renamed "pure_prove_general_recursive_function_exists" as simply "pure_prove_recursive_function_exists". The name was too long for the reference manual banner. Of course that's not such a good reason... Thu 11th May 06 tactics.ml Hid "print_hyp" and "print_hyps" inside "print_goal" and "print_goalstate" inside "print_goalstack". Thu 11th May 06 realax.ml Also removed "real_lift_theorem", replacing the only use by its definition. Thu 11th May 06 drule.ml Hid "match_bvs" inside "PART_MATCH"; it was not used anywhere else. And hid "tryalpha" inside "deep_alpha". And deleted "unify_terms". I'm a bit mystified why that's there as well as "term_unify"; the latter is at least used! Wed 10th May 06 simp.ml, Examples/mizar.ml Removed LIMITED_REWRITE_CONV, which was an egregious hack, and put in in Examples/mizar.ml, which contains the only use of it. Wed 10th May 06 thm.ml, meson.ml Removed "le_thm" and replaced the one application with its definition. Wed 10th May 06 realax.ml Hid "hreal_lift_fn" and "hreal_lift_thm". Wed 10th May 06 simp.ml Hid GEN_SUB_CONV, IMP_REWRITES_CONV and RUN_SUB_CONV. Wed 10th May 06 parser.ml Added a "string" type constraint into "install_parser", which otherwise has an undetermined type for the tags. Wed 10th May 06 ind-types.ml Removed RECTYPE_EQ_CONV, which was never used in the latest "define". Wed 10th May 06 bool.ml, passim Added "mk_iff" and "dest_iff" and renamed "is_beq" to "is_iff". Pity to make an incompatible change but it seems far more intuitive. Wed 10th May 06 ind-types.ml Again hid a lot of internal stuff: sucivate, SCRUB_EQUATION, justify_inductive_type_model, prove_model_inhabitation, define_inductive_type, define_inductive_type_constructor, instantiate_induction_theorem, pullback_induction_clause, finish_induction_conclusion, derive_induction_theorem, create_recursive_functions, create_recursion_iso_constructor, derive_recursion_theorem, generalize_recursion_theorem, define_type_mutual, TRIV_ANTE_RULE, ISO_EXPAND_CONV, lift_type_bijections, DE_EXISTENTIALIZE_RULE, grab_type, clause_corresponds, prove_inductive_types_isomorphic, SCRUB_ASSUMPTION, define_type_basecase, SIMPLE_BETA_RULE, ISO_USAGE_RULE, SIMPLE_ISO_EXPAND_RULE, REWRITE_FUN_EQ_RULE, define_type_nested. What used to be called "define_type_nested" is now called "define_type_raw" (which was formerly a limited and not specially useful version used in bootstrapping). Wed 10th May 06 preterm.ml, parser.ml Hid the following "internal" things: new_type_var, reset_type_num [actually deleted that completely], pretype_subst, pretype_instance, get_generic_type, istrivial, unify, typify, resolve_interface, solve, solve_preterm and stvs_translated. Removed pmk_eq, pmk_conj and split_ppair. Hid pmk_let, pmk_set_enum, pfrees, pmk_setabs, pmk_setcompr, pmk_vbinder, pmk_binder, pmk_cv, pmk_numeral, pgenvar, split_ppair, pmk_conj, pmk_exists. Added a few of these needed back to Examples/mizar.ml. Wed 10th May 06 lib.ml, preterm.ml Moved "num_of_string" from "preterm.ml" to "lib.ml". It seemed an unnatural fit, even though its primary purpose is indeed for parsing etc. Tue 9th May 06 parser.ml Hid "mk_precedence" and "parse_typed_apreterm", which seemed a bit too ad hoc. Tue 9th May 06 meson.ml Removed two less useful flags: "precheck" and "cache"; in neither case is it really plausible that they'll be changed. Renamed others with too-short names: depth, prefine, dcutin, skew and brand to meson_depth, meson_prefine, meson_dcutin, meson_skew and meson_brand. Hid a whole bunch of internal things in MESON: offinc, inferences, qpartition, reset_vars, fol_of_var, hol_of_var, reset_consts, fol_of_const, hol_of_const, fol_of_term, fol_of_atom, fol_of_literal, fol_of_form, hol_of_term, hol_of_atom, hol_of_literal, fol_free_in, fol_frees, fol_subst, fol_substl, fol_inst, fol_subst_bump, fol_inst_bump, istriv, fol_unify, fol_eq, cacheconts, checkan, insertan, fol_subst_partial, separate_insts, meson_single_expand, meson_expand_cont, meson_expand, expand_goal, solve_goal, fol_of_hol_clauses, optimize_rules, clear_contrapos_cache, make_hol_contrapos, meson_to_hol, create_equality_axioms, perform_brand_modification, POLY_ASSUME_TAC, SIMPLE_MESON_REFUTE, PURE_MESON_TAC, QUANT_BOOL_CONV, SPLIT_TAC. Mon 8th May 06 define.ml Removed "closed_prove_general_recursive_function_exists", which seemed a bit overspecialized and confusing. Hid various functions inside prove_general_recursive_function_exists, namely: prove_depth_measure_exists, INDUCTIVE_MEASURE_THEN, CONSTANT_MEASURE_THEN, GUESS_MEASURE_THEN, GUESS_WF_THEN, and GUESS_ORDERING_TAC. Hid "EXPAND_PAIRED_ALL_CONV", "SIMPLIFY_CASE_DISTINCTNESS_CLAUSES" and "FORALL_PAIR_CONV" inside "instantiate_casewise_recursion". Hid "tuple_function_existence", "is_applicative", "LAMBDA_PAIR_CONV" and "break_down_admissibility" inside "pure_prove_general_recursive_function_exists". Hid "close_definition_clauses" inside "define". Mon 8th May 06 define.ml, pair.ml Moved GABS_CONV back to "pair.ml", since it seems relatively natural and generally useful; I'm planning to hide most other internal functions in the "define" stuff. Also made it work on standard abstractions too, otherwise it's a bit unnatural as a general building-block. Fri 5th May 06 Proofrecording/diffs/*.ml Carefully went through making sure I'd changed the "copies" inside the Proofrecording library to keep them perfectly in step (modulo only the necessary changes) with the current core. Actually, every single file had at least cosmetic changes required. Thu 4th May 06 equal.ml Inspired by Steve Brackin's question on info-hol, generalized PAT_CONV so you can have multiple position-identifying variables. Thu 4th May 06 class.ml Changed "subst" to "vsubst" inside SELECT_CONV, which is trivial but will save a tiny bit of time. Thu 4th May 06 canon.ml, class.ml Moved REFUTE_THEN into the "class.ml" file, where it seems a more natural fit, and SPLIT_THEN into "meson.ml", since it's only used there and I may eventually rethink all this splitting stuff anyway. Hid SELECT_ELIM_CONV and SELECT_ELIM_ICONV inside SELECT_ELIM_TAC. Actually, I'm a bit confused about why I don't just do REDEPTH_CONV SELECT_CONV instead of this custom SELECT_ELIM_CONV, but I left it as is just in case I'm forgetting something important. Renamed CONDS_ELIM_CONV' as CONDS_CELIM_CONV, which is a bit more consistent with NNFC_CONV. Hid get_heads, get_thm_heads, GEN_FOL_CONV and FOL_CONV inside ASM_FOL_TAC. Wed 3rd May 06 canon.ml, meson.ml Added quick getout clauses for the reflexive case in CONJ_ACI_RULE and DISJ_ACI_RULE. Removed PROP_CNF_CONV and PROP_DNF_CONV. Renamed STRONG_CNF_CONV and STRONG_DNF_CONV to just CNF_CONV and DNF_CONV, and made them descend inside the two core quantifiers so that they subsume the old PROP_CNF_CONV and PROP_DNF_CONV. Also added ASSOC_CONV. Changed MESON to use WEAK_CNF_CONV and then ASSOC_CONV, since that seems more compatible and slightly faster than CNF_CONV. Tue 2nd May 06 canon.ml Modified PRENEX_CONV so it also pulls out existential quantifiers. I tend to use it after Skolemizing so there's no need, but for some sort of general entry point it seems sensible to enhance things. I don't think the lookup time will make a significant difference to anything. Tue 2nd May 06 canon.ml Removed MINISCOPE_CONV. In principle it's quite useful, but it's a bit overspecialized (only does universal quantifiers...) and was never used anywhere. Tue 2nd May 06 canon.ml Added an initial primitive miniscoping to SKOLEM_CONV, to push quantifiers in naively first before doing the Skolemizing, for which the universal quantifiers get pulled out again. I'm not 100% sure this is good / worthwhile, but let's try. Tue 2nd May 06 canon.ml Removed "CNNF_CONV" (NNF with an atom base conversion), which was never used; in the rare cases when this generality is needed, one can use GEN_NNF_CONV. Mon 1st May 06 int.ml, Examples/prime.ml, Examples/pocklington.ml Put in definitions of divisibility, coprimality and gcd over both Z and N. The net new definitions/theorems are, I believe: int_divides = |- !b a. a divides b <=> (?x. b = a * x) int_mod = |- !n x y. mod n x y <=> n divides x - y int_congruent = |- !x y n. (x == y) (mod n) <=> (?d. x - y = n * d) int_coprime = |- !a b. coprime (a,b) <=> (?x y. a * x + b * y = &1) num_divides = |- !a b. a divides b <=> &a divides &b num_mod = |- !n x y. mod n x y <=> mod &n (&x) (&y) num_congruent = |- !x y n. (x == y) (mod n) <=> (&x == &y) (mod &n) num_coprime = |- !a b. coprime (a,b) <=> coprime (&a,&b) num_gcd = |- !a b. gcd (a,b) = num_of_int (gcd (&a,&b)) NUM_GCD = |- !a b. &(gcd (a,b)) = gcd (&a,&b) INT_GCD_EXISTS = |- !a b. ?d. d divides a /\ d divides b /\ (?x y. d = a * x + b * y) INT_GCD_EXISTS_POS = |- !a b. ?d. &0 <= d /\ d divides a /\ d divides b /\ (?x y. d = a * x + b * y) int_gcd = |- !a b. &0 <= gcd (a,b) /\ gcd (a,b) divides a /\ gcd (a,b) divides b /\ (?x y. gcd (a,b) = a * x + b * y) Also defined a mapping "num_of_int" from integers back to natural numbers and proved a few lemmas about it: num_of_int = |- !x. num_of_int x = (@n. &n = x) NUM_OF_INT_OF_NUM = |- !n. num_of_int (&n) = n INT_OF_NUM_OF_INT = |- !x. &0 <= x ==> &(num_of_int x) = x NUM_OF_INT = |- !x. &0 <= x <=> &(num_of_int x) = x Plus a few auxiliary lemmas that I might just want to hide, but perhaps they'll be useful. FORALL_UNCURRY = |- !P. (!f. P f) <=> (!f. P (\a b. f (a,b))) EXISTS_UNCURRY = |- !P. (?f. P f) <=> (?f. P (\a b. f (a,b))) WF_INT_MEASURE = |- !P m. (!x. &0 <= m x) /\ (!x. (!y. m y < m x ==> P y) ==> P x) ==> (!x. P x) WF_INT_MEASURE_2 = |- !P m. (!x y. &0 <= m x y) /\ (!x y. (!x' y'. m x' y' < m x y ==> P x' y') ==> P x y) ==> (!x y. P x y) Also added INTEGER_TAC, INTEGER_RULE, NUMBER_TAC and NUMBER_RULE, which are a first "production" version of the ideal-based hacks I've been using lately. They will probably get some future refinements (especially the number ones, which could probably have their Finally, switched the definition of integers from "new_basic_type_definition" to just "new_type_definition" for benignity. I modified the existing files where such divisibility concepts (over N) were defined, so they use the new definitions and often use NUMBER_TAC instead of manual proofs, but are otherwise identical in structure. I can no doubt substantially improve this, but it's not critical to get to it soon. Mon 1st May 06 class.ml Fixed up "new_specification" to inherit acceptance of benign redefinition from the underlying "new_definition". This meant first not adding an outer check, and second replacing the variable in the input term by a constant if need be. Mon 1st May 06 arith.ml, realax.ml, int.ml Removed all the congruence-related stuff from its various points, as a prelude to a nicer arrangement afterwards. Mon 1st May 06 canon.ml Removed GEN_NNFC_CONV as a separate function, instead adding the same flag argument used internally to GEN_NNF_CONV. So GEN_NNF_CONV |-> GEN_NNF_CONV false GEN_NNFC_CONV |-> GEN_NNF_CONV true Also removed the toplevel binding of GEN_NNF_DCONV, which is a bit over-refined and I never actually used. Fri 28th Apr 06 list.ml Added ITLIST_APPEND = |- !f a l1 l2. ITLIST f (APPEND l1 l2) a = ITLIST f l1 (ITLIST f l2 a) The existing ITLIST_EXTRA is just a special case of this, so possibly I should remove it. Still, it's used once. Thu 27th Apr 06 help.ml [new file], doc-to-help.sed [new file] Introduced simple "help" system on the lines of HOL88. So far it's a little more inflexible, e.g. doesn't have a separate help path, but I might think about later generalizations. Couldn't resist adding a cool hack to compute the "edit distance" (aka Levenshtein distance) between two strings and try to guess what you meant. Thu 27th Apr 06 canon.ml Corrected DISJ_CANON_CONV, which simply didn't work, since several things were not modified from cut-and-pasting CONJ_CANON_CONV. Thu 27th Apr 06 canon.ml Changed DEPTH_CONV to TOP_DEPTH_CONV in PRESIMP_CONV, since several of the transformations are inherently top-down. Thu 27th Apr 06 preterm.ml, int.ml, realax.ml, real.ml Added a new function "prioritize_overload" that essentially prioritizes the first instance of each thing where the desired type appears as an instantiation of one of the type variables in the generic type. Made prioritize_num, prioritize_int, prioritize_real all just instances of this. The main point is that then it "automatically" expands to cover newly defined overloaded constants without continual redefinition of the prioritizer functions. Also renamed "mod_nat" as "nat_mod"; "mod_int" as "int_mod", and "mod_real" as "real_mod"; these are more consistent with the usual naming conventions. Also redefined "real_mod", which was stupidly trivial; moved its definition into "int.ml" so I could use the "is_int" property. Fri 21st Apr 06 lib.ml A relatively trivial change: modified the implementation of "allpairs" to be less hacky-combinatorial and probably slightly more efficient. Not that it really matters, of course... Fri 21st Apr 06 int.ml Dumped in all the operations on integers, analogous to the ones over reals: INT_LE_CONV INT_LT_CONV INT_GE_CONV INT_GT_CONV INT_EQ_CONV INT_NEG_CONV INT_MUL_CONV INT_ADD_CONV INT_SUB_CONV INT_POW_CONV INT_ABS_CONV INT_RED_CONV INT_REDUCE_CONV as well as instantiations of the normalizer and ring/ideal procedures: INT_POLY_CONV INT_RING int_ideal_cofactors Thu 20th Apr 06 sets.ml Added a stronger form of set induction, which can be useful: FINITE_INDUCT_DELETE = |- !P. P {} /\ (!s. FINITE s /\ ~(s = {}) ==> (?x. x IN s /\ (P (s DELETE x) ==> P s))) ==> (!s. FINITE s ==> P s) Thu 20th Apr 06 int.ml, Examples/floor.ml Changed "dest_int" to "real_of_int" and "mk_int" to "int_of_real". These are much more natural and people may really want to use them. I now removed interface mappings with similar effect from "Examples/floor.ml". The only remaining thing I should probably do is unify "integer" and "is_int", but that's a lower priority. It might also be nice to rename things like "int_le" so that the correspondence with real is perfect. Call that "int_le_def" and move the current INT_LE to int_le etc. Thu 20th Apr 06 int.ml Added "dest_intconst", "is_intconst" and "mk_intconst" as the start of a campaign to bring type "int" up to a more equal footing with "real". Wed 19th Apr 06 calc_int.ml Decomissioned "is_numconst", "dest_numconst" and "mk_numconst"; except for an odd use in the Maxima interface (now changed), these were little used. Also systematically renamed "[is|mk|dest]_intconst" as "[is|mk|dest|]_realintconst", since this is a bit more intuitive and makes room for those names for the type of integers. Mon 17th Apr 06 iter.ml Added a third congruence variant for iterated operations, this time for "iterator {x | P x}" assuming "P x" rather than "x IN {x | P x}" which is what the default will give. Mon 17th Apr 06 iter.ml Changed "[N]SUM_CMUL" to "[N]SUM_LMUL" and added right-handed variants "[N]SUM_RMUL": |- !f c s. nsum s (\x. f x * c) = nsum s f * c |- !f c s. sum s (\x. f x * c) = sum s f * c It was starting to get silly how often I was generating these by manually rewriting. Fri 14th Apr 06 grobner.ml, calc_rat.ml, Complex/complex.ml Made two significant changes to Grobner bases. The first is rather trifling; changed the existential variable in the Rabinowitsch theorems from "d" to "z". Since this puts it at or near the end of the resulting variable order, it matters! At least on one important example, it makes things significantly better, though I don't know how stable that is; I'm about to run tests. The other is more interesting: in the case where there are only positive equations (e.g. the Rabinowitsch trick has been pre-applied) and we have a true ring, I directly execute the "history" proof trace rather than create the intermediate cofactors list, which can sometimes really blow up. Fri 14th Apr 06 cart.ml Changed the ML binding of the definition of "finite_index" to "finite_index" rather than "index_def". Fri 14th Apr 06 calc_int.ml, calc_rat.ml Cleaned up a few places replacing "COMB2_CONV (RAND_CONV c) c" with just "BINOP_CONV c", which is simpler and probably slightly more efficient. Fri 14th Apr 06 drule.ml, calc_rat.ml Remove the ad-hoccery of "REAL_INT_POS_CONV" and "REAL_INT_POS_PROVE", replacing them by a potentially more generally useful function MP_CONV, which eliminates the antecedent of an implicational theorem |- p ==> q by applying a conversion, which may either return "p <=> T" or just "p". Fri 14th Apr 06 calc_rat.ml Deleted REAL_INT_RAT_UNOP_CONV, which in fact wasn't used at all. Replaced REAL_INT_RAT_BINOP_CONV by its trivial definition; actually made it more trivial by using BINOP_CONV. Also replaced REAL_RAT_INT_CONV by its definition and deleted it. Fri 14th Apr 06 sets.ml Added yet another few theorems about set bijections. I get the feeling that this disparate collection of lemmas is rather spinning out of control and needs to be rationalized. Anyway: BIJECTIONS_HAS_SIZE = |- !s t f g. (!x. x IN s ==> f x IN t /\ g (f x) = x) /\ (!y. y IN t ==> g y IN s /\ f (g y) = y) /\ s HAS_SIZE n ==> t HAS_SIZE n BIJECTIONS_HAS_SIZE_EQ = |- !s t f g. (!x. x IN s ==> f x IN t /\ g (f x) = x) /\ (!y. y IN t ==> g y IN s /\ f (g y) = y) ==> (!n. s HAS_SIZE n <=> t HAS_SIZE n) BIJECTIONS_CARD_EQ = |- !s t f g. (FINITE s \/ FINITE t) /\ (!x. x IN s ==> f x IN t /\ g (f x) = x) /\ (!y. y IN t ==> g y IN s /\ f (g y) = y) ==> CARD s = CARD t Thu 13th Apr 06 grobner.ml, calc_rat.ml Put a simple Rabinowitsch parameter into RING, and made the real version use it. Indeed, it seems that this can make quite a difference. One example I tried went from a minute (generating a degree-3 strong certificate in the biggest subcase) to 3 seconds. There may be some still more dramatic cases. Thu 13th Apr 06 calc_rat.ml, Complex/complex.ml Tweaked the implementations of REAL_FIELD and COMPLEX_FIELD so they do splitting up first, and separately introduce the inversion hypotheses for each conjunct. In some cases, this may save quite a few cases. For example, on the cubic, we went down from 68 cases to 32. This is still not a complete answer to its inefficiency, though: to cure that we need to tackle the underlying procedure. Perhaps I'll try aplying the Rabinowitsch trick first to avoid the overhead generating strong Nullstellensatz certificates? Thu 13th Apr 06 arith.ml, grobner.ml Finally got round to tracing why the ARITH_TAC calls in Zagier's 2-squares proof are so excruciatingly slow. Realized that the forms of theorems like SUB_ELIM_THM are stupid, because they have two separate instances of P on the right, "P d" and "P 0". It's much better to keep them as "P d" but have a "d = 0" assumption. Otherwise, you may be creating twice as many other instances, and getting doubly exponential performance! Accordingly, changed the elimination theorems and incorporated them into NUM_SIMPLIFY_CONV. Also made it behave better with respect to formula sense when introducing quantifiers, by also defining "existential" variants: PRE_ELIM_THM = |- P (PRE n) <=> (!m. n = SUC m \/ m = 0 /\ n = 0 ==> P m) PRE_ELIM_THM' = |- P (PRE n) <=> (?m. (n = SUC m \/ m = 0 /\ n = 0) /\ P m) SUB_ELIM_THM = |- P (a - b) <=> (!d. a = b + d \/ a < b /\ d = 0 ==> P d) SUB_ELIM_THM' = |- P (a - b) <=> (?d. (a = b + d \/ a < b /\ d = 0) /\ P d) DIVMOD_ELIM_THM = |- P (m DIV n) (m MOD n) <=> (!q r. n = 0 /\ q = 0 /\ r = 0 \/ m = q * n + r /\ r < n ==> P q r) DIVMOD_ELIM_THM' = |- P (m DIV n) (m MOD n) <=> (?q r. (n = 0 /\ q = 0 /\ r = 0 \/ m = q * n + r /\ r < n) /\ P q r) Thu 13th Apr 06 parser.ml Took the plunge and rewrote the precedence parser so it collects all operators with the same parse status in bunches. This was stimulated by the fact that after the recent modifications, something in Tom's Jordan proof failed because when using a binary operator "+." with the same precedence as "+", the input "a +. b + c" was parsed as "(a +. b) + c". Wed 12th Apr 06 parser.ml, preterm.ml Added support for type abbreviations: new_type_abbrev remove_type_abbrev type_abbrevs These are applied each time the type parser is looking at an atomic string. Wed 12th Apr 06 hol.ml Tweaked "load_on_path" so it only adds to the list of loaded files after the load. In some ways this seems more reasonable, since "already loaded" is a bit misleading if the load failed. Of course, one advantage of doing things the old way would be the impossibility of infinite loops... Wed 12th Apr 06 Examples/pocklington.ml Added a completely stupid factoring algorithm as a catchall; this is invoked either for small numbers (< 2^25 currently; the naive algorithm starts to take of the order of a second for primes of this size) or when the call to PARI/GP fails, e.g. because it's not installed. Tue 11th Apr 06 bool.ml Took away the initial infix of "=", which gets overwritten anyway. Very trivial but... Tue 11th Apr 06 iter.ml Added some theorems that are a bit specialized but capture quite a common situation, where you iterate something composed with an injective function from a finite set into itself: ITERATE_INJECTION = |- !op. monoidal op ==> !f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> iterate op s (f o p) = iterate op s f NSUM_INJECTION = |- !f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> nsum s (f o p) = nsum s f SUM_INJECTION = |- !f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> sum s (f o p) = sum s f Tue 11th Apr 06 preterm.ml Enhanced "num_of_string" to handle binary numbers with notation "0b". Also put in an error check for empty digit lists in the based case; previously, for example, "0x" was quietly accepted as zero! Mon 10th Apr 06 grobner.ml Fixed a strikingly trivial error in the ideal part of RING_AND_IDEAL_CONV, where I'd missed a prime from "pol'", and so was failing by seeing that the original polynomial is nonzero. Mon 10th Apr 06 cart.ml, ind-types.ml Removed the "inductive type" definitions of the types ":2" and ":3". Added a function "define_finite_type", and made ":2" and ":3" instances of that. Derived all these theorems, some for the type ":1" which is defined the same old way: HAS_SIZE_1 = |- (:1) HAS_SIZE 1 HAS_SIZE_2 = |- (:2) HAS_SIZE 2 HAS_SIZE_3 = |- (:3) HAS_SIZE 3 DIMINDEX_1 = |- dimindex (:1) = 1 DIMINDEX_2 = |- dimindex (:2) = 2 DIMINDEX_3 = |- dimindex (:3) = 3 Mon 10th Apr 06 cart.ml Added DIMINDEX_UNIQUE = |- (:A) HAS_SIZE n ==> dimindex (:A) = n Mon 10th Apr 06 theorems.ml, passim. Finally added EQ_IMP = |- (a <=> b) ==> a ==> b which I seem to use a great deal as a prelude to congruence reasoning. Changed numerous explicit TAUT instances into that. Mon 10th Apr 06 arith.ml Added two occasionally useful and very natural rewrites: EVEN_SUB = |- !m n. EVEN (m - n) <=> m <= n \/ (EVEN m <=> EVEN n) ODD_SUB = |- !m n. ODD (m - n) <=> n < m /\ ~(ODD m <=> ODD n) Mon 10th Apr 06 iter.ml Added some theorems about iterations over sets with deleted elements. Note that the REAL one is a bit different, presumably more convenient in a ring. ITERATE_DELETE = |- !op. monoidal op ==> !f s a. FINITE s /\ a IN s ==> op (f a) (iterate op (s DELETE a) f) = iterate op s f NSUM_DELETE = |- !f s a. FINITE s /\ a IN s ==> f a + nsum (s DELETE a) f = nsum s f SUM_DELETE = |- !f s a. FINITE s /\ a IN s ==> sum (s DELETE a) f = sum s f - f a ITERATE_DELETE NSUM_DELETE Mon 10th Apr 06 arith.ml, grobner.ml Hid NUM_MULTIPLY_CONV inside NUM_SIMPLIFY_CONV; that's actually the only place where it's used. Mon 10th Apr 06 grobner.ml Completely hid almost all the internal functions inside RING_AND_IDEAL_CONV. (After carefully confirming that they weren't used anywhere, or anywhere interesting anyway.) So now all of the following are hidden away: morder_lt morder_le morder_gt grob_neg grob_add grob_sub grob_mmul grob_cmul grob_mul grob_inv grob_div grob_pow mdiv mlcm reduce1 reduceb reduce orthogonal spoly monic forder poly_lt align poly_eq memx criterion2 constant_poly grobner_basis grobner_interreduce grobner grobner_refute resolve_proof grobner_weak grobner_ideal grobner_strong Sat 8th Apr 06 grobner.ml Fixed a little error in "grobvars", which was descending to the "x" in all terms of the form "x pow n", without checking if "n" is a numeral. This was inconsistent with the actual normalizer functions, which treat "x pow n" for non-numeral n as atomic variables. For example this now works, whereas before: # REAL_RING `!x:real. &2 pow n = x ==> x = &2 pow n`;; Exception: Failure "grobify_term: unknown or invalid term". Fri 7th Apr 06 printer.ml Added ".." and "$" to the unspaced_binops. Don't know why I didn't think of it before. Fri 7th Apr 06 arith.ml, sets.ml, Examples/analysis.ml Fixed more cases of "=" that should be "<=>"; the error was only apparent because of the slight reshuffling of the precedences. In fact I discovered all but one by deliberately upping the precedence of "=" to 13 temporarily. Fri 7th Apr 06 parser.ml Modified the sorting of the infixes list to make it a canonical ordering, lexicographically by precedence, then fixity (left is higher) then alphabetical name of the operator. This was motivated by the fact that adding "CROSS" the other day had actually changed the order of "<" and "=" and affected parsing, albeit only on formulas that were "wrong". Fri 7th Apr 06 normalizer.ml Removed SEMIRING_NORMALIZE_CONV; after all it's only a small wrap round SEMIRING_NORMALIZERS_CONV, and was only used once in the core. Thu 6th Apr 06 Examples/combin.ml [new file] Added a new example, the old combinatory logic one done by Tom Melham and Juanito Camilleri in HOL88. My source and inspiration was the HOL4 tutorial and distribution; the proof is quite close to the one there apart from cosmetic features. Thu 6th Apr 06 printer.ml Restored behaviour of "name_of" that I'd changed inadvertently in my recoding: it should return "" rather than fail on combinations or abstractions. Thu 6th Apr 06 sets.ml Added a proper "Cartesian product" operation CROSS and the theorems: CROSS = |- !s t. s CROSS t = {x,y | x IN s /\ y IN t} IN_CROSS = |- !x y s t. x,y IN s CROSS t <=> x IN s /\ y IN t HAS_SIZE_CROSS = |- !s t m n. s HAS_SIZE m /\ t HAS_SIZE n ==> s CROSS t HAS_SIZE m * n FINITE_CROSS = |- !s t. FINITE s /\ FINITE t ==> FINITE (s CROSS t) CARD_CROSS = |- !s t. FINITE s /\ FINITE t ==> CARD(s CROSS t) = CARD s * CARD t All these are just trivial rewrites of "..._PRODUCT" theorems. I would rather like to decomission those, but it might be a bit disruptive. One idea would be to rename the "DEPENDENT" versions, since in many "crude" applications they would work equally well. But then all the explicit enumerations eliminated with IN_ELIM_PAIR_THM would need to be tracked. Scarcely worth it. Thu 6th Apr 06 recursion.ml, pair.ml Hid "prove_raw_recursive_functions_exist" and "prove_canon_recursive_functions_exist" inside the main function; they are never used and there's no obvious reason why one would want to. Also hid "projection_cache" and "create_projections", moving them inside GEN_BETA_CONV. Again, this seems sensible since they're hardly of general utility. I hesitated briefly because there's now no way to flush the cache, but since in the typical case it will contain only the theorem for pairs, and anyway is sorta linear in the number of constructors declared, I decided this was a non-issue. Wed 5th Apr 06 realarith.ml, calc_rat.ml Rearranged GEN_REAL_ARITH to be further specialized twice from its bootstrapping version so that it only takes the prover as an argument and otherwise has everything fixed. That makes things a bit simpler conceptually, and moreover I could now hide ABSMAXMIN_ELIM_CONV1 and ABSMAXMIN_ELIM_CONV2 inside and intermediate version. Tue 4th Apr 06 printer.ml Deleted "backquote_char" (never used, a relic from the separate filter for CAML Light), "IS_BINDER", "IS_PREFIX", "IS_INFIX", "FIXITY" (all have trivial synonyms and are only used in the printer). Hid "DEST_BINARY", "ARIGHT" and "dest_binder_vorc" inside "pp_print_term", which is the only place they are used. Renamed "NAME_OF" to "name_of" since the case conventions make the former look like an inference rule; also slightly optimized the implementation. Hid "reverse_interface". The parametrization by the reference flag makes it less generally useful, and as a matter of fact it isn't used anywhere. Also hid the initial "string_of_type" and added a new variant in the same style as the other "to string" stuff. Eventually I would like this to be derived, if at all, from the printer rather than vice versa, so it works more nicely on huge types. Sun 2nd Apr 06 int.ml Removed ARITH_CONV and INT_ARITH_CONV; these were almost never used and seem merely likely to create more confusion given that ARITH_RULE and INT_ARITH both exist and do almost the same thing. Sat 1st Apr 06 sets.ml, define.ml Got rid of various explicit "CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV)" type things now that generalized beta conversion is in the basic rewrites. Fri 31st Mar 06 pair.ml, realax.ml, wf.ml Removed the horribly ad-hoc GEN_PAIR_TAC. Replaced the instances in other files with other proofs, actually often simpler, typically using FORALL_PAIR_THM. Also forced "LET_TAC" to have abbreviated type "tactic". Tue 28th Mar 06 realax.ml Hid "DIST_ELIM_TAC" inside some proofs. The net effect is also a bit shorter, since I noticed three proofs were identical. Tue 28th Mar 06 sets.ml Renamed yesterday's theorem (CARD_EQ_BIJ -> CARD_EQ_BIJECTION), and added a new version with two bijections: CARD_EQ_BIJECTION = |- !s t. FINITE s /\ FINITE t /\ CARD s = CARD t ==> ?f. (!x. x IN s ==> f x IN t) /\ (!y. y IN t ==> (?x. x IN s /\ f x = y)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) CARD_EQ_BIJECTIONS = |- !s t. FINITE s /\ FINITE t /\ CARD s = CARD t ==> ?f g. (!x. x IN s ==> f x IN t /\ g (f x) = x) /\ (!y. y IN t ==> g y IN s /\ f (g y) = y) Tue 28th Mar 06 wf.ml Got rid of WF_INDUCT_THEN, which was never used. Kept WF_INDUCT_TAC. Tue 28th Mar 06 arith.ml Got rid of PRE_ELIM_TAC and SUB_ELIM_TAC too. They're both subsumed really by NUM_MULTIPLY_CONV, and I only had one instance of each (one in Tom's Jordan proof, one in my ancient Ramsey proof where it was doing manually something doable by ARITH_TAC anyway). Tue 28th Mar 06 calc_num.ml Removed one instance of NUM_CANCEL_CONV. I had wanted to get rid of it, but then some of the proofs in "realax.ml" would become somewhat tedious, so I thought better of it. Tue 28th Mar 06 Rqe/make.ml Deleted the files "core.ml" and "analysis.ml" from the build. They aren't necessary and break when any theorems vanish, even obscure ones. Sean himself suggested getting rid of this. Mon 27th Mar 06 Examples/binary.ml [new file] Added a basic development of the "binary expansion" bijection between finite sets and functions. It's actually surprisingly tedious... Mon 27th Mar 06 arith.ml Recoded mk_small_numeral and dest_small_numeral in terms of their mk_numeral and dest_numeral counterparts. This is not only simpler but in the latter case has better error checking instead of silently overflowing. Also deleted "is_small_numeral", which is rather obscure and had never been used at all. Also hid PRE_ELIM_CONV and SUB_ELIM_CONV inside the corresponding tactics. Mon 27th Mar 06 sets.ml Removed SETIFY_CONV and SETENUM_UNION_CONV. I'm not really very satisfied with this half-baked solution. I think I should really do it all modulo an equality conversion or something. Mon 27th Mar 06 sets.ml Added another of those "how did I manage without it for so long?" theorems: CARD_EQ_BIJ = |- !s t. FINITE s /\ FINITE t /\ CARD s = CARD t ==> (?f. (!y. y IN t ==> (?x. x IN s /\ f x = y)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)) Mon 27th Mar 06 calc_num.ml Decided to hide NUM_DIVMOD_CONV. It's potentially useful, but I'd never used it and in any really critical situation one would probably want even more delicacy. Sun 26th Mar 06 calc_num.ml Removed toplevel binding of NUM_SUC_CONV', which is never used. Changed one right-hand clause of ARITH_LE to "n <= _0" rather than "n = 0" since it keeps the rewrites more thematic. Slightly reorganized the definitions of the inequality conversions to be more efficient exploiting this, and recoded NUM_REL_CONV. Made the final net use the explicit conversions rather than NUM_REL_CONV; I can't remember how that happened. And in the process, hid NUM_REL_CONV'. And hid both NUM_ADD_CONV' and NUM_MULT_CONV'. Finally renamed "mangle" to a more meaningful name DENUMERAL. I could just hide it, since it's not used outside this file, but that's a bit tedious. Fri 24th Mar 06 class.ml, Examples/hol88.ml Tweaked ETA_CONV so it doesn't muss the variable name. Previously ETA_CONV `\n. SUC n` returned `(\x. SUC x) = SUC`. Also removed EXT, or moved it to Examples/hol88.ml; I've never used it. And removed "list_mk_select" and "strip_select", which were never used, and "simple_new_specification". Fri 24th Mar 06 sets.ml, cart.ml [new file] Slightly reorganized the definitions of finite_index and finite_sum to use simple correspondence with ranges, parametrized by the base type, rather than the somewhat laborious constructions within the core types. As a consequence, I needed to move this stuff after the definition of ranges "..", so I put it in a new file "cart.ml". This is arguably a structural improvement anyway since it really is rather out of character with the rest of "sets.ml". Fri 24th Mar 06 ind-defs.ml Removed HALF_BETA_EXPAND; it hardly seemed worthwhile given that the definition in terms of RIGHT_BETAS is simple and it's not used much. Fri 24th Mar 06 ind-defs.ml, ind-types.ml, num.ml Deleted "prove_nonschematic_inductive_relations_exist", and changed the only two applications of it into simple "prove_inductive_relations_exist". Also removed RULE_INDUCT_TAC and RULE_INDUCT_THEN. I don't really want these ad-hoc things when MATCH_MP_TAC works fine. There are some instances of RULE_INDUCT_TAC in Examples/rstc.ml but that's already using a slightly different local definition. Also hid "generalize_schematic_variables", "derive_existence", "make_definitions", "prove_inductive_properties" and "unschematize_clauses". Fri 24th Mar 06 ind-defs.ml, class.ml, list.ml Restructured the monotonicity-proving code somewhat, hiding BACKCHAIN_TAC, MONO_ABS_TAC, APPLY_MONOTAC and MONO_STEP_TAC, and replacing "mono_tactics" with "monotonicity_theorems", which is *just* a list of theorems. This seems to be a much more straightforward interface. Thu 23rd Mar 06 ind-defs.ml Hid: FORALL_IMPS_CONV, AND_IMPS_CONV, SIMPLE_DISJ_PAIR, canonicalize_clause, canonicalize_clauses, derive_canon_inductive_relations; all of these are just used once inside the core function. Wed 22nd Mar 06 ind-defs.ml Hid "getconcl". I'll do some more tomorrow... Wed 22nd Mar 06 tactics.ml Removed the binding of REFINEMENT_PROOF, which seems entirely useless. Wed 22nd Mar 06 tactics.ml Removed the type constructor "Goalstack" everywhere and just made "goalstack" a direct abbreciation of "goalstate list". It seemed just to get in the way and make things less intuitive. Tue 21st Mar 06 tactics.ml Deleted DISJ_CASES_THENL, which is quite rarely used and has a trivial definition; it's also a bit inconsistent to have this but not the corresponding thing for conjunction. Tue 21st Mar 06 tactics.ml Fixed a small but real error in CONV_TAC, which was checking for equations "x = T" without taking into account that the goal might itself be of the form "something = T" and the tactic may be returning the goal itself. Sat 18th Mar 06 drule.ml Deleted "find_matching_subterm", which was never used at all. It was probably used in a previous version of HIGHER_REWRITE_CONV. Actually, I'm quite tempted to get rid of that too: in particular its treatment of freeness in conditionals is too conservative (only the condition arm needs to be free). Fri 17th Mar 06 drule.ml Changed BETAS_CONV so that it just infers the number of reductions to make from the form of the term, rather than taking it as a separate parameter. There's really not much to be done besides following the form of the term, and that's really all the old function did. Thu 16th Mar 06 bool.ml Made a trivial syntactic tweak to the concrete syntax in the definition of unique existence, to remove excessive bracketing. Wed 15th Mar 06 equal.ml Removed SINGLE_DEPTH_CONV, which is very specialized, only really used to do an old-style SKOLEM_CONV. The latter is used in a few places so I copied the definition there, but eventually I really ought to scrub those too. Wed 15th Mar 06 equal.ml Hid all the "failure propagating" depth conversions (even removed COMB2_QCONV, which was only used in the instance COMB_QCONV) inside the core functions. This means COMB2_QCONV, COMB_QCONV, DEPTH_QCONV, ONCE_DEPTH_QCONV, REDEPTH_QCONV, SUB_QCONV, TOP_DEPTH_QCONV and TOP_SWEEP_QCONV are no longer bound. Tue 14th Mar 06 nets.ml Hid "label_to_store", "label_for_lookup", "follow" and "net_update" inside the main two functions "enter" and "lookup". Mon 13th Mar 06 basics.ml, equal.ml Changed the notion of "path" in find_path, follow_path and PATH_CONV to be a string rather than a list of strings. After all, the whole point is to be terse. Sat 11th Mar 06 basics.ml Removed "dest_cvar". It's not unreasonable a priori but isn't even used once, and I didn't want to document it. I'm plodding through reference manual entries in Atlanta airport. Fri 10th Mar 06 make.ml, hol.ml Moved "hol_version" into the "hol.ml" file, since there seems to be no reason to confine it to the built version. And also hid "nice_date" inside "startup_banner". Fri 10th Mar 06 sys.ml Removed the assignable variable "set_jrh_lexer", which probably gives a false impression that it's a Boolean flag. Just used the name in an identity function in order to force things. Fri 10th Mar 06 lib.ml, meson.ml Removed "uniq'" and "setify'" from the library file and inserted them internally in the only application, in MESON (something I eventually want to get rid of anyway). Also removed "assoc'" and "pair_equals" completely, since they are apparently never used. Thu 9th Mar 06 lib.ml, Examples/holby.ml Deleted less useful FPF functions "tryapply" and "tryapply" (had a few instances of the latter in Holby to expand by changing to "tryapplyd ... []". Also hid a lot of things that should really be considered internal functions to the implementation: map_list, foldl_list, foldr_list, apply_listd, undefine_list, define_list, combine_list, ldb, newbranch. Thu 9th Mar 06 basics.ml Realized I'd been stupid yesterday: the messiness in "subst" with genvars is used to rename variables, and it is necessary; thanks to that a proof failed. So restored the basic structure, but kept the superior handling of unchanged subterms. Thu 9th Mar 06 lib.ml Modified "lcm_num" to return 0 rather than fail if both inputs are zero. Wed 8th Mar 06 lib.ml Fixed "gcd" to always return nonnegative gcds. Now it's basically consistent with gcd_num in the absence of overflow. Removed "lcm" which was particularly vulnerable to overflow and never got used. Wed 8th Mar 06 lib.ml Removed "munion" and "msubtract" (the later is used in the Tang exponential proof so I put a copy there). Removed all the flag functions: flags, get_flag_value, new_flag, set_flag. I had intended to use these as in HOL88, but it seems somewhat pointless; better to just use assignable variables, which can then have different types (one idea would be to put them all together in a record for tidiness). Removed "abs" (integer absolute value) which is already in OCaml and "sgn", which seems pretty minimally useful since its definition is so short; indeed it was never used. Wed 8th Mar 06 lib.ml, nets.ml Took the functions "set_insert" and "set_merge" from the library and hid them inside the unique net function they are used in. They are never used anywhere else. Wed 8th Mar 06 lib.ml, passim And removed "upto" which is just a synonm for "--". Needed to change a lot of instances. And removed "gather", which is just a synonym (and a less efficient one) for "filter". Just one or two instances in use. And removed "do_list2" which was never, ever, used. Wed 8th Mar 06 lib.ml, basics.ml Recoded "subst" to use pointer-eq rather than Unchanged exceptions, and generally wrote a simpler implementation; I can't figure out why I formerly replaced with genvars and then replaced those; it just looks weird. And this was the only place where "qcomb" was used, so removed that too. Removed "qtry" too, which wasn't used at all! Also removed all the "lazy sum" stuff that's now not used: the type "lazysum" and the functions "lazify", "eager" and "eval". Wed 8th Mar 06 lib.ml, ind-defs.ml Removed the function "assoc2", mainly to avoid documenting it, and replaced its unique application in ind-defs: let vargs = shareout xargs flargs in let cargs = map (C assoc2 (rels,vargs) o fst) uncs in with let cargs = map (fun (r,a) -> assoc2 r (rels,vargs)) uncs Also moved "shareout" back into "lib.ml"; it seems it sorta belongs there. Thu 2nd Mar 06 printer.ml Re-fixed the problem of "--&n" printing; I'd accidentally knocked this out when improving the behaviour of "----" to take into account any interface. Thu 2nd Mar 06 calc_rat.ml Added REAL_INV_INV into the initial normalizations done in REAL_FIELD; this catches an issue where in the absence of this normalization one of the proofs in 100/stirling.ml was failing; it had worked before because of a lucky correlation in the older algorithm. Wed 1st Mar 06 calc_rat.ml, Complex/complex.ml Fixed an error in REAL_FIELD and COMPLEX_FIELD: they picked out a list of any inverse terms. Now they pick only those that occur free in the formula. With the earlier implementation this led only to pointless case splits, but now it can lead to failure, e.g. if the term involves "sum (\k. ... / &(FACT k))" it would attempt to establish ~(&(FACT k) = &0) in context, which is unlikely to work. Wed 1st Mar 06 itab.ml, bool.ml, tactics.ml, class.ml, Examples/hol88.ml Removed CONTRAPOS (but put it in Examples/hol88.ml). This was very seldom used and it can be done perfectly well by GEN_REWRITE_RULE I [GSYM CONTRAPOS_THM] at worst. Likewise moved NEG_DISCH. And also SELECT_ELIM and SELECT_INTRO: neither of these was *ever* used (by me). Thu 23rd Feb 06 calc_rat.ml, Complex/complex.ml Recoded REAL_FIELD and COMPLEX_FIELD to make a much less unintelligent case-split. Instead of all 2^n combinations of cases for each x = 0 or x * inv(x) = 1 for the n terms that are inverted, use the superior n+1 cases. This should be a lot faster on formulas with many inverses. Thu 23rd Feb 06 preterm.ml Renamed "istriv" as "istrivial", since the former is already used for a MESON function (not that there's much need for anyone to use either). Tue 21st Feb 06 real.ml, num.ml, Examples/analysis.ml, Examples/transc.ml Examples/card.ml, Examples/reduct.ml, Examples/wo.ml, ind-types.ml Spotted various "duplicate definition" type errors while accumulating a list of identifiers for the reference manual. Removed duplicate proofs of REAL_LE_REFL, REAL_LE_TOTAL and REAL_LE_ANTISYM, which are already proved in "realax.ml". Also removed the pointless rewrite with _0 = 0 of SUC_INJ, which doesn't involve the constant zero. Removed double proofs of SUB_LEFT_LESS_EQ and TC_CR, and the whole series WOSET_REFL, WOSET_TRANS, WOSET_ANTISYM, WOSET_TOTAL and WOSET_WELL, plus finally INTEGRAL_LE (though there was a slight difference in the first instance) and renamed CARD_MUL_ASSOC correctly (it had been called CARD_ADD_ASSOC in a cut-and-paste error). Removed definitions of p_tm and d_tm from "transc.ml", kl_tm from "wo.ml", and localized (stupidly) t_tm in "ind-types.ml". Tue 14th Feb 06 class.ml Changed the "new_specification" code to use "new_definition" rather than "new_basic_definition", otherwise the new constants don't get added to the definitions list. Mon 13th Feb 06 printer.ml Fixed a problem with the printer pointed out by Cezary Kaliszyk: the special avoidance of printing double-negations *not* as "----" was only working for some instances, and not vectors (indeed, not complex numbers either). So I changed the code a bit so that now it comprehensively looks if the reverse interface mapping is "--", which seems more satisfactory. Fri 13th Jan 06 preterm.ml Modified "pmk_let" so that it will allow "<=>" as well as "=" as the binding construct; remember that typechecking and overloading resolution hasn't been performed at this point. This was to fix an unanticipated issue with the change of precedence: neither "let x = y \/ z in ..." nor "let x <=> y \/ z in ..." was accepted. Now the latter is; in either case "let x = (y \/ z) in ..." was of course. Still, I wonder if I ought to do a more special-case parse of the let bindings rather than relying on treating it as a preterm directly. Of course it prints as "<=>" anyway. Let's stick with this for now. Mon 9th Jan 06 define.ml Fixed one case where there was a reliance on the default rewriting net at runtime, in ELIM_LISTOPS_CONV within instantiate_casewise_recursion. With paired beta inside, this was breaking. Also changed REWRITE_CONV to PURE_REWRITE_CONV on line 451. Although I don't think that was currently causing problems, it could in principle. There are still a few defaulted REWRITE_TACs in the later order-guessing stuff, but then that should be rewritten more fundamentally anyway so I'm not planning to tinker unless I need to. Fri 6th Jan 06 pair.ml So, added GEN_BETA_CONV to the basic rewrites at the end of "pair.ml". Seems not to kill anything in the core; I'll run some tests to see if anything breaks. Eventually I can go through and make some consequential simplifications. Fri 6th Jan 06 simp.ml I really wanted to add paired (or generalized) beta-conversion to the basic "rewrites", but the mechanism for adding a conversion is not really there. So I restructured, adding set_basic_convs extend_basic_convs basic_convs and tweaked all the setting functions so that updating either the basic theorems or conversions will "rehash" the whole term net starting from those two lists. Should be compatible... Wed 4th Jan 06 printer.ml Prompted by Steve Brackin, who wanted to convert terms to strings, I generalized several printing functions into "pp_" variants that take a formatter as an additional argument: pp_print_type pp_print_qtype pp_print_term pp_print_qterm pp_print_thm Also added more explicit string conversion functions: print_to_string string_of_term string_of_thm Mon 12th Dec 05 iter.ml Removed more redundant finiteness assumptions from some theorems. These may seem a bit too "hacky" to expose, but it's very convenient to be able to apply these with no finiteness worries. NSUM_SUPPORT = |- !f s. nsum (support (+) f s) f = nsum s f SUM_SUPPORT = |- !f s. sum (support (+) f s) f = sum s f NSUM_CMUL = |- !f c s. nsum s (\x. c * f x) = c * nsum s f SUM_CMUL = |- !f c s. sum s (\x. c * f x) = c * sum s f SUM_NEG = |- !f s. sum s (\x. --f x) = --sum s f Deleted NSUM_CMUL_NUMSEG, SUM_CMUL_NUMSEG and SUM_NEG_NUMSEG since they're now nothing but instances of the general case. Fri 9th Dec 05 iter.ml Realized that several "nsum" theorems had stupid "0 <= ..." properties that I just took over from the real numbers, but of course these are redundant for N. Just removed NSUM_POS_LE and NSUM_POS_LE_NUMSEG, NSUM_POS_EQ_0 and NSUM_POS_EQ_0_NUMSEG. On the other hand added the more useful bi-implications: NSUM_EQ_0_IFF = |- !s. FINITE s ==> (nsum s f = 0 <=> !x. x IN s ==> f x = 0) NSUM_EQ_0_IFF_NUMSEG = |- !f m n. nsum (m .. n) f = 0 <=> (!i. m <= i /\ i <= n ==> f i = 0) Thu 8th Dec 05 iter.ml Made quite a few theorems stronger by removing unnecessary finiteness assumptions. The first was just stupidity; the others have become possible thanks to the canonical choice in the "infinite support" case: ITERATE_SUPPORT = |- !op f s. iterate op (support op f s) f = iterate op s f ITERATE_IMAGE = |- !op. monoidal op ==> (!f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> iterate op (IMAGE f s) g = iterate op s (g o f)) ITERATE_BIJECTION = |- !op. monoidal op ==> (!f p s. (!x. x IN s ==> p x IN s) /\ (!y. y IN s ==> (?!x. x IN s /\ p x = y)) ==> iterate op s f = iterate op s (f o p)) ITERATE_EQ = |- !op. monoidal op ==> (!f g s. (!x. x IN s ==> f x = g x) ==> iterate op s f = iterate op s g) ITERATE_EQ_GENERAL = |- !op. monoidal op ==> (!s t f g h. (!y. y IN t ==> (?!x. x IN s /\ h x = y)) /\ (!x. x IN s ==> h x IN t /\ g (h x) = f x) ==> iterate op s f = iterate op t g) ITERATE_EQ_GENERAL_INVERSES = |- !op. monoidal op ==> (!s t f g h k. (!y. y IN t ==> k y IN s /\ h (k y) = y) /\ (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x) ==> iterate op s f = iterate op t g) and likewise for all the instantiations. Also added the following clause to SUPPORT_CLAUSES: |- ... /\ (!f g s. support op g (IMAGE f s) = IMAGE f (support op (g o f) s)) Thu 8th Dec 05 sets.ml Added FINITE_IMAGE_INJ_EQ |- !f s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (FINITE (IMAGE f s) <=> FINITE s) Wed 7th Dec 05 iter.ml Changed the definition of "iter" so it always returns the neutral element in the case of non-finite support. The principal motivation is to allow us to have a simple congruence rule, which at the moment we have for the special case of "m..n" but not for general sets. Another pleasing consequence is that quite a few theorems (ITERATE_EQ, ITERATE_IMAGE, ...) can lose their finiteness hypothesis. However, I haven't at present added the new congruence rules or modified the theorems; that will require quite a bit of effort to fix proofs broken by becoming "too easy". Tue 6th Dec 05 canon.ml, meson.ml Attempted to improve CONDS_ELIM_CONV, a slightly dangerous undertaking. Now it more aggressively splits at the outer level, even if the term contains quantifiers, provided the condition being tested is free. Moreover, it will achieve some level of sharing when multiple conditional expressions have the same test. I also changed CONDS_ELIM_CONV to CONDS_ELIM_CONV' in MESON, since it seems to be a case where conjunctive splitting is called for. Tue 6th Dec 05 iter.ml Added variants of general equality between sums using mutually inverse functions. This clutter is getting a bit much, but these often seem more useful. ITERATE_EQ_GENERAL_INVERSES = |- !op. monoidal op ==> (!s t f g h k. FINITE s /\ (!y. y IN t ==> k y IN s /\ h (k y) = y) /\ (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x) ==> iterate op s f = iterate op t g) NSUM_EQ_GENERAL_INVERSES = |- !s t f g h k. FINITE s /\ (!y. y IN t ==> k y IN s /\ h (k y) = y) /\ (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x) ==> nsum s f = nsum t g SUM_EQ_GENERAL_INVERSES = |- !s t f g h k. FINITE s /\ (!y. y IN t ==> k y IN s /\ h (k y) = y) /\ (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x) ==> sum s f = sum t g Mon 5th Dec 05 Examples/pocklington.ml It was pointed out to me by Freek that there's still no proof of the multiplicativity of the totient function, so I added this and various other useful lemmas: PHI_FINITE_LEMMA = |- !P n. FINITE {m | coprime (m,n) /\ m < n} CONG_IMP_EQ = |- !x y n. x < n /\ y < n /\ (x == y) (mod n) ==> x = y CONG_DIVIDES_MODULUS = |- !x y m n. (x == y) (mod m) /\ n divides m ==> (x == y) (mod n) MOD_MULT_CONG = |- !a b x y. ~(a = 0) /\ ~(b = 0) ==> ((x MOD (a * b) == y) (mod a) <=> (x == y) (mod a)) including more forms of the Chinese remainder theorem combining existence and uniqueness: CHINESE_REMAINDER_UNIQUE = |- !a b m n. coprime (a,b) /\ ~(a = 0) /\ ~(b = 0) ==> (?!x. x < a * b /\ (x == m) (mod a) /\ (x == n) (mod b)) CHINESE_REMAINDER_COPRIME_UNIQUE = |- !a b m n. coprime (a,b) /\ ~(a = 0) /\ ~(b = 0) /\ coprime (m,a) /\ coprime (n,b) ==> (?!x. coprime (x,a * b) /\ x < a * b /\ (x == m) (mod a) /\ (x == n) (mod b)) and finally the multiplicativity property itself: PHI_MULTIPLICATIVE = |- !a b. coprime (a,b) ==> phi (a * b) = phi a * phi b Mon 5th Dec 05 sets.ml Added CARD_IMAGE_INJ_EQ, which can be handy to avoid explicitly expanding the image. |- !f s t. FINITE s /\ (!x. x IN s ==> f x IN t) /\ (!y. y IN t ==> (?!x. x IN s /\ f x = y)) ==> CARD t = CARD s Sat 3rd Dec 05 sets.ml Added a type annotation to INTERS_0 so it doesn't look so ugly with the new union-printing. Sat 3rd Dec 05 meson.ml Tried to do the dual thing for MESON, adding a new UNWIND_CLAUSAL_EQUATION to eliminate equality from assumptions that modulo clausification are like `!x. x = a ==> P(x)` and replace them with `P(a)`. Took the chance to eliminate definition of the function GSPEC, which is only really used locally and clashes with the definitional theorem for the set constant. Just doing UNWIND_CLAUSAL_EQUATION where possible *can* actually make things worse, because the "stupid" form was useful in contrapositive mode I assume. So instead of replacing the "stupid" form I add both. This is a compromise: it may still increase the search space but at least shouldn't increase the depth and so *really* be a disaster. Well, that's the theory... Sat 3rd Dec 05 tactics.ml Generalized SUBST_VAR_TAC to do constants too, which is even easier. Fri 2nd Dec 05 tactics.ml, meson.ml Added SUBST_VAR_TAC, which will perform substitution if one side of the equation is a variable not occurring in the other (or do nothing for a reflexive equation). Added it just at the end of the MESON canonicalization; I hope this will render some simple equality propagation more efficient. ********************** RELEASE OF VERSION 2.10 ********************** Wed 30th Nov 05 Examples/permutations.ml, Examples/product.ml [new files] Added these two files, one with a quite decent theory of permutations, one with a fairly spartan theory of products, which could be beefed up with a little boring work. Wed 30th Nov 05 iter.ml Added theorems about bijections of the indexing set: ITERATE_BIJECTION = |- !op. monoidal op ==> (!f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!y. y IN s ==> (?!x. x IN s /\ p x = y)) ==> iterate op s f = iterate op s (f o p)) SUM_BIJECTION = |- !f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!y. y IN s ==> (?!x. x IN s /\ p x = y)) ==> sum s f = sum s (f o p) NSUM_BIJECTION = |- !f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!y. y IN s ==> (?!x. x IN s /\ p x = y)) ==> nsum s f = nsum s (f o p) about composing iterated operations over a Cartesian product set: ITERATE_ITERATE_PRODUCT = |- !op. monoidal op ==> (!s t x. FINITE s /\ (!i. i IN s ==> FINITE (t i)) ==> iterate op s (\i. iterate op (t i) (x i)) = iterate op {i,j | i IN s /\ j IN t i} (\(i,j). x i j)) NSUM_NSUM_PRODUCT = |- !s t x. FINITE s /\ (!i. i IN s ==> FINITE (t i)) ==> nsum s (\i. nsum (t i) (x i)) = nsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j) SUM_SUM_PRODUCT = |- !s t x. FINITE s /\ (!i. i IN s ==> FINITE (t i)) ==> sum s (\i. sum (t i) (x i)) = sum {i,j | i IN s /\ j IN t i} (\(i,j). x i j) And this, which had somehow been forgotten in the general case: ITERATE_EQ = |- !op. monoidal op ==> (!f g s. FINITE s /\ (!x. x IN s ==> f x = g x) ==> iterate op s f = iterate op s g) and these more general-looking theorems in all instantiations: ITERATE_EQ_GENERAL = |- !op. monoidal op ==> (!s t f g h. FINITE s /\ (!y. y IN t ==> (?!x. x IN s /\ h x = y)) /\ (!x. x IN s ==> h x IN t /\ g (h x) = f x) ==> iterate op s f = iterate op t g) NSUM_EQ_GENERAL = |- !s t f g h. FINITE s /\ (!y. y IN t ==> (?!x. x IN s /\ h x = y)) /\ (!x. x IN s ==> h x IN t /\ g (h x) = f x) ==> nsum s f = nsum t g SUM_EQ_GENERAL = |- !s t f g h. FINITE s /\ (!y. y IN t ==> (?!x. x IN s /\ h x = y)) /\ (!x. x IN s ==> h x IN t /\ g (h x) = f x) ==> sum s f = sum t g Wed 30th Nov 05 sets.ml Added IN_ELIM_PAIR_THM = |- !P a b. (a,b) IN {(x,y) | P x y} <=> P a b Tue 22nd Nov 05 Examples/transc.ml Added some missing derivative theorems to "diff_net": sqrt, asn and acs. The DIFF_SQRT theorem wasn't even there at all: DIFF_SQRT = |- !x. &0 < x ==> (sqrt diffl inv (&2 * sqrt x)) x Fri 18th Nov 05 Examples/floor.ml Put interface maps "real_of_int" and "int_of_real" for the "dest_int" and "mk_int" functions, and proved "integer" and "is_int" are the same. Really, I would have preferred to just fix the names back in "int.ml" but was put off by the thought of breaking Tom's proofs: he uses "dest_int" at least quite extensively and may rely on its hash value. Thu 17th Nov 05 make.ml Added a version number (now set to "2.10" for next planned public release) and set it to appear in the startup banner. Thu 17th Nov 05 meson.ml Scaled back the default chattiness of MESON (unless "meson_chatty" is set), with a one-line output that's almost as informative as the old screed. Thu 17th Nov 05 parser.ml. printer.ml Introduced "string_of_type" and "print_type" (now without surrounding quotes and colon) and renamed old "print_type" (with quotes and colon) as "print_qtype". This is more consistent with the naming scheme for terms. Introduced parsing and printing of "(:ty)" as "UNIV:ty->bool". This is very helpful when using my functional approach to Cartesian products. It can be disabled by setting the new variable "typify_universal_set" to false. Wed 16th Nov 05 define.ml Added some limited support for intelligent admissibility analysis of "sum" and "nsum". Slightly lazily, I don't do the careful tupling, and just do beta-conversion afterwards, so it's only really reliable for one-argument functions that appear themselves in the summation. But this is a useful special case. It would be easy but tedious to generalize it. The new theorems themselves are, I believe, sufficiently generic, ADMISSIBLE_SUM = |- !(<<) p s h a b. (!k. admissible (<<) (\f x. a(x) <= k /\ k <= b(x) /\ p f x) s (\f x. h f x k)) ==> admissible (<<) p s (\f x. sum (a(x) .. b(x)) (h f x)) ADMISSIBLE_NSUM = |- !(<<) p s h a b. (!k. admissible (<<) (\f x. a(x) <= k /\ k <= b(x) /\ p f x) s (\f x. h f x k)) ==> admissible (<<) p s (\f x. nsum (a(x) .. b(x)) (h f x)) Tue 8th Nov 05 pa_j_3.09.ml [new file] Flemming Andersen pointed out that the latest pa_j.ml doesn't work in 3.09; there have been yet more changes! So I created a new pa_j.ml for 3.09, correctly I hope. Tue 8th Nov 05 preterm.ml, parser.ml, printer.ml Added pmk_setcompr, which generalizes pmk_setabs to be given an explicit set of bound variables (code from Sean McLaughlin). Now "pmk_setabs" just figures out the default and calls that. In the parser, added parsing for set comprehensions with explicit bound variable indication as in "{t | vs | p}". The printer will also print in this form if either (i) flag print_unambiguous_comprehensions is set, or (ii) the choices don't match the defaults (which are unchanged). Fri 4th Nov 05 printer.ml Added two new reference variables "unspaced_binops" (binary operators to be printed without spaces round them) and "prebroken_binops" (binary operators where line breaks are to be inserted before the operator for preference). This generalizes the special treatments originally given to "," and "==>" respectively, which I wanted to extend to "::" and "-->" for a Murphi spec. Also added "reverse_interface" and used it, and changed DEST_BINARY further, so that it treats as the same all constants (only constants) that have the same interface map. Once again this is good for "::" which I had overloaded to two different things. Wed 2nd Nov 05 equal.ml Added PAT_CONV, identifying positions for conversion application using a simple pattern term. I've contemplated this for a while and I know John Matthews also suggested it. Mon 31st Oct 05 hol.ml Just when I was ready for a Halloween release! I found that I was not consistently keeping a fully qualified path in the lost "loaded_files". This can mean "needs" forcing a repetition of something that was loaded using ".". So I added an explicit transformation of "." into "Sys.getcwd()" in "file_on_path". Fri 28th Oct 05 parser.ml Realized I'd been too hasty accommodating Steve B's requests. The new lexical conventions hit me almost as soon as I started loading the complex numbers and hit `&1,&2`. So I implemented a somewhat more intricate approach, where "," and ";" are set aside into their own class of "separators", and the only permissible combination is repetition within that class. This gives ",,", which Steve wanted, and ";;", which I sometimes use in programming language semantics. Fri 28th Oct 05 calc_rat.ml Finally fixed REAL_RAT_DIV_CONV so it doesn't incorrectly ignore "&n / &1". Also fixed what is a bug, though I've never seen it come up: I was using "=" instead of "=/" for the gcd equality test. Thu 27th Oct 05 lib.ml After finally tracking a performance bug to large traversals inside set operations like "union", I defined inequalities and equalities like "=?", "<=?" etc. and tried to use them consistently inside the set operations and other related stuff like "setify", finite partial functions etc. I found this by porting by old Stalmarck code because Hasan Amjad was interested, and discovered that compared with 1995 the pure (O)Caml proof search is about 50X as fast, yet sometimes proof reconstruction was only 3X. Thu 27th Oct 05 bool.ml Reorganized derivations to avoid gratuituous MP in CONTR and DISJ_CASES. There are plenty of others worth doing, no doubt. Wed 26th Oct 05 parser.ml Moved the comma from punctuation/bracket status to regular symbol. There seems no really compelling reason for its position, given that "." and ";" are now classed as regular symbols. The only slight danger is using identifiers with leading or trailing underscores next to commas, as for example with ML pattern-matching "a,_,b". This was stimulated by Steve Brackin's desire to use ",," as the record selector. Mon 24th Oct 05 calc_rat.ml Added inv(x pow n) = inv(x) pow n to the initial normalization in REAL_FIELD, which is consistent with the existing use of inv(x * y) = inv(x) * inv(y). This fixes the fact that things like this failed (and none too fast!) REAL_FIELD `&0 < x ==> &1 / x pow 2 - &1 / (x + &1) pow 2 = (&2 * x + &1) / (x * (x + &1)) pow 2`;; Mon 24th Oct 05 Makefile Added a catchall so that if there's no pa_j_XXX.ml for the version of OCaml being used, we use the 3.08 one. This was stimulated by Steve Brackin's observation that the build didn't just work on 3.08.4. Thu 20th Oct 05 Examples/analysis.ml Added a theorem that's pretty trivial, but tiresome to prove each time it comes up: SEQ_HARMONIC = |- !a. (\n. a / &n) --> &0. Thu 20th Oct 05 Examples/hol88.ml [new file] Added a "HOL88 compatibility" file. This is by no means perfect, but fixes the most important gaps and incompatibilities I've come across when porting stuff. Wed 19th Oct 05 grobner.ml Fixed a bug in "grobner_strong" by adding a special case for pol = []. As it stood, this was correctly returning the trivial certificate, but incorrectly returning the degree d = 0 instead of d = 1. This caused some later things to fail in trivial cases, e.g. REAL_RING `x:real = y ==> z:real = z`;; Mon 17th Oct 05 real.ml Added REAL_SOS_EQ_0 = |- !x y. x pow 2 + y pow 2 = &0 <=> x = &0 /\ y = &0 Fri 7th Oct 05 parser.ml Added "isalpha" (letter or prime or underscore) to the character discrimination functions, and slightly rejigged the implementation. Tue 20th Sep 05 lib.ml Tweaked "setify" and "setify'" to remove the pointless historical relic of a trap for the Unchanged exception. And it was wrong anyway: should have returned the intermediate sorted list if the exception came from "uniq". This was pointed out by Sean McLaughlin. Wed 7th Sep 05 printer.ml At Sean's suggestion, modified the store of printers to have names. So now "install_user_printer" takes a name-printer pair not just a printer, and delete_user_printer takes just a name (it wasn't really usable with just a function since they can't be compared for equality). Thu 1st Sep 05 ind-types.ml Added induction and recursion theorems for treating "bool" as just another inductive type: bool_INDUCT = |- !P. P F /\ P T ==> (!x. P x) bool_RECURSION = |- !a b. ?f. f F = a /\ f T = b and added them to the inductive type store, with knock-on effects on the "rectype net". This was needed to make a definition Damir Jamsek wanted to work accepted by "define": define `(cnt3(T,T) = 0) /\ (cnt3(F,T) = 1) /\ (cnt3(T,F) = 2)`;; Sat 20th Aug 05 tactics.ml Added a warning to the "g" goal-setting function about free variables in the goal. Tue 16th Aug 05 parser.ml At Sean's suggestion, removed the second (parser function) argument from "delete_parser", since it wasn't used anyway. Thu 11th Aug 05 sets.ml Added some theorems about general intersections: INTERS_0 = |- INTERS {} = UNIV INTERS_1 = |- INTERS {s} = s INTERS_2 = |- INTERS {s,t} = s INTER t INTERS_INSERT = |- INTERS (s INSERT u) = s INTER (INTERS u) Tue 2nd Aug 05 Examples/analysis.ml, Examples/transc.ml Added another tranche of basic but sometimes non-trivial theorems about integration, including integration over a combined interval, integration over a subinterval and integrability of continuous functions. Tue 26th Jul 05 tactics.ml, simp.ml Enhanced ABBREV_TAC so you can introduce functions with arguments directly rather than explicitly using the lambda-abstraction. Haven't correspondingly changed EXPAND_TAC as yet, and I'm not sure I will. Also moved ABBREV_TAC and EXPAND_TAC into "simp.ml" so the former can use rewriting. Mon 25th Jul 05 Examples/analysis.ml, Examples/transc.ml Added quite a few theorems to these files. Some, amazingly, had been put into the CAML Light version (gtt) but left out here. More substantially, added quite a few new lemmas about integration, which otherwise had hardly any theorems except for the FTC. ********************** RELEASE OF VERSION 2.00 ********************** Fri 22nd Jul 05 hol.ml, Examples/sos.ml At the suggestion of Tom Hales, added "tmp_path", a settable variable for a temporary path, and used that instead of explicit "/tmp" string in SOS. Fri 22nd Jul 05 sets.ml Added HAS_SIZE_PRODUCT_DEPENDENT = |- !s m t n. s HAS_SIZE m /\ (!x. x IN s ==> t(x) HAS_SIZE n) ==> {(x:A,y:B) | x IN s /\ y IN t(x)} HAS_SIZE (m * n) and made CARD_PRODUCT proof just use this as a lemma. Fri 22nd Jul 05 Examples/pocklington.ml Added more basic lemmas about congruences, including solving linear congruences: CONG_MOD_MULT = |- !x y m n. (x == y) (mod n) /\ m divides n ==> (x == y) (mod m) CONG_SOLVE = |- !a b n. coprime(a,n) ==> ?x. (a * x == b) (mod n) CONG_SOLVE_UNIQUE = |- !a b n. coprime(a,n) /\ ~(n = 0) ==> ?!x. x < n /\ (a * x == b) (mod n) CONG_UNIQUE_INVERSE_PRIME = |- !p x. prime p /\ 0 < x /\ x < p ==> ?!y. 0 < y /\ y < p /\ (x * y == 1) (mod p) Fri 22nd Jul 05 Examples/card.ml Added CANTOR_THM = |- (UNIV:A->bool) <_c (UNIV:(A->bool)->bool) to the cardinality theory. Tue 12th Jul 05 hol.ml Changed the first element of load_path to "."; formerly it used Sys.getcwd() but of course that's at build time, making it rather useless. Tue 12th Jul 05 calc_rat.ml Fixed up REAL_FIELD to (i) avoid using the non-trivial inverse adjunction for inverses of rational constants, and (ii) do a conjunctive not disjunctive split in its initial canonicalization. Tue 12th Jul 05 grobner.ml, passim Added another parameter to "RING_AND_IDEAL_CONV" (hence also "RING" and "ideal_cofactors") for the inversion ("inv") operation of the ring. Made the corresponding routine changes to the code to exploit "inv" correctly. It seemed inconsistent that, say, REAL_RING copes fine with &1 / &3 but not inv(&3)! Tue 12th Jul 05 canon.ml Added NNFC_CONV and GEN_NNFC_CONV, which force a conjunctive NNF split. This is sometimes useful if you're trying to prove something rather than refute its negation. Mon 11th Jul 05 grobner.ml Made "grobner_ideal" fail if the polynomial is not in the ideal instead of just returning an unsatisfactory list of cofactors. Obviously this is better on general grounds, and in particular it ensures that failure comes early on big applications of the IDEAL part of RING_AND_IDEAL_CONV. Also added initial interreduction of the input polynomials before forming a Grobner basis. (It would be more elegant just to put them in the spoly rather than basis list, but that gets complicated by all the criteria that are applied only when processed.) Also added depth BETA_CONV and PRESIMP_CONV to the initializations that go on, otherwise it fails to deal properly with things like REAL_RING `x = &1 ==> T`; also put a special-case check in the REFUTE code for `F`. Finally, fixed a problem where if the Strong Nullstellensatz certificate happened to have degree zero (i.e. the equations along imply 1=0) yet there are also assumed inequations to refute, the wrong thing was generated. This line: let th2 = funpow (deg-1) (IDOM_RULE o CONJ th1) th1 in was changed to this: let th2 = funpow deg (IDOM_RULE o CONJ th1) NOT_EQ_01 Sun 10th Jul 05 sets.ml Added yet more rather elementary set-theoretic results that aren't completely trivial conseqences of stuff I already have: CHOOSE_SUBSET = |- !s:A->bool. FINITE s ==> !n. n <= CARD s ==> ?t. t SUBSET s /\ t HAS_SIZE n CARD_UNION_LE = |- !s t:A->bool. FINITE s /\ FINITE t ==> CARD(s UNION t) <= CARD(s) + CARD(t) CARD_UNIONS_LE = |- !s t:A->B->bool m n. s HAS_SIZE m /\ (!x. x IN s ==> FINITE(t x) /\ CARD(t x) <= n) ==> CARD(UNIONS {t(x) | x IN s}) <= m * n Sat 9th Jul 05 grobner.ml Fixed an error where in the "no negated equations" case of Grobner, the filtered set of "things that are indeed equations" was not being used consistently, but rather at one point the original term was fed to "grobify_equations". Fri 8th Jul 05 sets.ml Added a few new set-theoretic lemmas: EMPTY_UNIONS = |- !s. UNIONS s = {} <=> (!t. t IN s ==> t = {}) HAS_SIZE_UNION = |- !s t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ DISJOINT s t ==> s UNION t HAS_SIZE m + n HAS_SIZE_UNIONS = |- !s t m n. s HAS_SIZE m /\ (!x. x IN s ==> t x HAS_SIZE n) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (t x) (t y)) ==> UNIONS {t x | x IN s} HAS_SIZE m * n Thu 7th Jul 05 Examples/prime.ml Added DIVIDES_PRIMEPOW = |- !p. prime p ==> (!d. d divides p EXP k <=> (?i. i <= k /\ d = p EXP i)) COPRIME_DIVISORS = |- !a b d e. d divides a /\ e divides b /\ coprime(a,b) ==> coprime(d,e) Thu 7th Jul 05 Makefile Added some files to the HOLSRC list in the Makefile; it was missing a few recent ones such as "iter.ml". Thu 7th Jul 05 iter.ml Added some more theorems about sums w.r.t. subsets, which I was a bit surprised I'd never proved before: NSUM_SUBSET = |- !u v f. FINITE u /\ FINITE v /\ (!x. x IN u DIFF v ==> f x = 0) ==> nsum u f <= nsum v f NSUM_SUBSET_SIMPLE = |- !u v f. FINITE v /\ u SUBSET v ==> nsum u f <= nsum v f SUM_SUBSET = |- !u v f. FINITE u /\ FINITE v /\ (!x. x IN u DIFF v ==> f x <= &0) /\ (!x. x IN v DIFF u ==> &0 <= f x) ==> sum u f <= sum v f SUM_SUBSET_SIMPLE = |- !u v f. FINITE v /\ u SUBSET v /\ (!x. x IN v DIFF u ==> &0 <= f x) ==> sum u f <= sum v f Sun 3rd Jul 05 Examples/analysis.ml Used overloading rather than overriding for the new and "pair-style" sums so it isn't so thoroughly awkward to mix the two. And added two theorems that relate old-style and new-style sums (which are a bit messy): PSUM_SUM = |- !f m n. sum (m,n) f = sum {i | m <= i /\ i < m + n} f PSUM_SUM_NUMSEG = |- !f m n. ~(m = 0 /\ n = 0) ==> sum (m,n) f = sum (m .. (m + n) - 1) f Sun 3rd Jul 05 calc_rat.ml Added a small but significant tweak to REAL_FIELD: rewrite with REAL_INV_MUL in the initial canonicalization. This often means that it only has to prove nonzeroness for individual factors, which is in general much easier. For example, it can now do this, which it couldn't before: REAL_FIELD `&1 / (&n + &1) - &1 / (&n + &2) = &1 / ((&n + &1) * (&n + &2))`;; Sun 3rd Jul 05 iter.ml Added: REAL_OF_NUM_SUM = |- !f s. FINITE s ==> &(nsum s f) = sum s (\x. &(f x)) REAL_OF_NUM_SUM_NUMSEG = |- !f m n. &(nsum (m .. n) f) = sum (m .. n) (\i. &(f i)) Fri 1st Jul 05 Examples/analysis.ml, Examples/transc.ml Changed the definitions of "sup" and "sqrt" to match the ones in the multivariate theory (called xxx_def here) and changed the current definitional theorems "sup" and "sqrt" to derived consequences. This removes some of the more gratuitous clashes between the univariate and multivariate theories. Thu 30th Jun 05 iter.ml, real.ml Changed "CARD_EQ_SUM" to "CARD_EQ_NSUM" for the "nsum" version; before it erroneously duplicated the "sum" version. Also removed duplicates from "real.ml" of REAL_LE_ADD, REAL_LET_ADD and REAL_LT_ADD, already defined in "realarith.ml". All this name duplication was found by Steven Obua's editing script! Thu 30th Jun 05 lib.ml, passim Made changes so that Steven Obua's proof recording stuff does not require much to be changed. Mainly: add new parametrized set operations in "lib.ml", define "equals_thm" and "equals_goal" and use them consistently to avoid ever comparing theorems for equality with the built-in relation. With a few minor changes, all the things I did were just following Steven's suggestions. Wed 29th Jun 05 inter.ml Changed some bound variables names that range over number segments from x/y (as in the general set case) to i/j, which seems a bit more intuitive. Tue 28th Jun 05 define.ml Fixed some degenerate cases in "define" and associated functions so that it can handle a trivial equational definition "v = t" and hence be used quite generally. Tue 28th Jun 05 tactics.ml Finally removed the use of "mk_thm" from tactic validity checking. Instead used a technique going back to Cambridge LCF: added a function "mk_fthm" which adds a trivially false assumption (actually a distinct constant _FALSITY_ to avoid unfortunate interactions with real parts of the goal). On a superficial test it seems to work fine. Mon 27th Jun 05 class.ml, ind-types.ml Added sort of benignity checking to type definitions made with "new_type_definition" and inductive types defined with "define_type". They are separate mechanisms, and the second is rather crude, actually using the input *string*. But it should suffice to make sure that almost all proof files will now load multiple times without redefinition complaints. Mon 27th Jun 05 drule.ml, define.ml Added "benign definition" acceptance to "define" and beefed up that in "new_definition" with the same new feature: it's OK it type variables etc. change provided both the old and new definitions can be instantiated (by PART_MATCH) to each other. (This ensures that we can change type variables but not make the definition more type-constrained, e.g. making two formerly distinct type variables the same.) Mon 27th Jun 05 tactics.ml Changed "REMOVE_THEN" so it removes only the first assumption with that label (and always the one that's handed to the thm-tactic). Previously it removed every assumption with that label. However it seemed it might sometimes be useful to have gentler behaviour; for example in porting Gappa proofs to Coq I wanted to flag certain assumptions defined by "Notation" to be automatically expanded so it was natural to use a fixed label for all of them and do REPEAT(REMOVE_THEN ...). Thu 23rd Jun 05 calc_rat.ml Inspired by porting Guillaume Marquiond's support files for Gappa, I decided it was about time I had some sort of analog to Coq's "field", so I added "REAL_FIELD". This basically uses RING after adding hypotheses "~(x = &0) ==> x * inv(x) = &1` for any inverted terms "x" appearing in the formula. But it splits up the DNF/CNF and separately tries both REAL_RING and REAL_ARITH on each part, meaning that one can sometimes deduce the nonzero-ness from some inequalities. For example it will prove this: REAL_FIELD `!c. &0 < c /\ &0 < d /\ d < b ==> (a - c) / c + (c - b) / b + ((a - c) / c) * ((c - b) / b) = (a - b) / b`;; Tue 21st Jun 05 define.ml Separated out the initial instantiation of casewise recursion (still called "instantiate_casewise_recursion") and the later first-pass processing of the "superadmissible" hypotheses, the latter now a new function "break_down_admissibility". Also reintroduced into the latter the more aggressive descent through lambdas, removing the sidecondition check on "is_applicative" for going through a lambda. Wed 15th Jun 05 sets.ml Tweaked SET_RULE so before the final MESON it also writes away "IN". This makes it better in cases where there's a mixture of set-style and predicate-style set constructs. I just threw "IN" into the same bunch of rewrites; by the top-down and minimal-generality rules this should always be fine. Fri 3rd Jun 05 Examples/binomial.ml, Examples/prime.ml Cleaned up the proofs a bit; even the definition of the binomial coefficients is easier using "define". Also added the real-number version. Also simplified the proof of EUCLID_BOUND and added an explicit "infinite set" version of the same thing: "PRIMES_INFINITE = |- INFINITE {p | prime p}". Fri 3rd Jun 05 .ml Added a recent copyright banner to all the ML files, except the "pa_j.ml" ones. Fri 3rd Jun 05 hol.ml, Examples/ Made loads keep track of files already loaded together with MD5 checksums in a variable "loaded_files". Added a "needs" function which will act like "loadt" unless the file, with unchanged checksum, has already been loaded. (It would be more rigorous to check the timestamps too, but that seems to require OS-specific stuff, as far as I can see.) Made a few uses of it to show mutual interdependencies of some of the examples. Fri 3rd Jun 05 .ocamlinit, hol.ml, sys.ml Reorganize the system a bit by removing the ".ocamlinit" file and shuffling much of the stuff from this and the root file into "sys.ml". Reorganized the root file so that simply modifying the "hol_dir" on the first line will make everything relocatable. Sun 29th May 05 Makefile Made a trivial-looking change to the Makefile: in the preprocessing directive to build the syntax extension file, changed -pp '...' to -pp "...". The double quotes also work OK in a pure Windows environment at the command prompt, whereas single quotes do not. This problem was pointed out to me by Yuri Matiyasevich. Fri 27th May 05 ind-types.ml Added "cases", which is just a slightly more convenient interface to "prove_cases_thm"; it also handles "num" specially, which otherwise fails because 0 isn't actually a constant. Fri 27th May 05 simp.ml Removed the mostly commented out stuff that's concerned with making simplifier extensions. (I kept it in "Work/simp.ml" in case I want it sometime.) Thu 18th May 05 define.ml Forced the breakdown under admissibility combinators to fail if the function being defined is used in an apparently `higher-order' way, i.e. inside a lambda or not applied to anything at one point in the body. This prevents the breakdown in difficult cases (e.g. the power series example) from going so far that the wellfoundedndess theorem is unprovable. Tue 17th May 05 meson.ml Upped the default MESON limit from 30 to 50. It's occasionally useful for goals where the proof is long but the search space is narrow, and seems harmless. When a smaller bound is required it can always be asserted. Tue 17th May 05 define.ml, wf.ml Moved the lemma MEASURE_LE back into wf.ml, since it seems more general. Mon 16th Mat 05 ind-types.ml, list.ml, sets.ml Added two new stores of injectivity and distinctness theorems and a function to simply look them up: "distinctness" and "injectivity". This avoids repeated calls and the verbose names of "prove_constructors_distinct" and "prove_constructors_injective". Took calls to those out of other files. Fri 13th May 05 iter.ml Added "left" version of the recursion equations for sums, as well as a more matchable "right" version: SUM_CLAUSES_LEFT = |- !f m n. m <= n ==> sum (m .. n) f = f m + sum (m + 1 .. n) f SUM_CLAUSES_RIGHT = |- !f m n. 0 < n /\ m <= n ==> sum (m .. n) f = sum (m .. n - 1) f + f n NSUM_CLAUSES_LEFT = |- !f m n. m <= n ==> nsum (m .. n) f = f m + nsum (m + 1 .. n) f NSUM_CLAUSES_RIGHT = |- !f m n. 0 < n /\ m <= n ==> nsum (m .. n) f = nsum (m .. n - 1) f + f n Fri 13th May 05 arith.ml, passim Also added another theorem I always end up regenerating: LT_NZ = |- !n. 0 < n <=> ~(n = 0) and changed various scripts to make use of it. Fri 13th May 05 theorems.ml, passim Added the two "distribution" theorems that otherwise I always end up recreating manually. In HOL88 they were called "LEFT_AND_OVER_OR" and "RIGHT_AND_OVER_OR"; I hope these names are more consistent with my naming conventions and a bit less of a mouthful. LEFT_OR_DISTRIB = |- !p q r. p /\ (q \/ r) <=> p /\ q \/ p /\ r RIGHT_OR_DISTRIB = |- !p q r. (p \/ q) /\ r <=> p /\ r \/ q /\ r Fixed up scripts to take out some explicit calls to TAUT replacing them with this, and likewise with IMP_IMP and IMP_CONJ. Mon 9th May 05 define.ml [new file] Added a suite of tools for making general recursive definitions. Some of the later stuff is a bit hacky, but it's a good placeholder and so long as I make things upwards compatible, we're OK. Fri 6th May 05 printer.ml Fixed an error in the printing of "let"s. Previously no brackets were printed in `(let x = 2 in x + x) = 4`. Fixed by analogy with the printing of other binders. Thu 5th May 05 int.ml Finally rewrote ARITH_RULE more carefully so that it takes out atomic terms, and generalizes them with a positivity hypothesis in the integer transition, after doing basic normalization to expand products etc. This fixes a lot of problems I've noted over the years with ARITH_RULE not assuming linearity for composite terms that are otherwise treated atomically, even including the alpha-equivalence problem: ARITH_RULE `2 * a * b <= a * b ==> a * b = 0`;; ARITH_RULE `~(k1 * k2 = 0) ==> 1 <= k1 * k2`;; ARITH_RULE `n * n * n <= n * n * n + 1 + n + n * n`;; ARITH_RULE `~(b = 0) ==> 1 <= a * n + b`;; ARITH_RULE `~(p = 0) ==> ~(binade (p,N) b = 0) ==> (binade (p,N) b + p - 1 = binade (p,N) b - 1 + p)`;; ARITH_RULE `2 EXP (p - 1) < k ==> 1 <= k`;; ARITH_RULE `2 * a * b <= a * b ==> a * b = 0`;; ARITH_RULE `2 * a * b EXP 2 <= b * a * b ==> (SUC c - SUC(a * b * b) <= c)`;; ARITH_RULE `7 <= CARD {x | x = 0} ==> 6 < CARD {x | x = 0}`;; Thu 5th May 05 canon.ml Added a conversional to apply a conversion to the "atoms" in a first-order formula: PROP_ATOM_CONV. Thu 5th May 05 wf.ml Added the more sophisticated mix of tail and wellfounded recursion: WF_REC_TAIL_GENERAL = |- !P G H. WF (<<) /\ (!f g x. (!z. z << x ==> f z = g z) ==> (P f x <=> P g x) /\ G f x = G g x /\ H f x = H g x) /\ (!f g x. (!z. z << x ==> f z = g z) ==> H f x = H g x) /\ (!f x y. P f x /\ y << G f x ==> y << x) ==> (?f. !x. f x = (if P f x then f (G f x) else H f x)) Tue 3rd May 05 wf.ml Added wellfoundedness triviality: WF_FALSE = |- WF(\x y. F). Mon 2nd May 05 grobner.ml Added conditional elimination to the pre-canonicalization in RING. So now this works: REAL_RING `p = (&3 * a1 - a2 pow 2) / &3 /\ q = (&9 * a1 * a2 - &27 * a0 - &2 * a2 pow 3) / &27 /\ x = z + a2 / &3 /\ x * w = w pow 2 - p / &3 ==> (z pow 3 + a2 * z pow 2 + a1 * z + a0 = &0 <=> if p = &0 then x pow 3 = q else (w pow 3) pow 2 - q * (w pow 3) - p pow 3 / &27 = &0)`;; Sun 24th Apr 05 sets.ml Added another "how did I manage without it for so long" result about sets and functions: CARD_LE_INJ = |- !s t. FINITE s /\ FINITE t /\ CARD s <= CARD t ==> (?f. IMAGE f s SUBSET t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)) Sat 23rd Apr 05 arith.ml, Examples/pocklington.ml Moved the definition of the "minimal" binder back into the core arithmetic file, since it seems potentially to be quite useful. Fri 22nd Apr 05 iter.ml Added HAS_SIZE_NUMSEG = |- !m n. m .. n HAS_SIZE (n + 1) - m CARD_NUMSEG_1 = |- !n. CARD(1 .. n) = n HAS_SIZE_NUMSEG_1 = |- !n. 1 .. n HAS_SIZE n Fri 22nd Apr 05 sets.ml Added CARD_PSUBSET = |- !a b. a PSUBSET b /\ FINITE b ==> CARD a < CARD b Tue 19th Apr 05 sets.ml Added IN_IMAGE into SET_TAC, which had somehow got forgotten before. Thu 14th Apr 05 sets.ml Added FORALL_IN_CLAUSES = |- (!P. (!x. x IN {} ==> P x) <=> T) /\ (!P a s. (!x. x IN a INSERT s ==> P x) <=> P a /\ (!x. x IN s ==> P x)) EXISTS_IN_CLAUSES = |- (!P. (?x. x IN {} /\ P x) <=> F) /\ (!P a s. (?x. x IN a INSERT s /\ P x) <=> P a \/ (?x. x IN s /\ P x)) Tue 12th Apr 05 iter.ml [new file] Added a new file right at the end of the core build containing segments of natural numbers together with iterated operations in general and the cases of sums of natural numbers ("nsum") and reals ("sum") in particular. Tue 12th Apr 05 realax.ml, real.ml, calc_rat.ml, Examples/analysis.ml Removed the definition of "sum" (realax.ml), as well as all the theorems about it (in real.ml) and the conversions REAL_SUM_CONV, REAL_HORNER_SUM_CONV (from calc_rat.ml). Moved it all into "Examples/analysis.ml", ready to make a nicer version the core default. Thu 7th Apr 05 meson.ml, sets.ml Added MESON, a rule form of MESON_TAC[]. Useful for generating trivial lemmas on the fly. Used it once in "sets.ml"; also made a similar tweak replacing SET_TAC[] proof with SET_RULE. Thu 7th Apr 05 bool.ml Uncommented the line giving "=" precedence 12; I'd like the keep this as the default now. Mon 4th Apr 05 printer.ml Fixed a bug where prefix operators weren't getting parenthesized in the "1000 precedence context" case; this was pointed out by Tom Hales. For example `f (~x) y` and `f x (--(&1))` were printing without brackets. Also fixed the longstanding bug of printing double negations without an intervening space. Sun 3rd Apr 05 Makefile Modified the Makefile so that "hol.multivariate" gets built from "hol" not right from scratch. Also added "hol.sosa" with SOS and analysis and "hol.card" with cardinal arithmetic. Sun 3rd Apr 05 printer.ml Fixed the printer so it doesn't put brackets in right-iterated pairs like `1,2,3`, which formerly printed as `1,(2,3)`. The problem was that when stripping an iterated pair, a comparison with the original "," was done, yet that has a different type. Fixed it by putting a special case for "," in DEST_BINARY. Sat 2nd Apr 05 sets.ml Added three theorems (formerly in Multivariate/misc.ml): SUBSET_RESTRICT = |- !s P. {x | x IN s /\ P x} SUBSET s FINITE_RESTRICT = |- !s p. FINITE s ==> FINITE {x | x IN s /\ P x} CARD_UNION_EQ = |- !s t u. FINITE u /\ (s INTER t = {}) /\ (s UNION t = u) ==> (CARD s + CARD t = CARD u) Fri 1st Apr 05 calc_rat.ml Made both REAL_RING and REAL_ARITH (hence REAL_ARITH_TAC) first write away the decimal notation "#n". Otherwise they failed on trivialities containing decimal numbers, e.g. `~(#1 = #2)`. Mon 28th Mar 05 grobner.ml, int.ml Moved back NUM_SIMPLIFY_CONV and applied it as a prenormalizer to NUM_RING; also made it rewrite SUC to something recongnizable inside. In addition, made the generic RING tactic simply ignore non-equational atoms, rather than choking on them. Fri 25th Mar 05 ind-types.ml Fixed "prove_constructors_distinct" so that it will work with num_RECURSION_STD. (The fact that `0` is not actually a constant was previously causing trouble.) Added "num" to !inductive_type_store and slightly reordered it. More dramatically, added a new store "basic_rectype_net" and a function "extend_rectype_net" to expand it, making the type definition stuff automatically add cases and distinctness theorems to it; also provided a conversion RECTYPE_EQ_CONV to apply it reasonably efficiently at depth. Since there can be quadratically many distinctness clauses, it would be better to have a clever conversion (e.g. via an auxiliary discriminator map into N) but I tried a 100-constructor type and the time to add this stuff was comparable to the time for the core definition. Thu 24th Mar 05 arith.ml Modified NUM_MULTIPLY_CONV so that it doesn't descend into subterms that are unquantified. This is analogous to what's done in CONDS_ELIM_CONV, and perhaps in fact I ought to be doing something more sophisticated like that. Anyway, this fixes a regressive bug that ARITH_RULE was failing on `2 EXP (p - 1) < k ==> 2 EXP (p - 1) <= k - 1` because it was creating a separate quantified formula in both arms of the implication. Sun 20th Mar 05 term.ml, thm.ml, basics.ml, pair.ml, drule.ml Recoded "mk_comb", "is_eq" and "dest_eq" in a somewhat more "pattern-matchy" style. Also PE'd the "mk_const" in "mk_binder". Similarly PE'd MK_FORALL, MK_EXISTS and mk_pair. The efficiency difference doesn't seem to be great, but it is a bit faster. Sun 20th Mar 05 lib.ml Made explicit definitions of "assoc" and "rev_assoc" rather than calling "find". (But kept the exception as "find" for compatibility.) Not so spectacular, but it takes a couple of percent off the load time. Sun 20th Mar 05 thm.ml Inspired by Sean's observation that "find" was taking 70% of the profile, I tried replacing "mk_eq" with a version that does an "inst" rather than a "mk_const" each time. This made the core a *lot* faster (1:25 to build versus 2:11). Mon 14th Mar 05 make.ml Added a call to "Gc.compact()" before the checkpointing in "self_destruct". This often makes the image a lot smaller. Thu 10th Mar 05 tactics.ml Removed old USE_ASSUM which I'd forgotten I ever wrote and duplicates the function of USE_THEN. Tue 8th Mar 05 parser.ml Made a little tweak to the lexical analysis so that you can use the "glue either symbolic or alphanumeric tokens together with underscores" more general in two respects: these identifiers can start with an underscore, and there can be multiple underscores in the glueing section. The immediate motivation was that I wanted to use "_|_" for a perpendicularity relation, but it seems generally sensible. Tue 8th Mar 05 grobner.ml Changed to using WEAK_DNF_CONV, which is a *lot* faster in many cases than the egregious PROP_DNF_CONV; added a custom disjunctive refuter so that we don't need to reassociate the disjuncts. I should probably go one step further as in realarith.ml and use conjuncts directly too, and hence never create the normal forms at all. Fri 4th Mar 05 grobner.ml Fixed a (fairly gross) error in the RING procedure, which was not working properly in relatively trivial cases where there were no "positive" or no "negative" elements in the certificate, notably in degenerate cases like `(x = &0) ==> (&1 = &1)`;; Wed 2nd Mar 05 sets.ml Added use of "IN_ELIM_THM" to SET_TAC. Funny this wasn't done before, but I guess I was mainly using it for combinations of the usual set operators. Also added SET_RULE, not before time. Tue 1st Mar 05 Makefile Simplified the camlp4 library search yet again using "-I +camlp4", which was pointed out to me by Trevor Morris. Thu 17th Feb 05 term.ml Slightly recoded "paconv" in what I think is a clearer style with corresponding matching of the pair of terms. Moreover it should I hope be a little more efficient, with no subcalls to "type_of" and wasteful "alphavars" checking of cases where only one term is a variable. Also did a similar simplification of "type_of"; it now doesn't have the extra "chase length" argument (which didn't pass through abstractions anyway). I hope this simpler version will also be more efficient. Mon 14th Feb 05 sets.ml Added SIMPLE_IMAGE = |- !f s. {f x | x IN s} = IMAGE f s Wed 9th Feb 05 lib.ml, pa_j_3.08.ml, pa_j_3.07+2.ml, tactics.ml, equal.ml Added a few more syntax tweaks so that new infixes work when parenthesized as in "(o)" or "(THEN)". For "o" and "upto" I removed the underscored names, which are not needed. But I can't seem to do the same for the others because the uppercaseness still spoils stuff; nevertheless the underscored names don't need to appear in sources. Also exposed the hashtable (Pa_j.ht) so that additional extensions can do the same thing without needing to copy all the pa_j stuff. I'm planning to use this to deal with Freek's Mizar Light. Wed 9th Feb 05 preterm.ml Made "make_overloadable" accept repetition of the same overload skeleton, and only fail if it differs (could even look for equivalence, i.e. mutual matchability, but I don't think it's worth the additional complexity). Wed 9th Feb 05 parser.ml Changed element-parser in set abstractions from "typed_apreterm" to a new class "nocommapreterm", which is essentially all infix terms that don't, except inside nested brackets etc., use the "," operator. This allows almost all terms to be put as elements in set abstractions, with only pairs requiring the bracketing. I think this is about the best we can do without a more radical change like using ";" or another reserved word as the separator. One might argue it would be more consistent to only allow infixes with higher precedence than ","; that would also be easy to implement if desired. Tue 8th Feb 05 grobner.ml, calc_rat.ml Backed off the introduction of IDEAL_CONV and just put in "ideal_cofactors", which returns the cofactors needed for an ideal certificate, but doesn't actually prove the equality. (This is really what I wanted for use in the Positivstellensatz prover.) However, defined appropriate REAL_IDEAL_CONV since that one might actually be useful. Mon 7th Feb 05 grobner.ml, calc_rat.ml Made a new "RING_AND_IDEAL_CONV" which returns a pair of the old RING procedure plus a more tightly restricted "IDEAL_CONV" that will prove one term is in the ideal generated by the others. In "calc_rat.ml", put instantiations of both of them to the reals: REAL_RING and REAL_IDEAL_CONV. Sun 6th Feb 05 printer.ml Added a flag "print_all_thm", which suppresses the printing of theorem hypotheses if set to false. Sean McLaughlin was wanting this, and I sometimes find it useful myself. It was in fact the default in old HOL88 not to print hypotheses. Sat 5th Feb 05 Makefile, make.ml At the suggestion of Freek Wiedijk, changed the checkpointing signal from TSTP to USR1. This means you can still do the usual ctrl-z suspend of a checkpointed process without causing another checkpoint dump. Thu 3rd Feb 05 arith.ml Added natural number counterparts of the real "without loss of generality" lemmas: WLOG_LE = |- (!m n. P m n <=> P n m) /\ (!m n. m <= n ==> P m n) ==> (!m n. P m n) WLOG_LT = |- (!m. P m m) /\ (!m n. P m n <=> P n m) /\ (!m n. m < n ==> P m n) ==> (!m y. P m y) Thu 3rd Feb 05 canon.ml Refined CONDS_ELIM_CONV/CONDS_ELIM_CONV' so that they appropriately share conditionals with a common condition, even if the things decided by those conditions are different. For example, (if x = 1 then a = 1 else b = 2) /\ (if x = 1 then T else F) will now generate just one case split over x = 1, not two nested ones. Although this may seem like a relatively minor efficiency issue, the change to a more "global" CONDS_ELIM_CONV yesterday was actually breaking some proofs, because the redundant case splits were then causing MESON to hit its split limit. Thu 3rd Feb 05 int.ml Slightly tweaked NUM_SIMPLIFY_CONV to apply NUM_REDUCE_CONV before the elimination of division etc. This makes ARITH_RULE a bit better at handling cases involving unevaluated constant expressions. Wed 2nd Feb 05 canon.ml, realarith.ml, int.ml Modified CONDS_ELIM_CONV so that it takes the topmost formula not involving quantifiers and does the main transformation there; on balance this seems to give the best chance of sharing several with identical tests, and will also make the parity of the newly introduced formulas more controllable; the latter was a problem before in REAL_ARITH. Added parallel CONDS_ELIM_CONV' for contexts where you want a disjunction; attempted to make both keep the right parity as they descend terms (but don't expand any <=>s so you can't really do it right there). Used that in NUM_SIMPLIFY_CONV, which makes conditional-elimination in the discrete decision procedures better. Even though I can now rely better on parity, I added the tweak in REAL_ARITH of doing a preliminary NNF conversion and applying CONDS_ELIM_CONV over the disjuncts, to avoid gratuitous "sharing" among separate subgoals. Fixed a silly bug in INT_ARITH, which simply wasn't applying the initialization conversion and so wouldn't always handle conditionals etc. properly; took the chance to make it more like the reals one. Seems to work pretty well, and this fixes a few regressions such as this (previously this generated a complicated DNF with a = b and ~(a = b) in one disjunct, which wasn't picked up by the core routine). REAL_ARITH `~(x - (if a = b then &1 else &0) <= &0) ==> ~(x = &0)`;; ARITH_RULE `~(multiplicity M x - (if x = a then 1 else 0) = 0) ==> ~(multiplicity M x = 0)` Wed 2nd Feb 05 tactics.ml Only 10 years too late, introduced a few tactics for making more convenient use of labelled assumptions: USE_THEN, REMOVE_THEN and SUBGOAL_TAC. I was actually doing a proof today where quoting the terms was becoming too painful. Also added REPLICATE_TAC, which I occasionally want and end up hacking round. Tue 1st Feb 05 grobner.ml Added "grobner_ideal" to certify that a polynomial is in the ideal generated by another; via a tweak to "resolve_proof" so Start(-1) is treated as zero, I could essentially use the same framework. Next I'll integrate it into an actual HOL conversion. Tue 1st Feb 05 realarith.ml Made the initial normalization, once it's reached a formula (negating the thing to be proved for refutation) ?x1..xn. !y1..ym.... no longer just die if m =/= 0. This spoiled the "ignoring" of hopefully irrelevant subterms, as in: REAL_ARITH `(!x. x + 1 = SUC x) ==> (y:real = y)`;; Now it just specializes them, so it not only does that but even will use universal formulas provided that a completely arbitrary instantiation works: REAL_ARITH `(!x:real. x < x) ==> (w = z:real)`;; This ought to propagate to integer and natural versions too and so fix one or two regressions. Mon 31st Jan 05 grobner.ml Fixed a little potential performance bug: the initial critical pairs were not sorted by "forder", so that entire optimization was only partly useful. Fri 28th Jan 05 Makefile Tidied up the Makefile a bit with more verbose explanations, and made use of "camlp4 -where" instead of the former hack to find the camlp4 library directory. Also added a dependency on "pa_j_3.08.2" (these flaws were pointed out by Tom Hales). Mon 24th Jan 05 bool.ml Backed off the change to precedence of "=" a while longer since I want to make a preliminary quasi-release with Tom's Flyspeck proof. Fri 21st Jan 05 tactics.ml Made the change to ABBREV_TAC slightly less sharp by not looking in the "assumptions of the assumptions" for existing variables. Thu 20th Jan 05 int.ml Made a few little tweaks and improvements to INT_ARITH: treated abs (and now max and min) using the same bubble treatment rather than eliminating them, and avoided explicitly locating and replacing the alien subterms, leaving that to REAL_ARITH; this makes the basic approach applicable even in situations with a more complicated quantifier structure (in case we ever care). Thu 20th Jan 05 bool.ml, passim Finished updating all the Examples for the new precedences; hence made it the default. Now I just need to fix up some of my own proofs, which I can do little by little. Thu 20th Jan 05 realarith.ml, real.ml Moved REAL_POS back into "realarith.ml" for use in REAL_ARITH. Then modified REAL_ARITH (not the general wrapper REAL_ARITH, since one really needs a different notion of 'variable' in the nonlinear case) so that it identifies "alien" subterms of the form "&t" for t not a numeral, and adds positivity hypotheses. This means that REAL_ARITH `&k + x:real <= x`, and more interesting examples, work. But the real advantage is that alien subterms in ARITH_RULE should inherit the effects. Thu 20th Jan 05 int.ml Added a conversion NUM_TO_INT_CONV to convert an assertion over N to a corresponding one over Z. Previously this was embedded in INT_ARITH itself and would only handle universal formulas. But now I want to use it as a subcomponent in Cooper's algorithm too. Modified ARITH_RULE to use this rather than the previous stuff. This now no longer does anything about alien subterms, i.e. "&t" for t a non-numeral. I plan to put this into REAL_ARITH (and so implicitly INT_ARITH) instead, since it may occasionally be useful there anyway. On a quick test of explicitly grepped cases, the only failure in the new version that worked before was the following, and since the3 solution (rewrite with sub-distributivity) seems ad hoc I changed the proof to remove it. `n * b <= 1 * b + c ==> (n - 1) * b <= c` The new version also fixes a number of the bugs I had against the old ARITH_RULE, e.g. `p - 1 <= 2 * p` and `g (f m) < f m + g (f m) + 1`. It still doesn't fix some cases where the bubbling through `known' operators will fail to leave a simple "alien" term for REAL_ARITH, e.g. `~(k1 * k2 = 0) ==> 1 <= k1 * k2`. But they're a bit marginal and maybe I should defer them to a more interesting nonlinear case anyway. Wed 19th Jan 05 int.ml Added NUM_SIMPLIFY_CONV, a somewhat more capable conversion for initial canonicalization of natural number formulas with arbitrary quantifier structure, which reduces pretty much everything to addition and multiplication. It does take care to keep the result universal if the original was, and returns something in NNF. Eventually this will be used in ARITH_RULE (and in Cooper's procedure in the examples). Wed 19th Jan 05 arith.ml Slightly modified NUM_MULTIPLY_CONV to make it a bit better as a component elsewhere: it now puts the newly introduced subterm in NNF, so if the original was in NNF so will be the result. Added a flag which if set will stop it from descending through negations (hence better for a term already in NNF to keep the signs of the subsidiary quantifiers straight). I also removed the initial LAMBDA_ELIM_CONV and COND_ELIM_CONVs which I'd rather be able to choreograph separately. Sun 16th Jan 05 passim Finished fixing up the core so that it works with new scheme for "<=>", and for now returned the precedence of "=" to 2. Sat 15th Jan 05 bool.ml and passim Started the project of making the core safe with "<=>" and a higher precision for "=". Started by adding the following to "bool.ml": parse_as_infix("<=>",(2,"right"));; override_interface ("<=>",`(=):bool->bool->bool`);; parse_as_infix("=",(12,"right"));; Then went through changing "=" into "<=>" in most places; at least all places where it would otherwise break, though I probably missed quite a few "harmless" ones. The medium-term goal is to make the entire core, libraries and proofs I care about work equally well with or without the last one of the above three lines. Then I'll probably be brave enough to use the last line in the production system, and start relying on the new precedence. At least I'm going to use the first two. Fri 14th Jan 05 calc_rat.ml Fixed REAL_RAT_INV_CONV so that "inv(&1 / &n)" or "inv(-- &1 / &n)" return integer constants not non-canonical things like "&n / &1". Fri 14th Jan 05 type.ml, term.ml Added "types()" and "constants()" to return the type and term constants. As Freek had pointed out, now the underlying lists are hidden, one wants some way of looking at them. Fri 14th Jan 05 basics.ml Deleted the near-duplicate definition of "vfree_in", which is already defined in "term.ml". They are perfectly identical assuming the first argument is indeed a variable; there is a small difference in that the term.ml version will accept a constant and tell you if it's free, whereas the deleted one will give false if the first argument is not a variable. I don't think this is ever relied on. I could change it, but (a) it could actually be useful, and (b) it might be marginally faster, and (c) it keeps the core one line shorter. Fri 14th Jan 05 tactics.ml Modified ABBREV_TAC so that it will fail if the chosen abbreviating variable is already used somewhere in the goal. Previously it would just silently pick a variant. Fri 14th Jan 05 printer.ml Made the printer print a space between two "--" negation symbols; previously it wasn't doing so and the result "----" didn't re-parse. Also slightly generalized the circumstances under which it adds a space in "-- &n": now it does it even if n is not a numeral. Fri 14th Jan 05 int.ml Added new definitions int_max and int_min together with int_max_th and int_min_th, and updated the theorem-lifter to deal with them. Hence added integer clones of all the real theorems I added in the last batch: INT_MIN_MAX = |- !x y. min x y = --(max (--x) (--y)) INT_MAX_MIN = |- !x y. max x y = --(min (--x) (--y)) INT_MAX_MAX = |- !x y. x <= max x y /\ y <= max x y INT_MIN_MIN = |- !x y. min x y <= x /\ min x y <= y INT_MAX_SYM = |- !x y. max x y = max y x INT_MIN_SYM = |- !x y. min x y = min y x INT_LE_MAX = |- !x y z. z <= max x y = z <= x \/ z <= y INT_LE_MIN = |- !x y z. z <= min x y = z <= x /\ z <= y INT_LT_MAX = |- !x y z. z < max x y = z < x \/ z < y INT_LT_MIN = |- !x y z. z < min x y = z < x /\ z < y INT_MAX_LE = |- !x y z. max x y <= z = x <= z /\ y <= z INT_MIN_LE = |- !x y z. min x y <= z = x <= z \/ y <= z INT_MAX_LT = |- !x y z. max x y < z = x < z /\ y < z INT_MIN_LT = |- !x y z. min x y < z = x < z \/ y < z INT_MAX_ASSOC = |- !x y z. max x (max y z) = max (max x y) z INT_MIN_ASSOC = |- !x y z. min x (min y z) = min (min x y) z INT_MAX_ACI = |- (max x y = max y x) /\ (max (max x y) z = max x (max y z)) /\ (max x (max y z) = max y (max x z)) /\ (max x x = x) /\ (max x (max x y) = max x y) INT_MIN_ACI = |- (min x y = min y x) /\ (min (min x y) z = min x (min y z)) /\ (min x (min y z) = min y (min x z)) /\ (min x x = x) /\ (min x (min x y) = min x y) Fri 14th Jan 05 list.ml Replaced EX_MEM with the equation the other way round. It's never used anywhere anyway and it seems better to have it consistent with ALL_MEM. It's now: EX_MEM = |- !P l. (?x. P x /\ MEM x l) = EX P l Thu 13th Jan 05 Examples/pratt.ml, Examples/pocklington.ml Renamed an overwritten theorem CONG_SUB_CASES. Actually it's only in pocklington that it gets overwritten, but it seems wise to be consistent. Thu 13th Jan 05 simp.ml, class.ml, pair.ml, wf.ml, ind-types.ml, realax.ml, sets.ml Finally cured the minor but persistent irritant that one can't easily use ETA_AX as a rewrite because it will in general loop on any lambda owing to the higher-order match. The fix was to modify "net_of_thm" to treat an (unconditional) rewrite alpha-equivalent to ETA_AX as a special case with a first order match. Changed various proof scripts to avoid ETA_CONV and just use ETA_AX as a rewrite, which is the usage pattern I now want to establish. Thu 13th Jan 05 real.ml Added a large suite of basic lemmas about max and min, all of which are proved automatically by the new REAL_ARITH_TAC. REAL_MIN_MAX = |- !x y. min x y = --(max (--x) (--y)) REAL_MAX_MIN = |- !x y. max x y = --(min (--x) (--y)) REAL_MAX_MAX = |- !x y. x <= max x y /\ y <= max x y REAL_MIN_MIN = |- !x y. min x y <= x /\ min x y <= y REAL_MAX_SYM = |- !x y. max x y = max y x REAL_MIN_SYM = |- !x y. min x y = min y x REAL_LE_MAX = |- !x y z. z <= max x y = z <= x \/ z <= y REAL_LE_MIN = |- !x y z. z <= min x y = z <= x /\ z <= y REAL_LT_MAX = |- !x y z. z < max x y = z < x \/ z < y REAL_LT_MIN = |- !x y z. z < min x y = z < x /\ z < y REAL_MAX_LE = |- !x y z. max x y <= z = x <= z /\ y <= z REAL_MIN_LE = |- !x y z. min x y <= z = x <= z \/ y <= z REAL_MAX_LT = |- !x y z. max x y < z = x < z /\ y < z REAL_MIN_LT = |- !x y z. min x y < z = x < z \/ y < z REAL_MAX_ASSOC = |- !x y z. max x (max y z) = max (max x y) z REAL_MIN_ASSOC = |- !x y z. min x (min y z) = min (min x y) z REAL_MAX_ACI = |- (max x y = max y x) /\ (max (max x y) z = max x (max y z)) /\ (max x (max y z) = max y (max x z)) /\ (max x x = x) /\ (max x (max x y) = max x y) REAL_MIN_ACI = |- (min x y = min y x) /\ (min (min x y) z = min x (min y z)) /\ (min x (min y z) = min y (min x z)) /\ (min x x = x) /\ (min x (min x y) = min x y) Mon 10th Jan 05 realarith.ml Fixed a little bug: the translator for "Square" in Positivstellensatz proofs was not forcing normalization. Of course this only matters for the extra stuff I'm doing on nonlinear arithmetic outside the core. Mon 10th Jan 05 hol.ml Added an explicit printer for the type "num". I thought this was already there, but apparently not; I guess I just mostly look at small numbers. Mon 10th Jan 05 lib.ml, arith.ml, basics.ml, calc_int.ml, grobner.ml, normalizer.ml, preterm.ml, realarith.ml Added a few bits and pieces: num_0, num_1, num_2, num_10, pow2, pow10, increasing, decreasing. Swept through the other files changing "Int x" to "num_x" for x in 0, 1, 2 and 10. This is hardly a big issue, but we might as well get a little extra partial evaluation. Sat 8th Jan 05 realarith.ml Fixed yet another tiny failure in REAL_ARITH: it was failing if the initial canonicalization already returned `F`. Fri 7th Jan 05 calc_int.ml Made the destructor and tester functions for rationals an integers more careful about excluding non-canonical cases like '--(&0)`, `&5 / &1` and `&2 / &4`. This is more important now these are used in REAL_ARITH as the justification for doing no internal simplification. Fri 7th Jan 05 basics.ml Modified some of the destructors to use direct pattern-matching rather than nested primitive destructors. Rather disappointingly, I see no speedup; in fact if anything it's slower. Thu 6th Jan 05 canon.ml Added two more carefully implemented variants of CNF and DNF, though kept the old olds since they work inside a quantifier prefix and that's depended on sometimes. WEAK_CNF_CONV and WEAK_DNF_CONV force the appropriate conj-of-disj or vice versa, but no association, and STRONG_CNF_CONV and STRONG_DNF_CONV go further and AC-canonicalize. Perhaps I should modify the full conversions to be comparably efficient; at the moment they're just crude rewrites and may be very slow. Thu 6th Jan 05 calc_int.ml, realarith.ml, real.ml, calc_rat.ml Radically updated the reals decision procedure REAL_ARITH (and so REAL_ARITH_TAC). The new version copes with arbitrary numbers, rationals and powers, and uses better data structures for normalization so it can be dramatically faster on big algebraic simplification tasks (though the more general approach can make it a little slower on smaller problems). In addition, sepearated out the integer calculations into a (new) separate file "calc_int.ml", and the decision procedure into another new file "realarith.ml". The procedure is highly parametrized, and in fact it's first bootstrapped over the integers and only extended to cope with rationals later in "calc_rat.ml". It's also ready to incorporate the kind of more general Positivstellensatz certificates that nonlinear procedures may want to use. Thu 6th Jan 05 grobner.ml, list.ml Renamed the more general basis-computing function "grobner_basis"; it seemed a bit inelegant to use "grobner" twice for different things. Removed duplicate (except for one quantifier; anyway it was unused) FORALL_ALL. Thu 6th Jan 05 printer.ml, basics.ml, bool.ml Removed some duplicate definitions of syntax operations; moved all those possible (basically, testers and destructors but not constructors) from "bool.ml" back to "basics.ml", even when the underlying constants haven't been defined. Thu 6th Jan 05 normalizer.ml Fixed a little bug in the normalizer, which would choke on "x pow y" for "y" a non-numeral, rather than the desirable behaviour of returning a reflexive theorem in such a case. Wed 5th Jan 05 realax.ml, int.ml Made the natural-number injection symbol "&" overloaded rather than separately overriden for the integers and reals. Wed 5th Jan 05 calc_rat.ml Fixed "dest_ratconst" and "is_ratconst" (and hence "rat_of_term" which uses the former) so that they refuse to accept rationals with negative or zero denominators. Tue 4th Jan 05 canon.ml, meson.ml Installed a new version of NNF_CONV. This provides a new more general GEN_NNF_CONV which allows a user-installed conversion for the atomic formulas. Moreover, it performs a fancier recursion (computing the NNF of a formula and its negation in parallel) to avoid some recomputation when doing multiple splits of "iff". Finally, it's just more carefully (and painfully) coded than the previous version, which was simply done by rewrites. Threw away the CNF-angling "NNFC_CONV" and made this standard function enter a similar mode below universal quantifiers; hence used the new function in MESON_TAC. This should be better than the old version of NNFC_CONV anyway, which stupidly did the same thing even before passing through quantifiers, less good for initial case splits. Indeed, the new version only gives 1024 basic MESON problems when building the core, whereas the old gives 1939. The speedup is actually quite significant: according to some quick tests, the time to build the core on my laptop is reduced by about 7% to just under 2 minutes. Tue 4th Jan 05 theorems.ml Added EXISTS_UNIQUE = |- !P. (?!x. P x) = (?x. P x /\ (!y. P y ==> (y = x))) Tue 28th Dec 04 lib.ml Incorporated my entire "fpf.ml" file for finite partial functions, which notably adds the "combine" function to what I had before. Tue 28th Dec 04 realax.ml Added definitions of "real_max" and "real_min", as well as incorporating their overloaded forms "max" and "min". Mon 27th Dec 04 meson.ml Deleted unused PREMESON_CANON_TAC. Fri 17th Dec 04 meson.ml Started reworking the basics of MESON_TAC's first order core. Introduced somewhat different and simpler unification algorithm that keeps instantiation in a "graph" (not fully solved) form; also changed the equality test function. Made the unification function more rationally keep the two terms asymmetrical so that you know which the variable offset applies to. Well, this is now a bit neater, but outside the individual unification steps I still in general solve the graph; eventually I'd like to fix this too, and move to a more efficient data structure for instantiations, but that was enough for one day. Mon 13th Dec 04 sets.ml Added some theorems about the cardinality of function spaces with finite "support"/"domain": HAS_SIZE_FUNSPACE = |- !d n t m s. s HAS_SIZE m /\ t HAS_SIZE n ==> {f | (!x. x IN s ==> f x IN t) /\ (!x. ~(x IN s) ==> (f x = d))} HAS_SIZE (n EXP m) CARD_FUNSPACE = |- !s t. FINITE s /\ FINITE t ==> (CARD {f | (!x. x IN s ==> f x IN t) /\ (!x. ~(x IN s) ==> (f x = d))} = CARD t EXP CARD s) FINITE_FUNSPACE = |- !s t. FINITE s /\ FINITE t ==> FINITE {f | (!x. x IN s ==> f x IN t) /\ (!x. ~(x IN s) ==> (f x = d))} Changed the proofs of HAS_SIZE_POWERSET and FINITE_POWERSET to use that as a lemma, and added CARD_POWERSET = |- !s. FINITE s ==> (CARD {t | t SUBSET s} = 2 EXP CARD s) Mon 13th Dec 04 sets.ml, preterm.ml, printer.ml Fixed a long-standing irritation, that IN_ELIM_THM would disturb the internal structure of set abstractions that it didn't eliminate; and at the same time some other apparently harmless theorems like CONJ_ACI could do the same. Fixed this by defining a new constant SETSPEC and using this instead of the conjunction and equation it's equivalent to. SETSPEC = |- SETSPEC v P t = P /\ (v = t) Correspondingly changed IN_ELIM_THM to be more delicate; note that we use a high-order rewrite to ensure that we only eliminate SETSPEC as part of a successful overall elimination: IN_ELIM_THM = |- (!P x. x IN GSPEC (\v. P (SETSPEC v)) = P (\p t. p /\ (x = t))) /\ (!p x. x IN {y | p y} = p x) /\ (!P x. GSPEC (\v. P (SETSPEC v)) x = P (\p t. p /\ (x = t))) /\ (!p x. {y | p y} x = p x) /\ (!p x. x IN (\y. p y) = p x) More ambitiously, I reverted to an old policy of making the implicit bound variables in a set abstraction the ones free on both sides of the "|" in a set enumeration. However, to avoid the problems that caused me to abandon this policy originally, I special-case the two cases: (1) when there is exactly one free variable on the left of "|", we always consider it bound, and (2) if there are no free variables on the right of the "|" we just consider all those on the left bound. I hope this will be much more useful. Fri 10th Dec 04 sets.ml Added a generalized form of yesterday's theorem; the original is a trivial consequence of this one. SURJECTIVE_IFF_INJECTIVE_GEN = |- !s t f. FINITE s /\ FINITE t /\ (CARD s = CARD t) /\ IMAGE f s SUBSET t ==> ((!y. y IN t ==> (?x. x IN s /\ (f x = y))) = (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))) Also added a couple of simple consequences: IMAGE_IMP_INJECTIVE_GEN = |- !s t f. FINITE s /\ (CARD s = CARD t) /\ (IMAGE f s = t) ==> (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) IMAGE_IMP_INJECTIVE = |- !s f. FINITE s /\ (IMAGE f s = s) ==> (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) Also added one more triviality: HAS_SIZE_CARD = |- !s n. s HAS_SIZE n ==> (CARD s = n) Thu 9th Dec 04 sets.ml Added the classic theorem that a function from a finite set into itself is injective iff surjective. Quite surprising I've managed without it all these years... SURJECTIVE_IFF_INJECTIVE = |- !s f. FINITE s /\ IMAGE f s SUBSET s ==> ((!y. y IN s ==> (?x. x IN s /\ (f x = y))) = (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))) Mon 6th Dec 04 README, Examples/pratt.ml, Examples/pocklington.ml Some minor tidying up: described the new Make process better and made the two primality-proving routines use the standard "Filename.temp_file" function rather than an ad-hoc alternative of my own. Fri 3rd Dec 04 sets.ml Added HAS_SIZE_CLAUSES = |- (s HAS_SIZE 0 = (s = {})) /\ (s HAS_SIZE SUC n = (?a t. t HAS_SIZE n /\ ~(a IN t) /\ (s = a INSERT t))) which is more useful in many cases than the "more general" HAS_SIZE_SUC; in particular one can just blindly apply num_CONV and that rewrite rule to produce expressions for a set known to have a particular number of elements. Added a conversion HAS_SIZE_CONV to do this expansion in a fairly efficient and controlled way. Also added PAIRWISE and "pairwise", which I hope will be useful. Thu 2nd Dec 04 Makefile Tidied up the Makefile a bit and made it issue a more explanatory failure if the native OS isn't Linux and the user tries to build a checkpointed image. Wed 1st Dec 04 Makefile, make.ml [new file] Set up a build process for images using "ckpt". It's slightly hacky with the process sending out a signal to suspend itself, but it seems to work. Wed 1st Dec 04 lib.ml Changed the representation of finite partial functions to the canonical Patricia tree form instead of the AVL variant that was there before. Wed 1st Dec 04 canon.ml, ind-defs.ml, ind-types.ml, Examples/transc.ml Added hand-coded rules CONJ_ACI_RULE and DISJ_ACI_RULE for reordering conjunctions and disjunctions. Got rid of some more ad-hoc implementations in other files. Tue 30th Nov 04 sets.ml Added CARD_EQ_0 = |- !s. FINITE s ==> ((CARD s = 0) = (s = {})) and IMAGE_CONST = |- !s c. IMAGE (\x. c) s = if s = {} then {} else {c} Mon 29th Nov 04 sets.ml Modified FORALL_PASTECART to |- (!p. P p) = (!x y. P (pastecart x y)) and added EXISTS_PASTECART = |- (?p. P p) = (?x y. P (pastecart x y)) Sat 27th Nov 04 printer.ml Fixed the internal precedence setting when printing lists, so that no redundant bracketing is done. Before `[1,2]` would print as `[(1,2)]`. Of course some people might regard that as a feature... Sat 27th Nov 04 sets.ml Added a natural dual to FORALL_IN_IMAGE, namely EXISTS_IN_IMAGE = |- !f s. (?y. y IN IMAGE f s /\ P y) = (?x. x IN s /\ P (f x)) as well as this useful lemma: SUBSET_IMAGE = |- !f s t. s SUBSET IMAGE f t = (?u. u SUBSET t /\ (s = IMAGE f u)) Replaced the old FINITE_SUBSET_IMAGE, which is now called FINITE_SUBSET_IMAGE_IMP, with the stronger result: FINITE_SUBSET_IMAGE = |- !f s t. FINITE t /\ t SUBSET IMAGE f s = (?s'. FINITE s' /\ s' SUBSET s /\ (t = IMAGE f s')) Wed 24th Nov 04 list.ml Added LENGTH_MAP2 = |- !f l m. (LENGTH l = LENGTH m) ==> (LENGTH (MAP2 f l m) = LENGTH m) Tue 23rd Nov 04 list.ml Added LENGTH_EQ_CONS = |- !l n. (LENGTH l = SUC n) = (?h t. (l = CONS h t) /\ (LENGTH t = n)) Fri 19th Nov 04 sets.ml Added two more useful theorems of function calculus, generalizing the "injectivity" and "surjectivity" theorems, which are the special case of identity: FUNCTION_FACTORS_LEFT = |- !f g. (!x y. (g x = g y) ==> (f x = f y)) = (?h. f = h o g) FUNCTION_FACTORS_RIGHT = |- !f g. (!x. ?y. g y = f x) = (?h. f = g o h) I suppose I ought, by analogy with the injectivity and surjectivity ones, to prove them with set restrictions too. Mon 15th Nov 04 real.ml Added REAL_SUB_INV = |- !x y. ~(x = &0) /\ ~(y = &0) ==> (inv(x) - inv(y) = (y - x) / (x * y)) Mon 15th Nov 04 sets.ml Added the suite of useful lemmas relating (local) injectivity and surjectivity to left and right inverses: SURJECTIVE_ON_RIGHT_INVERSE = |- !f t. (!y. y IN t ==> (?x. x IN s /\ (f x = y))) = (?g. !y. y IN t ==> g y IN s /\ (f (g y) = y)) INJECTIVE_ON_LEFT_INVERSE = |- !f s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) = (?g. !x. x IN s ==> (g (f x) = x)) SURJECTIVE_RIGHT_INVERSE = |- (!y. ?x. f x = y) = (?g. !y. f (g y) = y) INJECTIVE_LEFT_INVERSE = |- (!x y. (f x = f y) ==> (x = y)) = (?g. !x. g (f x) = x) Sun 14th Nov 04 sets.ml Added FORALL_PASTECART = |- (!p. P (fstcart p) (sndcart p)) = (!x y. P x y) Mon 8th Nov 04 sets.ml Added FORALL_IN_UNIONS = |- !P s. (!x. x IN UNIONS s ==> P x) = (!t x. t IN s /\ x IN t ==> P x) Fri 5th Nov 04 sets.ml Added PASTECART_EQ = |- !x y. (x = y) = (fstcart x = fstcart y) /\ (sndcart x = sndcart y) Fri 5th Nov 04 sets.ml Added DIMINDEX_GE_1 = |- !s:A->bool. 1 <= dimindex(s), which is trivial but often useful. Thu 4th Nov 04 sets.ml Added stuff for pasting together two Cartesian products; the type constructor "finite_sum", pairing and projection functions "pastecart", "fstcart" and "sndcart", together with the following theorems: DIMINDEX_HAS_SIZE_FINITE_SUM, DIMINDEX_FINITE_SUM, FSTCART_PASTECART, SNDCART_PASTECART and PASTECART_FST_SND. Thu 4th Nov 04 real.ml, int.ml, Examples/analysis.ml Fixed a trivial and long-standing bug. The theorem REAL_LET_ANTISYM is what should have been called REAL_LTE_ANTISYM. Moreover, the latter didn't exist but was misspelled as REAL_LTE_ANTSYM, and was the wrong way round too! This has been changed to do the obviously right thing. The corresponding change was made for the integers too. Thu 4th Nov 04 parser.ml Added the "atleast" parser combinator, just because I've found it handy in other contexts. Tue 2nd Nov 04 sets.ml Added UNION_SUBSET = |- !s t u. (s UNION t) SUBSET u = s SUBSET u /\ t SUBSET u Thu 28th Oct 04 type.ml, term.ml After asking on the OCaml list, I found out (thanks to Andrej Bauer, William Lovas and Brian Rogoff) that there's a way of making type constructors visible in pattern matching yet still disallowing their use as constructors, by using the explicit type definition together with the "private" keyword in the signature. So I changed the abstract type definitions of types and terms in that way. That's good, because it won't require people like Tom Hales who've written code by pattern-matching to change it now I have a proper LCF core. And maybe I can start defining things that way myself now; it should be much cleaner and probably more efficient. Tue 19th Oct 04 Makefile Modified the Makefile to eliminate the hardwired path to camlp4 (this was pointed out by Sean); now it looks for the ocaml binary and guesses the camlp4's library directory based on that. Tue 12th Oct 04 type.ml, term.ml, thm.ml Changed the three instances of "open" for the core modules to "include". This was pointed out by Freek --- the effect is the same but one no longer gets the irritating qualifiers "Term.term" etc. Mon 11th Oct 04 arith.ml Added NUM_MULTIPLY_CONV, which should fairly reliably remove all the "nasties" from statements about N: predecessor, cutoff subtraction, division and modulus, plus abstractions and conditionals. This could possibly be a precursor to a clever decision procedure; at least it makes it easy to adapt my Cooper implementation for the linear case. Mon 11th Oct 04 arith.ml Modified the definitions of DIV and MOD to force them both to be zero when the divisor is zero. This does make DIV consistent with the reals in that case, and more importantly it made possible the next part of the change: changed DIVMOD_ELIM_THM into a simple equality. Previous fixes were on the plane; made the last in O'Hare airport. Mon 11th Oct 04 meson.ml Moved the generalization over free variables in MESON to a later phase when everything has been loaded into the conclusion. This works better in situations where you have a given Boolean variable free in both assumptions and conclusion, by eventually forcing a case split. Mon 11th Oct 04 printer.ml Modified the printing of types so it uses precedence and associativity of type constructors in order to reduce the bracketing; formerly it just blindly bracketed all nested infixes. Mon 11th Oct 04 printer.ml Fixed a misfeature in the treatment of binary operators. They are broken up iteratively as an easy was of getting a list to then treat according to specified associativity. But previously the splitup was done based only on the head operator name, ignoring the type, so that the apparent iteration of a single operator could actually be multiple type instances. This was particularly striking after doing the <=>/= redefinition below, when `1 = 2 <=> 2 = 3` would print as `1 = 2 <=> 2 <=> 3`;; Sat 9th Oct 04 grobner.ml [new file] Added a new "generic" Grobner basis procedure and its instantiation to N. This essentially uses Nullstellensatz certificates, so it's only really complete for C, but still gets a lot of "natural" stuff on other rings and semirings. It uses Strong Nullstellensatz certificates to avoid using any field properties to do the Rabinowitsch trick. (If one does have a field it's probably more efficient to use Weak Nullstellensatz certificates directly and in fact do proof generation without explicitly contructing the certificate --- the hooks are all there to do this if desired.) Roughly, it's complete for the universal theory of commutative cancellation semirings with no nilpotents and characteristic zero, I think. Sat 9th Oct 04 lib.ml, calc_rat.ml Added "lcm_num", "merge" and "mergesort", and moved "gcd_num", "numdom", "numerator" and "denominator" back from "calc_rat.ml". Also modified "allpairs" to use appending rather than unioning; I think in most applications that's actually what's wanted. Sat 9th Oct 04 parser.ml Removed the hacky special treatment of equality among the binary operators. I think this was only necessary because of the lack of a left bracketing symbol in the old conditionals notation, which I've just scrubbed. Now the infixes are treated in a completely regular way based only on the list of precedences and associativities. Among other things, this makes possible a simple change to a "better" way of dealing with "=" and "<=>" that Freek at least wanted and I might end up making the default: parse_as_infix("<=>",(2,"right"));; override_interface ("<=>",`(=):bool->bool->bool`);; parse_as_infix("=",(15,"right"));; Sat 9th Oct 04 parser.ml, Examples/analysis.ml, Examples/transc.ml, Examples/poly.ml Eliminated the old notation ".. => .. | .." for conditionals; now only the preferred notation "if .. then .. else .." is accepted. Removed it from the parser and eliminated the only remaining uses elsewhere in the system. Also unreserved the "=>" symbol, though not "|" which is also special in set abstractions. Sat 9th Oct 04 term.ml Changed "aconv" to use "Pervasives.compare tm1 tm2 = 0" rather than simply "tm1 = tm2". This is Xavier Leroy's recommended solution in response to an observation by Christophe Raffalli on the OCaml list that the builtin equality no longer guarantees an early-out in the case of pointer eq. A quick test on my laptop indicates that the build time for the core goes down from 2m7.845s to 1m58.681, nearly an 8% improvement. With non-trivial proofs containing big terms, the difference might be much more. Wed 6th Oct 04 drule.ml Modified "PART_MATCH" so that it fails if any type variables in the hypothesis get instantiated; previously it only checked for terms in the assumptions becoming instantiated, and this can lead to some oddities in rewriting, e.g. let th1 = ASSUME `f = \s f x:A. if x IN s then f(x) else &0`;; let th2 = BETA_RULE (AP_THM th1 `s:A->bool`);; let th3 = SYM(BETA_RULE(AP_THM th2 `f:A->real`));; GEN_REWRITE_CONV I [th3] `\a:B. if a IN s then f a else &0`;; Tue 5th Oct 04 meson.ml Made one more small tweak to the new MESON canonicalization, to generalize the goal first. Though this normally disappears, it's beneficial if the variables are Boolean since it allows for subsequent elimination. This finally fixes a problem Mike Gordon pointed out back on 15th March 2001, that MESON_TAC fails on `?b. b = ~a`. Mon 4th Oct 04 arith.ml, real.ml, int.ml, Examples/pratt.ml Examples/pocklington.ml Examples/cong.ml Introduced congruence notation "(x == y)" and three overloaded variants of "mod" for the three basic number systems. All non-trivial stuff is delegated to Examples files, but at least this gives a uniform approach; formerly the two prime-number-proving files used a congruence that, while superficially similar, was defined in a completely different way. Mon 4th Oct 04 meson.ml With some trepidation, put a new initial normalizer into MESON_TAC. This should split conditionals and treat select-terms and abstractions with a degree of intelligence; this has long been a weak spot of MESON_TAC. I was pleasantly surprised how little stuff broke, and the ability to handle more things is already quite useful. Mon 4th Oct 04 bool.ml Added syntax operations for "unique exists": is_uexists, dest_uexists and mk_uexists. Mon 4th Oct 04 class.ml Added FORALL_BOOL_THM and EXISTS_BOOL_THM to deal with quantification over Booleans. Mon 4th Oct 04 canon.ml Eliminated the old "EQ_ABS_CONV" and "DELAMB_CONV", which are respectively not so very useful and only used by MESON. Slightly modified SPLIT_TAC, which will now be used by MESON instead of a bespoke variant. Added several new functions: SELECT_ELIM_CONV, SELECT_ELIM_ICONV, SELECT_ELIM_TAC, LAMBDA_ELIM_CONV and CONDS_ELIM_CONV. Sat 2nd Oct 04 trivia.ml, ind-types.ml Renamed the type "one" to "1". Didn't change any theorem names, but also added the obvious one_INDUCT and one_RECURSION and included them in the inductive type store (they were forgotten before). Also defined types "2" (with 2 elements) and "3" (with 3 elements), since I think all of them will be natural when using low-dimensional vectors ("real^3" etc.) Fri 1st Oct 04 sets.ml Changed FINITE_INTER to |- !s t. FINITE s \/ FINITE t ==> FINITE (s INTER t) where before it had a conjunction in the assumption, gratuitously weak. Fri 1st Oct 04 bool.ml Changed the bound variable names in the connective definitions to be more intuitive, e.g. "p" (not "P" or "t1") for Booleans, as suggested by Heath Putnam. Thu 30th Sep 04 term.ml, thm.ml Completed the basic "LCF-ization" by making terms and theorems into proper abstract types. Thu 30th Sep 04 drule.ml Removed use of "paconv" in PART_MATCH; I wanted to hide "paconv" and the new version is more efficient anyway. Wed 29th Sep 04 type.ml Made "hol_type" an abstract type, the first step in the more rigorous "LCF-ification". This was fairly painless; the only hidden value is a "the_type_constants" reference, which seems not to be used anywhere anyway. Wed 22nd Sep 04 hol.ml Modified the default setting of "hol_dir" so that if the "HOLDIR" environment variable isn't set, it will default to the current directory. The problem with the existing default was pointed out by Joe Hurd: it only really fits with my personal setup, whereas the current directory fits the intended build process. Wed 23rd Jun 04 sets.ml Added IMAGE_EQ_EMPTY = |- !f s. (IMAGE f s = {}) = (s = {}) and FORALL_IN_IMAGE = |- (!y. y IN IMAGE f s ==> P y) = (!x. x IN s ==> P(f x)) Mon 7th Jun 04 simp.ml Fixed an error in the treatment of "higher-order" congruence rules. Still, these need to be chosen with care otherwise beta-redexes arise in matching and send us into a loop. Wed 2nd Jun 04 parser.ml, printer.ml, sets.ml Added a new type of finite Cartesian products with a supported infix syntax `:A^B`, an indexing function so elements of `x` can be accessed by `x$1` ... `x$n`, and even a syntax for lambdas. If the type A is infinite, then it forces a 1-element type, otherwise uses an isomorphic image of A. The immediate motivation for this was multivariate calculus, but given that parser and printer support is needed anyway it seemed worth adding to the core. Various theorems have been included at the end of "sets.ml". Wed 2nd Jun 04 thm.ml Modified the basic type definition function so it sorts the type variables into alphabetical order. It's a pity to put sorting into the core, but we could if desired use some ultra-simple version. Without this there's no way of enforcing the right order of type variables, in particular for Cartesian products being defined. Wed 2nd Jun 04 sets.ml Added HAS_SIZE_IMAGE_INJ = |- !f s n. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\ s HAS_SIZE n ==> (IMAGE f s) HAS_SIZE n Wed 12th May 04 sets.ml Strengthened num_FINITE from an implication to an equality: |- !s:num->bool. FINITE s = ?a. !x. x IN s ==> x <= a. Thu 6th May 04 preterm.ml Completely rewrote the typechecker. The initial motivation was to fix the fact that overload resolution was not working when the possible types could contain type variables, e.g. "N->real" for addition in multivariate calculus. But I took the chance to completely rewrite the typechecker in a more functional style so that I understand it, expunging the last non-trivial piece of hol90 code remaining in HOL Light. I suspect the new version is less efficient, but this is not really an issue for typical use. Sat 24th Apr 04 hol.ml Modified the "use_file" function used by "loads" and "loadt" so that it just returns quietly in the event of failure instead of raising an exception. The former behaviour resulted in OCaml rolling back the symbol table to the point before the load. The new behaviour is compatible with "#use" itself. However, I'd really like to make everything stop on the first error... Fri 23rd Apr 04 pa_j.ml, Makefile, .ocamlinit Replaced the old pa_j.ml, which doesn't work under 3.07, with a modified version kindly provided by Carl Witty. Also added a Makefile encapsulating the simple build process he pointed out to me. Fri 16th Apr 04 normalizer.ml Added parametrization over a variable ordering instead of assuming the default ordering. The impetus was the desire to re-use this inside the Cooper quantifier elimination procedure, in which case we want to use the order of quantifiers to decide the order of variables for easiest elimination. Also added SEMIRING_NORMALIZERS_CONV which exposes a whole suite of arithmetic operation conversions as well as the overall normalizer. Thu 8th Apr 04 lib.ml Renamed "funset" (map a finite partial function to a set representation of its graph) to just "graph". Wed 31st Mar 04 preterm.ml Fixed a bug in overloading, which was not following its promise to utilize polymorphic matching rather than simple equality among the possible alternative types. It was always assigning the generic type instead of the one resulting from matching, which of course results in an overall typechecking failure. Wed 31st Mar 04 arith.ml Added SUC_SUB1 = |- !n. SUC n - 1 = n, which I often use but is not in the main core arith file. Tue 30th Mar 04 theorems.ml Added the following two theorems, which I keep on regenerating for proofs: IMP_CONJ = |- p /\ q ==> r = p ==> q ==> r IMP_IMP = |- p ==> q ==> r = p /\ q ==> r Thu 26th Feb 04 real.ml Added "without loss of generality assume x <= y" (or "x < y") lemmas: REAL_WLOG_LE = |- (!x y. P x y = P y x) /\ (!x y. x <= y ==> P x y) ==> (!x y. P x y) REAL_WLOG_LT = |- (!x. P x x) /\ (!x y. P x y = P y x) /\ (!x y. x < y ==> P x y) ==> (!x y. P x y) Tue 3rd Feb 04 arith.ml Added a couple of theorems that embody some "exclusion zone" reasoning about integer quotients, and are quite tedious to derive for the cases in hand. DIV_LE_EXCLUSION = |- !a b c d. ~(b = 0) /\ b * c < (a + 1) * d ==> c DIV d <= a DIV b DIV_EQ_EXCLUSION = |- b * c < (a + 1) * d /\ a * d < (c + 1) * b ==> (a DIV b = c DIV d) Tue 25th Nov 03 wf.ml Added a more general form of the wellfounded recursion theorem with an "inductive invariant", based on the paper by Krstic and Matthews in TPHOLs'03. As they point out, this is much more useful for nested recursions like: `?g. !x. g(x) = if x = 0 then 0 else g(g(x - 1))` The proof can be condensed a bit by relying on MESON more but it gets rather slow in that case: let WF_REC_INVARIANT = prove (`WF(<<) ==> !H S. (!f g x. (!z. z << x ==> (f z = g z) /\ S z (f z)) ==> (H f x = H g x) /\ S x (H f x)) ==> ?f:A->B. !x. (f x = H f x)`, let lemma = prove_inductive_relations_exist `!f:A->B x. (!z. z << x ==> R z (f z)) ==> R x (H f x)` in REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN X_CHOOSE_THEN `R:A->B->bool` STRIP_ASSUME_TAC lemma THEN SUBGOAL_THEN `!x:A. ?!y:B. R x y` (fun th -> ASM_MESON_TAC[th]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `!x:A y:B. R x y ==> S x y` MP_TAC THEN ASM_MESON_TAC[]);; Mon 1st Sep 03 term.ml Fix for a second soundness bug, this time found by Bob Solovay; it was later independently discovered by Kevin Watkins. There was an asymmetry in the way alpha-conversion made its tests, which didn't check the proper correspondences between binding instances. let A = `\z:num. \z:num.z` and B = `\x:num. \y:num. x` in CONV_RULE NUM_REDUCE_CONV (BETA_RULE (AP_THM (AP_THM (ALPHA B A) `1`) `2`));; The new version, instead of using "assoc", traverses the environment more carefully checking proper correspondence. Wed 27th Aug 03 lib.ml Added "ran" (range of a finite partial function). Mon 18th Aug 03 normalizer.ml Added a new file, with a generic (semi)ring normalizer and its instantiation to the natural numbers. Later, this will be used more, e.g. in REAL_ARITH instead of the current mediocre version. Fri 15th Aug 03 sets.ml Added operations on set enumerations: dest_setenum, is_setenum, mk_setenum, mk_fset and some conversions SETIFY_CONV and SET_UNION_CONV. I suppose I should add a whole set eventually. Tue 22nd Jul 03 term.ml Did a bit of tidying up of the revised "inst" function, reinstating Boultonization of the Abs case and removing a redundant "qtry". Actually, we could now remove "qtry" from "lib.ml", and indeed get rid of "qcomb[2]" with only one change to the core. Fri 19th Jul 03 term.ml Made a preliminary fix to "inst" in order to fix a serious error leading to a soundness bug found by Tom Hales (the first soundness bug since 1996). The "unchanged" short-circuiting was bypassing the test for consistency with the environment, which can still fail even when the current variable is unchanged. I still need to think more carefully about this code, though. Here is my simplification of Tom's way of reaching a false theorem: let th0 = prove (`(?p:bool#B. P p) ==> ?x y. P(x,y)`, REWRITE_TAC[EXISTS_PAIR_THM]);; let th1 = CONV_RULE (RAND_CONV (BINDER_CONV (GEN_ALPHA_CONV `x:B`))) th0;; let th2 = INST_TYPE [`:bool`,`:B`] th1;; Mon 5th May 03 lib.ml and passim Made the trivial change of changing "sort" from uncurried to curried (the expected order is now 'a -> 'a -> bool not 'a # 'a -> bool). This meant a lot of trivial changes elsewhere, but it's worth getting it right once and for all. I also added all the "finite partial" functions stuff, which I've found very useful in my book code. This is useful for implementing some lookup structures a bit more efficiently. This also requires some changes elsewhere, changing "apply" to "apply_prover" in "simp.ml". Fri 4th Apr 03 arith.ml Added EVEN_ODD_DECOMPOSITION = |- !n. (?k m. ODD m /\ (n = 2 EXP k * m)) = ~(n = 0) Fri 7th Mar 03 list.ml Added APPEND_EQ_NIL = |- !l m. (APPEND l m = []) = (l = []) /\ (m = []) Thu 6th Mar 03 wf.ml Added a tactical and tactic WF_INDUCT_THEN and WF_INDUCT_TAC to perform wellfounded induction over a natural number measure. I do this quite often and I'm getting fed up with manually introducing a tweaked goal with a new variable etc. Wed 5th Mar 03 sets.ml Added CARD_IMAGE_LE = |- !f s. FINITE s ==> CARD(IMAGE f s) <= CARD s Tue 4th Mar 03 sets.ml Added a "dependent" generalization of a previous theorem: FINITE_PRODUCT_DEPENDENT = |- !s t. FINITE s /\ (!x. x IN s ==> FINITE (t x)) ==> FINITE {x,y | x IN s /\ y IN t x} Thu 27th Feb 03 parser.ml Made carriage return ("\r", 0x0d) another space. This is helpful on Windows, which normally uses CR/LF pairs for newline. Mon 24th Feb 03 sets.ml Added two theorems about cardinality of Cartesian products: CARD_PRODUCT = |- !s t. FINITE s /\ FINITE t ==> (CARD {x,y | x IN s /\ y IN t} = CARD s * CARD t) HAS_SIZE_PRODUCT = |- !s m t n. s HAS_SIZE m /\ t HAS_SIZE n ==> {x,y | x IN s /\ y IN t} HAS_SIZE m * n as well as "<=" versions of existing theorems for "<": HAS_SIZE_NUMSEG_LE = |- !n. {m | m <= n} HAS_SIZE n + 1 CARD_NUMSEG_LE = |- !n. CARD {m | m <= n} = n + 1 FINITE_NUMSEG_LE = |- !n. FINITE {m | m <= n} Fri 31st Jan 03 int.ml Removed spurious "integer" theorems that keep in the type destructors: INT_INV_0, INT_MUL_LINV, INT_POW_INV. Also tweaked INT_OF_REAL_THM so it handles conditionals (by adding a theorem to push "dest_int" through a conditional), and thus INT_POW_NEG is now what it was always supposed to be instead of having the spurious "dest_int"s. Fri 31st Jan 03 int.ml Added more pseudo-definitions (they are definitions on the reals) INT_GT, INT_LT and INT_SUB. Tue 28th Jan 03 int.ml Added INT_LT_TOTAL, which had got left out (probably because it was one of the real-closed field "axioms" over the reals). Tue 26th Nov 02 passim Made various changes to make HOL Light work in OCaml 3.06. The Camlp4 preprocessing can now be switched on and off with the magic identifiers "set_jrh_parsing" and "unset_jrh_parsing". Also set things up to look in $HOME/holl before defaulting to "johnh". Fri 1st Nov 02 real.ml Added another couple of handy theorems about finite sums: SUM_MORETERMS_EQ = |- !m n p. n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f r = &0)) ==> (sum (m,p) f = sum (m,n) f) SUM_DIFFERENCES_EQ = |- !m n p. n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f r = g r)) ==> (sum (m,p) f - sum (m,n) f = sum (m,p) g - sum (m,n) g) Fri 1st Nov 02 arith.ml Another basic theorem about DIV and MOD added. Will it never end? DIV_MONO2 = |- !m n p. ~(p = 0) /\ p <= m ==> n DIV m <= n DIV p Thu 31st Oct 02 real.ml Added SUM_EQ_0 = |- (!r. m <= r /\ r < m + n ==> (f r = &0)) ==> (sum (m,n) f = &0) There were already several theorems of that kind, but none of them quite in the natural convenient form I keep wanting. Thu 17th Oct 02 real.ml Added SUM_SWAP = |- !f m1 n1 m2 n2. sum (m1,n1) (\a. sum (m2,n2) (\b. f a b)) = sum (m2,n2) (\b. sum (m1,n1) (\a. f a b)) Wed 16th Oct 02 real.ml Added SUM_SPLIT = |- !f n p. sum(m,n) f + sum(m + n,p) f = sum(m,n + p) f, a useful generalization of SUM_TWO, which required a zero start. Tue 15th Oct 02 arith.ml Added DIV_MONO_LT = |- !m n p. ~(p = 0) /\ m + p <= n ==> m DIV p < n DIV p Mon 14th Oct 02 class.ml Finally added the following theorem, which I should use consistently instead of CONTRAPOS_CONV. I keep generating it by hand... let CONTRAPOS_THM = TAUT `!t1 t2. (~t1 ==> ~t2) = (t2 ==> t1)`;; Tue 13th Aug 02 wf.ml Couldn't resist putting in the simpler proof of WF_REC, where by using FIRST_X_ASSUM, the MESON proof search is quite feasible. I'd used this as an example at my PaPS invited talk and discussed it with Freek, so had started looking at the proof again. Tue 14th May 02 lib.ml Tidied up "lib.ml" in order to make things more consistent between CAML Light and OCaml versions. Also tweaked "partition" to do eq-optimization of either "yes" or "no" results. Mon 5th May 02 lib.ml Changed "forall", "exists" and "forall2" to treat list lazily; the previous implementations in terms of itlist did not have this property! This triviality improves runtimes by 3.5% Wed 4th Apr 02 lib.ml, type.ml, recursion.ml, preterm.ml, real.ml, term.ml Set up "assocd" and "rev_assocd" to return given defaults rather than failure; made use of these to replace a few of "try [rev_]assoc ... with Failure _ ->" idioms. Perhaps this should be done by more general functions that take a continuation, to allow us to scrub most of the others? Wed 4th Apr 02 lib.ml, type.ml, term.ml, meson.ml Changed "qmap" to propagate pointer equality not use the "Unchanged" exception. Modified type substitution and the meson FOL shadow syntax operations to work this way. Still need to do the same to terms. Tue 5th Mar 02 term.ml, basics.ml, thm.ml Moved a definition of "vfree_in" from basics.ml into term.ml and added a few function "freesin". Modified the inference rules to use these instead of "frees". This was motivated by the fact that GEN "x" (!x. Big[x] |- small[x]) took forever, since a full "frees" of the big assumption is performed. Admittedly this expands the size of the core, but the new functions are even simpler than "frees". It would perhaps be nice to eliminate "frees" completely from the core; it's now only used in variant-finding, and this could presumably be modified to use the new functions. Mon 4th Mar 02 pa_j.ml Added a new extension to bind the last toplevel expression to "it". The code was provided by Daniel de Rauglaudre in response to my question on the CAML list, following on from someone else wanting the same thing. Wed 13th Feb 02 drule.ml Further modified "new_definition" so that it uses recalled benign definitions correctly rather than taking the underlying definition as the overall theorem. Tue 12th Feb 02 drule.ml Modified "new_definition" so that it does in fact enter definitions in the store used to accept benign redefinitions --- previously this store was checked but not updated! Fri 8th Feb 02 sets.ml Changed the mis-named FINITE_RECUSION_DELETE to FINITE_RECURSION_DELETE. Fri 8th Feb 02 Ported HOL Light from CAML Light to OCaml (3.04), with hacked syntax to make "*" the special identifiers reserved for type constructors and modules, and with perverted-comma `...` quotations as well as <<...>>. The syntax modifier is kept in "pa_j.ml". Some minor syntactic changes were needed in most filed; only the following are unchanged: itab.ml, list.ml, nets.ml, num.ml, sets.ml, theorems.ml, wf.ml The names of useful functions and theorems are maintained, with the following exceptions (and lazy -> lazify but I never use that): Sum --> sum (the real number sum contravened even modified case conventions) assert -> check (assert is a reserved word with incompatible behaviour) Wed 6th Feb 02 arith.ml Added DIV_ADD_MOD = |- !a b n. ~(n = 0) ==> (((a + b) MOD n = a MOD n + b MOD n) = ((a + b) DIV n = a DIV n + b DIV n)) and DIV_REFL = |- !n. ~(n = 0) ==> (n DIV n = 1) and MOD_LE = |- !m n. ~(n = 0) ==> m MOD n <= m Tue 5th Feb 02 sets.ml Added ITSET_EQ = |- !s f g b. FINITE s /\ (!x. x IN s ==> (f x = g x)) /\ (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) /\ (!x y s. ~(x = y) ==> (g x (g y s) = g y (g x s))) ==> (ITSET f s b = ITSET g s b) Wed 30th Jan 02 int.ml Added INT_ABS_MUL_1 = |- !x y. (abs (x * y) = &1) = (abs x = &1) /\ (abs y = &1) Fri 25th Jan 02 int.ml Added INT_ABS_NUM and INT_ABS_MUL Wed 23rd Jan 02 sets.ml Added FINITE_DIFF = |- !s t. FINITE s ==> FINITE (s DIFF t) Tue 22nd Jan 02 int.ml Added INT_LE_SQUARE, another forgotten theorem. Wed 9th Jan 02 lib.ml, gtt.ml/hol.ml, caml, hol Stimulated by a message from Robert Solovay, re-organized and simplified the way the system is set up and loaded. Removed all use of the "Unix" library, so that one doesn't need a special CAML Light toplevel but can just use "camllight camlnum". (The use of "sys__command" still assumes a Unix-like environment, but this could also be changed quite easily.) The changes were: * Removing the "Interrupt" exception and the signal setup for it, just using CAML Light's native "Break", making sure "catch_break true" is set. * Using sys__time instead of unix__times in the "time" function * Avoiding using the PID to create unique temporary filenames, instead repeatedly adding "_" to the last component of the filename until it does not coincide with an existing file. (The file manipulation stuff in "sys" is a bit limited, so the code is messy.) Modified the setup to allow more flexibility over the placement of the filter file and avoid forcing the user to work in the HOL Light directory itself. The HOL directory and filter location are now specified by macros HOLDIR and HOLFILTER in the "hol" and "caml" scripts, and the load sequence attempts to read these if possible. These use new functions "includes" and "loads" so that HOL can be run from any location, and the original function "loadt" now uses a settable load path "load_path" which by default is the current directory and the HOL system directory. Wed 21st Nov 01 int.ml Added a whole new raft of theorems that were forgotten, to do with integer powers. INT_ABS_POW, INT_LE_POW2, INT_LT_POW2, INT_POW_1, INT_POW_1_LE, INT_POW2_ABS, INT_POW_2, INT_POW_ADD, INT_POW_EQ_0, INT_POW_INV, INT_POW_LE_1, INT_POW_LE2, INT_POW_LE, INT_POW_LT2, INT_POW_LT, INT_POW_MONO, INT_POW_MONO_LT, INT_POW_MUL, INT_POW_NEG, INT_POW_NZ, INT_POW_ONE, INT_POW_POW Thu 15th Nov 01 int.ml Added INT_OF_NUM_SUB = |- !m n. m <= n ==> (&n - &m = &(n - m)) which had somehow got left out, despite the analogous result for reals. Thu 15th Nov 01 arith.ml Added LE_EXP, a natural counterpart to LT_EXP. I'd avoided adding it until now (doubtless because it's so hideous with all the special cases). |- !x m n. x EXP m <= x EXP n = if x = 0 then (m = 0) ==> (n = 0) else (x = 1) \/ m <= n Wed 24th Oct 01 bool.ml Stimulated by a message from Mike Gordon on the hol-developers list, I discovered that the time taken for GEN on a theorem with an empty assumption list was not constant. This turned out to be because the MP with the proforma theorem was comparing (... = (\x. T)) and (... = (\v. T)), and this tips "aconv" into the full traversal instead of quick equality. Added an explicit alpha conversion to GEN so that this will now succeed instantly. Actually, several of these derived rules should avoid MP and use hypotheses, but that's another issue. Thu 5th Jul 01 preterm.ml Fixed a bug that Freek Wiedijk hit when trying to parse a set abstraction {t[x] | P[x]} with multiple instances of the same variable in the term t[x]. It turned out that "pfrees" was not returning a set, and could repeat the same variable because "ptm::acc" was used instead of "insert ptm acc", and this led to the problem since the variable then got existentially quantified twice, the outer one picking up a polymorphic type. Thu 28th Jun 01 basics.ml Fixed a bug in "type_match" pointed out by Michael Norrish; embarrassingly I thought I'd fixed this before (see 14 Feb 01). This was not recording identity mappings "A|->A" in the environment so far, meaning that it could allow impossible matches like `:A#A` to `:A#num`. Fixed it simply by removing the first line "if vty = cty then sofar else". Thu 21st Jun 01 sets.ml Added: CARD_IMAGE_INJ = |- !f s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\ FINITE s ==> (CARD(IMAGE f s) = CARD s) HAS_SIZE_POWERSET = |- !s n. s HAS_SIZE n ==> {t | t SUBSET s} HAS_SIZE 2 EXP n FINITE_POWERSET = |- !s. FINITE s ==> FINITE {t | t SUBSET s} IMAGE_DELETE_INJ = |- (!x. (f x = f a) ==> (x = a)) ==> (IMAGE f (s DELETE a) = IMAGE f s DELETE f a) Tue 22nd May 01 wf.ml In fact, it's even better; the reverse Skolemization is unnecessary! I took it out, and MESON can still do everything itself. In fact, with a few minutes, it can even absorb the shorter proof: REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN X_CHOOSE_THEN `R:A->B->bool` (ASSUME_TAC o last o CONJUNCTS) lemma THEN SUBGOAL_THEN `!x:A. ?!y:B. R x y` (fun th -> ASM_MESON_TAC[th]) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[] Mon 21st May 01 wf.ml Simplified the proof of WF_REC using "reverse Skolemization" to hide the messy details of converting a relation into a function. This is now appealingly short, if tricky. Wed 9th May 01 int.ml Some more escapees: INT_ENTIRE, INT_EQ_MUL_LCANCEL, INT_EQ_MUL_RCANCEL, INT_LT_LMUL_EQ, INT_LT_RMUL_EQ. Wed 9th May 01 printer.ml Corrected a few irritating misfeatures with printing of numerals like "&1". First, avoided space after "&" for integers as well as reals. Second, made a space appear after "--" in "-- &1" etc. Really, we should have a more principled treatment of spacing based mainly on whether we end up with two adjacent printer tokens in the same lexical category (alphanumeric or symbolic). One day the printer will be rewritten. Sun 7th May 01 lib.ml Modified the "time" function so that it also reports elapsed times when a function generates an exception, i.e. fails or is interrupted. In addition, moved back the testing of "report_timing" to avoid doing anything special at all when it's false. Sat 6th May 01 int.ml Added INT_LT_MUL, another escapee. Fri 5th May 01 int.ml As part of writing a "proforma theorem" version of Michael Norrish's hol98 Cooper algorithm, I improved the integer theory a bit (this is the first time I've ever used it non-trivially). Added INT_LT_REFL, INT_LE_LMUL and INT_SUB_LDISTRIB, which had somehow got forgotten. Exposed INT_FORALL_POS at the top level (previously it was hidden inside ARITH_RULE, but is sometimes useful). Added the Archimedian theorem INT_ARCH = |- !x d. ~(d = & 0) ==> (?c. x < c * d) Fri 13th Apr 01 list.ml Added ALL2_ALL = |- !P l. ALL2 P l l = ALL (\x. P x x) l Mon 9th Apr 01 list.ml Added ALL2_MAP2 = |- !l m. ALL2 P (MAP f l) (MAP g m) = ALL2 (\x y. P (f x) (g y)) l m AND_ALL2 = |- !P Q l m. ALL2 P l m /\ ALL2 Q l m = ALL2 (\x y. P x y /\ Q x y) l m Sat 7th Apr 01 lib.ml Modified "forall2" to return falsity rather than fail when the two lists have different lengths. I had been under the impression it already worked this way. Fri 30th Mar 01 quot.ml Shortened the proof of the main proforma theorem by using MESON. I don't remember why I had such an intricate manual proof before. Actually, with better tweaks for extensionality and select terms, MESON should be capable of doing the whole thing automatically. Thu 29th Mar 01 thm.ml, bool.ml, drule.ml, class.ml Took the lists storing term and type variables out of the core "thm.ml". The discussion with Roger Jones on the Isabelle list reminded me of something Konrad Slind pointed out early on in the development of GTT: you don't need to store the actual definitions to ensure consistency. Renamed the basic definitional principle "new_basic_definition" by analogy with "new_basic_type_definition" and used this in bool.ml before the full definitional principle is defined, and also in class.ml to define "new_specification". However, re-introduced the list of definitions higher up in bool.ml, to enable acceptance of benign redefinitions. This was a nice feature that I used to have, but it got lost somewhere. This should be extended in two ways: allow appropriately named variables on the left (in case the definition was generated by code rather than entered via the quotation parser), and modify for higher-level derived rules like new_inductive_definition. And likewise for types. Sat 24th Mar 01 printer.ml Fixed a bug in the printing of "{}", which would print that whenever the head operator is the empty set, even if applied to an argument. This came up porting Peter Homeier's Church-Rosser proof. Wed 21st Mar 01 sets.ml Added a theorem about indexing of finite sets. Surprising I'd always managed without this so far: HAS_SIZE_INDEX = |- !s n. s HAS_SIZE n ==> (?f. (!m. m < n ==> f m IN s) /\ (!x. x IN s ==> (?!m. m < n /\ (f m = x)))) Tue 6th Mar 01 tactics.ml Removed VALID from TAC_PROOF, at the suggestion of Freek Wiedijk. This is a rather inefficient way to do things since it leads to a double evaluation of the justification function. Besides, we might want to remove VALID from the system, since on non-empty lists of subgoals it calls mk_thm (though here it's only used on the empty list of subgoals). Instead, added a test and alpha-conversion coercion to "prove" itself, to ensure that the theorem returned is exactly the same as the original goal, even up to variable naming. Tue 27th Feb 01 sets.ml Added SUBSET_DIFF = |- !s t. (s DIFF t) SUBSET s Mon 26th Feb 01 sets.ml Added IMAGE_DIFF_INJ = |- (!x y. (f x = f y) ==> (x = y)) ==> (IMAGE f (s DIFF t) = (IMAGE f s) DIFF (IMAGE f t)) Sun 25th Feb 01 sets.ml Added IMAGE_SUBSET = |- !f s t. s SUBSET t ==> IMAGE f s SUBSET IMAGE f t Sun 25th Feb 01 list.ml Added MEM_EL = |- !l n. n < LENGTH l ==> MEM (EL n l) l Sun 25th Feb 01 sets.ml Added SET_OF_LIST_APPEND = |- !l1 l2. set_of_list (APPEND l1 l2) = set_of_list l1 UNION set_of_list l2 Sat 24th Feb 01 meson.ml Fixed a bug in MESON where an error trap was capturing all failures with Cut -> failwith "meson_expand" | _ -> including Interrupt, hence in some circumstances making it impossible to interrupt the search. Changed "_" to "Failure _". This has popped up occasionally over the years, but last time I looked I didn't notice it, probably because I was searching for "with _". Thu 22nd Feb 01 sets.ml Added FINITE_SUBSETS = |- !s. FINITE s ==> FINITE {t | t SUBSET s} Wed 21st Feb 01 sets.ml Added IN_SET_OF_LIST = |- !x l. x IN set_of_list l = MEM x l Wed 14th Feb 01 basics.ml Fixed a bug in "type_match". Strangely, it was failing to detect inconsistent matching assignments and allowing say [`:num`,`:A`; `:bool`,`:A`]. This must have been around for ages without causing (many) problems. Sun 11th Feb 01 sets.ml Added IMAGE_UNION = |- !f s t. IMAGE f (s UNION t) = IMAGE f s UNION IMAGE f t IMAGE_o = |- !f g s. IMAGE (f o g) s = IMAGE f (IMAGE g s) Sat 10th Feb 01 wf.ml Added a theorem asserting that tail-recursive recursion schemes are always satisfiable. WF_REC_TAIL = |- !P g h. ?f. !x. f x = (if P x then f (g x) else h x) This was pointed out to me by J Moore at the 2000 ACL2 workshop. It would have saved me a bit of tedious hacking around defining things like unification algorithms. Sat 10th Feb 01 num.ml Added num_CASES = |- !m. (m = 0) \/ (?n. m = SUC n) This is often quite useful, and was in HOL88. Thu 8th Feb 01 sets.ml Added: FINITE_PRODUCT = |- !s t. FINITE s /\ FINITE t ==> FINITE {x,y | x IN s /\ y IN t} CARD_DELETE = |- !x s. FINITE s ==> (CARD(s DELETE x) = (if x IN s then CARD s - 1 else CARD s)) Tue 6th Feb 01 sets.ml Added FINITE_SUBSET_IMAGE = |- !f s t. FINITE t /\ t SUBSET IMAGE f s ==> (?s'. FINITE s' /\ s' SUBSET s /\ t SUBSET IMAGE f s') The proof is a bit slow (15 seconds); maybe I should unpick more of the automation. I've already separated out the two subgoals, which improves things slightly. Anyway, Moore's Law will save me eventually. Thu 25th Jan 01 tactics.ml Updated "STRIP_ASSUME_TAC" to discard the theorem if it's alpha-convertible to an existing assumption. This seems sensible, and the update brings HOL Light in line with HOL88. The implementation is the same, based on DISCARD_TAC, but this is only introduced locally since it doesn't seem particularly useful. This incompatibility arose in porting the proofs concerning graph planarity by Yamamoto et al. to HOL Light from hol90. Tue 23rd Jan 01 sets.ml Uncommented proof (it used to blow up the space usage a long time ago) of IN_DELETE_EQ = |- !s x x'. (x IN s = x' IN s) = x IN s DELETE x' = x' IN s DELETE x and added the theorems: INTER_ACI = |- (p INTER q = q INTER p) /\ ((p INTER q) INTER r = p INTER q INTER r) /\ (p INTER q INTER r = q INTER p INTER r) /\ (p INTER p = p) /\ (p INTER p INTER q = p INTER q) UNION_ACI = |- (p UNION q = q UNION p) /\ ((p UNION q) UNION r = p UNION q UNION r) /\ (p UNION q UNION r = q UNION p UNION r) /\ (p UNION p = p) /\ (p UNION p UNION q = p UNION q) while renaming the following, inexplicably called INTER_ACI and never used: INSERT_AC = |- (x INSERT y INSERT s = y INSERT x INSERT s) /\ (x INSERT x INSERT s = x INSERT s) Thu 18th Jan 01 lib.ml, calc_num.ml, ind-types.ml, real.ml, tactics.ml Modified "upto" to be an infix and take two arguments. This seems a much nicer and more flexible arrangement, and I've been meaning to do it for ages. Of course, quite a few consequential changes were needed, mostly from "upto n" to "0 upto n". Fri 12th Jan 01 tactics.ml Made the assumption list numbering when a goal is printed work from top to bottom, i.e. give the oldest assumption number zero, even though it is actually the last element of the list. NB: this only affects printing, and has no effect on goal representation. This policy seems more logical and should certainly be better when using numbers to refer to assumptions (as Freek Wiedijk is thinking of doing), since an assumption number won't change unless a prior assumption is deleted. Even better might be to allocate default labels, which would then never change. Thu 11th Nov 00 printer.ml Made set enumerations like `{1,2}` print properly instead of as `1 INSERT 2 INSERT EMPTY`. This includes the case of EMPTY printing as {}. Noticed this defect while doing 4CT statement with Freek Wiedijk, so made this fix on the boat from Holland. Apparently this once worked a long time ago with a different printer-constant called ESPEC, which is no longer used. Wed 4th Oct 00 wf.ml Added WF_REFL = |- !x. WF (<<) ==> ~(x << x) Wed 4th Oct 00 list.ml Added: MAP_FST_ZIP = |- !l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP FST (ZIP l1 l2) = l1) MAP_SND_ZIP = |- !l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP SND (ZIP l1 l2) = l2) MEM_ASSOC = |- !l x. MEM (x,ASSOC x l) l = MEM x (MAP FST l) ALL_APPEND = |- !P l1 l2. ALL P (APPEND l1 l2) = ALL P l1 /\ ALL P l2 Note that MAP_FST_ZIP is actually true without the precondition, but this is an accident of the way ZIP is defined by recursion on the first argument. Wed 4th Oct 00 basics.ml Fixed a bug in "mk_gabs" which must have been there forever and I only noticed when neither PAIRED_BETA_CONV nor GEN_BETA_CONV worked for `(\(p1,p2). f(p1,p2)) (p1,p2)`. The problem was that "f" was also used for the internal variable, with a faulty variant procedure due to a type or thinko. The line: let f = variant (frees tm1 @ frees tm2) (mk_var("f",fty)) was originally let f = variant (frees tm1 @ frees tm1) (mk_var("f",fty)) Tue 3rd Oct 00 wf.ml Added WF_LEX_DEPENDENT = |- !R S. WF R /\ (!a. WF (S a)) ==> WF (\(r1,s1). \(r2,s2). R r1 r2 \/ (r1 = r2) /\ S r1 s1 s2) and now deduced WF_LEX as a special case. The extra generality makes almost no difference to the proof, so it seemed we might as well prove a stronger form. Mon 2nd Oct 00 list.ml Added EX_MEM = |- !P l. EX P l = (?x. P x /\ MEM x l) Fri 29th Sep 00 wf.ml Finished the proof of WF_LEX which was commented out (actually took it from an old multiset ordering proof). Also uncommented WF_POINTWISE. However, erased WF_TC since TC isn't defined at this point in the build, and there is a short proof in Examples/reduct.ml Fri 29th Sep 00 list.ml Defined ASSOC (as in the ML "assoc"), and ITLIST2, and ZIP. I'm suffering from CAML envy. Fri 29th Sep 00 trivia.ml Removed various unused stuff from this file, including the definitions and consequential theorems for ASSOC, COMM, FCOMM, RIGHT_ID, LEFT_ID and MONOID. They don't seem particularly general (I've never used them), and I happened to want the name ASSOC for association lists. Fri 29th Sep 00 list.ml Defined FILTER. Added theorems: FILTER_APPEND = |- !P l1 l2. FILTER P (APPEND l1 l2) = APPEND (FILTER P l1) (FILTER P l2) FILTER_MAP = |- !P f l. FILTER P (MAP f l) = MAP f (FILTER (P o f) l) MEM_FILTER = |- !P l x. MEM x (FILTER P l) = P x /\ MEM x l Thu 28th Sep 00 sets.ml Added FINITE_SET_OF_LIST = |- !l. FINITE (set_of_list l) EX_MAP = |- !P f l. EX P (MAP f l) = EX (P o f) l EXISTS_EX = |- !P l. (?x. EX (P x) l) = EX (\s. ?x. P x s) l FORALL_ALL = |- !P l. (!x. ALL (P x) l) = ALL (\s. !x. P x s) l MEM_APPEND = |-!x l1 l2. MEM x (APPEND l1 l2) = MEM x l1 \/ MEM x l2 MEM_MAP = |- !f y l. MEM y (MAP f l) = ?x. MEM x l /\ (y = f x) Mon 25th Sep 00 filter.c Added #include . Michael Beeson pointed out that this was missing. I'd just got used to the laxity of gcc's default, but it also complains given -Wall. Mon 25th Sep 00 ind-types.ml Fixed a bug that had been lurking undiscovered in recursive types for a long time. It was found by Kim Sunesen in hol98 by trying the following: define_type "repDatatype = repBool bool | repTuple (repDatatype list) | repMap (bool list) # (repDatatype list) | repSet (bool list) | repEnum (bool list)";; and Michael Norrish identified the fix. Instead of applying the 1-step denesting transformation just to any of the nested types, apply it to one that is not a proper subtype of another. Otherwise, "lift_type_bijections" may later need to cope with lifting isomorphisms through other free recursive types, which it isn't able to do. The fix just uses: let nty = hd (sort (fun (t1,t2) -> occurs_in t2 t1) rectys) in instead of let nty = hd rectys in Wed 20th Sep 00 tactics.ml Modified UNDISCH_THEN so it tests for alpha-convertibility rather than equality. UNDISCH_TAC already did this, but it was forgotten here. Wed 20th Sep 00 sets.ml Added FINITE_IMAGE_INJ_GENERAL = |- !f A s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\ FINITE A ==> FINITE {x | x IN s /\ f x IN A} HAS_SIZE_NUMSEG_LT = |- !n. {m | m < n} HAS_SIZE n CARD_NUMSEG_LT = |- !n. CARD {m | m < n} = n FINITE_NUMSEG_LT = |- !n. FINITE {m | m < n} INFINITE_NONEMPTY= |- !s. INFINITE s ==> ~(s = EMPTY) INFINITE_DIFF_FINITE = |- !s t. INFINITE s /\ FINITE t ==> INFINITE (s DIFF t) Thu 7th Sep 00 list.ml Added LENGTH_REPLICATE = !n x. LENGTH (REPLICATE n x) = n Sat 2nd Sep 00 parser.ml Relaxed the lexical rules to allow identifiers to be built up from a mixture of alphanumerics and symbolics provided adjacent strings of opposite types are connected by "_". This is a bit of a hack but allows natural idioms like "++_2" as identifiers. It's also pretty sure to be upwards compatible. Fri 25th Aug 00 sets.ml Added INFINITE_IMAGE_INJ = |- !f. (!x y. (f x = f y) ==> (x = y)) ==> !s. INFINITE s ==> INFINITE (IMAGE f s) Mon 21st Aug 00 printer.ml Made general binders print properly. Previously this only worked for binders with simple abstractions as bodies, but not pairs etc. This should now work. Tue 18th Apr 00 tactics.ml Added "ANTS_TAC", a slightly more refined version of an idiom I use a great deal. I had the habit of using the cruder W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) but this is better and has a short name. Simply splits off antecedent of antecedent as a separate subgoal. The tactic has a laborious tautology definition; with a bit of reordering, we could use ITAUT or even TAUT. Fri 24th Mar 00 list.ml Added ALL_MEM = |- !P l. (!x. MEM x l ==> P x) = ALL P l Tue 18th Jan 00 arith.ml Added MOD_ADD_MOD = |- !a b n. ~(n = 0) ==> ((a MOD n + b MOD n) MOD n = (a + b) MOD n) Tue 21st Dec 99 printer.ml Changed the "dest_binder" used by printer stuff to "dest_binder_vorc" which will break binders even when the binder thing is a variable. Otherwise the printer actually crashes when used on a binder that isn't a constant, as I discovered by trying to demonstrate how to define binders to Jim Grundy. Thu 16th Dec 99 arith.ml Added MOD_MULT2: |- !m n p. ~(m * p = 0) ==> ((m * n) MOD (m * p) = m * n MOD p) this was wanted by Jim Grundy, and in any case is a logical addition since the corresponding theorem for DIV (DIV_MULT2) was already there. Tue 14th Dec 99 calc_rat.ml Modified REAL_RAT_POW_CONV so that it works when the argument is a decimal. Previously for example this would fail: REAL_RAT_POW_CONV `#0.7854 pow 2` Thu 9th Dec 99 class.ml Modified COND_CASES_TAC so that if the expression being split over is a negation, the assumption in the second branch eliminates the double negation. This was a suggestion from Jim Grundy. Fri 3rd Dec 99 preterm.ml Fixed a bug in overloading found by Jim Grundy. It was the case that if there was enough type information to resolve an overload unambiguously, then this already-gathered type information was used as the type for the object, instead of taking the type of the overload instance from the interface list. However, this is no good when we have enough type information to resolve the overload but still have indeterminate parts, e.g. a binary function where we have the type of the first argument (and hence resolve the overload) but not the second. Not only doesn't the subsequent typecheck ever resolve the indeterminate parts, they actually look to it like incompatibilities, so it fails. This has been modified to simply take the type from the interface list, as is done anyway in the case of defaulting. Also, typechecking is now repeated whenever "overresolve" changed the preterm, not just when it set the "overloads_defaulted" flag. Fri 3rd Dec 99 printer.ml Put in a flag "reverse_interface_mapping" that controls whether overloaded identifiers print as the overloaded name (flag = true, default) or their true name (flag = false). This was a suggestion from Jim Grundy. Fri 3rd Dec 99 preterm.ml Backed off the change made a year ago that made "\const. tm" always interpret "const" as a variable. Now this behaviour is under the control of a settable flag called "ignore_constant_varstructs". However, the default is true, which means no (intentional) change in behaviour. Setting it to false would restore the state of affairs in version 1.0 Fri 3rd Dec 99 pair.ml Added the GEN_BETA_CONV function that does generalized beta conversion over nested linear patterns of constructors, e.g. GEN_BETA_CONV `(\[SUC m; SUC n]. m + n) [SUC 1; SUC 2]`. This subsumes PAIRED_BETA_CONV, but it is slower. Fri 3rd Dec 99 recursion.ml Added "create_projections" which demonstrates the existence of projection functions for a type constructor. These are then stored away in a cache. The main intention is to do genrealized betas over arbitrarily nested type constructors automatically. Fri 3rd Dec 99 drule.ml Added BETAS_CONV where BETAS_CONV n `(\x1...xn. E[xs]) a1 ... an` reduces all the beta redexes. Thu 2nd Dec 99 printer.ml Stuck an additional "print_break" before the "and"s in a printing of "let ... and ... and ... and", otherwise the line would never break properly. This bug was pointed out by Jim Grundy. Thu 2nd Dec 99 ind-type.ml Added ":num" to the inductive type store. I needed to swap the order of arguments; I should really make this standard anyway. Wed 1st Dec 99 arith.ml Added MOD_MULT_ADD = |- !m n p. (m * n + p) MOD n = p MOD n Mon 29th Nov 99 ind-types.ml Changed the recursive type definition type bijections used internally from "mk_" and "dest_" to "_mk_" and "_dest_". Jim Grundy was caught out by the original, since he wanted a constructor with the same name. Sun 22nd Aug 99 real.ml Added REAL_POW2_ABS = |- !x. abs(x) pow 2 = x pow 2 REAL_LE_SQUARE_ABS = |- !x y. abs(x) <= abs(y) = x pow 2 <= y pow 2 Sun 22nd Aug 99 ind-defs.ml Renamed MONO_ALL to MONO_FORALL; it's more logical and the second is already used for list quantification. Mon 3rd May 99 realax.ml, calc_rat.ml, calc_real.ml Set up "--" as a prefix, so one can write "--R(j)" rather than "--(R(j))" etc. This meant changing a few `--`s to `(--)`s otherwise the parser complains. Fri 23rd Apr 99 meson.ml Wow, found and removed a second "with Cut -> raise Cut". What fascinating optimizations there are to be found! Fri 9th Apr 99 meson.ml While nosing around meson.ml looking for Wishnu's bug (see last item) I spotted and removed a pointless "with Cut -> raise Cut". Might speed things up by a few microseconds. Fri 9th Apr 99 canon.ml Fixed a bug in NNFC_CONV. The "clever" optimization that avoided rewriting a term twice at one level is wrong in the case "~ ~ (p ==> q)". This caused a MESON_TAC failure spotted by Wishnu Prasetya: `~(p /\ q ==> ~r) = (p /\ q /\ r)`;; The new version simply uses TOP_SWEEP_CONV. I don't believe the impact will be that significant. These things aren't that well optimized anyway; if speed is critical I should rewrite it to do the maching manually. Fri 2nd Apr 99 tactics.ml Fixed a bug in THENL where "g THENL [non-empty-list]" would fail if g left no subgoals. Now it behaves like THEN. Thu 25th Mar 99 calc_num.ml Installed a more efficient version of NUM_ADD_CONV and NUM_SUC_CONV. These are hand-coded instantiations rather than being based on rewriting. The motivation is that addition is now fairly important in proofs, though the long-term goal is to improve multiplication, which is the real bottleneck. Anyway, this improved the speed of my current proofs (division algorithms) by about 12%. Wed 24th Mar 99 real.ml Added: REAL_EQ_RDIV_EQ = |- !x y z. &0 < z ==> ((x = y / z) = x * z = y) REAL_EQ_LDIV_EQ = |- !x y z. &0 < z ==> ((x / z = y) = x = y * z) Thu 18th Feb 99 sets.ml Renamed the old FINITE_IMAGE to FINITE_IMAGE_EXPAND and added: FINITE_IMAGE = |- !f s. FINITE s ==> FINITE (IMAGE f s) The previous version had the definition of IMAGE expanded... Thu 18th Feb 99 sets.ml Added IMAGE_CLAUSES = |- (IMAGE f EMPTY = EMPTY) /\ (IMAGE f (x INSERT s) = f x INSERT IMAGE f s) Thu 18th Feb 99 arith.ml Added: MOD_MULT_RMOD = |- !m n p. ~(n = 0) ==> ((m * p MOD n) MOD n = (m * p) MOD n) MOD_MULT_LMOD = |- !m n p. ~(n = 0) ==> ((m MOD n * p) MOD n = (m * p) MOD n) MOD_MULT_MOD2 = |- !m n p. ~(n = 0) ==> ((m MOD n * p MOD n) MOD n = (m * p) MOD n) MOD_EXP_MOD = |- !m n p. ~(n = 0) ==> ((m MOD n) EXP p MOD n = m EXP p MOD n) Wed 27th Jan 99 real.ml Added: REAL_LT_POW2 = |- !n. &0 < &2 pow n REAL_LE_POW2 = |- !n. &1 <= &2 pow n Wed 27th Jan 99 pair.ml Added EXISTS_PAIR_THM = |- (?p. P p) = (?p1 p2. P (p1,p2)) Fri 22nd Jan 99 real.ml Moved the quantifier from ... ==> !n. to !n. ... ==> in SUM_POS_GEN, so that we can later use MATCH_MP_TAC more conveniently. Wed 20th Jan 99 drule.ml Modified HIGHER_REWRITE_CONV so that it takes a flag allowing one to pick the lowest subterm (as originally) or the highest. Now the latter is used for COND_CASES_TAC, which seems much more sensible. However, note that lowest still makes sense for many things, e.g. the elimination of subtractions. And the new COND_CASES_TAC has the "defect" that if (if ...) will put the inner conditional on the assumptions so REPEAT COND_CASES_TAC is no good. Wed 20th Jan 99 pair.ml Modified let_CONV so that it deals with paired lets correctly provided the thing being abbreviated is also paired. Modified LET_TAC so that it works on any paired let at all, introducing appropriate abbreviatory assumptions. Wed 20th Jan 99 basics.ml, equal.ml Added three new functions "find_path", "follow_path" and "PATH_CONV" to create and use paths, i.e. director strings. These are useful for modifying terms at a precise position without any accidents. Thu 7th Jan 99 arith.ml Made "mk_numeral" and "mk_small_numeral" fail when given negative arguments. Thu 10th Dec 98 preterm.ml Modified the behaviour of "typify" on the varstruct of a preterm so that if the varstruct is a single variable, it is always treated as a variable even if there is a constant with that name. This makes (simply) bound variables override constants, conforming to the intuition that constants are like outer-level bound variables. However, this does not apply to complex varstructs; this seems hard in general since we need to recognize certain constants like the comma in "\(x,y). ...". Probably need to think more about this in concert with set abstraction syntax. Tue 8th Dec 98 arith.ml Added LE_SQUARE_REFL = |- !n. n <= n * n Fri 4th Dec 98 real.ml Added REAL_DIV_REFL = |- !x. ~(x = &0) ==> (x / x = &1) REAL_DIV_LMUL = |- !x y. ~(y = &0) ==> (y * (x / y) = x) REAL_DIV_RMUL = |- !x y. ~(y = &0) ==> ((x / y) * y = x) Thu 3rd Dec 98 arith.ml Added the new theorems: LE_LDIV = |- !a b n. ~(a = 0) /\ b <= a * n ==> b DIV a <= n LE_RDIV_EQ = |- !a b n. ~(a = 0) ==> (n <= b DIV a = a * n <= b) LE_LDIV_EQ = |- !a b n. ~(a = 0) ==> (b DIV a <= n = b < a * (n + 1)) Wed 2nd Dec 98 class.ml Modified the condition syntax of COND_CONG to the new "if g then t else e" instead of the old "g => t | e". Thu 12th Nov 98 arith.ml Added MOD_EQ_0 = |- !m n. ~(n = 0) ==> ((m MOD n = 0) = (?q. m = q * n)) EVEN_MOD = |- !n. EVEN(n) = (n MOD 2 = 0) ODD_MOD = |- !n. ODD(n) = (n MOD 2 = 1) Wed 11th Nov 98 arith.ml Added DIV_MONO = |- !m n p. ~(p = 0) /\ m <= n ==> m DIV p <= n DIV p DIV_EQ_0 = |- !m n. ~(n = 0) ==> ((m DIV n = 0) = m < n) Fri 23rd Oct 98 gtt.ml, hol.ml Set up an allocated scratch_directory that is used instead of /tmp when the environment variable TMPDIR isn't set. This was because, at least on my laptop, /tmp was getting cleared so often that it sometimes happened in the middle of loading a multiple-day proof. Tue 20th Oct 98 list.ml Changed the names of FORALL and FORALL2 to ALL and ALL2. The new names are shorter, more consistent with EX, and make it easier to name theorems relating ordinary quantifiers to these. For example the theorem previously known as FORALL_FORALL gives no clue in its name about which way it switches the quantifiers. The names of theorems have been changed as follows: FORALL -> ALL FORALL2 -> ALL2 FORALL_IMP -> ALL_IMP NOT_FORALL -> NOT_ALL FORALL_MAP -> ALL_MAP FORALL_T -> ALL_T FORALL_MP -> ALL_MP FORALL_FORALL -> FORALL_ALL AND_FORALL -> AND_ALL MONO_FORALL -> MONO_ALL FORALL2_DEF -> ALL2_DEF MAP_EQ_FORALL2 -> MAP_EQ_ALL2 FORALL2_MAP -> ALL2_MAP FORALL2_AND_RIGHT -> ALL2_AND_RIGHT MONO_FORALL2 -> MONO_ALL2 Tue 20th Oct 98 printer.ml Made sure that a space is printed between a prefix operator and its arguments, and between a binder and its bound variables, when (and only when) the operator's name is alphanumeric. Mon 19th Oct 98 class.ml, ind-defs.ml, itab.ml real.ml tactics.ml Removed "PROVE" since there's now no compactor, and replaced it by "prove". Mon 19th Oct 98 calc_num.ml Added EXPAND_CASES_CONV, which I seem to use quite often to expand "!n. n < N ==> P n" into "P 0 /\ P 1 /\ ... /\ P (N-1)". Mon 19th Oct 98 calc_rat.ml Added more functions for dealing with rational number terms: numdom, numerator, denominator, term_of_rat, rat_of_term. Fri 16th Oct 98 basics.ml, bool.ml, tactics.ml Eliminated the compactor and loading and saving of theorems. This was a hack and in fact turned out to inhibit performance on really big examples. Admittedly, this is probably just because I used the built-in CAML hash tables which clearly aren't designed for hashing objects of this size and structure. Fri 16th Oct 98 tactics.ml Optimized the implementations of THEN and THENL which were recreating nontrivial bits of the justification function; these are now going to be function closures. This saves piles of memory on really big case splits. Also made similar optimizations to a few other "terminal" tactics such as ACCEPT_TAC. Thu 15th Oct 98 real.ml, int.ml Renamed REAL_NEG_EQ_0 and INT_NEG_EQ_0 from REAL_NEG_EQ0 and INT_NEG_EQ0 for consistency with other REAL_opr_EQ_0. Really a more serious bash at making these names consistent would be worthwhile before they become entrenched. Thu 15th Oct 98 simp.ml Modified "net_of_thm" so it also translates |- p ==> (s = t[s]) into |- p ==> ((s = t[s]) = T). Previously this was only happening for non-conditional rewrites. Also eliminated the "discarding looping rewrite" warning which would need changing to "modifying looping rewrite" and is probably more irritating than useful. Fri 9th Oct 98 parser.ml Removed the special "bracket" status for semicolon; there seem to be few natural situations where a semicolon is followed by a symbolic ID. Anyway, I wanted to use ";;" for a sequencing operator. Maybe I should do the same for comma? Wed 7th Oct 98 tactics.ml Made goals print the other way up, i.e. with the conclusion at the bottom with the head (most recently added) assumptions above them. This is a trivial change, but seems much more sensible to avoid goals with zillions of assumptions scrolling off the screen. Tue 6th Oct 98 tactics.ml Reimplemented THEN and THENL in a more direct way, not relying on hacking up a goalstate and manipulating it using "by" and "bys". This is partly because I suspect the space behaviour of the old one is very bad when there are splits into many subgoals. Anyway the aesthetics are better. The left-right order for metavariable instantiation has been maintained. Tue 6th Oct 98 drule.ml Optimized INSTANTIATE_ALL for the case where the instantiation is null. Tue 6th Oct 98 tactics.ml Made similar optimization to the one below for THENL, this time for THEN, and hence EVERY. I had misthought that THEN called THENL, but of course it doesn't. Tue 6th Oct 98 real.ml Changed "prove" to "PROVE" so that REAL_ARITH doesn't cache what probably are, after all, only temporary theorems. Mon 5th Oct 98 real.ml Added call to "clear_atom_cache" in SIMPLE_REAL_ARITH_TAC; previously the cache would just extend forever across multiple calls, surely not a very good idea... Mon 5th Oct 98 tactics.ml Optimized the implementation of "THENL" for the case where the composite construct finishes off the goal. Now, rather than keeping the perhaps complicated justification function hanging around, we apply it at once, then return a trivial wrapper round the resulting theorem. Tue 15th Sep 98 real.ml Added REAL_DIV_POW2_ALT = |- !x m n. ~(x = &0) ==> (x pow m / x pow n = (if n < m then x pow (m - n) else inv (x pow (n - m)))) Mon 14th Sep 98 arith.ml Added MOD_EXISTS = |- !m n. (?q. m = n * q) = (if n = 0 then m = 0 else m MOD n = 0) Mon 14th Sep 98 pair.ml Made LET_TAC scrub trivial lets first. This is a bit ad-hoc, but helps it goals with parallel chains of lets but different bodies. Fri 4th Sep 98 arith.ml Added LT_MULT2 = |- !m n p q. m < n /\ p < q ==> m * p < n * q which had somehow got forgotten. Thu 3rd Sep 98 basics.ml, pair.ml Modified dest_let so that it allows arbitrary varstructs on the left of the equals sign. This was just a matter of changing "strip_abs" to "strip_gabs". Also modified let_CONV so that it works on paired varstructs provided the right hand side is a pair, as in "let (x,y,z) = (1,2,3) in ...". The parser already worked in the general case, and the change to "dest_let" makes the printer work. However let_CONV needs more work, changing ABS to an equivalent for varstructs. Pretty easy... Wed 2nd Sep 98 arith.ml Added EXP_1 = |- !n. n EXP 1 = n, and renamed the theorem previously called EXP_1 to EXP_ONE = |- !n. 1 EXP n = 1 Wed 2nd Sep 98 pair.ml Added LET_TAC to eliminate let_terms while replacing them with equivalently named abbreviatory assumptions. Sun 16th Aug 98 real.ml Added REAL_DIV_POW2 = |- !x m n. ~(x = &0) ==> (x pow m / x pow n = (if n <= m then x pow (m - n) else inv (x pow (n - m)))) Fri 14th Aug 98 calc_rat.ml Improved REAL_RAT_MUL_CONV which did cancellation in an utterly inept way, requiring big multiplications in many cases. Fri 14th Aug 98 real.ml Term-netted REAL_INT_RED_CONV and so REAL_INT_REDUCE_CONV. Fri 14th Aug 98 real.ml Added REAL_LT_DIV = |- !x y. &0 < x /\ &0 < y ==> &0 < x / y REAL_LE_DIV = |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x / y Tue 4th Aug 98 calc_rat.ml The conversion CALC_DIV_CONV was failing if the input was of the form "m / n" for integers m and n even if m and n were cancellable. Now it cancels if possible. Wed 29th Jul 98 arith.ml Added MOD_MOD_REFL = |- !m n. ~(n = 0) ==> (m MOD n MOD n = m MOD n) Mon 27th Jul 98 tactics.ml Added RECALL_ACCEPT_TAC, intended for use by extremely time-consuming rules that take some argument(s) other than the goal term. One can use it to delay evaluation till after lookup in the theorem compactor. Fri 24th Jul 98 calc_rat.ml Term-netted REAL_RAT_RED_CONV and so REAL_RAT_REDUCE_CONV. Thu 23rd Jul 98 pair.ml Added FORALL_PAIR_THM = |- (!p. P p) = (!p1 p2. P (p1,p2)) I should probably get rid of GEN_PAIR_TAC one day. Wed 22nd Jul 98 real.ml Added REAL_LE_RDIV_EQ = |- !x y z. &0 < z ==> (x <= y / z = x * z <= y) REAL_LE_LDIV_EQ = |- !x y z. &0 < z ==> (x / z <= y = x <= y * z) REAL_LT_RDIV_EQ = |- !x y z. &0 < z ==> (x < y / z = x * z < y) REAL_LT_LDIV_EQ = |- !x y z. &0 < z ==> (x / z < y = x < y * z) REAL_LT_DIV2_EQ = |- !x y z. &0 < z ==> (x / z < y / z = x < y) REAL_LE_DIV2_EQ = |- !x y z. &0 < z ==> (x / z <= y / z = x <= y) REAL_EQ_LCANCEL_IMP = |- !x y z. ~(z = &0) /\ (z * x = z * y) ==> (x = y) REAL_EQ_RCANCEL_IMP = |- !x y z. ~(z = &0) /\ (x * z = y * z) ==> (x = y) Wed 15th Jul 98 real.ml Added SUM_CONST = |- !c n. Sum (0,n) (\m. c) = &n * c Mon 13th Jul 98 real.ml Added REAL_INV_1_LE = |- x. &0 < x /\ x <= &1 ==> &1 <= inv x Fri 10th Jul 98 calc_num.ml Added NUM_FACT_CONV into the set of conversions applied by NUM_RED_CONV and hence NUM_REDUCE_CONV. Fri 10th Jul 98 real.ml Added REAL_POW_POW = |- !x m n. x pow m pow n = x pow (m * n) Thu 9th Jul 98 arith.ml Added MOD_MOD = |- !m n p. ~(n * p = 0) ==> (m MOD (n * p) MOD n = m MOD n) and DIV_MULT2 = |- !m n p. ~(m * p = 0) ==> ((m * n) DIV (m * p) = n DIV p) and MOD_1 = |- !n. n MOD 1 = 0 Mon 5th Jul 98 real.ml Added REAL_POW_MONO_LT = |- !m n x. &1 < x /\ m < n ==> x pow m < x pow n Mon 5th Jul 98 tactics.ml Made the variant-choosing in CHOOSE_TAC more conservative, to avoid problems where the variable coincides with something in the hypotheses of an assumption theorem, yet not in any of the conclusions. Mon 5th Jul 98 real.ml Added another couple: REAL_LT_RMUL_EQ = |- &0 < z ==> (x * z < y * z = x < y) REAL_LT_LMUL_EQ = |- &0 < z ==> (z * x < z * y = x < y) Thu 2nd Jul 98 real.ml Added two theorems that are specially useful in conjunction with the simplifier: REAL_LE_RMUL_EQ = |- &0 < z ==> (x * z <= y * z = x <= y) REAL_LE_LMUL_EQ = |- &0 < z ==> (z * x <= z * y = x <= y) Thu 25th Jun 98 realax.ml Avoided the auxiliary definition of "sum". This was inelegant, and particularly inconvenient since "sum" is quite a useful constant name for the user. Wed 24th Jun 98 tactics.ml Added EXPAND_TAC, the natural complement to ABBREV_TAC. Tue 23rd Jun 98 parser.ml Added comments to the quotation parser. These are one-line comments started by a settable symbol, initially // as in BCPL/C++. Tue 26th May 98 calc_rat.ml, parser.ml, printer.ml Made `#xxxx.yyyy` acceptable instead of explicit fraction, using a new constant DECIMAL. Modified parser and printer appropriately and tweaked rational arithmetic stuff so it accepts these (but always returns a conventional rational). Wed 20th May 98 preterm.ml Made hexadecimal numerals acceptable to the parser. They are entered in C notation, i.e. 0x... with either upper or lower case or mixed case for the hex digits (but the initial x must be lowercase). Note that this has no logical meaning, so the numerals are still printed as decimals. However it would be possible to have a more general numeral syntax, e.g. several alternatives to "NUMERAL". This would mean changing some calculation code. ********************** RELEASE OF VERSION 1.00 ********************** Thu 30th Apr 98 preterm.ml, parser.ml, printer.ml, passim Abolished interface maps, integrating them with overloading. Renamed the functions involved, except make_overloadable. Now we have override_interface, overload_interface, reduce_interface and remove_interface. Wed 29th Apr 98 tactics.ml Deleted test_just. I think the stuff is all OK, so I shouldn't need it; and it cheats! Wed 29th Apr 98 arith.ml Fixed a bug in PRE_ELIM_TAC, used in preprocessing phase of the decision procedure for naturals. It was substituting x = SUC m where we had PRE(x), but of course x might not be a variable and then the x = SUC m was lost. The analogous SUB_ELIM_CONV already did this right. Wed 29th Apr 98 simp.ml, theorems.ml, class.ml Tweaked simplification slightly, adding new rewrites for "(x = x) ==> p" and "if x = x then y else z" so that we never perform a contextual rewrite in such a trivial case. Wed 29th Apr 98 meson.ml Limited the case-splitting before MESON proper is applied; this was getting to rather extreme levels for propositional tautologies. The limit is controlled by an assignable variable meson_split_limit; this is initially 4, meaning no more than 2^4 = 16 separate cases. Wed 29th Apr 98 real.ml Optimized the linear decision procedure in several ways. (1) the most important: the case-splitting induced by "abs" is now somewhat more intelligent that blindly doing COND_CASES as before. Something like abs(x) <= y is expanded to x <= y /\ --x <= y, which is much better: no case-splitting. In the case split from x <= abs(y) we have a case split but leave out &0 <= x and &0 <= -x indications; they are not needed and if "x" involves abs, can lead to further expansion. It's still not perfect; for example &2 * abs(x) <= y is still treated in the old way. But it's much better. (2) We avoid ASSUMEing and PROVE_HYPing the starting theorems. (3) simplified the proof traces slightly, which for no good reason kept the shadow forms of the intermediate inequalities. Mon 27th Apr 98 thm.ml, drule.ml, class.ml, bool.ml Abandoned the "clever" definitional principle and made the equational form primitive. Mon 27th Apr 98 type.ml, term.ml, drule.ml, tactics.ml Renamed type_subst to raw_type_subst and made type_subst a version that doesn't create an unchanged exception; better for external use. Tue 21st Apr 98 int.ml Added some theorems whose real counterparts were in realax.ml not real.ml and hence got left out, e.g. INT_ADD_SYM and INT_ADD_ASSOC (!) Tue 21st Apr 98 pair.ml Added let_CONV. Tue 31st Mar 98 type.ml, term.ml Made a few efficiency tweaks and tidyings. Tue 31st Mar 98 type.ml Removed "tyvarsl" which was never used. Wed 25th Mar 98 list.ml Added definition of constant EL. Tue 24th Mar 98 printer.ml Forced the printer to print brackets round paired abstractions. Mon 23rd Mar 98 printer.ml Stopped printing of CONS as (CONS). I've no idea why I did this. Mon 2nd Mar 98 simp.ml, class.ml Set up useful simplifier as the default SIMP_TAC, ASM_SIMP_TAC etc., for the situations where one needs implicational rewriting but doesn't want to fuss with constructing simpsets. Fitted mechanism for basic congruences and augmented it with conditional in class.ml Wed 18th Feb 98 printer.ml Made a modification to compile under 0.74: print_break is now curried. Wed 11th Feb 98 ind-types.ml Changed "BOT" to "BOTTOM", less likely to be wanted elsewhere when dealing with Boolean algebras. Tue 10th Feb 98 printer.ml Modified the printer to use bracketing instead of dollaring. Tue 10th Feb 98 quot.ml, real.ml Modified "define_quotient_type" so the user can specify the names of the abstraction and representation functions. Mon 9th Feb 98 parser.ml, printer.ml, passim Eliminated the use of dollaring to force non-special status. Now just use brackets: (+), (==>), (!) etc. This seems much more intuitive and also makes the lexical stuff simpler. Sun 8th Feb 98 printer.ml Added user-installable printers, via a trivial "try them first" interface. Wed 4th Feb 98 list.ml Added EX_IMP. Wed 28th Jan 98 list.ml Added NOT_FORALL, FORALL_FORALL and AND_FORALL. Mon 19th Jan 98 list.ml Added FORALL_MP. Wed 14th Jan 98 list.ml Added ITLIST_EXTRA. Fri 2nd Jan 98 simp.ml Inserted a warning when discarding a looping rewrite. Wed 24th Dec 97 drule.ml Made INSTANTIATE fail if anything gets instantiated in assumptions. The main reason is that on occasion ASM_REWRITE_TAC[] could instantiate the assumptions of goal-assumptions and lead to an invalid tactic, whereas it should fail. Mon 22nd Dec 97 sets.ml Added LENGTH_LIST_OF_SET and rejigged the definition to make sure "list_of_set" is repetition-free. Mon 22nd Dec 97 list.ml Added MAP2. Sat 20th Dec 97 sets.ml Added num_FINITE, num_FINITE_AVOID and num_INFINITE. Fri 19th Dec 97 list.ml Added FORALL2_AND_RIGHT. Thu 18th Dec 97 sets.ml Added FINITE_IMAGE_INJ. Thu 18th Dec 97 list.ml Added MAP_EQ_DEGEN. Thu 18th Dec 97 ind-types.ml Made "prove_constructors_injective" and "prove_constructors_distinct" return a single conjunctive theorem rather than a list of theorems. This strange decision has been an irritation for ages, so I decided to change it now before it requires any more tweaking of work. Thu 18th Dec 97 list.ml Added FORALL2, with theorems MAP_EQ_FORALL2 and FORALL2_MAP; added in monotonicity theorems for FORALL and FORALL2 for ind-defs package. Also tweaked a couple of proofs. Wed 17th Dec 97 list.ml Added FORALL_T. Sat 13th Dec 97 sets.ml Added UNIONS_INSERT, FINITE_UNIONS and FINITE_IMAGE. Thu 11th Dec 97 sets.ml Added IN_UNIONS, IN_INTERS, UNIONS_0, UNIONS_1, UNIONS_2. Tue 2nd Dec 97 equal.ml Added CACHE_CONV, which seems potentially quite useful. I should probably use it in the reals decision procedure in future; it uses a term net rather than a linear list, as now. However this version also uses a modicum of intelligence. Tue 2nd Dec 97 tactics.ml Changed THENL so it succeeds if the first tactic creates no subgoals, even if the list of tactics is of nonzero length. This was suggested by Michael Norrish (for hol90). Sat 29th Nov 97 preterm.ml Updated the earlier change so it also checks for numerals, not actually there as single constants. At this stage they are not written out in binary. Fri 28th Nov 97 preterm.ml Fixed up set abstractions so they don't generalize over constants in the left; the problem was that at the preterm stage these are still "variables", so needed to put a check in "pfrees" whether something is a constant name. This is safe: any inner bound variables aren't free anyway(!) Fri 28th Nov 97 printer.ml Fixed the printing of iterated polymorphic binary operators without brackets by changing dest_binop to DEST_BINARY where needed, so any instances of operators with the same name are accepted. This function DEST_BINARY is new: it works for variable infixes as well as constants. Wed 26th Nov 97 arith.ml Added: DIV_0 = |- !n. ~(n = 0) ==> (0 DIV n = 0) MOD_0 = |- !n. ~(n = 0) ==> (0 MOD n = 0) EXP_1 = |- !n. 1 EXP n = 1 DIV_LT = |- !m n. m < n ==> (m DIV n = 0) LT_EXP = |- !x m n. x EXP m < x EXP n = 2 <= x /\ m < n \/ (x = 0) /\ ~(m = 0) /\ (n = 0) Thu 20th Nov 97 basics.ml, tactics.ml Finally, I've done something about a fast save/resume. I started by creating a (term-netted) stock of theorems, optionally with names. The old COMPACT function now not only compacts theorems, but also stores them in this structure. This "theory file" is loadable and savable. Also, "prove" tries to find a theorem in the net before running the tactic to prove it; the disadvantage is that it still *creates* the tactic --- in cases where this is expensive we're going to need something like a "fun g -> tac g" wrapper. Sat 15th Nov 97 preterm.ml, sets.ml Fixed a bug pointed out by Mark Woodcock: in general set abstractions {t | P}, the only variables getting existentially quantified were those in both t *and* P, the idea being that if a variable doesn't appear in P, then it means something outside and the user doesn't want to bind it. However this is quite wrong, as pointed out by Mark's example { x | T }. So now I quantify any variables appearing in t. This meant I had to change the definition of IMAGE f s = {f x | x IN s} to an explicit existential. Really, it would only be possible to do this better using parsing in a context of meaningful (in particular bound) variables, and that creates all sorts of new problems. Probably better to accept occasional inconvenience. Tue 11th Nov 97 real.ml, int.ml Removed a few duplicated theorems. Tue 11th Nov 97 term.ml, drule.ml Chaged "paconv" to delete the env argument at toplevel. Tue 11th Nov 97 term.ml, thm.ml, bool.ml, equal.ml, basics.ml Moved syntax constructors from term.ml out to more appropriate places, since this is after all part of the core. Mon 10th Nov 97 bool.ml Put back an old optimization into PROVE_HYP, which is now completely different, so that it does no inference in the trivial case. Mon 10th Nov 97 thm.ml, equal.ml Changed the beta conversion primitive so that it only does the trivial case. This is now called BETA. The general case, BETA_CONV, is done by adding INST where needed. Mon 10th Nov 97 thm.ml, equal.ml, bool.ml Returned to old name INST despite the fact that it instantiates in assumptions, as does INST_TYPE. Profiling indicated this was safe, i.e. failure never occurred at all, let alone in a situation where failure causes some other action. Sun 9th Nov 97 term.ml, thm.ml, equal.ml bool.ml Changed the primitive basis to cut out implication as a primitive. Introduced the new inference rule DEDUCT_ANTISYM_RULE, made instantiation apply to assumptions, and moved MP, DISCH, IMP_ANTISYM_RULE and SYM from primitive to derived. The derivation of SYM is something independent from the effort of eliminating implication; I could have done it before. It doesn't appear that often in profiles, whereas TRANS does. Sun 12th Oct 97 sets.ml Strengthened FINITE_UNION to an equation, and renamed the implicational version FINITE_UNION_IMP. Wed 17th Sep 97 meson.ml Changed "Var" to "Fvar" to avoid a clash with the standard term constructors; this was also pointed out by Mark Woodcock. Wed 17th Sep 97 class.ml Deleted duplicate proof of BOOL_CASES_AX (pointed out by Mark Woodcock). Mon 8th Sep 97 wf.ml Added an "exists unique" version of the wellfounded recursion theorem. Mon 8th Sep 97 sets.ml Remarkably, I had UNIONS and INTERS defined wrong way round, and only now discovered it while trying to use them! Fixed it. Fri 5th Sep 97 wf.ml Simplified the proof that recursive existence implies wellfoundedness following a suggestion of Torkel Franzen. Wed 3rd Sep 97 gtt.ml, wf.ml, arith.ml Added a proof that the existence part of wellfounded recursion implies wellfoundedness. Needed to swap arith.ml and wf.ml in the load sequence and transfer a few theorems in order to make this cleaner. Also moved "recursion.ml" back in the load sequence so as to make "prove_recursive_functions_exist" available during wellfoundedness proof. Sat 21st Jun 97 list.ml Added FORALL_MAP = |- !P f l. FORALL P (MAP f l) = FORALL (P o f) l Fri 20th Jun 97 ind-types.ml Fixed a bug in "derive_recursion_theorem", which was failing in the case where a type had only a single constructor; the theorem was being treated as if it were a conjunction even though it wasn't. Sat 7th Jun 97 tactics.ml Modified VALID so it takes into account ASSUME-ability of conclusions of hypotheses (if you see what I mean). Since it should now be OK, inserted it into "TAC_PROOF" and "e". Sat 7th Jun 97 bool.ml Optimized PROVE_HYP so it doesn't do any work in the trivial case. This seems wise now it will get called even more often in tactic proof reconstructions. Sat 7th Jun 97 tactics.ml Modified RULE_ASSUM_TAC so that it works via a series of ASSUME_TACs; this allows the traditional HOL practice of ASSUMEing assumptions after modification. I believe now that all ways of getting a theorem onto the assumption list support this style. Fri 6th Jun 97 tactics.ml Changed b() so it doesn't back up to an empty goalstack. Tue 3rd Jun 97 tactics.ml Added checks to X_GEN_TAC and X_CHOOSE_TAC to ensure that the variables chosen aren't already free. Fri 30th May 97 tactics.ml Added "flush_goalstack". Tue 27th May 97 real.ml Added REAL_POW_LT2 = |- !n x y. ~(n = 0) /\ &0 <= x /\ x < y ==> x pow n < y pow n Fri 23rd May 97 real.ml Added REAL_POW_SUB = |- !x m n. ~(x = &0) /\ m <= n ==> (x pow (n - m) = x pow n / x pow m) and REAL_POW_NZ = |- !x n. ~(x = &0) ==> ~(x pow n = &0) Wed 21st May 97 type.ml, term.ml, preterm.ml, thm.ml Made sure that the binary type constructors are not treated as if they take pairs; after a message from the CAML list I'm not sure this is safe. Tue 20th May 97 real.ml Added REAL_OF_NUM_SUB = |- !m n. m <= n ==> (&n - &m = &(n - m)) Tue 20th May 97 meson.ml Deleted the unused internal function "bump_hol_thm" (pointed out by Michael Norrish again). Mon 19th May 97 arith.ml Added EVEN_EXP = |- !m n. EVEN (m EXP n) = EVEN m /\ ~(n = 0) and ODD_EXP = |- !m n. ODD (m EXP n) = ODD m \/ (n = 0) Sun 18th May 97 real.ml,calc_rat.ml Added SUM_HORNER = |- !f n x. Sum (0,SUC n) (\i. f i * x pow i) = f 0 + x * Sum (0,n) (\i. f (SUC i) * x pow i) and a corresponding conversion REAL_HORNER_SUM_CONV. Wed 14th May 97 meson.ml Deleted duplicate definition of POLY_ASSUME_TAC; thanks to Michael Norrish for pointing this out. Tue 13th May 97 real.ml Added REAL_POW_ONE = |- !n. &1 pow n = &1 and REAL_POW_MONO = |- !m n x. &1 <= x /\ m <= n ==> x pow m <= x pow n Mon 12th May 97 gtt.ml Moved "quot.ml" to earlier in the build sequence, in an attempt to move closer to the (unrealizable) ideal of deductive system first, theories second. Mon 12th May 97 calc_num.ml Fixed a bug in the rewrites for EXP, which was leaving "1" instead of "BIT1 _0" in the right hand side; this was then unsimplifiable by the other rewrites in certain situations. Sat 10th May 97 preterm.ml, passim Modified "overload" so it checks that the thing being overloaded (a) conforms to the type skeleton, and (b) isn't polymorphic. Also changed "overesolve" so that it will accept overloading of variables, purely so that the overloaded form (and parse status) can be used during an actual definition. Sat 10th May 97 mizar.ml Made the "given" construct use the types of variables in the thesis; even improved "consider" slightly by linking the evars and the body before typechecking. Did a few other bits of tidying up. Fri 9th May 97 parser.ml Deleted the stuff that parses types after binary operators. By construction it could never get called; types are attached to the unary subterms. Fri 9th May 97 preterm.ml, passim Added a fairly major new feature: operator overloading. The main new functions are "make_overloadable", "overload", "unoverload", "prioritize_overload" and "retypecheck", though these include various auxiliary functions. It seems to work quite well. Thu 8th May 97 tactics.ml Added "top_realgoal", which is useful for investigating goalstacks. Thu 8th May 97 gtt.ml Changed "loadt" to be less dependent on the Unix library. Now it only depends on Unix for the PID, and this could be avoided. Thu 8th May 97 mizar.ml Simplified Mizar to avoid using metavariables; hence diffuse statements are now banned. This makes lots of things much simpler. Mon 5th May 97 pair.ml, basics.ml Changed the bodies of generalized abstractions to use a new constant "GEQ" rather than equality. The problem is that with standard equality, "\(tup). T" gets its equality predicate obliterated by the default rewrite "(x = T) = x". Changed syntax functions and PAIRED_BETA_CONV correspondingly. Sun 4th May 97 arith.ml Added the definition of "measure" (natural number measures) and proved wellfoundedness. Wed 30th Apr 97 passim Changed a lot of "b => x | y"s into "if b then x else y"s. Sun 27th Apr 97 parser.ml, printer.ml Made the syntax "if b then l else r" acceptable as well as "b => l | r". Made the printer print conditionals as "if-then-else". In the long run, I might try and scrub the conditional expression; I think "if-then-else" is normally clearer. Mon 21st Apr 97 ind-defs.ml, basics.ml Moved the function "make_args" back from ind-defs into a more general place, since it's used in other places. Also tweaked it to avoid using numbers when only a single argument is required. Mon 21st Apr 97 ind-types.ml Added "prove_cases_thm" to prove the exhaustive case analysis theorems. Also changed the variable name stylization in the induction theorems to use "x" rather than "a" since the latter is already in use for the arguments. Mon 21st Apr 97 term.ml, basics.ml, bool.ml, tactics.ml Backed off the change to "variant" and instead installed an alternative "mk_primed_var" and used that in a few tactics instead of "variant". Fri 18th Apr 97 trivia.ml Deleted the constants S and K and redefined I directly. They were not useful and frequently clashed with variable names, even more troublesome given the change to variant. Fri 18th Apr 97 term.ml Changed "variant" so that it also avoids constant names. This seems useful in many situations, e.g. in problems with CHOOSE_TAC in the presence of constants with the same name as the existential variable (this was pointed out by B. Karthikeyan). Fri 18th Apr 97 class.ml Fixed a subtle bug in the tautology checker found by Claire and Tom at Glasgow. The collection of useful case splits was being accumulated at the start. However in certain composite expressions other than boolean variables, new subterms can be created by the case splits chosen by the unsubtle "deepest first" algorithm, e.g. from a term "P(x:bool)" two new terms "P T" and "P F". Fixed this by moving the "ok" accumulation into the REPEAT loop. Sun 23rd Mar 97 calc_num.ml Term-netted the general numeral arithmetic conversion to make its discrimination a bit faster. Added Karatsuba multiplication, which is a lot faster for really big numbers. It's pretty crude and could be optimized a great deal. Sat 8th Mar 97 basics.ml Slightly modified the term compactor: since "mk_mconst" recreates its types anyway, there's no point in rehashing the type. Fortunately there aren't usually all that many different polymorphic instances of constants! Also made the hash tables visible, for convenient tweaking. Sat 8th Mar 97 sets.ml Added stuff about recursive definitions over finite sets. The proofs are a slight variant of those from Ching-Tsun Chou for his HOL88 "aci" contribution. It's actually quite tricky; we copy his trick of defining a relational form including the cardinal, as in Tom Melham's original definition of CARD. Fri 7th Mar 97 sets.ml Added some trivia about finiteness being preserved by subset, union and intersection. Also added definitions of cardinal relations, but not much more. Wed 5th Mar 97 meson.ml Put an EQ-test optimization in unification and equality-under-instantiation tests. Wed 5th Mar 97 real.ml, calc_rat.ml Added a "proper" definition of summation, and a load of theorems from the old reals library. Threw away "Sum0". Wed 5th Mar 97 parser.ml Added another syntax class of "typed_appl_preterm", to allow types on subcomponents of binary operators, e.g. `x:A,y`. This has the side-effect that `x,y:A` means `x,(y:A)` not `(x,y):A`. We could change this by slightly generalizing "precedence" to take two different parsers, but the new behaviour seems at least as intuitive. Mon 3rd Mar 97 mizar.ml Corrected Mizar mode so that "endcase" does not perform an "end". This is achieved by doing a SUBGOAL_THEN followed by a "conclusion" in the global goal. There are still other things to fix here; in particular there are problems with the treatment of metavariables in several ways; best to avoid "now" for the present! Sun 2nd Mar 97 mizar.ml Changed treatment of case splits so "per cases" creates two subgoals, the first trivial, and "suppose" now *always* tries to finish the current subgoal before splitting. This seems neater than repeating each time a test for whether there were any conclusions; this was hard when using metavariables. Also fixed a bug in transitivity chaining. Sat 1st Mar 97 meson.ml Made the polymorphic duplication more generous: it was missing trivial instantiations if it could find any others. Sat 1st Mar 97 parser.ml Changed the parsing of set enumerations to parse a list of comma separated "typed_apreterms", rather than parsing a preterm then splitting pairs. The snag with that was that it was impossible to enumerate a set of pairs, since even bracketing was ignored. Sat 1st Mar 97 list.ml Added ITLIST and EX(ISTS). Sat 1st Mar 97 int.ml Corrected ARITH_TAC so that it deals correctly with non-variable terms; previously, it only worked if the ultimate constituents of the terms were atoms. Fri 28th Feb 97 mizar.ml, arith.ml, real.ml, int.ml Changed the treatment of transitivity chains to be more powerful and useful. Now they store some transitivity theorems, and these are used to connect together binary relations where the left of the second is "...". Fri 28th Feb 97 mizar.ml Generalized labelled formulas so one can label the conjuncts, separating them by "and". Also cleaned up the parser and treatment of let-bound variables, which were working out wrong when dollared. Thu 27th Feb 97 mizar.ml Fixed up Mizar mode with a parser based on the new combinators. Tue 25th Feb 97 ind-types.ml Added tools to prove injectivity and distinctness of inductive type constructors. Tue 25th Feb 97 list.ml Added FORALL Mon 24th Feb 97 recursion.ml Fixed a bug in proving recursive functions exist, so it still works even if the user only wants to justify some, not all, of the recursive functions. This is useful as a subroutine for the expansion of nested types, even if the user is unlikely to want trivially mutual definitions. Mon 24th Feb 97 lib.ml Added "set_eq", a set comparison of lists. Sun 23rd Feb 97 pair.ml Manually redid an automatic proof --- it was already highly inefficient using meson, and now with duplication of polymorphic theorems it's even worse. Sun 23rd Feb 97 tab.ml, meson.ml Deleted tableaux prover, which seems merely a diversion now meson can cope with polymorphism. Also in the interest of simplifying interfaces, threw away equality-free versions of meson and deleted the "EQ" from names. Sun 23rd Feb 97 meson.ml Fixed up meson so that polymorphic lemmas to x_MESON_TAC are automatically duplicated for relevant-looking instances in the existing assumptions. This seems crude and is probably incomplete, but it seems to make meson cope with most or all cases of polymorphic instantiation that occur in practice. Sun 23rd Feb 97 meson.ml Slightly improved the standard equality handling by adding just (x = y) /\ (x = z) ==> (y = z) instead of separate symmetry and transitivity laws. Sun 23rd Feb 97 bool.ml Fixed "is_beq", which was always returning false by comparing wrong type with `:bool`. Sun 23rd Feb 97 recursion.ml Corrected the argument reshuffling so that it works even if the recursive instances of the function are applied to fewer arguments than in the varstructs on the left. Sat 22nd Feb 97 meson.ml Installed Brand's transformation (SIAM J. Computing, vol. 4, pp. 412-430, 1975). Pending detailed comparative tests, left the old equality stuff in as an alternative. Early indications are that most cases get quicker (proofs a bit longer but found more quickly) but a few hard ones get quite a bit longer. Sat 22nd Feb 97 ind-types.ml At last, cleaned up the mutually recursive types so the postulated recursive functions have different codomain types. Reshuffled definition of sum type as we need this first. Wed 19th Feb 97 recursion.ml Reimplemented "new_recursive_definition" to work properly, even in the mutual case. Tue 18th Feb 97 parser.ml, passim Rewrote the parser in terms of nicer infix combinators. Also made the installation of user parsers more flexible (try-fail interface rather than keying on brackets). Also, treated "=" explicitly with lower precedence than conditionals. Mon 4th Nov 96 lib.ml Added multiset union and subtraction (could no doubt be done much more efficiently). Sun 3rd Nov 96 printer.ml Put in a rather ad hoc printer for program stuff. One day all this will be completely reweitten and replaced by something nice. Sun 3rd Nov 96 wf.ml Added a theorem saying that applying a measure function into a WF ordering gives a WF ordering. Sun 3rd Nov 96 tactics.ml Changed META_EXISTS_TAC to X_META_EXISTS_TAC, and provided a META_EXISTS_TAC that invents a variant of the original name. Sat 2nd Nov 96 sets.ml Beefed up "IN_ELIM_THM" with a predicate version of the GSPEC clause. Sat 2nd Nov 96 preterm.ml Corrected "undollar" so it also works inside varstructs. Fri 1st Nov 96 printer.ml Threw in printing of generalized abstractions. Really, all this stuff could be done much more neatly. Thu 31st Oct 96 ind-defs.ml Added a few extra entry points and a flag to "generalize_schematic_variables" so that the user can avoid gratuitously generalizing monotonicity hypotheses that weren't proved. This came up in defining the WP semantics of while loops; one wants to modify the monotonicity assumption to the monotonicity of the body. Wed 30th Oct 96 mizar.ml Put in a couple of pre-provers to get the common cases quickly. First try to match a conjunct of the assumptions, then try rewriting. This works out a lot quicker on average. Wed 30th Oct 96 tab.ml Added two new equality handling features to tableaux. Though incomplete, they should be pretty useful. First it uses initial equational theorems as rewrite rules. Second, it uses any clauses "v = t" or "t = v" to rewrite with "v = t" everywhere and dispose of the assumption. Finally, added a type variable renaming feature to better allow unification with type instantiation. Wed 30th Oct 96 simp.ml Added "LIMITED_REWRITE_CONV", which is useful in a few situations. Fri 25th Oct 96 bool.ml Made a few small tweaks, mainly replacing "type_of v" by "snd(dest_var v)" where "v" is a type. Thu 24th Oct 96 preterm.ml Corrected the function "typify": the environment was being used to attach types to binding instances of variables. Tue 22nd Oct 96 meson.ml, pair.ml Fixed yet another bug in the equality adder: it was creating congruence rules assuming that constants are fully applied. However after first order reduction this is not so for the I (application) combinator. Now fixed. At last, meson proves the goal in "pair.ml" that it should --- although it takes a while of course. Tue 22nd Oct 96 canon.ml, meson.ml Rewrote the FOL reduction so that it can be applied in an integrated manner to all the assumptions of a goal, rather than merely a term at a time. This fixed a few cases where meson would fail. Also made the precanonicalizer for meson simpler by using genvars for specializations. Tue 22nd Oct 96 drule.ml Fixed a bug in matching where even pure variables were treated as a higher order match, requiring all type instantiations to have been resolved. Mon 21st Oct 96 mizar.ml Finished a completely rewritten version of Mizar mode, with metavariables for diffuse statements, nested proofs, alternative prover via "by ... with ..." and various other enhancements and bugfixes. Got out the following nice proof of Tarski's fixpoint theorem: let f be A->A; assume L:antecedent; antisymmetry: (!x y. x <= y /\ y <= x ==> (x = y)) by L; transitivity: (!x y z. x <= y /\ y <= z ==> x <= z) by L; monotonicity: (!x y. x <= y ==> f x <= f y) by L; least_upper_bound: (!X. ?s:A. (!x. x IN X ==> s <= x) /\ (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s)) by L; set Y_def: Y = {b | f b <= b}; Y_thm: !b. b IN Y = f b <= b by rewriting with Y_def,IN_ELIM_THM,BETA_THM; consider a such that lub: (!x. x IN Y ==> a <= x) /\ (!a'. (!x. x IN Y ==> a' <= x) ==> a' <= a) by least_upper_bound; take a; !b. b IN Y ==> f a <= b proof let b be A; assume b_in_Y: b IN Y; then L0: f b <= b by Y_thm; a <= b by b_in_Y, lub; so f a <= f b by monotonicity; hence f a <= b by L0, transitivity; end; so Part1: f(a) <= a by lub; so f(f(a)) <= f(a) by monotonicity; so f(a) IN Y by Y_thm; so a <= f(a) by lub; hence thesis by Part1, antisymmetry; end Sun 20th Oct 96 basics.ml and others Added "compact" and "COMPACT" to enforce maximal sharing on terms and types (well, not quite, because of the way mk_const works, but not bad). Made separate "prove" and "PROVE" which respectively do and don't apply the compactor. So far the results are positive but the improvement is surprisingly modest; maybe CAML does this sort of thing itself anyway. Sat 19th Oct 96 canon.ml Fixed the lambda-remover to be less zealous, otherwise there will be problems with special binder terms. Now it will just remove lambdas in beta redexes and on either side of equations. This probably covers most cases in practice. Tue 15th Oct 96 nets.ml Fixed a bug in the term nets code. This would very seldom strike; the problem was that "label_to_store" was not remembering the environment of bound variables. This means if one of them happened to be the same as a local constant, it would disable a match with an alpha-equivalent but unequal term. This showed up in matching ASSUME `sup (\x. ?n. x = f n) - e < f n` with `sup (\x. ?m. x = f m) - e < f n`. The fix is crude but adequate: replace the variable by a genvar in such cases so it couldn't possibly be the same as a local constant. Tue 15th Oct 96 arith.ml Put in the (easy) proof of DIV_MUL_LE, which has been mk_thm'd for a long time, for some reason. Tue 15th Oct 96 meson.ml Fixed the use of "FOL_CONV" at the right point in the MESON canonicalizer, i.e. after NNF conversion and CHOOSE-ing of existential variables. The practical effect of this is that we can prove Andrews's "unique fixed point" theorem in its most natural form. Mon 14th Oct 96 basics.ml, drule.ml, and passim Completely rewrote matching and higher order instantiation. Instead of the crude old 2-phase approach where the beta conversions were applied in a rather indiscriminate way, the new version has the instantiation list contain a list of pattern variables to beta-reduce. A few proofs broke under this because accidental beta conversions was relied on. The simplest solution was simply to install BETA_THM as a basic rewrite (long-term, will use BETA_CONV in the net directly, but this is OK pro tem). Don has done this anyway, i.e. replaced ABS_SIMP with BETA_THM. Rather surprisingly this change broke no proofs at all, so it's definitely a good idea. Lots of BETA_THM's deleted from rewrites all over the system. Sun 13th Oct 96 basics.ml, bool.ml Made "type_match" keep its accumulator in the visible version. This at least makes ISPECL tidier, and seems a good idea in principle. Sun 13th Oct 96 equal.ml Tweaked SUBS_CONV so that if no substitutions occur, any new hypotheses in the equational theorems get included in the result. That this was happening was an unfortunate consequence of the implementation style. It affected later tactic proofs by propagating bogus assumptions in SUBST_ALL_TAC. Sun 13th Oct 96 meson.ml Fixed a serious and longstanding bug in the MESON equality axiom producer. It was only producing equivalence axioms for equalities of a type that actually occur in the target. However in general this is not enough, e.g. "P x y /\ ~P x z ==> (y = z)" requires equality axioms for the type of "x" too! Sun 13th Oct 96 tactics.ml Put a check for boolean goal into mk_goalstate, from where it propagates out to other relevant functions like "prove". Sun 13th Oct 96 basics.ml Did a lot of cleaning up of the basic term matching function, including avoiding inefficient recalculation of the type instantiations from the term instantiations over a set of higher order pattern subterms. Also a bit of dead code removal and other minor efficiency tweaks like using "snd o dest_var" instead of "type_of" for known variables. Also an enhancement: the outer types of patterns are matched first, which in principle could lead to more matches. Another enhancement: the local constants, besides stopping instantiations of variables, are used to fix those too for the matching of patterns. This will be specially useful for Mizar, but seems a good idea anyway. Sat 12th Oct 96 basics.ml, bool.ml, drule.ml Tidied and optimized the simple stuff in "basics.ml". Moved the binder syntax back here from "bool.ml" (hence reduced the duplication in the deneralized abstraction syntax operations, which use universal quantifiers). Also moved the dreaded "mk_thm" to the start of "drule.ml". Deleted the function "beta" completely; it was only used once in "ind-types.ml". Sat 12th Oct 96 equal.ml Made a few minor tweaks, including delting BODY_CONV which was no longer used (the old canonicalizer used it). Mostly replacing "rhs" with "rand" and reorganizing type annotations more tidily. Sat 12th Oct 96 term.ml Made various minor but probably worthwhile optimizations, including the avoidance of rebuiling some paired varstructs, and slightly tidier control flow in "inst"; also the type_of tests for known variables have been optimized. Fri 11th Oct 96 tactics.ml, passim Corrected CONV_TAC so it accepts |- p rather than |- p = T even if p is an equation. Hence removed some EQT_INTROs. Fri 11th Oct 96 tactics.ml Fixed an analogous bug in DISJ_CASES_TAC; I notices how slow really big case splits were becoming. The resulting theorem was getting all prefixes of a big disjunction. Now I recall this was a fix due to TFM for a problem in the HOL88 subgoal mechanism. I guess it won't affect mine as the assumption is explicit; should think it over though. Anyway it all seems to work. Fri 11th Oct 96 canon.ml, tab.ml, meson.ml, real.ml Replaced the old complicated (but slightly more efficient) canonicalization stuff with simpler versions using rewriting. In particular, took out all the "REFUTER" stuff which is cute but too complicated. This necessitated a lot of consequential changes in files that use that stuff. Fri 11th Oct 96 tactics.ml Fixed a bizarre bug in X_CHOOSE_TAC, which was keeping the existential assumption in the new theorem. Also a less bizarre but completely stupid one in CHOOSE_THEN: the variant was being chosen avoiding the hypotheses of the existing assumption theorems, rather than the conclusion! Fri 11th Oct 96 iprover.ml, tactics.ml Moved FIRST_X_ASSUM into the main tactic file. Wed 9th Oct 96 drule.ml Beefed up the sanity check in PART_MATCH to force equality rather than alpha conversion. Wed 9th Oct 96 term.ml Separated off "pure alpha conversion" (without a preceding equality test) as "paconv". Wed 9th Oct 96 list.ml Locally changed the bound variable names of list_INDUCT inside LIST_INDUCT_TAC so that the induction subgoals have these names, as before. Tue 8th Oct 96 cprover.ml Implemented the main prover module. However it's very slow compared with the search-separated TAB_TAC. Tue 8th Oct 96 iprover.ml Fixed a bug in the unifier. Tue 8th Oct 96 tab.ml Fixed a bug resulting from the backing off of the equality stuff; a previous version of NNF_CONV had been used that took its args in a different order. Tue 8th Oct 96 list.ml Proved the remaining theorems in the modest list theory that had previously been asserted. Tue 8th Oct 96 ind-types.ml Moved the definition of lists to here, and also proved standard induction and recursion theorems for the pair type. Tue 8th Oct 96 ac.ml + passim Now we have ordered rewriting, the small performance improvement from AC_CONV et al. hardly seems worthwhile. So I removed ac.ml from the build sequence, inserting a trivial "AC" using ordered rewriting in theorems.ml, and using ordered rewriting directly in many of the proofs. Some other things, like syntax for binary operators, have been scattered in other files. The ASSOC and DISTRIB conversions have gone in canon.ml pro tem, pending a complete rewrite of that file. Mon 7th Oct 96 cprover.ml Set up basic canonicalization conversions for the classical prover and the mechanism to set it up as a prover, using a goalstate as a context. Sun 6th Oct 96 simp.ml Corrected some of the simplifier traversal strategies, and generally rewrote and optimized stuff. Sat 5th Oct 96 simp.ml Made a few minor tweaks, including optimizing and correcting the default term ordering. Sat 5th Oct 96 theorems.ml Now all the equality-free theorems here are provable by ITAUT rather than special tactic scripts, so I've done that. In the long run, we could deal with equality too. Sat 5th Oct 96 tactics.ml Fixed a bug in META_EXISTS_TAC, and a corresponding one in EXISTS_TAC; these were not instantiating the pattern argument to exists (left part of paired argument). This was causing problems with proving things involving existential quantifiers in ITAUT_xx. Fri 4th Oct 96 tactics.ml Fixed a bug in "by", which was passing the non-updated instantiation to the body of the new justification function. Fri 4th Oct 96 iprover.ml Replaced the ad hoc tautology prover by one using tactics, exploiting the metavariable feature. This also does some first order logic (without equality), modulo bugs. Fri 4th Oct 96 tactics.ml Added (as an experiment) two metavariable tactics: META_EXISTS_TAC and META_SPEC_TAC. Fri 4th Oct 96 tactics.ml Optimized UNDISCH_THEN, so now it uses the theorem directly rather than doing inference. Fri 4th Oct 96 tactics.ml Added "FIND_ASSUM" to use an assumption with given conclusion. (A more efficient alternative than using ASSUME, now to be deprecated.) Fri 4th Oct 96 bool.ml, canon.ml Corrected "is_beq" and moved it back to "bool.ml". Fri 4th Oct 96 simp.ml, tactics.ml Reversed the build order of these two files so that tactics come first. This seems better as we can then use tactics to get a simple logical theorem prover. Accordingly, moved the rewriting tactics out of "tactics.ml" and into "simp.ml". Tue 1st Oct 96 ind-types.ml Fixed a silly little bug in the "extract_arg" function; it only worked when the string of FSTs and SNDs generated by a recursive call was exactly one of FST and SND without nesting. This caused examples from Steve Brackin and Konrad Slind to fail. Now they all seem OK. It even handles Konrad's big 68000 instruction set example (418 seconds on swordfish). Tue 1st Oct 96 parser.ml Added semicolon and comma to the stock of "brackets" (single-character identifiers). Tue 1st Oct 96 parser.ml Added an option (lexquotes) to allow recognition of items in '....' as variable names, even if they don't obey the usual syntactic conventions. This was to simplify supporting Prover logs, but is arguably useful. Anyway it's switched off. Also corrected the string quotes inside quotation parser to double quotes. Mon 30th Sep 96 lib.ml Inserted a slightly seedy hack into "set_insert" and "set_merge" to make the builtin orderings return false rather than fail when given functional values. Since the built-in ordering is lexicographic on pairs, this lets us prioritize the data lists in term nets without any special ordering. Perhaps I should do this properly... Mon 30th Sep 96 nets.ml Rewrote nets completely. First, included a facility for local constants (i.e. variables not instantiable in context), and included a function to merge sets. This is more or less ripped off from Don's hol-lite code, though I don't store the local constants in the net as he does. Also made the data lists canonically sorted, so that we can encode priorities in convnets without any special measures. Mon 30th Sep 96 lib.ml Added a function "set_merge" to perform (set) union of canon-sorted sets. Mon 30th Sep 96 theorems.ml Stepped the _AC suites for conjunction and disjunction up to _ACI ones; this still gives a normalizer with ordered rewriting (I hope). Mon 30th Sep 96 simp.ml Modified the default term ordering to be a dynamic lex order. I think this is AC-compatible and efficient, but I'm not 100% sure. We'll see... Sat 28th Sep 96 wf.ml, arith.ml Fixed two broken proofs. The "arith.ml" one was the old favourite of nonconfluent rewrites. The "wf.ml" one is a bit odd; the name of a bound variable, later freed by STRIP_TAC, changed. This is presumably because I deleted the alpha conversion wrapper round REWR_CONV, since it seemed pointless. But I guess some consequences made it to the toplevel, maybe via the ind def package. Anyway, gratifyingly few breaks. Sat 28th Sep 96 simp.ml, drule.ml, iprover.ml Created "simp.ml" containing the core of a simplifier. This is crudely speaking all the "atomic" stuff, which is a generalization of basic HOL rewriting to include ordered rewriting and conditional rewriting (though without doing anything with the conditions yet except leaving them as assumptions.) The nice thing about isolating this part first is that we can integrate it with the basic HOL rewriting. This has been done, so the rewriting stuff has been taken out of "drule.ml". I've also separated off the intuitionistic tautology prover; this is a bit half-baked and deserves to be the core of a more serious prover anyway. Sat 28th Sep 96 theorems.ml, arith.ml, reals.ml, int.ml Added xxx_AC theorems for conjunction and disjunction, and for addition and multiplication of naturals, reals and integers. This is in preparation for ordered rewriting, when lots of things will become better. Fri 27th Sep 96 ind-defs.ml, lib.ml Moved "nsplit" back into lib.ml since it seems fairly general. Fri 27th Sep 96 basics.ml Made "free_in" work up to alpgha-equivalence. Wed 25th Sep 96 tactics.ml Abandoned pro tem the keeping of a series of goalstacks as completed ones were stuck there, causing problems. Wed 11th Sep 96 equal.ml Cleaned up the file a bit, e.g. removed pointless error traps for RAND_CONV and RATOR_CONV. Fri 6th Sep 96 term-nc.ml Added an optimization to "type_of" for the case "(\x. s[x]) t". Also renamed the file simply to "term.ml" since there's no foreseeable prospect of having dB terms back. Fri 6th Sep 96 type.ml Fixed a bug in "tyvarsl", which simply returned the list unchanged due to a permutation of the arguments to itlist. Fortunately this wasn't used anywhere. Now "tyvars" and "tyvarsl" are mutually recursive. Thu 15th Aug 96 tactics.ml Renamed "merge_insts" to "compose_insts" (which better suggests its sequential nature). Also corrected (?) the implementation, which was completely wrong. Thu 15th Aug 96 tactics.ml (was newtactics.ml) Fixed a moronic error in the goalstack printer which usually caused no subgoals to be printed during an interactive goalstack proof. (Basically, it used the number of current goals minus the previous number to indicate how many to print. It should be one greater than that, while being at least 1, and with no previous goal being another special case of 1.) Thu 15th Aug 96 tab.ml Replaced the new but more complicated version of tableaux (with a half-baked and incomplete equality handling system) by the old equality-free but simple version. I'll attack this again in a different way sometime. Must also try Brand/E-SETHEO transformation to MESON. Thu 15th Aug 96 Made bool_ty (":bool"), aty (":A") and bty (":B") global; removed all their local bindings. Thu 15th Aug 96 term-nc.ml,ind-defs.ml Moves "lhand" back with the other term syntax stuff. Thu 15th Aug 96 Following a suggestion of Donald Syme, deleted the file "dsyntax.ml" and inserted these syntax functions in the natural (usually) places in the development. The main defect is that some duplications are needed in the printer, which uses some derived destructors. Eventually this will be fixed when the printer prints preterms not terms (another suggestion from Don; I think Isabelle does it this way too). Thu 15th Aug 96 preterm.ml Trivial change: made "unify" curried, to use "do_list2" instead of "zip" in its implementation. Wed 14th Aug 96 parser.ml Fixed parser not to keep swallowing undefined type constructors. This introduces more context-sensitivity into parsing. However this was my original intention, since one part of the pretype parser already made this check. Mon 12th Aug 96 ind-defs.ml Made "make_args" take a letter argument, for greater flexibility. Thu 27th Jun 96 newtactics.ml Added an experimental new scheme for tactics. This retains labels, but also (1) makes the assumptions theorems, and (2) includes metavariables. There is now a move to the notion of a "refinement" on a set of subgoals (since with metavariables, the order in which goals are solved matters). This has been used to provide goalstack-like facilities in a less ad hoc fashion. The new aspects may be buggy, but it's surprisingly upward-compatible. Mon 17th Jun 96 tacticals.ml,tactics.ml I discovered SUBST_ALL_TAC was throwing away assumptions. Fixed this and related problems by adding "POP_LASSUM_TAC" and making RULE_ASSUM_TAC use it to preserve labellings. There might be a few others of these lurking. Sun 16th Jun 96 subgoal.ml Made the subgoal state a list (i.e. stack) of goalstacks. This allows one to go into a new goal state then return to the old one (but you need to "b()" explicitly; it doesn't happen just when the subgoal is proved). This is to support Mizar processing but it's handy anyway. I think hol90 does it. Sat 15th Jun 96 subgoal.ml Added a flag "valcheck" to make validity checking optional. Sat 8th Jun 96 basics.ml, printer.ml, subgoal.ml, tacticals.ml, tactics.ml, meson.ml Introduced labelled assumptions in tactics. The main reason was to achieve a new level of integration between tactics and MESON proofs. However labels seem useful for other reasons. The main additions are "LABEL_TAC" to perform a labelled "ASSUME_TAC", and "USE_ASSUM" to grab the assumption with a given label. The goal prettyprinter puts any labels in parentheses at the right of the term, which seems quite close to mathematics books, and doesn't disturb the formatting. While tinkering with tactics, I also grabbed the chance to add "UNDISCH_THEN" which I've always wanted, and added a generic function "ASM_TAC" to augment the theorem list given to a tactic with the assumptions of the goal. In fact, if we called it just "ASM" then "ASM REWRITE_TAC[]" and "ASM_REWRITE_TAC[]" would be the same and we could avoid all those extra functions. Perhaps the HOL world isn't quite ready for that, though. Since I can't use my pet "W(ACCEPT_TAC o mk_thm)" any more, I decided to add "CHEAT_TAC"! Anyway, no proofs broke, and there are some big ones now. Of course, there was no reason why they should. Fri 7th Jun 96 ind-defs.ml Corrected a non-PE'd quotation (just `T` fortunately) which somehow got left in. Sat 25th May 96 calc_rat.ml Added "REAL_SUM0_CONV" to evaluate summations. I don't really know why I put it in this file. Fri 24th May 96 calc_rat.ml Included "REAL_RAT_DIV_CONV" in the overall conversion; it had been inadvertently left out. Also optimized REAL_RAT_DIV_CONV to fail quickly when given a canonical rational. Wed 22nd May 96 tactics.ml Added "ABBREV_TAC", which I found quite useful in the reals library in HOL88. I've now come across a use for it, and in general, I think it's a worthy inclusion. Wed 22nd May 96 calc_num.ml Added a "NUMERAL" on the right-hand side of the first ARITH_SUB theorem! Tue 21st May 96 tab.ml Put proper initialization of "cstore" in "fol_of_const" and friends, so that a call to "reset_cstore" isn't necessary at the start. This bug was pointed out by Donald Syme. Mon 20th May 96 dsyntax.ml Added "is_beq" test for Boolean equations (iffs). Sun 19th May 96 equal.ml Fixed up "BINOP_CONV" to do what it should do, i.e. ignore the operator. (The old one checked it against an additional argument). Added "DEPTH_PRED_CONV" to apply a conversion to atoms in pred. calc. Fri 26th Apr 96 calc_num.ml Added "num_CONV"; not before time! Now it's derived, of course. Sat 20th Apr 96 printer.ml Added printing of a space after the ";" and "," separators for lists and sets. Sat 20th Apr 96 dsyntax.ml, equal.ml Added "is_cons" (forgotten earlier) and a conversion "LIST_CONV" to apply a conversion to each element of a list. Sun 31st Mar 96 printer.ml Put special syntax for list printing in; also fixed a bug in printing of term sequences (it always used "," regardless of the separator argument, and due to a syntax ambiguity in CAML, it wasn't dealing with empty lists correctly). Sun 31st Mar 96 dsyntax.ml Put in syntax functions for lists: mk_cons, dest_cons, mk_list, mk_flist, dest_list and is_list. Sun 31st Mar 96 real.ml Took the rewrite-based natural number arithmetic conversions out; now the new, more efficient ones are used. This file now does seem to go through a bit faster (2:25 rather that 2:50 real time for the REAL_ARITH_TAC applications). Sun 31st Mar 96 calc_num.ml Finished a complete suite of numeric calculation routines. They're OK, but really multiplication should be O(n^log_2(3)) optimized. Anyway, the performance is not too disastrous, e.g. `2 EXP 1000` takes under 7 seconds; `(2 EXP (4 + 5) * 2) DIV (3 EXP (8 MOD 4))` takes 0.35 seconds (on woodcock). Note the "n * 1 = n" traps in multiplication; given these, then denormalization will never occur, per construction (or so I hope). Sun 31st Mar 96 arith.ml Added theorems about the uniqueness of DIV and MOD, and derived some earlier theorems from them. Sat 30th Mar 96 arith.ml calc_num.ml Separated off the arithmetic rewrites into a separate file "calc_num.ml". Began augmenting these crude rewrites with some more efficient conversions. Sat 30th Mar 96 dsyntax.ml arith.ml parser.ml printer.ml Wrote versions of numeral conversions using Valerie's bignums. Just in case, added "small" versions for type "int"; maybe these should be scrubbed in fact. Moved the numeral constructors forward into "arith.ml" to get the benefit of a bit of PE. (The destructors are needed in the printer at present.) Fixed up the parser and printer to use bignums; changing pmk_numeral. Sat 30th Mar 96 - Moved over to version 0.71 of CAML without obvious problems. Took the chance to set up a preload of both unix and bignum stuff in "my_little_caml". Sat 30th Mar 96 real.ml Fixed a thinko in "REAL_ATOM_NORM_CONV". I'd defined an optimized conversion internally to avoid pointless "&0 = a" -> "&0 = a - &0" canonicalization, but then never used it. This ought to make the real arithmetic stuff marginally faster on average. Fri 29th Mar 96 arith.ml, parser.ml, perterm.ml, dsyntax.ml, num.ml Put an extra tag "NUMERAL" round all bitwise numerals. This is to fix an old bug where one numeral is actually a subterm of another, leading to bizarre effect such as rewrites with |- 1 = SUC 0 to "2". The change was pretty trivial to make, fixing all the numeral manipulating syntax functions, parser etc. and throwing in NUMERAL as an additional rewrite to derive some theorems. All the arithmetic rewrites now have the extra "numeral" tag. NB! We consistently use the numeral tag for zero too (which therefore ceases to be a constant). This may require a modest hack when we get round to defining "new_recursive_definition" properly. As it is, we now have "_0" for the constant (which is needed as a foundation for the numerals). Thu 28th Mar 96 thm.ml Hey -- our first unsoundness bug since teething troubles over prelogic! This was pointed out by Tom: in the definition rules there's a requirement not to have type variables free in the term being defined which aren't free in the new constant. For example: let th0 = new_definition `X = !x:A. !y. x = y`;; let th1 = INST_TYPE [`:one`,`:A`] th0 and th1' = INST_TYPE [`:bool`,`:A`] th0;; let th2 = TRANS (SYM th1) th1';; let th3 = ONCE_REWRITE_RULE[one] th2;; let th4 = REWRITE_RULE[] th3;; let th5 = SPECL [`T`;`F`] th4;; let th6 = REWRITE_RULE[] th5;; Fixed this by a check in "new_basic_definition" that all type variables in the predicate are in the type of the constant to be defined. I think this is the right thing: it means that type instantiation of the predicate is reflected in a change to the constant. But should think this over carefully one day... Thu 28th Mar 96 lib.ml Put a "subset" function in. About time; see above for the reason. It would be more efficient to sort first, but I don't really mind... Thu 21st Mar 96 meson.ml Fixed a very strange bug in the production of congruence rules for EQ_MESON. It was completely wayward, producing something not in clausal form. Obviously I'd just assumed this worked without even the most rudimentary testing. Wed 20th Mar 96 meson.ml Fixed a gross blunder in "fol_of_hol_clauses". It was taking as the set of local constants the hypothesis frees of the head theorem, but now takes the hypothesis frees of the theorem it's actually doing. What was I thinking? Sat 17th Feb 96 drule.ml Removed "part_match_error". I've no idea how that got there. Anyway the compiler couldn't infer the types ("I" in a ref) so it spoiled my profile run. Wed 14th Feb 96 gtt.ml Moved "trivia" back before "canon", since we might as well use I_THM for first order reduction. Wed 14th Feb 96 canon.ml, meson.ml, tab.ml Wrote a conversion FOL_CONV to produce a better FOL reduction (Donald Syme was already finding examples where the naive apporach failed). Basically it finds the minimal application level for each "constant", then fills out any greater levels with explicit invocations of the "apply" operator (we use I for this -- probably should use a separate constant just in case the original formula involves "I"...) This is now used by tableaux and MESON. Wed 14th Feb 96 canon.ml Put in an extra conversion for REFUTE and CNF_REFUTE which is applied after the reduction to NNF, but before any splitting etc. The idea is to allow a superior massage into first order form. Wed 14th Feb 96 printer.ml Put a break after each assumption in "print_thm". Tue 13th Feb 96 real.ml Proved all the trivial lemmas leading up to the arithmetic decision procedure, which had previously been mk_thm'ed (they all turned out to be true!) Really, should go over these again when the equality handling in TAB_TAC improves; it should do almost all of them automatically. Tue 13th Feb 96 canon.ml, tab.ml, meson.ml, real.ml, int.ml Added conversions EQ_ABS_CONV and UNLAMB_CONV. The latter tries to eliminate lambda-terms from formulas as input to first order automation tools. Now since the elimination of a lambda requires the resulting term to be further processed (to get it into NNF and remove any further lambdas), the NNF_CONV function has been modified to do a retraversal after calling "baseconv". Now to stop this, the conversion given must be NO_CONV, not REFL. This has been appropriately fixed up. The extra baseconv argument has been retained in CNF_REFUTE too. Now tableaux and MESON use UNLAMB_CONV in their NNF steps. Mon 12th Feb 96 thm.ml Put an extra test in BETA_CONV to avoid calling "vsubst" in the special situation where the abstraction variable and argument are the same, i.e. "(\x. t[x]) x". This was intended to make let-elimination more efficient in certain situations, but should have other efficiency payoffs since these trivial beta-redexes often arise in higher order matching, and in SPEC_ALL. Sun 11th Feb 96 parser.ml, printer.ml, dsyntax.ml, pair.ml Changed the representation of lets so that "let x = s and y = t in u[x,y]" becomes "LET (\x y. LET_END (u[x,y])) s t"; the new constant "LET_END" is used to flag the end of the let-terms in case "u" is itself an abstraction. Put in a "dest_let" and "is_let"; the former is now used in the printer. Sun 11th Feb 96 printer.ml Increased box limit (after which elision starts) from default of 35 to 100. Sun 11th Feb 96 parser.ml, printer.ml Added parsing support (actually just a correct "pmk_let" constructor; the parser was already OK) and printing support for let-expressions. Fri 9th Feb 96 equal.ml Fixed a fumble in TOP_SWEEP_QCONV, which had TOP_DEPTH_QCONV in place of a recursive call. Thanks to Don Syme for pointing this out. Thu 8th Feb 96 realax.ml Filled in the remaining gaps in the real construction: construction of multiplicative inverse and completeness transfer from ":hreal". Fri 2nd Feb 96 arith.ml Added a proper derivation of the existence of DIV and MOD, and defined them by constant specification. The proof was basically the same as (Tom's?) HOL88 one. Tue 12th Dec 95 meson.ml, arith.ml, realax.ml Added versions of MESON_TAC which take theorems and allow throwing in of the assumptions, by analogy with REWRITE_TAC and ASM_REWRITE_TAC. These are much more convenient to use, and instances in other files have been updated. Tue 12th Dec 95 canon.ml Added "CONV_OF_PROVER", useful for more palatable forms of MESON_TAC, TAB_TAC and no doubt others in the future. Fri 8th Dec 95 fol.ml Fixed a bug in the addition of equality axioms; it was leaving implications in the supposed clausal form of the congruence rules. Wed 6th Dec 95 canon.ml Used a different version of EXISTS_UNIQUE_THM to eliminate unique-existence; this should make the resulting proofs easier. Wed 6th Dec 95 fol.ml Fixed a bug in the HOL translation of MESON proofs. The local instantiations saved in the proof tree were merely being unioned in, but it can happen that the toplevel instantiations change them (because some variable free in the, err, residue, gets instantiated "right" in the proof. Wed 6th Dec 95 canon.ml Added a preprocessing phase to NNF_CONV which eliminates any logical constants T and F used in combination; it also makes a few other handy simplifications and expands unique-existence instances. The REFUTE function checks whether it's already got "F", just in case that would stump the later function! Tue 5th Dec 95 basics.ml, drule.ml, ac.ml, ind-types.ml Introduced an extra argument "local constants" for term_match. This is instantiated to the variables free in both hyp and concl of the theorem when it's used in PART_MATCH. The main idea is to inhibit impossible higher order matches, and so improve efficiency. However it may lead to usefully more rapid failures in other no-match situations too. Sun 3rd Dec 95 class.ml Took out duplicate SELECT_AX. How did that get there? Tue 28th Nov 95 printer.ml Fixed up the printing of negation properly: it was giving it precedence over infixes --- actually HOL88 does this for high-binding infixes, meaning basically not the logical operations. Perhaps I should introduce precedence for prefixes and follow suit. Also generalized printer to arbitrary prefixes (though in fact we don't have any besides negation yet!) Sun 26th Nov 95 fol.ml Added a new version of MESON_TAC which throws in the equality axioms to the proof search. The initial results are not encouraging... For example Pelletier number 49 takes 6 minutes! But some of the others aren't too bad... Sun 26th Nov 95 sets.ml More set theory stuff ported, using automated proofs; however we still specify by trial and error which equality theorems etc. to throw in. There's also a slight problem over when we want the extra theorems to get rewritten with the definitions (use MP_TAC first when we do, rather than giving it in the theorem list argument). Sun 26th Nov 95 It was just getting too tedious being unable to interrupt things, now we have all these first order automation tools, so... Made a signal call so that SIGINTs raise a new exception "Interrupt". Then trawled through systematically taking out all "with _ ->" traps. Most can be replaced by "with Failure _ ->", since practically every function used is one of ours (except arithmetic, and I think that just wraps without failing). A few need to be treated more carefully (Unchanged exceptions and Cut too in the Prolog engine). So, after a small number of fixes, everything seems to work again, and now interrupts will always(?) propagate. Really, it would be preferable to have a separate signal mechanism, but... Fri 24th Nov 95 fol.ml Modified the tableau procedure to use a similar "offset" technique to MESON in order to create temporary variables. This is much better than inventing stacks of genvars of its own, each with a HOL analog... Thu 23rd Nov 95 fol.ml Added a depth bound (as opposed to inference bound) option to MESON_TAC. Of course it's important that this switches off the divide-and-conquer optimization; this is forced even if the user forgets. We also disable the size consideration in the continuation cacher, to avoid uneccessary conservatism. Wed 22nd Nov 95 fol.ml Added MESON_TAC. It seems to work reasonably well. Tue 21st Nov 95 canon.ml Added conversions for DNF and CNF. Also added the wrapper CNF_THEN_REFUTE, which is a bit more efficient than just applying the conversion at toplevel. Tue 21st Nov 95 ac.ml Added DISTRIB_CONV and BODY_CONV. Tue 21st Nov 95 equal.ml, ac.ml, drule.ml Introduced COMB2_QCONV and COMB_QCONV; renamed COMB_CONV2 to COMB2_CONV everywhere. Mon 20th Nov 95 equal.ml, real.ml Introduced BINOP_CONV as an analog to SUB_CONV which is what I thought it was; the old one is renamed to DEPTH_BINOP_CONV and the two instances in real.ml changed. Mon 20th Nov 95 gtt.ml Fixed the filter to use suffix of pathname only when creating its temporary filename, otherwise it tries to deal with a nonexsistent directory. Mon 20th Nov 95 parser.ml Modified set enumeration parsing to use "INSERT" and "EMPTY", rather than write down an abstraction term explicitly. Mon 20th Nov 95 int.ml Modified the integer decision procedure to do discretization properly, i.e. to force NNF and hence fix the signs of all the inequalities first. The overhead shouldn't be too large since the NNF run introduced by the reals decision procedure will be trivial in most cases (the refuter will give a toplevel double negation, and the remainder is already in NNF). Mon 20th Nov 95 basics.ml Modified "find_terms" to use "insert" rather than "::", and hence produce a set. Mon 20th Nov 95 real.ml Added a quick prepass to REAL_ARITH_CONV to eliminate trivial quantifiers; this can get a few more things into prenex universal form, though it's probably quite useless in practice. Renamed "REAL_ARITH_CONV" to "REAL_ARITH" and put in a separate EQT_INTRO version called "REAL_ARITH_CONV" (just for consistency; it wasn't a conversion). Sun 19th Nov 95 real.ml Altered REAL_ARITH_CONV to force prenex form, and hence avoid failing where a trivial transformation would bring the theorem into universal form, e.g. "!x. x < y \/ !z. z <= y ==> z <= x". Sun 19th Nov 95 canon.ml Added a conversion for prenexing (assuming there are no equivalences or conditionals). Sun 19th Nov 95 int.ml Put in a decision procedure for the naturals; a wrapper for the one for integers. Sun 19th Nov 95 filter.c Tweaked the filter again; it still wasn't giving the right line numbers! Sun 19th Nov 95 real.ml Made sure all quotations get evaluated at load time. This is not just an efficiency tweak -- if a different interface map is in action at runtime, we get a change in behaviour! This was exhibited in the integer decision procedure. Sun 19th Nov 95 int.ml Added a simple decision procedure for linear arithmetic over the integers. This just hacks the term down to the corresponding real fact (we assume it's universal in these procedures anyway) then calls REAL_ARITH_CONV. Sun 19th Nov 95 gtt.ml Made the filter pick a temporary filename which depends on the PID and the original filename -- this should avoid the problem of contention between parallel GTT sessions on the same machine, and give more helpful error messages. Sun 19th Nov 95 thm.ml Made benign type redefinitions acceptable, by the crude device of inserting a cache of previous calls and results. Sat 18th Nov 95 ind-defs.ml INDUCT_THEN and INDUCT_TAC added. These are similar, but not the same, as the ones in the HOL88/hol90 library. In particular, there is no distinction made between "hypotheses" and "side-conditions", and so no call for two separate theorem continuations. Sat 18th Nov 95 sets.ml Wrote simple tactic to reduce the very elementary reasoning to FOL, then call TAB_TAC; hence automatically proved a reasonable number of the theorems in the HOL88 pred_sets library. Sat 18th Nov 95 thm.ml, bool.ml, drule.ml Made benign term definitions acceptable (up to alpha conversion; this is necessary since pairs and set abstractions may introduce different bound variable names on different occasions); also introduced storage of definitions (which was not done before, despite the presence of the variable "the_definitions"!) Fri 17th Nov 95 ind-defs.ml, num.ml, ind-types.ml Changed "new_inductive_definition" to split up the three conjuncts into separate theorems. Modified the two existing uses in the core. Fri 17th Nov 95 sets.ml [new file] Basic definitions for set theory added. Fri 17th Nov 95 parser.ml, preterm.ml, printer.ml Included parsing and printing support for enumerated and generalized set specifications; also added to "preterm.ml" a few preterm syntax functions that were needed and may be useful elsewhere. Fri 17th Nov 95 arith.ml, bool.ml, int.ml, pair.ml, realax.ml, trivia.ml, wf.ml Rationalized the infix precedences as follows (arithmetic operators include their analogs in other number systems and in set theory). They're right-associative, unless marked "L". These seem the most sensible; e.g. x - y + z and x - y - z work as expected. I'm not quite sure where pairing (,) should go really... 2 = 4 ==> 6 \/ 8 /\ 10 general_equivalence_relation 11 IN 12 < <= >= > general_order_relation SUBSET PSUBSET 14 , 16 + UNION 18 L - DIFF 20 * INTER 21 INSERT DELETE 22 L / DIV MOD 24 L pow EXP 26 o Fri 17th Nov 95 lib.ml Put in a version of "map" with a more intuitive evaluation order (left to right). Fri 17th Nov 95 fol.ml Put continuation cacheing into tableau prover (so repeated attempts will immediately fail). On big examples this seems quite useful; e.g. Andrews's challenge now takes 89.77 seconds instead of 130.23. Pelletier 43 now takes 2.21 seconds instead of 13.50. The other Pelletier examples are all pretty much the same. Fri 17th Nov 95 filter.c Changed the filter to echo all newlines (and to flush stdout after each newline, rather than after each ";;"). This makes the error messages from CAML better in two respects: (1) the line numbers are right; (2) you don't get lots of previous phrases spat out at you. Fri 17th Nov 95 real.ml Fixed a bug in the cacher's translator, which did not distribute negations over the final term in a sum. Thu 16th Nov 95 lib.ml Added a timing function. Thu 16th Nov 95 lib.ml Added "report" function and verbose/terse flag; modified "warn" to use it. Thu 16th Nov 95 fol.ml Integrated a simple tableau prover based on Lean-TAP into HOL. The preliminary results are quite good; e.g. it solves most of the equality-free Pelletier problems fairly quickly. Andrews's challenge takes about 2 minutes. Wed 15th Nov 95 real.ml Cleaned up the decision procedure REAL_ARITH_CONV and modified it to use the refuter in "canon.ml" rather than its own bespoke code. Also added intelligent cacheing of atom normaliztion theorems (i.e. it remembers negations of previous atoms --- this seemed easier than canonicalizing prior to the NNF conversion, and probably as efficient, on average, since it might on occasion catch complicated duplicates). Wed 15th Nov 95 quot.ml The "lift_theorem" function in the quotient stuff has been rewritten: given the new higher order rewriting, it's trivial. The left and right sides of the derived theorems returned by "lift_function" have been swapped; this seems more sensible. Wed 15th Nov 95 drule.ml, arith.ml, realax.ml Changed PART_MATCH to attempt a crude (but adequate) preservation of bound variable names. Really, all the higher order matching, BETA_VAR and this should be more neatly integrated in PART_MATCH, which is the practically universal entry point. There are further things one would like, e.g. the recognition that "f" and "f'" should be changed in parallel -- but where do we stop? A few consequentially broken proofs fixed; broken mainly because INDUCT_TAC now (correctly!) preserves the bound variable name in the goal rather than replacing it by "n". Mon 13th Nov 95 basics.ml Substantially enhanced higher order matching so that (1) Manifestly first order bits are handled first, which may increase the stock of determinate variables available later; this is sometimes useful; e.g. RULE_INDUCT_TAC has a more natural coding; and (2) More general patterns are allowed, of the form P (t1[x1,..,xn]) ... (tm[x1,..,xn]), where the x1,..,xn are all determinate. This is useful for doing some transfer stuff (!n. P(&n) = ...) etc. and occasionally in other places too. Mon 13th Nov 95 term-nc.ml Put trivial PE into "inst"; it returns the identity function if the instantiation list is empty. Thu 9th Nov 95 filter.c Fixed filter to ignore interrupts, and also to insert "let it = " before any toplevel phrases which are not declarations. Thu 9th Nov 95 nets.ml, arith.ml, realax.ml Reversed the appending in "follow" to favour specificity in matches; that is "SUC n" will (if matchable) be put ahead of "m" in the list of possible matches. This seems a more sensible defalt. A few consequentially broken proofs fixed. Wed 1st Nov 95 theorems.ml Cleaned up a few proofs, now that higher order matching bugs are cleared. Tue 31st Oct 95 printer.ml Terms and types are now printed with backquotes, not double quotes. Tue 31st Oct 95 parser.ml "lextoken" now uses consing followed by final reverse; probably a bit better than iterative snoc-ing. Tue 31st Oct 95 drule.ml, ind-defs.ml Moved the derived congruence rules back into drule.ml. Tue 31st Oct 95 parser.ml Put in faster character disrimination based on lookup table. (Be nicer to have bitwise operations for this as some aren't mutually exclusive). Mon 30th Oct 95 lib.ml Slightly less lamentable implementation of "explode" substituted. (The old one kept taking the `tail' of the string, which involved creating new copies!) Mon 30th Oct 95 lib.ml,preterm.ml,subgoal.ml The "warn" function added, and the two warnings to date modified to use it. Mon 30th Oct 95 preterm.ml "type_of_pretype" and "term_of_preterm" tweaked so they will invent names for STVs, but issue a warning. Sun 29th Oct 95 subgoal.ml Inserted a warning into "expand" if the tactic does not change the goal state. hol-light/Complex/000077500000000000000000000000001303454263000143545ustar00rootroot00000000000000hol-light/Complex/complex_grobner.ml000066400000000000000000000504051303454263000200770ustar00rootroot00000000000000(* ========================================================================= *) (* Grobner basis algorithm. *) (* ========================================================================= *) needs "Complex/complexnumbers.ml";; needs "Complex/quelim.ml";; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* Utility functions. *) (* ------------------------------------------------------------------------- *) let allpairs f l1 l2 = itlist ((@) o C map l2 o f) l1 [];; let rec merge ord l1 l2 = match l1 with [] -> l2 | h1::t1 -> match l2 with [] -> l1 | h2::t2 -> if ord h1 h2 then h1::(merge ord t1 l2) else h2::(merge ord l1 t2);; let sort ord = let rec mergepairs l1 l2 = match (l1,l2) with ([s],[]) -> s | (l,[]) -> mergepairs [] l | (l,[s1]) -> mergepairs (s1::l) [] | (l,(s1::s2::ss)) -> mergepairs ((merge ord s1 s2)::l) ss in fun l -> if l = [] then [] else mergepairs [] (map (fun x -> [x]) l);; (* ------------------------------------------------------------------------- *) (* Type for recording history, i.e. how a polynomial was obtained. *) (* ------------------------------------------------------------------------- *) type history = Start of int | Mmul of (num * (int list)) * history | Add of history * history;; (* ------------------------------------------------------------------------- *) (* Conversion of leaves, i.e. variables and constant rational constants. *) (* ------------------------------------------------------------------------- *) let grob_var vars tm = let res = map (fun i -> if i = tm then 1 else 0) vars in if exists (fun x -> x <> 0) res then [Int 1,res] else failwith "grob_var";; let grob_const = let cx_tm = `Cx` in fun vars tm -> try let l,r = dest_comb tm in if l = cx_tm then let x = rat_of_term r in if x =/ Int 0 then [] else [x,map (fun v -> 0) vars] else failwith "" with Failure _ -> failwith "grob_const";; (* ------------------------------------------------------------------------- *) (* Monomial ordering. *) (* ------------------------------------------------------------------------- *) let morder_lt = let rec lexorder l1 l2 = match (l1,l2) with [],[] -> false | (x1::o1,x2::o2) -> x1 > x2 || x1 = x2 && lexorder o1 o2 | _ -> failwith "morder: inconsistent monomial lengths" in fun m1 m2 -> let n1 = itlist (+) m1 0 and n2 = itlist (+) m2 0 in n1 < n2 || n1 = n2 && lexorder m1 m2;; let morder_le m1 m2 = morder_lt m1 m2 || (m1 = m2);; let morder_gt m1 m2 = morder_lt m2 m1;; (* ------------------------------------------------------------------------- *) (* Arithmetic on canonical polynomials. *) (* ------------------------------------------------------------------------- *) let grob_neg = map (fun (c,m) -> (minus_num c,m));; let rec grob_add l1 l2 = match (l1,l2) with ([],l2) -> l2 | (l1,[]) -> l1 | ((c1,m1)::o1,(c2,m2)::o2) -> if m1 = m2 then let c = c1+/c2 and rest = grob_add o1 o2 in if c =/ Int 0 then rest else (c,m1)::rest else if morder_lt m2 m1 then (c1,m1)::(grob_add o1 l2) else (c2,m2)::(grob_add l1 o2);; let grob_sub l1 l2 = grob_add l1 (grob_neg l2);; let grob_mmul (c1,m1) (c2,m2) = (c1*/c2,map2 (+) m1 m2);; let rec grob_cmul cm pol = map (grob_mmul cm) pol;; let rec grob_mul l1 l2 = match l1 with [] -> [] | (h1::t1) -> grob_add (grob_cmul h1 l2) (grob_mul t1 l2);; let rec grob_pow vars l n = if n < 0 then failwith "grob_pow: negative power" else if n = 0 then [Int 1,map (fun v -> 0) vars] else grob_mul l (grob_pow vars l (n - 1));; (* ------------------------------------------------------------------------- *) (* Monomial division operation. *) (* ------------------------------------------------------------------------- *) let mdiv (c1,m1) (c2,m2) = (c1//c2, map2 (fun n1 n2 -> if n1 < n2 then failwith "mdiv" else n1-n2) m1 m2);; (* ------------------------------------------------------------------------- *) (* Lowest common multiple of two monomials. *) (* ------------------------------------------------------------------------- *) let mlcm (c1,m1) (c2,m2) = (Int 1,map2 max m1 m2);; (* ------------------------------------------------------------------------- *) (* Reduce monomial cm by polynomial pol, returning replacement for cm. *) (* ------------------------------------------------------------------------- *) let reduce1 cm (pol,hpol) = match pol with [] -> failwith "reduce1" | cm1::cms -> try let (c,m) = mdiv cm cm1 in (grob_cmul (minus_num c,m) cms, Mmul((minus_num c,m),hpol)) with Failure _ -> failwith "reduce1";; (* ------------------------------------------------------------------------- *) (* Try this for all polynomials in a basis. *) (* ------------------------------------------------------------------------- *) let reduceb cm basis = tryfind (fun p -> reduce1 cm p) basis;; (* ------------------------------------------------------------------------- *) (* Reduction of a polynomial (always picking largest monomial possible). *) (* ------------------------------------------------------------------------- *) let rec reduce basis (pol,hist) = match pol with [] -> (pol,hist) | cm::ptl -> try let q,hnew = reduceb cm basis in reduce basis (grob_add q ptl,Add(hnew,hist)) with Failure _ -> let q,hist' = reduce basis (ptl,hist) in cm::q,hist';; (* ------------------------------------------------------------------------- *) (* Check for orthogonality w.r.t. LCM. *) (* ------------------------------------------------------------------------- *) let orthogonal l p1 p2 = snd l = snd(grob_mmul (hd p1) (hd p2));; (* ------------------------------------------------------------------------- *) (* Compute S-polynomial of two polynomials. *) (* ------------------------------------------------------------------------- *) let spoly cm ph1 ph2 = match (ph1,ph2) with ([],h),p -> ([],h) | p,([],h) -> ([],h) | (cm1::ptl1,his1),(cm2::ptl2,his2) -> (grob_sub (grob_cmul (mdiv cm cm1) ptl1) (grob_cmul (mdiv cm cm2) ptl2), Add(Mmul(mdiv cm cm1,his1), Mmul(mdiv (minus_num(fst cm),snd cm) cm2,his2)));; (* ------------------------------------------------------------------------- *) (* Make a polynomial monic. *) (* ------------------------------------------------------------------------- *) let monic (pol,hist) = if pol = [] then (pol,hist) else let c',m' = hd pol in (map (fun (c,m) -> (c//c',m)) pol, Mmul((Int 1 // c',map (K 0) m'),hist));; (* ------------------------------------------------------------------------- *) (* The most popular heuristic is to order critical pairs by LCM monomial. *) (* ------------------------------------------------------------------------- *) let forder ((c1,m1),_) ((c2,m2),_) = morder_lt m1 m2;; (* ------------------------------------------------------------------------- *) (* Stupid stuff forced on us by lack of equality test on num type. *) (* ------------------------------------------------------------------------- *) let rec poly_lt p q = match (p,q) with p,[] -> false | [],q -> true | (c1,m1)::o1,(c2,m2)::o2 -> c1 c1 =/ c2 && m1 = m2) p1 p2;; let memx ((p1,h1),(p2,h2)) ppairs = not (exists (fun ((q1,_),(q2,_)) -> poly_eq p1 q1 && poly_eq p2 q2) ppairs);; (* ------------------------------------------------------------------------- *) (* Buchberger's second criterion. *) (* ------------------------------------------------------------------------- *) let criterion2 basis (lcm,((p1,h1),(p2,h2))) opairs = exists (fun g -> not(poly_eq (fst g) p1) && not(poly_eq (fst g) p2) & can (mdiv lcm) (hd(fst g)) & not(memx (align(g,(p1,h1))) (map snd opairs)) & not(memx (align(g,(p2,h2))) (map snd opairs))) basis;; (* ------------------------------------------------------------------------- *) (* Test for hitting constant polynomial. *) (* ------------------------------------------------------------------------- *) let constant_poly p = length p = 1 && forall ((=) 0) (snd(hd p));; (* ------------------------------------------------------------------------- *) (* Grobner basis algorithm. *) (* ------------------------------------------------------------------------- *) let rec grobner histories basis pairs = print_string(string_of_int(length basis)^" basis elements and "^ string_of_int(length pairs)^" critical pairs"); print_newline(); match pairs with [] -> rev histories,basis | (l,(p1,p2))::opairs -> let (sp,hist) = monic (reduce basis (spoly l p1 p2)) in if sp = [] || criterion2 basis (l,(p1,p2)) opairs then grobner histories basis opairs else let sph = sp,Start(length histories) in if constant_poly sp then grobner ((sp,hist)::histories) (sph::basis) [] else let rawcps = map (fun p -> mlcm (hd(fst p)) (hd sp),align(p,sph)) basis in let newcps = filter (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) rawcps in grobner ((sp,hist)::histories) (sph::basis) (merge forder opairs (sort forder newcps));; (* ------------------------------------------------------------------------- *) (* Overall function. *) (* ------------------------------------------------------------------------- *) let groebner pols = let npols = map2 (fun p n -> p,Start n) pols (0--(length pols - 1)) in let phists = filter (fun (p,_) -> p <> []) npols in let bas0 = map monic phists in let bas = map2 (fun (p,h) n -> p,Start n) bas0 ((length bas0)--(2 * length bas0 - 1)) in let prs0 = allpairs (fun x y -> x,y) bas bas in let prs1 = filter (fun ((x,_),(y,_)) -> poly_lt x y) prs0 in let prs2 = map (fun (p,q) -> mlcm (hd(fst p)) (hd(fst q)),(p,q)) prs1 in let prs3 = filter (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) prs2 in grobner (rev bas0 @ rev phists) bas (mergesort forder prs3);; (* ------------------------------------------------------------------------- *) (* Alternative orthography. *) (* ------------------------------------------------------------------------- *) let gr'o'bner = groebner;; (* ------------------------------------------------------------------------- *) (* Conversion from HOL term. *) (* ------------------------------------------------------------------------- *) let grobify_term = let neg_tm = `(--):complex->complex` and add_tm = `(+):complex->complex->complex` and sub_tm = `(-):complex->complex->complex` and mul_tm = `(*):complex->complex->complex` and pow_tm = `(pow):complex->num->complex` in let rec grobify_term vars tm = try grob_var vars tm with Failure _ -> try grob_const vars tm with Failure _ -> let lop,r = dest_comb tm in if lop = neg_tm then grob_neg(grobify_term vars r) else let op,l = dest_comb lop in if op = pow_tm then grob_pow vars (grobify_term vars l) (dest_small_numeral r) else (if op = add_tm then grob_add else if op = sub_tm then grob_sub else if op = mul_tm then grob_mul else failwith "unknown term") (grobify_term vars l) (grobify_term vars r) in fun vars tm -> try grobify_term vars tm with Failure _ -> failwith "grobify_term";; let grobvars = let neg_tm = `(--):complex->complex` and add_tm = `(+):complex->complex->complex` and sub_tm = `(-):complex->complex->complex` and mul_tm = `(*):complex->complex->complex` and pow_tm = `(pow):complex->num->complex` in let rec grobvars tm acc = if is_complex_const tm then acc else if not (is_comb tm) then tm::acc else let lop,r = dest_comb tm in if lop = neg_tm then grobvars r acc else if not (is_comb lop) then tm::acc else let op,l = dest_comb lop in if op = pow_tm then grobvars l acc else if op = mul_tm || op = sub_tm || op = add_tm then grobvars l (grobvars r acc) else tm::acc in fun tm -> setify(grobvars tm []);; let grobify_equations = let zero_tm = `Cx(&0)` and sub_tm = `(-):complex->complex->complex` and complex_ty = `:complex` in let grobify_equation vars tm = let l,r = dest_eq tm in if r <> zero_tm then grobify_term vars (mk_comb(mk_comb(sub_tm,l),r)) else grobify_term vars l in fun tm -> let cjs = conjuncts tm in let rawvars = itlist (fun eq acc -> let l,r = dest_eq eq in union (union (grobvars l) (grobvars r)) acc) cjs [] in let vars = sort (fun x y -> x < y) rawvars in vars,map(grobify_equation vars) cjs;; (* ------------------------------------------------------------------------- *) (* Printer. *) (* ------------------------------------------------------------------------- *) let string_of_monomial vars (c,m) = let xns = filter (fun (x,y) -> y <> 0) (map2 (fun x y -> x,y) vars m) in let xnstrs = map (fun (x,n) -> x^(if n = 1 then "" else "^"^(string_of_int n))) xns in if xns = [] then Num.string_of_num c else let basstr = if c =/ Int 1 then "" else (Num.string_of_num c)^" * " in basstr ^ end_itlist (fun s t -> s^" * "^t) xnstrs;; let string_of_polynomial vars l = if l = [] then "0" else end_itlist (fun s t -> s^" + "^t) (map (string_of_monomial vars) l);; (* ------------------------------------------------------------------------- *) (* Resolve a proof. *) (* ------------------------------------------------------------------------- *) let rec resolve_proof vars prf = match prf with Start n -> [n,[Int 1,map (K 0) vars]] | Mmul(pol,lin) -> let lis = resolve_proof vars lin in map (fun (n,p) -> n,grob_cmul pol p) lis | Add(lin1,lin2) -> let lis1 = resolve_proof vars lin1 and lis2 = resolve_proof vars lin2 in let dom = setify(union (map fst lis1) (map fst lis2)) in map (fun n -> let a = try assoc n lis1 with Failure _ -> [] and b = try assoc n lis2 with Failure _ -> [] in n,grob_add a b) dom;; (* ------------------------------------------------------------------------- *) (* Convert a polynomial back to HOL. *) (* ------------------------------------------------------------------------- *) let holify_polynomial = let complex_ty = `:complex` and pow_tm = `(pow):complex->num->complex` and mk_mul = mk_binop `(*):complex->complex->complex` and mk_add = mk_binop `(+):complex->complex->complex` and zero_tm = `Cx(&0)` and add_tm = `(+):complex->complex->complex` and mul_tm = `(*):complex->complex->complex` and complex_term_of_rat = curry mk_comb `Cx` o term_of_rat in let holify_varpow (v,n) = if n = 1 then v else list_mk_comb(pow_tm,[v;mk_small_numeral n]) in let holify_monomial vars (c,m) = let xps = map holify_varpow (filter (fun (_,n) -> n <> 0) (zip vars m)) in end_itlist mk_mul (complex_term_of_rat c :: xps) in let holify_polynomial vars p = if p = [] then zero_tm else end_itlist mk_add (map (holify_monomial vars) p) in holify_polynomial;; (* ------------------------------------------------------------------------- *) (* Recursively find the set of basis elements involved. *) (* ------------------------------------------------------------------------- *) let dependencies = let rec dependencies prf acc = match prf with Start n -> n::acc | Mmul(pol,lin) -> dependencies lin acc | Add(lin1,lin2) -> dependencies lin1 (dependencies lin2 acc) in fun prf -> setify(dependencies prf []);; let rec involved deps sofar todo = match todo with [] -> sort (<) sofar | (h::hs) -> if mem h sofar then involved deps sofar hs else involved deps (h::sofar) (el h deps @ hs);; (* ------------------------------------------------------------------------- *) (* Refute a conjunction of equations in HOL. *) (* ------------------------------------------------------------------------- *) let GROBNER_REFUTE = let add_tm = `(+):complex->complex->complex` and mul_tm = `(*):complex->complex->complex` in let APPLY_pth = MATCH_MP(SIMPLE_COMPLEX_ARITH `(x = y) ==> (x + Cx(--(&1)) * (y + Cx(&1)) = Cx(&0)) ==> F`) and MK_ADD th1 th2 = MK_COMB(AP_TERM add_tm th1,th2) in let rec holify_lincombs vars cjs prfs = match prfs with [] -> cjs | (p::ps) -> if p = [] then holify_lincombs vars (cjs @ [TRUTH]) ps else let holis = map (fun (n,q) -> n,holify_polynomial vars q) p in let ths = map (fun (n,m) -> AP_TERM (mk_comb(mul_tm,m)) (el n cjs)) holis in let th = CONV_RULE(BINOP_CONV COMPLEX_POLY_CONV) (end_itlist MK_ADD ths) in holify_lincombs vars (cjs @ [th]) ps in fun tm -> let vars,pols = grobify_equations tm in let (prfs,gb) = groebner pols in let (_,prf) = find (fun (p,h) -> length p = 1 && forall ((=)0) (snd(hd p))) gb in let deps = map (dependencies o snd) prfs and depl = dependencies prf in let need = involved deps [] depl in let pprfs = map2 (fun p n -> if mem n need then resolve_proof vars (snd p) else []) prfs (0--(length prfs - 1)) and ppr = resolve_proof vars prf in let ths = CONJUNCTS(ASSUME tm) in let th = last (holify_lincombs vars ths (snd(chop_list(length ths) (pprfs @ [ppr])))) in CONV_RULE COMPLEX_RAT_EQ_CONV th;; (* ------------------------------------------------------------------------- *) (* Overall conversion. *) (* ------------------------------------------------------------------------- *) let COMPLEX_ARITH = let pth0 = SIMPLE_COMPLEX_ARITH `(x = y) <=> (x - y = Cx(&0))` and pth1 = prove (`!x. ~(x = Cx(&0)) <=> ?z. z * x + Cx(&1) = Cx(&0)`, CONV_TAC(time FULL_COMPLEX_QUELIM_CONV)) and pth2a = prove (`!x y u v. ~(x = y) \/ ~(u = v) <=> ?w z. w * (x - y) + z * (u - v) + Cx(&1) = Cx(&0)`, CONV_TAC(time FULL_COMPLEX_QUELIM_CONV)) and pth2b = prove (`!x y. ~(x = y) <=> ?z. z * (x - y) + Cx(&1) = Cx(&0)`, CONV_TAC(time FULL_COMPLEX_QUELIM_CONV)) and pth3 = TAUT `(p ==> F) ==> (~q <=> p) ==> q` in let GEN_PRENEX_CONV = GEN_REWRITE_CONV REDEPTH_CONV [AND_FORALL_THM; LEFT_AND_FORALL_THM; RIGHT_AND_FORALL_THM; LEFT_OR_FORALL_THM; RIGHT_OR_FORALL_THM; OR_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] in let INITIAL_CONV = NNF_CONV THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth1] THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth2a] THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth2b] THENC ONCE_DEPTH_CONV(GEN_REWRITE_CONV I [pth0] o check ((<>) `Cx(&0)` o rand)) THENC GEN_PRENEX_CONV THENC DNF_CONV in fun tm -> let avs = frees tm in let tm' = list_mk_forall(avs,tm) in let th1 = INITIAL_CONV(mk_neg tm') in let evs,bod = strip_exists(rand(concl th1)) in if is_forall bod then failwith "COMPLEX_ARITH: non-universal formula" else let djs = disjuncts bod in let th2 = end_itlist SIMPLE_DISJ_CASES(map GROBNER_REFUTE djs) in let th3 = itlist SIMPLE_CHOOSE evs th2 in SPECL avs (MATCH_MP (MATCH_MP pth3 (DISCH_ALL th3)) th1);; hol-light/Complex/complex_real.ml000066400000000000000000000007361303454263000173660ustar00rootroot00000000000000(* ========================================================================= *) (* Trivial restriction of complex Groebner bases to reals. *) (* ========================================================================= *) let GROBNER_REAL_ARITH = let trans_conv = GEN_REWRITE_CONV TOP_SWEEP_CONV [GSYM CX_INJ; CX_POW; CX_MUL; CX_ADD; CX_NEG; CX_SUB] in fun tm -> let th = trans_conv tm in EQ_MP (SYM th) (COMPLEX_ARITH(rand(concl th)));; hol-light/Complex/complex_transc.ml000066400000000000000000000323621303454263000177350ustar00rootroot00000000000000(* ========================================================================= *) (* Complex transcendental functions. *) (* ========================================================================= *) needs "Library/transc.ml";; needs "Library/floor.ml";; needs "Complex/complexnumbers.ml";; unparse_as_infix "exp";; remove_interface "exp";; (* ------------------------------------------------------------------------- *) (* Complex square roots. *) (* ------------------------------------------------------------------------- *) let csqrt = new_definition `csqrt(z) = if Im(z) = &0 then if &0 <= Re(z) then complex(sqrt(Re(z)),&0) else complex(&0,sqrt(--Re(z))) else complex(sqrt((norm(z) + Re(z)) / &2), (Im(z) / abs(Im(z))) * sqrt((norm(z) - Re(z)) / &2))`;; let COMPLEX_NORM_GE_RE_IM = prove (`!z. abs(Re(z)) <= norm(z) /\ abs(Im(z)) <= norm(z)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN REWRITE_TAC[complex_norm] THEN CONJ_TAC THEN MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_ADDL; REAL_POW_2; REAL_LE_SQUARE]);; let CSQRT = prove (`!z. csqrt(z) pow 2 = z`, GEN_TAC THEN REWRITE_TAC[COMPLEX_POW_2; csqrt] THEN COND_CASES_TAC THENL [COND_CASES_TAC THEN ASM_REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_ADD_LID; COMPLEX_EQ] THEN REWRITE_TAC[REAL_NEG_EQ; GSYM REAL_POW_2] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`]; ALL_TAC] THEN REWRITE_TAC[complex_mul; RE; IM] THEN ONCE_REWRITE_TAC[REAL_ARITH `(s * s - (i * s') * (i * s') = s * s - (i * i) * (s' * s')) /\ (s * i * s' + (i * s')* s = &2 * i * s * s')`] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN SUBGOAL_THEN `&0 <= norm(z) + Re(z) /\ &0 <= norm(z) - Re(z)` STRIP_ASSUME_TAC THENL [MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; GSYM SQRT_MUL; SQRT_POW_2] THEN REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW2_ABS; REAL_POW_EQ_0; REAL_DIV_REFL] THEN REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_ARITH `(m + r) - (m - r) = r * &2`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * a' * b = (a * a') * (b * b:real)`] THEN REWRITE_TAC[REAL_DIFFSQ] THEN REWRITE_TAC[complex_norm; GSYM REAL_POW_2] THEN SIMP_TAC[SQRT_POW_2; REAL_LE_ADD; REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE] THEN REWRITE_TAC[REAL_ADD_SUB; GSYM REAL_POW_MUL] THEN REWRITE_TAC[POW_2_SQRT_ABS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `&2 * (i * a') * a * h = i * (&2 * h) * a * a'`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID; GSYM real_div] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_ABS_ZERO; REAL_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Complex exponential. *) (* ------------------------------------------------------------------------- *) let cexp = new_definition `cexp z = Cx(exp(Re z)) * complex(cos(Im z),sin(Im z))`;; let CX_CEXP = prove (`!x. Cx(exp x) = cexp(Cx x)`, REWRITE_TAC[cexp; CX_DEF; RE; IM; SIN_0; COS_0] THEN REWRITE_TAC[GSYM CX_DEF; GSYM CX_MUL; REAL_MUL_RID]);; let CEXP_0 = prove (`cexp(Cx(&0)) = Cx(&1)`, REWRITE_TAC[GSYM CX_CEXP; REAL_EXP_0]);; let CEXP_ADD = prove (`!w z. cexp(w + z) = cexp(w) * cexp(z)`, REWRITE_TAC[COMPLEX_EQ; cexp; complex_mul; complex_add; RE; IM; CX_DEF] THEN REWRITE_TAC[REAL_EXP_ADD; SIN_ADD; COS_ADD] THEN CONV_TAC REAL_RING);; let CEXP_MUL = prove (`!n z. cexp(Cx(&n) * z) = cexp(z) pow n`, INDUCT_TAC THEN REWRITE_TAC[complex_pow] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; CEXP_0] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; COMPLEX_ADD_RDISTRIB; CX_ADD] THEN ASM_REWRITE_TAC[CEXP_ADD; COMPLEX_MUL_LID] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; let CEXP_NONZERO = prove (`!z. ~(cexp z = Cx(&0))`, GEN_TAC THEN REWRITE_TAC[cexp; COMPLEX_ENTIRE; CX_INJ; REAL_EXP_NZ] THEN REWRITE_TAC[CX_DEF; RE; IM; COMPLEX_EQ] THEN MP_TAC(SPEC `Im z` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; let CEXP_NEG_LMUL = prove (`!z. cexp(--z) * cexp(z) = Cx(&1)`, REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_ADD_LINV; CEXP_0]);; let CEXP_NEG_RMUL = prove (`!z. cexp(z) * cexp(--z) = Cx(&1)`, REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_ADD_RINV; CEXP_0]);; let CEXP_NEG = prove (`!z. cexp(--z) = inv(cexp z)`, MESON_TAC[CEXP_NEG_LMUL; COMPLEX_MUL_LINV_UNIQ]);; let CEXP_SUB = prove (`!w z. cexp(w - z) = cexp(w) / cexp(z)`, REWRITE_TAC[complex_sub; complex_div; CEXP_NEG; CEXP_ADD]);; (* ------------------------------------------------------------------------- *) (* Complex trig functions. *) (* ------------------------------------------------------------------------- *) let ccos = new_definition `ccos z = (cexp(ii * z) + cexp(--ii * z)) / Cx(&2)`;; let csin = new_definition `csin z = (cexp(ii * z) - cexp(--ii * z)) / (Cx(&2) * ii)`;; let CX_CSIN,CX_CCOS = (CONJ_PAIR o prove) (`(!x. Cx(sin x) = csin(Cx x)) /\ (!x. Cx(cos x) = ccos(Cx x))`, REWRITE_TAC[csin; ccos; cexp; CX_DEF; ii; RE; IM; complex_mul; complex_add; REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_MUL_LID; complex_neg; REAL_EXP_0; REAL_ADD_LID; REAL_MUL_LNEG; REAL_NEG_0; REAL_ADD_RID; complex_sub; SIN_NEG; COS_NEG; GSYM REAL_MUL_2; GSYM real_sub; complex_div; REAL_SUB_REFL; complex_inv; REAL_SUB_RNEG] THEN CONJ_TAC THEN GEN_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RZERO] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC REAL_RING);; let CSIN_0 = prove (`csin(Cx(&0)) = Cx(&0)`, REWRITE_TAC[GSYM CX_CSIN; SIN_0]);; let CCOS_0 = prove (`ccos(Cx(&0)) = Cx(&1)`, REWRITE_TAC[GSYM CX_CCOS; COS_0]);; let CSIN_CIRCLE = prove (`!z. csin(z) pow 2 + ccos(z) pow 2 = Cx(&1)`, GEN_TAC THEN REWRITE_TAC[csin; ccos] THEN MP_TAC(SPEC `ii * z` CEXP_NEG_LMUL) THEN MP_TAC COMPLEX_POW_II_2 THEN REWRITE_TAC[COMPLEX_MUL_LNEG] THEN CONV_TAC COMPLEX_FIELD);; let CSIN_ADD = prove (`!w z. csin(w + z) = csin(w) * ccos(z) + ccos(w) * csin(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);; let CCOS_ADD = prove (`!w z. ccos(w + z) = ccos(w) * ccos(z) - csin(w) * csin(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);; let CSIN_NEG = prove (`!z. csin(--z) = --(csin(z))`, REWRITE_TAC[csin; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN GEN_TAC THEN MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);; let CCOS_NEG = prove (`!z. ccos(--z) = ccos(z)`, REWRITE_TAC[ccos; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN GEN_TAC THEN MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);; let CSIN_DOUBLE = prove (`!z. csin(Cx(&2) * z) = Cx(&2) * csin(z) * ccos(z)`, REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CSIN_ADD] THEN CONV_TAC COMPLEX_RING);; let CCOS_DOUBLE = prove (`!z. ccos(Cx(&2) * z) = (ccos(z) pow 2) - (csin(z) pow 2)`, REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* Euler and de Moivre formulas. *) (* ------------------------------------------------------------------------- *) let CEXP_EULER = prove (`!z. cexp(ii * z) = ccos(z) + ii * csin(z)`, REWRITE_TAC[ccos; csin] THEN MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);; let DEMOIVRE = prove (`!z n. (ccos z + ii * csin z) pow n = ccos(Cx(&n) * z) + ii * csin(Cx(&n) * z)`, REWRITE_TAC[GSYM CEXP_EULER; GSYM CEXP_MUL] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* Some lemmas. *) (* ------------------------------------------------------------------------- *) let EXISTS_COMPLEX = prove (`!P. (?z. P (Re z) (Im z)) <=> ?x y. P x y`, MESON_TAC[RE; IM; COMPLEX]);; let COMPLEX_UNIMODULAR_POLAR = prove (`!z. (norm z = &1) ==> ?x. z = complex(cos(x),sin(x))`, GEN_TAC THEN DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow):real->num->real`) THEN REWRITE_TAC[complex_norm] THEN SIMP_TAC[REAL_POW_2; REWRITE_RULE[REAL_POW_2] SQRT_POW_2; REAL_LE_SQUARE; REAL_LE_ADD] THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_MUL_LID] THEN DISCH_THEN(X_CHOOSE_TAC `t:real` o MATCH_MP CIRCLE_SINCOS) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM]);; let SIN_INTEGER_2PI = prove (`!n. integer n ==> sin((&2 * pi) * n) = &0`, REWRITE_TAC[integer; REAL_ARITH `abs(x) = &n <=> x = &n \/ x = -- &n`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; SIN_NEG] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; SIN_DOUBLE] THEN REWRITE_TAC[REAL_ARITH `pi * &n = &n * pi`; SIN_NPI] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_NEG_0]);; let COS_INTEGER_2PI = prove (`!n. integer n ==> cos((&2 * pi) * n) = &1`, REWRITE_TAC[integer; REAL_ARITH `abs(x) = &n <=> x = &n \/ x = -- &n`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; COS_NEG] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; COS_DOUBLE] THEN REWRITE_TAC[REAL_ARITH `pi * &n = &n * pi`; SIN_NPI; COS_NPI] THEN REWRITE_TAC[REAL_POW_POW] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM REAL_POW_POW; REAL_POW_2] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE; REAL_SUB_RZERO]);; let SINCOS_PRINCIPAL_VALUE = prove (`!x. ?y. (--pi < y /\ y <= pi) /\ (sin(y) = sin(x) /\ cos(y) = cos(x))`, GEN_TAC THEN EXISTS_TAC `pi - (&2 * pi) * frac((pi - x) / (&2 * pi))` THEN CONJ_TAC THENL [SIMP_TAC[REAL_ARITH `--p < p - x <=> x < (&2 * p) * &1`; REAL_ARITH `p - x <= p <=> (&2 * p) * &0 <= x`; REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_LT_MUL; PI_POS; REAL_OF_NUM_LT; ARITH; FLOOR_FRAC]; REWRITE_TAC[FRAC_FLOOR; REAL_SUB_LDISTRIB] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH; REAL_LT_IMP_NZ; PI_POS; REAL_ARITH `a - (a - b - c):real = b + c`; SIN_ADD; COS_ADD] THEN SIMP_TAC[FLOOR_FRAC; SIN_INTEGER_2PI; COS_INTEGER_2PI] THEN CONV_TAC REAL_RING]);; (* ------------------------------------------------------------------------- *) (* Complex logarithms (the conventional principal value). *) (* ------------------------------------------------------------------------- *) let clog = new_definition `clog z = @w. cexp(w) = z /\ --pi < Im(w) /\ Im(w) <= pi`;; let CLOG_WORKS = prove (`!z. ~(z = Cx(&0)) ==> cexp(clog z) = z /\ --pi < Im(clog z) /\ Im(clog z) <= pi`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[clog] THEN CONV_TAC SELECT_CONV THEN REWRITE_TAC[cexp; EXISTS_COMPLEX] THEN EXISTS_TAC `ln(norm(z:complex))` THEN SUBGOAL_THEN `exp(ln(norm(z:complex))) = norm(z)` SUBST1_TAC THENL [ASM_MESON_TAC[REAL_EXP_LN; COMPLEX_NORM_NZ]; ALL_TAC] THEN MP_TAC(SPEC `z / Cx(norm z)` COMPLEX_UNIMODULAR_POLAR) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[COMPLEX_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `x:real` SINCOS_PRINCIPAL_VALUE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CX_INJ; COMPLEX_DIV_LMUL; COMPLEX_NORM_ZERO]);; let CEXP_CLOG = prove (`!z. ~(z = Cx(&0)) ==> cexp(clog z) = z`, SIMP_TAC[CLOG_WORKS]);; (* ------------------------------------------------------------------------- *) (* Unwinding number. *) (* ------------------------------------------------------------------------- *) let unwinding = new_definition `unwinding(z) = (z - clog(cexp z)) / (Cx(&2 * pi) * ii)`;; let COMPLEX_II_NZ = prove (`~(ii = Cx(&0))`, MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_RING);; let UNWINDING_2PI = prove (`Cx(&2 * pi) * ii * unwinding(z) = z - clog(cexp z)`, REWRITE_TAC[unwinding; COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC COMPLEX_DIV_LMUL THEN REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; COMPLEX_II_NZ] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* An example of how to get nice identities with unwinding number. *) (* ------------------------------------------------------------------------- *) let CLOG_MUL = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> clog(w * z) = clog(w) + clog(z) - Cx(&2 * pi) * ii * unwinding(clog w + clog z)`, REWRITE_TAC[UNWINDING_2PI; COMPLEX_RING `w + z - ((w + z) - c) = c:complex`] THEN ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG]);; hol-light/Complex/complexnumbers.ml000066400000000000000000000765011303454263000177620ustar00rootroot00000000000000(* ========================================================================= *) (* Basic definitions and properties of complex numbers. *) (* ========================================================================= *) needs "Library/transc.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Definition of complex number type. *) (* ------------------------------------------------------------------------- *) let complex_tybij_raw = new_type_definition "complex" ("complex","coords") (prove(`?x:real#real. T`,REWRITE_TAC[]));; let complex_tybij = REWRITE_RULE [] complex_tybij_raw;; (* ------------------------------------------------------------------------- *) (* Real and imaginary parts of a number. *) (* ------------------------------------------------------------------------- *) let RE_DEF = new_definition `Re(z) = FST(coords(z))`;; let IM_DEF = new_definition `Im(z) = SND(coords(z))`;; (* ------------------------------------------------------------------------- *) (* Set up overloading. *) (* ------------------------------------------------------------------------- *) do_list overload_interface ["+",`complex_add:complex->complex->complex`; "-",`complex_sub:complex->complex->complex`; "*",`complex_mul:complex->complex->complex`; "/",`complex_div:complex->complex->complex`; "--",`complex_neg:complex->complex`; "pow",`complex_pow:complex->num->complex`; "inv",`complex_inv:complex->complex`];; let prioritize_complex() = prioritize_overload(mk_type("complex",[]));; (* ------------------------------------------------------------------------- *) (* Complex absolute value (modulus). *) (* ------------------------------------------------------------------------- *) make_overloadable "norm" `:A->real`;; overload_interface("norm",`complex_norm:complex->real`);; let complex_norm = new_definition `norm(z) = sqrt(Re(z) pow 2 + Im(z) pow 2)`;; (* ------------------------------------------------------------------------- *) (* Imaginary unit (too inconvenient to use "i"!) *) (* ------------------------------------------------------------------------- *) let ii = new_definition `ii = complex(&0,&1)`;; (* ------------------------------------------------------------------------- *) (* Injection from reals. *) (* ------------------------------------------------------------------------- *) let CX_DEF = new_definition `Cx(a) = complex(a,&0)`;; (* ------------------------------------------------------------------------- *) (* Arithmetic operations. *) (* ------------------------------------------------------------------------- *) let complex_neg = new_definition `--z = complex(--(Re(z)),--(Im(z)))`;; let complex_add = new_definition `w + z = complex(Re(w) + Re(z),Im(w) + Im(z))`;; let complex_sub = new_definition `w - z = w + --z`;; let complex_mul = new_definition `w * z = complex(Re(w) * Re(z) - Im(w) * Im(z), Re(w) * Im(z) + Im(w) * Re(z))`;; let complex_inv = new_definition `inv(z) = complex(Re(z) / (Re(z) pow 2 + Im(z) pow 2), --(Im(z)) / (Re(z) pow 2 + Im(z) pow 2))`;; let complex_div = new_definition `w / z = w * inv(z)`;; let complex_pow = new_recursive_definition num_RECURSION `(x pow 0 = Cx(&1)) /\ (!n. x pow (SUC n) = x * x pow n)`;; (* ------------------------------------------------------------------------- *) (* Various handy rewrites. *) (* ------------------------------------------------------------------------- *) let RE = prove (`(Re(complex(x,y)) = x)`, REWRITE_TAC[RE_DEF; complex_tybij]);; let IM = prove (`Im(complex(x,y)) = y`, REWRITE_TAC[IM_DEF; complex_tybij]);; let COMPLEX = prove (`complex(Re(z),Im(z)) = z`, REWRITE_TAC[IM_DEF; RE_DEF; complex_tybij]);; let COMPLEX_EQ = prove (`!w z. (w = z) <=> (Re(w) = Re(z)) /\ (Im(w) = Im(z))`, REWRITE_TAC[RE_DEF; IM_DEF; GSYM PAIR_EQ] THEN MESON_TAC[complex_tybij]);; (* ------------------------------------------------------------------------- *) (* Crude tactic to automate very simple algebraic equivalences. *) (* ------------------------------------------------------------------------- *) let SIMPLE_COMPLEX_ARITH_TAC = REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF; complex_add; complex_neg; complex_sub; complex_mul] THEN REAL_ARITH_TAC;; let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Basic algebraic properties that can be proved automatically by this. *) (* ------------------------------------------------------------------------- *) let COMPLEX_ADD_SYM = prove (`!x y. x + y = y + x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_ASSOC = prove (`!x y z. x + y + z = (x + y) + z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_LID = prove (`!x. Cx(&0) + x = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_LINV = prove (`!x. --x + x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_SYM = prove (`!x y. x * y = y * x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_ASSOC = prove (`!x y z. x * y * z = (x * y) * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_LID = prove (`!x. Cx(&1) * x = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_LDISTRIB = prove (`!x y z. x * (y + z) = x * y + x * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_AC = prove (`(m + n = n + m) /\ ((m + n) + p = m + n + p) /\ (m + n + p = n + m + p)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_AC = prove (`(m * n = n * m) /\ ((m * n) * p = m * n * p) /\ (m * n * p = n * m * p)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_RID = prove (`!x. x + Cx(&0) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_RID = prove (`!x. x * Cx(&1) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_RINV = prove (`!x. x + --x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_RDISTRIB = prove (`!x y z. (x + y) * z = x * z + y * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_LCANCEL = prove (`!x y z. (x + y = x + z) <=> (y = z)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_RCANCEL = prove (`!x y z. (x + z = y + z) <=> (x = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_RZERO = prove (`!x. x * Cx(&0) = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_LZERO = prove (`!x. Cx(&0) * x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_NEG = prove (`!x. --(--x) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_RNEG = prove (`!x y. x * --y = --(x * y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_LNEG = prove (`!x y. --x * y = --(x * y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_ADD = prove (`!x y. --(x + y) = --x + --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_0 = prove (`--Cx(&0) = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_LCANCEL_0 = prove (`!x y. (x + y = x) <=> (y = Cx(&0))`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_RCANCEL_0 = prove (`!x y. (x + y = y) <=> (x = Cx(&0))`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_LNEG_UNIQ = prove (`!x y. (x + y = Cx(&0)) <=> (x = --y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_RNEG_UNIQ = prove (`!x y. (x + y = Cx(&0)) <=> (y = --x)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_LMUL = prove (`!x y. --(x * y) = --x * y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_RMUL = prove (`!x y. --(x * y) = x * --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_MUL2 = prove (`!x y. --x * --y = x * y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_ADD = prove (`!x y. x - y + y = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_ADD2 = prove (`!x y. y + x - y = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_REFL = prove (`!x. x - x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_0 = prove (`!x y. (x - y = Cx(&0)) <=> (x = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_EQ_0 = prove (`!x. (--x = Cx(&0)) <=> (x = Cx(&0))`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_SUB = prove (`!x y. --(x - y) = y - x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_SUB = prove (`!x y. (x + y) - x = y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_EQ = prove (`!x y. (--x = y) <=> (x = --y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_MINUS1 = prove (`!x. --x = --Cx(&1) * x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_SUB = prove (`!x y. x - y - x = --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD2_SUB2 = prove (`!a b c d. (a + b) - (c + d) = a - c + b - d`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_LZERO = prove (`!x. Cx(&0) - x = --x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_RZERO = prove (`!x. x - Cx(&0) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_LNEG = prove (`!x y. --x - y = --(x + y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_RNEG = prove (`!x y. x - --y = x + y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_NEG2 = prove (`!x y. --x - --y = y - x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_TRIANGLE = prove (`!a b c. a - b + b - c = a - c`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_SUB_LADD = prove (`!x y z. (x = y - z) <=> (x + z = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_SUB_RADD = prove (`!x y z. (x - y = z) <=> (x = z + y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_SUB2 = prove (`!x y. x - (x - y) = y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_SUB2 = prove (`!x y. x - (x + y) = --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_DIFFSQ = prove (`!x y. (x + y) * (x - y) = x * x - y * y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_NEG2 = prove (`!x y. (--x = --y) <=> (x = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_LDISTRIB = prove (`!x y z. x * (y - z) = x * y - x * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_RDISTRIB = prove (`!x y z. (x - y) * z = x * z - y * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_2 = prove (`!x. &2 * x = x + x`, SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Homomorphic embedding properties for Cx mapping. *) (* ------------------------------------------------------------------------- *) let CX_INJ = prove (`!x y. (Cx(x) = Cx(y)) <=> (x = y)`, REWRITE_TAC[CX_DEF; COMPLEX_EQ; RE; IM]);; let CX_NEG = prove (`!x. Cx(--x) = --(Cx(x))`, REWRITE_TAC[CX_DEF; complex_neg; RE; IM; REAL_NEG_0]);; let CX_INV = prove (`!x. Cx(inv x) = inv(Cx x)`, GEN_TAC THEN REWRITE_TAC[CX_DEF; complex_inv; RE; IM] THEN REWRITE_TAC[real_div; REAL_NEG_0; REAL_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_EQ; REAL_POW_2; REAL_MUL_RZERO; RE; IM] THEN REWRITE_TAC[REAL_ADD_RID; REAL_INV_MUL] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[REAL_MUL_RINV]);; let CX_ADD = prove (`!x y. Cx(x + y) = Cx(x) + Cx(y)`, REWRITE_TAC[CX_DEF; complex_add; RE; IM; REAL_ADD_LID]);; let CX_SUB = prove (`!x y. Cx(x - y) = Cx(x) - Cx(y)`, REWRITE_TAC[complex_sub; real_sub; CX_ADD; CX_NEG]);; let CX_MUL = prove (`!x y. Cx(x * y) = Cx(x) * Cx(y)`, REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_ADD_RID]);; let CX_DIV = prove (`!x y. Cx(x / y) = Cx(x) / Cx(y)`, REWRITE_TAC[complex_div; real_div; CX_MUL; CX_INV]);; let CX_POW = prove (`!x n. Cx(x pow n) = Cx(x) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; real_pow; CX_MUL]);; let CX_ABS = prove (`!x. Cx(abs x) = Cx(norm(Cx(x)))`, REWRITE_TAC[CX_DEF; complex_norm; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);; let COMPLEX_NORM_CX = prove (`!x. norm(Cx(x)) = abs(x)`, REWRITE_TAC[GSYM CX_INJ; CX_ABS]);; (* ------------------------------------------------------------------------- *) (* A convenient lemma that we need a few times below. *) (* ------------------------------------------------------------------------- *) let COMPLEX_ENTIRE = prove (`!x y. (x * y = Cx(&0)) <=> (x = Cx(&0)) \/ (y = Cx(&0))`, REWRITE_TAC[COMPLEX_EQ; complex_mul; RE; IM; CX_DEF; GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Powers. *) (* ------------------------------------------------------------------------- *) let COMPLEX_POW_ADD = prove (`!x m n. x pow (m + n) = x pow m * x pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_ASSOC]);; let COMPLEX_POW_POW = prove (`!x m n. (x pow m) pow n = x pow (m * n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; MULT_CLAUSES; COMPLEX_POW_ADD]);; let COMPLEX_POW_1 = prove (`!x. x pow 1 = x`, REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID]);; let COMPLEX_POW_2 = prove (`!x. x pow 2 = x * x`, REWRITE_TAC[num_CONV `2`] THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1]);; let COMPLEX_POW_NEG = prove (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; EVEN] THEN ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG]);; let COMPLEX_POW_ONE = prove (`!n. Cx(&1) pow n = Cx(&1)`, INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID]);; let COMPLEX_POW_MUL = prove (`!x y n. (x * y) pow n = (x pow n) * (y pow n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_AC]);; let COMPLEX_POW_II_2 = prove (`ii pow 2 = --Cx(&1)`, REWRITE_TAC[ii; COMPLEX_POW_2; complex_mul; CX_DEF; RE; IM; complex_neg] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let COMPLEX_POW_EQ_0 = prove (`!x n. (x pow n = Cx(&0)) <=> (x = Cx(&0)) /\ ~(n = 0)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC; complex_pow; COMPLEX_ENTIRE] THENL [SIMPLE_COMPLEX_ARITH_TAC; CONV_TAC TAUT]);; (* ------------------------------------------------------------------------- *) (* Norms (aka "moduli"). *) (* ------------------------------------------------------------------------- *) let COMPLEX_NORM_CX = prove (`!x. norm(Cx x) = abs(x)`, GEN_TAC THEN REWRITE_TAC[complex_norm; CX_DEF; RE; IM] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);; let COMPLEX_NORM_POS = prove (`!z. &0 <= norm(z)`, SIMP_TAC[complex_norm; SQRT_POS_LE; REAL_POW_2; REAL_LE_SQUARE; REAL_LE_ADD]);; let COMPLEX_ABS_NORM = prove (`!z. abs(norm z) = norm z`, REWRITE_TAC[real_abs; COMPLEX_NORM_POS]);; let COMPLEX_NORM_ZERO = prove (`!z. (norm z = &0) <=> (z = Cx(&0))`, GEN_TAC THEN REWRITE_TAC[complex_norm] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_0] THEN SIMP_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LE_ADD; REAL_POS; SQRT_INJ] THEN REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF] THEN SIMP_TAC[REAL_LE_SQUARE; REAL_ARITH `&0 <= x /\ &0 <= y ==> ((x + y = &0) <=> (x = &0) /\ (y = &0))`] THEN REWRITE_TAC[REAL_ENTIRE]);; let COMPLEX_NORM_NUM = prove (`norm(Cx(&n)) = &n`, REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]);; let COMPLEX_NORM_0 = prove (`norm(Cx(&0)) = &0`, MESON_TAC[COMPLEX_NORM_ZERO]);; let COMPLEX_NORM_NZ = prove (`!z. &0 < norm(z) <=> ~(z = Cx(&0))`, MESON_TAC[COMPLEX_NORM_ZERO; COMPLEX_ABS_NORM; REAL_ABS_NZ]);; let COMPLEX_NORM_NEG = prove (`!z. norm(--z) = norm(z)`, REWRITE_TAC[complex_neg; complex_norm; REAL_POW_2; RE; IM] THEN GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let COMPLEX_NORM_MUL = prove (`!w z. norm(w * z) = norm(w) * norm(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm; complex_mul; RE; IM] THEN SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let COMPLEX_NORM_POW = prove (`!z n. norm(z pow n) = norm(z) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; real_pow; COMPLEX_NORM_NUM; COMPLEX_NORM_MUL]);; let COMPLEX_NORM_INV = prove (`!z. norm(inv z) = inv(norm z)`, GEN_TAC THEN REWRITE_TAC[complex_norm; complex_inv; RE; IM] THEN REWRITE_TAC[REAL_POW_2; real_div] THEN REWRITE_TAC[REAL_ARITH `(r * d) * r * d + (--i * d) * --i * d = (r * r + i * i) * d * d:real`] THEN ASM_CASES_TAC `Re z * Re z + Im z * Im z = &0` THENL [ASM_REWRITE_TAC[REAL_INV_0; SQRT_0; REAL_MUL_LZERO]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN SIMP_TAC[GSYM SQRT_MUL; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LE_ADD; REAL_LE_SQUARE] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * a * b * b:real = (a * b) * (a * b)`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; SQRT_1]);; let COMPLEX_NORM_DIV = prove (`!w z. norm(w / z) = norm(w) / norm(z)`, REWRITE_TAC[complex_div; real_div; COMPLEX_NORM_INV; COMPLEX_NORM_MUL]);; let COMPLEX_NORM_TRIANGLE = prove (`!w z. norm(w + z) <= norm(w) + norm(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm; complex_add; RE; IM] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs(x) <= abs(y) ==> x <= y`) THEN SIMP_TAC[SQRT_POS_LE; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; REAL_LE_SQUARE_ABS; SQRT_POW_2] THEN GEN_REWRITE_TAC RAND_CONV[REAL_ARITH `(a + b) * (a + b) = a * a + b * b + &2 * a * b`] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN SIMP_TAC[SQRT_POW_2; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN REWRITE_TAC[REAL_ARITH `(rw + rz) * (rw + rz) + (iw + iz) * (iw + iz) <= (rw * rw + iw * iw) + (rz * rz + iz * iz) + &2 * other <=> rw * rz + iw * iz <= other`] THEN SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs(x) <= abs(y) ==> x <= y`) THEN SIMP_TAC[SQRT_POS_LE; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; REAL_LE_SQUARE_ABS; SQRT_POW_2; REAL_LE_MUL] THEN REWRITE_TAC[REAL_ARITH `(rw * rz + iw * iz) * (rw * rz + iw * iz) <= (rw * rw + iw * iw) * (rz * rz + iz * iz) <=> &0 <= (rw * iz - rz * iw) * (rw * iz - rz * iw)`] THEN REWRITE_TAC[REAL_LE_SQUARE]);; let COMPLEX_NORM_TRIANGLE_SUB = prove (`!w z. norm(w) <= norm(w + z) + norm(z)`, MESON_TAC[COMPLEX_NORM_TRIANGLE; COMPLEX_NORM_NEG; COMPLEX_ADD_ASSOC; COMPLEX_ADD_RINV; COMPLEX_ADD_RID]);; let COMPLEX_NORM_ABS_NORM = prove (`!w z. abs(norm w - norm z) <= norm(w - z)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a - b <= x /\ b - a <= x ==> abs(a - b) <= x:real`) THEN MESON_TAC[COMPLEX_NEG_SUB; COMPLEX_NORM_NEG; REAL_LE_SUB_RADD; complex_sub; COMPLEX_NORM_TRIANGLE_SUB]);; (* ------------------------------------------------------------------------- *) (* Complex conjugate. *) (* ------------------------------------------------------------------------- *) let cnj = new_definition `cnj(z) = complex(Re(z),--(Im(z)))`;; (* ------------------------------------------------------------------------- *) (* Conjugation is an automorphism. *) (* ------------------------------------------------------------------------- *) let CNJ_INJ = prove (`!w z. (cnj(w) = cnj(z)) <=> (w = z)`, REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_EQ_NEG2]);; let CNJ_CNJ = prove (`!z. cnj(cnj z) = z`, REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_NEG_NEG]);; let CNJ_CX = prove (`!x. cnj(Cx x) = Cx x`, REWRITE_TAC[cnj; COMPLEX_EQ; CX_DEF; REAL_NEG_0; RE; IM]);; let COMPLEX_NORM_CNJ = prove (`!z. norm(cnj z) = norm(z)`, REWRITE_TAC[complex_norm; cnj; REAL_POW_2] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; RE; IM; REAL_NEG_NEG]);; let CNJ_NEG = prove (`!z. cnj(--z) = --(cnj z)`, REWRITE_TAC[cnj; complex_neg; COMPLEX_EQ; RE; IM]);; let CNJ_INV = prove (`!z. cnj(inv z) = inv(cnj z)`, REWRITE_TAC[cnj; complex_inv; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[real_div; REAL_NEG_NEG; REAL_POW_2; REAL_MUL_LNEG; REAL_MUL_RNEG]);; let CNJ_ADD = prove (`!w z. cnj(w + z) = cnj(w) + cnj(z)`, REWRITE_TAC[cnj; complex_add; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let CNJ_SUB = prove (`!w z. cnj(w - z) = cnj(w) - cnj(z)`, REWRITE_TAC[complex_sub; CNJ_ADD; CNJ_NEG]);; let CNJ_MUL = prove (`!w z. cnj(w * z) = cnj(w) * cnj(z)`, REWRITE_TAC[cnj; complex_mul; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let CNJ_DIV = prove (`!w z. cnj(w / z) = cnj(w) / cnj(z)`, REWRITE_TAC[complex_div; CNJ_MUL; CNJ_INV]);; let CNJ_POW = prove (`!z n. cnj(z pow n) = cnj(z) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; CNJ_MUL; CNJ_CX]);; (* ------------------------------------------------------------------------- *) (* Conversion of (complex-type) rational constant to ML rational number. *) (* ------------------------------------------------------------------------- *) let is_complex_const = let cx_tm = `Cx` in fun tm -> is_comb tm & let l,r = dest_comb tm in l = cx_tm && is_ratconst r;; let dest_complex_const = let cx_tm = `Cx` in fun tm -> let l,r = dest_comb tm in if l = cx_tm then rat_of_term r else failwith "dest_complex_const";; let mk_complex_const = let cx_tm = `Cx` in fun r -> mk_comb(cx_tm,term_of_rat r);; (* ------------------------------------------------------------------------- *) (* Conversions to perform operations if coefficients are rational constants. *) (* ------------------------------------------------------------------------- *) let COMPLEX_RAT_MUL_CONV = GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;; let COMPLEX_RAT_ADD_CONV = GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;; let COMPLEX_RAT_EQ_CONV = GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;; let COMPLEX_RAT_POW_CONV = let x_tm = `x:real` and n_tm = `n:num` in let pth = SYM(SPECL [x_tm; n_tm] CX_POW) in fun tm -> let lop,r = dest_comb tm in let op,bod = dest_comb lop in let th1 = INST [rand bod,x_tm; r,n_tm] pth in let tm1,tm2 = dest_comb(concl th1) in if rand tm1 <> tm then failwith "COMPLEX_RAT_POW_CONV" else let tm3,tm4 = dest_comb tm2 in TRANS th1 (AP_TERM tm3 (REAL_RAT_REDUCE_CONV tm4));; (* ------------------------------------------------------------------------- *) (* Instantiate polynomial normalizer. *) (* ------------------------------------------------------------------------- *) let COMPLEX_POLY_CLAUSES = prove (`(!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. Cx(&0) + x = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x y. x * y = y * x) /\ (!x. Cx(&1) * x = x) /\ (!x. Cx(&0) * x = Cx(&0)) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x. x pow 0 = Cx(&1)) /\ (!x n. x pow (SUC n) = x * x pow n)`, REWRITE_TAC[complex_pow] THEN SIMPLE_COMPLEX_ARITH_TAC) and COMPLEX_POLY_NEG_CLAUSES = prove (`(!x. --x = Cx(-- &1) * x) /\ (!x y. x - y = x + Cx(-- &1) * y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_POLY_NEG_CONV,COMPLEX_POLY_ADD_CONV,COMPLEX_POLY_SUB_CONV, COMPLEX_POLY_MUL_CONV,COMPLEX_POLY_POW_CONV,COMPLEX_POLY_CONV = SEMIRING_NORMALIZERS_CONV COMPLEX_POLY_CLAUSES COMPLEX_POLY_NEG_CLAUSES (is_complex_const, COMPLEX_RAT_ADD_CONV,COMPLEX_RAT_MUL_CONV,COMPLEX_RAT_POW_CONV) (<);; let COMPLEX_RAT_INV_CONV = GEN_REWRITE_CONV I [GSYM CX_INV] THENC RAND_CONV REAL_RAT_INV_CONV;; let COMPLEX_POLY_CONV = let neg_tm = `(--):complex->complex` and inv_tm = `inv:complex->complex` and add_tm = `(+):complex->complex->complex` and sub_tm = `(-):complex->complex->complex` and mul_tm = `(*):complex->complex->complex` and div_tm = `(/):complex->complex->complex` and pow_tm = `(pow):complex->num->complex` and div_conv = REWR_CONV complex_div in let rec COMPLEX_POLY_CONV tm = if not(is_comb tm) || is_complex_const tm then REFL tm else let lop,r = dest_comb tm in if lop = neg_tm then let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in TRANS th1 (COMPLEX_POLY_NEG_CONV (rand(concl th1))) else if lop = inv_tm then let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in TRANS th1 (TRY_CONV COMPLEX_RAT_INV_CONV (rand(concl th1))) else if not(is_comb lop) then REFL tm else let op,l = dest_comb lop in if op = pow_tm then let th1 = AP_THM (AP_TERM op (COMPLEX_POLY_CONV l)) r in TRANS th1 (TRY_CONV COMPLEX_POLY_POW_CONV (rand(concl th1))) else if op = add_tm || op = mul_tm || op = sub_tm then let th1 = MK_COMB(AP_TERM op (COMPLEX_POLY_CONV l), COMPLEX_POLY_CONV r) in let fn = if op = add_tm then COMPLEX_POLY_ADD_CONV else if op = mul_tm then COMPLEX_POLY_MUL_CONV else COMPLEX_POLY_SUB_CONV in TRANS th1 (fn (rand(concl th1))) else if op = div_tm then let th1 = div_conv tm in TRANS th1 (COMPLEX_POLY_CONV (rand(concl th1))) else REFL tm in COMPLEX_POLY_CONV;; (* ------------------------------------------------------------------------- *) (* Complex number version of usual ring procedure. *) (* ------------------------------------------------------------------------- *) let COMPLEX_MUL_LINV = prove (`!z. ~(z = Cx(&0)) ==> (inv(z) * z = Cx(&1))`, REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);; let COMPLEX_MUL_RINV = prove (`!z. ~(z = Cx(&0)) ==> (z * inv(z) = Cx(&1))`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[COMPLEX_MUL_LINV]);; let COMPLEX_RING,complex_ideal_cofactors = let ring_pow_tm = `(pow):complex->num->complex` and COMPLEX_INTEGRAL = prove (`(!x. Cx(&0) * x = Cx(&0)) /\ (!x y z. (x + y = x + z) <=> (y = z)) /\ (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, REWRITE_TAC[COMPLEX_ENTIRE; SIMPLE_COMPLEX_ARITH `(w * y + x * z = w * z + x * y) <=> (w - x) * (y - z) = Cx(&0)`] THEN SIMPLE_COMPLEX_ARITH_TAC) and COMPLEX_RABINOWITSCH = prove (`!x y:complex. ~(x = y) <=> ?z. (x - y) * z = Cx(&1)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_SUB_0] THEN MESON_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LZERO; SIMPLE_COMPLEX_ARITH `~(Cx(&1) = Cx(&0))`]) and init = ALL_CONV in let pure,ideal = RING_AND_IDEAL_CONV (dest_complex_const,mk_complex_const,COMPLEX_RAT_EQ_CONV, `(--):complex->complex`,`(+):complex->complex->complex`, `(-):complex->complex->complex`,`(inv):complex->complex`, `(*):complex->complex->complex`,`(/):complex->complex->complex`, `(pow):complex->num->complex`, COMPLEX_INTEGRAL,COMPLEX_RABINOWITSCH,COMPLEX_POLY_CONV) in (fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)))), ideal;; (* ------------------------------------------------------------------------- *) (* Most basic properties of inverses. *) (* ------------------------------------------------------------------------- *) let COMPLEX_INV_0 = prove (`inv(Cx(&0)) = Cx(&0)`, REWRITE_TAC[complex_inv; CX_DEF; RE; IM; real_div; REAL_MUL_LZERO; REAL_NEG_0]);; let COMPLEX_INV_MUL = prove (`!w z. inv(w * z) = inv(w) * inv(z)`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`w = Cx(&0)`; `z = Cx(&0)`] THEN ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);; let COMPLEX_INV_1 = prove (`inv(Cx(&1)) = Cx(&1)`, REWRITE_TAC[complex_inv; CX_DEF; RE; IM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1]);; let COMPLEX_POW_INV = prove (`!x n. (inv x) pow n = inv(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_INV_1; COMPLEX_INV_MUL]);; let COMPLEX_INV_INV = prove (`!x:complex. inv(inv x) = x`, GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_INV_0] THEN POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> MP_TAC(SPEC t COMPLEX_MUL_RINV)) [`x:complex`; `inv(x):complex`] THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* And also field procedure. *) (* ------------------------------------------------------------------------- *) let COMPLEX_FIELD = let prenex_conv = TOP_DEPTH_CONV BETA_CONV THENC PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; complex_div; COMPLEX_INV_INV; COMPLEX_INV_MUL; GSYM REAL_POW_INV] THENC NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC PRENEX_CONV and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV and is_inv = let inv_tm = `inv:complex->complex` and is_div = is_binop `(/):complex->complex->complex` in fun tm -> (is_div tm || (is_comb tm && rator tm = inv_tm)) & not(is_complex_const(rand tm)) and lemma_inv = MESON[COMPLEX_MUL_RINV] `!x. x = Cx(&0) \/ x * inv(x) = Cx(&1)` and dcases = MATCH_MP(TAUT `(p \/ q) /\ (r \/ s) ==> (p \/ r) \/ q /\ s`) in let cases_rule th1 th2 = dcases (CONJ th1 th2) in let BASIC_COMPLEX_FIELD tm = let is_freeinv t = is_inv t && free_in t tm in let itms = setify(map rand (find_terms is_freeinv tm)) in let dth = if itms = [] then TRUTH else end_itlist cases_rule (map (C SPEC lemma_inv) itms) in let tm' = mk_imp(concl dth,tm) in let th1 = setup_conv tm' in let ths = map COMPLEX_RING (conjuncts(rand(concl th1))) in let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in MP (EQ_MP (SYM th1) (end_itlist CONJ ths)) dth in fun tm -> let th0 = prenex_conv tm in let tm0 = rand(concl th0) in let avs,bod = strip_forall tm0 in let th1 = setup_conv bod in let ths = map BASIC_COMPLEX_FIELD (conjuncts(rand(concl th1))) in EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; (* ------------------------------------------------------------------------- *) (* Properties of inverses, divisions are now mostly automatic. *) (* ------------------------------------------------------------------------- *) let COMPLEX_POW_DIV = prove (`!x y n. (x / y) pow n = (x pow n) / (y pow n)`, REWRITE_TAC[complex_div; COMPLEX_POW_MUL; COMPLEX_POW_INV]);; let COMPLEX_DIV_REFL = prove (`!x. ~(x = Cx(&0)) ==> (x / x = Cx(&1))`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_EQ_MUL_LCANCEL = prove (`!x y z. (x * y = x * z) <=> (x = Cx(&0)) \/ (y = z)`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_EQ_MUL_RCANCEL = prove (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = Cx(&0))`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_MUL_RINV_UNIQ = prove (`!w z. w * z = Cx(&1) ==> inv w = z`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_MUL_LINV_UNIQ = prove (`!w z. w * z = Cx(&1) ==> inv z = w`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIV_LMUL = prove (`!w z. ~(z = Cx(&0)) ==> z * w / z = w`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIV_RMUL = prove (`!w z. ~(z = Cx(&0)) ==> w / z * z = w`, CONV_TAC COMPLEX_FIELD);; hol-light/Complex/cpoly.ml000066400000000000000000001263411303454263000160430ustar00rootroot00000000000000(* ========================================================================= *) (* Properties of complex polynomials (not canonically represented). *) (* ========================================================================= *) needs "Complex/complexnumbers.ml";; prioritize_complex();; parse_as_infix("++",(16,"right"));; parse_as_infix("**",(20,"right"));; parse_as_infix("##",(20,"right"));; parse_as_infix("divides",(14,"right"));; parse_as_infix("exp",(22,"right"));; do_list override_interface ["++",`poly_add:complex list->complex list->complex list`; "**",`poly_mul:complex list->complex list->complex list`; "##",`poly_cmul:complex->complex list->complex list`; "neg",`poly_neg:complex list->complex list`; "divides",`poly_divides:complex list->complex list->bool`; "exp",`poly_exp:complex list -> num -> complex list`; "diff",`poly_diff:complex list->complex list`];; let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Polynomials. *) (* ------------------------------------------------------------------------- *) let poly = new_recursive_definition list_RECURSION `(poly [] x = Cx(&0)) /\ (poly (CONS h t) x = h + x * poly t x)`;; (* ------------------------------------------------------------------------- *) (* Arithmetic operations on polynomials. *) (* ------------------------------------------------------------------------- *) let poly_add = new_recursive_definition list_RECURSION `([] ++ l2 = l2) /\ ((CONS h t) ++ l2 = (if l2 = [] then CONS h t else CONS (h + HD l2) (t ++ TL l2)))`;; let poly_cmul = new_recursive_definition list_RECURSION `(c ## [] = []) /\ (c ## (CONS h t) = CONS (c * h) (c ## t))`;; let poly_neg = new_definition `neg = (##) (--(Cx(&1)))`;; let poly_mul = new_recursive_definition list_RECURSION `([] ** l2 = []) /\ ((CONS h t) ** l2 = if t = [] then h ## l2 else (h ## l2) ++ CONS (Cx(&0)) (t ** l2))`;; let poly_exp = new_recursive_definition num_RECURSION `(p exp 0 = [Cx(&1)]) /\ (p exp (SUC n) = p ** p exp n)`;; (* ------------------------------------------------------------------------- *) (* Useful clausifications. *) (* ------------------------------------------------------------------------- *) let POLY_ADD_CLAUSES = prove (`([] ++ p2 = p2) /\ (p1 ++ [] = p1) /\ ((CONS h1 t1) ++ (CONS h2 t2) = CONS (h1 + h2) (t1 ++ t2))`, REWRITE_TAC[poly_add; NOT_CONS_NIL; HD; TL] THEN SPEC_TAC(`p1:complex list`,`p1:complex list`) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly_add]);; let POLY_CMUL_CLAUSES = prove (`(c ## [] = []) /\ (c ## (CONS h t) = CONS (c * h) (c ## t))`, REWRITE_TAC[poly_cmul]);; let POLY_NEG_CLAUSES = prove (`(neg [] = []) /\ (neg (CONS h t) = CONS (--h) (neg t))`, REWRITE_TAC[poly_neg; POLY_CMUL_CLAUSES; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID]);; let POLY_MUL_CLAUSES = prove (`([] ** p2 = []) /\ ([h1] ** p2 = h1 ## p2) /\ ((CONS h1 (CONS k1 t1)) ** p2 = h1 ## p2 ++ CONS (Cx(&0)) (CONS k1 t1 ** p2))`, REWRITE_TAC[poly_mul; NOT_CONS_NIL]);; (* ------------------------------------------------------------------------- *) (* Various natural consequences of syntactic definitions. *) (* ------------------------------------------------------------------------- *) let POLY_ADD = prove (`!p1 p2 x. poly (p1 ++ p2) x = poly p1 x + poly p2 x`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly_add; poly; COMPLEX_ADD_LID] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL; HD; TL; poly; COMPLEX_ADD_RID] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_CMUL = prove (`!p c x. poly (c ## p) x = c * poly p x`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly; poly_cmul] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_NEG = prove (`!p x. poly (neg p) x = --(poly p x)`, REWRITE_TAC[poly_neg; POLY_CMUL] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_MUL = prove (`!x p1 p2. poly (p1 ** p2) x = poly p1 x * poly p2 x`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly_mul; poly; COMPLEX_MUL_LZERO; POLY_CMUL; POLY_ADD] THEN SPEC_TAC(`h:complex`,`h:complex`) THEN SPEC_TAC(`t:complex list`,`t:complex list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly_mul; POLY_CMUL; POLY_ADD; poly; POLY_CMUL; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; NOT_CONS_NIL] THEN ASM_REWRITE_TAC[POLY_ADD; POLY_CMUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_EXP = prove (`!p n x. poly (p exp n) x = (poly p x) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; complex_pow; POLY_MUL] THEN REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Lemmas. *) (* ------------------------------------------------------------------------- *) let POLY_ADD_RZERO = prove (`!p. poly (p ++ []) = poly p`, REWRITE_TAC[FUN_EQ_THM; POLY_ADD; poly; COMPLEX_ADD_RID]);; let POLY_MUL_ASSOC = prove (`!p q r. poly (p ** (q ** r)) = poly ((p ** q) ** r)`, REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]);; let POLY_EXP_ADD = prove (`!d n p. poly(p exp (n + d)) = poly(p exp n ** p exp d)`, REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_MUL; ADD_CLAUSES; poly_exp; poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Key property that f(a) = 0 ==> (x - a) divides p(x). Very delicate! *) (* ------------------------------------------------------------------------- *) let POLY_LINEAR_REM = prove (`!t h. ?q r. CONS h t = [r] ++ [--a; Cx(&1)] ** q`, LIST_INDUCT_TAC THEN REWRITE_TAC[] THENL [GEN_TAC THEN EXISTS_TAC `[]:complex list` THEN EXISTS_TAC `h:complex` THEN REWRITE_TAC[poly_add; poly_mul; poly_cmul; NOT_CONS_NIL] THEN REWRITE_TAC[HD; TL; COMPLEX_ADD_RID]; X_GEN_TAC `k:complex` THEN POP_ASSUM(STRIP_ASSUME_TAC o SPEC `h:complex`) THEN EXISTS_TAC `CONS (r:complex) q` THEN EXISTS_TAC `r * a + k` THEN ASM_REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN REWRITE_TAC[CONS_11] THEN CONJ_TAC THENL [SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`q:complex list`,`q:complex list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_LID] THEN REWRITE_TAC[COMPLEX_ADD_AC]]);; let POLY_LINEAR_DIVIDES = prove (`!a p. (poly p a = Cx(&0)) <=> (p = []) \/ ?q. p = [--a; Cx(&1)] ** q`, GEN_TAC THEN LIST_INDUCT_TAC THENL [REWRITE_TAC[poly]; ALL_TAC] THEN EQ_TAC THEN STRIP_TAC THENL [DISJ2_TAC THEN STRIP_ASSUME_TAC(SPEC_ALL POLY_LINEAR_REM) THEN EXISTS_TAC `q:complex list` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `r = Cx(&0)` SUBST_ALL_TAC THENL [UNDISCH_TAC `poly (CONS h t) a = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[POLY_ADD; POLY_MUL] THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_ADD_LINV] THEN SIMPLE_COMPLEX_ARITH_TAC; REWRITE_TAC[poly_mul] THEN REWRITE_TAC[NOT_CONS_NIL] THEN SPEC_TAC(`q:complex list`,`q:complex list`) THEN LIST_INDUCT_TAC THENL [REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; HD; TL; COMPLEX_ADD_LID]; REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; HD; TL; COMPLEX_ADD_LID]]]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly] THEN REWRITE_TAC[POLY_MUL] THEN REWRITE_TAC[poly] THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_ADD_LINV] THEN SIMPLE_COMPLEX_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Thanks to the finesse of the above, we can use length rather than degree. *) (* ------------------------------------------------------------------------- *) let POLY_LENGTH_MUL = prove (`!q. LENGTH([--a; Cx(&1)] ** q) = SUC(LENGTH q)`, let lemma = prove (`!p h k a. LENGTH (k ## p ++ CONS h (a ## p)) = SUC(LENGTH p)`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly_cmul; POLY_ADD_CLAUSES; LENGTH]) in REWRITE_TAC[poly_mul; NOT_CONS_NIL; lemma]);; (* ------------------------------------------------------------------------- *) (* Thus a nontrivial polynomial of degree n has no more than n roots. *) (* ------------------------------------------------------------------------- *) let POLY_ROOTS_INDEX_LEMMA = prove (`!n. !p. ~(poly p = poly []) /\ (LENGTH p = n) ==> ?i. !x. (poly p x = Cx(&0)) ==> ?m. m <= n /\ (x = i m)`, INDUCT_TAC THENL [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a. poly p a = Cx(&0)` THENL [UNDISCH_TAC `?a. poly p a = Cx(&0)` THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN UNDISCH_TAC `~(poly ([-- a; Cx(&1)] ** q) = poly [])` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[POLY_LENGTH_MUL; SUC_INJ] THEN DISCH_TAC THEN ASM_CASES_TAC `poly q = poly []` THENL [ASM_REWRITE_TAC[POLY_MUL; poly; COMPLEX_MUL_RZERO; FUN_EQ_THM]; DISCH_THEN(K ALL_TAC)] THEN DISCH_THEN(MP_TAC o SPEC `q:complex list`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `i:num->complex`) THEN EXISTS_TAC `\m. if m = SUC n then a:complex else i m` THEN REWRITE_TAC[POLY_MUL; LE; COMPLEX_ENTIRE] THEN X_GEN_TAC `x:complex` THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_THEN(fun th -> EXISTS_TAC `SUC n` THEN MP_TAC th) THEN REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC; DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `m:num <= n` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC]; UNDISCH_TAC `~(?a. poly p a = Cx(&0))` THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);; let POLY_ROOTS_INDEX_LENGTH = prove (`!p. ~(poly p = poly []) ==> ?i. !x. (poly p(x) = Cx(&0)) ==> ?n. n <= LENGTH p /\ (x = i n)`, MESON_TAC[POLY_ROOTS_INDEX_LEMMA]);; let POLY_ROOTS_FINITE_LEMMA = prove (`!p. ~(poly p = poly []) ==> ?N i. !x. (poly p(x) = Cx(&0)) ==> ?n:num. n < N /\ (x = i n)`, MESON_TAC[POLY_ROOTS_INDEX_LENGTH; LT_SUC_LE]);; let FINITE_LEMMA = prove (`!i N P. (!x. P x ==> ?n:num. n < N /\ (x = i n)) ==> ?a. !x. P x ==> norm(x) < a`, GEN_TAC THEN ONCE_REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN INDUCT_TAC THENL [REWRITE_TAC[LT] THEN MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `P:complex->bool` THEN POP_ASSUM(MP_TAC o SPEC `\z. P z /\ ~(z = (i:num->complex) N)`) THEN DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN EXISTS_TAC `abs(a) + norm(i(N:num)) + &1` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[LT] THEN SUBGOAL_THEN `(!x. norm(x) < abs(a) + norm(x) + &1) /\ (!x y. norm(x) < a ==> norm(x) < abs(a) + norm(y) + &1)` (fun th -> MP_TAC th THEN MESON_TAC[]) THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REPEAT GEN_TAC THEN MP_TAC(SPEC `y:complex` COMPLEX_NORM_POS) THEN REAL_ARITH_TAC);; let POLY_ROOTS_FINITE = prove (`!p. ~(poly p = poly []) <=> ?N i. !x. (poly p(x) = Cx(&0)) ==> ?n:num. n < N /\ (x = i n)`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE_LEMMA] THEN REWRITE_TAC[FUN_EQ_THM; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM; poly] THEN MP_TAC(GENL [`i:num->complex`; `N:num`] (SPECL [`i:num->complex`; `N:num`; `\x. poly p x = Cx(&0)`] FINITE_LEMMA)) THEN REWRITE_TAC[] THEN MESON_TAC[REAL_ARITH `~(abs(x) < x)`; COMPLEX_NORM_CX]);; (* ------------------------------------------------------------------------- *) (* Hence get entirety and cancellation for polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_ENTIRE_LEMMA = prove (`!p q. ~(poly p = poly []) /\ ~(poly q = poly []) ==> ~(poly (p ** q) = poly [])`, REPEAT GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (X_CHOOSE_TAC `i2:num->complex`)) THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (X_CHOOSE_TAC `i1:num->complex`)) THEN EXISTS_TAC `N1 + N2:num` THEN EXISTS_TAC `\n:num. if n < N1 then i1(n):complex else i2(n - N1)` THEN X_GEN_TAC `x:complex` THEN REWRITE_TAC[COMPLEX_ENTIRE; POLY_MUL] THEN DISCH_THEN(DISJ_CASES_THEN (ANTE_RES_THEN (X_CHOOSE_TAC `n:num`))) THENL [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN ARITH_TAC; EXISTS_TAC `N1 + n:num` THEN ASM_REWRITE_TAC[LT_ADD_LCANCEL] THEN REWRITE_TAC[ARITH_RULE `~(m + n < m:num)`] THEN AP_TERM_TAC THEN ARITH_TAC]);; let POLY_ENTIRE = prove (`!p q. (poly (p ** q) = poly []) <=> (poly p = poly []) \/ (poly q = poly [])`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[POLY_ENTIRE_LEMMA]; REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO; poly]]);; let POLY_MUL_LCANCEL = prove (`!p q r. (poly (p ** q) = poly (p ** r)) <=> (poly p = poly []) \/ (poly q = poly r)`, let lemma1 = prove (`!p q. (poly (p ++ neg q) = poly []) <=> (poly p = poly q)`, REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; poly] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(p + --q = Cx(&0)) <=> (p = q)`]) in let lemma2 = prove (`!p q r. poly (p ** q ++ neg(p ** r)) = poly (p ** (q ++ neg(r)))`, REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC) in ONCE_REWRITE_TAC[GSYM lemma1] THEN REWRITE_TAC[lemma2; POLY_ENTIRE] THEN REWRITE_TAC[lemma1]);; let POLY_EXP_EQ_0 = prove (`!p n. (poly (p exp n) = poly []) <=> (poly p = poly []) /\ ~(n = 0)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN REWRITE_TAC[LEFT_AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[poly_exp; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; CX_INJ; REAL_OF_NUM_EQ; ARITH; NOT_SUC] THEN ASM_REWRITE_TAC[POLY_MUL; poly; COMPLEX_ENTIRE] THEN CONV_TAC TAUT);; let POLY_PRIME_EQ_0 = prove (`!a. ~(poly [a ; Cx(&1)] = poly [])`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1) - a`) THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_EXP_PRIME_EQ_0 = prove (`!a n. ~(poly ([a ; Cx(&1)] exp n) = poly [])`, MESON_TAC[POLY_EXP_EQ_0; POLY_PRIME_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Can also prove a more "constructive" notion of polynomial being trivial. *) (* ------------------------------------------------------------------------- *) let POLY_ZERO_LEMMA = prove (`!h t. (poly (CONS h t) = poly []) ==> (h = Cx(&0)) /\ (poly t = poly [])`, let lemma = REWRITE_RULE[FUN_EQ_THM; poly] POLY_ROOTS_FINITE in REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[COMPLEX_ADD_LID]; DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN POP_ASSUM MP_TAC THEN SIMPLE_COMPLEX_ARITH_TAC] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(MP_TAC o REWRITE_RULE[lemma]) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (X_CHOOSE_TAC `i:num->complex`)) THEN MP_TAC(SPECL [`i:num->complex`; `N:num`; `\x. poly t x = Cx(&0)`] FINITE_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN DISCH_THEN(MP_TAC o SPEC `Cx(abs(a) + &1)`) THEN REWRITE_TAC[COMPLEX_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THENL [REWRITE_TAC[CX_INJ] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o MATCH_MP (ASSUME `!x. (poly t x = Cx(&0)) ==> norm(x) < a`)) THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]);; let POLY_ZERO = prove (`!p. (poly p = poly []) <=> ALL (\c. c = Cx(&0)) p`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN ASM_REWRITE_TAC[]; POP_ASSUM(SUBST1_TAC o SYM) THEN STRIP_TAC THEN ASM_REWRITE_TAC[FUN_EQ_THM; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Basics of divisibility. *) (* ------------------------------------------------------------------------- *) let divides = new_definition `p1 divides p2 <=> ?q. poly p2 = poly (p1 ** q)`;; let POLY_PRIMES = prove (`!a p q. [a; Cx(&1)] divides (p ** q) <=> [a; Cx(&1)] divides p \/ [a; Cx(&1)] divides q`, REPEAT GEN_TAC THEN REWRITE_TAC[divides; POLY_MUL; FUN_EQ_THM; poly] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `r:complex list` (MP_TAC o SPEC `--a`)) THEN REWRITE_TAC[COMPLEX_ENTIRE; GSYM complex_sub; COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO] THEN DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN (POP_ASSUM(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN REWRITE_TAC[COMPLEX_NEG_NEG] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN `s:complex list` SUBST_ALL_TAC)) THENL [EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO]; EXISTS_TAC `s:complex list` THEN GEN_TAC THEN REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]); DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_TAC `s:complex list`)) THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `s ** q`; EXISTS_TAC `p ** s`] THEN GEN_TAC THEN REWRITE_TAC[POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC]);; let POLY_DIVIDES_REFL = prove (`!p. p divides p`, GEN_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[Cx(&1)]` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_DIVIDES_TRANS = prove (`!p q r. p divides q /\ q divides r ==> p divides r`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN EXISTS_TAC `t ** s` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]);; let POLY_DIVIDES_EXP = prove (`!p m n. m <= n ==> (p exp m) divides (p exp n)`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; POLY_DIVIDES_REFL] THEN MATCH_MP_TAC POLY_DIVIDES_TRANS THEN EXISTS_TAC `p exp (m + d)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN EXISTS_TAC `p:complex list` THEN REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_EXP_DIVIDES = prove (`!p q m n. (p exp n) divides q /\ m <= n ==> (p exp m) divides q`, MESON_TAC[POLY_DIVIDES_TRANS; POLY_DIVIDES_EXP]);; let POLY_DIVIDES_ADD = prove (`!p q r. p divides q /\ p divides r ==> p divides (q ++ r)`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN EXISTS_TAC `t ++ s` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_DIVIDES_SUB = prove (`!p q r. p divides q /\ p divides (q ++ r) ==> p divides r`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN EXISTS_TAC `s ++ neg(t)` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL; POLY_NEG] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN REWRITE_TAC[COMPLEX_ADD_LDISTRIB; COMPLEX_MUL_RNEG] THEN ASM_REWRITE_TAC[] THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_DIVIDES_SUB2 = prove (`!p q r. p divides r /\ p divides (q ++ r) ==> p divides q`, REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_DIVIDES_SUB THEN EXISTS_TAC `r:complex list` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `p divides (q ++ r)` THEN REWRITE_TAC[divides; POLY_ADD; FUN_EQ_THM; POLY_MUL] THEN DISCH_THEN(X_CHOOSE_TAC `s:complex list`) THEN EXISTS_TAC `s:complex list` THEN X_GEN_TAC `x:complex` THEN POP_ASSUM(MP_TAC o SPEC `x:complex`) THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_DIVIDES_ZERO = prove (`!p q. (poly p = poly []) ==> q divides p`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[]:complex list` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* At last, we can consider the order of a root. *) (* ------------------------------------------------------------------------- *) let POLY_ORDER_EXISTS = prove (`!a d. !p. (LENGTH p = d) /\ ~(poly p = poly []) ==> ?n. ([--a; Cx(&1)] exp n) divides p /\ ~(([--a; Cx(&1)] exp (SUC n)) divides p)`, GEN_TAC THEN (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) `(!p q. mulexp 0 p q = q) /\ (!p q n. mulexp (SUC n) p q = p ** (mulexp n p q))` THEN SUBGOAL_THEN `!d. !p. (LENGTH p = d) /\ ~(poly p = poly []) ==> ?n q. (p = mulexp (n:num) [--a; Cx(&1)] q) /\ ~(poly q a = Cx(&0))` MP_TAC THENL [INDUCT_TAC THENL [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `p:complex list` THEN ASM_CASES_TAC `poly p a = Cx(&0)` THENL [STRIP_TAC THEN UNDISCH_TAC `poly p a = Cx(&0)` THEN DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN UNDISCH_TAC `!p. (LENGTH p = d) /\ ~(poly p = poly []) ==> ?n q. (p = mulexp (n:num) [--a; Cx(&1)] q) /\ ~(poly q a = Cx(&0))` THEN DISCH_THEN(MP_TAC o SPEC `q:complex list`) THEN RULE_ASSUM_TAC(REWRITE_RULE[POLY_LENGTH_MUL; POLY_ENTIRE; DE_MORGAN_THM; SUC_INJ]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `s:complex list` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `SUC n` THEN EXISTS_TAC `s:complex list` THEN ASM_REWRITE_TAC[]; STRIP_TAC THEN EXISTS_TAC `0` THEN EXISTS_TAC `p:complex list` THEN ASM_REWRITE_TAC[]]; DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `s:complex list` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN CONJ_TAC THENL [EXISTS_TAC `s:complex list` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `r:complex list` MP_TAC) THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THENL [UNDISCH_TAC `~(poly s a = Cx(&0))` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[poly; poly_exp; POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[poly_exp] THEN REWRITE_TAC[GSYM POLY_MUL_ASSOC; POLY_MUL_LCANCEL] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `a + Cx(&1)`) THEN REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC; DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]]]);; let POLY_ORDER = prove (`!p a. ~(poly p = poly []) ==> ?!n. ([--a; Cx(&1)] exp n) divides p /\ ~(([--a; Cx(&1)] exp (SUC n)) divides p)`, MESON_TAC[POLY_ORDER_EXISTS; POLY_EXP_DIVIDES; LE_SUC_LT; LT_CASES]);; (* ------------------------------------------------------------------------- *) (* Definition of order. *) (* ------------------------------------------------------------------------- *) let order = new_definition `order a p = @n. ([--a; Cx(&1)] exp n) divides p /\ ~(([--a; Cx(&1)] exp (SUC n)) divides p)`;; let ORDER = prove (`!p a n. ([--a; Cx(&1)] exp n) divides p /\ ~(([--a; Cx(&1)] exp (SUC n)) divides p) <=> (n = order a p) /\ ~(poly p = poly [])`, REPEAT GEN_TAC THEN REWRITE_TAC[order] THEN EQ_TAC THEN STRIP_TAC THENL [SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL [FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[divides] THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]; ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[]]; ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV] THEN ASM_MESON_TAC[POLY_ORDER]);; let ORDER_THM = prove (`!p a. ~(poly p = poly []) ==> ([--a; Cx(&1)] exp (order a p)) divides p /\ ~(([--a; Cx(&1)] exp (SUC(order a p))) divides p)`, MESON_TAC[ORDER]);; let ORDER_UNIQUE = prove (`!p a n. ~(poly p = poly []) /\ ([--a; Cx(&1)] exp n) divides p /\ ~(([--a; Cx(&1)] exp (SUC n)) divides p) ==> (n = order a p)`, MESON_TAC[ORDER]);; let ORDER_POLY = prove (`!p q a. (poly p = poly q) ==> (order a p = order a q)`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[order; divides; FUN_EQ_THM; POLY_MUL]);; let ORDER_ROOT = prove (`!p a. (poly p a = Cx(&0)) <=> (poly p = poly []) \/ ~(order a p = 0)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[poly] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN ASM_CASES_TAC `p:complex list = []` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN ASM_REWRITE_TAC[poly_exp; DE_MORGAN_THM] THEN DISJ2_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `q:complex list` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC; DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN UNDISCH_TAC `~(order a p = 0)` THEN SPEC_TAC(`order a p`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; NOT_SUC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `s:complex list` SUBST1_TAC) THEN REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]);; let ORDER_DIVIDES = prove (`!p a n. ([--a; Cx(&1)] exp n) divides p <=> (poly p = poly []) \/ n <= order a p`, REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[divides] THEN EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]; ASM_MESON_TAC[ORDER_THM; POLY_EXP_DIVIDES; NOT_LE; LE_SUC_LT]]);; let ORDER_DECOMP = prove (`!p a. ~(poly p = poly []) ==> ?q. (poly p = poly (([--a; Cx(&1)] exp (order a p)) ** q)) /\ ~([--a; Cx(&1)] divides q)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORDER_THM) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o SPEC `a:complex`) THEN DISCH_THEN(X_CHOOSE_TAC `q:complex list` o REWRITE_RULE[divides]) THEN EXISTS_TAC `q:complex list` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `r: complex list` o REWRITE_RULE[divides]) THEN UNDISCH_TAC `~([-- a; Cx(&1)] exp SUC (order a p) divides p)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN EXISTS_TAC `r:complex list` THEN ASM_REWRITE_TAC[POLY_MUL; FUN_EQ_THM; poly_exp] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Important composition properties of orders. *) (* ------------------------------------------------------------------------- *) let ORDER_MUL = prove (`!a p q. ~(poly (p ** q) = poly []) ==> (order a (p ** q) = order a p + order a q)`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[POLY_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `(order a p + order a q = order a (p ** q)) /\ ~(poly (p ** q) = poly [])` MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[GSYM ORDER] THEN CONJ_TAC THENL [MP_TAC(CONJUNCT1 (SPEC `a:complex` (MATCH_MP ORDER_THM (ASSUME `~(poly p = poly [])`)))) THEN DISCH_THEN(X_CHOOSE_TAC `r: complex list` o REWRITE_RULE[divides]) THEN MP_TAC(CONJUNCT1 (SPEC `a:complex` (MATCH_MP ORDER_THM (ASSUME `~(poly q = poly [])`)))) THEN DISCH_THEN(X_CHOOSE_TAC `s: complex list` o REWRITE_RULE[divides]) THEN REWRITE_TAC[divides; FUN_EQ_THM] THEN EXISTS_TAC `s ** r` THEN ASM_REWRITE_TAC[POLY_MUL; POLY_EXP_ADD] THEN SIMPLE_COMPLEX_ARITH_TAC; X_CHOOSE_THEN `r: complex list` STRIP_ASSUME_TAC (SPEC `a:complex` (MATCH_MP ORDER_DECOMP (ASSUME `~(poly p = poly [])`))) THEN X_CHOOSE_THEN `s: complex list` STRIP_ASSUME_TAC (SPEC `a:complex` (MATCH_MP ORDER_DECOMP (ASSUME `~(poly q = poly [])`))) THEN ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_EXP_ADD; POLY_MUL; poly_exp] THEN DISCH_THEN(X_CHOOSE_THEN `t:complex list` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `[--a; Cx(&1)] divides (r ** s)` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[POLY_PRIMES]] THEN REWRITE_TAC[divides] THEN EXISTS_TAC `t:complex list` THEN SUBGOAL_THEN `poly ([-- a; Cx(&1)] exp (order a p) ** r ** s) = poly ([-- a; Cx(&1)] exp (order a p) ** ([-- a; Cx(&1)] ** t))` MP_TAC THENL [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN SUBGOAL_THEN `poly ([-- a; Cx(&1)] exp (order a q) ** [-- a; Cx(&1)] exp (order a p) ** r ** s) = poly ([-- a; Cx(&1)] exp (order a q) ** [-- a; Cx(&1)] exp (order a p) ** [-- a; Cx(&1)] ** t)` MP_TAC THENL [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD] THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN REWRITE_TAC[COMPLEX_MUL_AC]]);; (* ------------------------------------------------------------------------- *) (* Normalization of a polynomial. *) (* ------------------------------------------------------------------------- *) let normalize = new_recursive_definition list_RECURSION `(normalize [] = []) /\ (normalize (CONS h t) = if normalize t = [] then if h = Cx(&0) then [] else [h] else CONS h (normalize t))`;; let POLY_NORMALIZE = prove (`!p. poly (normalize p) = poly p`, LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; poly] THEN ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM] THEN UNDISCH_TAC `poly (normalize t) = poly t` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[poly] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID]);; let LENGTH_NORMALIZE_LE = prove (`!p. LENGTH(normalize p) <= LENGTH p`, LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; normalize; LE_REFL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; LE_SUC] THEN COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The degree of a polynomial. *) (* ------------------------------------------------------------------------- *) let degree = new_definition `degree p = PRE(LENGTH(normalize p))`;; let DEGREE_ZERO = prove (`!p. (poly p = poly []) ==> (degree p = 0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[degree] THEN SUBGOAL_THEN `normalize p = []` SUBST1_TAC THENL [POP_ASSUM MP_TAC THEN SPEC_TAC(`p:complex list`,`p:complex list`) THEN REWRITE_TAC[POLY_ZERO] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; ALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `normalize t = []` (fun th -> REWRITE_TAC[th]) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LENGTH; PRE]]);; (* ------------------------------------------------------------------------- *) (* Show that the degree is welldefined. *) (* ------------------------------------------------------------------------- *) let POLY_CONS_EQ = prove (`(poly (CONS h1 t1) = poly (CONS h2 t2)) <=> (h1 = h2) /\ (poly t1 = poly t2)`, REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL [ALL_TAC; SIMP_TAC[poly]] THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(a = b) <=> (a + --b = Cx(&0))`] THEN REWRITE_TAC[GSYM POLY_NEG; GSYM POLY_ADD] THEN DISCH_TAC THEN SUBGOAL_THEN `poly (CONS h1 t1 ++ neg(CONS h2 t2)) = poly []` MP_TAC THENL [ASM_REWRITE_TAC[poly; FUN_EQ_THM]; ALL_TAC] THEN REWRITE_TAC[poly_neg; poly_cmul; poly_add; NOT_CONS_NIL; HD; TL] THEN DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN SIMP_TAC[poly; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID]);; let POLY_NORMALIZE_ZERO = prove (`!p. (poly p = poly []) <=> (normalize p = [])`, REWRITE_TAC[POLY_ZERO] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; normalize] THEN ASM_CASES_TAC `normalize t = []` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_CONS_NIL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL]);; let POLY_NORMALIZE_EQ_LEMMA = prove (`!p q. (poly p = poly q) ==> (normalize p = normalize q)`, LIST_INDUCT_TAC THENL [MESON_TAC[POLY_NORMALIZE_ZERO]; ALL_TAC] THEN LIST_INDUCT_TAC THENL [MESON_TAC[POLY_NORMALIZE_ZERO]; ALL_TAC] THEN REWRITE_TAC[POLY_CONS_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[normalize] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t':complex list`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; let POLY_NORMALIZE_EQ = prove (`!p q. (poly p = poly q) <=> (normalize p = normalize q)`, MESON_TAC[POLY_NORMALIZE_EQ_LEMMA; POLY_NORMALIZE]);; let DEGREE_WELLDEF = prove (`!p q. (poly p = poly q) ==> (degree p = degree q)`, SIMP_TAC[degree; POLY_NORMALIZE_EQ]);; (* ------------------------------------------------------------------------- *) (* Degree of a product with a power of linear terms. *) (* ------------------------------------------------------------------------- *) let NORMALIZE_EQ = prove (`!p. ~(LAST p = Cx(&0)) ==> (normalize p = p)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[NOT_CONS_NIL] THEN REWRITE_TAC[normalize; LAST] THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[normalize]));; let NORMAL_DEGREE = prove (`!p. ~(LAST p = Cx(&0)) ==> (degree p = LENGTH p - 1)`, SIMP_TAC[degree; NORMALIZE_EQ] THEN REPEAT STRIP_TAC THEN ARITH_TAC);; let LAST_LINEAR_MUL_LEMMA = prove (`!p a b x. LAST(a ## p ++ CONS x (b ## p)) = if p = [] then x else b * LAST(p)`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly_cmul; poly_add; LAST; HD; TL; NOT_CONS_NIL] THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `~(a ## t ++ CONS (b * h) (b ## t) = [])` ASSUME_TAC THENL [SPEC_TAC(`t:complex list`,`t:complex list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; let LAST_LINEAR_MUL = prove (`!p. ~(p = []) ==> (LAST([a; Cx(&1)] ** p) = LAST p)`, SIMP_TAC[poly_mul; NOT_CONS_NIL; LAST_LINEAR_MUL_LEMMA; COMPLEX_MUL_LID]);; let NORMAL_NORMALIZE = prove (`!p. ~(normalize p = []) ==> ~(LAST(normalize p) = Cx(&0))`, LIST_INDUCT_TAC THEN REWRITE_TAC[normalize] THEN POP_ASSUM MP_TAC THEN ASM_CASES_TAC `normalize t = []` THEN ASM_REWRITE_TAC[LAST; NOT_CONS_NIL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LAST]);; let LINEAR_MUL_DEGREE = prove (`!p a. ~(poly p = poly []) ==> (degree([a; Cx(&1)] ** p) = degree(p) + 1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `degree([a; Cx(&1)] ** normalize p) = degree(normalize p) + 1` MP_TAC THENL [FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE RAND_CONV [POLY_NORMALIZE_ZERO]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP NORMAL_NORMALIZE) THEN FIRST_ASSUM(MP_TAC o MATCH_MP LAST_LINEAR_MUL) THEN SIMP_TAC[NORMAL_DEGREE] THEN REPEAT STRIP_TAC THEN SUBST1_TAC(SYM(SPEC `a:complex` COMPLEX_NEG_NEG)) THEN REWRITE_TAC[POLY_LENGTH_MUL] THEN UNDISCH_TAC `~(normalize p = [])` THEN SPEC_TAC(`normalize p`,`p:complex list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL; LENGTH] THEN ARITH_TAC; MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN TRY(AP_THM_TAC THEN AP_TERM_TAC) THEN MATCH_MP_TAC DEGREE_WELLDEF THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_NORMALIZE]]);; let LINEAR_POW_MUL_DEGREE = prove (`!n a p. degree([a; Cx(&1)] exp n ** p) = if poly p = poly [] then 0 else degree p + n`, INDUCT_TAC THEN REWRITE_TAC[poly_exp] THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `degree(p)` THEN CONJ_TAC THENL [MATCH_MP_TAC DEGREE_WELLDEF THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_LID]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `degree []` THEN CONJ_TAC THENL [MATCH_MP_TAC DEGREE_WELLDEF THEN ASM_REWRITE_TAC[]; REWRITE_TAC[degree; LENGTH; normalize; ARITH]]]; REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC DEGREE_WELLDEF THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_LID]]; ALL_TAC] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `degree([a; Cx (&1)] exp n ** ([a; Cx (&1)] ** p))` THEN CONJ_TAC THENL [MATCH_MP_TAC DEGREE_WELLDEF THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_AC]; ALL_TAC] THEN ASM_REWRITE_TAC[POLY_ENTIRE] THEN ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[LINEAR_MUL_DEGREE] THEN SUBGOAL_THEN `~(poly [a; Cx (&1)] = poly [])` (fun th -> REWRITE_TAC[th] THEN ARITH_TAC) THEN REWRITE_TAC[POLY_NORMALIZE_EQ] THEN REWRITE_TAC[normalize; CX_INJ; REAL_OF_NUM_EQ; ARITH; NOT_CONS_NIL]);; (* ------------------------------------------------------------------------- *) (* Show that the order of a root (or nonroot!) is bounded by degree. *) (* ------------------------------------------------------------------------- *) let ORDER_DEGREE = prove (`!a p. ~(poly p = poly []) ==> order a p <= degree p`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN DISCH_THEN(MP_TAC o REWRITE_RULE[divides] o CONJUNCT1) THEN DISCH_THEN(X_CHOOSE_THEN `q:complex list` ASSUME_TAC) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN ASM_REWRITE_TAC[LINEAR_POW_MUL_DEGREE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[POLY_MUL] THENL [UNDISCH_TAC `~(poly p = poly [])` THEN SIMP_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]; DISCH_TAC THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Tidier versions of finiteness of roots. *) (* ------------------------------------------------------------------------- *) let POLY_ROOTS_FINITE_SET = prove (`!p. ~(poly p = poly []) ==> FINITE { x | poly p x = Cx(&0)}`, GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `i:num->complex` ASSUME_TAC) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:complex | ?n:num. n < N /\ (x = i n)}` THEN CONJ_TAC THENL [SPEC_TAC(`N:num`,`N:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THENL [SUBGOAL_THEN `{x:complex | ?n. n < 0 /\ (x = i n)} = {}` (fun th -> REWRITE_TAC[th; FINITE_RULES]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; SUBGOAL_THEN `{x:complex | ?n. n < SUC N /\ (x = i n)} = (i N) INSERT {x:complex | ?n. n < N /\ (x = i n)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; LT] THEN MESON_TAC[]; MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN ASM_REWRITE_TAC[]]]; ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM]]);; (* ------------------------------------------------------------------------- *) (* Conversions to perform operations if coefficients are rational constants. *) (* ------------------------------------------------------------------------- *) let COMPLEX_RAT_MUL_CONV = GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;; let COMPLEX_RAT_ADD_CONV = GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;; let COMPLEX_RAT_EQ_CONV = GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;; let POLY_CMUL_CONV = let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul] and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul] in let rec POLY_CMUL_CONV tm = (cmul_conv0 ORELSEC (cmul_conv1 THENC LAND_CONV COMPLEX_RAT_MUL_CONV THENC RAND_CONV POLY_CMUL_CONV)) tm in POLY_CMUL_CONV;; let POLY_ADD_CONV = let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES)) and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)] in let rec POLY_ADD_CONV tm = (add_conv0 ORELSEC (add_conv1 THENC LAND_CONV COMPLEX_RAT_ADD_CONV THENC RAND_CONV POLY_ADD_CONV)) tm in POLY_ADD_CONV;; let POLY_MUL_CONV = let mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES] and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)] and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)] in let rec POLY_MUL_CONV tm = (mul_conv0 ORELSEC (mul_conv1 THENC POLY_CMUL_CONV) ORELSEC (mul_conv2 THENC LAND_CONV POLY_CMUL_CONV THENC RAND_CONV(RAND_CONV POLY_MUL_CONV) THENC POLY_ADD_CONV)) tm in POLY_MUL_CONV;; let POLY_NORMALIZE_CONV = let pth = prove (`normalize (CONS h t) = (\n. if n = [] then if h = Cx(&0) then [] else [h] else CONS h n) (normalize t)`, REWRITE_TAC[normalize]) in let norm_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 normalize] and norm_conv1 = GEN_REWRITE_CONV I [pth] and norm_conv2 = GEN_REWRITE_CONV DEPTH_CONV [COND_CLAUSES; NOT_CONS_NIL; EQT_INTRO(SPEC_ALL EQ_REFL)] in let rec POLY_NORMALIZE_CONV tm = (norm_conv0 ORELSEC (norm_conv1 THENC RAND_CONV POLY_NORMALIZE_CONV THENC BETA_CONV THENC RATOR_CONV(RAND_CONV(RATOR_CONV(LAND_CONV COMPLEX_RAT_EQ_CONV))) THENC norm_conv2)) tm in POLY_NORMALIZE_CONV;; (* ------------------------------------------------------------------------- *) (* Now we're finished with polynomials... *) (* ------------------------------------------------------------------------- *) (************** keep this for now do_list reduce_interface ["divides",`poly_divides:complex list->complex list->bool`; "exp",`poly_exp:complex list -> num -> complex list`; "diff",`poly_diff:complex list->complex list`];; unparse_as_infix "exp";; ****************) hol-light/Complex/fundamental.ml000066400000000000000000001041741303454263000172130ustar00rootroot00000000000000(* ========================================================================= *) (* Fundamental theorem of algebra. *) (* ========================================================================= *) needs "Complex/complex_transc.ml";; needs "Complex/cpoly.ml";; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* A cute trick to reduce magnitude of unimodular number. *) (* ------------------------------------------------------------------------- *) let SQRT_SOS_LT_1 = prove (`!x y. sqrt(x pow 2 + y pow 2) < &1 <=> x pow 2 + y pow 2 < &1`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN REWRITE_TAC[REAL_POW_2] THEN SIMP_TAC[SQRT_MONO_LT_EQ; REAL_POS; REAL_LE_ADD; REAL_LE_SQUARE]);; let SQRT_SOS_EQ_1 = prove (`!x y. (sqrt(x pow 2 + y pow 2) = &1) <=> (x pow 2 + y pow 2 = &1)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN REWRITE_TAC[REAL_POW_2] THEN SIMP_TAC[SQRT_INJ; REAL_POS; REAL_LE_ADD; REAL_LE_SQUARE]);; let UNIMODULAR_REDUCE_NORM = prove (`!z. (norm(z) = &1) ==> norm(z + Cx(&1)) < &1 \/ norm(z - Cx(&1)) < &1 \/ norm(z + ii) < &1 \/ norm(z - ii) < &1`, GEN_TAC THEN REWRITE_TAC[ii; CX_DEF; complex_add; complex_sub; complex_neg; complex_norm; RE; IM; REAL_ADD_RID; REAL_NEG_0; SQRT_SOS_LT_1; SQRT_SOS_EQ_1] THEN SIMP_TAC[REAL_POW_2; REAL_ARITH `a * a + (b + c) * (b + c) = (a * a + b * b) + (&2 * b * c + c * c)`; REAL_ARITH `(b + c) * (b + c) + a * a = (b * b + a * a) + (&2 * b * c + c * c)`] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `&1 + x < &1 <=> &0 < --x`] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_MUL_RID] THEN MATCH_MP_TAC(REAL_ARITH `~(abs(a) <= &1 /\ abs(b) <= &1) ==> &0 < --a + --(&1) \/ &0 < a + --(&1) \/ &0 < --b + --(&1) \/ &0 < b + --(&1)`) THEN STRIP_TAC THEN UNDISCH_TAC `Re z * Re z + Im z * Im z = &1` THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `(&2 * r) * (&2 * r) <= &1 /\ (&2 * i) * (&2 * i) <= &1 ==> ~(r * r + i * i = &1)`) THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ASM_SIMP_TAC[REAL_POW_1_LE; REAL_ABS_POS]);; (* ------------------------------------------------------------------------- *) (* Hence we can always reduce modulus of 1 + b z^n if nonzero *) (* ------------------------------------------------------------------------- *) let REDUCE_POLY_SIMPLE = prove (`!b n. ~(b = Cx(&0)) /\ ~(n = 0) ==> ?z. norm(Cx(&1) + b * z pow n) < &1`, GEN_TAC THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `EVEN(n)` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_SIMP_TAC[ARITH_RULE `~(2 * m = 0) ==> m < 2 * m /\ ~(m = 0)`] THEN DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN EXISTS_TAC `csqrt w` THEN ASM_REWRITE_TAC[GSYM COMPLEX_POW_POW; CSQRT]; ALL_TAC] THEN MP_TAC(SPEC `Cx(norm b) / b` UNIMODULAR_REDUCE_NORM) THEN ANTS_TAC THENL [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[COMPLEX_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `?v. norm(Cx(norm b) / b + v pow n) < &1` MP_TAC THENL [SUBGOAL_THEN `(Cx(&1) pow n = Cx(&1)) /\ (--Cx(&1) pow n = --Cx(&1)) /\ (((ii pow n = ii) /\ (--ii pow n = --ii)) \/ ((ii pow n = --ii) /\ (--ii pow n = ii)))` MP_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[complex_sub]) THEN ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[complex_pow; COMPLEX_POW_NEG; EVEN; EVEN_MULT; ARITH_EVEN] THEN REWRITE_TAC[GSYM COMPLEX_POW_POW] THEN REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_POW_II_2; COMPLEX_MUL_LID; COMPLEX_POW_NEG] THEN COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_MUL_RID; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:complex` ASSUME_TAC) THEN EXISTS_TAC `v / Cx(root(n) (norm b))` THEN REWRITE_TAC[COMPLEX_POW_DIV; GSYM CX_POW] THEN SUBGOAL_THEN `root n (norm b) pow n = norm b` SUBST1_TAC THENL [UNDISCH_TAC `~(EVEN n)` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN SIMP_TAC[EVEN; ROOT_POW_POS; COMPLEX_NORM_POS]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `norm(Cx(norm b) / b)` THEN REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_ADD_LDISTRIB] THEN REWRITE_TAC[COMPLEX_MUL_RID; REAL_MUL_RID] THEN SUBGOAL_THEN `norm(Cx(norm b) / b) = &1` SUBST1_TAC THENL [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; COMPLEX_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_REFL; COMPLEX_NORM_ZERO]; ALL_TAC] THEN REWRITE_TAC[REAL_LT_01; complex_div] THEN ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `(m * b') * b * p * m' = (m * m') * (b * b') * p`] THEN ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LID; CX_INJ; COMPLEX_NORM_ZERO] THEN ASM_REWRITE_TAC[GSYM complex_div]);; (* ------------------------------------------------------------------------- *) (* Basic lemmas about polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_CMUL_MAP = prove (`!p c x. poly (MAP (( * ) c) p) x = c * poly p x`, LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; poly; COMPLEX_MUL_RZERO] THEN ASM_REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; let POLY_0 = prove (`!p x. ALL (\b. b = Cx(&0)) p ==> (poly p x = Cx(&0))`, LIST_INDUCT_TAC THEN ASM_SIMP_TAC[ALL; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]);; let POLY_BOUND_EXISTS = prove (`!p r. ?m. &0 < m /\ !z. norm(z) <= r ==> norm(poly p z) <= m`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN LIST_INDUCT_TAC THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[poly; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_LT_01; REAL_POS]; ALL_TAC] THEN POP_ASSUM(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&1 + norm(h) + abs(r * m)` THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 < &1 + x + y`; REAL_ABS_POS; COMPLEX_NORM_POS] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[poly] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(h) + norm(z * poly t z)` THEN REWRITE_TAC[COMPLEX_NORM_TRIANGLE] THEN MATCH_MP_TAC(REAL_ARITH `y <= z ==> x + y <= &1 + x + abs(z)`) THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[COMPLEX_NORM_POS]);; (* ------------------------------------------------------------------------- *) (* Offsetting the variable in a polynomial gives another of same degree. *) (* ------------------------------------------------------------------------- *) let POLY_OFFSET_LEMMA = prove (`!a p. ?b q. (LENGTH q = LENGTH p) /\ !x. poly (CONS b q) x = (a + x) * poly p x`, GEN_TAC THEN LIST_INDUCT_TAC THENL [EXISTS_TAC `Cx(&0)` THEN EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; LENGTH; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]; ALL_TAC] THEN POP_ASSUM STRIP_ASSUME_TAC THEN EXISTS_TAC `a * h` THEN EXISTS_TAC `CONS (b + h) q` THEN ASM_REWRITE_TAC[LENGTH; poly] THEN X_GEN_TAC `x:complex ` THEN FIRST_ASSUM(MP_TAC o SPEC `x:complex`) THEN REWRITE_TAC[poly] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) x`) THEN SIMPLE_COMPLEX_ARITH_TAC);; let POLY_OFFSET = prove (`!a p. ?q. (LENGTH q = LENGTH p) /\ !x. poly q x = poly p (a + x)`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; poly] THENL [EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; LENGTH]; ALL_TAC] THEN POP_ASSUM(X_CHOOSE_THEN `p:complex list` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPECL [`a:complex`; `p:complex list`] POLY_OFFSET_LEMMA) THEN DISCH_THEN(X_CHOOSE_THEN `b:complex` (X_CHOOSE_THEN `r: complex list` (STRIP_ASSUME_TAC o GSYM))) THEN EXISTS_TAC `CONS (h + b) r` THEN ASM_REWRITE_TAC[LENGTH] THEN REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Bolzano-Weierstrass type property for closed disc in complex plane. *) (* ------------------------------------------------------------------------- *) let METRIC_BOUND_LEMMA = prove (`!x y. norm(x - y) <= abs(Re(x) - Re(y)) + abs(Im(x) - Im(y))`, REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC(REAL_ARITH `a <= abs(abs x + abs y) ==> a <= abs x + abs y`) THEN GEN_REWRITE_TAC RAND_CONV [GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LE THEN SIMP_TAC[REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN REWRITE_TAC[complex_add; complex_sub; complex_neg; RE; IM] THEN REWRITE_TAC[GSYM real_sub] THEN REWRITE_TAC[REAL_ARITH `(a + b) * (a + b) = a * a + b * b + &2 * a * b`] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ARITH `a + b <= abs a + abs b + &2 * abs c`]);; let BOLZANO_WEIERSTRASS_COMPLEX_DISC = prove (`!s r. (!n. norm(s n) <= r) ==> ?f z. subseq f /\ !e. &0 < e ==> ?N. !n. n >= N ==> norm(s(f n) - z) < e`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `Re o (s:num->complex)` SEQ_MONOSUB) THEN DISCH_THEN(X_CHOOSE_THEN `f:num->num` MP_TAC) THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THEN MP_TAC(SPEC `Im o (s:num->complex) o (f:num->num)` SEQ_MONOSUB) THEN DISCH_THEN(X_CHOOSE_THEN `g:num->num` MP_TAC) THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THEN EXISTS_TAC `(f:num->num) o (g:num->num)` THEN SUBGOAL_THEN `convergent (\n. Re(s(f n :num))) /\ convergent (\n. Im(s((f:num->num)(g n))))` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC SEQ_BCONV THEN ASM_REWRITE_TAC[bounded] THEN MAP_EVERY EXISTS_TAC [`r + &1`; `&0`; `0`] THEN REWRITE_TAC[GE; LE_0; MR1_DEF; REAL_SUB_LZERO; REAL_ABS_NEG] THEN X_GEN_TAC `n:num` THEN W(fun (_,w) -> FIRST_ASSUM(MP_TAC o SPEC (funpow 3 rand (lhand w)))) THEN REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b <= r ==> a < r + &1`) THEN GEN_REWRITE_TAC LAND_CONV [GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LE THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LE_ADDR; REAL_LE_ADDL]; ALL_TAC] THEN REWRITE_TAC[convergent; SEQ; GE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `x:real`) (X_CHOOSE_TAC `y:real`)) THEN EXISTS_TAC `complex(x,y)` THEN CONJ_TAC THENL [MAP_EVERY UNDISCH_TAC [`subseq f`; `subseq g`] THEN REWRITE_TAC[subseq; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `!e. &0 < e ==> (?N. !n. N <= n ==> abs(Re(s ((f:num->num) n)) - x) < e)` THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN EXISTS_TAC `N1 + N2:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * e / &2` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH; REAL_LE_REFL]] THEN W(MP_TAC o PART_MATCH lhand METRIC_BOUND_LEMMA o lhand o snd) THEN MATCH_MP_TAC(REAL_ARITH `a < c /\ b < c ==> x <= a + b ==> x < &2 * c`) THEN REWRITE_TAC[o_THM; RE; IM] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[LE_ADD; SEQ_SUBLE; LE_TRANS; ADD_SYM]);; (* ------------------------------------------------------------------------- *) (* Polynomial is continuous. *) (* ------------------------------------------------------------------------- *) let POLY_CONT = prove (`!p z e. &0 < e ==> ?d. &0 < d /\ !w. &0 < norm(w - z) /\ norm(w - z) < d ==> norm(poly p w - poly p z) < e`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`z:complex`; `p:complex list`] POLY_OFFSET) THEN DISCH_THEN(X_CHOOSE_THEN `q:complex list` (MP_TAC o CONJUNCT2)) THEN DISCH_THEN(MP_TAC o GEN `w:complex` o SYM o SPEC `w - z`) THEN REWRITE_TAC[COMPLEX_SUB_ADD2] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[COMPLEX_SUB_REFL] THEN SPEC_TAC(`q:complex list`,`p:complex list`) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly] THENL [EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_CX; REAL_ABS_NUM]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; COMPLEX_ADD_SUB] THEN MP_TAC(SPECL [`t:complex list`; `&1`] POLY_BOUND_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`&1`; `e / m:real`] REAL_DOWN2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_01] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d * m:real` THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_MESON_TAC[REAL_LT_TRANS; REAL_LT_IMP_LE; COMPLEX_NORM_POS]);; (* ------------------------------------------------------------------------- *) (* Hence a polynomial attains minimum on a closed disc in the complex plane. *) (* ------------------------------------------------------------------------- *) let POLY_MINIMUM_MODULUS_DISC = prove (`!p r. ?z. !w. norm(w) <= r ==> norm(poly p z) <= norm(poly p w)`, let lemma = prove (`P /\ (m = --x) /\ --x < y <=> (--x = m) /\ P /\ m < y`, MESON_TAC[]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= r` THENL [ALL_TAC; ASM_MESON_TAC[COMPLEX_NORM_POS; REAL_LE_TRANS]] THEN MP_TAC(SPEC `\x. ?z. norm(z) <= r /\ (norm(poly p z) = --x)` REAL_SUP_EXISTS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`--norm(poly p (Cx(&0)))`; `Cx(&0)`] THEN ASM_REWRITE_TAC[REAL_NEG_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM]; EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_ARITH `(a = --b) <=> (--b = a:real)`] THEN REWRITE_TAC[REAL_ARITH `x < &1 <=> --(&1) < --x`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[REAL_ARITH `&0 <= x ==> --(&1) < x`; COMPLEX_NORM_POS]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `s:real` MP_TAC) THEN ONCE_REWRITE_TAC[REAL_ARITH `a < b <=> --b < --a:real`] THEN ABBREV_TAC `m = --s:real` THEN DISCH_THEN(MP_TAC o GEN `y:real` o SPEC `--y:real`) THEN REWRITE_TAC[REAL_NEG_NEG] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; lemma] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[REAL_ARITH `(--a = b) <=> (a = --b:real)`] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `m:real` th)) THEN REWRITE_TAC[REAL_LT_REFL; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `m + inv(&(SUC n))`) THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0] THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->complex` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`s:num->complex`; `r:real`] BOLZANO_WEIERSTRASS_COMPLEX_DISC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->num` (X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `z:complex` THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `norm(poly p z) = m` (fun th -> ASM_SIMP_TAC[th]) THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(a - b)) ==> (a = b)`) THEN DISCH_TAC THEN ABBREV_TAC `e = abs(norm(poly p z) - m)` THEN MP_TAC(SPECL [`p:complex list`; `z:complex`; `e / &2`] POLY_CONT) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!w. norm(w - z) < d ==> norm(poly p w - poly p z) < e / &2` MP_TAC THENL [X_GEN_TAC `u:complex` THEN ASM_CASES_TAC `u = z:complex` THEN ASM_SIMP_TAC[COMPLEX_SUB_REFL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ; COMPLEX_SUB_0]; ALL_TAC] THEN FIRST_ASSUM(K ALL_TAC o check (is_conj o lhand o snd o dest_forall o concl)) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` ASSUME_TAC) THEN MP_TAC(SPEC `&2 / e` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN SUBGOAL_THEN `norm(poly p (s((f:num->num) (N1 + N2))) - poly p z) < e / &2` MP_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[LE_ADD]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!m. abs(norm(psfn) - m) < e2 /\ &2 * e2 <= abs(norm(psfn) - m) + norm(psfn - pz) ==> norm(psfn - pz) < e2 ==> F`) THEN EXISTS_TAC `m:real` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&(SUC(N1 + N2)))` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `m <= x /\ x < m + e ==> abs(x - m:real) < e`) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `m + inv(&(SUC(f(N1 + N2:num))))` THEN ASM_REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_0; LE_SUC; SEQ_SUBLE]; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N2` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]; ALL_TAC] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN EXPAND_TAC "e" THEN MATCH_MP_TAC(REAL_ARITH `abs(norm(psfn) - norm(pz)) <= norm(psfn - pz) ==> abs(norm(pz) - m) <= abs(norm(psfn) - m) + norm(psfn - pz)`) THEN REWRITE_TAC[COMPLEX_NORM_ABS_NORM]);; (* ------------------------------------------------------------------------- *) (* Nonzero polynomial in z goes to infinity as z does. *) (* ------------------------------------------------------------------------- *) let POLY_INFINITY = prove (`!p a. EX (\b. ~(b = Cx(&0))) p ==> !d. ?r. !z. r <= norm(z) ==> d <= norm(poly (CONS a p) z)`, LIST_INDUCT_TAC THEN REWRITE_TAC[EX] THEN X_GEN_TAC `a:complex` THEN ASM_CASES_TAC `EX (\b. ~(b = Cx(&0))) t` THEN ASM_REWRITE_TAC[] THENL [X_GEN_TAC `d:real` THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `r:real` o SPEC `d + norm(a)`) THEN EXISTS_TAC `&1 + abs(r)` THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[poly] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(z * poly (CONS h t) z) - norm(a)` THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[REAL_LE_SUB_RADD; COMPLEX_NORM_TRIANGLE_SUB]] THEN REWRITE_TAC[REAL_LE_SUB_LADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * norm(poly (CONS h t) z)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&1 + abs(r) <= x ==> r <= x`]; REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN ASM_MESON_TAC[REAL_ARITH `&1 + abs(r) <= x ==> &1 <= x`]]; RULE_ASSUM_TAC(REWRITE_RULE[NOT_EX]) THEN ASM_SIMP_TAC[poly; POLY_0; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN DISCH_TAC THEN X_GEN_TAC `d:real` THEN EXISTS_TAC `(abs(d) + norm(a)) / norm(h)` THEN X_GEN_TAC `z:complex` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ; GSYM COMPLEX_NORM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh`) THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[COMPLEX_NORM_TRIANGLE_SUB]]);; (* ------------------------------------------------------------------------- *) (* Hence polynomial's modulus attains its minimum somewhere. *) (* ------------------------------------------------------------------------- *) let POLY_MINIMUM_MODULUS = prove (`!p. ?z. !w. norm(poly p z) <= norm(poly p w)`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_LE_REFL] THEN ASM_CASES_TAC `EX (\b. ~(b = Cx(&0))) t` THENL [FIRST_ASSUM(MP_TAC o SPEC `h:complex` o MATCH_MP POLY_INFINITY) THEN DISCH_THEN(MP_TAC o SPEC `norm(poly (CONS h t) (Cx(&0)))`) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` ASSUME_TAC) THEN MP_TAC(SPECL [`CONS (h:complex) t`; `abs(r)`] POLY_MINIMUM_MODULUS_DISC) THEN REWRITE_TAC[GSYM(CONJUNCT2 poly)] THEN ASM_MESON_TAC[REAL_ARITH `r <= z \/ z <= abs(r)`; REAL_LE_TRANS; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_POS]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EX]) THEN REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP POLY_0) THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; REAL_LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Constant function (non-syntactic characterization). *) (* ------------------------------------------------------------------------- *) let constant = new_definition `constant f = !w z. f(w) = f(z)`;; let NONCONSTANT_LENGTH = prove (`!p. ~constant(poly p) ==> 2 <= LENGTH p`, REWRITE_TAC[constant] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly] THEN REWRITE_TAC[LENGTH; ARITH_RULE `2 <= SUC n <=> ~(n = 0)`] THEN SIMP_TAC[TAUT `~a ==> ~b <=> b ==> a`; LENGTH_EQ_NIL; poly] THEN REWRITE_TAC[COMPLEX_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* Decomposition of polynomial, skipping zero coefficients after the first. *) (* ------------------------------------------------------------------------- *) let POLY_DECOMPOSE_LEMMA = prove (`!p. ~(!z. ~(z = Cx(&0)) ==> (poly p z = Cx(&0))) ==> ?k a q. ~(a = Cx(&0)) /\ (SUC(LENGTH q + k) = LENGTH p) /\ !z. poly p z = z pow k * poly (CONS a q) z`, LIST_INDUCT_TAC THENL [REWRITE_TAC[poly]; ALL_TAC] THEN ASM_CASES_TAC `h = Cx(&0)` THENL [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [poly] THEN ASM_SIMP_TAC[COMPLEX_ADD_LID; COMPLEX_ENTIRE] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex` (X_CHOOSE_THEN `q:complex list` STRIP_ASSUME_TAC))) THEN MAP_EVERY EXISTS_TAC [`k + 1`; `a:complex`; `q:complex list`] THEN ASM_REWRITE_TAC[poly; LENGTH; GSYM ADD1; ADD_CLAUSES] THEN REWRITE_TAC[COMPLEX_ADD_LID; complex_pow; GSYM COMPLEX_MUL_ASSOC]; DISCH_THEN(K ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`0`; `h:complex`; `t:complex list`] THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; ADD_CLAUSES; LENGTH]]);; let POLY_DECOMPOSE = prove (`!p. ~constant(poly p) ==> ?k a q. ~(a = Cx(&0)) /\ ~(k = 0) /\ (LENGTH q + k + 1 = LENGTH p) /\ !z. poly p z = poly p (Cx(&0)) + z pow k * poly (CONS a q) z`, LIST_INDUCT_TAC THENL [REWRITE_TAC[constant; poly]; ALL_TAC] THEN POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN MP_TAC(SPEC `t:complex list` POLY_DECOMPOSE_LEMMA) THEN ANTS_TAC THENL [POP_ASSUM MP_TAC THEN REWRITE_TAC[constant; poly] THEN REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`; COMPLEX_EQ_ADD_LCANCEL] THEN SIMP_TAC[TAUT `~a ==> b <=> a \/ b`; GSYM COMPLEX_ENTIRE]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex` (X_CHOOSE_THEN `q:complex list` STRIP_ASSUME_TAC))) THEN MAP_EVERY EXISTS_TAC [`SUC k`; `a:complex`; `q:complex list`] THEN ASM_REWRITE_TAC[ADD_CLAUSES; GSYM ADD1; LENGTH; NOT_SUC] THEN ASM_REWRITE_TAC[poly; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; complex_pow] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC]);; let POLY_REPLICATE_APPEND = prove (`!n p x. poly (APPEND (REPLICATE n (Cx(&0))) p) x = x pow n * poly p x`, INDUCT_TAC THEN REWRITE_TAC[REPLICATE; APPEND; complex_pow; COMPLEX_MUL_LID] THEN ASM_REWRITE_TAC[poly; COMPLEX_ADD_LID] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Fundamental theorem. *) (* ------------------------------------------------------------------------- *) let FUNDAMENTAL_THEOREM_OF_ALGEBRA = prove (`!p. ~constant(poly p) ==> ?z. poly p z = Cx(&0)`, SUBGOAL_THEN `!n p. (LENGTH p = n) /\ ~constant(poly p) ==> ?z. poly p z = Cx(&0)` (fun th -> MESON_TAC[th]) THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN X_GEN_TAC `p:complex list` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP NONCONSTANT_LENGTH) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN X_CHOOSE_TAC `c:complex` (SPEC `p:complex list` POLY_MINIMUM_MODULUS) THEN ASM_CASES_TAC `poly p c = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(SPECL [`c:complex`; `p:complex list`] POLY_OFFSET) THEN DISCH_THEN(X_CHOOSE_THEN `q:complex list` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) ASSUME_TAC) THEN SUBGOAL_THEN `~constant(poly q)` ASSUME_TAC THENL [UNDISCH_TAC `~(constant(poly p))` THEN SUBGOAL_THEN `!z. poly q (z - c) = poly p z` (fun th -> MESON_TAC[th; constant]) THEN ASM_MESON_TAC[SIMPLE_COMPLEX_ARITH `a + (x - a) = x`]; ALL_TAC] THEN SUBGOAL_THEN `poly p c = poly q (Cx(&0))` SUBST_ALL_TAC THENL [ASM_MESON_TAC[COMPLEX_ADD_RID]; ALL_TAC] THEN SUBGOAL_THEN `!w. norm(poly q (Cx(&0))) <= norm(poly q w)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN POP_ASSUM_LIST(MAP_EVERY (fun th -> if free_in `p:complex list` (concl th) then ALL_TAC else ASSUME_TAC th)) THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN ABBREV_TAC `a0 = poly q (Cx(&0))` THEN SUBGOAL_THEN `!z. poly q z = poly (MAP (( * ) (inv(a0))) q) z * a0` ASSUME_TAC THENL [REWRITE_TAC[POLY_CMUL_MAP] THEN ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `(a * b) * c = b * c * a`] THEN ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_RID]; ALL_TAC] THEN ABBREV_TAC `r = MAP (( * ) (inv(a0))) q` THEN SUBGOAL_THEN `LENGTH(q:complex list) = LENGTH(r:complex list)` SUBST_ALL_TAC THENL [EXPAND_TAC "r" THEN REWRITE_TAC[LENGTH_MAP]; ALL_TAC] THEN SUBGOAL_THEN `~(constant(poly r))` ASSUME_TAC THENL [UNDISCH_TAC `~constant(poly q)` THEN ASM_REWRITE_TAC[constant; COMPLEX_EQ_MUL_RCANCEL] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `poly r (Cx(&0)) = Cx(&1)` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM COMPLEX_MUL_LID] THEN ASM_SIMP_TAC[COMPLEX_EQ_MUL_RCANCEL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MAP_EVERY (fun th -> if free_in `q:complex list` (concl th) then ALL_TAC else ASSUME_TAC th)) THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; COMPLEX_NORM_NZ; COMPLEX_NORM_MUL; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN FIRST_ASSUM(MP_TAC o MATCH_MP POLY_DECOMPOSE) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex` (X_CHOOSE_THEN `s:complex list` MP_TAC))) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) MP_TAC) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `k + 1 = n` THENL [UNDISCH_TAC `LENGTH(s:complex list) + k + 1 = n` THEN ASM_REWRITE_TAC[ARITH_RULE `(s + m = m) <=> (s = 0)`; LENGTH_EQ_NIL] THEN REWRITE_TAC[LENGTH_EQ_NIL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN MATCH_MP_TAC REDUCE_POLY_SIMPLE THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`k + 1 = n`; `2 <= n`] THEN ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `k + 1`) THEN ANTS_TAC THENL [UNDISCH_TAC `~(k + 1 = n)` THEN UNDISCH_TAC `LENGTH(s:complex list) + k + 1 = n` THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `CONS (Cx(&1)) (APPEND (REPLICATE (k - 1) (Cx(&0))) [a])`) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[LENGTH; LENGTH_APPEND; LENGTH_REPLICATE] THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[constant; POLY_REPLICATE_APPEND; poly] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(&1)`]) THEN REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_POW_ONE; SIMPLE_COMPLEX_ARITH `(a = a + b) <=> (b = Cx(&0))`] THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN REWRITE_TAC[constant; POLY_REPLICATE_APPEND; poly] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `a * b * c = (a * b) * c`] THEN REWRITE_TAC[GSYM(CONJUNCT2 complex_pow)] THEN ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> (SUC(k - 1) = k)`] THEN DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN MP_TAC(SPECL [`s:complex list`; `norm(w)`] POLY_BOUND_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(w = Cx(&0))` ASSUME_TAC THENL [UNDISCH_TAC `Cx(&1) + w pow k * a = Cx(&0)` THEN ONCE_REWRITE_TAC[TAUT `a ==> ~b <=> b ==> ~a`] THEN DISCH_THEN SUBST1_TAC THEN UNDISCH_TAC `~(k = 0)` THEN SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_ADD_RID; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN MP_TAC(SPECL [`&1`; `inv(norm(w) pow (k + 1) * m)`] REAL_DOWN2) THEN ASM_SIMP_TAC[REAL_LT_01; REAL_LT_INV_EQ; REAL_LT_MUL; REAL_POW_LT; COMPLEX_NORM_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `Cx(t) * w` THEN REWRITE_TAC[COMPLEX_POW_MUL] THEN REWRITE_TAC[COMPLEX_ADD_LDISTRIB; GSYM COMPLEX_MUL_ASSOC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SIMPLE_COMPLEX_ARITH `(a + w = Cx(&0)) ==> (w = --a)`)) THEN REWRITE_TAC[GSYM CX_NEG; GSYM CX_POW; GSYM CX_MUL] THEN REWRITE_TAC[COMPLEX_ADD_ASSOC; GSYM CX_ADD] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(Cx(&1 + t pow k * -- &1)) + norm(Cx(t pow k) * w pow k * Cx t * w * poly s (Cx t * w))` THEN REWRITE_TAC[COMPLEX_NORM_TRIANGLE] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < t /\ t <= &1 ==> abs(&1 + t * --(&1)) + x < &1`) THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN ASM_SIMP_TAC[REAL_POW_1_LE; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_POW_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_SIMP_TAC[REAL_POW_LT] THEN ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `a * b * c * d = b * (c * a) * d`] THEN REWRITE_TAC[GSYM(CONJUNCT2 complex_pow)] THEN REWRITE_TAC[COMPLEX_NORM_MUL; ADD1; COMPLEX_NORM_CX] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs t * norm(w pow (k + 1)) * m` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ARITH `&0 < t /\ t < &1 ==> abs(t) <= &1`]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL; COMPLEX_NORM_POW; REAL_POW_LT; COMPLEX_NORM_NZ] THEN ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_ARITH `&0 < t /\ t < x ==> abs(t) < x`]);; (* ------------------------------------------------------------------------- *) (* Alternative version with a syntactic notion of constant polynomial. *) (* ------------------------------------------------------------------------- *) let FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT = prove (`!p. ~(?a l. ~(a = Cx(&0)) /\ ALL (\b. b = Cx(&0)) l /\ (p = CONS a l)) ==> ?z. poly p z = Cx(&0)`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly; CONS_11] THEN POP_ASSUM_LIST(K ALL_TAC) THEN ONCE_REWRITE_TAC[AC CONJ_ACI `a /\ b /\ c /\ d <=> c /\ d /\ a /\ b`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_ADD_LID] THENL [EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 poly)] THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_ALGEBRA THEN UNDISCH_TAC `~ALL (\b. b = Cx (&0)) t` THEN REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[constant; poly; REAL_EQ_LADD] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0)` o ONCE_REWRITE_RULE[SWAP_FORALL_THM]) THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_EQ_ADD_LCANCEL] THEN REWRITE_TAC[COMPLEX_ENTIRE; TAUT `a \/ b <=> ~a ==> b`] THEN SPEC_TAC(`t:complex list`,`p:complex list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL] THEN ASM_CASES_TAC `h = Cx(&0)` THEN ASM_SIMP_TAC[poly; COMPLEX_ADD_LID; COMPLEX_ENTIRE] THEN MP_TAC(SPECL [`t:complex list`; `&1`] POLY_BOUND_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`norm(h) / m`; `&1`] REAL_DOWN2) THEN ASM_SIMP_TAC[REAL_LT_01; REAL_LT_DIV; COMPLEX_NORM_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `Cx(x)`) THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(x + y = Cx(&0)) <=> (y = --x)`] THEN DISCH_THEN(MP_TAC o AP_TERM `norm`) THEN REWRITE_TAC[COMPLEX_NORM_NEG] THEN MATCH_MP_TAC(REAL_ARITH `abs(a) < abs(b) ==> ~(a = b)`) THEN REWRITE_TAC[real_abs; COMPLEX_NORM_POS] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(h) / m * m` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_LE_REFL; REAL_DIV_RMUL; REAL_LT_IMP_NZ]] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) * m` THEN ASM_SIMP_TAC[REAL_LT_RMUL; REAL_ARITH `&0 < x /\ x < a ==> abs(x) < a`] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_ABS_POS; COMPLEX_NORM_CX; REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) <= &1`]);; hol-light/Complex/grobner_examples.ml000066400000000000000000000567141303454263000202570ustar00rootroot00000000000000(* ========================================================================= *) (* Examples of using the Grobner basis procedure. *) (* ========================================================================= *) time COMPLEX_ARITH `!a b c. (a * x pow 2 + b * x + c = Cx(&0)) /\ (a * y pow 2 + b * y + c = Cx(&0)) /\ ~(x = y) ==> (a * (x + y) + b = Cx(&0))`;; time COMPLEX_ARITH `!a b c. (a * x pow 2 + b * x + c = Cx(&0)) /\ (Cx(&2) * a * y pow 2 + Cx(&2) * b * y + Cx(&2) * c = Cx(&0)) /\ ~(x = y) ==> (a * (x + y) + b = Cx(&0))`;; (* ------------------------------------------------------------------------- *) (* Another example. *) (* ------------------------------------------------------------------------- *) time COMPLEX_ARITH `~((y_1 = Cx(&2) * y_3) /\ (y_2 = Cx(&2) * y_4) /\ (y_1 * y_3 = y_2 * y_4) /\ ((y_1 pow 2 - y_2 pow 2) * z = Cx(&1)))`;; time COMPLEX_ARITH `!y_1 y_2 y_3 y_4. (y_1 = Cx(&2) * y_3) /\ (y_2 = Cx(&2) * y_4) /\ (y_1 * y_3 = y_2 * y_4) ==> (y_1 pow 2 = y_2 pow 2)`;; (* ------------------------------------------------------------------------- *) (* Angle at centre vs. angle at circumference. *) (* Formulation from "Real quantifier elimination in practice" paper. *) (* ------------------------------------------------------------------------- *) time COMPLEX_ARITH `~((c pow 2 = a pow 2 + b pow 2) /\ (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\ (y0 * t1 = a + x0) /\ (y0 * t2 = a - x0) /\ ((Cx(&1) - t1 * t2) * t = t1 + t2) /\ (u * (b * t - a) = Cx(&1)) /\ (v1 * a + v2 * x0 + v3 * y0 = Cx(&1)))`;; time COMPLEX_ARITH `(c pow 2 = a pow 2 + b pow 2) /\ (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\ (y0 * t1 = a + x0) /\ (y0 * t2 = a - x0) /\ ((Cx(&1) - t1 * t2) * t = t1 + t2) /\ (~(a = Cx(&0)) \/ ~(x0 = Cx(&0)) \/ ~(y0 = Cx(&0))) ==> (b * t = a)`;; time COMPLEX_ARITH `(c pow 2 = a pow 2 + b pow 2) /\ (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\ (y0 * t1 = a + x0) /\ (y0 * t2 = a - x0) /\ ((Cx(&1) - t1 * t2) * t = t1 + t2) /\ (~(a = Cx(&0)) /\ ~(x0 = Cx(&0)) /\ ~(y0 = Cx(&0))) ==> (b * t = a)`;; (* ------------------------------------------------------------------------- *) (* Another example (note we rule out points 1, 2 or 3 coinciding). *) (* ------------------------------------------------------------------------- *) time COMPLEX_ARITH `((x1 - x0) pow 2 + (y1 - y0) pow 2 = (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ ((x2 - x0) pow 2 + (y2 - y0) pow 2 = (x3 - x0) pow 2 + (y3 - y0) pow 2) /\ ((x1 - x0') pow 2 + (y1 - y0') pow 2 = (x2 - x0') pow 2 + (y2 - y0') pow 2) /\ ((x2 - x0') pow 2 + (y2 - y0') pow 2 = (x3 - x0') pow 2 + (y3 - y0') pow 2) /\ (a12 * (x1 - x2) + b12 * (y1 - y2) = Cx(&1)) /\ (a13 * (x1 - x3) + b13 * (y1 - y3) = Cx(&1)) /\ (a23 * (x2 - x3) + b23 * (y2 - y3) = Cx(&1)) /\ ~((x1 - x0) pow 2 + (y1 - y0) pow 2 = Cx(&0)) ==> (x0' = x0) /\ (y0' = y0)`;; time COMPLEX_ARITH `~(((x1 - x0) pow 2 + (y1 - y0) pow 2 = (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ ((x2 - x0) pow 2 + (y2 - y0) pow 2 = (x3 - x0) pow 2 + (y3 - y0) pow 2) /\ ((x1 - x0') pow 2 + (y1 - y0') pow 2 = (x2 - x0') pow 2 + (y2 - y0') pow 2) /\ ((x2 - x0') pow 2 + (y2 - y0') pow 2 = (x3 - x0') pow 2 + (y3 - y0') pow 2) /\ (a12 * (x1 - x2) + b12 * (y1 - y2) = Cx(&1)) /\ (a13 * (x1 - x3) + b13 * (y1 - y3) = Cx(&1)) /\ (a23 * (x2 - x3) + b23 * (y2 - y3) = Cx(&1)) /\ (z * (x0' - x0) = Cx(&1)) /\ (z' * (y0' - y0) = Cx(&1)) /\ (z'' * ((x1 - x0) pow 2 + (y1 - y0) pow 2) = Cx(&1)) /\ (z''' * ((x1 - x09) pow 2 + (y1 - y09) pow 2) = Cx(&1)))`;; (* ------------------------------------------------------------------------- *) (* These are pure algebraic simplification. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_4 = time COMPLEX_ARITH `(((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2))) = ((((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2))`;; let LAGRANGE_8 = time COMPLEX_ARITH `((p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2)) = ((p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1* w2) pow 2 + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1* v2) pow 2 + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1* u2) pow 2 + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1* t2) pow 2 + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1* s2) pow 2 + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1* r2) pow 2 + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1* q2) pow 2 + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1* p2) pow 2)`;; let LIOUVILLE = time COMPLEX_ARITH `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2) = (Cx(&1 / &6) * ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) + Cx(&1 / &6) * ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4))`;; let FLECK = time COMPLEX_ARITH `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 3) = (Cx(&1 / &60) * ((x1 + x2 + x3) pow 6 + (x1 + x2 - x3) pow 6 + (x1 - x2 + x3) pow 6 + (x1 - x2 - x3) pow 6 + (x1 + x2 + x4) pow 6 + (x1 + x2 - x4) pow 6 + (x1 - x2 + x4) pow 6 + (x1 - x2 - x4) pow 6 + (x1 + x3 + x4) pow 6 + (x1 + x3 - x4) pow 6 + (x1 - x3 + x4) pow 6 + (x1 - x3 - x4) pow 6 + (x2 + x3 + x4) pow 6 + (x2 + x3 - x4) pow 6 + (x2 - x3 + x4) pow 6 + (x2 - x3 - x4) pow 6) + Cx(&1 / &30) * ((x1 + x2) pow 6 + (x1 - x2) pow 6 + (x1 + x3) pow 6 + (x1 - x3) pow 6 + (x1 + x4) pow 6 + (x1 - x4) pow 6 + (x2 + x3) pow 6 + (x2 - x3) pow 6 + (x2 + x4) pow 6 + (x2 - x4) pow 6 + (x3 + x4) pow 6 + (x3 - x4) pow 6) + Cx(&3 / &5) * (x1 pow 6 + x2 pow 6 + x3 pow 6 + x4 pow 6))`;; let HURWITZ = time COMPLEX_ARITH `!x1 x2 x3 x4. (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 4 = Cx(&1 / &840) * ((x1 + x2 + x3 + x4) pow 8 + (x1 + x2 + x3 - x4) pow 8 + (x1 + x2 - x3 + x4) pow 8 + (x1 + x2 - x3 - x4) pow 8 + (x1 - x2 + x3 + x4) pow 8 + (x1 - x2 + x3 - x4) pow 8 + (x1 - x2 - x3 + x4) pow 8 + (x1 - x2 - x3 - x4) pow 8) + Cx(&1 / &5040) * ((Cx(&2) * x1 + x2 + x3) pow 8 + (Cx(&2) * x1 + x2 - x3) pow 8 + (Cx(&2) * x1 - x2 + x3) pow 8 + (Cx(&2) * x1 - x2 - x3) pow 8 + (Cx(&2) * x1 + x2 + x4) pow 8 + (Cx(&2) * x1 + x2 - x4) pow 8 + (Cx(&2) * x1 - x2 + x4) pow 8 + (Cx(&2) * x1 - x2 - x4) pow 8 + (Cx(&2) * x1 + x3 + x4) pow 8 + (Cx(&2) * x1 + x3 - x4) pow 8 + (Cx(&2) * x1 - x3 + x4) pow 8 + (Cx(&2) * x1 - x3 - x4) pow 8 + (Cx(&2) * x2 + x3 + x4) pow 8 + (Cx(&2) * x2 + x3 - x4) pow 8 + (Cx(&2) * x2 - x3 + x4) pow 8 + (Cx(&2) * x2 - x3 - x4) pow 8 + (x1 + Cx(&2) * x2 + x3) pow 8 + (x1 + Cx(&2) * x2 - x3) pow 8 + (x1 - Cx(&2) * x2 + x3) pow 8 + (x1 - Cx(&2) * x2 - x3) pow 8 + (x1 + Cx(&2) * x2 + x4) pow 8 + (x1 + Cx(&2) * x2 - x4) pow 8 + (x1 - Cx(&2) * x2 + x4) pow 8 + (x1 - Cx(&2) * x2 - x4) pow 8 + (x1 + Cx(&2) * x3 + x4) pow 8 + (x1 + Cx(&2) * x3 - x4) pow 8 + (x1 - Cx(&2) * x3 + x4) pow 8 + (x1 - Cx(&2) * x3 - x4) pow 8 + (x2 + Cx(&2) * x3 + x4) pow 8 + (x2 + Cx(&2) * x3 - x4) pow 8 + (x2 - Cx(&2) * x3 + x4) pow 8 + (x2 - Cx(&2) * x3 - x4) pow 8 + (x1 + x2 + Cx(&2) * x3) pow 8 + (x1 + x2 - Cx(&2) * x3) pow 8 + (x1 - x2 + Cx(&2) * x3) pow 8 + (x1 - x2 - Cx(&2) * x3) pow 8 + (x1 + x2 + Cx(&2) * x4) pow 8 + (x1 + x2 - Cx(&2) * x4) pow 8 + (x1 - x2 + Cx(&2) * x4) pow 8 + (x1 - x2 - Cx(&2) * x4) pow 8 + (x1 + x3 + Cx(&2) * x4) pow 8 + (x1 + x3 - Cx(&2) * x4) pow 8 + (x1 - x3 + Cx(&2) * x4) pow 8 + (x1 - x3 - Cx(&2) * x4) pow 8 + (x2 + x3 + Cx(&2) * x4) pow 8 + (x2 + x3 - Cx(&2) * x4) pow 8 + (x2 - x3 + Cx(&2) * x4) pow 8 + (x2 - x3 - Cx(&2) * x4) pow 8) + Cx(&1 / &84) * ((x1 + x2) pow 8 + (x1 - x2) pow 8 + (x1 + x3) pow 8 + (x1 - x3) pow 8 + (x1 + x4) pow 8 + (x1 - x4) pow 8 + (x2 + x3) pow 8 + (x2 - x3) pow 8 + (x2 + x4) pow 8 + (x2 - x4) pow 8 + (x3 + x4) pow 8 + (x3 - x4) pow 8) + Cx(&1 / &840) * ((Cx(&2) * x1) pow 8 + (Cx(&2) * x2) pow 8 + (Cx(&2) * x3) pow 8 + (Cx(&2) * x4) pow 8)`;; let SCHUR = time COMPLEX_ARITH `Cx(&22680) * (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 5 = Cx(&9) * ((Cx(&2) * x1) pow 10 + (Cx(&2) * x2) pow 10 + (Cx(&2) * x3) pow 10 + (Cx(&2) * x4) pow 10) + Cx(&180) * ((x1 + x2) pow 10 + (x1 - x2) pow 10 + (x1 + x3) pow 10 + (x1 - x3) pow 10 + (x1 + x4) pow 10 + (x1 - x4) pow 10 + (x2 + x3) pow 10 + (x2 - x3) pow 10 + (x2 + x4) pow 10 + (x2 - x4) pow 10 + (x3 + x4) pow 10 + (x3 - x4) pow 10) + ((Cx(&2) * x1 + x2 + x3) pow 10 + (Cx(&2) * x1 + x2 - x3) pow 10 + (Cx(&2) * x1 - x2 + x3) pow 10 + (Cx(&2) * x1 - x2 - x3) pow 10 + (Cx(&2) * x1 + x2 + x4) pow 10 + (Cx(&2) * x1 + x2 - x4) pow 10 + (Cx(&2) * x1 - x2 + x4) pow 10 + (Cx(&2) * x1 - x2 - x4) pow 10 + (Cx(&2) * x1 + x3 + x4) pow 10 + (Cx(&2) * x1 + x3 - x4) pow 10 + (Cx(&2) * x1 - x3 + x4) pow 10 + (Cx(&2) * x1 - x3 - x4) pow 10 + (Cx(&2) * x2 + x3 + x4) pow 10 + (Cx(&2) * x2 + x3 - x4) pow 10 + (Cx(&2) * x2 - x3 + x4) pow 10 + (Cx(&2) * x2 - x3 - x4) pow 10 + (x1 + Cx(&2) * x2 + x3) pow 10 + (x1 + Cx(&2) * x2 - x3) pow 10 + (x1 - Cx(&2) * x2 + x3) pow 10 + (x1 - Cx(&2) * x2 - x3) pow 10 + (x1 + Cx(&2) * x2 + x4) pow 10 + (x1 + Cx(&2) * x2 - x4) pow 10 + (x1 - Cx(&2) * x2 + x4) pow 10 + (x1 - Cx(&2) * x2 - x4) pow 10 + (x1 + Cx(&2) * x3 + x4) pow 10 + (x1 + Cx(&2) * x3 - x4) pow 10 + (x1 - Cx(&2) * x3 + x4) pow 10 + (x1 - Cx(&2) * x3 - x4) pow 10 + (x2 + Cx(&2) * x3 + x4) pow 10 + (x2 + Cx(&2) * x3 - x4) pow 10 + (x2 - Cx(&2) * x3 + x4) pow 10 + (x2 - Cx(&2) * x3 - x4) pow 10 + (x1 + x2 + Cx(&2) * x3) pow 10 + (x1 + x2 - Cx(&2) * x3) pow 10 + (x1 - x2 + Cx(&2) * x3) pow 10 + (x1 - x2 - Cx(&2) * x3) pow 10 + (x1 + x2 + Cx(&2) * x4) pow 10 + (x1 + x2 - Cx(&2) * x4) pow 10 + (x1 - x2 + Cx(&2) * x4) pow 10 + (x1 - x2 - Cx(&2) * x4) pow 10 + (x1 + x3 + Cx(&2) * x4) pow 10 + (x1 + x3 - Cx(&2) * x4) pow 10 + (x1 - x3 + Cx(&2) * x4) pow 10 + (x1 - x3 - Cx(&2) * x4) pow 10 + (x2 + x3 + Cx(&2) * x4) pow 10 + (x2 + x3 - Cx(&2) * x4) pow 10 + (x2 - x3 + Cx(&2) * x4) pow 10 + (x2 - x3 - Cx(&2) * x4) pow 10) + Cx(&9) * ((x1 + x2 + x3 + x4) pow 10 + (x1 + x2 + x3 - x4) pow 10 + (x1 + x2 - x3 + x4) pow 10 + (x1 + x2 - x3 - x4) pow 10 + (x1 - x2 + x3 + x4) pow 10 + (x1 - x2 + x3 - x4) pow 10 + (x1 - x2 - x3 + x4) pow 10 + (x1 - x2 - x3 - x4) pow 10)`;; (* ------------------------------------------------------------------------- *) (* Intersection of diagonals of a parallelogram is their midpoint. *) (* Kapur "...Dixon resultants, Groebner Bases, and Characteristic Sets", 3.1 *) (* ------------------------------------------------------------------------- *) time COMPLEX_ARITH `(x1 = u3) /\ (x1 * (u2 - u1) = x2 * u3) /\ (x4 * (x2 - u1) = x1 * (x3 - u1)) /\ (x3 * u3 = x4 * u2) /\ ~(u1 = Cx(&0)) /\ ~(u3 = Cx(&0)) ==> (x3 pow 2 + x4 pow 2 = (u2 - x3) pow 2 + (u3 - x4) pow 2)`;; (* ------------------------------------------------------------------------- *) (* Chou's formulation of same property. *) (* ------------------------------------------------------------------------- *) time COMPLEX_ARITH `(u1 * x1 - u1 * u3 = Cx(&0)) /\ (u3 * x2 - (u2 - u1) * x1 = Cx(&0)) /\ (x1 * x4 - (x2 - u1) * x3 - u1 * x1 = Cx(&0)) /\ (u3 * x4 - u2 * x3 = Cx(&0)) /\ ~(u1 = Cx(&0)) /\ ~(u3 = Cx(&0)) ==> (Cx(&2) * u2 * x4 + Cx(&2) * u3 * x3 - u3 pow 2 - u2 pow 2 = Cx(&0))`;; (* ------------------------------------------------------------------------- *) (* Perpendicular lines property; from Kapur's earlier paper. *) (* ------------------------------------------------------------------------- *) time COMPLEX_ARITH `(y1 * y3 + x1 * x3 = Cx(&0)) /\ (y3 * (y2 - y3) + (x2 - x3) * x3 = Cx(&0)) /\ ~(x3 = Cx(&0)) /\ ~(y3 = Cx(&0)) ==> (y1 * (x2 - x3) = x1 * (y2 - y3))`;; (* ------------------------------------------------------------------------- *) (* Simson's theorem (Chou, p7). *) (* ------------------------------------------------------------------------- *) time COMPLEX_ARITH `(Cx(&2) * u2 * x2 + Cx(&2) * u3 * x1 - u3 pow 2 - u2 pow 2 = Cx(&0)) /\ (Cx(&2) * u1 * x2 - u1 pow 2 = Cx(&0)) /\ (--(x3 pow 2) + Cx(&2) * x2 * x3 + Cx(&2) * u4 * x1 - u4 pow 2 = Cx(&0)) /\ (u3 * x5 + (--u2 + u1) * x4 - u1 * u3 = Cx(&0)) /\ ((u2 - u1) * x5 + u3 * x4 + (--u2 + u1) * x3 - u3 * u4 = Cx(&0)) /\ (u3 * x7 - u2 * x6 = Cx(&0)) /\ (u2 * x7 + u3 * x6 - u2 * x3 - u3 * u4 = Cx(&0)) /\ ~(Cx(&4) * u1 * u3 = Cx(&0)) /\ ~(Cx(&2) * u1 = Cx(&0)) /\ ~(--(u3 pow 2) - u2 pow 2 + Cx(&2) * u1 * u2 - u1 pow 2 = Cx(&0)) /\ ~(u3 = Cx(&0)) /\ ~(--(u3 pow 2) - u2 pow 2 = Cx(&0)) /\ ~(u2 = Cx(&0)) ==> (x4 * x7 + (--x5 + x3) * x6 - x3 * x4 = Cx(&0))`;; (* ------------------------------------------------------------------------- *) (* Determinants from Coq convex hull paper (some require reals or order). *) (* ------------------------------------------------------------------------- *) let det3 = new_definition `det3(a11,a12,a13, a21,a22,a23, a31,a32,a33) = a11 * (a22 * a33 - a32 * a23) - a12 * (a21 * a33 - a31 * a23) + a13 * (a21 * a32 - a31 * a22)`;; let DET_TRANSPOSE = prove (`det3(a1,b1,c1,a2,b2,c2,a3,b3,c3) = det3(a1,a2,a3,b1,b2,b3,c1,c2,c3)`, REWRITE_TAC[det3] THEN CONV_TAC(time COMPLEX_ARITH));; let sdet3 = new_definition `sdet3(p,q,r) = det3(FST p,SND p,Cx(&1), FST q,SND q,Cx(&1), FST r,SND r,Cx(&1))`;; let SDET3_PERMUTE_1 = prove (`sdet3(p,q,r) = sdet3(q,r,p)`, REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; let SDET3_PERMUTE_2 = prove (`sdet3(p,q,r) = --(sdet3(p,r,q))`, REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; let SDET_SUM = prove (`sdet3(p,q,r) - sdet3(t,q,r) - sdet3(p,t,r) - sdet3(p,q,t) = Cx(&0)`, REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; let SDET_CRAMER = prove (`sdet3(s,t,q) * sdet3(t,p,r) = sdet3(t,q,r) * sdet3(s,t,p) + sdet3(t,p,q) * sdet3(s,t,r)`, REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; let SDET_NZ = prove (`!p q r. ~(sdet3(p,q,r) = Cx(&0)) ==> ~(p = q) /\ ~(q = r) /\ ~(r = p)`, REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ; sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; let SDET_LINCOMB = prove (`(FST p * sdet3(i,j,k) = FST i * sdet3(j,k,p) + FST j * sdet3(k,i,p) + FST k * sdet3(i,j,p)) /\ (SND p * sdet3(i,j,k) = SND i * sdet3(j,k,p) + SND j * sdet3(k,i,p) + SND k * sdet3(i,j,p))`, REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; (***** I'm not sure if this is true; there must be some sufficient degenerate conditions.... let th = prove (`~(~(xp pow 2 + yp pow 2 = Cx(&0)) /\ ~(xq pow 2 + yq pow 2 = Cx(&0)) /\ ~(xr pow 2 + yr pow 2 = Cx(&0)) /\ (det3(xp,yp,Cx(&1), xq,yq,Cx(&1), xr,yr,Cx(&1)) = Cx(&0)) /\ (det3(yp,xp pow 2 + yp pow 2,Cx(&1), yq,xq pow 2 + yq pow 2,Cx(&1), yr,xr pow 2 + yr pow 2,Cx(&1)) = Cx(&0)) /\ (det3(xp,xp pow 2 + yp pow 2,Cx(&1), xq,xq pow 2 + yq pow 2,Cx(&1), xr,xr pow 2 + yr pow 2,Cx(&1)) = Cx(&0)))`, REWRITE_TAC[det3] THEN CONV_TAC(time COMPLEX_ARITH));; ***************) (* ------------------------------------------------------------------------- *) (* Some geometry concepts (just "axiomatic" in this file). *) (* ------------------------------------------------------------------------- *) prioritize_real();; let collinear = new_definition `collinear (a:real#real) b c <=> ((FST a - FST b) * (SND b - SND c) = (SND a - SND b) * (FST b - FST c))`;; let parallel = new_definition `parallel (a,b) (c,d) <=> ((FST a - FST b) * (SND c - SND d) = (SND a - SND b) * (FST c - FST d))`;; let perpendicular = new_definition `perpendicular (a,b) (c,d) <=> ((FST a - FST b) * (FST c - FST d) + (SND a - SND b) * (SND c - SND d) = &0)`;; let oncircle_with_diagonal = new_definition `oncircle_with_diagonal a (b,c) = perpendicular (b,a) (c,a)`;; let length = new_definition `length (a,b) = sqrt((FST a - FST b) pow 2 + (SND a - SND b) pow 2)`;; let lengths_eq = new_definition `lengths_eq (a,b) (c,d) <=> ((FST a - FST b) pow 2 + (SND a - SND b) pow 2 = (FST c - FST d) pow 2 + (SND c - SND d) pow 2)`;; let is_midpoint = new_definition `is_midpoint b (a,c) <=> (&2 * FST b = FST a + FST c) /\ (&2 * SND b = SND a + SND c)`;; (* ------------------------------------------------------------------------- *) (* Chou isn't explicit about this. *) (* ------------------------------------------------------------------------- *) let is_intersection = new_definition `is_intersection p (a,b) (c,d) <=> collinear a p b /\ collinear c p d`;; (* ------------------------------------------------------------------------- *) (* This is used in some degenerate conditions. See Chou, p18. *) (* ------------------------------------------------------------------------- *) let isotropic = new_definition `isotropic (a,b) = perpendicular (a,b) (a,b)`;; (* ------------------------------------------------------------------------- *) (* This increases degree, but sometimes makes complex assertion useful. *) (* ------------------------------------------------------------------------- *) let distinctpairs = new_definition `distinctpairs pprs <=> ~(ITLIST (\(a,b) pr. ((FST a - FST b) pow 2 + (SND a - SND b) pow 2) * pr) pprs (&1) = &0)`;; (* ------------------------------------------------------------------------- *) (* Simple tactic to remove defined concepts and expand coordinates. *) (* ------------------------------------------------------------------------- *) let (EXPAND_COORDS_TAC:tactic) = let complex2_ty = `:real#real` in fun (asl,w) -> (let fvs = filter (fun v -> type_of v = complex2_ty) (frees w) in MAP_EVERY (fun v -> SPEC_TAC(v,v)) fvs THEN GEN_REWRITE_TAC DEPTH_CONV [FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN REPEAT GEN_TAC) (asl,w);; let PAIR_BETA_THM = prove (`(\(x,y). P x y) (a,b) = P a b`, CONV_TAC(LAND_CONV GEN_BETA_CONV) THEN REFL_TAC);; let GEOM_TAC = EXPAND_COORDS_TAC THEN GEN_REWRITE_TAC TOP_DEPTH_CONV [collinear; parallel; perpendicular; oncircle_with_diagonal; length; lengths_eq; is_midpoint; is_intersection; distinctpairs; isotropic; ITLIST; PAIR_BETA_THM; BETA_THM; PAIR_EQ; FST; SND];; (* ------------------------------------------------------------------------- *) (* Centroid (Chou, example 142). *) (* ------------------------------------------------------------------------- *) let CENTROID = time prove (`is_midpoint d (b,c) /\ is_midpoint e (a,c) /\ is_midpoint f (a,b) /\ is_intersection m (b,e) (a,d) ==> collinear c f m`, GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; (* ------------------------------------------------------------------------- *) (* Gauss's theorem (Chou, example 15). *) (* ------------------------------------------------------------------------- *) let GAUSS = time prove (`collinear x a0 a3 /\ collinear x a1 a2 /\ collinear y a2 a3 /\ collinear y a1 a0 /\ is_midpoint m1 (a1,a3) /\ is_midpoint m2 (a0,a2) /\ is_midpoint m3 (x,y) ==> collinear m1 m2 m3`, GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; (* ------------------------------------------------------------------------- *) (* Simson's theorem (Chou, example 288). *) (* ------------------------------------------------------------------------- *) (**** These are all hideously slow. At least the first one works. I haven't had the patience to try the rest. let SIMSON = time prove (`lengths_eq (O,a) (O,b) /\ lengths_eq (O,a) (O,c) /\ lengths_eq (d,O) (O,a) /\ perpendicular (e,d) (b,c) /\ collinear e b c /\ perpendicular (f,d) (a,c) /\ collinear f a c /\ perpendicular (g,d) (a,b) /\ collinear g a b /\ ~(collinear a c b) /\ ~(lengths_eq (a,b) (a,a)) /\ ~(lengths_eq (a,c) (a,a)) /\ ~(lengths_eq (b,c) (a,a)) ==> collinear e f g`, GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; let SIMSON = time prove (`lengths_eq (O,a) (O,b) /\ lengths_eq (O,a) (O,c) /\ lengths_eq (d,O) (O,a) /\ perpendicular (e,d) (b,c) /\ collinear e b c /\ perpendicular (f,d) (a,c) /\ collinear f a c /\ perpendicular (g,d) (a,b) /\ collinear g a b /\ ~(a = b) /\ ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d) /\ ~(c = d) ==> collinear e f g`, GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; let SIMSON = time prove (`lengths_eq (O,a) (O,b) /\ lengths_eq (O,a) (O,c) /\ lengths_eq (d,O) (O,a) /\ perpendicular (e,d) (b,c) /\ collinear e b c /\ perpendicular (f,d) (a,c) /\ collinear f a c /\ perpendicular (g,d) (a,b) /\ collinear g a b /\ ~(collinear a c b) /\ ~(isotropic (a,b)) /\ ~(isotropic (a,c)) /\ ~(isotropic (b,c)) /\ ~(isotropic (a,d)) /\ ~(isotropic (b,d)) /\ ~(isotropic (c,d)) ==> collinear e f g`, GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; ****************) hol-light/Complex/make.ml000066400000000000000000000017231303454263000156260ustar00rootroot00000000000000needs "Library/analysis.ml";; (* Basic real analysis *) needs "Library/transc.ml";; (* Real transcendental functions *) needs "Library/floor.ml";; (* Floor and frac functions *) needs "Complex/complexnumbers.ml";; (* Basic complex number defs *) needs "Complex/complex_transc.ml";; (* Complex transcendental functions *) needs "Complex/cpoly.ml";; (* Complex polynomials *) needs "Complex/fundamental.ml";; (* Fundamental theorem of algebra *) needs "Complex/quelim.ml";; (* Quantifier elimination algorithm *) needs "Complex/complex_grobner.ml";; (* Grobner bases with HOL proofs *) needs "Complex/complex_real.ml";; (* Special case of reals *) needs "Complex/quelim_examples.ml";; (* Examples of using quantifier elim *) needs "Complex/grobner_examples.ml";; (* Examples of using Grobner bases *) hol-light/Complex/quelim.ml000066400000000000000000001221121303454263000162010ustar00rootroot00000000000000(* ========================================================================= *) (* Naive quantifier elimination for complex numbers. *) (* ========================================================================= *) needs "Complex/fundamental.ml";; let NULLSTELLENSATZ_LEMMA = prove (`!n p q. (!x. (poly p x = Cx(&0)) ==> (poly q x = Cx(&0))) /\ (degree p = n) /\ ~(n = 0) ==> p divides (q exp n)`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`p:complex list`; `q:complex list`] THEN ASM_CASES_TAC `?a. poly p a = Cx(&0)` THENL [ALL_TAC; DISCH_THEN(K ALL_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[TAUT `a ==> b <=> ~b ==> ~a`] FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:complex`; `zeros:complex list`] THEN STRIP_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[inv(k)] ** q exp n` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN X_GEN_TAC `z:complex` THEN ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_RINV; COMPLEX_MUL_LID; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; POLY_0]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [ORDER_ROOT] THEN ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[DEGREE_ZERO] THEN MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`p:complex list`; `a:complex`; `order a p`] ORDER) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_DEGREE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:complex`) THEN REWRITE_TAC[ASSUME `poly p a = Cx(&0)`] THEN REWRITE_TAC[POLY_LINEAR_DIVIDES] THEN ASM_CASES_TAC `q:complex list = []` THENL [DISCH_TAC THEN MATCH_MP_TAC POLY_DIVIDES_ZERO THEN UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp] THEN DISCH_TAC THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_LZERO; poly]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:complex list` SUBST_ALL_TAC) THEN UNDISCH_TAC `[--a; Cx (&1)] exp (order a p) divides p` THEN GEN_REWRITE_TAC LAND_CONV [divides] THEN DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN SUBGOAL_THEN `~(poly s = poly [])` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `~(poly p = poly [])` THEN ASM_REWRITE_TAC[POLY_ENTIRE]; ALL_TAC] THEN ASM_CASES_TAC `degree s = 0` THENL [SUBGOAL_THEN `?k. ~(k = Cx(&0)) /\ (poly s = poly [k])` MP_TAC THENL [EXISTS_TAC `LAST(normalize s)` THEN ASM_SIMP_TAC[NORMAL_NORMALIZE; GSYM POLY_NORMALIZE_ZERO] THEN GEN_REWRITE_TAC LAND_CONV [GSYM POLY_NORMALIZE] THEN UNDISCH_TAC `degree s = 0` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [POLY_NORMALIZE_ZERO]) THEN REWRITE_TAC[degree] THEN SPEC_TAC(`normalize s`,`s:complex list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL] THEN REWRITE_TAC[LENGTH; PRE; poly; LAST] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:complex` STRIP_ASSUME_TAC) THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[inv(k)] ** [--a; Cx (&1)] exp (n - order a p) ** r exp n` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_EXP; COMPLEX_POW_MUL] THEN X_GEN_TAC `z:complex` THEN ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `(a * b) * c * d * e = ((d * a) * (c * b)) * e`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN ASM_SIMP_TAC[SUB_ADD] THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN ASM_SIMP_TAC[COMPLEX_MUL_LINV; COMPLEX_MUL_RID]; ALL_TAC] THEN SUBGOAL_THEN `degree s < n` ASSUME_TAC THENL [EXPAND_TAC "n" THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN REWRITE_TAC[LINEAR_POW_MUL_DEGREE] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(order a p = 0)` THEN ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `degree s`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`s:complex list`; `r:complex list`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN UNDISCH_TAC `!x. (poly p x = Cx(&0)) ==> (poly([--a; Cx (&1)] ** r) x = Cx(&0))` THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[POLY_MUL; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_ENTIRE] THEN MATCH_MP_TAC(TAUT `~a ==> (a \/ b ==> b)`) THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(--a + z * Cx(&1) = Cx(&0)) <=> (z = a)`] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `poly s a = Cx (&0)` THEN ASM_REWRITE_TAC[POLY_LINEAR_DIVIDES; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `u:complex list` SUBST_ALL_TAC) THEN UNDISCH_TAC `~([--a; Cx (&1)] exp SUC (order a p) divides p)` THEN REWRITE_TAC[divides] THEN EXISTS_TAC `u:complex list` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[POLY_MUL; poly_exp; COMPLEX_MUL_AC; FUN_EQ_THM]; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `u:complex list` ASSUME_TAC) THEN EXISTS_TAC `u ** [--a; Cx(&1)] exp (n - order a p) ** r exp (n - degree s)` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_EXP; COMPLEX_POW_MUL] THEN X_GEN_TAC `z:complex` THEN ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `(ap * s) * u * anp * rns = (anp * ap) * rns * s * u`] THEN REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN ASM_SIMP_TAC[SUB_ADD] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM POLY_MUL] THEN SUBST1_TAC(SYM(ASSUME `poly (r exp degree s) = poly (s ** u)`)) THEN REWRITE_TAC[POLY_EXP; GSYM COMPLEX_POW_ADD] THEN ASM_SIMP_TAC[SUB_ADD; LT_IMP_LE]);; let NULLSTELLENSATZ_UNIVARIATE = prove (`!p q. (!x. (poly p x = Cx(&0)) ==> (poly q x = Cx(&0))) <=> p divides (q exp (degree p)) \/ ((poly p = poly []) /\ (poly q = poly []))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THENL [ASM_REWRITE_TAC[poly] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN REWRITE_TAC[degree; normalize; LENGTH; ARITH; poly_exp] THEN ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH]; ALL_TAC] THEN ASM_CASES_TAC `degree p = 0` THENL [ALL_TAC; MP_TAC(SPECL [`degree p`; `p:complex list`; `q:complex list`] NULLSTELLENSATZ_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EQ_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL] THEN DISCH_THEN(CHOOSE_THEN (MP_TAC o SPEC `z:complex`)) THEN ASM_REWRITE_TAC[POLY_EXP; COMPLEX_MUL_LZERO; COMPLEX_POW_EQ_0]] THEN ASM_REWRITE_TAC[poly_exp] THEN SUBGOAL_THEN `?k. ~(k = Cx(&0)) /\ (poly p = poly [k])` MP_TAC THENL [SUBST1_TAC(SYM(SPEC `p:complex list` POLY_NORMALIZE)) THEN EXISTS_TAC `LAST(normalize p)` THEN ASM_SIMP_TAC[NORMAL_NORMALIZE; GSYM POLY_NORMALIZE_ZERO] THEN GEN_REWRITE_TAC LAND_CONV [GSYM POLY_NORMALIZE] THEN UNDISCH_TAC `degree p = 0` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [POLY_NORMALIZE_ZERO]) THEN REWRITE_TAC[degree] THEN SPEC_TAC(`normalize p`,`p:complex list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL] THEN REWRITE_TAC[LENGTH; PRE; poly; LAST] THEN SIMP_TAC[LENGTH_EQ_NIL; POLY_NORMALIZE]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:complex` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[divides; poly; FUN_EQ_THM; POLY_MUL] THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN EXISTS_TAC `[inv(k)]` THEN ASM_REWRITE_TAC[divides; poly; FUN_EQ_THM; POLY_MUL] THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN ASM_SIMP_TAC[COMPLEX_MUL_RINV]);; (* ------------------------------------------------------------------------- *) (* Useful lemma I should have proved ages ago. *) (* ------------------------------------------------------------------------- *) let CONSTANT_DEGREE = prove (`!p. constant(poly p) <=> (degree p = 0)`, GEN_TAC THEN REWRITE_TAC[constant] THEN EQ_TAC THENL [DISCH_THEN(ASSUME_TAC o GSYM o SPEC `Cx(&0)`) THEN SUBGOAL_THEN `degree [poly p (Cx(&0))] = 0` MP_TAC THENL [REWRITE_TAC[degree; normalize] THEN COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `(x = y) ==> (x = 0) ==> (y = 0)`) THEN MATCH_MP_TAC DEGREE_WELLDEF THEN REWRITE_TAC[FUN_EQ_THM; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN FIRST_ASSUM(ACCEPT_TAC o GSYM); ONCE_REWRITE_TAC[GSYM POLY_NORMALIZE] THEN REWRITE_TAC[degree] THEN SPEC_TAC(`normalize p`,`l:complex list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[poly] THEN SIMP_TAC[LENGTH; PRE; LENGTH_EQ_NIL; poly; COMPLEX_MUL_RZERO]]);; (* ------------------------------------------------------------------------- *) (* It would be nicer to prove this without using algebraic closure... *) (* ------------------------------------------------------------------------- *) let DIVIDES_DEGREE_LEMMA = prove (`!n p q. (degree(p) = n) ==> n <= degree(p ** q) \/ (poly(p ** q) = poly [])`, INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `p:complex list` FUNDAMENTAL_THEOREM_OF_ALGEBRA) THEN ASM_REWRITE_TAC[CONSTANT_DEGREE; NOT_SUC] THEN DISCH_THEN(X_CHOOSE_THEN `a:complex` MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THENL [REWRITE_TAC[POLY_MUL; poly; COMPLEX_MUL_LZERO; FUN_EQ_THM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `r:complex list` SUBST_ALL_TAC) THEN SUBGOAL_THEN `poly (([--a; Cx (&1)] ** r) ** q) = poly ([--a; Cx (&1)] ** (r ** q))` ASSUME_TAC THENL [REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPECL [`r ** q`; `--a`] LINEAR_MUL_DEGREE) THEN ASM_CASES_TAC `poly (r ** q) = poly []` THENL [REWRITE_TAC[FUN_EQ_THM] THEN ONCE_REWRITE_TAC[POLY_MUL] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `n <= degree(r ** q) \/ (poly(r ** q) = poly [])` MP_TAC THENL [ALL_TAC; REWRITE_TAC[ARITH_RULE `SUC n <= m + 1 <=> n <= m`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FUN_EQ_THM] THEN ONCE_REWRITE_TAC[POLY_MUL] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO]] THEN MP_TAC(SPECL [`r:complex list`; `--a`] LINEAR_MUL_DEGREE) THEN ANTS_TAC THENL [UNDISCH_TAC `~(poly (r ** q) = poly [])` THEN REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN SIMP_TAC[poly; FUN_EQ_THM; POLY_MUL; COMPLEX_ENTIRE]; ALL_TAC] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `degree r + 1 = SUC n` THEN ARITH_TAC);; let DIVIDES_DEGREE = prove (`!p q. p divides q ==> degree(p) <= degree(q) \/ (poly q = poly [])`, REPEAT GEN_TAC THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:complex list` THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIVIDES_DEGREE_LEMMA]);; (* ------------------------------------------------------------------------- *) (* Arithmetic operations on multivariate polynomials. *) (* ------------------------------------------------------------------------- *) let MPOLY_BASE_CONV = let pth_0 = prove (`Cx(&0) = poly [] x`, REWRITE_TAC[poly]) and pth_1 = prove (`c = poly [c] x`, REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) and pth_var = prove (`x = poly [Cx(&0); Cx(&1)] x`, REWRITE_TAC[poly; COMPLEX_ADD_LID; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_RID]) and zero_tm = `Cx(&0)` and c_tm = `c:complex` and x_tm = `x:complex` in let rec MPOLY_BASE_CONV avs tm = if avs = [] then REFL tm else if tm = zero_tm then INST [hd avs,x_tm] pth_0 else if tm = hd avs then let th1 = INST [tm,x_tm] pth_var in let th2 = (LAND_CONV (COMB2_CONV (RAND_CONV (MPOLY_BASE_CONV (tl avs))) (LAND_CONV (MPOLY_BASE_CONV (tl avs))))) (rand(concl th1)) in TRANS th1 th2 else let th1 = MPOLY_BASE_CONV (tl avs) tm in let th2 = INST [hd avs,x_tm; rand(concl th1),c_tm] pth_1 in TRANS th1 th2 in MPOLY_BASE_CONV;; let MPOLY_NORM_CONV = let pth_0 = prove (`poly [Cx(&0)] x = poly [] x`, REWRITE_TAC[poly; COMPLEX_ADD_RID; COMPLEX_MUL_RZERO]) and pth_1 = prove (`poly [poly [] y] x = poly [] x`, REWRITE_TAC[poly; COMPLEX_ADD_RID; COMPLEX_MUL_RZERO]) in let conv_fwd = REWR_CONV(CONJUNCT2 poly) and conv_bck = REWR_CONV(GSYM(CONJUNCT2 poly)) and conv_0 = GEN_REWRITE_CONV I [pth_0] and conv_1 = GEN_REWRITE_CONV I [pth_1] in let rec NORM0_CONV tm = (conv_0 ORELSEC (conv_fwd THENC RAND_CONV(RAND_CONV NORM0_CONV) THENC conv_bck THENC TRY_CONV NORM0_CONV)) tm and NORM1_CONV tm = (conv_1 ORELSEC (conv_fwd THENC RAND_CONV(RAND_CONV NORM1_CONV) THENC conv_bck THENC TRY_CONV NORM1_CONV)) tm in fun avs -> TRY_CONV(if avs = [] then NORM0_CONV else NORM1_CONV);; let MPOLY_ADD_CONV,MPOLY_TADD_CONV = let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES)) and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)] and add_conv = REWR_CONV(GSYM POLY_ADD) in let rec MPOLY_ADD_CONV avs tm = if avs = [] then COMPLEX_RAT_ADD_CONV tm else (add_conv THENC LAND_CONV(MPOLY_TADD_CONV avs) THENC MPOLY_NORM_CONV (tl avs)) tm and MPOLY_TADD_CONV avs tm = (add_conv0 ORELSEC (add_conv1 THENC LAND_CONV (MPOLY_ADD_CONV (tl avs)) THENC RAND_CONV (MPOLY_TADD_CONV avs))) tm in MPOLY_ADD_CONV,MPOLY_TADD_CONV;; let MPOLY_CMUL_CONV,MPOLY_TCMUL_CONV,MPOLY_MUL_CONV,MPOLY_TMUL_CONV = let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul] and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul] and cmul_conv = REWR_CONV(GSYM POLY_CMUL) and mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES] and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)] and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)] and mul_conv = REWR_CONV(GSYM POLY_MUL) in let rec MPOLY_CMUL_CONV avs tm = (cmul_conv THENC LAND_CONV(MPOLY_TCMUL_CONV avs)) tm and MPOLY_TCMUL_CONV avs tm = (cmul_conv0 ORELSEC (cmul_conv1 THENC LAND_CONV (MPOLY_MUL_CONV (tl avs)) THENC RAND_CONV (MPOLY_TCMUL_CONV avs))) tm and MPOLY_MUL_CONV avs tm = if avs = [] then COMPLEX_RAT_MUL_CONV tm else (mul_conv THENC LAND_CONV(MPOLY_TMUL_CONV avs)) tm and MPOLY_TMUL_CONV avs tm = (mul_conv0 ORELSEC (mul_conv1 THENC MPOLY_TCMUL_CONV avs) ORELSEC (mul_conv2 THENC COMB2_CONV (RAND_CONV(MPOLY_TCMUL_CONV avs)) (COMB2_CONV (RAND_CONV(MPOLY_BASE_CONV (tl avs))) (MPOLY_TMUL_CONV avs)) THENC MPOLY_TADD_CONV avs)) tm in MPOLY_CMUL_CONV,MPOLY_TCMUL_CONV,MPOLY_MUL_CONV,MPOLY_TMUL_CONV;; let MPOLY_SUB_CONV = let pth = prove (`(poly p x - poly q x) = (poly p x + Cx(--(&1)) * poly q x)`, SIMPLE_COMPLEX_ARITH_TAC) in let APPLY_PTH_CONV = REWR_CONV pth in fun avs -> APPLY_PTH_CONV THENC RAND_CONV(LAND_CONV (MPOLY_BASE_CONV (tl avs)) THENC MPOLY_CMUL_CONV avs) THENC MPOLY_ADD_CONV avs;; let MPOLY_POW_CONV = let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 complex_pow] and cnv_1 = GEN_REWRITE_CONV I [CONJUNCT2 complex_pow] in let rec MPOLY_POW_CONV avs tm = try (cnv_0 THENC MPOLY_BASE_CONV avs) tm with Failure _ -> (RAND_CONV num_CONV THENC cnv_1 THENC (RAND_CONV (MPOLY_POW_CONV avs)) THENC MPOLY_MUL_CONV avs) tm in MPOLY_POW_CONV;; (* ------------------------------------------------------------------------- *) (* Recursive conversion to polynomial form. *) (* ------------------------------------------------------------------------- *) let POLYNATE_CONV = let ELIM_SUB_CONV = REWR_CONV (SIMPLE_COMPLEX_ARITH `x - y = x + Cx(--(&1)) * y`) and ELIM_NEG_CONV = REWR_CONV (SIMPLE_COMPLEX_ARITH `--x = Cx(--(&1)) * x`) and ELIM_POW_0_CONV = GEN_REWRITE_CONV I [CONJUNCT1 complex_pow] and ELIM_POW_1_CONV = RAND_CONV num_CONV THENC GEN_REWRITE_CONV I [CONJUNCT2 complex_pow] in let rec ELIM_POW_CONV tm = (ELIM_POW_0_CONV ORELSEC (ELIM_POW_1_CONV THENC RAND_CONV ELIM_POW_CONV)) tm in let polynet = itlist (uncurry net_of_conv) [`x pow n`,(fun cnv avs -> LAND_CONV (cnv avs) THENC MPOLY_POW_CONV avs); `x * y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_MUL_CONV avs); `x + y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_ADD_CONV avs); `x - y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_SUB_CONV avs); `--x`,(fun cnv avs -> ELIM_NEG_CONV THENC (cnv avs))] empty_net in let rec POLYNATE_CONV avs tm = try snd(hd(lookup tm polynet)) POLYNATE_CONV avs tm with Failure _ -> MPOLY_BASE_CONV avs tm in POLYNATE_CONV;; (* ------------------------------------------------------------------------- *) (* Cancellation conversion. *) (* ------------------------------------------------------------------------- *) let POLY_PAD_RULE = let pth = prove (`(poly p x = Cx(&0)) ==> (poly (CONS (Cx(&0)) p) x = Cx(&0))`, SIMP_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID]) in let MATCH_pth = MATCH_MP pth in fun avs th -> let th1 = MATCH_pth th in CONV_RULE(funpow 3 LAND_CONV (MPOLY_BASE_CONV (tl avs))) th1;; let POLY_CANCEL_EQ_CONV = let pth_1 = prove (`(p = Cx(&0)) /\ ~(a = Cx(&0)) ==> !q b. (q = Cx(&0)) <=> (a * q - b * p = Cx(&0))`, SIMP_TAC[COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO; COMPLEX_ENTIRE]) in let MATCH_CANCEL_THM = MATCH_MP pth_1 in let rec POLY_CANCEL_EQ_CONV avs n ath eth tm = let m = length(dest_list(lhand(lhand tm))) in if m < n then REFL tm else let th1 = funpow (m - n) (POLY_PAD_RULE avs) eth in let th2 = MATCH_CANCEL_THM (CONJ th1 ath) in let th3 = SPECL [lhs tm; last(dest_list(lhand(lhs tm)))] th2 in let th4 = CONV_RULE(RAND_CONV(LAND_CONV (BINOP_CONV(MPOLY_CMUL_CONV avs)))) th3 in let th5 = CONV_RULE(RAND_CONV(LAND_CONV (MPOLY_SUB_CONV avs))) th4 in TRANS th5 (POLY_CANCEL_EQ_CONV avs n ath eth (rand(concl th5))) in POLY_CANCEL_EQ_CONV;; let RESOLVE_EQ_RAW = let pth = prove (`(poly [] x = Cx(&0)) /\ (poly [c] x = c)`, REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in let REWRITE_pth = GEN_REWRITE_CONV LAND_CONV [pth] in let rec RESOLVE_EQ asm tm = try EQT_INTRO(find (fun th -> concl th = tm) asm) with Failure _ -> let tm' = mk_neg tm in try EQF_INTRO(find (fun th -> concl th = tm') asm) with Failure _ -> try let th1 = REWRITE_pth tm in TRANS th1 (RESOLVE_EQ asm (rand(concl th1))) with Failure _ -> COMPLEX_RAT_EQ_CONV tm in RESOLVE_EQ;; let RESOLVE_EQ asm tm = let th = RESOLVE_EQ_RAW asm tm in try EQF_ELIM th with Failure _ -> EQT_ELIM th;; let RESOLVE_EQ_THEN = let MATCH_pth = MATCH_MP (TAUT `(p ==> (q <=> q1)) /\ (~p ==> (q <=> q2)) ==> (q <=> (p /\ q1 \/ ~p /\ q2))`) in fun asm tm yfn nfn -> try let th = RESOLVE_EQ asm tm in if is_neg(concl th) then nfn (th::asm) th else yfn (th::asm) th with Failure _ -> let tm' = mk_neg tm in let yth = DISCH tm (yfn (ASSUME tm :: asm) (ASSUME tm)) and nth = DISCH tm' (nfn (ASSUME tm' :: asm) (ASSUME tm')) in MATCH_pth (CONJ yth nth);; let POLY_CANCEL_ENE_CONV avs n ath eth tm = if is_neg tm then RAND_CONV(POLY_CANCEL_EQ_CONV avs n ath eth) tm else POLY_CANCEL_EQ_CONV avs n ath eth tm;; let RESOLVE_NE = let NEGATE_NEGATE_RULE = GEN_REWRITE_RULE I [TAUT `p <=> (~p <=> F)`] in fun asm tm -> try let th = RESOLVE_EQ asm (rand tm) in if is_neg(concl th) then EQT_INTRO th else NEGATE_NEGATE_RULE th with Failure _ -> REFL tm;; (* ------------------------------------------------------------------------- *) (* Conversion for division of polynomials. *) (* ------------------------------------------------------------------------- *) let LAST_CONV = GEN_REWRITE_CONV REPEATC [LAST_CLAUSES];; let LENGTH_CONV = let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 LENGTH] and cnv_1 = GEN_REWRITE_CONV I [CONJUNCT2 LENGTH] in let rec LENGTH_CONV tm = try cnv_0 tm with Failure _ -> (cnv_1 THENC RAND_CONV LENGTH_CONV THENC NUM_SUC_CONV) tm in LENGTH_CONV;; let EXPAND_EX_BETA_CONV = let pth = prove(`EX P [c] = P c`,REWRITE_TAC[EX]) in let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 EX] and cnv_1 = GEN_REWRITE_CONV I [pth] and cnv_2 = GEN_REWRITE_CONV I [CONJUNCT2 EX] in let rec EXPAND_EX_BETA_CONV tm = try (cnv_1 THENC BETA_CONV) tm with Failure _ -> try (cnv_2 THENC COMB2_CONV (RAND_CONV BETA_CONV) EXPAND_EX_BETA_CONV) tm with Failure _ -> cnv_0 tm in EXPAND_EX_BETA_CONV;; let POLY_DIVIDES_PAD_RULE = let pth = prove (`p divides q ==> p divides (CONS (Cx(&0)) q)`, REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL; poly; COMPLEX_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `r:complex list` ASSUME_TAC) THEN EXISTS_TAC `[Cx(&0); Cx(&1)] ** r` THEN ASM_REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_ADD_RID; COMPLEX_MUL_RID; POLY_MUL] THEN REWRITE_TAC[COMPLEX_MUL_AC]) in let APPLY_pth = MATCH_MP pth in fun avs n tm -> funpow n (CONV_RULE(RAND_CONV(LAND_CONV(MPOLY_BASE_CONV (tl avs)))) o APPLY_pth) (SPEC tm POLY_DIVIDES_REFL);; let POLY_DIVIDES_PAD_CONST_RULE = let pth = prove (`p divides q ==> !a. p divides (a ## q)`, REWRITE_TAC[FUN_EQ_THM; divides; POLY_CMUL; POLY_MUL] THEN DISCH_THEN(X_CHOOSE_THEN `r:complex list` ASSUME_TAC) THEN X_GEN_TAC `a:complex` THEN EXISTS_TAC `[a] ** r` THEN ASM_REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC) in let APPLY_pth = MATCH_MP pth in fun avs n a tm -> let th1 = POLY_DIVIDES_PAD_RULE avs n tm in let th2 = SPEC a (APPLY_pth th1) in CONV_RULE(RAND_CONV(MPOLY_TCMUL_CONV avs)) th2;; let EXPAND_EX_BETA_RESOLVE_CONV asm tm = let th1 = EXPAND_EX_BETA_CONV tm in let djs = disjuncts(rand(concl th1)) in let th2 = end_itlist MK_DISJ (map (RESOLVE_NE asm) djs) in TRANS th1 th2;; let POLY_DIVIDES_CONV = let pth_0 = prove (`LENGTH q < LENGTH p ==> ~(LAST p = Cx(&0)) ==> (p divides q <=> ~(EX (\c. ~(c = Cx(&0))) q))`, REPEAT STRIP_TAC THEN REWRITE_TAC[NOT_EX; GSYM POLY_ZERO] THEN EQ_TAC THENL [ALL_TAC; SIMP_TAC[divides; POLY_MUL; FUN_EQ_THM] THEN DISCH_TAC THEN EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO]] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_DEGREE) THEN MATCH_MP_TAC(TAUT `(~b ==> ~a) ==> (a \/ b ==> b)`) THEN DISCH_TAC THEN REWRITE_TAC[NOT_LE] THEN ASM_SIMP_TAC[NORMAL_DEGREE] THEN REWRITE_TAC[degree] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `lq < lp ==> ~(lq = 0) /\ dq <= lq - 1 ==> dq < lp - 1`)) THEN CONJ_TAC THENL [ASM_MESON_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `m <= n ==> PRE m <= n - 1`) THEN REWRITE_TAC[LENGTH_NORMALIZE_LE]) in let APPLY_pth0 = PART_MATCH (lhand o rand o rand) pth_0 in let pth_1 = prove (`~(a = Cx(&0)) ==> p divides p' ==> (!x. a * poly q x - poly p' x = poly r x) ==> (p divides q <=> p divides r)`, DISCH_TAC THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:complex list` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `s:complex list` MP_TAC) THENL [DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `a ## s ++ --(Cx(&1)) ## t` THEN REWRITE_TAC[POLY_MUL; POLY_ADD; POLY_CMUL] THEN REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC; REWRITE_TAC[POLY_MUL] THEN DISCH_TAC THEN EXISTS_TAC `[inv(a)] ** (t ++ s)` THEN X_GEN_TAC `z:complex` THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[POLY_MUL; POLY_ADD; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN SUBGOAL_THEN `a * poly q z = (poly t z + poly s z) * poly p z` MP_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `z:complex`) THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) (inv a)`) THEN ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_LINV; COMPLEX_MUL_LID]]) in let MATCH_pth1 = MATCH_MP pth_1 in let rec DIVIDE_STEP_CONV avs sfn n tm = let m = length(dest_list(rand tm)) in if m < n then REFL tm else let th1 = POLY_DIVIDES_PAD_CONST_RULE avs (m - n) (last(dest_list(rand tm))) (lhand tm) in let th2 = MATCH_MP (sfn tm) th1 in let av,bod = dest_forall(lhand(concl th2)) in let tm1 = vsubst [hd avs,av] (lhand bod) in let th3 = (LAND_CONV (MPOLY_CMUL_CONV avs) THENC MPOLY_SUB_CONV avs) tm1 in let th4 = MATCH_MP th2 (GEN (hd avs) th3) in TRANS th4 (DIVIDE_STEP_CONV avs sfn n (rand(concl th4))) in let zero_tm = `Cx(&0)` in fun asm avs tm -> let ath = RESOLVE_EQ asm (mk_eq(last(dest_list(lhand tm)),zero_tm)) in let sfn = PART_MATCH (lhand o rand o rand) (MATCH_pth1 ath) and n = length(dest_list(lhand tm)) in let th1 = DIVIDE_STEP_CONV avs sfn n tm in let th2 = APPLY_pth0 (rand(concl th1)) in let th3 = (BINOP_CONV LENGTH_CONV THENC NUM_LT_CONV) (lhand(concl th2)) in let th4 = MP th2 (EQT_ELIM th3) in let th5 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th4 in let th6 = TRANS th1 (MP th5 ath) in CONV_RULE(RAND_CONV(RAND_CONV(EXPAND_EX_BETA_RESOLVE_CONV asm))) th6;; (* ------------------------------------------------------------------------- *) (* Apply basic Nullstellensatz principle. *) (* ------------------------------------------------------------------------- *) let BASIC_QUELIM_CONV = let pth_1 = prove (`((?x. (poly p x = Cx(&0)) /\ ~(poly [] x = Cx(&0))) <=> F) /\ ((?x. ~(poly [] x = Cx(&0))) <=> F) /\ ((?x. ~(poly [c] x = Cx(&0))) <=> ~(c = Cx(&0))) /\ ((?x. (poly [] x = Cx(&0))) <=> T) /\ ((?x. (poly [c] x = Cx(&0))) <=> (c = Cx(&0)))`, REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in let APPLY_pth1 = GEN_REWRITE_CONV I [pth_1] in let pth_2 = prove (`~(LAST(CONS a (CONS b p)) = Cx(&0)) ==> ((?x. poly (CONS a (CONS b p)) x = Cx(&0)) <=> T)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `CONS (a:complex) (CONS b p)` FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT) THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[NOT_EXISTS_THM; CONS_11] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(ALL (\c. c = Cx(&0)) (CONS b p))` (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]) THEN UNDISCH_TAC `~(LAST (CONS a (CONS b p)) = Cx (&0))` THEN ONCE_REWRITE_TAC[LAST] THEN REWRITE_TAC[NOT_CONS_NIL] THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN SPEC_TAC(`p:complex list`,`p:complex list`) THEN LIST_INDUCT_TAC THEN ONCE_REWRITE_TAC[LAST] THEN REWRITE_TAC[ALL; NOT_CONS_NIL] THEN STRIP_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_imp o concl) THEN REWRITE_TAC[LAST] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ALL]) in let APPLY_pth2 = PART_MATCH (lhand o rand) pth_2 in let pth_2b = prove (`(?x. ~(poly p x = Cx(&0))) <=> EX (\c. ~(c = Cx(&0))) p`, REWRITE_TAC[GSYM NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[TAUT `(~a <=> b) <=> (a <=> ~b)`] THEN REWRITE_TAC[NOT_EX; GSYM POLY_ZERO; poly; FUN_EQ_THM]) in let APPLY_pth2b = GEN_REWRITE_CONV I [pth_2b] in let pth_3 = prove (`~(LAST(CONS a p) = Cx(&0)) ==> ((?x. (poly (CONS a p) x = Cx(&0)) /\ ~(poly q x = Cx(&0))) <=> ~((CONS a p) divides (q exp (LENGTH p))))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`CONS (a:complex) p`; `q:complex list`] NULLSTELLENSATZ_UNIVARIATE) THEN ASM_SIMP_TAC[degree; NORMALIZE_EQ; LENGTH; PRE] THEN SUBGOAL_THEN `~(poly (CONS a p) = poly [])` (fun th -> REWRITE_TAC[th] THEN MESON_TAC[]) THEN REWRITE_TAC[POLY_ZERO] THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`p:complex list`,`p:complex list`) THEN REWRITE_TAC[LAST] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LAST; ALL; NOT_CONS_NIL] THEN POP_ASSUM MP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ALL] THEN CONV_TAC TAUT) in let APPLY_pth3 = PART_MATCH (lhand o rand) pth_3 in let POLY_EXP_DIVIDES_CONV = let pth_4 = prove (`(!x. (poly (q exp n) x = poly r x)) ==> (p divides (q exp n) <=> p divides r)`, SIMP_TAC[divides; POLY_EXP; FUN_EQ_THM]) in let APPLY_pth4 = MATCH_MP pth_4 and poly_tm = `poly` and REWR_POLY_EXP_CONV = REWR_CONV POLY_EXP in let POLY_EXP_DIVIDES_CONV avs tm = let tm1 = mk_comb(mk_comb(poly_tm,rand tm),hd avs) in let th1 = REWR_POLY_EXP_CONV tm1 in let th2 = TRANS th1 (MPOLY_POW_CONV avs (rand(concl th1))) in PART_MATCH lhand (APPLY_pth4 (GEN (hd avs) th2)) tm in POLY_EXP_DIVIDES_CONV in fun asm avs tm -> try APPLY_pth1 tm with Failure _ -> try let th1 = APPLY_pth2 tm in let th2 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th1 in let th3 = try MATCH_MP th2 (RESOLVE_EQ asm (rand(lhand(concl th2)))) with Failure _ -> failwith "Sanity failure (2a)" in th3 with Failure _ -> try let th1 = APPLY_pth2b tm in TRANS th1 (EXPAND_EX_BETA_RESOLVE_CONV asm (rand(concl th1))) with Failure _ -> let th1 = APPLY_pth3 tm in let th2 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th1 in let th3 = try MATCH_MP th2 (RESOLVE_EQ asm (rand(lhand(concl th2)))) with Failure _ -> failwith "Sanity failure (2b)" in let th4 = CONV_RULE (funpow 4 RAND_CONV LENGTH_CONV) th3 in let th5 = CONV_RULE(RAND_CONV(RAND_CONV(POLY_EXP_DIVIDES_CONV avs))) th4 in CONV_RULE(RAND_CONV(RAND_CONV(POLY_DIVIDES_CONV asm avs))) th5;; (* ------------------------------------------------------------------------- *) (* Put into canonical form by multiplying inequalities. *) (* ------------------------------------------------------------------------- *) let POLY_NE_MULT_CONV = let pth = prove (`~(poly p x = Cx(&0)) /\ ~(poly q x = Cx(&0)) <=> ~(poly p x * poly q x = Cx(&0))`, REWRITE_TAC[COMPLEX_ENTIRE; DE_MORGAN_THM]) in let APPLY_pth = REWR_CONV pth in let rec POLY_NE_MULT_CONV avs tm = if not(is_conj tm) then REFL tm else let l,r = dest_conj tm in let th1 = MK_COMB(AP_TERM (rator(rator tm)) (POLY_NE_MULT_CONV avs l), POLY_NE_MULT_CONV avs r) in let th2 = TRANS th1 (APPLY_pth (rand(concl th1))) in CONV_RULE(RAND_CONV(RAND_CONV(LAND_CONV(MPOLY_MUL_CONV avs)))) th2 in POLY_NE_MULT_CONV;; let CORE_QUELIM_CONV = let CONJ_AC_RULE = AC CONJ_ACI in let CORE_QUELIM_CONV asm avs tm = let ev,bod = dest_exists tm in let cjs = conjuncts bod in let eqs,neqs = partition is_eq cjs in if eqs = [] then let th1 = MK_EXISTS ev (POLY_NE_MULT_CONV avs bod) in TRANS th1 (BASIC_QUELIM_CONV asm avs (rand(concl th1))) else if length eqs > 1 then failwith "CORE_QUELIM_CONV: Sanity failure" else if neqs = [] then BASIC_QUELIM_CONV asm avs tm else let tm1 = mk_conj(hd eqs,list_mk_conj neqs) in let th1 = CONJ_AC_RULE(mk_eq(bod,tm1)) in let th2 = CONV_RULE(funpow 2 RAND_CONV(POLY_NE_MULT_CONV avs)) th1 in let th3 = MK_EXISTS ev th2 in TRANS th3 (BASIC_QUELIM_CONV asm avs (rand(concl th3))) in CORE_QUELIM_CONV;; (* ------------------------------------------------------------------------- *) (* Main elimination coversion (for a single quantifier). *) (* ------------------------------------------------------------------------- *) let RESOLVE_EQ_NE = let DNE_RULE = GEN_REWRITE_RULE I [TAUT `((p <=> T) <=> (~p <=> F)) /\ ((p <=> F) <=> (~p <=> T))`] in fun asm tm -> if is_neg tm then DNE_RULE(RESOLVE_EQ_RAW asm (rand tm)) else RESOLVE_EQ_RAW asm tm;; let COMPLEX_QUELIM_CONV = let pth_0 = prove (`((poly [] x = Cx(&0)) <=> T) /\ ((poly [] x = Cx(&0)) /\ p <=> p)`, REWRITE_TAC[poly]) and pth_1 = prove (`(~(poly [] x = Cx(&0)) <=> F) /\ (~(poly [] x = Cx(&0)) /\ p <=> F)`, REWRITE_TAC[poly]) and pth_2 = prove (`(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`, CONV_TAC TAUT) and zero_tm = `Cx(&0)` and true_tm = `T` in let ELIM_ZERO_RULE = GEN_REWRITE_RULE RAND_CONV [pth_0] and ELIM_NONZERO_RULE = GEN_REWRITE_RULE RAND_CONV [pth_1] and INCORP_ASSUM_THM = MATCH_MP pth_2 and CONJ_AC_RULE = AC CONJ_ACI in let POLY_CONST_CONV = let pth = prove (`((poly [c] x = y) <=> (c = y)) /\ (~(poly [c] x = y) <=> ~(c = y))`, REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in TRY_CONV(GEN_REWRITE_CONV I [pth]) in let EXISTS_TRIV_CONV = REWR_CONV EXISTS_SIMP and EXISTS_PUSH_CONV = REWR_CONV RIGHT_EXISTS_AND_THM and AND_SIMP_CONV = GEN_REWRITE_CONV DEPTH_CONV [TAUT `(p /\ F <=> F) /\ (p /\ T <=> p) /\ (F /\ p <=> F) /\ (T /\ p <=> p)`] and RESOLVE_OR_CONST_CONV asm tm = try RESOLVE_EQ_NE asm tm with Failure _ -> POLY_CONST_CONV tm and false_tm = `F` in let rec COMPLEX_QUELIM_CONV asm avs tm = let ev,bod = dest_exists tm in let cjs = conjuncts bod in let cjs_set = setify cjs in if length cjs_set < length cjs then let th1 = CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs_set)) in let th2 = MK_EXISTS ev th1 in TRANS th2 (COMPLEX_QUELIM_CONV asm avs (rand(concl th2))) else let eqs,neqs = partition is_eq cjs in let lens = map (length o dest_list o lhand o lhs) eqs and nens = map (length o dest_list o lhand o lhs o rand) neqs in try let zeq = el (index 0 lens) eqs in if cjs = [zeq] then BASIC_QUELIM_CONV asm avs tm else let cjs' = zeq::(subtract cjs [zeq]) in let th1 = ELIM_ZERO_RULE(CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs'))) in let th2 = MK_EXISTS ev th1 in TRANS th2 (COMPLEX_QUELIM_CONV asm avs (rand(concl th2))) with Failure _ -> try let zne = el (index 0 nens) neqs in if cjs = [zne] then BASIC_QUELIM_CONV asm avs tm else let cjs' = zne::(subtract cjs [zne]) in let th1 = ELIM_NONZERO_RULE (CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs'))) in CONV_RULE (RAND_CONV EXISTS_TRIV_CONV) (MK_EXISTS ev th1) with Failure _ -> try let ones = map snd (filter (fun (n,_) -> n = 1) (zip lens eqs @ zip nens neqs)) in if ones = [] then failwith "" else let cjs' = subtract cjs ones in if cjs' = [] then let th1 = MK_EXISTS ev (SUBS_CONV(map POLY_CONST_CONV cjs) bod) in TRANS th1 (EXISTS_TRIV_CONV (rand(concl th1))) else let tha = SUBS_CONV (map (RESOLVE_OR_CONST_CONV asm) ones) (list_mk_conj ones) in let thb = CONV_RULE (RAND_CONV AND_SIMP_CONV) tha in if rand(concl thb) = false_tm then let thc = MK_CONJ thb (REFL(list_mk_conj cjs')) in let thd = CONV_RULE(RAND_CONV AND_SIMP_CONV) thc in let the = CONJ_AC_RULE(mk_eq(bod,lhand(concl thd))) in let thf = MK_EXISTS ev (TRANS the thd) in CONV_RULE(RAND_CONV EXISTS_TRIV_CONV) thf else let thc = MK_CONJ thb (REFL(list_mk_conj cjs')) in let thd = CONJ_AC_RULE(mk_eq(bod,lhand(concl thc))) in let the = MK_EXISTS ev (TRANS thd thc) in let th4 = TRANS the(EXISTS_PUSH_CONV(rand(concl the))) in let tm4 = rand(concl th4) in let th5 = COMPLEX_QUELIM_CONV asm avs (rand tm4) in TRANS th4 (AP_TERM (rator tm4) th5) with Failure _ -> if eqs = [] || (length eqs = 1 & (let ceq = mk_eq(last(dest_list(lhand(lhs(hd eqs)))),zero_tm) in try concl(RESOLVE_EQ asm ceq) = mk_neg ceq with Failure _ -> false) & (let h = hd lens in forall (fun n -> n < h) nens)) then CORE_QUELIM_CONV asm avs tm else let n = end_itlist min lens in let eq = el (index n lens) eqs in let pol = lhand(lhand eq) in let atm = last(dest_list pol) in let zeq = mk_eq(atm,zero_tm) in RESOLVE_EQ_THEN asm zeq (fun asm' yth -> let th0 = TRANS yth (MPOLY_BASE_CONV (tl avs) zero_tm) in let th1 = GEN_REWRITE_CONV (LAND_CONV o LAND_CONV o funpow (n - 1) RAND_CONV o LAND_CONV) [th0] eq in let th2 = LAND_CONV(MPOLY_NORM_CONV avs) (rand(concl th1)) in let th3 = MK_EXISTS ev (SUBS_CONV[TRANS th1 th2] bod) in TRANS th3 (COMPLEX_QUELIM_CONV asm' avs (rand(concl th3)))) (fun asm' nth -> let oth = subtract cjs [eq] in if oth = [] then COMPLEX_QUELIM_CONV asm' avs tm else let eth = ASSUME eq in let ths = map (POLY_CANCEL_ENE_CONV avs n nth eth) oth in let th1 = DISCH eq (end_itlist MK_CONJ ths) in let th2 = INCORP_ASSUM_THM th1 in let th3 = TRANS (CONJ_AC_RULE(mk_eq(bod,lhand(concl th2)))) th2 in let th4 = MK_EXISTS ev th3 in TRANS th4 (COMPLEX_QUELIM_CONV asm' avs (rand(concl th4)))) in fun asm avs -> time(COMPLEX_QUELIM_CONV asm avs);; (* ------------------------------------------------------------------------- *) (* NNF conversion doing "conditionals" ~(p /\ q \/ ~p /\ r) intelligently. *) (* ------------------------------------------------------------------------- *) let NNF_COND_CONV = let NOT_EXISTS_UNIQUE_THM = prove (`~(?!x. P x) <=> (!x. ~P x) \/ ?x x'. P x /\ P x' /\ ~(x = x')`, REWRITE_TAC[EXISTS_UNIQUE_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; CONJ_ASSOC]) in let tauts = [TAUT `~(~p) <=> p`; TAUT `~(p /\ q) <=> ~p \/ ~q`; TAUT `~(p \/ q) <=> ~p /\ ~q`; TAUT `~(p ==> q) <=> p /\ ~q`; TAUT `p ==> q <=> ~p \/ q`; NOT_FORALL_THM; NOT_EXISTS_THM; EXISTS_UNIQUE_THM; NOT_EXISTS_UNIQUE_THM; TAUT `~(p <=> q) <=> (p /\ ~q) \/ (~p /\ q)`; TAUT `(p <=> q) <=> (p /\ q) \/ (~p /\ ~q)`; TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;; (* ------------------------------------------------------------------------- *) (* Overall procedure for multiple quantifiers in any first order formula. *) (* ------------------------------------------------------------------------- *) let FULL_COMPLEX_QUELIM_CONV = let ELIM_FORALL_CONV = let pth = prove(`(!x. P x) <=> ~(?x. ~(P x))`,MESON_TAC[]) in REWR_CONV pth in let ELIM_EQ_CONV = let pth = SIMPLE_COMPLEX_ARITH `(x = y) <=> (x - y = Cx(&0))` and zero_tm = `Cx(&0)` in let REWR_pth = REWR_CONV pth in fun avs tm -> if rand tm = zero_tm then LAND_CONV(POLYNATE_CONV avs) tm else (REWR_pth THENC LAND_CONV(POLYNATE_CONV avs)) tm in let SIMP_DNF_CONV = GEN_REWRITE_CONV TOP_DEPTH_CONV (basic_rewrites()) THENC NNF_COND_CONV THENC DNF_CONV in let DISTRIB_EXISTS_CONV = GEN_REWRITE_CONV I [EXISTS_OR_THM] in let TRIV_EXISTS_CONV = GEN_REWRITE_CONV I [EXISTS_SIMP] in let complex_ty = `:complex` in let FINAL_SIMP_CONV = GEN_REWRITE_CONV DEPTH_CONV [CX_INJ] THENC REAL_RAT_REDUCE_CONV THENC GEN_REWRITE_CONV TOP_DEPTH_CONV (basic_rewrites()) in let rec FULL_COMPLEX_QUELIM_CONV avs tm = if is_forall tm then let th1 = ELIM_FORALL_CONV tm in let th2 = FULL_COMPLEX_QUELIM_CONV avs (rand(concl th1)) in TRANS th1 th2 else if is_neg tm then AP_TERM (rator tm) (FULL_COMPLEX_QUELIM_CONV avs (rand tm)) else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then let lop,r = dest_comb tm in let op,l = dest_comb lop in let thl = FULL_COMPLEX_QUELIM_CONV avs l and thr = FULL_COMPLEX_QUELIM_CONV avs r in MK_COMB(AP_TERM(rator(rator tm)) thl,thr) else if is_exists tm then let ev,bod = dest_exists tm in let th0 = FULL_COMPLEX_QUELIM_CONV (ev::avs) bod in let th1 = MK_EXISTS ev (CONV_RULE(RAND_CONV SIMP_DNF_CONV) th0) in TRANS th1 (DISTRIB_AND_COMPLEX_QUELIM_CONV (ev::avs) (rand(concl th1))) else if is_eq tm then ELIM_EQ_CONV avs tm else failwith "unexpected type of formula" and DISTRIB_AND_COMPLEX_QUELIM_CONV avs tm = try TRIV_EXISTS_CONV tm with Failure _ -> try (DISTRIB_EXISTS_CONV THENC BINOP_CONV (DISTRIB_AND_COMPLEX_QUELIM_CONV avs)) tm with Failure _ -> COMPLEX_QUELIM_CONV [] avs tm in fun tm -> let avs = filter (fun t -> type_of t = complex_ty) (frees tm) in (FULL_COMPLEX_QUELIM_CONV avs THENC FINAL_SIMP_CONV) tm;; hol-light/Complex/quelim_examples.ml000066400000000000000000000160201303454263000200770ustar00rootroot00000000000000(* ========================================================================= *) (* Some examples of full complex quantifier elimination. *) (* ========================================================================= *) let th = time prove (`!x y. (x pow 2 = Cx(&2)) /\ (y pow 2 = Cx(&3)) ==> ((x * y) pow 2 = Cx(&6))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`!x a. (a pow 2 = Cx(&2)) /\ (x pow 2 + a * x + Cx(&1) = Cx(&0)) ==> (x pow 4 + Cx(&1) = Cx(&0))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`!a x. (a pow 2 = Cx(&2)) /\ (x pow 2 + a * x + Cx(&1) = Cx(&0)) ==> (x pow 4 + Cx(&1) = Cx(&0))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`~(?a x y. (a pow 2 = Cx(&2)) /\ (x pow 2 + a * x + Cx(&1) = Cx(&0)) /\ (y * (x pow 4 + Cx(&1)) + Cx(&1) = Cx(&0)))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`!x. ?y. x pow 2 = y pow 3`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`!x y z a b. (a + b) * (x - y + z) - (a - b) * (x + y + z) = Cx(&2) * (b * x + b * z - a * y)`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`!a b. ~(a = b) ==> ?x y. (y * x pow 2 = a) /\ (y * x pow 2 + x = b)`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ (a * y pow 2 + b * y + c = Cx(&0)) /\ ~(x = y) ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; let th = time prove (`~(!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ (a * y pow 2 + b * y + c = Cx(&0)) ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0)))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; (** geometric example from ``Algorithms for Computer Algebra'': right triangle where perp. bisector of hypotenuse passes through the right angle is isoseles. **) let th = time prove (`!y_1 y_2 y_3 y_4. (y_1 = Cx(&2) * y_3) /\ (y_2 = Cx(&2) * y_4) /\ (y_1 * y_3 = y_2 * y_4) ==> (y_1 pow 2 = y_2 pow 2)`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; (** geometric example: gradient condition for two lines to be non-parallel. **) let th = time prove (`!a1 b1 c1 a2 b2 c2. ~(a1 * b2 = a2 * b1) ==> ?x y. (a1 * x + b1 * y = c1) /\ (a2 * x + b2 * y = c2)`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; (*********** Apparently takes too long let th = time prove (`!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ (a * y pow 2 + b * y + c = Cx(&0)) /\ (!z. (a * z pow 2 + b * z + c = Cx(&0)) ==> (z = x) \/ (z = y)) ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; *************) (* ------------------------------------------------------------------------- *) (* Any three points determine a circle. Not true in complex number version! *) (* ------------------------------------------------------------------------- *) (******** And it takes a lot of memory! let th = time prove (`~(!x1 y1 x2 y2 x3 y3. ?x0 y0. ((x1 - x0) pow 2 + (y1 - y0) pow 2 = (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ ((x2 - x0) pow 2 + (y2 - y0) pow 2 = (x3 - x0) pow 2 + (y3 - y0) pow 2))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; **************) (* ------------------------------------------------------------------------- *) (* To show we don't need to consider only closed formulas. *) (* Can eliminate some, then deal with the rest manually and painfully. *) (* ------------------------------------------------------------------------- *) let th = time prove (`(?x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ (a * y pow 2 + b * y + c = Cx(&0)) /\ ~(x = y)) <=> (a = Cx(&0)) /\ (b = Cx(&0)) /\ (c = Cx(&0)) \/ ~(a = Cx(&0)) /\ ~(b pow 2 = Cx(&4) * a * c)`, CONV_TAC(LAND_CONV FULL_COMPLEX_QUELIM_CONV) THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_ADD_RID] THEN REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; REAL_OF_NUM_EQ; ARITH] THEN ASM_CASES_TAC `a = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THENL [ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO]; ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `b * b * c * Cx(--(&1)) + a * c * c * Cx(&4) = c * (Cx(&4) * a * c - b * b)`] THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `b * b * b * Cx(--(&1)) + a * b * c * Cx (&4) = b * (Cx(&4) * a * c - b * b)`] THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `b * b * Cx (&1) + a * c * Cx(--(&4)) = Cx(--(&1)) * (Cx(&4) * a * c - b * b)`] THEN REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_SUB_0; CX_INJ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `c = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPLEX_POW_2; COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[EQ_SYM_EQ]]);; (* ------------------------------------------------------------------------- *) (* Do the same thing directly. *) (* ------------------------------------------------------------------------- *) (**** This seems barely feasible let th = time prove (`!a b c. (?x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ (a * y pow 2 + b * y + c = Cx(&0)) /\ ~(x = y)) <=> (a = Cx(&0)) /\ (b = Cx(&0)) /\ (c = Cx(&0)) \/ ~(a = Cx(&0)) /\ ~(b pow 2 = Cx(&4) * a * c)`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; ****) (* ------------------------------------------------------------------------- *) (* More ambitious: determine a unique circle. Also not true over complexes. *) (* (consider the points (k, k i) where i is the imaginary unit...) *) (* ------------------------------------------------------------------------- *) (********** Takes too long, I think, and too much memory too let th = prove (`~(!x1 y1 x2 y2 x3 y3 x0 y0 x0' y0'. ((x1 - x0) pow 2 + (y1 - y0) pow 2 = (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ ((x2 - x0) pow 2 + (y2 - y0) pow 2 = (x3 - x0) pow 2 + (y3 - y0) pow 2) /\ ((x1 - x0') pow 2 + (y1 - y0') pow 2 = (x2 - x0') pow 2 + (y2 - y0') pow 2) /\ ((x2 - x0') pow 2 + (y2 - y0') pow 2 = (x3 - x0') pow 2 + (y3 - y0') pow 2) ==> (x0 = x0') /\ (y0 = y0'))`, CONV_TAC FULL_COMPLEX_QUELIM_CONV);; *************) (* ------------------------------------------------------------------------- *) (* Side of a triangle in terms of its bisectors; Kapur survey 5.1. *) (* ------------------------------------------------------------------------- *) (************* let th = time FULL_COMPLEX_QUELIM_CONV `?b c. (p1 = ai pow 2 * (b + c) pow 2 - c * b * (c + b - a) * (c + b + a)) /\ (p2 = ae pow 2 * (c - b) pow 2 - c * b * (a + b - c) * (a - b + a)) /\ (p3 = be pow 2 * (c - a) pow 2 - a * c * (a + b - c) * (c + b - a))`;; *************) hol-light/Examples/000077500000000000000000000000001303454263000145235ustar00rootroot00000000000000hol-light/Examples/borsuk.ml000066400000000000000000000225461303454263000163730ustar00rootroot00000000000000(* ========================================================================= *) (* Borsuk-Ulam theorem for an ordinary 2-sphere in real^3. *) (* From Andrew Browder's article, AMM vol. 113 (2006), pp. 935-6 *) (* ========================================================================= *) needs "Multivariate/moretop.ml";; (* ------------------------------------------------------------------------- *) (* The Borsuk-Ulam theorem for the unit sphere. *) (* ------------------------------------------------------------------------- *) let THEOREM_1 = prove (`!f:real^3->real^2. f continuous_on {x | norm(x) = &1} ==> ?x. norm(x) = &1 /\ f(--x) = f(x)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN PURE_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN ABBREV_TAC `(g:real^3->real^2) = \x. f(x) - f(--x)` THEN ABBREV_TAC `k = \z. (g:real^3->real^2) (vector[Re z; Im z; sqrt(&1 - norm z pow 2)])` THEN MP_TAC(ISPECL [`k:complex->complex`; `Cx(&0)`; `&1`] CONTINUOUS_LOGARITHM_ON_CBALL) THEN MATCH_MP_TAC(TAUT `a /\ (a /\ b ==> c) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL [CONJ_TAC THENL [EXPAND_TAC "k" THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_COMPONENTWISE] THEN SIMP_TAC[DIMINDEX_3; FORALL_3; VECTOR_3; ETA_AX] THEN REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_WITHIN_COMPOSE) THEN SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_POW; REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_NORM_WITHIN] THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN EXISTS_TAC `{t | &0 <= t}` THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SQRT_STRONG] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_CBALL; IN_ELIM_THM; dist; COMPLEX_SUB_LZERO; NORM_NEG; REAL_SUB_LE] THEN REWRITE_TAC[ABS_SQUARE_LE_1; REAL_ABS_NORM]; ALL_TAC] THEN EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC; REWRITE_TAC[GSYM IMAGE_o]]] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `{x:real^3 | norm x = &1}` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_ELIM_THM] THEN SIMP_TAC[NORM_EQ_1; DOT_3; VECTOR_3; VECTOR_NEG_COMPONENT; dist; DIMINDEX_3; ARITH; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG] THEN REWRITE_TAC[REAL_NEG_MUL2] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC; X_GEN_TAC `z:complex` THEN REWRITE_TAC[dist; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_TAC THEN MAP_EVERY EXPAND_TAC ["k"; "g"] THEN REWRITE_TAC[COMPLEX_RING `x - y = Cx(&0) <=> y = x`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_EQ_1; DOT_3; VECTOR_3]] THEN REWRITE_TAC[GSYM REAL_POW_2; COMPLEX_SQNORM] THEN REWRITE_TAC[REAL_ARITH `r + i + s = &1 <=> s = &1 - (r + i)`] THEN MATCH_MP_TAC SQRT_POW_2 THEN REWRITE_TAC[GSYM COMPLEX_SQNORM] THEN ASM_SIMP_TAC[REAL_SUB_LE; ABS_SQUARE_LE_1; REAL_ABS_NORM]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN ABBREV_TAC `m = \z:complex. (h(z) - h(--z)) / (Cx pi * ii)` THEN SUBGOAL_THEN `!z:complex. norm(z) = &1 ==> cexp(Cx pi * ii * m z) = cexp(Cx pi * ii)` MP_TAC THENL [EXPAND_TAC "m" THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB; complex_div; COMPLEX_SUB_RDISTRIB] THEN SIMP_TAC[CX_INJ; PI_NZ; CEXP_SUB; COMPLEX_FIELD `~(p = Cx(&0)) ==> p * ii * h * inv(p * ii) = h`] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `cexp(h z) = k z /\ cexp(h(--z:complex)) = k(--z)` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[dist; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[EULER; RE_MUL_CX; IM_MUL_CX; RE_II; IM_II; COMPLEX_ADD_RID; REAL_MUL_RZERO; REAL_MUL_RID; SIN_PI; COS_PI; REAL_EXP_0; COMPLEX_MUL_RZERO; COMPLEX_MUL_LID] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(y = Cx(&0)) /\ x = -- y ==> x / y = Cx(-- &1)`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[dist; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG; REAL_LE_REFL]; MAP_EVERY EXPAND_TAC ["k"; "g"] THEN REWRITE_TAC[COMPLEX_NEG_SUB] THEN BINOP_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; FORALL_3; VECTOR_3; VECTOR_NEG_COMPONENT; DIMINDEX_3; ARITH; RE_NEG; IM_NEG; NORM_NEG; REAL_NEG_NEG] THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_0; REAL_NEG_0]]; ALL_TAC] THEN REWRITE_TAC[CEXP_EQ; CX_MUL] THEN SIMP_TAC[CX_INJ; PI_NZ; COMPLEX_FIELD `~(p = Cx(&0)) ==> (p * ii * m = p * ii + (t * n * p) * ii <=> m = t * n + Cx(&1))`] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL] THEN DISCH_THEN(LABEL_TAC "*") THEN SUBGOAL_THEN `?n. !z. z IN {z | norm(z) = &1} ==> (m:complex->complex)(z) = n` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[NORM_ARITH `norm z = dist(vec 0,z)`] THEN SIMP_TAC[GSYM sphere; CONNECTED_SPHERE; DIMINDEX_2; LE_REFL]; ALL_TAC] THEN CONJ_TAC THENL [EXPAND_TAC "m" THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN SIMP_TAC[CONTINUOUS_ON_CONST; COMPLEX_ENTIRE; II_NZ; CX_INJ; PI_NZ] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC; REWRITE_TAC[GSYM IMAGE_o]]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; NORM_NEG; IN_CBALL; COMPLEX_SUB_LZERO; dist; IN_ELIM_THM; REAL_LE_REFL]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN REMOVE_THEN "*" (fun th -> MP_TAC(SPEC `w:complex` th) THEN MP_TAC(SPEC `z:complex` th)) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC))) THEN REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `~(abs(x - y) < &1) ==> &1 <= abs((&2 * x + &1) - (&2 * y + &1))`) THEN ASM_SIMP_TAC[GSYM REAL_EQ_INTEGERS] THEN ASM_MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `v:complex`)] THEN SUBGOAL_THEN `?n. integer n /\ !z:complex. norm z = &1 ==> m z = Cx(&2 * n + &1)` MP_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `Cx(&1)`) THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` MP_TAC) THEN EXPAND_TAC "m" THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `--Cx(&1)` th) THEN MP_TAC(SPEC `Cx(&1)` th)) THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_NEG_NEG] THEN REWRITE_TAC[complex_div; COMPLEX_SUB_RDISTRIB] THEN MATCH_MP_TAC(COMPLEX_RING `~(z = Cx(&0)) ==> a - b = z ==> ~(b - a = z)`) THEN REWRITE_TAC[CX_INJ; REAL_ARITH `&2 * n + &1 = &0 <=> n = --(&1 / &2)`] THEN UNDISCH_TAC `integer n` THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN SIMP_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[integer] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_DIV; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `a / &2 = n <=> a = &2 * n`] THEN REWRITE_TAC[NOT_EXISTS_THM; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; ARITH]);; (* ------------------------------------------------------------------------- *) (* The Borsuk-Ulam theorem for a general sphere. *) (* ------------------------------------------------------------------------- *) let BORSUK_ULAM = prove (`!f:real^3->real^2 a r. &0 <= r /\ f continuous_on {z | norm(z - a) = r} ==> ?x. norm(x) = r /\ f(a + x) = f(a - x)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. (f:real^3->real^2) (a + r % x)` THEOREM_1) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM]; DISCH_THEN(X_CHOOSE_THEN `x:real^3` STRIP_ASSUME_TAC) THEN EXISTS_TAC `r % x:real^3` THEN ASM_REWRITE_TAC[VECTOR_ARITH `a - r % x:real^3 = a + r % --x`]] THEN ASM_SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL] THEN ASM_REAL_ARITH_TAC);; hol-light/Examples/brunn_minkowski.ml000066400000000000000000002121071303454263000202770ustar00rootroot00000000000000(* ========================================================================= *) (* Brunn-Minkowski theorem and related results. *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* First, the special case of a box. *) (* ------------------------------------------------------------------------- *) let BRUNN_MINKOWSKI_INTERVAL = prove (`!a b c d:real^N. ~(interval[a,b] = {}) /\ ~(interval[c,d] = {}) ==> root (dimindex(:N)) (measure {x + y | x IN interval[a,b] /\ y IN interval[c,d]}) >= root (dimindex(:N)) (measure(interval[a,b])) + root (dimindex(:N)) (measure(interval[c,d]))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SUMS_INTERVALS; real_ge] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_CASES_TAC `measure(interval[a:real^N,b]) = &0` THENL [ASM_SIMP_TAC[ROOT_0; DIMINDEX_GE_1; LE_1; REAL_ADD_LID; ROOT_MONO_LE_EQ; MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL; VECTOR_ADD_COMPONENT; REAL_ARITH `a <= b /\ c <= d ==> a + c <= b + d`] THEN MATCH_MP_TAC PRODUCT_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN SIMP_TAC[MEASURABLE_MEASURE_EQ_0; MEASURABLE_INTERVAL] THEN REWRITE_TAC[NEGLIGIBLE_INTERVAL; INTERVAL_NE_EMPTY] THEN STRIP_TAC] THEN ASM_CASES_TAC `measure(interval[c:real^N,d]) = &0` THENL [ASM_SIMP_TAC[ROOT_0; DIMINDEX_GE_1; LE_1; REAL_ADD_RID; ROOT_MONO_LE_EQ; MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL; VECTOR_ADD_COMPONENT; REAL_ARITH `a <= b /\ c <= d ==> a + c <= b + d`] THEN MATCH_MP_TAC PRODUCT_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN SIMP_TAC[MEASURABLE_MEASURE_EQ_0; MEASURABLE_INTERVAL] THEN REWRITE_TAC[NEGLIGIBLE_INTERVAL; INTERVAL_NE_EMPTY] THEN STRIP_TAC] THEN ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL; VECTOR_ADD_COMPONENT; REAL_ARITH `a <= b /\ c <= d ==> a + c <= b + d`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN W(MP_TAC o PART_MATCH (rand o rand) REAL_LE_LDIV_EQ o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC ROOT_POS_LT THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; PRODUCT_POS_LT_NUMSEG; IN_NUMSEG; REAL_ARITH `a < b /\ c < d ==> &0 < (b + d) - (a + c)`; DIMINDEX_GE_1; LE_1]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[GSYM REAL_ROOT_DIV] THEN REWRITE_TAC[GSYM PRODUCT_DIV_NUMSEG] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (1..dimindex(:N)) (\i. ((b:real^N)$i - (a:real^N)$i) / ((b$i + d$i) - (a$i + c$i))) / &(dimindex(:N)) + sum (1..dimindex(:N)) (\i. ((d:real^N)$i - (c:real^N)$i) / ((b$i + d$i) - (a$i + c$i))) / &(dimindex(:N))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_ROOT_LE o snd) THEN (ANTS_TAC THENL [SIMP_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_EQ; DIMINDEX_GE_1; LE_1; REAL_LE_RDIV_EQ; REAL_MUL_LZERO] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC AGM THEN SIMP_TAC[HAS_SIZE_NUMSEG_1; DIMINDEX_GE_1; LE_1; IN_NUMSEG]]) THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_DIV THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM SUM_ADD_NUMSEG] THEN ASM_SIMP_TAC[REAL_FIELD `a < b /\ c < d ==> (b - a) * inv((b + d) - (a + c)) + (d - c) * inv((b + d) - (a + c)) = &1`] THEN REWRITE_TAC[SUM_CONST_NUMSEG; ADD_SUB] THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_MUL_RINV; REAL_LE_REFL; REAL_OF_NUM_EQ; DIMINDEX_NONZERO]]);; (* ------------------------------------------------------------------------- *) (* Now for a finite union of boxes. *) (* ------------------------------------------------------------------------- *) let BRUNN_MINKOWSKI_ELEMENTARY = prove (`!s t:real^N->bool. (s = {} <=> t = {}) /\ (?d. d division_of s) /\ (?d. d division_of t) ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`; `d1:(real^N->bool)->bool`; `d2:(real^N->bool)->bool`] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`] THEN SIMP_TAC[MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO] THEN STRIP_TAC THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[TAUT `p ==> q /\ r ==> s <=> q /\ p /\ r ==> s`]] THEN X_CHOOSE_THEN `n:num` MP_TAC (ISPEC `CARD(d1:(real^N->bool)->bool) + CARD(d2:(real^N->bool)->bool)` (GSYM EXISTS_REFL)) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:real^N->bool`; `s:real^N->bool`; `d2:(real^N->bool)->bool`; `d1:(real^N->bool)->bool`; `n:num`] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[MESON[] `(!m. m < n ==> !a b c d. f a b = m /\ stuff a b c d ==> other a b c d) <=> (!a b c d. f a b:num < n /\ stuff a b c d ==> other a b c d)`] THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[] `(!d d' s s'. P d d' s s' ==> P d' d s' s) /\ (!d d' s s'. ~(2 <= CARD d) /\ ~(2 <= CARD d') ==> P d d' s s') /\ (!d d' s s'. negligible s ==> P d d' s s') /\ (!d d' s s'. 2 <= CARD d /\ ~(negligible s) /\ ~(negligible s') ==> P d d' s s') ==> !d d' s s'. P d d' s s'`) THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [REWRITE_TAC[ADD_SYM; CONJ_ACI]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x >= a + b ==> y >= b + a`) THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]; REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(d1:(real^N->bool)->bool) /\ FINITE(d2:(real^N->bool)->bool)` THENL [ALL_TAC; REWRITE_TAC[division_of] THEN ASM_MESON_TAC[]] THEN ASM_SIMP_TAC[CARD_EQ_0; ARITH_RULE `~(2 <= n) <=> n = 0 \/ n = 1`] THEN ASM_CASES_TAC `d1:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[EMPTY_DIVISION_OF] THEN MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `d2:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[EMPTY_DIVISION_OF] THEN MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `(d1:(real^N->bool)->bool) HAS_SIZE 1 /\ (d2:(real^N->bool)->bool) HAS_SIZE 1` MP_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN CONV_TAC(LAND_CONV(BINOP_CONV HAS_SIZE_CONV)) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool` SUBST_ALL_TAC) (X_CHOOSE_THEN `v:real^N->bool` SUBST_ALL_TAC)) THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of; UNIONS_1; IN_SING]) THEN REPEAT(FIRST_X_ASSUM (CONJUNCTS_THEN2 MP_TAC (SUBST_ALL_TAC o SYM o CONJUNCT2) o CONJUNCT2)) THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BRUNN_MINKOWSKI_INTERVAL THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN SUBGOAL_THEN `measure(s:real^N->bool) = &0` SUBST1_TAC THENL [ASM_SIMP_TAC[MEASURE_EQ_0]; ALL_TAC] THEN SIMP_TAC[ROOT_0; DIMINDEX_NONZERO; REAL_ADD_LID; real_ge] THEN MATCH_MP_TAC ROOT_MONO_LE THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN SUBGOAL_THEN `?a:real^N. a IN s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) t)` THEN CONJ_TAC THENL [REWRITE_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_TRANSLATION_EQ] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]] THEN SUBGOAL_THEN `!d1 d2 s t i j k. CARD d1 + CARD d2 = n /\ 1 <= k /\ k <= dimindex(:N) /\ ~(i = j) /\ i IN d1 /\ i SUBSET {x:real^N | x$k <= &0} /\ j IN d1 /\ j SUBSET {x | x$k >= &0} /\ ~(negligible i) /\ ~(negligible j) /\ ~(s = {}) /\ ~(t = {}) /\ ~(negligible s) /\ ~(negligible t) /\ d1 division_of s /\ d2 division_of t ==> root(dimindex (:N)) (measure {x + y | x IN s /\ y IN t}) >= root(dimindex (:N)) (measure s) + root(dimindex (:N)) (measure t)` MP_TAC THENL [ALL_TAC; POP_ASSUM(LABEL_TAC "*") THEN DISCH_THEN(LABEL_TAC "+") THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `?i:real^N->bool. i IN d1 /\ interior i = {}` THENL [REMOVE_THEN "+" (K ALL_TAC) THEN REMOVE_THEN "*" MP_TAC THEN DISCH_THEN(MP_TAC o SPECL [`{i:real^N->bool | i IN d1 /\ ~(interior i = {})}`; `d2:(real^N->bool)->bool`; `UNIONS {i:real^N->bool | i IN d1 /\ ~(interior i = {})}`; `t:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [EXPAND_TAC "n" THEN REWRITE_TAC[LT_ADD_RCANCEL] THEN MATCH_MP_TAC CARD_PSUBSET THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[DIVISION_OF_FINITE]]; DISCH_TAC THEN SUBGOAL_THEN `negligible(UNIONS {i | i IN d1 /\ ~(interior i = {})} UNION UNIONS {i:real^N->bool | i IN d1 /\ interior i = {}})` MP_TAC THENL [ASM_REWRITE_TAC[UNION_EMPTY] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[DIVISION_OF_FINITE]; REWRITE_TAC[IN_ELIM_THM; IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; NEGLIGIBLE_INTERVAL]]; REWRITE_TAC[GSYM UNIONS_UNION; SET_RULE `{x | x IN s /\ ~Q x} UNION {x | x IN s /\ Q x} = s`] THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC DIVISION_OF_SUBSET THEN EXISTS_TAC `d1:(real^N->bool)->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; SET_TAC[]]]; MATCH_MP_TAC(REAL_ARITH `c' <= c /\ a' = a ==> c' >= a' + b ==> c >= a + b`) THEN CONJ_TAC THENL [MATCH_MP_TAC ROOT_MONO_LE THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ELEMENTARY_COMPACT]] THEN MATCH_MP_TAC COMPACT_UNIONS THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN ASM_MESON_TAC[COMPACT_INTERVAL]; MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; MATCH_MP_TAC(SET_RULE `s' SUBSET s ==> {f x y | x IN s' /\ y IN t} SUBSET {f x y | x IN s /\ y IN t}`) THEN SUBGOAL_THEN `s:real^N->bool = UNIONS d1` SUBST1_TAC THENL [ASM_MESON_TAC[division_of]; MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[]]]; AP_TERM_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {i:real^N->bool | i IN d1 /\ interior i = {}}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[DIVISION_OF_FINITE]; REWRITE_TAC[IN_ELIM_THM; IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; NEGLIGIBLE_INTERVAL]]; MATCH_MP_TAC(SET_RULE `s' UNION s'' = s ==> (s' DIFF s) UNION (s DIFF s') SUBSET s''`) THEN REWRITE_TAC[GSYM UNIONS_UNION; SET_RULE `{x | x IN s /\ ~Q x} UNION {x | x IN s /\ Q x} = s`] THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_REWRITE_TAC[]]]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN REMOVE_THEN "*" (K ALL_TAC) THEN SUBGOAL_THEN `?d:(real^N->bool)->bool. d SUBSET d1 /\ d HAS_SIZE 2` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP CHOOSE_SUBSET o MATCH_MP DIVISION_OF_FINITE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV HAS_SIZE_CONV)) THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `i:real^N->bool` MP_TAC) THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `j:real^N->bool` MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN REWRITE_TAC[UNWIND_THM2; INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN MP_TAC(ASSUME `d1 division_of (s:real^N->bool)`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`i:real^N->bool`; `j:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?u v w z. i = interval[u:real^N,v] /\ j = interval[w:real^N,z]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[DIVISION_OF]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM INTERIOR_INTER; INTER_INTERVAL] THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_EQ_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SIMP_TAC[LAMBDA_BETA; ASSUME `1 <= k`; ASSUME `k <= dimindex(:N)`] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_BETWEEN] THEN DISCH_THEN(X_CHOOSE_THEN `a:real` MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `min v z <= a /\ a <= max u w ==> u < v /\ w < z ==> u <= a /\ v <= a /\ a <= w /\ a <= z \/ w <= a /\ z <= a /\ a <= u /\ a <= v`)) THEN ANTS_TAC THENL [UNDISCH_TAC `!i:real^N->bool. i IN d1 ==> ~(interior i = {})` THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `interval[u:real^N,v]` th) THEN MP_TAC(ISPEC `interval[w:real^N,z]` th)) THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_NE_EMPTY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`IMAGE (IMAGE (\x:real^N. x - a % basis k)) d1`; `d2:(real^N->bool)->bool`; `IMAGE (\x:real^N. x - a % basis k) s`; `t:real^N->bool`]) THENL [DISCH_THEN(MP_TAC o SPECL [`IMAGE (\x:real^N. x - a % basis k) i`; `IMAGE (\x:real^N. x - a % basis k) j`; `k:num`]); DISCH_THEN(MP_TAC o SPECL [`IMAGE (\x:real^N. x - a % basis k) j`; `IMAGE (\x:real^N. x - a % basis k) i`; `k:num`])] THEN (ASM_REWRITE_TAC[] THEN ANTS_TAC THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "n" THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_OF_FINITE]] THEN MATCH_MP_TAC(MESON[] `(!x y. Q x y ==> R x y) ==> (!x y. P x /\ P y /\ Q x y ==> R x y)`) THEN REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC; MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) /\ ~(s = t) ==> ~(IMAGE f s = IMAGE f t)`) THEN REWRITE_TAC[VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN ASM_MESON_TAC[]; MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_MESON_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; REAL_MUL_RID; REAL_LE_SUB_RADD; REAL_ADD_LID] THEN REWRITE_TAC[IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_MESON_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; real_ge] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; REAL_MUL_RID; REAL_LE_SUB_LADD; REAL_ADD_LID] THEN REWRITE_TAC[IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN ASM_MESON_TAC[NEGLIGIBLE_INTERVAL; INTERIOR_CLOSED_INTERVAL]; REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN ASM_MESON_TAC[NEGLIGIBLE_INTERVAL; INTERIOR_CLOSED_INTERVAL]; ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ]; REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN ASM_REWRITE_TAC[DIVISION_OF_TRANSLATION]; MATCH_MP_TAC(REAL_ARITH `a = a' /\ b = b' ==> a >= b + c ==> a' >= b' + c`) THEN REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN REWRITE_TAC[MEASURE_TRANSLATION] THEN REWRITE_TAC[GSYM VECTOR_ADD_ASSOC; SET_RULE `{f x y | x IN IMAGE g s /\ y IN t} = {f (g x) y | x IN s /\ y IN t}`] THEN REWRITE_TAC[SET_RULE `{a + x + y:real^N | x IN s /\ y IN t} = IMAGE (\z. a + z) {x + y | x IN s /\ y IN t}`] THEN REWRITE_TAC[MEASURE_TRANSLATION]])]] THEN SUBGOAL_THEN `!d1 d2 s t i j k. CARD d1 + CARD d2 = n /\ 1 <= k /\ k <= dimindex(:N) /\ ~(i = j) /\ i IN d1 /\ i SUBSET {x:real^N | x$k <= &0} /\ ~(negligible i) /\ j IN d1 /\ j SUBSET {x | x$k >= &0} /\ ~(negligible j) /\ measure(t INTER {x | x$k <= &0}) / measure t = measure(s INTER {x | x$k <= &0}) / measure s /\ measure(t INTER {x | x$k >= &0}) / measure t = measure(s INTER {x | x$k >= &0}) / measure s /\ ~(s = {}) /\ ~(t = {}) /\ ~(negligible s) /\ ~(negligible t) /\ d1 division_of s /\ d2 division_of t ==> root(dimindex (:N)) (measure {x + y | x IN s /\ y IN t}) >= root(dimindex (:N)) (measure s) + root(dimindex (:N)) (measure t)` MP_TAC THENL [ALL_TAC; POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < measure(s:real^N->bool) /\ &0 < measure(t:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_ELEMENTARY]; ALL_TAC] THEN SUBGOAL_THEN `?a. measure(t INTER {x:real^N | x$k <= a}) / measure t = measure(s INTER {x:real^N | x$k <= &0}) / measure s` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `&0 <= measure(s INTER {x:real^N | x$k <= &0}) / measure s /\ measure(s INTER {x:real^N | x$k <= &0}) / measure s <= &1` MP_TAC THENL [ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_MUL_LZERO] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_POS_LE; REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; SET_TAC[]]] THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; SPEC_TAC(`measure(s INTER {x:real^N | x$k <= &0}) / measure s`, `u:real`)] THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN SUBGOAL_THEN `?b:real. &0 < b /\ !x:real^N. x IN t ==> abs(x$k) <= b` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `bounded(t:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[ELEMENTARY_BOUNDED]; REWRITE_TAC[BOUNDED_POS]] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `?a. a IN real_interval[--b,b] /\ measure (t INTER {x:real^N | x$k <= a}) / measure t = u` (fun th -> MESON_TAC[th]) THEN MATCH_MP_TAC REAL_IVT_INCREASING THEN REPEAT CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 <= u ==> x = &0 ==> x <= u`)) THEN REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN MATCH_MP_TAC MEASURE_EQ_0 THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | x$k = --b}` THEN ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; GSYM REAL_LE_ANTISYM] THEN ASM_MESON_TAC[REAL_ARITH `abs x <= b ==> --b <= x`]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `u <= &1 ==> x = &1 ==> u <= x`)) THEN ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_MUL_LID] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_ARITH `abs x <= b ==> x <= b`]] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE THEN ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d1:(real^N->bool)->bool`; `IMAGE (IMAGE (\x:real^N. x - a % basis k)) d2`; `s:real^N->bool`; `IMAGE (\x:real^N. x - a % basis k) t`; `i:real^N->bool`; `j:real^N->bool`; `k:num`]) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ; DIVISION_OF_TRANSLATION] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXPAND_TAC "n" THEN AP_TERM_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_OF_FINITE]] THEN MATCH_MP_TAC(MESON[] `(!x y. Q x y ==> R x y) ==> (!x y. P x /\ P y /\ Q x y ==> R x y)`) THEN REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (\x. --(a % basis k) + x) t INTER {x:real^N | x$k >= &0} = IMAGE (\x. --(a % basis k) + x) (t INTER {x | x$k >= a}) /\ IMAGE (\x. --(a % basis k) + x) t INTER {x:real^N | x$k <= &0} = IMAGE (\x. --(a % basis k) + x) (t INTER {x | x$k <= a})` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `!g. (!x. f(x) IN s' <=> x IN s) /\ (!x. g(f x) = x) ==> IMAGE f t INTER s' = IMAGE f (t INTER s)`) THEN ASM_SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; VECTOR_NEG_COMPONENT] THEN EXISTS_TAC `\x:real^N. a % basis k + x` THEN (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]); ALL_TAC] THEN REWRITE_TAC[MEASURE_TRANSLATION] THEN MATCH_MP_TAC(REAL_FIELD `&0 < s /\ &0 < t /\ t' / t = s' / s /\ s' + s'' = s /\ t' + t'' = t ==> t' / t = s' / s /\ t'' / t = s'' / s`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN (REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; MATCH_MP_TAC(SET_RULE `(!x. P x \/ Q x) ==> s INTER {x | P x} UNION s INTER {x | Q x} = s`) THEN REAL_ARITH_TAC; REWRITE_TAC[SET_RULE `(t INTER {x | P x}) INTER (t INTER {x | Q x}) = t INTER {x | P x /\ Q x}`] THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_SUBSET; INTER_SUBSET] `negligible t ==> negligible(s INTER t)`) THEN REWRITE_TAC[REAL_ARITH `x <= a /\ x >= a <=> x = a`] THEN ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE]]); REWRITE_TAC[MEASURE_TRANSLATION] THEN MATCH_MP_TAC(REAL_ARITH `a' = a ==> a' >= b ==> a >= b`) THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `{f x y | x IN s /\ y IN IMAGE g t} = {f x (g y) | x IN s /\ y IN t}`] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x + a + y:real^N = a + x + y`] THEN REWRITE_TAC[SET_RULE `{a + x + y:real^N | x IN s /\ y IN t} = IMAGE (\z. a + z) {x + y | x IN s /\ y IN t}`] THEN REWRITE_TAC[MEASURE_TRANSLATION]]] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_ge] THEN SUBGOAL_THEN `measurable(s:real^N->bool) /\ measurable(t:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; ALL_TAC] THEN SUBGOAL_THEN `measurable {x + y:real^N | x IN s /\ y IN t}` ASSUME_TAC THENL [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; ALL_TAC] THEN SUBGOAL_THEN `&0 < measure(s:real^N->bool) /\ &0 < measure(t:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MEASURABLE_MEASURE_POS_LT]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(d1:(real^N->bool)->bool) /\ FINITE(d2:(real^N->bool)->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_LE_ROOT o snd) THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; ROOT_POS_LE; REAL_LE_ADD] THEN DISCH_THEN SUBST1_TAC THEN ABBREV_TAC `dl = {l INTER {x:real^N | x$k <= &0} |l| l IN d1 DELETE j /\ ~(l INTER {x | x$k <= &0} = {})}` THEN ABBREV_TAC `dr = {l INTER {x:real^N | x$k >= &0} |l| l IN d1 DELETE i /\ ~(l INTER {x | x$k >= &0} = {})}` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure {x + y:real^N | x IN UNIONS dl /\ y IN (t INTER {x | x$k <= &0})} + measure {x + y | x IN UNIONS dr /\ y IN (t INTER {x | x$k >= &0})}` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure {x + y:real^N | x IN (s INTER {x | x$k <= &0}) /\ y IN (t INTER {x | x$k <= &0})} + measure {x + y:real^N | x IN (s INTER {x | x$k >= &0}) /\ y IN (t INTER {x | x$k >= &0})}` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN (MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_UNIONS THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN ASM_SIMP_TAC[IN_DELETE; FINITE_DELETE; FINITE_IMAGE; FINITE_RESTRICT; IMP_CONJ] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN ASM_SIMP_TAC[INTERVAL_SPLIT; COMPACT_INTERVAL]; MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]]; MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN CONJ_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; MATCH_MP_TAC(SET_RULE `s SUBSET s' ==> {x + y:real^N | x IN s /\ y IN t} SUBSET {x + y:real^N | x IN s' /\ y IN t}`) THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[IN_DELETE; IN_INTER; IN_ELIM_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_MESON_TAC[IN_UNIONS]]); ALL_TAC] THEN SUBGOAL_THEN `s = (s INTER {x:real^N | x$k <= &0}) UNION (s INTER {x | x$k >= &0}) /\ t = (t INTER {x:real^N | x$k <= &0}) UNION (t INTER {x | x$k >= &0})` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x \/ Q x) ==> s = (s INTER {x | P x}) UNION (s INTER {x | Q x})`) THEN REAL_ARITH_TAC; DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])] THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_NEGLIGIBLE_UNION o lhand o snd) THEN ANTS_TAC THENL [REPEAT(CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN CONJ_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; ALL_TAC]) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | x$k = &0}` THEN ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(SET_RULE `s SUBSET {x | P x} /\ t SUBSET {x | Q x} ==> (s INTER t) SUBSET {x | P x /\ Q x}`) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN SIMP_TAC[IN_INTER; IN_ELIM_THM; REAL_LE_ADD; VECTOR_ADD_COMPONENT; real_ge; REAL_ARITH `x <= &0 /\ y <= &0 ==> x + y <= &0`]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNION THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN CONJ_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN CONJ_TAC THEN MATCH_MP_TAC COMPACT_UNION THEN CONJ_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; SET_TAC[]]] THEN SUBGOAL_THEN `&0 < measure(s INTER {x:real^N | x$k <= &0}) /\ &0 < measure(s INTER {x:real^N | x$k >= &0})` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER_HALFSPACE_GE] THEN CONJ_TAC THENL [UNDISCH_TAC `~negligible(i:real^N->bool)`; UNDISCH_TAC `~negligible(j:real^N->bool)`] THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN UNDISCH_TAC `d1 division_of (s:real^N->bool)` THEN REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`dl:(real^N->bool)->bool`; `{l INTER {x:real^N | x$k <= &0} |l| l IN d2 /\ ~(l INTER {x | x$k <= &0} = {})}`; `UNIONS dl :real^N->bool`; `t INTER {x:real^N | x$k <= &0}`] th) THEN MP_TAC(SPECL [`dr:(real^N->bool)->bool`; `{l INTER {x:real^N | x$k >= &0} |l| l IN d2 /\ ~(l INTER {x | x$k >= &0} = {})}`; `UNIONS dr :real^N->bool`; `t INTER {x:real^N | x$k >= &0}`] th)) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [EXPAND_TAC "n" THEN MATCH_MP_TAC LTE_ADD2 THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN CONJ_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(d1 DELETE (i:real^N->bool))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `CARD {x | x IN IMAGE f s /\ P x} <= CARD(IMAGE f s) /\ CARD(IMAGE f s) <= CARD s ==> CARD {x | x IN IMAGE f s /\ P x} <= CARD s`) THEN ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DELETE] THEN SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIONS] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `j INTER {x:real^N | x$k >= &0}` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; MEMBER_NOT_EMPTY] THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_DELETE; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [EXISTS_TAC `j:real^N->bool` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET t ==> ~(s INTER t = {})`) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of]]; DISCH_TAC THEN UNDISCH_TAC `measure (t INTER {x:real^N | x$k >= &0}) / measure t = measure (s INTER {x:real^N | x$k >= &0}) / measure s` THEN ASM_SIMP_TAC[MEASURE_EMPTY; REAL_EQ_RDIV_EQ] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; REWRITE_TAC[division_of] THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN CONJ_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET UNIONS s`) THEN ASM SET_TAC[]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `interior(s) INTER interior(s') = {} /\ interior(s INTER t) SUBSET interior s /\ interior(s' INTER t) SUBSET interior s' ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_MESON_TAC[division_of]]; REWRITE_TAC[division_of] THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`) THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `interior(s) INTER interior(s') = {} /\ interior(s INTER t) SUBSET interior s /\ interior(s' INTER t) SUBSET interior s' ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_MESON_TAC[division_of]; REWRITE_TAC[SET_RULE `{x | x IN s /\ ~(x = a)} = s DELETE a`] THEN GEN_REWRITE_TAC LAND_CONV [SET_RULE `s = {} UNION s`] THEN REWRITE_TAC[GSYM UNIONS_INSERT] THEN REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = x INSERT s`] THEN REWRITE_TAC[UNIONS_INSERT; UNION_EMPTY] THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[division_of]]]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [EXPAND_TAC "n" THEN MATCH_MP_TAC LTE_ADD2 THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN CONJ_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(d1 DELETE (j:real^N->bool))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `CARD {x | x IN IMAGE f s /\ P x} <= CARD(IMAGE f s) /\ CARD(IMAGE f s) <= CARD s ==> CARD {x | x IN IMAGE f s /\ P x} <= CARD s`) THEN ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DELETE] THEN SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIONS] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `i INTER {x:real^N | x$k <= &0}` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; MEMBER_NOT_EMPTY] THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_DELETE; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [EXISTS_TAC `i:real^N->bool` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET t ==> ~(s INTER t = {})`) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of]]; DISCH_TAC THEN UNDISCH_TAC `measure (t INTER {x:real^N | x$k <= &0}) / measure t = measure (s INTER {x:real^N | x$k <= &0}) / measure s` THEN ASM_SIMP_TAC[MEASURE_EMPTY; REAL_EQ_RDIV_EQ] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; REWRITE_TAC[division_of] THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN CONJ_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET UNIONS s`) THEN ASM SET_TAC[]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `interior(s) INTER interior(s') = {} /\ interior(s INTER t) SUBSET interior s /\ interior(s' INTER t) SUBSET interior s' ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_MESON_TAC[division_of]]; REWRITE_TAC[division_of] THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`) THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `interior(s) INTER interior(s') = {} /\ interior(s INTER t) SUBSET interior s /\ interior(s' INTER t) SUBSET interior s' ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_MESON_TAC[division_of]; REWRITE_TAC[SET_RULE `{x | x IN s /\ ~(x = a)} = s DELETE a`] THEN GEN_REWRITE_TAC LAND_CONV [SET_RULE `s = {} UNION s`] THEN REWRITE_TAC[GSYM UNIONS_INSERT] THEN REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = x INSERT s`] THEN REWRITE_TAC[UNIONS_INSERT; UNION_EMPTY] THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[division_of]]]; ALL_TAC] THEN REWRITE_TAC[real_ge; IMP_IMP] THEN SUBGOAL_THEN `compact(UNIONS dl:real^N->bool) /\ compact(UNIONS dr:real^N->bool)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC COMPACT_UNIONS THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN REWRITE_TAC[IMP_CONJ; IN_ELIM_THM; FORALL_IN_IMAGE; IN_DELETE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[division_of; COMPACT_INTERVAL]; ALL_TAC] THEN SUBGOAL_THEN `measurable(UNIONS dl:real^N->bool) /\ measurable(UNIONS dr:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[MEASURABLE_COMPACT]; ALL_TAC] THEN SUBGOAL_THEN `measurable { x + y:real^N | x IN UNIONS dl /\ y IN t INTER {x | x$k <= &0}} /\ measurable { x + y:real^N | x IN UNIONS dr /\ y IN t INTER {x | &0 <= x$k}}` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> x >= &0`; CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; ALL_TAC] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [REAL_LE_ROOT; DIMINDEX_NONZERO; REAL_LE_ADD; ROOT_POS_LE; MEASURE_POS_LE; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER_HALFSPACE_GE; REAL_ARITH `&0 <= x <=> x >= &0`] THEN MATCH_MP_TAC(REAL_ARITH `x <= a' + b' ==> a' <= a /\ b' <= b ==> x <= a + b`) THEN SUBGOAL_THEN `measure(UNIONS dl :real^N->bool) = measure(s INTER {x:real^N | x$k <= &0}) /\ measure(UNIONS dr :real^N->bool) = measure(s INTER {x:real^N | x$k >= &0})` (CONJUNCTS_THEN SUBST1_TAC) THENL [MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = {t | t IN IMAGE f s /\ ~(t = a)}`] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ ~(x = a)} = s DELETE a`] THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SET_RULE `s = {} UNION s`] THEN REWRITE_TAC[GSYM UNIONS_INSERT] THEN REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = x INSERT s`] THEN REWRITE_TAC[UNIONS_INSERT; UNION_EMPTY] THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | x$k = &0}` THEN ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ t DIFF s SUBSET u ==> (s DIFF t UNION t DIFF s) SUBSET u`) THEN REWRITE_TAC[SET_RULE `s INTER u DIFF t INTER u = (s DIFF t) INTER u`] THEN (SUBGOAL_THEN `s:real^N->bool = UNIONS d1` SUBST1_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; real_ge; SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s INTER u SUBSET u INTER t`); MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`)] THEN RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `root (dimindex (:N)) (measure (s INTER {x:real^N | x$k <= &0})) + root (dimindex (:N)) (measure (t INTER {x:real^N | x$k <= &0})) = root (dimindex (:N)) (measure (s INTER {x | x$k <= &0})) * (&1 + root (dimindex (:N)) (measure (t INTER {x | x$k <= &0})) / root (dimindex (:N)) (measure (s INTER {x | x$k <= &0}))) /\ root (dimindex (:N)) (measure (s INTER {x:real^N | x$k >= &0})) + root (dimindex (:N)) (measure (t INTER {x:real^N | x$k >= &0})) = root (dimindex (:N)) (measure (s INTER {x | x$k >= &0})) * (&1 + root (dimindex (:N)) (measure (t INTER {x | x$k >= &0})) / root (dimindex (:N)) (measure (s INTER {x | x$k >= &0})))` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC(REAL_FIELD `&0 < s ==> s + t = s * (&1 + t / s)`) THEN ASM_SIMP_TAC[ROOT_POS_LT; DIMINDEX_NONZERO]; ALL_TAC] THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; GSYM REAL_ROOT_DIV; MEASURE_POS_LE; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER_HALFSPACE_GE] THEN SUBGOAL_THEN `measure(t INTER {x:real^N | x$k <= &0}) / measure(s INTER {x:real^N | x$k <= &0}) = measure t / measure s /\ measure(t INTER {x:real^N | x$k >= &0}) / measure(s INTER {x:real^N | x$k >= &0}) = measure t / measure s` (CONJUNCTS_THEN SUBST1_TAC) THENL [MATCH_MP_TAC(REAL_FIELD `tn / t = sn / s /\ tp / t = sp / s /\ &0 < sp /\ &0 < sn /\ &0 < s /\ &0 < t ==> tn / sn = t / s /\ tp / sp = t / s`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_POW_MUL] THEN ASM_SIMP_TAC[REAL_POW_ROOT; DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER_HALFSPACE_GE] THEN SUBGOAL_THEN `measure (s INTER {x | x$k <= &0}) + measure (s INTER {x | x$k >= &0}) = root (dimindex(:N)) (measure(s:real^N->bool)) pow (dimindex(:N))` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_POW_ROOT; DIMINDEX_NONZERO; REAL_LT_IMP_LE] THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN ASM_SIMP_TAC[MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER_HALFSPACE_GE] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | x$k = &0}` THEN ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; real_ge] THEN SET_TAC[]]; ASM_SIMP_TAC[GSYM REAL_ROOT_MUL; MEASURE_POS_LE; DIMINDEX_NONZERO; REAL_LE_DIV; GSYM REAL_POW_MUL; REAL_ADD_LDISTRIB; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Now for open sets. *) (* ------------------------------------------------------------------------- *) let BRUNN_MINKOWSKI_OPEN = prove (`!s t:real^N->bool. (s = {} <=> t = {}) /\ bounded s /\ open s /\ bounded t /\ open t ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[SET_RULE `{x + y:real^N | x IN {} /\ y IN {}} = {}`; REAL_LE_REFL; MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO; real_ge; REAL_ADD_LID] THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `atreal(&0) within {e | &0 <= e}` REALLIM_UBOUND) THEN EXISTS_TAC `\e. root (dimindex(:N)) (measure(s:real^N->bool) - e) + root (dimindex(:N)) (measure(t:real^N->bool) - e)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\e. (measure(s:real^N->bool) - e) rpow (inv(&(dimindex(:N)))) + (measure(t:real^N->bool) - e) rpow (inv(&(dimindex(:N))))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO; MEASURE_OPEN_POS_LT] THEN REPEAT STRIP_TAC THEN BINOP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_ROOT_RPOW THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_ROOT_RPOW; MEASURE_OPEN_POS_LT; DIMINDEX_NONZERO; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `measure(s:real^N->bool) = measure s - &0`] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[GSYM(REWRITE_CONV [o_DEF] `(\x. x rpow y) o (\e. s - e)`)] THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN ASM_SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_WITHIN_ID; REAL_CONTINUOUS_CONST] THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]]; W(MP_TAC o PART_MATCH (lhand o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION; IN_SING] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC]; REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO; MEASURE_OPEN_POS_LT] THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `&0 <= e` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MAP_EVERY (fun l -> MP_TAC(ISPECL l OPEN_MEASURABLE_INNER_DIVISION)) [[`t:real^N->bool`; `e:real`]; [`s:real^N->bool`; `e:real`]] THEN ASM_SIMP_TAC[MEASURABLE_OPEN; GSYM REAL_LT_SUB_RADD] THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `E:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`UNIONS D:real^N->bool`; `UNIONS E:real^N->bool`] BRUNN_MINKOWSKI_ELEMENTARY) THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURE_EMPTY; REAL_ARITH `e < s ==> ~(s - e < &0)`]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `s1 <= r1 /\ s2 <= r2 /\ rs <= s ==> rs >= r1 + r2 ==> s1 + s2 <= s`) THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC ROOT_MONO_LE THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; REAL_SUB_LE; REAL_LT_IMP_LE] THEN SUBGOAL_THEN `measurable {x + y :real^N | x IN UNIONS D /\ y IN UNIONS E}` ASSUME_TAC THENL [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; MATCH_MP_TAC MEASURE_SUBSET] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_OPEN THEN ASM_SIMP_TAC[BOUNDED_SUMS; OPEN_SUMS]]);; (* ------------------------------------------------------------------------- *) (* Now for convex sets. *) (* ------------------------------------------------------------------------- *) let BRUNN_MINKOWSKI_CONVEX = prove (`!s t:real^N->bool. (s = {} <=> t = {}) /\ bounded s /\ convex s /\ bounded t /\ convex t ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[BRUNN_MINKOWSKI_OPEN; OPEN_EMPTY] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM MEASURE_INTERIOR; NEGLIGIBLE_CONVEX_FRONTIER; real_ge] THEN ASM_CASES_TAC `interior s:real^N->bool = {}` THENL [ASM_SIMP_TAC[MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO; REAL_ADD_LID] THEN MATCH_MP_TAC ROOT_MONO_LE THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_INTERIOR] THEN SUBGOAL_THEN `?a:real^N. a IN s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) t)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[MEASURE_TRANSLATION; MEASURE_INTERIOR; NEGLIGIBLE_CONVEX_FRONTIER; REAL_LE_REFL]; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_CONVEX; CONVEX_SUMS; BOUNDED_SUMS] THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `interior t:real^N->bool = {}` THENL [ASM_SIMP_TAC[MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO; REAL_ADD_RID] THEN MATCH_MP_TAC ROOT_MONO_LE THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_INTERIOR] THEN SUBGOAL_THEN `?a:real^N. a IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) s)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[MEASURE_TRANSLATION; MEASURE_INTERIOR; NEGLIGIBLE_CONVEX_FRONTIER; REAL_LE_REFL]; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_CONVEX; CONVEX_SUMS; BOUNDED_SUMS] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ADD_SYM] THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `root (dimindex (:N)) (measure {x + y:real^N | x IN interior s /\ y IN interior t})` THEN ASM_SIMP_TAC[GSYM real_ge; BRUNN_MINKOWSKI_OPEN; BOUNDED_INTERIOR; OPEN_INTERIOR] THEN REWRITE_TAC[real_ge] THEN MATCH_MP_TAC ROOT_MONO_LE THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; BOUNDED_SUMS; MEASURABLE_CONVEX; BOUNDED_INTERIOR; CONVEX_SUMS; CONVEX_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `s' SUBSET s /\ t' SUBSET t ==> {x + y:real^N | x IN s' /\ y IN t'} SUBSET {x + y | x IN s /\ y IN t}`) THEN REWRITE_TAC[INTERIOR_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Now for compact sets. *) (* ------------------------------------------------------------------------- *) let INTERS_SUMS_CLOSED_BALL_SEQUENTIAL = prove (`!s:real^N->bool. closed s ==> INTERS {{x + d | x IN s /\ d IN ball(vec 0,inv(&n + &1))} | n IN (:num)} = s`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SEPARATE_POINT_CLOSED) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `e:real^N`] THEN REWRITE_TAC[IN_BALL_0] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[NORM_ARITH `dist(y + e:real^N,y) = norm e`] THEN SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ASM_REAL_ARITH_TAC]; DISCH_TAC THEN X_GEN_TAC `n:num` THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]);; let MEASURE_SUMS_COMPACT_EPSILON = prove (`!s:real^N->bool. compact s ==> ((\e. measure {x + d | x IN s /\ d IN ball(vec 0,e)}) ---> measure s) (atreal (&0) within {e | &0 <= e})`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\n. {x + d:real^N | x IN s /\ d IN ball(vec 0,inv(&n + &1))}` HAS_MEASURE_NESTED_INTERS) THEN ASM_SIMP_TAC[INTERS_SUMS_CLOSED_BALL_SEQUENTIAL; COMPACT_IMP_CLOSED] THEN ANTS_TAC THENL [ASM_SIMP_TAC[MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] THEN GEN_TAC THEN MATCH_MP_TAC(SET_RULE `t' SUBSET t ==> {x + y:real^N | x IN s /\ y IN t'} SUBSET {x + y | x IN s /\ y IN t}`) THEN MATCH_MP_TAC SUBSET_BALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM(REWRITE_RULE[o_DEF] TENDSTO_REAL)] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY; REALLIM_WITHINREAL] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `inv(&N + &1)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `d:real` THEN REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO] THEN ASM_CASES_TAC `abs d = d` THENL [FIRST_X_ASSUM SUBST1_TAC THEN STRIP_TAC; ASM_REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `m <= m1 /\ m1 <= m2 ==> abs(m2 - m) < e ==> abs(m1 - m) < e`) THEN CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; MATCH_MP_TAC(SET_RULE `t' SUBSET t ==> {x + y:real^N | x IN s /\ y IN t'} SUBSET {x + y | x IN s /\ y IN t}`) THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]);; let BRUNN_MINKOWSKI_COMPACT = prove (`!s t:real^N->bool. (s = {} <=> t = {}) /\ compact s /\ compact t ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, let lemma1 = prove (`{ x + y:real^N | x IN {x + d | x IN s /\ d IN ball(vec 0,e)} /\ y IN {y + d | y IN t /\ d IN ball(vec 0,e)}} = { z + d | z IN {x + y | x IN s /\ y IN t} /\ d IN ball(vec 0,&2 * e) }`, MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[IN_ELIM_THM; IN_BALL_0] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN X_GEN_TAC `k:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x + y:real^N` THEN EXISTS_TAC `d + k:real^N` THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN ASM_SIMP_TAC[NORM_ARITH `norm(d:real^N) < e /\ norm(k) < e ==> norm(d + k) < &2 * e`] THEN EXISTS_TAC `x:real^N` THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x + inv(&2) % d:real^N` THEN EXISTS_TAC `y + inv(&2) % d:real^N` THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN CONJ_TAC THENL [EXISTS_TAC `x:real^N`; EXISTS_TAC `y:real^N`] THEN EXISTS_TAC `inv(&2) % d:real^N` THEN ASM_REWRITE_TAC[NORM_MUL] THEN ASM_REAL_ARITH_TAC]) and lemma2 = prove (`(f ---> l) (atreal (&0) within {e | &0 <= e}) ==> ((\e. f(&2 * e)) ---> l) (atreal (&0) within {e | &0 <= e})`, REWRITE_TAC[REALLIM_WITHINREAL] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC) in REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[BRUNN_MINKOWSKI_OPEN; OPEN_EMPTY; BOUNDED_EMPTY] THEN STRIP_TAC THEN REWRITE_TAC[real_ge] THEN MATCH_MP_TAC(ISPEC `atreal (&0) within {e | &0 <= e}` REALLIM_LE) THEN EXISTS_TAC `\e. root (dimindex(:N)) (measure {x + d:real^N | x IN s /\ d IN ball(vec 0,e)}) + root (dimindex(:N)) (measure {x + d:real^N | x IN t /\ d IN ball(vec 0,e)})` THEN EXISTS_TAC `\e. root (dimindex(:N)) (measure { x + y:real^N | x IN {x + d | x IN s /\ d IN ball(vec 0,e)} /\ y IN {y + d | y IN t /\ d IN ball(vec 0,e)}})` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [REAL_ROOT_RPOW; DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_COMPACT; MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] THEN MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REALLIM_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MATCH_MP_TAC MEASURE_SUMS_COMPACT_EPSILON THEN ASM_REWRITE_TAC[]; REWRITE_TAC[lemma1] THEN MATCH_MP_TAC lemma2 THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 6) [REAL_ROOT_RPOW; DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_COMPACT; MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; COMPACT_SUMS; COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] THEN MATCH_MP_TAC REALLIM_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MATCH_MP_TAC MEASURE_SUMS_COMPACT_EPSILON THEN ASM_SIMP_TAC[COMPACT_SUMS]; W(MP_TAC o PART_MATCH (lhand o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION; IN_SING] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC]; MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[GSYM real_ge] THEN MATCH_MP_TAC BRUNN_MINKOWSKI_OPEN THEN SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL; COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Finally, for an arbitrary measurable set. In this general case, the *) (* measurability of the sum-set is needed as an additional hypothesis. *) (* ------------------------------------------------------------------------- *) let BRUNN_MINKOWSKI_MEASURABLE = prove (`!s t:real^N->bool. (s = {} <=> t = {}) /\ measurable s /\ measurable t /\ measurable {x + y | x IN s /\ y IN t} ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[BRUNN_MINKOWSKI_OPEN; OPEN_EMPTY; BOUNDED_EMPTY] THEN STRIP_TAC THEN REWRITE_TAC[real_ge] THEN ASM_CASES_TAC `measure(s:real^N->bool) = &0` THENL [ASM_SIMP_TAC[ROOT_0; DIMINDEX_NONZERO; REAL_ADD_LID] THEN MATCH_MP_TAC ROOT_MONO_LE THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE] THEN SUBGOAL_THEN `?a:real^N. a IN s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) t)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ] THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `measure(t:real^N->bool) = &0` THENL [ASM_SIMP_TAC[ROOT_0; DIMINDEX_NONZERO; REAL_ADD_RID] THEN MATCH_MP_TAC ROOT_MONO_LE THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE] THEN SUBGOAL_THEN `?a:real^N. a IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) s)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ADD_SYM] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `&0 < measure(s:real^N->bool) /\ &0 < measure(t:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_MEASURE_EQ_0]; ALL_TAC] THEN MATCH_MP_TAC(ISPEC `atreal(&0) within {e | &0 <= e}` REALLIM_UBOUND) THEN EXISTS_TAC `\e. root (dimindex(:N)) (measure(s:real^N->bool) - e) + root (dimindex(:N)) (measure(t:real^N->bool) - e)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\e. (measure(s:real^N->bool) - e) rpow (inv(&(dimindex(:N)))) + (measure(t:real^N->bool) - e) rpow (inv(&(dimindex(:N))))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO; MEASURE_OPEN_POS_LT] THEN REPEAT STRIP_TAC THEN BINOP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_ROOT_RPOW THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_ROOT_RPOW; MEASURE_OPEN_POS_LT; DIMINDEX_NONZERO; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `measure(s:real^N->bool) = measure s - &0`] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[GSYM(REWRITE_CONV [o_DEF] `(\x. x rpow y) o (\e. s - e)`)] THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN ASM_SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_WITHIN_ID; REAL_CONTINUOUS_CONST] THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]]; W(MP_TAC o PART_MATCH (lhand o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION; IN_SING] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC]; REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `&0 <= e` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MAP_EVERY (fun l -> MP_TAC(ISPECL l MEASURABLE_INNER_COMPACT)) [[`t:real^N->bool`; `e:real`]; [`s:real^N->bool`; `e:real`]] THEN ASM_SIMP_TAC[MEASURABLE_OPEN; GSYM REAL_LT_SUB_RADD] THEN DISCH_THEN(X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s':real^N->bool`; `t':real^N->bool`] BRUNN_MINKOWSKI_COMPACT) THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURE_EMPTY; REAL_ARITH `e < s ==> ~(s - e < &0)`]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `s1 <= r1 /\ s2 <= r2 /\ rs <= s ==> rs >= r1 + r2 ==> s1 + s2 <= s`) THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC ROOT_MONO_LE THEN ASM_SIMP_TAC[DIMINDEX_NONZERO; REAL_SUB_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[MEASURE_POS_LE; COMPACT_SUMS; MEASURABLE_COMPACT] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURE_POS_LE; COMPACT_SUMS; MEASURABLE_COMPACT] THEN ASM SET_TAC[]]);; hol-light/Examples/combin.ml000066400000000000000000000156241303454263000163340ustar00rootroot00000000000000(* ========================================================================= *) (* Church-Rosser property for combinatory logic (S and K combinators). *) (* *) (* This is adapted from a HOL4 develoment, itself derived from an old HOL88 *) (* example by Tom Melham and Juanito Camilleri. For a detailed discussion, *) (* see pp. 29-39 of the following paper: *) (* *) (* http://www.comlab.ox.ac.uk/tom.melham/pub/Camilleri-1992-RID.pdf *) (* ========================================================================= *) needs "Examples/reduct.ml";; (* ------------------------------------------------------------------------- *) (* Definition of confluence. *) (* ------------------------------------------------------------------------- *) let confluent = define `confluent R <=> !x y z. RTC R x y /\ RTC R x z ==> ?u. RTC R y u /\ RTC R z u`;; let confluent_diamond_RTC = prove (`!R. confluent R <=> CR(RTC R)`, REWRITE_TAC[confluent; CR]);; (* ------------------------------------------------------------------------- *) (* Basic term structure: S and K combinators and function application ("%"). *) (* ------------------------------------------------------------------------- *) parse_as_infix("%",(20,"left"));; let cl_INDUCT,cl_RECURSION = define_type "cl = S | K | % cl cl";; (* ------------------------------------------------------------------------- *) (* Reduction relation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("-->",(12,"right"));; let redn_rules, redn_ind, redn_cases = new_inductive_definition `(!x y f. x --> y ==> f % x --> f % y) /\ (!f g x. f --> g ==> f % x --> g % x) /\ (!x y. K % x % y --> x) /\ (!f g x. S % f % g % x --> (f % x) % (g % x))`;; (* ------------------------------------------------------------------------- *) (* A different, "parallel", reduction relation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("-||->",(12,"right"));; let predn_rules, predn_ind, predn_cases = new_inductive_definition `(!x. x -||-> x) /\ (!x y u v. x -||-> y /\ u -||-> v ==> x % u -||-> y % v) /\ (!x y. K % x % y -||-> x) /\ (!f g x. S % f % g % x -||-> (f % x) % (g % x))`;; (* ------------------------------------------------------------------------- *) (* Abbreviations for their reflexive-transitive closures. *) (* ------------------------------------------------------------------------- *) parse_as_infix("-->*",(12,"right"));; parse_as_infix("-||->*",(12,"right"));; let RTCredn = define `(-->*) = RTC(-->)`;; let RTCpredn = define `(-||->*) = RTC(-||->)`;; let RTCredn_rules = REWRITE_RULE[SYM RTCredn] (ISPEC `(-->)` RTC_RULES);; let RTCredn_ind = REWRITE_RULE[SYM RTCredn] (ISPEC `(-->)` RTC_INDUCT);; let RTCpredn_rules = REWRITE_RULE[SYM RTCpredn] (ISPEC `(-||->)` RTC_RULES);; let RTCpredn_ind = REWRITE_RULE[SYM RTCpredn] (ISPEC `(-||->)` RTC_INDUCT);; (* ------------------------------------------------------------------------- *) (* Prove that the two RTCs are actually the same. *) (* ------------------------------------------------------------------------- *) let RTCredn_RTCpredn = prove (`!x y. x -->* y ==> x -||->* y`, REWRITE_TAC[RTCredn; RTCpredn] THEN MATCH_MP_TAC RTC_MONO THEN MATCH_MP_TAC redn_ind THEN MESON_TAC[predn_rules]);; let RTCredn_ap_monotonic = prove (`!x y. x -->* y ==> !z. x % z -->* y % z /\ z % x -->* z % y`, MATCH_MP_TAC RTCredn_ind THEN MESON_TAC[RTCredn_rules; redn_rules]);; let predn_RTCredn = prove (`!x y. x -||-> y ==> x -->* y`, MATCH_MP_TAC predn_ind THEN MESON_TAC[RTCredn_rules; redn_rules; RTCredn_ap_monotonic]);; let RTCpredn_RTCredn = prove (`!x y. x -||->* y ==> x -->* y`, MATCH_MP_TAC RTCpredn_ind THEN MESON_TAC[predn_RTCredn; RTCredn_rules]);; let RTCpredn_EQ_RTCredn = prove (`(-||->*) = (-->*)`, REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[RTCpredn_RTCredn; RTCredn_RTCpredn]);; (* ------------------------------------------------------------------------- *) (* Now prove diamond property for "-||->" reduction. *) (* ------------------------------------------------------------------------- *) let characterise t = SIMP_RULE[distinctness "cl"; injectivity "cl"; GSYM EXISTS_REFL; RIGHT_EXISTS_AND_THM; GSYM CONJ_ASSOC; UNWIND_THM1] (SPEC t predn_cases);; let Sx_PREDN = prove (`!x y. S % x -||-> y <=> ?z. y = S % z /\ x -||-> z`, REWRITE_TAC[characterise `S % x`] THEN MESON_TAC[predn_rules; characterise `S`]);; let Kx_PREDN = prove (`!x y. K % x -||-> y <=> ?z. y = K % z /\ x -||-> z`, REWRITE_TAC[characterise `K % x`] THEN MESON_TAC[predn_rules; characterise `K`]);; let Kxy_PREDN = prove (`!x y z. K % x % y -||-> z <=> (?u v. z = K % u % v /\ x -||-> u /\ y -||-> v) \/ z = x`, REWRITE_TAC[characterise `K % x % y`] THEN MESON_TAC[predn_rules; Kx_PREDN]);; let Sxy_PREDN = prove (`!x y z. S % x % y -||-> z <=> ?u v. z = S % u % v /\ x -||-> u /\ y -||-> v`, REWRITE_TAC[characterise `S % x % y`] THEN MESON_TAC[predn_rules; characterise `S`; Sx_PREDN]);; let Sxyz_PREDN = prove (`!w x y z. S % w % x % y -||-> z <=> (?p q r. z = S % p % q % r /\ w -||-> p /\ x -||-> q /\ y -||-> r) \/ z = (w % y) % (x % y)`, REWRITE_TAC[characterise `S % w % x % y`] THEN MESON_TAC[predn_rules; Sxy_PREDN]);; let predn_diamond_lemma = prove (`!x y. x -||-> y ==> !z. x -||-> z ==> ?u. y -||-> u /\ z -||-> u`, ONCE_REWRITE_TAC[TAUT `a ==> b <=> a ==> a /\ b`] THEN MATCH_MP_TAC predn_ind THEN SIMP_TAC[predn_rules] THEN REPEAT CONJ_TAC THENL [MESON_TAC[predn_rules]; REPEAT STRIP_TAC THEN UNDISCH_THEN `x % u -||-> z` (STRIP_ASSUME_TAC o SIMP_RULE[characterise `x % y`]) THENL [ASM_MESON_TAC[predn_rules]; ASM_MESON_TAC[predn_rules]; SUBGOAL_THEN `?w. y = K % w /\ z -||-> w` MP_TAC; SUBGOAL_THEN `?p q. y = S % p % q /\ f -||-> p /\ g -||-> q` MP_TAC] THEN ASM_MESON_TAC[Kx_PREDN; Sxy_PREDN; predn_rules]; REWRITE_TAC[Kxy_PREDN] THEN MESON_TAC[predn_rules]; REWRITE_TAC[Sxyz_PREDN] THEN MESON_TAC[predn_rules]]);; let predn_diamond = prove (`CR (-||->)`, MESON_TAC[CR; predn_diamond_lemma]);; (* ------------------------------------------------------------------------- *) (* Hence we have confluence of the main reduction. *) (* ------------------------------------------------------------------------- *) let confluent_redn = prove (`confluent(-->)`, MESON_TAC[confluent_diamond_RTC; RTCpredn_EQ_RTCredn; RTCredn; RTCpredn; RTC_CR; predn_diamond]);; hol-light/Examples/cong.ml000066400000000000000000000143241303454263000160070ustar00rootroot00000000000000(* ========================================================================= *) (* Integer congruences. *) (* ========================================================================= *) prioritize_int();; (* ------------------------------------------------------------------------- *) (* Combined rewrite, for later proofs. *) (* ------------------------------------------------------------------------- *) let CONG = prove (`(x == y) (mod n) <=> ?q. x - y = q * n`, REWRITE_TAC[int_congruent; int_divides] THEN MESON_TAC[INT_MUL_SYM]);; (* ------------------------------------------------------------------------- *) (* Trivial consequences. *) (* ------------------------------------------------------------------------- *) let CONG_MOD_0 = prove (`(x == y) (mod (&0)) <=> (x = y)`, INTEGER_TAC);; let CONG_MOD_1 = prove (`(x == y) (mod (&1))`, INTEGER_TAC);; (* ------------------------------------------------------------------------- *) (* Congruence is an equivalence relation. *) (* ------------------------------------------------------------------------- *) let CONG_REFL = prove (`!n x. (x == x) (mod n)`, INTEGER_TAC);; let CONG_SYM = prove (`!n x y. (x == y) (mod n) ==> (y == x) (mod n)`, INTEGER_TAC);; let CONG_TRANS = prove (`!n x y z. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, INTEGER_TAC);; (* ------------------------------------------------------------------------- *) (* Congruences are indeed congruences. *) (* ------------------------------------------------------------------------- *) let CONG_ADD = prove (`!n x1 x2 y1 y2. (x1 == x2) (mod n) /\ (y1 == y2) (mod n) ==> (x1 + y1 == x2 + y2) (mod n)`, INTEGER_TAC);; let CONG_NEG = prove (`!n x1 x2. (x1 == x2) (mod n) ==> (--x1 == --x2) (mod n)`, INTEGER_TAC);; let CONG_SUB = prove (`!n x1 x2 y1 y2. (x1 == x2) (mod n) /\ (y1 == y2) (mod n) ==> (x1 - y1 == x2 - y2) (mod n)`, INTEGER_TAC);; let CONG_MUL = prove (`!n x1 x2 y1 y2. (x1 == x2) (mod n) /\ (y1 == y2) (mod n) ==> (x1 * y1 == x2 * y2) (mod n)`, INTEGER_TAC);; (* ------------------------------------------------------------------------- *) (* Various other trivial properties of congruences. *) (* ------------------------------------------------------------------------- *) let CONG_MOD_NEG = prove (`!x y n. (x == y) (mod (--n)) <=> (x == y) (mod n)`, INTEGER_TAC);; let CONG_MOD_ABS = prove (`!x y n. (x == y) (mod (abs n)) <=> (x == y) (mod n)`, REPEAT GEN_TAC THEN REWRITE_TAC[INT_ABS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONG_MOD_NEG]);; let CONG_MULTIPLE = prove (`!m n. (m * n == &0) (mod n)`, INTEGER_TAC);; let CONG_SELF = prove (`!n. (n == &0) (mod n)`, INTEGER_TAC);; let CONG_SELF_ABS = prove (`!n. (abs(n) == &0) (mod n)`, ONCE_REWRITE_TAC[GSYM CONG_MOD_ABS] THEN REWRITE_TAC[CONG_SELF]);; let CONG_MOD_1 = prove (`(x == y) (mod &1)`, INTEGER_TAC);; (* ------------------------------------------------------------------------- *) (* Can choose a representative, either positive or with minimal magnitude. *) (* ------------------------------------------------------------------------- *) let CONG_REP_POS_POS = prove (`!n x. &0 <= x /\ ~(n = &0) ==> ?y. &0 <= y /\ y < abs(n) /\ (x == y) (mod n)`, REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[GSYM INT_FORALL_POS] THEN MAP_EVERY X_GEN_TAC [`n:int`; `k:num`] THEN ONCE_REWRITE_TAC[GSYM CONG_MOD_ABS] THEN MP_TAC(SPEC `n:int` INT_ABS_POS) THEN ONCE_REWRITE_TAC[INT_ARITH `(n = &0) <=> (abs n = &0)`] THEN SPEC_TAC(`abs n`,`n:int`) THEN REWRITE_TAC[GSYM INT_FORALL_POS] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[INT_OF_NUM_EQ] THEN DISCH_TAC THEN EXISTS_TAC `&(k MOD n)` THEN REWRITE_TAC[CONG; INT_OF_NUM_LE; INT_OF_NUM_LT] THEN ASM_SIMP_TAC[DIVISION; LE_0] THEN EXISTS_TAC `&(k DIV n)` THEN REWRITE_TAC[INT_ARITH `(x - y = z) <=> (x = z + y)`] THEN REWRITE_TAC[INT_OF_NUM_MUL; INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN ASM_SIMP_TAC[DIVISION]);; let CONG_REP_POS = prove (`!n x. ~(n = &0) ==> ?y. &0 <= y /\ y < abs(n) /\ (x == y) (mod n)`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(INT_ARITH `&0 <= x \/ &0 <= --x`) THEN ASM_SIMP_TAC[CONG_REP_POS_POS] THEN MP_TAC(SPECL [`n:int`; `--x`] CONG_REP_POS_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:int` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `y = &0` THENL [EXISTS_TAC `y:int` THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONG_NEG) THEN ASM_REWRITE_TAC[INT_NEG_0; INT_NEG_NEG]; ALL_TAC] THEN EXISTS_TAC `abs(n) - y` THEN ASM_SIMP_TAC[INT_ARITH `y < abs(n) ==> &0 <= abs(n) - y`; INT_ARITH `&0 <= y /\ ~(y = &0) ==> abs(n) - y < abs(n)`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONG_NEG) THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_SYM) THEN DISCH_THEN(MP_TAC o CONJ (SPEC `abs n` CONG_SELF)) THEN REWRITE_TAC[CONG_MOD_ABS] THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_ADD) THEN REWRITE_TAC[INT_NEG_NEG; INT_ADD_LID] THEN MESON_TAC[INT_ARITH `x + --y = x - y`; CONG_SYM]);; let CONG_REP_MIN = prove (`!n x. ~(n = &0) ==> ?y. --(abs n) <= &2 * y /\ &2 * y < abs n /\ (x == y) (mod n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONG_REP_POS) THEN DISCH_THEN(X_CHOOSE_THEN `y:int` STRIP_ASSUME_TAC o SPEC `x:int`) THEN MP_TAC(INT_ARITH `&0 <= y /\ y < abs n ==> --(abs n) <= &2 * y /\ &2 * y < abs(n) \/ --(abs n) <= &2 * (y - abs(n)) /\ &2 * (y - abs(n)) < abs(n)`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [ASM_MESON_TAC[CONG_REP_POS; INT_LT_IMP_LE]; ALL_TAC] THEN EXISTS_TAC `y - abs(n)` THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `n:int` CONG_SELF_ABS) THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_SYM) THEN UNDISCH_TAC `(x == y) (mod n)` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_SUB) THEN REWRITE_TAC[INT_ARITH `x - &0 = x`]);; let CONG_REP_MIN_ABS = prove (`!n x. ~(n = &0) ==> ?y. &2 * abs(y) <= abs(n) /\ (x == y) (mod n)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_REP_MIN) THEN DISCH_THEN(MP_TAC o SPEC `x:int`) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN INT_ARITH_TAC);; hol-light/Examples/cooper.ml000066400000000000000000001743401303454263000163550ustar00rootroot00000000000000(* ========================================================================= *) (* Implementation of Cooper's algorithm via proforma theorems. *) (* ========================================================================= *) prioritize_int();; (* ------------------------------------------------------------------------- *) (* Basic syntax on integer terms. *) (* ------------------------------------------------------------------------- *) let dest_mul = dest_binop `(*)`;; let dest_add = dest_binop `(+)`;; (* ------------------------------------------------------------------------- *) (* Divisibility. *) (* ------------------------------------------------------------------------- *) parse_as_infix("divides",(12,"right"));; let divides = new_definition `a divides b <=> ?x. b = a * x`;; (* ------------------------------------------------------------------------- *) (* Trivial lemmas about integers. *) (* ------------------------------------------------------------------------- *) let INT_DOWN2 = prove (`!a b. ?c. !x. x < c ==> x < a /\ x < b`, MESON_TAC[INT_LE_TOTAL; INT_LET_TRANS]);; (* ------------------------------------------------------------------------- *) (* Trivial lemmas about divisibility. *) (* ------------------------------------------------------------------------- *) let DIVIDES_ADD = prove (`!d a b. d divides a /\ d divides b ==> d divides (a + b)`, MESON_TAC[divides; INT_ADD_LDISTRIB]);; let DIVIDES_SUB = prove (`!d a b. d divides a /\ d divides b ==> d divides (a - b)`, MESON_TAC[divides; INT_SUB_LDISTRIB]);; let DIVIDES_ADD_REVR = prove (`!d a b. d divides a /\ d divides (a + b) ==> d divides b`, MESON_TAC[DIVIDES_SUB; INT_ARITH `(a + b) - a = b`]);; let DIVIDES_ADD_REVL = prove (`!d a b. d divides b /\ d divides (a + b) ==> d divides a`, MESON_TAC[DIVIDES_SUB; INT_ARITH `(a + b) - b = a`]);; let DIVIDES_LMUL = prove (`!d a x. d divides a ==> d divides (x * a)`, ASM_MESON_TAC[divides; INT_ARITH `a * b * c = b * a * c`]);; let DIVIDES_RNEG = prove (`!d a. d divides (--a) <=> d divides a`, REWRITE_TAC[divides] THEN MESON_TAC[INT_MUL_RNEG; INT_NEG_NEG]);; let DIVIDES_LNEG = prove (`!d a. (--d) divides a <=> d divides a`, REWRITE_TAC[divides] THEN MESON_TAC[INT_MUL_RNEG; INT_MUL_LNEG; INT_NEG_NEG]);; (* ------------------------------------------------------------------------- *) (* More specialized lemmas (see footnotes on p4 and p5). *) (* ------------------------------------------------------------------------- *) let INT_DOWN_MUL_LT = prove (`!x y d. &0 < d ==> ?c. x + c * d < y`, MESON_TAC[INT_ARCH; INT_LT_REFL; INT_ARITH `x - y < c * d <=> x + --c * d < y`]);; let INT_MOD_LEMMA = prove (`!d x. &0 < d ==> ?c. &1 <= x + c * d /\ x + c * d <= d`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`x:int`; `&0`] o MATCH_MP INT_DOWN_MUL_LT) THEN DISCH_THEN(X_CHOOSE_TAC `c0:int`) THEN SUBGOAL_THEN `?c1. &0 <= c1 /\ --(x + c0 * d) < c1 * d` MP_TAC THENL [SUBGOAL_THEN `?c1. --(x + c0 * d) < c1 * d` MP_TAC THENL [ASM_MESON_TAC[INT_ARCH; INT_ARITH `&0 < d ==> ~(d = &0)`]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN MATCH_MP_TAC(INT_ARITH `(&0 < --c1 ==> &0 < --cd) /\ xcod < &0 ==> --xcod < cd ==> &0 <= c1`) THEN ASM_SIMP_TAC[GSYM INT_MUL_LNEG; INT_LT_MUL]; ALL_TAC] THEN REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`; GSYM NOT_FORALL_THM] THEN REWRITE_TAC[GSYM INT_FORALL_POS] THEN REWRITE_TAC[NOT_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[INT_ARITH `--(x + a * d) < b * d <=> &1 <= x + (a + b) * d`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `c0 + &n` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN UNDISCH_TAC `&1 <= x + (c0 + &n) * d` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `SUC n - 1 = n`] THENL [REWRITE_TAC[SUB_0; LT_REFL; INT_ADD_RID] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN INT_ARITH_TAC; REWRITE_TAC[GSYM INT_OF_NUM_SUC; LT] THEN INT_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Shadow for restricted class of formulas. *) (* ------------------------------------------------------------------------- *) let cform_INDUCT,cform_RECURSION = define_type "cform = Lt int | Gt int | Eq int | Ne int | Divides int int | Ndivides int int | And cform cform | Or cform cform | Nox bool";; (* ------------------------------------------------------------------------- *) (* Interpretation of a cform. *) (* ------------------------------------------------------------------------- *) let interp = new_recursive_definition cform_RECURSION `(interp x (Lt e) <=> x + e < &0) /\ (interp x (Gt e) <=> x + e > &0) /\ (interp x (Eq e) <=> (x + e = &0)) /\ (interp x (Ne e) <=> ~(x + e = &0)) /\ (interp x (Divides c e) <=> c divides (x + e)) /\ (interp x (Ndivides c e) <=> ~(c divides (x + e))) /\ (interp x (And p q) <=> interp x p /\ interp x q) /\ (interp x (Or p q) <=> interp x p \/ interp x q) /\ (interp x (Nox P) <=> P)`;; (* ------------------------------------------------------------------------- *) (* The "minus infinity" and "plus infinity" variants. *) (* ------------------------------------------------------------------------- *) let minusinf = new_recursive_definition cform_RECURSION `(minusinf (Lt e) = Nox T) /\ (minusinf (Gt e) = Nox F) /\ (minusinf (Eq e) = Nox F) /\ (minusinf (Ne e) = Nox T) /\ (minusinf (Divides c e) = Divides c e) /\ (minusinf (Ndivides c e) = Ndivides c e) /\ (minusinf (And p q) = And (minusinf p) (minusinf q)) /\ (minusinf (Or p q) = Or (minusinf p) (minusinf q)) /\ (minusinf (Nox P) = Nox P)`;; let plusinf = new_recursive_definition cform_RECURSION `(plusinf (Lt e) = Nox F) /\ (plusinf (Gt e) = Nox T) /\ (plusinf (Eq e) = Nox F) /\ (plusinf (Ne e) = Nox T) /\ (plusinf (Divides c e) = Divides c e) /\ (plusinf (Ndivides c e) = Ndivides c e) /\ (plusinf (And p q) = And (plusinf p) (plusinf q)) /\ (plusinf (Or p q) = Or (plusinf p) (plusinf q)) /\ (plusinf (Nox P) = Nox P)`;; (* ------------------------------------------------------------------------- *) (* All the "dividing" things divide the given constant (e.g. their LCM). *) (* ------------------------------------------------------------------------- *) let alldivide = new_recursive_definition cform_RECURSION `(alldivide d (Lt e) <=> T) /\ (alldivide d (Gt e) <=> T) /\ (alldivide d (Eq e) <=> T) /\ (alldivide d (Ne e) <=> T) /\ (alldivide d (Divides c e) <=> c divides d) /\ (alldivide d (Ndivides c e) <=> c divides d) /\ (alldivide d (And p q) <=> alldivide d p /\ alldivide d q) /\ (alldivide d (Or p q) <=> alldivide d p /\ alldivide d q) /\ (alldivide d (Nox P) <=> T)`;; (* ------------------------------------------------------------------------- *) (* A-sets and B-sets. *) (* ------------------------------------------------------------------------- *) let aset = new_recursive_definition cform_RECURSION `(aset (Lt e) = {(--e)}) /\ (aset (Gt e) = {}) /\ (aset (Eq e) = {(--e + &1)}) /\ (aset (Ne e) = {(--e)}) /\ (aset (Divides c e) = {}) /\ (aset (Ndivides c e) = {}) /\ (aset (And p q) = (aset p) UNION (aset q)) /\ (aset (Or p q) = (aset p) UNION (aset q)) /\ (aset (Nox P) = {})`;; let bset = new_recursive_definition cform_RECURSION `(bset (Lt e) = {}) /\ (bset (Gt e) = {(--e)}) /\ (bset (Eq e) = {(--(e + &1))}) /\ (bset (Ne e) = {(--e)}) /\ (bset (Divides c e) = {}) /\ (bset (Ndivides c e) = {}) /\ (bset (And p q) = (bset p) UNION (bset q)) /\ (bset (Or p q) = (bset p) UNION (bset q)) /\ (bset (Nox P) = {})`;; (* ------------------------------------------------------------------------- *) (* The key minimality case analysis for the integers. *) (* ------------------------------------------------------------------------- *) let INT_EXISTS_CASES = prove (`(?x. P x) <=> (!y. ?x. x < y /\ P x) \/ (?x. P x /\ !y. y < x ==> ~P y)`, EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_TAC `x:int`) THEN MATCH_MP_TAC(TAUT `(~b ==> a) ==> a \/ b`) THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM; NOT_IMP] THEN STRIP_TAC THEN X_GEN_TAC `y:int` THEN DISJ_CASES_TAC(INT_ARITH `x < y \/ &0 <= x - y`) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. ?y. y < x - &n /\ P y` MP_TAC THENL [ALL_TAC; REWRITE_TAC[INT_FORALL_POS] THEN DISCH_THEN(MP_TAC o SPEC `x - y`) THEN ASM_REWRITE_TAC[INT_ARITH `x - (x - y) = y`]] THEN INDUCT_TAC THEN REWRITE_TAC[INT_SUB_RZERO; GSYM INT_OF_NUM_SUC] THEN ASM_MESON_TAC[INT_ARITH `z < y /\ y < x - &n ==> z < x - (&n + &1)`]);; (* ------------------------------------------------------------------------- *) (* Lemmas towards the main theorems (following my book). *) (* ------------------------------------------------------------------------- *) let MINUSINF_LEMMA = prove (`!p. ?y. !x. x < y ==> (interp x p <=> interp x (minusinf p))`, MATCH_MP_TAC cform_INDUCT THEN REWRITE_TAC[interp; minusinf] THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c /\ d) /\ (e /\ f) ==> a /\ b /\ c /\ d /\ e /\ f`) THEN CONJ_TAC THENL [MESON_TAC[INT_ARITH `x < --a ==> x + a < &0`; INT_GT; INT_LT_ANTISYM; INT_LT_REFL]; ALL_TAC] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN STRIP_TAC THEN MP_TAC(SPECL [`a:int`; `b:int`] INT_DOWN2) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[]);; let MINUSINF_REPEATS = prove (`!p c d x. alldivide d p ==> (interp x (minusinf p) <=> interp (x + c * d) (minusinf p))`, CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[interp; minusinf; alldivide] THEN ONCE_REWRITE_TAC[INT_ARITH `(x + d) + y = (x + y) + d`] THEN MESON_TAC[DIVIDES_LMUL; DIVIDES_ADD_REVL; DIVIDES_ADD]);; let NOMINIMAL_EQUIV = prove (`alldivide d p /\ &0 < d ==> ((!y. ?x. x < y /\ interp x p) <=> ?j. &1 <= j /\ j <= d /\ interp j (minusinf p))`, ASM_MESON_TAC[MINUSINF_LEMMA; MINUSINF_REPEATS; INT_DOWN_MUL_LT; INT_DOWN2; INT_MOD_LEMMA]);; let BDISJ_REPEATS_LEMMA = prove (`!d p. alldivide d p /\ &0 < d ==> !x. interp x p /\ ~(interp (x - d) p) ==> ?j b. &1 <= j /\ j <= d /\ b IN bset p /\ (x = b + j)`, GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> b ==> a ==> c`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC cform_INDUCT THEN REWRITE_TAC[interp; alldivide; bset; NOT_IN_EMPTY] THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c /\ d /\ e /\ f) /\ g /\ h ==> a /\ b /\ c /\ d /\ e /\ f /\ g /\ h`) THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[TAUT `~a \/ a`; TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`; TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`; DE_MORGAN_THM; IN_UNION; EXISTS_OR_THM; FORALL_AND_THM]] THEN REPEAT STRIP_TAC THENL [ALL_TAC; MAP_EVERY EXISTS_TAC [`x + a`; `--a`]; MAP_EVERY EXISTS_TAC [`&1`; `--a - &1`]; MAP_EVERY EXISTS_TAC [`d:int`; `--a`]; ASM_MESON_TAC[INT_ARITH `(x - y) + z = (x + z) - y`; DIVIDES_SUB]; ASM_MESON_TAC[INT_ARITH `(x - y) + z = (x + z) - y`; INT_ARITH `(x - y) + y = x`; DIVIDES_ADD]] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[IN_SING] THEN INT_ARITH_TAC);; let MAINTHM_B = prove (`!p d. alldivide d p /\ &0 < d ==> ((?x. interp x p) <=> ?j. &1 <= j /\ j <= d /\ (interp j (minusinf p) \/ ?b. b IN bset p /\ interp (b + j) p))`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`; EXISTS_OR_THM] THEN MATCH_MP_TAC(TAUT `!a1 a2. (a <=> a1 \/ a2) /\ (a1 <=> b) /\ (a2 ==> c) /\ (c ==> a) ==> (a <=> b \/ c)`) THEN EXISTS_TAC `!y. ?x. x < y /\ interp x p` THEN EXISTS_TAC `?x. interp x p /\ !y. y < x ==> ~(interp y p)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM INT_EXISTS_CASES]; ASM_MESON_TAC[NOMINIMAL_EQUIV]; ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `x:int` (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x - d`))) THEN ASM_SIMP_TAC[INT_ARITH `&0 < d ==> x - d < x`] THEN DISCH_TAC THEN MP_TAC(SPECL [`d:int`; `p:cform`] BDISJ_REPEATS_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:int`) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Deduce the other one by a symmetry argument rather than a similar proof. *) (* ------------------------------------------------------------------------- *) let mirror = new_recursive_definition cform_RECURSION `(mirror (Lt e) = Gt(--e)) /\ (mirror (Gt e) = Lt(--e)) /\ (mirror (Eq e) = Eq(--e)) /\ (mirror (Ne e) = Ne(--e)) /\ (mirror (Divides c e) = Divides c (--e)) /\ (mirror (Ndivides c e) = Ndivides c (--e)) /\ (mirror (And p q) = And (mirror p) (mirror q)) /\ (mirror (Or p q) = Or (mirror p) (mirror q)) /\ (mirror (Nox P) = Nox P)`;; let INTERP_MIRROR_LEMMA = prove (`!p x. interp (--x) (mirror p) <=> interp x p`, MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[mirror; interp] THEN REWRITE_TAC[GSYM INT_NEG_ADD; DIVIDES_RNEG] THEN INT_ARITH_TAC);; let INTERP_MIRROR = prove (`!p x. interp x (mirror p) <=> interp (--x) p`, MESON_TAC[INTERP_MIRROR_LEMMA; INT_NEG_NEG]);; let BSET_MIRROR = prove (`!p. bset(mirror p) = IMAGE (--) (aset p)`, MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[mirror; aset; bset] THEN REWRITE_TAC[IMAGE_CLAUSES; IMAGE_UNION] THEN REWRITE_TAC[EXTENSION; IN_SING] THEN INT_ARITH_TAC);; let MINUSINF_MIRROR = prove (`!p. minusinf (mirror p) = mirror (plusinf p)`, MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[plusinf; minusinf; mirror]);; let PLUSINF_MIRROR = prove (`!p. plusinf p = mirror(minusinf (mirror p))`, MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[plusinf; minusinf; mirror; INT_NEG_NEG]);; let ALLDIVIDE_MIRROR = prove (`!p d. alldivide d (mirror p) = alldivide d p`, MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[mirror; alldivide]);; let EXISTS_NEG = prove (`(?x. P(--x)) <=> (?x. P(x))`, MESON_TAC[INT_NEG_NEG]);; let FORALL_NEG = prove (`(!x. P(--x)) <=> (!x. P x)`, MESON_TAC[INT_NEG_NEG]);; let EXISTS_MOD_IMP = prove (`!P d. (!c x. P(x + c * d) <=> P(x)) /\ (?j. &1 <= j /\ j <= d /\ P(--j)) ==> ?j. &1 <= j /\ j <= d /\ P(j)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `d:int = j` THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`--(&2)`; `d:int`]) THEN ASM_REWRITE_TAC[INT_ARITH `d + --(&2) * d = --d`] THEN ASM_MESON_TAC[INT_LE_REFL]; FIRST_X_ASSUM(MP_TAC o SPECL [`&1`; `--j`]) THEN ASM_REWRITE_TAC[INT_ARITH `--j + &1 * d = d - j`] THEN DISCH_TAC THEN EXISTS_TAC `d - j` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`&1 <= j`; `j <= d`; `~(d:int = j)`] THEN INT_ARITH_TAC]);; let EXISTS_MOD_EQ = prove (`!P d. (!c x. P(x + c * d) <=> P(x)) ==> ((?j. &1 <= j /\ j <= d /\ P(--j)) <=> (?j. &1 <= j /\ j <= d /\ P(j)))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MP_TAC(SPEC `P:int->bool` EXISTS_MOD_IMP); MP_TAC(SPEC `\x. P(--x):bool` EXISTS_MOD_IMP)] THEN DISCH_THEN(MP_TAC o SPEC `d:int`) THEN ASM_REWRITE_TAC[INT_NEG_NEG] THEN ASM_REWRITE_TAC[INT_ARITH `--(x + c * d) = --x + --c * d`; FORALL_NEG] THEN MESON_TAC[]);; let MAINTHM_A = prove (`!p d. alldivide d p /\ &0 < d ==> ((?x. interp x p) <=> ?j. &1 <= j /\ j <= d /\ (interp j (plusinf p) \/ ?a. a IN aset p /\ interp (a - j) p))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM EXISTS_NEG] THEN REWRITE_TAC[GSYM INTERP_MIRROR] THEN MP_TAC(SPECL [`mirror p`; `d:int`] MAINTHM_B) THEN ASM_REWRITE_TAC[ALLDIVIDE_MIRROR] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`; TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`; EXISTS_OR_THM] THEN BINOP_TAC THENL [ALL_TAC; REWRITE_TAC[INTERP_MIRROR; MINUSINF_MIRROR; BSET_MIRROR] THEN REWRITE_TAC[INT_ARITH `--(b + j) = --b - j`; IN_IMAGE] THEN MESON_TAC[INT_NEG_NEG]] THEN REWRITE_TAC[PLUSINF_MIRROR] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ALLDIVIDE_MIRROR]) THEN SPEC_TAC(`mirror p`,`q:cform`) THEN REWRITE_TAC[INTERP_MIRROR] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM EXISTS_MOD_EQ) THEN ASM_SIMP_TAC[GSYM MINUSINF_REPEATS]);; (* ------------------------------------------------------------------------- *) (* Proforma for elimination of coefficient of main variable. *) (* ------------------------------------------------------------------------- *) let EXISTS_MULTIPLE_THM_1 = prove (`(?x. P(&1 * x)) <=> ?x. P(x)`, REWRITE_TAC[INT_MUL_LID]);; let EXISTS_MULTIPLE_THM = prove (`(?x. P(c * x)) <=> ?x. c divides x /\ P(x)`, MESON_TAC[divides]);; (* ------------------------------------------------------------------------- *) (* Ordering of variables determined by a list, *with* trivial default. *) (* ------------------------------------------------------------------------- *) let rec earlier vars x y = match vars with z::ovs -> if z = y then false else if z = x then true else earlier ovs x y | [] -> x < y;; (* ------------------------------------------------------------------------- *) (* Conversion of integer constant to ML rational number. *) (* This is a tweaked copy of the real-type versions in "real.ml". *) (* ------------------------------------------------------------------------- *) let is_num_const = let ptm = `&` in fun tm -> try let l,r = dest_comb tm in l = ptm && is_numeral r with Failure _ -> false;; let mk_num_const,dest_num_const = let ptm = `&` in (fun n -> mk_comb(ptm,mk_numeral n)), (fun tm -> let l,r = dest_comb tm in if l = ptm then dest_numeral r else failwith "dest_num_const");; let is_int_const = let ptm = `(--)` in fun tm -> is_num_const tm || try let l,r = dest_comb tm in l = ptm && is_num_const r with Failure _ -> false;; let mk_int_const,dest_int_const = let ptm = `(--)` in (fun n -> if n if try rator tm = ptm with Failure _ -> false then minus_num (dest_num_const(rand tm)) else dest_num_const tm);; (* ------------------------------------------------------------------------- *) (* Similar tweaks of all the REAL_INT_..._CONV arith convs in real.ml *) (* ------------------------------------------------------------------------- *) let INT_LE_CONV,INT_LT_CONV, INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV = let tth = TAUT `(F /\ F <=> F) /\ (F /\ T <=> F) /\ (T /\ F <=> F) /\ (T /\ T <=> T)` in let nth = TAUT `(~T <=> F) /\ (~F <=> T)` in let NUM2_EQ_CONV = COMB2_CONV (RAND_CONV NUM_EQ_CONV) NUM_EQ_CONV THENC GEN_REWRITE_CONV I [tth] in let NUM2_NE_CONV = RAND_CONV NUM2_EQ_CONV THENC GEN_REWRITE_CONV I [nth] in let [pth_le1; pth_le2a; pth_le2b; pth_le3] = (CONJUNCTS o prove) (`(--(&m) <= &n <=> T) /\ (&m <= &n <=> m <= n) /\ (--(&m) <= --(&n) <=> n <= m) /\ (&m <= --(&n) <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[INT_LE_NEG2] THEN REWRITE_TAC[INT_LE_LNEG; INT_LE_RNEG] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE; LE_0] THEN REWRITE_TAC[LE; ADD_EQ_0]) in let INT_LE_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_le1]; GEN_REWRITE_CONV I [pth_le2a; pth_le2b] THENC NUM_LE_CONV; GEN_REWRITE_CONV I [pth_le3] THENC NUM2_EQ_CONV] in let [pth_lt1; pth_lt2a; pth_lt2b; pth_lt3] = (CONJUNCTS o prove) (`(&m < --(&n) <=> F) /\ (&m < &n <=> m < n) /\ (--(&m) < --(&n) <=> n < m) /\ (--(&m) < &n <=> ~((m = 0) /\ (n = 0)))`, REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; GSYM NOT_LE; GSYM INT_NOT_LE] THEN CONV_TAC TAUT) in let INT_LT_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_lt1]; GEN_REWRITE_CONV I [pth_lt2a; pth_lt2b] THENC NUM_LT_CONV; GEN_REWRITE_CONV I [pth_lt3] THENC NUM2_NE_CONV] in let [pth_ge1; pth_ge2a; pth_ge2b; pth_ge3] = (CONJUNCTS o prove) (`(&m >= --(&n) <=> T) /\ (&m >= &n <=> n <= m) /\ (--(&m) >= --(&n) <=> m <= n) /\ (--(&m) >= &n <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; INT_GE] THEN CONV_TAC TAUT) in let INT_GE_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_ge1]; GEN_REWRITE_CONV I [pth_ge2a; pth_ge2b] THENC NUM_LE_CONV; GEN_REWRITE_CONV I [pth_ge3] THENC NUM2_EQ_CONV] in let [pth_gt1; pth_gt2a; pth_gt2b; pth_gt3] = (CONJUNCTS o prove) (`(--(&m) > &n <=> F) /\ (&m > &n <=> n < m) /\ (--(&m) > --(&n) <=> m < n) /\ (&m > --(&n) <=> ~((m = 0) /\ (n = 0)))`, REWRITE_TAC[pth_lt1; pth_lt2a; pth_lt2b; pth_lt3; INT_GT] THEN CONV_TAC TAUT) in let INT_GT_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_gt1]; GEN_REWRITE_CONV I [pth_gt2a; pth_gt2b] THENC NUM_LT_CONV; GEN_REWRITE_CONV I [pth_gt3] THENC NUM2_NE_CONV] in let [pth_eq1a; pth_eq1b; pth_eq2a; pth_eq2b] = (CONJUNCTS o prove) (`((&m = &n) <=> (m = n)) /\ ((--(&m) = --(&n)) <=> (m = n)) /\ ((--(&m) = &n) <=> (m = 0) /\ (n = 0)) /\ ((&m = --(&n)) <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[GSYM INT_LE_ANTISYM; GSYM LE_ANTISYM] THEN REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; LE; LE_0] THEN CONV_TAC TAUT) in let INT_EQ_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_eq1a; pth_eq1b] THENC NUM_EQ_CONV; GEN_REWRITE_CONV I [pth_eq2a; pth_eq2b] THENC NUM2_EQ_CONV] in INT_LE_CONV,INT_LT_CONV, INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV;; let INT_NEG_CONV = let pth = prove (`(--(&0) = &0) /\ (--(--(&x)) = &x)`, REWRITE_TAC[INT_NEG_NEG; INT_NEG_0]) in GEN_REWRITE_CONV I [pth];; let INT_MUL_CONV = let pth0 = prove (`(&0 * &x = &0) /\ (&0 * --(&x) = &0) /\ (&x * &0 = &0) /\ (--(&x) * &0 = &0)`, REWRITE_TAC[INT_MUL_LZERO; INT_MUL_RZERO]) and pth1,pth2 = (CONJ_PAIR o prove) (`((&m * &n = &(m * n)) /\ (--(&m) * --(&n) = &(m * n))) /\ ((--(&m) * &n = --(&(m * n))) /\ (&m * --(&n) = --(&(m * n))))`, REWRITE_TAC[INT_MUL_LNEG; INT_MUL_RNEG; INT_NEG_NEG] THEN REWRITE_TAC[INT_OF_NUM_MUL]) in FIRST_CONV [GEN_REWRITE_CONV I [pth0]; GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_MULT_CONV; GEN_REWRITE_CONV I [pth2] THENC RAND_CONV(RAND_CONV NUM_MULT_CONV)];; let INT_ADD_CONV = let neg_tm = `(--)` in let amp_tm = `&` in let add_tm = `(+)` in let dest = dest_binop `(+)` in let m_tm = `m:num` and n_tm = `n:num` in let pth0 = prove (`(--(&m) + &m = &0) /\ (&m + --(&m) = &0)`, REWRITE_TAC[INT_ADD_LINV; INT_ADD_RINV]) in let [pth1; pth2; pth3; pth4; pth5; pth6] = (CONJUNCTS o prove) (`(--(&m) + --(&n) = --(&(m + n))) /\ (--(&m) + &(m + n) = &n) /\ (--(&(m + n)) + &m = --(&n)) /\ (&(m + n) + --(&m) = &n) /\ (&m + --(&(m + n)) = --(&n)) /\ (&m + &n = &(m + n))`, REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_NEG_ADD] THEN REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID] THEN ONCE_REWRITE_TAC[INT_ADD_SYM] THEN REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID]) in GEN_REWRITE_CONV I [pth0] ORELSEC (fun tm -> try let l,r = dest tm in if rator l = neg_tm then if rator r = neg_tm then let th1 = INST [rand(rand l),m_tm; rand(rand r),n_tm] pth1 in let tm1 = rand(rand(rand(concl th1))) in let th2 = AP_TERM neg_tm (AP_TERM amp_tm (NUM_ADD_CONV tm1)) in TRANS th1 th2 else let m = rand(rand l) and n = rand r in let m' = dest_numeral m and n' = dest_numeral n in if m' <=/ n' then let p = mk_numeral (n' -/ m') in let th1 = INST [m,m_tm; p,n_tm] pth2 in let th2 = NUM_ADD_CONV (rand(rand(lhand(concl th1)))) in let th3 = AP_TERM (rator tm) (AP_TERM amp_tm (SYM th2)) in TRANS th3 th1 else let p = mk_numeral (m' -/ n') in let th1 = INST [n,m_tm; p,n_tm] pth3 in let th2 = NUM_ADD_CONV (rand(rand(lhand(lhand(concl th1))))) in let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_THM (AP_TERM add_tm th3) (rand tm) in TRANS th4 th1 else if rator r = neg_tm then let m = rand l and n = rand(rand r) in let m' = dest_numeral m and n' = dest_numeral n in if n' <=/ m' then let p = mk_numeral (m' -/ n') in let th1 = INST [n,m_tm; p,n_tm] pth4 in let th2 = NUM_ADD_CONV (rand(lhand(lhand(concl th1)))) in let th3 = AP_TERM add_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_THM th3 (rand tm) in TRANS th4 th1 else let p = mk_numeral (n' -/ m') in let th1 = INST [m,m_tm; p,n_tm] pth5 in let th2 = NUM_ADD_CONV (rand(rand(rand(lhand(concl th1))))) in let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_TERM (rator tm) th3 in TRANS th4 th1 else let th1 = INST [rand l,m_tm; rand r,n_tm] pth6 in let tm1 = rand(rand(concl th1)) in let th2 = AP_TERM amp_tm (NUM_ADD_CONV tm1) in TRANS th1 th2 with Failure _ -> failwith "INT_ADD_CONV");; let INT_SUB_CONV = GEN_REWRITE_CONV I [INT_SUB] THENC TRY_CONV(RAND_CONV INT_NEG_CONV) THENC INT_ADD_CONV;; let INT_POW_CONV = let n = `n:num` and x = `x:num` in let pth1,pth2 = (CONJ_PAIR o prove) (`(&x pow n = &(x EXP n)) /\ ((--(&x)) pow n = if EVEN n then &(x EXP n) else --(&(x EXP n)))`, REWRITE_TAC[INT_OF_NUM_POW; INT_POW_NEG]) in let tth = prove (`((if T then x:int else y) = x) /\ ((if F then x:int else y) = y)`, REWRITE_TAC[]) in let neg_tm = `(--)` in (GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_EXP_CONV) ORELSEC (GEN_REWRITE_CONV I [pth2] THENC RATOR_CONV(RATOR_CONV(RAND_CONV NUM_EVEN_CONV)) THENC GEN_REWRITE_CONV I [tth] THENC (fun tm -> if rator tm = neg_tm then RAND_CONV(RAND_CONV NUM_EXP_CONV) tm else RAND_CONV NUM_EXP_CONV tm));; (* ------------------------------------------------------------------------- *) (* Handy utility functions for int arithmetic terms. *) (* ------------------------------------------------------------------------- *) let dest_add = dest_binop `(+)`;; let dest_mul = dest_binop `(*)`;; let dest_pow = dest_binop `(pow)`;; let dest_sub = dest_binop `(-)`;; let is_add = is_binop `(+)`;; let is_mul = is_binop `(*)`;; let is_pow = is_binop `(pow)`;; let is_sub = is_binop `(-)`;; (* ------------------------------------------------------------------------- *) (* Instantiate the normalizer. *) (* ------------------------------------------------------------------------- *) let POLYNOMIAL_NORMALIZERS = let sth = prove (`(!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. &0 + x = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x y. x * y = y * x) /\ (!x. &1 * x = x) /\ (!x. &0 * x = &0) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x. x pow 0 = &1) /\ (!x n. x pow (SUC n) = x * x pow n)`, REWRITE_TAC[INT_POW] THEN INT_ARITH_TAC) and rth = prove (`(!x. --x = --(&1) * x) /\ (!x y. x - y = x + --(&1) * y)`, INT_ARITH_TAC) and is_semiring_constant = is_int_const and SEMIRING_ADD_CONV = INT_ADD_CONV and SEMIRING_MUL_CONV = INT_MUL_CONV and SEMIRING_POW_CONV = INT_POW_CONV in let NORMALIZERS = SEMIRING_NORMALIZERS_CONV sth rth (is_semiring_constant, SEMIRING_ADD_CONV,SEMIRING_MUL_CONV,SEMIRING_POW_CONV) in fun vars -> NORMALIZERS(earlier vars);; let POLYNOMIAL_NEG_CONV vars = let cnv,_,_,_,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; let POLYNOMIAL_ADD_CONV vars = let _,cnv,_,_,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; let POLYNOMIAL_SUB_CONV vars = let _,_,cnv,_,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; let POLYNOMIAL_MUL_CONV vars = let _,_,_,cnv,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; let POLYNOMIAL_POW_CONV vars = let _,_,_,_,cnv,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; let POLYNOMIAL_CONV vars = let _,_,_,_,_,cnv = POLYNOMIAL_NORMALIZERS vars in cnv;; (* ------------------------------------------------------------------------- *) (* Slight variants of these functions for procedure below. *) (* ------------------------------------------------------------------------- *) let LINEAR_CMUL = let mul_tm = `(*)` in fun vars n tm -> POLYNOMIAL_MUL_CONV vars (mk_comb(mk_comb(mul_tm,mk_int_const n),tm));; (* ------------------------------------------------------------------------- *) (* Linearize a formula, dealing with non-strict inequalities. *) (* ------------------------------------------------------------------------- *) let LINEARIZE_CONV = let rew_conv = GEN_REWRITE_CONV I [CONJ (REFL `c divides e`) (INT_ARITH `(s < t <=> &0 < t - s) /\ (~(s < t) <=> &0 < (s + &1) - t) /\ (s > t <=> &0 < s - t) /\ (~(s > t) <=> &0 < (t + &1) - s) /\ (s <= t <=> &0 < (t + &1) - s) /\ (~(s <= t) <=> &0 < s - t) /\ (s >= t <=> &0 < (s + &1) - t) /\ (~(s >= t) <=> &0 < t - s) /\ ((s = t) <=> (&0 = s - t))`)] and true_tm = `T` and false_tm = `F` in let rec conv vars tm = try (rew_conv THENC RAND_CONV(POLYNOMIAL_CONV vars)) tm with Failure _ -> if is_exists tm || is_forall tm then let x = bndvar(rand tm) in BINDER_CONV (conv (x::vars)) tm else if is_neg tm then RAND_CONV (conv vars) tm else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then BINOP_CONV (conv vars) tm else if tm = true_tm || tm = false_tm then REFL tm else failwith "LINEARIZE_CONV: Unexpected term type" in conv;; (* ------------------------------------------------------------------------- *) (* Get the coefficient of x, assumed to be first term, if there at all. *) (* ------------------------------------------------------------------------- *) let coefficient x tm = try let l,r = dest_add tm in if l = x then Int 1 else let c,y = dest_mul l in if y = x then dest_int_const c else Int 0 with Failure _ -> try let c,y = dest_mul tm in if y = x then dest_int_const c else Int 0 with Failure _ -> Int 1;; (* ------------------------------------------------------------------------- *) (* Find (always positive) LCM of all the multiples of x in formula tm. *) (* ------------------------------------------------------------------------- *) let lcm_num x y = abs_num((x */ y) // gcd_num x y);; let rec formlcm x tm = if is_neg tm then formlcm x (rand tm) else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then lcm_num (formlcm x (lhand tm)) (formlcm x (rand tm)) else if is_forall tm || is_exists tm then formlcm x (body(rand tm)) else if not(mem x (frees tm)) then Int 1 else let c = coefficient x (rand tm) in if c =/ Int 0 then Int 1 else c;; (* ------------------------------------------------------------------------- *) (* Switch from "x [+ ...]" to "&1 * x [+ ...]" to suit later proforma. *) (* ------------------------------------------------------------------------- *) let MULTIPLY_1_CONV = let conv_0 = REWR_CONV(INT_ARITH `x = &1 * x`) and conv_1 = REWR_CONV(INT_ARITH `x + a = &1 * x + a`) in fun vars tm -> let x = hd vars in if tm = x then conv_0 tm else if is_add tm && lhand tm = x then conv_1 tm else REFL tm;; (* ------------------------------------------------------------------------- *) (* Adjust all coefficients of x (head variable) to match l in formula tm. *) (* ------------------------------------------------------------------------- *) let ADJUSTCOEFF_CONV = let op_eq = `(=):int->int->bool` and op_lt = `(<):int->int->bool` and op_gt = `(>):int->int->bool` and op_divides = `(divides):int->int->bool` and c_tm = `c:int` and d_tm = `d:int` and e_tm = `e:int` in let pth_divides = prove (`~(d = &0) ==> (c divides e <=> (d * c) divides (d * e))`, SIMP_TAC[divides; GSYM INT_MUL_ASSOC; INT_EQ_MUL_LCANCEL]) and pth_eq = prove (`~(d = &0) ==> ((&0 = e) <=> (&0 = d * e))`, DISCH_TAC THEN CONV_TAC(BINOP_CONV SYM_CONV) THEN ASM_REWRITE_TAC[INT_ENTIRE]) and pth_lt_pos = prove (`&0 < d ==> (&0 < e <=> &0 < d * e)`, DISCH_TAC THEN SUBGOAL_THEN `&0 < e <=> d * &0 < d * e` SUBST1_TAC THENL [ASM_SIMP_TAC[INT_LT_LMUL_EQ]; REWRITE_TAC[INT_MUL_RZERO]]) and pth_gt_pos = prove (`&0 < d ==> (&0 > e <=> &0 > d * e)`, DISCH_TAC THEN REWRITE_TAC[INT_GT] THEN SUBGOAL_THEN `e < &0 <=> d * e < d * &0` SUBST1_TAC THENL [ASM_SIMP_TAC[INT_LT_LMUL_EQ]; REWRITE_TAC[INT_MUL_RZERO]]) and true_tm = `T` and false_tm = `F` in let pth_lt_neg = prove (`d < &0 ==> (&0 < e <=> &0 > d * e)`, REWRITE_TAC[INT_ARITH `&0 > d * e <=> &0 < --d * e`; INT_ARITH `d < &0 <=> &0 < --d`; pth_lt_pos]) and pth_gt_neg = prove (`d < &0 ==> (&0 > e <=> &0 < d * e)`, REWRITE_TAC[INT_ARITH `&0 < d * e <=> &0 > --d * e`; INT_ARITH `d < &0 <=> &0 < --d`; pth_gt_pos]) in let rec ADJUSTCOEFF_CONV vars l tm = if tm = true_tm || tm = false_tm then REFL tm else if is_exists tm || is_forall tm then BINDER_CONV (ADJUSTCOEFF_CONV vars l) tm else if is_neg tm then RAND_CONV (ADJUSTCOEFF_CONV vars l) tm else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then BINOP_CONV (ADJUSTCOEFF_CONV vars l) tm else let lop,t = dest_comb tm in let op,z = dest_comb lop in let c = coefficient (hd vars) t in if c =/ Int 0 then REFL tm else let th1 = if c =/ l then REFL tm else let m = l // c in let th0 = if op = op_eq then pth_eq else if op = op_divides then pth_divides else if op = op_lt then if m >/ Int 0 then pth_lt_pos else pth_lt_neg else if op = op_gt then if m >/ Int 0 then pth_gt_pos else pth_gt_neg else failwith "ADJUSTCOEFF_CONV: unknown predicate" in let th1 = INST [mk_int_const m,d_tm; z,c_tm; t,e_tm] th0 in let tm1 = lhand(concl th1) in let th2 = if is_neg tm1 then EQF_ELIM(INT_EQ_CONV(rand tm1)) else EQT_ELIM(INT_LT_CONV tm1) in let th3 = MP th1 th2 in if op = op_divides then let th3 = MP th1 th2 in let tm2 = rand(concl th3) in let l,r = dest_comb tm2 in let th4 = AP_TERM (rator l) (INT_MUL_CONV (rand l)) in let th5 = AP_THM th4 r in let tm3 = rator(rand(concl th5)) in let th6 = TRANS th5 (AP_TERM tm3 (LINEAR_CMUL vars m t)) in TRANS th3 th6 else let tm2 = rator(rand(concl th3)) in TRANS th3 (AP_TERM tm2 (LINEAR_CMUL vars m t)) in if l =/ Int 1 then CONV_RULE(funpow 2 RAND_CONV (MULTIPLY_1_CONV vars)) th1 else th1 in ADJUSTCOEFF_CONV;; (* ------------------------------------------------------------------------- *) (* Now normalize all the x terms to have same coefficient and eliminate it. *) (* ------------------------------------------------------------------------- *) let NORMALIZE_COEFF_CONV = let c_tm = `c:int` and pth = prove (`(?x. P(c * x)) <=> (?x. c divides x /\ P x)`, REWRITE_TAC[GSYM EXISTS_MULTIPLE_THM]) in let NORMALIZE_COEFF_CONV vars tm = let x,bod = dest_exists tm in let l = formlcm x tm in let th1 = ADJUSTCOEFF_CONV (x::vars) l tm in let th2 = if l =/ Int 1 then EXISTS_MULTIPLE_THM_1 else INST [mk_int_const l,c_tm] pth in TRANS th1 (REWR_CONV th2 (rand(concl th1))) in NORMALIZE_COEFF_CONV;; (* ------------------------------------------------------------------------- *) (* Convert to shadow syntax. *) (* ------------------------------------------------------------------------- *) let SHADOW_CONV = let pth_trivial = prove (`P = interp x (Nox P)`, REWRITE_TAC[interp]) and pth_composite = prove (`(interp x p /\ interp x q <=> interp x (And p q)) /\ (interp x p \/ interp x q <=> interp x (Or p q))`, REWRITE_TAC[interp]) and pth_literal_nontrivial = prove (`(&0 > x + e <=> interp x (Lt e)) /\ (&0 < x + e <=> interp x (Gt e)) /\ ((&0 = x + e) <=> interp x (Eq e)) /\ (~(&0 = x + e) <=> interp x (Ne e)) /\ (c divides (x + e) <=> interp x (Divides c e)) /\ (~(c divides (x + e)) <=> interp x (Ndivides c e))`, REWRITE_TAC[interp; INT_ADD_RID] THEN INT_ARITH_TAC) and pth_literal_trivial = prove (`(&0 > x <=> interp x (Lt(&0))) /\ (&0 < x <=> interp x (Gt(&0))) /\ ((&0 = x) <=> interp x (Eq(&0))) /\ (~(&0 = x) <=> interp x (Ne(&0))) /\ (c divides x <=> interp x (Divides c (&0))) /\ (~(c divides x) <=> interp x (Ndivides c (&0)))`, REWRITE_TAC[interp; INT_ADD_RID] THEN INT_ARITH_TAC) in let rewr_composite = GEN_REWRITE_CONV I [pth_composite] and rewr_literal = GEN_REWRITE_CONV I [pth_literal_nontrivial] ORELSEC GEN_REWRITE_CONV I [pth_literal_trivial] and x_tm = `x:int` and p_tm = `P:bool` in let rec SHADOW_CONV x tm = if not (mem x (frees tm)) then INST [tm,p_tm; x,x_tm] pth_trivial else if is_conj tm || is_disj tm then let l,r = try dest_conj tm with Failure _ -> dest_disj tm in let thl = SHADOW_CONV x l and thr = SHADOW_CONV x r in let th1 = MK_COMB(AP_TERM (rator(rator tm)) thl,thr) in TRANS th1 (rewr_composite(rand(concl th1))) else rewr_literal tm in fun tm -> let x,bod = dest_exists tm in MK_EXISTS x (SHADOW_CONV x bod);; (* ------------------------------------------------------------------------- *) (* Get the LCM of the dividing things. *) (* ------------------------------------------------------------------------- *) let dplcm = let divides_tm = `Divides` and ndivides_tm = `Ndivides` and and_tm = `And` and or_tm = `Or` in let rec dplcm tm = let hop,args = strip_comb tm in if hop = divides_tm || hop = ndivides_tm then dest_int_const (hd args) else if hop = and_tm || hop = or_tm then end_itlist lcm_num (map dplcm args) else Int 1 in dplcm;; (* ------------------------------------------------------------------------- *) (* Conversion for true formulas "(--) &m divides (--) &n". *) (* ------------------------------------------------------------------------- *) let PROVE_DIVIDES_CONV_POS = let pth = prove (`(p * m = n) ==> &p divides &n`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[divides] THEN EXISTS_TAC `&m` THEN REWRITE_TAC[INT_OF_NUM_MUL]) and m_tm = `m:num` and n_tm = `n:num` and p_tm = `p:num` in fun tm -> let n = rand(rand tm) and p = rand(lhand tm) in let m = mk_numeral(dest_numeral n // dest_numeral p) in let th1 = INST [m,m_tm; n,n_tm; p,p_tm] pth in EQT_INTRO(MP th1 (NUM_MULT_CONV (lhand(lhand(concl th1)))));; let PROVE_DIVIDES_CONV = GEN_REWRITE_CONV REPEATC [DIVIDES_LNEG; DIVIDES_RNEG] THENC PROVE_DIVIDES_CONV_POS;; (* ------------------------------------------------------------------------- *) (* General version that works for positive and negative. *) (* ------------------------------------------------------------------------- *) let INT_DIVIDES_NUM = prove (`&p divides &n <=> ?m. (n = p * m)`, REWRITE_TAC[divides] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `x:int` MP_TAC) THEN DISJ_CASES_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) (SPEC `x:int` INT_IMAGE) THEN DISCH_THEN(MP_TAC o AP_TERM `abs:int->int`) THEN REWRITE_TAC[INT_ABS_MUL; INT_ABS_NUM; INT_ABS_NEG] THEN REWRITE_TAC[INT_OF_NUM_MUL; INT_OF_NUM_EQ] THEN MESON_TAC[]; MESON_TAC[INT_OF_NUM_MUL]]);; let INT_DIVIDES_POS_CONV = let pth = prove (`(&p divides &n) <=> (p = 0) /\ (n = 0) \/ ~(p = 0) /\ (n MOD p = 0)`, REWRITE_TAC[INT_DIVIDES_NUM] THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN EQ_TAC THENL [ASM_MESON_TAC[MOD_MULT]; DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN MESON_TAC[MULT_SYM]]) in GEN_REWRITE_CONV I [pth] THENC NUM_REDUCE_CONV;; let INT_DIVIDES_CONV = GEN_REWRITE_CONV REPEATC [DIVIDES_LNEG; DIVIDES_RNEG] THENC INT_DIVIDES_POS_CONV;; (* ------------------------------------------------------------------------- *) (* Conversion for "alldivide d p" (which should be true!) *) (* ------------------------------------------------------------------------- *) let ALLDIVIDE_CONV = let pth_atom = prove (`(alldivide d (Lt e) <=> T) /\ (alldivide d (Gt e) <=> T) /\ (alldivide d (Eq e) <=> T) /\ (alldivide d (Ne e) <=> T) /\ (alldivide d (Nox P) <=> T)`, REWRITE_TAC[alldivide]) and pth_div = prove (`(alldivide d (Divides c e) <=> c divides d) /\ (alldivide d (Ndivides c e) <=> c divides d)`, REWRITE_TAC[alldivide]) and pth_comp = prove (`(alldivide d (And p q) <=> alldivide d p /\ alldivide d q) /\ (alldivide d (Or p q) <=> alldivide d p /\ alldivide d q)`, REWRITE_TAC[alldivide]) and pth_taut = TAUT `(T /\ T <=> T)` in let basnet = itlist (fun th -> enter [] (lhand(concl th),REWR_CONV th)) (CONJUNCTS pth_atom) (itlist (fun th -> enter [] (lhand(concl th), REWR_CONV th THENC PROVE_DIVIDES_CONV)) (CONJUNCTS pth_div) empty_net) and comp_rewr = GEN_REWRITE_CONV I [pth_comp] in let rec alldivide_conv tm = try tryfind (fun f -> f tm) (lookup tm basnet) with Failure _ -> let th = (comp_rewr THENC BINOP_CONV alldivide_conv) tm in TRANS th pth_taut in alldivide_conv;; (* ------------------------------------------------------------------------- *) (* Conversion for "?b. b IN bset p /\ P b";; *) (* ------------------------------------------------------------------------- *) let EXISTS_IN_BSET_CONV = let pth_false = prove (`((?b. b IN bset (Lt e) /\ P b) <=> F) /\ ((?b. b IN bset (Divides c e) /\ P b) <=> F) /\ ((?b. b IN bset (Ndivides c e) /\ P b) <=> F) /\ ((?b. b IN bset(Nox Q) /\ P b) <=> F)`, REWRITE_TAC[bset; NOT_IN_EMPTY]) and pth_neg = prove (`((?b. b IN bset (Gt e) /\ P b) <=> P(--e)) /\ ((?b. b IN bset (Ne e) /\ P b) <=> P(--e))`, REWRITE_TAC[bset; IN_SING; INT_MUL_LID; UNWIND_THM2]) and pth_add = prove (`(?b. b IN bset (Eq e) /\ P b) <=> P(--(e + &1))`, REWRITE_TAC[bset; IN_SING; INT_MUL_LID; UNWIND_THM2]) and pth_comp = prove (`((?b. b IN bset (And p q) /\ P b) <=> (?b. b IN bset p /\ P b) \/ (?b. b IN bset q /\ P b)) /\ ((?b. b IN bset (Or p q) /\ P b) <=> (?b. b IN bset p /\ P b) \/ (?b. b IN bset q /\ P b))`, REWRITE_TAC[bset; IN_UNION] THEN MESON_TAC[]) and taut = TAUT `(F \/ P <=> P) /\ (P \/ F <=> P)` in let conv_neg vars = LAND_CONV(LAND_CONV(POLYNOMIAL_NEG_CONV vars)) and conv_add vars = LAND_CONV(LAND_CONV(RAND_CONV(POLYNOMIAL_ADD_CONV vars) THENC POLYNOMIAL_NEG_CONV vars)) and conv_comp = GEN_REWRITE_CONV I [pth_comp] in let net1 = itlist (fun th -> enter [] (lhand(concl th),K (REWR_CONV th))) (CONJUNCTS pth_false) empty_net in let net2 = itlist (fun th -> enter [] (lhand(concl th), let cnv = K (REWR_CONV th) in fun v -> cnv v THENC conv_neg v)) (CONJUNCTS pth_neg) net1 in let basnet = enter [] (lhand(concl pth_add), let cnv = K (REWR_CONV pth_add) in fun v -> cnv v THENC conv_add v) net2 in let rec baseconv vars tm = try tryfind (fun f -> f vars tm) (lookup tm basnet) with Failure _ -> (conv_comp THENC BINOP_CONV (baseconv vars)) tm in let finconv = GEN_REWRITE_CONV DEPTH_CONV [taut] THENC PURE_REWRITE_CONV [DISJ_ACI] in fun vars tm -> (baseconv vars THENC finconv) tm;; (* ------------------------------------------------------------------------- *) (* Naive conversion for "minusinf p". *) (* ------------------------------------------------------------------------- *) let MINUSINF_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV [minusinf];; (* ------------------------------------------------------------------------- *) (* Conversion for "interp s p" where s is a canonical linear form. *) (* ------------------------------------------------------------------------- *) let INTERP_CONV = let pth_trivial = prove (`interp x (Nox P) <=> P`, REWRITE_TAC[interp]) and pth_comp = prove (`(interp x (And p q) <=> interp x p /\ interp x q) /\ (interp x (Or p q) <=> interp x p \/ interp x q)`, REWRITE_TAC[interp]) and pth_pos,pth_neg = (CONJ_PAIR o prove) (`((interp x (Lt e) <=> &0 > x + e) /\ (interp x (Gt e) <=> &0 < x + e) /\ (interp x (Eq e) <=> (&0 = x + e)) /\ (interp x (Divides c e) <=> c divides (x + e))) /\ ((interp x (Ne e) <=> ~(&0 = x + e)) /\ (interp x (Ndivides c e) <=> ~(c divides (x + e))))`, REWRITE_TAC[interp] THEN INT_ARITH_TAC) in let conv_pos vars = RAND_CONV(POLYNOMIAL_ADD_CONV vars) and conv_neg vars = RAND_CONV(RAND_CONV(POLYNOMIAL_ADD_CONV vars)) and conv_comp = GEN_REWRITE_CONV I [pth_comp] in let net1 = itlist (fun th -> enter [] (lhand(concl th),K (REWR_CONV th))) (CONJUNCTS pth_trivial) empty_net in let net2 = itlist (fun th -> enter [] (lhand(concl th), let cnv = K (REWR_CONV th) in fun v -> cnv v THENC conv_pos v)) (CONJUNCTS pth_pos) net1 in let basnet = itlist (fun th -> enter [] (lhand(concl th), let cnv = K (REWR_CONV th) in fun v -> cnv v THENC conv_neg v)) (CONJUNCTS pth_neg) net2 in let rec baseconv vars tm = try tryfind (fun f -> f vars tm) (lookup tm basnet) with Failure _ -> (conv_comp THENC BINOP_CONV (baseconv vars)) tm in baseconv;; (* ------------------------------------------------------------------------- *) (* Expand `?j. &1 <= j /\ j <= &[n] /\ P[j]` cases. *) (* ------------------------------------------------------------------------- *) let EXPAND_INT_CASES_CONV = let pth_base = prove (`(?j. n <= j /\ j <= n /\ P(j)) <=> P(n)`, MESON_TAC[INT_LE_ANTISYM]) and pth_step = prove (`(?j. &1 <= j /\ j <= &(SUC n) /\ P(j)) <=> (?j. &1 <= j /\ j <= &n /\ P(j)) \/ P(&(SUC n))`, REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN REWRITE_TAC[INT_ARITH `x <= y + &1 <=> (x = y + &1) \/ x < y + &1`] THEN REWRITE_TAC[INT_LT_DISCRETE; INT_LE_RADD] THEN MESON_TAC[INT_ARITH `&0 <= x ==> &1 <= x + &1`; INT_POS; INT_LE_REFL]) in let base_conv = REWR_CONV pth_base and step_conv = BINDER_CONV(RAND_CONV(LAND_CONV(funpow 2 RAND_CONV num_CONV))) THENC REWR_CONV pth_step THENC RAND_CONV(ONCE_DEPTH_CONV NUM_SUC_CONV) in let rec conv tm = try base_conv tm with Failure _ -> (step_conv THENC LAND_CONV conv) tm in conv;; (* ------------------------------------------------------------------------- *) (* Canonicalize "t + c" in all "interp (t + c) P"s assuming t is canonical. *) (* ------------------------------------------------------------------------- *) let CANON_INTERP_ADD = let pat = `interp (t + c) P` in fun vars -> let net = net_of_conv pat (LAND_CONV(POLYNOMIAL_ADD_CONV vars)) empty_net in ONCE_DEPTH_CONV(REWRITES_CONV net);; (* ------------------------------------------------------------------------- *) (* Conversion to evaluate constant expressions. *) (* ------------------------------------------------------------------------- *) let EVAL_CONSTANT_CONV = let net = itlist (uncurry net_of_conv) ([`x < y`,INT_LT_CONV; `x > y`,INT_GT_CONV; `x:int = y`,INT_EQ_CONV; `x divides y`,INT_DIVIDES_CONV] @ map (fun t -> t,REWR_CONV(REWRITE_CONV[] t)) [`~F`; `~T`; `a /\ T`; `T /\ a`; `a /\ F`; `F /\ a`; `a \/ T`; `T \/ a`; `a \/ F`; `F \/ a`]) empty_net in DEPTH_CONV(REWRITES_CONV net);; (* ------------------------------------------------------------------------- *) (* Basic quantifier elimination conversion. *) (* ------------------------------------------------------------------------- *) let BASIC_COOPER_CONV = let p_tm = `p:cform` and d_tm = `d:int` in let pth_B = SPECL [p_tm; d_tm] MAINTHM_B in fun vars tm -> let x,bod = dest_exists tm in let th1 = (NORMALIZE_COEFF_CONV vars THENC SHADOW_CONV) tm in let p = rand(snd(dest_exists(rand(concl th1)))) in let th2 = INST [p,p_tm; mk_int_const(dplcm p),d_tm] pth_B in let tm2a,tm2b = dest_conj(lhand(concl th2)) in let th3 = CONJ (EQT_ELIM(ALLDIVIDE_CONV tm2a)) (EQT_ELIM(INT_LT_CONV tm2b)) in let th4 = TRANS th1 (MP th2 th3) in let th5 = CONV_RULE(RAND_CONV(BINDER_CONV(funpow 2 RAND_CONV(LAND_CONV MINUSINF_CONV)))) th4 in let th6 = CONV_RULE(RAND_CONV(BINDER_CONV(funpow 3 RAND_CONV (EXISTS_IN_BSET_CONV vars)))) th5 in let th7 = CONV_RULE(RAND_CONV EXPAND_INT_CASES_CONV) th6 in let th8 = CONV_RULE(RAND_CONV(CANON_INTERP_ADD vars)) th7 in let th9 = CONV_RULE(RAND_CONV(ONCE_DEPTH_CONV(INTERP_CONV vars))) th8 in CONV_RULE(RAND_CONV EVAL_CONSTANT_CONV) th9;; (* ------------------------------------------------------------------------- *) (* NNF transformation that also eliminates negated inequalities. *) (* ------------------------------------------------------------------------- *) let NNF_POSINEQ_CONV = let pth = prove (`(~(&0 < x) <=> &0 < &1 - x) /\ (~(&0 > x) <=> &0 < &1 + x)`, REWRITE_TAC[INT_NOT_LT; INT_GT] THEN REWRITE_TAC[INT_LT_DISCRETE; INT_GT_DISCRETE] THEN INT_ARITH_TAC) in let conv1 vars = REWR_CONV(CONJUNCT1 pth) THENC RAND_CONV (POLYNOMIAL_SUB_CONV vars) and conv2 vars = REWR_CONV(CONJUNCT2 pth) THENC RAND_CONV (POLYNOMIAL_ADD_CONV vars) and pat1 = `~(&0 < x)` and pat2 = `~(&0 > x)` and net = itlist (fun t -> net_of_conv (lhand t) (REWR_CONV(TAUT t))) [`~(~ p) <=> p`; `~(p /\ q) <=> ~p \/ ~q`; `~(p \/ q) <=> ~p /\ ~q`] empty_net in fun vars -> let net' = net_of_conv pat1 (conv1 vars) (net_of_conv pat2 (conv2 vars) net) in TOP_SWEEP_CONV(REWRITES_CONV net');; (* ------------------------------------------------------------------------- *) (* Overall function. *) (* ------------------------------------------------------------------------- *) let COOPER_CONV = let FORALL_ELIM_CONV = GEN_REWRITE_CONV I [prove(`(!x. P x) <=> ~(?x. ~(P x))`,MESON_TAC[])] and not_tm = `(~)` in let rec conv vars tm = if is_conj tm || is_disj tm then let lop,r = dest_comb tm in let op,l = dest_comb lop in MK_COMB(AP_TERM op (conv vars l),conv vars r) else if is_neg tm then let l,r = dest_comb tm in AP_TERM l (conv vars r) else if is_exists tm then let x,bod = dest_exists tm in let th1 = MK_EXISTS x (conv (x::vars) bod) in TRANS th1 (BASIC_COOPER_CONV vars (rand(concl th1))) else if is_forall tm then let x,bod = dest_forall tm in let th1 = AP_TERM not_tm (conv (x::vars) bod) in let th2 = CONV_RULE(RAND_CONV (NNF_POSINEQ_CONV (x::vars))) th1 in let th3 = MK_EXISTS x th2 in let th4 = CONV_RULE(RAND_CONV (BASIC_COOPER_CONV vars)) th3 in let th5 = CONV_RULE(RAND_CONV (NNF_POSINEQ_CONV (x::vars))) (AP_TERM not_tm th4) in TRANS (FORALL_ELIM_CONV tm) th5 else REFL tm in let init_CONV = PRESIMP_CONV THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [INT_ABS; INT_ARITH `max m n = if m <= n then n else m`; INT_ARITH `min m n = if m <= n then m else n`] THENC CONDS_ELIM_CONV THENC NNF_CONV in fun tm -> let vars = frees tm in let th1 = (init_CONV THENC LINEARIZE_CONV vars) tm in let th2 = TRANS th1 (conv vars (rand(concl th1))) in TRANS th2 (EVAL_CONSTANT_CONV(rand(concl th2)));; (* ------------------------------------------------------------------------- *) (* Examples from the book. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!x y. x < y ==> &2 * x + &1 < &2 * y`;; time COOPER_CONV `!x y. ~(&2 * x + &1 = &2 * y)`;; time COOPER_CONV `?x y. x > &0 /\ y >= &0 /\ (&3 * x - &5 * y = &1)`;; time COOPER_CONV `?x y z. &4 * x - &6 * y = &1`;; time COOPER_CONV `!x. b < x ==> a <= x`;; time COOPER_CONV `!x. a < &3 * x ==> b < &3 * x`;; time COOPER_CONV `!x y. x <= y ==> &2 * x + &1 < &2 * y`;; time COOPER_CONV `(?d. y = &65 * d) ==> (?d. y = &5 * d)`;; time COOPER_CONV `!y. (?d. y = &65 * d) ==> (?d. y = &5 * d)`;; time COOPER_CONV `!x y. ~(&2 * x + &1 = &2 * y)`;; time COOPER_CONV `!x y z. (&2 * x + &1 = &2 * y) ==> x + y + z > &129`;; time COOPER_CONV `!x. a < x ==> b < x`;; time COOPER_CONV `!x. a <= x ==> b < x`;; (* ------------------------------------------------------------------------- *) (* Formula examples from Cooper's paper. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!a b. ?x. a < &20 * x /\ &20 * x < b`;; time COOPER_CONV `?x. a < &20 * x /\ &20 * x < b`;; time COOPER_CONV `!b. ?x. a < &20 * x /\ &20 * x < b`;; time COOPER_CONV `!a. ?b. a < &4 * b + &3 * a \/ (~(a < b) /\ a > b + &1)`;; time COOPER_CONV `?y. !x. x + &5 * y > &1 /\ &13 * x - y > &1 /\ x + &2 < &0`;; (* ------------------------------------------------------------------------- *) (* More of my own. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!x y. x >= &0 /\ y >= &0 ==> &12 * x - &8 * y < &0 \/ &12 * x - &8 * y > &2`;; time COOPER_CONV `?x y. &5 * x + &3 * y = &1`;; time COOPER_CONV `?x y. &5 * x + &10 * y = &1`;; time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&5 * x - &6 * y = &1)`;; time COOPER_CONV `?w x y z. &2 * w + &3 * x + &4 * y + &5 * z = &1`;; time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&5 * x - &3 * y = &1)`;; time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&3 * x - &5 * y = &1)`;; time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&6 * x - &3 * y = &1)`;; time COOPER_CONV `!x y. ~(x = &0) ==> &5 * y < &6 * x \/ &5 * y > &6 * x`;; time COOPER_CONV `!x y. ~(&5 divides x) /\ ~(&6 divides y) ==> ~(&6 * x = &5 * y)`;; time COOPER_CONV `!x y. ~(&5 divides x) ==> ~(&6 * x = &5 * y)`;; time COOPER_CONV `!x y. ~(&6 * x = &5 * y)`;; time COOPER_CONV `!x y. (&6 * x = &5 * y) ==> (?d. y = &3 * d)`;; time COOPER_CONV `(&6 * x = &5 * y) ==> (?d. y = &3 * d)`;; (* ------------------------------------------------------------------------- *) (* Positive variant of the Bezout theorem (see the exercise). *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!z. z > &7 ==> ?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = z)`;; time COOPER_CONV `!z. z > &2 ==> ?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = z)`;; time COOPER_CONV `!z. z <= &7 ==> ((?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = z)) <=> ~(?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = &7 - z)))`;; (* ------------------------------------------------------------------------- *) (* Basic result about congruences. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!x. ~(&2 divides x) /\ &3 divides (x - &1) <=> &12 divides (x - &1) \/ &12 divides (x - &7)`;; time COOPER_CONV `!x. ~(?m. x = &2 * m) /\ (?m. x = &3 * m + &1) <=> (?m. x = &12 * m + &1) \/ (?m. x = &12 * m + &7)`;; (* ------------------------------------------------------------------------- *) (* Something else. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!x. ~(&2 divides x) ==> &4 divides (x - &1) \/ &8 divides (x - &1) \/ &8 divides (x - &3) \/ &6 divides (x - &1) \/ &14 divides (x - &1) \/ &14 divides (x - &9) \/ &14 divides (x - &11) \/ &24 divides (x - &5) \/ &24 divides (x - &11)`;; (* ------------------------------------------------------------------------- *) (* Testing fix for an earlier version with negative result from formlcm. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!a b v_1 v_2 v_3. (a + &2 = b) /\ (v_3 = b - a + &1) /\ (v_2 = b - &2) /\ (v_1 = &3) ==> F`;; (* ------------------------------------------------------------------------- *) (* Inspired by the Collatz conjecture. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `?a b. ~(a = &1) /\ ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ (a = b)`;; time COOPER_CONV `?a b. a > &1 /\ b > &1 /\ ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ (a = b)`;; time COOPER_CONV `?b. a > &1 /\ b > &1 /\ ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ ((&2 * a = b) \/ (&2 * a = &3 * b + &1))`;; (*************** These seem to take a long time time COOPER_CONV `?a b. a > &1 /\ b > &1 /\ ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ ((&2 * a = b) \/ (&2 * a = &3 * b + &1))`;; let fm = (dnf ** parse) `((2 * b = a) \/ (2 * b = &3 * a + 1)) /\ ((2 * c = b) \/ (2 * c = &3 * b + 1)) /\ ((2 * d = c) \/ (2 * d = &3 * c + 1)) /\ ((2 * e = d) \/ (2 * e = &3 * d + 1)) /\ ((2 * f = e) \/ (2 * f = &3 * e + 1)) /\ (f = a)`;; let fms = map (itlist (fun x p -> Exists(x,And(Atom(R(`>`,[Var x; Fn(`1`,[])])),p))) [`b`; `c`; `d`; `e`; `f`]) (disjuncts fm);; let fm = el &15 fms;; integer_qelim fm;; ******************) (* ------------------------------------------------------------------------- *) (* More old examples. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `?x. &5 * x + x + x < x \/ (y = &7 - x) /\ &33 + z < x /\ x + &1 <= &2 * y \/ &3 divides &4 * x + z /\ (x + y + z = &7 * z)`;; time COOPER_CONV `?x. &5 * x + x + x < x \/ (y = &7 - x) /\ &33 + z < x /\ x + &1 <= &2 * y \/ &3 divides (&4 * x + z) /\ (x + y + z = &7 * z)`;; time COOPER_CONV `?x. &5 * x + x + x < x \/ (y = &7 - x) /\ &33 + z < x /\ x + &1 <= &2 * y \/ &3 divides (&4 * x + z) /\ (x + y + z = &7 * z)`;; (**** This also seems very slow; one quantifier less maybe? time COOPER_CONV `?z y x. &5 * x + x + x < x \/ (y = &7 - x) /\ &33 + z < x /\ x + &1 <= &2 * y \/ &3 divides (&4 * x + z) /\ (x + y + z = &7 * z)`;; time COOPER_CONV `?y x. &5 * x + x + x < x \/ (y = &7 - x) /\ &33 + z < x /\ x + &1 <= &2 * y \/ &3 divides (&4 * x + z) /\ (x + y + z = &7 * z)`;; *****) time COOPER_CONV `?x. x + &1 < &2 * y /\ &3 divides (&4 * x + z) /\ (&6 * x + y + z = &7 * z)`;; time COOPER_CONV `?x. &5 * x + x + x < x \/ (y = &7 - x) /\ &33 + z < x /\ x + &1 < &2 * y \/ &3 divides (&4 * x + z) /\ (x + y + z = &7 * z)`;; (* ------------------------------------------------------------------------- *) (* Stamp problem. *) (* ------------------------------------------------------------------------- *) time COOPER_CONV `!x. x >= &8 ==> ?u v. u >= &0 /\ v >= &0 /\ (x = &3 * u + &5 * v)`;; time COOPER_CONV `!x. x >= &10 ==> ?u v. u >= &0 /\ v >= &0 /\ (x = &3 * u + &7 * v)`;; time COOPER_CONV `!x. x >= &30 ==> ?u v. u >= &0 /\ v >= &0 /\ (x = &3 * u + &7 * v)`;; (* ------------------------------------------------------------------------- *) (* Decision procedures in the style of INT_ARITH and ARITH_RULE. *) (* *) (* Really I should locate the free alien subterms. *) (* ------------------------------------------------------------------------- *) let INT_COOPER tm = let fvs = frees tm in let tm' = list_mk_forall(fvs,tm) in SPECL fvs (EQT_ELIM(COOPER_CONV tm'));; let COOPER_RULE tm = let fvs = frees tm in let tm' = list_mk_forall(fvs,tm) in let th = (NUM_TO_INT_CONV THENC COOPER_CONV) tm' in SPECL fvs (EQT_ELIM th);; (* ------------------------------------------------------------------------- *) (* Examples. *) (* ------------------------------------------------------------------------- *) time INT_COOPER `abs(x) < &1 ==> (x = &0)`;; time COOPER_RULE `ODD n ==> 2 * n DIV 2 < n`;; time COOPER_RULE `!n. EVEN(n) ==> (2 * n DIV 2 = n)`;; time COOPER_RULE `!n. ODD n <=> 2 * n DIV 2 < n`;; (**** This seems quite slow (maybe not very) as well time COOPER_RULE `n DIV 3 <= n DIV 2`;; ****) (*** This one too? time COOPER_RULE `!x. ?y. if EVEN x then x = 2 * y else x = 2 * (y - 1) + 1`;; ***) time COOPER_RULE `!n. n >= 8 ==> ?a b. n = 3 * a + 5 * b`;; hol-light/Examples/dickson.ml000066400000000000000000000111401303454263000165040ustar00rootroot00000000000000(* ========================================================================= *) (* Dickson's lemma. *) (* ========================================================================= *) let MINIMIZING_CHOICE = prove (`!(m:A->num) s. (?x. P x) ==> ?a. P a /\ !b. P b ==> m(a) <= m(b)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM NOT_LT] THEN MP_TAC(ISPEC `\n. ?x. P x /\ (m:A->num) x = n` num_WOP) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* The Nash-Williams minimal bad sequence argument for some predicate `bad` *) (* that is a "safety property" in the Lamport/Alpern/Schneider sense. *) (* ------------------------------------------------------------------------- *) let MINIMAL_BAD_SEQUENCE = prove (`!(bad:(num->A)->bool) (m:A->num). (!x. ~bad x ==> ?n. !y. (!k. k < n ==> y k = x k) ==> ~bad y) /\ (?x. bad x) ==> ?y. bad y /\ !z n. bad z /\ (!k. k < n ==> z k = y k) ==> m(y n) <= m(z n)`, REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `?x. !n. (x:num->A) n = @a. (?y. bad y /\ (!k. k < n ==> y k = x k) /\ y n = a) /\ !z. bad z /\ (!k. k < n ==> z k = x k) ==> (m:A->num)(a) <= m(z n)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. (?y:num->A. bad y /\ (!k. k < n ==> y k = x k) /\ y n = x n) /\ !z. bad z /\ (!k. k < n ==> z k = x k) ==> m(x n):num <= m(z n)` ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `x:num->A` THEN ASM_MESON_TAC[]] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(fun th -> DISCH_TAC THEN SUBST1_TAC(SPEC `n:num` th)) THEN CONV_TAC SELECT_CONV THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[TAUT `(p /\ q /\ r) /\ s <=> r /\ p /\ q /\ s`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM1] THEN REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC MINIMIZING_CHOICE THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN SIMP_TAC[LT] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Dickson's Lemma itself. *) (* ------------------------------------------------------------------------- *) let DICKSON = prove (`!n x:num->num->num. ?i j. i < j /\ (!k. k < n ==> x i k <= x j k)`, ABBREV_TAC `bad = \n x:num->num->num. !i j. i < j ==> ?k. k < n /\ x j k < x i k` THEN SUBGOAL_THEN `!n:num x:num->num->num. ~(bad n x)` MP_TAC THENL [ALL_TAC; EXPAND_TAC "bad" THEN MESON_TAC[NOT_LT]] THEN INDUCT_TAC THENL [EXPAND_TAC "bad" THEN MESON_TAC[LT]; ALL_TAC] THEN REWRITE_TAC[GSYM NOT_EXISTS_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `?x. bad (SUC n) (x:num->num->num) /\ !y j. bad (SUC n) y /\ (!i. i < j ==> y i = x i) ==> x j n <= y j n` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC MINIMAL_BAD_SEQUENCE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:num->num->num` THEN EXPAND_TAC "bad" THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN EXISTS_TAC `SUC j` THEN X_GEN_TAC `y:num->num->num` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LT_SUC_LE] THEN REWRITE_TAC[LE_LT] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`i:num`; `j:num`] THEN ASM_MESON_TAC[]; SUBGOAL_THEN `~(bad (n:num) (x:num->num->num))` MP_TAC THENL [ASM_MESON_TAC[]; EXPAND_TAC "bad" THEN REWRITE_TAC[]] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN MP_TAC(ASSUME `bad (SUC n) (x:num->num->num):bool`) THEN EXPAND_TAC "bad" THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[LT_REFL] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\k. if k < i then (x:num->num->num) k else x (j + k - i)`) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[LT_REFL; SUB_REFL; ADD_CLAUSES; NOT_IMP; NOT_LE] THEN SIMP_TAC[] THEN UNDISCH_TAC `bad (SUC n) (x:num->num->num):bool` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN EXPAND_TAC "bad" THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_MESON_TAC[LT_TRANS; ARITH_RULE `(a:num < i /\ ~(b < i) /\ i < j ==> a < j + b - i) /\ (~(a < i) /\ a < b /\ i < j ==> j + a - i < j + b - i)`]]);; hol-light/Examples/division_algebras.ml000066400000000000000000000720471303454263000205530ustar00rootroot00000000000000(* ========================================================================= *) (* Some nonexistence proofs for division algebras in higher dimensions. *) (* This does not (yet...) include the much more difficult restriction from *) (* Bott-Milnor-Kervaire to 1, 2, 4 or 8 dimensions, but does have these: *) (* *) (* - Any division algebra must have even (or 1) dimension. This is simple *) (* linear algebra, but given that Hamilton tried hard to find an example *) (* in 3 dimensions, it's perhaps not completely trivial. *) (* *) (* - Any commutative division algebra must have dimension 1 or 2. This is *) (* originally due to Hopf. *) (* *) (* - Any associative division algebra must have dimension 1, 2 or 4. This *) (* goes back to Frobenius. *) (* *) (* It would need only a little more work to show that the 2-dim and 4-dim *) (* examples in the latter must be isomorphic to complexes or quaternions. *) (* Most of the required reasoning is already buried inside the proofs, and *) (* the structures themselves are both available in the libraries: *) (* *) (* Multivariate/make_complex.ml --- the complex numbers *) (* Quaternions/make.ml --- the quaternions *) (* ------------------------------------------------------------------------- *) needs "Multivariate/moretop.ml";; (* ------------------------------------------------------------------------- *) (* First the easy fact that any division algebra must have even dimension *) (* (or trivially 1). This essentially follows from the fact that every *) (* linear operator has an eigenvector when the dimension is odd. One proof *) (* would be that the characteristic polynomial has odd degree and hence has *) (* a root, but we get it from a convenient topological generalization. *) (* ------------------------------------------------------------------------- *) let DIVISION_ALGEBRA = prove (`!m:real^N->real^N->real^N. bilinear m /\ (!x y. m x y = vec 0 ==> x = vec 0 \/ y = vec 0) ==> dimindex(:N) = 1 \/ EVEN(dimindex(:N))`, REWRITE_TAC[ETA_AX; bilinear; linear; FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN REWRITE_TAC[GSYM NOT_ODD] THEN SUBGOAL_THEN `?g. linear g /\ (!x. g (m (basis 1) x) = x) /\ (!x. (m:real^N->real^N->real^N) (basis 1) (g x) = x)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC LINEAR_INJECTIVE_ISOMORPHISM THEN ASM_REWRITE_TAC[linear] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN DISCH_TAC THEN SUBGOAL_THEN `basis 1:real^N = vec 0 \/ x + --(&1) % y:real^N = vec 0` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]] THEN ASM_REWRITE_TAC[VECTOR_ARITH `x + --(&1) % y:real^N = vec 0 <=> x = y`]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(m:real^N->real^N->real^N) (basis 2) o (g:real^N->real^N)` o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_FUNCTION_HAS_EIGENVALUES_ODD_DIM)) THEN REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN ASM_SIMP_TAC[DIMINDEX_GE_1; ARITH] THEN ASM_REWRITE_TAC[linear]; MAP_EVERY X_GEN_TAC [`v:real^N`; `c:real`] THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[IN_SPHERE_0; NORM_0; o_THM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN SUBGOAL_THEN `?w. v = (m:real^N->real^N->real^N) (basis 1) w` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(w:real^N = vec 0)` ASSUME_TAC THENL [ASM_MESON_TAC[VECTOR_MUL_LZERO]; ASM_REWRITE_TAC[]] THEN DISCH_TAC THEN SUBGOAL_THEN `basis 2 + --c % basis 1:real^N = vec 0 \/ w:real^N = vec 0` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `x + --c % y:real^N = vec 0 <=> x = c % y`]; ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$2`) THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[BASIS_COMPONENT; ARITH; VEC_COMPONENT] THEN REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* The fact that there is no *commutative* division algebra for dim > 2, *) (* even without assuming associativity. This is based on the paper by *) (* W. B. Gordon, "An Application of Hadamard's Inverse Function Theorem *) (* to Algebra", American Mathematical Monthly vol. 84 (1977), pp. 28-29. *) (* The original proof of this result is due to Hopf. *) (* ------------------------------------------------------------------------- *) let COMMUTATIVE_DIVISION_ALGEBRA_GEN = prove (`!m:real^N->real^N->real^N s. bilinear m /\ subspace s /\ (!x y. m x y = vec 0 ==> x = vec 0 \/ y = vec 0) /\ (!x y. x IN s /\ y IN s ==> m x y IN s /\ m x y = m y x) ==> dim s <= 2`, REWRITE_TAC[ARITH_RULE `n <= 2 <=> ~(3 <= n)`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(!x y c. (m:real^N->real^N->real^N) x (c % y) = c % m x y) /\ (!x y z. m x (y + z) = m x y + m x z)` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[bilinear; linear]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ABBREV_TAC `f:real^N->real^N = \x. m x x` THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s DELETE (vec 0:real^N)`; `s DELETE (vec 0:real^N)`] PROPER_LOCAL_HOMEOMORPHISM_GLOBAL) THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_PUNCTURED_CONVEX; INT_OF_NUM_LE; SUBSPACE_IMP_CONVEX; AFF_DIM_DIM_SUBSPACE; SIMPLY_CONNECTED_IMP_PATH_CONNECTED; NOT_IMP] THEN SUBGOAL_THEN `!x. (f:real^N->real^N) x = vec 0 <=> x = vec 0` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_MESON_TAC[VECTOR_ARITH `x + y:real^N = x <=> y = vec 0`]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s DELETE vec 0 /\ (f:real^N->real^N) x IN k} = s INTER {x | x IN UNIV /\ (f:real^N->real^N) x IN k}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_SIMP_TAC[CLOSED_SUBSPACE; COMPACT_EQ_BOUNDED_CLOSED] THEN SUBGOAL_THEN `(f:real^N->real^N) continuous_on UNIV` ASSUME_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] BILINEAR_CONTINUOUS_ON_COMPOSE))) THEN REWRITE_TAC[CONTINUOUS_ON_ID]; FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_BOUNDED_CLOSED])] THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_UNIV] THEN MP_TAC(ISPECL [`IMAGE (f:real^N->real^N) (sphere(vec 0,&1))`; `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[IN_SPHERE_0; SPHERE_EQ_EMPTY; DIST_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV; COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE; COMPACT_SPHERE]; DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC)] THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < norm((f:real^N->real^N) a)` ASSUME_TAC THENL [ASM_MESON_TAC[NORM_POS_LT; NORM_EQ_0]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[bounded] THEN EXISTS_TAC `sqrt(B / norm((f:real^N->real^N) a))` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `~((f:real^N->real^N) x = vec 0) /\ ~(x = vec 0)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_RSQRT THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; REAL_POW_LT] THEN TRANS_TAC REAL_LE_TRANS `norm((f:real^N->real^N) (inv(norm x) % x))` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; REAL_POW_LT] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM REAL_ABS_NORM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_ABS_POW; GSYM NORM_MUL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN k ==> y = x ==> y IN k`)) THEN EXPAND_TAC "f" THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear; linear]) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; VECTOR_MUL_LID; REAL_FIELD `~(x = &0) ==> x pow 2 * inv x * inv x = &1`]]; X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `\x h. &2 % (m:real^N->real^N->real^N) h x`; `s DELETE (vec 0:real^N)`; `s:real^N->bool`; `a:real^N`] INVERSE_FUNCTION_THEOREM_SUBSPACE) THEN ASM_SIMP_TAC[OPEN_IN_DELETE; IN_DELETE; OPEN_IN_REFL] THEN ANTS_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN CONJ_TAC THENL [MP_TAC(ISPECL [`m:real^N->real^N->real^N`; `\x:real^N. x`; `\x:real^N. x`; `\x:real^N. x`; `\x:real^N. x`; `x:real^N`; `s:real^N->bool`] HAS_DERIVATIVE_BILINEAR_WITHIN) THEN ASM_REWRITE_TAC[HAS_DERIVATIVE_ID] THEN REWRITE_TAC[has_derivative] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC LINEAR_COMPOSE_CMUL THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `trivial_limit(at (x:real^N) within s)` THENL [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `x:real^N = y ==> x + y = &2 % y`) THEN ASM_MESON_TAC[SUBSPACE_SUB]; MATCH_MP_TAC LINEAR_INJECTIVE_IMP_SURJECTIVE_ON THEN ASM_REWRITE_TAC[LE_REFL; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[SUBSPACE_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear]) THEN ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN REWRITE_TAC[VECTOR_ARITH `&2 % x:real^N = &2 % y <=> x = y`] THEN STRIP_TAC THEN SUBGOAL_THEN `x:real^N = vec 0 \/ y + --(&1) % z:real^N = vec 0` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[linear]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `x + --(&1) % y:real^N = vec 0 <=> x = y`] THEN ASM_MESON_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THENL [ASM SET_TAC[]; REWRITE_TAC[DELETE_SUBSET]] THEN SUBGOAL_THEN `v = IMAGE (f:real^N->real^N) u` SUBST1_TAC THENL [ASM_MESON_TAC[homeomorphism]; SIMP_TAC[SUBSET; FORALL_IN_IMAGE]] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_DELETE] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [EXPAND_TAC "f"; ASM SET_TAC[]] THEN ASM_MESON_TAC[SUBSET]]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` MP_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `3 <= n ==> ~(n = 0)`)) THEN REWRITE_TAC[DIM_EQ_0; LEFT_IMP_EXISTS_THM; SET_RULE `~(s SUBSET {a}) <=> ?x. x IN s /\ ~(x = a)`] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN REWRITE_TAC[homeomorphism] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `--(&1) % x:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN ASM_REWRITE_TAC[IN_DELETE; VECTOR_MUL_EQ_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear; linear]) THEN EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[VECTOR_MUL_LID; SUBSPACE_MUL; VECTOR_ARITH `x = --(&1) % x <=> x:real^N = vec 0`]]);; let COMMUTATIVE_DIVISION_ALGEBRA = prove (`!m:real^N->real^N->real^N. bilinear m /\ (!x y. m x y = m y x) /\ (!x y. m x y = vec 0 ==> x = vec 0 \/ y = vec 0) ==> dimindex(:N) IN {1,2}`, REPEAT STRIP_TAC THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MATCH_MP_TAC(ARITH_RULE `1 <= n /\ n <= 2 ==> n = 1 \/ n = 2`) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN REWRITE_TAC[GSYM DIM_UNIV] THEN MATCH_MP_TAC COMMUTATIVE_DIVISION_ALGEBRA_GEN THEN EXISTS_TAC `m:real^N->real^N->real^N` THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Frobenius's theorem that there is no associative division algebra except *) (* in dimensions 1, 2 and 4. This has a more elementary purely algebraic *) (* proof, but since we have the commutative case proved above, we can make *) (* good use of it. *) (* ------------------------------------------------------------------------- *) let ASSOCIATIVE_DIVISION_ALGEBRA_HAS_IDENTITY = prove (`!m:real^N->real^N->real^N. bilinear m /\ (!x y z. m (m x y) z = m x (m y z)) /\ (!x y. m x y = vec 0 ==> x = vec 0 \/ y = vec 0) ==> ?e. (!x. m e x = x) /\ (!x. m x e = x)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bilinear]) THEN REWRITE_TAC[linear; FORALL_AND_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `~(basis 1:real^N = vec 0)` ASSUME_TAC THENL [ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?e. (m:real^N->real^N->real^N) (basis 1) e = basis 1` MP_TAC THENL [MP_TAC(ISPEC `(m:real^N->real^N->real^N) (basis 1)` LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[linear]; MESON_TAC[]] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = y <=> x + -- &1 % y = vec 0`] THEN SUBGOAL_THEN `!x y. (m:real^N->real^N->real^N) (basis 1) x + -- &1 % m (basis 1) y = m (basis 1) (x + -- &1 % y)` (fun th -> REWRITE_TAC[th]) THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real^N` THEN ASM_CASES_TAC `e:real^N = vec 0` THENL [ASM_MESON_TAC[VECTOR_MUL_LZERO]; DISCH_TAC] THEN SUBGOAL_THEN `basis 1:real^N = vec 0 \/ (m:real^N->real^N->real^N) e e + --(&1) % e = vec 0` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `x + --(&1) % y = vec 0 <=> x:real^N = y`] THENL [ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN SUBGOAL_THEN `!x. (e:real^N = vec 0 \/ m e x - x:real^N = vec 0) /\ (m x e - x = vec 0 \/ e = vec 0)` (fun th -> ASM_MESON_TAC[VECTOR_SUB_EQ; th]) THEN GEN_TAC THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --(&1) % y`] THEN ASM_MESON_TAC[VECTOR_ARITH `x + --(&1) % x:real^N = vec 0`]);; let ASSOCIATIVE_DIVISION_ALGEBRA = prove (`!m:real^N->real^N->real^N. bilinear m /\ (!x y z. m (m x y) z = m x (m y z)) /\ (!x y. m x y = vec 0 ==> x = vec 0 \/ y = vec 0) ==> dimindex(:N) IN {1,2,4}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `m:real^N->real^N->real^N` ASSOCIATIVE_DIVISION_ALGEBRA_HAS_IDENTITY) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bilinear]) THEN REWRITE_TAC[linear; FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(e:real^N = vec 0)` ASSUME_TAC THENL [SUBGOAL_THEN `~(basis 1:real^N = vec 0)` ASSUME_TAC THENL [SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; ASM_MESON_TAC[VECTOR_MUL_LZERO]]; ALL_TAC] THEN ASM_CASES_TAC `span {e} = (:real^N)` THENL [FIRST_X_ASSUM(MP_TAC o SYM o AP_TERM `dim:(real^N->bool)->num`) THEN ASM_SIMP_TAC[DIM_SPAN; DIM_SING; DIM_UNIV; IN_INSERT]; ONCE_REWRITE_TAC[IN_INSERT] THEN DISJ2_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = UNIV) ==> ?x. ~(x IN s)`)) THEN DISCH_THEN(X_CHOOSE_TAC `j:real^N`) THEN SUBGOAL_THEN `!s. (!x y. x IN s /\ y IN s ==> (m:real^N->real^N->real^N) x y = m y x) ==> dim s <= 2` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN (X_CHOOSE_THEN `C:real^N->bool` MP_TAC o prove_inductive_relations_exist) `(!x:real^N. x IN s ==> C x) /\ (!c x. C x ==> C(c % x)) /\ (!x y. C x /\ C y ==> C(x + y)) /\ (!x y. C x /\ C y ==> C(m x y))` THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN MP_TAC(SET_RULE `!x:real^N. C x <=> x IN C`) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_TAC THEN SUBGOAL_THEN `!x y. x IN C /\ y IN C ==> (m:real^N->real^N->real^N) x y = m y x` ASSUME_TAC THENL [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN TRANS_TAC EQ_TRANS `(m:real^N->real^N->real^N) (m z x) y` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN TRANS_TAC EQ_TRANS `(m:real^N->real^N->real^N) (m x z) y` THEN ASM_MESON_TAC[]; SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:real^N` THEN ASM_CASES_TAC `(z:real^N) IN C` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN TRANS_TAC LE_TRANS `dim(C:real^N->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC DIM_SUBSET THEN ASM_REWRITE_TAC[SUBSET]; ALL_TAC] THEN ASM_CASES_TAC `C:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIM_EMPTY; ARITH] THEN MATCH_MP_TAC COMMUTATIVE_DIVISION_ALGEBRA_GEN THEN EXISTS_TAC `m:real^N->real^N->real^N` THEN ASM_REWRITE_TAC[subspace] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; VECTOR_MUL_LZERO]; ALL_TAC] THEN SUBGOAL_THEN `(!x. (m:real^N->real^N->real^N) x (vec 0) = vec 0) /\ (!x. (m:real^N->real^N->real^N) (vec 0) x = vec 0)` ASSUME_TAC THENL [ASM_MESON_TAC[VECTOR_MUL_LZERO]; ALL_TAC] THEN ABBREV_TAC `C = span{j:real^N,e}` THEN SUBGOAL_THEN `(e:real^N) IN C /\ j IN C` STRIP_ASSUME_TAC THENL [EXPAND_TAC "C" THEN SIMP_TAC[SPAN_SUPERSET; IN_INSERT]; ALL_TAC] THEN SUBGOAL_THEN `subspace(C:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[SUBSPACE_SPAN]; REWRITE_TAC[subspace] THEN STRIP_TAC] THEN SUBGOAL_THEN `dim(C:real^N->bool) = 2` ASSUME_TAC THENL [EXPAND_TAC "C" THEN REWRITE_TAC[DIM_INSERT; DIM_SPAN] THEN ASM_REWRITE_TAC[SPAN_EMPTY; DIM_EMPTY; IN_SING] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `!x y:real^N. x IN C /\ y IN C ==> m x y IN C` ASSUME_TAC THENL [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN EXPAND_TAC "C" THEN MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[subspace; IN_ELIM_THM] THEN EXPAND_TAC "C" THEN SIMP_TAC[SPAN_ADD; SPAN_MUL; SPAN_0] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "C" THEN MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[subspace; IN_ELIM_THM] THEN EXPAND_TAC "C" THEN SIMP_TAC[SPAN_ADD; SPAN_MUL; SPAN_0] THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN EXPAND_TAC "C" THEN SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `{m j j:real^N,j,e}`) THEN ASM_REWRITE_TAC[DIM_INSERT; DIM_SING] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?i. i IN C /\ (m:real^N->real^N->real^N) i i = --e` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `(m:real^N->real^N->real^N) j j IN C` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "C" THEN SIMP_TAC[SPAN_SUPERSET; IN_INSERT]; FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM th])] THEN REWRITE_TAC[SPAN_2; IN_ELIM_THM; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN ABBREV_TAC `k:real^N = j + (--a / &2) % e` THEN SUBGOAL_THEN `(m:real^N->real^N->real^N) k k = (b + a pow 2 / &4) % e` ASSUME_TAC THENL [EXPAND_TAC "k" THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "k" THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN SUBGOAL_THEN `(k:real^N) IN C` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `inv(sqrt(--(b + a pow 2 / &4))) % k:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; GSYM REAL_POW_2; REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(REAL_FIELD `x pow 2 = --y /\ ~(y = &0) ==> inv x pow 2 * y = --(&1)`) THEN REWRITE_TAC[SQRT_POW2; REAL_ARITH `&0 <= --x /\ ~(x = &0) <=> ~(&0 <= x)`] THEN DISCH_TAC THEN SUBGOAL_THEN `?c. k:real^N = --c % e` (CHOOSE_THEN SUBST_ALL_TAC) THENL [REWRITE_TAC[VECTOR_ARITH `k:real^N = --c % e <=> k + c % e = vec 0`] THEN MATCH_MP_TAC(MESON[] `(?c:real. P c \/ P(--c)) ==> ?c. P c`) THEN EXISTS_TAC `sqrt(b + a pow 2 / &4)` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN REWRITE_TAC[VECTOR_ARITH `(x % e + --y % k) + (y % k + w % z % e):real^N = (x + w * z) % e`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_MUL_RNEG] THEN DISJ1_TAC THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_ADD_RINV]; UNDISCH_TAC `~(j IN span{e:real^N})` THEN REWRITE_TAC[SPAN_SING; IN_ELIM_THM; IN_UNIV] THEN ASM_MESON_TAC[VECTOR_ARITH `j + x % e:real^N = y % e ==> j = (y - x) % e`]]; ALL_TAC] THEN SUBGOAL_THEN `~(i IN span {e:real^N})` ASSUME_TAC THENL [REWRITE_TAC[SPAN_SING; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_TAC `c:real`) THEN UNDISCH_TAC `(m:real^N->real^N->real^N) i i = --e` THEN ASM_REWRITE_TAC[VECTOR_ARITH `c % c % e:real^N = --e <=> (c pow 2 + &1) % e = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> ~(x + &1 = &0)`) THEN REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN SUBGOAL_THEN `~(i:real^N = vec 0)` ASSUME_TAC THENL [ASM_MESON_TAC[SPAN_0]; ALL_TAC] THEN SUBGOAL_THEN `span{j:real^N,e} = span{i,e}` SUBST_ALL_TAC THENL [REWRITE_TAC[SPAN_EQ; SUBSET; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IN_SPAN_INSERT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `j:real^N`) o concl)) THEN SUBGOAL_THEN `{x | (m:real^N->real^N->real^N) i x = m x i} = C` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ (!a. a IN s /\ ~(a IN t) ==> F) ==> s = t`) THEN CONJ_TAC THENL [EXPAND_TAC "C" THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; subspace; IN_ELIM_THM] THEN SIMP_TAC[]; X_GEN_TAC `k:real^N` THEN EXPAND_TAC "C" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `{k:real^N,i,e}`) THEN REWRITE_TAC[DIM_INSERT] THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[SPAN_EMPTY; IN_SING; DIM_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ABBREV_TAC `D = {x | --((m:real^N->real^N->real^N) i x) = m x i}` THEN SUBGOAL_THEN `subspace(C:real^N->bool) /\ subspace(D:real^N->bool)` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["C"; "D"] THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `--x:real^N = y <=> x = --y`] THEN SIMP_TAC[] THEN CONV_TAC VECTOR_ARITH; MP_TAC(ASSUME `subspace(D:real^N->bool)`) THEN REWRITE_TAC[subspace] THEN STRIP_TAC] THEN MP_TAC(ISPECL [`C:real^N->bool`; `D:real^N->bool`] DIM_UNION_INTER) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `C INTER D:real^N->bool = {vec 0}` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["C"; "D"] THEN REWRITE_TAC[IN_ELIM_THM; EXTENSION; IN_INTER; IN_SING; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b /\ --a = b <=> a = vec 0 /\ b = vec 0`] THEN ASM_MESON_TAC[]; REWRITE_TAC[DIM_SING; ADD_CLAUSES]] THEN SUBGOAL_THEN `dim(C UNION D:real^N->bool) = dimindex(:N)` SUBST1_TAC THENL [ONCE_REWRITE_TAC[GSYM DIM_SPAN; GSYM DIM_UNIV] THEN AP_TERM_TAC THEN REWRITE_TAC[SPAN_UNION; SET_RULE `s = UNIV <=> !x. x IN s`] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `inv(&2) % (x + --(&1) % m i (m x i)):real^N` THEN EXISTS_TAC `inv(&2) % (x + m i (m x i)):real^N` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN MAP_EVERY EXPAND_TAC ["C"; "D"] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN UNDISCH_THEN `!x y z. (m:real^N->real^N->real^N) (m x y) z = m x (m y z)` (fun th -> REWRITE_TAC[GSYM th]) THEN ASM_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN ASM_CASES_TAC `dim(D:real^N->bool) = 0` THEN ASM_SIMP_TAC[ADD_CLAUSES; IN_INSERT] THEN DISCH_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN REWRITE_TAC[ARITH_RULE `2 + d = 4 <=> d = 2`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DIM_EQ_0]) THEN REWRITE_TAC[SET_RULE `~(s SUBSET {z}) <=> ?a. a IN s /\ ~(a = z)`] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `linear((m:real^N->real^N->real^N) k)` ASSUME_TAC THENL [ASM_REWRITE_TAC[linear]; ALL_TAC] THEN SUBGOAL_THEN `!x y. (m:real^N->real^N->real^N) k x = m k y <=> x = y` ASSUME_TAC THENL [REWRITE_TAC[GSYM INJECTIVE_ALT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN DISCH_TAC THEN SUBGOAL_THEN `k:real^N = vec 0 \/ x + --(&1) % y:real^N = vec 0` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN SUBGOAL_THEN `D = IMAGE ((m:real^N->real^N->real^N) k) C` (fun th -> ASM_SIMP_TAC[th; DIM_INJECTIVE_LINEAR_IMAGE]) THEN SUBGOAL_THEN `IMAGE ((m:real^N->real^N->real^N) k) C SUBSET D /\ IMAGE ((m:real^N->real^N->real^N) k) D SUBSET C` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN UNDISCH_TAC `(k:real^N) IN D` THEN MAP_EVERY EXPAND_TAC ["C"; "D"] THEN REWRITE_TAC[VECTOR_ARITH `--x:real^N = y <=> x = --y`] THEN SIMP_TAC[IN_ELIM_THM] THEN UNDISCH_THEN `!x y z. (m:real^N->real^N->real^N) (m x y) z = m x (m y z)` (fun th -> REWRITE_TAC[GSYM th] THEN ASM_SIMP_TAC[VECTOR_NEG_MINUS1] THEN ASSUME_TAC th) THEN SIMP_TAC[] THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `IMAGE f c SUBSET d /\ IMAGE f d SUBSET c /\ (!x y. f x = f y ==> x = y) /\ IMAGE f (IMAGE f c) = c ==> d = IMAGE f c`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[SPAN_EQ_SELF] `subspace s /\ subspace t /\ span s = span t ==> s = t`) THEN ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN ASM_SIMP_TAC[DIM_INJECTIVE_LINEAR_IMAGE; LE_REFL] THEN ASM SET_TAC[]);; hol-light/Examples/dlo.ml000066400000000000000000000376751303454263000156550ustar00rootroot00000000000000(* ========================================================================= *) (* Dense linear order decision procedure for reals, by Sean McLaughlin. *) (* ========================================================================= *) prioritize_real();; (* ---------------------------------------------------------------------- *) (* Util *) (* ---------------------------------------------------------------------- *) let list_conj = let t_tm = `T` in fun l -> if l = [] then t_tm else end_itlist (curry mk_conj) l;; let mk_lt = mk_binop `(<)`;; (* ---------------------------------------------------------------------- *) (* cnnf *) (* ---------------------------------------------------------------------- *) let DOUBLE_NEG_CONV = let dn_thm = TAUT `!x. ~(~ x) <=> x` in let dn_conv = fun tm -> let tm' = dest_neg (dest_neg tm) in ISPEC tm' dn_thm in dn_conv;; let IMP_CONV = let i_thm = TAUT `!a b. (a ==> b) <=> (~a \/ b)` in let i_conv = fun tm -> let (a,b) = dest_imp tm in ISPECL [a;b] i_thm in i_conv;; let BEQ_CONV = let beq_thm = TAUT `!a b. (a = b) <=> (a /\ b \/ ~a /\ ~b)` in let beq_conv = fun tm -> let (a,b) = dest_eq tm in ISPECL [a;b] beq_thm in beq_conv;; let NEG_AND_CONV = let na_thm = TAUT `!a b. ~(a /\ b) <=> (~a \/ ~b)` in let na_conv = fun tm -> let (a,b) = dest_conj (dest_neg tm) in ISPECL [a;b] na_thm in na_conv;; let NEG_OR_CONV = let no_thm = TAUT `!a b. ~(a \/ b) <=> (~a /\ ~b)` in let no_conv = fun tm -> let (a,b) = dest_disj (dest_neg tm) in ISPECL [a;b] no_thm in no_conv;; let NEG_IMP_CONV = let ni_thm = TAUT `!a b. ~(a ==> b) <=> (a /\ ~b)` in let ni_conv = fun tm -> let (a,b) = dest_imp (dest_neg tm) in ISPECL [a;b] ni_thm in ni_conv;; let NEG_BEQ_CONV = let nbeq_thm = TAUT `!a b. ~(a = b) <=> (a /\ ~b \/ ~a /\ b)` in let nbeq_conv = fun tm -> let (a,b) = dest_eq (dest_neg tm) in ISPECL [a;b] nbeq_thm in nbeq_conv;; (* tm = (p /\ q0) \/ (~p /\ q1) *) let dest_cases tm = try let (l,r) = dest_disj tm in let (p,q0) = dest_conj l in let (np,q1) = dest_conj r in if mk_neg p = np then (p,q0,q1) else failwith "not a cases term" with Failure _ -> failwith "not a cases term";; let is_cases = can dest_cases;; let CASES_CONV = let c_thm = TAUT `!p q0 q1. ~(p /\ q0 \/ ~p /\ q1) <=> (p /\ ~q0 \/ ~p /\ ~q1)` in let cc = fun tm -> let (p,q0,q1) = dest_cases tm in ISPECL [p;q0;q1] c_thm in cc;; let QE_SIMPLIFY_CONV = let NOT_EXISTS_UNIQUE_THM = prove (`~(?!x. P x) <=> (!x. ~P x) \/ ?x x'. P x /\ P x' /\ ~(x = x')`, REWRITE_TAC[EXISTS_UNIQUE_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; CONJ_ASSOC]) in let tauts = [TAUT `~(~p) <=> p`; TAUT `~(p /\ q) <=> ~p \/ ~q`; TAUT `~(p \/ q) <=> ~p /\ ~q`; TAUT `~(p ==> q) <=> p /\ ~q`; TAUT `p ==> q <=> ~p \/ q`; NOT_FORALL_THM; NOT_EXISTS_THM; EXISTS_UNIQUE_THM; NOT_EXISTS_UNIQUE_THM; TAUT `~(p = q) <=> (p /\ ~q) \/ (~p /\ q)`; TAUT `(p = q) <=> (p /\ q) \/ (~p /\ ~q)`; TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;; let CNNF_CONV = let refl_conj = REFL `(/\)` and refl_disj = REFL `(\/)` in fun lfn_conv -> let rec cnnf_conv tm = if is_conj tm then let (p,q) = dest_conj tm in let thm1 = cnnf_conv p in let thm2 = cnnf_conv q in MK_COMB (MK_COMB (refl_conj,thm1),thm2) else if is_disj tm then let (p,q) = dest_disj tm in let thm1 = cnnf_conv p in let thm2 = cnnf_conv q in MK_COMB (MK_COMB (refl_disj,thm1),thm2) else if is_imp tm then let (p,q) = dest_imp tm in let thm1 = cnnf_conv (mk_neg p) in let thm2 = cnnf_conv q in TRANS (IMP_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) else if is_iff tm then let (p,q) = dest_eq tm in let pthm = cnnf_conv p in let qthm = cnnf_conv q in let npthm = cnnf_conv (mk_neg p) in let nqthm = cnnf_conv (mk_neg q) in let thm1 = MK_COMB(MK_COMB(refl_conj,pthm),qthm) in let thm2 = MK_COMB(MK_COMB(refl_conj,npthm),nqthm) in TRANS (BEQ_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) else if is_neg tm then let tm' = dest_neg tm in if is_neg tm' then let tm'' = dest_neg tm' in let thm = cnnf_conv tm in TRANS (DOUBLE_NEG_CONV tm'') thm else if is_conj tm' then let (p,q) = dest_conj tm' in let thm1 = cnnf_conv (mk_neg p) in let thm2 = cnnf_conv (mk_neg q) in TRANS (NEG_AND_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) else if is_cases tm' then let (p,q0,q1) = dest_cases tm in let thm1 = cnnf_conv (mk_conj(p,mk_neg q0)) in let thm2 = cnnf_conv (mk_conj(mk_neg p,mk_neg q1)) in TRANS (CASES_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) else if is_disj tm' then let (p,q) = dest_disj tm' in let thm1 = cnnf_conv (mk_neg p) in let thm2 = cnnf_conv (mk_neg q) in TRANS (NEG_OR_CONV tm) (MK_COMB(MK_COMB(refl_conj,thm1),thm2)) else if is_imp tm' then let (p,q) = dest_imp tm' in let thm1 = cnnf_conv p in let thm2 = cnnf_conv (mk_neg q) in TRANS (NEG_IMP_CONV tm) (MK_COMB(MK_COMB(refl_conj,thm1),thm2)) else if is_iff tm' then let (p,q) = dest_eq tm' in let pthm = cnnf_conv p in let qthm = cnnf_conv q in let npthm = cnnf_conv (mk_neg p) in let nqthm = cnnf_conv (mk_neg q) in let thm1 = MK_COMB (MK_COMB(refl_conj,pthm),nqthm) in let thm2 = MK_COMB(MK_COMB(refl_conj,npthm),qthm) in TRANS (NEG_BEQ_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) else lfn_conv tm else lfn_conv tm in QE_SIMPLIFY_CONV THENC cnnf_conv THENC QE_SIMPLIFY_CONV;; (* let tests = [ `~(a /\ b)`; `~(a \/ b)`; `~(a ==> b)`; `~(a:bool <=> b)`; `~ ~ a`; ];; map (CNNF_CONV (fun x -> REFL x)) tests;; *) (* ---------------------------------------------------------------------- *) (* Real Lists *) (* ---------------------------------------------------------------------- *) let MINL = new_recursive_definition list_RECURSION `(MINL [] default = default) /\ (MINL (CONS h t) default = min h (MINL t default))`;; let MAXL = new_recursive_definition list_RECURSION `(MAXL [] default = default) /\ (MAXL (CONS h t) default = max h (MAXL t default))`;; let MAX_LT = prove (`!x y z. max x y < z <=> x < z /\ y < z`, REWRITE_TAC[real_max] THEN MESON_TAC[REAL_LET_TRANS; REAL_LE_TOTAL]);; let MIN_GT = prove (`!x y z. x < real_min y z <=> x < y /\ x < z`, REWRITE_TAC[real_min] THEN MESON_TAC[REAL_LTE_TRANS; REAL_LE_TOTAL]);; let ALL_LT_LEMMA = prove (`!left x lefts. ALL (\l. l < x) (CONS left lefts) <=> MAXL lefts left < x`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAXL; ALL] THEN SPEC_TAC(`t:real list`,`t:real list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; MAXL; MAX_LT] THEN ASM_MESON_TAC[MAX_LT]);; let ALL_GT_LEMMA = prove (`!right x rights. ALL (\r. x < r) (CONS right rights) <=> x < MINL rights right`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MINL; ALL] THEN SPEC_TAC(`t:real list`,`t:real list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; MINL; MIN_GT] THEN ASM_MESON_TAC[MIN_GT]);; (* ---------------------------------------------------------------------- *) (* Axioms *) (* ---------------------------------------------------------------------- *) let REAL_DENSE = prove (`!x y. x < y ==> ?z. x < z /\ z < y`, REPEAT STRIP_TAC THEN EXISTS_TAC `(x + y) / &2` THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let REAL_LT_EXISTS = prove(`!x. ?y. x < y`, GEN_TAC THEN EXISTS_TAC `x + &1` THEN REAL_ARITH_TAC);; let REAL_GT_EXISTS = prove(`!x. ?y. y < x`, GEN_TAC THEN EXISTS_TAC `x - &1` THEN REAL_ARITH_TAC);; (* ---------------------------------------------------------------------- *) (* lfn_dlo *) (* ---------------------------------------------------------------------- *) let LFN_DLO_CONV = PURE_REWRITE_CONV[ REAL_ARITH `~(s < t) <=> ((s = t) \/ (t < s))`; REAL_ARITH `~(s = t) <=> (s < t \/ t < s)`; ];; (* ------------------------------------------------------------------------- *) (* Proforma theorems to support the main inference step. *) (* ------------------------------------------------------------------------- *) let PROFORMA_LEFT = prove (`!l ls. (?x. ALL (\l. l < x) (CONS l ls)) <=> T`, REWRITE_TAC[ALL_LT_LEMMA] THEN MESON_TAC[REAL_LT_EXISTS]);; let PROFORMA_RIGHT = prove (`!r rs. (?x. ALL (\r. x < r) (CONS r rs)) <=> T`, REWRITE_TAC[ALL_GT_LEMMA] THEN MESON_TAC[REAL_GT_EXISTS]);; let PROFORMA_BOTH = prove (`!l ls r rs. (?x. ALL (\l. l < x) (CONS l ls) /\ ALL (\r. x < r) (CONS r rs)) <=> ALL (\l. ALL (\r. l < r) (CONS r rs)) (CONS l ls)`, REWRITE_TAC[ALL_LT_LEMMA; ALL_GT_LEMMA] THEN MESON_TAC[REAL_DENSE; REAL_LT_TRANS]);; (* ------------------------------------------------------------------------- *) (* Deal with ?x. *) (* ------------------------------------------------------------------------- *) let mk_rlist = let ty = `:real` in fun x -> mk_list(x,ty);; let expand_all = PURE_REWRITE_RULE [ALL; BETA_THM; GSYM CONJ_ASSOC; TAUT `a /\ T <=> a`];; let DLO_EQ_CONV fm = let x,p = dest_exists fm in let xl,xr = partition (fun t -> rand t = x) (conjuncts p) in let lefts = map lhand xl and rights = map rand xr in let th1 = if lefts = [] then SPECL [hd rights; mk_rlist(tl rights)] PROFORMA_RIGHT else if rights = [] then SPECL [hd lefts; mk_rlist(tl lefts)] PROFORMA_LEFT else SPECL [hd lefts; mk_rlist(tl lefts); hd rights; mk_rlist(tl rights)] PROFORMA_BOTH in let th2 = CONV_RULE (LAND_CONV(GEN_ALPHA_CONV x)) (expand_all th1) in let p' = snd(dest_exists(lhand(concl th2))) in let th3 = MK_EXISTS x (CONJ_ACI_RULE(mk_eq(p,p'))) in TRANS th3 th2;; (* ------------------------------------------------------------------------- *) (* Deal with general ?x. *) (* ------------------------------------------------------------------------- *) let eq_triv_conv = let pth_triv = prove (`((?x. x = x) <=> T) /\ ((?x. x = t) <=> T) /\ ((?x. t = x) <=> T) /\ ((?x. (x = t) /\ P x) <=> P t) /\ ((?x. (t = x) /\ P x) <=> P t)`, MESON_TAC[]) in GEN_REWRITE_CONV I [pth_triv] and eq_refl_conv = let pth_refl = prove (`(?x. (x = x) /\ P x) <=> (?x. P x)`, MESON_TAC[]) in GEN_REWRITE_CONV I [pth_refl] and lt_refl_conv = GEN_REWRITE_CONV DEPTH_CONV [REAL_LT_REFL; AND_CLAUSES; EXISTS_SIMP];; let rec DLOBASIC_CONV fm = try let x,p = dest_exists fm in let cjs = conjuncts p in try let eq = find (fun e -> is_eq e && (lhs e = x || rhs e = x)) cjs in let cjs' = eq::setify(subtract cjs [eq]) in let p' = list_mk_conj cjs' in let th1 = MK_EXISTS x (CONJ_ACI_RULE(mk_eq(p,p'))) in let fm' = rand(concl th1) in try TRANS th1 (eq_triv_conv fm') with Failure _ -> TRANS th1 ((eq_refl_conv THENC DLOBASIC_CONV) fm') with Failure _ -> if mem (mk_lt x x) cjs then lt_refl_conv fm else DLO_EQ_CONV fm with Failure _ -> (print_qterm fm; failwith "dlobasic");; (* ------------------------------------------------------------------------- *) (* Overall quantifier elimination. *) (* ------------------------------------------------------------------------- *) let AFN_DLO_CONV vars = PURE_REWRITE_CONV[ REAL_ARITH `s <= t <=> ~(t < s)`; REAL_ARITH `s >= t <=> ~(s < t)`; REAL_ARITH `s > t <=> t < s` ];; let dest_binop_op tm = try let f,r = dest_comb tm in let op,l = dest_comb f in (l,r,op) with Failure _ -> failwith "dest_binop_op";; let forall_thm = prove(`!P. (!x. P x) <=> ~ (?x. ~ P x)`,MESON_TAC[]) and or_exists_conv = PURE_REWRITE_CONV[OR_EXISTS_THM] and triv_exists_conv = REWR_CONV EXISTS_SIMP and push_exists_conv = REWR_CONV RIGHT_EXISTS_AND_THM and not_tm = `(~)` and or_tm = `(\/)` and t_tm = `T` and f_tm = `F`;; let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = let rec qelift_conv vars fm = if fm = t_tm || fm = f_tm then REFL fm else if is_neg fm then let thm1 = qelift_conv vars (dest_neg fm) in MK_COMB(REFL not_tm,thm1) else if is_conj fm || is_disj fm || is_imp fm || is_iff fm then let (p,q,op) = dest_binop_op fm in let thm1 = qelift_conv vars p in let thm2 = qelift_conv vars q in MK_COMB(MK_COMB((REFL op),thm1),thm2) else if is_forall fm then let (x,p) = dest_forall fm in let nex_thm = BETA_RULE (ISPEC (mk_abs(x,p)) forall_thm) in let elim_thm = qelift_conv vars (mk_exists(x,mk_neg p)) in TRANS nex_thm (MK_COMB (REFL not_tm,elim_thm)) else if is_exists fm then let (x,p) = dest_exists fm in let thm1 = qelift_conv (x::vars) p in let thm1a = MK_EXISTS x thm1 in let thm2 = nfn_conv (rhs(concl thm1)) in let thm2a = MK_EXISTS x thm2 in let djs = disjuncts (rhs (concl thm2)) in let djthms = map (qelim x vars) djs in let thm3 = end_itlist (fun thm1 thm2 -> MK_COMB(MK_COMB (REFL or_tm,thm1),thm2)) djthms in let split_ex_thm = GSYM (or_exists_conv (lhs (concl thm3))) in let thm3a = TRANS split_ex_thm thm3 in TRANS (TRANS thm1a thm2a) thm3a else afn_conv vars fm and qelim x vars p = let cjs = conjuncts p in let ycjs,ncjs = partition (mem x o frees) cjs in if ycjs = [] then triv_exists_conv(mk_exists(x,p)) else if ncjs = [] then qfn_conv vars (mk_exists(x,p)) else let th1 = CONJ_ACI_RULE (mk_eq(p,mk_conj(list_mk_conj ncjs,list_mk_conj ycjs))) in let th2 = CONV_RULE (RAND_CONV push_exists_conv) (MK_EXISTS x th1) in let t1,t2 = dest_comb (rand(concl th2)) in TRANS th2 (AP_TERM t1 (qfn_conv vars t2)) in fun fm -> ((qelift_conv (frees fm)) THENC QE_SIMPLIFY_CONV) fm;; let QELIM_DLO_CONV = (LIFT_QELIM_CONV AFN_DLO_CONV ((CNNF_CONV LFN_DLO_CONV) THENC DNF_CONV) (fun v -> DLOBASIC_CONV)) THENC (REWRITE_CONV[]);; (* ---------------------------------------------------------------------- *) (* Test *) (* ---------------------------------------------------------------------- *) let tests = [ `!x y. ?z. z < x /\ z < y`; `?z. x < x /\ z < y`; `?z. x < z /\ z < y`; `!x. x < a ==> x < b`; `!a b. (!x. (x < a) <=> (x < b)) <=> (a = b)`; (* long time *) `!x. ?y. x < y`; `!x y z. x < y /\ y < z ==> x < z`; `!x y. x < y \/ (x = y) \/ y < x`; `!x y. x < y \/ (x = y) \/ y < x`; `?x y. x < y /\ y < x`; `!x y. ?z. z < x /\ x < y`; `!x y. ?z. z < x /\ z < y`; `!x y. x < y ==> ?z. x < z /\ z < y`; `!x y. ~(x = y) ==> ?u. u < x /\ (y < u \/ x < y)`; `?x. x = x:real`; `?x.(x = x) /\ (x = y)`; `?z. x < z /\ z < y`; `?z. x <= z /\ z <= y`; `?z. x < z /\ z <= y`; `!x y z. ?u. u < x /\ u < y /\ u < z`; `!y. x < y /\ y < z ==> w < z`; `!x y . x < y`; `?z. z < x /\ x < y`; `!a b. (!x. x < a ==> x < b) <=> (a <= b)`; `!x. x < a ==> x < b`; `!x. x < a ==> x <= b`; `!a b. ?x. ~(x = a) \/ ~(x = b) \/ (a = b:real)`; `!x y. x <= y \/ x > y`; `!x y. x <= y \/ x < y` ];; map (time QELIM_DLO_CONV) tests;; hol-light/Examples/forster.ml000066400000000000000000000106071303454263000165450ustar00rootroot00000000000000prioritize_num();; let FORSTER_PUZZLE = prove (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN SUBGOAL_THEN `!n m. f(m) < n ==> m <= f m` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[LT] THEN INDUCT_TAC THEN ASM_MESON_TAC[LE_0; LE_SUC_LT; LET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!n. n <= f n` ASSUME_TAC THENL [ASM_MESON_TAC[LT]; ALL_TAC] THEN SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m < n ==> f(m) < f(n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LT; LT_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!m n. (f m < f n) <=> m < n` ASSUME_TAC THENL [ASM_MESON_TAC[LT_CASES; LT_ANTISYM; LT_REFL]; ALL_TAC] THEN ASM_MESON_TAC[LE_ANTISYM; LT_SUC_LE]);; (* ------------------------------------------------------------------------- *) (* Alternative; shorter but less transparent and taking longer to run. *) (* ------------------------------------------------------------------------- *) let FORSTER_PUZZLE = prove (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN SUBGOAL_THEN `!n m. f(m) < n ==> m <= f m` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[LT] THEN INDUCT_TAC THEN ASM_MESON_TAC[LE_0; LE_SUC_LT; LET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!n. n <= f n` ASSUME_TAC THENL [ASM_MESON_TAC[LT]; ALL_TAC] THEN SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m < n ==> f(m) < f(n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LT; LT_TRANS]; ALL_TAC] THEN ASM_MESON_TAC[LE_ANTISYM; LT_CASES; LT_ANTISYM; LT_REFL; LT_SUC_LE]);; (* ------------------------------------------------------------------------- *) (* Robin Milner's proof. *) (* ------------------------------------------------------------------------- *) let FORSTER_PUZZLE = prove (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN SUBGOAL_THEN `!m n. m <= f(n + m)` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[LE_0; ADD_CLAUSES; LE_SUC_LT] THEN ASM_MESON_TAC[LET_TRANS; SUB_ADD]; ALL_TAC] THEN SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL [ASM_MESON_TAC[LET_TRANS; LE_TRANS; ADD_CLAUSES]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m <= n ==> f(m) <= f(n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LE; LE_REFL; LT_IMP_LE; LE_TRANS]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM LE_ANTISYM] THEN ASM_MESON_TAC[LT_SUC_LE; NOT_LT; ADD_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* A variant of Robin's proof avoiding explicit use of addition. *) (* ------------------------------------------------------------------------- *) let FORSTER_PUZZLE = prove (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN SUBGOAL_THEN `!m n. m <= n ==> m <= f(n)` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN INDUCT_TAC THEN REWRITE_TAC[LE; NOT_SUC] THEN ASM_MESON_TAC[LE_SUC_LT; LET_TRANS; LE_REFL; LT_IMP_LE; LE_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL [ASM_MESON_TAC[NOT_LE]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m <= n ==> f(m) <= f(n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LE; LE_REFL; LT_IMP_LE; LE_TRANS]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM LE_ANTISYM] THEN ASM_MESON_TAC[LT_SUC_LE; NOT_LT; ADD_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* The shortest? *) (* ------------------------------------------------------------------------- *) let FORSTER_PUZZLE = prove (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN SUBGOAL_THEN `!m n. m <= f(n + m)` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[LE_0; ADD_CLAUSES; LE_SUC_LT] THEN ASM_MESON_TAC[LET_TRANS; SUB_ADD]; ALL_TAC] THEN SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL [ASM_MESON_TAC[LET_TRANS; LE_TRANS; ADD_CLAUSES]; ALL_TAC] THEN SUBGOAL_THEN `!m n. f(m) < f(n) ==> m < n` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_MESON_TAC[LT_LE; LE_0; LTE_TRANS; LE_SUC_LT]; ALL_TAC] THEN ASM_MESON_TAC[LE_ANTISYM; ADD_CLAUSES; LT_SUC_LE]);; hol-light/Examples/gcdrecurrence.ml000066400000000000000000000250121303454263000176700ustar00rootroot00000000000000(* ========================================================================= *) (* Some divisibility properties of certain linear integer recurrences. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/integer.ml";; prioritize_int();; (* ------------------------------------------------------------------------- *) (* A customized induction principle. *) (* ------------------------------------------------------------------------- *) let INDUCT_SPECIAL = prove (`!P. (!n. P 0 n) /\ (!m n. P m n <=> P n m) /\ (!m n. P m n ==> P n (m + n)) ==> !m n. P m n`, GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN WF_INDUCT_TAC `m + n:num` THEN ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISJ_CASES_THEN MP_TAC (ARITH_RULE `m <= n:num \/ n <= m`) THEN REWRITE_TAC[LE_EXISTS] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THENL [ALL_TAC; ASM (GEN_REWRITE_TAC I) []] THEN MATCH_MP_TAC(ASSUME `!m n:num. P m n ==> P n (m + n)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The main results; to literally apply integer gcd we need nonnegativity. *) (* ------------------------------------------------------------------------- *) let INT_DIVISORS_RECURRENCE = prove (`!G a b. G(0) = &0 /\ G(1) = &1 /\ coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) ==> !d m n. d divides (G m) /\ d divides (G n) <=> d divides G(gcd(m,n))`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!n. coprime(G(n + 1),b)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[ARITH; ARITH_RULE `SUC n + 1 = n + 2`] THEN REPEAT(POP_ASSUM MP_TAC) THEN NUMBER_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. coprime(G(n + 1),G n)` ASSUME_TAC THENL [INDUCT_TAC THENL [ASM_REWRITE_TAC[ARITH] THEN NUMBER_TAC; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o SPEC `n:num`)) THEN ASM_REWRITE_TAC[ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC; ALL_TAC] THEN SUBGOAL_THEN `!m p. G(m + 1 + p) = G(m + 1) * G(p + 1) + b * G(m) * G(p)` ASSUME_TAC THENL [INDUCT_TAC THENL [ASM_REWRITE_TAC[ADD_CLAUSES; ADD_AC] THEN INTEGER_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC m + 1 + p = (m + p) + 2`] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC m + 1 = m + 2`] THEN ASM_REWRITE_TAC[ARITH_RULE `(m + p) + 1 = m + 1 + p`] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ARITH; ADD_CLAUSES] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(m + p) = m + 1 + p`] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(m + 1) = m + 2`; ARITH] THEN REWRITE_TAC[ADD1] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!m p:num. gcd(G(m + p),G m) = gcd(G m,G p)` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EQT_INTRO(SPEC_ALL INT_GCD_SYM)] THEN ASM_REWRITE_TAC[ADD1; ARITH_RULE `(m + p) + 1 = m + 1 + p`] THEN GEN_TAC THEN SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS] THEN MP_TAC(SPEC `m:num` (ASSUME `!n. coprime(G(n + 1),b)`)) THEN MP_TAC(SPEC `m:num` (ASSUME `!n. coprime(G(n + 1),G n)`)) THEN INTEGER_TAC; ALL_TAC] THEN GEN_TAC THEN MATCH_MP_TAC INDUCT_SPECIAL THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[GCD_0; INT_DIVIDES_0]; MESON_TAC[GCD_SYM]; ALL_TAC] THEN ASM_MESON_TAC[GCD_ADD; INT_DIVIDES_GCD; INT_GCD_SYM; ADD_SYM; GCD_SYM]);; let INT_GCD_RECURRENCE = prove (`!G a b. G(0) = &0 /\ G(1) = &1 /\ coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) /\ (!n. &0 <= G n) ==> !m n. gcd(G m,G n) = G(gcd(m,n))`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM INT_DIVIDES_ANTISYM_POS; INT_GCD_POS] THEN REWRITE_TAC[INT_DIVIDES_ANTISYM_DIVISORS; INT_DIVIDES_GCD] THEN ASM_MESON_TAC[INT_DIVISORS_RECURRENCE]);; (* ------------------------------------------------------------------------- *) (* Natural number variants of the same results. *) (* ------------------------------------------------------------------------- *) let GCD_RECURRENCE = prove (`!G a b. G(0) = 0 /\ G(1) = 1 /\ coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) ==> !m n. gcd(G m,G n) = G(gcd(m,n))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`& o (G:num->num)`; `&a:int`; `&b:int`] INT_GCD_RECURRENCE) THEN ASM_REWRITE_TAC[o_THM; GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN ASM_SIMP_TAC[GSYM num_coprime; INT_POS; GSYM NUM_GCD; INT_OF_NUM_EQ]);; let DIVISORS_RECURRENCE = prove (`!G a b. G(0) = 0 /\ G(1) = 1 /\ coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) ==> !d m n. d divides (G m) /\ d divides (G n) <=> d divides G(gcd(m,n))`, REWRITE_TAC[GSYM DIVIDES_GCD] THEN MESON_TAC[DIVISORS_EQ; GCD_RECURRENCE]);; (* ------------------------------------------------------------------------- *) (* Application 1: Mersenne numbers. *) (* ------------------------------------------------------------------------- *) let GCD_MERSENNE = prove (`!m n. gcd(2 EXP m - 1,2 EXP n - 1) = 2 EXP (gcd(m,n)) - 1`, SIMP_TAC[GSYM INT_OF_NUM_EQ; NUM_GCD; GSYM INT_OF_NUM_SUB; GSYM INT_OF_NUM_POW; EXP_LT_0; ARITH; ARITH_RULE `1 <= n <=> 0 < n`] THEN MATCH_MP_TAC INT_GCD_RECURRENCE THEN MAP_EVERY EXISTS_TAC [`&3`; `-- &2`] THEN REWRITE_TAC[INT_POW_ADD; INT_LE_SUB_LADD] THEN CONV_TAC INT_REDUCE_CONV THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM(INT_REDUCE_CONV `&2 * &2 - &1`)] THEN SPEC_TAC(`&2`,`t:int`) THEN INTEGER_TAC; INT_ARITH_TAC; GEN_TAC THEN MATCH_MP_TAC INT_POW_LE_1 THEN INT_ARITH_TAC]);; let DIVIDES_MERSENNE = prove (`!m n. (2 EXP m - 1) divides (2 EXP n - 1) <=> m divides n`, REPEAT GEN_TAC THEN REWRITE_TAC[DIVIDES_GCD_LEFT; GCD_MERSENNE] THEN SIMP_TAC[EXP_EQ_0; EQ_EXP; ARITH_EQ; ARITH_RULE `~(x = 0) /\ ~(y = 0) ==> (x - 1 = y - 1 <=> x = y)`]);; (* ------------------------------------------------------------------------- *) (* Application 2: the Fibonacci series. *) (* ------------------------------------------------------------------------- *) let fib = define `fib 0 = 0 /\ fib 1 = 1 /\ !n. fib(n + 2) = fib(n + 1) + fib(n)`;; let GCD_FIB = prove (`!m n. gcd(fib m,fib n) = fib(gcd(m,n))`, MATCH_MP_TAC GCD_RECURRENCE THEN REPEAT(EXISTS_TAC `1`) THEN REWRITE_TAC[fib; COPRIME_1] THEN ARITH_TAC);; let FIB_EQ_0 = prove (`!n. fib n = 0 <=> n = 0`, MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib; ARITH_RULE `SUC(SUC n) = n + 2`; ADD_EQ_0] THEN SIMP_TAC[ADD1; ADD_EQ_0; ARITH_EQ] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[fib; ARITH_EQ]);; let FIB_INCREASES_LE = prove (`!m n. m <= n ==> fib m <= fib n`, MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[LE_REFL; LE_TRANS] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib; ARITH] THEN REWRITE_TAC[ADD1; fib; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN ARITH_TAC);; let FIB_INCREASES_LT = prove (`!m n. 2 <= m /\ m < n ==> fib m < fib n`, INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN REPEAT STRIP_TAC THEN TRANS_TAC LTE_TRANS `fib(m + 2)` THEN ASM_SIMP_TAC[FIB_INCREASES_LE; ARITH_RULE `m + 2 <= n <=> SUC m < n`] THEN REWRITE_TAC[fib; ADD1; ARITH_RULE `m < m + n <=> ~(n = 0)`; FIB_EQ_0] THEN ASM_ARITH_TAC);; let FIB_EQ_1 = prove (`!n. fib n = 1 <=> n = 1 \/ n = 2`, MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib; ARITH] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib; ARITH] THEN REWRITE_TAC[fib; ARITH_RULE `SUC(SUC n) = n + 2`] THEN REWRITE_TAC[FIB_EQ_0; ADD_EQ_0; ARITH; ARITH_RULE `m + n = 1 <=> m = 0 /\ n = 1 \/ m = 1 /\ n = 0`] THEN ARITH_TAC);; let DIVIDES_FIB = prove (`!m n. (fib m) divides (fib n) <=> m divides n \/ n = 0 \/ m = 2`, REPEAT GEN_TAC THEN REWRITE_TAC[DIVIDES_GCD_LEFT; GCD_FIB] THEN MP_TAC(SPECL [`gcd(m:num,n)`; `m:num`] DIVIDES_LE) THEN REWRITE_TAC[GCD] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[GCD_0; fib; FIB_EQ_0; ARITH] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[GCD_0] THEN ASM_CASES_TAC `gcd(m:num,n) = m` THEN ASM_REWRITE_TAC[LE_LT] THEN ASM_CASES_TAC `gcd(m:num,n) = 0` THENL [ASM_MESON_TAC[GCD_ZERO]; ALL_TAC] THEN ASM_CASES_TAC `m:num = n` THEN ASM_REWRITE_TAC[GCD_REFL; LT_REFL] THEN ASM_CASES_TAC `2 <= gcd(m,n)` THENL [MP_TAC(SPECL [`gcd(m:num,n)`; `m:num`] FIB_INCREASES_LT) THEN ASM_ARITH_TAC; ASM_CASES_TAC `gcd(m,n) = 1` THENL [ASM_REWRITE_TAC[]; ASM_ARITH_TAC] THEN DISCH_TAC THEN CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[FIB_EQ_1; fib] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Application 3: solutions of the Pell equation x^2 = (a^2 - 1) y^2 + 1. *) (* All solutions are of the form (pellx a n,pelly a n); see Examples/pell.ml *) (* ------------------------------------------------------------------------- *) let pellx = define `(!a. pellx a 0 = 1) /\ (!a. pellx a 1 = a) /\ (!a n. pellx a (n + 2) = 2 * a * pellx a (n + 1) - pellx a n)`;; let pelly = define `(!a. pelly a 0 = 0) /\ (!a. pelly a 1 = 1) /\ (!a n. pelly a (n + 2) = 2 * a * pelly a (n + 1) - pelly a (n))`;; let PELLY_INCREASES = prove (`!a n. ~(a = 0) ==> pelly a n <= pelly a (n + 1)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[pelly; ARITH; LE_1; ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN TRANS_TAC LE_TRANS `2 * pelly a (n + 1) - pelly a n` THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `a:num <= b ==> a - c <= b - c`) THEN REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN ASM_ARITH_TAC);; let GCD_PELLY = prove (`!a m n. ~(a = 0) ==> gcd(pelly a m,pelly a n) = pelly a (gcd(m,n))`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_EQ; NUM_GCD] THEN MATCH_MP_TAC INT_GCD_RECURRENCE THEN MAP_EVERY EXISTS_TAC [`&2 * &a:int`; `-- &1:int`] THEN REWRITE_TAC[pelly; INT_POS; INT_COPRIME_NEG; INT_COPRIME_1] THEN GEN_TAC THEN REWRITE_TAC[INT_OF_NUM_MUL; MULT_ASSOC] THEN REWRITE_TAC[INT_ARITH `a + -- &1 * b:int = a - b`] THEN MATCH_MP_TAC(GSYM INT_OF_NUM_SUB) THEN TRANS_TAC LE_TRANS `1 * pelly a (n + 1)` THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_SIMP_TAC[MULT_CLAUSES; PELLY_INCREASES] THEN ASM_ARITH_TAC);; hol-light/Examples/harmonicsum.ml000066400000000000000000000142571303454263000174130ustar00rootroot00000000000000(* ========================================================================= *) (* Nice little result that harmonic sum never gives an integer. *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/products.ml";; needs "Library/floor.ml";; (* ------------------------------------------------------------------------- *) (* In any contiguous range, index (order) of 2 has a strict maximum. *) (* ------------------------------------------------------------------------- *) let NUMSEG_MAXIMAL_INDEX_2 = prove (`!m n. 1 <= m /\ m <= n ==> ?k. k IN m..n /\ !l. l IN m..n /\ ~(l = k) ==> index 2 l < index 2 k`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\x. x IN IMAGE (index 2) (m..n)` num_MAX) THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_REWRITE_TAC[MEMBER_NOT_EMPTY; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [MESON_TAC[INDEX_TRIVIAL_BOUND; LE_TRANS]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LT_LE] THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN MP_TAC(SPECL [`l:num`; `2`] INDEX_DECOMPOSITION_PRIME) THEN MP_TAC(SPECL [`k:num`; `2`] INDEX_DECOMPOSITION_PRIME) THEN REWRITE_TAC[PRIME_2; LEFT_IMP_EXISTS_THM; COPRIME_2] THEN ASM_CASES_TAC `k = 0` THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN ASM_CASES_TAC `l = 0` THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN X_GEN_TAC `q:num` THEN STRIP_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(ARITH_RULE `~(l:num = k) ==> l < k \/ k < l`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN MAP_EVERY EXPAND_TAC ["k"; "l"] THEN REWRITE_TAC[LT_MULT_LCANCEL; EXP_EQ_0; ARITH_EQ] THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `2 EXP index 2 k * (q + 1)`); FIRST_X_ASSUM(MP_TAC o SPEC `2 EXP index 2 k * (p + 1)`)] THEN ASM_SIMP_TAC[INDEX_MUL; PRIME_2; EXP_EQ_0; ADD_EQ_0; ARITH; NOT_IMP; INDEX_EXP; INDEX_REFL] THEN REWRITE_TAC[ARITH_RULE `n * 1 + k <= n <=> k = 0`; INDEX_EQ_0] THEN ASM_REWRITE_TAC[ADD_EQ_0; ARITH; DIVIDES_2; EVEN_ADD; NOT_EVEN] THEN MATCH_MP_TAC(ARITH_RULE `!p. m <= e * q /\ e * (q + 1) <= e * p /\ e * p <= n ==> m <= e * (q + 1) /\ e * (q + 1) <= n`) THENL [EXISTS_TAC `p:num`; EXISTS_TAC `q:num`] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence the result. *) (* ------------------------------------------------------------------------- *) let NONINTEGER_HARMONIC = prove (`!m n. 1 <= m /\ 1 < n /\ m <= n ==> ~(integer (sum(m..n) (\k. inv(&k))))`, let lemma = prove (`!m n. 1 <= m ==> sum(m..n) (\k. inv(&k)) = (sum(m..n) (\k. product ((m..n) DELETE k) (\i. &i))) / product(m..n) (\i. &i)`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_FIELD `~(x = &0) /\ ~(z = &0) /\ x * y = z ==> inv x = y * inv z`) THEN ASM_SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; REAL_OF_NUM_EQ] THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN MP_TAC(ISPECL [`\i. &i`; `m..n`; `k:num`] PRODUCT_DELETE) THEN ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG]) in REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `n:num = m` THENL [ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN REWRITE_TAC[REAL_ARITH `inv x = &1 / x`; INTEGER_DIV; DIVIDES_ONE] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[lemma] THEN SIMP_TAC[GSYM REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG; GSYM REAL_OF_NUM_SUM; FINITE_DELETE; INTEGER_DIV] THEN SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPECL [`m:num`; `n:num`] NUMSEG_MAXIMAL_INDEX_2) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\i. nproduct((m..n) DELETE i) (\j. j)`; `m..n`; `k:num`] NSUM_DELETE) THEN ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ABBREV_TAC `i = index 2 (nproduct ((m..n) DELETE k) (\j. j))` THEN MATCH_MP_TAC(EQT_ELIM( (REWRITE_CONV[IMP_CONJ; CONTRAPOS_THM] THENC (EQT_INTRO o NUMBER_RULE)) `!p. p divides r /\ p divides n /\ ~(p divides m) ==> ~(r divides (m + n))`)) THEN EXISTS_TAC `2 EXP (i + 1)` THEN REPEAT CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC DIVIDES_NSUM THEN REWRITE_TAC[FINITE_NUMSEG; FINITE_DELETE; IN_NUMSEG; IN_DELETE] THEN X_GEN_TAC `l:num` THEN STRIP_TAC; ALL_TAC] THEN REWRITE_TAC[PRIMEPOW_DIVIDES_INDEX] THEN SIMP_TAC[ARITH; DE_MORGAN_THM; NPRODUCT_EQ_0; FINITE_NUMSEG; FINITE_DELETE; IN_NUMSEG; IN_DELETE] THENL [DISJ2_TAC THEN MP_TAC(ISPECL [`\i:num. i`; `m..n`; `k:num`] NPRODUCT_DELETE) THEN ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o AP_TERM `index 2`) THEN IMP_REWRITE_TAC[INDEX_MUL] THEN SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; FINITE_DELETE; PRIME_2] THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `m:num` th) THEN MP_TAC(SPEC `n:num` th)) THEN ASM_ARITH_TAC; DISJ2_TAC THEN MP_TAC(ISPECL [`\i:num. i`; `m..n`; `l:num`] NPRODUCT_DELETE) THEN MP_TAC(ISPECL [`\i:num. i`; `m..n`; `k:num`] NPRODUCT_DELETE) THEN ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o AP_TERM `index 2`)) THEN IMP_REWRITE_TAC[INDEX_MUL] THEN SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; FINITE_DELETE; PRIME_2] THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `l:num`) THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; hol-light/Examples/hol88.ml000066400000000000000000001150411303454263000160210ustar00rootroot00000000000000(* ========================================================================= *) (* HOL88 compatibility: various things missing or different in HOL Light. *) (* ========================================================================= *) let (upto) = (--);; let is_neg_imp tm = is_neg tm || is_imp tm;; let dest_neg_imp tm = try dest_imp tm with Failure _ -> try (dest_neg tm,mk_const("F",[])) with Failure _ -> failwith "dest_neg_imp";; (* ------------------------------------------------------------------------- *) (* I removed this recently. Note that it's intuitionistically valid. *) (* ------------------------------------------------------------------------- *) let CONTRAPOS = let a = `a:bool` and b = `b:bool` in let pth = ITAUT `(a ==> b) ==> (~b ==> ~a)` in fun th -> try let P,Q = dest_imp(concl th) in MP (INST [P,a; Q,b] pth) th with Failure _ -> failwith "CONTRAPOS";; (* ------------------------------------------------------------------------- *) (* I also got rid of this; it's mainly used inside DISCH_TAC anyway. *) (* ------------------------------------------------------------------------- *) let NEG_DISCH = let falsity = `F` in fun t th -> try if concl th = falsity then NOT_INTRO(DISCH t th) else DISCH t th with Failure _ -> failwith "NEG_DISCH";; (* ------------------------------------------------------------------------- *) (* These were never used (by me). *) (* ------------------------------------------------------------------------- *) let SELECT_ELIM th1 (v,th2) = try let P, SP = dest_comb(concl th1) in let th3 = DISCH (mk_comb(P,v)) th2 in MP (INST [SP,v] th3) th1 with Failure _ -> failwith "SELECT_ELIM";; let SELECT_INTRO = let P = `P:A->bool` and x = `x:A` in let pth = SPECL [P; x] SELECT_AX in fun th -> try let f,arg = dest_comb(concl th) in MP (PINST [type_of x,aty] [f,P; arg,x] pth) th with Failure _ -> failwith "SELECT_INTRO";; (* ------------------------------------------------------------------------- *) (* Again, I never use this so I removed it from the core. *) (* ------------------------------------------------------------------------- *) let EXT = let f = `f:A->B` and g = `g:A->B` in let pth = prove (`(!x. (f:A->B) x = g x) ==> (f = g)`, MATCH_ACCEPT_TAC EQ_EXT) in fun th -> try let x,bod = dest_forall(concl th) in let l,r = dest_eq bod in let l',r' = rator l, rator r in let th1 = PINST [type_of x,aty; type_of l,bty] [l',f; r',g] pth in MP th1 th with Failure _ -> failwith "EXT";; (* ------------------------------------------------------------------------- *) (* These get overwritten by the subgoal stuff. *) (* ------------------------------------------------------------------------- *) let PROVE = prove;; let prove_thm((s:string),g,t) = prove(g,t);; (* ------------------------------------------------------------------------- *) (* The quantifier movement conversions. *) (* ------------------------------------------------------------------------- *) let (CONV_OF_RCONV: conv -> conv) = let rec get_bv tm = if is_abs tm then bndvar tm else if is_comb tm then try get_bv (rand tm) with Failure _ -> get_bv (rator tm) else failwith "" in fun conv tm -> let v = get_bv tm in let th1 = conv tm in let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in TRANS th1 th2;; let (CONV_OF_THM: thm -> conv) = CONV_OF_RCONV o REWR_CONV;; let (X_FUN_EQ_CONV:term->conv) = fun v -> (REWR_CONV FUN_EQ_THM) THENC GEN_ALPHA_CONV v;; let (FUN_EQ_CONV:conv) = fun tm -> let vars = frees tm in let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in if op = "fun" then let varnm = if (is_vartype ty1) then "x" else hd(explode(fst(dest_type ty1))) in let x = variant vars (mk_var(varnm,ty1)) in X_FUN_EQ_CONV x tm else failwith "FUN_EQ_CONV";; let (SINGLE_DEPTH_CONV:conv->conv) = let rec SINGLE_DEPTH_CONV conv tm = try conv tm with Failure _ -> (SUB_CONV (SINGLE_DEPTH_CONV conv) THENC (TRY_CONV conv)) tm in SINGLE_DEPTH_CONV;; let (SKOLEM_CONV:conv) = SINGLE_DEPTH_CONV (REWR_CONV SKOLEM_THM);; let (X_SKOLEM_CONV:term->conv) = fun v -> SKOLEM_CONV THENC GEN_ALPHA_CONV v;; let EXISTS_UNIQUE_CONV tm = let v = bndvar(rand tm) in let th1 = REWR_CONV EXISTS_UNIQUE_THM tm in let tm1 = rhs(concl th1) in let vars = frees tm1 in let v = variant vars v in let v' = variant (v::vars) v in let th2 = (LAND_CONV(GEN_ALPHA_CONV v) THENC RAND_CONV(BINDER_CONV(GEN_ALPHA_CONV v') THENC GEN_ALPHA_CONV v)) tm1 in TRANS th1 th2;; let NOT_FORALL_CONV = CONV_OF_THM NOT_FORALL_THM;; let NOT_EXISTS_CONV = CONV_OF_THM NOT_EXISTS_THM;; let RIGHT_IMP_EXISTS_CONV = CONV_OF_THM RIGHT_IMP_EXISTS_THM;; let FORALL_IMP_CONV = CONV_OF_RCONV (REWR_CONV TRIV_FORALL_IMP_THM ORELSEC REWR_CONV RIGHT_FORALL_IMP_THM ORELSEC REWR_CONV LEFT_FORALL_IMP_THM);; let EXISTS_AND_CONV = CONV_OF_RCONV (REWR_CONV TRIV_EXISTS_AND_THM ORELSEC REWR_CONV LEFT_EXISTS_AND_THM ORELSEC REWR_CONV RIGHT_EXISTS_AND_THM);; let LEFT_IMP_EXISTS_CONV = CONV_OF_THM LEFT_IMP_EXISTS_THM;; let LEFT_AND_EXISTS_CONV tm = let v = bndvar(rand(rand(rator tm))) in (REWR_CONV LEFT_AND_EXISTS_THM THENC TRY_CONV (GEN_ALPHA_CONV v)) tm;; let RIGHT_AND_EXISTS_CONV = CONV_OF_THM RIGHT_AND_EXISTS_THM;; let AND_FORALL_CONV = CONV_OF_THM AND_FORALL_THM;; (* ------------------------------------------------------------------------- *) (* Paired beta conversion (now just a special case of GEN_BETA_CONV). *) (* ------------------------------------------------------------------------- *) let PAIRED_BETA_CONV = let pth = (EQT_ELIM o REWRITE_CONV [EXISTS_THM; GABS_DEF]) `!P:A->bool. (?) P ==> P((GABS) P)` and pth1 = GSYM PASSOC_DEF and pth2 = GSYM UNCURRY_DEF in let dest_geq = dest_binary "GEQ" in let GEQ_RULE = CONV_RULE(REWR_CONV(GSYM GEQ_DEF)) and UNGEQ_RULE = CONV_RULE(REWR_CONV GEQ_DEF) in let rec UNCURRY_CONV fn vs = try let l,r = dest_pair vs in try let r1,r2 = dest_pair r in let lr = mk_pair(l,r1) in let th0 = UNCURRY_CONV fn (mk_pair(lr,r2)) in let th1 = ISPECL [rator(rand(concl th0));l;r1;r2] pth1 in TRANS th0 th1 with Failure _ -> let th0 = UNCURRY_CONV fn l in let fn' = rand(concl th0) in let th1 = UNCURRY_CONV fn' r in let th2 = ISPECL [rator fn';l;r] pth2 in TRANS (TRANS (AP_THM th0 r) th1) th2 with Failure _ -> REFL(mk_comb(fn,vs)) in fun tm -> try BETA_CONV tm with Failure _ -> let gabs,args = dest_comb tm in let fn,bod = dest_binder "GABS" gabs in let avs,eqv = strip_forall bod in let l,r = dest_geq eqv in let pred = list_mk_abs(avs,r) in let th0 = rev_itlist (fun v th -> CONV_RULE(RAND_CONV BETA_CONV) (AP_THM th v)) avs (REFL pred) in let th1 = TRANS (SYM(UNCURRY_CONV pred (rand l))) th0 in let th1a = GEQ_RULE th1 in let etm = list_mk_icomb "?" [rand gabs] in let th2 = EXISTS(etm,rator (lhand(concl th1a))) (GENL avs th1a) in let th3 = SPECL (striplist dest_pair args) (BETA_RULE(MATCH_MP pth th2)) in UNGEQ_RULE th3;; (* ------------------------------------------------------------------------- *) (* The slew of named tautologies. *) (* ------------------------------------------------------------------------- *) let AND1_THM = TAUT `!t1 t2. t1 /\ t2 ==> t1`;; let AND2_THM = TAUT `!t1 t2. t1 /\ t2 ==> t2`;; let AND_IMP_INTRO = TAUT `!t1 t2 t3. t1 ==> t2 ==> t3 <=> t1 /\ t2 ==> t3`;; let AND_INTRO_THM = TAUT `!t1 t2. t1 ==> t2 ==> t1 /\ t2`;; let BOOL_EQ_DISTINCT = TAUT `~(T <=> F) /\ ~(F <=> T)`;; let EQ_EXPAND = TAUT `!t1 t2. (t1 <=> t2) <=> t1 /\ t2 \/ ~t1 /\ ~t2`;; let EQ_IMP_THM = TAUT `!t1 t2. (t1 <=> t2) <=> (t1 ==> t2) /\ (t2 ==> t1)`;; let FALSITY = TAUT `!t. F ==> t`;; let F_IMP = TAUT `!t. ~t ==> t ==> F`;; let IMP_DISJ_THM = TAUT `!t1 t2. t1 ==> t2 <=> ~t1 \/ t2`;; let IMP_F = TAUT `!t. (t ==> F) ==> ~t`;; let IMP_F_EQ_F = TAUT `!t. t ==> F <=> (t <=> F)`;; let LEFT_AND_OVER_OR = TAUT `!t1 t2 t3. t1 /\ (t2 \/ t3) <=> t1 /\ t2 \/ t1 /\ t3`;; let LEFT_OR_OVER_AND = TAUT `!t1 t2 t3. t1 \/ t2 /\ t3 <=> (t1 \/ t2) /\ (t1 \/ t3)`;; let NOT_AND = TAUT `~(t /\ ~t)`;; let NOT_F = TAUT `!t. ~t ==> (t <=> F)`;; let OR_ELIM_THM = TAUT `!t t1 t2. t1 \/ t2 ==> (t1 ==> t) ==> (t2 ==> t) ==> t`;; let OR_IMP_THM = TAUT `!t1 t2. (t1 <=> t2 \/ t1) <=> t2 ==> t1`;; let OR_INTRO_THM1 = TAUT `!t1 t2. t1 ==> t1 \/ t2`;; let OR_INTRO_THM2 = TAUT `!t1 t2. t2 ==> t1 \/ t2`;; let RIGHT_AND_OVER_OR = TAUT `!t1 t2 t3. (t2 \/ t3) /\ t1 <=> t2 /\ t1 \/ t3 /\ t1`;; let RIGHT_OR_OVER_AND = TAUT `!t1 t2 t3. t2 /\ t3 \/ t1 <=> (t2 \/ t1) /\ (t3 \/ t1)`;; (* ------------------------------------------------------------------------- *) (* This is an overwrite -- is there any point in what I have? *) (* ------------------------------------------------------------------------- *) let is_type = can get_type_arity;; (* ------------------------------------------------------------------------- *) (* I suppose this is also useful. *) (* ------------------------------------------------------------------------- *) let is_constant = can get_const_type;; (* ------------------------------------------------------------------------- *) (* Misc. *) (* ------------------------------------------------------------------------- *) let null l = l = [];; let combine(a,b) = zip a b;; let split = unzip;; (* ------------------------------------------------------------------------- *) (* Syntax. *) (* ------------------------------------------------------------------------- *) let type_tyvars = type_vars_in_term o curry mk_var "x";; let find_match u = let rec find_mt t = try term_match [] u t with Failure _ -> try find_mt(rator t) with Failure _ -> try find_mt(rand t) with Failure _ -> try find_mt(snd(dest_abs t)) with Failure _ -> failwith "find_match" in fun t -> let _,tmin,tyin = find_mt t in tmin,tyin;; let rec mk_primed_var(name,ty) = if can get_const_type name then mk_primed_var(name^"'",ty) else mk_var(name,ty);; let subst_occs = let rec subst_occs slist tm = let applic,noway = partition (fun (i,(t,x)) -> aconv tm x) slist in let sposs = map (fun (l,z) -> let l1,l2 = partition ((=) 1) l in (l1,z),(l2,z)) applic in let racts,rrest = unzip sposs in let acts = filter (fun t -> not (fst t = [])) racts in let trest = map (fun (n,t) -> (map (C (-) 1) n,t)) rrest in let urest = filter (fun t -> not (fst t = [])) trest in let tlist = urest @ noway in if acts = [] then if is_comb tm then let l,r = dest_comb tm in let l',s' = subst_occs tlist l in let r',s'' = subst_occs s' r in mk_comb(l',r'),s'' else if is_abs tm then let bv,bod = dest_abs tm in let gv = genvar(type_of bv) in let nbod = vsubst[gv,bv] bod in let tm',s' = subst_occs tlist nbod in alpha bv (mk_abs(gv,tm')),s' else tm,tlist else let tm' = (fun (n,(t,x)) -> subst[t,x] tm) (hd acts) in tm',tlist in fun ilist slist tm -> fst(subst_occs (zip ilist slist) tm);; (* ------------------------------------------------------------------------- *) (* Note that the all-instantiating INST and INST_TYPE are not overwritten. *) (* ------------------------------------------------------------------------- *) let INST_TY_TERM(substl,insttyl) th = let th' = INST substl (INST_TYPE insttyl th) in if hyp th' = hyp th then th' else failwith "INST_TY_TERM: Free term and/or type variables in hypotheses";; (* ------------------------------------------------------------------------- *) (* Conversions stuff. *) (* ------------------------------------------------------------------------- *) let RIGHT_CONV_RULE (conv:conv) th = TRANS th (conv(rhs(concl th)));; (* ------------------------------------------------------------------------- *) (* Derived rules. *) (* ------------------------------------------------------------------------- *) let NOT_EQ_SYM = let pth = GENL [`a:A`; `b:A`] (CONTRAPOS(DISCH_ALL(SYM(ASSUME`a:A = b`)))) and aty = `:A` in fun th -> try let l,r = dest_eq(dest_neg(concl th)) in MP (SPECL [r; l] (INST_TYPE [type_of l,aty] pth)) th with Failure _ -> failwith "NOT_EQ_SYM";; let NOT_MP thi th = try MP thi th with Failure _ -> try let t = dest_neg (concl thi) in MP(MP (SPEC t F_IMP) thi) th with Failure _ -> failwith "NOT_MP";; let FORALL_EQ x = let mkall = AP_TERM (mk_const("!",[type_of x,mk_vartype "A"])) in fun th -> try mkall (ABS x th) with Failure _ -> failwith "FORALL_EQ";; let EXISTS_EQ x = let mkex = AP_TERM (mk_const("?",[type_of x,mk_vartype "A"])) in fun th -> try mkex (ABS x th) with Failure _ -> failwith "EXISTS_EQ";; let SELECT_EQ x = let mksel = AP_TERM (mk_const("@",[type_of x,mk_vartype "A"])) in fun th -> try mksel (ABS x th) with Failure _ -> failwith "SELECT_EQ";; let RIGHT_BETA th = try TRANS th (BETA_CONV(rhs(concl th))) with Failure _ -> failwith "RIGHT_BETA";; let rec LIST_BETA_CONV tm = try let rat,rnd = dest_comb tm in RIGHT_BETA(AP_THM(LIST_BETA_CONV rat)rnd) with Failure _ -> REFL tm;; let RIGHT_LIST_BETA th = TRANS th (LIST_BETA_CONV(snd(dest_eq(concl th))));; let LIST_CONJ = end_itlist CONJ ;; let rec CONJ_LIST n th = try if n=1 then [th] else (CONJUNCT1 th)::(CONJ_LIST (n-1) (CONJUNCT2 th)) with Failure _ -> failwith "CONJ_LIST";; let rec BODY_CONJUNCTS th = if is_forall(concl th) then BODY_CONJUNCTS (SPEC_ALL th) else if is_conj (concl th) then BODY_CONJUNCTS (CONJUNCT1 th) @ BODY_CONJUNCTS (CONJUNCT2 th) else [th];; let rec IMP_CANON th = let w = concl th in if is_conj w then IMP_CANON (CONJUNCT1 th) @ IMP_CANON (CONJUNCT2 th) else if is_imp w then let ante,conc = dest_neg_imp w in if is_conj ante then let a,b = dest_conj ante in IMP_CANON (DISCH a (DISCH b (NOT_MP th (CONJ (ASSUME a) (ASSUME b))))) else if is_disj ante then let a,b = dest_disj ante in IMP_CANON (DISCH a (NOT_MP th (DISJ1 (ASSUME a) b))) @ IMP_CANON (DISCH b (NOT_MP th (DISJ2 a (ASSUME b)))) else if is_exists ante then let x,body = dest_exists ante in let x' = variant (thm_frees th) x in let body' = subst [x',x] body in IMP_CANON (DISCH body' (NOT_MP th (EXISTS (ante, x') (ASSUME body')))) else map (DISCH ante) (IMP_CANON (UNDISCH th)) else if is_forall w then IMP_CANON (SPEC_ALL th) else [th];; let LIST_MP = rev_itlist (fun x y -> MP y x);; let DISJ_IMP = let pth = TAUT`!t1 t2. t1 \/ t2 ==> ~t1 ==> t2` in fun th -> try let a,b = dest_disj(concl th) in MP (SPECL [a;b] pth) th with Failure _ -> failwith "DISJ_IMP";; let IMP_ELIM = let pth = TAUT`!t1 t2. (t1 ==> t2) ==> ~t1 \/ t2` in fun th -> try let a,b = dest_imp(concl th) in MP (SPECL [a;b] pth) th with Failure _ -> failwith "IMP_ELIM";; let DISJ_CASES_UNION dth ath bth = DISJ_CASES dth (DISJ1 ath (concl bth)) (DISJ2 (concl ath) bth);; let MK_ABS qth = try let ov = bndvar(rand(concl qth)) in let bv,rth = SPEC_VAR qth in let sth = ABS bv rth in let cnv = ALPHA_CONV ov in CONV_RULE(BINOP_CONV cnv) sth with Failure _ -> failwith "MK_ABS";; let HALF_MK_ABS th = try let th1 = MK_ABS th in CONV_RULE(LAND_CONV ETA_CONV) th1 with Failure _ -> failwith "HALF_MK_ABS";; let MK_EXISTS qth = try let ov = bndvar(rand(concl qth)) in let bv,rth = SPEC_VAR qth in let sth = EXISTS_EQ bv rth in let cnv = GEN_ALPHA_CONV ov in CONV_RULE(BINOP_CONV cnv) sth with Failure _ -> failwith "MK_EXISTS";; let LIST_MK_EXISTS l th = itlist (fun x th -> MK_EXISTS(GEN x th)) l th;; let IMP_CONJ th1 th2 = let A1,C1 = dest_imp (concl th1) and A2,C2 = dest_imp (concl th2) in let a1,a2 = CONJ_PAIR (ASSUME (mk_conj(A1,A2))) in DISCH (mk_conj(A1,A2)) (CONJ (MP th1 a1) (MP th2 a2));; let EXISTS_IMP x = if not (is_var x) then failwith "EXISTS_IMP: first argument not a variable" else fun th -> try let ante,cncl = dest_imp(concl th) in let th1 = EXISTS (mk_exists(x,cncl),x) (UNDISCH th) in let asm = mk_exists(x,ante) in DISCH asm (CHOOSE (x,ASSUME asm) th1) with Failure _ -> failwith "EXISTS_IMP: variable free in assumptions";; let CONJUNCTS_CONV (t1,t2) = let rec build_conj thl t = try let l,r = dest_conj t in CONJ (build_conj thl l) (build_conj thl r) with Failure _ -> find (fun th -> concl th = t) thl in try IMP_ANTISYM_RULE (DISCH t1 (build_conj (CONJUNCTS (ASSUME t1)) t2)) (DISCH t2 (build_conj (CONJUNCTS (ASSUME t2)) t1)) with Failure _ -> failwith "CONJUNCTS_CONV";; let CONJ_SET_CONV l1 l2 = try CONJUNCTS_CONV (list_mk_conj l1, list_mk_conj l2) with Failure _ -> failwith "CONJ_SET_CONV";; let FRONT_CONJ_CONV tml t = let rec remove x l = if hd l = x then tl l else (hd l)::(remove x (tl l)) in try CONJ_SET_CONV tml (t::(remove t tml)) with Failure _ -> failwith "FRONT_CONJ_CONV";; let CONJ_DISCH = let pth = TAUT`!t t1 t2. (t ==> (t1 = t2)) ==> (t /\ t1 <=> t /\ t2)` in fun t th -> try let t1,t2 = dest_eq(concl th) in MP (SPECL [t; t1; t2] pth) (DISCH t th) with Failure _ -> failwith "CONJ_DISCH";; let rec CONJ_DISCHL l th = if l = [] then th else CONJ_DISCH (hd l) (CONJ_DISCHL (tl l) th);; let rec GSPEC th = let wl,w = dest_thm th in if is_forall w then GSPEC (SPEC (genvar (type_of (fst (dest_forall w)))) th) else th;; let ANTE_CONJ_CONV tm = try let (a1,a2),c = (dest_conj F_F I) (dest_imp tm) in let imp1 = MP (ASSUME tm) (CONJ (ASSUME a1) (ASSUME a2)) and imp2 = LIST_MP [CONJUNCT1 (ASSUME (mk_conj(a1,a2))); CONJUNCT2 (ASSUME (mk_conj(a1,a2)))] (ASSUME (mk_imp(a1,mk_imp(a2,c)))) in IMP_ANTISYM_RULE (DISCH_ALL (DISCH a1 (DISCH a2 imp1))) (DISCH_ALL (DISCH (mk_conj(a1,a2)) imp2)) with Failure _ -> failwith "ANTE_CONJ_CONV";; let bool_EQ_CONV = let check = let boolty = `:bool` in check (fun tm -> type_of tm = boolty) in let clist = map (GEN `b:bool`) (CONJUNCTS(SPEC `b:bool` EQ_CLAUSES)) in let tb = hd clist and bt = hd(tl clist) in let T = `T` and F = `F` in fun tm -> try let l,r = (I F_F check) (dest_eq tm) in if l = r then EQT_INTRO (REFL l) else if l = T then SPEC r tb else if r = T then SPEC l bt else fail() with Failure _ -> failwith "bool_EQ_CONV";; let COND_CONV = let T = `T` and F = `F` and vt = genvar`:A` and vf = genvar `:A` in let gen = GENL [vt;vf] in let CT,CF = (gen F_F gen) (CONJ_PAIR (SPECL [vt;vf] COND_CLAUSES)) in fun tm -> let P,(u,v) = try dest_cond tm with Failure _ -> failwith "COND_CONV: not a conditional" in let ty = type_of u in if (P=T) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CT)) else if (P=F) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CF)) else if (u=v) then SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) else if (aconv u v) then let cnd = AP_TERM (rator tm) (ALPHA v u) in let thm = SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) in TRANS cnd thm else failwith "COND_CONV: can't simplify conditional";; let SUBST_MATCH eqth th = let tm_inst,ty_inst = find_match (lhs(concl eqth)) (concl th) in SUBS [INST tm_inst (INST_TYPE ty_inst eqth)] th;; let SUBST thl pat th = let eqs,vs = unzip thl in let gvs = map (genvar o type_of) vs in let gpat = subst (zip gvs vs) pat in let ls,rs = unzip (map (dest_eq o concl) eqs) in let ths = map (ASSUME o mk_eq) (zip gvs rs) in let th1 = ASSUME gpat in let th2 = SUBS ths th1 in let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in let th4 = INST (zip ls gvs) th3 in MP (rev_itlist (C MP) eqs th4) th;; (* ------------------------------------------------------------------------- *) (* A poor thing but my own. The original (bogus) code used mk_thm. *) (* I haven't bothered with GSUBS and SUBS_OCCS. *) (* ------------------------------------------------------------------------- *) let SUBST_CONV thvars template tm = let thms,vars = unzip thvars in let gvs = map (genvar o type_of) vars in let gtemplate = subst (zip gvs vars) template in SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; (* ------------------------------------------------------------------------- *) (* Filtering rewrites. *) (* ------------------------------------------------------------------------- *) let FILTER_PURE_ASM_REWRITE_RULE f thl th = PURE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_ASM_REWRITE_RULE f thl th = REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_PURE_ONCE_ASM_REWRITE_RULE f thl th = PURE_ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_ONCE_ASM_REWRITE_RULE f thl th = ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th;; let (FILTER_PURE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> PURE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) and (FILTER_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) and (FILTER_PURE_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> PURE_ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) and (FILTER_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = fun f thl (asl,w) -> ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w);; (* ------------------------------------------------------------------------- *) (* Tacticals. *) (* ------------------------------------------------------------------------- *) let DISJ_CASES_THENL = end_itlist DISJ_CASES_THEN2;; let (X_CASES_THENL: term list list -> thm_tactic list -> thm_tactic) = fun varsl ttacl -> end_itlist DISJ_CASES_THEN2 (map (fun (vars,ttac) -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) (zip varsl ttacl));; let (X_CASES_THEN: term list list -> thm_tactical) = fun varsl ttac -> end_itlist DISJ_CASES_THEN2 (map (fun vars -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) varsl);; let (CASES_THENL: thm_tactic list -> thm_tactic) = fun ttacl -> end_itlist DISJ_CASES_THEN2 (map (REPEAT_TCL CHOOSE_THEN) ttacl);; (* ------------------------------------------------------------------------- *) (* Tactics. *) (* ------------------------------------------------------------------------- *) let (DISCARD_TAC: thm_tactic) = let truth = `T` in fun th (asl,w) -> if exists (aconv (concl th)) (truth::(map (concl o snd) asl)) then ALL_TAC (asl,w) else failwith "DISCARD_TAC";; let (GSUBST_TAC:((term * term)list->term->term)->thm list -> tactic) = fun substfn ths (asl,w) -> let ls,rs = split (map (dest_eq o concl) ths) in let vars = map (genvar o type_of) ls in let base = substfn (combine(vars,ls)) w in let rfn i thl = match thl with [th] -> SUBST (combine(map SYM ths, vars)) base th | _ -> failwith "" in null_meta, [asl,subst (combine(rs,vars)) base], rfn;; let SUBST_TAC = GSUBST_TAC subst;; let SUBST_OCCS_TAC nlths = let nll,ths = split nlths in GSUBST_TAC (subst_occs nll) ths;; let (CHECK_ASSUME_TAC: thm_tactic) = fun gth -> FIRST [CONTR_TAC gth; ACCEPT_TAC gth; DISCARD_TAC gth; ASSUME_TAC gth];; let (FILTER_GEN_TAC: term -> tactic) = fun tm (asl,w) -> if is_forall w && not (tm = fst(dest_forall w)) then GEN_TAC (asl,w) else failwith "FILTER_GEN_TAC";; let (FILTER_DISCH_THEN: thm_tactic -> term -> tactic) = fun ttac tm (asl,w) -> if is_neg_imp w && not (free_in tm (fst(dest_neg_imp w))) then DISCH_THEN ttac (asl,w) else failwith "FILTER_DISCH_THEN";; let FILTER_STRIP_THEN ttac tm = FIRST [FILTER_GEN_TAC tm; FILTER_DISCH_THEN ttac tm; CONJ_TAC];; let FILTER_DISCH_TAC = FILTER_DISCH_THEN STRIP_ASSUME_TAC;; let FILTER_STRIP_TAC = FILTER_STRIP_THEN STRIP_ASSUME_TAC;; (* ------------------------------------------------------------------------- *) (* Resolution stuff. *) (* ------------------------------------------------------------------------- *) let RES_CANON = let not_elim th = if is_neg (concl th) then true,(NOT_ELIM th) else (false,th) in let rec canon fl th = let w = concl th in if (is_conj w) then let (th1,th2) = CONJ_PAIR th in (canon fl th1) @ (canon fl th2) else if ((is_imp w) && not(is_neg w)) then let ante,conc = dest_neg_imp w in if (is_conj ante) then let a,b = dest_conj ante in let cth = NOT_MP th (CONJ (ASSUME a) (ASSUME b)) in let th1 = DISCH b cth and th2 = DISCH a cth in (canon true (DISCH a th1)) @ (canon true (DISCH b th2)) else if (is_disj ante) then let a,b = dest_disj ante in let ath = DISJ1 (ASSUME a) b and bth = DISJ2 a (ASSUME b) in let th1 = DISCH a (NOT_MP th ath) and th2 = DISCH b (NOT_MP th bth) in (canon true th1) @ (canon true th2) else if (is_exists ante) then let v,body = dest_exists ante in let newv = variant (thm_frees th) v in let newa = subst [newv,v] body in let th1 = NOT_MP th (EXISTS (ante, newv) (ASSUME newa)) in canon true (DISCH newa th1) else map (GEN_ALL o (DISCH ante)) (canon true (UNDISCH th)) else if (is_eq w && (type_of (rand w) = `:bool`)) then let (th1,th2) = EQ_IMP_RULE th in (if fl then [GEN_ALL th] else []) @ (canon true th1) @ (canon true th2) else if (is_forall w) then let vs,body = strip_forall w in let fvs = thm_frees th in let vfn = fun l -> variant (l @ fvs) in let nvs = itlist (fun v nv -> let v' = vfn nv v in (v'::nv)) vs [] in canon fl (SPECL nvs th) else if fl then [GEN_ALL th] else [] in fun th -> try let args = map (not_elim o SPEC_ALL) (CONJUNCTS (SPEC_ALL th)) in let imps = flat (map (map GEN_ALL o (uncurry canon)) args) in check ((not) o (=) []) imps with Failure _ -> failwith "RES_CANON: no implication is derivable from input thm.";; let IMP_RES_THEN,RES_THEN = let MATCH_MP impth = let sth = SPEC_ALL impth in let matchfn = (fun (a,b,c) -> b,c) o term_match [] (fst(dest_neg_imp(concl sth))) in fun th -> NOT_MP (INST_TY_TERM (matchfn (concl th)) sth) th in let check st l = (if l = [] then failwith st else l) in let IMP_RES_THEN ttac impth = let ths = try RES_CANON impth with Failure _ -> failwith "IMP_RES_THEN: no implication" in ASSUM_LIST (fun asl -> let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asl)) ths [] in let res = check "IMP_RES_THEN: no resolvents " l in let tacs = check "IMP_RES_THEN: no tactics" (mapfilter ttac res) in EVERY tacs) in let RES_THEN ttac (asl,g) = let asm = map snd asl in let ths = itlist (@) (mapfilter RES_CANON asm) [] in let imps = check "RES_THEN: no implication" ths in let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asm)) imps [] in let res = check "RES_THEN: no resolvents " l in let tacs = check "RES_THEN: no tactics" (mapfilter ttac res) in EVERY tacs (asl,g) in IMP_RES_THEN,RES_THEN;; let IMP_RES_TAC th g = try IMP_RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) th g with Failure _ -> ALL_TAC g;; let RES_TAC g = try RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) g with Failure _ -> ALL_TAC g;; (* ------------------------------------------------------------------------- *) (* Stuff for handling type definitions. *) (* ------------------------------------------------------------------------- *) let prove_rep_fn_one_one th = try let thm = CONJUNCT1 th in let A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl thm))))) in let _,[aty;rty] = dest_type (type_of R) in let a = mk_primed_var("a",aty) in let a' = variant [a] a in let a_eq_a' = mk_eq(a,a') and Ra_eq_Ra' = mk_eq(mk_comb(R,a),mk_comb (R,a')) in let th1 = AP_TERM A (ASSUME Ra_eq_Ra') in let ga1 = genvar aty and ga2 = genvar aty in let th2 = SUBST [SPEC a thm,ga1;SPEC a' thm,ga2] (mk_eq(ga1,ga2)) th1 in let th3 = DISCH a_eq_a' (AP_TERM R (ASSUME a_eq_a')) in GEN a (GEN a' (IMP_ANTISYM_RULE (DISCH Ra_eq_Ra' th2) th3)) with Failure _ -> failwith "prove_rep_fn_one_one";; let prove_rep_fn_onto th = try let [th1;th2] = CONJUNCTS th in let r,eq = (I F_F rhs)(dest_forall(concl th2)) in let RE,ar = dest_comb(lhs eq) and sr = (mk_eq o (fun (x,y) -> y,x) o dest_eq) eq in let a = mk_primed_var ("a",type_of ar) in let sra = mk_eq(r,mk_comb(RE,a)) in let ex = mk_exists(a,sra) in let imp1 = EXISTS (ex,ar) (SYM(ASSUME eq)) in let v = genvar (type_of r) and A = rator ar and s' = AP_TERM RE (SPEC a th1) in let th = SUBST[SYM(ASSUME sra),v](mk_eq(mk_comb(RE,mk_comb(A,v)),v))s' in let imp2 = CHOOSE (a,ASSUME ex) th in let swap = IMP_ANTISYM_RULE (DISCH eq imp1) (DISCH ex imp2) in GEN r (TRANS (SPEC r th2) swap) with Failure _ -> failwith "prove_rep_fn_onto";; let prove_abs_fn_onto th = try let [th1;th2] = CONJUNCTS th in let a,(A,R) = (I F_F ((I F_F rator)o dest_comb o lhs)) (dest_forall(concl th1)) in let thm1 = EQT_ELIM(TRANS (SPEC (mk_comb (R,a)) th2) (EQT_INTRO (AP_TERM R (SPEC a th1)))) in let thm2 = SYM(SPEC a th1) in let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) in let ex = mk_exists(r,mk_conj(mk_eq(a,mk_comb(A,r)),mk_comb(P,r))) in GEN a (EXISTS(ex,mk_comb(R,a)) (CONJ thm2 thm1)) with Failure _ -> failwith "prove_abs_fn_onto";; let prove_abs_fn_one_one th = try let [th1;th2] = CONJUNCTS th in let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) and A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl th1))))) in let r' = variant [r] r in let as1 = ASSUME(mk_comb(P,r)) and as2 = ASSUME(mk_comb(P,r')) in let t1 = EQ_MP (SPEC r th2) as1 and t2 = EQ_MP (SPEC r' th2) as2 in let eq = (mk_eq(mk_comb(A,r),mk_comb(A,r'))) in let v1 = genvar(type_of r) and v2 = genvar(type_of r) in let i1 = DISCH eq (SUBST [t1,v1;t2,v2] (mk_eq(v1,v2)) (AP_TERM R (ASSUME eq))) and i2 = DISCH (mk_eq(r,r')) (AP_TERM A (ASSUME (mk_eq(r,r')))) in let thm = IMP_ANTISYM_RULE i1 i2 in let disch = DISCH (mk_comb(P,r)) (DISCH (mk_comb(P,r')) thm) in GEN r (GEN r' disch) with Failure _ -> failwith "prove_abs_fn_one_one";; (* ------------------------------------------------------------------------- *) (* AC rewriting needs to be wrapped up as a special conversion. *) (* ------------------------------------------------------------------------- *) let AC_CONV(associative,commutative) tm = try let op = (rator o rator o lhs o snd o strip_forall o concl) commutative in let ty = (hd o snd o dest_type o type_of) op in let x = mk_var("x",ty) and y = mk_var("y",ty) and z = mk_var("z",ty) in let xy = mk_comb(mk_comb(op,x),y) and yz = mk_comb(mk_comb(op,y),z) and yx = mk_comb(mk_comb(op,y),x) in let comm = PART_MATCH I commutative (mk_eq(xy,yx)) and ass = PART_MATCH I (SYM (SPEC_ALL associative)) (mk_eq(mk_comb(mk_comb(op,xy),z),mk_comb(mk_comb(op,x),yz))) in let asc = TRANS (SUBS [comm] (SYM ass)) (INST[(x,y); (y,x)] ass) in let init = TOP_DEPTH_CONV (REWR_CONV ass) tm in let gl = rhs (concl init) in let rec bubble head expr = let ((xop,l),r) = (dest_comb F_F I) (dest_comb expr) in if xop = op then if l = head then REFL expr else if r = head then INST [(l,x); (r,y)] comm else let subb = bubble head r in let eqv = AP_TERM (mk_comb(xop,l)) subb and ((yop,l'),r') = (dest_comb F_F I) (dest_comb (snd (dest_eq (concl subb)))) in TRANS eqv (INST[(l,x); (l',y); (r',z)] asc) else failwith "" in let rec asce (l,r) = if l = r then REFL l else let ((zop,l'),r') = (dest_comb F_F I) (dest_comb l) in if zop = op then let beq = bubble l' r in let rt = snd (dest_eq (concl beq)) in TRANS (AP_TERM (mk_comb(op,l')) (asce ((snd (dest_comb l)),(snd (dest_comb rt))))) (SYM beq) else failwith "" in EQT_INTRO (EQ_MP (SYM init) (asce (dest_eq gl))) with _ -> failwith "AC_CONV";; let AC_RULE ths = EQT_ELIM o AC_CONV ths;; (* ------------------------------------------------------------------------- *) (* The order of picking conditionals is different! *) (* ------------------------------------------------------------------------- *) let (COND_CASES_TAC :tactic) = let is_good_cond tm = try not(is_const(fst(dest_cond tm))) with Failure _ -> false in fun (asl,w) -> let cond = find_term (fun tm -> is_good_cond tm && free_in tm w) w in let p,(t,u) = dest_cond cond in let inst = INST_TYPE [type_of t, `:A`] COND_CLAUSES in let (ct,cf) = CONJ_PAIR (SPEC u (SPEC t inst)) in DISJ_CASES_THEN2 (fun th -> SUBST1_TAC (EQT_INTRO th) THEN SUBST1_TAC ct THEN ASSUME_TAC th) (fun th -> SUBST1_TAC (EQF_INTRO th) THEN SUBST1_TAC cf THEN ASSUME_TAC th) (SPEC p EXCLUDED_MIDDLE) (asl,w) ;; (* ------------------------------------------------------------------------- *) (* MATCH_MP_TAC allows universals on the right of implication. *) (* Here's a crude hack to allow it. *) (* ------------------------------------------------------------------------- *) let MATCH_MP_TAC th = MATCH_MP_TAC th ORELSE MATCH_MP_TAC(PURE_REWRITE_RULE[RIGHT_IMP_FORALL_THM] th);; (* ------------------------------------------------------------------------- *) (* Various theorems have different names. *) (* ------------------------------------------------------------------------- *) let ZERO_LESS_EQ = LE_0;; let LESS_EQ_MONO = LE_SUC;; let NOT_LESS = NOT_LT;; let LESS_0 = LT_0;; let LESS_EQ_REFL = LE_REFL;; let LESS_EQUAL_ANTISYM = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ANTISYM)));; let NOT_LESS_0 = GEN_ALL(EQF_ELIM(SPEC_ALL(CONJUNCT1 LT)));; let LESS_TRANS = LT_TRANS;; let LESS_LEMMA1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL(CONJUNCT2 LT))));; let LESS_SUC_REFL = prove(`!n. n < SUC n`,REWRITE_TAC[LT]);; let FACT_LESS = FACT_LT;; let LESS_EQ_SUC_REFL = prove(`!n. n <= SUC n`,REWRITE_TAC[LE; LE_REFL]);; let LESS_EQ_ADD = LE_ADD;; let GREATER_EQ = GE;; let LESS_EQUAL_ADD = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_EXISTS)));; let LESS_EQ_IMP_LESS_SUC = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_SUC_LE)));; let LESS_IMP_LESS_OR_EQ = LT_IMP_LE;; let LESS_MONO_ADD = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_ADD_RCANCEL)));; let LESS_SUC = prove(`!m n. m < n ==> m < (SUC n)`,MESON_TAC[LT]);; let LESS_CASES = LTE_CASES;; let LESS_EQ = GSYM LE_SUC_LT;; let LESS_OR_EQ = LE_LT;; let LESS_ADD_1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL (REWRITE_RULE[ADD1] LT_EXISTS))));; let SUC_SUB1 = ARITH_RULE `!m. SUC m - 1 = m`;; let LESS_MONO_EQ = LT_SUC;; let LESS_ADD_SUC = ARITH_RULE `!m n. m < m + SUC n`;; let LESS_REFL = LT_REFL;; let INV_SUC_EQ = SUC_INJ;; let LESS_EQ_CASES = LE_CASES;; let LESS_EQ_TRANS = LE_TRANS;; let LESS_THM = CONJUNCT2 LT;; let GREATER = GT;; let LESS_EQ_0 = CONJUNCT1 LE;; let OR_LESS = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_SUC_LT)));; let SUB_EQUAL_0 = SUB_REFL;; let SUB_MONO_EQ = SUB_SUC;; let NOT_SUC_LESS_EQ = ARITH_RULE `!n m. ~(SUC n <= m) <=> m <= n`;; let SUC_NOT = GSYM NOT_SUC;; let LESS_LESS_CASES = ARITH_RULE `!m n:num. (m = n) \/ m < n \/ n < m`;; let NOT_LESS_EQUAL = NOT_LE;; let LESS_EQ_EXISTS = LE_EXISTS;; let LESS_MONO_ADD_EQ = LT_ADD_RCANCEL;; let LESS_LESS_EQ_TRANS = LTE_TRANS;; let SUB_SUB = ARITH_RULE `!b c. c <= b ==> (!a:num. a - (b - c) = (a + c) - b)`;; let LESS_CASES_IMP = ARITH_RULE `!m n:num. ~(m < n) /\ ~(m = n) ==> n < m`;; let SUB_LESS_EQ = ARITH_RULE `!n m:num. (n - m) <= n`;; let SUB_EQ_EQ_0 = ARITH_RULE `!m n:num. (m - n = m) = (m = 0) \/ (n = 0)`;; let SUB_LEFT_LESS_EQ = ARITH_RULE `!m n p:num. m <= (n - p) <=> (m + p) <= n \/ m <= 0`;; let SUB_LEFT_GREATER_EQ = ARITH_RULE `!m n p:num. m >= (n - p) <=> (m + p) >= n`;; let LESS_EQ_LESS_TRANS = LET_TRANS;; let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; let LESS_OR = ARITH_RULE `!m n. m < n ==> (SUC m) <= n`;; let SUB = ARITH_RULE `(!m. 0 - m = 0) /\ (!m n. (SUC m) - n = (if m < n then 0 else SUC(m - n)))`;; let LESS_MULT_MONO = prove (`!m i n. ((SUC n) * m) < ((SUC n) * i) <=> m < i`, REWRITE_TAC[LT_MULT_LCANCEL; NOT_SUC]);; let LESS_MONO_MULT = prove (`!m n p. m <= n ==> (m * p) <= (n * p)`, SIMP_TAC[LE_MULT_RCANCEL]);; let LESS_MULT2 = prove (`!m n. 0 < m /\ 0 < n ==> 0 < (m * n)`, REWRITE_TAC[LT_MULT]);; let SUBSET_FINITE = prove (`!s. FINITE s ==> (!t. t SUBSET s ==> FINITE t)`, MESON_TAC[FINITE_SUBSET]);; let LESS_EQ_SUC = prove (`!n. m <= SUC n <=> (m = SUC n) \/ m <= n`, REWRITE_TAC[LE]);; (* ------------------------------------------------------------------------- *) (* Restore traditional (low) parse status of "=". *) (* ------------------------------------------------------------------------- *) parse_as_infix("=",(2,"right"));; hol-light/Examples/holby.ml000066400000000000000000001027471303454263000162050ustar00rootroot00000000000000(* ========================================================================= *) (* A HOL "by" tactic, doing Mizar-like things, trying something that is *) (* sufficient for HOL's basic rules, trying a few other things like *) (* arithmetic, and finally if all else fails using MESON_TAC[]. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* More refined net lookup that double-checks conditions like matchability. *) (* ------------------------------------------------------------------------- *) let matching_enter tm y net = enter [] (tm,((fun tm' -> can (term_match [] tm) tm'),y)) net;; let unconditional_enter (tm,y) net = enter [] (tm,((fun t -> true),y)) net;; let conditional_enter (tm,condy) net = enter [] (tm,condy) net;; let careful_lookup tm net = map snd (filter (fun (c,y) -> c tm) (lookup tm net));; (* ------------------------------------------------------------------------- *) (* Transform theorem list to simplify, eliminate redundant connectives and *) (* split the problem into (generally multiple) subproblems. Then, call the *) (* prover given as the first argument on each component. *) (* ------------------------------------------------------------------------- *) let SPLIT_THEN = let action_false th f oths = th and action_true th f oths = f oths and action_conj th f oths = f (CONJUNCT1 th :: CONJUNCT2 th :: oths) and action_disj th f oths = let th1 = f (ASSUME(lhand(concl th)) :: oths) and th2 = f (ASSUME(rand(concl th)) :: oths) in DISJ_CASES th th1 th2 and action_taut tm = let pfun = PART_MATCH lhs (TAUT tm) in let prule th = EQ_MP (pfun (concl th)) th in lhand tm,(fun th f oths -> f(prule th :: oths)) in let enet = itlist unconditional_enter [`F`,action_false; `T`,action_true; `p /\ q`,action_conj; `p \/ q`,action_disj; action_taut `(p ==> q) <=> ~p \/ q`; action_taut `~F <=> T`; action_taut `~T <=> F`; action_taut `~(~p) <=> p`; action_taut `~(p /\ q) <=> ~p \/ ~q`; action_taut `~(p \/ q) <=> ~p /\ ~q`; action_taut `~(p ==> q) <=> p /\ ~q`; action_taut `p /\ F <=> F`; action_taut `F /\ p <=> F`; action_taut `p /\ T <=> p`; action_taut `T /\ p <=> p`; action_taut `p \/ F <=> p`; action_taut `F \/ p <=> p`; action_taut `p \/ T <=> T`; action_taut `T \/ p <=> T`] (let tm,act = action_taut `~(p <=> q) <=> p /\ ~q \/ ~p /\ q` in let cond tm = type_of(rand(rand tm)) = bool_ty in conditional_enter (tm,(cond,act)) (let tm,act = action_taut `(p <=> q) <=> p /\ q \/ ~p /\ ~q` in let cond tm = type_of(rand tm) = bool_ty in conditional_enter (tm,(cond,act)) empty_net)) in fun prover -> let rec splitthen splat tosplit = match tosplit with [] -> prover (rev splat) | th::oths -> let funs = careful_lookup (concl th) enet in if funs = [] then splitthen (th::splat) oths else (hd funs) th (splitthen splat) oths in splitthen [];; (* ------------------------------------------------------------------------- *) (* A similar thing that also introduces Skolem constants (but not functions) *) (* and does some slight first-order simplification like trivial miniscoping. *) (* ------------------------------------------------------------------------- *) let SPLIT_FOL_THEN = let action_false th f splat oths = th and action_true th f splat oths = f oths and action_conj th f splat oths = f (CONJUNCT1 th :: CONJUNCT2 th :: oths) and action_disj th f splat oths = let th1 = f (ASSUME(lhand(concl th)) :: oths) and th2 = f (ASSUME(rand(concl th)) :: oths) in DISJ_CASES th th1 th2 and action_exists th f splat oths = let v,bod = dest_exists(concl th) in let vars = itlist (union o thm_frees) (oths @ splat) (thm_frees th) in let v' = variant vars v in let th' = ASSUME (subst [v',v] bod) in CHOOSE (v',th) (f (th'::oths)) and action_taut tm = let pfun = PART_MATCH lhs (TAUT tm) in let prule th = EQ_MP (pfun (concl th)) th in lhand tm,(fun th f splat oths -> f(prule th :: oths)) and action_fol tm = let pfun = PART_MATCH lhs (prove(tm,MESON_TAC[])) in let prule th = EQ_MP (pfun (concl th)) th in lhand tm,(fun th f splat oths -> f(prule th :: oths)) in let enet = itlist unconditional_enter [`F`,action_false; `T`,action_true; `p /\ q`,action_conj; `p \/ q`,action_disj; `?x. P x`,action_exists; action_taut `~(~p) <=> p`; action_taut `~(p /\ q) <=> ~p \/ ~q`; action_taut `~(p \/ q) <=> ~p /\ ~q`; action_fol `~(!x. P x) <=> (?x. ~(P x))`; action_fol `(!x. P x /\ Q x) <=> (!x. P x) /\ (!x. Q x)`] empty_net in fun prover -> let rec splitthen splat tosplit = match tosplit with [] -> prover (rev splat) | th::oths -> let funs = careful_lookup (concl th) enet in if funs = [] then splitthen (th::splat) oths else (hd funs) th (splitthen splat) splat oths in splitthen [];; (* ------------------------------------------------------------------------- *) (* Do the basic "semantic correlates" stuff. *) (* This is more like NNF than Mizar's version. *) (* ------------------------------------------------------------------------- *) let CORRELATE_RULE = PURE_REWRITE_RULE [TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`; TAUT `(a ==> b) <=> ~a \/ b`; DE_MORGAN_THM; TAUT `~(~a) <=> a`; TAUT `~T <=> F`; TAUT `~F <=> T`; TAUT `T /\ p <=> p`; TAUT `p /\ T <=> p`; TAUT `F /\ p <=> F`; TAUT `p /\ F <=> F`; TAUT `T \/ p <=> T`; TAUT `p \/ T <=> T`; TAUT `F \/ p <=> p`; TAUT `p \/ F <=> p`; GSYM CONJ_ASSOC; GSYM DISJ_ASSOC; prove(`(?x. P x) <=> ~(!x. ~(P x))`,MESON_TAC[])];; (* ------------------------------------------------------------------------- *) (* Look for an immediate contradictory pair of theorems. This is quadratic, *) (* but I doubt if that's much of an issue in practice. We could do something *) (* fancier, but need to be careful over alpha-equivalence if sorting. *) (* ------------------------------------------------------------------------- *) let THMLIST_CONTR_RULE = let CONTR_PAIR_THM = UNDISCH_ALL(TAUT `p ==> ~p ==> F`) and p_tm = `p:bool` in fun ths -> let ths_n,ths_p = partition (is_neg o concl) ths in let th_n = find (fun thn -> let tm = rand(concl thn) in exists (aconv tm o concl) ths_p) ths_n in let tm = rand(concl th_n) in let th_p = find (aconv tm o concl) ths_p in itlist PROVE_HYP [th_p; th_n] (INST [tm,p_tm] CONTR_PAIR_THM);; (* ------------------------------------------------------------------------- *) (* Hence something similar to Mizar's "prechecker". *) (* ------------------------------------------------------------------------- *) let PRECHECKER_THEN prover = SPLIT_THEN (fun ths -> try THMLIST_CONTR_RULE ths with Failure _ -> SPLIT_FOL_THEN prover (map CORRELATE_RULE ths));; (* ------------------------------------------------------------------------- *) (* Lazy equations for use in congruence closure. *) (* ------------------------------------------------------------------------- *) type lazyeq = Lazy of (term * term) * (unit -> thm);; let cache f = let store = ref TRUTH in fun () -> let th = !store in if is_eq(concl th) then th else let th' = f() in (store := th'; th');; let lazy_eq th = Lazy((dest_eq(concl th)),(fun () -> th));; let lazy_eval (Lazy(_,f)) = f();; let REFL' t = Lazy((t,t),cache(fun () -> REFL t));; let SYM' = fun (Lazy((t,t'),f)) -> Lazy((t',t),cache(fun () -> SYM(f ())));; let TRANS' = fun (Lazy((s,s'),f)) (Lazy((t,t'),g)) -> if not(aconv s' t) then failwith "TRANS'" else Lazy((s,t'),cache(fun () -> TRANS (f ()) (g ())));; let MK_COMB' = fun (Lazy((s,s'),f),Lazy((t,t'),g)) -> Lazy((mk_comb(s,t),mk_comb(s',t')),cache(fun () -> MK_COMB (f (),g ())));; let concl' = fun (Lazy(tmp,g)) -> tmp;; (* ------------------------------------------------------------------------- *) (* Successors of a term, and predecessor function. *) (* ------------------------------------------------------------------------- *) let successors tm = try let f,x = dest_comb tm in [f;x] with Failure _ -> [];; let predecessor_function tms = itlist (fun x -> itlist (fun y f -> (y |-> insert x (tryapplyd f y [])) f) (successors x)) tms undefined;; (* ------------------------------------------------------------------------- *) (* A union-find structure for equivalences, with theorems for edges. *) (* ------------------------------------------------------------------------- *) type termnode = Nonterminal of lazyeq | Terminal of term * term list;; type termequivalence = Equivalence of (term,termnode)func;; let rec terminus (Equivalence f as eqv) a = match (apply f a) with Nonterminal(th) -> let b = snd(concl' th) in let th',n = terminus eqv b in TRANS' th th',n | Terminal(t,n) -> (REFL' t,n);; let tryterminus eqv a = try terminus eqv a with Failure _ -> (REFL' a,[a]);; let canonize eqv a = fst(tryterminus eqv a);; let equate th (Equivalence f as eqv) = let a,b = concl' th in let (ath,na) = tryterminus eqv a and (bth,nb) = tryterminus eqv b in let a' = snd(concl' ath) and b' = snd(concl' bth) in Equivalence (if a' = b' then f else if length na <= length nb then let th' = TRANS' (TRANS' (SYM' ath) th) bth in (a' |-> Nonterminal th') ((b' |-> Terminal(b',na@nb)) f) else let th' = TRANS'(SYM'(TRANS' th bth)) ath in (b' |-> Nonterminal th') ((a' |-> Terminal(a',na@nb)) f));; let unequal = Equivalence undefined;; let equated (Equivalence f) = dom f;; let prove_equal eqv (s,t) = let sth = canonize eqv s and tth = canonize eqv t in TRANS' (canonize eqv s) (SYM'(canonize eqv t));; let equivalence_class eqv a = snd(tryterminus eqv a);; (* ------------------------------------------------------------------------- *) (* Prove composite terms equivalent based on 1-step congruence. *) (* ------------------------------------------------------------------------- *) let provecongruent eqv (tm1,tm2) = let f1,x1 = dest_comb tm1 and f2,x2 = dest_comb tm2 in MK_COMB'(prove_equal eqv (f1,f2),prove_equal eqv (x1,x2));; (* ------------------------------------------------------------------------- *) (* Merge equivalence classes given equation "th", using congruence closure. *) (* ------------------------------------------------------------------------- *) let rec emerge th (eqv,pfn) = let s,t = concl' th in let sth = canonize eqv s and tth = canonize eqv t in let s' = snd(concl' sth) and t' = snd(concl' tth) in if s' = t' then (eqv,pfn) else let sp = tryapplyd pfn s' [] and tp = tryapplyd pfn t' [] in let eqv' = equate th eqv in let stth = canonize eqv' s' in let sttm = snd(concl' stth) in let pfn' = (sttm |-> union sp tp) pfn in itlist (fun (u,v) (eqv,pfn as eqp) -> try let thuv = provecongruent eqv (u,v) in emerge thuv eqp with Failure _ -> eqp) (allpairs (fun u v -> (u,v)) sp tp) (eqv',pfn');; (* ------------------------------------------------------------------------- *) (* Find subterms of "tm" that contain as a subterm one of the "tms" terms. *) (* This is intended to be more efficient than the obvious "find_terms ...". *) (* ------------------------------------------------------------------------- *) let rec supersubterms tms tm = let ltms,tms' = if mem tm tms then [tm],filter (fun t -> t <> tm) tms else [],tms in if tms' = [] then ltms else let stms = try let l,r = dest_comb tm in union (supersubterms tms' l) (supersubterms tms' r) with Failure _ -> [] in if stms = [] then ltms else tm::stms;; (* ------------------------------------------------------------------------- *) (* Find an appropriate term universe for overall terms "tms". *) (* ------------------------------------------------------------------------- *) let term_universe tms = setify (itlist ((@) o supersubterms tms) tms []);; (* ------------------------------------------------------------------------- *) (* Congruence closure of "eqs" over term universe "tms". *) (* ------------------------------------------------------------------------- *) let congruence_closure tms eqs = let pfn = predecessor_function tms in let eqv,_ = itlist emerge eqs (unequal,pfn) in eqv;; (* ------------------------------------------------------------------------- *) (* Prove that "eq" follows from "eqs" by congruence closure. *) (* ------------------------------------------------------------------------- *) let CCPROVE eqs eq = let tps = dest_eq eq :: map concl' eqs in let otms = itlist (fun (x,y) l -> x::y::l) tps [] in let tms = term_universe(setify otms) in let eqv = congruence_closure tms eqs in prove_equal eqv (dest_eq eq);; (* ------------------------------------------------------------------------- *) (* Inference rule for `eq1 /\ ... /\ eqn ==> eq` *) (* ------------------------------------------------------------------------- *) let CONGRUENCE_CLOSURE tm = if is_imp tm then let eqs,eq = dest_imp tm in DISCH eqs (lazy_eval(CCPROVE (map lazy_eq (CONJUNCTS(ASSUME eqs))) eq)) else lazy_eval(CCPROVE [] tm);; (* ------------------------------------------------------------------------- *) (* Inference rule for contradictoriness of set of +ve and -ve eqns. *) (* ------------------------------------------------------------------------- *) let CONGRUENCE_CLOSURE_CONTR ths = let nths,pths = partition (is_neg o concl) ths in let peqs = filter (is_eq o concl) pths and neqs = filter (is_eq o rand o concl) nths in let tps = map (dest_eq o concl) peqs @ map (dest_eq o rand o concl) neqs in let otms = itlist (fun (x,y) l -> x::y::l) tps [] in let tms = term_universe(setify otms) in let eqv = congruence_closure tms (map lazy_eq peqs) in let prover th = let eq = dest_eq(rand(concl th)) in let lth = prove_equal eqv eq in EQ_MP (EQF_INTRO th) (lazy_eval lth) in tryfind prover neqs;; (* ------------------------------------------------------------------------- *) (* Attempt to prove equality between terms/formulas based on equivalence. *) (* Note that ABS sideconditions are only checked at inference-time... *) (* ------------------------------------------------------------------------- *) let ABS' v = fun (Lazy((s,t),f)) -> Lazy((mk_abs(v,s),mk_abs(v,t)), cache(fun () -> ABS v (f ())));; let ALPHA_EQ' s' t' = fun (Lazy((s,t),f) as inp) -> if s' = s && t' = t then inp else Lazy((s',t'), cache(fun () -> EQ_MP (ALPHA (mk_eq(s,t)) (mk_eq(s',t'))) (f ())));; let rec PROVE_EQUAL eqv (tm1,tm2 as tmp) = if tm1 = tm2 then REFL' tm1 else try prove_equal eqv tmp with Failure _ -> if is_comb tm1 && is_comb tm2 then let f1,x1 = dest_comb tm1 and f2,x2 = dest_comb tm2 in MK_COMB'(PROVE_EQUAL eqv (f1,f2),PROVE_EQUAL eqv (x1,x2)) else if is_abs tm1 && is_abs tm2 then let x1,bod1 = dest_abs tm1 and x2,bod2 = dest_abs tm2 in let gv = genvar(type_of x1) in ALPHA_EQ' tm1 tm2 (ABS' x1 (PROVE_EQUAL eqv (vsubst[gv,x1] bod1,vsubst[gv,x2] bod2))) else failwith "PROVE_EQUAL";; let PROVE_EQUIVALENT eqv tm1 tm2 = lazy_eval (PROVE_EQUAL eqv (tm1,tm2));; (* ------------------------------------------------------------------------- *) (* Complementary version for formulas. *) (* ------------------------------------------------------------------------- *) let PROVE_COMPLEMENTARY eqv th1 th2 = let tm1 = concl th1 and tm2 = concl th2 in if is_neg tm1 then let th = PROVE_EQUIVALENT eqv (rand tm1) tm2 in EQ_MP (EQF_INTRO th1) (EQ_MP (SYM th) th2) else if is_neg tm2 then let th = PROVE_EQUIVALENT eqv (rand tm2) tm1 in EQ_MP (EQF_INTRO th2) (EQ_MP (SYM th) th1) else failwith "PROVE_COMPLEMENTARY";; (* ------------------------------------------------------------------------- *) (* Check equality under equivalence with "env" mapping for first term. *) (* ------------------------------------------------------------------------- *) let rec test_eq eqv (tm1,tm2) env = if is_comb tm1 && is_comb tm2 then let f1,x1 = dest_comb tm1 and f2,x2 = dest_comb tm2 in test_eq eqv (f1,f2) env && test_eq eqv (x1,x2) env else if is_abs tm1 && is_abs tm2 then let x1,bod1 = dest_abs tm1 and x2,bod2 = dest_abs tm2 in let gv = genvar(type_of x1) in test_eq eqv (vsubst[gv,x1] bod1,vsubst[gv,x2] bod2) env else if is_var tm1 && can (rev_assoc tm1) env then test_eq eqv (rev_assoc tm1 env,tm2) [] else can (prove_equal eqv) (tm1,tm2);; (* ------------------------------------------------------------------------- *) (* Map a term to its equivalence class modulo equivalence *) (* ------------------------------------------------------------------------- *) let rec term_equivs eqv tm = let l = equivalence_class eqv tm in if l <> [tm] then l else if is_comb tm then let f,x = dest_comb tm in allpairs (curry mk_comb) (term_equivs eqv f) (term_equivs eqv x) else if is_abs tm then let v,bod = dest_abs tm in let gv = genvar(type_of v) in map (fun t -> alpha v (mk_abs(gv,t))) (term_equivs eqv (vsubst [gv,v] bod)) else [tm];; (* ------------------------------------------------------------------------- *) (* Replace "outer" universal variables with genvars. This is "outer" in the *) (* second sense, i.e. universals not in scope of an existential or negation. *) (* ------------------------------------------------------------------------- *) let rec GENSPEC th = let tm = concl th in if is_forall tm then let v = bndvar(rand tm) in let gv = genvar(type_of v) in GENSPEC(SPEC gv th) else if is_conj tm then let th1,th2 = CONJ_PAIR th in CONJ (GENSPEC th1) (GENSPEC th2) else if is_disj tm then let th1 = GENSPEC(ASSUME(lhand tm)) and th2 = GENSPEC(ASSUME(rand tm)) in let th3 = DISJ1 th1 (concl th2) and th4 = DISJ2 (concl th1) th2 in DISJ_CASES th th3 th4 else th;; (* ------------------------------------------------------------------------- *) (* Simple first-order matching. *) (* ------------------------------------------------------------------------- *) let rec term_fmatch vars vtm ctm env = if mem vtm vars then if can (rev_assoc vtm) env then term_fmatch vars (rev_assoc vtm env) ctm env else if aconv vtm ctm then env else (ctm,vtm)::env else if is_comb vtm && is_comb ctm then let fv,xv = dest_comb vtm and fc,xc = dest_comb ctm in term_fmatch vars fv fc (term_fmatch vars xv xc env) else if is_abs vtm && is_abs ctm then let xv,bodv = dest_abs vtm and xc,bodc = dest_abs ctm in let gv = genvar(type_of xv) and gc = genvar(type_of xc) in let gbodv = vsubst [gv,xv] bodv and gbodc = vsubst [gc,xc] bodc in term_fmatch (gv::vars) gbodv gbodc ((gc,gv)::env) else if vtm = ctm then env else failwith "term_fmatch";; let rec check_consistency env = match env with [] -> true | (c,v)::es -> forall (fun (c',v') -> v' <> v || c' = c) es;; let separate_insts env = let tyin = itlist (fun (c,v) -> type_match (type_of v) (type_of c)) env [] in let ifn(c,v) = (inst tyin c,inst tyin v) in let tmin = setify (map ifn env) in if check_consistency tmin then (tmin,tyin) else failwith "separate_insts";; let first_order_match vars vtm ctm env = let env' = term_fmatch vars vtm ctm env in if can separate_insts env' then env' else failwith "first_order_match";; (* ------------------------------------------------------------------------- *) (* Try to match all leaves to negation of auxiliary propositions. *) (* ------------------------------------------------------------------------- *) let matchleaves = let rec matchleaves vars vtm ctms env cont = if is_conj vtm then try matchleaves vars (rand vtm) ctms env cont with Failure _ -> matchleaves vars (lhand vtm) ctms env cont else if is_disj vtm then matchleaves vars (lhand vtm) ctms env (fun e -> matchleaves vars (rand vtm) ctms e cont) else tryfind (fun ctm -> cont (first_order_match vars vtm ctm env)) ctms in fun vars vtm ctms env -> matchleaves vars vtm ctms env (fun e -> e);; (* ------------------------------------------------------------------------- *) (* Now actually do the refutation once theorem is instantiated. *) (* ------------------------------------------------------------------------- *) let rec REFUTE_LEAVES eqv cths th = let tm = concl th in if is_conj tm then try REFUTE_LEAVES eqv cths (CONJUNCT1 th) with Failure _ -> REFUTE_LEAVES eqv cths (CONJUNCT2 th) else if is_disj tm then let th1 = REFUTE_LEAVES eqv cths (ASSUME(lhand tm)) and th2 = REFUTE_LEAVES eqv cths (ASSUME(rand tm)) in DISJ_CASES th th1 th2 else tryfind (PROVE_COMPLEMENTARY eqv th) cths;; (* ------------------------------------------------------------------------- *) (* Hence the Mizar "unifier" for given universal formula. *) (* ------------------------------------------------------------------------- *) let negate tm = if is_neg tm then rand tm else mk_neg tm;; let MIZAR_UNIFIER eqv ths th = let gth = GENSPEC th in let vtm = concl gth in let vars = subtract (frees vtm) (frees(concl th)) and ctms = map (negate o concl) ths in let allctms = itlist (union o term_equivs eqv) ctms [] in let env = matchleaves vars vtm allctms [] in let tmin,tyin = separate_insts env in REFUTE_LEAVES eqv ths (PINST tyin tmin gth);; (* ------------------------------------------------------------------------- *) (* Deduce disequalities of subterms and add symmetric versions at the end. *) (* ------------------------------------------------------------------------- *) let rec DISEQUALITIES ths = match ths with [] -> [] | th::oths -> let t1,t2 = dest_eq (rand(concl th)) in let f1,args1 = strip_comb t1 and f2,args2 = strip_comb t2 in if f1 <> f2 || length args1 <> length args2 then th::(GSYM th)::(DISEQUALITIES oths) else let zargs = zip args1 args2 in let diffs = filter (fun (a1,a2) -> a1 <> a2) zargs in if length diffs <> 1 then th::(GSYM th)::(DISEQUALITIES oths) else let eths = map (fun (a1,a2) -> if a1 = a2 then REFL a1 else ASSUME(mk_eq(a1,a2))) zargs in let th1 = rev_itlist (fun x y -> MK_COMB(y,x)) eths (REFL f1) in let th2 = MP (GEN_REWRITE_RULE I [GSYM CONTRAPOS_THM] (DISCH_ALL th1)) th in th::(GSYM th)::(DISEQUALITIES(th2::oths));; (* ------------------------------------------------------------------------- *) (* Get such a starting inequality from complementary literals. *) (* ------------------------------------------------------------------------- *) let ATOMINEQUALITIES th1 th2 = let t1 = concl th1 and t2' = concl th2 in let t2 = dest_neg t2' in let f1,args1 = strip_comb t1 and f2,args2 = strip_comb t2 in if f1 <> f2 || length args1 <> length args2 then [] else let zargs = zip args1 args2 in let diffs = filter (fun (a1,a2) -> a1 <> a2) zargs in if length diffs <> 1 then [] else let eths = map (fun (a1,a2) -> if a1 = a2 then REFL a1 else ASSUME(mk_eq(a1,a2))) zargs in let th3 = rev_itlist (fun x y -> MK_COMB(y,x)) eths (REFL f1) in let th4 = EQ_MP (TRANS th3 (EQF_INTRO th2)) th1 in let th5 = NOT_INTRO(itlist (DISCH o mk_eq) diffs th4) in [itlist PROVE_HYP [th1; th2] th5];; (* ------------------------------------------------------------------------- *) (* Basic prover. *) (* ------------------------------------------------------------------------- *) let BASIC_MIZARBY ths = try let nths,pths = partition (is_neg o concl) ths in let peqs,pneqs = partition (is_eq o concl) pths and neqs,nneqs = partition (is_eq o rand o concl) nths in let tps = map (dest_eq o concl) peqs @ map (dest_eq o rand o concl) neqs in let otms = itlist (fun (x,y) l -> x::y::l) tps [] in let tms = term_universe(setify otms) in let eqv = congruence_closure tms (map lazy_eq peqs) in let eqprover th = let s,t = dest_eq(rand(concl th)) in let th' = PROVE_EQUIVALENT eqv s t in EQ_MP (EQF_INTRO th) th' and contrprover thp thn = let th = PROVE_EQUIVALENT eqv (concl thp) (rand(concl thn)) in EQ_MP (TRANS th (EQF_INTRO thn)) thp in try tryfind eqprover neqs with Failure _ -> try tryfind (fun thp -> tryfind (contrprover thp) nneqs) pneqs with Failure _ -> let new_neqs = unions(allpairs ATOMINEQUALITIES pneqs nneqs) in let allths = pneqs @ nneqs @ peqs @ DISEQUALITIES(neqs @ new_neqs) in tryfind (MIZAR_UNIFIER eqv allths) (filter (is_forall o concl) allths) with Failure _ -> failwith "BASIC_MIZARBY";; (* ------------------------------------------------------------------------- *) (* Put it all together. *) (* ------------------------------------------------------------------------- *) let MIZAR_REFUTER ths = PRECHECKER_THEN BASIC_MIZARBY ths;; (* ------------------------------------------------------------------------- *) (* The Mizar prover for getting a conclusion from hypotheses. *) (* ------------------------------------------------------------------------- *) let MIZAR_BY = let pth = TAUT `(~p ==> F) <=> p` and p_tm = `p:bool` in fun ths tm -> let tm' = mk_neg tm in let th0 = ASSUME tm' in let th1 = MIZAR_REFUTER (th0::ths) in EQ_MP (INST [tm,p_tm] pth) (DISCH tm' th1);; (* ------------------------------------------------------------------------- *) (* As a standalone prover of formulas. *) (* ------------------------------------------------------------------------- *) let MIZAR_RULE tm = MIZAR_BY [] tm;; (* ------------------------------------------------------------------------- *) (* Some additional stuff for HOL. *) (* ------------------------------------------------------------------------- *) let HOL_BY = let BETASET_CONV = TOP_DEPTH_CONV GEN_BETA_CONV THENC REWRITE_CONV[IN_ELIM_THM] and BUILTIN_CONV tm = try EQT_ELIM(NUM_REDUCE_CONV tm) with Failure _ -> try EQT_ELIM(REAL_RAT_REDUCE_CONV tm) with Failure _ -> try ARITH_RULE tm with Failure _ -> try REAL_ARITH tm with Failure _ -> failwith "BUILTIN_CONV" in fun ths tm -> try MIZAR_BY ths tm with Failure _ -> try tryfind (fun th -> PART_MATCH I th tm) ths with Failure _ -> try let avs,bod = strip_forall tm in let gvs = map (genvar o type_of) avs in let gtm = vsubst (zip gvs avs) bod in let th = tryfind (fun th -> PART_MATCH I th gtm) ths in let gth = GENL gvs th in EQ_MP (ALPHA (concl gth) tm) gth with Failure _ -> try (let ths' = map BETA_RULE ths and th' = TOP_DEPTH_CONV BETA_CONV tm in let tm' = rand(concl th') in try EQ_MP (SYM th') (tryfind (fun th -> PART_MATCH I th tm') ths) with Failure _ -> try EQ_MP (SYM th') (BUILTIN_CONV tm') with Failure _ -> let ths'' = map (CONV_RULE BETASET_CONV) ths' and th'' = TRANS th' (BETASET_CONV tm') in EQ_MP (SYM th'') (prove(rand(concl th''),MESON_TAC ths''))) with Failure _ -> failwith "HOL_BY";; (* ------------------------------------------------------------------------- *) (* Standalone prover, breaking down an implication first. *) (* ------------------------------------------------------------------------- *) let HOL_RULE tm = try let l,r = dest_imp tm in DISCH l (HOL_BY (CONJUNCTS(ASSUME l)) r) with Failure _ -> HOL_BY [] tm;; (* ------------------------------------------------------------------------- *) (* Tautology examples (Pelletier problems). *) (* ------------------------------------------------------------------------- *) let prop_1 = time HOL_RULE `p ==> q <=> ~q ==> ~p`;; let prop_2 = time HOL_RULE `~ ~p <=> p`;; let prop_3 = time HOL_RULE `~(p ==> q) ==> q ==> p`;; let prop_4 = time HOL_RULE `~p ==> q <=> ~q ==> p`;; let prop_5 = time HOL_RULE `(p \/ q ==> p \/ r) ==> p \/ (q ==> r)`;; let prop_6 = time HOL_RULE `p \/ ~p`;; let prop_7 = time HOL_RULE `p \/ ~ ~ ~p`;; let prop_8 = time HOL_RULE `((p ==> q) ==> p) ==> p`;; let prop_9 = time HOL_RULE `(p \/ q) /\ (~p \/ q) /\ (p \/ ~q) ==> ~(~q \/ ~q)`;; let prop_10 = time HOL_RULE `(q ==> r) /\ (r ==> p /\ q) /\ (p ==> q /\ r) ==> (p <=> q)`;; let prop_11 = time HOL_RULE `p <=> p`;; let prop_12 = time HOL_RULE `((p <=> q) <=> r) <=> (p <=> (q <=> r))`;; let prop_13 = time HOL_RULE `p \/ q /\ r <=> (p \/ q) /\ (p \/ r)`;; let prop_14 = time HOL_RULE `(p <=> q) <=> (q \/ ~p) /\ (~q \/ p)`;; let prop_15 = time HOL_RULE `p ==> q <=> ~p \/ q`;; let prop_16 = time HOL_RULE `(p ==> q) \/ (q ==> p)`;; let prop_17 = time HOL_RULE `p /\ (q ==> r) ==> s <=> (~p \/ q \/ s) /\ (~p \/ ~r \/ s)`;; (* ------------------------------------------------------------------------- *) (* Congruence closure examples. *) (* ------------------------------------------------------------------------- *) time HOL_RULE `(f(f(f(f(f(x))))) = x) /\ (f(f(f(x))) = x) ==> (f(x) = x)`;; time HOL_RULE `(f(f(f(f(f(f(x)))))) = x) /\ (f(f(f(f(x)))) = x) ==> (f(f(x)) = x)`;; time HOL_RULE `(f a = a) ==> (f(f a) = a)`;; time HOL_RULE `(a = f a) /\ ((g b (f a))=(f (f a))) /\ ((g a b)=(f (g b a))) ==> (g a b = a)`;; time HOL_RULE `((s(s(s(s(s(s(s(s(s(s(s(s(s(s(s a)))))))))))))))=a) /\ ((s (s (s (s (s (s (s (s (s (s a))))))))))=a) /\ ((s (s (s (s (s (s a))))))=a) ==> (a = s a)`;; time HOL_RULE `(u = v) ==> (P u <=> P v)`;; time HOL_RULE `(b + c + d + e + f + g + h + i + j + k + l + m = m + l + k + j + i + h + g + f + e + d + c + b) ==> (a + b + c + d + e + f + g + h + i + j + k + l + m = a + m + l + k + j + i + h + g + f + e + d + c + b)`;; time HOL_RULE `(f(f(f(f(a)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ something(irrelevant) /\ (11 + 12 = 23) /\ (f(f(f(f(b)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ P(f(f(f(a)))) ==> P(f(a))`;; time HOL_RULE `((a = b) \/ (c = d)) /\ ((a = c) \/ (b = d)) ==> (a = d) \/ (b = c)`;; (* ------------------------------------------------------------------------- *) (* Various combined examples. *) (* ------------------------------------------------------------------------- *) time HOL_RULE `(f(f(f(f(a:A)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ something(irrelevant) /\ (11 + 12 = 23) /\ (f(f(f(f(b:A)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ P(f(a)) /\ ~(f(f(f(a))) = f(a)) ==> ?x. P(f(f(f(x))))`;; time HOL_RULE `(f(f(f(f(a:A)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ something(irrelevant) /\ (11 + 12 = 23) /\ (f(f(f(f(b:A)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ P(f(a)) ==> P(f(f(f(a))))`;; time HOL_RULE `(f(f(f(f(a:A)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ something(irrelevant) /\ (11 + 12 = 23) /\ (f(f(f(f(b:A)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ P(f(a)) ==> ?x. P(f(f(f(x))))`;; time HOL_RULE `(a = f a) /\ ((g b (f a))=(f (f a))) /\ ((g a b)=(f (g b a))) /\ (!x y. ~P (g x y)) ==> ~P(a)`;; time HOL_RULE `(!x y. x + y = y + x) /\ (1 + 2 = x) /\ (x = 3) ==> (3 = 2 + 1)`;; time HOL_RULE `(!x:num y. x + y = y + x) ==> (1 + 2 = 2 + 1)`;; time HOL_RULE `(!x:num y. ~(x + y = y + x)) ==> ~(1 + 2 = 2 + 1)`;; time HOL_RULE `(1 + 2 = 2 + 1) ==> ?x:num y. x + y = y + x`;; time HOL_RULE `(1 + x = x + 1) ==> ?x:num y. x + y = y + x`;; time (HOL_BY []) `?x. P x ==> !y. P y`;; (* ------------------------------------------------------------------------- *) (* Testing the HOL extensions. *) (* ------------------------------------------------------------------------- *) time HOL_RULE `1 + 1 = 2`;; time HOL_RULE `(\x. x + 1) 2 = 2 + 1`;; time HOL_RULE `!x. x < 2 ==> 2 * x <= 3`;; time HOL_RULE `y IN {x | x < 2} <=> y < 2`;; time HOL_RULE `(!x. (x = a) \/ x > a) ==> (1 + x = a) \/ 1 + x > a`;; time HOL_RULE `(\(x,y). x + y)(1,2) + 5 = (1 + 2) + 5`;; (* ------------------------------------------------------------------------- *) (* These and only these should go to MESON. *) (* ------------------------------------------------------------------------- *) print_string "***** Now the following (only) should use MESON"; print_newline();; time HOL_RULE `?x y. x = y`;; time HOL_RULE `(!Y X Z. p(X,Y) /\ p(Y,Z) ==> p(X,Z)) /\ (!Y X Z. q(X,Y) /\ q(Y,Z) ==> q(X,Z)) /\ (!Y X. q(X,Y) ==> q(Y,X)) /\ (!X Y. p(X,Y) \/ q(X,Y)) ==> p(a,b) \/ q(c,d)`;; time HOL_BY [PAIR_EQ] `(1,2) IN {(x,y) | x < y} <=> 1 < 2`;; HOL_BY [] `?x. !y. P x ==> P y`;; hol-light/Examples/inverse_bug_puzzle_miz3.ml000066400000000000000000000521161303454263000217450ustar00rootroot00000000000000(* ========================================================================= *) (* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* Proof of the Bug Puzzle conjecture of the HOL Light tutorial: *) (* Any two triples with the same oriented area can be connected in *) (* 5 moves or less (FiveMovesOrLess). Also a proof that 4 moves is not *) (* enough, with an explicit counterexample. This result (NOTENOUGH_4) *) (* is due to John Harrison, as is much of the basic vector code, and *) (* the definition of move, which defines a closed subset *) (* {(A,B,C,A',B',C') | move (A,B,C) (A',B',C')} subset R^6 x R^6 *) (* and also a result FiveMovesOrLess_STRONG that handles the degenerate *) (* case (the two triples not required to be non-collinear), which has a *) (* very satisfying answer using this "closed" definition of move. *) (* *) (* The mathematical proofs are essentially due to Tom Hales. The *) (* code is all in miz3, and was an attempt to explore Freek Wiedijk's *) (* vision of mixing the procedural and declarative proof styles. *) (* ========================================================================= *) needs "Multivariate/determinants.ml";; #load "unix.cma";; loadt "miz3/miz3.ml";; new_type_abbrev("triple",`:real^2#real^2#real^2`);; default_prover := ("ya prover", fun thl -> REWRITE_TAC thl THEN CONV_TAC (HOL_BY thl));; horizon := 0;; timeout := 500;; let VEC2_TAC = SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; vector_add; vec; dot; orthogonal; basis; vector_neg; vector_sub; vector_mul; ARITH] THEN CONV_TAC REAL_RING;; let COLLINEAR_3_2Dzero = thm `; !y z:real^2. collinear{vec 0,y,z} <=> z$1 * y$2 = y$1 * z$2 by REWRITE_TAC[COLLINEAR_3_2D] THEN VEC2_TAC; `;; let Noncollinear_3ImpliesDistinct = thm `; !a b c:real^N. ~collinear {a,b,c} ==> ~(a = b) /\ ~(a = c) /\ ~(b = c) by COLLINEAR_BETWEEN_CASES, BETWEEN_REFL; `;; let collinearSymmetry = thm `; let A B C be real^N; thus collinear {A,B,C} ==> collinear {A,C,B} /\ collinear {B,A,C} /\ collinear {B,C,A} /\ collinear {C,A,B} /\ collinear {C,B,A} proof {A,C,B} SUBSET {A,B,C} /\ {B,A,C} SUBSET {A,B,C} /\ {B,C,A} SUBSET {A,B,C} /\ {C,A,B} SUBSET {A,B,C} /\ {C,B,A} SUBSET {A,B,C} by SET_RULE; qed by -, COLLINEAR_SUBSET; `;; let Noncollinear_2Span = thm `; let u v w be real^2; assume ~collinear {vec 0,v,w} [H1]; thus ? s t. s % v + t % w = u proof !n r. ~(r < n) /\ r <= MIN n n ==> r = n [easy_arith] by ARITH_RULE; ~(w$1 * v$2 = v$1 * w$2) [H1'] by H1, COLLINEAR_3_2Dzero; consider M such that M = transp(vector[v;w]):real^2^2 [Mexists]; det M = v$1 * w$2 - w$1 * v$2 by -, DIMINDEX_2, SUM_2, TRANSP_COMPONENT, VECTOR_2, LAMBDA_BETA, ARITH, CART_EQ, FORALL_2, DET_2; ~(det M = &0) by -, H1', REAL_ARITH; consider x s t such that M ** x = u /\ s = x$1 /\ t = x$2 by -, easy_arith, DET_EQ_0_RANK, RANK_BOUND, MATRIX_FULL_LINEAR_EQUATIONS; v$1 * s + w$1 * t = u$1 /\ v$2 * s + w$2 * t = u$2 by Mexists, -, SIMP_TAC[matrix_vector_mul; DIMINDEX_2; SUM_2; TRANSP_COMPONENT; VECTOR_2; LAMBDA_BETA; ARITH; CART_EQ; FORALL_2] THEN MESON_TAC[]; s % v + t % w = u by -, REAL_MUL_SYM, VECTOR_MUL_COMPONENT, VECTOR_ADD_COMPONENT, VEC2_TAC; qed by -; `;; let oriented_area = new_definition `oriented_area (a:real^2,b:real^2,c:real^2) = ((b$1 - a$1) * (c$2 - a$2) - (c$1 - a$1) * (b$2 - a$2)) / &2`;; let oriented_areaSymmetry = thm `; !A B C A' B' C':real^2. oriented_area (A,B,C) = oriented_area(A',B',C') ==> oriented_area (B,C,A) = oriented_area (B',C',A') /\ oriented_area (C,A,B) = oriented_area (C',A',B') /\ oriented_area (A,C,B) = oriented_area (A',C',B') /\ oriented_area (B,A,C) = oriented_area (B',A',C') /\ oriented_area (C,B,A) = oriented_area (C',B',A') by REWRITE_TAC[oriented_area] THEN VEC2_TAC; `;; let move = new_definition `!A B C A' B' C':real^2. move (A,B,C) (A',B',C') <=> (B = B' /\ C = C' /\ collinear {vec 0,C - B,A' - A} \/ A = A' /\ C = C' /\ collinear {vec 0,C - A,B' - B} \/ A = A' /\ B = B' /\ collinear {vec 0,B - A,C' - C})`;; let moveInvariant = thm `; let p p' be triple; assume move p p' [H1]; thus oriented_area p = oriented_area p' proof consider X Y Z X' Y' Z' such that p = X,Y,Z /\ p' = X',Y',Z' [pDef] by PAIR_SURJECTIVE; move (X,Y,Z) (X',Y',Z') by -, H1; oriented_area (X,Y,Z) = oriented_area (X',Y',Z') by -, SIMP_TAC[move; oriented_area; COLLINEAR_3; COLLINEAR_3_2Dzero] THEN VEC2_TAC; qed by -, pDef; `;; let reachable = new_definition `!p p'. reachable p p' <=> ?n. ?s. s 0 = p /\ s n = p' /\ (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; let reachableN = new_definition `!p p'. !n. reachableN p p' n <=> ?s. s 0 = p /\ s n = p' /\ (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; let ReachLemma = thm `; !p p'. reachable p p' <=> ?n. reachableN p p' n by reachable, reachableN; `;; let reachableN_CLAUSES = thm `; ! p p'. (reachableN p p' 0 <=> p = p') /\ ! n. reachableN p p' (SUC n) <=> ? q. reachableN p q n /\ move q p' proof let p p' be triple; consider s0 such that s0 = \m:num. p'; reachableN p p' 0 <=> p = p' [0CLAUSE] by -, reachableN, LT, LE_0; ! n. reachableN p p' (SUC n) ==> ? q. reachableN p q n /\ move q p' [Imp1] proof let n be num; assume reachableN p p' (SUC n) [H1]; consider s such that s 0 = p /\ s (SUC n) = p' /\ !m. m < SUC n ==> move (s m) (s (SUC m)) [sDef] by H1, LE_0, reachableN; consider q such that q = s n; qed by sDef, -, LE_0, reachableN, LT; ! n. (? q. reachableN p q n /\ move q p') ==> reachableN p p' (SUC n) proof let n be num; assume ? q. reachableN p q n /\ move q p'; consider q such that reachableN p q n /\ move q p' [qExists] by -; consider s such that s 0 = p /\ s n = q /\ !m. m < n ==> move (s m) (s (SUC m)) [sDef] by -, reachableN, LT, LE_0; consider t such that t = \m. if m < SUC n then s m else p'; t 0 = p /\ t (SUC n) = p' /\ !m. m < SUC n ==> move (t m) (t (SUC m)) [tProp] by qExists, sDef, -, LT_0, LT_REFL, LT, LT_SUC; qed by -, reachableN, LT, LE_0; qed by 0CLAUSE, Imp1, -; `;; let reachableInvariant = thm `; !p p':triple. reachable p p' ==> oriented_area p = oriented_area p' proof !n. !p p'. reachableN p p' n ==> oriented_area p = oriented_area p' by INDUCT_TAC THEN ASM_MESON_TAC[reachableN_CLAUSES; moveInvariant]; qed by -, ReachLemma; `;; let move2Cond = new_definition `move2Cond (A,B,C) (A',B',C') <=> ~collinear {B,A,A'} /\ ~collinear {A',B,B'} \/ ~collinear {A,B,B'} /\ ~collinear {B',A,A'}`;; let reachableN_Two = thm `; !P0 P2:triple. reachableN P0 P2 2 <=> ?P1. move P0 P1 /\ move P1 P2 by ONE, TWO, reachableN_CLAUSES; `;; let reachableN_Three = thm `; !P0 P3:triple. reachableN P0 P3 3 <=> ?P1 P2. move P0 P1 /\ move P1 P2 /\ move P2 P3 proof 3 = SUC 2 by ARITH_RULE; qed by -, reachableN_Two, reachableN_CLAUSES; `;; let reachableN_Four = thm `; !P0 P4:triple. reachableN P0 P4 4 <=> ?P1 P2 P3. move P0 P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 proof 4 = SUC 3 by ARITH_RULE; qed by -, reachableN_Three, reachableN_CLAUSES; `;; let moveSymmetry = thm `; let A B C A' B' C' be real^2; assume move (A,B,C) (A',B',C') [H1]; thus move (B,C,A) (B',C',A') /\ move (C,A,B) (C',A',B') /\ move (A,C,B) (A',C',B') /\ move (B,A,C) (B',A',C') /\ move (C,B,A) (C',B',A') proof !A B C A':real^2. collinear {vec 0, C - B, A' - A} ==> collinear {vec 0, B - C, A' - A} by REWRITE_TAC[COLLINEAR_3_2Dzero] THEN VEC2_TAC; qed by H1, -, move; `;; let reachableNSymmetry = thm `; ! A B C A' B' C' n. reachableN (A,B,C) (A',B',C') n ==> reachableN (B,C,A) (B',C',A') n /\ reachableN (C,A,B) (C',A',B') n /\ reachableN (A,C,B) (A',C',B') n /\ reachableN (B,A,C) (B',A',C') n /\ reachableN (C,B,A) (C',B',A') n proof let A B C be real^2; consider Q such that Q = \n A' B' C'. reachableN (B,C,A) (B',C',A') n /\ reachableN (C,A,B) (C',A',B') n /\ reachableN (A,C,B) (A',C',B') n /\ reachableN (B,A,C) (B',A',C') n /\ reachableN (C,B,A) (C',B',A') n [Qdef]; consider P such that P = \n. ! A' B' C'. reachableN (A,B,C) (A',B',C') n ==> Q n A' B' C' [Pdef]; P 0 [Base] by -, Qdef, reachableN_CLAUSES, PAIR_EQ; !n. P n ==> P (SUC n) proof let n be num; assume P n [Pn]; ! A' B' C'. reachableN (A,B,C) (A',B',C') (SUC n) ==> Q (SUC n) A' B' C' proof let A' B' C' be real^2; assume reachableN (A,B,C) (A',B',C') (SUC n); consider X Y Z such that reachableN (A,B,C) (X,Y,Z) n /\ move (X,Y,Z) (A',B',C') [XYZdef] by -, reachableN_CLAUSES, PAIR_SURJECTIVE; qed by -, Qdef, Pdef, Pn, XYZdef, moveSymmetry, reachableN_CLAUSES; qed by -, Pdef; !n. P n by Base, -, INDUCT_TAC; qed by -, Pdef, Qdef; `;; let ORIENTED_AREA_COLLINEAR_CONG = thm `; let A B C A' B' C' be real^2; assume oriented_area (A,B,C) = oriented_area (A',B',C') [H1]; thus collinear {A,B,C} <=> collinear {A',B',C'} by H1, REWRITE_TAC[COLLINEAR_3_2D; oriented_area] THEN CONV_TAC REAL_RING; `;; let Basic2move_THM = thm `; let A B C A' be real^2; assume ~collinear {A,B,C} [H1]; assume ~collinear {B,A,A'} [H2]; thus ? X. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) proof !r. r % (A - B) = (--r) % (B - A) /\ r % (A - B) = r % (A - B) + &0 % (C - B) [add0vector_mul] by VEC2_TAC; ~ ? r. A' - A = r % (A - B) [H2'] by H2, COLLINEAR_3, COLLINEAR_LEMMA, -; consider r t such that A' - A = r % (A - B) + t % (C - B) [rExists] by H1, COLLINEAR_3, Noncollinear_2Span; ~(t = &0) [tNonzero] by -, add0vector_mul, H2'; consider s X such that s = r / t /\ X = C + s % (A - B) [Xexists] by rExists; A' - A = (t * s) % (A - B) + t % (C - B) by rExists, -, tNonzero, REAL_DIV_LMUL; A' - A = t % (X - B) [tProp] by -, Xexists, VEC2_TAC; X - C = (-- s) % (B - A) by -, Xexists, VEC2_TAC; collinear {vec 0,B - A,X - C} /\ collinear {vec 0,X - B,A' - A} by -, tProp, COLLINEAR_LEMMA; qed by -, move; `;; let FourStepMoveAB = thm `; let A B C A' B' C' be real^2; assume ~collinear {A,B,C} [H1]; assume ~collinear {B,A,A'} /\ ~collinear {A',B,B'} [H2]; thus ? X Y. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) /\ move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y) proof consider X such that move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) [ABX] by H1, H2, -, Basic2move_THM; ~collinear {A,B,X} /\ ~collinear {A',B,X} by H1, -, moveInvariant, ORIENTED_AREA_COLLINEAR_CONG; ~collinear {B,A',X} by -, collinearSymmetry; consider Y such that move (B,A',X) (B,A',Y) /\ move (B,A',Y) (B',A',Y) by -, H2, Basic2move_THM; move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y) by -, moveSymmetry; qed by -, ABX; `;; let FourStepMoveABBAreach = thm `; let A B C A' B' C' be real^2; assume ~collinear {A,B,C} [H1]; assume move2Cond (A,B,C) (A',B',C') [H2]; thus ? Y. reachableN (A,B,C) (A',B',Y) 4 proof cases by H2, move2Cond; suppose ~collinear {B,A,A'} /\ ~collinear {A',B,B'}; qed by H1, -, FourStepMoveAB, reachableN_Four; suppose ~collinear {A,B,B'} /\ ~collinear {B',A,A'} [Case2]; ~collinear {B,A,C} by H1, collinearSymmetry; consider X Y such that move (B,A,C) (B,A,X) /\ move (B,A,X) (B',A,X) /\ move (B',A,X) (B',A,Y) /\ move (B',A,Y) (B',A',Y) by -, Case2, FourStepMoveAB; qed by -, moveSymmetry, reachableN_Four; end; `;; let NotMove2Impliescollinear = thm `; let A B C A' B' C' be real^2; assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; assume ~(A = A') /\ ~(B = B') [H2]; assume ~move2Cond (A,B,C) (A',B',C') [H3]; thus collinear {A,B,A',B'} proof ~(A = B) /\ ~(A' = B') [Distinct] by H1, Noncollinear_3ImpliesDistinct; {A,B,A',B'} SUBSET {A,A',B,B'} /\ {A,B,A',B'} SUBSET {B,B',A',A} /\ {A,B,A',B'} SUBSET {A',B',B,A} [set4symmetry] by SET_RULE; cases by H3, move2Cond; suppose collinear {B,A,A'} /\ collinear {A,B,B'}; collinear {A,B,A'} /\ collinear {A,B,B'} by -, collinearSymmetry; qed by Distinct, -, COLLINEAR_4_3; suppose collinear {B,A,A'} /\ collinear {B',A,A'}; collinear {A,A',B} /\ collinear {A,A',B'} by -, collinearSymmetry; collinear {A,A',B,B'} by H2, -, COLLINEAR_4_3; qed by -, set4symmetry, COLLINEAR_SUBSET; suppose collinear {A',B,B'} /\ collinear {A,B,B'}; collinear {B,B',A'} /\ collinear {B,B',A} by -, collinearSymmetry; collinear {B,B',A',A} by H2, -, COLLINEAR_4_3; qed by -, set4symmetry, COLLINEAR_SUBSET; suppose collinear {A',B,B'} /\ collinear {B',A,A'}; collinear {A',B',B} /\ collinear {A',B',A} by -, collinearSymmetry; collinear {A',B',B,A} by Distinct, -, COLLINEAR_4_3; qed by -, set4symmetry, COLLINEAR_SUBSET; end; `;; let DistinctImplies2moveable = thm `; let A B C A' B' C' be real^2; assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; assume ~(A = A') /\ ~(B = B') /\ ~(C = C') [H2]; thus move2Cond (A,B,C) (A',B',C') \/ move2Cond (B,C,A) (B',C',A') proof {A, B, B'} SUBSET {A, B, A', B'} /\ {B,B',C} SUBSET {B,C,B',C'} [3subset4] by SET_RULE; ~collinear {B,C,A} /\ ~collinear {B',C',A'} [H1'] by H1, collinearSymmetry; assume ~(move2Cond (A,B,C) (A',B',C') \/ move2Cond (B,C,A) (B',C',A')); ~move2Cond (A,B,C) (A',B',C') /\ ~move2Cond (B,C,A) (B',C',A') by -; collinear {A, B, A', B'} /\ collinear {B,C,B',C'} by H1, H1', -, H2, NotMove2Impliescollinear; collinear {A, B, B'} /\ collinear {B,B',C} by -, 3subset4, COLLINEAR_SUBSET; collinear {A, B, C} by -, H2, COLLINEAR_3_TRANS; qed by -, H1; `;; let SameCdiffAB = thm `; let A B C A' B' C' be real^2; assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; assume C = C' /\ ~(A = A') /\ ~(B = B') [H2]; thus ? Y. reachableN (A,B,C) (Y,B',C') 2 \/ reachableN (A,B,C) (A',B',Y) 4 proof {B,B',A} SUBSET {A,B,A',B'} /\ {A,B,C} SUBSET {B,B',A,C} [easy_set] by SET_RULE; cases; suppose ~collinear {C,B,B'}; consider X such that move (B,C,A) (B,C,X) /\ move (B,C,X) (B',C',X) by H1, collinearSymmetry, -, H2, Basic2move_THM; qed by -, reachableN_Two, reachableNSymmetry; suppose move2Cond (A,B,C) (A',B',C'); qed by H1, -, FourStepMoveABBAreach; suppose collinear {C,B,B'} /\ ~move2Cond (A,B,C) (A',B',C'); collinear {B,B',A} /\ collinear {B,B',C} by H1, H2, -, NotMove2Impliescollinear, easy_set, COLLINEAR_SUBSET, collinearSymmetry; qed by -, H2, COLLINEAR_4_3, easy_set, COLLINEAR_SUBSET, H1; end; `;; let FourMovesToCorrectTwo = thm `; let A B C A' B' C' be real^2; assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; thus ? n. n < 5 /\ ? Y. reachableN (A,B,C) (A',B',Y) n \/ reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n proof ~collinear {B,C,A} /\ ~collinear {B',C',A'} /\ ~collinear {C,A,B} /\ ~collinear {C',A',B'} [H1'] by H1, collinearSymmetry; 0 < 5 /\ 2 < 5 /\ 3 < 5 /\ 4 < 5 [easy_arith] by ARITH_RULE; cases; suppose A = A' /\ B = B' /\ C = C' \/ A = A' /\ B = B' /\ ~(C = C') \/ A = A' /\ ~(B = B') /\ C = C' \/ ~(A = A') /\ B = B' /\ C = C'; reachableN (A,B,C) (A',B',C') 0 \/ reachableN (A,B,C) (A',B',C) 0 \/ reachableN (A,B,C) (A',B,C') 0 \/ reachableN (A,B,C) (A,B',C') 0 by -, reachableN_CLAUSES; qed by -, easy_arith; suppose A = A' /\ ~(B = B') /\ ~(C = C') \/ ~(A = A') /\ B = B' /\ ~(C = C') \/ ~(A = A') /\ ~(B = B') /\ C = C'; qed by H1, H1', -, SameCdiffAB, reachableNSymmetry, easy_arith; suppose ~(A = A') /\ ~(B = B') /\ ~(C = C'); move2Cond (A,B,C) (A',B',C') \/ move2Cond (B,C,A) (B',C',A') by H1, -, DistinctImplies2moveable; qed by H1, H1', -, FourStepMoveABBAreach, reachableNSymmetry, reachableN_Four, easy_arith; end; `;; let CorrectFinalPoint = thm `; let A B C A' C' be real^2; assume oriented_area (A,B,C) = oriented_area (A,B,C') [H1]; thus move (A,B,C) (A,B,C') proof ((B$1 - A$1) * (C$2 - A$2) - (C$1 - A$1) * (B$2 - A$2)) / &2 = ((B$1 - A$1) * (C'$2 - A$2) - (C'$1 - A$1) * (B$2 - A$2)) / &2 by H1, oriented_area; (C$1 - C'$1) * (B$2 - A$2) = (B$1 - A$1) * (C$2 - C'$2) by -, REAL_ARITH; (C' - C)$1 * (B - A)$2 = (B - A)$1 * (C' - C)$2 by -, VEC2_TAC; collinear {vec 0, B - A, C' - C} by -, COLLINEAR_3_2Dzero; qed by -, move; `;; let FiveMovesOrLess = thm `; let A B C A' B' C' be real^2; assume ~collinear {A,B,C} [H1]; assume oriented_area (A,B,C) = oriented_area (A',B',C') [H2]; thus ? n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n proof ~collinear {A',B',C'} [H1'] by H1, H2, ORIENTED_AREA_COLLINEAR_CONG; ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~(A' = B') /\ ~(A' = C') /\ ~(B' = C') [Distinct] by H1, -, Noncollinear_3ImpliesDistinct; consider n Y such that n < 5 /\ (reachableN (A,B,C) (A',B',Y) n \/ reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n) [2Correct] by H1, H1', FourMovesToCorrectTwo; cases by 2Correct; suppose reachableN (A,B,C) (A',B',Y) n [Case]; oriented_area (A',B',Y) = oriented_area (A',B',C') by H2, -, ReachLemma, reachableInvariant; move (A',B',Y) (A',B',C') by -, Distinct, CorrectFinalPoint; qed by Case, -, reachableN_CLAUSES, 2Correct, LE_SUC_LT; suppose reachableN (A,B,C) (A',Y,C') n [Case]; oriented_area (A',C',Y) = oriented_area (A',C',B') by H2, -, ReachLemma, reachableInvariant, oriented_areaSymmetry; move (A',Y,C') (A',B',C') by -, Distinct, CorrectFinalPoint, moveSymmetry; qed by Case, -, reachableN_CLAUSES, 2Correct, LE_SUC_LT; suppose reachableN (A,B,C) (Y,B',C') n [Case]; oriented_area (B',C',Y) = oriented_area (B',C',A') by H2, -, ReachLemma, reachableInvariant, oriented_areaSymmetry; move (Y,B',C') (A',B',C') by -, Distinct, CorrectFinalPoint, moveSymmetry; qed by Case, -, reachableN_CLAUSES, 2Correct, LE_SUC_LT; end; `;; let NOTENOUGH_4 = thm `; ?p0 p4. oriented_area p0 = oriented_area p4 /\ ~reachableN p0 p4 4 proof consider p0 p4 such that p0 = vector [&0;&0]:real^2,vector [&0;&1]:real^2,vector [&1;&0]:real^2 /\ p4 = vector [&1;&1]:real^2,vector [&1;&2]:real^2,vector [&2;&1]:real^2 [p04Def]; oriented_area p0 = oriented_area p4 [equal_areas] by -, ASM_REWRITE_TAC[oriented_area] THEN VEC2_TAC; ~reachableN p0 p4 4 by p04Def, ASM_REWRITE_TAC[reachableN_Four; NOT_EXISTS_THM; FORALL_PAIR_THM; move; COLLINEAR_3_2Dzero; FORALL_VECTOR_2] THEN VEC2_TAC; qed by equal_areas, -; `;; let reachableN_Five = thm `; !P0 P5:triple. reachableN P0 P5 5 <=> ?P1 P2 P3 P4. move P0 P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 /\ move P4 P5 proof 5 = SUC 4 by ARITH_RULE; qed by -, reachableN_CLAUSES, reachableN_Four; `;; let EasyCollinearMoves = thm `; (!A A' B:real^2. move (A:real^2,B,B) (A',B,B)) /\ !A B B' C:real^2. collinear {A:real^2,B,C} /\ collinear {A,B',C} ==> move (A,B,C) (A,B',C) by REWRITE_TAC[move; COLLINEAR_3_2D] THEN VEC2_TAC; `;; let FiveMovesOrLess_STRONG = thm `; let A B C A' B' C' be real^2; assume oriented_area (A,B,C) = oriented_area (A',B',C') [H1]; thus ?n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n proof {A,C,C} = {A,C} /\ {B',C,C} = {B',C} /\ {B',B',C} = {B',C} /\ {B',B',C'} = {B',C'} [easy_sets] by SET_RULE; cases; suppose ~collinear {A,B,C}; qed by -, H1, FiveMovesOrLess; suppose collinear {A,B,C} [ABCcol]; collinear {A',B',C'} [A'B'C'col] by -, H1, ORIENTED_AREA_COLLINEAR_CONG; consider P1 P2 P3 P4 such that P1 = A,C,C /\ P2 = B',C,C /\ P3 = B',B',C /\ P4 = B',B',C'; move (A,B,C) P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 /\ move P4 (A',B',C') by -, ABCcol, A'B'C'col, easy_sets, COLLINEAR_2, collinearSymmetry, moveSymmetry, EasyCollinearMoves; qed by -, reachableN_Five, LE_REFL; end; `;; hol-light/Examples/inverse_bug_puzzle_tac.ml000066400000000000000000000536421303454263000216370ustar00rootroot00000000000000(* ========================================================================= *) (* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* Proof of the Bug Puzzle conjecture of the HOL Light tutorial: Any two *) (* triples of points in the plane with the same oriented area can be *) (* connected in 5 moves or less (FivemovesOrLess). Much of the code is *) (* due to John Harrison: a proof (NOTENOUGH_4) showing this is the best *) (* possible result; an early version of Noncollinear_2Span; the *) (* definition of move, which defines a closed subset *) (* {(A,B,C,A',B',C') | move (A,B,C) (A',B',C')} of R^6 x R^6, *) (* i.e. the zero set of a continuous function; FivemovesOrLess_STRONG, *) (* which handles the degenerate case (collinear or non-distinct triples), *) (* giving a satisfying answer using this "closed" definition of move. *) (* *) (* The mathematical proofs are essentially due to Tom Hales. The code *) (* tries to mix declarative and procedural proof styles, using ideas due *) (* to John Harrison (section 12.1 "Towards more readable proofs" of the *) (* HOL Light tutorial), Freek Wiedijk (arxiv.org/pdf/1201.3601 "A *) (* Synthesis of the Procedural and Declarative Styles of Interactive *) (* Theorem Proving"), Marco Maggesi, who wrote the tactic constructs *) (* INTRO_TAC & HYP, which goes well with the older SUBGOAL_TAC, and Petros *) (* Papapanagiotou, coauthor of IsabelleLight, who wrote BuildExist below, a *) (* a crucial part of consider. *) (* ========================================================================= *) needs "Multivariate/determinants.ml";; new_type_abbrev("triple",`:real^2#real^2#real^2`);; let so = fun tac -> FIRST_ASSUM MP_TAC THEN tac;; let BuildExist x t = let try_type tp tm = try inst (type_match (type_of tm) tp []) tm with Failure _ -> tm in (* Check if two variables match allowing only type instantiations: *) let vars_match tm1 tm2 = let inst = try term_match [] tm1 tm2 with Failure _ -> [],[tm2,tm1],[] in match inst with [],[],_ -> tm2 | _ -> failwith "vars_match: no match" in (* Find the type of a matching variable in t. *) let tp = try type_of (tryfind (vars_match x) (frees t)) with Failure _ -> warn true ("BuildExist: `" ^ string_of_term x ^ "` not be found in `" ^ string_of_term t ^ "`") ; type_of x in (* Try to force x to type tp. *) let x' = try_type tp x in mk_exists (x',t);; let consider vars_SuchThat t prfs lab = (* Functions ident and parse_using borrowed from HYP in tactics.ml *) let ident = function Ident s::rest when isalnum s -> s,rest | _ -> raise Noparse in let parse_using = many ident in let rec findSuchThat = function n -> if String.sub vars_SuchThat n 9 = "such that" then n else findSuchThat (n + 1) in let n = findSuchThat 1 in let vars = String.sub vars_SuchThat 0 (n - 1) in let xl = map parse_term ((fst o parse_using o lex o explode) vars) in let tm = itlist BuildExist xl t in match prfs with p::ps -> (warn (ps <> []) "consider: additional subproofs ignored"; SUBGOAL_THEN tm (DESTRUCT_TAC ("@" ^ vars ^ "." ^ lab)) THENL [p; ALL_TAC]) | [] -> failwith "consider: no subproof given";; let cases sDestruct disjthm tac = SUBGOAL_TAC "" disjthm tac THEN FIRST_X_ASSUM (DESTRUCT_TAC sDestruct);; let raa lab t tac = SUBGOAL_THEN (mk_imp(t, `F`)) (LABEL_TAC lab) THENL [INTRO_TAC lab; tac];; let VEC2_TAC = SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; vector_add; vec; dot; orthogonal; basis; vector_neg; vector_sub; vector_mul; ARITH] THEN CONV_TAC REAL_RING;; let COLLINEAR_3_2Dzero = prove (`!y z:real^2. collinear{vec 0,y,z} <=> z$1 * y$2 = y$1 * z$2`, REWRITE_TAC[COLLINEAR_3_2D] THEN VEC2_TAC);; let Noncollinear_3ImpliesDistinct = prove (`~collinear {a,b,c} ==> ~(a = b) /\ ~(a = c) /\ ~(b = c)`, MESON_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_REFL]);; let collinearSymmetry = prove (`collinear {A,B,C} ==> collinear {A,C,B} /\ collinear {B,A,C} /\ collinear {B,C,A} /\ collinear {C,A,B} /\ collinear {C,B,A}`, MESON_TAC[SET_RULE `{A,C,B} SUBSET {A,B,C} /\ {B,A,C} SUBSET {A,B,C} /\ {B,C,A} SUBSET {A,B,C} /\ {C,A,B} SUBSET {A,B,C} /\ {C,B,A} SUBSET {A,B,C}`; COLLINEAR_SUBSET]);; let Noncollinear_2Span = prove (`!u v w:real^2. ~collinear {vec 0,v,w} ==> ? s t. s % v + t % w = u`, INTRO_TAC "!u v w; H1" THEN SUBGOAL_TAC "H1'" `~(v$1 * w$2 - (w:real^2)$1 * (v:real^2)$2 = &0)` [HYP MESON_TAC "H1" [COLLINEAR_3_2Dzero; REAL_SUB_0]] THEN consider "M such that" `M = transp(vector[v:real^2;w:real^2]):real^2^2` [MESON_TAC[]] "Mexists" THEN SUBGOAL_TAC "MatMult" `~(det (M:real^2^2) = &0) /\ (! x. (M ** x)$1 = (v:real^2)$1 * x$1 + (w:real^2)$1 * x$2 /\ (M ** x)$2 = v$2 * x$1 + w$2 * x$2)` [HYP SIMP_TAC "H1' Mexists" [matrix_vector_mul; DIMINDEX_2; SUM_2; TRANSP_COMPONENT; VECTOR_2; LAMBDA_BETA; ARITH; CART_EQ; FORALL_2; DET_2] THEN VEC2_TAC] THEN consider "x such that" `(M:real^2^2) ** (x:real^2) = u` [so (MESON_TAC [ARITH_RULE `~(r < n) /\ r <= MIN n n ==> r = n`; DET_EQ_0_RANK; RANK_BOUND; MATRIX_FULL_LINEAR_EQUATIONS])] "xDef" THEN MAP_EVERY EXISTS_TAC [`(x:real^2)$1`; `(x:real^2)$2`] THEN SUBGOAL_TAC "" `(x:real^2)$1 * (v:real^2)$1 + (x:real^2)$2 * (w:real^2)$1 = (u:real^2)$1 /\ x$1 * v$2 + x$2 * w$2 = u$2` [HYP MESON_TAC "MatMult xDef" [REAL_MUL_SYM]] THEN so (SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; vector_add; vector_mul; ARITH]));; let oriented_area = new_definition `oriented_area (a:real^2,b:real^2,c:real^2) = ((b$1 - a$1) * (c$2 - a$2) - (c$1 - a$1) * (b$2 - a$2)) / &2`;; let oriented_areaSymmetry = prove (`oriented_area (A,B,C) = oriented_area(A',B',C') ==> oriented_area (B,C,A) = oriented_area (B',C',A') /\ oriented_area (C,A,B) = oriented_area (C',A',B') /\ oriented_area (A,C,B) = oriented_area (A',C',B') /\ oriented_area (B,A,C) = oriented_area (B',A',C') /\ oriented_area (C,B,A) = oriented_area (C',B',A')`, REWRITE_TAC[oriented_area] THEN VEC2_TAC);; let move = new_definition `!A B C A' B' C':real^2. move (A,B,C) (A',B',C') <=> (B = B' /\ C = C' /\ collinear {vec 0,C - B,A' - A} \/ A = A' /\ C = C' /\ collinear {vec 0,C - A,B' - B} \/ A = A' /\ B = B' /\ collinear {vec 0,B - A,C' - C})`;; let moveInvariant = prove (`!p p'. move p p' ==> oriented_area p = oriented_area p'`, REWRITE_TAC[FORALL_PAIR_THM; move; oriented_area; COLLINEAR_LEMMA; vector_mul] THEN VEC2_TAC);; let reachable = new_definition `!p p'. reachable p p' <=> ?n. ?s. s 0 = p /\ s n = p' /\ (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; let reachableN = new_definition `!p p'. !n. reachableN p p' n <=> ?s. s 0 = p /\ s n = p' /\ (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; let ReachLemma = prove (`!p p'. reachable p p' <=> ?n. reachableN p p' n`, REWRITE_TAC[reachable; reachableN]);; let reachableN_CLAUSES = prove (`! p p'. (reachableN p p' 0 <=> p = p') /\ ! n. reachableN p p' (SUC n) <=> ? q. reachableN p q n /\ move q p'`, INTRO_TAC "!p p'" THEN consider "s0 such that" `s0 = \m:num. p':triple` [MESON_TAC[]] "s0exists" THEN SUBGOAL_TAC "0CLAUSE" `reachableN p p' 0 <=> p = p'` [HYP MESON_TAC "s0exists" [LE_0; reachableN; LT]] THEN SUBGOAL_TAC "Imp1" `! n. reachableN p p' (SUC n) ==> ? q. reachableN p q n /\ move q p'` [INTRO_TAC "!n; H1" THEN consider "s such that" `s 0 = p /\ s (SUC n) = p' /\ !m. m < SUC n ==> move (s m) (s (SUC m))` [HYP MESON_TAC "H1" [LE_0; reachableN]] "sDef" THEN consider "q such that" `q:triple = s n` [MESON_TAC[]] "qDef" THEN HYP MESON_TAC "sDef qDef" [LE_0; reachableN; LT]] THEN SUBGOAL_TAC "Imp2" `!n. (? q. reachableN p q n /\ move q p') ==> reachableN p p' (SUC n)` [INTRO_TAC "!n" THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN INTRO_TAC "!q; nReach; move_qp'" THEN consider "s such that" `s 0 = p /\ s n = q /\ !m. m < n ==> move (s m) (s (SUC m))` [HYP MESON_TAC "nReach" [reachableN; LT; LE_0]] "sDef" THEN REWRITE_TAC[reachableN; LT; LE_0] THEN EXISTS_TAC `\m. if m < SUC n then s m else p':triple` THEN HYP MESON_TAC "sDef move_qp'" [LT_0; LT_REFL; LT; LT_SUC]] THEN HYP MESON_TAC "0CLAUSE Imp1 Imp2" []);; let reachableInvariant = prove (`!p p'. reachable p p' ==> oriented_area p = oriented_area p'`, SIMP_TAC[ReachLemma; LEFT_IMP_EXISTS_THM; SWAP_FORALL_THM] THEN INDUCT_TAC THEN ASM_MESON_TAC[reachableN_CLAUSES; moveInvariant]);; let move2Cond = new_definition `! A B A' B':real^2. move2Cond A B A' B' <=> ~collinear {B,A,A'} /\ ~collinear {A',B,B'} \/ ~collinear {A,B,B'} /\ ~collinear {B',A,A'}`;; let reachableN_One = prove (`reachableN P0 P1 1 <=> move P0 P1`, MESON_TAC[ONE; reachableN; reachableN_CLAUSES]);; let reachableN_Two = prove (`reachableN P0 P2 2 <=> ?P1. move P0 P1 /\ move P1 P2`, MESON_TAC[TWO; reachableN_One; reachableN_CLAUSES]);; let reachableN_Three = prove (`reachableN P0 P3 3 <=> ?P1 P2. move P0 P1 /\ move P1 P2 /\ move P2 P3`, MESON_TAC[ARITH_RULE `3 = SUC 2`; reachableN_Two; reachableN_CLAUSES]);; let reachableN_Four = prove (`reachableN P0 P4 4 <=> ?P1 P2 P3. move P0 P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4`, MESON_TAC[ARITH_RULE `4 = SUC 3`; reachableN_Three; reachableN_CLAUSES]);; let reachableN_Five = prove (`reachableN P0 P5 5 <=> ?P1 P2 P3 P4. move P0 P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 /\ move P4 P5`, REWRITE_TAC[ARITH_RULE `5 = SUC 4`; reachableN_CLAUSES] THEN MESON_TAC[reachableN_Four]);; let moveSymmetry = prove (`move (A,B,C) (A',B',C') ==> move (B,C,A) (B',C',A') /\ move (C,A,B) (C',A',B') /\ move (A,C,B) (A',C',B') /\ move (B,A,C) (B',A',C') /\ move (C,B,A) (C',B',A')`, SUBGOAL_TAC "" `!A B C A':real^2. collinear {vec 0, C - B, A' - A} ==> collinear {vec 0, B - C, A' - A}` [REWRITE_TAC[COLLINEAR_3_2Dzero] THEN VEC2_TAC] THEN so (REWRITE_TAC[move]) THEN MESON_TAC[]);; let reachableNSymmetry = prove (`! n. ! A B C A' B' C'. reachableN (A,B,C) (A',B',C') n ==> reachableN (B,C,A) (B',C',A') n /\ reachableN (C,A,B) (C',A',B') n /\ reachableN (A,C,B) (A',C',B') n /\ reachableN (B,A,C) (B',A',C') n /\ reachableN (C,B,A) (C',B',A') n`, MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[reachableN_CLAUSES] THEN SIMP_TAC[PAIR_EQ] THEN INTRO_TAC "!n;nStep; !A B C A' B' C'" THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`X:real^2`; `Y:real^2`; `Z:real^2`] THEN INTRO_TAC "XYZexists" THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY EXISTS_TAC [`(Y,Z,X):triple`; `(Z,X,Y):triple`; `(X,Z,Y):triple`; `(Y,X,Z):triple`; `(Z,Y,X):triple`] THEN HYP SIMP_TAC "nStep XYZexists" [moveSymmetry]);; let ORIENTED_AREA_COLLINEAR_CONG = prove (`! A B C A' B' C. oriented_area (A,B,C) = oriented_area (A',B',C') ==> (collinear {A,B,C} <=> collinear {A',B',C'})`, REWRITE_TAC[COLLINEAR_3_2D; oriented_area] THEN CONV_TAC REAL_RING);; let Basic2move_THM = prove (`! A B C A'. ~collinear {A,B,C} /\ ~collinear {B,A,A'} ==> ?X. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X)`, INTRO_TAC "!A B C A'; H1 H2" THEN SUBGOAL_TAC "add0vector_mul" `!r. r % ((A:real^2) - B) = (--r) % (B - A) /\ r % (A - B) = r % (A - B) + &0 % (C - B)` [VEC2_TAC] THEN SUBGOAL_TAC "H2'" `~ ? r. A' - (A:real^2) = r % (A - B)` [so (HYP MESON_TAC "H2" [COLLINEAR_3; COLLINEAR_LEMMA])] THEN consider "r t such that" `A' - (A:real^2) = r % (A - B) + t % (C - B)` [HYP MESON_TAC "H1" [COLLINEAR_3; Noncollinear_2Span]] "rExists" THEN SUBGOAL_TAC "tNonzero" `~(t = &0)` [so (HYP MESON_TAC "add0vector_mul H2'" [])] THEN consider "s X such that" `s = r / t /\ X:real^2 = C + s % (A - B)` [HYP MESON_TAC "rExists" []] "Xexists" THEN SUBGOAL_TAC "" `A' - (A:real^2) = (t * s) % (A - B) + t % (C - B)` [so (HYP MESON_TAC "rExists tNonzero" [REAL_DIV_LMUL])] THEN SUBGOAL_TAC "" `A' - (A:real^2) = t % (X - B) /\ X - C = (-- s) % (B - (A:real^2))` [(so (HYP REWRITE_TAC "Xexists" [])) THEN VEC2_TAC] THEN SUBGOAL_TAC "" `collinear {vec 0,B - (A:real^2),X - C} /\ collinear {vec 0,X - B,A' - A}` [so (HYP MESON_TAC "" [COLLINEAR_LEMMA])] THEN so (MESON_TAC [move]));; let FourStepMoveAB = prove (`!A B C A' B'. ~collinear {A,B,C} ==> ~collinear {B,A,A'} /\ ~collinear {A',B,B'} ==> ? X Y. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) /\ move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y)`, INTRO_TAC "!A B C A' B'; H1; H2" THEN consider "X such that" `move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X)` [HYP MESON_TAC "H1 H2" [Basic2move_THM]]"ABX" THEN SUBGOAL_TAC "" `~collinear {(A:real^2),B,X} /\ ~collinear {A',B,X}` [so (HYP MESON_TAC "H1" [moveInvariant; ORIENTED_AREA_COLLINEAR_CONG])] THEN SUBGOAL_TAC "" `~collinear {(B:real^2),A',X}` [so (MESON_TAC [collinearSymmetry])] THEN consider "Y such that" `move (B,A',X) (B,A',Y) /\ move (B,A',Y) (B',A',Y)` [so (HYP MESON_TAC "H2" [Basic2move_THM])] "BA'Y" THEN SUBGOAL_TAC "" `move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y)` [HYP MESON_TAC "BA'Y" [moveSymmetry]] THEN so (HYP MESON_TAC "ABX" []));; let FourStepMoveABBAreach = prove (`!A B C A' B'. ~collinear {A,B,C} /\ move2Cond A B A' B' ==> ? Y. reachableN (A,B,C) (A',B',Y) 4`, INTRO_TAC "!A B C A' B'; H1 H2" THEN cases "Case1 | Case2" `~collinear {B,(A:real^2),A'} /\ ~collinear {A',B,B'} \/ ~collinear {A,B,B'} /\ ~collinear {B',A,A'}` [HYP MESON_TAC "H2" [move2Cond]] THENL [so (HYP MESON_TAC "H1" [FourStepMoveAB; reachableN_Four]); SUBGOAL_TAC "" `~collinear {B,(A:real^2),C}` [HYP MESON_TAC "H1" [collinearSymmetry]]] THEN SUBGOAL_TAC "" `~collinear {B,(A:real^2),C}` [HYP MESON_TAC "H1" [collinearSymmetry]] THEN consider "X Y such that" `move (B,A,C) (B,A,X) /\ move (B,A,X) (B',A,X) /\ move (B',A,X) (B',A,Y) /\ move (B',A,Y) (B',A',Y)` [so (HYP MESON_TAC "Case2" [FourStepMoveAB])] "BAX" THEN HYP MESON_TAC "BAX" [moveSymmetry; reachableN_Four]);; let NotMove2ImpliesCollinear = prove (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} /\ ~(A = A') /\ ~(B = B') /\ ~move2Cond A B A' B' ==> collinear {A,B,A',B'}`, INTRO_TAC "!A B C A' B' C'; H1 H1' H2 H2' H3" THEN SUBGOAL_TAC "Distinct" `~((A:real^2) = B) /\ ~((A':real^2) = B')` [HYP MESON_TAC "H1 H1'" [Noncollinear_3ImpliesDistinct]] THEN SUBGOAL_TAC "set4symmetry" `{(A:real^2),B,A',B'} SUBSET {A,A',B,B'} /\ {A,B,A',B'} SUBSET {B,B',A',A} /\ {A,B,A',B'} SUBSET {A',B',B,A}` [SET_TAC[]] THEN cases "Case1 | Case2 | Case3 | Case4" `collinear {B,(A:real^2),A'} /\ collinear {A,B,B'} \/ collinear {B,A,A'} /\ collinear {B',A,A'} \/ collinear {A',B,B'} /\ collinear {A,B,B'} \/ collinear {A',B,B'} /\ collinear {B',A,A'}` [HYP MESON_TAC "H3" [move2Cond]] THEN so (HYP MESON_TAC "Distinct H2 H2' set4symmetry" [collinearSymmetry; COLLINEAR_4_3; COLLINEAR_SUBSET]));; let DistinctImplies2moveable = prove (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} /\ ~(A = A') /\ ~(B = B') /\ ~(C = C') ==> move2Cond A B A' B' \/ move2Cond B C B' C'`, INTRO_TAC "!A B C A' B' C'; H1 H1' H2a H2b H2c" THEN SUBGOAL_TAC "3subset4" `{(A:real^2),B,B'} SUBSET {A,B,A',B'} /\ {B,B',C} SUBSET {B,C,B',C'}` [SET_TAC[]] THEN raa "Con" `~move2Cond A B A' B' /\ ~move2Cond B C B' C'` (HYP MESON_TAC "Con" []) THEN SUBGOAL_TAC "" `collinear {(A:real^2),B,A',B'} /\ collinear {B,C,B',C'}` [so (HYP MESON_TAC "H1 H1' H2a H2b H2c" [collinearSymmetry; NotMove2ImpliesCollinear])] THEN SUBGOAL_TAC "" `collinear {(A:real^2),B,C}` [so (HYP MESON_TAC "3subset4 H2a H2b H2c" [COLLINEAR_SUBSET; COLLINEAR_3_TRANS])] THEN so (HYP MESON_TAC "H1 H1'" []));; let SameCdiffAB = prove (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} ==> C = C' /\ ~(A = A') /\ ~(B = B') ==> ? Y. reachableN (A,B,C) (Y,B',C') 2 \/ reachableN (A,B,C) (A',B',Y) 4`, INTRO_TAC "!A B C A' B' C'; H1; H2" THEN SUBGOAL_TAC "easy_set" `{B,B',(A:real^2)} SUBSET {A,B,A',B'} /\ {A,B,C} SUBSET {B,B',A,C}` [SET_TAC[]] THEN cases "Ncol | move | col_Nmove" `~collinear {C,B,B'} \/ move2Cond A B A' B' \/ collinear {C,B,B'} /\ ~move2Cond A B A' B'` [MESON_TAC[]] THENL [consider "X such that" `move (B,C,A) (B,C,X) /\ move (B,C,X) (B',C',X)` [so (HYP MESON_TAC "easy_set H1 H2" [collinearSymmetry; Basic2move_THM])] "BCX" THEN HYP MESON_TAC "BCX" [reachableN_Two; reachableNSymmetry]; so (HYP MESON_TAC "H1" [FourStepMoveABBAreach]); SUBGOAL_TAC "" `collinear {(B:real^2),B',A} /\ collinear {B,B',C}` [so (HYP MESON_TAC "H1 H2 easy_set" [NotMove2ImpliesCollinear; COLLINEAR_SUBSET; collinearSymmetry])] THEN so (HYP MESON_TAC "H2 easy_set H1" [COLLINEAR_4_3; COLLINEAR_SUBSET])]);; let FourMovesToCorrectTwo = prove (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} ==> ? n. n < 5 /\ ? Y. reachableN (A,B,C) (A',B',Y) n \/ reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n`, INTRO_TAC "!A B C A' B' C'; H1" THEN SUBGOAL_TAC "H1'" `~collinear {B,C,(A:real^2)} /\ ~collinear{B',C',(A':real^2)} /\ ~collinear {C,A,B} /\ ~collinear {C',A',B'}` [HYP MESON_TAC "H1" [collinearSymmetry]] THEN SUBGOAL_TAC "easy_arith" `0 < 5 /\ 2 < 5 /\ 3 < 5 /\ 4 < 5` [ARITH_TAC] THEN cases "case01 | case2 | case3" `((A:real^2) = A' /\ (B:real^2) = B' /\ (C:real^2) = C' \/ A = A' /\ B = B' /\ ~(C = C') \/ A = A' /\ ~(B = B') /\ C = C' \/ ~(A = A') /\ B = B' /\ C = C') \/ (A = A' /\ ~(B = B') /\ ~(C = C') \/ ~(A = A') /\ B = B' /\ ~(C = C') \/ ~(A = A') /\ ~(B = B') /\ C = C') \/ ~(A = A') /\ ~(B = B') /\ ~(C = C')` [MESON_TAC []] THENL [so (HYP MESON_TAC "easy_arith" [reachableN_CLAUSES]); so (HYP MESON_TAC "H1 H1' easy_arith" [SameCdiffAB; reachableNSymmetry]); EXISTS_TAC `4` THEN HYP SIMP_TAC "easy_arith" [] THEN so (HYP MESON_TAC "H1 H1'" [DistinctImplies2moveable; FourStepMoveABBAreach; reachableNSymmetry; reachableN_Four])]);; let CorrectFinalPoint = prove (`oriented_area (A,B,C) = oriented_area (A,B,C') ==> move (A,B,C) (A,B,C')`, REWRITE_TAC [move; oriented_area; COLLINEAR_3_2Dzero] THEN VEC2_TAC);; let FiveMovesOrLess = prove (`!A B C A' B' C'. ~collinear {A,B,C} ==> oriented_area (A,B,C) = oriented_area (A',B',C') ==> ? n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n`, INTRO_TAC "!A B C A' B' C'; H1; H2" THEN SUBGOAL_TAC "H1'" `~collinear {(A':real^2),B',C'}` [HYP MESON_TAC "H1 H2" [ORIENTED_AREA_COLLINEAR_CONG]] THEN SUBGOAL_TAC "Distinct" `~((A:real^2) = B) /\ ~(A = C) /\ ~(B = C) /\ ~((A':real^2) = B') /\ ~(A' = C') /\ ~(B' = C')` [so (HYP MESON_TAC "H1" [Noncollinear_3ImpliesDistinct])] THEN consider "n Y such that" `n < 5 /\ (reachableN (A,B,C) (A',B',Y) n \/ reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n)` [HYP MESON_TAC "H1 H1'" [FourMovesToCorrectTwo]] "2Correct" THEN cases "A'B'Y | A'YC' | YB'C'" `reachableN (A,B,C) (A',B',Y) n \/ reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n` [HYP MESON_TAC "2Correct" []] THENL [SUBGOAL_TAC "" `oriented_area (A',B',Y) = oriented_area (A',B',C')` [so (HYP MESON_TAC "H2" [ReachLemma; reachableInvariant])] THEN SUBGOAL_TAC "" `move (A',B',Y) (A',B',C')` [so (HYP MESON_TAC "Distinct" [CorrectFinalPoint])] THEN so (HYP MESON_TAC "A'B'Y 2Correct" [reachableN_CLAUSES; LE_SUC_LT]); SUBGOAL_TAC "" `oriented_area (A',C',Y) = oriented_area (A',C',B')` [so (HYP MESON_TAC "H2" [ReachLemma; reachableInvariant; oriented_areaSymmetry])] THEN SUBGOAL_TAC "" `move (A',Y,C') (A',B',C')` [so (HYP MESON_TAC "Distinct" [CorrectFinalPoint; moveSymmetry])] THEN so (HYP MESON_TAC "A'YC' 2Correct" [reachableN_CLAUSES; LE_SUC_LT]); SUBGOAL_TAC "" `oriented_area (B',C',Y) = oriented_area (B',C',A')` [so (HYP MESON_TAC "H2" [ReachLemma; reachableInvariant; oriented_areaSymmetry])] THEN SUBGOAL_TAC "" `move (Y,B',C') (A',B',C')` [so (HYP MESON_TAC "Distinct" [CorrectFinalPoint; moveSymmetry])] THEN so (HYP MESON_TAC "YB'C' 2Correct" [reachableN_CLAUSES; LE_SUC_LT])]);; let NOTENOUGH_4 = prove (`?p0 p4. oriented_area p0 = oriented_area p4 /\ ~reachableN p0 p4 4`, consider "p0 p4 such that" `p0:triple = vector [&0;&0],vector [&0;&1],vector [&1;&0] /\ p4:triple = vector [&1;&1],vector [&1;&2],vector [&2;&1]` [MESON_TAC []] "p04Def" THEN SUBGOAL_TAC "equal_areas" `oriented_area p0 = oriented_area p4` [HYP REWRITE_TAC "p04Def" [oriented_area] THEN VEC2_TAC] THEN SUBGOAL_TAC "" `~reachableN p0 p4 4` [HYP REWRITE_TAC "p04Def" [reachableN_Four; NOT_EXISTS_THM; FORALL_PAIR_THM; move; COLLINEAR_3_2Dzero; FORALL_VECTOR_2] THEN VEC2_TAC] THEN so (HYP MESON_TAC "equal_areas" []));; let FiveMovesOrLess_STRONG = prove (`!A B C A' B' C'. oriented_area (A,B,C) = oriented_area (A',B',C') ==> ?n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n`, INTRO_TAC "!A B C A' B' C'; H1" THEN SUBGOAL_TAC "EZcollinear" `(!X Y:real^2. collinear {X,Y,Y}) /\ (!A B A'. move (A,B,B) (A',B,B)) /\ !A B C B'. (collinear {A,B,C} /\ collinear {A,B',C} ==> move (A,B,C) (A,B',C))` [REWRITE_TAC[move; COLLINEAR_3_2D] THEN VEC2_TAC] THEN cases "ABCncol | ABCcol" `~collinear {(A:real^2),B,C} \/ collinear {A,B,C}` [MESON_TAC []] THENL [so (HYP MESON_TAC "H1" [FiveMovesOrLess]); SUBGOAL_TAC "A'B'C'col" `collinear {(A':real^2),B',C'}` [so (HYP MESON_TAC "H1" [ORIENTED_AREA_COLLINEAR_CONG])] THEN consider "P1 P2 P3 P4 such that" `P1:triple = A,C,C /\ P2:triple = B',C,C /\ P3 = B',B',C /\ P4:triple = B',B',C'` [MESON_TAC []] "P1234exist" THEN SUBGOAL_TAC "" `move (A,B,C) (P1:triple) /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 /\ move P4 (A',B',C')` [HYP MESON_TAC "ABCcol A'B'C'col EZcollinear P1234exist" [collinearSymmetry; moveSymmetry]] THEN so (MESON_TAC [reachableN_Five; LE_REFL])]);; hol-light/Examples/kb.ml000066400000000000000000000313651303454263000154610ustar00rootroot00000000000000(* ========================================================================= *) (* Knuth-Bendix completion done by HOL inference. John Harrison 2005 *) (* *) (* This was written by fairly mechanical modification of the code at *) (* *) (* http://www.cl.cam.ac.uk/users/jrh/atp/order.ml *) (* http://www.cl.cam.ac.uk/users/jrh/atp/completion.ml *) (* *) (* for HOL's slightly different term structure, with ad hoc term *) (* manipulations replaced by inference on equational theorems. We also have *) (* the optimization of throwing left-reducible rules back into the set of *) (* critical pairs. However, we don't prioritize smaller critical pairs or *) (* anything like that; this is still a very naive implementation. *) (* *) (* For something very similar done 15 years ago, see Konrad Slind's Master's *) (* thesis: "An Implementation of Higher Order Logic", U Calgary 1991. *) (* ========================================================================= *) let is_realvar w x = is_var x && not(mem x w);; let rec real_strip w tm = if mem tm w then tm,[] else let l,r = dest_comb tm in let f,args = real_strip w l in f,args@[r];; (* ------------------------------------------------------------------------- *) (* Construct a weighting function. *) (* ------------------------------------------------------------------------- *) let weight lis (f,n) (g,m) = let i = index f lis and j = index g lis in i > j || i = j && n > m;; (* ------------------------------------------------------------------------- *) (* Generic lexicographic ordering function. *) (* ------------------------------------------------------------------------- *) let rec lexord ord l1 l2 = match (l1,l2) with (h1::t1,h2::t2) -> if ord h1 h2 then length t1 = length t2 else h1 = h2 && lexord ord t1 t2 | _ -> false;; (* ------------------------------------------------------------------------- *) (* Lexicographic path ordering. Note that we also use the weights *) (* to define the set of constants, so they don't literally have to be *) (* constants in the HOL sense. *) (* ------------------------------------------------------------------------- *) let rec lpo_gt w s t = if is_realvar w t then not(s = t) && mem t (frees s) else if is_realvar w s || is_abs s || is_abs t then false else let f,fargs = real_strip w s and g,gargs = real_strip w t in exists (fun si -> lpo_ge w si t) fargs || forall (lpo_gt w s) gargs & (f = g && lexord (lpo_gt w) fargs gargs || weight w (f,length fargs) (g,length gargs)) and lpo_ge w s t = (s = t) || lpo_gt w s t;; (* ------------------------------------------------------------------------- *) (* Unification. Again we have the weights "w" fixing the set of constants. *) (* ------------------------------------------------------------------------- *) let rec istriv w env x t = if is_realvar w t then t = x || defined env t && istriv w env x (apply env t) else if is_const t then false else let f,args = strip_comb t in exists (istriv w env x) args && failwith "cyclic";; let rec unify w env tp = match tp with ((Var(_,_) as x),t) | (t,(Var(_,_) as x)) when not(mem x w) -> if defined env x then unify w env (apply env x,t) else if istriv w env x t then env else (x|->t) env | (Comb(f,x),Comb(g,y)) -> unify w (unify w env (x,y)) (f,g) | (s,t) -> if s = t then env else failwith "unify: not unifiable";; (* ------------------------------------------------------------------------- *) (* Full unification, unravelling graph into HOL-style instantiation list. *) (* ------------------------------------------------------------------------- *) let fullunify w (s,t) = let env = unify w undefined (s,t) in let th = map (fun (x,t) -> (t,x)) (graph env) in let rec subs t = let t' = vsubst th t in if t' = t then t else subs t' in map (fun (t,x) -> (subs t,x)) th;; (* ------------------------------------------------------------------------- *) (* Construct "overlaps": ways of rewriting subterms using unification. *) (* ------------------------------------------------------------------------- *) let LIST_MK_COMB f ths = rev_itlist (fun s t -> MK_COMB(t,s)) ths (REFL f);; let rec listcases fn rfn lis acc = match lis with [] -> acc | h::t -> fn h (fun i h' -> rfn i (h'::map REFL t)) @ listcases fn (fun i t' -> rfn i (REFL h::t')) t acc;; let rec overlaps w th tm rfn = let l,r = dest_eq(concl th) in if not (is_comb tm) then [] else let f,args = strip_comb tm in listcases (overlaps w th) (fun i a -> rfn i (LIST_MK_COMB f a)) args (try [rfn (fullunify w (l,tm)) th] with Failure _ -> []);; (* ------------------------------------------------------------------------- *) (* Rename variables canonically to avoid clashes or remove redundancy. *) (* ------------------------------------------------------------------------- *) let fixvariables s th = let fvs = subtract (frees(concl th)) (freesl(hyp th)) in let gvs = map2 (fun v n -> mk_var(s^string_of_int n,type_of v)) fvs (1--(length fvs)) in INST (zip gvs fvs) th;; let renamepair (th1,th2) = fixvariables "x" th1,fixvariables "y" th2;; (* ------------------------------------------------------------------------- *) (* Find all critical pairs. *) (* ------------------------------------------------------------------------- *) let crit1 w eq1 eq2 = let l1,r1 = dest_eq(concl eq1) and l2,r2 = dest_eq(concl eq2) in overlaps w eq1 l2 (fun i th -> TRANS (SYM(INST i th)) (INST i eq2));; let thm_union l1 l2 = itlist (fun th ths -> let th' = fixvariables "x" th in let tm = concl th' in if exists (fun th'' -> concl th'' = tm) ths then ths else th'::ths) l1 l2;; let critical_pairs w tha thb = let th1,th2 = renamepair (tha,thb) in if concl th1 = concl th2 then crit1 w th1 th2 else filter (fun th -> let l,r = dest_eq(concl th) in l <> r) (thm_union (crit1 w th1 th2) (thm_union (crit1 w th2 th1) []));; (* ------------------------------------------------------------------------- *) (* Normalize an equation and try to orient it. *) (* ------------------------------------------------------------------------- *) let normalize_and_orient w eqs th = let th' = GEN_REWRITE_RULE TOP_DEPTH_CONV eqs th in let s',t' = dest_eq(concl th') in if lpo_ge w s' t' then th' else if lpo_ge w t' s' then SYM th' else failwith "Can't orient equation";; (* ------------------------------------------------------------------------- *) (* Print out status report to reduce user boredom. *) (* ------------------------------------------------------------------------- *) let status(eqs,crs) eqs0 = if eqs = eqs0 && (length crs) mod 1000 <> 0 then () else (print_string(string_of_int(length eqs)^" equations and "^ string_of_int(length crs)^" pending critical pairs"); print_newline());; (* ------------------------------------------------------------------------- *) (* Basic completion, throwing back left-reducible rules. *) (* ------------------------------------------------------------------------- *) let left_reducible eqs eq = can (CHANGED_CONV(GEN_REWRITE_CONV (LAND_CONV o ONCE_DEPTH_CONV) eqs)) (concl eq);; let rec complete w (eqs,crits) = match crits with (eq::ocrits) -> let trip = try let eq' = normalize_and_orient w eqs eq in let s',t' = dest_eq(concl eq') in if s' = t' then (eqs,ocrits) else let crits',eqs' = partition(left_reducible [eq']) eqs in let eqs'' = eq'::eqs' in eqs'', ocrits @ crits' @ itlist ((@) o critical_pairs w eq') eqs'' [] with Failure _ -> if exists (can (normalize_and_orient w eqs)) ocrits then (eqs,ocrits@[eq]) else failwith "complete: no orientable equations" in status trip eqs; complete w trip | [] -> eqs;; (* ------------------------------------------------------------------------- *) (* Overall completion. *) (* ------------------------------------------------------------------------- *) let complete_equations wts eqs = let eqs' = map (normalize_and_orient wts []) eqs in complete wts ([],eqs');; (* ------------------------------------------------------------------------- *) (* Knuth-Bendix example 4: the inverse property. *) (* ------------------------------------------------------------------------- *) complete_equations [`1`; `(*):num->num->num`; `i:num->num`] [SPEC_ALL(ASSUME `!a b. i(a) * a * b = b`)];; (* ------------------------------------------------------------------------- *) (* Knuth-Bendix example 6: central groupoids. *) (* ------------------------------------------------------------------------- *) complete_equations [`(*):num->num->num`] [SPEC_ALL(ASSUME `!a b c. (a * b) * (b * c) = b`)];; (* ------------------------------------------------------------------------- *) (* Knuth-Bendix example 9: cancellation law. *) (* ------------------------------------------------------------------------- *) complete_equations [`1`; `( * ):num->num->num`; `(+):num->num->num`; `(-):num->num->num`] (map SPEC_ALL (CONJUNCTS (ASSUME `(!a b:num. a - a * b = b) /\ (!a b:num. a * b - b = a) /\ (!a. a * 1 = a) /\ (!a. 1 * a = a)`)));; (* ------------------------------------------------------------------------- *) (* Another example: pure congruence closure (no variables). *) (* ------------------------------------------------------------------------- *) complete_equations [`c:A`; `f:A->A`] (map SPEC_ALL (CONJUNCTS (ASSUME `((f(f(f(f(f c))))) = c:A) /\ (f(f(f c)) = c)`)));; (* ------------------------------------------------------------------------- *) (* Knuth-Bendix example 1: group theory. *) (* ------------------------------------------------------------------------- *) let eqs = map SPEC_ALL (CONJUNCTS (ASSUME `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ (!x y z. (x * y) * z = x * y * z)`));; complete_equations [`1`; `(*):num->num->num`; `i:num->num`] eqs;; (* ------------------------------------------------------------------------- *) (* Near-rings (from Aichinger's Diplomarbeit). *) (* ------------------------------------------------------------------------- *) let eqs = map SPEC_ALL (CONJUNCTS (ASSUME `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z))`));; let nreqs = complete_equations [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`] eqs;; (*** This weighting also works OK, though the system is a bit bigger let nreqs = complete_equations [`0`; `(+):num->num->num`; `( * ):num->num->num`; `INV`] eqs;; ****) (* ------------------------------------------------------------------------- *) (* A "completion" tactic. *) (* ------------------------------------------------------------------------- *) let COMPLETE_TAC w th = let eqs = map SPEC_ALL (CONJUNCTS(SPEC_ALL th)) in let eqs' = complete_equations w eqs in MAP_EVERY (ASSUME_TAC o GEN_ALL) eqs';; (* ------------------------------------------------------------------------- *) (* Solve example problems in groups and near-rings. *) (* ------------------------------------------------------------------------- *) g `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ (!x y z. (x * y) * z = x * y * z) ==> !x y. i(y) * i(i(i(x * i(y)))) * x = 1`;; e (DISCH_THEN(COMPLETE_TAC [`1`; `(*):num->num->num`; `i:num->num`]));; e (ASM_REWRITE_TAC[]);; g `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z)) ==> (neg 0 * (x * y + z + neg(neg(w + z))) + neg(neg b + neg a) = a + b)`;; e (DISCH_THEN(COMPLETE_TAC [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`]));; e (ASM_REWRITE_TAC[]);; hol-light/Examples/lagrange_lemma.ml000066400000000000000000000136471303454263000200230ustar00rootroot00000000000000(* ========================================================================= *) (* Nice test for ring procedure and ordered rewriting: Lagrange lemma. *) (* ========================================================================= *) prioritize_real();; (* ------------------------------------------------------------------------- *) (* Do the problems the (relatively) efficient way using the normalizer. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_4 = time prove (`((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2)) = (((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2)`, CONV_TAC REAL_RING);; let LAGRANGE_8 = time prove (`(p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2) = (p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1 * w2) pow 2 + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1 * v2) pow 2 + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1 * u2) pow 2 + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1 * t2) pow 2 + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1 * s2) pow 2 + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1 * r2) pow 2 + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1 * q2) pow 2 + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1 * p2) pow 2`, CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Or we can just use REAL_ARITH, which is also reasonably fast. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_4 = time prove (`((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2)) = (((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2)`, REAL_ARITH_TAC);; let LAGRANGE_8 = time prove (`(p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2) = (p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1 * w2) pow 2 + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1 * v2) pow 2 + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1 * u2) pow 2 + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1 * t2) pow 2 + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1 * s2) pow 2 + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1 * r2) pow 2 + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1 * q2) pow 2 + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1 * p2) pow 2`, REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* But they can be done (slowly) simply by ordered rewriting. *) (* ------------------------------------------------------------------------- *) let LAGRANGE_4 = time prove (`((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2)) = (((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2)`, REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB; REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB; REAL_ARITH `a + (b - c) = (a + b) - c`; REAL_ARITH `a - (b - c) = a + (c - b)`; REAL_ARITH `(a - b) + c = (a + c) - b`; REAL_ARITH `(a - b) - c = a - (b + c)`; REAL_ARITH `(a - b = c) = (a = b + c)`; REAL_ARITH `(a = b - c) = (a + c = b)`; REAL_ADD_AC; REAL_MUL_AC]);; let LAGRANGE_8 = time prove (`(p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2) = (p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1 * w2) pow 2 + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1 * v2) pow 2 + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1 * u2) pow 2 + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1 * t2) pow 2 + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1 * s2) pow 2 + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1 * r2) pow 2 + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1 * q2) pow 2 + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1 * p2) pow 2`, REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB; REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB; REAL_ARITH `a + (b - c) = (a + b) - c`; REAL_ARITH `a - (b - c) = a + (c - b)`; REAL_ARITH `(a - b) + c = (a + c) - b`; REAL_ARITH `(a - b) - c = a - (b + c)`; REAL_ARITH `(a - b = c) = (a = b + c)`; REAL_ARITH `(a = b - c) = (a + c = b)`; REAL_ADD_AC; REAL_MUL_AC]);; hol-light/Examples/lucas_lehmer.ml000066400000000000000000000445311303454263000175270ustar00rootroot00000000000000(* ========================================================================= *) (* The Lucas-Lehmer test. *) (* ========================================================================= *) needs "Library/iter.ml";; needs "Library/pocklington.ml";; needs "Library/floor.ml";; needs "Multivariate/vectors.ml";; needs "100/sqrt.ml";; (* ------------------------------------------------------------------------- *) (* Relate real powers to iteration. *) (* ------------------------------------------------------------------------- *) let REAL_POW_ITER = prove (`!x n. x pow n = ITER n (\y. x * y) (&1)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; real_pow]);; (* ------------------------------------------------------------------------- *) (* Basic definition of the Lucas-Lehmer sequence. To avoid troubles with *) (* cutoff subtraction and keep things in N we use m^2 + (p - 2) not m^2 - 2. *) (* ------------------------------------------------------------------------- *) let llseq = define `llseq p 0 = 4 MOD p /\ llseq p (SUC n) = ((llseq p n) EXP 2 + (p - 2)) MOD p`;; (* ------------------------------------------------------------------------- *) (* Closed form for the Lucas-Lehmer sequence. *) (* ------------------------------------------------------------------------- *) let LLSEQ_CLOSEDFORM = prove (`!p n. ~(p = 0) ==> ?x. llseq p n = x MOD p /\ &x = (&2 + sqrt(&3)) pow (2 EXP n) + (&2 - sqrt(&3)) pow (2 EXP n)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [EXISTS_TAC `4` THEN REWRITE_TAC[llseq; EXP] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `x:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `x EXP 2 - 2` THEN ASM_REWRITE_TAC[llseq] THEN SUBGOAL_THEN `2 <= x EXP 2` ASSUME_TAC THENL [MATCH_MP_TAC(ARITH_RULE `2 EXP 2 <= x ==> 2 <= x`) THEN REWRITE_TAC[EXP_MONO_LE; ARITH_EQ] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ y pow 1 <= y pow n /\ &0 <= z pow n ==> x <= y pow n + z pow n`) THEN REPEAT CONJ_TAC THENL [SIMP_TAC[REAL_LE_ADDR; SQRT_POS_LE; REAL_POS]; MATCH_MP_TAC REAL_POW_MONO THEN SIMP_TAC[LE_1; EXP_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 <= &2 + x`) THEN SIMP_TAC[SQRT_POS_LE; REAL_POS]; MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN CONV_TAC REAL_RAT_REDUCE_CONV]; ALL_TAC] THEN CONJ_TAC THENL [ASM_CASES_TAC `p = 1` THENL [ASM_REWRITE_TAC[MOD_1]; ALL_TAC] THEN TRANS_TAC EQ_TRANS `(x EXP 2 + (p - 2)) MOD p` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[ARITH_RULE `2 <= x /\ ~(p = 0) /\ ~(p = 1) ==> x + p - 2 = (x - 2) + p`]] THEN FIRST_ASSUM(fun t -> ONCE_REWRITE_TAC[GSYM(MATCH_MP MOD_ADD_MOD t)]) THENL [ASM_MESON_TAC[MOD_EXP_MOD]; ASM_SIMP_TAC[MOD_REFL; ADD_CLAUSES; MOD_MOD_REFL]]; ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[ADD1; EXP_ADD; GSYM REAL_POW_MUL; REAL_ARITH `(x + y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`] THEN REWRITE_TAC[REAL_ARITH `(&2 + s) * (&2 - s) = &4 - s pow 2`] THEN REWRITE_TAC[REAL_SQRT_POW_2; REAL_ABS_NUM; GSYM REAL_POW_POW] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE] THEN CONV_TAC REAL_RING]);; (* ------------------------------------------------------------------------- *) (* The main Lucas-Lehmer theorem. *) (* ------------------------------------------------------------------------- *) let LUCAS_LEHMER = prove (`!p. 2 <= p /\ llseq (2 EXP p - 1) (p - 2) = 0 ==> prime(2 EXP p - 1)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[PRIME_PRIME_FACTOR_SQRT] THEN SUBGOAL_THEN `2 <= 2 EXP p - 1` ASSUME_TAC THENL [MATCH_MP_TAC(ARITH_RULE `2 EXP 2 <= x ==> 2 <= x - 1`) THEN REWRITE_TAC[LE_EXP] THEN ASM_ARITH_TAC; ALL_TAC] THEN REPEAT(MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN DISCH_THEN(X_CHOOSE_THEN `q:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_GE_2) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN ABBREV_TAC `equiv = \x y. ?a b. integer a /\ integer b /\ x - y = (a + b * sqrt(&3)) * &q` THEN SUBGOAL_THEN `!x:real. (x == x) equiv` ASSUME_TAC THENL [REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN GEN_TAC THEN REPEAT(EXISTS_TAC `&0`) THEN REWRITE_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!x y:real. (x == y) equiv <=> (y == x) equiv` ASSUME_TAC THENL [MATCH_MP_TAC(MESON[] `(!x y. P x y ==> P y x) ==> (!x y. P x y <=> P y x)`) THEN REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN MESON_TAC[INTEGER_CLOSED; REAL_ARITH `x - y:real = (a + b * s) * q ==> y - x = (--a + --b * s) * q`]; ALL_TAC] THEN SUBGOAL_THEN `!x y z:real. (x == y) equiv /\ (y == z) equiv ==> (x == z) equiv` ASSUME_TAC THENL [REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN MESON_TAC[INTEGER_CLOSED; REAL_ARITH `x - y = (a + b * s) * q /\ y - z = (a' + b' * s) * q ==> x - z:real = ((a + a') + (b + b') * s) * q`]; ALL_TAC] THEN SUBGOAL_THEN `!k. ?a b. (&2 + sqrt(&3)) pow k = &a + &b * sqrt(&3)` STRIP_ASSUME_TAC THENL [INDUCT_TAC THENL [MAP_EVERY EXISTS_TAC [`1`; `0`] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(X_CHOOSE_THEN `a:num` MP_TAC) THEN REWRITE_TAC[real_pow; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num` THEN DISCH_THEN SUBST1_TAC THEN MAP_EVERY EXISTS_TAC [`2 * a + 3 * b`; `2 * b + a`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN MP_TAC(SPEC `&3` SQRT_POW_2) THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RING]; ALL_TAC] THEN SUBGOAL_THEN `!x y. ((&2 + sqrt(&3)) * x == (&2 + sqrt(&3)) * y) equiv <=> (x == y) equiv` ASSUME_TAC THENL [SUBGOAL_THEN `!x y:real. (x == y) equiv <=> (x - y == &0) equiv` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN SIMP_TAC[REAL_SUB_RZERO]; REWRITE_TAC[GSYM REAL_SUB_LDISTRIB]] THEN REPEAT GEN_TAC THEN SPEC_TAC(`x - y:real`,`x:real`) THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN REWRITE_TAC[REAL_SUB_RZERO] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_TAC THENL [MAP_EVERY EXISTS_TAC [`&2 * u - &3 * v`; `&2 * v - u`]; MAP_EVERY EXISTS_TAC [`&2 * u + &3 * v`; `&2 * v + u`]] THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN MP_TAC(SPEC `&3` SQRT_POW_2) THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RING; ALL_TAC] THEN SUBGOAL_THEN `((&2 + sqrt(&3)) pow (2 EXP (p - 1)) == -- &1) equiv` ASSUME_TAC THENL [UNDISCH_THEN `!x y:real. (x == y) equiv <=> (y == x) equiv` (K ALL_TAC) THEN MP_TAC(ISPECL [`2 EXP p - 1`; `p - 2`] LLSEQ_CLOSEDFORM) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN ASM_SIMP_TAC[MOD_EQ_0; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` (MP_TAC o AP_TERM `(*) ((&2 + sqrt(&3)) pow (2 EXP (p - 2)))`)) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ADD_LDISTRIB] THEN REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_POW_2; REAL_POW_POW] THEN REWRITE_TAC[REAL_ARITH `(&2 + s) * (&2 - s) = &4 - s pow 2`] THEN REWRITE_TAC[REAL_SQRT_POW_2; REAL_ABS_NUM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE] THEN REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= p ==> SUC(p - 2) = p - 1`] THEN SUBGOAL_THEN `?a b. (&2 + sqrt(&3)) pow (2 EXP (p - 2)) = &a + &b * sqrt(&3)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN REWRITE_TAC[REAL_SUB_RNEG] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `s:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN MAP_EVERY EXISTS_TAC [`&a * &r * &s`; `&b * &r * &s`] THEN SIMP_TAC[INTEGER_CLOSED; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `((&2 + sqrt(&3)) pow (2 EXP p) == &1) equiv` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cong]) THEN REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ARITH `a - -- &1 = b <=> a = b - &1`] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `p = (p - 1) + 1` SUBST1_TAC THENL [UNDISCH_TAC `2 <= p` THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[EXP_ADD; GSYM REAL_POW_POW] THEN EXISTS_TAC `&q * (a pow 2 + &3 * b pow 2) - &2 * a` THEN EXISTS_TAC `&2 * a * b * &q - &2 * b` THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED]; ALL_TAC]) THEN CONV_TAC NUM_REDUCE_CONV THEN MP_TAC(SPEC `&3` SQRT_POW_2) THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RING; ALL_TAC] THEN SUBGOAL_THEN `?k. 0 < k /\ k <= 2 EXP p - 1 /\ !n. ((&2 + sqrt(&3)) pow n == &1) equiv <=> k divides n` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `\x y:real. (x == y) equiv` ORDER_EXISTENCE_CARD) THEN REWRITE_TAC[REAL_POW_ITER] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (MESON[CARD_SUBSET; FINITE_SUBSET; LE_TRANS; CARD_IMAGE_LE; FINITE_IMAGE] `!f:num#num->A t. s SUBSET IMAGE f t /\ FINITE t /\ CARD t <= n ==> FINITE s /\ CARD s <= n`) THEN EXISTS_TAC `\(a,b) y. (y == &a + &b * sqrt(&3)) equiv` THEN EXISTS_TAC `(0..q-1) CROSS (0..q-1)` THEN SIMP_TAC[CARD_CROSS; FINITE_CROSS; FINITE_NUMSEG; CARD_NUMSEG] THEN ASM_SIMP_TAC[SUB_ADD; SUB_0; LE_1; GSYM EXP_2; SUBSET] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; IN_IMAGE; EXISTS_PAIR_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_CROSS; GSYM REAL_POW_ITER] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:num` MP_TAC o SPEC `n:num`) THEN DISCH_THEN(X_CHOOSE_TAC `b:num`) THEN MAP_EVERY EXISTS_TAC [`a MOD q`; `b MOD q`] THEN ASM_SIMP_TAC[IN_NUMSEG; LE_0; DIVISION; FUN_EQ_THM; ARITH_RULE `a <= q - 1 <=> a = 0 \/ a < q`] THEN MATCH_MP_TAC(MESON[] `(a == b) equiv /\ ((a == b) equiv ==> !x. (x == a) equiv <=> (x == b) equiv) ==> !x. (x == a) equiv <=> (x == b) equiv`) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN MAP_EVERY EXISTS_TAC [`&(a DIV q)`; `&(b DIV q)`] THEN REWRITE_TAC[INTEGER_CLOSED; REAL_RING `(a + b * s) - (a' + b' * s):real = (a'' + b'' * s) * q <=> a + b * s = (a'' * q + a') + (b'' * q + b') * s`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN ASM_SIMP_TAC[GSYM DIVISION]; SUBGOAL_THEN `k divides 2 EXP p` MP_TAC THENL [ASM_MESON_TAC[]; SIMP_TAC[DIVIDES_PRIMEPOW; PRIME_2]] THEN REWRITE_TAC[LE_LT; RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2] THEN ASM_SIMP_TAC[ARITH_RULE `k <= p - 1 ==> (k = p <=> p = 0)`] THEN REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `((&2 + sqrt (&3)) pow (2 EXP (p - 1)) == &1) (equiv)` ASSUME_TAC THENL [ASM_REWRITE_TAC[] THEN SIMP_TAC[DIVIDES_EXP_LE; LE_REFL] THEN ASM_SIMP_TAC[ARITH_RULE `i < p ==> i <= p - 1`]; ALL_TAC] THEN SUBGOAL_THEN `(&1 == -- &1) (equiv)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[REAL_ARITH `&1 - -- &1 = &2`] THEN ASM_CASES_TAC `b = &0` THENL [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN DISCH_THEN(MP_TAC o AP_TERM `abs`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN SUBGOAL_THEN `?q. abs a = &q` (CHOOSE_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[integer]; REWRITE_TAC[REAL_ABS_NUM]] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN MP_TAC PRIME_2 THEN REWRITE_TAC[prime; ARITH_EQ] THEN DISCH_THEN(MP_TAC o SPEC `q:num`) THEN ANTS_TAC THENL [REWRITE_TAC[divides] THEN ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[NUM_REDUCE_CONV `2 <= 1`]; ALL_TAC] THEN SUBGOAL_THEN `2 divides (2 EXP p - 1) + 2` MP_TAC THENL [MATCH_MP_TAC DIVIDES_ADD THEN ASM_REWRITE_TAC[DIVIDES_REFL]; ASM_SIMP_TAC[ARITH_RULE `~(n - 1 = 0) ==> n - 1 + 2 = n + 1`]] THEN REWRITE_TAC[DIVIDES_2; EVEN_ADD; EVEN_EXP; ARITH] THEN UNDISCH_TAC `2 <= p` THEN ARITH_TAC; DISCH_THEN(MP_TAC o MATCH_MP (REAL_FIELD `&2 = (a + b * x) * q ==> ~(b = &0) ==> x = (&2 - a * q) / (b * q)`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `rational`) THEN SIMP_TAC[IRRATIONAL_SQRT_PRIME; PRIME_CONV `prime 3`] THEN ASM_MESON_TAC[RATIONAL_CLOSED; INTEGER_CLOSED]]]);; (* ------------------------------------------------------------------------- *) (* Actual evaluation of the LL sequence. *) (* ------------------------------------------------------------------------- *) let ll_verbose = ref false;; let LUCAS_LEHMER_RULE = let pth_base = prove (`llseq (2 EXP p - 1) 0 = 4 MOD (2 EXP p - 1)`, REWRITE_TAC[llseq]) and pth_step = prove (`llseq (2 EXP p - 1) n = m ==> m * m + q = 2 EXP p * q + 2 + r /\ r < 2 EXP p - 1 ==> llseq (2 EXP p - 1) (SUC n) = r`, REWRITE_TAC[llseq] THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[LT] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[MOD_1; ARITH_RULE `r < 1 <=> r = 0`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `q + 1` THEN ASM_REWRITE_TAC[EXP_2] THEN MATCH_MP_TAC(ARITH_RULE `!p:num. (x + p) + y = p + z ==> x + y = z`) THEN EXISTS_TAC `q:num` THEN ASM_REWRITE_TAC[RIGHT_ADD_DISTRIB; LEFT_SUB_DISTRIB; MULT_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `x + y - 1 + w = u + v + z + r + 2 /\ 2 EXP 2 <= y /\ w * 1 <= v ==> x + y - 1 - 2 = u + (v - w + z) + r`) THEN REWRITE_TAC[LE_MULT_LCANCEL; LE_EXP; EXP_EQ_0; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC) and pconv_tt = GEN_REWRITE_CONV I [TAUT `T /\ T <=> T`] and p_tm = `p:num` and n_tm = `n:num` and m_tm = `m:num` and q_tm = `q:num` and r_tm = `r:num` in let ariconv = let BINOP2_CONV conv1 conv2 = COMB2_CONV (RAND_CONV conv1) conv2 in (BINOP2_CONV (BINOP2_CONV (LAND_CONV NUM_MULT_CONV THENC NUM_ADD_CONV) (BINOP2_CONV NUM_MULT_CONV NUM_ADD_CONV THENC NUM_ADD_CONV) THENC NUM_EQ_CONV) NUM_LT_CONV THENC pconv_tt) in fun p -> let th_base = CONV_RULE(RAND_CONV NUM_REDUCE_CONV) (INST [mk_small_numeral p,p_tm] pth_base) and th_step = CONV_RULE(RAND_CONV(LAND_CONV NUM_REDUCE_CONV)) (INST [mk_small_numeral p,p_tm] pth_step) and pp1 = pow2 p -/ Int 1 in let rec lucas_lehmer k = if k = 0 then th_base,dest_numeral(rand(concl th_base)) else let th1,mval = lucas_lehmer (k - 1) in let gofer() = let mtm = rand(concl th1) in let yval = power_num mval (Int 2) in let qval = quo_num yval pp1 and rval = mod_num yval pp1 -/ Int 2 in let th3 = INST [mk_small_numeral(k - 1),n_tm; mtm,m_tm; mk_numeral qval,q_tm; mk_numeral rval,r_tm] th_step in let th4 = MP th3 th1 in let th5 = MP th4 (EQT_ELIM(ariconv(lhand(concl th4)))) in CONV_RULE (LAND_CONV(RAND_CONV NUM_SUC_CONV)) th5,rval in if !ll_verbose then (Format.print_string("Iteration "^string_of_int k^" of "^ string_of_int(p-2)); Format.print_newline(); time gofer()) else gofer() in let th1,y = lucas_lehmer (p - 2) in if y <>/ Int 0 then failwith "LUCAS_LEHMER_RULE: not a prime" else let th2 = SPEC(mk_small_numeral p) LUCAS_LEHMER in let th3 = CONV_RULE (LAND_CONV(RAND_CONV(LAND_CONV (RAND_CONV NUM_SUB_CONV THENC K th1)))) th2 in MP th3 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th3))));; (* ------------------------------------------------------------------------- *) (* Time a few small examples. *) (* ------------------------------------------------------------------------- *) ll_verbose := false;; time LUCAS_LEHMER_RULE 3;; time LUCAS_LEHMER_RULE 5;; time LUCAS_LEHMER_RULE 7;; time LUCAS_LEHMER_RULE 13;; time LUCAS_LEHMER_RULE 17;; time LUCAS_LEHMER_RULE 19;; time LUCAS_LEHMER_RULE 31;; time LUCAS_LEHMER_RULE 61;; time LUCAS_LEHMER_RULE 89;; time LUCAS_LEHMER_RULE 107;; time LUCAS_LEHMER_RULE 127;; time LUCAS_LEHMER_RULE 521;; time LUCAS_LEHMER_RULE 607;; (* ------------------------------------------------------------------------- *) (* These take a while, so they're commented out here. *) (* ------------------------------------------------------------------------- *) (*** ll_verbose := true;; time LUCAS_LEHMER_RULE 1279;; time LUCAS_LEHMER_RULE 2203;; time LUCAS_LEHMER_RULE 2281;; time LUCAS_LEHMER_RULE 3217;; time LUCAS_LEHMER_RULE 4253;; time LUCAS_LEHMER_RULE 4423;; time LUCAS_LEHMER_RULE 9689;; time LUCAS_LEHMER_RULE 9941;; time LUCAS_LEHMER_RULE 11213;; time LUCAS_LEHMER_RULE 19937;; time LUCAS_LEHMER_RULE 21701;; time LUCAS_LEHMER_RULE 23209;; time LUCAS_LEHMER_RULE 44497;; time LUCAS_LEHMER_RULE 86243;; time LUCAS_LEHMER_RULE 110503;; time LUCAS_LEHMER_RULE 132049;; time LUCAS_LEHMER_RULE 216091;; time LUCAS_LEHMER_RULE 756839;; time LUCAS_LEHMER_RULE 859433;; time LUCAS_LEHMER_RULE 1257787;; time LUCAS_LEHMER_RULE 1398269;; time LUCAS_LEHMER_RULE 2976221;; time LUCAS_LEHMER_RULE 3021377;; time LUCAS_LEHMER_RULE 6972593;; time LUCAS_LEHMER_RULE 13466917;; time LUCAS_LEHMER_RULE 20996011;; time LUCAS_LEHMER_RULE 24036583;; time LUCAS_LEHMER_RULE 25964951;; time LUCAS_LEHMER_RULE 30402457;; ****) hol-light/Examples/machin.ml000066400000000000000000001123771303454263000163270ustar00rootroot00000000000000(* ========================================================================= *) (* Derivation of Machin's formula and other similar ones. *) (* ========================================================================= *) needs "Library/transc.ml";; let REAL_LE_1_POW2 = prove (`!n. &1 <= &2 pow n`, REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> 0 < n`; EXP_LT_0; ARITH]);; let REAL_LT_1_POW2 = prove (`!n. &1 < &2 pow n <=> ~(n = 0)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&2 pow 0`)) THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let REAL_POW2_CLAUSES = prove (`(!n. &0 <= &2 pow n) /\ (!n. &0 < &2 pow n) /\ (!n. &0 <= inv(&2 pow n)) /\ (!n. &0 < inv(&2 pow n)) /\ (!n. inv(&2 pow n) <= &1) /\ (!n. &1 - inv(&2 pow n) <= &1) /\ (!n. &1 <= &2 pow n) /\ (!n. &1 < &2 pow n <=> ~(n = 0)) /\ (!n. &0 <= &1 - inv(&2 pow n)) /\ (!n. &0 <= &2 pow n - &1) /\ (!n. &0 < &1 - inv(&2 pow n) <=> ~(n = 0))`, SIMP_TAC[REAL_LE_1_POW2; REAL_LT_1_POW2; REAL_SUB_LE; REAL_SUB_LT; REAL_INV_LE_1] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_INV_EQ; REAL_POW_LT; REAL_POW_LE; REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH; REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2 pow 1)` THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_POW_MONO; REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let REAL_POW2_THM = prove (`&0 < &2 pow n /\ &1 <= &2 pow n /\ (&1 < &2 pow n <=> ~(n = 0)) /\ (&2 pow m <= &2 pow n <=> m <= n) /\ (&2 pow m < &2 pow n <=> m < n) /\ (inv(&2 pow m) <= inv(&2 pow n) <=> n <= m) /\ (inv(&2 pow m) < inv(&2 pow n) <=> n < m)`, REWRITE_TAC[REAL_POW2_CLAUSES] THEN SUBGOAL_THEN `!m n. &2 pow m <= &2 pow n <=> m <= n` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH] THEN CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; REAL_POW_MONO_LT; REAL_OF_NUM_LT; NOT_LE; ARITH]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN REWRITE_TAC[GSYM NOT_LE] THEN SUBGOAL_THEN `!m n. inv(&2 pow m) <= inv(&2 pow n) <=> &2 pow n <= &2 pow m` (fun th -> ASM_REWRITE_TAC[th]) THEN REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_LE_INV2; REAL_POW2_CLAUSES] THEN CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[REAL_NOT_LE; REAL_LT_INV2; REAL_POW2_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Compound errors given bounds in assumptions. *) (* ------------------------------------------------------------------------- *) let BOUND_SUMPROD_RULE = let pth_add = REAL_ARITH `abs(x1) <= b1 /\ abs(x2) <= b2 ==> abs(x1 + x2) <= b1 + b2` and pth_sub = REAL_ARITH `abs(x1) <= b1 /\ abs(x2) <= b2 ==> abs(x1 - x2) <= b1 + b2` and pth_mul = prove (`abs(x1) <= b1 /\ abs(x2) <= b2 ==> abs(x1 * x2) <= b1 * b2`, REWRITE_TAC[REAL_ABS_MUL] THEN SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS]) and pth_neg = REAL_ARITH `abs(x1) <= b1 ==> abs(--x1) <= b1` and pth_pow = prove (`abs(x) <= b1 ==> abs(x pow n) <= b1 pow n`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]) and pth_abs = REAL_ARITH `abs(x) <= b ==> abs(abs(x)) <= b` and pth_triv = REAL_ARITH `abs(x) <= abs(x)` and n_tm = `n:num` in let rec BOUND_SUMPROD_RULE (asl,w) = let tm = rator w in try tryfind (fun (_,th) -> if rator(concl th) = tm then th else fail()) asl with Failure _ -> try let pth,th = tryfind (fun pth -> pth,PART_MATCH (rator o rand) pth tm) [pth_neg; pth_abs] in let th1 = BOUND_SUMPROD_RULE (asl,lhand(concl th)) in MATCH_MP pth th1 with Failure _ -> try let pth = INST [funpow 3 rand tm,n_tm] pth_pow in let th = PART_MATCH (rator o rand) pth tm in let th1 = BOUND_SUMPROD_RULE (asl,lhand(concl th)) in MATCH_MP (INST [funpow 3 rand tm,n_tm] pth_pow) th1 with Failure _ -> try let pth,th = tryfind (fun pth -> pth,PART_MATCH (rator o rand) pth tm) [pth_add; pth_sub; pth_mul] in let trm = lhand(concl th) in let th1 = BOUND_SUMPROD_RULE (asl,lhand trm) and th2 = BOUND_SUMPROD_RULE (asl,rand trm) in MATCH_MP pth (CONJ th1 th2) with Failure _ -> PART_MATCH rator pth_triv tm in BOUND_SUMPROD_RULE;; let BOUND_SUMPROD_TAC = let tac = let pth = REAL_ARITH `x <= a ==> (!b. a <= b ==> x <= b) /\ (!b. a < b ==> x < b)` in fun th -> let th1,th2 = CONJ_PAIR(MATCH_MP pth th) in MATCH_MP_TAC th1 ORELSE MATCH_MP_TAC th2 and le_tm = `(<=):real->real->bool` in fun (asl,w as gl) -> let l,r = dest_comb w in let gv = genvar(type_of r) in let tm = mk_comb(mk_comb(le_tm,rand l),gv) in let th = BOUND_SUMPROD_RULE(asl,tm) in tac th gl;; (* ------------------------------------------------------------------------- *) (* Power series for atn. *) (* ------------------------------------------------------------------------- *) let REAL_ATN_POWSER_SUMMABLE = prove (`!x. abs(x) < &1 ==> summable (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_LDIV THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_OF_NUM_LT; EVEN; LT_NZ]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN ASM_MESON_TAC[REAL_OF_NUM_LE; EVEN; ARITH_RULE `1 <= n <=> ~(n = 0)`]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; let REAL_ATN_POWSER_DIFFS_SUMMABLE = prove (`!x. abs(x) < &1 ==> summable (\n. diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; let REAL_ATN_POWSER_DIFFS_SUM = prove (`!x. abs(x) < &1 ==> (\n. diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n) sums (inv(&1 + x pow 2))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUMMABLE) THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP SUMMABLE_SUM th) THEN MP_TAC(MATCH_MP SER_PAIR th)) THEN SUBGOAL_THEN `(\n. sum (2 * n,2) (\n. diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)) = (\n. --(x pow 2) pow n)` SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC(LAND_CONV(LAND_CONV(RAND_CONV(TOP_DEPTH_CONV num_CONV)))) THEN REWRITE_TAC[sum; diffs; ADD_CLAUSES; EVEN_MULT; ARITH_EVEN; EVEN] THEN REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN SIMP_TAC[ARITH_RULE `SUC n - 1 = n`; DIV_MULT; ARITH_EQ] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN ONCE_REWRITE_TAC[GSYM REAL_POW_POW] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `(\n. --(x pow 2) pow n) sums inv (&1 + x pow 2)` MP_TAC THENL [ONCE_REWRITE_TAC[REAL_ARITH `&1 + x = &1 - (--x)`] THEN MATCH_MP_TAC GP THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_POW_2; REAL_LT_MUL2; REAL_ABS_POS]; ALL_TAC] THEN MESON_TAC[SUM_UNIQ]);; let REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE = prove (`!x. abs(x) < &1 ==> summable (\n. diffs (diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n))) n * x pow n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. &(SUC n) * abs(x) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_MUL_LID; REAL_ABS_NUM; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC SER_RATIO THEN SUBGOAL_THEN `?c. abs(x) < c /\ c < &1` STRIP_ASSUME_TAC THENL [EXISTS_TAC `(&1 + abs(x)) / &2` THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?N. !n. n >= N ==> &(SUC(SUC n)) * abs(x) <= &(SUC n) * c` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_pow; REAL_ABS_MUL; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_ABS] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[]] THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN UNDISCH_TAC `abs(x) < c` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN ONCE_REWRITE_TAC[REAL_ARITH `x + &1 <= y <=> &1 <= y - x * &1`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN SUBGOAL_THEN `?N. &1 <= &N * (c / abs x - &1)` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `N:num` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&1 <= x ==> x <= y ==> &1 <= y`)) THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_ARITH `a <= b ==> a <= b + &1`; REAL_OF_NUM_LE; REAL_LE_RADD] THEN REWRITE_TAC[REAL_LE_SUB_LADD; REAL_ADD_LID] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; REAL_LT_IMP_LE]] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_SUB_LADD; REAL_ADD_LID; REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; REAL_ARCH_SIMPLE]);; let REAL_ATN_POWSER_DIFFL = prove (`!x. abs(x) < &1 ==> ((\x. suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)) diffl (inv(&1 + x pow 2))) x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUM) THEN DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN MATCH_MP_TAC TERMDIFF THEN SUBGOAL_THEN `?K. abs(x) < abs(K) /\ abs(K) < &1` STRIP_ASSUME_TAC THENL [EXISTS_TAC `(&1 + abs(x)) / &2` THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_ATN_POWSER_SUMMABLE; REAL_ATN_POWSER_DIFFS_SUMMABLE; REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE]);; let REAL_ATN_POWSER = prove (`!x. abs(x) < &1 ==> (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) sums (atn x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_SUMMABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN SUBGOAL_THEN `suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) = atn(x)` (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a = b) <=> (a - b = &0)`] THEN SUBGOAL_THEN `suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * &0 pow n) - atn(&0) = &0` MP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `(a = &0) /\ (b = &0) ==> (a - b = &0)`) THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN MP_TAC(SPEC `&0` GP) THEN REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP SER_CMUL) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN ASM_MESON_TAC[EVEN]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM TAN_0] THEN MATCH_MP_TAC TAN_ATN THEN SIMP_TAC[PI2_BOUNDS; REAL_ARITH `&0 < x ==> --x < &0`]]; ALL_TAC] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MP_TAC(SPEC `\x. suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) - atn x` DIFF_ISCONST_END_SIMPLE) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ x < &0`)) THENL [DISCH_THEN(MP_TAC o SPECL [`&0`; `x:real`]); CONV_TAC(RAND_CONV SYM_CONV) THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `&0`])] THEN (REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:real` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(u) < &1` (MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFL) THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o C CONJ (SPEC `u:real` DIFF_ATN)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN REWRITE_TAC[REAL_SUB_REFL]));; (* ------------------------------------------------------------------------- *) (* A more Taylor-like version with a simply bounded remainder term. *) (* ------------------------------------------------------------------------- *) let MCLAURIN_ATN_SIMPLE = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(k = 0) ==> abs(atn x - sum(0,n) (\m. (if EVEN m then &0 else --(&1) pow ((m - 1) DIV 2) / &m) * x pow m)) <= &2 * abs(x) pow n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(x) < &1` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[REAL_ARITH `a < &1 <=> &0 < &1 - a`; REAL_POW2_CLAUSES]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER) THEN DISCH_THEN(fun th -> ASSUME_TAC(SYM(MATCH_MP SUM_UNIQ th)) THEN MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_OFFSET) THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN MATCH_MP_TAC(REAL_ARITH `abs(r) <= e ==> (f - s = r) ==> abs(f - s) <= e`) THEN SUBGOAL_THEN `(\m. abs(x) pow (m + n)) sums (abs(x) pow n) * inv(&1 - abs(x))` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP GP o MATCH_MP (REAL_ARITH `abs(x) < &1 ==> abs(abs x) < &1`)) THEN DISCH_THEN(MP_TAC o SPEC `abs(x) pow n` o MATCH_MP SER_CMUL) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_POW_ADD]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `suminf (\m. abs(x) pow (m + n))` THEN CONJ_TAC THENL [ALL_TAC; FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_ABS_POS; REAL_POW_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= &1 - b <=> b <= &1 - a`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN ASM_SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; ARITH_RULE `~(k = 0) ==> 1 <= k`]] THEN SUBGOAL_THEN `!m. abs((if EVEN (m + n) then &0 else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * x pow (m + n)) <= abs(x) pow (m + n)` ASSUME_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN SIMP_TAC[REAL_MUL_LZERO; REAL_ABS_NUM; REAL_POW_LE; REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM_MESON_TAC[EVEN]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `suminf (\m. abs((if EVEN (m + n) then &0 else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * x pow (m + n)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SER_ABS THEN MATCH_MP_TAC SER_COMPARA THEN EXISTS_TAC `\m. abs(x) pow (m + n)` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUM_SUMMABLE]; ALL_TAC] THEN MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SER_COMPARA THEN EXISTS_TAC `\m. abs(x) pow (m + n)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[SUM_SUMMABLE]);; let MCLAURIN_ATN_APPROX = prove (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(k = 0) ==> abs(atn x - sum(0,n) (\m. (if EVEN m then &0 else --(&1) pow ((m - 1) DIV 2) / &m) * x pow m)) <= inv(&2 pow (n * k - 1))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[sum; REAL_SUB_RZERO; MULT_CLAUSES; SUB_0] THEN MP_TAC(SPECL [`x:real`; `2`; `k:num`] MCLAURIN_ATN_SIMPLE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `abs(y) + d <= e ==> abs(x - y) <= d ==> abs(x) <= e`) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[real_pow; REAL_POW_1] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_1; REAL_ADD_LID] THEN SUBGOAL_THEN `abs(x) <= inv(&2)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN ASM_SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; ARITH_RULE `~(k = 0) ==> 1 <= k`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2) + &2 * inv(&2) pow 2` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[REAL_POW_1] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; REAL_POW_LE2; REAL_OF_NUM_LE; REAL_ABS_POS]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * abs(x) pow n` THEN CONJ_TAC THENL [MATCH_MP_TAC MCLAURIN_ATN_SIMPLE THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ; ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0] THEN REWRITE_TAC[REAL_INV_DIV; REAL_POW_1] THEN REWRITE_TAC[real_div] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN ONCE_REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; (* ------------------------------------------------------------------------- *) (* Rules to return approximations to atn(x) good to 2^-p given |x| <= 2^-k. *) (* ------------------------------------------------------------------------- *) let mclaurin_atn_rule,MCLAURIN_ATN_RULE = let x_tm = `x:real` and n_tm = `n:num` and k_tm = `k:num` and inv_tm = `inv` and le_tm = `(<=):real->real->bool` and pow2_tm = `(pow) (&2)` in let pth = SPECL [x_tm; n_tm; k_tm] MCLAURIN_ATN_APPROX and CLEAN_RULE = REWRITE_RULE[real_pow] and MATCH_REAL_LE_TRANS = MATCH_MP REAL_LE_TRANS and num_0 = Int 0 and num_1 = Int 1 in let mclaurin_atn_rule k0 p0 = if k0 = 0 then failwith "mclaurin_atn_rule: must have |x| <= 1/2" else let k = Int k0 and p = Int p0 in let n = Num.int_of_num(ceiling_num ((p +/ k) // k)) in let ns = if n mod 2 = 0 then 0--(n - 1) else 0--(n - 2) in map (fun m -> if m mod 2 = 0 then num_0 else (if (m - 1) mod 4 = 0 then I else minus_num) (num_1 // Int m)) ns and MCLAURIN_ATN_RULE k0 p0 = if k0 = 0 then failwith "MCLAURIN_ATN_RULE: must have |x| <= 1/2" else let k = Int k0 and p = Int p0 in let n = ceiling_num ((p +/ k) // k) in let th1 = INST [mk_numeral k,k_tm; mk_numeral n,n_tm] pth in let th2 = ASSUME (lhand(lhand(concl th1))) and th3 = EQF_ELIM(NUM_REDUCE_CONV(rand(rand(lhand(concl th1))))) in let th4 = MP th1 (CONJ th2 th3) in let th5 = CONV_RULE(ONCE_DEPTH_CONV REAL_HORNER_SUM_CONV) th4 in let th6 = CLEAN_RULE th5 in let th7 = CONV_RULE (NUM_REDUCE_CONV THENC LAND_CONV REAL_RAT_REDUCE_CONV) (BETA_RULE th6) in let tm1 = mk_comb(inv_tm,mk_comb(pow2_tm,mk_numeral p)) in let tm2 = mk_comb(mk_comb(le_tm,rand(concl th7)),tm1) in let th8 = EQT_ELIM((NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) tm2) in let th9 = MATCH_REAL_LE_TRANS (CONJ th7 th8) in GEN x_tm (DISCH_ALL th9) in mclaurin_atn_rule,MCLAURIN_ATN_RULE;; (* ------------------------------------------------------------------------- *) (* Lemmas for Machin-type formulas. *) (* ------------------------------------------------------------------------- *) let TAN_ADD_ATN_SIDECOND = prove (`!x y. ~(x * y = &1) ==> ~(cos(atn x + atn y) = &0)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[COS_ADD; REAL_ARITH `(a - b = &0) <=> (a = b)`] THEN DISCH_THEN(MP_TAC o AP_TERM `(*) (inv(cos(atn x)))`) THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; COS_ATN_NZ; REAL_MUL_LID] THEN DISCH_THEN(MP_TAC o AP_TERM `(*) (inv(cos(atn y)))`) THEN SIMP_TAC[REAL_MUL_LINV; COS_ATN_NZ; REAL_MUL_LID; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (c * b) * (d * a)`] THEN ASM_REWRITE_TAC[GSYM tan; GSYM real_div; ATN_TAN]);; let ATN_ADD = prove (`!x y. ~(x * y = &1) /\ abs(atn x + atn y) < pi / &2 ==> (atn(x) + atn(y) = atn((x + y) / (&1 - x * y)))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `tan(atn(x) + atn(y)) = (x + y) / (&1 - x * y)` MP_TAC THENL [ASM_SIMP_TAC[ATN_TAN; TAN_ADD; COS_ATN_NZ; TAN_ADD_ATN_SIDECOND]; DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[TAN_ATN; REAL_ARITH `abs(x) < e ==> --e < x /\ x < e`]]);; let ATN_ADD_SMALL_LEMMA_POS = prove (`!x y. &0 < y /\ x * y < &1 ==> atn(x) + atn(y) < pi / &2`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN SUBGOAL_THEN `pi / &2 - atn y = atn(tan(pi / &2 - atn y))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC TAN_ATN THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < a ==> --a < a - x /\ a - x < a`) THEN REWRITE_TAC[ATN_BOUNDS] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ATN_0] THEN ASM_SIMP_TAC[ATN_MONO_LT]; MATCH_MP_TAC ATN_MONO_LT THEN REWRITE_TAC[TAN_COT; ATN_TAN] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_LT_IMP_NZ]]);; let ATN_ADD_SMALL_LEMMA = prove (`!x y. abs(x * y) < &1 ==> abs(atn(x) + atn(y)) < pi / &2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `--a < x /\ x < a /\ --a < y /\ y < a /\ (&0 < y ==> x + y < a) /\ (&0 < --y ==> --x + --y < a) ==> abs(x + y) < a`) THEN REWRITE_TAC[ATN_BOUNDS] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ATN_NEG] THEN MATCH_MP_TAC ATN_ADD_SMALL_LEMMA_POS THEN ASM_SIMP_TAC[REAL_ARITH `abs(x) < &1 ==> x < &1`; REAL_ARITH `--x * -- y = x * y`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 < y ==> (z <= &0 ==> y <= &0) ==> &0 < z`)) THEN MATCH_MP_TAC(REAL_ARITH `(y < &0 ==> z < &0) /\ ((y = &0) ==> (z = &0)) ==> y <= &0 ==> z <= &0`) THEN SIMP_TAC[ATN_0; GSYM ATN_NEG] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ATN_0] THEN SIMP_TAC[ATN_MONO_LT]);; let ATN_ADD_SMALL = prove (`!x y. abs(x * y) < &1 ==> (atn(x) + atn(y) = atn((x + y) / (&1 - x * y)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ATN_ADD THEN ASM_SIMP_TAC[ATN_ADD_SMALL_LEMMA] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let ATN_ADD_CONV = let match_fn = PART_MATCH (lhand o rand) ATN_ADD_SMALL in let overall_fn = C MP TRUTH o CONV_RULE (COMB2_CONV REAL_RAT_REDUCE_CONV (RAND_CONV REAL_RAT_REDUCE_CONV)) o match_fn in fun tm -> if is_ratconst(rand(rand tm)) & is_ratconst(rand(lhand tm)) then overall_fn tm else failwith "ATN_ADD_CONV: Atn of nonconstant";; let ATN_CMUL_CONV = let pth_base = prove (`(&0 * atn(x) = &0) /\ (&1 * atn(x) = atn(x))`, REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID]) and pth_0,pth_1 = (CONJ_PAIR o prove) (`(&(NUMERAL(BIT0 n)) * atn(x) = &(NUMERAL n) * atn(x) + &(NUMERAL n) * atn(x)) /\ (&(NUMERAL(BIT1 n)) * atn(x) = atn(x) + &(NUMERAL n) * atn(x) + &(NUMERAL n) * atn(x))`, REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC) in let rewr_base = GEN_REWRITE_CONV I [pth_base] and rewr_0 = GEN_REWRITE_CONV I [pth_0] and rewr_1 = GEN_REWRITE_CONV I [pth_1] in let rec ATN_CMUL_CONV tm = if not (is_ratconst(rand(rand tm))) then failwith "ATN_CMUL_CONV" else try rewr_base tm with Failure _ -> try let th1 = rewr_0 tm in let tm1 = rand(concl th1) in let th2 = ATN_CMUL_CONV(rand tm1) in let th3 = MK_COMB(AP_TERM (rator(rator tm1)) th2,th2) in let th4 = TRANS th3 (ATN_ADD_CONV(rand(concl th3))) in TRANS th1 th4 with Failure _ -> let th1 = rewr_1 tm in let tm1 = rand(rand(concl th1)) in let th2 = ATN_CMUL_CONV(rand tm1) in let th3 = MK_COMB(AP_TERM (rator(rator tm1)) th2,th2) in let th4 = TRANS th3 (ATN_ADD_CONV(rand(concl th3))) in let th5 = AP_TERM (rator(rand(concl th1))) th4 in let th6 = TRANS th5 (ATN_ADD_CONV(rand(concl th5))) in TRANS th1 th6 in ATN_CMUL_CONV;; let ATN_SUB_CONV = let pth = prove (`(atn(x) - atn(y) = atn(x) + atn(--y))`, REWRITE_TAC[real_sub; ATN_NEG]) in GEN_REWRITE_CONV I [pth] THENC RAND_CONV(RAND_CONV REAL_RAT_NEG_CONV) THENC ATN_ADD_CONV;; let MACHIN_CONV = DEPTH_CONV(ATN_ADD_CONV ORELSEC ATN_SUB_CONV ORELSEC ATN_CMUL_CONV);; let MACHIN_RULE tm = SYM(TRANS (MACHIN_CONV tm) ATN_1);; let MACHIN_1 = time MACHIN_RULE `&4 * atn(&1 / &5) - atn(&1 / &239)`;; let MACHIN_2 = time MACHIN_RULE `atn(&1 / &2) + atn(&1 / &3)`;; let MACHIN_3 = time MACHIN_RULE `&2 * atn(&1 / &2) - atn(&1 / &7)`;; let MACHIN_4 = time MACHIN_RULE `&2 * atn(&1 / &3) + atn(&1 / &7)`;; let EULER = time MACHIN_RULE `&5 * atn(&1 / &7) + &2 * atn (&3 / &79)`;; let GAUSS_MACHIN = time MACHIN_RULE `&12 * atn(&1 / &18) + &8 * atn (&1 / &57) - &5 * atn(&1 / &239)`;; let STRASSNITZKY_MACHIN = time MACHIN_RULE `atn(&1 / &2) + atn (&1 / &5) + atn(&1 / &8)`;; let MACHINLIKE_1 = time MACHIN_RULE `&6 * atn(&1 / &8) + &2 * atn(&1 / &57) + atn(&1 / &239)`;; let MACHINLIKE_2 = time MACHIN_RULE `&4 * atn(&1 / &5) - &1 * atn(&1 / &70) + atn(&1 / &99)`;; let MACHINLIKE_3 = time MACHIN_RULE `&1 * atn(&1 / &2) + &1 * atn(&1 / &5) + atn(&1 / &8)`;; let MACHINLIKE_4 = time MACHIN_RULE `&8 * atn(&1 / &10) - &1 * atn(&1 / &239) - &4 * atn(&1 / &515)`;; let MACHINLIKE_5 = time MACHIN_RULE `&5 * atn(&1 / &7) + &4 * atn(&1 / &53) + &2 * atn(&1 / &4443)`;; (***** Hopefully this one would work, but it takes a long time let HWANG_MACHIN = time MACHIN_RULE `&183 * atn(&1 / &239) + &32 * atn(&1 / &1023) - &68 * atn(&1 / &5832) + &12 * atn(&1 / &110443) - &12 * atn(&1 / &4841182) - &100 * atn(&1 / &6826318)`;; *****) (* ------------------------------------------------------------------------- *) (* Approximate the arctan of a rational number. *) (* ------------------------------------------------------------------------- *) let rec POLY l x = if l = [] then num_0 else hd l +/ (x */ POLY (tl l) x);; let atn_approx_conv,ATN_APPROX_CONV = let atn_tm = `atn` and num_0 = Int 0 and num_1 = Int 1 and num_2 = Int 2 in let rec log_2 x = if x <=/ num_1 then log_2 (num_2 */ x) -/ num_1 else if x >/ num_2 then log_2 (x // num_2) +/ num_1 else num_1 in let pth = prove (`!p. abs(atn(&0) - &0) <= inv(&2 pow p)`, SIMP_TAC[ATN_0; REAL_SUB_REFL; REAL_ABS_NUM; REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS]) in let atn_approx_conv p r = if r =/ num_0 then num_0 else let k = Num.int_of_num(minus_num(log_2(abs_num r))) in if k < 1 then failwith "atn_approx_conv: argument too big" else let rats = mclaurin_atn_rule k p in POLY rats r and ATN_APPROX_CONV p tm = let atm,rtm = dest_comb tm in if atm <> atn_tm then failwith "ATN_APPROX_CONV" else let r = rat_of_term rtm in if r =/ num_0 then SPEC (mk_small_numeral p) pth else let k = Num.int_of_num(minus_num(log_2(abs_num r))) in if k < 1 then failwith "ATN_APPROX_CONV: argument too big" else let th1 = MCLAURIN_ATN_RULE k p in let th2 = SPEC rtm th1 in let th3 = MP th2 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th2)))) in CONV_RULE(LAND_CONV(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV))) th3 in atn_approx_conv,ATN_APPROX_CONV;; (* ------------------------------------------------------------------------- *) (* Approximate pi using this and a Machin-type formula. *) (* ------------------------------------------------------------------------- *) let pi_approx_rule,PI_APPROX_RULE = let const_1_8 = Int 1 // Int 8 and const_1_57 = Int 1 // Int 57 and const_1_239 = Int 1 // Int 239 and const_24 = Int 24 and const_8 = Int 8 and const_4 = Int 4 and tm_1_8 = `atn(&1 / &8)` and tm_1_57 = `atn(&1 / &57)` and tm_1_239 = `atn(&1 / &239)` and q1_tm = `q1:num` and q2_tm = `q2:num` and p_tm = `p:num` in let pth = prove (`(q1 = p + 5) /\ (q2 = p + 6) /\ abs(atn(&1 / &8) - a1) <= inv(&2 pow q1) /\ abs(atn(&1 / &57) - a2) <= inv(&2 pow q2) /\ abs(atn(&1 / &239) - a3) <= inv(&2 pow q2) ==> abs(pi - (&24 * a1 + &8 * a2 + &4 * a3)) <= inv(&2 pow p)`, DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(inv(&2 pow 2))` THEN SIMP_TAC[REAL_POW2_CLAUSES; REAL_ARITH `&0 < x ==> &0 < abs(x)`] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_POW_ADD] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_ADD_LDISTRIB; REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div; MACHINLIKE_1] THEN REWRITE_TAC[REAL_ARITH `(x1 + x2 + x3) - (y1 + y2 + y3) = (x1 - y1) + (x2 - y2) + (x3 - y3)`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN BOUND_SUMPROD_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM REAL_ADD_RDISTRIB; REAL_LE_RMUL_EQ; REAL_POW2_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV) in let pi_approx_rule p = let q1 = p + 5 and q2 = p + 6 in let a1 = atn_approx_conv q1 const_1_8 and a2 = atn_approx_conv q2 const_1_57 and a3 = atn_approx_conv q2 const_1_239 in const_24 */ a1 +/ const_8 */ a2 +/ const_4 */ a3 and PI_APPROX_RULE p = let q1 = p + 5 and q2 = p + 6 in let th1 = ATN_APPROX_CONV q1 tm_1_8 and th2 = ATN_APPROX_CONV q2 tm_1_57 and th3 = ATN_APPROX_CONV q2 tm_1_239 in let th4 = INST [mk_small_numeral p,p_tm; mk_small_numeral q1,q1_tm; mk_small_numeral q2,q2_tm] pth in let th5 = EQT_ELIM(NUM_REDUCE_CONV(lhand(lhand(concl th4)))) and th6 = EQT_ELIM(NUM_REDUCE_CONV(lhand(rand(lhand(concl th4))))) in let th7 = MATCH_MP th4 (end_itlist CONJ [th5; th6; th1; th2; th3]) in CONV_RULE(LAND_CONV(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV))) th7 in pi_approx_rule,PI_APPROX_RULE;; (* ------------------------------------------------------------------------- *) (* A version that yields a fraction with power of two denominator. *) (* ------------------------------------------------------------------------- *) let pi_approx_binary_rule,PI_APPROX_BINARY_RULE = let pth = prove (`abs(x - r) <= inv(&2 pow (SUC p)) ==> !a. abs(&2 pow p * r - a) <= inv(&2) ==> abs(x - a / &2 pow p) <= inv(&2 pow p)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(x - r) <= q ==> abs(r - r') <= p - q ==> abs(x - r') <= p`)) THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow p)` THEN SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs(x)`; REAL_POW2_THM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; GSYM real_div; REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; REAL_DIV_POW2; REAL_OF_NUM_EQ; ARITH_EQ; LE_REFL; ARITH_RULE `~(SUC p <= p)`; ARITH_RULE `SUC p - p = 1`; SUB_REFL] THEN UNDISCH_TAC `abs (&2 pow p * r - a) <= inv (&2)` THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV) and num_2 = Int 2 in let pi_approx_binary_rule p = let ppow = power_num num_2 (Int p) in let r = pi_approx_rule (p + 1) in let a = round_num (ppow */ r) in a // ppow and PI_APPROX_BINARY_RULE p = let ppow = power_num num_2 (Int p) in let th1 = PI_APPROX_RULE (p + 1) in let th2 = CONV_RULE(funpow 3 RAND_CONV num_CONV) th1 in let r = rat_of_term(rand(rand(lhand(concl th2)))) in let th3 = SPEC (mk_realintconst(round_num(ppow */ r))) (MATCH_MP pth th2) in let th4 = MP th3 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th3)))) in CONV_RULE(LAND_CONV(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV))) th4 in pi_approx_binary_rule,PI_APPROX_BINARY_RULE;; (* ------------------------------------------------------------------------- *) (* Rule to expand atn(r) for rational r into more easily calculable bits. *) (* ------------------------------------------------------------------------- *) let ATN_EXPAND_CONV = let num_0 = Int 0 and num_1 = Int 1 and num_2 = Int 2 and eighth = Int 1 // Int 8 and atn_tm = `atn` and eighth_tm = `&1 / &8` and mk_mul = mk_binop `(*)` and mk_add = mk_binop `(+)` and amp_tm = `&` in let home_in = let rec homein n x = let x' = (x -/ eighth) // (num_1 +/ x */ eighth) in if x' let ltm,rtm = dest_comb tm in if ltm <> atn_tm then failwith "ATN_EXPAND_CONV" else let r = rat_of_term rtm in let (x,n) = home_in r in let xtm = mk_add (mk_mul (mk_comb(amp_tm,mk_small_numeral n)) (mk_comb(atn_tm,eighth_tm))) (mk_comb(atn_tm,term_of_rat x)) in SYM(MACHIN_CONV xtm);; hol-light/Examples/mangoldt.ml000066400000000000000000001007121303454263000166630ustar00rootroot00000000000000(* ========================================================================= *) (* Mangoldt function and elementary Chebyshev/Mertens results. *) (* ========================================================================= *) needs "Library/pocklington.ml";; needs "Multivariate/transcendentals.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Useful approximation/bound lemmas, simple rather than sharp. *) (* ------------------------------------------------------------------------- *) let LOG_FACT = prove (`!n. log(&(FACT n)) = sum(1..n) (\d. log(&d))`, INDUCT_TAC THEN SIMP_TAC[FACT; SUM_CLAUSES_NUMSEG; LOG_1; ARITH; ARITH_RULE `1 <= SUC n`] THEN SIMP_TAC[GSYM REAL_OF_NUM_MUL; LOG_MUL; REAL_OF_NUM_LT; FACT_LT; LT_0] THEN ASM_REWRITE_TAC[ADD1] THEN REWRITE_TAC[ADD_AC; REAL_ADD_AC]);; let SUM_DIVISORS_FLOOR_LEMMA = prove (`!n d. ~(d = 0) ==> sum(1..n) (\m. if d divides m then &1 else &0) = floor(&n / &d)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FLOOR_DIV_DIV] THEN SIMP_TAC[GSYM SUM_RESTRICT_SET; FINITE_NUMSEG; SUM_CONST; FINITE_RESTRICT; REAL_MUL_RID; REAL_OF_NUM_EQ] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN MAP_EVERY EXISTS_TAC [`\m:num. m DIV d`; `\m:num. m * d`] THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; LE_1; DIV_MULT; DIVIDES_DIV_MULT; FINITE_NUMSEG; ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT; DIV_MONO; LE_1] THEN ASM_SIMP_TAC[LE_RDIV_EQ; MULT_EQ_0; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN CONJ_TAC THENL [GEN_TAC THEN STRIP_TAC; ARITH_TAC] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[DIV_EQ_0] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ARITH_RULE `d = 1 * d`] THEN ASM_SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `n < 1 <=> n = 0`] THEN ASM_MESON_TAC[MULT_CLAUSES]);; let LOG_2_BOUNDS = prove (`&1 / &2 <= log(&2) /\ log(&2) <= &1`, CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM LOG_EXP] THEN MP_TAC(SPEC `inv(&2)` REAL_EXP_BOUND_LEMMA); GEN_REWRITE_TAC RAND_CONV [GSYM LOG_EXP] THEN MP_TAC(SPEC `&1` REAL_EXP_LE_X)] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC LOG_MONO_LE THEN REWRITE_TAC[REAL_EXP_POS_LT; REAL_OF_NUM_LT; ARITH]);; let LOG_LE_REFL = prove (`!n. ~(n = 0) ==> log(&n) <= &n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= y - &1 ==> x <= y`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_ARITH `n = &1 + (n - &1)`] THEN MATCH_MP_TAC LOG_LE THEN REWRITE_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC);; let LOG_FACT_BOUNDS = prove (`!n. ~(n = 0) ==> abs(log(&(FACT n)) - (&n * log(&n) - &n + &1)) <= &2 * log(&n)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 1` THENL [ASM_REWRITE_TAC[num_CONV `1`; FACT] THEN REWRITE_TAC[ARITH; LOG_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LOG_FACT] THEN REWRITE_TAC[REAL_ARITH `abs(x - y) <= e <=> x <= y + e /\ y - e <= x`] THEN CONJ_TAC THENL [MP_TAC(ISPECL[`\z. clog(z)`; `\z. z * clog z - z`; `1`; `n:num`] SUM_INTEGRAL_UBOUND_INCREASING) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN REPEAT STRIP_TAC THENL [COMPLEX_DIFF_TAC THEN CONJ_TAC THEN UNDISCH_TAC `&1 <= Re x` THENL [REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX] THENL [REAL_ARITH_TAC; UNDISCH_TAC `~(x = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM LT_NZ]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN ASM_REAL_ARITH_TAC]; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < a /\ &0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; RE_CX; LOG_MONO_LE_IMP]]; ALL_TAC]; ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN REWRITE_TAC[LOG_1; REAL_ADD_LID; ARITH] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = 1 \/ 2 <= n`)) THENL [ASM_REWRITE_TAC[] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN REWRITE_TAC[LOG_1; SUM_CLAUSES] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL[`\z. clog(z)`; `\z. z * clog z - z`; `2`; `n:num`] SUM_INTEGRAL_LBOUND_INCREASING) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN REPEAT STRIP_TAC THENL [COMPLEX_DIFF_TAC THEN CONJ_TAC THEN UNDISCH_TAC `&1 <= Re x` THENL [REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX] THENL [REAL_ARITH_TAC; UNDISCH_TAC `~(x = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC]; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < a /\ &0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; RE_CX; LOG_MONO_LE_IMP]]; ALL_TAC]] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `y <= x /\ a <= b ==> x <= a ==> y <= b`) THEN ASM_SIMP_TAC[GSYM CX_LOG; SUM_EQ_NUMSEG; REAL_OF_NUM_LT; LE_1; CLOG_1; ARITH_RULE `2 <= n ==> 0 < n`; RE_CX; REAL_ARITH `&0 < &n + &1`; REAL_EQ_IMP_LE] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; GSYM CX_ADD; RE_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RNEG] THENL [REWRITE_TAC[REAL_ARITH `(n + &1) * l' - (n + &1) + &1 <= (n * l - n + &1) + k * l <=> (n + &1) * l' <= (n + k) * l + &1`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&n + &1) * (log(&n) + &1 / &n)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `x <= y + z <=> x - y <= z`] THEN ASM_SIMP_TAC[GSYM LOG_DIV; REAL_OF_NUM_LT; LT_NZ; REAL_ARITH `&0 < &n + &1`; REAL_FIELD `&0 < x ==> (x + &1) / x = &1 + &1 / x`] THEN MATCH_MP_TAC LOG_LE THEN SIMP_TAC[REAL_LE_DIV; REAL_POS]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `(n + &1) * (l + n') <= (n + k) * l + &1 <=> n' * (n + &1) <= (k - &1) * l + &1`] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_LE_RADD; REAL_FIELD `~(n = &0) ==> &1 / n * (n + &1) = inv(n) + &1`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `log(&2)` THEN REWRITE_TAC[LOG_2_BOUNDS] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; SUBGOAL_THEN `&0 <= log(&n)` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC LOG_POS THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The Mangoldt function and its key expansion. *) (* ------------------------------------------------------------------------- *) let mangoldt = new_definition `mangoldt n = if ?p k. 1 <= k /\ prime p /\ n = p EXP k then log(&(@p. prime p /\ p divides n)) else &0`;; let MANGOLDT_1 = prove (`mangoldt 1 = &0`, REWRITE_TAC[mangoldt] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[EXP_EQ_1] THEN MESON_TAC[PRIME_1; ARITH_RULE `~(1 <= 0)`]);; let MANGOLDT_PRIMEPOW = prove (`!p k. prime p ==> mangoldt(p EXP k) = if 1 <= k then log(&p) else &0`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[mangoldt] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN ASM_SIMP_TAC[EQ_PRIME_EXP; LE_1] THEN REWRITE_TAC[TAUT `~(a /\ b ==> ~(c /\ d)) <=> d /\ c /\ a /\ b`] THEN ASM_REWRITE_TAC[UNWIND_THM1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT AP_TERM_TAC THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW] THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[PRIME_DIVEXP; prime; PRIME_1; DIVIDES_REFL; EXP_1]);; let MANGOLDT_POS_LE = prove (`!n. &0 <= mangoldt n`, GEN_TAC THEN ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ n = p EXP k` THENL [FIRST_X_ASSUM(REPEAT_TCL CHOOSE_THEN STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[MANGOLDT_PRIMEPOW] THEN MATCH_MP_TAC LOG_POS THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; ASM_REWRITE_TAC[mangoldt; REAL_LE_REFL]]);; let LOG_MANGOLDT_SUM = prove (`!n. ~(n = 0) ==> log(&n) = sum {d | d divides n} (\d. mangoldt(d))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 1` THENL [ASM_REWRITE_TAC[LOG_1; DIVIDES_ONE; SET_RULE `{x | x = a} = {a}`] THEN REWRITE_TAC[SUM_SING; mangoldt] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[EXP_EQ_1] THEN MESON_TAC[PRIME_1; ARITH_RULE `~(1 <= 0)`]; ALL_TAC] THEN SUBGOAL_THEN `1 < n` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`n:num`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC INDUCT_COPRIME THEN REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[LOG_MUL; GSYM REAL_OF_NUM_MUL; REAL_OF_NUM_LT; ARITH_RULE `1 < a ==> 0 < a`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum ({d | d divides a} UNION {d | d divides b}) (\d. mangoldt d)` THEN CONJ_TAC THEN CONV_TAC SYM_CONV THENL [MATCH_MP_TAC SUM_UNION_NONZERO THEN REWRITE_TAC[IN_INTER] THEN ASM_SIMP_TAC[FINITE_DIVISORS; ARITH_RULE `1 < n ==> ~(n = 0)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[coprime; MANGOLDT_1]; MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[UNION_SUBSET; IN_UNION] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; DIVIDES_LMUL; DIVIDES_RMUL] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[mangoldt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PRIME_DIVPROD_POW]]; ALL_TAC] THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[SET_RULE `{d | ?i. i <= k /\ d = p EXP i} = IMAGE (\i. p EXP i) {i | i <= k}`] THEN ASM_SIMP_TAC[EQ_EXP; SUM_IMAGE; PRIME_GE_2; ARITH_RULE `2 <= p ==> ~(p = 0) /\ ~(p = 1)`] THEN ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; o_DEF] THEN ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET; IN_ELIM_THM; FINITE_NUMSEG_LE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[GSYM numseg] THEN ASM_SIMP_TAC[LOG_POW; PRIME_IMP_NZ; REAL_OF_NUM_LT; LT_NZ] THEN SIMP_TAC[SUM_CONST; CARD_NUMSEG_1; FINITE_NUMSEG]);; let MANGOLDT = prove (`!n. log(&(FACT n)) = sum(1..n) (\d. mangoldt(d) * floor(&n / &d))`, GEN_TAC THEN REWRITE_TAC[LOG_FACT] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1..n) (\m. sum {d | d divides m} (\d. mangoldt d))` THEN SIMP_TAC[LOG_MANGOLDT_SUM; SUM_EQ_NUMSEG; LE_1] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (1..n) (\m. sum (1..n) (\d. mangoldt d * (if d divides m then &1 else &0)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_SIMP_TAC[LE_1; FINITE_DIVISORS; IN_ELIM_THM; REAL_MUL_RZERO; REAL_MUL_RID; SUBSET; IN_NUMSEG] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE_STRONG) THEN ASM_ARITH_TAC; GEN_REWRITE_TAC LAND_CONV [SUM_SWAP_NUMSEG] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN ASM_SIMP_TAC[SUM_DIVISORS_FLOOR_LEMMA; LE_1; SUM_LMUL]]);; (* ------------------------------------------------------------------------- *) (* The Chebyshev psi function and the key bounds on it. *) (* ------------------------------------------------------------------------- *) let PSI_BOUND_INDUCT = prove (`!n. ~(n = 0) ==> sum(1..2*n) (\d. mangoldt(d)) - sum(1..n) (\d. mangoldt(d)) <= &9 * &n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (n+1..2 * n) (\d. mangoldt d)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[REAL_EQ_SUB_RADD] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN ONCE_REWRITE_TAC[UNION_COMM] THEN REWRITE_TAC[FINITE_NUMSEG] THEN ASM_SIMP_TAC[NUMSEG_COMBINE_R; ARITH_RULE `~(n = 0) ==> 1 <= n + 1 /\ n <= 2 * n`] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (n+1..2*n) (\d. mangoldt(d) * (floor(&(2 * n) / &d) - &2 * floor(&n / &d)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[MANGOLDT_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= a /\ b = &0 ==> &1 <= a - &2 * b`) THEN SUBGOAL_THEN `~(r = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[FLOOR_DIV_DIV; FLOOR_NUM; REAL_OF_NUM_LE; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[DIV_EQ_0; LE_RDIV_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (1..2*n) (\d. mangoldt(d) * (floor(&(2 * n) / &d) - &2 * floor(&n / &d)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG; IN_DIFF; IN_NUMSEG] THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN SUBGOAL_THEN `~(r = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[MANGOLDT_POS_LE] THEN ASM_SIMP_TAC[FLOOR_DIV_DIV; REAL_NEG_SUB; REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE; MULT_DIV_LE]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `m * (f1 - &2 * f2) = m * f1 - &2 * m * f2`] THEN REWRITE_TAC[SUM_SUB_NUMSEG; SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..2*n) (\d. mangoldt(d) * floor(&(2 * n) / &d)) - &2 * sum(1..n) (\d. mangoldt(d) * floor(&n / &d))` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `y' <= y ==> x - y <= x - y'`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG; IN_DIFF; IN_NUMSEG] THEN SIMP_TAC[FLOOR_DIV_DIV; LE_1; FLOOR_NUM; REAL_LE_MUL; REAL_POS; MANGOLDT_POS_LE] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM MANGOLDT] THEN MAP_EVERY (MP_TAC o C SPEC LOG_FACT_BOUNDS) [`n:num`; `2 * n`] THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC(REAL_ARITH `a2 + e2 + &2 * (e1 - a1) <= m ==> abs(f2 - a2) <= e2 ==> abs(f1 - a1) <= e1 ==> f2 - &2 * f1 <= m`) THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_MUL; LOG_MUL; REAL_OF_NUM_LT; LT_NZ; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&6 * log(&n) + (&2 * log(&2) - &1) * &1 + (&2 * log(&2)) * &n` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&6 * &n + (&2 * log(&2) - &1) * &n + (&2 * log(&2)) * &n` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC[LOG_LE_REFL; REAL_LE_LMUL; REAL_POS; REAL_LE_RADD] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`]; REWRITE_TAC[GSYM REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS]] THEN MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC);; let PSI_BOUND_EXP = prove (`!n. sum(1..2 EXP n) (\d. mangoldt(d)) <= &9 * &(2 EXP n)`, INDUCT_TAC THEN SIMP_TAC[EXP; SUM_SING_NUMSEG; MANGOLDT_1; REAL_LE_MUL; REAL_POS] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `s1 <= &9 * e ==> s2 - s1 <= &9 * e ==> s2 <= &9 * &2 * e`)) THEN MATCH_MP_TAC PSI_BOUND_INDUCT THEN REWRITE_TAC[EXP_EQ_0; ARITH]);; let PSI_BOUND = prove (`!n. sum(1..n) (\d. mangoldt(d)) <= &18 * &n`, GEN_TAC THEN ASM_CASES_TAC `n <= 1` THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..1) (\d. mangoldt d)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET; ALL_TAC] THEN REWRITE_TAC[SUM_SING_NUMSEG; FINITE_NUMSEG; IN_DIFF; IN_NUMSEG] THEN SIMP_TAC[MANGOLDT_POS_LE; MANGOLDT_1; REAL_LE_MUL; REAL_POS] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?k. n <= 2 EXP k /\ !l. l < k ==> ~(n <= 2 EXP l)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM num_WOP] THEN EXISTS_TAC `n:num` THEN MP_TAC(SPEC `n:num` LT_POW2_REFL) THEN REWRITE_TAC[EXP] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..2 EXP k) (\d. mangoldt d)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG; IN_DIFF; IN_NUMSEG; MANGOLDT_POS_LE] THEN ASM_ARITH_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&9 * &(2 EXP k)` THEN REWRITE_TAC[PSI_BOUND_EXP] THEN ASM_CASES_TAC `k = 0` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(k = 0) ==> k = SUC(k - 1)`)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `k - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_MUL; EXP; REAL_OF_NUM_LE] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Now Mertens's first theorem. *) (* ------------------------------------------------------------------------- *) let MERTENS_LEMMA = prove (`!n. ~(n = 0) ==> abs(sum(1..n) (\d. mangoldt(d) / &d) - log(&n)) <= &21`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&n` THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LT_NZ] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_ABS_NUM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB; GSYM SUM_LMUL] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LOG_FACT_BOUNDS) THEN REWRITE_TAC[MANGOLDT] THEN MATCH_MP_TAC(REAL_ARITH `abs(n - &1) <= n /\ abs(s' - s) <= (k - &1) * n - a ==> abs(s' - (nl - n + &1)) <= a ==> abs(s - nl) <= n * k`) THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> abs(x - &1) <= x`) THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[REAL_ARITH `n * i / x:real = i * n / x`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..n) (\i. mangoldt i)` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ --x <= y ==> abs(x) <= y`) THEN REWRITE_TAC[GSYM SUM_NEG; REAL_ARITH `--(a * (x - y)):real = a * (y - x)`] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN SIMP_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL; MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL] THEN ASM_REWRITE_TAC[MANGOLDT_POS_LE; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN MP_TAC(SPEC `&n / &i` FLOOR) THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= (k - &2) * n /\ l <= n ==> x <= k * n - &2 * l`) THEN ASM_SIMP_TAC[LOG_LE_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[PSI_BOUND]);; let MERTENS_MANGOLDT_VERSUS_LOG = prove (`!n s. s SUBSET (1..n) ==> abs (sum s (\d. mangoldt d / &d) - sum {p | prime p /\ p IN s} (\p. log (&p) / &p)) <= &3`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUBSET_EMPTY] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; SUM_CLAUSES] THEN REAL_ARITH_TAC; DISCH_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(sum (1..n) (\d. mangoldt d / &d) - sum {p | prime p /\ p IN 1..n} (\p. log (&p) / &p))` THEN CONJ_TAC THENL [SUBGOAL_THEN `FINITE(s:num->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_SIMP_TAC[SUM_RESTRICT_SET; FINITE_NUMSEG] THEN ASM_SIMP_TAC[GSYM SUM_SUB; FINITE_NUMSEG] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE; MATCH_MP_TAC SUM_SUBSET_SIMPLE] THEN ASM_SIMP_TAC[IN_DIFF; FINITE_NUMSEG; REAL_SUB_LE] THEN X_GEN_TAC `x:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; MANGOLDT_POS_LE; REAL_POS] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM EXP_1] THEN ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; LE_REFL; REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `{p | prime p /\ p IN 1..n} = {p | prime p /\ p <= n}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN MESON_TAC[ARITH_RULE `2 <= p ==> 1 <= p`; PRIME_GE_2]; ALL_TAC] THEN SUBGOAL_THEN `sum(1..n) (\d. mangoldt d / &d) - sum {p | prime p /\ p <= n} (\p. log (&p) / &p) = sum {p EXP k | prime p /\ p EXP k <= n /\ k >= 2} (\d. mangoldt d / &d)` SUBST1_TAC THENL [SUBGOAL_THEN `sum {p | prime p /\ p <= n} (\p. log (&p) / &p) = sum {p | prime p /\ p <= n} (\d. mangoldt d / &d)` SUBST1_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM EXP_1] THEN ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; ARITH]; ALL_TAC] THEN REWRITE_TAC[REAL_EQ_SUB_RADD] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {p EXP k | prime p /\ p EXP k <= n /\ k >= 1} (\d. mangoldt d / &d)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[IN_ELIM_THM; SUBSET; IN_NUMSEG] THEN CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; EXP_EQ_0] THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN REWRITE_TAC[mangoldt] THEN ASM_MESON_TAC[GE]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN MESON_TAC[PRIME_EXP; ARITH_RULE `~(1 >= 2)`]; REWRITE_TAC[ARITH_RULE `k >= 1 <=> k >= 2 \/ k = 1`] THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[EXP_1]]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(x) <= y`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE THEN SIMP_TAC[REAL_LE_DIV; REAL_POS; MANGOLDT_POS_LE]THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {p | p IN 1..n /\ prime p} (\p. sum (2..n) (\k. log(&p) / &p pow k))` THEN CONJ_TAC THENL [SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG; FINITE_RESTRICT] THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN EXISTS_TAC `\(p,k). p EXP k` THEN SIMP_TAC[FINITE_PRODUCT; FINITE_NUMSEG; FINITE_RESTRICT] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; REAL_LE_DIV; REAL_POW_LE; REAL_POS; LOG_POS; REAL_OF_NUM_LE] THEN X_GEN_TAC `x:num` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; GSYM REAL_OF_NUM_POW; REAL_LE_REFL; ARITH_RULE `k >= 2 ==> 1 <= k /\ 2 <= k`] THEN ASM_SIMP_TAC[PRIME_IMP_NZ; ARITH_RULE `1 <= k <=> ~(k = 0)`] THEN CONJ_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN ASM_SIMP_TAC[PRIME_IMP_NZ; LE_EXP] THEN ASM_ARITH_TAC; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP k` THEN ASM_SIMP_TAC[LT_POW2_REFL; LT_IMP_LE; EXP_MONO_LE; PRIME_GE_2]]; ALL_TAC] THEN REWRITE_TAC[real_div; SUM_LMUL; GSYM REAL_POW_INV; SUM_GP] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {p | p IN 1..n /\ prime p} (\p. log(&p) / (&p * (&p - &1)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN SIMP_TAC[FINITE_NUMSEG; FINITE_RESTRICT] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN ASM_SIMP_TAC[REAL_INV_EQ_1; REAL_OF_NUM_EQ; PRIME_GE_2; ARITH_RULE `2 <= p ==> ~(p = 1)`] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_LE_DIV; REAL_LE_MUL; REAL_SUB_LE; REAL_OF_NUM_LE; LOG_POS; LE_0] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y * z /\ x * z <= a ==> (x - y) * z <= a`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_INV_EQ; REAL_POS; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (2..n) (\p. log(&p) / (&p * (&p - &1)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET THEN SIMP_TAC[FINITE_NUMSEG; FINITE_RESTRICT] THEN REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN CONJ_TAC THENL [MESON_TAC[PRIME_GE_2]; ALL_TAC] THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; REAL_LE_MUL; REAL_POS; REAL_SUB_LE; REAL_LE_DIV]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (2..n) (\m. log(&m) / (&m - &1) pow 2)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_POW_2; REAL_LE_RMUL_EQ; REAL_LT_MUL; REAL_LT_IMP_LE; REAL_SUB_LT; REAL_OF_NUM_LT; ARITH_RULE `1 < p <=> 2 <= p`; REAL_ARITH `x - &1 <= x`]; ALL_TAC] THEN ASM_CASES_TAC `n < 2` THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM NUMSEG_EMPTY]); RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT])] THEN ASM_SIMP_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `x <= &1 /\ y <= e - &1 ==> x + y <= e`) THEN CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `n < 3` THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM NUMSEG_EMPTY]); RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT])] THEN ASM_SIMP_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC(ISPECL [`\z. clog(z) / (z - Cx(&1)) pow 2`; `\z. clog(z - Cx(&1)) - clog(z) - clog(z) / (z - Cx(&1))`; `3`; `n:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THENL [COMPLEX_DIFF_TAC THEN SIMP_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_LID] THEN ASM_SIMP_TAC[RE_SUB; RE_CX; REAL_SUB_LT] THEN ASM_SIMP_TAC[REAL_ARITH `&2 <= x ==> &1 < x /\ &0 < x`] THEN SUBGOAL_THEN `~(z = Cx(&0)) /\ ~(z = Cx(&1))` MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `&2 <= Re z` THEN ASM_REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_ARITH_TAC]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN MP_TAC(SPECL [`\z. clog(z) / (z - Cx(&1)) pow 2`; `\z. inv(z * (z - Cx(&1)) pow 2) - Cx(&2) * clog(z) / (z - Cx(&1)) pow 3`; `Cx(x)`; `Cx(y)`] COMPLEX_MVT_LINE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=> a <= x /\ x <= b \/ b < a /\ b <= x /\ x <= a`] THEN STRIP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONV_TAC NUM_REDUCE_CONV THEN SUBGOAL_THEN `~(z = Cx(&0)) /\ ~(z = Cx(&1))` MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[RE_CX; IM_CX] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `x <= y <=> x - y <= &0`] THEN DISCH_THEN(X_CHOOSE_THEN `w:complex` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[GSYM CX_SUB; RE_MUL_CX] THEN REWRITE_TAC[REAL_ARITH `a * (y - x) <= &0 <=> &0 <= --a * (y - x)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[RE_SUB; REAL_NEG_SUB; REAL_SUB_LE] THEN SUBGOAL_THEN `real w` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL]) THEN ABBREV_TAC `u = Re w` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN ASM_SIMP_TAC[REAL_ARITH `x <= y ==> (x <= u /\ u <= y \/ y <= u /\ u <= x <=> x <= u /\ u <= y)`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < u /\ &1 < u /\ &2 <= u` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; GSYM CX_MUL; GSYM CX_INV; RE_CX] THEN REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_MUL; REAL_MUL_ASSOC; REAL_RING `(x:real) pow 3 = x * x pow 2`] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_INV_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN MATCH_MP_TAC(REAL_ARITH `a * b <= &1 /\ &1 / &2 <= c ==> b * a <= &2 * c`) THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `log(&2)` THEN REWRITE_TAC[LOG_2_BOUNDS] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> x <= a ==> y <= b`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_SUB; GSYM CX_LOG; GSYM CX_DIV; REAL_SUB_LT; ARITH; RE_CX; REAL_OF_NUM_LT; ARITH_RULE `3 <= n ==> 0 < n /\ 1 < n`; GSYM CX_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LOG_1; REAL_ARITH `a - (&0 - x - x / &1) = a + &2 * x`] THEN MATCH_MP_TAC(REAL_ARITH `a <= e - &2 /\ x <= &1 ==> a + &2 * x <= e`) THEN REWRITE_TAC[LOG_2_BOUNDS] THEN MATCH_MP_TAC(REAL_ARITH `a <= b /\ --c <= e ==> a - b - c <= e`) THEN REWRITE_TAC[REAL_SUB_REFL; REAL_ARITH `--x <= &0 <=> &0 <= x`] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_SUB_LE; LOG_POS; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LOG_MONO_LE_IMP; REAL_ARITH `x - &1 <= x`; REAL_SUB_LT; LE_0; ARITH_RULE `3 <= n ==> 1 <= n /\ 1 < n`]);; let MERTENS = prove (`!n. ~(n = 0) ==> abs(sum {p | prime p /\ p <= n} (\p. log(&p) / &p) - log(&n)) <= &24`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP MERTENS_LEMMA) THEN MATCH_MP_TAC(REAL_ARITH `abs(s1 - s2) <= k - e ==> abs(s1 - l) <= e ==> abs(s2 - l) <= k`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBGOAL_THEN `{p | prime p /\ p <= n} = {p | prime p /\ p IN 1..n}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN MESON_TAC[ARITH_RULE `2 <= p ==> 1 <= p`; PRIME_GE_2]; MATCH_MP_TAC MERTENS_MANGOLDT_VERSUS_LOG THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; hol-light/Examples/mccarthy.ml000066400000000000000000000151731303454263000166760ustar00rootroot00000000000000(***************************************************************************** * * mp.ml * * An HOL mechanization of the compiler correctness proof of McCarthy and * Painter from 1967. * * From a HOL-4 original by Robert Bauer and Ray Toal * * HOL Light proof by John Harrison, 21st April 2004 * *****************************************************************************) (* ------------------------------------------------------------------------- *) (* Define a type of strings, not already there in HOL Light. *) (* We don't use any particular properties of the type in the proof below. *) (* ------------------------------------------------------------------------- *) let string_INDUCT,string_RECURSION = define_type "string = String (int list)";; (* ------------------------------------------------------------------------- *) (* The definitions from Robert's file. *) (* ------------------------------------------------------------------------- *) (* * The source language * ------------------- * * Syntax: * * The language contains only expressions of three kinds: (1) simple * numeric literals, (2) simple variables, and (3) plus expressions. *) let exp_INDUCT,exp_RECURSION = define_type "exp = Lit num | Var string | Plus exp exp";; (* * Semantics: * * Expressions evaluated in a state produce a result. There are no * side effects. A state is simply a mapping from variables to * values. The semantic function is called E. *) let E_DEF = new_recursive_definition exp_RECURSION `(E (Lit n) s = n) /\ (E (Var v) s = s v) /\ (E (Plus e1 e2) s = E e1 s + E e2 s)`;; (* * The object language * ------------------- * * Syntax: * * The target machine has a single accumulator (Acc) and an infinite * set of numbered registers (Reg 0, Reg 1, Reg 2, and so on). The * accumulator and registers together are called cells. There are four * instructions: LI (load immediate into accumulator), LOAD (load the * contents of a numbered register into the accumulator), STO (store * the accumulator value into a numbered register) and ADD (add the * contents of a numbered register into the accumulator). *) let cell_INDUCT,cell_RECURSION = define_type "cell = Acc | Reg num";; let inst_INDUCT,inst_RECURSION = define_type "inst = LI num | LOAD num | STO num | ADD num";; (* * update x z s is the state that is just like s except that x now * maps to z. This definition applies to any kind of state. *) let update_def = new_definition `update x z s y = if (y = x) then z else s y`;; (* * Semantics: * * First, the semantics of the execution of a single instruction. * The semantic function is called S. Executing an instruction in * a machine state produces a new machine state. Here a machine * state is a mapping from cells to values. *) let S_DEF = new_recursive_definition inst_RECURSION `(S (LI n) s = update Acc n s) /\ (S (LOAD r) s = update Acc (s (Reg r)) s) /\ (S (STO r) s = update (Reg r) (s Acc) s) /\ (S (ADD r) s = update Acc (s (Reg r) + s Acc) s)`;; (* * Next we give the semantics of a list of instructions with the * semantic function S'. The execution of an intruction list * in an initial state is given by executing the first instruction * in the list in the initial state, which produce a new state s1, * and taking the execution of the rest of the list in s1. *) let S'_DEF = new_recursive_definition list_RECURSION `(S' [] s = s) /\ (S' (CONS inst rest) s = S' rest (S inst s))`;; (* * The compiler * ------------ * * Each source language expression is compiled into a list of * instructions. The compilation is done using a symbol table * which maps source language indentifiers into target machine * register numbers, and a parameter r which tells the next * available free register. *) let C_DEF = new_recursive_definition exp_RECURSION `(C (Lit n) map r = [LI n]) /\ (C (Var v) map r = [LOAD (map v)]) /\ (C (Plus e1 e2) map r = APPEND (APPEND (C e1 map r) [STO r]) (APPEND (C e2 map (r + 1)) [ADD r]))`;; (* ------------------------------------------------------------------------- *) (* My key lemmas; UPDATE_DIFFERENT and S'_APPEND are the same as Robert's. *) (* ------------------------------------------------------------------------- *) let cellth = CONJ (distinctness "cell") (injectivity "cell");; let S'_APPEND = prove (`!p1 p2 s. S' (APPEND p1 p2) s = S' p2 (S' p1 s)`, LIST_INDUCT_TAC THEN ASM_SIMP_TAC[S'_DEF; APPEND]);; let UPDATE_DIFFERENT = prove (`!x y z s. ~(x = y) ==> (update x z s y = s y)`, SIMP_TAC[update_def]);; let UPDATE_SAME = prove (`!x z s. update x z s x = z`, SIMP_TAC[update_def]);; (* * The Correctness Condition * ------------------------- * * The correctness condition is this: * * For every expression e, symbol table map, source state s, * target state s', register number r: * * If all source variables map to registers LESS THAN r, * and if the value of every variable v in s is exactly * the same as the value in s' of the register to which * v is mapped by map, THEN * * When e is compiled with map and first free register r, * and then executed in the state s', in the resulting * machine state S'(C e map r): * * the accumulator will contain E e s and every register * with number x less than r will have the same value as * it does in s'. * * The Proof * --------- * * The proof can be done by induction and careful application of SIMP_TAC[] * using the lemmas isolated above. * * The only "hack" is to throw in GSYM SKOLEM_THM and EXISTS_REFL to dispose * of state existence subgoals of the form `?s. !v. s v = t[v]`, which * otherwise would not be proven automatically by the simplifier. *) let CORRECTNESS_THEOREM = prove (`!e map s s' r. (!v. map v < r) ==> (!v. s v = s' (Reg (map v))) ==> (S' (C e map r) s' Acc = E e s) /\ (!x. (x < r) ==> (S' (C e map r) s' (Reg x) = s' (Reg x)))`, MATCH_MP_TAC exp_INDUCT THEN REWRITE_TAC[E_DEF; S_DEF; S'_DEF; update_def; C_DEF; S'_APPEND] THEN SIMP_TAC[ARITH_RULE `(x < y ==> x < y + 1 /\ ~(x = y)) /\ x < x + 1`; cellth; UPDATE_SAME; UPDATE_DIFFERENT; GSYM SKOLEM_THM; EXISTS_REFL]);; hol-light/Examples/misiurewicz.ml000066400000000000000000002016561303454263000174410ustar00rootroot00000000000000(* ========================================================================= *) (* Proof that the complex exponential map is topologically transitive, *) (* following Misiurewicz's original paper "On iterates of e^z". *) (* Suggestion of problem and additional advice from Lasse Rempe-Gillen. *) (* ========================================================================= *) needs "Multivariate/cauchy.ml";; (* ------------------------------------------------------------------------- *) (* Some preliminaries. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_CEXP_COMPOSE = prove (`!f z. (f has_complex_derivative f') (at z) ==> ((\w. cexp(f w)) has_complex_derivative (f' * cexp(f z))) (at z)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID]);; let COMPLEX_DIFFERENTIABLE_CEXP_COMPOSE = prove (`!f z. f complex_differentiable at z ==> (\w. cexp(f w)) complex_differentiable at z`, MESON_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_CEXP_COMPOSE]);; let COMPLEX_DERIVATIVE_CEXP_COMPOSE = prove (`!f z. f complex_differentiable at z ==> complex_derivative (\w. cexp(f w)) z = complex_derivative f z * cexp(f z)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CEXP_COMPOSE THEN ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DIFFERENTIABLE_ITER_CEXP = prove (`!n z. (ITER n cexp) complex_differentiable at z`, GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV) [GSYM ETA_AX] THEN INDUCT_TAC THEN ASM_SIMP_TAC[ITER; COMPLEX_DIFFERENTIABLE_ID] THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_CEXP_COMPOSE]);; let CONTINUOUS_ITER_CEXP = prove (`!n z. (ITER n cexp) continuous at z`, SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT; COMPLEX_DIFFERENTIABLE_ITER_CEXP]);; let HOLOMORPHIC_ON_ITER_CEXP = prove (`!n s. (ITER n cexp) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_ITER_CEXP]);; let CONTINUOUS_ON_ITER_CEXP = prove (`!n s. (ITER n cexp) continuous_on s`, SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_ITER_CEXP]);; (* ------------------------------------------------------------------------- *) (* Lemma 1. *) (* ------------------------------------------------------------------------- *) let LEMMA_1 = prove (`!n z. 1 <= n ==> abs(Im(ITER n cexp z)) <= norm(complex_derivative(ITER n cexp) z)`, INDUCT_TAC THEN REWRITE_TAC[ITER; ARITH] THEN X_GEN_TAC `z:complex` THEN DISCH_THEN(K ALL_TAC) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[ITER] THEN ASM_SIMP_TAC[COMPLEX_DERIVATIVE_CEXP_COMPOSE; COMPLEX_DIFFERENTIABLE_ITER_CEXP; ETA_AX] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ITER_POINTLESS; I_DEF; o_DEF; COMPLEX_DERIVATIVE_ID; COMPLEX_MUL_LID; COMPLEX_NORM_GE_RE_IM] THEN TRANS_TAC REAL_LE_TRANS `abs(Im(ITER n cexp z)) * norm(cexp (ITER n cexp z))` THEN ASM_SIMP_TAC[COMPLEX_NORM_MUL; REAL_LE_RMUL; NORM_POS_LE; LE_1] THEN SPEC_TAC(`ITER n cexp z`,`w:complex`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[IM_CEXP; NORM_CEXP; REAL_ABS_MUL; REAL_ABS_EXP] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_EXP_POS_LT; REAL_ABS_SIN_BOUND_LE]);; (* ------------------------------------------------------------------------- *) (* Lemma 2 (two parts) *) (* ------------------------------------------------------------------------- *) let LEMMA_2a = prove (`!z. abs(Im z) <= pi / &3 ==> Re(cexp z) >= Re z + (&1 - log(&2))`, REPEAT STRIP_TAC THEN REWRITE_TAC[RE_CEXP; real_ge] THEN TRANS_TAC REAL_LE_TRANS `exp(Re z) / &2` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[real_div; REAL_LE_LMUL_EQ; REAL_EXP_POS_LT] THEN MP_TAC(ISPECL [`pi / &3`; `abs(Im z)`] COS_MONO_LE_EQ) THEN ASM_REWRITE_TAC[COS_ABS] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN REWRITE_TAC[COS_PI3] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN ABBREV_TAC `x = Re z - log(&2)` THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH `z - l:real = x ==> z = x + l`)) THEN SIMP_TAC[REAL_EXP_ADD; EXP_LOG; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_EXP_LE_X; REAL_ARITH `(x + l) + &1 - l <= (e * &2) / &2 <=> &1 + x <= e`]);; let LEMMA_2b = prove (`!z. ~(real z) ==> ?n. abs(Im(ITER n cexp z)) > pi / &3`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?n. P n) <=> (!n. ~P n) ==> F`] THEN REWRITE_TAC[real_gt; REAL_NOT_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. abs(Im(ITER (n + 1) cexp z)) >= (&2 / &5 * exp(Re(ITER n cexp z))) * abs(Im(ITER n cexp z))` (LABEL_TAC "*") THENL [REPEAT GEN_TAC THEN REWRITE_TAC[ITER; GSYM ADD1; IM_CEXP; REAL_ABS_EXP; REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ARITH `e * x >= (y * e) * z <=> e * y * z <= e * x`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_EXP_POS_LT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN SPEC_TAC(`Im(ITER n cexp z)`,`x:real`) THEN MATCH_MP_TAC(MESON[REAL_LE_NEGTOTAL] `(!x. P(--x) <=> P x) /\ (!x. &0 <= x ==> P x) ==> !x. P x`) THEN REWRITE_TAC[SIN_NEG; REAL_ABS_NEG] THEN SIMP_TAC[real_abs; SIN_POS_PI_LE; REAL_ARITH `&0 <= x /\ x <= pi / &3 ==> x <= pi`] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`0`; `Cx x`] TAYLOR_CSIN) THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[IM_CX; REAL_ABS_NUM; REAL_EXP_0; GSYM CX_SIN] THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1] THEN REWRITE_TAC[GSYM CX_DIV; GSYM CX_POW; GSYM CX_MUL; GSYM CX_SUB; GSYM CX_ADD; GSYM CX_NEG; COMPLEX_NORM_CX; REAL_MUL_LID] THEN MATCH_MP_TAC(REAL_ARITH `e <= (&1 - a) * x ==> abs(sin x - x / &1) <= e ==> a * x <= sin x`) THEN ASM_SIMP_TAC[real_abs; REAL_ARITH `x pow 3 / &2 <= a * x <=> x * x pow 2 <= x * &2 * a`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `(pi / &3) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LE2; REAL_ARITH `(pi / &3) pow 2 <= a <=> pi pow 2 <= &9 * a`] THEN TRANS_TAC REAL_LE_TRANS `(&16 / &5) pow 2` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. &0 < abs(Im(ITER n cexp z))` ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_ABS_NZ] THEN INDUCT_TAC THENL [ASM_MESON_TAC[ITER; real]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[ADD1; real_ge; REAL_NOT_LE; REAL_ABS_NUM] THEN DISCH_TAC THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_EXP_POS_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `?N. !n. N <= n ==> abs(Im(ITER (n + 1) cexp z)) >= &2 * abs(Im(ITER n cexp z))` CHOOSE_TAC THENL [MP_TAC(ISPEC `&1 - log(&2)` REAL_ARCH) THEN ANTS_TAC THENL [MP_TAC LOG2_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `log(&5) - Re z`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN MATCH_MP_TAC(REAL_ARITH `&5 * b <= u * v ==> x >= (&2 / &5 * u) * v ==> x >= &2 * b`) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ONCE_REWRITE_TAC[SYM(MATCH_MP EXP_LOG (REAL_ARITH `&0 < &5`))] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN TRANS_TAC REAL_LE_TRANS `Re z + &N * (&1 - log(&2))` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `Re z + &n * (&1 - log(&2))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN MP_TAC LOG2_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`n:num`,`m:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[ITER; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL]; REWRITE_TAC[GSYM REAL_OF_NUM_SUC]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `z + m * l <= n ==> s >= n + l ==> z + (m + &1) * l <= s`)) THEN REWRITE_TAC[ITER] THEN MATCH_MP_TAC LEMMA_2a THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN UNDISCH_TAC `!n. abs(Im(ITER n cexp z)) <= pi / &3` THEN MP_TAC(SPECL [`&2`; `pi / &3 / abs(Im (ITER N cexp z))`] REAL_ARCH_POW) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_TAC `d:num`) THEN DISCH_THEN(MP_TAC o SPEC `N + d:num`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `p < x ==> x <= a ==> a <= p ==> F`)) THEN SPEC_TAC(`d:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_LID; REAL_LE_REFL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `m * a <= b ==> c >= &2 * b ==> (&2 * m) * a <= c`)) THEN REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LE_ADD]);; (* ------------------------------------------------------------------------- *) (* Lemma 3. *) (* ------------------------------------------------------------------------- *) let LEMMA_3 = prove (`!n b r s. &0 < r /\ (!w z. w IN ball(b,r) /\ z IN ball(b,r) /\ ITER n cexp w = ITER n cexp z ==> w = z) /\ (!z. z IN ball(b,r) ==> s <= r * norm(complex_derivative (ITER n cexp) z)) ==> ball(ITER n cexp b,s) SUBSET IMAGE (ITER n cexp) (ball(b,r))`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `s <= &0 \/ &0 < s`) THENL [ASM_MESON_TAC[BALL_EQ_EMPTY; EMPTY_SUBSET]; ALL_TAC] THEN MP_TAC(ISPEC `n:num` COMPLEX_DIFFERENTIABLE_ITER_CEXP) THEN SPEC_TAC(`ITER n cexp`,`f:complex->complex`) THEN REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(b:complex,r)`] HOLOMORPHIC_ON_INVERSE) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT; OPEN_BALL] THEN ANTS_TAC THENL [ASM_SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_AT_WITHIN]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC))] THEN ABBREV_TAC `c = closest_point ((:complex) DIFF IMAGE f (ball(b:complex,r))) (f b)` THEN MP_TAC(ISPECL [`(:complex) DIFF IMAGE f (ball(b:complex,r))`; `(f:complex->complex) b`] CLOSEST_POINT_EXISTS) THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN DISCH_THEN(MP_TAC o AP_TERM `bounded:(complex->bool)->bool`) THEN REWRITE_TAC[NOT_BOUNDED_UNIV] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (f:complex->complex) (cball(b,r))` THEN SIMP_TAC[IMAGE_SUBSET; BALL_SUBSET_CBALL] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_CBALL] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; COMPLEX_DIFFERENTIABLE_AT_WITHIN]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV) [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[GSYM IN_BALL; REAL_NOT_LE; GSYM SUBSET]] THEN ABBREV_TAC `t = dist((f:complex->complex) b,c)` THEN STRIP_TAC THEN ASM_CASES_TAC `s:real <= t` THENL [ASM_MESON_TAC[SUBSET_BALL; SUBSET_TRANS]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[GSYM DIST_NZ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(y IN IMAGE f s) ==> x IN s ==> ~(f x = y)`)) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]; ALL_TAC] THEN SUBGOAL_THEN `c IN closure(IMAGE (f:complex->complex) (ball (b,r)) INTER ball(f b,t))` MP_TAC THENL [ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> t INTER s = s`] THEN ASM_SIMP_TAC[CLOSURE_BALL] THEN ASM_REWRITE_TAC[IN_CBALL; REAL_LE_REFL]; REWRITE_TAC[CLOSURE_SEQUENTIAL]] THEN REWRITE_TAC[IN_IMAGE; IN_INTER; SKOLEM_THM; FORALL_AND_THM] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[ETA_AX; LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `z:num->complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n. (z:num->complex) n IN cball(b,t / s * r)` ASSUME_TAC THENL [ALL_TAC; MP_TAC(ISPEC `cball(b:complex,t / s * r)` compact) THEN REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `z:num->complex`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`w:complex`; `r:num->num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_IMAGE]) THEN REWRITE_TAC[] THEN EXISTS_TAC `w:complex` THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:complex->complex) o z o (r:num->num)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[o_DEF]; MP_TAC(ISPECL [`f:complex->complex`; `sequentially`] LIM_CONTINUOUS_FUNCTION) THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT]]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL; REAL_ADD_LID] THEN DISJ1_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_LDIV_EQ; REAL_MUL_LID]]] THEN UNDISCH_TAC `!n:num. (f:complex->complex) (z n) IN ball (f b,t)` THEN UNDISCH_TAC `!n:num. z n IN ball(b:complex,r)` THEN REWRITE_TAC[AND_FORALL_THM; IMP_IMP] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `nn:num` THEN SPEC_TAC(`(z:num->complex) nn`,`w:complex`) THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:complex->complex`; `complex_derivative g`; `ball((f:complex->complex) b,t)`; `r / s:real`] COMPLEX_MVT) THEN REWRITE_TAC[CONVEX_BALL] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPECL [`(f:complex->complex) b`; `(f:complex->complex) w`]) THEN ASM_SIMP_TAC[CENTRE_IN_BALL; IN_CBALL] THEN MATCH_MP_TAC(NORM_ARITH `s <= t ==> norm(w - b) <= s ==> dist(b,w) <= t`) THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `t / s * r:real = r / s * t`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_DIV] THEN ASM_MESON_TAC[IN_BALL; dist; DIST_SYM; REAL_LT_IMP_LE]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOLOMORPHIC_ON_DIFFERENTIABLE]) THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; COMPLEX_DIFFERENTIABLE_WITHIN_OPEN] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t SUBSET IMAGE f s ==> (!x. x IN s ==> P(f x)) ==> !x. x IN t ==> P x`)) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `norm(complex_derivative f z)` THEN ASM_SIMP_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `n * r / s:real = (r * n) / s`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; COMPLEX_NORM_NZ; REAL_MUL_LID] THEN ASM_MESON_TAC[COMPLEX_RING `a * b = Cx(&1) ==> ~(a = Cx(&0))`]);; (* ------------------------------------------------------------------------- *) (* Lemma 4. *) (* ------------------------------------------------------------------------- *) let LEMMA_4 = prove (`!v. ~(v = {}) /\ open v /\ connected v ==> FINITE {n | DISJOINT (IMAGE (ITER n cexp) v) {z | abs(Im z) <= pi / &3}}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?N. !n. N < n ==> ~DISJOINT (IMAGE (ITER n cexp) v) {z | abs(Im z) <= pi / &3}` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> p) ==> p`) THEN DISCH_TAC; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..N` THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_ELIM_THM; IN_NUMSEG; LE_0] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[NOT_LE]] THEN SUBGOAL_THEN `?n z:complex. z IN v /\ integer(Im(ITER n cexp z) / pi)` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `n:num` THEN REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM] THEN SUBGOAL_THEN `!d. real(ITER (n + SUC d) cexp z)` ASSUME_TAC THENL [INDUCT_TAC THEN ONCE_REWRITE_TAC[ADD_CLAUSES] THENL [REWRITE_TAC[ADD_CLAUSES; ITER; real; IM_CEXP; REAL_ENTIRE] THEN DISJ2_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SIN_INTEGER_PI) THEN SIMP_TAC[REAL_DIV_RMUL; PI_NZ]; ASM_SIMP_TAC[ITER; REAL_EXP]]; MAP_EVERY X_GEN_TAC [`q:num`; `d:num`] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:num`) THEN MATCH_MP_TAC(SET_RULE `(!x. real x ==> x IN t) /\ z IN s ==> real(f z) ==> ~DISJOINT (IMAGE f s) t`) THEN ASM_SIMP_TAC[real; IN_ELIM_THM] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC]] THEN SUBGOAL_THEN `?n w z. w IN v /\ z IN v /\ pi <= abs(Im(ITER n cexp w) - Im(ITER n cexp z))` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC WLOG_RELATION THEN EXISTS_TAC `\w z. Im(ITER n cexp z) <= Im(ITER n cexp w)` THEN REWRITE_TAC[REAL_LE_TOTAL] THEN CONJ_TAC THENL [MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`w:complex`; `z:complex`] THEN SIMP_TAC[real_abs; REAL_SUB_LE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (ITER n cexp) v`; `ITER n cexp z`; `ITER n cexp w`; `floor(Im(ITER n cexp w) / pi) * pi`; `2`] CONNECTED_IVT_COMPONENT) THEN REWRITE_TAC[DIMINDEX_2; ARITH; GSYM IM_DEF; EXISTS_IN_IMAGE] THEN SIMP_TAC[PI_POS; REAL_ARITH `&0 < &2`; REAL_LT_MUL; GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ] THEN ANTS_TAC THENL [REWRITE_TAC[FLOOR] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_ITER_CEXP; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; COMPLEX_DIFFERENTIABLE_AT_WITHIN]; REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC(REAL_ARITH `x + &1 <= y /\ y < floor y + &1 ==> x <= floor y`) THEN REWRITE_TAC[FLOOR] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; PI_POS; REAL_LT_IMP_NZ; IM_ADD; IM_MUL_II; RE_CX; REAL_LE_LADD] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN ASM_SIMP_TAC[PI_NZ; FLOOR; REAL_FIELD `~(pi = &0) ==> (x * pi) / pi = x`]]] THEN ASM_CASES_TAC `!n w z. w IN v /\ z IN v /\ ITER n cexp w = ITER n cexp z ==> w = z` THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THEN SIMP_TAC[ITER] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `(p ==> r) ==> (~p ==> q ==> r) ==> (q ==> r)`)) THEN REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_THEN(fun th -> EXISTS_TAC `n:num` THEN MP_TAC th) THEN REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:complex` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:complex`; `z:complex`]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CEXP_EQ]) THEN DISCH_THEN(X_CHOOSE_THEN `i:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IM_ADD; REAL_ADD_SUB; IM_MUL_II; RE_CX] THEN ASM_CASES_TAC `i = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[REAL_ABS_MUL; REAL_ABS_PI; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `pi <= &2 * x * pi <=> pi * &1 <= pi * &2 * x`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; PI_POS] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &2 * x`) THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN ASM_REWRITE_TAC[]] THEN RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN SUBGOAL_THEN `?r. ((!n. 0 < r n) /\ (!n. DISJOINT (IMAGE (ITER (r n) cexp) v) {z | abs (Im z) <= pi / &3})) /\ (!n. r n < r(SUC n))` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC DEPENDENT_CHOICE THEN ASM_MESON_TAC[ARITH_RULE `m < n ==> 0 < n`]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m < n ==> (r:num->num) m < r n` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_MESON_TAC[LT_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!n z. z IN v ==> (pi / &3) pow n <= norm(complex_derivative (ITER (r n) cexp) z)` ASSUME_TAC THENL [INDUCT_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THENL [TRANS_TAC REAL_LE_TRANS `abs(Im(ITER (r 0) cexp z))` THEN ASM_SIMP_TAC[real_pow; LE_1; LEMMA_1] THEN UNDISCH_TAC `(z:complex) IN v` THEN SPEC_TAC(`z:complex`,`z:complex`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT (IMAGE f s) t ==> (!z. ~(z IN t) ==> P z) ==> !z. z IN s ==> P(f z)`) o SPEC `0`) THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `ITER (r (SUC n)) cexp = ITER (r(SUC n) - r n) cexp o ITER (r n) cexp` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; ITER_ADD] THEN ASM_SIMP_TAC[SUB_ADD; LT_IMP_LE]; SIMP_TAC[COMPLEX_DERIVATIVE_CHAIN;COMPLEX_DIFFERENTIABLE_ITER_CEXP]] THEN REWRITE_TAC[real_pow; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x / &3 <=> &0 < x`; PI_POS; REAL_POW_LE; REAL_LT_IMP_LE] THEN W(MP_TAC o PART_MATCH (rand o rand) LEMMA_1 o rand o snd) THEN ASM_SIMP_TAC[ARITH_RULE `m < n ==> 1 <= n - m`] THEN ASM_SIMP_TAC[ITER_ADD; SUB_ADD; LT_IMP_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN UNDISCH_TAC `(z:complex) IN v` THEN SPEC_TAC(`z:complex`,`z:complex`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `DISJOINT (IMAGE f s) t ==> !P. (!z. ~(z IN t) ==> P z) ==> !z. z IN s ==> P(f z)`) o SPEC `SUC n`) THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `z:complex`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`pi / &3`; `pi / r`] REAL_ARCH_POW) THEN ANTS_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_LT_LDIV_EQ] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `(r:num->num) n` THEN MP_TAC(ISPECL [`(r:num->num) n`; `z:complex`; `r:real`; `pi`] LEMMA_3) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `w:complex`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `pi < x ==> x <= y ==> pi <= y`)) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN ASM SET_TAC[]; ABBREV_TAC `w = ITER (r(n:num)) cexp z` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `w - pi / &2 % basis 2:complex` th) THEN MP_TAC(SPEC `w + pi / &2 % basis 2:complex` th)) THEN SIMP_TAC[IN_BALL; NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH; PI_POS; REAL_ARITH `&0 < pi ==> abs(pi / &2) * &1 < pi`; NORM_ARITH `dist(w,w + x) = norm x /\ dist(w,w - x) = norm x`] THEN REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:complex` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN X_GEN_TAC `b:complex` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MAP_EVERY EXISTS_TAC [`a:complex`; `b:complex`] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[IM_ADD; IM_SUB; COMPLEX_CMUL; IM_MUL_CX] THEN SIMP_TAC[IM_DEF; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Lemma 5. *) (* ------------------------------------------------------------------------- *) let LEMMA_5 = prove (`!v. ~(v = {}) /\ open v /\ connected v /\ INFINITE {n | IMAGE (ITER n cexp) v SUBSET {z | Re z > &4}} ==> ?n. ~(IMAGE (ITER n cexp) v INTER real = {})`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NOT_FORALL_THM] THEN DISCH_TAC THEN MAP_EVERY ABBREV_TAC [`h = {z | Re z > &4}`; `s = {z | abs(Im z) <= pi / &3}`; `w = {z | abs(Im z) <= &2 * pi /\ abs(Im(cexp z)) <= &2 * pi}`] THEN SUBGOAL_THEN `DISJOINT (frontier s) (w INTER h:complex->bool)` ASSUME_TAC THENL [EXPAND_TAC "s" THEN REWRITE_TAC[IM_DEF; FRONTIER_STRIP_COMPONENT_LE] THEN REWRITE_TAC[GSYM IM_DEF] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN u ==> ~(x IN t)) ==> DISJOINT s (t INTER u)`) THEN MAP_EVERY EXPAND_TAC ["h"; "w"] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IM_CEXP; real_gt] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[REAL_NOT_LE; REAL_ABS_MUL; REAL_ABS_EXP] THEN SUBGOAL_THEN `abs(sin(Im z)) = sqrt(&3) / &2` SUBST1_TAC THENL [FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `abs x = a ==> x = a \/ x = --a`)) THEN REWRITE_TAC[SIN_NEG; SIN_PI3; REAL_ABS_NEG] THEN SIMP_TAC[REAL_ABS_REFL; REAL_LE_DIV; SQRT_POS_LE; REAL_POS]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `pi < &4 /\ &2 pow 4 <= x * y ==> &2 * pi < x * y / &2`) THEN CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= x /\ x * &1 <= x * s ==> a <= x * s`) THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `exp(&4 * &1)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_EXP_N] THEN MATCH_MP_TAC REAL_POW_LE2 THEN MP_TAC E_APPROX_32 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_MONO_LE] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN SUBST1_TAC(SYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]; ALL_TAC] THEN SUBGOAL_THEN `!n. IMAGE (ITER n cexp) v INTER frontier {z | abs (Im z) <= &2 * pi} = {}` ASSUME_TAC THENL [REWRITE_TAC[IM_DEF; FRONTIER_STRIP_COMPONENT_LE] THEN REWRITE_TAC[GSYM IM_DEF] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[ITER_POINTLESS; IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN t ==> real(f x)) ==> IMAGE f s INTER real = {} ==> s INTER t = {}`) THEN REWRITE_TAC[IN_ELIM_THM; real; IM_CEXP] THEN GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `abs x = a ==> x = a \/ x = --a`)) THEN REWRITE_TAC[SIN_NEG; SIN_NPI; REAL_MUL_RZERO; REAL_NEG_0]; ALL_TAC] THEN SUBGOAL_THEN `!n. IMAGE (ITER n cexp) v INTER frontier {z | abs(Im(cexp z)) <= &2 * pi} = {}` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[ITER_POINTLESS; IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `IMAGE f u SUBSET t ==> IMAGE f s INTER t = {} ==> s INTER u = {}`) THEN REWRITE_TAC[FRONTIER_CLOSURES; REAL_NOT_LE; SET_RULE `UNIV DIFF {x | P x} = {x | ~P x}`] THEN MATCH_MP_TAC(SET_RULE `IMAGE f s SUBSET t /\ IMAGE f u SUBSET v ==> IMAGE f (s INTER u) SUBSET t INTER v`) THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_CLOSURE; CONTINUOUS_ON_CEXP] THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN SUBGOAL_THEN `FINITE {n | DISJOINT (IMAGE (ITER n cexp) v) w}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{n | DISJOINT (IMAGE (ITER n cexp) v) {z | abs(Im z) <= pi / &3}} UNION {n | DISJOINT (IMAGE (ITER (n + 1) cexp) v) {z | abs(Im z) <= pi / &3}}` THEN CONJ_TAC THENL [ASM_SIMP_TAC[FINITE_UNION; LEMMA_4] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o ABS_CONV o BINDER_CONV o RAND_CONV) [ARITH_RULE `n = (n + 1) - 1`] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\n. n - 1) {n | DISJOINT (IMAGE (ITER n cexp) v) {z | abs (Im z) <= pi / &3}}` THEN ASM_SIMP_TAC[LEMMA_4; FINITE_IMAGE] THEN SET_TAC[]; EXPAND_TAC "w" THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN MATCH_MP_TAC(SET_RULE `((!n. f n SUBSET s \/ DISJOINT (f n) s) /\ (!n. f n SUBSET t \/ DISJOINT (f n) t))/\ {n | DISJOINT (f n) s} UNION {n | DISJOINT (f n) t} SUBSET u ==> {n | DISJOINT (f n) (s INTER t)} SUBSET u`) THEN CONJ_TAC THENL [CONJ_TAC THEN GEN_TAC THEN MATCH_MP_TAC(SET_RULE `~(~(s INTER (UNIV DIFF t) = {}) /\ ~(s DIFF (UNIV DIFF t) = {})) ==> s SUBSET t \/ DISJOINT s t`) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_INTER_FRONTIER)) THEN ASM_REWRITE_TAC[FRONTIER_COMPLEMENT] THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_ITER_CEXP]; MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> (s UNION t) SUBSET (s' UNION t')`) THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `n:num` THENL [MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> x IN t) ==> DISJOINT u t ==> DISJOINT u s`); REWRITE_TAC[GSYM ADD1; ITER_POINTLESS; IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!z. Q z ==> P z) ==> DISJOINT t {z | P(cexp z)} ==> DISJOINT (IMAGE cexp t) {z | Q z}`)] THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `FINITE {n | ~(IMAGE (ITER n cexp) v SUBSET w)}` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(SET_RULE `(~(s INTER (UNIV DIFF t) = {}) /\ ~(s DIFF (UNIV DIFF t) = {}) ==> F) ==> ~(s SUBSET t) ==> DISJOINT s t`) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_INTER_FRONTIER)) THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_ITER_CEXP] THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN EXPAND_TAC "w" THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN W(MP_TAC o PART_MATCH lhand FRONTIER_INTER_SUBSET o rand o lhand o snd) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?N. (!n. N <= n ==> ~(IMAGE (ITER n cexp) v INTER s = {})) /\ (!n. N <= n ==> IMAGE (ITER n cexp) v SUBSET w)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`\n:num. n`; `{n | ~(IMAGE (ITER n cexp) v SUBSET w)} UNION {n | DISJOINT (IMAGE (ITER n cexp) v) s}`] UPPER_BOUND_FINITE_SET) THEN ASM_SIMP_TAC[FINITE_UNION] THEN ANTS_TAC THENL [ASM_MESON_TAC[LEMMA_4]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (fun th -> EXISTS_TAC `N + 1` THEN MP_TAC th)) THEN REWRITE_TAC[ARITH_RULE `N + 1 <= n <=> ~(n <= N)`; CONTRAPOS_THM] THEN REWRITE_TAC[DISJOINT; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~({n | IMAGE (ITER n cexp) v SUBSET w INTER h} SUBSET 0..N)` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_NUMSEG; GSYM INFINITE] THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `{n | IMAGE (ITER n cexp) v SUBSET h} DIFF {n | ~(IMAGE (ITER n cexp) v SUBSET w)}` THEN ASM_SIMP_TAC[INFINITE_DIFF_FINITE] THEN SET_TAC[]; ALL_TAC] THEN PURE_ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[NOT_IMP; IN_ELIM_THM; IN_NUMSEG; LE_0] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET_INTER] THEN STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE `~(m:num <= n) ==> n <= m`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`IMAGE (ITER n cexp) v`; `s:complex->bool`] CONNECTED_INTER_FRONTIER) THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_ITER_CEXP; NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN DISCH_TAC THEN SUBGOAL_THEN `?m. ~(IMAGE (ITER (n + m) cexp) v SUBSET s)` MP_TAC THENL [SUBGOAL_THEN `?z. z IN IMAGE (ITER n cexp) v` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `z:complex` LEMMA_2b) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `x > y <=> ~(x <= y)`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ITER_ADD)] THEN ASM SET_TAC[]; REWRITE_TAC[NOT_EXISTS_THM]] THEN SUBGOAL_THEN `!m. IMAGE (ITER (n + m) cexp) v SUBSET (w INTER h INTER s)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN INDUCT_TAC THENL [ASM_REWRITE_TAC[ADD_CLAUSES; ITER_POINTLESS; SUBSET_INTER]; ALL_TAC] THEN REWRITE_TAC[ADD_CLAUSES; SUBSET_INTER] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[ITER_POINTLESS; IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `u SUBSET w INTER h INTER s ==> (!x. x IN h /\ x IN s ==> f x IN h) ==> IMAGE f u SUBSET h`)) THEN MAP_EVERY EXPAND_TAC ["h"; "s"] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LEMMA_2a) THEN MP_TAC LOG2_APPROX_32 THEN ASM_REAL_ARITH_TAC; DISCH_TAC THEN MP_TAC(ISPECL [`IMAGE (ITER (SUC(n + m)) cexp) v`; `s:complex->bool`] CONNECTED_INTER_FRONTIER) THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_ITER_CEXP] THEN REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN MATCH_MP_TAC(TAUT `~p /\ r ==> (~p /\ ~q ==> ~r) ==> q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Lemma 6. *) (* ------------------------------------------------------------------------- *) let LEMMA_6 = prove (`!v. ~(v = {}) /\ open v /\ connected v ==> ?n. ~(IMAGE (ITER n cexp) v INTER real = {})`, let lemma = prove (`!v. ~(v = {}) /\ open v /\ connected v /\ (!n. IMAGE (ITER n cexp) v INTER real = {}) ==> FINITE {n | IMAGE (ITER n cexp) v INTER cball(Cx(&0),exp(&4)) = {}}`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `v:complex->bool` LEMMA_5) THEN ASM_REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0 INSERT (IMAGE (\n. n + 1) {n | IMAGE (ITER n cexp) v SUBSET {z | Re z > &4}})` THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_IMAGE] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_INSERT; IN_ELIM_THM] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN DISJ2_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[ADD1; IN_ELIM_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[ITER_POINTLESS; IMAGE_o]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f s INTER t = {} ==> (!x. ~(x IN u) ==> f x IN t) ==> s SUBSET u`)) THEN REWRITE_TAC[IN_ELIM_THM; COMPLEX_IN_CBALL_0; real_gt; REAL_NOT_LT] THEN REWRITE_TAC[NORM_CEXP; REAL_EXP_MONO_LE]) in REWRITE_TAC[GSYM NOT_FORALL_THM] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `d = cball(Cx(&0),exp(&4))` THEN MAP_EVERY ABBREV_TAC [`h = {z | Re z > &4}`; `s = {z | abs(Im z) <= pi / &3}`] THEN SUBGOAL_THEN `?g r:num->num. g holomorphic_on v /\ (!m n. m < n ==> r m < r n) /\ (!x. x IN v ==> ((\n. ITER (r n) cexp x) --> g x) sequentially) /\ (!x e. x IN v /\ &0 < e ==> ?d N. &0 < d /\ !n y. N <= n /\ y IN cball(x,d) ==> norm(ITER (r n) cexp y - g x) < e)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`\n. ITER n cexp`; `{ITER n cexp | n IN (:num)}`; `v:complex->bool`; `Cx(&0)`; `Cx(&1)`] MONTEL_OMITTING) THEN ASM_REWRITE_TAC[NOT_IMP] THEN ANTS_TAC THENL [REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[HOLOMORPHIC_ON_ITER_CEXP] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN MATCH_MP_TAC(SET_RULE `P a /\ P b ==> IMAGE f s INTER P = {} ==> !x. x IN s ==> ~(f x = a) /\ ~(f x = b)`) THEN REWRITE_TAC[REAL_CX]; ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[]] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MATCH_MP_TAC(TAUT `~q ==> p /\ q ==> r`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`cball(w:complex,b)`; `exp(&4)`]) THEN ASM_REWRITE_TAC[COMPACT_CBALL; NOT_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN MP_TAC(SPEC `ball(w:complex,b)` lemma) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BALL_EQ_EMPTY] THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN ANTS_TAC THENL [MP_TAC(ISPECL [`w:complex`; `b:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_GSPEC] THEN X_GEN_TAC `M:num` THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o SPEC `M + N + 1`) THEN MP_TAC(SPEC `r(M + N + 1):num` th)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER) THEN ASM_SIMP_TAC[ARITH_RULE `M + N + 1 >= N /\ (M + N + 1 <= r(M + N + 1) ==> ~(r(M + N + 1) <= M))`] THEN EXPAND_TAC "d" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_IMAGE; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_BALL; IN_CBALL; CONTRAPOS_THM] THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:complex` THEN REWRITE_TAC[TAUT `~((p /\ q) /\ r) <=> p ==> q ==> ~r`] THEN REWRITE_TAC[FORALL_UNWIND_THM2; REAL_NOT_LE] THEN SIMP_TAC[REAL_LT_IMP_LE]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`w:complex`; `e:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `(g:complex->complex) continuous at w` MP_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; REWRITE_TAC[continuous_at]] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min b (d / &2)` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`cball(w:complex,b)`; `e / &2`]) THEN ASM_REWRITE_TAC[COMPACT_CBALL; REAL_HALF; GE; REAL_LT_MIN; IN_CBALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:complex` THEN REWRITE_TAC[REAL_LE_MIN] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN MATCH_MP_TAC(NORM_ARITH `dist(y,x) < e / &2 ==> norm(z - y) < e / &2 ==> norm(z - x) < e`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `?k. ITER k cexp (g(w:complex)) IN h UNION ((:complex) DIFF s)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_UNION; IN_DIFF; IN_UNIV; EXISTS_OR_THM] THEN ASM_CASES_TAC `real(g(w:complex))` THENL [ALL_TAC; DISJ2_TAC THEN EXPAND_TAC "s" THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEMMA_2b) THEN REWRITE_TAC[real_gt; REAL_NOT_LE; IN_ELIM_THM]] THEN DISJ1_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC(SPEC `&5 - Re(g(w:complex))` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC(REAL_ARITH `x + n <= y ==> &5 - x <= n ==> y > &4`) THEN MATCH_MP_TAC(TAUT `!p. p /\ q ==> q`) THEN EXISTS_TAC `real(ITER n cexp (g(w:complex)))` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; REAL_ADD_RID; REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_EXP; GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC(REAL_ARITH `g + n <= Re x /\ &1 + Re x <= Re(cexp x) ==> g + n + &1 <= Re(cexp x)`) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[real]) THEN ASM_REWRITE_TAC[RE_CEXP; COS_0; REAL_MUL_RID; REAL_EXP_LE_X]; ALL_TAC] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[IN_UNION]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[OPEN_CONTAINS_BALL] `ITER n f x IN s ==> open s ==> ?e. &0 < e /\ ball(ITER n f x,e) SUBSET s`)) THEN (ANTS_TAC THENL [EXPAND_TAC "h" THEN REWRITE_TAC[RE_DEF; OPEN_HALFSPACE_COMPONENT_GT] THEN EXPAND_TAC "s" THEN REWRITE_TAC[GSYM closed; IM_DEF; CLOSED_STRIP_COMPONENT_LE]; ALL_TAC]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`k:num`; `(:complex)`] CONTINUOUS_ON_ITER_CEXP) THEN REWRITE_TAC[continuous_on; IN_UNIV] THEN DISCH_THEN(MP_TAC o SPECL [`(g:complex->complex) w`; `e:real`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real`; `N:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THENL [MP_TAC(SPEC `ball(w:complex,min b c)` LEMMA_5) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BALL_EQ_EMPTY] THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC; REWRITE_TAC[NOT_EXISTS_THM] THEN SUBGOAL_THEN `ball(w:complex,min b c) SUBSET ball(w,c)` MP_TAC THENL [REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN REAL_ARITH_TAC; ASM SET_TAC[]]]; MP_TAC(SPEC `ball(w:complex,min b c)` LEMMA_4) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BALL_EQ_EMPTY] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM INFINITE]]] THEN (MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `IMAGE (\n. r n + (k:num)) ((:num) DIFF (0..N))` THEN CONJ_TAC THENL [MATCH_MP_TAC INFINITE_IMAGE THEN SIMP_TAC[INFINITE_DIFF_FINITE; num_INFINITE; FINITE_NUMSEG] THEN REWRITE_TAC[IN_UNIV; IN_NUMSEG; IN_DIFF; LE_0; NOT_LE] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[EQ_ADD_RCANCEL] THEN ASM_MESON_TAC[LT_REFL]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN REWRITE_TAC[FORALL_IN_IMAGE; SET_RULE `DISJOINT s t <=> !x. x IN s ==> x IN (UNIV DIFF t)`] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN DISCH_TAC THEN X_GEN_TAC `y:complex` THEN DISCH_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ITER_ADD)] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[IN_CBALL]] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM_REAL_ARITH_TAC])]);; (* ------------------------------------------------------------------------- *) (* Main theorem that the iterates of the exponential do not give a *) (* "normal family" in the sense of Montel's theorem. *) (* ------------------------------------------------------------------------- *) let THEOREM = prove (`!v. open v /\ connected v /\ ~(v = {}) ==> ?q. (!m n. m < n ==> (q:num->num) m < q n) /\ !r. (!m n. m < n ==> r m < r n) /\ ((!x. x IN v ==> ((\n. inv (ITER (q(r n)) cexp x)) --> Cx (&0)) sequentially) /\ (!k c. compact k /\ k SUBSET v ==> (?N. !n x. n >= N /\ x IN k ==> c < norm(ITER (q(r n)) cexp x))) \/ (?g. g holomorphic_on v /\ (!x. x IN v ==> ((\n. ITER (q(r n)) cexp x) --> g x) sequentially) /\ (!k e. compact k /\ k SUBSET v /\ &0 < e ==> (?N. !n x. n >= N /\ x IN k ==> norm(ITER (q(r n)) cexp x - g x) < e)))) ==> F`, SUBGOAL_THEN `!v. ~(open v /\ connected v /\ bounded v /\ ~(v = {}) /\ (!c. ?N. !n x. n >= N /\ x IN v ==> c < norm(ITER n cexp x)))` ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `v:complex->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `z:complex`) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball(z:complex,d / &2)`) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; REAL_HALF; BOUNDED_BALL] THEN ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; NOT_IMP] THEN REWRITE_TAC[GSYM CONJ_ASSOC; REAL_NOT_LT] THEN DISCH_THEN(X_CHOOSE_TAC `c:real`) THEN SUBGOAL_THEN `?q. (!n. ?x. x IN IMAGE (ITER (q n) cexp) (ball(z,d / &2)) /\ norm(x) <= c) /\ (!n. q n < q(SUC n))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN ASM_MESON_TAC[ARITH_RULE `n >= N + 1 ==> N < n`]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m < n ==> (q:num->num) m < q n` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_MESON_TAC[LT_TRANS]; ALL_TAC] THEN EXISTS_TAC `q:num->num` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:num->num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ABBREV_TAC `r n = (q:num->num) (p(n:num))` THEN SUBGOAL_THEN `!m n. m < n ==> (r:num->num) m < r n` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n:num. ?x. x IN IMAGE (ITER (r n) cexp) (ball(z,d / &2)) /\ norm x <= c` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[EXISTS_IN_IMAGE]] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl)) THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`cball(z:complex,d / &2)`; `c:real`]) THEN REWRITE_TAC[COMPACT_CBALL; NOT_IMP] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `ball(z:complex,d)` THEN ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[GE; LE_REFL; GSYM REAL_NOT_LE] THEN ASM_MESON_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL]]; MP_TAC(SPEC `v:complex->bool` LEMMA_6) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN REWRITE_TAC[SET_RULE `P /\ x IN real <=> real x /\ P`] THEN REWRITE_TAC[EXISTS_REAL; IN_IMAGE] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real`; `w:complex`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN MP_TAC(SPEC `Re(g(w:complex)) + &1 - x` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN REMOVE_THEN "*" (MP_TAC o SPEC `N + M + n:num`) THEN REWRITE_TAC[LE_ADD; dist] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[COMPONENT_LE_NORM; REAL_LET_TRANS] `norm(x) < &1 ==> abs(x$1) < &1`)) THEN REWRITE_TAC[GSYM RE_DEF; RE_SUB; REAL_NOT_LT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `g + &1 - x <= m ==> m + x <= f ==> &1 <= abs(f - g)`)) THEN TRANS_TAC REAL_LE_TRANS `(&N + &M) + x:real` THEN CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[REAL_OF_NUM_ADD; ADD_ASSOC]] THEN SPEC_TAC(`N + M:num`,`m:num`) THEN GEN_TAC THEN SUBGOAL_THEN `m + n <= (r:num->num) (m + n)` MP_TAC THENL [ASM_MESON_TAC[MONOTONE_BIGGER]; REWRITE_TAC[LE_EXISTS]] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN TRANS_TAC REAL_LE_TRANS `(&m + &d) + x:real` THEN CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[REAL_OF_NUM_ADD; ADD_ASSOC]] THEN ONCE_REWRITE_TAC[ARITH_RULE `(m + n) + d:num = n + (m + d)`] THEN SPEC_TAC(`m + d:num`,`d:num`) THEN SUBGOAL_THEN `!d. real(ITER (n + d) cexp w) /\ &d + x <= Re(ITER (n + d) cexp w)` (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD_CLAUSES; ITER; REAL_CX; RE_CX; REAL_ADD_LID; REAL_LE_REFL; REAL_EXP; RE_CEXP] THEN RULE_ASSUM_TAC(REWRITE_RULE[real]) THEN ASM_REWRITE_TAC[COS_0; GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC(REAL_ARITH `d + y <= x /\ &1 + x <= exp x ==> (d + &1) + y <= exp(x) * &1`) THEN ASM_REWRITE_TAC[REAL_EXP_LE_X]]] THEN REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`h = {z | Re z > &4}`; `s = {z | abs(Im z) <= pi / &3}`; `w = {z | abs(Im z) <= &2 * pi /\ abs(Im(cexp z)) <= &2 * pi}`] THEN SUBGOAL_THEN `FINITE {n | ~(IMAGE (ITER n cexp) v SUBSET h)}` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `exp(&4)`) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..N` THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM; LE_0] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN EXPAND_TAC "h" THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n + 1`; `w:complex`]) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[ARITH_RULE `N < n ==> SUC n >= N`; GSYM ADD1] THEN REWRITE_TAC[real_gt; ITER; NORM_CEXP; REAL_EXP_MONO_LT]; ALL_TAC] THEN SUBGOAL_THEN `FINITE {n | DISJOINT (IMAGE (ITER n cexp) v) real}` ASSUME_TAC THENL [MP_TAC(SPEC `v:complex->bool` LEMMA_6) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..N` THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN MATCH_MP_TAC(MESON[ARITH_RULE `~(n:num <= N) ==> n = N + (n - N)`] `(!d:num. ~P (N + d)) ==> (!n. P n ==> n <= N)`) THEN REWRITE_TAC[DISJOINT] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[ADD_CLAUSES; ITER_POINTLESS] THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. real x ==> real(cexp x)) ==> ~(s INTER real = {}) ==> ~(IMAGE cexp s INTER real = {})`) THEN REWRITE_TAC[REAL_EXP]; ALL_TAC] THEN SUBGOAL_THEN `INFINITE {n | IMAGE (ITER n cexp) v SUBSET h /\ ~(DISJOINT (IMAGE (ITER n cexp) v) real) /\ ~(IMAGE (ITER n cexp) v SUBSET s)}` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} = {x | R x} DIFF ({x | ~P x} UNION {x | ~Q x})`] THEN MATCH_MP_TAC INFINITE_DIFF_FINITE THEN ASM_REWRITE_TAC[FINITE_UNION; INFINITE] THEN DISCH_THEN(MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_GSPEC] THEN X_GEN_TAC `N:num` THEN SUBGOAL_THEN `?z. z IN IMAGE (ITER (N + 1) cexp) v /\ ~(real z)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s SUBSET t) ==> ?z. z IN s /\ ~t z`) THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN REWRITE_TAC[INTERIOR_REAL] THEN MATCH_MP_TAC(SET_RULE `interior(IMAGE f s) = IMAGE f s /\ ~(s = {}) ==> ~(interior(IMAGE f s) SUBSET {})`) THEN ASM_REWRITE_TAC[INTERIOR_EQ] THEN SPEC_TAC(`N + 1`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER_POINTLESS; IMAGE_I; IMAGE_o] THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] OPEN_MAPPING_THM) THEN EXISTS_TAC `IMAGE (ITER n cexp) v` THEN ASM_REWRITE_TAC[SUBSET_REFL; HOLOMORPHIC_ON_CEXP] THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_ITER_CEXP] THEN DISCH_THEN(X_CHOOSE_TAC `c:complex`) THEN SUBGOAL_THEN `?x. x IN IMAGE (ITER n cexp) v` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `x:complex` CEXP_NZ) THEN REWRITE_TAC[] THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`cexp`; `x:complex`] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CEXP] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`(\z. c):complex->complex`; `IMAGE (ITER n cexp) v`] THEN ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(MP_TAC o MATCH_MP LEMMA_2b) THEN EXPAND_TAC "s" THEN REWRITE_TAC[real_gt; IN_ELIM_THM; SUBSET] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN DISCH_THEN(MP_TAC o SPEC `n + N + 1:num`) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ITER_ADD_POINTLESS] THEN SIMP_TAC[ARITH_RULE `~(n + N + 1 <= N)`; IMAGE_o; GSYM REAL_NOT_LT] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `INFINITE {n | ~(IMAGE (ITER n cexp) v SUBSET w)}` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INFINITE_SUPERSET)) THEN GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (ITER n cexp) v`; `s:complex->bool`] CONNECTED_INTER_FRONTIER) THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_ITER_CEXP] THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(DISJOINT s real) ==> {x | real x} SUBSET t ==> ~(s INTER t = {})`)) THEN EXPAND_TAC "s" THEN SIMP_TAC[real; IN_ELIM_THM; SUBSET] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `DISJOINT (frontier s) (w INTER h:complex->bool)` ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IM_DEF; FRONTIER_STRIP_COMPONENT_LE] THEN REWRITE_TAC[GSYM IM_DEF] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN u ==> ~(x IN t)) ==> DISJOINT s (t INTER u)`) THEN MAP_EVERY EXPAND_TAC ["h"; "w"] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IM_CEXP; real_gt] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[REAL_NOT_LE; REAL_ABS_MUL; REAL_ABS_EXP] THEN SUBGOAL_THEN `abs(sin(Im z)) = sqrt(&3) / &2` SUBST1_TAC THENL [FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `abs x = a ==> x = a \/ x = --a`)) THEN REWRITE_TAC[SIN_NEG; SIN_PI3; REAL_ABS_NEG] THEN SIMP_TAC[REAL_ABS_REFL; REAL_LE_DIV; SQRT_POS_LE; REAL_POS]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `pi < &4 /\ &2 pow 4 <= x * y ==> &2 * pi < x * y / &2`) THEN CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= x /\ x * &1 <= x * s ==> a <= x * s`) THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `exp(&4 * &1)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_EXP_N] THEN MATCH_MP_TAC REAL_POW_LE2 THEN MP_TAC E_APPROX_32 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_MONO_LE] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN SUBST1_TAC(SYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]; ALL_TAC] THEN SUBGOAL_THEN `INFINITE {n | ~(IMAGE (ITER n cexp) v SUBSET {z | abs(Im z) <= &2 * pi}) /\ ~DISJOINT (IMAGE (ITER n cexp) v) real}` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `{x | P x /\ ~Q x} = {x | P x} DIFF {x | Q x}`] THEN MATCH_MP_TAC INFINITE_DIFF_FINITE THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `INFINITE {n | ~(IMAGE (ITER n cexp) v SUBSET w)}` THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN EXPAND_TAC "w" THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`; SUBSET_INTER; FINITE_SUBSET_NUMSEG] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN REWRITE_TAC[IN_ELIM_THM; CONTRAPOS_THM; GSYM NOT_LT] THEN DISCH_THEN(fun th -> X_GEN_TAC `k:num` THEN DISCH_TAC THEN MP_TAC(SPEC `k:num` th) THEN MP_TAC(SPEC `SUC k` th)) THEN ASM_SIMP_TAC[LT_SUC_LE; LT_IMP_LE; ITER_POINTLESS] THEN REWRITE_TAC[IMAGE_o] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `INFINITE {n | ~(IMAGE (ITER n cexp) v INTER {x | abs(Im x) = pi} = {})}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INFINITE_SUPERSET)) THEN GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SUBSET; DISJOINT; IN_ELIM_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_INTER; REAL_NOT_LE; real; IN_ELIM_THM; SET_RULE `x IN real <=> real x`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `a:complex` STRIP_ASSUME_TAC)) THEN MP_TAC(ISPECL [`IMAGE (lift o abs o Im) (IMAGE (ITER n cexp) v)`; `(lift o abs o Im) a`; `(lift o abs o Im) b`; `pi`; `1`] CONNECTED_IVT_COMPONENT) THEN ASM_SIMP_TAC[DIMINDEX_1; LE_REFL; FUN_IN_IMAGE] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EXISTS_IN_IMAGE] THEN REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_ITER_CEXP] THEN REWRITE_TAC[o_DEF; IM_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_ABS_COMPONENT THEN REWRITE_TAC[CONTINUOUS_ON_ID]; REWRITE_TAC[INFINITE]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[FINITE_SUBSET_NUMSEG] THEN REWRITE_TAC[SUBSET; GE; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM NOT_LT; CONTRAPOS_THM] THEN REWRITE_TAC[IN_ELIM_THM; NOT_LT; SET_RULE `IMAGE f s INTER t = {} <=> !x. x IN s ==> ~(f x IN t)`] THEN DISCH_THEN(fun th -> X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:complex` THEN DISCH_TAC THEN MP_TAC(ISPECL [`SUC(SUC n)`; `x:complex`] th)) THEN ASM_SIMP_TAC[ARITH_RULE `N < n ==> N <= SUC(SUC n)`; GSYM REAL_NOT_LE; CONTRAPOS_THM] THEN SIMP_TAC[ITER; NORM_CEXP; RE_CEXP] THEN ONCE_REWRITE_TAC[GSYM COS_ABS] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COS_PI; GSYM REAL_EXP_0; REAL_EXP_MONO_LE] THEN REWRITE_TAC[REAL_EXP_0; REAL_ARITH `x * -- &1 <= &0 <=> &0 <= x`] THEN REWRITE_TAC[REAL_EXP_POS_LE]);; (* ------------------------------------------------------------------------- *) (* Hence a strong form of topological transitivity. *) (* ------------------------------------------------------------------------- *) let STRONG = prove (`!u a. open u /\ ~(u = {}) /\ ~(a = Cx(&0)) ==> ?n. a IN IMAGE (ITER n cexp) u`, SUBGOAL_THEN `!v a. open v /\ ~(v = {}) /\ connected v /\ ~(Cx(&0) IN v) /\ ~(a = Cx(&0)) ==> ?n. a IN IMAGE (ITER n cexp) v` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(u SUBSET {Cx(&0),a})` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; REWRITE_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN DISCH_THEN(X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `b:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`ball(b:complex,min r (min (norm b) (dist(b,a))))`; `a:complex`]) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BALL_EQ_EMPTY] THEN ASM_REWRITE_TAC[REAL_NOT_LE; REAL_LT_MIN; GSYM DIST_NZ; COMPLEX_NORM_NZ] THEN REWRITE_TAC[IN_BALL; dist; COMPLEX_SUB_RZERO] THEN ANTS_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN GEN_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> a IN IMAGE f s ==> a IN IMAGE f t`) THEN TRANS_TAC SUBSET_TRANS `ball(b:complex,r)` THEN ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN REAL_ARITH_TAC]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `((!x. ~P x) ==> F) ==> ?x. P x`) THEN DISCH_TAC THEN MP_TAC(SPEC `v:complex->bool` THEOREM) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `q:num->num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`\n:num. ITER (q n) cexp`; `{ITER n cexp | n IN (:num)}`; `v:complex->bool`; `Cx(&0)`; `a:complex`] MONTEL_OMITTING) THEN ASM_REWRITE_TAC[NOT_IMP; NOT_FORALL_THM] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_GSPEC]; SET_TAC[]] THEN REWRITE_TAC[IN_UNIV; HOLOMORPHIC_ON_ITER_CEXP] THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN INDUCT_TAC THEN REWRITE_TAC[ITER; CEXP_NZ] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* The usual formulation. *) (* ------------------------------------------------------------------------- *) let COROLLARY = prove (`!u v. open u /\ ~(u = {}) /\ open v /\ ~(v = {}) ==> ?n. ~(IMAGE (ITER n cexp) u INTER v = {})`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(v SUBSET {Cx(&0)})` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_SING] THEN ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(s SUBSET {z}) ==> ?a. a IN s /\ ~(a = z)`)) THEN DISCH_THEN(X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`u:complex->bool`; `b:complex`] STRONG) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; hol-light/Examples/mizar.ml000066400000000000000000000647741303454263000162210ustar00rootroot00000000000000(* ========================================================================= *) (* Mizar-style proofs integrated with the HOL goalstack. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* ========================================================================= *) let old_parse_term = parse_term;; (* ------------------------------------------------------------------------- *) (* This version of CHOOSE is more convenient to "itlist". *) (* ------------------------------------------------------------------------- *) let IMP_CHOOSE_RULE = let P = `P:A->bool` and Q = `Q:bool` and pth = prove (`(!x:A. P x ==> Q) ==> ((?) P ==> Q)`, GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM]) in fun v th -> let ant,con = dest_imp (concl th) in let pred = mk_abs(v,ant) in let tm = concl th in let q = rand tm in let th1 = BETA_CONV(mk_comb(pred,v)) in let th2 = PINST [type_of v,aty] [pred,P; q,Q] pth in let th3 = AP_THM (AP_TERM (rator(rator tm)) th1) q in let th4 = GEN v (EQ_MP (SYM th3) th) in MP th2 th4;; (* ------------------------------------------------------------------------- *) (* Some preterm operations we need. *) (* ------------------------------------------------------------------------- *) let rec split_ppair ptm = match ptm with Combp(Combp(Varp(",",dpty),ptm1),ptm2) -> ptm1::(split_ppair ptm2) | _ -> [ptm];; let pmk_conj(ptm1,ptm2) = Combp(Combp(Varp("/\\",dpty),ptm1),ptm2);; let pmk_exists(v,ptm) = Combp(Varp("?",dpty),Absp(v,ptm));; (* ------------------------------------------------------------------------- *) (* Typecheck a preterm into a term in an environment of (typed) variables. *) (* ------------------------------------------------------------------------- *) let typecheck_in_env env ptm = let penv = itlist (fun v acc -> let n,ty = dest_var v in (n,pretype_of_type ty)::acc) env [] in (term_of_preterm o retypecheck penv) ptm;; (* ------------------------------------------------------------------------- *) (* Converts a labelled preterm (using "and"s) into a single conjunction. *) (* ------------------------------------------------------------------------- *) let delabel lfs = end_itlist (curry pmk_conj) (map snd lfs);; (* ------------------------------------------------------------------------- *) (* These special constants are replaced by useful bits when encountered: *) (* *) (* thesis -- Current thesis (i.e. conclusion of goal). *) (* *) (* antecedent -- antecedent of goal, if applicable *) (* *) (* contradiction -- falsity *) (* *) (* ... -- Right hand side of previous conclusion. *) (* ------------------------------------------------------------------------- *) let thesis = new_definition `thesis = F`;; let antecedent = new_definition `antecedent = F`;; let contradiction = new_definition `contradiction = F`;; let iter_rhs = new_definition `... = @x:A. F`;; (* ------------------------------------------------------------------------- *) (* This function performs the replacement, and typechecks in current env. *) (* *) (* The replacement of "..." is done specially, since it also adds a "then". *) (* ------------------------------------------------------------------------- *) let mizarate_term = let atm = `antecedent` and ttm = `thesis` and ctm = `contradiction` in let f_tm = `F` in let filter_env fvs = let env1 = map dest_var fvs in let sizes = map (fun (v,_) -> v,length (filter ((=) v o fst) env1)) env1 in let env2 = filter (fun (v,_) -> assoc v sizes = 1) env1 in map mk_var env2 in let goal_lconsts (asl,w) = itlist (union o frees o concl o snd) asl (frees w) in fun (asl,w as gl) ptm -> let lconsts = goal_lconsts gl in let tm = typecheck_in_env (filter_env lconsts) ptm in let ant = try fst(dest_imp w) with Failure _ -> atm in subst [w,ttm; ant,atm; f_tm,ctm] tm;; (* ------------------------------------------------------------------------- *) (* The following is occasionally useful as a hack. *) (* ------------------------------------------------------------------------- *) let LIMITED_REWRITE_CONV = let LIMITED_ONCE_REWRITE_CONV ths = GEN_REWRITE_CONV ONCE_DEPTH_CONV ths THENC GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net()) [] in fun n ths tm -> funpow n (CONV_RULE(RAND_CONV(LIMITED_ONCE_REWRITE_CONV ths))) (REFL tm);; (* ------------------------------------------------------------------------- *) (* The default prover. *) (* ------------------------------------------------------------------------- *) let DEFAULT_PROVER = let FREEZE_THENL fn ths x = let ths' = map (ASSUME o concl) ths in let th = fn ths' x in itlist PROVE_HYP ths th in let REWRITE_PROVER ths tm = if length ths < 2 then EQT_ELIM(LIMITED_REWRITE_CONV 3 ths tm) else let ths' = tl ths in let th' = CONV_RULE (LIMITED_REWRITE_CONV 4 ths') (hd ths) in EQT_ELIM(LIMITED_REWRITE_CONV 4 (th'::ths') tm) in fun ths tm -> let sths = itlist (union o CONJUNCTS) ths [] in try prove(tm,MAP_FIRST MATCH_ACCEPT_TAC sths) with Failure _ -> try FREEZE_THENL REWRITE_PROVER ths tm with Failure _ -> prove(tm,GEN_MESON_TAC 0 30 1 ths);; let default_prover = ref DEFAULT_PROVER;; let prover_list = ref ["rewriting",(fun ths tm -> EQT_ELIM(REWRITE_CONV ths tm))];; (* ------------------------------------------------------------------------- *) (* "arithmetic",(fun ths tm -> *) (* let tm' = itlist (curry mk_imp o concl) ths tm in *) (* let th = REAL_ARITH tm' in *) (* rev_itlist (C MP) ths th);; *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* Produce a "default" label for various constructs where applicable. *) (* ------------------------------------------------------------------------- *) let default_assumptions = ref false;; let mklabel s = if s = "" && !default_assumptions then "*" else s;; (* ------------------------------------------------------------------------- *) (* Augment assumptions, throwing away an *unnamed* previous step. *) (* ------------------------------------------------------------------------- *) let augments = let augment nw asl = if asl = [] then [nw] else if fst(hd asl) = "" then nw::(tl asl) else nw::asl in fun labs th asl -> let ths,thl = nsplit CONJ_PAIR (tl labs) th in itlist augment (zip (map mklabel labs) (ths@[thl])) asl;; (* ------------------------------------------------------------------------- *) (* Wrapper for labels in justification list (use K for preproved theorems). *) (* ------------------------------------------------------------------------- *) let L s asl = if s = "" then snd(hd asl) else ((assoc s asl):thm);; (* ------------------------------------------------------------------------- *) (* Perform justification, given asl and target. *) (* ------------------------------------------------------------------------- *) let JUSTIFY (prover,tlist) asl tm = let xthms = map (C I asl) tlist in let proof_fn = if prover = "" then !default_prover else assoc prover (!prover_list) in let ithms = map snd (filter ((=) "*" o fst) asl) in proof_fn (xthms @ ithms) tm;; (* ------------------------------------------------------------------------- *) (* Either do justification or split off subproof then call ttac with result. *) (* ------------------------------------------------------------------------- *) let JUSTIFY_THEN wtm ((pr,tls) as jdata) ttac (asl,w as gl) = if pr = "proof" then SUBGOAL_THEN wtm ttac gl else let wth = JUSTIFY jdata asl wtm in ttac wth gl;; (* ------------------------------------------------------------------------- *) (* Utilise a conclusion. *) (* ------------------------------------------------------------------------- *) let (MIZAR_CONCLUSION_TAC:thm_tactic) = let t_tm = `T` in let CONJ_ASSOC_RULE = EQT_ELIM o GEN_REWRITE_RULE RAND_CONV [EQT_INTRO(SPEC_ALL EQ_REFL)] o PURE_REWRITE_CONV[GSYM CONJ_ASSOC] in fun th (asl,w as gl) -> let cjs = conjuncts(concl th) in let cjs1,cjs2 = chop_list(length cjs) (conjuncts w) in if cjs2 = [] then let th' = EQ_MP (CONJ_ASSOC_RULE(mk_eq(concl th,w))) th in null_meta,[asl,t_tm],fun i _ -> INSTANTIATE i th' else let w1 = list_mk_conj cjs1 and w2 = list_mk_conj cjs2 in let w12 = mk_conj(w1,w2) in let th' = EQ_MP (CONJ_ASSOC_RULE(mk_eq(concl th,w1))) th in let wth = CONJ_ASSOC_RULE(mk_eq(w,w12)) in (SUBST1_TAC wth THEN CONJ_TAC THENL [ACCEPT_TAC th'; ALL_TAC]) gl;; (* ------------------------------------------------------------------------- *) (* Transitivity chain stuff; store a list of useful transitivity theorems. *) (* ------------------------------------------------------------------------- *) let mizar_transitivity_net = ref empty_net;; let add_mizar_transitivity_theorem th = let pat = fst(dest_imp(snd(strip_forall(concl th)))) in mizar_transitivity_net := enter [] (pat,MATCH_MP th) (!mizar_transitivity_net);; let TRANSITIVITY_CHAIN th1 th2 ttac = let tm1 = concl th1 and tm2 = concl th2 in let th = if is_eq tm1 then EQ_MP (SYM (AP_THM (AP_TERM (rator(rator tm2)) th1) (rand tm2))) th2 else if is_eq tm2 then EQ_MP (AP_TERM (rator tm1) th2) th1 else let th12 = CONJ th1 th2 in tryfind (fun rule -> rule th12) (lookup (concl th12) (!mizar_transitivity_net)) in ttac th;; (* ------------------------------------------------------------------------- *) (* Perform terminal or initial step. *) (* ------------------------------------------------------------------------- *) let MIZAR_SUBSTEP_TAC = fun labs thm (asl,w) -> let asl' = augments labs thm asl in null_meta,[asl',w], K(function [th] -> PROVE_HYP thm th | _ -> fail());; let MIZAR_BISTEP_TAC = fun termflag labs jth -> if termflag then MIZAR_SUBSTEP_TAC labs jth THEN MIZAR_CONCLUSION_TAC jth else MIZAR_SUBSTEP_TAC labs jth;; let MIZAR_STEP_TAC = fun termflag lfs (pr,tls as jdata) (asl,w as gl) -> let tm = mizarate_term gl (delabel lfs) in if try fst(dest_const(lhand tm)) = "..." with Failure _ -> false then let thp = snd(hd asl) in let lhd = rand(concl thp) in let tm' = mk_comb(mk_comb(rator(rator tm),lhd),rand tm) in JUSTIFY_THEN tm' (pr,tls) (fun th -> TRANSITIVITY_CHAIN thp th (MIZAR_BISTEP_TAC termflag (map fst lfs))) gl else JUSTIFY_THEN tm (pr,tls) (MIZAR_BISTEP_TAC termflag (map fst lfs)) gl;; (* ------------------------------------------------------------------------- *) (* Perform an "end": finish the trivial goal. *) (* ------------------------------------------------------------------------- *) let MIZAR_END_TAC = ACCEPT_TAC TRUTH;; (* ------------------------------------------------------------------------- *) (* Perform "assume " *) (* ------------------------------------------------------------------------- *) let (MIZAR_ASSUME_TAC: (string * preterm) list -> tactic) = let f_tm = `F` and CONTRA_HACK = CONV_RULE(REWR_CONV(TAUT `(~p ==> F) <=> p`)) in fun lfs (asl,w as gl) -> let tm = mizarate_term gl (delabel lfs) in if try aconv (dest_neg tm) w with Failure _ -> false then (null_meta,[augments (map fst lfs) (ASSUME tm) asl,f_tm], (fun i -> function [th] -> CONTRA_HACK(DISCH (instantiate i tm) th) | _ -> fail())) else if try aconv tm (fst(dest_imp w)) with Failure _ -> false then (null_meta,[augments (map fst lfs) (ASSUME tm) asl,rand w], (fun i -> function [th] -> DISCH (instantiate i tm) th | _ -> fail())) else failwith "MIZAR_ASSUME_REF: Bad thesis";; (* ------------------------------------------------------------------------- *) (* Perform "let ,..., [be ]" *) (* ------------------------------------------------------------------------- *) let (MIZAR_LET_TAC: preterm list * hol_type list -> tactic) = fun (vlist,tys) (asl,w as gl) -> let ty = if tys = [] then type_of(fst(dest_forall w)) else hd tys in let pty = pretype_of_type ty in let mk_varb v = (term_of_preterm o retypecheck []) (Typing(v,pty)) in let vs = map mk_varb vlist in MAP_EVERY X_GEN_TAC vs gl;; (* ------------------------------------------------------------------------- *) (* Perform "take " *) (* ------------------------------------------------------------------------- *) let (MIZAR_TAKE_TAC: preterm -> tactic) = fun ptm (asl,w as gl) -> let ptm' = Typing(ptm,pretype_of_type(type_of(fst(dest_exists w)))) in let tm = mizarate_term (asl,w) ptm' in EXISTS_TAC tm gl;; (* ------------------------------------------------------------------------- *) (* Perform "suffices to prove
by ". *) (* ------------------------------------------------------------------------- *) let MIZAR_SUFFICES_TAC = fun new0 ((pr,tlist) as jdata) (asl,w as gl) -> let nw = mizarate_term gl (end_itlist (curry pmk_conj) new0) in JUSTIFY_THEN (mk_imp(nw,w)) jdata (fun jth (asl,w) -> null_meta,[asl,nw], (fun i -> function [th] -> MP (INSTANTIATE_ALL i jth) th | _ -> fail())) gl;; (* ------------------------------------------------------------------------- *) (* Perform "set " *) (* ------------------------------------------------------------------------- *) let MIZAR_SET_TAC = fun (lab,ptm) (asl,w as gl) -> let tm = mizarate_term gl ptm in let v,t = dest_eq tm in CHOOSE_THEN (fun th -> SUBST_ALL_TAC th THEN LABEL_TAC (mklabel lab) (SYM th)) (EXISTS(mk_exists(v,mk_eq(t,v)),t) (REFL t)) gl;; (* ------------------------------------------------------------------------- *) (* Perform "consider such that by ". *) (* ------------------------------------------------------------------------- *) let MIZAR_CONSIDER_TAC = fun vars0 lfs ((pr,tls) as jdata) (asl,w as gl) -> let ptm = itlist (curry pmk_exists) vars0 (delabel lfs) in let etm = mizarate_term gl ptm in let vars,tm = nsplit dest_exists vars0 etm in JUSTIFY_THEN etm jdata (fun jth (asl,w) -> null_meta,[augments (map fst lfs) (ASSUME tm) asl,w], (fun i -> function [th] -> MP (itlist IMP_CHOOSE_RULE vars (DISCH (instantiate i tm) th)) jth | _ -> fail())) gl;; (* ------------------------------------------------------------------------- *) (* Perform "given such that ". *) (* ------------------------------------------------------------------------- *) let MIZAR_GIVEN_TAC = fun vars0 lfs (asl,w as gl) -> let ant = fst(dest_imp w) in let gvars,gbod = nsplit dest_exists vars0 ant in let tvars = map2 (fun p v -> Typing(p,pretype_of_type(snd(dest_var v)))) vars0 gvars in let ptm = itlist (curry pmk_exists) tvars (delabel lfs) in let etm = mizarate_term gl ptm in let vars,tm = nsplit dest_exists vars0 etm in if try aconv ant etm with Failure _ -> false then null_meta,[augments (map fst lfs) (ASSUME tm) asl,rand w], (fun i -> function [th] -> DISCH ant (MP (itlist IMP_CHOOSE_RULE vars (DISCH (instantiate i tm) th)) (ASSUME ant)) | _ -> fail()) else failwith "MIZAR_GIVEN_TAC: Bad thesis";; (* ------------------------------------------------------------------------- *) (* Initialize a case split. *) (* ------------------------------------------------------------------------- *) let MIZAR_PER_CASES_TAC = fun jdata (asl,w as gl) -> null_meta,[gl], K(function [th] -> let ghyps = itlist (union o hyp o snd) asl [] in let rogues = subtract (hyp th) ghyps in if rogues = [] then th else if tl rogues = [] then let thm = JUSTIFY jdata asl (hd rogues) in PROVE_HYP thm th else failwith "MIZAR_PER_CASES_ATAC: Too many suppositions" | _ -> fail());; (* ------------------------------------------------------------------------- *) (* Perform a case split. NB! This tactic is not "valid" in the LCF sense. *) (* We could make it so, but that would force classical logic! *) (* ------------------------------------------------------------------------- *) let MIZAR_SUPPOSE_TAC = fun lfs (asl,w as gl) -> let asm = mizarate_term gl (delabel lfs) in let ghyps = itlist (union o hyp o snd) asl [] in null_meta, [augments (map fst lfs) (ASSUME asm) asl,w; gl], K(function [th1; th2] -> let hyp1 = hyp th1 and hyp2 = hyp th2 in let asm1 = subtract hyp1 ghyps and asm2 = subtract hyp2 ghyps in if asm1 = [] then th1 else if asm2 = [] then th2 else if tl asm1 = [] && tl asm2 = [] then DISJ_CASES (ASSUME(mk_disj(hd asm1,hd asm2))) th1 th2 else failwith "MIZAR_SUPPOSE_TAC: Too many suppositions" | _ -> fail());; let MIZAR_SUPPOSE_REF lfs = by (MIZAR_SUPPOSE_TAC lfs) o by (TRY MIZAR_END_TAC);; (* ------------------------------------------------------------------------- *) (* Terminate a case split. *) (* ------------------------------------------------------------------------- *) let MIZAR_RAW_ENDCASE_TAC = let pth = ITAUT `F ==> p` and p = `p:bool` in fun (asl,w) -> let th = UNDISCH (INST [w,p] pth) in null_meta,[],fun _ _ -> th;; let MIZAR_ENDCASE_REF = by MIZAR_RAW_ENDCASE_TAC o by (TRY MIZAR_END_TAC);; (* ------------------------------------------------------------------------- *) (* Parser-processor for textual version of Mizar proofs. *) (* ------------------------------------------------------------------------- *) let add_mizar_words,subtract_mizar_words = let l = ["assume"; "take"; "set"; "given"; "such"; "that"; "proof"; "end"; "consider"; "suffices"; "to"; "show"; "per"; "cases"; "endcase"; "suppose"; "be"; "then"; "thus"; "hence"; "by"; "so"] in (fun () -> reserve_words l), (fun () -> unreserve_words l);; let parse_preform l = let ptm,rst = parse_preterm l in let ptm' = Typing(ptm,Ptycon("bool",[])) in ptm',rst;; let parse_fulltype l = let pty,rst = parse_pretype l in type_of_pretype pty,rst;; let parse_ident l = match (hd l) with Ident n -> n,tl l | _ -> raise Noparse;; let parse_string l = match (hd l) with Ident n -> n,tl l | Resword n -> n,tl l;; let rec parse_lform oldlab l = match l with (Ident n)::(Resword ":")::rst -> if oldlab = "" then parse_lform n rst else failwith "Too many labels" | _ -> let fm,rst = parse_preform l in (oldlab,fm),rst;; let parse_lforms oldlab = listof (parse_lform oldlab) (a (Resword "and")) "labelled formula";; let parse_just tlink l = if l = [] then if tlink then ("",[L""]),l else ("",[]),l else match (hd l) with Resword "by" -> let pot,rem = parse_string (tl l) in if rem = [] || hd rem <> Ident "," && hd rem <> Ident "with" then if can (assoc pot) (!prover_list) then (pot,if tlink then [L""] else []),rem else ("",if tlink then [L""; L pot] else [L pot]),rem else if hd rem = Ident "," then let oths,rst = listof parse_string (a (Ident ",")) "theorem name" (tl rem) in let ths = if tlink then ""::pot::oths else pot::oths in ("",map L ths),rst else let oths,rst = listof parse_string (a (Ident ",")) "theorem name" (tl rem) in let ths = if tlink then ""::oths else oths in (pot,map L ths),rst | Resword "proof" -> ("proof",[]),tl l | _ -> if tlink then ("",[L""]),l else ("",[]),l;; let rec parse_step tlink l = (a (Resword "assume") ++ parse_lforms "" >> (by o MIZAR_ASSUME_TAC o snd) ||| (a (Resword "let") ++ (parse_preterm >> split_ppair) ++ possibly (a (Resword "be") ++ parse_fulltype >> snd) >> (fun ((_,vnames),ty) -> by (MIZAR_LET_TAC (vnames,ty)))) ||| (a (Resword "take") ++ parse_preterm >> (by o MIZAR_TAKE_TAC o snd)) ||| (a (Resword "set") ++ parse_lforms "" >> (itlist (by o MIZAR_SET_TAC) o snd)) ||| (a (Resword "consider") ++ (parse_preterm >> split_ppair) ++ a (Resword "such") ++ a (Resword "that") ++ parse_lforms "" ++ parse_just tlink >> (fun (((((_,vars),_),_),lf),jst) -> by (MIZAR_CONSIDER_TAC vars lf jst))) ||| (a (Resword "given") ++ (parse_preterm >> split_ppair) ++ a (Resword "such") ++ a (Resword "that") ++ parse_lforms "" >> (fun ((((_,vars),_),_),lf) -> by (MIZAR_GIVEN_TAC vars lf))) ||| (a (Resword "suffices") ++ a (Resword "to") ++ a (Resword "show") ++ parse_lforms "" ++ parse_just tlink >> (fun ((((_,_),_),lf),jst) -> by (MIZAR_SUFFICES_TAC (map snd lf) jst))) ||| (a (Resword "per") ++ a (Resword "cases") ++ parse_just tlink >> (fun ((_,_),jst) -> by (MIZAR_PER_CASES_TAC jst))) ||| (a (Resword "suppose") ++ parse_lforms "" >> (fun (_,lf) -> MIZAR_SUPPOSE_REF lf)) ||| (a (Resword "endcase") >> K MIZAR_ENDCASE_REF) ||| (a (Resword "end") >> K (by MIZAR_END_TAC)) ||| (a (Resword "then") ++ parse_step true >> snd) ||| (a (Resword "so") ++ parse_step true >> snd) ||| (a (Resword "hence") ++ parse_lforms "" ++ parse_just true >> (fun ((_,lf),jst) -> by (MIZAR_STEP_TAC true lf jst))) ||| (a (Resword "thus") ++ parse_lforms "" ++ parse_just tlink >> (fun ((_,lf),jst) -> by (MIZAR_STEP_TAC true lf jst))) ||| (parse_lforms "" ++ parse_just tlink >> (fun (lf,jst) -> by (MIZAR_STEP_TAC false lf jst)))) l;; (* ------------------------------------------------------------------------- *) (* From now on, quotations evaluate to preterms. *) (* ------------------------------------------------------------------------- *) let run_steps lexemes = let rec compose_steps lexemes gs = if lexemes = [] then gs else let rf,rest = parse_step false lexemes in let gs' = rf gs in if rest <> [] && hd rest = Resword ";" then compose_steps (tl rest) gs' else compose_steps rest gs' in refine (compose_steps lexemes);; (* ------------------------------------------------------------------------- *) (* Include some theorems. *) (* ------------------------------------------------------------------------- *) do_list add_mizar_transitivity_theorem [LE_TRANS; LT_TRANS; LET_TRANS; LTE_TRANS];; do_list add_mizar_transitivity_theorem [INT_LE_TRANS; INT_LT_TRANS; INT_LET_TRANS; INT_LTE_TRANS];; do_list add_mizar_transitivity_theorem [REAL_LE_TRANS; REAL_LT_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS];; do_list add_mizar_transitivity_theorem [SUBSET_TRANS; PSUBSET_TRANS; PSUBSET_SUBSET_TRANS; SUBSET_PSUBSET_TRANS];; (* ------------------------------------------------------------------------- *) (* Simple example: Knaster-Tarski fixpoint theorem. *) (* ------------------------------------------------------------------------- *) add_mizar_words();; hide_constant "<=";; (*** Set up goal ***) g `!f. (!x y. x <= y /\ y <= x ==> (x = y)) /\ (!x y z. x <= y /\ y <= z ==> x <= z) /\ (!x y. x <= y ==> f x <= f y) /\ (!X. ?s:A. (!x. x IN X ==> s <= x) /\ (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s)) ==> ?x. f x = x`;; (*** Start parsing quotations as Mizar directives ***) let parse_term = run_steps o lex o explode;; (*** Label the external facts needed ***) e(LABEL_TAC "IN_ELIM_THM" IN_ELIM_THM);; e(LABEL_TAC "BETA_THM" BETA_THM);; (*** The proof itself ***) `let f be A->A; assume L:antecedent; antisymmetry: (!x y. x <= y /\ y <= x ==> (x = y)) by L; transitivity: (!x y z. x <= y /\ y <= z ==> x <= z) by L; monotonicity: (!x y. x <= y ==> f x <= f y) by L; least_upper_bound: (!X. ?s:A. (!x. x IN X ==> s <= x) /\ (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s)) by L; set Y_def: Y = {b | f b <= b}; Y_thm: !b. b IN Y <=> f b <= b by Y_def,IN_ELIM_THM,BETA_THM; consider a such that lub: (!x. x IN Y ==> a <= x) /\ (!a'. (!x. x IN Y ==> a' <= x) ==> a' <= a) by least_upper_bound; take a; !b. b IN Y ==> f a <= b proof let b be A; assume b_in_Y: b IN Y; then L0: f b <= b by Y_thm; a <= b by b_in_Y, lub; so f a <= f b by monotonicity; hence f a <= b by L0, transitivity; end; so Part1: f(a) <= a by lub; so f(f(a)) <= f(a) by monotonicity; so f(a) IN Y by Y_thm; so a <= f(a) by lub; hence thesis by Part1, antisymmetry; end`;; (*** Get the theorem ***) top_thm();; (* ------------------------------------------------------------------------- *) (* Back to normal. *) (* ------------------------------------------------------------------------- *) let parse_term = old_parse_term;; hol-light/Examples/multiwf.ml000066400000000000000000000324321303454263000165500ustar00rootroot00000000000000(* ========================================================================= *) (* Part 1: Background theories. *) (* ========================================================================= *) let EMPTY_IS_FINITE = prove (`!s. (s = EMPTY) ==> FINITE s`, SIMP_TAC[FINITE_RULES]);; let SING_IS_FINITE = prove (`!s a. (s = {a}) ==> FINITE s`, SIMP_TAC[FINITE_INSERT; FINITE_RULES]);; let UNION_NONZERO = prove (`{a | ~(f a + g a = 0)} = {a | ~(f a = 0)} UNION {a | ~(g a = 0)}`, REWRITE_TAC[ADD_EQ_0; EXTENSION; IN_UNION; IN_ELIM_THM; DE_MORGAN_THM]);; (* ------------------------------------------------------------------------- *) (* Definition of type of finite multisets with a few basic operations. *) (* ------------------------------------------------------------------------- *) parse_as_infix("mmember",(11,"right"));; parse_as_infix("munion",(16,"right"));; parse_as_infix("mdiff",(18,"left"));; let multiset_tybij_th = prove (`?f. FINITE {a:A | ~(f a = 0)}`, EXISTS_TAC `\a:A. 0` THEN SIMP_TAC[EMPTY_IS_FINITE; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]);; let multiset_tybij = new_type_definition "multiset" ("multiset","multiplicity") multiset_tybij_th;; let mempty = new_definition `mempty = multiset (\b. 0)`;; let mmember = new_definition `a mmember M <=> ~(multiplicity M a = 0)`;; let msing = new_definition `msing a = multiset (\b. if b = a then 1 else 0)`;; let munion = new_definition `M munion N = multiset(\b. multiplicity M b + multiplicity N b)`;; let mdiff = new_definition `M mdiff N = multiset(\b. multiplicity M b - multiplicity N b)`;; (* ------------------------------------------------------------------------- *) (* Extensionality for multisets. *) (* ------------------------------------------------------------------------- *) let MEXTENSION = prove (`(M = N) = !a. multiplicity M a = multiplicity N a`, REWRITE_TAC[GSYM FUN_EQ_THM] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MESON_TAC[multiset_tybij]);; (* ------------------------------------------------------------------------- *) (* Basic properties of multisets. *) (* ------------------------------------------------------------------------- *) let MULTIPLICITY_MULTISET = prove (`FINITE {a | ~(f a = 0)} /\ (f a = y) ==> (multiplicity(multiset f) a = y)`, SIMP_TAC[multiset_tybij]);; let MEMPTY = prove (`multiplicity mempty a = 0`, REWRITE_TAC[mempty] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN SIMP_TAC[EMPTY_IS_FINITE; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]);; let MSING = prove (`multiplicity (msing (a:A)) b = if b = a then 1 else 0`, REWRITE_TAC[msing] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN REWRITE_TAC[] THEN MATCH_MP_TAC SING_IS_FINITE THEN EXISTS_TAC `a:A` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[ARITH_EQ]);; let MUNION = prove (`multiplicity (M munion N) a = multiplicity M a + multiplicity N a`, REWRITE_TAC[munion] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN REWRITE_TAC[UNION_NONZERO; FINITE_UNION] THEN SIMP_TAC[multiset_tybij] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[multiset_tybij]);; let MDIFF = prove (`multiplicity (M mdiff N) (a:A) = multiplicity M a - multiplicity N a`, REWRITE_TAC[mdiff] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{a:A | ~(multiplicity M a = 0)}` THEN SIMP_TAC[SUBSET; IN_ELIM_THM; multiset_tybij] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[multiset_tybij] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some trivial properties of multisets that we use later. *) (* ------------------------------------------------------------------------- *) let MUNION_MEMPTY = prove (`~(M munion (msing(a:A)) = mempty)`, REWRITE_TAC[MEXTENSION; MEMPTY; MSING; MUNION] THEN DISCH_THEN(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ]);; let MMEMBER_MUNION = prove (`x mmember (M munion N) <=> x mmember M \/ x mmember N`, REWRITE_TAC[mmember; MUNION; ADD_EQ_0; DE_MORGAN_THM]);; let MMEMBER_MSING = prove (`x mmember (msing a) <=> (x = a)`, REWRITE_TAC[mmember; MSING] THEN COND_CASES_TAC THEN REWRITE_TAC[ARITH_EQ]);; let MUNION_EMPTY = prove (`M munion mempty = M`, REWRITE_TAC[MEXTENSION; MUNION; MEMPTY; ADD_CLAUSES]);; let MUNION_ASSOC = prove (`M1 munion (M2 munion M3) = (M1 munion M2) munion M3`, REWRITE_TAC[MEXTENSION; MUNION; ADD_ASSOC]);; let MUNION_AC = prove (`(M1 munion M2 = M2 munion M1) /\ ((M1 munion M2) munion M3 = M1 munion M2 munion M3) /\ (M1 munion M2 munion M3 = M2 munion M1 munion M3)`, REWRITE_TAC[MEXTENSION; MUNION; ADD_AC]);; let MUNION_11 = prove (`(M1 munion N = M2 munion N) <=> (M1 = M2)`, REWRITE_TAC[MEXTENSION; MUNION; EQ_ADD_RCANCEL]);; let MUNION_INUNION = prove (`a mmember (M munion (msing b)) /\ ~(b = a) ==> a mmember M`, REWRITE_TAC[mmember; MUNION; MSING; ADD_EQ_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ]);; let MMEMBER_MDIFF = prove (`(a:A) mmember M ==> (M = (M mdiff (msing a)) munion (msing a))`, REWRITE_TAC[mmember; MEXTENSION; MUNION; MDIFF; MSING] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(multiplicity M (a:A) = 0)` THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Induction principle for multisets. *) (* ------------------------------------------------------------------------- *) let MULTISET_INDUCT_LEMMA1 = prove (`(!M. ({a | ~(multiplicity M a = 0)} SUBSET s) ==> P M) /\ (!a:A M. P M ==> P (M munion (msing a))) ==> !n M. (multiplicity M a = n) /\ {a:A | ~(multiplicity M a = 0)} SUBSET (a INSERT s) ==> P M`, STRIP_TAC THEN INDUCT_TAC THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `{a:A | ~(multiplicity M a = 0)} SUBSET (a INSERT s)` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT] THEN ASM_MESON_TAC[]; SUBGOAL_THEN `M = (M mdiff (msing(a:A))) munion (msing a)` SUBST1_TAC THENL [MATCH_MP_TAC MMEMBER_MDIFF THEN ASM_REWRITE_TAC[mmember; NOT_SUC]; ALL_TAC] THEN MAP_EVERY (MATCH_MP_TAC o ASSUME) [`!a:A M. P M ==> P (M munion msing a)`; `!M. (multiplicity M a = n) /\ {a:A | ~(multiplicity M a = 0)} SUBSET (a INSERT s) ==> P M`] THEN ASM_REWRITE_TAC[MDIFF; MSING; ARITH_RULE `SUC n - 1 = n`] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `{a:A | ~(multiplicity M a = 0)}` THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; CONTRAPOS_THM; SUB_0]]);; let MULTISET_INDUCT_LEMMA2 = prove (`P mempty /\ (!a:A M. P M ==> P (M munion (msing a))) ==> !s. FINITE s ==> !M. {a:A | ~(multiplicity M a = 0)} SUBSET s ==> P M`, STRIP_TAC THEN MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `M:(A)multiset = mempty` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[MEXTENSION; MEMPTY]; X_GEN_TAC `a:A`] THEN REPEAT STRIP_TAC THEN MP_TAC MULTISET_INDUCT_LEMMA1 THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM EXISTS_REFL]);; let MULTISET_INDUCT = prove (`P mempty /\ (!a:A M. P M ==> P (M munion (msing a))) ==> !M. P M`, DISCH_THEN(MP_TAC o MATCH_MP MULTISET_INDUCT_LEMMA2) THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN GEN_TAC THEN DISCH_THEN MATCH_MP_TAC THEN EXISTS_TAC `{a:A | ~(multiplicity M a = 0)}` THEN REWRITE_TAC[SUBSET_REFL; multiset_tybij] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[multiset_tybij]);; (* ========================================================================= *) (* Part 2: Transcription of Tobias's paper. *) (* ========================================================================= *) parse_as_infix("<<",(12,"right"));; (* ------------------------------------------------------------------------- *) (* Wellfounded part of a relation. *) (* ------------------------------------------------------------------------- *) let WFP_RULES,WFP_INDUCT,WFP_CASES = new_inductive_definition `!x. (!y. y << x ==> WFP(<<) y) ==> WFP(<<) x`;; (* ------------------------------------------------------------------------- *) (* Wellfounded part induction. *) (* ------------------------------------------------------------------------- *) let WFP_PART_INDUCT = prove (`!P. (!x. x IN WFP(<<) /\ (!y. y << x ==> P(y)) ==> P(x)) ==> !x:A. x IN WFP(<<) ==> P(x)`, GEN_TAC THEN REWRITE_TAC[IN] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> a ==> a /\ b`] THEN MATCH_MP_TAC WFP_INDUCT THEN ASM_MESON_TAC[WFP_RULES]);; (* ------------------------------------------------------------------------- *) (* A relation is wellfounded iff WFP is the whole universe. *) (* ------------------------------------------------------------------------- *) let WFP_WF = prove (`WF(<<) <=> (WFP(<<) = UNIV:A->bool)`, EQ_TAC THENL [REWRITE_TAC[WF_IND; EXTENSION; IN; UNIV] THEN MESON_TAC[WFP_RULES]; DISCH_TAC THEN MP_TAC WFP_PART_INDUCT THEN ASM_REWRITE_TAC[IN; UNIV; WF_IND]]);; (* ------------------------------------------------------------------------- *) (* The multiset order. *) (* ------------------------------------------------------------------------- *) let morder = new_definition `morder(<<) N M <=> ?M0 a K. (M = M0 munion (msing a)) /\ (N = M0 munion K) /\ (!b. b mmember K ==> b << a)`;; (* ------------------------------------------------------------------------- *) (* We separate off this part from the proof of LEMMA_2_1. *) (* ------------------------------------------------------------------------- *) let LEMMA_2_0 = prove (`morder(<<) N (M0 munion (msing a)) ==> (?M. morder(<<) M M0 /\ (N = M munion (msing a))) \/ (?K. (N = M0 munion K) /\ (!b:A. b mmember K ==> b << a))`, GEN_REWRITE_TAC LAND_CONV [morder] THEN DISCH_THEN(EVERY_TCL (map X_CHOOSE_THEN [`M1:(A)multiset`; `b:A`; `K:(A)multiset`]) STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `b:A = a` THENL [DISJ2_TAC THEN UNDISCH_THEN `b:A = a` SUBST_ALL_TAC THEN EXISTS_TAC `K:(A)multiset` THEN ASM_MESON_TAC[MUNION_11]; DISJ1_TAC] THEN SUBGOAL_THEN `?M2. M1 = M2 munion (msing(a:A))` STRIP_ASSUME_TAC THENL [EXISTS_TAC `M1 mdiff (msing(a:A))` THEN MAP_EVERY MATCH_MP_TAC [MMEMBER_MDIFF; MUNION_INUNION] THEN UNDISCH_TAC `M0 munion (msing a) = M1 munion (msing(b:A))` THEN ASM_REWRITE_TAC[MEXTENSION; MUNION; MSING; mmember] THEN DISCH_THEN(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `M2 munion K:(A)multiset` THEN ASM_REWRITE_TAC[MUNION_AC] THEN REWRITE_TAC[morder] THEN MAP_EVERY EXISTS_TAC [`M2:(A)multiset`; `b:A`; `K:(A)multiset`] THEN UNDISCH_TAC `M0 munion msing (a:A) = M1 munion msing b` THEN ASM_REWRITE_TAC[MUNION_AC] THEN MESON_TAC[MUNION_AC; MUNION_11]);; (* ------------------------------------------------------------------------- *) (* The sequence of lemmas from Tobias's paper. *) (* ------------------------------------------------------------------------- *) let LEMMA_2_1 = prove (`(!M b:A. b << a /\ M IN WFP(morder(<<)) ==> (M munion (msing b)) IN WFP(morder(<<))) /\ M0 IN WFP(morder(<<)) /\ (!M. morder(<<) M M0 ==> (M munion (msing a)) IN WFP(morder(<<))) ==> (M0 munion (msing a)) IN WFP(morder(<<))`, STRIP_TAC THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC WFP_RULES THEN X_GEN_TAC `N:(A)multiset` THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP LEMMA_2_0) THENL [ASM_MESON_TAC[IN]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN SPEC_TAC(`N:(A)multiset`,`N:(A)multiset`) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC MULTISET_INDUCT THEN REPEAT STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[MUNION_ASSOC; MMEMBER_MUNION; MMEMBER_MSING]) THEN ASM_MESON_TAC[IN; MUNION_EMPTY]);; let LEMMA_2_2 = prove (`(!M b. b << a /\ M IN WFP(morder(<<)) ==> (M munion (msing b)) IN WFP(morder(<<))) ==> !M. M IN WFP(morder(<<)) ==> (M munion (msing a)) IN WFP(morder(<<))`, STRIP_TAC THEN MATCH_MP_TAC WFP_PART_INDUCT THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LEMMA_2_1 THEN ASM_REWRITE_TAC[]);; let LEMMA_2_3 = prove (`WF(<<) ==> !a M. M IN WFP(morder(<<)) ==> (M munion (msing a)) IN WFP(morder(<<))`, REWRITE_TAC[WF_IND] THEN DISCH_THEN MATCH_MP_TAC THEN MESON_TAC[LEMMA_2_2]);; let LEMMA_2_4 = prove (`WF(<<) ==> !M. M IN WFP(morder(<<))`, DISCH_TAC THEN MATCH_MP_TAC MULTISET_INDUCT THEN CONJ_TAC THENL [REWRITE_TAC[IN] THEN MATCH_MP_TAC WFP_RULES THEN REWRITE_TAC[morder; MUNION_MEMPTY]; ASM_SIMP_TAC[LEMMA_2_3]]);; (* ------------------------------------------------------------------------- *) (* Hence the final result. *) (* ------------------------------------------------------------------------- *) let MORDER_WF = prove (`WF(<<) ==> WF(morder(<<))`, SIMP_TAC[WFP_WF; EXTENSION; IN_UNIV; LEMMA_2_4]);; hol-light/Examples/pell.ml000066400000000000000000003301031303454263000160110ustar00rootroot00000000000000(* ========================================================================= *) (* Analysis of solutions to Pell equation *) (* ========================================================================= *) needs "Library/analysis.ml";; needs "Library/transc.ml";; needs "Library/prime.ml";; prioritize_real();; let PELL_INDUCTION = prove (`P 0 /\ P 1 /\ (!n. P n /\ P (n + 1) ==> P(n + 2)) ==> !n. P n`, STRIP_TAC THEN SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> REWRITE_TAC[th]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_SIMP_TAC[ADD1; ARITH_RULE `SUC(n + 1) = n + 2`]);; (* ------------------------------------------------------------------------- *) (* Useful number-theoretic basics *) (* ------------------------------------------------------------------------- *) let ROOT_NONPOWER = prove (`!p q d n. ~(q = 0) /\ (p EXP n = d * q EXP n) ==> ?a. d = a EXP n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `q:num`; `p:num`] DIVIDES_EXP2_REV) THEN ASM_REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `d:num`) THEN REWRITE_TAC[EQT_INTRO(SPEC_ALL MULT_SYM)] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN DISCH_THEN(X_CHOOSE_THEN `a:num` SUBST_ALL_TAC) THEN EXISTS_TAC `a:num` THEN UNDISCH_TAC `(a * q) EXP n = d * q EXP n` THEN ASM_SIMP_TAC[MULT_EXP; EQ_MULT_RCANCEL; EXP_EQ_0]);; let INTEGER_SUB_LEMMA = prove (`!x y. ?n. (&x - &y) pow 2 = &n pow 2`, REPEAT STRIP_TAC THEN DISJ_CASES_THEN MP_TAC (SPECL [`&x`; `&y`] REAL_LE_TOTAL) THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN DISCH_TAC THENL [EXISTS_TAC `y - x:num`; EXISTS_TAC `x - y:num`] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; let SQRT_LINEAR_EQ = prove (`!a u v x y. 2 <= a ==> ((&u + &v * sqrt(&a pow 2 - &1) = &x + &y * sqrt(&a pow 2 - &1)) <=> (u = x) /\ (v = y))`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN REWRITE_TAC[REAL_ARITH `(a + b = c + d) <=> (a - c = d - b)`] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN REWRITE_TAC[REAL_POW_MUL] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `2 <= a ==> 1 <= a`] THEN X_CHOOSE_TAC `p:num` (SPECL [`u:num`; `x:num`] INTEGER_SUB_LEMMA) THEN X_CHOOSE_TAC `q:num` (SPECL [`y:num`; `v:num`] INTEGER_SUB_LEMMA) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `2 <= a ==> 1 <= a`]; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN DISCH_TAC THEN MP_TAC(SPECL [`p:num`; `q:num`; `a EXP 2 - 1`; `2`] ROOT_NONPOWER) THEN ASM_REWRITE_TAC[EQT_INTRO(SPEC_ALL MULT_SYM)] THEN MATCH_MP_TAC(TAUT `~b /\ (a ==> c) ==> ((~a ==> b) ==> c)`) THEN CONJ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `b:num` MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a - 1 = b) ==> 1 < a ==> (a - b = 1)`)) THEN SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 EXP))) THEN ASM_REWRITE_TAC[LT_EXP; ARITH_LE; ARITH_LT] THEN REWRITE_TAC[EXP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a - b = 1) ==> (a = b + 1)`)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_POW_2] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(a * a = b * b + &1) ==> ((a + b) * (a - b) = &1)`)) THEN DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN REWRITE_TAC[REAL_POW_MUL] THEN X_CHOOSE_TAC `c:num` (SPECL [`a:num`; `b:num`] INTEGER_SUB_LEMMA) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_OF_NUM_EQ; EXP_ONE; EXP_EQ_1; MULT_EQ_1; ARITH_EQ] THEN UNDISCH_TAC `2 <= a` THEN ARITH_TAC; DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `p EXP 2 = 0 EXP 2 * (a EXP 2 - 1)` THEN REWRITE_TAC[ARITH; MULT_CLAUSES; EXP_EQ_0] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `(&u - &x) pow 2 = &0 pow 2` THEN UNDISCH_TAC `(&y - &v) pow 2 = &0 pow 2` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_EQ_0; ARITH_EQ; REAL_SUB_0] THEN SIMP_TAC[REAL_OF_NUM_EQ]]);; (* ------------------------------------------------------------------------- *) (* Recurrence defining the solutions. *) (* ------------------------------------------------------------------------- *) let X_DEF = let th = prove (`!a. ?X. !n. X n = if n = 0 then 1 else if n = 1 then a else 2 * a * X(n-1) - X(n-2)`, GEN_TAC THEN MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN BINOP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `n - m < n <=> ~(m = 0) /\ ~(n = 0)`; ARITH_EQ]) in new_specification ["X"] (REWRITE_RULE[SKOLEM_THM] th);; let X_CLAUSES = prove (`(!a. X a 0 = 1) /\ (!a. X a 1 = a) /\ (!a n. X a (n + 2) = 2 * a * X a (n + 1) - X a (n))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [X_DEF] THEN REWRITE_TAC[ARITH_EQ; ADD_EQ_0; ARITH_RULE `~(n + 2 = 1)`] THEN REWRITE_TAC[ARITH_RULE `((n + 2) - 2 = n) /\ ((n + 2) - 1 = n + 1)`]);; let Y_DEF = let th = prove (`!a. ?Y. !n. Y n = if n = 0 then 0 else if n = 1 then 1 else 2 * a * Y(n-1) - Y(n-2)`, GEN_TAC THEN MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN BINOP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `n - m < n <=> ~(m = 0) /\ ~(n = 0)`; ARITH_EQ]) in new_specification ["Y"] (REWRITE_RULE[SKOLEM_THM] th);; let Y_CLAUSES = prove (`(!a. Y a 0 = 0) /\ (!a. Y a 1 = 1) /\ (!a n. Y a (n + 2) = 2 * a * Y a (n + 1) - Y a (n))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [Y_DEF] THEN REWRITE_TAC[ARITH_EQ; ADD_EQ_0; ARITH_RULE `~(n + 2 = 1)`] THEN REWRITE_TAC[ARITH_RULE `((n + 2) - 2 = n) /\ ((n + 2) - 1 = n + 1)`]);; (* ------------------------------------------------------------------------- *) (* An obvious but tiresome lemma: the Xs and Ys increase. *) (* ------------------------------------------------------------------------- *) let X_INCREASES = prove (`!a n. ~(a = 0) ==> X a n <= X a (n + 1)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[X_CLAUSES; ADD_CLAUSES; ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN GEN_REWRITE_TAC RAND_CONV [X_DEF] THEN ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `(n + 1 = 1) <=> (n = 0)`] THEN REWRITE_TAC[ADD_SUB] THEN MATCH_MP_TAC(ARITH_RULE `a + b <= c ==> a <= c - b:num`) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 * X a n` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[LE_MULT_LCANCEL; ARITH_EQ] THEN UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`a:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN REWRITE_TAC[ARITH_RULE `a <= b + a:num`]] THEN MATCH_MP_TAC(ARITH_RULE `b <= a ==> a + b <= 2 * a`) THEN SUBGOAL_THEN `n = (n - 1) + 1` SUBST1_TAC THENL [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `((n + 1) + 1) - 2 = n`] THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC);; let Y_INCREASES = prove (`!a n. ~(a = 0) ==> Y a n <= Y a (n + 1)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[Y_CLAUSES; ADD_CLAUSES; LE_0] THEN GEN_REWRITE_TAC RAND_CONV [Y_DEF] THEN ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `(n + 1 = 1) <=> (n = 0)`] THEN REWRITE_TAC[ADD_SUB] THEN MATCH_MP_TAC(ARITH_RULE `a + b <= c ==> a <= c - b:num`) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 * Y a n` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[LE_MULT_LCANCEL; ARITH_EQ] THEN UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`a:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN REWRITE_TAC[ARITH_RULE `a <= b + a:num`]] THEN MATCH_MP_TAC(ARITH_RULE `b <= a ==> a + b <= 2 * a`) THEN SUBGOAL_THEN `n = (n - 1) + 1` SUBST1_TAC THENL [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `((n + 1) + 1) - 2 = n`] THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Show that the expression is a power of the basis. *) (* ------------------------------------------------------------------------- *) let XY_POWER_POS = prove (`!a n. ~(a = 0) ==> (&(X a n) + &(Y a n) * sqrt(&a pow 2 - &1) = (&a + sqrt(&a pow 2 - &1)) pow n)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[X_DEF; Y_DEF] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; real_pow] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_1; REAL_MUL_LID] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN SUBGOAL_THEN `(&(2 * a * X a (n - 1) - X a (n - 2)) = &(2 * a * X a (n - 1)) - &(X a (n - 2))) /\ (&(2 * a * Y a (n - 1) - Y a (n - 2)) = &(2 * a * Y a (n - 1)) - &(Y a (n - 2)))` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC(GSYM REAL_OF_NUM_SUB) THEN MATCH_MP_TAC(ARITH_RULE `x <= y /\ y <= 2 * a * y ==> x <= 2 * a * y`) THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> (n - 1 = (n - 2) + 1)`] THEN ASM_SIMP_TAC[X_INCREASES; Y_INCREASES] THEN REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `(x1 - x2) + (y1 - y2) * a = (x1 + y1 * a) - (x2 + y2 * a)`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_ADD_LDISTRIB] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> n - 2 < n /\ n - 1 < n`] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> (n - 1 = 1 + (n - 2))`] THEN REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; REAL_POW_1] THEN REWRITE_TAC[REAL_ARITH `a * b - b = (a - &1) * b`] THEN SUBGOAL_THEN `n = 2 + (n - 2)` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_POW_ADD] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; let XY_POWER_NEG = prove (`!a n. ~(a = 0) ==> (&(X a n) - &(Y a n) * sqrt(&a pow 2 - &1) = (&a - sqrt(&a pow 2 - &1)) pow n)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[X_DEF; Y_DEF] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO; real_pow] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_1; REAL_MUL_LID] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN SUBGOAL_THEN `(&(2 * a * X a (n - 1) - X a (n - 2)) = &(2 * a * X a (n - 1)) - &(X a (n - 2))) /\ (&(2 * a * Y a (n - 1) - Y a (n - 2)) = &(2 * a * Y a (n - 1)) - &(Y a (n - 2)))` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC(GSYM REAL_OF_NUM_SUB) THEN MATCH_MP_TAC(ARITH_RULE `x <= y /\ y <= 2 * a * y ==> x <= 2 * a * y`) THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> (n - 1 = (n - 2) + 1)`] THEN ASM_SIMP_TAC[X_INCREASES; Y_INCREASES] THEN REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `(x1 - x2) - (y1 - y2) * a = (x1 - y1 * a) - (x2 - y2 * a)`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_SUB_LDISTRIB] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> n - 2 < n /\ n - 1 < n`] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> (n - 1 = 1 + (n - 2))`] THEN REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; REAL_POW_1] THEN REWRITE_TAC[REAL_ARITH `a * b - b = (a - &1) * b`] THEN SUBGOAL_THEN `n = 2 + (n - 2)` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THENL [MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_POW_ADD] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_2; REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence all members of recurrence relations are Pell solutions. *) (* ------------------------------------------------------------------------- *) let XY_ARE_SOLUTIONS = prove (`!a n. ~(a = 0) ==> ((X a n) EXP 2 = (a EXP 2 - 1) * (Y a n) EXP 2 + 1)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP XY_POWER_NEG) THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP XY_POWER_POS) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> MP_TAC(MK_COMB(AP_TERM `( * )` (CONJUNCT1 th),CONJUNCT2 th))) THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_ARITH `(x + y) * (x - y) = x * x - y * y`] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (a * c) * (b * d)`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN REWRITE_TAC[REAL_ARITH `a - (a - &1) = &1`; REAL_POW_ONE] THEN REWRITE_TAC[REAL_EQ_SUB_RADD] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `1 <= a <=> ~(a = 0)`]; REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN REWRITE_TAC[MULT_AC; ADD_AC]]);; (* ------------------------------------------------------------------------- *) (* And they are all solutions. *) (* ------------------------------------------------------------------------- *) let X_DEGENERATE = prove (`!n. X 1 n = 1`, MATCH_MP_TAC PELL_INDUCTION THEN SIMP_TAC[X_CLAUSES; ARITH]);; let Y_DEGENERATE = prove (`!n. Y 1 n = n`, MATCH_MP_TAC PELL_INDUCTION THEN SIMP_TAC[Y_CLAUSES] THEN REPEAT STRIP_TAC THEN ARITH_TAC);; let REAL_ARCH_POW = prove (`!x y. &1 < x /\ &1 < y ==> ?n. x pow n <= y /\ y < x pow (SUC n)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `ln(x)` REAL_ARCH_LEAST) THEN ASM_SIMP_TAC[LN_POS_LT] THEN DISCH_THEN(MP_TAC o SPEC `ln(y)`) THEN ASM_SIMP_TAC[LN_POS_LT; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[GSYM LN_POW; REAL_ARITH `&1 < x ==> &0 < x`; REAL_POW_LT; LN_MONO_LT; LN_MONO_LE]);; let SOLUTIONS_INDUCTION = prove (`!a x y. ~(a = 0) /\ ~(a = 1) /\ ~(y = 0) /\ (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) ==> ?x' y'. x' < x /\ y' < y /\ (x' EXP 2 = (a EXP 2 - 1) * y' EXP 2 + 1) /\ (&x + &y * sqrt(&a pow 2 - &1) = (&x' + &y' * sqrt(&a pow 2 - &1)) * (&a + sqrt(&a pow 2 - &1)))`, REPEAT STRIP_TAC THEN EXISTS_TAC `a * x - (a EXP 2 - 1) * y` THEN EXISTS_TAC `a * y - x:num` THEN SUBGOAL_THEN `x <= a * y:num` ASSUME_TAC THENL [ONCE_REWRITE_TAC[GSYM(SPECL [`x:num`; `y:num`; `1`] EXP_MONO_LE_SUC)] THEN ASM_REWRITE_TAC[ARITH_SUC] THEN REWRITE_TAC[GSYM ADD1; LE_SUC_LT] THEN REWRITE_TAC[MULT_EXP; LT_MULT_RCANCEL] THEN REWRITE_TAC[ARITH_RULE `a - 1 < a <=> ~(a = 0)`] THEN ASM_REWRITE_TAC[EXP_EQ_0]; ALL_TAC] THEN SUBGOAL_THEN `(a EXP 2 - 1) * y <= a * x:num` ASSUME_TAC THENL [SUBGOAL_THEN `(a EXP 2 - 1) * y EXP 2 < a * x * y` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[MULT_ASSOC; EXP_2; LT_MULT_RCANCEL; LT_IMP_LE]] THEN REWRITE_TAC[GSYM LE_SUC_LT; ADD1] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN REWRITE_TAC[EXP_2; GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN DISJ2_TAC THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `d /\ (d ==> a /\ b /\ c) ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&a - sqrt(&a pow 2 - &1)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `(a + b) * (a - b) = a * a - b * b`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REWRITE_TAC[REAL_ARITH `a - (a - b) = b`; REAL_MUL_RID] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[REAL_ARITH `(x + y * s) * (a - s) = (a * x - (s * s) * y) + (a * y - x) * s`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN SUBGOAL_THEN `(&x - &y * sqrt(&a pow 2 - &1)) = (&(a * x - (a EXP 2 - 1) * y) - &(a * y - x) * sqrt (&a pow 2 - &1)) * (&a - sqrt(&a pow 2 - &1))` MP_TAC THENL [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&a + sqrt(&a pow 2 - &1)` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `~(a = --b) ==> ~(a + b = &0)`) THEN DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN REWRITE_TAC[REAL_POW_NEG; ARITH] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `(a - b) * (a + b) = a * a - b * b`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REWRITE_TAC[REAL_ARITH `a - (a - b) = b`; REAL_MUL_RID] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[REAL_ARITH `(x - y * s) * (a + s) = (a * x - (s * s) * y) - (a * y - x) * s`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN DISCH_THEN(fun th1 -> DISCH_THEN (fun th2 -> MP_TAC(MK_COMB(AP_TERM `( * )` th1,th2)))) THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (c * a) * (d * b)`] THEN REWRITE_TAC[REAL_ARITH `(a + b) * (a - b) = a * a - b * b`] THEN REWRITE_TAC[REAL_ARITH `(a - b) * (a + b) = a * a - b * b`] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * b) = (c * a) * (b * b)`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REWRITE_TAC[REAL_ARITH `a - (a - b) = b`; REAL_MUL_RID] THEN ASM_REWRITE_TAC[REAL_OF_NUM_POW] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `((a * b + &1) - b * a = x - y) ==> (x = y + &1)`)) THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_OF_NUM_SUB; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN ABBREV_TAC `u = a * x - (a EXP 2 - 1) * y` THEN ABBREV_TAC `v = a * y - x:num` THEN DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[MULT_SYM]) THEN REWRITE_TAC[MULT_AC] THEN MATCH_MP_TAC(TAUT `(a <=> b) /\ (~a /\ ~b ==> F) ==> a /\ b`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM(SPEC `1` EXP_MONO_LT_SUC)] THEN ASM_REWRITE_TAC[ARITH_SUC] THEN REWRITE_TAC[LT_ADD_RCANCEL; LT_MULT_LCANCEL] THEN REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC] THEN MATCH_MP_TAC(TAUT `a ==> (a /\ b <=> b)`) THEN REWRITE_TAC[SUB_EQ_0; ARITH_SUC; NOT_LE] THEN SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 EXP))) THEN REWRITE_TAC[LT_EXP] THEN REWRITE_TAC[ARITH] THEN MATCH_MP_TAC(ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[NOT_LT] THEN STRIP_TAC THEN UNDISCH_TAC `&x + &y * sqrt (&a pow 2 - &1) = (&u + &v * sqrt (&a pow 2 - &1)) * (&a + sqrt (&a pow 2 - &1))` THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> ~(a = b)`) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(&u + &v * sqrt (&a pow 2 - &1)) * &1` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; SQRT_POS_LE; REAL_POW_LE_1; REAL_SUB_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT; LT_NZ] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `0 EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1` THEN DISCH_THEN(MP_TAC o SYM) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; SQRT_POS_LE; REAL_POW_LE_1; REAL_SUB_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&1 < x /\ &0 <= y ==> &1 < x + y`) THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; SQRT_POS_LE; REAL_POW_LE_1; REAL_SUB_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN MATCH_MP_TAC(ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 1 < a`) THEN ASM_REWRITE_TAC[]);; let SOLUTIONS_ARE_XY = prove (`!a x y. ~(a = 0) /\ (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) ==> ?n. (x = X a n) /\ (y = Y a n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a = 1` THENL [ASM_REWRITE_TAC[ARITH; MULT_CLAUSES; ADD_CLAUSES; EXP_2] THEN SIMP_TAC[MULT_EQ_1; X_DEGENERATE; Y_DEGENERATE; GSYM EXISTS_REFL]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `?n. &x + &y * sqrt(&a pow 2 - &1) = (&a + sqrt(&a pow 2 - &1)) pow n` MP_TAC THENL [UNDISCH_TAC `x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1` THEN SPEC_TAC(`x:num`,`x:num`) THEN SPEC_TAC(`y:num`,`y:num`) THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `y0:num` THEN DISCH_TAC THEN X_GEN_TAC `x0:num` THEN ASM_CASES_TAC `y0 = 0` THENL [ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES; MULT_EQ_1] THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `0` THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; real_pow]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(SPECL [`a:num`; `x0:num`; `y0:num`] SOLUTIONS_INDUCTION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `x1:num` (X_CHOOSE_THEN `y1:num` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y1:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x1:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN EXISTS_TAC `SUC n` THEN REWRITE_TAC[real_pow; REAL_MUL_AC]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM XY_POWER_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN ASM_SIMP_TAC[SQRT_LINEAR_EQ; ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`]);; (* ------------------------------------------------------------------------- *) (* Addition formulas. *) (* ------------------------------------------------------------------------- *) let ADDITION_FORMULA_POS = prove (`!a m n. ~(a = 0) ==> ((X a (m + n) = X a m * X a n + (a EXP 2 - 1) * Y a m * Y a n) /\ (Y a (m + n) = X a m * Y a n + X a n * Y a m))`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a = 1` THENL [ASM_REWRITE_TAC[X_DEGENERATE; Y_DEGENERATE] THEN REWRITE_TAC[ARITH; MULT_CLAUSES] THEN REWRITE_TAC[ADD_AC]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `m + n:num`] XY_POWER_POS) THEN MP_TAC(SPECL [`a:num`; `m:num`] XY_POWER_POS) THEN MP_TAC(SPECL [`a:num`; `n:num`] XY_POWER_POS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_POW_ADD] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `(a + b * s) * (c + d * s) = (a * c + (s * s) * b * d) + (a * d + b * c) * s`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_LINEAR_EQ; ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`] THEN REWRITE_TAC[MULT_AC]);; let ADDITION_FORMULA_NEG = prove (`!a m n. ~(a = 0) /\ m <= n ==> ((X a (n - m) = X a m * X a n - (a EXP 2 - 1) * Y a m * Y a n) /\ (Y a (n - m) = X a m * Y a n - X a n * Y a m))`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a = 1` THENL [ASM_REWRITE_TAC[X_DEGENERATE; Y_DEGENERATE] THEN REWRITE_TAC[ARITH; MULT_CLAUSES]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `n - m:num`] XY_POWER_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) (((&a - sqrt (&a pow 2 - &1)) * (&a + sqrt (&a pow 2 - &1))) pow m)`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `(x - y) * (x + y) = x * x - y * y`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN REWRITE_TAC[REAL_ARITH `x - (x - &1) = &1`] THEN REWRITE_TAC[REAL_POW_MUL; REAL_POW_ONE; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN ASM_SIMP_TAC[ARITH_RULE `m <= n ==> (m + (n - m) = n:num)`] THEN MP_TAC(SPECL [`a:num`; `m:num`] XY_POWER_NEG) THEN MP_TAC(SPECL [`a:num`; `n:num`] XY_POWER_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `(a - b * s) * (c + d * s) = (a * c - (s * s) * b * d) + (a * d - b * c) * s`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a + b * s = (x1 - x2) + (y1 - y2) * s) = ((a + x2) + (b + y2) * s = x1 + y1 * s)`] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_LINEAR_EQ; ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`] THEN DISCH_THEN(CONJUNCTS_THEN(SUBST1_TAC o SYM)) THEN REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_SUB]);; (* ------------------------------------------------------------------------- *) (* Some stronger monotonicity theorems for Y. *) (* ------------------------------------------------------------------------- *) let Y_INCREASES_SUC = prove (`!a n. ~(a = 0) ==> Y a n < Y a (SUC n)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ADD1; ADDITION_FORMULA_POS] THEN REWRITE_TAC[X_CLAUSES; Y_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `1 * y <= ay /\ ~(x = 0) ==> y < x * 1 + ay`) THEN ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN MATCH_MP_TAC(ARITH_RULE `!n. (n = 1) /\ n <= m ==> ~(m = 0)`) THEN EXISTS_TAC `X a 0` THEN CONJ_TAC THENL [REWRITE_TAC[X_CLAUSES]; ALL_TAC] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN REWRITE_TAC[ADD1] THEN ASM_MESON_TAC[LE_TRANS; X_INCREASES]);; let Y_INCREASES_LT = prove (`!a m n. ~(a = 0) /\ m < n ==> Y a m < Y a n`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [LT_EXISTS] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_TAC THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `Y a (SUC m)` THEN ASM_SIMP_TAC[Y_INCREASES_SUC] THEN REWRITE_TAC[ARITH_RULE `m + SUC d = SUC m + d`] THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[ADD_CLAUSES]) THEN ASM_MESON_TAC[ADD1; LE_TRANS; Y_INCREASES]);; let Y_INCREASES_LE = prove (`!a m n. ~(a = 0) /\ m <= n ==> Y a m <= Y a n`, REWRITE_TAC[LE_LT] THEN MESON_TAC[LE_REFL; Y_INCREASES_LT]);; let Y_INJ = prove (`!a m n. ~(a = 0) ==> ((Y a m = Y a n) <=> (m = n))`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN MP_TAC(SPEC `a:num` Y_INCREASES_LT) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[LT_CASES; LT_REFL]);; (* ------------------------------------------------------------------------- *) (* One for X (to get the same as Y, need a /= 1). *) (* ------------------------------------------------------------------------- *) let X_INCREASES_LE = prove (`!a m n. ~(a = 0) /\ m <= n ==> X a m <= X a n`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(K ALL_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN REWRITE_TAC[ADD1] THEN ASM_MESON_TAC[LE_TRANS; X_INCREASES]);; let X_INCREASES_LT = prove (`!a m n. ~(a = 0) /\ ~(a = 1) /\ m < n ==> X a m < X a n`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LE_SUC_LT] THEN STRIP_TAC THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `X a (SUC m)` THEN ASM_SIMP_TAC[X_INCREASES_LE] THEN SPEC_TAC(`m:num`,`p:num`) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ARITH; X_CLAUSES; ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 1 < a`] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC p) = p + 2`] THEN REWRITE_TAC[X_CLAUSES; ADD1] THEN MATCH_MP_TAC(ARITH_RULE `a <= b /\ c < b ==> a < 2 * b - c`) THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `X a (SUC p)` THEN ASM_REWRITE_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[LE_MULT_RCANCEL; ADD1] THEN DISJ1_TAC THEN MAP_EVERY UNDISCH_TAC [`~(a = 0)`; `~(a = 1)`] THEN ARITH_TAC);; let X_INCREASES_SUC = prove (`!a n. ~(a = 0) /\ ~(a = 1) ==> X a n < X a (SUC n)`, SIMP_TAC[X_INCREASES_LT; LT]);; let X_INJ = prove (`!a m n. ~(a = 0) /\ ~(a = 1) ==> ((X a m = X a n) <=> (m = n))`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN MP_TAC(SPEC `a:num` X_INCREASES_LT) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[LT_CASES; LT_REFL]);; (* ------------------------------------------------------------------------- *) (* Coprimality of "X a n" and "Y a n". *) (* ------------------------------------------------------------------------- *) let XY_COPRIME = prove (`!a n. ~(a = 0) ==> coprime(X a n,Y a n)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP XY_ARE_SOLUTIONS) THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN REWRITE_TAC[coprime; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[divides] THEN STRIP_TAC THEN ASM_REWRITE_TAC[EXP_2] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV o LAND_CONV) [AC MULT_AC `a * d * x * d * x = d * d * a * x * x:num`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a = b + 1) ==> (a - b = 1)`)) THEN ASM_REWRITE_TAC[GSYM LEFT_SUB_DISTRIB; MULT_EQ_1]);; (* ------------------------------------------------------------------------- *) (* Divisibility properties. *) (* ------------------------------------------------------------------------- *) let Y_DIVIDES_LEMMA = prove (`!a k n. ~(a = 0) ==> (Y a n) divides (Y a (n * k))`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES] THEN REWRITE_TAC[Y_CLAUSES; DIVIDES_0] THEN ASM_SIMP_TAC[ADDITION_FORMULA_POS] THEN UNDISCH_TAC `Y a n divides Y a (n * k)` THEN SIMP_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_TAC THEN EXISTS_TAC `X a n * d + X a (n * k)` THEN REWRITE_TAC[LEFT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC; ADD_AC]);; let Y_DIVIDES = prove (`!a m n. ~(a = 0) ==> ((Y a m) divides (Y a n) <=> m divides n)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [divides] THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; Y_DIVIDES_LEMMA]] THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THEN ASM_CASES_TAC `m = 0` THENL [ASM_REWRITE_TAC[Y_CLAUSES; DIVIDES_ZERO] THEN MATCH_MP_TAC(ARITH_RULE `!n. (n = 1) /\ n <= m ==> ~(m = 0)`) THEN EXISTS_TAC `Y a 1` THEN CONJ_TAC THENL [REWRITE_TAC[Y_CLAUSES]; ALL_TAC] THEN ASM_SIMP_TAC[Y_INCREASES_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`]; ALL_TAC] THEN MP_TAC(SPECL [`n:num`; `m:num`] DIVISION) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `q = n DIV m` THEN ABBREV_TAC `r = n MOD m` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `r = 0` THEN ASM_SIMP_TAC[ADD_CLAUSES; DIVIDES_LMUL; DIVIDES_REFL] THEN DISCH_TAC THEN ASM_SIMP_TAC[ADDITION_FORMULA_POS] THEN SUBGOAL_THEN `~((Y a m) divides (X a (q * m) * Y a r))` MP_TAC THENL [ALL_TAC; REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN DISCH_TAC THEN MATCH_MP_TAC DIVIDES_ADD_REVL THEN EXISTS_TAC `X a r * Y a (q * m)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [MULT_SYM] THEN ASM_SIMP_TAC[DIVIDES_LMUL; Y_DIVIDES_LEMMA]] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COPRIME_DIVPROD)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MP_TAC(SPECL [`a:num`; `q * m:num`] XY_COPRIME) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN REWRITE_TAC[coprime; NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_MESON_TAC[DIVIDES_TRANS; Y_DIVIDES_LEMMA]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_SIMP_TAC[DE_MORGAN_THM; NOT_LE; Y_INCREASES_LT] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 Y_CLAUSES)] THEN ASM_SIMP_TAC[Y_INJ]);; (* ------------------------------------------------------------------------- *) (* This lemma would be trivial from binomial theorem. *) (* ------------------------------------------------------------------------- *) let BINOMIAL_TRIVIALITY = prove (`!x y d n. ?p q. (&x + &y * sqrt(&d)) pow (n + 2) = &x pow (n + 2) + &(n + 2) * &x pow (n + 1) * &y * sqrt(&d) + &(((n + 1) * (n + 2)) DIV 2) * &x pow n * &y pow 2 * &d + &p * &y pow 3 + &q * &y pow 3 * sqrt(&d)`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL [REPEAT(EXISTS_TAC `0`) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_1; real_pow; REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[REAL_POW_2] THEN REWRITE_TAC[REAL_ARITH `(x + y) * (x + y) = x * x + &2 * x * y + y * y`] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (a * b) = (a * a) * b * b`] THEN SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_POS]; ALL_TAC] THEN GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o TOP_DEPTH_CONV) [ADD_CLAUSES; real_pow] THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` (X_CHOOSE_THEN `q:num` SUBST1_TAC)) THEN REWRITE_TAC[REAL_ARITH `(x + y) * (xn + xn1 + xn2 + p + q) = (x * xn) + (x * xn1 + y * xn) + (x * xn2 + y * xn1) + (y * xn2 + p * x + q * y) + (p * y + q * x)`] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * n2 * xn1 * y * d + (y * d) * xn2 = (n2 * x * xn1 + xn2) * y * d`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ARITH_RULE `SUC(n + m) = n + SUC m`] THEN REWRITE_TAC[ARITH_RULE `SUC n + m = n + SUC m`] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&n * x + x = (&n + &1) * x`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; ARITH_RULE `(n + 2) + 1 = n + 3`] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; GSYM REAL_MUL_ASSOC; REAL_EQ_LADD] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * n12 * xn * y2 * d + y * s * n2 * xn1 * y * s + a = (n12 * (x * xn) * y2 * d + n2 * xn1 * (y * y) * (s * s)) + a`] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM(CONJUNCT2 real_pow)] THEN SIMP_TAC[SQRT_POW_2; REAL_POS] THEN REWRITE_TAC[ADD1; REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB] THEN SUBGOAL_THEN `&(((n + 1) * (n + 2)) DIV 2) + &(n + 2) = &(((n + 2) * (n + 3)) DIV 2)` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[ARITH; ADD_CLAUSES] THEN REWRITE_TAC[ARITH_RULE `(n + 2) * (n + 3) = n * n + 5 * n + 6`] THEN REWRITE_TAC[ARITH_RULE `(x + 5 * n + 6 = (y + n + 2) * 2) <=> (x + 3 * n + 2 = 2 * y)`] THEN REWRITE_TAC[ARITH_RULE `n * n + 3 * n + 2 = (n + 1) * (n + 2)`] THEN SUBGOAL_THEN `EVEN((n + 1) * (n + 2))` MP_TAC THENL [REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH_EVEN] THEN CONV_TAC(EQT_INTRO o TAUT); ALL_TAC] THEN SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[DIV_MULT; ARITH_EQ]; ALL_TAC] THEN REWRITE_TAC[REAL_EQ_LADD] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ARITH `q * y3 * s * y * s = q * y * y3 * s * s`] THEN SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_POS] THEN ONCE_REWRITE_TAC[REAL_ARITH `y * s * nn * xn * y2 * d = nn * d * xn * (y * y2) * s`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN EXISTS_TAC `p * x + q * y * d:num` THEN REWRITE_TAC[ARITH_SUC] THEN EXISTS_TAC `((n + 1) * (n + 2)) DIV 2 * d * x EXP n + p * y + q * x` THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_AC] THEN REWRITE_TAC[REAL_ADD_AC]);; (* ------------------------------------------------------------------------- *) (* A lower bound theorem. *) (* ------------------------------------------------------------------------- *) let Y_LOWERBOUND = prove (`!a n. (2 * a - 1) EXP n <= Y a (n + 1)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH; Y_CLAUSES] THEN ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[ARITH; MULT_CLAUSES; LE_0] THEN REWRITE_TAC[ARITH_RULE `SUC n + 1 = n + 2`; Y_CLAUSES] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(2 * a - 1) * Y a (n + 1)` THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN REWRITE_TAC[RIGHT_SUB_DISTRIB; MULT_CLAUSES; GSYM MULT_ASSOC] THEN MATCH_MP_TAC(ARITH_RULE `a <= b ==> c - b <= c - a:num`) THEN ASM_SIMP_TAC[Y_INCREASES]);; let Y_UPPERBOUND = prove (`!a n. Y a (n + 1) <= (2 * a) EXP n`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ADD_CLAUSES; Y_CLAUSES; LE_REFL] THEN REWRITE_TAC[ARITH_RULE `SUC(n + 1) = n + 2`; Y_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `a <= b ==> a - c <= b:num`) THEN ASM_REWRITE_TAC[MULT_ASSOC; LE_MULT_LCANCEL]);; (* ------------------------------------------------------------------------- *) (* Now a key congruence. *) (* ------------------------------------------------------------------------- *) let XY_Y3_CONGRUENCE = prove (`!a n k. ~(a = 0) ==> ?q. Y a (n * k) = k * (X a n) EXP (k - 1) * Y a n + q * (Y a n) EXP 3`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `k = 0` THENL [EXISTS_TAC `0` THEN ASM_REWRITE_TAC[Y_CLAUSES; MULT_CLAUSES; ADD_CLAUSES; SUB_0]; ALL_TAC] THEN ASM_CASES_TAC `a = 1` THENL [ASM_REWRITE_TAC[X_DEGENERATE; Y_DEGENERATE; EXP_ONE] THEN EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN ASM_CASES_TAC `k = 1` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; SUB_REFL; EXP] THEN EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `n * k:num`] XY_POWER_POS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN MP_TAC(SPECL [`a:num`; `n:num`] XY_POWER_POS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SUBGOAL_THEN `2 <= k` MP_TAC THENL [MAP_EVERY UNDISCH_TAC [`~(k = 0)`; `~(k = 1)`] THEN ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM])) THEN MP_TAC(SPECL [`X a n`; `Y a n`; `a EXP 2 - 1`; `d:num`] BINOMIAL_TRIVIALITY) THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` (X_CHOOSE_THEN `q:num` SUBST1_TAC)) THEN ONCE_REWRITE_TAC[REAL_ARITH `x1 + y1 + x2 + x3 + y2 = (x1 + x2 + x3) + (y1 + y2)`] THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_LINEAR_EQ; ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 2 <= p`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `(d + 2) - 1 = d + 1`] THEN EXISTS_TAC `q:num` THEN REWRITE_TAC[GSYM MULT_ASSOC]);; (* ------------------------------------------------------------------------- *) (* The other key divisibility result. *) (* ------------------------------------------------------------------------- *) let Y2_DIVIDES = prove (`!a m n. ~(a = 0) ==> (((Y a m) EXP 2) divides (Y a n) <=> (m * Y a m) divides n)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = 0` THENL [ASM_REWRITE_TAC[Y_CLAUSES; MULT_CLAUSES; DIVIDES_ZERO; EXP_2] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM(CONJUNCT1 Y_CLAUSES)] THEN ASM_SIMP_TAC[Y_INJ]; ALL_TAC] THEN SUBGOAL_THEN `~(Y a m = 0)` ASSUME_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM(CONJUNCT1 Y_CLAUSES)] THEN ASM_SIMP_TAC[Y_INJ]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `!c. (a ==> c) /\ (b ==> c) /\ (c ==> (a <=> b)) ==> (a <=> b)`) THEN EXISTS_TAC `m divides n` THEN REPEAT CONJ_TAC THENL [DISCH_TAC THEN SUBGOAL_THEN `(Y a m) divides (Y a n)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[Y_DIVIDES]] THEN UNDISCH_TAC `((Y a m) EXP 2) divides (Y a n)` THEN REWRITE_TAC[divides; EXP_2; GSYM MULT_ASSOC] THEN MESON_TAC[]; REWRITE_TAC[divides; GSYM MULT_ASSOC] THEN MESON_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [divides] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN MP_TAC(SPECL [`a:num`; `m:num`; `k:num`] XY_Y3_CONGRUENCE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `((Y a m) EXP 2) divides (k * (X a m) EXP (k - 1) * Y a m)` THEN CONJ_TAC THENL [REWRITE_TAC[num_CONV `3`; EXP] THEN MESON_TAC[DIVIDES_ADD; DIVIDES_ADD_REVL; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MULT_SYM] THEN REWRITE_TAC[EXP_2; GSYM MULT_ASSOC] THEN ASM_SIMP_TAC[DIVIDES_LMUL2_EQ] THEN EQ_TAC THEN SIMP_TAC[DIVIDES_RMUL] THEN DISCH_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THEN EXISTS_TAC `X a m EXP (k - 1)` THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COPRIME_EXP THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[XY_COPRIME]);; (* ------------------------------------------------------------------------- *) (* Some more congruences. *) (* ------------------------------------------------------------------------- *) let Y_N_MOD2 = prove (`!a n. ~(a = 0) ==> ?q. Y a n = 2 * q + n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[Y_CLAUSES] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP Y_INCREASES) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `2 * q1 + n <= 2 * q2 + n + 1 <=> q1 <= q2`] THEN DISCH_TAC THEN EXISTS_TAC `(2 * a * q2 - q1) + (a - 1) * (n + 1)` THEN MATCH_MP_TAC(ARITH_RULE `v <= u /\ y <= x /\ (2 * (x + z) + w + v = 2 * y + u) ==> (u - v = 2 * ((x - y) + z) + w)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[LEFT_ADD_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `x <= u /\ y <= v ==> 2 * x + y <= 2 * u + v + w`) THEN REWRITE_TAC[MULT_ASSOC] THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THENL [MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC] THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`a:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[ARITH_RULE `SUC a - 1 = a`] THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ARITH_TAC]);; let Y_N_MODA1 = prove (`!a n. ~(a = 0) ==> ?q. Y a n = q * (a - 1) + n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN ASM_CASES_TAC `a = 1` THENL [ASM_REWRITE_TAC[SUB_REFL; Y_DEGENERATE; MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[Y_CLAUSES] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP Y_INCREASES) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `q1 + n <= q2 + n + 1 <=> q1 <= q2 + 1`] THEN ASM_CASES_TAC `q2 = 0` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[ARITH_RULE `a <= 1 <=> (a = 0) \/ (a = 1)`] THEN ASM_REWRITE_TAC[MULT_EQ_0; MULT_EQ_1] THEN ASM_REWRITE_TAC[ARITH_RULE `(a - 1 = 0) <=> (a = 0) \/ (a = 1)`] THEN SIMP_TAC[ARITH_RULE `(a - 1 = 1) <=> (a = 2)`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THENL [EXISTS_TAC `2 * (n + 1)` THEN UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`b:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[ARITH_RULE `SUC n - 1 = n`] THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `(a + c = b) ==> (b - a = c:num)`) THEN ARITH_TAC; REWRITE_TAC[MULT_ASSOC; ARITH] THEN REWRITE_TAC[ARITH_RULE `4 * (n + 1) - (1 + n) = 3 * (n + 1)`] THEN EXISTS_TAC `2 * n + 1` THEN ARITH_TAC]; ALL_TAC] THEN DISCH_THEN(fun th -> EXISTS_TAC `2 * (n + 1) + 2 * a * q2 - q1` THEN MP_TAC th) THEN UNDISCH_TAC `~(a = 1)` THEN UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`b:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[ARITH_RULE `(SUC n = 1) <=> (n = 0)`] THEN DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `SUC n - 1 = n`] THEN DISCH_TAC THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; RIGHT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `v <= u /\ y <= x /\ (u + y = z + x + w + v) ==> (u - v = (z + (x - y)) + w:num)`) THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[MULT_ASSOC] THEN MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[ARITH_RULE `q1 + n <= q2 + n + 1 <=> q1 <= q2 + 1`] THEN REWRITE_TAC[MULT_CLAUSES] THEN ARITH_TAC; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `q2 * b + 1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `a + 1 <= b <=> a < b`] THEN ASM_SIMP_TAC[LT_MULT_RCANCEL] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[MULT_ASSOC] THEN ASM_SIMP_TAC[LT_MULT_RCANCEL] THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ARITH_TAC; REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ARITH_TAC]);; let X_CONGRUENT = prove (`!a b c n. ~(a = 0) ==> ?q. X (a + b * c) n = X a n + q * c`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN ASM_CASES_TAC `b * c = 0` THENL [GEN_TAC THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN UNDISCH_TAC `~(b * c = 0)` THEN REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[X_CLAUSES] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; EXISTS_TAC `b:num` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `2 * (x + y) * (u + v) = 2 * x * u + 2 * u * y + 2 * (x + y) * v`] THEN EXISTS_TAC `(2 * X a (n + 1) * b + 2 * (a + b * c) * q2) - q1` THEN MATCH_MP_TAC(ARITH_RULE `a <= x /\ b <= y + z:num /\ ((x - a) + ((y + z) - b) = u) ==> ((x + y + z) - (a + b) = u)`) THEN REWRITE_TAC[RIGHT_SUB_DISTRIB; RIGHT_ADD_DISTRIB; GSYM MULT_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `1 * X a (n + 1)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[MULT_CLAUSES; X_INCREASES]; ALL_TAC] THEN REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `X (a + b * c) n` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `X (a + b * c) (n + 1)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[X_INCREASES; ADD_EQ_0]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN REWRITE_TAC[GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]; MATCH_MP_TAC(ARITH_RULE `a <= y ==> a <= 2 * (x + y)`) THEN ONCE_REWRITE_TAC[AC MULT_AC `a * b * c * d = (a * b) * (c * d:num)`] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]]);; let Y_CONGRUENT = prove (`!a b c n. ~(a = 0) ==> ?q. Y (a + b * c) n = Y a n + q * c`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN ASM_CASES_TAC `b * c = 0` THENL [GEN_TAC THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN UNDISCH_TAC `~(b * c = 0)` THEN REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[Y_CLAUSES] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `2 * (x + y) * (u + v) = 2 * x * u + 2 * u * y + 2 * (x + y) * v`] THEN EXISTS_TAC `(2 * Y a (n + 1) * b + 2 * (a + b * c) * q2) - q1` THEN MATCH_MP_TAC(ARITH_RULE `a <= x /\ b <= y + z:num /\ ((x - a) + ((y + z) - b) = u) ==> ((x + y + z) - (a + b) = u)`) THEN REWRITE_TAC[RIGHT_SUB_DISTRIB; RIGHT_ADD_DISTRIB; GSYM MULT_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `1 * Y a (n + 1)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[MULT_CLAUSES; Y_INCREASES]; ALL_TAC] THEN REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `Y (a + b * c) n` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `Y (a + b * c) (n + 1)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[Y_INCREASES; ADD_EQ_0]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN REWRITE_TAC[GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]; MATCH_MP_TAC(ARITH_RULE `a <= y ==> a <= 2 * (x + y)`) THEN ONCE_REWRITE_TAC[AC MULT_AC `a * b * c * d = (a * b) * (c * d:num)`] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]]);; (* ------------------------------------------------------------------------- *) (* A more important congruence. *) (* ------------------------------------------------------------------------- *) let X_CONGRUENT_2NJ_POS = prove (`!a n j. ~(a = 0) ==> ?q. X a (2 * n + j) + X a j = q * X a n`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `n:num`; `n + j:num`] ADDITION_FORMULA_POS) THEN ASM_REWRITE_TAC[ARITH_RULE `n + n + j = 2 * n + j`] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT1) THEN MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] ADDITION_FORMULA_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN ONCE_REWRITE_TAC[ARITH_RULE `(xn * a + d * yn * (xn * yj + xj * yn)) + xj = xn * (a + d * yn * yj) + xj * (d * yn * yn + 1)`] THEN ASM_SIMP_TAC[GSYM XY_ARE_SOLUTIONS; GSYM EXP_2] THEN REWRITE_TAC[EXP_2; ARITH_RULE `xn * a + xj * xn * xn = (a + xj * xn) * xn:num`] THEN MESON_TAC[]);; let X_CONGRUENT_4NJ_POS = prove (`!a n j. ~(a = 0) ==> ?q. X a (4 * n + j) = q * X a n + X a j`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `n:num`; `2 * n + j`] X_CONGRUENT_2NJ_POS) THEN ASM_REWRITE_TAC[ARITH_RULE `2 * n + 2 * n + j = 4 * n + j`] THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN DISCH_THEN(MP_TAC o C AP_THM `X a j` o AP_TERM `(+):num->num->num`) THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] X_CONGRUENT_2NJ_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q2:num` MP_TAC) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(y + q2 = q1 + x) ==> x <= y ==> (y = (q1 - q2) + x:num)`)) THEN ASM_SIMP_TAC[X_INCREASES_LE; ARITH_RULE `j <= 4 * n + j`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN MESON_TAC[]);; let X_CONGRUENT_4MNJ_POS = prove (`!a m n j. ~(a = 0) ==> ?q. X a (4 * m * n + j) = q * X a n + X a j`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THENL [REPEAT GEN_TAC THEN EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN UNDISCH_TAC `!n j. ?q. X a (4 * m * n + j) = q * X a n + X a j` THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` ASSUME_TAC) THEN MP_TAC(SPECL [`a:num`; `n:num`; `4 * m * n + j`] X_CONGRUENT_4NJ_POS) THEN ASM_REWRITE_TAC[ARITH_RULE `4 * (m * n + n) + j = 4 * n + 4 * m * n + j`] THEN DISCH_THEN(X_CHOOSE_THEN `q2:num` SUBST1_TAC) THEN EXISTS_TAC `q2 + q1:num` THEN ARITH_TAC);; let X_CONGRUENT_2NJ_NEG_LEMMA = prove (`!a n j. ~(a = 0) /\ j <= n ==> ?q. X a (2 * n - j) + X a j = q * X a n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `j = n:num` THENL [EXISTS_TAC `2` THEN ASM_REWRITE_TAC[MULT_2; ADD_SUB]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `n:num`; `n - j:num`] ADDITION_FORMULA_POS) THEN ASM_SIMP_TAC[ARITH_RULE `j <= n ==> (n + n - j = 2 * n - j)`] THEN STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `j:num`; `n:num`] ADDITION_FORMULA_NEG) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(X a j * X a n - (a EXP 2 - 1) * Y a j * Y a n) + (X a j * X a n - (a EXP 2 - 1) * Y a j * Y a n)` THEN REWRITE_TAC[ARITH_RULE `((xn * a + b) + c = (a + d) * xn) <=> (b + c = xn * d:num)`] THEN REWRITE_TAC[LEFT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `b <= a /\ e <= d /\ (e + a + c = d + b) ==> ((a - b) + c = d - e:num)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[LE_MULT_LCANCEL] THEN REPEAT DISJ2_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `(c = a - b) ==> 1 <= c ==> b <= a`)) THEN SUBST1_TAC(SYM(SPEC `a:num` (el 1 (CONJUNCTS Y_CLAUSES)))) THEN MATCH_MP_TAC Y_INCREASES_LE THEN ASM_SIMP_TAC[ARITH_RULE `j <= n ==> (1 <= n - j <=> ~(j = n))`]; REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `(c = a - b) ==> 1 <= c ==> b <= a`)) THEN SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 X_CLAUSES))) THEN MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[LE_0]; REWRITE_TAC[ARITH_RULE `xn * a * yj * yn + a * yn * xj * yn + xj = xj * (a * yn * yn + 1) + a * yn * xn * yj`] THEN ASM_SIMP_TAC[GSYM XY_ARE_SOLUTIONS; GSYM EXP_2] THEN REWRITE_TAC[EXP_2; MULT_AC]]);; let X_CONGRUENT_2NJ_NEG = prove (`!a n j. ~(a = 0) /\ j <= 2 * n ==> ?q. X a (2 * n - j) + X a j = q * X a n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `j <= n:num` THEN ASM_SIMP_TAC[X_CONGRUENT_2NJ_NEG_LEMMA] THEN MP_TAC(SPECL [`a:num`; `n:num`; `2 * n - j`] X_CONGRUENT_2NJ_NEG_LEMMA) THEN ASM_SIMP_TAC[ARITH_RULE `~(j <= n) ==> 2 * n - j <= n`] THEN ASM_SIMP_TAC[ARITH_RULE `y <= x ==> (x - (x - y) = y:num)`] THEN SIMP_TAC[ADD_AC]);; (* ------------------------------------------------------------------------- *) (* The cute GCD fact given by Smorynski. *) (* ------------------------------------------------------------------------- *) let XY_GCD_LEMMA = prove (`!a m n. ~(a = 0) /\ m < n ==> (gcd(Y a m,Y a n) = Y a (gcd(m,n)))`, GEN_TAC THEN ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `a = 1` THEN ASM_REWRITE_TAC[Y_DEGENERATE] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MP_TAC(SPECL [`n:num`; `m:num`] DIVISION) THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[Y_CLAUSES; GCD_0] THEN ABBREV_TAC `q = n DIV m` THEN ABBREV_TAC `r = n MOD m` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [EXPAND_TAC "n" THEN ASM_SIMP_TAC[ADDITION_FORMULA_POS] THEN GEN_REWRITE_TAC LAND_CONV [GCD_SYM] THEN MATCH_MP_TAC GCD_EQ THEN X_GEN_TAC `d:num` THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `d divides (X a (q * m) * Y a r)` THEN CONJ_TAC THENL [SUBGOAL_THEN `d divides (Y a (q * m))` MP_TAC THENL [ASM_MESON_TAC[Y_DIVIDES; DIVIDES_TRANS; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN MESON_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL; DIVIDES_ADD_REVL]; ALL_TAC] THEN EQ_TAC THEN SIMP_TAC[DIVIDES_LMUL] THEN SUBGOAL_THEN `coprime(d,X a (q * m))` (fun th -> MESON_TAC[COPRIME_DIVPROD; th]) THEN SUBGOAL_THEN `d divides (Y a (q * m))` MP_TAC THENL [ASM_MESON_TAC[Y_DIVIDES; DIVIDES_TRANS; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `q * m:num`] XY_COPRIME) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[coprime] THEN X_GEN_TAC `e:num` THEN STRIP_TAC THEN UNDISCH_TAC `coprime (X a (q * m),Y a (q * m))` THEN REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `e:num`) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[DIVIDES_TRANS]; AP_TERM_TAC THEN EXPAND_TAC "n" THEN GEN_REWRITE_TAC I [GSYM DIVIDES_ANTISYM] THEN POP_ASSUM_LIST(K ALL_TAC) THEN NUMBER_TAC]);; let XY_GCD = prove (`!a m n. ~(a = 0) ==> (gcd(Y a m,Y a n) = Y a (gcd(m,n)))`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`m:num`; `n:num`] LT_CASES) THENL [ASM_SIMP_TAC[XY_GCD_LEMMA]; ONCE_REWRITE_TAC[GCD_SYM] THEN ASM_SIMP_TAC[XY_GCD_LEMMA]; ASM_REWRITE_TAC[GCD_REFL]]);; (* ------------------------------------------------------------------------- *) (* The "step-down" lemma. *) (* ------------------------------------------------------------------------- *) let STEP_DOWN_LEMMA = prove (`!a i j n q. ~(a = 0) /\ ~(a = 1) /\ i <= j /\ j <= 2 * n /\ (X a j = q * X a n + X a i) ==> (i = j) \/ ((a = 2) /\ (n = 1) /\ (i = 0) /\ (j = 2))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `j <= n:num` THENL [ASM_CASES_TAC `i = j:num` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `i < n:num` ASSUME_TAC THENL [ASM_MESON_TAC[LTE_TRANS; LT_LE]; ALL_TAC] THEN UNDISCH_TAC `X a j = q * X a n + X a i` THEN ASM_CASES_TAC `q = 0` THEN ASM_SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; X_INJ] THEN DISCH_TAC THEN MP_TAC(SPECL [`a:num`; `j:num`; `n:num`] X_INCREASES_LE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN MATCH_MP_TAC(ARITH_RULE `1 <= b /\ 1 * x <= qx ==> ~(qx + b <= x)`) THEN SIMP_TAC[LE_MULT_RCANCEL] THEN ASM_SIMP_TAC[ARITH_RULE `~(x = 0) ==> 1 <= x`] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN ASM_CASES_TAC `n = 0` THENL [UNDISCH_TAC `i <= j:num` THEN UNDISCH_TAC `j <= 2 * n` THEN ASM_SIMP_TAC[LE; MULT_CLAUSES]; ALL_TAC] THEN ASM_CASES_TAC `i <= n:num` THENL [MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] X_CONGRUENT_2NJ_NEG) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN UNDISCH_TAC `X a j = q * X a n + X a i` THEN ASM_CASES_TAC `q = 0` THEN ASM_SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; X_INJ] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a + b + c = d:num) ==> (a + c = d - b)`)) THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN ASM_CASES_TAC `i = n:num` THENL [ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + n = q * n) ==> (x = q * n - 1 * n)`)) THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN ASM_CASES_TAC `q1 - q - 1 = 0` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `j < n /\ 1 * n <= a * n ==> ~(j = a * n)`) THEN ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `~(x = 0) ==> 1 <= x`] THEN MATCH_MP_TAC X_INCREASES_LT THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(j <= n:num)` THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `q1 - q = 0` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0] THEN MATCH_MP_TAC(TAUT `~c ==> a /\ c ==> b`) THEN REWRITE_TAC[ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(~b ==> a ==> c) ==> a ==> b \/ c`) THEN DISCH_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `n = 1` THENL [UNDISCH_TAC `j <= 2 * n` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN UNDISCH_TAC `~(j <= n:num)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `~(j <= 1) /\ j <= 2 ==> (j = 2)`)) THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[] THEN UNDISCH_THEN `n = 1` SUBST_ALL_TAC THEN SUBGOAL_THEN `i = 0` SUBST_ALL_TAC THENL [MAP_EVERY UNDISCH_TAC [`i <= 1`; `~(i = 1)`] THEN ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `X a (2 * 1 - 2) + X a 0 = (q1 - q) * X a 1` THEN REWRITE_TAC[ARITH; X_CLAUSES] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN MATCH_MP_TAC(ARITH_RULE `~(a = 0) /\ ~(a = 1) /\ a <= 2 ==> (a = 2)`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `(q1 - q) * a = 2` (SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_SIMP_TAC[ARITH_RULE `~(q = 0) ==> 1 <= q`]; ALL_TAC] THEN UNDISCH_TAC `X a (2 * n - j) + X a i = (q1 - q) * X a n` THEN MATCH_MP_TAC(TAUT `~b ==> b ==> a`) THEN MATCH_MP_TAC(ARITH_RULE `s < x /\ x <= q * x ==> ~(s = q * x:num)`) THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_SIMP_TAC[ARITH_RULE `~(q = 0) ==> 1 <= q`]] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `2 * X a (n - 1)` THEN CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `a <= c /\ b <= c ==> a + b <= 2 * c`) THEN CONJ_TAC THEN MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[] THENL [UNDISCH_TAC `~(n = 0)` THEN UNDISCH_TAC `~(j <= n:num)` THEN ARITH_TAC; UNDISCH_TAC `~(i = n:num)` THEN UNDISCH_TAC `i <= n:num` THEN ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `n - 1 = (n - 2) + 1` SUBST1_TAC THENL [UNDISCH_TAC `~(n = 0)` THEN UNDISCH_TAC `~(n = 1)` THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `n = (n - 2) + 2` (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [UNDISCH_TAC `~(n = 0)` THEN UNDISCH_TAC `~(n = 1)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[X_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `z < x /\ 3 * x <= y ==> 2 * x < y - z`) THEN ASM_SIMP_TAC[X_INCREASES_LT; ARITH_RULE `n < n + 1`] THEN REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(a = 1)` THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] X_CONGRUENT_2NJ_NEG) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN MP_TAC(SPECL [`a:num`; `n:num`; `i:num`] X_CONGRUENT_2NJ_NEG) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q2:num` MP_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a = b) /\ (c = d) ==> (a + d = b + c:num)`)) THEN REWRITE_TAC[ARITH_RULE `((x + i) + q1 = q2 + y + q3 + i) <=> (x + q1 = y + q2 + q3:num)`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + q1 = y + q2) ==> y <= x ==> (x = y + (q2 - q1:num))`)) THEN ANTS_TAC THENL [MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `i <= j:num` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB; GSYM RIGHT_SUB_DISTRIB] THEN ASM_CASES_TAC `(q2 + q) - q1 = 0` THENL [ASM_SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; X_INJ] THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a ==> b \/ c)`) THEN UNDISCH_TAC `j <= 2 * n` THEN UNDISCH_TAC `i <= j:num` THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN MATCH_MP_TAC(ARITH_RULE `1 * xi <= qxn /\ 1 <= xj ==> ~(xi = xj + qxn)`) THEN CONJ_TAC THENL [MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(i <= n:num)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[LE_0]);; let STEP_DOWN_LEMMA_4_ASYM = prove (`!a i j n q. ~(a = 0) /\ ~(a = 1) /\ 0 < i /\ i <= n /\ j < 4 * n /\ (X a i + q * X a n = X a j) ==> (j = i) \/ (j = 4 * n - i)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `j <= 2 * n` THENL [MP_TAC(SPECL [`a:num`; `i:num`; `j:num`; `n:num`; `q:num`] STEP_DOWN_LEMMA) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `X a i + q * X a n = X a j` THEN SIMP_TAC[ADD_AC; MULT_AC] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN SUBGOAL_THEN `X a i <= X a j` MP_TAC THENL [ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN ASM_SIMP_TAC[X_INCREASES_LT; NOT_LE]; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `0 < i ==> ~(i = 0)`]; ALL_TAC] THEN DISJ_CASES_TAC(SPECL [`i:num`; `4 * n - j`] LE_CASES) THEN (MP_TAC(SPECL [`a:num`; `n:num`; `2 * n - (4 * n - j)`] X_CONGRUENT_2NJ_POS) THEN MP_TAC(SPECL [`a:num`; `n:num`; `4 * n - j`] X_CONGRUENT_2NJ_NEG) THEN ASM_SIMP_TAC[ARITH_RULE `~(j <= 2 * n) ==> 4 * n - j <= 2 * n`] THEN ASM_SIMP_TAC[ARITH_RULE `j < 4 * n /\ ~(j <= 2 * n) ==> (2 * n + 2 * n - (4 * n - j) = j)`] THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `q2:num` MP_TAC) THEN SUBST1_TAC(SYM(ASSUME `X a i + q * X a n = X a j`)) THEN UNDISCH_TAC `X a (2 * n - (4 * n - j)) + X a (4 * n - j) = q1 * X a n` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a + b = c) /\ (d + a = e) ==> (b + e = c + d:num)`))) THENL [DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + q1 = q2 + y + q3) ==> y <= x ==> (x = ((q2 + q3) - q1) + y:num)`)); DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + q1 = q2 + y + q3) ==> x <= y ==> (y = (q1 - (q2 + q3)) + x:num)`))] THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; GSYM RIGHT_ADD_DISTRIB] THEN ASM_SIMP_TAC[X_INCREASES_LE] THEN DISCH_TAC THENL [MP_TAC(SPECL [`a:num`; `i:num`; `4 * n - j`; `n:num`; `(q1 + q) - q2:num`] STEP_DOWN_LEMMA) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(j <= 2 * n)` THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `0 < i ==> ~(i = 0)`] THEN DISCH_TAC THEN DISJ2_TAC THEN UNDISCH_TAC `j < 4 * n` THEN ARITH_TAC; MP_TAC(SPECL [`a:num`; `4 * n - j`; `i:num`; `n:num`; `q2:num - (q1 + q)`] STEP_DOWN_LEMMA) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `i <= n:num` THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[SUB_EQ_0; GSYM NOT_LT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISJ2_TAC THEN UNDISCH_TAC `j < 4 * n` THEN ARITH_TAC]);; let STEP_DOWN_LEMMA_4 = prove (`!a i j n q1 q2. ~(a = 0) /\ ~(a = 1) /\ 0 < i /\ i <= n /\ j < 4 * n /\ (X a i + q1 * X a n = X a j + q2 * X a n) ==> (j = i) \/ (j = 4 * n - i)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `j < i:num` THENL [UNDISCH_TAC `X a i + q1 * X a n = X a j + q2 * X a n` THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + q1 = y + q2) ==> y < x ==> (x = y + (q2 - q1:num))`)) THEN ASM_SIMP_TAC[X_INCREASES_LT; GSYM RIGHT_SUB_DISTRIB] THEN ASM_CASES_TAC `q2 - q1 = 0` THENL [ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; X_INJ]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(i = j + q * n) ==> 1 <= j /\ 1 * n <= q * n ==> ~(i <= n)`)) THEN ASM_SIMP_TAC[X_INCREASES_LE] THEN ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `~(q2 - q1 = 0) ==> 1 <= q2 - q1`] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `i:num`; `j:num`; `n:num`; `q1 - q2:num`] STEP_DOWN_LEMMA_4_ASYM) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `(i + q1 = j + q2) /\ ~(j < i) ==> (i + q1 - q2 = j:num)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN ASM_SIMP_TAC[NOT_LT; X_INCREASES_LE]);; let STEP_DOWN_LEMMA_STRONG_ASYM = prove (`!a i j n c. ~(a = 0) /\ ~(a = 1) /\ 0 < i /\ i <= n /\ (X a i + c * X a n = X a j) ==> (?q. j = i + 4 * n * q) \/ (?q. j + i = 4 * n * q)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`j:num`; `4 * n`] DIVISION) THEN ABBREV_TAC `q = j DIV (4 * n)` THEN ABBREV_TAC `k = j MOD (4 * n)` THEN ANTS_TAC THENL [UNDISCH_TAC `0 < i` THEN UNDISCH_TAC `i <= n:num` THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MP_TAC(SPECL [`a:num`; `q:num`; `n:num`; `k:num`] X_CONGRUENT_4MNJ_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN SUBST1_TAC(ARITH_RULE `4 * q * n + k = q * 4 * n + k`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_CASES_TAC `k < i:num` THENL [UNDISCH_TAC `X a i + c * X a n = q1 * X a n + X a k` THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a + q1 = q2 + b) ==> b < a ==> (a = (q2 - q1) + b:num)`)) THEN ASM_SIMP_TAC[X_INCREASES_LT] THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN ASM_CASES_TAC `q1 - c = 0` THENL [ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; X_INJ] THEN DISCH_TAC THEN DISJ1_TAC THEN EXISTS_TAC `q:num` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN REWRITE_TAC[ADD_AC; MULT_AC]; MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN MATCH_MP_TAC(ARITH_RULE `a <= b /\ 1 <= c ==> ~(a = b + c)`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM_SIMP_TAC[X_INCREASES_LE; LT_IMP_LE]; SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 X_CLAUSES))) THEN ASM_SIMP_TAC[X_INCREASES_LE; LE_0]]]; MP_TAC(SPECL [`a:num`; `i:num`; `k:num`; `n:num`; `c - q1:num`] STEP_DOWN_LEMMA_4_ASYM) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `X a i + c * X a n = q1 * X a n + X a k` THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a + q1 = q2 + b) ==> ~(b < a) ==> (a + (q1 - q2)= b:num)`)) THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[NOT_LT] THEN MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[GSYM NOT_LT]; ALL_TAC] THEN DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC THEN EXISTS_TAC `q:num` THEN UNDISCH_THEN `q * 4 * n + k = j` (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[MULT_AC; ADD_AC]; DISJ2_TAC THEN EXISTS_TAC `q + 1` THEN UNDISCH_THEN `q * 4 * n + k = j` (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM ADD_ASSOC; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE `(a' = a) /\ i <= b ==> (a + (b - i) + i = a' + b:num)`) THEN REWRITE_TAC[MULT_AC] THEN UNDISCH_TAC `i <= n:num` THEN ARITH_TAC]]);; let STEP_DOWN_LEMMA_STRONG = prove (`!a i j n c1 c2. ~(a = 0) /\ ~(a = 1) /\ 0 < i /\ i <= n /\ (X a i + c1 * X a n = X a j + c2 * X a n) ==> (?q. j = i + 4 * n * q) \/ (?q. j + i = 4 * n * q)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `j < i:num` THENL [UNDISCH_TAC `X a i + c1 * X a n = X a j + c2 * X a n` THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + q1 = y + q2) ==> y < x ==> (x = y + (q2 - q1:num))`)) THEN ASM_SIMP_TAC[X_INCREASES_LT; GSYM RIGHT_SUB_DISTRIB] THEN ASM_CASES_TAC `c2 - c1 = 0` THENL [ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; X_INJ] THEN DISCH_THEN(K ALL_TAC) THEN DISJ1_TAC THEN EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(i = j + q * n) ==> 1 <= j /\ 1 * n <= q * n ==> ~(i <= n)`)) THEN ASM_SIMP_TAC[X_INCREASES_LE] THEN ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `~(q2 - q1 = 0) ==> 1 <= q2 - q1`] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `i:num`; `j:num`; `n:num`; `c1 - c2:num`] STEP_DOWN_LEMMA_STRONG_ASYM) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `(i + q1 = j + q2) /\ ~(j < i) ==> (i + q1 - q2 = j:num)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN ASM_SIMP_TAC[NOT_LT; X_INCREASES_LE]);; (* ------------------------------------------------------------------------- *) (* Diophantine nature of the Y sequence. *) (* ------------------------------------------------------------------------- *) let Y_DIOPH = prove (`~(a = 0) /\ ~(a = 1) /\ ~(y = 0) ==> ((y = Y a k) <=> ?x u v r b p q s t c d. 0 < r /\ (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) /\ (u EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1) /\ (s EXP 2 = (b EXP 2 - 1) * t EXP 2 + 1) /\ (v = r * y EXP 2) /\ (b = 1 + 4 * p * y) /\ (b = a + q * u) /\ (s = x + c * u) /\ (t = k + 4 * d * y) /\ k <= y)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MP_TAC(SPECL [`a:num`; `x:num`; `y:num`] SOLUTIONS_ARE_XY) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `i:num` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(SPECL [`a:num`; `u:num`; `v:num`] SOLUTIONS_ARE_XY) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `~(b = 0)` ASSUME_TAC THENL [SUBST1_TAC(SYM(ASSUME `1 + 4 * p * y = b`)) THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN MP_TAC(SPECL [`b:num`; `s:num`; `t:num`] SOLUTIONS_ARE_XY) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `j:num` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `y <= v:num` ASSUME_TAC THENL [SUBST1_TAC(SYM(ASSUME `r * y EXP 2 = v`)) THEN REWRITE_TAC[EXP_2] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `y = 1 * y`] THEN REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= a <=> ~(a = 0)`; MULT_EQ_0] THEN ASM_SIMP_TAC[ARITH_RULE `0 < r ==> ~(r = 0)`]; ALL_TAC] THEN SUBGOAL_THEN `i <= n:num` ASSUME_TAC THENL [UNDISCH_TAC `y <= v:num` THEN SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN SUBST1_TAC(SYM(ASSUME `Y a n = v`)) THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN ASM_SIMP_TAC[NOT_LE; Y_INCREASES_LT]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `q:num`; `u:num`; `j:num`] X_CONGRUENT) THEN REWRITE_TAC[ASSUME `~(a = 0)`; ASSUME `a + q * u = b:num`] THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN SUBST1_TAC(ASSUME `X b j = s`) THEN SUBST1_TAC(SYM(ASSUME `x + c * u = s:num`)) THEN SUBST1_TAC(SYM(ASSUME `X a i = x`)) THEN SUBST1_TAC(SYM(ASSUME `X a n = u`)) THEN DISCH_TAC THEN SUBGOAL_THEN `~(i = 0)` ASSUME_TAC THENL [UNDISCH_TAC `~(y = 0)` THEN REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN EXPAND_TAC "y" THEN SIMP_TAC[Y_CLAUSES; ASSUME `~(a = 0)`]; ALL_TAC] THEN SUBGOAL_THEN `(?q. j = i + 4 * n * q) \/ (?q. j + i = 4 * n * q)` ASSUME_TAC THENL [MATCH_MP_TAC STEP_DOWN_LEMMA_STRONG THEN MAP_EVERY EXISTS_TAC [`a:num`; `c:num`; `q1:num`] THEN ASM_SIMP_TAC[ARITH_RULE `~(i = 0) ==> 0 < i`]; ALL_TAC] THEN MP_TAC(SPECL [`a:num`; `i:num`; `n:num`] Y2_DIVIDES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `r:num`) THEN SUBST1_TAC(SYM(ASSUME `r * y EXP 2 = v`)) THEN REWRITE_TAC[EQT_INTRO(SPEC_ALL MULT_SYM)] THEN DISCH_THEN(X_CHOOSE_THEN `d1:num` (ASSUME_TAC o SYM)) THEN UNDISCH_TAC `(?q. j = i + 4 * n * q) \/ (?q. j + i = 4 * n * q:num)` THEN UNDISCH_THEN `(i * y) * d1 = n:num` (SUBST1_TAC o SYM) THEN DISCH_TAC THEN SUBGOAL_THEN `(?q. j = i + q * 4 * Y a i) \/ (?q. j + i = q * 4 * Y a i)` MP_TAC THENL [FIRST_ASSUM(UNDISCH_TAC o check is_disj o concl) THEN REWRITE_TAC[OR_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d2:num` (fun th -> EXISTS_TAC `i * d1 * d2:num` THEN MP_TAC th)) THEN SUBST1_TAC(ASSUME `Y a i = y`) THEN REWRITE_TAC[MULT_AC]; FIRST_X_ASSUM(K ALL_TAC o check (is_disj o concl)) THEN DISCH_TAC] THEN MP_TAC(SPECL [`b:num`; `j:num`] Y_N_MODA1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d3:num` MP_TAC) THEN SUBST1_TAC(SYM(ASSUME `1 + 4 * p * y = b`)) THEN REWRITE_TAC[ADD_SUB2] THEN SUBST1_TAC(SYM(ASSUME `k + 4 * d * y = t`)) THEN DISCH_TAC THEN SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN AP_TERM_TAC THEN SUBGOAL_THEN `(?q1 q2. k + q1 * 4 * Y a i = i + q2 * 4 * Y a i) \/ (?q. i + k = q * 4 * Y a i)` MP_TAC THENL [UNDISCH_TAC `(?q. j = i + q * 4 * Y a i) \/ (?q. j + i = q * 4 * Y a i)` THEN MATCH_MP_TAC(TAUT `(a1 ==> b1) /\ (a2 ==> b2) ==> a1 \/ a2 ==> b1 \/ b2`) THEN CONJ_TAC THEN DISCH_TAC THEN UNDISCH_TAC `k + 4 * d * y = d3 * 4 * p * y + j` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `d4:num` SUBST1_TAC) THEN DISCH_THEN(fun th -> EXISTS_TAC `d:num` THEN EXISTS_TAC `d3 * p + d4:num` THEN MP_TAC th) THEN SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]; DISCH_THEN(MP_TAC o C AP_THM `i:num` o AP_TERM `(+):num->num->num`) THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d4:num` SUBST1_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(k + q1 + i = q2) ==> (i + k = q2 - q1:num)`)) THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB; MULT_ASSOC; GSYM RIGHT_SUB_DISTRIB] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN REWRITE_TAC[ARITH_RULE `(d3 * 4 * p + d4 * 4) - 4 * x = ((d3 * p + d4) - x) * 4`] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN EXISTS_TAC `(d3 * p + d4) - d:num` THEN REFL_TAC]; ALL_TAC] THEN SUBGOAL_THEN `k <= Y a i` ASSUME_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `i <= Y a i` ASSUME_TAC THENL [MP_TAC(SPECL [`a:num`; `i:num`] Y_N_MODA1) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_THEN(X_CHOOSE_THEN `q4:num` (X_CHOOSE_THEN `q5:num` MP_TAC)) THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`q4:num`; `q5:num`] LT_CASES) THENL [DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(k + q4 = i + q5) ==> q4 < q5:num ==> (k = i + (q5 - q4))`)) THEN REWRITE_TAC[MULT_ASSOC; LT_MULT_RCANCEL; GSYM RIGHT_SUB_DISTRIB] THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN UNDISCH_TAC `k <= y:num` THEN MATCH_MP_TAC(TAUT `(a ==> ~b) ==> b ==> a ==> c`) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(ARITH_RULE `1 * y < k * y ==> ~(i + k * y <= y)`) THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN UNDISCH_TAC `q4 < q5:num` THEN ARITH_TAC; DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(k + q4 = i + q5) ==> q5 < q4:num ==> (i = k + (q4 - q5))`)) THEN REWRITE_TAC[MULT_ASSOC; LT_MULT_RCANCEL; GSYM RIGHT_SUB_DISTRIB] THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN UNDISCH_TAC `i <= Y a i` THEN MATCH_MP_TAC(TAUT `(a ==> ~b) ==> b ==> a ==> c`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(ARITH_RULE `1 * y < k * y ==> ~(i + k * y <= y)`) THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN UNDISCH_TAC `q5 < q4:num` THEN ARITH_TAC; ASM_SIMP_TAC[EQ_ADD_RCANCEL]]; DISCH_THEN(X_CHOOSE_THEN `q6:num` MP_TAC) THEN ASM_CASES_TAC `q6 = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0] THEN UNDISCH_TAC `k <= Y a i` THEN UNDISCH_TAC `i <= Y a i` THEN SUBST1_TAC(ASSUME `Y a i = y`) THEN MATCH_MP_TAC(ARITH_RULE `2 * y < ay ==> i <= y ==> k <= y ==> (i + k = ay) ==> (i = k)`) THEN REWRITE_TAC[MULT_ASSOC; LT_MULT_RCANCEL] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(q6 = 0)` THEN ARITH_TAC]] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN ABBREV_TAC `x = X a k` THEN SUBGOAL_THEN `x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1` (ASSUME_TAC o SYM) THENL [MAP_EVERY EXPAND_TAC ["x"; "y"] THEN SIMP_TAC[XY_ARE_SOLUTIONS; ASSUME `~(a = 0)`]; ALL_TAC] THEN EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `m = 2 * k * Y a k` THEN ABBREV_TAC `u = X a m` THEN ABBREV_TAC `v = Y a m` THEN SUBGOAL_THEN `u EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1` (ASSUME_TAC o SYM) THENL [MAP_EVERY EXPAND_TAC ["u"; "v"] THEN SIMP_TAC[XY_ARE_SOLUTIONS; ASSUME `~(a = 0)`]; ALL_TAC] THEN EXISTS_TAC `u:num` THEN EXISTS_TAC `v:num` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(y EXP 2) divides v` MP_TAC THENL [SUBST1_TAC(SYM(ASSUME `Y a m = v`)) THEN SUBST1_TAC(SYM(ASSUME `Y a k = y`)) THEN SIMP_TAC[Y2_DIVIDES; ASSUME `~(a = 0)`] THEN SUBST1_TAC(SYM(ASSUME `2 * k * Y a k = m`)) THEN REWRITE_TAC[divides] THEN EXISTS_TAC `2` THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` (ASSUME_TAC o SYM)) THEN EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `r = 0` THENL [UNDISCH_TAC `y EXP 2 * r = v` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN REWRITE_TAC[LT_REFL] THEN UNDISCH_TAC `Y a m = v` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `m = 0` ASSUME_TAC THENL [UNDISCH_TAC `Y a m = 0` THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 Y_CLAUSES)] THEN SIMP_TAC[Y_INJ; ASSUME `~(a = 0)`] THEN REWRITE_TAC[Y_CLAUSES]; ALL_TAC] THEN SUBGOAL_THEN `k = 0` ASSUME_TAC THENL [UNDISCH_TAC `2 * k * Y a k = m` THEN REWRITE_TAC[ASSUME `m = 0`; MULT_EQ_0; ARITH_EQ] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 Y_CLAUSES)] THEN SIMP_TAC[Y_INJ; ASSUME `~(a = 0)`] THEN REWRITE_TAC[Y_CLAUSES; EQ_SYM]; ALL_TAC] THEN UNDISCH_TAC `Y a k = y` THEN ASM_REWRITE_TAC[Y_CLAUSES]; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `~(r = 0) ==> 0 < r`] THEN SUBGOAL_THEN `ODD(u)` ASSUME_TAC THENL [UNDISCH_TAC `(a EXP 2 - 1) * v EXP 2 + 1 = u EXP 2` THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EXP_2; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN SUBGOAL_THEN `EVEN v` (fun th -> REWRITE_TAC[GSYM NOT_EVEN; th]) THEN SUBST1_TAC(SYM(ASSUME `Y a m = v`)) THEN MP_TAC(SPECL [`a:num`; `m:num`] Y_N_MOD2) THEN SIMP_TAC[ASSUME `~(a = 0)`; LEFT_IMP_EXISTS_THM] THEN SUBST1_TAC(SYM(ASSUME `2 * k * Y a k = m`)) THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN]; ALL_TAC] THEN SUBGOAL_THEN `?b0 q6 q7. (b0 = 1 + q6 * 4 * y) /\ (b0 = a + q7 * u)` MP_TAC THENL [MATCH_MP_TAC CHINESE_REMAINDER THEN UNDISCH_TAC `ODD u` THEN ASM_CASES_TAC `u = 0` THEN ASM_REWRITE_TAC[ARITH_ODD] THEN DISCH_TAC THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_MUL THEN CONJ_TAC THENL [SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN MATCH_MP_TAC COPRIME_MUL THEN REWRITE_TAC[] THEN MP_TAC(SPECL [`u:num`; `2`] PRIME_COPRIME) THEN REWRITE_TAC[PRIME_2] THEN MATCH_MP_TAC(TAUT `~b /\ (a ==> d) /\ (c ==> d) ==> a \/ b \/ c ==> d`) THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `ODD u` THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN SIMP_TAC[divides; LEFT_IMP_EXISTS_THM; ODD_MULT; ARITH_ODD]; ONCE_REWRITE_TAC[COPRIME_SYM] THEN SIMP_TAC[COPRIME_1]; REWRITE_TAC[COPRIME_SYM]]; MP_TAC(SPECL [`a:num`; `m:num`] XY_COPRIME) THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(ASSUME `y EXP 2 * r = v`)) THEN REWRITE_TAC[coprime; EXP_2] THEN MESON_TAC[DIVIDES_RMUL; DIVIDES_LMUL]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `b:num` (X_CHOOSE_THEN `p:num` (X_CHOOSE_THEN `q:num` (STRIP_ASSUME_TAC o GSYM)))) THEN MAP_EVERY EXISTS_TAC [`b:num`; `p:num`; `q:num`] THEN ONCE_REWRITE_TAC[ARITH_RULE `1 + 4 * p * y = 1 + p * 4 * y`] THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `s = X b k` THEN ABBREV_TAC `t = Y b k` THEN EXISTS_TAC `s:num` THEN EXISTS_TAC `t:num` THEN SUBST1_TAC(ARITH_RULE `r * y EXP 2 = y EXP 2 * r`) THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(ASSUME `X b k = s`)) THEN SUBST1_TAC(SYM(ASSUME `Y b k = t`)) THEN SUBGOAL_THEN `~(b = 0)` ASSUME_TAC THENL [UNDISCH_THEN `1 + p * 4 * y = b` (SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[TAUT `~b ==> a ==> b ==> ~a`] THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN SIMP_TAC[XY_ARE_SOLUTIONS; ASSUME `~(b = 0)`] THEN MP_TAC(SPECL [`a:num`; `q:num`; `u:num`; `k:num`] X_CONGRUENT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:num` (ASSUME_TAC o SYM)) THEN EXISTS_TAC `c:num` THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPECL [`b:num`; `k:num`] Y_N_MODA1) THEN SUBST1_TAC(SYM(ASSUME `1 + p * 4 * y = b`)) THEN REWRITE_TAC[ADD_EQ_0; ADD_SUB2; ARITH_EQ] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q8:num` SUBST1_TAC) THEN EXISTS_TAC `q8 * p:num` THEN REWRITE_TAC[MULT_AC; ADD_AC] THEN MP_TAC(SPECL [`a:num`; `k:num`] Y_N_MODA1) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]);; (* ------------------------------------------------------------------------- *) (* A ratio approaches a^n for large enough k. *) (* ------------------------------------------------------------------------- *) let BINOMIALISH_LEMMA = prove (`!m n. m EXP n * (m - n) <= m * (m - 1) EXP n`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; SUB_0; MULT_CLAUSES; LE_REFL] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(m - 1) * m EXP n * (m - n)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MULT_ASSOC] THEN ONCE_REWRITE_TAC[AC MULT_AC `a * b * c = b * a * c:num`] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN REWRITE_TAC[LEFT_SUB_DISTRIB; RIGHT_SUB_DISTRIB; MULT_CLAUSES] THEN ONCE_REWRITE_TAC[ARITH_RULE `a - (b + c) = a - c - b:num`] THEN MATCH_MP_TAC(ARITH_RULE `c <= b ==> a - b <= a - c:num`) THEN ARITH_TAC; GEN_REWRITE_TAC RAND_CONV [AC MULT_AC `m * (m - 1) * n = (m - 1) * m * n`] THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]]);; let XY_EXP_LEMMA = prove (`!a k n. ~(a = 0) /\ 2 * n * a EXP n < k ==> abs(&(Y (a * k) (n + 1)) / &(Y k (n + 1)) - &a pow n) < &1 / &2`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(k = 0)` ASSUME_TAC THENL [FIRST_ASSUM(ACCEPT_TAC o MATCH_MP (ARITH_RULE `a < k ==> ~(k = 0)`)); ALL_TAC] THEN SUBGOAL_THEN `0 < Y k (n + 1)` ASSUME_TAC THENL [SUBST1_TAC(SYM(SPEC `k:num` (CONJUNCT1 Y_CLAUSES))) THEN ASM_SIMP_TAC[Y_INCREASES_LT; ARITH_RULE `0 < n + 1`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&(Y k (n + 1)))` THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN ASM_SIMP_TAC[REAL_ABS_NUM; REAL_LT_IMP_NZ; REAL_OF_NUM_LT; REAL_DIV_LMUL] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div; REAL_OF_NUM_LT; ARITH; REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `!lx ly ux uy. lx <= x /\ x <= ux /\ ly <= y /\ y <= uy /\ &2 * uy < &2 * lx + d /\ &2 * ux < &2 * ly + d ==> abs(x - y) * &2 < d`) THEN MAP_EVERY EXISTS_TAC [`&((2 * a * k - 1) EXP n)`; `&((2 * k - 1) EXP n) * &a pow n`; `&((2 * a * k) EXP n)`; `&((2 * k) EXP n) * &a pow n`] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; Y_LOWERBOUND; Y_UPPERBOUND; REAL_LE_RMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH_RULE `~(a = 0) ==> 0 < a`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN MATCH_MP_TAC(ARITH_RULE `!x:num. x <= c /\ a < b + x /\ d < e + x ==> a < b + c /\ d < e + c`) THEN EXISTS_TAC `(2 * k - 1) EXP n` THEN REWRITE_TAC[Y_LOWERBOUND] THEN REWRITE_TAC[GSYM MULT_EXP; GSYM MULT_ASSOC] THEN REWRITE_TAC[RIGHT_SUB_DISTRIB; GSYM MULT_ASSOC] THEN SUBST1_TAC(AC MULT_AC `2 * k * a = 2 * a * k`) THEN REWRITE_TAC[MULT_CLAUSES] THEN MATCH_MP_TAC(ARITH_RULE `b' <= b /\ a < b' + c ==> a < b + c /\ a < b' + c:num`) THEN CONJ_TAC THENL [REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN SPEC_TAC(`n:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 EXP; LE_REFL] THEN REWRITE_TAC[EXP_MONO_LE_SUC] THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN SUBST1_TAC(AC MULT_AC `2 * a * k = 2 * k * a`) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) [ARITH_RULE `a = 1 * a`] THEN REWRITE_TAC[MULT_ASSOC; GSYM RIGHT_SUB_DISTRIB] THEN REWRITE_TAC[MULT_EXP] THEN REWRITE_TAC[ARITH_RULE `2 * e * a + e = (2 * a + 1) * e`] THEN REWRITE_TAC[GSYM MULT_EXP; GSYM MULT_ASSOC] THEN SUBST1_TAC(AC MULT_AC `2 * k * a = a * 2 * k`) THEN ONCE_REWRITE_TAC[MULT_EXP] THEN REWRITE_TAC[MULT_ASSOC] THEN SUBGOAL_THEN `(2 * k) * (2 * a EXP n) * (2 * k) EXP n < (2 * k) * (2 * a EXP n + 1) * (2 * k - 1) EXP n` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[LT_MULT_LCANCEL; MULT_EQ_0; ARITH_EQ]] THEN GEN_REWRITE_TAC RAND_CONV [AC MULT_AC `(2 * k) * l * m = l * (2 * k) * m`] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `(2 * a EXP n + 1) * (2 * k) EXP n * (2 * k - n)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[LE_MULT_LCANCEL; BINOMIALISH_LEMMA]] THEN REWRITE_TAC[ARITH_RULE `(2 * k) * (2 * an) * 2kn < a2na * 2kn * kmn <=> 2kn * 4 * k * an < 2kn * a2na * kmn`] THEN ASM_SIMP_TAC[LT_MULT_LCANCEL; EXP_EQ_0; MULT_EQ_0; ARITH_EQ] THEN REWRITE_TAC[LEFT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `a + b < c ==> a < c - b:num`) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN REWRITE_TAC[ARITH_RULE `4 * k * an + x < 2 * an * 2 * k + y <=> x < y`] THEN ONCE_REWRITE_TAC[AC MULT_AC `2 * a * n = 2 * n * a`] THEN UNDISCH_TAC `2 * n * a EXP n < k` THEN MATCH_MP_TAC(ARITH_RULE `n * 1 <= x ==> 2 * x < k ==> 2 * x + n < 2 * k`) THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM_REWRITE_TAC[EXP_EQ_0]);; let ABS_LT_REPRESENTATION = prove (`!x y z. ~(y = 0) ==> (abs(&x / &y - &z) < &1 / &2 <=> 4 * x EXP 2 + 4 * (y * z) EXP 2 < 8 * x * y * z + y EXP 2)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&4 * (&x / &y - &z) pow 2 < &1` THEN CONJ_TAC THENL [SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&2 * &2`)) THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_POW_MUL] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN EQ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM(REAL_RAT_REDUCE_CONV `&1 pow 2`)] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN SIMP_TAC[ARITH_EQ; REAL_POW_LT2; REAL_LE_MUL; REAL_POS; REAL_ABS_POS]; ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN REWRITE_TAC[REAL_NOT_LT] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM(REAL_RAT_REDUCE_CONV `&1 pow 2`)] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN SIMP_TAC[ARITH_EQ; REAL_POW_LE2; REAL_LE_MUL; REAL_POS; REAL_ABS_POS]]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&4 * (&x - &y * &z) pow 2 < &y pow 2` THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_POW2_ABS] THEN REWRITE_TAC[GSYM REAL_ABS_POW] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ; REAL_POW_EQ_0; ARITH_EQ; REAL_OF_NUM_EQ] THEN REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div; GSYM REAL_POW_DIV] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div; REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[GSYM real_div; REAL_DIV_LMUL; REAL_OF_NUM_EQ]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; let Y_EQ_0 = prove (`!a n. ~(a = 0) ==> ((Y a n = 0) <=> (n = 0))`, REPEAT STRIP_TAC THEN SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 Y_CLAUSES))) THEN ASM_SIMP_TAC[Y_INJ] THEN REWRITE_TAC[Y_CLAUSES]);; let XY_EXP = prove (`~(a = 0) ==> ((a EXP n = p) <=> ?k x y z. (Y (a * k) (n + 1) = x) /\ (Y k (n + 1) = y) /\ (Y a (n + 1) = z) /\ 2 * n * z < k /\ 4 * x EXP 2 + 4 * (y * p) EXP 2 < 8 * x * y * p + y EXP 2)`, let lemma1 = prove (`(?x y z. (a = x) /\ (b = y) /\ (c = z) /\ P x y z) <=> P a b c`, MESON_TAC[]) and lemma2 = CONV_RULE(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) (SPEC_ALL ABS_LT_REPRESENTATION) in REPEAT STRIP_TAC THEN REWRITE_TAC[lemma1] THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV o LAND_CONV) [ARITH_RULE `n < k <=> n < k /\ ~(k = 0)`] THEN ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN ASM_SIMP_TAC[lemma2; Y_EQ_0; ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[ARITH_RULE `n < k /\ ~(k = 0) <=> n < k`] THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `2 * n * Y a (n + 1) + 1` THEN REWRITE_TAC[ARITH_RULE `c < c + 1`; GSYM REAL_OF_NUM_POW] THEN MATCH_MP_TAC XY_EXP_LEMMA THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE `a <= b ==> 2 * a < 2 * b + 1`) THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(2 * a - 1) EXP n` THEN REWRITE_TAC[Y_LOWERBOUND] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 EXP; LE_REFL; EXP_MONO_LE_SUC] THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(SPECL [`a:num`; `k:num`; `n:num`] XY_EXP_LEMMA) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `2 * a < k ==> b <= a ==> 2 * b < k`)) THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(2 * a - 1) EXP n` THEN REWRITE_TAC[Y_LOWERBOUND] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 EXP; LE_REFL; EXP_MONO_LE_SUC] THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs(x - a) < e1 /\ abs(x - b) < e2 ==> abs(a - b) < e1 + e2`)) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs(a - b) < &1 ==> a + &1 <= b \/ (a = b) \/ b + &1 <= a ==> (a = b)`)) THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; REAL_OF_NUM_LE] THEN DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Lemmas. *) (* ------------------------------------------------------------------------- *) let REAL_SUM_OF_SQUARES = prove (`(x pow 2 + y pow 2 = &0) <=> (x = &0) /\ (y = &0)`, REWRITE_TAC[REAL_POW_2] THEN EQ_TAC THEN SIMP_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(a + b = &0) ==> &0 <= a /\ &0 <= b ==> (a = &0) /\ (b = &0)`)) THEN REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]);; (* ------------------------------------------------------------------------- *) (* Combining theorems for conjunction and disjunction. *) (* ------------------------------------------------------------------------- *) let DIOPH_CONJ = prove (`(x1 = x2) /\ (y1 = y2) <=> (x1 * x1 + x2 * x2 + y1 * y1 + y2 * y2 = 2 * x1 * x2 + 2 * y1 * y2)`, REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM REAL_SUM_OF_SQUARES] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; let DIOPH_DISJ = prove (`(x1 = x2) \/ (y1 = y2) <=> (x1 * y1 + x2 * y2 = x1 * y2 + x2 * y1)`, REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM REAL_ENTIRE] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Inequalities. *) (* ------------------------------------------------------------------------- *) let DIOPH_LE = prove (`x <= y <=> ?d:num. x + d = y`, REWRITE_TAC[LE_EXISTS] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[ADD_AC; EQ_SYM_EQ]);; let DIOPH_LT = prove (`x < y <=> ?d. x + d + 1 = y`, REWRITE_TAC[LT_EXISTS] THEN REWRITE_TAC[ADD1] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[ADD_AC; EQ_SYM_EQ]);; let DIOPH_NE = prove (`~(x = y) <=> x < y \/ y < x:num`, ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Exponentiation (from the Pell stuff). *) (* ------------------------------------------------------------------------- *) let Y_0 = prove (`!k. Y 0 k = if k = 1 then 1 else 0`, INDUCT_TAC THEN REWRITE_TAC[Y_CLAUSES; ARITH_EQ] THEN SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[Y_CLAUSES; ARITH] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`; Y_CLAUSES; ARITH] THEN REWRITE_TAC[MULT_CLAUSES; SUB_0; ARITH_RULE `~(k + 2 = 1)`]);; let Y_0_TRIV = prove (`!k. (Y 0 k = 0) <=> ~(k = 1)`, GEN_TAC THEN REWRITE_TAC[Y_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ]);; let DIOPH_Y = prove (`(Y a k = y) <=> (a = 0) /\ (k = 1) /\ (y = 1) \/ (a = 0) /\ ~(k = 1) /\ (y = 0) \/ (k = 0) /\ (y = 0) \/ (a = 1) /\ (y = k) \/ ~(a = 0) /\ ~(k = 0) /\ ~(a = 1) /\ ~(y = 0) /\ ?x u v r b p q s t c d. 0 < r /\ (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) /\ (u EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1) /\ (s EXP 2 = (b EXP 2 - 1) * t EXP 2 + 1) /\ (v = r * y EXP 2) /\ (b = 1 + 4 * p * y) /\ (b = a + q * u) /\ (s = x + c * u) /\ (t = k + 4 * d * y) /\ k <= y`, ASM_CASES_TAC `a = 0` THENL [ASM_CASES_TAC `y = 0` THENL [ASM_REWRITE_TAC[Y_0_TRIV; ARITH_EQ] THEN ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[Y_CLAUSES; ARITH_EQ] THEN ASM_REWRITE_TAC[ARITH_EQ] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[EXP_2; MULT_EQ_1] THEN REWRITE_TAC[Y_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_EQ] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[Y_CLAUSES] THENL [REWRITE_TAC[EQ_SYM_EQ] THEN CONV_TAC(EQT_INTRO o TAUT); ALL_TAC] THEN ASM_CASES_TAC `a = 1` THEN ASM_REWRITE_TAC[Y_DEGENERATE] THENL [REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN ASM_CASES_TAC `y = 0` THEN ASM_SIMP_TAC[Y_EQ_0] THEN GEN_REWRITE_TAC LAND_CONV [EQ_SYM_EQ] THEN ASM_SIMP_TAC[Y_DIOPH]);; let DIOPH_EXP_LEMMA = prove (`(m EXP n = p) <=> (m = 0) /\ (n = 0) /\ (p = 1) \/ (m = 0) /\ ~(n = 0) /\ (p = 0) \/ ~(m = 0) /\ ?k x y z. (Y (m * k) (n + 1) = x) /\ (Y k (n + 1) = y) /\ (Y m (n + 1) = z) /\ 2 * n * z < k /\ 4 * x EXP 2 + 4 * (y * p) EXP 2 < 8 * x * y * p + y EXP 2`, ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[ARITH_EQ] THENL [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES; NOT_SUC] THEN REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN ASM_SIMP_TAC[XY_EXP]);; let DIOPH_EXP = let th1 = REWRITE_RULE[DIOPH_Y] DIOPH_EXP_LEMMA in let th2 = REWRITE_RULE[EXP_2] th1 in let th3 = REWRITE_RULE[DIOPH_NE; DIOPH_LT; DIOPH_LE] th2 in let th4 = REWRITE_RULE[ADD_CLAUSES; ARITH_EQ; ADD_EQ_0; ARITH_RULE `(n + 1 = 1) = (n = 0)`; ADD_ASSOC; EQ_ADD_RCANCEL] th3 in let th5 = REWRITE_RULE[GSYM ADD_ASSOC] th4 in REWRITE_RULE [OR_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] th5;; (****** This takes about an hour to compute, and longer to print out! let DIOPH_EXP_ONE_EQUATION = REWRITE_RULE[DIOPH_CONJ; DIOPH_DISJ] DIOPH_EXP;; *******) hol-light/Examples/polylog.ml000066400000000000000000000777771303454263000165730ustar00rootroot00000000000000(* ========================================================================= *) (* Pi series in Bailey/Borwein/Plouffe "polylogarithmic constants" paper. *) (* ========================================================================= *) needs "Library/transc.ml";; let FACTOR_1X4_LEMMA = prove (`!x. (x * x + x * sqrt (&2) + &1) * (x * x - x * sqrt (&2) + &1) = &1 + x pow 4`, REWRITE_TAC[REAL_ARITH `(a + b + c) * (a - b + c) = &2 * a * c + a * a - b * b + c * c`] THEN REWRITE_TAC[REAL_ARITH `&2 * (x * x) * &1 + a - (x * s) * x * s + &1 * &1 = (&2 - s * s) * x * x + (&1 + a)`] THEN SIMP_TAC[REWRITE_RULE[REAL_POW_2] SQRT_POW_2; REAL_POS] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_LZERO; REAL_ADD_LID] THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `SUC(SUC(SUC(SUC 0)))`)) THEN REWRITE_TAC[real_pow; REAL_MUL_ASSOC; REAL_MUL_RID]);; let MAGIC_DERIVATIVE = prove (`!x. abs(x) < &1 ==> ((\x. ln((x - &1) pow 2) + ln((x + &1) pow 2) + ln((x pow 2 + x * sqrt(&2) + &1) / (x pow 2 - x * sqrt(&2) + &1)) + &2 * atn(x * sqrt(&2) + &1) + &2 * atn(x * sqrt(&2) - &1) + &2 * atn(x pow 2) - ln(x pow 4 + &1)) diffl ((&4 * sqrt(&2) - &8 * x pow 3 - &4 * sqrt(&2) * x pow 4 - &8 * x pow 5) / (&1 - x pow 8)))(x)`, REPEAT STRIP_TAC THEN W(MP_TAC o SPEC `x:real` o DIFF_CONV o lhand o rator o snd) THEN REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> (b <=> c)) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> c) /\ (a /\ c ==> b) /\ d /\ e ==> e /\ d /\ b /\ a /\ c`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 + 2`)) THEN REWRITE_TAC[REAL_POW_ADD; REAL_LE_SQUARE]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_ADD_SYM] THEN ONCE_REWRITE_TAC[GSYM FACTOR_1X4_LEMMA] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN SIMP_TAC[REAL_POW_2; REAL_ENTIRE; DE_MORGAN_THM]; STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv((x pow 2 - x * sqrt (&2) + &1) * (x pow 2 - x * sqrt (&2) + &1)) * ((x pow 2 - x * sqrt (&2) + &1) * (x pow 2 - x * sqrt (&2) + &1)) * (x pow 2 + x * sqrt (&2) + &1) / (x pow 2 - x * sqrt (&2) + &1)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [REWRITE_TAC[REAL_LT_INV_EQ; GSYM REAL_POW_2] THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`; REAL_POW_EQ_0] THEN REWRITE_TAC[REAL_LE_SQUARE; REAL_POW_2]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_DIV_LMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_POW_2; FACTOR_1X4_LEMMA] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 + 2`)) THEN REWRITE_TAC[REAL_POW_ADD; REAL_LE_SQUARE]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ENTIRE; DE_MORGAN_THM] THEN REWRITE_TAC[REAL_LE_REFL; REAL_MUL_LID]; REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE] THEN UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE] THEN UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC]; ALL_TAC] THEN STRIP_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_MUL_LID; REAL_MUL_RID; REAL_SUB_RZERO; REAL_SUB_LZERO; REAL_SUB_REFL; REAL_ADD_LID; REAL_ADD_RID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_1] THEN REWRITE_TAC[REAL_ARITH `(a + b) * (x - y + z) - (a - b) * (x + y + z) = &2 * (b * x + b * z - a * y)`] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `s * x * x + s - (&2 * x) * x * s = s * (&1 - x * x)`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e * inv(a) * f = (a * inv a) * b * c * d * e * f`] THEN REWRITE_TAC[REAL_ARITH `&1 + (x * s + &1) * (x * s + &1) = &2 + &2 * x * s + (s * s) * x * x`] THEN REWRITE_TAC[REAL_ARITH `&1 + (x * s - &1) * (x * s - &1) = &2 + &2 * x * --s + (s * s) * x * x`] THEN SIMP_TAC[REWRITE_RULE[REAL_POW_2] SQRT_POW_2; REAL_POS] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_ARITH `&2 + &2 * x = &2 * (&1 + x)`] THEN REWRITE_TAC[REAL_MUL_LNEG] THEN REWRITE_TAC[REAL_ARITH `&1 + x * (a + b) = (&1 + x * a) + x * b`] THEN REWRITE_TAC[REAL_MUL_RNEG] THEN REWRITE_TAC[GSYM real_sub] THEN REWRITE_TAC[REAL_ARITH `(&1 + x * a) + x * x = x * x + x * a + &1`] THEN REWRITE_TAC[REAL_ARITH `(&1 - x * a) + x * x = x * x - x * a + &1`] THEN REWRITE_TAC[REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `inv(x) * y * z * x = (x * inv(x)) * y * z`] THEN SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `p' * n * &2 * s2 * aa * n' * n' = (n' * n) * (p' * n') * &2 * s2 * aa`] THEN MP_TAC(SPEC `x pow 2` REAL_LE_SQUARE) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_POW_2] THEN REWRITE_TAC[REAL_POW_POW; ARITH] THEN REWRITE_TAC[GSYM FACTOR_1X4_LEMMA; REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN SUBGOAL_THEN `!other. inv(x * x + x * sqrt (&2) + &1) * sqrt (&2) + inv(x * x - x * sqrt (&2) + &1) * sqrt (&2) + other = other + &2 * sqrt(&2) * (&1 + x * x) * inv(x * x + x * sqrt (&2) + &1) * inv(x * x - x * sqrt (&2) + &1)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `(x * x + x * sqrt (&2) + &1) * (x * x - x * sqrt (&2) + &1)` THEN MATCH_MP_TAC(TAUT `~a /\ (~a ==> b) ==> ~a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[FACTOR_1X4_LEMMA] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`) THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 + 2`)) THEN REWRITE_TAC[REAL_POW_ADD; REAL_LE_SQUARE]; ALL_TAC] THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `(x * y) * (a + b + c) = (x * a) * y + (y * b) * x + x * y * c`] THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV] THEN REWRITE_TAC[REAL_ARITH `(a + b + x * other = x * (other + c)) <=> (a + b = x * c)`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `p * n * x * y * z * p' * n' = (p * p') * (n * n') * x * y * z`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `a * (x - y + z) + a * (x + y + z) = &2 * a * (x + z)`] THEN REWRITE_TAC[REAL_ADD_AC]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_INV_MUL; FACTOR_1X4_LEMMA] THEN SUBGOAL_THEN `~(x + &1 = &0) /\ ~(x - &1 = &0)` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [UNDISCH_TAC `&0 < (x + &1) pow 2`; UNDISCH_TAC `&0 < (x - &1) pow 2`] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN SIMP_TAC[REAL_POW_EQ_0; ARITH_EQ]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `i4 * &2 * s * (&1 - x2) + other + &2 * s * (&1 + x2) * i4 = &4 * s * i4 + other`] THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&1 - x pow 8` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x < &1 ==> ~(&1 - x = &0)`) THEN SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 4`)) THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&1 pow 4`)) THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN MATCH_MP_TAC REAL_POW_LT2 THEN REWRITE_TAC[ARITH_EQ; REAL_POW_2; REAL_LE_SQUARE] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&1 pow 2`)) THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[REAL_ABS_POS; ARITH_EQ]; ALL_TAC] THEN SIMP_TAC[GSYM real_div; REAL_DIV_LMUL] THEN SUBGOAL_THEN `!x. &1 - x pow 8 = (&1 + x pow 4) * (&1 - x pow 4)` (fun th -> REWRITE_TAC[th]) THENL [SUBST1_TAC(SYM(NUM_REDUCE_CONV `4 * 2`)) THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM(CONJUNCT2 real_pow)] THEN CONV_TAC NUM_REDUCE_CONV THEN SUBST1_TAC(SPECL [`x pow 4`; `&1`] REAL_ADD_SYM) THEN REWRITE_TAC[real_div; REAL_ARITH `a + b + c1 * c2 * x + x * d - x * e = (a + b) + x * (c1 * c2 + d - e)`] THEN ONCE_REWRITE_TAC[REAL_ARITH `(p * m) * (x + inv(p) * y) = m * x * p + (p * inv(p)) * m * y`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN UNDISCH_TAC `~(&1 - x pow 4 = &0)` THEN SUBGOAL_THEN `!x. &1 - x pow 4 = (&1 + x pow 2) * (&1 - x pow 2)` (fun th -> REWRITE_TAC[th]) THENL [SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN UNDISCH_TAC `~(&1 - x pow 2 = &0)` THEN SUBGOAL_THEN `!x. &1 - x pow 2 = (&1 + x) * (&1 - x)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `(x12 * (p1 + p2) * (m1 - m2)) * (m' * &2 + p' * &2) * other = --(&2) * x12 * other * ((p2 + p1) * (m2 - m1) * m' + (m2 - m1) * (p2 + p1) * p')`] THEN ASM_SIMP_TAC[REAL_MUL_RINV] THEN CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[real_pow] THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC);; let POLYLOG_CONVERGES = prove (`!a b x. ~(a = 0) /\ ~(b = 0) /\ abs(x) < &1 ==> summable (\n. x pow (a * n + b) / &(a * n + b))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(x) pow (a * n + b)` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_DIV; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[real_div] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_INV_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; ALL_TAC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; GSYM REAL_POW_POW] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `abs(x) pow b * inv(&1 - abs(x) pow a)` THEN MATCH_MP_TAC SER_CMUL THEN MATCH_MP_TAC GP THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_ABS] THEN SUBST1_TAC(SYM(SPEC `a:num` REAL_POW_ONE)) THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; let POLYLOG_DERIVATIVE = prove (`!a b x. ~(a = 0) /\ ~(b = 0) /\ abs(x) < &1 ==> ((\x. suminf (\n. x pow (a * n + b) / &(a * n + b))) diffl (x pow (b - 1) / (&1 - x pow a)))(x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(x pow a) < &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_ABS_POW] THEN SUBST1_TAC(SYM(SPEC `a:num` REAL_POW_ONE)) THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]; ALL_TAC] THEN MP_TAC(SPEC `x pow a` GP) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `((\x. suminf (\n. inv(&(a * n + b)) * x pow n)) diffl (suminf (\n. diffs (\n. inv(&(a * n + b))) n * (x pow a) pow n)))(x pow a)` MP_TAC THENL [MATCH_MP_TAC TERMDIFF_STRONG THEN EXISTS_TAC `(abs(x pow a) + &1) / &2` THEN ABBREV_TAC `k = (abs(x pow a) + &1) / &2` THEN SUBGOAL_THEN `abs(x pow a) < abs(k) /\ abs(k) < &1` STRIP_ASSUME_TAC THENL [EXPAND_TAC "k" THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x pow a) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(k) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div; REAL_ABS_DIV; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `~(b = 0) ==> 0 < a + b`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs k)` THEN ASM_SIMP_TAC[GP; REAL_ABS_ABS]; ALL_TAC] THEN REWRITE_TAC[diffs] THEN MP_TAC(SPECL [`a:num`; `x:real`] DIFF_POW) THEN REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN REWRITE_TAC[] THEN MP_TAC(SPECL [`b:num`; `x:real`] DIFF_POW) THEN REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN REWRITE_TAC[] THEN SUBGOAL_THEN `summable (\n. &(SUC n) / &(a * SUC n + b) * (x pow a) pow (SUC n - 1))` ASSUME_TAC THENL [REWRITE_TAC[SUC_SUB1] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(x pow a) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[GSYM REAL_ABS_POW] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_ABS_DIV; REAL_ABS_NUM; ARITH_RULE `~(b = 0) ==> 0 < a + b /\ 1 <= a + b`; REAL_MUL_LID; REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC(ARITH_RULE `1 * n <= b ==> n <= b + c`) THEN ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= n <=> ~(n = 0)`]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs(x pow a))` THEN ASM_SIMP_TAC[GP; REAL_ABS_ABS]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(SPECL [`f:num->real`; `1`] SER_OFFSET_REV) o REWRITE_RULE[ADD1]) THEN REWRITE_TAC[SUM_1] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID] THEN REWRITE_TAC[GSYM real_div] THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV(ALPHA_CONV `n:num`))) THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[ADD1] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_CMUL) THEN DISCH_THEN(MP_TAC o SPEC `&a * x pow (a - 1) * x pow b`) THEN SUBGOAL_THEN `summable (\n. inv(&(a * n + b)) * x pow a pow n)` MP_TAC THENL [MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(x pow a) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_INV_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs(x pow a))` THEN ASM_SIMP_TAC[GP; REAL_ABS_ABS]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_CMUL) THEN DISCH_THEN(MP_TAC o SPEC `&b * x pow (b - 1)`) THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_ADD) THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!n. (&a * x pow (a - 1) * x pow b) * &n / &(a * n + b) * x pow a pow (n - 1) + (&b * x pow (b - 1)) * inv(&(a * n + b)) * x pow a pow n = x pow (a * n + b - 1)` (fun th -> REWRITE_TAC[th]) THENL [X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[SUB_0; real_pow; MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_ADD_LID; GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN ASM_SIMP_TAC[GSYM real_div; REAL_DIV_LMUL; REAL_OF_NUM_EQ]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_ADD; GSYM REAL_POW_POW] THEN SUBGOAL_THEN `(x pow a) pow n = x pow a * (x pow a) pow (n - 1)` SUBST1_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_POW_POW] THEN SUBGOAL_THEN `x pow a = x * x pow (a - 1)` SUBST1_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `x pow b = x * x pow (b - 1)` SUBST1_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN UNDISCH_TAC `~(b = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `a * xa1 * x * xb1 * n * i * xan1 + b * xb1 * i * x * xa1 * xan1 = x * xa1 * xan1 * xb1 * (a * n + b) * i`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_MUL_RID; REAL_OF_NUM_EQ; ARITH_RULE `~(b = 0) ==> ~(a + b = 0)`]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN SUBGOAL_THEN `x pow (b - 1) / (&1 - x pow a) = suminf (\n. x pow (a * n + b - 1))` (SUBST1_TAC o SYM) THENL [MATCH_MP_TAC SUM_UNIQ THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; real_div] THEN MATCH_MP_TAC SER_CMUL THEN ASM_SIMP_TAC[GSYM REAL_POW_POW; GP]; ALL_TAC] THEN SIMP_TAC[REAL_MUL_AC] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[diffl] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `&1 - abs(x)` THEN ASM_REWRITE_TAC[REAL_SUB_LT; REAL_SUB_RZERO] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `(a = a') /\ &0 < b ==> abs(a - a') < b`) THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `abs(x + h) < &1` ASSUME_TAC THENL [UNDISCH_TAC `abs(h) < &1 - abs(x)` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!z. abs(z) < &1 ==> (suminf (\n. z pow (a * n + b) / &(a * n + b)) = z pow b * suminf (\n. inv (&(a * n + b)) * z pow a pow n))` (fun th -> ASM_SIMP_TAC[th]) THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN MATCH_MP_TAC(GSYM SUM_UNIQ) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC SER_CMUL THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN MATCH_MP_TAC SUMMABLE_SUM THEN ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(z pow a) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_INV_LE_1; REAL_OF_NUM_LE; ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs(z pow a))` THEN MATCH_MP_TAC GP THEN REWRITE_TAC[REAL_ABS_ABS; REAL_ABS_POW] THEN SUBST1_TAC(SYM(SPEC `a:num` REAL_POW_ONE)) THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; let POLYLOG_THM = prove (`(\n. inv(&16 pow n) * (&4 / &(8 * n + 1) - &2 / &(8 * n + 4) - &1 / &(8 * n + 5) - &1 / &(8 * n + 6))) sums pi`, SUBGOAL_THEN `!x. abs(x) < &1 ==> ((\x. suminf (\n. &4 * sqrt(&2) * x pow (8 * n + 1) / &(8 * n + 1) - &8 * x pow (8 * n + 4) / &(8 * n + 4) - &4 * sqrt(&2) * x pow (8 * n + 5) / &(8 * n + 5) - &8 * x pow (8 * n + 6) / &(8 * n + 6))) diffl (&4 * sqrt(&2) - &8 * x pow 3 - &4 * sqrt(&2) * x pow 4 - &8 * x pow 5) / (&1 - x pow 8))(x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(SPECL [`8`; `1`; `x:real`] POLYLOG_DERIVATIVE) THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[real_pow] THEN DISCH_THEN(MP_TAC o SPEC `&4 * sqrt(&2)` o MATCH_MP DIFF_CMUL) THEN MP_TAC(SPECL [`8`; `4`; `x:real`] POLYLOG_DERIVATIVE) THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `&8` o MATCH_MP DIFF_CMUL) THEN MP_TAC(SPECL [`8`; `5`; `x:real`] POLYLOG_DERIVATIVE) THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `&4 * sqrt(&2)` o MATCH_MP DIFF_CMUL) THEN MP_TAC(SPECL [`8`; `6`; `x:real`] POLYLOG_DERIVATIVE) THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `&8` o MATCH_MP DIFF_CMUL) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_ARITH `a - (b + c + d) = a - b - c - d`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_RID] THEN REWRITE_TAC[diffl] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `&1 - abs(x)` THEN ASM_REWRITE_TAC[REAL_SUB_LT; REAL_SUB_RZERO] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `(a = a') /\ &0 < b ==> abs(a - a') < b`) THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `abs(x + h) < &1` ASSUME_TAC THENL [UNDISCH_TAC `abs(h) < &1 - abs(x)` THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!z. abs(z) < &1 ==> (suminf (\n. (&4 * sqrt (&2)) * z pow (8 * n + 1) / &(8 * n + 1) - &8 * z pow (8 * n + 4) / &(8 * n + 4) - (&4 * sqrt (&2)) * z pow (8 * n + 5) / &(8 * n + 5) - &8 * z pow (8 * n + 6) / &(8 * n + 6)) = (&4 * sqrt (&2)) * suminf (\n. z pow (8 * n + 1) / &(8 * n + 1)) - &8 * suminf (\n. z pow (8 * n + 4) / &(8 * n + 4)) - (&4 * sqrt (&2)) * suminf (\n. z pow (8 * n + 5) / &(8 * n + 5)) - &8 * suminf (\n. z pow (8 * n + 6) / &(8 * n + 6)))` (fun th -> ASM_SIMP_TAC[th]) THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN MATCH_MP_TAC(GSYM SUM_UNIQ) THEN REPEAT(MATCH_MP_TAC SER_SUB THEN CONJ_TAC) THEN MATCH_MP_TAC SER_CMUL THEN MATCH_MP_TAC SUMMABLE_SUM THEN MATCH_MP_TAC POLYLOG_CONVERGES THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN MP_TAC(SPEC `\x. suminf (\n. &4 * sqrt (&2) * x pow (8 * n + 1) / &(8 * n + 1) - &8 * x pow (8 * n + 4) / &(8 * n + 4) - &4 * sqrt (&2) * x pow (8 * n + 5) / &(8 * n + 5) - &8 * x pow (8 * n + 6) / &(8 * n + 6)) - (ln ((x - &1) pow 2) + ln((x + &1) pow 2) + ln((x pow 2 + x * sqrt (&2) + &1) / (x pow 2 - x * sqrt (&2) + &1)) + &2 * atn (x * sqrt (&2) + &1) + &2 * atn (x * sqrt (&2) - &1) + &2 * atn (x pow 2) - ln (x pow 4 + &1))` DIFF_ISCONST_END_SIMPLE) THEN DISCH_THEN(MP_TAC o SPECL [`&0`; `inv(sqrt(&2))`]) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [SIMP_TAC[SQRT_POS_LT; REAL_LT_INV_EQ; REAL_OF_NUM_LT; ARITH] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN SUBGOAL_THEN `abs(x) < &1` MP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `!a. &0 <= x /\ x <= a /\ a < &1 ==> abs(x) < &1`) THEN EXISTS_TAC `inv(sqrt(&2))` THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&1)`)) THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_01] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `sqrt((&5 / &4) pow 2)` THEN CONJ_TAC THENL [SIMP_TAC[POW_2_SQRT; REAL_LE_DIV; REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MATCH_MP_TAC SQRT_MONO_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP MAGIC_DERIVATIVE th) THEN ANTE_RES_THEN MP_TAC th) THEN ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN REWRITE_TAC[REAL_SUB_REFL]; ALL_TAC] THEN SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL REAL_POW_EQ_0)); ARITH_RULE `~(b = 0) ==> ~(a + b = 0)`; ARITH_EQ] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[GSYM real_div; REAL_ADD_LID; REAL_ADD_RID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1; LN_1; ATN_1; ATN_NEG; ATN_0] THEN REWRITE_TAC[REAL_ARITH `a * b + a * --b + c = c`] THEN SUBGOAL_THEN `suminf (\n. &0) = &0` SUBST1_TAC THENL [MATCH_MP_TAC(GSYM SUM_UNIQ) THEN MP_TAC(SPECL [`\n:num. &0`; `0`] SER_0) THEN REWRITE_TAC[sum]; ALL_TAC] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; REAL_SUB_REFL] THEN SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_LT_INV_EQ; SQRT_POS_LT; REAL_OF_NUM_LT; ARITH_LE; ARITH_LT] THEN SUBGOAL_THEN `inv(sqrt(&2)) pow 4 = inv(sqrt(&2)) pow 2 pow 2` SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_POW; ARITH]; ALL_TAC] THEN SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBGOAL_THEN `!other. ln((inv (sqrt (&2)) - &1) pow 2) + ln((inv (sqrt (&2)) + &1) pow 2) + other = ln(&1 / &4) + other` (fun th -> ONCE_REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[REAL_ADD_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `&0 < (inv(sqrt(&2)) - &1) pow 2 /\ &0 < (inv(sqrt (&2)) + &1) pow 2` (fun th -> SIMP_TAC[GSYM LN_MUL; th]) THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < &1 ==> ~(x - &1 = &0) /\ ~(x + &1 = &0)`) THEN SIMP_TAC[REAL_LT_INV_EQ; SQRT_POS_LT; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sqrt((&4 / &5) pow 2)` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[POW_2_SQRT; REAL_LE_DIV; REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN SIMP_TAC[GSYM SQRT_INV; REAL_POS] THEN MATCH_MP_TAC SQRT_MONO_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_ARITH `(x - &1) * (x + &1) = x * x - &1`] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[ATN_0; REAL_MUL_RZERO; REAL_ADD_LID] THEN ONCE_REWRITE_TAC[REAL_ARITH `l1 + l2 + a + y - l3 = (l1 + l2 - l3) + a + y`] THEN SIMP_TAC[GSYM LN_DIV; GSYM LN_MUL; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH_LE; ARITH_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LN_1; REAL_ADD_LID] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_MUL_ASSOC] THEN SUBGOAL_THEN `!n. inv(sqrt (&2)) pow (8 * n) = inv(&16 pow n)` (fun th -> REWRITE_TAC[th]) THENL [SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 4`)) THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_POW_INV] THEN REWRITE_TAC[real_div; REAL_MUL_LID]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN SUBGOAL_THEN `!x. x pow 5 = x * x pow 4` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[GSYM(CONJUNCT2 real_pow); ARITH]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_1] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * s * i * b - c - d * s * (i * e) * f - g = (s * i) * a * b - c - (s * i) * d * e * f - g`] THEN SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; SQRT_POS_LT; REAL_OF_NUM_LT; ARITH_LT; ARITH_LE] THEN SUBGOAL_THEN `!x. x pow 6 = (x pow 2) pow 3` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[REAL_POW_POW; ARITH]; ALL_TAC] THEN SUBGOAL_THEN `!x. x pow 4 = (x pow 2) pow 2` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[REAL_POW_POW; ARITH]; ALL_TAC] THEN SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_INV_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * a * c`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THEN SUBGOAL_THEN `summable (\n. inv (&16 pow n) * (&4 / &(8 * n + 1) - &2 / &(8 * n + 4) - &1 / &(8 * n + 5) - &1 / &(8 * n + 6)))` MP_TAC THENL [MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. &8 / &16 pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM; REAL_LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `abs(v) <= &1 /\ abs(w) <= &1 /\ abs(x) <= &1 /\ abs(y) <= &1 ==> abs(&4 * v - &2 * w - &1 * x - &1 * y) <= &8`) THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN SUBST1_TAC(SYM REAL_INV_1) THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `&8 / (&1 - inv(&16))` THEN REWRITE_TAC[real_div; GSYM REAL_POW_INV] THEN MATCH_MP_TAC SER_CMUL THEN MATCH_MP_TAC GP THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN MP_TAC(SPEC `atn(&1 / &2)` TAN_COT) THEN REWRITE_TAC[ATN_TAN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o AP_TERM `atn`) THEN REWRITE_TAC[REAL_DIV_1] THEN MATCH_MP_TAC(REAL_ARITH `(a = d - c) ==> (a = b) ==> (b + c = d)`) THEN MATCH_MP_TAC TAN_ATN THEN REWRITE_TAC[PI2_PI4] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < p4 ==> --(&2 * p4) < &2 * p4 - x /\ &2 * p4 - x < &2 * p4`) THEN CONJ_TAC THENL [SUBST1_TAC(SYM ATN_0) THEN MATCH_MP_TAC ATN_MONO_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC ATN_LT_PI4_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; hol-light/Examples/prog.ml000066400000000000000000000731021303454263000160270ustar00rootroot00000000000000(* ========================================================================= *) (* Simple WHILE-language with relational semantics. *) (* ========================================================================= *) prioritize_num();; parse_as_infix("refined",(12,"right"));; (* ------------------------------------------------------------------------- *) (* Logical operations "lifted" to predicates, for readability. *) (* ------------------------------------------------------------------------- *) parse_as_infix("AND",(20,"right"));; parse_as_infix("OR",(16,"right"));; parse_as_infix("IMP",(13,"right"));; parse_as_infix("IMPLIES",(12,"right"));; let FALSE = new_definition `FALSE = \x:S. F`;; let TRUE = new_definition `TRUE = \x:S. T`;; let NOT = new_definition `NOT p = \x:S. ~(p x)`;; let AND = new_definition `p AND q = \x:S. p x /\ q x`;; let OR = new_definition `p OR q = \x:S. p x \/ q x`;; let ANDS = new_definition `ANDS P = \x:S. !p. P p ==> p x`;; let ORS = new_definition `ORS P = \x:S. ?p. P p /\ p x`;; let IMP = new_definition `p IMP q = \x:S. p x ==> q x`;; (* ------------------------------------------------------------------------- *) (* This one is different, corresponding to "subset". *) (* ------------------------------------------------------------------------- *) let IMPLIES = new_definition `p IMPLIES q <=> !x:S. p x ==> q x`;; (* ------------------------------------------------------------------------- *) (* Simple procedure to prove tautologies at the predicate level. *) (* ------------------------------------------------------------------------- *) let PRED_TAUT = let tac = REWRITE_TAC[FALSE; TRUE; NOT; AND; OR; ANDS; ORS; IMP; IMPLIES; FUN_EQ_THM] THEN MESON_TAC[] in fun tm -> prove(tm,tac);; (* ------------------------------------------------------------------------- *) (* Some applications. *) (* ------------------------------------------------------------------------- *) let IMPLIES_TRANS = PRED_TAUT `!p q r. p IMPLIES q /\ q IMPLIES r ==> p IMPLIES r`;; (* ------------------------------------------------------------------------- *) (* Enumerated type of basic commands, and other derived commands. *) (* ------------------------------------------------------------------------- *) parse_as_infix("Seq",(26,"right"));; let command_INDUCTION,command_RECURSION = define_type "command = Assign (S->S) | Seq command command | Ite (S->bool) command command | While (S->bool) command";; let SKIP = new_definition `SKIP = Assign I`;; let ABORT = new_definition `ABORT = While TRUE SKIP`;; let IF = new_definition `IF e c = Ite e c SKIP`;; let DO = new_definition `DO c e = c Seq (While e c)`;; let ASSERT = new_definition `ASSERT g = Ite g SKIP ABORT`;; (* ------------------------------------------------------------------------- *) (* Annotation commands, to allow insertion of loop (in)variants. *) (* ------------------------------------------------------------------------- *) let AWHILE = new_definition `AWHILE (i:S->bool) (v:S->S->bool) (e:S->bool) c = While e c`;; let ADO = new_definition `ADO (i:S->bool) (v:S->S->bool) c (e:S->bool) = DO c e`;; (* ------------------------------------------------------------------------- *) (* Useful properties of type constructors for commands. *) (* ------------------------------------------------------------------------- *) let command_DISTINCT = distinctness "command";; let command_INJECTIVE = injectivity "command";; (* ------------------------------------------------------------------------- *) (* Relational semantics of commands. *) (* ------------------------------------------------------------------------- *) let sem_RULES,sem_INDUCT,sem_CASES = new_inductive_definition `(!f s. sem(Assign f) s (f s)) /\ (!c1 c2 s s' s''. sem(c1) s s' /\ sem(c2) s' s'' ==> sem(c1 Seq c2) s s'') /\ (!e c1 c2 s s'. e s /\ sem(c1) s s' ==> sem(Ite e c1 c2) s s') /\ (!e c1 c2 s s'. ~(e s) /\ sem(c2) s s' ==> sem(Ite e c1 c2) s s') /\ (!e c s. ~(e s) ==> sem(While e c) s s) /\ (!e c s s' s''. e s /\ sem(c) s s' /\ sem(While e c) s' s'' ==> sem(While e c) s s'')`;; (* ------------------------------------------------------------------------- *) (* A more "denotational" view of the semantics. *) (* ------------------------------------------------------------------------- *) let SEM_ASSIGN = prove (`sem(Assign f) s s' <=> (s' = f s)`, GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; let SEM_SEQ = prove (`sem(c1 Seq c2) s s' <=> ?s''. sem c1 s s'' /\ sem c2 s'' s'`, GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; let SEM_ITE = prove (`sem(Ite e c1 c2) s s' <=> e s /\ sem c1 s s' \/ ~(e s) /\ sem c2 s s'`, GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; let SEM_SKIP = prove (`sem(SKIP) s s' <=> (s' = s)`, REWRITE_TAC[SKIP; SEM_ASSIGN; I_THM]);; let SEM_IF = prove (`sem(IF e c) s s' <=> e s /\ sem c s s' \/ ~(e s) /\ (s = s')`, REWRITE_TAC[IF; SEM_ITE; SEM_SKIP; EQ_SYM_EQ]);; let SEM_WHILE = prove (`sem(While e c) s s' <=> sem(IF e (c Seq While e c)) s s'`, GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN REWRITE_TAC[FUN_EQ_THM; SEM_IF; SEM_SEQ] THEN REPEAT GEN_TAC THEN REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; let SEM_ABORT = prove (`sem(ABORT) s s' <=> F`, let lemma = prove (`!c s s'. sem c s s' ==> ~(c = ABORT)`, MATCH_MP_TAC sem_INDUCT THEN REWRITE_TAC[command_DISTINCT; command_INJECTIVE; ABORT] THEN REWRITE_TAC[FUN_EQ_THM; TRUE] THEN MESON_TAC[]) in MESON_TAC[lemma]);; let SEM_DO = prove (`sem(DO c e) s s' <=> sem(c Seq IF e (DO c e)) s s'`, REWRITE_TAC[DO; SEM_SEQ; GSYM SEM_WHILE]);; let SEM_ASSERT = prove (`sem(ASSERT g) s s' <=> g s /\ (s' = s)`, REWRITE_TAC[ASSERT; SEM_ITE; SEM_SKIP; SEM_ABORT]);; (* ------------------------------------------------------------------------- *) (* Proofs that all commands are deterministic. *) (* ------------------------------------------------------------------------- *) let deterministic = new_definition `deterministic r <=> !s s1 s2. r s s1 /\ r s s2 ==> (s1 = s2)`;; let DETERMINISM = prove (`!c:(S)command. deterministic(sem c)`, REWRITE_TAC[deterministic] THEN SUBGOAL_THEN `!c s s1. sem c s s1 ==> !s2:S. sem c s s2 ==> (s1 = s2)` (fun th -> MESON_TAC[th]) THEN MATCH_MP_TAC sem_INDUCT THEN CONJ_TAC THENL [ALL_TAC; REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[sem_CASES] THEN REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Termination, weakest liberal precondition and weakest precondition. *) (* ------------------------------------------------------------------------- *) let terminates = new_definition `terminates c s <=> ?s'. sem c s s'`;; let wlp = new_definition `wlp c q s <=> !s'. sem c s s' ==> q s'`;; let wp = new_definition `wp c q s <=> terminates c s /\ wlp c q s`;; (* ------------------------------------------------------------------------- *) (* Dijkstra's healthiness conditions (the last because of determinism). *) (* ------------------------------------------------------------------------- *) let WP_TOTAL = prove (`!c. (wp c FALSE = FALSE)`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; FALSE] THEN MESON_TAC[]);; let WP_MONOTONIC = prove (`q IMPLIES r ==> wp c q IMPLIES wp c r`, REWRITE_TAC[IMPLIES; wp; wlp; terminates] THEN MESON_TAC[]);; let WP_CONJUNCTIVE = prove (`(wp c q) AND (wp c r) = wp c (q AND r)`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; AND] THEN MESON_TAC[]);; let WP_DISJUNCTIVE = prove (`(wp c p) OR (wp c q) = wp c (p OR q)`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; OR; terminates] THEN MESON_TAC[REWRITE_RULE[deterministic] DETERMINISM]);; (* ------------------------------------------------------------------------- *) (* Weakest preconditions for the primitive and derived commands. *) (* ------------------------------------------------------------------------- *) let WP_ASSIGN = prove (`!f q. wp (Assign f) q = q o f`, REWRITE_TAC[wp; wlp; terminates; o_THM; FUN_EQ_THM; SEM_ASSIGN] THEN MESON_TAC[]);; let WP_SEQ = prove (`!c1 c2 q. wp (c1 Seq c2) q = wp c1 (wp c2 q)`, REWRITE_TAC[wp; wlp; terminates; SEM_SEQ; FUN_EQ_THM] THEN MESON_TAC[REWRITE_RULE[deterministic] DETERMINISM]);; let WP_ITE = prove (`!e c1 c2 q. wp (Ite e c1 c2) q = (e AND wp c1 q) OR (NOT e AND wp c2 q)`, REWRITE_TAC[wp; wlp; terminates; SEM_ITE; FUN_EQ_THM; AND; OR; NOT] THEN MESON_TAC[]);; let WP_WHILE = prove (`!e c. wp (IF e (c Seq While e c)) q = wp (While e c) q`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; GSYM SEM_WHILE]);; let WP_SKIP = prove (`!q. wp SKIP q = q`, REWRITE_TAC[FUN_EQ_THM; SKIP; WP_ASSIGN; I_THM; o_THM]);; let WP_ABORT = prove (`!q. wp ABORT q = FALSE`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; SEM_ABORT; FALSE]);; let WP_IF = prove (`!e c q. wp (IF e c) q = (e AND wp c q) OR (NOT e AND q)`, REWRITE_TAC[IF; WP_ITE; WP_SKIP]);; let WP_DO = prove (`!e c. wp (c Seq IF e (DO c e)) q = wp (DO c e) q`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; GSYM SEM_DO]);; let WP_ASSERT = prove (`!g q. wp (ASSERT g) q = g AND q`, REWRITE_TAC[wp; wlp; terminates; SEM_ASSERT; FUN_EQ_THM; AND] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Rules for total correctness. *) (* ------------------------------------------------------------------------- *) let correct = new_definition `correct p c q <=> p IMPLIES (wp c q)`;; let CORRECT_PRESTRENGTH = prove (`!p p' c q. p IMPLIES p' /\ correct p' c q ==> correct p c q`, REWRITE_TAC[correct; IMPLIES_TRANS]);; let CORRECT_POSTWEAK = prove (`!p c q q'. correct p c q' /\ q' IMPLIES q ==> correct p c q`, REWRITE_TAC[correct] THEN MESON_TAC[WP_MONOTONIC; IMPLIES_TRANS]);; let CORRECT_ASSIGN = prove (`!p f q. (p IMPLIES (\s. q(f s))) ==> correct p (Assign f) q`, REWRITE_TAC[correct; WP_ASSIGN; IMPLIES; o_THM]);; let CORRECT_SEQ = prove (`!p q r c1 c2. correct p c1 r /\ correct r c2 q ==> correct p (c1 Seq c2) q`, REWRITE_TAC[correct; WP_SEQ; o_THM] THEN MESON_TAC[WP_MONOTONIC; IMPLIES_TRANS]);; let CORRECT_ITE = prove (`!p e c1 c2 q. correct (p AND e) c1 q /\ correct (p AND (NOT e)) c2 q ==> correct p (Ite e c1 c2) q`, REWRITE_TAC[correct; WP_ITE; AND; NOT; IMPLIES; OR] THEN MESON_TAC[]);; let CORRECT_WHILE = prove (`! (<<) p c q e invariant. WF(<<) /\ p IMPLIES invariant /\ (NOT e) AND invariant IMPLIES q /\ (!X:S. correct (invariant AND e AND (\s. X = s)) c (invariant AND (\s. s << X))) ==> correct p (While e c) q`, REWRITE_TAC[correct; IMPLIES; IN; AND; NOT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!s:S. invariant s ==> wp (While e c) q s` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND]) THEN X_GEN_TAC `s:S` THEN REPEAT DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM WP_WHILE] THEN REWRITE_TAC[WP_IF; WP_SEQ; AND; OR; NOT; o_THM] THEN ASM_CASES_TAC `(e:S->bool) s` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SUBGOAL_THEN `wp c (\x:S. invariant x /\ x << s) (s:S) :bool` MP_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(\x:S. invariant x /\ x << (s:S)) IMPLIES wp (While e c) q` MP_TAC THENL [REWRITE_TAC[IMPLIES] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MESON_TAC[WP_MONOTONIC; IMPLIES]);; let CORRECT_SKIP = prove (`!p q. (p IMPLIES q) ==> correct p SKIP q`, REWRITE_TAC[correct; WP_SKIP]);; let CORRECT_ABORT = prove (`!p q. F ==> correct p ABORT q`, REWRITE_TAC[]);; let CORRECT_IF = prove (`!p e c q. correct (p AND e) c q /\ (p AND (NOT e)) IMPLIES q ==> correct p (IF e c) q`, REWRITE_TAC[correct; WP_IF; AND; NOT; IMPLIES; OR] THEN MESON_TAC[]);; let CORRECT_DO = prove (`! (<<) p q c invariant. WF(<<) /\ (e AND invariant) IMPLIES p /\ ((NOT e) AND invariant) IMPLIES q /\ (!X:S. correct (p AND (\s. X = s)) c (invariant AND (\s. s << X))) ==> correct p (DO c e) q`, REPEAT STRIP_TAC THEN REWRITE_TAC[DO] THEN MATCH_MP_TAC CORRECT_SEQ THEN EXISTS_TAC `invariant:S->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[correct; GSYM WP_CONJUNCTIVE] THEN REWRITE_TAC[AND; IMPLIES] THEN MESON_TAC[]; MATCH_MP_TAC CORRECT_WHILE THEN MAP_EVERY EXISTS_TAC [`(<<) :S->S->bool`; `invariant:S->bool`] THEN ASM_REWRITE_TAC[IMPLIES] THEN X_GEN_TAC `X:S` THEN MATCH_MP_TAC CORRECT_PRESTRENGTH THEN EXISTS_TAC `p AND (\s:S. X = s)` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(e:S->bool) AND invariant IMPLIES p` THEN REWRITE_TAC[AND; IMPLIES] THEN MESON_TAC[]]);; let CORRECT_ASSERT = prove (`!p g q. p IMPLIES (g AND q) ==> correct p (ASSERT g) q`, REWRITE_TAC[correct; WP_ASSERT]);; (* ------------------------------------------------------------------------- *) (* VCs for the basic commands (in fact only assign should be needed). *) (* ------------------------------------------------------------------------- *) let VC_ASSIGN = prove (`p IMPLIES (q o f) ==> correct p (Assign f) q`, REWRITE_TAC[o_DEF; CORRECT_ASSIGN]);; let VC_SKIP = prove (`p IMPLIES q ==> correct p SKIP q`, REWRITE_TAC[CORRECT_SKIP]);; let VC_ABORT = prove (`F ==> correct p ABORT q`, MATCH_ACCEPT_TAC CORRECT_ABORT);; let VC_ASSERT = prove (`p IMPLIES (b AND q) ==> correct p (ASSERT b) q`, REWRITE_TAC[CORRECT_ASSERT]);; (* ------------------------------------------------------------------------- *) (* VCs for composite commands other than sequences. *) (* ------------------------------------------------------------------------- *) let VC_ITE = prove (`correct (p AND e) c1 q /\ correct (p AND NOT e) c2 q ==> correct p (Ite e c1 c2) q`, REWRITE_TAC[CORRECT_ITE]);; let VC_IF = prove (`correct (p AND e) c q /\ p AND NOT e IMPLIES q ==> correct p (IF e c) q`, REWRITE_TAC[CORRECT_IF]);; let VC_AWHILE_VARIANT = prove (`WF(<<) /\ p IMPLIES invariant /\ (NOT e) AND invariant IMPLIES q /\ (!X. correct (invariant AND e AND (\s. X = s)) c (invariant AND (\s. s << X))) ==> correct p (AWHILE invariant (<<) e c) q`, REWRITE_TAC[AWHILE; CORRECT_WHILE]);; let VC_AWHILE_MEASURE = prove (`p IMPLIES invariant /\ (NOT e) AND invariant IMPLIES q /\ (!X. correct (invariant AND e AND (\s:S. X = m(s))) c (invariant AND (\s. m(s) < X))) ==> correct p (AWHILE invariant (MEASURE m) e c) q`, STRIP_TAC THEN MATCH_MP_TAC VC_AWHILE_VARIANT THEN ASM_REWRITE_TAC[WF_MEASURE] THEN X_GEN_TAC `X:S` THEN FIRST_ASSUM(MP_TAC o SPEC `(m:S->num) X`) THEN REWRITE_TAC[correct; AND; IMPLIES; MEASURE] THEN MESON_TAC[]);; let VC_ADO_VARIANT = prove (`WF(<<) /\ (e AND invariant) IMPLIES p /\ ((NOT e) AND invariant) IMPLIES q /\ (!X. correct (p AND (\s. X = s)) c (invariant AND (\s. s << X))) ==> correct p (ADO invariant (<<) c e) q`, REWRITE_TAC[ADO; CORRECT_DO]);; let VC_ADO_MEASURE = prove (`(e AND invariant) IMPLIES p /\ ((NOT e) AND invariant) IMPLIES q /\ (!X. correct (p AND (\s:S. X = m(s))) c (invariant AND (\s. m(s) < X))) ==> correct p (ADO invariant (MEASURE m) c e) q`, STRIP_TAC THEN MATCH_MP_TAC VC_ADO_VARIANT THEN ASM_REWRITE_TAC[WF_MEASURE] THEN X_GEN_TAC `X:S` THEN FIRST_ASSUM(MP_TAC o SPEC `(m:S->num) X`) THEN REWRITE_TAC[correct; AND; IMPLIES; MEASURE] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* VCs for sequences of commands, using intelligence where possible. *) (* ------------------------------------------------------------------------- *) let VC_SEQ_ASSERT_LEFT = prove (`p IMPLIES b /\ correct b c q ==> correct p (ASSERT b Seq c) q`, MESON_TAC[CORRECT_SEQ; CORRECT_ASSERT; CORRECT_PRESTRENGTH; PRED_TAUT `(p IMPLIES b) ==> (p IMPLIES b AND p)`]);; let VC_SEQ_ASSERT_RIGHT = prove (`correct p c b /\ b IMPLIES q ==> correct p (c Seq (ASSERT b)) q`, MESON_TAC[CORRECT_SEQ; CORRECT_ASSERT; PRED_TAUT `(p IMPLIES b) ==> (p IMPLIES p AND b)`]);; let VC_SEQ_ASSERT_MIDDLE = prove (`correct p c b /\ correct b c' q ==> correct p (c Seq (ASSERT b) Seq c') q`, MESON_TAC[CORRECT_SEQ; CORRECT_ASSERT; PRED_TAUT `b IMPLIES b AND b`]);; let VC_SEQ_ASSIGN_LEFT = prove (`(p o f = p) /\ (f o f = f) /\ correct (p AND (\s:S. s = f s)) c q ==> correct p ((Assign f) Seq c) q`, REWRITE_TAC[FUN_EQ_THM; o_THM] THEN STRIP_TAC THEN MATCH_MP_TAC CORRECT_SEQ THEN EXISTS_TAC `p AND (\s:S. s = f s)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VC_ASSIGN THEN ASM_REWRITE_TAC[IMPLIES; AND; o_THM]);; let VC_SEQ_ASSIGN_RIGHT = prove (`correct p c (q o f) ==> correct p (c Seq (Assign f)) q`, MESON_TAC[CORRECT_SEQ; VC_ASSIGN; PRED_TAUT `(p:S->bool) IMPLIES p`]);; (* ------------------------------------------------------------------------- *) (* Parser for correctness assertions. *) (* ------------------------------------------------------------------------- *) let rec dive_to_var ptm = match ptm with Varp(_,_) as vp -> vp | Typing(t,_) -> dive_to_var t | _ -> fail();; let reserve_program_words,unreserve_program_words = let words = ["var"; "end"; "skip"; "abort"; ":="; "if"; "then"; "else"; "while"; "do"] in (fun () -> reserve_words words), (fun () -> unreserve_words words);; reserve_program_words();; let parse_program,parse_program_assertion = let assign_ptm = Varp("Assign",dpty) and seq_ptm = Varp("Seq",dpty) and ite_ptm = Varp("Ite",dpty) and while_ptm = Varp("While",dpty) and skip_ptm = Varp("SKIP",dpty) and abort_ptm = Varp("ABORT",dpty) and if_ptm = Varp("IF",dpty) and do_ptm = Varp("DO",dpty) and assert_ptm = Varp("ASSERT",dpty) and awhile_ptm = Varp("AWHILE",dpty) and ado_ptm = Varp("ADO",dpty) in let pmk_pair(ptm1,ptm2) = Combp(Combp(Varp(",",dpty),ptm1),ptm2) in let varname ptm = match dive_to_var ptm with Varp(n,_) -> n | _ -> fail() in let rec assign s v e = match s with Combp(Combp(pop,lptm),rptm) -> if varname pop = "," then Combp(Combp(pop,assign lptm v e),assign rptm v e) else fail() | _ -> if varname s = v then e else s in let lmk_assign s v e = Combp(assign_ptm,Absp(s,assign s v e)) and lmk_seq c cs = if cs = [] then c else Combp(Combp(seq_ptm,c),hd cs) and lmk_ite e c1 c2 = Combp(Combp(Combp(ite_ptm,e),c1),c2) and lmk_while e c = Combp(Combp(while_ptm,e),c) and lmk_skip _ = skip_ptm and lmk_abort _ = abort_ptm and lmk_if e c = Combp(Combp(if_ptm,e),c) and lmk_do c e = Combp(Combp(do_ptm,c),e) and lmk_assert e = Combp(assert_ptm,e) and lmk_awhile i v e c = Combp(Combp(Combp(Combp(awhile_ptm,i),v),e),c) and lmk_ado i v c e = Combp(Combp(Combp(Combp(ado_ptm,i),v),c),e) in let lmk_gwhile al e c = if al = [] then lmk_while e c else lmk_awhile (fst(hd al)) (snd(hd al)) e c and lmk_gdo al c e = if al = [] then lmk_do c e else lmk_ado (fst(hd al)) (snd(hd al)) c e in let expression s = parse_preterm >> (fun p -> Absp(s,p)) in let identifier = function ((Ident n)::rest) -> n,rest | _ -> raise Noparse in let variant s = (a (Ident "variant") ++ parse_preterm >> snd) ||| (a (Ident "measure") ++ expression s >> fun (_,m) -> Combp(Varp("MEASURE",dpty),m)) in let annotation s = a (Resword "[") ++ a (Ident "invariant") ++ expression s ++ a (Resword ";") ++ variant s ++ a (Resword "]") >> fun (((((_,_),i),_),v),_) -> (i,v) in let rec command s i = ( (a (Resword "(") ++ commands s ++ a (Resword ")") >> (fun ((_,c),_) -> c)) ||| (a (Resword "skip") >> lmk_skip) ||| (a (Resword "abort") >> lmk_abort) ||| (a (Resword "if") ++ expression s ++ a (Resword "then") ++ command s ++ possibly (a (Resword "else") ++ command s >> snd) >> (fun ((((_,e),_),c),cs) -> if cs = [] then lmk_if e c else lmk_ite e c (hd cs))) ||| (a (Resword "while") ++ expression s ++ a (Resword "do") ++ possibly (annotation s) ++ command s >> (fun ((((_,e),_),al),c) -> lmk_gwhile al e c)) ||| (a (Resword "do") ++ possibly (annotation s) ++ command s ++ a (Resword "while") ++ expression s >> (fun ((((_,al),c),_),e) -> lmk_gdo al c e)) ||| (a (Resword "{") ++ expression s ++ a (Resword "}") >> (fun ((_,e),_) -> lmk_assert e)) ||| (identifier ++ a (Resword ":=") ++ parse_preterm >> (fun ((v,_),e) -> lmk_assign s v e))) i and commands s i = (command s ++ possibly (a (Resword ";") ++ commands s >> snd) >> (fun (c,cs) -> lmk_seq c cs)) i in let program i = let ((_,s),_),r = (a (Resword "var") ++ parse_preterm ++ a (Resword ";")) i in let c,r' = (commands s ++ a (Resword "end") >> fst) r in (s,c),r' in let assertion = a (Ident "correct") ++ parse_preterm ++ program ++ parse_preterm >> fun (((_,p),(s,c)),q) -> Combp(Combp(Combp(Varp("correct",dpty),Absp(s,p)),c),Absp(s,q)) in (program >> snd),assertion;; (* ------------------------------------------------------------------------- *) (* Introduce the variables in the VCs. *) (* ------------------------------------------------------------------------- *) let STATE_GEN_TAC = let PAIR_CONV = REWR_CONV(GSYM PAIR) in let rec repair vs v acc = try let l,r = dest_pair vs in let th = PAIR_CONV v in let tm = rand(concl th) in let rtm = rator tm in let lth,acc1 = repair l (rand rtm) acc in let rth,acc2 = repair r (rand tm) acc1 in TRANS th (MK_COMB(AP_TERM (rator rtm) lth,rth)),acc2 with Failure _ -> REFL v,((v,vs)::acc) in fun (asl,w) -> let abstm = find_term (fun t -> not (is_abs t) && is_gabs t) w in let vs = fst(dest_gabs abstm) in let v = genvar(type_of(fst(dest_forall w))) in let th,gens = repair vs v [] in (X_GEN_TAC v THEN SUBST1_TAC th THEN MAP_EVERY SPEC_TAC gens THEN REPEAT GEN_TAC) (asl,w);; let STATE_GEN_TAC' = let PAIR_CONV = REWR_CONV(GSYM PAIR) in let rec repair vs v acc = try let l,r = dest_pair vs in let th = PAIR_CONV v in let tm = rand(concl th) in let rtm = rator tm in let lth,acc1 = repair l (rand rtm) acc in let rth,acc2 = repair r (rand tm) acc1 in TRANS th (MK_COMB(AP_TERM (rator rtm) lth,rth)),acc2 with Failure _ -> REFL v,((v,vs)::acc) in fun (asl,w) -> let abstm = find_term (fun t -> not (is_abs t) && is_gabs t) w in let vs0 = fst(dest_gabs abstm) in let vl0 = striplist dest_pair vs0 in let vl = map (variant (variables (list_mk_conj(w::map (concl o snd) asl)))) vl0 in let vs = end_itlist (curry mk_pair) vl in let v = genvar(type_of(fst(dest_forall w))) in let th,gens = repair vs v [] in (X_GEN_TAC v THEN SUBST1_TAC th THEN MAP_EVERY SPEC_TAC gens THEN REPEAT GEN_TAC) (asl,w);; (* ------------------------------------------------------------------------- *) (* Tidy up a verification condition. *) (* ------------------------------------------------------------------------- *) let VC_UNPACK_TAC = REWRITE_TAC[IMPLIES; o_THM; FALSE; TRUE; AND; OR; NOT; IMP] THEN STATE_GEN_TAC THEN CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[PAIR_EQ; GSYM CONJ_ASSOC];; (* ------------------------------------------------------------------------- *) (* Calculate a (pseudo-) weakest precondition for command. *) (* ------------------------------------------------------------------------- *) let find_pwp = let wptms = (map (snd o strip_forall o concl) [WP_ASSIGN; WP_ITE; WP_SKIP; WP_ABORT; WP_IF; WP_ASSERT]) @ [`wp (AWHILE i v e c) q = i`; `wp (ADO i v c e) q = i`] in let conv tm = tryfind (fun t -> rand (instantiate (term_match [] (lhand t) tm) t)) wptms in fun tm q -> conv(mk_comb(list_mk_icomb "wp" [tm],q));; (* ------------------------------------------------------------------------- *) (* Tools for automatic VC generation from annotated program. *) (* ------------------------------------------------------------------------- *) let VC_SEQ_TAC = let is_seq = is_binary "Seq" and strip_seq = striplist (dest_binary "Seq") and is_assert tm = try fst(dest_const(rator tm)) = "ASSERT" with Failure _ -> false and is_assign tm = try fst(dest_const(rator tm)) = "Assign" with Failure _ -> false and SIDE_TAC = GEN_REWRITE_TAC I [FUN_EQ_THM] THEN STATE_GEN_TAC THEN PURE_REWRITE_TAC[IMPLIES; o_THM; FALSE; TRUE; AND; OR; NOT; IMP] THEN CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[PAIR_EQ] THEN NO_TAC in let ADJUST_TAC ptm ptm' ((_,w) as gl) = let w' = subst [ptm',ptm] w in let th = EQT_ELIM(REWRITE_CONV[correct; WP_SEQ] (mk_eq(w,w'))) in GEN_REWRITE_TAC I [th] gl in fun (asl,w) -> let cptm,q = dest_comb w in let cpt,ptm = dest_comb cptm in let ctm,p = dest_comb cpt in let ptms = strip_seq ptm in let seq = rator(rator ptm) in try let atm = find is_assert ptms in let i = index atm ptms in if i = 0 then let ptm' = mk_binop seq (hd ptms) (list_mk_binop seq (tl ptms)) in (ADJUST_TAC ptm ptm' THEN MATCH_MP_TAC VC_SEQ_ASSERT_LEFT THEN CONJ_TAC THENL [VC_UNPACK_TAC; ALL_TAC]) (asl,w) else if i = length ptms - 1 then let ptm' = mk_binop seq (list_mk_binop seq (butlast ptms)) (last ptms) in (ADJUST_TAC ptm ptm' THEN MATCH_MP_TAC VC_SEQ_ASSERT_RIGHT THEN CONJ_TAC THENL [ALL_TAC; VC_UNPACK_TAC]) (asl,w) else let l,mr = chop_list (index atm ptms) ptms in let ptm' = mk_binop seq (list_mk_binop seq l) (mk_binop seq (hd mr) (list_mk_binop seq (tl mr))) in (ADJUST_TAC ptm ptm' THEN MATCH_MP_TAC VC_SEQ_ASSERT_MIDDLE THEN CONJ_TAC) (asl,w) with Failure "find" -> try if is_assign (hd ptms) then let ptm' = mk_binop seq (hd ptms) (list_mk_binop seq (tl ptms)) in (ADJUST_TAC ptm ptm' THEN MATCH_MP_TAC VC_SEQ_ASSIGN_LEFT THEN REPEAT CONJ_TAC THENL [SIDE_TAC; SIDE_TAC; ALL_TAC]) (asl,w) else fail() with Failure _ -> let ptm' = mk_binop seq (list_mk_binop seq (butlast ptms)) (last ptms) in let pwp = find_pwp (rand ptm') q in (ADJUST_TAC ptm ptm' THEN MATCH_MP_TAC CORRECT_SEQ THEN EXISTS_TAC pwp THEN CONJ_TAC) (asl,w);; (* ------------------------------------------------------------------------- *) (* Tactic to apply a 1-step VC generation. *) (* ------------------------------------------------------------------------- *) let VC_STEP_TAC = let tacnet = itlist (enter []) [`correct p SKIP q`, MATCH_MP_TAC VC_SKIP THEN VC_UNPACK_TAC; `correct p (ASSERT b) q`, MATCH_MP_TAC VC_ASSERT THEN VC_UNPACK_TAC; `correct p (Assign f) q`, MATCH_MP_TAC VC_ASSIGN THEN VC_UNPACK_TAC; `correct p (Ite e c1 c2) q`, MATCH_MP_TAC VC_ITE THEN CONJ_TAC; `correct p (IF e c) q`, MATCH_MP_TAC VC_IF THEN CONJ_TAC THENL [ALL_TAC; VC_UNPACK_TAC]; `correct p (AWHILE i (MEASURE m) e c) q`, MATCH_MP_TAC VC_AWHILE_MEASURE THEN REPEAT CONJ_TAC THENL [VC_UNPACK_TAC; VC_UNPACK_TAC; GEN_TAC]; `correct p (AWHILE i v e c) q`, MATCH_MP_TAC VC_AWHILE_VARIANT THEN REPEAT CONJ_TAC THENL [ALL_TAC; VC_UNPACK_TAC; VC_UNPACK_TAC; STATE_GEN_TAC']; `correct p (ADO i (MEASURE m) c e) q`, MATCH_MP_TAC VC_ADO_MEASURE THEN REPEAT CONJ_TAC THENL [VC_UNPACK_TAC; VC_UNPACK_TAC; STATE_GEN_TAC']; `correct p (ADO i v c e) q`, MATCH_MP_TAC VC_ADO_VARIANT THEN REPEAT CONJ_TAC THENL [ALL_TAC; VC_UNPACK_TAC; VC_UNPACK_TAC; STATE_GEN_TAC']; `correct p (c1 Seq c2) q`, VC_SEQ_TAC] empty_net in fun (asl,w) -> FIRST(lookup w tacnet) (asl,w);; (* ------------------------------------------------------------------------- *) (* Final packaging to strip away the program completely. *) (* ------------------------------------------------------------------------- *) let VC_TAC = REPEAT VC_STEP_TAC;; (* ------------------------------------------------------------------------- *) (* Some examples. *) (* ------------------------------------------------------------------------- *) install_parser ("correct",parse_program_assertion);; let EXAMPLE_FACTORIAL = prove (`correct T var x,y,n; x := 0; y := 1; while x < n do [invariant x <= n /\ (y = FACT x); measure n - x] (x := x + 1; y := y * x) end y = FACT n`, VC_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[FACT; LE_0]; REWRITE_TAC[CONJ_ASSOC; NOT_LT; LE_ANTISYM] THEN MESON_TAC[]; REWRITE_TAC[GSYM ADD1; FACT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[MULT_AC] THEN UNDISCH_TAC `x < n` THEN ARITH_TAC]);; delete_parser "correct";; hol-light/Examples/prover9.ml000066400000000000000000000570261303454263000164750ustar00rootroot00000000000000(* ========================================================================= *) (* Interface to prover9. *) (* ========================================================================= *) (**** NB: this is the "prover9" command invoked by HOL Light. **** If this doesn't work, set an explicit path to the prover9 binary ****) let prover9 = "prover9";; (* ------------------------------------------------------------------------- *) (* Debugging mode (true = keep the Prover9 input and output files) *) (* ------------------------------------------------------------------------- *) let prover9_debugging = ref false;; (* ------------------------------------------------------------------------- *) (* Prover9 options. Set to "" for the Prover9 default. *) (* ------------------------------------------------------------------------- *) let prover9_options = ref ("clear(auto_inference).\n"^ "clear(auto_denials).\n"^ "clear(auto_limits).\n"^ "set(neg_binary_resolution).\n"^ "set(binary_resolution).\n"^ "set(paramodulation).\n");; (* ------------------------------------------------------------------------- *) (* Find the variables, functions, and predicates excluding equality. *) (* ------------------------------------------------------------------------- *) let rec functions fvs tm (vacc,facc,racc as acc) = if is_var tm then if mem tm fvs then (vacc,insert tm facc,racc) else (insert tm vacc,facc,racc) else if is_abs tm then acc else let f,args = strip_comb tm in itlist (functions fvs) args (vacc,insert f facc,racc);; let rec signature fvs tm (vacc,facc,racc as acc) = if is_neg tm then signature fvs (rand tm) acc else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then signature fvs (lhand tm) (signature fvs (rand tm) acc) else if is_forall tm || is_exists tm || is_uexists tm then signature fvs (body(rand tm)) acc else if is_eq tm then functions fvs (lhand tm) (functions fvs (rand tm) acc) else if is_abs tm then acc else let r,args = strip_comb tm in itlist (functions fvs) args (vacc,facc,insert r racc);; (* ------------------------------------------------------------------------- *) (* Shadow first-order syntax. Literal sign is true = positive. *) (* ------------------------------------------------------------------------- *) type folterm = Variable of string | Function of string * folterm list;; type literal = Literal of bool * string * folterm list;; (* ------------------------------------------------------------------------- *) (* Translate clause into shadow syntax. *) (* ------------------------------------------------------------------------- *) let rec translate_term (trans_var,trans_fun,trans_rel as trp) tm = let f,args = strip_comb tm in if defined trans_fun f then Function(apply trans_fun f,map (translate_term trp) args) else if is_var tm then Variable(apply trans_var tm) else failwith("unknown function"^ (try fst(dest_const tm) with Failure _ -> "??"));; let translate_atom (trans_var,trans_fun,trans_rel as trp) tm = if is_eq tm then Literal(true,"=",[translate_term trp (lhand tm); translate_term trp (rand tm)]) else let r,args = strip_comb tm in Literal(true,apply trans_rel r,map (translate_term trp) args);; let rec translate_clause trp tm = if is_disj tm then translate_clause trp (lhand tm) @ translate_clause trp (rand tm) else if is_neg tm then let Literal(s,r,args) = translate_atom trp (rand tm) in [Literal(not s,r,args)] else [translate_atom trp tm];; (* ------------------------------------------------------------------------- *) (* Create Prover9 input file for a set of clauses. *) (* ------------------------------------------------------------------------- *) let rec prover9_of_term tm = match tm with Variable(s) -> s | Function(f,[]) -> f | Function(f,args) -> f^"("^ end_itlist (fun s t -> s^","^t) (map prover9_of_term args) ^ ")";; let prover9_of_literal lit = match lit with Literal(s,r,[]) -> if s then r else "-"^r | Literal(s,"=",[l;r]) -> (if s then "(" else "-(")^ (prover9_of_term l) ^ " = " ^ (prover9_of_term r)^")" | Literal(s,r,args) -> (if s then "" else "-")^r^"("^ end_itlist (fun s t -> s^","^t) (map prover9_of_term args) ^ ")";; let rec prover9_of_clause cls = match cls with [] -> failwith "prover9_of_clause: empty clause" | [l] -> prover9_of_literal l | l::ls -> prover9_of_literal l ^ " | " ^ prover9_of_clause ls;; (* ------------------------------------------------------------------------- *) (* Parse S-expressions. *) (* ------------------------------------------------------------------------- *) type sexp = Atom of string | List of sexp list;; let atom inp = match inp with Resword "("::rst -> raise Noparse | Resword ")"::rst -> raise Noparse | Resword s::rst -> Atom s,rst | Ident s::rst -> Atom s,rst | [] -> raise Noparse;; let rec sexpression inp = ( atom ||| (a (Resword "(") ++ many sexpression ++ a (Resword ")") >> (fun ((_,l),_) -> List l))) inp;; (* ------------------------------------------------------------------------- *) (* Skip to beginning of proof object. *) (* ------------------------------------------------------------------------- *) let rec skipheader i s = if String.sub s i 28 = ";; BEGINNING OF PROOF OBJECT" then String.sub s (i + 28) (String.length s - i - 28) else skipheader (i + 1) s;; (* ------------------------------------------------------------------------- *) (* Parse a proof step. *) (* ------------------------------------------------------------------------- *) let parse_proofstep ps = match ps with List[Atom id; just; formula; Atom "NIL"] -> (id,just,formula) | _ -> failwith "unexpected proofstep";; (* ------------------------------------------------------------------------- *) (* Convert sexp representation of formula to shadow syntax. *) (* ------------------------------------------------------------------------- *) let rec folterm_of_sexp sexp = match sexp with Atom(s) when String.sub s 0 1 = "v" -> Variable s | Atom(s) -> Function(s,[]) | List(Atom f::args) -> Function(f,map folterm_of_sexp args) | _ -> failwith "folterm_of_sexp: malformed sexpression term representation";; let folatom_of_sexp sexp = match sexp with Atom(r) -> Literal(true,r,[]) | List(Atom r::args) -> Literal(true,r,map folterm_of_sexp args) | _ -> failwith "folatom_of_sexp: malformed sexpression atom representation";; let folliteral_of_sexp sexp = match sexp with List[Atom "not";sex] -> let Literal(s,r,args) = folatom_of_sexp sex in Literal(not s,r,args) | _ -> folatom_of_sexp sexp;; let rec folclause_of_sexp sexp = match sexp with List[Atom "or";sex1;sex2] -> folclause_of_sexp sex1 @ folclause_of_sexp sex2 | _ -> [folliteral_of_sexp sexp];; (* ------------------------------------------------------------------------- *) (* Convert shadow syntax back into HOL (sometimes given expected type). *) (* Make a crude type postcorrection for equations between variables based *) (* on their types in other terms, if applicable. *) (* It might be nicer to use preterms to get a systematic use of context, but *) (* this is a pretty simple problem. *) (* ------------------------------------------------------------------------- *) let rec hol_of_folterm (btrans_fun,btrans_rel as trp) ty tm = match tm with Variable(x) -> variant (ran btrans_fun) (mk_var(x,ty)) | Function(fs,args) -> let f = apply btrans_fun fs in let tys,rty = nsplit dest_fun_ty args (type_of f) in list_mk_comb(f,map2 (hol_of_folterm trp) tys args);; let hol_of_folliteral (btrans_fun,btrans_rel as trp) lit = match lit with Literal(s,"false",[]) -> if s then mk_const("F",[]) else mk_neg(mk_const("F",[])) | Literal(s,"=",[l;r]) -> let tml_prov = hol_of_folterm trp aty l and tmr_prov = hol_of_folterm trp aty r in let ty = if type_of tml_prov <> aty then type_of tml_prov else if type_of tmr_prov <> aty then type_of tmr_prov else aty in let ptm = mk_eq(hol_of_folterm trp ty l,hol_of_folterm trp ty r) in if s then ptm else mk_neg ptm | Literal(s,rs,args) -> let r = apply btrans_rel rs in let tys,rty = nsplit dest_fun_ty args (type_of r) in let ptm = list_mk_comb(r,map2 (hol_of_folterm trp) tys args) in if s then ptm else mk_neg ptm;; let is_truevar (bf,_) tm = is_var tm && not(mem tm (ran bf));; let rec hol_of_folclause trp cls = match cls with [] -> mk_const("F",[]) | [c] -> hol_of_folliteral trp c | c::cs -> let rawcls = map (hol_of_folliteral trp) cls in let is_truevar tm = is_var tm & not(mem tm (ran(fst trp))) & not(mem tm (ran(snd trp))) in let und,dec = partition (fun t -> is_eq t && is_truevar(lhs t) && is_truevar(rhs t)) rawcls in if und = [] || dec = [] then list_mk_disj rawcls else let cxt = map dest_var (filter is_truevar (freesl dec)) in let correct t = try let l,r = dest_eq t in let ls = fst(dest_var l) and rs = fst(dest_var r) in let ty = try assoc ls cxt with Failure _ -> assoc rs cxt in mk_eq(mk_var(ls,ty),mk_var(rs,ty)) with Failure _ -> t in list_mk_disj(map correct rawcls);; (* ------------------------------------------------------------------------- *) (* Composed map from sexp to HOL items. *) (* ------------------------------------------------------------------------- *) let hol_of_term trp ty sexp = hol_of_folterm trp ty (folterm_of_sexp sexp);; let hol_of_literal trp sexp = hol_of_folliteral trp (folliteral_of_sexp sexp);; let hol_of_clause trp sexp = hol_of_folclause trp (folclause_of_sexp sexp);; (* ------------------------------------------------------------------------- *) (* Follow paramodulation path *) (* ------------------------------------------------------------------------- *) let rec PARA_SUBS_CONV path eth tm = match path with [] -> if lhs(concl eth) = tm then eth else failwith "PARA_SUBS_CONV" | n::rpt -> let f,args = strip_comb tm in funpow (length args - n) RATOR_CONV (RAND_CONV (PARA_SUBS_CONV rpt eth)) tm;; (* ------------------------------------------------------------------------- *) (* Pull forward disjunct in clause using prover9/Ivy director string. *) (* ------------------------------------------------------------------------- *) let FRONT1_DISJ_CONV = GEN_REWRITE_CONV I [TAUT `a \/ b \/ c <=> b \/ a \/ c`] ORELSEC GEN_REWRITE_CONV I [TAUT `a \/ b <=> b \/ a`];; let rec FRONT_DISJ_CONV l tm = match l with [] | ((Atom "1")::_) -> REFL tm | (Atom "2")::t -> (RAND_CONV (FRONT_DISJ_CONV t) THENC FRONT1_DISJ_CONV) tm | _ -> failwith "unexpected director string in clause";; (* ------------------------------------------------------------------------- *) (* For using paramodulating equation, more convenient to put at the back. *) (* ------------------------------------------------------------------------- *) let AP_IMP = let pp = MATCH_MP(TAUT `(a ==> b) ==> !x. x \/ a ==> x \/ b`) in fun t -> SPEC t o pp;; let rec PARA_BACK_CONV eqdir tm = match eqdir with [Atom "1"] when not(is_disj tm) -> REFL tm | [Atom "2"] when not(is_disj tm) -> SYM_CONV tm | Atom "2"::eqs -> RAND_CONV (PARA_BACK_CONV eqs) tm | [Atom "1"; Atom f] when is_disj tm -> let th1 = if f = "2" then LAND_CONV SYM_CONV tm else REFL tm in let tm' = rand(concl th1) in let djs = disjuncts tm' in let th2 = DISJ_ACI_RULE(mk_eq(tm',list_mk_disj(tl djs @ [hd djs]))) in TRANS th1 th2 | _ -> failwith "PARA_BACK_CONV";; (* ------------------------------------------------------------------------- *) (* Do direct resolution on front clauses. *) (* ------------------------------------------------------------------------- *) let RESOLVE = let resrules = map (MATCH_MP o TAUT) [`a /\ ~a ==> F`; `~a /\ a ==> F`; `a /\ (~a \/ b) ==> b`; `~a /\ (a \/ b) ==> b`; `(a \/ b) /\ ~a ==> b`; `(~a \/ b) /\ a ==> b`; `(a \/ b) /\ (~a \/ c) ==> b \/ c`; `(~a \/ b) /\ (a \/ c) ==> b \/ c`] in fun th1 th2 -> let th = CONJ th1 th2 in tryfind (fun f -> f th) resrules;; (* ------------------------------------------------------------------------- *) (* AC rearrangement of disjunction but maybe correcting proforma types in *) (* the target term for equations between variables. *) (* ------------------------------------------------------------------------- *) let ACI_CORRECT th tm = try EQ_MP (DISJ_ACI_RULE(mk_eq(concl th,tm))) th with Failure _ -> let cxt = map dest_var (frees(concl th)) in let rec correct t = if is_disj t then mk_disj(correct(lhand t),correct(rand t)) else if is_neg t then mk_neg(correct(rand t)) else (try let l,r = dest_eq t in let ls = fst(dest_var l) and rs = fst(dest_var r) in let ty = try assoc ls cxt with Failure _ -> assoc rs cxt in mk_eq(mk_var(ls,ty),mk_var(rs,ty)) with Failure _ -> t) in let tm' = correct tm in EQ_MP (DISJ_ACI_RULE(mk_eq(concl th,tm'))) th;; (* ------------------------------------------------------------------------- *) (* Process proof step. *) (* ------------------------------------------------------------------------- *) let rec PROVER9_PATH_CONV l conv = match l with Atom "2"::t -> RAND_CONV(PROVER9_PATH_CONV t conv) | Atom "1"::t -> LAND_CONV(PROVER9_PATH_CONV t conv) | [] -> conv | _ -> failwith "PROVER9_PATH_CONV:unknown path";; let PROVER9_FLIP_CONV tm = if is_neg tm then RAND_CONV SYM_CONV tm else SYM_CONV tm;; let process_proofstep ths trp asms (lab,just,fm) = let tm = hol_of_clause trp fm in match just with List[Atom "input"] -> if is_eq tm && lhs tm = rhs tm then REFL(rand tm) else tryfind (fun th -> PART_MATCH I th tm) ths | List[Atom "flip"; Atom n; List path] -> let th = apply asms n in let nth = CONV_RULE(PROVER9_PATH_CONV path PROVER9_FLIP_CONV) th in if concl nth = tm then nth else failwith "Inconsistency from flip" | List[Atom "instantiate"; Atom "0"; List[List[x;Atom".";y]]] -> let th = REFL(hol_of_term trp aty y) in if concl th = tm then th else failwith "Inconsistency from instantiation of reflexivity" | List[Atom "instantiate"; Atom n; List i] -> let th = apply asms n and ilist = map (fun (List[Atom x;Atom"."; y]) -> (y,x)) i in let xs = map (fun (y,x) -> find_term (fun v -> is_var v && fst(dest_var v) = x) (concl th)) ilist in let ys = map2 (fun (y,x) v -> hol_of_term trp (type_of v) y) ilist xs in INST (zip ys xs) th | List[Atom "paramod"; Atom eqid; List eqdir; Atom tmid; List dir] -> let eth = CONV_RULE (PARA_BACK_CONV eqdir) (apply asms eqid) and tth = apply asms tmid and path = (map (fun (Atom s) -> int_of_string s) dir) in let etm = concl eth in let th = if is_disj etm then let djs = disjuncts etm in let eq = last djs in let fth = CONV_RULE (PARA_SUBS_CONV path (ASSUME eq)) tth in MP (itlist AP_IMP (butlast djs) (DISCH eq fth)) eth else CONV_RULE(PARA_SUBS_CONV path eth) tth in if concl th = tm then th else failwith "Inconsistency from paramodulation" | List[Atom "resolve"; Atom l1; List path1; Atom l2; List path2] -> let th1 = CONV_RULE (FRONT_DISJ_CONV path1) (apply asms l1) and th2 = CONV_RULE (FRONT_DISJ_CONV path2) (apply asms l2) in let th3 = RESOLVE th1 th2 in ACI_CORRECT th3 tm | List[Atom "propositional"; Atom l] -> let th1 = apply asms l in ACI_CORRECT th1 tm | _ -> failwith "process_proofstep: no translation";; let rec process_proofsteps ths trp asms steps = match steps with [] -> asms,[] | ((lab,_,_) as st)::sts -> (try let th = process_proofstep ths trp asms st in process_proofsteps ths trp ((lab |-> th) asms) sts with _ -> asms,steps);; (* ------------------------------------------------------------------------- *) (* Main refutation procedure for clauses *) (* ------------------------------------------------------------------------- *) let PROVER9_REFUTE ths = let fvs = itlist (fun th -> union (freesl(hyp th))) ths [] in let fovars,functions,relations = signature fvs (end_itlist (curry mk_conj) (map concl ths)) ([],[],[]) in let trans_var = itlist2 (fun f n -> f |-> "x"^string_of_int n) fovars (1--length fovars) undefined and trans_fun = itlist2 (fun f n -> f |-> "f"^string_of_int n) functions (1--length functions) undefined and trans_rel = itlist2 (fun f n -> f |-> "R"^string_of_int n) relations (1--length relations) undefined in let cls = map (translate_clause (trans_var,trans_fun,trans_rel) o concl) ths in let p9cls = map (fun c -> prover9_of_clause c ^".\n") cls in let p9str = "clear(bell).\n"^ !prover9_options ^ "formulas(sos).\n"^ itlist (^) p9cls "end_of_list.\n" in let filename_in = Filename.temp_file "prover9" ".in" and filename_out = Filename.temp_file "prover9" ".out" in let _ = file_of_string filename_in p9str in let retcode = Sys.command (prover9 ^ " -f " ^ filename_in ^ " | prooftrans ivy >" ^ filename_out) in if retcode <> 0 then failwith "Prover9 call apparently failed" else let p9proof = string_of_file filename_out in let _ = if !prover9_debugging then () else (ignore(Sys.remove filename_in); ignore(Sys.remove filename_out)) in let List sexps,unp = sexpression(lex(explode(skipheader 0 p9proof))) in (if unp <> [Ident ";;"; Ident "END"; Ident "OF"; Ident "PROOF"; Ident "OBJECT"] then (Format.print_string "Unexpected proof object tail"; Format.print_newline()) else ()); let btrans_fun = itlist (fun (x,y) -> y |-> x) (graph trans_fun) undefined and btrans_rel = itlist (fun (x,y) -> y |-> x) (graph trans_rel) undefined and proof = map parse_proofstep sexps in let asms,undone = process_proofsteps ths (btrans_fun,btrans_rel) undefined proof in find (fun th -> concl th = mk_const("F",[])) (map snd (graph asms));; (* ------------------------------------------------------------------------- *) (* Hence a prover. *) (* ------------------------------------------------------------------------- *) let PROVER9 = let prule = MATCH_MP(TAUT `(~p ==> F) ==> p`) and false_tm = `F` and true_tm = `T` in let init_conv = TOP_DEPTH_CONV BETA_CONV THENC PRESIMP_CONV THENC CONDS_ELIM_CONV THENC NNFC_CONV THENC CNF_CONV THENC DEPTH_BINOP_CONV `(/\)` (SKOLEM_CONV THENC PRENEX_CONV) THENC GEN_REWRITE_CONV REDEPTH_CONV [RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THENC GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM DISJ_ASSOC] THENC GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM CONJ_ASSOC] in fun tm -> let tm' = mk_neg tm in let ith = init_conv tm' in let itm = rand(concl ith) in if itm = true_tm then failwith "PROVER9: formula is trivially false" else if itm = false_tm then prule(fst(EQ_IMP_RULE ith)) else let evs,bod = strip_exists itm in let ths = map SPEC_ALL (CONJUNCTS(ASSUME bod)) in let ths' = end_itlist (@) (map (CONJUNCTS o CONV_RULE CNF_CONV) ths) in let rth = PROVER9_REFUTE ths' in let eth = itlist SIMPLE_CHOOSE evs rth in let sth = PROVE_HYP (UNDISCH(fst(EQ_IMP_RULE ith))) eth in prule(DISCH tm' sth);; (* ------------------------------------------------------------------------- *) (* Examples. *) (* ------------------------------------------------------------------------- *) let FRIEND_0 = time PROVER9 `(!x:P. ~friend(x,x)) /\ ~(a:P = b) /\ (!x y. friend(x,y) ==> friend(y,x)) ==> (!x. ?y z. friend(x,y) /\ ~friend(x,z)) \/ (!x. ?y z. ~(y = z) /\ ~friend(x,y) /\ ~friend(x,z))`;; let FRIEND_1 = time PROVER9 `(!x:P. ~friend(x,x)) /\ a IN s /\ b IN s /\ ~(a:P = b) /\ (!x y. friend(x,y) ==> friend(y,x)) ==> (!x. x IN s ==> ?y z. y IN s /\ z IN s /\ friend(x,y) /\ ~friend(x,z)) \/ (!x. x IN s ==> ?y z. y IN s /\ z IN s /\ ~(y = z) /\ ~friend(x,y) /\ ~friend(x,z))`;; let LOS = time PROVER9 `(!x y z. P(x,y) /\ P(y,z) ==> P(x,z)) /\ (!x y z. Q(x,y) /\ Q(y,z) ==> Q(x,z)) /\ (!x y. Q(x,y) ==> Q(y,x)) /\ (!x y. P(x,y) \/ Q(x,y)) /\ ~P(a,b) /\ ~Q(c,d) ==> F`;; let CONWAY_1 = time PROVER9 `(!x. 0 + x = x) /\ (!x y. x + y = y + x) /\ (!x y z. x + (y + z) = (x + y) + z) /\ (!x. 1 * x = x) /\ (!x. x * 1 = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x. 0 * x = 0) /\ (!x. x * 0 = 0) /\ (!x y z. x * (y + z) = (x * y) + (x * z)) /\ (!x y z. (x + y) * z = (x * z) + (y * z)) /\ (!x y. star(x * y) = 1 + x * star(y * x) * y) /\ (!x y. star(x + y) = star(star(x) * y) * star(x)) ==> star(star(star(1))) = star(star(1))`;; let CONWAY_2 = time PROVER9 `(!x. 0 + x = x) /\ (!x y. x + y = y + x) /\ (!x y z. x + (y + z) = (x + y) + z) /\ (!x. 1 * x = x) /\ (!x. x * 1 = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x. 0 * x = 0) /\ (!x. x * 0 = 0) /\ (!x y z. x * (y + z) = (x * y) + (x * z)) /\ (!x y z. (x + y) * z = (x * z) + (y * z)) /\ (!x y. star(x * y) = 1 + x * star(y * x) * y) /\ (!x y. star(x + y) = star(star(x) * y) * star(x)) ==> !a. star(star(star(star(a)))) = star(star(star(a)))`;; let ECKMAN_HILTON_1 = time PROVER9 `(!x. 1 * x = x) /\ (!x. x * 1 = x) /\ (!x. 1 + x = x) /\ (!x. x + 1 = x) /\ (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) ==> !a b. a * b = a + b`;; let ECKMAN_HILTON_2 = time PROVER9 `(!x. 1 * x = x) /\ (!x. x * 1 = x) /\ (!x. 1 + x = x) /\ (!x. x + 1 = x) /\ (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) ==> !a b. a * b = b * a`;; let ECKMAN_HILTON_3 = time PROVER9 `(!x. 1 * x = x) /\ (!x. x * 1 = x) /\ (!x. 0 + x = x) /\ (!x. x + 0 = x) /\ (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) ==> !a b. a * b = b * a`;; let ECKMAN_HILTON_4 = time PROVER9 `(!x. 1 * x = x) /\ (!x. x * 1 = x) /\ (!x. 0 + x = x) /\ (!x. x + 0 = x) /\ (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) ==> !a b. a + b = a * b`;; let DOUBLE_DISTRIB = time PROVER9 `(!x y z. (x * y) * z = (x * z) * (y * z)) /\ (!x y z. z * (x * y) = (z * x) * (z * y)) ==> !a b c. (a * b) * (c * a) = (a * c) * (b * a)`;; let MOORE_PENROSE_PSEUDOINVERSE_UNIQUE = time PROVER9 `X * A * X = X /\ transpose(A * X) = A * X /\ A * X * A = A /\ transpose(X * A) = X * A /\ Y * A * Y = Y /\ transpose(A * Y) = A * Y /\ A * Y * A = A /\ transpose(Y * A) = Y * A /\ (!x y z. (x * y) * z = x * (y * z)) /\ (!x y. transpose(x * y) = transpose(y) * transpose(x)) ==> X = Y`;; hol-light/Examples/rectypes.ml000066400000000000000000000370121303454263000167160ustar00rootroot00000000000000(* ========================================================================= *) (* Some (mutually, nested) recursive types from various sources. *) (* ========================================================================= *) time define_type "Term = Var A B | App bool Termlist; Termlist = Empty | Consp Term Termlist";; time define_type "List = Nil | Cons A List";; time define_type "Btree = Leaf A | Node B Btree Btree";; time define_type "Command = Assign ind Expression | If Expression Command | Ite Expression Command Command | While Expression Command | Do Command Expression; Expression = Constant num | Variable ind | Summ Expression Expression | Product Expression Expression";; time define_type "testa = empty_testa | cons_testa testa testb; testb = contentb L testc; testc = connection M testa";; time define_type "atexp = Varb ind | Let dec exp; exp = Exp1 atexp | Exp2 exp atexp | Exp3 matching; matching = Match1 rule | Matches rule matching; rule = Rule pat exp; dec = Val valbind | Local dec dec | Decs dec dec; valbind = Single pat exp | Multi pat exp valbind | Rec valbind; pat = Wild | Varpat ind";; time define_type "tri = ONE | TWO | THREE";; (* ------------------------------------------------------------------------- *) (* A couple from Steve Brackin's work. *) (* ------------------------------------------------------------------------- *) time define_type "T = X1 | X2 | X3 | X4 | X5 | X6 | X7 | X8 | X9 | X10 | X11 | X12 | X13 | X14 | X15 | X16 | X17 | X18 | X19 | X20 | X21 | X22 | X23 | X24 | X25 | X26 | X27 | X28 | X29 | X30 | X31 | X32 | X33 | X34";; time define_type "TY1 = NoF__ | Fk__ A TY2; TY2 = Ta__ bool | Td__ bool | Tf__ TY1 | Tk__ bool | Tp__ bool | App__ A TY1 TY2 TY3 | Pair__ TY2 TY2; TY3 = NoS__ | Fresh__ TY2 | Trustworthy__ A | PrivateKey__ A B C | PublicKey__ A B C | Conveyed__ A TY2 | Possesses__ A TY2 | Received__ A TY2 | Recognizes__ A TY2 | NeverMalFromSelf__ A B TY2 | Sends__ A TY2 B | SharedSecret__ A TY2 B | Believes__ A TY3 | And__ TY3 TY3";; (* ------------------------------------------------------------------------- *) (* Some with nesting of various kinds, plus required auxiliaries. *) (* ------------------------------------------------------------------------- *) let term_INDUCTION,term_RECURSION = time define_type "term = Vari int | Fni int (term list)";; let bintree_INDUCTION,bintree_RECURSION = time define_type "bintree = Leafb | Branchb (bintree # bintree)";; let etree_INDUCTION,etree_RECURSION = time define_type "etree = Terminal | Nonterminal (num + etree)";; let ptree_INDUCTION,ptree_RECURSION = time define_type "ptree = Only (ptree option)";; let mut_INDUCTION,mut_RECURSION = time define_type "mutual = Mutual A mutual D otherone | Friend D otherone; otherone = Great C | Expectations mutual otherone";; let groof_INDUCTION,groof_RECURSION = time define_type "groof = Wu bool | Wibble (A,groof,L)mutual | Wobble groof groof";; let biterm_INDUCTION,biterm_RECURSION = time define_type "biterm = Variab int | Fnapp (biterm list + biterm list)";; let triterm_INDUCTION,triterm_RECURSION = time define_type "triterm = Var0 int | Fun2 (triterm list + triterm list) | Fun1 (triterm list)";; let xtree_INDUCTION,xtree_RECURSION = time define_type "xtree = Leafx A | Branchx (xtree list)";; let simper_INDUCTION,simper_RECURSION = time define_type "simper = Leaves A B | Bough (simper xtree)";; let array_INDUCTION,array_RECURSION = time define_type "array = Array num (A list)";; let value_INDUCTION,value_RECURSION = time define_type "value = Integer num | Boolean bool | List_of (value list) | Tree_of (value xtree) | Array_of (value array)";; let example_INDUCTION,example_RECURSION = time define_type "command = Assignment (num list # expression list) | Sequence (command list); expression = Numeral num | Plus (expression # expression) | Valof command";; let zonk_INDUCTION,zonk_RECURSION = time define_type "zonk = Stonk ((zonk,pink,A)mutual)list # expression | Tonk zonk (pink list) | Honk num; pink = Floyd (zonk # pink) | Purple num | Rain (A # pink)";; (* ------------------------------------------------------------------------- *) (* Example from Konrad Slind: 68000 instruction set. *) (* ------------------------------------------------------------------------- *) time define_type "Size = Byte | Word | Long";; time define_type "DataRegister = RegD0 | RegD1 | RegD2 | RegD3 | RegD4 | RegD5 | RegD6 | RegD7";; time define_type "AddressRegister = RegA0 | RegA1 | RegA2 | RegA3 | RegA4 | RegA5 | RegA6 | RegA7";; time define_type "DataOrAddressRegister = data DataRegister | address AddressRegister";; time define_type "Condition = Hi | Ls | Cc | Cs | Ne | Eq | Vc | Vs | Pl | Mi | Ge | Lt | Gt | Le";; time define_type "AddressingMode = immediate num | direct DataOrAddressRegister | indirect AddressRegister | postinc AddressRegister | predec AddressRegister | indirectdisp num AddressRegister | indirectindex num AddressRegister DataOrAddressRegister Size | absolute num | pcdisp num | pcindex num DataOrAddressRegister Size";; time define_type "M68kInstruction = ABCD AddressingMode AddressingMode | ADD Size AddressingMode AddressingMode | ADDA Size AddressingMode AddressRegister | ADDI Size num AddressingMode | ADDQ Size num AddressingMode | ADDX Size AddressingMode AddressingMode | AND Size AddressingMode AddressingMode | ANDI Size num AddressingMode | ANDItoCCR num | ANDItoSR num | ASL Size AddressingMode DataRegister | ASLW AddressingMode | ASR Size AddressingMode DataRegister | ASRW AddressingMode | Bcc Condition Size num | BTST Size AddressingMode AddressingMode | BCHG Size AddressingMode AddressingMode | BCLR Size AddressingMode AddressingMode | BSET Size AddressingMode AddressingMode | BRA Size num | BSR Size num | CHK AddressingMode DataRegister | CLR Size AddressingMode | CMP Size AddressingMode DataRegister | CMPA Size AddressingMode AddressRegister | CMPI Size num AddressingMode | CMPM Size AddressRegister AddressRegister | DBT DataRegister num | DBF DataRegister num | DBcc Condition DataRegister num | DIVS AddressingMode DataRegister | DIVU AddressingMode DataRegister | EOR Size DataRegister AddressingMode | EORI Size num AddressingMode | EORItoCCR num | EORItoSR num | EXG DataOrAddressRegister DataOrAddressRegister | EXT Size DataRegister | ILLEGAL | JMP AddressingMode | JSR AddressingMode | LEA AddressingMode AddressRegister | LINK AddressRegister num | LSL Size AddressingMode DataRegister | LSLW AddressingMode | LSR Size AddressingMode DataRegister | LSRW AddressingMode | MOVE Size AddressingMode AddressingMode | MOVEtoCCR AddressingMode | MOVEtoSR AddressingMode | MOVEfromSR AddressingMode | MOVEtoUSP AddressingMode | MOVEfromUSP AddressingMode | MOVEA Size AddressingMode AddressRegister | MOVEMto Size AddressingMode DataOrAddressRegister list | MOVEMfrom Size DataOrAddressRegister list AddressingMode | MOVEP Size AddressingMode AddressingMode | MOVEQ num DataRegister | MULS AddressingMode DataRegister | MULU AddressingMode DataRegister | NBCD AddressingMode | NEG Size AddressingMode | NEGX Size AddressingMode | NOP | NOT Size AddressingMode | OR Size AddressingMode AddressingMode | ORI Size num AddressingMode | ORItoCCR num | ORItoSR num | PEA AddressingMode | RESET | ROL Size AddressingMode DataRegister | ROLW AddressingMode | ROR Size AddressingMode DataRegister | RORW AddressingMode | ROXL Size AddressingMode DataRegister | ROXLW AddressingMode | ROXR Size AddressingMode DataRegister | ROXRW AddressingMode | RTE | RTR | RTS | SBCD AddressingMode AddressingMode | ST AddressingMode | SF AddressingMode | Scc Condition AddressingMode | STOP num | SUB Size AddressingMode AddressingMode | SUBA Size AddressingMode AddressingMode | SUBI Size num AddressingMode | SUBQ Size num AddressingMode | SUBX Size AddressingMode AddressingMode | SWAP DataRegister | TAS AddressingMode | TRAP num | TRAPV | TST Size AddressingMode | UNLK AddressRegister";; (* ------------------------------------------------------------------------- *) (* Example from Myra VanInwegen: part of the syntax of SML. *) (* ------------------------------------------------------------------------- *) let string_INDUCTION,string_RECURSION = time define_type "string = EMPTY_STRING | CONS_STRING num string";; let strid_INDUCTION,strid_RECURSION = time define_type "strid = STRID string; var = VAR string; con = CON string; scon = SCINT int | SCSTR string; excon = EXCON string; label = LABEL string";; let nonemptylist_INDUCTION,nonemptylist_RECURSION = time define_type "nonemptylist = Head_and_tail A (A list)";; let long_INDUCTION,long_RECURSION = time define_type "long = BASE A | QUALIFIED strid long";; let myra_INDUCTION,myra_RECURSION = time define_type "atpat_e = WILDCARDatpat_e | SCONatpat_e scon | VARatpat_e var | CONatpat_e (con long) | EXCONatpat_e (excon long) | RECORDatpat_e (patrow_e option) | PARatpat_e pat_e; patrow_e = DOTDOTDOT_e | PATROW_e label pat_e (patrow_e option); pat_e = ATPATpat_e atpat_e | CONpat_e (con long) atpat_e | EXCONpat_e (excon long) atpat_e | LAYEREDpat_e var pat_e; conbind_e = CONBIND_e con (conbind_e option); datbind_e = DATBIND_e conbind_e (datbind_e option); exbind_e = EXBIND1_e excon (exbind_e option) | EXBIND2_e excon (excon long) (exbind_e option); atexp_e = SCONatexp_e scon | VARatexp_e (var long) | CONatexp_e (con long) | EXCONatexp_e (excon long) | RECORDatexp_e (exprow_e option) | LETatexp_e dec_e exp_e | PARatexp_e exp_e; exprow_e = EXPROW_e label exp_e (exprow_e option); exp_e = ATEXPexp_e atexp_e | APPexp_e exp_e atexp_e | HANDLEexp_e exp_e match_e | RAISEexp_e exp_e | FNexp_e match_e; match_e = MATCH_e mrule_e (match_e option); mrule_e = MRULE_e pat_e exp_e; dec_e = VALdec_e valbind_e | DATATYPEdec_e datbind_e | ABSTYPEdec_e datbind_e dec_e | EXCEPTdec_e exbind_e | LOCALdec_e dec_e dec_e | OPENdec_e ((strid long) nonemptylist) | EMPTYdec_e | SEQdec_e dec_e dec_e; valbind_e = PLAINvalbind_e pat_e exp_e (valbind_e option) | RECvalbind_e valbind_e";; (* ------------------------------------------------------------------------- *) (* Example from Daryl Stewart: a Verilog grammar. *) (* ------------------------------------------------------------------------- *) let daryl_INDUCTION,daryl_RECURSION = time define_type "Source_text = module string (string list) (Module_item list) | Source_textMeta string; Module_item = declaration Declaration | initial Statement | always Statement | assign Lvalue Exprn | Module_itemMeta string; Declaration = reg_declaration (Range option) (string list) | net_declaration (Range option) (string list) | input_declaration (Range option) (string list) | output_declaration (Range option) (string list) | DeclarationMeta string; Range = range Exprn Exprn | RangeMeta string; Statement = clock_statement Clock Statement_or_null | blocking_assignment Lvalue Exprn | non_blocking_assignment Lvalue Exprn | conditional_statement Exprn Statement_or_null (Statement_or_null option) | case_statement Exprn (Case_item list) | while_loop Exprn Statement | repeat_loop Exprn Statement | for_loop Lvalue Exprn Exprn Lvalue Exprn Statement | forever_loop Statement | disable string | seq_block (string option) (Statement list) | StatementMeta string; Statement_or_null = statement Statement | null_statement | Statement_or_nullMeta string; Clock = posedge string | negedge string | clock string | ClockMeta string; Case_item = case_item (Exprn list) Statement_or_null | default_case_item Statement_or_null | Case_itemMeta string; Exprn = plus Exprn Exprn | minus Exprn Exprn | lshift Exprn Exprn | rshift Exprn Exprn | lt Exprn Exprn | leq Exprn Exprn | gt Exprn Exprn | geq Exprn Exprn | logeq Exprn Exprn | logneq Exprn Exprn | caseeq Exprn Exprn | caseneq Exprn Exprn | bitand Exprn Exprn | bitxor Exprn Exprn | bitor Exprn Exprn | logand Exprn Exprn | logor Exprn Exprn | conditional Exprn Exprn Exprn | positive Primary | negative Primary | lognot Primary | bitnot Primary | reducand Primary | reducxor Primary | reducor Primary | reducnand Primary | reducxnor Primary | reducnor Primary | primary Primary | ExpressionMeta string; Primary = primary_number Number | primary_IDENTIFIER string | primary_bit_select string Exprn | primary_part_select string Exprn Exprn | primary_gen_bit_select Exprn Exprn | primary_gen_part_select Exprn Exprn Exprn | primary_concatenation Concatenation | primary_multiple_concatenation Multiple_concatenation | brackets Exprn | PrimaryMeta string; Lvalue = lvalue string | lvalue_bit_select string Exprn | lvalue_part_select string Exprn Exprn | lvalue_concatenation Concatenation | LvalueMeta string; Number = decimal string | based string option string | NumberMeta string; Concatenation = concatenation (Exprn list) | ConcatenationMeta string; Multiple_concatenation = multiple_concatenation Exprn (Exprn list) | Multiple_concatenationMeta string; meta = Meta_Source_text Source_text | Meta_Module_item Module_item | Meta_Declaration Declaration | Meta_Range Range | Meta_Statement Statement | Meta_Statement_or_null Statement_or_null | Meta_Clock Clock | Meta_Case_item Case_item | Meta_Expression Exprn | Meta_Primary Primary | Meta_Lvalue Lvalue | Meta_Number Number | Meta_Concatenation Concatenation | Meta_Multiple_concatenation Multiple_concatenation";; hol-light/Examples/reduct.ml000066400000000000000000000515171303454263000163540ustar00rootroot00000000000000(* ========================================================================= *) (* General "reduction" properties of binary relations, *) (* ========================================================================= *) needs "Library/rstc.ml";; (* ------------------------------------------------------------------------- *) (* Field of a binary relation. *) (* ------------------------------------------------------------------------- *) let FL = new_definition `FL(R) x <=> (?y:A. R x y) \/ (?y. R y x)`;; (* ------------------------------------------------------------------------ *) (* Normality of a term w.r.t. a reduction relation *) (* ------------------------------------------------------------------------ *) let NORMAL = new_definition `NORMAL(R:A->A->bool) x <=> ~(?y. R x y)`;; (* ------------------------------------------------------------------------ *) (* Full Church-Rosser property. *) (* *) (* Note that we deviate from most term rewriting literature which call this *) (* the "diamond property" and calls a relation "Church-Rosser" iff its RTC *) (* has the diamond property. But this seems simpler and more natural. *) (* ------------------------------------------------------------------------ *) let CR = new_definition `CR(R:A->A->bool) <=> !x y1 y2. R x y1 /\ R x y2 ==> ?z. R y1 z /\ R y2 z`;; (* ------------------------------------------------------------------------ *) (* Weak Church-Rosser property, i.e. the rejoining may take several steps. *) (* ------------------------------------------------------------------------ *) let WCR = new_definition `WCR(R:A->A->bool) <=> !x y1 y2. R x y1 /\ R x y2 ==> ?z. RTC R y1 z /\ RTC R y2 z`;; (* ------------------------------------------------------------------------ *) (* (Weak) normalization: every term has a normal form. *) (* ------------------------------------------------------------------------ *) let WN = new_definition `WN(R:A->A->bool) <=> !x. ?y. RTC R x y /\ NORMAL(R) y`;; (* ------------------------------------------------------------------------ *) (* Strong normalization: every reduction sequence terminates (Noetherian) *) (* ------------------------------------------------------------------------ *) let SN = new_definition `SN(R:A->A->bool) <=> ~(?seq. !n. R (seq n) (seq (SUC n)))`;; (* ------------------------------------------------------------------------- *) (* Definition of a tree. *) (* ------------------------------------------------------------------------- *) let TREE = new_definition `TREE(R:A->A->bool) <=> (!y. ~(TC R y y)) /\ ?a. a IN FL(R) /\ !y. y IN FL(R) ==> (y = a) \/ TC R a y /\ ?!x. R x y`;; (* ------------------------------------------------------------------------- *) (* Local finiteness (finitely branching). *) (* ------------------------------------------------------------------------- *) let LF = new_definition `LF(R:A->A->bool) <=> !x. FINITE {y | R x y}`;; (* ------------------------------------------------------------------------- *) (* Wellfoundedness apparatus for SN relations. *) (* ------------------------------------------------------------------------- *) let SN_WF = prove (`!R:A->A->bool. SN(R) <=> WF(INV R)`, REWRITE_TAC[SN; WF_DCHAIN; INV]);; let SN_PRESERVE = prove (`!R:A->A->bool. SN(R) <=> !P. (!x. P x ==> ?y. P y /\ R x y) ==> ~(?x. P x)`, REWRITE_TAC[SN_WF; WF; INV] THEN MESON_TAC[]);; let SN_NOETHERIAN = prove (`!R:A->A->bool. SN(R) <=> !P. (!x. (!y. R x y ==> P y) ==> P x) ==> !x. P x`, REWRITE_TAC[WF_IND; SN_WF; INV]);; (* ------------------------------------------------------------------------ *) (* Normality and weak normalization is preserved by transitive closure. *) (* ------------------------------------------------------------------------ *) let NORMAL_TC = prove (`!R:A->A->bool. NORMAL(TC R) x <=> NORMAL(R) x`, REWRITE_TAC[NORMAL] THEN MESON_TAC[TC_CASES_R; TC_INC]);; let NORMAL_RTC = prove (`!R:A->A->bool. NORMAL(R) x ==> !y. RTC R x y <=> (x = y)`, ONCE_REWRITE_TAC[GSYM NORMAL_TC] THEN REWRITE_TAC[NORMAL; RTC; RC_EXPLICIT] THEN MESON_TAC[]);; let WN_TC = prove (`!R:A->A->bool. WN(TC R) <=> WN R`, REWRITE_TAC[WN; NORMAL_TC; RTC; TC_IDEMP]);; (* ------------------------------------------------------------------------- *) (* Wellfoundedness and strong normalization are too. *) (* ------------------------------------------------------------------------- *) let WF_TC = prove (`!R:A->A->bool. WF(TC R) <=> WF(R)`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[WF_SUBSET; TC_INC]; REWRITE_TAC[WF] THEN DISCH_TAC THEN X_GEN_TAC `P:A->bool` THEN FIRST_X_ASSUM(MP_TAC o SPEC `\y:A. ?z. P z /\ TC(R) z y`) THEN REWRITE_TAC[] THEN MESON_TAC[TC_CASES_L]]);; (******************* Alternative --- intuitionistic --- proof let WF_TC = prove (`!R:A->A->bool. WF(TC R) <=> WF(R)`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[WF_SUBSET; TC_INC]; REWRITE_TAC[WF_IND]] THEN DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\z:A. !u:A. TC(R) u z ==> P(u)`) THEN REWRITE_TAC[] THEN MESON_TAC[TC_CASES_L]);; let WF_TC_EXPLICIT = prove (`!R:A->A->bool. WF(R) ==> WF(TC(R))`, GEN_TAC THEN REWRITE_TAC[WF_IND] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\z:A. !u:A. TC(R) u z ==> P(u)`) THEN REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `z:A` THEN FIRST_ASSUM MATCH_MP_TAC THEN SPEC_TAC(`z:A`,`z:A`) THEN FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_TAC THEN X_GEN_TAC `u:A` THEN ONCE_REWRITE_TAC[TC_CASES_L] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_TAC THEN MATCH_MP_TAC(ASSUME `!x:A. (!y. TC R y x ==> P y) ==> P x`) THEN X_GEN_TAC `v:A` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:A` THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_THEN(X_CHOOSE_THEN `w:A` STRIP_ASSUME_TAC) THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `w:A` THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; ***********************) let SN_TC = prove (`!R:A->A->bool. SN(TC R) <=> SN R`, GEN_TAC THEN REWRITE_TAC[SN_WF; GSYM TC_INV; WF_TC]);; (* ------------------------------------------------------------------------ *) (* Strong normalization implies normalization *) (* ------------------------------------------------------------------------ *) let SN_WN = prove (`!R:A->A->bool. SN(R) ==> WN(R)`, GEN_TAC THEN REWRITE_TAC[SN_WF; WF; WN] THEN DISCH_TAC THEN X_GEN_TAC `a:A` THEN POP_ASSUM(MP_TAC o SPEC `\y:A. RTC R a y`) THEN REWRITE_TAC[INV; NORMAL] THEN MESON_TAC[RTC_REFL; RTC_TRANS_L]);; (* ------------------------------------------------------------------------ *) (* Reflexive closure preserves Church-Rosser property (pretty trivial) *) (* ------------------------------------------------------------------------ *) let RC_CR = prove (`!R:A->A->bool. CR(R) ==> CR(RC R)`, REWRITE_TAC[CR; RC_EXPLICIT] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------ *) (* The strip lemma leads us halfway to the fact that transitive x *) (* closure preserves the Church-Rosser property. It's no harder / \ *) (* to prove it for two separate reduction relations. This then / y2 *) (* allows us to prove the desired theorem simply by using the / / *) (* strip lemma twice with a bit of conjunct-swapping. y1 / *) (* \ / *) (* The diagram on the right shows the use of the variables. z *) (* ------------------------------------------------------------------------ *) let STRIP_LEMMA = prove (`!R S. (!x y1 y2. R x y1 /\ S x y2 ==> ?z:A. S y1 z /\ R y2 z) ==> (!x y1 y2. TC R x y1 /\ S x y2 ==> ?z:A. S y1 z /\ TC R y2 z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> (b ==> c)`] THEN REWRITE_TAC[GSYM RIGHT_IMP_FORALL_THM] THEN MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[TC_INC; TC_TRANS]);; (* ------------------------------------------------------------------------ *) (* Transitive closure preserves Church-Rosser property. *) (* ------------------------------------------------------------------------ *) let TC_CR = prove (`!R:A->A->bool. CR(R) ==> CR(TC R)`, GEN_TAC THEN REWRITE_TAC[CR] THEN DISCH_TAC THEN MATCH_MP_TAC STRIP_LEMMA THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN RULE_INDUCT_TAC STRIP_LEMMA THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------ *) (* Reflexive transitive closure preserves Church-Rosser property. *) (* ------------------------------------------------------------------------ *) let RTC_CR = prove (`!R:A->A->bool. CR(R) ==> CR(RTC R)`, REWRITE_TAC[RTC] THEN MESON_TAC[RC_CR; TC_CR]);; (* ------------------------------------------------------------------------ *) (* Equivalent `Church-Rosser` property for the equivalence relation. *) (* ------------------------------------------------------------------------ *) let STC_CR = prove (`!R:A->A->bool. CR(RTC R) <=> !x y. RSTC R x y ==> ?z:A. RTC R x z /\ RTC R y z`, GEN_TAC THEN REWRITE_TAC[CR] THEN EQ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC RSTC_INDUCT THEN ASM_MESON_TAC[RTC_REFL; RTC_INC; RTC_TRANS]; MESON_TAC[RSTC_INC_RTC; RSTC_SYM; RSTC_TRANS]]);; (* ------------------------------------------------------------------------ *) (* Under normalization, Church-Rosser is equivalent to uniqueness of NF *) (* ------------------------------------------------------------------------ *) let NORM_CR = prove (`!R:A->A->bool. WN(R) ==> (CR(RTC R) <=> (!x y1 y2. RTC R x y1 /\ NORMAL(R) y1 /\ RTC R x y2 /\ NORMAL(R) y2 ==> (y1 = y2)))`, GEN_TAC THEN REWRITE_TAC[CR; WN] THEN DISCH_TAC THEN EQ_TAC THENL [MESON_TAC[NORMAL_RTC]; ASM_MESON_TAC[RTC_TRANS]]);; (* ------------------------------------------------------------------------ *) (* Normalizing and Church-Rosser iff every term has a unique normal form *) (* ------------------------------------------------------------------------ *) let CR_NORM = prove (`!R:A->A->bool. WN(R) /\ CR(RTC R) <=> !x. ?!y. RTC R x y /\ NORMAL(R) y`, GEN_TAC THEN ONCE_REWRITE_TAC[EXISTS_UNIQUE_THM] THEN REWRITE_TAC[FORALL_AND_THM; GSYM WN] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP NORM_CR th]) THEN REWRITE_TAC[CONJ_ASSOC]);; (* ------------------------------------------------------------------------ *) (* Newman's lemma: weak Church-Rosser plus x *) (* strong normalization implies full Church- / \ *) (* Rosser. By the above (and SN ==> WN) it z1 z2 *) (* is sufficient to show normal forms are / | | \ *) (* unique. We use the Noetherian induction / \ / \ *) (* form of SN, so we need only prove that if / z \ *) (* some term has multiple normal forms, so / | \ *) (* does a `successor`. See the diagram on the / | \ *) (* right for the use of variables. y1 w y2 *) (* ------------------------------------------------------------------------ *) let NEWMAN_LEMMA = prove (`!R:A->A->bool. SN(R) /\ WCR(R) ==> CR(RTC R)`, GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SN_WN) THEN DISCH_THEN(fun th -> ASSUME_TAC(REWRITE_RULE[WN] th) THEN MP_TAC th) THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP NORM_CR th]) THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND; SN_WF]) THEN REWRITE_TAC[INV] THEN X_GEN_TAC `x:A` THEN REPEAT STRIP_TAC THEN MAP_EVERY UNDISCH_TAC [`RTC R (x:A) y1`; `RTC R (x:A) y2`] THEN ONCE_REWRITE_TAC[RTC_CASES_R] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `z2:A`)) THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `z1:A`)) THENL [ASM_MESON_TAC[];ASM_MESON_TAC[NORMAL];ASM_MESON_TAC[NORMAL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [WCR]) THEN ASM_MESON_TAC[RTC_TRANS]);; (* ------------------------------------------------------------------------- *) (* A variant of Koenig's lemma. *) (* ------------------------------------------------------------------------- *) let LF_TC_FINITE = prove (`!R. LF(R) /\ SN(R) ==> !x:A. FINITE {y | TC(R) x y}`, GEN_TAC THEN REWRITE_TAC[LF] THEN STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND; SN_WF; INV]) THEN GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `{y:A | TC(R) x y} = {y | R x y} UNION (UNIONS { s | ?z. R x z /\ (s = {y | TC(R) z y})})` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIONS] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[IN] THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [TC_CASES_R] THEN AP_TERM_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[FINITE_UNION; FINITE_UNIONS] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`\z:A. {y | TC R z y}`; `{z | (R:A->A->bool) x z}`] FINITE_IMAGE_EXPAND) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN; IN_ELIM_THM]; GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [IN_ELIM_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; let SN_NOLOOP = prove (`!R:A->A->bool. SN(R) ==> !z. ~(TC(R) z z)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM SN_TC] THEN SPEC_TAC(`TC(R:A->A->bool)`,`R:A->A->bool`) THEN GEN_TAC THEN REWRITE_TAC[SN_WF; INV; WF] THEN DISCH_THEN(fun th -> GEN_TAC THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `\x:A. x = z`) THEN REWRITE_TAC[] THEN MESON_TAC[]);; let RELPOW_RTC = prove (`!R:A->A->bool. !n x y. RELPOW n R x y ==> RTC(R) x y`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[RELPOW] THEN ASM_MESON_TAC[RTC_REFL; RTC_TRANS_L]);; let RTC_TC_LEMMA = prove (`!R x:A. {y:A | RTC(R) x y} = x INSERT {y:A | TC(R) x y}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN REWRITE_TAC[RTC; RC_EXPLICIT; DISJ_ACI; EQ_SYM_EQ]);; let HAS_SIZE_SUBSET = prove (`!s:A->bool t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ s SUBSET t ==> m <= n`, REWRITE_TAC[HAS_SIZE] THEN MESON_TAC[CARD_SUBSET]);; let FC_FINITE_BOUND_LEMMA = prove (`!R. (!z. ~(TC R z z)) ==> !n. {y:A | RTC(R) x y} HAS_SIZE n ==> !m y. RELPOW m R x y ==> m <= n`, REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC o REWRITE_RULE[RELPOW_SEQUENCE]) THEN SUBGOAL_THEN `!i. i <= m ==> RELPOW i R (x:A) (f i)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[RELPOW] THEN REWRITE_TAC[LE_SUC_LT] THEN ASM_MESON_TAC[LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `{z:A | ?i:num. i < m /\ (z = f i)} SUBSET {y | RTC R x y}` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[RELPOW_RTC; LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `!p. p <= m ==> {z:A | ?i. i < p /\ (z = f i)} HAS_SIZE p` (fun th -> ASSUME_TAC(MATCH_MP th (SPEC `m:num` LE_REFL))) THENL [ALL_TAC; MATCH_MP_TAC HAS_SIZE_SUBSET THEN EXISTS_TAC `{z:A | ?i. i < m /\ (z = f i)}` THEN EXISTS_TAC `{y:A | RTC(R) x y}` THEN ASM_REWRITE_TAC[]] THEN INDUCT_TAC THEN DISCH_TAC THENL [REWRITE_TAC[HAS_SIZE_0; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; LT]; ALL_TAC] THEN SUBGOAL_THEN `{z:A | ?i. i < SUC p /\ (z = f i)} = f(p) INSERT {z | ?i. i < p /\ (z = f i)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN REWRITE_TAC[LT] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE; CARD_CLAUSES; SUC_INJ] THEN SUBGOAL_THEN `{z:A | ?i. i < p /\ (z = f i)} HAS_SIZE p` MP_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `SUC p <= m` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP (CONJUNCT2 CARD_CLAUSES) th]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FINITE_INSERT] THEN UNDISCH_TAC `f p IN {z:A | ?i:num. i < p /\ (z = f i)}` THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN X_GEN_TAC `q:num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `TC(R) ((f:num->A) q) (f p)` (fun th -> ASM_MESON_TAC[th]) THEN UNDISCH_TAC `SUC p <= m` THEN UNDISCH_TAC `q < p` THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN MATCH_MP_TAC TC_INC THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `SUC (SUC q) <= m` THEN ARITH_TAC; DISCH_TAC THEN MATCH_MP_TAC TC_TRANS_L THEN EXISTS_TAC `(f:num->A)(q + SUC d)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[ADD_CLAUSES]] THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `SUC (q + SUC (SUC d)) <= m` THEN ARITH_TAC]);; let FC_FINITE_BOUND = prove (`!R (x:A). FINITE {y | RTC(R) x y} /\ (!z. ~(TC R z z)) ==> ?N. !n y. RELPOW n R x y ==> n <= N`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_TAC THEN EXISTS_TAC `CARD {y:A | RTC(R) x y}` THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP FC_FINITE_BOUND_LEMMA) THEN ASM_REWRITE_TAC[HAS_SIZE]);; let BOUND_SN = prove (`!R. (!x:A. ?N. !n y. RELPOW n R x y ==> n <= N) ==> SN(R)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SN_WF; WF_DCHAIN; INV] THEN DISCH_THEN(X_CHOOSE_TAC `f:num->A`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:num->A) 0`) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPECL [`SUC N`; `f(SUC N):A`])) THEN REWRITE_TAC[GSYM NOT_LT; LT] THEN SUBGOAL_THEN `!n. RELPOW n R (f 0 :A) (f n)` (fun th -> REWRITE_TAC[th]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[RELPOW] THEN ASM_MESON_TAC[]);; let LF_SN_BOUND = prove (`!R. LF(R) ==> (SN(R) <=> !x:A. ?N. !n y. RELPOW n R x y ==> n <= N)`, GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUND_SN] THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FC_FINITE_BOUND THEN CONJ_TAC THENL [SPEC_TAC(`x:A`,`x:A`) THEN REWRITE_TAC[RTC_TC_LEMMA; FINITE_INSERT] THEN MATCH_MP_TAC LF_TC_FINITE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC SN_NOLOOP THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Koenig's lemma. *) (* ------------------------------------------------------------------------- *) let TREE_FL = prove (`!R. TREE(R) ==> ?a:A. FL(R) = {y | RTC(R) a y}`, GEN_TAC THEN REWRITE_TAC[TREE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `a:A` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN EQ_TAC THENL [DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[]; ONCE_REWRITE_TAC[RTC_CASES_L] THEN ASM_MESON_TAC[IN; FL]]);; let KOENIG_LEMMA = prove (`!R:A->A->bool. TREE(R) /\ LF(R) /\ SN(R) ==> FINITE (FL R)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `a:A` SUBST1_TAC o MATCH_MP TREE_FL) THEN REWRITE_TAC[RTC_TC_LEMMA; FINITE_INSERT] THEN SPEC_TAC(`a:A`,`a:A`) THEN MATCH_MP_TAC LF_TC_FINITE THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Rephrasing in terms of joinability. *) (* ------------------------------------------------------------------------- *) let JOINABLE = new_definition `JOINABLE R s t <=> ?u. RTC R s u /\ RTC R t u`;; let JOINABLE_REFL = prove (`!R t. JOINABLE R t t`, REWRITE_TAC[JOINABLE] THEN MESON_TAC[RTC_CASES]);; let JOINABLE_SYM = prove (`!R s t. JOINABLE R s t <=> JOINABLE R t s`, REWRITE_TAC[JOINABLE] THEN MESON_TAC[]);; let JOINABLE_TRANS_R = prove (`!R s t u. R s t /\ JOINABLE R t u ==> JOINABLE R s u`, REWRITE_TAC[JOINABLE] THEN MESON_TAC[RTC_CASES_R]);; let CR_RSTC_JOINABLE = prove (`!R. CR(RTC R) ==> !x:A y. RSTC(R) x y <=> JOINABLE(R) x y`, GEN_TAC THEN REWRITE_TAC[STC_CR; JOINABLE] THEN ASM_MESON_TAC[RSTC_TRANS; RSTC_SYM; RSTC_INC_RTC]);; (* ------------------------------------------------------------------------- *) (* CR is equivalent to transitivity of joinability. *) (* ------------------------------------------------------------------------- *) let JOINABLE_TRANS = prove (`!R. CR(RTC R) <=> !x y z. JOINABLE(R) x y /\ JOINABLE(R) y z ==> JOINABLE(R) x z`, REWRITE_TAC[CR; JOINABLE] THEN MESON_TAC[RTC_REFL; RTC_TRANS; RTC_SYM]);; hol-light/Examples/schnirelmann.ml000066400000000000000000000622531303454263000175460ustar00rootroot00000000000000(* ========================================================================= *) (* Schnirelmann density and its basic properties (not Mann's theorem yet). *) (* ========================================================================= *) needs "Multivariate/misc.ml";; needs "Library/products.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* The basic definition. *) (* ------------------------------------------------------------------------- *) let count = new_definition `count s n = CARD (s INTER (1..n))`;; let schnirelmann = new_definition `schnirelmann s = inf { &(count s n) / &n | 1 <= n}`;; (* ------------------------------------------------------------------------- *) (* Basic properties of the "count" function. *) (* ------------------------------------------------------------------------- *) let COUNT_BOUND = prove (`!s. count s n <= n`, GEN_TAC THEN REWRITE_TAC[count] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN SET_TAC[]);; let COUNT_UNIV = prove (`!n. count (:num) n = n`, REWRITE_TAC[count; INTER_UNIV; CARD_NUMSEG_1]);; let COUNT_MONO = prove (`!s t n. s SUBSET t ==> count s n <= count t n`, REPEAT STRIP_TAC THEN REWRITE_TAC[count] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN ASM SET_TAC[]);; let COUNT_INSENSITIVE = prove (`!s t n. (!m. 1 <= m ==> (m IN s <=> m IN t)) ==> count s n = count t n`, REPEAT STRIP_TAC THEN REWRITE_TAC[count] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* The straightforward properties of Schnirelmann density. *) (* ------------------------------------------------------------------------- *) let SCHNIRELMANN_UBOUND,SCHNIRELMANN_LBOUND = (CONJ_PAIR o prove) (`(!n. 1 <= n ==> schnirelmann s <= &(count s n) / &n) /\ (!b. (!n. 1 <= n ==> b <= &(count s n) / &n) ==> b <= schnirelmann s)`, MP_TAC(ISPEC `{ &(count s n) / &n | 1 <= n}` INF) THEN SIMP_TAC[SET_RULE `(!x. x IN {f x | P x} ==> Q x) <=> !x. P x ==> Q(f x)`; GSYM schnirelmann] THEN ANTS_TAC THENL [CONJ_TAC THENL [SET_TAC[LE_REFL]; ALL_TAC] THEN EXISTS_TAC `&0` THEN SIMP_TAC[REAL_LE_DIV; REAL_POS]; MESON_TAC[]]);; let SCHNIRELMANN_UBOUND_MUL = prove (`!n s. schnirelmann s * &n <= &(count s n)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_POS] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; SCHNIRELMANN_UBOUND]);; let SCHNIRELMANN_BOUNDS = prove (`!s. &0 <= schnirelmann s /\ schnirelmann s <= &1`, GEN_TAC THEN REWRITE_TAC[schnirelmann] THEN MATCH_MP_TAC REAL_INF_BOUNDS THEN CONJ_TAC THENL [SET_TAC[LE_REFL]; ALL_TAC] THEN SIMP_TAC[SET_RULE `(!x. x IN {f x | P x} ==> Q x) <=> !x. P x ==> Q(f x)`; REAL_LE_DIV; REAL_POS; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE; COUNT_BOUND]);; let SCHNIRELMANN_MONO = prove (`!s t. s SUBSET t ==> schnirelmann s <= schnirelmann t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHNIRELMANN_LBOUND THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(count s n) / &n` THEN ASM_SIMP_TAC[SCHNIRELMANN_UBOUND] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; COUNT_MONO]);; let SCHNIRELMANN_INSENSITIVE = prove (`!s t. (!n. 1 <= n ==> (n IN s <=> n IN t)) ==> schnirelmann s = schnirelmann t`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COUNT_INSENSITIVE) THEN SIMP_TAC[schnirelmann]);; let SCHNIRELMANN_SENSITIVE = prove (`!s k. 1 <= k /\ ~(k IN s) ==> schnirelmann s <= &1 - &1 / &k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(count s k) / &k` THEN ASM_SIMP_TAC[SCHNIRELMANN_UBOUND] THEN ASM_SIMP_TAC[REAL_FIELD `&1 <= x ==> (&1 - &1 / x) = (x - &1) / x`; REAL_OF_NUM_LE; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_SIMP_TAC[REAL_OF_NUM_SUB; REAL_OF_NUM_LE; count] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_INTER] THEN ASM_MESON_TAC[ARITH_RULE `1 <= k ==> (x <= k - 1 <=> x <= k /\ ~(x = k))`]);; let SCHNIRELMANN_SENSITIVE_1 = prove (`!s. ~(1 IN s) ==> schnirelmann s = &0`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`s:num->bool`; `1`] SCHNIRELMANN_SENSITIVE) THEN MP_TAC(SPEC `s:num->bool` SCHNIRELMANN_BOUNDS) THEN ASM_REWRITE_TAC[LE_REFL] THEN REAL_ARITH_TAC);; let SCHNIRELMANN_UNIV = prove (`schnirelmann(:num) = &1`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; SCHNIRELMANN_BOUNDS] THEN MATCH_MP_TAC SCHNIRELMANN_LBOUND THEN SIMP_TAC[COUNT_UNIV; REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_1; REAL_LE_REFL]);; let SCHNIRELMANN_EQ_1 = prove (`!s. schnirelmann s = &1 <=> !n. 1 <= n ==> n IN s`, GEN_TAC THEN EQ_TAC THENL [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_UNIV; NOT_IMP] THEN DISCH_THEN(CHOOSE_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP SCHNIRELMANN_SENSITIVE) THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> s <= &1 - x ==> ~(s = &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; ARITH]; REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM SCHNIRELMANN_UNIV] THEN MATCH_MP_TAC SCHNIRELMANN_INSENSITIVE THEN ASM_REWRITE_TAC[IN_UNIV]]);; (* ------------------------------------------------------------------------- *) (* Sum-sets. *) (* ------------------------------------------------------------------------- *) parse_as_infix("+++",(16,"right"));; let sumset = new_definition `s +++ t = {x + y:num | x IN s /\ y IN t}`;; let SUMSET_0 = prove (`!s t. 0 IN s /\ 0 IN t ==> 0 IN (s +++ t)`, SIMP_TAC[sumset; IN_ELIM_THM] THEN MESON_TAC[ADD_CLAUSES]);; let SUMSET_SUPERSET_LZERO = prove (`!s t. 0 IN s ==> t SUBSET (s +++ t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; sumset; IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`0`; `n:num`] THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; let SUMSET_SUPERSET_RZERO = prove (`!s t. 0 IN t ==> s SUBSET (s +++ t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; sumset; IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`n:num`; `0`] THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; let SUMSET_SYM = prove (`!s t. s +++ t = t +++ s`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; sumset] THEN MESON_TAC[ADD_SYM]);; let SUMSET_ASSOC = prove (`!s t u. s +++ (t +++ u) = (s +++ t) +++ u`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; sumset] THEN MESON_TAC[ADD_ASSOC]);; let NEUTRAL_SUMSET = prove (`neutral(+++) = {0}`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `s:num->bool` THEN REWRITE_TAC[sumset; IN_ELIM_THM; EXTENSION; IN_SING] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `{0}`) THEN REWRITE_TAC[IN_SING]; ALL_TAC] THEN MESON_TAC[ADD_CLAUSES]);; let MONOIDAL_SUMSET = prove (`monoidal (+++)`, REWRITE_TAC[monoidal; NEUTRAL_SUMSET; SUMSET_ASSOC] THEN REWRITE_TAC[EQT_INTRO(SPEC_ALL SUMSET_SYM)] THEN REWRITE_TAC[EXTENSION; sumset; IN_ELIM_THM; IN_SING] THEN MESON_TAC[ADD_CLAUSES]);; let SUMSET_0_ITER = prove (`!a s. FINITE s /\ (!k. k IN s ==> 0 IN a k) ==> 0 IN iterate(+++) s a`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_SUMSET; NEUTRAL_SUMSET; IN_SING] THEN SIMP_TAC[IN_INSERT; SUMSET_0]);; (* ------------------------------------------------------------------------- *) (* Basic Schnirelmann theorem. *) (* ------------------------------------------------------------------------- *) let SCHNIRELMAN_LEMMA = prove (`!s t n. 0 IN (s INTER t) /\ count s n + count t n >= n ==> n IN (s +++ t)`, REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN ASM_CASES_TAC `(n:num) IN s` THENL [ASM_MESON_TAC[SUMSET_SUPERSET_RZERO; SUBSET]; ALL_TAC] THEN ASM_CASES_TAC `(n:num) IN t` THENL [ASM_MESON_TAC[SUMSET_SUPERSET_LZERO; SUBSET]; ALL_TAC] THEN ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((s INTER (1..n-1)) INTER (IMAGE (\b. n - b) (t INTER (1..n-1))) = {})` MP_TAC THENL [MATCH_MP_TAC CARD_UNION_OVERLAP THEN SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG; GT] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(1..n-1)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[SUBSET; IN_UNION; FORALL_IN_IMAGE; FORALL_AND_THM; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FINITE_NUMSEG; IN_INTER; IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[CARD_NUMSEG_1] THEN MATCH_MP_TAC(ARITH_RULE `~(n = 0) /\ n <= x ==> n - 1 < x`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `s + t:num >= n ==> a = s /\ b = t ==> n <= a + b`)) THEN SUBGOAL_THEN `CARD(IMAGE (\b. n - b) (t INTER (1..n-1))) = count t (n - 1)` SUBST1_TAC THENL [REWRITE_TAC[count] THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER; IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[count] THEN CONJ_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[EXTENSION; IN_INTER; IN_NUMSEG; ARITH_RULE `~(n = 0) ==> (x <= n - 1 <=> x <= n /\ ~(x = n))`] THEN ASM_MESON_TAC[]; UNDISCH_TAC `~(n IN s +++ t)` THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_IMAGE; IN_NUMSEG; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:num` THEN REWRITE_TAC[sumset; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `b:num`)) THEN MAP_EVERY EXISTS_TAC [`a:num`; `b:num`] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; let SCHNIRELMANN_THEOREM = prove (`!s t. 0 IN (s INTER t) /\ schnirelmann s + schnirelmann t >= &1 ==> s +++ t = (:num)`, REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[SUMSET_SUPERSET_LZERO; SUBSET; IN_INTER]; ALL_TAC] THEN MATCH_MP_TAC SCHNIRELMAN_LEMMA THEN ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[GE; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a + b >= &1 ==> a <= x /\ b <= y ==> &1 <= x + y`)) THEN CONJ_TAC THEN MATCH_MP_TAC SCHNIRELMANN_UBOUND THEN ASM_ARITH_TAC);; let SCHNIRELMANN_THEOREM_2 = prove (`!s. 0 IN s /\ schnirelmann s >= &1 / &2 ==> s +++ s = (:num)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHNIRELMANN_THEOREM THEN ASM_REWRITE_TAC[IN_INTER] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Additional additivity properties and full Schnirelmann theorem. *) (* ------------------------------------------------------------------------- *) let ENUMERATION_LEMMA = prove (`!n s p. s HAS_SIZE n /\ (!k. k IN s ==> 1 <= k /\ k <= p) ==> ?a:num->num. a(0) = 0 /\ a(n + 1) = p + 1 /\ s = IMAGE a (1..n) /\ (!j k. j <= n /\ k <= n + 1 /\ j < k ==> a(j) < a(k)) /\ (!j k. j <= n /\ k <= n + 1 /\ j <= k ==> a(j) <= a(k))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(<=):num->num->bool` TOPOLOGICAL_SORT) THEN REWRITE_TAC[LE_TRANS; LE_ANTISYM] THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `s:num->bool`]) THEN ASM_REWRITE_TAC[NOT_LE; IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\i. if 1 <= i then if i <= n then f i else p + 1 else 0` THEN ASM_REWRITE_TAC[ARITH; ARITH_RULE `1 <= n + 1 /\ ~(n + 1 <= n)`] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [MESON_TAC[LE_LT]; ALL_TAC] THEN SUBGOAL_THEN `!k. 1 <= k /\ k <= n ==> 1 <= f(k) /\ f(k) <= p` ASSUME_TAC THENL [GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th)) THEN ASM_ARITH_TAC);; let CARD_INTER_0_1 = prove (`!n s. 0 IN s ==> CARD(s INTER (0..n)) = SUC(CARD(s INTER (1..n)))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s INTER (0..n) = 0 INSERT (s INTER (1..n))` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `a IN s /\ (t = a INSERT u) ==> (s INTER t = a INSERT (s INTER u))`) THEN ASM_REWRITE_TAC[EXTENSION; IN_INSERT; IN_NUMSEG] THEN ARITH_TAC; SIMP_TAC[CARD_CLAUSES; FINITE_INTER; FINITE_NUMSEG; IN_INTER; ARITH; IN_NUMSEG; GSYM REAL_OF_NUM_SUC]]);; let SCHNIRELMANN_SUMSET = prove (`!s t. 0 IN (s INTER t) ==> schnirelmann(s +++ t) >= (schnirelmann s + schnirelmann t) - schnirelmann s * schnirelmann t`, REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_ge] THEN MATCH_MP_TAC SCHNIRELMANN_LBOUND THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN MP_TAC(SPECL [`count s n`; `s INTER (1..n)`; `n:num`] ENUMERATION_LEMMA) THEN SIMP_TAC[count; HAS_SIZE; FINITE_INTER; FINITE_NUMSEG] THEN SIMP_TAC[IN_INTER; IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `a:num->num` STRIP_ASSUME_TAC) THEN ABBREV_TAC `A = CARD(s INTER (1..n))` THEN SUBGOAL_THEN `!k. k <= A ==> (a:num->num)(k) IN s /\ a(k) <= n` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `(a:num->num)(k)`) THEN DISJ_CASES_TAC(ARITH_RULE `k = 0 \/ 1 <= k`) THEN ASM_REWRITE_TAC[LE_0; IN_INTER; IN_NUMSEG] THEN MATCH_MP_TAC(TAUT `d ==> (a /\ b /\ c <=> d) ==> a /\ c`) THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(CARD ((s +++ t) INTER (0..n))) - &1` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[CARD_INTER_0_1; SUMSET_0; GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_LE_SUB_LADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(CARD(UNIONS(IMAGE (\i. (IMAGE (\b. a i + b) (t INTER (0..(a(i+1) - a(i) - 1))))) (0..A))))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC CARD_SUBSET THEN SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; UNIONS_SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `l:num` THEN REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THENL [REWRITE_TAC[sumset; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN MATCH_MP_TAC(ARITH_RULE `a(k) < a(k + 1) /\ a(k + 1) <= n + 1 /\ l <= a(k + 1) - a(k) - 1 ==> a(k) + l <= n`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k:num = A` THEN ASM_REWRITE_TAC[LE_REFL] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k + 1`)) THEN ASM_ARITH_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) CARD_UNIONS o rand o rand o snd) THEN REWRITE_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FINITE_INTER] THEN SUBGOAL_THEN `!i j. i IN 0..A /\ j IN 0..A /\ ~(i = j) ==> IMAGE (\b. a i + b) (t INTER (0..a (i + 1) - a i - 1)) INTER IMAGE (\b. a j + b) (t INTER (0..a (j + 1) - a j - 1)) = {}` (LABEL_TAC "*") THENL [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `IMAGE f s INTER t = {} <=> !x. x IN s ==> ~(f x IN t)`] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG; IN_INTER]) THEN SUBGOAL_THEN `a(i + 1):num <= a(j) \/ a(j + 1) <= a(i)` MP_TAC THENL [FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(i = j) ==> i + 1 <= j \/ j + 1 <= i`)) THENL [DISJ1_TAC; DISJ2_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(a:num->num)(i) < a(i + 1) /\ a(j) < a(j + 1)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN ASM_ARITH_TAC; ALL_TAC] THEN ANTS_TAC THENL [X_GEN_TAC `i:num` THEN DISCH_TAC THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) NSUM_IMAGE_NONZERO o rand o rand o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_NUMSEG] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[INTER_ACI] THEN SIMP_TAC[CARD_CLAUSES]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN SIMP_TAC[EQ_ADD_LCANCEL; CARD_IMAGE_INJ; FINITE_INTER; FINITE_NUMSEG] THEN SIMP_TAC[REAL_OF_NUM_SUM; FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..A) (\i. schnirelmann t * &(a(i + 1) - a(i) - 1) + &1)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[CARD_INTER_0_1; SUMSET_0; GSYM REAL_OF_NUM_SUC] THEN SIMP_TAC[GSYM count; SCHNIRELMANN_UBOUND_MUL; REAL_LE_RADD]] THEN REWRITE_TAC[SUM_ADD_NUMSEG; SUM_CONST_NUMSEG] THEN REWRITE_TAC[SUB_0; GSYM REAL_OF_NUM_ADD; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..A) (\i. schnirelmann t * (&(a(i + 1)) - &(a i) - &1)) + &A` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_LE_RADD] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `a(i):num < a(i + 1)` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_OF_NUM_SUB; LT_IMP_LE; ARITH_RULE `a < b ==> 1 <= b - a`; REAL_LE_REFL]] THEN REWRITE_TAC[SUM_LMUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `a - b - c:real = --((b - a) + c)`] THEN REWRITE_TAC[SUM_NEG; SUM_ADD_NUMSEG; SUM_DIFFS; LE_0] THEN ASM_REWRITE_TAC[REAL_ARITH `--(&0 - a + b) = a - b`; SUM_CONST_NUMSEG] THEN REWRITE_TAC[SUB_0; GSYM REAL_OF_NUM_ADD; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `(n + &1) - (a + &1) = n - a`] THEN MATCH_MP_TAC(REAL_ARITH `(&1 - t) * s * n <= (&1 - t) * a ==> ((s + t) - s * t) * n <= t * (n - a) + a`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN EXPAND_TAC "A" THEN REWRITE_TAC[REAL_SUB_LE; SCHNIRELMANN_UBOUND_MUL; GSYM count] THEN REWRITE_TAC[SCHNIRELMANN_BOUNDS]);; (* ------------------------------------------------------------------------- *) (* Now an iterative form. *) (* ------------------------------------------------------------------------- *) let SCHNIRELMANN_SUMSET_GEN = prove (`!a s. FINITE s /\ (!i:A. i IN s ==> 0 IN a i) ==> schnirelmann(iterate(+++) s a) >= &1 - product s (\i. &1 - schnirelmann(a i))`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; real_ge; REAL_SUB_REFL; SCHNIRELMANN_BOUNDS] THEN MAP_EVERY X_GEN_TAC [`k:A`; `s:A->bool`] THEN STRIP_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INSERT]; DISCH_TAC] THEN ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_SUMSET] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 - (&1 - schnirelmann(a(k:A))) * (&1 - schnirelmann(iterate (+++) s a))` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `a <= b ==> &1 - b <= &1 - a`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; SCHNIRELMANN_BOUNDS] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `&1 - (&1 - s) * (&1 - t) <= u <=> u >= (s + t) - s * t`] THEN MATCH_MP_TAC SCHNIRELMANN_SUMSET THEN ASM_SIMP_TAC[IN_INTER; IN_INSERT; SUMSET_0_ITER]]);; let SCHNIRELMANN_SUMSET_POW = prove (`!i s. FINITE i /\ 0 IN s ==> schnirelmann(iterate(+++) i (\k:A. s)) >= &1 - (&1 - schnirelmann s) pow (CARD i)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\i:A. (s:num->bool)`; `i:A->bool`] SCHNIRELMANN_SUMSET_GEN) THEN ASM_SIMP_TAC[PRODUCT_CONST]);; let SCHNIRELMANN = prove (`!s. 0 IN s /\ schnirelmann s > &0 ==> ?k. !i. i HAS_SIZE k ==> iterate(+++) i (\a:A. s) = (:num)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN MP_TAC(ISPECL [`&1 - schnirelmann s`; `&1 / &2`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `2 * n` THEN X_GEN_TAC `i:A->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?j k:A->bool. i = j UNION k /\ j INTER k = {} /\ j HAS_SIZE n /\ k HAS_SIZE n` (REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC)) THENL [FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP CHOOSE_SUBSET) THEN ASM_REWRITE_TAC[ARITH_RULE `n <= 2 * n`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:A->bool` THEN STRIP_TAC THEN EXISTS_TAC `i DIFF j:A->bool` THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c) /\ (a /\ b /\ c ==> d) ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [ARITH_RULE `n = 2 * n - n`] THEN MATCH_MP_TAC HAS_SIZE_DIFF THEN ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DISJOINT; HAS_SIZE]) THEN ASM_SIMP_TAC[MONOIDAL_SUMSET; ITERATE_UNION] THEN MATCH_MP_TAC SCHNIRELMANN_THEOREM THEN ASM_SIMP_TAC[SUMSET_0_ITER; IN_INTER] THEN MP_TAC(SPECL [`j:A->bool`; `s:num->bool`] SCHNIRELMANN_SUMSET_POW) THEN MP_TAC(SPECL [`k:A->bool`; `s:num->bool`] SCHNIRELMANN_SUMSET_POW) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a < &1 / &2 ==> y >= &1 - a ==> x >= &1 - a ==> x + y >= &1`) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* A more direct version, without the techicality of 0 and sumsets. *) (* ------------------------------------------------------------------------- *) let SCHNIRELMANN_DIRECT = prove (`!s. schnirelmann s > &0 ==> ?k. !n. ?m f. m <= k /\ (!i. i IN 1..m ==> f(i) IN s) /\ n = nsum (1..m) f`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `?k. !i:num->bool. i HAS_SIZE k ==> iterate (+++) i (\a. 0 INSERT s) = (:num)` MP_TAC THENL [MATCH_MP_TAC SCHNIRELMANN THEN REWRITE_TAC[IN_INSERT] THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SCHNIRELMANN_INSENSITIVE THEN SIMP_TAC[IN_INSERT; LE_1]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_THEN(MP_TAC o SPEC `1..k`) THEN REWRITE_TAC[EXTENSION; HAS_SIZE_NUMSEG_1; IN_UNIV] THEN MATCH_MP_TAC MONO_FORALL THEN SPEC_TAC(`k:num`,`k:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THEN SIMP_TAC[NUMSEG_CLAUSES; ARITH; ARITH_RULE `1 <= SUC k`] THEN SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_SUMSET; FINITE_NUMSEG] THENL [REWRITE_TAC[NEUTRAL_SUMSET; IN_SING] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `0` THEN SIMP_TAC[NSUM_CLAUSES_NUMSEG; CARD_CLAUSES; EMPTY_SUBSET; FINITE_RULES; IN_NUMSEG; LE_REFL; ARITH] THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`]; ALL_TAC] THEN REWRITE_TAC[IN_NUMSEG; ARITH_RULE `~(SUC n <= n)`] THEN ONCE_REWRITE_TAC[sumset] THEN REWRITE_TAC[IN_ELIM_THM; IN_INSERT] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(X_CHOOSE_THEN `x:num` MP_TAC) THEN ASM_CASES_TAC `x = 0` THEN ASM_REWRITE_TAC[ADD_CLAUSES] THENL [ASM_MESON_TAC[IN_NUMSEG; ARITH_RULE `x <= k ==> x <= SUC k`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:num`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `f:num->num`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`SUC m`; `\i. if i = SUC m then x:num else f i`] THEN ASM_SIMP_TAC[LE_SUC; LE; NSUM_CLAUSES_NUMSEG] THEN CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `~(SUC n <= n)`; IN_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `1 = SUC m \/ 1 <= m`] THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN AP_TERM_TAC THEN MATCH_MP_TAC NSUM_EQ THEN ASM_MESON_TAC[ARITH_RULE `~(SUC n <= n)`; IN_NUMSEG]);; hol-light/Examples/solovay.ml000066400000000000000000000425321303454263000165570ustar00rootroot00000000000000(* ========================================================================= *) (* Simple universal variant of Bob Solovay's procedure for vector spaces. *) (* ========================================================================= *) needs "Multivariate/misc.ml";; needs "Multivariate/vectors.ml";; (* ------------------------------------------------------------------------- *) (* Initial simplification so we just use dot products between vectors. *) (* ------------------------------------------------------------------------- *) let VECTOR_SUB_ELIM_THM = prove (`(--x = --(&1) % x) /\ (x - y = x + --(&1) % y)`, VECTOR_ARITH_TAC);; let NORM_ELIM_THM = prove (`!P t. P (norm t) = !x. &0 <= x /\ (x pow 2 = (t:real^N) dot t) ==> P x`, GEN_TAC THEN REWRITE_TAC[vector_norm] THEN MESON_TAC[DOT_POS_LE; SQRT_POW2; SQRT_UNIQUE; REAL_POW_2; REAL_POW2_ABS; REAL_ABS_POS]);; let NORM_ELIM_CONV = let dest_norm tm = let nm,v = dest_comb tm in if fst(dest_const nm) <> "vector_norm" then failwith "dest_norm" else v in let is_norm = can dest_norm in fun tm -> let t = find_term (fun t -> is_norm t && free_in t tm) tm in let v = dest_norm t in let w = genvar(type_of t) in let th1 = ISPECL [mk_abs(w,subst[w,t] tm); v] NORM_ELIM_THM in CONV_RULE(COMB2_CONV (RAND_CONV BETA_CONV) (BINDER_CONV(RAND_CONV BETA_CONV))) th1;; let NORM_ELIM_TAC = CONV_TAC NORM_ELIM_CONV THEN GEN_TAC;; let SOLOVAY_TAC = REWRITE_TAC[orthogonal; GSYM DOT_EQ_0] THEN REWRITE_TAC[VECTOR_EQ] THEN REWRITE_TAC[VECTOR_SUB_ELIM_THM] THEN REWRITE_TAC[NORM_EQ; NORM_LE; NORM_LT; real_gt; real_ge] THEN REPEAT NORM_ELIM_TAC THEN REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL];; (* ------------------------------------------------------------------------- *) (* Iterative Gram-Schmidt type process. *) (* ------------------------------------------------------------------------- *) let component = new_definition `component (b:real^N) x = (b dot x) / (b dot b)`;; let COMPONENT_ORTHOGONAL = prove (`!b:real^N x. orthogonal b (x - (component b x) % b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b = vec 0 :real^N` THENL [ASM_REWRITE_TAC[orthogonal; DOT_LZERO]; ALL_TAC] THEN ASM_SIMP_TAC[orthogonal; component] THEN REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN ASM_SIMP_TAC[REAL_SUB_REFL; REAL_DIV_RMUL; DOT_EQ_0]);; let ORTHOGONAL_SUM_LEMMA = prove (`!cs vs. ALL (orthogonal x) vs /\ orthogonal x z /\ (LENGTH cs = LENGTH vs) ==> orthogonal x (ITLIST2 (\a v s. a % v + s) cs vs z)`, LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL; NOT_SUC; ITLIST2; LENGTH; ALL] THEN ASM_SIMP_TAC[ORTHOGONAL_CLAUSES; SUC_INJ]);; let GRAM_SCHMIDT_LEMMA = prove (`!w:real^N vs. ?u as. ALL (orthogonal u) vs /\ (LENGTH as = LENGTH vs) /\ (w = ITLIST2 (\a v s. a % v + s) as vs u)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC list_INDUCT THEN SIMP_TAC[ALL; LENGTH; ITLIST2; LENGTH_EQ_NIL] THEN CONJ_TAC THENL [X_GEN_TAC `w:real^N` THEN EXISTS_TAC `w:real^N` THEN EXISTS_TAC `[]:real list` THEN REWRITE_TAC[ITLIST2]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`v:real^N`; `vs:(real^N)list`] THEN REWRITE_TAC[LENGTH_EQ_CONS] THEN DISCH_TAC THEN X_GEN_TAC `w:real^N` THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `w:real^N` th) THEN MP_TAC(SPEC `v:real^N` th)) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` (X_CHOOSE_THEN `cs:real list` (STRIP_ASSUME_TAC o GSYM))) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N` (X_CHOOSE_THEN `as:real list` (STRIP_ASSUME_TAC o GSYM))) THEN MP_TAC(ISPECL [`z:real^N`; `u:real^N`] COMPONENT_ORTHOGONAL) THEN ABBREV_TAC `k = component z (u:real^N)` THEN ABBREV_TAC `x = u - k % z :real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `CONS k (MAP2 (\a c. a - k * c) as cs)`] THEN REWRITE_TAC[CONS_11; RIGHT_EXISTS_AND_THM; GSYM CONJ_ASSOC; UNWIND_THM1] THEN SUBGOAL_THEN `ALL (orthogonal(x:real^N)) vs` ASSUME_TAC THENL [UNDISCH_TAC `ALL (orthogonal(z:real^N)) vs` THEN UNDISCH_TAC `ALL (orthogonal(u:real^N)) vs` THEN REWRITE_TAC[IMP_IMP; AND_ALL] THEN MATCH_MP_TAC MONO_ALL THEN REWRITE_TAC[] THEN EXPAND_TAC "x" THEN SIMP_TAC[ORTHOGONAL_CLAUSES]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "v" THEN MATCH_MP_TAC ORTHOGONAL_SUM_LEMMA THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ORTHOGONAL_SYM]; FIRST_ASSUM ACCEPT_TAC; ASM_MESON_TAC[LENGTH_MAP2]; ALL_TAC] THEN REWRITE_TAC[ITLIST2; VECTOR_ARITH `(a = b + c:real^N) = (c = a - b)`] THEN MAP_EVERY EXPAND_TAC ["v"; "w"; "x"] THEN UNDISCH_TAC `LENGTH(vs:(real^N)list) = LENGTH(cs:real list)` THEN UNDISCH_TAC `LENGTH(vs:(real^N)list) = LENGTH(as:real list)` THEN REWRITE_TAC[IMP_CONJ] THEN MAP_EVERY (fun v -> SPEC_TAC(v,v)) [`vs:(real^N)list`; `cs:real list`; `as:real list`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL; NOT_SUC; ITLIST2; LENGTH; ALL; SUC_INJ; MAP2] THEN ASM_SIMP_TAC[] THEN REPEAT DISCH_TAC THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence this is a simple equality. *) (* ------------------------------------------------------------------------- *) let SOLOVAY_LEMMA = prove (`!P vs. (!w:real^N. P w vs) = (!as u. ALL (orthogonal u) vs /\ (LENGTH as = LENGTH vs) ==> P (ITLIST2 (\a v s. a % v + s) as vs u) vs)`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `w:real^N` THEN MP_TAC(ISPECL [`w:real^N`; `vs:(real^N)list`] GRAM_SCHMIDT_LEMMA) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Set up the specific instances to get rid of list stuff. *) (* ------------------------------------------------------------------------- *) let FORALL_LENGTH_CLAUSES = prove (`((!l. (LENGTH l = 0) ==> P l) = P []) /\ ((!l. (LENGTH l = SUC n) ==> P l) = (!h t. (LENGTH t = n) ==> P (CONS h t)))`, MESON_TAC[LENGTH; LENGTH_EQ_NIL; NOT_SUC; LENGTH_EQ_CONS]);; let ORTHOGONAL_SIMP_CLAUSES = prove (`orthogonal u x ==> (u dot x = &0) /\ (x dot u = &0) /\ (u dot (a % x) = &0) /\ ((a % x) dot u = &0) /\ (u dot (a % x + y) = u dot y) /\ ((a % x + y) dot u = y dot u) /\ (u dot (y + a % x) = u dot y) /\ ((y + a % x) dot u = y dot u)`, SIMP_TAC[orthogonal; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [DOT_SYM] THEN SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID; REAL_ADD_RID]);; (* ------------------------------------------------------------------------- *) (* A nicer proforma version. *) (* ------------------------------------------------------------------------- *) let ITLIST2_0_LEMMA = prove (`!u as vs. ITLIST2 (\a v s. a % v + s) as vs u = ITLIST2 (\a v s. a % v + s) as vs (vec 0) + u`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ITLIST2_DEF; VECTOR_ADD_LID] THEN ASM_REWRITE_TAC[VECTOR_ADD_ASSOC]);; let SOLOVAY_PROFORMA_EQ = prove (`(!w:real^N. P (MAP ((dot) w) (CONS w vs)) vs) = (!u. ALL (orthogonal u) vs ==> !as. (LENGTH as = LENGTH vs) ==> P (CONS ((ITLIST2 (\a v s. a % v + s) as vs (vec 0)) dot (ITLIST2 (\a v s. a % v + s) as vs (vec 0)) + u dot u) (MAP ((dot) (ITLIST2 (\a v s. a % v + s) as vs (vec 0))) vs)) vs)`, MP_TAC(ISPEC `\w:real^N vs. P (MAP ((dot) w) (CONS w vs)) vs :bool` SOLOVAY_LEMMA) THEN REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:real^N` THEN REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `as:(real)list` THEN REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC(TAUT `(a ==> (b = c)) ==> (a ==> b <=> a ==> c)`) THEN STRIP_TAC THEN REWRITE_TAC[MAP] THEN BINOP_TAC THEN REWRITE_TAC[CONS_11] THEN ONCE_REWRITE_TAC[ITLIST2_0_LEMMA] THEN REWRITE_TAC[VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_ARITH `(a + u) dot (a + u) = a dot a + &2 * (u dot a) + u dot u`] THEN REWRITE_TAC[REAL_ARITH `(a + &2 * b + c = a + c) <=> (b = &0)`] THEN GEN_REWRITE_TAC (RAND_CONV o BINOP_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[DOT_LADD] THEN CONJ_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`vs:(real^N)list`,`vs:(real^N)list`) THEN SPEC_TAC(`as:(real)list`,`as:(real)list`) THEN REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_SUC] THEN REWRITE_TAC[ALL; ITLIST2; DOT_RZERO; SUC_INJ] THEN ASM_SIMP_TAC[DOT_RADD] THEN REWRITE_TAC[REAL_ADD_RID; DOT_RMUL] THEN SIMP_TAC[orthogonal] THEN REWRITE_TAC[REAL_MUL_RZERO]; MATCH_MP_TAC MAP_EQ THEN REWRITE_TAC[REAL_ARITH `(a + b = a) <=> (b = &0)`] THEN MATCH_MP_TAC ALL_IMP THEN EXISTS_TAC `orthogonal (u:real^N)` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[orthogonal]]);; (* ------------------------------------------------------------------------- *) (* The implication that we normally use. *) (* ------------------------------------------------------------------------- *) let SOLOVAY_PROFORMA = prove (`!P vs. (!c. &0 <= c ==> !as. (LENGTH as = LENGTH vs) ==> P (CONS ((ITLIST2 (\a v s. a % v + s) as vs (vec 0)) dot (ITLIST2 (\a v s. a % v + s) as vs (vec 0)) + c) (MAP ((dot) (ITLIST2 (\a v s. a % v + s) as vs (vec 0))) vs)) vs) ==> !w:real^N. P (MAP ((dot) w) (CONS w vs)) vs`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [SOLOVAY_PROFORMA_EQ] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[DOT_POS_LE]);; (* ------------------------------------------------------------------------- *) (* Automatically set up an implication for n (+1 eliminated) quantifier. *) (* ------------------------------------------------------------------------- *) let SOLOVAY_RULE = let v_tm = `v:(real^N)list` and d_tm = `d:real list` and elv_tm = `EL:num->(real^N)list->real^N` and eld_tm = `EL:num->(real)list->real` and rn_ty = `:real^N` and rewr_rule = REWRITE_RULE [MAP; EL; HD; TL; LENGTH; FORALL_LENGTH_CLAUSES; ITLIST2; VECTOR_ADD_RID; VECTOR_ADD_LID; DOT_LZERO] and sewr_rule = PURE_ONCE_REWRITE_RULE[DOT_SYM] in fun n -> let args = map (fun i -> mk_comb(mk_comb(elv_tm,mk_small_numeral i),v_tm)) (0--(n-1)) @ map (fun i -> mk_comb(mk_comb(eld_tm,mk_small_numeral i),d_tm)) (1--n) @ [mk_comb(mk_comb(eld_tm,mk_small_numeral 0),d_tm)] in let pty = itlist (mk_fun_ty o type_of) args bool_ty in let p_tm = list_mk_abs([d_tm;v_tm],list_mk_comb(mk_var("P",pty),args)) and vs = make_args "v" [] (replicate rn_ty n) in let th1 = ISPECL [p_tm; mk_list(vs,rn_ty)] SOLOVAY_PROFORMA in let th2 = rewr_rule(CONV_RULE(TOP_DEPTH_CONV num_CONV) th1) in let th3 = sewr_rule th2 in itlist (fun v -> MATCH_MP MONO_FORALL o GEN v) vs th3;; (* ------------------------------------------------------------------------- *) (* Now instantiate it to some special cases. *) (* ------------------------------------------------------------------------- *) let MK_SOLOVAY_PROFORMA = let preths = map SOLOVAY_RULE (0--9) in fun n -> if n < 10 then el n preths else SOLOVAY_RULE n;; (* ------------------------------------------------------------------------- *) (* Apply it to a goal. *) (* ------------------------------------------------------------------------- *) let is_vector_ty ty = match ty with Tyapp("cart",[Tyapp("real",[]);_]) -> true | _ -> false;; let SOLOVAY_REDUCE_TAC (asl,w) = let avs = sort (<) (filter (is_vector_ty o type_of) (frees w)) in (REWRITE_TAC[DOT_SYM] THEN MAP_EVERY (fun v -> SPEC_TAC(v,v)) (rev avs) THEN MATCH_MP_TAC(MK_SOLOVAY_PROFORMA (length avs - 1)) THEN REWRITE_TAC[DOT_LADD; DOT_LMUL; DOT_RADD; DOT_RMUL; DOT_LZERO; DOT_RZERO] THEN REPEAT GEN_TAC) (asl,w);; (* ------------------------------------------------------------------------- *) (* Overall tactic. *) (* ------------------------------------------------------------------------- *) let SOLOVAY_VECTOR_TAC = REWRITE_TAC[dist; real_gt; real_ge; NORM_LT; NORM_LE; GSYM DOT_POS_LT] THEN REPEAT GEN_TAC THEN SOLOVAY_TAC THEN REWRITE_TAC[DOT_LZERO; DOT_RZERO] THEN REPEAT SOLOVAY_REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_MUL_LID; REAL_MUL_RID; REAL_ADD_LID; REAL_ADD_RID] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG; REAL_MUL_LID; REAL_MUL_RID; GSYM real_sub];; (* ------------------------------------------------------------------------- *) (* An example where REAL_RING then works. *) (* ------------------------------------------------------------------------- *) let PYTHAGORAS = prove (`!A B C:real^N. orthogonal (A - B) (C - B) ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_RING);; (*** Actually in this case we can fairly easily do things manually, though we do need to explicitly use symmetry of the dot product. let PYTHAGORAS = prove (`!A B C:real^N. orthogonal (A - B) (C - B) ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, REWRITE_TAC[NORM_POW_2; orthogonal; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; ***) (* ------------------------------------------------------------------------- *) (* Examples. *) (* ------------------------------------------------------------------------- *) needs "Examples/sos.ml";; let EXAMPLE_1 = prove (`!x y:real^N. x dot y <= norm x * norm y`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; let EXAMPLE_2 = prove (`!x y:real^N. a % (x + y) = a % x + a % y`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; (*** Takes a few minutes but does work let EXAMPLE_3 = prove (`!x y:real^N. norm (x + y) <= norm x + norm y`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; ****) let EXAMPLE_4 = prove (`!x y z. x dot (y + z) = (x dot y) + (x dot z)`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; let EXAMPLE_5 = prove (`!x y. (x dot x = &0) ==> (x dot y = &0)`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; (* ------------------------------------------------------------------------- *) (* This is NORM_INCREASES_ONLINE. *) (* ------------------------------------------------------------------------- *) g `!a d:real^N. ~(d = vec 0) ==> norm (a + d) > norm a \/ norm (a - d) > norm a`;; time e SOLOVAY_VECTOR_TAC;; time e (CONV_TAC REAL_SOS);; (* ------------------------------------------------------------------------- *) (* DIST_INCREASES_ONLINE *) (* ------------------------------------------------------------------------- *) g `!b a d:real^N. ~(d = vec 0) ==> dist(a,b + d) > dist(a,b) \/ dist(a,b - d) > dist(a,b)`;; time e SOLOVAY_VECTOR_TAC;; time e (CONV_TAC REAL_SOS);; (* ------------------------------------------------------------------------- *) (* This one doesn't seem to work easily, but I think it does eventually. *) (* ------------------------------------------------------------------------- *) (**** let EXAMPLE_6 = prove (`!a x. norm(a % x) = abs(a) * norm x`;; SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; ****) let EXAMPLE_7 = prove (`!x. abs(norm x) = norm x`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; (*** But this is (at least) really slow let EXAMPLE_8 = prove (`!x y. abs(norm(x) - norm(y)) <= abs(norm(x - y))`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; ****) (* ------------------------------------------------------------------------- *) (* One from separating hyperplanes with a richer structure. *) (* ------------------------------------------------------------------------- *) needs "Rqe/make.ml";; let EXAMPLE_9 = prove (`!x:real^N y. x dot y > &0 ==> ?u. &0 < u /\ norm(u % y - x) < norm x`, SOLOVAY_VECTOR_TAC THEN W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN CONV_TAC REAL_QELIM_CONV);; (* ------------------------------------------------------------------------- *) (* Even richer set of quantifier alternations. *) (* ------------------------------------------------------------------------- *) let EXAMPLE_10 = prove (`!x:real^N y. x dot y > &0 ==> ?u. &0 < u /\ !v. &0 < v /\ v <= u ==> norm(v % y - x) < norm x`, SOLOVAY_VECTOR_TAC THEN W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN CONV_TAC REAL_QELIM_CONV);; hol-light/Examples/sos.ml000066400000000000000000002250401303454263000156640ustar00rootroot00000000000000(* ========================================================================= *) (* Nonlinear universal reals procedure using SOS decomposition. *) (* ========================================================================= *) prioritize_real();; let debugging = ref false;; exception Sanity;; exception Unsolvable;; (* ------------------------------------------------------------------------- *) (* Turn a rational into a decimal string with d sig digits. *) (* ------------------------------------------------------------------------- *) let decimalize = let rec normalize y = if abs_num y =/ Int 1 then normalize (y // Int 10) + 1 else 0 in fun d x -> if x =/ Int 0 then "0.0" else let y = abs_num x in let e = normalize y in let z = pow10(-e) */ y +/ Int 1 in let k = round_num(pow10 d */ z) in (if x a | h::t -> itern (k + 1) t f (f h k a);; let rec iter (m,n) f a = if n < m then a else iter (m+1,n) f (f m a);; (* ------------------------------------------------------------------------- *) (* The main types. *) (* ------------------------------------------------------------------------- *) type vector = int*(int,num)func;; type matrix = (int*int)*(int*int,num)func;; type monomial = (term,int)func;; type poly = (monomial,num)func;; (* ------------------------------------------------------------------------- *) (* Assignment avoiding zeros. *) (* ------------------------------------------------------------------------- *) let (|-->) x y a = if y =/ Int 0 then a else (x |-> y) a;; (* ------------------------------------------------------------------------- *) (* This can be generic. *) (* ------------------------------------------------------------------------- *) let element (d,v) i = tryapplyd v i (Int 0);; let mapa f (d,v) = d,foldl (fun a i c -> (i |--> f(c)) a) undefined v;; let is_zero (d,v) = is_undefined v;; (* ------------------------------------------------------------------------- *) (* Vectors. Conventionally indexed 1..n. *) (* ------------------------------------------------------------------------- *) let vec_0 n = (n,undefined:vector);; let vec_dim (v:vector) = fst v;; let vec_const c n = if c =/ Int 0 then vec_0 n else (n,itlist (fun k -> k |-> c) (1--n) undefined :vector);; let vec_1 = vec_const (Int 1);; let vec_cmul c (v:vector) = let n = vec_dim v in if c =/ Int 0 then vec_0 n else n,mapf (fun x -> c */ x) (snd v) let vec_neg (v:vector) = (fst v,mapf minus_num (snd v) :vector);; let vec_add (v1:vector) (v2:vector) = let m = vec_dim v1 and n = vec_dim v2 in if m <> n then failwith "vec_add: incompatible dimensions" else (n,combine (+/) (fun x -> x =/ Int 0) (snd v1) (snd v2) :vector);; let vec_sub v1 v2 = vec_add v1 (vec_neg v2);; let vec_dot (v1:vector) (v2:vector) = let m = vec_dim v1 and n = vec_dim v2 in if m <> n then failwith "vec_add: incompatible dimensions" else foldl (fun a i x -> x +/ a) (Int 0) (combine ( */ ) (fun x -> x =/ Int 0) (snd v1) (snd v2));; let vec_of_list l = let n = length l in (n,itlist2 (|->) (1--n) l undefined :vector);; (* ------------------------------------------------------------------------- *) (* Matrices; again rows and columns indexed from 1. *) (* ------------------------------------------------------------------------- *) let matrix_0 (m,n) = ((m,n),undefined:matrix);; let dimensions (m:matrix) = fst m;; let matrix_const c (m,n as mn) = if m <> n then failwith "matrix_const: needs to be square" else if c =/ Int 0 then matrix_0 mn else (mn,itlist (fun k -> (k,k) |-> c) (1--n) undefined :matrix);; let matrix_1 = matrix_const (Int 1);; let matrix_cmul c (m:matrix) = let (i,j) = dimensions m in if c =/ Int 0 then matrix_0 (i,j) else (i,j),mapf (fun x -> c */ x) (snd m);; let matrix_neg (m:matrix) = (dimensions m,mapf minus_num (snd m) :matrix);; let matrix_add (m1:matrix) (m2:matrix) = let d1 = dimensions m1 and d2 = dimensions m2 in if d1 <> d2 then failwith "matrix_add: incompatible dimensions" else (d1,combine (+/) (fun x -> x =/ Int 0) (snd m1) (snd m2) :matrix);; let matrix_sub m1 m2 = matrix_add m1 (matrix_neg m2);; let row k (m:matrix) = let i,j = dimensions m in (j, foldl (fun a (i,j) c -> if i = k then (j |-> c) a else a) undefined (snd m) : vector);; let column k (m:matrix) = let i,j = dimensions m in (i, foldl (fun a (i,j) c -> if j = k then (i |-> c) a else a) undefined (snd m) : vector);; let transp (m:matrix) = let i,j = dimensions m in ((j,i),foldl (fun a (i,j) c -> ((j,i) |-> c) a) undefined (snd m) :matrix);; let diagonal (v:vector) = let n = vec_dim v in ((n,n),foldl (fun a i c -> ((i,i) |-> c) a) undefined (snd v) : matrix);; let matrix_of_list l = let m = length l in if m = 0 then matrix_0 (0,0) else let n = length (hd l) in (m,n),itern 1 l (fun v i -> itern 1 v (fun c j -> (i,j) |-> c)) undefined;; (* ------------------------------------------------------------------------- *) (* Monomials. *) (* ------------------------------------------------------------------------- *) let monomial_eval assig (m:monomial) = foldl (fun a x k -> a */ power_num (apply assig x) (Int k)) (Int 1) m;; let monomial_1 = (undefined:monomial);; let monomial_var x = (x |=> 1 :monomial);; let (monomial_mul:monomial->monomial->monomial) = combine (+) (fun x -> false);; let monomial_pow (m:monomial) k = if k = 0 then monomial_1 else mapf (fun x -> k * x) m;; let monomial_divides (m1:monomial) (m2:monomial) = foldl (fun a x k -> tryapplyd m2 x 0 >= k && a) true m1;; let monomial_div (m1:monomial) (m2:monomial) = let m = combine (+) (fun x -> x = 0) m1 (mapf (fun x -> -x) m2) in if foldl (fun a x k -> k >= 0 && a) true m then m else failwith "monomial_div: non-divisible";; let monomial_degree x (m:monomial) = tryapplyd m x 0;; let monomial_lcm (m1:monomial) (m2:monomial) = (itlist (fun x -> x |-> max (monomial_degree x m1) (monomial_degree x m2)) (union (dom m1) (dom m2)) undefined :monomial);; let monomial_multidegree (m:monomial) = foldl (fun a x k -> k + a) 0 m;; let monomial_variables m = dom m;; (* ------------------------------------------------------------------------- *) (* Polynomials. *) (* ------------------------------------------------------------------------- *) let eval assig (p:poly) = foldl (fun a m c -> a +/ c */ monomial_eval assig m) (Int 0) p;; let poly_0 = (undefined:poly);; let poly_isconst (p:poly) = foldl (fun a m c -> m = monomial_1 && a) true p;; let poly_var x = ((monomial_var x) |=> Int 1 :poly);; let poly_const c = if c =/ Int 0 then poly_0 else (monomial_1 |=> c);; let poly_cmul c (p:poly) = if c =/ Int 0 then poly_0 else mapf (fun x -> c */ x) p;; let poly_neg (p:poly) = (mapf minus_num p :poly);; let poly_add (p1:poly) (p2:poly) = (combine (+/) (fun x -> x =/ Int 0) p1 p2 :poly);; let poly_sub p1 p2 = poly_add p1 (poly_neg p2);; let poly_cmmul (c,m) (p:poly) = if c =/ Int 0 then poly_0 else if m = monomial_1 then mapf (fun d -> c */ d) p else foldl (fun a m' d -> (monomial_mul m m' |-> c */ d) a) poly_0 p;; let poly_mul (p1:poly) (p2:poly) = foldl (fun a m c -> poly_add (poly_cmmul (c,m) p2) a) poly_0 p1;; let poly_div (p1:poly) (p2:poly) = if not(poly_isconst p2) then failwith "poly_div: non-constant" else let c = eval undefined p2 in if c =/ Int 0 then failwith "poly_div: division by zero" else poly_cmul (Int 1 // c) p1;; let poly_square p = poly_mul p p;; let rec poly_pow p k = if k = 0 then poly_const (Int 1) else if k = 1 then p else let q = poly_square(poly_pow p (k / 2)) in if k mod 2 = 1 then poly_mul p q else q;; let poly_exp p1 p2 = if not(poly_isconst p2) then failwith "poly_exp: not a constant" else poly_pow p1 (Num.int_of_num (eval undefined p2));; let degree x (p:poly) = foldl (fun a m c -> max (monomial_degree x m) a) 0 p;; let multidegree (p:poly) = foldl (fun a m c -> max (monomial_multidegree m) a) 0 p;; let poly_variables (p:poly) = foldr (fun m c -> union (monomial_variables m)) p [];; (* ------------------------------------------------------------------------- *) (* Order monomials for human presentation. *) (* ------------------------------------------------------------------------- *) let humanorder_varpow (x1,k1) (x2,k2) = x1 < x2 || x1 = x2 && k1 > k2;; let humanorder_monomial = let rec ord l1 l2 = match (l1,l2) with _,[] -> true | [],_ -> false | h1::t1,h2::t2 -> humanorder_varpow h1 h2 || h1 = h2 && ord t1 t2 in fun m1 m2 -> m1 = m2 || ord (sort humanorder_varpow (graph m1)) (sort humanorder_varpow (graph m2));; (* ------------------------------------------------------------------------- *) (* Conversions to strings. *) (* ------------------------------------------------------------------------- *) let string_of_vector min_size max_size (v:vector) = let n_raw = vec_dim v in if n_raw = 0 then "[]" else let n = max min_size (min n_raw max_size) in let xs = map (string_of_num o element v) (1--n) in "[" ^ end_itlist (fun s t -> s ^ ", " ^ t) xs ^ (if n_raw > max_size then ", ...]" else "]");; let string_of_matrix max_size (m:matrix) = let i_raw,j_raw = dimensions m in let i = min max_size i_raw and j = min max_size j_raw in let rstr = map (fun k -> string_of_vector j j (row k m)) (1--i) in "["^end_itlist(fun s t -> s^";\n "^t) rstr ^ (if j > max_size then "\n ...]" else "]");; let rec string_of_term t = if (is_comb t) then let (a,b) = (dest_comb t) in "("^(string_of_term a)^" "^(string_of_term b)^")" else if (is_abs t) then let (a,b) = (dest_abs t) in "(\\"^(string_of_term a)^"."^(string_of_term b)^")" else if (is_const t) then let (a,_) = (dest_const t) in a else if (is_var t) then let (a,_) = (dest_var t) in a else failwith "string_of_term";; let string_of_varpow x k = if k = 1 then string_of_term x else string_of_term x^"^"^string_of_int k;; let string_of_monomial m = if m = monomial_1 then "1" else let vps = List.fold_right (fun (x,k) a -> string_of_varpow x k :: a) (sort humanorder_varpow (graph m)) [] in end_itlist (fun s t -> s^"*"^t) vps;; let string_of_cmonomial (c,m) = if m = monomial_1 then string_of_num c else if c =/ Int 1 then string_of_monomial m else string_of_num c ^ "*" ^ string_of_monomial m;; let string_of_poly (p:poly) = if p = poly_0 then "<<0>>" else let cms = sort (fun (m1,_) (m2,_) -> humanorder_monomial m1 m2) (graph p) in let s = List.fold_left (fun a (m,c) -> if c >";; (* ------------------------------------------------------------------------- *) (* Printers. *) (* ------------------------------------------------------------------------- *) let print_vector v = Format.print_string(string_of_vector 0 20 v);; let print_matrix m = Format.print_string(string_of_matrix 20 m);; let print_monomial m = Format.print_string(string_of_monomial m);; let print_poly m = Format.print_string(string_of_poly m);; #install_printer print_vector;; #install_printer print_matrix;; #install_printer print_monomial;; #install_printer print_poly;; (* ------------------------------------------------------------------------- *) (* Conversion from HOL term. *) (* ------------------------------------------------------------------------- *) let poly_of_term = let neg_tm = `(--):real->real` and add_tm = `(+):real->real->real` and sub_tm = `(-):real->real->real` and mul_tm = `(*):real->real->real` and inv_tm = `(inv):real->real` and div_tm = `(/):real->real->real` and pow_tm = `(pow):real->num->real` and zero_tm = `&0:real` and real_ty = `:real` in let rec poly_of_term tm = if tm = zero_tm then poly_0 else if is_ratconst tm then poly_const(rat_of_term tm) else if not(is_comb tm) then poly_var tm else let lop,r = dest_comb tm in if lop = neg_tm then poly_neg(poly_of_term r) else if lop = inv_tm then let p = poly_of_term r in if poly_isconst p then poly_const(Int 1 // eval undefined p) else failwith "poly_of_term: inverse of non-constant polyomial" else if not(is_comb lop) then poly_var tm else let op,l = dest_comb lop in if op = pow_tm && is_numeral r then poly_pow (poly_of_term l) (dest_small_numeral r) else if op = add_tm then poly_add (poly_of_term l) (poly_of_term r) else if op = sub_tm then poly_sub (poly_of_term l) (poly_of_term r) else if op = mul_tm then poly_mul (poly_of_term l) (poly_of_term r) else if op = div_tm then let p = poly_of_term l and q = poly_of_term r in if poly_isconst q then poly_cmul (Int 1 // eval undefined q) p else failwith "poly_of_term: division by non-constant polynomial" else poly_var tm in fun tm -> if type_of tm = real_ty then poly_of_term tm else failwith "poly_of_term: term does not have real type";; (* ------------------------------------------------------------------------- *) (* String of vector (just a list of space-separated numbers). *) (* ------------------------------------------------------------------------- *) let sdpa_of_vector (v:vector) = let n = vec_dim v in let strs = map (decimalize 20 o element v) (1--n) in end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";; (* ------------------------------------------------------------------------- *) (* String for block diagonal matrix numbered k. *) (* ------------------------------------------------------------------------- *) let sdpa_of_blockdiagonal k m = let pfx = string_of_int k ^" " in let ents = foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in let entss = sort (increasing fst) ents in itlist (fun ((b,i,j),c) a -> pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^ " " ^ decimalize 20 c ^ "\n" ^ a) entss "";; (* ------------------------------------------------------------------------- *) (* String for a matrix numbered k, in SDPA sparse format. *) (* ------------------------------------------------------------------------- *) let sdpa_of_matrix k (m:matrix) = let pfx = string_of_int k ^ " 1 " in let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a) (snd m) [] in let mss = sort (increasing fst) ms in itlist (fun ((i,j),c) a -> pfx ^ string_of_int i ^ " " ^ string_of_int j ^ " " ^ decimalize 20 c ^ "\n" ^ a) mss "";; (* ------------------------------------------------------------------------- *) (* String in SDPA sparse format for standard SDP problem: *) (* *) (* X = v_1 * [M_1] + ... + v_m * [M_m] - [M_0] must be PSD *) (* Minimize obj_1 * v_1 + ... obj_m * v_m *) (* ------------------------------------------------------------------------- *) let sdpa_of_problem comment obj mats = let m = length mats - 1 and n,_ = dimensions (hd mats) in "\"" ^ comment ^ "\"\n" ^ string_of_int m ^ "\n" ^ "1\n" ^ string_of_int n ^ "\n" ^ sdpa_of_vector obj ^ itlist2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a) (1--length mats) mats "";; (* ------------------------------------------------------------------------- *) (* More parser basics. *) (* ------------------------------------------------------------------------- *) let word s = end_itlist (fun p1 p2 -> (p1 ++ p2) >> (fun (s,t) -> s^t)) (map a (explode s));; let token s = many (some isspace) ++ word s ++ many (some isspace) >> (fun ((_,t),_) -> t);; let decimal = let numeral = some isnum in let decimalint = atleast 1 numeral >> (Num.num_of_string o implode) in let decimalfrac = atleast 1 numeral >> (fun s -> Num.num_of_string(implode s) // pow10 (length s)) in let decimalsig = decimalint ++ possibly (a "." ++ decimalfrac >> snd) >> (function (h,[]) -> h | (h,[x]) -> h +/ x) in let signed prs = a "-" ++ prs >> (minus_num o snd) ||| (a "+" ++ prs >> snd) ||| prs in let exponent = (a "e" ||| a "E") ++ signed decimalint >> snd in signed decimalsig ++ possibly exponent >> (function (h,[]) -> h | (h,[x]) -> h */ power_num (Int 10) x);; let mkparser p s = let x,rst = p(explode s) in if rst = [] then x else failwith "mkparser: unparsed input";; let parse_decimal = mkparser decimal;; (* ------------------------------------------------------------------------- *) (* Parse back a vector. *) (* ------------------------------------------------------------------------- *) let parse_sdpaoutput,parse_csdpoutput = let vector = token "{" ++ listof decimal (token ",") "decimal" ++ token "}" >> (fun ((_,v),_) -> vec_of_list v) in let parse_vector = mkparser vector in let rec skipupto dscr prs inp = (dscr ++ prs >> snd ||| (some (fun c -> true) ++ skipupto dscr prs >> snd)) inp in let ignore inp = (),[] in let sdpaoutput = skipupto (word "xVec" ++ token "=") (vector ++ ignore >> fst) in let csdpoutput = (decimal ++ many(a " " ++ decimal >> snd) >> (fun (h,t) -> h::t)) ++ (a " " ++ a "\n" ++ ignore) >> (vec_of_list o fst) in mkparser sdpaoutput,mkparser csdpoutput;; (* ------------------------------------------------------------------------- *) (* Also parse the SDPA output to test success (CSDP yields a return code). *) (* ------------------------------------------------------------------------- *) let sdpa_run_succeeded = let rec skipupto dscr prs inp = (dscr ++ prs >> snd ||| (some (fun c -> true) ++ skipupto dscr prs >> snd)) inp in let prs = skipupto (word "phase.value" ++ token "=") (possibly (a "p") ++ possibly (a "d") ++ (word "OPT" ||| word "FEAS")) in fun s -> try prs (explode s); true with Noparse -> false;; (* ------------------------------------------------------------------------- *) (* The default parameters. Unfortunately this goes to a fixed file. *) (* ------------------------------------------------------------------------- *) let sdpa_default_parameters = "100 unsigned int maxIteration; 1.0E-7 double 0.0 < epsilonStar; 1.0E2 double 0.0 < lambdaStar; 2.0 double 1.0 < omegaStar; -1.0E5 double lowerBound; 1.0E5 double upperBound; 0.1 double 0.0 <= betaStar < 1.0; 0.2 double 0.0 <= betaBar < 1.0, betaStar <= betaBar; 0.9 double 0.0 < gammaStar < 1.0; 1.0E-7 double 0.0 < epsilonDash; ";; (* ------------------------------------------------------------------------- *) (* These were suggested by Makoto Yamashita for problems where we are *) (* right at the edge of the semidefinite cone, as sometimes happens. *) (* ------------------------------------------------------------------------- *) let sdpa_alt_parameters = "1000 unsigned int maxIteration; 1.0E-7 double 0.0 < epsilonStar; 1.0E4 double 0.0 < lambdaStar; 2.0 double 1.0 < omegaStar; -1.0E5 double lowerBound; 1.0E5 double upperBound; 0.1 double 0.0 <= betaStar < 1.0; 0.2 double 0.0 <= betaBar < 1.0, betaStar <= betaBar; 0.9 double 0.0 < gammaStar < 1.0; 1.0E-7 double 0.0 < epsilonDash; ";; let sdpa_params = sdpa_alt_parameters;; (* ------------------------------------------------------------------------- *) (* CSDP parameters; so far I'm sticking with the defaults. *) (* ------------------------------------------------------------------------- *) let csdp_default_parameters = "axtol=1.0e-8 atytol=1.0e-8 objtol=1.0e-8 pinftol=1.0e8 dinftol=1.0e8 maxiter=100 minstepfrac=0.9 maxstepfrac=0.97 minstepp=1.0e-8 minstepd=1.0e-8 usexzgap=1 tweakgap=0 affine=0 printlevel=1 ";; let csdp_params = csdp_default_parameters;; (* ------------------------------------------------------------------------- *) (* Now call SDPA on a problem and parse back the output. *) (* ------------------------------------------------------------------------- *) let run_sdpa dbg obj mats = let input_file = Filename.temp_file "sos" ".dat-s" in let output_file = String.sub input_file 0 (String.length input_file - 6) ^ ".out" and params_file = Filename.concat (!temp_path) "param.sdpa" in file_of_string input_file (sdpa_of_problem "" obj mats); file_of_string params_file sdpa_params; Sys.command("cd "^ !temp_path ^ "; sdpa "^input_file ^ " " ^ output_file ^ (if dbg then "" else "> /dev/null")); let op = string_of_file output_file in if not(sdpa_run_succeeded op) then failwith "sdpa: call failed" else let res = parse_sdpaoutput op in ((if dbg then () else (Sys.remove input_file; Sys.remove output_file)); res);; let sdpa obj mats = run_sdpa (!debugging) obj mats;; (* ------------------------------------------------------------------------- *) (* The same thing with CSDP. *) (* ------------------------------------------------------------------------- *) let run_csdp dbg obj mats = let input_file = Filename.temp_file "sos" ".dat-s" in let output_file = String.sub input_file 0 (String.length input_file - 6) ^ ".out" and params_file = Filename.concat (!temp_path) "param.csdp" in file_of_string input_file (sdpa_of_problem "" obj mats); file_of_string params_file csdp_params; let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^ " " ^ output_file ^ (if dbg then "" else "> /dev/null")) in let op = string_of_file output_file in let res = parse_csdpoutput op in ((if dbg then () else (Sys.remove input_file; Sys.remove output_file)); rv,res);; let csdp obj mats = let rv,res = run_csdp (!debugging) obj mats in (if rv = 1 || rv = 2 then failwith "csdp: Problem is infeasible" else if rv = 3 then (Format.print_string "csdp warning: Reduced accuracy"; Format.print_newline()) else if rv <> 0 then failwith("csdp: error "^string_of_int rv) else ()); res;; (* ------------------------------------------------------------------------- *) (* Try some apparently sensible scaling first. Note that this is purely to *) (* get a cleaner translation to floating-point, and doesn't affect any of *) (* the results, in principle. In practice it seems a lot better when there *) (* are extreme numbers in the original problem. *) (* ------------------------------------------------------------------------- *) let scale_then = let common_denominator amat acc = foldl (fun a m c -> lcm_num (denominator c) a) acc amat and maximal_element amat acc = foldl (fun maxa m c -> max_num maxa (abs_num c)) acc amat in fun solver obj mats -> let cd1 = itlist common_denominator mats (Int 1) and cd2 = common_denominator (snd obj) (Int 1) in let mats' = map (mapf (fun x -> cd1 */ x)) mats and obj' = vec_cmul cd2 obj in let max1 = itlist maximal_element mats' (Int 0) and max2 = maximal_element (snd obj') (Int 0) in let scal1 = pow2 (20-int_of_float(log(float_of_num max1) /. log 2.0)) and scal2 = pow2 (20-int_of_float(log(float_of_num max2) /. log 2.0)) in let mats'' = map (mapf (fun x -> x */ scal1)) mats' and obj'' = vec_cmul scal2 obj' in solver obj'' mats'';; (* ------------------------------------------------------------------------- *) (* Round a vector to "nice" rationals. *) (* ------------------------------------------------------------------------- *) let nice_rational n x = round_num (n */ x) // n;; let nice_vector n = mapa (nice_rational n);; (* ------------------------------------------------------------------------- *) (* Reduce linear program to SDP (diagonal matrices) and test with CSDP. This *) (* one tests A [-1;x1;..;xn] >= 0 (i.e. left column is negated constants). *) (* ------------------------------------------------------------------------- *) let linear_program_basic a = let m,n = dimensions a in let mats = map (fun j -> diagonal (column j a)) (1--n) and obj = vec_const (Int 1) m in let rv,res = run_csdp false obj mats in if rv = 1 || rv = 2 then false else if rv = 0 then true else failwith "linear_program: An error occurred in the SDP solver";; (* ------------------------------------------------------------------------- *) (* Alternative interface testing A x >= b for matrix A, vector b. *) (* ------------------------------------------------------------------------- *) let linear_program a b = let m,n = dimensions a in if vec_dim b <> m then failwith "linear_program: incompatible dimensions" else let mats = diagonal b :: map (fun j -> diagonal (column j a)) (1--n) and obj = vec_const (Int 1) m in let rv,res = run_csdp false obj mats in if rv = 1 || rv = 2 then false else if rv = 0 then true else failwith "linear_program: An error occurred in the SDP solver";; (* ------------------------------------------------------------------------- *) (* Test whether a point is in the convex hull of others. Rather than use *) (* computational geometry, express as linear inequalities and call CSDP. *) (* This is a bit lazy of me, but it's easy and not such a bottleneck so far. *) (* ------------------------------------------------------------------------- *) let in_convex_hull pts pt = let pts1 = (1::pt) :: map (fun x -> 1::x) pts in let pts2 = map (fun p -> map (fun x -> -x) p @ p) pts1 in let n = length pts + 1 and v = 2 * (length pt + 1) in let m = v + n - 1 in let mat = (m,n), itern 1 pts2 (fun pts j -> itern 1 pts (fun x i -> (i,j) |-> Int x)) (iter (1,n) (fun i -> (v + i,i+1) |-> Int 1) undefined) in linear_program_basic mat;; (* ------------------------------------------------------------------------- *) (* Filter down a set of points to a minimal set with the same convex hull. *) (* ------------------------------------------------------------------------- *) let minimal_convex_hull = let augment1 (m::ms) = if in_convex_hull ms m then ms else ms@[m] in let augment m ms = funpow 3 augment1 (m::ms) in fun mons -> let mons' = itlist augment (tl mons) [hd mons] in funpow (length mons') augment1 mons';; (* ------------------------------------------------------------------------- *) (* Stuff for "equations" (generic A->num functions). *) (* ------------------------------------------------------------------------- *) let equation_cmul c eq = if c =/ Int 0 then undefined else mapf (fun d -> c */ d) eq;; let equation_add eq1 eq2 = combine (+/) (fun x -> x =/ Int 0) eq1 eq2;; let equation_eval assig eq = let value v = apply assig v in foldl (fun a v c -> a +/ value(v) */ c) (Int 0) eq;; (* ------------------------------------------------------------------------- *) (* Eliminate among linear equations: return unconstrained variables and *) (* assignments for the others in terms of them. We give one pseudo-variable *) (* "one" that's used for a constant term. *) (* ------------------------------------------------------------------------- *) let eliminate_equations = let rec extract_first p l = match l with [] -> failwith "extract_first" | h::t -> if p(h) then h,t else let k,s = extract_first p t in k,h::s in let rec eliminate vars dun eqs = match vars with [] -> if forall is_undefined eqs then dun else raise Unsolvable | v::vs -> try let eq,oeqs = extract_first (fun e -> defined e v) eqs in let a = apply eq v in let eq' = equation_cmul (Int(-1) // a) (undefine v eq) in let elim e = let b = tryapplyd e v (Int 0) in if b =/ Int 0 then e else equation_add e (equation_cmul (minus_num b // a) eq) in eliminate vs ((v |-> eq') (mapf elim dun)) (map elim oeqs) with Failure _ -> eliminate vs dun eqs in fun one vars eqs -> let assig = eliminate vars undefined eqs in let vs = foldl (fun a x f -> subtract (dom f) [one] @ a) [] assig in setify vs,assig;; (* ------------------------------------------------------------------------- *) (* Eliminate all variables, in an essentially arbitrary order. *) (* ------------------------------------------------------------------------- *) let eliminate_all_equations one = let choose_variable eq = let (v,_) = choose eq in if v = one then let eq' = undefine v eq in if is_undefined eq' then failwith "choose_variable" else let (w,_) = choose eq' in w else v in let rec eliminate dun eqs = match eqs with [] -> dun | eq::oeqs -> if is_undefined eq then eliminate dun oeqs else let v = choose_variable eq in let a = apply eq v in let eq' = equation_cmul (Int(-1) // a) (undefine v eq) in let elim e = let b = tryapplyd e v (Int 0) in if b =/ Int 0 then e else equation_add e (equation_cmul (minus_num b // a) eq) in eliminate ((v |-> eq') (mapf elim dun)) (map elim oeqs) in fun eqs -> let assig = eliminate undefined eqs in let vs = foldl (fun a x f -> subtract (dom f) [one] @ a) [] assig in setify vs,assig;; (* ------------------------------------------------------------------------- *) (* Solve equations by assigning arbitrary numbers. *) (* ------------------------------------------------------------------------- *) let solve_equations one eqs = let vars,assigs = eliminate_all_equations one eqs in let vfn = itlist (fun v -> (v |-> Int 0)) vars (one |=> Int(-1)) in let ass = combine (+/) (fun c -> false) (mapf (equation_eval vfn) assigs) vfn in if forall (fun e -> equation_eval ass e =/ Int 0) eqs then undefine one ass else raise Sanity;; (* ------------------------------------------------------------------------- *) (* Hence produce the "relevant" monomials: those whose squares lie in the *) (* Newton polytope of the monomials in the input. (This is enough according *) (* to Reznik: "Extremal PSD forms with few terms", Duke Math. Journal, *) (* vol 45, pp. 363--374, 1978. *) (* *) (* These are ordered in sort of decreasing degree. In particular the *) (* constant monomial is last; this gives an order in diagonalization of the *) (* quadratic form that will tend to display constants. *) (* ------------------------------------------------------------------------- *) let newton_polytope pol = let vars = poly_variables pol in let mons = map (fun m -> map (fun x -> monomial_degree x m) vars) (dom pol) and ds = map (fun x -> (degree x pol + 1) / 2) vars in let all = itlist (fun n -> allpairs (fun h t -> h::t) (0--n)) ds [[]] and mons' = minimal_convex_hull mons in let all' = filter (fun m -> in_convex_hull mons' (map (fun x -> 2 * x) m)) all in map (fun m -> itlist2 (fun v i a -> if i = 0 then a else (v |-> i) a) vars m monomial_1) (rev all');; (* ------------------------------------------------------------------------- *) (* Diagonalize (Cholesky/LDU) the matrix corresponding to a quadratic form. *) (* ------------------------------------------------------------------------- *) let diag m = let nn = dimensions m in let n = fst nn in if snd nn <> n then failwith "diagonalize: non-square matrix" else let rec diagonalize i m = if is_zero m then [] else let a11 = element m (i,i) in if a11 a1k // a11) v in let m' = (n,n), iter (i+1,n) (fun j -> iter (i+1,n) (fun k -> ((j,k) |--> (element m (j,k) -/ element v j */ element v' k)))) undefined in (a11,v')::diagonalize (i + 1) m' in diagonalize 1 m;; (* ------------------------------------------------------------------------- *) (* Adjust a diagonalization to collect rationals at the start. *) (* ------------------------------------------------------------------------- *) let deration d = if d = [] then Int 0,d else let adj(c,l) = let a = foldl (fun a i c -> lcm_num a (denominator c)) (Int 1) (snd l) // foldl (fun a i c -> gcd_num a (numerator c)) (Int 0) (snd l) in (c // (a */ a)),mapa (fun x -> a */ x) l in let d' = map adj d in let a = itlist (lcm_num o denominator o fst) d' (Int 1) // itlist (gcd_num o numerator o fst) d' (Int 0) in (Int 1 // a),map (fun (c,l) -> (a */ c,l)) d';; (* ------------------------------------------------------------------------- *) (* Enumeration of monomials with given multidegree bound. *) (* ------------------------------------------------------------------------- *) let rec enumerate_monomials d vars = if d < 0 then [] else if d = 0 then [undefined] else if vars = [] then [monomial_1] else let alts = map (fun k -> let oths = enumerate_monomials (d - k) (tl vars) in map (fun ks -> if k = 0 then ks else (hd vars |-> k) ks) oths) (0--d) in end_itlist (@) alts;; (* ------------------------------------------------------------------------- *) (* Enumerate products of distinct input polys with degree <= d. *) (* We ignore any constant input polynomials. *) (* Give the output polynomial and a record of how it was derived. *) (* ------------------------------------------------------------------------- *) let rec enumerate_products d pols = if d = 0 then [poly_const num_1,Rational_lt num_1] else if d < 0 then [] else match pols with [] -> [poly_const num_1,Rational_lt num_1] | (p,b)::ps -> let e = multidegree p in if e = 0 then enumerate_products d ps else enumerate_products d ps @ map (fun (q,c) -> poly_mul p q,Product(b,c)) (enumerate_products (d - e) ps);; (* ------------------------------------------------------------------------- *) (* Multiply equation-parametrized poly by regular poly and add accumulator. *) (* ------------------------------------------------------------------------- *) let epoly_pmul p q acc = foldl (fun a m1 c -> foldl (fun b m2 e -> let m = monomial_mul m1 m2 in let es = tryapplyd b m undefined in (m |-> equation_add (equation_cmul c e) es) b) a q) acc p;; (* ------------------------------------------------------------------------- *) (* Usual operations on equation-parametrized poly. *) (* ------------------------------------------------------------------------- *) let epoly_cmul c l = if c =/ Int 0 then undefined else mapf (equation_cmul c) l;; (* ------------------------------------------------------------------------- *) (* Convert regular polynomial. Note that we treat (0,0,0) as -1. *) (* ------------------------------------------------------------------------- *) let epoly_of_poly p = foldl (fun a m c -> (m |-> ((0,0,0) |=> minus_num c)) a) undefined p;; (* ------------------------------------------------------------------------- *) (* String for block diagonal matrix numbered k. *) (* ------------------------------------------------------------------------- *) let sdpa_of_blockdiagonal k m = let pfx = string_of_int k ^" " in let ents = foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in let entss = sort (increasing fst) ents in itlist (fun ((b,i,j),c) a -> pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^ " " ^ decimalize 20 c ^ "\n" ^ a) entss "";; (* ------------------------------------------------------------------------- *) (* SDPA for problem using block diagonal (i.e. multiple SDPs) *) (* ------------------------------------------------------------------------- *) let sdpa_of_blockproblem comment nblocks blocksizes obj mats = let m = length mats - 1 in "\"" ^ comment ^ "\"\n" ^ string_of_int m ^ "\n" ^ string_of_int nblocks ^ "\n" ^ (end_itlist (fun s t -> s^" "^t) (map string_of_int blocksizes)) ^ "\n" ^ sdpa_of_vector obj ^ itlist2 (fun k m a -> sdpa_of_blockdiagonal (k - 1) m ^ a) (1--length mats) mats "";; (* ------------------------------------------------------------------------- *) (* Hence run CSDP on a problem in block diagonal form. *) (* ------------------------------------------------------------------------- *) let run_csdp dbg nblocks blocksizes obj mats = let input_file = Filename.temp_file "sos" ".dat-s" in let output_file = String.sub input_file 0 (String.length input_file - 6) ^ ".out" and params_file = Filename.concat (!temp_path) "param.csdp" in file_of_string input_file (sdpa_of_blockproblem "" nblocks blocksizes obj mats); file_of_string params_file csdp_params; let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^ " " ^ output_file ^ (if dbg then "" else "> /dev/null")) in let op = string_of_file output_file in let res = parse_csdpoutput op in ((if dbg then () else (Sys.remove input_file; Sys.remove output_file)); rv,res);; let csdp nblocks blocksizes obj mats = let rv,res = run_csdp (!debugging) nblocks blocksizes obj mats in (if rv = 1 || rv = 2 then failwith "csdp: Problem is infeasible" else if rv = 3 then (Format.print_string "csdp warning: Reduced accuracy"; Format.print_newline()) else if rv <> 0 then failwith("csdp: error "^string_of_int rv) else ()); res;; (* ------------------------------------------------------------------------- *) (* 3D versions of matrix operations to consider blocks separately. *) (* ------------------------------------------------------------------------- *) let bmatrix_add = combine (+/) (fun x -> x =/ Int 0);; let bmatrix_cmul c bm = if c =/ Int 0 then undefined else mapf (fun x -> c */ x) bm;; let bmatrix_neg = bmatrix_cmul (Int(-1));; let bmatrix_sub m1 m2 = bmatrix_add m1 (bmatrix_neg m2);; (* ------------------------------------------------------------------------- *) (* Smash a block matrix into components. *) (* ------------------------------------------------------------------------- *) let blocks blocksizes bm = map (fun (bs,b0) -> let m = foldl (fun a (b,i,j) c -> if b = b0 then ((i,j) |-> c) a else a) undefined bm in let d = foldl (fun a (i,j) c -> max a (max i j)) 0 m in (((bs,bs),m):matrix)) (zip blocksizes (1--length blocksizes));; (* ------------------------------------------------------------------------- *) (* Positiv- and Nullstellensatz. Flag "linf" forces a linear representation. *) (* ------------------------------------------------------------------------- *) let real_positivnullstellensatz_general linf d eqs leqs pol = let vars = itlist (union o poly_variables) (pol::eqs @ map fst leqs) [] in let monoid = if linf then (poly_const num_1,Rational_lt num_1):: (filter (fun (p,c) -> multidegree p <= d) leqs) else enumerate_products d leqs in let nblocks = length monoid in let mk_idmultiplier k p = let e = d - multidegree p in let mons = enumerate_monomials e vars in let nons = zip mons (1--length mons) in mons, itlist (fun (m,n) -> (m |-> ((-k,-n,n) |=> Int 1))) nons undefined in let mk_sqmultiplier k (p,c) = let e = (d - multidegree p) / 2 in let mons = enumerate_monomials e vars in let nons = zip mons (1--length mons) in mons, itlist (fun (m1,n1) -> itlist (fun (m2,n2) a -> let m = monomial_mul m1 m2 in if n1 > n2 then a else let c = if n1 = n2 then Int 1 else Int 2 in let e = tryapplyd a m undefined in (m |-> equation_add ((k,n1,n2) |=> c) e) a) nons) nons undefined in let sqmonlist,sqs = unzip(map2 mk_sqmultiplier (1--length monoid) monoid) and idmonlist,ids = unzip(map2 mk_idmultiplier (1--length eqs) eqs) in let blocksizes = map length sqmonlist in let bigsum = itlist2 (fun p q a -> epoly_pmul p q a) eqs ids (itlist2 (fun (p,c) s a -> epoly_pmul p s a) monoid sqs (epoly_of_poly(poly_neg pol))) in let eqns = foldl (fun a m e -> e::a) [] bigsum in let pvs,assig = eliminate_all_equations (0,0,0) eqns in let qvars = (0,0,0)::pvs in let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in let mk_matrix v = foldl (fun m (b,i,j) ass -> if b < 0 then m else let c = tryapplyd ass v (Int 0) in if c =/ Int 0 then m else ((b,j,i) |-> c) (((b,i,j) |-> c) m)) undefined allassig in let diagents = foldl (fun a (b,i,j) e -> if b > 0 && i = j then equation_add e a else a) undefined allassig in let mats = map mk_matrix qvars and obj = length pvs, itern 1 pvs (fun v i -> (i |--> tryapplyd diagents v (Int 0))) undefined in let raw_vec = if pvs = [] then vec_0 0 else scale_then (csdp nblocks blocksizes) obj mats in let find_rounding d = (if !debugging then (Format.print_string("Trying rounding with limit "^string_of_num d); Format.print_newline()) else ()); let vec = nice_vector d raw_vec in let blockmat = iter (1,vec_dim vec) (fun i a -> bmatrix_add (bmatrix_cmul (element vec i) (el i mats)) a) (bmatrix_neg (el 0 mats)) in let allmats = blocks blocksizes blockmat in vec,map diag allmats in let vec,ratdias = if pvs = [] then find_rounding num_1 else tryfind find_rounding (map Num.num_of_int (1--31) @ map pow2 (5--66)) in let newassigs = itlist (fun k -> el (k - 1) pvs |-> element vec k) (1--vec_dim vec) ((0,0,0) |=> Int(-1)) in let finalassigs = foldl (fun a v e -> (v |-> equation_eval newassigs e) a) newassigs allassig in let poly_of_epoly p = foldl (fun a v e -> (v |--> equation_eval finalassigs e) a) undefined p in let mk_sos mons = let mk_sq (c,m) = c,itlist (fun k a -> (el (k - 1) mons |--> element m k) a) (1--length mons) undefined in map mk_sq in let sqs = map2 mk_sos sqmonlist ratdias and cfs = map poly_of_epoly ids in let msq = filter (fun (a,b) -> b <> []) (map2 (fun a b -> a,b) monoid sqs) in let eval_sq sqs = itlist (fun (c,q) -> poly_add (poly_cmul c (poly_mul q q))) sqs poly_0 in let sanity = itlist (fun ((p,c),s) -> poly_add (poly_mul p (eval_sq s))) msq (itlist2 (fun p q -> poly_add (poly_mul p q)) cfs eqs (poly_neg pol)) in if not(is_undefined sanity) then raise Sanity else cfs,map (fun (a,b) -> snd a,b) msq;; (* ------------------------------------------------------------------------- *) (* Iterative deepening. *) (* ------------------------------------------------------------------------- *) let rec deepen f n = try print_string "Searching with depth limit "; print_int n; print_newline(); f n with Failure _ -> deepen f (n + 1);; (* ------------------------------------------------------------------------- *) (* The ordering so we can create canonical HOL polynomials. *) (* ------------------------------------------------------------------------- *) let dest_monomial mon = sort (increasing fst) (graph mon);; let monomial_order = let rec lexorder l1 l2 = match (l1,l2) with [],[] -> true | vps,[] -> false | [],vps -> true | ((x1,n1)::vs1),((x2,n2)::vs2) -> if x1 < x2 then true else if x2 < x1 then false else if n1 < n2 then false else if n2 < n1 then true else lexorder vs1 vs2 in fun m1 m2 -> if m2 = monomial_1 then true else if m1 = monomial_1 then false else let mon1 = dest_monomial m1 and mon2 = dest_monomial m2 in let deg1 = itlist ((+) o snd) mon1 0 and deg2 = itlist ((+) o snd) mon2 0 in if deg1 < deg2 then false else if deg1 > deg2 then true else lexorder mon1 mon2;; let dest_poly p = map (fun (m,c) -> c,dest_monomial m) (sort (fun (m1,_) (m2,_) -> monomial_order m1 m2) (graph p));; (* ------------------------------------------------------------------------- *) (* Map back polynomials and their composites to HOL. *) (* ------------------------------------------------------------------------- *) let term_of_varpow = let pow_tm = `(pow):real->num->real` in fun x k -> if k = 1 then x else mk_comb(mk_comb(pow_tm,x),mk_small_numeral k);; let term_of_monomial = let one_tm = `&1:real` and mul_tm = `(*):real->real->real` in fun m -> if m = monomial_1 then one_tm else let m' = dest_monomial m in let vps = itlist (fun (x,k) a -> term_of_varpow x k :: a) m' [] in end_itlist (fun s t -> mk_comb(mk_comb(mul_tm,s),t)) vps;; let term_of_cmonomial = let mul_tm = `(*):real->real->real` in fun (m,c) -> if m = monomial_1 then term_of_rat c else if c =/ num_1 then term_of_monomial m else mk_comb(mk_comb(mul_tm,term_of_rat c),term_of_monomial m);; let term_of_poly = let zero_tm = `&0:real` and add_tm = `(+):real->real->real` in fun p -> if p = poly_0 then zero_tm else let cms = map term_of_cmonomial (sort (fun (m1,_) (m2,_) -> monomial_order m1 m2) (graph p)) in end_itlist (fun t1 t2 -> mk_comb(mk_comb(add_tm,t1),t2)) cms;; let term_of_sqterm (c,p) = Product(Rational_lt c,Square(term_of_poly p));; let term_of_sos (pr,sqs) = if sqs = [] then pr else Product(pr,end_itlist (fun a b -> Sum(a,b)) (map term_of_sqterm sqs));; (* ------------------------------------------------------------------------- *) (* Interface to HOL. *) (* ------------------------------------------------------------------------- *) let REAL_NONLINEAR_PROVER translator (eqs,les,lts) = let eq0 = map (poly_of_term o lhand o concl) eqs and le0 = map (poly_of_term o lhand o concl) les and lt0 = map (poly_of_term o lhand o concl) lts in let eqp0 = map (fun (t,i) -> t,Axiom_eq i) (zip eq0 (0--(length eq0 - 1))) and lep0 = map (fun (t,i) -> t,Axiom_le i) (zip le0 (0--(length le0 - 1))) and ltp0 = map (fun (t,i) -> t,Axiom_lt i) (zip lt0 (0--(length lt0 - 1))) in let keq,eq = partition (fun (p,_) -> multidegree p = 0) eqp0 and klep,lep = partition (fun (p,_) -> multidegree p = 0) lep0 and kltp,ltp = partition (fun (p,_) -> multidegree p = 0) ltp0 in let trivial_axiom (p,ax) = match ax with Axiom_eq n when eval undefined p <>/ num_0 -> el n eqs | Axiom_le n when eval undefined p el n les | Axiom_lt n when eval undefined p <=/ num_0 -> el n lts | _ -> failwith "not a trivial axiom" in try let th = tryfind trivial_axiom (keq @ klep @ kltp) in CONV_RULE (LAND_CONV REAL_POLY_CONV THENC REAL_RAT_RED_CONV) th with Failure _ -> let pol = itlist poly_mul (map fst ltp) (poly_const num_1) in let leq = lep @ ltp in let tryall d = let e = multidegree pol in let k = if e = 0 then 0 else d / e in let eq' = map fst eq in tryfind (fun i -> d,i,real_positivnullstellensatz_general false d eq' leq (poly_neg(poly_pow pol i))) (0--k) in let d,i,(cert_ideal,cert_cone) = deepen tryall 0 in let proofs_ideal = map2 (fun q (p,ax) -> Eqmul(term_of_poly q,ax)) cert_ideal eq and proofs_cone = map term_of_sos cert_cone and proof_ne = if ltp = [] then Rational_lt num_1 else let p = end_itlist (fun s t -> Product(s,t)) (map snd ltp) in funpow i (fun q -> Product(p,q)) (Rational_lt num_1) in let proof = end_itlist (fun s t -> Sum(s,t)) (proof_ne :: proofs_ideal @ proofs_cone) in print_string("Translating proof certificate to HOL"); print_newline(); translator (eqs,les,lts) proof;; (* ------------------------------------------------------------------------- *) (* A wrapper that tries to substitute away variables first. *) (* ------------------------------------------------------------------------- *) let REAL_NONLINEAR_SUBST_PROVER = let zero = `&0:real` and mul_tm = `( * ):real->real->real` and shuffle1 = CONV_RULE(REWR_CONV(REAL_ARITH `a + x = (y:real) <=> x = y - a`)) and shuffle2 = CONV_RULE(REWR_CONV(REAL_ARITH `x + a = (y:real) <=> x = y - a`)) in let rec substitutable_monomial fvs tm = match tm with Var(_,Tyapp("real",[])) when not (mem tm fvs) -> Int 1,tm | Comb(Comb(Const("real_mul",_),c),(Var(_,_) as t)) when is_ratconst c && not (mem t fvs) -> rat_of_term c,t | Comb(Comb(Const("real_add",_),s),t) -> (try substitutable_monomial (union (frees t) fvs) s with Failure _ -> substitutable_monomial (union (frees s) fvs) t) | _ -> failwith "substitutable_monomial" and isolate_variable v th = match lhs(concl th) with x when x = v -> th | Comb(Comb(Const("real_add",_),(Var(_,Tyapp("real",[])) as x)),t) when x = v -> shuffle2 th | Comb(Comb(Const("real_add",_),s),t) -> isolate_variable v(shuffle1 th) in let make_substitution th = let (c,v) = substitutable_monomial [] (lhs(concl th)) in let th1 = AP_TERM (mk_comb(mul_tm,term_of_rat(Int 1 // c))) th in let th2 = CONV_RULE(BINOP_CONV REAL_POLY_MUL_CONV) th1 in CONV_RULE (RAND_CONV REAL_POLY_CONV) (isolate_variable v th2) in fun translator -> let rec substfirst(eqs,les,lts) = try let eth = tryfind make_substitution eqs in let modify = CONV_RULE(LAND_CONV(SUBS_CONV[eth] THENC REAL_POLY_CONV)) in substfirst(filter (fun t -> lhand(concl t) <> zero) (map modify eqs), map modify les,map modify lts) with Failure _ -> REAL_NONLINEAR_PROVER translator (eqs,les,lts) in substfirst;; (* ------------------------------------------------------------------------- *) (* Overall function. *) (* ------------------------------------------------------------------------- *) let REAL_SOS = let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] and pure = GEN_REAL_ARITH REAL_NONLINEAR_SUBST_PROVER in fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; (* ------------------------------------------------------------------------- *) (* Add hacks for division. *) (* ------------------------------------------------------------------------- *) let REAL_SOSFIELD = let inv_tm = `inv:real->real` in let prenex_conv = TOP_DEPTH_CONV BETA_CONV THENC PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; real_div; REAL_INV_INV; REAL_INV_MUL; GSYM REAL_POW_INV] THENC NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC PRENEX_CONV and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV and core_rule t = try REAL_ARITH t with Failure _ -> try REAL_RING t with Failure _ -> REAL_SOS t and is_inv = let is_div = is_binop `(/):real->real->real` in fun tm -> (is_div tm || (is_comb tm && rator tm = inv_tm)) & not(is_ratconst(rand tm)) in let BASIC_REAL_FIELD tm = let is_freeinv t = is_inv t && free_in t tm in let itms = setify(map rand (find_terms is_freeinv tm)) in let hyps = map (fun t -> SPEC t REAL_MUL_RINV) itms in let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in let itms' = map (curry mk_comb inv_tm) itms in let gvs = map (genvar o type_of) itms' in let tm'' = subst (zip gvs itms') tm' in let th1 = setup_conv tm'' in let cjs = conjuncts(rand(concl th1)) in let ths = map core_rule cjs in let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in rev_itlist (C MP) hyps (INST (zip itms' gvs) th2) in fun tm -> let th0 = prenex_conv tm in let tm0 = rand(concl th0) in let avs,bod = strip_forall tm0 in let th1 = setup_conv bod in let ths = map BASIC_REAL_FIELD (conjuncts(rand(concl th1))) in EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; (* ------------------------------------------------------------------------- *) (* Integer version. *) (* ------------------------------------------------------------------------- *) let INT_SOS = let atom_CONV = let pth = prove (`(~(x <= y) <=> y + &1 <= x:int) /\ (~(x < y) <=> y <= x) /\ (~(x = y) <=> x + &1 <= y \/ y + &1 <= x) /\ (x < y <=> x + &1 <= y)`, REWRITE_TAC[INT_NOT_LE; INT_NOT_LT; INT_NOT_EQ; INT_LT_DISCRETE]) in GEN_REWRITE_CONV I [pth] and bub_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV [int_eq; int_le; int_lt; int_ge; int_gt; int_of_num_th; int_neg_th; int_add_th; int_mul_th; int_sub_th; int_pow_th; int_abs_th; int_max_th; int_min_th] in let base_CONV = TRY_CONV atom_CONV THENC bub_CONV in let NNF_NORM_CONV = GEN_NNF_CONV false (base_CONV,fun t -> base_CONV t,base_CONV(mk_neg t)) in let init_CONV = GEN_REWRITE_CONV DEPTH_CONV [FORALL_SIMP; EXISTS_SIMP] THENC GEN_REWRITE_CONV DEPTH_CONV [INT_GT; INT_GE] THENC CONDS_ELIM_CONV THENC NNF_NORM_CONV in let p_tm = `p:bool` and not_tm = `(~)` in let pth = TAUT(mk_eq(mk_neg(mk_neg p_tm),p_tm)) in fun tm -> let th0 = INST [tm,p_tm] pth and th1 = NNF_NORM_CONV(mk_neg tm) in let th2 = REAL_SOS(mk_neg(rand(concl th1))) in EQ_MP th0 (EQ_MP (AP_TERM not_tm (SYM th1)) th2);; (* ------------------------------------------------------------------------- *) (* Natural number version. *) (* ------------------------------------------------------------------------- *) let SOS_RULE tm = let avs = frees tm in let tm' = list_mk_forall(avs,tm) in let th1 = NUM_TO_INT_CONV tm' in let th2 = INT_SOS (rand(concl th1)) in SPECL avs (EQ_MP (SYM th1) th2);; (* ------------------------------------------------------------------------- *) (* Now pure SOS stuff. *) (* ------------------------------------------------------------------------- *) prioritize_real();; (* ------------------------------------------------------------------------- *) (* Some combinatorial helper functions. *) (* ------------------------------------------------------------------------- *) let rec allpermutations l = if l = [] then [[]] else itlist (fun h acc -> map (fun t -> h::t) (allpermutations (subtract l [h])) @ acc) l [];; let allvarorders l = map (fun vlis x -> index x vlis) (allpermutations l);; let changevariables_monomial zoln (m:monomial) = foldl (fun a x k -> (assoc x zoln |-> k) a) monomial_1 m;; let changevariables zoln pol = foldl (fun a m c -> (changevariables_monomial zoln m |-> c) a) poly_0 pol;; (* ------------------------------------------------------------------------- *) (* Return to original non-block matrices. *) (* ------------------------------------------------------------------------- *) let sdpa_of_vector (v:vector) = let n = vec_dim v in let strs = map (decimalize 20 o element v) (1--n) in end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";; let sdpa_of_blockdiagonal k m = let pfx = string_of_int k ^" " in let ents = foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in let entss = sort (increasing fst) ents in itlist (fun ((b,i,j),c) a -> pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^ " " ^ decimalize 20 c ^ "\n" ^ a) entss "";; let sdpa_of_matrix k (m:matrix) = let pfx = string_of_int k ^ " 1 " in let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a) (snd m) [] in let mss = sort (increasing fst) ms in itlist (fun ((i,j),c) a -> pfx ^ string_of_int i ^ " " ^ string_of_int j ^ " " ^ decimalize 20 c ^ "\n" ^ a) mss "";; let sdpa_of_problem comment obj mats = let m = length mats - 1 and n,_ = dimensions (hd mats) in "\"" ^ comment ^ "\"\n" ^ string_of_int m ^ "\n" ^ "1\n" ^ string_of_int n ^ "\n" ^ sdpa_of_vector obj ^ itlist2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a) (1--length mats) mats "";; let run_sdpa dbg obj mats = let input_file = Filename.temp_file "sos" ".dat-s" in let output_file = String.sub input_file 0 (String.length input_file - 6) ^ ".out" and params_file = Filename.concat (!temp_path) "param.sdpa" in file_of_string input_file (sdpa_of_problem "" obj mats); file_of_string params_file sdpa_params; Sys.command("cd "^(!temp_path)^"; sdpa "^input_file ^ " " ^ output_file ^ (if dbg then "" else "> /dev/null")); let op = string_of_file output_file in if not(sdpa_run_succeeded op) then failwith "sdpa: call failed" else let res = parse_sdpaoutput op in ((if dbg then () else (Sys.remove input_file; Sys.remove output_file)); res);; let sdpa obj mats = run_sdpa (!debugging) obj mats;; let run_csdp dbg obj mats = let input_file = Filename.temp_file "sos" ".dat-s" in let output_file = String.sub input_file 0 (String.length input_file - 6) ^ ".out" and params_file = Filename.concat (!temp_path) "param.csdp" in file_of_string input_file (sdpa_of_problem "" obj mats); file_of_string params_file csdp_params; let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^ " " ^ output_file ^ (if dbg then "" else "> /dev/null")) in let op = string_of_file output_file in let res = parse_csdpoutput op in ((if dbg then () else (Sys.remove input_file; Sys.remove output_file)); rv,res);; let csdp obj mats = let rv,res = run_csdp (!debugging) obj mats in (if rv = 1 || rv = 2 then failwith "csdp: Problem is infeasible" else if rv = 3 then (Format.print_string "csdp warning: Reduced accuracy"; Format.print_newline()) else if rv <> 0 then failwith("csdp: error "^string_of_int rv) else ()); res;; (* ------------------------------------------------------------------------- *) (* Sum-of-squares function with some lowbrow symmetry reductions. *) (* ------------------------------------------------------------------------- *) let sumofsquares_general_symmetry tool pol = let vars = poly_variables pol and lpps = newton_polytope pol in let n = length lpps in let sym_eqs = let invariants = filter (fun vars' -> is_undefined(poly_sub pol (changevariables (zip vars vars') pol))) (allpermutations vars) in let lpps2 = allpairs monomial_mul lpps lpps in let lpp2_classes = setify(map (fun m -> setify(map (fun vars' -> changevariables_monomial (zip vars vars') m) invariants)) lpps2) in let lpns = zip lpps (1--length lpps) in let lppcs = filter (fun (m,(n1,n2)) -> n1 <= n2) (allpairs (fun (m1,n1) (m2,n2) -> (m1,m2),(n1,n2)) lpns lpns) in let clppcs = end_itlist (@) (map (fun ((m1,m2),(n1,n2)) -> map (fun vars' -> (changevariables_monomial (zip vars vars') m1, changevariables_monomial (zip vars vars') m2),(n1,n2)) invariants) lppcs) in let clppcs_dom = setify(map fst clppcs) in let clppcs_cls = map (fun d -> filter (fun (e,_) -> e = d) clppcs) clppcs_dom in let eqvcls = map (setify o map snd) clppcs_cls in let mk_eq cls acc = match cls with [] -> raise Sanity | [h] -> acc | h::t -> map (fun k -> (k |-> Int(-1)) (h |=> Int 1)) t @ acc in itlist mk_eq eqvcls [] in let eqs = foldl (fun a x y -> y::a) [] (itern 1 lpps (fun m1 n1 -> itern 1 lpps (fun m2 n2 f -> let m = monomial_mul m1 m2 in if n1 > n2 then f else let c = if n1 = n2 then Int 1 else Int 2 in (m |-> ((n1,n2) |-> c) (tryapplyd f m undefined)) f)) (foldl (fun a m c -> (m |-> ((0,0)|=>c)) a) undefined pol)) @ sym_eqs in let pvs,assig = eliminate_all_equations (0,0) eqs in let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in let qvars = (0,0)::pvs in let diagents = end_itlist equation_add (map (fun i -> apply allassig (i,i)) (1--n)) in let mk_matrix v = ((n,n), foldl (fun m (i,j) ass -> let c = tryapplyd ass v (Int 0) in if c =/ Int 0 then m else ((j,i) |-> c) (((i,j) |-> c) m)) undefined allassig :matrix) in let mats = map mk_matrix qvars and obj = length pvs, itern 1 pvs (fun v i -> (i |--> tryapplyd diagents v (Int 0))) undefined in let raw_vec = if pvs = [] then vec_0 0 else tool obj mats in let find_rounding d = (if !debugging then (Format.print_string("Trying rounding with limit "^string_of_num d); Format.print_newline()) else ()); let vec = nice_vector d raw_vec in let mat = iter (1,vec_dim vec) (fun i a -> matrix_add (matrix_cmul (element vec i) (el i mats)) a) (matrix_neg (el 0 mats)) in deration(diag mat) in let rat,dia = if pvs = [] then let mat = matrix_neg (el 0 mats) in deration(diag mat) else tryfind find_rounding (map Num.num_of_int (1--31) @ map pow2 (5--66)) in let poly_of_lin(d,v) = d,foldl(fun a i c -> (el (i - 1) lpps |-> c) a) undefined (snd v) in let lins = map poly_of_lin dia in let sqs = map (fun (d,l) -> poly_mul (poly_const d) (poly_pow l 2)) lins in let sos = poly_cmul rat (end_itlist poly_add sqs) in if is_undefined(poly_sub sos pol) then rat,lins else raise Sanity;; let sumofsquares = sumofsquares_general_symmetry csdp;; (* ------------------------------------------------------------------------- *) (* Pure HOL SOS conversion. *) (* ------------------------------------------------------------------------- *) let SOS_CONV = let mk_square = let pow_tm = `(pow)` and two_tm = `2` in fun tm -> mk_comb(mk_comb(pow_tm,tm),two_tm) and mk_prod = mk_binop `(*)` and mk_sum = mk_binop `(+)` in fun tm -> let k,sos = sumofsquares(poly_of_term tm) in let mk_sqtm(c,p) = mk_prod (term_of_rat(k */ c)) (mk_square(term_of_poly p)) in let tm' = end_itlist mk_sum (map mk_sqtm sos) in let th = REAL_POLY_CONV tm and th' = REAL_POLY_CONV tm' in TRANS th (SYM th');; (* ------------------------------------------------------------------------- *) (* Attempt to prove &0 <= x by direct SOS decomposition. *) (* ------------------------------------------------------------------------- *) let PURE_SOS_TAC = let tac = MATCH_ACCEPT_TAC(REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE) ORELSE MATCH_ACCEPT_TAC REAL_LE_SQUARE ORELSE (MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) ORELSE (MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) ORELSE CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV THENC REAL_RAT_LE_CONV) in REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN GEN_REWRITE_TAC I [GSYM REAL_SUB_LE] THEN CONV_TAC(RAND_CONV SOS_CONV) THEN REPEAT tac THEN NO_TAC;; let PURE_SOS tm = prove(tm,PURE_SOS_TAC);; (* ------------------------------------------------------------------------- *) (* Examples. *) (* ------------------------------------------------------------------------- *) (***** time REAL_SOS `a1 >= &0 /\ a2 >= &0 /\ (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + &2) /\ (a1 * b1 + a2 * b2 = &0) ==> a1 * a2 - b1 * b2 >= &0`;; time REAL_SOS `&3 * x + &7 * a < &4 /\ &3 < &2 * x ==> a < &0`;; time REAL_SOS `b pow 2 < &4 * a * c ==> ~(a * x pow 2 + b * x + c = &0)`;; time REAL_SOS `(a * x pow 2 + b * x + c = &0) ==> b pow 2 >= &4 * a * c`;; time REAL_SOS `&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 ==> x pow 2 + y pow 2 < &1 \/ (x - &1) pow 2 + y pow 2 < &1 \/ x pow 2 + (y - &1) pow 2 < &1 \/ (x - &1) pow 2 + (y - &1) pow 2 < &1`;; time REAL_SOS `&0 <= b /\ &0 <= c /\ &0 <= x /\ &0 <= y /\ (x pow 2 = c) /\ (y pow 2 = a pow 2 * c + b) ==> a * c <= y * x`;; time REAL_SOS `&0 <= x /\ &0 <= y /\ &0 <= z /\ x + y + z <= &3 ==> x * y + x * z + y * z >= &3 * x * y * z`;; time REAL_SOS `(x pow 2 + y pow 2 + z pow 2 = &1) ==> (x + y + z) pow 2 <= &3`;; time REAL_SOS `(w pow 2 + x pow 2 + y pow 2 + z pow 2 = &1) ==> (w + x + y + z) pow 2 <= &4`;; time REAL_SOS `x >= &1 /\ y >= &1 ==> x * y >= x + y - &1`;; time REAL_SOS `x > &1 /\ y > &1 ==> x * y > x + y - &1`;; time REAL_SOS `abs(x) <= &1 ==> abs(&64 * x pow 7 - &112 * x pow 5 + &56 * x pow 3 - &7 * x) <= &1`;; time REAL_SOS `abs(x - z) <= e /\ abs(y - z) <= e /\ &0 <= u /\ &0 <= v /\ (u + v = &1) ==> abs((u * x + v * y) - z) <= e`;; (* ------------------------------------------------------------------------- *) (* One component of denominator in dodecahedral example. *) (* ------------------------------------------------------------------------- *) time REAL_SOS `&2 <= x /\ x <= &125841 / &50000 /\ &2 <= y /\ y <= &125841 / &50000 /\ &2 <= z /\ z <= &125841 / &50000 ==> &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z) >= &0`;; (* ------------------------------------------------------------------------- *) (* Over a larger but simpler interval. *) (* ------------------------------------------------------------------------- *) time REAL_SOS `&2 <= x /\ x <= &4 /\ &2 <= y /\ y <= &4 /\ &2 <= z /\ z <= &4 ==> &0 <= &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)`;; (* ------------------------------------------------------------------------- *) (* We can do 12. I think 12 is a sharp bound; see PP's certificate. *) (* ------------------------------------------------------------------------- *) time REAL_SOS `&2 <= x /\ x <= &4 /\ &2 <= y /\ y <= &4 /\ &2 <= z /\ z <= &4 ==> &12 <= &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)`;; (* ------------------------------------------------------------------------- *) (* Gloptipoly example. *) (* ------------------------------------------------------------------------- *) (*** This works but normalization takes minutes time REAL_SOS `(x - y - &2 * x pow 4 = &0) /\ &0 <= x /\ x <= &2 /\ &0 <= y /\ y <= &3 ==> y pow 2 - &7 * y - &12 * x + &17 >= &0`;; ***) (* ------------------------------------------------------------------------- *) (* Inequality from sci.math (see "Leon-Sotelo, por favor"). *) (* ------------------------------------------------------------------------- *) time REAL_SOS `&0 <= x /\ &0 <= y /\ (x * y = &1) ==> x + y <= x pow 2 + y pow 2`;; time REAL_SOS `&0 <= x /\ &0 <= y /\ (x * y = &1) ==> x * y * (x + y) <= x pow 2 + y pow 2`;; time REAL_SOS `&0 <= x /\ &0 <= y ==> x * y * (x + y) pow 2 <= (x pow 2 + y pow 2) pow 2`;; (* ------------------------------------------------------------------------- *) (* Some examples over integers and natural numbers. *) (* ------------------------------------------------------------------------- *) time SOS_RULE `!m n. 2 * m + n = (n + m) + m`;; time SOS_RULE `!n. ~(n = 0) ==> (0 MOD n = 0)`;; time SOS_RULE `!m n. m < n ==> (m DIV n = 0)`;; time SOS_RULE `!n:num. n <= n * n`;; time SOS_RULE `!m n. n * (m DIV n) <= m`;; time SOS_RULE `!n. ~(n = 0) ==> (0 DIV n = 0)`;; time SOS_RULE `!m n p. ~(p = 0) /\ m <= n ==> m DIV p <= n DIV p`;; time SOS_RULE `!a b n. ~(a = 0) ==> (n <= b DIV a <=> a * n <= b)`;; (* ------------------------------------------------------------------------- *) (* This is particularly gratifying --- cf hideous manual proof in arith.ml *) (* ------------------------------------------------------------------------- *) (*** This doesn't now seem to work as well as it did; what changed? time SOS_RULE `!a b c d. ~(b = 0) /\ b * c < (a + 1) * d ==> c DIV d <= a DIV b`;; ***) (* ------------------------------------------------------------------------- *) (* Key lemma for injectivity of Cantor-type pairing functions. *) (* ------------------------------------------------------------------------- *) time SOS_RULE `!x1 y1 x2 y2. ((x1 + y1) EXP 2 + x1 + 1 = (x2 + y2) EXP 2 + x2 + 1) ==> (x1 + y1 = x2 + y2)`;; time SOS_RULE `!x1 y1 x2 y2. ((x1 + y1) EXP 2 + x1 + 1 = (x2 + y2) EXP 2 + x2 + 1) /\ (x1 + y1 = x2 + y2) ==> (x1 = x2) /\ (y1 = y2)`;; time SOS_RULE `!x1 y1 x2 y2. (((x1 + y1) EXP 2 + 3 * x1 + y1) DIV 2 = ((x2 + y2) EXP 2 + 3 * x2 + y2) DIV 2) ==> (x1 + y1 = x2 + y2)`;; time SOS_RULE `!x1 y1 x2 y2. (((x1 + y1) EXP 2 + 3 * x1 + y1) DIV 2 = ((x2 + y2) EXP 2 + 3 * x2 + y2) DIV 2) /\ (x1 + y1 = x2 + y2) ==> (x1 = x2) /\ (y1 = y2)`;; (* ------------------------------------------------------------------------- *) (* Reciprocal multiplication (actually just ARITH_RULE does these). *) (* ------------------------------------------------------------------------- *) time SOS_RULE `x <= 127 ==> ((86 * x) DIV 256 = x DIV 3)`;; time SOS_RULE `x < 2 EXP 16 ==> ((104858 * x) DIV (2 EXP 20) = x DIV 10)`;; (* ------------------------------------------------------------------------- *) (* This is more impressive since it's really nonlinear. See REMAINDER_DECODE *) (* ------------------------------------------------------------------------- *) time SOS_RULE `0 < m /\ m < n ==> ((m * ((n * x) DIV m + 1)) DIV n = x)`;; (* ------------------------------------------------------------------------- *) (* Some conversion examples. *) (* ------------------------------------------------------------------------- *) time SOS_CONV `&2 * x pow 4 + &2 * x pow 3 * y - x pow 2 * y pow 2 + &5 * y pow 4`;; time SOS_CONV `x pow 4 - (&2 * y * z + &1) * x pow 2 + (y pow 2 * z pow 2 + &2 * y * z + &2)`;; time SOS_CONV `&4 * x pow 4 + &4 * x pow 3 * y - &7 * x pow 2 * y pow 2 - &2 * x * y pow 3 + &10 * y pow 4`;; time SOS_CONV `&4 * x pow 4 * y pow 6 + x pow 2 - x * y pow 2 + y pow 2`;; time SOS_CONV `&4096 * (x pow 4 + x pow 2 + z pow 6 - &3 * x pow 2 * z pow 2) + &729`;; time SOS_CONV `&120 * x pow 2 - &63 * x pow 4 + &10 * x pow 6 + &30 * x * y - &120 * y pow 2 + &120 * y pow 4 + &31`;; time SOS_CONV `&9 * x pow 2 * y pow 4 + &9 * x pow 2 * z pow 4 + &36 * x pow 2 * y pow 3 + &36 * x pow 2 * y pow 2 - &48 * x * y * z pow 2 + &4 * y pow 4 + &4 * z pow 4 - &16 * y pow 3 + &16 * y pow 2`;; time SOS_CONV `(x pow 2 + y pow 2 + z pow 2) * (x pow 4 * y pow 2 + x pow 2 * y pow 4 + z pow 6 - &3 * x pow 2 * y pow 2 * z pow 2)`;; time SOS_CONV `x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z + &3`;; (*** I think this will work, but normalization is slow time SOS_CONV `&100 * (x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z) + &212`;; ***) time SOS_CONV `&100 * ((&2 * x - &2) pow 2 + (x pow 3 - &8 * x - &2) pow 2) - &588`;; time SOS_CONV `x pow 2 * (&120 - &63 * x pow 2 + &10 * x pow 4) + &30 * x * y + &30 * y pow 2 * (&4 * y pow 2 - &4) + &31`;; (* ------------------------------------------------------------------------- *) (* Example of basic rule. *) (* ------------------------------------------------------------------------- *) time PURE_SOS `!x. x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z + &3 >= &1 / &7`;; time PURE_SOS `&0 <= &98 * x pow 12 + -- &980 * x pow 10 + &3038 * x pow 8 + -- &2968 * x pow 6 + &1022 * x pow 4 + -- &84 * x pow 2 + &2`;; time PURE_SOS `!x. &0 <= &2 * x pow 14 + -- &84 * x pow 12 + &1022 * x pow 10 + -- &2968 * x pow 8 + &3038 * x pow 6 + -- &980 * x pow 4 + &98 * x pow 2`;; (* ------------------------------------------------------------------------- *) (* From Zeng et al, JSC vol 37 (2004), p83-99. *) (* All of them work nicely with pure SOS_CONV, except (maybe) the one noted. *) (* ------------------------------------------------------------------------- *) PURE_SOS `x pow 6 + y pow 6 + z pow 6 - &3 * x pow 2 * y pow 2 * z pow 2 >= &0`;; PURE_SOS `x pow 4 + y pow 4 + z pow 4 + &1 - &4*x*y*z >= &0`;; PURE_SOS `x pow 4 + &2*x pow 2*z + x pow 2 - &2*x*y*z + &2*y pow 2*z pow 2 + &2*y*z pow 2 + &2*z pow 2 - &2*x + &2* y*z + &1 >= &0`;; (**** This is harder. Interestingly, this fails the pure SOS test, it seems. Yet only on rounding(!?) Poor Newton polytope optimization or something? But REAL_SOS does finally converge on the second run at level 12! REAL_SOS `x pow 4*y pow 4 - &2*x pow 5*y pow 3*z pow 2 + x pow 6*y pow 2*z pow 4 + &2*x pow 2*y pow 3*z - &4* x pow 3*y pow 2*z pow 3 + &2*x pow 4*y*z pow 5 + z pow 2*y pow 2 - &2*z pow 4*y*x + z pow 6*x pow 2 >= &0`;; ****) PURE_SOS `x pow 4 + &4*x pow 2*y pow 2 + &2*x*y*z pow 2 + &2*x*y*w pow 2 + y pow 4 + z pow 4 + w pow 4 + &2*z pow 2*w pow 2 + &2*x pow 2*w + &2*y pow 2*w + &2*x*y + &3*w pow 2 + &2*z pow 2 + &1 >= &0`;; PURE_SOS `w pow 6 + &2*z pow 2*w pow 3 + x pow 4 + y pow 4 + z pow 4 + &2*x pow 2*w + &2*x pow 2*z + &3*x pow 2 + w pow 2 + &2*z*w + z pow 2 + &2*z + &2*w + &1 >= &0`;; *****) hol-light/Examples/ste.ml000066400000000000000000000226241303454263000156560ustar00rootroot00000000000000(* ========================================================================= *) (* Abstract version of symbolic trajectory evaluation. *) (* *) (* Based on the paper "Symbolic Trajectory Evaluation in a Nutshell" *) (* by Tom Melham & Ashish Darbari, 2002 (still unpublished?) *) (* ========================================================================= *) parse_as_infix("&&",(16,"right"));; parse_as_infix("<<=",(14,"right"));; parse_as_infix(">->",(13,"right"));; parse_as_infix(">~~>",(6,"right"));; (* ------------------------------------------------------------------------- *) (* Some type of nodes that we don't really care much about. *) (* ------------------------------------------------------------------------- *) let node_INDUCT,node_RECURSION = define_type "node = Node num";; (* ------------------------------------------------------------------------- *) (* Also "abstract" propositional formulas (i.e. we never unfold "eval"). *) (* ------------------------------------------------------------------------- *) let propform_INDUCT,propform_RECURSION = define_type "propform = Propform (num->bool)->bool";; let eval = new_recursive_definition propform_RECURSION `eval (Propform p) v = p v`;; (* ------------------------------------------------------------------------- *) (* Quaternary lattice. *) (* ------------------------------------------------------------------------- *) let quat_INDUCT,quat_RECURSION = define_type "quat = X | ZERO | ONE | TOP";; let quat_DISTINCT = prove_constructors_distinct quat_RECURSION;; (* ------------------------------------------------------------------------- *) (* Basic lattice operations. *) (* ------------------------------------------------------------------------- *) let qle = new_definition `x <<= y <=> x = X \/ y = TOP \/ x = y`;; let qjoin = new_definition `x && y = if x <<= y then y else if y <<= x then x else TOP`;; (* ------------------------------------------------------------------------- *) (* Trivial lemmas about the quaternary lattice. *) (* ------------------------------------------------------------------------- *) let QLE_REFL = prove (`!x. x <<= x`, REWRITE_TAC[qle]);; let QLE_TRANS = prove (`!x y z. x <<= y /\ y <<= z ==> x <<= z`, REPEAT(MATCH_MP_TAC quat_INDUCT THEN REPEAT CONJ_TAC) THEN REWRITE_TAC[qle; quat_DISTINCT]);; let QLE_LJOIN = prove (`!x y z. x && y <<= z <=> x <<= z /\ y <<= z`, REPEAT(MATCH_MP_TAC quat_INDUCT THEN REPEAT CONJ_TAC) THEN REWRITE_TAC[qjoin; qle; quat_DISTINCT]);; let QLE_RJOIN = prove (`!x y. x <<= x && y /\ y <<= x && y`, REPEAT(MATCH_MP_TAC quat_INDUCT THEN REPEAT CONJ_TAC) THEN REWRITE_TAC[qjoin; qle; quat_DISTINCT]);; (* ------------------------------------------------------------------------- *) (* Choice expressions. *) (* ------------------------------------------------------------------------- *) let choice = new_definition `b >-> x = if b then x else X`;; let QLE_CHOICE = prove (`(b >-> x) <<= y <=> b ==> x <<= y`, REPEAT GEN_TAC THEN REWRITE_TAC[choice] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[qle]);; (* ------------------------------------------------------------------------- *) (* Basic type of trajectory formulas. *) (* ------------------------------------------------------------------------- *) let trajform_INDUCT,trajform_RECURSION = define_type "trajform = Is_0 node | Is_1 node | Andj trajform trajform | When trajform propform | Next trajform";; (* ------------------------------------------------------------------------- *) (* Semantics. *) (* ------------------------------------------------------------------------- *) let tholds = new_recursive_definition trajform_RECURSION `(tholds (Is_0 nd) seq v <=> ZERO <<= seq 0 nd v) /\ (tholds (Is_1 nd) seq v <=> ONE <<= seq 0 nd v) /\ (tholds (Andj tf1 tf2) seq v <=> tholds tf1 seq v /\ tholds tf2 seq v) /\ (tholds (When tf1 p) seq v <=> eval p v ==> tholds tf1 seq v) /\ (tholds (Next(tf1)) seq v <=> tholds tf1 (\t. seq(t + 1)) v)`;; (* ------------------------------------------------------------------------- *) (* Defining sequence. *) (* ------------------------------------------------------------------------- *) let defseq = new_recursive_definition trajform_RECURSION `(defseq (Is_0 n) t nd v = ((n = nd) /\ (t = 0)) >-> ZERO) /\ (defseq (Is_1 n) t nd v = ((n = nd) /\ (t = 0)) >-> ONE) /\ (defseq (Andj tf1 tf2) t nd v = defseq tf1 t nd v && defseq tf2 t nd v) /\ (defseq (When tf1 p) t nd v = eval p v >-> defseq tf1 t nd v) /\ (defseq (Next(tf1)) t nd v = ~(t = 0) >-> defseq tf1 (t - 1) nd v)`;; (* ------------------------------------------------------------------------- *) (* Proof of the key property. *) (* ------------------------------------------------------------------------- *) let DEFSEQ_MINIMAL = prove (`!tf seq v. tholds tf seq v <=> !t nd. defseq tf t nd v <<= seq t nd v`, let cases_lemma = prove (`(!t. P t) <=> P 0 /\ !t. P(SUC t)`,MESON_TAC[num_CASES]) in MATCH_MP_TAC trajform_INDUCT THEN REWRITE_TAC[defseq; tholds] THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[QLE_CHOICE] THEN MESON_TAC[]; REPEAT GEN_TAC THEN REWRITE_TAC[QLE_CHOICE] THEN MESON_TAC[]; SIMP_TAC[QLE_LJOIN; FORALL_AND_THM]; REWRITE_TAC[QLE_CHOICE] THEN MESON_TAC[]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[cases_lemma] THEN ASM_REWRITE_TAC[QLE_CHOICE; NOT_SUC; ADD1; ADD_SUB]]);; (* ------------------------------------------------------------------------- *) (* Notion of a trajectory w.r.t. a next-state function. *) (* ------------------------------------------------------------------------- *) let trajectory = new_definition `trajectory next seq v <=> !t nd. next(seq t) nd v <<= seq (t + 1) nd v`;; (* ------------------------------------------------------------------------- *) (* Defining trajectory of a formula. *) (* ------------------------------------------------------------------------- *) let deftraj = new_recursive_definition num_RECURSION `(deftraj step tf 0 nd v = defseq tf 0 nd v) /\ (deftraj step tf (SUC t) nd v = defseq tf (SUC t) nd v && step(deftraj step tf t) nd v)`;; (* ------------------------------------------------------------------------- *) (* Obviously this is at least as strong as the defining sequence. *) (* ------------------------------------------------------------------------- *) let DEFTRAJ_DEFSEQ = prove (`!tf t nd v. defseq tf t nd v <<= deftraj step tf t nd v`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[deftraj; QLE_REFL; QLE_RJOIN]);; (* ------------------------------------------------------------------------- *) (* ...and it is indeed a trajectory. *) (* ------------------------------------------------------------------------- *) let TRAJECTORY_DEFTRAJ = prove (`!step tf v. trajectory step (deftraj step tf) v`, REPEAT GEN_TAC THEN REWRITE_TAC[trajectory] THEN REWRITE_TAC[GSYM ADD1; deftraj; QLE_RJOIN]);; (* ------------------------------------------------------------------------- *) (* Monotonicity of next-state function. *) (* ------------------------------------------------------------------------- *) let monotonic = new_definition `monotonic next v <=> !s1 s2. (!nd. s1 nd v <<= s2 nd v) ==> !nd. next s1 nd v <<= next s2 nd v`;; (* ------------------------------------------------------------------------- *) (* Minimality property of defining trajectory (needs monotonicity). *) (* ------------------------------------------------------------------------- *) let DEFTRAJ_MINIMAL = prove (`!step v. monotonic step v ==> !tf seq. trajectory step seq v ==> (tholds tf seq v <=> !t nd. deftraj step tf t nd v <<= seq t nd v)`, REWRITE_TAC[monotonic; trajectory; RIGHT_IMP_FORALL_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DEFSEQ_MINIMAL; DEFTRAJ_DEFSEQ; QLE_TRANS]] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[deftraj; QLE_LJOIN] THEN ASM_MESON_TAC[DEFSEQ_MINIMAL; QLE_TRANS; ADD1]);; (* ------------------------------------------------------------------------- *) (* Basic semantic notion in STE. *) (* ------------------------------------------------------------------------- *) let ste = new_definition `(A >~~> C) ckt v <=> !seq. trajectory ckt seq v /\ tholds A seq v ==> tholds C seq v`;; (* ------------------------------------------------------------------------- *) (* The "fundamental theorem of STE". *) (* ------------------------------------------------------------------------- *) let STE_THM = prove (`monotonic ckt v ==> ((A >~~> C) ckt v <=> !t nd. defseq C t nd v <<= deftraj ckt A t nd v)`, MESON_TAC[ste; DEFTRAJ_MINIMAL; DEFSEQ_MINIMAL; DEFTRAJ_DEFSEQ; TRAJECTORY_DEFTRAJ; QLE_TRANS]);; hol-light/Examples/sylvester_gallai.ml000066400000000000000000000313121303454263000204260ustar00rootroot00000000000000(* ========================================================================= *) (* The Sylvester-Gallai theorem. *) (* ========================================================================= *) needs "Multivariate/convex.ml";; (* ------------------------------------------------------------------------- *) (* The main lemma that we reduce things to. *) (* ------------------------------------------------------------------------- *) let SYLVESTER_GALLAI_LEMMA = prove (`!p q b c:real^2. between b (q,c) /\ ~(p IN affine hull {q,c}) /\ orthogonal (p - q) (c - q) /\ ~(c = b) /\ ~(c = q) ==> ~(b IN affine hull {p,c}) /\ ?x. x IN affine hull {p,c} /\ dist(b,x) < dist(p,q)`, GEOM_ORIGIN_TAC `q:real^2` THEN GEOM_BASIS_MULTIPLE_TAC 1 `c:real^2` THEN X_GEN_TAC `c:real` THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`pp:real^2`; `bb:real^2`] THEN REWRITE_TAC[BETWEEN_IN_SEGMENT; SEGMENT_CONVEX_HULL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] CONVEX_HULL_SUBSET_AFFINE_HULL)) THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN REWRITE_TAC[SPAN_SING; IN_ELIM_THM; IN_UNIV; VECTOR_MUL_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `bc:real` SUBST_ALL_TAC) THEN ABBREV_TAC `b:real = bc * c` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[VECTOR_SUB_RZERO; orthogonal; DOT_2] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_ADD_RID] THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ; VECTOR_MUL_EQ_0] THEN ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM SEGMENT_CONVEX_HULL]) THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between; DIST_0] THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN SIMP_TAC[NORM_BASIS; REAL_MUL_RID; DIMINDEX_2; ARITH] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs c = abs b + abs(b - c) ==> &0 < c ==> &0 <= b /\ (b < c \/ b = c)`)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `?p. ~(p = &0) /\ pp:real^2 = p % basis 2` (CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THENL [EXISTS_TAC `(pp:real^2)$2` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[AFFINE_HULL_2_ALT; EXISTS_IN_GSPEC; IN_UNIV; NORM_LT] THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM; CART_EQ; DIMINDEX_2; FORALL_2] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; REAL_ADD_LID] THEN REWRITE_TAC[REAL_RING `&0 = p + u * (&0 - p) <=> p = &0 \/ u = &1`] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `b - (p + u % (c - p)):real^2 = (b - u % c) - (&1 - u) % p`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[NORM_POS_LT; GSYM DOT_POS_LT] THEN REWRITE_TAC[VECTOR_ARITH `(a - b) dot (a - b) = a dot a + b dot b - &2 * a dot b`] THEN REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_2; ARITH; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_MUL_RID; REAL_SUB_RZERO] THEN SUBGOAL_THEN `&0 < c pow 2 /\ &0 < p pow 2` STRIP_ASSUME_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE]; ALL_TAC] THEN ASM_CASES_TAC `b = &0` THENL [EXISTS_TAC `p pow 2 / (p pow 2 + c pow 2):real` THEN ASM_REWRITE_TAC[REAL_ARITH `(&0 - u * c) * (&0 - u * c) + ((&1 - u) * p) * ((&1 - u) * p) < p * p <=> u * u * c pow 2 < u * (&2 - u) * p pow 2`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_DIV; REAL_LT_ADD] THEN SIMP_TAC[REAL_ARITH `u * c < (&2 - u) * p <=> u * (p + c) < &2 * p`] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_ADD] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `b:real / c` THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_SUB_REFL] THEN REWRITE_TAC[REAL_ARITH `&0 * &0 + (u * p) * (u * p) < p * p <=> &0 < (&1 - u * u) * p * p`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_POW_1_LT THEN SIMP_TAC[ARITH_EQ; REAL_SUB_LE; REAL_ARITH `&1 - x < &1 <=> &0 < x`] THEN ASM_SIMP_TAC[ARITH_EQ; REAL_LT_RDIV_EQ; REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The following lemmas drive a case analysis to pick the right points. *) (* ------------------------------------------------------------------------- *) let cases_quick = prove (`!q a b c:real^N. collinear {q,a,b,c} /\ between b (a,c) ==> between b (q,a) \/ between b (q,c)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN GEOM_ORIGIN_TAC `u:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `v:real^N` THEN GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN REWRITE_TAC[SPAN_INSERT_0; SPAN_SING; INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN STRIP_TAC THEN ASM_REWRITE_TAC[between; dist; GSYM VECTOR_SUB_RDISTRIB] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[REAL_MUL_RID; GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN ASM_CASES_TAC `abs v = &0` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let cases_lemma = prove (`!q a b c:real^N. collinear {q,a,b,c} ==> between a (q,b) \/ between a (q,c) \/ between b (q,c) \/ between b (q,a) \/ between c (q,a) \/ between c (q,b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `collinear {a:real^N,b,c}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COLLINEAR_SUBSET)) THEN SET_TAC[]; REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN REPEAT(ONCE_REWRITE_TAC[TAUT `a \/ b \/ c \/ d <=> (a \/ b) \/ c \/ d`] THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] cases_quick) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[INSERT_AC]]);; (* ------------------------------------------------------------------------- *) (* Kelly's proof of the Sylvester-Gallai theorem. *) (* ------------------------------------------------------------------------- *) let SYLVESTER_GALLAI = prove (`!s:real^2->bool. FINITE s /\ (!a b. a IN s /\ b IN s /\ ~(a = b) ==> ?c. c IN s /\ ~(c = a) /\ ~(c = b) /\ collinear {a,b,c}) ==> collinear s`, GEN_TAC THEN ASM_CASES_TAC `s:real^2->bool = {}` THEN ASM_REWRITE_TAC[COLLINEAR_EMPTY] THEN ASM_CASES_TAC `?a:real^2. s = {a}` THENL [ASM_MESON_TAC[COLLINEAR_SING]; STRIP_TAC] THEN ABBREV_TAC `L = {affine hull {a,b} | a IN s /\ b IN s /\ ~(a:real^2 = b)}` THEN SUBGOAL_THEN `FINITE(L:(real^2->bool)->bool)` ASSUME_TAC THENL [EXPAND_TAC "L" THEN ONCE_REWRITE_TAC[SET_RULE `{f x y | x IN s /\ y IN s /\ P x y} = {f x y | x IN s /\ y IN {y | y IN s /\ P x y}}`] THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_RESTRICT]; ALL_TAC] THEN ASM_CASES_TAC `L:(real^2->bool)->bool = {}` THENL [UNDISCH_TAC `L:(real^2->bool)->bool = {}` THEN EXPAND_TAC "L" THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `{ dist(closest_point l p,p) | l IN L /\ p IN {p:real^2 | p IN s /\ &0 < dist(closest_point l p,p)}}` INF_FINITE) THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_RESTRICT] THEN ASM_REWRITE_TAC[SET_RULE `{f x y | x IN s /\ y IN t x} = {} <=> s = {} \/ (!x. x IN s ==> t x = {})`] THEN MATCH_MP_TAC(TAUT `(p ==> r) /\ (q ==> r) ==> (~p ==> q) ==> r`) THEN CONJ_TAC THENL [SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = {} <=> !x. x IN s ==> ~P x`] THEN REWRITE_TAC[GSYM DIST_NZ] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^2->bool` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(MP_TAC o SPEC `l:real^2->bool`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `closed(l:real^2->bool) /\ ~(l = {})` ASSUME_TAC THENL [UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY]; ASM_SIMP_TAC[CLOSEST_POINT_REFL]] THEN DISCH_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `l:real^2->bool` THEN ASM_REWRITE_TAC[SUBSET] THEN UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_MESON_TAC[COLLINEAR_AFFINE_HULL; SUBSET_REFL]; ALL_TAC] THEN SIMP_TAC[IMP_CONJ; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^2->bool`; `p:real^2`] THEN DISCH_TAC THEN SUBGOAL_THEN `affine(l:real^2->bool) /\ ~(l = {})` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_AFFINE) THEN ABBREV_TAC `q = closest_point l p:real^2` THEN DISCH_TAC THEN REWRITE_TAC[DIST_NZ] THEN DISCH_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_TAC THEN SUBGOAL_THEN `(q:real^2) IN l` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSEST_POINT_IN_SET]; ALL_TAC] THEN SUBGOAL_THEN `?b c:real^2. b IN s /\ c IN s /\ b IN l /\ c IN l /\ ~(b = c) /\ between b (q,c)` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^2`; `b:real^2`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `?c:real^2. c IN s /\ ~(c = a) /\ ~(c = b) /\ collinear {a, b, c}` (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN SUBGOAL_THEN `(a:real^2) IN l /\ (b:real^2) IN l` STRIP_ASSUME_TAC THENL [EXPAND_TAC "l" THEN SIMP_TAC[HULL_INC; IN_INSERT]; ALL_TAC] THEN MP_TAC(ISPECL [`q:real^2`; `a:real^2`; `b:real^2`; `c:real^2`] cases_lemma) THEN ANTS_TAC THENL [REWRITE_TAC[COLLINEAR_AFFINE_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN MAP_EVERY EXISTS_TAC [`a:real^2`; `b:real^2`] THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `~(c:real^2 = q)` ASSUME_TAC THENL [ASM_MESON_TAC[BETWEEN_REFL_EQ]; ALL_TAC] THEN SUBGOAL_THEN `~((p:real^2) IN l)` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSEST_POINT_SELF; DIST_EQ_0; REAL_LT_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`p:real^2`; `q:real^2`; `b:real^2`; `c:real^2`] SYLVESTER_GALLAI_LEMMA) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [UNDISCH_TAC `~((p:real^2) IN l)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN SPEC_TAC(`p:real^2`,`p:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]; EXPAND_TAC "q" THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN MATCH_MP_TAC CLOSEST_POINT_AFFINE_ORTHOGONAL THEN ASM_REWRITE_TAC[]]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `r:real^2` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`dist(closest_point (affine hull {p,c}) b:real^2,b)`; `affine hull {p:real^2,c}`; `b:real^2`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[DIST_POS_LE; DIST_EQ_0] THEN ASM_SIMP_TAC[CLOSEST_POINT_REFL; CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN EXPAND_TAC "L" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `rb < qp ==> cb <= rb ==> ~(qp <= cb)`)) THEN MATCH_MP_TAC CLOSEST_POINT_LE THEN ASM_REWRITE_TAC[CLOSED_AFFINE_HULL]]]);; hol-light/Examples/update_database.ml000066400000000000000000000170731303454263000201730ustar00rootroot00000000000000(* ========================================================================= *) (* Create search database from OCaml / modify search database dynamically. *) (* *) (* This file assigns to "theorems", which is a list of name-theorem pairs. *) (* The core system already has such a database set up. Use this file if you *) (* want to update the database beyond the core, so you can search it. *) (* *) (* The trickery to get at the OCaml environment is due to oleg@pobox.com *) (* (see his message to the caml-list on Tuesday 26th September 2006). *) (* ========================================================================= *) (* !!!!!!! You must set this to point at the source directory in !!!!!!! which OCaml was built. (And don't do "make clean" beforehand.) *) let ocaml_source_dir = Filename.concat (Sys.getenv "HOME") ("software/ocaml-"^Sys.ocaml_version);; do_list (fun s -> Topdirs.dir_directory(Filename.concat ocaml_source_dir s)) ["parsing"; "typing"; "toplevel"; "utils"];; (* This must be loaded first! It is stateful, and affects Predef *) #load "ident.cmo";; #load "misc.cmo";; #load "path.cmo";; #load "types.cmo";; #load "btype.cmo";; #load "tbl.cmo";; #load "subst.cmo";; #load "predef.cmo";; #load "datarepr.cmo";; #load "config.cmo";; #load "consistbl.cmo";; #load "clflags.cmo";; #load "env.cmo";; #load "ctype.cmo";; #load "printast.cmo";; #load "oprint.cmo";; #load "primitive.cmo";; #load "printtyp.cmo";; (* ------------------------------------------------------------------------- *) (* Get the toplevel environment as raw data. *) (* ------------------------------------------------------------------------- *) let get_value_bindings env = let rec get_val acc = function | Env.Env_empty -> acc | Env.Env_value (next, ident, val_descr) -> get_val ((ident,val_descr)::acc) next | Env.Env_type (next,_,_) -> get_val acc next | Env.Env_exception (next,_,_) -> get_val acc next | Env.Env_module (next,_,_) -> get_val acc next | Env.Env_modtype (next,_,_) -> get_val acc next | Env.Env_class (next,_,_) -> get_val acc next | Env.Env_cltype (next,_,_) -> get_val acc next | Env.Env_open (next,_) -> get_val acc next in get_val [] (Env.summary env);; (* ------------------------------------------------------------------------- *) (* Convert a type to a string, for ease of comparison. *) (* ------------------------------------------------------------------------- *) let type_to_str (x : Types.type_expr) = Printtyp.type_expr Format.str_formatter x; Format.flush_str_formatter ();; (* ------------------------------------------------------------------------- *) (* Put an assignment of a theorem database in the named file. *) (* ------------------------------------------------------------------------- *) let make_database_assignment filename = let all_bnds = get_value_bindings (!Toploop.toplevel_env) in let thm_bnds = filter (fun (ident,val_descr) -> type_to_str val_descr.Types.val_type = "thm") all_bnds in let names = subtract (map (fun (ident,val_descr) -> Ident.name ident) thm_bnds) ["it"] in let entries = map (fun n -> "\""^n^"\","^n) (uniq(sort (<) names)) in let text = "theorems :=\n[\n"^ end_itlist (fun a b -> a^";\n"^b) entries^"\n];;\n" in file_of_string filename text;; (* ------------------------------------------------------------------------- *) (* Remove bindings in first list from second assoc list (all ordered). *) (* ------------------------------------------------------------------------- *) let rec demerge s l = match (s,l) with u::t,(x,y as p)::m -> if u = x then demerge t m else if u < x then demerge t l else p::(demerge s m) | _ -> l;; (* ------------------------------------------------------------------------- *) (* Incrementally update database. *) (* ------------------------------------------------------------------------- *) let update_database = let value_bindings_checked = ref 0 and theorem_bindings_existing = ref undefined in let listify l = if l = [] then "[]" else "[\n"^end_itlist (fun a b -> a^";\n"^b) l^"\n]\n" in let purenames = map (fun n -> "\""^n^"\"") and pairnames = map (fun n -> "\""^n^"\","^n) in fun () -> let old_count = !value_bindings_checked and old_ths = !theorem_bindings_existing in let all_bnds = get_value_bindings (!Toploop.toplevel_env) in let new_bnds = funpow old_count tl all_bnds in let new_count = old_count + length new_bnds and new_ths = rev_itlist (fun (ident,val_descr) -> let n = Ident.name ident in if type_to_str val_descr.Types.val_type = "thm" && n <> "it" then (n |-> ()) else undefine n) new_bnds old_ths in value_bindings_checked := new_count; if new_ths = old_ths then () else (print_string "Updating search database\n"; theorem_bindings_existing := new_ths; let all_ths = combine (fun _ _ -> ()) (fun _ -> false) old_ths new_ths in let del_ths = combine (fun _ _ -> ()) (fun _ -> true) all_ths new_ths and add_ths = combine (fun _ _ -> ()) (fun _ -> true) all_ths old_ths in let del_names = mergesort (<) (foldr (fun a _ l -> a::l) del_ths []) and add_names = mergesort (<) (foldr (fun a _ l -> a::l) add_ths []) in let exptext = "theorems :=\n merge (increasing fst) (demerge "^ (listify(purenames del_names))^ " (!theorems)) "^ (listify(pairnames add_names))^ ";;\n" in (let filename = Filename.temp_file "database" ".ml" in file_of_string filename exptext; loadt filename; Sys.remove filename));; (* ------------------------------------------------------------------------- *) (* Include a call to this on each search. *) (* ------------------------------------------------------------------------- *) let search = let rec immediatesublist l1 l2 = match (l1,l2) with [],_ -> true | _,[] -> false | (h1::t1,h2::t2) -> h1 = h2 && immediatesublist t1 t2 in let rec sublist l1 l2 = match (l1,l2) with [],_ -> true | _,[] -> false | (h1::t1,h2::t2) -> immediatesublist l1 l2 || sublist l1 t2 in let exists_subterm_satisfying p (n,th) = can (find_term p) (concl th) and name_contains s (n,th) = sublist (explode s) (explode n) in let rec filterpred tm = match tm with Comb(Var("",_),t) -> not o filterpred t | Comb(Var("",_),Var(pat,_)) -> name_contains pat | Comb(Var("",_),pat) -> exists_subterm_satisfying (aconv pat) | pat -> exists_subterm_satisfying (can (term_match [] pat)) in fun pats -> update_database(); let triv,nontriv = partition is_var pats in (if triv <> [] then warn true ("Ignoring plain variables in search: "^ end_itlist (fun s t -> s^", "^t) (map (fst o dest_var) triv)) else ()); (if nontriv = [] && triv <> [] then [] else itlist (filter o filterpred) pats (!theorems));; (* ------------------------------------------------------------------------- *) (* Update to bring things back to current state. *) (* ------------------------------------------------------------------------- *) theorems := [];; update_database();; hol-light/Examples/vitali.ml000066400000000000000000000116461303454263000163550ustar00rootroot00000000000000(* ========================================================================= *) (* Existence of a (bounded) non-measurable set of reals. *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* Classic Vitali proof (positive case simplified via Steinhaus's theorem). *) (* ------------------------------------------------------------------------- *) let NON_MEASURABLE_SET = prove (`?s. real_bounded s /\ ~real_measurable s`, MAP_EVERY ABBREV_TAC [`equiv = \x y. &0 <= x /\ x < &1 /\ &0 <= y /\ y < &1 /\ rational(x - y)`; `(canonize:real->real) = \x. @y. equiv x y`; `V = IMAGE (canonize:real->real) {x | &0 <= x /\ x < &1}`] THEN SUBGOAL_THEN `!x. equiv x x <=> &0 <= x /\ x < &1` ASSUME_TAC THENL [EXPAND_TAC "equiv" THEN REWRITE_TAC[REAL_SUB_REFL; RATIONAL_NUM; CONJ_ACI]; ALL_TAC] THEN SUBGOAL_THEN `!x y:real. equiv x y ==> equiv y x` ASSUME_TAC THENL [EXPAND_TAC "equiv" THEN MESON_TAC[RATIONAL_NEG; REAL_NEG_SUB]; ALL_TAC] THEN SUBGOAL_THEN `!x y z:real. equiv x y /\ equiv y z ==> equiv x z` ASSUME_TAC THENL [EXPAND_TAC "equiv" THEN MESON_TAC[RATIONAL_ADD; REAL_ARITH `x - z:real = (x - y) + (y - z)`]; ALL_TAC] THEN SUBGOAL_THEN `!x. &0 <= x /\ x < &1 ==> (equiv:real->real->bool) x (canonize x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "canonize" THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x y. x IN V /\ y IN V /\ rational(x - y) ==> x = y` ASSUME_TAC THENL [EXPAND_TAC "V" THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN STRIP_TAC THEN EXPAND_TAC "canonize" THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real` THEN SUBGOAL_THEN `equiv ((canonize:real->real) x) (canonize y) :bool` (fun th -> MP_TAC th THEN ASM_MESON_TAC[]) THEN EXPAND_TAC "equiv" THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `V:real->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN EXISTS_TAC `real_interval[&0,&1]` THEN REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET; IN_REAL_INTERVAL] THEN ASM SET_TAC[REAL_LT_IMP_LE]; DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_REAL_MEASURE_MEASURE]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_MEASURE_POS_LE) THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THENL [MP_TAC(ISPEC `V:real->bool` REAL_STEINHAUS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPECL [`d / &2`; `d / &2`] RATIONAL_APPROXIMATION) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:real` THEN STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `q:real`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `q = &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[REAL_SUB_0]; REWRITE_TAC[HAS_REAL_MEASURE_0] THEN DISCH_TAC THEN SUBGOAL_THEN `?r. rational = IMAGE r (:num)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN REWRITE_TAC[COUNTABLE_RATIONAL] THEN REWRITE_TAC[FUN_EQ_THM; EMPTY] THEN MESON_TAC[RATIONAL_NUM]; ALL_TAC] THEN MP_TAC(ISPEC `\n. IMAGE (\x. (r:num->real) n + x) V` REAL_NEGLIGIBLE_COUNTABLE_UNIONS) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_NEGLIGIBLE_TRANSLATION]; ALL_TAC] THEN SUBGOAL_THEN `~(real_negligible(real_interval(&0,&1)))` MP_TAC THENL [SIMP_TAC[GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0; REAL_MEASURABLE_REAL_INTERVAL; REAL_MEASURE_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN SUBGOAL_THEN `(equiv:real->real->bool) x (canonize x)` MP_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN EXPAND_TAC "equiv" THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC LAND_CONV [GSYM IN] THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (ASSUME_TAC o SYM)) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[UNIONS_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN MAP_EVERY EXISTS_TAC [`n:num`; `(canonize:real->real) x`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN EXPAND_TAC "V" THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]);; hol-light/Formal_ineqs/000077500000000000000000000000001303454263000153645ustar00rootroot00000000000000hol-light/Formal_ineqs/README.txt000066400000000000000000000003641303454263000170650ustar00rootroot00000000000000A tool for formal verification of nonlinear inequalities in HOL Light. Part of the Flyspeck project: http://code.google.com/p/flyspeck/ Distributed under the same license as HOL Light. See docs/FormalVerifier.pdf for additional information. hol-light/Formal_ineqs/arith/000077500000000000000000000000001303454263000164735ustar00rootroot00000000000000hol-light/Formal_ineqs/arith/arith_cache.hl000066400000000000000000000140611303454263000212540ustar00rootroot00000000000000(* =========================================================== *) (* Cached natural arithmetic *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "arith_options.hl";; needs "arith/arith_num.hl";; module Arith_cache = struct let cache_size = if !Arith_options.cached then !Arith_options.init_cache_size else 1;; (* Hash tables *) let my_add h key v = if Hashtbl.length h >= !Arith_options.max_cache_size then Hashtbl.clear h (* let _ = Hashtbl.clear h in print_string "Clearing a nat hash table" *) else (); Hashtbl.add h key v;; let le_table = Hashtbl.create cache_size and add_table = Hashtbl.create cache_size and sub_table = Hashtbl.create cache_size and sub_le_table = Hashtbl.create cache_size and mul_table = Hashtbl.create cache_size and div_table = Hashtbl.create cache_size;; (* Counters for collecting stats *) let suc_counter = ref 0 and eq0_counter = ref 0 and pre_counter = ref 0 and gt0_counter = ref 0 and lt_counter = ref 0 and le_counter = ref 0 and add_counter = ref 0 and sub_counter = ref 0 and sub_le_counter = ref 0 and mul_counter = ref 0 and div_counter = ref 0 and even_counter = ref 0 and odd_counter = ref 0;; (* Clears all cached results *) let reset_cache () = let clear = Hashtbl.clear in clear le_table; clear add_table; clear sub_table; clear sub_le_table; clear mul_table; clear div_table;; (* Resets all counters *) let reset_stat () = suc_counter := 0; eq0_counter := 0; pre_counter := 0; gt0_counter := 0; lt_counter := 0; le_counter := 0; add_counter := 0; sub_counter := 0; sub_le_counter := 0; mul_counter := 0; div_counter := 0; even_counter := 0; odd_counter := 0;; (* Prints stats *) let print_stat () = let len = Hashtbl.length in let suc_pre_str = sprintf "suc = %d\npre = %d\n" !suc_counter !pre_counter in let cmp0_str = sprintf "eq0 = %d\ngt0 = %d\n" !eq0_counter !gt0_counter in let lt_str = sprintf "lt = %d\n" !lt_counter in let even_odd_str = sprintf "even = %d\nodd = %d\n" !even_counter !odd_counter in let le_str = sprintf "le = %d (le_hash = %d)\n" !le_counter (len le_table) in let add_str = sprintf "add = %d (add_hash = %d)\n" !add_counter (len add_table) in let sub_str = sprintf "sub = %d (sub_hash = %d)\n" !sub_counter (len sub_table) in let sub_le_str = sprintf "sub_le = %d (sub_le_hash = %d)\n" !sub_le_counter (len sub_le_table) in let mul_str = sprintf "mul = %d (mul_hash = %d)\n" !mul_counter (len mul_table) in let div_str = sprintf "div = %d (div_hash = %d)\n" !div_counter (len div_table) in print_string (suc_pre_str ^ cmp0_str ^ lt_str ^ even_odd_str ^ le_str ^ add_str ^ sub_str ^ sub_le_str ^ mul_str ^ div_str);; (* Note: the standard Hashtbl.hash function works very purely on terms *) let rec num_tm_hash tm = if is_comb tm then let b_tm, n_tm = dest_comb tm in let str = (fst o dest_const) b_tm in str ^ num_tm_hash n_tm else "";; let op_tm_hash tm = let lhs, tm2 = dest_comb tm in let tm1 = rand lhs in num_tm_hash tm1 ^ "x" ^ num_tm_hash tm2;; let tm1_tm2_hash tm1 tm2 = num_tm_hash tm1 ^ "x" ^ num_tm_hash tm2;; (* SUC *) let raw_suc_conv_hash tm = let _ = suc_counter := !suc_counter + 1 in (* let _ = suc_list := tm :: !suc_list in *) Arith_hash.raw_suc_conv_hash tm;; (* x = 0 *) let raw_eq0_hash_conv tm = let _ = eq0_counter := !eq0_counter + 1 in (* let _ = eq0_list := tm :: !eq0_list in *) Arith_hash.raw_eq0_hash_conv tm;; (* PRE *) let raw_pre_hash_conv tm = let _ = pre_counter := !pre_counter + 1 in Arith_hash.raw_pre_hash_conv tm;; (* x > 0 *) let raw_gt0_hash_conv tm = let _ = gt0_counter := !gt0_counter + 1 in Arith_hash.raw_gt0_hash_conv tm;; (* x < y *) let raw_lt_hash_conv tm = let _ = lt_counter := !lt_counter + 1 in Arith_hash.raw_lt_hash_conv tm;; (* x <= y *) let raw_le_hash_conv tm = let _ = le_counter := !le_counter + 1 in let hash = op_tm_hash tm in try Hashtbl.find le_table hash with Not_found -> let result = Arith_hash.raw_le_hash_conv tm in let _ = my_add le_table hash result in result;; (* x + y *) let raw_add_conv_hash tm = let _ = add_counter := !add_counter + 1 in let hash = op_tm_hash tm in try Hashtbl.find add_table hash with Not_found -> let result = Arith_hash.raw_add_conv_hash tm in let _ = my_add add_table hash result in result;; (* x - y *) let raw_sub_hash_conv tm = let _ = sub_counter := !sub_counter + 1 in let hash = op_tm_hash tm in try Hashtbl.find sub_table hash with Not_found -> let result = Arith_hash.raw_sub_hash_conv tm in let _ = my_add sub_table hash result in result;; let raw_sub_and_le_hash_conv tm1 tm2 = let _ = sub_le_counter := !sub_le_counter + 1 in let hash = tm1_tm2_hash tm1 tm2 in try Hashtbl.find sub_le_table hash with Not_found -> let result = Arith_hash.raw_sub_and_le_hash_conv tm1 tm2 in let _ = my_add sub_le_table hash result in result;; (* x * y *) let raw_mul_conv_hash tm = let _ = mul_counter := !mul_counter + 1 in let hash = op_tm_hash tm in try Hashtbl.find mul_table hash with Not_found -> let result = Arith_hash.raw_mul_conv_hash tm in let _ = my_add mul_table hash result in result;; (* x / y *) let raw_div_hash_conv tm = let _ = div_counter := !div_counter + 1 in let hash = op_tm_hash tm in try Hashtbl.find div_table hash with Not_found -> let result = Arith_hash.raw_div_hash_conv tm in let _ = my_add div_table hash result in result;; (* EVEN, ODD *) let raw_even_hash_conv tm = let _ = even_counter := !even_counter + 1 in Arith_hash.raw_even_hash_conv tm;; let raw_odd_hash_conv tm = let _ = odd_counter := !odd_counter + 1 in Arith_hash.raw_odd_hash_conv tm;; end;; hol-light/Formal_ineqs/arith/arith_num.hl000066400000000000000000001473271303454263000210240ustar00rootroot00000000000000(* =========================================================== *) (* Formal natural arithmetic with an arbitrary base *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) module type Arith_hash_sig = sig val arith_base : int val num_def : thm val NUM_THM : thm val num_const : term val const_array : term array val def_array: thm array val def_thm_array: thm array val mk_numeral_hash : num -> term val mk_numeral_array : num -> term val mk_small_numeral_array : int -> term val raw_dest_hash : term -> num val dest_numeral_hash : term -> num val NUMERAL_TO_NUM_CONV : term -> thm val NUM_TO_NUMERAL_CONV : term -> thm val raw_suc_conv_hash : term -> thm val NUM_SUC_HASH_CONV : term -> thm val raw_eq0_hash_conv : term -> thm val NUM_EQ0_HASH_CONV : term -> thm val raw_pre_hash_conv : term -> thm val NUM_PRE_HASH_CONV : term -> thm val raw_gt0_hash_conv : term -> thm val NUM_GT0_HASH_CONV : term -> thm val raw_lt_hash_conv : term -> thm val raw_le_hash_conv : term -> thm val NUM_LT_HASH_CONV : term -> thm val NUM_LE_HASH_CONV : term -> thm val raw_add_conv_hash : term -> thm val NUM_ADD_HASH_CONV : term -> thm val raw_sub_hash_conv : term -> thm val raw_sub_and_le_hash_conv : term -> term -> thm * thm val NUM_SUB_HASH_CONV : term -> thm val raw_mul_conv_hash : term -> thm val NUM_MULT_HASH_CONV : term -> thm val raw_div_hash_conv : term -> thm val NUM_DIV_HASH_CONV : term -> thm val raw_even_hash_conv : term -> thm val raw_odd_hash_conv : term -> thm val NUM_EVEN_HASH_CONV : term -> thm val NUM_ODD_HASH_CONV : term -> thm end;; (* Dependencies *) needs "misc/misc.hl";; needs "arith_options.hl";; module Arith_hash : Arith_hash_sig = struct open Arith_misc;; let arith_base = !Arith_options.base;; let maximum = arith_base;; (******************) (* Generate definitions and constants *) let num_type = `:num`;; let fnum_type = `:num->num`;; let numeral_const = `NUMERAL` and zero_const = `_0` and bit0_const = `BIT0` and bit1_const = `BIT1` and truth_const = `T` and false_const = `F`;; let m_var_num = `m:num` and n_var_num = `n:num` and t_var_num = `t:num` and r_var_num = `r:num` and p_var_num = `p:num` and q_var_num = `q:num`;; let suc_const = `SUC` and plus_op_num = `(+):num->num->num` and minus_op_num = `(-):num->num->num` and mul_op_num = `( * ):num->num->num` and div_op_num = `(DIV):num->num->num` and le_op_num = `(<=):num->num->bool` and lt_op_num = `(<):num->num->bool`;; let plus_op_real = `(+):real->real->real` and mul_op_real = `( * ):real->real->real`;; (* Names of constants which define "digits" *) let names_array = Array.init maximum (fun i -> "D"^(string_of_int i));; (* Definitions *) let num_name = "NUM"^(string_of_int arith_base);; let num_def = new_basic_definition (mk_eq(mk_var(num_name, fnum_type), numeral_const));; let num_const = mk_const(num_name, []);; let num_def_sym = SYM num_def;; (* |- NUM n = n *) let NUM_THM = prove(mk_eq(mk_comb(num_const, n_var_num), n_var_num), REWRITE_TAC[num_def; NUMERAL]);; (* |- D_i(n) = i + D_0(n) *) let mk_bit_definition i = let lhs = mk_var (names_array.(i), fnum_type) in let tm1 = mk_binop mul_op_num (mk_small_numeral arith_base) n_var_num in let tm2 = mk_binop plus_op_num tm1 (mk_small_numeral i) in let rhs = mk_abs (n_var_num, tm2) in new_basic_definition (mk_eq (lhs, rhs));; let def_basic_array = Array.init maximum mk_bit_definition;; let def_array = Array.init maximum (fun i -> let basic = def_basic_array.(i) in let th1 = AP_THM basic n_var_num in TRANS th1 (BETA (rand (concl th1))));; let def_table = Hashtbl.create maximum;; let def_basic_table = Hashtbl.create maximum;; for i = 0 to maximum - 1 do let _ = Hashtbl.add def_table names_array.(i) def_array.(i) in Hashtbl.add def_basic_table names_array.(i) def_basic_array.(i) done;; (* Constants *) let const_array = Array.init maximum (fun i -> mk_const(names_array.(i),[]));; let b0_def = def_array.(0);; let b0_const = const_array.(0);; let b0_name = names_array.(0);; let max_const = mk_small_numeral maximum;; (* Alternative definition of D_i *) let ADD_0_n = prove(`_0 + n = n`, ONCE_REWRITE_TAC[GSYM NUMERAL] THEN REWRITE_TAC[GSYM ARITH_ADD; ADD_CLAUSES]);; let ADD_n_0 = prove(`n + _0 = n`, ONCE_REWRITE_TAC[GSYM NUMERAL] THEN REWRITE_TAC[GSYM ARITH_ADD; ADD_CLAUSES]);; let MUL_n_0 = prove(`n * _0 = 0`, REWRITE_TAC[NUMERAL] THEN SUBGOAL_THEN `_0 = 0` MP_TAC THENL [ REWRITE_TAC[NUMERAL]; ALL_TAC ] THEN DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN ARITH_TAC);; (* D_i(n) = i + D_0(n) *) let def_thm i = let bin = mk_comb(const_array.(i), n_var_num) in let bi0 = mk_comb(const_array.(i), zero_const) in let b0n = mk_comb(const_array.(0), n_var_num) in let rhs = mk_binop plus_op_num bi0 b0n in prove(mk_eq(bin, rhs), REWRITE_TAC[def_array.(i); def_array.(0)] THEN REWRITE_TAC[MUL_n_0; ADD_CLAUSES] THEN ARITH_TAC);; let def_thm_array = Array.init maximum def_thm;; let B0_0 = prove(mk_eq(mk_comb(b0_const, zero_const), zero_const), REWRITE_TAC[b0_def; MUL_n_0; ADD_CLAUSES; NUMERAL]);; let B0_EXPLICIT = prove(mk_eq(mk_comb(b0_const, n_var_num), mk_binop mul_op_num max_const n_var_num), REWRITE_TAC[b0_def; ADD_CLAUSES]);; (******************************) (* mk_numeral and dest_numeral *) (* mk_table *) let mk_table = Hashtbl.create maximum;; for i = 0 to maximum - 1 do Hashtbl.add mk_table (Int i) const_array.(i) done;; (* mk_numeral *) let max_num = Int maximum;; let mk_numeral_hash = let rec mk_num n = if (n =/ num_0) then zero_const else let m = mod_num n max_num in let bit = Hashtbl.find mk_table m in mk_comb(bit, mk_num(quo_num n max_num)) in fun n -> if n if n if n < 0 then failwith "mk_small_numeral_array: negative argument" else mk_comb (num_const, mk_num n);; (* dest_table *) let dest_table_num = Hashtbl.create maximum;; for i = 0 to maximum - 1 do Hashtbl.add dest_table_num names_array.(i) (Int i) done;; (* dest_numeral *) let max_num = Int maximum;; let rec raw_dest_hash tm = if tm = zero_const then num_0 else let l, r = dest_comb tm in let n = max_num */ raw_dest_hash r in let cn = fst(dest_const l) in n +/ (Hashtbl.find dest_table_num cn);; let dest_numeral_hash tm = raw_dest_hash (rand tm);; (******************************) (* NUMERAL_TO_NUM_CONV: coverts usual HOL numerals into k-bit numerals *) let th_num_conv = Array.init maximum (fun i -> (SYM o SPEC_ALL) def_array.(i));; let mod_op_num = `MOD`;; let zero = `0`;; let DIV_BASE = let h1 = mk_eq(mk_binop div_op_num m_var_num max_const, q_var_num) in let h2 = mk_eq(mk_binop mod_op_num m_var_num max_const, r_var_num) in let c = mk_eq(m_var_num, mk_binop plus_op_num (mk_binop mul_op_num max_const q_var_num) r_var_num) in (UNDISCH_ALL o ARITH_RULE) (mk_imp(h1, mk_imp(h2, c)));; let ZERO_EQ_ZERO = (EQT_ELIM o REWRITE_CONV[NUMERAL]) `0 = _0`;; let SYM_ZERO_EQ_ZERO = SYM ZERO_EQ_ZERO;; let SYM_NUM_THM = SYM NUM_THM;; let NUMERAL_TO_NUM_CONV tm = let rec raw_conv tm = if (rand tm = zero_const) then ZERO_EQ_ZERO else let th_div = NUM_DIV_CONV (mk_binop div_op_num tm max_const) in let th_mod = NUM_MOD_CONV (mk_binop mod_op_num tm max_const) in let q_tm = rand(concl th_div) in let r_tm = rand(concl th_mod) in let th0 = INST[tm, m_var_num; q_tm, q_var_num; r_tm, r_var_num] DIV_BASE in let th1 = MY_PROVE_HYP th_mod (MY_PROVE_HYP th_div th0) in let r = dest_small_numeral r_tm in let th2 = INST[q_tm, n_var_num] th_num_conv.(r) in let th = TRANS th1 th2 in let ltm, rtm = dest_comb(rand(concl th)) in let r_th = raw_conv rtm in TRANS th (AP_TERM ltm r_th) in if (fst o dest_const o rator) tm <> "NUMERAL" then failwith "NUMERAL_TO_NUM_CONV" else let th0 = raw_conv tm in let n_tm = rand(concl th0) in TRANS th0 (INST[n_tm, n_var_num] SYM_NUM_THM);; let replace_numerals = rand o concl o DEPTH_CONV NUMERAL_TO_NUM_CONV;; let REPLACE_NUMERALS = CONV_RULE (DEPTH_CONV NUMERAL_TO_NUM_CONV);; (* NUM_TO_NUMERAL_CONV *) let NUM_TO_NUMERAL_CONV tm = let rec raw_conv tm = if tm = zero_const then SYM_ZERO_EQ_ZERO else let b_tm, n_tm = dest_comb tm in let n_th = raw_conv n_tm in let n_tm' = rand(concl n_th) in let cb = (fst o dest_const) b_tm in let th0 = Hashtbl.find def_table cb in let th1 = AP_TERM b_tm n_th in let th2 = TRANS th1 (INST[n_tm', n_var_num] th0) in let ltm, rtm = dest_comb(rand(concl th2)) in let mul_th = NUM_MULT_CONV (rand ltm) in let add_th0 = AP_THM (AP_TERM plus_op_num mul_th) rtm in let add_th = TRANS add_th0 (NUM_ADD_CONV (rand(concl add_th0))) in TRANS th2 add_th in let ltm, rtm = dest_comb tm in if (fst o dest_const) ltm <> num_name then failwith "NUM_TO_NUMERAL_CONV" else let num_th = INST[rtm, n_var_num] NUM_THM in let th0 = raw_conv rtm in TRANS num_th th0;; (*************************) (* SUC_CONV *) let suc_const = `SUC`;; (* Theorems *) let SUC_NUM = prove(mk_eq(mk_comb(suc_const, mk_comb (num_const, n_var_num)), mk_comb(num_const, mk_comb (suc_const, n_var_num))), REWRITE_TAC[num_def; NUMERAL]);; let SUC_0 = prove(mk_eq(`SUC _0`, mk_comb (const_array.(1), zero_const)), REWRITE_TAC[def_array.(1); MUL_n_0; ARITH_SUC; NUMERAL; ARITH_ADD]);; let suc_th i = let cflag = (i + 1 >= maximum) in let suc = if (cflag) then 0 else i + 1 in let lhs = mk_comb(suc_const, (mk_comb (const_array.(i), n_var_num))) in let rhs = mk_comb(const_array.(suc), if (cflag) then mk_comb(suc_const, n_var_num) else n_var_num) in let proof = REWRITE_TAC [def_array.(i); def_array.(suc)] THEN ARITH_TAC in prove(mk_eq(lhs, rhs), proof);; let th_suc_array = Array.init maximum suc_th;; let th_suc_table = Hashtbl.create maximum;; for i = 0 to maximum - 1 do Hashtbl.add th_suc_table names_array.(i) th_suc_array.(i) done;; let SUC_MAX = th_suc_array.(maximum - 1);; let bit_max_name = names_array.(maximum - 1);; (* Conversion *) let rec raw_suc_conv_hash tm = let otm = rand tm in if (otm = zero_const) then SUC_0 else let btm, ntm = dest_comb otm in let cn = fst(dest_const btm) in if (cn = bit_max_name) then let th = INST [ntm, n_var_num] SUC_MAX in let ltm, rtm = dest_comb(rand(concl th)) in TRANS th (AP_TERM ltm (raw_suc_conv_hash rtm)) else INST [ntm, n_var_num] (Hashtbl.find th_suc_table cn);; let NUM_SUC_HASH_CONV tm = let ntm = rand (rand tm) in let th = INST [ntm, n_var_num] SUC_NUM in let lhs, rhs = dest_eq(concl th) in if (lhs <> tm) then failwith("NUM_SUC_HASH_CONV") else let ltm, rtm = dest_comb rhs in TRANS th (AP_TERM ltm (raw_suc_conv_hash rtm));; (**************************************) (* EQ_0_CONV *) let EQ_0_NUM = prove(mk_eq(mk_eq(mk_comb(num_const, n_var_num), `_0`), `n = _0`), REWRITE_TAC[num_def; NUMERAL]);; let EQ_B0_0 = prove(mk_eq(mk_eq(mk_comb(b0_const, n_var_num), `_0`), `n = _0`), REWRITE_TAC[b0_def; ADD_CLAUSES; NUMERAL; REWRITE_RULE[NUMERAL] MULT_EQ_0; ARITH_EQ]);; let EQ_0_0 = prove(`_0 = _0 <=> T`, REWRITE_TAC[ARITH_EQ]);; let eq_0_lemma = REWRITE_RULE[NUMERAL] (ARITH_RULE `a + b = 0 <=> a = 0 /\ b = 0`);; let eq_0_i i = let concl = mk_eq(mk_eq(mk_comb(const_array.(i), n_var_num), zero_const), false_const) in prove(concl, REWRITE_TAC[def_array.(i); eq_0_lemma; NUMERAL; ARITH_EQ]);; let th_eq0_array = Array.init maximum (fun i -> if (i = 0) then EQ_0_0 else eq_0_i i);; let th_eq0_table = Hashtbl.create maximum;; for i = 0 to maximum - 1 do Hashtbl.add th_eq0_table names_array.(i) th_eq0_array.(i) done;; let rec raw_eq0_hash_conv rtm = if (rtm = zero_const) then EQ_0_0 else let b_tm, n_tm = dest_comb rtm in let cn = (fst o dest_const) b_tm in if (cn = b0_name) then let th0 = INST[n_tm, n_var_num] EQ_B0_0 in let th1 = raw_eq0_hash_conv n_tm in TRANS th0 th1 else INST[n_tm, n_var_num] (Hashtbl.find th_eq0_table cn);; let NUM_EQ0_HASH_CONV rtm = let n_tm = rand rtm in let th = INST [n_tm, n_var_num] EQ_0_NUM in TRANS th (raw_eq0_hash_conv n_tm);; (**************************************) (* PRE_CONV *) let pre_const = `PRE`;; (* Theorems *) let PRE_NUM = prove(mk_eq(mk_comb(pre_const, mk_comb (num_const, n_var_num)), mk_comb(num_const, mk_comb (pre_const, n_var_num))), REWRITE_TAC[num_def; NUMERAL]);; let PRE_0 = prove(`PRE _0 = _0`, MP_TAC (CONJUNCT1 PRE) THEN SIMP_TAC[NUMERAL]);; let PRE_B1_0 = prove(mk_eq(mk_comb(`PRE`, mk_comb(const_array.(1), `_0`)), `_0`), REWRITE_TAC[def_array.(1); MUL_n_0; ARITH_ADD; NUMERAL; ARITH_PRE; ARITH_EQ]);; let PRE_B0_n0 = (UNDISCH_ALL o prove)(mk_imp(`n = _0 <=> T`, mk_eq(mk_comb(`PRE`, mk_comb(b0_const, `n:num`)), `_0`)), REWRITE_TAC[B0_EXPLICIT] THEN DISCH_THEN (fun th -> REWRITE_TAC[th; MUL_n_0]) THEN REWRITE_TAC[NUMERAL; ARITH_PRE]);; let PRE_B0_n1 = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o prove)(mk_imp(`n = 0 <=> F`, mk_eq(mk_comb(`PRE`, mk_comb(b0_const, `n:num`)), mk_comb(const_array.(maximum - 1), `PRE n`))), REWRITE_TAC[B0_EXPLICIT; def_array.(maximum - 1)] THEN ARITH_TAC);; let PRE_lemma = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o ARITH_RULE) `((n = 0) <=> F) ==> (SUC m = n <=> PRE n = m)`;; let pre_th i = let pre = i - 1 in let pre_tm = mk_comb(const_array.(pre), n_var_num) in let suc_tm = mk_comb(suc_const, pre_tm) in let suc_th = raw_suc_conv_hash suc_tm in let n_tm = rand(concl suc_th) in let n0_th = raw_eq0_hash_conv n_tm in let th0 = INST[pre_tm, m_var_num; n_tm, n_var_num] PRE_lemma in MY_PROVE_HYP n0_th (EQ_MP th0 suc_th);; let th_pre_array = Array.init maximum (fun i -> if i = 0 then REFL `_0` else pre_th i);; let th_pre_table = Hashtbl.create maximum;; for i = 0 to maximum - 1 do Hashtbl.add th_pre_table names_array.(i) th_pre_array.(i) done;; (* Conversion *) let b1_name = names_array.(1);; let b1_pre_thm = th_pre_array.(1);; let rec raw_pre_hash_conv tm = let otm = rand tm in if (otm = zero_const) then PRE_0 else let btm, ntm = dest_comb otm in let cn = fst(dest_const btm) in if (cn = b0_name) then let n_th = raw_eq0_hash_conv ntm in if (rand(concl n_th) = false_const) then let th0 = INST[ntm, n_var_num] PRE_B0_n1 in let th1 = MY_PROVE_HYP n_th th0 in let ltm, rtm = dest_comb(rand(concl th1)) in let th2 = raw_pre_hash_conv rtm in TRANS th1 (AP_TERM ltm th2) else let th = INST[ntm, n_var_num] PRE_B0_n0 in MY_PROVE_HYP n_th th else if (cn = b1_name) then if (ntm = zero_const) then PRE_B1_0 else INST[ntm, n_var_num] b1_pre_thm else INST [ntm, n_var_num] (Hashtbl.find th_pre_table cn);; let NUM_PRE_HASH_CONV tm = let ntm = rand (rand tm) in let th = INST [ntm, n_var_num] PRE_NUM in let lhs, rhs = dest_eq(concl th) in if (lhs <> tm) then failwith("NUM_PRE_HASH_CONV") else let ltm, rtm = dest_comb rhs in TRANS th (AP_TERM ltm (raw_pre_hash_conv rtm));; (**************************************) (* GT0_CONV *) let gt0_table = Hashtbl.create maximum;; let GT0_NUM = (REWRITE_RULE[GSYM num_def] o prove)(`0 < NUMERAL n <=> _0 < n`, REWRITE_TAC[NUMERAL]);; let gt0_0 = prove(`_0 < _0 <=> F`, REWRITE_TAC[ARITH_LT]);; let gt0_b0 = (REWRITE_RULE[NUMERAL] o prove)(mk_eq (mk_binop lt_op_num `0` (mk_comb(b0_const, n_var_num)), `0 < n`), REWRITE_TAC[b0_def] THEN ARITH_TAC);; let zero = `0`;; let gt0_th i = let bi = const_array.(i) in let concl = mk_eq (mk_binop lt_op_num zero (mk_comb(bi, n_var_num)), truth_const) in let proof = REWRITE_TAC[def_array.(i)] THEN ARITH_TAC in (PURE_REWRITE_RULE[NUMERAL] o prove)(concl, proof);; for i = 1 to maximum - 1 do Hashtbl.add gt0_table names_array.(i) (gt0_th i) done;; let rec raw_gt0_hash_conv rtm = if (rtm = zero_const) then gt0_0 else let b_tm, n_tm = dest_comb rtm in let cn = (fst o dest_const) b_tm in if (cn = b0_name) then let th0 = INST[n_tm, n_var_num] gt0_b0 in let th1 = raw_gt0_hash_conv n_tm in TRANS th0 th1 else INST[n_tm, n_var_num] (Hashtbl.find gt0_table cn);; let NUM_GT0_HASH_CONV rtm = let n_tm = rand rtm in let th = INST [n_tm, n_var_num] GT0_NUM in TRANS th (raw_gt0_hash_conv n_tm);; (*************************************) (* LT and LE *) let LT_NUM = (REWRITE_RULE[SYM num_def] o prove)(`NUMERAL m < NUMERAL n <=> m < n`, REWRITE_TAC[NUMERAL]);; let LE_NUM = (REWRITE_RULE[SYM num_def] o prove)(`NUMERAL m <= NUMERAL n <=> m <= n`, REWRITE_TAC[NUMERAL]);; let LT_n_0 = prove(`n < _0 <=> F`, SUBGOAL_THEN `_0 = 0` MP_TAC THENL [ REWRITE_TAC[NUMERAL]; ALL_TAC ] THEN DISCH_THEN (fun th -> PURE_ONCE_REWRITE_TAC[th]) THEN ARITH_TAC);; let LE_0_n = prove(`_0 <= n <=> T`, SUBGOAL_THEN `_0 = 0` MP_TAC THENL [ REWRITE_TAC[NUMERAL]; ALL_TAC ] THEN DISCH_THEN (fun th -> PURE_ONCE_REWRITE_TAC[th]) THEN ARITH_TAC);; let SUC_LT_THM = ARITH_RULE `SUC m < SUC n <=> m < n`;; let SUC_LE_THM = ARITH_RULE `SUC m <= SUC n <=> m <= n`;; (* LT tables *) (* Generates the theorem |- _0 < bi(n) <=> T (or |- _0 < b0(n) <=> _0 < n) *) let gen_0_lt_bi i = let bin = mk_comb (const_array.(i), n_var_num) in let lt_tm = mk_binop lt_op_num zero bin in if i > 0 then (PURE_REWRITE_RULE[NUMERAL] o EQT_INTRO o prove)(lt_tm, REWRITE_TAC[def_array.(i)] THEN ARITH_TAC) else (PURE_REWRITE_RULE[NUMERAL] o prove)(mk_eq(lt_tm, `0 < n`), REWRITE_TAC[B0_EXPLICIT] THEN ARITH_TAC);; let th_lt0_table = Hashtbl.create maximum;; for i = 0 to maximum - 1 do let th = gen_0_lt_bi i in let name = names_array.(i) in Hashtbl.add th_lt0_table name th done;; (* Generates the theorem |- bi(m) < bj(n) <=> m <= n (or m < n) *) let gen_bi_lt_bj i j = let bim = mk_comb (const_array.(i), m_var_num) in let bjn = mk_comb (const_array.(j), n_var_num) in let lt_tm = mk_binop lt_op_num bim bjn in let rhs = if i >= j then mk_binop lt_op_num m_var_num n_var_num else mk_binop le_op_num m_var_num n_var_num in prove(mk_eq(lt_tm, rhs), REWRITE_TAC[def_array.(i); def_array.(j)] THEN ARITH_TAC);; (* Given a theorem |- bi(m) < bj(n) <=> P m n, generates the theorem |- SUC(bi(m)) < SUC(bj(n)) <=> P m n *) let gen_next_lt_thm th = let ltm, n_tm = (dest_comb o lhand o concl) th in let m_tm = rand ltm in let th0 = INST[m_tm, m_var_num; n_tm, n_var_num] SUC_LT_THM in let suc_m = raw_suc_conv_hash (mk_comb (suc_const, m_tm)) in let suc_n = raw_suc_conv_hash (mk_comb (suc_const, n_tm)) in let th1 = SYM (MK_COMB ((AP_TERM lt_op_num suc_m), suc_n)) in TRANS (TRANS th1 th0) th;; let th_lt_table = Hashtbl.create (maximum * maximum);; for i = 0 to maximum - 1 do let th = ref (gen_bi_lt_bj 0 i) in let name_left = names_array.(0) and name_right = names_array.(i) in let _ = Hashtbl.add th_lt_table (name_left ^ name_right) !th in for k = 1 to maximum - i - 1 do let x = k and y = i + k in let name_left = names_array.(x) and name_right = names_array.(y) in th := gen_next_lt_thm (!th); Hashtbl.add th_lt_table (name_left ^ name_right) !th done; done;; for i = 1 to maximum - 1 do let th = ref (gen_bi_lt_bj i 0) in let name_left = names_array.(i) and name_right = names_array.(0) in let _ = Hashtbl.add th_lt_table (name_left ^ name_right) !th in for k = 1 to maximum - i - 1 do let x = i + k and y = k in let name_left = names_array.(x) and name_right = names_array.(y) in th := gen_next_lt_thm (!th); Hashtbl.add th_lt_table (name_left ^ name_right) !th done; done;; (* LE tables *) (* Generates the theorem |- bi(n) <= _0 <=> F (or |- b0(n) <= _0 <=> n <= _0) *) let gen_bi_le_0 i = let bin = mk_comb (const_array.(i), n_var_num) in let lt_tm = mk_binop le_op_num bin zero in if i > 0 then (PURE_REWRITE_RULE[NUMERAL] o prove)(mk_eq(lt_tm, false_const), REWRITE_TAC[def_array.(i)] THEN ARITH_TAC) else (PURE_REWRITE_RULE[NUMERAL] o prove)(mk_eq(lt_tm, `n <= 0`), REWRITE_TAC[B0_EXPLICIT] THEN ARITH_TAC);; let th_le0_table = Hashtbl.create maximum;; for i = 0 to maximum - 1 do let th = gen_bi_le_0 i in let name = names_array.(i) in Hashtbl.add th_le0_table name th done;; (* Generates the theorem |- bi(m) <= bj(n) <=> m <= n (or m < n) *) let gen_bi_le_bj i j = let bim = mk_comb (const_array.(i), m_var_num) in let bjn = mk_comb (const_array.(j), n_var_num) in let lt_tm = mk_binop le_op_num bim bjn in let rhs = if i > j then mk_binop lt_op_num m_var_num n_var_num else mk_binop le_op_num m_var_num n_var_num in prove(mk_eq(lt_tm, rhs), REWRITE_TAC[def_array.(i); def_array.(j)] THEN ARITH_TAC);; (* Given the theorem |- bi(m) <= bj(n) <=> P m n, generates the theorem |- SUC(bi(m)) <= SUC(bj(n)) <=> P m n *) let gen_next_le_thm th = let ltm, n_tm = (dest_comb o lhand o concl) th in let m_tm = rand ltm in let th0 = INST[m_tm, m_var_num; n_tm, n_var_num] SUC_LE_THM in let suc_m = raw_suc_conv_hash (mk_comb (suc_const, m_tm)) in let suc_n = raw_suc_conv_hash (mk_comb (suc_const, n_tm)) in let th1 = SYM (MK_COMB ((AP_TERM le_op_num suc_m), suc_n)) in TRANS (TRANS th1 th0) th;; let th_le_table = Hashtbl.create (maximum * maximum);; for i = 0 to maximum - 1 do let th = ref (gen_bi_le_bj 0 i) in let name_left = names_array.(0) and name_right = names_array.(i) in let _ = Hashtbl.add th_le_table (name_left ^ name_right) !th in for k = 1 to maximum - i - 1 do let x = k and y = i + k in let name_left = names_array.(x) and name_right = names_array.(y) in th := gen_next_le_thm (!th); Hashtbl.add th_le_table (name_left ^ name_right) !th done; done;; for i = 1 to maximum - 1 do let th = ref (gen_bi_le_bj i 0) in let name_left = names_array.(i) and name_right = names_array.(0) in let _ = Hashtbl.add th_le_table (name_left ^ name_right) !th in for k = 1 to maximum - i - 1 do let x = i + k and y = k in let name_left = names_array.(x) and name_right = names_array.(y) in th := gen_next_le_thm (!th); Hashtbl.add th_le_table (name_left ^ name_right) !th done; done;; (* Conversions *) let rec raw_lt_hash_conv tm = let ltm, rtm = dest_comb tm in let ltm = rand ltm in if is_const rtm then (* n < _0 <=> F *) INST[ltm, n_var_num] LT_n_0 else if is_const ltm then (* _0 < Bi(n) *) let bn_tm, n_tm = dest_comb rtm in let cbn = (fst o dest_const) bn_tm in let th0 = INST[n_tm, n_var_num] (Hashtbl.find th_lt0_table cbn) in if cbn = b0_name then let th1 = raw_lt_hash_conv (rand (concl th0)) in TRANS th0 th1 else th0 else (* Bi(n) < Bj(m) *) let bm_tm, m_tm = dest_comb ltm in let bn_tm, n_tm = dest_comb rtm in let cbm = (fst o dest_const) bm_tm in let cbn = (fst o dest_const) bn_tm in let th0 = INST[m_tm, m_var_num; n_tm, n_var_num] (Hashtbl.find th_lt_table (cbm^cbn)) in let op = (fst o dest_const o rator o rator o rand o concl) th0 in let th1 = if op = "<" then raw_lt_hash_conv (rand (concl th0)) else raw_le_hash_conv (rand (concl th0)) in TRANS th0 th1 and raw_le_hash_conv tm = let ltm, rtm = dest_comb tm in let ltm = rand ltm in if is_const ltm then (* _0 <= n <=> T *) INST[rtm, n_var_num] LE_0_n else if is_const rtm then (* Bi(n) <= _0 *) let bn_tm, n_tm = dest_comb ltm in let cbn = (fst o dest_const) bn_tm in let th0 = INST[n_tm, n_var_num] (Hashtbl.find th_le0_table cbn) in if cbn = b0_name then let th1 = raw_le_hash_conv (rand (concl th0)) in TRANS th0 th1 else th0 else (* Bi(n) <= Bj(m) *) let bm_tm, m_tm = dest_comb ltm in let bn_tm, n_tm = dest_comb rtm in let cbm = (fst o dest_const) bm_tm in let cbn = (fst o dest_const) bn_tm in let th0 = INST[m_tm, m_var_num; n_tm, n_var_num] (Hashtbl.find th_le_table (cbm^cbn)) in let op = (fst o dest_const o rator o rator o rand o concl) th0 in let th1 = if op = "<" then raw_lt_hash_conv (rand (concl th0)) else raw_le_hash_conv (rand (concl th0)) in TRANS th0 th1;; let NUM_LT_HASH_CONV tm = let atm, rtm = dest_comb tm in let ltm = rand atm in let th = INST [rand ltm, m_var_num; rand rtm, n_var_num] LT_NUM in let rtm = rand(concl th) in TRANS th (raw_lt_hash_conv rtm);; let NUM_LE_HASH_CONV tm = let atm, rtm = dest_comb tm in let ltm = rand atm in let th = INST [rand ltm, m_var_num; rand rtm, n_var_num] LE_NUM in let rtm = rand(concl th) in TRANS th (raw_le_hash_conv rtm);; (**************************************) (* ADD_CONV *) (* ADD theorems *) let ADD_NUM = (REWRITE_RULE[GSYM num_def] o prove) (`NUMERAL m + NUMERAL n = NUMERAL (m + n)`, REWRITE_TAC[NUMERAL]);; let CADD_0_n = prove(`SUC (_0 + n) = SUC n`, REWRITE_TAC[ADD_0_n]);; let CADD_n_0 = prove(`SUC (n + _0) = SUC n`, REWRITE_TAC[ADD_n_0]);; (* B0 (SUC n) = B0 n + maximum *) let B0_SUC = prove(mk_eq(mk_comb(b0_const, mk_comb(suc_const, n_var_num)), mk_binop plus_op_num max_const (mk_comb(b0_const, n_var_num))), REWRITE_TAC [B0_EXPLICIT] THEN ARITH_TAC);; let B0_ADD = prove(mk_eq(mk_binop plus_op_num (mk_comb(b0_const, m_var_num)) (mk_comb(b0_const, n_var_num)), mk_comb(b0_const, mk_binop plus_op_num m_var_num n_var_num)), REWRITE_TAC[B0_EXPLICIT] THEN ARITH_TAC);; let SUC_ADD_RIGHT = prove(`SUC(m + n) = m + SUC n`, ARITH_TAC);; (* Generate all theorems iteratively *) let th_add_right_next th = let lhs, rhs = dest_eq(concl th) in let ltm, rtm = dest_comb rhs in let cn = fst(dest_const ltm) in let suc_th = AP_TERM suc_const th in let th_rhs = INST[rtm, n_var_num] (Hashtbl.find th_suc_table cn) in let ltm, rarg = dest_comb lhs in let larg = rand ltm in let th1 = INST[larg, m_var_num; rarg, n_var_num] SUC_ADD_RIGHT in let cn = fst(dest_const(rator rarg)) in let th2 = Hashtbl.find th_suc_table cn in let th_lhs = TRANS th1 (AP_TERM ltm th2) in TRANS (TRANS (SYM th_lhs) suc_th) th_rhs;; let th_add_array = Array.make (maximum * maximum) (REFL zero_const);; for i = 0 to maximum - 1 do let th0 = if i = 0 then B0_ADD else INST[n_var_num, m_var_num; m_var_num, n_var_num] (ONCE_REWRITE_RULE[ADD_AC] th_add_array.(i)) in let _ = th_add_array.(i * maximum) <- th0 in for j = 1 to maximum - 1 do th_add_array.(i * maximum + j) <- th_add_right_next th_add_array.(i * maximum + j - 1) done; done;; (* SUC (B_i(m) + B_j(n)) = B_p(...) *) let th_cadd i j = let add_th = th_add_array.(i * maximum + j) in let th0 = AP_TERM suc_const add_th in let ltm, rtm = dest_comb(rand(concl th0)) in let ltm, rtm = dest_comb rtm in let cn = fst(dest_const ltm) in let suc_th = INST[rtm, n_var_num] (Hashtbl.find th_suc_table cn) in TRANS th0 suc_th;; let th_cadd_array = Array.make (maximum * maximum) (REFL zero_const);; for i = 0 to maximum - 1 do for j = 0 to maximum - 1 do th_cadd_array.(i * maximum + j) <- th_cadd i j done; done;; let th_add_table = Hashtbl.create (maximum * maximum);; for i = 0 to maximum - 1 do for j = 0 to maximum - 1 do let name = names_array.(i) ^ names_array.(j) in let th = th_add_array.(i * maximum + j) in let cflag = (i + j >= maximum) in Hashtbl.add th_add_table name (th, cflag) done; done;; let th_cadd_table = Hashtbl.create (maximum * maximum);; for i = 0 to maximum - 1 do for j = 0 to maximum - 1 do let name = names_array.(i) ^ names_array.(j) in let th = th_cadd_array.(i * maximum + j) in let cflag = (i + j + 1 >= maximum) in Hashtbl.add th_cadd_table name (th, cflag) done; done;; (* ADD conversion *) let rec raw_add_conv_hash tm = let atm,rtm = dest_comb tm in let ltm = rand atm in if ltm = zero_const then INST [rtm,n_var_num] ADD_0_n else if rtm = zero_const then INST [ltm,n_var_num] ADD_n_0 else let lbit,larg = dest_comb ltm and rbit,rarg = dest_comb rtm in let name = fst(dest_const lbit) ^ fst(dest_const rbit) in let th0, cflag = Hashtbl.find th_add_table name in let th = INST [larg, m_var_num; rarg, n_var_num] th0 in let ltm, rtm = dest_comb(rand(concl th)) in if cflag then TRANS th (AP_TERM ltm (raw_adc_conv_hash rtm)) else TRANS th (AP_TERM ltm (raw_add_conv_hash rtm)) and raw_adc_conv_hash tm = let atm,rtm = dest_comb (rand tm) in let ltm = rand atm in if ltm = zero_const then let th = INST [rtm,n_var_num] CADD_0_n in TRANS th (raw_suc_conv_hash (rand(concl th))) else if rtm = zero_const then let th = INST [ltm,n_var_num] CADD_n_0 in TRANS th (raw_suc_conv_hash (rand(concl th))) else let lbit,larg = dest_comb ltm and rbit,rarg = dest_comb rtm in let name = fst(dest_const lbit) ^ fst(dest_const rbit) in let th0, cflag = Hashtbl.find th_cadd_table name in let th = INST [larg, m_var_num; rarg, n_var_num] th0 in let ltm, rtm = dest_comb(rand(concl th)) in if cflag then TRANS th (AP_TERM ltm (raw_adc_conv_hash rtm)) else TRANS th (AP_TERM ltm (raw_add_conv_hash rtm));; let NUM_ADD_HASH_CONV tm = let atm, rtm = dest_comb tm in let ltm = rand atm in let th = INST [rand ltm, m_var_num; rand rtm, n_var_num] ADD_NUM in let ltm, rtm = dest_comb(rand(concl th)) in TRANS th (AP_TERM ltm (raw_add_conv_hash rtm));; (********************************) (* Subtraction *) let SUB_NUM = prove(mk_eq(mk_binop minus_op_num (mk_comb (num_const, m_var_num)) (mk_comb (num_const, n_var_num)), mk_comb(num_const, mk_binop minus_op_num m_var_num n_var_num)), REWRITE_TAC[num_def; NUMERAL]);; let SUB_lemma1 = (UNDISCH_ALL o ARITH_RULE) `n + t = m ==> m - n = t:num`;; let SUB_lemma2 = (UNDISCH_ALL o REWRITE_RULE[NUMERAL] o ARITH_RULE) `m + t = n ==> m - n = 0`;; let LE_lemma = (UNDISCH_ALL o ARITH_RULE) `n + t = m ==> n <= m:num`;; let raw_sub_hash_conv tm = let ltm, n_tm = dest_comb tm in let m_tm = rand ltm in let m = raw_dest_hash m_tm in let n = raw_dest_hash n_tm in let t = m -/ n in if t >=/ num_0 then let t_tm = rand (mk_numeral_array t) in let th0 = INST[n_tm, n_var_num; t_tm, t_var_num; m_tm, m_var_num] SUB_lemma1 in let th_add = raw_add_conv_hash (mk_binop plus_op_num n_tm t_tm) in MY_PROVE_HYP th_add th0 else let t_tm = rand (mk_numeral_array (Num.abs_num t)) in let th0 = INST[m_tm, m_var_num; t_tm, t_var_num; n_tm, n_var_num] SUB_lemma2 in let th_add = raw_add_conv_hash (mk_binop plus_op_num m_tm t_tm) in MY_PROVE_HYP th_add th0;; (* Returns either (tm1 - tm2, tm2 <= tm1) or (tm2 - tm1, tm1 <= tm2) *) let raw_sub_and_le_hash_conv tm1 tm2 = let m = raw_dest_hash tm1 in let n = raw_dest_hash tm2 in let t = m -/ n in if t >=/ num_0 then let t_tm = rand (mk_numeral_array t) in let inst = INST[tm2, n_var_num; t_tm, t_var_num; tm1, m_var_num] in let th_sub = inst SUB_lemma1 in let th_le = inst LE_lemma in let th_add = raw_add_conv_hash (mk_binop plus_op_num tm2 t_tm) in (MY_PROVE_HYP th_add th_sub, MY_PROVE_HYP th_add th_le) else let t_tm = rand (mk_numeral_array (Num.abs_num t)) in let inst = INST[tm2, m_var_num; t_tm, t_var_num; tm1, n_var_num] in let th_sub = inst SUB_lemma1 in let th_le = inst LE_lemma in let th_add = raw_add_conv_hash (mk_binop plus_op_num tm1 t_tm) in (MY_PROVE_HYP th_add th_sub, MY_PROVE_HYP th_add th_le);; let NUM_SUB_HASH_CONV tm = let atm, rtm = dest_comb tm in let ltm = rand atm in let th = INST [rand ltm, m_var_num; rand rtm, n_var_num] SUB_NUM in let ltm, rtm = dest_comb(rand(concl th)) in TRANS th (AP_TERM ltm (raw_sub_hash_conv rtm));; (********************************) (* Multiplication *) let MUL_NUM = prove(mk_eq(mk_binop mul_op_num (mk_comb(num_const, m_var_num)) (mk_comb(num_const, n_var_num)), mk_comb(num_const, mk_binop mul_op_num m_var_num n_var_num)), REWRITE_TAC[num_def; NUMERAL]);; let MUL_0_n = prove(`_0 * n = _0`, ONCE_REWRITE_TAC[GSYM NUM_THM] THEN ONCE_REWRITE_TAC[GSYM MUL_NUM] THEN REWRITE_TAC[num_def] THEN REWRITE_TAC[MULT_CLAUSES]);; let MUL_n_0 = ONCE_REWRITE_RULE[MULT_AC] MUL_0_n;; let MUL_1_n, MUL_n_1 = let one_const = mk_comb (const_array.(1), zero) in let cond = mk_eq(mk_binop mul_op_num one_const n_var_num, n_var_num) in let th = (REWRITE_RULE[NUMERAL] o prove)(cond, REWRITE_TAC[def_array.(1)] THEN ARITH_TAC) in th, ONCE_REWRITE_RULE[MULT_AC] th;; let MUL_B0_t = prove(mk_eq(mk_binop mul_op_num (mk_comb(b0_const, n_var_num)) t_var_num, mk_comb(b0_const, mk_binop mul_op_num n_var_num t_var_num)), REWRITE_TAC[def_array.(0)] THEN ARITH_TAC);; let MUL_t_B0 = ONCE_REWRITE_RULE[MULT_AC] MUL_B0_t;; let MUL_SUC_RIGHT = prove(`m * SUC(n) = m * n + m`, ARITH_TAC);; (* Multiplication table *) let mul_th_next_right th = let ltm, rtm = dest_comb(rand(rator(concl th))) in let mtm = rand ltm in let th0 = INST[mtm, m_var_num; rtm, n_var_num] MUL_SUC_RIGHT in let th1 = AP_THM (AP_TERM plus_op_num th) mtm in let sum_th = raw_add_conv_hash (rand(concl th1)) in let th2 = TRANS (TRANS th0 th1) sum_th in let cn = fst(dest_const (rator rtm)) in let th_suc = INST[zero_const, n_var_num] (Hashtbl.find th_suc_table cn) in let th3 = AP_TERM (mk_comb (mul_op_num, mtm)) th_suc in TRANS (SYM th3) th2;; let mul_array = Array.make (maximum * maximum) (REFL zero_const);; for i = 1 to maximum - 1 do let th1 = INST[mk_comb(const_array.(i), zero_const), n_var_num] MUL_n_1 in let _ = mul_array.(i * maximum + 1) <- th1 in for j = 2 to maximum - 1 do mul_array.(i * maximum + j) <- mul_th_next_right mul_array.(i * maximum + j - 1) done; done;; let mul_table = Hashtbl.create (maximum * maximum);; for i = 1 to maximum - 1 do for j = 1 to maximum - 1 do Hashtbl.add mul_table (names_array.(i) ^ names_array.(j)) mul_array.(i * maximum + j) done; done;; (* General multiplication theorem *) let prod_lemma = let mul (a,b) = mk_binop mul_op_num a b and add (a,b) = mk_binop plus_op_num a b in let lhs = mul(add(t_var_num, mk_comb(b0_const, m_var_num)), add(r_var_num, mk_comb(b0_const, n_var_num))) in let rhs = add(mul(t_var_num, r_var_num), mk_comb(b0_const, add(mk_comb(b0_const, mul(m_var_num, n_var_num)), add(mul(m_var_num, r_var_num), mul(n_var_num, t_var_num))))) in prove(mk_eq(lhs, rhs), REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MUL_B0_t; MUL_t_B0] THEN ONCE_REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[th_add_array.(0)] THEN REWRITE_TAC[ADD_AC; MULT_AC]);; let ADD_ASSOC' = SPEC_ALL ADD_ASSOC;; let dest_op tm = let ltm, rtm = dest_comb tm in rand ltm, rtm;; (* B_i(m) * B_j(n) = B_p(B_q(m * n) + m * B_j(0) + n * B_i(0)) where B_p(B_q(0)) = i * j *) let gen_mul_thm i j = let bi0 = mk_comb(const_array.(i), zero_const) and bj0 = mk_comb(const_array.(j), zero_const) in let def_i = INST[m_var_num, n_var_num] def_thm_array.(i) in let def_j = def_thm_array.(j) in let th0 = MK_COMB(AP_TERM mul_op_num def_i, def_j) in let th1 = TRANS th0 (INST[bi0, t_var_num; bj0, r_var_num] prod_lemma) in let mul_th = mul_array.(i * maximum + j) in let larg, rarg = dest_op (rand (concl th1)) in let th2 = TRANS th1 (AP_THM (AP_TERM plus_op_num mul_th) rarg) in let larg = rand(concl mul_th) in let b_low, b_high = dest_comb larg in let rtm = rand(rarg) in let th_add = INST[b_high, m_var_num; rtm, n_var_num] (fst(Hashtbl.find th_add_table (fst(dest_const b_low)^b0_name))) in if i * j < maximum then let ltm, rtm = dest_op(rand(rand(concl th_add))) in let add_0 = AP_TERM b_low (INST[rtm, n_var_num] ADD_0_n) in TRANS th2 (TRANS th_add add_0) else let larg, rtm = dest_op (rand(rand(concl th_add))) in let rarg, rtm = dest_op rtm in let th_assoc = INST[larg, m_var_num; rarg, n_var_num; rtm, p_var_num] ADD_ASSOC' in let mn = rand(rarg) in let b_high = rator b_high in let th_add2' = INST[zero_const, m_var_num; mn, n_var_num] (fst(Hashtbl.find th_add_table (fst(dest_const b_high)^b0_name))) in let add_0 = AP_TERM b_high (INST[mn, n_var_num] ADD_0_n) in let th_add2 = TRANS th_add2' add_0 in let th3 = TRANS th_assoc (AP_THM (AP_TERM plus_op_num th_add2) rtm) in let th4 = TRANS th_add (AP_TERM b_low th3) in TRANS th2 th4;; let gen_mul_table = Hashtbl.create (maximum * maximum);; for i = 1 to maximum - 1 do for j = 1 to maximum - 1 do let name = names_array.(i) ^ names_array.(j) in Hashtbl.add gen_mul_table name (gen_mul_thm i j) done; done;; (* B_i(m) * B_j(0) = B_p(B_q(0) + m * B_j(0)) where i * j = B_p(B_q(0)) *) let mul1_right_th i j = let th0 = INST[zero_const, n_var_num] (Hashtbl.find gen_mul_table (names_array.(i)^names_array.(j))) in let b_low, rtm = dest_comb(rand(concl th0)) in let tm1, tm23 = dest_op rtm in let tm2p, tm3 = dest_comb tm23 in let tm3_th = INST[rand tm3, n_var_num] MUL_0_n in let tm2_th = INST[rand(tm2p), n_var_num] ADD_n_0 in let tm23_th = TRANS (AP_TERM tm2p tm3_th) tm2_th in let ltm, rtm = dest_comb tm1 in if (i * j < maximum) then let tm1_th = TRANS (AP_TERM ltm (INST[m_var_num, n_var_num] MUL_n_0)) B0_0 in let tm123_th' = TRANS (INST[tm23, n_var_num] ADD_0_n) tm23_th in let tm123_th = TRANS (AP_THM (AP_TERM plus_op_num tm1_th) tm23) tm123_th' in TRANS th0 (AP_TERM b_low tm123_th) else let tm1_th = AP_TERM ltm (INST[m_var_num, n_var_num] MUL_n_0) in let tm123_th = MK_COMB(AP_TERM plus_op_num tm1_th, tm23_th) in TRANS th0 (AP_TERM b_low tm123_th);; (* B_j(0) * B_i(m) = B_p(B_q(0) + B_j(0) * B_i(m) *) let MULT_AC' = CONJUNCT1 MULT_AC;; let mul1_left_th th = let lhs, rhs = dest_eq(concl th) in let ltm, rtm = dest_op lhs in let th_lhs = INST[ltm, n_var_num; rtm, m_var_num] MULT_AC' in let btm, rtm = dest_comb rhs in let larg, rarg = dest_op rtm in if (is_comb larg) then let ltm, rtm = dest_op rarg in let th_rhs' = INST[ltm, m_var_num; rtm, n_var_num] MULT_AC' in let th_rhs = AP_TERM (mk_comb(plus_op_num, larg)) th_rhs' in TRANS th_lhs (TRANS th (AP_TERM btm th_rhs)) else let th_rhs = INST[larg, m_var_num; rarg, n_var_num] MULT_AC' in TRANS th_lhs (TRANS th (AP_TERM btm th_rhs));; let mul1_right_th_table = Hashtbl.create (maximum * maximum);; let mul1_left_th_table = Hashtbl.create (maximum * maximum);; for i = 1 to maximum - 1 do for j = 1 to maximum - 1 do let name_right = names_array.(i) ^ names_array.(j) in let name_left = names_array.(j) ^ names_array.(i) in let th = mul1_right_th i j in let add_flag = (i * j >= maximum) in let _ = Hashtbl.add mul1_right_th_table name_right (add_flag, th) in Hashtbl.add mul1_left_th_table name_left (add_flag, mul1_left_th th) done; done;; (******************************************************) (* Conversions *) (* Multiplies arg and (tm = tmname(_0)) *) let rec raw_mul1_right_hash arg tm tmname = if arg = zero_const then INST [tm, n_var_num] MUL_0_n else let btm, mtm = dest_comb arg in let cn = fst(dest_const btm) in if (cn = b0_name) then let th = INST[mtm, n_var_num; tm, t_var_num] MUL_B0_t in TRANS th (AP_TERM b0_const (raw_mul1_right_hash mtm tm tmname)) else let name = cn ^ tmname in if (mtm = zero_const) then Hashtbl.find mul_table name else let add_flag, th' = Hashtbl.find mul1_right_th_table name in let th = INST[mtm, m_var_num] th' in if add_flag then let ltm, rtm = dest_comb(rand(concl th)) in let lplus, rarg = dest_comb rtm in let th2 = AP_TERM lplus (raw_mul1_right_hash mtm tm tmname) in let th_add = raw_add_conv_hash (rand(concl th2)) in TRANS th (AP_TERM ltm (TRANS th2 th_add)) else let ltm = rator(rand(concl th)) in let th2 = AP_TERM ltm (raw_mul1_right_hash mtm tm tmname) in TRANS th th2;; (* Multiplies (tm = tmname(_0)) and arg *) let rec raw_mul1_left_hash tm tmname arg = if arg = zero_const then INST [tm, n_var_num] MUL_n_0 else let btm, mtm = dest_comb arg in let cn = fst(dest_const btm) in if (cn = b0_name) then let th = INST[mtm, n_var_num; tm, t_var_num] MUL_t_B0 in TRANS th (AP_TERM b0_const (raw_mul1_left_hash tm tmname mtm)) else let name = tmname ^ cn in if (mtm = zero_const) then Hashtbl.find mul_table name else let add_flag, th' = Hashtbl.find mul1_left_th_table name in let th = INST[mtm, m_var_num] th' in if add_flag then let ltm, rtm = dest_comb(rand(concl th)) in let lplus, rarg = dest_comb rtm in let th2 = AP_TERM lplus (raw_mul1_left_hash tm tmname mtm) in let th_add = raw_add_conv_hash (rand(concl th2)) in TRANS th (AP_TERM ltm (TRANS th2 th_add)) else let ltm = rator(rand(concl th)) in let th2 = AP_TERM ltm (raw_mul1_left_hash tm tmname mtm) in TRANS th th2;; (* Computes B_i(m) * B_j(n) *) let rec raw_mul_conv_hash tm = let larg, rarg = dest_comb tm in let larg = rand larg in if larg = zero_const then INST [rarg, n_var_num] MUL_0_n else if rarg = zero_const then INST [larg, n_var_num] MUL_n_0 else let lbtm, mtm = dest_comb larg in let lcn = fst(dest_const lbtm) in if (lcn = b0_name) then let th = INST[rarg, t_var_num; mtm, n_var_num] MUL_B0_t in let ltm, rtm = dest_comb(rand(concl th)) in TRANS th (AP_TERM ltm (raw_mul_conv_hash rtm)) else let rbtm, ntm = dest_comb rarg in let rcn = fst(dest_const rbtm) in if (rcn = b0_name) then let th = INST[larg, t_var_num; ntm, n_var_num] MUL_t_B0 in let ltm, rtm = dest_comb(rand(concl th)) in TRANS th (AP_TERM ltm (raw_mul_conv_hash rtm)) else if (ntm = zero_const) then if (mtm = zero_const) then Hashtbl.find mul_table (lcn ^ rcn) else raw_mul1_right_hash larg (mk_comb(rbtm, zero_const)) rcn else if (mtm = zero_const) then raw_mul1_left_hash (mk_comb(lbtm, zero_const)) lcn rarg else let th0 = INST[mtm, m_var_num; ntm, n_var_num] (Hashtbl.find gen_mul_table (lcn ^ rcn)) in let b_low, expr = dest_comb(rand(concl th0)) in let ltm, rsum = dest_comb expr in let b_high, mul0 = dest_comb (rand ltm) in let th_mul0 = raw_mul_conv_hash mul0 in let th_mul1 = raw_mul1_right_hash mtm (mk_comb(rbtm, zero_const)) rcn in let th_mul2 = raw_mul1_right_hash ntm (mk_comb(lbtm, zero_const)) lcn in let th_larg = AP_TERM plus_op_num (AP_TERM b_high th_mul0) in let th_rarg = MK_COMB(AP_TERM plus_op_num th_mul1, th_mul2) in let add_rarg = TRANS th_rarg (raw_add_conv_hash (rand(concl th_rarg))) in let add_th = MK_COMB (th_larg, add_rarg) in let add = TRANS add_th (raw_add_conv_hash (rand(concl add_th))) in TRANS th0 (AP_TERM b_low add);; (* The main multiplication conversion *) let NUM_MULT_HASH_CONV tm = let ltm, rtm = dest_comb tm in let larg, rarg = rand (rand ltm), rand rtm in let th0 = INST[larg, m_var_num; rarg, n_var_num] MUL_NUM in if (rand(rator(concl th0)) <> tm) then failwith "NUM_MULT_HASH_CONV" else let rtm = rand(rand(concl th0)) in let th = raw_mul_conv_hash rtm in TRANS th0 (AP_TERM num_const th);; (************************************) (* DIV *) let DIV_NUM = prove(mk_eq(mk_binop div_op_num (mk_comb(num_const, m_var_num)) (mk_comb(num_const, n_var_num)), mk_comb(num_const, mk_binop div_op_num m_var_num n_var_num)), REWRITE_TAC[num_def; NUMERAL]);; let DIV_UNIQ' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[ARITH_RULE `a < b <=> (a < b:num <=> T)`] o ONCE_REWRITE_RULE[ARITH_RULE `m = q * n + r <=> q * n + r = m:num`] o REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL) DIV_UNIQ;; (* Computes m DIV n *) let raw_div_hash_conv tm = let ltm, n_tm = dest_comb tm in let m_tm = rand ltm in let m = raw_dest_hash m_tm in let n = raw_dest_hash n_tm in let q = Num.quo_num m n and r = Num.mod_num m n in let q_tm = rand (mk_numeral_array q) and r_tm = rand (mk_numeral_array r) in let qn_th = raw_mul_conv_hash (mk_binop mul_op_num q_tm n_tm) in let qn_tm = rand (concl qn_th) in let qnr_th = raw_add_conv_hash (mk_binop plus_op_num qn_tm r_tm) in let th1 = TRANS (AP_THM (AP_TERM plus_op_num qn_th) r_tm) qnr_th in let th2 = raw_lt_hash_conv (mk_binop lt_op_num r_tm n_tm) in let th0 = INST[r_tm, r_var_num; n_tm, n_var_num; m_tm, m_var_num; q_tm, q_var_num] DIV_UNIQ' in MY_PROVE_HYP th1 (MY_PROVE_HYP th2 th0);; (* The main division conversion *) let NUM_DIV_HASH_CONV tm = let ltm, rtm = dest_comb tm in let larg, rarg = rand (rand ltm), rand rtm in let th0 = INST[larg, m_var_num; rarg, n_var_num] DIV_NUM in if (rand(rator(concl th0)) <> tm) then failwith "NUM_DIV_HASH_CONV" else let rtm = rand(rand(concl th0)) in let th = raw_div_hash_conv rtm in TRANS th0 (AP_TERM num_const th);; (*********************************************) (* EVEN_CONV, ODD_CONV *) let even_const = `EVEN` and odd_const = `ODD` and eq_const = `<=>` and f_const = `F` and t_const = `T`;; let EVEN_NUM = (REWRITE_RULE[GSYM num_def] o prove) (`EVEN (NUMERAL n) <=> EVEN n`, REWRITE_TAC[NUMERAL]);; let ODD_NUM = (REWRITE_RULE[GSYM num_def] o prove) (`ODD (NUMERAL n) <=> ODD n`, REWRITE_TAC[NUMERAL]);; let EVEN_ZERO = prove(`EVEN _0 <=> T`, REWRITE_TAC[ARITH_EVEN]);; let ODD_ZERO = prove(`ODD _0 <=> F`, REWRITE_TAC[ARITH_ODD]);; let EVEN_B0 = prove(mk_eq(mk_comb(`EVEN`, mk_comb(b0_const, `n:num`)), `T`), REWRITE_TAC[B0_EXPLICIT; EVEN_MULT] THEN DISJ1_TAC THEN CONV_TAC NUM_EVEN_CONV);; let ODD_B0 = prove(mk_eq(mk_comb(`ODD`, mk_comb(b0_const, `n:num`)), `F`), REWRITE_TAC[NOT_ODD; EVEN_B0]);; let EVEN_SUC_T = prove(`(EVEN (SUC n) <=> T) <=> (EVEN n <=> F)`, REWRITE_TAC[EVEN]);; let EVEN_SUC_F = prove(`(EVEN (SUC n) <=> F) <=> (EVEN n <=> T)`, REWRITE_TAC[EVEN]);; let ODD_SUC_T = prove(`(ODD (SUC n) <=> T) <=> (ODD n <=> F)`, REWRITE_TAC[ODD]);; let ODD_SUC_F = prove(`(ODD (SUC n) <=> F) <=> (ODD n <=> T)`, REWRITE_TAC[ODD]);; let next_even_th th = let ltm, rtm = dest_comb(concl th) in let b_tm = rand(rand ltm) in let suc_b = raw_suc_conv_hash (mk_comb (suc_const, b_tm)) in let flag = (fst o dest_const) rtm = "T" in let th0 = SYM (AP_TERM even_const suc_b) in let th1 = AP_THM (AP_TERM eq_const th0) (if flag then f_const else t_const) in let th2 = INST[b_tm, n_var_num] (if flag then EVEN_SUC_F else EVEN_SUC_T) in EQ_MP (SYM (TRANS th1 th2)) th;; let next_odd_th th = let ltm, rtm = dest_comb(concl th) in let b_tm = rand(rand ltm) in let suc_b = raw_suc_conv_hash (mk_comb (suc_const, b_tm)) in let flag = (fst o dest_const) rtm = "T" in let th0 = SYM (AP_TERM odd_const suc_b) in let th1 = AP_THM (AP_TERM eq_const th0) (if flag then f_const else t_const) in let th2 = INST[b_tm, n_var_num] (if flag then ODD_SUC_F else ODD_SUC_T) in EQ_MP (SYM (TRANS th1 th2)) th;; let even_thm_table = Hashtbl.create maximum;; Hashtbl.add even_thm_table names_array.(0) EVEN_B0;; for i = 1 to maximum - 1 do let th0 = next_even_th (Hashtbl.find even_thm_table names_array.(i - 1)) in Hashtbl.add even_thm_table names_array.(i) th0 done;; let odd_thm_table = Hashtbl.create maximum;; Hashtbl.add odd_thm_table names_array.(0) ODD_B0;; for i = 1 to maximum - 1 do let th0 = next_odd_th (Hashtbl.find odd_thm_table names_array.(i - 1)) in Hashtbl.add odd_thm_table names_array.(i) th0 done;; let raw_even_hash_conv tm = let ltm, rtm = dest_comb tm in if ((fst o dest_const) ltm <> "EVEN") then failwith "raw_even_hash_conv: no EVEN" else if (is_const rtm) then EVEN_ZERO else let b_tm, n_tm = dest_comb rtm in let th0 = Hashtbl.find even_thm_table ((fst o dest_const) b_tm) in INST[n_tm, n_var_num] th0;; let raw_odd_hash_conv tm = let ltm, rtm = dest_comb tm in if ((fst o dest_const) ltm <> "ODD") then failwith "raw_odd_hash_conv: no ODD" else if (is_const rtm) then ODD_ZERO else let b_tm, n_tm = dest_comb rtm in let th0 = Hashtbl.find odd_thm_table ((fst o dest_const) b_tm) in INST[n_tm, n_var_num] th0;; let NUM_EVEN_HASH_CONV tm = let ltm, rtm = dest_comb tm in let th0 = INST[rand rtm, n_var_num] EVEN_NUM in let ltm, rtm = dest_comb(concl th0) in if (rand ltm <> tm) then failwith "NUM_EVEN_HASH_CONV" else let th1 = raw_even_hash_conv rtm in TRANS th0 th1;; let NUM_ODD_HASH_CONV tm = let ltm, rtm = dest_comb tm in let th0 = INST[rand rtm, n_var_num] ODD_NUM in let ltm, rtm = dest_comb(concl th0) in if (rand ltm <> tm) then failwith "NUM_ODD_HASH_CONV" else let th1 = raw_odd_hash_conv rtm in TRANS th0 th1;; end;; hol-light/Formal_ineqs/arith/eval_interval.hl000066400000000000000000000224501303454263000216560ustar00rootroot00000000000000(* =========================================================== *) (* Formal interval evaluation of arithmetic expressions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "arith/more_float.hl";; needs "arith/float_atn.hl";; needs "misc/vars.hl";; module Eval_interval = struct open Arith_misc;; open Interval_arith;; open Arith_float;; open Float_atn;; open More_float;; open Misc_vars;; (* Creates an interval approximation of the given decimal term *) let mk_float_interval_decimal = let DECIMAL' = SPEC_ALL DECIMAL in fun pp decimal_tm -> let n_tm, d_tm = dest_binary "DECIMAL" decimal_tm in let n, d = dest_numeral n_tm, dest_numeral d_tm in let n_int, d_int = mk_float_interval_num n, mk_float_interval_num d in let int = float_interval_div pp n_int d_int in let eq_th = INST[n_tm, x_var_num; d_tm, y_var_num] DECIMAL' in norm_interval int eq_th;; (* Unary interval operations *) let unary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table `--` (fun pp -> float_interval_neg); add table `inv` float_interval_inv; add table `sqrt` float_interval_sqrt; add table `atn` float_interval_atn; add table `acs` float_interval_acs; table;; (* Binary interval operations *) let binary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table `+` float_interval_add; add table `-` float_interval_sub; add table `*` float_interval_mul; add table `/` float_interval_div; table;; (* Interval approximations of constants *) let interval_constants = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table `pi` (fun pp -> pi_approx_array.(pp)); table;; (* Type of an interval function *) type interval_fun = | Int_ref of int | Int_var of term | Int_const of thm | Int_decimal_const of term | Int_named_const of term | Int_pow of int * interval_fun | Int_unary of term * interval_fun | Int_binary of term * interval_fun * interval_fun;; (* Evaluates the given interval function at the point defined by the given list of variables *) let eval_interval_fun pp ifun vars refs = let u_find = Hashtbl.find unary_interval_operations and b_find = Hashtbl.find binary_interval_operations and c_find = Hashtbl.find interval_constants in let rec rec_eval f = match f with | Int_ref i -> List.nth refs i | Int_var tm -> assoc tm vars | Int_const th -> th | Int_decimal_const tm -> mk_float_interval_decimal pp tm | Int_named_const tm -> c_find tm pp | Int_pow (n,f1) -> float_interval_pow_simple pp n (rec_eval f1) | Int_unary (tm,f1) -> u_find tm pp (rec_eval f1) | Int_binary (tm,f1,f2) -> b_find tm pp (rec_eval f1) (rec_eval f2) in rec_eval ifun;; (* Evaluates all sub-expressions involving constants in the given interval function *) let eval_constants pp ifun = let u_find = Hashtbl.find unary_interval_operations and b_find = Hashtbl.find binary_interval_operations and c_find = Hashtbl.find interval_constants in let rec rec_eval f = match f with | Int_decimal_const tm -> Int_const (mk_float_interval_decimal pp tm) | Int_named_const tm -> Int_const (c_find tm pp) | Int_pow (n,f1) -> (let f1_val = rec_eval f1 in match f1_val with | Int_const th -> Int_const (float_interval_pow_simple pp n th) | _ -> Int_pow (n,f1_val)) | Int_unary (tm,f1) -> (let f1_val = rec_eval f1 in match f1_val with | Int_const th -> Int_const (u_find tm pp th) | _ -> Int_unary (tm, f1_val)) | Int_binary (tm,f1,f2) -> (let f1_val, f2_val = rec_eval f1, rec_eval f2 in match f1_val with | Int_const th1 -> (match f2_val with | Int_const th2 -> Int_const (b_find tm pp th1 th2) | _ -> Int_binary (tm, f1_val, f2_val)) | _ -> Int_binary (tm, f1_val, f2_val)) | _ -> f in rec_eval ifun;; (**************************************) (* Builds an interval function from the given term *) let rec build_interval_fun expr_tm = if is_const expr_tm then (* Constant *) Int_named_const expr_tm else if is_var expr_tm then (* Variable *) Int_var expr_tm else let ltm, r_tm = dest_comb expr_tm in (* Unary operations *) if is_const ltm then (* & *) if ltm = amp_op_real then let n = dest_numeral r_tm in Int_const (mk_float_interval_num n) else let r_fun = build_interval_fun r_tm in Int_unary (ltm, r_fun) else (* Binary operations *) let op, l_tm = dest_comb ltm in let name = (fst o dest_const) op in if name = "DECIMAL" then (* DECIMAL *) Int_decimal_const expr_tm else if name = "real_pow" then (* pow *) let n = dest_small_numeral r_tm in Int_pow (n, build_interval_fun l_tm) else if name = "$" then (* $ *) Int_var expr_tm else let lhs = build_interval_fun l_tm and rhs = build_interval_fun r_tm in Int_binary (op, lhs, rhs);; (********************************) (* Replaces the given subexpression with the given reference index in all interval functions in the list. Returns the number of replaces and a new list of interval functions *) let replace_subexpr expr expr_index f_list = let rec replace f = if f = expr then 1, Int_ref expr_index else match f with | Int_pow (k, f1) -> let c, f1' = replace f1 in c, Int_pow (k, f1') | Int_unary (tm, f1) -> let c, f1' = replace f1 in c, Int_unary (tm, f1') | Int_binary (tm, f1, f2) -> let c1, f1' = replace f1 in let c2, f2' = replace f2 in c1 + c2, Int_binary (tm, f1', f2') | _ -> 0, f in let cs, fs = unzip (map replace f_list) in itlist (+) cs 0, fs;; let is_leaf f = match f with | Int_pow _ -> false | Int_unary _ -> false | Int_binary _ -> false | _ -> true;; let find_and_replace_all f_list acc = let rec find_and_replace f i f_list = if is_leaf f then f, (0, f_list) else let expr, (c, fs) = match f with | Int_pow (k, f1) -> find_and_replace f1 i f_list | Int_unary (tm, f1) -> find_and_replace f1 i f_list | Int_binary (tm, f1, f2) -> let expr, (c1, fs) = find_and_replace f1 i f_list in if c1 > 1 then expr, (c1, fs) else find_and_replace f2 i f_list | _ -> f, (0, f_list) in if c > 1 then expr, (c, fs) else f, replace_subexpr f i f_list in let rec iterate fs acc = let i = length acc in let expr, (c, fs') = find_and_replace (hd fs) i fs in if c > 1 then iterate fs' (acc @ [expr]) else fs, acc in let rec iterate_all f_list ref_acc f_acc = match f_list with | [] -> f_acc, ref_acc | f :: fs -> let fs', acc' = iterate f_list ref_acc in iterate_all (tl fs') acc' (f_acc @ [hd fs']) in iterate_all f_list acc [];; let eval_interval_fun_list pp (f_list, refs) vars = let rec eval_refs refs acc = match refs with | [] -> acc | r :: rs -> let v = eval_interval_fun pp r vars acc in eval_refs rs (acc @ [v]) in let rs = eval_refs refs [] in map (fun f -> eval_interval_fun pp f vars rs) f_list;; (***************************************) (* Approximate the bounds of the given interval with floating point numbers *) let interval_to_float_interval = let th = (UNDISCH_ALL o prove)(`interval_arith x (lo, hi) ==> interval_arith lo (a, y) ==> interval_arith hi (z, b) ==> interval_arith x (a, b)`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC) in fun pp int_th -> let x_tm, bounds = dest_interval_arith (concl int_th) in let lo, hi = dest_pair bounds in let f_lo = build_interval_fun lo and f_hi = build_interval_fun hi in let th_lo = eval_interval_fun pp f_lo [] [] and th_hi = eval_interval_fun pp f_hi [] [] in let a_tm, y_tm = (dest_pair o rand o concl) th_lo and z_tm, b_tm = (dest_pair o rand o concl) th_hi in let th1 = INST[x_tm, x_var_real; lo, lo_var_real; hi, hi_var_real; a_tm, a_var_real; y_tm, y_var_real; z_tm, z_var_real; b_tm, b_var_real] th in (MY_PROVE_HYP int_th o MY_PROVE_HYP th_lo o MY_PROVE_HYP th_hi) th1;; (* Adds a new constant approximation to the table of constants *) let add_constant_interval int_th = let c_tm, _ = dest_interval_arith (concl int_th) in let _ = is_const c_tm or failwith "add_constant_interval: not a constant" in let th = interval_to_float_interval 20 int_th in let approx_array = Array.init 20 (fun i -> float_interval_round i th) in Hashtbl.add interval_constants c_tm (fun pp -> approx_array.(pp));; end;; hol-light/Formal_ineqs/arith/float.hl000066400000000000000000004640541303454263000201420ustar00rootroot00000000000000(* =========================================================== *) (* Formal floating point arithmetic *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "arith/nat.hl";; needs "arith/num_exp_theory.hl";; needs "arith/float_theory.hl";; needs "arith/interval_arith.hl";; needs "misc/vars.hl";; (* FLOOR_DIV_DIV *) needs "Library/floor.ml";; (* sqrt and its properties *) needs "Multivariate/vectors.ml";; prioritize_real();; module type Arith_float_sig = sig val mk_num_exp : term -> term -> term val dest_num_exp : term -> (term * term) val dest_float : term -> (string * term * term) val float_lt0 : term -> thm val float_gt0 : term -> thm val float_lt : term -> term -> thm val float_le0 : term -> thm val float_ge0 : term -> thm val float_le : term -> term -> thm val float_min : term -> term -> thm val float_max : term -> term -> thm val float_min_max : term -> term -> (thm * thm) val float_mul_eq : term -> term -> thm val float_mul_lo : int -> term -> term -> thm val float_mul_hi : int -> term -> term -> thm val float_div_lo : int -> term -> term -> thm val float_div_hi : int -> term -> term -> thm val float_add_lo : int -> term -> term -> thm val float_add_hi : int -> term -> term -> thm val float_sub_lo : int -> term -> term -> thm val float_sub_hi : int -> term -> term -> thm val float_sqrt_lo : int -> term -> thm val float_sqrt_hi : int -> term -> thm val reset_stat : unit -> unit val reset_cache : unit -> unit val print_stat : unit -> unit val dest_float_interval : term -> term * term * term val mk_float_interval_small_num : int -> thm val mk_float_interval_num : num -> thm val float_lo : int -> term -> thm val float_hi : int -> term -> thm val float_interval_round : int -> thm -> thm val float_interval_neg : thm -> thm val float_interval_mul : int -> thm -> thm -> thm val float_interval_div : int -> thm -> thm -> thm val float_interval_add : int -> thm -> thm -> thm val float_interval_sub : int -> thm -> thm -> thm val float_interval_sqrt : int -> thm -> thm val float_abs : term -> thm val FLOAT_TO_NUM_CONV : term -> thm end;; module Arith_float : Arith_float_sig = struct open Big_int;; open Arith_misc;; open Arith_nat;; open Num_exp_theory;; open Float_theory;; open Interval_arith;; open Misc_vars;; (* interval *) let APPROX_INTERVAL' = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL) APPROX_INTERVAL;; let interval_const = `interval_arith` and num_exp_const = `num_exp`;; let b0_const = (fst o dest_comb o lhand o concl) (Arith_hash.def_array.(0));; let b0_name = (fst o dest_const) b0_const;; let base_const = mk_small_numeral Arith_hash.arith_base;; let NUM_REMOVE = prove(mk_eq(mk_comb(Arith_hash.num_const, n_var_num), n_var_num), REWRITE_TAC[Arith_hash.num_def; NUMERAL]);; (* B0 n = base * n *) let b0_thm = prove(mk_eq(mk_comb(b0_const, n_var_num), mk_binop mul_op_num base_const n_var_num), REWRITE_TAC[Arith_hash.def_array.(0)] THEN TRY ARITH_TAC THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [BIT0] THEN ARITH_TAC);; let dest_num_exp tm = let ltm, e_tm = dest_comb tm in rand ltm, e_tm;; let num_exp_const = `num_exp`;; let mk_num_exp n_tm e_tm = mk_binop num_exp_const n_tm e_tm;; (* float_num s n e -> "s", n, e *) let dest_float tm = let ltm, e_tm = dest_comb tm in let ltm, n_tm = dest_comb ltm in let float_tm, s_tm = dest_comb ltm in if (fst o dest_const) float_tm <> "float_num" then failwith "dest_float: not float" else (fst o dest_const) s_tm, n_tm, e_tm;; (************************************) let NUM_EXP_EXP' = SPEC_ALL NUM_EXP_EXP;; let NUM_EXP_0' = (SPEC_ALL o REWRITE_RULE[NUMERAL]) NUM_EXP_0;; let NUM_EXP_LE' = (UNDISCH_ALL o SPEC_ALL) NUM_EXP_LE;; let NUM_EXP_LT' = (UNDISCH_ALL o SPEC_ALL) NUM_EXP_LT;; (* B0 n = num_exp n bits *) let normal_lemma1 = prove(mk_eq(mk_comb(b0_const, n_var_num), `num_exp n 1`), REWRITE_TAC[Arith_hash.def_array.(0); num_exp] THEN TRY ARITH_TAC THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [BIT0] THEN ARITH_TAC);; let NORMAL_LEMMA1 = NUMERALS_TO_NUM normal_lemma1;; let normal_lemma2 = prove(mk_eq (mk_comb (b0_const, `num_exp n e`), `num_exp n (SUC e)`), REWRITE_TAC[normal_lemma1; NUM_EXP_EXP] THEN ARITH_TAC);; let rec normalize tm = if (is_comb tm) then let ltm, rtm = dest_comb tm in let lname = (fst o dest_const) ltm in if (lname = b0_name) then let lth = INST[rtm, n_var_num] NORMAL_LEMMA1 in let rth, flag = normalize rtm in if flag then let ltm, lexp = (dest_comb o snd o dest_eq o concl) lth in let ltm, rtm = dest_comb ltm in let rn, rexp = (dest_comb o snd o dest_eq o concl) rth in let rn = rand rn in let th1 = AP_THM (AP_TERM ltm rth) lexp in let th2 = INST[rexp, e1_var_num; lexp, e2_var_num; rn, n_var_num] NUM_EXP_EXP' in let th3 = TRANS lth (TRANS th1 th2) in let ltm, rtm = (dest_comb o snd o dest_eq o concl) th3 in let add_th = raw_add_conv_hash rtm in let th4 = AP_TERM ltm add_th in (TRANS th3 th4, true) else (lth, true) else (REFL tm, false) else (REFL tm, false);; (* Converts a raw numeral to a num_exp expression *) let to_num_exp tm = let x, flag = normalize tm in if flag then x else INST[tm, n_var_num] NUM_EXP_0';; (************************************) let SYM_NUM_EXP_0' = SYM NUM_EXP_0';; let NUM_EXP_n0 = prove(`!e. num_exp 0 e = 0`, REWRITE_TAC[num_exp; MULT_CLAUSES]);; let NUM_EXP_n0' = (REWRITE_RULE[NUMERAL] o SPEC_ALL) NUM_EXP_n0;; let NUM_EXP_DENORM = (UNDISCH_ALL o prove) (mk_imp(`e = _0 <=> F`, mk_eq(`num_exp n e`, mk_comb (b0_const, `num_exp n (PRE e)`))), REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SYM (REWRITE_CONV[NUMERAL] `0`)] THEN REWRITE_TAC[num_exp; b0_thm] THEN REWRITE_TAC[ARITH_RULE (mk_eq(mk_binop mul_op_num base_const `n * a:num`, mk_binop mul_op_num `n:num` (mk_binop mul_op_num base_const `a:num`)))] THEN REWRITE_TAC[GSYM EXP] THEN SIMP_TAC[ARITH_RULE `~(e = 0) ==> SUC (PRE e) = e`]);; (* Converts num_exp n e to a numeral by adding e B0's *) let rec denormalize tm = let ltm, etm = dest_comb tm in let ntm = rand ltm in if (etm = zero_const) then INST[ntm, n_var_num] SYM_NUM_EXP_0' else if ntm = zero_const then INST[etm, e_var_num] NUM_EXP_n0' else let e_th = raw_eq0_hash_conv etm in let th0' = INST[etm, e_var_num; ntm, n_var_num] NUM_EXP_DENORM in let th0 = MY_PROVE_HYP e_th th0' in let b0_tm, rtm = dest_comb(rand(concl th0)) in let ltm, pre_tm = dest_comb rtm in let pre_th = raw_pre_hash_conv pre_tm in let th1 = AP_TERM ltm pre_th in let th2 = denormalize (rand(concl th1)) in TRANS th0 (AP_TERM b0_tm (TRANS th1 th2));; (***************************************) let rec comb_number tm n = if (is_comb tm) then comb_number ((snd o dest_comb) tm) (n + 1) else n;; let make_lo_thm i = let th_concl = mk_binop `(<=):num->num->bool` (mk_comb (Arith_hash.const_array.(0), n_var_num)) (mk_comb (Arith_hash.const_array.(i), n_var_num)) in prove(th_concl, REWRITE_TAC[Arith_hash.def_array.(i); Arith_hash.def_array.(0)] THEN REWRITE_TAC[ARITH_LE; LE_REFL] THEN ARITH_TAC);; let lo_thm_array = Array.init Arith_hash.arith_base make_lo_thm;; let lo_thm_table = Hashtbl.create Arith_hash.arith_base;; for i = 0 to Arith_hash.arith_base - 1 do Hashtbl.add lo_thm_table Arith_hash.const_array.(i) lo_thm_array.(i); done;; let make_lo_thm2 i = let th_concl = mk_imp (`n <= m:num`, mk_binop `(<=):num->num->bool` (mk_comb (Arith_hash.const_array.(0), n_var_num)) (mk_comb (Arith_hash.const_array.(i), m_var_num))) in (UNDISCH_ALL o prove) (th_concl, REWRITE_TAC[Arith_hash.def_array.(i); Arith_hash.def_array.(0); ARITH_LE] THEN ARITH_TAC);; let lo_thm2_array = Array.init Arith_hash.arith_base make_lo_thm2;; let lo_thm2_table = Hashtbl.create Arith_hash.arith_base;; for i = 0 to Arith_hash.arith_base - 1 do Hashtbl.add lo_thm2_table Arith_hash.const_array.(i) lo_thm2_array.(i); done;; let make_hi_thm i = let th_concl = mk_imp (`n < m:num`, mk_binop `(<):num->num->bool` (mk_comb (Arith_hash.const_array.(i), n_var_num)) (mk_comb (Arith_hash.const_array.(0), m_var_num))) in (UNDISCH_ALL o prove) (th_concl, REWRITE_TAC[Arith_hash.def_array.(i); Arith_hash.def_array.(0); ARITH_LT] THEN ARITH_TAC);; let hi_thm_array = Array.init Arith_hash.arith_base make_hi_thm;; let hi_thm_table = Hashtbl.create Arith_hash.arith_base;; for i = 0 to Arith_hash.arith_base - 1 do Hashtbl.add hi_thm_table Arith_hash.const_array.(i) hi_thm_array.(i); done;; (***************************************) let LE_REFL' = SPEC_ALL LE_REFL;; let LE_TRANS' = (UNDISCH_ALL o SPEC_ALL o REWRITE_RULE[GSYM IMP_IMP]) LE_TRANS;; let lo_num_conv p tm = let n = comb_number tm 0 in if (n <= p) then INST[tm, n_var_num] LE_REFL' else let rec lo_bound n tm = let btm, rtm = dest_comb tm in let th0 = INST[rtm, n_var_num] (Hashtbl.find lo_thm_table btm) in if n > 1 then let rth = lo_bound (n - 1) rtm in let xtm = rand (rator (concl rth)) in let th1' = INST[xtm, n_var_num; rtm, m_var_num] (Hashtbl.find lo_thm2_table btm) in let th1 = MY_PROVE_HYP rth th1' in th1 else th0 in lo_bound (n - p) tm;; let N_LT_SUC = ARITH_RULE `n < SUC n`;; let LT_IMP_LE' = (UNDISCH_ALL o SPEC_ALL) LT_IMP_LE;; let N_LT_SUC = ARITH_RULE `n < SUC n`;; let LT_LE_TRANS = (UNDISCH_ALL o ARITH_RULE) `n < e ==> e <= m ==> n < m:num`;; (* Generates a theorem |- n <= m such that m contains at most p non-zero digits *) let hi_num_conv p tm = let n = comb_number tm 0 in if (n <= p) then INST[tm, n_var_num] LE_REFL' else let k = n - p in let rec check_b0s n tm = let btm, rtm = dest_comb tm in if ((fst o dest_const) btm = b0_name) then if n > 1 then check_b0s (n - 1) rtm else true else false in if (check_b0s k tm) then INST[tm, n_var_num] LE_REFL' else let rec hi_bound n tm = if n > 0 then let btm, rtm = dest_comb tm in let r_th = hi_bound (n - 1) rtm in let xtm = rand (concl r_th) in let th0 = INST[rtm, n_var_num; xtm, m_var_num] (Hashtbl.find hi_thm_table btm) in MY_PROVE_HYP r_th th0 else let th0 = INST[tm, n_var_num] N_LT_SUC in let ltm, suc_tm = dest_comb (concl th0) in let suc_th = raw_suc_conv_hash suc_tm in EQ_MP (AP_TERM ltm suc_th) th0 in let th = hi_bound k tm in let m_tm, l_tm = dest_comb (concl th) in MY_PROVE_HYP th (INST[rand m_tm, m_var_num; l_tm, n_var_num] LT_IMP_LE');; (* Generates a theorem |- n < m such that m contains at most p non-zero digits *) let hi_lt_num_conv p tm = let n = comb_number tm 0 in if (n <= p) then let th0 = INST[tm, n_var_num] N_LT_SUC in let ltm, rtm = dest_comb(concl th0) in let suc_th = raw_suc_conv_hash rtm in EQ_MP (AP_TERM ltm suc_th) th0 else let k = n - p in let rec check_b0s n tm = let btm, rtm = dest_comb tm in if ((fst o dest_const) btm = b0_name) then if n > 1 then check_b0s (n - 1) rtm else true else false in if (check_b0s k tm) then let th0 = INST[tm, n_var_num] N_LT_SUC in let ltm, rtm = dest_comb (concl th0) in let suc_th = raw_suc_conv_hash rtm in let suc_tm = rand(concl suc_th) in let th1 = hi_num_conv p suc_tm in let th2 = EQ_MP (AP_TERM ltm suc_th) th0 in let th = INST[tm, n_var_num; suc_tm, e_var_num; rand(concl th1), m_var_num] LT_LE_TRANS in MY_PROVE_HYP th1 (MY_PROVE_HYP th2 th) else let rec hi_bound n tm = if n > 0 then let btm, rtm = dest_comb tm in let r_th = hi_bound (n - 1) rtm in let xtm = rand (concl r_th) in let th0 = INST[rtm, n_var_num; xtm, m_var_num] (Hashtbl.find hi_thm_table btm) in MY_PROVE_HYP r_th th0 else let th0 = INST[tm, n_var_num] N_LT_SUC in let ltm, suc_tm = dest_comb (concl th0) in let suc_th = raw_suc_conv_hash suc_tm in EQ_MP (AP_TERM ltm suc_th) th0 in hi_bound k tm;; (*****************************************) let num_exp_lo p tm = let ltm, e_tm = dest_comb tm in let n_tm = rand ltm in let n_th = lo_num_conv p n_tm in let m_tm = rand (rator (concl n_th)) in let m_norm, flag = normalize m_tm in let th0' = INST[m_tm, m_var_num; n_tm, n_var_num; e_tm, e_var_num] NUM_EXP_LE' in let th0 = MY_PROVE_HYP n_th th0' in if flag then let th1 = AP_THM (AP_TERM (rator ltm) m_norm) e_tm in let m_tm, me_tm = (dest_comb o rand o concl) m_norm in let th2 = INST[me_tm, e1_var_num; e_tm, e2_var_num; rand m_tm, n_var_num] NUM_EXP_EXP' in let th3 = TRANS th1 th2 in let ltm, rtm = (dest_comb o rand o concl) th3 in let th_add = raw_add_conv_hash rtm in let th4 = TRANS th3 (AP_TERM ltm th_add) in EQ_MP (AP_THM (AP_TERM le_op_num th4) tm) th0 else th0;; let num_exp_hi p tm = let ltm, e_tm = dest_comb tm in let n_tm = rand ltm in let n_th = hi_num_conv p n_tm in let m_tm = rand (concl n_th) in let m_norm, flag = normalize m_tm in let th0' = INST[m_tm, n_var_num; n_tm, m_var_num; e_tm, e_var_num] NUM_EXP_LE' in let th0 = MY_PROVE_HYP n_th th0' in if flag then let th1 = AP_THM (AP_TERM (rator ltm) m_norm) e_tm in let m_tm, me_tm = (dest_comb o rand o concl) m_norm in let th2 = INST[me_tm, e1_var_num; e_tm, e2_var_num; rand m_tm, n_var_num] NUM_EXP_EXP' in let th3 = TRANS th1 th2 in let ltm, rtm = (dest_comb o rand o concl) th3 in let th_add = raw_add_conv_hash rtm in let th4 = TRANS th3 (AP_TERM ltm th_add) in EQ_MP (AP_TERM (rator (concl th0)) th4) th0 else th0;; let num_exp_hi_lt p tm = let ltm, e_tm = dest_comb tm in let n_tm = rand ltm in let n_th = hi_lt_num_conv p n_tm in let m_tm = rand (concl n_th) in let m_norm, flag = normalize m_tm in let th0' = INST[m_tm, n_var_num; n_tm, m_var_num; e_tm, e_var_num] NUM_EXP_LT' in let th0 = MY_PROVE_HYP n_th th0' in if flag then let th1 = AP_THM (AP_TERM (rator ltm) m_norm) e_tm in let m_tm, me_tm = (dest_comb o rand o concl) m_norm in let th2 = INST[me_tm, e1_var_num; e_tm, e2_var_num; rand m_tm, n_var_num] NUM_EXP_EXP' in let th3 = TRANS th1 th2 in let ltm, rtm = (dest_comb o rand o concl) th3 in let th_add = raw_add_conv_hash rtm in let th4 = TRANS th3 (AP_TERM ltm th_add) in EQ_MP (AP_TERM (rator (concl th0)) th4) th0 else th0;; (***************************************) (* num_exp_lt, num_exp_le *) let transform = UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL;; let NUM_EXP_LT1_EQ' = transform NUM_EXP_LT1_EQ and NUM_EXP_LT2_EQ' = transform NUM_EXP_LT2_EQ;; let NUM_EXP_LE1_EQ' = transform NUM_EXP_LE1_EQ and NUM_EXP_LE2_EQ' = transform NUM_EXP_LE2_EQ;; let num_exp_lt tm1 tm2 = let n1_tm, e1_tm = dest_num_exp tm1 in let n2_tm, e2_tm = dest_num_exp tm2 in let sub_th, le_th = raw_sub_and_le_hash_conv e1_tm e2_tm in let r_tm = rand(concl sub_th) in if (rand(concl le_th) = e1_tm) then let x_expr = mk_num_exp n1_tm r_tm in let x_th = denormalize x_expr in let x_tm = rand(concl x_th) in let th0 = INST[e2_tm, e2_var_num; e1_tm, e1_var_num; r_tm, r_var_num; x_tm, x_var_num; n1_tm, n1_var_num; n2_tm, n2_var_num] NUM_EXP_LT1_EQ' in let th1 = MY_PROVE_HYP x_th (MY_PROVE_HYP sub_th (MY_PROVE_HYP le_th th0)) in let lt_th = raw_lt_hash_conv (rand(concl th1)) in TRANS th1 lt_th else let x_expr = mk_num_exp n2_tm r_tm in let x_th = denormalize x_expr in let x_tm = rand(concl x_th) in let th0 = INST[e2_tm, e2_var_num; e1_tm, e1_var_num; r_tm, r_var_num; x_tm, x_var_num; n1_tm, n1_var_num; n2_tm, n2_var_num] NUM_EXP_LT2_EQ' in let th1 = MY_PROVE_HYP x_th (MY_PROVE_HYP sub_th (MY_PROVE_HYP le_th th0)) in let lt_th = raw_lt_hash_conv (rand(concl th1)) in TRANS th1 lt_th;; let num_exp_le tm1 tm2 = let n1_tm, e1_tm = dest_num_exp tm1 in let n2_tm, e2_tm = dest_num_exp tm2 in let sub_th, le_th = raw_sub_and_le_hash_conv e1_tm e2_tm in let r_tm = rand(concl sub_th) in if (rand(concl le_th) = e1_tm) then let x_expr = mk_num_exp n1_tm r_tm in let x_th = denormalize x_expr in let x_tm = rand(concl x_th) in let th0 = INST[e2_tm, e2_var_num; e1_tm, e1_var_num; r_tm, r_var_num; x_tm, x_var_num; n1_tm, n1_var_num; n2_tm, n2_var_num] NUM_EXP_LE1_EQ' in let th1 = MY_PROVE_HYP x_th (MY_PROVE_HYP sub_th (MY_PROVE_HYP le_th th0)) in let le_th = raw_le_hash_conv (rand(concl th1)) in TRANS th1 le_th else let x_expr = mk_num_exp n2_tm r_tm in let x_th = denormalize x_expr in let x_tm = rand(concl x_th) in let th0 = INST[e2_tm, e2_var_num; e1_tm, e1_var_num; r_tm, r_var_num; x_tm, x_var_num; n1_tm, n1_var_num; n2_tm, n2_var_num] NUM_EXP_LE2_EQ' in let th1 = MY_PROVE_HYP x_th (MY_PROVE_HYP sub_th (MY_PROVE_HYP le_th th0)) in let le_th = raw_le_hash_conv (rand(concl th1)) in TRANS th1 le_th;; (***************************************) (* num_exp_mul *) let NUM_EXP_MUL' = SPEC_ALL NUM_EXP_MUL;; let num_exp_mul tm1 tm2 = let n1_tm, e1_tm = dest_comb tm1 in let n1_tm = rand n1_tm in let n2_tm, e2_tm = dest_comb tm2 in let n2_tm = rand n2_tm in let th0 = INST[n1_tm, n1_var_num; e1_tm, e1_var_num; n2_tm, n2_var_num; e2_tm, e2_var_num] NUM_EXP_MUL' in let ltm, tm_add = dest_comb (rand (concl th0)) in let tm_mul = rand ltm in let th_mul = raw_mul_conv_hash tm_mul in let th_add = raw_add_conv_hash tm_add in TRANS th0 (MK_COMB (AP_TERM (rator ltm) th_mul, th_add));; (**********************************) (* num_exp_add *) let NUM_EXP_ADD' = (UNDISCH_ALL o SPEC_ALL) NUM_EXP_ADD;; let ADD_COMM = ARITH_RULE `m + n = n + m:num`;; let num_exp_add tm1 tm2 = let n1_tm, e1_tm = dest_comb tm1 in let n1_tm = rand n1_tm in let n2_tm, e2_tm = dest_comb tm2 in let n2_tm = rand n2_tm in let e_sub, e_le = raw_sub_and_le_hash_conv e1_tm e2_tm in let flag = (rand(concl e_le) = e2_tm) in let th0' = if flag then INST[n1_tm, n1_var_num; e1_tm, e1_var_num; n2_tm, n2_var_num; e2_tm, e2_var_num] NUM_EXP_ADD' else INST[n2_tm, n1_var_num; e2_tm, e1_var_num; n1_tm, n2_var_num; e1_tm, e2_var_num] NUM_EXP_ADD' in let th0 = MY_PROVE_HYP e_le th0' in let ltm, e0_tm = dest_comb(rand(concl th0)) in let exp_tm, add_tm = dest_comb ltm in let ltm, d_tm = dest_comb add_tm in let th1 = AP_TERM (rator d_tm) e_sub in let th2 = denormalize (rand(concl th1)) in let th3 = AP_TERM ltm (TRANS th1 th2) in let th4 = raw_add_conv_hash (rand(concl th3)) in let th5 = AP_THM (AP_TERM exp_tm (TRANS th3 th4)) e0_tm in let th = TRANS th0 th5 in if flag then th else TRANS (INST[tm1, m_var_num; tm2, n_var_num] ADD_COMM) th;; (****************************************) (* num_exp_sub *) let NUM_EXP_SUB1' = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL) NUM_EXP_SUB1 and NUM_EXP_SUB2' = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL) NUM_EXP_SUB2 and NUM_EXP_LE1' = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL) NUM_EXP_LE1 and NUM_EXP_LE2' = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL) NUM_EXP_LE2;; (* Returns two theorems: |- tm1 - tm2 = tm, |- tm2 <= tm1 or |- tm2 - tm1 = tm, |- tm1 <= tm2 *) let num_exp_sub tm1 tm2 = let n1_tm, e1_tm = dest_num_exp tm1 in let n2_tm, e2_tm = dest_num_exp tm2 in let e_sub, e_le = raw_sub_and_le_hash_conv e1_tm e2_tm in if rand(concl e_le) = e1_tm then (* e2 <= e1 *) let e1_sub_e2 = rand(concl e_sub) in let a0 = mk_num_exp n1_tm e1_sub_e2 in let b = n2_tm in let a_th = denormalize a0 in let a = rand(concl a_th) in let th_sub, th_le = raw_sub_and_le_hash_conv a b in if rand(concl th_le) = a then (* b <= a *) let a_sub_b = TRANS (AP_THM (AP_TERM sub_op_num a_th) b) th_sub in let b_le_a = EQ_MP (SYM (AP_TERM (rator(concl th_le)) a_th)) th_le in let th0 = AP_THM (AP_TERM num_exp_const a_sub_b) e2_tm in let inst = INST[n1_tm, n1_var_num; e1_tm, e1_var_num; n2_tm, n2_var_num; e2_tm, e2_var_num; e1_sub_e2, r_var_num] in let th1_sub = inst NUM_EXP_SUB1' in let th1_le = inst NUM_EXP_LE1' in let th2_sub = MY_PROVE_HYP e_sub (MY_PROVE_HYP e_le th1_sub) in let th2_le = MY_PROVE_HYP e_sub (MY_PROVE_HYP b_le_a (MY_PROVE_HYP e_le th1_le)) in TRANS th2_sub th0, th2_le else (* a <= b *) let b_sub_a = TRANS (AP_TERM (rator(lhand(concl th_sub))) a_th) th_sub in let a_le_b = EQ_MP (SYM (AP_THM (AP_TERM le_op_num a_th) b)) th_le in let th0 = AP_THM (AP_TERM num_exp_const b_sub_a) e2_tm in let inst = INST[n2_tm, n1_var_num; e2_tm, e1_var_num; n1_tm, n2_var_num; e1_tm, e2_var_num; e1_sub_e2, r_var_num] in let th1_sub = inst NUM_EXP_SUB2' in let th1_le = inst NUM_EXP_LE2' in let th2_sub = MY_PROVE_HYP e_sub (MY_PROVE_HYP e_le th1_sub) in let th2_le = MY_PROVE_HYP e_sub (MY_PROVE_HYP a_le_b (MY_PROVE_HYP e_le th1_le)) in TRANS th2_sub th0, th2_le else (* e1 <= e2 *) let e2_sub_e1 = rand(concl e_sub) in let b0 = mk_num_exp n2_tm e2_sub_e1 in let a = n1_tm in let b_th = denormalize b0 in let b = rand(concl b_th) in let th_sub, th_le = raw_sub_and_le_hash_conv a b in if rand(concl th_le) = a then (* b <= a *) let a_sub_b = TRANS (AP_TERM (rator(lhand(concl th_sub))) b_th) th_sub in let b_le_a = EQ_MP (SYM (AP_THM (AP_TERM le_op_num b_th) a)) th_le in let th0 = AP_THM (AP_TERM num_exp_const a_sub_b) e1_tm in let inst = INST[n1_tm, n1_var_num; e1_tm, e1_var_num; n2_tm, n2_var_num; e2_tm, e2_var_num; e2_sub_e1, r_var_num] in let th1_sub = inst NUM_EXP_SUB2' in let th1_le = inst NUM_EXP_LE2' in let th2_sub = MY_PROVE_HYP e_sub (MY_PROVE_HYP e_le th1_sub) in let th2_le = MY_PROVE_HYP e_sub (MY_PROVE_HYP b_le_a (MY_PROVE_HYP e_le th1_le)) in TRANS th2_sub th0, th2_le else (* a <= b *) let b_sub_a = TRANS (AP_THM (AP_TERM sub_op_num b_th) a) th_sub in let a_le_b = EQ_MP (SYM (AP_TERM (rator(concl th_le)) b_th)) th_le in let th0 = AP_THM (AP_TERM num_exp_const b_sub_a) e1_tm in let inst = INST[n2_tm, n1_var_num; e2_tm, e1_var_num; n1_tm, n2_var_num; e1_tm, e2_var_num; e2_sub_e1, r_var_num] in let th1_sub = inst NUM_EXP_SUB1' in let th1_le = inst NUM_EXP_LE1' in let th2_sub = MY_PROVE_HYP e_sub (MY_PROVE_HYP e_le th1_sub) in let th2_le = MY_PROVE_HYP e_sub (MY_PROVE_HYP a_le_b (MY_PROVE_HYP e_le th1_le)) in TRANS th2_sub th0, th2_le;; (*************************************) (* division *) let NUM_EXP_DIV1' = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o PURE_ONCE_REWRITE_RULE[ARITH_RULE `~(x = 0) <=> (x = 0 <=> F)`] o REWRITE_RULE[GSYM IMP_IMP]) NUM_EXP_DIV1;; let NUM_EXP_DIV2' = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o PURE_ONCE_REWRITE_RULE[ARITH_RULE `~(x = 0) <=> (x = 0 <=> F)`] o REWRITE_RULE[GSYM IMP_IMP]) NUM_EXP_DIV2;; let num_exp_div tm1 tm2 = let n1_tm, e1_tm = dest_comb tm1 in let n1_tm = rand n1_tm in let n2_tm, e2_tm = dest_comb tm2 in let n2_tm = rand n2_tm in let e_sub, e_le = raw_sub_and_le_hash_conv e1_tm e2_tm in let inst = INST[n1_tm, n1_var_num; e1_tm, e1_var_num; n2_tm, n2_var_num; e2_tm, e2_var_num] in let n2_not_0 = raw_eq0_hash_conv n2_tm in if ((fst o dest_const o rand o concl) n2_not_0 = "T") then failwith "num_exp_div: n2 = 0" else if (rand(concl e_le) = e1_tm) then let th0' = inst NUM_EXP_DIV1' in let th0 = MY_PROVE_HYP n2_not_0 (MY_PROVE_HYP e_le th0') in let ltm, rtm = dest_comb(rand(concl th0)) in let div_tm, rtm2 = dest_comb ltm in let num_exp_tm = rator rtm2 in let th1 = AP_THM (AP_TERM div_tm (AP_TERM num_exp_tm e_sub)) rtm in let ltm, rtm = dest_comb(rand(concl th1)) in let tm1 = rand ltm in let th2 = AP_THM (AP_TERM div_tm (denormalize tm1)) rtm in let th3 = raw_div_hash_conv (rand(concl th2)) in let th = TRANS th0 (TRANS th1 (TRANS th2 th3)) in TRANS th (INST[rand(concl th), n_var_num] NUM_EXP_0') else let th0' = inst NUM_EXP_DIV2' in let th0 = MY_PROVE_HYP n2_not_0 (MY_PROVE_HYP e_le th0') in let ltm, rtm = dest_comb(rand(concl th0)) in let num_exp_tm = rator rtm in let th1 = AP_TERM ltm (AP_TERM num_exp_tm e_sub) in let ltm, rtm = dest_comb(rand(concl th1)) in let th2 = AP_TERM ltm (denormalize rtm) in let th3 = raw_div_hash_conv (rand(concl th2)) in let th = TRANS th0 (TRANS th1 (TRANS th2 th3)) in TRANS th (INST[rand(concl th), n_var_num] NUM_EXP_0');; (*****************************) (* Computes a lower bound for (op tm1 tm2) with p significant digits *) let num_exp_op_lo p op tm1 tm2 = let op_th = op tm1 tm2 in let rtm = rand (concl op_th) in let lo_th = num_exp_lo p rtm in let ltm = rator (concl lo_th) in let th0 = AP_TERM ltm op_th in EQ_MP (SYM th0) lo_th;; (* Computes an upper bound for (op tm1 tm2) with p significant digits *) let num_exp_op_hi p op tm1 tm2 = let op_th = op tm1 tm2 in let rtm = rand (concl op_th) in let hi_th = num_exp_hi p rtm in let tm = rand (concl hi_th) in let th0 = AP_THM (AP_TERM le_op_num op_th) tm in EQ_MP (SYM th0) hi_th;; (* Computes a strict upper bound for (op tm1 tm2) with p significant digits *) let num_exp_op_hi_lt p op tm1 tm2 = let op_th = op tm1 tm2 in let rtm = rand (concl op_th) in let hi_lt_th = num_exp_hi_lt p rtm in let tm = rand (concl hi_lt_th) in let th0 = AP_THM (AP_TERM lt_op_num op_th) tm in EQ_MP (SYM th0) hi_lt_th;; (******************************************) (* float *) let mod_plus = new_definition `mod_plus s1 s2 = (~(s1 /\ s2) /\ (s1 \/ s2))`;; (********************) (* Float operations *) (********************) module Float_ops = struct (**********************************) (* FLOAT_LT *) let FLOAT_LT_FF = prove(`float_num F n1 e1 < float_num F n2 e2 <=> num_exp n1 e1 < num_exp n2 e2`, REWRITE_TAC[float; GSYM REAL_OF_NUM_LT; REAL_MUL_LID; real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN MATCH_MP_TAC REAL_LT_INV THEN REWRITE_TAC[REAL_OF_NUM_LT; LT_NZ; NUM_EXP_EQ_0] THEN ARITH_TAC);; let FLOAT_LT_TT = prove(`float_num T n1 e1 < float_num T n2 e2 <=> num_exp n2 e2 < num_exp n1 e1`, REWRITE_TAC[FLOAT_NEG_T; REAL_ARITH `--a < --b <=> b < a`] THEN REWRITE_TAC[FLOAT_LT_FF]);; let FLOAT_LT_FT = prove(`float_num F n1 e1 < float_num T n2 e2 <=> F`, MP_TAC (SPECL [`n2:num`; `e2:num`] FLOAT_T_NEG) THEN MP_TAC (SPECL [`n1:num`; `e1:num`] FLOAT_F_POS) THEN REAL_ARITH_TAC);; let FLOAT_LT_TF_00 = (PURE_REWRITE_RULE[NUMERAL] o prove) (`float_num T 0 e1 < float_num F 0 e2 <=> F`, MP_TAC (SPECL [`T`; `0`; `e1:num`] FLOAT_EQ_0) THEN MP_TAC (SPECL [`F`; `0`; `e2:num`] FLOAT_EQ_0) THEN REWRITE_TAC[] THEN REPLICATE_TAC 2 (DISCH_THEN (fun th -> REWRITE_TAC[th])) THEN REAL_ARITH_TAC);; let FLOAT_LT_TF_1 = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o prove) (`(n1 = 0 <=> F) ==> (float_num T n1 e1 < float_num F n2 e2 <=> T)`, DISCH_TAC THEN MATCH_MP_TAC (REAL_ARITH `a < &0 /\ &0 <= b ==> (a < b <=> T)`) THEN REWRITE_TAC[FLOAT_F_POS] THEN MATCH_MP_TAC (REAL_ARITH `~(a = &0) /\ a <= &0 ==> a < &0`) THEN ASM_REWRITE_TAC[FLOAT_T_NEG; FLOAT_EQ_0]);; let FLOAT_LT_TF_2 = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o prove) (`(n2 = 0 <=> F) ==> (float_num T n1 e1 < float_num F n2 e2 <=> T)`, DISCH_TAC THEN MATCH_MP_TAC (REAL_ARITH `a <= &0 /\ &0 < b ==> (a < b <=> T)`) THEN REWRITE_TAC[FLOAT_T_NEG] THEN MATCH_MP_TAC (REAL_ARITH `~(a = &0) /\ &0 <= a ==> &0 < a`) THEN ASM_REWRITE_TAC[FLOAT_F_POS; FLOAT_EQ_0]);; let FLOAT_F_LT_0 = prove(`float_num F n e < &0 <=> F`, MP_TAC (SPEC_ALL FLOAT_F_POS) THEN REAL_ARITH_TAC);; let FLOAT_T_LT_0 = (CONV_RULE (RAND_CONV (REWRITE_CONV[NUMERAL])) o prove) (`float_num T n e < &0 <=> (0 < n)`, REWRITE_TAC[REAL_ARITH `a < &0 <=> a <= &0 /\ ~(a = &0)`] THEN REWRITE_TAC[FLOAT_T_NEG; FLOAT_EQ_0] THEN ARITH_TAC);; let FLOAT_F_GT_0 = (CONV_RULE (RAND_CONV (REWRITE_CONV[NUMERAL])) o prove) (`&0 < float_num F n e <=> 0 < n`, REWRITE_TAC[REAL_ARITH `&0 < a <=> &0 <= a /\ ~(a = &0)`] THEN REWRITE_TAC[FLOAT_F_POS; FLOAT_EQ_0] THEN ARITH_TAC);; let FLOAT_T_GT_0 = prove(`&0 < float_num T n e <=> F`, MP_TAC (SPEC_ALL FLOAT_T_NEG) THEN REAL_ARITH_TAC);; (* float_lt0, float_gt0 *) let float_lt0 f1 = let s, n_tm, e_tm = dest_float f1 in let inst = INST[n_tm, n_var_num; e_tm, e_var_num] in if s = "F" then inst FLOAT_F_LT_0 else let gt_th = raw_gt0_hash_conv n_tm in TRANS (inst FLOAT_T_LT_0) gt_th;; let float_gt0 f1 = let s, n_tm, e_tm = dest_float f1 in let inst = INST[n_tm, n_var_num; e_tm, e_var_num] in if s = "F" then let gt_th = raw_gt0_hash_conv n_tm in TRANS (inst FLOAT_F_GT_0) gt_th else inst FLOAT_T_GT_0;; (* float_lt *) let float_lt f1 f2 = let s1, n1, e1 = dest_float f1 in let s2, n2, e2 = dest_float f2 in let inst = INST[n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] in if s1 = "F" then if s2 = "F" then (* FF *) let th0 = inst FLOAT_LT_FF in let ltm, tm2 = dest_comb (rand (concl th0)) in let lt_th = num_exp_lt (rand ltm) tm2 in TRANS th0 lt_th else (* FT *) inst FLOAT_LT_FT else if s2 = "F" then (* TF *) if (is_const n1 && is_const n2) then (* n1 = _0 and n2 = _0 *) inst FLOAT_LT_TF_00 else let n1_0 = raw_eq0_hash_conv n1 in if (fst o dest_const o rand o concl) n1_0 = "F" then (* n1 <> _0 *) MY_PROVE_HYP n1_0 (inst FLOAT_LT_TF_1) else let n2_0 = raw_eq0_hash_conv n2 in if (fst o dest_const o rand o concl) n2_0 = "F" then (* n2 <> _0 *) MY_PROVE_HYP n2_0 (inst FLOAT_LT_TF_2) else failwith "float_lt: D0 _0 exception" else (* TT *) let th0 = inst FLOAT_LT_TT in let ltm, tm2 = dest_comb (rand (concl th0)) in let lt_th = num_exp_lt (rand ltm) tm2 in TRANS th0 lt_th;; (**********************************) (* FLOAT_LE *) let FLOAT_LE_FF = prove(`float_num F n1 e1 <= float_num F n2 e2 <=> num_exp n1 e1 <= num_exp n2 e2`, REWRITE_TAC[float; GSYM REAL_OF_NUM_LE; REAL_MUL_LID; real_div] THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN MATCH_MP_TAC REAL_LT_INV THEN REWRITE_TAC[REAL_OF_NUM_LT; LT_NZ; NUM_EXP_EQ_0] THEN ARITH_TAC);; let FLOAT_LE_TT = prove(`float_num T n1 e1 <= float_num T n2 e2 <=> num_exp n2 e2 <= num_exp n1 e1`, REWRITE_TAC[FLOAT_NEG_T; REAL_ARITH `--a <= --b <=> b <= a`] THEN REWRITE_TAC[FLOAT_LE_FF]);; let FLOAT_LE_TF = prove(`float_num T n1 e1 <= float_num F n2 e2 <=> T`, MP_TAC (SPECL [`n1:num`; `e1:num`] FLOAT_T_NEG) THEN MP_TAC (SPECL [`n2:num`; `e2:num`] FLOAT_F_POS) THEN REAL_ARITH_TAC);; let FLOAT_LE_FT = prove(`float_num F n1 e1 <= float_num T n2 e2 <=> n1 = 0 /\ n2 = 0`, REWRITE_TAC[REAL_LE_LT; FLOAT_LT_FT] THEN EQ_TAC THENL [ DISCH_TAC THEN SUBGOAL_THEN `float_num F n1 e1 = &0 /\ float_num T n2 e2 = &0` MP_TAC THENL [ MP_TAC (SPECL [`n2:num`; `e2:num`] FLOAT_T_NEG) THEN MP_TAC (SPECL [`n1:num`; `e1:num`] FLOAT_F_POS) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLOAT_EQ_0]; DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[float; NUM_EXP_n0; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO] ]);; let FLOAT_LE_FT_00 = (PURE_REWRITE_RULE[NUMERAL] o prove) (`float_num F 0 e1 <= float_num T 0 e2 <=> T`, REWRITE_TAC[FLOAT_LE_FT]);; let FLOAT_LE_FT_1 = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o prove) (`(n1 = 0 <=> F) ==> (float_num F n1 e1 <= float_num T n2 e2 <=> F)`, DISCH_TAC THEN ASM_REWRITE_TAC[FLOAT_LE_FT]);; let FLOAT_LE_FT_2 = (UNDISCH_ALL o PURE_REWRITE_RULE[NUMERAL] o prove) (`(n2 = 0 <=> F) ==> (float_num F n1 e1 <= float_num T n2 e2 <=> F)`, DISCH_TAC THEN ASM_REWRITE_TAC[FLOAT_LE_FT]);; let FLOAT_F_LE_0 = (CONV_RULE (RAND_CONV (REWRITE_CONV[NUMERAL])) o prove) (`float_num F n e <= &0 <=> n = 0`, REWRITE_TAC[GSYM (SPEC `F` FLOAT_EQ_0)] THEN MP_TAC (SPEC_ALL FLOAT_F_POS) THEN REAL_ARITH_TAC);; let FLOAT_T_LE_0 = prove(`float_num T n e <= &0 <=> T`, REWRITE_TAC[FLOAT_T_NEG]);; let FLOAT_F_GE_0 = prove(`&0 <= float_num F n e <=> T`, REWRITE_TAC[FLOAT_F_POS]);; let FLOAT_T_GE_0 = (CONV_RULE (RAND_CONV (REWRITE_CONV[NUMERAL])) o prove) (`&0 <= float_num T n e <=> n = 0`, REWRITE_TAC[GSYM (SPEC `T` FLOAT_EQ_0)] THEN MP_TAC (SPEC_ALL FLOAT_T_NEG) THEN REAL_ARITH_TAC);; (* float_le0, float_ge0 *) let float_le0 f1 = let s, n_tm, e_tm = dest_float f1 in let inst = INST[n_tm, n_var_num; e_tm, e_var_num] in if s = "T" then inst FLOAT_T_LE_0 else let eq_th = raw_eq0_hash_conv n_tm in TRANS (inst FLOAT_F_LE_0) eq_th;; let float_ge0 f1 = let s, n_tm, e_tm = dest_float f1 in let inst = INST[n_tm, n_var_num; e_tm, e_var_num] in if s = "T" then let eq_th = raw_eq0_hash_conv n_tm in TRANS (inst FLOAT_T_GE_0) eq_th else inst FLOAT_F_GE_0;; (* float_le *) let float_le f1 f2 = let s1, n1, e1 = dest_float f1 in let s2, n2, e2 = dest_float f2 in let inst = INST[n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] in if s2 = "F" then if s1 = "F" then (* FF *) let th0 = inst FLOAT_LE_FF in let ltm, tm2 = dest_comb (rand (concl th0)) in let le_th = num_exp_le (rand ltm) tm2 in TRANS th0 le_th else (* TF *) inst FLOAT_LE_TF else if s1 = "F" then (* FT *) if (is_const n1 && is_const n2) then (* n1 = _0 and n2 = _0 *) inst FLOAT_LE_FT_00 else let n1_0 = raw_eq0_hash_conv n1 in if (fst o dest_const o rand o concl) n1_0 = "F" then (* n1 <> _0 *) MY_PROVE_HYP n1_0 (inst FLOAT_LE_FT_1) else let n2_0 = raw_eq0_hash_conv n2 in if (fst o dest_const o rand o concl) n2_0 = "F" then (* n2 <> _0 *) MY_PROVE_HYP n2_0 (inst FLOAT_LE_FT_2) else failwith "float_lt: D0 _0 exception" else (* TT *) let th0 = inst FLOAT_LE_TT in let ltm, tm2 = dest_comb (rand (concl th0)) in let le_th = num_exp_le (rand ltm) tm2 in TRANS th0 le_th;; (*************************************) (* float_max, float_min *) let FLOAT_MIN_1 = (UNDISCH_ALL o prove)(`(f1 <= f2 <=> T) ==> min f1 f2 = f1`, REAL_ARITH_TAC);; let FLOAT_MIN_2 = (UNDISCH_ALL o prove)(`(f1 <= f2 <=> F) ==> min f1 f2 = f2`, REAL_ARITH_TAC);; let FLOAT_MAX_1 = (UNDISCH_ALL o prove)(`(f1 <= f2 <=> T) ==> max f1 f2 = f2`, REAL_ARITH_TAC);; let FLOAT_MAX_2 = (UNDISCH_ALL o prove)(`(f1 <= f2 <=> F) ==> max f1 f2 = f1`, REAL_ARITH_TAC);; let float_min f1 f2 = let inst = INST[f1, f1_var_real; f2, f2_var_real] in let le_th = float_le f1 f2 in let th0 = if (fst o dest_const o rand o concl) le_th = "T" then inst FLOAT_MIN_1 else inst FLOAT_MIN_2 in MY_PROVE_HYP le_th th0;; let float_max f1 f2 = let inst = INST[f1, f1_var_real; f2, f2_var_real] in let le_th = float_le f1 f2 in let th0 = if (fst o dest_const o rand o concl) le_th = "T" then inst FLOAT_MAX_1 else inst FLOAT_MAX_2 in MY_PROVE_HYP le_th th0;; let float_min_max f1 f2 = let inst = INST[f1, f1_var_real; f2, f2_var_real] in let le_th = float_le f1 f2 in let th_min, th_max = if (fst o dest_const o rand o concl) le_th = "T" then inst FLOAT_MIN_1, inst FLOAT_MAX_1 else inst FLOAT_MIN_2, inst FLOAT_MAX_2 in MY_PROVE_HYP le_th th_min, MY_PROVE_HYP le_th th_max;; (*************************************) (* FLOAT_MUL *) let FLOAT_MUL = prove(`!s1 s2. min_exp <= e /\ num_exp n1 e1 * num_exp n2 e2 = num_exp n e ==> float_num s1 n1 e1 * float_num s2 n2 e2 = float_num (mod_plus s1 s2) n (e - min_exp)`, REPEAT STRIP_TAC THEN REWRITE_TAC[float] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b / c) * (d * e / f) = (a * d) * (b * e) / c / f`] THEN SUBGOAL_THEN `(if s1 then -- &1 else &1) * (if s2 then -- &1 else &1) = if mod_plus s1 s2 then -- &1 else &1` MP_TAC THENL [ REWRITE_TAC[mod_plus] THEN COND_CASES_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_ARITH `-- &1 * -- &1 = &1`; REAL_MUL_LID; REAL_MUL_RID]; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN DISJ2_TAC THEN MP_TAC (SPECL[`n:num`; `e:num`; `min_exp`] NUM_EXP_SUB_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL]);; let FLOAT_MUL_FF = prove(`min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 = num_exp n e ==> float_num F n1 e1 * float_num F n2 e2 = float_num F n r`, SIMP_TAC[FLOAT_MUL; mod_plus]);; let FLOAT_MUL_FT = prove(`min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 = num_exp n e ==> float_num F n1 e1 * float_num T n2 e2 = float_num T n r`, SIMP_TAC[FLOAT_MUL; mod_plus]);; let FLOAT_MUL_TF = prove(`min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 = num_exp n e ==> float_num T n1 e1 * float_num F n2 e2 = float_num T n r`, SIMP_TAC[FLOAT_MUL; mod_plus]);; let FLOAT_MUL_TT = prove(`min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 = num_exp n e ==> float_num T n1 e1 * float_num T n2 e2 = float_num F n r`, SIMP_TAC[FLOAT_MUL; mod_plus]);; let FLOAT_MUL_0x_hi, FLOAT_MUL_0x_lo, FLOAT_MUL_x0_hi, FLOAT_MUL_x0_lo = let mul_0x_hi = `(n1 = 0 <=> T) ==> float_num s1 n1 e1 * f2 <= float_num F 0 min_exp` in let mul_0x_lo = `(n1 = 0 <=> T) ==> float_num F 0 min_exp <= float_num s1 n1 e1 * f2` in let mul_x0_hi = `(n2 = 0 <=> T) ==> f1 * float_num s2 n2 e2 <= float_num F 0 min_exp` in let mul_x0_lo = `(n2 = 0 <=> T) ==> float_num F 0 min_exp <= f1 * float_num s2 n2 e2` in let proof = MP_TAC (GEN_ALL (SPECL [`s:bool`; `0`] FLOAT_EQ_0)) THEN SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_REFL] in prove(mul_0x_hi, proof), prove(mul_0x_lo, proof), prove(mul_x0_hi, proof), prove(mul_x0_lo, proof);; let FLOAT_MUL_FF_hi, FLOAT_MUL_FF_lo = let ff_hi = `min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 <= num_exp n e ==> float_num F n1 e1 * float_num F n2 e2 <= float_num F n r` in let ff_lo = `min_exp <= e /\ e - min_exp = r /\ num_exp n e <= num_exp n1 e1 * num_exp n2 e2 ==> float_num F n r <= float_num F n1 e1 * float_num F n2 e2` in let proof = REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN DISCH_TAC THEN MAP_EVERY ABBREV_TAC [`z = &(num_exp n e)`; `x = &(num_exp n1 e1)`; `y = &(num_exp n2 e2)`] THEN ASM_REWRITE_TAC[float; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `a / b * c / d = (a * c) / b / d`] THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MP_TAC (SPECL [`n:num`; `e:num`; `min_exp`] NUM_EXP_SUB_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] in prove(ff_hi, proof), prove(ff_lo, proof);; let FLOAT_MUL_TT_hi, FLOAT_MUL_TT_lo = let tt_hi = `min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 <= num_exp n e ==> float_num T n1 e1 * float_num T n2 e2 <= float_num F n r` in let tt_lo = `min_exp <= e /\ e - min_exp = r /\ num_exp n e <= num_exp n1 e1 * num_exp n2 e2 ==> float_num F n r <= float_num T n1 e1 * float_num T n2 e2` in let proof = REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[REAL_ARITH `--a * --b = a * b`] THEN REWRITE_TAC[FLOAT_MUL_FF_hi; FLOAT_MUL_FF_lo] in prove(tt_hi, proof), prove(tt_lo, proof);; let FLOAT_MUL_FT_hi, FLOAT_MUL_FT_lo = let ft_hi = `min_exp <= e /\ e - min_exp = r /\ num_exp n e <= num_exp n1 e1 * num_exp n2 e2 ==> float_num F n1 e1 * float_num T n2 e2 <= float_num T n r` in let ft_lo = `min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 <= num_exp n e ==> float_num T n r <= float_num F n1 e1 * float_num T n2 e2` in let proof = REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[REAL_ARITH `a * --b <= --c <=> c <= a * b`] THEN REWRITE_TAC[REAL_ARITH `--c <= a * --b <=> a * b <= c`] THEN REWRITE_TAC[FLOAT_MUL_FF_hi; FLOAT_MUL_FF_lo] in prove(ft_hi, proof), prove(ft_lo, proof);; let FLOAT_MUL_TF_hi, FLOAT_MUL_TF_lo = let ft_hi = `min_exp <= e /\ e - min_exp = r /\ num_exp n e <= num_exp n1 e1 * num_exp n2 e2 ==> float_num T n1 e1 * float_num F n2 e2 <= float_num T n r` in let ft_lo = `min_exp <= e /\ e - min_exp = r /\ num_exp n1 e1 * num_exp n2 e2 <= num_exp n e ==> float_num T n r <= float_num T n1 e1 * float_num F n2 e2` in let proof = REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[REAL_ARITH `--a * b <= --c <=> c <= a * b`] THEN REWRITE_TAC[REAL_ARITH `--c <= --a * b <=> a * b <= c`] THEN REWRITE_TAC[FLOAT_MUL_FF_hi; FLOAT_MUL_FF_lo] in prove(ft_hi, proof), prove(ft_lo, proof);; (*********************************************) (* float_mul_lo, float_mul_hi *) let transform = UNDISCH_ALL o NUMERALS_TO_NUM o PURE_REWRITE_RULE[min_exp_def; GSYM IMP_IMP];; let FLOAT_MUL_FF_hi' = transform FLOAT_MUL_FF_hi and FLOAT_MUL_FF_lo' = transform FLOAT_MUL_FF_lo and FLOAT_MUL_TT_hi' = transform FLOAT_MUL_TT_hi and FLOAT_MUL_TT_lo' = transform FLOAT_MUL_TT_lo and FLOAT_MUL_FT_hi' = transform FLOAT_MUL_FT_hi and FLOAT_MUL_FT_lo' = transform FLOAT_MUL_FT_lo and FLOAT_MUL_TF_hi' = transform FLOAT_MUL_TF_hi and FLOAT_MUL_TF_lo' = transform FLOAT_MUL_TF_lo and FLOAT_MUL_0x_hi' = transform FLOAT_MUL_0x_hi and FLOAT_MUL_0x_lo' = transform FLOAT_MUL_0x_lo and FLOAT_MUL_x0_hi' = transform FLOAT_MUL_x0_hi and FLOAT_MUL_x0_lo' = transform FLOAT_MUL_x0_lo;; let FLOAT_MUL_FF' = transform FLOAT_MUL_FF and FLOAT_MUL_TT' = transform FLOAT_MUL_TT and FLOAT_MUL_FT' = transform FLOAT_MUL_FT and FLOAT_MUL_TF' = transform FLOAT_MUL_TF;; let float_mul_eq f1 f2 = let s1, n1, e1 = dest_float f1 and s2, n2, e2 = dest_float f2 in let flag = s1 = s2 in let num_exp1 = mk_num_exp n1 e1 and num_exp2 = mk_num_exp n2 e2 in let mul_th = num_exp_mul num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (rand (concl mul_th)) in let sub_th, le_th = raw_sub_and_le_hash_conv e_tm min_exp_num_const in if (rand(concl le_th) <> e_tm) then failwith "float_mul_eq: underflow" else let r_tm = rand(concl sub_th) in let inst = INST[e_tm, e_var_num; r_tm, r_var_num; n_tm, n_var_num; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] in let th0 = inst (if flag then if s1 = "F" then FLOAT_MUL_FF' else FLOAT_MUL_TT' else if s1 = "F" then FLOAT_MUL_FT' else FLOAT_MUL_TF') in MY_PROVE_HYP sub_th (MY_PROVE_HYP mul_th (MY_PROVE_HYP le_th th0));; let float_mul_lo pp f1 f2 = let s1, n1, e1 = dest_float f1 and s2, n2, e2 = dest_float f2 in (* Multiplication by zero *) let n1_eq0_th = raw_eq0_hash_conv n1 in if (rand o concl) n1_eq0_th = t_const then (MY_PROVE_HYP n1_eq0_th o INST[e1, e1_var_num; f2, f2_var_real; n1, n1_var_num; (if s1 = "T" then t_const else f_const), s1_var_bool]) FLOAT_MUL_0x_lo' else let n2_eq0_th = raw_eq0_hash_conv n2 in if (rand o concl) n2_eq0_th = t_const then (MY_PROVE_HYP n2_eq0_th o INST[e2, e2_var_num; f1, f1_var_real; n2, n2_var_num; (if s2 = "T" then t_const else f_const), s2_var_bool]) FLOAT_MUL_x0_lo' else let flag = s1 = s2 in let num_exp1 = mk_num_exp n1 e1 and num_exp2 = mk_num_exp n2 e2 in let mul_th, n_tm, e_tm = if flag then let th = num_exp_op_lo pp num_exp_mul num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (lhand (concl th)) in th, n_tm, e_tm else let th = num_exp_op_hi pp num_exp_mul num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (rand (concl th)) in th, n_tm, e_tm in let sub_th, le_th = raw_sub_and_le_hash_conv e_tm min_exp_num_const in if (rand(concl le_th) <> e_tm) then failwith "float_mul_lo: underflow" else let r_tm = rand(concl sub_th) in let inst = INST[e_tm, e_var_num; r_tm, r_var_num; n_tm, n_var_num; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] in let th0 = inst (if flag then if s1 = "F" then FLOAT_MUL_FF_lo' else FLOAT_MUL_TT_lo' else if s1 = "F" then FLOAT_MUL_FT_lo' else FLOAT_MUL_TF_lo') in MY_PROVE_HYP sub_th (MY_PROVE_HYP mul_th (MY_PROVE_HYP le_th th0));; let float_mul_hi pp f1 f2 = let s1, n1, e1 = dest_float f1 and s2, n2, e2 = dest_float f2 in (* Multiplication by zero *) let n1_eq0_th = raw_eq0_hash_conv n1 in if (rand o concl) n1_eq0_th = t_const then (MY_PROVE_HYP n1_eq0_th o INST[e1, e1_var_num; f2, f2_var_real; n1, n1_var_num; (if s1 = "T" then t_const else f_const), s1_var_bool]) FLOAT_MUL_0x_hi' else let n2_eq0_th = raw_eq0_hash_conv n2 in if (rand o concl) n2_eq0_th = t_const then (MY_PROVE_HYP n2_eq0_th o INST[e2, e2_var_num; f1, f1_var_real; n2, n2_var_num; (if s2 = "T" then t_const else f_const), s2_var_bool]) FLOAT_MUL_x0_hi' else let flag = s1 = s2 in let num_exp1 = mk_num_exp n1 e1 and num_exp2 = mk_num_exp n2 e2 in let mul_th, n_tm, e_tm = if flag then let th = num_exp_op_hi pp num_exp_mul num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (rand (concl th)) in th, n_tm, e_tm else let th = num_exp_op_lo pp num_exp_mul num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (lhand (concl th)) in th, n_tm, e_tm in let sub_th, le_th = raw_sub_and_le_hash_conv e_tm min_exp_num_const in if (rand(concl le_th) <> e_tm) then failwith "float_mul_hi: underflow" else let r_tm = rand(concl sub_th) in let inst = INST[e_tm, e_var_num; r_tm, r_var_num; n_tm, n_var_num; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] in let th0 = inst (if flag then if s1 = "F" then FLOAT_MUL_FF_hi' else FLOAT_MUL_TT_hi' else if s1 = "F" then FLOAT_MUL_FT_hi' else FLOAT_MUL_TF_hi') in MY_PROVE_HYP sub_th (MY_PROVE_HYP mul_th (MY_PROVE_HYP le_th th0));; (*********************************************) (* FLOAT_DIV *) let DIV_lemma = prove(`!x y. ~(y = 0) ==> &(x DIV y) <= &x / &y /\ &x / &y <= &(x DIV y + 1)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC (SPECL [`y:num`; `x:num`] FLOOR_DIV_DIV) THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN SIMP_TAC[FLOOR; REAL_LT_IMP_LE]);; let FLOAT_DIV_FF = prove(`e2 + k <= min_exp + e + e1 /\ ~(n2 = 0) /\ num_exp n1 k DIV num_exp n2 0 = num_exp n e ==> float_num F n ((min_exp + e + e1) - (e2 + k)) <= float_num F n1 e1 / float_num F n2 e2`, MAP_EVERY ABBREV_TAC [`z = num_exp n e`; `x = num_exp n1 k`; `y = num_exp n2 0`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[float; REAL_MUL_LID] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_ARITH `(a * b) * c * d = (b * d) * (a * c)`] THEN SUBGOAL_THEN `~(&(num_exp 1 min_exp) = &0)` ASSUME_TAC THENL [ REWRITE_TAC[num_exp; REAL_OF_NUM_EQ; MULT_CLAUSES; EXP_EQ_0] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN ASM_SIMP_TAC[NUM_EXP_SUB_lemma] THEN SUBGOAL_THEN `&(num_exp n1 e1) * inv(&(num_exp n2 e2)) = (&x / &y) * &(num_exp 1 e1) * inv(&(num_exp 1 (e2 + k)))` MP_TAC THENL [ EXPAND_TAC "x" THEN EXPAND_TAC "y" THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[num_exp; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_MUL_LID; REAL_INV_MUL; REAL_INV_1; real_pow; REAL_MUL_RID] THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `((a * b) * c) * d * e * f = (b * f) * (a * c * d * e)`] THEN SUBGOAL_THEN (mk_comb(`(~)`, mk_eq(mk_binop `pow` (mk_comb (`&`, base_const)) `k:num`, `&0`))) ASSUME_TAC THENL [ REWRITE_TAC[REAL_POW_EQ_0] THEN REAL_ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN REAL_ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c = (a * c) * b`] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN ONCE_REWRITE_TAC[NUM_EXP_SUM1] THEN REWRITE_TAC[NUM_EXP_SUM] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN ASM_REWRITE_TAC[REAL_ARITH `(a * b * c) * d = (d * a) * b * c`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MP_TAC (SPEC_ALL DIV_lemma) THEN ANTS_TAC THENL [ EXPAND_TAC "y" THEN REWRITE_TAC[num_exp; MULT_EQ_0; DE_MORGAN_THM] THEN ASM_REWRITE_TAC[EXP] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[]);; let FLOAT_DIV_0x_lo = prove(`(n1 = 0 <=> T) ==> float_num F 0 min_exp <= float_num s1 n1 e1 / f2`, SIMP_TAC[real_div; FLOAT_MUL_0x_lo]);; let FLOAT_DIV_0x_hi = prove(`(n1 = 0 <=> T) ==> float_num s1 n1 e1 / f2 <= float_num F 0 min_exp`, SIMP_TAC[real_div; FLOAT_MUL_0x_hi]);; let FLOAT_DIV_FF_lo = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n e <= num_exp n1 k DIV num_exp n2 0 ==> float_num F n r <= float_num F n1 e1 / float_num F n2 e2`, MAP_EVERY ABBREV_TAC [`z = num_exp n e`; `x = num_exp n1 k`; `y = num_exp n2 0`] THEN REPEAT STRIP_TAC THEN REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[float; REAL_MUL_LID] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_ARITH `(a * b) * c * d = (b * d) * (a * c)`] THEN SUBGOAL_THEN `~(&(num_exp 1 min_exp) = &0)` ASSUME_TAC THENL [ REWRITE_TAC[num_exp; REAL_OF_NUM_EQ; MULT_CLAUSES; EXP_EQ_0] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN ASM_SIMP_TAC[NUM_EXP_SUB_lemma] THEN SUBGOAL_THEN `&(num_exp n1 e1) * inv(&(num_exp n2 e2)) = (&x / &y) * &(num_exp 1 e1) * inv(&(num_exp 1 (e2 + k)))` MP_TAC THENL [ EXPAND_TAC "x" THEN EXPAND_TAC "y" THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[num_exp; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_MUL_LID; REAL_INV_MUL; REAL_INV_1; real_pow; REAL_MUL_RID] THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `((a * b) * c) * d * e * f = (b * f) * (a * c * d * e)`] THEN SUBGOAL_THEN (mk_comb(`(~)`, mk_eq(mk_binop `pow` (mk_comb (`&`, base_const)) `k:num`, `&0`))) ASSUME_TAC THENL [ REWRITE_TAC[REAL_POW_EQ_0] THEN REAL_ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN REAL_ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c = (a * c) * b`] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN ONCE_REWRITE_TAC[NUM_EXP_SUM1] THEN REWRITE_TAC[NUM_EXP_SUM] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN ASM_REWRITE_TAC[REAL_ARITH `(a * b * c) * d = (d * a) * b * c`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MP_TAC (SPEC_ALL DIV_lemma) THEN ANTS_TAC THENL [ EXPAND_TAC "y" THEN REWRITE_TAC[num_exp; MULT_EQ_0; DE_MORGAN_THM] THEN ASM_REWRITE_TAC[EXP] THEN ARITH_TAC; ALL_TAC ] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(x DIV y)` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE]);; let FLOAT_DIV_FF_hi = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n1 k DIV num_exp n2 0 < num_exp n e ==> float_num F n1 e1 / float_num F n2 e2 <= float_num F n r`, MAP_EVERY ABBREV_TAC [`z = num_exp n e`; `x = num_exp n1 k`; `y = num_exp n2 0`] THEN REPEAT STRIP_TAC THEN REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[float; REAL_MUL_LID] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_ARITH `(a * b) * c * d = (b * d) * (a * c)`] THEN SUBGOAL_THEN `~(&(num_exp 1 min_exp) = &0)` ASSUME_TAC THENL [ REWRITE_TAC[num_exp; REAL_OF_NUM_EQ; MULT_CLAUSES; EXP_EQ_0] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN ASM_SIMP_TAC[NUM_EXP_SUB_lemma] THEN SUBGOAL_THEN `&(num_exp n1 e1) * inv(&(num_exp n2 e2)) = (&x / &y) * &(num_exp 1 e1) * inv(&(num_exp 1 (e2 + k)))` MP_TAC THENL [ EXPAND_TAC "x" THEN EXPAND_TAC "y" THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[num_exp; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_MUL_LID; REAL_INV_MUL; REAL_INV_1; real_pow; REAL_MUL_RID] THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `((a * b) * c) * d * e * f = (b * f) * (a * c * d * e)`] THEN SUBGOAL_THEN (mk_comb(`(~)`, mk_eq(mk_binop `pow` (mk_comb (`&`, base_const)) `k:num`, `&0`))) ASSUME_TAC THENL [ REWRITE_TAC[REAL_POW_EQ_0] THEN REAL_ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN REAL_ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c = (a * c) * b`] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN ONCE_REWRITE_TAC[NUM_EXP_SUM1] THEN REWRITE_TAC[NUM_EXP_SUM] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN ASM_REWRITE_TAC[REAL_ARITH `(a * b * c) * d = (d * a) * b * c`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN MP_TAC (SPEC_ALL DIV_lemma) THEN ANTS_TAC THENL [ EXPAND_TAC "y" THEN REWRITE_TAC[num_exp; MULT_EQ_0; DE_MORGAN_THM] THEN ASM_REWRITE_TAC[EXP] THEN ARITH_TAC; ALL_TAC ] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(x DIV y + 1)` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `x DIV y < z` THEN ARITH_TAC);; let FLOAT_DIV_TT_lo = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n e <= num_exp n1 k DIV num_exp n2 0 ==> float_num F n r <= float_num T n1 e1 / float_num T n2 e2`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_NEG_MUL2] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[FLOAT_DIV_FF_lo]);; let FLOAT_DIV_TT_hi = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n1 k DIV num_exp n2 0 < num_exp n e ==> float_num T n1 e1 / float_num T n2 e2 <= float_num F n r`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_NEG_MUL2] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[FLOAT_DIV_FF_hi]);; let FLOAT_DIV_FT_lo = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n1 k DIV num_exp n2 0 < num_exp n e ==> float_num T n r <= float_num F n1 e1 / float_num T n2 e2`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REWRITE_TAC[REAL_ARITH `--a <= b * --c <=> b * c <= a`] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[FLOAT_DIV_FF_hi]);; let FLOAT_DIV_FT_hi = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n e <= num_exp n1 k DIV num_exp n2 0 ==> float_num F n1 e1 / float_num T n2 e2 <= float_num T n r`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REWRITE_TAC[REAL_ARITH `a * --b <= --c <=> c <= a * b`] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[FLOAT_DIV_FF_lo]);; let FLOAT_DIV_TF_lo = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n1 k DIV num_exp n2 0 < num_exp n e ==> float_num T n r <= float_num T n1 e1 / float_num F n2 e2`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REWRITE_TAC[REAL_ARITH `--a <= --b * c <=> b * c <= a`] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[FLOAT_DIV_FF_hi]);; let FLOAT_DIV_TF_hi = prove(`e2 + k = r1 /\ min_exp + e + e1 = r2 /\ r2 - r1 = r /\ r1 <= r2 /\ ~(n2 = 0) /\ num_exp n e <= num_exp n1 k DIV num_exp n2 0 ==> float_num T n1 e1 / float_num F n2 e2 <= float_num T n r`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REWRITE_TAC[REAL_ARITH `--a * b <= --c <=> c <= a * b`] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[FLOAT_DIV_FF_lo]);; (******************************************) (* float_div_lo, float_div_hi *) let transform = UNDISCH_ALL o PURE_REWRITE_RULE[TAUT `~P <=> (P <=> F)`] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[GSYM IMP_IMP; min_exp_def];; let FLOAT_DIV_FF_hi' = transform FLOAT_DIV_FF_hi and FLOAT_DIV_FF_lo' = transform FLOAT_DIV_FF_lo and FLOAT_DIV_TT_hi' = transform FLOAT_DIV_TT_hi and FLOAT_DIV_TT_lo' = transform FLOAT_DIV_TT_lo and FLOAT_DIV_FT_hi' = transform FLOAT_DIV_FT_hi and FLOAT_DIV_FT_lo' = transform FLOAT_DIV_FT_lo and FLOAT_DIV_TF_hi' = transform FLOAT_DIV_TF_hi and FLOAT_DIV_TF_lo' = transform FLOAT_DIV_TF_lo and FLOAT_DIV_0x_hi' = transform FLOAT_DIV_0x_hi and FLOAT_DIV_0x_lo' = transform FLOAT_DIV_0x_lo;; let float_div_lo pp f1 f2 = let s1, n1, e1 = dest_float f1 and s2, n2, e2 = dest_float f2 in let n1_eq0_th = raw_eq0_hash_conv n1 in if (rand o concl) n1_eq0_th = t_const then (MY_PROVE_HYP n1_eq0_th o INST[e1, e1_var_num; f2, f2_var_real; n1, n1_var_num; (if s1 = "T" then t_const else f_const), s1_var_bool]) FLOAT_DIV_0x_lo' else let flag = s1 = s2 in let k_tm = rand (mk_small_numeral_array (2 * pp)) in let num_exp1 = mk_num_exp n1 k_tm and num_exp2 = mk_num_exp n2 zero_const in let div_th, n_tm, e_tm = if flag then let th = num_exp_op_lo pp num_exp_div num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (lhand(concl th)) in th, n_tm, e_tm else let th = num_exp_op_hi_lt pp num_exp_div num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (rand(concl th)) in th, n_tm, e_tm in let r1_th = raw_add_conv_hash (mk_binop add_op_num e2 k_tm) in let r1_tm = rand(concl r1_th) in let e_plus_e1 = raw_add_conv_hash (mk_binop add_op_num e_tm e1) in let ltm, rtm = dest_comb(concl e_plus_e1) in let r2_th' = raw_add_conv_hash (mk_binop add_op_num min_exp_num_const rtm) in let r2_th = TRANS (AP_TERM (mk_comb (add_op_num, min_exp_num_const)) e_plus_e1) r2_th' in let r2_tm = rand(concl r2_th) in let sub_th, le_th = raw_sub_and_le_hash_conv r2_tm r1_tm in if rand(concl le_th) <> r2_tm then failwith "float_div_lo: underflow" else let r_tm = rand(concl sub_th) in let n2_not_zero = raw_eq0_hash_conv n2 in let inst = INST[r1_tm, r1_var_num; r2_tm, r2_var_num; n1, n1_var_num; e1, e1_var_num; e_tm, e_var_num; k_tm, k_var_num; n2, n2_var_num; e2, e2_var_num; n_tm, n_var_num; r_tm, r_var_num] in let th0 = inst (if flag then if s1 = "F" then FLOAT_DIV_FF_lo' else FLOAT_DIV_TT_lo' else if s1 = "F" then FLOAT_DIV_FT_lo' else FLOAT_DIV_TF_lo') in let th1 = MY_PROVE_HYP n2_not_zero (MY_PROVE_HYP div_th (MY_PROVE_HYP le_th th0)) in MY_PROVE_HYP sub_th (MY_PROVE_HYP r2_th (MY_PROVE_HYP r1_th th1));; let float_div_hi pp f1 f2 = let s1, n1, e1 = dest_float f1 and s2, n2, e2 = dest_float f2 in let n1_eq0_th = raw_eq0_hash_conv n1 in if (rand o concl) n1_eq0_th = t_const then (MY_PROVE_HYP n1_eq0_th o INST[e1, e1_var_num; f2, f2_var_real; n1, n1_var_num; (if s1 = "T" then t_const else f_const), s1_var_bool]) FLOAT_DIV_0x_hi' else let flag = s1 = s2 in let k_tm = rand (mk_small_numeral_array (2 * pp)) in let num_exp1 = mk_num_exp n1 k_tm and num_exp2 = mk_num_exp n2 zero_const in let div_th, n_tm, e_tm = if flag then let th = num_exp_op_hi_lt pp num_exp_div num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (rand(concl th)) in th, n_tm, e_tm else let th = num_exp_op_lo pp num_exp_div num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (lhand(concl th)) in th, n_tm, e_tm in let r1_th = raw_add_conv_hash (mk_binop add_op_num e2 k_tm) in let r1_tm = rand(concl r1_th) in let e_plus_e1 = raw_add_conv_hash (mk_binop add_op_num e_tm e1) in let ltm, rtm = dest_comb(concl e_plus_e1) in let r2_th' = raw_add_conv_hash (mk_binop add_op_num min_exp_num_const rtm) in let r2_th = TRANS (AP_TERM (mk_comb (add_op_num, min_exp_num_const)) e_plus_e1) r2_th' in let r2_tm = rand(concl r2_th) in let sub_th, le_th = raw_sub_and_le_hash_conv r2_tm r1_tm in if rand(concl le_th) <> r2_tm then failwith "float_div_hi: underflow" else let r_tm = rand(concl sub_th) in let n2_not_zero = raw_eq0_hash_conv n2 in let inst = INST[r1_tm, r1_var_num; r2_tm, r2_var_num; n1, n1_var_num; e1, e1_var_num; e_tm, e_var_num; k_tm, k_var_num; n2, n2_var_num; e2, e2_var_num; n_tm, n_var_num; r_tm, r_var_num] in let th0 = inst (if flag then if s1 = "F" then FLOAT_DIV_FF_hi' else FLOAT_DIV_TT_hi' else if s1 = "F" then FLOAT_DIV_FT_hi' else FLOAT_DIV_TF_hi') in let th1 = MY_PROVE_HYP n2_not_zero (MY_PROVE_HYP div_th (MY_PROVE_HYP le_th th0)) in MY_PROVE_HYP sub_th (MY_PROVE_HYP r2_th (MY_PROVE_HYP r1_th th1));; (***********************************) (* FLOAT_ADD *) let FLOAT_ADD_FF = prove(`num_exp n1 e1 + num_exp n2 e2 = num_exp n e ==> float_num F n1 e1 + float_num F n2 e2 = float_num F n e`, REPEAT STRIP_TAC THEN REWRITE_TAC[float; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `a / b + c / b = (a + c) / b`] THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD]);; let FLOAT_ADD_TT = prove(`num_exp n1 e1 + num_exp n2 e2 = num_exp n e ==> float_num T n1 e1 + float_num T n2 e2 = float_num T n e`, REWRITE_TAC[FLOAT_NEG_T; REAL_ARITH `--a + --b = --c <=> a + b = c`] THEN REWRITE_TAC[FLOAT_ADD_FF]);; let FLOAT_ADD_FF_lo = prove(`num_exp n e <= num_exp n1 e1 + num_exp n2 e2 ==> float_num F n e <= float_num F n1 e1 + float_num F n2 e2`, REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`z = &(num_exp n e)`; `x = &(num_exp n1 e1)`; `y = &(num_exp n2 e2)`] THEN ASM_REWRITE_TAC[float; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `a / b + c / b = (a + c) / b`] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]);; let FLOAT_ADD_FF_hi = prove(`num_exp n1 e1 + num_exp n2 e2 <= num_exp n e ==> float_num F n1 e1 + float_num F n2 e2 <= float_num F n e`, REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`z = &(num_exp n e)`; `x = &(num_exp n1 e1)`; `y = &(num_exp n2 e2)`] THEN ASM_REWRITE_TAC[float; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `a / b + c / b = (a + c) / b`] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]);; let FLOAT_ADD_TT_lo = prove(`num_exp n1 e1 + num_exp n2 e2 <= num_exp n e ==> float_num T n e <= float_num T n1 e1 + float_num T n2 e2`, REWRITE_TAC[FLOAT_NEG_T; REAL_ARITH `--a <= --b + --c <=> b + c <= a`] THEN REWRITE_TAC[FLOAT_ADD_FF_hi]);; let FLOAT_ADD_TT_hi = prove(`num_exp n e <= num_exp n1 e1 + num_exp n2 e2 ==> float_num T n1 e1 + float_num T n2 e2 <= float_num T n e`, REWRITE_TAC[FLOAT_NEG_T; REAL_ARITH `--b + --c <= --a <=> a <= b + c`] THEN REWRITE_TAC[FLOAT_ADD_FF_lo]);; let FLOAT_ADD_FT_F_lo = prove(`num_exp n2 e2 <= num_exp n1 e1 ==> num_exp n e <= num_exp n1 e1 - num_exp n2 e2 ==> float_num F n e <= float_num F n1 e1 + float_num T n2 e2`, MAP_EVERY ABBREV_TAC[`z = num_exp n e`; `x = num_exp n1 e1`; `y = num_exp n2 e2`] THEN ASM_REWRITE_TAC[FLOAT_NEG_T; float; REAL_MUL_LID] THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[num_exp; min_exp_def; MULT_CLAUSES; GSYM REAL_OF_NUM_POW] THEN REAL_ARITH_TAC);; let FLOAT_ADD_FT_T_lo = prove(`num_exp n1 e1 <= num_exp n2 e2 ==> num_exp n2 e2 - num_exp n1 e1 <= num_exp n e ==> float_num T n e <= float_num F n1 e1 + float_num T n2 e2`, MAP_EVERY ABBREV_TAC[`z = num_exp n e`; `x = num_exp n1 e1`; `y = num_exp n2 e2`] THEN ASM_REWRITE_TAC[FLOAT_NEG_T; float; REAL_MUL_LID] THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[num_exp; min_exp_def; MULT_CLAUSES; GSYM REAL_OF_NUM_POW] THEN REAL_ARITH_TAC);; let FLOAT_ADD_FT_F_hi = prove(`num_exp n2 e2 <= num_exp n1 e1 ==> num_exp n1 e1 - num_exp n2 e2 <= num_exp n e ==> float_num F n1 e1 + float_num T n2 e2 <= float_num F n e`, REWRITE_TAC[FLOAT_NEG_T; REAL_ARITH `a + --b <= c <=> --c <= b + --a`] THEN REWRITE_TAC[GSYM FLOAT_NEG_T; FLOAT_ADD_FT_T_lo]);; let FLOAT_ADD_FT_T_hi = prove(`num_exp n1 e1 <= num_exp n2 e2 ==> num_exp n e <= num_exp n2 e2 - num_exp n1 e1 ==> float_num F n1 e1 + float_num T n2 e2 <= float_num T n e`, REWRITE_TAC[FLOAT_NEG_T; REAL_ARITH `a + --b <= --c <=> c <= b + --a`] THEN REWRITE_TAC[GSYM FLOAT_NEG_T; FLOAT_ADD_FT_F_lo]);; (******************************************) (* float_add_lo, float_add_hi *) let REAL_ADD_COMM = CONJUNCT1 REAL_ADD_AC;; let transform = UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o NUMERALS_TO_NUM;; let FLOAT_ADD_FF_hi' = transform FLOAT_ADD_FF_hi and FLOAT_ADD_FF_lo' = transform FLOAT_ADD_FF_lo and FLOAT_ADD_TT_hi' = transform FLOAT_ADD_TT_hi and FLOAT_ADD_TT_lo' = transform FLOAT_ADD_TT_lo and FLOAT_ADD_FT_F_lo' = transform FLOAT_ADD_FT_F_lo and FLOAT_ADD_FT_T_lo' = transform FLOAT_ADD_FT_T_lo and FLOAT_ADD_FT_F_hi' = transform FLOAT_ADD_FT_F_hi and FLOAT_ADD_FT_T_hi' = transform FLOAT_ADD_FT_T_hi;; let float_add_lo pp f1 f2 = let s1, n1, e1 = dest_float f1 in let s2, n2, e2 = dest_float f2 in if s1 = s2 then let num_exp1 = mk_num_exp n1 e1 in let num_exp2 = mk_num_exp n2 e2 in if s1 = "F" then (* F + F *) let add_th = num_exp_op_lo pp num_exp_add num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (lhand(concl add_th)) in let th0 = INST[e_tm, e_var_num; n_tm, n_var_num; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] FLOAT_ADD_FF_lo' in MY_PROVE_HYP add_th th0 else (* T + T *) let add_th = num_exp_op_hi pp num_exp_add num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (rand(concl add_th)) in let th0 = INST[e_tm, e_var_num; n_tm, n_var_num; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] FLOAT_ADD_TT_lo' in MY_PROVE_HYP add_th th0 else (* F + T or T + F *) let th0, n1, e1, n2, e2 = if s1 = "T" then INST[f2, m_var_real; f1, n_var_real] REAL_ADD_COMM, n2, e2, n1, e1 else REFL(mk_binop add_op_real f1 f2), n1, e1, n2, e2 in let num_exp1 = mk_num_exp n1 e1 in let num_exp2 = mk_num_exp n2 e2 in let sub_th, le_th = num_exp_sub num_exp1 num_exp2 in let sub_tm = rand(concl sub_th) in if rand(concl le_th) = num_exp1 then let lo_th = num_exp_lo pp sub_tm in let n_tm, e_tm = dest_num_exp (lhand(concl lo_th)) in let lo_sub_th = EQ_MP (AP_TERM (rator(concl lo_th)) (SYM sub_th)) lo_th in let th1 = INST[n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num; n_tm, n_var_num; e_tm, e_var_num] FLOAT_ADD_FT_F_lo' in let th2 = MY_PROVE_HYP lo_sub_th (MY_PROVE_HYP le_th th1) in EQ_MP (AP_TERM (rator(concl th2)) th0) th2 else let hi_th = num_exp_hi pp sub_tm in let n_tm, e_tm = dest_num_exp(rand(concl hi_th)) in let hi_sub_th = EQ_MP (SYM (AP_THM (AP_TERM le_op_num sub_th) (rand(concl hi_th)))) hi_th in let th1 = INST[n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num; n_tm, n_var_num; e_tm, e_var_num] FLOAT_ADD_FT_T_lo' in let th2 = MY_PROVE_HYP hi_sub_th (MY_PROVE_HYP le_th th1) in EQ_MP (AP_TERM (rator(concl th2)) th0) th2;; let float_add_hi pp f1 f2 = let s1, n1, e1 = dest_float f1 in let s2, n2, e2 = dest_float f2 in if s1 = s2 then let num_exp1 = mk_num_exp n1 e1 in let num_exp2 = mk_num_exp n2 e2 in if s1 = "F" then (* F + F *) let add_th = num_exp_op_hi pp num_exp_add num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (rand(concl add_th)) in let th0 = INST[e_tm, e_var_num; n_tm, n_var_num; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] FLOAT_ADD_FF_hi' in MY_PROVE_HYP add_th th0 else (* T + T *) let add_th = num_exp_op_lo pp num_exp_add num_exp1 num_exp2 in let n_tm, e_tm = dest_num_exp (lhand(concl add_th)) in let th0 = INST[e_tm, e_var_num; n_tm, n_var_num; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] FLOAT_ADD_TT_hi' in MY_PROVE_HYP add_th th0 else (* F + T or T + F *) let th0, n1, e1, n2, e2 = if s1 = "T" then INST[f2, m_var_real; f1, n_var_real] REAL_ADD_COMM, n2, e2, n1, e1 else REFL(mk_binop add_op_real f1 f2), n1, e1, n2, e2 in let num_exp1 = mk_num_exp n1 e1 in let num_exp2 = mk_num_exp n2 e2 in let sub_th, le_th = num_exp_sub num_exp1 num_exp2 in let sub_tm = rand(concl sub_th) in if rand(concl le_th) = num_exp1 then let hi_th = num_exp_hi pp sub_tm in let n_tm, e_tm = dest_num_exp (rand(concl hi_th)) in let hi_sub_th = EQ_MP (SYM (AP_THM (AP_TERM le_op_num sub_th) (rand(concl hi_th)))) hi_th in let th1 = INST[n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num; n_tm, n_var_num; e_tm, e_var_num] FLOAT_ADD_FT_F_hi' in let th2 = MY_PROVE_HYP hi_sub_th (MY_PROVE_HYP le_th th1) in EQ_MP (AP_THM (AP_TERM le_op_real th0) (rand(concl th2))) th2 else let lo_th = num_exp_lo pp sub_tm in let n_tm, e_tm = dest_num_exp(lhand(concl lo_th)) in let lo_sub_th = EQ_MP (AP_TERM (rator(concl lo_th)) (SYM sub_th)) lo_th in let th1 = INST[n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num; n_tm, n_var_num; e_tm, e_var_num] FLOAT_ADD_FT_T_hi' in let th2 = MY_PROVE_HYP lo_sub_th (MY_PROVE_HYP le_th th1) in EQ_MP (AP_THM (AP_TERM le_op_real th0) (rand(concl th2))) th2;; (******************************************) (* float_sub_lo, float_sub_hi *) let FLOAT_SUB_F_EQ_ADD = (SYM o prove)(`f1 - float_num F n2 e2 = f1 + float_num T n2 e2`, REWRITE_TAC[FLOAT_NEG_T] THEN REAL_ARITH_TAC);; let FLOAT_SUB_T_EQ_ADD = (SYM o prove)(`f1 - float_num T n2 e2 = f1 + float_num F n2 e2`, REWRITE_TAC[FLOAT_NEG_T] THEN REAL_ARITH_TAC);; let float_sub_lo pp f1 f2 = let s2, n2, e2 = dest_float f2 in let th0 = INST[f1, f1_var_real; n2, n2_var_num; e2, e2_var_num] (if s2 = "F" then FLOAT_SUB_F_EQ_ADD else FLOAT_SUB_T_EQ_ADD) in let ltm,f2_tm = dest_comb(lhand(concl th0)) in let f1_tm = rand ltm in let lo_th = float_add_lo pp f1_tm f2_tm in EQ_MP (AP_TERM (rator(concl lo_th)) th0) lo_th;; let float_sub_hi pp f1 f2 = let s2, n2, e2 = dest_float f2 in let th0 = INST[f1, f1_var_real; n2, n2_var_num; e2, e2_var_num] (if s2 = "F" then FLOAT_SUB_F_EQ_ADD else FLOAT_SUB_T_EQ_ADD) in let ltm, f2_tm = dest_comb(lhand(concl th0)) in let f1_tm = rand ltm in let hi_th = float_add_hi pp f1_tm f2_tm in EQ_MP (AP_THM (AP_TERM le_op_real th0) (rand(concl hi_th))) hi_th;; (*******************************************) (* FLOAT_SQRT *) (* float_num F m e = float_num F (B0 m) (PRE e) *) let FLOAT_PRE_EXP = prove(mk_imp(`~(e = 0) /\ PRE e = e1`, mk_eq(`float_num F m e`, mk_comb(mk_comb(`float_num F`, mk_comb(b0_const, m_var_num)), `e1:num`))), STRIP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[float; REAL_MUL_LID; real_div; REAL_EQ_MUL_RCANCEL] THEN DISJ1_TAC THEN REWRITE_TAC[num_exp; b0_thm; REAL_OF_NUM_EQ] THEN SUBGOAL_THEN `e = SUC (PRE e)` MP_TAC THENL [ POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[th]))) THEN REWRITE_TAC[EXP] THEN ARITH_TAC);; let DIV2_EVEN_lemma = prove(`!n. EVEN n ==> 2 * (n DIV 2) = n`, GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `x = y ==> 2 * x = 2 * y`) THEN MATCH_MP_TAC DIV_MULT THEN ARITH_TAC);; let FLOAT_SQRT_EVEN_lo = prove(`f1 * f1 = f2 /\ f2 <= x /\ num_exp m (2 * p) = x /\ f1 = num_exp n1 e1 /\ EVEN e /\ e DIV 2 = e2 /\ e1 + e2 + (min_exp DIV 2) = r /\ p <= r /\ r - p = r2 ==> float_num F n1 r2 <= sqrt (float_num F m e)`, STRIP_TAC THEN UNDISCH_TAC `f2 <= x:num` THEN UNDISCH_TAC `num_exp m (2 * p) = x` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN UNDISCH_TAC `f1 * f1 = f2:num` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN UNDISCH_TAC `e1 + e2 + min_exp DIV 2 = r` THEN UNDISCH_TAC `e DIV 2 = e2` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[num_exp; float; REAL_MUL_LID; GSYM REAL_OF_NUM_MUL] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `r - p = r2:num` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW; REAL_POW_DIV] THEN REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `(((a * b) * a) * b) * c = (a * a) * (b * b) * c:real`] THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN REWRITE_TAC[ARITH_RULE `r - p + r - p = 2 * r - 2 * p`] THEN MP_TAC (SPECL[mk_comb(amp_op_real, base_const); `2 * r`; `2 * p`] REAL_DIV_POW2) THEN ANTS_TAC THENL [ REAL_ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[ARITH_RULE `p <= r ==> 2 * p <= 2 * r`] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th; real_div]) THEN SUBGOAL_THEN `2 * r = (e1 + e1) + min_exp + e` (fun th -> REWRITE_TAC[th]) THENL [ EXPAND_TAC "r" THEN REWRITE_TAC[ARITH_RULE `2 * (e1 + b + c) = (e1 + e1) + 2 * c + 2 * b`] THEN MATCH_MP_TAC (ARITH_RULE `b1 = b2 /\ c1 = c2 ==> a + b1 + c1 = a + b2 + c2:num`) THEN SUBGOAL_THEN `EVEN min_exp` ASSUME_TAC THENL [ REWRITE_TAC[min_exp_def] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[DIV2_EVEN_lemma]; ALL_TAC ] THEN REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[REAL_ARITH `(n * n) * (((e * e) * x * y) * z) * u = (n * e) * (n * e) * (x * u) * z * y:real`] THEN SUBGOAL_THEN `~(&(num_exp 1 min_exp) = &0)` MP_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_EQ; NUM_EXP_EQ_0] THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[num_exp; REAL_MUL_LID; GSYM REAL_OF_NUM_POW; GSYM REAL_OF_NUM_MUL] THEN DISCH_THEN (fun th -> SIMP_TAC[th; REAL_MUL_RINV; REAL_MUL_LID]) THEN FIRST_X_ASSUM (MP_TAC o check(fun th -> (fst o dest_var o lhand o concl) th = "f1")) THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [ SUBGOAL_THEN `!x y z. &0 < x /\ y <= z * x ==> y * inv x <= z` MP_TAC THENL [ REPEAT STRIP_TAC THEN MP_TAC (SPECL [`y * inv x`; `z:real`; `x:real`] REAL_LE_RMUL_EQ) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th; GSYM REAL_MUL_ASSOC]) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> ~(x = &0)`; REAL_MUL_LINV; REAL_MUL_RID]; ALL_TAC ] THEN DISCH_THEN (MP_TAC o SPECL[`&(num_exp 1 (2 * p))`; `&(f1 * f1)`; `&m`]) THEN REWRITE_TAC[num_exp; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN REWRITE_TAC[REAL_OF_NUM_LT; EXP_LT_0] THEN ARITH_TAC; ALL_TAC ] THEN MATCH_MP_TAC REAL_POW_LE THEN ARITH_TAC; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_POW_LE THEN ARITH_TAC);; let FLOAT_SQRT_EVEN_hi = prove(`f1 * f1 = f2 /\ x <= f2 /\ num_exp m (2 * p) = x /\ f1 = num_exp n1 e1 /\ EVEN e /\ e DIV 2 = e2 /\ e1 + e2 + (min_exp DIV 2) = r /\ p <= r /\ r - p = r2 ==> sqrt (float_num F m e) <= float_num F n1 r2`, STRIP_TAC THEN UNDISCH_TAC `x <= f2:num` THEN UNDISCH_TAC `num_exp m (2 * p) = x` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN UNDISCH_TAC `f1 * f1 = f2:num` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN UNDISCH_TAC `e1 + e2 + min_exp DIV 2 = r` THEN UNDISCH_TAC `e DIV 2 = e2` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[num_exp; float; REAL_MUL_LID; GSYM REAL_OF_NUM_MUL] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `r - p = r2:num` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN MATCH_MP_TAC REAL_LE_LSQRT_COMPAT THEN REPEAT CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_MUL; real_div] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; REWRITE_TAC[REAL_OF_NUM_MUL; real_div] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; ALL_TAC ] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW; REAL_POW_DIV] THEN REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `(((a * b) * a) * b) * c = (a * a) * (b * b) * c:real`] THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN REWRITE_TAC[ARITH_RULE `r - p + r - p = 2 * r - 2 * p`] THEN MP_TAC (SPECL[mk_comb(amp_op_real, base_const); `2 * r`; `2 * p`] REAL_DIV_POW2) THEN ANTS_TAC THENL [ REAL_ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[ARITH_RULE `p <= r ==> 2 * p <= 2 * r`] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th; real_div]) THEN SUBGOAL_THEN `2 * r = (e1 + e1) + min_exp + e` (fun th -> REWRITE_TAC[th]) THENL [ EXPAND_TAC "r" THEN REWRITE_TAC[ARITH_RULE `2 * (e1 + b + c) = (e1 + e1) + 2 * c + 2 * b`] THEN MATCH_MP_TAC (ARITH_RULE `b1 = b2 /\ c1 = c2 ==> a + b1 + c1 = a + b2 + c2:num`) THEN SUBGOAL_THEN `EVEN min_exp` ASSUME_TAC THENL [ REWRITE_TAC[min_exp_def] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[DIV2_EVEN_lemma]; ALL_TAC ] THEN REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[REAL_ARITH `(n * n) * (((e * e) * x * y) * z) * u = (n * e) * (n * e) * (x * u) * z * y:real`] THEN SUBGOAL_THEN `~(&(num_exp 1 min_exp) = &0)` MP_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_EQ; NUM_EXP_EQ_0] THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[num_exp; REAL_MUL_LID; GSYM REAL_OF_NUM_POW; GSYM REAL_OF_NUM_MUL] THEN DISCH_THEN (fun th -> SIMP_TAC[th; REAL_MUL_RINV; REAL_MUL_LID]) THEN FIRST_X_ASSUM (MP_TAC o check(fun th -> (fst o dest_var o lhand o concl) th = "f1")) THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [ SUBGOAL_THEN `!x y z. &0 < x /\ z * x <= y ==> z <= y * inv x` MP_TAC THENL [ REPEAT STRIP_TAC THEN MP_TAC (SPECL [`z:real`; `y * inv x`; `x:real`] REAL_LE_RMUL_EQ) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th; GSYM REAL_MUL_ASSOC]) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> ~(x = &0)`; REAL_MUL_LINV; REAL_MUL_RID]; ALL_TAC ] THEN DISCH_THEN (MP_TAC o SPECL[`&(num_exp 1 (2 * p))`; `&(f1 * f1)`; `&m`]) THEN REWRITE_TAC[num_exp; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN REWRITE_TAC[REAL_OF_NUM_LT; EXP_LT_0] THEN ARITH_TAC; ALL_TAC ] THEN MATCH_MP_TAC REAL_POW_LE THEN ARITH_TAC; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_POW_LE THEN ARITH_TAC);; (******************) let transform = UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[TAUT `EVEN e <=> (EVEN e <=> T)`] o NUMERALS_TO_NUM o CONV_RULE (DEPTH_CONV NUM_DIV_CONV) o REWRITE_RULE[GSYM IMP_IMP; min_exp_def];; let FLOAT_SQRT_EVEN_lo' = transform FLOAT_SQRT_EVEN_lo and FLOAT_SQRT_EVEN_hi' = transform FLOAT_SQRT_EVEN_hi and FLOAT_PRE_EXP' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[TAUT `~(e = _0) <=> ((e = _0) <=> F)`] o REWRITE_RULE[GSYM IMP_IMP; NUMERAL]) FLOAT_PRE_EXP;; let even_const = `EVEN` and pre_const = `PRE` and two_num = rand(mk_small_numeral_array 2) and min_exp_div2 = rand(mk_small_numeral_array (min_exp / 2)) and f2_var_num = `f2:num` and f1_var_num = `f1:num` and p_var_num = `p:num`;; (* Returns the list of digits of the given Big_int n in the base b *) let rec get_big_int_digits b n = let bb = big_int_of_int b in if le_big_int n zero_big_int then [] else let q, r = quomod_big_int n bb in r :: get_big_int_digits b q;; (* [1;2;3] -> 123 (base = 10) *) let rec big_int_from_list b list = let rec proc acc list = match list with [] -> acc | h::t -> proc (add_big_int h (mult_int_big_int b acc)) t in proc zero_big_int list;; (* Returns n first elements of the list *) let rec take n list = match list with x :: xs -> if n > 0 then x :: take (n - 1) xs else [] | [] -> [];; (* Returns an integer number that contains at most pp significant digits in the given base b *) let big_int_round_lo base pp n = let digits = rev (get_big_int_digits base n) in let n_digits = length digits in if n_digits <= pp then n else let m = big_int_from_list base (take pp digits) in mult_big_int (power_int_positive_int base (n_digits - pp)) m;; let big_int_round_hi base pp n = let digits = rev (get_big_int_digits base n) in let n_digits = length digits in if n_digits <= pp then n else let l1, l2 = chop_list pp digits in if forall (eq_big_int zero_big_int) l2 then n else let m = succ_big_int (big_int_from_list base l1) in mult_big_int (power_int_positive_int base (n_digits - pp)) m;; (******************) let rec float_sqrt_lo pp tm = let s, m_tm, e_tm = dest_float tm in let p_tm = rand (mk_small_numeral_array pp) in if s <> "F" then failwith "float_sqrt_lo: negative argument" else let even_th = raw_even_hash_conv (mk_comb (even_const, e_tm)) in if (fst o dest_const o rand o concl) even_th <> "T" then (* ODD e *) let pre_e = raw_pre_hash_conv (mk_comb (pre_const, e_tm)) in let e_neq_0 = raw_eq0_hash_conv e_tm in let e1_tm = rand (concl pre_e) in let th0 = INST[e1_tm, e1_var_num; e_tm, e_var_num; m_tm, m_var_num] FLOAT_PRE_EXP' in let th1 = MY_PROVE_HYP pre_e (MY_PROVE_HYP e_neq_0 th0) in let th2 = float_sqrt_lo pp (rand(concl th1)) in let ltm, rtm = dest_comb (concl th2) in EQ_MP (SYM (AP_TERM ltm (AP_TERM (rator rtm) th1))) th2 else (* EVEN e *) let p2_tm = mk_binop mul_op_num two_num p_tm in let p2_th = raw_mul_conv_hash p2_tm in let f1_1 = AP_TERM (mk_comb(num_exp_const, m_tm)) p2_th in let f1_2 = TRANS f1_1 (denormalize (rand (concl f1_1))) in let x_tm = rand(concl f1_2) in let x = raw_dest_hash x_tm in let f1' = Big_int.sqrt_big_int (big_int_of_num x) in let f1 = num_of_big_int (big_int_round_lo Arith_hash.arith_base pp f1') in let f1_tm = rand(mk_numeral_array f1) in let f1_num_exp = to_num_exp f1_tm in let n1_tm, e1_tm = dest_num_exp (rand (concl f1_num_exp)) in let f1f1_eq_f2 = raw_mul_conv_hash (mk_binop mul_op_num f1_tm f1_tm) in let f2_tm = rand(concl f1f1_eq_f2) in let f2_le_x = EQT_ELIM (raw_le_hash_conv (mk_binop le_op_num f2_tm x_tm)) in let e_div2_eq_e2 = raw_div_hash_conv (mk_binop div_op_num e_tm two_num) in let e2_tm = rand(concl e_div2_eq_e2) in let r_th1 = raw_add_conv_hash (mk_binop add_op_num e2_tm min_exp_div2) in let r_th2 = AP_TERM (mk_comb(add_op_num, e1_tm)) r_th1 in let r_th = TRANS r_th2 (raw_add_conv_hash (rand (concl r_th2))) in let r_tm = rand(concl r_th) in let r_sub_p, p_le_r = raw_sub_and_le_hash_conv p_tm r_tm in let r2_tm = rand(concl r_sub_p) in if (rand(concl p_le_r) <> r_tm) then failwith "float_sqrt_lo: underflow" else let th0 = INST[f2_tm, f2_var_num; x_tm, x_var_num; p_tm, p_var_num; r_tm, r_var_num; f1_tm, f1_var_num; n1_tm, n1_var_num; e1_tm, e1_var_num; e2_tm, e2_var_num; e_tm, e_var_num; m_tm, m_var_num; r2_tm, r2_var_num] FLOAT_SQRT_EVEN_lo' in MY_PROVE_HYP f1_2 ( MY_PROVE_HYP e_div2_eq_e2 ( MY_PROVE_HYP r_sub_p ( MY_PROVE_HYP r_th ( MY_PROVE_HYP f1f1_eq_f2 ( MY_PROVE_HYP f1_num_exp ( MY_PROVE_HYP even_th ( MY_PROVE_HYP f2_le_x ( MY_PROVE_HYP p_le_r th0 ))))))));; let rec float_sqrt_hi pp tm = let s, m_tm, e_tm = dest_float tm in let p_tm = rand (mk_small_numeral_array pp) in if s <> "F" then failwith "float_sqrt_lo: negative argument" else let even_th = raw_even_hash_conv (mk_comb (even_const, e_tm)) in if (fst o dest_const o rand o concl) even_th <> "T" then (* ODD e *) let pre_e = raw_pre_hash_conv (mk_comb (pre_const, e_tm)) in let e_neq_0 = raw_eq0_hash_conv e_tm in let e1_tm = rand (concl pre_e) in let th0 = INST[e1_tm, e1_var_num; e_tm, e_var_num; m_tm, m_var_num] FLOAT_PRE_EXP' in let th1 = MY_PROVE_HYP pre_e (MY_PROVE_HYP e_neq_0 th0) in let th2 = float_sqrt_hi pp (rand(concl th1)) in let ltm, rtm = dest_comb (concl th2) in let ltm2, rtm2 = dest_comb ltm in let th3 = AP_THM (AP_TERM ltm2 (AP_TERM (rator rtm2) th1)) rtm in EQ_MP (SYM th3) th2 else (* EVEN e *) let p2_tm = mk_binop mul_op_num two_num p_tm in let p2_th = raw_mul_conv_hash p2_tm in let f1_1 = AP_TERM (mk_comb(num_exp_const, m_tm)) p2_th in let f1_2 = TRANS f1_1 (denormalize (rand (concl f1_1))) in let x_tm = rand(concl f1_2) in let x = raw_dest_hash x_tm in let x' = big_int_of_num x in let f1' = sqrt_big_int x' in let f1 = (num_of_big_int o big_int_round_hi Arith_hash.arith_base pp) (if eq_big_int (mult_big_int f1' f1') x' then f1' else succ_big_int f1') in let f1_tm = rand(mk_numeral_array f1) in let f1_num_exp = to_num_exp f1_tm in let n1_tm, e1_tm = dest_num_exp (rand (concl f1_num_exp)) in let f1f1_eq_f2 = raw_mul_conv_hash (mk_binop mul_op_num f1_tm f1_tm) in let f2_tm = rand(concl f1f1_eq_f2) in let x_le_f2 = EQT_ELIM (raw_le_hash_conv (mk_binop le_op_num x_tm f2_tm)) in let e_div2_eq_e2 = raw_div_hash_conv (mk_binop div_op_num e_tm two_num) in let e2_tm = rand(concl e_div2_eq_e2) in let r_th1 = raw_add_conv_hash (mk_binop add_op_num e2_tm min_exp_div2) in let r_th2 = AP_TERM (mk_comb(add_op_num, e1_tm)) r_th1 in let r_th = TRANS r_th2 (raw_add_conv_hash (rand (concl r_th2))) in let r_tm = rand(concl r_th) in let r_sub_p, p_le_r = raw_sub_and_le_hash_conv p_tm r_tm in let r2_tm = rand(concl r_sub_p) in if (rand(concl p_le_r) <> r_tm) then failwith "float_sqrt_lo: underflow" else let th0 = INST[f2_tm, f2_var_num; x_tm, x_var_num; p_tm, p_var_num; r_tm, r_var_num; f1_tm, f1_var_num; n1_tm, n1_var_num; e1_tm, e1_var_num; e2_tm, e2_var_num; e_tm, e_var_num; m_tm, m_var_num; r2_tm, r2_var_num] FLOAT_SQRT_EVEN_hi' in MY_PROVE_HYP f1_2 ( MY_PROVE_HYP e_div2_eq_e2 ( MY_PROVE_HYP r_sub_p ( MY_PROVE_HYP r_th ( MY_PROVE_HYP f1f1_eq_f2 ( MY_PROVE_HYP f1_num_exp ( MY_PROVE_HYP even_th ( MY_PROVE_HYP x_le_f2 ( MY_PROVE_HYP p_le_r th0 ))))))));; end;; (* Float_ops module *) (************************************) (* Cached floating point operations *) (************************************) (* Counters for collecting stats *) let lt0_c = ref 0 and gt0_c = ref 0 and lt_c = ref 0 and le0_c = ref 0 and ge0_c = ref 0 and le_c = ref 0 and min_c = ref 0 and max_c = ref 0 and min_max_c = ref 0 and mul_lo_c = ref 0 and mul_hi_c = ref 0 and div_lo_c = ref 0 and div_hi_c = ref 0 and add_lo_c = ref 0 and add_hi_c = ref 0 and sub_lo_c = ref 0 and sub_hi_c = ref 0 and sqrt_lo_c = ref 0 and sqrt_hi_c = ref 0;; (* Hash tables *) let cache_size = if !Arith_options.float_cached then !Arith_options.init_cache_size else 1;; let my_add h key v = if Hashtbl.length h >= !Arith_options.max_cache_size then Hashtbl.clear h (* let _ = Hashtbl.clear h in print_string "Clearing a float hash table" *) else (); Hashtbl.add h key v;; let mul_table = Hashtbl.create cache_size and div_table = Hashtbl.create cache_size and add_table = Hashtbl.create cache_size and sub_table = Hashtbl.create cache_size and sqrt_table = Hashtbl.create cache_size and le_table = Hashtbl.create cache_size and max_table = Hashtbl.create cache_size;; let reset_cache () = Hashtbl.clear mul_table; Hashtbl.clear div_table; Hashtbl.clear add_table; Hashtbl.clear sub_table; Hashtbl.clear sqrt_table; Hashtbl.clear le_table; Hashtbl.clear max_table;; let reset_stat () = lt0_c := 0; gt0_c := 0; lt_c := 0; le0_c := 0; ge0_c := 0; le_c := 0; min_c := 0; max_c := 0; min_max_c := 0; mul_lo_c := 0; mul_hi_c := 0; div_lo_c := 0; div_hi_c := 0; add_lo_c := 0; add_hi_c := 0; sub_lo_c := 0; sub_hi_c := 0; sqrt_lo_c := 0; sqrt_hi_c := 0;; let print_stat () = let len = Hashtbl.length in let cmp_str1 = sprintf "lt0 = %d\ngt0 = %d\nlt = %d\n" !lt0_c !gt0_c !lt_c and cmp_str2 = sprintf "le0 = %d\nge0 = %d\n" !le0_c !ge0_c and cmp_str3 = sprintf "min = %d\nmin_max = %d\n" !min_c !min_max_c and le_str = sprintf "le = %d (le_hash = %d)\n" !le_c (len le_table) and max_str = sprintf "max = %d (max_hash = %d)\n" !max_c (len max_table) and mul_str = sprintf "mul_lo = %d, mul_hi = %d (mul_hash = %d)\n" !mul_lo_c !mul_hi_c (len mul_table) and div_str = sprintf "div_lo = %d, div_hi = %d (div_hash = %d)\n" !div_lo_c !div_hi_c (len div_table) and add_str = sprintf "add_lo = %d, add_hi = %d (add_hash = %d)\n" !add_lo_c !add_hi_c (len add_table) and sub_str = sprintf "sub_lo = %d, sub_hi = %d (sub_hash = %d)\n" !sub_lo_c !sub_hi_c (len sub_table) and sqrt_str = sprintf "sqrt_lo = %d, sqrt_hi = %d (sqrt_hash = %d)\n" !sqrt_lo_c !sqrt_hi_c (len sqrt_table) in print_string (cmp_str1 ^ cmp_str2 ^ cmp_str3 ^ le_str ^ max_str ^ mul_str ^ div_str ^ add_str ^ sub_str ^ sqrt_str);; (* lt0 *) let float_lt0 = if !Arith_options.float_cached then fun tm -> let _ = lt0_c := !lt0_c + 1 in Float_ops.float_lt0 tm else Float_ops.float_lt0;; (* gt0 *) let float_gt0 = if !Arith_options.float_cached then fun tm -> let _ = gt0_c := !gt0_c + 1 in Float_ops.float_gt0 tm else Float_ops.float_gt0;; (* lt *) let float_lt = if !Arith_options.float_cached then fun tm1 tm2 -> let _ = lt_c := !lt_c + 1 in Float_ops.float_lt tm1 tm2 else Float_ops.float_lt;; (* le0 *) let float_le0 = if !Arith_options.float_cached then fun tm -> let _ = le0_c := !le0_c + 1 in Float_ops.float_le0 tm else Float_ops.float_le0;; (* ge0 *) let float_ge0 = if !Arith_options.float_cached then fun tm -> let _ = ge0_c := !ge0_c + 1 in Float_ops.float_ge0 tm else Float_ops.float_ge0;; (* min *) let float_min = if !Arith_options.float_cached then fun tm1 tm2 -> let _ = min_c := !min_c + 1 in Float_ops.float_min tm1 tm2 else Float_ops.float_min;; (* min_max *) let float_min_max = if !Arith_options.float_cached then fun tm1 tm2 -> let _ = min_max_c := !min_max_c + 1 in Float_ops.float_min_max tm1 tm2 else Float_ops.float_min_max;; (***************) let float_hash tm = let s, n_tm, e_tm = dest_float tm in s ^ (Arith_cache.num_tm_hash n_tm) ^ "e" ^ (Arith_cache.num_tm_hash e_tm);; let float_op_hash pp tm1 tm2 = string_of_int pp ^ float_hash tm1 ^ "x" ^ float_hash tm2;; let float_op_hash1 pp tm = string_of_int pp ^ float_hash tm;; (* le *) let float_le = if !Arith_options.float_cached then fun tm1 tm2 -> let _ = le_c := !le_c + 1 in let hash = float_op_hash 0 tm1 tm2 in try Hashtbl.find le_table hash with Not_found -> let result = Float_ops.float_le tm1 tm2 in let _ = my_add le_table hash result in result else Float_ops.float_le;; (* max *) let float_max = if !Arith_options.float_cached then fun tm1 tm2 -> let _ = max_c := !max_c + 1 in let hash = float_op_hash 0 tm1 tm2 in try Hashtbl.find max_table hash with Not_found -> let result = Float_ops.float_max tm1 tm2 in let _ = my_add max_table hash result in result else Float_ops.float_max;; (* mul_eq *) let float_mul_eq = Float_ops.float_mul_eq;; (* mul_lo *) let float_mul_lo = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = mul_lo_c := !mul_lo_c + 1 in let hash = "lo" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find mul_table hash with Not_found -> let result = Float_ops.float_mul_lo pp tm1 tm2 in let _ = my_add mul_table hash result in result else Float_ops.float_mul_lo;; (* mul_hi *) let float_mul_hi = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = mul_hi_c := !mul_hi_c + 1 in let hash = "hi" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find mul_table hash with Not_found -> let result = Float_ops.float_mul_hi pp tm1 tm2 in let _ = my_add mul_table hash result in result else Float_ops.float_mul_hi;; (* div_lo *) let float_div_lo = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = div_lo_c := !div_lo_c + 1 in let hash = "lo" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find div_table hash with Not_found -> let result = Float_ops.float_div_lo pp tm1 tm2 in let _ = my_add div_table hash result in result else Float_ops.float_div_lo;; (* div_hi *) let float_div_hi = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = div_hi_c := !div_hi_c + 1 in let hash = "hi" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find div_table hash with Not_found -> let result = Float_ops.float_div_hi pp tm1 tm2 in let _ = my_add div_table hash result in result else Float_ops.float_div_hi;; (* add_lo *) let float_add_lo = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = add_lo_c := !add_lo_c + 1 in let hash = "lo" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find add_table hash with Not_found -> let result = Float_ops.float_add_lo pp tm1 tm2 in let _ = my_add add_table hash result in result else Float_ops.float_add_lo;; (* add_hi *) let float_add_hi = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = add_hi_c := !add_hi_c + 1 in let hash = "hi" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find add_table hash with Not_found -> let result = Float_ops.float_add_hi pp tm1 tm2 in let _ = my_add add_table hash result in result else Float_ops.float_add_hi;; (* sub_lo *) let float_sub_lo = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = sub_lo_c := !sub_lo_c + 1 in let hash = "lo" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find sub_table hash with Not_found -> let result = Float_ops.float_sub_lo pp tm1 tm2 in let _ = my_add sub_table hash result in result else Float_ops.float_sub_lo;; (* sub_hi *) let float_sub_hi = if !Arith_options.float_cached then fun pp tm1 tm2 -> let _ = sub_hi_c := !sub_hi_c + 1 in let hash = "hi" ^ float_op_hash pp tm1 tm2 in try Hashtbl.find sub_table hash with Not_found -> let result = Float_ops.float_sub_hi pp tm1 tm2 in let _ = my_add sub_table hash result in result else Float_ops.float_sub_hi;; (* sqrt_lo *) let float_sqrt_lo = if !Arith_options.float_cached then fun pp tm -> let _ = sqrt_lo_c := !sqrt_lo_c + 1 in let hash = "lo" ^ float_op_hash1 pp tm in try Hashtbl.find sqrt_table hash with Not_found -> let result = Float_ops.float_sqrt_lo pp tm in let _ = my_add sqrt_table hash result in result else Float_ops.float_sqrt_lo;; (* sqrt_hi *) let float_sqrt_hi = if !Arith_options.float_cached then fun pp tm -> let _ = sqrt_hi_c := !sqrt_hi_c + 1 in let hash = "hi" ^ float_op_hash1 pp tm in try Hashtbl.find sqrt_table hash with Not_found -> let result = Float_ops.float_sqrt_hi pp tm in let _ = my_add sqrt_table hash result in result else Float_ops.float_sqrt_hi;; (******************************************) (* float intervals *) let FLOAT_OF_NUM' = (SPEC_ALL o REWRITE_RULE[min_exp_def]) FLOAT_OF_NUM;; let FLOAT_INTERVAL_OF_NUM = (NUMERALS_TO_NUM o REWRITE_RULE[min_exp_def] o prove)(`interval_arith (&n) (float_num F n min_exp, float_num F n min_exp)`, REWRITE_TAC[FLOAT_OF_NUM; CONST_INTERVAL]);; let FLOAT_F_bound' = (UNDISCH_ALL o SPEC_ALL) FLOAT_F_bound;; let FLOAT_T_bound' = (UNDISCH_ALL o SPEC_ALL) FLOAT_T_bound;; (* interval_arith x (float_num s1 n1 e1, float_num s2 n2 e2) -> x, float_num s1 n1 e1, float_num s2 n2 e2 *) let dest_float_interval tm = let ltm, rtm = dest_comb tm in let f1, f2 = dest_pair rtm in rand ltm, f1, f2;; let mk_float_interval_small_num n = let n_tm0 = mk_small_numeral n in let n_th = NUMERAL_TO_NUM_CONV n_tm0 in let n_tm = rand(rand(concl n_th)) in let n_th1 = TRANS n_th (INST[n_tm, n_var_num] NUM_REMOVE) in let th1 = AP_TERM amp_op_real n_th1 in let int_th = INST[n_tm, n_var_num] FLOAT_INTERVAL_OF_NUM in let rtm = rand(concl int_th) in EQ_MP (SYM (AP_THM (AP_TERM interval_const th1) rtm)) int_th;; let mk_float_interval_num n = let n_tm0 = mk_numeral n in let n_th = NUMERAL_TO_NUM_CONV n_tm0 in let n_tm = rand(rand(concl n_th)) in let n_th1 = TRANS n_th (INST[n_tm, n_var_num] NUM_REMOVE) in let th1 = AP_TERM amp_op_real n_th1 in let int_th = INST[n_tm, n_var_num] FLOAT_INTERVAL_OF_NUM in let rtm = rand(concl int_th) in EQ_MP (SYM (AP_THM (AP_TERM interval_const th1) rtm)) int_th;; (* Returns the lower bound for the given float *) let float_lo p tm = let s, n_tm, e_tm = dest_float tm in if s = "F" then let num_exp_tm = mk_num_exp n_tm e_tm in let th0 = num_exp_lo p num_exp_tm in let ltm, e1_tm = dest_comb(lhand(concl th0)) in let n1_tm = rand ltm in let th1 = INST[n1_tm, n1_var_num; e1_tm, e1_var_num; n_tm, n2_var_num; e_tm, e2_var_num] FLOAT_F_bound' in MY_PROVE_HYP th0 th1 else let num_exp_tm = mk_num_exp n_tm e_tm in let th0 = num_exp_hi p num_exp_tm in let ltm, e1_tm = dest_comb(rand(concl th0)) in let n1_tm = rand ltm in let th1 = INST[n_tm, n1_var_num; e_tm, e1_var_num; n1_tm, n2_var_num; e1_tm, e2_var_num] FLOAT_T_bound' in MY_PROVE_HYP th0 th1;; (* Returns the upper bound for the given float *) let float_hi p tm = let s, n_tm, e_tm = dest_float tm in if s = "F" then let num_exp_tm = mk_num_exp n_tm e_tm in let th0 = num_exp_hi p num_exp_tm in let ltm, e2_tm = dest_comb(rand(concl th0)) in let n2_tm = rand ltm in let th1 = INST[n_tm, n1_var_num; e_tm, e1_var_num; n2_tm, n2_var_num; e2_tm, e2_var_num] FLOAT_F_bound' in MY_PROVE_HYP th0 th1 else let num_exp_tm = mk_num_exp n_tm e_tm in let th0 = num_exp_lo p num_exp_tm in let ltm, e1_tm = dest_comb(lhand(concl th0)) in let n1_tm = rand ltm in let th1 = INST[n1_tm, n1_var_num; e1_tm, e1_var_num; n_tm, n2_var_num; e_tm, e2_var_num] FLOAT_T_bound' in MY_PROVE_HYP th0 th1;; (* Approximates the given interval with p-digits floating point numbers *) let float_interval_round p th = let x_tm, f1, f2 = dest_float_interval (concl th) in let lo_th = float_lo p f1 in let hi_th = float_hi p f2 in let lo_tm = lhand(concl lo_th) in let hi_tm = rand(concl hi_th) in let th0 = INST[x_tm, x_var_real; f1, lo_var_real; f2, hi_var_real; lo_tm, a_var_real; hi_tm, b_var_real] APPROX_INTERVAL' in MY_PROVE_HYP lo_th (MY_PROVE_HYP hi_th (MY_PROVE_HYP th th0));; (****************************************) (* float_interval_lt *) let FLOAT_INTERVAL_LT = prove(`interval_arith x (lo1, hi1) /\ interval_arith y (lo2, hi2) /\ hi1 < lo2 ==> x < y`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; (****************************************) (* float_interval_neg *) let FLOAT_INTERVAL_NEG = prove(`!s1 s2. interval_arith x (float_num s1 n1 e1, float_num s2 n2 e2) ==> interval_arith (--x) (float_num (~s2) n2 e2, float_num (~s1) n1 e1)`, REPEAT GEN_TAC THEN DISCH_THEN (fun th -> MP_TAC (MATCH_MP INTERVAL_NEG th)) THEN SIMP_TAC[FLOAT_NEG]);; let FLOAT_INTERVAL_NEG_FF = (UNDISCH_ALL o REWRITE_RULE[] o SPECL[`F`; `F`]) FLOAT_INTERVAL_NEG;; let FLOAT_INTERVAL_NEG_FT = (UNDISCH_ALL o REWRITE_RULE[] o SPECL[`F`; `T`]) FLOAT_INTERVAL_NEG;; let FLOAT_INTERVAL_NEG_TF = (UNDISCH_ALL o REWRITE_RULE[] o SPECL[`T`; `F`]) FLOAT_INTERVAL_NEG;; let FLOAT_INTERVAL_NEG_TT = (UNDISCH_ALL o REWRITE_RULE[] o SPECL[`T`; `T`]) FLOAT_INTERVAL_NEG;; (* |- interval x (float s1 n1 e1, float s2 n2 e2) -> |- interval (--x) (float ~s2 n2 e2, float ~s1 n1 e1 *) let float_interval_neg th = let x_tm, f1, f2 = dest_float_interval (concl th) in let s1, n1_tm, e1_tm = dest_float f1 in let s2, n2_tm, e2_tm = dest_float f2 in let inst = INST[x_tm, x_var_real; n1_tm, n1_var_num; e1_tm, e1_var_num; n2_tm, n2_var_num; e2_tm, e2_var_num] in let th0 = if s1 = "F" then if s2 = "F" then inst FLOAT_INTERVAL_NEG_FF else inst FLOAT_INTERVAL_NEG_FT else if s2 = "F" then inst FLOAT_INTERVAL_NEG_TF else inst FLOAT_INTERVAL_NEG_TT in MY_PROVE_HYP th th0;; (***********************************************) (* float_interval_mul *) let f1_1_var = `f1_1:real` and f1_2_var = `f1_2:real` and f2_1_var = `f2_1:real` and f2_2_var = `f2_2:real`;; let FLOAT_INTERVAL_FT_IMP_0 = prove(`interval_arith x (float_num F n1 e1, float_num T n2 e2) ==> x = &0`, REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [ EXISTS_TAC `float_num T n2 e2` THEN ASM_REWRITE_TAC[FLOAT_T_NEG]; EXISTS_TAC `float_num F n1 e1` THEN ASM_REWRITE_TAC[FLOAT_F_POS] ]);; (* FT_xx *) let FLOAT_INTERVAL_MUL_FT_xx = (UNDISCH_ALL o NUMERALS_TO_NUM o REWRITE_RULE[GSYM IMP_IMP; min_exp_def] o prove)( `interval_arith x (float_num F n1 e1, float_num T n2 e2) ==> interval_arith (x * y) (float_num F 0 min_exp, float_num F 0 min_exp)`, STRIP_TAC THEN FIRST_X_ASSUM (fun th -> REWRITE_TAC[MATCH_MP FLOAT_INTERVAL_FT_IMP_0 th]) THEN REWRITE_TAC[REAL_MUL_LZERO; interval_arith] THEN MP_TAC (GEN_ALL (SPECL [`s:bool`; `0`] FLOAT_EQ_0)) THEN SIMP_TAC[REAL_LE_REFL]);; (* xx_FT *) let FLOAT_INTERVAL_MUL_xx_FT = (UNDISCH_ALL o NUMERALS_TO_NUM o REWRITE_RULE[GSYM IMP_IMP; min_exp_def] o prove)( `interval_arith y (float_num F m1 r1, float_num T m2 r2) ==> interval_arith (x * y) (float_num F 0 min_exp, float_num F 0 min_exp)`, STRIP_TAC THEN FIRST_X_ASSUM (fun th -> REWRITE_TAC[MATCH_MP FLOAT_INTERVAL_FT_IMP_0 th]) THEN REWRITE_TAC[REAL_MUL_RZERO; interval_arith] THEN MP_TAC (GEN_ALL (SPECL [`s:bool`; `0`] FLOAT_EQ_0)) THEN SIMP_TAC[REAL_LE_REFL]);; (* FF_FF *) let FLOAT_INTERVAL_MUL_FF_FF = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num F n1 e1, float_num F n2 e2) /\ interval_arith y (float_num F m1 r1, float_num F m2 r2) /\ f1 <= float_num F n1 e1 * float_num F m1 r1 /\ float_num F n2 e2 * float_num F m2 r2 <= f2 ==> interval_arith (x * y) (f1, f2)`, MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` MP_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN REPEAT (POP_ASSUM (fun th -> ALL_TAC)) THEN REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * c:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * d:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [ EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] ] ]);; (* TT_TT *) let FLOAT_INTERVAL_MUL_TT_TT = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num T n1 e1, float_num T n2 e2) /\ interval_arith y (float_num T m1 r1, float_num T m2 r2) /\ f1 <= float_num T n2 e2 * float_num T m2 r2 /\ float_num T n1 e1 * float_num T m1 r1 <= f2 ==> interval_arith (x * y) (f1, f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[interval_arith] THEN MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` MP_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN REWRITE_TAC[REAL_NEG_MUL2] THEN REPEAT STRIP_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * d:real` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= x * y <=> a <= --x * --y`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `b <= --x <=> x <= --b`] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * c:real` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * y <= a <=> --x * --y <= a`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--x <= c <=> --c <= x`] THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC (REAL_ARITH `!b x. &0 <= b /\ x <= --b ==> &0 <= --x`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THENL [ EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] ] ]);; (* FF_TT *) let FLOAT_INTERVAL_MUL_FF_TT = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num F n1 e1, float_num F n2 e2) /\ interval_arith y (float_num T m1 r1, float_num T m2 r2) /\ f1 <= float_num F n2 e2 * float_num T m1 r1 /\ float_num F n1 e1 * float_num T m2 r2 <= f2 ==> interval_arith (x * y) (f1, f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[interval_arith] THEN MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` MP_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN REPEAT STRIP_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * --c` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `b * --c <= x * y <=> x * --y <= b * c`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--y <= c <=> --c <= y`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [ EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `d:real` THEN ONCE_REWRITE_TAC[REAL_ARITH `d <= --y <=> y <= --d`] THEN ASM_REWRITE_TAC[] ]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * --d` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * y <= a * --d <=> a * d <= x * --y`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `d <= --y <=> y <= --d`] THEN ASM_REWRITE_TAC[] ]);; (* TT_FF *) let FLOAT_INTERVAL_MUL_TT_FF = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num T n1 e1, float_num T n2 e2) /\ interval_arith y (float_num F m1 r1, float_num F m2 r2) /\ f1 <= float_num T n1 e1 * float_num F m2 r2 /\ float_num T n2 e2 * float_num F m1 r1 <= f2 ==> interval_arith (x * y) (f1, f2)`, STRIP_TAC THEN MP_TAC ((GEN_ALL o DISCH_ALL) FLOAT_INTERVAL_MUL_FF_TT) THEN DISCH_THEN (MP_TAC o SPECL[`n1:num`; `e1:num`; `n2:num`; `e2:num`; `m1:num`; `r1:num`; `m2:num`; `r2:num`]) THEN DISCH_THEN (MP_TAC o SPECL[`y:real`; `x:real`; `f1:real`; `f2:real`]) THEN REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC[REAL_MUL_AC]);; (* TF_FF *) let FLOAT_INTERVAL_MUL_TF_FF = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num T n1 e1, float_num F n2 e2) /\ interval_arith y (float_num F m1 r1, float_num F m2 r2) /\ f1 <= float_num T n1 e1 * float_num F m2 r2 /\ float_num F n2 e2 * float_num F m2 r2 <= f2 ==> interval_arith (x * y) (f1, f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[interval_arith] THEN MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` ASSUME_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN SUBGOAL_THEN `&0 <= y` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN CONJ_TAC THENL [ DISJ_CASES_TAC (REAL_ARITH `&0 <= x \/ &0 <= --x`) THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * d` THEN ASM_REWRITE_TAC[REAL_ARITH `--a * d <= &0 <=> &0 <= a * d`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] ]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * d` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `--a * d <= x * y <=> --x * y <= a * d`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--x <= a <=> --a <= x`] THEN ASM_REWRITE_TAC[]; DISJ_CASES_TAC (REAL_ARITH `&0 <= --x \/ &0 <= x`) THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `x * y <= &0 <=> &0 <= --x * y`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * d` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] ]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * d` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] ]);; (* TF_TT *) let FLOAT_INTERVAL_MUL_TF_TT = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num T n1 e1, float_num F n2 e2) /\ interval_arith y (float_num T m1 r1, float_num T m2 r2) /\ f1 <= float_num F n2 e2 * float_num T m1 r1 /\ float_num T n1 e1 * float_num T m1 r1 <= f2 ==> interval_arith (x * y) (f1, f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[interval_arith] THEN MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` ASSUME_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN SUBGOAL_THEN `&0 <= --y` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `d:real` THEN ONCE_REWRITE_TAC[REAL_ARITH `d <= --y <=> y <= --d`] THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN CONJ_TAC THENL [ DISJ_CASES_TAC (REAL_ARITH `&0 <= --x \/ &0 <= x`) THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * --c` THEN ASM_REWRITE_TAC[REAL_ARITH `b * --c <= &0 <=> &0 <= b * c`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[REAL_ARITH `x * y = --x * --y`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] ]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * --c` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `b * --c <= x * y <=> x * --y <= b * c`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--y <= c <=> --c <= y`] THEN ASM_REWRITE_TAC[]; DISJ_CASES_TAC (REAL_ARITH `&0 <= x \/ &0 <= --x`) THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `x * y <= &0 <=> &0 <= x * --y`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * --c` THEN ASM_REWRITE_TAC[REAL_NEG_MUL2] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] ]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * --c` THEN ASM_REWRITE_TAC[REAL_NEG_MUL2] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * y <= a * c <=> --x * --y <= a * c`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--x <= a <=> --a <= x`] THEN ASM_REWRITE_TAC[] ]);; (* FF_TF *) let FLOAT_INTERVAL_MUL_FF_TF = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num F n1 e1, float_num F n2 e2) /\ interval_arith y (float_num T m1 r1, float_num F m2 r2) /\ f1 <= float_num F n2 e2 * float_num T m1 r1 /\ float_num F n2 e2 * float_num F m2 r2 <= f2 ==> interval_arith (x * y) (f1, f2)`, STRIP_TAC THEN MP_TAC ((SPECL [`n1:num`; `e1:num`; `n2:num`; `e2:num`; `m1:num`; `r1:num`; `m2:num`; `r2:num`; `y:real`; `x:real`; `f1:real`; `f2:real`] o GEN_ALL o DISCH_ALL) FLOAT_INTERVAL_MUL_TF_FF) THEN ASM_REWRITE_TAC[REAL_MUL_SYM] THEN DISCH_THEN MATCH_MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; (* TT_TF *) let FLOAT_INTERVAL_MUL_TT_TF = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num T n1 e1, float_num T n2 e2) /\ interval_arith y (float_num T m1 r1, float_num F m2 r2) /\ f1 <= float_num T n1 e1 * float_num F m2 r2 /\ float_num T n1 e1 * float_num T m1 r1 <= f2 ==> interval_arith (x * y) (f1, f2)`, STRIP_TAC THEN MP_TAC ((SPECL [`n1:num`; `e1:num`; `n2:num`; `e2:num`; `m1:num`; `r1:num`; `m2:num`; `r2:num`; `y:real`; `x:real`; `f1:real`; `f2:real`] o GEN_ALL o DISCH_ALL) FLOAT_INTERVAL_MUL_TF_TT) THEN ASM_REWRITE_TAC[REAL_MUL_SYM] THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN SIMP_TAC[REAL_MUL_SYM]);; (* TF_TF *) let FLOAT_INTERVAL_MUL_TF_TF = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (float_num T n1 e1, float_num F n2 e2) /\ interval_arith y (float_num T m1 r1, float_num F m2 r2) /\ f1_1 <= float_num T n1 e1 * float_num F m2 r2 /\ f1_2 <= float_num F n2 e2 * float_num T m1 r1 /\ min f1_1 f1_2 = f1 /\ float_num T n1 e1 * float_num T m1 r1 <= f2_1 /\ float_num F n2 e2 * float_num F m2 r2 <= f2_2 /\ max f2_1 f2_2 = f2 ==> interval_arith (x * y) (f1, f2)`, REWRITE_TAC[EQ_SYM_EQ; FLOAT_NEG_T] THEN REWRITE_TAC[interval_arith] THEN MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` ASSUME_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN DISJ_CASES_TAC (REAL_ARITH `&0 <= x \/ &0 <= --x`) THENL [ DISJ_CASES_TAC (REAL_ARITH `&0 <= y \/ &0 <= --y`) THENL [ CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f1_1:real` THEN ASM_REWRITE_TAC[REAL_MIN_MIN] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * d` THEN ASM_REWRITE_TAC[REAL_ARITH `--a * d <= &0 <=> &0 <= a * d`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * d` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f2_2:real` THEN ASM_REWRITE_TAC[REAL_MAX_MAX]; ALL_TAC ] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f1_2:real` THEN ASM_REWRITE_TAC[REAL_MIN_MIN] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * --c` THEN ONCE_REWRITE_TAC[REAL_ARITH `b * --c <= x * y <=> x * --y <= b * c`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--y <= c <=> --c <= y`] THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `x * y <= &0 <=> &0 <= x * --y`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f2_2:real` THEN ASM_REWRITE_TAC[REAL_MAX_MAX] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * d` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN DISJ_CASES_TAC (REAL_ARITH `&0 <= y \/ &0 <= --y`) THENL [ CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f1_1:real` THEN ASM_REWRITE_TAC[REAL_MIN_MIN] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * d` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `--a * d <= x * y <=> --x * y <= a * d`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--x <= a <=> --a <= x`] THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ARITH `x * y <= &0 <=> &0 <= --x * y`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f2_2:real` THEN ASM_REWRITE_TAC[REAL_MAX_MAX] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * d` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f1_1:real` THEN ASM_REWRITE_TAC[REAL_MIN_MIN] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * d` THEN ASM_REWRITE_TAC[REAL_ARITH `--a * d <= &0 <=> &0 <= a * d`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_MUL2] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a * --c` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_NEG_MUL2] THEN REWRITE_TAC[REAL_NEG_NEG] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC[REAL_ARITH `--x <= a <=> --a <= x`] THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f2_1:real` THEN ASM_REWRITE_TAC[REAL_MAX_MAX]);; (****************************) let float_interval_mul = let mul_ft_xx th1 x y n1 e1 n2 e2 = let th0 = INST[x, x_var_real; y, y_var_real; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] FLOAT_INTERVAL_MUL_FT_xx in MY_PROVE_HYP th1 th0 in let mul_xx_ft th2 x y m1 r1 m2 r2 = let th0 = INST[x, x_var_real; y, y_var_real; m1, m1_var_num; r1, r1_var_num; m2, m2_var_num; r2, r2_var_num] FLOAT_INTERVAL_MUL_xx_FT in MY_PROVE_HYP th2 th0 in fun pp th1 th2 -> let x, l_lo, l_hi = dest_float_interval (concl th1) and y, r_lo, r_hi = dest_float_interval (concl th2) in let s1, n1, e1 = dest_float l_lo and s2, n2, e2 = dest_float l_hi and s3, m1, r1 = dest_float r_lo and s4, m2, r2 = dest_float r_hi in (* Special case 1 *) if s1 <> s2 && s1 = "F" then mul_ft_xx th1 x y n1 e1 n2 e2 else if s3 <> s4 && s3 = "F" then mul_xx_ft th2 x y m1 r1 m2 r2 else (* Special case 2 *) if s1 <> s2 && s3 <> s4 then let lo1, lo2 = float_mul_lo pp l_lo r_hi, float_mul_lo pp l_hi r_lo and hi1, hi2 = float_mul_hi pp l_lo r_lo, float_mul_hi pp l_hi r_hi in let f1_1 = (lhand o concl) lo1 and f1_2 = (lhand o concl) lo2 and f2_1 = (rand o concl) hi1 and f2_2 = (rand o concl) hi2 in let min_th = float_min f1_1 f1_2 and max_th = float_max f2_1 f2_2 in let f1_tm = (rand o concl) min_th and f2_tm = (rand o concl) max_th in let th0 = INST[x, x_var_real; n1, n1_var_num; e1, e1_var_num; y, y_var_real; n2, n2_var_num; e2, e2_var_num; m1, m1_var_num; r1, r1_var_num; m2, m2_var_num; r2, r2_var_num; f1_tm, f1_var_real; f2_tm, f2_var_real; f1_1, f1_1_var; f1_2, f1_2_var; f2_1, f2_1_var; f2_2, f2_2_var] FLOAT_INTERVAL_MUL_TF_TF in (MY_PROVE_HYP min_th o MY_PROVE_HYP max_th o MY_PROVE_HYP lo1 o MY_PROVE_HYP lo2 o MY_PROVE_HYP hi1 o MY_PROVE_HYP hi2 o MY_PROVE_HYP th1 o MY_PROVE_HYP th2) th0 else let lo_th, hi_th, th0 = if s1 <> s2 then if s3 = "F" then float_mul_lo pp l_lo r_hi, float_mul_hi pp l_hi r_hi, FLOAT_INTERVAL_MUL_TF_FF else float_mul_lo pp l_hi r_lo, float_mul_hi pp l_lo r_lo, FLOAT_INTERVAL_MUL_TF_TT else if s3 <> s4 then if s1 = "F" then float_mul_lo pp l_hi r_lo, float_mul_hi pp l_hi r_hi, FLOAT_INTERVAL_MUL_FF_TF else float_mul_lo pp l_lo r_hi, float_mul_hi pp l_lo r_lo, FLOAT_INTERVAL_MUL_TT_TF else if s1 = "F" then if s3 = "F" then float_mul_lo pp l_lo r_lo, float_mul_hi pp l_hi r_hi, FLOAT_INTERVAL_MUL_FF_FF else float_mul_lo pp l_hi r_lo, float_mul_hi pp l_lo r_hi, FLOAT_INTERVAL_MUL_FF_TT else if s3 = "F" then float_mul_lo pp l_lo r_hi, float_mul_hi pp l_hi r_lo, FLOAT_INTERVAL_MUL_TT_FF else float_mul_lo pp l_hi r_hi, float_mul_hi pp l_lo r_lo, FLOAT_INTERVAL_MUL_TT_TT in let f1_tm = lhand(concl lo_th) and f2_tm = rand(concl hi_th) in let th = INST[x, x_var_real; n1, n1_var_num; e1, e1_var_num; y, y_var_real; n2, n2_var_num; e2, e2_var_num; m1, m1_var_num; r1, r1_var_num; m2, m2_var_num; r2, r2_var_num; f1_tm, f1_var_real; f2_tm, f2_var_real] th0 in MY_PROVE_HYP lo_th (MY_PROVE_HYP hi_th (MY_PROVE_HYP th1 (MY_PROVE_HYP th2 th)));; (*************************************) (* float_interval_div *) (* FT_xx *) let FLOAT_INTERVAL_DIV_FT_xx = prove( `interval_arith x (float_num F n1 e1, float_num T n2 e2) ==> interval_arith (x / y) (float_num F 0 min_exp, float_num F 0 min_exp)`, REWRITE_TAC[real_div] THEN DISCH_THEN (MP_TAC o MATCH_MP FLOAT_INTERVAL_FT_IMP_0) THEN SIMP_TAC[REAL_MUL_LZERO; interval_arith] THEN MP_TAC (GEN_ALL (SPECL [`s:bool`; `0`] FLOAT_EQ_0)) THEN SIMP_TAC[REAL_LE_REFL]);; (* FF_FF *) let FLOAT_INTERVAL_DIV_FF_FF = prove( `~(m1 = 0) /\ interval_arith x (float_num F n1 e1, float_num F n2 e2) /\ interval_arith y (float_num F m1 r1, float_num F m2 r2) /\ f1 <= float_num F n1 e1 / float_num F m2 r2 /\ float_num F n2 e2 / float_num F m1 r1 <= f2 ==> interval_arith (x / y) (f1, f2)`, MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN REWRITE_TAC[real_div] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` MP_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN SUBGOAL_THEN `~(c = &0)` ASSUME_TAC THENL [ EXPAND_TAC "c" THEN ASM_REWRITE_TAC[FLOAT_EQ_0]; ALL_TAC ] THEN STRIP_TAC THEN SUBGOAL_THEN `~(d = &0)` MP_TAC THENL [ MATCH_MP_TAC (REAL_ARITH `~(c = &0) /\ &0 <= c /\ c <= d ==> ~(d = &0)`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `interval_arith y (c,d)` THEN REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC; ALL_TAC ] THEN REPLICATE_TAC 10 (POP_ASSUM MP_TAC) THEN REPEAT (POP_ASSUM (fun th -> ALL_TAC)) THEN REWRITE_TAC[interval_arith] THEN REPEAT STRIP_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * inv d` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < c <=> ~(c = &0) /\ &0 <= c`]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * inv c` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN REPEAT CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < c <=> ~(c = &0) /\ &0 <= c`] ]);; (* TT_TT *) let FLOAT_INTERVAL_DIV_TT_TT = prove( `~(m2 = 0) /\ interval_arith x (float_num T n1 e1, float_num T n2 e2) /\ interval_arith y (float_num T m1 r1, float_num T m2 r2) /\ f1 <= float_num T n2 e2 / float_num T m1 r1 /\ float_num T n1 e1 / float_num T m2 r2 <= f2 ==> interval_arith (x / y) (f1,f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_NEG_MUL2] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[interval_arith] THEN REWRITE_TAC[REAL_ARITH `--a <= x /\ x <= --b <=> b <= --x /\ --x <= a`] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[GSYM interval_arith] THEN STRIP_TAC THEN MP_TAC ((SPECL[`n2:num`; `e2:num`; `m1:num`; `r1:num`; `n1:num`; `e1:num`; `m2:num`; `r2:num`; `--x`; `--y`] o GEN_ALL) FLOAT_INTERVAL_DIV_FF_FF) THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_NEG_MUL2] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; (* FF_TT *) let FLOAT_INTERVAL_DIV_FF_TT = prove( `~(m2 = 0) /\ interval_arith x (float_num F n1 e1, float_num F n2 e2) /\ interval_arith y (float_num T m1 r1, float_num T m2 r2) /\ f1 <= float_num F n2 e2 / float_num T m2 r2 /\ float_num F n1 e1 / float_num T m1 r1 <= f2 ==> interval_arith (x / y) (f1,f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REWRITE_TAC[REAL_ARITH `a * --b <= c <=> --c <= a * b`] THEN REWRITE_TAC[REAL_ARITH `c <= a * --b <=> a * b <= --c`] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[interval_arith] THEN REWRITE_TAC[REAL_ARITH `--a <= x /\ x <= --b <=> b <= --x /\ --x <= a`] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[GSYM interval_arith] THEN STRIP_TAC THEN MP_TAC ((SPECL[`n1:num`; `e1:num`; `m1:num`; `r1:num`; `n2:num`; `e2:num`; `m2:num`; `r2:num`; `x:real`; `--y`; `--f2`; `--f1`] o GEN_ALL) FLOAT_INTERVAL_DIV_FF_FF) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[real_div]; ALL_TAC ] THEN REWRITE_TAC[real_div; REAL_INV_NEG; interval_arith] THEN REAL_ARITH_TAC);; (* TT_FF *) let FLOAT_INTERVAL_DIV_TT_FF = prove( `~(m1 = 0) /\ interval_arith x (float_num T n1 e1, float_num T n2 e2) /\ interval_arith y (float_num F m1 r1, float_num F m2 r2) /\ f1 <= float_num T n1 e1 / float_num F m1 r1 /\ float_num T n2 e2 / float_num F m2 r2 <= f2 ==> interval_arith (x / y) (f1,f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REWRITE_TAC[REAL_ARITH `--a * b <= c <=> --c <= a * b`] THEN REWRITE_TAC[REAL_ARITH `c <= --a * b <=> a * b <= --c`] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[interval_arith] THEN REWRITE_TAC[REAL_ARITH `--a <= x /\ x <= --b <=> b <= --x /\ --x <= a`] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[GSYM interval_arith] THEN STRIP_TAC THEN MP_TAC ((SPECL[`n2:num`; `e2:num`; `m2:num`; `r2:num`; `n1:num`; `e1:num`; `m1:num`; `r1:num`; `--x:real`; `y:real`; `--f2`; `--f1`] o GEN_ALL) FLOAT_INTERVAL_DIV_FF_FF) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[real_div]; ALL_TAC ] THEN REWRITE_TAC[real_div; REAL_INV_NEG; interval_arith] THEN REAL_ARITH_TAC);; let FLOAT_0 = prove(`!s e. float_num s 0 e = &0`, REWRITE_TAC[FLOAT_EQ_0]);; (* TF_FF *) let FLOAT_INTERVAL_DIV_TF_FF = prove( `~(m1 = 0) /\ interval_arith x (float_num T n1 e1, float_num F n2 e2) /\ interval_arith y (float_num F m1 r1, float_num F m2 r2) /\ f1 <= float_num T n1 e1 / float_num F m1 r1 /\ float_num F n2 e2 / float_num F m1 r1 <= f2 ==> interval_arith (x / y) (f1,f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` ASSUME_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN DISJ_CASES_TAC (REAL_ARITH `&0 <= x \/ x <= &0`) THENL [ SUBGOAL_THEN `interval_arith x (float_num F 0 0, b)` ASSUME_TAC THENL [ UNDISCH_TAC `interval_arith x (--a, b)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[interval_arith; FLOAT_0] THEN REAL_ARITH_TAC; ALL_TAC ] THEN MP_TAC ((SPEC_ALL o SPECL [`0`; `0`] o GEN_ALL) FLOAT_INTERVAL_DIV_FF_FF) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN REWRITE_TAC[real_div] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a / c` THEN ASM_REWRITE_TAC[real_div; ARITH_RULE `--a * b <= &0 <=> &0 <= a * b`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; FLOAT_F_POS]; ALL_TAC ] THEN SUBGOAL_THEN `interval_arith x (--a, float_num T 0 0)` ASSUME_TAC THENL [ UNDISCH_TAC `interval_arith x (--a, b)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[interval_arith; FLOAT_0] THEN REAL_ARITH_TAC; ALL_TAC ] THEN MP_TAC ((INST[`0`, `n2:num`; `0`, `e2:num`]) FLOAT_INTERVAL_DIV_TT_FF) THEN ASM_REWRITE_TAC[FLOAT_NEG_T] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM FLOAT_NEG_T] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN REWRITE_TAC[real_div] THEN CONJ_TAC THENL [ REWRITE_TAC[FLOAT_0; REAL_MUL_LZERO; REAL_LE_REFL]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b / c` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REWRITE_TAC[]);; (* TF_TT *) let FLOAT_INTERVAL_DIV_TF_TT = prove( `~(m2 = 0) /\ interval_arith x (float_num T n1 e1, float_num F n2 e2) /\ interval_arith y (float_num T m1 r1, float_num T m2 r2) /\ f1 <= float_num F n2 e2 / float_num T m2 r2 /\ float_num T n1 e1 / float_num T m2 r2 <= f2 ==> interval_arith (x / y) (f1,f2)`, REWRITE_TAC[FLOAT_NEG_T] THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`a = float_num F n1 e1`; `b = float_num F n2 e2`; `c = float_num F m1 r1`; `d = float_num F m2 r2`] THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 <= d` ASSUME_TAC THENL [ MAP_EVERY EXPAND_TAC ["a"; "b"; "c"; "d"] THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN DISJ_CASES_TAC (REAL_ARITH `x <= &0 \/ &0 <= x`) THENL [ SUBGOAL_THEN `interval_arith x (--a, float_num T 0 0)` ASSUME_TAC THENL [ UNDISCH_TAC `interval_arith x (--a, b)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[interval_arith; FLOAT_0] THEN REAL_ARITH_TAC; ALL_TAC ] THEN MP_TAC ((SPEC_ALL o SPECL [`0`; `0`] o GEN_ALL) FLOAT_INTERVAL_DIV_TT_TT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[FLOAT_NEG_T] THEN ASM_REWRITE_TAC[GSYM FLOAT_NEG_T] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN REWRITE_TAC[real_div] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b / --d` THEN ASM_REWRITE_TAC[real_div; REAL_INV_NEG; REAL_ARITH `b * --d <= &0 <=> &0 <= b * d`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ]; ALL_TAC ] THEN REWRITE_TAC[FLOAT_0; REAL_MUL_LZERO; REAL_LE_REFL]; ALL_TAC ] THEN SUBGOAL_THEN `interval_arith x (float_num F 0 0, b)` ASSUME_TAC THENL [ UNDISCH_TAC `interval_arith x (--a, b)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[interval_arith; FLOAT_0] THEN REAL_ARITH_TAC; ALL_TAC ] THEN MP_TAC ((INST[`0`, `n1:num`; `0`, `e1:num`]) FLOAT_INTERVAL_DIV_FF_TT) THEN ASM_REWRITE_TAC[FLOAT_NEG_T] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN REWRITE_TAC[real_div] THEN CONJ_TAC THENL [ REWRITE_TAC[FLOAT_0; REAL_MUL_LZERO; REAL_LE_REFL]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--a / --d` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_NEG_MUL2] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ]);; let transform = UNDISCH_ALL o PURE_REWRITE_RULE[TAUT `~P <=> (P <=> F)`] o NUMERALS_TO_NUM o REWRITE_RULE[GSYM IMP_IMP; min_exp_def];; let FLOAT_INTERVAL_DIV_FT_xx' = transform FLOAT_INTERVAL_DIV_FT_xx and FLOAT_INTERVAL_DIV_FF_FF' = transform FLOAT_INTERVAL_DIV_FF_FF and FLOAT_INTERVAL_DIV_TT_TT' = transform FLOAT_INTERVAL_DIV_TT_TT and FLOAT_INTERVAL_DIV_FF_TT' = transform FLOAT_INTERVAL_DIV_FF_TT and FLOAT_INTERVAL_DIV_TT_FF' = transform FLOAT_INTERVAL_DIV_TT_FF and FLOAT_INTERVAL_DIV_TF_FF' = transform FLOAT_INTERVAL_DIV_TF_FF and FLOAT_INTERVAL_DIV_TF_TT' = transform FLOAT_INTERVAL_DIV_TF_TT;; let float_interval_div pp th1 th2 = let x, l_lo, l_hi = dest_float_interval (concl th1) and y, r_lo, r_hi = dest_float_interval (concl th2) in let s1, n1, e1 = dest_float l_lo and s2, n2, e2 = dest_float l_hi and s3, m1, r1 = dest_float r_lo and s4, m2, r2 = dest_float r_hi in if s1 <> s2 && s1 = "F" then let th0 = INST[x, x_var_real; y, y_var_real; n1, n1_var_num; e1, e1_var_num; n2, n2_var_num; e2, e2_var_num] FLOAT_INTERVAL_DIV_FT_xx' in MY_PROVE_HYP th1 th0 else if s3 <> s4 then failwith "float_interval_div: division by an interval containing 0" else let lo_th, hi_th, th0, zero_th = if s1 = s2 then if s1 = "F" then if s3 = "F" then float_div_lo pp l_lo r_hi, float_div_hi pp l_hi r_lo, FLOAT_INTERVAL_DIV_FF_FF', raw_eq0_hash_conv m1 else float_div_lo pp l_hi r_hi, float_div_hi pp l_lo r_lo, FLOAT_INTERVAL_DIV_FF_TT', raw_eq0_hash_conv m2 else if s3 = "F" then float_div_lo pp l_lo r_lo, float_div_hi pp l_hi r_hi, FLOAT_INTERVAL_DIV_TT_FF', raw_eq0_hash_conv m1 else float_div_lo pp l_hi r_lo, float_div_hi pp l_lo r_hi, FLOAT_INTERVAL_DIV_TT_TT', raw_eq0_hash_conv m2 else if s3 = "F" then float_div_lo pp l_lo r_lo, float_div_hi pp l_hi r_lo, FLOAT_INTERVAL_DIV_TF_FF', raw_eq0_hash_conv m1 else float_div_lo pp l_hi r_hi, float_div_hi pp l_lo r_hi, FLOAT_INTERVAL_DIV_TF_TT', raw_eq0_hash_conv m2 in let f1_tm = lhand(concl lo_th) and f2_tm = rand(concl hi_th) in let th = INST[x, x_var_real; n1, n1_var_num; e1, e1_var_num; y, y_var_real; n2, n2_var_num; e2, e2_var_num; m1, m1_var_num; r1, r1_var_num; m2, m2_var_num; r2, r2_var_num; f1_tm, f1_var_real; f2_tm, f2_var_real] th0 in (MY_PROVE_HYP lo_th o MY_PROVE_HYP hi_th o MY_PROVE_HYP th1 o MY_PROVE_HYP th2 o MY_PROVE_HYP zero_th) th;; (*****************************************) (* float_interval_add, float_interval_sub *) let n1_var_real = `n1:real` and n2_var_real = `n2:real` and m1_var_real = `m1:real` and m2_var_real = `m2:real` and n_var_real = `n:real` and m_var_real = `m:real`;; let INTERVAL_ADD = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (n1, m1) /\ interval_arith y (n2, m2) /\ n <= n1 + n2 /\ m1 + m2 <= m ==> interval_arith (x + y) (n, m)`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; let INTERVAL_SUB = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove)( `interval_arith x (n1, m1) /\ interval_arith y (n2, m2) /\ n <= n1 - m2 /\ m1 - n2 <= m ==> interval_arith (x - y) (n, m)`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; let float_interval_add pp th1 th2 = let x, n1, m1 = dest_float_interval (concl th1) in let y, n2, m2 = dest_float_interval (concl th2) in let lo_th = float_add_lo pp n1 n2 in let hi_th = float_add_hi pp m1 m2 in let n_tm = lhand (concl lo_th) in let m_tm = rand (concl hi_th) in let th0 = INST[x, x_var_real; n1, n1_var_real; m1, m1_var_real; y, y_var_real; n2, n2_var_real; m2, m2_var_real; n_tm, n_var_real; m_tm, m_var_real] INTERVAL_ADD in MY_PROVE_HYP lo_th (MY_PROVE_HYP hi_th (MY_PROVE_HYP th2 (MY_PROVE_HYP th1 th0)));; let float_interval_sub pp th1 th2 = let x, n1, m1 = dest_float_interval (concl th1) in let y, n2, m2 = dest_float_interval (concl th2) in let lo_th = float_sub_lo pp n1 m2 in let hi_th = float_sub_hi pp m1 n2 in let n_tm = lhand(concl lo_th) in let m_tm = rand(concl hi_th) in let th0 = INST[x, x_var_real; n1, n1_var_real; m1, m1_var_real; y, y_var_real; n2, n2_var_real; m2, m2_var_real; n_tm, n_var_real; m_tm, m_var_real] INTERVAL_SUB in MY_PROVE_HYP lo_th (MY_PROVE_HYP hi_th (MY_PROVE_HYP th2 (MY_PROVE_HYP th1 th0)));; (********************************************) (* FLOAT_ABS *) let s_var_bool = `s:bool`;; let FLOAT_ABS = prove(`abs (float_num s n e) = float_num F n e`, BOOL_CASES_TAC `s:bool` THEN REWRITE_TAC[FLOAT_NEG_T; REAL_ABS_NEG; REAL_ABS_REFL; FLOAT_F_POS]);; let float_abs tm = let ltm, rtm = dest_comb tm in if ((fst o dest_const) ltm <> "real_abs") then failwith "float_abs: no abs" else let ltm, e_tm = dest_comb rtm in let ltm, n_tm = dest_comb ltm in let s_tm = rand ltm in INST[s_tm, s_var_bool; n_tm, n_var_num; e_tm, e_var_num] FLOAT_ABS;; (*******************************) (* float_interval_sqrt *) let FLOAT_INTERVAL_SQRT = prove(`interval_arith x (float_num F n1 e1, hi) /\ f1 <= sqrt (float_num F n1 e1) /\ sqrt hi <= f2 ==> interval_arith (sqrt x) (f1, f2)`, ABBREV_TAC `lo = float_num F n1 e1` THEN REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= lo /\ &0 <= hi` ASSUME_TAC THENL [ EXPAND_TAC "lo" THEN REWRITE_TAC[FLOAT_F_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `lo:real` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "lo" THEN REWRITE_TAC[FLOAT_F_POS]; ALL_TAC ] THEN SUBGOAL_THEN `&0 <= x` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `lo:real` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sqrt lo` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SQRT_MONO_LE_COMPAT THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sqrt hi` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SQRT_MONO_LE_COMPAT THEN ASM_REWRITE_TAC[] ]);; let FLOAT_INTERVAL_SQRT' = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP]) FLOAT_INTERVAL_SQRT;; let float_interval_sqrt pp th = let x_tm, lo_tm, hi_tm = dest_float_interval (concl th) in let s1, n1_tm, e1_tm = dest_float lo_tm in if s1 <> "F" then failwith "float_interval_sqrt: negative low bound" else let lo_th = float_sqrt_lo pp lo_tm in let hi_th = float_sqrt_hi pp hi_tm in let f1_tm = lhand (concl lo_th) in let f2_tm = rand (concl hi_th) in let th0 = INST[x_tm, x_var_real; n1_tm, n1_var_num; e1_tm, e1_var_num; hi_tm, hi_var_real; f1_tm, f1_var_real; f2_tm, f2_var_real] FLOAT_INTERVAL_SQRT' in MY_PROVE_HYP lo_th (MY_PROVE_HYP hi_th (MY_PROVE_HYP th th0));; (******************************************) (* FLOAT_TO_NUM_CONV *) let FLOAT_TO_NUM_CONV tm = let ltm, e_tm = dest_comb tm in let f_tm, n_tm = dest_comb ltm in if (fst o dest_const o rator) f_tm <> "float_num" then failwith "FLOAT_TO_NUM_CONV" else let n_th' = SYM (INST[n_tm, n_var_num] Arith_hash.NUM_THM) in let e_th' = SYM (INST[e_tm, n_var_num] Arith_hash.NUM_THM) in let n_th = TRANS n_th' (NUM_TO_NUMERAL_CONV (mk_comb(Arith_hash.num_const, n_tm))) in let e_th = TRANS e_th' (NUM_TO_NUMERAL_CONV (mk_comb(Arith_hash.num_const, e_tm))) in let th0 = MK_COMB (AP_TERM f_tm n_th, e_th) in let tm0 = rand(concl th0) in let th1 = REWRITE_CONV[float; num_exp; REAL_MUL_LID; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; min_exp_def] tm0 in let th2 = REAL_RAT_REDUCE_CONV (rand(concl th1)) in TRANS th0 (TRANS th1 th2);; end;; (**************************************) (* Printer for floating-point numbers *) (**************************************) let print_float fmt tm = try let s, m_tm, e_tm = Arith_float.dest_float tm in let m = Arith_hash.raw_dest_hash m_tm and e = Arith_hash.raw_dest_hash e_tm -/ Num.num_of_int Float_theory.min_exp in let s_str = if s = "T" then "-" else "" in let m_str = Num.string_of_num m in let e_str = if e = num_0 then "" else "*" ^ string_of_int Arith_hash.arith_base ^ "^" ^ Num.string_of_num e in let str = "##" ^ s_str ^ m_str ^ e_str in pp_print_string fmt str with _ -> failwith "print_float";; install_user_printer ("float_num", print_float);; hol-light/Formal_ineqs/arith/float_atn.hl000066400000000000000000000545441303454263000210030ustar00rootroot00000000000000(* =========================================================== *) (* Formal arctangent and arccosine *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "Multivariate/realanalysis.ml";; needs "jordan/refinement.hl";; open Refinement;; needs "jordan/parse_ext_override_interface.hl";; needs "jordan/real_ext.hl";; prioritize_real();; needs "jordan/taylor_atn.hl";; needs "arith/float.hl";; needs "list/more_list.hl";; module type Float_atn_sig = sig val float_interval_pow_simple : int -> int -> thm -> thm val pi_approx_array : thm array val pi2_approx_array : thm array val float_interval_atn : int -> thm -> thm val float_interval_acs : int -> thm -> thm end;; module Float_atn : Float_atn_sig = struct open Arith_misc;; open Interval_arith;; open Float_theory;; open Arith_float;; open Taylor_atn;; open More_list;; (******************************) let x_var_real = `x:real` and n_var_num = `n:num` and e_var_num = `e:num` and a_var_real = `a:real` and b_var_real = `b:real` and d_var_real = `d:real` and hi_var_real = `hi:real` and lo_var_real = `lo:real`;; let add_op_real = `(+):real->real->real` and sub_op_real = `(-):real->real->real` and mul_op_real = `( * ):real->real->real` and div_op_real = `(/):real->real->real` and neg_op_real = `(--):real->real` and mul_op_num = `( * ):num->num->num` and add_op_num = `(+):num->num->num`;; (******************************) (* halfatn and halfatn4 *) let float_interval_1 = mk_float_interval_small_num 1;; let HALFATN' = (SYM o SPEC_ALL o REWRITE_RULE[REAL_POW_2]) halfatn;; let HALFATN4' = prove(`halfatn(halfatn(halfatn(halfatn x))) = halfatn4 x`, REWRITE_TAC[halfatn4; o_THM]);; let float_interval_halfatn pp x_th = let x_tm = (rand o rator o concl) x_th in let xx_th = float_interval_mul pp x_th x_th in let one_xx_th = float_interval_add pp float_interval_1 xx_th in let sqrt_th = float_interval_sqrt pp one_xx_th in let one_sqrt_th = float_interval_add pp sqrt_th float_interval_1 in let r_th = float_interval_div pp x_th one_sqrt_th in let th0 = INST[x_tm, x_var_real] HALFATN' in let ltm, rtm = dest_comb(concl r_th) in EQ_MP (AP_THM (AP_TERM (rator ltm) th0) rtm) r_th;; let float_interval_halfatn4 pp x_th = let x_tm = (rand o rator o concl) x_th in let r_th = float_interval_halfatn pp (float_interval_halfatn pp (float_interval_halfatn pp (float_interval_halfatn pp x_th))) in let th0 = INST[x_tm, x_var_real] HALFATN4' in let ltm, rtm = dest_comb(concl r_th) in EQ_MP (AP_THM (AP_TERM (rator ltm) th0) rtm) r_th;; (****************************************) let rec float_interval_calc pp expr x_th = if is_var expr then x_th else let ltm, r_tm = dest_comb expr in if is_comb ltm then let op, l_tm = dest_comb ltm in let l_th = float_interval_calc pp l_tm x_th in let r_th = float_interval_calc pp r_tm x_th in if op = add_op_real then float_interval_add pp l_th r_th else if op = mul_op_real then float_interval_mul pp l_th r_th else if op = div_op_real then float_interval_div pp l_th r_th else if op = sub_op_real then float_interval_sub pp l_th r_th else failwith ("Unknown operation: " ^ (fst o dest_const) op) else if ltm = neg_op_real then let r_th = float_interval_calc pp r_tm x_th in float_interval_neg r_th else mk_float_interval_num (dest_numeral r_tm);; (*************************************) (* Polynomial functions *) let poly_f = new_definition `poly_f cs x = ITLIST (\c s. c + x * s) cs (&0)`;; (* Even function *) let poly_f_even = new_definition `poly_f_even cs x = ITLIST (\c s. c + (x * x) * s) cs (&0)`;; (* Odd function *) let poly_f_odd = new_definition `poly_f_odd cs x = x * poly_f_even cs x`;; let poly_f_odd' = SPECL[`t:(real)list`; `x:real`] poly_f_odd;; let NUMERALS_TO_NUM = Arith_nat.NUMERALS_TO_NUM;; let POLY_F_EMPTY = (NUMERALS_TO_NUM o prove) (`poly_f [] x = &0`, REWRITE_TAC[poly_f; ITLIST]) and POLY_F_CONS = prove(`poly_f (CONS h t) x = h + x * poly_f t x`, REWRITE_TAC[poly_f; ITLIST]);; let POLY_F_EVEN_EMPTY = (NUMERALS_TO_NUM o prove) (`poly_f_even [] x = &0`, REWRITE_TAC[poly_f_even; ITLIST]) and POLY_F_EVEN_CONS = prove(`poly_f_even (CONS h t) x = h + (x * x) * poly_f_even t x`, REWRITE_TAC[poly_f_even; ITLIST]);; let POLY_F_ODD_EMPTY = (NUMERALS_TO_NUM o prove) (`poly_f_odd [] x = &0`, REWRITE_TAC[poly_f_odd; poly_f_even; ITLIST; REAL_MUL_RZERO]);; (* TABLE *) let rec reverse_table_conv tm = let ltm, i_tm = dest_comb tm in if (i_tm = `0`) then ONCE_REWRITE_CONV[REVERSE_TABLE] tm else let i_suc = num_CONV i_tm in let th1 = ONCE_REWRITE_RULE[REVERSE_TABLE] (AP_TERM ltm i_suc) in let ltm, rtm = dest_comb (rand(concl th1)) in let th2 = reverse_table_conv rtm in TRANS th1 (AP_TERM ltm th2);; let atn_co_table = new_definition `atn_co_table n = TABLE (\k. (if (EVEN k) then &1 else --(&1)) / &(2 * k + 1)) (SUC n)`;; (* Returns a theorem |- atn_co_table n = [...] and a list of interval approximations of the coefficients in the table *) let mk_atn_co_table pp n = let table = SPEC (mk_small_numeral n) atn_co_table in let th = CONV_RULE (DEPTH_CONV NUM_SUC_CONV THENC REWRITE_CONV[TABLE] THENC ONCE_DEPTH_CONV reverse_table_conv THENC REWRITE_CONV[REVERSE; APPEND] THENC NUM_REDUCE_CONV) table in let list = (rand o concl) th in th, map (fun tm -> float_interval_calc pp tm float_interval_1) (dest_list list);; let POLY_F_EVEN_ALT = prove(`poly_f_even cs x = poly_f cs (x * x)`, REWRITE_TAC[poly_f_even; poly_f]);; let POLY_F_APPEND = prove(`!x b a. poly_f (APPEND a b) x = poly_f a x + x pow (LENGTH a) * poly_f b x`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REPEAT STRIP_TAC THENL [ REWRITE_TAC[APPEND; poly_f; ITLIST; LENGTH] THEN REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_ADD_LID]; ALL_TAC ] THEN REWRITE_TAC[APPEND; poly_f; ITLIST] THEN ASM_REWRITE_TAC[GSYM poly_f] THEN REWRITE_TAC[LENGTH; real_pow] THEN REAL_ARITH_TAC);; let POLY_F_EVEN_APPEND = prove(`!x b a. poly_f_even (APPEND a b) x = poly_f_even a x + x pow (2 * LENGTH a) * poly_f_even b x`, REWRITE_TAC[POLY_F_EVEN_ALT; POLY_F_APPEND] THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_POW_POW]);; let POLY_F_ODD_APPEND = prove(`!x b a. poly_f_odd (APPEND a b) x = poly_f_odd a x + x pow (2 * LENGTH a) * poly_f_odd b x`, REPEAT GEN_TAC THEN REWRITE_TAC[poly_f_odd] THEN REWRITE_TAC[POLY_F_EVEN_APPEND] THEN REAL_ARITH_TAC);; let ATN_SUM_TABLE = prove(`!x n. sum (0..n) (halfatn4_co x) = poly_f_odd (atn_co_table n) (halfatn4 x)`, GEN_TAC THEN INDUCT_TAC THENL [ REWRITE_TAC[SUM_SING_NUMSEG; atn_co_table; TABLE; REVERSE_TABLE; REVERSE; APPEND] THEN REWRITE_TAC[ARITH_EVEN] THEN REWRITE_TAC[poly_f_odd; poly_f_even; ITLIST] THEN REWRITE_TAC[halfatn4_co; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[MULT_CLAUSES; ARITH_ADD; REAL_POW_1; real_pow] THEN REAL_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; atn_co_table; TABLE; LE_0] THEN ONCE_REWRITE_TAC[REVERSE_TABLE] THEN ONCE_REWRITE_TAC[REVERSE] THEN REWRITE_TAC[GSYM TABLE; GSYM atn_co_table] THEN ASM_REWRITE_TAC[POLY_F_ODD_APPEND] THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[atn_co_table; LENGTH_TABLE; halfatn4_co] THEN REWRITE_TAC[poly_f_odd; poly_f_even; ITLIST; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN DISJ1_TAC THEN REWRITE_TAC[REAL_MUL_AC] THEN REWRITE_TAC[GSYM real_pow; ARITH_RULE `2 * SUC n + 1 = SUC (2 * SUC n)`] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_AC] THEN REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN DISJ1_TAC THEN REWRITE_TAC[REAL_POW_NEG; real_pow; REAL_POW_ONE; REAL_MUL_RID]);; let POLY_F_SING = prove(`poly_f [c] x = c`, REWRITE_TAC[poly_f; ITLIST; REAL_MUL_RZERO; REAL_ADD_RID]);; (********************) let c_var_real = `c:real` and cs_var_list = `cs:(real)list` and h_var_real = `h:real` and t_var_list = `t:(real)list`;; let interval_const = `interval_arith`;; let rec float_interval_poly_f pp (cs, l) x_th = if length l = 0 then failwith "float_interval_poly_f: an empty coefficient list" else let ltm, x_bounds = dest_comb (concl x_th) in let x_tm = rand ltm in let first = hd l in let ltm, first_bounds = dest_comb (concl first) in let first_tm = rand ltm in if length l = 1 then let th0 = INST[first_tm, c_var_real; x_tm, x_var_real] POLY_F_SING in EQ_MP (SYM (AP_THM (AP_TERM interval_const th0) first_bounds)) first else let ltm, t_tm = dest_comb cs in let h_tm = rand ltm in let th0 = INST[h_tm, h_var_real; t_tm, t_var_list; x_tm, x_var_real] POLY_F_CONS in let r_th = float_interval_poly_f pp (t_tm, tl l) x_th in let th1 = float_interval_add pp first (float_interval_mul pp x_th r_th) in let bounds = rand (concl th1) in EQ_MP (SYM (AP_THM (AP_TERM interval_const th0) bounds)) th1;; let float_interval_poly_f_even pp (cs, l) x_th = let x_tm = (rand o rator o concl) x_th in let xx_th = float_interval_mul pp x_th x_th in let th0 = INST[cs, cs_var_list; x_tm, x_var_real] POLY_F_EVEN_ALT in let th1 = float_interval_poly_f pp (cs, l) xx_th in let bounds = rand(concl th1) in EQ_MP (SYM (AP_THM (AP_TERM interval_const th0) bounds)) th1;; let float_interval_poly_f_odd pp (cs, l) x_th = let x_tm = (rand o rator o concl) x_th in let th0 = INST[cs, t_var_list; x_tm, x_var_real] poly_f_odd' in let even_th = float_interval_poly_f_even pp (cs, l) x_th in let th1 = float_interval_mul pp x_th even_th in let bounds = rand(concl th1) in EQ_MP (SYM (AP_THM (AP_TERM interval_const th0) bounds)) th1;; let poly_f_odd_const = `poly_f_odd`;; let ATN_SUM_TABLE' = SPEC_ALL ATN_SUM_TABLE;; let float_interval_16 = mk_float_interval_small_num 16;; (* Computes an interval for &16 * sum(0..n) (halfatn4_co x) *) let float_interval_atn_sum pp (cs_th, l) x_th = let n_tm = (rand o lhand o concl) cs_th in let cs_tm = rand(concl cs_th) in let halfatn4 = float_interval_halfatn4 pp x_th in let poly_th = float_interval_poly_f_odd pp (cs_tm, l) halfatn4 in let bounds = rand (concl poly_th) in let halfatn4_tm = (rand o rator o concl) halfatn4 in let x_tm = rand halfatn4_tm in let th1 = AP_THM (AP_TERM interval_const (AP_THM (AP_TERM poly_f_odd_const cs_th) halfatn4_tm)) bounds in let poly_atn_th = EQ_MP (SYM th1) poly_th in let bounds = rand (concl poly_atn_th) in let th2 = INST[n_tm, n_var_num; x_tm, x_var_real] ATN_SUM_TABLE' in let th3 = EQ_MP (SYM (AP_THM (AP_TERM interval_const th2) bounds)) poly_atn_th in float_interval_mul pp float_interval_16 th3;; (******************************) let bounds_var_pair = `bounds:real#real`;; let FLOAT_INTERVAL_INV = prove(`interval_arith (&1 / x) bounds <=> interval_arith (inv x) bounds`, REWRITE_TAC[real_div; REAL_MUL_LID]);; let float_interval_inv pp x_th = let x_tm = (rand o rator o concl) x_th in let r_th = float_interval_div pp float_interval_1 x_th in let th0 = INST[x_tm, x_var_real; rand(concl r_th), bounds_var_pair] FLOAT_INTERVAL_INV in EQ_MP th0 r_th;; let REAL_POW_SUC = (SPEC_ALL o CONJUNCT2) real_pow;; let INTERVAL_REAL_POW_0 = prove(mk_comb(`interval_arith (x pow 0)`, (rand o concl) float_interval_1), REWRITE_TAC[real_pow; float_interval_1]);; let INTERVAL_REAL_POW_1 = prove(`interval_arith x bounds <=> interval_arith (x pow 1) bounds`, REWRITE_TAC[REAL_POW_1]);; let rec float_interval_pow_simple pp n x_th = let x_tm = (rand o rator o concl) x_th in if n = 0 then INST[x_tm, x_var_real] INTERVAL_REAL_POW_0 else if n = 1 then let bounds = rand(concl x_th) in let th0 = INST[x_tm, x_var_real; bounds, bounds_var_pair] INTERVAL_REAL_POW_1 in EQ_MP th0 x_th else let n_tm' = mk_small_numeral n in let n_suc = num_CONV n_tm' in let n_tm = rand(rand(concl n_suc)) in let th0 = INST[x_tm, x_var_real; n_tm, n_var_num] REAL_POW_SUC in let r_th = float_interval_pow_simple pp (n - 1) x_th in let th1 = float_interval_mul pp x_th r_th in let bounds = rand (concl th1) in let th2 = TRANS (AP_TERM (rator(lhand(concl th0))) n_suc) th0 in EQ_MP (SYM (AP_THM (AP_TERM interval_const th2) bounds)) th1;; let float_interval_2 = mk_float_interval_small_num 2 and six_const = `6` and five_const = `5`;; (* Computes an interval for inv(&2 pow (6 * n + 5)) *) let compute_eps1 pp n = let n_tm = mk_small_numeral n in let n6 = NUM_MULT_CONV (mk_binop mul_op_num six_const n_tm) in let n65_1 = AP_THM (AP_TERM add_op_num n6) five_const in let n65_2 = NUM_ADD_CONV (rand (concl n65_1)) in let n65 = TRANS n65_1 n65_2 in let pow_th = float_interval_pow_simple pp (6 * n + 5) float_interval_2 in let ltm, bounds = dest_comb(concl pow_th) in let pow_tm = (rator o rand) ltm in let th0 = EQ_MP (SYM (AP_THM (AP_TERM interval_const (AP_TERM pow_tm n65)) bounds)) pow_th in float_interval_inv pp th0;; (**********************************) let FLOAT_ATN_LO_HI = prove(`interval_arith (&16 * sum(0..n) (halfatn4_co x)) (a, b) /\ interval_arith (inv(&2 pow (6*n + 5))) (c,d) /\ b + d <= hi /\ lo <= a - d ==> interval_arith (atn x) (lo, hi)`, REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN MP_TAC (SPEC_ALL real_taylor_atn_halfatn4) THEN MP_TAC (REAL_ARITH `&0 <= abs(&16)`) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP REAL_LE_LMUL) THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_ARITH `a * (b - c) = a * b - a * c:real`] THEN ONCE_REWRITE_TAC[GSYM atn_halfatn4] THEN REWRITE_TAC[REAL_ARITH `abs (x - v) <= e <=> v - e <= x /\ x <= v + e`] THEN REWRITE_TAC[REAL_ABS_NUM] THEN SUBGOAL_THEN `&16 * inv(&8 pow (2 * n + 3)) = inv(&2 pow (6 * n + 5))` (fun th -> REWRITE_TAC[th]) THENL [ REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `&16 = &2 pow 4 /\ &8 = &2 pow 3 /\ ~(&2 = &0)` ASSUME_TAC THENL [ REAL_ARITH_TAC; ALL_TAC ] THEN ASM_REWRITE_TAC[REAL_POW_POW] THEN ASM_SIMP_TAC[REAL_DIV_POW2] THEN REWRITE_TAC[ARITH_RULE `~(3 * (2 * n + 3) <= 4)`] THEN REPEAT AP_TERM_TAC THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[GSYM halfatn4_co] THEN SUBGOAL_THEN `sum (0..n) (\j. halfatn4_co x j) = sum (0..n) (halfatn4_co x)` (fun th -> REWRITE_TAC[th]) THENL [ AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM]; ALL_TAC ] THEN REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);; let FLOAT_ATN_LO_HI' = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP]) FLOAT_ATN_LO_HI;; let float_interval_atn_0 pp (cs_th, l) eps1_th x_th = let sum_th = float_interval_atn_sum pp (cs_th, l) x_th in let n_tm = (rand o lhand o concl) cs_th in let x_tm = (rand o rator o concl) x_th in let sum_bounds = rand (concl sum_th) in let a_tm, b_tm = dest_pair sum_bounds in let c_tm, d_tm = (dest_pair o rand o concl) eps1_th in let hi_th = float_add_hi pp b_tm d_tm in let lo_th = float_sub_lo pp a_tm d_tm in let hi_tm = rand(concl hi_th) in let lo_tm = lhand(concl lo_th) in let th0 = INST[n_tm, n_var_num; x_tm, x_var_real; a_tm, a_var_real; b_tm, b_var_real; c_tm, c_var_real; d_tm, d_var_real; hi_tm, hi_var_real; lo_tm, lo_var_real] FLOAT_ATN_LO_HI' in MY_PROVE_HYP lo_th (MY_PROVE_HYP hi_th (MY_PROVE_HYP sum_th (MY_PROVE_HYP eps1_th th0)));; (* Fill in lookup tables *) (* Computes n such that 2^(-(6n + 5)) <= base^(-(p + 1)) *) let n_of_p pp = let x = (float_of_int (pp + 1) *. log (float_of_int Arith_hash.arith_base) /. log (2.0) -. 5.0) /. 6.0 in let n = (int_of_float o ceil) x in if n < 1 then 1 else n;; let atn_co_array = Array.init 21 (fun i -> mk_atn_co_table (i + 1) (n_of_p i));; let eps1_array = Array.init 21 (fun i -> compute_eps1 (i + 1) (n_of_p i));; let float_interval_atn pp x_th = float_interval_atn_0 pp atn_co_array.(pp) eps1_array.(pp) x_th;; (*****************************************) (* pi approximation *) let pp = 20;; let x_th = float_interval_1;; let th1 = float_interval_atn pp x_th;; let th2 = float_interval_mul pp (mk_float_interval_small_num 4) th1;; let float_interval_pi = REWRITE_RULE[ATN_1; REAL_ARITH `&4 * pi / &4 = pi`] th2;; let float_interval_pi2 = float_interval_div pp float_interval_pi float_interval_2;; let pi_approx_array = Array.init 19 (fun i -> float_interval_round i float_interval_pi);; let pi2_approx_array = Array.init 19 (fun i -> float_interval_round i float_interval_pi2);; (********************************************) (* acs *) let TAN_HALF = prove(`!x. ~(cos x = -- &1) ==> tan (x / &2) = sin x / (&1 + cos x)`, GEN_TAC THEN ABBREV_TAC `t = x / &2` THEN SUBGOAL_THEN `x = &2 * t` ASSUME_TAC THENL [ EXPAND_TAC "t" THEN REAL_ARITH_TAC; ALL_TAC ] THEN ASM_REWRITE_TAC[SIN_DOUBLE; COS_DOUBLE_COS; REAL_ARITH `&1 + a - &1 = a`] THEN REWRITE_TAC[REAL_ARITH `a - &1 = -- &1 <=> a = &0`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_2] THEN REWRITE_TAC[REAL_ENTIRE; REAL_ARITH `&2 = &0 <=> F`] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `(&2 * s * c) * i2 * ic * ic = (&2 * i2) * (c * ic) * s * ic`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ARITH `~(&2 = &0)`] THEN REWRITE_TAC[REAL_MUL_LID; tan; real_div]);; let X_EQ_COS_T = prove(`!x. abs x <= &1 ==> ?t. &0 <= t /\ t <= pi /\ x = cos t`, REWRITE_TAC[REAL_ARITH `abs x <= &1 <=> -- &1 <= x /\ x <= &1`] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `acs x` THEN ASM_SIMP_TAC[ACS_BOUNDS; COS_ACS]);; let ACS_ATN_ALT = prove(`!x. -- &1 < x /\ x <= &1 ==> acs x = &2 * atn (sqrt (&1 - x pow 2) / (&1 + x))`, REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL X_EQ_COS_T) THEN ANTS_TAC THENL [ REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ACS_COS] THEN MP_TAC (SPEC `t:real` SIN_COS_SQRT) THEN ANTS_TAC THENL [ ASM_SIMP_TAC[SIN_POS_PI_LE]; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN MP_TAC (SPEC `t:real` TAN_HALF) THEN ANTS_TAC THENL [ POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN UNDISCH_TAC `-- &1 < x` THEN REAL_ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[REAL_ARITH `t = &2 * a <=> a = t / &2`] THEN MATCH_MP_TAC TAN_ATN THEN REWRITE_TAC[REAL_ARITH `a / &2 < b / &2 <=> a < b`] THEN REWRITE_TAC[REAL_ARITH `--(a / &2) < b / &2 <=> --a < b`] THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_NEG_LT0; PI_POS]; SUBGOAL_THEN `t = acs x` MP_TAC THENL [ ASM_SIMP_TAC[ACS_COS]; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[SYM ACS_NEG_1] THEN MATCH_MP_TAC ACS_MONO_LT THEN ASM_REWRITE_TAC[REAL_LE_REFL] ]);; let FLOAT_F_LT = prove(`!n e. &0 < float_num F n e <=> ~(n = 0)`, REWRITE_TAC[REAL_ARITH `&0 < a <=> &0 <= a /\ ~(a = &0)`] THEN REWRITE_TAC[FLOAT_F_POS; FLOAT_EQ_0]);; let FLOAT_INTERVAL_ACS = prove(`interval_arith (pi / &2 - atn(x / sqrt(&1 - x * x))) bounds /\ interval_arith (&1 - x * x) (float_num F n e, hi) /\ ~(n = 0) ==> interval_arith (acs x) bounds`, REWRITE_TAC[GSYM REAL_POW_2] THEN STRIP_TAC THEN MP_TAC (SPEC_ALL ACS_ATN) THEN ANTS_TAC THENL [ POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[interval_arith] THEN REWRITE_TAC[REAL_ARITH `-- &1 < x /\ x < &1 <=> abs x < abs (&1)`] THEN REWRITE_TAC[REAL_LT_SQUARE_ABS] THEN REWRITE_TAC[REAL_ARITH `&1 pow 2 = &1`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `a < &1 <=> &0 < &1 - a`] THEN MP_TAC (SPEC_ALL FLOAT_F_LT) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `float_num F n e <= &1 - x pow 2` THEN REAL_ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[th]));; let ZERO_EQ_ZERO_CONST = prove(`0 = _0`, REWRITE_TAC[NUMERAL]);; let FLOAT_INTERVAL_ACS' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[TAUT `~P <=> (P <=> F)`] o REWRITE_RULE[ZERO_EQ_ZERO_CONST; GSYM IMP_IMP]) FLOAT_INTERVAL_ACS;; let float_interval_acs_0 pp (cs_th, l) eps1_th x_th = let int1 = float_interval_sub pp float_interval_1 (float_interval_mul pp x_th x_th) in let int2 = float_interval_div pp x_th (float_interval_sqrt pp int1) in let atn_int = float_interval_atn_0 pp (cs_th, l) eps1_th int2 in let acs_int = float_interval_sub pp pi2_approx_array.(pp + 1) atn_int in let x_tm = (rand o rator o concl) x_th in let bounds = (rand o concl) acs_int in let int1_bounds = (rand o concl) int1 in let lo_tm, hi_tm = dest_pair int1_bounds in let s, n_tm, e_tm = dest_float lo_tm in if s <> "F" then failwith "float_interval_acs_0: &1 - x pow 2 < &1 is not satisfied" else let n_th = Arith_nat.raw_eq0_hash_conv n_tm in let th0 = INST[x_tm, x_var_real; bounds, bounds_var_pair; n_tm, n_var_num; e_tm, e_var_num; hi_tm, hi_var_real] FLOAT_INTERVAL_ACS' in MY_PROVE_HYP acs_int (MY_PROVE_HYP int1 (MY_PROVE_HYP n_th th0));; let float_interval_acs pp x_th = float_interval_acs_0 pp atn_co_array.(pp) eps1_array.(pp) x_th;; (****************************************) end;; hol-light/Formal_ineqs/arith/float_theory.hl000066400000000000000000000073311303454263000215230ustar00rootroot00000000000000(* =========================================================== *) (* Theoretical results for floating point arithmetic *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "arith/nat.hl";; needs "arith/num_exp_theory.hl";; module Float_theory = struct open Num_exp_theory;; open Arith_nat;; (* Fix the minimal exponent *) let min_exp = !Arith_options.min_exp;; (* The main definition *) let min_exp_num_const = rand (mk_small_numeral_array min_exp);; let min_exp_const = mk_small_numeral min_exp;; let min_exp_def = new_definition (mk_eq(`min_exp:num`, min_exp_const));; let float_tm = `float_num s n e = (if s then (-- &1) else &1) * &(num_exp n e) / &(num_exp 1 min_exp)`;; let float = new_definition float_tm;; let FLOAT_OF_NUM = (GEN_ALL o prove)(`&n = float_num F n min_exp`, REWRITE_TAC[float; num_exp; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_MUL_LID; real_div] THEN SUBGOAL_THEN (mk_comb(`(~)`, mk_eq(mk_comb(`&`, mk_binop `EXP` base_const `min_exp`), `&0`))) ASSUME_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_EQ; EXP_EQ_0] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_RID]);; let FLOAT_NEG = prove(`!s n e. --float_num s n e = float_num (~s) n e`, REWRITE_TAC[float] THEN REAL_ARITH_TAC);; let FLOAT_NEG_F = (GSYM o REWRITE_RULE[] o SPEC `T`) FLOAT_NEG;; let FLOAT_NEG_T = (GSYM o REWRITE_RULE[] o SPEC `F`) FLOAT_NEG;; let FLOAT_F_POS = prove(`!n e. &0 <= float_num F n e`, REPEAT GEN_TAC THEN REWRITE_TAC[float; REAL_MUL_LID; real_div] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS; REAL_LE_INV_EQ]);; let FLOAT_T_NEG = prove(`!n e. float_num T n e <= &0`, REPEAT GEN_TAC THEN REWRITE_TAC[float; real_div] THEN REWRITE_TAC[REAL_ARITH `-- &1 * a * b <= &0 <=> &0 <= a * b`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS; REAL_LE_INV_EQ]);; let FLOAT_EQ_0 = prove(`!s n e. float_num s n e = &0 <=> n = 0`, REPEAT GEN_TAC THEN REWRITE_TAC[float; real_div] THEN REWRITE_TAC[REAL_ENTIRE] THEN EQ_TAC THENL [ STRIP_TAC THEN POP_ASSUM MP_TAC THENL [ COND_CASES_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_OF_NUM_EQ; NUM_EXP_EQ_0]; REWRITE_TAC[REAL_INV_EQ_0; REAL_OF_NUM_EQ; NUM_EXP_EQ_0] THEN ARITH_TAC ]; DISCH_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; NUM_EXP_EQ_0] ]);; let FLOAT_F_bound = (GEN_ALL o prove)(`num_exp n1 e1 <= num_exp n2 e2 ==> float_num F n1 e1 <= float_num F n2 e2`, DISCH_TAC THEN REWRITE_TAC[float; REAL_MUL_LID; real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_LE_INV_EQ; REAL_POS]);; let FLOAT_T_bound = (GEN_ALL o prove)(`num_exp n1 e1 <= num_exp n2 e2 ==> float_num T n2 e2 <= float_num T n1 e1`, REWRITE_TAC[FLOAT_NEG_T; REAL_LE_NEG; FLOAT_F_bound]);; end;; hol-light/Formal_ineqs/arith/interval_arith.hl000066400000000000000000000040451303454263000220360ustar00rootroot00000000000000(* =========================================================== *) (* Theoretical results for interval arithmetic *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "misc/vars.hl";; module Interval_arith = struct (*******************************) (* The main definition *) let interval_arith = new_definition `interval_arith (x:real) (lo, hi) <=> lo <= x /\ x <= hi`;; (* Additional definitions *) let bounded_on = new_definition `bounded_on f s f_bounds <=> !x. x IN s ==> interval_arith (f x) f_bounds`;; let bounded_on_int = new_definition `bounded_on_int f int f_bounds <=> !x. interval_arith x int ==> interval_arith (f x) f_bounds`;; let iabs = new_definition `iabs (x_lo, x_hi) = max x_hi (-- x_lo)`;; let interval_not_zero = new_definition `interval_not_zero (lo, hi) <=> &0 < lo \/ hi < &0`;; let interval_pos = new_definition `interval_pos (lo, hi) <=> &0 < lo`;; (********************************) (* Lemmas *) let CONST_INTERVAL = prove(`!x. interval_arith x (x,x)`, REWRITE_TAC[interval_arith; REAL_LE_REFL]);; let APPROX_INTERVAL = (GEN_ALL o prove)(`(a <= lo /\ hi <= b) /\ interval_arith x (lo, hi) ==> interval_arith x (a,b)`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; let INTERVAL_NEG = (GEN_ALL o prove)(`interval_arith x (a, b) ==> interval_arith (--x) (--b, --a)`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; (**************************************) (* Conversions *) open Misc_vars;; let interval_tm = `interval_arith`;; let dest_interval_arith tm = let lhs, int_tm = dest_comb tm in rand lhs, int_tm;; let mk_interval tm bounds = mk_comb (mk_comb (interval_tm, tm), bounds);; let mk_const_interval = let lemma = SPEC_ALL CONST_INTERVAL in fun tm -> INST[tm, x_var_real] lemma;; end;; hol-light/Formal_ineqs/arith/more_float.hl000066400000000000000000000412061303454263000211520ustar00rootroot00000000000000(* =========================================================== *) (* Additional floating point procedures *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "arith/float.hl";; needs "misc/vars.hl";; module More_float = struct open Arith_misc;; open Float_theory;; open Interval_arith;; open Arith_float;; open Misc_vars;; let RULE = UNDISCH_ALL o Arith_nat.NUMERALS_TO_NUM o REWRITE_RULE[FLOAT_OF_NUM; min_exp_def; GSYM IMP_IMP] o SPEC_ALL;; (*************************************) (* More float *) (* Converts a float term to the corresponding rational number *) let num_of_float_tm tm = let s, n_tm, e_tm = dest_float tm in let b = Num.num_of_int Arith_hash.arith_base in let m = Num.num_of_int Float_theory.min_exp in let ( * ), (^), (-), (!) = ( */ ), ( **/ ), (-/), Arith_nat.raw_dest_hash in let r = !n_tm * (b ^ (!e_tm - m)) in if s = "T" then minus_num r else r;; (* Converts a float term to a floating point number *) (* Note: float_of_num gives a very bad approximation in some cases *) let float_of_float_tm tm = (float_of_string o approx_num_exp 30 o num_of_float_tm) tm;; (* Creates a float term with the value (n * base^e) *) let mk_float = let float_const = `float_num` in fun n e -> let n, s = if n < 0 then -n, `T` else n, `F` in let n_tm = rand (Arith_nat.mk_small_numeral_array n) in let e_tm = rand (Arith_nat.mk_small_numeral_array (e + Float_theory.min_exp)) in mk_comb(mk_comb(mk_comb (float_const, s), n_tm), e_tm);; (* |- ##0 = &0, |- ##1 = &1, |- ##2 = &2, |- ##3 = &3, |- ##4 = &4 *) let float0_eq = FLOAT_TO_NUM_CONV (mk_float 0 0) and float1_eq = FLOAT_TO_NUM_CONV (mk_float 1 0) and float2_eq = FLOAT_TO_NUM_CONV (mk_float 2 0) and float3_eq = FLOAT_TO_NUM_CONV (mk_float 3 0) and float4_eq = FLOAT_TO_NUM_CONV (mk_float 4 0);; (* |- D_k _0 = k for k = 1, 2, 3 *) let num1_eq, num2_eq, num3_eq = let conv = SYM o REWRITE_RULE[Arith_hash.NUM_THM] o Arith_nat.NUMERAL_TO_NUM_CONV in conv `1`, conv `2`, conv `3`;; (*********************) let float_F_const = `float_num F`;; let mk_float_small n = let n_tm0 = mk_small_numeral n in let n_th = Arith_nat.NUMERAL_TO_NUM_CONV n_tm0 in let n_tm = rand(rand(concl n_th)) in mk_comb(mk_comb(float_F_const, n_tm), min_exp_num_const);; (* Small float constants and intervals *) let one_float = mk_float_small 1 and two_float = mk_float_small 2 and one_interval = mk_float_interval_small_num 1 and two_interval = mk_float_interval_small_num 2;; let neg_two_interval = float_interval_neg two_interval;; (***********************************) (* float_eq0 *) let FLOAT_EQ_0' = (GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [NUMERAL] o SPEC_ALL) FLOAT_EQ_0;; let float_eq0 f_tm = let lhs, e_tm = dest_comb f_tm in let lhs2, n_tm = dest_comb lhs in let th0 = INST[rand lhs2, s_var_bool; n_tm, n_var_num; e_tm, e_var_num] FLOAT_EQ_0' in let eq_th = Arith_nat.raw_eq0_hash_conv n_tm in TRANS th0 eq_th;; (***********************************) (* float_interval_scale *) let float_interval_scale pp c_tm th = let c_th = mk_const_interval c_tm in float_interval_mul pp c_th th;; (***********************************) (* float_interval_lt0 *) let FLOAT_INTERVAL_LT0' = (UNDISCH_ALL o prove) (`interval_arith x (lo, hi) ==> (hi < &0 <=> T) ==> x < &0`, REWRITE_TAC[interval_arith] THEN REAL_ARITH_TAC);; let float_interval_lt0 th = let x_tm, bounds = dest_interval_arith (concl th) in let lo_tm, hi_tm = dest_pair bounds in let lt0_th = float_lt0 hi_tm in let _ = ((rand o concl) lt0_th = t_const) or failwith "float_interval_lt0: &0 <= hi" in let th0 = INST[x_tm, x_var_real; lo_tm, lo_var_real; hi_tm, hi_var_real] FLOAT_INTERVAL_LT0' in (MY_PROVE_HYP th o MY_PROVE_HYP lt0_th) th0;; (**********************************) (* float_pos *) let FLOAT_F_POS' = SPEC_ALL FLOAT_F_POS;; (* Returns &0 <= float F n e *) let float_pos tm = let _, n_tm, e_tm = dest_float tm in INST[n_tm, n_var_num; e_tm, e_var_num] FLOAT_F_POS';; (************************************) (* float_iabs *) let FLOAT_NEG_F' = RULE FLOAT_NEG_T;; let FLOAT_NEG_T' = RULE FLOAT_NEG_F;; let float_neg tm = let sign, n_tm, e_tm = dest_float tm in if sign = "T" then INST[n_tm, n_var_num; e_tm, e_var_num] FLOAT_NEG_T' else INST[n_tm, n_var_num; e_tm, e_var_num] FLOAT_NEG_F';; let IABS' = RULE iabs;; let float_iabs int_tm = let lo_tm, hi_tm = dest_pair int_tm in let neg_lo_th = float_neg lo_tm in let max_th = SYM (float_max hi_tm ((rand o rator o concl) neg_lo_th)) in let lhs, rhs = dest_comb (concl max_th) in let th0 = SYM (EQ_MP (AP_TERM lhs (AP_TERM (rator rhs) neg_lo_th)) max_th) in let th1 = INST[lo_tm, x_lo_var; hi_tm, x_hi_var] IABS' in TRANS th1 th0;; let FLOAT_IABS_FF = prove(`iabs (float_num F n1 e1, float_num F n2 e2) = float_num F n2 e2`, REWRITE_TAC[iabs] THEN MP_TAC (SPECL [`n1:num`; `e1:num`] FLOAT_F_POS) THEN MP_TAC (SPECL [`n2:num`; `e2:num`] FLOAT_F_POS) THEN REAL_ARITH_TAC);; let FLOAT_IABS_TT = prove(`iabs (float_num T n1 e1, float_num T n2 e2) = float_num F n1 e1`, REWRITE_TAC[iabs; GSYM FLOAT_NEG_F] THEN MP_TAC (SPECL [`n1:num`; `e1:num`] FLOAT_F_POS) THEN MP_TAC (SPECL [`n2:num`; `e2:num`] FLOAT_T_NEG) THEN REAL_ARITH_TAC);; (****************************) (* interval_not_zero *) let INTERVAL_NOT_ZERO1' = (UNDISCH_ALL o prove) (`(&0 < lo <=> T) ==> interval_not_zero (lo, hi)`, SIMP_TAC[interval_not_zero]);; let INTERVAL_NOT_ZERO2' = (UNDISCH_ALL o prove) (`(hi < &0 <=> T) ==> interval_not_zero (lo, hi)`, SIMP_TAC[interval_not_zero]);; let check_interval_not_zero int_tm = let lo, hi = dest_pair int_tm in let inst = INST[lo, lo_var_real; hi, hi_var_real] in let s1, _, _ = dest_float lo in if s1 = "F" then let gt_th = float_gt0 lo in if (fst o dest_const o rand o concl) gt_th <> "T" then failwith "check_interval_not_zero: &0 < lo <=> F" else (MY_PROVE_HYP gt_th o inst) INTERVAL_NOT_ZERO1' else let lt_th = float_lt0 hi in if (fst o dest_const o rand o concl) lt_th <> "T" then failwith "check_interval_not_zero: hi < &0 <=> F" else (MY_PROVE_HYP lt_th o inst) INTERVAL_NOT_ZERO2';; (*************************************) (* interval_pos *) let INTERVAL_POS' = (UNDISCH_ALL o prove) (`(&0 < lo <=> T) ==> interval_pos (lo, hi:real)`, SIMP_TAC[interval_pos]);; let check_interval_pos int_tm = let lo, hi = dest_pair int_tm in let gt_th = float_gt0 lo in if (fst o dest_const o rand o concl) gt_th <> "T" then failwith "check_interval_pos: &0 < lo <=> F" else (MY_PROVE_HYP gt_th o INST[lo, lo_var_real; hi, hi_var_real]) INTERVAL_POS';; (************************************) (* check_interval_iabs *) (* proves |- iabs int < rhs <=> T *) let check_interval_iabs int_tm rhs_tm = let iabs_eq = float_iabs int_tm in let lt_th = float_lt (rand (concl iabs_eq)) rhs_tm in if (fst o dest_const o rand o concl) lt_th <> "T" then failwith "check_interval_iabs: iabs < rhs <=> F" else let th0 = AP_THM (AP_TERM lt_op_real iabs_eq) rhs_tm in TRANS th0 lt_th;; (****************************) (* inv *) let INV_EQ_DIV_LEMMA = prove(`&1 / x = inv x`, REWRITE_TAC[real_div; REAL_MUL_LID]);; let float_interval_inv pp th = let x_tm = (rand o rator o concl) th in let div_th = INST[x_tm, x_var_real] INV_EQ_DIV_LEMMA in let th0 = float_interval_div pp one_interval th in let lhs, rhs = dest_comb (concl th0) in let lhs2, rhs2 = dest_comb lhs in EQ_MP (AP_THM (AP_TERM lhs2 div_th) rhs) th0;; (* Explicit representation of inv(&2) *) let float_inv2_th = let one_float_eq_one = FLOAT_TO_NUM_CONV one_float in let inv2_eq_lemma = prove(`interval_arith (&2 * x) (&1, &1) ==> inv (&2) = x`, REWRITE_TAC[interval_arith] THEN CONV_TAC REAL_FIELD) in let half_tm = (fst o dest_pair o rand o concl) (float_interval_inv 1 two_interval) in let half_interval = mk_const_interval half_tm in let mul_th = REWRITE_RULE[one_float_eq_one] (float_interval_mul 2 two_interval half_interval) in MATCH_MP inv2_eq_lemma mul_th;; let float_inv2 = rand (concl float_inv2_th);; let inv2_interval = mk_const_interval float_inv2;; (*****************************************) (* bounded_on_int *) let norm_derivative d_th eq_th = let lhs, rhs = (dest_eq o concl) d_th in let lhs2, rhs2 = dest_comb lhs in let th0 = AP_THM (AP_TERM (rator lhs2) eq_th) rhs2 in TRANS (SYM th0) d_th;; let norm_diff d_th eq_th = let lhs, rhs = (dest_comb o concl) d_th in let th0 = AP_THM (AP_TERM (rator lhs) eq_th) rhs in EQ_MP th0 d_th;; let norm_interval int_th eq_th = let lhs, rhs = (dest_comb o concl) int_th in let th0 = AP_THM (AP_TERM (rator lhs) eq_th) rhs in EQ_MP (SYM th0) int_th;; let norm_second_derivative th eq_th = let lhs, dd_bounds = dest_comb (concl th) in let lhs2, int_tm = dest_comb lhs in let th0 = AP_THM (AP_THM (AP_TERM (rator lhs2) eq_th) int_tm) dd_bounds in EQ_MP th0 th;; let norm_lin_approx th eq_th = let lhs, df_bounds = dest_comb (concl th) in let lhs2, f_bounds = dest_comb lhs in let lhs3, x_tm = dest_comb lhs2 in let th0 = AP_THM (AP_THM (AP_THM (AP_TERM (rator lhs3) eq_th) x_tm) f_bounds) df_bounds in EQ_MP th0 th;; let BOUNDED_ON_INT = (UNDISCH_ALL o prove)(`(!x. interval_arith x int ==> interval_arith (f x) f_bounds) ==> bounded_on_int f int f_bounds`, REWRITE_TAC[bounded_on_int; interval_arith]);; let BOUNDED_ON_INT_DEST = (UNDISCH_ALL o prove)(`bounded_on_int f int f_bounds ==> (!x. interval_arith x int ==> interval_arith (f x) f_bounds)`, REWRITE_TAC[bounded_on_int; interval_arith]);; (* Given a theorem (interval_arith x int |- interval_arith (f x) f_bounds), yields |- bounded_on_int (\x. f x) int f_bounds *) let mk_bounded_on_int th = let int_tm = (rand o hd o hyp) th in let lhs, f_bounds_tm = dest_comb (concl th) in let lhs2, rhs2 = dest_comb lhs in let f_tm = mk_abs (x_var_real, rhs2) in let b_th0 = (SYM o BETA_CONV) (mk_comb (f_tm , x_var_real)) in let b_th1 = AP_THM (AP_TERM lhs2 b_th0) f_bounds_tm in let th2 = EQ_MP b_th1 th in let th3 = DISCH_ALL th2 in let th4 = GEN x_var_real th3 in let th_int = INST[int_tm, int_var; f_bounds_tm, f_bounds_var; f_tm, f_var_fun] BOUNDED_ON_INT in MY_PROVE_HYP th4 th_int;; let dest_bounded_on_int th = let lhs, f_bounds = dest_comb (concl th) in let lhs2, int_tm = dest_comb lhs in let f_tm = rand lhs2 in let th0 = INST[f_tm, f_var_fun; int_tm, int_var; f_bounds, f_bounds_var] BOUNDED_ON_INT_DEST in let th1 = UNDISCH_ALL (SPEC x_var_real (MY_PROVE_HYP th th0)) in if is_abs f_tm then let f_tm = (rand o rator o concl) th1 in let eq_th = BETA_CONV f_tm in norm_interval th1 (SYM eq_th) else th1;; let dest_bounded_on_int_raw th = let lhs, f_bounds = dest_comb (concl th) in let lhs2, int_tm = dest_comb lhs in let f_tm = rand lhs2 in let th0 = INST[f_tm, f_var_fun; int_tm, int_var; f_bounds, f_bounds_var] BOUNDED_ON_INT_DEST in UNDISCH_ALL (SPEC x_var_real (MY_PROVE_HYP th th0));; (***********************************) (* bounded_on_int arithmetic *) let bounded_on_int_scale pp c_tm th = let i_th = dest_bounded_on_int th in let th0 = float_interval_scale pp c_tm i_th in mk_bounded_on_int th0;; let bounded_on_int_mul_int pp int_th th = let i_th = dest_bounded_on_int th in let th0 = float_interval_mul pp int_th i_th in mk_bounded_on_int th0;; let bounded_on_int_neg th1 = let i_th = dest_bounded_on_int th1 in let th0 = float_interval_neg i_th in mk_bounded_on_int th0;; let bounded_on_int_add pp th1 th2 = let i_th1, i_th2 = dest_bounded_on_int th1, dest_bounded_on_int th2 in let th0 = float_interval_add pp i_th1 i_th2 in mk_bounded_on_int th0;; let bounded_on_int_sub pp th1 th2 = let i_th1, i_th2 = dest_bounded_on_int th1, dest_bounded_on_int th2 in let th0 = float_interval_sub pp i_th1 i_th2 in mk_bounded_on_int th0;; let bounded_on_int_mul pp th1 th2 = let i_th1, i_th2 = dest_bounded_on_int th1, dest_bounded_on_int th2 in let th0 = float_interval_mul pp i_th1 i_th2 in mk_bounded_on_int th0;; let bounded_on_int_mul_raw pp th1 th2 = let i_th1, i_th2 = dest_bounded_on_int_raw th1, dest_bounded_on_int_raw th2 in let th0 = float_interval_mul pp i_th1 i_th2 in mk_bounded_on_int th0;; let bounded_on_int_div pp th1 th2 = let i_th1, i_th2 = dest_bounded_on_int th1, dest_bounded_on_int th2 in let th0 = float_interval_div pp i_th1 i_th2 in mk_bounded_on_int th0;; (************************************) let ADD_INEQ_HI = (RULE o REAL_ARITH) `x1 <= y1 /\ x2 <= y2 /\ y1 + y2 <= y ==> x1 + x2 <= y`;; let ADD_INEQ_LO = (RULE o REAL_ARITH) `x1 <= y1 /\ x2 <= y2 /\ x <= x1 + x2 ==> x <= y1 + y2`;; let SUB_INEQ_HI = (RULE o REAL_ARITH) `x1 <= y1 /\ y2 <= x2 /\ y1 - y2 <= y ==> x1 - x2 <= y`;; let SUB_INEQ_LO = (RULE o REAL_ARITH) `x1 <= y1 /\ y2 <= x2 /\ x <= x1 - x2 ==> x <= y1 - y2`;; let MUL_INEQ_HI = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o prove) (`&0 <= x1 /\ &0 <= x2 /\ x1 <= y1 /\ x2 <= y2 /\ y1 * y2 <= y ==> x1 * x2 <= y`, DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `y1 * y2` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]);; let MUL_INEQ_POS_CONST_HI = (UNDISCH_ALL o prove) (`(&0 <= x <=> T) ==> y1 <= y2 ==> x * y2 <= z ==> x * y1 <= z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x * y2` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]);; let mk_refl_ineq = let REAL_LE_REFL' = RULE REAL_LE_REFL in fun tm -> INST[tm, x_var_real] REAL_LE_REFL';; let dest_le_op ineq = let lhs, y_tm = dest_comb ineq in (rand lhs, y_tm);; let mul_ineq_pos_const_hi pp c_tm ineq = let y1_tm, y2_tm = dest_le_op (concl ineq) in let ge0_th = float_ge0 c_tm in let mul_hi_th = float_mul_hi pp c_tm y2_tm in let z_tm = (rand o concl) mul_hi_th in (MY_PROVE_HYP ge0_th o MY_PROVE_HYP ineq o MY_PROVE_HYP mul_hi_th o INST[c_tm, x_var_real; y1_tm, y1_var_real; y2_tm, y2_var_real; z_tm, z_var_real]) MUL_INEQ_POS_CONST_HI;; let mul_ineq_hi pp ineq1 ineq2 = let x1_tm, y1_tm = dest_le_op (concl ineq1) in let x2_tm, y2_tm = dest_le_op (concl ineq2) in let x1_pos, x2_pos = float_pos x1_tm, float_pos x2_tm in let rhs_mul = float_mul_hi pp y1_tm y2_tm in let y_tm = (rand o concl) rhs_mul in let th0 = INST[x1_tm, x1_var_real; y1_tm, y1_var_real; x2_tm, x2_var_real; y2_tm, y2_var_real; y_tm, y_var_real] MUL_INEQ_HI in (MY_PROVE_HYP x1_pos o MY_PROVE_HYP x2_pos o MY_PROVE_HYP ineq1 o MY_PROVE_HYP ineq2 o MY_PROVE_HYP rhs_mul) th0;; let sub_ineq_hi pp ineq1 ineq2 = let x1_tm, y1_tm = dest_le_op (concl ineq1) in let y2_tm, x2_tm = dest_le_op (concl ineq2) in let rhs_sub = float_sub_hi pp y1_tm y2_tm in let y_tm = (rand o concl) rhs_sub in let th0 = INST[x1_tm, x1_var_real; y1_tm, y1_var_real; x2_tm, x2_var_real; y2_tm, y2_var_real; y_tm, y_var_real] SUB_INEQ_HI in MY_PROVE_HYP ineq1 (MY_PROVE_HYP ineq2 (MY_PROVE_HYP rhs_sub th0));; let sub_ineq_lo pp ineq1 ineq2 = let x1_tm, y1_tm = dest_le_op (concl ineq1) in let y2_tm, x2_tm = dest_le_op (concl ineq2) in let lhs_sub = float_sub_lo pp x1_tm x2_tm in let x_tm = (lhand o concl) lhs_sub in let th0 = INST[x1_tm, x1_var_real; y1_tm, y1_var_real; x2_tm, x2_var_real; y2_tm, y2_var_real; x_tm, x_var_real] SUB_INEQ_LO in MY_PROVE_HYP ineq1 (MY_PROVE_HYP ineq2 (MY_PROVE_HYP lhs_sub th0));; let add_ineq_hi pp ineq1 ineq2 = let x1_tm, y1_tm = dest_le_op (concl ineq1) in let x2_tm, y2_tm = dest_le_op (concl ineq2) in let rhs_sum = float_add_hi pp y1_tm y2_tm in let y_tm = (rand o concl) rhs_sum in let th0 = INST[x1_tm, x1_var_real; y1_tm, y1_var_real; x2_tm, x2_var_real; y2_tm, y2_var_real; y_tm, y_var_real] ADD_INEQ_HI in MY_PROVE_HYP ineq1 (MY_PROVE_HYP ineq2 (MY_PROVE_HYP rhs_sum th0));; let add_ineq_lo pp ineq1 ineq2 = let x1_tm, y1_tm = dest_le_op (concl ineq1) in let x2_tm, y2_tm = dest_le_op (concl ineq2) in let lhs_sum = float_add_lo pp x1_tm x2_tm in let x_tm = (lhand o concl) lhs_sum in let th0 = INST[x1_tm, x1_var_real; y1_tm, y1_var_real; x2_tm, x2_var_real; y2_tm, y2_var_real; x_tm, x_var_real] ADD_INEQ_LO in MY_PROVE_HYP ineq1 (MY_PROVE_HYP ineq2 (MY_PROVE_HYP lhs_sum th0));; end;; hol-light/Formal_ineqs/arith/nat.hl000066400000000000000000000060621303454263000176060ustar00rootroot00000000000000(* =========================================================== *) (* Formal natural number arithmetic *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "arith_options.hl";; needs "arith/arith_cache.hl";; module Arith_nat = struct open Arith_options;; (* mk *) let mk_small_numeral_array = Arith_hash.mk_small_numeral_array;; let mk_numeral_array = Arith_hash.mk_numeral_array;; let NUMERAL_TO_NUM_CONV = Arith_hash.NUMERAL_TO_NUM_CONV;; let NUM_TO_NUMERAL_CONV = Arith_hash.NUM_TO_NUMERAL_CONV;; (* dest *) let raw_dest_hash = Arith_hash.raw_dest_hash;; (* SUC *) let raw_suc_conv_hash = if !cached then Arith_cache.raw_suc_conv_hash else Arith_hash.raw_suc_conv_hash;; let NUM_SUC_HASH_CONV = Arith_hash.NUM_SUC_HASH_CONV;; (* x = 0 *) let raw_eq0_hash_conv = if !cached then Arith_cache.raw_eq0_hash_conv else Arith_hash.raw_eq0_hash_conv;; let NUM_EQ0_HASH_CONV = Arith_hash.NUM_EQ0_HASH_CONV;; (* PRE *) let raw_pre_hash_conv = if !cached then Arith_cache.raw_pre_hash_conv else Arith_hash.raw_pre_hash_conv;; let NUM_PRE_HASH_CONV = Arith_hash.NUM_PRE_HASH_CONV;; (* x > 0 *) let raw_gt0_hash_conv = if !cached then Arith_cache.raw_gt0_hash_conv else Arith_hash.raw_gt0_hash_conv;; let NUM_GT0_HASH_CONV = Arith_hash.NUM_GT0_HASH_CONV;; (* x < y, x <= y *) let raw_lt_hash_conv = if !cached then Arith_cache.raw_lt_hash_conv else Arith_hash.raw_lt_hash_conv;; let raw_le_hash_conv = if !cached then Arith_cache.raw_le_hash_conv else Arith_hash.raw_le_hash_conv;; let NUM_LT_HASH_CONV = Arith_hash.NUM_LT_HASH_CONV;; let NUM_LE_HASH_CONV = Arith_hash.NUM_LE_HASH_CONV;; (* x + y *) let raw_add_conv_hash = if !cached then Arith_cache.raw_add_conv_hash else Arith_hash.raw_add_conv_hash;; let NUM_ADD_HASH_CONV = Arith_hash.NUM_ADD_HASH_CONV;; (* x - y *) let raw_sub_hash_conv = if !cached then Arith_cache.raw_sub_hash_conv else Arith_hash.raw_sub_hash_conv;; let raw_sub_and_le_hash_conv = if !cached then Arith_cache.raw_sub_and_le_hash_conv else Arith_hash.raw_sub_and_le_hash_conv;; let NUM_SUB_HASH_CONV = Arith_hash.NUM_SUB_HASH_CONV;; (* x * y *) let raw_mul_conv_hash = if !cached then Arith_cache.raw_mul_conv_hash else Arith_hash.raw_mul_conv_hash;; let NUM_MULT_HASH_CONV = Arith_hash.NUM_MULT_HASH_CONV;; (* x / y *) let raw_div_hash_conv = if !cached then Arith_cache.raw_div_hash_conv else Arith_hash.raw_div_hash_conv;; let NUM_DIV_HASH_CONV = Arith_hash.NUM_DIV_HASH_CONV;; (* EVEN, ODD *) let raw_even_hash_conv = if !cached then Arith_cache.raw_even_hash_conv else Arith_hash.raw_even_hash_conv;; let raw_odd_hash_conv = if !cached then Arith_cache.raw_odd_hash_conv else Arith_hash.raw_odd_hash_conv;; let NUM_EVEN_HASH_CONV = Arith_hash.NUM_EVEN_HASH_CONV;; let NUM_ODD_HASH_CONV = Arith_hash.NUM_ODD_HASH_CONV;; let NUMERALS_TO_NUM = PURE_REWRITE_RULE[Arith_hash.NUM_THM] o CONV_RULE (DEPTH_CONV NUMERAL_TO_NUM_CONV);; end;; hol-light/Formal_ineqs/arith/num_exp_theory.hl000066400000000000000000000256031303454263000220730ustar00rootroot00000000000000(* =========================================================== *) (* Exponential representation of natural numbers *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "arith/nat.hl";; module Num_exp_theory = struct let base_const = mk_small_numeral Arith_hash.arith_base;; (* num_exp definition *) let num_exp_tm = mk_eq (`(num_exp:num->num->num) n e`, mk_binop `( * ):num->num->num` `n:num` (mk_binop `EXP` base_const `e:num`));; (* let num_exp = new_definition `num_exp n e = n * 2 EXP e`;; *) let num_exp = new_definition num_exp_tm;; (**********************************) (* Theorems *) let NUM_EXP_EXP = prove(`!n e1 e2. num_exp (num_exp n e1) e2 = num_exp n (e1 + e2)`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp; EXP_ADD] THEN ARITH_TAC);; let NUM_EXP_SUM = prove(`!n e1 e2. num_exp n (e1 + e2) = num_exp n e1 * num_exp 1 e2`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp; EXP_ADD] THEN ARITH_TAC);; let NUM_EXP_SUM1 = prove(`!n e1 e2. num_exp n (e1 + e2) = num_exp 1 e1 * num_exp n e2`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp; EXP_ADD] THEN ARITH_TAC);; let NUM_EXP_0 = prove(`!n. n = num_exp n 0`, GEN_TAC THEN REWRITE_TAC[num_exp; EXP; MULT_CLAUSES]);; let NUM_EXP_LE = prove(`!m n e. m <= n ==> num_exp m e <= num_exp n e`, SIMP_TAC[num_exp; LE_MULT_RCANCEL]);; let NUM_EXP_LT = prove(`!m n e. m < n ==> num_exp m e < num_exp n e`, SIMP_TAC[num_exp; LT_MULT_RCANCEL; EXP_EQ_0] THEN ARITH_TAC);; let NUM_EXP_EQ_0 = prove(`!n e. num_exp n e = 0 <=> n = 0`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[num_exp; MULT_EQ_0; EXP_EQ_0] THEN ARITH_TAC);; let NUM_EXP_MUL = prove(`!n1 e1 n2 e2. num_exp n1 e1 * num_exp n2 e2 = num_exp (n1 * n2) (e1 + e2)`, REWRITE_TAC[num_exp; EXP_ADD] THEN ARITH_TAC);; let NUM_EXP_ADD = prove(`!n1 e1 n2 e2. e1 <= e2 ==> num_exp n1 e1 + num_exp n2 e2 = num_exp (n1 + num_exp n2 (e2 - e1)) e1`, REPEAT STRIP_TAC THEN REWRITE_TAC[num_exp] THEN REWRITE_TAC[ARITH_RULE `(a + b * c) * d = a * d + b * (c * d):num`] THEN REWRITE_TAC[GSYM EXP_ADD] THEN ASM_SIMP_TAC[ARITH_RULE `e1 <= e2 ==> e2 - e1 + e1 = e2:num`]);; let NUM_EXP_SUB2 = prove(`!n1 e1 n2 e2 r. e1 <= e2 /\ e2 - e1 = r ==> num_exp n1 e1 - num_exp n2 e2 = num_exp (n1 - num_exp n2 r) e1`, REPEAT STRIP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[num_exp] THEN MP_TAC (ARITH_RULE `e1 <= e2 ==> e2 = (e2 - e1) + e1:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB]);; let NUM_EXP_SUB1 = prove(`!n1 e1 n2 e2 r. e2 <= e1 /\ e1 - e2 = r ==> num_exp n1 e1 - num_exp n2 e2 = num_exp (num_exp n1 r - n2) e2`, REPEAT STRIP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[num_exp] THEN MP_TAC (ARITH_RULE `e2 <= e1 ==> e1 = (e1 - e2) + e2:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB]);; (* NUM_EXP_LE *) let NUM_EXP_LE1 = prove(`!n1 e1 n2 e2 r. e2 <= e1 /\ e1 - e2 = r /\ n2 <= num_exp n1 r ==> num_exp n2 e2 <= num_exp n1 e1`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_TAC THEN MP_TAC (ARITH_RULE `e2 <= e1 ==> e1 = (e1 - e2) + e2:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL]);; let NUM_EXP_LE2 = prove(`!n1 e1 n2 e2 r. e1 <= e2 /\ e2 - e1 = r /\ num_exp n2 r <= n1 ==> num_exp n2 e2 <= num_exp n1 e1`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_TAC THEN MP_TAC (ARITH_RULE `e1 <= e2 ==> e2 = (e2 - e1) + e1:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL]);; let NUM_EXP_LE1_EQ = prove(`!n1 e1 n2 e2 r x. e2 <= e1 /\ e1 - e2 = r /\ num_exp n1 r = x ==> (num_exp n1 e1 <= num_exp n2 e2 <=> x <= n2)`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN MP_TAC (ARITH_RULE `e2 <= e1 ==> e1 = (e1 - e2) + e2:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ]);; let NUM_EXP_LE2_EQ = prove(`!n1 e1 n2 e2 r x. e1 <= e2 /\ e2 - e1 = r /\ num_exp n2 r = x ==> (num_exp n1 e1 <= num_exp n2 e2 <=> n1 <= x)`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN MP_TAC (ARITH_RULE `e1 <= e2 ==> e2 = (e2 - e1) + e1:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ]);; (* NUM_EXP_LT *) let NUM_EXP_LT1 = prove(`!n1 e1 n2 e2 r. e2 <= e1 /\ e1 - e2 = r /\ n2 < num_exp n1 r ==> num_exp n2 e2 < num_exp n1 e1`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_TAC THEN MP_TAC (ARITH_RULE `e2 <= e1 ==> e1 = (e1 - e2) + e2:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ]);; let NUM_EXP_LT2 = prove(`!n1 e1 n2 e2 r. e1 <= e2 /\ e2 - e1 = r /\ num_exp n2 r < n1 ==> num_exp n2 e2 < num_exp n1 e1`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_TAC THEN MP_TAC (ARITH_RULE `e1 <= e2 ==> e2 = (e2 - e1) + e1:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ]);; let NUM_EXP_LT1_EQ = prove(`!n1 e1 n2 e2 r x. e2 <= e1 /\ e1 - e2 = r /\ num_exp n1 r = x ==> (num_exp n1 e1 < num_exp n2 e2 <=> x < n2)`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN MP_TAC (ARITH_RULE `e2 <= e1 ==> e1 = (e1 - e2) + e2:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ]);; let NUM_EXP_LT2_EQ = prove(`!n1 e1 n2 e2 r x. e1 <= e2 /\ e2 - e1 = r /\ num_exp n2 r = x ==> (num_exp n1 e1 < num_exp n2 e2 <=> n1 < x)`, REPEAT GEN_TAC THEN REWRITE_TAC[num_exp] THEN STRIP_TAC THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN MP_TAC (ARITH_RULE `e1 <= e2 ==> e2 = (e2 - e1) + e1:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [th]) THEN REWRITE_TAC[EXP_ADD; MULT_ASSOC] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ]);; (* NUM_EXP_DIV *) let mul_op_num = `( * ):num->num->num`;; let NUM_EXP_DIV1 = prove(`~(n2 = 0) /\ e2 <= e1 ==> num_exp n1 e1 DIV num_exp n2 e2 = num_exp n1 (e1 - e2) DIV n2`, STRIP_TAC THEN (*`num_exp n1 e1 = 16 EXP e2 * num_exp n1 (e1 - e2)` MP_TAC THENL*) SUBGOAL_THEN (mk_eq(`num_exp n1 e1`, mk_binop mul_op_num (mk_binop `EXP` base_const `e2:num`) `num_exp n1 (e1 - e2)`)) MP_TAC THENL [ REWRITE_TAC[num_exp] THEN ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * (a * c:num)`] THEN REWRITE_TAC[GSYM EXP_ADD] THEN ASM_SIMP_TAC[ARITH_RULE `e2 <= e1 ==> e2 + e1 - e2 = e1:num`]; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN (mk_eq(`num_exp n2 e2`, mk_binop mul_op_num (mk_binop `EXP` base_const `e2:num`) `n2:num`)) MP_TAC THENL [ REWRITE_TAC[num_exp; MULT_AC]; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC DIV_MULT2 THEN ASM_REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM; EXP_EQ_0] THEN ARITH_TAC);; let NUM_EXP_DIV2 = prove(`~(n2 = 0) /\ e1 <= e2 ==> num_exp n1 e1 DIV num_exp n2 e2 = n1 DIV num_exp n2 (e2 - e1)`, STRIP_TAC THEN (*`num_exp n2 e2 = 16 EXP e1 * num_exp n2 (e2 - e1)` MP_TAC THENL*) SUBGOAL_THEN (mk_eq(`num_exp n2 e2`, mk_binop mul_op_num (mk_binop `EXP` base_const `e1:num`) `num_exp n2 (e2 - e1)`)) MP_TAC THENL [ REWRITE_TAC[num_exp] THEN ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * (a * c:num)`] THEN REWRITE_TAC[GSYM EXP_ADD] THEN ASM_SIMP_TAC[ARITH_RULE `e1 <= e2 ==> e1 + e2 - e1 = e2:num`]; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN (mk_eq(`num_exp n1 e1`, mk_binop mul_op_num (mk_binop `EXP` base_const `e1:num`) `n1:num`)) MP_TAC THENL [ REWRITE_TAC[num_exp; MULT_AC]; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC DIV_MULT2 THEN ASM_REWRITE_TAC[num_exp; MULT_EQ_0; DE_MORGAN_THM; EXP_EQ_0] THEN ARITH_TAC);; let EXP_INV_lemma = prove(`!n e1 e2. ~(n = 0) /\ e2 <= e1 ==> &(n EXP (e1 - e2)) = &(n EXP e1) * inv(&(n EXP e2))`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN MP_TAC (SPECL [`&n`; `e2:num`; `e1:num`] REAL_POW_SUB) THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; real_div]);; let NUM_EXP_SUB_lemma = prove(`!n e1 e2. e2 <= e1 ==> &(num_exp n (e1 - e2)) = &(num_exp n e1) * inv(&(num_exp 1 e2))`, REPEAT STRIP_TAC THEN REWRITE_TAC[num_exp] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN MP_TAC (SPECL [base_const; `e1:num`; `e2:num`] EXP_INV_lemma) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REAL_ARITH_TAC);; end;; hol-light/Formal_ineqs/arith_options.hl000066400000000000000000000017241303454263000205770ustar00rootroot00000000000000(* =========================================================== *) (* Options of the arithmetic library *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) module Arith_options = struct (* Base of arithmetic operations with natural numbers *) (* The base should be even in order to represent inv(2) exactly *) let base = ref 100;; (* If true then results of natural number operations are cached *) let cached = ref true;; (* Initial size of the cache *) let init_cache_size = ref 10000;; (* Maximal size of the cache *) let max_cache_size = ref 20000;; (* Minimal exponent value for floating point numbers *) (* (should be even for the square root operation) *) let min_exp = ref 50;; (* If true, then arithmetic operations with floating point numbers are cached *) let float_cached = ref true;; end;; hol-light/Formal_ineqs/docs/000077500000000000000000000000001303454263000163145ustar00rootroot00000000000000hol-light/Formal_ineqs/docs/FormalVerifier.pdf000066400000000000000000006636431303454263000217450ustar00rootroot00000000000000%PDF-1.4 %ÐÔÅØ 1 0 obj << /S /GoTo /D (section.1) >> endobj 4 0 obj (Introduction) endobj 5 0 obj << /S /GoTo /D (section.2) >> endobj 8 0 obj (Installation) endobj 9 0 obj << /S /GoTo /D (section.3) >> endobj 12 0 obj (Quick Start) endobj 13 0 obj << /S /GoTo /D (section.4) >> endobj 16 0 obj (Verification Functions) endobj 17 0 obj << /S /GoTo /D (section.5) >> endobj 20 0 obj (Global Options) endobj 21 0 obj << /S /GoTo /D (section.6) >> endobj 24 0 obj (Additional Examples) endobj 25 0 obj << /S /GoTo /D (section.7) >> endobj 28 0 obj (Test Results) endobj 29 0 obj << /S /GoTo /D [30 0 R /Fit ] >> endobj 39 0 obj << /Length 440 /Filter /FlateDecode >> stream xÚm’MoÔ0†ïû+|´%l2þö± Á õÒ]¯áÆ%ÉVí¿glg¥ ödžw^Ï̇~÷þ '$Mú#ÐB;bµ&àÍü WŒ«NÒž9O3ãÒÒœÚÕ1Ïeô¦þ›‡íÇ}9ÇyüÙÞ똧vŸmýš§4Nq˜ÛñóÐ?Œ= i\Ǹ°_ý4gÑ‘ÆÈjNWJx§6w)¾ÄWÔA_w9e&}~-ßø\D—P‡K/´t ºÝ¯ùŸ‚AsCexW6ŽÊdK®°2Z(mkrŽÒµ>4ø0tmÙ\+KШ•¶pf¶l0¤Á3%é:ç’”Nû­F ”¢5ÿ¿ <ƒË:¤t®) —ãU‹ÿv÷%Õo öŠÞ­¥æhµ°,†]`ucïY°ÿuÑkì6ÞŸ¦êy)aEæ‚iBŸR~¨£nŸ6LuòÔ^Âl7TÓk’—â~x|J±dv  uo$6×úú€emø÷2dK2ܤZ†â5 ­uþMç aº€ºÎ þÜ@ Ü]÷»¿‚Ë° endstream endobj 30 0 obj << /Type /Page /Contents 39 0 R /Resources 38 0 R /MediaBox [0 0 612 792] /Parent 48 0 R /Annots [ 31 0 R 32 0 R 33 0 R 34 0 R 35 0 R 36 0 R 37 0 R ] >> endobj 31 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [107.004 508.509 187.106 517.42] /A << /S /GoTo /D (section.1) >> >> endobj 32 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [107.004 481.61 180.86 490.521] /A << /S /GoTo /D (section.2) >> >> endobj 33 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [107.004 452.774 182.297 463.622] /A << /S /GoTo /D (section.3) >> >> endobj 34 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [107.004 427.812 233.703 436.723] /A << /S /GoTo /D (section.4) >> >> endobj 35 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [107.004 398.975 200.017 409.823] /A << /S /GoTo /D (section.5) >> >> endobj 36 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [107.004 372.076 228.825 382.924] /A << /S /GoTo /D (section.6) >> >> endobj 37 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [107.004 347.114 185.885 356.025] /A << /S /GoTo /D (section.7) >> >> endobj 40 0 obj << /D [30 0 R /XYZ 107 736.262 null] >> endobj 41 0 obj << /D [30 0 R /XYZ 108 698.4 null] >> endobj 45 0 obj << /D [30 0 R /XYZ 108 526.539 null] >> endobj 38 0 obj << /Font << /F15 42 0 R /F16 43 0 R /F35 44 0 R /F36 46 0 R /F8 47 0 R >> /ProcSet [ /PDF /Text ] >> endobj 60 0 obj << /Length 2487 /Filter /FlateDecode >> stream xÚ­YKsÛ8¾çWè¶TUD$øJvž™ÍN23›­”oIj ¦ ‹1Ejøˆìæ·ï×h€&m:ž­š‹ˆG£Ñ~}€~¸|±}Å+!ýH&áêr¿A¶J²Ì—QººÜ­>zô^·º.t·þ|ùnû&[å~ž„ «MûY0éGñy½‰ƒÀûùý¯ëMEÞ¯åõaf^O]隣打ºÖÌûÜ3±/ótµÂÏ㘹úþôj»=ŸÏ~Qù…:úªð‡›--_ ì‡9VøyÄô˜‰Ø£Õýà—ö ¢í¡©6$¡WA®þ±>!?Œ40Z>†Ï¨Õ}Ó–ªúË‹‰§UÚ:Qþ†ÚíŸÕÑ™.²:^¬…ÞTwÝi½–º ]oX×SÛ€0ö¾è¢ÿÿô-šö¯›æºÒ~Ñ·§íž¶ÐkþPJÇhji…ü‘ú„ÑZ¦¡§;ÕB¸$ö~ pŠóŠñ[¯…×|ã Uï¸qQ»ó½£Aéý[µ7kè¤hì\ß^²@2™j† ÈB¸¼åÍ:M½¦=ªªü¦úì6Q†‘=}p2ÝëXxúÔBH©kø‹ð@N’Q³fj·êÝÖ]¯ËÚØ{#ÒÈ`óÙaþ§©îêæwXdV54.N§ª,hG#îþþ«j®H EûV4–zïO}ytò?2AæÈ‘Óø%Ž6¼wÍÐÖpuœsn§ï¼î¨z½ãî­º¦.ëë—¬ˆãÄŠXûéýÛWìi"ðE¤Û¹G¤›@„˜<٤т‹îÕôQw¿RmáתSðµ¯Û“nN•Þ"ȶãéZw›ç½Ñá¢gsŸ€Hïm½Ž„דë㻊å£t˜ †¼úòPv|лÆR1uíò ë®hË+2KªøCfƒ7ÖRû¦åÆWZ®ÛòS dá/°Ž‡oÝÔUYkeÉÑü}€ö¥ã_ÚœËИæ2tM|‡†!ÙîÁY«®+»^J ¢>Š—ÔH¼ð³è”Ós=ëm´@÷LË”ÛiÖ¥jl–±ÊóBèžTk72*S“¡ÐXÊPXxBt™$•p’2´Ÿ‚8°÷&l-mË¡HB.*L›J™ð¦ÔøEßZj§^ÑÔ_°^“£ýк66L´ŠCI³ˆóªát&Ô¥£¢o¡NꪚÐÐ'”’µ÷wÜ?’šCÕ—_×ÐN!Ñ÷šEݱ»3=t}[rŠu²‘÷À)Ôœ¾r¯Åy©úz¨Œÿ`b‡°.ë:$"ò~kZÍãæÜ!Za±ªîÖPž i-~SûcU¡ì>$­Ê²z fmþ{`‰Þ&²ÇžÓü,?—Ù|QfC}šÈQ_ú6«Ý.pBžGß„–@LÍ‚Üüô8 ­ñHð…-?ÈFã.w± É-TòzNx ºF~–ʺfs9dúŒ‰ŸÈ±îýìžy× JÇ~þyâgäIž‘gÆãõtãг˜ (Ð’€çPì·0óÓ8ûž1…æÑ÷Œ‰ú‹ä;†’~ž‰Ç'óH«‡–Jqyelì$—„ %>¶8=æ"}˜sBóé(I½WôIø“ºÏktL6 S?3õúžS½äÒ Ò‘fb°éù¤¾£Á¾,zX&P òú&ÉLœò‰ ’syB¹X3{Ý.î÷ð°ÿºý®ö“~˜>¯Р˜Yw! 3@û1X .ˆ“UŠ?™W^.›KŽæZ”abMS1PöC]8XJ(û¨Š ràîQ98ŽOYÕ°3ër¥…G‡nà¹&5w¤)4iËþpÔ=øÃÀXhÐ2&’e^‡ZcD…C:½›r,ši0ؤ˜¡ÂHè ØŒêaœÆö®„飺-S¤tï iM©¶Ð®µ-"Œ±”£úÓáa0A$/Ã>2JpÙ@m04·ºÂvÔa” $5&UÝsYÙÖýÁ¢£Ü(˜9XªÚ;æ¹€&î †>Š»ƒ1£¸%Íj’#Ï .cViÀ}ÄanŽ,}td†rÏ_ÍõÌ’9•Ð ‘†ZLL6 b¯ìy)ËI­+Æ*Üa¯h€c Ú2bX9¶&´Eý2Y†5`¯Í9áž¼#`y4÷½’ YGMdƒØw,oùì5]«FAA‹xÂÙeÝMVé–òù˜y1PÑåÖå:“tËM½»ÊÜ(ˆúDlÈ…ÁAKuê~e§vw›¦ÝÁ4 g¡Û–F$α£R°¨-ÇL"ïD‰õý´½VuùoÂÞ à˜MUiÏ&¡ÉÈ°Ö·–„µ7#Úg¼d¥|ÉÂXïÖÛö8uuOîî?ÙKw¿¤-ö¬ êtK¡ÏïCé® ÔµviYEw_4S&Zó4¦áIz4 ì÷ÔÒ³yG(\Jïbß› H@!¯zÂÜ‚ï`k<®±7"Ùé^•#÷6KúÐ ìH+£œ'9“‘º¥ý^—8v1' iït7+•eÐœ&Ë9 Ë`n RR&.µb¶R]o¥1f§ŸÆn ­8 Í®Öì—½pÒ Ñq¸HOߪã‰s/¨X|ãÆDh6G¯ |ë/=ó'ƒp|2˜xÖ“/œ¾)[Ú(ŒmÆ‹SJÏôâ’F^iGî(n›;»¦þ›]1KÃfäýêXY6¤™û>ð}?õzîÚÐ;»[o\ûÑ~µÖ–‘qŠû…vð OE •Ò`¼ÊÎ.²¹¡{&2ì4‡Âa@&\ÃèûÂhGÍÈf˜€ 7˜¡/xØÎO95µŽà8/,(+jãÈžVÎ:2Fx±´/*Y<{QÁ8%ÒVÈœ{æý%s¯÷ËäÔ0Ômµ+Ueß´wœP7qž>¹¢|àrÕ ùvCØxuÍ10–Hêì›ÁAiKÜ»æ`[?«¶-;x_ÇÄO¿‰#Ä쳸øHïC á¢2¥¯·Yd¬€a,Ø@ad_ÂÈT ÊuÕ¨O±‡cªjaX†-)L^_óg:nŸ]&(û^[þW‡Rû¢Ò·LùK«†®{µð%ÒOÄwé-’éV75³Áv{UöWCq£{%n«n ëÏøÜ<7íÍ•®‹ÃÒÛ,@z0‚xrŒ8G°­mMÃQÓ(³at~~4g1îX Ý“-o°ü3D$jêJ‡L<<éc†Eà€ŸÅ µ.Pk~Ò¿Cmsݪ£-¾"ý8Ü—H™"Ÿ¼Ë¼øçå‹ÿ0\ê] endstream endobj 59 0 obj << /Type /Page /Contents 60 0 R /Resources 58 0 R /MediaBox [0 0 612 792] /Parent 48 0 R /Annots [ 49 0 R 50 0 R 51 0 R 52 0 R 53 0 R 54 0 R 55 0 R 56 0 R 57 0 R 73 0 R ] >> endobj 49 0 obj << /Type /Annot /Border[0 0 1]/H/I/C[0 1 1] /Rect [122.501 647.466 334.205 658.591] /Subtype/Link/A<> >> endobj 50 0 obj << /Type /Annot /Border[0 0 1]/H/I/C[0 1 1] /Rect [122.501 615.585 423.121 626.71] /Subtype/Link/A<> >> endobj 51 0 obj << /Type /Annot /Border[0 0 1]/H/I/C[0 1 1] /Rect [122.501 583.705 302.325 594.83] /Subtype/Link/A<> >> endobj 52 0 obj << /Type /Annot /Border[0 0 1]/H/I/C[0 1 1] /Rect [122.501 527.914 386.011 539.039] /Subtype/Link/A<> >> endobj 53 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[0 1 0] /Rect [150.935 453.443 157.909 461.856] /A << /S /GoTo /D (cite.HOL) >> >> endobj 54 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[0 1 0] /Rect [162.322 453.443 169.296 461.856] /A << /S /GoTo /D (cite.HOL-tutorial) >> >> endobj 55 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[0 1 0] /Rect [226.681 441.488 233.654 449.901] /A << /S /GoTo /D (cite.flyspeck) >> >> endobj 56 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[0 1 0] /Rect [394.731 157.581 401.705 165.994] /A << /S /GoTo /D (cite.HOL-tutorial) >> >> endobj 57 0 obj << /Type /Annot /Border[0 0 1]/H/I/C[0 1 1] /Rect [471.622 138.43 504.996 149.555] /Subtype/Link/A<> >> endobj 73 0 obj << /Type /Annot /Border[0 0 1]/H/I/C[0 1 1] /Rect [107.004 126.475 334.897 137.6] /Subtype/Link/A<> >> endobj 61 0 obj << /D [59 0 R /XYZ 107 736.262 null] >> endobj 62 0 obj << /D [59 0 R /XYZ 108 678.571 null] >> endobj 63 0 obj << /D [59 0 R /XYZ 108 678.571 null] >> endobj 65 0 obj << /D [59 0 R /XYZ 108 644.477 null] >> endobj 66 0 obj << /D [59 0 R /XYZ 108 612.597 null] >> endobj 67 0 obj << /D [59 0 R /XYZ 108 580.716 null] >> endobj 2 0 obj << /D [59 0 R /XYZ 108 513.897 null] >> endobj 6 0 obj << /D [59 0 R /XYZ 108 242.222 null] >> endobj 58 0 obj << /Font << /F35 44 0 R /F8 47 0 R /F37 64 0 R /F46 68 0 R /F14 69 0 R /F36 46 0 R /F11 70 0 R /F7 71 0 R /F10 72 0 R >> /ProcSet [ /PDF /Text ] >> endobj 80 0 obj << /Length 2404 /Filter /FlateDecode >> stream xÚ¥YmÛ6þ¾¿Â—9o[Ë"õž4’ÞÍ¡EQtûÐ)W¢w‰èÅåìúßß ghK¶¼MqŸDRÃy}f¨¡ÞÜ\­ßæ‹"(R™.n6 æ‹4σ8Ê7Õâ÷åͽ¾^É$YšÖª®Õ`º–Vº =O2tðÌ—]MÓM×Óàó5¬êÞ¼E\Î0h»¶6­V½—¤?íTm£-¯Ø £=ͬi¶µ®W±(–ÿêðÝC[wªºþãæ?‹p±"(’„ìpJFQ´¬Œzs»#5peÓw nY¿£®8ap? ÛëuÙU:¸ëº;\vÍz»ÞÔ{»ÕåÇuÕ‘x»®AqÌ/3Dï ø;=à >ªNÖv 1˜œÉvª­1}¼|‹€O€°Dòô¾×[Š‡5C‡NÃÅ3ÜŸl·÷º®i ,jT[=á””·ŸAD&°ƒžìï v‘óº è×C¿k?®ª?`í¼Ò ˆÒú¢XŽ¡…ÓRµ4¸uËL´­U©+&B ØÓ¤2½.Ù0í˜f$Ý®gÞ]³Ý ºG`ebùn`†–Ÿ {µˆ÷pÔ£…4þñ—Ÿæ°ø“¹»÷;Á銌èv‹eWÿÓÒBM ”:¨VœZ1Ÿ8zvT]«/Æ{s-€90ž¦½£×¿ü š) ^\€Ƈ«ÂýÃV¡Á‹Wô|v\N:-`qtˆÆ3Þý‚žÿ8p}ùò/òz¡:1¤ã’ <­¾=I²1¢.ú±FW© fbY]p¨ó<‘9#—µZW–ÝôŠâÆè~Ý|ðÃ2mp_?ûÛ]vÄù¤ðâÔ!~ãI x·•ê+š!0a33„¢ÛinÁâ^A†œ"e¤iZ8é?ïêÁ|V½jµîµªU« û Ggª‹8 â¸ð›ÅyQ8 0AVQšBÄÓ]ªIÊs¨J”wÏå™jug¨|8F€5>ÜŽ•ÞÙ/\°pá¤nx$ÆhúJ3D$rѹ†c’"Ä¥†CÄçŒsœ²ÁAåºÞh(d¸OD£H{1J!ô™ÈÈW‚³žªv^„[l­¹­G›ñé\r¯Ú;^·]㻺»U5»-Ö>‹Å/Ê6VO^°À^ÏÕÛJÛŽ|Jlö‘i}e(1wƒ™Ž#^O΀ Dq*9£,ÈbAŒ#Ø ‘Ý™ò:îàÍ’åoƒêçÏ™y(Çg[DÎA/îÛ®1ªöúñGÕ1ƒü%TÈLË –bbù> Ã™ÔƒÌ £E z™@š«ß\}º U¸À- -âP"‹²¹úýpQÁKpg±xp¤œÇ0¬¿]ýzõ?!O4#^° Ö ’¹‘‹ — Ð 3Jf¹˜ŠœÏ) 2™ûàÌ8MiV,Àe±ô.“1Šï&ÂW«ÇyV¢È<…gã7æG=æ,‹“0ogALþË™ú:åFÎ؃l¤WöåŒ9EåÅÑÂѱŽîJSyÑ)‹ÌÀ˜4H"ù”1iBu™"GLNb5¶æ}‰y÷'Qqêþ'£8›E˜89g“_ä"0çÃdùj†›”A˜ÅGn‰˜Q NÑÐ>…V¾)²(G‚$H‹"†çá!µV#ª9óò INƒzê#„ÉÇûs}ÀGx(ŒDÍ8 ’e}¾ùKaû9Û%×—t^Tþe¢Ò¿ãæxÆç².Ô؉´lNŸ0ˆó6¾¿PÑ8›—C ù„_/Á‹s2ÈŽàYQ$þ êY$ܦ|¾Í}ZR×Îëêr›=†;T'mžÄÛaþ3Y&A.òCò„_Ógr£>rï`w½ï"îÕ@£“¤ìÚ¾ íI×qÞLúP·òµOØÓ÷É~Öço5÷Ê?O·ÉeìòZ³]¨^ÑÁø¸LXÿ¹ZÉsAÏ5ûéS? ŸGÎ$·ö÷fLù^DñdÅ6Ëãf¢F5 A£é§­×ÁïÛšs¡û3¡û)Á¬ß_½ú~¢á¶{ ä€MX­&´Ów‡,ý›ù·é„ÓólBü8ÏŠUô^ø ú̪?9º+uFÌÇx¸ÿ–}7¨Áúh»‡CÊþÕÞ(ø¦¨÷ªaÚä• íâ8¥èƒ3É—˜¸½»`‚‰ã§©‰N j:`yðÄs—w¸¾Ùµ¥›Í4ŠaÄÉ¡ÖM9ÓË|œ2)d¯kp(ƒY|6'þÐ8'Ë,„“.›Âç¿×y„5+–‚º³XJïFZ¥þ¨Þá=#Îï YÛí-7‰8¦Fh@E{¸ù™³]@‰>tµóz5_&£®8 ‹åkÐ úHS+×-¡øC›ƒ*`›ÃƬ¼ý±û¨˜Øÿ…MOKå:ž6ãëß(ÍqK×"›4›@_Q£K:, ~'4§¥á®ÖÀ`™ê/­Á¾¤ƒàºC·dw5áö±”^ùN0‰±tÍ&îQ«¹rÐ4–!ø † ÑÒœ‚* 8bÓW]lw ʾ¥[UÞŽªãÓš»–éowsg0‹‘¡'=\?â¤×–¡‡ãa×·$¿Ea{«93¼·d.'Þ’ù¡4^¤™z Ûfð£îñzCÑAWÜïà„›Ún • páî¼Jô ï~Ç×}«êzÏ[kÖ©U`ŽWÐ…mçn!½3Ê †ž oªÁ7zt‹;Kx€¡Â›•ÂÕ­GÿúVYÞ‡ŽÕ<œr‘€IBûÜœ7—H€ü²xRy©ˆ=’3X¯,š¯i¿ÑküýA%¢ÞÏYT«ï1dš;­èÏLU'”ÝPuhê~nÀS„!œ8qW+£ÜB«q¾ÛÒSõðÁÈ6%Íϳ#–Ñòu9ì\P\N‰eÏA¥ltûð dãkƤ Ú²ìmÙYnÒb¥ùŸݪˆeå^ä®â yY+„›Ë NñV•¤œî#¸W›“WfÖ¹û¸ âü±’ò<xv_FxÆú•ôÓsµ‹<,ÓhfœRŠ0Ì4PTNG{'•2š–YÇÀ} tüÐúA¯œçã»lËÿDý$ endstream endobj 79 0 obj << /Type /Page /Contents 80 0 R /Resources 78 0 R /MediaBox [0 0 612 792] /Parent 48 0 R /Annots [ 74 0 R 75 0 R 76 0 R 77 0 R ] >> endobj 74 0 obj << /Type /Annot /Border[0 0 1]/H/I/C[0 1 1] /Rect [107.004 661.317 360.053 672.442] /Subtype/Link/A<> >> endobj 75 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [195.976 490.181 202.95 499.092] /A << /S /GoTo /D (section.5) >> >> endobj 76 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [186.013 188.471 192.987 197.382] /A << /S /GoTo /D (section.4) >> >> endobj 77 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [314.99 133.178 321.963 145.133] /A << /S /GoTo /D (section.5) >> >> endobj 81 0 obj << /D [79 0 R /XYZ 107 736.262 null] >> endobj 10 0 obj << /D [79 0 R /XYZ 108 476.35 null] >> endobj 78 0 obj << /Font << /F8 47 0 R /F37 64 0 R /F35 44 0 R /F14 69 0 R /F11 70 0 R /F7 71 0 R >> /ProcSet [ /PDF /Text ] >> endobj 84 0 obj << /Length 2102 /Filter /FlateDecode >> stream xÚÍYKã6¾Ï¯ðQb(R¯ÌN€,°ƒÍ"Ù\¹$‹[¢m"z8Õùï[Å"eÉ–gº °—¶X$‹Å¯¾*Ù¿{÷þS¾)Â"ÓÍÝ~â|“æy(x¶¹«6¿ÉvÇcÈã@·Ô6Ç- }«gÙœj×Û]œÝþ¢Zr¥1ŽÂ"âs~Ô\%¸C,U†Û]³àßQd¼9Jã¿œˆÐï5@(J É-ÌI~xö4žtíðØKí¾ôþBõ©'ï³Àùqݱˆ‡Œ‹%¼'ÙËFÕÃL‘[xjv=5k5 °'‘ò৖ºh1c`±£]Í>ʶBV F¦ñâhÚtKMéæKúùçO?ÐÇúptÑfÕ«¾W±ˆ¥g«lÈš5Äm¢ˆÑîÁ}9W² A…*v i˜¥±ErÞ)[úÅ1ÚÓOr‘ê2ÏØVn­ÍÁ·IÈ^Ëà™SÓR—ËéÇ=ªRUÊ%—•Ýñ`8¸ÌšÃ“+ŒIFcH7JÈJ0Ìéð2‘vØ»4Öl\9„‚KûA4»±v¶<Øœ¨n,Ž®¡”"ÒYN¹Üå„r›°¬5²5$QÏìI@€º˜xÿ‰±™¢" “4}VÏßÖb& ßÿqEØ!2?àùZA&yîû!c¬hˆÃ,›©ØñL¬™Â²¥â–,ÖæG¼ •…Éq˜Oë€ÃS–Ÿ¶9§„WD’%ÆÞ‘ZààÄ;“ˆ’`<ÑQ§ÜdžÍ²qR„iÌœûRZ¢îZO[7Aðø’VmÐ!ìŒ?CB¥¨1%¤(Ï<ûÕùe Ce=t‘z  n:¯ƒDš»Ã7¾X­–TP‡í!ª4$è•û–b Û’æÛ3?fg*6!YC и±xÆ ÔM‚‚¦ëˆ;üºFÑø£VN.ÝÒM&b‰rÔ%Î<0ž¸¶ouŸ®<Áä:'&B. ýÓ‰Â3 oN B…ÇXœ?o q¥+K ‚ÜóéÚ -NÃ<Šç.€c°‘ö ’d7êÛt"é9¨œHö“÷/÷Ó+*Hw-Ý%±Ù9Kåd ”kÍÖÂcæé¾ì¹Go¶ãçC×ÕÓÒ·„yTÏ:ÿïh¹÷ûZ¾€Ã‰2'§³¯¢[õ->ò`kª®¡ðZløMŸNoÁlßõ eºsf\×—ú\ßvSÃð@Ó˧ ¸n@VSª€ÿuð«“ntÉôN¾Ô4' Ç³¦òc ªì³ŠÁæ{oî_‰œÈá‡áú?ö=\áã£ÂÌ×hïäW…–#Lܳ§×ª—¦Ñsó®9~“O²’'Ì6÷ ¼¿»£ßÿâ µ«¹Eíó’|ª{šPŸvUb·[ñQ§d__æ…§¨ÜqøÔwíÁwcíL®Fu‘ëðŠ¬ýPÕ÷?Ó^K{s )zœ¥j ´mW7±™Cqƒprƒ[AÉ+"I–'ξî¤ùàl¯Oæ??|¸]ʸšà;|;-0 ¤®mÑ‘DÐÊ^Ÿ\…"ü;³½Ü ŠDÿ–+Ü‹,Œêm,,VØú©PeûÕÃåTK†ô„÷½[¯éüö,ñò›z•¥µÖj»ñ€· <¶¤à9GB;ÁÑ}L7Ülý†s¸áNr¥ö(GeÒJm5lħJ~ƒÅ >ÒX:c˾¢«•`Nÿ"‘‡‘0v6ôŠjÓÍ.›¼Àw0㱿£AÏ»ܽû/òÑ| endstream endobj 83 0 obj << /Type /Page /Contents 84 0 R /Resources 82 0 R /MediaBox [0 0 612 792] /Parent 48 0 R >> endobj 85 0 obj << /D [83 0 R /XYZ 107 736.262 null] >> endobj 14 0 obj << /D [83 0 R /XYZ 108 531.955 null] >> endobj 82 0 obj << /Font << /F8 47 0 R /F7 71 0 R /F46 68 0 R /F11 70 0 R /F37 64 0 R /F35 44 0 R >> /ProcSet [ /PDF /Text ] >> endobj 89 0 obj << /Length 2352 /Filter /FlateDecode >> stream xÚÝËnäÆñî¯ÐÉá ;\²Ù|y½b ;0‹Kh{‡- 9&9Z Žÿ=õj¾¦e-’[.šîbuUu½«õýíWo?$ùM–™Ênnïo⨸Ɋ"Ô½­nþØó°Û§* ÞóO´ûÇí_Þ~(g’,Ìbuñp·×: ~lwû$‰‚Þô–W3Øá ®ã VñD•Ak»}Øa0ý3ƒÆŽQLõÏË02×µ¨¹U¤_ôJ´¸˼p(ŽäƒöFd´Ã¥EðÛ# EË>íö*äU×Êês=‘åÍ^©2ÌK}³ã°LSáv$¼$8t§“i+Ï"< —(øÄ£íëû绺µ¿°²­ì½ÑîΦ7'1±¥ÕÖ6±ÝÇÑo¼Nùiݧwï®u㘋¡oIÜ,{è@ZXðÝÅ9‘qFÛ3FwÏ¿£;ò¸SEÂÿÅú`ƺkùøý¥…ãdÚ±†•ƒg§QøJ§à#í† åsoõ gÎ÷]2 ƒãiLÛ2F$VÈøZÈ©ººEÁìJë ö=‰: áãT ßIÛ|]Qáòš”Ï$.Næ©&1pC .'üû‰xòqM2#™¡~hECKaªú¡‡%ªáyuñ*öU”?…õxAû´¤º ˜ÓQB0 rÚBÐB[ôíJ?€Óå¤TÒÁ¶·ožÏ"Ãy o<Ôv#C*°°£c)æ$lûÖ4÷FCFyиY5*|ê  ô¼c°Â bàe¨ÑçxgøjýÉa|‚<äÀi4X¡n/Ž _R†âxêSpS7ñ†I†~³CÇõ\MX%Šä‚Þ6 TŽ—晿5¦TIÞP?ow)س¹lèÅQ„¢0ó›âðtc@ºœnzHàØõ÷k;S€óýé0^À žë,‚Q•{kYÌîUk÷‚ý•{•å6ü±²"L[ „Ù@!íRÄÁz#Á2Pa‹Ivq´ Hõä6‹Ž8Ÿà/é\GY€‚æâ® ™½ à’ÛîŽN^KׂZ³ŒPN.¸içŠ"†J½Æ›V=V$ë<l}Þù†×\eõä,¶í.G^³¯À·öÐ[qÓd®Y¨hL*ìÚ¸p :Ÿé$Áå ‘7Æ9;×U't–I¶¨6ZeÀ±î+^:ÊH¨g)™°ýqGžƒb±V˜«È§áã¬ÄÇ«ã¯áŸþúcýTƒ"Ø%‰>$x^}>Bt‘·.”¸JYGÍk¬µ9 u¶/›`°Í=EV*%„#Æ¡’FªwfbaèôÀ8ã|°i:$ÿ"ì›×;ŠOÝ…â [d„¿̧ƺÞáýw¼Ànǵ tç—{†biŤ”I˜!€ —œÜù+ fÎŽÝ¥©O¢…?Ô-GGõÅÂèl! ¶]Yìº;tº´€n#ÅFcM‹NÁ]žÎ=¡»”zû!ŽtÊyäW*¶4&¢2âÙ¥|DÁD½£~×âÏ;é˜;ƒx(¡â@'æv<DZÃp}¬+[‘lf˜ŽÔQRwÎò¯tÑõ1ƒΖ”¹>ßBJ-V®î?`ñ u\Ôò½î¡È[Ö—=¬I|¿ BQ_®•50èdðBϼ™âA_ƒ¶:žì㦑MBPI%“o¿ý9N´Ç¥t«¥wRcýÅ$ Ób÷0}\ÓK쌗.£ HÜä#é«T °…‘³EBÀvßÈØ0öõa|™vOžÀRß¿¾ŠC=O°þèTaª§¨ûî•!í!_[.±‘˜\3QQùÚ’èR@¨>7—Ê9óÆi–Ñ$÷ðK?^ËJ5Ùâ‡JFÅ$¹Û×ì)Ý…¤Ui¹È;øfò2Œfe»ríºO©‘siÏôå¡.&NçÚÃ( óÙQ_pŽ$,r=ã$ñ5ÐO’/-».Φ¤2Í2™U¡<à;$vî–Ó¶*ÔÔÐÈLM—™†eYvnhŸf>jšacørÌ''Fç& Cwšy<^/'G.Òr?2ñ¨,¢´VÕíÄÆ?‘ ¾Þ‹ŒÏg+¾sÔ,Âyœž1<ä% ÔOm Úئ¹ë“ý†î@Þy;eTîVì¿ä¸ô¬Û|p}âoDÏöá¯Ådö>áûÒ'¥YÌ6>'eX¤ñüÀ5iäŠvªÃ4žÜ¢‹"ËÔäKJñY\&ÞçBÂ!&"Zò;¢ÅyÆÑTz^Tþ•¤1ód£ý•ÄZ盎Væ_®káP\s©ç'#.ƒÎ]áØL`Ù9ØêÒ[†umóÌx8¯7ܳ âCvhÿ0ò7NÚÞh‹S~\ÀeºþA./4ü3tÍ…å#Lt0Z¨P¸§±žÉupeY‡CåW)Ie!% ¿7Ë-®^6ãFþe\gʼ1õû3|¬Z$JŸ®Á’yHfÇùâô„º¼¸äUav=Vª,BÞ`y)HyA8¿Ý€ó(¥8KÍøQQøE öÉFô‚…Áœ„™6Ÿd¨EØò‰b#‡'ÅxRó¹PÆQÒœæÉÔÇæŠ;J­ûUĹg„m«  ¹Õ„ÍÜqÁÆ4 2½åRR^ 1·Í¾§½^æVR%Z÷2¸G©º]=9h×íè¿"UGÃ6õ©nÁþ•ŒÓ0ƒhnVá4Øètæc~r^¯J þ/³øxŒßðênõ¨~õ(ï{“O^,R¿Žå[¡÷Ì?܉/!áku…±¥ñt…ñ´¡‘l†{ùþÇ5GAÎ>¾ûJµÐú?ÖÐF'ÉG_ž´t!N%_Ðã•Þþ½ç_¬+ÿ…ü܉¾¢‡/ÖåzŠ·¤•÷^ÿ»,[›ø† ˜F£')h6 ”"ÞW¾ýê?±ÏqÌ endstream endobj 88 0 obj << /Type /Page /Contents 89 0 R /Resources 87 0 R /MediaBox [0 0 612 792] /Parent 48 0 R /Annots [ 86 0 R ] >> endobj 86 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [396.599 592.714 403.573 604.669] /A << /S /GoTo /D (section.5) >> >> endobj 90 0 obj << /D [88 0 R /XYZ 107 736.262 null] >> endobj 87 0 obj << /Font << /F37 64 0 R /F8 47 0 R /F46 68 0 R /F11 70 0 R >> /ProcSet [ /PDF /Text ] >> endobj 93 0 obj << /Length 2429 /Filter /FlateDecode >> stream xÚ­ËnãFòî¯r¢ƒQ‡ý"›ä0A’Ý,‚Í.ÖØK&ÐRÛ"@‘)=ûõ[ÕU|‰mg&3±»U¬÷«‹ßß\}ó“¶i„6™ÚÜÜmdê6™sÂè|s³ßü–Øë­”Ê&«ÛÛ²¾ÞêÜ&¿>œª¶é¯¿ùÇ7?¹M!ŠLeøvºÙªL¸TÑ»7½UE–´üBØ<ªÝµÊ“mË·©Ô~w¢Ýix¥ìªÓáèOË(àéß•sTC«¦<;ä/¼Ûìi¨m /4÷´'mÕ\Ã#PÌ“°>ñ÷–IÉP)Ea-  Î}xËÐ<ñ´é}8Õ‚»¶ótÀâèä=Jì» 82» ´ÄRMÛª§gÝ–{¿×[£eòæîä;¢4ÇçÖø áËŸ¹À÷ Ì—JRí6*#ë[©™É`s'HJ$ùšöD –˜6;„8”Í=±žºäæÚ™YRšµ` ÓN¤€;el`•ÎIXX µ'w¿œüMƒçæ D`> }ÇÈÄ¡^»ç–àIäŒÞªÉ Cdµ4ô äµ6IÇ:=Ñv_uà®m÷ÀÚ» ðɤ2A5€L7ôŸ&¾¿¶6)«º¼­ùxTv€éQ]õ#S¬gà‚u‘Í…“"Ï‹€©*H¸Û²÷k5Dæ²Am?xð®cÕx$Œ‘ÖÐËáü™Ž:ÿÐùÞSø„¨Â¿ÇØC1œò!Fº´`Á~ðwå¹>ÑKÿõzá—êþÀáˆç‰¥²±Nìé“ÞÕŒ:Fƒ9€U¬ÝÛª)Ó½MmZ /^1Èi€!ɵæ·T¢T²1ßÐÑøÆ°œ¿8š]çaǘzÎZ`ÆH¸¡F»E@à~•ëððö|ÂElò[ußÒªóœÁ)ð²Bý1¸)žžFX8뇑í÷+ë£à€ôØ ˆjHpovÔýhX­Ù»ÑùÏü÷E„Lê ùiÕÒe¢(ôà 2M×>,­È 9€Œ|9Ù&hyô§!ìÈ;ü#‘E^ÑÙy0õ¿»öxÄ ²fl«R¡c@9Vä;å›EÞ!Ù,TÌo¿£§JÓׯck¬p"+„Íg`È>zõãÍÕW(_º‘P”¡¨*»±Ê‰\ovÇ«ß~O7{ø,%tá6ò¸Ñ¡p§›zóŸ«_}êûœ¦”©PPé“ÕDÒ?=Drjl,G@£@º2™Fv«#ž"¢ù?X<Æ|Š°ü’ZfŽhá©EÕÆýeÕƳÌœlžiÐäœÛ‹˜#ÿXRB§×KB:B(žQ¸ê `! ¦k<,ùÏ’`O]õPû¨e–r®pð†BŬ 2dЄg–ÄÒ¸r2&("ðiÉG(è\n ™H÷æàÿáïj)‰>6_'Åzš‹T륎!@ V‡èw9·{Aç¸ÝÏË ì)ì`ÑW÷ ­B¾˜ÿ±Á«˜ ±Õ£ ›µ„…pÚŒýÂã $ŒE:jÕÇ´dŠ G7°8V!—?W…ÊúSVAè/Õ·ð'ìÞàÁ¹ך¨úö}I ,w»nhóu ²"÷ãnn"„ßµÞÙs»œS'àϸ¬NsÈ‚òS]Ö,] Q›ê’ûŠúÚÁ½´ ÆXèç–ÚÐ5;ø/Äd‘+¾ÜÅì—ËÑG¾ÃıÐÌ}üi*2oÓX!bfŒD 0ùŠX®‘tÐÁ€ì€¢‹ù’é *æ2:çH2a&Õ©C°ØDÒÃסŽÁ*&ˆŽ/ƒ‚3q¨˜a¥/hÉ YÌ ø,5ÀÜF$5Bå } éJÏ€´ÈÝZõ <™PSÆŒVNí pÑbcl.àêóRéTB;½, bºPBZPÉᆭօPÁ¥€€@ŸKËP‰]ê.Ôµô0[äó¼¼èV¦^uu‰ÕÙ9à¬s6Ñœ½fäøÕܵð`e[b¿_³¯]P3óÿ3Öx‰D¨0RÏsn‡ãSw¦¤'“W\DƒÏãË ´› Ø2Ʋ®é` O©O¸,ßREzlÄÑ1;îÂE6s”:#’Xç{žîë2CÏ£¸;Ç’d À¬µ]õ¬ S–…¸›YA!Eš+0„,}NûXaÓ"`2Ù_²=T<¶=®æuÈRK@/8 ÈG£ã¦ ¨$“»nåÂK|!GH–MŽ‹…Ét\-áŸÁÈ‘~rÞë=ïJPɲ—ëçǺ`2€é£]éó)®4'ý©®dÒ‚o°)6áO|í…Sr%\…R”º®˜»nƒ+!ÀTÀÆ·Šå(]M°åéªÙ/QˆÔ ž¤.†,ÿlOþ[š„ùñ6dvaH<$Ña°9—Î%÷0d70ßM¨çâø+›9"§Ó'&ÇÌÒµöCtúXÁãÖÊF0èÏ5‹ÿßK¯Ô¿ËC9AɽͿ§¶ï+šÔfÊÒ=í¡}€`°pÝMñ€Æ;MK.ÏŸch2ÆÌ]¼8½Ù(nt… ˆB{ƒPö0u/뿈<¢Y5ÍÁ‰”f¼a°†á<…ípó˜9Ïl(>~áø“DžršÍÍì7¢hüjñOåñaøHÒ(OpÒàßyZžÝŽîá†ýâWRp+•rœL¤_“›®p1Oϸ¿Ùàæ> âê–ÁÃ×.: Ï¸Æo[¡EÅÍiÀLÉi²ðWÛ²·~=L.o÷{&þÕå—¯¯^Ö†‚V¬…ú™¿R\0r)â4Ë^³a?qø=2óÑÜ@!–TbŒ\¤î†›ÉVa©çè͆®âÿ» Ï® endstream endobj 92 0 obj << /Type /Page /Contents 93 0 R /Resources 91 0 R /MediaBox [0 0 612 792] /Parent 48 0 R >> endobj 94 0 obj << /D [92 0 R /XYZ 107 736.262 null] >> endobj 18 0 obj << /D [92 0 R /XYZ 108 698.4 null] >> endobj 91 0 obj << /Font << /F35 44 0 R /F8 47 0 R /F37 64 0 R /F36 46 0 R /F11 70 0 R /F14 69 0 R /F7 71 0 R /F10 72 0 R /F13 95 0 R >> /ProcSet [ /PDF /Text ] >> endobj 99 0 obj << /Length 2025 /Filter /FlateDecode >> stream xÚíMoÛ6ôž_aôd·5+~SMwhð†»¤¡ÚJ-À–]ÛIš ûï{)Y²)K²ä4.–CÌÐïûñ}Hùpuñæg*{>ò½«ÛöTO(…ì^Mz×ý÷«h3-–›h¯Ñ<ø6ãi8ZG‡ƒ!'¼ÿ“ù`ü\^n®~íy½!¡ÈÇÅ'{/ Ðo‹`bV›©=~®¢Ûhhö«ÅbfV/á(N1bŒ|Î Ê8 'kó Woæ£t9šQŒ¦³;üì3tUΆ‘Ù¬Ç]|¶àãi ­,ÁÆ~ÆV‚hVHðWÊjªÚ(¾]Œ–«(ÞŒfá}h5ðÖj—85»X†–¯ß‹²h°-ïa†(DS‰|bM+Àœ}?™Dš‡hRÉû¿óå,\*皺@Ê£A¢<'îDõþ'³T…z³€OÕ×æÔN¢õf}¾ÛŒa`y­wDZd=nÌšp†C–o»mEλ3ÅQÌñ„a‹k=Z.fàûÓcÙ¤”õ—š0ö/æQ¢8ØŒâîK¸ÿõVÁ ÔÚ·«Å\¯¨ñ|½XËD=áÊ€\Ãv£ecV6 5^ÌçAZÌáz£í¨é_ í/ÌþJX$–ð°Àk‹¾Af5X¢œ ï(Á¤ƒ_å!X¦|QÌ _z˜µ¥<6No65×z©*ÙÃØG §Ž©¹ûGŸÅÁ<ü÷Ø#ˆ{2=ù0 W.üD!3¨î}ŒÂCBÐT\˲ˆC»¸µÂ%‰yÿüt1›-ÃäZ‚}Œ°/­Î­þ¢øË[k»¦ôÖãéCx:b‘a¤XÆ×k&<¥2N\ÊBLàÚ(ÆÁr¬×ak^f÷­ykòìj`YRÏ<ø‡›h=w%‘'YmLÓ0Xmö±@FÀ<ã #Æi1ž~Ñ®š\j‘½³»p©Á¬wƒ¯’ø×é]†,"]ƒ/qp·!aÈ÷dêQJúSýëAÿÚzf¹³Š#IÅ*­ k]ÖêLx“ÎÄ«êLº²jikód+ÕÃÀAi{G¡­ó¸_lïÒ'ï;}\\¤ùD“T&Óʇ½ÎÎŒ·ÝHåLíÜÿ­[³fO=· ž¤ þ¸ê‚>™ô„RQ€+;Xç’úunÛ܆«¸‰®êôétT Ĺìz:zþÅc ŒìÌž4’§¨XΞHBºê’¶C]Òv¨KÚÖ¤¼lÀºRQ|ªß¶KÞK߸+ÖŒ JšO†[_¾Ì9HÚ¨xàé ßÒ.o7 µ¦­F.üPIÚ §K-%Á'”„µ°Gu1Wøž™[¯Ås|BrZºøxuñõBÇ×Ã=êc3‘à#ØÏ/®o¼Þ¾VõUï!kDR›õþ¼øãâƒþ‡—Â{X&Špúžª+ñri°±¨Ã²çhN£E%0ý5\þí•°Åt%0×K_úŒ4 ãÿ×vÝÕvbäcçö¦ÛYLñYLŸD—ø,Fœø)šö몛ðÚNs[‹âŸjŠùc<Ç83Çt¾sT¨[Ÿ›4kAõÿ)1$9Ô)ÌC2ûÉ´¨û´Ô< endstream endobj 98 0 obj << /Type /Page /Contents 99 0 R /Resources 97 0 R /MediaBox [0 0 612 792] /Parent 101 0 R /Annots [ 96 0 R ] >> endobj 96 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[0 1 0] /Rect [321.367 515.115 328.341 523.528] /A << /S /GoTo /D (cite.bernstein) >> >> endobj 100 0 obj << /D [98 0 R /XYZ 107 736.262 null] >> endobj 22 0 obj << /D [98 0 R /XYZ 108 575.569 null] >> endobj 97 0 obj << /Font << /F37 64 0 R /F35 44 0 R /F8 47 0 R /F36 46 0 R /F14 69 0 R /F11 70 0 R /F13 95 0 R /F7 71 0 R >> /ProcSet [ /PDF /Text ] >> endobj 105 0 obj << /Length 2500 /Filter /FlateDecode >> stream xÚíÉrã6öî¯`r’ªCÀÃÚLM¥*}È-WåÐéJi,v¬‰–nI®nÿ}’&)p‘HÓšLN„)ðmx;ÿp{óí[P‘%VqÝ~ˆ4-m¤Œ!tt»ŒÞÍ6‹?¶ÉquØÌßßþôí[&Jó³D!„˜3b™ñüF)õsM4ÑÂDÔOÉ~g¬4Akx>áõ)N´Òùï\RÊ@¸&J‹|Öwó˜k3ûâ'êH«Á¤„+ÂYD1•tsð»Xj¬ÇN‰PD@R„?ç¢àÜ^£…!G¢ %@„$ÊŠ."ø5a"ĘD@b":%!¯a9Ô5¡þà„Š'_P¡À “€˜&[Œ¹¡Ù< Bæe!£Å%k.Jè¨4çÍŸ’Zu'uªšÔÁåI]n²Ð'Ï€¤.— ”åÂriÊ3EY0-y&?K&0'Ð̉icd܆ÑVX‚ԱĪ­”P£•²5?Ÿ•ÐËÉ­˜ñIe@ò9—ØLºÄâ9—ØL¾Äb436#0Þ¬ú}—¸1kÜ´R~éb0–ppRðr©KpNíWŽžaÎýÚgD´³Š±ÊáyŸtdÀªèÑ!š¶¶ƒ¼¾¶í*Eº¬rp55Ø/ˆ)ªôKåT”lzŠ2ðjê¡¥ídú4¨{4XçØ5¯f®¢§Ø)Ë {S13šPLSNrÚդꜘªIõ²Ö.^ÜÚ_žþâñ‹?{?òoâÍŠ¦gsk hƒEhÞæ¼½Oæ1XŠÔ0±N²ö¨.Wš¨§Š$ù²Ø|\'‡ß?¬“»?Éýú”F ¦nE¡z·Ûι™«íÁc;ì6)^6[m“O‹õê¸J²ß>ìw?:æĽuÈ°Ž4³äÎAúÓ¿þ¸ßÍc©fÿMîŽþÍ;xO<·L(ÂÒF-#VÊ2·HÑq°Ùb;g³e€k¬ç&­tÛ$Y"y’ËÙ×!|ý& p9ŒìôÈçÕzíx³õn±t#…®þ]&ÿt¼Ø.ý`ÿ°õó¼¼Ü«dqxôïVHz.¼9׳G?ᘎ2QÓf·s³]+) ¡\Iiö78¶röà_âïù>;I9zÂ"*ÉÖAúÝQ碉S»H”&Ö!©Ôˆ7§RHê9vƒÍnŸøÑr…²Qwë£û›$ m‘Räò1SLQ\€B{S7Érõ°i£ÒpŒ…öîö!Àn”áÞ/öËNÞÅï¾&·€59TEé üꄲØoWÛ?^#¯BÌ<Ý^S¸¡Àuýô°Úgz½øO*ŠÝÃÑÿ Ô?7«­S‘üîÿÆQÛ˯@:ãí$ ³wûÉsº¢ÿâç…ì¡ÔlÞÑ£Z¯Çdé§9^4.+Úézç>ÿì…¦ŠŒe'­táLYC+ƒq´~¶^Æk÷Pþ¡óÇÿ2€ŒkbB5ºi©ùSQÇ #ÆìûP·†ù”©O¼ã!z‘*¼+M¦;SAÎN›’¥9¯.ì­B¨Auº‹ÑÓe{1¢©±{ÆÏ"Á`£}LêŒ&~(Q7¯–I¯FQO>šáÉ~,5µwåEþb äôâ"ËšÀ†Å¤ü?´,{RËš`¥ø@ ¼rËš.^MdÃêò‘°–cÄ2éã^ų(7‹lûÌÂ4ª9^ùÀG?z5i’<^7\—T¯ÝãÀíêÅä@Jùtw‰"5(ïr¾èrð2ÖPÑÊ,V¶†ìÅ¿OAIbž:19I7?ÞÞ|ºqMP1¬¨QLGà®lqˆî67ïÞÓh‰?þQÖDŸÓ©w׉R·?²Ž~¹ùùæwë«vi*ƒ¥~X嚌¡½l,»‘ƒ.­À…RÒIŽÛ–¦‰EÚbÈEÖv\®î3x´ŒRÁ•Oî 6’3Íc%,¢í‹±º#¢GýÚ#œpšV̇6Eש3mŠ„z5=ªôà5'LHDlˆÒÐœ}™ô® B¦Eס Â û»ãb›+#µ0Š¡Q(&‹Pß…¡™s§@”p«zïF ðÏ_—¾d«.œ‘U• ßyâºe€(.jNª¢Í$ô4[½„€Ó|çôdFtœJ±fu.@¡D¸1=÷{/-~N›‡í­]õ7híž³$TGŽy¾'ðU0i‘™qÉâƒá]2„f0´à“‹3CËcÈ+H©z†–¢¿ûx*0AŒ‘ÏZƒ«ã˜Zü3,:! 5fTnj†àé1ÔòÊ(FÖڟEÕm"5èÿKgQ/) ½‡©0*‚¢®Ñp¦¥"Š×¡ <\S¢]­Ë1’æY›ÐLSŸ  fè…;…X»¬?†ŸùçÒìÿÀ¥Ù¾W\YÓ1Ñ…=”/ZÑ ŽC1Wt°ú9Ñt"ï7ôg!e­Ðñ%àªNµu,)zçŠ\¸èb[ =[’Šà%=WIQ½¤‡®-mÝn†Ù¼d¦jãÿTg›@]%ldžm¥—–Z1¨¼,«,f#Ì<èJ¯‰d·Ehøª#Ûû”œ ûq]¿,y¢Ëzˆ c2f0êÉjߵɔí%¦ÜO—Êú 8ª]Q,UýhÝÅ È,=–/áçû’zãÉòÒåëXbR @„€Pˆ3m¬}ïÿÕN³ÄiºE}*JC}i¨\÷­„ú?4 .W\š5ž‚Ê¡ú¥ÆÒ/zº2GQ—/È·Í$%X“ÇXÊË<60£µä̆|¥"Öz–7Íþ©’ |×%¡E ©¼8u¾¤ì uÏ`Øq˜·Ò·|è_qÛ$ƒ$í ˆ‰¦ŠÇÃìYËÖzJôÜïíÕ%€¶ý^Ñs¿·Or2LªuûRô¾2j†MÚ´£ÌÁ õȦåF½~ÁJÁxZÚ~ §?W|hð¼AÐn“J²nÇ2Þ-a`²MÀæ¢ÞK 8¨ÈgÝ‘r…cúŸÔ¬åm9Ò¹ùûc¨kx¢ M¥¸è™ÞèÑ(³n€ï® ×4%7ã6þ ¹· endstream endobj 104 0 obj << /Type /Page /Contents 105 0 R /Resources 103 0 R /MediaBox [0 0 612 792] /Parent 101 0 R /Annots [ 102 0 R ] >> endobj 102 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[0 1 0] /Rect [492.488 549.219 499.461 557.632] /A << /S /GoTo /D (cite.flyspeck) >> >> endobj 106 0 obj << /D [104 0 R /XYZ 107 736.262 null] >> endobj 103 0 obj << /Font << /F36 46 0 R /F14 69 0 R /F8 47 0 R /F11 70 0 R /F7 71 0 R /F37 64 0 R /F10 72 0 R /F1 107 0 R >> /ProcSet [ /PDF /Text ] >> endobj 110 0 obj << /Length 1249 /Filter /FlateDecode >> stream xÚ­VYsÛ6~ׯàL_À™ ÁâÆäÉG:LÚX½&ÉEѧ:’²ëþúîÐeÓn2Í‹D`ñíý-p:½¸P&Í•¶2›\g |f½çZ¹l2ËÞ3—¤a“VΰwU»YtmþqòúÅ…ÏVZ‹l,-÷BFôd^·ˆžµUÙÕë-+ñCzÖõ*‰»zYEY‡ÿÀzC¸j’¡þÐõº‰»õªú¼)uWWI4«Ú²©§ùX:VÍâ^¬uó*nÜ4Õm½Þ´q="K][¯x>Öʲ“Å‚‚¢8x0&ÆÑaäÓR³;ò¼j*Z)vƒi‰®-É. (Ivƒ¬qûl½Õæ{üЖInÝ«ÿ‰òf³Z‘/«Oqýëtl"*pQ‚Y«gI×ouÓa*¢àtM€¿‡"Ð\r„+ýSV±".¯W³w×Æ ÅóuÛ½¤r‡”A½-‹å"ŠosJuÓÖ[u}bŠ¤Cq¸zŸbxtX1ëë((šº›/«®.wº\Ò¥˜âåQH6¥W«+‹’ÎÏkJmì]Qšò¬Yõ]¡t_jRÚq|ìעʟ ¸^ܯÖËš’JÊŽš ‘£&£Ï#@oD€å\f‚à=+—£÷E6C!:Ü[¸ë.3L·Âà÷"»ý2:%ú’¤äàLfœÇƒ‰B—[óäÚ}téòsèpý]Œé67–rXLDˆ^„Í^Ö±:ýº[wÛˆÙðëƒ0¢ÅH‡¨·§RëtY$òažN†ÓÜÃ7J†E–Ø”Œ¶¤,ÌûníÝ»&vycSùؘA*8–UÉ€B $6CMÔÌhÀáØ‹ œ F¢à&àž³àÜ­Êâ¦)Ú¶êíÓ{'zž ã’àÒÛ!‹Û8cÅ#8pïL×ä‚Cð馋Y©p:z§³"Q˜é°D™!5ËâÓ Ø.ó±S¨Î=ðÅq!\òð¾LǼ*œÜÁáá—Áï4Hçžn íì5´ÈH‹º¬æ§ëìbqߦ™Ý'í¯/â¸Ô\•icxpêY¯,N>ÐÏ´µ\£SZ!Cü3§)‰4· ù\ÖÿÅeÿµ\Þ­©eä7 Z:lè´ÔÞxg¥6xÐ6¶?µšá[}ׯÆ^hÆ+ÀÚ0íñBïð¯Õ°§Æ;p‚´–à!™ï'öÞÎ:Òrm È@`8DGÊ{{àüʧ©ƒ|´&8­ü£àãöæé{À¼Åi¤pA<4/¹—ú>8q®ÎÏÎÞ¼:‰=€é ï­†€µ”; A‡! “«ŸN^ÿñçx’{ÅNÎ/OÞœÆÇ Ë,qÄÇÇ$e_f8 áàñ“ÑxüÌƇ¶…pH7tN£#FïÇ :ˆ—ã‘;XI”wÁäÃâ&éLó€¡x°’:ðRÊ£J„"‹°7‚D,¥†ê¨xœuÂ!Xô`¨Œ®GKiŸf˜š _ð%ø`Çë Çé³s 0Ë´>¢(Îh.rïH$*ÄJ(8*¸ÌáAtPs0€Ï&œ_éV~WÍ6eÿ¾2øÜZÇÿ"þÝÐcûèIeô~Üæ2àÀ{Ôà1 ‹M!qO¤Ñ¶üô}òº endstream endobj 109 0 obj << /Type /Page /Contents 110 0 R /Resources 108 0 R /MediaBox [0 0 612 792] /Parent 101 0 R >> endobj 111 0 obj << /D [109 0 R /XYZ 107 736.262 null] >> endobj 26 0 obj << /D [109 0 R /XYZ 108 698.4 null] >> endobj 108 0 obj << /Font << /F35 44 0 R /F8 47 0 R /F7 71 0 R /F18 112 0 R /F17 113 0 R >> /ProcSet [ /PDF /Text ] >> endobj 114 0 obj [781.6 590.3 767.4 795.8 795.8 1091 795.8 795.8 649.3 295.1 531.3 295.1 531.3 295.1 295.1 531.3 590.3 472.2 590.3 472.2 324.7 531.3 590.3 295.1 324.7 560.8 295.1 885.4 590.3 531.3 590.3 560.8 414.1 419.1 413.2 590.3 560.8 767.4 560.8 560.8] endobj 115 0 obj [611.1] endobj 116 0 obj [791.7 791.7 583.3 583.3 638.9 638.9 638.9 638.9 805.6 805.6 805.6 805.6 1277.8 1277.8 811.1 811.1 875 875 666.7 666.7 666.7 666.7 666.7 666.7 888.9 888.9 888.9 888.9 888.9 888.9 888.9 666.7 875 875 875 875 611.1 611.1 833.3 1111.1 472.2 555.6 1111.1 1511.1 1111.1 1511.1 1111.1 1511.1 1055.6 944.5 472.2 833.3 833.3 833.3 833.3 833.3 1444.5 1277.8 555.6 1111.1 1111.1 1111.1 1111.1 1111.1 944.5 1277.8 555.6 1000 1444.5 555.6 1000 1444.5 472.2 472.2 527.8 527.8 527.8 527.8 666.7 666.7 1000] endobj 117 0 obj [892.9] endobj 118 0 obj [339.3 892.9 585.3 892.9 585.3 610.1 859.1 863.2 819.4 934.1 838.7 724.5 889.4 935.6 506.3 632 959.9 783.7 1089.4 904.9 868.9 727.3 899.7 860.6 701.5 674.8 778.2 674.6 1074.4 936.9 671.5 778.4 462.3 462.3 462.3 1138.9 1138.9 478.2 619.7 502.4 510.5 594.7 542 557.1 557.3 668.8 404.2 472.7 607.3 361.3 1013.7 706.2 563.9 588.9 523.6 530.4 539.2 431.6 675.4 571.4 826.4 647.8 579.4] endobj 119 0 obj [569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 323.4 323.4 323.4 877 538.7 538.7 877 843.3 798.6 815.5 860.1 767.9 737.1 883.9 843.3 412.7 583.3 874 706.4 1027.8 843.3 877 767.9 877 829.4 631 815.5 843.3 843.3 1150.8 843.3 843.3 692.5 323.4 569.5 323.4 569.5 323.4 323.4 569.5 631 507.9 631 507.9 354.2 569.5 631 323.4 354.2 600.2 323.4 938.5 631 569.5 631 600.2 446.4 452.6 446.4] endobj 120 0 obj [570 517 571.4 437.2 540.3 595.8 625.7 651.4 622.5 466.3 591.4 828.1 517 362.8 654.2 1000 1000 1000 1000 277.8 277.8 500 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 777.8 500 777.8 500 530.9 750 758.5 714.7 827.9 738.2 643.1 786.3 831.3 439.6 554.5 849.3 680.6 970.1 803.5 762.8 642 790.6 759.3 613.2 584.4 682.8 583.3 944.4 828.5 580.6 682.6 388.9 388.9 388.9 1000 1000 416.7 528.6 429.2 432.8 520.5 465.6 489.6 477 576.2 344.5 411.8 520.6 298.4 878 600.2 484.7 503.1 446.4 451.2 468.8 361.1 572.5 484.7 715.9 571.5 490.3] endobj 121 0 obj [777.8 277.8 777.8 500 777.8 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 500 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 1000 777.8 777.8 1000 1000 500 500 1000 1000 1000 777.8 1000 1000 611.1 611.1 1000 1000 1000 777.8 275 1000 666.7 666.7 888.9 888.9 0 0 555.6 555.6 666.7 500 722.2 722.2 777.8 777.8 611.1 798.5 656.8 526.5 771.4 527.8 718.7 594.9 844.5 544.5 677.8 762 689.7 1200.9 820.5 796.1 695.6 816.7 847.5 605.6 544.6 625.8 612.8 987.8 713.3 668.3 724.7 666.7 666.7 666.7 666.7 666.7 611.1 611.1 444.4 444.4 444.4 444.4 500 500 388.9 388.9 277.8 500 500 611.1 500 277.8 833.3] endobj 122 0 obj [743.3 703.9 715.6 755 678.3 652.8 773.6 743.3 385.6 525 768.9 627.2 896.7 743.3 766.7 678.3 766.7 729.4 562.2 715.6 743.3 743.3 998.9 743.3 743.3 613.3 306.7 514.4 306.7 511.1 306.7 306.7 511.1 460 460 511.1 460 306.7 460 511.1 306.7 306.7 460 255.6 817.8 562.2 511.1 511.1 460 421.7 408.9 332.2 536.7 460 664.4 463.9 485.6 408.9] endobj 123 0 obj [525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] endobj 124 0 obj [833.3 777.8 694.4 666.7 750 722.2 777.8 722.2 777.8 722.2 583.3 555.6 555.6 833.3 833.3 277.8 305.6 500 500 500 500 500 750 444.4 500 722.2 777.8 500 902.8 1013.9 777.8 277.8 277.8 500 833.3 500 833.3 777.8 277.8 388.9 388.9 500 777.8 277.8 333.3 277.8 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 277.8 777.8 472.2 472.2 777.8 750 708.3 722.2 763.9 680.6 652.8 784.7 750 361.1 513.9 777.8 625 916.7 750 777.8 680.6 777.8 736.1 555.6 722.2 750 750 1027.8 750 750 611.1 277.8 500 277.8 500 277.8 277.8 500 555.6 444.4 555.6 444.4 305.6 500 555.6 277.8 305.6 527.8 277.8 833.3 555.6 500 555.6 527.8 391.7 394.4 388.9 555.6 527.8 722.2 527.8 527.8 444.4 500 1000 500 500] endobj 125 0 obj [638.9 638.9 958.3 958.3 319.4 351.4 575 575 575 575 575 869.4 511.1 597.2 830.6 894.4 575 1041.7 1169.4 894.4 319.4 350 602.8 958.3 575 958.3 894.4 319.4 447.2 447.2 575 894.4 319.4 383.3 319.4 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 350 894.4 543.1 543.1 894.4 869.4 818.1 830.6 881.9 755.6 723.6 904.2 900 436.1 594.4 901.4 691.7 1091.7 900 863.9 786.1 863.9 862.5 638.9 800 884.7 869.4 1188.9 869.4 869.4 702.8 319.4 602.8 319.4 575 319.4 319.4 559 638.9 511.1 638.9 527.1 351.4 575 638.9 319.4 351.4 606.9 319.4 958.3 638.9 575 638.9 606.9 473.6 453.6 447.2 638.9 606.9 830.6 606.9 606.9 511.1] endobj 126 0 obj [625 625 937.5 937.5 312.5 343.7 562.5 562.5 562.5 562.5 562.5 849.5 500 574.1 812.5 875 562.5 1018.5 1143.5 875 312.5 342.6 581 937.5 562.5 937.5 875 312.5 437.5 437.5 562.5 875 312.5 375 312.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 312.5 312.5 342.6 875 531.2 531.2 875 849.5 799.8 812.5 862.3 738.4 707.2 884.3 879.6 419 581 880.8 675.9 1067.1 879.6 844.9 768.5 844.9 839.1 625 782.4 864.6 849.5 1162 849.5 849.5 687.5 312.5 581 312.5 562.5 312.5 312.5 546.9 625 500 625 513.3 343.7 562.5 625 312.5 343.7 593.7 312.5 937.5 625 562.5 625 593.7 459.5 443.8 437.5 625 593.7 812.5 593.7] endobj 127 0 obj [272 326.4 272 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 272 272 272 761.6 462.4 462.4 761.6 734 693.4 707.2 747.8 666.2 639 768.3 734 353.2 503 761.2 611.8 897.2 734 761.6 666.2 761.6 720.6 544 707.2 734 734 1006 734 734 598.4 272 489.6 272 489.6 272 272 489.6 544 435.2 544 435.2 299.2 489.6 544 272 299.2 516.8 272 816 544 489.6 544 516.8 380.8 386.2 380.8 544 516.8 707.2 516.8 516.8] endobj 128 0 obj [499.3 499.3 748.9 748.9 249.6 275.8 458.6 458.6 458.6 458.6 458.6 693.3 406.4 458.6 667.6 719.8 458.6 837.2 941.7 719.8 249.6 249.6 458.6 772.1 458.6 772.1 719.8 249.6 354.1 354.1 458.6 719.8 249.6 301.9 249.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 249.6 249.6 249.6 719.8 432.5 432.5 719.8 693.3 654.3 667.6 706.6 628.2 602.1 726.3 693.3 327.6 471.5 719.4 576 850 693.3 719.8 628.2 719.8 680.5 510.9 667.6 693.3 693.3 954.5 693.3 693.3 563.1 249.6 458.6 249.6 458.6 249.6 249.6 458.6 510.9 406.4 510.9 406.4 275.8 458.6 510.9 249.6 275.8 484.7 249.6 772.1 510.9 458.6 510.9 484.7 354.1 359.4 354.1 510.9] endobj 129 0 obj << /Length1 2073 /Length2 16437 /Length3 0 /Length 17682 /Filter /FlateDecode >> stream xÚŒöT¥ Û WS“5yÒζmÛÆ®v¶í&Ûöd“mL®Éæ4aò×}?˜ûyÿ­ï[{­öuœ>N\;2"E:!;#¸­3=#7@DNX“‰ÀÈÈBÏÈÈ GF¦jál úŽLäèdagËý GÐù]& t~7”³³H»X˜XLìÜLÜŒŒfFF®ÿÚ9rD®&9z€´-È ŽLÄÎÞÃÑÂÌÜù=Ï”ÆT&..Ú¿ÝB6 G c -@èl²yÏh ´¨Ø[€œ=þ'%¯¹³³=7ƒ››=ÐƉÞÎÑŒŸŠàfálP9]A&€¿(ä6 S£‡#¨š[8ýK¡bgêìtÞÖÆ [§w[#à=;@EJ `²ý—±ì¿ hÿn€‰žé¿áþíýW Û¿ÆÆv6ö@[ [3€©…5  .KïìîL Úšüe´v²{÷º-¬Fï—ˆ )€ï ÿÍÏÉØÑÂÞÙ‰ÞÉÂú/Ž …yo³˜­‰ˆ ÈÖÙ î¯úD-AÆï}÷`ø÷p­líÜl½þƒL-lMLÿ¢aâbÏ fkáà’ý·Í»îÌ ä `cddä`ç€ wcs†¿¨z؃þV2ý%~çàãeog0}§ò±0½Áy9]AgG×?ÿ‹à˜˜&ÆÎ#™…-ÜŸèïbé¿ðûü-Ü:ŒïëÇ`üëóß'½÷ 3±³µöøcþ÷ˆDÕÔ´eÔiþMù¿Jaa;w€;€Ž™ÀÄÄÎ àxðùß8ÿíÀØÿ-UZü»ºD”²5µpý‹Ä{÷þCÄõß›Aùﳡüoy»÷}(ÿ¬¿.#£ñû¦ÿÏGð·Ëÿ¿Ýÿ+ÊÿëúÿߊÄ]¬­ÿÖSþËàÿG´±°öø·Åû>»8¿ß†œÝû…Øþ_S пZØÎÚäÿꤜï"dkfýß6Z8‰[¸ƒL-œÍÿµDÿ™Â{pk [¢“Å_/#ãÿѽߜ±ÕûKÅé}V«@ï'õ¿)ÅlíLþº=æ÷¹pï£Gl/¦÷#5¹ÿ½Ûz[;çwÀ;9€©#Ü_eg0ý%úâ0ˆýq0Äÿ &ƒÄÄ`úƒÞýþ‹8ß-•þ fƒòôî§ò±Tÿ vƒú€øqŒþ ÷|ÆÿEõÁäð=?è¿ð½- ÿÙƒ÷’LÿÀ¿Å{–¿ ëŸL ¬ÿèÿ2·sqüG¸w³ÀwRæÿ€ï¶ø|§eõøÎËúð˜Íø~Ý ¶2¿»Ú¾oÅ?ôïLíþ YßíþGý^ªý?à{aÿ(›é½0§?ÁÿB WÐ?Ò½›;½¿›þ8¼wòOßo™ÁÙÜôN¿Wëìf÷‡÷‚]þß¹ºþ¾—ëö)¼{ÿ#ó{힨½»z‚ÿûÀØÅÑñýÇáïWÔûuüÿýK¹ƒŒáVíŒy‚-ëƒ;× áºÑíOñÍ“ík¤QÑy­8~syD‚N¦ªÉ Üt¼JíCYߣ¼\%|ñ:mk„mOTêxò~6ˆWžÝï€[žÁš.:jćţS<ð~qðV°úÐÞ-M–çà‰¤X€öÛm@½a°|mâËâ¾ÒA » üsù]´Z”n@Éw²|£ìlâÎtø0ÔŸ®Ü‘¿ßÞÍÊ~#”Ž§ó9‹f)öÒÞbŽyXðܨTevêÁ!ÅÑÆÆÿpûib–ÜKø(EkÉ«ôkÔ&ßRGxìÈjð@‚Œ:±¯"¶cp_¦¿l7iO®›q¦£µºñ´<€œ‚°Æ+„¬TÂ4±šd´Ô ÏÂïá…_%AÜ„æ[/AÏÙ…Z7µwB,67Sôá” ÁÚNW¶/ûóÃG† ଄,T²)Ø’Uy̹I•|1åQ§èÆ"/Á·|ú¯÷t–,C½¿:Ûèþà€wçÄRœz2RlZ!^ ‚5‘Š£†¥Xvè ºÒ÷:»·Á`”Á^&X‰õjYÔ|õ1 ¥§IÃ6 ߊÄ%Cû}å#,“ÙÅlE´´­‘"ö@× ÅEXmöþMÞ™ÖkÅd‘ÝÙ·r††Žæ^ujÔæÒ'€ûõËl]€6ýR½Í)Û³'ùy_ÈѯQ‚`¡`ˆ×غlèrº™ÀSED²ÅäClt);dvÊ„ó`¡.ĺތfÞˆµÙ÷c߬ô´¨!Wn¡8).Ûù7·8$só: Áb ;ý(š©PáÚwšçbr%Fk Š >hûfŠ¦ÂEªÑC"ŠEŠtl³äBù,šƒlSJvÄÐâ+‰DžuÜ'&Ý«mûDHšHT-ÚéQn,~k,1ü´Ø§1\ÍÉ@YyÁ}ó96ã™êŽ¯G®L,úÅ¿(Yã_Ù{úôpY¶fcË5Á”þHz¿Ÿ÷„Q¦ƒ’^y>ˆØpèlÉÃ2(·á±ãù5ø€v[@ûªEðàQ]QØ‚ÿ×ÞÌiñåÙšk˜ºø‚®¹U]Zs5ÔJ'$áGˆtÈËKêÝCøáòRŸ•\K¸X!<;ÞÂY—îm¶œTø¢Ù'›FzÃ+9Ðo¼—“j”fû·Ë?(‹ ˜S#Û^Š°×ìcXs ßÜ•-?W€'ØQkþé(Û°FGX<´ë­,Ùw5¼¬Î#´Fa'5i-¡­û6‹ å¶ï—:i—NNoÔKHš©ëkdt}ŽÒG˶_ Á ñÍ:B ÍR7í~¬#‘á«}Fïé4/.ëX§üž `¾=j[Êmè® *(¡l7n¥SÀÖ™ K˜2ЈÑpç aài‹Fh">PÆ«²Ùè«Îͤª¾+CÏ‹ÑuÑ`BèŸM°K*žAóØ] _¡žˆ¸Òí\5 8Žš–°ˆ98¬$ßp²ê/ÎŽí wÏŠæ6㟹8v‹Z{f¼ªFK2?Uh5Ò9®Z¯ÄR_v8€fbçìá­´/Gä;#@ÊŠ€›ÍÁqÛIÆ=ʶ8Ä~Nv<´dÓàúP.¯¬Þ |XÅÂغŽ³­';Ûž®EÓJvq^ôK!Xƒ ÃbjÜåu ÖpÖåÉ*ý ¥÷\XEP‹kŠ=êæáá-‰žïuòEÍ“׺{ø*÷* ¬ËõÂim©my Ù`¶sàij_|*r 5Â5A)tÔ9÷õ3DÂcu6;YŽ±ÿ’¢aߦ8øÔˆq…(Ä ˆ¹ðøP àŠ SÆõ4(pÐ'ï‚è¤oAŒ}|âÑèG›Ôä +rUœà»£<”`ØI‹ûbID³2R)c¨Ä†ž5&Tn9þ,ö姑*Õr rqô—þ&·ã ק†moR,zÖ“DjÁy'58‹ßaÓö`Fƒ;ºŽ°Ñ\HBý[Ú¼®4åckdEö:’§hJñ×8!bÑSð<"éÝEæV†rÉ»ÕJ“}Vt¥ö?‡9f=ŽaI›á"d÷ls¬‰ `.$@Sf^Fí¥O9Ãg‹ÖTF0dX{üVêÍeX͹…¹3°*þI”\6pÂÛ`á•~´2/Áx²¥²ŸÊáF6aÅóaWAXØðÂÙªÈV¬o¹É_7LRqh’X<ýä\¥6Ô{ÝcúÒÅw_ ռªەUz¾(ãø“ŒFûT6çÏÒ$¿>´ð'Ô­gýåxºsùJŸ4|ø…Dú_ñÀ¢¹`\>p· ¼ŠÏ¾YÚX+M—ò(“üî¥RYΈ|’ŽU‘¦R5iÖ¥»ÛÚ÷‘~º1 IcÎIŠN4ZÒ(ÿÆêE381z“Ÿvi"2±˜ÏswJ 1ÐU[è_44¨M"Ô˜€_Öp9‡rkãG†èV–-‡ |õ—Y$õ^Õ¨Jœ¿aP”oø¨?“ÌBÍ(s»p<ð²>ÔBå3ÿ¡ZúXÎŒxŽ”í‘ó§A—Y…ˆ³H­Lv.òBŽÌTÇÔ4UÞArë„G¤u&ð>»öŠ”¶, )BMãlÅûeßð&@á1 ð:pO¿xõc”>‰Ê_áë*0DÔ·óx‰ÖÏ«˜#çBÛL ¿…9® +èæåuÛ)å³Hšú°öj)X©ègu‡éÇZ(þzöÅɇZó¥Yæ«eIú/c{=?ßtNÞÁݸÞ4–æB˶}æìÐ@²dp.ù©+ROß8ý¾Þ~Ù~Yù]®{ðÓ†^œ/g0`àÕÇiBµg*QzÉE°E®ÎìSVå;æò˘YͶ¶ D7deO\í *‡í-/À#ÚÒ- ‹ù®ÊÙfæ¡"ƪèØ`‚ûG*N˜ù³˜D²ÅÔ¾ý8%=Þïv¦3‘¾‹¦™|YßZÐ¥**E‰´×ºdDqGçŒ{ïO(÷y 4±‡ã°é³g$ÛY$1ÆÁBʤcoû>(rüNH&'ˆU¦i5VÛ®ÀWUݧ̡"l~“Ñ7Y#kì!¾~U‰¤—,Ï%÷æpu[xÁYÎ|Ì!ÝRŸ•ÏïZ~µ¶™cw`Ö•úâ·•Õ¾6Ù}VD&d¡€Ëƒ—ç8’æh „ü¾ÍÄQ¶¿(ÓèI-ƃ½ù06‰jhGæD€6ª,@N†‰åÑ‹V®©‘*§¾Rë#R6ù@89žmÖ}TfJN;¢»¼xùk‹W—aàÌ­Q³£J€=Ánú¢[Âàõ‡Þó¢ÍU"þ]]Ç™¼5åüJvÊ¥òÓwÑ…Î=ºPðû=Å_¦Tg®Ï¬Ó½bÒê~S:\Ý6Å<agŽqHŽDÑ ³É3žFwý¹‹ uù ´‰ôãÊxK¯'$™ s ç¡“–ÆF‡Û…Õ%(ý¶,ö°tö¤J4„x[v3ùjÙïjÐŽÍÀP£HUÇ$ÊN?å0Ê;ɲݮ€MÇËþr‰ ‹g_43p}„€“=°+«i*ð•¢j”!bÑü9åöí<˜¬Òýþ'¯ûÞ4ç)P=îñ.L‰P®PZ/‹ò(š÷FýÌþ¦Î MŸS†)íɃڌ!ér t•£òD€Àk®c9’d<ð¢á*S ‹3²V宩9D!e Ós·Žº° _*m¼Ã=J£BÐÔñ‘zd,Ù„$>qÒ#O­YÛÑ˲úuÞ§Ò({éqöÃàÕò÷xšòR3ïå.àz¢mÆ‘¡¥¢+Ó ºwÝ÷‡L!-F\Ÿ:›Š$"‰L.2–9ÂR%öÁñ BÔ5o¦I! dýæÎÐ Å1 § ‡‡’Ê©ËêeÒ´¦çkŽÍñ ‹ûÒM¸… Qt•“KäL‚Idà Ÿ#¶H¦À/ëΠä u? 56i丆Ù#«õSÆÓÙßð*íæ*2m{ÑT­PþþKåŸÃ“›¬[¶®pk_½ÀO¹¥¼ É*ö¯ ßêÁ Ò⫵~˜•|àç*»Ÿ™ ¬;Nšq.a¸mÙ"®ò ·%Ž…e`3Ìbú å㾜¤B²‚Õs¢P ĪOƒõ|Ú(MSVi›–›ä>µb-ü…¾®“â³ÂÛ²v2ÖÄ{’ PQÓ‡˜ŠŒµ³¿Ai|3%fŠ„-8øiä€~®‡w×¥±H­®K W强H«refc ×”ÇQ}B'1¦¹ðÛ³áˆFÂ;&ßÔ ÁQOL"~mè°–cWb» ×$g[ø– ãJY+ZÏÐx³*kTêw¹d²s¹¢\ų&‘) ”îWWEÞ~õÐ?Z«zk1+´ñÝÊ0¬×fŽ:Úž óŽ„šñÚ’6NURþ]„à`kBùy-Ë#ýºåÎNtÒPµ\Z$rý—d¨§2pýfx_ñ¹þ¥p) eé$|Ì}(KD°ã5*QÎ~ŠW'6šqZ ô4Ì¡­zrKR¦¬S`õÛlpº$ú #h+ ÒM\_g´xUÛµ¹2K½ûì‡ózæx¶òÓ»š›»EJ>NX¡WÍit]Òè (Q#*‰TsNÊNÊê,ÛÙ„R#mÞ×)u!/…-²˜åФ—IG¥ªBà÷Ið€³N†á È±1M„'o´cÜ.ã9°x )CÝwÁ¯G´éÝÉOûƒç¦C2ñ„…ŸÎ0.|´)ó¿cá*¢±ô€ó›†ïÁ–ßظ=y|X®¬ßêÖKô‘e„q°Û–^:¤ß¬\ná°îm¨‹ ”É>¹O29”UâPê2íjïuiÓϯÃIÜoìàœ€>gG5º47s#"³lÙ§SöÃÏg‹ùýjèËùÔûùî»~Ó¹ Kq†-Ž ºÆvÓá*Ü$¢÷|‚2wBû̹ŸZ¾îå#T!™ÉâKÚ(¬¤U”ç!qÁ(Æåu}†n}"´ëNž…K] žQ@·X’*àÌQVS)õÀd>Ù¥±&JL$«¾ùqi0›I¾ªÉë0Oèûòâ<ª(Üx™Þ7l¸ÀQ|^K]Î2»©>âöa uÓ@–#˜Ú§øYóR;¡L I7âœwdu™~^ 6v@RðÁ]ñíoþ¤GÓ”Q4ç¤u5%®ÆNÏ}åHC ì±I:€ÄTÝ爊Fóå¥P™XãÎW*(bXßÌR³UfSóÉSË·f.'–…¯ˆ4wµÑû4~OȤÕT·j€ýœ<û9ùº€é²Ìå #º§Œý êC kROzÚV_¨Ó,˜£«+vÿFµ§åÇn¡C”$’@µdj£,ÿ£eúq|túðU2ÇÆAQSlA¦Ò—[ƒ9«ùOJÄžÚµ}—9pìP›Ûü-»5.‘Ž4ÖÅ ñСCüS¯¶0Î ã)côæ«íõ€u dX‘¸èAÀU ÝHThŠN&÷hmyŒœ äpž¡ÔﶥDBºq¹ø/×/Ì=Ž )²kåÃÔé¿”–I˜OüCç#> =ó˜Kçz”ùˆåÓÝÊùñµó EsIƒ]95W§&·°íNôȼñ™W5Ðé76òÎlä>  K~×wÎðÎÙhÏ3…­a~S÷%‰E|‹j^¢*œef¿ã~’€•P®œÈÕ¥~é*ƉN6Pi 9./Ýãlo•Né[éTmAZnÊì†Eð0ÐÛËÒq‹¸Îz .ŽûÒ†‹"â}ñ”F§r­ÎÐ?ÉÁ‹ádÇ1å–†ð²§Y\úSÑ›zä·‡ÄÑœû^¸ü&ÉÏ^Ó©?Nñ$Úŧ“ú‘~w,ܹÏS… B=w§3§º£PÎQUŸ­Hݧ.…–¼z4gë, !ÅÇúP;ð¬Ç–: #„¸8D9xC)bçƒß fù4uƒfAnöùèZ»Ñ=VÒÿ©’ Vx¹ÃIŽRcÓÿáOdŠÖ’Ž A YÖHˆñg½{/*QC‰®·#­zõÉÏ0w”¿0¸ô½.ãG=×¾TCgÞVÎÃ})OŒ9˜Y?«é¾ŒÁÁ)Ñ ŠÆ\kÄ3ŸŠö‹¸Ô­OÅIüÞVƒôñŠ$)=°õà˜blµíù×FîY¶$T:ìh¢£ =fQw°þ\¬vñêfŠ%?z ]!çf·™öµQSex#ób@ ømìòâpÐǪ\Ò×YùMƒ´‘DSea}¶¦ù! ª8ÚÇèœr;ýa¡8¿=˜flªƒ5Vr]t‰~¤–ýA+ò¸¿ÀFï+¯· 3]|YNƒ©_u—ÉÜEØˬ€Ìh!TЬ™{gã¾Äùò,&KBbwÓldàr¿ÔÏêN­}ýuc€0aÎ¥a +ø.Ò<©6v­)äv€Ó¦Ø\’AŽÿÙM8z›–(mèrTÀþwÈîÈßòyk8:÷q‘1ðÑi.7s¬Háblóµe[Lý´–ï¿ Z¯FŽJ—!,ø^SV00"¥ÅyÚÑÝRGSNp¾ ¬º’_è#F]]†–Ù­P5@_JPüÐa<`”òªBËÉp> 9hè» 6Ù¾þþ¯î#bEÊ·{ÀzntFüJHýðJõ “ѯ è]ÃÅüŽ?p¸½Ÿ ŸøNçD¢ïå®Od×G!í»ÙÌ8†å|×ÕIYÅ%‹äpºv&† yžž“ׇP€™”£•ÛÊeÌ/®‰Sü2®šž†ÿ´éªÖY¨âçãG®»¬CAl·lÊ•Þ9ž™J¸TÝÛZ9ºnêÎÊÐpÖÌ2!˨»o\¶tÎŽ#®CàLQ%©ÚlùíÐâ a( h×-Ì™€O¼ÁQ f»Naºå ‹ó$Ý’Ý jhlRˆº¾ç§®0Mbû}‘åO¹8Bžr wm€S;«AúPPL!ŠÛ¹V·…ì–GÆœ ¯N4ÞH›«Ê…'î×_£“QŠúÔñ››â'…ö©#§}3»ª|ªÄ‘C­~ÄjPß@ÚQg6¬þøñ°àêð. %CS÷! MoK§ÞÌqí*ãGt5–ˆ@ž²Ÿ¼nõ¦o×:Tý“Ì­èH‹‰û½Ú& 綃07[yË_ö-í+5=Ÿô'ËS¸(SŸ0¢Ñ1•Š|%gÐa±Uú–~¥>ƒãó#„€‡Œ Mx@šaUßµ8ÉwÚêZ8ð*ÛÍ@œà…&U”å4;^õÛÉÿMîIð³_ÍÏa@7TÄ06 #‘¨AŸX²fóÑqïÄœE8׌‘-$´q™Ç€CÞ'_ËÞ¯èκ`3ߦ¯ºWÂÐ ³XвلVBkî SîgV ¤³áÁ³ŽîŠHh¨÷'þØä¿c…åu®ãb]‚%‹aÌõ\’(x©døÓ×ÎÇ/@X´q“sx•mñj—ø# eÜ­6MØò’N\W‰ƒ+ò¼`Sæ{ À/4[ؘɞ٭ÜÒd øû•ˆ„Ô<)Û¯ ’ðˆ²ÊHTª¼‹åæJU+ނܯH³Ì¿{®é„QƒÝÕ(¾iðâ¨?é•P˜ãØ_îvʥ̓òk.)˜‡YÄáŒãqŠΪ±¼PDPÆìS'n3EõB#¨ÑFúUŸ¬¨xí¿°ö(#Ü…pkb½*uHhO,ÚÚÊ$ñصjA‹¾¸bz­2Öº® *8¥Ú.õ.¬ÏísìÅÛ ÷çW;%X!£Wë"—óx±Î€—E¦`¡—ËeHÈš¬ªW×ÁæYdy›>÷seç2Ládžb)&LTb‘*‡ªÁ… Ç»Ø]¨h’&†Gž6Uø}^ü¡ÜíCú­Ü÷ûËšYÉa«…ë©“Éqÿ€¾=?>ÎÆ78Ö4>/«Ün þ¯Ezã‚T÷‹•RÈs/B“3ú3S5ÕŽ•9¡j=†ßå!üÑT÷BOC¾W¯ß&®hIw€:µ”DèÑ9¬_ Ï®æ_HõÏ㽂¬±`,ò;÷o Cðûä}J!Ü¢§WÒòN.ÖëÐå~ðÜå™ÌS8êù°ŒÆ:ùlT ý³H˜?‘ÎÅ;‹8f£©¸ßms£o£È¹ýZDÞR‰1¦º¯è,…’uBr$™zfNo(ø(|âpßþ$v«–KP&h‰Ðâ¯@^ÚúÅó%ÏMcWšèÂáẏÏZlÆM~M 7œyÿâ[ªäôþË’­ Š€YYAé´»² ËÁM¼WU’0¨-Ê*Kè–Ë$pËôÅ ¨ÛuS6~€2Ä–ÒŽ*ÙáØÖNd)Hån¡ËÉø^á§É^pv*êVŸ Y æÒšg¼ccÑ`ë4ꌣî:Å.f1ðã—O,éÝ{ê@ŽÂ"gù°¢#\‚eõ^¼v‰y[Äb"6ùÌL–¾‡† yŸb%oKE\\hË{óòŒãÉÝ_f§mžšW:•Ï–ã À¿¨ÁÀcá,?¥a¶cÚ|L¿ TÉæ^`¾^›Ü'†z8lƘþ¨­;¡NB¬ª&wÁ±ÌõMUO¶÷X÷ƒžxõ.ļG4e~·1U‚ÕiÑšµÖ×ÅáÉy©R†/:ãÁ^&²(»hvñAõu®žWù(|5˜¾ÅŠ«x÷ŒRPŽPæÜü!u”×@$IÐ,N ÌŽçÀÏz ø4f~G»áëGcÖà°o{´Ô4Q®Žà½¨)¢YÀÝoÙ'âyŒ‹Vyy&4¹#Nžr¦žU`3s >¾Üº¾ò± Ì;0t®3CSHfwŽ5Í’© [t5ÞvÐ3»òÖF“õ‹¦Nbá_Ä`†ÀZ0HRIõ+áÃH_K »(šå¢Œøzʼn¥:7GÝ#ïªýHºÉu–~µEIpµÓ¼æçÃXìö ôOñùÑb·—·&3´›†ýÍoø6é«ù­§à_§qLìÖÜ̧ˆæ¯ZÓ ß"I:ë9Ÿ_öƒ(£w•ÆɘÐ8l û(lÎíh ‘<Å3è‡iÇôœ+« R¹3¤‘û9kÒš‹45í;ß\jwÅýD½×X ,#ò†ZÁR‡Ü‰õž††J`‚ dØ=·Eò‚rŠ¶TìKÅë1ųùCÐC¤Êl*x«Ò–å*mq’Ñe„«(@+Ï€±Šôê;LnÂøeΉ‘‰kíÃÕ«!sÂyö,ªßnad@®òœü8uašÎ- d°ë°ð\/á„ú‚tLÐ"iÄ÷^·ü*>~D=™?ÛPq‘¬*:)9"ÂdK|[“Ù |ÇÒm OƒVÝäÞCèU[bÈÒ¿S@ÃC¢+½eAoí6¾9ÙÐÂç›W¶d^ý¹Í¼Î¯@ÇQúòkl‰õþÉ)Íò—.¨^¢oµÌÍŸœG;'³F5o!9•\X…~·‰'× ¬v§$šŸQ°µ¡k‰9ÞC“_÷Ì;ú–Z•qžDÌ~"î uœ² ‹ÅVlÃÏÝýõÖo‹=]&µX”ƒ¹–؇߅í‰}Ãåì‹·d ';}$jùùà{Ÿ? I£KíQjE­LØSÇë'wôL¹0ŽPÞƒbCûæÝ^$•ÈX>Æ•éO˜§s•ìRwcë[æ ÚŸ‘hìv†ô¼íñF˜Ù¹E9ÎJ=RZ£}Ë‹rÁÏ}õ~%ò³ÈVz›µZÛ+0ñát }åBÏÕF6ª;Çàˆ rÌ Ö¤NkÅÀ– ™§mÏb׺‰ööšZ1ÂzU|~‘ìfj\g¦"øìX $4?*gMM"¹ÒÉÎ>úÀv¹Jã¹™à æ3°2ã}S`ÿæ3…È ãÑÆÝ]‹ûFAçvN TQMlZ˜¨¨ÇlÏôe;¢fÁŸ‡ˆF"°xÆÙý*$Ûð( ö'q[QNre‡Ÿ—§OÅ#,µ:¥¬gî]0#¯Ç¸ã.¿f5_ò,[Šxm<ÀýáŽfÍÙå•RlÐôIwùÔ´°ŠÜ†²H1ùð@²Ó¼RhzmðØËsŽz%šºQÎì#máÜõìO_¨Ë)gG¸·¦$q±9ÞÑ”ÁŒæ"µéÕæE©³ÿdºàF§ª—礘»TÍ‘¨Cš¡[Ò§“Å=˜y|ÞAÏc½ËÀSëJÀ±óƒ.äƒÉÍ.žæ ûÆÉêIßRcp»änMC¶÷xí¤Š2­)ú…¼¼nSI§¨RãmÝ%•ÁŶ8U^é‹Y³HLƦ{%^!£¿9žfETi‡q.­ú^iD¾sHê¤2+TŒ9QG’Ÿ#SFÉ †…ŸÅxt¾E³”AÅ¡p©ñ>þüš T­RRiìA9éÏ•ƒ67 27 §IåâoôßÀs=x/Ák½†Ér.°&Ä,KÓErµ^g=kÁ|„µ ~~ öÌU¼Nc‘q9øJ²ßhjßn`8Qäñ€Yiüs‡I ™iT~©òŠŒ¥ÕÐ 'o;"`‰Ôí£p3nõ2S)²¥òe.û ¡éåìWóÄ’” pÏ‹]µ.w}z+†æ-Ô3ÆWLIsBÈ‘š‰BÒ _-—M)D$‹Í‚Ÿ#ŸÊ3#ïàÒðú„ümz=l!0ýÂ1B™Eú‡•XC2-É<¿¦þW cftÄtk*Ì%¸YÑß8P­ì&’¤FÅ›i+ß)r„=)ĥЧ=Ò> Å€cKfŽ¾ ˆñ 5EtïÜÂ(û`nU؃°ƒmý(_Õïî'„9þšžŽ;ú@žÚ+íÌwÀã”Ìn0œ‰Ójq?²ffUÍzSÿtíCÿÆç_[\%橉ÁYéÎ%³ä§î‚5óý ÿ»ÖµÊlìsy=©c;A&¡9÷ü†éiy c÷ ‡wÜR˜*Tf–ÍäظT¤g«§,͘7„#÷2Æ›<µÂ¬P(d¿Âu/?ßiÖúúo˜æÁZŒ.Å’Üv6dK•9¥·œ"œæ–§$ûƒø°oàcöÍ¿k[˜4?:΄“>› nTÁ&:]·MÕìò1e¯6cÉ-×ü5ô¡˜ÑzÆ`ò¾ƒPõv¿>NŽ Ox~À¿Q”nIEö‘¹í™ä†øìµÑ×BO .°©0ò;ªB0Í´…u¾^(þªn–—ÛÆåKøv¶T1jwÁÁ'lw<öÆèå íY¨nQ„Â.{ Ê>ÞÒ9¬Ñ/w:4 ÁTíÉ/ieàE^¼ó¥}ŽZK¯Û#rø›-ê‡ Ö;ô‡³b£ ÷;®v·NŸ-ȤU­lJ5Nuhg‘.¾6o_á®Ð`6W3áýe'Ó8¾(+zp²ÓìÖ÷÷nÊ: ÎY£Î¬“ç¡8ùQ”ñíiÿ®¦ü°Ãn]ìÊWë¢rDÌý·M¨}öGÝLhé@¤(£'Be„³(¢¨án¾'O-)Br`Lê½ÁebÉ%sKÅ2˜ìš;¢°ñU´<@À3/ Ò x„Ìw-Û1¿+ ‹å|Ï)\)ª<ãƒÓ’‘R/8†bŠ›`E¨WnSúL#ªèî=ì:cJF‡Ù$W\ÇB‘HÚGðÅC6øºC/H¤[¾•UR!ª]wëšöÅUsdmê) …YŸE(ˆÒ@iáÀ’ßh…u© 32å6âÛØDÇ߈†¦‰°Â#÷ätÍŸæ#ŽuA²™D×8/>7œ¶Ñ§å%,CiØù­Ÿ·ãüí‹\DJÈð—ß©¦Á>w9 |b‡-û²r'G‰mšß2î8D¾*‰!`ŠÊw¢x=Np~€&ëܥ?úX\´.ÁݤÔ';^km²])ßE0ìe½hð LÎuX{Lé7©ÞïôK^…èVï{p6³4nt©ýâúÖ.k f>åOˆ¬SàöØªÃOÜÏ(Ü`ð0cšNBäæÊ»:51±Ï‘çW™Gÿ!ðBßÕï–Ñ)5“&ó„ŸoÙÉ©æ2B¥h˜~¨¼§sýnxÉÚ\IAäʘù ä“â(ÁŠ l9NeçÝY®N½°·Ïz¨d-X»§»§òàþò Zô+–.»±yãÚvÙPñ>wpGZGsî+gØ’5ùµIw^#dÈò­V³êg7FÉá¸ÿ÷žf†‹¢o ‰±€Õ‚TËø ¿à•¸{a7ì!Õ#xÐh¨òo)©A?Üêè©Mr…èë Íe™ûZ¥i ¤:sð@ÇLÓJnØÄc‘k›sd£ÆN#N°¾øÒ90Cee'^s—'¦nãº9ÑЈ•½Ê·ÛWÏk†ÖO%ø<ä_Â6µô^A¥ì> Þâ3Тå½M/\²¸eYËŒäG?V‚=oÔÊ3Ízµ6·= ˆ„I)Å3t×±’Y^úX–‰áYvÍ:“MËJªH1åzƲÌÖŒKͶ\í_ ˆ×V‚ ƒµ`"UæÙLrª ?zU‰íÞf`=k|/•EëŠuêc\³¸2À÷¦ÙréSfÒD°™°l²ÂÝó~aå`•OÞgµ–aŸÐim:Çëˆt¦ÕtŽÂó‡ÝŽómX>µQÝðZ¹g¹¯*ATÈ ô\Ò"&Üå7·mKøJ„Vñ˜Ó’B†ïu/§Å­¥eâ©Êüf>ç(p›Y‹¢{§Èü(k”(•»ÆTkËEéƶ~uC‰fõZý®“Gå‘W®4{F?ŒuNÅàNÄCð#þ…/`k¥s#_ÎŽ£*°Ò?skO7 -§€)á…°èöc2mOÑd‡ƒyQ“ ¯—–³³æk–œ÷mMˆ~_ K1ò%ÄJü¹¯aØ1SEcãN¦‚|:’ºÏÃx0\ÑÁ̯ÐêÆž¢µÄq|íc¥t¥$½¾™Ï[M@JÁ—ĽPÈ1ݦֶ|s<Òt Ñ!Yu9¢½ˆÒROô¥´Î6 G‚/ãÐñM~óø^Dzˆh9ôMØŒä8a–gêAªôx=ä¿J¾åüzì€l*]]ÐÓìÊ@ßÜ#n|Iy%¬‡âT¼}öUœÿ^Áºûpæ¥éÁ-9‚c‘~c üZ¯­¬U óÝ´ˆÚéêgÖQs¯¨Ëö'jšß”´Rñ›érúC2ËâΪ» ;—Ö‘Äp–7Vüy(3d*tP>Š)7>(cI[³AlHv5 ;3_òñ}þ›ø¹Ä$Rðüô¹eÑ‚”v*£×Úõ5ÂD¿‰pEÍ!?·$yVL)év˜7 CLm›Ú{¸ é:„3ò&ZôÄw)NËÑÒ)‘ëÊ<Ú>NŽ$>`jÈJù̉vm%¶.8õ‹ ’–IiÃ#1ºò›–ç{(ÁÔçüXr¥êÛˆ8,ê`°vql íV,#|su3‡Õ?W•bÊNËhÿ¾gŸj–VÓnÑN 5uß“g3`\š4T •³«×µ<ê<­›XlKÿiK%.‘£ØÚš±eKIfª®CxÏÂ6B–u¯vl~6H9™½a-H‚5^u£Ò áÄ#[=ª;f0¸cÝ6¢ µçê|¹Í­u·4Z“©‹•öxmÆŠ®ñMwËý«‹Ø”¢œ¡ÌuÖHéfËGœ ybS›zÕ.Á‚”¯ÚGìv¾³ñ ¬–PÙÛ1åîf<䥛í?òpUÈØq™‚£™ÌN;BKÎq`³D´‡n[ó‰ùìSw´LãBC—è^§ý±eîT×ÿuØB ¢ã´â2ÇšZÅÕ¥`îG`̳òÈ ü³z%žÔK;§”)ÐòÐ?^ âwÑŠÃù÷£Ÿô–¨õdìÀ“e,qì71(+Ê@(ü4êòm¹íð:›ºîá&2[(bŠ®ñt¡´A‡ c0ëL90ž»­nDk=éázêÛ²¥Y2ncã0g…‚£†¯ã2®ð‘iBôF†ñ‰%ãlsUk˪ØÙCß!T±Õj¯ƒvwq¸ýWY4íÌ_ ¥$ƒî°¿øæ»=ÎSF»c…ž?©”§•Y<­KŸ`"3^}ÔŽ«®¬´Z»)‹¢ ¨*ÇÜ­ðùÒž‰Ly À ?œ,<ˆßxMßNJ­7è½:ø¹ˆÙèJ`Ó¸0­i“8b¾°EoMN¡±Ä÷; Y†³å{á®sÞQºJãw-U‚£oÃJmýdQTŒ7t»U™[KÍFj ³<UgsL?õ{;9ìVZû±š-ÏS£JaÀzZß|@Ž’#Ïh ­ËÌÉÚVXã§$·=[ÓS¦‡°[&U…,`˘F«;/éUeûâÆlË]Q$ìÉÛ¶dÌ~¨íµ7œ«P* Çõš—‘:ª³=+t•‰ –ÄXW¨¬á)ïòGrxCpÿ^ª÷䎾ԺDíÈÔëo¦à²º/®L¬ËÖ(†mþW6V—Wc”…*]Ñ9ßœ¶~·×BÄ øÑ´N¸§rù\òÐËïÃÎ4x !Z×lçæݳ/íd˜h”…7 ¿œë,°Û<ðÉÜë{(ZåÂ\GZ-*¨•‹DônZü«£³Ÿôux`ÃùæéjÕ·¥ØSÅ邤ØÜf=&g’}+ûüynù¿PÂDu‚܇¯¦mo?yÙ?f,È0™Ì,N˨5‹®Tâ~ã‰0‡-üªÿ²ØSDÆnLOÂ@P$2‰¨²7$ûN¾{÷¹|õÓ¾¨)Ç<fñ×åàoYª"`M%8øplS2šmu­¦¡ÕžWS×g½L”hÍiDw,ñŸƒ_– ¹öžcú‰…Â-ß–9:%L_oÓ±'Çë#Ò“}úð’Ãøkxb—ôº¡ïŸ:™Pú}YÜbˆÁê!qè¿ž‘ ZÎ%\Sõ&¶Î>5Å®\ΨM”Õê˜Ò>ÌX€)ÀD5Ú{“Ëd€…¾ViˆÅ–nΤ:_[»‘ñάaCÁí÷y có’ˆSðþT)¡vøm.㬺x霼]’SÕUDÄTƒ†æX@Ï( %ŒÃê"äM}îB"ؽpе@0‹ÊÕ¼%ÔeUÌÙpëC(ëR ¦…5ñ ki$¡5ÜûËñ®>µ:ÿ„ì’TŒðŽÍ6„ ã›$ÏäºÆ]…b±–H>õR°³µæÂÆ Z£Ú¡G»~söžv˜2“ÂäƒYAˆ˜{R^ýv²âgc2ÎJ0uíûÖª•¡@šà Œ$«ÙÓ(Œ®R¬2”OgüMþ¹Œ=á×¹æõ쳄1àîè‹ùíg„ñQwÌà m`:ö/yœY´ØõQ³Evæ¡d·/øöÚ:do¨²Ø»-Ôˆ<ƒJú†‹e)ò¾àþƒ٦IìDÚsTC’üng_mç^P둾–ªÅ´^ú‹”$š¡ƒ}à²é*8ˬ:†n“˜m®ïº ¾'Õ°ª°½ýÖ’nÓ°ü*mÅ.ÐérJ¿è.rž‘·¡ Œôœ‹¥yš¢|Ñzp…£¨¼ˆ9”ï0au|ݸ)4€¼B§¼*gvV 0‘ m!º7™Ži¥ú6ýö*+ÝšvÒ5ÖÁ7z‡ `‡ê§h­ |ãgO~Á ÏiÚˆ(j¿ŒÐ¢¶—9 ÖªG˱ȳ“Í,ÅÏss‹õE<[®²xèI'«f*sÃóϼ!0å}¯ŠÎTÓØCcâ)¦eÝêvr‡.Ÿˆ.\Ì6ÂŽÈžºTÙ™À,µ2òs{Á¯—Û×ÙÁŠ˜xP6&Òõâ¿ñg…ÞÝù¿®J¿œ.ù²”ÿ`¨'Àÿy¹Íâz!xË| £Tðøôvbš¢"üØÁÊû#2«ËÝÇõ£Á)QkJÕEg š‰þÎsPT$†¦¸ôSô>õ‹n»W~VâŽ)lhMŒ!¹%‡ôPã¬;¥b…÷qþHƒIXr¹A‘//¢ú7Æ+mU1¾' iy?䆟vŒ›õú&p(ìÌ´|ÄåƒÊÇ}6£¥ÂÚÑäCá>c‘=Ý=7Ã4–F%󕸸zÉÆ1]NKcãâ|lźPÓ­›Y˜%K* æ9ž²¥yñª•Ø¯ ½î]Ï×›ÕÀvaüÌ?!T™jqû¹òYkAÑR|ïž3[ DolWr£ÇáÒ=/Ø kËwÖÛµ\ Åéîë‘ÓÔ€§Ë4ü¢]ü˜Ú©.5rÛ ‹ä{A‰>? Ít(ÈȘ–ÏåÈßê*œE¶þ‹=Å‚-cjðƒÆØÅNoýúòÛ{…l{ß GÖÈ2ñµÄ·ØŽ™ý³a° ­5èôi Ç¿|ænõùr,ÖëA"{"ÆÔ~­šïÁ¢Óͪ¡N¼Û¤ à5Z}È*W¹*Ç^yZ1]Î2;٥˟+uÞ6þ3à"uOEús ‡Â…Çæoí0Ä}Ú'H`{#@è0—³'ΩÀn®ˆ‚¢‚õùNßÆ¢mOj—À€ÞaˆJÉáƒÙ ÷kñ(R³YBa‘Ðx5mésl±;UÊË…Ecðá*4#<,œ&M‘‘ÿ!¸+Ø5Ò˜ ?UDN‘q6ÐYUùCbÛý<›|¨&Í®§º?uÑÅÝ× RÏÛépª9Á`uªàlE€ƒ—Á§€à5V~rgï@f.;µ}Â?Y`^*Åóõ¿î˦À—¦M¯ ÄœUž¦¼> endobj 131 0 obj << /Length1 1945 /Length2 12546 /Length3 0 /Length 13736 /Filter /FlateDecode >> stream xÚ¶Pœë- !¸»ÃàîîÁƒ»ë0 0¸»»wÁ%Á]Áƒ;ÁÝ%Xá²åììsÞ«º·¦jæ_Ý«õëþþ¡¡PÕ`7w0Ë8Ø»²p°² $•$t98ìì\¬ììœH44šW[ðäH4Ú`gˆƒ½à¿’Î` ë‹L èúBTr°È»Ù8¸¼‚|‚ììNvvÿœR@wˆ9@‰ ï`vA¢‘tpôr†XZ¹¾ÄùÏ#€ÄààcþÓ nv†€€ö% «Øî%"h ÐpAÀ®^ÿå‚^ØÊÕÕQÍÃÃhçÂêàl)ÊÀ ð€¸ZÔÁ.`gw°9à’Ê@;ðߥ±"Ñ4­ .)4,\=€Î`À‹ÀÛ»¼˜¸Ù›ƒ/ÑrŠG°ý_dÅ¿Ì€¿›à`åøÇÝßÖ8‚Øÿi ìö^{K€Ä P‘QduõteíÍÿ m]^ìî@ˆ-Ðì…ðgê@€Œ¸øRáßõ¹€œ!Ž®.¬.Û?jdûÃÍK›¥íÍ%ììÀö®.Hä'qƒ^úîÅö÷áÚØ;xØûüY@ìÍ-þ(ÃÜÍ‘MËâä–“ú›ó"Bú-³»xØÙÙùx`'ØdÅöGM/GðŸJŽ?Ä/5øù8:8,^ÊûA,À/?H>.@w0ÀÕÙ ìçóoÅ#$€9ä 0[Bì‘~{ƒ-þÂ/çï ñ°¿Œ€ýÏ?OF/fî`oëõ›þç³éê+K««1ý]ò?J O€ €…“‡ÀÁÁ%àãaøý·Ÿ:ðŸêÿ”ª!gÇþÛ£œ½…@à¯"^º÷ŸBÜÿž ú¿×†ðß”^æ  ÿ=þ†ì<ì —/Žÿç%øÓäÿoöÿðòÿÿÍHÆÍÖöO=ý_„ÿh±õú›ñ2Ïn®/»¡äð²!öÿKÕÿµÐ¶æÿ«“s¾lˆ¸½¥í?m„¸È@<ÁæªWÕ_CôŸSxqn ±«:¸@þ¸p,ììÿ£{Ù9ÍË¥âòrVªÀ/+õß!¥íAæì'/èì ôBb0N€ÇË’šƒ=ÿœm«½ƒë‹ à¥8?€…ƒ3Ò'ÊË`ÿCôâ°IþF6é;€Mæ7â°ÉþF\6¹ßèÅNåÄÿÂTû8lê¿Ñ‹ÆoÄ `ÓüxlÚÿ —Ì€¿?€Íì7z‰úýÑE6óÁ—øàÁ—,~Ã?äø²:/Ðý7罃›ó¿ì_ù|ÉËæ_ð%1ÛÁ—Ìì~CŽ—Ììÿ_2sør¿p_^ ÿR¿Ävü|éοòàxÉÃåwž °;ø·wžºËËÍòÛय़®¿Õ/±]­œÁÿ*õ%9W‡¼”æö¯N½èÿr÷_rsv~¹œÿ¼"^¦ó?øÏ7ì !-Í;€„B­?…vÜ׉{°ì~™¡ÙÕÉ``ñYrîtûŸÊPû>xÝùV<惩ñ|³h':Љû#E÷’pÅèÄæ(Á¡IdúöTx ª_y6¶&67索mwGe–Rý>•UÉÛFœ˜ò ðÁ]ÄJºÇD—þ‹WB¸ò}<½Qé>¾9ϼpáš.wl;6EüŠ®d6\4™üm\eW3†á⬑nA[YCMöÏ%[Æ–Ù1bA=’FQÇa¾ÛÔŶdžÁEýÜAIÿúAÛ›‡›ªh¬vóLŽâqA¶ K fœA¤ÎU¿Ø4µ¯Lð\Ú>€®TµXÛùcٚƦ-T>( !òWÐ^NL›{•—¨Óò ©âÇ°pˆ{îwÖlΓsËïCôIU1¸ë,æ™TuM"]ý-/\sÜŽwùÓ*«¸¤Rb%z7ãû}æ8¿,‡¨jY^èBžÉÐé+9‰<á#/ÁHŸ !vܼ]%œ2 ÀTjº× óp`Åëá#ŽY«q÷ËCW…’,YG˜fŒöu_H?±PøÂô½šƒ"¨:¶4YÃþ¡x`ÛŸ*6À“1܈4·ÑrAû ?y?â4ša'P¨XtæGz1j<@£ùÝFAdµy=€ÍÐø›ÔvŸÂÝ…1¼õÕˆçöÙ•Ô²n)Vù†ÝU:¾Š˜ŒûŸý4ù&ø$,'&ÌsY‹¬‰âíRÚpêç¦hš¦´XÑEÉ—«Ð5ƒ sv·ß~µþßKãsu•Pì›ïnÊ@ÖÇ*NBÂU°´—ª@JˆSt€˜Ù`æ ø”•6ýÍåsŽ~ûÆŒúsTrIŸ&jSàè#|%çIbMÐO/)C¥L ·‹j±s9ÎßeKòðD¤Rm/¹ã„éM40àîã)ìh”“4øÛ·fV+é>2óÓñQ¿˜SÿJÿ–Šlìʦƒ´è5ÑÐÝOPŠp]ÅÝ¢¦àð$2¦#Õa.Úî@>ZÖÏv\J%‚„²€Ñߨ&)>›ÅûVÝR9ÂRòv+Ä¢)’«êŽ®{›¡}ÈÓMßù=2Ðà+.*X¨p¢« ÚÚÐ+Ï6h%Ô²4€Ÿ;òÞ]¹¡¨W¶z½Ó´±Åm£ÛøôöteM`*˜%…á¡ûÑí#RŽmƒùÍwãa‹w9HÑ%"ï^SÎ@¶Êý+ÑÏ°½wb:QÊ÷1J¸Œm¨uÊ°ó3E‹k ™Y¶R1ä"¨±Œ¯c&ÀqŠüUÔ-‰#W£ï`ÃNülتµu¶Lgîâãƒc<¥eixsPÙ 2Cç`º8£«€ýÕq2Ç!踅…¦εbCª ÀÐaô¯ŠÉt,0ÄH \ÌŠ˜Õ;.Y¿MhÂ}º¬å‚xûª!cÑWñÓùótù,Ù-¯×Weî»<”T4j¥\ä3FÕˆÛ~ô†øÀ#>uj®u5ç¬Ñ&L¬QvYŸŽ{¼B袑Y¶zwµBM²À¼y-š·Atíp¨¾Lù6g¢m=ÐRÉùU£LkœNþ#}Óy;é`öÔU5ˆCUî[Âæ«m¾Ú,´õ° u^™jÇY»·çpÍGÀ5%&;…æÐÖ/ƒÌ”«l\þEýµB·i|…l|½Õ"£,ûê4Ñ{öi$òM$oì÷ ŸyÅÙû¬zpÔeêò4çQ|è i3.¨×ÃG¿[uÝ=ßÄ+=[÷ì×å¡,ŸÐ$ȼÂ×}^Ž”Ýro†3ÕÜ8”;ªkF¿ØÈ®„z—?úMXïÎÀ~(½©úûàÚ«¸cœ™®Íùþ#êÝT”`„I¬9RdÒK‹5‹Ð‚´øwy£È5XåÁ (ªÄÒ¥7ÔÊí¡ËÂ…OeÏ‘”Öº°íº.0OJÎD‹GÒµ '9sŠ?)(N-˜²) µÄ£'F^¡0‹qaõl{ò¥]òRw?)®£E"·©†°Ÿ‡S‡ÝJðcÌ [Ø’×e»ëW©oUï Ë MÍ6·ç¨oEºÆÅØ>Ý Ä g;`Kha/ñÕ°æó”oH4m«Ë2ëK€”ÚØÛ´¤ž˜–{¥ÇUN6©"iá'ïXúá±µßÞœ×díÈaÚ4ÜßLA›<ö§½¨žÌ³ž_õž‡cиŒ¬ûg€¢îgŒèãΗ‘w¯€œmÅbSØ««>aù»Û²yó¹o> ~)°­ú1àÜã?Xê’m›ÖŽ¶hÿ.ÙQ°Úu\2&-lÚzÇ"vvc$Är}Œ'ë§AMôE¹Ût@Yh²q£;÷ÈÆxªM÷ ‚’9Ê]süÜÀI†ÓšÜï'Ǹր/!9!ê%–¥b2 ÛÁŽõSp+õ£™ô~¾¶Q(GÓ´öŃse„‚ƒ »¹Y¨í„ðy,oÍ‚[Öx¬Ê&‰Þgÿó¸à*Bfã¯5#°|ó¢Qê((hN ÷cÞÏ1«á;&¬¯…Ñ?¾˜4ºdç~Ñø„Ÿs@Ê t-ó‚@¼œsþÕJÓp%ÃEøÓ£$¯d-†¶PÉoq¥lˆ+OÊfÈÊ4Ö0ÏÙÍ\týRèÒ*NlÒu…‹ä c2• ²¹QΞ¹'·7-üá¾€;ÇÀ™•º’™´CMuŠÊû0åóëágåþVM“¡ŒûÖ‰)rw í'¬eÃ,Æi˜5¯ –$ò,î*eR’±­ä§s/ô¶U’_ä “4öM:s2ïUØ p”02½ª†qf÷ý¯õ:OË—É!r…aAÔò$G5³=C*Œ+öÓ¾“Cò ¡]¹õ³Ó´¡fìv£‚´g —U“ƒkn:,¡ ¿Z‘®hX^Ék}É7°¨ÓÔå›ec% EàÅ!h½Žd¾³â;çW*äž8"Aô>Ü«ß´þeçì~“­ú=Ž U4)Á,Ðóª}Ûä®ýèâç–þú”e˜';æöræ¾Opìçïk䬡(§ü£ƒtMúˆ ½ã&@KsTÿö€³íÙÊc­|ïð+èÛ˜åœðÂ[f9À$ø ‚¸ÿÊV´éç~õ&h»(¼–‰ÍV"ÊÆ;ìŽe/¹Kö½.¶¨Ý9~û0, ÿX@Ÿ6³y ´!µÐ‡*WMõ%þ^©“€–IÅ<=Ÿ(©*näû)`¹¡µP3µ} †ùHÝø¸‚4Jcò. p†ìvÕDšcÞ íçÈO ´4Ú*7e÷aƒ£á*?X¾@>šÅ¶Ìý@6N¹&›(ºêR3á1‰T¬[ßA!½­DäšnÛŸÅ fÜÛ÷{%HØtÌ¢!¶Ç$EúNNoêLñ¢p$cêΘÑx —}¯´>p–ûÜ·Œíîù|7©'‰~nÛœƒú›ŒUéªí°„÷´ ¬ì®‡ U% 7s³×|©pq¶SöYJ»ºÂï‘}‡Q»ï Z.Ö<8©ÚG}G';x× ¸ß>Ô•ÌÚ8_úË…BIÇ•Ø}Ÿ½Ìr¯Žª5cî3Èò¬ÚÂÐ {Óœ±áL¢ˆßÜC÷ƒœkTдDœO2Þ_—Éd/£KJvG\»ßÕ(Zj͵«qž=p‹1ÈmvÅû»Ù~]pFñq¥³ÞÔé‡OÊÑuyM4×S„–PWCDZº´V㑼 ‹*]û×?6fu¾r~4^&¸O€Fó–­=ý €(çO­|zò²è4Ñx¦\}dµ4½%’à•ÝGz:–H%û9d®{–Јsת+íõñýiXØX«Ýä ÏÖV­›÷ âP”$#\Ÿ@Ä5›ùSæ×·-e¼558c¯ßBb>ûdÓJW¿,´ G_f‘H”}l–ó-IEÊóŸ[ήµP(‡Øx–âϼ{í[È3\?–êýíNmÔ‹XJš·Ûß~~(Ù9Œil4‹†R¯7|ºù(1Ðð‡æX:t¼íòâe²7òlçÈÔþ’¤q [~ù¨Û¯•ê‘Å›õoó »zQüpÆjdÔ Öc4Þá%7«ZiÀã}Ý[vo}ÊÒ*‚ÔCóW,Ÿ7ðߥ\È}î¨JqCcÌRî]¿Új¢<d…9öÿšy@[ý¾Ô¨‰˜¥H¬,P/ë/ÂüÚ ,`û±ÞN߀ôŒÔ 32óì,PaÕ21´GºUdß9Mƒ¬à/¼:ê™±åæT¦ºTáóOÚ?P§˜|î«nûå¥eЫd¾z¬Ö•ùkÍ¢! ~²ÑCðÛ7ªQ4Z£¥6¡lÆfÞÄ›Ÿ[ÆJ}Ó^²æ­7Š$¥¼ŸhÈÖ7™³¶í{ñÈýu¤˜|]FÌudyk>yqÀ›UâÀërÃ*È–|¢ê?ã›ÚçšcqÆÃÀH䦴Gý*ž&½„E —ºIŽ+Äê/¥0=ºê¬ÿaR¨ÈÃÌóºã/„âghŸ›]jßH÷âté×s<I|w#$®¥¹ &c޻ʼn;«Ü.Š¹ EÍ–øÁ?8½‚Y¬°á+fkYë_G™Õ¸; unòD}ÿ¸ÕæŸ@Üv¨²ó¾±Õ£cò˜+ωžI…”¹ìû»ÐÌ…ï ÇÙF8Q.¨i1<¯¡ÑÍlƒ²”Œ lq[Ç“Â>wðº^“Ãõû±í­èâÃ{<Øn³QJDÕøÁ"Ó§4i¸»î¥^ k‹ÛUwijÎj[YXŒ”ÆpæÏ›Pu-?Ù)æÓ>U5œBUûx“5á¥N"#Ú b ëŒvdɽ \8ù+?:L'äÞë¥ZÜ’j,„é5™µ_§[Ÿ) D‘/wn¨,º{¸jÎÒêH]fâÂ'·Â熶>èÖY¢šÖ-›Ó‹½ß¥šuâ8»œ/ëC®3ÖÆM8ô¥a¡âáþ~åkøÌî $LvhýN¹8ÌìسcêìȨ̂v¯hŠ|ȯðqç|:«s„Ï5´‹žT «Å´3)çX}úÊÖûTãIñb7º0 !’v‹ž6jâ*ÀadaÜ&R0æÎÍt¿QÃÝüõ¨á’‘€Ì@u„(f†¼6®[\’âz@îYº'Ñ)¶÷é´@îEí7-í™äÃù[ñÂç»K3“/õ$ê×Ýù—ý‡G4x¦øxÒ–à~¯'¸Ú*OzGzÓo½!•«oñVÓÅ|}šžuÓ$‹ÌðýE“Ö ­$`¿ç%ÁÛÏVÜÅuPx¼['Ϊ­õëJIò}ÜÊË¡yÜyD&ä³ðå2](z’9›p¼"LÅ\Õ'ÛÛÓÑj„7M‡Œ7;B§Eèñ¿°Üçæh¦H» ¼ãÈÍ{üµßö´+~XR%—”çöN4ÀE£±Óöö| ³åmoë ³HE°B èœ!»¹uÄ*¸Gô•úÜ%Fì€|&d~½Ù•8^»ÞO™ëÉÀ^ÓOtzêøøNv§E (Vž’GkŽ—{‹ÞI—L㸱1ÍÓÞßQ(fÊö êé¸2ÎŒÀ$0aò÷ÑшAeÐ_ÏèðTqÎàújÄÆàù(·s ÂnþÔ:½Ý=„q4ât>ç[V$ë\å»ÎâB2Rew€ê¯ÏÙÎb­îŽèŸËÝ¡¦)¦˜ .¼O¿®¥ºU ¥óTžÿÑÉ:U'|a<±$.eS@kú5šújN…)N[r–´»;î; OP¤ì0ì&æÐc¤‡È‘a‘C¾Ay²;ñŒíÒEÒ«ÿ^–Ñ*žœuôøÇ¢‡åKçÛ,Z¼ÜD²ŸÝ»S3ü…玩 JòPÌ…puf·ÜÜv2×שGî±JM›>á‘“V p'TéëQÈ\Ë£éÁœÐsf¬Ýý+wYlË[~±Y©%ÇìxÆÇŸoOôŽ¿@–²+¶}l¨?IŽKÌ|÷(¿Ò$Z’ÆxL´©J¥”3T.Çnw€øÅ•’Üü=¯uÖ–îã^sp«G¶9È0lŸGÉ.ÈV·Êoú0dŸˆ­<ˆtêË쉱¬H—à΋pf¸YÚÿA¦x¹ +!‰ +ßPú¼–tç"„Dk„ƒhÑv’Mj¾oÞ‹ó-èÀＧԂ!e˜Õ!ÌÖr*ôô{x"9Éö±6ÄÒµ½± –'À´ Æn"ý õ\¬vIóɈø>ºr!Þ@QÎ;¨eÝ­p ×CgØwïân‡’ K]7™€cuIDÉ51îsp ){C"X;ç¶ö&duéFþw™"ßYäÚž&K< ®Þ-:ByPø+.¦kNnöʦô´¨…XžÅÍyN0¯öOD `y¥¹±ãV…ÚÄ¿6Ü’œèhÎÄ›º®g;5´4ÏG¯€äƒûœþëMXHkqŸ€ë”øg7qáúÑæø:¯m¡(œøhT ùEgi.8ÀWW^gD ð5ƒ; =Â#›¤“Ç*·bô+HמÌ×>éaÜíH¼-®%ý09ò¸ú)ìæ& âÒ5±|áh+Æ6QÛeúÆÜηýÏlÛæ§éL&RÜÑ8¤‡œçž©ÂzL(†²²í¶m›—Sã4):Ÿø¡Zè×°" Íp‰SâÔó:Å‹<ʼ/17?ÕÆ'‰Åמ²#*T:9ðšm†Ê+ÑÏxNŽ˜Ð¥°(¾^õ[ÝlNJF«ä…ˆæ#¯ëʉîâÐY1ƒR*- Yøõx£-’•ô˜Ík$vW#Tæ½B¹/¥YoÑãÅ©\›`N8Äý˜øÇ×ÑH,ƒ"Kß#_ šÅž#›|wgÇÝOFØ;í>»­Ï?Es´%!ó÷v@ §^ù©T[Œ‰¾m®…n¶X¦ÿ.2cf´ùËT&•x]÷j]Ê™³Xáê^:˜ýì›Ëm*Àë'½ RV®ÍA28¯ÈP&4*ùYµä“G´(Ép¨eÄc·¢r’Úˆô:-R4RB‚m§ÛèWš}ò¦Ü¼] ¨1hmyrÑ}'QEOª<žþ‘ãÆ]RÜÇù\B÷÷XA4‘!µhÎ9)H-aŽØ}pâÐ$}½À.„h"õ¨d!â”!ÕÏBR‘8{Óú—!ìu’²;ϸð­ëûHi ÿ¡jM:®#óí“'Ñî÷àwa’¦)|è€Jÿ =º/Mï›%¼Ü“ âêÉv=>Ëq%k£­ù†Ú4YW[[,¨(ûù‚Yüo+Å”×Þ3OË1|HFŽ¬¹$>_ï‰7µ •-ïØ µ¥´ƒÅ.SN„¬¿ƒbBývá/nh…N~.Â|Ä=xå˜,·¾+JEÓ=U4X÷V YÞ^ÞÈ›Öâ^[Š`I1·¾v­ÐÜ`MbÏÌ@Ùe+pòm˜Ñ éÄôŽg¯ÅZuÊÇÀᎅ 3]É/SÜÍØñ“$Ö„ÌžÂqû„*&7Žƒô³£jÖUÚQ~õf|Œx/þ°>`Ü3ý!LSô4¯óŠî‡Hïq݇Ãõ‹j=¸¸{…œ:ŒÅæÉpCØqyõˆç|%¬2 ð¶é¼kñÜ![?üTâŠêTÿ¬ÎÄðÛOã߉ãbX0æQÓ?;Ö¤(ŠVï`‹JO€¦÷Øy/­ Æ)¤ 7Ø€Àd@\ \Zùeº ÒMžrd_¶DKNk”ër™Þd¦6[G6²~Ö罿ö,“kOŒ„­í%`’oÑÍwÅ5»9awÜf÷TìúNnê Š©²ØÛh‹¨}Ç€C¸H5¥µ:ýôNMöyˆòtròÓÝýÁ/ƒ)@ ·Û’³ÎÜ­ÕÙCÁìqxý,ÞžèþñPî–ÉìãsºtïšØUt­Áj4=ûœšÆO ’µÀ +U¿‰‹Á½(ŒË ¾¶›÷†.¡ìO§8ÕòðT+‚”„Ó¹ãm›ÕAp3&ˆhXiß×nìE[Xy5kSôÕØÈœ¿&Þê3Õ›ÿrŘd¤$Bf2ϘðTãÇSxò:Î!ðHF¯¬R-Ï‚çT(£–è r}Õàìoq9t’Iúþ49GZüNkÕRA$ÑblàNÿõgvÁ &Vg4ŠTkV^Ö´Z.º˜å-LŠÌoó–DÄi¿f„œÑx¨Úö§ámyÂP <ž¡Õ?z®…¨|ÈL€Š^à­N2]éærÏìé‰É7ïÅ: ï4ᢥ¥¥I»Kñæ³&ýBcßÄB—<ÍÎË”¯D⣯’&]¾ínù’Éçœ/×~T÷‘ÈŸ¯ž¯˜wäORc¤ò^²±v\sgÔÉåìŒ]*±sUe~„v°™r÷¬Æfx ¿Ý0r¨]5÷l+üŠ ZÈ\6öE$ÆŸ–¿a¤å^-¥Êk#ߺNÌ),ü¦²|-JŸ5¡Ò+GdäzOM›™µ«…~‰ÅŸúI²ö²TTƒ¬éÙ[9Zªö˜°‡‡BºÔ”d²•ÐÚD |pr&#¯”VDÍ’›[70š ý7ÛˆµÌëáêG™Îµü!³þ¾›n Iþ–#^^ý3#5²ÜÉBc¨}çÂëìa­k‰¹Dÿ*Œ¶ÙÉñ-U*’±V«žÛ þY+£ ƒ“†:­½íç·KËì¹}“Y‹¶ð÷ž(›·óªɈã¢9¸ëÚ^pYš»LµåÑZ£¯4„¨M2Ib_;uøÖä#Å=æÛ\˜„6’¨Ôa£·—èl¹lÒ‰Ú "zè›m‹\ƒ`´A O˜Øò31cÞ¨ç]Š“\›ZÐ-w²áÝG>¢ÂæÜòMªx΢¤¯áÙÏŸ€tÂ… U8%©¾º0-IðƒLYœ-Oá³°°ªÎ‰Ø½¢à¸Îi××rÇÉÞ‰h,óíZÝ5z~þUõñV¼‚ÊP‹ HÏ)¾ÍýAJ5ÚÛ²9‘k--tØ$hÒJ"%ù¨®5ÁÕi€ÿ“‹-=ÇŠvéÚÈP¼I™ê!Ÿ•ùüãƒr]„Û3uO[!ÌS×F}6p_ÍÛ’ÙTöDrøæ….“ ¥\–pù=ï”RQ}†uTrÇë¦ð¢åĽ…°£ ¶/{Þ‘·†g ë»5W=^džlãMÃRAŒîÈÑû }Ñ“×ôÐ[:´¯Ú¢ŽùÅ̉Ñ”’èŠæöl[^q)L#¹ÜœìÖ@æêcûê!ÀfÕÄ ­¾:/ÕwŒ‘¶b_¤TêF³Ï€Aøü…ÓḴG-U?›¶3Û>æ{`è¡àÊeÙäø!ìþüÄ=Y+øâº-þ&¬mÙŠÔÕ3® á—:‘žè"J¬Ö¡îÛÛ_:htÙ‹0KWNXHZ|dtÄ’ªvÆó…5d"BånÔöñ:7*d7Àìý¦ž7““%Q6.zObD§»~BÓojµ,ãXBÍ›$c½™(–øL ahdŽzro÷ ãßûHr½êHŠšLí±n€"ïû,ì‘ßÒs¬‘ÿ¥º$ÏQô-=_¤hNô¼WS?µlq‘²#g^ÿ¨×T¹}³²>]bã¯:Æ/ŒU¢7–hüú7€L®9ƒñ®Î¬°òopëW«<Ü\m ¹ÁÎ,Zš\´,jüYȃ“F÷¯Wb0Ùh[4Ñ+GÈcßCpŽì·„‰ú†Kg7Tmd±÷Ô, ôãË&¶¸¦gVÊ4¬§¡#ziH-‰Í„ÇåSÂS0~ áœ&{×2ØÀ&˜å™†½—<}Ü¡]Àɧó ¹“\EÊ#O&_Ÿ*=rC §ú½¹NbîW ÍÎÅ’!W:Ð[(ó£á•i~t|vö yø1Î Œ©ÒT_äEÙg÷½ì¯ šò=S­t‚ˆÕj·q±#O4K‚v³ÊÚ* '³´Ïº!>3ÜÓ=sÞÁ 2ÀÛ†Æ)µq2H ·Z¸xª)‚%ô­õ׶ꜙ-yÝf€Vß´t8»i%¨K¤HÊ ´IãuTÙ¨ý^l¶È+óåŒÃú,í”e6ob—¸2YDfµª8’§Rù¨@÷b~þc]V§»º¶ªHóYeû+u Ë‹•Z™„'ÂSÁç$TâË0j4ÚRY¶Ù™Ô1*½^|ë~kÀ-΃Å<î‡D1å~ÍÎ䘡úóse—kŸÐ*_œñÜ¥0£÷è´Ý*©«lئfÜÆ:•2,¤)Ò—¹x’³‡œ¸y¯#™…Õò?ÔX:Â2cÒFG C î}­Äß ÁY"_ëvgŠ¼*†¦¼2…ä¥4+?0SÔ‰üÜøöü—á%’¹BÙ©^;G[îõ^‚ÏR]îMõ±° RóîÌNÕãxÐ*pcÛ^,¶~¦ÿ«¦Åµä,³DæAw;Té0û¾F â†T‰s½Ž÷ÉÇOÒY;ŠJ‰B?}­1`˜¨/¯‚!H<+l~¢B»ü†8‚È%"‚—ÍQˉo2ÂvÛò7ø»-Ux'Ç.ÚÔG»½*çY’æƒÖ•C¹X½Fòñau]£–PÑ/¯âöA%Þ‰²—LrÜ¥V÷Iø¯¤…\áeÎÝ?yP-Ž¬6ªÆâÝìê$ªÍ0ß4ØmaÛÜe?ð¼üÍ—¶Áú†<û®Ï!¿+éS«”K[4šÍS-÷—5k¥ |-ñ L7üÁRÅŠê7 –”–Ò^Y;yyf‹X©sºÝ1»I?J¸K®ñë_íïsÍîLåu¢´âGá9¸94/äôá7ûëf²d¨CÑœ ½–\:œƒm]ÈsØ“|•f¯­YüuQ©ÈëQ̺—Sen6Ùé(B“†Ómyn(GÏ>˜U‹“`˜ëí†a¶­Ï®,ŸÝzúêûX¦¯š™Tžè1™VKØB¿i¦)YcCØà9`º— }[†–v×÷®ì¼Uû{{=™œdÍ8Ïûñ“úRkî³=ãçq äÅ`|‚éNãDè9Žíf/îÊR}*vâ#ÔÀŸ˜Çasül%OSÚf®{â¦kˆŒÆ] "YÚ‘Ï[dÓYꔫO~ul¨*?=.ÌéÄÃÞçðŒ¨ UYÿš¥~Ž€þʦº¿q¢¦£ŸV&Föíi)e»ëëotx°cr»‘û•Â›æL¹Y×sf„¢¢~‹ïfíeŽZÉ•Ÿ²ñŸœä‹ÔD¯_#ÌÇ(Uv: 8CTÁB [6íÆŸ¿ThôÌ%zúqrí©E–›ºKCöÉžE­ø²åÃÂÎ’2º%@Ä *¤,í’nDžÕJ¿È]F>dz­—­ìíAŸ¬Ž¥ÈçŸ!(œÝ\8ˆ A¯þ¡Ígñçå •ÀD§e$Y<ñÆÀ]Åî+7M©­¯óâÇð%dgÁ†:t5³º>B?¢Ÿ”î,}Ïhahs¾[!Ö¢bûì´=v–­Ñl¶ E9"K´«4QpÀðuH¤S#ÍãĬ·;Ì‘Šöô©ÉäÏ£Ò÷ù•%z‚¡Rz™•¸,q¶ ‡&}GŽ:ãòÖ¹=¶û³†6!Ôß”éW7ãT<ßÉò!·IìÔÿðKßÓî2¤Éì©}’½§¾óšÍH){Õ%—Dßî Êe¤Üðç —öQS$Ng’¿=¬c™bsqÆ?0Ö+ïÆâ|ŠBKç QÿL´Öš²{‡3v ŠÜKÍzŸ³!é6ÕÝt¨6e ¥U½3ÑhÚ‡¢Ù¼EÌeÊ•›'[ôÀö4ïKíbÚ…¶’Š{2Ãeæʇt×?•£Z£uÓÒ©‡|þÀÁHBmí2Iª“MÇÊ“‡M•ÞNuv»¾ß¤l2 o¤&¥­œ]=LE½¾ v€¼¸£…C<çpܹ·û1Iž5Ë”v(á„6ï’ÛÁ]ZD¯/>œ©˜¿rUÝšŽº0ˆ)LÏNÙÄ'¦í1ŠÌ?ûžYsªýÈAh š‹±ÑK»% „GsG …Ki²×åÓêÕ s½¶±Mþ Æ z6{sp¡(È‹³˜T9’˜Õ²M~NÎq|Ž»·ŽÛùæ‰%Ëþ³‚~ûBZßµò‡îˆrUîªêô#Ã@¤b¬¼9J cS£@2ÅvRÔ#‚Î8\¿úY 'PŠÝÝ9/¿œßîÇPÂÏþLsG§t´^Û YÎqRÂI•y³SÏÒ[Zxþ?,¼| endstream endobj 132 0 obj << /Type /FontDescriptor /FontName /XZNERQ+CMBX12 /Flags 4 /FontBBox [-53 -251 1139 750] /Ascent 694 /CapHeight 686 /Descent -194 /ItalicAngle 0 /StemV 109 /XHeight 444 /CharSet (/A/C/E/F/G/I/O/Q/R/S/T/V/a/b/c/d/e/f/fi/five/four/i/k/l/m/n/o/one/p/r/s/seven/six/t/three/two/u/x) /FontFile 131 0 R >> endobj 133 0 obj << /Length1 1457 /Length2 6268 /Length3 0 /Length 7247 /Filter /FlateDecode >> stream xÚuT”ëÚ6Ý -¨À" 3twJw Ã0À30 9t7ˆ”ÒeЭ´ˆ€  (©¤0H‡JI}£Û}ÎÙçÿ×ú¾õ®5ïûÜ×]×Ïp±š*;!¡8J$”¨ê©[‚€ PT!ãâ2…¡< Ëɸ̡H.óªH(…•©QXE=p××€$d@’2@ @”þ[”¨ý`N=!À]êCÆ¥Šð DÂ\\QØ8x ¼´´¤Àos€²' ƒ€á=0Êê‰{Lø`?(…ô…† ÿøç‰ 8Á (€#Ô'û·w¬êü×Û$,`ÄŽüõüëË;aN¸Gà¿Õ·XXKKÙÜZŸÿå**ˆZPD ("-€ÄÄÅ’’"€:úW þ¦ÿ[j†ýIï?\jÃé¿X`Ë÷7¿?£ÁógoxÿŒ À4Àóïù·Š!ØÐÿy ~›üÿ†ÿ——ÿuþÿ;# _ß8Ï_ ÿö„yþÑÀ´/ »zìŠÀÿ[Õú×FëA`¾žÿj£ÀØ%Q†»xü«0 XÔɆ‚¸þ5G÷ëÞ‡"|`¿î€ ü/ »vwì½âƒíÖoŠÝª†T‡CN¿ÖOD\F"ÁdØæcOâ4»§NЀßã ‚#PX–^À$ûÕSQ€°öv€{@Q*0—_ð_ˆèäwÿ@X+$ØéWÇaÉÿ‘ĉ5DýžlÊŸßPhB6;…€ÈF»5FwžÔ+ßôÄŒÊäÂXäò ¢g‘]¾?©ˆ³xëò#‘GÊYC¯¨çVÔy•>±] ·Úš‰ãÚuœŸÛß7ÇtÍŒ1¼/ßRnêg!½%hª´|áláŽß†Ûs—«ØÛWŠÊ°”îÄÿµf@Såçw±S£µ: òóÊ‚)fɶO&¸J &™8ˆP‚,$|´û×&>Ò½¿b»{ŸŸ,d;E´m½$’z:4_m*âó’ù6³5 þ!í»ñ;h•õì»×§ÑO+Ê&ØS½®4mŽL#Pî¾ùÜ⌆з¡Z•!•¬m0s„ò9‚d_S6¢ì›ÑÖÍÃjU='â[ø±wl­LÑœ~Õ”žC€N"uqÉvÍÐÅ þHQ›þŠ˜G’É¢ýŒ2w|õKìTVIïBiÈËG/ýÎ^ñÐ~‰Ç“¼‹£M¥a LènÍ«Š÷Ø=âAPÕC>É K_?ÿG¯)“ŸÌÆž¸Ü™Jª6;ߥçW«±P®è_ZœhbÝaYœ4,-ã²CÐ(•/á_¥Ñ”hgÕ.…ï`BÞ‹Þ’š9Eûejèý(= ;ùòœ#/´ú+aƦÿ#¿ê/ƒq—  –­Ë×[Ú88žw-Ýoº¤ÒOnô‹ƒÔ Sâ˜lÞZ ¼$ç·6ÃøNæÏÚÒÀç ý¼ ¾Úe4ÊYãÄ.ˆm.âCx6&“뜉W×°®V„1þ…ãûm&»¸¹ÀÄÏcº[Q]n6 ZMæ1znŽR#a3¡¨CkÌ#ž“uØr…s¾`gD‹!©f9ooø‰<=Ù^ÊRñx÷÷0››²•­ÑÔ·ÚAÇZ1Ïêoç”ÞFR4ßœnp‘Í£&>ü¼»¬¤pc­ëšô±þx¾Ÿà§o~eK¼ç¦¦ej|,Úº!E­Þ·ê¿<ýì0­p|ÄâKÒ•^{gCftKÞÃn’uûá8Bæùóæ¸ÍrõI5°ÏOvlÒ”ïe¿¿8¢Œ´É¾†Q7‘}s`¼‘"›IÅ1 ÁÓÿ¬I禢*ûˆ‚¬‹+o÷$…&¸mTnôŒmþ¥\¤ÒõµýØ:6¹O¸ñ)y7ƒùcyC& ÞÆÑ‹ÜyÖàÄšíí 9_ä\Ѧrml]ïÃhAµÏãMšX g)¢Ùà«_ߣ+ lñÎ~)bÀÚ³W[v~qŠóIÖ´ï†õ9µwk¹qm¥çü‡Îúb kñ½Ò¾_¶;lvÁj¶ xVEÞê2ã9W”~«KVî¾o£x?ìtø*$'죤þgÞ~AÔ!où½*umž{sz6׺^l™:?µéÞê¹ù6h~]HXÑ_ÍZƒwꌹ¸~ê÷^cºëbªâ2{Ϲ=Ú€¾Ü¢š<†º[TgÞåkÌw}æTáæÑ©~[LútÖ mõc¶c易¡·S¥üiÀ7 arËÇOìZßùÖNy[ïVQäÕ±ÉwY˜»Z]»c|‰®a û<׹ν¥”`jHsL)v/·búôl|…d£þ’±èúËg7F–·¸_*Å3ƒ–E[ÐTûz:óéáöGgö³¯5Áó¦=ÊøŽ¸Ã‰#@ë§*èÕòJ§)L‘ÈÝ£ìÚU…3€¤ñG’„QjÉäe‚Üé´t’ñ™ë½¦Ô²oê×·kømÄÒU¾óáÜÊê!ñ ••,nÂþ‘ãÇX(â™wÜ™Íz:¾p`£‹Ù9­:Ú¿ÇN>7ä5×Z¢"ZÛ±˜ž¥LªŠÐCeå•>J.ÀÖI3N²Î ¨ÓD·üŒäîàªûnO¥B9Ú.ÉÃK{À #ñ0óÜûUŸÑÅ>ǼÌõZÒÇCÞ;{°¢ïöeÝ’ô_ôtØ{Äëy|6™œå†Õ$Zþ Ö[ .ÍO^hU0Øô“¤Ù1²RäJŸÊ„¿¯¾³)˜Æ£>ߺïì®ÊBLoQT›=Àœ<Ï-Ûk¦õí9,”̇êI"-ÃEµÜiJJY“AyW¸ùfm| ,oân¬îÓÇŸ\YÌèÉÀù\< æs²ÚÍÜeß^Á5Jø”O ´pÙNP #”ý-7‚ºcŸ­Ú»p¥@ÛNm&w ª’»4-úþèÞ‘šfœ Ñk£Û½poVNF÷KÈ]}=©%ÞçPÛèq™,Ñ/1"&„ù¥¾×F,+ÌYtEâÝ°Ìç¯}?¶Y_sô!¦;¡»WÆùz•%^ïÜ6UI$í“PQh@òëõ§ü•Zû«~ôùücøìk.+©ø,ÔL²\îë£m”œ‘Éü¶9H#_p}Ö{öŠ@9Cb*Vó†«=Ë.…Ií¬ÑAvMA{«³i­lãÒÊž_¢j[ŸéËE8 º\Oô`ò•Aˆf³˜íÏ—NïÛ‚‹{e ·¹,%8W)-ç=ô›ùRxi}QçF®¯ÒhUA¿/øvh!ÚwF*ŽŽO~s›‡NöæÆ´Õ¹]UªC1; t€>ol°Ž®‡_ þŽSmn"àW'1×ÿEhìy;x…‹~Vaü×^Ó0Õž¯Ùîe÷EÙèWJ|ÆfÓ©Sñ«r79Å^‰‘8$¨ ì¿ÆEȨO¡>³¢õ¢%8eârbkÙù](<ÌSU®,Ìâv³+‘?;Ó‹'üÁ²«®Ü'_Þ0*óVÏ`<ðßÜrÈfå±£À<‹'x–¯-‘)cDB:Ç:±Þn¸¼£3>*¸Îuø½"=cÊï@c½Ôf)Â;0Æ–À:%¼*¸‚oà× ŽßOÓ«ö,)R`×Î9v…;=þæô;n@h,gômYÐœ5Î!"Uå8¨âÜ~cߨu)´pøUi=ׇjãø`[ ˜Ÿ>×~è UÚþÃÇÙBg¤Ü­U$^äí›`gãôƒ¯6~"K$*)ì‘‘s²¥¾hûó°Ø gìl·2^Ȇן6)j¥è_Ž^ÜYÃw½Y4 3ÇékÞ[lzp}–äö’nQ®Åœ—³Ä÷Ｇ')’»hÊ΀~~>’¦½3Nùliš!9cGÄò‰©¾W_ãû±L½VÉLÆ”‡¥F¶–IØ.ìÖ›û7_2ËdiÒ[­ü¸ˆnÿ¦Ù„´ƒ“€¶°Æ1Ù¬¾n%µäxJmúi˜¡å§ŒSÏ‹vh›^aäôNÝpŸ.)ùcfÚ¬[šÕðtæ@aœ¹ï›æÞS‹ kÈ—Pñöõ‡¦ŒímMú-¤$ê•©“äæ^Ó·F=¿ÿ\%]~[œ—rsõºz\óDrtú$cƒp%••6D@¸”#³ÁbnÌñ“¢¼ˆÖÙ˜Yª`XŠÙ0¯X ¾EéyÑÅÃ>EðЕóÛ \§ô²¶“zÞÓWÚVãñ°W¿±=sþòÅh¸&çÍÓé‰ ½¯Zi7kÉÛYIÒòå§N!£Œ.ìFs£‘ý‡•G.¸KNzÒ¬/?Âoðu6š»o¥âå/%:.ŠFWm¨´\ƒRS)Œ] ÜObIbNmsGT!þT¹AŒTÃnjhKËÇZÓŠéý´Í¤YfY$¡ô^ïÔ#o][_}Ì Tí6¨ý v "æ"7µÑq}õ³Êfû©õ–mž kUŒ¸kd²5ö³zYq4ƒÓ=º~ÿÊW‰x³°–瞀RYâC &ÅþM2;ûÆgÖ&b)CV\ÛÑþ¹ù¼·¢¤¹¤‹i®ÏsŠ6‘›`¶LQ ‰Mæ_)Ô²zz÷ý½@%Ðéð:`‹ÇmÖxã| ÚÈìYµ# !촚˒8Á¡%yCñ•E¾yHäQ¶Ùš™A³‡#†•Ôˆ&ÍÏņ±z¡~J¨  N£ÝS¹†Æ zG%ô»¡re6\!“xÊ!g…dÄË#ݲ‰áù¯=™}ýtZµPååò8‚Á£œÔ2n»²fIòŠ—-×nY­¾»gìÇ‚lÞP$l¾®2eþA{|6Ôò8à^¡òÆèäÕbhõÚI¡N¡/*Ãä꾃uÔ’¦±«i–‹è¶V¯ØrÁ4÷8Tǘҡr.½€ÿyÕóò5[ðr›äb©CKßÈ›6!æ®Ë‘؇°¥2ô)GòW<}’âù»{Ÿf„6¾âÿXcÓDØÒù5ÜÒ.0éäO”¦fp5kÖuâoyàì›Ùù¶âu¨§QIƒ3kŸæÞ¨ã鈴•Èòk…Ú@§y‚Q£ÌfײJ ;[3çßÚp¤b•øäø[V×ØÓÒ…¶‹ì ]S¯ëOUƒèÞy‡÷í­!­è\vëõR›¿'QÑnö’ý°·š]íèÞBúr+/zùBéøßÞp°"VðŽX|³Ôì”pÚ‹?Πì9`¬¢‚Ræcèâ®H"3~曶”íìÙÇżr»—$¸6Îm/‡2X—ɬ^N(š¥fV†=Iï ’Õ@‚—+© ž„¤ ÛSæ .©q#Ùo¬q' 7èŽ)åR<›b7 ûz jì&o&?Z¡æ½Ö óx1ãN¡¯ôÆÁˆwÞ¨šœÌ" ¥.‰fY×±KH´óà*,²zIÈõ)À®j:A– ¶¦÷5>Åþõ. x§5×80¶ˆò³õ'™É”>û©ÝG÷"NáÓAÔTìo…‘çfÉñ&ïŠñö»<ÏÐ#Ösz=Bݶ–v9E±;l¶ÿ„”ÓÎ…x_ë',Êɶmý™ÍÓ8ÉΘvñøÞ—Ù-|Ý'­ä qÑY7¿¸ ®‰nMnHo<ϬM\˹)9Eg}¨juD„‹Ii o{gлT)#Àþ<ãÂŒ>Fõ6ß'W͈W\¸b)ë±?º9ùËdKpŒ) ÒÈpYêrõX2”¦©%8UÕØ,W×ÖÆi”šn—GÄ»¼µ„DŽ5ôtÉ”3#¤ã²lÑ»Ñ5ûW®\~Ò‡Ü(Fây3VúŠæ £þ¬;Q?5®¼ú'*>OHY$a¶rZ¶4ÚÞkEä>x)hT®nÑ9¦¦Þ4.îSÈ)dJ¤¢6FÏ'V7ȜݞáBòmÔXd†æ†/Ôš9öäÛÚ©?õó!îSÔuG4–§Ô–O\Â5R²Fx¤‚@˧ NQ}?¥ü‰I… nì;†sä×sé܃‰ÇôI÷ªÛ±ÜýºŠw]¬Ä åÖŸØw_53÷M\fDÒÙëššlÐõŒ0€• ‚ó=é¢;˜A-Öñ›zð ¦7ï±™b-`ÙѪüc×VܱvT¹çpΡí Có7þºÈ"ÞÖ2n+ 7PzL]õ:•²Ru•ó)|¶ïxŸÛ"¼Ÿ¶§š»¸`µ¢î8·á‡ß™¸éûä“Õ9ùúÈ,ÌÍ)ºŠµ— ¤¶˜Â¬\à+L,…Á(&Ř=I_Ñ”{ÂÎÂ0†»Ç… -€#ãÜ"ßckSs8£~gþBvÐ$‡c‘a;,§ó,ýìµV99AySo/¢4ÝG¶NŽbj9¸/s%åjû:‚ÏᶗƟâ|™œ˜)GdPsŠÏë·­›¤þ<+¶°ô`4ØH£ªµëE?uK'{Ùàœ“oŸàœ‰Ù”·6ÈäÙ㯼pØÒ"%k§ }”?Î'éäJò¯gªÊÎü3¨yr"z;_¤”fLgÔ¦O˜¥IfÈäi¡Ü*.Ò9!¨›JY數µfObQø‘ªû$iÑbL¥ñD¶6Ò¿¸° éiZgQήϜ‹Ü™Ó¥Dt¨ƒeWê)ä3&÷¨<#›› 84¥ã%¼¦É•.·Ýn}UI·–wc¯¸-IÞ/lTð÷†šµ‹£¼ó›3ƒ[k¤þÃA²ir:;-ï‘…R}¹“f¥u* õ$¿ÁÑ–pØýäÝçCæ´£›G¤ŒëÍ’!¨*Ìå“IÏG³Áfj‰ #……úTýØmÉKÛ­8„>—q¿½_טÞÉŠ³dëƒá\¤²…ªÁÒ“kZ¶ºª~_µ×SÝcw£„º·vL·©ôáEªSžÁܺÜ_uy½“¸q0ø]_~@h çnˆuÌâ\gjqCWª oq*‡ÎÑ hcÏtñ Ê7AKÅß™ÚÆ5'Å£ôÀÇoÉq,!W‚»Š½fwZªeC‰‡aRlWïÅ F8\…o^œ–¬:ÌŒu ö›+ ™mì·²ÅÑá<]ˬ׀<’s‰Ý¼;ù¥Æœ y’6þÁÎõøÓò"jÑÇPôáðäâšDÙ‚h® ¦²‹ò¤‰ Ø53· )Ö©{©·—³Ä âSà‹PÓl×¢¶üpgÀçÅ}&ÿ7|'9%¯Þ®ÊÞÜ\õá©Iá4T™í¸" P\‰wÓ:úHû˜|ÇqŽ¨„dÎ~dÇŽŠ¢¼º]Áø°úÔ©—`DÁï²ø^næùeòU¸Û‘ˆá¨I¬¥(V¬‰.¡?s=«Sÿþ´f~õ²øÊmàãÓº¶'™†eQ¬ú6ŽÈ÷ÆžÁ„ÑN±pZùUä)K-ôH”8=xQ »s€ÒÜu7ÌYµÞÊ{»ñ3u$Jó–ž}¿ æy«h´à À§´r‘ÃRøl$ë…œFÑÝý.Y ts€q@ùmÝ*˜Ïe€¨azsˆãkãtRã…¼Ô ÖªEIa8¡²›bOVuͧ‘ZxË{‡Ø)m¶@ã’ÈѸqáæ —ËwªWR<}¹W»¢€-fà §{Üp›dJ„ÛÜíÊ‘›ò Ë׎ªkiWÒ·17ªR7HrÆø»Žu5IЊJ cÆklÚËwêè+´¥zæ–ƹjZIVkß…}Û\ÀŸV Ž×’—àpÇØÜÓ‘Öp¤©H¹ày¶—ºÅeèÚ|×âu“%»îDç›iõ]¼œÆ²0O(/@éxCÁ¥ŠIÞ=QÕÌC~Ñkèf¤Í…Õ-q‹.}õåµãŽÎôæÝy¸ÃÌyZ,A|ótjd^Ê!u—EÕÝrR7Íh.…²z½½~'f “n‘Ú|ŒRXTçöâuÚºN½|¯jõ Å¶{£ ÒØǽ›X8ß³(ð¡” Û‰R……äS$äµ3ß,ï@{-=‘Ó4#—^”ïÜ›¿Œ½” /oòœtì0¸Ð¼˜?8*§ ¸TÔï›m {|pñÉýÆ¥Ýý ½Sü/# —Gu*”ú!ßUÞì>öƒ§©v_ž'ûs¨\NêQ¹-Ì<ðË U'üôÝZ¿çû‚/^ŠïY…{o2:È>^ÌæÔ·É„¡(¸½¥äDBCmü£Þ r endstream endobj 134 0 obj << /Type /FontDescriptor /FontName /HHAVZN+CMEX10 /Flags 4 /FontBBox [-24 -2960 1454 772] /Ascent 40 /CapHeight 0 /Descent -600 /ItalicAngle 0 /StemV 47 /XHeight 431 /CharSet (/parenleftBigg/parenrightBigg/radicalbig) /FontFile 133 0 R >> endobj 135 0 obj << /Length1 1679 /Length2 8660 /Length3 0 /Length 9758 /Filter /FlateDecode >> stream xÚ·T”í6Œ”¤¤H3¤ôÐÒÒ ’3ÀPÌÐ!ÒÝ ˆt#)) Ò Rßøæ9çÿ×ú¾5kÍ<×î½ïkßëfz-].0Ì ¢sFpñróˆäÔÕUxy<<üÜ<<|8ÌÌzP„#äo9³Ä …9‹þ‡…œ„@ÊäA¤¡:ÌðÜÝÀËàå}&ÊÃàãáùÛæ& y@ÁunÀs˜3ŽÃ,sñvƒÚÚ!yþ~°Z³xEDžqþáq‚¸A­AÎuÂâ„Ìh r謡„÷…`·C \D@OOOnœæf+ÉÆ ð„"ì:8ÄÍün r‚üÕ73@Ï ÿS¡ ³Ax‚Ü ¤Àj q†#]ÜÁ72;@WE  éqþÓXíONÀ_Ãðróþî/ïß Î8ƒ¬­aN. go¨³-Àêh*ªq#¼œ3ø·!ÈCúƒ<@PGÒàÒAEmÙá_ýÁ­Ý .87êø»Gàï0È1+8ƒå`NNgçw}òP7ˆ5rîÞÀ¿×Áæéìû7²:ƒm~·vwê;C]Ý!*òÙ E8ÿÊl!€ ð3~aAÄñ²¶þN çíùCÉû[ŒìÁß×æ°A¶ñ‡Ú@?8¾p€ps‡øûþ§â¿// µF¬ ¶Pgœ£#Å›?1òüÝ ^$ýx<¿?ÿ<™!†9;zÿkþÇ•µå •8þjù¥¬,Ì àËÅÏàâäðòž!üÿ;Î?ø»û?¤Z è_ÕýGDgàwŠß] Ç÷w'Qƒõ¯½aüw ’Ðë¿ü7åä±F~ñþ?oÁ.ÿäÿåÿÊÿÿ­HÑÝÑñ=ëŸÿ=È êèý—’Ðîär¨Ã+âü¿¦†?7Z†º;ý¯VB.‰Œ³-’è\¼Ü<Ê¡pE¨¬EXÛýI¦¿O™Ãê Ñ‚Á¡¿/¤Ïÿè»g퀼\àÈ3ûS‚#ñÇñþÆäªýw ÎÖ0ðïä€ÜÜ@Þ8HJ ‘ À—¹¼`ˆ×œ¹a¤ Ù³?Àæ†óû …„@ùߢ?È3ô/Bê¬þA‚" ò púWÏ‹ä/ò´ùÈÚþ…JÛßW)rÞÿÈx@ÇßÝþãƒä Ðù_½èrC@AŽ`¨Í¿¡‘…¹ )ÿ#âDŠ ÿ‰ÿ+„,î‚ÛýkÀ‡Ìäõiáýü¯ñZ»»¹!çÿÇ^ gÿ7þãþƒ@¼ Ö8s30k±ûšÖË**O®ÍqŒ£ôK#>®‘Bs,D¯Â„ÅZ’nNö¼ê{Ź^Esû Y×ËÜåÙSßZº:oŸ\tŠ;¶tV 3÷?L%û^P3Ì4¡¼1L“¥-vëEÑ¢‰&ìÄ–Ûöê2ø=­éþšìÉBZ¢øìyh«F{gUI¶µˆÁ÷o:ˆf«½MÁ3ò§yßœâƒ×cL#_kd2¨Š·_á$yV®ö,õÐtE¿zî´y̆ R –xXi°øöѯ¼býLb_+%é}poÙ [ÚeƉÝÆɾ=kJç3;Ë›Þï>W4D.‹¤²énù[Qà…Üp:´Æ~Éä ¸AwTùÓrù7‡çᡪÞóSÝã«¿ÜU_«˜Œö…°rª'IÜ}Øøî_ÏÜëa†Úò´*hCƒ,›mÏß&øm“cÎâOÖÐ)C>át»V=Éw‹"!-FDüüøÐô ýGÀúíþ‡EÆ?}}îÞž¶·Ë²Ì»VF;ÇÇø¬Ö.úe¾¹>â~®³Î¨Ž‘óñtZûéWéµf¦Öï+ò/÷iu–O*KžËûŸc-ä$ö§>j=¨«æµQl[ò³ƒ×ª½9ûù{Ÿe»]l±ÕK¶.Oãà#kû”ã#”gÞ—¶8$évº¡oY0^ú»ÜqMìÙ̘@738½TŽ>»§;Î:§«4±éÊZvT¿´ÄTC(w£È0[\F–l˜nÜ œ4>Þ!ŸÓ<Æ*)óØg¨ „;*`!‹¹¾G‚A¼xÓ7rÍ{Ä1>O4ù€à»a} ß  ,[þ&»,­ÝKrÐfV¹öÚ„ÎLOág—}¦Î@Tãwcƒl™N¸ä(¼ác´˜äRs–—•£Lop±ø Ü@ß(x[ WD0'(ʹ~íAÊh­Ͼ8#Æá3úø¡QL%±¾àI¡öäŠg¯$ȵÏJh“7VåºyD•%T 26}‘(±gÓÜ ~l¯ú+n’É¡Éñç2³Å™“a†È:WOpþæÚÐKÊÅ«t½Q-^ß±W$”¤Îù‘qÓ¹Šó¾Vzmí6˜aßòË}#Õ&öY":;qrDÖß­^_Ö¯HJ½"™ß¨ÓËÿ:;ÔñÌœ\Å §Í‚4áO°#[vh¨»Èɼošù‡ä‡#¶æÞ·0< ÿÒƒK²S“4}ºö. œct!ÁdÊС½ ¬ ÌÔæ{Á/JžÓH5 n¬4îË{yom BQ…&Äjá¦Îp‰/½×Øã3³†‚Ö~ œÞKÑ|qËøèá½PigÎÞ¥¬:WígzöÕ8Ò“¤žR}¿€Ÿ“½¾'ÊCПû}‘È»'Uy B Ö:¢GãÝLÿ4¡R>Õ`žC ƒ*²‘1†ÅBC‘<'²I}wŽ‡’žIËF{âß”c«úн<ˆÛHü7¹˜²²¬HéYë}äµu¬bµýví ›zrp74(~ ”Ob \eœ­Ô.ÞÛË°gYÚN„k¿¯®Áf}·-6ôªJ_Ÿ.DÎÅjç‹´Øe·Šd—EÑ„5çí¯Ð«„«wR#ä±n(Qé­-g¡‰&l4± —ÇP×KòJܯx–.c€I,•‚çxŸ'J®ê§¿b¿ªæZQ36xñÞ껀Q®É0û°=™¤Â”CM` ½Qo§ZB{Ãå›þDý×U?³ÖêáŽ×zÊÔÎwÞY=ý¾¾û_ðPôÅì(X(?݈Ÿ Ò,cc‹Ê§ùÕ’FK*eŠÒ´>¯t}7PU¬\åÁÞ¨¢O Ó»ö@ý¯@UT4ÇY!/×Õ|loœOÿê ee`-;óõ‚UªCrå/ãjo˜×Xƒ}Åák¯‚ݶt4Sïz6ç'R-¹;AÏ(h¯09è¨@¡ù&d>‹Ã6éÕįgmTØ—Ll($PÕ‰Éø'Ù˜[”V&»¾¯hÐdÅè0åzACA›»ÿ¼G™ÚMûgB=¶àÏ‚—zäVjþ@ÉAâïäÚžo5ïž‘ þŠ`¤Må|«oA¦¦%•Xß?øDC®bKWýç4ôh^2õQßèEÄ&Þæ~öY{FÃîù=áh¦“I¿“\úFŨ•Áᨦ;ÊÝyµd1‹—8`í´ç*L -iÝƬ_ÉÉœt\wH. ž›'ØÌ¢‰p¦• Õ~{bÁ{]0à Àý¸_J­Ë‰!Å/Œ…{:#3Õ»âíÈ´®ö yñ1ŸíH?øðûv'E™“ô;ÙM‚©H‚B3j‘¡¦-×|ÚLW A•ò®Ëù#2&-–©Oáí'BàÄ$mˆ‚½†ooä)ïp°^uªÚí„ ·¡ªŸOàÄéúëc¿ùÄÃB{Yðn¨D…Ïÿ|§ÞÌó€Ö-“šöú»i~Ë[ü;g·`}9Ó?CŠPÂqÄu…¼õŽ=K–­2·¢PòZPTöÉÆi,Ør^dœNY@é"ð‹ô­¿‘[“Ž‚õ ö{©ÉéIjxyÛ«ñŽfL  }mÓçµÅ'Ïš4ìœ_3?“½]Œ}?:^Çïžk þvÍí¶ŒU…F{ª`RÊ…öá¶ñûù£à’W>mi›ñn{«LE²ïqÕPQ Û¢M²d瀙åY–@%ªÜ‰^w!3¸å+œ¤³T¿Ì–dÖj2¼•bÖÝcÙš[."‡Ö͹}iEkg7Ui+œ¢—¤—- ežnÍv¾h™ì$ÆâdÒ`;MÉ› •Çvƺ WGâb-&ËÜ ;ÉøÌog£ƒÛ5Ä62È1Ç“JÚ]VZ¾~ÜD!§ôîQ`²ÆX^U\ÏŠŸ@õá¡a§ÌÊÅT¿¥åF»½(õ Ê‹ÚøÀû;ýwÌì×BT¦_Od·Ö’çÅ÷6µb˜\ÐìË;ûv=»¡Ð’ehEáó÷S¹¿¦múE½CÇðã–ûPÿ·8¦ŸÊr{¯h3€8òk›€ƒØ¾PHÏ:^Úñ7•Tí{£·~Ÿ¸}_[W…;^òÄD°“Í¿”ÃJç8üBÝD=÷¢éÎ… ÀòƒTLPǤð>IQ9Ö …måÉr!?ÆÄŠÎ&4Ë‘‰‡ÙËþV.C4PdwÛb„룿C€Ú¸ôöÁ‡OøCJ=æev_÷Ø*³š¡ØÂV“‰—Òpó'—^J÷܉aXûäša™/¢í+×Iõ[Çð9™@GÁ”: U×p›”º‚¯¦NÖ¼°jŽ­—XáÃ[+è] {áVGÑœr®§Ý,a·F$û*Y}Séènm¦ Ÿ‚>ß»ÑÀ,=’ÖZÜÀO\¤¾NUTfÛLË<Ƭ.i6Äøé6uê€ù6xd@&ŸŽuÎL}ƒb–ˆ›ôçb‚ù«òñiÍÔjÇ¥Ñ1o ê³sA…˜W>LwACÖË•O)Ù».ôŸÆ)7C“aõ¬¾-unT6vüjãKi—,û®êåÊß]´úÙQLSžµ›0æ7n8ËÁS0,±¥(]Ù’Â}Äg¾êV[$šÇJ£,ù²3¯5¼T;%VyñµöMˆ¿“aö.×zõ5™¸%ÜÊ?!7fî¶Þ$Mj‘ o¢¾Î]WŒè!ÐLRøTöÚñ0zÙÎTÉÒêÁO­paf#ëòÉ€¹>?I¥kfÝÔùÑú©CÙ½GGtÓ¹ýJ¬TzÞõâ Ídã– w \´Ý¬ŸJL™¯"´­Fʱ£®Æš”xãE«è⌂U°°Ç…àû ¤ö'Z‰‡¥&/Þ:Ü7}W0wÇS`Y#ù$!ñ_úÐÖ¿ +1EºŒ´~ÞïkTÿ!:™zí|û‰ÉZ7pŸJþ}Rn OjÔ·yéPú´†€ yìIFa1¼—oNêîOáè4yæ{U¶rÇoë^-I]íìÏú<‹µ0Knu @þåUN®Œ"~ávŸîÉ•>S²kN¿úL%Jp%+!ÂtþðGÿ>9S{£Pâùõ€Á9}06äƒØÎУÀ Ã^îpÀ…ÒBúÚ6Já²4ïFCQ¬´*Êà½+^âpSeYJ9áŒË¶m¡ÆOo³•ÓìE8Ÿ«ÓáT.÷×"Õ†ëŸb¾ççzÍA„ayŸâ‹5ÞM®b¶;ì¯ö€W½ºTì$úƒ‹#ŠÌ’ÌÜzIþø-‡*A7Y|KŒøEáèw{½&ØU¯q¦“¬Ýo½›õu^9¬¢% ßHê#©Ê¾¼ê ñk5ÒšÊ7hëeÝõYßsòõh‹ëÖ@°ç ÿÈ´&D‘Ϩ¦LµC8L-seåì Ð07`(–\ePà].ÔP>@“ÑÌc­ƒ¶©ff]¼q‘_PfàcÁHçr‰ÂU= ¨Š´Z?㧗pW8ÕÞMyź//.Vk_Õ3Øx½2§²yÅ'¥yÛ°r#Sg¦”üEC·?ʺoêWˬ1wØÒú³i¹8s9Ùüµè*R‰%·„qË´ÒlG×rV>³¥Ž UŽêN O-Íw©â Þ´‹¸æ±é'HYjèÞÓI¨.ÝK)\m©Ree±ÔrœF¸™2ña3™Ìƽf\øÛQö¿ë¿ùàŒQÏŽj™ï(½Á-OÖîëï…%°»Àñ¨¯ðŠ~::[I;ksœ‹é$Æ8ç&Eòy†U’…Ì5øÓ~ÜQÝýªj ÌX&L¹“›ê¢ Úî9˜“;N¦`MŒ›œ×ý¡[Bå|7²øy¿åñç#6¯£å¤Ý´/lÁqîy»F¬yeŠ½¼9žTëú€®f²çExëaMG¯ŠD]ÑÉúì¼U—êîÅÄïóÆBtû”5®`O‘œéÝ:nßÑUÉôXíµöÔÝl8~`vô9ãÉÀ·“åµä4TM–N¶¤è8O\¤2ì­90.å%Iëæ_û=Çe»?S6E§Â$õçL™ðЗ’g J;2+̺-„ÏtÝ\XÂj˜"Î7¾H¯cÕ¿K©F|J{BÊ8Xñ»I?³ªüF›‹‡P ¯æy=á7:¹×®I˶â:¶I¨˜ŠÀNÓÌC-ðª)jéňžÇÿúÎb«Wâ>™ð–ãu儦Èf˜Œÿ0ùSÜ5osN /‹˜®2}Œñ+o„4±Âíeç×…¥B¥B¶7å1>Æ¢$R›Äy˧Ìux÷ó=þi–-o鶲o“A@LÌPÔÎ4ðgV-À¹hP—'fc(mÐ8º…‹c Ü]ªZPšéEd«dûÈ5öDÉ÷>Á»Ö£?nA÷.Km­‚‹™ 6Ë¥¯µµûvY=¼H$O­5/^ "U_©„EÐ` *±[J}ÑQT/Á_í¼›¶]Ûsé´™_AuF»Ciìã%(lNâ((äîºýA;ÐVšuËHÖ/Mf] V†¥²ïÓ¨ ÞY•“õc}Ûù¹ò[£JÓ¤š@y5Oÿu_+Ë"U|Á©ÕÖ©|Wk-qôË#½\þŽú&Ê_r»(âxòu¶þ?¤Û¤Ê”¦:Bïß1nMÖž}‘RÆüh¦Š/Þk»;Ÿ¡s~¥¥\±d4j™ ÌIÑX@ýÙl¼Ò‚Z¦(…=Ç?[û+`«$JSûEyô£¡+Ÿ¾ƒ§­×k­š› âŒid55¢¯ÂJÎú=m ÚTg,Ìtì˜cÐüvZ´9j¦•%ºËÚDãþj–ž‡Š÷òß®9}9>º¾níZcÂê²Ka›Ã{¶¼W$åêìÇ»b)$„ê˯Ý#Gò«ÌÒp˜œUüÖýøѹA³æ¬±.t²Újœ­ÒÏÅù˜j8P54üäÛÉÔS?»rÊò&EOzá[À6gì—Ìòfü[}‰Óñj@ï5jgw" ^öãÊÿ¹­^‡‹U£p WÔÅuUÆ· ;Éi%—›e’r;+VÕŸ=C8ï2—„ø ú¤ô}Í„ £ CÆÑHRÜ_ÒüÄ hldìaa4à“ !‡žgsš±Ò3ÔyˆJÞFîsR‡«ª­*ŸðFùb÷ôÍÔ7*u¼?3óPÛÏýñw‰I!©…[„â²à}º7ûš {ØeŽûÇÄÛbƒç‰Iݵ®_¬-qÅvláeÞ hÒ xÍ/%Œ>ã÷ýØ™T0`(Ÿ™¼Š+à¸1õ>R­s’Ý\ÑÌN}1’ Ç_ä¹µ…±?âC¦KÍðõäása·2BæåàÇÝ=8Ñ s+vÚ×Áýí\çI ·öÆ{DóšÏk‹ÈÙ_º‡IdW ö3ê1¯‘]È4¥” ¼™q¡OÊߎ. _!/£ä*ú´:6ÿœîo×Äq’ÉÍÊË´}O5Ýš‰ ·1ªcG_øR)·ÈÄjNæø}Äcrp¤^l¡‡j¦ê™¹xjŠÞÝÅy&<›£pq.mxjùÊ|Ä!Pöuº¹8-…‘“놼S!~nñÝ%pÀ¸úµðþ#Ë«³;W *á¦Ŋ5tR†]ßÌx¦" ¢³0–cMw&\#gŒHÓoó2c>•l£G=™ã5Ø/ë½ÌRoåyZ;(—×R†–æEÂ"Æ…9iÉÙ³Ûy¤ž -Ì‘. Fž_u>Mª— I" H®Ç«dupá´øAGW Ò37<@¤³\ Ÿ0‚®¯Úd£´E£Î· Ñ]ø¾*mø—Ù˜—|¢>ÞñQ-ìîØæ¡ú_AÀgRÌ1­qP ‰œYƒ¬úˆN£hîä$3‡xª¾+Š¶q°Ê(ýe]sÌcÏláûñ”Ìd|2GA5GÇÆ! )oMá1Œ°Mõ«ãž´'³øšuÏ uÇÑßÊCàÅÛiJÞèÑA/¦ñϢ庙ðž2½$¼#ugrÝ58†/¼´³šU¯lÄ>`h¾ê– Gg¯‘í=è«v/±¯ªúÆIû›VÑ3$5cõßž™Eï`Û“V¼GØìÕÄ⤊1ßs>• ø¤2ß&üi<†a4Ëý=«ÿ1ê—¼K"ªHƒs¸i…ÔOb'P\è’%H™Œ·.¯ÇC¦xt¨÷ýäœvïP[±âàX# „δq«òšüLp3éf ¾[ÚcÅ(¡;×Âdô¸;HÄrØo‰ÃÊ|<&sˆ¹S¤ùÔ[~Í\}Dö’êS®:…Í‘zú:öùft=þ±u_ý¹Z€8|¿Í\ö6qM!Ú†ü§¢¬J1êÞAps7¢þ®¼¬9œYG°s¯ŽÙ=MÅÔüÅÄbïë†cB_N¿¢T;ÆGw?¿'ѺȠ¥–«¶]]®@1¼Ñí<¡1è¾$*qaŸÈÚ³XæûRjö.eº¢ŸúM©Õ/€› ×Éȹ{|âI,n“ᇥÓ-ÔY a‡í´ÆVöÅæò\/‚VƒsžÇRn³•F ´ÞÐ¥¯^bTÖ®õ½Äuþ1dc¶ÿ†ñ š‡·ÿå‡Ñ[4ÔÕ÷}††SÐíg‰§RA]?CºN-17–,Ñ€ó}´søZfY“ƒûa¯ÌÔVÆî ñ*f?ÒÄ åRFòhT”  êA§4=‚j-%¾z«hVE%†þàñnÿQÇbn!º9Ž·]È€ˆÚÂÍà¿é`[ɨ„ãþÍÞ³¢Ù°Û¹ƒœ£º[:&UK™ãMÏP*,gg‚¨DLsû¸—"¨Aò²øɺŠ-Ö·‹ïq}q7æé7ÍÇŽ57& ÐNZ¥Ý&¯Z+TvѦù*FmÌK{ñ§"7 Á¤ûËÓóY®2Ôaõ™ >ŒöÓ„kÍc©Œ`9Ail ©m¼ˆ“¡n¥¹­U¯/]ÖÕ7ßN X£Â¡ ¿ê—2Ž7&AZ¥>,Åæù˜W»oøŽi(#,±Ù2ŸJ³Œ5ú ú-N¯$ʪŽÀF·¾eTNÖ+ /l†½ÉóíÿÍ…ŸPðT¯ÈSR;:a}ÔÑ1¡[‰V<«™ZyÁ±˜dG}l ½¹"  Y%¾%ñ%$5R‰Ã·M³ËŸqŽbFft5b‘®6ðçB[&…ëƒúk„¶&:óñæaMXÞFìϘú)HF¿ßù 0ÚÒLÒÇm£ë&Ó%ž¶™FnŽ:k}êÞ$³ËDp´ª¹7-Y=~qTHú„ß2Rr4âÝû4•é’I—ë™ED<¤Óè<”$µÆ±K3&¯È9¶VÁÙ3‚Šq–8å‘A¬@ð’`ã~PòÒ­èô~š³j(Åu(‚ÒÌ"H°ï“ñר’ølÖÖÌïÓ-ô)Lf»Šß8é8Q¿ìVúP&‡À5€ Á¼Û½Ye`ð*דõÅyöºÎ²_²p¾´÷wæZ†T©cºêÊé/›Ãœ{·Ø£y‘=^ÆÃ>áw8L¥o¹}ø%O¶jà$åX)’X3¯ßÚñqŸSäÜ^tâë:¸½NR_’5:uÏ=þ Ôª êà ’4 Í> endobj 137 0 obj << /Length1 1530 /Length2 7849 /Length3 0 /Length 8870 /Filter /FlateDecode >> stream xÚ·TÚ6L ’Ò C7ÌÐ%HJwJÇC 54HÒ!H7ÒÝÝ! Š4(Hw‹4ߨçÜsîýÿµ¾oÍZ3ûykïg¿Ï»×zjU vq 3°ŒÆâ $•”äø@ 7È…AO¯ Ùÿ2cÐkƒ] P¡H:ƒMap›”) §äÈ»Ú@ÜŸˆ_p‚:8 ¤LÝ %€¼ì‚A/éàèé ±²†Á·ù{ `2g€ùÙ~§ÄíÁÎsS(@Éf ¶‡ïhnjÐp0‡€ažÿU‚IÄsâätwwç0µwápp¶ef¸C`Öu° ØÙ løE ljþÃŒƒ i qùc×p°„¹›:ƒpƒÄ ug¸B-ÀÎøæ 9E€Š#ú'XñO௻€8@ÿ)÷Wö¯BèïdSss{GS¨'j°„Ø*2Š0Àjñ+ÐÔÎÅžoêf ±35ƒü>¹)@F\ ` 'ø=sgˆ#Ì…Ãb÷‹"ç¯2ð[–†ZH:ØÛƒ¡0Œ_ç“‚8ƒÍá×îÉù§³¶Pw¨÷_Àµ°üEÂÂÕ‘S qrËIý7aüc³ü@~n.Ø ö0·æüU^ÓÓüÛ úe†3ðõvtpXÂI€}!–`ø†·‹©svûzÿÛñßX@Ìa3°ŠñOu¸lùÛï ñèáÚ€¿>ÿYÂåeáµóü'üw9_j*IiȲþaüŸ„„ƒÀ›`çâ@ ~€¾ðýï*ÿáÿ7÷ßVUSÈ_gþSPjéÿp€_Þß<Üþ’Ó_#à øï-”àZ˜þ‘¾hÿý?Àï”ÿ?Ýÿªò“þÿHÆÕÎî·›é·ÿÿã6µ‡Øyþ—²+ >Jðá€þo¨øÏ(+- ®öÿ땃™ÂÇCj—8;ˆ‡ÈóÇq‘x€-T!0së?Bú»ð=ì P°ªƒ ä׋ÏÿÇŸ:s[ø«âïØ—© |a¿›û ƒáCöß熚;XüšF.^>€©³³©'\pÄ ðÁÇÖìñ[ïN¨ ž€söX:8cüj3¯ €>Òö¦¿Ì¿- ¸"9Áÿ‚¼NÈ¿ <Áþ— 'ô_ Àéø/ÏuùrÁƒ=þáyþ†ÿEÉÜÕÙÎù·á|ÿÆ¿_0ØlŽ1?ã`.dSÔvY%Nîξ1.‚z”|©ËÅ>žg„ë—ž4þ§‘‘¾ P"3ß’1²éT–pºÌü6{æ½^KUçÉsÁN%³mEe;óp8ïý“‚f· !G'Qâ™P¡s?‚*eÄ“®ÇbVýô¸>Œ5½sñî „E2üòÁmÊ]UEéŠÄ‚Úû«ê°f³AÍ ÞsRƬUû˜7k‘aIÊ©4 "Wqî•OV†—ðú(»#äÝ7ŽéÞÂð¤…)¤xÐ*µ—rqn³ ÝöRñ½Í^HÈ2ëO2ÇÅn¤õëì¡ø…TÛoFmº~îñ·Ù+¹MÿTGɇë˜n¢6úqã°¶ú,`Iþœêa˜9àQ[L÷ñ‹Ìgûy§²m@ŠJ»¾R€Ö*Åsk(Hè<õñ,•—W4uÙìp%ÆÆh3åbþ>ßÒÃ.µÅ{ý’×½Vñ_«&¯òÓ¬ö^ÝkZˆÕù²†IÜÚ~)¤õÿ,9b<Ê*ž«¤4×’'ðÈ8Š°™SPP5C½‘ ÓîÄòC5û¹…a Îã²»åri­~ò»>ãÏ$¯-¿Reì±\Ûü$,¿z‡öÚ¤…ÉöË‹m&ôÔX=Ù†íâúÐïbÑ.—©¹¢¼,ÁÚo?'’ÔßÓ÷äEbNׇ1–ão ;ej=žRü!ñŽ>¸ -r¢cGtÔ.Ìö1OQ¤OÕ@<õ7üYåÛ±«L  $ħ¿x»[—ŸJU=OˆñKÁ>‘ÈrOXÜóÄN³œïeÛ_‘«ÍBð4݈ý•¬µaìÕ]¨R¯ÅC•»¥Ã›õúWµÆ) *¹õ_._:hǧ‡Ì x™dŠ ¼m{K ±B2pìÍd3Á¡ ®ù£ó–ˆÖõíaBsÏÚû‚$¨úøôÌûÐ>EpƒÇ^çôVÖ=zPÎ*òv.åÌ¥&{â€÷ê=.çÝQG®JËB,¤Ÿ¹SL8…•E¼f<ÁÂ\-¾t'$¤=xÈ’DNÄDF_L¦Qµë<ŒÙ—Q–“ úò¢¢¯ƒ?[ò NÛ6¡à~‘®ŽÒù¾°‡TØ÷Ø?‡^ASNu>Ø„á‰U™K,–}ÏNþÑr„LzÌ£ìMÚöÆÃîñ^EÁ‡ãi¼lýX ‡ÍÏ`YJÉÝqŽ¨Õ!Ãý¼{UÁQhð”Ï[^IræÜȤÀü€ëÓбY¾7ßsÂ.‰PQ¤þ¢ÉÑ3§2ú“×k"ååc<&Ãâ½ã9v• êsÊf3Hȶë{eïX‰»éÙ âß&µ^hgL:ãDçè°X @‹aéÓåß7Ÿ’JÙƒV(‘ÓÚ÷œïI‹žC±«ËS Ÿ8ðŠ•ZÚÑ*é¢å5RŠc•­s¿ßVb´˜HEJºÔ•d ã¤#ˆ¡¢:¶%mÇš”áï£'ßèZ üÒéÇ_Ø2´2ÕX툳ñ"ç{iì“u*º0:¬ôuçΚv+Iò8Mm2”º¾ýGþˆ¦“\‡$Kµÿó%ÕHóÓFb>Ò`í¼M¾J·ö@‘=Ê]€xƒ±RîqôTž’[U%Q%S‚Û(ã㮎™Ó+/ŽÇW$O-âyQqÂe$³†¦0 j %¢Þv…Yäê:õ™+ƒÜ'ì‚{Äi”Áňj¸îÍ¡Šô6•"ß-‘'íaOÙ’g…)Ž%UŸ¼â~à ã–{•¢E€<})¶ÿrÉ‚Ä y©‹ÂlÊ9Ä¿æºÎ(Š \ð² ¨´ÏJ{¿SŽß³>uºËZjï²)T²„LÕÒ"An¦àhŽ ÷Y7j#òBkßô¹Éš.ë}ŒÅðL(äM÷ï3( @ FŒ‡ïªŠ¢×ÛH){ŸôÙS)Ïk”£ 5é ŠôN …ã 9\Ç „Ï(%gß@%~p·óÁZs"¾˜¬4ÞÚ²ˆi˜=oBŠ#Î]ÍßÆ#Ïo½·ecÈŧú20<‰µUçn,ÙˆJ¦#4¹©÷:ŒÞ€À(q{ñäíÂF:¨ö ßÑYÅ¥à¨zÕ±ôýi7'WLBñÆÙf¯–åM©*B^"r#¢›‹1¹æ@¤—Ù©[ à!RôÞº•7&‰•³É¤!áBù”çí‹^|Èá¼ï7#‹ÑÇJ>5Šœ!Ùbgͪã ´Æo›ÊÛÕ`oþ¦@ûçÚÚI 0±bÍÖçü–Þ¶¸,¢)À¼3–XŠXyá"š=ß}QôÚœ"b}øjŽ¶Õ,%âڱڙ̊;Èæ™rÒ3ÆB‘NáDÍŒ…Õ¾xò7™ìŸu `w~32Ô‘Á bGrõ¹¨>ú²²«bRÝüØÙW\”Ù|öyÕRûkôϼžC§<]¿ÎØ*æÚO'¬hVì(#ó¤#óÕ,aöß}™â´pbuLèõ½Ó2šÅ`íÊ—&cO:AßQ^J9º%ô|pÛJZ)b¡ÚõA-ÎQ;€Ø‘__ÐiOÍAîðî¶^;%F‰Ëд/æ ÐÍ„@U~ûÝÿΧÚržsU&ƹä ý=®º¶Ûí;£ó3”ãŠÇˆ£>}Åìïç<^Ü!—âFe ù‰1¢mEXuzÍÛÕŇ\ï²eo×Ò6¤6‹7HÊ”§$êÙgaä (˜s™i‰=%·¤6¤˜›•ÇËžü"ùäå]•+iËδqô¤§dL[…ŽË<ñvoÕ*CXM€œ&9žÌ˜¿üAxä w;Š½L§=aKORó¸o‰ø ÑÍŽö‚‘ï$ 3¢Và2>[v¹C°=Ô¦ä{óö¿øïšXÆÖ]ËÖÕˆ'Q¶§I!mKï(B†$ë«íç+¦[F`ûQr}Ò>VÌQ•›^¨ƒ­ Ãð÷E-a/לóí˜ßŽ!߈Eš)ùCˆ®mֻŋG&ì.:kuïLvP &#?ÞS¯ÊÔMN±¬hš±œî[*dbF¨­L¡Q‹Z¡7ûü‚´ß‰5ÎHµ‘OüÓº+UIŸï JªÐK&T›7 ²,ò¾¦4&ê SÆYõ0œ¡þ–—çéè{ÞJËTR,5êl—ëôì¥÷xê3ßfüŒ'rU½úÕFm7–QœM)1kÃF[Ä»?±k ìb²¢Êaü´†ë{¹%øÊ âÚRª6°µzñª<Íy)ÓãÐÔqtì Ré™æà có Tõè'i\nÊøíd¾¥iQ16­{úlK#|¸ ˜ç&¿¥¬Ö“qÈ6é1ttÁÇK o;ÚðZ”ÂîàC ÉûR6”¼¿òþR—wMËž»£ÊHôç–à௾)Ÿ(Õ´°òÖ‰qb5O {æ%|¸ëû ~ê%£˜ìIÿþ|+RñèʪBy!£5ŸäŠJJ„RЮ@zA»ÛQzu>cÜ)DŠóÒ¨šuU_`°mømq¸5sõ®ÈÓ ƒ’²Mƒ q ‰n-÷ôä Ij»á«Œ€Í~ÕhwOy£èÚ§£ˆdÑ¥†€zžÖÌLÃ[Â'ú‰EÉÍUŸo§ð¶<Ù¤WN®V¦µoú? Êû…áŒýì?C»^Wa_b…0Ø=‚=ƒÀbèæjÆ“æO±…únžÔˆ¬\ëO¬ÓyRd-³F03Å¡z8~¬ìôÝ-}žm‡•‡eÃÒâc Úhžp‚8•âËgðGÜ[~\a€‡(ùY-P(t¨^çþ0câ››77·É½Æ0\lמ¶~ΞÈtk<`TI%dâ=&Vð Ñ©uƒ6‹ÆÓ‚øhcéübêþñ¼ lŸ“×éû(ɼÀ¿ÍâXª3Lr£Ký’×MaSú¢ýúºi몹®ZØ)7î.ú&,öV…ž_Ç+þ,éÀæuuÏ‘–•žS[ÐÆÁVL´F7EbÝò±Î¡ˆåôD¥mô@4_W!Zñˆ‹¦_T°’.,ƒRèëq¹ðšß£€I¬-†4/¶LU7"©„]žTÀìµH‰k]‡ÂùÙ>Íó[DVn’»Ö£9<Ž=žO?ILÒÉ6ßKzŽþ¶úèiøÔeÙ"w²7ÝVË뛢ÈÆ4íØÛ£ñ†çOícOhÖü\dCÝ:Žüü|¬§¨4_2ƒØ(wÕûfsEfÕªæ¤É[oøÊ®<ãÆé¾ìØÿÖûÇñøžÉD«okZ2w=•LwM/7Ó ›ùY<¹Íx©XÖ‡ç¦Ç/–ÞÖY|–¦ðM‹R ScQg¡›2/»í^˜ÇÆë‘ ™ÃbíKó?8Sýõ"æ+Ä,¯ö©Sk„¥­'L±bßÌE·7lœ'Kt2Èý,–+¥¨w€žH1â›Ïõ3';÷ü¬·Âħ®ìlôcŸ²P‰íÈiÔ˜Øê.º¨ËÊò? ¤/>Æú“Mi>Sú0”IIˆµ œ9l”úZ]UêGc}~Ët>º¤ûó vi]5÷Ú»„—Æ® ªÏt6?Âè¥Ô“&v€~eÛotQÂ÷¡„ºGÌLI‹‰]Ö xǤ±| î ×Å®É( Lz¿ùȶ,ßsZªr­^WvÕ˜ßV,Àû$tJCz*„Ó‘ 0ÉÛydƒ¨Í½–Ó gBëJÛ®h²Ô¨‚X(^"z ·}Pæ!9h(V#>&m±5WqºŒ¤  /d`–[Ø{W–™aÏô¼HŸ‡Ç©ÑÏéÕ3×á  ª1ç»ùÂ=±×øæƒà†ö<á‘u€Êñé¹Í¬ðÄ03>&åè_ mÈù÷§ô,ô¼¥„Ø86¶ü"ŠF´ã,/‚Í9„óº?6…cR˜^qFT:ÒnùÙe?,>fq¥!Uµ¾âKf[¿- #äëÿ–¯&jcy®ŽWøã©f÷¡âÖAáNÁ”7º U?R¡M S÷fqiÔ&l(Hê͇Ÿc"Æ‹^OCÍ]VcBRï™i2>T m\Äûpß—¨qØø×mþyÞÊeð.¢i)âqÍE!ª‹*(zŠ‰xFŽ5àŠ¼²G[“u/<ÙxÆhYXÚTõ¸—¬f¤T ú_x®ZÍiŠ–ž_Ò]ê—'âëÆ{Kv`DÇb nw€êïûÜÙ–I›oé)÷;D!4C<ôÞ’{ÞHgVý%ª¤Ía|Í%c$Ye-™ä¹ø“‰Ð¾¾Ð„% rŠ"+§]3þšÚÈ~¹S‡.á,FÍQšûùç1#=÷¾Ûã5)CÒ´Þ×/^3½§¹5y§•AÄÛª@ƒ8É+¥y†IJv}êLýÖN†ÍæX¤ÒO—TÍÒCr­-AWó,þ‹ÂP«ÓHÓüýç}hΓx òÝŽ¦NÓS‹Î>£‰}':42Ü–&k2ýþèädþôkâ¦hz½Üíyÿïù{žXg*·þÚHã§f“¥ ƒydCAß7!¨'~˜o¹.ˆ§Jc5Å Ê?ä·_a=ËBz‰)&¢©‰¾Åzõ&´KCigµÓôðòJ Ÿ¢ŸÆ6ÅJRq*ãËÜ MÑD|v̳ ;BÚôÝ\4Aâx %›vÝ€.¿]îÉò…ªÁ‹=¨4Y‹Ÿ‰æžK‘~}ÁØBÖ' ôåÊåé$°Í*‡Ôö¾k!6&—ŠZи)YÖ¹¹F²mQÝ•ƒ¾áM÷ñžo\}@ï;T¡½à#–bÂzO ö^§ïaòÞÁ£ûb)C6xfÛÚJ’‘´Ð’½®?Å‚CÁ†aò>_½õúeå›Ø°«ö§/ìûk]ÁúU½8a ?ÝJ«ÐÇÙ[ÛE¶j²“ÊÚmûjב¦šÃfˆJMåò¾Ž”Ž~OZ÷XY)òI ;ë6×/gR ¾Zžñ/&ɇ^‰Î¤Š’#½}…}3b*›|4W]?ýÂk%ÍiŠëÓÜUudbçT’ ·öOÛn.ö‹á†r^,Iê¯3³Ë\ؼÑDîê·¥÷$Ý 7•l•ô¼»ôû4Û/åÇ«cíw°uR¼®º™Ó*é´Ä¼Žg­guÛ°½¿Ô"¼3Te?°mnÉÃËLÏÔ8<˜p¤ñîà–}„†©¡ŒÝ¬¦æšUub†©î„àõ‰³™ p©4TL‹òÒÃÕö¥”^ÛáÌ‘ÿ~Ásöà0Òªç15û.ŸJ8ßY®ºa|û5†52{‚ ³©)¾»{B¬ó,nsšáñ N‰`Ô6¤Þ)% 2z3?+ÈÌ7í®{Ghä–ÑÓòŒ‡öÓ>-uô(„ñê¨Ev¬¡ïD#T@ÜòÙDghβ8Eh’œÚ97z„Ëù¨®Âk‡u-(D˜£ú¢˜2ßw¬G‡î±ØL´Kb9]°Ò+Ê06ô®ÙÂG÷ºÞ+þ0÷jwÓCª£åôÉÇ´¹Oz5Ì_ÆËd*ø™|׫ˆâ$¸[Ý,Úšøµâ»¾Rd%¨Q&€ßLÓ’P5åÆÒb{í£ŒÊÑX6ÊîxÒ‰¾¼—%Æ\YrbèªÉ2o4ÝøÂú…ª´Ùú˜ÚSº+YÂ3_JµI•;y†âVÿcÞïîR’ÿË-×1iCö-_p˜q÷qW?Üx“.âÍãé4âì'8}ÔÃ&´šè/ëÂ_}Vð±X™t:C ë’•«Íi=˜´ zHŠ GÞM‹ð|VYÃJvÀ…{¨ Øz~[OÃ1­á´…Y«ÆÖß³+U s~æ_ÐqÝ¿Ó¯T ÞQ¼è9€vá¾`IëM”˜À1. ü÷¥“ lÍ/2å˜H ×‹º1®(â«JŸH‘>*Î=Q¥*bFRvF'¯ÁÈE˜ä-lóºFZç7\óÁ ½’5&L/_Ç­¼ˆ•¸yRB)7N—Íž’—òˆ`dâØ:Ä#IÌxÈ«ÞuQ¬m¹b£ndŒüò“Î…l‰•Ç—t;GeîÖ) –PìQ…Ž1¹g?)ž:á’xsÌ;_-eg¡[µž¢æé‹‚Î8o¯Wèz90ºI#¢«ÛEŽÑÿ!yy›œÅñdENÜÀV‡+êØäÏ¢4¿o«ZEó1?&5Ø=ÄXP5Ú*/ñ^éGõ6Ù9rÜekÜID5~܉Á8Û –ϸæÆJµ‚ÅÉ;®£TéÝÑÊ«Ãؼ4ÊÙS¾Þ²ŒHúÑ¢Cj¨£ÛŒßR+$v$ìÕK9ßô;ëaî ·ˆ çäc¾ïá4qÛTÖZž7¤½:$í[÷|ÎQ.îw%$[~¸©=z3Ròx-ð‡…r!Œ¨~?uɈÕó5.»;,sôuÞ‘o;´÷:? Š ‘ÙFQøœF(â'Ï㜌ÓÌ Ü|îs}Ìåw­–ÁI™»À—ÎÁßü%YÇ(æÇ̯EöœÕž#XNؽ%ÔªÆ×$£ý&IF–¶ãz0sÀ8*#E¢3ƒ¶îy…Ý(Äê ±xg¹ 4¿:˜€HI -%Éþó¬‚??]Nø&còX¦é8ÓÞø¨w]!’ª!s È¤êHK¥ 7”È홋ZC¢xšnÍÓµÌÌüî'üô7ƒãˆè›úÜ—Æë¾õÎV+¾ @¯ãôŠúÙn‰¸L×Ö1·Y{‚‹ïr¤Ó# ’-øLdeƒÃg´<,„öÃ2öc y“öÛó7‡oèV–é/n?íB{¹{·b#v;ˆ¥4Txõ2Ãös¡è\Þ4.Ú˜½´Ë”>è¹1Êe¥*™pj8†×¨8*¥ÝãÆNb§ªµï. ƒ‚.Ø}˜†¯žÝ™Èü„ÿمͯ}aÂ*+Æ9•¸fÈ­êà©÷©Q¬ÔÙmü2i!U´FÝ€ÈeQl[FšðêµæE6}Bs[æ0GgOI‘ÏVOYfô0êYõ„•á9:i¡àº:c$?üû?Mû•{’sùèFO¡¿ë\$ÕÇ~EKÌĬ!ÖÚ™Lœ‹¯ˆÐ»°[šyMç þF«Þ…E¬„¦‡¨ ¸L¯×̺¡Š/›À;TfýZ¹ºöˆÃÇÄ`~ë%íÂQ›òM wéÜ÷íÜdV¼d4ó‹öøŽ˜M 5Á»ªiÓ2ÛÎëÉØrâU Óí ¬¶h=Ù~4"¾K7!«¨§WfqMApqdIÈÛâÚ1R¿­IÏ {#°²ß¢ìb÷¡YSüÑWÊl§÷!À¹1²Ÿ¥ä_­Þþ(Þl1Z¶‰aÁ(É© U]Î*p@V³îÒLî~ØQ« DÉkÿjwXè$"1~„h17Ti0u)„Né%>2z’ŒˆˆÐ»ruô~E£l— 'æ"?(mêtk½I]„Ù/ÈnËK‹U.åBÍÊc¤`ú"?7¤çúó²ÙNëI‘z³«CRüȹ¯î3ÝXi¬ÉñqþkšÄÔPb †d5J¢†ŽL‘SŒŸWÈw’?IJÚ.nÙ†=¥ú†¯2A’UXª"ÙŸ4g¾RXÐZïd̼¥Íˆ$šf¥Ãî‘’£—è}¦1ô,j½&Zä­ƒ?}¢’ U÷½ÿ8dw[”ãÍ›‘²™zàkoÍzh³mª#\™Ð«muq…uv-h4ÆÝ!Ÿ©mT6¬*K‹Ü='9™ îž»!¬åžygþÐäöÄ›d~R9™»’×\ÛÑÞ}œ¤¹i‹z¢þL×”Rê†`¿ÐSÙ©”‹M“#¥ŸåÒ Á„±¿SˆbŽ{þøq?’ãœûÑAÜûÈÜ=êÍroéNÄ…+3ê¦9{€ƒd…W¸æÇ& ‰a‹üöà>¨§Ìfï—æ~rm 33ƒŠãqlÂקºõ’›Š£ê»PµÉ·¤ñ_€/£°’É­Ö‡±è,(¼Ú*ÀÉdj¾°ìnlŽe/{<ô%½îMšÁ»Iÿ” †Üä言 ÙÉ>NÖÏÁ’ dæÿX>í endstream endobj 138 0 obj << /Type /FontDescriptor /FontName /GTMDSH+CMMI7 /Flags 4 /FontBBox [-1 -250 1171 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 81 /XHeight 431 /CharSet (/comma/e/i/m/n/p/s/x/y) /FontFile 137 0 R >> endobj 139 0 obj << /Length1 2668 /Length2 23263 /Length3 0 /Length 24772 /Filter /FlateDecode >> stream xÚŒ÷T” Û Ó"%Ý1 ÝÝÝRÒ9„ÀÐÝ-%Ò ÝRÒÝHwwwç÷ÞïÖýýÿZç,Ö‚¹î¸î~ž‚TY•AÄÔÖ(i rb`adæˆ)¼ca03³123³"PP¨Y:Yÿ#Ph-mA¼ˆ9œÀ2q#'°‚- ël `a°pò²pñ23X™™yþghëÀ 7r±4(0dmA@G 1[;wKs 'p˜ÿ}P›ÐXxx¸èÿrˆØ,MŒ@#'   8¢‰‘5@ÕÖÄèäþ j~ '';^&&WWWF#GF[sAz€«¥“àÐèà4ü* hdü»2F €š…¥ãßrU[3'W# ,°¶4‚ÁÎ S  *#P²‚þ6–ÿÛ€ðOo,Œ,ÿÒýãý‹Èô—³‘‰‰­ÈÝd0³´”$åÜœèF Ó_†FÖŽ¶`##Kk#c°Á_™$ETFàÿ)ÏÑÄÁÒÎÉ‘ÑÑÒúW‰L¿hÀ]–™ŠÙÚØANŽ¿ò·tš€ÛîÎô÷d­@¶® Ï€™%ÈÔìW¦ÎvLê K{g Œø?&`Âo™9Ð ÀÁÌÌÌÅÃÚ€n&L¿èÕÜí€)Y~‰Áx{ÚÙÚÌÀE½-Í€à?žŽF.@€“ƒ3ÐÛóOÅ ÀÔÒÄ ` 4·!üf‹fcðð,Ý:ÌàÝc0ÿúù÷“x½LmAÖî¿Íÿš/“˜¬’â{Eº¿+þW'*jëðd`g0°r0X~-øƒ÷iþmÀÿŠÿKªldùOr0Ê€Ìl<×nÞÿêpùg-¨ÿ9À#(Ú‚w þ½úºÌÌ&à_,ÿŸà/—ÿ{ÿ‹åÿmõÿoB’ÎÖÖ©©ÿÒÿÿ¨l,­Ýÿ1¯²³ø,lÁÇú¿¦šÀ¿OYhjélóµ2NFàó™[ÿÛFKGIK7 ©²¥“‰Åß;ô¿)€é­-A@e[GË_x`ÿG>8+ðÅ<«¿T@ð=ý7¤ÈÄÖô×á±rpŒŒÜÀ£#€' øBMn­6€‰dëv€Ëó˜Ù: üš('€Iä—èoÄ `ý¸À›öq˜ÄÿE,`´v2ú­æ0Iü‹¸˜L’¿ØZê7b0IÿFl&™ßˆÀ$û““ûÀÉÉÿFàä~#prŠ¿8¥78åßýÝoŽ®ú£«ýFàèê¿8ºÆoŽ®ù£¿ÿÀѵþE<`Ëß]bëŒLÀûõ[ö5þÀ2v02±‚_QfN¿ålÿÊÿ>¨`B“˜ÌÄÖ¼Lÿ“°³ÿ’ØØü‘x˘Lÿ€à¿Ó/ð?8éíÁ—ùÛÜC³ßl`ödÿ-ã_Æ¿!Û/èò;"Ë/ÁorŽ_æ¶ÎD˜ÿÁü¿ëÉÂÝÎúÃ,û#>3¸¤@ð@¬þ€à–ýY¸Ÿ6”îÕof°+|–ÿ ØÀ‘@Î6Æ¿ž‡ædð«%¶¿ssÚþáÅò«%v¿ÕàvàW3è?ggùGúßy³ƒ‹±?6mOÜ;kgÇ?øÁûßI‚ÃÛ;Û‚Ÿiÿabù5¨?ÚÌ®å7ØÉhcùßmâøetù£Ù`GðûëßdÀ-r´6r´øƒœòï°àW““…ðv°þ2°´6ýc Á-qrµýƒLëüÍåNÖõ>°·ÛÑýn¾Çï|ÁL@‡¿CýçÉjâìî¾Ó_ï>ðc÷ø¯ï7@ ÐanÚÖ„/èCUPóí7W†­ Š-Í/4 žs-Î÷(¯i*ÒV®E:Q7$¨¯„çIž<j^…6Æ«4=x=ľÛjB˜Åîý™{ RÝCôšAMxÛëÉÞKÃß º²M–"ËÞ™Eù+Æ­k·”[uOñÂPÈô–Êv§âcñ8C”z¤®Á$E¶qú.œ<-ú©Û›É«ë ôÌŸ/$²±tÞ‡QlyžÚ«¬Ÿî¦<–JÕXÛñÈñ´q‰ ¯Ð‡Æ(=Ew“dqf< ó{gÝøóH2‘é?/2 2VX¾‹ÕuUº ͵²lf%‚¨z16ã+‹ê0 È”°*š "0œ*Ù¬€D»­f¢KÍ×f>ÎóŒW¿&‘µ,üê;<jì—{nB>7ÞÔ ntxkõš»²ÐJXè„/.ð¦}†-v†j×Ê`¢ÒÏ»$r?Âó{œ‰Þ㳬ç23ksÃvAsdy}ò.«=Ul]D›±vE× | äT|1nû|zš‹gÁ&a˜B*Ñ–½M¥ÂW¬ ,f:]-Ãf/r'‘[ç˜=ë#Ïc—‘êÚš)× pÿpÇ“Ãx¬Q¦ÞÑ£BºyÁ0¼[ëß/ÜÍsmº»~]R"ªµg«qwZæúQtàÓšWPvXë;¿ÌvG¥d)‘¨ü›©®×ÆoÔD]Hmê¢ßhª Üo ·ç?ºÒˈSPåÍ)ôÈíñ‡zÍéÍŠçuá}óÆ»ªóc­jQº¥†@JC]úD‘¶½ýÖ e Nãì_”@Uíöë[Uˆ®™ñá ÒcäžÖeºìÝõ>ŽÈdhëXJÒ™ ¿”‹êÈðg³ðúeuW‘šyÂÊÔÉ^àÊaÿŒèÛW-l̘‚#‡Ò€Ü"ª´eù<:Ì—éøŒëéÂ÷$Ñõ厺U˘WüÁ%ºíZä+âBÕ÷_n?r&fŽ»Ie«€úJRÂñ6-+(¦2HgÆäY!p*u2RÐ.7ò|iH#Í‚ßÀ›ì¢EÀClðOQaöWE'½ÃPf“È& bà­D£B[}A‘}SÁ;×]%&;!ëT AÙåÉÃY‰ðÖ_c´k´ý`jZzŠ þ"‚©hErÆÜ•L’#!ÚõLõ#¹WÅ‹¿­ ÿÈÎÈgDÄ1CŸïüéÄ,ÌE^ðÉ/üM{6'5uw³i˧ËYA+e{~ðµµß¾¥ à ]p%`# eÁê$¶^p»)ó³³L]8ý¼•†˜ƒÌÇ™ÜPïí ç̲Çö¢.k™‚]#íTV56á}íŽK<ýìcBL¡»bâ§ÛظͮÄîBª“jp#ÓøõÛIuÅ#Vï¶I>ó Qɹ‚ìB¦séP´‹'ç n´îmÊ!Ó~ …Œ Oà:!]m\KŽqQw€¦ƒGjPÎÓ裘¶¨TF 1‘û5J¸UH«ó„ÆçrNerr뇽ûÒz†xœUv܃Iàð@Äm><žÜÐ %+…y‚q…Gèì^2½³­B)k7®Ç²s\rVè$'mJm>rO'rÉØ OÛHáŠPwŽ\¶ îŸ7kº§æ™Ne”BEŸ~v_>€àÔ\[ⷛɳLuÅêSsGæ•®§ çi²º‘ìrÛ“Ê›Ž—oØøl²h0Eö‹ W^Þ‘2ÇuheÛzÜ‘ÝÞôùQt—µ `¹®-¯±êÙw­Ê ž„d,~¼qÞ͵9–„Ãá­eAŸM2…/êwç¼ hŸ_I"áʃ8TÏ])‹&¾UdHyÜòìã ôSÅmR=5ËûĹàä:v=v^K“dTtq‹r:ãn‹<̘ŸÛ-L>®ÎÈ{h8}—*YÈjÊ/W.YwÀAú8»çyü@_‹øûúxg쳘 HC:kO|ø ÊÍtŒ°'¾ôŠ²‘˘žú0–Á·ÌaÌ^íbÚâ;(ôŠhº>c;¿>Ï¥â¡×þe*lØ»|³ÙÍÃ'PÑË••2V-雹¹K¦‰»B‚Í3tV…É$Wïå$oÕ²¾Ä¶jø²¦¶6/ïHŸ7/‹Z"­ß-žJšú¡»ötgĮ‚ómÈP³n¯‘W_0”ˆsÔ·:úêhú)„âÛÿª,g'—wšP>ÃOïÚi±bxÞ×â@EñÖ).ryËgÊx‘Ys‚55§;d¨ìëhI¥Ús~¹×[ÊùJŸDDp]Bâ}—Ç­¿RîÔÞjmÍÔPÍ@hÎnR¶eö—<ãa¥0Y¾¶œw~mœß)†ÀÝ×í!"7•É‰àÎx®“åÖ°¾äÄ"â\VœŽd'ò“Q‡=Gu–ÕØ5ÎàT”{¬Äǵ ªZBì!K&%öÙ,á£ã²ÓÍuuÃC×Z—BÐ_â(^ÜÇB'Ì4XlH’ª½Y;Ýó£&A²®Ã;f1\ävf¼p¦;Þ˜#»¿ä;¥÷õ¨£@°mªXÉrƒîgþâ€6݇®É"éöóxr÷ó ÀüÙ&6ªÖMÃýªvm,Lï­‡îç;—óät¢ØäëÙžBFQž0r,P½–X™Ë}·S±©ðÛ›BnˆQ+ÅÐɹoY|9íû“ñÖþ’÷Ôpˆ³‘Šáù|«ky¦Ï¥Gqe¨+´Íáü½ùÙ‰=AÅÐŽíù<üµRÑÈb†Á{_-V[º)°TâG$ól•[º×ÇÐ}É‹cZÈÆØØšo”yfxµ£yB!© 7ʈ‘æ5ïxòû'®úêH„áÌ‘Òô‰4—‚)YÙ]Ñ‹¬=·É'Y5O0ª\—‚{•xŒ_r¶È”ò31‡5»h%Ñõ–˜ò Ý‹#U*_HÐUIì$¤-^´TÃ>‹ÚÕW\›ä(憨R¨U+6ÊqEWÀÓ½Kž>ÔqÈK}ì׺êÁ8Ò²z7WÎ"åEÜÌj…*ß_"ŒHBªK|=¼xŽ< lŸz#IUU+©­"<òFfnÕ‰"gó%)­]§†«›²õ1Ëb”ŽT‰·§E5¹`Ôù]­ëŒê½ƒïäJ2È”-+ŸO$ŒPµ“õc4¡¬V‘ÈSN²veáTß*Õx¹´ïƒ}d(_‘£¿`”«ž ÙÐãùøÝeýD~e±qû+{ü%Ër_ ‘—cÇDÌÎÞ‹sö 4mr“@ÑÍ ãÕ©m*¦±°g¬û4"<©˜I„'Ž <£¦¯ö÷Ãâmf⪱]°¹£òSr†1Ý늑ÉTJy~»6ôú7ÖH^ >©5Ü»÷ŒÝIßéÌFú<Ü ]IÖ ªD=ÊC3C.Y…\&›áá ö/š¯fB»ÞCårãMåÚ $-„⚻Α¾B€¿åÚ’|­%쮪çsœ •\vgm+:½Wÿš$)Ý…”ùn·.\2!iiåþ¸HbÅHçc€Ù­²»Ÿtp–×þ+ÍǾ)âiLT- 26ÑKŽ¹‹ÇíÛ5i]²‰¸[–¤‘ä#Å[žb;AV.Ù&ѧ‹ZG&èãðïæÔ—EnX*ô(N‚:åëÜÃñRŽ=õþ¼$ïÈyô81)?ÞÛ¸—ÓXÖâ…» ì}è¼Ö,Œï~'ªOôNÔȺíÀ­Ú kF+·ŠC¡ feûxó$üƧ¦²7µ¾…LrƒW{æ²I½— ŽÄ)5 ýú‹7§UÞ7ÃI¯ì¼r’É-k~íÛ?Å8§Ex&< Â*qHB5¸<-úwÂ#·*=n8‰(Â2È#ƒ’"> Á,cë/˜cÆÕúd`÷FóE=*” ]>åvïX$©ˆ­GLصnS±‹ Á/ùê;AÓò=ý®6ïœ)Šï•*’~Ã歷låá}L·’ê@ jf©A¾‘F¬{¨OE} VjT §¨|ü1ö ÙMg'ky1–ø÷ÝŽaüÏö±3ÝöãyþB›£,bªtí„9Ê,]>ÄÀ(UÖaD¶Ù$…ùÁ Dk곉ZrxâFà€Ê“"‡¤æ0Ü‹¦kavÙ(\:©lU»a¢‚Ý9JÝ»­§{§ë²S0Fú#I+ñpâŽtR~Rk«p"OŽb×$O¢¢þø!U@tnHFÀOŽåðöb¢ÍeHG%DÞ¢X‹a+ÀGÕáÙ݈  ¬%U45ÊGÌE¨S4†£,Ìá·´2Fp›+ˆ˜ÞX7 .ý!ô+ê†#–V€ÛbÂ6c§àüètEEöO«ÏåóÖÝ|”IoùwæS¾chÌÆ6%=R ëúꄾnȘ@«JS&ñ¿À6ÇÃ]@Üþé’„º•Ål=Fe"¤îîͼgt˜&¤9n§°IÆ?ž§Ã̼֘ÙV’R~ä÷mI%¡•íP™)8Ž½š$y¯©þäýx][W¯Õ]¥è79Cña¸Tºõ$BIú~`ø‰ÁÝ÷¾ÝЪ‘sßØuÙz—l”*½Å·äs¯Šß,P‰Yùs$ó©â>5ýøÖq&_†›þ:Ũ´Æ3YÄ×$¤OKzSé÷·í‡(êôe­NY4Û–¼ÒçY­JÁÝ Ôå@%ÿ="IÖgûQ8lÁRçÝÕn)ÞkgÝÁ©ÒÚºÑêG.³íÄÈ£ú¸«?D£Ü)üÕÖ뿳 à–¿?Xj¶Á”»Åf˜` º!²Ü˜‘^Œñ7ûødUÿŽñ õêɅʯφjXu£S¼ihÎÚý‘—+û+’ÖÕ´XuYÍ^­þ÷ )g©ÔW·µs,ùoœ˜"'ŸW£†ÖOVÙÃ*YÊ@ Ľíàè¶ÍŠÍy,ȉî { õ„Oî gõǤä®ù8Jàr]ûš`6eìOD ÙÌDV´Ð,Ký:—6»Î[ÆNÇѵP÷ˆÄ¯®y££æM‰_½Ëƒ^Ä‹8¡!0ÇÐcÒ¬7ç4Z¬ÿäÑ™,p~WÝÁå‘‹Ã BëV“+2zO¾éj>ÿ])PgÊ-‚À¾/0ÇF†:é¥ù*‡|A±L»I­·—q;y¬‡ø:†úÏÎ×&­(º–§RmÞ‘“=i,mçµÖ¾sÀv‚>HCç[a(|/˜ÒC¬éÅ»5)½úóœÇLîc†F§ÙèùýÈá:#ᨆã­C9®ø°‡FÄHÙÛ–çòFA8èÞ¿í ?ä„oy÷øº½Ù>Ñüû*y êøé 3ˆÅ¥ÂZH»Èã""q=B°~‡ûˆÄŽA~Œ²?çúDÎP`XSHÑi˜ôõx©mÀ±X¨ÑåGS¯¾îcmÖô“ÊàZ¡¢±Y0ÝBsërP†-Ù먹õ×ÍcæûæÃF›Ÿbœk$³Æ’ù»0Þß»/Õ—ŽBÝÓ6Cõ›_¿° ½gÕëŒa/”Nþš:sž¢ß1j/´­Jû¢~táƒt“7Ê%xHÓ›{‘, ŠÉ€j,,á"ÛóyÇÏÄêô¤ÐÓwy縕ï÷`Å#óþ2Î,§(m zýåçÓÆ\þ{‰Ã‚$Ô~Æý5ÒöÑ.2ZÙU.”öy-â xÂ]Ø“ ÈD”ãs"»²Ht%ÛÛšàÑçÑ®’³·È9]ªTñÕ´ÐÂÞ.à–Ë~a)8ÞJ…øIu}xÓuç+‰cª!%?MO·ƒíˆU*õœ»ªÏT_d_Ó3p iÙó¦ôîN›¸Ô#H¼ÈI‰íˆž’š¹«0+,ø†_ÓÂpS¡ù£àËÌן5àꑆ¸ì”×çÆÆ÷o¼Ç ÄÂûqzÕúEúwÍpŸ ¾äÄ%({óÁ†“M4Ë]O¼‰U˪C‘¼¹×ÝÁºÑŸŒ‡&‡FäK~Ýîµÿ ®Û€,í<Éù¢Òó4ú…*]…­ß˜Ïímý'¶ Õ!ÞâÆhG õN²±¯˜³•^ŽÓˆ4–ý;ñÜô¾5À5 Ò¬ŸdvÔêùY§ßAsض¢êìdJò¡Ò+RRaX…ëV*ªtÈœKO_Ž’´ ©ñ ÏJžàì(¾ ¾R}ß±Ä\É_JÓd±ª9 çßÂnÖ )^g½À8[­E£¯ ;Æ@ rõ~¢Gü¨­X/5*yYqƒ¨…õXëÑ9y}ÊÖ<®‹ð}ÖéèùYkÃ0GÒÇ Õ­#*Z=Ã+‚ê}\m_h”ðõiTND]’ä ÅkÁGÞ ƒ¨Á©|Zfoì‰Z]2ÏY,ø6õyÞ³çMÉ43衹Üà+å•ÂA‰˜ÜoÕóÒî]iÊOÍ1Â`ÙOò®š~x›×P±ˆõÑâ•}b^Z³£-2Cƒp‚´WôY™—Êh(Ôvñý@ûÜÃÑ+8À;§[~ªF#<×Ϭxʦ¹ S„í$zúT‘µ[/vZ§Ú´n6þQ6Mw±›¸ŒðÛäp×ïñîܧÖ,c½©";ÏáXåícåÏxC².ôr$^¯Ïk‚&j,ÇĤ!|yLU ªÑY\æWïxÏK0¿ dBwM±ZùúH±iQT•ƒ'ä6°£2ª8ƒ¬kº;­Ú|Wm¯yiS߸H³nºŠ–é Wz»Kƒ¿¬©HêPÖ¥å‘ÇŸB‰ãð™OÄTFŒÀ飿7Ã$§‡îëó7COáirìø´Ãþr x3Kšyª[ÊÃå"ÅRTÝØÝ‹÷8Õ£ãC'¬³£ÒÊ\8ÄGZ›š U’è ±3z)ý¢aë™äèzg¬ü* Ûë>ÛÐúkÄ{C‡ß|súÞÎ÷yšæÛ¹ŽAXÞ[î“ØÂó8Ä«{‚<~xsªê](laû‡ÕªšUÔìTòßé„ß(Ùæ>i*q3šö®•á “îÌ|ÞÑÇ/ÇÙ‘C,_«ã£pZšnb‚ÝV¥«×ì@Ö©ÇÈ  YH‹¾5ž`F ñ‘ºC”àûTLÜŸ £øy\²«ýrÓÔöö΢G|ÖR¬NšM´¾…0ä·I?„b¡ƒ-F‰üú{O&„e¦×óóp¯Æi%0ì-;CÄÛòkÄ׋§E£ ŽÓd›âýÅv‰’"É ¥?œ|==®»~31ß—D¡¶!ü¡>—ÁÐZ%R™[³N¤Ï%²î ”v5íPKKm>ëçoÇå½;bZ@˜±}‚tí¦çKò9ÍZJW4ê€:áÈØæÙº+÷Va¹¯ ú¶ô,ÊEI€ÜPc&òÍõ]TÑðæ’¨¨Ý©c”àAƒ>Ï[¤0äDµŸémCIµXºÎ_¦gÐ0ÇŒÖX» TÕù ê ½û\ƒ’Æ P‘Sbõh£÷=XÙ‹Ln®ûäÙÉÏX$+áJ\ùg × W¹hPJK ºæ˜³0eF/Nfµ›¬Í¾T,q´ž¬êî9ûh 6S.DçïDÏ»¾×饻Õîf¬;Oø¹1{>g-Q§X5©uÑþÏ¢ ¸Tw {'· ×HÊf+(«¨™o[Q^õé^~ òfÞ´m¼úö³ÊŒ€ÕiÙÞ³N¨º» ŸÖÔY% ,EzíhίÛYÈñLgç/·ó¼ÉhC,%ŒØÖ³½3¹Ÿ‚lx{ã(cóÚž·äè!IÇê~•¨Š™ÕÑŠL–€èöCÜ¡+”á¾R [Ùpü(VÓ^T²ä„PßèÔ4A•Žb&x¸‰aêNvj©ïœÅ²W'ð²ëJ'tææáÌ4Œf qÕÚé³aß³ènEëpØÛ‹ÆjÑ&ØžäsŒ}–åIó‹:ÖaóŠÉÒq1Ýëä“Gb/•ôË ª[º§úXÌù› râòî²ØP(ß½=>3™“Å=–g’‚¶‹Ðèû¼2ôw[3^С)Z™a‡]àkvüSÊ*) ’r,oÇRÒÇV/)åKA¦À¾­Yç×_›ûQ‡LÉmi=¥M!ñËÍáÉ!Îý0i}oɉ‡âylP瞬³Ò.…¿Ç~QÕíÔø9íËšÑO.ØÀµ[Ê2¢_;}lŸd»>æÖØŠê‚>ôÞHƒ3úÁüs >¹{Bd`êñôtQ툫:„à4I+ã©÷Ðì-Šˆ¥~òh™ƒÄçÕý/èYÐ5Ѧ*M£¥· ®ïâV`­ïK§iÓµžJßœeÛ¸bÅ­O‘®N,ôöÔÁT9@}XÜ6ý˜ÙÃå‹h=NÕ?eûlÛwJP¦¹°½3 uª‘9ñí´‹þ$2vŽÌ_×—^¦·V8àZ¸[#®ÈOhÕ¹53þ» «ýUϺîz§I+W¢c¿ŒCPMæhå×@‡3O‹”gNbU¹9,RÅ‹§ÑÔÜå—UAk_ߺpÀx–‰»PöŒ=du‹:ÿ„‚âä’Übm~¸&ÂìãÒ!8á¢îÒ+¨¸ÅTϦ,¤åcÀÜO˜w %Ôûn¼koQz\}û#ø ¸ò™ÈK=JËÚâó= O*“_Å°áy¢ÊEʳÐý˜1gµÞ¼¶i‚œÜ)ñ}}Wî^Vg2­Í yqá¡q) zmt‰¥óÞLóžÌC:õžôæ¹Ñ¢Ö»ÇÕM¸T’A¬¦ÓOK,’§–ð*xô±)çYù9©=Zd}{3°Hqä˜f¬ ]:•â"|)50ÐÄ?&Ëη²OÈÖ²¡&æé ™uιy¦ŒF§Žû¹RÁ’ÊdZn}wl –|ë ¯Í\h¶l|J—QN¹–Jê iïv9“pêõY\Ð+ F†¹Æ´™‡˜³ÐßA˜ÔÚ5QLJ7’”fßRU…‹ãØ.Éa üf—žg÷î½'úÌò6?ÙdP†Ç8•›Çe+…ò´­ËõÖæX\E2-R3J)?ø¨ªHÅäð¶P šV±­“¾û8„Žûëê(Õj:„FX·Ãuõb'ÉѤ™XSÕÜ Êr Q¨1H~N¾D”Öê'Õ‡ˆ%_ÊëºÑ55YXe*ÔÛÄzF¿ž¾ÀÏ‚Ía>ïg žÍÞÇy»6òLi‚à4©Œ9²>*øXÂåU¹ kö³©–#¢H=µäH>6ãWLºòÓ-á™;—Lú‹ö3D Ó§kÙô,…!e,¿ŒÍÓ©ù÷øWÁg-ä5¢_·–âÌ/»–µ¸&Õ´¸Vœ"µª?Ž¡ÙSx‰ú+;çR£R…Q¯-ˆ; èXô ®p7~@Ë‘ÐCôpdººŠî4õÕÞð 0¬Ò¢¾.¥½IivÍ¿Jª&¡­°Û·S®4‡3:`Èaûûú¦Wmñ|»—ðw£%'È!.z+T"UYY½pÑhÛ™˜ÍQ0~×Ùå$¤×MX€{õBÝ-ÚÉÒ ]4³I¹ÈdžÓúø©âÓ£`ÑåS¼z±>²Ó† µý ©ImÀcˆíW?Šyü‘3™ouBåÖ!RÏòØâj„JqÚ¸kCƒ×óÝÏnv;ßQ/Ú’¦Ûà/à ÷¬c‹Å¾‘lC£ëÛ\쪗ÜóN…ïj·Ê­Ôî¬ø!n·n@;</º”ߣï 8rè°~Óž:íUJìR y¿¸¬õekV%ÖSÁ~OÁ×IT!•¤°²{µò§€…²†94Ò {üU‘„ˆwýB‹—Zç¥tîÕ,Êxnøºæ<5y®ÊþÖôÀîkv‚«-m˜Oü#8*Ðü‡j% j<'±ìÙ]\hn1C À aªxÌLþM .D.ù³B´ï%ÍMT[Þ7vbrÌŒO°·g?lÙˆå:ä»ýœÒ™±Û߇kœŸÝe3„2E'2 yàšMnyÜGN}W©£Q׈S]ªhá÷*õ['ûf]C"PÃo/ÈĈ=o¨É~UÉU± ù‘ ˜\“g&íé’ù–S•‹DƒkªÛ›UIÁóí+B©>äñµ¾ž: :8Õ#ùYeK•ì{tÞƒ-Gÿ£\!ŠúŠë€$†Cÿ9óM5m`Óç½(šQ!¾TÕÙ9ð8¯iZä/e³¹20g>×#UŒoìCኊ\aÔ°E†â—v/?G!6[£ÂÒd5zTø²ŸõуVÌ:P—sf®Q{S¦ •‚×ÎA¥ß[%îÑ–) ´ƒš¶ªûÇÒu»ÛüƒÌY¿k3E(4¸–¥5,= zø‡=€º`êdjó5¸k Ììy‚ˆ8bÝ Äk˜#QBã_t“yºqꂬàö»Õ:Ù2Ö¿1ÚCN!5¥&+ʦŠ`ÕF)UñÓ™¹¼²PÞÓNÏÈ›Ã_–Ÿ+c“!Ó·úÄo¸±”A6Hà`+]ä¥OõZ mP¨kD¨ž³Mm=[ ƒÒÜL¹Zߥw-—ÔÆÕ輕!§V-“l ¼,ø62†~²Ì¹‚Ä™ #½xg°-Ñ´Ž€¥û´Sï`)¦‰gRFÛwP£:µpWðnÿ£ú#ÝNÂYЖ…BVWˆ¯tv2|Ñtä%%f¡=Ž°âÀcëû®nʀęà$emKÁ&MÐÔùõý¦éaùªÀiÊ¢¯ö"ö Ûγ:é`IŠ?9¤>Ýwc:<žBWAý"šýú<7AŽ€8Üü ¡oÕ’W{ä÷Ä飆¡Â%ak¢ÎŸîŠ`%„®:ôi÷#ñ™€¼ÖßάÈP(ýy»…ÑL°¹%K‡ õºÔU¾ö×@¶Ã0%VåOH‹'D"VqîàNgw©ã¢{À eû¥Ó˜cÃÛšá qŒýˆum×Å ½¤ÜîIÉ(ÂÕÊ}ß©øE®ü{À‹3“qŸ ÄV¹†BIiøVÀè°äÓáK¡=o†îÞŽëäN÷IòH¨q1N¥Õg/&q©•ÃþBq·Ô-mõŒ÷)tpk©7L‡"&e0Yh,¬Ä|acúû;Åü• ßĨbvñ›ðh‡ÕÅú!Ӳņ[Õ\ÛÊý‰uîÆ{G2ùj™ÏþT9L0­þî™'eï´A+#bÞ§i¦ÙèB ©†[À÷EªÓvF1eÕP²nVY«o<5*Äm¯qVnâ•Dãé¹BCéÖöѺžaãwÔbW‰&m®i¢lÎ'̇¥W)ñؤ>z½”H%˜#n³Dlªª±:ßšk¾$hV×&[ìi@Ãá®Ã.„•!~Úiâ©ß›™^ö¿ÈK‰@=æžÙDüÑdŽž†[‡ß¨$R+D¤‘üòµ\=¦Bqƒ<+ç'V‡Ä%3.Läí¬•ÍKÝÛÍ  É”<Ç;§‘ä×°Y_lQ!œ[ÄMg žø½ÏYš 9¹ª¿º`“Pr5qû†cŠm#öئéÛ‡¾ $(²Ùx’T{WÞI¬V6 T׿ ²;4Þží›=÷¤B~*'ÉA À Gt,MçÔûSÑ>¨o@·se<ï­Î°ò©Ú¡à`úd['kH_@ï;nÎ)¶)½`Ã(lᨗ9ŽŒ/!Ðíò3í3ªFÜÉÉ›qIçÏ\]T‚)Ü+ø!ÑOïŠDKòødº( Ͼ®6ˆé-\|ÅÅÆì­&„P­žñÀ\xê™ré^¨>\ïBêKlR {XÇ Åâ»|9¿“€=:^¼Ckz˜Ä&•™ñÅÐö0Ÿ (ªÕÔ-o>Î¥ý¨ø˜c#Z¾É½ 4‰Qù¹ÂYÚ³ }‹¬‡o5õÁòyâº1ìG¶(çü!Ñ@Ç­Æ>—:@8Ué±*ev•‚‘¨˜‰è㉣Uö}†d[Nï}á1&v\5ZU~ïIJòÎvneÒ‹¨“%ádjX~éÚJ¢YŠA&e‚Sÿmôâ`„øõ×ìXU œÈÖÇç©EÙÛ$o”ûïì+" –.w"Æ·Lž¥Ü+ÚÒãÔÓ6¸ösû:ökÇ#k¶È¢ŽG vþ£ëÍÙzž ‰2šk"±‹.aœ§oB½?öføVºáÛk\ðí{ü–ˆ«™'ä$[k™yœ“}Ì‚Ž3ÖÓ8páìO4ÔN(¼Ì5æ-–wî°bÝ{NDeø¾<Œ>ÜQÙy¥ÝKUŸ…}˜&Ûÿn=À“¯°UpŽ*¸ÍFo¬RæªóX^ÜU7Dø¹^örOåb°=ÜïÀ\Ê]f‰Eø!\‡©QwÎBWªùûÝÜQK5*ôïŠåðAùô2Š¬æ°´êÌÝW¯´Æ£×kµQ‚±ß Úñ¼íÞ™9(=¼IõÌ+¤¿Fd”µž¿)â¦Lz­ÙI^¢êÎ¥7þ65P;ï<§ËÅ ËYm( ­8ÈÝLp|Ò=¸é¨z}ªˆ1Ãqµ9ÂÃÒZûÍ–JG`{•)â&í]Èg(œˆÆSÒ8u¡åú:ª†»œtœöZ]êU([ìàÂ䀟ÛY,A·eYé {Gn÷}4d«¹²:#½,BÑ@RÚ:ÚÉ#&hžÊ·\¤HhIÀ †ð>3Èëï†Çt¦a˜ KÍ´‚o„¿m»«î0†•J‹UɘÞàôX¾5‡~Ý^éð™x¿LšäÅ5¨r“Øäú¢vŠ9´–G:Å—381­TûíØzvL ?˜EO.u˜É›¿„õqûV˜]-ØÝdz$’n2ìnhB'æ·EiÃøÕ¨ö(Ò‰þ*ͤí¡¥êè>­Py¿¾î5™<"U">{v…FM!ÜCäSßg{ò ²‡ ïU£’螯r u)þÑ;´³ƒ!8ò­³ƒõÔ'xÒ ©nö7¸³ý&H—†ŠóªÏ¿1{QŽ«öÆ9ì¥ÑF02Ó´ ¶t2¼b!œº­,4™Î¿Ñ~#=üx%°^EXVY›7‡ž<ý6bí¨O }V…×ÖÓÅ ™‰uS³šë9üÛjâÇÕÀ×I ]“\+JCAi¼JòAõȾŽìrrMH|ZR-“S^†$P1öWÄñ9«õmû>~¦zågwCs0OÓÑPšyãéTÒöiOZ™+¨F'KßÃ\ø–´çãG¡¼|?áö÷r 9*¹çRé£ Yé¥II¹q.§dbÐ> ,|Ñž^º\² P~s.³>ü=G©k[ˆŸªOWùr‚ȸ1ƒI­àd«Fs-ăJYf—0áÔljf’*ÒÓÿNÕšø2, J!ç”B§o WE°GÉl*·Uû¢”`KnBð¦“+7à‹ÅgËÏ޴ϵiÝ[ȽCËŸ˜_´á8\Z$zê”ðƒ–¯Ùò=tvÛÞÕ¡¿©¹”hý˜cM3[?´àE•%JFÀ|3˜:A›6ª—~‹Öø“ý‰Í„C§½tÙ³E3íBiLoqÞwŠÒ±Ö6æ×Þ¼Zbço·´¥\­o™<¦!¡¶QÚ ´X%h@Š}_}×MOÒ!KÒÃvr…”jé®z¥ö²d u ¡u}²uëþ<Ïe´g×V{fo?íŶ¦¼o§Ö%$º(O¨ÔdLôµþþƈâG²OaÔè79Ïåc4És!¤D¤à\ä'¥¹Ü‰[Q¥ƒ!AüÈ^[ƒ„Ç+mÂýpMeõIïŽÉŒ˜´1ì¥×*#ÐB¼;{ëJ §;¹_]ô.$å¸è:0áôê|éÇa(¤…½Þ|½BõÓÖ¹Ô£~¹ð¡¤“±ªh¨Áþ%ls{¸ôÉ࣠wF¢}±<­§æ Æ=©ÄM•jµ‘£¨ÙÑ9Q¬ä•clªãh¾¬dœwlQ#‹VÌ‘¾‘tÕTŽ}#¢êV¦¡Ò#l®Ÿ¸˜øVŒÕU$¬ãv´‚ÁîhK¬r,Q€Så—ŠúA‚ø—̘§¥þ¡ ‚éG.(ã ]tÒŠ—[ŒhjÊ÷ÅœÒõϯý.\Ó¨qDK‡Ä·úصåzv [pf„I–ªkÓnK]½9\Æ["¿YÆ a¦Ž”Š•¦/«úöÌžjÍ'å×Æز”chÞ!›mmçÒþ|RŠá>ny b 'J[(³†ß±ÍÜ´3Æ^måP‘ŒÞ T’B,O¨ìÅL>¯ÿØÓ0tos‰ÌPGÿâcÖL>‚­Ø ï/°ËåW_‚6ó¥«1pùûÚ®^fË=c2´1ëcYj¤eÿrXJÉí>þ;Ž 3åÎlú‡€@ Ý«»·íLЊANPµQ“E͈ú­Eèinä"äT pǃ²Å‹XªÃöESéÿ4±§UDìmöÚÂ’éNa££¾Csûyõ(¬e%Æ€å }“¼QQmfdŽ§¢]1Ð5Šê²ÿºî^éã©Ý¤±êÕ"”–}Ð^ñž÷«ãeiz¢ñl3*çäc"oW¯”,ÖXNä/ý°åùSÞ{3xB1ÍHÕ0F¼HTÕçgÈeSêš"/5k£rû$ÞBozƤõ)K {>½®šÕèÕÉ ;oV%7ÈB¹ïú²rÛ=}QÕÏåu®+B]ýª]Z©•§ÖylÆ‹¯½ßsIp¡WTÛ¡©ÒbWß½Ÿ¡¥OYõƒ’àè w|0ò¥o•¹±X¬Gºb¡Öïq¯2 Z+{Ò¹1-ÍÐSPœàT̸ñ¨' vÏ]ª=úסҢ¸t¬µx›ÃYcÏÛ³’åìÇù4±Ì>F]!UaôÆíD‡iSŸhU(?mµT‹§zmç_tì¨Ic~¦ƒéß7|8¥T‘_‡¥TÎT$£nJ›2‚åöF_¼’}bJáºiÜ’Áå-Vôæçx ä§.2‰¤ô¸•ÂLüþv|tR~°ÿ(¤%PÿòöÂòõvÿd0ÇÍÚÖ´VI³•ûö襔ô¾)¢[C1!./Ñ1Ž«ÿG¯ù),#lBP€rdÅT>c¢*¬\jW–ì—‹É%³ïõ¨¦ÒQ;Uâ2c\ó«×áëïR¢,GÚ, X?)F`ÅV³­ßôgJ"Õ"¨Šku\#iý´£õú(ƒn¥Ø<>aåôˆú¶[S­Š+’¢” }QK9­oßx/tUðükt¡šØ¾Y±ËZËêØc™y>ý=¦`RrT•ÓX¾‹¥F3ÑS>-ͧ7/ÐBjœÛ®¨•ØÍ–=oÚ¯KnÉhƒ“j×劅¡¬o¡\v¤[ö­6?å¾Ç¶Ñ3"Œ×„›[YÁC:Þªí#‘ˆTÜÔE€µ‹# !Â$t Þîº&©åîñu_sÓU9¥ƒêNÈ•«n›E'¸çaÁÛF/÷OP~|?Úί4öÔ휃õd¬L QZ8ÌUk_ÉòI04ÜQ[ü ïVZSEr¡b¥Æ-®Gì‚Qÿû¯!]#bì?áfbf4ßjì Z¢•®d¼šÌ·šü6’à‚ÌØH2º,dÊyk ï3M°õë¯Fž…ø¯ 9“÷7[ ¸¥0¥ÍX² “ž¶¿úìÍ÷œ×eÏŠ¾ ×éÔÊ”6E Ý@sân ÇizN óÃ2V`‚¡[´gOSªÖO.\BÉUå_(.ÏÙÉø&¬/eRÝ«Ar&u)—0AѶf‡zaQÞá “Bl:o¥ýi#·|‡½ÁöNEÕŸ·ê¦j{R/´Â½/g÷± a\­Xñ-ÅâÒÑ`¾I¾HGÓì¢dâxoß=©…ûýöiJÈBo–Ó!é%Ì€èŒÚÈ7#¾üþú!%õ‡1´c’'kòI¾~éf”µ+î´ÜX»÷wÈÕ•!~ÇqâfÎJ&ñï7c¯#ð¢ŒïâÕ@¿ÐÍIWÏ‘a& XÛ5ð›uïÛ¥ÃPaÇLák> šªÙ¾„ÕTÞj~¦cBÒgT":_tô* 5ýþÉósÒ$mM–?CéGÓGÇ/£†ÔOEÀÞKo'Ns‡/i¥A÷‹Ü^(ZÚxQõzÅržó{jeÝZd"¾$,bSÕO®(­xÃW8&wê½w¯מœ+ŽÉÉ v×Ök7ØH¿òòî{¼%kxp”àQmEò P³{íür)G)«MwÕ'N:>9ÐE"€';šJ݃²®±›~ù95Â[S©%TíýÎg¯®}Ó»‰,ò¾D|õEó’ˆÀ!¤%kbV:+9 ¬ê6Ÿy_–Ö-[øñ@¯›9œ…µÑÎKƒ&>+Ç]d2n³Ü³ê™2²Ñ/9ßrZèÃ’k:€òÓXž~ì«­=©&pëÌÀˆˆYS`›}&ç‘ ¯º 'éjÙ.ôVùJ­¨Ù-ÙGÙQÚ$ÇÝÛ'ø""\¼– “}ðh£˜'$xÊ €¬ÈkWÜÚÏýúêóNhV ©ËLî£$ÃJ¡ó§ÓnÙÂr­"ÇN&Û§!ÉHmlRR£3‡Ó»ÝÇ>¡¸•úÎ Nù +ý¤Cá-«–RèÄ@÷Ë—V›HéŽÌG™™”Ž™»+·÷vºä’Ê0eŸ©v =9H)J.Ì'Ý-°1ŒzD”®L •Â•è«‚ÆTßy‹%Ó„fÆ‘ÃÖ˜wø{«xhÌîK;‡¶LÚôfŸ1nÝÅr6~Ú݈Ҩq=òu¿wWøPC¯Ûƒƒ,°² !íŸYØ„“b"óS0˜NÑfΩ´Jùñt:×?4Í’Bw¼¨YΊcóÃO[Q"?IbD-ÃdÚ¼ÕeLrÁ,ÿqqŠò¬Ç‰(‹€ŸèA.ˆ,w4=ƒ’øokõœ#/› W”( $+2²ÇÚ‘-ÙÎïB6tW("¡ónãì~p,0+Ù;d³rôF3Ræloq ÉÖ¹-5÷O’.õ5aTç¼ÁD\¤ÙÂÄ?XQä‘fµÚÜEïÈk¤]]£aýh%@Šô¯]¼Nò8û؉‡ºÃ<:½ª"¦›·m0Œ¿PIAµ_™[µj 5ï`bP@4ŠÈp$!b+z^ãõù†$VzE±sÔÝÍðUý%_' U8h6˜ fc–ÞŸ‰gÅXîc&°šrä*ñ°:[WU±…k‡§£ jÅL`‘[Kì’Ÿ…hyw¬}*RÉÒéG*ï§|7ˆ ¬}‹+L u‡{Ÿ/i•5r"*: ¾÷µÄÓœùiÎôy™¦5 ¬›Ð¨„vª_Ý3ÿBÈß\4"@€ˆ@h>†ðîÒ²÷Ö¹¡ÛÅdêãòHÐP&HŠ#丢ÔëMu Á·F¯#ø²sУ~dKÛHÑ|vÖÉ™”môÐ7ã׫Æ4óKÞ÷7c(éj6ouºÉtÞØì´à(ÙáÅÕQ¶=† Îùñv oѲ8ïÓwçøìEíÕZáVëÒ·Ó®g/ ¾1g kYgÑÝ££«z¥I×Y~0£8Öõ7Ÿu ÷Ö?®[‰}GX Z*/¹=ÓsaÿBRÏLç³ ’³7«©êhú0B¡ÏlÍÈ]Êì%Í…áœL2¿™ëE_·À;º]²Œ!~öwÆÏ;¨È™Ò ðFšC±Eib,C7Û`m̷쪑i^ø±ˆÐ½`qÕ&K`‡3[ Ä|³‹ÔH¹±N^¯-&Ô j©5Zd-^Æ!,”“çâNÃ8þ€u;ßÆÛª×zÓö¢#,ÙÅ™§ãÌ]Ìþô þŠ¦.cz\ŸÑ7a#ò%1­aXt,K·´Ùï±ÇÒT&'ú¸aÏ5'YáÍ™áÚ_@»‘˘K¾£Âݯ`‡¼ŸægÄ—Á­ ½tâ>-§Ù²“ž zø¡ú¤±Âÿ'êỿ-Æô(ñÕC/®|ížVÒ‹BŸpµÐa^¨EXkç’Yø(×l?{ ôœ^älñg‹ì((s"Áè%s²‹-¦µòïU²ù‡¼_Þššûäoø0O–ZÛ´ßÄ:‡“е1¬nuY)ø*Ùßêo¥”äÛf;ˆ-Û¹•„ªaÓsôýù^ÁoŸ÷”䊩™¤oåéµ9»p ßWN4gr„uúÌ‹fußUÉz±î¯'ÚC§xaõ:ÜC·~þ•-T—ãM*ê½K¬©Ç:ššQ~Øô;pR”o¿Ió>·Í/ ]¦[¨ ÄQŸWÒRc»‹ÚËìË÷ÚeÃXéœÀØ6q)ˆ¤Ç5»øQ§ ë]‡€œ§ŽÆ|æÉf3 =£c3 gݺ€XªW‚,æÝ–M®Oº@]übö L ·”ŒÏ×Ifv$™˜¿Ö(m&Á„sŽDxéüËKHEéÐdæžÏ-P)7’ÎbßfÜ&>çJ‰òò2yÂrË-üµ«Ù)R®ˆí™îYGÚR€€*¹UwÔÉÇù:üÞŸ$á "! R0“UwãXºB@eV‡ÍrÁ˜?Piåu•—“DQ8s¡c$‰4Cm ÿ䛵ŽßœsÌ获ÿÕŠì Âk¸ó´Ç&%Û½˜3ãk¨ûÏ¿­€qcö¯í‹r1b)^\[»ùÈw̘d§°Tí‚¢†ò ¦8\» ‡d&#Ú-3=™š ™–-„X½?¡Ô;é˜ôEÑòE…ž_åKaý&¦ÅùG~®Ì—ç(n©ê"–Ï«ÖIÏAN‚£‘_ÏYB¢ ¿-o+1 šý¨…E¨ìDß1Å-àd a‡Gˇ(Hx*Ì6X©ÐmÈVÿ™‹å¦vûýôWÏ„’kÑ*Œ„=¦Ï³}ài®£5ægÃ;!þñ»ÏyÙ¯cæ¼ìÏ·)ù•VgÜ ê‹WgO6¹44ÝBÖÇÁUEä_3ï9¥Œ¢@/™Æ†œEõ–üZ6ã6贉ɛ GßfÈV<ëêmÀ'P%I.+­!Bç“I† ʽ‹ø+ â®zs`wÔ_K8Ú‡²×Áæ¸;Ê~x¯On‰Ž…z¹]+pЙAâ¨p’Ê ¡×¦9b?›¢qbãHG”ÍéúŒ#ßÚõA*kƒ& -éûZ¡¶æʤ͠7ÐiåñWN2ü¾ÌÑ>ÑYªIÛ˜`ÿ÷¦É<æüuJÐ5–y4ÅE‚ªAŸÔd"obíùítyÈ9aLîî)ºìŸv€¯ÕK/°Ç²ð`;õïŠKY?‰°âxCªäŠ˜’nÉ y|ÇZÆœŠÉÚo7¼‚‹Mä@.è‚å#×èÁÞú G3°©pƒ;ºIE¬ùÀ Œ…æô”ÛÎtšV(€•è Õ›~àuœ`ƒFÜt.é¸ šõDVü,´Y«~©€½úp,Nô§Ò/ê9 O5eCÔTZ¹Ó«•æ6vØsÆÕž}ÊF[Ø4@o!X¬w£Ðï31ôZ#]Lù¼^Æ«0â‹ U}î‚ù( Yû` b(‡yâj<[8 ‰÷¿m0E™æ§võ§Å·šJÊYÍr¬"n]‹±È³((fÙè:p ­3gÒ­÷ÃZx¿¯²:ÆšPßœ®'Z²œÏ_Vð…hLàÐø*3A0§wú#_zëžQ´®Ü×8äg—ÇC\eÔîg« .P—Ó0_úÀ×aZ}n¼Ô}T€¸X¾ ûä•[nn;–¦Æ ]º_ ·Ñš ìššd¸Üê$¦£)¶Pm°S³mÔÀO WME?,ƒ[{Ê6„‡˜cTn°Së¶{7nš ïÄçul~Cy.ö§ç’lüÿ2šù³ˆ þkÜWU6’„&Çs¨çsÞr©C#_Œ»âŠÍ¯4&cÔ™yC‹¾CÍgÉÔêòæÙÉ›s T©¡ÌA\®89N/ùƒ¨ C™¢Ò6{5[¡ÈaZ zᬲå‰õ»úðø㵋O±A ímM•ð£îXòôM¤i$?ž,rC TÀ:fbGý"‰Gÿ6=Eø17@/š ¡/Øúû€w›ì[ˆŠMZÂû=Ï̾Ô)xä|NXíäö‡â¤~RtÜ¿u7 ´Um|ÝrN½F`ñXW\ÞDå,ÊQ@n Å<¦µÄ©rÚ|½‹:_"µbLÌû 4ÁÕT™'±Ñiòw‰ûT»©ëq>Á-¶Õ=I5âF¨Iv]Fd•Õɲßlö§Œƒ)f㉪ Öó|)öÿ6:hã# ·‹ð†ê†Z² Ðñ¹ó·Îa6ˆ*ÝBpÉ*!‘ë=º»ç8¦Áó÷ÐbŽŒ+nTžab¼®üpŠ3ÎÌ„þTñF—n–ÿˆ6åÔmøÅ÷:Й8ä¡èBÇ àïZݺ“¸ûg2-§X›©ÉÀá1áÇÕªÒNäÚ^uë9=IKp³F“â¡þðeùx؇ÄëYÄ%T¡‹\L‹Å 8;U9n›®ÜF¾öõ3â2AÀJ”¦PþH¢²³9¯/K༱>ÀpÔ«@ð‡ u ]{W2TÀÛ°C)úÂ*tcóë.[þ<€`)/¼ƒ¯ß«THb‚ lf¢äA}BÝ( eˆHš¶»¿Ï OÑ¡E´aòµûâg™puJFÉD;D0¬ûæoƒHHdƒgµvD2-XnVˆYjd¡6 —[êÞQ¿{qK—‡$¹<³-WËŸF¹Ü-ÛØ€éÚ'öÚŽAKˆ/òŒ*á—{?¡9ç’õȃ¨Ð§—Ê`NMmëD¸¾•ãhšœz¶Ê$”Ÿ–iû‚Æ¿º÷?I-Eà¬áÄ ·^dÕDÀüøDUZ8µ o×Ve¸É÷x5§w]HCz<‰ƤOl¹YGGzF²0u¤ŒÓ‹ŽìSM†6A&èù2Ø“ã¡ùcÔsu†œŠ›Šœ"'L™²ŠÁÊÙñ†öãne•Á@÷yõÌ› Å¢S;Ó¸´è(Ó«,añŽ"Ô!¯ùšlðá{VÆÜ¢%ƒz— 浉ˆ…œ…ÓB!M•‰ möØ,—8/¾tfߥ¦Šµ¢—±õ´¤p(ºîeý< Qø‘Ýþ æóM­¨[} ³:áÚ½E8ð8ŒÚÀb„d5”͇H:X€3̉äŒÑ!Prª¤¤>ý?%;þõ–Å$³'–š×e'¥ˆóg eè‡ïHþƒ6‚ ÇO-áK泘üd áÇÆÆ€µWó ®S¾¶ÇâÃA9`å5Ç°À·óóˆxÛÞét‹o]Å´#Q£ðY/,÷!ZMú‘Äž¦çðÙ×{¹ à xà›ââÛC¸¯seh:³çà|U‡‹ÒŠ«ÛûaïÞ9?÷VnèꞀ^˜`Fú1Qê«eQÆ™¹ ÿ;âZ“¾BFȵy ³Es Ï&™€<ƒM‹p.ž··ñÔp×ýLëû¸®iÜ ÄÎv¿(ãg¹_ò‰™²ÄÛ×w|¶%–Dm p²§¨t«3'5Í+N;°ì&ÿ  —j³”9Åd€Æ–LLã˜í‹•ê(Ö‡ 9Pÿ<‰±ƒýÒ'òwÞæý¯¢çèÐÜ,ƒ™€°$&£Wj±±²•ßѱ6ˆ¥€ã2}’/?<æT\¶±È(saÔÒ,ëâÅѶ ¸²X²‘a¶ÒZ}÷PÊ‹å=Dý¾æ_¾›Ý:±`’„¢nØY¡®˜µÊ¤³a2¬káÌGñ/™uY­e¸ÕŽ®ýˆ‰4<ûTÃ÷õÊ ”xÅ@6Ç Å;|رƒÅ#8”y]—Tú¯}rhˆâ[¼¥oMšdžõÇ/™'Ú󣶻X1–L÷yÍ(½õˆ)¬å¤CÕOèãÖUúJÁªÖ¶'¾.ð•ÍÎé8›oS¹{òÆ Ò·ùXÜý·øܸVÙ¿Œ-¾Í][ý 0pµoùkë”–—&i. ÏÇÖ˜Œ³Ý‹;?—H’”~ hádu:| ˜¿šq<þªU¡ð\ÜrovôñºÊÎ:dû•É5ÓÑ\š-vŸ ¶D!‚è­vÑÿ-™šÉeSW0‹ç[Ž¾ý1³¥‰MÂX(ÜŠÄt•Œn«…ëPKö‡4¼f×Wï ·o쉧VHþÄeŠsäéw9x†>¨‚*ûƒ½¶º¢ÿRòÌZ>ˆBŠ)37ž‰ÈL_¡ž°g¡7¯`QB8Ý•tëQ2ÿÁü`·þHÂV B?í× —à›ºÀ)÷ï„{‚0q{Á4šØ­ÌFÒM´n3˜¨œ ãþ¿pVKo6XcÜ¥®X\4°3n÷M·Ü!€{Ê*¡€ö·‰Ž¤U–¼gsÃæ¢Klòð¬ðë}ZÅ´¤Ól“<ž~¥Ñ%bñ~ Cþ±(4°»owqŠ]íÄ>«.Q }ÀŒ¯©ŽzÈr<úNÇ——c?€ém“gß°ÂÀCê )‹>š 3b¾Ö¢@Œë 0J¦×u¤µ1 $©¸dÊ˱Ùý¯ü¢×š‡'ᮈV¾³}×O”4})‹ã€/ŒØa1ϱi%JTkm¨IC½á0e¹Íý~ýØõåJaåcEíTj(ÀD¶´èî°2 ÈâVˆÍ®qéù4ŸcqÕXû` ’îì,ŠÜu ]qš™Hä©iþŸqD¹ýcOèÿΆzFÌæ©L|W?ï+íÎQ l]S¸N½kãzê­· ©P³·ñGèd{$ÇÝòSÇ#n^?JE5QuØ®}ˆÇ##öôb„ÔC;>öß;áŽÒ׋ùmàï໋ Ë 6B(}(lÊâÞ£’r„×FÒi ðž Bz† ïƒTÌ+ÿ˜‡¶sNñb²yŽBþOø~4‚åéš3\ZG‰y«Í0.f4þ°Óu ªµ°sÌNÍë\Šö}Ñóõˆ×>⦇n–P=ë/b¼Œ3°Óÿqk¨ˆðÚðW¡®ŽÐVA¨6û˜%TßkÎݺôNBlšWïh;z­\ÎrÝèÞ™|q;ƒØO$9Ïúâ«™«¦­N±„ Ö5?ïèõ;eĶêèe€ý´¡.È ˜§ÞÇY†›‡61ãYb#C‚ꆲ}ú«¼A~õòµ„~Z£I½‡ì†Èôç¹;uñ’k|Sþ¡È_@Ôõ¡ëö‡q*ŒA¡)+ a p&+ Võ¿Ö°ÄÖ)á½Â`rð*²ÚëÖ,nmZw^Ú]„ÀH :`äq<Ï"&S¸Š8…l„?£4ÞøYN —#Í\Mgâ“ôà cÌX–b×”žÅ'V‘¥Cn{òâ “|¿é'^Ç.î®ïzlÏà l8T„i²7àAˆ¬;¶ã¤6Mª¬¥{D`ê½—–Ú™ˆüS_MGó–2ù:‡+4Îñ&‹Äºoâª=l¡„ß¿lì{à”`p€­Ê.€@¢²#~EnÞáÍç? T®8tå²pPã¶ÌÐDc’ :Òœ&üzH( 3OÅPôés½ !ŽÝašºHDÛ\ð=®¶)§+Ó¼lsŒY1z.'¼„ËÇ7s_ÄtûŒ4³LjRæ”~E˜sâaàÆ fÑ‚Dô!â|¾diºÍʘyï/Ÿ‹Ù ¡cié> ËüÙá)þ֧ǒ,Š¢^q{ߎýë>¸µm:‚Q!T·*ÏW öpw®é–Œ…‰/¸ìÌ3¦@TbFbµÐqÕUº³€§`D@"™D\ÞâöµÂAŸáñ/9%Š®Ý…ñmûYw ¡!—<>óÜ2·mý#vÉ}q&é]ôòvIwȶ(Òš© I’]v W~#g¸²Ç?ù%A¦SAÓ‰¤~k²µ‡Wùßú„e§´þ£Joo„ìè ‰i¿Iâ4'oŽW{†ÜQA3Ü–`F¥õÜ`Õ¾ _Ó_Q¢M;ÕS|yËkŒ¡è7%÷ºd›4çLm» „à"Y»ÈJŒW6žîœ&4Í-¸ûÂfk`ªb „ñêS™&íQ I»“ wC¢=iÄ£‹A~1¥Ã›‡ø­â¿íÆ«˜#|.íîô,”¤v "+»ördŒÒÉG€QéT`Î)sªÐ\8Oœc PÖn}ÏoÊeŒ÷ëoHÇ}p@£‰Ð¦EiÔÜ\°â4 W½©!Çï Ú9»7–fÝšc¬Oo%õ¨ +àjæIÄ–8+È·…Å(’¬&Ê ôLw¸>GÕ†íMž‚‰ŠäÆD»ÆÖûò4ÔK»£Usb HOè)8?0N°¯šAJ;õs_}Á,QÌu«! ÄU\¾BEú­s‚ìkѦ6z ¼5Ÿ~Zbοß"I•`Š3£Ä%£ù­O¡M9&„ÛR†I,ˆˆ'å|¶‘ó­bèÄ;c¼Ó©_4­‰x2ì<44.{aÀ G¸@tBý×ú\jÐÿcÎc—Þ|¯Î C-ë-gpÇRÆ¥´×è¿ùªÎ™èO.×jÚ•¨:–%ñH¼šdszHf5to1*÷üžMèÁBð•Ô&Í‘Ðùo¿Æ[ÞMàiÉûx?ÙËËX¿eð²É8¿ï«²sÁ—ùjO¸¼ëð]N ¿Î €ê'Õ ÷S΀"£Tª;Ü‘‰—\WR¸//ÔGdRĉ‘=Ô¾+‹9@VÍVüE? ,yœ!H"Ù¿.“2§b?cw­xy± vm°õ1±·C‡Õ‘àa×j|j k 1VgÒ²ÚÔvJÖ4µT„ Ú!ï:_gcIÁ-8 e€m;§†]‡[å“ÆÉ\ é WŒ<ÅífŠäíZD+Òc¨&Ðê“ NjÓªOvó‰hÁK \Üš5_ɯΠ'AcBŒù9¦þFC¼XHž¦ïè`@"f!çß¾˜1½†£JS½h^¬0bHîÇø/Ê¿ÿ=Ì= °¶§§sr³¿¤Þ>o'ƒøÿmÖ"[¸X~µÐ¿Eó;d4 ¨c¡äÅDöZžñbÅÃm±æ„C\%Ú\`ÿâõÁ2¿°ò·#u,‘ü¼wø HGÙÑÍ­±Sy6ÊBm|Oâø¥• ˆý¹{î -hp•ƒðH–T'šk:Ýp³&Jû_u¨ˆœžØLÚpðÒª_I}IÚ*òÇ¥”t…'M7ž¯¾m(¢rûY®#åÞ•ìDº/K`7ª“À?:Ãú® $6ñåªÝÞ—I¥l¹âP@À匎»úrð†Õ¯Ö_/ôœI {n÷ÜU é*·“']xÈŒNYð&öaì‘:P ñÞññ~ã¯dGJ,›·o H§ï E FË›ÒPÕ€îèTš¡½]Ïìhܬ7Ú¼+° tµ.Q7*cZ;-Ȇÿ8ï6;+…‡G ;¥ï»øSl¾j–æ¤"`´ÃCÛ¿qZùš\¶–lðTâFÄð8á]½€qò›eÙ uã×ÜêÒêÂ~¡S¹¹W¿¼F‚^kyp~\›‰§ øVdÿ“s†öíHBHü#QŠ0rÞõe.Ýœ”tã`?nëÙ;kýš'áC#`V1_§Û ‚îZîµþ]ƒÆÏ¿ÛN ô ÒšuÆ9[5q¯m]™@iü£IU,õizÕeÍ\µM…_û\Ž…IÚ£|?*_üäˆò?g².•2P]Í5ÜEy-»m¬ Ì .‡^ƒo…?Úº^/Ε¼/˜„c¼ý‰z«<&ñ`? EÿÃòÝCÌX¾µñ[öP»WCMÅF‡7oVâ·74B—º*Pgïp™vh1=B€ÙÄä[i,ów³jX#kËbúíˆÐù&×û6ãÿ_5êûx*ßIÞñÌù¿yR‹3ÛC?ÆסH6¯_ ëÆ,çbñ2nYPpÈÍyt¹ä_SÊ– IÿÇfdE§H~fîMæã ©ÙüŽÖ~EÕ§¬^X\žä+jRE7œÁ—cŠ–ìBÞmEÖm@\.Ga;º3Z£×¡€tâ.®M©Qvfx£À6,åVQ±Ex̱gµ4›8hÆ° #qW›¬A äÛ¤êÑ ˆg¯–Œÿ¶ëÇèʉ§îú±x D²B>átb±¾ã°x`iÐãýC›”•ŽgT–ëv%Ë/úÎm“Õß?‡%R“t¬(7ÏSÑ¢ …¤.H£±"Ãp…Ëa5>XTlÆeìÙ#Bú¤#Aˆ#èÀÂ0Ç)jÕõlš9Át€À–@ÂNþÆì¥[!RM*ÑTÊ:½`Ø¡®ÏAy˹sƒFÂÑ;šÑÓîV1>èþ-ДTúÑßûEÜ£»ˆk²VÂ2.º=;fëû\à|3½ˆl° ›ÒØ<('OÀlµ­?曂ވzÃc­”q¡X뛊‰ZQc qR¶UË”à[ ²jláTHþºë›[ObþĺÅuY¡zø†ÛqßÆS‚;<“%Ïuº%»Ê¡ÄñœëBÔ¸K’iÈbÓì¤4 bŸ!S‚VI2XZ•zá§y|ý`ê)üßðK#[mƒiœ´¬ù9íÕ#¤þÆÊ8  \Gëü¤"™É{(‘cJó0ODê½~¬ Cz,ŽÇß*ŽÒ%ùÆNƒ2+0œJ}Xf]¬šÐ#>Glà2jÙIEAï…›.Àöœ$np@–K×0G°ÈâËðR(÷Œ{¿+x“îQ endstream endobj 140 0 obj << /Type /FontDescriptor /FontName /CJONXN+CMR10 /Flags 4 /FontBBox [-40 -250 1009 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 69 /XHeight 431 /CharSet (/A/B/C/D/Delta/E/F/G/H/I/J/K/L/M/N/O/P/R/S/T/U/V/W/X/Y/a/acute/b/bracketleft/bracketright/c/colon/comma/d/e/eight/equal/f/ff/ffi/fi/five/fl/four/g/h/hyphen/i/j/k/l/m/n/nine/numbersign/o/one/p/parenleft/parenright/period/plus/q/quoteright/r/s/semicolon/seven/six/slash/t/three/tilde/two/u/v/w/x/y/z/zero) /FontFile 139 0 R >> endobj 141 0 obj << /Length1 1644 /Length2 8870 /Length3 0 /Length 9941 /Filter /FlateDecode >> stream xÚ¶4œë6¬‹Þ{¢·½w¢Do!J”Œ2£½Ñ{!DïèBtÑ»(Ÿì½ÏÞgŸÿ_ëûÖ¬5ó^w}¯û¹îg £¶ØÙ òĆàáã‰4tùø /ÄÍ¢E8Bþ2c³BànPg˜ø(À!–ˆ›¢%â!NÃPswð ø„ÅùDÄA ?$öŸ@g¸8@ÑÒ hðÔœa7lgo8ÔÖñÐæ?vkŸ˜˜÷é9'jm hX"ì N­-zÎÖPÂû_%Ø%íq ÐÓÓ“×ÒÉ×n+ÍÁ ð„"ìº7Üü& дt‚üÉŒ› ouûÓ®çlƒð´„CG¨5æöáCà€‡æ=Uu€– ög°úŸÜ€¿fàãåû»Ü_Ù¿ Aa$[Z[;;¹X¼¡0[€ ÔÐz¢Î‹ðBp,aàß–ŽnÎù––PGK«‡€?ÞÜðDN`ù@ð/znÖp¨ Â× êø›"ðw™‡)+ÁÀ ÎNN û÷û)Bá뇱{ÿMœ7~Ï –À…í+Pìû|?îjÖgå½>¿[73ÕsJ:Ô3âÑIV_ùÝT5ŠÏ¾¥ÅkðÑ´YòŽ± §d>Ç]vŸMÝKøÞ±9+˸8;%•TõUÌZ«J¢S c"†`Îeµ5/Õc‘+7n­Dè½–£H.ŽØNÏu^Ï.&;Y­g„®YJ¬W(‚9¯Ž?²hÇvð&–bÕtÐzed…´¡Y ßB‰®¥#pÓ6»Ö3hoEŸqxÙkHu槚ÏT¤ÇÞ§#éSë,ç®/cn`'*sä–††`©ÝêÖ”š—zNf+4ð58uè û*„–FL9Ø.0æåø÷“I½IJ¼0pW9ŠZ/Ò…:½+竳.š°-IO6¾|· sME¢Æ˜\Âl^å¾z=X»×ó£Ã7‰ä>ÓY¿xsô^%iœ2p„/I7ÅzÜjOÛ>–äS}¬õbÇmåM[ßГ [÷êÞ­ïäVëöK\ŒðËû¤Ä‚¿ðòœ´Ë9¼Ø®·^³ò ûZ¸ØÌÙDQ\ŒßbÆBÑnmÒi”›¶ib¾?ÁÿI_#c˜Y:Eá5•e9´¦q¾yŠÛ“A°—&²üAF'•61áyUŒBKÑ6Ål”I&#PÑÏ‘æÌ+®ýqðŠ™ü^*éžÌ`¢m‰¥wã‘ÜÛÚIóí¦2 Œ×gbä™B¼{Ю˜N5t¯*\ñž¢/ËãGÆþº_ÇmwÄ^VMì!ö ®É|ËÌØ"à2¿d8mÖ.ýâgÏ'Ù •N•{ºdÑÛp‰`Y/}v!ߣû‹´Î¥{W·Ôrcêäò8r?¥—G˜ôaa´½'ͤ3ˆê•ºE÷>Š¥:#sIþѬ›gpÑ|LÂ:jo-%‰fKåYÏzW+J’2‰P½—óâ-bÞ`\¶eÐE¥T ÔC¢-—Ðí1Dún°x Ãèø6Vcáý$¿-‰Öî/i˜~ŸHåu£çxR‡L j±Â£µüTC+RóM‡¬Üwgjï­ñ°5»“9Oðb•i»ß¾Y_ðËJœé¥4xso=V¹V¸‹?\ê8°‘$Œ1XäNÙ±¹¼ŸÚâòJñ3ò¯•y5J¤<'@¤H'žlÞøº¡`:/ž“µEð§Ë<|Ó+öfC‚JŸÿÚÜŽ ËAö§Þ‹Ñ¸GssŒQÿÅFW1ÙÖÉ5Èý*–lMÛÝ[Ìü&¿hOhx’5©Øš6ûv®¤ƒhf•DJ™È  0©¨I0MwQ…²M¨³b:cnÇ ì3÷Z¿1Îå˜PT’÷Ñ– ;.Qø”!šz¸&Œ¬è$ñ´;ýÌ~³N,(ÒúãÕöàîaÕƲ°è&÷OÏ,Xd¨ tDéN=•léï$ÚqÀÅÍËŽ#ÎXcÔ-ü·¸I'gîÝ›é s¯X¨ûõÏØtOc©í§òœçøè4Ê`þêw¯¹~$‰kÝ5G-.dC¾NçMÇí!‘ 6ÇÕ—«aã‡Êã¾b.7¶œ­V!Ã’K°‘«ê$SH®J`¤ýòð“ü.Œ9£¼°-‹ˆu5 ‘Þ~í¢JQÁRÍNotê‘2òEÄŸ¯^ Ù±\®êébe 2ƒp1Ñ£ÔT³¤B®ÌëõÇ„ÓÂd'l©Tß&–-8õqÙ+ß™åö éÎó˜ô°+UÈ©1 ¸‰£C8å ÷—‹FqÑŸß• )¹ÕkNÆ8Õ[O”ýäå]º’Æø9}œ-­ÓÁÚB“:èU¹óm´Å–Žßî PZmãúŒg!å6DØ5Ê“3Ý…‹÷ÜÖÞñy>œÞAóú“Œ€81báç‚7+Í“ FOÉsW†#üïÕmOx5¦ñ})ßmHdÊ`×V‰•2}$ÆšŸ¸ÔÒ¶ªHú…Yó™²~ÅKâxï?v!¸¯F…Q‡œÚWóêo§à EPî²–EˆîÌäùÔôç(;GŠuÎ0™ST\ê¾!ñŠð{ÎhÞOÐé©dùÙ¦fêp¸ êtŸ+(H´ªÔ¼?`£Î8G}ºôA`§ƒèçñ^MP¹–ݸšÜ`Ff]»´y ±˜GÞt¼7' &›ª¢yºR¬ùø(-¸(Y}šæ‹¥®W~/cØ ˜±C99+ 2³óg>FP׶ؗ| ½Ê~E0‰Ã|/u¢sõµáÏÁð2sDª ¿$aUE3Þ§R¡ZÌ­Õ„)̶^Lµ1NäXXÇž…z®©µO¹øØË kDK?÷‘áO{£ZCÓóNo£5¬ŽRF³*ŸÏ˲Ÿyß]‘á }Bçy¤¨^/ô¾ ²³Wáj\R¤‡- &ܵ«ÒfIzåxÞïJíöÊŸ‘»µþÖŸ>Ò:^Pxc ^aåϽtŽ[DÊi\k[…Æ„óÀÞ$DìU!ÐÍ7G 8Ú²OCJÓ*vS­„À$“œZJXBñx5úv×T+Ž]bm4/8¯f¨F™]²2¾Ñr²7kÄaͶ/jÿ2|•¨åR02ˆ°V°hÍßeÅõÕVŠ ½7–cïgÛKŒäSËÄáÀ¥®"Iž–É(¹ÄÅmXºF›V]í³q||!¸@×éÿÔ¸ Š«<'mn½jøJx€¤ô|Á=tKJBÅñzŽ h1ÔULç ÁˆÞÒ@Eå…î8¿ „¦y­Ã:dz”~¡(jßK·æC˜IUÏ–Ì›a Ý–8ÆeÒd—…×+=ez\z7êïÇ’zo7 9ätKÝŒ/øíÓ}`x­oñ 7q‹;iJöØŒk¾1¡#Za‰À§å F䋶Ò=0¨ìzú3†–›u6hq†¡Ú”z "~y{¢O]¾º|œø±Úv-rÃî“»ÞŸÍt. ²1)Ò'£05b¢„§"ÏÕ™,‹RNm¾¨ò•ÒÊÌØ#zÙ†EÅì1ª¹Êy‹˜H# ÂуhTéx’!\µïàç€Ël¯Üyû R‘õUmb];>½ªŒhoáDeÍ.#M¹¨TA 73+ ÛdúXuñ¯1@²÷‹•£.$–ó©Ä·&ø¼®“‡¶-0 »S~²*)¡äÉ4ZRâÏ]’â*,¥ fˆˆÔòX .0£UUhx¬aîÓí“ûÕ…±ºõÅ|­6bì³} G˜$ym‡ÁØCÁ qiÎ3Î %/Â’ùñ·$WÚÊ°P"khñzPè#¼4âU»Ì±;N+L˜ÁŠúûÏç¯p§zíûšÖƒ“ ~Z¼_•Ä<­ôPZÝúå1}â7æ2‡ê2ùm ¼™»!.%\_³Â´†§3´/%<£æÃcZƒŽþäk@n ƒ%=¥ëÑRà!×”{·!%Fa+$õý™¹×Ø(;ºWP}ßýb®R}uÏ"B”‚Ð_3ïtN5Nq$491=ª«<³˜¡‹1(žre=É̹ñ iWw‚’> ÿ“.Tëí¸€%9hð[?#½Ífâà.z[´^6ë32_Cš9¤JŒ¥÷xeøë}% À´ŒgÖØAx;|IóByÞ ¢u4@ÜÖ9 ÃÖ­ª’Ó…’–Þã àBNó'þÔ epµi¾Ä5ò`ܽL¥vê}iÿ#9;ñÑZÃCÔÓ󼄘¦lÆ…çq§Ïƒ£óHbé¢"çü¾‹±bfwôã¯ÚÀE6uÚ_šxêBQ:Ä;ß&Ñ(´”&IÁZºîŠéå¾qœb¤ë*{íUÜöϾ%“ë.Vº‹Ô»â´]Ú;9b‡Gg ä1.ÿ ƒ'†~£Ž…bíZ¸÷‰2Ö 1S×Y£•^dÜhH¼ô_*%h&ºK‡FQ?ÁM½Âc°míÄDGv4¸qö(¾Îã"ªcÒañ‘êc.5@Bv—l"SÖUN;©_ðpZÝ®£`9»êmË«›"5{/¥­àz³ü‚ypÆáöŒ”„õÛ Îž¤FYäs"z±jêeLHǦØšpŽý‹jí(+¨·éÇ—ôdB"v.F( ~¦lqÁñÒ!%stAƒMîUÉ’®´m뚆¹ÿµY8X]Þ½™Ý3}¨Ÿ0«¬ÆIp4Ó© ò#ÝUðpî*†jÆ>•Õ”MùFš~aSÕ·½r¿Zýæt^ 2‰ÎB[Hâ=9&X,òê»èǦï¡5C…B/gÅï:r=]˜Ê%ìVË¡]W`}²ÐÓ5m4FïáòÔ\§¸U¨IpØñ&)¹ê®òx]\S¤àA°T¥ Ç±•ØMiØPûÎ'þz"@‡•¢ç©sñW¬}Ǽþvê}¶mió&$°4[N@Fé<ŽW—0Oy }'( ÝzÜÀO블«Å€Ž¹>)µ_I‹¿­ÿ*d1šRĽ¾œùa—’¡™ÿA ­“­ùYù93äýÚEv‚mZ¸‹”oøô ‚¡ Ќʘ4ûÇz÷gÓÅ>~Yú£õ[†ª[U6œkE¡ÂÈ0G­¿V.šK¦eë yðxVrîhÌ¿Ž¼:Iå 6,|‹ Ù. V“· ˧ÊùF§ûê»­ò¸^Ї= 9ŸÆ¶ÿe;¶h'Ï\Üçý°Ž1RÙKvÿƒ,Ê›¨/äúÙú8iÙ¡Ú5ÁG.3‘>1¾wlYÙ‘^¸QGd\™‰Ø)$%ŸÅ43zF×UUèòWÜrz¥ŽÜ Õ£›£hçoøÔ>•½ãŒý\ÝõNÝ$£©/ÖÓÚöLvþ¥“ƒG©‚èÊÈ Ih8ž˜¾ËsÙ×æD!£¨%¡ùP—¦rþÆ”`õò:‘Ú7.ÝxMä`Ù¯ºf=÷v2‹&Na.2¼ŠÒ@Ühž_dœ}ꎳš–©nºkÊ«° ×ýˆ£è7|VFÃh$<É4j;ø»]zåd~g_òã‹úÞêÞv[HìøpGúrJñµÚm°HÏ;Òô …±R>GëZ·“F ÚVþhf¦)š\WÏÄ豈‹Âûü"õâb5ùÐÙ9ÑY–îË«"§{a‰¸ ,íM媛­mJ‚Z3–×Zˆ €×-;[”Ž6ír˜›ÄÒÃsya þ²‘/Æ›j·îÑß<#eýZÊþøêÓçÀê̘¹_\ÌÃñü_ /2ÞÉçøx YК)ì šYsíMÆ´†Ö£s†Œ\5TîhЀZÚÃ/ >›Ž Ýa80,Ä8µb¿ã.Ö7i?Á(Z˜³ =bë‡Ç-v.4}’âÊçÝC¼h˜âf |ûA›cñd¢$Î9M´!ø,Ìå3s>­/OLcéd°|Í /&œÚu1?£ÛÒBkÔÏu+ œŽ^°ºñI`uº·•ycxâ7¥¡{ÝÄcC³^…ûNBø‹Æµ_^¯íËãÀ c€{™Iã1»sûÂ=ÆL-u†£ÁgRSsÏ\(W`L€Ë)x±ÎÈ‘ôµ¢‘;ia®2N ½¿ ¤o'ŠòùóåTwÉÈK´En7M ¦GœbªKV€‘ï¦4½A”õ5ãCýø¾å‘vR ¼ªqáÔL߯oÒ”á³þL#Zï«Tu|ê Œy…:dÊ!ë*ë®/öd&–{7¶oö’A®hîIμC=ÐÊôlk·ÖCuåâË0Jjñ*ñI²bÍÌþÉ/‡K·ÔB;éÆL‹°„<ËØwÚÕì/íY´+Û‡†¥ °”Ÿ9¦¨MÊ däDl7ü¸z{Ž¶’ðŽµ'ÚÎý ‰µƒ^9œ™0&8v†å:NÌÚT—I™i·³ìêö¬!|ã}¸»‡4eŠÉ' 6&/‹)i;¦™t±9¤ÌpS%:#ñl‘ª!–Oy1ïBÅ+zÓ˜ }O¿vlª|Ù-ž§×E/£¼G¡®6ßU;ULÌ ba¦;íë£PƒÑ*ã­Õª7Çû…k]ÿ±ÅÓ< kÀ!!Û_.Kz‡•6ļve—J×gRʆ(j/•ãÒÖ^n%‰Í+ÂJ^,YµUl>Ç=ÍHÐ[à1»ã4£Æ˜PÃ)YYÔ«Eú€"¥1*æoDg²¤+°q-ÇÏ¥þÆ´éôDKé,Ñ䈗 àÓôsMÍ`Eº­_ì(ÉbŠüˆ<ý*-4õŠWˆýéÆ5Ù´4fx—`›÷¬l)Ù*zNÜ„ü졉1Cs{òÖ{:‹¢˜”¨ä„Ÿc ŒÅ%<~ïÎt 5àÂX`f"ûØ‹rÏJu^kEìwv^ ÞócÁIÁ`¾I¢IqG³•cRý|­Œ˜È~ ³ÞÏUGaè‹‚$ÙsÈøü!…óöεbÌGk–€¤¢ÛÅÚÝ«çü {ݨl¤z?èWd-îŒL~¤Ï9èUÐzÊeÌxésëìS剽܋d…Îß«úëkLA°„r$œoG.ïÛñ ðŽ¨Kg¨äÇŒZ»ñ3Mؽ¤)Uø°BÛ?œL£ùñͨö% Ý3‚ãa}ÜUÔRDLÀühH™º_¶e1¹êWAò óá¹WMè(žò&§ÈèÓJ„Î"aZ1CèZqkAÏâL¨Íuo±S˜€Ò2ol}¶¦ö–p0—SxþmƒaOæža×0§÷Îmð](0¢ä‘ða‹ãº(åoí°àEq°ô-ìQÆê§>†5u ‘Íë¸.Ó!e׌yrÒdf7÷äû×g;Ô2uݼÁ<f~S_OýÓ/üÑ„P #Ð`WBßg%ìÑ|!†ÓnwQÌ[[Ø:VAµÎIòùÙœ¶B¡B1•²¿Nï8Š0¸z~tâôqgg2ˆÓuU¡¼Ü­¶‹6‰g¶NðççrjâœóAgü<«p'…âGvC­†ù¾ŠGHrzLM¼[ÍéßL;?¦·+RÉ^“£V5- 9ü®§3éýY³Ã âãªÉÓ«–œoô®Fý-OÄ`_ë %6¥„„þüŽ¼M6­”®‹pî{ýB6BåŠácÍÄ%cŽÉe½uRÖo¯z$i‰ëÅÊ;CÞõÓÐ#SƯLXù·Ÿ?<K¶å]ÿyáß²úpåPþ8žüãÄÛ}ŒVr&&J÷Ï€Á`?ÓýL°±(’¶_¯}¿¼*ÊJÞ–èý±êw6¬*¹náC"v8ŽlœMªÛ€s/y.‚,'Î`”ôaß¹Ót] .{ª9ÎØ~#ގų'Aü®¹ò#õòlG4ÐrìÔík^µ˜Ó6¼G¿ìJÝ‚g=”[k-~ûá®ã³ì‘+€qheªÈTpŒK¨dÜÀíÔÏ«­¯w¶¿‚Ö)ªk¸þÿy¦aiŒ¹ ÑF¹dw¢zì;×Q˜ýPuàÀÁBqƒ²¡)Úe¶”Èû~jAÚv‚¶åäì´.dê–3•¡EÉì¨Øþ· ›ŸÔ`@V\,‰F šø kF§, ä°O6}¿T0}Yº²å;|ûgû–|ÉÃzznË!Cª²cb_fÆyß'bf‹øù¼£iV3G$QOGh7ÚÞ=ý•yÁ…dÃŽ±ÿ©T¶þ¶»@É8?BX¶R×÷媕Ø9ž{‰b§Ž÷«^°KhCš ©z'PôŸ½7#¡¡˜¤U»|ë‹vîû‘ÉA&1%NßQ_Õ^;Y'Üüïö2›\_¡9OS;“èœz÷Õfd4bÓreUÇðÈ«0uò[á.Ù«60PÅÖŒV¹5j™ãTM¨çú©É½ä(¶­Â ÔÃQ¢f¹š®®»é™fÅLR àŒm|_ÿÃèä®?‘òå—·ç z/ÌÐé¾hWŽ8},è§ÐI<¯ òíI~±â7˜º«kóM›™W*A 9ïizA3¦›ý0®©jùQÑÛÊ´¨F•$›æ_cò}% T4¦¤nƒ¬‘ð°©®oo*H“¹ Ó_¾V@7äûÊ¡„×”î Š×<èv¿iŒ¶‹¥ŠÂÚDç„zº'‡!!p¹¹+Ò¨p lï`%*{wEë.¹’î³,EÖcöÊ©×òmxÕž‹e éJ´¼ yÁû1 §>²¯@ÒùìCÍw‚œÓÈ‹EkƯ;í@wͱe¨-¼ºæI¸V ~˲ôÝn ~l*„ƒ7HJ1ØбœʈMóšÌ×»¦Šq¡Ç’DòªmNˆ&ÛÕ¥«–‹z± ô.ùJ©€ÎüÙÏ“GˆÃtD¿}'¥SæR2³¯Î0mÑÁQ«® ú”™Š{èRÒ‡°øIŒ’ØÄ<*ˆã¾‡ñâi5V´Øâ/ʉú>ØZf§H;U'ˆÑî2/ä1º¬½¶ÈN" °ƒßxyÎø8ò°KÕÔ"+X¬jJøvžùë`#Q6ï¯6ÙùCÖY'߶‹"Ó]¿õçzqô¯#jXÄ7ñ‚‚(Úä8™³!;l o0Ó²©”>æãR8ÖxZÀaz’¨³âÜDM˜/“õÔº´6{ÃõiØiË&f-ã”®ï Ê;‹;*•‹5ÖR>;Ø;JV}ñšu+ ×ÐL•AÜ’%*‚mi„w?a[—ÆN¦Q•K)¢¢áýÊÀ<HþÒû“Ü Œ†UΨ£`Â<ÂMǤnWÖ!AKáíþÖž9Ƹï qÝÇo’´xós¡"Y‡+:“ŽlüÂ]©;â_ß b¿;­¿¥OËI±N û¼þ±q•ãƒ¹´RÉ÷wOÊ=FíFì)‰˜-BƒôUª,¶ž½5ÛÓÓên\8ü8°P¬å¦±Íç=Q.0K/RÚŽ§ÐÚK»“‰‘óÅI›…~´Ó)c× gõÝ6¨–fÐV4Ë&2¥"fÀ ð¢Z¦Ó|j5³úÆ…*>9¨ñ±Ý³+'b+{Яòz‰¸Œ*¥¿Þåb3"šöº›\u µMü>ù-}Ë’h˜­¼ð¦ÊÝ^¼Ñ¨"€Éj>B‹þÅè#™ñW`±œ/2º rØ}†Â•>@_sI ?OÉIVèA¯Q'×.·’¥ÌÈdßçEÕ&©Ù @W˜Pëgõþî—AV†°åv½«¾1[‹p2ªpLž7í•!«,Î5•š;ôóâó¿ò˜oßáK.Û¼žwk*—vk×àn¾²Â.]*ÒÀ“ÄD±îGyꔥþ«ÊYë5&iX..}×3¼ßÉe˜’V%*ù7"OäVµŠ3-ç“â‰ûOˆEï/ Ðæz¬¹mÝ6øÔEôÂ*@\¯d“ö “Ç9€,7.–cu©EÇz 9HüôU©/Ò4ûa˜j¯øÈz´Çá%£øGü© ºèL¦¼>“ñ©:]{WÏ=éŸò8QWmWÃ[ WëâV²¾ÙßQ¤ÃïK'¾Ñtæ(-uåàWh®ÏÁ³ÓÚÔo=æc0\W;O¤¹H2Ô Ï߃²ìºß9ŠG?R'”±Ò{ª­æ†?í²èÉ/±šp·5ˆ0³½Z_\\×Ò'šdôPµÏY©‰¸f ïX¾¹«œÐû@ºÚ—öuªÔuÝÖý s?¯…ûÕMÈp@… eT{÷Cï´õbê£8RŽ§Óêó¸2 ØÊíoØØ"Çkùuo”¶ã‡ŒsS…gciÖzt"¬Œ÷EHj¦z ­P戩Q³oÝèÅÓ‰pôˆŒO),j¥¥<-1Vý!¬ùº±ÜàYwuù”饺Ck`HaT#×Ñ+·OÈ ¶’ñ398úø?2e¤ÜF+{šì dÌÞÔxÊjí¨ºH$í@Ø{åŸÒu{|·ØH0wß—!Ññpõ‰f?.žÌÚöýt‰@ ¿Ï²0ãôçU–µU *:О¼m×—ƈÓÑæ¶ ŸÒ5•¡-bÿ–7ÙL©!v¿¯'‡†PQdwj›é=Ÿ‘íÑ,W1I“-¼Kƒ‘³¦DÒ]ØçÜN^ÁÚ?qtp4¿IÄbŠ§vÁU}ly@HÊ~öq"®z!úF¦!5¨œ¬<?ë^(å­Î:Ïõ@Gã»â>²“À§îêûêuØâ®3ÊsoU²– Ssô}b¢gP(0¥åI‡kÛü NgMÎûhÑ°ðõ|§Jœÿ,‘¿´L~ÿÐ^wÙ>`Ybî»]§û j*íä÷U,2ÂÄç ûø¾«Ž(Dä¨y,ïJĘËur_?ªÁŒ•öÁ¼ªÕ’[¦í™ Ão5‰pþÈäFR…“£g dΨŒQÓdå÷=µl< 5„íɃãwÌŸìÈz_Ñôîû5i܇\¹JN-›yip€þ®˜B~šSÚ›8H=»\µ¡3* ¥yÏ„.ïG%biヅ²ÇØÓ&¡ƒWîD_T?/ú­%«¼©èz”õ¾ä ï|ÂéeF'ÛE^p ý…/™´årqc!l‡2Ö§s‹l\NsâmD92HÔ´Š+d.HiÀŸC¶G0o<è _/“L]ÝOÊ“NGÁ²Fzµ4”éQN… U«b¶OVÉT^ÊÞ¶E´ÕýþÒ£z6!åçõÔªSÌèކȻúÛïøéøÕR¨Á}ñËÛ‚“LLjûwÌg‹Ñ1júÙ~¹Ì:¹Ô/T¦ç*ƒ±%Šçæi%„Ÿe ¿´â`'“\§’íyü—†q£¹5ó `µy$²’áã5ØB,(Òˆ¡Ÿÿ„ó2»G:Íðÿ¿±ý€ endstream endobj 142 0 obj << /Type /FontDescriptor /FontName /JUDEDS+CMR12 /Flags 4 /FontBBox [-34 -251 988 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 65 /XHeight 431 /CharSet (/A/O/S/b/c/comma/e/l/nine/o/one/r/t/two/v/x/y/zero) /FontFile 141 0 R >> endobj 143 0 obj << /Length1 1677 /Length2 9566 /Length3 0 /Length 10635 /Filter /FlateDecode >> stream xÚ·Pœé-Š»kðÆÝ!¸»woh¤—àî \Á Á!¸»»%Á ná’™93sÎ{U÷VWuÿkûúöÞ_ýMO­¡Í.e µÉC!îìÜ\Â5-n/=½ØÝô—^äê†B„ÿe ã ²t–ÉZº?Û©A!eG7/€û¥0·€0€‡‹Kè?†PWa€¬¥'Ø ÆP†B@nhô2PgW°­ûsšÿ<˜€Ìn!!¶?ÜRN W0ÐP³t·9=gZ:´¡@0ÈÝç¿B0‰Ú¹»; srzyyqX:¹q@]mÅ™Ù^`w;€È äê ²ü& P·týÉŒ cvûS® µq÷²tžŽ` âöìá±¹ž“´•T¯œA?Uÿ4`üu6nî¿Ãýåý;ò‡³%ur¶„ø€!¶°#ðJ^•ÃÝÛ ` ±þmhéè}ö·ô´;ZZ=üQ¹%@^J`ùLð/zn@W°³»‡Øñ7EÎßažOYb-urAÜÝÐ~×' vŸÝ‡óÏÎ:@ ^ß¿€ bm󛄵‡3§.ìâR’ýËäY„öÌäàçâââ€\ o çïð:>Π?”Ü¿ÅÏ ü}¡Î›g ° èùÍ×ÍÒpwõùûþ[ñß›` º¬@¶`Ú?ÑŸÅ ›?ñsó]ÁÞc®çÙãpýþüýdú<^ÖPˆ£Ï?æô—S]IEEI‰õOÆ뤥¡Þ_v^^;?@ˆ À'ðÿï(óÿ÷?¤–à¿jãú' Ä ú“ÂóÙý‡†ç_SÁô×Æ0þ;ƒ:ôy”A¦&ß„‹Ÿ øüÅýÿ<ÿ¸üÿýï(ÿ·Éÿß‚ä=ÿP3ý¡ÿÿ¨-ÀŽ>F°›<Ød­vÚý9BÿéÂsxG0¤uÿ¾kìÜ\\ÿ£{Þ7 Ãó}âöÜ«?T çuúï”r Ôú÷Þñð¿XººZú q=??À—ûyA­AÞL6€“uv<ÓóØ@]Ñ~wô%?€Sê·è$Àà”ÿñ8•þA‚Ïc÷7äpêüƒ^8õþFBNË€ø7â~žlNп €Óæøÿ¥}®îßð¹ÇÁçÈNÿ@îçâ!ÿ‚ω ÿ‚Ïd\þŸëwý|Näö/øÌÇý_ð™Çð¿Îèáêú|'ý±Ïùþã¼A@´Å9(P$̾6¬õ¦ZŠÌ‹}wLlš~W?™ÝwѵÍã 9•¹ê}Ⱥë•Tê`7ÎʶÓ¥äÕ£ïÁ—zäÈæ·š-÷~æIZ“»-h D}ã…Ru½¨äì:’{~.~zÁð_`;”é?¸xbiäãßxõ(x×õ–/DÌíjîU½TA(Ÿb×3 .™¡Ï³Êž}AƒäÎN‚wê=sy5—;þD¥œÄŠæÏ[äk´Á“p;ûzµB‡Ç­“„ŽÄèü%ÞÈ$ƒ¯ô÷wÊÄó¾¥Å±8MÃ<ùÊÙ¦‡Ñh ÊÔLf»A_}íÇTºe¯6b¼AmÃ{×AþH(§¯å[eêQb÷ôà ¼»Äš4É¡)ƒ¸@8£«¿›Y#åÉ’L"°UæWûÚ—˜B×44&a=£œò7þlÞÚ …]í§¶ùr½Ñ®_¤ q ±ö×5¦%R–ò?à .kd´c¯fuí¥‰[Äš£ülm!Á‹Ár ½‰›“×QÛº×+*US„ۤݙŸô1RhKžÅQëTl¦]ûÛ:¸e+âb%]úV>rJùF݈ßDh…ݼëfØÖŸÝ¿ä þ~Åâ½e7ÕºÎÙ@¡äõÎs(Y4GVpîÔWø»gfÿä§G%JŽ‡ðèÄj”n­©šü×F¶‡õýþfýö¸Ð36ºY*«~‹5Ž!$²—w¸LÖwäJZB0’¢Ìås¿ØÂÈ;µãÞ^Õ³æÚZŽ-iÓ¼=uRÊf$ŸÞ¬Ã&­è6—‚AÆïõ®’S˜pÈÙþœª?þ–5­áöMÞɶ¦ªõ}ßñ’·œvbFÊE§>íI›/ꬬ-Ëâ€/l†Ýïy ÕÁ0ô­f]ctJ[þ5t?qäõÞìÙ~£lÓ8d€ºÇ6ÿŒ{]fJU ¿:ëxždÒ‡þXô6É7Faàz(æ[Ìs‘]|Sˆ¯ÿ/@² 9ˆ“a:jªLºþb8¡­^ •íÃÙ‚øtžR³ä2“‡H½+ÒòRÎÚæ$26&ßíEö¬ì >Î8»¯Yªf3Aʶ96U×,¹À á¶ïÙh~¤Âf+„—ò¯Í•¼> -ØIÞïmV>Ћ¦%êWÉ·™F(U_ô’ݾČsó¢OQ|÷ŠEHmhŠ®&ÏS?îòSï¦8³MÉ;ˆ©¿õdb´ôR)øW$—7e_Ñ^$%Î݃\J=LÛŸp'<°,ÿ…Y!l ž¯`š%ýx…¹Jµù"¯Š%b¬È{Óm³øž(bq‡üÝ:?±‹Â<¨ybÿªÇë×'ÔÈ m$X[9¹m!#‡o,È)pyŠE4d?ófIú¹+†#’N‘O¸›8téJæäØð:›¨É£`ËQ?9„`—×°9È(rK’É¿GG?×a4­ù|<Åõnxi©AHkcË|¾+6iVAªíê ;© h°%µÔ«DßP§{­/t;èØú§ß̘Ý+2 ÛäザÿÇ@ /}®]æÙš€=Û+ïéÈÏ—+é:QMKí*_55SýÏ ”t‹`ˆK1ƒ’çR»Êû¦š¡-WÎ+ãdjûÁž)÷ò•¾ÙCýÈHëV¢zDö™¸Š%â-lŸ°þ¬ŠÀá·CAl”áq¥JÕÇUÝò"×ZüsKŠßMüÞAn‘¯÷i¾öí²ä÷…ê¿çR–ÐÉøˆ^·¦01|¾¢3z’¶ãpƒ$0ÿu†=¯øW'ü¯†W6YÒÌ5ðº“26r‚u˜Jú\¾k[ý 3ÅÇá)ßQð¥k®cFÃ¥ñµHœiíZV‘p±ö;¶TÌ×#/;Ô.®ýtecÖ2>ÎƲŒ±ô.žvMix;µçT»RînÆ Žs é ´i…Isz`xÝð_èéÅÖšCÍ®ídÁû?ë»:@ï©tDJ¿p·SÎnK)µ«ákrŸUß#¬…Xµè]ÂÏ€µ6Oú~ ìÀÇ =Ñ2’!™”|.ËÁZBwÛ¯HRæçÿXdû^àM°­‚beÔ¸ SpÂâôýR}8{ž¢è Ê( v´`‹¬òÚ¢‘ÕB] ÂŒ7ñ+†–cøðÁ^þm± ܾ‡y©}Lä&rвž™¼ÓJ´XÁqUðÝÝ R\I¦ÃÇÕÉý®l1Wé‹U>I± I^àÏ–§UÁÚáú]šî[ù¹-@|¯×mìMO©&Œð,I0z/`´:¶xï?\1þð@ˆ×ÜÁíÝxRy¡V÷ÞÍj$£­K¨¶Éãm´›ŽáƒRÁF ¥S¸©õj·è' ><üʉËòËÄX±__®r<¾Œ‰iAÏg,J¿­eÒ»%-² ÃçÝh%°˜óÈhÿM‰‰-š¼ ýÎw?¹ÝÝα4=ÂSÈ,©_YÀ¨®ûq;œ^d(æ|)9œ•KLŽ¹œ…Y#mѸÀV̱žeN{æü¶ß«õ½a2Q²£¦þŒË#ˆÃ¾çÎR…°8SU¾7iƒÈثحd4¿Ÿz³áDì<$?«qa¡Þ÷f±Z ¡"—õ;Hªë#@ªÏ3†³w\-­ ñÂÔŒŒ@£OUpj^‚MÑ]Z¥šî6ÜP´qsŠÞ´y7îb<Édæ6©G¨nÓtŠ—¥¯æÁsʃG‘Õ¼øÍ 'C\ SÚ¨nPⵎp{«f­É–q‹iiÆüM_¼¡ÂM‹ñ.ìÔf\äñÉ=!8gˆí,ñ캷Ú#ýÔ,Ñž;:ª?£;Q®‘™ùºúSÉ_µ31ZÛ¸½òÎN%sýûÛR>&ÕŠã”ýÊØ4ü\Ž’ b®\Ç4{½ñ¨æ©ZÒ=›÷P—º@à×e½tïØ«M)oÂç‚\WÕ±kì¡RQÍ TS‰ÁqÑ[-.ãU¬é<òÀªM“/õ^ ’žÔs/ÞI›º›< øÓÃJߨ^¹\†¦.V®X„£ßˆ`Mf:’¾Ï(ziΣ&¦OÌ Hç71ÏÈÞ2ºX~,ó^«ê.ˆ‹z ¦¶wFdÝùÜÁÐ,Z“ÓNªy€¶ÀÕ}¥%öUi‚¿Üø‹®Ó!ÏNéµgçm’±AZLÄ %OÍ·xìùf ß8:™[ߊ™Øj¼/¬Hù|æÃ|Ø€CŒÚÈ‚%aÜnÛA?ñv9–&ú'`)#Æql¹òµ*~ú˜ð½[ °íDi7M¬×ÍÆèé ëƧ‘P~¦9mŽ¸‡:‚ЊÝf™f:^Îóþ¡ÆŒÔp\€ÙY§{Ý"¿lÔW×óa»ñ¥¤¶6Kbu·4(Ö1c"$ðˆbÓMб°éŸì"Oqº• @’¬½ÄÛy.#yṬ©!‚r´Bœvû ݇c· gƆT¯`–©iƒ» >8$‘~“2W?É9 Ï—ËÍz–N2“&A˜¥÷U"×eÐRéÛÏ!Ý]êÙšd÷# rQ‚›¯ }$²7J‡ÛÕÊH<Ù·—̪”@ESìdÈðÁŸÓ$$êõ0â?*ÓdʈÐuæ•"•»#25hNá¡%Oñ7F¬é|<ï´¿mºÈŽÈF )µ H£Lç_sÊ$]Ûã½’ £Î‚â7Tu"¸ø²ýZÍq,@÷©!’ðŒj¤¦ké̷ᙊÝ%\2²ò¡æ‚ñQê×_ÁÖjŠÇî›álj½5¿škßâIy =]Â{Y—µsY ‡ë;Â~Ù’mÊPGò.E/, blªÓÐz…D]1åsª'fº§8Óx¥.}+yJ×n·qoÇ°`¬ìö]ˆ.·Bc®*úYÌø@™üÊ£ºÄ~ÿ #P‚¾ÑxÖóè¥#2úÚ~Ô ªlË¢@DuJøù;$¶) ÜÜzšîP©[/iô9˜ ¡œ‚ÓÌÓœ|”PåÜòù³sÃJEÆŒEVåbå¤Êöf“4Þyr%IH­gz/ó¸Èu®ç¥Ù¡Ñ.è»Au©Ð-í{ØÉïNÑHdµr* óÚ’2€¯¹ìUL0ŒÒ+k ¸Ðl£øw´snî*_ XáÒnû˜å˜…)ïßåH.ÆàxW‡¥Ò§öz9ŒR|«Å&,[ÇK)‰L"|ªlDº€G‘ªï™MCÓ"ÌÍ jKŒÑnQë¬i¾ü&¶„õQY‘ ``R”Tá•.Ÿ½uekµà ,ù®‰Æ&¸ëóGÞ-á4Æ´õ<´k8Û录Zµü5Ž.ïH›©z.ãNÂ$fgæg6á|¡S›”[¿P„¿¬8E2 .¤‡Oxì¤v6—Èéz±¡ŽØGƒ×>Põ‹GÍá³S ›žéúe\ˆKW†âiË…z­‡ˆ-#ÒÙ?­é3rùü Ú‘Eüšçdo‘gJA„eà­Óˆ6ÒríøÐ…ûd$¾"bRc…õzï Ç=}aYlXê¡®àßOU}Cç×uË{¿õÎGlýb -1oöÁÓè­Ü+x¤æèAÛMX¥?°mâ~œLòl}âtjt¨ß¨=‘1Y{Õ°Hh#>Ê6Y2žouahcFs]¨¿/D’‘hø²¡€Ì$GÛ`-/*Ú§–´ùýÒ¯]@ÇcÈÆJ¿4Ƹ]òÔSr´sˆ©ÑÄ‘24s]µª ó¡‡È± E@ó ›#—š^äZ´Æ0%1.Ó|ÃcúÛ1õ*',ÆVg¨¦êù¢õ¼ì@ŽD…‰âJ²÷2.J(b/´>A # &û€ pæ§'EÓ€€z {ÎF{1£ªµÁY\‰fŸÄ±Úpv7‡îü5+Ñ{}Ëû£v¼“ö˜ýQé6C Û,Ž]C4¥GÜçs½©Ñ ^—m§± {Ô!TJ­µf!¸áAÓ7#PH5mðaO*!÷³äð•²ç%àA¶³nŠÎ|ÖûK‚ökξ:¯Þ4¹øòÃM,G˜¾ƒ›üŒ´€-»xšØoɵzŸTBguuE.Ë5^r£n)ˆ!ñü¶1ô™/™ªÝ™ÆC… bç ¹ÌÄ·RÊ·8É“¡Êß¾ÉÏ~‡G¶=ª}u^ÎÏXJ4vš 讧ÊÎÔËä]¤O;Tž¡ØZ\Ø»}<³Û!£W}¥éþ…DËý*}ÒP@ž]¸áAn‹¤Ág¢•¢F[@°Eû£7îàÕéQHtÙW#Òæ„L³þ‹Nct‹u0¥ôRÒôd[ &”R‡²´/y=‘Îe@£o éž-‡ÙJÄršñ’äE\­`;dØ)– ¶ù3ËàÓí}Z4§5ÊË»$D«‡ŒíŽ¬×J0OœbïZÌ,]_7Z`½£||ùáãË$òˆÌIÏz'‘ywJ+yصVÃ#²qkîNíy2wÌ<¨²ÂêSè´n ¤E>"QÉíqOüÈ£¢« o ÖŸÓ!ZU÷\Ï.tt÷•~¡›(éà˜)0ÁUñú™·pÎæ}]u Ak~m⟳˜ÿÊx§þ§üÐÜì}æn¾FQ‰ D’﫽Šcj$ɺel@f®(ÖÜ^Y¾èõ ’¼ÌªŒŸ¢ÁàÑÁ]oY‹zM/›RçwmòåËM·å´LÊñ’ŒðþÝbÇÒ”ÔgÌGí6OÁ¯8¡NÅžÑçØöÑõµá Ðœ¢i§¥ãÊF8sÞ°éè`™¬ª1,ŸÝX ª>mZ¬ÉϨAÚ†ÂqàƒBEûq½ø^Ê<¦ÚŸwùŽò‘T¬Ýz£ì™M)]D ³ûá8¥¯,Dj£²>ßX8m–zŠ‘Y:gì\õ—È¡×kDÔA¤oš?HÓž ØG¤ES³Âד:¾Ž•!Èq³ÇÀ ”ˆ Í"¦ŽY‘Cª¹øÕ·µhJü8)<„¨ ¹«—uIÙ:@zP+À/ŸÑ”U€ Q–K/·ð¯•©ÔÕDVÁ{Ö ìBc49×oòv ¢ï=ÕŠ ûò² 1èï,jÔ©¶`8Ÿd:ÓáV®Œ"PÅSÍTP/6z´sT2ðD‘AÈKסeÅ[êóÝj=âú±šNž8­%Óúw´¡!ù Ñ,¼a{-§“r;†Á=5y˜‘Tͦ^m쬺xzqôÓÎþwn'O1M™LàG´S'üÍ™ýô·¸˜æÎuŸ}œí{¹6¢GE2ù4sþ+K,Ž:33Ån_5™íõLÔGMùè|‚H×xeó½Di ²òKhcOÌÎëù¯«935BØ=NÇ…o—ä"«[çÉ®b0ÇtYòŒaaAâüu œ†–\ìƒpŸJ™³ïM<`ïB&"÷n|Onú2䪔Ϝ»jcÅñõ$h£Œ7]¬Š™ÕhðŽºTË“ /%â©‹ÝÜ:Pøµ™ôRÙr®×/¤›²^VLÎù¾‘ÚAUKÅf&&ÑO™î¤¡…y5ŒrÅD–­‹%ìUˆ™4—·Øqhøå"ÑCbZqÂ)…º4¬}!éÜHQÃbV{àÙW¬5XhLù.é=[l0,DXùf}¹s£x1ÎÛr•»¿?ß:7¢_à?Ïn„ôÐ໋3‹|8B‚ÂÃ`ƒÊDŠ¹¸»¨CN×ü }RÈò&/]1x‘|4ˆ';fÇ7&™3棺ôÝÍÒ1 ñAWÔ]K¥{‹D8›{Í”½ªHÚyßÆêÓ)*ùº¿,ÙëÍùv¾PûU8¿u-›cÜô•ìÔÙ)UF ]JÏÚž$å1!XY™)ò«Ü«ÚPyçwØN±n¿(#m˜„Å᧠d´Ó:>4'`P“æºHï)úȾëOúÓõ¿ôdÊ4‚rCl÷ÞE4Iܘ|çEöðpKe("?tŽcKÇÂ9D?ÉËC¾å~Ñ$ôÒÛ+Õ93#·q`’n¼ªeLÑÆéú¦6Ú2²R¨œsS•B‡s¿CßQ)™T¬¤¼2;1k Äd£ç•>Ú•$F>×XëþFt’ˆ&ÂÇœã:»ðFt5xhD¤~TÚ“+²ó­ ãU÷³;ªß¿U»ësÇ#&ÝÀ¦×³Ô_\ܯEœAöFžT#KHNdn¨· Íw¡Ú[X/ê@Œ1ž1vT`? ‘ljw uÄ¡X\ÙÊ{¤Y'ƒ¯•‡-Gúf-âçNCxÖ™\Hõß¾ƒÚ[oÏæiÝùvë›G¸‹Ý8pD·Fìjñ‹Cf½ï”;ezuÂ9V°Ë¢è}¯ –oc.¶¯îÁ¥M„G‚W_\2Êó™Lkè¬*Ò\–³Œ7^@-øEýZX5–™³áÑ¡Á¥ï9’hC‘gbÎ ¨iøл)##Í94:˜@÷Jý4ž'drÀä*¶ËÄØ2ŽFZT;„ßÒü¬ƒ¡zL_9»¢ÀàÓ4_+FÜ2ŒV”BøhX£Âp©è~Ì–âÍY+áE"ªG‹ò®&̨½öJ1Þü£úl²å¥ !c2aiG‰QÐö&-ÏS§ýXŠž9øG‹|Ù´8ÁBDû<1Ui£/ã’U§ÏNjŒH"ßüMt纃Ÿ0‡šXÇÿbÒÜ9ÄDÖM¨‹ iùŒ ŒÊÞj;‹Á·0\W¢k4c/­ÿ k K¹&ÅAÙܤ3\Nʼ“nhZ^M Sr.¤¼nÕsŽ½&yJ7.¾nƒû‹gS•Ò«£Ð˽ÑëõÇdôïsÖ^'iÛÖðÉë³rhõ9D ›ìÏ*>¿rX¡Ó®YQñ"‰ÊëkèìíV-¾,Œ'Pg°R÷\Ën¸|äô)z'Ó^L=Âçå¢VùX¿¾‡A^žjµ¸ gŸ×dvYqCRRâ—,ü:êéÓ²‰¶òQJY¾ˆO ’Z·A·>»k.ˆ7ä9šüÁ$¤!Ìx9Ø7OËáÎ:åô¦ü¶,Žèò3O´G:oÎRõv­lùU–"š¬î ÈÌõþI¯Ú‘×xí §¢ÇM^Ù%”ñgqÈ]Õô¸“¹k’Ñ>S Ìiá#À0RwLj(÷*¨SܹQ¥å;o©#.VåÖ3/ëK±Œg¯¢WÙ$k´v›Ä¡„Ï+ÉÊCSbžhô+›‹¤_4»¨ÃÖëøâ\(®¦=f d‘0&,o†§^˜´x+¢ œÎ¥« ?±wx=²¦ŒÉ œÛÃHázŸ KÒMþé°Ö§éJ‚Úì«ú’Hr¸¥ôç5¦œ’@¾í—èL*®Ò ‹¶…Ù¤l…_)yBWóeñãe­ÂK=ñ\ ¶²^ÄM›ü”zQ¥Ý™‡ø¾?J E»Å¡Þxa¶†$”µFOÜÖ#¡P Žïuää늢£·«k8AlpÕìÌòÔqà7FœËSɉý Ô» îçŠ)´þ®ªàÊ ù}~HĆTL¿Ïß ñ§ÛÂòÝÁE©µ!è´y¿¤\t+Gî†çȸVû®›éB6þ(9I€UÿY—,Ç^!ö µ’ßÖ²Ž×/dw™›F©‡òŽåDbÒu!‰›küÏÇÕxúò¸ŒÖºˆ´vÃmâ‡ôáFbÌ%îŒ$~%ŽÚ ‘ìyùá§N{JdÛˆ.ÇÂ4ú¾ßœ˜?^‚ˆ•.„" lqç †:ç°žñ©öOŒYÏ pøõÅDwE îI­õ§x‡Z¦½‚…UÉRjêÏ/ ÄKðíÔeüFh¥st£‚Ëë$Ÿu>…~h‘;yJ|_a^×ìK‹Òå:YÅ€òe†FòÏ¥0*·n°2—H%èMëÞ¶ˆpÏüxXÈæÒü 82?)˜ót¥¤D™×ùÆÿåîXz6ÉŒòƒ³ãSÁ<©ÿ9ú rœ#i[œï×%1ÑR³3(Ȳr°—Æì£rPfÕ¢àv»OG5BÀ­LÜËÓ/Íñ_í¤N”!P£w'WÌ}+åïˆ%è(ÂO9 vƒ%qµ¿¹ÒOüôH8Ûg}=ÎðÆ| êhm’¢yò€·„%2ç>"ÿ@GÆ©bPlOåß7µ Ÿ-yÑÊ)5÷ð¶d“7 m²5î¾áU„!Ü Ö…C¢é}üŠH‘ÃRöñ'‘ÙVË ~Äè ÔZµø•²µ–%¬þùË¡Oil§Á1¯DJ΃—º,{³ÌŽb ›"•=ÍÚžöÊ£"I1Ô‘Û5Ü3—…ÄØÃ*D¹do“rq߬`÷V7Õ>ñ“òªÿ °ÜëŽÁ~ŒÏåy㌫ Wm/„°pª°J\¬tgb¥¤õÂk)KG ™»¬“)khÝ2AœE¿¾.‹'AŒÊ@®•€™¹BF3½¿¸þΤ“CÚö±qõÚJzÉjç‡ÎþØ-Êiš%N¸ê>¸Íøð«#|(^jSœ®äȃÏMy^‹jð·<•€¡$¹w²îL¤Š>d,[ ~#K6V‡ÔÉ[ãZ{oŸ8/PÖ¨ç#ò(3¬ÑëNb 1Ý.ÅÓ‹ì³Ä1û16Aü;ªÖ‡Œ×ZÞ" Oæ¿šì/ÎÙ¬€™‚ÌGŒVËä0î;œ‡j¹A\ê4B}1`˜XБž—–Õ‚pª¾ûRÎ õ7­óXx'^emm·àÎFÒÁ9 êUí>žo”ñ#TŽ_t²c0¨yÜ_¿¡©äfw5†ºÈÅjDoÁ—Ã1A}øéªSï輸æ {tô-ŒÀxîkœ–—Ëœzã® *Ñé±=`ëÑ;–6ó%¤÷•62²¿¢É¾÷I£ùk«A_Qªœ5„ÔÜÓ·Zîàó6²ªÈ_˜è:+ðÕU˜hÖµ%7¢,Ú iå—é½N¬ (ùt1Fz |üI…S‡@C1ýÖ• Ó_Åéµá½Ä‚…Q¦P†}G°G8v!õn¢÷b¨2©¬ª15_uÂÔ7ü]5Vâì&öˆ¸ZÉø£/‘&eËtˆÄ^ÃÊeŠ)äylrÑ2\­â ´ÏGZíˆ/rY» ÂLÖ‹Mp,Òö²Å"|fI~‰MŠ@/J@óI-VýÃ)ÇìA øeãk;òûÏ$_HO†²â=w–eß:"Ò§+h_óᘮfíVîKš*X¾¡ñz_דR„ý=›‹`Z}Ä,"][B Ѹ€ùê—Mlµ¤‚sz!èE ÞLõáŒÌ©^˜ _,N³Î‘¼£BV½*m¶R– »õ\júžJü*í©g(§Ž;.*1…ßµ2mÚv C?~þPw×i#`»²~a? «ŽŽÜ±åT•]¸ù"¦÷Œ^BŽÓ@¯PpÁ^Ö_>PEš´ÿ1¦ÓÒ­…·þ«ÌÎÃ+jÊ>·»W ,zÏmqsßPOêšáèÓœ7Ø„$p(Hc±ý~îW%m6 6‚•"1-52.ƒfÄXš–s3eÁØ«_îؽ±P{ÐÈ”M†¸Ø.n! õéý;ö%Ól?y‰³2½Ž8c–¢î3Š?î´2ßZQ]ê‚C¼…ÕâdésßV®V²;ÅÀUä¦DïÈÇ¢uS*tùÆ!̽ŠFÚ´Î{±O«É:gÂœ¥æš˜½#¡Üs'§©ÐÔ%ÒÏþxŽä0Çu³ôí~£³ú.¦r$L)åd¥Ã8zÅj%ƒw£?†Œ€+£‚4×sÕá ŽŠøgœð}÷ª¼¥ãP¾…ùš·®z|OUæ. ´t[~´ÆöjO¼T‚S~qÄð²¾ê„“‰/³üÛõ¤YÅv“ºj‰ ÏYåþ&ðÞÇfƒ½šQm Cö¥Ïæ>A3 ÕÚUﱩ©{À“”ÍYÁ À·ís5øÂ|teʶ#’†åA6o€zÈ®0Ç{>ùù¯ãVzêðÇ“tÍ.†,ɲÜB4^H¶*ü½TA£–(Š6ß“¶v¹Ï‚†b—°&IDN^Q‹þrÿ7c4€Ÿû§|êÇ; ûùÉñTÆ°'1EÇžxÎõ’¼ÙŸÚŽø¹s>X(}£%øm fÑ7j=,Nƒ bá3‚%Š~ÝÍHñü쌆KתN´;Ä!¶©–ÛN&1ïnU5Zxq·2©ØŒ\Œî¼D <ðô>m È>©¾=ÊFYô8ø‰ÄN|%ì«2‹ò3žáÍKvx›¯P«äFË„Â¥#ÄͤAÉãÖ¨V fôFÅW_Ìšs,>êô„ª_~1Oš#Š½ÃµÊ~ŽN"¥SÒx x>DÇ ,ÉaÜ73˜O)¥¾XTé0«Á©'¸6qq”8î ý?ñ¥R endstream endobj 144 0 obj << /Type /FontDescriptor /FontName /NIKKII+CMR17 /Flags 4 /FontBBox [-33 -250 945 749] /Ascent 694 /CapHeight 683 /Descent -195 /ItalicAngle 0 /StemV 53 /XHeight 430 /CharSet (/A/F/I/N/T/V/a/c/e/f/fi/i/l/m/n/o/q/r/s/t/u) /FontFile 143 0 R >> endobj 145 0 obj << /Length1 1379 /Length2 5945 /Length3 0 /Length 6881 /Filter /FlateDecode >> stream xÚWT컧S@¤QaÄèØèFº»”Æ0 Æ€nAB@B–‘ ƒé–4èP@âN¿ºßÿÞsî=;g{ߧÏó{Þsä06VqB:Â4‘´0X$P30•€@â" hG»ÃþR-a(o8!÷ßôj(“©CÐ83$ ëã‹ÀRr`i9 ÉþeˆDÉÔ!¾p'€@‰€ySÕžXÜÅËò×Àå€ee¥…~»T<`(8‚@Ю0\F(Ä`†„Âahì¿Bð)¸¢Ñžr¢¢~~~"o$ÊE‰_àG»LaÞ0”/Ì ð .Àâû L„0w…{ÿ!6C:£ý ('p‡Caoœƒ †àrÌtôFž0ÄÆúþl ,þ;ÜŸÞ¿Á¿!P(ÒÂÀÂ.g¸; `¤©/‚Æ …„Ó/Cˆ»7çñ…ÀÝ!Ž8ƒß…Cš*&ߟ輡(¸'Ú[Äîþ ¡è¯0¸&k œÔ0Ú›âW}êp Šë:Vô÷XÝH?DÀgg8ÂÉù'OQ Ü˦£þ§NDñ̆H‚@ iYÌ Ã@]E7ÇzÂ~+Á¿Ä¸úƒ<‘žgX܆û¡ð†øÂh”,(à¿+þ}£ƒNp(às#(þ‰ŽÃœÿ¸ã&‚c6 ñÀЯÏß';·œwì?濇+j¥cª®¦/øðß*UU$ ,‹I‚`°¬8@wúw”¿ñÿ…ý·Ôÿ³6Ð?uÎH€ìp½û †ïŸœàûs]øÿÎ`ˆÄñàû‡ö¶ I÷þ“ÿ·ËÿÆù_QþÚÿg=š>î|¿ÔÿC ñ€»cÿÔãXìƒÆm„·ˆÿ4µ‚ý±Ä0'¸ÇjuÐÜf¨ \Üÿn"Ü[Ž9ÃÑP×?ô× páÝá˜1Òþ뙃A ÿÐáv ê†{J¼q“ú­‚áVéß)5P¤Ó¯“”@P(–7xÜMÆ-§ ó›×Qsààœ‘(Š_ó”ˆâ«_BŠ†ú P¸eû=x\Ö¿î¿7ÃÀ 3“H¨|ä½úȶãZ•ë~Â˃ŠcÀe«ÇüÂ3¨W>§Ô¤iü5Ùየï*i}¯¯Î}Ñà;ºõ‘ý<`³¥ô~ë#“—?Ïì“MG–_RL3vmª<w“ü†°ù­•Às¯@Ë07Âü]`¾— µq!ݱß[-Ìówå³¢'—MVj¤ô(ÏÊG…,âmÃJÇŽ9Ìœ$há›d×ö04ãGßÇ®å ]²ë& Rm%ˆX/‰%žLøÏWš‹yw²p³X3ß$<ºöa„'@u-]—i*àYñ"êCÆã«O©`÷5>ÿeCÓcÔú·»<À!9>fQBz¸øÅVíRŽ‰œ½9ÝEŒÎ7éGo!£ø¥‘»t=QåX ÇŠ#ýÆ»›‹+# ƒÂJÔâ¥hy-Òx…ey÷}¹7äÇÅFfiW ?™ )¿‘mËZœù´”qX{-ï8ž}ä†ðÅ}âŸe$Ç~¬ ³ ž¾÷ôd³F*¥—v­'¨H©ÿ>uÏ2Åš×ÒÆ샖T¯¤ÚhzòJZku;é÷­-FnÂZöó¶ŸÍúéj±ZÙGú¹‡ç©YÑI†¬2§.O¶ÄLH‚äÖß]] âó4K/Õ‰Éh&ÔzÊ$Ù^d.{èGX°¸1{hW\Ñôš5w~oͽv¸W5˜9·Ò,öãþ±Úè¾Ï¦=ÅEkM4ŸDn‹Ç²Ç­Û§a²²‹=[]ˆ¸<W*óÄò~eqy>/2{6ÆÚSr›¨_6øÁ—ÁG¥ÏJŽ£¼f¹ Ÿ±æ‚À)zu3` Vñ"ÚÁaf~øqnm¹üYLô÷•ªgIÚBÑ«i‡£ô„{k…}:—œ}ëŽóÍk åa$‹yy!!yá^i1¢Á$÷xm4Àóä×ûü\„zõªBS©‘“J2 òµ¨2ÀµÛô„7Ù’î[Òº1лL ‹FVn˜ÞeŸ tßwÄS mò¯Õ+`³'*¯&€ ñN‚‡Lö3¥ï>oÕh9+ßÝ ‰»)ËMØiýn kçŽfKD]ͧUÌcÎÊz¯OG¯ ü0 ¹ ~e»Ã‡¦ùÂ(¢ÁæÿЊ/†+ÜÀðCr£ÔÇ`) ùÉŽËaµn–ÂÈ]ð¬dé|¯k Ö™¢Î›öêG™°¡ZÉêN(œV‹[²ß´«gî~Aèy6ukFÉŽåÒùó Õèj䬴ÉC-ËÍÔ¥JDÑÕàþ8·¸“ƒyoÑé0ί*½SbbÇêð"¹Œ¨ÛÀc˜äãQקÛ~ër{+ÏMå£ÑUYÓÌÙí\’k7è¬Çéû¢.¨Î‘Þ~åÖL,Âø³›dâª{!>«Ü…ôø*aºÞök‡·Ù#ÞÏã…eƱì²_Î…Ä™¡³Þkå<®¼2ª×Æ,#ÖîœS¥–; i1x€}”Ã#˜&$byÒí6W?>®q¸Ô óôØ #m¶¸VCãÚœ?VŸ×ÅÂíWl[£ëD*#Øi–¯¡XÚy;öÑÔo™ ›U­™ÌÓzo#ÿF}ˆv{ô!IrÐF„B þ- çe’:Ð å6‚üy›‡$¹½§Jô€!Iáîx«Q„¼¦aQA“©ZæªÞ©0óѽ¶£Œ9ÿAÒ—M#Ãls€ìÍ­3×/ñÞ‚KX,„³kØilßžóÝèRT·qâ¿u¶$B‡¥ós=›I‰5˜ÉPQ<‘4ä~Æ 6Ép«¢q­Xy{-ðFMÈ+~ë^èîÃT[œbPRÚTç]‚~E¼0Ÿqgbí*OŒÈa')§7ÇɤÙ3Ïéz_C<²Þ ¬LZðw`Vîý¨aFzûmqu™žæÔzmßs×8?+û®/R¯mS)-{ìnÜ©hS¶QTµ¾Ûà ªgšÚSÜ™ .',ˆuÄ·¼l™­E¾O—l}%žîðèì(¥_™xÜ`”sJËPÛÉv›ÃæKøÌt>Q¢ÃIŸ/‘ó·À O¦§IäœqŒ$Áü´$> Û¾W5¸-*2Ûmã^XÉoÆ粎ꪮH½äž,.]‰Kª2vS~7€}‰½Œ‘ˆj¥S þ>¿°×Ÿâ¥¨¦Å ØcJo¾å4ÓUGÜ|Ч6‘ W\Œu;øWÕÝÃ4$¥Ï–œYÛ^-éAí–]ÉþÚãÝ‘ÉùÂqƒÉΛ™™ÉƒêU]uÕÏ2›àߨô—2XQüœAwÁÉÛbd´–~Ñë?y€˜`÷ձàZ…©¥—)ßÞ[9|¯?CÞ®WäÝKÊšœw-{ó-­ûá̦š³Fv˜ä©¦Ýƒá8l:Â5ðÆ'2&R’aQ¾Ž`ž‹ÕNãÚbUÙj—˜ÐxYŠ“… ò‡@æO?„dóHñi‡ŒÈô¶Æ¶õ™Ïùޠ׊§WMŒ:Œ¿!$ÕJÀ)¨ÞÝ|€rÕW°#U”ZÑ}­ûBvuy¶#i‡!DìÇ=Qw±Š§¯¿ntH²v§Õuº\Zâ§ô3- Ó/dËèäê Am³·ŒØÏrJ£Ç’‚‚ÌÓ7~0Ìÿ¤“͹¡>Ê·Þ%“Ý-xì ›b‰ÊñÛ6½/#=ÏQ?X‹LöNiavD§^ V-4,2f?îÚÓ¾íÒ;@Ê¥ú8ÈÀ–,s]”ÿœ—Ú’ºuxæRÀoOþØÂùóòm®-]ÞR 0@øX°àÔ¡BfþÓ-ù7NÖ!û¬½l×®cò¬x™—ö\Tð“—¸ };½†toUPŒ±ôö~¥Ãë¥í¡*[<»¤²G¶.¨õ ÒÏ=’ ¸Î)L)¢Öï< ihË®áÎߪ Ý>$ºÞX"Õ’Ⱦœ™ÔûPë!½NF“Ã[g7¯ë [èfbkžÞä׊_ÉÄ‹#ljtJ]nXäJ’EÀB«z»ÏËT^Õàͺ&tVú•QÎBÖ Ýsµ–sïX¯ ¿¢ ™%=N$*(sPÓa[°Ùe)ò<û!ÒÖív) ¿-ÿM5‘൧ݬR~Ūpµ.O£'”u×h4ßwebÔíòؘ^ ’ß±Mc3oönÝ·±ž O-ýÕžé©||àØ$%›¦úCó™³V¢4d‡©Ë’äÎä\ÊÏMô ª×„1ß B|¡JbŒV\ÏÄ+A«›(î*ù%•£‡ï“áo§FíœÏ„(è"äøòj›­ »eð¦[»¶G96u$‡sG ±è´Ñ%ŵ ƒ}„ª=C¯Xº=aõ-„ÏceýQ!u+ úñã˜f<EŸ 4.Æ4©›cª›˜»Ä&Ö?ôä7c˜†L4¡¦Úä6w°­ exOâH|~ÝXº¬;ÙëéËæVjþñÔ¹© ð4ÞÎ{ýGlÝGfçãM€‹ÖÂ^Žqgœ˜².°ÑXûåâ<£pËÝ-§Ä¬aôþŽ®î®.ñeQŠuâ£òõKUma¼`lÛ(‹çć£•ø_ò#c–&kœ¶©hýE7ŠNÅ‹–î1$ tòÝÔÅ7~òŽ›·¦¨Jå«ùqcÓõþr gã»CÇÇÁv·©'ZWRÚÜ|,[-k®ðj<ïý½ §Q½y²Œ6:O•"X#$©M} <|;åŒßÇ@så¾9´õûùyò{ëâ碠—ö@‘v"Ç<˜Uþmy¡Ì ³¥Ž.Ãö´â:r+síSÀìËÎõ¦µì 2’?„•ñ^>}µÿ‚ôølùIAÓt”åÀíý/Š”¶£>%­ªi¤ï¶,øÔ|» ý”µ§Èï¡/ƒñÔóŠ˜1èíÓ±ˆÖÓÆ)6½¼Š1Ñ„úȱ¦pþêÁ¥†¦Lš<ê‘÷u}˜¨IM?ʨ“¤t´]j‘“¼÷ §õŽ+×ßÚºW}ÐOq…lž9ŠR—ë¹mXf],¨“ûäSKq ή3Ë"I‰+w^ÀŸ3^ãsÁJº›ÅíßoþÐÞCJiýjÝ$–*¾ ”óÂéÈ3ÎÊEX?ɱ8ÏóÇO¬í¬? Ÿ‹i©Ùl·g°³R/áÅ…S‰¢¬…Ø|éʧÆç-jµç%lIÚ”Ÿ»ž‰(Þ“Dšf›}‚T¯úúç¸{[éX([\ågȇuð ‚IÃÓ‹ÂåØêǽ¯ª˜5*N4›±HyÐNjЛ{Ê ³£³ÆÃJ¬œý\=iݧµTô‰æ’º¬Ç!ËL'fL·J V¤¹dx&·„KJOò±aˆÓ·²OOJ6ÕjEÖ™/LŒ÷EZ†^£øQ‘±-h…WgfÃj´á!Îlìá».D[!˜j:ÌÜu^ºo¾UívŒ=ºjªÀMÉ0ðu>”ü“Ø%„Œgô{3c^Ø´b±Úxþ÷ÝÚO†ƒT²ŒÒ\åõŸƒßwÄeÏ™×u*7¨ú3|›2hÉ/4¡¯÷¯(›²»FçWn¾¹w8f|Ë82“š;ÕÛxcªk˜¿d|ó5}ÑY< Ôw³ÂsÂéã KŽ,‡Öêfs‹†TzU©Üy^ßêãyíý:"º5Ú^¾•4³²‰þן}ÙysŽÜv›ÈŒÿN8#›Í9«2‘ãúˆá^ I`ç¸ñŒGwÐëNÑŸš%.iN‹Š7ü‘æ¶SÖ˜Mm*2)6{;oäm?DôÄwÿU˜º¸›EÚ¡Mçè” «ÐfEýä6ff¡~B2#Êm àâ}nb:mÞ³wuj$´¢×.ã’‰®ÄŸvM ú*¶ì­Gg³«Å”ggc¤îP 4¯>$|„Zè”!Ò % ©à•V#³}ÕF'R2©Í*;+ K'tÙ<ÿ[öB^c™Ñ¥’AŒXWË]Ã{!;Ô]6†·Òò¬_|¿¹"Ïåê:§'½Ê%&_£6ßXþ³NŒÊOíÚÚÄdÎ1ön›¬z…n¯×€cÈëXëÈKi†vñ±ÞWùܸÄáTl¿ohš¬”¿'97GòÛ Ñg'/dÚ)|Æ…XÓ®Ú ³§Ô4 ì'ô,r´J†»`m‚á+|jáÏ}Tj_{± »¯™C}lÒ)ÓîM*>ÔÈ"ÙŸÈc;V“ö4„TÖ2ˆ :¡LvZG éEå»’ó“>&Ÿ©ýþz+$ð’ù®c7üS§—à†QP+¾ä§ªp”ý£Ú}wµ‘™'«4¡¬}Ä S†4\%=I‰Ï%¨S•|… öÁ«žž±ö_j·ª@{pãЋ´´Ýøð¶ÊýûIÍ.ÅíÖà˜‡r¡QÁ+p¾÷ø_ݼª!5•{"`š¯ÙÓ ¼ròü“ vì{B›RL>èªþŒJ$bæ.GÙ¡>5^}l g¾c.û“Ï}ÙÁŠÅCjÃâ‘6í°Ì9þÜ=“Ss£i* “ˆKöÜTì_±ƒ@çO¥ŽJÞÅû‹’1Tl®T!‘–¡óBkG¾(qó›‰æc‹—¯ÄŒÚgÏwsì6#ÇÔ·ÉK/ñ\XcëÅÙèÞ‡Ó)|Z†‹lìùi³ÊÕŽ r·‘‰©ó…5—(VTíTŒ±é!+sܸsz¯•vÈÇ<pYiRòг–ýàýù|–™P":¨Ðe­ÜÇÔÇuÀÝ?Ê¿¶?ô„½°L Y^I‰÷üç‘uèŸübK¯žYvŒvž1[ös:ñ ÌÐmÏ »R»ÿˆîÌ©ö:t÷Ld‚N‚ãqÇM†srº¼5z¢SM!Zw_!³^ø\€}j‘gÅßuå)MS–z›nÌ<ƒHÒ÷÷PVõëýÏ‘-—Öð«ƒu?½sÍú™o£ÀfÞ «D~L0çä #VÙx5ý l% µˆ¦´Ü¶e³Ë{š–ƒß^¬ü2ÇàÆ$æê Û±Ïò#Ÿ¨jÙX–ù_××Ï*¾]¬ÉŒlèó&Ü›ý>[¸sÑMôD©ÈÓì<äª%×£.9¥WÎCÔœöª9HD*‡Ÿa{åVTMòéÊQù#ÞC韃·ž* FYJÆM° m^Ÿ®®* P’j}ÿ}yç;WÈÛ»U’©Öž€&”Ðœj ÓÝÏr„†ït‰è;_‚¤U†,–¢’'Jƒ4$òûüUªÖ¨­¢>|:LjÏxZ·þðTì ÈC†¼é Xåâ-?zîc@»–h^·ôíMÚ;"›p—€7Nú*†)Ý!äAŽ„7`[Ñ¢šÊT*ÍvŽ>9“¾}]aE^ó’lĆ$ TÍ‹)¦å˜)¨™±»´ù) q¿ú‰Yg3Þ Ïï­ ®Ç#§M9óè» 0¹ãôëÎæ¦@ž[«àŒÊ3Š3Îò”sè!ëV” #íP§[†ðíÕû/-LÒžuU\Açjiq_¥!³`zTùbjpBº\²/açt80nÏ>¼B«„šÚAyIDó „AÀË—ó|´„1&«ª&¼h‘.÷ÊI²µ˜I]ÒH“B €‚^BÔõ„Krž½ÖX¡íˆÈ™ˆMLhù¼¢ég0/L|°›¢X1n®¨aîÉmý0.õñœXSþšV§z5íÉÛ* u¬ÒG‘õ+[w{šfØoþ–Ó?¿ endstream endobj 146 0 obj << /Type /FontDescriptor /FontName /WIRDCL+CMR6 /Flags 4 /FontBBox [-20 -250 1193 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 83 /XHeight 431 /CharSet (/one) /FontFile 145 0 R >> endobj 147 0 obj << /Length1 1636 /Length2 8560 /Length3 0 /Length 9618 /Filter /FlateDecode >> stream xÚ¶Tî6L(1ºS™to£éFº¤Ç€1ºQº¥IiEî) ‘)IEæEýÿ¾sÞ÷ìœí¹û¾î纟3–Zº<26Hk˜"âð‚Å€r:Â@0˜Ÿ æ°°èÁQN°?´˜›;‰û—]Î f…ºÕÉ[¡nÝ4 ª‡Â„‰A„ÅÀ` ,ú—#ÒM (oå ·jðU‘˜;€Eéâã·³GÝVùëd‡r!¢¢ÂÜ¿Ã2Î078Ô Ô°BÙÃœo+B­œ€ºH(†òùO v {ÊE òòòâµrvçEºÙIqp½à({ Ìææ ³þ‚ Ô´r†ýÆ `êÙÃÝÿPë"mQ^Vn0à­Â …!Üo<607àmm ®Š:ð‘ ñ‡³úÜÀ?G„ðBþN÷gô¯DpÄï`+(éìb…ð#쀶p'ð‘¢:/ÊÅ ´BØür´rrGÞÆ[yZÁ¬¬o~7nT”ÑZÝâû;Ô î‚rçu‡;ýBú•ævÈ 9¤³3 rüêOîƒÞNÝôûZH/„ßg[8ÂÆö>îêS‘ÿÓãVøGgCÁ`°°(s¼¡ö _Éõ|\`¿_êÛþü\.@Û[°¸-ìöàçnå ¢Ü<`~ÿ6üW@ @8´†ÙÁ€²ßªa¶È·7ï÷>ßÿúü}2»å– áäóûïËi+«+ëhsýü·IVé ôãáòð ‚Pøöðß,ãÿ ûo­–üÏÞÀÿdTAØ"¢@¸Ý_0<ÿäûŸëÂüoMä-a@öho Co¿ ÿÏäÿòÿÇù_Yþ/´ÿß~=œœ~[Ù™ÿ?V+g¸“ÏŸö[{ n7By»ˆÿu5„ý±Ä0¸‡óÿZUPV·›!ƒ°sú{ˆpwE¸7ÌF Ž‚ÚÿA ¿îà6½ÓBºÃ=3@ü?¶Û]ƒ:Þ>%î·7õÛ»]¥ÿ–T@@‘6¿vŽOPhåæf帽ø[Iè¹]N˜÷o^A¼$ê6x /h‹tüºOÈ-Ï@°_ºßâmÐÿÒ@À|@í?ü·Üó_¿ÌH·Aöÿ ø¿D Èé‚‹¢@ÐíÓù/óm°û?µ~I0OØ?‚·µÜow矀[ÿ4Ë6ÊÞ ö¯vo롼ÿT¼mÇæö‡â?“…z¸¹Ý¾6¿™;ö¿äßO æ ƒ>O#¡âOÞ>m=­’¡óâY‘œ`Y7ÌààñûìÖæqNˆÊñ&;tÉíD&u°›x~Mýøá,ÕßNS-vDs²vË…ÿ¥E’Îøz `fŒòÝèË™š¾{¸ô„O¯ko¼Rû,ÿȧkR2É’oýbŠš Ås‡“ôЛhòød‚4wô†A5‰ °Ç_äg²Ì6å»ðJϽ“†™Æ„úæ1é‡qV?Ù­4UªO~¥E‹…“¦ÅQüóhfJÓ«¸Â>ð$‘jéÌv+?w;ð‡ÜJ‘•³i/7®¸+‚*]076/ÁǹAÄû~Ó÷ÊIëß2v\¾–;­Í¤XŠ Vez@+)yÌ–Âpè3ëÉ 5Ë ôƒ&­òA8ˆ€A›@‘P£6°Ïä|ŸŽ3ÞÃø^Ö• P $“Âï+¼ÄµIæV5¯¨ ££¹Ã}8jj^ðݤ¢¢ýÈI‡û½Ž+ÒѾlÃá‘×VÛ¼ë.î¡#+wò†…tpæ‡ëÁHè}Æd„ôIñÈ”ad2GNrÚT Y'íÈ=ÌbÜ8Çž´èT˽8“× )=  º¤xiœÃÒ©uXAPì/)ë†}vÈö¤ý¤«)Ú÷•o­»à"ö0÷Óö*m"øùÓÁfÅü¤32ÏÆ÷'YÁZøû륔3‰.pǤFK‡ƒ©Ã/–Ïëº*ô98û_ë ñd5mcºæ:Ÿh êÅÎ`5´²`>Ø&~M0è!oC>ïs’.Kc¢këã!€¿•Sêݽ\ܼ²4®y&q ™¡û¸šo´â˜*L5¡ò¼IŠ…îr+`"0Ã6·®—yÃQHÁ¬Â2rãºüLK…©†Gƒ4ytËÀÛq„°Û»o÷ábëä\6™É’ª}ðÁëÕYI{™Ùª¥‘XbÄL‰HëiÏæEr0¬ÝôŠáQþzw~ß=pòàÖÝc¨ÖY_¿>Ú[4É¥ÓzHô×¥,6¿ȧ·6#ò>Fní©ò•LKyGç%w’ÙYÌKÛ@|Tí´/¾~ìëÿ¾t¸ç|ÐLcÛLƒ}—”^'žLm¹Õ §îü„~òE›,^ýÙ{úP_µ{ÎÕ ÃEÕEÙ‡—3¸\æÛÓž25­¤Âе’7C¹'ýîžQƒŠ· Æà‘amîKìó))ïY¹îòŽÁñ;OR~<ðÊŸ0ßNÆ?#Ÿé-šñLaÇü1.ÀÍS ëþÖ:ÑRˆ# Ò‰ZÛM—Ž—¯q…¹v¥u“¼ˆ« Ç©áÉÏ+ÅñVØÛ2ÏgÄQ&pò#[W*3B'¹À~\š¼çWuÁ}R£‘‘l’y! ý*ªô=[³rŒî.ˆÐª<¾P®ÿ¹¤Âå¬Cå†Àñ¤‰æ{>Ú›cµ@N¯fékô”/·ö™ÒjóÂӊÿÔÞ‘¹Ë‘¥åCˆ'0o^çìA§¸Ÿ=ÓÏwŸòªÊ;ÐY¨KÂÀ\Í “aÄ× ÁçgåKF…""%âÓü¾/½ ½í²‘m„›­Ñ=º–‰¦æD´7Y\Ef9ÌV}FlZr)³JØ20.€¨13õEyý§‘±ÔŒB¢ÜO;ôÊvŸl/‰z¸$ËI|nBPëC²Í’ù·¯ñ2õÆùcq*-˜yŠ¾Íª€»”XýÀ¾È; d|ßœ%³éÃ%±0ˇ¥úè¥ZDÎÙŽÐÓZŒ& ±vñи­EU¤žJ}© b`ÅQê“v+2õz^J˜9 Îóê.¦NšïÉår›”M„nÎåäñ‡uyž§/?¨}%öó QÜï)“¹=çàçÊoh.‹VÆöbýŠŒÚ¸mÀž6ìÕÙJÐ]‘Fó =C›íÅ¿ÂØM7éc¨ªOL€'!jצÞK~nkœÍëÏàØIö«s#¹ålšÚáAâd®d¯9À0ƒõðbg™>=ÑÀûN˹Eògúê;Öç!l¤œ_qêÙ0Ë‹û„Ö¥¿¬ï :dòšü²sª2¸[2!‘~ÏN"wy§u¼5hš—6ØÉѼȞ79ñƒ5ΈË1;rç6VLТijÜ7[µK8™Ç.W{è=Ÿ\Ú%ä‘ÔݯäÚÊ"ýMƒîIgW9à±|foÚ>j\…$ƒZa¢m}/Ê,$ζï|ÓàkåTrÅ¢ƒ°•…Õ`çÑ1#ÓÞÄÕF OÈ9àDl“ÞúQúÜão$ûʯ[±'eŒ0fvZRzoJ~êÛåJ8Ö¹– ©ÓôÔÈVlL¿çtx5ÑLbO8­ˆÏ|·ýᬘ3/o8È5¥ÜÅ ( ¢#0µÝ^÷P…ÞOo#TË]?̲O‰óô6sÆHÄßÛädtÛ?Mkèˆ79ôÜ_,ÆÀ¥$,öã­"£&1`l‚6h'Â$Ù&]õPwÔ÷d4×yŽK²ªÜ —LË0Okl™ÿ»ÿFž‹s&˜±¥¨]ßFx³þS;ÍÀc£œƒTÞbTÛÅ÷ínSõ>MÆy…µÔ¶³umcS,ON}ŽÃ”4–µ'%㵆äGоüP'Ñsé7~確v‚Oi]Ô~!¶¿„æ¼½Vº$6u©ÈÉ‹"Þ25Ò:Dcè<_²c2;À0t­Ë>0i,MZk ÎêBLLäÉa¾Ø:ðảÂÙyëÀÄÕ¿Ú?`š9í—<œ䓺Yžj6ÖFôè´˜vÎKöÌÇàâèÂøÆÿRÅÌÄæÕf6¸®Ù¾ac Êü°Òÿ æ~[8U,ç×RÚöç>^‡”WÄ$øj¹D£¾L‚+·vøO1]=ï¤ó*VZÜ3’IËW 8‰4”õ1Ç ˆ5”šœàó}”êºq§¤$ȵêIa,c0ìÚMe0ppž¹DÊ}{qï¸ë.¸ÊøaéYó@©àyÙqƒŸJ[ü †ÙŸ»›¡o‘crµ »Odø$;eϤ÷ [»u"Iª]vƒÜõ?]yüä‡Ñt=!q¸´Q´õ' ?P?a9טÔ“³7 ê£ÀÖdu“á€|á†GÏIxwJâŸðî·˜³ sÝ«¡’ÿì`"]³÷Tøi¼!äý5>'¼„ÖdÈÁì,jÏWµì45oëë3©{ßÈåis¥µ,nPcÈüá#µèÔDõh6hyôqÃ=´ãEÜyú¥ˆ¼gjr],)ò.ž±3LþIñøâA#«u ˜ë³1©–?u"ëG§öô‡­¼“}Ó Š\C^üd ¹é_8tŒˆ˜î5Ÿˆ¹û |3Šb|Ëd½Jä…©î—E W Ö|†¶â€Ãöü]lžvôdªé„þŒî“Þ,"pŸw¯â ðiÇ]ª¹Eß}²Cê¥ÄÆkÇQö׊7ÎÄšgÎ%½1ÿ#¯Zà6¿®ìÌ«Ãé߇ÝEZq¹FÖ ÒR៷兛)å/[Î*˜ÖßÏu".4´À`—2Dù‡ÓÞÏ•\3÷„ÓÞ[àµhÿÄñ}¢ÓE0J —GÊ>Ë–ôÏËC0còYSôÙ?U¿ÀˆŠ˜#Y-+“(r=y8טÕßãijÊâMHVg¸ì±ùN£S/=/-RØ*oX°>N3pe-¹Š<§l,…ÆeGY]6Ü´Œ]ëî‘uÛÒQäÎðëÊs´…ža{ïG=¨#H*F­«s3)|½ö|24}Õ("LôpLb›äÆYºì çiÖjwãÕD‡ñ~:U§ð”¹>8¢ÿ›†eûg#îσ'H ßâ,\ü9M³ðÒëù ,B9ÝÃë顉ŽÓQ¿È³>j>nÈR¡«ªÎœ+îH>Ž© Ö>’ì?tp_õâéöêòõsßG#ÆzirfðÉ~Ðù»¯@5óºâm,«¹ûð|¿X,qô•—e¤ØO-K"öÄk å†~:Fñ+/§$*1ï¨~î=žLNT'¥ÆB@Ï¥8wÄ‹Ç¢6¿WpóÉp–ˆpv{ÑÐä.~ª”^›¸àbJ'ž¼8qSï%$§î%pAêÀmëÉÉó´½èXqűûJÓ%ßØ®Úí++´¡Ø¥4ŠEø«´› —z»‚6©!8—ÍîðbMfk—´à. úÖÇ`¦Á¤2eÅó¶þytcª„7cÜ%Cù…½”ïC»õŠÙDZ]R_zÝSK@h!¢½’X2WwDq&Ù¦å¬M@Ø¢Å×QVfǾ Ù¢ûxÜfrøŠ7ÇÌ}òz«©¦{ cöíèM?†ÓuÝÈ1(¸¸&síw<åÞZ\ƒô‘c”<†ü~OoÒVÊê%ûº¦½NxÇbÝûºuVxÒîEú@:Ǫl%†8Þ;l·ü XæŸòì<â—¶KGȘ¹Ÿüùº¸3L­ìh·’ñmN4´"O€´öCcfu7ç´ˆ?ÛªÅØÏ™.P0S9³šØk†`‹c×Ô3ÕÊ( ÉJ×3ôõƒHo`æÈY‹1/pEY”펦~–iCïR.îÚ× "ú$îU¬±üÚœZéœu!#¼'Ú€â¶*ƒÎ•ø`Ïî„r}óœëH6 ^b~ÿÌÕ™,ŽPË^mTé"‹­ä$¯°l扃àsUcv}O~@]éÐ7öaNùû‘!Ê4öçþ»±ïJªOlhv×Ûwd2¿Ûþ°•²”—#f.jZu²Kl¿J­ç8ås’eЯ1k,ÓU_;¯Ú0c×$—2“‚cïÀ6¦„­¬æ/+# Øéö½ø#M·3MrÖd:ž <·ü`öf/Í?Ù3|íÉ,¤ƒ#/ç*,צM诰b³£Üh 2£*hó|ƒ–­ÔSuNûÄ5´2­)˜aÍ3Tn©s)G³tËÿ¡i æ;ìp˜œÅ®T³Ñ±Tö{#›­~Q."Wûþ[Íwn¸:5 ˆÜâ¶DÈ"¶¬/ÁÆv&•ÅXv짬ÍîM¢ …ÂcG‡Ñyg„#ã3ºO‚%' ¾ØÀWkÖ1 Ç •a¢G‘L]ŠiÎÆse›þšò.¯Óõèõ„LX¾]Œ)ãB‰/ûPåß}ùs³gM)€œ)Ä5 p3}‘¨Î½ÇÏßð÷L–¡ÛŸ§Ë÷’ÐÔ/ߘ×á­ð[°ÈÒ>d.×°©ßeaßqOŽÑzo-6¾9ãK×dýîJrgx^ ã8‘9Pj`ìYÓýN¹«‰JJ£ä†Ç%PQ&4øEjÕÝﵡ²ì!‘/ þ—‹·L_¼I••¹äYb=M ÅIàð÷ñcjâ)†M„d‹Ž¡cç3â3¶Ô¹9¿‚eG¦ïd ùÍL^ó«3Ð 'lÚe¿è¯IoÝѹc©­&RÍ`zz¸?›l ¶?ΫKTÞˆç‡ø<™y2mÕZ:Û•o2ÝQ_„|xjÆŒF\%×®h}p䤡îÇËÐ<´š¨2÷­J¤ÑÖ¿‚çóÈ2ËlNÑ£ Y=ƒgw¨”Ë挩¸:]TtKƒo]ÚUiøÃKî¬ Üñr»ïÔqêj«7ËjY<U6¼#KÚ«mg»´WÌîhY|^ÝàˆY%vºöÜw×iÉ/>ee˜_ˆ'‚Ì©bRš*äðó³8 ü)ô¾Ú#ÖèHÈQÓ° ¯®F¦é£$Xõ•32¥†öËÞÓ÷s:y)Açe.¼¿ìëW392IƒŒÙÅ0ͦ§–™Ï磘†ö»¬˜…N¡Ô…î<ã»7,µ0#¨Cs´ò÷ÄƬÝé˜abKÃemq(f¡„šÏ“ðmª×Qä݆©?©qßeg,ƼütQc3š}uG6OŸÖnZ†dwõ²tïê¸,°’ì^œ—Œ‹¨ ;œÙê> J$@+ê kãÃ^0R’Ûra¡Oøz5¿ b ü‚fu´w~¨i°Ý^Dà}yo‡JJ»T_´·DFªƒ_ꬋœ…ÖÝÅ|Þ‡ãVî.å[OÖ®—ö#ñ¥¨Ë©É€7¢ºÈ†öä-“Á‰ó`ÖDÏTð‡!Y¤PJGõEV™(‡»ÞÚ@×l±+(ÀÏàjÜq§Á«O¹l£$*ëeÚ4ç"Ä1l*çýºm?k ÝQÙ¾ì¸`ËsŠ!À­êdØ“+ýŒá0ÏúÝ„wÁ­©“¦óê÷wάù$ô –=ÔG©µ1)t¸óC6ŠÄa áϾÕ$-W_)Š²ß1¤6}ïœ+6:ÚžôÙ•6µ½çÈÈQ4´¼ào0bãp7†>”,YüŽÒ¾.]ù{Y›Å,#n%-/—äÏs¶f4âN—Ÿi§4kýFQžñ÷:" ¥ÕÊq(I7¦ÖŠhLÚOÏÄü½e>úŠ]BäJëiuѪÂàëå†s„þzù÷NJµì©f— cå¬â÷ws2zõoMŒ6H0ßPèŽì ±‘†"›éßs<—÷w•¹ºBðâ&‹+s÷áø&‰z~6ÒžÁÃK†A5Œ7»Í¾^…=˜;Ú+½Ïæúµ?Qªú¼ý‚"°÷æ04ßbCx&L¤ÒE© ]Œyš“‘qDl°M6ÂdVP‹!ú!V…µB›ôx¬Á³ÝQÁexßH¥L¥è,‘ûáiôQbF Ì*¨”Ùc½°¤ ±Ÿƒm§íG÷Ÿ[|N+ôÆŠÃÎɻąu±b6ß=¯ÿ©ä-›“lB’Àà~¼sÖ5Á&¯‡Õ}%+€&”?ÆßÒ§ñöƒ07£ä³(ø V>{=!k®¦µ³Jàn¹ôÒÐWôï „Ý$—h_7ÄóqVö„õLo–­µ+q;0³´#—¡Ý[É gÕ¬;_Gø³Ûž ³=·%ü+­ÿ…lãjé‚|®lmQ¡€2¶.n).°½—[èHgPïÈ4…Ý÷5Ùù£æñŒ›@ÅH!¥£Íìdï Ãý^^™òV@¹^Ö¼(¦'w*é‡/bB†6iIÜ,1½¬Ò¡Üæ[LïâˆI›ðKJR9Šƒ!F6%ÀƧTra5½:…òâ§ØOòïÖªt^~OOåƒ%ô5ìg[2ü$ÒÓ¢'¼&v©jM‚Ž-猨åJ<½Z“õÑܾ"kìÜ,¼Éq73³1´+<)ÉajU\BoïêŒÀmüø´3Á½s‰}—o¬zw¿14/3rAÁ9¸0™BX¹%DÅEzáÅÒLÝÛ€ð­ÄV6YÛýQƒ10]ÞªwLǬ„KÕöÕxíuó0÷Ì;Ï¥ïèãªÉîPösKIÌ´x‡×‡ [t²:φM5úì /›EXŒå¼‰F¥ž&§Žš‡I IØ?n?*x*•Š#ürþE¸äŽ+—^YŠ"ܧ£}ë~ˆc§¬Á>e5^P]ù‘äA¬'Kr„ŸeJMj¿¡ªàNè›Ùþ‰a¹LBéñIÀ]y^æ0iÖÎýi•„f‰ÊQë÷dJ€øœ¾Ä´ÐZ‰8Å gåiP¡›Í¹õ[’gŽjŽ÷)v:±°ƒ5¢$*^BšêÑg¿e¿CÉÛqì½äÖXWÑT¤¾qU¦(Ùh›ÙºóÃ<½¯š…«¥ûô2áÉ×û£Û˶ üº*QÒÔ7]{Ù_PÑ×ûÉNå+¬-¬ÿ憊G endstream endobj 148 0 obj << /Type /FontDescriptor /FontName /QHLHRQ+CMR7 /Flags 4 /FontBBox [-27 -250 1122 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 79 /XHeight 431 /CharSet (/e/eight/f/five/four/h/i/l/n/one/s/seven/six/t/three/two/zero) /FontFile 147 0 R >> endobj 149 0 obj << /Length1 1585 /Length2 8494 /Length3 0 /Length 9523 /Filter /FlateDecode >> stream xÚ¹eTê6Lww3€tÒÝ©´Äà 1t"Ý"Òt)(tH·t§”ÒR/º÷9gŸó}k½ïšµ˜çºãzî|æÌ :úܲ¶0k çòð‰ä5õD||<||üXÌÌ`8ô—‹Ùäæ†AÅÿ¡—wYÁe VðG3M æ@aq ˆ8€ŸOì_†07q€‚•'Ø ÉPƒAAîXÌò07°½üñ–l6ì ˜˜×w€¬3È lchZÁ@Î7ÚXAú00îó_l’p¸‹8/¯——•³;ÌÍþ);À wèÜAnž [ÀïtZVΠ?‰ñ`1 Àî‰õavp/+7àQÛ€ îP[àñn€¾ª@ÛýËXã/.Àߥy€ÿ¦ûÛû7úÇÙÊÆæìbõCív` ­¤Á÷†s¬ ¶¿ ­ î°G+O+0ÄÊúÑàOàV%Y]€Õc~gçnãv»ó¸ƒ!¿3äýMóXdE¨­<ÌÙ…»cýŽOì²y¬º:Aa^P¿¿Îv`¨­Ýïl=\x ¡`WªÂß"¬ÿÈìAp€Ÿˆr€¼mx“ø¸€þ(ÿˆãðs¹ìS€í@_X~îVž ÜÍà÷OÅ#, ` ¶¬Aö`(ÖØÅ »¿ðcçÝÀÞS¾ÇÁø~þ}2œ-[âóó?Íå•US6PÔàü“ð¿Urr0o€·€0€›_ˆäáˆ<þ›åßùÿ+÷?R+ðß±ñý‡Qjˆý•Âcíþ•†çß3Áö÷º°þû-Øãƒlÿ{3>!>›Ç?Àÿçáÿãòÿ7ó¿Yþ/cÿ¿ñ(y@ ´l¿Õÿ­•3âó·þqŠ=à¡ {Ü èÿš>ýµÄš [°‡óÿjUáV›! µ‡ü»ˆ`w%°7ÈV ·qøk€þÕƒGz Ò¹ƒ?3n ßÿèwÍÆéñ)qìÔèq•þûJE¨ Ìö÷Îñ ¬Üܬ|°ÿˆ„~ÀÇå´yÿ™k/t<¦°ƒ¹aýî§(?€Wï·èðZý‰xmþ~GÇkûð‚þ…¼à@Q/äð‘Êù?øHý|¤‚ý>Æäò(àuýðÂÿCöøä¤òùÿ«L6nnOÇŸ1~¬á¿ðŸw òÙ`ÍÍÀl$^;~|ÝrU#KíŽ5"5ɼõ,•ÛoέÕãz2{uæ«· ÙäN‚Å E¶s™yú;¿ïuèáMIºÍ7þ·–‰zã[ÍXßÆÈzG ¿ËÖöÐbÒpÈlûß¹ú;!7"~QcÎuõÅÓÉ'¾òêVö®í)[ ›ÙÒÝ®VǾ-›àŽ5Œ1 .žbγΚ¦`DƒsÓbpxãO_LåŒ>Ы%rbÄ ¼÷3Y廞ö]ª0àwo§|BiBA‹|N44Îâ'·ûN|Ö¯äýŠÛPÊ4Yëðšó[ d—ÍwKKïÊmï§ ó¨8%/2‰jtÌJ“Êçb†7h‚Y'‹j+Þª?E­Ý¹´ß€´!"ñ,»OíÇkS[Ý…%¶“;uR‚²Rê*àDÞu\íªžjQÝÆÙ_ËÍÑ~bÝH-–}¦O#ÝÉRYwƒH¨`Š±y'êðê ܼ}ÐH£þÙ7«¥Êên½LÝ\0ø2…Í_ç ²K2™–6iCU¥ìpñùù¹£Þ.Fv‡Ä¢Q yB|o¤wlz>É\íîìœ*+ÑÎäÒ;OU2[ǘµb›%DY­Oç1”шcMº’Û“¬ûlWq-ÀO*NšÎÀTV ‹·î¹õÝËk!Jìñº‡jÍçX‰¨¸´šžWÈ%ÌÊZ'm³=ä\E­¼/Æ"/3ÕP ´ùDçÀh€nsUåW6›­v"›SAEC?ùg‡©ç  x÷;½¸¥]2§˜,Þ¤$´d+µD¢X¯Içüì­ê„hV4‚ú¦½XQ¤´Ï4(lì¯tÖ?ì{&Š}PÌðýEÊLðªìŠð5Èÿ.B;…wÒú(¤š2¼íÛÍþ¾fy°:îú‹Æ†î0Ñ©ðfIvÍÊöИ° I $ç”؉¡w‰4oð+´mæ&ú#$;tÎ:!vÂ5SMì´©š‘:E»öüc!@ûØ¡u¥ó‘½t¼ãå|Ü#„ú€Ÿ1~Ÿ‹%M Ii„ÀjÚÆeO‡§…‰žG™´Ñ=9¸X ½9A\ l¤@ß5ÉF@¢)O=,Â/ä6 Uèw–F©;(}ÍŠqpMÑVи^BlD0Ê©7GýRùÎ%ÛGœFeÔÓÛÏ%ˆÈFƒ %ÿèÕ²ÛÙ¶4ADÕM‰Ù ´§©eϦµ—žbG9h’–h‘Ñ$*8”ÓZ©Pn{~¯Æ߇á"Cqpuªæô[:õŸ/( š:}¿ˆ‰·ï3=‚gvt0´ ”N<ù:0nÇÕ=øCäò"’)ÈûÐa·«Õ¹)®õü…ã{›§º'â hze$s¡Q`ÅÃ&‚æ鼂Ƀ–õÏÓ<Æ,RÂh`ËÔbîO q¯»šÛ›¶°ªEÛ|)U'öäS˜aÍ“·åqéÚPQêŸzöLï$ZÞ Rgð'²©q† žúÏw`(g&ïNf~'Yu›ÿ8Br òɧ"¼+áíãäâ¶ðj{–p%‚5»¿À#<üî;½VÐHÓðþ~x²”ÊÐçÎÀåW;|ö¦!.ò‡åm2¿`ÉŽ•ð„{É›ð2´)í Óx6æÉr­Ùªì©‹Û“/¡·%føƒ.ˆÜc(УÐÅÖôhðâÔÊÑ;Øôü-céJÔ²kI÷„ ÍÈôø-IÅä.ûR½úÆÍÌë<¯åÍKæ#ËéJ¸ØMÈR›‰»$ÉSYýaòav­©Ìܳ õ_jõž¶¬Gé"#àÃeÎûº%ÃåÝên)V| ¶7“ÆCSÙˆ/@Õû⊣ҊA¡mçöd8R„§ó»´Ö|Œ¡c5®ÚˆæhfAmX$²CWãhÝšÃIçšqÉ¡°rúo¦¶èȉ@:ófËññù\D±1ž2™Ézºtêè>^Øbo¶êjÓüEc.•°(¢÷m=ªóOùÓçpØ¿çÞ6•V‘y_×èí#ü¥è¥sR(úó %£¨·òŠÚÞja¿°•œ‹^;°S>hEΣ™ ýÒG=¿÷Îoý 7:Ô¦€cK¢d$=o½µÒ‡1ª¸÷¿!”)ìç&̧qü.k·.ö©ÍèÖú,¯“HÉàfÁö£#… ÞQKSê&èã¹[”‰ç” Ȩh" EšËiéðYr!ÚµçäŽ8pï¨w.¢ÆTÈM#<ÀÃàÄÓÙQ~f«ÜZ³›HÜ>{í°£+ü³ÛHû; xd{'i¾ Ÿ®’ÉÜÇù’[p˜›kðG&¶]¨Ò…÷³_x±­å­Ÿb]Üž3Ä »rÇ¿ÖÄg="¾Ë뉟_aöõr6¹{|RÕ/HAÉèμ"2z`´8tÙÈTüêi„––Ɔ’o`q¤~Áï$ócà8}ò Ïš„­ûôš †œ9§`Ån¼‡!&6ÇÇò]¤5ñ_ÎIï%$i™Ý_}`àÆz¿> úR®Bkß7×@Qè"’›”_)þAkNW–Ô±å0lzÚ8ùGð±®›?éX§ååKýÞþÁKQ«$£ë~fVؼ'£!CÅA±­ƒ®tüi^ûvT²=‹ZÞ“#úb ©A®Õ¾G}sR–¯À%×±!Žþ}Ž…çéqñà2HøO};­·Ä)~®&4˜Õ¬È2}«¶(WPmƒß£z·ÂY>âCO:æŒ |ÁÀ8Ÿ\,ýáy€ HÒa)"ó–Єư»´÷½¬MÇ1B©l‡™ ­„Ö¤_½àÃaÞ-ŠÐyÅf»FuÇœƒ‘v[V€¢úÚ -Ù{×W›úiȬz¿¤²ñ‚ÄÛàJˆ–ÁÚFÜG”AswéJ‰R?Öãh%8Lršc_/wäF(Ãb@—XŠq³ \²O£§©S×û‡ø­éê¡\ÇïìJÇ ÁP [§Ï­V¬§âe~ÁåLV^ Î> ØÖ_]w"¤h>…œ/m'ü2YŸÎ!C;°„«e•“ºö¥u «eç½uòè—óùÈÄYVS T9аúnýU#ðv+2-ýGÈùV/ö3kúsvÝXÂYG;(zü ‹C0Á¼2MbÄ,a1æBT|ŸË/âãG©;d5|Å~ÓgU M~ ="‹Í´bÔ¬jAËÙ—c[7LÀ³Q cŠø8”óU9Ÿk¶g”+™t‹ø%Äý^ eé•’êƒÊj¼ Mè‹7éž™mÉßK·¤˜'y¬¶}ÕÃâ#+}4审 ­úN>žŒB|±fŠ©Y©.WF^ëúã²Ì”4õ·OÖ7éQØ8±L¶Ì©åæâ:àžš~k7Mêwð1§Í$Ú\ÂSûÜÛH×>=3‰ÅW‰7½‘cÿs“²Ã‹Æ ºöÅo¯EW¶Š\\Ú¨lŸ¤ªò.Æ]÷ºï4ö²Ç(ë¡~+¨EPœ-cÐlàИÝ]òKmnÃê».­FéU,Íœ~œCÜ=Öš¯–Ÿ¹Ó XPœåÍ<]Öh¯Ê„>W§YÎPªâ>ðxÈj ’wÆ VÃenwß{¤ço¿0^™"ëoþ*û°t -èv]«h¯R:.åªpþˆ´¡X¼ß ,ö4yò¶DD%ŒJ6eš¢4~Vé·1V•+m49¨UÀå¢sa´ ÉÁ¶³Ï–P½o]éH–ÎgL[›œ™Tðûˆ£q ùKq‰«GЦh¦Ã‹* /uKê×N ÉçaoRkõ#þÛ#¤–¨‹­#‹g—(†²F"UÞº R¦#Eµ!;^!D=þbÇŒå>¼º)¨ ’þTº* ©­S2çãƒfm6ФU–¥˜w"ëµäË[hå$CÁ^­òÔÃí²ŠÙC®@¥]»\ ÊjOst²˜Yòñ¾LgKÆ=Òü[OÍg‹˜tEZ”±Ú;æ†l8vj¾‘CtØu¬Éµ1NêqõuüÃñaV¯[ÈúBòŒ‰ðfÂLòÎîLhB&ÇíCm»0 Å&y7üóÎ&F[ ,‰È–X¨žXfT…JÓn|‰G”g•×¼ûvqx‘"?~.ªVº<‡¡–ÔJrq$ÆV“»ÀŸcš5þ›_±bIp”_¢î¯îyïqHq®Þú¢¬fУ3u~€Ì{‘éñËËJ›Ý`‚0¼:M(Ç^»ËnDŒ¹ uü–AVÌÊÒsØâÆå¡s )‘ˆu@Ó|ëýVaS?zÑãý‹þÜNå…Ý@z­5Ô౞ü ÷‚Îàè#Aª±IØ`”–z_øä#Z̉)Í»„͑Ùƒw¿dLÝgœ^^ :©5ŸÈðVék—BÕÌû©¶Ž|ý€yµ¨Ô±o?Ý£fnq £F¨ÝªͽñGakˇ¶yÉÏ4úX-ÛZ•+—yªã*o­MOÕ¶E‹“)ND8Y‚FF²*ˆ®bYžüðS¾>*Š—~i%Èé*c‰‘`ñ÷ ÓÄ£hB¿jïÊ6»ÈÆÓ×ÇP,ÀÓ€8íòÜEtkeSDzȼ@$˜ÐO; ž×½ûQÖ?>M–ò9Ù&3ãå¸5»Šs…؆ØÖzÄHËq~_‚ìK¦Ŗ=ÒuS†œöâ(­¹lÂñÝSù¨ ‡ü@zÉŠ*QV‰5üÆ-ÜÉ&å™kÛ%aú…¡%3F‹&^~Îú]*gxûesF>ç@ÌUù<”Ð#`5+'¦ê$æÈÒBòö­Â'©KälŒ€È¹ÆE`”€ôºX逛ÐÄIu’¤¾Ï'3kÃSä°N[¯I»Ž°o\½~î„ÊNð.8z¥µïÌ»Ê?Á࢛r’i¤!fN÷+Mµ´%ÀC­hCþgQƒ°óÉ‹ŸBðqPü/b³xj†Ï_j.[îÏZ0uCH)µ![ÝÖ…ªÚýÕÄcKìßœ@ŽN|²"Tc?Þ™×Øc4ÉIèÐÌEÉ™®H~åY4£þî…¬ºW¸çÔµ¬„êòÄœÔç×]TH å’€Ùî̹« w£,DÒ‰!ƒÜpÍÍ»L´ÊÔ|@ÄÎ÷p=mMîI»9j&Êî—JÓÚÊÖ])¡§›f_ßëG”Ë ‰\á`‘Ä<€`N`+bÈÉ×€åàs‰á3ýTˆº¢LÅWfr´žB]Æ)ôÍåÓCf#…ÓÒȊ踦 Ò°‰íFŸC† >²bÇ<¥ôõÉûl×b×om1ŠßòIÄÇ¿ã5EìŽ>}Êä [·3ÏÒ~ÚŽ&åËÍ^þPþÙ–öªÈþÄ„¡1ýódžR¼¢ÊD†Y „•úoâõ›A’ƵÇ#[ 7†¥ ¢žÛ—GÊUrmÐúøNu͡Ȭ[mÚ›˜tÐÙíjvÐdpâ÷.#i˜žÏké¥4ÏÜî“{Öº#ÎvgŸT¡M:q—ì Òž“= ×fÃ>ÃXü«y÷”,2ÃuZp‰˜Üû+)ä‘ì“øùsØ÷Ž/Æœeê½ ÁñQJ]=ðPßnÞz_=§ —×æ¾\Ù.1N–:l‹8œr’ØŸ›n–† 3¬¼ð:OÎÏçûÄMß=äù!«Våâ æœQÙ‡¤½q—ºbdsÙÒm)¾ÈeÔÓmß+ÖwzGqíìí"L•_µ™{³Ð'¾tÊImR¼-aŹõSrNù•f^y²èlÐå7úÊ! ø²Û$*1•­—®šèÎ3®ÝNE'žç4–OA™!øFyÒ¡ó8•S¾û!"±}¹T»t?ìQ{æ£*“Ç`wR¯vV¬(\0K(2¹´á•™›Îküžó¹Öi˜ÑˆÆ^»ª´qÿv&¥‡“0}¯Ûª}I“ÕÛpL2¸«Ô5ÁŽ¦Tõ½ô/Á@+Gå‡R/Ä™wa…ƒÓi5wÖ¢ßüEöº^îî['u#ÊþìûÄïþTæÐí›SËèÖÔH85´rîË‹’èÑ[u-»Ð\úêÍ—Â|½A‚LÍ,ÂI終b+UC“÷çëDÏ•«´ ô«BÄJ³YÓY”b˜N G×dŒbÎZ;ÜP®AZìËðâô¯Ïˆ‡β¿ øÑZ¯ÅžoCki³&{WßÕ/ÐûS®É³j[ßYŒª»<)«¿[à& €¹“ºí… €î°·ÈÞw ìG4eq^¢˜ßa”†•éá`nzYmêôZÄvêƒ&?Vzç¼ÏÔß7%P¥Hf‘J‡:#&šPŒ|Ú,D@h¾(–Im¡H3 E.j9r]¥®÷¿ênªUcÝ ×f–ƒµÄ1|bõ²ùÎ4Û¤ÙsD¿\pàîAžp‘»Éæ¸&~:¢¿“ü™¦ÕÙ{`ÕÞ/]Y¬×wôUY¯’´…Ï!¶Šj7ù7óý‹*KKmIî¸ÇýŒ‰ö'ßš¬«9"8eê¾KŒ†ýtÃnlˆÌÕTA'˜s˜Ì=óNõ Ùâ.‰EºãW •ò6þz³¶OÓ’(]LÚŸWÑ‘ð*ß9¤ço ÛjÿÜV¢È–ÈħaóD`ø ¥}"q&]Sê;òwV{)±¢Œ¹5@×€£”([]h15lêR^Íä>I ÷¥Æbþ¨ge4é+ö ƒc‡/wvLIF™OßÞ† U™w°É?Ÿ–t1¿íŒ0Eÿú“êǽ9Äå5Ï}íƒü‹O_ém–úå>+“ê–î<Ü¢à]¬xÆ?±Õžˆ1j^ûpZM}­c#:ÙËßr¥À.ëÓ_ÐýÙ/i Ûe€5€“Ù'«…Š«xÁU<¹KÒ¯]ÌCoVÂÓÈÈ^.µ¶3ªlOz.4éÐ].1SÞÄþ”XT+‹Si%¥ 5Ñ¢g˜®pYÖ»Ö®jزq|{;Um4OrQÖêmê¾ì´ÓÎ )‘ª£?«Â3fE‘> ÿ-–kb¡Ø_©p~}¿ÑÜi©s9vr<ËììÞÑŽÃêʹ²kã¶5JZž w%` ;^SùÌÏØí¨ýÐd/ÿ˜gÚ³9—,Õo^ù›nàô&´HÛ¦ o¿eÓYô$¶ØlÚV?á/@“Ç:š ª˜ófÏ*­ÇÒ—Þòè‘})}Lñ9ׄÇüƒT·ìMÙ1qW9ãôÓ‹›á- 3¹aO¢,-Âh2ÁSÛ£Ÿ¶Ð\§´ ]Ÿå÷·1ÖEWæeãC{;ï967×_D5348¶‹`p¸i;£÷° W«Èô9 ^fc—&JTw5ôûRÎû“]zÝLãàT(Uš¥‡Ü¯Æ´ÉDdמøÞ}Lošr´ªy×¼HĬyžš9¡Äd\ëäÿúU ŠGw©ƒŸï úÅ zÐÊ9¦ÐƒóRC`•á¹\ñѳdéÙD;Æs‡36ºŸ×Ág[+:OYfw,MÏ–à{¹çùí|9,_e©ªÁm’^Ç|Ý…yÒ(- ”$z0m%Ù ÆŒ…rk!5¥ˆyC« òÔ0ˆšDÁÞ^Ž)1†kpƾ ½2Õ^N§äúb°®‚®iµâŽÈýÛÄoà†Ò™È;=‚FÇ_ÃÃy]Ò³ó©8Áïqž¤™ç£eìφs¥ªÅ:–uH¦AÑ,øÄm¹•ÔÅÞ~Oºùì25(µ1;J>¡´‡îïjH…ÏÏ ;`ô/0ê£]¤|À ïR@dº ¥¿„À€—ÀÜ‹±FÕ*´“‘Ïzu•c/Ø8ôp/pv1âÙ!w˜Øêþ®ä;¾Ï+–KÜ„ iÝ·.O _HÅ–_&Ú9äL/G²ý@I™÷Àâ”@¡Õ½NØÙöBïþÔuá¡¡ ·<ÏuKöaàðm÷—X‘¯¯¦»ðÕ“¸’×-‡šçU”{ŸVyસ[©z6Ÿ™¨»ãE6æ²ìß›ñÄ&4í  x™±çælJ¨L99?y ûUz÷-•ª¨dØÆÿã$ CèhÖ­É”y‡Ž¸T‘k!Ix +H<í§…úŒšYÝðøÌõä6_«,wiQÒpºÐœ3X‡û³‘ïŠõ;áÚkjꄾÆ4Ä‹~/vU…g?/¾ëÆe 'õ§òëÈò—X8ÇÏ”$B>hŠóHåXS¬&4ô1MjÏoÙd˜2±-¸ÛŸÂ5«’VGcIrÍýäV²@B¾º?"NôQ öÆIN§õçÎSÕìÝH˜Ã©É}?Um ¯#’…™=ûù>׳Ê/‹°Ÿ·ËAËràJ·‹Ö‘ m*ß™›)pvè{ÉÊðã–Ÿ†%l^ozen…Õë ¦hM’ƒ~µ²×$ÄdîpâKÏu’zËT¯në÷—>üàê]÷écŒ+±¾D ½7ô[èëJ33> [“Þ ,øn&pbj3‹ú÷¿g}˜Ÿm²éš«dåg|ê~«ÍCC–æîÙ¹s”ษ¹¦Õœ-ݪ”l¤À{ñ#Œ endstream endobj 150 0 obj << /Type /FontDescriptor /FontName /AJGTEL+CMR8 /Flags 4 /FontBBox [-36 -250 1070 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 76 /XHeight 431 /CharSet (/R/a/c/d/e/i/l/m/n/o/p/q/t/u/y) /FontFile 149 0 R >> endobj 151 0 obj << /Length1 1596 /Length2 7400 /Length3 0 /Length 8461 /Filter /FlateDecode >> stream xÚ¸TS[6Œ 4©Ò{@:RB•Þ{ï†  ¡ƒTé½wéE@z"EéHGŠT•òE¯÷¾ï}ÿ­ï[Y+9û™gföìy朳ÂƬgÈ+o‹°¨ à(^ Ÿ€@QÛÐ (âÄgc3‚¢`¿q|6ˆ+Š€KüCÑB¡1% MÔFÀn0P•ŠIÄÿ&"\%J w¨-@› €CølŠg/W¨½ çïK'˜ {ðÛ ïq…‚Ap€6åqBgƒ`C Ayý+§” å,ÁÏïááÁrBò!\íe¸< (€ qu‡Ø~• Ð9Aþ”ƇÏ0r€"ÿ2"ìP W À `‰vqƒÛB\èìCu-€®3þYë/ÂÀŸÃù€ÿ„ûãý+þÛ#œœAp/(Ü`…Aº*Z|(OÔnû‹‚!h; Ù  ¿·¨Èë@è ÿÔ‡»BQH>$ö«Fþ_aÐǬ ·UD89Aà($þ¯ý)A]!`ô¹{ñÿi®#á÷ù{e…ÛÚý*ÃÖÍ™ßuqƒ¨+ýá !üÿ`ö@D@\TT€¸ ž`þ_ Œ¼œ!¿¿at ~>Îg€º ˆÔ‚þÁ÷A‚Ü!”«ÄÏç¿ ÿ^á[(°ØCáøÿ‰Ž†!v­Ñýw…z,Ðò~}þ¹²D+̇yý‡þ»ÅüŠ*jZæZ<JþǨ €ðøð ŠxÅE@ P &&ðûwœNàïê£z èŸÝýWDu¸ þWèÓû»÷?Êàü36\€gÐA õ pþGþDÀè/àÿóüvùÿÓþ¯(ÿWùÿïŽTÜ`°ßvοÿ;È óúÃ@ëÙ …ž mzBàÿK5…ü5ÐÚ[¨›ÓÿZÕQ ôŒÈÃíÑ:ç ó ÿ…C‘*POˆ­vøKK7…CôHè¯ûÚK@àlèÑ;¢ï-HtË~› èÉúw^e8aûkED WW>Zè•ÀˆžU[ˆço‰øùàÚ€®Ñ`‡pÅÿÕXa €í…ð°µýÕ1´ù·( à·¹þ ˆ\A` b÷ß<¡?ð¿ýÑ;æG3 ð?˜ ƒ¡Ë¸¸¡þ7Š p7ähhÀ †‚:£‹ü' º‚lKåŸè-ºÁ¡¿dùý×á€Ý\]Ñé«}r¯߬ Ov– yú:¤ý¢FžÎƒwã=öòJgD¼Y_¸ŠýÓ -œLÕ. Ol«¨‡ÓôfÊB'¦}鸿^Œz>îÎ\JUËCa(÷­)òæ~?鶇0Ú"híÇÄÒ"ÖHôˆŸXܶàH2¾|.Ö#´õj³ðª¹e.¾ pŸ‘0§Ò¡bäs;w1£Ì˜YWPCfIbï¹Z¤»©]aFAcÏÚ£i¾{­YÄf -.¾ËîïK:.Ðì­­ %£!÷Ö`ÎN ¡HÈÖhBb°+ˆœ)–¥Ä³Ð9…²/a=[ú9YÐß–0 äÖ`¯£xW÷ÙH£[BdZ:·gé˜Þz=Ëè;?!usb„Ú4V¶j[Œ³¡ôƒj!X^ïmJFv]çüö$¢¤ôÜL s®1çY°Õæ8õÅ“˜Ì  eŠ4ìáÀç— ¢z0Fça;Ó¹K©-™ž:–óÓ·áûø¾½ìƒVŠM/å)\û[“•>{œgó3öÛÖiÃAÞ#ùºpsXDr×ÿ5ë—# æý±ôéoÆ÷z;8R¶<Õ~œÝ>$³R•` )‚U4Ɖ´*.öSD[ôƒ´ÚO›q]{FìO¿-Î%…×­¶tœ–»((îsÌ<Z«Ò`÷¹Mnâ¯Døíá=BÐxCà4œÃÁ®&«9GY°kÁÕIZ÷CÕùð¬—~‘¬µ–ž_cÀ|ŽU¤ò𧻞ÐÂgþGº¢ï¼ä]µ_ŸínYšºÐ)i·`‡› /—œ„6“˜ÅM<ÒS>Ôº\³l¹[ÕR†PKñÁRy~ !Üáèjw£ñmC^œý0Õab0ÈTN>.ÞÏh‰›Ä<ýÉž¼–cR¹¡|ì¯EŠià|Ũ’ksT\5æÇ#T¼°Í÷pâ†Ð»ÛM!‚yìƨ³µw÷™êüÎa²ô`î¥p–¯UVþ•›–åN¡ë$¡%!šåºƒb™ÕïF¿ž|ýs‹ú›éµ5jÒT2£kä(}ÀMŽó~9Š{¤„lò®ñ‹lßµoßôý@B*¥0¬”Γ‡ž·+ép ? ÕLåK{ªV%ë˜çL–Ư [‡ÈƒMuióî­¹{‰²=uÉL’ÉÙµÒà 2Bú×J*:³T|oLɤš0Ø¿ãn ˜2St;[_ÉŸ†hRÎúAîåp6q‡ã=Ê;Ø–¼ú…žfy]†Çl&Y±­ú š·#'ø\(ØógŸa´†[•W;ÖÎò|⼌̒û=¯¿ŸOøDÿ \Þd*O}&”èÖU4ê œ_«Ÿü<åSN¨S„qàÀ†ü^þå0€ÑòiE§2h}£Òdn}t ¸ T–iyº-;õ€sÿØ•KJw M¸Ñ wï±.Á6ø2R'o°ÂÒÛgÖw>Ç뎧;oq=oï–,ª3OÝîê_wŸaw$ð"¥lPKôr–¤Uü´HzJ³Ì—84±¬\̲ñVU”ea ò…,y0oצ¾.2ÐÛfÝlj‘¸éøÈ5Ø«|f»È–£²w£‹Ž·¥‘à ?]€í(Ö/l¶‹.zfŠÀiøyµù%íÛ-¢‡coNgcÀÃ' còYÌÊÈ,-µ¢­š §'¹\éßp\ry>̓ͼRúÞ·åeÝÂ'³Ö‰¾zÂ+W‡#pÏûŠŽã4{¬vü¬ eX:XHl+»Xûˆâ6g°Yðó·çŽ:¦ foöUf¤¶üêR¿8ÖÍ÷â,ìsÎMY ΰ‘`Ê_^í9…´aDù:#&ßí• Óèo´RT…ä{åù&Å͹3Ý;ày_˜Çø6Y¹ûñõ,V¢vÿî'þª3Ê]ÔÌs¬K5Hf謞býw¯[,ª¢~Å{„_qòr-€ùòTño¢“y|·j8×[L¦Ž–#UK+abAšvt¦äÞK®yÖûÒ?UY|8Ê…‡CiŠ9»¨{SjCh¼ùêg½?hõš‡ø¶D(Ýbìæ%þ¾" ¼ïÜIknø£ùD~`%¬7¼îÝ ÍL³üzrKw ÖY;ªv•oaè‰Õ.`x®Á]ÿ)‹+¶+îÄðpœ £f¼Pr‰á–ÆAYbÆ{‚Xf®ë+zMd¡]÷îExŸl=ìïóí*’±½yêe”ØÛ`â4°™¶BãR2b¯8D“p’p0ó¦5ó–¸÷¶ £pÅ%þ·¨g­ }é¡wJ ÜûiâÑý®cSêQùˆ§ÕÆûšgdžOó[ùð`¿¿à±ÖL¿>"èUÏ‚)iè›c ž7êñ§íÇRãfËØÞ= ÿQtžX`4·²Èý4Û°£BDlª¥b¹ ë5– ž·=óx8÷KD+Æ䧑yu~î¿/z_…8~קé¡o¿ãœÍ ´"# ⛎ ÏíÙ­%Ð2‰xvúîæò‰%´d#ßãc)~ßVfýJ¿ JïO»îüæ¬/–q™ˆ)âÅ÷(8‹þÃûW\G›ôFùûÅg¶@ͼÇŠŠ‘ȧ‹þ¸tpoªrÕW +L.Mq» 2Sý/lÞ!“Ô¯[fÒô¡Ô½Þv¾ä»=y?¢Ï"é~!C°Ò}åA‰ÎÎÕ*Ü¥ßj—ÒÝ\u'mGábð»…¤°ìă¹«éöI|ëÜ’hÏ”à~¿¤Å`‡ù>†¢W<‘”øT’‡Á‡¢M k|N>Ѿ·F“{'ð‘fæ¼I#‡÷¬ùɈ<ÃüëÙØݺ)£ödÒÞŒøy­Ñe"݃ã/VJÐÒ+‹âC ¤TÎB³`óù’qØß,ŒÔûØßELBví&Œ#w\ôýÎ/?øJßDg¢ßgzDt}õz±·‘™âG%Œ±~ëIÜø <öÎòjtKû>­!U Ëú6ExZÝ6COâÏ÷…_¥”Žn°eX  e½Ò‰ÉÇBï!p ¥é"Ò xYŸvr>þª†¨—«©]M ¼±>Ü‘ÿà/T²ªOñ¥KÑäô롸rA+eüSiü(KY@ÅvŽÇjkb¡ó"•¯ö“]uÂ9 ÛëY{ò¥÷V:\^3-¿YšnÀ‰d +Œÿ |¥gGý¯òäÁ´a_žèéZûú®…% ‹ÝîO>´7ÔþŒ¡:íò÷#\S›™$M]ÕmÇLu‹‰{¸£œ›Ëûm„ÁÃVN¹ÙÙ¨LoBps‡\¯»ºSZîâK™GÌïœR GCr£0J"Ó–&ŠjÛ9?:RM%Ü‘òºÈÖq#%ãì•vôñ÷`¢tê‹Þ†Ã_“4;Ê«[†qQi_û7lÞ˜¥ÎÂhƒb°±3â¦ØK¹­b8.ÁrÄ«Ô—ìMƒ¾RË£}…i猴û5÷nvfËy’ÁDURùϼ8œöRÆ_Å™­;1KôÛç¾­sëd©Ö¬ÜI—!Âì+}ÿæ©eý=ø‰Ð#|oÙY¥ýi‹ç·:là„ 1>.T6fœ2,³¹·£:ß;–z ] V#/0'jk=„qJ«-–…tñ»¶/|”)†Šz£<giV2HùX)LV¶hQÙgÞŽ¬ŽŽ¬–»Õ·ÁvÍù?ªIÚo›¦ÊŸüÊ9Ksf‚éW¿HÒß̈¸m³RJÁï|r«áä½Q’K§ÊÄÃÛÖ×Sò¤‰]ð]2ý87Nš±>ìÞ’RS]¹ØNÇkP±‘1ÊúÝì—GÜ”W.ŒnÁQRtSÑŽÇü¸²e‚N4\¹Ãcv§-Õû)+«^÷9תŸ°Íù”Ó‘”0·ë3fó °#—=[Ní¶*x*§\£”—,Psöºšô1ú/Y°¾–&§ýô)[vÇVNÌEb)TN›J´3E?…ÁÆ­í§FßK›ñ¥(WRÑöåJúAWçš ùÓ«<RZ’®pðs$*e_•ã|Uñqj«3×í*®3ìëlk¦LÒ®Ú)ΖYE wµµ[ñêB]úÝÙ«‡Î—7„t0µÌ‘uFzn> ”ÈöÖ±š ½Ü(Þœª²|㨴Z•oÆz,mš£¡¡<íÌ:!bd²œ)g¸P[:ºL­zI{Gñî{œfê¼ñÑ°'¯¾}•|2E±µ)?Ž«&QÿêÅŠ™ƒ 0©aµMmÀ§Ù#xÀÀÊl"“†èþ V•Ò©jJ³Ç&´²ÎÇ8^i-äzKl*ÒmA=ý aØg³gùªš3zuÏtê-šo«Yï„(âQz/}°ÃÛ“šLMŽ¾ ¼õDýTVNkp´_­,²>ñ3ÀÃ&™ó\@ºª#èhW:A¸iˆ åø“ìÔ»¯ìtúkΛúdkO. É~Š‹)Ó>¶ü.aJ#INêÎÿœ$ýΣUÉ;! L‰x%ÈâøôVÔ%eó˜ Ã|w›”{XgƖ믂¥'E^ß½J©à ’ñ’®å^ ´QÄê|fEØ꣓w­Í‡q4^ô§\žÜz|z>“7H¯ˆ¹œ¯—Ä.†Bcž¹©zKjÚ ÏLÄ0J6¹q±|©“ü±`˜’ÚãÞ1|xùMñYl—Fp¢ ‹¨1_€Ì6æ)Ï‚¦þdˆ ËÐdÅ„ônàòËÒ~°'BÃråS9óˆÇ¥¨î"Ÿ_TnjwØ_„ô°Àdu¸¬Ž§’´¨©²êÍ%ƒXd12(óÕtY¿×ÖÆÐÛ$£¼hE‘KUWûUcì·$"#¬qaiÑì¾5q ]‘¸ÏRUË×gæ¦íæWck»o,s>¥B•¯-Æ àGûY–£–}ú˜#¦ÔÏughÈø¢_ÆVâXtR§#t¤žÞ߼æÚzÛ¬"›!z#éÇD|øü±¶xšSbW+{öìvYßvaOÙ1™\t¶Qe2`ŠtÆÂÖ¯éûD_ÓïsÁ»µc7¥Ðì¤"¿ö€«·Åù®¦KÚ¶lhÝÀ<þÊ]<²ƒ"Åáì0ñÓG-z2ãpûS}–ÇÑN-9üa4wûHrÛ>ÅRÙÒºÓD™a†b›¥ž]3y œÉN¿d0g(¿ÕËS‘EP½}ªG,¾z\Å’ÕmŸ¤™=Ú7«÷5öTRÁJ?N·,Iè{·Â]¡º`7xkÓ²z?ÑÎMžµ.6äúÉG|¦tÖ7ËO‚üxÅ)ôùßmh×Aregºw>Ô4Üb$ÙsXDzŒ,¶9ì»úÒ¶Sa½#(5qñ>µŸç6ÉŠ¾§¼Æb,»6œF#ÿºLW®M;A=hé !ª¸aÆ;8tê1m ¿ÍÚDﱶ‰ Å€ÈÍ(£ú† ©¸Œ]ª_Y€düâmã©*¬±â¦5ÿiyhq¯/KIýæé×øiü¼A ŠI­H‡<ÌX³{u\31GŠåë¤ûlþ8j‰1TzŽúž"«‘žûEj¹R*š¤këa3wÞï;”Üm1§~Žáô`iÂÁ×Ôü^Ö¨5GSÍùtéú‚‡ÎFNV.Áz¡+²¬·âÑk=¡,ɬ¹$1>Ìbµ1ñÝÞåZ\ ÖN¹ŸSÒ™EúzÈü‰/ËQ¹?¥8¼¸‰§ûýh÷ɽ!ÜçÄtŸæåRuQ*ÅTÍ+E,~š'rœŠ…!ì¯ô2N(jœ$4Sz¦{à}î,fx®Ò¼”u‡ðKȺr’ÌûPßFÉ'·‰ûܲ]0ÍUY샧±-‚ ˜‘,ªiÆ´Oc–+°C¼"QîžSn¶ú ”næ^Öä¯lY’Ê_Úðluë†ZÎÀª=?sˆz¯‰>z­HÒ¥¤É¨‹CÓf—Åi/çaiWl’1Üc±ãÿl7¨òý £±¼{%ÞÀªn–û‡júFÁ[îøÞ?6Œš—~ Ì.’ÛÜ?˺e‘åí5–8Åz¬œwœI³5ß{ÂÙ÷\Î'^úŽ—©L×aøºÌ„ê-/¹Í¾›ã•¸¿ÿRèU“û¤Jy)؈•Á˜Ù=ãZïÈ•…}cã#Óô~¬Cž²u¹vN©¼ƒó` b"øTZ› AÆEΨ0ù\(ñÖxVp¢Yfþé] q—¾ië‹`Ý«o ÂܺÞ?[ùÀÍ'OÁÉfì—Ë 33cdq{;Ò»b÷’ͨ3êÏ.Þî<©/«D¦ðgË^ŽDf¬Z‚|õ:ü׊Sm˜D(ª…+µçª"ž~qÜ4CöïÙ•¸_6\;?Wh”0ª$Ü <ÅÔ©zÜ%k%Ìñ5{Û¦l°mŒé ‡„æ‡'Îà1#²Ô8æ…yë‚3µtºš‹È–˜ÅÈЄ“kŸÔ>Ê9¿kµ.'s"ùsüÒŽØPEçrBž~î@Sç¬ Tf!Û\·°„ñEHd’m«­ÊTŒÏÊR‘~×÷ÌQCßWƒöqVÝ{r¶Ñžõ×BÛÕ\8òAöT¯yŒzŽ#Êß|-¹ÀhŠq…/¯ií%éftëÄ'Ë5({o©¹²–Ùrú¶žw7pc{‡/  *X8SáY­ìÓ×Ñ>“"®F5\ Šç„Ò¨P©x (Š¬>àöÐFZMÞ3¬ËSÌÉ“; ›Ûwö€œ…»(£†ZŽî íÝq¼רäøæÙØëJÐWF£B¤†i>b!‡fš3š¨{à‰q…¤c£ Ì6Q“®L¡ÿl §E@ºàY=T:¼§ž%&Åe¡4éÔ·Ñ“‹;mªü¼Ÿ!ù¥öÚhÔºÀÔ¸äV"N]dö«Miå £ÁÂÙgp”9låyô`¦Ø~ûMO²F ú]kõ)õEÉÊsé8oGæÖw’šŽ‡¯×®éiûœïGtäï¤WY1‹ÝJËZ¦Dn¥[w¿jr~àC.¬gÌÇü$ŒßÇß½¯á]IÐ^©…÷7¹ñbÝ5‘£Ò†ï¶ü{Ð}/íó]Ž*/ýÌ÷•nž›jR>åæí—`O,ÊgHùpqÕ¨e›W/È£ãÊo°۪·JÖß$Xk™&sX:¨ÑbuJ (àið½^³=×É)&ÃULgƒ –p.Þ:Æ:œÝ 9CóÈ*ó„>x–1YtŒ4ñ²Ý-¸v©ä£ó¹Ë#bßóåÖÉ®Îc˜·Ô¥FÒÃîДÇ­/ £¤¦òØUWöQªŠÔ±Pƒ4ƒ/³SÄ[bùàN úP.ÆÀÌãió­à.r{‰~dÞÇ@H3mêþ&p~ê`kaþ‹ƒlštkFÒ\æÃ'£aBîûŠýqmnê/ÅxçO¼yDD*b%հ냀MqqÔ*FÔ ¹‰ §ñZÞ³ºWÃQ…Ä@¦—AJ2OùIæVAxˆÉñ<÷øòmA—Dê¬Êõ" ±Œ‡ô~YÕfn½¡!Å ¯²’ùýR) Ôz¨‚Šù‘aî5[ººníiJŠ æ,I›…Ü\©³2Á*)Ý FÏœ’ÿõÖ$ÍžIZ¼Ó°ñ!õÜHšG­ÝJÚ,ÞiööGÂuj2›ÃêÌpn¥'!bš ”³Ýµo¯uóD5 oô$òõl㵄¿Ëk±„Þ’‘§<õÙ½Õ0_ÂúæÇÉöÁFýúg3ñÀ§ÝõKánjª¡›Egäî‡}’¨Pe\óÕÇô¤UaæÓŒ:îøs\÷åómb¹.IíóŸ_+m•y¨Dò—†E™¨§kË°Vîkß­à#Hf…¹“Ðß²xd|˜aÀÄeèð’¿W>•OH,è§e‡ˆýWzØF¦œÿ®rLJ"dñÞCVæB²·Rw¨“$ðh•×å<‚ÉùRâ’÷½c)ǘQL¼^h)û\ßÚ#šeP™ø³,Ÿ?=àjy(–”·m:÷H1Í*‡1‚GÞÆ~ÈÌÒÜÖ$¹¤¿?_En5 ,ÐC|<22_[Øk03ç’Žf•ì‹BºßõTyÅFôMä©ÌTú}Ê­ñÿ‘ØT×w9K ÀÐ_ãjÞVpQ]PÂ@®ëÌ»Lj™ úÀ\ôG™Œ¹ìœo51ç&u›X@/÷3&§/9í žqÓ§š¯[ñ=À†½¾£í¬ïë²…ÏÒË©«ÿs™Dwž]|‘´?fWн¨l_Nˆ· ØdŒŽ§¡¯aÐaN_´<‡Wá3VZ¢…• ¯Ù‚{ó„ûîÛÌw…ô‚8î‘ÚoT¼†0vsJ÷ŸMd!­³è:ç]‰^F«XËÇivÚ84º~‰q’h«µÄâÏ \­|?.Naè×M *ò³"»Ý…ôšyd„ÇÜ'j®3IµC+â7ó¢œÃ{J5g©9^­vI!7tÁPX°±Íhûæê(³óûgz_oUݦ(¿‹†N½Çåã7¾Ü^>ë¾›gãØØi¼®c|ŠB#zGT=vK¾²¤›žÁ׳ì©3Ï"×Â^Hä,s`W‡î–û9†ü”ÉÓ]ÀÜ7èö×|úøq±CP4¯¦¿ כ醺ò#ªº¶T×rAqH«a»±Õ ibÜÿ¯wof endstream endobj 152 0 obj << /Type /FontDescriptor /FontName /CFHLZL+CMSY10 /Flags 4 /FontBBox [-29 -960 1116 775] /Ascent 750 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 40 /XHeight 431 /CharSet (/arrowdblright/bar/braceleft/braceright/element/lessequal/minus/multiply/radical/universal) /FontFile 151 0 R >> endobj 153 0 obj << /Length1 1393 /Length2 5904 /Length3 0 /Length 6854 /Filter /FlateDecode >> stream xÚtT”kÛ.]‚Ò  HÃÐ"!Ýt ÃCÌÀ0t7RJI‰¤Ò!!Ý ‚€tw"(ðº÷·ÿý³Ö9kÖzç}î|®û¾®—EK—GÚaU@ÀQ< ^>1€¬º®‘€O€—ŸˆM†r„þe&bÓ‡"]a¸Øÿ EBÁ(´MŒBÇ©#à7GH‰ˆññøùøýˆ@ŠäÀî0k€:/@‡º±É"œ½0[;ºÍ߯'ôè‘ÈÃßéi'(Ãê`”Ô Ývè" 0(Êë_%8ÄíP(g1 ÐÃÃìäÊ‹@ÚJr>xÀPv¨+éµü Ð;Aÿ ã%bèÙÁ\ÿØu6(0 @a(Üá·†"èæ]e5€¦3þ'XíOÀCÀ_³€xAÿ)÷Wö¯B0øïd0‚prý`p[€ Ì ÐTPãEy¢Àpë_`GW:ì†9‚­Ð¿o(HkÀh€Ás… aÎ(W^W˜ã/ˆÀ_eÐS–‡[Ë"œœ p”+ѯûÉÁPzì^À?›u€#<à>l`pk›_ ¬ÝœOá07¨²Ü_!hÑ?6[( Ä÷HXXPu@=!vÀ_åõ¼œ¡¿ _f4?g„3À ê³¢ÿˆ|\ÁîP éõóùߎŸˆ@ €5 ‚XAmap¢ª£ÍP›?gôò‘0O€ š{ ߯ßÞÌÐô²FÀ½þ ÿ½_ –¡Œ¢’÷ÄÿñÉÈ <>< !Ï#!Ä~ˆˆòüþ]æ?øüo«ö×åøþ©¨ ·AýÁ€Þß8Üÿ¢Ç_’áü»ƒÍe(€ãê›ò ñAÐÐÿ·~§üßxÿ«Êÿ‹úÿ}!7GÇßnŽßþÿà v‚9zý€¦² - uZðÿ5€þ‘²:Ôææôß^e-i¸-šâ< A^>Á?v˜«Ìj­CAìþéïU {8ÂàP-„+ì×ÅÇ÷_>´ê 诊+za¿]P´¨þÝWAXÿR¿0ŒD‚½ˆøÐ$ãø€Ð2µ†zþæ7È G Ð)4F?€ Iôk­|  îæúËJô¯Ê7$­»ß@·ýûü[äP¨'B43…€<µ¯ mú^!ÍàÁ³>Œ·¸Üò,Þ¨;RÅ>ýÚÇN ÿ•â¸‹Œ¥u)í`ŠÖç·ácS¾ \ßG”?}Ä,‘ñ«¬šÒ&ÉŠnñQÙ ¡»ÄTcæŠ+BP×ÅLvÜ»²ŒWÓrýÆîábiXÚ¨WBÛ«7 Ëß?ZAùˆ¤QÇB¹ëk.N÷5ÅTìñæ3#º gÆGjgOY•š´Üs xŽôM8è¶À"½ B6ÐdµÉعÊF~ OÛMH¸y‘Ú'ß BÈ^s(g±ëÓEídp÷'Â2&¢œj ÐJU«õíœÍ³´æ—KiO~ï‰AGâö/¯¿„zúi|©ìÍÚJ†¸›lš‡‡ñžÜú¸†à¸CêYî§Ý¤O>~&c¸l>+ô%Lñ\:[l&¾ÄxGTJö–£ 6õ%ø d_gh.ìl÷ù•1·÷‰T”êÃ-ʺKÖH£‹Z0Êåd`ˆ´õåa8NÌÆ0ÁÉïWÍqëù‡P’ÌDJ² ‚õ®HýäN€iìÄ¡}Æú)ÉI+ÃïVEêäÄ¡>¾&@ÐÎK@ßJ æ˜öÊBÁ{Ów‘áx/rS«•„»f·¸)±>S3)Î05@¾?/SÚiÎwÇ’W:·T!Giš‚Ù$½ÛO?8áÆ7|âº-BࢠìzûøÖNGe¸¨€¦°¸80´+­ÃènÖÅU³X Nõ®üL%vw ¼ûQC&{[6½Ì˜X¿1‘^nC”AÜ>}îÛ |y!µ%û•WVã¯Í}WaR6cÛl/YJAkßÉåQßM “š\¹]+ô^nÑó1ÿÇ+‡£€vTÀ¾g¡|vI1xôî°3å02šÓ'­‰rÊ\lã]0ñ?_¹"™mŒ•ÃãR[ñ×ÏsÍÎn”T¾®è)÷ \È ùöYîγþýìo›¸¨s†›µ Þw»saÛ]­C{,S†„åˆo3'ít8°sÄ©´ëzP ²ŒÔìí—,`,^ʪÁ­ OÑoØQI^wy÷´Ô¸3tÞ$]åS³¶*aL—ZŠhùJXõD.ݾ؊ä>ª׳s¶ø¾} •–zËë‡IÏ“ùS3ÇÓ§c{"ŽJïGÝbÎìßö´ê¶ 1 zBXÜŸGødMNP÷¬ÏÝÂâ+ÃX3ûÈ+`ø¸ød_.ÿÀÑ’ßw½“ÉN yã•ú¡p©ü Y‚Ò©Á6» „û;/£+èãC"}e¤Î#b-ã"ÝEå˜1éÈ[8JT‡œ>^ÇÖª^Ñ~¹½]û(µ¬1‘1}¢èíøÖëàÔ­#Œ‰¸@½yjŠR×lœGvÆÌúàû+?À”0Òé^Öøë$l6"¨KÛ}.¦)þëyÁb Ý´õ{%žºê'ŠƒÖ ¹§ÁíÜ‘ÓM·_Ö[ÓóÆò!ÓÕõiefí´½?¶`=9ÛØÇ0¡ÛÃ~o¥ø¬7*ˆ¸ô<;rc5[À‰yP z*Dì^œ #~ ãiÚIUÑ*!|d2D³¯°Ï0k}w+½ºDeôÉâ!=¾Ÿ_Q”‹<õa†¤/«¼p°Á ìÒÛµEõ[ °œS‹æº‘±/:ƒÚ«úf´|è*u˜)ÙÅã§Ïº%P§æ•7k[ðiÂ0÷»y‚Jp~j©¸a={¸úÕßàx`’˜SÀZ¼“´,B.Fƒ2µ¯È¿ñi¾ÍŽJ*ˆ;¸]ð*€Ì‘¨Ï?Û¤A $)wªöÝšfÐ핆HŽ˜?[ïs_Ák à§EÃNVÌ-åO)+<·4Ɖþ™lò$ b?†¥IÉŸ`¬²±°ïe•'‡% ؈fO9^n[‡üT×IçÙ~È÷VáŽÅD•ñÀ蛢ÇØ®ÛA'žWìÕsµ!n™G©„´‘‹ä•éc™Ü™î!Òšx®Q-×M±óÂö亖b/‡øÍ׆–…8=)Q†LMUyœ>).VnÖˆô|[aªÀqêåî0N£Iá,»†$kf¾úNßðq­J¼@¦üwâ·JŠ;œC>Ò?9¢ÝA„KÈ7ÝuÖ¿+ô…M¶ÒàUkçÇÛǤzoá‘5_¹\ˆùÕØýòÒ„ô‡W¬X ¾ôuE\LfªSó]ãÉä‡k5…^ñnçM‰;O¿åOÊ*Èå¯GÜn„8búFjxf©Mí1GÛ3óTwNy´JnjZÞ{ÐyÏùB"ûV,ÅêZƒ—7Ëë‰LbÉNÆ-„Ã7=¨ô°)ÏÁáSò8¼€~*Z72YáT«¤ª†å»‡ŽCm´àsLÜçtå$­K)·˜XªÌ¢ÎR+?a ;.OSnø×òGsöë[»\êûÈ#Ë£‹‚Ó[„HqÅ¥Îv§•‹5œü ªVƒß˜†Ð"uî1Iç”]o˜‘P—˜þ„Ï7òCÉXØOú¶È#wkŸ±}4…É5^~>ü–î3d݈=¹S:!)58µE¯b”—ÎÖ"xÎ-äÅŽ_³Œ£$ úÀŠÇèý&úè-æÐÀó¶’„ZXÒÆ ¼Æ¯+”&ÜÌx“EâИ°&w÷Døó›WÔHyª¿cgšïÌB ïÙÁLL.Rîk&íiíƒ>~lß¹ä¸F†wµfÊÔ†ËÁsÅ›Ÿ¢‰2¸_v[àè,>Ë5bêÑê_‰Þ›°Øk)°IÂ.‰@šÐ9ë*¾ìr ê»–våµ—nQk»½ Î!“‘Üã/ñB±|ÆuKÁ§"K®xT˜> *¡©ÈÙDb‹gŒžšlïÂz»cÆ¢. âÒ¬Ëc$“²©óÌ%*7Œ•Û·ˆ·Ôl—4†5¯ÔwLù«›2éWl™¹Åýº¤Ví} ¯dhzßel«1i×ݳÒ–Ÿ0,ð¹‘U8U4JÁßVÊ‚JôÛ¥Ïé™›ÝgO¶qÁ„ßÀV|f™ùˆS¼eiX»}ý›¶¨I÷eÔMí°qm”í®žÏ¸PŒ³ÿs”"åœÇd$Å ¿f±á ]þ– m¢!Ýû÷êg‹‹?ðä5ó0KÉ⊪oE,ÄhÍá¾(ŽV´zü@ˆéÓÑYù‡ ŠýIb¡iõëû‹±Ê?êbêÚu,§æV%–Ü£]xä࣌ƹ׫gkW¿¾Sÿ„ÃØôÚÐ⊴Jy¬*_ÓùU¾P[¸ˆ$\f—­çó£¢¹f;Æ, TŸgܯ^g‘áT©F Òi9á[c}¤f›+èöÁãd"t­IYqiPzYz†ó8Äþ¥ûm¿ÏÁùÞ¢ÏÜO„·’&é!nÅâ•ÁpÁMÔ‰æ˜"?õ¡WŒd™K îüÂÑ#zA<Üq&‡\™¯—Qæuñoû C&@ÿJFÙþy⪓-ì}6BõÚ%Ÿ¸ZçÏ´Œ¡%Ÿ6…ž@=êb¥.˜šÎÓg4}뫯µ$·õ†/y)Ìí퀎ޑi§Nì íƒwí<^Ðë©×®Ôu˜S1e¦ ˜÷~=q‚b)½nKÅÚ‡}~âøôÞ(‹ñç>‡ÎPIj ü×Êý*<:Ò\ZOêXÜZŸÕîsÌuN¹ã˜A_便ºbõþa–Ú_öØàg>²$ã:¢Zü;Õ <1a·˜š„õá†òâ_KReÐÏmÙ»=kÞ³½­[ÅS"£'1³|î«:ô&– 5Ì1?Ïg»9c¹Å|/Ÿ¿…3%£ª\ã¼F±A…þnD¾ºY9ÏŒú`–Û3ÞH…N{Eys¥èw"Ay¶~ñêã3“Ôú&;{ÉÞJ¿r»0ìƒbW¹„¡IN=ãH§îaÊSO„¹pSðŽWm_2ƒ!§ßÁ&f.(5͘ØÇ” F‚´2 1^R¦svõC8j²5ôÙ4<¤H$*¶%ú'ïùfN jo‹ô0Úí’EÍÕb?½ÕÈ`;På÷ôó 7žÎÚgIkaêEÇ›×ׯ(Ol ªW)TÅ™¯I›ßÜì<í*ÕD2m­óDñ|?|ƒ"Ê‚ô°=2ÀÖ‘ÑÒ&iZ¼J{¯ƒM¨~!œ×<Ã<éFR=iŽÃ!Õ¾ò^ƒNFá~ø³?Uâû¥ p*®™‹œÕ¸u ±?ðƪG¢X@o’ô§Ä“³ã|F;8džo =rw%f¦fEKÈg¾9›? ›äí1ýÉ3€Q©8|LìÐÆÂ…-äNºõ5‹€òÃL+…F^žV·q•ªÃOsìo\àü²ÌAËåÅ Õ$‘A4ýÊAö‘°zGéÇš°ö#P`™7oGÇe´å™ìeöu‡ºƒö#:Ò+?5vɼ`\¿˜Ã ÏsÌ¦ê « p\ÿgì±4¾=}M%±è:ó{•œö(âV‡1„äpýà]J9‰©‹Â»$˜çʃï|»GB»Hëú§Ceº|/Ž#>üèÆÌIú‚¤ó´ <º£òe³›&s—N$6Ø1Þ8G}ükþlµˆ´`»Þ ­ 犌,õ‘·OuÚ*’»ðmö"ñ縓Zb@ëI­½\#ÅÁƒ^·‡=¦mîãV„s.ûéÁS˲XÕ W{µ0[Œ^`g‰Þ ás2ûÈÃæ¤FèòÇ ÓŒߤ»™øÞæñ7mù"^šø#3Rܤ #mï ‰Ç g—hgÐ"£õ Y ál+羧­ÄV»Ïâ÷±÷Ù fRòþzµ%g×Ç3†‘äj¢,õ.[W–RŠrïuöI?¡‹ê²ên.ó¬>Íkêd#Ú}cYk»ÌÕ Ñ÷J1¦¤$ÛÆu¢Ht#ÓYn‹ò»:¼˜á `BÅ Û)JŽ„Yl}ÓU—ûF…–ÞúdWK6ç3ÛPv¦rûkÏçê=Ëž•úr?KرÒ,o1r|½ÝU¹Bo¯É£!Tr‹©_© Ø²šÙœÔºw]˜Å :÷£+7´×a·bÿŒd™É1Ï°Z²ê‹¼~nbF:œzðC›=¢$šeü¦Ï° UšqÖ|l‚|¥Ê¨Ô`!X;Ó­3~Ë'÷ËÝläóÔ¼4!~‹DÓ<2Ü¡C i7«/ôÀf¯‚˜:ý?…4ˆ«‹¼œ ïs|Ù±?9*+ຆá*6ä—å×Ü%0ÄéÇ{®÷NT°‘»dÍ_ [O˜´¨°ðŽã·Œ‰ÛüˆÚ–lîr¢ —v²Î:MRÛôáîö±m­ˆÂkFâlfý’ŒöGKö‰Ô·/_ÂDèßî 1‹R¦#eÖº’ŒçĽjj·#’È%“®í†ª'›\¿íª«µì7Z|Ö,éCnµÊÉžzXPØÑœÖ+œ J@å éwýœ°£‡û?êŸÞ2ö,eGÐq 94Kâ'›bpS™÷¾I< VÅi&Z<©•þè[¥È½ '½©³q4B" 9u,½*SïØ1æ³áêxbät.Xq§·H€®ñßÄk‡k”(h§~¢ÃL'zy|Ëké’خà ù¢ ºÇU•C¹Ä&¡^Êà„ÞfR8œc†%R§ÜžèÃ+f„¾,&ÕA^ȯ"±LQò’ÓTÊü¢óÕz$6Ÿ§¾F¨Ý:—}qÌÌW‚;ÝÅÖiÈÑϾßk|21úôÖ…r´óü-û-»™RZ…›NÐÈ¡Ys¼<ƒ£%ëfŽU=­ý'¥¢97‚¯0¨(¯ÅGT°vy Ǻžx´7 –™" YOV‚ÁdÆ'555_à÷¼Ûí[¶#ЙåÜŽ« Ö~ÎBrþ¬’|ífѹLfúèõï}rÖ²†ãéD5 Ý;JÞÃo)ó–†sWñ#Îl"+Ù´T´ÉJæB_F'~Á7ä’—‡ó›Ä·zTSŽ´íΉ ?wß¼(`Î4)lì §{¶•Íknñ£bäu-,ÎgZ2ŸÊP”¼‘:¯¼>4PZ=3„žÞKljñá:Ù…÷xR{¹·%ÓTŽl¼ìóš+Fi—Nn<-ZŸobÍdõ»»¨Z¬d¶]ˆó,•Î9Ôûoæ>äÙíÂ.xk3›6“×#²öROîœêÓú" ’Bôõôo$¦tRÉë"ÜÎiÇÜ|*6ßEHÂJ%ž½”íõƒ;%¤ ±/p«nóO>¯WÎéWFiÓÅùD­«ª4ËZ‘]S9!T”@3³æ«’Š¹À>’¼µ§ â7é²fTcVõkY“Ü\ç5£½ÄÃÓÁ-{e-=?ó„+âŽ:lÆõ±ÃS&Y¼¶ÿ(P endstream endobj 154 0 obj << /Type /FontDescriptor /FontName /PXBGHL+CMSY7 /Flags 4 /FontBBox [-15 -951 1251 782] /Ascent 750 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 49 /XHeight 431 /CharSet (/minus) /FontFile 153 0 R >> endobj 155 0 obj << /Length1 1749 /Length2 12041 /Length3 0 /Length 13140 /Filter /FlateDecode >> stream xÚöPÚÚ ãîî‡âîVÜ]‹C€ Á‚Cq/´x)nÅÝ¥@q—bE‹w÷Ë–sö>ßÿÏÜ;™IÖóÊó®×Ö„ŽJ]‹UÒÊÉ(놰r²q¤T´89Ül\(ttÚ ˆð?r:] «È ,ô/ )W 9äU&my5TqÝœÜN>!N~!‡à \…Òæ +€ @Ñ tC¡“rrövÙØB^ãüç`´dp ò³üétº‚,ÍÁsˆ-Ðñ5¢¥¹@ËÉ„xÿ£ˆ-â,ÄÎîééÉfîèÆæäj#ÆÄðAlš@7 «Ð ðGÊUsGàß©±¡Ð´mAn)´œ¬!žæ®@À«Àd »½º¸ƒ­€®€×è-e€š3ü—±ò_,€¿‹àdãü/ÝßÞÀ:›[Z:9:›ƒ½A`€5ÈP“UfƒxAXæ`«? ÍÜœ^ýÍ=ÌAæ¯^Ý +©0ÍðïüÜ,]AÎ767Ã9²ÿAóZf°•”“£# qCùã~Ò W åkݽÙÿn®=ØÉìûd [Yÿ‘†•»3»äâTþÛæU„òÌðrppp €. —¥-û´½*9ÿ¿æàïëìä °~Mè²¾þ øº™{Ww ¿ï¿ÿ‹P89V KÀh£üÃþ*Zÿ…_ûï ò¼ãx?NÇŸÿžŒ_'ÌÊ ìàýùŸ-f×’5PÑ’gþ;åÿ*ß¾uòø²róX¹x9œœ\<þ׃ÿÿòü·ÿÉþO©º9èïÛý‹Qlíü+‰×êý'¿'ƒñïµaüoU§×yÿ#^Ë×/ÎÿÏKð§Ëÿ¿ÙÿƒåÿuüÿïdÝþÔ3þeðÿ£7w9xÿmñ:Ïî×ÝPqzÝðÿ5ÕþµÐ*@+»ãÿÕ*@Ì_wDló:笜ÇiŽó¢¿Wo$ÆT.²w¥;*«ÆÍC™ÚÙVë>…µ¸ˆ(Ïf§1ÂrÞ¶.áKLŸ\2i0}•i¥€â·”ç†=²ž~jÙ$‰0~ ­‰$òy¬9½¤§8džê¥¾„‘ëÔŒZÇG£–ùOäºÄšX²„I”'ûFÖðu¿?ù%­¨ÕY[Ú[çqE›Tw ª£¦=«Uû€’÷…2[wA#^üje‰ 꼬œ›¯Ô½ºxdÜ̧Öý}~m;ÔEÅf~ŠàUçvO ͘Šh1¢5›Îùô`Ù&I@ºÅ4ZÓAÉáVPî µe>)Îâ}viÀ\!ÍHµîMÇî©FÎÒÑX<á^9,<bCFÚñ½Y}’7zÜbÔážÀ•È¶úÏ:Â$…l}æ”üú?xa|ß#ª¤ùìÈ÷£vj¯c&_Ù}M$ì} _ÿ‚`‚2«l[QùõABàEœBÜÄ£ïØa‘To¼ÅÔ¼:=Tõ ª¬oNîìJYcEkxQ[Š|H\üõ^Õ¶"šŽãÄl1Bºb{9"ÎåølŒ&Ï~v­ßSœ¡Õ …æihU â>éÖIûMÍLËÈ;‹áÇ–¤ysgöSî]¾×ÄO2A7úÆ~":¤7¢ó—t‰OÙ˜H> ùŠÜ²’tŸìsâ~P®]ü°b„)3β¹è æ¹ø*bôE÷+<¡Ç‚Çë®@ð‹þǪU¾rµ^u;¤Ì8õξcŸ›‹ò Æâ|¯$ ^¦aJë} ÚUIeú.}’ÙÓžíš¾›œ$uÝ&Ýf|ÿX*õ”íq›ÈKCœ.??N¥-MN2 i¢öÄDt. NY šÂ&s¦USó‰;oÉ_ÅÒ߬û<%¾à)(M®¤ÊˆÝv ìj<çU'H "´óŸì£½ËÞêEE輶*™Ô]7®l,É7(;}Sô!g<fÄÖLȆTÃæKÁŽ9"Du-ePº…¦ZúÍí@i{Ά··Q. XP ª@Ë×›úS¦†¤ç%ûÙÔWP Ë\jë—|¨F>>^¡8q­@,W®¦+(è0dì8æ 㣎¾a‚òðÚ¿~ö~Ö5FÓÁ x?:¾µ‹X:¿å‰ †äÝ&¿ èl¶û¹©òÌ|û³Å)“*f§´ˆÉ;ÍDij?ûeÆÄFÕAWèl?Tuùž±ïžrÊŽ–íÓ]<®ÔáØ[+×-ì.ƒ\Ÿnî¤1ijJƇ•Rï„ñÒª¥{·2¨p7éP"H%/¢ÙííÌ£‹ea^‘náç¦ÿÕ^õ¥†gMÛåÖØ ²¶@h0•óq¾?¨­óƒƒ‹»Iê´•î[4¤wæCØŠ>uÍòIÝ3·ðk&µš–œ>°˜!2Ø0ñâ —î UÛbf$¹Ê}£JnñÖ̺öØB[fîÖ›7Øø”Vþr"žøL+i,€šWž­¹Ó(s©~Y¦g[ß õsì›±,¾ÂÏÜNŸ¥ºÝßÊã~ÔR2Õžþogô}+Ü«ä¨ä¦w¾ðãÑrPúìùí’,5óÞ£ózâ•U,”j^Ç‚îLi„Hl@$püMà¶]ûýtb¢Šà=¡ÕHnH{|·óWQð°8‚4ãZü–¨XWÀÞ”cT ô‚O®*ïc$2IÆ –Z.vê#(L¼ 뀢l¾\J:&Mºa‹»’œ>ÄJÇüô¤ V)Jô1·¥¦™é Šó£ò`QMnÂ!ü{+1*ƒ¥ñ¸Á6•HZ„ñdvÝY«ºõJh¤•næç·;Ë0øUwzÄô! g'ÁËd WΙ’WE¸¶oZJ=,zðÕ=»Ø¤çצ˜ÕØ:öÅz\srôÛ±û¯Ì¶º"´%¦Ú6EÊ?ÝŸà.-}ÅOLꧽk…Ës¹j–ö/GYÞ¾ç¯ ì3ƺ Ûw­(¢×Hžçxב>%©bœe=«ÿ[¼Ñ˘"Ôr›öû¬#v”·L7ÜüÄ8Õ¥-O’6Ɔ‡nΩ ÇVïÙ8 2[•¯({Þ»¡‘Še5³%!D¬´^aBÑN¬•‘ xˆ ¦+¸Ëà…8‰Ë’Ú Nó¦}w,ÿXAx9)gàÚL;—ûp’}¡¼ÕÕw‹÷M ÑVèÀŽ„œ!½mI!`OÆv{ìpTÕéçà‡VRÇ^v»üE˜!‘KÝXy|3]3s‹â`Ô+õø3pM(?yýCƒë´[°wþ/4psDº(‰ˆý 51V˽˜ŠQø5,ù¶—#7LÙZèQ!öñ •úѹ‘™ fôýÚÉD§ë“°¢pË—©È5E®†ýÞÆlœwH›P À¼ ;;PFÅû8*ß Bdƒlº~õ÷ïÊ2;ï»&qÏÔ–¼Áƒ@ô•HÝ5a•)sàç°‚GŠ ûÞÎð@oÃŪ;beöÚF¶ž;ßUX7¯Þ©j–¸†¶!Ñq(‘¬ °m¶ÇZôjç¥IùF³¨ã» ¢ÂÑQ£tô§sâŒõþlž4 VÒÁVXòi)Î^ز¾[¯uÛ!€êd(I“yÊÑs [K‹èļš”¿é„õ˜™>GÓOå ?'"훡_§†{tèpŸ¹ä¶tÚ¯&XPpÝœ¶8ÊÛEqú»<µ•™ªsø­˜ ½µ¯U_¿æqºûjz°uH¶!*º‹|‘Vè‘>q‹uQ6ôkiLàV‡÷]‹é4Æ>ê÷)¦½K ‚¨ãðúýp°ÐËS3çL,–E ºôWÁ'BÿY³عΠŽ˦-pžærH—Âu¤s½7HK|ԇטX§eårþ¼E¿ kd*êòÅ­¤‰9Ayé¹ÎÎòÚ› õ&hŸ;U4„Ô'ÚG»ŒŽ»Æ=¿^·±_xHØ5‹Ž¿¬™*'K„Þ”zö¨þhFõ—]¶ÒFj‰Ž>öŒø}2N×j®RlÙ“pÀžwLvfaA ÄŒŸžÎå²Zfm­ŠõÝ Ž¼‹§Œ9ïÄÎໃŠTnòF7/ɼ¶¸0#2Ê©ñì!z#9 Óᘋ˜©žˆ{Âü³>ì¦Ãæ9?=õé%t¿ƒªÖ¦=ÁºGܥγ- 2Ÿ¡”g8û¹¹¢‡Ÿ‚Éa¡zbÚ0øÌâóù®Ï'f²3ñ÷×*:Nªä¨œÆêºp=jg÷‰G@’㥹¦+gñ¯M×ÇÇj\ ©FT“Ì&tHãú‹¦ Ç×ð˜1%Ήïl'¦ÍÛºêÙ_E7'ÒÖ·Tk¿DýbJ4æQ`7…Ï;‘ßE÷¼/–ÃŽuó ° HN´/SGµ!Ûd?%ªE˜Ã¼¸þdj¬E‘Óø=ÙgŸ2Mû„…V·dJÛnìxÉðWÃåÇ,ò—\ÞŽ_MEÐÙ —ÑÊ£…´rö–ã×ëǾ™È~Eš­w0OÊÐX¨»„ýÆxR’¶»´ý˜Œ¼¹Þ‚b’Nû˜œ#·Õ¥ƒQQ¹ZÃjƒh’ââ1©I9¿Úfa6[âuíÝD<,V'ò¡a†üj{Œ¾™Òùžþ(®£§÷!S@ÄϸªÆл×ý¦uÒ‘Œ=ÑÍg^šN ”öO@k¿’»zÜÍŠZ+ûaö˜˜Öœ°b2MdÌ®›J›ö–<p¶HùO­±•Úë˜ÝÚr¥}r¸ÜÎúà‹Ÿ÷y˜¿ïttDm ‰I‚œïµÙçšéõ_âf† Wr—´ãX$´C„=ËPŸoJfˆ³«K}Û§‹Ö&ö}€³7H°+ö –¢>§Wæ[wòf³f´„)×<½Ø÷˜(1k8ò r&ì $½½§©áÇqw2Þ7}°ˆD‚ªC°±õô3Uþ‹M4™o–QæøïÃEw"Øýî¤ õ¹2gFôº¨<%SI퇴UD$´¦‚Cc+¿Ù« X—µˆ‰—í^T„¶µ¡¸•ØÖw:•:ÐÅ~‘ÇÒ¦Î, EÏÿ<ªQÖREçí–]eŠê§¢™€ú ýKœ±©IF0U­œÓ€iƽZ"É-Î,‚ÏH\2Ò‘|쌃·‘0%®_©ð9~ßíQ)ʽ^·üªÒ4•c/– ¯P€-r#3­ª1}Ø78…b/À[–?¥“Ÿ@²ŽJ40ÅA£[‡žãýÄ,(3ù‡K»q´yð·TýiœZË»ðºYÜÊé[ôóP6w¢"§ku\Ê<ý&°³E`“X5<î°®Ó²Ï×_E¼›¼¬¶µ›"r½žÜ\ªvÍ{Vëq· +–ó~³˜úYóíicû@µïóÁ)¢â²›kTé?ùQ4Ÿ ¡LÞ¯Ý?#·?54”ùNpÚÎßœ— r' 1ãæ:nå{$éö›y x,±¿‹ë˯W{8¦õ8¼™Îï=ÐtÚ¢¸‹­zTÀÝqÕw/žýª ›Žâ{/kž ½C•‡ ùÝEq®jq‹|CמŸ{D\ê·³Õ¿¥×£@ 5Í?¡óþ[Å•éwx͆A³s˜e™rwùþ<ùåþ «øE€ö·'`Sëñ¹ëE@«óž“¡S7”œ?·mÏÄb|LÍíûUUŸ¢4“±AqxƒHZ±eWD¬`Ƀ۷a>ZMРýåÔ0ï«x5dÃÞ9ñLGØ©råã—ù3uǪ ìF„“¥Rg 0‹w@7ÏÁ˜[ô°PŸ—jzC&á^ˆ’¾9Í= R¬;Ä“±ññ' ?¢·¶~s´pw~C¬­1÷–Ev|áml-oúd"¬Šá-¯“ϾBCÍD1ûiF8a+ ,颚HyFye%“ûì£yK]® IYøÅLvU b5µ¥ ×l&óãÚOL*ØÊ|Q:Ðâ<ÿöyKÑ\°ÁgE¯Ë-$iÂJºI_þ'ÃÈj)3Á®#€‰Ûk™üÄà€êÀPR+º¯rÔÄ3ZQàu᫽ç›´‘0XâÝJf&™ê|ÚhžoJ䪯ƒ³ÀxŒªB »®fÁpI‘êN\†‘>ˆjÙãQ}[êŽtÞµé Áœô1v.o,J¢.ŒKaïM˜ªša_vX~ç°BŸ±ƒG‚¥ùþ£žç[ªüË„›°q¿³¯§±¼îrí7aêÏ”—!kT‰‰¾/Ãã´œòœ§‡O¬¼YAè½õ5Ì<ÔáûèĬL7¶"úT} È¢o«ó Áv÷/sq«î*fÑب–­×ìs4Ï€ï¼]­‘lg‰{£y?X„xMZë*ú¨‡­qS ®³ÌÊW \Ú[hieV ¨ëO†œRéY{ö79JªŽ¶*¯_n¶À>ÎL)/©}-¸ñV,×Hd"ëR‡†å‚¢Ñh·eBV£¨†›$ÆÈ8¦|©#¿C˜ êŠÿÈ8)°O¶Áÿ»P¤ÂG–¡Ø¾å;©3±kÙ[$óú0-f!\«Pž Æㄶz¹¡¦X|zSp]÷¼ëš:3- %> @aßòÌ%A¤wÌr¯ñÕ`Y¡åa/´î­Ì¼b½k»¡2ÁpµšV¿ðÌ{YAËAšÛ¯e––©Ä­siVÊý)#Ø1_Vmû çOk5Cð‹bofäJQe?.oú K1,õØ,?#øòæÒè7òdS/ÀÄp±lšr›/c’áÀÚÒP¨¾‚=®4=r?%áÔÄ’)@%º¬×§úª;ü¼¸4tT•1É«´᪛ŸÑþ/›Üèyì\K#ݘ˜Lp‹—á®A×%)«1œøš}?¯ŒD})ý•dã›w)mx(§jyØ¿÷ékÂ2Oú)X[„úæÚŽ£ÉäF󆼳¤û STIå°¶¿…Ö¢~£\h8Ó40”j“TµúƬ^üqébf¡zx´ªTh[Öù“ò¬Œô"V÷ò-­q('ˆšEr©ÑDmQö…‡Ë‡@·Á©¾«¾.ʘëFH™¸Ô×:ukY¢ë/#ÈËlæG)ŒRT?AK[|¿B"MG)ñ"Y°£;jž28êë>QÒ{JàtßJÀu£\bXÖD$ä-þ±xÝþÀÛÎ"¹…ˆöm÷÷ŸhðTÒŠ(–DÜâniã®ÂÆÍÉ œÆS¦ƒï× 0ó‰Yaê+ÇÄÆ?ÑnçòÄ4—{ mê’þºçø’vT`u—•PöÃ'­jOÿ,V`±ÔùPŒ!žsÒ°§t`üÌ™ƒû{¿ËY¯;öQtü¤­ÜÉ'ÚqZgœæÆ÷ýg¸ëÉf·E‚ÊïÀÂi¬îÒÞc|©ÄL’_Žrd˜öÈ`ë¿hB¯aÏJ_÷ÁPeƒ|1Ï V¾ÌKìŽk Á3váæwFkh½¿gC½€È1ù6 BC»Z¾…*N”og-&M·ÑQ¦2®³PkðÂDr;É´k?òƯ6œ•MfVøX Hg™~¢G2ïJOPï9ú¬¦Ø?|Žý㉀†ÉM^Œ“eñ»CŽu™Bþêª|¶j|f kÿ%‹rÖšÌû] .²ürB€~.Æ×püš&J`q›wª—ÚMÖƒ@0Ih””Ý/4û`F;wâX~ä%Éæð»uL°«0BevNÄ®+`ÓÞMÜ}"S{üÙ@\7õÄ & +öó¨™K'ª9îá ûØcÂ74]•ð.‚3ÈÅ€Ô ‰ñÐ bNn¢÷ "¤L\ý_‡§?ô©Äp`¶ ·lž,™}ÇãébÈ‹#䮓)ÿêcü^“÷ëD…>Kk™dP÷ò© Ãf`ÈÂܘ*`ž¦Ð ái?ú8Ʊüؼû6súòLx¢Õ¬cD‰Âòïó6¾ÌÂô i—Ž4t^·9ÊbàAÝFD¢‹ÜPGýbévt*¡‡Çz†ær®"J”NˆˆûÅþ䛶ðcëtÜ0¸Cáo«Ë^k\-ý=ª³m~ÃOøgæøV¢ÙóÝYdι§-~X؈qésîKÛà$%i¥Œ;PªGPq”°›ÌÒ¬úåt±éq-["Æ©Z"&ýŽÝz§†ö6ügy$Êôr±Èn\€D!ÕùÛï–¼ñ gJ:ÁÕñ§¯Z/ñgôXPI-~Gþž/¡Ÿ©–hö%éwÏ´[èAùb‚”’š:PLéÕ°sR;ØœšåËÉPz:Ÿ™Í"¿:(Ú$ŸkAf΢Ή,|¬ƒ‹õw#í¢Ö¡oïqŠ5Äæa_îfÅd?¸ŽtúÍyzoJY#œÓ¶e„ 47rÅ1kÞÄ«çM¿›)Ø·ý 1µÜQ¡ªäðSYË’ÂS`ï÷^¼Þ¹*ß0‹©²)QýÄ¿^Jù \–{¨‹5„z'âaS>ÌŽ•ez¾Ñ4Ûº•XuZÏ þÃÞ%K5͈´ç™Ô„0¬…i@¦ªfâ%GZ“2´H ݨәòsÙü\Ù\Þ§dÐäî2¾•òŠÑÀxÚÈ  mh$3ÌkªLþÚh'Õ´¾î ñ@x€–ÝóÁøt–7¥ÒŽ}kOw‡ŸøÄG­Þ'bìo5õ±[{\²–:vð•ª\wXK÷ G˧œý]u;¹U”ŸàMÇm sý“+±â¤Jλ°°¤~èmÚÁ>ƒˆ|¯ÓÇfü¤C¿9æå.ª~FÁc|úýÁo/£¥ÞüW¨˜»:k<àD\ªhÄõcI:ï$Ñ#ÀMÉê*wëÕÉx’íÆa¨st°•¯7Çâ'Þ…²ÜíwDÆÓAS‚¾N­òAfˆªoÅ-ô[îAÌ‘s xËÖž[§áßo´ymÕ³{¢n"6`—‹=ôF²Q…ë )L'áÍx †Åƒñ-ðÍ]£“2N¯/³Œ ÏØ7\þöà"µQ®[À,…ðs•¶ô໲}“ÖÊ­ªçÛ…•n\Ó_8à(Þ@Ã¥–X"q[Ÿ•ŽŽ±ñ/}KžD‡½H,,y2+õ8·_`P ª6­ë¹T 0Pjö2‹Ï>Ÿx—©*y ì=k¾”IUÁ÷:S…•CB3Z/÷(Eßnwbôy”>Âg®Bo«!³TY*múGGpƒIéÙT—ìZ%'“Õ<VÒ¸1LW"Ú6»èVÎ7~ržÊ!!Š+H2äz¦·ÌúGM©=Äßlçè‚Ü1N £¨ÖŸÀõ"ä +c]?fw' sõÚú–½Q[dÀ ºyÁj Ïa'…!…²£¬RFäî‘9™i ЕöÈ-Ü3vÊ1׃”ß=éÁöÞ³G®³Ä´ÜÚ„AZF¤ry˜?Ù“ ˆ¤‹Ž›~/~×Ú@m+óÙ?K”§´ú8þ¤•BØ»/Ši¼Žõ8í{;—é·Ñ¡\1ÞÚgM5Êë8Ç<,tX…™{*qw Û“‘g’Ïa?/Šƒ ”¦§EÇ™ÿ$ÕœT¬vÆJ.Ìq™ò+¼.‘ɲçrÞ6„á©>IVë(„ÅhewK@䚃ÛÈý:ægÏ´äõ™ZØŲÏòÁ h\S&œ½Ÿçú9¬ ¸ >ã#ÒÑ„…ºbN–Åu×c H¬*É'pŒGˆmÉÂ#PöåÍc¸Â9;ÊA¤ÌÍÉöl®ý· c/3L* ¢™È-j³0;º†YõØËÕ”ñœ¯œ£Žý‚9d*¬üÊ¢Ó·iKÉÞlÑGµ¾¹£©õÅ ñ3 di‡k5K:>AêÎ`^ynœìƒ†¡^ærÎi{D²¦)@¸GçwÄ2; =þ‰zL9©*ŒÂu®[‰]¦žl@ ñØVÄÍw¸áÑ,ӆ̈́¦µ>Ó¨_`ÄVV!¥…Èñ²†0…<éó­ðwG­~#=š{T8£ß‚ ÍPqÊLå÷8ÄKnz+b?î¥Õ!ò¿óÃüÊͧ$îÿUBÞ"¸î¨ ³¸Íø[Tˆ4Tœ<ÿs ©Âí®½Þ"\\&ãåÏ}j[;#7­¬“e¼oçÅrÅG¥þüŒM¡¹†µoé³Ñ$ñ'!gl‹u”ºÝhP-sšÕ­Q˜#ÇKp1KT½ª¬ŒÕä$w€ðU¶o-Hnå$¾ð„EÖ€JŸ™Yá›RQ¾Á”N}zÎKù[aÄ»¯B²^Ë<Õ¹d Ä r³®ÔÀ ͪiøû¿øJ:HH”™ŒB••ç3q w¬”p­pÛŸD–9ìWÍÜœõg·ÉŠ/;˜ ²¼@ï½Æ Ì`+ñÛ8] FuœíMºj”35rÄÔ3O2Õ€–¬…µþ(È÷F½ ?­¹X.¥–à¶`=Á7½o±”ùÄø‚Øvgž¿E›d$ úZDý[èRþýÆwåì«>ýÔáö–É 3çÖH—é\.1õï×y?à¢vkwÁx3?¨5‘ìp‘¦(€[†g·+ æ©ô‡Éû¸H”Ê;áD¬&>;ÚÊv~•A¬`t‰âÑŽ>j­{Ö¶'Àã^mÍTg®÷Éú,{'Aœ §ÕY­©NÍöÇsXX§Në´zŠcëFŸ0Ò*¸dH'‚(«)J ÔšQ™j˜BÞ‡Åcg0—讌¾ PL)%UÍ‚B–À¹Þ1”su:PǬ´µ$f ¦¿1f*‰»íªén•‚@¹VŠš7OY*  Àù>c5àØc“ÕvQ ò³ùÿŽ¬ˆLS'enÝWV §‰â7& ©Y­hcyùf–B,æk8§Gï©ÔÔN $Y1e¸ýÅ´e ׫¸~!~9“à[¿–…t|A£ë€ã°„­ýFáKV‹HѦÆ¢wÕ\ù©L0æQ¿#¸§a‰²„ÞÆ" q°ˆØ1G]iK6.¶ÖãÕŠC¥æ%÷ßœénI4RbÕ†É?ÛŒgåa#Jò áÉ„²¦+*§Xµè¸Û#O¥ýV.øN`ˆM'M±ú‘Q› ÏzÍu?|Äá²ïÌíùÕÓ€úM¶Î¾çñׇ!äªÔÖªSö]5p'}Qù^ämŠouÑïEÒé€O}HäŠõ|)í(Ÿ´æ<±ªŒéÔÔ†GÝcÁ½ÇŒ( ¢¿ëÞf^òt'GÔ½áÚ‘5Œý̾ñ|w8EÈ@>ïóÜå…!äN†ð5¡ ¨, P="F¤ÄæU«£Þyc º§¶ú5}ÔMÅâ±YÞ7x»n©ìÙKì^Íÿ~]¬é˜Ð¿úün­áÍ—·–¬2̃y¢8º«èêM\:úô[ÂÞŽ–/Üí¤ÚG‰O‡ò\ÖSÜì}{šhôçO>Û^as%òäùÜÖÝwJöXý#£.•’ùGðˆ¿@Y½Zª|Ô]¾m[‰â ZbËÞ«†+'Š'ڔ˷à÷žã¡aëe2Rãîy¡pÅ¢Z0ç@ƒLbÀ[® ŒȬE•.ÚŒ¸æÀò#u¦É‚(°ÒJ:®Ãí,LþÇa:¼ßŽÒñ9Úå¼ÕȯÞ7Æ b(pÁ²‰B¬š¬<´¥…ÌGM$C«ä]‚1?u0òçÂû¿-vÝ÷è?†«€Ìª»²~ÉöÃ7»|Í„ùþé˜}u?\õ é¢æ½r‡é %«²£ëÅc©‘ÈÇ.âlNõ·Îs%[B¦æ¸óæÅ:¸6 ÚCÔœžâFÉx¨wÈÔÆ'I‘έuB‡/¼¹üÊ >=˜À@ìÉ#"é‹@MÙ“ ÷”ÈiO“dí2Q[¬=ß–VQÖ{tз²Íÿî¨PËkðÓÏõ5.Çf©ýž`ç¿éÓ‚Ø‚ªR·ˆp¸Tm­\i| ÉewÍb¥M ²Ê„ýº³Çô}#‡_ø £W5Êu(/‰|Ê7dLû2ÃÏY­o ‡¼¹Á¹ ¦®ú”©³PöPbüÛdá]HP>Ÿ¹3ðX:¦¹ñ&Ïß®ÿàJÅP}vŠtçGÄ˃Û߄륧+š‰]ÅD–„Ò˜þ‘]Õöw[~ßüÆdÌOc†,ï=i¤Æ‡{µÇ Q£º+d`øyöU0m@Äâý‡zÒM‚¦~S]Lñ ¶3¥š-Èì] è"Ö‹¶¸™¸`Q®ØF¼Iýy˜£7VCÂ)jµ“în,7@î Z~%Õ*5»+äH¿bËc©œS·­tŠ5ÒZ RÛ&=é»AÛ§ïÖ½‰ŽÌH$/ô›j wü®‰º·¿ÏÙ__#¤{½Bÿ/ç5ÃæÈ ¦a*ŠLŸ7%œ¤YYå¹Lñ ´ªÀ‘û‡/Þ‹Åh,' ÒZ(Œ— w}¡µ9z{q°|á!¾uÎ]YððÒµ¬º?ˆ*\u—ægG.SÖËÚ>Ñáúß)Ðyó¢G¢¼w¬üžž”¥`:®{Ò©ö£«b½½‡„Œëpq)üû‹ CáW«©—XÇof-)â{ \=׌!dÂòž_«‡ vù„ Ó4Z?™d6nŃÎy&N¾†Í/¡Óo+B9ÃZ¨#íÊ“ø wÐ,{ÑïìpÖ)^eì@#\‡xK“ð òxNt°»1ÕÝŠt³º™Z¥ò€ýTÊu×J*âsú pÏ ó-$º˜Ÿ²éJ49Þkƒ²»b ¿ }f•öG64HQt¶f}KÑ^ 4óšOÛõ–;¯¶¿Ç Éãÿ¸l¸šé¹aù¡cîŽ3AeOq÷¼ÝýQÆøìaHCñÙù]\³@«=’O×KÀG5©³ ‚ˆ»«ŸQFN'+‰ß½jTt@j5©«zy¾e+·—ó౫æj jŒ8Ø¢[/L‹ƒ•ýqÜË¿P‚ÒêG»ù>ª )Úzãðk)Ó”Ð\B"Pz˸1ï¹e ÃÍMÊ“§:>b^sö¡º%G$ë«#þá'»° y'Uf ä´BhÕ5ßÂï¨Èt¡ÁÉgEv–±Ã§C]|w1³)‰ƒ02%ö.Þ¡ÞJ%¬e’¸”;c¼IÄõEWÖ±S_án©É~Î%· t+[9 Ÿ>(ƒÂ®Ây*|§€ò¢vf4(hmÀƒŽÔÒ:N"ª˜OÜM,©Ì¦]¥´½Vu÷Þ–åKj~,˜ uäÆdá Y7ÛĶl;1q1Š OýgÜBæ̸—Ö®êúÁê£2,ÜLð‹¦eZJ÷Ëh/Îzq^1e}Ó0bN‘œ‹›å„¶-‹A+TCp ?FÞS[àûþâ´E°´+t¥s j©V7%úÓÔ,ÛyJÙžõÙç± ®ÝB*!ɆLÚƒ¦ÑE6ï:½ eMªRTgù>æhK£1Vã ²Ï?vÃcoì²r ¸›âq G`?… `8 ‹D €¬EÆA]Ë~_V!ˆÜ¾¿¬2ï|’%%3#~«6OÂë{V ¢sõŽŒˆb&örÙÐ_tg²Äzêüx£ ˵a@¶Žn¥¥Å(¸wm0'ÍŠe‰4Õí{¹Æ:á´¤}VÚö;å ½Œ#h§ŒqUÑ%¯rHGþ-tzx )ÓFPï¼åv "cfð°hUæ6–ÏM´Ç+³>ùa¤m›V½QBÅqy!*So“7oZÄ/ÇÊ™ î]S®Ê„5ó#)º/wáTœ¹¾rÜcg'3üQßÀ]‡²9·‹ D "ãê°¿=J2™æa]õ–…g¸¥ÑQÁ>Ö°Žj~‹Ð·[×ð—Ñ<"©]oا„…p‹Ø-#'XCF½ÙôáÚ™œƒÈÒ|4ž@GE‚®dÜ¢d¦ è£v¯…ùÉ͸kMŒz§Û£fvÇ´ŸÃ.ŠŠµÃ4&É¿yêiØdôÏu|ÒQÇ?ÓpÜŒ`í <Ú^¯Wô1p2aµÜ–i¿%2%Xœæ¨qù6A=žlu=ui}áuÿN—ÙÙ^Ÿ!ýFGtiD¾ü»ú íA{\™»zP¿(Uá½*›<qÉÎâU®b3Ûjþi»¡—SꈡÌ)C°ˆ~þ­Ñ)¡¼¥tH.âh\­ìx–º}2ž¦H7î˜Á Ü“ÌPSWÏMÄÖå -Ž–K?Š`*j`åÉ"c úU—ûï1Å8Ÿg`›ÈÎ.ÌÕoØGuc‘ 3¨÷*–[Ò¿ƒìªLòùAä}\éFñe*‘ð›‡öÖãÍ ½G;Œ+­AeÑê qËMØ D7•\g:7€Iy ÔÙì ;7g“ )¡ ¥¥Oíx$4-qÕ^†Ö–™8 Ü+ò\î,Ow8Ïäôœ3Q.ž5Úš*^ZYíճݑqiUÙQÈ1xÅØMBp_K©×JsÝ`ë©ÿ É«Ê2¹-Ýóñ Mx}Ì<¨»Òñ ƒÈg2ÇQnw ÝÜøª”f/ÕüŒ¼Y§Uúé¡•£g¹ÜF‘kv¡Ò ¡ZM‹3Úü{s#þK(Ž¡±r®Ö‚½ØëÙÙ@"²‡YÈ\ðƒÙ ©.R¸²kžéô"ÕNˆla£íN“X×»Jø.œî0ôè)>¼÷=ôF8„¢±?Ú¢ÎþÌ£yyKc'ç”»Žq¦w®N¸xñS›ŒÞñVŸüæ€lq:ÄÓÞ&g‚D‘íËÓÝ_¨ÙsZÓ³™š–ýŽTméÊJ”çµØkÁ'¸Íª˜‰X´ké’–:.I­‘,K HÿÁœr1 endstream endobj 156 0 obj << /Type /FontDescriptor /FontName /SFYMSH+CMTI10 /Flags 4 /FontBBox [-35 -250 1124 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 68 /XHeight 431 /CharSet (/A/B/F/G/O/P/R/a/b/c/d/e/f/i/l/m/n/o/p/r/s/t/x/y/z) /FontFile 155 0 R >> endobj 157 0 obj << /Length1 2505 /Length2 16736 /Length3 0 /Length 18219 /Filter /FlateDecode >> stream xÚŒ÷PÚÒ càî6Ü5¸»»» î®ÁÝ-¸w'@pw·× Á]ÞœsÏ=Éýþ¿ê½¢ fu÷îîÕ²7CN¢¨B/djo ··s¡gf`âˆÈ©ª23˜˜X˜˜XàÈÉU-]l€ÿ•Ã‘«œ-íí¸ÿ°q¹€d¢F. C9{;€´« €™Àü‘›™ƒ›‰ ÀÂÄÄõ_C{'n€¨‘›¥)@Ž mot†#±wðt²4·pÅùïG• 5€™‹‹ƒîïã![ “¥‰‘@ÎÈÅh ŠhbdP±7±ºxþ *^ nFFwww#[g{'s~j:€»¥‹@è tršþ¢ 7²þCŽ jaéü…Š½™‹»‘ØXšíœAG\íLNPt€Š”,@Áh÷cÙÿÐþ)€™ù_wÿœþË‘¥Ý߇LLìmŒì<-íÌf–6@€‚¸,ƒ‹‡ ÀÈÎô/C#g{Ðy#7#K#cÁß©Ä…”F †ÿðs6q²tpqfp¶´ù‹#ã_n@e³3±·µÚ¹8Ãý•Ÿ¨¥ÐTwOÆškmgïnçý_dfigjö SWF5;KGW ”è?6 Üo™9ÐÀÎÄÄÄÉÊ:€&ŒPõtþ­dþK âàëí`ï0ÑúZšAà¼Ü€'W ¯÷ŸŠÿEpÌÌSK€1ÐÜÒî·whö ê¿“¥@‡ 4~̦¿~þý¤š0S{;Ïßæ·˜QTSEIK’öÊÿ*……í=ÞôlzVV;+à#×G€ïÿzù—ÿ¹ÿ-U4²ü'·?üIÙ™Ù¸þCT»ÿÒpûg.¨þYjÀÿF·M3@õ{øu™Ø™L@¿˜ÿ?¯ÀßGþÿMþ_^þ_‡ÿÿf$îjcó·žê?ÿ?z#[KÏ,@ÓìêÚ 9{Ð~Øý_S àÖYhjéjûµR.F  ²3·ù·–Îâ–@SEK‹¿'æ¿my·±´*Ú;[þußè™™˜þ´r&Ö ;ÅÔ¬¿U@ÐFýoD1;{Ó¿V…ý#ÀÈÉÉÈŽ 4_,ììofÐŽš=þm#ƒ½ èÄÎ`fï÷WK?²…þý}0 ÿ‹8XŒR¿H'ûqåþEœlFÕßd©þ/âYý‹X9AÈÖ4A]ÿ•2³€Ž9›X‚*ac üWÎÆò—Ô KgëßA.Œ#‰±‘‰µ³‘³ÅÙþ;ý!‘1v22ÚÍ\þ³ÿ#þÏ þë• Àhò/bE4±·õèßÄØþ’ØÚþ&öWóÿ`ZaÆßD>þ…]Aóýo!@ù€úbcdûdzßQAf–n¿°ÿ¥¶wýƒÈÄüwÞü¯G ø§ (Óßuaѵðt°Úýa’YþA­°ú‚Úgý•â7‰ Î6ço=¨p0ÝNŒ¿C±ƒ|ÙÆúw@¡í\mÿºPÌÿH to2ÚÿNäÓþSÌÌ ¢¿Õ  ÇÍî:ËÆüôËbš>Kûß­bÑÁÆõ ÇžÑñw’  :ºÚ»M3Ý«ÿþï81ƒlÿ(>3ˆßo¿ì Î@[Ëÿ%ö¿l€nt„äÄô&ü› ¨lÿg¼™Aá‡Ý«Œ.NÀ?FTwû?€|¸þÎóïçßÙÄÞéÏ‚ºëö%ìþÇ®€œzüAQ=ÿ€ ¦xýÎäÉ èôŸ þçÆ2quuÅåïGtýÿýŸè4[Y´7á ¶ªþv_+„ïN¿7É7G¾§‘FMï½âÔáúˆ“B]“¸át+”2Ò‹²º#Fu#øøÅû¸µ&¬-I©ýÉçÙ Ayf¯nykpªðX¨a€–€^UpßçÅÑG=À²¼Kš<ÏÑ•I±ýÞ½_£a üÇxèâžÒ~ÍGøçòYúµhÝ€’yò|ãìRhzÂ÷4hçÈó7·sh¹SoÄÒ ´p¾'1¬EÞÚ›,± ^k•ª,Îݸd¸Ú8„7hã3ÞÂ??Kc/y—Goð-å0Q3€mŒûŒu‘œrëÈJ¡a3Ù8­pIŒ“ù¶70hö!Àfí©:ÐÔ;#-áК¹»‹K(|-î×߃½ w¢5•s‹ƒ‘÷ôÞßZºÑ:¾‘9>­ŸÒñÕ1Û†…ÛÆ\m^} sôŃ&¸Þçìö)´Ê,#«ó:q˜óØ÷Pé¬;sE‚ƒ)LIGFA/Ìhæ I¸©CgÓ…­áj7ƒÕí¡ÖÁý.®öƒÁñbÿ•í4\;SæÉËÝ ÉÓ&yªXŠÝ­…ØÊ$áT³)=’.‰#·pq¤\¦Žûþƒ ôÓjÁ™vñð ¹°ƒ»ƒòü'SÔæ´õÇ|-?ù#¡æµ³ÃŒü¾¶¤jDÊß`DJ²k1~ßáÕ®,üY˜6Ž…/6Q¤36I‘#ßËösáî1zú32Ž…ƒµYK¸¼NU9–ðóÈèex¯€¹rºLYƒ^ÄD<¯Êœbà×î7ä¸Ê"¾›òmq‚¾¤½ÚŸÒƵçz´—=G=†k¢ëÃê†4(DuæÁ2)КöÚxH¹ÚC}|;6ºúfŒn­ ^&cò¾I7­ÙíÇèݺÇÌɵÌÑxØ~]ÀÚתNÅç?YEdpÚC¯Œw0ófíöù(Xq{˜Í£wÄXÓiá35Íp_¢,µ>R+3i›es«¿J¡±êµ6äMÔRpþb+Þ·ö«‚0»1µ ÿûBúk¼¸Ì')¬Ð"A,U¡U¹'E¤HžØµøhÉQZËPͺßúÄûŒ}«-ͱ%× âo_؇Ú~Ä K}+ÞÊT`=—åq8(uÄ°1™€K¦Ï/°»êœ ºkuô}ÎÈÙËfù¦ã2=;2úùû—èÆ,‹ëôȯÆY[¯4+„dþp¦ƒE†‘dÅ„ÌîÒÀ¼‹2êØ2µ™_ƒeÇÑfØÐè¢M….÷(󦩽%y|•™YìWßühñ› Ϭ8zÈ-ßR±¶Ñ‡Q©qÁgÂÇTÁ¦ÃñÔV§Åëîâ[™“]Ħg[Ö g ü±™qû¾Ô‹ë+ |¦ÏNɾì-vÄ †ÑÏ"yŠ† a6w¿;`éÎgc,ÎËýÊÚ%X±­[ËáõÃÈëh†™à:¢…a3ýü* JÌ#P‹²m¸üîˆ=\ÜÄÏΪ“e»czÑãg¼;3BÌóýøOVã\)½°¬Èϯõܱ㻈f‹ùe«GQI{GÅO¥fæ'ä]ùO¼–Ä DT”Þeq õcHî¯*û*ÀLJNÑ·‹±üí–©Éî}_¢;ñ*á…Rû¹˜¶„St}¨ žÔ3íâ\høã•7Ê”øªP$pïñ´ˆ>£­Lဧû)öµ¬BE[¡ùaÚ<õ¥Q¯µÑ/‰™&XÄa8†¬úªHp¹Šnpxµµ;=G• zwÊÊ™å"E"Pú5ì/\®…N·h†„ÉV‡¨ë¹K¨4(÷é ÃÀ^…$ÊpéÇUóCS°´,ý¡ƒ…鬳!K(Pü&+ÄH3]/ÚW´6Ë ñ£Îè5R¥TÍQBÛ¦?ÂËP"ËlÏ!Ròç¢f‰m*ÊÓqËýôŽTa•`QFü¨›»)@¾ ¥CéÿãçŸ8ƒ£EZß»;-üÜË'›@£òR÷ñùj5‡‰êªëí 9®:è] ióYcw’íT„ñoÎý£ª³É`U¢ÝÆ#ÜŽ$z~–ƒùîíI†o? Ë `¢)÷z 7-ô¡{TUã¤*ì$#€6»Í¨‰—±w}y†hk·‹;iþ·KkÊR"‡ð $*>¨ -æÖýÛŠˆ<µ®™ÊRÆ…Çwªpä†'ÞÁT82Ü "'–2\]’ôènÛbÏólìDá{qy+mÏ‘ýt×9%¦Û6ì”ÆcÆkŽtŸ%o Iµ?9¶`ååíî´û%.ßÁ8ºNµ Õ-Ê%Ct^÷˜?Λ2BB0ÀØŸ~¢éïøŒ¶ÕÖ‰<ÚÄp¸k‚c>«÷µGö—;¡úüË[oÚYn‡ÐP€ŠÓ4æ‹‹âƒv™…†Vª?û½„êé;s—[®¸æó²U<‰:ÔU5;ßÑ E¦Vþ‰%ÑŠûUè˜v)Nv¨›HM”"ÐkGªn=æÐP¯~UF4Õ¦jðñP0Ô .RŽ K¯áD4LyŽgþmuþ5üÁò˜Cj°¬ƒÄÃq›Èýþ\ .Í:¬>1çìNLW­ƒË¯OËœ0)iŽ¢²ßb½WO ë1’†MÝ“ñ}–‚%¤ß¼[²~JRvj“G¬€¥/ËMrÆnÆÆ j£Œ‡Ç‚¾çåØð®‘uXGí»S§&GGÛúi=ºÊ|’®j_ø,bçËÆߢýæ4\ëÝî„Ý£¦ýÆ%Vž»8/Q½åšÀÆõÓÐ×±s‚1°pëÓ!’Çöç8•Ÿ,3.â¥JnÍ ×aa3 c±gw ž§t{ºnXì"aYkk™&o.³÷ææÏtà6‡>ßðýgqä†h¾Ì“ÝFv¹}Xmæ?áP;19ô›èk†©£lÀ³û*<>ÉqP¬±>Xñ Sºò¦¾ŠP–&ï MËõö™5ÊS™j¦÷uc±4±·;’´ÊktÉ^¡× Ù§ÒDû•ÀK¸p?H°EÛ_ˆx­óaSÐè Ðãó¾±@ü?é$f øÛŒVwȯ³¬EìˆCÕbsáF(ô•.µñ#éR4½^øïïF&-¢—{ò&»K/BÕ 8ý§’¼òÖ;eCü!’°Ÿ¹‰d¢xªoó5ÞÈÇ5“ƒo È–ø±G¸vÅõM3„'‰¥•©À?êЫҜ²‘dÅÌxjRÊ5½PAÂW½¯9•C¯Pú0h–à¯JjFM %¼K}Õ,¡HTîì:†×+e‘õ? íû…p!`AÍI1ŽÉ(l„btû9‰»)¼éÜ¥EŽw R“ Ü«ƒyƒì#f‹ïS€ï³Õžå6Çǃ²N¶: xmcà LvÎm2_ÕUé§}+÷Ú%ß…/a“XãX)ÕŽÊèØCRWM,ó:5¼éVTЇ«Q)è žvE=l´Ž‘¦‹V,eð®×”çŸ)mRtɤÙÙI·;ƹS“ÃÏKœ>«?$¦rÖ×~éò´I"ÀÙ nA›°„oÔxkNBcä1“pobn¡¶~ÞCÁrù@Ô·‰%@Þ:s—b©ÒÔñÊÈN€…øF7,¨SEO ­èCÞ÷Ÿ(t»ñr-Œ4‚€µôh4\3túFáÔ}@€ˆ$ur‡÷½Õ€õ}"³Ê‘Šé»k0œ=-²³CêÂÞª›™~œ%îw‘Xg])¨zð÷ÊhzÓâRÕªÖç™VæÆ9’I¦ï¨¸áz¶Ud0DOC¤’:8v•_ócùUòëzyÐ}÷ÖOœ0ÑsÊÜþh_ÝÚÔz“?¼^é"™¤º*ò2µHQà™vÜÐã| ÃðüÚ"n/ë„èïÍgÖÝ\IF ¿𥹠" ‰BB{,t1u.ÀÊ—÷2inÏ(y d—ø4á·Üû58b‰"œ7­ @ÜÑ3vö¢ìæÞ›2Òj,Oçgá…{(fwÝà“&R½|¬J’ Çç,ÕÚjÁ²ûŠ>=åý\G€üíþñ}ŽËÛ¬¯âóI²K?fA‰´GC çÒðœ2Á-l]ïQC×µ7Ìp|⦒kòÃVÖžð¸çŽ^Ý'»ÀPyi⦣ר©Ëô—<ñ*ëÊzø†w— V]©xÕß÷ia4€x ÓÎer ê©QÔå÷iŸ¯z6aÊ¥/´Ô/Æ29Oº™{^ M?HË2c  Ë5  “d—Œ+õ üêl53i™žËujì¨ç5·ùó+5]«FfŠ/@eïBïØN0¼Ð߆}AÒy3ðéfsðˆñr»-jÜZ`Íuß|×/ù%?jñ Å—’Í&e:yOð¡¦Ë@Aj£•7sŠÑ;^ÊË“ÞÔiÇÑ ?¿cœøCzcfñâ>xi®û®Q%»l‡2ßË·õظ©hÎÄZÑøý§Á°e8¦üºÞ¾ûâ /ü©¹*’`DÕ ¯QÊådstED¥'Œy?…Á O¶(ÄÒ 9{Ò‡žå`ÝÕî²NØR—¿÷ÓemZ‡in´Ò—õ´hc¯å iZ²?µáw{­¶ñ®{¨í‹L †¦j} ÅÏÕkÛ°uÍüøä«pˆ+Æ jܤºÐú)Õ€5R½ ñ 7ºŸMù4Ž«°~ºéè| ±Ì>T:5V£‡¢ ³ÕGC›ê!øhZRvDp?l’ÃT¡ïËþh°£FT¨QÂ%nÍjv·369Œ ©ï84QšçáÒ¶—¼”î»´Aö‹…5dzݤȇ]Y"ãy̺s;JNÌ‘çáòªjl<±ùPJÂ×f,@ØNhÖ¨%î•‘ö À怠t®ò–ã4ÒØ_uVð3©~²»Ã¤U&fÒ‚…&ó]åMéô»FýbGdÞ)ª_W~=ìÝðÁ@Nƒx£I}x|bXÓTZ› URo"˵nNê ?° B߃ǛA>È ,·Ú0gL÷hϯ•Ÿ9œSc¸49ÃP ¨Àøàç«%#£ø0N×9w'”öKYqœFÑÚ’÷NC|/©0qóØ0ÜeR!Ü wÁt•œß6–ìÔv·"—Û ÝÔã?¤ï†ïJ/ƒU>"a=DîŸ ÏzºHXÁýß k©š£¤AA‡®óÅRÍW5J›  Ï­˜‚0ÃÌœ7Ï-nŸ=×,6 uIfÎg¡ZDòÞ(½ÿµc´T›—PQê¥H£4V–ª²¤¼gJC|`#Š½gŒn5V†áÞáj0P‰CÀ´ÃZdÐeÛÇÉøsÃOéâºÁÕìz»î‚R Vª }[`ÝѪü"n4ö8c®ž6§9_mh†pÚ©`»½ì#…ät²×¢­Ó;Ÿ>§z´+‰rî°Ki§×fÞuª s ýÞþƆO5Š‡Ðúþ2Ûëó¸Ø=›ZZ!¢cI¤÷_“É0ÌZ8ˆR¿glø¢¶&jŽíÚÿ ?`}΢ܦU úpÜ|Êõ¸çïL\„M¤`¸ÂÿJK¶ÜyoÇ%ï‚ŠK˜ÂØîji²ï<±+íïg¢íÓ܃ñŽLdXg†È2r x?KzöT¿Ù9ȃÇê#”à%¾¥Åv«³¬B 9š&½U’sHýé ƒ<«ÄX§ UA ïb€3WÙ=l£uH¬Šý‹iŽÆž?ÏBµÔdzˆdMJ]ÓÈŸ2×ξ,ѸÞJBÔîxÒG.0š›±˜–¬®ÑÊh¬ª™Žì Æ>DŸŽyYžº9p…|CrÓñŠd5ç><1¢PBrOÍ_t@4v5&”µc^pšGK“ÝHÐ¥¼ËzúJga P›$®¾[¿úœñƱ%OÂ)<Úk>°ŠaC4…Õ´àî'Ó¬"0Á¤Í[NøíRN?Ç^ bkñW2"¯f¸©PQÿÓÐf‹?-, Rç&¯­D«[Œ§9I#)óañ©np²RªAÅuDXJµ%zaÞímø³)ŸV¹ÝÚ̧͆Êòî„ÉÑá¼NÉlÆÉ~GòQ)¼!ÝÍëâ s è¾rÁgX:4,3¾Kk¨P§¬1ò8Ç$Bè¥ÙšÀ‚Êoÿ%·'"r]Q|Ã4Kê”ïœ9©"R½Á×;ë9Šð¤3ÿ4¯ÏKB_ÌLVË.›¼.‡Š*EÏÿŠµ,uÆfú! MšëŒ"]*2äC`jÀ£c°¡ÝdpbJPýå5™½°¦”RžÓY.œ†VŒÛ-.r”4òë\ù¯2¿­$£b,ž)-„XÃ[„»ºÉA`Ìå¯_e¤ÆΛ–ŽütýxÚv£„}¥™¬û½ÑÀéqª¢:óÁeû§bÌo>²凖·Ü¦×ÕÊÇw5¹”ÛÒÜ&Vå¬Åf,pò‰Mܬ""ñ< (£n¤¼~Xà B\|]óaF‰s8ÃÞrcí‘Í·¾²ûv®ÙÅ~8El?rÕuÆ7i BŒJÉ\n+♚}G‡æzLfžk¼w+xy3ÝNîV¿n`{-^‡ñ>ÂO€]|žþ²Æ5Ó@šeèÒœ>šFæy8]¾˜¯~ÐÓøŒÓ»8;Ïÿem‡ 2õÆX±P8±Eƒ†P[dd03R!çH%Àö˜©áÐÁ(»-pr±» zO%¸Ž}2åŽÞ—#"ðýü Ö }O& öW)‘ê8oæáÖP¡È´ í†]˜j\'…*‰÷ðxvihwˆ1¾ÅpYî°o£Š¾ÈßÕQºËö""‚ïÑ¡Õ[‘¦‚i¸5xÊM›¹e¶>PÐ-„JÂT‡¡Ì4“Ð 4 9íǤH*SìöøÚH!…†“‘þv\gÉG…<–š÷Ó‹;PÇAvôÈ¿5£×˜ eãVí©x½òl=§Cè‚Úæ5ã¾Ë3cfRÄõ¹æPA…óÍ;;i![«RšÍÓ¹õœ’̉6Ó%ã%lŸƒ:˜zÖ"JVc\iqG–#‰ºªÁüÖ¿% té*a"¡™”!¼ûÛ› E,ó…f¹[nô6›ƒ æÆ Ï63 ¡œ¤‰²ª ƒµÕ£ŸWÇ p¶[u‘‡{l¿¦ŸîÜ6«Ÿ*çÝÇ%–4Ђ1C1Î9³&¼ãÂû]ãÃqƒ†óXÖDß^”€ýOzSòB/3$ŧfÉç䯳éýC÷µî½+ˆþ'áÇ}c tË]J‹;Ñ}•Qåàc¹ïâ+D1ˆª‘°ñ]bX~õA4ŒGÇfÖ~•5Øÿ‚Èe ?JÄOé^æVU3¶É4ñ¬®»gԴ–«ŠÉ A[zõ&¾«y=A·’±§çWæ•÷É(š9s?SdfxgŽHZ­ê»3#,å÷Šn\ðºÞ“$ë°.,!¹RœÅ—‰Ô¥¼$=;«Hrºô¸º˜†;pJ|üWŽujÙQÇdóN›" üµÛÑ.ør‹/üPRWå‘êUãE7MÉ*[Ý· äU Ù•‚"ë’©¸œI?j£ÀJ†¯Œæ…¡¶•e°ñ;ˆs| ª-ä1¹ö¤RKŠÃœoüUXƒ•íz'»1,xSÏ·™E:>™žx63˜|ú@Ò+õ¸ñ´ `¹­&÷áh"RK=‰-í×n«°i<)ûGþGÞMçMŸÅ† 1¨v‰!Ù1ª¤õÇ»Ÿñi·õ„#º „`¹ð€Ì—¾ ¬ˆXªŽvùT½tKßð%¥²?¹3NŠ5;ƒÞÒNx²8ŧ ±¬/ƒý‚¼Ž_ìÏƸ¦Ðúv§dž~|·#ÐßÉÿ>#§DîËpVxKâ wÙ]”>ú¤•ºPrŽ¡€«ˆX6ô`ûL¦›W5!`Ä”¬%„µy".]=ºþ|Ûìm€®¯ªÖçU.Wë$÷¨ˆE Ž¸áê²ñϺ‘ÑØŽÂA¨›‹S‡’MÚÈIXÙª³Œ5·4¤Œ’g®šÅN†§Ø¹§P¨«±>SB J,I„hV¶Pþ<Ý¥oŒ‘ò’ÿŒ[^$+u{ÞâIj¿ß}Ë;(Ó˜ÔQ:½goâ×FIþ}ÄÜ«}áp°ßÁþUìœ:É=ÊQŒ›c&]I´² ·îK³]{*Ç< ýb„L{ÕnãÌ€‹Qv]‰Ú¹p›J¦ÒÄnâIqL¿ˆÈÜØ^"8:ïð;Ã'‹Nõm‚ÎHÊ›)&@º§Ø{ÈEN`ô>·-9kì¸ä¬ƒïÀilé^NâA_W!Â8.ê¹ß8Œ#·¢!¸ø …O+œ?_ßÄÅg¨wã“ö:”ÌÛr‡g:Œ©qQ©–¥ƒ^ÞWܘÈfo-œ&4°¯ÜÁ9‚ãN$¶GŽyZ±cß„ªVçÜż7a+Æ PøÆ£«I oi£ˆüb¯y^mÒ΂¬à9_Å?ÙÏ4QÉhrõ ë[C„mïHÌÞQ¥AÌ–žË>V·³ÚRZæ0ß ê{¨’’ÌÝØ®€KÀ£¨[Oáz<–¨~TªŠTž’w«¦Tò²~1ŸÊ˜»Jš®yÏÈÙN“•ÚE»²m¦WÖù*!w6 \ºøUÒ¬=—ëÊÐÂbEê åUVK¤‘{Àó QÍÖˆˆçûHÈïTWü³z±óCcAû=˜]‰=Zq-×XÏÕà‚BX]Q½‘Òw0Å7L,.³â—ÂÒÀS7ü¨Ý¼“«€m±iý†!«EÕƒwÞ&Ü 99,Ò×ø ˜9¶ÝèŒ$[AŸ¨ Ü' 8 qÆa?e…§4.ç0ªµcÖ†žÌH˜›ù†v¿‡U”\Wg¥8×2¬+hð)“ Ö̃•#˜%ˆN›‚ˆuÌ>ðð½uHl )<r3OÚ#˜VhâFÂH—DÄɈ-\i9s’Ie­˜ï y+þ`ñDãVùøéõ<÷¨:í—ðïl 6ª._[Ø{1Œz Ê/qÌrXšèòSë)ÄÈ⿶G3Äž²ï%)BT£1õ3¸çNøyW.Ž9'pB˹YÂÏ~ìÁþH`ÑiBËûÌ»2µ?X~þEKCCÓ-‹†3eÃó°Ó(Wmo—Ä—V\3ÃpsuÊÖ‘…;5ø*¡Ò³Aõ­ÐÐò…t#ºæ… &ãñy–ñ^=/;4|¤FÔ*0ûö¥ÕȈcWUj¤T÷Û¡wµAÕ¯„X5³GÈ_)q·À’,°‘ñÙÇ`«*ž:þWßfZ¶¥”÷3HRþÛSóÃwréº Àº_h.W*~éÑêxàߎè>½É‘ÖÀ¯&au­âD¾=§õ|EnYÎë¤ÜV¢xe¡€b‡ÝlÓù¬†6‹^(qI¹]þÜ®L5%Rÿ1=?£M° ÿŒ+CuëÀºd*푈¿zÌ $‚ÎK®Ý³:n“—<ªôú²b=Ww+¶6Á°ÇáBòÉÛiƒƒ’ëlÑÃ>é‡Ð6Ô;yze¿.ÿekÁù2ù³PªÉ²)Þ­n•sY¿6 ÆïP﮺!ÕöhN‚ä׉aKoc`Ýõ]"\ká僥ÏÃü8! W-«iÞ±´ŽR¼r)âõ’ÛÆ—kj¸öO¤Š±² # ïò"fnp0íT‹Ü«ª[qÉÞVVµÄž ë&“Šj$yßèY2¸±JtÅ?kLŽ (PHÄŠ ·ÞÈ6;¶ß@ËÉ£ÙlM"ðÑÓ<¸}Á×Æä$â€dáë¾DõEä«3þòÖç ù9$/6sàt{»çˆ-×nYÑ×Ý‹ê‘  /ÏÃÁTùT"…–ï*ó™-)½òxÁ˜{ã7ëÝT‡¯A;V #èÛ“Y`6zÏ—:ê­•õÚØdÎáiÞ-¹l¬²ÃYþwªôÙoSÒ¾_*pÌÜ^¿>|f-2áhË`ôù¨ÏÈaÉ8èØåã)–p6~eiâ}Ïoo_®¨µëzC÷Ø€1‰o:ÛqéV)˜š)2ç¼×có}ÆH1^ _¢!h²F1ž µuÑW;cׂñ¸:ãÓÃWDÛr4'_ZÂÎ"@·rÈ êl ò^m¢¹e_j[C2n¶×ÆÅJÉœ¢ÈJË8ò]¥UyQ†Èf4~¹}WǽúIu 7:õý*ýºQTDétFðЉ‰S ¤y1%-Šaìù¤xû0”H"ê+6@81ÿü¼Pq)üÄÇ°mþ2¢É19ÑK}ð7Þ3þþ`wßJÅغ…ÐiÄ°fTMLž®Öþã „Ïå h©¶ †-‘}ibÕ!óp4ˆoÌ“ì摲 iCÂÖÇäðˆ‡K\/ȵ®a:q iAt@íGõ€í yÙ¥~Óiõö&bZ,ûÄC”Œ å=8:#LI8Úþ‰ ‚oÆŽè¸Kæ’ц¸|NäŽ{çMýTiô9ŸšÇiCIb´;ÈË9 '}®­ÖÉÎÎœkÛÇÀáØnT§Â>ïëWŸ ýÙN‡g–=ÇD‘kïÇ‹¶O·3k>=G © 'i݆·è1E’‡wí3ôf[SÊX7˜|þhüAãKkUƒtûγ=SŒÌ•˜wü7Ïôd¶ž 7¡Sˆr/^þðø,8#Wùlº—þÃ÷ë-6°EôìF ó"N»Û~ '#­ùu–GQv´3©\=ù'õÅ5ÕrÛø’QÜÈîÚÕXÇjÁíSgYa.Ò%»žb%Âò÷îÈ,§7ï%êT46nܸÀÛv<‰¸èž•›r¼ã UYKF›š×rè ï{v?vÍ´+6œ!ÍâMеš+Ò²à‰Z¥(j$a0Ú}‹l1eÓªõü˜^{,9›C%„)ÂÙ,7~u8ƒ»>TÃ?ËN5¡]ÅãÅ<|Iw…«Þ…2ÐÛQTM›Ð=a0DÐFÍV6AÑÅßÖx£X‡‹¯9[-$E¼ë•Ë*P¿ÉZj†Ø–i5Ôó)”X ‡‡ ¹¥øRÒÃû+èÛB'W³ éý/åsSåI]Q>§Ñ ò”æ5J¨CôÀÏRªw\Ð.ô~M†BqîOcCŒ4ÁÁ[DV‚€ù³ðæZý„ç˜Æ •ü¶èÉêæ¹bà|N®ÜMk:x[1º¥¢Æ Ln7DW«IÖ~ЇX9ªÒ++aë…*S)|Ü럵ڨëC>9bHYó rÿ¤Æ¹x÷ی²²-8Ð)KWãĺrEý¢BÝl+œ§„«­5_γΜ2ŒÁ˜ÒHÿú6°Œ}AÿZóù£CV>…ŽŒ¨Ê¼Ø3%‡m)[íW5Ÿ&^yUé b:LYlwʾÅsx½o:6ÍðI‹.0GgÌ1Q&¥ÄÝ.£ßØ• y¡>|TæAöÎ RBm¥©cSíâ묌‡*Él½FÜãæ1Yh îå•@m÷€c•Zh‚…yw`í–fy–Ž"‘÷u£ƒ ÷$Ô¸<¤6©a*'AÀÉ®ntÍF?Ÿˆ ð¡œ!å;Wðæ”ìN@ÇØtþá{¶´*ýds³Wr®·®GD¬\xJ‚ÉF Ü×´ÀÏ÷Ã?‹QV†«/~Rçôäl'0”Kül´ñè»o¢¹,°°,K¼=úÞ][Ôi7à‚ñ‚¶Å&¦iJ˜%8Le¡|áA ^eù*‚ôÜ‹‘8Ú;~ ˆÎ³¦6}|¥ú¶åt5ü@¦y±ªóÁâú‹‰ôד3rß(‘P:ô駻<èϨµì ð„¯ÓÉþb¹‡WEB®Ò|‹’âpW|g]0Áò¨&©Ô¨y>ç‰Í‹Îyû7>¹@6òüþ.’ê1Žsþhñõç6&i®£J‹_×â¿:|奡›1÷»êõ‹k”„'h Sã9÷-1nPM5t–ª#’*Ø6Òa¸ßé\¿Ø2ea,ÅIí‰ùçûè½…; 3UÕP‰ìÒÉÔì{ô<¸õ¥½Ájû†µ§ß™%"WV MÔp±øY?2ÍMQ¸áÇ«š]eoqµøé3‚·* Pª€'‰à>€·„›NÏó/ÝÐmnØ[1׎Ü5¡Mg+k/¯+Šà»oÖµ´Ñu &™Â–Ü7|LAAèêå+ÓÚò±°ˆ§£ŽF Qʆjï“<­ b_!ØLz•£^7^m{æÃø!wŸBE ¡™]ãÆ@ª²žt7})É oÜ—ðÑ+V”xö$ü ಢ›µ°  3‘²Î{u6kwi@VMg)…™ù›À]Kõ™†^?“gd’ÃR,=c¹TcxÅ®¯;¦#WLIÊʤ8~\Þ3V챋g4©låyV²÷diÔ„ûÒIlT6UÔ=?V%ªÉZåáˆ2¿>”*r‡xgˆ&[( £Ì=ÕÉ E‹×u„ÐGƒÜÌ¢U©’Õm‹jÅIŒ}Œ0~Ýó!?±ÔHöƒÔŒÃg„_2w©Ù@ð wœíKÑ¥÷3`"á×––³^!½+ªÇœ5ü¦Ù‡_÷*ö&¢X *ÜBMÛ=Ïg›ë˜ŸwU|ý€ºÐ3Y»ËWD1˜;xS¬ƒàºFÙ¸ÓnóP`–¿ö«ºßC«­Òît?ƒ­Î éYÒ0‘q$H1!æú'•–¯<Üz}¡Çbéc:„/êÖ„ýf ¾¼²$¼1ó}0ÆŽlaŠÆ—M‚ó½­ƒ‚â`tàgÝ›×ëû¢=¾Û] £+¿Ý(nø¾2i!«à$7ö .ÍúÅm0áG±{!Á Ðw¿wÜ…}xQ†¥aU:“ì@Òí¹£¨”4ëè$=“9ÔG¶5©Ö¤”@ €B-ë‰øðþál ¬äåiÒ ù:7£+DRŠ)K@ƒøuÔ:üÉLX¬øtÎÑDjÚÒ7àeVåü(l’€Ê^‹äžô¥ÈÕòˆ ÿÖN%œ5G˜PÍìôRváåÖýÈ‚Ëdtú8#êöˆ¿iŸû‰…o£Z“ ­üxáV[×òwG…БËlñËî¡“”†?šÖ´edí´ûfRvßCER†'ÑÌëß ù‰œ.‹˜BÑšG37Rð¸Ó9äJÅ¿ª cõBX1¶ã9«#Õ“å±rÏrQ(.Û“žòWöÛwì;j†A®Âï*½“iÙ¨ã¤Z²Ò«øâåÒ–v­†-®¢HŠ"¢÷Y5Kü‡~IÔb&Ĩ€¡>£2K1‘X7ÓÆó8Váú{µ=×_tÏeÉo(üûk¥ìˆà€Ç˜Áü_¾-=-&ø,hšT%ÑãdÖ¤L²†²?GXr4üöÇ¡FZ ö¤¾ºšà ý’ºm‡ÇÃrj‘Çaó8õsZ‡ôIgB°éÿ®×*liãWÐùjøôð15ƒbÖk(€È³ëb'ZØÄã]½.¿ÊXç—#B#/⇮«¸Ð¢îûá™j5Ïq*£·neŒÎ‡K®Œ<áŽz²!4U¶ì%¥©Ÿ¾Â71…‹PÁw»KϱƼ ¿ ")p©52áQLA6]Be­ôTÏ ×å3ñ‡&‰™?jK„@}Αïÿ>§^ˆ„µ²ç•yŒ_xMÄî÷†ç ©Ô‹ÞΙQ ÕãÑñÄ“•¦gÁŠ¹m¾«zI»ž¬U¬LyJ¦`X·zÙÖض“ÅÈ»ÇÜf(ÔÏx.å-¬ ¦j¨ ™TæÔÆÝb1†]†Ëôé‹‘›ˆšlÏ»ß׎.¿Å¡ÐbÔ“™4O°Tëñ‡›Y RIÄ,r4Óó·Gþf ¨¾¦ Æ5no›|ÔLOýµúÚi·à„~’`pBÈêÛ]¹ÛSä¾LgŽª„ÉQÆÜM÷ú´ç Ö’e·Žî5b<âŸðUp™ëN7ÁÅ®hŽÛ’ùgâóú*_rÍl¯À1Ëeã~œÎ©8~ÈÔÃ33…hª ¾º_Ù¸ uö½O(A÷ðÅöŒƒéùèV%ÝÝ„ÏÐM¤íõ_0[¾ÅFÕ˜‰`Åme Øûu{vzt׌|S òn‘5íÇ Ó°gûbF;N@œÕhÉËH£»î9H,$+ ÈR“!¬vr'9¿ú™ü)ÈÀÎŒy¨ÐÒxT¬À{¤²™" (§<Æ-)±ßVI„¦ÜR ª]cÙalîwÕ>ꯦ(2 v 0âÙíÈ=}¿î€~{ óËWæXV¦@ð‘öÉl ôUÚ‚D!'töÚéÑÚoÞ¬6Þ± ŽƒTf{f•ry“±š­¾©Îl%úþ¥qs¸rÞ(j(ÐXH_I}rû¾³T¼²ÍmvaÌ`úøà±ÕoÈ©kf˜×,Ë=­¢Ï¯í<‡æ'øbØI'Å·Ò@ƒø¼õÂÞÞU®­Wûˆ˜j¥˜¯I˲¦B;Íé( r§¿°§Â+®—I¢…Y£i)ahv8cÓ ^´?úÚn× îÕgÔWän”·Wùöü â_ÒÉå>$’Æ"åõ[¿&b6‚¯Ã1Ë_®RIx³‚4dÅ7™¡—Ó-ZZé ðe×׃Œ…! ¿-­+¦µ•¥#H!´‰w–=ÙÈ$BL#qß5{’pQzÓLd|ç0–?,ÔIí*s“¼o½ÝPºùÖ„dWX+fkmÍÃù+‘®œnK¶e³ ×GÙŸ>o9©{ºüj¬£å¶ ˜ÎúRÕIZFsÇÀNhCúª„ogt öëã"%Ü>7'e=ö{ÓS 1œÁàW) ]žˆ›ÊfH9X(¹Y1åƒßÔ*Î&ænÆt”{¿Ô½ÿlMÖI“·Œ“Ìp¢°S–*Y@[† u®L;£À™-ÌOžˆ†óƒ"¾-0,Ëßa~ 4>úC‹&ÿˆì…ÎE))œî¶`>6†nKºåS™í†hÌEíxLÅø LÐ’ÒÜ$y…*üyÝÃ[çM?Êjþ qÔ‹s»`•môáh/µ9u}öטf‘Q©²ÃÁ”Wh`N|—p‰‹ï¦/¹7qXî§-ê ÈN«Ì)›– ËÍŒ‚ž9(êh‰òcº·3ö(.ÎNcòy;lÀ¹Âwñ$‡çê‚ûnÂbŽÃ9¤ì FâI=›ˆÏ÷’ùÝA†µ²PÇ\= xiLKÄèãæ 4ôUÜJG^YL}&¶Çw—ñÇÌå²£“òoÚ/»hû¶SÑÙ’~N1öjW1óGw»­Ùú­œ ¢¢ªÎ…GðrbìªÔZ…žzWKã Î^âÔ˜ZÃ=Ñ%ĺmȂБæ}Ôn_¸DXÇ!ýü#˜µGêŠ#tf^&Ì¿QUièJ¿$žÖµ7R#À+Z[Öë6‚\»ƒ+Ù’Šç’=G”Lg…q­Ì¸±ráŒàÓ¶ßãÐÓ»}éþ8jViô³à´W–ü§{ûû 2s…Ûä ¢¶)¨·7ÎÍŒñ78 ¤±èè ïÉQ/ƒAhCˆàûò(çmÊͱ[½€ ”¦šX»*tÑLÜ«¸`vÙ·w±H¼v9byeDìÛóJ¹ÃÎ>#ñnlÍÒîÜùD~#B{Ñ PL¼j½\åöÛƒ© !1æÿ ÑJ+"î‡ÎqpAµã I’“_ øˆ¤|=r©( :y³öÔÛáøà}c­¡ WÁaÓÍLb–ð§n©s^ŸÃl_½- [QµéO\J%‡• aÚÄ‹r"ü8§­ð±~¶OXîbïïÞ)À¦Û̧ºDáÜUÛÚì…¯Vµ>Åå~]ç ¨¼¢^b//Y•Â$õì ÅXï øp¾…³j*M«R½„¶ßM­©{M *‹–Ÿ³“øVùV‰î¿ÊÏÄ\zÂÒ¦w÷¿ºà ™ Ô„gï/g;æã=,tL¾>éÜ8ðeÝ <þL‰Py% Z‡s¬rÖrá°zßð<ÎÅvÝKÃ=~ÊÛ“Ä«¥K­>pßj‹JFÉœÌ&œuGøuj¹,éh[êç„ç ´=•u¢2±>ù¯!7¼ÐsñÍÂ_ÛíBÝ7)dýNm¬·/žüÓ¿\¼Ô2’!±vê¾ó.pF‰g›þŒ2¥¥Å¿IêÑ݇ ÅZÄ‚=Tkç~£S™jv¸‚S’”Ä׸PH¤¾O Z/ð…wÃ{Ú„e:ˆK%á ¾Nr§OÕ Ò_Ë%צÒ|ÅGc!<ݼ¬½6¦‹§S§NÑÁš{‰Rb]¢?äè¶ÎX[˜öÕ¹Nœ{g®¤K¡“a‰î÷J?ïìXíbZ¢ùOºç7¼*ˆ÷•µàÐ¥>&6UõSÔuÈXúùe)ýÀó¨)?›³ëÑ{‡tÎccô®Dh>Zjòé¬Ö…[”7¡1€óP#Cò¶ÂhŽœ \UŒ8%>Aùrü “0â¶åë’²J_Q%ýJÆ+))ËÅ–² ÷µîy‹ÓÄÑ®Ð[ϩ϶Ÿ'¬eEMRÅ>“)â}ìП¹ß[,NÇZ¨¸êaÙþu"T‘C“é»â å”—E,}mÏ3:-ù*'0íA Å·PŠ ä‚VZVû×û‚=…ªð»'&ùk!²I³Eˆ åÊ—h—dæ–qå%£ð4[èjº°Ì©RÉÇý8d„B˜H Ëk\ˆ8®Ÿ ÁƒmÑ&ßÀMî¿VŒ4¢ÒÙИšÃ" m«”2³Qº‹v’Så­®ktÚ À¢|3LÜ ÿò“ÖusïOU0JÝïB×I‡Ú. `m¼¦ò-KFmï•Ãr-–˜9eÕ8ã‡ôK˜nº_ŽÈ˜y«‘žå¦OçI iI-ñæ=«¹ÿ¶ã{ø2ÜÙ’Øž<^5×®§/üБ‹jâd¯R‚ƒ(n,ðtð䬦Í$n¬yÂ8Cï7n¥™JöA…ÎõÝ÷K6/r‚foniVzì ¼' Ú3aŽˆÊšhqÝ£•¤OG¼™ß@îÐö0+7¹·(fvbŸ+ìèËI}>Ÿä ýº„PjCÍJ9®áëܨ:çi\½È)Ѫ؉•n[X÷CÉ1[YH•!¬kX{ñèsÇ1!>n‡Ä ÐsldÐoÖ‰4Ò^ê5çCê£Åœnè¾­!¡²¹|ÏyÓ¶zô cè<ÄvôÈjcÑXµ¡Û5g}ôzPB­žþ¨¡N–o\K²-æè š§,O×=¬ùA¤¯Mk×ÔÖ8ò \Ál#=õ†¢2F‹iâҩׂ‡¾Þ—¤”E›×¸^‹wjêïo¦= 3T£ñ$¨œ2ÉUÏ$eO'®œl(tÞ4úà˜»B€»ŸFëû£(gŸ†ý8$E4ögÓö®Ÿœ¶¶™…' ä 1Áb #°}åºv“Ôw¾ U+6¯ÃÍX ݧä6 |QËSðúßǯýà‹ÃÛ^?ñ°´%Ü=!›~ëJ{…ýXµÀ>?_øÿ\£úàh }MùTº¸9gðì+lºÚÍ£i²@ð•–§ÒÙÿŠõŸY™¥bRvªÙ'^Ó~Z§ÄbÕS@,c1Jе+Õ$ü¢ñyâïÒ«²‡å‚%EÄÉ)×C±Ý-QgפÇÄOè’³ –Lç'Ú[–É:RJlŒŽ-qƒIµ:¤Ç(~µöä :¹­ŸäÛOÀ´yeú µ£aÝ×}neÁ;‘q–¯¶óŠÈG*Ý-IWy¨-‰‡žûŒž‘‘¤ |Ftg-ˆ¬áT\(æÑHï‹ÑMò¬!ïôb6„7 ‹œ'}¯æ1Ö€çËÇo#˜Å2ˆWzȖθhU™bÜp½¬þ˜êÙ^µŠ^ý„!×óyáÂÑ”u Š£Yãƒn–áœKÜ©G0OÞ‡„OG¥sh¾@6b*[ZÉK¨¦°åÂ6R ³¡ù-¡Eú”QœeÔ’‹À ÎDÜ ªÊ׸3<ªF4¾-S¶2LQŸŽ˜ Ï) ˜ÿ²$m„~—&qiúÑpk;“à›à¬+]¥-p×zñŒÅ"Þ´‡3ãLÞ:{_H×´x.“„øi†ÜõKÿVír±+ã-{1ݘÛy¦¤ÀAz³ºôÙnu¹4šõPïÞ~«‘{T™÷œ¾Åw½eZ¦;A“pý£P}œæ¡q¢û­A/”$°B™½zHÒÄ ‘øþéÌ öUôr o&Îœ»Ìä‹›½’'AÎvGfÉäGé=q:t¦0ÛR’UŒ•x˜÷ÒÜS N3ï­8¶ØyZÈÑ® UÆî–çL‹•:0*ô·M›kzä¼@U ½GX#ø8¾ÏŸZ 3òÚ©œõz!Ïï_–£[‹›LK’ÒyrÌ6Nç`sœT3§R£ õÙûؽXc7é.•RÛÔàL^Ú<)‘Ý@«µòÄ©‚Ý3‰}¨›ÊÛÃm,³„NZßÁ ÙÙEFn‹Ý =t›iÍ­ÙŠ¥§–q³ªÈ´— D)–÷$ê ))'*‡þ¿&kÕþŠœ®ÉðÉ̹|ÄOU¾w…´9sæÛ†.¡±/(E&ëÞòDþi„èÈÉáßzàHxx6ìxÀߊr ”æw袟ñµë+Z®ÿ§ßõ(ó`Çnºîï:s»-Ÿ[!ÿ.!©‹7è–,.§•o6„)=žft?nlÎ0¶ !z‹à€]öÁ üD$÷Ö»€[Ë£}O×» 2À0ªˆw,mÇDûëµ¹S½25—üϪž0è˜K¿ï².Éý€6•$¥´Å‘Á¤© ÅÑÅ%ö=JíÏ7´…fih3]âqùšwÆv¯%ÎPÁñ6>MöO4#ïTù]×N3©ž;@óßg:óIó8Eé2ed g&5Š—œ\EûU†Y²RêHH¨æŒìá‹çóoÒ«z Ýh‡]fˆ£ÕßgÏòÉ12RSð,±û]µRbZ5õ¨£)w€²wßàÔ·Ì·-„"ÉàvR œÓ*@¸WR‰xÄÃÅ¡Bù5JØL–Ü6£ º›óìŸ)@6 “‡1‰:’RúÛÀ’ž"γ :Ð"‘~'3*IXÀR›ÌH–oXT³æ›&DjÛ¹zÊicFdu`ãŽÜ{f 89ƒfri¥Ü[…1å@¬“Âî¤2Ó·OÆÆÚY%Š•†¥ ¯ÃÄž½¢%} \1\–¢s{Tr!DõCþó©Ù-LøòqY˜ÊŽ°ôœÒjN'å‹Ùwª¡„¸,Ý×Qûöë?ß^+*§ëb]JƒÎ2ñ™Î¤×‰Ï„+’E endstream endobj 158 0 obj << /Type /FontDescriptor /FontName /DXSQYH+CMTT10 /Flags 4 /FontBBox [-4 -233 537 696] /Ascent 611 /CapHeight 611 /Descent -222 /ItalicAngle 0 /StemV 69 /XHeight 431 /CharSet (/A/B/I/L/M/T/V/a/ampersand/asciitilde/asterisk/b/backslash/bar/braceleft/braceright/c/colon/comma/d/e/equal/exclam/f/five/four/g/greater/h/hyphen/i/j/k/l/less/m/n/nine/numbersign/o/one/p/parenleft/parenright/period/plus/q/quotedbl/quoteleft/r/s/semicolon/seven/six/slash/t/three/two/u/underscore/v/w/x/y/z/zero) /FontFile 157 0 R >> endobj 46 0 obj << /Type /Font /Subtype /Type1 /BaseFont /DUUZKV+CMBX10 /FontDescriptor 130 0 R /FirstChar 12 /LastChar 122 /Widths 125 0 R >> endobj 44 0 obj << /Type /Font /Subtype /Type1 /BaseFont /XZNERQ+CMBX12 /FontDescriptor 132 0 R /FirstChar 12 /LastChar 120 /Widths 126 0 R >> endobj 107 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HHAVZN+CMEX10 /FontDescriptor 134 0 R /FirstChar 32 /LastChar 112 /Widths 116 0 R >> endobj 70 0 obj << /Type /Font /Subtype /Type1 /BaseFont /GFQDWG+CMMI10 /FontDescriptor 136 0 R /FirstChar 25 /LastChar 121 /Widths 120 0 R >> endobj 72 0 obj << /Type /Font /Subtype /Type1 /BaseFont /GTMDSH+CMMI7 /FontDescriptor 138 0 R /FirstChar 59 /LastChar 121 /Widths 118 0 R >> endobj 47 0 obj << /Type /Font /Subtype /Type1 /BaseFont /CJONXN+CMR10 /FontDescriptor 140 0 R /FirstChar 1 /LastChar 126 /Widths 124 0 R >> endobj 43 0 obj << /Type /Font /Subtype /Type1 /BaseFont /JUDEDS+CMR12 /FontDescriptor 142 0 R /FirstChar 44 /LastChar 121 /Widths 127 0 R >> endobj 42 0 obj << /Type /Font /Subtype /Type1 /BaseFont /NIKKII+CMR17 /FontDescriptor 144 0 R /FirstChar 12 /LastChar 117 /Widths 128 0 R >> endobj 112 0 obj << /Type /Font /Subtype /Type1 /BaseFont /WIRDCL+CMR6 /FontDescriptor 146 0 R /FirstChar 49 /LastChar 49 /Widths 115 0 R >> endobj 71 0 obj << /Type /Font /Subtype /Type1 /BaseFont /QHLHRQ+CMR7 /FontDescriptor 148 0 R /FirstChar 48 /LastChar 116 /Widths 119 0 R >> endobj 113 0 obj << /Type /Font /Subtype /Type1 /BaseFont /AJGTEL+CMR8 /FontDescriptor 150 0 R /FirstChar 82 /LastChar 121 /Widths 114 0 R >> endobj 69 0 obj << /Type /Font /Subtype /Type1 /BaseFont /CFHLZL+CMSY10 /FontDescriptor 152 0 R /FirstChar 0 /LastChar 112 /Widths 121 0 R >> endobj 95 0 obj << /Type /Font /Subtype /Type1 /BaseFont /PXBGHL+CMSY7 /FontDescriptor 154 0 R /FirstChar 0 /LastChar 0 /Widths 117 0 R >> endobj 68 0 obj << /Type /Font /Subtype /Type1 /BaseFont /SFYMSH+CMTI10 /FontDescriptor 156 0 R /FirstChar 65 /LastChar 122 /Widths 122 0 R >> endobj 64 0 obj << /Type /Font /Subtype /Type1 /BaseFont /DXSQYH+CMTT10 /FontDescriptor 158 0 R /FirstChar 33 /LastChar 126 /Widths 123 0 R >> endobj 48 0 obj << /Type /Pages /Count 6 /Parent 159 0 R /Kids [30 0 R 59 0 R 79 0 R 83 0 R 88 0 R 92 0 R] >> endobj 101 0 obj << /Type /Pages /Count 3 /Parent 159 0 R /Kids [98 0 R 104 0 R 109 0 R] >> endobj 159 0 obj << /Type /Pages /Count 9 /Kids [48 0 R 101 0 R] >> endobj 160 0 obj << /Type /Outlines /First 3 0 R /Last 27 0 R /Count 7 >> endobj 27 0 obj << /Title 28 0 R /A 25 0 R /Parent 160 0 R /Prev 23 0 R >> endobj 23 0 obj << /Title 24 0 R /A 21 0 R /Parent 160 0 R /Prev 19 0 R /Next 27 0 R >> endobj 19 0 obj << /Title 20 0 R /A 17 0 R /Parent 160 0 R /Prev 15 0 R /Next 23 0 R >> endobj 15 0 obj << /Title 16 0 R /A 13 0 R /Parent 160 0 R /Prev 11 0 R /Next 19 0 R >> endobj 11 0 obj << /Title 12 0 R /A 9 0 R /Parent 160 0 R /Prev 7 0 R /Next 15 0 R >> endobj 7 0 obj << /Title 8 0 R /A 5 0 R /Parent 160 0 R /Prev 3 0 R /Next 11 0 R >> endobj 3 0 obj << /Title 4 0 R /A 1 0 R /Parent 160 0 R /Next 7 0 R >> endobj 161 0 obj << /Names [(Doc-Start) 41 0 R (cite.HOL) 63 0 R (cite.HOL-tutorial) 65 0 R (cite.bernstein) 67 0 R (cite.flyspeck) 66 0 R (page.1) 40 0 R] /Limits [(Doc-Start) (page.1)] >> endobj 162 0 obj << /Names [(page.2) 61 0 R (page.3) 81 0 R (page.4) 85 0 R (page.5) 90 0 R (page.6) 94 0 R (page.7) 100 0 R] /Limits [(page.2) (page.7)] >> endobj 163 0 obj << /Names [(page.8) 106 0 R (page.9) 111 0 R (section*.1) 45 0 R (section*.2) 62 0 R (section.1) 2 0 R (section.2) 6 0 R] /Limits [(page.8) (section.2)] >> endobj 164 0 obj << /Names [(section.3) 10 0 R (section.4) 14 0 R (section.5) 18 0 R (section.6) 22 0 R (section.7) 26 0 R] /Limits [(section.3) (section.7)] >> endobj 165 0 obj << /Kids [161 0 R 162 0 R 163 0 R 164 0 R] /Limits [(Doc-Start) (section.7)] >> endobj 166 0 obj << /Dests 165 0 R >> endobj 167 0 obj << /Type /Catalog /Pages 159 0 R /Outlines 160 0 R /Names 166 0 R /PageMode/UseOutlines /OpenAction 29 0 R >> endobj 168 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.10)/Keywords() /CreationDate (D:20121029233513-04'00') /ModDate (D:20121029233513-04'00') /Trapped /False /PTEX.Fullbanner (This is MiKTeX-pdfTeX 2.8.3563 (1.40.10)) >> endobj xref 0 169 0000000000 65535 f 0000000015 00000 n 0000007515 00000 n 0000218308 00000 n 0000000060 00000 n 0000000090 00000 n 0000007570 00000 n 0000218224 00000 n 0000000135 00000 n 0000000165 00000 n 0000011123 00000 n 0000218138 00000 n 0000000210 00000 n 0000000240 00000 n 0000013652 00000 n 0000218050 00000 n 0000000286 00000 n 0000000327 00000 n 0000019380 00000 n 0000217962 00000 n 0000000373 00000 n 0000000406 00000 n 0000022044 00000 n 0000217874 00000 n 0000000452 00000 n 0000000490 00000 n 0000026831 00000 n 0000217799 00000 n 0000000536 00000 n 0000000567 00000 n 0000001137 00000 n 0000001306 00000 n 0000001456 00000 n 0000001605 00000 n 0000001756 00000 n 0000001907 00000 n 0000002058 00000 n 0000002209 00000 n 0000002526 00000 n 0000000617 00000 n 0000002360 00000 n 0000002416 00000 n 0000216322 00000 n 0000216180 00000 n 0000215467 00000 n 0000002470 00000 n 0000215324 00000 n 0000216039 00000 n 0000217455 00000 n 0000005400 00000 n 0000005587 00000 n 0000005790 00000 n 0000005970 00000 n 0000006167 00000 n 0000006317 00000 n 0000006476 00000 n 0000006631 00000 n 0000006790 00000 n 0000007625 00000 n 0000005210 00000 n 0000002643 00000 n 0000007179 00000 n 0000007235 00000 n 0000007291 00000 n 0000217312 00000 n 0000007347 00000 n 0000007403 00000 n 0000007459 00000 n 0000217169 00000 n 0000216888 00000 n 0000215754 00000 n 0000216605 00000 n 0000215897 00000 n 0000006985 00000 n 0000010421 00000 n 0000010616 00000 n 0000010766 00000 n 0000010917 00000 n 0000011178 00000 n 0000010273 00000 n 0000007789 00000 n 0000011067 00000 n 0000013708 00000 n 0000013488 00000 n 0000011306 00000 n 0000013596 00000 n 0000016395 00000 n 0000016602 00000 n 0000016268 00000 n 0000013836 00000 n 0000016546 00000 n 0000019434 00000 n 0000019216 00000 n 0000016707 00000 n 0000019324 00000 n 0000217030 00000 n 0000021831 00000 n 0000022100 00000 n 0000021703 00000 n 0000019598 00000 n 0000021987 00000 n 0000217565 00000 n 0000024964 00000 n 0000025178 00000 n 0000024832 00000 n 0000022252 00000 n 0000025120 00000 n 0000215610 00000 n 0000026886 00000 n 0000026661 00000 n 0000025331 00000 n 0000026773 00000 n 0000216464 00000 n 0000216746 00000 n 0000027005 00000 n 0000027263 00000 n 0000027288 00000 n 0000027798 00000 n 0000027823 00000 n 0000028221 00000 n 0000028634 00000 n 0000029187 00000 n 0000029835 00000 n 0000030184 00000 n 0000030579 00000 n 0000031277 00000 n 0000031910 00000 n 0000032541 00000 n 0000032971 00000 n 0000033622 00000 n 0000051425 00000 n 0000051768 00000 n 0000065625 00000 n 0000065941 00000 n 0000073308 00000 n 0000073564 00000 n 0000083442 00000 n 0000083729 00000 n 0000092719 00000 n 0000092959 00000 n 0000117852 00000 n 0000118371 00000 n 0000128432 00000 n 0000128698 00000 n 0000139453 00000 n 0000139712 00000 n 0000146713 00000 n 0000146933 00000 n 0000156671 00000 n 0000156948 00000 n 0000166591 00000 n 0000166837 00000 n 0000175418 00000 n 0000175728 00000 n 0000182702 00000 n 0000182927 00000 n 0000196188 00000 n 0000196458 00000 n 0000214798 00000 n 0000217657 00000 n 0000217725 00000 n 0000218379 00000 n 0000218569 00000 n 0000218726 00000 n 0000218899 00000 n 0000219060 00000 n 0000219157 00000 n 0000219195 00000 n 0000219322 00000 n trailer << /Size 169 /Root 167 0 R /Info 168 0 R /ID [ ] >> startxref 219597 %%EOF hol-light/Formal_ineqs/docs/FormalVerifier.tex000066400000000000000000000475131303454263000217640ustar00rootroot00000000000000\documentclass[a4paper]{article} \usepackage{amsmath} \usepackage{amssymb} \usepackage{hyperref} \usepackage{graphicx} \usepackage{geometry} \geometry{ letterpaper, left= 1.5in, right= 1.5in, top= 1.3in, bottom= 1.4in } \newcommand{\partd}[2]{\frac{\partial #1}{\partial #2}} \newcommand{\dih}{\mathrel{\rm dih}} \parindent=0mm \parskip=5pt \title{A Tool for Formal Verification of Nonlinear Inequalities} \author{Alexey Solovyev} % Document \begin{document} % Title \maketitle % Content \tableofcontents \pagebreak % References \begin{thebibliography}{9} \bibitem{HOL} HOL Light home page\\ \url{http://www.cl.cam.ac.uk/~jrh13/hol-light} \bibitem{HOL-tutorial} HOL Light tutorial\\ \url{http://www.cl.cam.ac.uk/~jrh13/hol-light/tutorial_220.pdf} \bibitem{flyspeck} The Flyspeck project\\ \url{https://github.com/flyspeck/flyspeck} \bibitem{bernstein}C\'esar Mu\~noz and Anthony Narkawicz, {\it Formalization of a Representation of Bernstein Polynomials and Applications to Global Optimization}, Journal of Automated Reasoning, DOI: 10.1007/s10817-012-9256-3\\ \url{http://shemesh.larc.nasa.gov/people/cam/Bernstein/} \end{thebibliography} % Introduction \section{Introduction} This document describes a tool for verification of nonlinear inequalities in HOL Light proof assistant~\cite{HOL, HOL-tutorial}. This tool was developed as a part of the Flyspeck project (a formal proof of the Kepler conjecture)~\cite{flyspeck}. The tool is capable to verify multivariate nonlinear strict inequalities on rectangular domains. More specifically, the tool can handle inequalities in the form \[\forall {\bf x} \in D \implies f({\bf x}) < g({\bf x}),\] where $D = \{(x_1, \ldots, x_n)\ |\ a_i \le x_i \le b_i\}$ and $f$, $g$ are functions which may include all usual arithmetic operations, square roots, arccosines, and arctangents. The maximal number of variables is 8. Future releases of the tool will include all elementary functions and will have no restriction on the number of variables. Moreover, it will be possible to verify inequalities on non-rectangular domains. Internally, the tool uses interval arithmetic with Taylor approximations (with second-order error terms). The document is organized as follows. The next section describes the installation process. Then a quick introduction of tool functions is presented. After that, a more detailed description of tool functions is given and special options are described. The last two sections describe several examples and test cases. % Installation \section{Installation} First of all, if you don't have OCaml and HOL Light installed, then you need to install them. The verification tool was tested with Ocaml 3.09.3 and Ocaml 3.12.1 and with one of the latest versions of HOL Light (r149 in the HOL Light repository). HOL Light installation instructions can be found in John Harrison's HOL Light tutorial~\cite{HOL-tutorial}. Alternatively, one can download and run the following script written by Alex Krauss: \url{https://bitbucket.org/akrauss/hol-light-workbench}. This script will download and install the latest version of HOL Light and other necessary programs. The installation of the tool for verification of nonlinear inequalities is very simple. Download the distribution from \vspace{-5pt} \url{http://code.google.com/p/flyspeck/downloads/list} \vspace{-5pt} or get the latest version from the Flyspeck repository with the shell command \vspace{-5pt} \verb|svn co http://flyspeck.googlecode.com/svn/trunk/formal_ineqs| The tool can be placed in any directory on your computer. It is important to inform HOL Light about tool's location. It can be done with the following OCaml command: \verb|load_path := "path to the tool directory" :: !load_path;;| After the path is set, the tool can be loaded with the command \verb|needs "verifier/m_verifier_main.hl";;| The tool loads the standard HOL Light library \verb|Multivariate/realanalysis.ml|. The loading process of this library could take pretty long time, so it is recommended to use a checkpointed version of HOL Light with preloaded multivariate analysis libraries. Before loading the tool, it is also possible to change some global options. These options are described in section \ref{global}. % Examples \section{Quick Start} The polynomial inequality \begin{multline*} -\frac{1}{\sqrt{3}} \le x \le \sqrt{2},\ -\sqrt{\pi} \le y \le 1 \implies x^2 y - x y^4 + y^6 + x^4 - 7 > -7.17995 \end{multline*} can be verified with the following script \begin{verbatim} (* make sure that load_path contains the path to formal_ineqs *) needs "verifier/m_verifier_main.hl";; open M_verifier_main;; let ineq = `-- &1 / sqrt(&3) <= x /\ x <= sqrt(&2) /\ -- sqrt(pi) <= y /\ y <= 1 ==> x pow 2 * y - x * y pow 4 + y pow 6 - &7 + x pow 4 > -- #7.17995`;; let th, stats = verify_ineq default_params 5 ineq;; \end{verbatim} The first parameter of the verification function \verb|verify_ineq| contains verification options. We use default values given by the constant \verb|default_params|. Available options are described in section \ref{verification}. The second parameter specifies the precision of formal floating point operations. This parameter determines the maximal number of significant digits of any result returned by a formal floating point operation. Here, digits are not decimal. Internally all natural numbers are represented using a fixed base (see section \ref{global} for more details). This base is relatively large (the default value is 100) to speed up arithmetic operations. Actual precision of formal floating point operations depends on the precision parameter and on the base of the internal representation of natural numbers. If the base value is 100 and the precision parameter is 5 as in the example above, then the precision of formal floating point operations is 10 decimal digits: $100^5 = 10^{10}$. Note that the verification of the example will fail if the precision parameter is 4 or less. On the other hand, if the precision parameter is 10, the verification will succeed but it will take a little more time. The third parameter is the inequality itself given as a HOL Light term. The format of this term is simple: it is an implication with bounds of variables in the antecedent and an inequality in the consequent. The bounds of all variables should be in the form $\text{\it a constant expression} <= x$ or $x <= \text{\it a constant expression}$. For each variable, upper and lower bounds must be given. The inequality must be a strict inequality ($<$ or $>$). The inequality may include \verb|sqrt|, \verb|atn|, and \verb|acs| functions. The constant \verb|pi| ($\pi$) is also allowed. The verification function returns a HOL Light theorem and a record with some verification information which include verification time. % Verification Functions \section{Verification Functions}\label{verification} The main verification function \verb|verify_ineq| is contained in \verb|M_verifier_main| module defined in \verb|verifier/m_verifier_main.hl|. The function has 3 arguments and its type is \begin{verbatim} verify_ineq : verification_parameters -> int -> term -> thm * verification_stats \end{verbatim} The first parameter contains verification options defined in the following record \begin{verbatim} type verification_parameters = { (* If true, then monotonicity properties can be used *) (* to reduce the dimension of a problem *) allow_derivatives : bool; (* If true, then convexity can be used *) (* to reduce the dimension of a problem *) convex_flag : bool; (* If true, then verification on internal subdomains can be skipped *) (* for a monotone function *) mono_pass_flag : bool; (* If true, then raw interval arithmetic can be used *) (* (without Taylor approximations) *) raw_intervals_flag : bool; (* If true, then an informal procedure is used to determine *) (* the optimal precision for the formal verification *) adaptive_precision : bool; (* This parameter might be used in cases when the certificate search *) (* procedure returns a wrong result due to rounding errors *) (* (this parameter will be eliminated when the search procedure is corrected) *) eps : float; };; \end{verbatim} A detailed description of these parameter is omitted in this document. In most cases, it is enough to use the constant \verb|default_params| which turns all verification flags on and sets \verb|eps = 0|. In rare cases, it is necessary to adjust \verb|eps| to get a result. This can be done with the command \begin{verbatim} verify_ineq {default_params with eps = 1e-10} 5 ineq_tm;; \end{verbatim} The second parameter of the verification function specifies the precision of formal floating point operations. This parameter determines the maximal number of significant digits of any result returned by a formal floating point operation. Here, digits are not decimal. Internally all natural numbers are represented using a fixed base (see section \ref{global} for more details). This base is relatively large (the default value is 100) to speed up arithmetic operations. Actual precision of formal floating point operations depends on the precision parameter and on the base of the internal representation of natural numbers. In many cases, if the verification function fails, it is enough to increase the precision parameter to get a result. The third parameter of the verification function is a HOL Light term which specifies an inequality itself. The format of this term is the following: \begin{verbatim} bounds of variables ==> an inequality \end{verbatim} The bounds of all variables should be in the form $\text{\it a constant expression} <= x$ or $x <= \text{\it a constant expression}$. For each variable, upper and lower bounds must be provided. The order in which the bounds are given is irrelevant. Bounds of variables may be connected with \verb|/\| or with \verb|==>|. The inequality must be a strict inequality ($<$ or $>$). The inequality may include \verb|sqrt|, \verb|atn|, and \verb|acs| functions. The constant \verb|pi| ($\pi$) is also allowed. The verification function returns a theorem and some verification information defined in the record \begin{verbatim} type verification_stats = { total_time : float; formal_verification_time : float; certificate : Verifier.certificate_stats; };; \end{verbatim} The field \verb|total_time| contains total verification time. The field \verb|formal_verification_time| contains time taken by the formal verification procedure only (this time doesn't include time for constructing a solution certificate and for other preparations). The last field \verb|certificate| contains information about a solution certificate. The conclusion of the returned theorem is not exactly the same as the third parameter of the verification function: the order of bounds of variables may be altered and variables which are not used in the inequality are eliminated. For example, commands \begin{verbatim} let th1, _ = verify_ineq default_params 3 `&1 <= y /\ y <= &2 /\ &1 <= x /\ x <= &3 ==> x + y < &6`;; let th2, _ = verify_ineq default_params 3 `&1 <= y /\ y <= &2 /\ &1 <= x /\ x <= &3 ==> y < &3`;; \end{verbatim} return \begin{verbatim} th1 = |- (&1 <= x /\ x <= &3) /\ &1 <= y /\ y <= &2 ==> x + y < &6 th2 = |- &1 <= y /\ y <= &2 ==> y < &3 \end{verbatim} % Options \section{Global Options}\label{global} The options which affect the arithmetic operations with natural and floating point numbers must be set before the verification tool is loaded. After the verification tool is loaded, arithmetic options may not be changed. To set arithmetic options, load the file \verb|arith_options.hl| located in the root directory of the tool. The available options are listed below. \begin{enumerate} % base \item[\bf base] Determines the base for representing natural numbers. Default HOL Light representation of natural numbers is binary (i.e., its base is 2). A higher base increases speed of arithmetic operations but it also requires more memory to remember additional theorems. The default value of the base is \verb|100|. To set a new base, use the command \verb|Arith_options.base := 200;;| % min_exp \item[\bf min\_exp] Determines the minimal exponent in the representation of floating point numbers. Each floating point number is represented as a triple $(s, n, e)$ where $s$ is a boolean value which determines the sign of the number, $n$ and $e$ are natural numbers which represent the mantissa and the exponent. The value corresponding to $(s, n, e)$ is given by \[f = (-1)^{\text{if $s$ then $1$ else $0$}} \times n \times b^{e - min\_exp}\] where $b$ is the base of the representation of natural numbers. % cached \item[\bf cached] If this value is true, then results of all natural number operations are cached. The default value is \verb|true|. % float_cached \item[\bf float\_cached] If this value is true, then results of all floating point operations are cached. The default value is \verb|true|. % init_cache_size \item[\bf init\_cache\_size] Determines the initial size of the cache for results of arithmetic operations. The default value is \verb|10000|. % max_cache_size \item[\bf max\_cache\_size] Determines the maximal size of the cache for results of arithmetic operations. The default value is \verb|20000|. Note: each cached operation has its own cache. \end{enumerate} The file \verb|verifier_options.hl| contains the option \verb|info_print_level| which controls the amount of information printed by a verification process. This option can be changed at any time: \verb|Verifier_options.info_print_level := 0;;| Possible values are: 0~(no information is printed); 1~(all essential information is printed); 2~(all information is printed). The default value is 1. The next example shows how to change default options: \begin{verbatim} (* The arithmetic options must be set before loading the verification tool *) needs "arith_options.hl";; (* Increase the arithmetic base *) Arith_options.base := 200;; (* Increase the cache size *) Arith_options.max_cache_size = 40000;; (* Load the verification tool *) needs "verifier/m_verifier_main.hl";; (* The verification option can be changed at any time *) Verifier_options.info_print_level := 2;; open M_verifier_main;; \end{verbatim} % Additional Examples \section{Additional Examples} The verification tool distribution contains several example files. The file \verb|examples_poly.hl| contains polynomial inequalities from the paper \cite{bernstein}. The command \verb|needs "examples_poly.hl";;| will load this file and run all polynomial inequality tests. To run all tests again, type \verb|run_tests();;| To run a specific test, type \verb|run_{test_name}();;| where \verb|{test_name}| is one of the following: \verb|schwefel|, \verb|rd|, \verb|caprasse|, \verb|lv|, \verb|butcher|, \verb|magnetism|, \verb|heart|. Here is the list of all examples. \begin{itemize} % schwefel \item[\bf schwefel] \begin{eqnarray*} &-5.8806 \times 10^{-10} < (x_1 - x_2^2)^2 + (x_2 - 1)^2 + (x_1 - x_3^2)^2 + (x_3 - 1)^2\\ &(x_1, x_2, x_3) \in [(-10,-10,-10),(10,10,10)] \end{eqnarray*} % rd \item[\bf rd] \begin{eqnarray*} &-36.7126907 < -x_1 + 2 x_2 - x_3 - 0.835634534\, x_2 (1 + x_2)\\ &(x_1, x_2, x_3) \in [(-5,-5,-5),(5,5,5)] \end{eqnarray*} % caprasse \item[\bf caprasse] \begin{eqnarray*} &-3.1801 < -x_1 x_3^3 + 4 x_2 x_3^2 x_4 + 4 x_1 x_3 x_4^2 + 2 x_2 x_4^3 + 4 x_1 x_3 + 4 x_3^2 - 10 x_2 x_4 - 10 x_4^2 + 2\\ &(x_1, x_2, x_3, x_4) \in [(-0.5,-0.5,-0.5,-0.5),(0.5,0.5,0.5,0.5)] \end{eqnarray*} % lv \item[\bf lv] \begin{eqnarray*} &-20.801 < x_1 x_2^2 + x_1 x_3^2 + x_1 x_4^2 - 1.1 x_1 + 1\\ &(x_1, x_2, x_3, x_4) \in [(-2,-2,-2,-2), (2,2,2,2)] \end{eqnarray*} % butcher \item[\bf butcher] \begin{eqnarray*} &-1.44 < x_6 x_2^2 + x_5 x_3^2 - x_1 x_4^2 + x_4^2 - \frac{1}{3} x_1 + \frac{4}{3} x_4\\ &(x_1, x_2, x_3, x_4, x_5, x_6) \in [(-1,-0.1, -0.1, -1, -0.1, -0.1), (0,0.9,0.5,-0.1,-0.05,-0.03)] \end{eqnarray*} % magnetsim \item[\bf magnetism] \begin{eqnarray*} &-0.25001 < x_1^2 + 2 x_2^2 + 2 x_3^2 + 2 x_4^2 + 2 x_5^2 + 2 x_6^2 + 2 x_7^2 - x_1\\ &(x_1,x_2,x_3,x_4,x_5,x_6,x_7) \in [(-1,-1,-1,-1,-1,-1,-1), (1,1,1,1,1,1,1)] \end{eqnarray*} % heart \item[\bf heart] \begin{equation*} \begin{split} &-1.7435 < -x_1 x_6^3 + 3 x_1 x_6 x_7^2 - x_3 x_7^3 + 3 x_3 x_7 x_6^2 - x_2 x_5^3 + 3 x_2 x_5 x_8^2 - x_4 x_8^3 + 3 x_4 x_8 x_5^2 - 0.9563453\\ &(x_1,x_2,x_3,x_4,x_5,x_6,x_7,x_8) \in [(-0.1, 0.4, -0.7, -0.7, 0.1, -0.1, -0.3, -1.1),\\ &\phantom{(x_1,x_2,x_3,x_4,x_5,x_6,x_7,x_8) \in [ }(0.4, 1, -0.4, 0.4, 0.2, 0.2, 1.1, -0.3)] \end{split} \end{equation*} \end{itemize} The file \verb|examples_flyspeck.hl| contains some inequalities from the Flyspeck project~\cite{flyspeck}. The command \verb|needs "examples_flyspeck.hl";;| will load this file and run some easy inequality tests. To rerun these tests, use the command \verb|test_easy();;|. To run more difficult tests, type \verb|test_medium();;| or \verb|test_hard();;|. (Warning: medium tests require about 30 minutes, hard tests require more than 5 hours.) Some Flyspeck inequalities are listed below. \begin{eqnarray*} \Delta(x_1,\ldots,x_6) &= &x_1 x_4(-x_1 + x_2 + x_3 - x_4 + x_5 + x_6)\\ && + x_2 x_5(x_1 - x_2 + x_3 + x_4 - x_5 + x_6)\\ && + x_3 x_6(x_1 + x_2 - x_3 + x_4 + x_5 - x_6)\\ && - x_2 x_3 x_4 - x_1 x_3 x_5 - x_1 x_2 x_6 - x_4 x_5 x_6,\\[6pt] \Delta_4 &=& \partd{\Delta}{x_4},\\[6pt] \dih_x(x_1,\ldots,x_6) &=& \frac{\pi}{2} - \arctan\left(\frac{-\Delta_4(x_1,\ldots,x_6)}{\sqrt{4 x_1 \Delta(x_1,\ldots,x_6)}}\right),\\[6pt] \dih_y(y_1,\ldots,y_6) &=& \dih_x(y_1^2, \ldots, y_6^2). \end{eqnarray*} \begin{itemize} % 1 \item[\bf 4717061266] \begin{eqnarray*} \Delta(x_1, x_2, x_3, x_4, x_5, x_6) > 0,\quad 4 \le x_i \le 6.3504 \end{eqnarray*} % 2 \item[\bf 7067938795] \begin{eqnarray*} &\dih_x (x_1, \ldots, x_6) - \pi/2 + 0.46 < 0,\\ &4 \le x_{1,2,3} \le 6.3504,\ x_4 = 4,\ 3.01^2 \le x_{5,6} \le 3.24^2 \end{eqnarray*} % 3 \item[\bf 3318775219] \begin{eqnarray*} &\begin{split} 0 < &\dih_y (y_1, \ldots, y_6) - 1.629 + 0.414 (y_2 + y_3 + y_5 + y_6 - 8.0)\\ &- 0.763 (y_4 - 2.52) - 0.315 (y_1 - 2.0), \end{split}\\ &2 \le y_i \le 2.52 \end{eqnarray*} \end{itemize} % Test Results \section{Test Results} This section contains time test results for inequalities described in the previous section. All tests were performed on Intel Core i5, 2.67GHz running Ubuntu 9.10 inside Virtual Box 4.2.0 on a Windows 7 host; the Ocaml version was 3.09.3; the base of arithmetic was 200; the caching was turned on. \begin{center} Polynomial inequalities \begin{tabular}{l@{\quad} r r r r r} %{r@{\quad}rl} \hline \multicolumn{1}{l}{\rule{0pt}{12pt}Inequality ID}& \multicolumn{1}{l}{\phantom{x}\# variables}& \multicolumn{1}{l}{\phantom{x}precision}& \multicolumn{1}{l}{\phantom{x}total time (s)}& \multicolumn{1}{l}{\phantom{x}formal verification (s)}\\ \hline\rule{0pt}{12pt}% schwefel & 3 & 5 & 26.329 & 19.145 \\ rd & 3 & 5 & 1.593 & 0.017 \\ caprasse & 4 & 5 & 8.057 & 1.286 \\ lv & 4 & 5 & 1.875 & 0.030 \\ butcher & 6 & 5 & 3.609 & 0.035 \\ magnetism & 7 & 5 & 7.007 & 1.347 \\ heart & 8 & 5 & 17.298 & 1.277 \\ \hline \end{tabular} \end{center} \begin{center} Flyspeck inequalities \begin{tabular}{l@{\quad} r r r r r} %{r@{\quad}rl} \hline \multicolumn{1}{l}{\rule{0pt}{12pt}Inequality ID}& \multicolumn{1}{l}{\phantom{x}precision}& \multicolumn{1}{l}{\phantom{x}total time (s)}& \multicolumn{1}{l}{\phantom{x}formal verification (s)}\\ \hline\rule{0pt}{12pt}% 2485876245a & 4 & 5.530 & 0.058 \\ 4559601669b & 4 & 4.679 & 0.048 \\ 4717061266 & 4 & 27.1 & 0.250 \\ 5512912661 & 4 & 8.860 & 0.086 \\ 6096597438a & 4 & 0.071 & 0.071 \\ 6843920790 & 4 & 2.824 & 0.076 \\ SDCCMGA b & 4 & 9.012 & 0.949 \\ TSKAJXY-TADIAMB\footnotemark[1] & 4 & 75.9 & 21.2 \\ 7067938795 & 4 & 431 & 387 \\ 5490182221 & 4 & 1726 & 1533 \\ 3318775219 & 4 & 17091 & 15226 \\ \hline \end{tabular} \end{center} \footnotetext[1]{Reduced to a polynomial inequality} \end{document} hol-light/Formal_ineqs/examples.hl000066400000000000000000000046271303454263000175400ustar00rootroot00000000000000(* Several simple examples *) (* Set up the loading path: load_path := "path to the formal_ineqs directory" :: !load_path;; *) (* Change default arithmetic options before loading other libraries *) (* (arithmetic options cannot be changed later) *) needs "arith_options.hl";; (* Set the base of natural number arithmetic to 200 *) Arith_options.base := 200;; (* Load all verification libraries *) (* Note: the verification library loads Multivariate/realanalysis.ml, so it is recommended to use a checkpointed version of HOL Light with preloaded realanalysis.ml *) needs "verifier/m_verifier_main.hl";; (* Set the level of info/debug printing: 0 - no info/debug printing 1 - report important steps (default) 2 - report everything *) needs "verifier_options.hl";; Verifier_options.info_print_level := 1;; (* Open the main verification module *) open M_verifier_main;; (* Several simple tests *) (* default_params: default verification parameters *) (* 5: precision parameter for floating point arithmetic *) let test1 () = verify_ineq default_params 5 `sqrt(pi) < #1.773`;; let test2 () = verify_ineq default_params 11 `#1.230959417 < acs(&1 / &3)`;; let test3 () = verify_ineq default_params 11 `#1.230959418 > acs(&1 / &3)`;; (* An approximation of atn *) let test4 () = let ineq1 = `&0 <= x /\ x <= &1 ==> atn x - x / (&1 + #0.28 * x * x) < #0.005` in let ineq2 = `&0 <= x /\ x <= &1 ==> -- #0.005 < atn x - x / (&1 + #0.28 * x * x)` in [verify_ineq default_params 5 ineq1; verify_ineq default_params 6 ineq2];; (* A polynomial approximation of atn *) (* Taken from: *) (* Marc Daumas, David Lester, and César Muñoz, Verified real number calculations: A library for interval arithmetic, IEEE Transactions on Computers, Volume 58, Number 2, 2009. *) let test5 () = let ineq1 = `-- &1 / &30 <= x /\ x <= &1 / &30 ==> x * (&1 - (x * x) * (&11184811 / &33554432 - (x * x) * (&13421773 / &67108864))) - atn x < #0.1 pow 7` in let ineq2 = `-- &1 / &30 <= x /\ x <= &1 / &30 ==> -- (#0.1 pow 7) < x * (&1 - (x * x) * (&11184811 / &33554432 - (x * x) * (&13421773 / &67108864))) - atn x` in [verify_ineq default_params 5 ineq1; verify_ineq default_params 5 ineq2];; (* Returns a list of theorems with verification information *) let run_tests () = [test1(); test2(); test3()] @ test4() @ test5();; (* Returns a list of theorems *) let results () = map fst (run_tests ());; results();; hol-light/Formal_ineqs/examples_flyspeck.hl000066400000000000000000000257201303454263000214350ustar00rootroot00000000000000(* Some inequalities from the Flyspeck project *) (* https://github.com/flyspeck/flyspeck *) (* Set up the loading path: load_path := "path to the formal_ineqs directory" :: !load_path;; *) (* Change default arithmetic options before loading other libraries *) (* (arithmetic options cannot be changed later) *) needs "arith_options.hl";; (* Set the base of natural number arithmetic to 200 *) Arith_options.base := 200;; (* Load all verification libraries *) (* Note: the verification library loads Multivariate/realanalysis.ml, so it is recommended to use a checkpointed version of HOL Light with preloaded realanalysis.ml *) needs "verifier/m_verifier_main.hl";; (* Set the level of info/debug printing: 0 - no info/debug printing 1 - report important steps (default) 2 - report everything *) needs "verifier_options.hl";; Verifier_options.info_print_level := 1;; (* Open the main verification module *) open M_verifier_main;; (************************) (* Flyspeck definitions *) (* ineq *) let ineq = define `(!c. ineq [] c <=> c) /\ (!a x b xs c. ineq (CONS (a,x,b) xs) c <=> a <= x /\ x <= b ==> ineq xs c)`;; (* A modified (only one case is considered, x > 0) definition of atn2 *) (* Add ' to some definitions to avoid conflicts with original Flyspeck definitions *) let atn2' = new_definition `atn2'(x,y) = atn(y / x)` (* delta_x *) let delta_x = new_definition (`delta_x x1 x2 x3 x4 x5 x6 = x1*x4*(--x1 + x2 + x3 -x4 + x5 + x6) + x2*x5*(x1 - x2 + x3 + x4 -x5 + x6) + x3*x6*(x1 + x2 - x3 + x4 + x5 - x6) -x2*x3*x4 - x1*x3*x5 - x1*x2*x6 -x4*x5*x6`);; (* delta_y *) let delta_y = new_definition `delta_y y1 y2 y3 y4 y5 y6 = delta_x (y1*y1) (y2*y2) (y3*y3) (y4*y4) (y5*y5) (y6*y6)`;; (* delta_x4 *) let delta_x4= new_definition(`delta_x4 x1 x2 x3 x4 x5 x6 = -- x2* x3 - x1* x4 + x2* x5 + x3* x6 - x5* x6 + x1* (-- x1 + x2 + x3 - x4 + x5 + x6)`);; (* ups_x *) let ups_x = new_definition(`ups_x x1 x2 x6 = --x1*x1 - x2*x2 - x6*x6 + &2 *x1*x6 + &2 *x1*x2 + &2 *x2*x6`);; (* rho_x *) let rho_x = new_definition(`rho_x x1 x2 x3 x4 x5 x6 = --x1*x1*x4*x4 - x2*x2*x5*x5 - x3*x3*x6*x6 + (&2)*x1*x2*x4*x5 + (&2)*x1*x3*x4*x6 + (&2)*x2*x3*x5*x6`);; (* rad2_x *) let rad2_x = new_definition(`rad2_x x1 x2 x3 x4 x5 x6 = (rho_x x1 x2 x3 x4 x5 x6)/((delta_x x1 x2 x3 x4 x5 x6)*(&4))`);; (* dih_x', atn2 replaced with atan2 *) let dih_x' = new_definition(`dih_x' x1 x2 x3 x4 x5 x6 = let d_x4 = delta_x4 x1 x2 x3 x4 x5 x6 in let d = delta_x x1 x2 x3 x4 x5 x6 in pi/ (&2) + atn2'( (sqrt ((&4) * x1 * d)),-- d_x4)`);; (* dih_y *) let dih_y' = new_definition(`dih_y' y1 y2 y3 y4 y5 y6 = let (x1,x2,x3,x4,x5,x6)= (y1*y1,y2*y2,y3*y3,y4*y4,y5*y5,y6*y6) in dih_x' x1 x2 x3 x4 x5 x6`);; (* arclength *) let arclength' = new_definition(`arclength' a b c = pi/(&2) + (atn2'( (sqrt (ups_x (a*a) (b*b) (c*c))),(c*c - a*a -b*b)))`);; (* sol_x *) let sol_x' = new_definition(`sol_x' x1 x2 x3 x4 x5 x6 = (dih_x' x1 x2 x3 x4 x5 x6) + (dih_x' x2 x3 x1 x5 x6 x4) + (dih_x' x3 x1 x2 x6 x4 x5) - pi`);; (* sol_y *) let sol_y' = new_definition(`sol_y' y1 y2 y3 y4 y5 y6 = (dih_y' y1 y2 y3 y4 y5 y6) + (dih_y' y2 y3 y1 y5 y6 y4) + (dih_y' y3 y1 y2 y6 y4 y5) - pi`);; (* const1 *) let const1' = new_definition `const1' = sol_y' (&2) (&2) (&2) (&2) (&2) (&2) / pi`;; (* h0 *) let h0 = new_definition `h0 = #1.26`;; (* lfun *) let lfun = new_definition `lfun h = (h0 - h)/(h0 - &1)`;; (* lfun_y1 *) let lfun_y1 = new_definition `lfun_y1 (y1:real) (y2:real) (y3:real) (y4:real) (y5:real) (y6:real) = lfun y1`;; (* num1 *) let num1 = new_definition `num1 e1 e2 e3 a2 b2 c2 = -- &4*((a2 pow 2) *e1 + &8*(b2 - c2)*(e2 - e3) - a2*(&16*e1 + ( b2 - &8 )*e2 + (c2 - &8)*e3))`;; (* unit6 *) let unit6 = define `unit6 x1 x2 x3 x4 x5 x6 = &1`;; (* arc_hhn *) let arc_hhn' = new_definition `arc_hhn' = arclength' (&2 * h0) (&2 * h0) (&2)`;; (* arclength_y1 *) let arclength_y1' = new_definition `arclength_y1' a b (y1:real) (y2:real) (y3:real) (y4:real) (y5:real) (y6:real) = arclength' y1 a b`;; (* arclength_x1 *) let arclength_x1' = new_definition `arclength_x1' a b x1 x2 x3 x4 x5 x6 = arclength_y1' a b (sqrt x1) (sqrt x2) (sqrt x3) (sqrt x4) (sqrt x5) (sqrt x6)`;; (* arclength_x_123 *) let arclength_x_123' = new_definition `arclength_x_123' (x1:real) (x2:real) (x3:real) (x4:real) (x5:real) (x6:real) = arclength' (sqrt x1) (sqrt x2) (sqrt x3)`;; (* acs_sqrt_x1_d4 *) let acs_sqrt_x1_d4 = new_definition `acs_sqrt_x1_d4 (x1:real) (x2:real) (x3:real) (x4:real) (x5:real) (x6:real) = acs (sqrt(x1)/ &4)`;; let sqrt_x1 = define `sqrt_x1 x1 x2 x3 x4 x5 x6 = sqrt x1`;; let sqrt_x2 = define `sqrt_x2 x1 x2 x3 x4 x5 x6 = sqrt x2`;; let sqrt_x3 = define `sqrt_x3 x1 x2 x3 x4 x5 x6 = sqrt x3`;; let sqrt_x4 = define `sqrt_x4 x1 x2 x3 x4 x5 x6 = sqrt x4`;; let sqrt_x5 = define `sqrt_x5 x1 x2 x3 x4 x5 x6 = sqrt x5`;; let sqrt_x6 = define `sqrt_x6 x1 x2 x3 x4 x5 x6 = sqrt x6`;; (* All definitions in one list *) let flyspeck_defs = [atn2'; delta_x; delta_y; delta_x4; ups_x; rho_x; dih_x'; dih_y'; arclength'; sol_x'; sol_y'; const1'; num1; unit6; h0; lfun; lfun_y1; rad2_x; arc_hhn'; arclength_y1'; arclength_x1'; acs_sqrt_x1_d4; arclength_x_123'; sqrt_x1; sqrt_x2; sqrt_x3; sqrt_x4; sqrt_x5; sqrt_x6];; (* A simple function for verifying Flyspeck inequalities *) let verify_flyspeck_ineq pp ineq_tm = let conv = REWRITE_CONV ([ineq; IMP_IMP] @ flyspeck_defs) THENC DEPTH_CONV let_CONV in let eq_th = conv ineq_tm in let ineq_tm1 = (rand o concl) eq_th in let th, time = verify_ineq default_params pp ineq_tm1 in REWRITE_RULE[GSYM eq_th] th, time;; (* Create a hashtable for saving inequalities *) type difficulty = Easy | Medium | Hard;; type flyspeck_example = { difficulty : difficulty; id : string; ineq_tm : term; };; let examples = Hashtbl.create 20;; let add_example ex = Hashtbl.add examples ex.id ex;; (* 2485876245a *) add_example {id = "2485876245a"; difficulty = Easy; ineq_tm = `ineq [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #6.3504; #3.0 * #3.0, x5, #2.0 * #2.52 * #2.0 * #2.52; #4.0,x6, #6.3504] (delta_x4 x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; (* 4559601669b *) add_example {id = "4559601669b"; difficulty = Easy; ineq_tm = `ineq [ #4.0,x1, #6.3504; #4.0,x2, #4.0; #4.0,x3, #6.3504; #3.01 * #3.01, x4, #3.01 * #3.01; #4.0, x5, #6.3504; #4.0,x6, #4.0] (delta_x4 x1 x2 x3 x4 x5 x6 < &0)`};; (* 5512912661 *) add_example {id = "5512912661"; difficulty = Easy; ineq_tm = `ineq [&1,x1,&1 + (pi * const1') / pi; &1,x2,&1 + (pi * const1') / pi; &1, x3, &1 + (pi * const1') / pi; #2.38 * #2.38, x4, #3.01 * #3.01; &2 * &2, x5, #2.52 * #2.52; #3.15 / #1.26 * #3.15 / #1.26,x6, #15.53] (num1 x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; (* 6843920790 *) add_example {id = "6843920790"; difficulty = Easy; ineq_tm = `ineq [&1,x1,&1 + (pi * const1') / pi; &1,x2,&1 + (pi * const1') / pi; &1, x3, &1 + (pi * const1') / pi; &2 / #1.26 * &2 / #1.26, x4, #3.01 * #3.01; #2.38 * #2.38, x5, #15.53; #2.38 * #2.38,x6, #15.53] (num1 x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; (* 6096597438a *) add_example {id = "6096597438a"; difficulty = Easy; ineq_tm = `ineq [ #1.0,x1, #1.0; &1,x2,&1; &1,x3,&1; &1,x4,&1; &1,x5,&1; &1,x6,&1] (unit6 x1 x2 x3 x4 x5 x6 * #0.591 + unit6 x1 x2 x3 x4 x5 x6 * #0.0331 * -- &64 + unit6 x1 x2 x3 x4 x5 x6 * #0.506 * #1.26 * &1 / ( #1.26 + -- &1) + unit6 x1 x2 x3 x4 x5 x6 * #0.506 * --(&1 / ( #1.26 + -- &1)) + unit6 x1 x2 x3 x4 x5 x6 * #1.0 < &0)`};; (* 4717061266 *) add_example {id = "4717061266"; difficulty = Easy; ineq_tm = `ineq [ #4.0,x1, #2.0 * #1.26 * #2.0 * #1.26; #4.0, x2, #2.0 * #1.26 * #2.0 * #1.26; #4.0, x3, #2.0 * #1.26 * #2.0 * #1.26; #4.0,x4, #2.0 * #1.26 * #2.0 * #1.26; #4.0, x5, #2.0 * #1.26 * #2.0 * #1.26; #4.0,x6, #2.0 * #1.26 * #2.0 * #1.26] (delta_x x1 x2 x3 x4 x5 x6 * -- &1 < &0)`};; (* SDCCMGA b *) add_example {id = "SDCCMGA b"; difficulty = Easy; ineq_tm = `ineq [ #4.0,x1, #6.3504; &1 * &1,x2,&1 * &1; &1 * &1,x3,&1 * &1; &1 * &1, x4, &1 * &1; &1 * &1, x5, &1 * &1; &1 * &1,x6,&1 * &1] (arclength_x1' #2.0 ( #2.0 * #1.26) x1 x2 x3 x4 x5 x6 + arclength_x1' #2.0 ( #2.0 * #1.26) x1 x2 x3 x4 x5 x6 + arclength_x1' ( #2.0 * #1.26) #2.0 x1 x2 x3 x4 x5 x6 * -- &1 + unit6 x1 x2 x3 x4 x5 x6 * pi * --(&1 / &3) + unit6 x1 x2 x3 x4 x5 x6 * --arc_hhn' < &0)`};; (* TSKAJXY-TADIAMB *) add_example {id = "TSKAJXY-TADIAMB"; difficulty = Medium; ineq_tm = `ineq [ #2.0 * #1.3254 * #2.0 * #1.3254,x1, #8.0; #2.0 * #1.3254 * #2.0 * #1.3254, x2, #8.0; #4.0,x3, #8.0; #4.0, x4, #8.0; #4.0,x5, #8.0; #4.0,x6, #8.0] ((unit6 x1 x2 x3 x4 x5 x6 * #2.0) * (delta_x x1 x2 x3 x4 x5 x6 * &4) < rho_x x1 x2 x3 x4 x5 x6)`};; (* 7067938795 *) add_example {id = "7067938795"; difficulty = Medium; ineq_tm = `ineq [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #4.0; #3.01 * #3.01, x5, #3.24 * #3.24; #3.01 * #3.01,x6, #3.24 * #3.24] (dih_x' x1 x2 x3 x4 x5 x6 + unit6 x1 x2 x3 x4 x5 x6 * pi * --(&1 / #2.0) + unit6 x1 x2 x3 x4 x5 x6 * #0.46 < &0)`};; (* 5490182221 *) add_example { id = "5490182221"; difficulty = Medium; ineq_tm = `ineq [ #4.0,x1, #6.3504; #4.0,x2, #6.3504; #4.0,x3, #6.3504; #4.0,x4, #6.3504; #4.0, x5, #6.3504; #4.0,x6, #6.3504] (dih_x' x1 x2 x3 x4 x5 x6 + unit6 x1 x2 x3 x4 x5 x6 * -- #1.893 < &0)`};; (* 3318775219 *) add_example { id = "3318775219"; difficulty = Hard; ineq_tm = `ineq [&2, y1, #2.52; &2, y2, #2.52; &2, y3, #2.52; #2.52, y4, sqrt(&8); &2, y5, #2.52; &2, y6, #2.52] ( ((dih_y' y1 y2 y3 y4 y5 y6) - #1.629 + (#0.414 * (y2 + y3 + y5 + y6 - #8.0)) - (#0.763 * (y4 - #2.52)) - (#0.315 * (y1 - #2.0))) * (-- &1) < &0)`};; (* Tests *) let run_example id = id, verify_flyspeck_ineq 4 (Hashtbl.find examples id).ineq_tm;; let test_easy, test_medium, test_hard = let run keys = map run_example keys in let get_keys d0 = let list = Hashtbl.fold (fun k v acc -> (k, v.difficulty) :: acc) examples [] in (setify o fst o unzip) (filter (fun (_, d) -> d = d0) list) in (fun () -> run (get_keys Easy)), (fun () -> run (get_keys Medium)), (fun () -> run (get_keys Hard));; let easy = test_easy();; (* let medium = test_medium();; *) (* let hard = test_hard();; *) hol-light/Formal_ineqs/examples_poly.hl000066400000000000000000000107151303454263000205760ustar00rootroot00000000000000(* Multivariate polynomial inequalities *) (* Examples are taken from the paper: César Muñoz and Anthony Narkawicz, Formalization of a Representation of Bernstein Polynomials and Applications to Global Optimization, Journal of Automated Reasoning, DOI: 10.1007/s10817-012-9256-3 http://shemesh.larc.nasa.gov/people/cam/Bernstein/ *) (* Set up the loading path: load_path := "path to the formal_ineqs directory" :: !load_path;; *) (* Change default arithmetic options before loading other libraries *) (* (arithmetic options cannot be changed later) *) needs "arith_options.hl";; (* Set the base of natural number arithmetic to 200 *) Arith_options.base := 200;; (* Load all verification libraries *) (* Note: the verification library loads Multivariate/realanalysis.ml, so it is recommended to use a checkpointed version of HOL Light with preloaded realanalysis.ml *) needs "verifier/m_verifier_main.hl";; (* Set the level of info/debug printing: 0 - no info/debug printing 1 - report important steps (default) 2 - report everything *) needs "verifier_options.hl";; Verifier_options.info_print_level := 1;; (* Open the main verification module *) open M_verifier_main;; (* Data *) (* Polynomials *) let schwefel_poly = `(x1 - x2 pow 2) pow 2 + (x2 - &1) pow 2 + (x1 - x3 pow 2) pow 2 + (x3 - &1) pow 2` and rd_poly = `-- x1 + &2 * x2 - x3 - #0.835634534 * x2 * (&1 + x2)` and caprasse_poly = `-- x1 * x3 pow 3 + &4 * x2 * x3 pow 2 * x4 + &4 * x1 * x3 * x4 pow 2 + &2 * x2 * x4 pow 3 + &4 * x1 * x3 + &4 * x3 pow 2 - &10 * x2 * x4 - &10 * x4 pow 2 + &2` and lv_poly = `x1 * x2 pow 2 + x1 * x3 pow 2 + x1 * x4 pow 2 - #1.1 * x1 + &1` and butcher_poly = `x6 * x2 pow 2 + x5 * x3 pow 2 - x1 * x4 pow 2 + x4 pow 2 - &1 / &3 * x1 + &4 / &3 * x4` and magnetism_poly = `x1 pow 2 + &2 * x2 pow 2 + &2 * x3 pow 2 + &2 * x4 pow 2 + &2 * x5 pow 2 + &2 * x6 pow 2 + &2 * x7 pow 2 - x1` and heart_poly = `-- x1 * x6 pow 3 + &3 * x1 * x6 * x7 pow 2 - x3 * x7 pow 3 + &3 * x3 * x7 * x6 pow 2 - x2 * x5 pow 3 + &3 * x2 * x5 * x8 pow 2 - x4 * x8 pow 3 + &3 * x4 * x8 * x5 pow 2 - #0.9563453`;; (* Minimal values *) let schwefel_min = `-- #0.00000000058806` and rd_min = `-- #36.7126907` and caprasse_min = `-- #3.1801` and lv_min = `-- #20.801` and butcher_min = `-- #1.44` and magnetism_min = `-- #0.25001` and heart_min = `-- #1.7435`;; (* Domains *) let schwefel_dom = `[-- &10; -- &10; -- &10]`, `[&10; &10; &10]` and rd_dom = `[-- &5; -- &5; -- &5]`, `[&5; &5; &5]` and caprasse_dom = `[-- #0.5; -- #0.5; -- #0.5; -- #0.5]`, `[#0.5; #0.5; #0.5; #0.5]` and lv_dom = `[-- &2; -- &2; -- &2; -- &2]`, `[&2; &2; &2; &2]` and butcher_dom = `[-- &1; -- #0.1; -- #0.1; -- &1; -- #0.1; -- #0.1]`, `[&0; #0.9; #0.5; -- #0.1; -- #0.05; -- #0.03]` and magnetism_dom = `[-- &1; -- &1; -- &1; -- &1; -- &1; -- &1; -- &1]`, `[&1; &1; &1; &1; &1; &1; &1]` and heart_dom = `[-- #0.1; #0.4; -- #0.7; -- #0.7; #0.1; -- #0.1; -- #0.3; -- #1.1]`, `[#0.4; &1; -- #0.4; #0.4; #0.2; #0.2; #1.1; -- #0.3]`;; let mk_poly_ineq poly_tm min_tm dom = let n = length (frees poly_tm) in let xs = map (fun i -> "x"^string_of_int i) (1--n) in let ineq_tm = mk_binop `(<):real->real->bool` min_tm poly_tm in let ineq2_tm = M_verifier_main.mk_ineq ineq_tm xs dom in ineq2_tm;; (* Create all inequalities *) let schwefel_ineq, rd_ineq, caprasse_ineq, lv_ineq, butcher_ineq, magnetism_ineq, heart_ineq = mk_poly_ineq schwefel_poly schwefel_min schwefel_dom, mk_poly_ineq rd_poly rd_min rd_dom, mk_poly_ineq caprasse_poly caprasse_min caprasse_dom, mk_poly_ineq lv_poly lv_min lv_dom, mk_poly_ineq butcher_poly butcher_min butcher_dom, mk_poly_ineq magnetism_poly magnetism_min magnetism_dom, mk_poly_ineq heart_poly heart_min heart_dom;; (* Tests *) let test_schwefel () = verify_ineq default_params 5 schwefel_ineq;; let test_rd () = verify_ineq default_params 5 rd_ineq;; let test_caprasse () = verify_ineq default_params 5 caprasse_ineq;; let test_lv () = verify_ineq default_params 5 lv_ineq;; let test_butcher () = verify_ineq default_params 5 butcher_ineq;; let test_magnetism () = verify_ineq default_params 5 magnetism_ineq;; let test_heart () = verify_ineq {default_params with eps = 1e-10} 5 heart_ineq;; let run_tests () = [test_schwefel(); test_rd(); test_caprasse(); test_lv(); test_butcher(); test_magnetism(); test_heart()];; let results () = map fst (run_tests());; results();; hol-light/Formal_ineqs/informal/000077500000000000000000000000001303454263000171735ustar00rootroot00000000000000hol-light/Formal_ineqs/informal/informal_arith.hl000066400000000000000000000521331303454263000225220ustar00rootroot00000000000000(* =========================================================== *) (* Informal arithmetic procedures *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "misc/misc.hl";; needs "arith_options.hl";; (* Natural numbers *) module type Informal_nat_sig = sig type nat val arith_base : int val mk_nat : num -> nat val mk_small_nat : int -> nat val dest_nat : nat -> num val eq_nat : nat -> nat -> bool val suc_nat : nat -> nat val pre_nat : nat -> nat val eq0_nat : nat -> bool val gt0_nat : nat -> bool val lt_nat : nat -> nat -> bool val le_nat : nat -> nat -> bool val add_nat : nat -> nat -> nat val sub_nat : nat -> nat -> nat (* If sub_and_le_nat m n = (m - n, true) if n <= m; (n - m, false) if m < n *) val sub_and_le_nat : nat -> nat -> nat * bool val mul_nat : nat -> nat -> nat val div_nat : nat -> nat -> nat val even_nat : nat -> bool val odd_nat : nat -> bool (* normalize_nat m = (n, e) s.t. m = n * base^e, e >= 0 *) val normalize_nat : nat -> nat * int val denormalize_nat : nat * int -> nat (* hi_nat p m = (n, e) s.t. m <= n * base^e and n contains at most p "digits" *) val hi_nat : int -> nat -> nat * int val hi_lt_nat : int -> nat -> nat * int (* lo_nat p m = (n, e) s.t. n * base^e <= m and n contains at most p "digits" *) val lo_nat : int -> nat -> nat * int end;; module Informal_nat : Informal_nat_sig = struct open Arith_misc;; open Big_int;; type nat = big_int;; let arith_base = !Arith_options.base;; let mk_nat n = let result = big_int_of_num n in if sign_big_int result < 0 then zero_big_int else result;; let mk_small_nat n = if n < 0 then zero_big_int else big_int_of_int n;; let dest_nat = num_of_big_int;; let eq_nat = eq_big_int;; let suc_nat = succ_big_int;; let pre_nat n = let result = pred_big_int n in if sign_big_int result < 0 then zero_big_int else result;; let eq0_nat n = sign_big_int n = 0;; let gt0_nat n = sign_big_int n > 0;; let lt_nat = lt_big_int;; let le_nat = le_big_int;; let add_nat = add_big_int;; let sub_nat m n = let result = sub_big_int m n in if sign_big_int result < 0 then zero_big_int else result;; let sub_and_le_nat m n = let result = sub_big_int m n in if sign_big_int result >= 0 then (result, true) else (abs_big_int result, false);; let mul_nat = mult_big_int;; let div_nat = div_big_int;; let two_big_int = big_int_of_int 2;; let even_nat n = sign_big_int (mod_big_int n two_big_int) = 0;; let odd_nat n = sign_big_int (mod_big_int n two_big_int) > 0;; (*******************************) (* num_exp *) let base_nat = mk_small_nat arith_base;; (* normalize_nat m = (n, e) s.t. m = n * base^e, e >= 0 *) let normalize_nat = let rec normalize n e = let q, r = quomod_big_int n base_nat in if sign_big_int r > 0 then (n, e) else normalize q (succ e) in fun n -> if sign_big_int n = 0 then (n, 0) else normalize n 0;; let denormalize_nat (n, e) = mult_big_int n (power_int_positive_int arith_base e);; let lo_nat pp = let max = power_int_positive_int arith_base pp in let rec lo m e = if lt_big_int m max then (m, e) else let q = div_big_int m base_nat in lo q (succ e) in fun m -> if sign_big_int m = 0 then (m, 0) else let n1, e1 = lo m 0 in let n, e2 = normalize_nat n1 in n, e1 + e2;; let hi_nat pp = if pp <= 0 then failwith "hi_nat: pp <= 0" else let max = power_int_positive_int arith_base pp in let rec hi m e = if lt_big_int m max then (m, e) else let q, r = quomod_big_int m base_nat in if sign_big_int r = 0 then hi q (succ e) else hi (succ_big_int q) (succ e) in fun m -> if sign_big_int m = 0 then (m, 0) else let n1, e1 = hi m 0 in let n, e2 = normalize_nat n1 in n, e1 + e2;; let hi_lt_nat pp m = hi_nat pp (succ_big_int m);; end;; (* Floating point numbers *) module type Informal_float_sig = sig type ifloat val min_exp : int val mk_float : num -> int -> ifloat val mk_num_float : num -> ifloat val mk_small_num_float : int -> ifloat val dest_float : ifloat -> bool * num * int val sign_float : ifloat -> bool (* Compares representations, not numbers themselves *) val eq_float : ifloat -> ifloat -> bool val lo_float : int -> ifloat -> ifloat val hi_float : int -> ifloat -> ifloat val neg_float : ifloat -> ifloat val abs_float : ifloat -> ifloat val lt0_float : ifloat -> bool val gt0_float : ifloat -> bool val le0_float : ifloat -> bool val ge0_float : ifloat -> bool val lt_float : ifloat -> ifloat -> bool val le_float : ifloat -> ifloat -> bool val min_float : ifloat -> ifloat -> ifloat val max_float : ifloat -> ifloat -> ifloat val mul_float_eq : ifloat -> ifloat -> ifloat val mul_float_lo : int -> ifloat -> ifloat -> ifloat val mul_float_hi : int -> ifloat -> ifloat -> ifloat val div_float_lo : int -> ifloat -> ifloat -> ifloat val div_float_hi : int -> ifloat -> ifloat -> ifloat val add_float_lo : int -> ifloat -> ifloat -> ifloat val add_float_hi : int -> ifloat -> ifloat -> ifloat val sub_float_lo : int -> ifloat -> ifloat -> ifloat val sub_float_hi : int -> ifloat -> ifloat -> ifloat val sqrt_float_lo : int -> ifloat -> ifloat val sqrt_float_hi : int -> ifloat -> ifloat end;; module Informal_float : Informal_float_sig = struct open Informal_nat;; type ifloat = bool * nat * int;; let min_exp = !Arith_options.min_exp;; (* Creates a non-negative float *) let mk_float n e : ifloat = false, mk_nat n, e + min_exp;; let mk_num_float n = false, mk_nat n, min_exp;; let mk_small_num_float n = false, mk_small_nat n, min_exp;; let zero_float = mk_small_num_float 0;; let dest_float ((s, n, e) : ifloat) = s, dest_nat n, e;; let sign_float ((s,_,_) : ifloat) = s;; let eq_float (s1,n1,e1) (s2,n2,e2) = s1 = s2 && eq_nat n1 n2 && e1 = e2;; let lo_float pp (s,n,e) = let n1, e1 = if s then hi_nat pp n else lo_nat pp n in (s, n1, e + e1);; let hi_float pp (s,n,e) = let n1, e1 = if s then lo_nat pp n else hi_nat pp n in (s, n1, e + e1);; (* Auxiliary num_exp functions *) let num_exp_add = let (+) = add_nat in fun (n1,e1) (n2,e2) -> if e1 <= e2 then n1 + denormalize_nat (n2, e2 - e1), e1 else n2 + denormalize_nat (n1, e1 - e2), e2;; (* Returns (n,e),true if (n1,e1) >= (n2,e2) and (n,e) = (n1,e1) - (n2,e2) Returns (n,e),false if (n1,e1) <= (n2,e2) and (n,e) = (n2,e2) - (n1,e1) *) let num_exp_sub = let (--) = sub_and_le_nat in fun (n1,e1) (n2,e2) -> if e2 <= e1 then let a = denormalize_nat (n1, e1 - e2) and b = n2 in let sub, flag = a -- b in (sub, e2), flag else let a = n1 and b = denormalize_nat (n2, e2 - e1) in let sub, flag = a -- b in (sub, e1), flag;; let num_exp_le = let (<=/) = le_nat in fun (n1,e1) (n2,e2) -> if e1 <= e2 then n1 <=/ denormalize_nat (n2, e2 - e1) else denormalize_nat (n1, e1 - e2) <=/ n2;; let num_exp_lt = let ( if e1 <= e2 then n1 interval val mk_num_interval : num -> interval val mk_small_num_interval : int -> interval val dest_interval : interval -> Informal_float.ifloat * Informal_float.ifloat val round_interval : int -> interval -> interval val neg_interval : interval -> interval val mul_interval : int -> interval -> interval -> interval val div_interval : int -> interval -> interval -> interval val add_interval : int -> interval -> interval -> interval val sub_interval : int -> interval -> interval -> interval val sqrt_interval : int -> interval -> interval val inv_interval : int -> interval -> interval val pow_interval : int -> int -> interval -> interval (* Computes max(-lo, hi) *) val abs_interval : interval -> Informal_float.ifloat end;; module Informal_interval : Informal_interval_sig = struct open Informal_float;; type interval = ifloat * ifloat;; let mk_interval (lo,hi) = if lt_float hi lo then failwith "mk_interval: hi < lo" else (lo,hi);; let mk_num_interval n = let f = mk_num_float n in (f, f);; let mk_small_num_interval n = let f = mk_small_num_float n in (f, f);; let zero_interval = mk_small_num_interval 0;; let one_interval = mk_small_num_interval 1;; let two_interval = mk_small_num_interval 2;; let dest_interval ((lo,hi) : interval) = (lo,hi);; let round_interval pp (lo,hi) = (lo_float pp lo, hi_float pp hi);; let neg_interval (lo,hi) = (neg_float hi, neg_float lo);; let abs_interval (lo,hi) = max_float hi (neg_float lo);; let add_interval pp (lo1,hi1) (lo2,hi2) = (add_float_lo pp lo1 lo2, add_float_hi pp hi1 hi2);; let sub_interval pp (lo1,hi1) (lo2,hi2) = (sub_float_lo pp lo1 hi2, sub_float_hi pp hi1 lo2);; let sqrt_interval pp (lo,hi) = if sign_float lo then failwith "sqrt_interval: negative lower bound" else (sqrt_float_lo pp lo, sqrt_float_hi pp hi);; (* mul *) let mul_interval pp (l_lo,l_hi) (r_lo,r_hi) = let s1 = sign_float l_lo and s2 = sign_float l_hi and s3 = sign_float r_lo and s4 = sign_float r_hi in if s1 <> s2 && not s1 then zero_interval else if s3 <> s4 && not s3 then zero_interval else if s1 <> s2 && s3 <> s4 then let lo1, lo2 = mul_float_lo pp l_lo r_hi, mul_float_lo pp l_hi r_lo and hi1, hi2 = mul_float_hi pp l_lo r_lo, mul_float_hi pp l_hi r_hi in (min_float lo1 lo2, max_float hi1 hi2) else let lo1, lo2, hi1, hi2 = if s1 <> s2 then if not s3 then l_lo, r_hi, l_hi, r_hi else l_hi, r_lo, l_lo, r_lo else if s3 <> s4 then if not s1 then l_hi, r_lo, l_hi, r_hi else l_lo, r_hi, l_lo, r_lo else if not s1 then if not s3 then l_lo, r_lo, l_hi, r_hi else l_hi, r_lo, l_lo, r_hi else if not s3 then l_lo, r_hi, l_hi, r_lo else l_hi, r_hi, l_lo, r_lo in (mul_float_lo pp lo1 lo2, mul_float_hi pp hi1 hi2);; (* div *) let div_interval pp (l_lo,l_hi) (r_lo,r_hi) = let s1 = sign_float l_lo and s2 = sign_float l_hi and s3 = sign_float r_lo and s4 = sign_float r_hi in if s1 <> s2 && not s1 then zero_interval else if s3 <> s4 then failwith "div_interval: division by an interval containing 0" else let lo1, lo2, hi1, hi2 = if s1 = s2 then if not s1 then if not s3 then l_lo, r_hi, l_hi, r_lo else l_hi, r_hi, l_lo, r_lo else if not s3 then l_lo, r_lo, l_hi, r_hi else l_hi, r_lo, l_lo, r_hi else if not s3 then l_lo, r_lo, l_hi, r_lo else l_hi, r_hi, l_lo, r_hi in (div_float_lo pp lo1 lo2, div_float_hi pp hi1 hi2);; (* inv *) let inv_interval pp int = div_interval pp one_interval int;; (* pow *) let pow_interval pp n int = let rec pow n = if n <= 0 then one_interval else if n = 1 then int else let i2 = pow (n - 1) in mul_interval pp int i2 in pow n;; (* Arith_misc.gen_pow (mul_interval pp) one_interval n;; *) end;; (* atn *) module type Informal_atn_sig = sig val atn_interval : int -> Informal_interval.interval -> Informal_interval.interval val acs_interval : int -> Informal_interval.interval -> Informal_interval.interval val pi_approx_array : Informal_interval.interval array val pi2_approx_array : Informal_interval.interval array end;; module Informal_atn : Informal_atn_sig = struct open Informal_float;; open Informal_interval;; let rec poly_f_interval pp l x = if length l = 0 then failwith "poly_f_interval: an empty coefficient list" else let first = hd l in if length l = 1 then first else let r = poly_f_interval pp (tl l) x in add_interval pp first (mul_interval pp x r);; let poly_f_even_interval pp l x = let xx = mul_interval pp x x in poly_f_interval pp l xx;; let poly_f_odd_interval pp l x = let even = poly_f_even_interval pp l x in mul_interval pp x even;; let halfatn_interval pp x = let xx = mul_interval pp x x in let one_xx = add_interval pp one_interval xx in let sqrt = sqrt_interval pp one_xx in let one_sqrt = add_interval pp sqrt one_interval in div_interval pp x one_sqrt;; let halfatn4_interval pp x = (halfatn_interval pp o halfatn_interval pp o halfatn_interval pp o halfatn_interval pp) x;; (* Computes an interval for 16 * sum(0..n) (halfatn4_co x) *) let atn_sum_interval = let interval_16 = mk_small_num_interval 16 in fun pp l x -> let halfatn4 = halfatn4_interval pp x in let poly = poly_f_odd_interval pp l halfatn4 in mul_interval pp interval_16 poly;; let atn0_interval pp l eps x = let sum = atn_sum_interval pp l x in let a, b = dest_interval sum in let _, d = dest_interval eps in let hi = add_float_hi pp b d in let lo = sub_float_lo pp a d in mk_interval (lo, hi);; (* Computes an interval for 2 ^ -(6n + 5) *) let compute_eps1 pp n = let pow = pow_interval pp (6 * n + 5) two_interval in inv_interval pp pow;; let mk_atn_co_table pp n = let get_val k = let l = if (k land 1) = 0 then one_interval else neg_interval (one_interval) in let r = mk_small_num_interval (2 * k + 1) in div_interval pp l r in map get_val (0--n);; (* Lookup tables *) let n_of_p pp = let x = (float_of_int (pp + 1) *. log (float_of_int Informal_nat.arith_base) /. log (2.0) -. 5.0) /. 6.0 in let n = (int_of_float o ceil) x in if n < 1 then 1 else n;; let atn_co_array = Array.init 21 (fun i -> mk_atn_co_table (i + 1) (n_of_p i));; let eps1_array = Array.init 21 (fun i -> compute_eps1 (i + 1) (n_of_p i));; let atn_interval pp x = atn0_interval pp atn_co_array.(pp) eps1_array.(pp) x;; (* pi approximation *) let pi_approx_array, pi2_approx_array = let pp = 20 in let x = one_interval in let r1 = atn_interval pp x in let r2 = mul_interval pp (mk_small_num_interval 4) r1 in let float_pi = r2 in let float_pi2 = div_interval pp float_pi two_interval in let pi_int0 = mk_small_num_interval 0 in let pi2_int0 = pi_int0 in Array.init 19 (fun i -> if i = 0 then pi_int0 else round_interval i float_pi), Array.init 19 (fun i -> if i = 0 then pi2_int0 else round_interval i float_pi2);; (* acs *) let acs0_interval pp l eps1 x = let int1 = sub_interval pp one_interval (mul_interval pp x x) in let int2 = div_interval pp x (sqrt_interval pp int1) in let atn_int = atn0_interval pp l eps1 int2 in sub_interval pp pi2_approx_array.(pp + 1) atn_int;; let acs_interval pp x = acs0_interval pp atn_co_array.(pp) eps1_array.(pp) x;; end;; hol-light/Formal_ineqs/informal/informal_eval_interval.hl000066400000000000000000000230141303454263000242420ustar00rootroot00000000000000(* =========================================================== *) (* Informal interval evaluation of arithmetic expressions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "informal/informal_arith.hl";; module Informal_eval_interval = struct open Informal_interval;; open Informal_float;; open Informal_atn;; (* Creates an interval approximation of the given decimal term *) let mk_float_interval_decimal pp decimal_tm = let n_tm, d_tm = dest_binary "DECIMAL" decimal_tm in let n, d = dest_numeral n_tm, dest_numeral d_tm in let n_int, d_int = mk_num_interval n, mk_num_interval d in div_interval pp n_int d_int;; (* Unary interval operations *) let unary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table "real_neg" (fun pp -> neg_interval); add table "real_inv" inv_interval; add table "sqrt" sqrt_interval; add table "atn" atn_interval; add table "acs" acs_interval; table;; (* Binary interval operations *) let binary_interval_operations = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table "real_add" add_interval; add table "real_sub" sub_interval; add table "real_mul" mul_interval; add table "real_div" div_interval; table;; (* Interval approximations of constants *) let interval_constants = let table = Hashtbl.create 10 in let add = Hashtbl.add in add table "pi" (fun pp -> pi_approx_array.(pp)); table;; (* Type of an interval function *) type interval_fun = | Int_ref of int | Int_var of int | Int_const of interval | Int_decimal_const of term | Int_named_const of string | Int_pow of int * interval_fun | Int_unary of string * interval_fun | Int_binary of string * interval_fun * interval_fun;; (* Equality of interval functions *) let rec eq_ifun ifun1 ifun2 = match (ifun1, ifun2) with | (Int_ref r1, Int_ref r2) -> r1 = r2 | (Int_var v1, Int_var v2) -> v1 = v2 | (Int_decimal_const tm1, Int_decimal_const tm2) -> tm1 = tm2 | (Int_named_const name1, Int_named_const name2) -> name1 = name2 | (Int_pow (n1, f1), Int_pow (n2, f2)) -> n1 = n2 && eq_ifun f1 f2 | (Int_unary (op1, f1), Int_unary (op2, f2)) -> op1 = op2 && eq_ifun f1 f2 | (Int_binary (op1, f1, g1), Int_binary (op2, f2, g2)) -> op1 = op2 && eq_ifun f1 f2 && eq_ifun g1 g2 | (Int_const int1, Int_const int2) -> let lo1, hi1 = dest_interval int1 and lo2, hi2 = dest_interval int2 in eq_float lo1 lo2 && eq_float hi1 hi2 | _ -> false;; (* Evaluates the given interval function at the point defined by the given list of variables *) let eval_interval_fun = let u_find = Hashtbl.find unary_interval_operations and b_find = Hashtbl.find binary_interval_operations and c_find = Hashtbl.find interval_constants in fun pp ifun vars refs -> let rec rec_eval f = match f with | Int_ref i -> List.nth refs i | Int_var i -> List.nth vars (i - 1) | Int_const int -> int | Int_decimal_const tm -> mk_float_interval_decimal pp tm | Int_named_const name -> (c_find name) pp | Int_pow (n,f1) -> pow_interval pp n (rec_eval f1) | Int_unary (op,f1) -> (u_find op) pp (rec_eval f1) | Int_binary (op,f1,f2) -> (b_find op) pp (rec_eval f1) (rec_eval f2) in rec_eval ifun;; (* Evaluates all sub-expressions involving constants in the given interval function *) let eval_constants = let u_find = Hashtbl.find unary_interval_operations and b_find = Hashtbl.find binary_interval_operations and c_find = Hashtbl.find interval_constants in fun pp ifun -> let rec rec_eval f = match f with | Int_decimal_const tm -> Int_const (mk_float_interval_decimal pp tm) | Int_named_const name -> Int_const (c_find name pp) | Int_pow (n, f1) -> (let f1_val = rec_eval f1 in match f1_val with | Int_const int -> Int_const (pow_interval pp n int) | _ -> Int_pow (n,f1_val)) | Int_unary (op, f1) -> (let f1_val = rec_eval f1 in match f1_val with | Int_const int -> Int_const (u_find op pp int) | _ -> Int_unary (op, f1_val)) | Int_binary (op, f1, f2) -> (let f1_val, f2_val = rec_eval f1, rec_eval f2 in match f1_val with | Int_const int1 -> (match f2_val with | Int_const int2 -> Int_const (b_find op pp int1 int2) | _ -> Int_binary (op, f1_val, f2_val)) | _ -> Int_binary (op, f1_val, f2_val)) | _ -> f in rec_eval ifun;; (**************************************) (* Builds an interval function from the given term expression *) let build_interval_fun = let amp_op_real = `(&):num -> real` in let rec rec_build expr_tm = if is_const expr_tm then (* Constant *) Int_named_const (fst (dest_const expr_tm)) else if is_var expr_tm then (* Variables should be of the form name$i *) failwith ("Variables should be of the form name$i: " ^ string_of_term expr_tm) else let ltm, r_tm = dest_comb expr_tm in (* Unary operations *) if is_const ltm then (* & *) if ltm = amp_op_real then let n = dest_numeral r_tm in Int_const (mk_num_interval n) else let r_fun = rec_build r_tm in Int_unary ((fst o dest_const) ltm, r_fun) else (* Binary operations *) let op, l_tm = dest_comb ltm in let name = (fst o dest_const) op in if name = "DECIMAL" then (* DECIMAL *) Int_decimal_const expr_tm else if name = "real_pow" then (* pow *) let n = dest_small_numeral r_tm in Int_pow (n, rec_build l_tm) else if name = "$" then (* $ *) Int_var (dest_small_numeral (rand expr_tm)) else let lhs = rec_build l_tm and rhs = rec_build r_tm in Int_binary ((fst o dest_const) op, lhs, rhs) in rec_build;; (* Replaces the given subexpression with the given reference index for all interval functions in the list. Returns the number of replaces and a new list of interval functions *) let replace_subexpr expr expr_index f_list = let rec replace f = if eq_ifun f expr then 1, Int_ref expr_index else match f with | Int_pow (k, f1) -> let c, f1' = replace f1 in c, Int_pow (k, f1') | Int_unary (op, f1) -> let c, f1' = replace f1 in c, Int_unary (op, f1') | Int_binary (op, f1, f2) -> let c1, f1' = replace f1 in let c2, f2' = replace f2 in c1 + c2, Int_binary (op, f1', f2') | _ -> 0, f in let cs, fs = unzip (map replace f_list) in itlist (+) cs 0, fs;; let is_leaf f = match f with | Int_pow _ -> false | Int_unary _ -> false | Int_binary _ -> false | _ -> true;; let find_and_replace_all f_list acc = let rec find_and_replace f i f_list = if is_leaf f then f, (0, f_list) else let expr, (c, fs) = match f with | Int_pow (k, f1) -> find_and_replace f1 i f_list | Int_unary (op, f1) -> find_and_replace f1 i f_list | Int_binary (op, f1, f2) -> let expr, (c1, fs) = find_and_replace f1 i f_list in if c1 > 1 then expr, (c1, fs) else find_and_replace f2 i f_list | _ -> f, (0, f_list) in if c > 1 then expr, (c, fs) else f, replace_subexpr f i f_list in let rec iterate fs acc = let i = length acc in let expr, (c, fs') = find_and_replace (hd fs) i fs in if c > 1 then iterate fs' (acc @ [expr]) else fs, acc in let rec iterate_all f_list ref_acc f_acc = match f_list with | [] -> f_acc, ref_acc | f :: fs -> let fs', acc' = iterate f_list ref_acc in iterate_all (tl fs') acc' (f_acc @ [hd fs']) in iterate_all f_list acc [];; let eval_interval_fun_list pp (f_list, refs) vars = let rec eval_refs refs acc = match refs with | [] -> acc | r :: rs -> let v = eval_interval_fun pp r vars acc in eval_refs rs (acc @ [v]) in let rs = eval_refs refs [] in map (fun f -> eval_interval_fun pp f vars rs) f_list;; (* Approximate the bounds of the given interval with floating point numbers *) let interval_to_float_interval pp int_th = let lo_tm, hi_tm = (dest_pair o rand o concl) int_th in let f_lo = build_interval_fun lo_tm and f_hi = build_interval_fun hi_tm in let int_lo = eval_interval_fun pp f_lo [] [] and int_hi = eval_interval_fun pp f_hi [] [] in let a, _ = dest_interval int_lo and _, b = dest_interval int_hi in mk_interval (a, b);; (* Adds a new constant approximation to the table of constants *) let add_constant_interval int_th = let c_tm = (rand o rator o concl) int_th in let _ = is_const c_tm or failwith "add_constant_interval: not a constant" in let interval = interval_to_float_interval 20 int_th in let approx_array = Array.init 20 (fun i -> round_interval (if i = 0 then 1 else i) interval) in Hashtbl.add interval_constants (fst (dest_const c_tm)) (fun pp -> approx_array.(pp));; end;; hol-light/Formal_ineqs/informal/informal_m_taylor.hl000066400000000000000000000334611303454263000232440ustar00rootroot00000000000000(* =========================================================== *) (* Informal taylor intervals *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "informal/informal_arith.hl";; needs "informal/informal_eval_interval.hl";; module Informal_taylor = struct open Informal_interval;; open Informal_float;; open Informal_atn;; open Informal_eval_interval;; type m_cell_domain = { lo : ifloat list; hi : ifloat list; y : ifloat list; w : ifloat list; };; type m_taylor_interval = { n : int; domain : m_cell_domain; f : interval; df : interval list; ddf : interval list list; };; let float_0 = mk_small_num_float 0 and float_1 = mk_small_num_float 1 and float_2 = mk_small_num_float 2;; let float_inv2 = div_float_lo 1 float_1 float_2;; (* convert_to_float_list *) let convert_to_float_list pp lo_flag list_tm = let tms = dest_list list_tm in let i_funs = map build_interval_fun tms in let ints = map (fun f -> eval_interval_fun pp f [] []) i_funs in let extract = (if lo_flag then fst else snd) o dest_interval in map extract ints;; (* mk_m_center_domain *) let mk_m_center_domain pp x_list z_list = let y_list = let ( * ), (+) = mul_float_eq, add_float_hi pp in map2 (fun x z -> if eq_float x z then x else float_inv2 * (x + z)) x_list z_list in (* test: x <= y <= z *) let flag1 = itlist2 (fun x y a -> le_float x y && a) x_list y_list true and flag2 = itlist2 (fun y z a -> le_float y z && a) y_list z_list true in if not flag1 or not flag2 then failwith "mk_m_center_domain: ~(x <= y <= z)" else let w_list = let (-) = sub_float_hi pp in let w1 = map2 (-) y_list x_list in let w2 = map2 (-) z_list y_list in map2 max_float w1 w2 in {lo = x_list; hi = z_list; y = y_list; w = w_list};; (* eval_m_taylor (pp0 for initial evaluation of constants) *) let eval_m_taylor pp0 f_tm partials partials2 = let build = eval_constants pp0 o build_interval_fun o snd o dest_abs in let f = build f_tm in let n = length partials in (* Verify that the list of second partial derivatives is correct *) let _ = map2 (fun i list -> if length list <> i then failwith "eval_m_taylor: incorrect partials2" else ()) (1--n) partials2 in let dfs = map (build o rand o concl) partials in let d2fs = map (build o rand o concl) (List.flatten partials2) in let f_dfs_list = find_and_replace_all (f :: dfs) [] in let rec shape_list dd i = if i >= n then [dd] else let l1, l2 = chop_list i dd in l1 :: shape_list l2 (i + 1) in let d2fs_list = find_and_replace_all d2fs [] in fun p_lin p_second domain -> let y_ints = map (fun y -> mk_interval (y, y)) domain.y in let xz_ints = map mk_interval (zip domain.lo domain.hi) in let f_dfs_vals = eval_interval_fun_list p_lin f_dfs_list y_ints in let d2fs_vals = eval_interval_fun_list p_second d2fs_list xz_ints in {n = n; domain = domain; f = hd f_dfs_vals; df = tl f_dfs_vals; ddf = shape_list d2fs_vals 1};; (* mk_eval_functionq *) let mk_eval_function pp0 f_tm = let build = eval_constants pp0 o build_interval_fun o snd o dest_abs in let f = build f_tm in let f_list = find_and_replace_all [f] [] in fun pp x_list z_list -> let xz_ints = map mk_interval (zip x_list z_list) in let f_val = eval_interval_fun_list pp f_list xz_ints in hd f_val;; (* error_mul_f2_hi *) let error_mul_f2_hi pp a int = mul_float_hi pp a (abs_interval int);; (* eval_m_taylor_error *) (* sum_{i = 1}^n (w_i * (f_ii * w_i + 2 * sum_{j = 1}^{i - 1} w_j * f_ij)) *) let eval_m_taylor_error pp ti = let w = ti.domain.w in let ns = 1--ti.n in let ( * ), ( + ) = mul_float_hi pp, add_float_hi pp in let mul_wdd = map2 (fun list i -> Arith_misc.my_map2 (error_mul_f2_hi pp) w list) ti.ddf ns in let sums1 = map (end_itlist ( + ) o butlast) (tl mul_wdd) in let sums2 = (hd o hd) mul_wdd :: map2 (fun list t1 -> last list + float_2 * t1) (tl mul_wdd) sums1 in let sums = map2 ( * ) w sums2 in end_itlist ( + ) sums;; (* eval_m_taylor_upper_bound *) let eval_m_taylor_upper_bound pp ti = let f_hi = (snd o dest_interval) ti.f in let error = eval_m_taylor_error pp ti in let ( * ), ( + ) = mul_float_hi pp, add_float_hi pp in let sum2 = let mul_wd = map2 (error_mul_f2_hi pp) ti.domain.w ti.df in end_itlist ( + ) mul_wd in let a = sum2 + float_inv2 * error in f_hi + a;; (* eval_m_taylor_lower_bound *) let eval_m_taylor_lower_bound pp ti = let f_lo = (fst o dest_interval) ti.f in let error = eval_m_taylor_error pp ti in let ( * ), ( + ), ( - ) = mul_float_hi pp, add_float_hi pp, sub_float_lo pp in let sum2 = let mul_wd = map2 (error_mul_f2_hi pp) ti.domain.w ti.df in end_itlist ( + ) mul_wd in let a = sum2 + float_inv2 * error in f_lo - a;; (* eval_m_taylor_bound *) let eval_m_taylor_bound pp ti = let f_lo, f_hi = dest_interval ti.f in let error = eval_m_taylor_error pp ti in let ( * ), ( + ), ( - ) = mul_float_hi pp, add_float_hi pp, sub_float_lo pp in let sum2 = let mul_wd = map2 (error_mul_f2_hi pp) ti.domain.w ti.df in end_itlist ( + ) mul_wd in let a = sum2 + float_inv2 * error in let hi = f_hi + a in let lo = f_lo - a in mk_interval (lo, hi);; (* eval_m_taylor_partial_upper *) let eval_m_taylor_partial_upper pp i ti = let df_hi = (snd o dest_interval o List.nth ti.df) (i - 1) in let dd_list = map (fun j -> if j <= i then List.nth (List.nth ti.ddf (i - 1)) (j - 1) else List.nth (List.nth ti.ddf (j - 1)) (i - 1)) (1--ti.n) in let sum2 = let mul_dd = map2 (error_mul_f2_hi pp) ti.domain.w dd_list in end_itlist (add_float_hi pp) mul_dd in add_float_hi pp df_hi sum2;; (* eval_m_taylor_partial_lower *) let eval_m_taylor_partial_lower pp i ti = let df_lo = (fst o dest_interval o List.nth ti.df) (i - 1) in let dd_list = map (fun j -> if j <= i then List.nth (List.nth ti.ddf (i - 1)) (j - 1) else List.nth (List.nth ti.ddf (j - 1)) (i - 1)) (1--ti.n) in let sum2 = let mul_dd = map2 (error_mul_f2_hi pp) ti.domain.w dd_list in end_itlist (add_float_hi pp) mul_dd in sub_float_lo pp df_lo sum2;; (* eval_m_taylor_partial_bound *) let eval_m_taylor_partial_bound pp i ti = let df_lo, df_hi = (dest_interval o List.nth ti.df) (i - 1) in let dd_list = map (fun j -> if j <= i then List.nth (List.nth ti.ddf (i - 1)) (j - 1) else List.nth (List.nth ti.ddf (j - 1)) (i - 1)) (1--ti.n) in let sum2 = let mul_dd = map2 (error_mul_f2_hi pp) ti.domain.w dd_list in end_itlist (add_float_hi pp) mul_dd in let lo = sub_float_lo pp df_lo sum2 in let hi = add_float_hi pp df_hi sum2 in mk_interval (lo, hi);; (* add *) let eval_m_taylor_add p_lin p_second taylor1 taylor2 = let ( + ), ( ++ ) = add_interval p_lin, add_interval p_second in { n = taylor1.n; domain = taylor1.domain; f = taylor1.f + taylor2.f; df = map2 (+) taylor1.df taylor2.df; ddf = map2 (map2 (++)) taylor1.ddf taylor2.ddf };; (* sub *) let eval_m_taylor_sub p_lin p_second taylor1 taylor2 = let ( - ), ( -- ) = sub_interval p_lin, sub_interval p_second in { n = taylor1.n; domain = taylor1.domain; f = taylor1.f - taylor2.f; df = map2 (-) taylor1.df taylor2.df; ddf = map2 (map2 (--)) taylor1.ddf taylor2.ddf };; (* mul *) let eval_m_taylor_mul p_lin p_second ti1 ti2 = let n = ti1.n in let ns = 1--n in let bounds = mul_interval p_lin ti1.f ti2.f in let df = map2 (fun d1 d2 -> let ( * ), ( + ) = mul_interval p_lin, add_interval p_lin in d1 * ti2.f + ti1.f * d2) ti1.df ti2.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti1) ns in let d2_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti2) ns in let f1_bound = eval_m_taylor_bound p_second ti1 in let f2_bound = eval_m_taylor_bound p_second ti2 in let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun (list1, list2) i -> let di1 = List.nth d1_bounds (i - 1) in let di2 = List.nth d2_bounds (i - 1) in map2 (fun (dd1, dd2) j -> let dj1 = List.nth d1_bounds (j - 1) in let dj2 = List.nth d2_bounds (j - 1) in (dd1 * f2_bound + di1 * dj2) + (dj1 * di2 + f1_bound * dd2)) (zip list1 list2) (1--i)) (zip ti1.ddf ti2.ddf) ns in { n = n; domain = ti1.domain; f = bounds; df = df; ddf = ddf; };; (* neg *) let eval_m_taylor_neg taylor1 = let neg = neg_interval in { n = taylor1.n; domain = taylor1.domain; f = neg taylor1.f; df = map neg taylor1.df; ddf = map (map neg) taylor1.ddf; };; (* inv *) let eval_m_taylor_inv p_lin p_second ti = let n = ti.n in let ns = 1--n in let f1_bound = eval_m_taylor_bound p_second ti in let bounds = inv_interval p_lin ti.f in let u_bounds = let neg, inv, ( * ) = neg_interval, inv_interval p_lin, mul_interval p_lin in neg (inv (ti.f * ti.f)) in let df = let ( * ) = mul_interval p_lin in map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in let d1, d2 = let inv, ( * ) = inv_interval p_second, mul_interval p_second in let ff = f1_bound * f1_bound in inv ff, two_interval * inv (f1_bound * ff) in let ddf = let ( * ), ( - ) = mul_interval p_second, sub_interval p_second in map2 (fun dd_list di1 -> Arith_misc.my_map2 (fun dd dj1 -> (d2 * dj1) * di1 - d1 * dd) dd_list d1_bounds) ti.ddf d1_bounds in { n = n; domain = ti.domain; f = bounds; df = df; ddf = ddf; };; (* sqrt *) let eval_m_taylor_sqrt p_lin p_second ti = let n = ti.n in let ns = 1--n in let f1_bound = eval_m_taylor_bound p_second ti in let bounds = sqrt_interval p_lin ti.f in let u_bounds = let inv, ( * ) = inv_interval p_lin, mul_interval p_lin in inv (two_interval * bounds) in let df = let ( * ) = mul_interval p_lin in map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in let d1, d2 = let neg, sqrt, inv, ( * ) = neg_interval, sqrt_interval p_second, inv_interval p_second, mul_interval p_second in let two_sqrt_f = two_interval * sqrt f1_bound in inv two_sqrt_f, neg (inv (two_sqrt_f * (two_interval * f1_bound))) in let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> Arith_misc.my_map2 (fun dd dj1 -> (d2 * dj1) * di1 + d1 * dd) dd_list d1_bounds) ti.ddf d1_bounds in { n = n; domain = ti.domain; f = bounds; df = df; ddf = ddf; };; (* atn *) let eval_m_taylor_atn = let neg_two_interval = neg_interval two_interval in fun p_lin p_second ti -> let n = ti.n in let ns = 1--n in let f1_bound = eval_m_taylor_bound p_second ti in let bounds = atn_interval p_lin ti.f in let u_bounds = let inv, ( + ), ( * ) = inv_interval p_lin, add_interval p_lin, mul_interval p_lin in inv (one_interval + ti.f * ti.f) in let df = let ( * ) = mul_interval p_lin in map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in let d1, d2 = let neg, inv, ( + ), ( * ) = neg_interval, inv_interval p_second, add_interval p_second, mul_interval p_second in let pow2 = pow_interval p_second 2 in let inv_one_ff = inv (one_interval + f1_bound * f1_bound) in inv_one_ff, (neg_two_interval * f1_bound) * pow2 inv_one_ff in let ddf = let ( * ), ( + ) = mul_interval p_second, add_interval p_second in map2 (fun dd_list di1 -> Arith_misc.my_map2 (fun dd dj1 -> (d2 * dj1) * di1 + d1 * dd) dd_list d1_bounds) ti.ddf d1_bounds in { n = n; domain = ti.domain; f = bounds; df = df; ddf = ddf; };; (* acs *) let eval_m_taylor_acs p_lin p_second ti = let n = ti.n in let ns = 1--n in let f1_bound = eval_m_taylor_bound p_second ti in let bounds = acs_interval p_lin ti.f in let u_bounds = let inv, sqrt, neg = inv_interval p_lin, sqrt_interval p_lin, neg_interval in let ( * ), ( - ) = mul_interval p_lin, sub_interval p_lin in neg (inv (sqrt (one_interval - ti.f * ti.f))) in let df = let ( * ) = mul_interval p_lin in map (fun d -> u_bounds * d) ti.df in let d1_bounds = map (fun i -> eval_m_taylor_partial_bound p_second i ti) ns in let d1, d2 = let neg, sqrt, inv = neg_interval, sqrt_interval p_second, inv_interval p_second in let ( - ), ( * ), ( / ) = sub_interval p_second, mul_interval p_second, div_interval p_second in let pow3 = pow_interval p_second 3 in let ff_1 = one_interval - f1_bound * f1_bound in inv (sqrt ff_1), neg (f1_bound / sqrt (pow3 ff_1)) in let ddf = let ( * ), ( - ) = mul_interval p_second, sub_interval p_second in map2 (fun dd_list di1 -> Arith_misc.my_map2 (fun dd dj1 -> (d2 * dj1) * di1 - d1 * dd) dd_list d1_bounds) ti.ddf d1_bounds in { n = n; domain = ti.domain; f = bounds; df = df; ddf = ddf; };; end;; hol-light/Formal_ineqs/informal/informal_m_verifier.hl000066400000000000000000000254161303454263000235460ustar00rootroot00000000000000(* =========================================================== *) (* Informal verification procedures *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Dependencies *) needs "informal/informal_m_taylor.hl";; needs "verifier/interval_m/recurse.ml";; needs "verifier_options.hl";; module Informal_verifier = struct open Informal_float;; open Informal_interval;; open Informal_taylor;; open Recurse;; open Verifier_options;; type verification_funs = { (* p_lin -> p_second -> dom -> ti *) taylor : int -> int -> m_cell_domain -> m_taylor_interval; (* pp -> xx -> zz -> interval *) f : int -> ifloat list -> ifloat list -> interval; (* j -> pp -> xx -> zz -> interval *) df : int -> int -> ifloat list -> ifloat list -> interval; (* i j -> pp -> xx -> zz -> interval *) ddf : int -> int -> int -> ifloat list -> ifloat list -> interval; };; (* m_subset_interval *) let m_subset_interval a b c d = let prove_le l1 l2 = itlist2 (fun x y r -> le_float x y && r) l1 l2 true in prove_le a c && prove_le d b;; (* m_taylor_cell_pass *) let m_taylor_cell_pass pp ti = let upper = eval_m_taylor_upper_bound pp ti in lt0_float upper;; (* m_taylor_cell_pass0 *) let m_taylor_cell_pass0 int = (lt0_float o snd o dest_interval) int;; (* m_cell_pass_subdomain *) let m_cell_pass_subdomain domain2 pass_domain = let a, b = pass_domain.lo, pass_domain. hi in let c, d = domain2.lo, domain2.hi in m_subset_interval a b c d;; (* m_incr_pass *) let m_incr_pass pp j ti = let partial_bound = eval_m_taylor_partial_lower pp j ti in ge0_float partial_bound;; (* m_decr_pass *) let m_decr_pass pp j ti = let partial_bound = eval_m_taylor_partial_upper pp j ti in le0_float partial_bound;; (* m_mono_pass_gen *) let m_mono_pass_gen decr_flag bound = (if decr_flag then le0_float else ge0_float) bound;; (* m_convex_pass *) let m_convex_pass int = (ge0_float o fst o dest_interval) int;; (* mk_verification_functions *) let mk_verification_functions_poly pp0 f partials partials2 = let n = length partials in let taylor = eval_m_taylor pp0 f partials partials2 in let eval0 = mk_eval_function pp0 f in let eval1 = map (fun i -> mk_eval_function pp0 ((rand o concl o List.nth partials) (i - 1))) (1--n) in let eval2 = map (fun i -> map (fun j -> let d2 = List.nth (List.nth partials2 (i - 1)) (j - 1) in mk_eval_function pp0 ((rand o concl) d2)) (1--i)) (1--n) in { taylor = taylor; f = eval0; df = (fun i -> List.nth eval1 (i - 1)); ddf = (fun i j -> List.nth (List.nth eval2 (j - 1)) (i - 1)); };; (* split_domain *) let split_domain pp j domain = let n = length domain.w in let t = List.nth domain.y (j - 1) in let vv = map (fun i -> if i = j then t else List.nth domain.hi (i - 1)) (1--n) in let uu = map (fun i -> if i = j then t else List.nth domain.lo (i - 1)) (1--n) in mk_m_center_domain pp domain.lo vv, mk_m_center_domain pp uu domain.hi;; (* restrict_domain *) let restrict_domain j left_flag domain = let replace list j v = map (fun i -> if i = j then v else List.nth list (i - 1)) (1--length list) in let t = List.nth (if left_flag then domain.lo else domain.hi) (j - 1) in let lo = if left_flag then domain.lo else replace domain.lo j t in let hi = if left_flag then replace domain.hi j t else domain.hi in let w = replace domain.w j float_0 in let y = replace domain.y j t in {lo = lo; hi = hi; w = w; y = y};; (*****************************) (* m_verify_raw *) (* Constructs a p_result_tree from the given result_tree *) let m_verify_raw (report_start, total_size) p_split p_min p_max fs certificate domain0 ref_list = let r_size = result_size certificate in let r_size2 = float_of_int (if total_size > 0 then total_size else (if r_size > 0 then r_size else 1)) in let k = ref 0 in let kk = ref report_start in let last_report = ref (int_of_float (float_of_int !kk /. r_size2 *. 100.0)) in let ps = p_min -- p_max in (* finds an optimal precision value *) let rec find_p p_fun p_list = match p_list with | [] -> failwith "find_p: no good p found" | p :: ps -> let flag = (try p_fun p with Failure _ -> false | Division_by_zero -> false) in if flag then let _ = if !info_print_level >= 2 then report (sprintf "p = %d" p) else () in p else find_p p_fun ps in (* pass_test *) let pass_test domain f0_flag pp = if f0_flag then m_taylor_cell_pass0 (fs.f pp domain.lo domain.hi) else m_taylor_cell_pass pp (fs.taylor pp pp domain) in (* glue_test *) let glue_test domain i convex_flag pp = if convex_flag then m_convex_pass (fs.ddf (i + 1) (i + 1) pp domain.lo domain.hi) else true in (* mono_test *) let mono_test mono domain domains pp = let xx, zz = domain.lo, domain.hi in let taylor = fs.taylor pp pp domain in let gen_mono m = if m.df0_flag then if m.decr_flag then (snd o dest_interval) (fs.df m.variable pp xx zz) else (fst o dest_interval) (fs.df m.variable pp xx zz) else if m.decr_flag then eval_m_taylor_partial_upper pp m.variable taylor else eval_m_taylor_partial_lower pp m.variable taylor in let monos = map gen_mono mono in rev_itlist (fun (m, bound) pass -> let flag = m.decr_flag in m_mono_pass_gen flag bound && pass) (rev (zip mono monos)) true in (* mk_domains *) let rec mk_domains mono dom0 acc = match mono with | [] -> rev acc | m :: ms -> let j, flag = m.variable, m.decr_flag in let dom = restrict_domain j flag dom0 in mk_domains ms dom (dom :: acc) in (* rec_verify *) let rec rec_verify domain certificate = match certificate with | Result_mono (mono, r1) -> let _ = if !info_print_level >= 2 then let mono_strs = map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") m.variable m.df0_flag) mono in report (sprintf "Mono: [%s]" (String.concat ";" mono_strs)) else () in let domains = mk_domains mono domain [] in let tree1 = rec_verify (last domains) r1 in (try let pp = find_p (mono_test mono domain domains) ps in P_result_mono ({pp = pp}, mono, tree1) with Failure _ -> failwith "mono: failed") | Result_pass (f0_flag, _, _) -> let _ = k := !k + 1; kk := !kk + 1 in let _ = if !info_print_level >= 2 then report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag) else () in let _ = !info_print_level <> 1 or (let r = int_of_float (float_of_int !kk /. r_size2 *. 100.0) in let _ = if r <> !last_report then (last_report := r; report0 (sprintf "%d " r)) else () in true) in (try let pp = find_p (pass_test domain f0_flag) ps in P_result_pass ({pp = pp}, f0_flag) with Failure _ -> failwith "pass: failed") | Result_glue (i, convex_flag, r1, r2) -> let domain1, domain2 = if convex_flag then let d1 = restrict_domain (i + 1) true domain in let d2 = restrict_domain (i + 1) false domain in d1, d2 else split_domain p_split (i + 1) domain in let tree1 = rec_verify domain1 r1 in let tree2 = rec_verify domain2 r2 in (try let pp = find_p (glue_test domain i convex_flag) ps in P_result_glue ({pp = pp}, i, convex_flag, tree1, tree2) with Failure _ -> failwith "glue: failed") | Result_pass_ref i -> let _ = if !info_print_level >= 2 then report (sprintf "Ref: %d" i) else () in let pass_flag = if i > 0 then let _ = List.nth ref_list (i - 1) in true else let pass_domain = List.nth ref_list (-i - 1) in m_cell_pass_subdomain domain pass_domain in if not pass_flag then failwith "ref: failed" else P_result_ref i | _ -> failwith "False result" in rec_verify domain0 certificate;; (*****************) (* m_verify_raw0 *) let m_verify_raw0 p_split p_min p_max fs certificate xx zz = m_verify_raw (0, 0) p_split p_min p_max fs certificate (mk_m_center_domain p_split xx zz) [];; (* m_verify_list *) let m_verify_list p_split p_min p_max fs certificate_list xx zz = let domain_hash = Hashtbl.create (length certificate_list * 10) in let mem, find, add = Hashtbl.mem domain_hash, Hashtbl.find domain_hash, Hashtbl.add domain_hash in let get_m_cell_domain pp domain0 path = let rec get_rec domain path hash = match path with | [] -> domain | (s, j) :: ps -> let hash' = hash^s^(string_of_int j) in if mem hash' then get_rec (find hash') ps hash' else if s = "l" or s = "r" then let domain1, domain2 = split_domain pp j domain in let hash1 = hash^"l"^(string_of_int j) and hash2 = hash^"r"^(string_of_int j) in let _ = add hash1 domain1; add hash2 domain2 in if s = "l" then get_rec domain1 ps hash' else get_rec domain2 ps hash' else let l_flag = (s = "ml") in let domain' = restrict_domain j l_flag domain in let _ = add hash' domain' in get_rec domain' ps hash' in get_rec domain0 path "" in let domain0 = mk_m_center_domain p_split xx zz in let size = length certificate_list in let k = ref 0 in let kk = ref 0 in let total_size = end_itlist (+) (map (result_size o snd) certificate_list) in let rec rec_verify certificate_list dom_list tree_list = match certificate_list with | [] -> rev tree_list | (path, certificate) :: cs -> let _ = k := !k + 1 in let _ = !info_print_level < 2 or (report (sprintf "List: %d/%d" !k size); true) in let domain = get_m_cell_domain p_split domain0 path in let tree = m_verify_raw (!kk, total_size) p_split p_min p_max fs certificate domain dom_list in let _ = kk := !kk + result_size certificate in rec_verify cs (dom_list @ [domain]) ((path, tree) :: tree_list) in rec_verify certificate_list [] [];; end;; hol-light/Formal_ineqs/jordan/000077500000000000000000000000001303454263000166415ustar00rootroot00000000000000hol-light/Formal_ineqs/jordan/parse_ext_override_interface.hl000066400000000000000000000213571303454263000251070ustar00rootroot00000000000000(* ========================================================================== *) (* FLYSPECK - BOOK FORMALIZATION *) (* *) (* Chapter: Jordan *) (* Copied from HOL Light jordan directory *) (* Author: Thomas C. Hales *) (* Date: 2010-07-08 *) (* ========================================================================== *) module Parse_ext_override_interface = struct (* As a new user of HOL-light, I have had a difficult time distinguishing between the different uses of overloaded operators such as (+), ( * ), (abs) (&), and so forth. Their interpretation is context dependent, according to which of prioritize_num, prioritize_int, and prioritize_real was most recently called. This file removes all ambiguities in notation. Following the usage of CAML, we append a dot to operations on real numbers so that addition is (+.), etc. In the same way, we remove ambiguities between natural numbers and integers by appending a character. We have chosen to use the character `|` for natural number operations and the character `:` for integer operations. The character `&` continues to denote the embedding of natural numbers into the integers or reals. HOL-light parsing does not permit an operator mixing alphanumeric characters with symbols. Thus, we were not able to use (abs.) and (abs:) for the absolute value. Instead we adapt the usual notation |x| for absolute value and write it in prefix notation ||: and ||. for the integer and real absolute value functions respectively. In deference to HOL-light notation, we use ** for the exponential function. There are three versions: ( **| ), ( **: ), and ( **. ). *) (* natural number operations *) let unambiguous_interface() = parse_as_infix("+|",(16,"right")); parse_as_infix("-|",(18,"left")); parse_as_infix("*|",(20,"right")); parse_as_infix("**|",(24,"left")); (* EXP *) parse_as_infix("/|",(22,"right")); (* DIV *) parse_as_infix("%|",(22,"left")); (* MOD *) parse_as_infix("<|",(12,"right")); parse_as_infix("<=|",(12,"right")); parse_as_infix(">|",(12,"right")); parse_as_infix(">=|",(12,"right")); override_interface("+|",`(+):num->(num->num)`); override_interface("-|",`(-):num->(num->num)`); override_interface("*|",`( * ):num->(num->num)`); override_interface("**|",`(EXP):num->(num->num)`); override_interface("/|",`(DIV):num->(num->num)`); override_interface("%|",`(MOD):num->(num->num)`); override_interface("<|",`(<):num->(num->bool)`); override_interface("<=|",`(<=):num->(num->bool)`); override_interface(">|",`(>):num->(num->bool)`); override_interface(">=|",`(>=):num->(num->bool)`); (* integer operations *) parse_as_infix("+:",(16,"right")); parse_as_infix("-:",(18,"left")); parse_as_infix("*:",(20,"right")); parse_as_infix("**:",(24,"left")); parse_as_infix("<:",(12,"right")); parse_as_infix("<=:",(12,"right")); parse_as_infix(">:",(12,"right")); parse_as_infix(">=:",(12,"right")); override_interface("+:",`int_add:int->int->int`); override_interface("-:",`int_sub:int->int->int`); override_interface("*:",`int_mul:int->int->int`); override_interface("**:",`int_pow:int->num->int`); (* boolean *) override_interface("<:",`int_lt:int->int->bool`); override_interface("<=:",`int_le:int->int->bool`); override_interface(">:",`int_gt:int->int->bool`); override_interface(">=:",`int_ge:int->int->bool`); (* unary *) override_interface("--:",`int_neg:int->int`); override_interface("&:",`int_of_num:num->int`); override_interface("||:",`int_abs:int->int`); (* real number operations *) parse_as_infix("+.",(16,"right")); parse_as_infix("-.",(18,"left")); parse_as_infix("*.",(20,"right")); parse_as_infix("**.",(24,"left")); parse_as_infix("<.",(12,"right")); parse_as_infix("<=.",(12,"right")); parse_as_infix(">.",(12,"right")); parse_as_infix(">=.",(12,"right")); override_interface("+.",`real_add:real->real->real`); override_interface("-.",`real_sub:real->real->real`); override_interface("*.",`real_mul:real->real->real`); override_interface("**.",`real_pow:real->num->real`); (* boolean *) override_interface("<.",`real_lt:real->real->bool`); override_interface("<=.",`real_le:real->real->bool`); override_interface(">.",`real_gt:real->real->bool`); override_interface(">=.",`real_ge:real->real->bool`); (* unary *) override_interface("--.",`real_neg:real->real`); override_interface("&.",`real_of_num:num->real`); override_interface("||.",`real_abs:real->real`);; let ambiguous_interface() = reduce_interface("+|",`(+):num->(num->num)`); reduce_interface("-|",`(-):num->(num->num)`); reduce_interface("*|",`( * ):num->(num->num)`); reduce_interface("**|",`(EXP):num->(num->num)`); reduce_interface("/|",`(DIV):num->(num->num)`); reduce_interface("%|",`(MOD):num->(num->num)`); reduce_interface("<|",`(<):num->(num->bool)`); reduce_interface("<=|",`(<=):num->(num->bool)`); reduce_interface(">|",`(>):num->(num->bool)`); reduce_interface(">=|",`(>=):num->(num->bool)`); (* integer operations *) reduce_interface("+:",`int_add:int->int->int`); reduce_interface("-:",`int_sub:int->int->int`); reduce_interface("*:",`int_mul:int->int->int`); reduce_interface("**:",`int_pow:int->num->int`); (* boolean *) reduce_interface("<:",`int_lt:int->int->bool`); reduce_interface("<=:",`int_le:int->int->bool`); reduce_interface(">:",`int_gt:int->int->bool`); reduce_interface(">=:",`int_ge:int->int->bool`); (* unary *) reduce_interface("--:",`int_neg:int->int`); reduce_interface("&:",`int_of_num:num->int`); reduce_interface("||:",`int_abs:int->int`); (* real *) reduce_interface("+.",`real_add:real->real->real`); reduce_interface("-.",`real_sub:real->real->real`); reduce_interface("*.",`real_mul:real->real->real`); reduce_interface("**.",`real_pow:real->num->real`); (* boolean *) reduce_interface("<.",`real_lt:real->real->bool`); reduce_interface("<=.",`real_le:real->real->bool`); reduce_interface(">.",`real_gt:real->real->bool`); reduce_interface(">=.",`real_ge:real->real->bool`); (* unary *) reduce_interface("--.",`real_neg:real->real`); reduce_interface("&.",`real_of_num:num->real`); reduce_interface("||.",`real_abs:real->real`);; (* add to Harrison's priorities the functions pop_priority and get_priority *) let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = let v = ref ([]:string list) in let prioritize_int() = v:= "int"::!v; overload_interface ("+",`int_add:int->int->int`); overload_interface ("-",`int_sub:int->int->int`); overload_interface ("*",`int_mul:int->int->int`); overload_interface ("<",`int_lt:int->int->bool`); overload_interface ("<=",`int_le:int->int->bool`); overload_interface (">",`int_gt:int->int->bool`); overload_interface (">=",`int_ge:int->int->bool`); overload_interface ("--",`int_neg:int->int`); overload_interface ("pow",`int_pow:int->num->int`); overload_interface ("abs",`int_abs:int->int`); override_interface ("&",`int_of_num:num->int`) and prioritize_num() = v:= "num"::!v; overload_interface ("+",`(+):num->num->num`); overload_interface ("-",`(-):num->num->num`); overload_interface ("*",`(*):num->num->num`); overload_interface ("<",`(<):num->num->bool`); overload_interface ("<=",`(<=):num->num->bool`); overload_interface (">",`(>):num->num->bool`); overload_interface (">=",`(>=):num->num->bool`) and prioritize_real() = v:= "real"::!v; overload_interface ("+",`real_add:real->real->real`); overload_interface ("-",`real_sub:real->real->real`); overload_interface ("*",`real_mul:real->real->real`); overload_interface ("/",`real_div:real->real->real`); overload_interface ("<",`real_lt:real->real->bool`); overload_interface ("<=",`real_le:real->real->bool`); overload_interface (">",`real_gt:real->real->bool`); overload_interface (">=",`real_ge:real->real->bool`); overload_interface ("--",`real_neg:real->real`); overload_interface ("pow",`real_pow:real->num->real`); overload_interface ("inv",`real_inv:real->real`); overload_interface ("abs",`real_abs:real->real`); override_interface ("&",`real_of_num:num->real`) and pop_priority() = if (length !v <= 1) then (print_string "priority unchanged\n") else let (a::b::c) = !v in v:= (b::c); print_string ("priority is now "^b^"\n"); match a with "num" -> prioritize_num() | "int" -> prioritize_int() | "real"-> prioritize_real()| _ -> () and get_priority() = if (!v=[]) then "unknown" else let (a::b) = !v in a in prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority;; end;; hol-light/Formal_ineqs/jordan/real_ext.hl000066400000000000000000000320331303454263000207720ustar00rootroot00000000000000(* ========================================================================== *) (* FLYSPECK - BOOK FORMALIZATION *) (* *) (* Chapter: Jordan *) (* Copied from HOL Light jordan directory *) (* Author: Thomas C. Hales *) (* Date: 2010-07-08 *) (* ========================================================================== *) module Real_ext = struct open Parse_ext_override_interface;; (* open Tactics_jordan;; *) (* ------------------------------------------------------------------ *) (* Theorems that construct and propagate equality and inequality *) (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) (* Propagation of =EQUAL= *) (* ------------------------------------------------------------------ *) unambiguous_interface();; prioritize_num();; let REAL_LE = REAL_OF_NUM_LE;; let pow = real_pow;; let REAL_INV2 = prove( `(inv(&. 2)*(&. 2) = (&.1)) /\ ((&. 2)*inv(&. 2) = (&.1))`, SUBGOAL_THEN `~((&.2) = (&.0))` MP_TAC THENL[ REAL_ARITH_TAC; SIMP_TAC[REAL_MUL_RINV;REAL_MUL_LINV]]);; let REAL_MUL_LTIMES = prove (`!x a b. (x*.a = x*.b) ==> (~(x=(&.0))) ==> (a =b)`, MESON_TAC[REAL_EQ_MUL_LCANCEL]);; let REAL_MUL_RTIMES = prove (`!x a b. (a*.x = b*.x) ==> (~(x=(&.0))) ==> (a =b)`, MESON_TAC[REAL_EQ_MUL_RCANCEL]);; let REAL_PROP_EQ_LMUL = REAL_MUL_LTIMES;; let REAL_PROP_EQ_RMUL = REAL_MUL_RTIMES;; let REAL_PROP_EQ_LMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * y = x * z) = (x = &0) \/ (y = z) *);; let REAL_PROP_EQ_RMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * z = y * z) = (x = y) \/ (z = &0) *);; (* see also minor variations REAL_LT_LMUL_EQ, REAL_LT_RMUL_EQ *) let REAL_PROP_EQ_SQRT = SQRT_INJ_COMPAT;; (* |- !x y. &0 <= x /\ &0 <= y ==> ((sqrt x = sqrt y) = x = y) *) (* ------------------------------------------------------------------ *) (* Construction of <=. *) (* ------------------------------------------------------------------ *) let REAL_MK_LE_SQUARE = REAL_LE_POW_2 ;; (* |- !x. &0 <= x pow 2 *) (* ------------------------------------------------------------------ *) (* Propagation of <=. *) (* ------------------------------------------------------------------ *) let REAL_MUL_LTIMES_LE = prove (`!x a b. (x*.a <=. x*.b) ==> (&.0 < x) ==> (a <=. b)`, MESON_TAC[REAL_LE_LMUL_EQ]);; (* virtually identical to REAL_LE_LCANCEL_IMP, REAL_LE_LMUL_EQ *) let REAL_MUL_RTIMES_LE = prove (`!x a b. (a*.x <=. b*.x) ==> (&.0 < x) ==> (a <=. b)`, MESON_TAC[REAL_LE_RMUL_EQ]);; (* virtually identical to REAL_LE_RCANCEL_IMP, REAL_LE_RMUL_EQ *) let REAL_PROP_LE_LCANCEL = REAL_MUL_LTIMES_LE;; let REAL_PROP_LE_RCANCEL = REAL_MUL_RTIMES_LE;; let REAL_PROP_LE_LMUL = REAL_LE_LMUL (* |- !x y z. &0 <= x /\ y <= z ==> x * y <= x * z *);; let REAL_PROP_LE_RMUL = REAL_LE_RMUL (* |- !x y z. x <= y /\ &0 <= z ==> x * z <= y * z *);; let REAL_PROP_LE_LRMUL = REAL_LE_MUL2;; (* |- !w x y z. &0 <= w /\ w <= x /\ &0 <= y /\ y <= z ==> w * y <= x * z *) let REAL_PROP_LE_POW = REAL_POW_LE2;; (* 2010-07-08 thales: POW_LE;; *) (* |- !n x y. &0 <= x /\ x <= y ==> x pow n <= y pow n *) let REAL_PROP_LE_SQRT = SQRT_MONO_LE_EQ_COMPAT;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x <= sqrt y = x <= y) *) (* ------------------------------------------------------------------ *) (* Construction of LT *) (* ------------------------------------------------------------------ *) let REAL_MK_LT_SQUARE = REAL_LT_SQUARE;; (* |- !x. &0 < x * x = ~(x = &0) *) (* ------------------------------------------------------------------ *) (* Propagation of LT *) (* ------------------------------------------------------------------ *) let REAL_PROP_LT_LCANCEL = REAL_LT_LCANCEL_IMP (* |- !x y z. &0 < x /\ x * y < x * z ==> y < z *);; let REAL_PROP_LT_RCANCEL = REAL_LT_RCANCEL_IMP (* |- !x y z. &0 < z /\ x * z < y * z ==> x < y *);; let REAL_PROP_LT_LMUL = REAL_LT_LMUL (* |- !x y z. &0 < x /\ y < z ==> x * y < x * z *);; let REAL_PROP_LT_RMUL = REAL_LT_RMUL (* |- !x y z. x < y /\ &0 < z ==> x * z < y * z *);; (* minor variation REAL_LT_LMUL_IMP, REAL_LT_RMUL_IMP *) let REAL_PROP_LT_LRMUL= REAL_LT_MUL2;; (* |- !w x y z. &0 <= w /\ w < x /\ &0 <= y /\ y < z ==> w * y < x * z *) let REAL_PROP_LT_SQRT = SQRT_MONO_LT_EQ_COMPAT;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x < sqrt y = x < y) *) (* ------------------------------------------------------------------ *) (* Constructors of Non-negative *) (* ------------------------------------------------------------------ *) let REAL_MK_NN_SQUARE = REAL_LE_SQUARE;; (* |- !x. &0 <= x * x *) let REAL_MK_NN_ABS = REAL_ABS_POS;; (* 2010 *) (* |- !x. &0 <= abs x *) (* moved here from float.hl *) (* from 778 *) let REAL_LE_LMUL_LOCAL = prove( `!x y z. &0 < x ==> ((x * y) <= (x * z) <=> y <= z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_LT_LMUL_EQ THEN ASM_REWRITE_TAC[]);; let ABS_TRIANGLE = prove( `!x y. abs(x + y) <= abs(x) + abs(y)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_NEG_ADD; REAL_LE_REFL; REAL_LE_LADD; REAL_LE_RADD] THEN ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_LE_NEGL; REAL_LE_NEGR] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN TRY(UNDISCH_TAC `(x + y) < &0`) THEN SUBST1_TAC(SYM(SPEC `&0` REAL_ADD_LID)) THEN REWRITE_TAC[REAL_NOT_LT] THEN MAP_FIRST MATCH_MP_TAC [REAL_LT_ADD2; REAL_LE_ADD2] THEN ASM_REWRITE_TAC[]);; let REAL_LE_LMUL_IMP = prove( `!x y z. &0 <= x /\ y <= z ==> (x * y) <= (x * z)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]); FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_ACCEPT_TAC REAL_LE_REFL]);; (* from ? *) let ABS_POS = prove( `!x. &0 <= abs(x)`, GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL [ALL_TAC; MP_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN ASM_REWRITE_TAC[real_abs]);; let REAL_PROP_LE_LABS = prove( `!x y z. (y <=. z) ==> ((abs x)* y <=. (abs x) *z)`,(SIMP_TAC[REAL_LE_LMUL_IMP;ABS_POS]));; let REAL_LE_RMUL_IMP = prove( `!x y z. &0 <= x /\ y <= z ==> (y * x) <= (z * x)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LE_LMUL_IMP);; (* ------------------------------------------------------------------ *) (* Propagation of Non-negative *) (* ------------------------------------------------------------------ *) let REAL_PROP_NN_POS = prove(`! x y. x<. y ==> x <= y`,MESON_TAC[REAL_LT_LE]);; let REAL_PROP_NN_ADD2 = REAL_LE_ADD (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x + y *);; let REAL_PROP_NN_DOUBLE = REAL_LE_DOUBLE (* |- !x. &0 <= x + x <=> &0 <= x *);; let REAL_PROP_NN_RCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. y*.x ==> ((&.0) <=. y)`, MESON_TAC[REAL_PROP_LE_RCANCEL;REAL_MUL_LZERO]);; let REAL_PROP_NN_LCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. x*.y ==> ((&.0) <=. y)`, MESON_TAC[REAL_PROP_LE_LCANCEL;REAL_MUL_RZERO]);; let REAL_PROP_NN_MUL2 = REAL_LE_MUL (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x * y *);; let REAL_PROP_NN_POW = REAL_POW_LE (* |- !x n. &0 <= x ==> &0 <= x pow n *);; let REAL_PROP_NN_SQUARE = REAL_LE_POW_2;; (* |- !x. &0 <= x pow 2 *) let REAL_PROP_NN_SQRT = SQRT_POS_LE;; (* |- !x. &0 <= x ==> &0 <= sqrt x *) let REAL_PROP_NN_INV = REAL_LE_INV_EQ (* |- !x. &0 <= inv x = &0 <= x *);; let REAL_PROP_NN_SIN = SIN_POS_PI_LE;; (* |- !x. &0 <= x /\ x <= pi ==> &0 <= sin x *) let REAL_PROP_NN_ATN = ATN_POS_LE;; (* |- &0 <= atn x = &0 <= x *) (* ------------------------------------------------------------------ *) (* Constructor of POS *) (* ------------------------------------------------------------------ *) let REAL_MK_POS_ABS = REAL_ABS_NZ (* |- !x. ~(x = &0) = &0 < abs x *);; let REAL_MK_POS_EXP = REAL_EXP_POS_LT;; (* |- !x. &0 < exp x *) (* let REAL_MK_POS_LN = LN_POS_LT;; (* |- !x. &1 < x ==> &0 < ln x *) *) let REAL_MK_POS_PI = PI_POS;; (* |- &0 < pi *) (* ------------------------------------------------------------------ *) (* Propagation of POS *) (* ------------------------------------------------------------------ *) let REAL_PROP_POS_ADD2 = REAL_LT_ADD (* |- !x y. &0 < x /\ &0 < y ==> &0 < x + y *);; let REAL_PROP_POS_LADD = REAL_LET_ADD (* |- !x y. &0 <= x /\ &0 < y ==> &0 < x + y *);; let REAL_PROP_POS_RADD = REAL_LTE_ADD (* |- !x y. &0 < x /\ &0 <= y ==> &0 < x + y *);; let REAL_PROP_POS_LMUL = REAL_LT_MUL_EQ;; (* REAL_LT_LMUL_0;; *) (* |- !x y. &0 < x ==> (&0 < x * y = &0 < y) *) let REAL_PROP_POS_RMUL = REAL_LT_MUL_EQ;; (* REAL_LT_RMUL_0;; *) (* |- !x y. &0 < y ==> (&0 < x * y = &0 < x) *) let REAL_PROP_POS_MUL2 = REAL_LT_MUL (* |- !x y. &0 < x /\ &0 < y ==> &0 < x * y *);; let REAL_PROP_POS_SQRT = SQRT_POS_LT;; (* |- !x. &0 < x ==> &0 < sqrt x *) let REAL_PROP_POS_POW = REAL_POW_LT (* |- !x n. &0 < x ==> &0 < x pow n *);; let REAL_PROP_POS_INV = REAL_LT_INV (* |- !x. &0 < x ==> &0 < inv x *);; let REAL_PROP_POS_SIN = SIN_POS_PI;; (* |- !x. &0 < x /\ x < pi ==> &0 < sin x *) let REAL_PROP_POS_TAN = TAN_POS_PI2;; (* |- !x. &0 < x /\ x < pi / &2 ==> &0 < tan x *) let REAL_PROP_POS_ATN = ATN_POS_LT;; (* |- &0 < atn x = &0 < x *) (* ------------------------------------------------------------------ *) (* Construction of NZ *) (* ------------------------------------------------------------------ *) (* renamed from REAL_MK_NZ_OF_POS *) let REAL_MK_NZ_POS = REAL_POS_NZ (* |- !x. &0 < x ==> ~(x = &0) *);; let REAL_MK_NZ_EXP = REAL_EXP_NZ;; (* |- !x. ~(exp x = &0) *) (* ------------------------------------------------------------------ *) (* Propagation of NZ *) (* ------------------------------------------------------------------ *) (* renamed from REAL_ABS_NZ, moved from float.ml *) let REAL_PROP_NZ_ABS = prove(`!x. (~(x = (&.0))) ==> (~(abs(x) = (&.0)))`, REWRITE_TAC[REAL_ABS_ZERO]);; let REAL_PROP_NZ_POW = REAL_POW_NZ (* |- !x n. ~(x = &0) ==> ~(x pow n = &0) *);; (* let REAL_PROP_NZ_INV = REAL_INV_NZ;; (* |- !x. ~(x = &0) ==> ~(inv x = &0) *) *) (* ------------------------------------------------------------------ *) (* Propagation of ZERO *) (* ------------------------------------------------------------------ *) let REAL_PROP_ZERO_ABS = REAL_ABS_ZERO (* |- !x. (abs x = &0) = x = &0); *);; (* let REAL_PROP_ZERO_NEG = REAL_NEG_EQ_0 ;; (* |- !x. (--x = &0) = x = &0 *) *) let REAL_PROP_ZERO_INV = REAL_INV_EQ_0 (* |- !x. (inv x = &0) = x = &0 *);; (* let REAL_PROP_ZERO_NEG = REAL_NEG_EQ0;; (* |- !x. (--x = &0) = x = &0 *) *) (* let REAL_PROP_ZERO_SUMSQ = REAL_SUMSQ;; (* |- !x y. (x * x + y * y = &0) = (x = &0) /\ (y = &0) *) *) let REAL_PROP_ZERO_POW = REAL_POW_EQ_0;; (* |- !x n. (x pow n = &0) = (x = &0) /\ ~(n = 0) *) let REAL_PROP_ZERO_SQRT = SQRT_EQ_0_COMPAT;; (* |- !x. &0 <= x ==> (x / sqrt x = sqrt x) *) (* ------------------------------------------------------------------ *) (* Special values of functions *) (* ------------------------------------------------------------------ *) let REAL_SV_LADD_0 = REAL_ADD_LID (* |- !x. &0 + x = x); *);; let REAL_SV_INV_0 = REAL_INV_0 (* |- inv (&0) = &0 *);; let REAL_SV_RMUL_0 = REAL_MUL_RZERO (* |- !x. x * &0 = &0 *);; let REAL_SV_LMUL_0 = REAL_MUL_LZERO (* |- !x. &0 * x = &0 *);; let REAL_SV_NEG_0 = REAL_NEG_0 (* |- -- &0 = &0 *);; let REAL_SV_ABS_0 = REAL_ABS_0 (* |- abs (&0) = &0 *);; let REAL_SV_EXP_0 = REAL_EXP_0;; (* |- exp (&0) = &1 *) (* let REAL_SV_LN_1 = LN_1;; (* |- ln (&1) = &0 *) *) let REAL_SV_SQRT_0 = SQRT_0;; (* |- sqrt (&0) = &0 *) let REAL_SV_TAN_0 = TAN_0;; (* |- tan (&0) = &0 *) let REAL_SV_TAN_PI = TAN_PI;; (* |- tan pi = &0 *) (* ------------------------------------------------------------------ *) (* A tactic that multiplies a real on the left *) (* ------------------------------------------------------------------ *) (** #g `a:real = b:real`;; #e (REAL_LMUL_TAC `c:real`);; it : goalstack = 2 subgoals (2 total) `~(c = &0)` `c * a = c * b` 0 [`~(c = &0)`] # **) (* ------------------------------------------------------------------ *) let REAL_LMUL_TAC t = let REAL_MUL_LTIMES = prove ((`!x a b. (((~(x=(&0)) ==> (x*a = x*b)) /\ ~(x=(&0))) ==> (a = b))`), MESON_TAC[REAL_EQ_MUL_LCANCEL]) in (MATCH_MP_TAC (SPEC t REAL_MUL_LTIMES)) THEN CONJ_TAC THENL [DISCH_TAC; ALL_TAC];; (* ------------------------------------------------------------------ *) (* Right multiply by a real *) (* ------------------------------------------------------------------ *) let REAL_RMUL_TAC t = let REAL_MUL_RTIMES = prove (`!x a b. ((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==> (a = b)`, MESON_TAC[REAL_EQ_MUL_RCANCEL]) in (MATCH_MP_TAC (SPEC t REAL_MUL_RTIMES)) THEN CONJ_TAC THENL [DISCH_TAC; ALL_TAC];; pop_priority();; end;; hol-light/Formal_ineqs/jordan/refinement.hl000066400000000000000000000054571303454263000213350ustar00rootroot00000000000000(* ========================================================================== *) (* FLYSPECK - BOOK FORMALIZATION *) (* *) (* Chapter: Jordan *) (* Copied from HOL Light jordan directory *) (* Author: Thomas C. Hales *) (* Date: 2010-07-08 *) (* ========================================================================== *) module Refinement = struct (* ------------------------------------------------------------------ *) (* This bundles an interactive session into a proof. *) (* Later split off into general/prove_by_refinement *) (* ------------------------------------------------------------------ *) (* let labels_flag = ref false;; (* if true add labels to assumptions *) *) let LABEL_ALL_TAC:tactic = let mk_label avoid = let rec mk_one_label i avoid = let label = "Z-"^(string_of_int i) in if not(mem label avoid) then label else mk_one_label (i+1) avoid in mk_one_label 0 avoid in let update_label i asl = let rec f_at_i f j = function [] -> [] | a::b -> if (j=0) then (f a)::b else a::(f_at_i f (j-1) b) in let avoid = map fst asl in let current = el i avoid in let new_label = mk_label avoid in if (String.length current > 0) then asl else f_at_i (fun (_,y) -> (new_label,y) ) i asl in fun (asl,w) -> let aslp = ref asl in (for i=0 to ((length asl)-1) do (aslp := update_label i !aslp) done; (ALL_TAC (!aslp,w)));; (* global_var *) let enhance flag every tac = if flag then (tac THEN every) THEN LABEL_ALL_TAC else tac;; let (e_enhance :bool ->tactic->tactic ->goalstack) = fun flag every tac -> refine(by(VALID (enhance flag every tac)));; (* let e_bak = e;; let every = ALL_TAC;; let e = e_enhance true every;; *) let has_stv t = let typ = (type_vars_in_term t) in can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;; let enhanced_prove_by_refinement flag every (t,(tacl:tactic list)) = if (length (frees t) > 0) then failwith "prove_by_refinement: free vars" else if (has_stv t) then failwith "prove_by_refinement: has stv" else let gstate = mk_goalstate ([],t) in let _,sgs,just = rev_itlist (fun tac gs -> by (enhance flag every tac) gs) tacl gstate in let th = if sgs = [] then just null_inst [] else failwith "BY_REFINEMENT_PROOF: Unsolved goals" in let t' = concl th in if t' = t then th else try EQ_MP (ALPHA t' t) th with Failure _ -> failwith "prove_by_refinement: generated wrong theorem";; let prove_by_refinement = enhanced_prove_by_refinement false ALL_TAC;; end;; hol-light/Formal_ineqs/jordan/taylor_atn.hl000066400000000000000000000720311303454263000213450ustar00rootroot00000000000000(* ========================================================================== *) (* FLYSPECK - BOOK FORMALIZATION *) (* *) (* Lemma: Taylor Series for atn function *) (* Chapter: Nonlinear Inequalities *) (* Author: Thomas C. Hales *) (* Date: 2010-07-14 *) (* ========================================================================== *) (* This file gives the half-angle identity for atan atn (2 x) = 2 atn (...) It gives a general formula for the nth derivative of catn It gives the complex Taylor polynomial of catn at Cx(&0). It gives the real Taylor polynomial of atn at (&0) *) module Taylor_atn = (* sig val halfatn:thm val halfatn_bounds_abs:thm val halfatn_bounds:thm val halfatn_half :thm val abs_pass_through:thm val atn_abs:thm val atn_half_range:thm end = *) struct let FORCE_EQ = REPEAT (CHANGED_TAC (AP_TERM_TAC ORELSE AP_THM_TAC ORELSE BINOP_TAC)) ;; let FORCE_MATCH = (MATCH_MP_TAC (TAUT `(a = b) ==> (a ==> b)`)) THEN FORCE_EQ ;; let FORCE_MATCH_MP_TAC th = MP_TAC th THEN ANTS_TAC THENL[ALL_TAC;FORCE_MATCH ];; (* first we develop the half-angle identity for the atn function *) let halfatn = new_definition `halfatn x = x / (sqrt(&1 + x pow 2) + &1)`;; let pos1 = prove( `!x. &0 < &1 + x pow 2 `, MESON_TAC[REAL_LE_POW_2;REAL_ARITH `&0 <= t ==> &0 < &1 + t`]; );; let ssqrt = new_definition `!x. ssqrt x = (if x < &0 then &0 else sqrt x)`;; let halfsqrt_ssqrt = prove_by_refinement( `!x. sqrt(&1+ x pow 2) = ssqrt(&1 + x pow 2)`, (* {{{ proof *) [ REWRITE_TAC[ssqrt;]; MESON_TAC[pos1;REAL_ARITH `&0 < x ==> ~(x < &0)`]; ]);; (* }}} *) let pos2 = prove ( `!x. &0 < sqrt(&1 + x pow 2) + &1`, (* {{{ proof *) MESON_TAC[pos1;REAL_ARITH `(&0 <= t ==> &0 < t + &1) /\ (&0 < t ==> &0 <= t)`;SQRT_POS_LE;] (* }}} *));; let halfatn_bounds_abs = prove_by_refinement( `!x. abs(halfatn x) < &1 `, (* {{{ proof *) [ REWRITE_TAC[halfatn;REAL_ABS_DIV]; GEN_TAC; ASSUME_TAC (ISPEC `x:real` pos2); ASM_SIMP_TAC[REAL_ARITH `(&0 < x ==> abs(x) = x)/\ (&1 * t = t)`;REAL_LT_LDIV_EQ]; (* *) REWRITE_TAC[GSYM POW_2_SQRT_ABS]; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `sqrt(&1 + x pow 2)`; CONJ_TAC; MATCH_MP_TAC SQRT_MONO_LE_COMPAT; REWRITE_TAC[REAL_LE_POW_2]; ARITH_TAC; ARITH_TAC; ] (* }}} *));; let halfatn_bounds = prove( `!x. -- &1 < halfatn x /\ halfatn x < &1 `, REWRITE_TAC[REAL_BOUNDS_LT;halfatn_bounds_abs]);; let halfatn_half = prove_by_refinement( `!x t. (abs (x) < t ==> abs(halfatn x) < t / &2) `, (* {{{ proof *) [ REWRITE_TAC[halfatn;REAL_ABS_DIV]; REPEAT STRIP_TAC; ASSUME_TAC (ISPEC `x:real` pos2); ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs(x)`;REAL_LT_LDIV_EQ]; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `t:real`; ASM_REWRITE_TAC[REAL_ARITH `(t / &2 * x = t * (x / &2)) /\ (t <= t * x/ &2 <=> t * &2 <= t * x)`]; MATCH_MP_TAC REAL_LE_LMUL; CONJ_TAC; UNDISCH_TAC `abs x < t`; REAL_ARITH_TAC; ASM_SIMP_TAC [REAL_ARITH `&0 < x ==> (abs(x) = x)`]; REWRITE_TAC[REAL_ARITH `(&2 <= x + &1) = (&1 <= x)`]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `sqrt(&1)`; CONJ_TAC; REWRITE_TAC[SQRT_1;REAL_ARITH `&1 <= &1`]; MATCH_MP_TAC SQRT_MONO_LE_COMPAT; CONJ_TAC; ARITH_TAC; MATCH_MP_TAC (REAL_ARITH `&0 <= x ==> &1 <= &1 + x`); REWRITE_TAC[REAL_LE_POW_2]; ] (* }}} *));; let abs_pass_through = prove_by_refinement ( `(!x f. (f (-- x) = -- f x) /\ (!y. &0 <= y ==> &0 <= f y) ==> (abs (f x) = f (abs x)))`, (* {{{ proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (REAL_ARITH `&0 <= x \/ &0 <= --x`); POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; MESON_TAC[REAL_ARITH `&0 <= x ==> abs(x ) = x`]; REPEAT (POP_ASSUM MP_TAC); MESON_TAC[REAL_ARITH `&0 <= --x ==> abs(x) = -- x`; REAL_ARITH `abs( -- x ) = abs(x)`]; ] (* }}} *));; let atn_abs = prove_by_refinement( `!x. abs(atn x) = atn (abs x) `, (* {{{ proof *) [ GEN_TAC; MATCH_MP_TAC abs_pass_through; REWRITE_TAC[ATN_NEG;ATN_POS_LE]; ] (* }}} *));; let atn_half_range = prove_by_refinement ( `!x. abs(atn (halfatn x)) < pi / &4 `, (* {{{ proof *) [ REWRITE_TAC[GSYM ATN_1;atn_abs;ATN_MONO_LT_EQ]; GEN_TAC; REWRITE_TAC [halfatn_bounds;GSYM REAL_BOUNDS_LT]; ] (* }}} *));; let tan_one_one = prove_by_refinement( `!x y. (abs(x) < pi/ &2 /\ (abs y < pi / &2 ) /\ (tan x = tan y) ==> (x = y))`, (* {{{ proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (REAL_ARITH `x < y \/ y < x \/ x = (y:real)`); REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[GSYM REAL_BOUNDS_LT]; MESON_TAC[TAN_MONO_LT_EQ;REAL_ARITH `(x:real ~(x = y)`]; POP_ASSUM DISJ_CASES_TAC; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[GSYM REAL_BOUNDS_LT]; MESON_TAC[TAN_MONO_LT_EQ;REAL_ARITH `(x:real ~(x = y)`]; ASM_REWRITE_TAC[]; ] (* }}} *));; let abs_lemma = prove( `!f x. (?n. x = f n) \/ (?n. x = -- f n) <=> (?n. abs(x) = abs(f n))`, ASM_MESON_TAC[REAL_ARITH `!x y. abs(x) = abs(y) <=> (x = y)\/ (x = -- y)`]);; let cos_nz = prove_by_refinement ( `!x. (abs(x) < pi / &2) ==> ~(cos x = &0) `, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[COS_ZERO_PI;abs_lemma]; ONCE_REWRITE_TAC[TAUT `(a ==> ~b) <=> (b ==> ~a)`]; ONCE_REWRITE_TAC[REAL_ARITH `~(x < y) <=> (y <= x)`]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC`(&n + &1/ &2) * pi `; REWRITE_TAC[REAL_ARITH `x <= abs(x)`]; MP_TAC PI_POS; MP_TAC (REAL_ARITH `&1/ &2 <= (&n + &1/ &2)`); REWRITE_TAC[REAL_ARITH `pi / &2 = (&1 / &2) * pi`]; ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 <= x`;Real_ext.REAL_LE_RMUL_IMP]; ] (* }}} *));; let cos_2nz = prove_by_refinement( `!x. (abs(x) < pi / &4) ==> ~(cos (&2 * x) = &0) `, (* {{{ proof *) [ STRIP_TAC THEN STRIP_TAC; MATCH_MP_TAC cos_nz; REWRITE_TAC[REAL_ABS_MUL;REAL_ARITH `abs(&2)= &2 /\ (&2 * x < pi/ &2 <=> x < pi/ &4)`]; ASM_REWRITE_TAC[]; ] (* }}} *));; let halfatn_double =prove_by_refinement( `!x. ~(cos (atn (halfatn x)) = &0) /\ ~(cos(&2 * atn (halfatn x)) = &0) `, (* {{{ proof *) [ REPLICATE_TAC 2 (STRIP_TAC); MATCH_MP_TAC cos_nz; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `pi/ &4`; REWRITE_TAC[atn_half_range]; MP_TAC PI_POS; REAL_ARITH_TAC; MATCH_MP_TAC cos_2nz; REWRITE_TAC[atn_half_range]; ] (* }}} *));; let REAL_DIV_MUL2z = REAL_FIELD `!x y z. (&0 < x) ==> (y /z = (x pow 2 * y) / (x pow 2* z)) `;; let atn_half = prove_by_refinement ( `!x. atn x = &2 * atn (halfatn x) `, (* {{{ proof *) [ GEN_TAC; MATCH_MP_TAC tan_one_one; MATCH_MP_TAC (TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`); REPEAT CONJ_TAC; REWRITE_TAC[GSYM REAL_BOUNDS_LT;ATN_BOUNDS]; (* *) REWRITE_TAC[REAL_ABS_MUL;REAL_ARITH `abs (&2) = &2`;REAL_ARITH `&2 * x < y / &2 <=> x < y / &4`;atn_half_range]; (* *) REPEAT STRIP_TAC; ASSUME_TAC (ISPEC `x:real` halfatn_double); ASM_SIMP_TAC[TAN_DOUBLE;ATN_TAN]; REWRITE_TAC[halfatn]; ASSUME_TAC (ISPEC `x:real` pos2); ABBREV_TAC `t = sqrt(&1 + x pow 2) + &1`; MP_TAC (ISPECL [`t:real`;`&2 * x / t`;`&1 - (x / t) pow 2`] REAL_DIV_MUL2z); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); ASM_SIMP_TAC[REAL_FIELD `&0 < t ==> t pow 2 * &2 * x / t = t * &2 * x`]; ASM_SIMP_TAC[REAL_FIELD `&0 < t ==> t pow 2 * (&1 - (x / t) pow 2) = t pow 2 - x pow 2`]; EXPAND_TAC "t"; REWRITE_TAC[REAL_FIELD `(a + &1) pow 2 = a pow 2 + &2 * a + &1`]; ASM_SIMP_TAC[pos1;REAL_ARITH `!x. &0 < x ==> &0 <= x`;SQRT_POW_2]; ASM_REWRITE_TAC[REAL_ARITH `((&1 + v) + &2 * u + &1) - v = (u + &1) * &2`]; UNDISCH_TAC `&0 < t`; CONV_TAC REAL_FIELD; ] (* }}} *));; (* complex taylor for atn *) prioritize_complex();; let id1 = COMPLEX_RING `inv (Cx (&1) + z pow 2) = (inv (Cx (&2))) * ( ( inv (Cx (&1) + z pow 2) * (Cx (&1) - ii *z)) + (inv (Cx (&1) + z pow 2)) * ( (Cx (&1) + ii * z)))`;; let id2 = SIMPLE_COMPLEX_ARITH ` (Cx (&1) + ii * z) * (Cx (&1) - ii * z) = (Cx (&1) - ii * ii * z * z)`;; let id3 = prove_by_refinement (`!u a. a - ii * ii * u = a + u`, (* {{{ proof *) [ REWRITE_TAC[ii]; SIMPLE_COMPLEX_ARITH_TAC; ] (* }}} *));; let id4 = prove_by_refinement (`!z. (Cx (&1) + z pow 2) = (Cx (&1) + ii*z) * (Cx (&1) - ii*z)`, (* {{{ proof *) [ REWRITE_TAC[id2;id3;COMPLEX_POW_2]; ] (* }}} *));; let tactic_list = [SUBGOAL_THEN `(Re (z) = &0) /\ (abs(Im (z)) = &1)` ASSUME_TAC ; POP_ASSUM MP_TAC ; ASM_REWRITE_TAC[] ; REWRITE_TAC[REAL_ARITH `abs(x) = &1 <=> (x = &1 \/ x = -- &1)`;ii] ; SIMPLE_COMPLEX_ARITH_TAC ; ASM_MESON_TAC[]];; let idz = prove_by_refinement( `!z a. (Re z = &0 ==> abs(Im z) < &1) /\ ((a = ii \/ a = --ii)) ==> ~(Cx (&1) + a * z = Cx (&0))`, (* {{{ proof *) [ ASSUME_TAC (REAL_ARITH `~(&1 < &1)`); REPEAT STRIP_TAC; ] @ (tactic_list @ tactic_list));; (* }}} *) let id4a = prove_by_refinement (`!z. (Re z = &0 ==> abs(Im z) < &1) ==>( inv(Cx (&1) + ii* z) * (Cx (&1) + ii*z) = Cx (&1))`, (* {{{ proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC COMPLEX_MUL_LINV; MATCH_MP_TAC idz; ASM_REWRITE_TAC[]; ] (* }}} *));; let id4b = prove_by_refinement (`!z. (Re z = &0 ==> abs(Im z) < &1) ==>( inv(Cx (&1) - ii* z) * (Cx (&1) - ii*z) = Cx (&1))`, (* {{{ proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC COMPLEX_MUL_LINV; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a - ii * z = a + (-- ii) * z`]; MATCH_MP_TAC idz; ASM_REWRITE_TAC[]; ] (* }}} *));; let id5 = prove_by_refinement (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> ( inv (Cx (&1) + z pow 2) = (inv (Cx (&2))) * ( inv (Cx (&1) + ii * z) + inv (Cx (&1) - ii * z)))`, (* {{{ proof *) [ REPEAT STRIP_TAC; ONCE_REWRITE_TAC[id1]; REWRITE_TAC[id4;COMPLEX_INV_MUL]; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `((a*b)*c + (e*f)*g = (a:complex)*(b*c) + f * (e *g))`]; ASM_SIMP_TAC[id4a;id4b]; REWRITE_TAC[COMPLEX_MUL_RID]; ] (* }}} *));; let taylor_coeff_catn = new_definition `taylor_coeff_catn n (z:complex) = if (n=0) then catn z else Cx (& (FACT (n-1))) * (inv(Cx (&2))) * ( ( (-- ii) pow (n - 1) * ((inv (Cx (&1) + ii * z)) pow n)) + ( ii pow (n - 1) * ((inv (Cx (&1) - ii * z)) pow n)))`;; let taylor_coeff_catn0 = prove_by_refinement ( `taylor_coeff_catn 0 = catn `, (* {{{ proof *) [ ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[taylor_coeff_catn]; ] (* }}} *));; let taylor_coeff_catn1 = prove_by_refinement ( `!z. (Re z = &0 ==> abs(Im z) < &1) ==> (catn has_complex_derivative (taylor_coeff_catn 1 z)) (at z)`, (* {{{ proof *) [ REPEAT STRIP_TAC; SUBGOAL_THEN `taylor_coeff_catn 1 z = inv (Cx (&1) + z pow 2)` ASSUME_TAC; REWRITE_TAC[taylor_coeff_catn;ARITH_RULE `~(1=0) /\ (1-1 = 0) /\ (FACT 0 =1)`;COMPLEX_POW_1;complex_pow;COMPLEX_MUL_LID]; ASM_SIMP_TAC[id5]; (* *) ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_CATN;]; ] (* }}} *));; let taylor_coeff_catn_pos = prove_by_refinement( `!n. (n > 0) ==> (taylor_coeff_catn n = (\z. Cx (& (FACT (n-1))) * (inv(Cx (&2))) * ( ( (-- ii) pow (n - 1) * ((inv (Cx (&1) + ii * z)) pow n)) + ( ii pow (n - 1) * ((inv (Cx (&1) - ii * z)) pow n))) ))`, (* {{{ proof *) [ REPEAT STRIP_TAC; ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[taylor_coeff_catn]; ASM_SIMP_TAC[ARITH_RULE `n > 0 ==> ~(n=0)`]; ] (* }}} *));; let taylor_series_inv_pow = prove_by_refinement( `!n a z. ~(Cx (&1) + a * z = Cx(&0)) ==> (((\z. (inv (Cx (&1) + a * z)) pow n) has_complex_derivative (-- Cx(&n) * a * (inv (Cx(&1) + a * z)) pow (n+1))) (at z))`, (* {{{ proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (ARITH_RULE `(n=0) \/ (n > 0)`); ASM_REWRITE_TAC[ARITH_RULE `0+1=1`;complex_pow;COMPLEX_POW_1;SIMPLE_COMPLEX_ARITH `-- Cx (&0) * u = Cx(&0)`;HAS_COMPLEX_DERIVATIVE_CONST]; ASM_SIMP_TAC[ARITH_RULE `(n>0) ==> (n+1 = 2 + (n-1))`;]; REWRITE_TAC[COMPLEX_POW_ADD]; ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `-- r * s * t * u = r * u * ( -- s * t)`]; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_POW_AT; REWRITE_TAC[COMPLEX_POW_INV;GSYM complex_div]; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_INV_AT; ASM_REWRITE_TAC[]; CONV_TAC (PATH_CONV "lr" (ONCE_REWRITE_CONV[SIMPLE_COMPLEX_ARITH `a = Cx(&0) + a * Cx (&1)` ])); MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ADD; REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST]; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT; REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_ID]; ]);; (* }}} *) let factorial_lemma = prove_by_refinement( `!n. (n>0) ==> (FACT n = n * FACT (n-1))`, (* {{{ proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (ISPEC `n:num` num_CASES); ASM_MESON_TAC[ARITH_RULE `(n>0) ==> ~(n=0)`]; ASM_MESON_TAC[FACT;ARITH_RULE `SUC n - 1 = n`]; ]);; (* }}} *) let taylor_coeff_catn_deriv = prove_by_refinement( `!z n. (Re z = &0 ==> abs(Im z) < &1) ==> ((taylor_coeff_catn n) has_complex_derivative (taylor_coeff_catn (n+1) z)) (at z)`, (* {{{ proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (ARITH_RULE `(n = 0) \/ (n >0)`); ASM_SIMP_TAC[ taylor_coeff_catn0;taylor_coeff_catn1;ARITH_RULE `0+1=1`]; REWRITE_TAC[taylor_coeff_catn;ARITH_RULE `(n+1)-1 = n`]; ASM_SIMP_TAC[ARITH_RULE `(n>0) ==> ~(n+1=0)`]; ASM_SIMP_TAC[taylor_coeff_catn_pos;factorial_lemma]; (* fact finding *) SUBGOAL_THEN `!u. Cx (&(n * FACT (n-1))) * u = Cx (&n) * (Cx (&(FACT (n-1))) * u)` MP_TAC; REWRITE_TAC[CX_MUL;GSYM REAL_OF_NUM_MUL]; SIMPLE_COMPLEX_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(a:complex) * b * c * d = b * c * a * d`]; ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(a:complex) * b * u = (a*b)*u`]; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT; REWRITE_TAC[COMPLEX_ADD_LDISTRIB]; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ADD; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a - ii * z = a + (-- ii) * z`]; SUBGOAL_THEN `!a b r. a * b pow n * r = b pow (n-1) * ( -- a * ( -- b) * r)` MP_TAC; REPEAT STRIP_TAC; MP_TAC(ARITH_RULE `n>0 ==> n = (n-1) + 1`); ASM_REWRITE_TAC[]; DISCH_THEN (fun t -> CONV_TAC (PATH_CONV "lr" (ONCE_REWRITE_CONV[t]))); REWRITE_TAC[COMPLEX_POW_ADD;COMPLEX_POW_1]; SIMPLE_COMPLEX_ARITH_TAC; DISCH_THEN (fun t->REWRITE_TAC[t]); CONJ_TAC THEN (MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT) ; (* highly parallel branches *) REWRITE_TAC[SIMPLE_COMPLEX_ARITH `-- --ii = ii`]; MATCH_MP_TAC taylor_series_inv_pow; STRIP_TAC; ASM_MESON_TAC[idz]; (* *) MATCH_MP_TAC taylor_series_inv_pow; STRIP_TAC; ASM_MESON_TAC[idz]; ] (* }}} *));; let ipows2 = prove_by_refinement( `!n. (--ii ) pow (n + 2) = -- ((-- ii) pow n)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[COMPLEX_POW_ADD;COMPLEX_POW_2;]; MATCH_MP_TAC (SIMPLE_COMPLEX_ARITH `(a * a = -- Cx(&1) ) ==> r * a * a = -- r`); REWRITE_TAC[ii]; SIMPLE_COMPLEX_ARITH_TAC; ]);; (* }}} *) let ipowsc2 = prove_by_refinement( `!n. (ii ) pow (n + 2) = -- ((ii) pow n)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[COMPLEX_POW_ADD;COMPLEX_POW_2;]; MATCH_MP_TAC (SIMPLE_COMPLEX_ARITH `(a * a = -- Cx(&1) ) ==> r * a * a = -- r`); REWRITE_TAC[ii]; SIMPLE_COMPLEX_ARITH_TAC; ]);; (* }}} *) let taylor_coeff0 = prove_by_refinement( `!n. (taylor_coeff_catn n (Cx (&0)) = if (EVEN n) then (Cx (&0)) else Cx (&(FACT (n-1)) * (-- &1) pow ((n - 1) DIV 2)))`, (* {{{ proof *) [ GEN_TAC; DISJ_CASES_TAC (ISPEC `n:num` EVEN_OR_ODD); DISJ_CASES_TAC (ARITH_RULE `(n=0) \/ (n >0)`); ASM_REWRITE_TAC[taylor_coeff_catn;GSYM CX_ATN;ATN_0]; (* *) ASM_SIMP_TAC[taylor_coeff_catn_pos]; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a + b * Cx(&0) = a /\ a - b * Cx(&0) =a`]; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv(Cx (&1)) = Cx (&1) /\ a * Cx(&1) = a`;COMPLEX_POW_ONE]; MATCH_MP_TAC (SIMPLE_COMPLEX_ARITH `c = Cx(&0) ==> a*b*c = Cx(&0)`); SUBGOAL_THEN ( `EVEN n ==> (?k. (n - 1) = 2 * k + 1)`) MP_TAC; REWRITE_TAC[EVEN_EXISTS]; REPEAT STRIP_TAC; EXISTS_TAC `m-1`; REPEAT (POP_ASSUM MP_TAC); ARITH_TAC; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; SPEC_TAC (`k:num`,`k:num`); INDUCT_TAC; REWRITE_TAC[ARITH_RULE `2* 0 + 1 = 1`;COMPLEX_POW_1]; SIMPLE_COMPLEX_ARITH_TAC; ASM_REWRITE_TAC[ipows2;ipowsc2;ARITH_RULE `2* SUC k' + 1 = (2 * k' + 1) + 2`;SIMPLE_COMPLEX_ARITH `--a + --b = --(a+b) /\ -- Cx(&0) = Cx(&0) `]; (* ODD *) ASM_REWRITE_TAC[GSYM NOT_ODD]; SUBGOAL_THEN (`ODD n ==> (?k. n = 2 * k + 1)`) MP_TAC; REWRITE_TAC[ODD_EXISTS]; REPEAT STRIP_TAC; EXISTS_TAC `m:num`; ASM_REWRITE_TAC[]; ARITH_TAC; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; SUBGOAL_THEN `n > 0` ASSUME_TAC; POP_ASSUM MP_TAC; ARITH_TAC; ASM_SIMP_TAC[taylor_coeff_catn_pos]; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a + b * Cx (&0) = a /\ a - b * Cx (&0) = a /\ inv (Cx (&1)) = Cx (&1) /\ a * Cx (&1) = a`;COMPLEX_POW_ONE;ARITH_RULE `(2 * k + 1 ) - 1 = 2 * k`;CX_MUL]; MATCH_MP_TAC (SIMPLE_COMPLEX_ARITH `(b = c) ==> (a*b = a*c)`); SPEC_TAC (`k:num`,`k:num`); INDUCT_TAC; REWRITE_TAC[ARITH_RULE `2 * 0 =0 /\ 0 DIV 2 = 0`;complex_pow;real_pow]; SIMPLE_COMPLEX_ARITH_TAC; REWRITE_TAC[ARITH_RULE `2 * SUC k' = 2 * k' + 2 /\ (2 * SUC k) DIV 2 = ((2 * k) DIV 2) + 1`;SIMPLE_COMPLEX_ARITH `a * (-- b + -- c) = -- (a * (b+c))`;ipows2;ipowsc2;COMPLEX_POW_ADD;REAL_POW_ADD;CX_MUL;REAL_POW_1]; ASM_REWRITE_TAC[]; SIMPLE_COMPLEX_ARITH_TAC; ]);; (* }}} *) let term_bound = prove_by_refinement( `!a n z. Im (z) = &0 ==> norm((Cx(a)* ii) pow n * ((inv (Cx (&1) - Cx(a)* ii * z)) pow (n+1))) <= (abs a) pow n `, (* {{{ proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[COMPLEX_NORM_MUL;COMPLEX_NORM_II;COMPLEX_NORM_CX;COMPLEX_NORM_POW;COMPLEX_NORM_INV;REAL_ARITH `a * &1 = a`]; MATCH_MP_TAC (MESON[REAL_LE_LMUL;REAL_ARITH `x = x* &1`] ( `!x y. &0 <= x /\ y <= &1 ==> x *y <= x`)) ; CONJ_TAC; MATCH_MP_TAC REAL_POW_LE; REWRITE_TAC[REAL_ABS_POS]; MATCH_MP_TAC (MESON[REAL_POW_LE2;REAL_POW_ONE] `!x. &0 <= x /\ x <= &1 ==> x pow n <= &1`); REWRITE_TAC[REAL_LE_INV_EQ;NORM_POS_LE]; MATCH_MP_TAC (MESON[REAL_LE_INV2;REAL_INV_1;REAL_ARITH `&0 < &1`] `&1 <= x ==> inv (x) <= &1`); SUBGOAL_THEN `Im z = &0 ==> Cx(&1) - Cx a * ii * z = complex(&1, -- a * Re(z))` MP_TAC; REWRITE_TAC[ii]; SIMPLE_COMPLEX_ARITH_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (fun t -> REWRITE_TAC[t]); (* *) MATCH_MP_TAC (MESON[REAL_ABS_REFL;REAL_LE_SQUARE_ABS;REAL_ARITH `&0 <= &1 /\ &1 pow 2 = &1`;NORM_POS_LE] `&1 <= norm x pow 2 ==> &1 <= norm x`); REWRITE_TAC[COMPLEX_SQNORM;RE;IM]; MESON_TAC[REAL_LE_POW_2;REAL_ARITH `&1 pow 2 = &1 /\ (&0 <= t ==> &1 <= &1 + t)`]; ]);; (* }}} *) let taylor_error_bound = prove_by_refinement( `!n z. Im(z) = &0 ==> norm(taylor_coeff_catn (n+1) z) <= &(FACT n)`, (* {{{ proof *) [ REPEAT STRIP_TAC; SIMP_TAC[taylor_coeff_catn_pos;ARITH_RULE `(n+1)>0 /\ ((n+1)-1 = n)`]; REWRITE_TAC[COMPLEX_NORM_MUL;COMPLEX_NORM_NUM;COMPLEX_NORM_INV]; REWRITE_TAC[COMPLEX_NORM_NUM]; MATCH_MP_TAC (MESON[REAL_LE_LMUL;REAL_ARITH `x = x* &1`] ( `!x y. &0 <= x /\ y <= &1 ==> x *y <= x`)) ; CONJ_TAC; REWRITE_TAC[REAL_OF_NUM_LE]; ARITH_TAC; MATCH_MP_TAC (REAL_ARITH `x <= &1 + &1 ==> inv (&2)* x <= &1`); MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `norm (--ii pow n * inv (Cx (&1) + ii * z) pow (n + 1)) + norm ( ii pow n * inv (Cx (&1) - ii * z) pow (n + 1))`; REWRITE_TAC[NORM_TRIANGLE]; MATCH_MP_TAC REAL_LE_ADD2; (* *) CONJ_TAC; (* FORCE_MATCH_MP_TAC *) FORCE_MATCH_MP_TAC (ISPECL [`-- &1`;`n:num`;`z:complex`] term_bound); ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[FUN_EQ_THM]; SIMPLE_COMPLEX_ARITH_TAC; SIMPLE_COMPLEX_ARITH_TAC; REWRITE_TAC[REAL_ABS_NEG;REAL_ABS_NUM;REAL_POW_ONE]; (* second *) ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `ii * z = Cx(&1) * ii * z`]; FORCE_MATCH_MP_TAC (ISPECL [` &1`;`n:num`;`z:complex`] term_bound); ASM_REWRITE_TAC[]; SIMPLE_COMPLEX_ARITH_TAC; REWRITE_TAC[REAL_ABS_NEG;REAL_ABS_NUM;REAL_POW_ONE]; ]);; (* }}} *) let complex_taylor_catn = prove_by_refinement( ` !n s. (s = {z | Im (z) = &0 }) ==> (!z. (Cx(&0)) IN s /\ z IN s ==> norm (catn z - vsum (0..n) (\i. taylor_coeff_catn i (Cx(&0)) * (z) pow i / Cx (&(FACT i)))) <= norm (z) pow (n + 1) )`, (* {{{ proof *) [ GEN_TAC THEN GEN_TAC; DISCH_TAC; MP_TAC (SPECL[`taylor_coeff_catn`;`n:num`;`s:complex->bool`;`&(FACT n)`] COMPLEX_TAYLOR); ASM_REWRITE_TAC[IN_ELIM_THM]; ANTS_TAC; REPEAT (CONJ_TAC THEN (REPEAT STRIP_TAC)); REWRITE_TAC[convex;IN_ELIM_THM;IM_ADD;IM_CMUL]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REAL_ARITH_TAC; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN; MATCH_MP_TAC taylor_coeff_catn_deriv; ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; (* *) MATCH_MP_TAC taylor_error_bound; ASM_REWRITE_TAC[]; DISCH_THEN (MP_TAC o (ISPEC `Cx (&0)`)); REWRITE_TAC[taylor_coeff_catn0;SIMPLE_COMPLEX_ARITH `z - Cx (&0) = z /\ Im (Cx (&0)) = &0`]; DISCH_THEN (fun t-> REPEAT STRIP_TAC THEN MP_TAC t) ; DISCH_THEN (MP_TAC o (ISPEC `z:complex`)); DISCH_THEN FORCE_MATCH_MP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_DIV_LMUL; REWRITE_TAC[REAL_OF_NUM_EQ]; MESON_TAC[ FACT_LT;ARITH_RULE `0 < x ==> ~(x =0)`]; ]);; (* }}} *) let real_axis = prove_by_refinement( (* not needed *) `!z. (Im z = &0 <=> (?x. z = Cx(x)))`, (* {{{ proof *) [ GEN_TAC; EQ_TAC; DISCH_TAC; EXISTS_TAC `(Re z)`; POP_ASSUM MP_TAC; SIMPLE_COMPLEX_ARITH_TAC; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IM_CX]; ]);; (* }}} *) let THREAD_IF = prove_by_refinement( `!x y z f. (f:A->B) (if x then y else z) = if x then f y else f z`, (* {{{ proof *) [ REPEAT GEN_TAC; BOOL_CASES_TAC `x:bool` THEN REWRITE_TAC[]; ]);; (* }}} *) let real_taylor_atn_ver1 = prove_by_refinement( `!n x. abs(atn x - sum (0..n) (\i. if EVEN i then &0 else ( -- &1 pow ((i-1) DIV 2) * x pow i / &i ))) <= abs(x) pow (n+1)`, (* {{{ proof *) [ REPEAT GEN_TAC; MP_TAC (ISPECL [`n:num`;`{ z | Im(z) = &0 }`] complex_taylor_catn); REWRITE_TAC[]; DISCH_THEN (fun t -> MP_TAC (ISPEC `Cx (x)` t)); REWRITE_TAC[VSUM_CX_NUMSEG;COMPLEX_NORM_CX;GSYM CX_SUB;GSYM CX_POW;IN_ELIM_THM;GSYM CX_MUL;GSYM CX_DIV;GSYM CX_ATN;IM_CX;taylor_coeff0;GSYM THREAD_IF]; FORCE_MATCH; ONCE_REWRITE_TAC[FUN_EQ_THM]; X_GEN_TAC `i:num`; BETA_TAC; DISJ_CASES_TAC (TAUT `EVEN i \/ ~(EVEN i)`) THEN ASM_REWRITE_TAC[]; REAL_ARITH_TAC; POP_ASSUM MP_TAC; REWRITE_TAC[NOT_EVEN;ODD_EXISTS]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[ARITH_RULE `SUC x - 1 = x`;FACT;GSYM REAL_OF_NUM_MUL ]; ONCE_REWRITE_TAC[REAL_FIELD `((a:real) * b) * c/(d*a) = (b * c/d) * (a/a)`]; MATCH_MP_TAC (REAL_FIELD `x = &1 ==> (y * x = y)`); MATCH_MP_TAC REAL_DIV_REFL; REWRITE_TAC[REAL_OF_NUM_EQ]; MESON_TAC[FACT_LT;ARITH_RULE `0 < x ==> ~(x = 0)`]; ]);; (* }}} *) let sum_odd = prove_by_refinement( `!(g:num->real) n. sum { i | ODD i /\ i IN 0.. 2 * n + 2 } g = sum (0.. n) (\i. g (2 * i +1))`, (* {{{ proof *) [ REPEAT STRIP_TAC; FORCE_MATCH_MP_TAC (ISPECL [`\i. (2 * i + 1)`; `g:num->real`;`(0..n)`] SUM_IMAGE); BETA_TAC; ARITH_TAC; REWRITE_TAC[IMAGE;numseg;IN_ELIM_THM;ODD_EXISTS]; ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[IN_ELIM_THM]; GEN_TAC; EQ_TAC; REPEAT STRIP_TAC; EXISTS_TAC `x':num`; POP_ASSUM MP_TAC; ARITH_TAC; REPEAT (POP_ASSUM MP_TAC); ARITH_TAC; REPEAT (POP_ASSUM MP_TAC); ARITH_TAC; REPEAT STRIP_TAC; EXISTS_TAC `m:num`; REPEAT (POP_ASSUM MP_TAC); ARITH_TAC; ONCE_REWRITE_TAC[FUN_EQ_THM;]; REWRITE_TAC[o_THM]] (* }}} *) );; let sum_even = prove_by_refinement( `!g n. sum {i | ODD i /\ i IN 0..n } (\i. if EVEN i then &0 else g i) = sum (0..n) (\i. if EVEN i then &0 else g i)`, (* {{{ proof *) [ REPEAT GEN_TAC; ONCE_REWRITE_TAC [MESON[] `x = y <=> y = x`]; FORCE_MATCH_MP_TAC (ISPECL [`(\i. if EVEN i then &0 else (g i))`;`{i | ODD i /\ i IN 0..n}`;`(0..n)`] SUM_SUPERSET); REPEAT STRIP_TAC; SET_TAC[]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[IN_ELIM_THM;numseg]; MESON_TAC[NOT_ODD]; REWRITE_TAC[]; ]);; (* }}} *) let real_taylor_atn = prove_by_refinement( `!n x. abs(atn x - sum (0..n) (\j. (-- &1 pow j) * x pow (2 * j + 1)/ &(2 * j+ 1))) <= abs(x) pow (2 * n + 3)`, (* {{{ proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL [`2*n + 2`;`x:real`] real_taylor_atn_ver1); REWRITE_TAC[ARITH_RULE `(2*n + 2) +1 = 2 *n + 3`]; REWRITE_TAC[GSYM sum_even]; REWRITE_TAC[sum_odd]; SUBGOAL_THEN `!i. ~(EVEN (2 *i + 1))` MP_TAC; MP_TAC NOT_EVEN; REWRITE_TAC[EVEN_EXISTS;ODD_EXISTS;ARITH_RULE `!m. SUC (m) = m+1`]; MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[ARITH_RULE `((2 * i + 1) - 1) DIV 2 = i`]; ]);; (* }}} *) let halfatn4 = new_definition `halfatn4 = halfatn o halfatn o halfatn o halfatn`;; let real_taylor_atn_halfatn4 = prove_by_refinement( `!n x. abs (atn(halfatn4 x) - sum (0..n) (\j. (-- &1 pow j) * halfatn4 x pow (2 * j + 1)/ &(2 * j+ 1))) <= inv (&8 pow (2 * n + 3))`, (* {{{ proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `abs(halfatn4 x) pow (2 * n + 3)`; REWRITE_TAC[real_taylor_atn;REAL_INV_POW]; MATCH_MP_TAC Real_ext.REAL_PROP_LE_POW; REWRITE_TAC[REAL_ABS_POS;halfatn4;o_THM]; MATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); MP_TAC (ISPEC `x:real` halfatn_bounds_abs); REPLICATE_TAC 3( DISCH_THEN (fun t-> MP_TAC (MATCH_MP halfatn_half t))); FORCE_MATCH; CONV_TAC REAL_FIELD; ]);; (* }}} *) let atn_halfatn4 = prove_by_refinement( `!x. atn x = &16 * atn(halfatn4 x)`, (* {{{ proof *) [ ONCE_REWRITE_TAC[REAL_ARITH `&16 * x = &2 * &2 * &2 * &2 * x`]; REWRITE_TAC[halfatn4;o_THM;GSYM atn_half]; ]);; (* }}} *) let real_taylor_atn_halfatn4_a = prove_by_refinement( `!n x. abs (atn x - &16 * sum (0..n) (\j. (-- &1 pow j) * halfatn4 x pow (2 * j + 1)/ &(2 * j+ 1))) <= inv (&2 pow (6 * n + 5 ))`, (* {{{ proof *) [ REPEAT GEN_TAC; ONCE_REWRITE_TAC [atn_halfatn4]; REWRITE_TAC[REAL_ARITH `abs (&16 * x - &16 * y) <= z <=> abs(x - y) <= z *inv (&2 pow 4)`]; MP_TAC (ISPECL [`n:num`;`x:real`] real_taylor_atn_halfatn4); FORCE_MATCH; REWRITE_TAC[GSYM REAL_INV_MUL;GSYM REAL_POW_ADD;REAL_ARITH `&8 = &2 pow 3`;REAL_POW_POW]; REPEAT AP_TERM_TAC; ARITH_TAC; ]);; (* }}} *) let halfatn4_co = new_definition `halfatn4_co x j = (-- &1 pow j) * halfatn4 x pow (2 * j + 1)/ &(2 * j+ 1)`;; let atn_bounds_anti = prove_by_refinement( `!x y. x <= y ==> abs(atn x - atn y) <= abs(x - y)`, (* {{{ proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL [`atn`;`(\t. inv(&1 + t pow 2))`;`x:real`;`y:real`] REAL_MVT_VERY_SIMPLE); REWRITE_TAC[real_interval;IN_ELIM_THM]; ANTS_TAC; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN; REWRITE_TAC[HAS_REAL_DERIVATIVE_ATN]; REPEAT STRIP_TAC; ONCE_REWRITE_TAC[REAL_ARITH `abs(y - x) = abs(x-y)`]; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ABS_MUL]; FORCE_MATCH_MP_TAC (ISPECL [`abs(inv (&1 + x' pow 2))`;`&1`;`abs(y-x)`] REAL_LE_RMUL); REWRITE_TAC[REAL_ABS_POS;REAL_ABS_INV]; FORCE_MATCH_MP_TAC (ISPECL [`&1`;`abs(&1 + x' pow 2)`] REAL_LE_INV2); CONJ_TAC THEN TRY(REAL_ARITH_TAC); MP_TAC (ISPEC `x':real` pos1); SIMP_TAC [REAL_ARITH `(&0 < x ==> (abs x = x)) /\ (&1 <= &1 + u <=> &0 <= u)`;REAL_LE_POW_2]; REAL_ARITH_TAC; REAL_ARITH_TAC; ]);; (* }}} *) prioritize_real();; let atn_bounds = prove_by_refinement( `!x y. abs(atn x - atn y) <= abs(x-y)`, (* {{{ proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (REAL_ARITH `x<= y \/ y <= x`); ASM_SIMP_TAC[atn_bounds_anti]; ONCE_REWRITE_TAC[REAL_ARITH `abs(x -y) = abs(y-x)`]; ASM_SIMP_TAC[atn_bounds_anti]; ]);; (* }}} *) (* let real_taylor_atn_approx = prove_by_refinement( `!n x u v eps1 eps2 eps3 eps. abs(x - u ) <= eps1 /\ inv (&2 pow (6 * n + 5)) <= eps2 /\ abs(&16 *sum (0..n) (halfatn4_co u) - v )<= eps3 /\ (eps1 + eps2 + eps3 <= eps) ==> abs(atn(x) - v) <= eps`, (* {{{ proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `(eps1:real) + eps2 + eps3`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS; ABBREV_TAC `r = &16 * sum(0..n) (halfatn4_co u)`; EXISTS_TAC` abs(atn x - atn u) +abs(atn u - r) + abs(r - v)`; CONJ_TAC; CONV_TAC (PATH_CONV "l" (ONCE_REWRITE_CONV[REAL_ARITH `atn x - v = (atn x - atn u) + (atn u - r) + (r - v)`])); MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `abs(atn x - atn u) + abs(atn u - r + r - v)`; REWRITE_TAC[REAL_ABS_TRIANGLE;REAL_ARITH `(x:real) + y <= x + z <=> y <= z`]; MATCH_MP_TAC (REAL_ARITH `a1 <= b1 /\ a2 <= b2 /\ a3 <= b3 ==> a1 + a2 + a3 <= b1 + b2 + b3`); ASM_REWRITE_TAC[]; CONJ_TAC; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `abs(x - u)`; ASM_REWRITE_TAC[atn_bounds]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `inv(&2 pow (6 * n + 5))`; ASM_REWRITE_TAC[]; EXPAND_TAC "r"; MP_TAC (ISPECL [`n:num`;`u:real`] real_taylor_atn_halfatn4_a); FORCE_MATCH; REWRITE_TAC[FUN_EQ_THM;halfatn4_co]; ]);; (* }}} *) *) let real_taylor_atn_approx = prove_by_refinement( `!n x v eps1 eps2 eps. inv (&2 pow (6 * n + 5)) <= eps1 /\ abs(&16 *sum (0..n) (halfatn4_co x) - v )<= eps2 /\ (eps1 + eps2 <= eps) ==> abs(atn(x) - v) <= eps`, (* {{{ proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `( eps1:real) + eps2`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS; ABBREV_TAC `r = &16 * sum(0..n) (halfatn4_co x)`; EXISTS_TAC`abs(atn x - r) + abs(r - v)`; CONJ_TAC; MESON_TAC[REAL_ABS_TRIANGLE;REAL_ARITH `atn x - v = (atn x - r) + r - v`]; MATCH_MP_TAC (REAL_ARITH `a1 <= b1 /\ a2 <= b2 ==> a1 + a2 <= b1 + b2`); ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `inv(&2 pow (6 * n + 5))`; ASM_REWRITE_TAC[]; EXPAND_TAC "r"; MP_TAC (ISPECL [`n:num`;`x:real`] real_taylor_atn_halfatn4_a); FORCE_MATCH; REWRITE_TAC[FUN_EQ_THM;halfatn4_co]; ]);; (* }}} *) end;; hol-light/Formal_ineqs/lib/000077500000000000000000000000001303454263000161325ustar00rootroot00000000000000hol-light/Formal_ineqs/lib/ssrbool-compiled.hl000066400000000000000000000577661303454263000217610ustar00rootroot00000000000000needs "lib/ssrfun-compiled.hl";; (* Section ApplyIff *) begin_section "ApplyIff";; (add_section_var (mk_var ("P", (`:bool`))); add_section_var (mk_var ("Q", (`:bool`))));; (add_section_hyp "eqPQ" (`P <=> Q`));; (* Lemma iffLR *) let iffLR = section_proof [] `P ==> Q` [ (done_tac); ];; (* Lemma iffRL *) let iffRL = section_proof [] `Q ==> P` [ (done_tac); ];; (* Lemma iffLRn *) let iffLRn = section_proof [] `~P ==> ~Q` [ (done_tac); ];; (* Lemma iffRLn *) let iffRLn = section_proof [] `~Q ==> ~P` [ (done_tac); ];; (* Finalization of the section ApplyIff *) let iffLR = finalize_theorem iffLR;; let iffRL = finalize_theorem iffRL;; let iffLRn = finalize_theorem iffLRn;; let iffRLn = finalize_theorem iffRLn;; end_section "ApplyIff";; (* Lemma is_true_true *) let is_true_true = section_proof [] `T` [ (done_tac); ];; (* Lemma not_false_is_true *) let not_false_is_true = section_proof [] `~F` [ (done_tac); ];; let isT = is_true_true;; let notF = not_false_is_true;; (* Lemma negbT *) let negbT = section_proof ["b"] `(b = F) ==> ~b` [ (done_tac); ];; (* Lemma negbTE *) let negbTE = section_proof ["b"] `~b ==> b = F` [ (done_tac); ];; (* Lemma negbF *) let negbF = section_proof ["b"] `b ==> ~b = F` [ (done_tac); ];; (* Lemma negbFE *) let negbFE = section_proof ["b"] `~b = F ==> b` [ (done_tac); ];; (* Lemma negbK *) let negbK = section_proof ["b"] `~ ~b = b` [ (done_tac); ];; (* Lemma negbNE *) let negbNE = section_proof ["b"] `~ ~ b ==> b` [ (done_tac); ];; (* Lemma negb_inj *) let negb_inj = section_proof ["b1";"b2"] `~b1 = ~b2 ==> b1 = b2` [ ((((use_arg_then "b1") (disch_tac [])) THEN (clear_assumption "b1") THEN case) THEN (((use_arg_then "b2") (disch_tac [])) THEN (clear_assumption "b2") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma negbLR *) let negbLR = section_proof ["b";"c"] `b = ~c ==> ~b = c` [ ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "negbK")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma negbRL *) let negbRL = section_proof ["b";"c"] `~b = c ==> b = ~c` [ ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "negbK")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma contra *) let contra = section_proof ["c";"b"] `(c ==> b) ==> ~b ==> ~c` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac))); ];; let contraNN = contra;; (* Lemma contraL *) let contraL = section_proof ["c";"b"] `(c ==> ~b) ==> b ==> ~c` [ (BETA_TAC THEN (move ["h"])); ((((fun arg_tac -> (use_arg_then "contra") (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((use_arg_then "negbK")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma contraR *) let contraR = section_proof ["c";"b"] `(~c ==> b) ==> ~b ==> c` [ (BETA_TAC THEN (move ["h"])); ((((fun arg_tac -> (use_arg_then "contra") (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((use_arg_then "negbK")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma contraLR *) let contraLR = section_proof ["c";"b"] `(~c ==> ~b) ==> b ==> c` [ (BETA_TAC THEN (move ["h"])); ((((fun arg_tac -> (use_arg_then "contra") (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "negbK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma contraT *) let contraT = section_proof ["b"] `(~b ==> F) ==> b` [ (done_tac); ];; (* Lemma wlog_neg *) let wlog_neg = section_proof ["b"] `(~b ==> b) ==> b` [ (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)); ];; (* Lemma contraFT *) let contraFT = section_proof ["c";"b"] `(~c ==> b) ==> b = F ==> c` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac))); ];; (* Lemma contraFN *) let contraFN = section_proof ["c";"b"] `(c ==> b) ==> b = F ==> ~c` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac))); ];; (* Lemma contraTF *) let contraTF = section_proof ["c";"b"] `(c ==> ~b) ==> b ==> c = F` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac))); ];; (* Lemma contraNF *) let contraNF = section_proof ["c";"b"] `(c ==> b) ==> ~b ==> c = F` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac))); ];; (* Lemma contraFF *) let contraFF = section_proof ["c";"b"] `(c ==> b) ==> b = F ==> c = F` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac))); ];; let isSome = define `isSome NONE = F /\ (!x. isSome (SOME x) = T)`;; (* Section BoolIf *) begin_section "BoolIf";; (add_section_var (mk_var ("vT", (`:A`))); add_section_var (mk_var ("vF", (`:A`))));; (add_section_var (mk_var ("f", (`:A -> B`))));; (add_section_var (mk_var ("b", (`:bool`))));; (* Lemma if_same *) let if_same = section_proof [] `(if b then vT else vT) = vT` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma if_neg *) let if_neg = section_proof [] `(if ~b then vT else vF) = if b then vF else vT` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma fun_if *) let fun_if = section_proof [] `f (if b then vT else vF) = if b then f vT else f vF` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma if_arg *) let if_arg = section_proof ["fT";"fF";"x"] `(if b then (fT:A->B) else fF) x = if b then fT x else fF x` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Finalization of the section BoolIf *) let if_same = finalize_theorem if_same;; let if_neg = finalize_theorem if_neg;; let fun_if = finalize_theorem fun_if;; let if_arg = finalize_theorem if_arg;; end_section "BoolIf";; (* Lemma andTb *) let andTb = section_proof ["b"] `(T /\ b) = b` [ (done_tac); ];; (* Lemma andFb *) let andFb = section_proof ["b"] `(F /\ b) = F` [ (done_tac); ];; (* Lemma andbT *) let andbT = section_proof ["b"] `(b /\ T) = b` [ (done_tac); ];; (* Lemma andbF *) let andbF = section_proof ["b"] `(b /\ F) = F` [ (done_tac); ];; (* Lemma andbb *) let andbb = section_proof ["b"] `(b /\ b) = b` [ (done_tac); ];; (* Lemma andbC *) let andbC = section_proof ["b";"c"] `(b /\ c) = (c /\ b)` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andbA *) let andbA = section_proof ["b";"c";"p"] `b /\ (c /\ p) <=> (b /\ c) /\ p` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andbCA *) let andbCA = section_proof ["b";"c";"p"] `b /\ (c /\ p) <=> c /\ (b /\ p)` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andbAC *) let andbAC = section_proof ["b";"c";"p"] `(b /\ c) /\ p <=> (b /\ p) /\ c` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orTb *) let orTb = section_proof ["b"] `T \/ b <=> T` [ (done_tac); ];; (* Lemma orFb *) let orFb = section_proof ["b"] `F \/ b <=> b` [ (done_tac); ];; (* Lemma orbT *) let orbT = section_proof ["b"] `b \/ T <=> T` [ (done_tac); ];; (* Lemma orbF *) let orbF = section_proof ["b"] `b \/ F <=> b` [ (done_tac); ];; (* Lemma orbb *) let orbb = section_proof ["b"] `b \/ b <=> b` [ (done_tac); ];; (* Lemma orbC *) let orbC = section_proof ["b";"c"] `b \/ c <=> c \/ b` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orbA *) let orbA = section_proof ["b";"c";"p"] `b \/ (c \/ p) <=> (b \/ c) \/ p` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orbCA *) let orbCA = section_proof ["b";"c";"p"] `b \/ (c \/ p) <=> c \/ (b \/ p)` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orbAC *) let orbAC = section_proof ["b";"c";"p"] `(b \/ c) \/ p <=> (b \/ p) \/ c` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andbN *) let andbN = section_proof ["b"] `b /\ ~b <=> F` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andNb *) let andNb = section_proof ["b"] `~b /\ b <=> F` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orbN *) let orbN = section_proof ["b"] `b \/ ~b` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orNb *) let orNb = section_proof ["b"] `~b \/ b` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andb_orl *) let andb_orl = section_proof ["b";"c";"p"] `(b \/ c) /\ p <=> (b /\ p) \/ (c /\ p)` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andb_orr *) let andb_orr = section_proof ["b";"c";"p"] `b /\ (c \/ p) <=> (b /\ c) \/ (b /\ p)` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orb_andl *) let orb_andl = section_proof ["b";"c";"p"] `(b /\ c) \/ p <=> (b \/ p) /\ (c \/ p)` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orb_andr *) let orb_andr = section_proof ["b";"c";"p"] `b \/ (c /\ p) <=> (b \/ c) /\ (b \/ p)` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andb_idl *) let andb_idl = section_proof ["a";"b"] `(b ==> a) ==> (a /\ b <=> b)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andb_idr *) let andb_idr = section_proof ["a";"b"] `(a ==> b) ==> (a /\ b <=> a)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andb_id2l *) let andb_id2l = section_proof ["a";"b";"c"] `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andb_id2r *) let andb_id2r = section_proof ["a";"b";"c"] `(b ==> (a <=> c)) ==> (a /\ b <=> c /\ b)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orb_idl *) let orb_idl = section_proof ["a";"b"] `(a ==> b) ==> (a \/ b <=> b)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orbb_idr *) let orbb_idr = section_proof ["a";"b"] `(b ==> a) ==> (a \/ b <=> a)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orb_id2l *) let orb_id2l = section_proof ["a";"b";"c"] `(~ a ==> (b <=> c)) ==> (a \/ b <=> a \/ c)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orb_id2r *) let orb_id2r = section_proof ["a";"b";"c"] `(~ b ==> (a <=> c)) ==> (a \/ b <=> c \/ b)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma negb_and *) let negb_and = section_proof ["a";"b"] `~ (a /\ b) <=> ~ a \/ ~ b` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma negb_or *) let negb_or = section_proof ["a";"b"] `~ (a \/ b) <=> ~ a /\ ~ b` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andbK *) let andbK = section_proof ["a";"b"] `((a /\ b) \/ a) = a` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma andKb *) let andKb = section_proof ["a";"b"] `a \/ b /\ a <=> a` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orbK *) let orbK = section_proof ["a";"b"] `(a \/ b) /\ a <=> a` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma orKb *) let orKb = section_proof ["a";"b"] `a /\ (b \/ a) <=> a` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implybT *) let implybT = section_proof ["b"] `b ==> T` [ (done_tac); ];; (* Lemma implybF *) let implybF = section_proof ["b"] `(b ==> F) <=> ~ b` [ (done_tac); ];; (* Lemma implyFb *) let implyFb = section_proof ["b"] `F ==> b` [ (done_tac); ];; (* Lemma implyTb *) let implyTb = section_proof ["b"] `(T ==> b) <=> b` [ (done_tac); ];; (* Lemma implybb *) let implybb = section_proof ["b"] `b ==> b` [ (done_tac); ];; (* Lemma negb_imply *) let negb_imply = section_proof ["a";"b"] `~ (a ==> b) <=> a /\ ~ b` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implybE *) let implybE = section_proof ["a";"b"] `(a ==> b) <=> ~ a \/ b` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implyNb *) let implyNb = section_proof ["a";"b"] `(~ a ==> b) <=> a \/ b` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implybN *) let implybN = section_proof ["a";"b"] `(a ==> ~ b) <=> (b ==> ~ a)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implybNN *) let implybNN = section_proof ["a";"b"] `(~ a ==> ~ b) <=> b ==> a` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implyb_idl *) let implyb_idl = section_proof ["a";"b"] `(~ a ==> b) ==> ((a ==> b) <=> b)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implyb_idr *) let implyb_idr = section_proof ["a";"b"] `(b ==> ~ a) ==> ((a ==> b) <=> ~ a)` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma implyb_id2l *) let implyb_id2l = section_proof ["a";"b";"c"] `(a ==> (b <=> c)) ==> ((a ==> b) <=> (a ==> c))` [ ((((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac)) THEN (done_tac)); ];; let XOR_DEF = new_definition `XOR p q = if p then ~q else q`;; overload_interface("+", `XOR`);; (* Lemma addFb *) let addFb = section_proof ["b"] `F + b <=> b` [ ((((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma addbF *) let addbF = section_proof ["b"] `b + F <=> b` [ ((((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma addbb *) let addbb = section_proof ["b"] `b + b <=> F` [ ((((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma addbC *) let addbC = section_proof ["b";"c"] `b + c <=> c + b` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma addbA *) let addbA = section_proof ["a";"b";"c"] `a + (b + c) <=> (a + b) + c` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case) THEN (((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac))); ];; (* Lemma addbCA *) let addbCA = section_proof ["a";"b";"c"] `(a + b) + c <=> (a + c) + b` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case) THEN (((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac))); ];; (* Lemma addbAC *) let addbAC = section_proof ["a";"b";"c"] `a + (b + c) <=> b + (a + c)` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case) THEN (((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac))); ];; (* Lemma andb_addl *) let andb_addl = section_proof ["a";"b";"c"] `(a + b) /\ c <=> (a /\ c) + (b /\ c)` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case) THEN (((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac))); ];; (* Lemma andb_addr *) let andb_addr = section_proof ["a";"b";"c"] `a /\ (b + c) <=> (a /\ b) + (a /\ c)` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN (((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case) THEN (((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case THEN (simp_tac))); ];; (* Lemma addKb *) let addKb = section_proof ["x";"y"] `x + (x + y) <=> y` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "x") (disch_tac [])) THEN (clear_assumption "x") THEN case) THEN (((use_arg_then "y") (disch_tac [])) THEN (clear_assumption "y") THEN case THEN (simp_tac))); ];; (* Lemma addbK *) let addbK = section_proof ["x";"y"] `(y + x) + x <=> y` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "x") (disch_tac [])) THEN (clear_assumption "x") THEN case) THEN (((use_arg_then "y") (disch_tac [])) THEN (clear_assumption "y") THEN case THEN (simp_tac))); ];; (* Lemma addIb *) let addIb = section_proof ["x";"y1";"y2"] `(y1 + x <=> y2 + x) ==> (y1 = y2)` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "y1") (disch_tac [])) THEN (clear_assumption "y1") THEN case) THEN (((use_arg_then "y2") (disch_tac [])) THEN (clear_assumption "y2") THEN case) THEN (((use_arg_then "x") (disch_tac [])) THEN (clear_assumption "x") THEN case THEN (simp_tac))); ];; (* Lemma addbI *) let addbI = section_proof ["x";"y1";"y2"] `(x + y1 <=> x + y2) ==> (y1 = y2)` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "x") (disch_tac [])) THEN (clear_assumption "x") THEN case) THEN (((use_arg_then "y1") (disch_tac [])) THEN (clear_assumption "y1") THEN case) THEN (((use_arg_then "y2") (disch_tac [])) THEN (clear_assumption "y2") THEN case THEN (simp_tac))); ];; (* Lemma addTb *) let addTb = section_proof ["b"] `T + b <=> ~b` [ (((((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (done_tac)); ];; (* Lemma addbT *) let addbT = section_proof ["b"] `b + T <=> ~ b` [ ((((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma addbN *) let addbN = section_proof ["a";"b"] `a + ~ b <=> ~ (a + b)` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac))); ];; (* Lemma addNb *) let addNb = section_proof ["a";"b"] `~ a + b <=> ~ (a + b)` [ ((repeat_tactic 1 9 (((use_arg_then "XOR_DEF")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "a") (disch_tac [])) THEN (clear_assumption "a") THEN case) THEN (((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac))); ];; let subpred = new_definition `subpred p1 p2 <=> (!x. p1 x ==> p2 x)`;; let subrel = new_definition `subrel r1 r2 <=> (!x y. r1 x y ==> r2 x y)`;; let pred0 = new_definition `pred0 = (\x. F)`;; let predT = new_definition `predT = (\x. T)`;; let predI = new_definition `predI p1 p2 = (\x. p1 x /\ p2 x)`;; let predU = new_definition `predU p1 p2 = (\x. p1 x \/ p2 x)`;; let predC = new_definition `predC p = (\x. ~p x)`;; let predD = new_definition `predD p1 p2 = (\x. ~p2 x /\ p1 x)`;; let preim = new_definition `preim f (d:A->bool) = (\x. d (f x))`;; let relU = new_definition `relU r1 r2 = (\x y. r1 x y \/ r2 x y)`;; (* Lemma subrelUl *) let subrelUl = section_proof ["r1";"r2"] `subrel r1 (relU r1 r2)` [ (((((use_arg_then "relU")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subrel")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma subrelUr *) let subrelUr = section_proof ["r1";"r2"] `subrel r2 (relU r1 r2)` [ (((((use_arg_then "relU")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subrel")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; hol-light/Formal_ineqs/lib/ssreflect/000077500000000000000000000000001303454263000201245ustar00rootroot00000000000000hol-light/Formal_ineqs/lib/ssreflect/sections.hl000066400000000000000000000221441303454263000223030ustar00rootroot00000000000000(* =========================================================== *) (* SSReflect/HOL Light support library *) (* See http://code.google.com/p/flyspeck/downloads/list *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* Basic commands for working with the goal stack *) let revert_proof_step = b;; let begin_goal = g;; (* A flag for fast proof loading (using mk_thm) *) let fast_load_flag = ref false;; (* Section variables, hypotheses (with labels), and implicit types *) type section_info = term list * (string * term) list * (string * hol_type) list;; let empty_section : section_info = ([], [], []);; let section_stack = ref ([] : (string * section_info) list);; (* Begins a new section *) let begin_section name = let sections = !section_stack in if can (C assoc sections) name then failwith ("Section " ^ name ^ " is already active") else let sections = (name, empty_section) :: sections in section_stack := sections;; (* Ends the active section *) let end_section name = let sections = !section_stack in if sections = [] then failwith "end_section: No open sections" else let last_name, _ = hd sections in if Pervasives.compare last_name name <> 0 then failwith ("The last open section is " ^ last_name) else section_stack := tl sections;; (* Returns all section variables in the current section *) let current_section_vars () = if !section_stack = [] then [] else let (_, (vars, _, _)) = hd !section_stack in vars;; (* Returns all hypotheses in the current section *) let current_section_hyps () = if !section_stack = [] then [] else let (_, (_, hyps, _)) = hd !section_stack in hyps;; (* Returns all section variables from all sections *) let section_vars () : term list = let vars = map (fun (_, (v, _, _)) -> v) !section_stack in List.concat vars;; (* Returns all implicit types from all sections *) let section_types () : (string * hol_type) list = let types = map (fun (_, (_, _, t)) -> t) !section_stack in List.concat types;; (* Returns all hypotheses from all sections *) let section_hyps () : (string * term) list = let hyps = map (fun (_, (_, h, _)) -> h) !section_stack in List.concat hyps;; (* Adds the given variable to the active section *) let add_section_var var = let sections = !section_stack in if sections = [] then failwith "add_section_var: No open sections" else let name, (vars, hyps, types) = hd sections in let s_var = section_vars() in let var_name, _ = dest_var var in if can (C assoc (map dest_var s_var)) var_name then failwith ("A variable with the name "^var_name^" is already defined") else section_stack := (name, (var :: vars, hyps, types)) :: tl sections;; (* Adds the given implicit type to the active section *) let add_section_type tm = let sections = !section_stack in if sections = [] then failwith "add_section_type: No open sections" else let name, (vars, hyps, types) = hd sections in let s_types = section_types() in let var_name, ty = dest_var tm in if can (C assoc s_types) var_name then failwith ("An implicit type for the variable "^var_name^" is already defined") else section_stack := (name, (vars, hyps, (var_name, ty) :: types)) :: tl sections;; (* Removes the given variable from the active section *) let remove_section_var var_name = let sections = !section_stack in let name, (vars, hyps, types) = hd sections in let ty = assoc var_name (map dest_var vars) in let var = mk_var (var_name, ty) in let new_vars = subtract vars [var] in section_stack := (name, (new_vars, hyps, types)) :: tl sections;; (* Removes the given implicit type from the active section *) let remove_section_type type_name = let sections = !section_stack in let name, (vars, hyps, types) = hd sections in let ty = assoc type_name types in let new_types = subtract types [type_name, ty] in section_stack := (name, (vars, hyps, new_types)) :: tl sections;; (* Instantiates types of section variables in the term *) let inst_section_vars tm = let s_vars = map dest_var (section_vars()) in let find_var (name, ty) = try (assoc name s_vars, ty) with Failure _ -> (bool_ty, bool_ty) in let inst_var (name, ty) tm = let ty_dst, ty_src = find_var (name, ty) in try (inst (type_match ty_src ty_dst []) tm) with Failure _ -> failwith ("Section variable " ^ name ^ " has type " ^ string_of_type ty_dst) in let f_vars = map dest_var (frees tm) in itlist inst_var f_vars tm;; (* Instantiates implicit types in the given term *) (* (free variables and top generalized variables are considered in the term) *) let inst_section_types tm = let s_types = section_types() in let find_type tm = let name, ty = dest_var tm in try (assoc name s_types, ty) with Failure _ -> (bool_ty, bool_ty) in let f_vars = frees tm in let g_vars, _ = strip_forall tm in let ty_dst, ty_src = unzip (map find_type (g_vars @ f_vars)) in let ty_inst = itlist2 type_match ty_src ty_dst [] in inst ty_inst tm;; (* Checks if the term contains any free variables which are not section variables *) let check_section_term tm = let f_vars = frees tm in if !section_stack = [] then if f_vars <> [] then let str = String.concat ", " (map string_of_term f_vars) in failwith ("Free variables: " ^ str) else () else let s_vars = section_vars() in let vars = subtract f_vars s_vars in if vars <> [] then let str = String.concat ", " (map string_of_term vars) in failwith ("Free variables: " ^ str) else ();; (* Adds the given hypothesis (term) to the active section *) let add_section_hyp label hyp = let sections = !section_stack in if sections = [] then failwith "add_section_hyp: No open sections" else let hyp0 = inst_section_vars hyp in let hyp1 = inst_section_types hyp0 in let name, (vars, hyps, types) = hd sections in let hyp_names = map fst (section_hyps()) in if can (find (fun x -> Pervasives.compare label x = 0)) hyp_names then failwith ("A hypothesis with the name "^label^" is already defined") else check_section_term hyp1; section_stack := (name, (vars, (label, hyp1) :: hyps, types)) :: tl sections;; (* Removes the given assumption from the active section *) let remove_section_hyp label = let sections = !section_stack in let name, (vars, hyps, types) = hd sections in let hyp = assoc label hyps in let new_hyps = subtract hyps [(label, hyp)] in section_stack := (name, (vars, new_hyps, types)) :: tl sections;; (* Prepares a goal term *) let prepare_goal_term tm = if !section_stack = [] then (check_section_term tm; tm) else let tm0 = inst_section_vars tm in let tm1 = inst_section_types tm0 in let s_hyps = map snd (section_hyps()) in let r = itlist (curry mk_imp) s_hyps tm1 in check_section_term r; r;; (* Prepares a goal term and an initial tactic *) let prepare_section_proof names tm = let f_vars = map dest_var (frees tm) in let find var_name = try assoc var_name f_vars with Failure _ -> failwith ("Unused variable: "^var_name) in let g_vars = map (fun name -> mk_var (name, find name)) names in let g_tm = list_mk_forall (g_vars, tm) in let tm0 = prepare_goal_term g_tm in let n_hyps = map fst (section_hyps()) in let gen_tac = REPLICATE_TAC (length g_vars) GEN_TAC in let disch_tac = itlist (fun name tac -> DISCH_THEN (LABEL_TAC name) THEN tac) n_hyps ALL_TAC in tm0, disch_tac THEN gen_tac;; (* Starts a proof of the goal using section hypotheses *) let start_section_proof names tm = let tm0, tac0 = prepare_section_proof names tm in let _ = set_goal([], tm0) in refine (by (VALID tac0));; (* Returns the final theorem *) let end_section_proof () = let th = top_thm() in let hyps = section_hyps() in itlist (fun _ th -> UNDISCH th) hyps th;; (* Proofs a lemma using section hypotheses and variables *) let section_proof names tm tac_list = let tm0, tac0 = prepare_section_proof names tm in let gstate = mk_goalstate ([], tm0) in let tac_list1 = if !fast_load_flag then [fun g -> ACCEPT_TAC(mk_thm([], snd g)) g] else tac_list in let _, sgs, just = rev_itlist by (tac0 :: tac_list1) gstate in let th0 = if sgs = [] then just null_inst [] else failwith "section_proof: unsolved goals" in let hyps = section_hyps() in itlist (fun _ th -> UNDISCH th) hyps th0;; (* Discharges all assumptions and generalize all section variables *) let finalize_theorem th = let hyps = map snd (current_section_hyps()) in let th_hyps = hyp th in let hyps0 = intersect hyps th_hyps in let s_vars = current_section_vars() in let th1 = rev_itlist (fun hyp th -> DISCH hyp th) hyps0 th in let f_vars = frees (concl th1) in let vars = intersect f_vars s_vars in itlist (fun var th -> GEN var th) vars th1;; hol-light/Formal_ineqs/lib/ssreflect/ssreflect.hl000066400000000000000000001044341303454263000224510ustar00rootroot00000000000000(* =========================================================== *) (* SSReflect/HOL Light support library *) (* See http://code.google.com/p/flyspeck/downloads/list *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* A special definition for introducing equalities with the construction move eq: a => b *) let ssreflect_eq_def = new_definition `!v P. ssreflect_eq (v:A) (P:bool) = P`;; (* Generalizes given variables in a term *) let gen_variables binders tm = if type_of tm <> bool_ty then if length binders = 0 then tm else failwith "gen_variables: bool term is required" else let f_vars = map dest_var (frees tm) in let find_type name = assoc name f_vars in let gen_variable var_name tm = let var = try mk_var (var_name, find_type var_name) with Failure _ -> failwith ("gen_variables: variable "^var_name ^" is not free in the term "^(string_of_term tm)) in mk_forall (var, tm) in itlist gen_variable binders tm;; (* Combined type of theorems and terms *) type arg_type = Arg_theorem of thm | Arg_term of term | Arg_type of hol_type;; let get_arg_thm arg = match arg with | Arg_theorem th -> th | _ -> failwith "A theorem expected";; let get_arg_term arg = match arg with | Arg_term tm -> tm | _ -> failwith "A term expected";; let get_arg_type arg = match arg with | Arg_type ty -> ty | _ -> failwith "A type expected";; (* Converts a theorem tactic into a tactic which accepts thm_term arguments *) let thm_tac (ttac : thm_tactic) = ttac o get_arg_thm;; let term_tac (ttac : term -> tactic) = ttac o get_arg_term;; let type_tac (ttac : hol_type -> tactic) arg = ttac o get_arg_type;; let conv_thm_tac (ttac : thm_tactic->tactic) (arg_tac : arg_type->tactic) = ttac (fun th -> arg_tac (Arg_theorem th));; (* Based on the code from tactics.ml *) (* Applies the second tactic to either the first subgoal or the last subgoal *) let (THENL_FIRST),(THENL_LAST) = let propagate_empty i [] = [] and propagate_thm th i [] = INSTANTIATE_ALL i th in let compose_justs n just1 just2 i ths = let ths1,ths2 = chop_list n ths in (just1 i ths1)::(just2 i ths2) in let rec seqapply l1 l2 = match (l1,l2) with ([],[]) -> null_meta,[],propagate_empty | ((tac:tactic)::tacs),((goal:goal)::goals) -> let ((mvs1,insts1),gls1,just1) = tac goal in let goals' = map (inst_goal insts1) goals in let ((mvs2,insts2),gls2,just2) = seqapply tacs goals' in ((union mvs1 mvs2,compose_insts insts1 insts2), gls1@gls2,compose_justs (length gls1) just1 just2) | _,_ -> failwith "seqapply: Length mismatch" in let justsequence just1 just2 insts2 i ths = just1 (compose_insts insts2 i) (just2 i ths) in let tacsequence ((mvs1,insts1),gls1,just1) tacl = let ((mvs2,insts2),gls2,just2) = seqapply tacl gls1 in let jst = justsequence just1 just2 insts2 in let just = if gls2 = [] then propagate_thm (jst null_inst []) else jst in ((union mvs1 mvs2,compose_insts insts1 insts2),gls2,just) in let (thenl_first: tactic -> tactic -> tactic) = fun tac1 tac2 g -> let _,gls,_ as gstate = tac1 g in if gls = [] then failwith "No subgoals" else let tac_list = tac2 :: (replicate ALL_TAC (length gls - 1)) in tacsequence gstate tac_list and (thenl_last: tactic -> tactic -> tactic) = fun tac1 tac2 g -> let _,gls,_ as gstate = tac1 g in if gls = [] then failwith "No subgoals" else let tac_list = (replicate ALL_TAC (length gls - 1)) @ [tac2] in tacsequence gstate tac_list in thenl_first, thenl_last;; (* Rotates the goalstack *) let (THENL_ROT: int -> tactic -> tactic) = fun n tac g -> let gstate = tac g in rotate n gstate;; (* Repeats the given tactic exactly n times and then repeats the same tactic at most m times *) let repeat_tactic n m tac = let rec replicate_at_most m tac = if m <= 0 then ALL_TAC else (tac THEN replicate_at_most (m - 1) tac) ORELSE ALL_TAC in REPLICATE_TAC n tac THEN replicate_at_most m tac;; (* Returns all free variables in the goal *) let get_context_vars (g : goal) = let list, g_tm = g in let tms = g_tm :: map (concl o snd) list in let f_vars = setify (flat (map frees tms)) in map (fun v -> ((fst o dest_var) v, v)) f_vars;; (* Clears the given assumption *) let clear_assumption name = TRY (REMOVE_THEN name (fun th -> ALL_TAC));; (* DISCH_THEN (LABEL_TAC name) for assumptions and X_GEN_TAC name for variables *) let move labels = (* Automatically introduces an assumption for a top-level ssreflect_eq *) let move_eq (g:goal) = let g_tm = snd g in let tac = try let eq_tm = (rator o fst o dest_imp) g_tm in if (fst o dest_const o rator) eq_tm = "ssreflect_eq" then let label = (fst o dest_var o rand) eq_tm in DISCH_THEN (LABEL_TAC label o PURE_ONCE_REWRITE_RULE[ssreflect_eq_def]) else ALL_TAC with Failure _ -> ALL_TAC in tac g in let move1 name (g:goal) = let g_tm = snd g in let tac = if is_forall g_tm then let tm0, g_tm1 = dest_forall g_tm in let tm = mk_var (name, type_of tm0) in if name = "_" then GEN_TAC else X_GEN_TAC tm else if is_imp g_tm then if name = "_" then DISCH_THEN (fun th -> ALL_TAC) else DISCH_THEN (LABEL_TAC name) else failwith "move: not (!) or (==>)" in tac g in fun g -> let tac = itlist (fun name tac -> move_eq THEN move1 name THEN tac) labels ALL_TAC in tac g;; (* Localization tactical *) let in_tac a_list in_goal tac (g:goal) = let goal_tm = snd g in let tmp_goal_name = "$_goal_$" in let tmp_goal_var = mk_var (tmp_goal_name, bool_ty) in let tmp_goal = mk_eq (tmp_goal_var, goal_tm) in let tmp_goal_sym = mk_eq (goal_tm, tmp_goal_var) in let disch_tac = rev_itlist (fun name tac -> REMOVE_THEN name MP_TAC THEN tac) a_list ALL_TAC in let intro_tac = move a_list in let hide_goal, unfold_goal = if in_goal then ALL_TAC, ALL_TAC else ABBREV_TAC tmp_goal, EXPAND_TAC tmp_goal_name THEN UNDISCH_TAC tmp_goal_sym THEN DISCH_THEN (fun th -> ALL_TAC) in (hide_goal THEN disch_tac THEN tac THEN TRY intro_tac THEN unfold_goal) g;; (* Finds a subterm in the given term which matches against the given pattern; local_consts is a list of variable which must be fixed in the pattern. This function returns the path to the first matched subterm *) let match_subterm local_consts pat tm = let rec find tm path = try let inst = term_match local_consts pat tm in if instantiate inst pat = tm then path else failwith "Bad instantiation" with x -> try match tm with | Abs(_, b_tm) -> find b_tm (path^"b") | Comb(l_tm, r_tm) -> try find l_tm (path^"l") with Failure _ -> find r_tm (path^"r") | _ -> failwith "match_subterm: no match" with x -> failwith ("match_subterm: no match: "^string_of_term pat) in find tm "";; (* Returns paths to all subterms satisfying p *) let find_all_paths p tm = let rec find_path p tm path = let paths = match tm with | Abs(_, b_tm) -> find_path p b_tm (path ^ "b") | Comb(l_tm, r_tm) -> (find_path p l_tm (path ^ "l")) @ (find_path p r_tm (path ^ "r")) | _ -> [] in if p tm then path :: paths else paths in find_path p tm "";; (* Instantiates types of the given context variables in the given term.*) let inst_context_vars vars tm_vars tm = let find_type var = let name, ty = dest_var var in try (ty, type_of (assoc name vars)) with Failure _ -> failwith (name^" is free in the term `"^(string_of_term tm)^"` and in the context") in let ty_src, ty_dst = unzip (map find_type tm_vars) in let ty_inst = itlist2 type_match ty_src ty_dst [] in inst ty_inst tm;; (* Instantiates types of all free variables in the term using the context *) let inst_all_free_vars tm (g : goal) = let context_vars = get_context_vars g in let f_vars = frees tm in inst_context_vars context_vars f_vars tm;; (* Finds a subterm corresponding to the given pattern. Before matching, the term types are instantiated in the given context. *) let match_subterm_in_context pat tm (g : goal) = let context_vars = get_context_vars g in let f0_vars = filter (fun tm -> ((fst o dest_var) tm).[0] <> '_') (frees pat) in let pattern = inst_context_vars context_vars f0_vars pat in let f1_vars = filter (fun tm -> ((fst o dest_var) tm).[0] <> '_') (frees pattern) in match_subterm f1_vars pattern tm;; (*************************) (* Rewriting *) (*************************) (* Breaks conjunctions and does other misc stuff *) let rec break_conjuncts th : thm list = (* Convert P ==> (!x. Q x) to !x. P ==> Q x and P ==> Q ==> R to P /\ Q ==> R *) let th0 = PURE_REWRITE_RULE[GSYM RIGHT_FORALL_IMP_THM; IMP_IMP] th in let th1 = SPEC_ALL th0 in (* Break top level conjunctions *) let th_list = CONJUNCTS th1 in if length th_list > 1 then List.concat (map break_conjuncts th_list) else let th_tm = concl th1 in (* Deal with assumptions *) if is_imp th_tm then let a_tm = lhand th_tm in let th_list = break_conjuncts (UNDISCH th1) in map (DISCH a_tm) th_list else if is_eq th_tm then [th1] else if is_neg th_tm then [PURE_ONCE_REWRITE_RULE[TAUT `~P <=> (P <=> F)`] th1] else [EQT_INTRO th1];; (* Finds an instantination for the given term inside another term *) let rec find_term_inst local_consts tm src_tm path = try (term_match local_consts tm src_tm, true, path) with Failure _ -> match src_tm with | Comb(l_tm, r_tm) -> let r_inst, flag, s = find_term_inst local_consts tm l_tm (path ^ "l") in if flag then (r_inst, flag, s) else find_term_inst local_consts tm r_tm (path ^ "r") | Abs(_, b_tm) -> find_term_inst local_consts tm b_tm (path ^ "b") | _ -> (([],[],[]), false, path);; (* Rewrites the subterm at the given path using the given equation theorem *) let path_rewrite path th tm = let rec build path tm = let n = String.length path in if n = 0 then th else let ch = path.[0] in let path' = String.sub path 1 (n - 1) in if ch = 'l' then let lhs, rhs = dest_comb tm in let th0 = build path' lhs in AP_THM th0 rhs else if ch = 'r' then let lhs, rhs = dest_comb tm in let th0 = build path' rhs in AP_TERM lhs th0 else if ch = 'b' then let var, body = dest_abs tm in let th0 = build path' body in try ABS var th0 with Failure _ -> failwith ("ABS failed: (" ^ string_of_term var ^ ", " ^ string_of_thm th0) else failwith ("Bad path symbol: "^path) in let res = build path tm in let lhs = (lhand o concl) res in if not (aconv lhs tm) then failwith ("path_rewrite: incorrect result [required: "^ (string_of_term tm)^"; obtained: "^ (string_of_term lhs)) else res;; let new_rewrite occ pat th g = let goal_tm = snd g in (* Free variables in the given theorem will not be matched *) let local_consts = frees (concl th) in (* Apply the pattern *) let goal_subterm_path = if pat = [] then "" else match_subterm_in_context (hd pat) goal_tm g in let goal_subterm = follow_path goal_subterm_path goal_tm in (* Local rewrite function *) let rewrite th = let concl_th = concl th in let cond_flag = is_imp concl_th in let match_fun = lhs o (if cond_flag then rand else I) in (* Match the theorem *) let lhs_tm = match_fun concl_th in let ii, flag, path = find_term_inst local_consts lhs_tm goal_subterm goal_subterm_path in if not flag then failwith (string_of_term lhs_tm ^ " does not match any subterm in the goal") else let matched_th = INSTANTIATE ii th in let matched_tm = (match_fun o concl) matched_th in (* Find all matched subterms *) let paths = find_all_paths (fun x -> aconv x matched_tm) goal_tm in let paths = if occ = [] then paths else map (fun i -> List.nth paths (i - 1)) occ in (* Find all free variables in the matched theorem which do not correspond to free variables in the matched subterm *) let tm_frees = frees matched_tm in let mth_frees = frees (concl matched_th) in let vars = subtract mth_frees (union local_consts tm_frees) in if vars = [] then (* Construct the tactic for rewriting *) let r_tac = fun th -> MAP_EVERY (fun path -> CONV_TAC (path_rewrite path th)) paths in if cond_flag then MP_TAC matched_th THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN r_tac] else r_tac matched_th else let rec gen_vars vars th = match vars with | v :: vs -> gen_vars vs (GEN v th) | [] -> th in let th2 = gen_vars vars matched_th in MP_TAC th2 THEN PURE_REWRITE_TAC[LEFT_IMP_FORALL_THM] in (* Try to rewrite with all given theorems *) let th_list = break_conjuncts th in let rec my_first th_list = if length th_list = 1 then rewrite (hd th_list) g else try rewrite (hd th_list) g with Failure _ -> my_first (tl th_list) in my_first th_list;; (* let th = ARITH_RULE `!n. n * 0 <= 1`;; let tm = `m * 0 <= 1 <=> T`;; g tm;; e(new_rewrite [] [] th);; let th = CONJ REAL_MUL_RINV REAL_MUL_LINV;; let tm = `inv (x - y) * (x - y) + &1 = &1 + inv (x - y) * (x - y) + x * inv x`;; let tm0 = `!x. inv (x - y) * (x - y) = &1`;; g tm0;; e(new_rewrite [] [] (th));; e(new_rewrite [] [] (GSYM th));; e(new_rewrite [] [`_ + &1`] th);; g(`x < 2`);; e(new_rewrite [] [] (ARITH_RULE `!x. x > 2 ==> (!n. n = 2 ==> ~(x < n))`));; *) (* Rewrite tactic for usual and conditional theorems *) let rewrite occ pat th g = let rec match_theorem ffun th tm str = try (PART_MATCH ffun th tm, true, str) with Failure _ -> match tm with | Comb(l_tm, r_tm) -> let r_th, flag, s = match_theorem ffun th l_tm (str ^ "l") in if flag then (r_th, flag, s) else match_theorem ffun th r_tm (str ^ "r") | Abs(_, b_tm) -> match_theorem ffun th b_tm (str ^ "b") | _ -> (th, false, str) in (* Initialize auxiliary variables *) let goal_tm = snd g in let th0 = PURE_REWRITE_RULE[IMP_IMP] th in let concl_th = concl (SPEC_ALL th0) in let cond_flag = is_imp concl_th in let eq_tm = if cond_flag then rand concl_th else concl_th in let match_fun = (if is_eq eq_tm then lhand else I) o (if cond_flag then rand else I) in (* Apply the pattern *) let goal_subterm_path = if pat = [] then "" else match_subterm_in_context (hd pat) goal_tm g in let goal_subterm = follow_path goal_subterm_path goal_tm in (* Match the theorem *) let matched_th, flag, path = match_theorem match_fun th0 goal_subterm goal_subterm_path in if not flag then failwith "lhs does not match any term in the goal" else let matched_tm = (match_fun o concl) matched_th in (* Find all matched subterms *) let paths = find_all_paths (fun x -> x = matched_tm) goal_tm in let paths = if occ = [] then paths else map (fun i -> List.nth paths (i - 1)) occ in (* Find all free variables in the matched theorem which do not correspond to free variables in the matched subterm *) let tm_frees = frees matched_tm in let th_frees = frees (concl th0) in let mth_frees = frees (concl matched_th) in let vars = subtract mth_frees (union th_frees tm_frees) in if vars = [] then let r_tac = fun th -> MAP_EVERY (fun path -> GEN_REWRITE_TAC (PATH_CONV path) [th]) paths in if cond_flag then (MP_TAC matched_th THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN r_tac]) g else (r_tac matched_th) g else let rec gen_vars vars th = match vars with | v :: vs -> gen_vars vs (GEN v th) | [] -> th in let th2 = gen_vars vars matched_th in (MP_TAC th2 THEN REWRITE_TAC[LEFT_IMP_FORALL_THM]) g;; (* Analogue of the "done" tactic in SSReflect *) let done_tac = ASM_REWRITE_TAC[] THEN FAIL_TAC "done: not all subgoals are proved";; (* Simplification: /= *) let simp_tac = SIMP_TAC[];; (* Linear arithmetic simplification *) let arith_tac = FIRST [ARITH_TAC; REAL_ARITH_TAC; INT_ARITH_TAC];; (* split *) let split_tac = FIRST [CONJ_TAC; EQ_TAC];; (* Creates an abbreviation for the given term with the given name *) let set_tac name tm (g : goal) = let goal_tm = snd g in let tm0 = try follow_path (match_subterm_in_context tm goal_tm g) goal_tm with Failure _ -> tm in let tm1 = inst_all_free_vars tm0 g in let abbrev_tm = mk_eq (mk_var (name, type_of tm1), tm1) in (ABBREV_TAC abbrev_tm THEN POP_ASSUM (LABEL_TAC (name ^ "_def"))) g;; (* Generates a fresh name for the given term *) (* taking into account names of the provided variables *) let generate_fresh_name names tm = let rec find_name prefix n = let name = prefix ^ (if n = 0 then "" else string_of_int n) in if can (find (fun str -> str = name)) names then find_name prefix (n + 1) else name in let prefix = if is_var tm then (fst o dest_var) tm else "x" in find_name prefix 0;; (* Returns a variable which name does not conflict with names of given vars *) let get_fresh_var var vars = let names = map (fst o dest_var) vars in mk_var (generate_fresh_name names var, type_of var);; (* Matches all wild cards in the term and *) (* instantinates all type variables in the given context *) let prepare_term tm (g : goal) = let goal_tm = snd g in let tm0 = try follow_path (match_subterm_in_context tm goal_tm g) goal_tm with Failure _ -> tm in inst_all_free_vars tm0 g;; (* Discharges a term by generalizing all occurences of this term first *) let disch_tm_tac occs tm (g : goal) = let tm0 = prepare_term tm g in let name = generate_fresh_name ((fst o unzip) (get_context_vars g)) tm in let new_tm = mk_var (name, type_of tm0) in let new_tm1 = if occs = [] && is_var tm then mk_var ((fst o dest_var) tm, type_of tm0) else new_tm in let abbrev_tm = mk_eq (new_tm, tm0) in (ABBREV_TAC abbrev_tm THEN EXPAND_TAC name THEN POP_ASSUM (fun th -> TRY (new_rewrite occs [] th)) THEN SPEC_TAC (new_tm, new_tm1)) g;; (* Discharges a theorem or a term *) let disch_tac occs arg = match arg with | Arg_theorem th -> MP_TAC th | Arg_term tm -> disch_tm_tac occs tm | _ -> failwith "disch_tac: a type cannot be discharged";; (* process_thm *) let process_thm = let conj_imp = TAUT `(A /\ B ==> C) ==> (A ==> B ==> C)` in let dummy_tm = `F` in fun local_consts -> let rec process th = let ctm = concl th in (* forall *) if is_forall ctm then let (var_tm, _) = dest_forall ctm in let var = get_fresh_var var_tm (thm_frees th @ local_consts) in let th1 = SPEC var th in let list, th0 = process th1 in ("spec", var) :: list, th0 (* P ==> Q *) else if is_imp ctm then let ant_tm, _ = dest_imp ctm in (* P /\ R ==> Q *) if is_conj ant_tm then let th1 = MATCH_MP conj_imp th in let list, th0 = process th1 in ("conj", dummy_tm) :: list, th0 (* P ==> Q *) else let th1 = UNDISCH th in let list, th0 = process th1 in ("undisch", ant_tm) :: list, th0 else [], th in process;; (* reconstruct_thm *) let reconstruct_thm = let imp_conj = TAUT `(A ==> B ==> C) ==> (A /\ B ==> C)` in let triv_ths = TAUT `((T ==> A) <=> A) /\ ((T /\ A) = A) /\ ((A /\ T) = A)` in let rec reconstruct list th = match list with | [] -> th | cmd :: t -> let th1 = match cmd with | ("spec", (_ as tm)) -> GEN tm th | ("conj", _) -> MATCH_MP imp_conj th | ("undisch", (_ as tm)) -> DISCH tm th | _ -> failwith ("Unknown command: " ^ fst cmd) in reconstruct t th1 in fun (cmd_list, th) -> let th1 = reconstruct (rev cmd_list) th in PURE_REWRITE_RULE[triv_ths] th1;; (* spec_var_th *) let spec_var_th th n tm = let cmd, th0 = process_thm (frees tm) th in let ty = type_of tm in let rec spec n list head = match list with | ("spec", (_ as var_tm)) :: t -> (try let ty_ii = type_match (type_of var_tm) ty [] in if n <= 1 then let th1 = reconstruct_thm (list, th0) in let th2 = ISPEC tm th1 in let tail, th0 = process_thm [] th2 in let head1 = map (fun s, tm -> s, inst ty_ii tm) head in head1 @ tail, th0 else spec (n - 1) t (head @ [hd list]) with Failure _ -> spec n t (head @ [hd list])) | h :: t -> spec n t (head @ [h]) | [] -> failwith ("spec_var_th") in reconstruct_thm (spec n cmd []);; (* match_mp_th *) let match_mp_th ith n th = let lconsts = thm_frees ith in let cmd, th0 = process_thm (thm_frees th) ith in let tm = concl th in let rec rec_match n list head = match list with | ("undisch", (_ as tm0)) :: t -> (try let ii = term_match lconsts tm0 tm in if n <= 1 then let th1 = INSTANTIATE_ALL ii th0 in let th2 = PROVE_HYP th th1 in let list0 = head @ (("undisch", `T`) :: t) in let f_vars = frees tm0 in let list1 = filter (fun s, tm -> not (s = "spec" && mem tm f_vars)) list0 in let list = map (fun s, tm -> s, instantiate ii tm) list1 in list, th2 else rec_match (n - 1) t (head @ [hd list]) with Failure _ -> rec_match n t (head @ [hd list])) | h :: t -> rec_match n t (head @ [h]) | [] -> failwith "match_mp_th: no match" in let r = rec_match n cmd [] in reconstruct_thm r;; (* Introduces a subgoal *) let have_gen_tac binders then_tac tm (g : goal) = (* let tm0 = inst_all_free_vars tm g in *) let tm1 = gen_variables binders tm in let tm2 = prepare_term tm1 g in (THENL_FIRST (SUBGOAL_THEN tm2 (fun th -> MP_TAC th THEN then_tac)) (move binders)) g;; let have_tac then_tac tm (g : goal) = (* let tm0 = inst_all_free_vars tm g in *) let tm0 = prepare_term tm g in (SUBGOAL_THEN tm0 (fun th -> MP_TAC th THEN then_tac)) g;; (* 'wlog' tactic *) let wlog_tac then_tac vars tm (g : goal) = (* let tm0 = inst_all_free_vars tm g in *) let tm0 = prepare_term tm g in let vars0 = map (fun tm -> inst_all_free_vars tm g) vars in let g_tm = snd g in let imp = list_mk_forall (vars0, mk_imp (tm0, g_tm)) in (THENL_ROT 1 (SUBGOAL_THEN imp (fun th -> MP_TAC th THEN then_tac) THENL [REPLICATE_TAC (length vars) GEN_TAC; ALL_TAC])) g;; (* Provides a witness for an existential goal *) let exists_tac tm (g : goal) = let tm0 = inst_all_free_vars tm g in let target_ty = (type_of o fst o dest_exists o snd) g in let inst_ty = type_match (type_of tm0) target_ty [] in let tm1 = inst inst_ty tm0 in (EXISTS_TAC tm1) g;; (* Instantiates the first type variable in the given theorem *) let inst_first_type th ty = let ty_vars = type_vars_in_term (concl th) in if ty_vars = [] then failwith "inst_first_type: no type variables in the theorem" else INST_TYPE [(ty, hd ty_vars)] th;; (* The first argument must be a theorem, the second argument is arbitrary *) let combine_args arg1 arg2 = let th1 = get_arg_thm arg1 in let th0 = match arg2 with | Arg_theorem th2 -> (try MATCH_MP th1 th2 with Failure _ -> match_mp_th th1 1 th2) | Arg_term tm2 -> (try ISPEC tm2 th1 with Failure _ -> spec_var_th th1 1 tm2) | Arg_type ty2 -> inst_first_type th1 ty2 in Arg_theorem th0;; let use_arg_then_result = ref TRUTH;; let use_arg_then id (arg_tac:arg_type->tactic) (g:goal) = let list = fst g in let arg = try let assumption = assoc id list in Arg_theorem assumption with Failure _ -> try let vars = get_context_vars g in let var = assoc id vars in Arg_term var with Failure _ -> let lexbuf = Lexing.from_string ("use_arg_then_result := " ^ id ^ ";;") in let ast = (!Toploop.parse_toplevel_phrase) lexbuf in let _ = try Toploop.execute_phrase false Format.std_formatter ast with _ -> failwith ("Bad identifier: " ^ id) in Arg_theorem !use_arg_then_result in arg_tac arg g;; let combine_args_then (tac:arg_type->tactic) arg1 arg2 (g:goal) = let th1 = get_arg_thm arg1 in let th0 = match arg2 with | Arg_theorem th2 -> (try MATCH_MP th1 th2 with Failure _ -> match_mp_th th1 1 th2) | Arg_term tm2 -> let tm0 = prepare_term tm2 g in (try ISPEC tm0 th1 with Failure _ -> spec_var_th th1 1 tm0) | Arg_type ty2 -> inst_first_type th1 ty2 in tac (Arg_theorem th0) g;; (* Specializes a variable and applies the next tactic *) let ispec_then tm (tac : thm_tactic) th (g : goal) = let tm0 = prepare_term tm g in let th0 = try ISPEC tm0 th with Failure _ -> spec_var_th th 1 tm0 in tac th0 g;; let ISPEC_THEN tm (tac : thm_tactic) th (g : goal) = let tm0 = inst_all_free_vars tm g in tac (ISPEC tm0 th) g;; let USE_THM_THEN th (tac : thm_tactic) = tac th;; let MATCH_MP_THEN th2 (tac : thm_tactic) th1 = tac (MATCH_MP th1 th2);; let match_mp_then th2 (tac : thm_tactic) th1 = let th0 = try MATCH_MP th1 th2 with Failure _ -> match_mp_th th1 1 th2 in tac th0;; let GSYM_THEN (tac : thm -> tactic) th = tac (GSYM th);; let gsym_then (tac:arg_type->tactic) arg = tac (Arg_theorem (GSYM (get_arg_thm arg)));; (* The 'apply' tactic *) let apply_tac th g = let rec try_match th = try MATCH_MP_TAC th g with Failure _ -> let th0 = PURE_ONCE_REWRITE_RULE[IMP_IMP] th in if th = th0 then failwith "apply_tac: no match" else try_match th0 in try MATCH_ACCEPT_TAC th g with Failure _ -> try_match th;; (*let apply_tac th = FIRST [MATCH_ACCEPT_TAC th; MATCH_MP_TAC th];; *) (* The 'exact' tactic *) (* TODO: do [done | by move => top; apply top], here apply top works as ACCEPT_TAC with matching (rewriting) in some cases *) let exact_tac = FIRST [done_tac; DISCH_THEN (fun th -> apply_tac th) THEN done_tac];; (* Specializes the theorem using the given set of variables *) let spec0 names vars = let find name = try (assoc name vars, true) with Failure _ -> (parse_term name, false) in let find_type var = let name, ty = dest_var var in let t, flag = find name in if flag then (ty, type_of t) else (`:bool`, `:bool`) in let inst_term tm = let ty_src, ty_dst = unzip (map find_type (frees tm)) in let ty_inst = itlist2 type_match ty_src ty_dst [] in inst ty_inst tm in let list = map find names in let tm_list = map (fun tm, flag -> if flag then tm else inst_term tm) list in ISPECL tm_list;; let spec names = spec0 names (get_context_vars (top_realgoal()));; let spec_mp names th g = MP_TAC (spec0 names (get_context_vars g) th) g;; (* Case theorems *) let bool_cases = ONCE_REWRITE_RULE[CONJ_ACI] bool_INDUCT;; let list_cases = prove(`!P. P [] /\ (!(h:A) t. P (CONS h t)) ==> (!l. P l)`, REPEAT STRIP_TAC THEN MP_TAC (SPEC `l:(A)list` list_CASES) THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (CHOOSE_THEN MP_TAC) THEN DISCH_THEN (CHOOSE_THEN MP_TAC) THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[th]));; let pair_cases = pair_INDUCT;; let num_cases = prove(`!P. P 0 /\ (!n. P (SUC n)) ==> (!m. P m)`, REPEAT STRIP_TAC THEN MP_TAC (SPEC `m:num` num_CASES) THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (CHOOSE_THEN (fun th -> ASM_REWRITE_TAC[th])));; let option_cases = option_INDUCT;; let cases_table = Hashtbl.create 10;; Hashtbl.add cases_table "bool" bool_cases;; Hashtbl.add cases_table "list" list_cases;; Hashtbl.add cases_table "prod" pair_cases;; Hashtbl.add cases_table "num" num_cases;; Hashtbl.add cases_table "option" option_cases;; (* Induction theorems *) let bool_elim = bool_cases;; let list_elim = list_INDUCT;; let pair_elim = pair_INDUCT;; let num_elim = num_INDUCTION;; let option_elim = option_INDUCT;; let elim_table = Hashtbl.create 10;; Hashtbl.add elim_table "bool" bool_elim;; Hashtbl.add elim_table "list" list_elim;; Hashtbl.add elim_table "prod" pair_elim;; Hashtbl.add elim_table "num" num_elim;; Hashtbl.add elim_table "option" option_elim;; (* case: works only for (A /\ B) -> C; (A \/ B) -> C; (?x. P) -> Q; !(n:num). P; !(l:list(A)). P *) let case (g:goal) = let goal_tm = snd g in if not (is_imp goal_tm) then (* !a. P *) if is_forall goal_tm then let var, _ = dest_forall goal_tm in let ty_name = (fst o dest_type o type_of) var in let case_th = Hashtbl.find cases_table ty_name in (MATCH_MP_TAC case_th THEN REPEAT CONJ_TAC) g else failwith "case: not imp or forall" else let tm = lhand goal_tm in (* A /\ B *) if is_conj tm then (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM MP_TAC) g (* A \/ B *) else if is_disj tm then (DISCH_THEN DISJ_CASES_TAC THEN POP_ASSUM MP_TAC) g (* ?x. P *) else if is_exists tm then (ONCE_REWRITE_TAC[GSYM LEFT_FORALL_IMP_THM]) g else failwith "case: not implemented";; (* elim: works only for num and list *) let elim (g:goal) = let goal_tm = snd g in (* !a. P *) if is_forall goal_tm then let var, _ = dest_forall goal_tm in let ty_name = (fst o dest_type o type_of) var in let induct_th = Hashtbl.find elim_table ty_name in (MATCH_MP_TAC induct_th THEN REPEAT CONJ_TAC) g else failwith "elim: not forall";; (* Instantiates the first type variable in the given theorem *) let INST_FIRST_TYPE_THEN ty (then_tac:thm_tactic) th = let ty_vars = type_vars_in_term (concl th) in if ty_vars = [] then failwith "inst_first_type: no type variables in the theorem" else then_tac (INST_TYPE [(ty, hd ty_vars)] th);; (* Replaces all occurrences of distinct '_' with unique variables *) let transform_pattern pat_tm = let names = ref (map (fst o dest_var) (frees pat_tm)) in let rec transform tm = match tm with | Abs(x_tm, b_tm) -> let _ = names := (fst o dest_var) x_tm :: !names in mk_abs (x_tm, transform b_tm) | Comb(l_tm, r_tm) -> mk_comb (transform l_tm, transform r_tm) | Var ("_", ty) -> let name = generate_fresh_name !names tm in let _ = names := name :: !names in mk_var (name, ty) | _ -> tm in transform pat_tm;; let wild_frees tm = filter (fun tm -> ((fst o dest_var) tm).[0] = '_') (frees tm);; let nwild_frees tm = filter (fun tm -> ((fst o dest_var) tm).[0] <> '_') (frees tm);; (* congr_tac *) let congr_tac pat_tm goal = let goal_tm = snd goal in let context_vars = get_context_vars goal in let pat = transform_pattern pat_tm in let f0_vars = nwild_frees pat in let pattern = inst_context_vars context_vars f0_vars pat in let const_pat = nwild_frees pattern in let wild_pat = wild_frees pattern in let lhs, rhs = dest_eq goal_tm in let lm, rm = term_match const_pat pattern lhs, term_match const_pat pattern rhs in let eq_tms = map (fun tm -> mk_eq (instantiate lm tm, instantiate rm tm)) wild_pat in let eq_tm = itlist (curry mk_imp) eq_tms goal_tm in let eq_thm = EQT_ELIM (SIMP_CONV[] eq_tm) in (apply_tac eq_thm THEN REPEAT CONJ_TAC) goal;; (* Eliminates the first antecedent of a goal *) let elim_fst_ants_tac = let gen_elim_thm tm = let vars, tm1 = strip_forall tm in let ants_tm, concl_tm = dest_imp tm1 in let th1 = ASSUME (itlist (curry mk_forall) vars concl_tm) in let th2 = DISCH ants_tm (SPECL vars th1) in DISCH_ALL (itlist GEN vars th2) in fun (g:goal) -> let goal_tm = snd g in let elim_th = gen_elim_thm goal_tm in MATCH_MP_TAC elim_th g;; (* If a goal has the form ssreflect_eq ==> P then the equality is introduced as an assumption. If a goal has the form !x. ssreflect_eq ==> P then the equality is eliminated *) let process_fst_eq_tac (g:goal) = let vars, g_tm = strip_forall (snd g) in let tac = try let eq_tm = (rator o fst o dest_imp) g_tm in let label = (fst o dest_var o rand) eq_tm in if (fst o dest_const o rator) eq_tm = "ssreflect_eq" then if length vars = 0 then DISCH_THEN (LABEL_TAC label o PURE_ONCE_REWRITE_RULE[ssreflect_eq_def]) else elim_fst_ants_tac else ALL_TAC with Failure _ -> ALL_TAC in tac g;; (* Discharges a term by generalizing all occurences of this term first *) let disch_tm_eq_tac eq_name occs tm (g : goal) = let tm0 = prepare_term tm g in let name = generate_fresh_name ((fst o unzip) (get_context_vars g)) tm in let eq_var = mk_var (eq_name, aty) in let new_tm = mk_var (name, type_of tm0) in let abbrev_tm = mk_eq (new_tm, tm0) in (ABBREV_TAC abbrev_tm THEN EXPAND_TAC name THEN FIRST_ASSUM (fun th -> TRY (new_rewrite occs [] th)) THEN POP_ASSUM (MP_TAC o PURE_ONCE_REWRITE_RULE[GSYM (SPEC eq_var ssreflect_eq_def)]) THEN SPEC_TAC (new_tm, new_tm)) g;; (* Discharges a term and generates an equality *) let disch_eq_tac eq_name occs arg = disch_tm_eq_tac eq_name occs (get_arg_term arg);; hol-light/Formal_ineqs/lib/ssrfun-compiled.hl000066400000000000000000000463461303454263000216060ustar00rootroot00000000000000let oapp = define `!f x y. oapp f x (SOME y) = f y /\ oapp f x NONE = x`;; let odflt = new_definition `odflt = oapp I`;; let obind = new_definition `obind f = oapp f NONE`;; let omap = new_definition `omap f = obind (\x. SOME (f x))`;; let pcomp = new_definition `pcomp f g x = obind f (g x)`;; (* Lemma odflt_alt *) let odflt_alt = section_proof ["x"] `(!y. odflt x (SOME y) = y) /\ odflt x NONE = x` [ (((((use_arg_then "odflt")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "oapp")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "I_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma obind_alt *) let obind_alt = section_proof ["f"] `obind f NONE = NONE /\ (!x. obind f (SOME x) = f x)` [ (((((use_arg_then "obind")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "oapp")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma omap_alt *) let omap_alt = section_proof ["f"] `omap f NONE = NONE /\ (!x. omap f (SOME x) = SOME (f x))` [ (((((use_arg_then "omap")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "obind")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "oapp")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma eq_sym *) let eq_sym = section_proof ["x";"y"] `x = y ==> y = x` [ ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eq_trans *) let eq_trans = section_proof ["x";"y";"z"] `x = y ==> y = z ==> x = z` [ ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_equal *) let f_equal = section_proof ["f";"x";"y"] `x = y ==> f x = f y` [ ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_equal2 *) let f_equal2 = section_proof ["f";"x1";"y1";"x2";"y2"] `x1 = y1 ==> x2 = y2 ==> f x1 x2 = f y1 y2` [ ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; let erefl = eq_sym;; let esym = eq_sym;; let etrans = eq_trans;; let congr1 = f_equal;; let congr2 = f_equal2;; (* Lemma eq_ext *) let eq_ext = section_proof ["f";"g"] `(!x. f x = g x) <=> f = g` [ (((THENL) (split_tac) [(DISCH_THEN (fun snd_th -> (use_arg_then "EQ_EXT") (thm_tac (match_mp_then snd_th MP_TAC)))); (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))]) THEN (done_tac)); ];; (* Section Injections *) begin_section "Injections";; (add_section_var (mk_var ("f", (`:A -> R`))));; let injective = new_definition `injective f <=> (!x1 x2. f x1 = f x2 ==> x1 = x2)`;; let cancel = new_definition `cancel f g <=> !x. g (f x) = x`;; let pcancel = new_definition `pcancel f g <=> !x. g (f x) = SOME x`;; let ocancel = new_definition `ocancel g h <=> !x. oapp h x (g x) = x`;; (* Lemma can_pcan *) let can_pcan = section_proof ["g"] `cancel f g ==> pcancel f (\y. SOME (g y))` [ (((((use_arg_then "cancel")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "pcancel")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma pcan_inj *) let pcan_inj = section_proof ["g"] `pcancel f g ==> injective f` [ (((((use_arg_then "pcancel")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "injective")(thm_tac (new_rewrite [] []))))) THEN (move ["can"]) THEN (move ["x1"]) THEN (move ["x2"]) THEN (move ["f_eq"])); ((((fun arg_tac -> (use_arg_then "can") (fun fst_arg -> (use_arg_then "x2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (use_arg_then "can") (fun fst_arg -> (use_arg_then "x1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "f_eq")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (injectivity "option")))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma can_inj *) let can_inj = section_proof ["g"] `cancel f g ==> injective f` [ (((((use_arg_then "cancel")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "injective")(thm_tac (new_rewrite [] []))))) THEN (move ["can"]) THEN (move ["x1"]) THEN (move ["x2"]) THEN (move ["f_eq"])); (((((fun arg_tac -> (use_arg_then "can") (fun fst_arg -> (use_arg_then "x1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "can") (fun fst_arg -> (use_arg_then "x2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "f_eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma canLR *) let canLR = section_proof ["g";"x";"y"] `cancel f g ==> x = f y ==> g x = y` [ (((((use_arg_then "cancel")(thm_tac (new_rewrite [] [])))) THEN (move ["can"]) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma canRL *) let canRL = section_proof ["g";"x";"y"] `cancel f g ==> f x = y ==> x = g y` [ (((((use_arg_then "cancel")(thm_tac (new_rewrite [] [])))) THEN (move ["can"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section Injections *) let can_pcan = finalize_theorem can_pcan;; let pcan_inj = finalize_theorem pcan_inj;; let can_inj = finalize_theorem can_inj;; let canLR = finalize_theorem canLR;; let canRL = finalize_theorem canRL;; end_section "Injections";; (* Lemma some_inj *) let some_inj = section_proof [] `injective SOME` [ (((((use_arg_then "injective")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (injectivity "option")))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Section InjectionsTheory *) begin_section "InjectionsTheory";; (add_section_var (mk_var ("f", (`:B -> A`))); add_section_var (mk_var ("g", (`:B -> A`))));; (add_section_var (mk_var ("h", (`:C -> B`))));; (* Lemma inj_id *) let inj_id = section_proof [] `injective I` [ (((((use_arg_then "injective")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "I_THM")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma inj_can_sym *) let inj_can_sym = section_proof ["f'"] `cancel f f' ==> injective f' ==> cancel f' f` [ (((repeat_tactic 2 0 (((use_arg_then "cancel")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "injective")(thm_tac (new_rewrite [] []))))) THEN (move ["can1"]) THEN (move ["inj"]) THEN (move ["x"])); ((((use_arg_then "inj") (disch_tac [])) THEN (clear_assumption "inj") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "can1")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma inj_comp *) let inj_comp = section_proof [] `injective f ==> injective h ==> injective (f o h)` [ (((repeat_tactic 3 0 (((use_arg_then "injective")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 2 0 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN (move ["inj_f"]) THEN (move ["inj_h"]) THEN (move ["x1"]) THEN (move ["x2"])); ((BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "inj_f") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "inj_h") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (done_tac)); ];; (* Lemma can_comp *) let can_comp = section_proof ["f'";"h'"] `cancel f f' ==> cancel h h' ==> cancel (f o h) (h' o f')` [ ((((repeat_tactic 3 0 (((use_arg_then "cancel")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 2 0 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN (move ["f_can"]) THEN (move ["h_can"]) THEN (move ["x"])) THEN (done_tac)); ];; (* Lemma pcan_pcomp *) let pcan_pcomp = section_proof ["f'";"h'"] `pcancel f f' ==> pcancel h h' ==> pcancel (f o h) (pcomp h' f')` [ ((((repeat_tactic 3 0 (((use_arg_then "pcancel")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "pcomp")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "obind")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "oapp")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eq_inj *) let eq_inj = section_proof [] `injective f ==> (!x. f x = g x) ==> injective g` [ (((((use_arg_then "eq_ext")(thm_tac (new_rewrite [] [])))) THEN (move ["inj"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma eq_can *) let eq_can = section_proof ["f'";"g'"] `cancel f f' ==> (!x. f x = g x) ==> (!x. f' x = g' x) ==> cancel g g'` [ (((repeat_tactic 1 9 (((use_arg_then "eq_ext")(thm_tac (new_rewrite [] []))))) THEN (move ["can"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma inj_can_eq *) let inj_can_eq = section_proof ["f'"] `cancel f f' ==> injective f' ==> cancel g f' ==> f = g` [ ((((repeat_tactic 2 0 (((use_arg_then "cancel")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "injective")(thm_tac (new_rewrite [] []))))) THEN (move ["f_can"]) THEN (move ["inj"]) THEN (move ["g_can"])) THEN ((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["x"]))); ((((use_arg_then "inj") (disch_tac [])) THEN (clear_assumption "inj") THEN (DISCH_THEN apply_tac)) THEN (done_tac)); ];; (* Finalization of the section InjectionsTheory *) let inj_id = finalize_theorem inj_id;; let inj_can_sym = finalize_theorem inj_can_sym;; let inj_comp = finalize_theorem inj_comp;; let can_comp = finalize_theorem can_comp;; let pcan_pcomp = finalize_theorem pcan_pcomp;; let eq_inj = finalize_theorem eq_inj;; let eq_can = finalize_theorem eq_can;; let inj_can_eq = finalize_theorem inj_can_eq;; end_section "InjectionsTheory";; (* Section Bijections *) begin_section "Bijections";; (add_section_var (mk_var ("f", (`:B -> A`))));; let bijective = new_definition `bijective f <=> ?g. cancel f g /\ cancel g f`;; (add_section_hyp "bijf" (`bijective f`));; (* Lemma bij_inj *) let bij_inj = section_proof [] `injective f` [ ((((use_arg_then "bijf") (disch_tac [])) THEN (clear_assumption "bijf") THEN BETA_TAC) THEN ((((use_arg_then "bijective")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["g"])) THEN (case THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "can_inj") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ];; (* Lemma bij_can_sym *) let bij_can_sym = section_proof ["f'"] `cancel f' f <=> cancel f f'` [ ((THENL_FIRST) (split_tac) (((DISCH_THEN (fun snd_th -> (use_arg_then "inj_can_sym") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "bij_inj") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC))) THEN (done_tac))); ((((use_arg_then "bijf") (disch_tac [])) THEN (clear_assumption "bijf") THEN BETA_TAC) THEN ((((use_arg_then "bijective")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["g"])) THEN (case THEN ALL_TAC)) THEN ((repeat_tactic 1 9 (((use_arg_then "cancel")(thm_tac (new_rewrite [] []))))) THEN (move ["gf"]) THEN (move ["fg"]) THEN (move ["f'f"]) THEN (move ["x"]))); (((((fun arg_tac -> (use_arg_then "fg") (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "f'f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma bij_can_eq *) let bij_can_eq = section_proof ["f'";"f''"] `cancel f f' ==> cancel f f'' ==> f' = f''` [ (((((fun arg_tac -> (use_arg_then "bij_can_sym") (fun fst_arg -> (use_arg_then "f''") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "bij_can_sym")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["can1"]) THEN (move ["can2"])); ((((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "inj_can_eq") (fun fst_arg -> (use_arg_then "can1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "bij_inj") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "can2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (done_tac)); ];; (* Finalization of the section Bijections *) let bij_inj = finalize_theorem bij_inj;; let bij_can_sym = finalize_theorem bij_can_sym;; let bij_can_eq = finalize_theorem bij_can_eq;; end_section "Bijections";; (* Section BijectionsTheory *) begin_section "BijectionsTheory";; (add_section_var (mk_var ("f", (`:BB -> AA`))));; (add_section_var (mk_var ("h", (`:CC -> BB`))));; (* Lemma eq_bij *) let eq_bij = section_proof [] `bijective f ==> !g. (!x. f x = g x) ==> bijective g` [ (((((use_arg_then "eq_ext")(thm_tac (new_rewrite [] [])))) THEN (move ["bij"]) THEN (move ["g"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma bij_comp *) let bij_comp = section_proof [] `bijective f ==> bijective h ==> bijective (f o h)` [ ((repeat_tactic 3 0 (((use_arg_then "bijective")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["g"])) THEN (case THEN ((move ["can_fg"]) THEN (move ["can_gf"]))) THEN (case THEN ((move ["r"]) THEN (case THEN ((move ["can_hr"]) THEN (move ["can_rh"])))))); (((fun arg_tac -> arg_tac (Arg_term (`r o g`))) (term_tac exists_tac)) THEN (split_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "can_comp") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "r") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "can_fg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC) THEN (DISCH_THEN apply_tac) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "can_comp") (fun fst_arg -> (use_arg_then "r") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "can_rh") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC) THEN (DISCH_THEN apply_tac) THEN (done_tac)); ];; (* Lemma bij_can_bij *) let bij_can_bij = section_proof [] `bijective f ==> !f'. cancel f f' ==> bijective f'` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "bij_can_sym") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["can_sym"]) THEN (move ["f'"]) THEN (move ["can_ff'"])) THEN (((use_arg_then "bijective")(thm_tac (new_rewrite [] []))))); (((use_arg_then "f") (term_tac exists_tac)) THEN (((use_arg_then "can_sym")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Finalization of the section BijectionsTheory *) let eq_bij = finalize_theorem eq_bij;; let bij_comp = finalize_theorem bij_comp;; let bij_can_bij = finalize_theorem bij_can_bij;; end_section "BijectionsTheory";; (* Section Involutions *) begin_section "Involutions";; (add_section_var (mk_var ("f", (`:A -> A`))));; let involutive = new_definition `involutive f <=> cancel f f`;; (add_section_hyp "Hf" (`involutive f`));; (* Lemma inv_inj *) let inv_inj = section_proof [] `injective f` [ ((((use_arg_then "Hf") (disch_tac [])) THEN (clear_assumption "Hf") THEN BETA_TAC) THEN ((((use_arg_then "involutive")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "can_inj") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (done_tac)); ];; (* Lemma inv_bij *) let inv_bij = section_proof [] `bijective f` [ ((((use_arg_then "bijective")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "f") (term_tac exists_tac)) THEN (((use_arg_then "Hf") (disch_tac [])) THEN (clear_assumption "Hf") THEN BETA_TAC) THEN (((use_arg_then "involutive")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Finalization of the section Involutions *) let inv_inj = finalize_theorem inv_inj;; let inv_bij = finalize_theorem inv_bij;; end_section "Involutions";; (* Section OperationProperties *) begin_section "OperationProperties";; (* Section SopTisR *) begin_section "SopTisR";; let left_inverse = new_definition `left_inverse e inv op = !x. op (inv x) x = e`;; let right_inverse = new_definition `right_inverse e inv op = !x. op x (inv x) = e`;; let left_injective = new_definition `left_injective op = !x. injective (\y. op y x)`;; let right_injective = new_definition `right_injective op = !y. injective (op y)`;; (* Finalization of the section SopTisR *) end_section "SopTisR";; (* Section SopTisS *) begin_section "SopTisS";; let right_id = new_definition `right_id e op = !x. op x e = x`;; let left_zero = new_definition `left_zero z op = !x. op z x = z`;; let right_commutative = new_definition `right_commutative op = !x y z. op (op x y) z = op (op x z) y`;; let left_distributive = new_definition `left_distributive op add = !x y z. op (add x y) z = add (op x z) (op y z)`;; let right_loop = new_definition `right_loop inv op = !y. cancel (\x. op x y) (\x. op x (inv y))`;; let rev_right_loop = new_definition `rev_right_loop inv op = !y. cancel (\x. op x (inv y)) (\x. op x y)`;; (* Finalization of the section SopTisS *) end_section "SopTisS";; (* Section SopTisT *) begin_section "SopTisT";; let left_id = new_definition `left_id e op = !x. op e x = x`;; let right_zero = new_definition `right_zero z op = !x. op x z = z`;; let left_commutative = new_definition `left_commutative op = !x y z. op x (op y z) = op y (op x z)`;; let right_distributive = new_definition `right_distributive op add = !x y z. op x (add y z) = add (op x y) (op x z)`;; let left_loop = new_definition `left_loop inv op = !x. cancel (op x) (op (inv x))`;; let rev_left_loop = new_definition `rev_left_loop inv op = !x. cancel (op (inv x)) (op x)`;; (* Finalization of the section SopTisT *) end_section "SopTisT";; (* Section SopSisT *) begin_section "SopSisT";; let self_inverse = new_definition `self_inverse e op = !x. op x x = e`;; let commutative = new_definition `commutative op = !x y. op x y = op y x`;; (* Finalization of the section SopSisT *) end_section "SopSisT";; (* Section SopSisS *) begin_section "SopSisS";; let idempotent = new_definition `idempotent op = !x. op x x = x`;; let associative = new_definition `associative op = !x y z. op x (op y z) = op (op x y) z`;; (* Finalization of the section SopSisS *) end_section "SopSisS";; (* Finalization of the section OperationProperties *) end_section "OperationProperties";; hol-light/Formal_ineqs/lib/ssrnat-compiled.hl000066400000000000000000004030021303454263000215620ustar00rootroot00000000000000needs "lib/ssrbool-compiled.hl";; prioritize_num();; (* Lemma succnK *) let succnK = section_proof ["n"] `SUC n - 1 = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma succn_inj *) let succn_inj = section_proof ["n";"m"] `SUC n = SUC m ==> n = m` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma eqSS *) let eqSS = section_proof ["m";"n"] `(SUC m = SUC n) = (m = n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma add0n *) let add0n = section_proof ["n"] `0 + n = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addSn *) let addSn = section_proof ["m";"n"] `SUC m + n = SUC (m + n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma add1n *) let add1n = section_proof ["n"] `1 + n = SUC n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addn0 *) let addn0 = section_proof ["n"] `n + 0 = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addnS *) let addnS = section_proof ["m";"n"] `m + SUC n = SUC (m + n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addSnnS *) let addSnnS = section_proof ["m";"n"] `SUC m + n = m + SUC n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addnCA *) let addnCA = section_proof ["m";"n";"p"] `m + (n + p) = n + (m + p)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addnC *) let addnC = section_proof ["m";"n"] `m + n = n + m` [ (((((fun arg_tac -> (use_arg_then "addn0") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (((use_arg_then "addnCA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addn0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addn1 *) let addn1 = section_proof ["n"] `n + 1 = SUC n` [ (((((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add1n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addnA *) let addnA = section_proof ["n";"m";"p"] `n + (m + p) = (n + m) + p` [ (((((use_arg_then "addnC")(thm_tac (new_rewrite [] [(`m + p`)])))) THEN (((use_arg_then "addnCA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addnAC *) let addnAC = section_proof ["m";"n";"p"] `(n + m) + p = (n + p) + m` [ (((repeat_tactic 1 9 (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] [(`p + m`)]))))) THEN (done_tac)); ];; (* Lemma addn_eq0 *) let addn_eq0 = section_proof ["m";"n"] `(m + n = 0) <=> (m = 0) /\ (n = 0)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma eqn_addl *) let eqn_addl = section_proof ["p";"m";"n"] `(p + m = p + n) <=> (m = n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma eqn_addr *) let eqn_addr = section_proof ["p";"m";"n"] `(m + p = n + p) = (m = n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addnI *) let addnI = section_proof ["m";"n1";"n2"] `m + n1 = m + n2 ==> n1 = n2` [ ((BETA_TAC THEN (move ["Heq"])) THEN (((fun arg_tac -> (use_arg_then "eqn_addl") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addIn *) let addIn = section_proof ["m";"n1";"n2"] `n1 + m = n2 + m ==> n1 = n2` [ ((repeat_tactic 1 9 (((use_arg_then "addnC")(gsym_then (thm_tac (new_rewrite [] [(`_1 + m`)])))))) THEN (move ["Heq"])); ((((fun arg_tac -> (use_arg_then "addnI") (fun fst_arg -> (use_arg_then "Heq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (done_tac)); ];; (* Lemma sub0n *) let sub0n = section_proof ["n"] `0 - n = 0` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subn0 *) let subn0 = section_proof ["n"] `n - 0 = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subnn *) let subnn = section_proof [] `!n. n - n = 0` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subSS *) let subSS = section_proof [] `!n m. SUC m - SUC n = m - n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subn_add2l *) let subn_add2l = section_proof [] `!p m n. (p + m) - (p + n) = m - n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subn_add2r *) let subn_add2r = section_proof [] `!p m n. (m + p) - (n + p) = m - n` [ (BETA_TAC THEN (move ["p"]) THEN (move ["m"]) THEN (move ["n"])); (((repeat_tactic 1 9 (((use_arg_then "addnC")(gsym_then (thm_tac (new_rewrite [] [(`_1 + p`)])))))) THEN (((use_arg_then "subn_add2l")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addKn *) let addKn = section_proof ["n"] `!x. (n + x) - n = x` [ ((BETA_TAC THEN (move ["m"])) THEN ((((use_arg_then "addn0")(gsym_then (thm_tac (new_rewrite [2] [(`n`)]))))) THEN (((use_arg_then "subn_add2l")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subn0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addnK *) let addnK = section_proof [] `!n x. (x + n) - n = x` [ ((BETA_TAC THEN (move ["n"]) THEN (move ["m"])) THEN ((((fun arg_tac -> (use_arg_then "addnC") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addKn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma subSnn *) let subSnn = section_proof ["n"] `SUC n - n = 1` [ (((((use_arg_then "add1n")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma subn_sub *) let subn_sub = section_proof ["m";"n";"p"] `(n - m) - p = n - (m + p)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subnAC *) let subnAC = section_proof [] `!m n p. (m - n) - p = (m - p) - n` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])) THEN ((repeat_tactic 1 9 (((use_arg_then "subn_sub")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma predn_sub *) let predn_sub = section_proof [] `!m n. (m - n) - 1 = m - SUC n` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"])) THEN ((((use_arg_then "subn_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addn1")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma predn_subS *) let predn_subS = section_proof [] `!m n. (SUC m - n) - 1 = m - n` [ (((((use_arg_then "predn_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subSS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltnS *) let ltnS = section_proof [] `!m n. (m < SUC n) = (m <= n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leq0n *) let leq0n = section_proof [] `!n. 0 <= n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltn0Sn *) let ltn0Sn = section_proof [] `!n. 0 < SUC n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltn0 *) let ltn0 = section_proof [] `!n. n < 0 <=> F` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leqnn *) let leqnn = section_proof [] `!n. n <= n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltnSn *) let ltnSn = section_proof [] `!n. n < SUC n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma eq_leq *) let eq_leq = section_proof [] `!m n. m = n ==> m <= n` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma leqnSn *) let leqnSn = section_proof [] `!n. n <= SUC n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leq_pred *) let leq_pred = section_proof [] `!n. n - 1 <= n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leqSpred *) let leqSpred = section_proof [] `!n. n <= SUC (n - 1)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltn_predK *) let ltn_predK = section_proof [] `!m n. m < n ==> SUC (n - 1) = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma prednK *) let prednK = section_proof [] `!n. 0 < n ==> SUC (n - 1) = n` [ ((BETA_TAC THEN (move ["n"]) THEN (move ["H"])) THEN (((fun arg_tac -> (use_arg_then "ltn_predK") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (exact_tac))); ];; (* Lemma leqNgt *) let leqNgt = section_proof [] `!m n. (m <= n) <=> ~(n < m)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltnNge *) let ltnNge = section_proof [] `!m n. (m < n) = ~(n <= m)` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"])) THEN (((use_arg_then "leqNgt")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma ltnn *) let ltnn = section_proof [] `!n. n < n <=> F` [ ((BETA_TAC THEN (move ["n"])) THEN ((((use_arg_then "ltnNge")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leqn0 *) let leqn0 = section_proof [] `!n. (n <= 0) = (n = 0)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma lt0n *) let lt0n = section_proof [] `!n. (0 < n) = ~(n = 0)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma lt0n_neq0 *) let lt0n_neq0 = section_proof [] `!n. 0 < n ==> ~(n = 0)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma eqn0Ngt *) let eqn0Ngt = section_proof [] `!n. (n = 0) = ~(0 < n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma neq0_lt0n *) let neq0_lt0n = section_proof [] `!n. (n = 0) = F ==> 0 < n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma eqn_leq *) let eqn_leq = section_proof [] `!m n. (m = n) = (m <= n /\ n <= m)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma anti_leq *) let anti_leq = section_proof [] `!m n. m <= n /\ n <= m ==> m = n` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"])) THEN (((use_arg_then "eqn_leq")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma neq_ltn *) let neq_ltn = section_proof [] `!m n. ~(m = n) <=> (m < n) \/ (n < m)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_and")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orbC")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ltnNge")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ];; (* Lemma leq_eqVlt *) let leq_eqVlt = section_proof ["m";"n"] `(m <= n) <=> (m = n) \/ (m < n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma eq_sym *) let eq_sym = section_proof [] `!x y:A. x = y <=> y = x` [ ((((use_arg_then "EQ_SYM_EQ") (disch_tac [])) THEN (clear_assumption "EQ_SYM_EQ") THEN BETA_TAC) THEN (done_tac)); ];; (* Lemma ltn_neqAle *) let ltn_neqAle = section_proof [] `!m n. (m < n) <=> ~(m = n) /\ (m <= n)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((((use_arg_then "ltnNge")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_eqVlt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_or")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqNgt")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eq_sym")(thm_tac (new_rewrite [] [(`n = m`)]))))) THEN (done_tac)); ];; (* Lemma leq_trans *) let leq_trans = section_proof [] `!n m p. m <= n ==> n <= p ==> m <= p` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltE *) let ltE = section_proof [] `!n m. n < m <=> SUC n <= m` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leqSS *) let leqSS = section_proof [] `!n m. SUC n <= SUC m <=> n <= m` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leq_ltn_trans *) let leq_ltn_trans = section_proof [] `!n m p. m <= n ==> n < p ==> m < p` [ (BETA_TAC THEN (move ["n"]) THEN (move ["m"]) THEN (move ["p"]) THEN (move ["Hmn"])); (((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_trans") (disch_tac [])) THEN (clear_assumption "leq_trans") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "leqSS")(thm_tac (new_rewrite [] [])))) THEN (done_tac)) THEN (done_tac)); ];; (* Lemma ltn_leq_trans *) let ltn_leq_trans = section_proof ["n";"m";"p"] `m < n ==> n <= p ==> m < p` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltnW *) let ltnW = section_proof [] `!m n. m < n ==> m <= n` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"])) THEN (((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_trans") (disch_tac [])) THEN (clear_assumption "leq_trans") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "leqnSn")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma leqW *) let leqW = section_proof [] `!m n. m <= n ==> m <= SUC n` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["le_mn"])) THEN (((use_arg_then "ltnW") (disch_tac [])) THEN (clear_assumption "ltnW") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqSS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_trans *) let ltn_trans = section_proof [] `!n m p. m < n ==> n < p ==> m < p` [ (BETA_TAC THEN (move ["n"]) THEN (move ["m"]) THEN (move ["p"]) THEN (move ["lt_mn"])); (((DISCH_THEN (fun snd_th -> (use_arg_then "ltnW") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "leq_trans") (disch_tac [])) THEN (clear_assumption "leq_trans") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma geqE *) let geqE = section_proof [] `!m n. m >= n <=> n <= m` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma gtE *) let gtE = section_proof ["m";"n"] `m > n <=> n < m` [ (arith_tac); ];; (* Lemma leq_total *) let leq_total = section_proof ["m";"n"] `(m <= n) \/ (n <= m)` [ ((((((use_arg_then "implyNb")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ltnNge")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["lt_nm"])) THEN (((use_arg_then "ltnW") (disch_tac [])) THEN (clear_assumption "ltnW") THEN (exact_tac)) THEN (done_tac)); ];; (* Lemma leqP *) let leqP = section_proof ["m";"n"] `m <= n \/ n < m` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltnP *) let ltnP = section_proof ["m";"n"] `m < n \/ n <= m` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma posnP *) let posnP = section_proof ["n"] `n = 0 \/ 0 < n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltngtP *) let ltngtP = section_proof ["m";"n"] `m < n \/ n < m \/ m = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leq_add2l *) let leq_add2l = section_proof [] `!p m n. (p + m <= p + n) = (m <= n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma ltn_add2l *) let ltn_add2l = section_proof [] `!p m n. (p + m < p + n) = (m < n)` [ (BETA_TAC THEN (move ["p"]) THEN (move ["m"]) THEN (move ["n"])); (((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnS")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_add2l")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_add2r *) let leq_add2r = section_proof ["p";"m";"n"] `(m + p <= n + p) = (m <= n)` [ (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "addnC") (fun fst_arg -> (use_arg_then "p") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "leq_add2l")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_add2r *) let ltn_add2r = section_proof [] `!p m n. (m + p < n + p) = (m < n)` [ (BETA_TAC THEN (move ["p"]) THEN (move ["m"]) THEN (move ["n"])); (((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addSn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_add2r")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_add *) let leq_add = section_proof [] `!m1 m2 n1 n2. m1 <= n1 ==> m2 <= n2 ==> m1 + m2 <= n1 + n2` [ (BETA_TAC THEN (move ["m1"]) THEN (move ["m2"]) THEN (move ["n1"]) THEN (move ["n2"]) THEN (move ["le_mn1"]) THEN (move ["le_mn2"])); (((((fun arg_tac -> (use_arg_then "leq_trans") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m1 + n2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_add2l")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_add2r")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_addr *) let leq_addr = section_proof [] `!m n. n <= n + m` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((((use_arg_then "addn0")(gsym_then (thm_tac (new_rewrite [1] [(`n`)]))))) THEN (((use_arg_then "leq_add2l")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_addl *) let leq_addl = section_proof [] `!m n. n <= m + n` [ (((((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_addr")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_addr *) let ltn_addr = section_proof ["m";"n";"p"] `m < n ==> m < n + p` [ ((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "leq_trans") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_addr")(thm_tac (new_rewrite [] []))))); ];; (* Lemma ltn_addl *) let ltn_addl = section_proof [] `!m n p. m < n ==> m < p + n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma addn_gt0 *) let addn_gt0 = section_proof [] `!m n. (0 < m + n) <=> (0 < m) \/ (0 < n)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((repeat_tactic 1 9 (((use_arg_then "lt0n")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "negb_and")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addn_eq0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma subn_gt0 *) let subn_gt0 = section_proof ["m";"n"] `(0 < n - m) = (m < n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subn_eq0 *) let subn_eq0 = section_proof [] `!m n. (m - n = 0) = (m <= n)` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leqE *) let leqE = section_proof [] `!m n. m <= n <=> m - n = 0` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma leq_sub_add *) let leq_sub_add = section_proof [] `!m n p. (m - n <= p) = (m <= n + p)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])); (((((use_arg_then "subn_eq0")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subn_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma leq_subr *) let leq_subr = section_proof [] `!m n. n - m <= n` [ (((((use_arg_then "leq_sub_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_addl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma subnKC *) let subnKC = section_proof [] `!m n. m <= n ==> m + (n - m) = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma subnK *) let subnK = section_proof [] `!m n. m <= n ==> (n - m) + m = n` [ ((((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subnKC") (disch_tac [])) THEN (clear_assumption "subnKC") THEN (exact_tac)) THEN (done_tac)); ];; (* Lemma addn_subA *) let addn_subA = section_proof [] `!m n p. p <= n ==> m + (n - p) = (m + n) - p` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"]) THEN (move ["le_pn"])); (((((fun arg_tac -> (use_arg_then "subnK") (fun fst_arg -> (use_arg_then "le_pn") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [2] []))))) THEN (((use_arg_then "addnA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma subn_subA *) let subn_subA = section_proof [] `!m n p. p <= n ==> m - (n - p) = (m + p) - n` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"]) THEN (move ["le_pn"])); (((((fun arg_tac -> (use_arg_then "subnK") (fun fst_arg -> (use_arg_then "le_pn") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [2] []))))) THEN (((use_arg_then "subn_add2r")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma subKn *) let subKn = section_proof [] `!m n. m <= n ==> n - (n - m) = m` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "subn_subA") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addKn")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma leq_subS *) let leq_subS = section_proof [] `!m n. m <= n ==> SUC n - m = SUC (n - m)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); ((((use_arg_then "add1n")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "addn_subA") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] []))))))); ((((use_arg_then "add1n")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma ltn_subS *) let ltn_subS = section_proof [] `!m n. m < n ==> n - m = SUC (n - SUC m)` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["lt_mn"])) THEN ((((use_arg_then "leq_subS")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "subSS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma leq_sub2r *) let leq_sub2r = section_proof [] `!p m n. m <= n ==> m - p <= n - p` [ (BETA_TAC THEN (move ["p"]) THEN (move ["m"]) THEN (move ["n"]) THEN (move ["le_mn"])); (((((use_arg_then "leq_sub_add")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "leq_trans") (fun fst_arg -> (use_arg_then "le_mn") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_sub_add")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_sub2l *) let leq_sub2l = section_proof [] `!p m n. m <= n ==> p - n <= p - m` [ ((BETA_TAC THEN (move ["p"]) THEN (move ["m"]) THEN (move ["n"])) THEN ((((fun arg_tac -> (use_arg_then "leq_add2r") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`p - m`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_sub_add")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "leq_trans") (disch_tac [])) THEN (clear_assumption "leq_trans") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "leq_sub_add")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_sub2 *) let leq_sub2 = section_proof [] `!m1 m2 n1 n2. m1 <= m2 ==> n2 <= n1 ==> m1 - n1 <= m2 - n2` [ (BETA_TAC THEN (move ["m1"]) THEN (move ["m2"]) THEN (move ["n1"]) THEN (move ["n2"])); (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "leq_sub2r") (fun fst_arg -> (use_arg_then "n1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["le_m12"])) THEN ((DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "leq_sub2l") (fun fst_arg -> (use_arg_then "m2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (((use_arg_then "leq_trans") (disch_tac [])) THEN (clear_assumption "leq_trans") THEN (exact_tac))); ];; (* Lemma ltn_sub2r *) let ltn_sub2r = section_proof [] `!p m n. p < n ==> m < n ==> m - p < n - p` [ (BETA_TAC THEN (move ["p"]) THEN (move ["m"]) THEN (move ["n"])); (((DISCH_THEN (fun snd_th -> (use_arg_then "ltn_subS") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leqSS")(thm_tac (new_rewrite [] [])))))); (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "leq_sub2r") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`SUC p`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (((use_arg_then "subSS")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma ltn_sub2l *) let ltn_sub2l = section_proof [] `!p m n. m < p ==> m < n ==> p - n < p - m` [ (BETA_TAC THEN (move ["p"]) THEN (move ["m"]) THEN (move ["n"])); (((DISCH_THEN (fun snd_th -> (use_arg_then "ltn_subS") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leqSS")(thm_tac (new_rewrite [] [])))))); (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "leq_sub2l") (fun fst_arg -> (use_arg_then "p") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (done_tac)); ];; (* Lemma ltn_add_sub *) let ltn_add_sub = section_proof [] `!m n p. (m + n < p) = (n < p - m)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])); (((repeat_tactic 1 9 (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_sub_add")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; let maxn = new_definition `maxn m n = if m < n then n else m`;; let minn = new_definition `minn m n = if m < n then m else n`;; (* Lemma max0n *) let max0n = section_proof [] `!n. maxn 0 n = n` [ ((((use_arg_then "maxn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma maxn0 *) let maxn0 = section_proof [] `!n. maxn n 0 = n` [ ((((use_arg_then "maxn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma maxnC *) let maxnC = section_proof [] `!m n. maxn m n = maxn n m` [ ((repeat_tactic 1 9 (((use_arg_then "maxn")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma maxnl *) let maxnl = section_proof [] `!m n. n <= m ==> maxn m n = m` [ ((((use_arg_then "maxn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma maxnr *) let maxnr = section_proof [] `!m n. m <= n ==> maxn m n = n` [ ((((use_arg_then "maxn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma add_sub_maxn *) let add_sub_maxn = section_proof [] `!m n. m + (n - m) = maxn m n` [ ((((use_arg_then "maxn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma maxnAC *) let maxnAC = section_proof [] `!m n p. maxn (maxn m n) p = maxn (maxn m p) n` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])); (((repeat_tactic 1 9 (((use_arg_then "add_sub_maxn")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "subn_sub")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "add_sub_maxn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "maxnC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma maxnA *) let maxnA = section_proof [] `!m n p. maxn m (maxn n p) = maxn (maxn m n) p` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])); (((repeat_tactic 1 9 (((use_arg_then "maxnC")(thm_tac (new_rewrite [] [(`maxn m _1`)]))))) THEN (((use_arg_then "maxnAC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma maxnCA *) let maxnCA = section_proof [] `!m n p. maxn m (maxn n p) = maxn n (maxn m p)` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])) THEN ((repeat_tactic 1 9 (((use_arg_then "maxnA")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "maxnC")(thm_tac (new_rewrite [] [(`maxn m _1`)]))))) THEN (done_tac)); ];; (* Lemma eqn_maxr *) let eqn_maxr = section_proof [] `!m n. (maxn m n = n) = (m <= n)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((((use_arg_then "maxnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addn0")(gsym_then (thm_tac (new_rewrite [2] [(`n`)]))))) THEN (((use_arg_then "add_sub_maxn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eqn_addl")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqE")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eqn_maxl *) let eqn_maxl = section_proof [] `!m n. (maxn m n = m) = (n <= m)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((((use_arg_then "addn0")(gsym_then (thm_tac (new_rewrite [2] [(`m`)]))))) THEN (((use_arg_then "add_sub_maxn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eqn_addl")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqE")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma maxnn *) let maxnn = section_proof [] `!n. maxn n n = n` [ (BETA_TAC THEN (move ["n"])); (((((use_arg_then "maxnl")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_maxr *) let leq_maxr = section_proof ["m";"n1";"n2"] `(m <= maxn n1 n2) <=> (m <= n1) \/ (m <= n2)` [ ((fun arg_tac -> arg_tac (Arg_term (`n2 <= n1`))) (term_tac (wlog_tac (move ["le_n21"])[`n1`; `n2`]))); (((THENL_LAST) (((fun arg_tac -> (fun arg_tac -> (use_arg_then "leq_total") (fun fst_arg -> (use_arg_then "n2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "n1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (move ["le_n12"])) ((((use_arg_then "maxnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orbC")(thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "le_n21")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); (BETA_TAC THEN (move ["le_n21"])); (((((use_arg_then "maxn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "le_n21")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m <= n1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac))); ((((use_arg_then "contra") (disch_tac [])) THEN (clear_assumption "contra") THEN (DISCH_THEN apply_tac)) THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "leq_trans") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "n1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC))) THEN (done_tac)); ];; (* Lemma leq_maxl *) let leq_maxl = section_proof ["m";"n1";"n2"] `(maxn n1 n2 <= m) <=> (n1 <= m) /\ (n2 <= m)` [ (((((use_arg_then "leqNgt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_maxr")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_or")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "leqNgt")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ];; (* Lemma addn_maxl *) let addn_maxl = section_proof [] `!m1 m2 n. (maxn m1 m2) + n = maxn (m1 + n) (m2 + n)` [ ((BETA_TAC THEN (move ["m1"]) THEN (move ["m2"]) THEN (move ["n"])) THEN ((repeat_tactic 1 9 (((use_arg_then "add_sub_maxn")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "subn_add2r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnAC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addn_maxr *) let addn_maxr = section_proof [] `!m n1 n2. m + maxn n1 n2 = maxn (m + n1) (m + n2)` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n1"]) THEN (move ["n2"])) THEN ((repeat_tactic 1 9 (((use_arg_then "addnC")(thm_tac (new_rewrite [] [(`m + _1`)]))))) THEN (((use_arg_then "addn_maxl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma min0n *) let min0n = section_proof ["n"] `minn 0 n = 0` [ ((((use_arg_then "minn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma minn0 *) let minn0 = section_proof ["n"] `minn n 0 = 0` [ ((((use_arg_then "minn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma minnC *) let minnC = section_proof ["m";"n"] `minn m n = minn n m` [ ((repeat_tactic 1 9 (((use_arg_then "minn")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma minnr *) let minnr = section_proof ["m";"n"] `n <= m ==> minn m n = n` [ ((((use_arg_then "minn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma minnl *) let minnl = section_proof ["m";"n"] `m <= n ==> minn m n = m` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "minnr") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (((use_arg_then "minnC")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma addn_min_max *) let addn_min_max = section_proof ["m";"n"] `minn m n + maxn m n = m + n` [ (((((use_arg_then "minn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "maxn")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma minn_to_maxn *) let minn_to_maxn = section_proof ["m";"n"] `minn m n = (m + n) - maxn m n` [ (((((use_arg_then "addn_min_max")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma sub_sub_minn *) let sub_sub_minn = section_proof ["m";"n"] `m - (m - n) = minn m n` [ (((((use_arg_then "minnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "minn_to_maxn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add_sub_maxn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subn_add2l")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma minnCA *) let minnCA = section_proof [] `!m1 m2 m3. minn m1 (minn m2 m3) = minn m2 (minn m1 m3)` [ ((BETA_TAC THEN (move ["m1"]) THEN (move ["m2"]) THEN (move ["m3"])) THEN (repeat_tactic 1 9 (((use_arg_then "minn_to_maxn")(thm_tac (new_rewrite [] [(`minn _1 (minn _2 _3)`)])))))); ((((fun arg_tac -> (use_arg_then "subn_add2r") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`maxn m2 m3`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "subn_add2r") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`maxn m1 m3`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [(`(m2 + _1) - _2`)]))))) THEN (repeat_tactic 1 9 (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] []))))))); (((repeat_tactic 1 9 (((use_arg_then "addn_maxl")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "addn_min_max")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "addn_maxr")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnCA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "maxnAC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] [(`m2 + m1`)]))))) THEN (done_tac)); ];; (* Lemma minnA *) let minnA = section_proof [] `!m1 m2 m3. minn m1 (minn m2 m3) = minn (minn m1 m2) m3` [ (BETA_TAC THEN (move ["m1"]) THEN (move ["m2"]) THEN (move ["m3"])); (((((use_arg_then "minnC")(thm_tac (new_rewrite [] [(`minn m2 _1`)])))) THEN (((use_arg_then "minnCA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "minnC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma minnAC *) let minnAC = section_proof ["m1";"m2";"m3"] `minn (minn m1 m2) m3 = minn (minn m1 m3) m2` [ (((((use_arg_then "minnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "minnCA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "minnA")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eqn_minr *) let eqn_minr = section_proof ["m";"n"] `(minn m n = n) = (n <= m)` [ (((fun arg_tac -> (use_arg_then "eqn_addr") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))); (((((use_arg_then "addn_min_max")(gsym_then (thm_tac (new_rewrite [] [(`n + m`)]))))) THEN (((use_arg_then "minnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eqn_addl")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eq_sym")(thm_tac (new_rewrite [] [(`m = _1`)])))) THEN (((use_arg_then "maxnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eqn_maxl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eqn_minl *) let eqn_minl = section_proof ["m";"n"] `(minn m n = m) = (m <= n)` [ (((((fun arg_tac -> (use_arg_then "eqn_addr") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eq_sym")(thm_tac (new_rewrite [] [(`_1 = m + n`)])))) THEN (((use_arg_then "addn_min_max")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eqn_addl")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eqn_maxr")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma minnn *) let minnn = section_proof ["n"] `minn n n = n` [ (((((use_arg_then "minnr")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_minr *) let leq_minr = section_proof ["m";"n1";"n2"] `(m <= minn n1 n2) <=> (m <= n1) /\ (m <= n2)` [ ((((use_arg_then "minn")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma leq_minl *) let leq_minl = section_proof ["m";"n1";"n2"] `(minn n1 n2 <= m) <=> (n1 <= m) \/ (n2 <= m)` [ (((((use_arg_then "leqNgt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_minr")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "negb_and")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "leqNgt")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ];; (* Lemma addn_minl *) let addn_minl = section_proof [] `!m1 m2 n. (minn m1 m2) + n = minn (m1 + n) (m2 + n)` [ ((BETA_TAC THEN (move ["m1"]) THEN (move ["m2"]) THEN (move ["n"])) THEN ((repeat_tactic 1 9 (((use_arg_then "minn_to_maxn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addn_maxl")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subn_add2r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnAC")(thm_tac (new_rewrite [] [])))))); (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "addnC") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [(`_1 + n`)])))))) THEN (((use_arg_then "addn_subA")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "addn_min_max")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_addl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma addn_minr *) let addn_minr = section_proof [] `!m n1 n2. m + minn n1 n2 = minn (m + n1) (m + n2)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n1"]) THEN (move ["n2"])); (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "addnC") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [(`m + _1`)]))))) THEN (((use_arg_then "addn_minl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma maxnK *) let maxnK = section_proof ["m";"n"] `minn (maxn m n) m = m` [ (((((use_arg_then "minnr")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "leq_maxr")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma maxKn *) let maxKn = section_proof ["m";"n"] `minn n (maxn m n) = n` [ (((((use_arg_then "minnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "maxnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "maxnK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma minnK *) let minnK = section_proof ["m";"n"] `maxn (minn m n) m = m` [ (((((use_arg_then "maxnr")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "leq_minl")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma minKn *) let minKn = section_proof ["m";"n"] `maxn n (minn m n) = n` [ (((((use_arg_then "minnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "maxnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "minnK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma maxn_minl *) let maxn_minl = section_proof ["m1";"m2";"n"] `maxn (minn m1 m2) n = minn (maxn m1 n) (maxn m2 n)` [ (((repeat_tactic 1 9 (((use_arg_then "maxn")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "minn")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac)); ];; (* Lemma maxn_minr *) let maxn_minr = section_proof ["m";"n1";"n2"] `maxn m (minn n1 n2) = minn (maxn m n1) (maxn m n2)` [ (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "maxnC") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [(`maxn m _1`)]))))) THEN (((use_arg_then "maxn_minl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma minn_maxl *) let minn_maxl = section_proof [] `!m1 m2 n. minn (maxn m1 m2) n = maxn (minn m1 n) (minn m2 n)` [ ((BETA_TAC THEN (move ["m1"]) THEN (move ["m2"]) THEN (move ["n"])) THEN ((((use_arg_then "maxn_minr")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "maxn_minl")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "minnA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "maxnn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "maxnC")(thm_tac (new_rewrite [] [(`maxn _1 n`)])))) THEN (repeat_tactic 1 9 (((use_arg_then "maxnK")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma minn_maxr *) let minn_maxr = section_proof [] `!m n1 n2. minn m (maxn n1 n2) = maxn (minn m n1) (minn m n2)` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n1"]) THEN (move ["n2"])); (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "minnC") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [(`minn m _1`)]))))) THEN (((use_arg_then "minn_maxl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Section Iteration *) begin_section "Iteration";; (add_section_var (mk_var ("m", (`:num`))); add_section_var (mk_var ("n", (`:num`))));; (add_section_var (mk_var ("x", (`:A`))); add_section_var (mk_var ("y", (`:A`))));; let iter = define `iter (SUC n) f (x:A) = f (iter n f x) /\ iter 0 f x = x`;; let iteri = define `iteri (SUC n) f (x:A) = f n (iteri n f x) /\ iteri 0 f x = x`;; (* Lemma iterSr *) let iterSr = section_proof ["n";"f";"x"] `iter (SUC n) f (x : A) = iter n f (f x)` [ ((((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) THEN ((repeat_tactic 1 9 (((use_arg_then "iter")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (move ["n"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma iterS *) let iterS = section_proof ["n";"f";"x"] `iter (SUC n) f (x:A) = f (iter n f x)` [ ((((use_arg_then "iter")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma iter_add *) let iter_add = section_proof ["n";"m";"f";"x"] `iter (n + m) f (x:A) = iter n f (iter m f x)` [ ((((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) THEN (((repeat_tactic 1 9 (((use_arg_then "iter")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (((use_arg_then "add0n")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((TRY done_tac)) THEN (((use_arg_then "addSn")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (move ["n"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "iterS")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma iteriS *) let iteriS = section_proof ["n";"f";"x"] `iteri (SUC n) f x = f n (iteri n f (x:A))` [ ((((use_arg_then "iteri")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Finalization of the section Iteration *) let iterSr = finalize_theorem iterSr;; let iterS = finalize_theorem iterS;; let iter_add = finalize_theorem iter_add;; let iteriS = finalize_theorem iteriS;; end_section "Iteration";; (* Lemma mul0n *) let mul0n = section_proof ["n"] `0 * n = 0` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma muln0 *) let muln0 = section_proof ["n"] `n * 0 = 0` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma mul1n *) let mul1n = section_proof ["n"] `1 * n = n` [ ((arith_tac) THEN (done_tac)); ];; (* Lemma mulSn *) let mulSn = section_proof ["m";"n"] `SUC m * n = n + m * n` [ (arith_tac); ];; (* Lemma mulSnr *) let mulSnr = section_proof ["m";"n"] `SUC m * n = m * n + n` [ (arith_tac); ];; (* Lemma mulnS *) let mulnS = section_proof ["m";"n"] `m * SUC n = m + m * n` [ ((((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) THEN (((repeat_tactic 0 10 (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "addn0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN (move ["m"]))); ((((repeat_tactic 1 9 (((use_arg_then "mulSn")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "addSn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnCA")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma mulnSr *) let mulnSr = section_proof ["m";"n"] `m * SUC n = m * n + m` [ (((((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulnS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma muln1 *) let muln1 = section_proof ["n"] `n * 1 = n` [ (((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `1 = SUC 0`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulnSr")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "muln0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma mulnC *) let mulnC = section_proof [] `!m n. m * n = n * m` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); (((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; (move ["m"])]) THEN (((repeat_tactic 0 10 (((use_arg_then "muln0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "mulnS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "mulSn")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma muln_addl *) let muln_addl = section_proof ["m1";"m2";"n"] `(m1 + m2) * n = m1 * n + m2 * n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "m1") (disch_tac [])) THEN (clear_assumption "m1") THEN elim) [ALL_TAC; ((move ["m1"]) THEN (move ["IHm"]))]) (((((use_arg_then "mul0n")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "add0n")(thm_tac (new_rewrite [] [])))))) THEN (done_tac))); (((((use_arg_then "mulSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IHm")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "mulSn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addSn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma muln_addr *) let muln_addr = section_proof ["m";"n1";"n2"] `m * (n1 + n2) = m * n1 + m * n2` [ (((repeat_tactic 1 9 (((use_arg_then "mulnC")(thm_tac (new_rewrite [] [(`m * _1`)]))))) THEN (((use_arg_then "muln_addl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma muln_subl *) let muln_subl = section_proof [] `!m n p. (m - n) * p = m * p - n * p` [ ((THENL_FIRST) (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN ((THENL) case [ALL_TAC; (move ["n'"])])) (((repeat_tactic 1 9 (((use_arg_then "muln0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subn0")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN ((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; ((move ["m"]) THEN (move ["IHm"]))]) THEN ((THENL) case [ALL_TAC; (move ["n"])])) THEN ((repeat_tactic 0 10 (((fun arg_tac ->(use_arg_then "mul0n")(fun tmp_arg1 -> (fun arg_tac ->(use_arg_then "sub0n")(fun tmp_arg1 -> (use_arg_then "subn0")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "mulSn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subn_add2l")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "IHm")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subSS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma muln_subr *) let muln_subr = section_proof [] `!m n p. m * (n - p) = m * n - m * p` [ ((BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])) THEN ((repeat_tactic 1 9 (((use_arg_then "mulnC")(thm_tac (new_rewrite [] [(`m * _1`)]))))) THEN (((use_arg_then "muln_subl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma mulnA *) let mulnA = section_proof [] `!m n p. m * (n * p) = (m * n) * p` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"]) THEN (move ["p"])); ((THENL_FIRST) ((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; (move ["m"])]) ((repeat_tactic 1 9 (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((repeat_tactic 1 9 (((use_arg_then "mulSn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "muln_addl")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma mulnCA *) let mulnCA = section_proof ["m";"n1";"n2"] `m * (n1 * n2) = n1 * (m * n2)` [ (((repeat_tactic 1 9 (((use_arg_then "mulnA")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "mulnC") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [(`m * _1`)]))))) THEN (done_tac)); ];; (* Lemma mulnAC *) let mulnAC = section_proof ["m";"n";"p"] `(n * m) * p = (n * p) * m` [ (((repeat_tactic 1 9 (((use_arg_then "mulnA")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "mulnC")(thm_tac (new_rewrite [] [(`p * _1`)]))))) THEN (done_tac)); ];; (* Lemma muln_eq0 *) let muln_eq0 = section_proof ["m";"n"] `(m * n = 0) <=> (m = 0) \/ (n = 0)` [ ((((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN ((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; (move ["m"])]) THEN ((THENL) case [ALL_TAC; (move ["n"])])) THEN ((repeat_tactic 0 10 (((fun arg_tac ->(use_arg_then "muln0")(fun tmp_arg1 -> (use_arg_then "mul0n")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN (arith_tac)); ];; (* Lemma eqn_mul1 *) let eqn_mul1 = section_proof ["m";"n"] `(m * n = 1) <=> (m = 1) /\ (n = 1)` [ ((((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN ((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; ((THENL) case [ALL_TAC; (move ["m"])])]) THEN ((THENL) case [ALL_TAC; ((THENL) case [ALL_TAC; (move ["n"])])])) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma muln_gt0 *) let muln_gt0 = section_proof ["m";"n"] `(0 < m * n) <=> (0 < m) /\ (0 < n)` [ ((((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN ((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; (move ["m"])]) THEN ((THENL) case [ALL_TAC; (move ["n"])])) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma leq_pmull *) let leq_pmull = section_proof ["m";"n"] `0 < n ==> m <= n * m` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "prednK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "mulSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_addr")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_pmulr *) let leq_pmulr = section_proof ["m";"n"] `0 < n ==> m <= m * n` [ (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "leq_pmull") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (((use_arg_then "mulnC")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma leq_mul2l *) let leq_mul2l = section_proof ["m";"n1";"n2"] `(m * n1 <= m * n2) <=> (m = 0) \/ (n1 <= n2)` [ (((((use_arg_then "leqE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "muln_subr")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "muln_eq0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma leq_mul2r *) let leq_mul2r = section_proof ["m";"n1";"n2"] `(n1 * m <= n2 * m) <=> (m = 0) \/ (n1 <= n2)` [ (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "mulnC") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [(`_1 * m`)])))))) THEN (((use_arg_then "leq_mul2l")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_mul *) let leq_mul = section_proof ["m1";"m2";"n1";"n2"] `m1 <= n1 ==> m2 <= n2 ==> m1 * m2 <= n1 * n2` [ (BETA_TAC THEN (move ["le_mn1"]) THEN (move ["le_mn2"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "leq_trans") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m1 * n2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m1 * m2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`n1 * n2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((THENL_FIRST) (ANTS_TAC) (((((use_arg_then "leq_mul2l")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "le_mn2")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (DISCH_THEN apply_tac); (((((use_arg_then "leq_mul2r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "le_mn1")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eqn_mul2l *) let eqn_mul2l = section_proof ["m";"n1";"n2"] `(m * n1 = m * n2) <=> (m = 0) \/ (n1 = n2)` [ (((((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "leq_mul2l")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "orb_andr")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eqn_leq")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma eqn_mul2r *) let eqn_mul2r = section_proof ["m";"n1";"n2"] `(n1 * m = n2 * m) <=> (m = 0) \/ (n1 = n2)` [ (((((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "leq_mul2r")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "orb_andr")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eqn_leq")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma leq_pmul2l *) let leq_pmul2l = section_proof ["m";"n1";"n2"] `0 < m ==> ((m * n1 <= m * n2) <=> (n1 <= n2))` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "prednK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "leq_mul2l")(thm_tac (new_rewrite [] [])))) THEN ((((use_arg_then "NOT_SUC")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "orFb")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma leq_pmul2r *) let leq_pmul2r = section_proof ["m";"n1";"n2"] `0 < m ==> ((n1 * m <= n2 * m) <=> (n1 <= n2))` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "prednK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "leq_mul2r")(thm_tac (new_rewrite [] [])))) THEN ((((use_arg_then "NOT_SUC")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "orFb")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma eqn_pmul2l *) let eqn_pmul2l = section_proof ["m";"n1";"n2"] `0 < m ==> ((m * n1 = m * n2) <=> (n1 = n2))` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "prednK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "eqn_mul2l")(thm_tac (new_rewrite [] [])))) THEN ((((use_arg_then "NOT_SUC")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "orFb")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma eqn_pmul2r *) let eqn_pmul2r = section_proof ["m";"n1";"n2"] `0 < m ==> ((n1 * m = n2 * m) <=> (n1 = n2))` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "prednK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "eqn_mul2r")(thm_tac (new_rewrite [] [])))) THEN ((((use_arg_then "NOT_SUC")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "orFb")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma ltn_mul2l *) let ltn_mul2l = section_proof ["m";"n1";"n2"] `(m * n1 < m * n2) <=> (0 < m) /\ (n1 < n2)` [ (((((use_arg_then "lt0n")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_mul2l")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_or")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_mul2r *) let ltn_mul2r = section_proof ["m";"n1";"n2"] `(n1 * m < n2 * m) <=> (0 < m) /\ (n1 < n2)` [ (((((use_arg_then "lt0n")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_mul2r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_or")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_pmul2l *) let ltn_pmul2l = section_proof ["m";"n1";"n2"] `0 < m ==> ((m * n1 < m * n2) <=> (n1 < n2))` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "prednK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "ltn_mul2l")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LT_0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_pmul2r *) let ltn_pmul2r = section_proof ["m";"n1";"n2"] `0 < m ==> (n1 * m < n2 * m <=> n1 < n2)` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "prednK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "ltn_mul2r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LT_0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_Pmull *) let ltn_Pmull = section_proof ["m";"n"] `1 < n ==> 0 < m ==> m < n * m` [ ((BETA_TAC THEN (move ["lt1n"]) THEN (move ["m_gt0"])) THEN ((((use_arg_then "mul1n")(gsym_then (thm_tac (new_rewrite [1] [(`m`)]))))) THEN (((use_arg_then "ltn_pmul2r")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_Pmulr *) let ltn_Pmulr = section_proof ["m";"n"] `1 < n ==> 0 < m ==> m < m * n` [ ((BETA_TAC THEN (move ["lt1n"]) THEN (move ["m_gt0"])) THEN ((((use_arg_then "mulnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltn_Pmull")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_mul *) let ltn_mul = section_proof ["m1";"m2";"n1";"n2"] `m1 < n1 ==> m2 < n2 ==> m1 * m2 < n1 * n2` [ (BETA_TAC THEN (move ["lt_mn1"]) THEN (move ["lt_mn2"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "leq_ltn_trans") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m1 * n2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m1 * m2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`n1 * n2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); (ANTS_TAC); (((((use_arg_then "leq_mul2l")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orbC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (DISCH_THEN apply_tac); ((((use_arg_then "ltn_pmul2r")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "lt_mn2") (disch_tac [])) THEN (clear_assumption "lt_mn2") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma maxn_mulr *) let maxn_mulr = section_proof ["m";"n1";"n2"] `m * maxn n1 n2 = maxn (m * n1) (m * n2)` [ ((THENL_FIRST) ((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; (move ["n"])]) (((repeat_tactic 1 9 (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "maxnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((repeat_tactic 1 9 (((use_arg_then "maxn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "fun_if")(thm_tac (new_rewrite [] [(`SUC n * _1`)])))) THEN (((use_arg_then "ltn_pmul2l")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "LT_0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma maxn_mull *) let maxn_mull = section_proof ["m1";"m2";"n"] `maxn m1 m2 * n = maxn (m1 * n) (m2 * n)` [ (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "mulnC") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [(`_1 * n`)])))))) THEN (((use_arg_then "maxn_mulr")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma minn_mulr *) let minn_mulr = section_proof ["m";"n1";"n2"] `m * minn n1 n2 = minn (m * n1) (m * n2)` [ ((THENL_FIRST) ((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; (move ["n"])]) (((repeat_tactic 1 9 (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "minn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "if_same")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((repeat_tactic 1 9 (((use_arg_then "minn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "fun_if")(thm_tac (new_rewrite [] [(`SUC n * _1`)])))) THEN (((use_arg_then "ltn_pmul2l")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "LT_0")(thm_tac (new_rewrite [] []))))); ];; (* Lemma minn_mull *) let minn_mull = section_proof ["m1";"m2";"n"] `minn m1 m2 * n = minn (m1 * n) (m2 * n)` [ (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "mulnC") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [(`_1 * n`)])))))) THEN (((use_arg_then "minn_mulr")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; parse_as_infix("^", (24, "left"));; override_interface("^", `EXP`);; (* Lemma expn0 *) let expn0 = section_proof ["m"] `m ^ 0 = 1` [ ((((use_arg_then "EXP")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma expn1 *) let expn1 = section_proof ["m"] `m ^ 1 = m` [ ((((use_arg_then "EXP_1")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma expnS *) let expnS = section_proof ["m";"n"] `m ^ SUC n = m * m ^ n` [ ((((use_arg_then "EXP")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma expnSr *) let expnSr = section_proof ["m";"n"] `m ^ SUC n = m ^ n * m` [ (((((use_arg_then "mulnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma exp0n *) let exp0n = section_proof ["n"] `0 < n ==> 0 ^ n = 0` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN case) [ALL_TAC; (move ["n"])]) ((((use_arg_then "LT_REFL")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (((((use_arg_then "EXP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma exp1n *) let exp1n = section_proof ["n"] `1 ^ n = 1` [ (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [(((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))); ((((use_arg_then "expnS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mul1n")(thm_tac (new_rewrite [] [])))))]) THEN (done_tac)); ];; (* Lemma expn_add *) let expn_add = section_proof ["m";"n1";"n2"] `m ^ (n1 + n2) = m ^ n1 * m ^ n2` [ (((THENL) (((use_arg_then "n1") (disch_tac [])) THEN (clear_assumption "n1") THEN elim) [ALL_TAC; ((move ["n1"]) THEN (move ["IHn"]))]) THEN ((repeat_tactic 0 10 (((use_arg_then "expn0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "mul1n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "add0n")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "addSn")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulnA")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma expn_mull *) let expn_mull = section_proof ["m1";"m2";"n"] `(m1 * m2) ^ n = m1 ^ n * m2 ^ n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) (((repeat_tactic 1 9 (((use_arg_then "expn0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "muln1")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((repeat_tactic 1 9 (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "mulnA")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "mulnCA")(thm_tac (new_rewrite [] [(`m2 * _1`)]))))) THEN (done_tac)); ];; (* Lemma expn_mulr *) let expn_mulr = section_proof ["m";"n1";"n2"] `m ^ (n1 * n2) = (m ^ n1) ^ n2` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n1") (disch_tac [])) THEN (clear_assumption "n1") THEN elim) [ALL_TAC; ((move ["n1"]) THEN (move ["IHn"]))]) (((repeat_tactic 1 9 (((use_arg_then "expn0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "mul0n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "exp1n")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "mulSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "expn_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "expnS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "expn_mull")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IHn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma expn_gt0 *) let expn_gt0 = section_proof ["m";"n"] `(0 < m ^ n) <=> (0 < m) \/ (n = 0)` [ ((THENL_FIRST) (((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; (move ["m"])]) THEN ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))])) ((((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac))); (((((use_arg_then "expnS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); (((((use_arg_then "expnS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addn_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IHn")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma expn_eq0 *) let expn_eq0 = section_proof ["m";"e"] `(m ^ e = 0) <=> (m = 0) /\ (0 < e)` [ (((repeat_tactic 1 9 (((use_arg_then "eqn0Ngt")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "expn_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_or")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "lt0n")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma ltn_expl *) let ltn_expl = section_proof ["m";"n"] `1 < m ==> n < m ^ n` [ ((THENL_FIRST) ((BETA_TAC THEN (move ["m_gt1"])) THEN ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; (move ["n"])])) ((((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac))); ((((fun arg_tac -> (use_arg_then "ltnW") (fun fst_arg -> (use_arg_then "m_gt1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "leq_pmul2l") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC)); (((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))); ((((use_arg_then "leq_trans") (disch_tac [])) THEN (clear_assumption "leq_trans") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> (use_arg_then "ltn_Pmull") (fun fst_arg -> (use_arg_then "m_gt1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma leq_exp2l *) let leq_exp2l = section_proof ["m";"n1";"n2"] `1 < m ==> (m ^ n1 <= m ^ n2 <=> n1 <= n2)` [ ((THENL_ROT (-1)) ((BETA_TAC THEN (move ["m_gt1"])) THEN ((THENL) (((use_arg_then "n2") (disch_tac [])) THEN (clear_assumption "n2") THEN ((use_arg_then "n1") (disch_tac [])) THEN (clear_assumption "n1") THEN elim) [ALL_TAC; ((move ["n1"]) THEN (move ["IHn"]))]) THEN (BETA_TAC THEN ((THENL) case [ALL_TAC; (move ["q"])])) THEN ((repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))))); (((repeat_tactic 1 9 (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_pmul2l")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "leqSS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "expn_gt0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "m_gt1") (disch_tac [])) THEN (clear_assumption "m_gt1") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "leqNgt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "expn0")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "m_gt1") (disch_tac [])) THEN (clear_assumption "m_gt1") THEN BETA_TAC) THEN ((((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (move ["m_gt1"]))); ((((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "leq_trans") (fun fst_arg -> (use_arg_then "m_gt1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 0 10 (((use_arg_then "ltn0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "expnS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_pmulr")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "expn_gt0")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "m_gt1") (disch_tac [])) THEN (clear_assumption "m_gt1") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma ltn_exp2l *) let ltn_exp2l = section_proof ["m";"n1";"n2"] `1 < m ==> (m ^ n1 < m ^ n2 <=> n1 < n2)` [ ((BETA_TAC THEN (move ["m_gt1"])) THEN ((repeat_tactic 1 9 (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_exp2l")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eqn_exp2l *) let eqn_exp2l = section_proof ["m";"n1";"n2"] `1 < m ==> (m ^ n1 = m ^ n2 <=> n1 = n2)` [ ((BETA_TAC THEN (move ["m_gt1"])) THEN ((repeat_tactic 1 9 (((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "leq_exp2l")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma expnI *) let expnI = section_proof ["m"] `1 < m ==> !e1 e2. m ^ e1 = m ^ e2 ==> e1 = e2` [ ((BETA_TAC THEN (move ["m_gt1"]) THEN (move ["e1"]) THEN (move ["e2"])) THEN (((use_arg_then "eqn_exp2l")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma leq_pexp2l *) let leq_pexp2l = section_proof ["m";"n1";"n2"] `0 < m ==> n1 <= n2 ==> m ^ n1 <= m ^ n2` [ (((THENL) (((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; ((THENL) case [ALL_TAC; (move ["m"])])]) THEN ((repeat_tactic 0 10 (((use_arg_then "ltn0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))) [((((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "exp1n")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "leq_exp2l")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))]) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma ltn_pexp2l *) let ltn_pexp2l = section_proof ["m";"n1";"n2"] `0 < m ==> m ^ n1 < m ^ n2 ==> n1 < n2` [ (((THENL) (((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN case) [ALL_TAC; ((THENL) case [ALL_TAC; (move ["m"])])]) THEN ((repeat_tactic 0 10 (((use_arg_then "ltn0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))) [((((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "exp1n")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "ltn_exp2l")(thm_tac (new_rewrite [] []))))]) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma ltn_exp2r *) let ltn_exp2r = section_proof ["m";"n";"e"] `0 < e ==> (m ^ e < n ^ e <=> m < n)` [ ((BETA_TAC THEN (move ["e_gt0"])) THEN ((THENL) (split_tac) [ALL_TAC; (move ["ltmn"])])); ((repeat_tactic 1 9 (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "contra") (disch_tac [])) THEN (clear_assumption "contra") THEN (DISCH_THEN apply_tac) THEN (move ["lemn"]))); (((THENL) (((use_arg_then "e") (disch_tac [])) THEN (clear_assumption "e") THEN elim) [ALL_TAC; ((move ["e'"]) THEN (move ["IHe"]))]) THEN ((repeat_tactic 0 10 (((use_arg_then "expn0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_mul")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) (((use_arg_then "e_gt0") (disch_tac [])) THEN (clear_assumption "e_gt0") THEN ((use_arg_then "e") (disch_tac [])) THEN (clear_assumption "e") THEN elim) ((((use_arg_then "ltnn")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((THENL_FIRST) (BETA_TAC THEN ((THENL) case [ALL_TAC; ((move ["e"]) THEN (move ["IHe"]))])) (((((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "expn1")(thm_tac (new_rewrite [] [])))))) THEN (done_tac))); (((repeat_tactic 1 9 (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ltn_mul")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "expnS")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "IHe")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (arith_tac)); ];; (* Lemma leq_exp2r *) let leq_exp2r = section_proof ["m";"n";"e"] `0 < e ==> (m ^ e <= n ^ e <=> m <= n)` [ ((BETA_TAC THEN (move ["e_gt0"])) THEN ((((use_arg_then "leqNgt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltn_exp2r")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "leqNgt")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma eqn_exp2r *) let eqn_exp2r = section_proof ["m";"n";"e"] `0 < e ==> (m ^ e = n ^ e <=> m = n)` [ ((BETA_TAC THEN (move ["e_gt0"])) THEN ((repeat_tactic 1 9 (((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "leq_exp2r")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma expIn *) let expIn = section_proof ["e"] `0 < e ==> !m n. m ^ e = n ^ e ==> m = n` [ ((BETA_TAC THEN (move ["e_gt0"]) THEN (move ["m"]) THEN (move ["n"])) THEN (((use_arg_then "eqn_exp2r")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma fact0 *) let fact0 = section_proof [] `FACT 0 = 1` [ ((((use_arg_then "FACT")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma factS *) let factS = section_proof ["n"] `FACT (SUC n) = (SUC n) * FACT n` [ ((((use_arg_then "FACT")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma fact_gt0 *) let fact_gt0 = section_proof ["n"] `0 < FACT n` [ (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; (move ["n"])]) THEN ((((use_arg_then "FACT")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (repeat_tactic 0 10 (((use_arg_then "muln_gt0")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))))) THEN (arith_tac) THEN (done_tac)); ];; let odd = new_basic_definition `odd = ODD`;; (* Lemma odd0 *) let odd0 = section_proof [] `odd 0 = F` [ ((((use_arg_then "odd")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 2 0 (((use_arg_then "ODD")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma oddS *) let oddS = section_proof ["n"] `odd (SUC n) = ~odd n` [ (((((use_arg_then "odd")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "ODD")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma odd1 *) let odd1 = section_proof [] `odd 1 = T` [ (((((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "oddS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma odd_add *) let odd_add = section_proof ["m";"n"] `odd (m + n) = odd m + odd n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; ((move ["m"]) THEN (move ["IHn"]))]) (((((use_arg_then "add0n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addFb")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "addSn")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "oddS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addTb")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addbA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addTb")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma odd_sub *) let odd_sub = section_proof ["m";"n"] `n <= m ==> odd (m - n) = odd m + odd n` [ ((BETA_TAC THEN (move ["le_nm"])) THEN (((fun arg_tac -> (use_arg_then "addIb") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`odd n`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "odd_add")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subnK")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "addbK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma odd_opp *) let odd_opp = section_proof ["i";"m"] `odd m = F ==> i < m ==> odd (m - i) = odd i` [ (BETA_TAC THEN (move ["oddm"]) THEN (move ["lt_im"])); (((((fun arg_tac -> (use_arg_then "odd_sub") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ltnW") (fun fst_arg -> (use_arg_then "lt_im") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "oddm")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addFb")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma odd_mul *) let odd_mul = section_proof ["m";"n"] `odd (m * n) <=> odd m /\ odd n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; ((move ["m"]) THEN (move ["IHm"]))]) (((((use_arg_then "mul0n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andFb")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "mulSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "oddS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addTb")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andb_addl")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IHm")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma odd_exp *) let odd_exp = section_proof ["m";"n"] `odd (m ^ n) <=> (n = 0) \/ odd m` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) (((((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd1")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "expnS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd_mul")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orbC")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `SUC n = 0 <=> F`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orFb")(thm_tac (new_rewrite [] []))))); ((fun arg_tac -> arg_tac (Arg_term (`odd m`))) (term_tac (set_tac "b"))); (((use_arg_then "IHn") (disch_tac [])) THEN (clear_assumption "IHn") THEN ((use_arg_then "b_def") (disch_tac [])) THEN (clear_assumption "b_def") THEN BETA_TAC THEN (move ["_"]) THEN (move ["_"])); ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case THEN (simp_tac)) THEN (done_tac)); ];; let double = define `double 0 = 0 /\ (!n. double (SUC n) = SUC (SUC (double n)))`;; (* Lemma double0 *) let double0 = section_proof [] `double 0 = 0` [ ((((use_arg_then "double")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma doubleS *) let doubleS = section_proof ["n"] `double (SUC n) = SUC (SUC (double n))` [ ((((use_arg_then "double")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma addnn *) let addnn = section_proof ["n"] `n + n = double n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) (((((use_arg_then "addn0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "double0")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "addnS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "doubleS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma mul2n *) let mul2n = section_proof ["m"] `2 * m = double m` [ (((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `2 = SUC 1`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mul1n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma muln2 *) let muln2 = section_proof ["m"] `m * 2 = double m` [ (((((use_arg_then "mulnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mul2n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma double_add *) let double_add = section_proof ["m";"n"] `double (m + n) = double m + double n` [ (((repeat_tactic 1 9 (((use_arg_then "addnn")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((fun arg_tac -> (use_arg_then "addnCA") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [(`n + _1`)]))))) THEN (done_tac)); ];; (* Lemma double_sub *) let double_sub = section_proof ["m";"n"] `double (m - n) = double m - double n` [ ((((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN ((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; ((move ["m"]) THEN (move ["IHm"]))]) THEN ((THENL) case [ALL_TAC; (move ["n"])])) THEN ((repeat_tactic 0 10 (((use_arg_then "sub0n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "subn0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "double0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "subn0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "sub0n")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((repeat_tactic 1 9 (((use_arg_then "doubleS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "subSS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IHm")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_double *) let leq_double = section_proof ["m";"n"] `(double m <= double n <=> m <= n)` [ (((repeat_tactic 1 9 (((use_arg_then "leqE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "double_sub")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((THENL) (((fun arg_tac -> arg_tac (Arg_term (`m - n`))) (disch_tac [])) THEN case) [ALL_TAC; (move ["n"])]) THEN (((use_arg_then "double")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma ltn_double *) let ltn_double = section_proof ["m";"n"] `(double m < double n) = (m < n)` [ (((repeat_tactic 2 0 (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_double")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma ltn_Sdouble *) let ltn_Sdouble = section_proof ["m";"n"] `(SUC (double m) < double n) = (m < n)` [ ((repeat_tactic 1 9 (((use_arg_then "muln2")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma leq_Sdouble *) let leq_Sdouble = section_proof ["m";"n"] `(double m <= SUC (double n)) = (m <= n)` [ (((((use_arg_then "leqNgt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltn_Sdouble")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqNgt")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma odd_double *) let odd_double = section_proof ["n"] `odd (double n) = F` [ (((((use_arg_then "addnn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "odd_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addbb")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma double_gt0 *) let double_gt0 = section_proof ["n"] `(0 < double n) = (0 < n)` [ (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN case) [ALL_TAC; (move ["n"])]) THEN ((repeat_tactic 0 10 (((use_arg_then "double0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "doubleS")(thm_tac (new_rewrite [] []))))) THEN (arith_tac)); ];; (* Lemma double_eq0 *) let double_eq0 = section_proof ["n"] `(double n = 0) = (n = 0)` [ (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN case) [ALL_TAC; (move ["n"])]) THEN ((repeat_tactic 0 10 (((use_arg_then "double0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "doubleS")(thm_tac (new_rewrite [] []))))) THEN (arith_tac)); ];; (* Lemma double_mull *) let double_mull = section_proof ["m";"n"] `double (m * n) = double m * n` [ (((repeat_tactic 1 9 (((use_arg_then "mul2n")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "mulnA")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma double_mulr *) let double_mulr = section_proof ["m";"n"] `double (m * n) = m * double n` [ (((repeat_tactic 1 9 (((use_arg_then "muln2")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "mulnA")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; let half_def = define `HALF 0 = (0, 0) /\ !n. HALF (SUC n) = (SND (HALF n), SUC (FST (HALF n)))`;; let half = new_basic_definition `half = FST o HALF`;; let uphalf = new_basic_definition `uphalf = SND o HALF`;; (* Lemma half0 *) let half0 = section_proof [] `half 0 = 0` [ (((((use_arg_then "half")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "o_DEF")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (simp_tac) THEN (((use_arg_then "half_def")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma uphalf0 *) let uphalf0 = section_proof [] `uphalf 0 = 0` [ (((((use_arg_then "uphalf")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "o_DEF")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (simp_tac) THEN (((use_arg_then "half_def")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma halfS *) let halfS = section_proof ["n"] `half (SUC n) = uphalf n` [ (((((use_arg_then "half")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "uphalf")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "o_DEF")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (simp_tac) THEN (((use_arg_then "half_def")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma uphalfS *) let uphalfS = section_proof ["n"] `uphalf (SUC n) = SUC (half n)` [ (((((use_arg_then "half")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "uphalf")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "o_DEF")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (simp_tac) THEN (((use_arg_then "half_def")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma doubleK *) let doubleK = section_proof ["x"] `half (double x) = x` [ ((THENL_FIRST) ((THENL) (((use_arg_then "x") (disch_tac [])) THEN (clear_assumption "x") THEN elim) [ALL_TAC; (move ["n"])]) (((((use_arg_then "double0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "half0")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((((use_arg_then "doubleS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "halfS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "uphalfS")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; let half_double = doubleK;; (* Lemma double_inj *) let double_inj = section_proof [] `!m n. double m = double n ==> m = n` [ (BETA_TAC THEN (move ["m"]) THEN (move ["n"])); ((((((use_arg_then "doubleK")(gsym_then (thm_tac (new_rewrite [2] [(`m`)]))))) THEN (((use_arg_then "doubleK")(gsym_then (thm_tac (new_rewrite [2] [(`n`)])))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma uphalf_double *) let uphalf_double = section_proof ["n"] `uphalf (double n) = n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; (move ["n"])]) (((((use_arg_then "double0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "uphalf0")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((((use_arg_then "doubleS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "uphalfS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "halfS")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma uphalf_half *) let uphalf_half = section_proof ["n"] `uphalf n = (if odd n then 1 else 0) + half n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) (((((use_arg_then "uphalf0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "half0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addn0")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "halfS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "oddS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "uphalfS")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> arg_tac (Arg_term (`odd n`))) (disch_tac [])) THEN case THEN (simp_tac)) THEN ((((fun arg_tac ->(use_arg_then "add0n")(fun tmp_arg1 -> (use_arg_then "addn0")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add1n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma odd_double_half *) let odd_double_half = section_proof ["n"] `(if odd n then 1 else 0) + double (half n) = n` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) (((((use_arg_then "odd0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "half0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "double0")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "addn0")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "IHn")(gsym_then (thm_tac (new_rewrite [3] []))))) THEN (((use_arg_then "halfS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "uphalf_half")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "double_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "oddS")(thm_tac (new_rewrite [] []))))); (((use_arg_then "IHn") (disch_tac [])) THEN (clear_assumption "IHn") THEN BETA_TAC THEN (move ["_"])); ((((fun arg_tac -> arg_tac (Arg_term (`odd n`))) (disch_tac [])) THEN case THEN (simp_tac)) THEN ((repeat_tactic 0 10 (((use_arg_then "double0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "add0n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add1n")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "doubleS")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "addSn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "double0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma half_bit_double *) let half_bit_double = section_proof ["n";"b"] `half ((if b then 1 else 0) + double n) = n` [ ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN case) THEN ((simp_tac) THEN (repeat_tactic 0 10 (((use_arg_then "add0n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "add1n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "halfS")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac ->(use_arg_then "half_double")(fun tmp_arg1 -> (use_arg_then "uphalf_double")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma half_add *) let half_add = section_proof ["m";"n"] `half (m + n) = (if odd m /\ odd n then 1 else 0) + (half m + half n)` [ ((((use_arg_then "odd_double_half")(gsym_then (thm_tac (new_rewrite [1] [(`n`)]))))) THEN (((use_arg_then "addnCA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "odd_double_half")(gsym_then (thm_tac (new_rewrite [1] [(`m`)]))))) THEN (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "double_add")(gsym_then (thm_tac (new_rewrite [] [])))))); ((repeat_tactic 2 0 ((((fun arg_tac -> arg_tac (Arg_term (`odd _`))) (disch_tac [])) THEN case))) THEN ((simp_tac) THEN (repeat_tactic 0 10 (((use_arg_then "add0n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "half_double")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "add1n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "halfS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "uphalfS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "uphalf_double")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); ((((use_arg_then "half_double")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma half_leq *) let half_leq = section_proof ["m";"n"] `m <= n ==> half m <= half n` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "subnK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "half_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_addl")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma half_gt0 *) let half_gt0 = section_proof ["n"] `(0 < half n) = (1 < n)` [ (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN case) [ALL_TAC; (case THEN ALL_TAC)]) THEN ((repeat_tactic 0 10 (((use_arg_then "halfS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "uphalfS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "uphalf0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "half0")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma mulnn *) let mulnn = section_proof ["m"] `m * m = m ^ 2` [ (((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `2 = SUC (SUC 0)`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "expnS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "expn0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "muln1")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma sqrn_add *) let sqrn_add = section_proof ["m";"n"] `(m + n) ^ 2 = (m ^ 2 + n ^ 2) + 2 * (m * n)` [ ((repeat_tactic 1 9 (((use_arg_then "mulnn")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "mul2n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "muln_addr")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "muln_addl")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "mulnC") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] []))))))); (((((use_arg_then "EQ_ADD_LCANCEL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma sqrn_sub *) let sqrn_sub = section_proof ["m";"n"] `n <= m ==> (m - n) ^ 2 = (m ^ 2 + n ^ 2) - 2 * (m * n)` [ ((DISCH_THEN (fun snd_th -> (use_arg_then "subnK") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["def_m"])); ((((use_arg_then "def_m")(gsym_then (thm_tac (new_rewrite [2] []))))) THEN (((use_arg_then "sqrn_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnAC")(thm_tac (new_rewrite [] []))))); (((repeat_tactic 2 0 (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "addnn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mul2n")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "muln_addr")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "mulnn")(gsym_then (thm_tac (new_rewrite [] [(`n EXP 2`)]))))) THEN (((use_arg_then "muln_addl")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "def_m")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnK")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma sqrn_add_sub *) let sqrn_add_sub = section_proof ["m";"n"] `n <= m ==> (m + n) ^ 2 - 4 * (m * n) = (m - n) ^ 2` [ ((BETA_TAC THEN (move ["le_nm"])) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `4 = 2 * 2`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulnA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "mul2n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subn_sub")(gsym_then (thm_tac (new_rewrite [] []))))))); (((((use_arg_then "sqrn_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnK")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "sqrn_sub")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma subn_sqr *) let subn_sqr = section_proof ["m";"n"] `m ^ 2 - n ^ 2 = (m - n) * (m + n)` [ (((((use_arg_then "muln_subl")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "muln_addr")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "mulnC") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subn_add2l")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "mulnn")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma ltn_sqr *) let ltn_sqr = section_proof ["m";"n"] `(m ^ 2 < n ^ 2) = (m < n)` [ (((((use_arg_then "ltn_exp2r")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma leq_sqr *) let leq_sqr = section_proof ["m";"n"] `(m ^ 2 <= n ^ 2) = (m <= n)` [ (((((use_arg_then "leq_exp2r")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma sqrn_gt0 *) let sqrn_gt0 = section_proof ["n"] `(0 < n ^ 2) = (0 < n)` [ ((THENL_FIRST) ((((fun arg_tac -> (use_arg_then "ltn_sqr") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((use_arg_then "exp0n")(thm_tac (new_rewrite [] []))))) ((arith_tac) THEN (done_tac))); ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma eqn_sqr *) let eqn_sqr = section_proof ["m";"n"] `(m ^ 2 = n ^ 2) = (m = n)` [ (((((use_arg_then "eqn_exp2r")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma sqrn_inj *) let sqrn_inj = section_proof ["m";"n"] `m ^ 2 = n ^ 2 ==> m = n` [ (BETA_TAC THEN (move ["eq"])); (((fun arg_tac -> (use_arg_then "expIn") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 < 2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (move ["inj"])); ((((fun arg_tac -> (use_arg_then "inj") (fun fst_arg -> (use_arg_then "eq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; let leqif = new_definition `!m n c. leqif m n c <=> (m <= n /\ ((m = n) <=> c))`;; (* Lemma leqifP *) let leqifP = section_proof ["m";"n";"c"] `leqif m n c <=> if c then m = n else m < n` [ ((THENL_FIRST) (((((use_arg_then "ltn_neqAle")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqif")(thm_tac (new_rewrite [] []))))) THEN (split_tac)) ((((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (done_tac))); ((((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN case THEN (simp_tac)) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma leqif_imp_le *) let leqif_imp_le = section_proof ["m";"n";"c"] `leqif m n c ==> m <= n` [ (((((use_arg_then "leqif")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma leqif_imp_eq *) let leqif_imp_eq = section_proof ["m";"n";"c"] `leqif m n c ==> (m = n <=> c)` [ (((((use_arg_then "leqif")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma leqif_refl *) let leqif_refl = section_proof ["m";"c"] `(leqif m m c) <=> c` [ (((((use_arg_then "leqif")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leqif_trans *) let leqif_trans = section_proof ["m1";"m2";"m3";"c1";"c2"] `leqif m1 m2 c1 ==> leqif m2 m3 c2 ==> leqif m1 m3 (c1 /\ c2)` [ (repeat_tactic 1 9 (((use_arg_then "leqifP")(thm_tac (new_rewrite [] []))))); ((THENL_FIRST) ((((use_arg_then "c1") (disch_tac [])) THEN (clear_assumption "c1") THEN case) THEN (((use_arg_then "c2") (disch_tac [])) THEN (clear_assumption "c2") THEN case THEN (simp_tac) THEN (move ["lt12"]))) ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac))); ((repeat_tactic 1 9 (((use_arg_then "ltE")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leq_trans") (disch_tac [])) THEN (clear_assumption "leq_trans") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "leqSS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltnW") (disch_tac [])) THEN (clear_assumption "ltnW") THEN (exact_tac)) THEN (done_tac)); ];; (* Lemma monotone_leqif *) let monotone_leqif = section_proof ["f"] `(!m n. f m <= f n <=> m <= n) ==> !m n c. (leqif (f m) (f n) c) <=> (leqif m n c)` [ (BETA_TAC THEN (move ["f_mono"]) THEN (move ["m"]) THEN (move ["n"]) THEN (move ["c"])); (((repeat_tactic 1 9 (((use_arg_then "leqifP")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "f_mono")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma leqif_geq *) let leqif_geq = section_proof ["m";"n"] `m <= n ==> leqif m n (n <= m)` [ ((BETA_TAC THEN (move ["lemn"])) THEN (((use_arg_then "leqif")(thm_tac (new_rewrite [] [])))) THEN ((split_tac) THEN ((TRY done_tac))) THEN (((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "lemn")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma leqif_eq *) let leqif_eq = section_proof ["m";"n"] `m <= n ==> leqif m n (m = n)` [ ((((use_arg_then "leqif")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma geq_leqif *) let geq_leqif = section_proof ["a";"b";"C"] `leqif a b C ==> ((b <= a) <=> C)` [ ((((use_arg_then "leqif")(thm_tac (new_rewrite [] [])))) THEN (case THEN (move ["le_ab"])) THEN (((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "le_ab")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma ltn_leqif *) let ltn_leqif = section_proof ["a";"b";"C"] `leqif a b C ==> (a < b <=> ~ C)` [ (BETA_TAC THEN (move ["le_ab"])); (((((use_arg_then "ltnNge")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "geq_leqif") (fun fst_arg -> (use_arg_then "le_ab") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leqif_add *) let leqif_add = section_proof ["m1";"n1";"c1";"m2";"n2";"c2"] `leqif m1 n1 c1 ==> leqif m2 n2 c2 ==> leqif (m1 + m2) (n1 + n2) (c1 /\ c2)` [ ((((fun arg_tac -> (use_arg_then "monotone_leqif") (fun fst_arg -> (fun arg_tac -> (use_arg_then "leq_add2r") (fun fst_arg -> (use_arg_then "m2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["le1"])); (((fun arg_tac -> (use_arg_then "monotone_leqif") (fun fst_arg -> (fun arg_tac -> (use_arg_then "leq_add2l") (fun fst_arg -> (use_arg_then "n1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))); (((use_arg_then "leqif_trans") (disch_tac [])) THEN (clear_assumption "leqif_trans") THEN (exact_tac)); ];; (* Lemma leqif_mul *) let leqif_mul = section_proof ["m1";"n1";"c1";"m2";"n2";"c2"] `leqif m1 n1 c1 ==> leqif m2 n2 c2 ==> leqif (m1 * m2) (n1 * n2) (n1 * n2 = 0 \/ (c1 /\ c2))` [ (BETA_TAC THEN (move ["le1"]) THEN (move ["le2"])); ((THENL) (((fun arg_tac -> (use_arg_then "posnP") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`n1 * n2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case) [(move ["n12_0"]); ALL_TAC]); ((((use_arg_then "n12_0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "le2") (disch_tac [])) THEN (clear_assumption "le2") THEN ((use_arg_then "le1") (disch_tac [])) THEN (clear_assumption "le1") THEN ((use_arg_then "n12_0") (disch_tac [])) THEN (clear_assumption "n12_0") THEN BETA_TAC) THEN (((use_arg_then "muln_eq0")(thm_tac (new_rewrite [] []))))); ((case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((THENL) (((use_arg_then "m2") (disch_tac [])) THEN (clear_assumption "m2") THEN ((use_arg_then "m1") (disch_tac [])) THEN (clear_assumption "m1") THEN case) [ALL_TAC; (move ["m"])]) THEN ((THENL) case [ALL_TAC; (move ["m'"])]) THEN ((repeat_tactic 1 9 (((use_arg_then "leqif")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "muln0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "mul0n")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (arith_tac)); ((((use_arg_then "muln_gt0")(thm_tac (new_rewrite [] [])))) THEN (BETA_TAC THEN (case THEN ((move ["n1_gt0"]) THEN (move ["n2_gt0"]))))); (((fun arg_tac -> (use_arg_then "posnP") (fun fst_arg -> (use_arg_then "m2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN ((THENL) case [(move ["m2_0"]); (move ["m2_gt0"])])); ((((use_arg_then "leqifP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "le2") (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "leqif")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN ((move ["_"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] []))))))))); (((((use_arg_then "andbC")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "leqNgt")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "m2_0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "muln0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "muln_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "n1_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "n2_gt0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "n1_gt0") (disch_tac [])) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "leq_pmul2l") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "monotone_leqif") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["Mn1"]))); (((use_arg_then "le2") (disch_tac [])) THEN (clear_assumption "le2") THEN ((use_arg_then "Mn1") (disch_tac [])) THEN (clear_assumption "Mn1") THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))); ((((use_arg_then "m2_gt0") (disch_tac [])) THEN (clear_assumption "m2_gt0") THEN (DISCH_THEN (fun snd_th -> (use_arg_then "leq_pmul2r") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "monotone_leqif") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["Mm2"]))); (((use_arg_then "le1") (disch_tac [])) THEN (clear_assumption "le1") THEN ((use_arg_then "Mm2") (disch_tac [])) THEN (clear_assumption "Mm2") THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))); (BETA_TAC THEN (move ["leq1"]) THEN (move ["leq2"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "leqif_trans") (fun fst_arg -> (use_arg_then "leq1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "leq2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "leqifP")(thm_tac (new_rewrite [] [])))))); (((fun arg_tac -> arg_tac (Arg_term (`c1 /\ c2`))) (disch_tac [])) THEN case THEN (simp_tac)); (((((use_arg_then "eqn_leq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqNgt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "muln_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "n1_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "n2_gt0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nat_Cauchy *) let nat_Cauchy = section_proof ["m";"n"] `leqif (2 * (m * n)) (m ^ 2 + n ^ 2) (m = n)` [ ((fun arg_tac -> arg_tac (Arg_term (`n <= m`))) (term_tac (wlog_tac (move ["le_nm"])[`m`; `n`]))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "leqP") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN ((TRY done_tac))) THEN (((((use_arg_then "eq_sym")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulnC")(thm_tac (new_rewrite [] [(`m * _1`)]))))) THEN (move ["mn"]))); ((((use_arg_then "le_nm") (disch_tac [])) THEN (clear_assumption "le_nm") THEN (DISCH_THEN apply_tac)) THEN (((fun arg_tac -> (use_arg_then "ltnW") (fun fst_arg -> (use_arg_then "mn") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (done_tac)); (BETA_TAC THEN (move ["le_nm"])); (((use_arg_then "leqifP")(thm_tac (new_rewrite [] [])))); ((THENL_FIRST) ((THENL) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m = n`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case) [(((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))); (move ["ne_mn"])]) (((((use_arg_then "mulnn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mul2n")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "ne_mn")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (simp_tac)) THEN ((((use_arg_then "subn_gt0")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "sqrn_sub")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "sqrn_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subn_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltn_neqAle")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eq_sym")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nat_AGM2 *) let nat_AGM2 = section_proof ["m";"n"] `leqif (4 * (m * n)) ((m + n) ^ 2) (m = n)` [ ((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `4 = 2 * 2`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "mulnA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "mul2n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addnn")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "sqrn_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqifP")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "ltn_add2r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eqn_addr")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltn_neqAle")(thm_tac (new_rewrite [] []))))); (((((fun arg_tac -> (use_arg_then "leqif_imp_eq") (fun fst_arg -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nat_Cauchy") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "leqif_imp_le") (fun fst_arg -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nat_Cauchy") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "if_same")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; let distn = new_definition `!m n. distn m n = (m - n) + (n - m)`;; (* Lemma distnC *) let distnC = section_proof ["m";"n"] `distn m n = distn n m` [ (((repeat_tactic 1 9 (((use_arg_then "distn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma distn_add2l *) let distn_add2l = section_proof ["d";"m";"n"] `distn (d + m) (d + n) = distn m n` [ (((repeat_tactic 1 9 (((use_arg_then "distn")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "subn_add2l")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma distn_add2r *) let distn_add2r = section_proof ["d";"m";"n"] `distn (m + d) (n + d) = distn m n` [ (((repeat_tactic 1 9 (((use_arg_then "distn")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "subn_add2r")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma distnEr *) let distnEr = section_proof ["m";"n"] `m <= n ==> distn m n = n - m` [ (BETA_TAC THEN (move ["le_m_n"])); (((((use_arg_then "distn")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "EQ_IMP") (fun fst_arg -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "leqE") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "le_m_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma distnEl *) let distnEl = section_proof ["m";"n"] `n <= m ==> distn m n = m - n` [ ((BETA_TAC THEN (move ["le_n_m"])) THEN ((((use_arg_then "distnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "distnEr")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma dist0n *) let dist0n = section_proof ["n"] `distn 0 n = n` [ (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN case) [ALL_TAC; (move ["m"])]) THEN ((((use_arg_then "distn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "sub0n")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "subn0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "add0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma distn0 *) let distn0 = section_proof ["n"] `distn n 0 = n` [ (((((use_arg_then "distnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dist0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma distnn *) let distnn = section_proof ["m"] `distn m m = 0` [ (((repeat_tactic 1 9 (((use_arg_then "distn")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "subnn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addn0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma distn_eq0 *) let distn_eq0 = section_proof ["m";"n"] `(distn m n = 0) <=> (m = n)` [ (((((use_arg_then "distn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "addn_eq0")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "subn_eq0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eqn_leq")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma distnS *) let distnS = section_proof ["m"] `distn m (SUC m) = 1` [ ((((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "distn_add2r") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "add0n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "add1n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dist0n")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma distSn *) let distSn = section_proof ["m"] `distn (SUC m) m = 1` [ (((((use_arg_then "distnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "distnS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma distn_eq1 *) let distn_eq1 = section_proof ["m";"n"] `(distn m n = 1) <=> (if m < n then SUC m = n else m = SUC n)` [ ((THENL) (((fun arg_tac -> (fun arg_tac -> (use_arg_then "ltnP") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case) [(move ["lt_mn"]); (move ["le_mn"])]); (((((use_arg_then "eq_sym")(thm_tac (new_rewrite [] [(`_ = 1`)])))) THEN (((fun arg_tac -> (use_arg_then "eqn_addr") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "distnEr")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "subnK")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "add1n")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((fun arg_tac -> (use_arg_then "eqn_addr") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "distnEl")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "subnK")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "add1n")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltnNge")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "le_mn")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma leqif_add_distn *) let leqif_add_distn = section_proof ["m";"n";"p"] `leqif (distn m p) (distn m n + distn n p) ((m <= n /\ n <= p) \/ (p <= n /\ n <= m))` [ (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`!m p. m <= p ==> leqif (distn m p) (distn m n + distn n p) (m <= n /\ n <= p \/ p <= n /\ n <= m)`))) (term_tac (have_gen_tac [](move ["IH"]))))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "leq_total") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "p") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN ((TRY done_tac))) THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "IH") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC)); (((((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orbC")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "distnC") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [(`distn n _`)])))) THEN (repeat_tactic 1 9 (((use_arg_then "distnC")(thm_tac (new_rewrite [] [(`distn p _`)])))))) THEN (done_tac)); (BETA_TAC THEN (move ["m"]) THEN (move ["p"]) THEN (move ["le_mp"])); ((((use_arg_then "distnEr")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((THENL) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`m <= n /\ n <= p`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case) [((case THEN ((move ["le_mn"]) THEN (move ["le_np"]))) THEN ((simp_tac THEN TRY done_tac))); ALL_TAC]); (((repeat_tactic 1 9 (((use_arg_then "distnEr")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "addnC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqifP")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((fun arg_tac -> (use_arg_then "eqn_addr") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addnA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "subnK")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((((use_arg_then "negb_and")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ltnNge")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN ALL_TAC THEN ((THENL) case [(move ["lt_nm"]); (move ["lt_pn"])])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "ltn_leq_trans") (fun fst_arg -> (use_arg_then "lt_nm") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "le_mp") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (move ["lt_np"])); (((((use_arg_then "leqifP")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "leqNgt")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "lt_nm")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "lt_np")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "ltn_addl")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "distnEr")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "ltnW")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "ltn_sub2l")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "leq_ltn_trans") (fun fst_arg -> (use_arg_then "le_mp") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "lt_pn") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (move ["lt_mn"])); (((((use_arg_then "leqifP")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "leqNgt")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "lt_mn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "lt_pn")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "ltn_addr")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "distnEr")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "ltn_sub2r")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma leq_add_distn *) let leq_add_distn = section_proof ["m";"n";"p"] `distn m p <= distn m n + distn n p` [ ((((fun arg_tac -> (use_arg_then "leqif_imp_le") (fun fst_arg -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "leqif_add_distn") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "p") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (done_tac)); ];; (* Lemma sqrn_distn *) let sqrn_distn = section_proof ["m";"n"] `(distn m n) ^ 2 + 2 * (m * n) = m ^ 2 + n ^ 2` [ ((fun arg_tac -> arg_tac (Arg_term (`n <= m`))) (term_tac (wlog_tac (move ["le_nm"])[`m`; `n`]))); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "leq_total") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (DISCH_THEN (fun snd_th -> (use_arg_then "le_nm") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN ((TRY done_tac))); (((((fun arg_tac -> (use_arg_then "addnC") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`n EXP 2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "mulnC") (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "distnC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((BETA_TAC THEN (move ["le_nm"])) THEN ((((use_arg_then "distnEl")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "sqrn_sub")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "subnK")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "leqif_imp_le") (fun fst_arg -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nat_Cauchy") (fun fst_arg -> (use_arg_then "m") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; hol-light/Formal_ineqs/list/000077500000000000000000000000001303454263000163375ustar00rootroot00000000000000hol-light/Formal_ineqs/list/list_conversions.hl000066400000000000000000000451411303454263000222740ustar00rootroot00000000000000(* =========================================================== *) (* Efficient formal list conversions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "arith/nat.hl";; needs "misc/vars.hl";; module type List_conversions_sig = sig val eval_hd : term -> thm val hd_conv : term -> thm val eval_el : term -> term -> thm val el_conv : term -> thm val fst_conv : term -> thm val snd_conv : term -> thm val eval_length : term -> thm val length_conv : term -> thm val eval_zip : term -> term -> thm val all_conv_univ : (term -> thm) -> term -> thm val all2_conv_univ : (term -> thm) -> term -> thm val eval_mem_univ : (term -> thm) -> term -> term -> thm val mem_conv_univ : (term -> thm) -> term -> thm val filter_conv_univ : (term -> thm) -> term -> thm val map_conv_univ : (term -> thm) -> term -> thm val get_all : thm -> thm list val select_all : thm -> int list -> thm list val set_of_list_conv : term -> thm end;; module List_conversions : List_conversions_sig = struct open Arith_nat;; open Arith_misc;; open Misc_vars;; let MY_RULE = UNDISCH_ALL o PURE_REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL;; let MY_RULE_NUM = UNDISCH_ALL o NUMERALS_TO_NUM o PURE_REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL;; (******************************) (* HD conversions *) let HD_A_CONS = prove(`HD (CONS (h:A) t) = h`, REWRITE_TAC[HD]);; (* Takes a term `[a;...]` and returns the theorem |- HD [a;...] = a *) let eval_hd list_tm = let ltm, t_tm = dest_comb list_tm in let h_tm = rand ltm in let list_ty = type_of t_tm and ty = type_of h_tm in let h_var = mk_var("h", ty) and t_var = mk_var("t", list_ty) in (INST[h_tm, h_var; t_tm, t_var] o INST_TYPE[ty, aty]) HD_A_CONS;; (* Takes a term `HD [a;...]` and returns the theorem |- HD [a;...] = a *) let hd_conv hd_tm = if (fst o dest_const o rator) hd_tm <> "HD" then failwith "hd_conv" else eval_hd (rand hd_tm);; (*********************************) (* EL conversion *) let EL_0' = (MY_RULE_NUM o prove)(`EL 0 (CONS (h:A) t) = h`, REWRITE_TAC[EL; HD]);; let EL_n' = (MY_RULE_NUM o prove)(`0 < n /\ PRE n = m ==> EL n (CONS (h:A) t) = EL m t`, STRIP_TAC THEN SUBGOAL_THEN `n = SUC m` ASSUME_TAC THENL [ REPEAT (POP_ASSUM MP_TAC) THEN ARITH_TAC; ALL_TAC ] THEN ASM_REWRITE_TAC[EL; TL]);; (* Takes a raw numeral term and a list term and returns the theorem |- EL n [...] = x *) let eval_el n_tm list_tm = let list_ty = type_of list_tm in let ty = (hd o snd o dest_type) list_ty in let inst_t = INST_TYPE[ty, aty] in let el_0, el_n = inst_t EL_0', inst_t EL_n' in let h_var, t_var = mk_var("h", ty), mk_var("t", list_ty) in let rec el_conv_raw = fun n_tm list_tm -> let h_tm, t_tm = dest_cons list_tm in let inst0 = INST[h_tm, h_var; t_tm, t_var] in if n_tm = zero_const then inst0 el_0 else let n_gt0 = (EQT_ELIM o raw_gt0_hash_conv) n_tm in let pre_n = raw_pre_hash_conv (mk_comb (pre_op_num, n_tm)) in let m_tm = (rand o concl) pre_n in let th0 = (MY_PROVE_HYP pre_n o MY_PROVE_HYP n_gt0 o INST[n_tm, n_var_num; m_tm, m_var_num] o inst0) el_n in let th1 = el_conv_raw m_tm t_tm in TRANS th0 th1 in el_conv_raw n_tm list_tm;; (* Takes a term `EL n [...]` and returns the theorem |- EL n [...] = x *) (* Note: n must be a raw numeral term Dx (Dy ... _0) *) let el_conv el_tm = let ltm, list_tm = dest_comb el_tm in let el, n_tm = dest_comb ltm in if (fst o dest_const) el <> "EL" then failwith "el_conv" else eval_el n_tm list_tm;; (*******************************) (* FST, SND conversions *) let FST' = ISPECL[`x:A`; `y:B`] FST;; let SND' = ISPECL[`x:A`; `y:B`] SND;; let fst_conv tm = let x_tm, y_tm = dest_pair (rand tm) in let x_ty, y_ty = type_of x_tm, type_of y_tm in let x_var, y_var = mk_var("x", x_ty), mk_var("y", y_ty) in (INST[x_tm, x_var; y_tm, y_var] o INST_TYPE[x_ty, aty; y_ty, bty]) FST';; let snd_conv tm = let x_tm, y_tm = dest_pair (rand tm) in let x_ty, y_ty = type_of x_tm, type_of y_tm in let x_var, y_var = mk_var("x", x_ty), mk_var("y", y_ty) in (INST[x_tm, x_var; y_tm, y_var] o INST_TYPE[x_ty, aty; y_ty, bty]) SND';; (******************************) (* LENGTH conversions *) let LENGTH_0' = (MY_RULE_NUM o prove) (`LENGTH ([]:(A)list) = 0`, REWRITE_TAC[LENGTH]) and LENGTH_CONS' = prove(`LENGTH (CONS (h:A) t) = SUC (LENGTH t)`, REWRITE_TAC[LENGTH]);; (* Takes a term `[...]` and returns the theorem |- LENGTH [...] = n *) let eval_length list_tm = let list_ty = type_of list_tm in let ty = (hd o snd o dest_type) list_ty in let inst_t = INST_TYPE[ty, aty] in let length_empty, length_cons = inst_t LENGTH_0', inst_t LENGTH_CONS' in let h_var, t_var = mk_var("h", ty), mk_var("t", list_ty) in let rec length_conv_raw = fun list_tm -> if (is_comb list_tm) then let ltm, t_tm = dest_comb list_tm in let h_tm = rand ltm in let th0 = INST[h_tm, h_var; t_tm, t_var] length_cons in let th1' = length_conv_raw t_tm in let th1 = AP_TERM suc_op_num th1' in let th2 = raw_suc_conv_hash (rand(concl th1)) in TRANS (TRANS th0 th1) th2 else length_empty in length_conv_raw list_tm;; (* Takes a term `LENGTH [...]` and returns the theorem |- LENGTH [...] = n *) let length_conv length_tm = if (fst o dest_const o rator) length_tm <> "LENGTH" then failwith "length_conv" else eval_length (rand length_tm);; (************************) (* eval_zip *) let ZIP_0' = prove(`ZIP ([]:(A)list) ([]:(B)list) = []`, REWRITE_TAC[ZIP]) and ZIP_CONS' = prove(`ZIP (CONS (h1:A) t1) (CONS (h2:B) t2) = CONS (h1, h2) (ZIP t1 t2)`, REWRITE_TAC[ZIP]);; let eval_zip list1_tm list2_tm = let list1_ty = type_of list1_tm and list2_ty = type_of list2_tm in let ty1 = (hd o snd o dest_type) list1_ty and ty2 = (hd o snd o dest_type) list2_ty in let inst_t = INST_TYPE[ty1, aty; ty2, bty] in let zip0, zip_cons = inst_t ZIP_0', inst_t ZIP_CONS' in let h1_var, t1_var = mk_var("h1", ty1), mk_var("t1", list1_ty) and h2_var, t2_var = mk_var("h2", ty2), mk_var("t2", list2_ty) in let rec zip_conv_rec = fun list1_tm list2_tm -> if (is_comb list1_tm) then let ltm1, t1_tm = dest_comb list1_tm and ltm2, t2_tm = dest_comb list2_tm in let h1_tm, h2_tm = rand ltm1, rand ltm2 in let th0 = INST[h1_tm, h1_var; t1_tm, t1_var; h2_tm, h2_var; t2_tm, t2_var] zip_cons in let cons_tm = (rator o rand o concl) th0 in let th1' = zip_conv_rec t1_tm t2_tm in let th1 = AP_TERM cons_tm th1' in TRANS th0 th1 else zip0 in zip_conv_rec list1_tm list2_tm;; (******************) (* ALL conversion *) (******************) let ALL_0' = prove(`ALL P ([]:(A)list) <=> T`, REWRITE_TAC[ALL]) and ALL_CONS_T' = (MY_RULE o prove)(`(P h <=> T) /\ (ALL P t <=> T) ==> (ALL P (CONS (h:A) t) <=> T)`, REWRITE_TAC[ALL]) and ALL_CONS_F2' = (MY_RULE o prove)(`(ALL P t <=> F) ==> (ALL P (CONS (h:A) t) <=> F)`, SIMP_TAC[ALL]) and ALL_CONS_F1' = (MY_RULE o prove)(`(P h <=> F) ==> (ALL P (CONS (h:A) t) <=> F)`, SIMP_TAC[ALL]);; (* Note: p_conv should return theorems of the form |- P a <=> T *) let all_conv_univ p_conv tm = let ltm, list_tm = dest_comb tm in let p_tm = rand ltm in let list_ty = type_of list_tm and p_ty = type_of p_tm in let ty = (hd o snd o dest_type) list_ty in let inst_t = INST_TYPE[ty, aty] in let all_0, all_t, all_f1, all_f2 = inst_t ALL_0', inst_t ALL_CONS_T', inst_t ALL_CONS_F1', inst_t ALL_CONS_F2' in let h_var, t_var = mk_var("h", ty), mk_var("t", list_ty) and p_var = mk_var("P", p_ty) in let rec all_conv_rec = fun list_tm -> if is_comb list_tm then let ltm, t_tm = dest_comb list_tm in let h_tm = rand ltm in let p_th = p_conv (mk_comb (p_tm, h_tm)) in let inst = INST[h_tm, h_var; t_tm, t_var; p_tm, p_var] in if (rand o concl) p_th = t_const then let all_th = all_conv_rec t_tm in if (rand o concl) all_th = t_const then (MY_PROVE_HYP all_th o MY_PROVE_HYP p_th o inst) all_t else (MY_PROVE_HYP all_th o inst) all_f2 else (MY_PROVE_HYP p_th o inst) all_f1 else INST[p_tm, p_var] all_0 in all_conv_rec list_tm;; (*******************) (* ALL2 conversion *) (*******************) let ALL2_0' = prove(`ALL2 P ([]:(A)list) ([]:(B)list) <=> T`, REWRITE_TAC[ALL2]) and ALL2_CONS_T' = (MY_RULE o prove)(`(P h1 h2 <=> T) /\ (ALL2 P t1 t2 <=> T) ==> (ALL2 P (CONS (h1:A) t1) (CONS (h2:B) t2) <=> T)`, REWRITE_TAC[ALL2]) and ALL2_CONS_F2' = (MY_RULE o prove)(`(ALL2 P t1 t2 <=> F) ==> (ALL2 P (CONS (h1:A) t1) (CONS (h2:B) t2) <=> F)`, SIMP_TAC[ALL2]) and ALL2_CONS_F1' = (MY_RULE o prove)(`(P h1 h2 <=> F) ==> (ALL2 P (CONS (h1:A) t1) (CONS (h2:B) t2) <=> F)`, SIMP_TAC[ALL2]);; (* Note: p_conv should return theorems of the form |- P a b <=> T *) let all2_conv_univ p_conv tm = let ltm, list2_tm = dest_comb tm in let ltm2, list1_tm = dest_comb ltm in let p_tm = rand ltm2 in let list1_ty = type_of list1_tm and list2_ty = type_of list2_tm and p_ty = type_of p_tm in let ty1 = (hd o snd o dest_type) list1_ty and ty2 = (hd o snd o dest_type) list2_ty in let inst_t = INST_TYPE[ty1, aty; ty2, bty] in let all2_0, all2_t, all2_f1, all2_f2 = inst_t ALL2_0', inst_t ALL2_CONS_T', inst_t ALL2_CONS_F1', inst_t ALL2_CONS_F2' in let h1_var, t1_var = mk_var("h1", ty1), mk_var("t1", list1_ty) and h2_var, t2_var = mk_var("h2", ty2), mk_var("t2", list2_ty) and p_var = mk_var("P", p_ty) in let rec all2_conv_rec = fun list1_tm list2_tm -> if is_comb list1_tm then let ltm1, t1_tm = dest_comb list1_tm and ltm2, t2_tm = dest_comb list2_tm in let h1_tm, h2_tm = rand ltm1, rand ltm2 in let p_th = p_conv (mk_binop p_tm h1_tm h2_tm) in let inst = INST[h1_tm, h1_var; t1_tm, t1_var; h2_tm, h2_var; t2_tm, t2_var; p_tm, p_var] in if (rand o concl) p_th = t_const then let all2_th = all2_conv_rec t1_tm t2_tm in if (rand o concl) all2_th = t_const then (MY_PROVE_HYP all2_th o MY_PROVE_HYP p_th o inst) all2_t else (MY_PROVE_HYP all2_th o inst) all2_f2 else (MY_PROVE_HYP p_th o inst) all2_f1 else if is_comb list2_tm then failwith ("all2_conv_univ: l1 = []; l2 = "^string_of_term list2_tm) else INST[p_tm, p_var] all2_0 in all2_conv_rec list1_tm list2_tm;; (******************************) (* MEM conversions *) let MEM_A_EMPTY = prove(`MEM (x:A) [] <=> F`, REWRITE_TAC[MEM]) and MEM_A_HD = MY_RULE (prove(`(x = h <=> T) ==> (MEM (x:A) (CONS h t) <=> T)`,SIMP_TAC[MEM])) and MEM_A_TL = MY_RULE (prove(`(x = h <=> F) ==> (MEM (x:A) (CONS h t) <=> MEM x t)`, SIMP_TAC[MEM]));; let rec eval_mem_univ eq_conv x_tm list_tm = let ty = type_of x_tm in let inst_t = INST_TYPE[ty, aty] in let mem_empty, mem_hd, mem_tl = inst_t MEM_A_EMPTY, inst_t MEM_A_HD, inst_t MEM_A_TL in let x_var, h_var = mk_var("x", ty), mk_var("h", ty) and t_var = mk_var("t", mk_type("list", [ty])) in let rec mem_conv_raw list_tm = if (is_comb list_tm) then let h_tm', t_tm = dest_comb list_tm in let h_tm = rand h_tm' in let eq_th = eq_conv (mk_eq(x_tm, h_tm)) in if (rand(concl eq_th) = t_const) then let th0' = INST[x_tm, x_var; h_tm, h_var; t_tm, t_var] mem_hd in MY_PROVE_HYP eq_th th0' else let th0' = INST[x_tm, x_var; h_tm, h_var; t_tm, t_var] mem_tl in let th0 = MY_PROVE_HYP eq_th th0' in let th1 = mem_conv_raw t_tm in TRANS th0 th1 else INST[x_tm, x_var] mem_empty in mem_conv_raw list_tm;; let mem_conv_univ eq_conv mem_tm = let ltm, list_tm = dest_comb mem_tm in let c_tm, x_tm = dest_comb ltm in if (fst o dest_const) c_tm <> "MEM" then failwith "mem_conv_univ" else eval_mem_univ eq_conv x_tm list_tm;; (**********************************) (* FILTER conversions *) let FILTER_A_EMPTY = prove(`FILTER (P:A->bool) [] = []`, REWRITE_TAC[FILTER]) and FILTER_A_HD = (MY_RULE o prove)(`(P h <=> T) ==> FILTER (P:A->bool) (CONS h t) = CONS h (FILTER P t)`, SIMP_TAC[FILTER]) and FILTER_A_TL = (MY_RULE o prove)(`(P h <=> F) ==> FILTER (P:A->bool) (CONS h t) = FILTER P t`, SIMP_TAC[FILTER]);; let filter_conv_univ p_conv tm = let ltm, list_tm = dest_comb tm in let p_tm = rand ltm in let p_ty = type_of p_tm in let ty = (hd o snd o dest_type) p_ty in let inst_t = INST_TYPE[ty, aty] in let filter_empty, filter_hd, filter_tl = inst_t FILTER_A_EMPTY, inst_t FILTER_A_HD, inst_t FILTER_A_TL in let p_var = mk_var("P", p_ty) in let h_var = mk_var("h", ty) in let t_var = mk_var("t", mk_type("list",[ty])) in let rec filter_conv_raw = fun list_tm -> if (is_comb list_tm) then let ltm, t_tm = dest_comb list_tm in let h_tm = rand ltm in let p_th = p_conv (mk_comb(p_tm, h_tm)) in if (rand(concl p_th) = t_const) then let th0' = INST[p_tm, p_var; h_tm, h_var; t_tm, t_var] filter_hd in let th0 = MY_PROVE_HYP p_th th0' in let ltm = rator(rand(concl th0)) in let th1 = filter_conv_raw t_tm in TRANS th0 (AP_TERM ltm th1) else let th0' = INST[p_tm, p_var; h_tm, h_var; t_tm, t_var] filter_tl in let th0 = MY_PROVE_HYP p_th th0' in let th1 = filter_conv_raw t_tm in TRANS th0 th1 else INST[p_tm, p_var] filter_empty in filter_conv_raw list_tm;; (***************************) (* MAP conversions *) let MAP_AB_EMPTY = prove(`MAP (f:A->B) [] = []`, REWRITE_TAC[MAP]) and MAP_AB_CONS = prove(`MAP (f:A->B) (CONS h t) = CONS (f h) (MAP f t)`, REWRITE_TAC[MAP]);; let map_conv_univ f_conv tm = let ltm, list_tm = dest_comb tm in let ftm = rand ltm in let ftm_ty = type_of ftm in let f_var = mk_var("f", ftm_ty) in let [a_type; b_type] = snd(dest_type ftm_ty) in let h_var = mk_var("h", a_type) in let t_var = mk_var("t", mk_type("list", [a_type])) in let inst_t = INST[ftm, f_var] o INST_TYPE[a_type, aty; b_type, bty] in let map_empty, map_cons = inst_t MAP_AB_EMPTY, inst_t MAP_AB_CONS in let rec map_conv_raw list_tm = if (is_comb list_tm) then let h_tm', t_tm = dest_comb list_tm in let h_tm = rand h_tm' in let th0 = INST[h_tm, h_var; t_tm, t_var] map_cons in let ltm, rtm = dest_comb (rand(concl th0)) in let cons_tm, f_h_tm = dest_comb ltm in let f_h_th = f_conv f_h_tm in let map_t_th = map_conv_raw t_tm in TRANS th0 (MK_COMB (AP_TERM cons_tm f_h_th, map_t_th)) else map_empty in map_conv_raw list_tm;; (*****************************************) (* ALL rules *) let ALL_A_HD = UNDISCH_ALL(prove(`ALL (P:A->bool) (CONS h t) ==> P h`, SIMP_TAC[ALL])) and ALL_A_TL = UNDISCH_ALL(prove(`ALL (P:A->bool) (CONS h t) ==> ALL P t`, SIMP_TAC[ALL]));; (* Given a theorem `ALL P list` returns the list of theorems (P x1),...,(P xn) *) let get_all th = let ltm, list_tm = dest_comb (concl th) in let p_tm = rand ltm in let list_ty = type_of list_tm in let p_ty = type_of p_tm in let ty = (hd o snd o dest_type) list_ty in let p_var = mk_var("P", p_ty) in let h_var = mk_var("h", ty) in let t_var = mk_var("t", list_ty) in let inst_t = INST[p_tm, p_var] o INST_TYPE[ty, aty] in let all_hd, all_tl = inst_t ALL_A_HD, inst_t ALL_A_TL in let rec get_all_raw all_th list_tm = if (is_comb list_tm) then let h_tm', t_tm = dest_comb list_tm in let h_tm = rand h_tm' in let inst_t = INST[h_tm, h_var; t_tm, t_var] in let th_tl = MY_PROVE_HYP all_th (inst_t all_tl) in let th_hd = MY_PROVE_HYP all_th (inst_t all_hd) in th_hd :: get_all_raw th_tl t_tm else [] in get_all_raw th list_tm;; (* Given a theorem `ALL P list`, returns (P x_i1),..., (P x_in) where i1,...,in are given indices. The list of indices should be sorted *) let select_all th indices = let ltm, list_tm = dest_comb (concl th) in let p_tm = rand ltm in let list_ty = type_of list_tm in let p_ty = type_of p_tm in let ty = (hd o snd o dest_type) list_ty in let p_var = mk_var("P", p_ty) in let h_var = mk_var("h", ty) in let t_var = mk_var("t", list_ty) in let inst_t = INST[p_tm, p_var] o INST_TYPE[ty, aty] in let all_hd, all_tl = inst_t ALL_A_HD, inst_t ALL_A_TL in let rec get_all_raw all_th list_tm indices n = match indices with [] -> [] | i::is -> let h_tm', t_tm = dest_comb list_tm in let h_tm = rand h_tm' in let inst_t = INST[h_tm, h_var; t_tm, t_var] in let th_tl = MY_PROVE_HYP all_th (inst_t all_tl) in if (i - n = 0) then let th_hd = MY_PROVE_HYP all_th (inst_t all_hd) in th_hd :: get_all_raw th_tl t_tm is (n + 1) else get_all_raw th_tl t_tm (i::is) (n + 1) in get_all_raw th list_tm indices 0;; (*****************************************) (* set_of_list conversions *) let SET_OF_LIST_A_EMPTY = prove(`set_of_list ([]:(A)list) = {}`, REWRITE_TAC[set_of_list]) and SET_OF_LIST_A_H = prove(`set_of_list [h:A] = {h}`, REWRITE_TAC[set_of_list]) and SET_OF_LIST_A_CONS = prove(`set_of_list (CONS (h:A) t) = h INSERT set_of_list t`, REWRITE_TAC[set_of_list]);; let set_of_list_conv tm = let list_tm = rand tm in let list_ty = type_of list_tm in let ty = (hd o snd o dest_type) list_ty in let h_var = mk_var("h", ty) in let t_var = mk_var("t", list_ty) in let inst_t = INST_TYPE[ty, aty] in let set_of_list_h, set_of_list_cons = inst_t SET_OF_LIST_A_H, inst_t SET_OF_LIST_A_CONS in let rec set_of_list_conv_raw = fun h_tm t_tm -> if (is_comb t_tm) then let h_tm', t_tm' = dest_comb t_tm in let th0 = INST[h_tm, h_var; t_tm, t_var] set_of_list_cons in let ltm, rtm = dest_comb(rand(concl th0)) in TRANS th0 (AP_TERM ltm (set_of_list_conv_raw (rand h_tm') t_tm')) else INST[h_tm, h_var] set_of_list_h in if (is_comb list_tm) then let h_tm, t_tm = dest_comb list_tm in set_of_list_conv_raw (rand h_tm) t_tm else inst_t SET_OF_LIST_A_EMPTY;; end;; hol-light/Formal_ineqs/list/list_float.hl000066400000000000000000000175121303454263000210320ustar00rootroot00000000000000(* =========================================================== *) (* Special list conversions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "arith/more_float.hl";; needs "list/list_conversions.hl";; needs "misc/vars.hl";; module type List_float_sig = sig val list_sum : thm val list_sum2 : thm val error_mul_f2 : thm val error_mul_f1 : thm val list_sum_conv : (term -> thm) -> term -> thm val list_sum2_le_conv : int -> (int -> term -> term -> thm) -> term -> thm val error_mul_f2_le_conv : int -> term -> term -> thm val error_mul_f2_le_conv2 : int -> term -> term -> thm val error_mul_f1_le_conv : term -> int -> term -> term -> thm end;; module List_float : List_float_sig = struct open Arith_misc;; open Arith_nat;; open Arith_float;; open More_float;; open Float_theory;; open List_conversions;; open Misc_vars;; let MY_RULE_FLOAT = UNDISCH_ALL o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def; GSYM IMP_IMP] o SPEC_ALL;; (****************************) (* new definitions *) let list_sum = new_definition `list_sum list f = ITLIST (\t1 t2. f t1 + t2) list (&0)`;; let list_sum2 = new_definition `list_sum2 f l1 l2 = ITLIST2 (\a b c. f a b + c) l1 l2 (&0)`;; let error_mul_f2 = new_definition `error_mul_f2 a int = a * iabs int`;; let error_mul_f1 = new_definition `error_mul_f1 w x list = x * list_sum2 error_mul_f2 w list`;; (*************************************) (* list_sum conversions *) let LIST_SUM_A_EMPTY = prove(`list_sum [] (f:A->real) = &0`, REWRITE_TAC[list_sum; ITLIST]) and LIST_SUM_A_H = prove(`list_sum [h:A] f = f h`, REWRITE_TAC[list_sum; ITLIST; REAL_ADD_RID]) and LIST_SUM_A_CONS = prove(`list_sum (CONS (h:A) t) f = f h + list_sum t f`, REWRITE_TAC[list_sum; ITLIST]);; let list_sum_conv f_conv tm = let ltm, f_tm = dest_comb tm in let list_tm = rand ltm in let list_ty = type_of list_tm in let f_ty = type_of f_tm in let ty = (hd o snd o dest_type) list_ty in let f_var = mk_var("f", f_ty) and h_var = mk_var("h", ty) and t_var = mk_var("t", list_ty) in let inst_t = INST[f_tm, f_var] o INST_TYPE[ty, aty] in let list_sum_h = inst_t LIST_SUM_A_H and list_sum_cons = inst_t LIST_SUM_A_CONS in let rec list_sum_conv_raw = fun h_tm t_tm -> if (is_comb t_tm) then let h_tm', t_tm' = dest_comb t_tm in let th0 = INST[h_tm, h_var; t_tm, t_var] list_sum_cons in let ltm, rtm = dest_comb(rand(concl th0)) in let plus_op, fh_tm = dest_comb ltm in let f_th = f_conv fh_tm in let th1 = list_sum_conv_raw (rand h_tm') t_tm' in let th2 = MK_COMB(AP_TERM plus_op f_th, th1) in TRANS th0 th2 else let th0 = INST[h_tm, h_var] list_sum_h in let f_th = f_conv (rand(concl th0)) in TRANS th0 f_th in if (is_comb list_tm) then let h_tm, t_tm = dest_comb list_tm in list_sum_conv_raw (rand h_tm) t_tm else inst_t LIST_SUM_A_EMPTY;; (*************************************) (* list_sum2 evaluation *) let LIST_SUM2_0_LE' = (MY_RULE_FLOAT o prove)(`list_sum2 (f:A->B->real) [] [] <= &0`, REWRITE_TAC[list_sum2; ITLIST2; REAL_LE_REFL]);; let LIST_SUM2_1_LE' = (MY_RULE_FLOAT o prove)(`f h1 h2 <= x ==> list_sum2 (f:A->B->real) [h1] [h2] <= x`, REWRITE_TAC[list_sum2; ITLIST2; REAL_ADD_RID]);; let LIST_SUM2_LE' = (MY_RULE_FLOAT o prove)(`f h1 h2 <= x /\ list_sum2 f t1 t2 <= y /\ x + y <= z ==> list_sum2 (f:A->B->real) (CONS h1 t1) (CONS h2 t2) <= z`, REWRITE_TAC[list_sum2; ITLIST2] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x + y:real` THEN ASM_SIMP_TAC[REAL_LE_ADD2]);; let list_sum2_le_conv pp f_le_conv tm = let ltm, list2_tm = dest_comb tm in let ltm2, list1_tm = dest_comb ltm in let f_tm = rand ltm2 in let list1_ty = type_of list1_tm and list2_ty = type_of list2_tm and f_ty = type_of f_tm in let ty1 = (hd o snd o dest_type) list1_ty and ty2 = (hd o snd o dest_type) list2_ty in let f_var = mk_var ("f", f_ty) and h1_var, t1_var = mk_var ("h1", ty1), mk_var ("t1", list1_ty) and h2_var, t2_var = mk_var ("h2", ty2), mk_var ("t2", list2_ty) in let inst_t = INST[f_tm, f_var] o INST_TYPE[ty1, aty; ty2, bty] in let list2_0, list2_1, list2_le = inst_t LIST_SUM2_0_LE', inst_t LIST_SUM2_1_LE', inst_t LIST_SUM2_LE' in let rec rec_conv = fun list1_tm list2_tm -> if (is_comb list1_tm) then let h1_tm, t1_tm = dest_cons list1_tm and h2_tm, t2_tm = dest_cons list2_tm in let f_le_th = f_le_conv pp h1_tm h2_tm in let x_tm = (rand o concl) f_le_th in let inst0 = INST[h1_tm, h1_var; h2_tm, h2_var; x_tm, x_var_real] in if is_comb t1_tm then let sum2_t_th = rec_conv t1_tm t2_tm in let y_tm = (rand o concl) sum2_t_th in let xy_th = float_add_hi pp x_tm y_tm in let z_tm = (rand o concl) xy_th in (MY_PROVE_HYP xy_th o MY_PROVE_HYP sum2_t_th o MY_PROVE_HYP f_le_th o INST[y_tm, y_var_real; z_tm, z_var_real; t1_tm, t1_var; t2_tm, t2_var] o inst0) list2_le else if is_comb t2_tm then failwith ("sum2_le_conv: t1 = []; t2 = "^string_of_term t2_tm) else (MY_PROVE_HYP f_le_th o inst0) list2_1 else if is_comb list2_tm then failwith ("sum2_le_conv: list1 = []; list2 = "^string_of_term list2_tm) else list2_0 in rec_conv list1_tm list2_tm;; (**************************) (* \a b c. a * iabs b + c *) let ERROR_MUL_F2' = (SYM o MY_RULE_FLOAT) error_mul_f2;; (* |- x = a, |- P x y -> P a y *) let rewrite_lhs eq_th th = let ltm, rhs = dest_comb (concl th) in let th0 = AP_THM (AP_TERM (rator ltm) eq_th) rhs in EQ_MP th0 th;; let error_mul_f2_le_conv pp tm1 tm2 = let eq_th = INST[tm1, a_var_real; tm2, int_var] ERROR_MUL_F2' in let iabs_th = float_iabs tm2 in let iabs_tm = (rand o concl) iabs_th in let mul_th = float_mul_hi pp tm1 iabs_tm in let th0 = AP_TERM (mk_comb (mul_op_real, tm1)) iabs_th in let th1 = AP_THM (AP_TERM le_op_real th0) (rand (concl mul_th)) in let le_th = EQ_MP (SYM th1) mul_th in rewrite_lhs eq_th le_th;; let ERROR_MUL_F2_LEMMA' = (MY_RULE_FLOAT o prove)(`iabs int = x /\ a * x <= y ==> error_mul_f2 a int <= y`, REWRITE_TAC[error_mul_f2] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; let error_mul_f2_le_conv2 pp tm1 tm2 = let iabs_th = float_iabs tm2 in let x_tm = (rand o concl) iabs_th in let mul_th = float_mul_hi pp tm1 x_tm in let y_tm = (rand o concl) mul_th in (MY_PROVE_HYP iabs_th o MY_PROVE_HYP mul_th o INST[tm2, int_var; tm1, a_var_real; x_tm, x_var_real; y_tm, y_var_real]) ERROR_MUL_F2_LEMMA';; (**************************) (* \a b c. a * iabs b + c *) let ERROR_MUL_F1_LEMMA' = (MY_RULE_FLOAT o prove)(`x * list_sum2 error_mul_f2 w list <= z ==> error_mul_f1 w x list <= z`, REWRITE_TAC[error_mul_f1]);; let list_sum2_error2_const = `list_sum2 error_mul_f2` and w_var_list = `w:(real)list` and list_var = `list:(real#real)list`;; let error_mul_f1_le_conv w_tm pp x_tm list_tm = (* TODO: if x = 0 then do not need to compute the sum *) let sum2_tm = mk_binop list_sum2_error2_const w_tm list_tm in let sum2_le_th = list_sum2_le_conv pp error_mul_f2_le_conv2 sum2_tm in let ineq_th = mul_ineq_pos_const_hi pp x_tm sum2_le_th in let z_tm = (rand o concl) ineq_th in (MY_PROVE_HYP ineq_th o INST[x_tm, x_var_real; z_tm, z_var_real; w_tm, w_var_list; list_tm, list_var]) ERROR_MUL_F1_LEMMA';; end;; hol-light/Formal_ineqs/list/more_list.hl000066400000000000000000000115711303454263000206660ustar00rootroot00000000000000(* =========================================================== *) (* Additional list definitions and theorems *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) module More_list = struct (* definitions *) let REVERSE_TABLE = define `(REVERSE_TABLE (f:num->A) 0 = []) /\ (REVERSE_TABLE f (SUC i) = CONS (f i) ( REVERSE_TABLE f i))`;; let TABLE = new_definition `!(f:num->A) k. TABLE f k = REVERSE (REVERSE_TABLE f k)`;; let l_seq = new_definition `l_seq n m = TABLE (\i. n + i) ((m + 1) - n)`;; (* lemmas *) let LENGTH_REVERSE_TABLE = prove(`!(f:num->A) n. LENGTH (REVERSE_TABLE f n) = n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE_TABLE; LENGTH]);; let LENGTH_REVERSE = prove(`!(l:(A)list). LENGTH (REVERSE l) = LENGTH l`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[REVERSE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LENGTH_APPEND; LENGTH] THEN ARITH_TAC);; let LENGTH_TABLE = prove(`!(f:num->A) n. LENGTH (TABLE f n) = n`, REWRITE_TAC[TABLE; LENGTH_REVERSE; LENGTH_REVERSE_TABLE]);; let EL_TABLE = prove(`!(f:num->A) n i. i < n ==> EL i (TABLE f n) = f i`, REPEAT GEN_TAC THEN SPEC_TAC (`n:num`, `n:num`) THEN INDUCT_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[TABLE; REVERSE_TABLE; REVERSE; EL_APPEND] THEN REWRITE_TAC[GSYM TABLE; LENGTH_TABLE] THEN DISCH_TAC THEN COND_CASES_TAC THENL [ FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN SUBGOAL_THEN `i = n:num` (fun th -> REWRITE_TAC[th]) THENL [ POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[ARITH_RULE `n - n = 0`; EL; HD]);; let LIST_EL_EQ = prove(`!ul vl:(A)list. ul = vl <=> (LENGTH ul = LENGTH vl /\ (!j. j < LENGTH ul ==> EL j ul = EL j vl))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN SPEC_TAC (`vl:(A)list`, `vl:(A)list`) THEN SPEC_TAC (`ul:(A)list`, `ul:(A)list`) THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN SIMP_TAC[LENGTH_EQ_NIL; EQ_SYM_EQ; LENGTH; ARITH_RULE `~(0 = SUC a)`] THEN POP_ASSUM (fun th -> ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `SUC a = SUC b <=> a = b`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `t':(A)list`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `SUC j`) THEN ASM_REWRITE_TAC[ARITH_RULE `SUC a < SUC b <=> a < b`; EL; TL]; ALL_TAC ] THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `0`) THEN ASM_SIMP_TAC[ARITH_RULE `0 < SUC a`; EL; HD]);; let LENGTH_L_SEQ = prove(`LENGTH (l_seq n m) = (m + 1) - n`, REWRITE_TAC[l_seq; LENGTH_TABLE]);; let EL_L_SEQ = prove(`!i m n. i < (m + 1) - n ==> EL i (l_seq n m) = n + i`, REWRITE_TAC[l_seq] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EL_TABLE THEN ASM_REWRITE_TAC[]);; let L_SEQ_NIL = prove(`!n m. l_seq n m = [] <=> (m < n)`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[GSYM LENGTH_EQ_NIL; LENGTH_L_SEQ] THEN ARITH_TAC);; let L_SEQ_NN = prove(`!n. l_seq n n = [n]`, GEN_TAC THEN REWRITE_TAC[l_seq; ARITH_RULE `(n + 1) - n = 1`; ONE; TABLE; REVERSE_TABLE; REVERSE] THEN REWRITE_TAC[APPEND; ADD_0]);; let L_SEQ_CONS = prove(`!n m. n <= m ==> l_seq n m = CONS n (l_seq (n + 1) m)`, REPEAT STRIP_TAC THEN REWRITE_TAC[LIST_EL_EQ; LENGTH_L_SEQ; LENGTH] THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC ] THEN INDUCT_TAC THENL [ ASM_SIMP_TAC[EL_L_SEQ] THEN ASM_REWRITE_TAC[EL; HD] THEN ARITH_TAC; DISCH_TAC THEN ASM_SIMP_TAC[EL_L_SEQ] THEN ASM_REWRITE_TAC[EL; TL] THEN MP_TAC (SPECL [`j:num`; `m:num`; `n + 1`] EL_L_SEQ) THEN ANTS_TAC THENL [ ASM_ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN ARITH_TAC ]);; let LENGTH_BUTLAST = prove(`!l. LENGTH (BUTLAST l) = LENGTH l - 1`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[BUTLAST; LENGTH; ARITH] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM LENGTH_EQ_NIL] THEN ARITH_TAC);; let EL_BUTLAST = prove(`!(l:(A)list) i. i < LENGTH l - 1 ==> EL i (BUTLAST l) = EL i l`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[BUTLAST; LENGTH] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [ UNDISCH_TAC `i < SUC (LENGTH (a1:(A)list)) - 1` THEN ASM_REWRITE_TAC[LENGTH] THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[EL_CONS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `i - 1`) THEN ANTS_TAC THENL [ ASM_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[]);; end;; hol-light/Formal_ineqs/make.ml000066400000000000000000000076111303454263000166400ustar00rootroot00000000000000(* ========================================================================= *) (* A tool for formal verification of nonlinear inequalities in HOL Light. *) (* *) (* (c) Alexey Solovyev 2012. *) (* *) (* Distributed under the same license as HOL Light. *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* For backwards compatibility, old versions of some sqrt theorems. *) (* In revision 182 (18th February 2014) these were strengthened to have *) (* fewer (or in some cases no) conditions. These _COMPAT versions ensure *) (* that the code will work correctly either with earlier or later HOL Light. *) (* ------------------------------------------------------------------------- *) let SQRT_MUL_COMPAT = prove (`!x y. &0 <= x /\ &0 <= y ==> sqrt(x * y) = sqrt x * sqrt y`, MESON_TAC[SQRT_MUL]);; let SQRT_EQ_0_COMPAT = prove (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`, MESON_TAC[SQRT_EQ_0]);; let SQRT_MONO_LT_COMPAT = prove (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`, MESON_TAC[SQRT_MONO_LT]);; let SQRT_MONO_LE_COMPAT = prove (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`, MESON_TAC[SQRT_MONO_LE]);; let SQRT_MONO_LT_EQ_COMPAT = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`, MESON_TAC[SQRT_MONO_LT_EQ]);; let SQRT_MONO_LE_EQ_COMPAT = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`, MESON_TAC[SQRT_MONO_LE_EQ]);; let SQRT_INJ_COMPAT = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) = sqrt(y) <=> x = y)`, MESON_TAC[SQRT_INJ]);; let REAL_LE_LSQRT_COMPAT = prove (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`, MESON_TAC[REAL_LE_LSQRT]);; (* ------------------------------------------------------------------------- *) (* More backward-compatibility with a change of 29th Jan 2016. *) (* ------------------------------------------------------------------------- *) let IMAGE_DELETE_INJ_COMPAT = prove (`!f s a. (!x. f(x) = f(a) ==> x = a) ==> (IMAGE f (s DELETE a) = (IMAGE f s) DELETE (f a))`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Main load. *) (* ------------------------------------------------------------------------- *) load_path := (Filename.concat (!hol_dir) "Formal_ineqs") :: (!load_path);; loadt "Formal_ineqs/verifier/m_verifier_main.hl";; open M_verifier_main;; (* ------------------------------------------------------------------------- *) (* See docs/FormalVerifier.pdf for more information. A simple example: *) (* *) (* let ineq = *) (* `-- &1 / sqrt(&3) <= x /\ x <= sqrt(&2) /\ -- sqrt(pi) <= y /\ y <= &1 *) (* ==> x pow 2 * y - x * y pow 4 + y pow 6 - &7 + x pow 4 > -- #7.17995`;; *) (* let th, stats = verify_ineq default_params 5 ineq;; *) (* *) (* These files contain more substantial examples: *) (* *) (* loadt "Formal_ineqs/examples.hl";; *) (* loadt "Formal_ineqs/examples_poly.hl";; *) (* loadt "Formal_ineqs/examples_flyspeck.hl";; *) (* ------------------------------------------------------------------------- *) hol-light/Formal_ineqs/misc/000077500000000000000000000000001303454263000163175ustar00rootroot00000000000000hol-light/Formal_ineqs/misc/misc.hl000066400000000000000000000032371303454263000176040ustar00rootroot00000000000000(* =========================================================== *) (* Miscellaneous functions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) module Arith_misc = struct (* A little faster version of PROVE_HYP *) let MY_PROVE_HYP hyp th = EQ_MP (DEDUCT_ANTISYM_RULE hyp th) hyp;; (* A faster version of BETA_RULE *) let MY_BETA_RULE th = let rec beta tm = let op, arg = dest_comb tm in if is_comb op then let op_th = AP_THM (beta op) arg in let beta_th = BETA_CONV (rand (concl op_th)) in TRANS op_th beta_th else BETA_CONV tm in EQ_MP (beta (concl th)) th;; (* Applies f to arg n times and returns the total execution time *) let test n f arg = let start = Sys.time() in for i = 1 to n do let _ = f arg in () done; Sys.time() -. start;; (* Generates a power function for the given binary operation *) let gen_pow op id n x = let ( * ) = op in let rec pow n = if n <= 0 then id else if n = 1 then x else if n land 1 = 1 then x * pow (n - 1) else let t = pow (n lsr 1) in t * t in pow n;; let rec shape_list n list = if length list <= n then [list] else let l1, l2 = chop_list n list in l1 :: shape_list n l2;; (* map2 which works for lists of any size (no requirement |l1| = |l2|) *) let rec my_map2 f l1 l2 = match l1 with | [] -> [] | (h1::t1) -> (match l2 with | [] -> [] | (h2::t2) -> (f h1 h2) :: my_map2 f t1 t2);; end;; hol-light/Formal_ineqs/misc/vars.hl000066400000000000000000000113141303454263000176170ustar00rootroot00000000000000(* =========================================================== *) (* Commonly used variables and constants *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) module Misc_vars = struct (* bool variables *) let s_var_bool = `s:bool` and s1_var_bool = `s1:bool` and s2_var_bool = `s2:bool`;; (* num variables *) let n_var_num = `n:num` and m_var_num = `m:num` and k_var_num = `k:num` and e_var_num = `e:num` and e1_var_num = `e1:num` and e2_var_num = `e2:num` and r_var_num = `r:num` and r1_var_num = `r1:num` and r2_var_num = `r2:num` and n1_var_num = `n1:num` and n2_var_num = `n2:num` and m1_var_num = `m1:num` and m2_var_num = `m2:num` and x_var_num = `x:num` and y_var_num = `y:num` and i_var_num = `i:num` and j_var_num = `j:num`;; (* real variables *) let x_var_real = `x : real` and y_var_real = `y : real` and z_var_real = `z : real` and w_var_real = `w : real` and a_var_real = `a : real` and b_var_real = `b : real` and m_var_real = `m : real` and n_var_real = `n : real` and x1_var_real = `x1 : real` and x2_var_real = `x2 : real` and y1_var_real = `y1 : real` and y2_var_real = `y2 : real` and f1_var_real = `f1 : real` and f2_var_real = `f2 : real` and f_var_fun = `f : real->real` and g_var_fun = `g : real->real` and f1_var_fun = `f1 : real->real` and f2_var_fun = `f2 : real->real` and int_var = `int : real#real` and f_bounds_var = `f_bounds : real#real` and df_bounds_var = `df_bounds : real#real` and dd_bounds_var = `dd_bounds : real#real` and x_lo_var = `x_lo : real` and x_hi_var = `x_hi : real` and lo_var_real = `lo : real` and hi_var_real = `hi : real` and dd_var_real = `dd : real` and df_lo_var = `df_lo : real` and df_hi_var = `df_hi : real` and df_var_real = `df : real` and f_lo_var = `f_lo : real` and f_hi_var = `f_hi : real` and w1_var_real = `w1 : real` and w2_var_real = `w2 : real` and t_var_real = `t : real` and g_bounds_var = `g_bounds : real#real` and dg_bounds_var = `dg_bounds : real#real` and bounds_var = `bounds : real#real` and d_bounds_var = `d_bounds : real#real` and x0_var_real = `x0 : real` and z0_var_real = `z0 : real` and w0_var_real = `w0 : real` and error_var = `error : real` and d_bounds_list_var = `d_bounds_list : (real#real)list` and dd_bounds_list_var = `dd_bounds_list : ((real#real)list)list` and df_bounds_list_var = `df_bounds_list : (real#real)list` and dd_list_var = `dd_list : (real#real)list` and x_var_real_list = `x:(real)list` and y_var_real_list = `y:(real)list` and z_var_real_list = `z:(real)list` and w_var_real_list = `w:(real)list` and yw_var = `yw : (real#real)list` and xz_var = `xz : (real#real)list` and xz_pair_var = `xz : real#real` and yw_pair_var = `yw : real#real` and list_var_real_pair = `list : (real#real)list`;; (* bool constants *) let t_const = `T` and f_const = `F`;; (* num constants *) let zero_const = `_0`;; (* num operations *) let add_op_num = `(+) : num->num->num` and sub_op_num = `(-) : num->num->num` and mul_op_num = `( * ) : num->num->num` and le_op_num = `(<=) : num->num->bool` and lt_op_num = `(<) : num->num->bool` and div_op_num = `(DIV): num->num->num` and pre_op_num = `PRE: num->num` and suc_op_num = `SUC : num->num`;; (* real constants *) let real_empty_list = `[]:(real)list`;; (* real operations *) let add_op_real = `(+) : real->real->real` and mul_op_real = `( * ) : real->real->real` and sub_op_real = `(-) : real->real->real` and div_op_real = `(/) :real->real->real` and inv_op_real = `inv : real->real` and neg_op_real = `(--) : real->real` and eq_op_real = `(=) : real->real->bool` and lt_op_real = `(<) : real->real->bool` and le_op_real = `(<=):real->real->bool` and amp_op_real = `(&) : num->real` and pow_op_real = `(pow) : real->num->real`;; (* types *) let real_ty = `:real` and real_list_ty = `:(real)list` and real_pair_ty = `:real#real` and real_pair_list_ty = `:(real#real)list` and nty = `:N`;; (* Simple operations *) let mk_real_list tms = mk_list (tms, real_ty);; let mk_names n prefix = map (fun i -> prefix^(string_of_int i)) (1--n);; let mk_real_vars n prefix = map (C (curry mk_var) real_ty) (mk_names n prefix);; end;; hol-light/Formal_ineqs/taylor/000077500000000000000000000000001303454263000166765ustar00rootroot00000000000000hol-light/Formal_ineqs/taylor/m_taylor.hl000066400000000000000000001760201303454263000210570ustar00rootroot00000000000000(* =========================================================== *) (* Formal taylor intervals *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "arith/more_float.hl";; needs "arith/float_atn.hl";; needs "arith/eval_interval.hl";; needs "list/list_conversions.hl";; needs "list/list_float.hl";; needs "list/more_list.hl";; needs "misc/vars.hl";; needs "lib/ssreflect/ssreflect.hl";; needs "lib/ssreflect/sections.hl";; needs "taylor/theory/taylor_interval-compiled.hl";; needs "taylor/theory/multivariate_taylor-compiled.hl";; module M_taylor = struct open Arith_misc;; open Arith_float;; open More_float;; open Float_theory;; open Eval_interval;; open List_conversions;; open List_float;; open More_list;; open Interval_arith;; open Misc_vars;; let MY_RULE = UNDISCH_ALL o PURE_REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL;; let MY_RULE_NUM = UNDISCH_ALL o Arith_nat.NUMERALS_TO_NUM o PURE_REWRITE_RULE[GSYM IMP_IMP] o SPEC_ALL;; let MY_RULE_FLOAT = UNDISCH_ALL o Arith_nat.NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def; GSYM IMP_IMP] o SPEC_ALL;; let max_dim = 8;; let inst_first_type_var ty th = let ty_vars = type_vars_in_term (concl th) in if ty_vars = [] then failwith "inst_first_type: no type variables in the theorem" else INST_TYPE [ty, hd ty_vars] th;; let float0 = mk_float 0 0 and interval0 = mk_float_interval_small_num 0;; let has_size_array = Array.init (max_dim + 1) (fun i -> match i with | 0 -> TRUTH | 1 -> HAS_SIZE_1 | _ -> define_finite_type i);; let dimindex_array = Array.init (max_dim + 1) (fun i -> if i < 1 then TRUTH else MATCH_MP DIMINDEX_UNIQUE has_size_array.(i));; let n_type_array = Array.init (max_dim + 1) (fun i -> if i < 1 then bool_ty else let dimindex_th = dimindex_array.(i) in (hd o snd o dest_type o snd o dest_const o rand o lhand o concl) dimindex_th);; let n_vector_type_array = Array.init (max_dim + 1) (fun i -> if i < 1 then bool_ty else mk_type ("cart", [real_ty; n_type_array.(i)]));; let x_var_names = Array.init (max_dim + 1) (fun i -> "x"^(string_of_int i)) and y_var_names = Array.init (max_dim + 1) (fun i -> "y"^(string_of_int i)) and z_var_names = Array.init (max_dim + 1) (fun i -> "z"^(string_of_int i)) and w_var_names = Array.init (max_dim + 1) (fun i -> "w"^(string_of_int i));; let x_vars_array = Array.init (max_dim + 1) (fun i -> mk_var(x_var_names.(i), real_ty)) and y_vars_array = Array.init (max_dim + 1) (fun i -> mk_var(y_var_names.(i), real_ty)) and z_vars_array = Array.init (max_dim + 1) (fun i -> mk_var(z_var_names.(i), real_ty)) and w_vars_array = Array.init (max_dim + 1) (fun i -> mk_var(w_var_names.(i), real_ty));; let df_vars_array = Array.init (max_dim + 1) (fun i -> mk_var ("df"^(string_of_int i), real_pair_ty));; let dd_vars_array = Array.init (max_dim + 1) (fun i -> Array.init (max_dim + 1) (fun j -> mk_var ("dd"^(string_of_int i)^(string_of_int j), real_pair_ty)));; let dest_vector = dest_list o rand;; let mk_vector list_tm = let n = (length o dest_list) list_tm in let ty = (hd o snd o dest_type o type_of) list_tm in let vec = mk_const ("vector", [ty, aty; n_type_array.(n), nty]) in mk_comb (vec, list_tm);; let mk_vector_list list = mk_vector (mk_list (list, type_of (hd list)));; let el_thms_array = let el_tm = `EL : num->(A)list->A` in let gen0 n = let e_list = mk_list (map (fun i -> mk_var ("e"^(string_of_int i), aty)) (1--n), aty) in let el0_th = REWRITE_CONV[EL; HD] (mk_binop el_tm `0` e_list) in Array.create n el0_th in let array = Array.init (max_dim + 1) gen0 in let gen_i n i = let e_list = (rand o lhand o concl) array.(n).(i) in let prev_thm = array.(n - 1).(i - 1) in let i_tm = mk_small_numeral i in let prev_i = num_CONV i_tm in let el_th = REWRITE_CONV[prev_i; EL; HD; TL; prev_thm] (mk_binop el_tm i_tm e_list) in array.(n).(i) <- el_th in let _ = map (fun n -> map (fun i -> gen_i n i) (1--(n - 1))) (2--max_dim) in array;; let VECTOR_COMPONENT = prove(`!l i. i IN 1..dimindex (:N) ==> (vector l:A^N)$i = EL (i - 1) l`, REWRITE_TAC[IN_NUMSEG] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[vector] THEN MATCH_MP_TAC LAMBDA_BETA THEN ASM_REWRITE_TAC[]);; let gen_comp_thm n i = let i_tm = mk_small_numeral i and x_list = mk_list (map (fun i -> mk_var("x"^(string_of_int i), aty)) (1--n), aty) in let th0 = (ISPECL [x_list; i_tm] o inst_first_type_var (n_type_array.(n))) VECTOR_COMPONENT in let th1 = (CONV_RULE NUM_REDUCE_CONV o REWRITE_RULE[IN_NUMSEG; dimindex_array.(n)]) th0 in REWRITE_RULE[el_thms_array.(n).(i - 1)] th1;; let comp_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun i -> if i < 1 or n < 1 then TRUTH else gen_comp_thm n i));; (************************************) (* m_cell_domain *) let ALL2_ALL_ZIP = prove(`!(P:A->B->bool) l1 l2. LENGTH l1 = LENGTH l2 ==> (ALL2 P l1 l2 <=> ALL (\p. P (FST p) (SND p)) (ZIP l1 l2))`, GEN_TAC THEN LIST_INDUCT_TAC THENL [ GEN_TAC THEN REWRITE_TAC[LENGTH; EQ_SYM_EQ; LENGTH_EQ_NIL] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[ZIP; ALL2; ALL]; ALL_TAC ] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH] THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[eqSS] THEN DISCH_TAC THEN REWRITE_TAC[ALL2; ZIP; ALL] THEN FIRST_X_ASSUM (new_rewrite [] []) THEN ASM_REWRITE_TAC[]);; let EL_ZIP = prove(`!(l1:(A)list) (l2:(B)list) i. LENGTH l1 = LENGTH l2 /\ i < LENGTH l1 ==> EL i (ZIP l1 l2) = (EL i l1, EL i l2)`, LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ZIP; LENGTH] THEN TRY ARITH_TAC THEN case THEN REWRITE_TAC[EL; HD; TL] THEN GEN_TAC THEN REWRITE_TAC[eqSS; ARITH_RULE `SUC n < SUC x <=> n < x`] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let LENGTH_ZIP = prove(`!l1 l2. LENGTH l1 = LENGTH l2 ==> LENGTH (ZIP l1 l2) = LENGTH l1`, LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ZIP; LENGTH] THEN TRY ARITH_TAC THEN REWRITE_TAC[eqSS] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let test_domain_xi = new_definition `test_domain_xi xz yw <=> FST xz <= FST yw /\ FST yw <= SND xz /\ FST yw - FST xz <= SND yw /\ SND xz - FST yw <= SND yw`;; let MK_CELL_DOMAIN = prove(`!xz (yw:(real#real)list) x z y w. LENGTH x = dimindex (:N) /\ LENGTH z = dimindex (:N) /\ LENGTH y = dimindex (:N) /\ LENGTH w = dimindex (:N) /\ ZIP y w = yw /\ ZIP x z = xz /\ ALL2 test_domain_xi xz yw ==> m_cell_domain (vector x, vector z:real^N) (vector y) (vector w)`, REPEAT GEN_TAC THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN SUBGOAL_THEN `LENGTH (xz:(real#real)list) = dimindex (:N) /\ LENGTH (yw:(real#real)list) = dimindex (:N)` ASSUME_TAC THENL [ EXPAND_TAC "yw" THEN EXPAND_TAC "xz" THEN REPEAT (new_rewrite [] [] LENGTH_ZIP) THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN rewrite [] [] ALL2_ALL_ZIP THEN ASM_REWRITE_TAC[m_cell_domain; GSYM ALL_EL] THEN DISCH_TAC THEN REWRITE_TAC[m_cell_domain] THEN GEN_TAC THEN DISCH_TAC THEN REPEAT (new_rewrite [] [] VECTOR_COMPONENT) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `j = i - 1` THEN SUBGOAL_THEN `j < dimindex (:N)` ASSUME_TAC THENL [ POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN FIRST_X_ASSUM (MP_TAC o SPEC `j:num`) THEN REWRITE_TAC[test_domain_xi] THEN rewrite [] [] LENGTH_ZIP THEN ASM_REWRITE_TAC[] THEN rewrite [] [] EL_ZIP THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "xz" THEN EXPAND_TAC "yw" THEN REPEAT (new_rewrite [] [] EL_ZIP) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; (* array of theorems *) let mk_m_domain_array = let mk_m_domain n = let dimindex_th = dimindex_array.(n) in let n_ty = (hd o snd o dest_type o snd o dest_const o rand o lhand o concl) dimindex_th in let nty = `:N` in (UNDISCH_ALL o REWRITE_RULE[float0_eq] o DISCH_ALL o RULE o REWRITE_RULE[dimindex_th] o INST_TYPE[n_ty, nty]) MK_CELL_DOMAIN in Array.init (max_dim + 1) (fun i -> if i < 1 then TRUTH else mk_m_domain i);; let TEST_DOMAIN_XI' = (EQT_INTRO o RULE o prove)(`xz = (x,z) /\ yw = (y,w) /\ x <= y /\ y <= z /\ y - x <= w1 /\ z - y <= w2 /\ w1 <= w /\ w2 <= w ==> test_domain_xi xz yw`, SIMP_TAC[test_domain_xi] THEN REAL_ARITH_TAC);; let eval_test_domain_xi pp test_domain_tm = let ltm, yw = dest_comb test_domain_tm in let xz = rand ltm in let x, z = dest_pair xz and y, w = dest_pair yw in let (<=) = (fun t1 t2 -> EQT_ELIM (float_le t1 t2)) and (-) = float_sub_hi pp in let x_le_y = x <= y and y_le_z = y <= z and yx_le_w1 = y - x and zy_le_w2 = z - y in let w1 = (rand o concl) yx_le_w1 and w2 = (rand o concl) zy_le_w2 in let w1_le_w = w1 <= w and w2_le_w = w2 <= w in (MY_PROVE_HYP (REFL xz) o MY_PROVE_HYP (REFL yw) o MY_PROVE_HYP x_le_y o MY_PROVE_HYP y_le_z o MY_PROVE_HYP yx_le_w1 o MY_PROVE_HYP zy_le_w2 o MY_PROVE_HYP w1_le_w o MY_PROVE_HYP w2_le_w o INST[x, x_var_real; y, y_var_real; z, z_var_real; w, w_var_real; w1, w1_var_real; w2, w2_var_real; xz, xz_pair_var; yw, yw_pair_var]) TEST_DOMAIN_XI';; (* mk_m_center_domain *) let mk_m_center_domain n pp x_list_tm z_list_tm = let x_list = dest_list x_list_tm and z_list = dest_list z_list_tm in let y_list = let ( * ) = (fun t1 t2 -> (rand o concl) (float_mul_eq t1 t2)) and (+) = (fun t1 t2 -> (rand o concl) (float_add_hi pp t1 t2)) in map2 (fun x y -> if x = y then x else float_inv2 * (x + y)) x_list z_list in let w_list = let (-) = (fun t1 t2 -> (rand o concl) (float_sub_hi pp t1 t2)) and max = (fun t1 t2 -> (rand o concl) (float_max t1 t2)) in let w1 = map2 (-) y_list x_list and w2 = map2 (-) z_list y_list in map2 max w1 w2 in let y_list_tm = mk_list (y_list, real_ty) and w_list_tm = mk_list (w_list, real_ty) in let yw_zip_th = eval_zip y_list_tm w_list_tm and xz_zip_th = eval_zip x_list_tm z_list_tm in let yw_list_tm = (rand o concl) yw_zip_th and xz_list_tm = (rand o concl) xz_zip_th in let len_x_th = eval_length x_list_tm and len_z_th = eval_length z_list_tm and len_y_th = eval_length y_list_tm and len_w_th = eval_length w_list_tm in let th0 = (MY_PROVE_HYP len_x_th o MY_PROVE_HYP len_z_th o MY_PROVE_HYP len_y_th o MY_PROVE_HYP len_w_th o MY_PROVE_HYP yw_zip_th o MY_PROVE_HYP xz_zip_th o INST[x_list_tm, x_var_real_list; z_list_tm, z_var_real_list; y_list_tm, y_var_real_list; w_list_tm, w_var_real_list; yw_list_tm, yw_var; xz_list_tm, xz_var]) mk_m_domain_array.(n) in let all_th = (EQT_ELIM o all2_conv_univ (eval_test_domain_xi pp) o hd o hyp) th0 in MY_PROVE_HYP all_th th0;; (***********************) let MK_M_TAYLOR_INTERVAL' = (RULE o MATCH_MP iffRL o SPEC_ALL) m_taylor_interval;; let get_types_and_vars n = let ty = n_type_array.(n) and xty = n_vector_type_array.(n) in let x_var = mk_var ("x", xty) and f_var = mk_var ("f", mk_fun_ty xty real_ty) and y_var = mk_var ("y", xty) and w_var = mk_var ("w", xty) and domain_var = mk_var ("domain", mk_type ("prod", [xty; xty])) in ty, xty, x_var, f_var, y_var, w_var, domain_var;; let dest_m_cell_domain domain_tm = let lhs, w_tm = dest_comb domain_tm in let lhs2, y_tm = dest_comb lhs in rand lhs2, y_tm, w_tm;; (**************************************************) (* Given a variable of the type `:real^N`, returns the number N *) let get_dim = int_of_string o fst o dest_type o hd o tl o snd o dest_type o type_of;; (**********************) (* eval_m_taylor_poly *) let partial_pow = prove(`!i f n (y:real^N). lift o f differentiable at y ==> partial i (\x. f x pow n) y = &n * f y pow (n - 1) * partial i f y`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^N. f x pow n) = (\t. t pow n) o f` (fun th -> REWRITE_TAC[th]) THENL [ ONCE_REWRITE_TAC[GSYM eq_ext] THEN REWRITE_TAC[o_THM]; ALL_TAC ] THEN new_rewrite [] [] partial_uni_compose THENL [ ASM_REWRITE_TAC[] THEN new_rewrite [] [] REAL_DIFFERENTIABLE_POW_ATREAL THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ID]; ALL_TAC ] THEN new_rewrite [] [] derivative_pow THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ID; derivative_x] THEN REAL_ARITH_TAC);; let nth_diff2_pow = prove(`!n y. nth_diff_strong 2 (\x. x pow n) y`, REWRITE_TAC[nth_diff_strong2_eq] THEN REPEAT GEN_TAC THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[REAL_OPEN_UNIV; IN_UNIV] THEN GEN_TAC THEN new_rewrite [] [] REAL_DIFFERENTIABLE_POW_ATREAL THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ID] THEN MATCH_MP_TAC differentiable_local THEN EXISTS_TAC `\x. &n * x pow (n - 1)` THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[REAL_OPEN_UNIV; IN_UNIV] THEN new_rewrite [] [] REAL_DIFFERENTIABLE_MUL_ATREAL THEN REWRITE_TAC[REAL_DIFFERENTIABLE_CONST] THENL [ new_rewrite [] [] REAL_DIFFERENTIABLE_POW_ATREAL THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ID]; ALL_TAC ] THEN GEN_TAC THEN new_rewrite [] [] derivative_pow THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ID] THEN REWRITE_TAC[derivative_x; REAL_MUL_RID]);; let diff2c_pow = prove(`!f n (x:real^N). diff2c f x ==> diff2c (\x. f x pow n) x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^N. f x pow n) = (\t. t pow n) o f` (fun th -> REWRITE_TAC[th]) THENL [ ONCE_REWRITE_TAC[GSYM eq_ext] THEN REWRITE_TAC[o_THM]; ALL_TAC ] THEN apply_tac diff2c_uni_compose THEN ASM_REWRITE_TAC[nth_diff2_pow] THEN REWRITE_TAC[nth_derivative2] THEN SUBGOAL_THEN `!n. derivative (\t. t pow n) = (\t. &n * t pow (n - 1))` ASSUME_TAC THENL [ GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN new_rewrite [] [] derivative_pow THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ID] THEN REWRITE_TAC[derivative_x; REAL_MUL_RID]; ALL_TAC ] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!n. derivative (\t. &n * t pow (n - 1)) = (\t. &n * derivative (\t. t pow (n - 1)) t)` ASSUME_TAC THENL [ GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN new_rewrite [] [] derivative_scale THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_POW_ATREAL THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ID]; ALL_TAC ] THEN ASM_REWRITE_TAC[] THEN REPEAT (MATCH_MP_TAC REAL_CONTINUOUS_LMUL) THEN MATCH_MP_TAC REAL_CONTINUOUS_POW THEN REWRITE_TAC[REAL_CONTINUOUS_AT_ID]);; let diff2c_domain_pow = prove(`!f n domain. diff2c_domain domain f ==> diff2c_domain domain (\x. f x pow n)`, REWRITE_TAC[diff2c_domain] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[diff2c_pow]);; let diff2c_domain_tm = `diff2c_domain domain`;; let rec gen_diff2c_domain_poly poly_tm = let x_var, expr = dest_abs poly_tm in let n = (int_of_string o fst o dest_type o hd o tl o snd o dest_type o type_of) x_var in let diff2c_tm = mk_icomb (diff2c_domain_tm, poly_tm) in if frees expr = [] then (* const *) (SPEC_ALL o ISPEC expr o inst_first_type_var (n_type_array.(n))) diff2c_domain_const else let lhs, r_tm = dest_comb expr in if lhs = neg_op_real then (* -- *) let r_th = gen_diff2c_domain_poly (mk_abs (x_var, r_tm)) in prove(diff2c_tm, MATCH_MP_TAC diff2c_domain_neg THEN REWRITE_TAC[r_th]) else let op, l_tm = dest_comb lhs in let name = (fst o dest_const) op in if name = "$" then (* x$k *) let dim_th = dimindex_array.(n) in prove(diff2c_tm, MATCH_MP_TAC diff2c_domain_x THEN REWRITE_TAC[IN_NUMSEG; dim_th] THEN ARITH_TAC) else let l_th = gen_diff2c_domain_poly (mk_abs (x_var, l_tm)) in if name = "real_pow" then (* f pow n *) prove(diff2c_tm, MATCH_MP_TAC diff2c_domain_pow THEN REWRITE_TAC[l_th]) else let r_th = gen_diff2c_domain_poly (mk_abs (x_var, r_tm)) in prove(diff2c_tm, MAP_FIRST apply_tac [diff2c_domain_add; diff2c_domain_sub; diff2c_domain_mul] THEN REWRITE_TAC[l_th; r_th]);; let gen_diff2c_poly = let th_imp = prove(`!f. (!domain. diff2c_domain domain f) ==> !x:real^N. diff2c f x`, REWRITE_TAC[diff2c_domain] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(x:real^N, x:real^N)` THEN REWRITE_TAC[INTERVAL_SING; IN_SING]) in fun poly_tm -> (MATCH_MP th_imp o GEN_ALL o gen_diff2c_domain_poly) poly_tm;; let gen_diff_poly = let th_imp = prove(`!f. (!domain. diff2c_domain domain f) ==> !x:real^N. lift o f differentiable at x`, REWRITE_TAC[diff2c_domain; diff2c; diff2] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`x:real^N, x:real^N`; `x:real^N`]) THEN REWRITE_TAC[INTERVAL_SING; IN_SING] THEN case THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[]) in fun poly_tm -> (MATCH_MP th_imp o GEN_ALL o gen_diff2c_domain_poly) poly_tm;; let in_tm = `IN`;; let add_to_hash tbl max_size key value = let _ = if Hashtbl.length tbl >= max_size then Hashtbl.clear tbl else () in Hashtbl.add tbl key value;; (* Formally computes partial derivatives of a polynomial *) let gen_partial_poly = let max_hash = 1000 in let hash = Hashtbl.create max_hash in fun i poly_tm -> let key = (i, poly_tm) in try Hashtbl.find hash (i, poly_tm) with Not_found -> let i_tm = mk_small_numeral i in let rec gen_rec poly_tm = let x_var, expr = dest_abs poly_tm in let n = (int_of_string o fst o dest_type o hd o tl o snd o dest_type o type_of) x_var in if frees expr = [] then (* const *) (SPECL [i_tm; expr] o inst_first_type_var (n_type_array.(n))) partial_const else let lhs, r_tm = dest_comb expr in if lhs = neg_op_real then (* -- *) let r_poly = mk_abs (x_var, r_tm) in let r_diff = (SPEC_ALL o gen_diff_poly) r_poly and r_partial = gen_rec r_poly in let th0 = SPEC i_tm (MATCH_MP partial_neg r_diff) in REWRITE_RULE[r_partial] th0 else let op, l_tm = dest_comb lhs in let name = (fst o dest_const) op in if name = "$" then (* comp *) let dim_th = dimindex_array.(n) in let dim_tm = (lhand o concl) dim_th in let i_eq_k = NUM_EQ_CONV (mk_eq (i_tm, r_tm)) in let int_tm = mk_binop `..` `1` dim_tm in let k_in_dim = prove(mk_comb (mk_icomb(in_tm, r_tm), int_tm), REWRITE_TAC[IN_NUMSEG; dim_th] THEN ARITH_TAC) in (REWRITE_RULE[i_eq_k] o MATCH_MP (SPECL [r_tm; i_tm] partial_x)) k_in_dim else let l_poly = mk_abs (x_var, l_tm) in let l_partial = gen_rec l_poly in let l_diff = (SPEC_ALL o gen_diff_poly) l_poly in if name = "real_pow" then (* f pow n *) let th0 = SPECL [i_tm; r_tm] (MATCH_MP partial_pow l_diff) in REWRITE_RULE[l_partial] th0 else let r_poly = mk_abs (x_var, r_tm) in let r_partial = gen_rec r_poly in let r_diff = (SPEC_ALL o gen_diff_poly) r_poly in let imp_th = assoc op [add_op_real, partial_add; sub_op_real, partial_sub; mul_op_real, partial_mul] in let th0 = SPEC i_tm (MATCH_MP (MATCH_MP imp_th l_diff) r_diff) in REWRITE_RULE[l_partial; r_partial] th0 in let th1 = gen_rec poly_tm in let th2 = ((NUM_REDUCE_CONV THENC REWRITE_CONV[DECIMAL] THENC REAL_POLY_CONV) o rand o concl) th1 in let th3 = (REWRITE_RULE[ETA_AX] o ONCE_REWRITE_RULE[eq_ext] o GEN_ALL) (TRANS th1 th2) in let _ = add_to_hash hash max_hash key th3 in th3;; let gen_partial2_poly i j poly_tm = let partial_j = gen_partial_poly j poly_tm in let partial_ij = gen_partial_poly i (rand (concl partial_j)) in let pi = (rator o lhand o concl) partial_ij in REWRITE_RULE[GSYM partial2] (TRANS (AP_TERM pi partial_j) partial_ij);; (********************************************) let eval_diff2_poly diff2_domain_th = fun xx zz -> let domain_tm = mk_pair (xx, zz) in INST[domain_tm, mk_var ("domain", type_of domain_tm)] diff2_domain_th;; (*****************************) (* m_lin_approx *) let CONST_INTERVAL' = RULE CONST_INTERVAL;; let dest_lin_approx approx_tm = let lhs, df_bounds = dest_comb approx_tm in let lhs2, f_bounds = dest_comb lhs in let lhs3, x_tm = dest_comb lhs2 in let f_tm = rand lhs3 in f_tm, x_tm, f_bounds, df_bounds;; let gen_lin_approx_eq_thm n = let ty = n_type_array.(n) in let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let df_bounds_list = mk_list (df_vars, real_pair_ty) in let th0 = (SPECL[f_bounds_var; df_bounds_list] o inst_first_type_var ty) m_lin_approx in let th1 = (CONV_RULE NUM_REDUCE_CONV o REWRITE_RULE[all_n]) th0 in th1;; let gen_lin_approx_poly_thm poly_tm diff_th partials = let x_var, _ = dest_abs poly_tm in let n = get_dim x_var in let lin_eq = (REWRITE_RULE partials o SPECL [poly_tm]) (gen_lin_approx_eq_thm n) in let x_vec = mk_vector_list (map (fun i -> x_vars_array.(i)) (1--n)) in let th1 = (REWRITE_RULE (Array.to_list comp_thms_array.(n)) o SPEC x_vec o REWRITE_RULE[diff_th]) lin_eq in th1;; let gen_lin_approx_poly_thm0 poly_tm = let x_var, _ = dest_abs poly_tm in let n = get_dim x_var in let partials = map (fun i -> gen_partial_poly i poly_tm) (1--n) in let diff_th = gen_diff_poly poly_tm in gen_lin_approx_poly_thm poly_tm diff_th partials;; let eval_lin_approx pp0 lin_approx_th = let poly_tm, _, _, _ = (dest_lin_approx o lhand o concl) lin_approx_th in let x_var, _ = dest_abs poly_tm in let n = get_dim x_var in let th0 = lin_approx_th in let th1 = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o MATCH_MP iffRL) th0 in let build_eval int_hyp = let expr, b_var = dest_binary "interval_arith" int_hyp in (eval_constants pp0 o build_interval_fun) expr, b_var in let int_fs = map build_eval (hyp th1) in let rec split_rules i_list = match i_list with | [] -> ([], []) | ((i_fun, var_tm) :: es) -> let th_list, i_list' = split_rules es in match i_fun with | Int_const th -> (var_tm, th) :: th_list, i_list' | Int_var v -> (var_tm, INST[v, x_var_real] CONST_INTERVAL') :: th_list, i_list' | _ -> th_list, (var_tm, i_fun) :: i_list' in let const_th_list, i_list0 = split_rules int_fs in let th2 = itlist (fun (var_tm, th) th0 -> let b_tm = rand (concl th) in (MY_PROVE_HYP th o INST[b_tm, var_tm]) th0) const_th_list th1 in let v_list, i_list' = unzip i_list0 in let i_list = find_and_replace_all i_list' [] in fun pp vector_tm -> let x_vals = dest_vector vector_tm in if length x_vals <> n then failwith (sprintf "Wrong vector size; expected size: %d" n) else let x_ints = map mk_const_interval x_vals in let vars = map (fun i -> x_vars_array.(i)) (1--n) in let th3 = INST (zip x_vals vars) th2 in let i_vals = eval_interval_fun_list pp i_list (zip vars x_ints) in itlist2 (fun var_tm th th0 -> let b_tm = rand (concl th) in (MY_PROVE_HYP th o INST[b_tm, var_tm]) th0) v_list i_vals th3;; let eval_lin_approx_poly0 pp0 poly_tm = eval_lin_approx pp0 (gen_lin_approx_poly_thm0 poly_tm);; (*************************************) (* 1 <= i /\ i <= n <=> i = 1 \/ i = 2 \/ ... \/ i = n *) let i_int_array = let i_tm = `i:num` in let i_th0 = prove(`1 <= i /\ i <= SUC n <=> (1 <= i /\ i <= n) \/ i = SUC n`, ARITH_TAC) in let th1 = prove(`1 <= i /\ i <= 1 <=> i = 1`, ARITH_TAC) in let array = Array.create (max_dim + 1) th1 in let prove_next n = let n_tm = mk_small_numeral n in let prev_n = num_CONV n_tm in let tm = mk_conj (`1 <= i`, mk_binop le_op_num i_tm n_tm) in let th = REWRITE_CONV[prev_n; i_th0; array.(n - 1)] tm in array.(n) <- REWRITE_RULE[SYM prev_n; GSYM DISJ_ASSOC] th in let _ = map prove_next (2--max_dim) in array;; (* (!i. 1 <= i /\ i <= n ==> P i) <=> P 1 /\ P 2 /\ ... /\ P n *) let gen_in_interval = let th0 = prove(`(!i:num. (i = k \/ Q i) ==> P i) <=> (P k /\ (!i. Q i ==> P i))`, MESON_TAC[]) in let th1 = prove(`(!i:num. (i = k ==> P i)) <=> P k`, MESON_TAC[]) in fun n -> let n_tm = mk_small_numeral n and i_tm = `i:num` in let lhs1 = mk_conj (`1 <= i`, mk_binop le_op_num i_tm n_tm) in let lhs = mk_forall (i_tm, mk_imp (lhs1, `(P:num->bool) i`)) in REWRITE_CONV[i_int_array.(n); th0; th1] lhs;; let gen_second_bounded_eq_thm n = let ty, _, x_var, _, _, _, domain_var = get_types_and_vars n in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(j).(i)) (1--i)) (1--n) in let dd_bounds_list = mk_list (map (fun l -> mk_list (l, real_pair_ty)) dd_vars, real_pair_list_ty) in let th0 = (SPECL[domain_var; dd_bounds_list] o inst_first_type_var ty) second_bounded in let th1 = (CONV_RULE NUM_REDUCE_CONV o REWRITE_RULE[all_n]) th0 in th1;; let gen_second_bounded_poly_thm poly_tm partials2 = let x_var, _ = dest_abs poly_tm in let n = get_dim x_var in let partials2' = List.flatten partials2 in let second_th = (REWRITE_RULE partials2' o SPECL [poly_tm]) (gen_second_bounded_eq_thm n) in second_th;; let gen_second_bounded_poly_thm0 poly_tm = let x_var, _ = dest_abs poly_tm in let n = get_dim x_var in let partials = map (fun i -> gen_partial_poly i poly_tm) (1--n) in let get_partial i eq_th = let partial_i = gen_partial_poly i (rand (concl eq_th)) in let pi = (rator o lhand o concl) partial_i in REWRITE_RULE[GSYM partial2] (TRANS (AP_TERM pi eq_th) partial_i) in let partials2 = map (fun th, i -> map (fun j -> get_partial j th) (1--i)) (zip partials (1--n)) in gen_second_bounded_poly_thm poly_tm partials2;; (* let eq_th = TAUT `(P ==> Q /\ R) <=> ((P ==> Q) /\ (P ==> R))` in REWRITE_RULE[eq_th; FORALL_AND_THM; GSYM m_bounded_on_int] second_th;;*) (* eval_second_bounded *) let eval_second_bounded pp0 second_bounded_th = let poly_tm = (lhand o rator o lhand o concl) second_bounded_th in let th0 = second_bounded_th in let n = (get_dim o fst o dest_abs) poly_tm in let x_vector = mk_vector_list (map (fun i -> x_vars_array.(i)) (1--n)) and z_vector = mk_vector_list (map (fun i -> z_vars_array.(i)) (1--n)) in let _, _, _, _, _, _, domain_var = get_types_and_vars n in let th1 = INST[mk_pair (x_vector, z_vector), domain_var] th0 in let th2 = REWRITE_RULE[IN_INTERVAL; dimindex_array.(n)] th1 in let th3 = REWRITE_RULE[gen_in_interval n; GSYM interval_arith] th2 in let th4 = (REWRITE_RULE[CONJ_ACI] o REWRITE_RULE (Array.to_list comp_thms_array.(n))) th3 in let final_th0 = (UNDISCH_ALL o MATCH_MP iffRL) th4 in let x_var, h_tm = (dest_forall o hd o hyp) final_th0 in let _, h2 = dest_imp h_tm in let concl_ints = striplist dest_conj h2 in let i_funs = map (fun int -> let expr, var = dest_interval_arith int in (eval_constants pp0 o build_interval_fun) expr, var) concl_ints in let rec split_rules i_list = match i_list with | [] -> ([], []) | ((i_fun, var_tm) :: es) -> let th_list, i_list' = split_rules es in match i_fun with | Int_const th -> (var_tm, th) :: th_list, i_list' (* | Int_var v -> (var_tm, INST[v, x_var_real] CONST_INTERVAL') :: th_list, i_list' *) | _ -> th_list, (var_tm, i_fun) :: i_list' in let const_th_list, i_list0 = split_rules i_funs in let th5 = itlist (fun (var_tm, th) th0 -> let b_tm = rand (concl th) in (REWRITE_RULE[th] o INST[b_tm, var_tm]) th0) const_th_list (SYM th4) in let final_th = REWRITE_RULE[GSYM IMP_IMP] th5 in let v_list, i_list' = unzip i_list0 in let i_list = find_and_replace_all i_list' [] in fun pp x_vector_tm z_vector_tm -> let x_vals = dest_vector x_vector_tm and z_vals = dest_vector z_vector_tm in if length x_vals <> n or length z_vals <> n then failwith (sprintf "Wrong vector size; expected size: %d" n) else let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) in let inst_th = (INST (zip x_vals x_vars) o INST (zip z_vals z_vars)) final_th in if (not o is_eq) (concl inst_th) then inst_th else let x_var, lhs = (dest_forall o lhand o concl) inst_th in let hs = (butlast o striplist dest_imp) lhs in let vars = map (rand o rator) hs in let int_vars = zip vars (map ASSUME hs) in let dd_ints = eval_interval_fun_list pp i_list int_vars in let inst_dd = map2 (fun var th -> (rand o concl) th, var) v_list dd_ints in let inst_th2 = INST inst_dd inst_th in let conj_th = end_itlist CONJ dd_ints in let lhs_th = GEN x_var (itlist DISCH hs conj_th) in EQ_MP inst_th2 lhs_th;; let eval_second_bounded_poly0 pp0 poly_tm = eval_second_bounded pp0 (gen_second_bounded_poly_thm0 poly_tm);; (*************************************) (* eval_m_taylor *) let eval_m_taylor pp0 diff2c_th lin_th second_th = let poly_tm = (rand o concl) diff2c_th in let n = (get_dim o fst o dest_abs) poly_tm in let eval_lin = eval_lin_approx pp0 lin_th and eval_second = eval_second_bounded pp0 second_th in let ty, _, x_var, f_var, y_var, w_var, domain_var = get_types_and_vars n in let th0 = (SPEC_ALL o inst_first_type_var ty) m_taylor_interval in let th1 = INST[poly_tm, f_var] th0 in let th2 = (UNDISCH_ALL o REWRITE_RULE[GSYM IMP_IMP] o MATCH_MP iffRL o REWRITE_RULE[diff2c_th]) th1 in fun p_lin p_second domain_th -> let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let x_tm, z_tm = dest_pair domain_tm in let lin_th = eval_lin p_lin y_tm and second_th = eval_second p_second x_tm z_tm in let _, _, f_bounds, df_bounds_list = dest_lin_approx (concl lin_th) in let dd_bounds_list = (rand o concl) second_th in let df_var = mk_var ("d_bounds_list", type_of df_bounds_list) and dd_var = mk_var ("dd_bounds_list", type_of dd_bounds_list) in (MY_PROVE_HYP domain_th o MY_PROVE_HYP lin_th o MY_PROVE_HYP second_th o INST[domain_tm, domain_var; y_tm, y_var; w_tm, w_var; f_bounds, f_bounds_var; df_bounds_list, df_var; dd_bounds_list, dd_var]) th2;; let eval_m_taylor_poly0 pp0 poly_tm = let diff2_th = gen_diff2c_domain_poly poly_tm in let x_var, _ = dest_abs poly_tm in let n = get_dim x_var in let partials = map (fun i -> gen_partial_poly i poly_tm) (1--n) in let get_partial i eq_th = let partial_i = gen_partial_poly i (rand (concl eq_th)) in let pi = (rator o lhand o concl) partial_i in REWRITE_RULE[GSYM partial2] (TRANS (AP_TERM pi eq_th) partial_i) in let partials2 = map2 (fun th i -> map (fun j -> get_partial j th) (1--i)) partials (1--n) in let second_th = gen_second_bounded_poly_thm poly_tm partials2 in let diff_th = gen_diff_poly poly_tm in let lin_th = gen_lin_approx_poly_thm poly_tm diff_th partials in eval_m_taylor pp0 diff2_th lin_th second_th;; (******************************************) (* mk_eval_function *) let mk_eval_function_eq pp0 eq_th = let expr_tm = (rand o concl) eq_th in let tm0 = `!x:real^N. x IN interval [domain] ==> interval_arith (f x) f_bounds` in let n = (get_dim o fst o dest_abs) expr_tm in let x_vector = mk_vector_list (map (fun i -> x_vars_array.(i)) (1--n)) and z_vector = mk_vector_list (map (fun i -> z_vars_array.(i)) (1--n)) in let ty, _, _, _, _, _, domain_var = get_types_and_vars n and f_var = mk_var ("f", type_of expr_tm) in let th1 = (REWRITE_CONV[IN_INTERVAL] o subst[mk_pair(x_vector,z_vector), domain_var] o inst[ty, nty]) tm0 in let th2 = REWRITE_RULE [dimindex_array.(n)] th1 in let th3 = REWRITE_RULE [gen_in_interval n; GSYM interval_arith] th2 in let th4 = (REWRITE_RULE[GSYM IMP_IMP; CONJ_ACI] o REWRITE_RULE (Array.to_list comp_thms_array.(n))) th3 in let final_th0 = (CONV_RULE ((RAND_CONV o ONCE_DEPTH_CONV) BETA_CONV) o INST[expr_tm, f_var]) th4 in let x_var, h_tm = (dest_forall o rand o concl) final_th0 in let f_tm = (fst o dest_interval_arith o last o striplist dest_imp) h_tm in let i_fun = (eval_constants pp0 o build_interval_fun) f_tm in let i_list = find_and_replace_all [i_fun] [] in let final_th = (PURE_REWRITE_RULE[SYM eq_th] o SYM) final_th0 in fun pp x_vector_tm z_vector_tm -> let x_vals = dest_vector x_vector_tm and z_vals = dest_vector z_vector_tm in if length x_vals <> n or length z_vals <> n then failwith (sprintf "Wrong vector size; expected size: %d" n) else let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) in let inst_th = (INST (zip x_vals x_vars) o INST (zip z_vals z_vars)) final_th in let x_var, lhs = (dest_forall o lhand o concl) inst_th in let hs = (butlast o striplist dest_imp) lhs in let vars = map (rand o rator) hs in let int_vars = zip vars (map ASSUME hs) in let eval_th = hd (eval_interval_fun_list pp i_list int_vars) in let f_bounds = (rand o concl) eval_th in let inst_th2 = INST[f_bounds, f_bounds_var] inst_th in let lhs_th = GEN x_var (itlist DISCH hs eval_th) in EQ_MP inst_th2 lhs_th;; let mk_eval_function pp0 expr_tm = mk_eval_function_eq pp0 (REFL expr_tm);; (********************************) (* m_taylor_error *) (* Sum of the list elements *) let ITLIST2_EQ_SUM = prove(`!(f:A->B->real) l1 l2. LENGTH l1 <= LENGTH l2 ==> ITLIST2 (\x y z. f x y + z) l1 l2 (&0) = sum (1..(LENGTH l1)) (\i. f (EL (i - 1) l1) (EL (i - 1) l2))`, GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; ITLIST2_DEF] THEN TRY ARITH_TAC THENL [ REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH]; REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH]; ALL_TAC ] THEN REWRITE_TAC[leqSS] THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `t':(B)list`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[TL; th]) THEN REWRITE_TAC[GSYM add1n] THEN new_rewrite [] [] SUM_ADD_SPLIT THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[TWO; add1n; SUM_SING_NUMSEG; subnn; EL; HD] THEN REWRITE_TAC[GSYM addn1; SUM_OFFSET; REAL_EQ_ADD_LCANCEL] THEN MATCH_MP_TAC SUM_EQ THEN move ["i"] THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN ASM_SIMP_TAC[ARITH_RULE `1 <= i ==> (i + 1) - 1 = SUC (i - 1)`; EL; TL]);; let interval_arith_abs_le = prove(`!x int y. interval_arith x int ==> iabs int <= y ==> abs x <= y`, GEN_TAC THEN case THEN REWRITE_TAC[interval_arith; IABS'] THEN REAL_ARITH_TAC);; let ALL_N_ALL2 = prove(`!P (l:(A)list) i0. (all_n i0 l P <=> if l = [] then T else ALL2 P (l_seq i0 ((i0 + LENGTH l) - 1)) l)`, GEN_TAC THEN LIST_INDUCT_TAC THEN GEN_TAC THEN REWRITE_TAC[all_n; NOT_CONS_NIL] THEN new_rewrite [] [] L_SEQ_CONS THEN REWRITE_TAC[LENGTH; ALL2] THEN TRY ARITH_TAC THEN FIRST_X_ASSUM (new_rewrite [] []) THEN TRY ARITH_TAC THEN REWRITE_TAC[addSn; addnS; addn1] THEN SPEC_TAC (`t:(A)list`, `t:(A)list`) THEN case THEN SIMP_TAC[NOT_CONS_NIL] THEN REWRITE_TAC[LENGTH; addn0] THEN MP_TAC (SPECL [`SUC i0`; `SUC i0 - 1`] L_SEQ_NIL) THEN REWRITE_TAC[ARITH_RULE `SUC i0 - 1 < SUC i0`] THEN DISCH_THEN (fun th -> REWRITE_TAC[th; ALL2]));; let ALL_N_EL = prove(`!P (l:(A)list) i0. all_n i0 l P <=> (!i. i < LENGTH l ==> P (i0 + i) (EL i l))`, REPEAT GEN_TAC THEN REWRITE_TAC[ALL_N_ALL2] THEN SPEC_TAC (`l:(A)list`, `l:(A)list`) THEN case THEN SIMP_TAC[NOT_CONS_NIL; LENGTH; ltn0] THEN REPEAT GEN_TAC THEN new_rewrite [] [] ALL2_ALL_ZIP THENL [ REWRITE_TAC[LENGTH_L_SEQ; LENGTH] THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[GSYM ALL_EL] THEN new_rewrite [] [] LENGTH_ZIP THENL [ REWRITE_TAC[LENGTH_L_SEQ; LENGTH] THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[LENGTH_L_SEQ; ARITH_RULE `((i0 + SUC a) - 1 + 1) - i0 = SUC a`] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN new_rewrite [] [] EL_ZIP THENL [ REWRITE_TAC[LENGTH_L_SEQ; LENGTH] THEN ASM_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[] THEN new_rewrite [] [] EL_L_SEQ THEN ASM_ARITH_TAC; ALL_TAC ] THEN new_rewrite [] [] EL_ZIP THENL [ REWRITE_TAC[LENGTH_L_SEQ; LENGTH] THEN ASM_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[] THEN new_rewrite [] [] EL_L_SEQ THEN TRY ASM_ARITH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let M_TAYLOR_ERROR_ITLIST2 = prove(`!f domain y w dd_bounds_list error. m_cell_domain domain y (vector w) ==> diff2c_domain domain f ==> second_bounded (f:real^N->real) domain dd_bounds_list ==> LENGTH w = dimindex (:N) ==> LENGTH dd_bounds_list = dimindex (:N) ==> all_n 1 dd_bounds_list (\i list. LENGTH list = i) ==> ITLIST2 (\list x z. x * (x * iabs (LAST list) + &2 * ITLIST2 (\a b c. b * iabs a + c) (BUTLAST list) w (&0)) + z) dd_bounds_list w (&0) <= error ==> m_taylor_error f domain (vector w) error`, REPEAT GEN_TAC THEN REWRITE_TAC[second_bounded] THEN set_tac "s" `ITLIST2 _1 _2 _3 _4` THEN move ["domain"; "d2f"; "second"; "lw"; "ldd"; "ldd_all"; "s_le"] THEN ASM_SIMP_TAC[m_taylor_error_eq] THEN move ["x"; "x_in"] THEN SUBGOAL_THEN `!i. i IN 1..dimindex (:N) ==> &0 <= EL (i - 1) w` (LABEL_TAC "w_ge0") THENL [ GEN_TAC THEN DISCH_TAC THEN REMOVE_THEN "domain" MP_TAC THEN new_rewrite [] [] pair_eq THEN REWRITE_TAC[m_cell_domain] THEN DISCH_THEN (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[VECTOR_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN new_rewrite [] [] ITLIST2_EQ_SUM THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN move ["i"; "i_in"] THEN ASM_SIMP_TAC[VECTOR_COMPONENT] THEN USE_THEN "i_in" (ASSUME_TAC o REWRITE_RULE[IN_NUMSEG]) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `LENGTH (EL (i - 1) dd_bounds_list:(real#real)list) = i` (LABEL_TAC "len_i") THENL [ REMOVE_THEN "ldd_all" MP_TAC THEN REWRITE_TAC[ALL_N_EL] THEN DISCH_THEN (MP_TAC o SPEC `i - 1`) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC ] THEN new_rewrite [] [] ITLIST2_EQ_SUM THEN ASM_REWRITE_TAC[] THENL [ REWRITE_TAC[LENGTH_BUTLAST] THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [ new_rewrite [] [] LAST_EL THENL [ ASM_REWRITE_TAC[GSYM LENGTH_EQ_NIL] THEN REMOVE_THEN "i_in" MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[ALL_N_EL] THEN DISCH_THEN (MP_TAC o SPEC `i - 1`) THEN ANTS_TAC THENL [ REMOVE_THEN "i_in" MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (MP_TAC o SPEC `i - 1`) THEN ANTS_TAC THENL [ UNDISCH_TAC `1 <= i /\ i <= dimindex (:N)` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC ] THEN SUBGOAL_THEN `1 + i - 1 = i /\ 1 + i - 1 = i` (fun th -> REWRITE_TAC[th]) THENL [ REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[partial2] THEN DISCH_THEN (MP_TAC o MATCH_MP interval_arith_abs_le) THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_LE_REFL]; ALL_TAC ] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ REAL_ARITH_TAC; ALL_TAC ] THEN ASM_REWRITE_TAC[LENGTH_BUTLAST] THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN move ["j"; "j_in"] THEN SUBGOAL_THEN `j IN 1..dimindex (:N)` (LABEL_TAC "j_in2") THENL [ REMOVE_THEN "i_in" MP_TAC THEN REMOVE_THEN "j_in" MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN ASM_SIMP_TAC[VECTOR_COMPONENT] THEN USE_THEN "j_in" (ASSUME_TAC o REWRITE_RULE[IN_NUMSEG]) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[ALL_N_EL] THEN DISCH_THEN (MP_TAC o SPEC `i - 1`) THEN ANTS_TAC THENL [ REMOVE_THEN "i_in" MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (MP_TAC o SPEC `j - 1`) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC ] THEN SUBGOAL_THEN `1 + j - 1 = j /\ 1 + i - 1 = i` (fun th -> REWRITE_TAC[th]) THENL [ REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[partial2] THEN DISCH_THEN (MP_TAC o MATCH_MP interval_arith_abs_le) THEN DISCH_THEN MATCH_MP_TAC THEN new_rewrite [] [] EL_BUTLAST THENL [ ASM_REWRITE_TAC[] THEN REMOVE_THEN "j_in" MP_TAC THEN REMOVE_THEN "i_in" MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[REAL_LE_REFL]);; let M_TAYLOR_ERROR_ITLIST2_ALT = prove(`!f domain y w f_lo f_hi d_bounds_list dd_bounds_list error. m_taylor_interval f domain y (vector w:real^N) (f_lo, f_hi) d_bounds_list dd_bounds_list ==> LENGTH w = dimindex (:N) ==> LENGTH dd_bounds_list = dimindex (:N) ==> all_n 1 dd_bounds_list (\i list. LENGTH list = i) ==> ITLIST2 (\list x z. x * (x * iabs (LAST list) + &2 * ITLIST2 (\a b c. b * iabs a + c) (BUTLAST list) w (&0)) + z) dd_bounds_list w (&0) <= error ==> m_taylor_error f domain (vector w) error`, REWRITE_TAC[m_taylor_interval] THEN REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL M_TAYLOR_ERROR_ITLIST2) THEN ASM_REWRITE_TAC[]);; (****************************) let M_TAYLOR_INTERVAL' = MY_RULE m_taylor_interval;; let dest_m_taylor m_taylor_tm = let ltm1, dd_bounds_list = dest_comb m_taylor_tm in let ltm2, d_bounds_list = dest_comb ltm1 in let ltm3, f_bounds = dest_comb ltm2 in let ltm4, w = dest_comb ltm3 in let ltm5, y = dest_comb ltm4 in let ltm6, domain = dest_comb ltm5 in rand ltm6, domain, y, w, f_bounds, d_bounds_list, dd_bounds_list;; let dest_m_taylor_thms n = let ty, xty, x_var, f_var, y_var, w_var, domain_var = get_types_and_vars n in fun m_taylor_th -> let f, domain, y, w, f_bounds, d_bounds_list, dd_bounds_list = dest_m_taylor (concl m_taylor_th) in let th0 = (INST[f, f_var; domain, domain_var; y, y_var; w, w_var; f_bounds, f_bounds_var; d_bounds_list, d_bounds_list_var; dd_bounds_list, dd_bounds_list_var] o inst_first_type_var ty) M_TAYLOR_INTERVAL' in let th1 = EQ_MP th0 m_taylor_th in let [domain_th; d2_th; lin_th; second_th] = CONJUNCTS th1 in domain_th, d2_th, lin_th, second_th;; (**********************) (* bound *) let M_TAYLOR_BOUND' = prove(`m_taylor_interval f domain y (vector w:real^N) (f_lo, f_hi) d_bounds_list dd_bounds_list /\ m_taylor_error f domain (vector w) error /\ ITLIST2 (\a b c. b * iabs a + c) d_bounds_list w (&0) <= b /\ b + inv(&2) * error <= a /\ lo <= f_lo - a /\ f_hi + a <= hi /\ LENGTH w = dimindex (:N) /\ LENGTH d_bounds_list = dimindex (:N) ==> (!x. x IN interval [domain] ==> interval_arith (f x) (lo, hi))`, REWRITE_TAC[GSYM m_bounded_on_int; m_taylor_interval; m_lin_approx; ALL_N_EL] THEN set_tac "s" `ITLIST2 _1 _2 _3 _4` THEN STRIP_TAC THEN SUBGOAL_THEN `diff2_domain domain (f:real^N->real)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN SIMP_TAC[diff2_domain; diff2c_domain; diff2c]; ALL_TAC ] THEN apply_tac m_taylor_bounds THEN MAP_EVERY EXISTS_TAC [`y:real^N`; `vector w:real^N`; `error:real`; `f_lo:real`; `f_hi:real`; `a:real`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b + inv (&2) * error` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_AC] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN new_rewrite [] [] ITLIST2_EQ_SUM THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[VECTOR_COMPONENT; REAL_LE_REFL; REAL_ABS_POS] THEN CONJ_TAC THENL [ UNDISCH_TAC `m_cell_domain domain (y:real^N) (vector w)` THEN new_rewrite [] [] pair_eq THEN REWRITE_TAC[m_cell_domain] THEN DISCH_THEN (MP_TAC o SPEC `x:num`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[VECTOR_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC ] THEN FIRST_X_ASSUM (MP_TAC o SPEC `x - 1`) THEN ANTS_TAC THENL [ POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN DISCH_THEN (MP_TAC o MATCH_MP interval_arith_abs_le) THEN SUBGOAL_THEN `1 + x - 1 = x` (fun th -> REWRITE_TAC[th]) THENL [ POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC ] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_LE_REFL]);; (* upper *) let M_TAYLOR_UPPER_BOUND' = prove(`m_taylor_interval f domain y (vector w) (f_lo, f_hi) d_bounds_list dd_bounds_list /\ m_taylor_error f domain (vector w:real^N) error /\ ITLIST2 (\a b c. b * iabs a + c) d_bounds_list w (&0) <= b /\ b + inv(&2) * error <= a /\ f_hi + a <= hi /\ LENGTH w = dimindex (:N) /\ LENGTH d_bounds_list = dimindex (:N) ==> (!p. p IN interval [domain] ==> f p <= hi)`, STRIP_TAC THEN MP_TAC (INST[`f_lo - a:real`, `lo:real`] M_TAYLOR_BOUND') THEN ASM_SIMP_TAC[interval_arith; REAL_LE_REFL]);; (* lower *) let M_TAYLOR_LOWER_BOUND' = prove(`m_taylor_interval f domain y (vector w:real^N) (f_lo, f_hi) d_bounds_list dd_bounds_list /\ m_taylor_error f domain (vector w) error /\ ITLIST2 (\a b c. b * iabs a + c) d_bounds_list w (&0) <= b /\ b + inv(&2) * error <= a /\ lo <= f_lo - a /\ LENGTH w = dimindex (:N) /\ LENGTH d_bounds_list = dimindex (:N) ==> (!p. p IN interval [domain] ==> lo <= f p)`, STRIP_TAC THEN MP_TAC (INST[`f_hi + a:real`, `hi:real`] M_TAYLOR_BOUND') THEN ASM_SIMP_TAC[interval_arith; REAL_LE_REFL]);; (* arrays *) let gen_taylor_bound_th bound_th n = let th0 = (DISCH_ALL o MY_RULE o REWRITE_RULE[MY_RULE M_TAYLOR_ERROR_ITLIST2_ALT]) bound_th in let ns = 1--n in let mk_list_hd l = mk_list (l, type_of (hd l)) in let w_list = mk_list_hd (map (fun i -> w_vars_array.(i)) ns) in let d_bounds_list = mk_list_hd (map (fun i -> df_vars_array.(i)) ns) in let dd_bounds_list = mk_list_hd (map (fun i -> mk_list_hd (map (fun j -> dd_vars_array.(i).(j)) (1--i))) ns) in let th1 = (INST[w_list, w_var_real_list; d_bounds_list, d_bounds_list_var; dd_bounds_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) th0 in let th2 = REWRITE_RULE[LAST; NOT_CONS_NIL; BUTLAST; all_n; ITLIST2_DEF; LENGTH; ARITH; dimindex_array.(n)] th1 in let th3 = REWRITE_RULE[HD; TL; REAL_MUL_RZERO; REAL_ADD_RID; GSYM error_mul_f2] th2 in (MY_RULE o REWRITE_RULE[float_inv2_th; SYM float2_eq]) th3;; let m_taylor_upper_array = Array.init (max_dim + 1) (fun i -> if i < 1 then TRUTH else gen_taylor_bound_th M_TAYLOR_UPPER_BOUND' i);; let m_taylor_lower_array = Array.init (max_dim + 1) (fun i -> if i < 1 then TRUTH else gen_taylor_bound_th M_TAYLOR_LOWER_BOUND' i);; let m_taylor_bound_array = Array.init (max_dim + 1) (fun i -> if i < 1 then TRUTH else gen_taylor_bound_th M_TAYLOR_BOUND' i);; (***************************) (* eval_m_taylor_bounds0 *) let eval_m_taylor_bounds0 mode n pp m_taylor_th = let bound_th = if mode = "upper" then m_taylor_upper_array.(n) else if mode = "bound" then m_taylor_bound_array.(n) else m_taylor_lower_array.(n) in let f_tm, domain_tm, y_tm, w_tm, f_bounds, d_bounds_list, dd_bounds_list = dest_m_taylor (concl m_taylor_th) in let f_lo, f_hi = dest_pair f_bounds and ws = dest_list (rand w_tm) and dfs = dest_list d_bounds_list and dds = map dest_list (dest_list dd_bounds_list) in let ns = 1--n in let df_vars = map (fun i -> df_vars_array.(i)) ns and dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) ns and w_vars = map (fun i -> w_vars_array.(i)) ns and y_var = mk_var ("y", type_of y_tm) and f_var = mk_var ("f", type_of f_tm) and domain_var = mk_var ("domain", type_of domain_tm) in (* sum of first partials *) let d_th = let mul_wd = map2 (error_mul_f2_le_conv2 pp) ws dfs in end_itlist (add_ineq_hi pp) mul_wd in let b_tm = (rand o concl) d_th in (* sum of second partials *) let dd_th = let ( * ), ( + ) = mul_ineq_pos_const_hi pp, add_ineq_hi pp in let mul_wdd = map2 (fun list i -> my_map2 (error_mul_f2_le_conv2 pp) ws list) dds ns in let sums1 = map (end_itlist ( + ) o butlast) (tl mul_wdd) in let sums2 = (hd o hd) mul_wdd :: map2 (fun list th1 -> last list + two_float * th1) (tl mul_wdd) sums1 in let sums = map2 ( * ) ws sums2 in end_itlist ( + ) sums in let error_tm = (rand o concl) dd_th in (* additional inequalities *) let ineq1_th = let ( * ), ( + ) = float_mul_hi pp, add_ineq_hi pp in mk_refl_ineq b_tm + float_inv2 * error_tm in let a_tm = (rand o concl) ineq1_th in let prove_ineq2, bounds_inst = if mode = "upper" then let ineq2 = float_add_hi pp f_hi a_tm in MY_PROVE_HYP ineq2, [(rand o concl) ineq2, hi_var_real] else if mode = "bound" then let ineq2 = float_add_hi pp f_hi a_tm in let ineq3 = float_sub_lo pp f_lo a_tm in MY_PROVE_HYP ineq2 o MY_PROVE_HYP ineq3, [(rand o concl) ineq2, hi_var_real; (lhand o concl) ineq3, lo_var_real] else let ineq2 = float_sub_lo pp f_lo a_tm in MY_PROVE_HYP ineq2, [(lhand o concl) ineq2, lo_var_real] in (* final step *) let inst_list = let inst1 = zip dfs df_vars in let inst2 = zip (List.flatten dds) (List.flatten dd_vars) in let inst3 = zip ws w_vars in inst1 @ inst2 @ inst3 in (MY_PROVE_HYP m_taylor_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP d_th o MY_PROVE_HYP ineq1_th o prove_ineq2 o INST ([f_hi, f_hi_var; f_lo, f_lo_var; error_tm, error_var; a_tm, a_var_real; b_tm, b_var_real; y_tm, y_var; domain_tm, domain_var; f_tm, f_var] @ bounds_inst @ inst_list)) bound_th;; (* upper *) let eval_m_taylor_upper_bound = eval_m_taylor_bounds0 "upper";; (* lower *) let eval_m_taylor_lower_bound = eval_m_taylor_bounds0 "lower";; (* bound *) let eval_m_taylor_bound = eval_m_taylor_bounds0 "bound";; (******************************) (* taylor_upper_partial_bound *) (* taylor_lower_partial_bound *) (* bound *) let M_TAYLOR_PARTIAL_BOUND' = prove(`m_taylor_interval f domain (y:real^N) (vector w) f_bounds d_bounds_list dd_bounds_list /\ i IN 1..dimindex (:N) /\ EL (i - 1) d_bounds_list = (df_lo, df_hi) /\ (!x. x IN interval [domain] ==> all_n 1 dd_list (\j int. interval_arith (if j <= i then partial2 j i f x else partial2 i j f x) int)) /\ LENGTH dd_list = dimindex (:N) /\ LENGTH d_bounds_list = dimindex (:N) /\ LENGTH w = dimindex (:N) /\ ITLIST2 (\a b c. b * iabs a + c) dd_list w (&0) <= error /\ df_hi + error <= hi ==> lo <= df_lo - error ==> (!x. x IN interval [domain] ==> interval_arith (partial i f x) (lo, hi))`, REWRITE_TAC[m_taylor_interval; m_lin_approx; ALL_N_EL; GSYM m_bounded_on_int] THEN set_tac "s" `ITLIST2 _1 _2 _3 _4` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 <= i /\ i <= dimindex (:N)` (LABEL_TAC "i_in") THENL [ ASM_REWRITE_TAC[GSYM IN_NUMSEG]; ALL_TAC ] THEN SUBGOAL_THEN `diff2_domain domain (f:real^N->real)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN SIMP_TAC[diff2_domain; diff2c_domain; diff2c]; ALL_TAC ] THEN REWRITE_TAC[ETA_AX] THEN apply_tac m_taylor_partial_bounds THEN MAP_EVERY EXISTS_TAC [`y:real^N`; `vector w:real^N`; `error:real`; `df_lo:real`; `df_hi:real`] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `i - 1`) THEN ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> i - 1 < n`] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= i ==> 1 + i - 1 = i`; interval_arith] THEN DISCH_THEN (fun th -> ALL_TAC) THEN REWRITE_TAC[m_taylor_partial_error] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN new_rewrite [] [] ITLIST2_EQ_SUM THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN move ["j"; "j_in"] THEN ASM_SIMP_TAC[VECTOR_COMPONENT] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ UNDISCH_TAC `m_cell_domain domain (y:real^N) (vector w)` THEN new_rewrite [] [] pair_eq THEN REWRITE_TAC[m_cell_domain] THEN DISCH_THEN (MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[VECTOR_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC ] THEN FIRST_X_ASSUM (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `j - 1`) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN ASM_SIMP_TAC[ARITH_RULE `1 <= j /\ j <= n ==> j - 1 < n`] THEN ASM_SIMP_TAC[ARITH_RULE `!i. 1 <= i ==> 1 + i - 1 = i`; GSYM partial2] THEN DISCH_THEN (MP_TAC o MATCH_MP interval_arith_abs_le) THEN COND_CASES_TAC THEN TRY (DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_LE_REFL]) THEN new_rewrite [] [] mixed_second_partials THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN ASM_SIMP_TAC[diff2c_domain]; ALL_TAC ] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_LE_REFL]);; (* upper *) let M_TAYLOR_PARTIAL_UPPER' = prove(`m_taylor_interval f domain (y:real^N) (vector w) f_bounds d_bounds_list dd_bounds_list /\ i IN 1..dimindex (:N) /\ EL (i - 1) d_bounds_list = (df_lo, df_hi) /\ (!x. x IN interval [domain] ==> all_n 1 dd_list (\j int. interval_arith (if j <= i then partial2 j i f x else partial2 i j f x) int)) /\ LENGTH dd_list = dimindex (:N) /\ LENGTH d_bounds_list = dimindex (:N) /\ LENGTH w = dimindex (:N) /\ ITLIST2 (\a b c. b * iabs a + c) dd_list w (&0) <= error /\ df_hi + error <= hi ==> (!x. x IN interval [domain] ==> partial i f x <= hi)`, REPEAT STRIP_TAC THEN MP_TAC (INST[`df_lo - error`, `lo:real`] M_TAYLOR_PARTIAL_BOUND') THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_SIMP_TAC[interval_arith]);; (* lower *) let M_TAYLOR_PARTIAL_LOWER' = prove(`m_taylor_interval f domain (y:real^N) (vector w) f_bounds d_bounds_list dd_bounds_list /\ i IN 1..dimindex (:N) /\ EL (i - 1) d_bounds_list = (df_lo, df_hi) /\ (!x. x IN interval [domain] ==> all_n 1 dd_list (\j int. interval_arith (if j <= i then partial2 j i f x else partial2 i j f x) int)) /\ LENGTH dd_list = dimindex (:N) /\ LENGTH d_bounds_list = dimindex (:N) /\ LENGTH w = dimindex (:N) /\ ITLIST2 (\a b c. b * iabs a + c) dd_list w (&0) <= error /\ lo <= df_lo - error ==> (!x. x IN interval [domain] ==> lo <= partial i f x)`, REPEAT STRIP_TAC THEN MP_TAC (INST[`df_hi + error`, `hi:real`] M_TAYLOR_PARTIAL_BOUND') THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_SIMP_TAC[interval_arith]);; (* arrays *) let gen_taylor_partial_bound_th = let imp_and_eq = TAUT `((P ==> Q) /\ (P ==> R)) <=> (P ==> Q /\ R)` in let mk_list_hd l = mk_list (l, type_of (hd l)) in let dd_list_var = `dd_list : (real#real)list` in fun bound_th n i -> let ns = 1--n in let i_tm = mk_small_numeral i in let w_list = mk_list_hd (map (fun i -> w_vars_array.(i)) ns) in let d_bounds_list = mk_list_hd (map (fun i -> df_vars_array.(i)) ns) in let dd_bounds_list = mk_list_hd (map (fun i -> mk_list_hd (map (fun j -> dd_vars_array.(i).(j)) (1--i))) ns) in let dd_list = mk_list_hd (map (fun j -> if j <= i then dd_vars_array.(i).(j) else dd_vars_array.(j).(i)) ns) in let th1 = (INST[w_list, w_var_real_list; d_bounds_list, d_bounds_list_var; dd_list, dd_list_var; i_tm, `i:num`; dd_bounds_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) bound_th in let th2 = REWRITE_RULE[REAL_ADD_RID; HD; TL; ITLIST2_DEF; LENGTH; ARITH; dimindex_array.(n)] th1 in let th3 = REWRITE_RULE[IN_NUMSEG; ARITH; el_thms_array.(n).(i - 1)] th2 in let th4 = (REWRITE_RULE[] o INST[`df_lo:real, df_hi:real`, df_vars_array.(i)]) th3 in let th5 = (MY_RULE o REWRITE_RULE[GSYM imp_and_eq; GSYM AND_FORALL_THM; all_n; ARITH]) th4 in let m_taylor_hyp = find (can dest_m_taylor) (hyp th5) in let t_th0 = (REWRITE_RULE[ARITH; all_n; second_bounded; m_taylor_interval] o ASSUME) m_taylor_hyp in let t_th1 = REWRITE_RULE[GSYM imp_and_eq; GSYM AND_FORALL_THM] t_th0 in (MY_RULE_NUM o REWRITE_RULE[GSYM error_mul_f2; t_th1] o DISCH_ALL) th5;; (* The (n, i)-th element is the theorem |- i IN 1..dimindex (:n) *) let i_in_array = Array.init (max_dim + 1) (fun i -> Array.init (i + 1) (fun j -> if j < 1 then TRUTH else let j_tm = mk_small_numeral j in let tm0 = `j IN 1..dimindex (:N)` in let tm1 = (subst [j_tm, `j:num`] o inst [n_type_array.(i), nty]) tm0 in prove(tm1, REWRITE_TAC[dimindex_array.(i); IN_NUMSEG] THEN ARITH_TAC)));; let m_taylor_partial_upper_array, m_taylor_partial_lower_array, m_taylor_partial_bound_array = let gen_array bound_th = Array.init (max_dim + 1) (fun i -> Array.init (i + 1) (fun j -> if j < 1 then TRUTH else gen_taylor_partial_bound_th bound_th i j)) in gen_array M_TAYLOR_PARTIAL_UPPER', gen_array M_TAYLOR_PARTIAL_LOWER', gen_array M_TAYLOR_PARTIAL_BOUND';; (***************************) let eval_m_taylor_partial_bounds0 mode n pp i m_taylor_th = let bound_th = if mode = "upper" then m_taylor_partial_upper_array.(n).(i) else if mode = "bound" then m_taylor_partial_bound_array.(n).(i) else m_taylor_partial_lower_array.(n).(i) in let f_tm, domain_tm, y_tm, w_tm, f_bounds, d_bounds_list, dd_bounds_list = dest_m_taylor (concl m_taylor_th) in let ws = dest_list (rand w_tm) and dfs = dest_list d_bounds_list and dds = map dest_list (dest_list dd_bounds_list) in let ns = 1--n in let df_lo, df_hi = dest_pair (List.nth dfs (i - 1)) and df_vars = map (fun i -> df_vars_array.(i)) ns and dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) ns and w_vars = map (fun i -> w_vars_array.(i)) ns and y_var = mk_var ("y", type_of y_tm) and f_var = mk_var ("f", type_of f_tm) and domain_var = mk_var ("domain", type_of domain_tm) in (* sum of second partials *) let dd_list = map (fun j -> if j <= i then List.nth (List.nth dds (i-1)) (j-1) else List.nth (List.nth dds (j-1)) (i-1)) ns in let dd_th = let mul_dd = map2 (error_mul_f2_le_conv2 pp) ws dd_list in end_itlist (add_ineq_hi pp) mul_dd in let error_tm = (rand o concl) dd_th in (* additional inequalities *) let prove_ineq, bounds_inst = if mode = "upper" then let ineq2 = float_add_hi pp df_hi error_tm in MY_PROVE_HYP ineq2, [(rand o concl) ineq2, hi_var_real] else if mode = "bound" then let ineq2 = float_add_hi pp df_hi error_tm in let ineq3 = float_sub_lo pp df_lo error_tm in MY_PROVE_HYP ineq2 o MY_PROVE_HYP ineq3, [(rand o concl) ineq2, hi_var_real; (lhand o concl) ineq3, lo_var_real] else let ineq2 = float_sub_lo pp df_lo error_tm in MY_PROVE_HYP ineq2, [(lhand o concl) ineq2, lo_var_real] in (* final step *) let inst_list = let inst1 = zip dfs df_vars in let inst2 = zip (List.flatten dds) (List.flatten dd_vars) in let inst3 = zip ws w_vars in inst1 @ inst2 @ inst3 in (MY_PROVE_HYP m_taylor_th o MY_PROVE_HYP dd_th o prove_ineq o INST ([df_hi, df_hi_var; df_lo, df_lo_var; error_tm, error_var; y_tm, y_var; domain_tm, domain_var; f_bounds, f_bounds_var; f_tm, f_var] @ bounds_inst @ inst_list)) bound_th;; (* upper *) let eval_m_taylor_partial_upper = eval_m_taylor_partial_bounds0 "upper";; (* lower *) let eval_m_taylor_partial_lower = eval_m_taylor_partial_bounds0 "lower";; (* bound *) let eval_m_taylor_partial_bound = eval_m_taylor_partial_bounds0 "bound";; end;; hol-light/Formal_ineqs/taylor/m_taylor_arith.hl000066400000000000000000002010451303454263000222420ustar00rootroot00000000000000(* =========================================================== *) (* Formal arithmetic of taylor intervals *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "taylor/m_taylor.hl";; needs "misc/vars.hl";; module M_taylor_arith = struct open Arith_misc;; open Arith_nat;; open Arith_float;; open More_float;; open Float_atn;; open Float_theory;; open M_taylor;; open Misc_vars;; let sqrt_tm = `sqrt` and atn_tm = `atn` and acs_tm = `acs`;; (*************************************) let binary_beta_gen_eq f1_tm f2_tm x_var op_tm = let beta_tm1, beta_tm2 = mk_comb (f1_tm, x_var), mk_comb (f2_tm, x_var) in let beta_th1 = if is_abs f1_tm then BETA beta_tm1 else REFL beta_tm1 and beta_th2 = if is_abs f2_tm then BETA beta_tm2 else REFL beta_tm2 in ABS x_var (MK_COMB (AP_TERM op_tm beta_th1, beta_th2));; let unary_beta_gen_eq f_tm x_var op_tm = let beta_tm = mk_comb (f_tm, x_var) in let beta_th = if is_abs f_tm then BETA beta_tm else REFL beta_tm in ABS x_var (AP_TERM op_tm beta_th);; let m_taylor_interval_norm th eq_th = let lhs1, d2f = dest_comb (concl th) in let lhs2, d1f = dest_comb lhs1 in let lhs3, d0f = dest_comb lhs2 in let lhs4, w = dest_comb lhs3 in let lhs5, y = dest_comb lhs4 in let lhs6, domain = dest_comb lhs5 in let m_taylor = rator lhs6 in let th0 = AP_TERM m_taylor eq_th in let th1 = AP_THM (AP_THM (AP_THM (AP_THM (AP_THM (AP_THM th0 domain) y) w) d0f) d1f) d2f in EQ_MP th1 th;; (*****************************************) (* dest_m_lin_approx *) let MK_M_LIN_APPROX' = (RULE o MATCH_MP EQ_IMP o SYM o SPEC_ALL) m_lin_approx;; let DEST_M_LIN_APPROX' = MY_RULE_NUM m_lin_approx;; let m_lin_approx_components n m_lin_th = let f_tm, x_tm, f_bounds, d_bounds_list = dest_lin_approx (concl m_lin_th) in let ty = n_type_array.(n) in let f_var = mk_var ("f", type_of f_tm) in let x_var = mk_var ("x", type_of x_tm) in let th0 = (INST[f_tm, f_var; x_tm, x_var; f_bounds, f_bounds_var; d_bounds_list, df_bounds_list_var] o inst_first_type_var ty) DEST_M_LIN_APPROX' in let th1 = EQ_MP th0 m_lin_th in let [r1; r2; r3] = CONJUNCTS th1 in r1, r2, r3;; (********************************) (* all_n manipulations *) let ALL_N_EMPTY' = prove(`all_n n [] (s:num->A->bool)`, REWRITE_TAC[all_n]);; let ALL_N_CONS_IMP' = (MY_RULE o prove)(`SUC n = m /\ s n (x:A) ==> (all_n m t s <=> all_n n (CONS x t) s)`, SIMP_TAC[all_n]);; let ALL_N_CONS_EQ' = (MY_RULE o prove)(`SUC n = m ==> (all_n n (CONS x t) s <=> (s n (x:A) /\ all_n m t s))`, SIMP_TAC[all_n]);; let dest_all_n all_n_tm = let ltm, s_tm = dest_comb all_n_tm in let ltm2, list_tm = dest_comb ltm in rand ltm2, list_tm, s_tm;; (* Splits `|- all_n n list s` into separate components. Also returns the list of SUC n = m theorems *) let all_n_components all_n_th = let n_tm, list_tm, s_tm = dest_all_n (concl all_n_th) in let list_ty = type_of list_tm in let ty = (hd o snd o dest_type) list_ty in let s_var = mk_var ("s", type_of s_tm) and x_var = mk_var ("x", ty) and t_var = mk_var ("t", list_ty) in let all_n_cons_th = (INST[s_tm, s_var] o INST_TYPE[ty, aty]) ALL_N_CONS_EQ' in let rec get_components n_tm list_tm all_n_th = if is_const list_tm then [], [] else let x_tm, t_tm = dest_cons list_tm in let suc_th = raw_suc_conv_hash (mk_comb (suc_op_num, n_tm)) in let m_tm = rand (concl suc_th) in let th0 = INST[n_tm, n_var_num; m_tm, m_var_num; x_tm, x_var; t_tm, t_var] all_n_cons_th in let th1 = MY_PROVE_HYP suc_th th0 in let th2 = EQ_MP th1 all_n_th in let snx_th, all_m_th = CONJUNCT1 th2, CONJUNCT2 th2 in let comps, suc_list = get_components m_tm t_tm all_m_th in snx_th :: comps, suc_th :: suc_list in get_components n_tm list_tm all_n_th;; (* Builds all_n from the given theorems and SUC n = m results *) let build_all_n ths suc_ths = (* The list ths should be not empty *) let tm0 = (concl o hd) ths in let lhs, rhs = dest_comb tm0 in let s_tm = rator lhs in let ty = type_of rhs in let list_ty = mk_type ("list", [ty]) in let s_var = mk_var ("s", type_of s_tm) and x_var = mk_var ("x", ty) and t_var = mk_var ("t", list_ty) in let m_tm = (rand o concl o hd) suc_ths in let empty_th = (INST[s_tm, s_var; m_tm, n_var_num] o INST_TYPE[ty, aty]) ALL_N_EMPTY' in let cons_th = (INST[s_tm, s_var] o INST_TYPE[ty, aty]) ALL_N_CONS_IMP' in let build suc_th s_th th = let t_tm = (rand o rator o concl) th in let x_tm = rand (concl s_th) in let lhs, m_tm = dest_eq (concl suc_th) in let n_tm = rand lhs in let th' = INST[n_tm, n_var_num; m_tm, m_var_num; x_tm, x_var; t_tm, t_var] cons_th in EQ_MP (MY_PROVE_HYP s_th (MY_PROVE_HYP suc_th th')) th in rev_itlist2 build suc_ths ths empty_th;; (*************************) (* Generates |- s D1 a1 /\ ... /\ s D_m a_m <=> all_n D1 [a1; ... ; a_m] s *) let gen_all_n_th m = let a_vars = map (fun i -> mk_var ("a"^string_of_int i, aty)) (1--m) in let list_tm = mk_list (a_vars, aty) in let all_tm = mk_comb (mk_binop `all_n : num -> (A)list -> (num -> A -> bool) -> bool` `1` list_tm, `s : num -> A -> bool`) in (SYM o MY_RULE_NUM o CONV_RULE NUM_REDUCE_CONV) (REWRITE_CONV[all_n] all_tm);; let all_n_array = Array.init (max_dim + 1) (fun i -> if i = 0 then TRUTH else gen_all_n_th i);; (***) let build2 ths = let n = length ths in let th0 = rev_itlist CONJ (tl ths) (hd ths) in let tm0 = (concl o hd) ths in let lhs, rhs = dest_comb tm0 in let a_tms = rev (map (rand o concl) ths) in let s_tm = rator lhs in let ty = type_of rhs in let s_var = mk_var ("s", type_of s_tm) and a_vars0 = map (fun i -> mk_var ("a"^string_of_int i, ty)) (1--n) in let th1 = (INST[s_tm, s_var] o INST (zip a_tms a_vars0) o INST_TYPE[ty, aty]) all_n_array.(n) in EQ_MP th1 th0;; (************************) (* Constructs all_n n (map s list1) *) let eval_all_n all_n1_th beta_flag s = let ths1', suc_ths = all_n_components all_n1_th in let ths1 = if beta_flag then map MY_BETA_RULE ths1' else ths1' in let ths1, suc_ths = List.rev ths1, List.rev suc_ths in let ths = map s ths1 in (* build_all_n ths suc_ths;; *) build2 ths;; (* Constructs all_n n (map2 s list1 list2) *) let eval_all_n2 all_n1_th all_n2_th beta_flag s = let ths1', suc_ths = all_n_components all_n1_th in let ths2', _ = all_n_components all_n2_th in let ths1, ths2 = if beta_flag then map MY_BETA_RULE ths1', map MY_BETA_RULE ths2' else ths1', ths2' in let ths1, ths2, suc_ths = List.rev ths1, List.rev ths2, List.rev suc_ths in let ths = map2 s ths1 ths2 in (* build_all_n ths suc_ths;; *) build2 ths;; (***************************************) (* eval_m_taylor_add *) let SECOND_BOUNDED' = MY_RULE_NUM second_bounded;; let dest_second_bounded tm = let ltm, dd = dest_comb tm in let ltm2, domain = dest_comb ltm in rand ltm2, domain, dd;; let second_bounded_components n th = let f_tm, domain_tm, dd_tm = dest_second_bounded (concl th) in let x_var = mk_var ("x", n_vector_type_array.(n)) in let th0 = (INST[f_tm, mk_var ("f", type_of f_tm); domain_tm, mk_var ("domain", type_of domain_tm); dd_tm, dd_bounds_list_var] o inst_first_type_var n_type_array.(n)) SECOND_BOUNDED' in UNDISCH (SPEC x_var (EQ_MP th0 th));; let MK_M_TAYLOR_ADD' = (MY_RULE_NUM o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> diff2c_domain domain g ==> interval_arith (f y + g y) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f y + partial i g y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x + partial2 j i g x) int))) ==> m_taylor_interval (\x. f x + g x) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N) /\ lift o g differentiable at y` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN UNDISCH_TAC `diff2c_domain domain (g:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN STRIP_TAC THEN REPEAT (new_rewrite [] [] diff2_imp_diff) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_add THEN ASM_REWRITE_TAC[]; REWRITE_TAC[f_lift_add] THEN new_rewrite [] [] DIFFERENTIABLE_ADD THEN ASM_REWRITE_TAC[ETA_AX]; ASM_SIMP_TAC[partial_add]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN UNDISCH_TAC `diff2c_domain domain (g:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN REPEAT (DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN ASM_SIMP_TAC[second_partial_add]);; (*************************) let add_partial_lemma' = prove(`interval_arith (partial i f (x:real^N) + partial i g x) int <=> (\i int. interval_arith (partial i f x + partial i g x) int) i int`, REWRITE_TAC[]);; let add_second_lemma' = prove(`interval_arith (partial2 j i f (x:real^N) + partial2 j i g x) int <=> (\j int. interval_arith (partial2 j i f x + partial2 j i g x) int) j int`, REWRITE_TAC[]);; let add_second_lemma'' = (NUMERALS_TO_NUM o prove)(`all_n 1 list (\j int. interval_arith (partial2 j i f (x:real^N) + partial2 j i g x) int) <=> (\i list. all_n 1 list (\j int. interval_arith (partial2 j i f x + partial2 j i g x) int)) i list`, REWRITE_TAC[]);; let eval_m_taylor_add n p_lin p_second taylor1_th taylor2_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let _, diff2_f2_th, lin2_th, second2_th = dest_m_taylor_thms n taylor2_th in let f1_tm = (rand o concl) diff2_f1_th and f2_tm = (rand o concl) diff2_f2_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and g_var = mk_var ("g", type_of f2_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th and _, bounds2_th, df2_th = m_lin_approx_components n lin2_th in let bounds_th = float_interval_add p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in let add_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, x_var] o INST_TYPE[n_type_array.(n), nty]) add_partial_lemma' in let add th1 th2 = let add_th = float_interval_add p_lin th1 th2 in let int_tm = rand (concl add_th) and i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] add_lemma0 in EQ_MP th0 add_th in let df_th = eval_all_n2 df1_th df2_th true add in let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in let dd2 = second_bounded_components n second2_th in let add_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) add_second_lemma' in let add_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) add_second_lemma'' in let add_second2 th1 th2 = let i_tm = (rand o rator o concl) th1 in let th1, th2 = MY_BETA_RULE th1, MY_BETA_RULE th2 in let lemma = INST[i_tm, i_var_num] add_second_lemma0 in let add_second th1 th2 = let add_th = float_interval_add p_second th1 th2 in let int_tm = rand (concl add_th) and j_tm = (rand o rator o rator o rator o lhand) (concl th1) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 add_th in let add_th = eval_all_n2 th1 th2 true add_second in let list_tm = (rand o rator o concl) add_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] add_second_lemma1 in EQ_MP lemma1 add_th in let dd_th0 = eval_all_n2 dd1 dd2 false add_second2 in let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o INST[f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_ADD' in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var add_op_real in m_taylor_interval_norm th eq_th;; (***************************************) (* eval_m_taylor_sub *) let MK_M_TAYLOR_SUB' = (MY_RULE_NUM o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> diff2c_domain domain g ==> interval_arith (f y - g y) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f y - partial i g y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x - partial2 j i g x) int))) ==> m_taylor_interval (\x. f x - g x) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N) /\ lift o g differentiable at y` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN UNDISCH_TAC `diff2c_domain domain (g:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN STRIP_TAC THEN REPEAT (new_rewrite [] [] diff2_imp_diff) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_sub THEN ASM_REWRITE_TAC[]; REWRITE_TAC[f_lift_sub] THEN new_rewrite [] [] DIFFERENTIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; ASM_SIMP_TAC[partial_sub]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN UNDISCH_TAC `diff2c_domain domain (g:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN REPEAT (DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN ASM_SIMP_TAC[second_partial_sub]);; (*************************) let sub_partial_lemma' = prove(`interval_arith (partial i f (x:real^N) - partial i g x) int <=> (\i int. interval_arith (partial i f x - partial i g x) int) i int`, REWRITE_TAC[]);; let sub_second_lemma' = prove(`interval_arith (partial2 j i f (x:real^N) - partial2 j i g x) int <=> (\j int. interval_arith (partial2 j i f x - partial2 j i g x) int) j int`, REWRITE_TAC[]);; let sub_second_lemma'' = (NUMERALS_TO_NUM o prove)(`all_n 1 list (\j int. interval_arith (partial2 j i f (x:real^N) - partial2 j i g x) int) <=> (\i list. all_n 1 list (\j int. interval_arith (partial2 j i f x - partial2 j i g x) int)) i list`, REWRITE_TAC[]);; let eval_m_taylor_sub n p_lin p_second taylor1_th taylor2_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let _, diff2_f2_th, lin2_th, second2_th = dest_m_taylor_thms n taylor2_th in let f1_tm = (rand o concl) diff2_f1_th and f2_tm = (rand o concl) diff2_f2_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and g_var = mk_var ("g", type_of f2_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th and _, bounds2_th, df2_th = m_lin_approx_components n lin2_th in let bounds_th = float_interval_sub p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in let sub_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, x_var] o INST_TYPE[n_type_array.(n), nty]) sub_partial_lemma' in let sub th1 th2 = let sub_th = float_interval_sub p_lin th1 th2 in let int_tm = rand (concl sub_th) and i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] sub_lemma0 in EQ_MP th0 sub_th in let df_th = eval_all_n2 df1_th df2_th true sub in let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in let dd2 = second_bounded_components n second2_th in let sub_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) sub_second_lemma' in let sub_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) sub_second_lemma'' in let sub_second2 th1 th2 = let i_tm = (rand o rator o concl) th1 in let th1, th2 = MY_BETA_RULE th1, MY_BETA_RULE th2 in let lemma = INST[i_tm, i_var_num] sub_second_lemma0 in let sub_second th1 th2 = let sub_th = float_interval_sub p_second th1 th2 in let int_tm = rand (concl sub_th) and j_tm = (rand o rator o rator o rator o lhand) (concl th1) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 sub_th in let sub_th = eval_all_n2 th1 th2 true sub_second in let list_tm = (rand o rator o concl) sub_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] sub_second_lemma1 in EQ_MP lemma1 sub_th in let dd_th0 = eval_all_n2 dd1 dd2 false sub_second2 in let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o INST[f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_SUB' in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var sub_op_real in m_taylor_interval_norm th eq_th;; (*******************************************************) (***************************************) (* eval_m_taylor_mul *) let MK_M_TAYLOR_MUL' = (MY_RULE_NUM o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> diff2c_domain domain g ==> interval_arith (f y * g y) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f y * g y + f y * partial i g y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x) int))) ==> m_taylor_interval (\x. f x * g x) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N) /\ lift o g differentiable at y` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN UNDISCH_TAC `diff2c_domain domain (g:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN STRIP_TAC THEN REPEAT (new_rewrite [] [] diff2_imp_diff) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_mul THEN ASM_REWRITE_TAC[]; new_rewrite [] [] differentiable_mul THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[partial_mul]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN UNDISCH_TAC `diff2c_domain domain (g:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN REPEAT (DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN ASM_SIMP_TAC[second_partial_mul]);; (*************************) let mul_partial_lemma' = prove(`interval_arith (partial i f (y:real^N) * g y + f y * partial i g y) int <=> (\i int. interval_arith (partial i f y * g y + f y * partial i g y) int) i int`, REWRITE_TAC[]);; let mul_second_lemma' = prove(`interval_arith ((partial2 j i f x * g (x:real^N) + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x) int <=> (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x) int) j int`, REWRITE_TAC[]);; let mul_second_lemma'' = (NUMERALS_TO_NUM o prove) (`all_n 1 list (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f (x:real^N) * partial2 j i g x) int) <=> (\i list. all_n 1 list (\j int. interval_arith ((partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x) int)) i list`, REWRITE_TAC[]);; let eval_m_taylor_mul n p_lin p_second taylor1_th taylor2_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th and _, diff2_f2_th, lin2_th, second2_th = dest_m_taylor_thms n taylor2_th in let f1_tm = (rand o concl) diff2_f1_th and f2_tm = (rand o concl) diff2_f2_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and g_var = mk_var ("g", type_of f2_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th and _, bounds2_th, df2_th = m_lin_approx_components n lin2_th in let bounds_th = float_interval_mul p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in let mul_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) mul_partial_lemma' in let mul th1 th2 = let mul_th = let ( * ), ( + ) = float_interval_mul p_lin, float_interval_add p_lin in th1 * bounds2_th + bounds1_th * th2 in let int_tm = rand (concl mul_th) in let i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] mul_lemma0 in EQ_MP th0 mul_th in let df_th = eval_all_n2 df1_th df2_th true mul in let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in let dd2 = second_bounded_components n second2_th in let mul_second_lemma0 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) mul_second_lemma' in let mul_second_lemma1 = (INST[f1_tm, f_var; f2_tm, g_var] o INST_TYPE[n_type_array.(n), nty]) mul_second_lemma'' in let undisch = UNDISCH o SPEC x_var in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in let d2_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor2_th in undisch th0) (1--n) in let f1_bound = undisch (eval_m_taylor_bound n p_second taylor1_th) and f2_bound = undisch (eval_m_taylor_bound n p_second taylor2_th) in let mul_second2 th1 th2 = let i_tm = (rand o rator o concl) th1 in let i_int = (Num.int_of_num o raw_dest_hash) i_tm in let di1 = List.nth d1_bounds (i_int - 1) and di2 = List.nth d2_bounds (i_int - 1) in let th1, th2 = MY_BETA_RULE th1, MY_BETA_RULE th2 in let lemma = INST[i_tm, i_var_num] mul_second_lemma0 in let mul_second th1 th2 = let j_tm = (rand o rator o rator o rator o lhand) (concl th1) in let j_int = (Num.int_of_num o raw_dest_hash) j_tm in let dj1 = List.nth d1_bounds (j_int - 1) and dj2 = List.nth d2_bounds (j_int - 1) in let mul_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (th1 * f2_bound + di1 * dj2) + (dj1 * di2 + f1_bound * th2) in let int_tm = rand (concl mul_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 mul_th in let mul_th = eval_all_n2 th1 th2 true mul_second in let list_tm = (rand o rator o concl) mul_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] mul_second_lemma1 in EQ_MP lemma1 mul_th in let dd_th0 = eval_all_n2 dd1 dd2 false mul_second2 in let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o INST[f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_MUL' in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var mul_op_real in m_taylor_interval_norm th eq_th;; (*******************************************************) (* neg, inv, sqrt, atn, acs *) let partial_uni_compose' = REWRITE_RULE[SWAP_FORALL_THM; GSYM RIGHT_IMP_FORALL_THM] partial_uni_compose;; let second_partial_uni_compose' = REWRITE_RULE[SWAP_FORALL_THM; GSYM RIGHT_IMP_FORALL_THM] second_partial_uni_compose;; (* neg *) let MK_M_TAYLOR_NEG' = (MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> interval_arith (-- (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (-- partial i f y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (-- partial2 j i f x) int))) ==> m_taylor_interval (\x. -- (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN REPEAT (new_rewrite [] [] diff2_imp_diff) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ new_rewrite [] [] diff2c_domain_neg THEN ASM_REWRITE_TAC[]; REWRITE_TAC[f_lift_neg] THEN new_rewrite [] [] DIFFERENTIABLE_NEG THEN ASM_REWRITE_TAC[ETA_AX]; ASM_SIMP_TAC[partial_neg]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_SIMP_TAC[second_partial_neg]);; (* inv *) let MK_M_TAYLOR_INV' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> interval_not_zero f_bounds ==> diff2c_domain domain f ==> interval_arith (inv (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (--inv (f y * f y) * partial i f y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f x - inv (f x * f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. inv (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN new_rewrite [] [] diff2_imp_diff THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN SUBGOAL_THEN `!x:real^N. x IN interval [domain] ==> ~(f x = &0)` ASSUME_TAC THENL [ GEN_TAC THEN DISCH_TAC THEN apply_tac interval_arith_not_zero THEN EXISTS_TAC `f_bounds:real#real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN SUBGOAL_THEN `~(f (y:real^N) = &0)` ASSUME_TAC THENL [ FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_THM] THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff2c_inv_compose THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; new_rewrite [] [`inv _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff_uni_compose THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_AT_INV THEN ASM_REWRITE_TAC[]; new_rewrite [] [`inv _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN MP_TAC (ISPECL [`y:real^N`; `f:real^N->real`] partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `inv`) THEN ANTS_TAC THENL [ MATCH_MP_TAC REAL_DIFFERENTIABLE_AT_INV THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN ASM_SIMP_TAC[derivative_inv]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (ISPECL [`x:real^N`; `f:real^N->real`] second_partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `inv`) THEN ANTS_TAC THENL [ MATCH_MP_TAC diff2_inv THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN new_rewrite [] [`inv _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[second_derivative_inv; derivative_inv; REAL_MUL_LNEG; GSYM real_sub] THEN ASM_SIMP_TAC[REAL_ARITH `a pow 3 = a * a * a`]);; (* sqrt *) let MK_M_TAYLOR_SQRT' = (UNDISCH_ALL o PURE_REWRITE_RULE[float2_eq; float4_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> interval_pos f_bounds ==> diff2c_domain domain f ==> interval_arith (sqrt (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (inv (&2 * sqrt (f y)) * partial i f y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f x + inv (&2 * sqrt (f x)) * partial2 j i f x) int))) ==> m_taylor_interval (\x. sqrt (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN new_rewrite [] [] diff2_imp_diff THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN SUBGOAL_THEN `!x:real^N. x IN interval [domain] ==> &0 < f x` ASSUME_TAC THENL [ GEN_TAC THEN DISCH_TAC THEN apply_tac interval_arith_pos THEN EXISTS_TAC `f_bounds:real#real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN SUBGOAL_THEN `&0 < f (y:real^N)` ASSUME_TAC THENL [ FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_THM] THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff2c_sqrt_compose THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; new_rewrite [] [`sqrt _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff_uni_compose THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_AT_SQRT THEN ASM_REWRITE_TAC[]; new_rewrite [] [`sqrt _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN MP_TAC (ISPECL [`y:real^N`; `f:real^N->real`] partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `sqrt`) THEN ANTS_TAC THENL [ MATCH_MP_TAC REAL_DIFFERENTIABLE_AT_SQRT THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN ASM_SIMP_TAC[derivative_sqrt]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (ISPECL [`x:real^N`; `f:real^N->real`] second_partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `sqrt`) THEN ANTS_TAC THENL [ MATCH_MP_TAC diff2_sqrt THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN new_rewrite [] [`sqrt _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[second_derivative_sqrt; derivative_sqrt] THEN DISCH_THEN (fun th -> ALL_TAC) THEN REWRITE_TAC[REAL_ARITH `a pow 3 = a * a pow 2`] THEN new_rewrite [] [] SQRT_MUL_COMPAT THENL [ REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN new_rewrite [] [] POW_2_SQRT THENL [ MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN ASM_SIMP_TAC[REAL_ARITH `&4 * a * b = (&2 * a) * (&2 * b)`]);; (* atn *) let MK_M_TAYLOR_ATN' = (UNDISCH_ALL o PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> diff2c_domain domain f ==> interval_arith (atn (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (inv (&1 + f y * f y) * partial i f y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int))) ==> m_taylor_interval (\x. atn (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN new_rewrite [] [] diff2_imp_diff THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_THM] THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff2c_atn_compose THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; new_rewrite [] [`atn _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff_uni_compose THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_DIFFERENTIABLE_AT_ATN]; new_rewrite [] [`atn _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN MP_TAC (ISPECL [`y:real^N`; `f:real^N->real`] partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `atn`) THEN REWRITE_TAC[REAL_DIFFERENTIABLE_AT_ATN] THEN ASM_SIMP_TAC[derivative_atn]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (ISPECL [`x:real^N`; `f:real^N->real`] second_partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `atn`) THEN REWRITE_TAC[diff2_atn] THEN new_rewrite [] [`atn _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[nth_derivative2; second_derivative_atn; derivative_atn] THEN new_rewrite [] [`f x pow 2`] REAL_POW_2 THEN ASM_SIMP_TAC[]);; (* acs *) let iabs_lemma = GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [GSYM float1_eq] (REFL `iabs f_bounds < &1`);; let MK_M_TAYLOR_ACS' = (UNDISCH_ALL o PURE_ONCE_REWRITE_RULE[iabs_lemma] o PURE_REWRITE_RULE[float1_eq; num3_eq] o DISCH_ALL o MY_RULE_FLOAT o prove) (`m_cell_domain domain (y:real^N) w ==> (!x. x IN interval [domain] ==> interval_arith (f x) f_bounds) ==> iabs f_bounds < &1 ==> diff2c_domain domain f ==> interval_arith (acs (f y)) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (--inv (sqrt (&1 - f y * f y)) * partial i f y) int) ==> (!x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f x - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int))) ==> m_taylor_interval (\x. acs (f x)) domain y w bounds d_bounds_list dd_bounds_list`, REWRITE_TAC[m_taylor_interval; m_lin_approx; second_bounded; ETA_AX] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `lift o f differentiable at (y:real^N)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN STRIP_TAC THEN new_rewrite [] [] diff2_imp_diff THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN SUBGOAL_THEN `!x:real^N. x IN interval [domain] ==> abs (f x) < &1` ASSUME_TAC THENL [ GEN_TAC THEN DISCH_TAC THEN apply_tac interval_arith_abs THEN EXISTS_TAC `f_bounds:real#real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN SUBGOAL_THEN `abs (f (y:real^N)) < &1` ASSUME_TAC THENL [ FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC y_in_domain THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_THM] THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff2c_acs_compose THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; new_rewrite [] [`acs _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN apply_tac diff_uni_compose THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_AT_ACS THEN ASM_REWRITE_TAC[]; new_rewrite [] [`acs _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN MP_TAC (ISPECL [`y:real^N`; `f:real^N->real`] partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `acs`) THEN ANTS_TAC THENL [ MATCH_MP_TAC REAL_DIFFERENTIABLE_AT_ACS THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN ASM_SIMP_TAC[derivative_acs]; ALL_TAC ] THEN UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2c_domain_alt; diff2_domain] THEN DISCH_THEN (MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (ISPECL [`x:real^N`; `f:real^N->real`] second_partial_uni_compose') THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `acs`) THEN ANTS_TAC THENL [ MATCH_MP_TAC diff2_acs THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN new_rewrite [] [`acs _`] (GSYM o_THM) THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[second_derivative_acs; derivative_acs; REAL_MUL_LNEG; GSYM real_sub] THEN ASM_SIMP_TAC[GSYM REAL_MUL_LNEG]);; (*************************) (***************************************) (* eval_m_taylor_inv *) let inv_partial_lemma' = prove(`interval_arith (--inv (f y * f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (--inv (f y * f y) * partial i f y) int) i int`, REWRITE_TAC[]);; let inv_second_lemma' = prove(`interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f (x:real^N) - inv (f x * f x) * partial2 j i f x) int <=> (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f x - inv (f x * f x) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; let inv_second_lemma'' = (PURE_REWRITE_RULE[GSYM num1_eq] o prove) (`all_n 1 list (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f (x:real^N) - inv (f x * f x) * partial2 j i f x) int) <=> (\i list. all_n 1 list (\j int. interval_arith (((&2 * inv (f x * f x * f x)) * partial j f x) * partial i f x - inv (f x * f x) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; let eval_m_taylor_inv n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let f_bounds_tm = (rand o concl) f1_bound in (* cond *) let cond_th = check_interval_not_zero f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_inv p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) inv_partial_lemma' in let u_bounds = let neg, inv, ( * ) = float_interval_neg, float_interval_inv p_lin, float_interval_mul p_lin in neg (inv (bounds1_th * bounds1_th)) in let u_lin th1 = (* partial *) let u_th = let ( * ) = float_interval_mul p_lin in u_bounds * th1 in let int_tm = rand (concl u_th) in let i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] u_lemma0 in EQ_MP th0 u_th in let df_th = eval_all_n df1_th true u_lin in let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in (* second_lemma', second_lemma'' *) let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) inv_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) inv_second_lemma'' in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let inv, ( * ) = float_interval_inv p_second, float_interval_mul p_second in let ff = f1_bound * f1_bound in inv ff, two_interval * inv (f1_bound * ff) in let u_second2 th1 = let i_tm = (rand o rator o concl) th1 in let i_int = (Num.int_of_num o raw_dest_hash) i_tm in let di1 = List.nth d1_bounds (i_int - 1) in let th1 = MY_BETA_RULE th1 in let lemma = INST[i_tm, i_var_num] u_second_lemma0 in let u_second th1 = let j_tm = (rand o rator o rator o rator o lhand) (concl th1) in let j_int = (Num.int_of_num o raw_dest_hash) j_tm in let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) let u_th = let ( * ), ( - ) = float_interval_mul p_second, float_interval_sub p_second in (d2_th0 * dj1) * di1 - d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in EQ_MP lemma1 u_th in let dd_th0 = eval_all_n dd1 false u_second2 in let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_INV' in let eq_th = unary_beta_gen_eq f1_tm x_var inv_op_real in m_taylor_interval_norm th eq_th;; (***************************************) (* eval_m_taylor_sqrt *) let sqrt_partial_lemma' = prove(`interval_arith (inv (&2 * sqrt (f y)) * partial i f (y:real^N)) int <=> (\i int. interval_arith (inv (&2 * sqrt (f y)) * partial i f y) int) i int`, REWRITE_TAC[]);; let sqrt_second_lemma' = prove(`interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f (x:real^N) + inv (&2 * sqrt (f x)) * partial2 j i f x) int <=> (\j int. interval_arith ((--inv ((&2 * sqrt (f x))*(&2 * f x)) * partial j f x) * partial i f x + inv (&2 * sqrt (f x)) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; let sqrt_second_lemma'' = (PURE_REWRITE_RULE[GSYM num1_eq] o prove) (`all_n 1 list (\j int. interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f x + inv (&2 * sqrt (f x)) * partial2 j i f (x:real^N)) int) <=> (\i list. all_n 1 list (\j int. interval_arith ((--inv ((&2 * sqrt (f x)) * (&2 * f x)) * partial j f x) * partial i f x + inv (&2 * sqrt (f x)) * partial2 j i f (x:real^N)) int)) i list`, REWRITE_TAC[]);; let eval_m_taylor_sqrt n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let f_bounds_tm = (rand o concl) f1_bound in (* cond *) let cond_th = check_interval_pos f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_sqrt p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) sqrt_partial_lemma' in let u_bounds = let inv, ( * ) = float_interval_inv p_lin, float_interval_mul p_lin in inv (two_interval * bounds_th) in let u_lin th1 = (* partial *) let u_th = let ( * ) = float_interval_mul p_lin in u_bounds * th1 in let int_tm = rand (concl u_th) in let i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] u_lemma0 in EQ_MP th0 u_th in let df_th = eval_all_n df1_th true u_lin in let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in (* second_lemma', second_lemma'' *) let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) sqrt_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) sqrt_second_lemma'' in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let neg, sqrt, inv, ( * ) = float_interval_neg, float_interval_sqrt p_second, float_interval_inv p_second, float_interval_mul p_second in let two_sqrt_f = two_interval * sqrt f1_bound in inv two_sqrt_f, neg (inv (two_sqrt_f * (two_interval * f1_bound))) in let u_second2 th1 = let i_tm = (rand o rator o concl) th1 in let i_int = (Num.int_of_num o raw_dest_hash) i_tm in let di1 = List.nth d1_bounds (i_int - 1) in let th1 = MY_BETA_RULE th1 in let lemma = INST[i_tm, i_var_num] u_second_lemma0 in let u_second th1 = let j_tm = (rand o rator o rator o rator o lhand) (concl th1) in let j_int = (Num.int_of_num o raw_dest_hash) j_tm in let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in EQ_MP lemma1 u_th in let dd_th0 = eval_all_n dd1 false u_second2 in let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_SQRT' in let eq_th = unary_beta_gen_eq f1_tm x_var sqrt_tm in m_taylor_interval_norm th eq_th;; (***************************************) (* eval_m_taylor_atn *) let atn_partial_lemma' = prove(`interval_arith (inv (&1 + f y * f y) * partial i f (y:real^N)) int <=> (\i int. interval_arith (inv (&1 + f y * f y) * partial i f y) int) i int`, REWRITE_TAC[]);; let atn_second_lemma' = prove(`interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f (x:real^N)) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int <=> (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; let atn_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) (`all_n 1 list (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f (x:real^N)) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int) <=> (\i list. all_n 1 list (\j int. interval_arith ((((-- &2 * f x) * inv (&1 + f x * f x) pow 2) * partial j f x) * partial i f x + inv (&1 + f x * f x) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; let eval_m_taylor_atn n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_atn p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) atn_partial_lemma' in let u_bounds = let inv, ( + ), ( * ) = float_interval_inv p_lin, float_interval_add p_lin, float_interval_mul p_lin in inv (one_interval + bounds1_th * bounds1_th) in let u_lin th1 = (* partial *) let u_th = let ( * ) = float_interval_mul p_lin in u_bounds * th1 in let int_tm = rand (concl u_th) in let i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] u_lemma0 in EQ_MP th0 u_th in let df_th = eval_all_n df1_th true u_lin in let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in (* second_lemma', second_lemma'' *) let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) atn_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) atn_second_lemma'' in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let neg, inv, ( + ), ( * ), pow2 = float_interval_neg, float_interval_inv p_second, float_interval_add p_second, float_interval_mul p_second, float_interval_pow_simple p_second 2 in let inv_one_ff = inv (one_interval + f1_bound * f1_bound) in inv_one_ff, (neg_two_interval * f1_bound) * pow2 inv_one_ff in let u_second2 th1 = let i_tm = (rand o rator o concl) th1 in let i_int = (Num.int_of_num o raw_dest_hash) i_tm in let di1 = List.nth d1_bounds (i_int - 1) in let th1 = MY_BETA_RULE th1 in let lemma = INST[i_tm, i_var_num] u_second_lemma0 in let u_second th1 = let j_tm = (rand o rator o rator o rator o lhand) (concl th1) in let j_int = (Num.int_of_num o raw_dest_hash) j_tm in let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) let u_th = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in (d2_th0 * dj1) * di1 + d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in EQ_MP lemma1 u_th in let dd_th0 = eval_all_n dd1 false u_second2 in let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o INST[f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_ATN' in let eq_th = unary_beta_gen_eq f1_tm x_var atn_tm in m_taylor_interval_norm th eq_th;; (***************************************) (* eval_m_taylor_acs *) let acs_partial_lemma' = prove(`interval_arith (--inv (sqrt (&1 - f y * f y)) * partial i f (y:real^N)) int <=> (\i int. interval_arith (--inv (sqrt (&1 - f y * f y)) * partial i f y) int) i int`, REWRITE_TAC[]);; let acs_second_lemma' = prove(`interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int <=> (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int) j int`, REWRITE_TAC[]);; let acs_second_lemma'' = (PURE_REWRITE_RULE[float1_eq; float2_eq; num3_eq; num2_eq] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def] o prove) (`all_n 1 list (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int) <=> (\i list. all_n 1 list (\j int. interval_arith ((--(f x / sqrt ((&1 - f x * f x) pow 3)) * partial j f x) * partial i f (x:real^N) - inv (sqrt (&1 - f x * f x)) * partial2 j i f x) int)) i list`, REWRITE_TAC[]);; let eval_m_taylor_acs n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let f_bounds_tm = (rand o concl) f1_bound in (* cond *) let cond_th = EQT_ELIM (check_interval_iabs f_bounds_tm one_float) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_acs p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* partial_lemma' *) let u_lemma0 = (INST[f1_tm, f_var; y_tm, y_var] o INST_TYPE[n_type_array.(n), nty]) acs_partial_lemma' in let u_bounds = let inv, sqrt, neg = float_interval_inv p_lin, float_interval_sqrt p_lin, float_interval_neg in let ( * ), (-) = float_interval_mul p_lin, float_interval_sub p_lin in neg (inv (sqrt (one_interval - bounds1_th * bounds1_th))) in let u_lin th1 = (* partial *) let u_th = let ( * ) = float_interval_mul p_lin in u_bounds * th1 in let int_tm = rand (concl u_th) in let i_tm = (rand o rator o rator o lhand) (concl th1) in let th0 = INST[i_tm, i_var_num; int_tm, int_var] u_lemma0 in EQ_MP th0 u_th in let df_th = eval_all_n df1_th true u_lin in let d_bounds_list = (rand o rator o concl) df_th in let dd1 = second_bounded_components n second1_th in (* second_lemma', second_lemma'' *) let u_second_lemma0 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) acs_second_lemma' in let u_second_lemma1 = (INST[f1_tm, f_var] o INST_TYPE[n_type_array.(n), nty]) acs_second_lemma'' in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let neg, sqrt, inv = float_interval_neg, float_interval_sqrt p_second, float_interval_inv p_second in let (-), ( * ), (/) = float_interval_sub p_second, float_interval_mul p_second, float_interval_div p_second in let pow3 = float_interval_pow_simple p_second 3 in let ff_1 = one_interval - f1_bound * f1_bound in inv (sqrt ff_1), neg (f1_bound / sqrt (pow3 ff_1)) in let u_second2 th1 = let i_tm = (rand o rator o concl) th1 in let i_int = (Num.int_of_num o raw_dest_hash) i_tm in let di1 = List.nth d1_bounds (i_int - 1) in let th1 = MY_BETA_RULE th1 in let lemma = INST[i_tm, i_var_num] u_second_lemma0 in let u_second th1 = let j_tm = (rand o rator o rator o rator o lhand) (concl th1) in let j_int = (Num.int_of_num o raw_dest_hash) j_tm in let dj1 = List.nth d1_bounds (j_int - 1) in (* partial2 *) let u_th = let ( * ), ( - ) = float_interval_mul p_second, float_interval_sub p_second in (d2_th0 * dj1) * di1 - d1_th0 * th1 in let int_tm = rand (concl u_th) in let th0 = INST[j_tm, j_var_num; int_tm, int_var] lemma in EQ_MP th0 u_th in let u_th = eval_all_n th1 true u_second in let list_tm = (rand o rator o concl) u_th in let lemma1 = INST[i_tm, i_var_num; list_tm, list_var_real_pair] u_second_lemma1 in EQ_MP lemma1 u_th in let dd_th0 = eval_all_n dd1 false u_second2 in let dd_list = (rand o rator o concl) dd_th0 in let dd_th = GEN x_var (DISCH_ALL dd_th0) in let th = (MY_PROVE_HYP dd_th o MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP df_th o MY_PROVE_HYP domain_th o INST[f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var; d_bounds_list, d_bounds_list_var; dd_list, dd_bounds_list_var] o INST_TYPE[n_type_array.(n), nty]) MK_M_TAYLOR_ACS' in let eq_th = unary_beta_gen_eq f1_tm x_var acs_tm in m_taylor_interval_norm th eq_th;; end;; hol-light/Formal_ineqs/taylor/m_taylor_arith2.hl000066400000000000000000000651451303454263000223350ustar00rootroot00000000000000(* =========================================================== *) (* Formal arithmetic of taylor intervals 2 *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "taylor/m_taylor_arith.hl";; module M_taylor_arith2 = struct open Arith_misc;; open Arith_nat;; open Arith_float;; open More_float;; open Float_atn;; open Float_theory;; open M_taylor;; open M_taylor_arith;; open Misc_vars;; (**************************************) let mk_vars n name ty = map (fun i -> mk_var (name^string_of_int i, ty)) (1--n);; let all_n_components2 n all_n_th = let th0 = SYM (all_n_array.(n)) in let _, list_tm, s_tm = dest_all_n (concl all_n_th) in let list_ty = type_of list_tm in let ty = (hd o snd o dest_type) list_ty in let s_var = mk_var ("s", type_of s_tm) and a_vars = mk_vars n "a" ty in let list_tms = dest_list list_tm in let th1 = (INST ([s_tm, s_var] @ zip list_tms a_vars) o INST_TYPE[ty, aty]) th0 in CONJUNCTS (EQ_MP th1 all_n_th);; (***************************************) let gen_taylor_arith_thm arith_th final_rule n = let num1_th = (SYM o REWRITE_RULE[Arith_hash.NUM_THM] o NUMERAL_TO_NUM_CONV) `1` in let th0 = (REWRITE_RULE[num1_th] o DISCH_ALL o INST_TYPE[n_type_array.(n), nty]) arith_th in let pty = `:real#real` in let dfs = mk_vars n "df" pty in let ddfs' = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let ddfs = map (fun list -> mk_list (list, pty)) ddfs' in let d_bounds_list = mk_list (dfs, pty) in let dd_bounds_list = mk_list (ddfs, type_of (hd ddfs)) in let th1 = INST[d_bounds_list, d_bounds_list_var; dd_bounds_list, dd_bounds_list_var] th0 in let th2 = (CONV_RULE NUM_REDUCE_CONV o REWRITE_RULE[all_n]) th1 in (UNDISCH_ALL o final_rule o REWRITE_RULE[GSYM CONJ_ASSOC] o NUMERALS_TO_NUM o PURE_REWRITE_RULE[FLOAT_OF_NUM; min_exp_def]) th2;; let gen_add_thm = gen_taylor_arith_thm MK_M_TAYLOR_ADD' (CONV_RULE ALL_CONV);; let gen_sub_thm = gen_taylor_arith_thm MK_M_TAYLOR_SUB' (CONV_RULE ALL_CONV);; let gen_mul_thm = gen_taylor_arith_thm MK_M_TAYLOR_MUL' (CONV_RULE ALL_CONV);; let gen_neg_thm = gen_taylor_arith_thm MK_M_TAYLOR_NEG' (CONV_RULE ALL_CONV);; let gen_inv_thm = gen_taylor_arith_thm MK_M_TAYLOR_INV' (REWRITE_RULE[float2_eq]);; let gen_sqrt_thm = gen_taylor_arith_thm MK_M_TAYLOR_SQRT' (REWRITE_RULE[float2_eq]);; let gen_atn_thm = let pow2_th = (SYM o REWRITE_CONV[SYM num2_eq]) `x pow 2` in gen_taylor_arith_thm MK_M_TAYLOR_ATN' (REWRITE_RULE[float2_eq; float1_eq; pow2_th]);; let gen_acs_thm = let iabs_lemma = REWRITE_CONV[SYM float1_eq] `iabs f_bounds < &1` in let pow3_lemma = (SYM o REWRITE_CONV[SYM num3_eq]) `x pow 3` in gen_taylor_arith_thm MK_M_TAYLOR_ACS' (REWRITE_RULE[iabs_lemma] o REWRITE_RULE[float1_eq; pow3_lemma]);; let add_ths_array, sub_ths_array, mul_ths_array, neg_ths_array, inv_ths_array, sqrt_ths_array, atn_ths_array, acs_ths_array = let gen = fun f -> Array.init (max_dim + 1) (fun i -> if i = 0 then TRUTH else f i) in gen gen_add_thm, gen gen_sub_thm, gen gen_mul_thm, gen gen_neg_thm, gen gen_inv_thm, gen gen_sqrt_thm, gen gen_atn_thm, gen gen_acs_thm;; (*********************) (* add *) let eval_m_taylor_add2 n p_lin p_second taylor1_th taylor2_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let _, diff2_f2_th, lin2_th, second2_th = dest_m_taylor_thms n taylor2_th in let f1_tm = (rand o concl) diff2_f1_th and f2_tm = (rand o concl) diff2_f2_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and g_var = mk_var ("g", type_of f2_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th and _, bounds2_th, df2_th = m_lin_approx_components n lin2_th in let bounds_th = float_interval_add p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in let df_ths = let df1_ths = map MY_BETA_RULE (all_n_components2 n df1_th) in let df2_ths = map MY_BETA_RULE (all_n_components2 n df2_th) in map2 (float_interval_add p_lin) df1_ths df2_ths in let df_th = end_itlist CONJ df_ths in let dd_ths = let dd1' = all_n_components2 n (second_bounded_components n second1_th) in let dd2' = all_n_components2 n (second_bounded_components n second2_th) in let dd1 = map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1' in let dd2 = map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd2' in map2 (map2 (float_interval_add p_second)) dd1 dd2 in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o INST([f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) add_ths_array.(n) in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var add_op_real in m_taylor_interval_norm th eq_th;; (*********************) (* sub *) let eval_m_taylor_sub2 n p_lin p_second taylor1_th taylor2_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let _, diff2_f2_th, lin2_th, second2_th = dest_m_taylor_thms n taylor2_th in let f1_tm = (rand o concl) diff2_f1_th and f2_tm = (rand o concl) diff2_f2_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and g_var = mk_var ("g", type_of f2_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th and _, bounds2_th, df2_th = m_lin_approx_components n lin2_th in let bounds_th = float_interval_sub p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in let df_ths = let df1_ths = map MY_BETA_RULE (all_n_components2 n df1_th) in let df2_ths = map MY_BETA_RULE (all_n_components2 n df2_th) in map2 (float_interval_sub p_lin) df1_ths df2_ths in let df_th = end_itlist CONJ df_ths in let dd_ths = let dd1' = all_n_components2 n (second_bounded_components n second1_th) in let dd2' = all_n_components2 n (second_bounded_components n second2_th) in let dd1 = map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1' in let dd2 = map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd2' in map2 (map2 (float_interval_sub p_second)) dd1 dd2 in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o INST([f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) sub_ths_array.(n) in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var sub_op_real in m_taylor_interval_norm th eq_th;; (*********************) (* mul *) let eval_m_taylor_mul2 n p_lin p_second taylor1_th taylor2_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let _, diff2_f2_th, lin2_th, second2_th = dest_m_taylor_thms n taylor2_th in let f1_tm = (rand o concl) diff2_f1_th and f2_tm = (rand o concl) diff2_f2_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and g_var = mk_var ("g", type_of f2_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th and _, bounds2_th, df2_th = m_lin_approx_components n lin2_th in let bounds_th = float_interval_mul p_lin bounds1_th bounds2_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) let df_ths = let df1_ths = map MY_BETA_RULE (all_n_components2 n df1_th) in let df2_ths = map MY_BETA_RULE (all_n_components2 n df2_th) in let ( * ), ( + ) = float_interval_mul p_lin, float_interval_add p_lin in map2 (fun d1 d2 -> d1 * bounds2_th + bounds1_th * d2) df1_ths df2_ths in let df_th = end_itlist CONJ df_ths in (* second partials *) let d1_bounds = map (fun i -> undisch (eval_m_taylor_partial_bound n p_second i taylor1_th)) (1--n) in let d2_bounds = map (fun i -> undisch (eval_m_taylor_partial_bound n p_second i taylor2_th)) (1--n) in let f1_bound = undisch (eval_m_taylor_bound n p_second taylor1_th) in let f2_bound = undisch (eval_m_taylor_bound n p_second taylor2_th) in let dd_ths = let ns = 1--n in let dd1' = all_n_components2 n (second_bounded_components n second1_th) in let dd2' = all_n_components2 n (second_bounded_components n second2_th) in let dd1 = map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) ns dd1' in let dd2 = map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) ns dd2' in let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in map2 (fun (dd1_list, dd2_list) i -> let di1 = List.nth d1_bounds (i - 1) in let di2 = List.nth d2_bounds (i - 1) in map2 (fun (dd1, dd2) j -> let dj1 = List.nth d1_bounds (j - 1) in let dj2 = List.nth d2_bounds (j - 1) in (dd1 * f2_bound + di1 * dj2) + (dj1 * di2 + f1_bound * dd2)) (zip dd1_list dd2_list) (1--i)) (zip dd1 dd2) ns in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP diff2_f2_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o INST([f1_tm, f_var; f2_tm, g_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) mul_ths_array.(n) in let eq_th = binary_beta_gen_eq f1_tm f2_tm x_var mul_op_real in m_taylor_interval_norm th eq_th;; (*********************) (* neg *) let eval_m_taylor_neg2 n taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_neg bounds1_th in let bounds_tm = (rand o concl) bounds_th in let df_ths = let df1_ths = map MY_BETA_RULE (all_n_components2 n df1_th) in map (float_interval_neg) df1_ths in let df_th = end_itlist CONJ df_ths in let dd_ths = let dd1' = all_n_components2 n (second_bounded_components n second1_th) in let dd1 = map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1' in map (map float_interval_neg) dd1 in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP df_th o MY_PROVE_HYP dd_th o INST([f1_tm, f_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) neg_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var neg_op_real in m_taylor_interval_norm th eq_th;; (******************************) (* inv *) let eval_m_taylor_inv2 n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let f_bounds_tm = (rand o concl) f1_bound in (* cond *) let cond_th = check_interval_not_zero f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_inv p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) let u_bounds = let neg, inv, ( * ) = float_interval_neg, float_interval_inv p_lin, float_interval_mul p_lin in neg (inv (bounds1_th * bounds1_th)) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in let df_th = end_itlist CONJ df_ths in (* second partials *) let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let inv, ( * ) = float_interval_inv p_second, float_interval_mul p_second in let ff = f1_bound * f1_bound in inv ff, two_interval * inv (f1_bound * ff) in let dd_ths = let ( * ), ( - ) = float_interval_mul p_second, float_interval_sub p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> (d2_th0 * dj1) * di1 - d1_th0 * dd) dd_list d1_bounds) dd_ths d1_bounds in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in (***) let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) inv_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var inv_op_real in m_taylor_interval_norm th1 eq_th;; (******************************) (* sqrt *) let eval_m_taylor_sqrt2 n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let f_bounds_tm = (rand o concl) f1_bound in (* cond *) let cond_th = check_interval_pos f_bounds_tm in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_sqrt p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) let u_bounds = let inv, ( * ) = float_interval_inv p_lin, float_interval_mul p_lin in inv (two_interval * bounds_th) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in let df_th = end_itlist CONJ df_ths in (* second partials *) let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let neg, sqrt, inv, ( * ) = float_interval_neg, float_interval_sqrt p_second, float_interval_inv p_second, float_interval_mul p_second in let two_sqrt_f = two_interval * sqrt f1_bound in inv two_sqrt_f, neg (inv (two_sqrt_f * (two_interval * f1_bound))) in let dd_ths = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> (d2_th0 * dj1) * di1 + d1_th0 * dd) dd_list d1_bounds) dd_ths d1_bounds in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in (***) let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) sqrt_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var sqrt_tm in m_taylor_interval_norm th1 eq_th;; (******************************) (* atn *) let eval_m_taylor_atn2 n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let f_bounds_tm = (rand o concl) f1_bound in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_atn p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) let u_bounds = let inv, ( + ), ( * ) = float_interval_inv p_lin, float_interval_add p_lin, float_interval_mul p_lin in inv (one_interval + bounds1_th * bounds1_th) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in let df_th = end_itlist CONJ df_ths in (* second partials *) let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let neg, inv, ( + ), ( * ), pow2 = float_interval_neg, float_interval_inv p_second, float_interval_add p_second, float_interval_mul p_second, float_interval_pow_simple p_second 2 in let inv_one_ff = inv (one_interval + f1_bound * f1_bound) in inv_one_ff, (neg_two_interval * f1_bound) * pow2 inv_one_ff in let dd_ths = let ( * ), ( + ) = float_interval_mul p_second, float_interval_add p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> (d2_th0 * dj1) * di1 + d1_th0 * dd) dd_list d1_bounds) dd_ths d1_bounds in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in (***) let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) atn_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var atn_tm in m_taylor_interval_norm th1 eq_th;; (******************************) (* acs *) let eval_m_taylor_acs2 n p_lin p_second taylor1_th = let domain_th, diff2_f1_th, lin1_th, second1_th = dest_m_taylor_thms n taylor1_th in let f1_tm = (rand o concl) diff2_f1_th in let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let ty = type_of y_tm in let x_var = mk_var ("x", ty) and y_var = mk_var ("y", ty) and w_var = mk_var ("w", ty) and f_var = mk_var ("f", type_of f1_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let undisch = UNDISCH o SPEC x_var in let f1_bound0 = eval_m_taylor_bound n p_second taylor1_th in let f1_bound = undisch f1_bound0 in let f_bounds_tm = (rand o concl) f1_bound in (* cond *) let cond_th = EQT_ELIM (check_interval_iabs f_bounds_tm one_float) in let _, bounds1_th, df1_th = m_lin_approx_components n lin1_th in let bounds_th = float_interval_acs p_lin bounds1_th in let bounds_tm = (rand o concl) bounds_th in (* first partials *) let u_bounds = let inv, sqrt, neg = float_interval_inv p_lin, float_interval_sqrt p_lin, float_interval_neg in let ( * ), ( - ) = float_interval_mul p_lin, float_interval_sub p_lin in neg (inv (sqrt (one_interval - bounds1_th * bounds1_th))) in let df1_ths' = all_n_components2 n df1_th in let df1_ths = map MY_BETA_RULE df1_ths' in let df_ths = let ( * ) = float_interval_mul p_lin in map (fun th1 -> u_bounds * th1) df1_ths in let df_th = end_itlist CONJ df_ths in (* second partials *) let dd_ths = let dd1 = all_n_components2 n (second_bounded_components n second1_th) in map2 (fun i -> map MY_BETA_RULE o all_n_components2 i o MY_BETA_RULE) (1--n) dd1 in let d1_bounds = map (fun i -> let th0 = eval_m_taylor_partial_bound n p_second i taylor1_th in undisch th0) (1--n) in (* u'(f x), u''(f x) *) let d1_th0, d2_th0 = let neg, sqrt, inv = float_interval_neg, float_interval_sqrt p_second, float_interval_inv p_second in let ( - ), ( * ), ( / ), pow3 = float_interval_sub p_second, float_interval_mul p_second, float_interval_div p_second, float_interval_pow_simple p_second 3 in let ff_1 = one_interval - f1_bound * f1_bound in inv (sqrt ff_1), neg (f1_bound / sqrt (pow3 ff_1)) in let dd_ths = let ( * ), ( - ) = float_interval_mul p_second, float_interval_sub p_second in map2 (fun dd_list di1 -> my_map2 (fun dd dj1 -> (d2_th0 * dj1) * di1 - d1_th0 * dd) dd_list d1_bounds) dd_ths d1_bounds in let dd_th = (GEN x_var o DISCH_ALL o end_itlist CONJ) (List.flatten dd_ths) in (***) let df_vars = map (fun i -> df_vars_array.(i)) (1--n) in let dd_vars = map (fun i -> map (fun j -> dd_vars_array.(i).(j)) (1--i)) (1--n) in let dfs = map (rand o concl) df_ths in let dds = map (map (rand o concl)) dd_ths in let inst_list = union (zip dfs df_vars) (zip (List.flatten dds) (List.flatten dd_vars)) in let th1 = (MY_PROVE_HYP diff2_f1_th o MY_PROVE_HYP cond_th o MY_PROVE_HYP f1_bound0 o MY_PROVE_HYP bounds_th o MY_PROVE_HYP domain_th o MY_PROVE_HYP dd_th o MY_PROVE_HYP df_th o INST([f1_tm, f_var; f_bounds_tm, f_bounds_var; domain_tm, domain_var; y_tm, y_var; w_tm, w_var; bounds_tm, bounds_var] @ inst_list)) acs_ths_array.(n) in let eq_th = unary_beta_gen_eq f1_tm x_var acs_tm in m_taylor_interval_norm th1 eq_th;; end;; hol-light/Formal_ineqs/taylor/theory/000077500000000000000000000000001303454263000202105ustar00rootroot00000000000000hol-light/Formal_ineqs/taylor/theory/multivariate_taylor-compiled.hl000066400000000000000000013205131303454263000264340ustar00rootroot00000000000000needs "lib/ssrbool-compiled.hl";; needs "lib/ssrnat-compiled.hl";; needs "taylor/theory/taylor_interval-compiled.hl";; prioritize_overload `:real^N`;; prioritize_real();; let partial = new_definition `partial i f x = derivative (f o (\t. (x:real^N) + t % basis i)) (&0)`;; let all_n = define `(all_n n [] s <=> T) /\ (all_n n (CONS h t) s <=> s n h /\ all_n (SUC n) t s)`;; let m_lin_approx = new_definition `m_lin_approx (f:real^N->real) x f_bounds df_bounds_list <=> (lift o f) differentiable at x /\ interval_arith (f x) f_bounds /\ all_n 1 df_bounds_list (\i int. interval_arith (partial i f x) int)`;; (* Section Misc *) begin_section "Misc";; (* Lemma f_lift_neg *) let f_lift_neg = section_proof ["f"] `lift o (\x. --f x) = (\x. --(lift o f) x)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "LIFT_NEG")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_lift_scale *) let f_lift_scale = section_proof ["f";"c"] `lift o (\x. c * f x) = (\x. c % (lift o f) x)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "LIFT_CMUL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_lift_add *) let f_lift_add = section_proof ["f";"g"] `lift o (\x. f x + g x) = (\x. (lift o f) x + (lift o g) x)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "LIFT_ADD")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_lift_sub *) let f_lift_sub = section_proof ["f";"g"] `lift o (\x. f x - g x) = (\x. (lift o f) x - (lift o g) x)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "LIFT_SUB")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_binary_drop *) let f_binary_drop = section_proof ["op";"f";"g"] `(\t. op (f t) (g t)) o drop = (\x. op (f (drop x)) (g (drop x)))` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma f_unary_drop *) let f_unary_drop = section_proof ["op";"f"] `(\t. op (f t)) o drop = (\x. op (f (drop x)))` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Section MoreFrechet *) begin_section "MoreFrechet";; (add_section_var (mk_var ("f", (`:real^N -> real^M`))); add_section_var (mk_var ("g", (`:real^N -> real^M`))));; (add_section_var (mk_var ("x", (`:real^N`))); add_section_var (mk_var ("y", (`:real^N`))));; (* Lemma frechet_compose *) let frechet_compose = section_proof ["f";"g";"x"] `f differentiable at (g x) ==> g differentiable at x ==> frechet_derivative (f o g) (at x) = frechet_derivative f (at (g x)) o frechet_derivative g (at x)` [ ((BETA_TAC THEN (move ["df"]) THEN (move ["dg"])) THEN (((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac))); (((use_arg_then "DIFF_CHAIN_AT") (thm_tac apply_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma frechet_const *) let frechet_const = section_proof ["z"] `frechet_derivative (\x. y) (at z) = (\x. vec 0)` [ ((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac)) THEN (((use_arg_then "HAS_DERIVATIVE_CONST")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma frechet_id *) let frechet_id = section_proof [] `frechet_derivative (\x. x) (at y) = (\x. x)` [ ((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac)) THEN (((use_arg_then "HAS_DERIVATIVE_ID")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma frechet_vmul *) let frechet_vmul = section_proof ["z"] `frechet_derivative (\x. drop x % y) (at z) = (\x. drop x % y)` [ ((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac)) THEN ((use_arg_then "HAS_DERIVATIVE_VMUL_DROP") (thm_tac apply_tac))); (((use_arg_then "HAS_DERIVATIVE_ID")(thm_tac (new_rewrite [] [])))); ];; (add_section_hyp "df" (`f differentiable at x`));; (* Lemma frechet_neg *) let frechet_neg = section_proof [] `frechet_derivative (\x. --f x) (at x) = (\y. --frechet_derivative f (at x) y)` [ ((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac)) THEN ((use_arg_then "HAS_DERIVATIVE_NEG") (thm_tac apply_tac))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma frechet_scale *) let frechet_scale = section_proof ["c"] `frechet_derivative (\x. c % f x) (at x) = (\y. c % frechet_derivative f (at x) y)` [ ((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac)) THEN ((use_arg_then "HAS_DERIVATIVE_CMUL") (thm_tac apply_tac))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_hyp "dg" (`g differentiable at x`));; (* Lemma frechet_add *) let frechet_add = section_proof [] `frechet_derivative (\x. f x + g x) (at x) = (\y. frechet_derivative f (at x) y + frechet_derivative g (at x) y)` [ ((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac)) THEN ((use_arg_then "HAS_DERIVATIVE_ADD") (thm_tac apply_tac))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (repeat_tactic 1 9 (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma frechet_sub *) let frechet_sub = section_proof [] `frechet_derivative (\x. f x - g x) (at x) = (\y. frechet_derivative f (at x) y - frechet_derivative g (at x) y)` [ ((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac)) THEN ((use_arg_then "HAS_DERIVATIVE_SUB") (thm_tac apply_tac))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (repeat_tactic 1 9 (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section MoreFrechet *) let frechet_compose = finalize_theorem frechet_compose;; let frechet_const = finalize_theorem frechet_const;; let frechet_id = finalize_theorem frechet_id;; let frechet_vmul = finalize_theorem frechet_vmul;; let frechet_neg = finalize_theorem frechet_neg;; let frechet_scale = finalize_theorem frechet_scale;; let frechet_add = finalize_theorem frechet_add;; let frechet_sub = finalize_theorem frechet_sub;; end_section "MoreFrechet";; (* Lemma differentiable_compose_at *) let differentiable_compose_at = section_proof ["f";"g";"x"] `f differentiable at (g x) ==> g differentiable at x ==> (f o g) differentiable at x` [ ((BETA_TAC THEN (move ["df"]) THEN (move ["dg"])) THEN (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "frechet_compose")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN ((use_arg_then "DIFF_CHAIN_AT") (thm_tac apply_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma jacobian_compose *) let jacobian_compose = section_proof ["f";"g";"x"] `f differentiable at (g x) ==> g differentiable at x ==> jacobian (f o g) (at x) = jacobian f (at (g x)) ** jacobian g (at x)` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dg"])); (((repeat_tactic 1 9 (((use_arg_then "jacobian")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "frechet_compose")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "MATRIX_COMPOSE")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "LINEAR_FRECHET_DERIVATIVE")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma frechet_eq_jacobian *) let frechet_eq_jacobian = section_proof ["f";"x"] `f differentiable at x ==> frechet_derivative f (at x) = (\h. jacobian f (at x) ** h)` [ (BETA_TAC THEN (move ["df"])); (((((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "FRECHET_DERIVATIVE_AT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "JACOBIAN_WORKS")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Section Product *) begin_section "Product";; (* Lemma REAL_LET_MUL2 *) let REAL_LET_MUL2 = section_proof ["w";"x";"y";"z"] `&0 < w /\ w <= x /\ &0 <= y /\ y < z ==> w * y < x * z` [ (BETA_TAC THEN (move ["ineq"])); ((THENL) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`w = x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case) [(move ["w_eq_x"]); (move ["wnx"])]); (((((use_arg_then "w_eq_x")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LT_LMUL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "REAL_LT_MUL2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "wnx") (disch_tac [])) THEN (clear_assumption "wnx") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma has_derivative_x12 *) let has_derivative_x12 = section_proof ["y"] `(lift o (\x:real^2. x$1 * x$2) has_derivative lift o (\x. y$2 * x$1 + y$1 * x$2)) (at y)` [ ((((use_arg_then "has_derivative_at")(thm_tac (new_rewrite [] [])))) THEN (split_tac)); ((((use_arg_then "linear")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_ADD")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_CMUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_ADD")(thm_tac (new_rewrite [] [])))))); ((VECTOR_ARITH_TAC) THEN (done_tac)); ((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "LIFT_ADD")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_SUB")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_CMUL")(gsym_then (thm_tac (new_rewrite [] [])))))); (((((use_arg_then "LIM_AT")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "dist")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_SUB_RZERO)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_LIFT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] [])))))) THEN (move ["e"]) THEN (move ["e0"])); (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `(x:real^2)$1 * x$2 - ((y:real^2)$1 * y$2 + y$2 * (x$1 - y$1) + y$1 * (x$2 - y$2)) = (x$2 - y$2) * (x$1 - y$1)`)))(thm_tac (new_rewrite [] [])))); (((use_arg_then "e") (term_tac exists_tac)) THEN (((((use_arg_then "e0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (case THEN ((move ["norm0"]) THEN (move ["norm_e"]))))); ((repeat_tactic 1 9 (((use_arg_then "REAL_ABS_MUL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_ABS_INV")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ABS_NORM")(thm_tac (new_rewrite [] []))))); ((repeat_tactic 1 9 (((use_arg_then "VECTOR_SUB_COMPONENT")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((fun arg_tac -> arg_tac (Arg_term (`x - y:real^2`))) (term_tac (set_tac "p")))); ((fun arg_tac -> (use_arg_then "NORM_BOUND_COMPONENT_LT") (fun fst_arg -> (use_arg_then "norm_e") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN (move ["ineq"]))); ((((use_arg_then "REAL_LTE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LTE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`inv (infnorm p) * infnorm p * e`))) (term_tac exists_tac))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`&0 < infnorm p`))) (term_tac (have_gen_tac [](move ["infnorm_0"])))) (((((use_arg_then "INFNORM_POS_LT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_POS_LT")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac))); ((THENL_ROT (-1)) (split_tac)); (((((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "INFNORM_EQ_0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_POS_LT")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((((use_arg_then "REAL_LET_MUL2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_INV")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_LE_INV2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "INFNORM_LE_NORM")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "REAL_LE_MUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_ABS_POS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((fun arg_tac -> arg_tac (Arg_term (`infnorm p = abs (p$1) \/ infnorm p = abs (p$2)`))) (term_tac (have_gen_tac []ALL_TAC))); ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL INFNORM_2)))(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); (((THENL_FIRST) (case THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "REAL_LT_LMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineq")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "DIMINDEX_2")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma lambda_eq_vsum *) let lambda_eq_vsum = section_proof ["f"] `(\x:A. lambda i. f i x) = (\x. vsum (1..dimindex (:N)) (\i. f i x % (basis i:real^N)))` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["x"])); (((((use_arg_then "CART_EQ")(thm_tac (new_rewrite [] [])))) THEN (move ["i"]) THEN (move ["ineq"])) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "VSUM_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac)))); (((fun arg_tac -> arg_tac (Arg_term (`1.. _`))) (term_tac (set_tac "A"))) THEN ((fun arg_tac -> arg_tac (Arg_term (`A DIFF {i}`))) (term_tac (set_tac "B")))); ((fun arg_tac -> arg_tac (Arg_term (`DISJOINT B {i} /\ A = B UNION {i}`))) (term_tac (have_gen_tac [](move ["cond"])))); ((((use_arg_then "DISJOINT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "EXTENSION")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "B_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "A_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_DIFF")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_SING")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NOT_IN_EMPTY")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((THENL_FIRST) ((split_tac) THEN (move ["x"])) (((repeat_tactic 1 9 (((use_arg_then "negb_and")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "negbK")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orbA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "EXCLUDED_MIDDLE")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "IN_UNION")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_DIFF")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_SING")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`x = i`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN ((simp_tac) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "cond")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_UNION")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "cond")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "B_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_DIFF")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "A_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_SING")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "SUM_SING")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "BASIS_COMPONENT") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); (((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b. a = b + a * &1 <=> b = &0`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_EQ_0")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (move ["j"])); ((((((use_arg_then "IN_DIFF")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_SING")(thm_tac (new_rewrite [] []))))) THEN (move ["ineq_j"]) THEN (simp_tac)) THEN ((((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "EQ_SYM_EQ") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "ineq_j")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "REAL_MUL_RZERO")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma has_derivative_lambda *) let has_derivative_lambda = section_proof ["f";"f'";"y"] `(!i. i IN 1..dimindex (:M) ==> (lift o (f i) has_derivative lift o (f' i)) (at (y:real^N))) ==> (((\x. lambda i. f i x):real^N->real^M) has_derivative (\x. lambda i. f' i x) ) (at y)` [ ((BETA_TAC THEN (move ["df"])) THEN (repeat_tactic 1 9 (((use_arg_then "lambda_eq_vsum")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "HAS_DERIVATIVE_VSUM") (thm_tac apply_tac))); (((((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["ineq"]) THEN (simp_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!f. (\x:real^N. f i x % (basis i:real^M)) = (\x. drop ((lift o f i) x) % basis i)`))) (term_tac (have_gen_tac [](move ["eq"])))); ((BETA_TAC THEN (move ["g"])) THEN ((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((fun arg_tac -> (use_arg_then "eq") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "eq") (fun fst_arg -> (use_arg_then "f'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL HAS_DERIVATIVE_VMUL_DROP)))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma vector2_eq_lambda *) let vector2_eq_lambda = section_proof ["x";"y"] `(vector [x; y]:real^2) = (lambda i. if i = 1 then x else y)` [ ((((((use_arg_then "CART_EQ")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIMINDEX_2")(thm_tac (new_rewrite [] []))))) THEN (move ["i"])) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`)))(thm_tac (new_rewrite [] []))))); ((case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [1; 3] []))))) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_2)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (repeat_tactic 0 10 (((use_arg_then "DIMINDEX_2")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma has_derivative_vector2 *) let has_derivative_vector2 = section_proof ["f";"g";"f'";"g'";"y"] `(lift o f has_derivative lift o f') (at y) ==> (lift o g has_derivative lift o g') (at y) ==> ((\x. vector [f x; g x]:real^2) has_derivative (\x. vector [f' x; g' x]:real^2)) (at y)` [ ((BETA_TAC THEN (move ["df"]) THEN (move ["dg"])) THEN (repeat_tactic 1 9 (((use_arg_then "vector2_eq_lambda")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "has_derivative_lambda") (thm_tac apply_tac)) THEN (((((use_arg_then "DIMINDEX_2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]))); ((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`)))(thm_tac (new_rewrite [] [])))) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [2; 4] [])))) THEN (simp_tac)) THEN ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((TRY done_tac)))); (((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `~(2 = 1)`)))(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (* Lemma has_derivative_mul *) let has_derivative_mul = section_proof ["f";"g";"f'";"g'";"y"] `(lift o f has_derivative lift o f') (at y) ==> (lift o g has_derivative lift o g') (at y) ==> (lift o (\x. f x * g x) has_derivative lift o (\x. f' x * g y + f y * g' x)) (at y)` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dg"])); ((fun arg_tac -> arg_tac (Arg_term (`lift o (\x. f x * g x) = (lift o (\p. p$1 * p$2)) o (\x. vector [f x; g x]:real^2)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["x"])) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_2)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`vector [f y; g y]:real^2`))) (term_tac (set_tac "q"))); ((fun arg_tac -> arg_tac (Arg_term (`lift o (\x. f' x * g y + f y * g' x) = (lift o (\x:real^2. q$2 * x$1 + q$1 * x$2)) o (\x. vector [f' x; g' x])`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "q_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_2)))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "DIFF_CHAIN_AT") (thm_tac apply_tac)) THEN (simp_tac)) THEN ((((use_arg_then "q_def")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_x12")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_vector2")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_eq_lift_drop *) let f_eq_lift_drop = section_proof ["f"] `f = lift o (drop o f)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma differentiable_mul *) let differentiable_mul = section_proof ["f";"g";"y"] `lift o f differentiable (at y) ==> lift o g differentiable (at y) ==> lift o (\x. f x * g x) differentiable (at y)` [ ((repeat_tactic 2 0 (((use_arg_then "differentiable")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["f'"])) THEN (move ["df"]) THEN (case THEN (move ["g'"])) THEN (move ["dg"])); ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((((fun arg_tac -> (use_arg_then "f_eq_lift_drop") (fun fst_arg -> (use_arg_then "f'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "f_eq_lift_drop") (fun fst_arg -> (use_arg_then "g'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (move ["df"]) THEN (move ["dg"]))); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "has_derivative_mul") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (((use_arg_then "HAS_DERIVATIVE_IMP_DIFFERENTIABLE") (thm_tac apply_tac)) THEN (done_tac)); ];; (* Lemma frechet_mul *) let frechet_mul = section_proof ["f";"g";"y"] `lift o f differentiable at y ==> lift o g differentiable at y ==> frechet_derivative (lift o (\x. f x * g x)) (at y) = (\x. g y % frechet_derivative (lift o f) (at y) x + f y % frechet_derivative (lift o g) (at y) x)` [ (((repeat_tactic 1 9 (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "f_eq_lift_drop")(thm_tac (new_rewrite [] [(`frechet_derivative _1 _2`)]))))) THEN (move ["df"])); ((((use_arg_then "f_eq_lift_drop")(thm_tac (new_rewrite [] [(`frechet_derivative _1 _2`)])))) THEN (move ["dg"])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "has_derivative_mul") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] []))))))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] [])))))) THEN (move ["x"])); (((((use_arg_then "LIFT_ADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_CMUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section Product *) let REAL_LET_MUL2 = finalize_theorem REAL_LET_MUL2;; let has_derivative_x12 = finalize_theorem has_derivative_x12;; let lambda_eq_vsum = finalize_theorem lambda_eq_vsum;; let has_derivative_lambda = finalize_theorem has_derivative_lambda;; let vector2_eq_lambda = finalize_theorem vector2_eq_lambda;; let has_derivative_vector2 = finalize_theorem has_derivative_vector2;; let has_derivative_mul = finalize_theorem has_derivative_mul;; let f_eq_lift_drop = finalize_theorem f_eq_lift_drop;; let differentiable_mul = finalize_theorem differentiable_mul;; let frechet_mul = finalize_theorem frechet_mul;; end_section "Product";; (* Finalization of the section Misc *) let f_lift_neg = finalize_theorem f_lift_neg;; let f_lift_scale = finalize_theorem f_lift_scale;; let f_lift_add = finalize_theorem f_lift_add;; let f_lift_sub = finalize_theorem f_lift_sub;; let f_binary_drop = finalize_theorem f_binary_drop;; let f_unary_drop = finalize_theorem f_unary_drop;; let frechet_compose = finalize_theorem frechet_compose;; let frechet_const = finalize_theorem frechet_const;; let frechet_id = finalize_theorem frechet_id;; let frechet_vmul = finalize_theorem frechet_vmul;; let frechet_neg = finalize_theorem frechet_neg;; let frechet_scale = finalize_theorem frechet_scale;; let frechet_add = finalize_theorem frechet_add;; let frechet_sub = finalize_theorem frechet_sub;; let differentiable_compose_at = finalize_theorem differentiable_compose_at;; let jacobian_compose = finalize_theorem jacobian_compose;; let frechet_eq_jacobian = finalize_theorem frechet_eq_jacobian;; let REAL_LET_MUL2 = finalize_theorem REAL_LET_MUL2;; let has_derivative_x12 = finalize_theorem has_derivative_x12;; let lambda_eq_vsum = finalize_theorem lambda_eq_vsum;; let has_derivative_lambda = finalize_theorem has_derivative_lambda;; let vector2_eq_lambda = finalize_theorem vector2_eq_lambda;; let has_derivative_vector2 = finalize_theorem has_derivative_vector2;; let has_derivative_mul = finalize_theorem has_derivative_mul;; let f_eq_lift_drop = finalize_theorem f_eq_lift_drop;; let differentiable_mul = finalize_theorem differentiable_mul;; let frechet_mul = finalize_theorem frechet_mul;; end_section "Misc";; (* Section Partial *) begin_section "Partial";; (* Lemma real_derivative_compose_frechet *) let real_derivative_compose_frechet = section_proof ["f";"h";"t"] `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> ((f o h) has_real_derivative (drop o (frechet_derivative (lift o f) (at (h t)) o frechet_derivative (h o drop) (at (lift t))) o lift) (&1)) (atreal t)` [ (BETA_TAC THEN (move ["diff_f"]) THEN (move ["diff_h"])); ((((use_arg_then "diff_h") (disch_tac [])) THEN ((use_arg_then "diff_f") (disch_tac [])) THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "FRECHET_DERIVATIVE_WORKS")(thm_tac (new_rewrite [] [])))))); ((fun arg_tac -> arg_tac (Arg_term (`frechet_derivative _1 _2`))) (term_tac (set_tac "f'"))); ((fun arg_tac -> arg_tac (Arg_term (`frechet_derivative _1 _2`))) (term_tac (set_tac "h'"))); (BETA_TAC THEN (move ["df"]) THEN (move ["dh"])); (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL HAS_REAL_FRECHET_DERIVATIVE_AT)))(thm_tac (new_rewrite [] [])))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`lift o (f o h) o drop = (lift o f) o (h o drop)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) ((repeat_tactic 1 9 (((use_arg_then "o_ASSOC")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`(\x. (drop o (f' o h') o lift) (&1) % x) = f' o h'`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))); (((((use_arg_then "DIFF_CHAIN_AT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dh")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN (move ["x"]) THEN (simp_tac)); ((fun arg_tac -> arg_tac (Arg_term (`linear f' /\ linear h'`))) (term_tac (have_gen_tac [](move ["lin"])))); (((((use_arg_then "h'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "f'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LINEAR_FRECHET_DERIVATIVE")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`x = drop x % lift (&1)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [2] []))))))); (((((use_arg_then "DROP_EQ")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "DROP_CMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "LINEAR_CMUL")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "DROP_EQ")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "DROP_CMUL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma real_derivative_compose_jacobian *) let real_derivative_compose_jacobian = section_proof ["f";"h";"t"] `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> ((f o h) has_real_derivative (jacobian (lift o f) (at (h t)) ** jacobian (h o drop) (at (lift t)))$1$1) (atreal t)` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dh"])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "real_derivative_compose_frechet") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dh") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((repeat_tactic 1 9 (((use_arg_then "frechet_eq_jacobian")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)); ((((use_arg_then "MATRIX_VECTOR_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "matrix_vector_mul")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DROP_LAMBDA")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIMINDEX_1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_SING_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); (((((use_arg_then "LIFT_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff_imp_real_diff *) let diff_imp_real_diff = section_proof ["f";"h";"t"] `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> (f o h) real_differentiable atreal t` [ (BETA_TAC THEN (move ["diff_f"]) THEN (move ["diff_h"])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "real_derivative_compose_frechet") (fun fst_arg -> (use_arg_then "diff_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "diff_h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((fun arg_tac -> arg_tac (Arg_term (`(drop o _ o lift) (&1)`))) (term_tac (set_tac "fh'"))); (((((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] [])))) THEN (move ["dfh"])) THEN ((use_arg_then "fh'") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma diff_direction *) let diff_direction = section_proof ["y";"e";"net"] `((\t. y + t % e) o drop) differentiable net` [ ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`(\t. y + t % e) o drop = (\x. y + drop x % e)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((use_arg_then "HAS_DERIVATIVE_IMP_DIFFERENTIABLE") (thm_tac apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`\x. drop x % e`))) (term_tac exists_tac)) THEN ((use_arg_then "HAS_DERIVATIVE_VMUL_DROP") (thm_tac apply_tac)) THEN (((use_arg_then "HAS_DERIVATIVE_ID")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma frechet_direction *) let frechet_direction = section_proof ["y";"e";"t"] `frechet_derivative ((\t. y + t % e) o drop) (at (lift t)) = (\x. drop x % e)` [ ((((use_arg_then "f_unary_drop")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "frechet_add")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "HAS_DERIVATIVE_IMP_DIFFERENTIABLE") (thm_tac apply_tac))); (((fun arg_tac -> arg_tac (Arg_term (`\x. drop x % e`))) (term_tac exists_tac)) THEN ((use_arg_then "HAS_DERIVATIVE_VMUL_DROP") (thm_tac apply_tac)) THEN (((use_arg_then "HAS_DERIVATIVE_ID")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "frechet_vmul")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "frechet_const")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_ADD_LID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma real_dir_derivative_frechet *) let real_dir_derivative_frechet = section_proof ["f";"y";"e";"t"] `(lift o f) differentiable at (y + t % e) ==> ((f o (\t. y + t % e)) has_real_derivative (drop (frechet_derivative (lift o f) (at (y + t % e)) e))) (atreal t)` [ (BETA_TAC THEN (move ["df"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_derivative_compose_frechet") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`\t. y + t % e`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "t") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); (((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff_direction")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "frechet_direction")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma real_dir_derivative_jacobian *) let real_dir_derivative_jacobian = section_proof ["f";"y";"e";"t"] `(lift o f) differentiable at (y + t % e) ==> ((f o (\t. y + t % e)) has_real_derivative drop (jacobian (lift o f) (at (y + t % e)) ** e)) (atreal t)` [ (BETA_TAC THEN (move ["df"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_dir_derivative_frechet") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "e") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((((use_arg_then "frechet_eq_jacobian")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma partial_eq_frechet *) let partial_eq_frechet = section_proof ["f";"y";"i"] `(lift o f) differentiable at (y:real^N) ==> partial i f y = drop (frechet_derivative (lift o f) (at y) (basis i))` [ ((BETA_TAC THEN (move ["df"])) THEN (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_dir_derivative_frechet") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`basis i:real^N`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "derivative_unique") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (done_tac)); ];; (* Lemma partial_eq_jacobian *) let partial_eq_jacobian = section_proof ["f";"y";"i"] `(lift o f) differentiable at y ==> partial i f y = drop (jacobian (lift o f) (at y) ** basis i)` [ (BETA_TAC THEN (move ["df"])); ((((use_arg_then "df") (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "JACOBIAN_WORKS")(thm_tac (new_rewrite [] []))))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma partial_eq_jacobian_column *) let partial_eq_jacobian_column = section_proof ["f";"y";"i"] `(lift o (f:real^N->real)) differentiable at y ==> i IN 1..dimindex (:N) ==> partial i f y = drop (column i (jacobian (lift o f) (at y)))` [ ((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["df"]) THEN (move ["ineq"])); (((((use_arg_then "partial_eq_jacobian")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "MATRIX_VECTOR_MUL_BASIS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial_eq_jacobian_entry *) let partial_eq_jacobian_entry = section_proof ["f";"y";"i"] `(lift o (f:real^N->real)) differentiable at y ==> i IN 1..dimindex (:N) ==> partial i f y = (jacobian (lift o f) (at y))$1$i` [ ((BETA_TAC THEN (move ["df"]) THEN (move ["ineq"])) THEN ((((use_arg_then "partial_eq_jacobian_column")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "column")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DROP_LAMBDA")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_var (mk_var ("y", (`:real^N`))));; (add_section_var (mk_var ("i", (`:num`))));; (* Lemma partial_eq0 *) let partial_eq0 = section_proof ["f"] `~(i IN 1..dimindex (:N)) ==> partial i f y = &0` [ ((BETA_TAC THEN (move ["ineq"])) THEN (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`basis i = (vec 0):real^N`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) ((((use_arg_then "BASIS_EQ_0")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((((use_arg_then "VECTOR_MUL_RZERO")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "VECTOR_ADD_RID")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); ((fun arg_tac -> arg_tac (Arg_term (`derivative (f o (\t. y)) = derivative (\t. f y)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((AP_TERM_TAC) THEN ((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma derivative_compose *) let derivative_compose = section_proof ["f";"g";"x"] `f real_differentiable atreal (g x) ==> g real_differentiable atreal x ==> derivative (f o g) x = derivative f (g x) * derivative g x` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dg"])); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`f o g = \x. f (g x)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma projection_has_derivative *) let projection_has_derivative = section_proof ["i";"net"] `i IN 1..dimindex (:N) ==> (lift o (\x:real^N. x$i) has_derivative lift o (\x. x$i)) net` [ ((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["ineq"])); ((fun arg_tac -> arg_tac (Arg_term (`lift o (\x:real^N. x$i) = (\x. x$i % vec 1)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (move ["x"])) THEN ((((use_arg_then "DROP_EQ")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DROP_CMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DROP_VEC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL HAS_DERIVATIVE_VMUL_COMPONENT)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "HAS_DERIVATIVE_ID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma projection_diff *) let projection_diff = section_proof ["i";"net"] `i IN 1..dimindex (:N) ==> (lift o (\x:real^N. x$i)) differentiable net` [ ((((use_arg_then "differentiable")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "projection_has_derivative") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "net") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); (((fun arg_tac -> arg_tac (Arg_term (`lift o \x:real^N. x$i`))) (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma frechet_projection *) let frechet_projection = section_proof ["i";"x"] `i IN 1..dimindex (:N) ==> frechet_derivative (lift o (\x:real^N. x$i)) (at x) = lift o (\x:real^N. x$i)` [ ((BETA_TAC THEN (move ["ineq"])) THEN (((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "FRECHET_DERIVATIVE_AT") (thm_tac apply_tac))); ((((use_arg_then "projection_has_derivative")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma has_derivative_vector_frechet *) let has_derivative_vector_frechet = section_proof ["h";"t";"i"] `i IN 1..dimindex (:N) ==> (h o drop) differentiable at (lift t) ==> ((\s. (h:real->real^N) s$i) has_real_derivative (frechet_derivative (h o drop) (at (lift t)) (lift (&1)))$i) (atreal t)` [ (BETA_TAC THEN (move ["ineq"]) THEN (move ["dh"])); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`(\s. h s$i) = (\x. x$i) o h`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_derivative_compose_frechet") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`\x:real^N. x$i`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "t") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((((use_arg_then "dh")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "projection_diff")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`(drop o _ o lift) (&1)`))) (term_tac (set_tac "lhs"))); ((fun arg_tac -> arg_tac (Arg_term (`(frechet_derivative _1 _2 _3)$i`))) (term_tac (set_tac "rhs"))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`lhs = rhs`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) ((done_tac) THEN (done_tac))); (((((use_arg_then "lhs_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "frechet_projection")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "rhs_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma has_derivative_vector_jacobian *) let has_derivative_vector_jacobian = section_proof ["h";"t";"i"] `i IN 1..dimindex (:N) ==> (h o drop) differentiable at (lift t) ==> ((\s. (h:real->real^N) s$i) has_real_derivative (jacobian (h o drop) (at (lift t)))$i$1) (atreal t)` [ (BETA_TAC THEN (move ["ineq"]) THEN (move ["dh"])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "has_derivative_vector_frechet") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dh") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((fun arg_tac -> arg_tac (Arg_term (`(frechet_derivative _1 _2 _3)$i`))) (term_tac (set_tac "lhs"))); ((fun arg_tac -> arg_tac (Arg_term (`jacobian _1 _2$i$1`))) (term_tac (set_tac "rhs"))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`lhs = rhs`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) ((done_tac) THEN (done_tac))); ((((use_arg_then "lhs_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "frechet_eq_jacobian")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`lift (&1) = basis 1`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "DROP_EQ")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "basis")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DROP_LAMBDA")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "MATRIX_VECTOR_MUL_BASIS")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "DIMINDEX_GE_1")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "column")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_NUMSEG")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ];; (* Lemma derivative_vector_jacobian *) let derivative_vector_jacobian = section_proof ["h";"t";"i"] `i IN 1..dimindex (:N) ==> ((h:real->real^N) o drop) differentiable at (lift t) ==> derivative (\s. h s$i) t = jacobian (h o drop) (at (lift t))$i$1` [ ((BETA_TAC THEN (move ["ineq"]) THEN (move ["dh"])) THEN ((use_arg_then "derivative_unique") (thm_tac apply_tac)) THEN (((use_arg_then "has_derivative_vector_jacobian")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma real_derivative_compose_partial *) let real_derivative_compose_partial = section_proof ["f";"h";"t"] `(lift o (f:real^N -> real)) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> ((f o h) has_real_derivative sum (1..dimindex (:N)) (\i. partial i f (h t) * derivative (\s. h s$i) t)) (atreal t)` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dh"])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "real_derivative_compose_jacobian") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dh") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); (((fun arg_tac -> arg_tac (Arg_term (`_$1$1`))) (term_tac (set_tac "lhs"))) THEN ((fun arg_tac -> arg_tac (Arg_term (`sum _ _2`))) (term_tac (set_tac "rhs")))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`lhs = rhs`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) ((done_tac) THEN (done_tac))); (((use_arg_then "lhs_def")(gsym_then (thm_tac (new_rewrite [] []))))); ((((use_arg_then "matrix_mul")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "DIMINDEX_GE_1")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac))); ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "DIMINDEX_GE_1")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac)) THEN (((use_arg_then "rhs_def")(gsym_then (thm_tac (new_rewrite [] [])))))); (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["i"]) THEN (move ["ineq"]) THEN (simp_tac)); (((((use_arg_then "partial_eq_jacobian_entry")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_EQ_MUL_LCANCEL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_vector_jacobian")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma real_dir_derivative_partial *) let real_dir_derivative_partial = section_proof ["f";"e";"t"] `(lift o f) differentiable at (y + t % e) ==> ((f o (\t. y + t % e)) has_real_derivative sum (1..dimindex (:N)) (\i. e$i * (partial i f o (\t. y + t % e)) t)) (atreal t)` [ (BETA_TAC THEN (move ["df"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_dir_derivative_jacobian") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "e") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((((use_arg_then "matrix_vector_mul")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DROP_LAMBDA")(thm_tac (new_rewrite [] []))))); (((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "lhs"))) THEN ((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "rhs")))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`lhs = rhs`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) ((done_tac) THEN (done_tac))); (((((use_arg_then "lhs_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "rhs_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["i"]) THEN (move ["ineq"]) THEN (simp_tac))); (((((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "partial_eq_jacobian_entry")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac)) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_var (mk_var ("f", (`:real^N -> real`))); add_section_var (mk_var ("g", (`:real^N -> real`))));; (add_section_hyp "df" (`(lift o f) differentiable at y`));; (* Lemma partial_uni_compose *) let partial_uni_compose = section_proof ["u"] `u real_differentiable atreal (f y) ==> partial i (u o f) y = derivative u (f y) * partial i f y` [ ((BETA_TAC THEN (move ["du"])) THEN ((repeat_tactic 1 9 (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_ASSOC")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "derivative_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac))); (((((use_arg_then "diff_imp_real_diff")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff_direction")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial_neg *) let partial_neg = section_proof [] `partial i (\x. --f x) y = --partial i f y` [ (((repeat_tactic 1 9 (((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "f_lift_neg")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_NEG")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 0 10 (((use_arg_then "frechet_neg")(thm_tac (new_rewrite [] [])))))) THEN ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((TRY done_tac)) THEN (((use_arg_then "DROP_NEG")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ];; (* Lemma partial_scale *) let partial_scale = section_proof ["c"] `partial i (\x. c * f x) y = c * partial i f y` [ (((repeat_tactic 1 9 (((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "f_lift_scale")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_CMUL")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 0 10 (((use_arg_then "frechet_scale")(thm_tac (new_rewrite [] [])))))) THEN ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((TRY done_tac)))); ((((use_arg_then "DROP_CMUL")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (add_section_hyp "dg" (`(lift o g) differentiable at y`));; (* Lemma partial_add *) let partial_add = section_proof [] `partial i (\x. f x + g x) y = partial i f y + partial i g y` [ (((repeat_tactic 1 9 (((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "f_lift_add")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 0 10 (((use_arg_then "frechet_add")(thm_tac (new_rewrite [] [])))))) THEN ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((TRY done_tac)))); ((((use_arg_then "DROP_ADD")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma partial_sub *) let partial_sub = section_proof [] `partial i (\x. f x - g x) y = partial i f y - partial i g y` [ (((repeat_tactic 1 9 (((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "f_lift_sub")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_SUB")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 0 10 (((use_arg_then "frechet_sub")(thm_tac (new_rewrite [] [])))))) THEN ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((TRY done_tac)))); ((((use_arg_then "DROP_SUB")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma partial_mul *) let partial_mul = section_proof [] `partial i (\x. f x * g x) y = partial i f y * g y + f y * partial i g y` [ ((repeat_tactic 1 9 (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))) THEN ((fun arg_tac -> arg_tac (Arg_term (`\t. y + t % basis i`))) (term_tac (set_tac "h")))); ((fun arg_tac -> arg_tac (Arg_term (`(\x. f x * g x) o h = (\t. (f o h) t * (g o h) t)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((THENL_ROT (-1)) (((use_arg_then "derivative_mul")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "h_def")(gsym_then (thm_tac (new_rewrite [1; 4] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [])))))); ((((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`h (&0) = y`))) (term_tac (have_gen_tac [](move ["h0"])))) (((((use_arg_then "h_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`(h o drop) differentiable at (lift (&0))`))) (term_tac (have_gen_tac [](move ["dh"])))) (((((use_arg_then "h_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "diff_direction")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 1 9 (((use_arg_then "diff_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "h0")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section Partial *) let real_derivative_compose_frechet = finalize_theorem real_derivative_compose_frechet;; let real_derivative_compose_jacobian = finalize_theorem real_derivative_compose_jacobian;; let diff_imp_real_diff = finalize_theorem diff_imp_real_diff;; let diff_direction = finalize_theorem diff_direction;; let frechet_direction = finalize_theorem frechet_direction;; let real_dir_derivative_frechet = finalize_theorem real_dir_derivative_frechet;; let real_dir_derivative_jacobian = finalize_theorem real_dir_derivative_jacobian;; let partial_eq_frechet = finalize_theorem partial_eq_frechet;; let partial_eq_jacobian = finalize_theorem partial_eq_jacobian;; let partial_eq_jacobian_column = finalize_theorem partial_eq_jacobian_column;; let partial_eq_jacobian_entry = finalize_theorem partial_eq_jacobian_entry;; let partial_eq0 = finalize_theorem partial_eq0;; let derivative_compose = finalize_theorem derivative_compose;; let projection_has_derivative = finalize_theorem projection_has_derivative;; let projection_diff = finalize_theorem projection_diff;; let frechet_projection = finalize_theorem frechet_projection;; let has_derivative_vector_frechet = finalize_theorem has_derivative_vector_frechet;; let has_derivative_vector_jacobian = finalize_theorem has_derivative_vector_jacobian;; let derivative_vector_jacobian = finalize_theorem derivative_vector_jacobian;; let real_derivative_compose_partial = finalize_theorem real_derivative_compose_partial;; let real_dir_derivative_partial = finalize_theorem real_dir_derivative_partial;; let partial_uni_compose = finalize_theorem partial_uni_compose;; let partial_neg = finalize_theorem partial_neg;; let partial_scale = finalize_theorem partial_scale;; let partial_add = finalize_theorem partial_add;; let partial_sub = finalize_theorem partial_sub;; let partial_mul = finalize_theorem partial_mul;; end_section "Partial";; (* Section PartialMonotone *) begin_section "PartialMonotone";; (* Lemma derivative_translation *) let derivative_translation = section_proof ["f";"x"] `f real_differentiable atreal x ==> derivative f x = derivative (f o (\t. x + t)) (&0)` [ (BETA_TAC THEN (move ["diff_f"])); ((((use_arg_then "derivative_compose")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_ADD_RID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_f")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "REAL_DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((((use_arg_then "derivative_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_x")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (arith_tac) THEN (done_tac)); ];; (add_section_type (mk_var ("f", (`:real^N->real`))));; (* Lemma partial_increasing_left *) let partial_increasing_left = section_proof ["f";"j";"u";"x";"z";"lo"] `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> (!y. y IN interval [x,z] ==> &0 <= partial j f y) ==> (!y. y IN interval [x,u] ==> lo <= f y) ==> (!y. y IN interval [x,z] ==> lo <= f y)` [ (((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] [])))))) THEN (move ["uz_eq"]) THEN (move ["ux_eq"]) THEN (move ["diff_f"]) THEN (move ["partial_pos"]) THEN (move ["f_bound"]) THEN (move ["y"]) THEN (move ["y_in"])); ((((use_arg_then "partial_pos") (disch_tac [])) THEN (clear_assumption "partial_pos") THEN ((use_arg_then "diff_f") (disch_tac [])) THEN (clear_assumption "diff_f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["diff_f"]) THEN (move ["partial_pos"]))); ((fun arg_tac -> arg_tac (Arg_term (`(lambda i. if i = j then x$j else y$i):real^N`))) (term_tac (set_tac "y'"))); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`f y' <= f y`))) (term_tac (have_gen_tac []ALL_TAC)))); ((((fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "f_bound") (disch_tac [])) THEN (clear_assumption "f_bound") THEN (DISCH_THEN apply_tac) THEN (move ["i"]) THEN (move ["i_in"]))); ((((use_arg_then "y'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((THENL_FIRST) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`i = j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["ij"])) (((((use_arg_then "ux_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "uz_eq")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "y_in")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`j IN 1..dimindex (:N)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case)) THEN ((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["j_in"]))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`y' = y`))) (term_tac (have_gen_tac []ALL_TAC)))) ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((((use_arg_then "CART_EQ")(thm_tac (new_rewrite [] [])))) THEN (move ["i"]) THEN (move ["i_in"])); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`~(i = j)`))) (term_tac (have_gen_tac [](move ["inj"])))) ((((use_arg_then "i_in") (disch_tac [])) THEN (clear_assumption "i_in") THEN ((use_arg_then "j_in") (disch_tac [])) THEN (clear_assumption "j_in") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (((((use_arg_then "y'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`f o (\t. y' + t % basis j)`))) (term_tac (set_tac "g"))); ((fun arg_tac -> arg_tac (Arg_term (`f y' = g (&0)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`f y = g (y$j - x$j)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (AP_TERM_TAC)); ((((use_arg_then "CART_EQ")(thm_tac (new_rewrite [] [])))) THEN (move ["i"]) THEN (move ["i_in"])); ((((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`i = j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["ij"])) THEN ((((use_arg_then "y'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); ((arith_tac) THEN (done_tac)); (((simp_tac) THEN (((use_arg_then "ij")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`real_interval [&0, y$j - x$j]`))) (term_tac (set_tac "s"))); ((fun arg_tac -> arg_tac (Arg_term (`!t. t IN s ==> y' + t % basis j IN interval [x,z]`))) (term_tac (have_gen_tac [](move ["in_s"])))); (((((use_arg_then "s_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] []))))) THEN (move ["t"]) THEN (move ["t_ineq"]) THEN (move ["i"]) THEN (move ["i_ineq"])); ((repeat_tactic 1 9 (((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "y'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`i = j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["ij"]))); (((((use_arg_then "REAL_MUL_RZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "y_in")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN ((fun arg_tac -> (use_arg_then "y_in") (fun fst_arg -> (use_arg_then "i_ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((use_arg_then "ij")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!t. t IN s ==> (g has_real_derivative (partial j f (y' + t % basis j))) (atreal t within s)`))) (term_tac (have_gen_tac [](move ["ds"])))); ((BETA_TAC THEN (move ["t"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "in_s") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["p_in"])) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_ATREAL_WITHIN") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))); ((fun arg_tac -> arg_tac (Arg_term (`f o _`))) (term_tac (set_tac "h"))); ((fun arg_tac -> arg_tac (Arg_term (`h = g o (\t'. t + t')`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "h_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["r"])) THEN ((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac))); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "derivative_translation")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "diff_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "diff_f")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac)) THEN (((use_arg_then "diff_direction")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`&0 <= y$j - x$j`))) (term_tac (have_gen_tac [](move ["pos"])))) ((((fun arg_tac -> (use_arg_then "y_in") (fun fst_arg -> (use_arg_then "j_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "HAS_REAL_DERIVATIVE_INCREASING_IMP") (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`\t. partial j f (y' + t % basis j)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`y$j - x$j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (((((use_arg_then "s_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (((use_arg_then "IS_REALINTERVAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((((use_arg_then "ds")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (simp_tac)) THEN (DISCH_THEN apply_tac)); ((((use_arg_then "s_def")(gsym_then (thm_tac (new_rewrite [2; 3] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "pos")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)); ((BETA_TAC THEN (move ["t"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "in_s") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "partial_pos") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (done_tac)); ];; (* Lemma partial_decreasing_left *) let partial_decreasing_left = section_proof ["f";"j";"u";"x";"z";"hi"] `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> (!y. y IN interval [x,z] ==> partial j f y <= &0) ==> (!y. y IN interval [x,u] ==> f y <= hi) ==> (!y. y IN interval [x,z] ==> f y <= hi)` [ (BETA_TAC THEN (move ["u_eq_i"]) THEN (move ["u_eq_j"]) THEN (move ["diff_f"]) THEN (move ["partial_f"]) THEN (move ["f_bound"]) THEN (move ["y"]) THEN (move ["y_in"])); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "partial_increasing_left") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`(\p. -- f p)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "u") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "z") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`--hi`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "u_eq_i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "u_eq_j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); ((THENL_FIRST) (ANTS_TAC) ((BETA_TAC THEN (move ["p"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "diff_f") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "DIFFERENTIABLE_NEG") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (((use_arg_then "f_lift_neg")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (ANTS_TAC); ((BETA_TAC THEN (move ["p"]) THEN (move ["p_in"])) THEN ((((use_arg_then "partial_neg")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_f")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_NEG_GE0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "partial_f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) (ANTS_TAC) ((BETA_TAC THEN (move ["p"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "f_bound") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (arith_tac) THEN (done_tac))); ((((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "y_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma partial_translation *) let partial_translation = section_proof ["f";"i";"p";"y"] `lift o f differentiable at (p + y) ==> partial i (f o (\x. p + x)) y = partial i f (p + y)` [ (BETA_TAC THEN (move ["diff"])); ((fun arg_tac -> arg_tac (Arg_term (`!net. (\x. p + x) differentiable net`))) (term_tac (have_gen_tac [](move ["diff_p"])))); ((BETA_TAC THEN (move ["net"])) THEN ((((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 1 (((use_arg_then "o_ASSOC")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_CHAIN_AT")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "frechet_compose")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "frechet_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "frechet_const")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "frechet_id")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_ADD_LID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "I_DEF")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "I_O_ID")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma partial_rev_translation *) let partial_rev_translation = section_proof ["f";"i";"p";"y"] `lift o f differentiable at (p - y) ==> partial i (f o (\x. p - x)) y = --partial i f (p - y)` [ (BETA_TAC THEN (move ["diff"])); ((fun arg_tac -> arg_tac (Arg_term (`!net. (\x. p - x) differentiable net`))) (term_tac (have_gen_tac [](move ["diff_p"])))); ((BETA_TAC THEN (move ["net"])) THEN ((((use_arg_then "DIFFERENTIABLE_SUB")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 1 (((use_arg_then "o_ASSOC")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_CHAIN_AT")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "frechet_compose")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "frechet_sub")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "frechet_const")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "frechet_id")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_SUB_LZERO)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "partial_eq_frechet")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)); (((((use_arg_then "LINEAR_NEG")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "LINEAR_FRECHET_DERIVATIVE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "DROP_NEG")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial_increasing_right *) let partial_increasing_right = section_proof ["f";"j";"u";"x";"z";"hi"] `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i) ==> u$j = z$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> (!y. y IN interval [x,z] ==> &0 <= partial j f y) ==> (!y. y IN interval [u,z] ==> f y <= hi) ==> (!y. y IN interval [x,z] ==> f y <= hi)` [ (BETA_TAC THEN (move ["u_eq_i"]) THEN (move ["u_eq_j"]) THEN (move ["diff_f"]) THEN (move ["partial_f"]) THEN (move ["f_bound"]) THEN (move ["y"]) THEN (move ["y_in"])); (((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`j IN 1..dimindex (:N)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case)) THEN ((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["j_in"]))); ((((use_arg_then "f_bound") (disch_tac [])) THEN (clear_assumption "f_bound") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "y_in") (disch_tac [])) THEN (clear_assumption "y_in") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] []))))) THEN (move ["y_ineq"]) THEN (move ["i"]) THEN (move ["i_in"]))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`~(i = j)`))) (term_tac (have_gen_tac [](move ["inj"])))) ((((use_arg_then "i_in") (disch_tac [])) THEN (clear_assumption "i_in") THEN ((use_arg_then "j_in") (disch_tac [])) THEN (clear_assumption "j_in") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (((((use_arg_then "u_eq_i")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "y_ineq")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "partial_decreasing_left") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f o (\p:real^N. x + (z - p))`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`x + (z - u):real^N`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "z") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "hi") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); ((BETA_TAC THEN (move ["i"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "u_eq_i") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["eq1"]) THEN (move ["inj"])) THEN ((((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "eq1")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (arith_tac) THEN (done_tac)); ((THENL_FIRST) (ANTS_TAC) (((((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "u_eq_j")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`!p. p IN interval [x,z] ==> x + (z - p) IN interval [x,z]`))) (term_tac (have_gen_tac [](move ["Hp"])))); ((BETA_TAC THEN (move ["p"])) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] []))))) THEN (move ["p_in"]) THEN (move ["i"]) THEN (move ["ineq"]))); ((((fun arg_tac -> (use_arg_then "p_in") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!y. _ y`))) (term_tac (set_tac "dP"))); ((fun arg_tac -> arg_tac (Arg_term (`dP`))) (term_tac (have_gen_tac [](move ["P"])))); ((((use_arg_then "dP_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (BETA_TAC THEN (move ["p"]) THEN (move ["p_in"]))); (((((use_arg_then "o_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CHAIN_AT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_SUB")(thm_tac (new_rewrite [] [])))))) THEN ((repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "diff_f")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac)) THEN (((use_arg_then "Hp")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "P") (disch_tac [])) THEN (clear_assumption "P") THEN BETA_TAC THEN (simp_tac)) THEN ((((use_arg_then "dP_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["diff"]))); (ANTS_TAC); (BETA_TAC THEN (move ["p"]) THEN (move ["p_in"])); ((fun arg_tac -> arg_tac (Arg_theorem (VECTOR_ARITH `!x z p. x + z - p = (x + z) - p:real^N`))) (fun arg -> thm_tac MP_TAC arg THEN (move ["assoc"]))); ((((use_arg_then "assoc")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "partial_rev_translation")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "assoc")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "Hp")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "REAL_NEG_LE0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "partial_f")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "Hp")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (ANTS_TAC); ((BETA_TAC THEN (move ["p"]) THEN (move ["p_in"])) THEN ((((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "f_bound")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "p_in") (disch_tac [])) THEN (clear_assumption "p_in") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] []))))) THEN (move ["ineq"]) THEN (move ["i"]) THEN (move ["i_ineq"]))); ((((fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "i_ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ((((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`x + z - y:real^N`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC) THEN ((((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac))); ((((fun arg_tac -> arg_tac (Arg_theorem (VECTOR_ARITH `!x z y:real^N. x + z - (x + z - y) = y`)))(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN apply_tac)); ((((use_arg_then "Hp")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Finalization of the section PartialMonotone *) let derivative_translation = finalize_theorem derivative_translation;; let partial_increasing_left = finalize_theorem partial_increasing_left;; let partial_decreasing_left = finalize_theorem partial_decreasing_left;; let partial_translation = finalize_theorem partial_translation;; let partial_rev_translation = finalize_theorem partial_rev_translation;; let partial_increasing_right = finalize_theorem partial_increasing_right;; end_section "PartialMonotone";; (* Section Taylor *) begin_section "Taylor";; (* Lemma real_taylor2_bound *) let real_taylor2_bound = section_proof ["f";"dd_bound"] `nth_diff_strong_int 2 (&0, &1) f ==> (!t. interval_arith t (&0, &1) ==> abs (nth_derivative 2 f t) <= dd_bound) ==> abs (f (&1) - (f (&0) + derivative f (&0))) <= dd_bound / &2` [ (((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_diff_strong2_eq_alt")(thm_tac (new_rewrite [] []))))) THEN (move ["df"]) THEN (move ["dd"])); ((fun arg_tac -> arg_tac (Arg_term (`\i. if i = 0 then f else if i = 1 then derivative f else nth_derivative 2 f`))) (term_tac (set_tac "R"))); ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 0)`))) (fun arg -> thm_tac MP_TAC arg THEN (move ["arithH"]))); ((((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_TAYLOR") (fun fst_arg -> (use_arg_then "R") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`real_interval [&0, &1]`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dd_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (ANTS_TAC)); (((((use_arg_then "IS_REALINTERVAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((BETA_TAC THEN (move ["i"]) THEN (move ["x"])) THEN ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `i <= 1 <=> i = 0 \/ i = 1`)))(thm_tac (new_rewrite [] [])))))); (BETA_TAC THEN (case THEN ALL_TAC) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (case THEN (move ["s"])) THEN (move ["d_f"])); ((case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "R_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "arithH")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN") (thm_tac apply_tac)) THEN (((use_arg_then "d_f")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((BETA_TAC THEN (move ["x"])) THEN (((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "arithH")(thm_tac (new_rewrite [] []))))) THEN (move ["ineq"]))); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (move ["d_f"])) THEN ((((use_arg_then "R_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "arithH")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "dd")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((fun arg_tac -> (fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_01")(thm_tac (new_rewrite [] [])))) THEN (simp_tac))); ((((use_arg_then "REAL_SUB_RZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ABS_1")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_POW_ONE")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `FACT (1 + 1) = 2`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "ONE")(thm_tac (new_rewrite [2] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL SUM_CLAUSES_NUMSEG)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_SING_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 <= 1`)))(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `FACT 0 = 1 /\ FACT 1 = 1`)))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_INV_1")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "R_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "arithH")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma real_taylor1_bound *) let real_taylor1_bound = section_proof ["f";"d_bound"] `(!t. interval_arith t (&0, &1) ==> f real_differentiable atreal t /\ abs (derivative f t) <= d_bound) ==> abs (f (&1) - f (&0)) <= d_bound` [ (BETA_TAC THEN (move ["df"])); ((fun arg_tac -> arg_tac (Arg_term (`\i. if i = 0 then f else derivative f`))) (term_tac (set_tac "R"))); ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0)`))) (fun arg -> thm_tac MP_TAC arg THEN (move ["arithH"]))); ((((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_TAYLOR") (fun fst_arg -> (use_arg_then "R") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`real_interval [&0, &1]`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "d_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (ANTS_TAC)); (((((use_arg_then "IS_REALINTERVAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((BETA_TAC THEN (move ["i"]) THEN (move ["x"])) THEN ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "leqn0")(thm_tac (new_rewrite [] [])))))); (BETA_TAC THEN (case THEN ALL_TAC) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (case THEN ((move ["diff_f"]) THEN (move ["df_bound"]))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))); (((((use_arg_then "R_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "arithH")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN") (thm_tac apply_tac)) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((BETA_TAC THEN (move ["x"])) THEN (((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "arithH")(thm_tac (new_rewrite [] []))))) THEN (move ["ineq"]))); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (move ["d_f"])) THEN ((((use_arg_then "R_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "arithH")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((fun arg_tac -> (fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_01")(thm_tac (new_rewrite [] [])))) THEN (simp_tac))); ((((use_arg_then "SUM_SING_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "REAL_SUB_RZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "arithH")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ABS_1")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_POW_ONE")(thm_tac (new_rewrite [] [])))))); ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `FACT 1 = 1 /\ FACT 0 = 1`)))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_DIV_1")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "R_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "arithH")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; let m_taylor_error = new_definition `m_taylor_error f domain (w:real^N) error <=> !x:real^N. x IN interval [domain] ==> sum (1..dimindex (:N)) (\i. w$i * sum (1..dimindex (:N)) (\j. w$j * abs (partial j (partial i f) x))) <= error`;; let m_taylor_partial_error = new_definition `m_taylor_partial_error f i domain (w:real^N) error <=> (!x:real^N. x IN interval[domain] ==> sum (1..dimindex (:N)) (\j. w$j * abs (partial j (partial i f) x)) <= error)`;; (* Lemma taylor_error_eq_sum_partial_errors *) let taylor_error_eq_sum_partial_errors = section_proof ["f";"domain";"w";"p_error";"error"] `(!i. i IN 1..dimindex (:N) ==> m_taylor_partial_error f i domain w (p_error i) /\ &0 <= w$i) ==> sum (1..dimindex (:N)) (\i. w$i * p_error i) <= error ==> m_taylor_error f domain (w:real^N) error` [ (((((use_arg_then "m_taylor_partial_error")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "m_taylor_error")(thm_tac (new_rewrite [] []))))) THEN (move ["partialH"]) THEN (move ["ineq"]) THEN (move ["p"]) THEN (move ["p_in"])); (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((use_arg_then "SUM_LE") (thm_tac apply_tac)) THEN (((((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_ineq"]) THEN (simp_tac))); (((((use_arg_then "REAL_LE_LMUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "partialH") (fun fst_arg -> (use_arg_then "i_ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; let partial2 = new_definition `partial2 j i f = partial j (partial i f)`;; let diff2 = new_definition `diff2 f x <=> ?s. open s /\ x IN s /\ (!y. y IN s ==> (lift o f) differentiable at y /\ (!i. (lift o partial i f) differentiable at y))`;; let diff2c = new_definition `diff2c f x <=> diff2 f x /\ (!i j. (lift o partial2 j i f) continuous at x)`;; (* Lemma diff2c_imp_diff2 *) let diff2c_imp_diff2 = section_proof ["f";"x"] `diff2c f x ==> diff2 f x` [ (((((use_arg_then "diff2c")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma diff2_eq_diff2_on_open *) let diff2_eq_diff2_on_open = section_proof ["f";"x"] `diff2 f x <=> ?s. open s /\ x IN s /\ (!y. y IN s ==> diff2 f y)` [ ((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN ((split_tac) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]))); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (move ["ys"])) THEN ((use_arg_then "s") (term_tac exists_tac)) THEN (done_tac)); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["df2"])) THEN (((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC THEN (move ["_"]))); (((use_arg_then "t") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma diff2_imp_real_diff *) let diff2_imp_real_diff = section_proof ["f";"x";"e";"t"] `diff2 f (x + t % e) ==> f o (\t. x + t % e) real_differentiable atreal t` [ ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((use_arg_then "diff_imp_real_diff") (thm_tac apply_tac)) THEN ((simp_tac) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "diff_direction")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_dir_derivative *) let diff2_dir_derivative = section_proof ["f";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> derivative (f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\i. e$i * (partial i f o (\t. x + t % e)) t)` [ ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "real_dir_derivative_partial")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_partial_real_diff *) let diff2_partial_real_diff = section_proof ["f";"i";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> partial i f o (\t. x + t % e) real_differentiable atreal t` [ ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((((use_arg_then "diff_imp_real_diff")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "diff_direction")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma in_trans *) let in_trans = section_proof ["x";"s";"t"] `t SUBSET s ==> x IN t ==> x IN s` [ ((((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (move ["sub"]) THEN (move ["xt"])); (((use_arg_then "sub") (disch_tac [])) THEN (clear_assumption "sub") THEN (exact_tac)); ];; (* Lemma open_contains_open_interval *) let open_contains_open_interval = section_proof ["e";"s";"x"] `open s ==> x IN s ==> ?a b. &0 IN real_interval (a, b) /\ IMAGE (\t. x + t % e) (real_interval (a, b)) SUBSET s` [ ((((use_arg_then "OPEN_CONTAINS_BALL")(thm_tac (new_rewrite [] [])))) THEN (move ["open_s"])); (((DISCH_THEN (fun snd_th -> (use_arg_then "open_s") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["ball_s"])) THEN (((use_arg_then "open_s") (disch_tac [])) THEN (clear_assumption "open_s") THEN BETA_TAC THEN (move ["_"]))); ((THENL) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`norm e = &0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case) [ALL_TAC; (move ["n0"])]); (((((use_arg_then "NORM_EQ_0")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_term (`--d`))) (term_tac exists_tac)) THEN ((use_arg_then "d") (term_tac exists_tac)))); ((THENL_FIRST) (split_tac) ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (move ["y"]) THEN (case THEN (move ["t"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_MUL_RZERO)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))))); (((((fun arg_tac -> (use_arg_then "in_trans") (fun fst_arg -> (use_arg_then "ball_s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "CENTRE_IN_BALL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`((d / &2) * inv(norm e)) % e`))) (term_tac (set_tac "y"))); ((fun arg_tac -> arg_tac (Arg_term (`norm y = d / &2`))) (term_tac (have_gen_tac [](move ["norm_y"])))); ((((use_arg_then "y_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "VECTOR_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "NORM_MUL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_ABS_INV")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ABS_NORM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LINV")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((fun arg_tac -> arg_tac (Arg_term (`-- (d / &2 * inv (norm e))`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`d / &2 * inv (norm e)`))) (term_tac exists_tac))) THEN (split_tac)); ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_NEG_LT0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_INV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "NORM_POS_LT")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "NORM_EQ_0")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac))); ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (((use_arg_then "SUBSET_TRANS") (thm_tac apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`ball (x, d)`))) (term_tac exists_tac)) THEN (((((use_arg_then "ball_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (move ["p"]) THEN (case THEN (move ["t"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (move ["t_in"]) THEN (simp_tac))); ((((use_arg_then "IN_BALL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dist")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_SUB_RADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_NEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_MUL")(thm_tac (new_rewrite [] []))))); ((THENL_LAST) ((((use_arg_then "REAL_LET_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`d / &2`))) (term_tac exists_tac)) THEN (split_tac)) ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((fun arg_tac -> (use_arg_then "REAL_MUL_RID") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`d / &2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "REAL_MUL_LINV") (fun fst_arg -> (use_arg_then "n0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_RMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_POS_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "t_in") (disch_tac [])) THEN (clear_assumption "t_in") THEN BETA_TAC) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma diff2_dir *) let diff2_dir = section_proof ["f";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> nth_diff_strong 2 (f o (\t. x + t % e)) t` [ (((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "open_contains_open_interval") (fun fst_arg -> (use_arg_then "e") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "open_s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["a"])) THEN (case THEN (move ["b"])) THEN (case THEN (move ["in0"])) THEN (move ["sub"])); (((fun arg_tac -> arg_tac (Arg_term (`real_interval (a + t, b + t)`))) (term_tac exists_tac)) THEN ((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((use_arg_then "in0") (disch_tac [])) THEN (clear_assumption "in0") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (move ["p"]) THEN (move ["p_int"])); ((fun arg_tac -> arg_tac (Arg_term (`x + p % e IN s`))) (term_tac (have_gen_tac [](move ["xp_in"])))); ((((use_arg_then "sub") (disch_tac [])) THEN (clear_assumption "sub") THEN BETA_TAC) THEN (((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN apply_tac) THEN ((((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`p - t`))) (term_tac exists_tac))); (((THENL) (split_tac) [(VECTOR_ARITH_TAC); ((((use_arg_then "p_int") (disch_tac [])) THEN (clear_assumption "p_int") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (arith_tac))]) THEN (done_tac)); ((((use_arg_then "diff2_imp_real_diff")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((use_arg_then "differentiable_local") (thm_tac apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`\t. sum (1..dimindex(:N)) (\i. e$i * (partial i f o (\t. x + t % e)) t)`))) (term_tac exists_tac)); ((fun arg_tac -> arg_tac (Arg_term (`min (p - (a + t)) (b + t - p)`))) (term_tac (set_tac "d"))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`&0 < d`))) (term_tac (have_gen_tac [](move ["d0"])))) ((((use_arg_then "p_int") (disch_tac [])) THEN (clear_assumption "p_int") THEN BETA_TAC) THEN ((((use_arg_then "d_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac))); (((fun arg_tac -> arg_tac (Arg_term (`real_interval (p - d, p + d)`))) (term_tac exists_tac)) THEN (split_tac)); ((((use_arg_then "differentiable_sum_numseg")(thm_tac (new_rewrite [] [])))) THEN (move ["i"]) THEN (move ["ineq"]) THEN (simp_tac)); (((((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((((use_arg_then "diff2_partial_real_diff")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((BETA_TAC THEN (move ["y"]) THEN (move ["y_in"])) THEN ((((use_arg_then "diff2_dir_derivative")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "sub") (disch_tac [])) THEN (clear_assumption "sub") THEN BETA_TAC) THEN (((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN apply_tac) THEN ((((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`y - t`))) (term_tac exists_tac))); ((THENL_FIRST) (split_tac) ((VECTOR_ARITH_TAC) THEN (done_tac))); ((((use_arg_then "p_int") (disch_tac [])) THEN (clear_assumption "p_int") THEN ((use_arg_then "d_def") (disch_tac [])) THEN (clear_assumption "d_def") THEN ((use_arg_then "y_in") (disch_tac [])) THEN (clear_assumption "y_in") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma diff2_dir_derivative2 *) let diff2_dir_derivative2 = section_proof ["f";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> nth_derivative 2 (f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\i. sum (1..dimindex (:N)) (\j. e$i * e$j * (partial j (partial i f) o (\t. x + t % e)) t))` [ ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); ((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac))); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`\t. sum (1..dimindex(:N)) (\i. e$i * (partial i f o (\t. x + t % e)) t)`))) (term_tac exists_tac)) THEN (split_tac)); (((use_arg_then "HAS_REAL_DERIVATIVE_SUM") (thm_tac apply_tac)) THEN (((((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["ineq"]) THEN (simp_tac))); (((((use_arg_then "SUM_LMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_LMUL_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((use_arg_then "real_dir_derivative_partial")(thm_tac (new_rewrite [] [])))); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["r"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["xr"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "open_contains_open_interval") (fun fst_arg -> (use_arg_then "e") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "open_s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["a"])) THEN (case THEN (move ["b"])) THEN (case THEN (move ["in0"])) THEN (move ["sub"])); (((fun arg_tac -> arg_tac (Arg_term (`real_interval (a + t, b + t)`))) (term_tac exists_tac)) THEN ((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((use_arg_then "in0") (disch_tac [])) THEN (clear_assumption "in0") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((BETA_TAC THEN (move ["p"]) THEN (move ["p_in"])) THEN ((((use_arg_then "diff2_dir_derivative")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "sub") (disch_tac [])) THEN (clear_assumption "sub") THEN BETA_TAC) THEN (((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN apply_tac) THEN ((((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`p - t`))) (term_tac exists_tac))); ((THENL_FIRST) (split_tac) ((VECTOR_ARITH_TAC) THEN (done_tac))); ((((use_arg_then "p_in") (disch_tac [])) THEN (clear_assumption "p_in") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma diff2_has_derivative_partial *) let diff2_has_derivative_partial = section_proof ["f";"i";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> (partial i f o (\t. x + t % e) has_real_derivative sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)) (atreal t)` [ ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((((use_arg_then "real_dir_derivative_partial")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_derivative_partial *) let diff2_derivative_partial = section_proof ["f";"i";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> derivative (partial i f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)` [ ((BETA_TAC THEN (move ["df"])) THEN (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "diff2_has_derivative_partial") (disch_tac [])) THEN (clear_assumption "diff2_has_derivative_partial") THEN (exact_tac)) THEN (done_tac)); ];; (* Lemma diff2_real_diff_partial *) let diff2_real_diff_partial = section_proof ["f";"i";"x";"e";"t"] `diff2 f (x + t % e:real^N) ==> partial i f o (\t. x + t % e) real_differentiable atreal t` [ (BETA_TAC THEN (move ["df2"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "diff2_has_derivative_partial") (fun fst_arg -> (use_arg_then "df2") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s")))); (((((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] [])))) THEN (move ["df"])) THEN ((use_arg_then "s") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma partial_const *) let partial_const = section_proof ["i";"c"] `partial i (\x:real^N. c) = (\x. &0)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (simp_tac)); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`(\x. c) o (\t. x + t % basis i) = (\x. c)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))); ((((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial_eq0_alt *) let partial_eq0_alt = section_proof ["i";"f"] `~(i IN 1..dimindex (:N)) ==> partial i f = (\x:real^N. &0)` [ ((BETA_TAC THEN (move ["ih"])) THEN ((((use_arg_then "FUN_EQ_THM")(thm_tac (new_rewrite [] [])))) THEN (move ["x"])) THEN (((use_arg_then "partial_eq0")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma real_mvt0 *) let real_mvt0 = section_proof [] `!f f' a. (!x. abs x <= abs a ==> (f has_real_derivative f' x) (atreal x)) ==> (?t. abs t <= abs a /\ f a - f (&0) = f' t * a)` [ (BETA_TAC THEN (move ["f"]) THEN (move ["f'"]) THEN (move ["a"]) THEN (move ["h"])); (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0 <= a`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (move ["a_ineq"])); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_MVT_VERY_SIMPLE") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "a") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (((((use_arg_then "a_ineq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))))) THEN (ANTS_TAC)); (BETA_TAC THEN (move ["x"]) THEN (move ["x_ineq"])); (((((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "h")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["t_ineq"])) THEN (move ["eq"])); (((use_arg_then "t") (term_tac exists_tac)) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_MVT_VERY_SIMPLE") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "a") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); ((repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (ANTS_TAC)); ((THENL_FIRST) (split_tac) ((((use_arg_then "a_ineq") (disch_tac [])) THEN (clear_assumption "a_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((BETA_TAC THEN (move ["x"]) THEN (move ["x_ineq"])) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "h")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["t_ineq"])) THEN (move ["eq"])); (((use_arg_then "t") (term_tac exists_tac)) THEN ((((use_arg_then "REAL_NEG_SUB")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_NEG_RMUL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma mixed_second_partials *) let mixed_second_partials = section_proof ["f";"x";"i";"j"] `diff2c f x ==> partial2 i j f x = partial2 j i f (x:real^N)` [ (((((use_arg_then "diff2c")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "partial2")(thm_tac (new_rewrite [] [])))))) THEN ALL_TAC THEN (case THEN ((move ["d2f"]) THEN (move ["pc"])))); ((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`i IN 1..dimindex (:N)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (move ["ih"]))); (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "partial_eq0_alt") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "partial_const")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`j IN 1..dimindex (:N)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (move ["jh"]))); (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "partial_eq0_alt") (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "partial_const")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "jh") (disch_tac [])) THEN (clear_assumption "jh") THEN ((use_arg_then "ih") (disch_tac [])) THEN (clear_assumption "ih") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (move ["ih"]) THEN (move ["jh"]))); ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["d2f"]))); ((fun arg_tac -> arg_tac (Arg_term (`\h k. f ((x + k % basis j) + h % basis i) - f (x + k % basis j)`))) (term_tac (set_tac "F1"))); ((fun arg_tac -> arg_tac (Arg_term (`\k h. f ((x + h % basis i) + k % basis j) - f (x + h % basis i)`))) (term_tac (set_tac "F2"))); ((fun arg_tac -> arg_tac (Arg_term (`\h k. F1 h k - F1 h (&0)`))) (term_tac (set_tac "G"))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`!h k. (x + k % basis j) + h % basis i = (x + h % basis i) + k % basis j`))) (term_tac (have_gen_tac [](move ["v_eq"])))) ((VECTOR_ARITH_TAC) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`G = \h k. F2 k h - F2 k (&0)`))) (term_tac (have_gen_tac [](move ["G_eq"])))); ((repeat_tactic 2 0 (((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["h"]) THEN (move ["k"])); (((((use_arg_then "G_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "F2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "F1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`?r. &0 < r /\ (!h k. abs h <= r /\ abs k <= r ==> (x + h % basis i) + k % basis j IN s)`))) (term_tac (have_gen_tac [](case THEN ((move ["r"]) THEN (case THEN ((move ["r0"]) THEN (move ["rs"])))))))); ((((use_arg_then "open_s") (disch_tac [])) THEN (clear_assumption "open_s") THEN BETA_TAC) THEN (((((use_arg_then "OPEN_CONTAINS_BALL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_BALL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dist")(thm_tac (new_rewrite [] []))))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (case THEN (move ["e"])) THEN (case THEN ((move ["e0"]) THEN (move ["de"]))))); ((THENL_FIRST) (((fun arg_tac -> arg_tac (Arg_term (`e / &3`))) (term_tac exists_tac)) THEN (split_tac)) ((((use_arg_then "e0") (disch_tac [])) THEN (clear_assumption "e0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])); ((((use_arg_then "de")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "VECTOR_SUB_RADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_NEG")(thm_tac (new_rewrite [] []))))); ((THENL_LAST) ((((use_arg_then "REAL_LET_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`e / &3 + e / &3`))) (term_tac exists_tac)) THEN (split_tac)) ((((use_arg_then "e0") (disch_tac [])) THEN (clear_assumption "e0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((THENL_LAST) ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`abs h + abs k`))) (term_tac exists_tac)) THEN (split_tac)) ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "NORM_TRIANGLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`h % basis i:real^N`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`k % basis j:real^N`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (((repeat_tactic 1 9 (((use_arg_then "NORM_MUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "NORM_BASIS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(!h. abs h <= r ==> x + h % basis i IN s) /\ (!k. abs k <= r ==> x + k % basis j IN s)`))) (term_tac (have_gen_tac [](move ["in_s"])))); ((THENL) (split_tac) [((move ["h"]) THEN (move ["h_ineq"])); ((move ["k"]) THEN (move ["k_ineq"]))]); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "rs") (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "h_ineq")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "r0") (disch_tac [])) THEN (clear_assumption "r0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "rs") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "k") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "k_ineq")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "r0") (disch_tac [])) THEN (clear_assumption "r0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h. F1 h = (\k. (f o (\k. (x + h % basis i) + k % basis j)) k - (f o (\k. x + k % basis j)) k)`))) (term_tac (have_gen_tac [](move ["F1h"])))); (((((use_arg_then "F1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h. abs h <= r ==> !k. abs k <= r ==> (F1 h) real_differentiable atreal k`))) (term_tac (have_gen_tac [](move ["dF1"])))); (BETA_TAC THEN (move ["h"]) THEN (move ["h_ineq"]) THEN (move ["k"]) THEN (move ["k_ineq"])); (((((use_arg_then "F1h")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_SUB")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((repeat_tactic 1 9 (((use_arg_then "diff2_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "in_s")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> derivative (F1 h) k = partial j f ((x + h % basis i) + k % basis j) - partial j f (x + k % basis j)`))) (term_tac (have_gen_tac [](move ["F1_der"])))); ((BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])) THEN ((((use_arg_then "F1h")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_sub")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((use_arg_then "diff2_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "in_s")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((((use_arg_then "derivative_translation")(thm_tac (new_rewrite [] [(`derivative (f o (\k. x + k % basis j)) k`)])))) THEN (repeat_tactic 0 1 (((use_arg_then "derivative_translation")(thm_tac (new_rewrite [] [])))))) THEN ((repeat_tactic 0 10 (((use_arg_then "diff2_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "in_s")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); ((fun arg_tac -> arg_tac (Arg_term (`!y e. (f o (\k. y + k % e)) o (\t. k + t) = f o (\t. (y + k % e) + t % e)`))) (term_tac (have_gen_tac [](move ["eq"])))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "eq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "partial")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> (?t1. G h k = k * derivative (F1 h) t1 /\ abs t1 <= abs k)`))) (term_tac (have_gen_tac [](move ["Gh"])))); ((BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])) THEN ((((use_arg_then "G_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_mvt0") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`F1 h`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative (F1 h)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "k") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); ((BETA_TAC THEN (move ["t"]) THEN (move ["t_ineq"])) THEN ((((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dF1")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (case THEN (move ["t1"])) THEN (case THEN (move ["t1_ineq"])) THEN (move ["eq"])); (((use_arg_then "t1") (term_tac exists_tac)) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t1_ineq") (disch_tac [])) THEN (clear_assumption "t1_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> (?t1 t2. G h k = h * k * partial i (partial j f) (x + t1 % basis j + t2 % basis i) /\ abs t1 <= abs k /\ abs t2 <= abs h)`))) (term_tac (have_gen_tac [](move ["Ghk"])))); (BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "Gh") (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "k") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then "ineq")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["t1"])) THEN (case THEN ((move ["eq"]) THEN (move ["t1k"]))))); ((THENL) ((((use_arg_then "eq") (disch_tac [])) THEN (clear_assumption "eq") THEN BETA_TAC) THEN (((use_arg_then "F1_der")(thm_tac (new_rewrite [] []))))) [((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t1k") (disch_tac [])) THEN (clear_assumption "t1k") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (move ["eq"]))]); ((fun arg_tac -> arg_tac (Arg_term (`partial j f o (\h. (x + t1 % basis j) + h % basis i)`))) (term_tac (set_tac "g"))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_mvt0") (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative g`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); ((BETA_TAC THEN (move ["t"]) THEN (move ["t_ineq"])) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "diff2_partial_real_diff")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "v_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN ((use_arg_then "t1k") (disch_tac [])) THEN (clear_assumption "t1k") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (case THEN (move ["t2"])) THEN (case THEN (move ["t2_ineq"])) THEN (move ["g_eq"])); ((THENL_LAST) ((((use_arg_then "t1") (term_tac exists_tac)) THEN ((use_arg_then "t2") (term_tac exists_tac))) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (split_tac)) ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t2_ineq") (disch_tac [])) THEN (clear_assumption "t2_ineq") THEN ((use_arg_then "t1k") (disch_tac [])) THEN (clear_assumption "t1k") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`_1 - _2`))) (term_tac (set_tac "p"))); ((fun arg_tac -> arg_tac (Arg_term (`p = g h - g (&0)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "p_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "g_eq")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. k * a * h = h * k * a`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "REAL_EQ_MUL_LCANCEL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (DISJ2_TAC)); (((use_arg_then "derivative_translation")(thm_tac (new_rewrite [] [])))); (((((use_arg_then "diff2_partial_real_diff")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "v_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t2_ineq") (disch_tac [])) THEN (clear_assumption "t2_ineq") THEN ((use_arg_then "t1k") (disch_tac [])) THEN (clear_assumption "t1k") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "partial")(thm_tac (new_rewrite [] [])))) THEN (AP_THM_TAC) THEN (AP_TERM_TAC)); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); (((use_arg_then "F1_def") (disch_tac [])) THEN (clear_assumption "F1_def") THEN ((use_arg_then "G_def") (disch_tac [])) THEN (clear_assumption "G_def") THEN ((use_arg_then "F1h") (disch_tac [])) THEN (clear_assumption "F1h") THEN ((use_arg_then "dF1") (disch_tac [])) THEN (clear_assumption "dF1") THEN ((use_arg_then "F1_der") (disch_tac [])) THEN (clear_assumption "F1_der") THEN ((use_arg_then "Gh") (disch_tac [])) THEN (clear_assumption "Gh") THEN BETA_TAC THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"])); ((fun arg_tac -> arg_tac (Arg_term (`!k. F2 k = (\h. (f o (\h. (x + k % basis j) + h % basis i)) h - (f o (\h. x + h % basis i)) h)`))) (term_tac (have_gen_tac [](move ["F2h"])))); (((((use_arg_then "F2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!k. abs k <= r ==> !h. abs h <= r ==> (F2 k) real_differentiable atreal h`))) (term_tac (have_gen_tac [](move ["dF2"])))); (BETA_TAC THEN (move ["k"]) THEN (move ["k_ineq"]) THEN (move ["h"]) THEN (move ["h_ineq"])); (((((use_arg_then "F2h")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_SUB")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((repeat_tactic 1 9 (((use_arg_then "diff2_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "in_s")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> derivative (F2 k) h = partial i f ((x + k % basis j) + h % basis i) - partial i f (x + h % basis i)`))) (term_tac (have_gen_tac [](move ["F2_der"])))); ((BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])) THEN ((((use_arg_then "F2h")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_sub")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((use_arg_then "diff2_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "in_s")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((((use_arg_then "v_eq")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "derivative_translation")(thm_tac (new_rewrite [] [(`derivative (f o (\h. x + h % basis i)) h`)])))) THEN (repeat_tactic 0 1 (((use_arg_then "derivative_translation")(thm_tac (new_rewrite [] [])))))) THEN ((repeat_tactic 0 10 (((use_arg_then "diff2_imp_real_diff")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "in_s")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "v_eq")(gsym_then (thm_tac (new_rewrite [] []))))))); ((fun arg_tac -> arg_tac (Arg_term (`!y e. (f o (\h. y + h % e)) o (\t. h + t) = f o (\t. (y + h % e) + t % e)`))) (term_tac (have_gen_tac [](move ["eq"])))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "eq")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "partial")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> (?t3. G h k = h * derivative (F2 k) t3 /\ abs t3 <= abs h)`))) (term_tac (have_gen_tac [](move ["Gk"])))); ((BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])) THEN ((((use_arg_then "G_eq")(thm_tac (new_rewrite [] [])))) THEN (simp_tac))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_mvt0") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`F2 k`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative (F2 k)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); ((BETA_TAC THEN (move ["t"]) THEN (move ["t_ineq"])) THEN ((((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dF2")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (case THEN (move ["t3"])) THEN (case THEN (move ["t3_ineq"])) THEN (move ["eq"])); (((use_arg_then "t3") (term_tac exists_tac)) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t3_ineq") (disch_tac [])) THEN (clear_assumption "t3_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!h k. abs h <= r /\ abs k <= r ==> (?t3 t4. G h k = h * k * partial j (partial i f) (x + t4 % basis j + t3 % basis i) /\ abs t3 <= abs h /\ abs t4 <= abs k)`))) (term_tac (have_gen_tac [](move ["Gkh"])))); (BETA_TAC THEN (move ["h"]) THEN (move ["k"]) THEN (move ["ineq"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "Gk") (fun fst_arg -> (use_arg_then "h") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "k") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then "ineq")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["t3"])) THEN (case THEN ((move ["eq"]) THEN (move ["t3h"]))))); ((THENL) ((((use_arg_then "eq") (disch_tac [])) THEN (clear_assumption "eq") THEN BETA_TAC) THEN (((use_arg_then "F2_der")(thm_tac (new_rewrite [] []))))) [((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t3h") (disch_tac [])) THEN (clear_assumption "t3h") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (move ["eq"]))]); ((fun arg_tac -> arg_tac (Arg_term (`partial i f o (\k. (x + t3 % basis i) + k % basis j)`))) (term_tac (set_tac "g"))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "real_mvt0") (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative g`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "k") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); ((BETA_TAC THEN (move ["t"]) THEN (move ["t_ineq"])) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "diff2_partial_real_diff")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN ((use_arg_then "t3h") (disch_tac [])) THEN (clear_assumption "t3h") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (case THEN (move ["t4"])) THEN (case THEN (move ["t4_ineq"])) THEN (move ["g_eq"])); ((THENL_LAST) ((((use_arg_then "t3") (term_tac exists_tac)) THEN ((use_arg_then "t4") (term_tac exists_tac))) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (split_tac)) ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t4_ineq") (disch_tac [])) THEN (clear_assumption "t4_ineq") THEN ((use_arg_then "t3h") (disch_tac [])) THEN (clear_assumption "t3h") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`_1 - _2`))) (term_tac (set_tac "p"))); ((fun arg_tac -> arg_tac (Arg_term (`p = g k - g (&0)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "p_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "v_eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "g_eq")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. h * a * k = h * k * a`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "REAL_EQ_MUL_LCANCEL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (DISJ2_TAC)); (((use_arg_then "derivative_translation")(thm_tac (new_rewrite [] [])))); (((((use_arg_then "diff2_partial_real_diff")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "rs")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "t4_ineq") (disch_tac [])) THEN (clear_assumption "t4_ineq") THEN ((use_arg_then "t3h") (disch_tac [])) THEN (clear_assumption "t3h") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "partial")(thm_tac (new_rewrite [] [])))) THEN (AP_THM_TAC) THEN (AP_TERM_TAC)); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (move ["y"])); ((AP_TERM_TAC) THEN (VECTOR_ARITH_TAC) THEN (done_tac)); (((use_arg_then "F2_def") (disch_tac [])) THEN (clear_assumption "F2_def") THEN ((use_arg_then "G_eq") (disch_tac [])) THEN (clear_assumption "G_eq") THEN ((use_arg_then "F2h") (disch_tac [])) THEN (clear_assumption "F2h") THEN ((use_arg_then "dF2") (disch_tac [])) THEN (clear_assumption "dF2") THEN ((use_arg_then "F2_der") (disch_tac [])) THEN (clear_assumption "F2_der") THEN ((use_arg_then "Gk") (disch_tac [])) THEN (clear_assumption "Gk") THEN BETA_TAC THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"])); ((fun arg_tac -> arg_tac (Arg_term (`(vec 0:real^2) limit_point_of {y | &0 < y$1 /\ &0 < y$2}`))) (term_tac (have_gen_tac [](move ["lim0"])))); (((((use_arg_then "limit_point_of")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "OPEN_CONTAINS_BALL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_BALL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dist")(thm_tac (new_rewrite [] []))))) THEN (move ["t"]) THEN (case THEN (move ["v0t"]))); (((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "v0t") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC THEN (case THEN (move ["e"])) THEN (case THEN (move ["e0"])) THEN (move ["in_t"])); ((fun arg_tac -> arg_tac (Arg_term (`e / &2 % (vec 1:real^2)`))) (term_tac (set_tac "y"))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`!i. y$i = e / (&2)`))) (term_tac (have_gen_tac [](move ["yc"])))) (((((use_arg_then "y_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VEC_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`&0 < e / (&2)`))) (term_tac (have_gen_tac [](move ["ineq"])))) (((((use_arg_then "REAL_LT_DIV")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "e0")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`infnorm y = e / &2`))) (term_tac (have_gen_tac [](move ["inf_y"])))); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL INFNORM_2)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "yc")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL (CONJUNCT2 REAL_MAX_ACI))))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ABS_REFL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_LT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) (((use_arg_then "y") (term_tac exists_tac)) THEN (split_tac)) (((((use_arg_then "INFNORM_EQ_0")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "inf_y")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((THENL_FIRST) (split_tac) (((((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((use_arg_then "y") (term_tac exists_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "yc")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ineq")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "in_t")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LET_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`e * inv(&2) * sqrt(&2)`))) (term_tac exists_tac)) THEN (split_tac)); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`infnorm y * sqrt (&2)`))) (term_tac exists_tac)) THEN (split_tac)); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_MUL_AC)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NORM_SUB")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_SUB_RZERO)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIMINDEX_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "NORM_LE_INFNORM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "inf_y")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((fun arg_tac -> (use_arg_then "REAL_MUL_RID") (fun fst_arg -> (use_arg_then "e") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [2] []))))) THEN (((use_arg_then "REAL_LT_LMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "e0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((((fun arg_tac -> (use_arg_then "REAL_MUL_LINV") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_LMUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_INV")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (TRY ((arith_tac)))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`&2 = sqrt (&2 * &2)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [2] []))))))) (((((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "POW_2_SQRT_ABS")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "SQRT_MONO_LT_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial j (partial i f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`))) (term_tac (have_gen_tac [](move ["lim_ji"])))); ((((use_arg_then "LIM_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (move ["e"]) THEN (move ["e_gt0"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "pc") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL continuous_at)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "dist")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "e_gt0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["e_ineq"]))); ((THENL_FIRST) (((fun arg_tac -> arg_tac (Arg_term (`min r (d / &2)`))) (term_tac exists_tac)) THEN (((use_arg_then "REAL_LT_MIN")(thm_tac (new_rewrite [] [])))) THEN (split_tac)) ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN ((use_arg_then "r0") (disch_tac [])) THEN (clear_assumption "r0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (((simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_SUB_RZERO)))(thm_tac (new_rewrite [] []))))) THEN (move ["y"]) THEN (move ["ineq"])); ((fun arg_tac -> arg_tac (Arg_term (`&0 < abs (y$1) /\ &0 < abs (y$2)`))) (term_tac (have_gen_tac [](move ["y0"])))); ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (((((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["z"])) THEN (case THEN (move ["z_ineq"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (move ["_"]))); ((((use_arg_then "z_ineq") (disch_tac [])) THEN (clear_assumption "z_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`abs (y$1) <= r /\ abs (y$2) <= r /\ abs (y$1) < d / &2 /\ abs (y$2) < d / &2`))) (term_tac (have_gen_tac [](move ["yr"])))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`infnorm y < min r (d / &2)`))) (term_tac (have_gen_tac []ALL_TAC)))) ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL INFNORM_2)))(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "REAL_LET_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`norm y`))) (term_tac exists_tac)) THEN (((use_arg_then "INFNORM_LE_NORM")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "Gkh") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`y$1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`y$2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (((repeat_tactic 1 9 (((use_arg_then "yr")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["t1"])) THEN (case THEN (move ["t2"])) THEN (case THEN (move ["G_eq"])) THEN (move ["t_ineq"])); ((((use_arg_then "G_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_MUL_AC)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "y0") (disch_tac [])) THEN (clear_assumption "y0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "e_ineq") (disch_tac [])) THEN (clear_assumption "e_ineq") THEN (DISCH_THEN apply_tac)) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_SUB)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "REAL_LET_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`norm (t2 % basis j:real^N) + norm (t1 % basis i:real^N)`))) (term_tac exists_tac))); ((((use_arg_then "NORM_TRIANGLE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "NORM_MUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "NORM_BASIS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "yr") (disch_tac [])) THEN (clear_assumption "yr") THEN ((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial i (partial j f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`))) (term_tac (have_gen_tac [](move ["lim_ij"])))); ((((use_arg_then "LIM_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (move ["e"]) THEN (move ["e_gt0"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "pc") (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL continuous_at)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "dist")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "e_gt0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["e_ineq"]))); ((THENL_FIRST) (((fun arg_tac -> arg_tac (Arg_term (`min r (d / &2)`))) (term_tac exists_tac)) THEN (((use_arg_then "REAL_LT_MIN")(thm_tac (new_rewrite [] [])))) THEN (split_tac)) ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN ((use_arg_then "r0") (disch_tac [])) THEN (clear_assumption "r0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (((simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_SUB_RZERO)))(thm_tac (new_rewrite [] []))))) THEN (move ["y"]) THEN (move ["ineq"])); ((fun arg_tac -> arg_tac (Arg_term (`&0 < abs (y$1) /\ &0 < abs (y$2)`))) (term_tac (have_gen_tac [](move ["y0"])))); ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (((((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["z"])) THEN (case THEN (move ["z_ineq"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (move ["_"]))); ((((use_arg_then "z_ineq") (disch_tac [])) THEN (clear_assumption "z_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`abs (y$1) <= r /\ abs (y$2) <= r /\ abs (y$1) < d / &2 /\ abs (y$2) < d / &2`))) (term_tac (have_gen_tac [](move ["yr"])))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`infnorm y < min r (d / &2)`))) (term_tac (have_gen_tac []ALL_TAC)))) ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL INFNORM_2)))(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "REAL_LET_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`norm y`))) (term_tac exists_tac)) THEN (((use_arg_then "INFNORM_LE_NORM")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "Ghk") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`y$1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`y$2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (((repeat_tactic 1 9 (((use_arg_then "yr")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["t1"])) THEN (case THEN (move ["t2"])) THEN (case THEN (move ["G_eq"])) THEN (move ["t_ineq"])); ((((use_arg_then "G_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_MUL_AC)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "y0") (disch_tac [])) THEN (clear_assumption "y0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "e_ineq") (disch_tac [])) THEN (clear_assumption "e_ineq") THEN (DISCH_THEN apply_tac)) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_SUB)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "REAL_LET_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LET_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`norm (t1 % basis j:real^N) + norm (t2 % basis i:real^N)`))) (term_tac exists_tac))); ((((use_arg_then "NORM_TRIANGLE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "NORM_MUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "NORM_BASIS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "yr") (disch_tac [])) THEN (clear_assumption "yr") THEN ((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "LIFT_EQ")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((fun arg_tac -> (use_arg_then "LIM_UNIQUE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`at (vec 0:real^2) within {y:real^2 | &0 < y$1 /\ &0 < y$2}`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac apply_tac))); ((fun arg_tac -> arg_tac (Arg_term (`\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))`))) (term_tac exists_tac)); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL TRIVIAL_LIMIT_WITHIN)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negbK")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "lim0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; let m_cell_domain = new_definition `m_cell_domain (x:real^N, z:real^N) (y:real^N) (w:real^N) <=> !i. i IN 1..dimindex (:N) ==> x$i <= y$i /\ y$i <= z$i /\ max (y$i - x$i) (z$i - y$i) <= w$i`;; let m_bounded_on_int = new_definition `m_bounded_on_int (f:real^N->real) domain f_bounds <=> !x. x IN interval [domain] ==> interval_arith (f x) f_bounds`;; let diff2_domain = new_definition `diff2_domain domain f <=> !x. x IN interval [domain] ==> diff2 f x`;; let diff2c_domain = new_definition `diff2c_domain domain f <=> !x. x IN interval [domain] ==> diff2c f x`;; (* Lemma diff2c_domain_alt *) let diff2c_domain_alt = section_proof ["f";"domain"] `diff2c_domain domain f <=> diff2_domain domain f /\ (!x. x IN interval [domain] ==> !i j. (lift o partial2 j i f) continuous at x)` [ (((((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] []))))) THEN ((THENL) (split_tac) [(move ["h1"]); ((case THEN ((move ["h1"]) THEN (move ["h2"]))) THEN (move ["x"]) THEN (move ["h3"]))])); (((split_tac) THEN (move ["x"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "h1") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (simp_tac)) THEN (done_tac)); ((((fun arg_tac -> (use_arg_then "h1") (fun fst_arg -> (use_arg_then "h3") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (use_arg_then "h2") (fun fst_arg -> (use_arg_then "h3") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma y_in_domain *) let y_in_domain = section_proof ["domain";"y";"w"] `m_cell_domain domain y w ==> y IN interval [domain]` [ ((((use_arg_then "domain") (disch_tac [])) THEN (clear_assumption "domain") THEN case THEN (move ["x"]) THEN (move ["z"])) THEN (((((use_arg_then "m_cell_domain")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (move ["ineqs"]) THEN (move ["i"]))); (((DISCH_THEN (fun snd_th -> (use_arg_then "ineqs") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma domain_width *) let domain_width = section_proof ["p";"domain";"y";"w"] `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> !i. i IN 1..dimindex (:N) ==> abs (p$i - y$i) <= w$i` [ ((((use_arg_then "domain") (disch_tac [])) THEN (clear_assumption "domain") THEN case THEN (move ["x"]) THEN (move ["z"])) THEN ((((use_arg_then "m_cell_domain")(thm_tac (new_rewrite [] [])))) THEN (move ["ineqs"]) THEN (move ["p_in"]) THEN (move ["i"]) THEN (move ["i_in"]))); ((((fun arg_tac -> (use_arg_then "ineqs") (fun fst_arg -> (use_arg_then "i_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((use_arg_then "p_in") (disch_tac [])) THEN (clear_assumption "p_in") THEN BETA_TAC) THEN (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_NUMSEG")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "i_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma sum_swap1 *) let sum_swap1 = section_proof ["g";"n"] `sum (1..n) (\i. sum (i + 1..n) (\j. g i j)) = sum (1..n) (\i. sum (1..i - 1) (\j. g j i))` [ ((repeat_tactic 1 9 (((use_arg_then "SUM_SUM_PRODUCT")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))))); ((fun arg_tac -> arg_tac (Arg_term (`{i, j | (1 <= i /\ i <= n) /\ i + 1 <= j /\ j <= n}`))) (term_tac (set_tac "s1"))); ((fun arg_tac -> arg_tac (Arg_term (`{i, j | (1 <= i /\ i <= n) /\ 1 <= j /\ j <= i - 1}`))) (term_tac (set_tac "s2"))); ((fun arg_tac -> arg_tac (Arg_term (`\(i,j):num#num. j, i`))) (term_tac (set_tac "f"))); ((fun arg_tac -> arg_tac (Arg_term (`s1 = IMAGE f s2`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((((((use_arg_then "s1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "s2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "f_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "EXTENSION")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["p"])) THEN (split_tac)); (BETA_TAC THEN (case THEN (move ["i"])) THEN (case THEN (move ["j"])) THEN (case THEN (move ["ineq"])) THEN (move ["p_eq"])); (((fun arg_tac -> arg_tac (Arg_term (`j, i`))) (term_tac exists_tac)) THEN ((((use_arg_then "p_eq")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (((use_arg_then "j") (term_tac exists_tac)) THEN ((use_arg_then "i") (term_tac exists_tac))) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (BETA_TAC THEN (case THEN (move ["p1"])) THEN (case THEN (move ["p_eq"])) THEN (case THEN (move ["i"])) THEN (case THEN (move ["j"])) THEN (case THEN (move ["ineq"])) THEN (move ["p1_eq"])); ((((use_arg_then "j") (term_tac exists_tac)) THEN ((use_arg_then "i") (term_tac exists_tac))) THEN ((((use_arg_then "p_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "p1_eq")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\(i,j). g j i) = (\(i,j). g i j) o f`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN case THEN (done_tac)); (((use_arg_then "SUM_IMAGE") (thm_tac apply_tac)) THEN (case THEN (move ["i1"]) THEN (move ["j1"])) THEN (case THEN (move ["i2"]) THEN (move ["j2"]))); ((((((use_arg_then "f_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "PAIR_EQ")(thm_tac (new_rewrite [] [])))))) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (case THEN (move ["_"])) THEN (case THEN ((((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) THEN (done_tac)); ];; (* Lemma m_taylor_error_eq *) let m_taylor_error_eq = section_proof ["f";"domain";"w";"error"] `diff2c_domain domain f ==> (m_taylor_error f domain (w:real^N) error <=> (!x. x IN interval [domain] ==> sum (1..dimindex (:N)) (\i. w$i * (w$i * abs (partial2 i i f x) + &2 * sum (1..i - 1) (\j. w$j * abs (partial2 j i f x)))) <= error))` [ (((((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "m_taylor_error")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"])); ((fun arg_tac -> arg_tac (Arg_term (`!g1 g2. (!x. x IN interval [domain] ==> g1 x = g2 x) ==> ((!x. x IN interval [domain] ==> g1 x <= error) <=> (!x. x IN interval [domain] ==> g2 x <= error))`))) (term_tac (have_gen_tac [](move ["eq"])))); ((BETA_TAC THEN (move ["g1"]) THEN (move ["g2"]) THEN (move ["eq"])) THEN ((split_tac) THEN (move ["cond"]) THEN (move ["x"]) THEN (move ["Px"]))); (((((use_arg_then "eq")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "cond")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "cond")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((use_arg_then "eq") (disch_tac [])) THEN (clear_assumption "eq") THEN (DISCH_THEN apply_tac) THEN (move ["x"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "d2f") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["d2fx"])); ((fun arg_tac -> arg_tac (Arg_term (`\i j. w$i * w$j * abs (partial2 j i f x)`))) (term_tac (set_tac "g"))); ((fun arg_tac -> arg_tac (Arg_term (`dimindex (:N)`))) (term_tac (set_tac "n"))); ((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s1"))); ((fun arg_tac -> arg_tac (Arg_term (`s1 = sum (1..n) (\i. sum (1..n) (\j. g i j))`))) (term_tac (have_gen_tac [](move ["s1_eq"])))); ((((use_arg_then "s1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["i"]) THEN (simp_tac) THEN (move ["i_in"]))); (((((use_arg_then "SUM_LMUL")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial2")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (done_tac)); ((((use_arg_then "REAL_MUL_2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_ADD_LDISTRIB")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_LMUL")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_ADD_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_ADD_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s2"))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`s2 = sum (1..n) (\i. g i i + sum (1..i - 1) (\j. g i j))`))) (term_tac (have_gen_tac [](move ["s2_eq"])))) (((((use_arg_then "s2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s3"))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`s3 = sum (1..n) (\i. sum (1..i - 1) (\j. g i j))`))) (term_tac (have_gen_tac [](move ["s3_eq"])))) (((((use_arg_then "s3_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac))); (((use_arg_then "s3_def") (disch_tac [])) THEN (clear_assumption "s3_def") THEN ((use_arg_then "s2_def") (disch_tac [])) THEN (clear_assumption "s2_def") THEN ((use_arg_then "s1_def") (disch_tac [])) THEN (clear_assumption "s1_def") THEN BETA_TAC THEN (move ["_"]) THEN (move ["_"]) THEN (move ["_"])); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`s3 = sum (1..n) (\i. sum (i + 1..n) (\j. g i j))`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))); (((((use_arg_then "s2_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_ADD_NUMSEG")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "s1_eq")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["i"]) THEN (simp_tac)) THEN ((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["i_ineq"]))); (((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c. (a + b) + c = (a + c) + b`)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "SUM_SING_NUMSEG") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`g i`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); ((THENL_FIRST) ((((use_arg_then "SUM_COMBINE_R")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "i_ineq")(thm_tac (new_rewrite [] [])))))) ((arith_tac) THEN (done_tac))); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_ADD_AC)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_COMBINE_L")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (((use_arg_then "i_ineq") (disch_tac [])) THEN (clear_assumption "i_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (((((use_arg_then "s3_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "sum_swap1")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["i"]) THEN (move ["_"]) THEN (simp_tac)) THEN (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["j"]) THEN (move ["_"]) THEN (simp_tac))); (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c. a * b * c = b * a * c`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_EQ_MUL_LCANCEL")(thm_tac (new_rewrite [] [])))))) THEN (DISJ2_TAC) THEN (DISJ2_TAC)); ((((use_arg_then "mixed_second_partials")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma diff2_derivative2_bound *) let diff2_derivative2_bound = section_proof ["domain";"y";"w";"p";"f";"dd_bound"] `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> (!t. interval_arith t (&0, &1) ==> abs (nth_derivative 2 (f o (\t. y + t % (p - y))) t) <= dd_bound)` [ (((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "m_taylor_error")(thm_tac (new_rewrite [] []))))) THEN (move ["domainH"]) THEN (move ["p_in"]) THEN (move ["df"]) THEN (move ["boundedH"]) THEN (move ["t"]) THEN (move ["t_in"])); ((fun arg_tac -> arg_tac (Arg_term (`y + t % (p - y) IN interval [domain]`))) (term_tac (have_gen_tac [](move ["pt_in"])))); ((((fun arg_tac -> arg_tac (Arg_theorem (VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_CONVEX_SET")(thm_tac (new_rewrite [] []))))); (((((fun arg_tac -> (use_arg_then "y_in_domain") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "p_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "t_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "CONVEX_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "diff2_dir_derivative2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (((fun arg_tac -> (use_arg_then "boundedH") (fun fst_arg -> (use_arg_then "pt_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC)); (((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s1"))) THEN (((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s2"))) THEN (move ["i1"]))); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "s1") (term_tac exists_tac)) THEN ((((use_arg_then "i1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "s1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "s2_def")(gsym_then (thm_tac (new_rewrite [] []))))))); (((((use_arg_then "SUM_ABS_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_ineq"]) THEN (simp_tac)); (((((use_arg_then "SUM_LMUL")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_ABS_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["j"]) THEN (move ["j_ineq"]) THEN (simp_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_ABS_MUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_LE_MUL2")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LE_MUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_ABS_POS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "domain_width") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "p_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_error_lemma *) let m_taylor_error_lemma = section_proof ["domain";"y";"w";"p";"f";"dd_bound"] `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> abs (f p - (f y + sum (1..dimindex (:N)) (\i. (p - y)$i * partial i f y))) <= dd_bound / &2` [ ((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (BETA_TAC THEN (move ["domainH"]) THEN (move ["p_in"]) THEN (move ["df"]) THEN (move ["taylor_error"]))); ((fun arg_tac -> arg_tac (Arg_term (`!t. interval_arith t (&0, &1) ==> y + t % (p - y) IN interval [domain]`))) (term_tac (have_gen_tac [](move ["pt_in"])))); ((BETA_TAC THEN (move ["t"]) THEN (move ["t_in"])) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_CONVEX_SET")(thm_tac (new_rewrite [] [])))))); (((((fun arg_tac -> (use_arg_then "y_in_domain") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "p_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "t_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "CONVEX_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "real_taylor2_bound") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f o (\t. y + t % (p - y))`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dd_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((THENL_FIRST) (ANTS_TAC) (((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (move ["t"]) THEN (move ["t_in"])) THEN ((((use_arg_then "diff2_dir")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "pt_in")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((THENL_FIRST) (ANTS_TAC) ((((fun arg_tac -> (use_arg_then "diff2_derivative2_bound") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_SUB_ADD2)))(thm_tac (new_rewrite [] []))))); ((THENL_FIRST) ((((use_arg_then "diff2_dir_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "pt_in")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))))) ((arith_tac) THEN (done_tac))); (((((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_upper_bound *) let m_taylor_upper_bound = section_proof ["domain";"y";"w";"f";"dd_bound";"hi";"hi_bound"] `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> f y <= hi ==> hi + sum(1..dimindex (:N)) (\i. w$i * abs (partial i f y)) + dd_bound / &2 <= hi_bound ==> !p. p IN interval [domain] ==> f p <= hi_bound` [ (BETA_TAC THEN (move ["domainH"]) THEN (move ["df"]) THEN (move ["errorH"]) THEN (move ["f_bound"]) THEN (move ["total_bound"]) THEN (move ["p"]) THEN (move ["p_in"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_error_lemma") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "p_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((DISCH_THEN (fun snd_th -> (fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!x y e. abs (x - y) <= e ==> x <= y + e`))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC); (((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s"))) THEN (move ["ineq"])); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`(f y + s) + dd_bound / &2`))) (term_tac exists_tac)) THEN ((((use_arg_then "ineq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "total_bound") (disch_tac [])) THEN (clear_assumption "total_bound") THEN ((fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); ((((use_arg_then "REAL_ADD_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_RADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ADD2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_bound")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`abs s`))) (term_tac exists_tac)) THEN ((((use_arg_then "REAL_ABS_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "s_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_ABS_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_ineq"]) THEN (simp_tac)); (((((use_arg_then "REAL_ABS_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_MUL2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_ABS_POS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "domain_width") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_lower_bound *) let m_taylor_lower_bound = section_proof ["domain";"y";"w";"f";"dd_bound";"lo";"lo_bound"] `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> lo <= f y ==> lo_bound <= lo - (sum(1..dimindex (:N)) (\i. w$i * abs (partial i f y)) + dd_bound / &2) ==> !p. p IN interval [domain] ==> lo_bound <= f p` [ (BETA_TAC THEN (move ["domainH"]) THEN (move ["df"]) THEN (move ["errorH"]) THEN (move ["f_bound"]) THEN (move ["total_bound"]) THEN (move ["p"]) THEN (move ["p_in"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_error_lemma") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "p_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((DISCH_THEN (fun snd_th -> (fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!x y e. abs (x - y) <= e ==> y - e <= x`))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC); (((fun arg_tac -> arg_tac (Arg_term (`sum _1 _2`))) (term_tac (set_tac "s"))) THEN (move ["ineq"])); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`(f y + s) - dd_bound / &2`))) (term_tac exists_tac)) THEN ((((use_arg_then "ineq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); (((fun arg_tac -> (fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (fun fst_arg -> (use_arg_then "total_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); ((repeat_tactic 1 9 (((use_arg_then "real_sub")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_NEG_ADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ADD_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_RADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ADD2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_bound")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((THENL_LAST) ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`--abs s`))) (term_tac exists_tac)) THEN (((use_arg_then "REAL_LE_NEG")(thm_tac (new_rewrite [] [])))) THEN (split_tac)) ((arith_tac) THEN (done_tac))); (((((use_arg_then "s_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_ABS_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_ineq"]) THEN (simp_tac)); (((((use_arg_then "REAL_ABS_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_MUL2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_ABS_POS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "domain_width") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_bounds *) let m_taylor_bounds = section_proof ["domain";"y";"w";"f";"dd_bound";"lo";"hi";"err_bound";"lo_bound";"hi_bound"] `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> interval_arith (f y) (lo, hi) ==> sum(1..dimindex (:N)) (\i. w$i * abs(partial i f y)) + dd_bound / &2 <= err_bound ==> lo_bound <= lo - err_bound ==> hi + err_bound <= hi_bound ==> m_bounded_on_int f domain (lo_bound, hi_bound)` [ (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))))) THEN (move ["domainH"]) THEN (move ["df"]) THEN (move ["errorH"]) THEN (case THEN ((move ["f_lo"]) THEN (move ["f_hi"]))) THEN (move ["err"]) THEN (move ["lo_ineq"]) THEN (move ["hi_ineq"]) THEN (move ["p"]) THEN (move ["p_in"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_lower_bound") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f_lo") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "lo_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))); (((((use_arg_then "p_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`lo - err_bound`))) (term_tac exists_tac))); (((((use_arg_then "lo_ineq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "real_sub")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_ADD2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_NEG")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_upper_bound") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f_hi") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "hi_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); (((((use_arg_then "p_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`hi + err_bound`))) (term_tac exists_tac))); (((((use_arg_then "hi_ineq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_LADD")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_derivative_partial_bound *) let diff2_derivative_partial_bound = section_proof ["domain";"y";"w";"p";"f";"i";"d_bound"] `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w d_bound ==> (!t. interval_arith t (&0, &1) ==> abs (derivative (partial i f o (\t. y + t % (p - y))) t) <= d_bound)` [ (((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "m_taylor_partial_error")(thm_tac (new_rewrite [] []))))) THEN (move ["domainH"]) THEN (move ["p_in"]) THEN (move ["df"]) THEN (move ["boundedH"]) THEN (move ["t"]) THEN (move ["t_in"])); ((fun arg_tac -> arg_tac (Arg_term (`y + t % (p - y) IN interval [domain]`))) (term_tac (have_gen_tac [](move ["pt_in"])))); ((((fun arg_tac -> arg_tac (Arg_theorem (VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_CONVEX_SET")(thm_tac (new_rewrite [] []))))); (((((fun arg_tac -> (use_arg_then "y_in_domain") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "p_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "t_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "CONVEX_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "diff2_derivative_partial")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((fun arg_tac -> (use_arg_then "boundedH") (fun fst_arg -> (use_arg_then "pt_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((((use_arg_then "SUM_ABS_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["j"]) THEN (move ["j_ineq"]) THEN (simp_tac)); ((((use_arg_then "REAL_ABS_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "REAL_LE_MUL2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_ABS_POS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_SUB_COMPONENT")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (use_arg_then "domain_width") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma m_taylor_partial_error_lemma *) let m_taylor_partial_error_lemma = section_proof ["domain";"y";"w";"p";"f";"i";"dd_bound"] `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> abs (partial i f p - partial i f y) <= dd_bound` [ ((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (BETA_TAC THEN (move ["domainH"]) THEN (move ["p_in"]) THEN (move ["df"]) THEN (move ["partial_error"]))); ((fun arg_tac -> arg_tac (Arg_term (`!t. interval_arith t (&0, &1) ==> y + t % (p - y) IN interval [domain]`))) (term_tac (have_gen_tac [](move ["pt_in"])))); ((BETA_TAC THEN (move ["t"]) THEN (move ["t_in"])) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_CONVEX_SET")(thm_tac (new_rewrite [] [])))))); (((((fun arg_tac -> (use_arg_then "y_in_domain") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "p_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "t_in")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "CONVEX_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "real_taylor1_bound") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`partial i f o (\t. y + t % (p - y))`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dd_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); (ANTS_TAC); ((BETA_TAC THEN (move ["t"]) THEN (move ["t_in"])) THEN ((((use_arg_then "diff2_real_diff_partial")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "pt_in")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "diff2_derivative_partial_bound") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); ((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_SUB_ADD2)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_upper_partial_bound *) let m_taylor_upper_partial_bound = section_proof ["domain";"y";"w";"f";"i";"dd_bound";"hi";"hi_bound"] `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> partial i f y <= hi ==> hi + dd_bound <= hi_bound ==> !p. p IN interval [domain] ==> partial i f p <= hi_bound` [ (BETA_TAC THEN (move ["domainH"]) THEN (move ["df"]) THEN (move ["errorH"]) THEN (move ["df_bound"]) THEN (move ["total_bound"]) THEN (move ["p"]) THEN (move ["p_in"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_partial_error_lemma") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "p_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((DISCH_THEN (fun snd_th -> (fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!x y e. abs (x - y) <= e ==> x <= y + e`))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["ineq"])); (((fun arg_tac -> (fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((use_arg_then "total_bound") (disch_tac [])) THEN (clear_assumption "total_bound") THEN ((fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((((use_arg_then "REAL_LE_ADD2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_lower_partial_bound *) let m_taylor_lower_partial_bound = section_proof ["domain";"y";"w";"f";"i";"dd_bound";"lo";"lo_bound"] `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> lo <= partial i f y ==> lo_bound <= lo - dd_bound ==> !p. p IN interval [domain] ==> lo_bound <= partial i f p` [ (BETA_TAC THEN (move ["domainH"]) THEN (move ["df"]) THEN (move ["errorH"]) THEN (move ["df_bound"]) THEN (move ["total_bound"]) THEN (move ["p"]) THEN (move ["p_in"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_partial_error_lemma") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "p_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((DISCH_THEN (fun snd_th -> (fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!x y e. abs (x - y) <= e ==> y - e <= x`))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["ineq"])); (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((fun arg_tac -> (fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (fun fst_arg -> (use_arg_then "total_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((repeat_tactic 1 9 (((use_arg_then "real_sub")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_ADD2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_partial_bounds *) let m_taylor_partial_bounds = section_proof ["domain";"y";"w";"f";"i";"dd_bound";"lo";"hi";"lo_bound";"hi_bound"] `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> interval_arith (partial i f y) (lo, hi) ==> lo_bound <= lo - dd_bound ==> hi + dd_bound <= hi_bound ==> m_bounded_on_int (partial i f) domain (lo_bound, hi_bound)` [ (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))))) THEN (move ["domainH"]) THEN (move ["df"]) THEN (move ["errorH"]) THEN (case THEN ((move ["df_lo"]) THEN (move ["df_hi"]))) THEN (move ["lo_ineq"]) THEN (move ["hi_ineq"]) THEN (move ["p"]) THEN (move ["p_in"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_lower_partial_bound") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df_lo") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "lo_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "m_taylor_upper_partial_bound") (fun fst_arg -> (use_arg_then "domainH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "errorH") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df_hi") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "hi_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section Taylor *) let real_taylor2_bound = finalize_theorem real_taylor2_bound;; let real_taylor1_bound = finalize_theorem real_taylor1_bound;; let taylor_error_eq_sum_partial_errors = finalize_theorem taylor_error_eq_sum_partial_errors;; let diff2c_imp_diff2 = finalize_theorem diff2c_imp_diff2;; let diff2_eq_diff2_on_open = finalize_theorem diff2_eq_diff2_on_open;; let diff2_imp_real_diff = finalize_theorem diff2_imp_real_diff;; let diff2_dir_derivative = finalize_theorem diff2_dir_derivative;; let diff2_partial_real_diff = finalize_theorem diff2_partial_real_diff;; let in_trans = finalize_theorem in_trans;; let open_contains_open_interval = finalize_theorem open_contains_open_interval;; let diff2_dir = finalize_theorem diff2_dir;; let diff2_dir_derivative2 = finalize_theorem diff2_dir_derivative2;; let diff2_has_derivative_partial = finalize_theorem diff2_has_derivative_partial;; let diff2_derivative_partial = finalize_theorem diff2_derivative_partial;; let diff2_real_diff_partial = finalize_theorem diff2_real_diff_partial;; let partial_const = finalize_theorem partial_const;; let partial_eq0_alt = finalize_theorem partial_eq0_alt;; let real_mvt0 = finalize_theorem real_mvt0;; let mixed_second_partials = finalize_theorem mixed_second_partials;; let diff2c_domain_alt = finalize_theorem diff2c_domain_alt;; let y_in_domain = finalize_theorem y_in_domain;; let domain_width = finalize_theorem domain_width;; let sum_swap1 = finalize_theorem sum_swap1;; let m_taylor_error_eq = finalize_theorem m_taylor_error_eq;; let diff2_derivative2_bound = finalize_theorem diff2_derivative2_bound;; let m_taylor_error_lemma = finalize_theorem m_taylor_error_lemma;; let m_taylor_upper_bound = finalize_theorem m_taylor_upper_bound;; let m_taylor_lower_bound = finalize_theorem m_taylor_lower_bound;; let m_taylor_bounds = finalize_theorem m_taylor_bounds;; let diff2_derivative_partial_bound = finalize_theorem diff2_derivative_partial_bound;; let m_taylor_partial_error_lemma = finalize_theorem m_taylor_partial_error_lemma;; let m_taylor_upper_partial_bound = finalize_theorem m_taylor_upper_partial_bound;; let m_taylor_lower_partial_bound = finalize_theorem m_taylor_lower_partial_bound;; let m_taylor_partial_bounds = finalize_theorem m_taylor_partial_bounds;; end_section "Taylor";; (* Section Diff2Arith *) begin_section "Diff2Arith";; (add_section_var (mk_var ("f", (`:real^N -> real`))); add_section_var (mk_var ("g", (`:real^N -> real`))));; (add_section_var (mk_var ("x", (`:real^N`))));; (add_section_var (mk_var ("domain", (`:real^N#real^N`))));; (* Lemma differentiable_local_at *) let differentiable_local_at = section_proof ["s";"f";"g";"x"] `f differentiable at x ==> open s ==> x IN s ==> (!y. y IN s ==> g y = f y) ==> g differentiable at x` [ ((((use_arg_then "OPEN_CONTAINS_BALL")(thm_tac (new_rewrite [] [])))) THEN (move ["df"]) THEN (move ["open_s"]) THEN (move ["xs"]) THEN (move ["eq"])); ((((fun arg_tac -> (use_arg_then "open_s") (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"]))) THEN (((((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_BALL")(thm_tac (new_rewrite [] []))))) THEN (move ["in_ball"]))); ((((fun arg_tac -> (use_arg_then "DIFFERENTIABLE_TRANSFORM_AT") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "d") (term_tac exists_tac)) THEN (((((use_arg_then "d0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["z"]) THEN (move ["dzx"])) THEN ((((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "in_ball")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIST_SYM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Section Point *) begin_section "Point";; (* Lemma diff2_scale *) let diff2_scale = section_proof ["f";"c"] `diff2 f x ==> diff2 (\x. c * f x) x` [ ((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (move ["zs"]))); ((THENL_FIRST) ((((use_arg_then "f_lift_scale")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CMUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((BETA_TAC THEN (move ["i"])) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "differentiable_local_at") (fun fst_arg -> (use_arg_then "s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`lift o (\x. c * partial i f x)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac))); ((THENL_FIRST) ((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "zs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_scale")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CMUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((BETA_TAC THEN (move ["y"]) THEN (move ["ys"])) THEN ((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial_scale")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "LIFT_CMUL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_neg *) let diff2_neg = section_proof ["f"] `diff2 f x ==> diff2 (\x. --f x) x` [ (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "diff2_scale") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`--(&1)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (((use_arg_then "REAL_NEG_MINUS1")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Section Composite *) begin_section "Composite";; (* Lemma has_derivative_uni_compose *) let has_derivative_uni_compose = section_proof ["u";"f";"u'";"f'";"x"] `(lift o f has_derivative f') (at x) ==> (u has_real_derivative u') (atreal (f x)) ==> (lift o u o f has_derivative (\x. u' % f' x)) (at x)` [ (BETA_TAC THEN (move ["df"]) THEN (move ["du"])); ((fun arg_tac -> arg_tac (Arg_term (`lift o u o f = (lift o u o drop) o (lift o f)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`(\x. u' % f' x) = (\x. u' % x) o f'`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (done_tac))); (((((use_arg_then "DIFF_CHAIN_AT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL HAS_REAL_FRECHET_DERIVATIVE_AT)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff_uni_compose *) let diff_uni_compose = section_proof ["u";"f";"x"] `lift o f differentiable at x ==> u real_differentiable atreal (f x) ==> lift o u o f differentiable at x` [ (((repeat_tactic 1 9 (((use_arg_then "differentiable")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["f'"])) THEN (move ["df"]) THEN (case THEN (move ["u'"])) THEN (move ["du"])); (((fun arg_tac -> arg_tac (Arg_term (`\x. u' % f' x`))) (term_tac exists_tac)) THEN ((use_arg_then "has_derivative_uni_compose") (thm_tac apply_tac)) THEN (done_tac)); ];; (* Lemma diff2_uni_compose *) let diff2_uni_compose = section_proof ["u";"f"] `diff2 f x ==> nth_diff_strong 2 u (f x) ==> diff2 (u o f) x` [ (((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["fxt"])) THEN (move ["du"])); ((fun arg_tac -> arg_tac (Arg_term (`{z | z IN s /\ (lift o f) z IN (IMAGE lift t)}`))) (term_tac (set_tac "r"))); ((fun arg_tac -> arg_tac (Arg_term (`open r`))) (term_tac (have_gen_tac [](move ["open_r"])))); ((((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONTINUOUS_OPEN_PREIMAGE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_OPEN")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "open_t")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "DIFFERENTIABLE_IMP_CONTINUOUS_ON") (thm_tac apply_tac)) THEN ((((use_arg_then "differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (move ["y"]) THEN (move ["ys"])) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((((use_arg_then "DIFFERENTIABLE_AT_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) (((use_arg_then "r") (term_tac exists_tac)) THEN ((((use_arg_then "open_r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LIFT_IN_IMAGE_LIFT")(thm_tac (new_rewrite [] []))))) THEN (split_tac)) (((use_arg_then "x") (term_tac exists_tac)) THEN (done_tac))); (BETA_TAC THEN (move ["y"]) THEN (case THEN (move ["z"])) THEN (case THEN ((case THEN (move ["zs"])) THEN (move ["fzt"]))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))); (((((use_arg_then "diff_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "du")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"])); (((use_arg_then "differentiable_local_at") (thm_tac apply_tac)) THEN (((use_arg_then "r") (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`lift o (\y. derivative u (f y) * partial i f y)`))) (term_tac exists_tac)))); ((((use_arg_then "open_r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "differentiable_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative u`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((((use_arg_then "diff_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "du")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) (((((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_IN_IMAGE_LIFT")(thm_tac (new_rewrite [] [])))))) THEN (split_tac)) (((use_arg_then "z") (term_tac exists_tac)) THEN (done_tac))); (BETA_TAC THEN (move ["y"]) THEN (case THEN (move ["p"])) THEN (case THEN ((case THEN (move ["ps"])) THEN (move ["fpt"]))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))); (((((use_arg_then "partial_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "du")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2_inv_compose *) let diff2_inv_compose = section_proof [] `~(f x = &0) ==> diff2 f x ==> diff2 (inv o f) x` [ ((BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "diff2_inv") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["du"]) THEN (move ["df"])) THEN (((use_arg_then "diff2_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma diff2_sqrt_compose *) let diff2_sqrt_compose = section_proof [] `&0 < f x ==> diff2 f x ==> diff2 (sqrt o f) x` [ ((BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "diff2_sqrt") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["du"]) THEN (move ["df"])) THEN (((use_arg_then "diff2_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma diff2_atn_compose *) let diff2_atn_compose = section_proof [] `diff2 f x ==> diff2 (atn o f) x` [ ((BETA_TAC THEN (move ["df"])) THEN ((((use_arg_then "diff2_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_atn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_acs_compose *) let diff2_acs_compose = section_proof [] `abs (f x) < &1 ==> diff2 f x ==> diff2 (acs o f) x` [ ((BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "diff2_acs") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["du"]) THEN (move ["df"])) THEN (((use_arg_then "diff2_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Finalization of the section Composite *) let has_derivative_uni_compose = finalize_theorem has_derivative_uni_compose;; let diff_uni_compose = finalize_theorem diff_uni_compose;; let diff2_uni_compose = finalize_theorem diff2_uni_compose;; let diff2_inv_compose = finalize_theorem diff2_inv_compose;; let diff2_sqrt_compose = finalize_theorem diff2_sqrt_compose;; let diff2_atn_compose = finalize_theorem diff2_atn_compose;; let diff2_acs_compose = finalize_theorem diff2_acs_compose;; end_section "Composite";; (* Lemma diff2_add *) let diff2_add = section_proof ["f";"g"] `diff2 f x ==> diff2 g x ==> diff2 (\x. f x + g x) x` [ ((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["ys"])) THEN (move ["dg"])); (((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac)) THEN (((((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (case THEN ((move ["zs"]) THEN (move ["zt"]))))); ((((use_arg_then "f_lift_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((BETA_TAC THEN (move ["i"])) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "differentiable_local_at") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`lift o (\x. partial i f x + partial i g x)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac))); ((((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "zt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "zs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["yt"])))) THEN ((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "LIFT_ADD")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_sub *) let diff2_sub = section_proof ["f";"g"] `diff2 f x ==> diff2 g x ==> diff2 (\x. f x - g x) x` [ ((BETA_TAC THEN (move ["d2f"]) THEN (move ["d2g"])) THEN ((((use_arg_then "real_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_add")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "diff2_neg")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_mul *) let diff2_mul = section_proof ["f";"g"] `diff2 f x ==> diff2 g x ==> diff2 (\x. f x * g x) x` [ ((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["ys"])) THEN (move ["dg"])); (((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac)) THEN (((((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (case THEN ((move ["zs"]) THEN (move ["zt"]))))); (((((use_arg_then "differentiable_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "differentiable_local_at") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`lift o (\x. partial i f x * g x + f x * partial i g x)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); ((((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "zt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "zs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (repeat_tactic 1 9 (((use_arg_then "differentiable_mul")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["yt"])))) THEN ((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "LIFT_ADD")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section Point *) let diff2_scale = finalize_theorem diff2_scale;; let diff2_neg = finalize_theorem diff2_neg;; let has_derivative_uni_compose = finalize_theorem has_derivative_uni_compose;; let diff_uni_compose = finalize_theorem diff_uni_compose;; let diff2_uni_compose = finalize_theorem diff2_uni_compose;; let diff2_inv_compose = finalize_theorem diff2_inv_compose;; let diff2_sqrt_compose = finalize_theorem diff2_sqrt_compose;; let diff2_atn_compose = finalize_theorem diff2_atn_compose;; let diff2_acs_compose = finalize_theorem diff2_acs_compose;; let diff2_add = finalize_theorem diff2_add;; let diff2_sub = finalize_theorem diff2_sub;; let diff2_mul = finalize_theorem diff2_mul;; end_section "Point";; (* Section Domain *) begin_section "Domain";; (add_section_hyp "d2f" (`diff2_domain domain f`));; (* Lemma diff2_domain_scale *) let diff2_domain_scale = section_proof ["c"] `diff2_domain domain (\x. c * f x)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2_scale")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_domain_neg *) let diff2_domain_neg = section_proof [] `diff2_domain domain (\x. --f x)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2_neg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_var (mk_var ("bounds", (`:real#real`))));; (* Lemma diff2_domain_inv_compose *) let diff2_domain_inv_compose = section_proof [] `m_bounded_on_int f domain bounds ==> interval_not_zero bounds ==> diff2_domain domain (inv o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))))) THEN (move ["d2f"]) THEN (move ["ineq"]) THEN (move ["n0"]) THEN (move ["x"]) THEN (move ["x_in"]))); (((((use_arg_then "diff2_inv_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "interval_arith_not_zero") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "x_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_domain_sqrt_compose *) let diff2_domain_sqrt_compose = section_proof [] `m_bounded_on_int f domain bounds ==> interval_pos bounds ==> diff2_domain domain (sqrt o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))))) THEN (move ["d2f"]) THEN (move ["ineq"]) THEN (move ["n0"]) THEN (move ["x"]) THEN (move ["x_in"]))); (((((use_arg_then "diff2_sqrt_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "interval_arith_pos") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "x_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_domain_atn_compose *) let diff2_domain_atn_compose = section_proof [] `diff2_domain domain (atn o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2_atn_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_domain_acs_compose *) let diff2_domain_acs_compose = section_proof [] `m_bounded_on_int f domain bounds ==> iabs bounds < &1 ==> diff2_domain domain (acs o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))))) THEN (move ["d2f"]) THEN (move ["ineq"]) THEN (move ["n0"]) THEN (move ["x"]) THEN (move ["x_in"]))); (((((use_arg_then "diff2_acs_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "interval_arith_abs") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "x_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_hyp "d2g" (`diff2_domain domain g`));; (* Lemma diff2_domain_add *) let diff2_domain_add = section_proof [] `diff2_domain domain (\x. f x + g x)` [ ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["d2g"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2_domain_sub *) let diff2_domain_sub = section_proof [] `diff2_domain domain (\x. f x - g x)` [ ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["d2g"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2_domain_mul *) let diff2_domain_mul = section_proof [] `diff2_domain domain (\x. f x * g x)` [ ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["d2g"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2_mul")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section Domain *) let diff2_domain_scale = finalize_theorem diff2_domain_scale;; let diff2_domain_neg = finalize_theorem diff2_domain_neg;; let diff2_domain_inv_compose = finalize_theorem diff2_domain_inv_compose;; let diff2_domain_sqrt_compose = finalize_theorem diff2_domain_sqrt_compose;; let diff2_domain_atn_compose = finalize_theorem diff2_domain_atn_compose;; let diff2_domain_acs_compose = finalize_theorem diff2_domain_acs_compose;; let diff2_domain_add = finalize_theorem diff2_domain_add;; let diff2_domain_sub = finalize_theorem diff2_domain_sub;; let diff2_domain_mul = finalize_theorem diff2_domain_mul;; end_section "Domain";; (* Section SecondPartial *) begin_section "SecondPartial";; (* Lemma diff2_imp_diff *) let diff2_imp_diff = section_proof ["f";"x"] `diff2 f x ==> (lift o f) differentiable at x` [ (((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_imp_partial_diff *) let diff2_imp_partial_diff = section_proof ["f";"i";"x"] `diff2 f x ==> (lift o partial i f) differentiable at x` [ (((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial_local *) let partial_local = section_proof ["s";"f";"g";"i";"x"] `(lift o f) differentiable at x ==> open s ==> x IN s ==> (!y:real^N. y IN s ==> f y = g y) ==> partial i f x = partial i g x` [ ((BETA_TAC THEN (move ["df"]) THEN (move ["open_s"]) THEN (move ["xs"]) THEN (move ["eq"])) THEN (repeat_tactic 1 9 (((use_arg_then "partial")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac))); (((fun arg_tac -> arg_tac (Arg_term (`g o (\t. x + t % basis i)`))) (term_tac exists_tac)) THEN (split_tac)); ((((use_arg_then "has_derivative_alt") (disch_tac [])) THEN (clear_assumption "has_derivative_alt") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "diff_imp_real_diff") (thm_tac apply_tac)) THEN ((((use_arg_then "diff_direction")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "differentiable_local_at") (fun fst_arg -> (use_arg_then "s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`lift o f`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac apply_tac)); (((simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (move ["ys"])); (((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "open_contains_open_interval") (fun fst_arg -> (use_arg_then "open_s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`basis i:real^N`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["a"])) THEN (case THEN (move ["b"])) THEN (case THEN (move ["ab0"]))) THEN ((((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (move ["sub"]))); (((fun arg_tac -> arg_tac (Arg_term (`real_interval (a, b)`))) (term_tac exists_tac)) THEN (((((use_arg_then "ab0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (move ["y_in"]))); (((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((use_arg_then "y") (term_tac exists_tac)) THEN (done_tac)); ];; (add_section_var (mk_var ("i", (`:num`))); add_section_var (mk_var ("j", (`:num`))));; (* Lemma second_partial_scale *) let second_partial_scale = section_proof ["f";"c"] `diff2 f x ==> partial2 i j (\x. c * f x) x = c * partial2 i j f x` [ ((BETA_TAC THEN (move ["d2f"])) THEN ((repeat_tactic 1 9 (((use_arg_then "partial2")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial_scale")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_imp_partial_diff")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]))); (((use_arg_then "partial_local") (thm_tac apply_tac)) THEN ((use_arg_then "s") (term_tac exists_tac)) THEN ((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_scale")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CMUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))))); ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((BETA_TAC THEN (move ["y"]) THEN (move ["ys"])) THEN ((((use_arg_then "partial_scale")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma second_partial_neg *) let second_partial_neg = section_proof ["f"] `diff2 f x ==> partial2 i j (\x. --f x) x = --partial2 i j f x` [ (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "second_partial_scale") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`--(&1)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_NEG_MINUS1")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma second_partial_add *) let second_partial_add = section_proof ["f";"g"] `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x + g x) x = partial2 i j f x + partial2 i j g x` [ ((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["ys"])) THEN (move ["dg"])); (((repeat_tactic 1 9 (((use_arg_then "partial2")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial_add")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "partial_local") (thm_tac apply_tac))); (((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac)) THEN ((((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "f_lift_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((BETA_TAC THEN (move ["z"]) THEN (case THEN ((move ["zs"]) THEN (move ["zt"])))) THEN ((((use_arg_then "partial_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma second_partial_sub *) let second_partial_sub = section_proof ["f";"g"] `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x - g x) x = partial2 i j f x - partial2 i j g x` [ ((BETA_TAC THEN (move ["d2f"]) THEN (move ["d2g"])) THEN ((((use_arg_then "real_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "second_partial_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_neg")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "second_partial_neg")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "real_sub")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma second_partial_mul *) let second_partial_mul = section_proof ["f";"g"] `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x * g x) x = (partial2 i j f x * g x + partial j f x * partial i g x) + (partial i f x * partial j g x + f x * partial2 i j g x)` [ ((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["ys"])) THEN (move ["dg"])); ((repeat_tactic 1 9 (((use_arg_then "partial2")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "partial_mul")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 0 10 (((use_arg_then "partial_add")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 0 1 (((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] [])))))); ((repeat_tactic 1 9 (((use_arg_then "differentiable_mul")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((use_arg_then "partial_local") (thm_tac apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac)) THEN ((((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "f_lift_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (repeat_tactic 1 9 (((use_arg_then "differentiable_mul")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((BETA_TAC THEN (move ["z"]) THEN (case THEN ((move ["zs"]) THEN (move ["zt"])))) THEN ((((use_arg_then "partial_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma second_partial_uni_compose *) let second_partial_uni_compose = section_proof ["f";"u"] `diff2 f x ==> nth_diff_strong 2 u (f x) ==> partial2 i j (u o f) x = (nth_derivative 2 u (f x) * partial i f x) * partial j f x + derivative u (f x) * partial2 i j f x` [ (((repeat_tactic 1 9 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["fxt"])) THEN (move ["du"])); ((fun arg_tac -> arg_tac (Arg_term (`{z | z IN s /\ (lift o f) z IN (IMAGE lift t)}`))) (term_tac (set_tac "r"))); ((fun arg_tac -> arg_tac (Arg_term (`open r`))) (term_tac (have_gen_tac [](move ["open_r"])))); ((((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONTINUOUS_OPEN_PREIMAGE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_OPEN")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "open_t")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "DIFFERENTIABLE_IMP_CONTINUOUS_ON") (thm_tac apply_tac)) THEN ((((use_arg_then "differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (move ["y"]) THEN (move ["ys"])) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((((use_arg_then "DIFFERENTIABLE_AT_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((repeat_tactic 1 9 (((use_arg_then "partial2")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "partial_uni_compose")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "du")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative u`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial_mul")(gsym_then (thm_tac (new_rewrite [] [])))))); (((((use_arg_then "diff_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "du")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((use_arg_then "partial_local") (thm_tac apply_tac)) THEN ((use_arg_then "r") (term_tac exists_tac)) THEN ((((use_arg_then "open_r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); ((THENL_ROT (-1)) (((((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LIFT_IN_IMAGE_LIFT")(thm_tac (new_rewrite [] []))))) THEN (split_tac))); ((BETA_TAC THEN (move ["y"]) THEN (case THEN (move ["z"])) THEN (case THEN ((case THEN (move ["zs"])) THEN (move ["fpz"]))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "partial_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "du")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_LAST) (split_tac) (((use_arg_then "x") (term_tac exists_tac)) THEN (done_tac))); (((use_arg_then "differentiable_local_at") (thm_tac apply_tac)) THEN (((use_arg_then "r") (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`lift o (\y. derivative u (f y) * partial j f y)`))) (term_tac exists_tac)))); ((((use_arg_then "open_r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "differentiable_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative u`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN ((((use_arg_then "diff_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "du")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_FIRST) (((((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_IN_IMAGE_LIFT")(thm_tac (new_rewrite [] [])))))) THEN (split_tac)) (((use_arg_then "x") (term_tac exists_tac)) THEN (done_tac))); ((BETA_TAC THEN (move ["y"]) THEN (case THEN (move ["p"])) THEN (case THEN ((case THEN (move ["ps"])) THEN (move ["fpt"]))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "partial_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "du")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section SecondPartial *) let diff2_imp_diff = finalize_theorem diff2_imp_diff;; let diff2_imp_partial_diff = finalize_theorem diff2_imp_partial_diff;; let partial_local = finalize_theorem partial_local;; let second_partial_scale = finalize_theorem second_partial_scale;; let second_partial_neg = finalize_theorem second_partial_neg;; let second_partial_add = finalize_theorem second_partial_add;; let second_partial_sub = finalize_theorem second_partial_sub;; let second_partial_mul = finalize_theorem second_partial_mul;; let second_partial_uni_compose = finalize_theorem second_partial_uni_compose;; end_section "SecondPartial";; (* Finalization of the section Diff2Arith *) let differentiable_local_at = finalize_theorem differentiable_local_at;; let diff2_scale = finalize_theorem diff2_scale;; let diff2_neg = finalize_theorem diff2_neg;; let has_derivative_uni_compose = finalize_theorem has_derivative_uni_compose;; let diff_uni_compose = finalize_theorem diff_uni_compose;; let diff2_uni_compose = finalize_theorem diff2_uni_compose;; let diff2_inv_compose = finalize_theorem diff2_inv_compose;; let diff2_sqrt_compose = finalize_theorem diff2_sqrt_compose;; let diff2_atn_compose = finalize_theorem diff2_atn_compose;; let diff2_acs_compose = finalize_theorem diff2_acs_compose;; let diff2_add = finalize_theorem diff2_add;; let diff2_sub = finalize_theorem diff2_sub;; let diff2_mul = finalize_theorem diff2_mul;; let diff2_domain_scale = finalize_theorem diff2_domain_scale;; let diff2_domain_neg = finalize_theorem diff2_domain_neg;; let diff2_domain_inv_compose = finalize_theorem diff2_domain_inv_compose;; let diff2_domain_sqrt_compose = finalize_theorem diff2_domain_sqrt_compose;; let diff2_domain_atn_compose = finalize_theorem diff2_domain_atn_compose;; let diff2_domain_acs_compose = finalize_theorem diff2_domain_acs_compose;; let diff2_domain_add = finalize_theorem diff2_domain_add;; let diff2_domain_sub = finalize_theorem diff2_domain_sub;; let diff2_domain_mul = finalize_theorem diff2_domain_mul;; let diff2_imp_diff = finalize_theorem diff2_imp_diff;; let diff2_imp_partial_diff = finalize_theorem diff2_imp_partial_diff;; let partial_local = finalize_theorem partial_local;; let second_partial_scale = finalize_theorem second_partial_scale;; let second_partial_neg = finalize_theorem second_partial_neg;; let second_partial_add = finalize_theorem second_partial_add;; let second_partial_sub = finalize_theorem second_partial_sub;; let second_partial_mul = finalize_theorem second_partial_mul;; let second_partial_uni_compose = finalize_theorem second_partial_uni_compose;; end_section "Diff2Arith";; (* Section Diff2c *) begin_section "Diff2c";; (* Lemma real_cont_at_local *) let real_cont_at_local = section_proof ["f";"g";"x";"s"] `g real_continuous at x ==> open s ==> x IN s ==> (!y. y IN s ==> f y = g y) ==> f real_continuous at x` [ ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL real_continuous_at)))(thm_tac (new_rewrite [] []))))) THEN (move ["g_cont"]) THEN (move ["open_s"]) THEN (move ["xs"]) THEN (move ["f_eq_g"]) THEN (move ["e"]) THEN (move ["e_gt0"])); (((fun arg_tac -> (use_arg_then "OPEN_CONTAINS_BALL") (fun fst_arg -> (use_arg_then "s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN ((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "ball")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUBSET")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac))); (((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "xs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC THEN (case THEN (move ["d0"])) THEN (case THEN (move ["d0_gt0"])) THEN (move ["sub_s"])); (((fun arg_tac -> (use_arg_then "g_cont") (fun fst_arg -> (use_arg_then "e_gt0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["d1"])) THEN (case THEN (move ["d1_gt0"])) THEN (move ["dist_cond"])); ((fun arg_tac -> arg_tac (Arg_term (`min d0 d1`))) (term_tac exists_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_LT_MIN")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "d1_gt0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d0_gt0")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (move ["y"]) THEN (case THEN ((move ["yd0"]) THEN (move ["yd1"])))); ((repeat_tactic 1 9 (((use_arg_then "f_eq_g")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "sub_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIST_SYM")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "y") (term_tac exists_tac)) THEN (done_tac)); (((use_arg_then "dist_cond") (disch_tac [])) THEN (clear_assumption "dist_cond") THEN (exact_tac)); ];; (* Lemma real_cont_atreal_local *) let real_cont_atreal_local = section_proof ["v";"u";"t";"x"] `v real_continuous atreal x ==> real_open t ==> x IN t ==> (!y. y IN t ==> u y = v y) ==> u real_continuous atreal x` [ (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS_ATREAL)))(thm_tac (new_rewrite [] []))))); (((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "REAL_OPEN")(thm_tac (new_rewrite [] []))))) THEN (move ["vc"]) THEN (move ["open_t"]) THEN (move ["xt"]) THEN (move ["v_eq_u"])); ((use_arg_then "real_cont_at_local") (thm_tac apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`v o drop`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`IMAGE lift t`))) (term_tac exists_tac))); ((((((use_arg_then "open_t")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "vc")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "LIFT_IN_IMAGE_LIFT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "IN_IMAGE_LIFT_DROP")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "v_eq_u") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (done_tac)); ];; (add_section_type (mk_var ("f", (`:real^N -> real`))); add_section_type (mk_var ("g", (`:real^N -> real`))));; (add_section_var (mk_var ("x", (`:real^N`))));; (add_section_var (mk_var ("domain", (`:real^N#real^N`))));; (* Section Point *) begin_section "Point";; (* Lemma diff2c_scale *) let diff2c_scale = section_proof ["f";"c"] `diff2c f x ==> diff2c (\x. c * f x) x` [ (((repeat_tactic 1 9 (((use_arg_then "diff2c")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN ((move ["d2f"]) THEN (move ["p2c"])))) THEN (((((use_arg_then "diff2_scale")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["j"]))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "p2c") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["p2ij"]))); ((use_arg_then "real_cont_at_local") (thm_tac apply_tac)); ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["d2s"]))); (((fun arg_tac -> arg_tac (Arg_term (`(\x. c * partial2 j i f x)`))) (term_tac exists_tac)) THEN ((use_arg_then "s") (term_tac exists_tac))); ((THENL_FIRST) (((use_arg_then "REAL_CONTINUOUS_LMUL")(thm_tac (new_rewrite [] [])))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac))); (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (move ["y"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "d2s") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["d2y"])); ((((use_arg_then "second_partial_scale")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma diff2c_neg *) let diff2c_neg = section_proof ["f"] `diff2c f x ==> diff2c (\x. --f x) x` [ (((DISCH_THEN (fun snd_th -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "diff2c_scale") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`--(&1)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN (((use_arg_then "REAL_NEG_MINUS1")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Section Composite *) begin_section "Composite";; (* Lemma nth_diff_strong_eq_on_open *) let nth_diff_strong_eq_on_open = section_proof ["n";"u";"x"] `nth_diff_strong n u x ==> ?s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_diff_strong n u y)` [ ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["dt"])); (((use_arg_then "t") (term_tac exists_tac)) THEN (((((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_t")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (move ["y"]) THEN (move ["yt"]))); (((use_arg_then "t") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma diff2_imp_cont *) let diff2_imp_cont = section_proof ["f";"x"] `diff2 f x ==> f real_continuous at x` [ ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_IMP_CONTINUOUS_AT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_imp_partial_cont *) let diff2_imp_partial_cont = section_proof ["f";"i";"x"] `diff2 f x ==> (partial i f) real_continuous at x` [ ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_IMP_CONTINUOUS_AT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_uni_compose *) let diff2c_uni_compose = section_proof ["u";"f";"x"] `diff2c f x ==> nth_diff_strong 2 u (f x) ==> (nth_derivative 2 u) real_continuous atreal (f x) ==> diff2c (u o f) x` [ ((repeat_tactic 1 9 (((use_arg_then "diff2c")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["d2f"])) THEN (move ["p2c"]) THEN (move ["d2u"]) THEN (move ["u2c"])); (((((use_arg_then "diff2_uni_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2u")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["j"])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "p2c") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["p2ij"]))); ((use_arg_then "real_cont_at_local") (thm_tac apply_tac)); ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["d2s"]))); (((fun arg_tac -> (use_arg_then "nth_diff_strong_eq_on_open") (fun fst_arg -> (use_arg_then "d2u") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["fxt"])) THEN (move ["d2t"])); ((fun arg_tac -> arg_tac (Arg_term (`{z | z IN s /\ (lift o f) z IN (IMAGE lift t)}`))) (term_tac (set_tac "r"))); ((fun arg_tac -> arg_tac (Arg_term (`open r`))) (term_tac (have_gen_tac [](move ["open_r"])))); ((((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONTINUOUS_OPEN_PREIMAGE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_OPEN")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "open_t")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "DIFFERENTIABLE_IMP_CONTINUOUS_ON") (thm_tac apply_tac)) THEN ((((use_arg_then "differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (move ["y"]) THEN (move ["ys"])) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((use_arg_then "DIFFERENTIABLE_AT_WITHIN")(thm_tac (new_rewrite [] [])))); ((((fun arg_tac -> (use_arg_then "d2s") (fun fst_arg -> (use_arg_then "ys") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s'"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["ys'"])))); ((((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "ys'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN BETA_TAC THEN (simp_tac)) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`(\x. (nth_derivative 2 u (f x) * partial j f x) * partial i f x + derivative u (f x) * partial2 j i f x)`))) (term_tac exists_tac)) THEN ((use_arg_then "r") (term_tac exists_tac))); ((THENL_ROT (-1)) (((((use_arg_then "open_r")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "r_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "LIFT_IN_IMAGE_LIFT")(thm_tac (new_rewrite [] []))))) THEN (split_tac))); (BETA_TAC THEN (move ["y"]) THEN (case THEN (move ["z"])) THEN (case THEN ALL_TAC) THEN (case THEN (move ["zs"])) THEN (move ["fzt"]) THEN (move ["yz"])); (((((use_arg_then "second_partial_uni_compose")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "yz")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2s")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "d2t")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_LAST) (split_tac) (((use_arg_then "x") (term_tac exists_tac)) THEN (done_tac))); (((((use_arg_then "REAL_CONTINUOUS_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_CONTINUOUS_MUL")(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((fun arg_tac ->(use_arg_then "diff2_imp_partial_cont")(fun tmp_arg1 -> (use_arg_then "d2s")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(gsym_then (thm_tac (new_rewrite [] [(`nth_derivative 2 u _1`)])))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(thm_tac (new_rewrite [] [])))); ((((use_arg_then "o_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_imp_cont")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2s")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_CONTINUOUS_ATREAL_WITHINREAL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "p2ij")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(gsym_then (thm_tac (new_rewrite [] [(`derivative u _`)])))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(thm_tac (new_rewrite [] [])))); ((((use_arg_then "o_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_imp_cont")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2s")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_CONTINUOUS_ATREAL_WITHINREAL")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "nth_derivative1")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "nth_derivative_continuous") (thm_tac apply_tac))); ((THENL_LAST) (((fun arg_tac -> arg_tac (Arg_term (`2`))) (term_tac exists_tac)) THEN (split_tac)) ((arith_tac) THEN (done_tac))); ((((fun arg_tac -> (use_arg_then "d2t") (fun fst_arg -> (use_arg_then "fxt") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["t'"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["fxt'"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma real_open_delete *) let real_open_delete = section_proof ["s";"x"] `real_open s ==> real_open (s DELETE x)` [ ((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN")(thm_tac (new_rewrite [] []))))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "OPEN_DELETE") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`lift x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC))); (((((use_arg_then "IMAGE_DELETE_INJ_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "LIFT_EQ")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2c_inv_compose *) let diff2c_inv_compose = section_proof ["f"] `~(f x = &0) ==> diff2c f x ==> diff2c (inv o f) x` [ ((BETA_TAC THEN (move ["fn0"]) THEN (move ["d2f"])) THEN (((use_arg_then "diff2c_uni_compose")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (use_arg_then "diff2_inv") (fun fst_arg -> (use_arg_then "fn0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); (((use_arg_then "real_cont_atreal_local") (disch_tac [])) THEN (clear_assumption "real_cont_atreal_local") THEN (DISCH_THEN apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`\x. &2 * inv (x pow 3)`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`UNIV DELETE (&0)`))) (term_tac exists_tac))); ((THENL_ROT (-1)) (((((use_arg_then "real_open_delete")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_OPEN_UNIV")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "IN_DELETE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_UNIV")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "fn0")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (split_tac))); ((BETA_TAC THEN (move ["y"]) THEN (move ["yn0"])) THEN (((use_arg_then "second_derivative_inv")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((((use_arg_then "REAL_CONTINUOUS_LMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_INV_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_POW")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_CONTINUOUS_AT_ID")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "REAL_POW_NZ")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma diff2c_sqrt_compose *) let diff2c_sqrt_compose = section_proof ["f"] `&0 < f x ==> diff2c f x ==> diff2c (sqrt o f) x` [ ((BETA_TAC THEN (move ["fn0"]) THEN (move ["d2f"])) THEN (((use_arg_then "diff2c_uni_compose")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (use_arg_then "diff2_sqrt") (fun fst_arg -> (use_arg_then "fn0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); (((use_arg_then "real_cont_atreal_local") (disch_tac [])) THEN (clear_assumption "real_cont_atreal_local") THEN (DISCH_THEN apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`\x. -- inv (&4 * sqrt (x pow 3))`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`{x | x > &0}`))) (term_tac exists_tac))); ((THENL_ROT (-1)) (((((use_arg_then "REAL_OPEN_HALFSPACE_GT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "real_gt")(thm_tac (new_rewrite [] [])))))) THEN (split_tac))); ((BETA_TAC THEN (move ["y"]) THEN (case THEN (move ["z"])) THEN (case THEN (move ["z0"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "second_derivative_sqrt")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((THENL_LAST) (split_tac) (((fun arg_tac -> arg_tac (Arg_term (`f x`))) (term_tac exists_tac)) THEN (done_tac))); ((THENL_ROT (-1)) ((((use_arg_then "REAL_CONTINUOUS_NEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_INV_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_LMUL")(thm_tac (new_rewrite [] [])))))); ((THENL_FIRST) (((((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_or")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)) ((arith_tac) THEN (done_tac))); ((((use_arg_then "SQRT_EQ_0_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_POW_NZ")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_POS_NZ")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_POW_LE")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "fn0") (disch_tac [])) THEN (clear_assumption "fn0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\x. sqrt (x pow 3)) = (sqrt o (\x. x pow 3))`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "FUN_EQ_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "REAL_CONTINUOUS_ATREAL_COMPOSE")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "REAL_CONTINUOUS_POW")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_CONTINUOUS_AT_ID")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_CONTINUOUS_AT_SQRT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_POW_LT")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_atn_compose *) let diff2c_atn_compose = section_proof ["f"] `diff2c f x ==> diff2c (atn o f) x` [ ((BETA_TAC THEN (move ["d2f"])) THEN (((use_arg_then "diff2c_uni_compose")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "diff2_atn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "second_derivative_atn")(thm_tac (new_rewrite [] []))))); ((repeat_tactic 1 9 (((use_arg_then "REAL_CONTINUOUS_MUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_CONTINUOUS_CONST")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_CONTINUOUS_AT_ID")(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac))); ((((use_arg_then "REAL_CONTINUOUS_POW")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_INV_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "REAL_CONTINUOUS_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_POW")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_CONTINUOUS_AT_ID")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((use_arg_then "REAL_RNEG_UNIQ")(thm_tac (new_rewrite [] [])))); ((fun arg_tac -> (use_arg_then "REAL_LE_POW_2") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); ((arith_tac) THEN (done_tac)); ];; (* Lemma diff2c_acs_compose *) let diff2c_acs_compose = section_proof ["f"] `abs (f x) < &1 ==> diff2c f x ==> diff2c (acs o f) x` [ ((BETA_TAC THEN (move ["fn1"]) THEN (move ["d2f"])) THEN (((use_arg_then "diff2c_uni_compose")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (use_arg_then "diff2_acs") (fun fst_arg -> (use_arg_then "fn1") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); (((use_arg_then "real_cont_atreal_local") (disch_tac [])) THEN (clear_assumption "real_cont_atreal_local") THEN (DISCH_THEN apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`\x. --(x / sqrt ((&1 - x * x) pow 3))`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`{x | x < &1} INTER {x | x > -- &1}`))) (term_tac exists_tac))); ((((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_OPEN_HALFSPACE_GT")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_OPEN_HALFSPACE_LT")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((THENL_ROT (-1)) (((repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "real_gt")(thm_tac (new_rewrite [] [])))))) THEN (split_tac))); ((BETA_TAC THEN (move ["y"]) THEN (case THEN ALL_TAC) THEN (case THEN (move ["a"])) THEN (case THEN (move ["a1"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (case THEN (move ["b"])) THEN (case THEN (move ["b1"])) THEN (move ["ab"])) THEN ((((use_arg_then "second_derivative_acs")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); ((((use_arg_then "a1") (disch_tac [])) THEN (clear_assumption "a1") THEN ((use_arg_then "b1") (disch_tac [])) THEN (clear_assumption "b1") THEN ((use_arg_then "ab") (disch_tac [])) THEN (clear_assumption "ab") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL_LAST) (split_tac) ((split_tac) THEN ((fun arg_tac -> arg_tac (Arg_term (`f x`))) (term_tac exists_tac)) THEN (((use_arg_then "fn1") (disch_tac [])) THEN (clear_assumption "fn1") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (((use_arg_then "REAL_CONTINUOUS_NEG")(thm_tac (new_rewrite [] [])))); ((use_arg_then "REAL_CONTINUOUS_DIV_ATREAL") (thm_tac apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`&0 < (&1 - f x * f x) pow 3`))) (term_tac (have_gen_tac [](move ["h"])))); (((use_arg_then "REAL_POW_LT")(thm_tac (new_rewrite [] [])))); ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. &1 - a * a = (&1 - a) * (&1 + a)`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_MUL")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "fn1") (disch_tac [])) THEN (clear_assumption "fn1") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL_ROT (-1)) (((((use_arg_then "REAL_CONTINUOUS_AT_ID")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (split_tac))); (((((use_arg_then "SQRT_EQ_0_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LE_LT")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_LT_IMP_NZ")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\x. sqrt ((&1 - x * x) pow 3)) = sqrt o (\x. (&1 - x * x) pow 3)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "FUN_EQ_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "REAL_CONTINUOUS_ATREAL_COMPOSE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_AT_SQRT")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((((use_arg_then "REAL_CONTINUOUS_POW")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_SUB")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_CONST")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_CONTINUOUS_MUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_CONTINUOUS_AT_ID")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section Composite *) let nth_diff_strong_eq_on_open = finalize_theorem nth_diff_strong_eq_on_open;; let diff2_imp_cont = finalize_theorem diff2_imp_cont;; let diff2_imp_partial_cont = finalize_theorem diff2_imp_partial_cont;; let diff2c_uni_compose = finalize_theorem diff2c_uni_compose;; let real_open_delete = finalize_theorem real_open_delete;; let diff2c_inv_compose = finalize_theorem diff2c_inv_compose;; let diff2c_sqrt_compose = finalize_theorem diff2c_sqrt_compose;; let diff2c_atn_compose = finalize_theorem diff2c_atn_compose;; let diff2c_acs_compose = finalize_theorem diff2c_acs_compose;; end_section "Composite";; (* Lemma diff2c_add *) let diff2c_add = section_proof ["f";"g"] `diff2c f x ==> diff2c g x ==> diff2c (\x. f x + g x) x` [ (((repeat_tactic 1 9 (((use_arg_then "diff2c")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN ((move ["d2f"]) THEN (move ["p2f"]))) THEN (case THEN ((move ["d2g"]) THEN (move ["p2g"])))) THEN (((((use_arg_then "diff2_add")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["j"]))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "p2g") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (fun arg_tac -> (use_arg_then "p2f") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["p2fij"]) THEN (move ["p2gij"]))); ((use_arg_then "real_cont_at_local") (thm_tac apply_tac)); ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["d2f"]))); ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["d2g"])); (((fun arg_tac -> arg_tac (Arg_term (`(\x. partial2 j i f x + partial2 j i g x)`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac))); ((THENL_FIRST) ((repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac)) THEN (((use_arg_then "REAL_CONTINUOUS_ADD")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac))); ((BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["yt"])))) THEN ((((use_arg_then "second_partial_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2c_sub *) let diff2c_sub = section_proof ["f";"g"] `diff2c f x ==> diff2c g x ==> diff2c (\x. f x - g x) x` [ ((BETA_TAC THEN (move ["d2f"]) THEN (move ["d2g"])) THEN ((((use_arg_then "real_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_add")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "diff2c_neg")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_mul *) let diff2c_mul = section_proof ["f";"g"] `diff2c f x ==> diff2c g x ==> diff2c (\x. f x * g x) x` [ (((repeat_tactic 1 9 (((use_arg_then "diff2c")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN ((move ["d2f"]) THEN (move ["p2f"]))) THEN (case THEN ((move ["d2g"]) THEN (move ["p2g"])))) THEN (((((use_arg_then "diff2_mul")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["j"]))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "p2g") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (fun arg_tac -> (use_arg_then "p2f") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "j") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["p2fij"]) THEN (move ["p2gij"]))); ((use_arg_then "real_cont_at_local") (thm_tac apply_tac)); ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["d2f"]))); ((((use_arg_then "diff2_eq_diff2_on_open")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["d2g"])); (((fun arg_tac -> arg_tac (Arg_term (`(\x. (partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x)`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac))); ((THENL_ROT (-1)) (((repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))) THEN (split_tac))); ((BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["yt"])))) THEN ((((use_arg_then "second_partial_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_CONTINUOUS_ADD")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_CONTINUOUS_MUL")(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((TRY done_tac))) THEN ((repeat_tactic 0 10 (((use_arg_then "p2gij")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "p2fij")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_imp_partial_cont")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_imp_cont")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section Point *) let diff2c_scale = finalize_theorem diff2c_scale;; let diff2c_neg = finalize_theorem diff2c_neg;; let nth_diff_strong_eq_on_open = finalize_theorem nth_diff_strong_eq_on_open;; let diff2_imp_cont = finalize_theorem diff2_imp_cont;; let diff2_imp_partial_cont = finalize_theorem diff2_imp_partial_cont;; let diff2c_uni_compose = finalize_theorem diff2c_uni_compose;; let real_open_delete = finalize_theorem real_open_delete;; let diff2c_inv_compose = finalize_theorem diff2c_inv_compose;; let diff2c_sqrt_compose = finalize_theorem diff2c_sqrt_compose;; let diff2c_atn_compose = finalize_theorem diff2c_atn_compose;; let diff2c_acs_compose = finalize_theorem diff2c_acs_compose;; let diff2c_add = finalize_theorem diff2c_add;; let diff2c_sub = finalize_theorem diff2c_sub;; let diff2c_mul = finalize_theorem diff2c_mul;; end_section "Point";; (* Section Domain *) begin_section "Domain";; (add_section_var (mk_var ("f", (`:real^N -> real`))); add_section_var (mk_var ("g", (`:real^N -> real`))));; (add_section_hyp "d2f" (`diff2c_domain domain f`));; (* Lemma diff2c_domain_scale *) let diff2c_domain_scale = section_proof ["c"] `diff2c_domain domain (\x. c * f x)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2c_scale")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_neg *) let diff2c_domain_neg = section_proof [] `diff2c_domain domain (\x. --f x)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2c_neg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_var (mk_var ("bounds", (`:real#real`))));; (* Lemma diff2c_domain_inv_compose *) let diff2c_domain_inv_compose = section_proof [] `m_bounded_on_int f domain bounds ==> interval_not_zero bounds ==> diff2c_domain domain (inv o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] [])))))) THEN (move ["d2f"]) THEN (move ["ineq"]) THEN (move ["n0"]) THEN (move ["x"]) THEN (move ["x_in"]))); (((((use_arg_then "diff2c_inv_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "interval_arith_not_zero") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "x_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_sqrt_compose *) let diff2c_domain_sqrt_compose = section_proof [] `m_bounded_on_int f domain bounds ==> interval_pos bounds ==> diff2c_domain domain (sqrt o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] [])))))) THEN (move ["d2f"]) THEN (move ["ineq"]) THEN (move ["n0"]) THEN (move ["x"]) THEN (move ["x_in"]))); (((((use_arg_then "diff2c_sqrt_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "interval_arith_pos") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "x_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_atn_compose *) let diff2c_domain_atn_compose = section_proof [] `diff2c_domain domain (atn o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2c_atn_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_acs_compose *) let diff2c_domain_acs_compose = section_proof [] `m_bounded_on_int f domain bounds ==> iabs bounds < &1 ==> diff2c_domain domain (acs o f)` [ ((((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN (((((use_arg_then "m_bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] [])))))) THEN (move ["d2f"]) THEN (move ["ineq"]) THEN (move ["n0"]) THEN (move ["x"]) THEN (move ["x_in"]))); (((((use_arg_then "diff2c_acs_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "interval_arith_abs") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "x_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_hyp "d2g" (`diff2c_domain domain g`));; (* Lemma diff2c_domain_add *) let diff2c_domain_add = section_proof [] `diff2c_domain domain (\x. f x + g x)` [ ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["d2g"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2c_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_sub *) let diff2c_domain_sub = section_proof [] `diff2c_domain domain (\x. f x - g x)` [ ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["d2g"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2c_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_mul *) let diff2c_domain_mul = section_proof [] `diff2c_domain domain (\x. f x * g x)` [ ((((use_arg_then "d2g") (disch_tac [])) THEN (clear_assumption "d2g") THEN ((use_arg_then "d2f") (disch_tac [])) THEN (clear_assumption "d2f") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] []))))) THEN (move ["d2f"]) THEN (move ["d2g"]) THEN (move ["x"]) THEN (move ["x_in"])) THEN ((((use_arg_then "diff2c_mul")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d2f")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Finalization of the section Domain *) let diff2c_domain_scale = finalize_theorem diff2c_domain_scale;; let diff2c_domain_neg = finalize_theorem diff2c_domain_neg;; let diff2c_domain_inv_compose = finalize_theorem diff2c_domain_inv_compose;; let diff2c_domain_sqrt_compose = finalize_theorem diff2c_domain_sqrt_compose;; let diff2c_domain_atn_compose = finalize_theorem diff2c_domain_atn_compose;; let diff2c_domain_acs_compose = finalize_theorem diff2c_domain_acs_compose;; let diff2c_domain_add = finalize_theorem diff2c_domain_add;; let diff2c_domain_sub = finalize_theorem diff2c_domain_sub;; let diff2c_domain_mul = finalize_theorem diff2c_domain_mul;; end_section "Domain";; (* Finalization of the section Diff2c *) let real_cont_at_local = finalize_theorem real_cont_at_local;; let real_cont_atreal_local = finalize_theorem real_cont_atreal_local;; let diff2c_scale = finalize_theorem diff2c_scale;; let diff2c_neg = finalize_theorem diff2c_neg;; let nth_diff_strong_eq_on_open = finalize_theorem nth_diff_strong_eq_on_open;; let diff2_imp_cont = finalize_theorem diff2_imp_cont;; let diff2_imp_partial_cont = finalize_theorem diff2_imp_partial_cont;; let diff2c_uni_compose = finalize_theorem diff2c_uni_compose;; let real_open_delete = finalize_theorem real_open_delete;; let diff2c_inv_compose = finalize_theorem diff2c_inv_compose;; let diff2c_sqrt_compose = finalize_theorem diff2c_sqrt_compose;; let diff2c_atn_compose = finalize_theorem diff2c_atn_compose;; let diff2c_acs_compose = finalize_theorem diff2c_acs_compose;; let diff2c_add = finalize_theorem diff2c_add;; let diff2c_sub = finalize_theorem diff2c_sub;; let diff2c_mul = finalize_theorem diff2c_mul;; let diff2c_domain_scale = finalize_theorem diff2c_domain_scale;; let diff2c_domain_neg = finalize_theorem diff2c_domain_neg;; let diff2c_domain_inv_compose = finalize_theorem diff2c_domain_inv_compose;; let diff2c_domain_sqrt_compose = finalize_theorem diff2c_domain_sqrt_compose;; let diff2c_domain_atn_compose = finalize_theorem diff2c_domain_atn_compose;; let diff2c_domain_acs_compose = finalize_theorem diff2c_domain_acs_compose;; let diff2c_domain_add = finalize_theorem diff2c_domain_add;; let diff2c_domain_sub = finalize_theorem diff2c_domain_sub;; let diff2c_domain_mul = finalize_theorem diff2c_domain_mul;; end_section "Diff2c";; (* Section M_LinApprox *) begin_section "M_LinApprox";; (add_section_var (mk_var ("f", (`:real^N -> real`))); add_section_var (mk_var ("g", (`:real^N -> real`))));; (add_section_var (mk_var ("bounds", (`:real#real`))));; (add_section_var (mk_var ("d_bounds_list", (`:(real#real)list`))));; (add_section_var (mk_var ("x", (`:real^N`))));; (* Lemma m_lin_approx_neg *) let m_lin_approx_neg = section_proof [] `(lift o f) differentiable at x ==> interval_arith (--f x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (--partial i f x) int) ==> m_lin_approx (\x. --f x) x bounds d_bounds_list` [ (BETA_TAC THEN (move ["df"]) THEN (move ["b"]) THEN (move ["db"])); ((THENL_FIRST) ((((use_arg_then "m_lin_approx")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "b")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_neg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_NEG")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac))); ((ASM_SIMP_TAC[partial_neg]) THEN (done_tac)); ];; (* Lemma m_lin_approx_scale *) let m_lin_approx_scale = section_proof ["c"] `(lift o f) differentiable at x ==> interval_arith (c * f x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (c * partial i f x) int) ==> m_lin_approx (\x. c * f x) x bounds d_bounds_list` [ (BETA_TAC THEN (move ["df"]) THEN (move ["bH"]) THEN (move ["dbH"])); ((THENL_FIRST) ((((use_arg_then "m_lin_approx")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "bH")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_scale")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_CMUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac))); ((ASM_SIMP_TAC[partial_scale]) THEN (done_tac)); ];; (* Lemma m_lin_approx_add *) let m_lin_approx_add = section_proof [] `(lift o f) differentiable at x ==> (lift o g) differentiable at x ==> interval_arith (f x + g x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f x + partial i g x) int) ==> m_lin_approx (\x. f x + g x) x bounds d_bounds_list` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["bH"]) THEN (move ["dbH"])); ((THENL_FIRST) ((((use_arg_then "m_lin_approx")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "bH")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_add")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac))); ((ASM_SIMP_TAC[partial_add]) THEN (done_tac)); ];; (* Lemma m_lin_approx_sub *) let m_lin_approx_sub = section_proof [] `(lift o f) differentiable at x ==> (lift o g) differentiable at x ==> interval_arith (f x - g x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f x - partial i g x) int) ==> m_lin_approx (\x. f x - g x) x bounds d_bounds_list` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["bH"]) THEN (move ["dbH"])); ((THENL_FIRST) ((((use_arg_then "m_lin_approx")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "bH")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "f_lift_sub")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "DIFFERENTIABLE_SUB")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac))); ((ASM_SIMP_TAC[partial_sub]) THEN (done_tac)); ];; (* Lemma m_lin_approx_mul *) let m_lin_approx_mul = section_proof [] `(lift o f) differentiable at x ==> (lift o g) differentiable at x ==> interval_arith (f x * g x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f x * g x + f x * partial i g x) int) ==> m_lin_approx (\x. f x * g x) x bounds d_bounds_list` [ (BETA_TAC THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["bH"]) THEN (move ["dbH"])); ((((use_arg_then "m_lin_approx")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "bH")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "differentiable_mul")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((ASM_SIMP_TAC[partial_mul]) THEN (done_tac)); ];; (* Finalization of the section M_LinApprox *) let m_lin_approx_neg = finalize_theorem m_lin_approx_neg;; let m_lin_approx_scale = finalize_theorem m_lin_approx_scale;; let m_lin_approx_add = finalize_theorem m_lin_approx_add;; let m_lin_approx_sub = finalize_theorem m_lin_approx_sub;; let m_lin_approx_mul = finalize_theorem m_lin_approx_mul;; end_section "M_LinApprox";; let second_bounded = new_definition `second_bounded f domain dd_bounds_list <=> !x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x) int))`;; let m_taylor_interval = new_definition `m_taylor_interval f domain y w f_bounds d_bounds_list dd_bounds_list <=> m_cell_domain domain y w /\ diff2c_domain domain f /\ m_lin_approx f y f_bounds d_bounds_list /\ second_bounded f domain dd_bounds_list`;; (* Section M_TaylorIntervalArith *) begin_section "M_TaylorIntervalArith";; (add_section_var (mk_var ("f", (`:real^N -> real`))); add_section_var (mk_var ("g", (`:real^N -> real`))));; (add_section_var (mk_var ("x", (`:real^N`))); add_section_var (mk_var ("z", (`:real^N`))); add_section_var (mk_var ("y", (`:real^N`))); add_section_var (mk_var ("w", (`:real^N`))));; (add_section_var (mk_var ("domain", (`:real^N#real^N`))));; (add_section_var (mk_var ("f_bounds", (`:real#real`))); add_section_var (mk_var ("g_bounds", (`:real#real`))); add_section_var (mk_var ("bounds", (`:real#real`))));; (add_section_var (mk_var ("df_bounds_list", (`:(real#real)list`))); add_section_var (mk_var ("dg_bounds_list", (`:(real#real)list`))); add_section_var (mk_var ("d_bounds_list", (`:(real#real)list`))));; (add_section_var (mk_var ("ddf_bounds_list", (`:((real#real)list)list`))); add_section_var (mk_var ("ddg_bounds_list", (`:((real#real)list)list`))); add_section_var (mk_var ("dd_bounds_list", (`:((real#real)list)list`))));; (add_section_hyp "domainH" (`m_cell_domain domain y w`));; (add_section_hyp "d2f" (`diff2c_domain domain f`));; (* Lemma m_taylor_inv_compose *) let m_taylor_inv_compose = section_proof [] `m_bounded_on_int f domain f_bounds ==> interval_not_zero f_bounds ==> m_lin_approx (inv o f) y bounds d_bounds_list ==> second_bounded (inv o f) domain dd_bounds_list ==> m_taylor_interval (inv o f) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["bf"]) THEN (move ["fn0"]) THEN (move ["lin"]) THEN (move ["second"])) THEN (((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "diff2c_domain_inv_compose") (fun fst_arg -> (use_arg_then "d2f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "bf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma m_taylor_sqrt_compose *) let m_taylor_sqrt_compose = section_proof [] `m_bounded_on_int f domain f_bounds ==> interval_pos f_bounds ==> m_lin_approx (sqrt o f) y bounds d_bounds_list ==> second_bounded (sqrt o f) domain dd_bounds_list ==> m_taylor_interval (sqrt o f) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["bf"]) THEN (move ["fn0"]) THEN (move ["lin"]) THEN (move ["second"])) THEN (((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "diff2c_domain_sqrt_compose") (fun fst_arg -> (use_arg_then "d2f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "bf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma m_taylor_atn_compose *) let m_taylor_atn_compose = section_proof [] `m_lin_approx (atn o f) y bounds d_bounds_list ==> second_bounded (atn o f) domain dd_bounds_list ==> m_taylor_interval (atn o f) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["lin"]) THEN (move ["second"])) THEN ((((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_domain_atn_compose")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_acs_compose *) let m_taylor_acs_compose = section_proof [] `m_bounded_on_int f domain f_bounds ==> iabs f_bounds < &1 ==> m_lin_approx (acs o f) y bounds d_bounds_list ==> second_bounded (acs o f) domain dd_bounds_list ==> m_taylor_interval (acs o f) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["bf"]) THEN (move ["fn0"]) THEN (move ["lin"]) THEN (move ["second"])) THEN (((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "diff2c_domain_acs_compose") (fun fst_arg -> (use_arg_then "d2f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "bf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma m_taylor_neg *) let m_taylor_neg = section_proof [] `m_lin_approx (\x. --f x) y bounds d_bounds_list ==> second_bounded (\x. --f x) domain dd_bounds_list ==> m_taylor_interval (\x. --f x) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["lin"]) THEN (move ["second"])) THEN ((((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_domain_neg")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_scale *) let m_taylor_scale = section_proof ["c"] `m_lin_approx (\x. c * f x) y bounds d_bounds_list ==> second_bounded (\x. c * f x) domain dd_bounds_list ==> m_taylor_interval (\x. c * f x) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["lin"]) THEN (move ["second"])) THEN ((((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_domain_scale")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_hyp "d2g" (`diff2c_domain domain g`));; (* Lemma m_taylor_add *) let m_taylor_add = section_proof [] `m_lin_approx (\x. f x + g x) y bounds d_bounds_list ==> second_bounded (\x. f x + g x) domain dd_bounds_list ==> m_taylor_interval (\x. f x + g x) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["lin"]) THEN (move ["second"])) THEN ((((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_domain_add")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_sub *) let m_taylor_sub = section_proof [] `m_lin_approx (\x. f x - g x) y bounds d_bounds_list ==> second_bounded (\x. f x - g x) domain dd_bounds_list ==> m_taylor_interval (\x. f x - g x) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["lin"]) THEN (move ["second"])) THEN ((((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_domain_sub")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma m_taylor_mul *) let m_taylor_mul = section_proof [] `m_lin_approx (\x. f x * g x) y bounds d_bounds_list ==> second_bounded (\x. f x * g x) domain dd_bounds_list ==> m_taylor_interval (\x. f x * g x) domain y w bounds d_bounds_list dd_bounds_list` [ ((BETA_TAC THEN (move ["lin"]) THEN (move ["second"])) THEN ((((use_arg_then "m_taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_domain_mul")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section M_TaylorIntervalArith *) let m_taylor_inv_compose = finalize_theorem m_taylor_inv_compose;; let m_taylor_sqrt_compose = finalize_theorem m_taylor_sqrt_compose;; let m_taylor_atn_compose = finalize_theorem m_taylor_atn_compose;; let m_taylor_acs_compose = finalize_theorem m_taylor_acs_compose;; let m_taylor_neg = finalize_theorem m_taylor_neg;; let m_taylor_scale = finalize_theorem m_taylor_scale;; let m_taylor_add = finalize_theorem m_taylor_add;; let m_taylor_sub = finalize_theorem m_taylor_sub;; let m_taylor_mul = finalize_theorem m_taylor_mul;; end_section "M_TaylorIntervalArith";; (* Section PartialConvex *) begin_section "PartialConvex";; (add_section_type (mk_var ("f", (`:real^N->real`))));; (* Lemma REAL_LE_DIV_1 *) let REAL_LE_DIV_1 = section_proof ["a";"b"] `&0 < b ==> (a / b <= &1 <=> a <= b)` [ ((BETA_TAC THEN (move ["b_gt"])) THEN ((((use_arg_then "REAL_LE_LDIV_EQ")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial_convex_max *) let partial_convex_max = section_proof ["f";"j";"x";"z";"u";"v";"hi"] `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i /\ v$i = x$i) ==> u$j = x$j ==> v$j = z$j ==> diff2_domain (x,z) f ==> (!y. y IN interval [x,z] ==> &0 <= partial2 j j f y) ==> (!y. y IN interval [x,u] ==> f y <= hi) ==> (!y. y IN interval [v,z] ==> f y <= hi) ==> (!y. y IN interval [x,z] ==> f y <= hi)` [ ((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["uv_eq"]) THEN (move ["ux_eq"]) THEN (move ["vz_eq"])); ((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (move ["diff2_f"]) THEN (move ["partial2_pos"]) THEN (move ["bound1"]) THEN (move ["bound2"]) THEN (move ["y"]) THEN (move ["y_in"])); ((fun arg_tac -> arg_tac (Arg_term (`(lambda i. if i = j then x$j else y$i):real^N`))) (term_tac (set_tac "y1"))); ((fun arg_tac -> arg_tac (Arg_term (`(lambda i. if i = j then z$j else y$i):real^N`))) (term_tac (set_tac "y2"))); ((((use_arg_then "y_in") (disch_tac [])) THEN (clear_assumption "y_in") THEN BETA_TAC) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] [])))) THEN (move ["y_in"]))); ((fun arg_tac -> arg_tac (Arg_term (`y1 IN interval [x,u] /\ y2 IN interval [v,z]`))) (term_tac (have_gen_tac [](case THEN ((move ["y1_in"]) THEN (move ["y2_in"])))))); ((((use_arg_then "y1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "y2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] [])))))); (((split_tac) THEN (move ["i"]) THEN (move ["i_ineq"])) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`i = j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["ij"])) THEN ((repeat_tactic 0 10 (((fun arg_tac ->(use_arg_then "ux_eq")(fun tmp_arg1 -> (use_arg_then "vz_eq")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN ((((use_arg_then "uv_eq")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "y_in")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`j IN 1..dimindex (:N)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case)) THEN ((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["j_in"]))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`y1 = y`))) (term_tac (have_gen_tac []ALL_TAC)))) ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "bound1") (disch_tac [])) THEN (clear_assumption "bound1") THEN (DISCH_THEN apply_tac)) THEN (done_tac))); ((((use_arg_then "CART_EQ")(thm_tac (new_rewrite [] [])))) THEN (move ["i"]) THEN (move ["i_in"])); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`~(i = j)`))) (term_tac (have_gen_tac [](move ["inj"])))) ((((use_arg_then "i_in") (disch_tac [])) THEN (clear_assumption "i_in") THEN ((use_arg_then "j_in") (disch_tac [])) THEN (clear_assumption "j_in") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (((((use_arg_then "y1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`f y <= max (f y1) (f y2)`))) (term_tac (have_gen_tac []ALL_TAC)))); (BETA_TAC THEN (move ["cond"])); (((fun arg_tac -> (fun arg_tac -> arg_tac (Arg_theorem (REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS))) (fun fst_arg -> (use_arg_then "cond") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); ((((fun arg_tac -> (use_arg_then "bound2") (fun fst_arg -> (use_arg_then "y2_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (use_arg_then "bound1") (fun fst_arg -> (use_arg_then "y1_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`f o (\t. y1 + t % basis j)`))) (term_tac (set_tac "g"))); ((fun arg_tac -> arg_tac (Arg_term (`f y1 = g (&0)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_ADD_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`y = y1 + (y$j - x$j) % basis j /\ y2 = y1 + (z$j - x$j) % basis j`))) (term_tac (have_gen_tac [](move ["y_eq"])))); ((repeat_tactic 1 9 (((use_arg_then "CART_EQ")(thm_tac (new_rewrite [] []))))) THEN ((split_tac) THEN (move ["i"]) THEN (move ["i_in"])) THEN ((((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`i = j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["ij"])) THEN ((repeat_tactic 0 10 (((fun arg_tac ->(use_arg_then "y1_def")(fun tmp_arg1 -> (use_arg_then "y2_def")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac)) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_SUB_ADD2")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((((use_arg_then "ij")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (arith_tac) THEN (done_tac)); (((((use_arg_then "ij")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (arith_tac) THEN (done_tac)); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`f y = g (y$j - x$j)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "y_eq")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`f y2 = g (z$j - x$j)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "y_eq")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac))); (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`z$j = x$j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (move ["zx_j"])); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`y$j = x$j`))) (term_tac (have_gen_tac []ALL_TAC)))) ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "zx_j")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_SUB_REFL")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac))); ((((fun arg_tac -> (use_arg_then "y_in") (fun fst_arg -> (use_arg_then "j_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((use_arg_then "zx_j")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(y$j - x$j) / (z$j - x$j)`))) (term_tac (set_tac "t"))); ((fun arg_tac -> arg_tac (Arg_term (`&0 < z$j - x$j`))) (term_tac (have_gen_tac [](move ["zx_pos"])))); ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b. &0 < a - b <=> ~(a = b) /\ b <= a`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "zx_j")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`y$j`))) (term_tac exists_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "y_in")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`&0 <= t /\ t <= &1 /\ y$j - x$j = (&1 - t) * &0 + t * (z$j - x$j)`))) (term_tac (have_gen_tac [](move ["t_props"])))); ((((use_arg_then "t_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_DIV_1")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_RZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ADD_LID")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_MUL_ASSOC)))(gsym_then (thm_tac (new_rewrite [] [])))))); ((((use_arg_then "REAL_MUL_LINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_SUB_0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((repeat_tactic 1 9 (((use_arg_then "real_sub")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_RADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "y_in")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "real_sub")(gsym_then (thm_tac (new_rewrite [] []))))))); ((THENL_FIRST) ((((use_arg_then "REAL_LE_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_INV")(thm_tac (new_rewrite [] []))))) ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. &0 < a ==> &0 <= a`)))(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (((((use_arg_then "REAL_SUB_LE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "y_in")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "t_props")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONVEX_LOWER))) (disch_tac [])) THEN (DISCH_THEN apply_tac))); ((fun arg_tac -> arg_tac (Arg_term (`real_interval [&0, z$j - x$j]`))) (term_tac exists_tac)); ((((use_arg_then "REAL_SUB_ADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_SUB_LE")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "t_props")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)); ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. &0 < a ==> &0 <= a`)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))); (((fun arg_tac -> arg_tac (Arg_term (`real_interval _`))) (term_tac (set_tac "s"))) THEN (((use_arg_then "t_props") (disch_tac [])) THEN (clear_assumption "t_props") THEN ((use_arg_then "t_def") (disch_tac [])) THEN (clear_assumption "t_def") THEN BETA_TAC THEN (move ["_"]) THEN (move ["_"]))); ((fun arg_tac -> arg_tac (Arg_term (`!t. t IN s ==> y1 + t % basis j IN interval [x,z]`))) (term_tac (have_gen_tac [](move ["in_s"])))); (((((use_arg_then "s_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL IN_INTERVAL)))(thm_tac (new_rewrite [] []))))) THEN (move ["t"]) THEN (move ["t_ineq"]) THEN (move ["i"]) THEN (move ["i_ineq"])); ((repeat_tactic 1 9 (((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "y1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL LAMBDA_BETA)))(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`i = j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["ij"]))); (((((use_arg_then "REAL_MUL_RZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "y_in")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN ((fun arg_tac -> (use_arg_then "y_in") (fun fst_arg -> (use_arg_then "i_ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((use_arg_then "ij")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!t. t IN s ==> nth_diff_strong 2 g t`))) (term_tac (have_gen_tac [](move ["diff2_g"])))); ((BETA_TAC THEN (move ["t"]) THEN (move ["ts"])) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "diff2_dir")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_f")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "in_s")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!t. t IN s ==> derivative g t = partial j f (y1 + t % basis j)`))) (term_tac (have_gen_tac [](move ["dg"])))); ((BETA_TAC THEN (move ["t"]) THEN (move ["ts"])) THEN (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (use_arg_then "in_s") (fun fst_arg -> (use_arg_then "ts") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (move ["p_in"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`f o _`))) (term_tac (set_tac "h")))); ((fun arg_tac -> arg_tac (Arg_term (`h = g o (\t'. t + t')`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "h_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["r"])) THEN ((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (simp_tac))); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_RDISTRIB)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL VECTOR_ADD_ASSOC)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "derivative_translation")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((fun arg_tac -> (use_arg_then "diff2_g") (fun fst_arg -> (use_arg_then "ts") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["e"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["te"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!t. t IN s ==> nth_derivative 2 g t = partial2 j j f (y1 + t % basis j)`))) (term_tac (have_gen_tac [](move ["d2g"])))); ((BETA_TAC THEN (move ["t"]) THEN (move ["ts"])) THEN ((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "diff2_dir_derivative2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "in_s")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); ((fun arg_tac -> arg_tac (Arg_term (`1..dimindex (:N) = ((1..dimindex (:N)) DELETE j) UNION {j}`))) (term_tac (have_gen_tac [](move ["s_eq"])))); ((((((use_arg_then "EXTENSION")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_UNION")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_SING")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_DELETE")(thm_tac (new_rewrite [] []))))) THEN (move ["i"])) THEN (split_tac)); ((BETA_TAC THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "orNb")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((case THEN (simp_tac)) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`DISJOINT ((1..dimindex (:N)) DELETE j) {j}`))) (term_tac (have_gen_tac [](move ["disj"])))); (((((use_arg_then "DISJOINT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "EXTENSION")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_SING")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NOT_IN_EMPTY")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_DELETE")(thm_tac (new_rewrite [] []))))) THEN (move ["i"])); (((((use_arg_then "andbA")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andNb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbF")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "s_eq")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "SUM_UNION")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_DELETE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_SING")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "SUM_SING")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((((use_arg_then "SUM_EQ_0")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_DELETE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_ADD_LID")(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_in"])) THEN (((use_arg_then "SUM_EQ_0") (thm_tac apply_tac)) THEN (move ["k"]) THEN (move ["k_in"]) THEN (simp_tac))); (((((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_NUMSEG")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac)) THEN (((use_arg_then "i_in")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "REAL_MUL_LZERO")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "s_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_UNION")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_DELETE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_SING")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "SUM_SING")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((((use_arg_then "SUM_EQ_0")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_DELETE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_ADD_LID")(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_in"]) THEN (simp_tac)) THEN (((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (DISJ2_TAC)); (((((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_NUMSEG")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac)) THEN (((use_arg_then "i_in")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "REAL_MUL_LZERO")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "j_in")(thm_tac (new_rewrite [] []))))) THEN ((simp_tac THEN TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_CONVEX_ON_SECOND_DERIVATIVE") (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative g`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`nth_derivative 2 g`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); ((THENL_ROT (-1)) (((((use_arg_then "s_def")(gsym_then (thm_tac (new_rewrite [1; 2] []))))) THEN (((use_arg_then "IS_REALINTERVAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NOT_EXISTS_THM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["t"]) THEN (move ["ts"])) THEN ((((use_arg_then "d2g")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "partial2_pos")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "in_s")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (split_tac); ((BETA_TAC THEN (move ["t"])) THEN (((use_arg_then "contraT") (disch_tac [])) THEN (clear_assumption "contraT") THEN (DISCH_THEN apply_tac)) THEN (((((use_arg_then "negbK")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "EXTENSION")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_SING")(thm_tac (new_rewrite [] []))))) THEN (move ["eq"]))); ((((use_arg_then "zx_pos") (disch_tac [])) THEN (clear_assumption "zx_pos") THEN ((fun arg_tac -> (use_arg_then "eq") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`z$j - x$j`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (use_arg_then "eq") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))))); ((arith_tac) THEN (done_tac)); ((split_tac) THEN (move ["t"]) THEN (move ["ts"])); ((((fun arg_tac -> (use_arg_then "diff2_g") (fun fst_arg -> (use_arg_then "ts") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "nth_diff_strong2_eq_alt")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["e"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["te"])) THEN (move ["H"]))); (((((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "H")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((fun arg_tac -> (use_arg_then "diff2_g") (fun fst_arg -> (use_arg_then "ts") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "nth_diff_strong2_eq_alt")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["e"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["te"])) THEN (move ["H"]))); (((((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "H")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section PartialConvex *) let REAL_LE_DIV_1 = finalize_theorem REAL_LE_DIV_1;; let partial_convex_max = finalize_theorem partial_convex_max;; end_section "PartialConvex";; (* Section ElementaryFunctions *) begin_section "ElementaryFunctions";; (* Lemma f_lift_const *) let f_lift_const = section_proof ["c"] `lift o (\x. c) = (\x. lift c)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma f_lift_unary *) let f_lift_unary = section_proof ["f"] `lift o (\x. f x) = (\x. lift (f x))` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_const *) let diff2_const = section_proof ["c";"x"] `diff2 (\x:real^N. c) x` [ ((((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> arg_tac (Arg_term (`(:real^N)`))) (term_tac exists_tac)) THEN (((((use_arg_then "OPEN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (move ["_"]))); (((((use_arg_then "partial_const")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "f_lift_const")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2_domain_const *) let diff2_domain_const = section_proof ["c";"domain"] `diff2_domain domain (\x:real^N. c)` [ (((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_const")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial2_const *) let partial2_const = section_proof ["i";"j";"c"] `partial2 i j (\x:real^N. c) = (\x. &0)` [ (((((use_arg_then "partial2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "partial_const")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma diff2c_const *) let diff2c_const = section_proof ["c";"x"] `diff2c (\x:real^N. c) x` [ (((((use_arg_then "diff2c")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_const")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "partial2_const")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_CONTINUOUS_CONST")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_const *) let diff2c_domain_const = section_proof ["c";"domain"] `diff2c_domain domain (\x:real^N. c)` [ (((((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2c_const")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma partial_x_lemma *) let partial_x_lemma = section_proof ["k";"i"] `partial i (\x:real^N. x$k) = (\x. (basis i:real^N)$k)` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial")(thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (simp_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\x. x$k) o (\t. x + t % basis i) = (\t. x$k + t * (basis i:real^N)$k)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "VECTOR_ADD_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "VECTOR_MUL_COMPONENT")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "derivative_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "derivative_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "derivative_x")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_const")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma partial_x *) let partial_x = section_proof ["k";"i"] `k IN 1..dimindex (:N) ==> partial i (\x:real^N. x$k) = (\x. if i = k then &1 else &0)` [ ((BETA_TAC THEN (move ["k_ineq"])) THEN ((((use_arg_then "partial_x_lemma")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "BASIS_COMPONENT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_NUMSEG")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma partial2_x *) let partial2_x = section_proof ["k";"i";"j"] `partial2 i j (\x:real^N. x$k) = (\x. &0)` [ (((((use_arg_then "partial2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "partial_x_lemma")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "partial_const")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_x *) let diff2_x = section_proof ["k";"x"] `k IN 1..dimindex (:N) ==> diff2 (\x:real^N. x$k) x` [ ((BETA_TAC THEN (move ["k_ineq"])) THEN (((use_arg_then "diff2")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> arg_tac (Arg_term (`(:real^N)`))) (term_tac exists_tac)) THEN (((((use_arg_then "OPEN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (move ["_"]))); (((((use_arg_then "projection_diff")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "partial_x_lemma")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "f_lift_unary")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_domain_x *) let diff2_domain_x = section_proof ["k";"domain"] `k IN 1..dimindex (:N) ==> diff2_domain domain (\x:real^N. x$k)` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "diff2_x") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN ((((use_arg_then "diff2_domain")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_x *) let diff2c_x = section_proof ["k";"x"] `k IN 1..dimindex (:N) ==> diff2c (\x:real^N. x$k) x` [ ((BETA_TAC THEN (move ["k_ineq"])) THEN ((((use_arg_then "diff2c")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_x")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); (((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL REAL_CONTINUOUS_CONTINUOUS1)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "partial2_x")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_CONTINUOUS_CONST")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2c_domain_x *) let diff2c_domain_x = section_proof ["k";"domain"] `k IN 1..dimindex (:N) ==> diff2c_domain domain (\x:real^N. x$k)` [ (((DISCH_THEN (fun snd_th -> (use_arg_then "diff2c_x") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC) THEN ((((use_arg_then "diff2c_domain")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section ElementaryFunctions *) let f_lift_const = finalize_theorem f_lift_const;; let f_lift_unary = finalize_theorem f_lift_unary;; let diff2_const = finalize_theorem diff2_const;; let diff2_domain_const = finalize_theorem diff2_domain_const;; let partial2_const = finalize_theorem partial2_const;; let diff2c_const = finalize_theorem diff2c_const;; let diff2c_domain_const = finalize_theorem diff2c_domain_const;; let partial_x_lemma = finalize_theorem partial_x_lemma;; let partial_x = finalize_theorem partial_x;; let partial2_x = finalize_theorem partial2_x;; let diff2_x = finalize_theorem diff2_x;; let diff2_domain_x = finalize_theorem diff2_domain_x;; let diff2c_x = finalize_theorem diff2c_x;; let diff2c_domain_x = finalize_theorem diff2c_domain_x;; end_section "ElementaryFunctions";; hol-light/Formal_ineqs/taylor/theory/multivariate_taylor.vhl000066400000000000000000003144661303454263000250410ustar00rootroot00000000000000(* =========================================================== *) (* Theory of multivariate taylor intervals *) (* Requires SSReflect/HOL Light for translation *) (* See http://code.google.com/p/flyspeck/downloads/list *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) "needs \"lib/ssrbool-compiled.hl\"". "needs \"lib/ssrnat-compiled.hl\"". "needs \"taylor/theory/taylor_interval-compiled.hl\"". "prioritize_overload `:real^N`". "prioritize_real()". "let partial = new_definition `partial i f x = derivative (f o (\t. (x:real^N) + t % basis i)) (&0)`". "let all_n = define `(all_n n [] s <=> T) /\ (all_n n (CONS h t) s <=> s n h /\ all_n (SUC n) t s)`". "let m_lin_approx = new_definition `m_lin_approx (f:real^N->real) x f_bounds df_bounds_list <=> (lift o f) differentiable at x /\ interval_arith (f x) f_bounds /\ all_n 1 df_bounds_list (\i int. interval_arith (partial i f x) int)`". Section Misc. Lemma f_lift_neg f : `lift o (\x. --f x) = (\x. --(lift o f) x)`. by rewrite -eq_ext !o_THM /= LIFT_NEG. Qed. Lemma f_lift_scale f c : `lift o (\x. c * f x) = (\x. c % (lift o f) x)`. by rewrite -eq_ext !o_THM /= LIFT_CMUL. Qed. Lemma f_lift_add f g : `lift o (\x. f x + g x) = (\x. (lift o f) x + (lift o g) x)`. by rewrite -eq_ext !o_THM /= LIFT_ADD. Qed. Lemma f_lift_sub f g : `lift o (\x. f x - g x) = (\x. (lift o f) x - (lift o g) x)`. by rewrite -eq_ext !o_THM /= LIFT_SUB. Qed. Lemma f_binary_drop op f g : `(\t. op (f t) (g t)) o drop = (\x. op (f (drop x)) (g (drop x)))`. by rewrite -eq_ext !o_THM. Qed. Lemma f_unary_drop op f : `(\t. op (f t)) o drop = (\x. op (f (drop x)))`. by rewrite -eq_ext !o_THM. Qed. Section MoreFrechet. Variables f g : `:real^N -> real^M`. Variables x y : `:real^N`. Lemma frechet_compose f g x : `f differentiable at (g x) ==> g differentiable at x ==> frechet_derivative (f o g) (at x) = frechet_derivative f (at (g x)) o frechet_derivative g (at x)`. move => df dg; rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT. by apply DIFF_CHAIN_AT; rewrite -!FRECHET_DERIVATIVE_WORKS. Qed. Lemma frechet_const z : `frechet_derivative (\x. y) (at z) = (\x. vec 0)`. by rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; rewrite HAS_DERIVATIVE_CONST. Qed. Lemma frechet_id : `frechet_derivative (\x. x) (at y) = (\x. x)`. by rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; rewrite HAS_DERIVATIVE_ID. Qed. Lemma frechet_vmul z : `frechet_derivative (\x. drop x % y) (at z) = (\x. drop x % y)`. rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; apply HAS_DERIVATIVE_VMUL_DROP. rewrite HAS_DERIVATIVE_ID. Qed. Hypothesis df : `f differentiable at x`. Lemma frechet_neg : `frechet_derivative (\x. --f x) (at x) = (\y. --frechet_derivative f (at x) y)`. rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; apply HAS_DERIVATIVE_NEG. by rewr ETA_AX; rewrite -FRECHET_DERIVATIVE_WORKS. Qed. Lemma frechet_scale c : `frechet_derivative (\x. c % f x) (at x) = (\y. c % frechet_derivative f (at x) y)`. rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; apply HAS_DERIVATIVE_CMUL. by rewr ETA_AX; rewrite -FRECHET_DERIVATIVE_WORKS. Qed. Hypothesis dg : `g differentiable at x`. Lemma frechet_add : `frechet_derivative (\x. f x + g x) (at x) = (\y. frechet_derivative f (at x) y + frechet_derivative g (at x) y)`. rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; apply HAS_DERIVATIVE_ADD. by rewr ETA_AX; rewrite -!FRECHET_DERIVATIVE_WORKS. Qed. Lemma frechet_sub : `frechet_derivative (\x. f x - g x) (at x) = (\y. frechet_derivative f (at x) y - frechet_derivative g (at x) y)`. rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT; apply HAS_DERIVATIVE_SUB. by rewr ETA_AX; rewrite -!FRECHET_DERIVATIVE_WORKS. Qed. End MoreFrechet. Lemma differentiable_compose_at f g x : `f differentiable at (g x) ==> g differentiable at x ==> (f o g) differentiable at x`. move => df dg; rewrite FRECHET_DERIVATIVE_WORKS. by rewrite frechet_compose //; apply DIFF_CHAIN_AT; rewrite -!FRECHET_DERIVATIVE_WORKS. Qed. Lemma jacobian_compose f g x : `f differentiable at (g x) ==> g differentiable at x ==> jacobian (f o g) (at x) = jacobian f (at (g x)) ** jacobian g (at x)`. move => df dg. by rewrite !jacobian frechet_compose // MATRIX_COMPOSE // !LINEAR_FRECHET_DERIVATIVE. Qed. Lemma frechet_eq_jacobian f x : `f differentiable at x ==> frechet_derivative f (at x) = (\h. jacobian f (at x) ** h)`. move => df. by rewrite EQ_SYM_EQ FRECHET_DERIVATIVE_AT // -JACOBIAN_WORKS. Qed. (* Product *) Section Product. Lemma REAL_LET_MUL2 w x y z: `&0 < w /\ w <= x /\ &0 <= y /\ y < z ==> w * y < x * z`. move => ineq. case: (EXCLUDED_MIDDLE `w = x`) => [w_eq_x | wnx]. by rewrite -w_eq_x REAL_LT_LMUL. by rewrite REAL_LT_MUL2; move: ineq wnx; arith. Qed. Lemma has_derivative_x12 y : `(lift o (\x:real^2. x$1 * x$2) has_derivative lift o (\x. y$2 * x$1 + y$1 * x$2)) (at y)`. rewrite has_derivative_at; split. rewrite linear !o_THM /= !VECTOR_ADD_COMPONENT !VECTOR_MUL_COMPONENT !LIFT_ADD !LIFT_CMUL !LIFT_ADD. by "VECTOR_ARITH_TAC". rewrite !o_THM /= -LIFT_ADD -LIFT_SUB -LIFT_CMUL. rewrite LIM_AT /= !dist "GEN_ALL VECTOR_SUB_RZERO" NORM_LIFT !VECTOR_SUB_COMPONENT => e e0. rewrite "REAL_ARITH `(x:real^2)$1 * x$2 - ((y:real^2)$1 * y$2 + y$2 * (x$1 - y$1) + y$1 * (x$2 - y$2)) = (x$2 - y$2) * (x$1 - y$1)`". exists e; rewrite e0 andTb => x [norm0 norm_e]. rewrite !REAL_ABS_MUL REAL_ABS_INV REAL_ABS_NORM. rewrite -!VECTOR_SUB_COMPONENT; set p := `x - y:real^2`. have ineq := (NORM_BOUND_COMPONENT_LT norm_e). apply: REAL_LTE_TRANS; exists `inv (infnorm p) * infnorm p * e`. have infnorm_0: `&0 < infnorm p`; first by rewrite INFNORM_POS_LT -NORM_POS_LT. split; last first. by rewrite REAL_MUL_ASSOC REAL_MUL_LINV ?REAL_MUL_LID ?REAL_LE_REFL // INFNORM_EQ_0 -NORM_POS_LT. rewrite REAL_LET_MUL2 REAL_LT_INV // REAL_LE_INV2 ?INFNORM_LE_NORM // !andTb. rewrite REAL_LE_MUL ?REAL_ABS_POS // andTb. have: `infnorm p = abs (p$1) \/ infnorm p = abs (p$2)`. by rewrite "GEN_ALL INFNORM_2"; arith. by case => <-; first rewrite REAL_MUL_SYM; rewrite REAL_LT_LMUL ineq // DIMINDEX_2; arith. Qed. Lemma lambda_eq_vsum f : `(\x:A. lambda i. f i x) = (\x. vsum (1..dimindex (:N)) (\i. f i x % (basis i:real^N)))`. rewrite -eq_ext /= => x. rewrite CART_EQ => i ineq; rewrite "GEN_ALL LAMBDA_BETA" // VSUM_COMPONENT //=. set A := `1.. _`; set B := `A DIFF {i}`. have cond: `DISJOINT B {i} /\ A = B UNION {i}`. rewrite DISJOINT !EXTENSION -B_def -A_def IN_INTER IN_DIFF IN_SING NOT_IN_EMPTY /=. split => x; first by rewrite !negb_and negbK -orbA EXCLUDED_MIDDLE. rewrite IN_UNION IN_DIFF IN_SING. by case: (EXCLUDED_MIDDLE `x = i`) => -> //; rewrite /= IN_NUMSEG. rewrite cond SUM_UNION ?cond -B_def ?FINITE_DIFF -?A_def ?FINITE_NUMSEG ?FINITE_SING //. rewrite SUM_SING /= !VECTOR_MUL_COMPONENT (BASIS_COMPONENT i i) //=. rewrite "REAL_ARITH `!a b. a = b + a * &1 <=> b = &0`" SUM_EQ_0 // => j. rewrite IN_DIFF IN_SING => ineq_j /=; rewrite BASIS_COMPONENT // (EQ_SYM_EQ i). by rewrite ineq_j /= REAL_MUL_RZERO. Qed. Lemma has_derivative_lambda f f' y : `(!i. i IN 1..dimindex (:M) ==> (lift o (f i) has_derivative lift o (f' i)) (at (y:real^N))) ==> (((\x. lambda i. f i x):real^N->real^M) has_derivative (\x. lambda i. f' i x) ) (at y)`. Proof. move => df; rewrite !lambda_eq_vsum; apply HAS_DERIVATIVE_VSUM. rewrite FINITE_NUMSEG andTb => i ineq /=. have eq: `!f. (\x:real^N. f i x % (basis i:real^M)) = (\x. drop ((lift o f i) x) % basis i)`. by move => g; rewrite -eq_ext /= o_THM LIFT_DROP. by rewrite (eq f) (eq f') "GEN_ALL HAS_DERIVATIVE_VMUL_DROP"; rewr ETA_AX; rewrite df. Qed. Lemma vector2_eq_lambda x y : `(vector [x; y]:real^2) = (lambda i. if i = 1 then x else y)`. Proof. rewrite CART_EQ DIMINDEX_2 => i; rewrite "ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`". by case => {1 3}->; rewrite "GEN_ALL VECTOR_2" "GEN_ALL LAMBDA_BETA" /= ?DIMINDEX_2; arith. Qed. Lemma has_derivative_vector2 f g f' g' y : `(lift o f has_derivative lift o f') (at y) ==> (lift o g has_derivative lift o g') (at y) ==> ((\x. vector [f x; g x]:real^2) has_derivative (\x. vector [f' x; g' x]:real^2)) (at y)`. Proof. move => df dg; rewrite !vector2_eq_lambda. apply has_derivative_lambda; rewrite DIMINDEX_2 IN_NUMSEG => i. rewrite "ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`"; case => {2 4}-> /=; rewr ETA_AX //. by rewrite "ARITH_RULE `~(2 = 1)`" /=; rewr ETA_AX. Qed. Lemma has_derivative_mul f g f' g' y : `(lift o f has_derivative lift o f') (at y) ==> (lift o g has_derivative lift o g') (at y) ==> (lift o (\x. f x * g x) has_derivative lift o (\x. f' x * g y + f y * g' x)) (at y)`. move => df dg. have ->: `lift o (\x. f x * g x) = (lift o (\p. p$1 * p$2)) o (\x. vector [f x; g x]:real^2)`. by rewrite -eq_ext !o_THM /= => x; rewrite !"GEN_ALL VECTOR_2". set q := `vector [f y; g y]:real^2`. have ->: `lift o (\x. f' x * g y + f y * g' x) = (lift o (\x:real^2. q$2 * x$1 + q$1 * x$2)) o (\x. vector [f' x; g' x])`. by rewrite -eq_ext !o_THM /= -q_def !"GEN_ALL VECTOR_2" REAL_MUL_SYM. by apply DIFF_CHAIN_AT => /=; rewrite q_def has_derivative_x12 has_derivative_vector2. Qed. Lemma f_eq_lift_drop f : `f = lift o (drop o f)`. Proof. by rewrite -eq_ext !o_THM LIFT_DROP. Qed. Lemma differentiable_mul f g y : `lift o f differentiable (at y) ==> lift o g differentiable (at y) ==> lift o (\x. f x * g x) differentiable (at y)`. rewrite 2!differentiable => [] [f'] df [g'] dg. move: df dg; rewrite (f_eq_lift_drop f') (f_eq_lift_drop g') => df dg. have := has_derivative_mul df dg. by apply HAS_DERIVATIVE_IMP_DIFFERENTIABLE. Qed. Lemma frechet_mul f g y : `lift o f differentiable at y ==> lift o g differentiable at y ==> frechet_derivative (lift o (\x. f x * g x)) (at y) = (\x. g y % frechet_derivative (lift o f) (at y) x + f y % frechet_derivative (lift o g) (at y) x)`. rewrite !FRECHET_DERIVATIVE_WORKS [`frechet_derivative _1 _2`]f_eq_lift_drop => df. rewrite [`frechet_derivative _1 _2`]f_eq_lift_drop => dg. have := has_derivative_mul df dg; move/FRECHET_DERIVATIVE_AT => <-. rewrite -eq_ext !o_THM /= !LIFT_DROP => x. by rewrite LIFT_ADD REAL_MUL_SYM !LIFT_CMUL !LIFT_DROP. Qed. End Product. End Misc. (* Properties of partial derivatives *) Section Partial. Lemma real_derivative_compose_frechet f h t : `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> ((f o h) has_real_derivative (drop o (frechet_derivative (lift o f) (at (h t)) o frechet_derivative (h o drop) (at (lift t))) o lift) (&1)) (atreal t)`. move => diff_f diff_h. move: (diff_f) (diff_h); rewrite !FRECHET_DERIVATIVE_WORKS. set f' := `frechet_derivative _1 _2`. set h' := `frechet_derivative _1 _2`. move => df dh. rewrite "GEN_ALL HAS_REAL_FRECHET_DERIVATIVE_AT". have ->: `lift o (f o h) o drop = (lift o f) o (h o drop)`; first by rewrite !o_ASSOC. suff ->: `(\x. (drop o (f' o h') o lift) (&1) % x) = f' o h'`. by rewrite DIFF_CHAIN_AT dh o_THM LIFT_DROP df. rewrite -eq_ext !o_THM => x /=. have lin: `linear f' /\ linear h'`. by rewrite -h'_def -f'_def !LINEAR_FRECHET_DERIVATIVE. have {2}->: `x = drop x % lift (&1)`. by rewrite -DROP_EQ DROP_CMUL LIFT_DROP REAL_MUL_RID. by rewrite !LINEAR_CMUL // -DROP_EQ !DROP_CMUL REAL_MUL_SYM. Qed. Lemma real_derivative_compose_jacobian f h t : `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> ((f o h) has_real_derivative (jacobian (lift o f) (at (h t)) ** jacobian (h o drop) (at (lift t)))$1$1) (atreal t)`. move => df dh. move: (real_derivative_compose_frechet df dh). rewrite !frechet_eq_jacobian // !o_THM /=. rewrite MATRIX_VECTOR_MUL_ASSOC matrix_vector_mul DROP_LAMBDA DIMINDEX_1 SUM_SING_NUMSEG /=. by rewrite LIFT_COMPONENT REAL_MUL_RID. Qed. Lemma diff_imp_real_diff f h t : `(lift o f) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> (f o h) real_differentiable atreal t`. move => diff_f diff_h. move: (real_derivative_compose_frechet diff_f diff_h). set fh' := `(drop o _ o lift) (&1)`. by rewrite real_differentiable => dfh; exists fh'. Qed. Lemma diff_direction y e net : `((\t. y + t % e) o drop) differentiable net`. have ->: `(\t. y + t % e) o drop = (\x. y + drop x % e)`; first by rewrite -eq_ext o_THM. rewrite DIFFERENTIABLE_ADD DIFFERENTIABLE_CONST andTb. apply HAS_DERIVATIVE_IMP_DIFFERENTIABLE. by exists `\x. drop x % e`; apply HAS_DERIVATIVE_VMUL_DROP; rewrite HAS_DERIVATIVE_ID. Qed. Lemma frechet_direction y e t : `frechet_derivative ((\t. y + t % e) o drop) (at (lift t)) = (\x. drop x % e)`. rewrite f_unary_drop frechet_add. rewrite DIFFERENTIABLE_CONST andTb; apply HAS_DERIVATIVE_IMP_DIFFERENTIABLE. exists `\x. drop x % e`; apply HAS_DERIVATIVE_VMUL_DROP; rewrite HAS_DERIVATIVE_ID. by rewrite frechet_vmul frechet_const /= VECTOR_ADD_LID. Qed. Lemma real_dir_derivative_frechet f y e t : `(lift o f) differentiable at (y + t % e) ==> ((f o (\t. y + t % e)) has_real_derivative (drop (frechet_derivative (lift o f) (at (y + t % e)) e))) (atreal t)`. move => df. move: (real_derivative_compose_frechet f `\t. y + t % e` t). by rewrite df diff_direction /= frechet_direction !o_THM /= LIFT_DROP VECTOR_MUL_LID. Qed. Lemma real_dir_derivative_jacobian f y e t : `(lift o f) differentiable at (y + t % e) ==> ((f o (\t. y + t % e)) has_real_derivative drop (jacobian (lift o f) (at (y + t % e)) ** e)) (atreal t)`. move => df. move: (real_dir_derivative_frechet f e df). by rewrite frechet_eq_jacobian. Qed. Lemma partial_eq_frechet f y i : `(lift o f) differentiable at (y:real^N) ==> partial i f y = drop (frechet_derivative (lift o f) (at y) (basis i))`. move => df; rewrite partial. move: (real_dir_derivative_frechet f y `basis i:real^N` `&0`); rewrite VECTOR_MUL_LZERO VECTOR_ADD_RID. by move => /(_ df) /derivative_unique. Qed. Lemma partial_eq_jacobian f y i : `(lift o f) differentiable at y ==> partial i f y = drop (jacobian (lift o f) (at y) ** basis i)`. move => df. by move: (df); rewrite partial_eq_frechet // JACOBIAN_WORKS => /FRECHET_DERIVATIVE_AT <-. Qed. Lemma partial_eq_jacobian_column f y i : `(lift o (f:real^N->real)) differentiable at y ==> i IN 1..dimindex (:N) ==> partial i f y = drop (column i (jacobian (lift o f) (at y)))`. rewrite IN_NUMSEG => df ineq. by rewrite partial_eq_jacobian // MATRIX_VECTOR_MUL_BASIS. Qed. Lemma partial_eq_jacobian_entry f y i : `(lift o (f:real^N->real)) differentiable at y ==> i IN 1..dimindex (:N) ==> partial i f y = (jacobian (lift o f) (at y))$1$i`. by move => df ineq; rewrite partial_eq_jacobian_column // column DROP_LAMBDA. Qed. Variable y : `:real^N`. Variable i : `:num`. Lemma partial_eq0 f : `~(i IN 1..dimindex (:N)) ==> partial i f y = &0`. move => ineq; rewrite partial. have ->: `basis i = (vec 0):real^N`; first by rewrite BASIS_EQ_0. (* TODO: rewrite doesn't work *) rewr VECTOR_MUL_RZERO VECTOR_ADD_RID. have ->: `derivative (f o (\t. y)) = derivative (\t. f y)`. by "AP_TERM_TAC"; rewrite -eq_ext o_THM. by rewrite derivative_const. Qed. Lemma derivative_compose f g x : `f real_differentiable atreal (g x) ==> g real_differentiable atreal x ==> derivative (f o g) x = derivative f (g x) * derivative g x`. move => df dg. have ->: `f o g = \x. f (g x)`; first by rewrite -eq_ext o_THM. by rewrite derivative_composition // REAL_MUL_SYM. Qed. Lemma projection_has_derivative i net : `i IN 1..dimindex (:N) ==> (lift o (\x:real^N. x$i) has_derivative lift o (\x. x$i)) net`. rewrite IN_NUMSEG => ineq. have ->: `lift o (\x:real^N. x$i) = (\x. x$i % vec 1)`. by rewrite -eq_ext o_THM /= => x; rewrite -DROP_EQ LIFT_DROP DROP_CMUL DROP_VEC REAL_MUL_RID. by rewrite "GEN_ALL HAS_DERIVATIVE_VMUL_COMPONENT" HAS_DERIVATIVE_ID. Qed. Lemma projection_diff i net : `i IN 1..dimindex (:N) ==> (lift o (\x:real^N. x$i)) differentiable net`. rewrite differentiable => /(projection_has_derivative i net) h. by exists `lift o \x:real^N. x$i`. Qed. Lemma frechet_projection i x : `i IN 1..dimindex (:N) ==> frechet_derivative (lift o (\x:real^N. x$i)) (at x) = lift o (\x:real^N. x$i)`. move => ineq; rewrite EQ_SYM_EQ; apply FRECHET_DERIVATIVE_AT. by rewrite projection_has_derivative. Qed. Lemma has_derivative_vector_frechet h t i : `i IN 1..dimindex (:N) ==> (h o drop) differentiable at (lift t) ==> ((\s. (h:real->real^N) s$i) has_real_derivative (frechet_derivative (h o drop) (at (lift t)) (lift (&1)))$i) (atreal t)`. move => ineq dh. have ->: `(\s. h s$i) = (\x. x$i) o h`; first by rewrite -eq_ext o_THM. move: (real_derivative_compose_frechet `\x:real^N. x$i` h t). rewrite dh projection_diff //=. set lhs := `(drop o _ o lift) (&1)`. set rhs := `(frechet_derivative _1 _2 _3)$i`. suff ->: `lhs = rhs`; first by done. by rewrite -lhs_def !o_THM /= frechet_projection // o_THM /= -rhs_def LIFT_DROP. Qed. Lemma has_derivative_vector_jacobian h t i : `i IN 1..dimindex (:N) ==> (h o drop) differentiable at (lift t) ==> ((\s. (h:real->real^N) s$i) has_real_derivative (jacobian (h o drop) (at (lift t)))$i$1) (atreal t)`. move => ineq dh. move: (has_derivative_vector_frechet ineq dh). set lhs := `(frechet_derivative _1 _2 _3)$i`. set rhs := `jacobian _1 _2$i$1`. suff ->: `lhs = rhs`; first by done. rewrite -lhs_def frechet_eq_jacobian //=. have ->: `lift (&1) = basis 1`. by rewrite -DROP_EQ LIFT_DROP basis DROP_LAMBDA. by rewrite MATRIX_VECTOR_MUL_BASIS ?DIMINDEX_GE_1 ?leqnn // column "GEN_ALL LAMBDA_BETA" -?IN_NUMSEG. Qed. Lemma derivative_vector_jacobian h t i : `i IN 1..dimindex (:N) ==> ((h:real->real^N) o drop) differentiable at (lift t) ==> derivative (\s. h s$i) t = jacobian (h o drop) (at (lift t))$i$1`. by move => ineq dh; apply derivative_unique; rewrite has_derivative_vector_jacobian. Qed. (* real_compose *) Lemma real_derivative_compose_partial f h t : `(lift o (f:real^N -> real)) differentiable at (h t) ==> (h o drop) differentiable at (lift t) ==> ((f o h) has_real_derivative sum (1..dimindex (:N)) (\i. partial i f (h t) * derivative (\s. h s$i) t)) (atreal t)`. move => df dh. move: (real_derivative_compose_jacobian df dh). set lhs := `_$1$1`; set rhs := `sum _ _2`. suff ->: `lhs = rhs`; first by done. rewrite -lhs_def. rewrite matrix_mul "GEN_ALL LAMBDA_BETA" ?DIMINDEX_GE_1 ?leqnn //=. rewrite "GEN_ALL LAMBDA_BETA" ?DIMINDEX_GE_1 ?leqnn //= -rhs_def. apply SUM_EQ => i ineq /=. by rewrite partial_eq_jacobian_entry // REAL_EQ_MUL_LCANCEL derivative_vector_jacobian. Qed. Lemma real_dir_derivative_partial f e t : `(lift o f) differentiable at (y + t % e) ==> ((f o (\t. y + t % e)) has_real_derivative sum (1..dimindex (:N)) (\i. e$i * (partial i f o (\t. y + t % e)) t)) (atreal t)`. move => df. move: (real_dir_derivative_jacobian f y e df). rewrite matrix_vector_mul DROP_LAMBDA. set lhs := `sum _1 _2`; set rhs := `sum _1 _2`. suff ->: `lhs = rhs`; first by done. rewrite -lhs_def -rhs_def; apply SUM_EQ => i ineq /=. by rewrite o_THM partial_eq_jacobian_entry //= REAL_MUL_SYM. Qed. Variables f g : `:real^N -> real`. Hypothesis df : `(lift o f) differentiable at y`. (* uni_compose *) Lemma partial_uni_compose u : `u real_differentiable atreal (f y) ==> partial i (u o f) y = derivative u (f y) * partial i f y`. move => du; rewrite !partial -o_ASSOC derivative_compose !o_THM /=. by rewrite diff_imp_real_diff /= VECTOR_MUL_LZERO VECTOR_ADD_RID // df diff_direction. by rewrite VECTOR_MUL_LZERO VECTOR_ADD_RID. Qed. (* neg *) Lemma partial_neg : `partial i (\x. --f x) y = --partial i f y`. by rewrite !partial_eq_frechet ?f_lift_neg ?DIFFERENTIABLE_NEG // ?frechet_neg; rewr !ETA_AX // DROP_NEG. Qed. (* scale *) Lemma partial_scale c : `partial i (\x. c * f x) y = c * partial i f y`. rewrite !partial_eq_frechet ?f_lift_scale ?DIFFERENTIABLE_CMUL // ?frechet_scale; rewr !ETA_AX //. by rewrite DROP_CMUL. Qed. Hypothesis dg : `(lift o g) differentiable at y`. (* add *) Lemma partial_add : `partial i (\x. f x + g x) y = partial i f y + partial i g y`. rewrite !partial_eq_frechet ?f_lift_add ?DIFFERENTIABLE_ADD // ?frechet_add; rewr !ETA_AX //. by rewrite DROP_ADD. Qed. (* sub *) Lemma partial_sub : `partial i (\x. f x - g x) y = partial i f y - partial i g y`. rewrite !partial_eq_frechet ?f_lift_sub ?DIFFERENTIABLE_SUB // ?frechet_sub; rewr !ETA_AX //. by rewrite DROP_SUB. Qed. (* mul *) Lemma partial_mul : `partial i (\x. f x * g x) y = partial i f y * g y + f y * partial i g y`. rewrite !partial; set h := `\t. y + t % basis i`. have ->: `(\x. f x * g x) o h = (\t. (f o h) t * (g o h) t)`. by rewrite -eq_ext !o_THM. rewrite derivative_mul; last first. rewrite -{1 4}h_def !o_THM /= VECTOR_MUL_LZERO VECTOR_ADD_RID -(o_THM f) -(o_THM g). by rewrite REAL_ADD_SYM; rewr ETA_AX. have h0: `h (&0) = y`; first by rewrite -h_def /= VECTOR_MUL_LZERO VECTOR_ADD_RID. have dh: `(h o drop) differentiable at (lift (&0))`; first by rewrite -h_def diff_direction. by rewr ETA_AX; rewrite !diff_imp_real_diff ?h0. Qed. End Partial. Section PartialMonotone. Lemma derivative_translation f x : `f real_differentiable atreal x ==> derivative f x = derivative (f o (\t. x + t)) (&0)`. move => diff_f. rewrite derivative_compose /= ?REAL_ADD_RID ?diff_f. by rewrite REAL_DIFFERENTIABLE_ADD ?REAL_DIFFERENTIABLE_CONST ?REAL_DIFFERENTIABLE_ID. rewrite derivative_add ?REAL_DIFFERENTIABLE_CONST ?REAL_DIFFERENTIABLE_ID //. by rewrite derivative_const derivative_x /=; arith. Qed. Implicit Type f : `:real^N->real`. Lemma partial_increasing_left f j u x z lo : `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> (!y. y IN interval [x,z] ==> &0 <= partial j f y) ==> (!y. y IN interval [x,u] ==> lo <= f y) ==> (!y. y IN interval [x,z] ==> lo <= f y)`. rewrite IN_NUMSEG !"GEN_ALL IN_INTERVAL" => uz_eq ux_eq diff_f partial_pos f_bound y y_in. move: diff_f partial_pos; rewrite -!"GEN_ALL IN_INTERVAL" => diff_f partial_pos. set y' := `(lambda i. if i = j then x$j else y$i):real^N`. suff: `f y' <= f y`. apply: "REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS"; apply: f_bound => i i_in. rewrite -y'_def "GEN_ALL LAMBDA_BETA" //=. case: (EXCLUDED_MIDDLE `i = j`) => /= ij; first by rewrite ux_eq REAL_LE_REFL. by rewrite uz_eq // !y_in. case: (EXCLUDED_MIDDLE `j IN 1..dimindex (:N)`); last first; rewrite IN_NUMSEG => j_in. suff: `y' = y`; first by move => ->; rewrite REAL_LE_REFL. rewrite CART_EQ => i i_in. have inj: `~(i = j)`; first by move: j_in i_in; arith. by rewrite -y'_def "GEN_ALL LAMBDA_BETA". set g := `f o (\t. y' + t % basis j)`. have ->: `f y' = g (&0)`. by rewrite -g_def o_THM /= VECTOR_MUL_LZERO VECTOR_ADD_RID. have ->: `f y = g (y$j - x$j)`. rewrite -g_def o_THM /=; "AP_TERM_TAC". rewrite CART_EQ => i i_in. rewrite VECTOR_ADD_COMPONENT VECTOR_MUL_COMPONENT BASIS_COMPONENT //. case: (EXCLUDED_MIDDLE `i = j`) => /= ij; rewrite -y'_def "GEN_ALL LAMBDA_BETA" //. by arith. by rewrite /= ij /=; arith. set s := `real_interval [&0, y$j - x$j]`. have in_s : `!t. t IN s ==> y' + t % basis j IN interval [x,z]`. rewrite -s_def IN_REAL_INTERVAL "GEN_ALL IN_INTERVAL" => t t_ineq i i_ineq. rewrite !VECTOR_ADD_COMPONENT VECTOR_MUL_COMPONENT BASIS_COMPONENT //. rewrite -y'_def "GEN_ALL LAMBDA_BETA" //=. case: (EXCLUDED_MIDDLE `i = j`) => /= ij; last first. by rewrite REAL_MUL_RZERO REAL_ADD_RID !y_in. by move: (y_in i_ineq) t_ineq; rewrite ij; arith. have ds : `!t. t IN s ==> (g has_real_derivative (partial j f (y' + t % basis j))) (atreal t within s)`. move => t /in_s p_in; apply: HAS_REAL_DERIVATIVE_ATREAL_WITHIN; rewrite partial. set h := `f o _`. have ->: `h = g o (\t'. t + t')`. rewrite -eq_ext -h_def -g_def => r; rewrite !o_THM /=. by rewrite "GEN_ALL VECTOR_ADD_RDISTRIB" "GEN_ALL VECTOR_ADD_ASSOC". by rewrite -derivative_translation ?has_derivative_alt -g_def diff_imp_real_diff; rewrite diff_f //= diff_direction. have pos: `&0 <= y$j - x$j`; first by move: (y_in j_in); arith. have := HAS_REAL_DERIVATIVE_INCREASING_IMP g `\t. partial j f (y' + t % basis j)` s `&0` `y$j - x$j`. rewrite -{1}s_def IS_REALINTERVAL_INTERVAL /=; rewr ds /=; apply. rewrite -{2 3}s_def !IN_REAL_INTERVAL pos !REAL_LE_REFL /=. by move => t /in_s /partial_pos. Qed. Lemma partial_decreasing_left f j u x z hi : `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> (!y. y IN interval [x,z] ==> partial j f y <= &0) ==> (!y. y IN interval [x,u] ==> f y <= hi) ==> (!y. y IN interval [x,z] ==> f y <= hi)`. move => u_eq_i u_eq_j diff_f partial_f f_bound y y_in. have := partial_increasing_left `(\p. -- f p)` j u x z `--hi` u_eq_i u_eq_j. "ANTS_TAC"; first by move => p /diff_f /DIFFERENTIABLE_NEG; rewrite f_lift_neg. "ANTS_TAC". by move => p p_in; rewrite partial_neg ?diff_f // REAL_NEG_GE0 partial_f. "ANTS_TAC"; first by move => p /f_bound; arith. by move/(_ y_in); arith. Qed. Lemma partial_translation f i p y: `lift o f differentiable at (p + y) ==> partial i (f o (\x. p + x)) y = partial i f (p + y)`. move => diff. have diff_p : `!net. (\x. p + x) differentiable net`. by move => net; rewrite DIFFERENTIABLE_ADD DIFFERENTIABLE_CONST DIFFERENTIABLE_ID. rewrite partial_eq_frechet 1?o_ASSOC ?DIFFERENTIABLE_CHAIN_AT //. rewrite frechet_compose // frechet_add ?DIFFERENTIABLE_ID ?DIFFERENTIABLE_CONST //. rewrite frechet_const frechet_id /= VECTOR_ADD_LID -I_DEF I_O_ID. by rewrite partial_eq_frechet. Qed. Lemma partial_rev_translation f i p y : `lift o f differentiable at (p - y) ==> partial i (f o (\x. p - x)) y = --partial i f (p - y)`. move => diff. have diff_p : `!net. (\x. p - x) differentiable net`. by move => net; rewrite DIFFERENTIABLE_SUB DIFFERENTIABLE_CONST DIFFERENTIABLE_ID. rewrite partial_eq_frechet 1?o_ASSOC ?DIFFERENTIABLE_CHAIN_AT //. rewrite frechet_compose // frechet_sub ?DIFFERENTIABLE_ID ?DIFFERENTIABLE_CONST //. rewrite frechet_const frechet_id /= "GEN_ALL VECTOR_SUB_LZERO". rewrite partial_eq_frechet // !o_THM /=. by rewrite LINEAR_NEG ?LINEAR_FRECHET_DERIVATIVE // DROP_NEG. Qed. Lemma partial_increasing_right f j u x z hi : `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i) ==> u$j = z$j ==> (!y. y IN interval [x,z] ==> (lift o f) differentiable at y) ==> (!y. y IN interval [x,z] ==> &0 <= partial j f y) ==> (!y. y IN interval [u,z] ==> f y <= hi) ==> (!y. y IN interval [x,z] ==> f y <= hi)`. move => u_eq_i u_eq_j diff_f partial_f f_bound y y_in. case: (EXCLUDED_MIDDLE `j IN 1..dimindex (:N)`); last first; rewrite IN_NUMSEG => j_in. apply: f_bound; move: y_in; rewrite !"GEN_ALL IN_INTERVAL" => y_ineq i i_in. have inj: `~(i = j)`; first by move: j_in i_in; arith. by rewrite u_eq_i ?IN_NUMSEG // !y_ineq. have := partial_decreasing_left `f o (\p:real^N. x + (z - p))` j `x + (z - u):real^N` x z hi. "ANTS_TAC". move => i /u_eq_i eq1 inj; rewrite VECTOR_ADD_COMPONENT VECTOR_SUB_COMPONENT. by rewrite eq1 //; arith. "ANTS_TAC"; first by rewrite VECTOR_ADD_COMPONENT VECTOR_SUB_COMPONENT u_eq_j; arith. have Hp : `!p. p IN interval [x,z] ==> x + (z - p) IN interval [x,z]`. move => p; rewrite !"GEN_ALL IN_INTERVAL" => p_in i ineq. by move: (p_in ineq); rewrite VECTOR_ADD_COMPONENT VECTOR_SUB_COMPONENT; arith. set dP := `!y. _ y`. have P: `dP`. rewrite -dP_def; move => p p_in. by rewrite o_ASSOC DIFFERENTIABLE_CHAIN_AT DIFFERENTIABLE_ADD ?DIFFERENTIABLE_SUB; rewrite ?DIFFERENTIABLE_ID ?DIFFERENTIABLE_CONST // diff_f //= Hp. move: P => /=; rewrite -dP_def => diff. "ANTS_TAC". move => p p_in. have assoc := "VECTOR_ARITH `!x z p. x + z - p = (x + z) - p:real^N`". rewrite assoc partial_rev_translation -assoc ?diff_f ?Hp //. by rewrite REAL_NEG_LE0 partial_f Hp. "ANTS_TAC". move => p p_in; rewrite o_THM /= f_bound. move: p_in; rewrite !"GEN_ALL IN_INTERVAL" => ineq i i_ineq. by move: (ineq i_ineq); rewrite !VECTOR_ADD_COMPONENT !VECTOR_SUB_COMPONENT; arith. move/(_ `x + z - y:real^N`); rewrite o_THM /=. rewrite "VECTOR_ARITH `!x z y:real^N. x + z - (x + z - y) = y`"; apply. by rewrite Hp. Qed. End PartialMonotone. (* Taylor *) Section Taylor. Lemma real_taylor2_bound f dd_bound: `nth_diff_strong_int 2 (&0, &1) f ==> (!t. interval_arith t (&0, &1) ==> abs (nth_derivative 2 f t) <= dd_bound) ==> abs (f (&1) - (f (&0) + derivative f (&0))) <= dd_bound / &2`. rewrite nth_diff_strong_int nth_diff_strong2_eq_alt => df dd. set R := `\i. if i = 0 then f else if i = 1 then derivative f else nth_derivative 2 f`. have arithH := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 0)`". move: (REAL_TAYLOR R `1` `real_interval [&0, &1]` dd_bound); "ANTS_TAC". rewrite IS_REALINTERVAL_INTERVAL andTb; split. move => i x; rewrite IN_REAL_INTERVAL -interval_arith "ARITH_RULE `i <= 1 <=> i = 0 \/ i = 1`". move => [] /df [s] d_f. by case => ->; rewrite -R_def /= !arithH /=; apply HAS_REAL_DERIVATIVE_ATREAL_WITHIN; rewrite d_f. move => x; rewrite IN_REAL_INTERVAL -interval_arith arithH => ineq. by move: (df ineq) => [s] d_f; rewrite -R_def /= !arithH /= dd. move/(_ `&0` `&1`); rewrite !IN_REAL_INTERVAL !REAL_LE_REFL REAL_LE_01 /=. rewrite REAL_SUB_RZERO REAL_ABS_1 !REAL_POW_ONE "ARITH_RULE `FACT (1 + 1) = 2`" !real_div !REAL_MUL_LID. rewrite {2}ONE "GEN_ALL SUM_CLAUSES_NUMSEG" SUM_SING_NUMSEG -ONE "ARITH_RULE `0 <= 1`" /=. rewrite !"ARITH_RULE `FACT 0 = 1 /\ FACT 1 = 1`" REAL_INV_1 !REAL_MUL_RID. by rewrite -R_def /= !arithH. Qed. Lemma real_taylor1_bound f d_bound: `(!t. interval_arith t (&0, &1) ==> f real_differentiable atreal t /\ abs (derivative f t) <= d_bound) ==> abs (f (&1) - f (&0)) <= d_bound`. move => df. set R := `\i. if i = 0 then f else derivative f`. have arithH := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0)`". move: (REAL_TAYLOR R `0` `real_interval [&0, &1]` d_bound); "ANTS_TAC". rewrite IS_REALINTERVAL_INTERVAL andTb; split. move => i x; rewrite IN_REAL_INTERVAL -interval_arith leqn0. move => [] /df [diff_f df_bound] ->. by rewrite -R_def /= !arithH /=; apply HAS_REAL_DERIVATIVE_ATREAL_WITHIN; rewrite has_derivative_alt. move => x; rewrite IN_REAL_INTERVAL -interval_arith arithH => ineq. by move: (df ineq) => [s] d_f; rewrite -R_def /= !arithH /= df. move/(_ `&0` `&1`); rewrite !IN_REAL_INTERVAL !REAL_LE_REFL REAL_LE_01 /=. rewrite SUM_SING_NUMSEG /= REAL_SUB_RZERO arithH REAL_ABS_1 !REAL_POW_ONE. rewrite !"ARITH_RULE `FACT 1 = 1 /\ FACT 0 = 1`" REAL_DIV_1 !REAL_MUL_RID. by rewrite -R_def /= !arithH. Qed. (* m_taylor_error *) "let m_taylor_error = new_definition `m_taylor_error f domain (w:real^N) error <=> !x:real^N. x IN interval [domain] ==> sum (1..dimindex (:N)) (\i. w$i * sum (1..dimindex (:N)) (\j. w$j * abs (partial j (partial i f) x))) <= error`". "let m_taylor_partial_error = new_definition `m_taylor_partial_error f i domain (w:real^N) error <=> (!x:real^N. x IN interval[domain] ==> sum (1..dimindex (:N)) (\j. w$j * abs (partial j (partial i f) x)) <= error)`". Lemma taylor_error_eq_sum_partial_errors f domain w p_error error : `(!i. i IN 1..dimindex (:N) ==> m_taylor_partial_error f i domain w (p_error i) /\ &0 <= w$i) ==> sum (1..dimindex (:N)) (\i. w$i * p_error i) <= error ==> m_taylor_error f domain (w:real^N) error`. rewrite m_taylor_partial_error m_taylor_error => partialH ineq p p_in. apply: "REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" ineq. apply SUM_LE; rewrite FINITE_NUMSEG andTb => i i_ineq /=. by rewrite REAL_LE_LMUL !(partialH i_ineq). Qed. (* diff2 definition *) "let partial2 = new_definition `partial2 j i f = partial j (partial i f)`". "let diff2 = new_definition `diff2 f x <=> ?s. open s /\ x IN s /\ (!y. y IN s ==> (lift o f) differentiable at y /\ (!i. (lift o partial i f) differentiable at y))`". "let diff2c = new_definition `diff2c f x <=> diff2 f x /\ (!i j. (lift o partial2 j i f) continuous at x)`". Lemma diff2c_imp_diff2 f x : `diff2c f x ==> diff2 f x`. by rewrite diff2c /=. Qed. Lemma diff2_eq_diff2_on_open f x : `diff2 f x <=> ?s. open s /\ x IN s /\ (!y. y IN s ==> diff2 f y)`. rewrite !diff2; split => [] [s] [open_s] [xs] df. by exists s; rewrite {1}open_s xs !andTb => y ys; exists s. move: (df xs) => [t] [open_t] [xt] df2; move: df => _. by exists t. Qed. Lemma diff2_imp_real_diff f x e t : `diff2 f (x + t % e) ==> f o (\t. x + t % e) real_differentiable atreal t`. rewrite diff2 => [] [s] [open_s] [xs] df. by apply diff_imp_real_diff; rewrite /= df // diff_direction. Qed. Lemma diff2_dir_derivative f x e t : `diff2 f (x + t % e:real^N) ==> derivative (f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\i. e$i * (partial i f o (\t. x + t % e)) t)`. rewrite diff2 => [] [s] [open_s] [xs] df. by apply: derivative_unique; rewrite real_dir_derivative_partial df. Qed. Lemma diff2_partial_real_diff f i x e t : `diff2 f (x + t % e:real^N) ==> partial i f o (\t. x + t % e) real_differentiable atreal t`. rewrite diff2 => [] [s] [open_s] [xs] df. by rewrite diff_imp_real_diff /= df // diff_direction. Qed. Lemma in_trans x s t : `t SUBSET s ==> x IN t ==> x IN s`. rewrite SUBSET => sub xt. exact: sub. Qed. Lemma open_contains_open_interval e s x : `open s ==> x IN s ==> ?a b. &0 IN real_interval (a, b) /\ IMAGE (\t. x + t % e) (real_interval (a, b)) SUBSET s`. rewrite OPEN_CONTAINS_BALL => open_s. move/open_s => [d] [d0] ball_s; move: open_s => _. case: (EXCLUDED_MIDDLE `norm e = &0`) => [|n0]. rewrite NORM_EQ_0 => ->; exists `--d` d. split; first by rewrite IN_REAL_INTERVAL; move: d0; arith. rewrite SUBSET IN_IMAGE => y [t] -> /=; rewrite "GEN_ALL VECTOR_MUL_RZERO" VECTOR_ADD_RID. by rewrite (in_trans ball_s) CENTRE_IN_BALL. set y := `((d / &2) * inv(norm e)) % e`. have norm_y : `norm y = d / &2`. rewrite -y_def -VECTOR_MUL_ASSOC !NORM_MUL REAL_ABS_INV REAL_ABS_NORM REAL_MUL_LINV //. by move: d0; arith. exists `-- (d / &2 * inv (norm e))` `d / &2 * inv (norm e)`; split. rewrite IN_REAL_INTERVAL REAL_NEG_LT0 andbb REAL_LT_MUL REAL_LT_INV ?NORM_POS_LT -?NORM_EQ_0 //. by move: d0; arith. apply SUBSET_TRANS; exists `ball (x, d)`; rewrite ball_s andbT SUBSET IN_IMAGE => p [t] [->] t_in /=. rewrite IN_BALL dist VECTOR_SUB_RADD NORM_NEG NORM_MUL. apply: REAL_LET_TRANS; exists `d / &2`; split; last by move: d0; arith. rewrite -(REAL_MUL_RID `d / &2`) -(REAL_MUL_LINV n0) REAL_MUL_ASSOC REAL_LE_RMUL NORM_POS_LE andbT. by move: t_in; rewrite IN_REAL_INTERVAL; arith. Qed. Lemma diff2_dir f x e t : `diff2 f (x + t % e:real^N) ==> nth_diff_strong 2 (f o (\t. x + t % e)) t`. Proof. rewrite diff2_eq_diff2_on_open nth_diff_strong2_eq => [] [s] [open_s] [xs] df. move: (open_contains_open_interval e open_s xs) => [a] [b] [in0] sub. exists `real_interval (a + t, b + t)`; rewrite REAL_OPEN_REAL_INTERVAL andTb; split. by move: in0; rewrite !IN_REAL_INTERVAL; arith. move => p p_int. have xp_in : `x + p % e IN s`. move: sub; rewrite SUBSET; apply; rewrite IN_IMAGE /=; exists `p - t`. by split; ["VECTOR_ARITH_TAC" | move: p_int; rewrite !IN_REAL_INTERVAL; arith]. rewrite diff2_imp_real_diff ?df // andTb. apply differentiable_local. exists `\t. sum (1..dimindex(:N)) (\i. e$i * (partial i f o (\t. x + t % e)) t)`. set d := `min (p - (a + t)) (b + t - p)`. have d0: `&0 < d`; first by move: p_int; rewrite -d_def IN_REAL_INTERVAL; arith. exists `real_interval (p - d, p + d)`; split. rewrite differentiable_sum_numseg => i ineq /=. rewrite REAL_DIFFERENTIABLE_MUL_ATREAL REAL_DIFFERENTIABLE_CONST andTb; rewr ETA_AX. by rewrite diff2_partial_real_diff df. rewrite REAL_OPEN_REAL_INTERVAL andTb; split. by rewrite IN_REAL_INTERVAL; move: d0; arith. move => y y_in; rewrite diff2_dir_derivative // df. move: sub; rewrite SUBSET; apply; rewrite IN_IMAGE /=; exists `y - t`. split; first by "VECTOR_ARITH_TAC". by move: y_in d_def p_int; rewrite !IN_REAL_INTERVAL; arith. Qed. Lemma diff2_dir_derivative2 f x e t : `diff2 f (x + t % e:real^N) ==> nth_derivative 2 (f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\i. sum (1..dimindex (:N)) (\j. e$i * e$j * (partial j (partial i f) o (\t. x + t % e)) t))`. Proof. rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] df. rewrite nth_derivative2; apply: derivative_unique. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `\t. sum (1..dimindex(:N)) (\i. e$i * (partial i f o (\t. x + t % e)) t)`; split. apply HAS_REAL_DERIVATIVE_SUM; rewrite FINITE_NUMSEG andTb => i ineq /=. rewrite SUM_LMUL HAS_REAL_DERIVATIVE_LMUL_ATREAL; rewr ETA_AX. rewrite real_dir_derivative_partial. by move: (df xs); rewrite diff2 => [] [r] [_] [xr] ->. move: (open_contains_open_interval e open_s xs) => [a] [b] [in0] sub. exists `real_interval (a + t, b + t)`; rewrite REAL_OPEN_REAL_INTERVAL andTb; split. by move: in0; rewrite !IN_REAL_INTERVAL; arith. move => p p_in; rewrite diff2_dir_derivative // df. move: sub; rewrite SUBSET; apply; rewrite IN_IMAGE /=; exists `p - t`. split; first by "VECTOR_ARITH_TAC". by move: p_in; rewrite !IN_REAL_INTERVAL; arith. Qed. Lemma diff2_has_derivative_partial f i x e t : `diff2 f (x + t % e:real^N) ==> (partial i f o (\t. x + t % e) has_real_derivative sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)) (atreal t)`. rewrite diff2 => [] [s] [open_s] [xs] df. by rewrite real_dir_derivative_partial df. Qed. Lemma diff2_derivative_partial f i x e t : `diff2 f (x + t % e:real^N) ==> derivative (partial i f o (\t. x + t % e)) t = sum (1..dimindex (:N)) (\j. e$j * (partial j (partial i f) o (\t. x + t % e)) t)`. by move => df; apply: derivative_unique; exact: diff2_has_derivative_partial. Qed. Lemma diff2_real_diff_partial f i x e t : `diff2 f (x + t % e:real^N) ==> partial i f o (\t. x + t % e) real_differentiable atreal t`. move => df2. move: (diff2_has_derivative_partial df2 i); set s := `sum _1 _2`. by rewrite real_differentiable => df; exists s. Qed. (* const *) Lemma partial_const i c : `partial i (\x:real^N. c) = (\x. &0)`. rewrite -eq_ext partial => x /=. suff ->: `(\x. c) o (\t. x + t % basis i) = (\x. c)`. by rewrite derivative_const. by rewrite -eq_ext o_THM. Qed. Lemma partial_eq0_alt i f : `~(i IN 1..dimindex (:N)) ==> partial i f = (\x:real^N. &0)`. Proof. by move => ih; rewrite FUN_EQ_THM => x; rewrite partial_eq0. Qed. Lemma real_mvt0 : `!f f' a. (!x. abs x <= abs a ==> (f has_real_derivative f' x) (atreal x)) ==> (?t. abs t <= abs a /\ f a - f (&0) = f' t * a)`. Proof. move => f f' a h. case: (EXCLUDED_MIDDLE `&0 <= a`) => a_ineq. have := REAL_MVT_VERY_SIMPLE f f' `&0` a. rewrite a_ineq andTb !IN_REAL_INTERVAL; "ANTS_TAC". move => x x_ineq. by rewrite HAS_REAL_DERIVATIVE_ATREAL_WITHIN h; move: x_ineq; arith. move => [t] [t_ineq] eq. by exists t; rewrite eq; move: t_ineq; arith. have := REAL_MVT_VERY_SIMPLE f f' a `&0`. rewrite !IN_REAL_INTERVAL; "ANTS_TAC". split; first by move: a_ineq; arith. move => x x_ineq; rewrite HAS_REAL_DERIVATIVE_ATREAL_WITHIN h. by move: x_ineq; arith. move => [t] [t_ineq] eq. by exists t; rewrite -REAL_NEG_SUB eq REAL_NEG_RMUL; move: t_ineq; arith. Qed. (* Mixed second partial derivatives are equal *) Lemma mixed_second_partials f x i j : `diff2c f x ==> partial2 i j f x = partial2 j i f (x:real^N)`. Proof. rewrite diff2c !partial2 => [] [d2f pc]. case: (EXCLUDED_MIDDLE `i IN 1..dimindex (:N)`) => ih; last first. by rewrite !(partial_eq0_alt i) // partial_const. case: (EXCLUDED_MIDDLE `j IN 1..dimindex (:N)`) => jh; last first. by rewrite !(partial_eq0_alt j) // partial_const. move: ih jh; rewrite !IN_NUMSEG => ih jh. move: d2f; rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] d2f. set F1 := `\h k. f ((x + k % basis j) + h % basis i) - f (x + k % basis j)`. set F2 := `\k h. f ((x + h % basis i) + k % basis j) - f (x + h % basis i)`. set G := `\h k. F1 h k - F1 h (&0)`. have v_eq: `!h k. (x + k % basis j) + h % basis i = (x + h % basis i) + k % basis j`; first by "VECTOR_ARITH_TAC". have G_eq: `G = \h k. F2 k h - F2 k (&0)`. rewrite -2!eq_ext => h k. by rewrite -G_def -F2_def -F1_def /= !VECTOR_MUL_LZERO VECTOR_ADD_RID v_eq; arith. have [r [r0 rs]]: `?r. &0 < r /\ (!h k. abs h <= r /\ abs k <= r ==> (x + h % basis i) + k % basis j IN s)`. move: open_s; rewrite OPEN_CONTAINS_BALL SUBSET IN_BALL dist => /(_ xs) [e] [e0 de]. exists `e / &3`; split; first by move: e0; arith. move => h k ineq. rewrite de -"GEN_ALL VECTOR_ADD_ASSOC" VECTOR_SUB_RADD NORM_NEG. apply: REAL_LET_TRANS; exists `e / &3 + e / &3`; split; last by move: e0; arith. apply: REAL_LE_TRANS; exists `abs h + abs k`; split; last by move: ineq; arith. have := NORM_TRIANGLE `h % basis i:real^N` `k % basis j:real^N`. by rewrite !NORM_MUL !NORM_BASIS // !REAL_MUL_RID. have in_s: `(!h. abs h <= r ==> x + h % basis i IN s) /\ (!k. abs k <= r ==> x + k % basis j IN s)`. split => [h h_ineq | k k_ineq]. by move: (rs h `&0`); rewrite VECTOR_MUL_LZERO VECTOR_ADD_RID h_ineq => ->; move: r0; arith. by move: (rs `&0` k); rewrite VECTOR_MUL_LZERO VECTOR_ADD_RID k_ineq => ->; move: r0; arith. have F1h: `!h. F1 h = (\k. (f o (\k. (x + h % basis i) + k % basis j)) k - (f o (\k. x + k % basis j)) k)`. by rewrite -F1_def !o_THM /= v_eq. have dF1: `!h. abs h <= r ==> !k. abs k <= r ==> (F1 h) real_differentiable atreal k`. move => h h_ineq k k_ineq. rewrite F1h REAL_DIFFERENTIABLE_SUB; rewr ETA_AX. by rewrite !diff2_imp_real_diff ?d2f ?rs ?in_s. have F1_der : `!h k. abs h <= r /\ abs k <= r ==> derivative (F1 h) k = partial j f ((x + h % basis i) + k % basis j) - partial j f (x + k % basis j)`. move => h k ineq; rewrite F1h derivative_sub; rewr ETA_AX; rewrite ?diff2_imp_real_diff ?d2f ?rs ?in_s //. rewrite [`derivative (f o (\k. x + k % basis j)) k`]derivative_translation 1?derivative_translation; rewrite ?diff2_imp_real_diff ?d2f ?rs ?in_s //. have eq: `!y e. (f o (\k. y + k % e)) o (\t. k + t) = f o (\t. (y + k % e) + t % e)`. by rewrite -eq_ext !o_THM /= "GEN_ALL VECTOR_ADD_RDISTRIB" "GEN_ALL VECTOR_ADD_ASSOC". by rewrite !eq -!partial. have Gh: `!h k. abs h <= r /\ abs k <= r ==> (?t1. G h k = k * derivative (F1 h) t1 /\ abs t1 <= abs k)`. move => h k ineq; rewrite -G_def /=. have := real_mvt0 `F1 h` `derivative (F1 h)` k. "ANTS_TAC". move => t t_ineq; rewrite has_derivative_alt dF1. by move: ineq t_ineq; arith. move => [t1] [t1_ineq] eq. by exists t1; rewrite eq; move: t1_ineq ineq; arith. have Ghk: `!h k. abs h <= r /\ abs k <= r ==> (?t1 t2. G h k = h * k * partial i (partial j f) (x + t1 % basis j + t2 % basis i) /\ abs t1 <= abs k /\ abs t2 <= abs h)`. move => h k ineq. move: (Gh h k); rewrite !ineq /= => [] [t1] [eq t1k]. move: eq; rewrite F1_der; [by move: t1k ineq; arith | move => eq]. set g := `partial j f o (\h. (x + t1 % basis j) + h % basis i)`. have := real_mvt0 g `derivative g` h. "ANTS_TAC". move => t t_ineq; rewrite has_derivative_alt. rewrite -g_def diff2_partial_real_diff d2f v_eq rs. by move: t1k t_ineq ineq; arith. move => [t2] [t2_ineq] g_eq. exists t1 t2; rewrite eq; split; last by move: t1k t2_ineq ineq; arith. set p := `_1 - _2`. have ->: `p = g h - g (&0)`. by rewrite -p_def -g_def !o_THM /= VECTOR_MUL_LZERO VECTOR_ADD_RID v_eq. rewrite g_eq "REAL_ARITH `!a. k * a * h = h * k * a`" !REAL_MUL_ASSOC. rewrite REAL_EQ_MUL_LCANCEL -g_def; right. rewrite derivative_translation. by rewrite diff2_partial_real_diff d2f v_eq rs; move: t1k t2_ineq ineq; arith. rewrite partial; "AP_THM_TAC"; "AP_TERM_TAC". by rewrite -eq_ext !o_THM /= "GEN_ALL VECTOR_ADD_RDISTRIB" -!"GEN_ALL VECTOR_ADD_ASSOC". move: Gh F1_der dF1 F1h G_def F1_def => _ _ _ _ _ _. have F2h: `!k. F2 k = (\h. (f o (\h. (x + k % basis j) + h % basis i)) h - (f o (\h. x + h % basis i)) h)`. by rewrite -F2_def !o_THM /= v_eq. have dF2: `!k. abs k <= r ==> !h. abs h <= r ==> (F2 k) real_differentiable atreal h`. move => k k_ineq h h_ineq. rewrite F2h REAL_DIFFERENTIABLE_SUB; rewr ETA_AX. by rewrite !diff2_imp_real_diff ?d2f ?v_eq ?rs ?in_s. have F2_der : `!h k. abs h <= r /\ abs k <= r ==> derivative (F2 k) h = partial i f ((x + k % basis j) + h % basis i) - partial i f (x + h % basis i)`. move => h k ineq; rewrite F2h derivative_sub; rewr ETA_AX; rewrite ?diff2_imp_real_diff ?d2f ?v_eq ?rs ?in_s //. rewrite -v_eq [`derivative (f o (\h. x + h % basis i)) h`]derivative_translation 1?derivative_translation; rewrite ?diff2_imp_real_diff ?d2f ?v_eq ?rs ?in_s // -v_eq. have eq: `!y e. (f o (\h. y + h % e)) o (\t. h + t) = f o (\t. (y + h % e) + t % e)`. by rewrite -eq_ext !o_THM /= "GEN_ALL VECTOR_ADD_RDISTRIB" "GEN_ALL VECTOR_ADD_ASSOC". by rewrite !eq -!partial. have Gk: `!h k. abs h <= r /\ abs k <= r ==> (?t3. G h k = h * derivative (F2 k) t3 /\ abs t3 <= abs h)`. move => h k ineq; rewrite G_eq /=. have := real_mvt0 `F2 k` `derivative (F2 k)` h. "ANTS_TAC". move => t t_ineq; rewrite has_derivative_alt dF2. by move: ineq t_ineq; arith. move => [t3] [t3_ineq] eq. by exists t3; rewrite eq; move: t3_ineq ineq; arith. have Gkh: `!h k. abs h <= r /\ abs k <= r ==> (?t3 t4. G h k = h * k * partial j (partial i f) (x + t4 % basis j + t3 % basis i) /\ abs t3 <= abs h /\ abs t4 <= abs k)`. move => h k ineq. move: (Gk h k); rewrite !ineq /= => [] [t3] [eq t3h]. move: eq; rewrite F2_der; [by move: t3h ineq; arith | move => eq]. set g := `partial i f o (\k. (x + t3 % basis i) + k % basis j)`. have := real_mvt0 g `derivative g` k. "ANTS_TAC". move => t t_ineq; rewrite has_derivative_alt. rewrite -g_def diff2_partial_real_diff d2f rs. by move: t3h t_ineq ineq; arith. move => [t4] [t4_ineq] g_eq. exists t3 t4; rewrite eq; split; last by move: t3h t4_ineq ineq; arith. set p := `_1 - _2`. have ->: `p = g k - g (&0)`. by rewrite -p_def -g_def !o_THM /= VECTOR_MUL_LZERO VECTOR_ADD_RID v_eq. rewrite g_eq "REAL_ARITH `!a. h * a * k = h * k * a`" !REAL_MUL_ASSOC. rewrite REAL_EQ_MUL_LCANCEL -g_def; right. rewrite derivative_translation. by rewrite diff2_partial_real_diff d2f rs; move: t3h t4_ineq ineq; arith. rewrite partial; "AP_THM_TAC"; "AP_TERM_TAC". rewrite -eq_ext !o_THM /= "GEN_ALL VECTOR_ADD_RDISTRIB" -!"GEN_ALL VECTOR_ADD_ASSOC" => y. by "AP_TERM_TAC"; "VECTOR_ARITH_TAC". move: Gk F2_der dF2 F2h G_eq F2_def => _ _ _ _ _ _. have lim0: `(vec 0:real^2) limit_point_of {y | &0 < y$1 /\ &0 < y$2}`. rewrite limit_point_of OPEN_CONTAINS_BALL SUBSET IN_BALL dist => t [v0t]. move/(_ v0t) => [e] [e0] in_t. set y := `e / &2 % (vec 1:real^2)`. have yc: `!i. y$i = e / (&2)`; first by rewrite -y_def VECTOR_MUL_COMPONENT VEC_COMPONENT REAL_MUL_RID. have ineq: `&0 < e / (&2)`; first by rewrite REAL_LT_DIV e0; arith. have inf_y: `infnorm y = e / &2`. by rewrite "GEN_ALL INFNORM_2" !yc "GEN_ALL (CONJUNCT2 REAL_MAX_ACI)" REAL_ABS_REFL REAL_LE_LT ineq. exists y; split; first by rewrite -INFNORM_EQ_0 inf_y; move: ineq; arith. split; first by rewrite IN_ELIM_THM /=; exists y; rewrite !yc ineq. rewrite in_t; apply: REAL_LET_TRANS; exists `e * inv(&2) * sqrt(&2)`; split. apply: REAL_LE_TRANS; exists `infnorm y * sqrt (&2)`; split. by rewrite "GEN_ALL REAL_MUL_AC" NORM_SUB "GEN_ALL VECTOR_SUB_RZERO" -DIMINDEX_2 NORM_LE_INFNORM. by rewrite inf_y real_div -REAL_MUL_ASSOC REAL_LE_REFL. rewrite -{2}(REAL_MUL_RID e) REAL_LT_LMUL e0 andTb. rewrite -(REAL_MUL_LINV `&2`) ?REAL_LT_LMUL ?REAL_LT_INV ?andTb; try arith. have {2}->: `&2 = sqrt (&2 * &2)`; first by rewrite -REAL_POW_2 POW_2_SQRT_ABS; arith. by rewrite SQRT_MONO_LT_COMPAT; arith. have lim_ji: `((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial j (partial i f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`. rewrite LIM_WITHIN => e e_gt0. move: (pc i j); rewrite "GEN_ALL continuous_at" !dist !o_THM => /(_ e_gt0) [d] [d0] e_ineq. exists `min r (d / &2)`; rewrite REAL_LT_MIN; split; first by move: r0 d0; arith. rewrite /= "GEN_ALL VECTOR_SUB_RZERO" => y ineq. have y0: `&0 < abs (y$1) /\ &0 < abs (y$2)`. move: ineq; rewrite IN_ELIM_THM /= => [] [] [z] [z_ineq] -> _. by move: z_ineq; arith. have yr: `abs (y$1) <= r /\ abs (y$2) <= r /\ abs (y$1) < d / &2 /\ abs (y$2) < d / &2`. suff: `infnorm y < min r (d / &2)`; first by rewrite "GEN_ALL INFNORM_2"; arith. by apply: REAL_LET_TRANS; exists `norm y`; rewrite INFNORM_LE_NORM. have := Gkh `y$1` `y$2`. rewrite !yr /= => [] [t1] [t2] [G_eq] t_ineq. rewrite G_eq REAL_MUL_ASSOC "GEN_ALL REAL_MUL_AC" real_div -REAL_MUL_ASSOC REAL_MUL_RINV ?REAL_MUL_RID. by rewrite REAL_ENTIRE; move: y0; arith. apply: e_ineq; rewrite "GEN_ALL VECTOR_ADD_SUB". apply: REAL_LET_TRANS; exists `norm (t2 % basis j:real^N) + norm (t1 % basis i:real^N)`. rewrite NORM_TRIANGLE andTb !NORM_MUL !NORM_BASIS // !REAL_MUL_RID. by move: t_ineq yr; arith. have lim_ij: `((\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))) --> lift (partial i (partial j f) x)) (at (vec 0) within {y | &0 < y$1 /\ &0 < y$2})`. rewrite LIM_WITHIN => e e_gt0. move: (pc j i); rewrite "GEN_ALL continuous_at" !dist !o_THM => /(_ e_gt0) [d] [d0] e_ineq. exists `min r (d / &2)`; rewrite REAL_LT_MIN; split; first by move: r0 d0; arith. rewrite /= "GEN_ALL VECTOR_SUB_RZERO" => y ineq. have y0: `&0 < abs (y$1) /\ &0 < abs (y$2)`. move: ineq; rewrite IN_ELIM_THM /= => [] [] [z] [z_ineq] -> _. by move: z_ineq; arith. have yr: `abs (y$1) <= r /\ abs (y$2) <= r /\ abs (y$1) < d / &2 /\ abs (y$2) < d / &2`. suff: `infnorm y < min r (d / &2)`; first by rewrite "GEN_ALL INFNORM_2"; arith. by apply: REAL_LET_TRANS; exists `norm y`; rewrite INFNORM_LE_NORM. have := Ghk `y$1` `y$2`. rewrite !yr /= => [] [t1] [t2] [G_eq] t_ineq. rewrite G_eq REAL_MUL_ASSOC "GEN_ALL REAL_MUL_AC" real_div -REAL_MUL_ASSOC REAL_MUL_RINV ?REAL_MUL_RID. by rewrite REAL_ENTIRE; move: y0; arith. apply: e_ineq; rewrite "GEN_ALL VECTOR_ADD_SUB". apply: REAL_LET_TRANS; exists `norm (t1 % basis j:real^N) + norm (t2 % basis i:real^N)`. rewrite NORM_TRIANGLE andTb !NORM_MUL !NORM_BASIS // !REAL_MUL_RID. by move: t_ineq yr; arith. rewrite -LIFT_EQ; apply (LIM_UNIQUE `at (vec 0:real^2) within {y:real^2 | &0 < y$1 /\ &0 < y$2}`). exists `\y:real^2. lift (G (y$1) (y$2) / (y$1 * y$2))`. by rewrite "GEN_ALL TRIVIAL_LIMIT_WITHIN" negbK lim0 andTb. Qed. (* m_cell_domain *) "let m_cell_domain = new_definition `m_cell_domain (x:real^N, z:real^N) (y:real^N) (w:real^N) <=> !i. i IN 1..dimindex (:N) ==> x$i <= y$i /\ y$i <= z$i /\ max (y$i - x$i) (z$i - y$i) <= w$i`". "let m_bounded_on_int = new_definition `m_bounded_on_int (f:real^N->real) domain f_bounds <=> !x. x IN interval [domain] ==> interval_arith (f x) f_bounds`". "let diff2_domain = new_definition `diff2_domain domain f <=> !x. x IN interval [domain] ==> diff2 f x`". "let diff2c_domain = new_definition `diff2c_domain domain f <=> !x. x IN interval [domain] ==> diff2c f x`". Lemma diff2c_domain_alt f domain : `diff2c_domain domain f <=> diff2_domain domain f /\ (!x. x IN interval [domain] ==> !i j. (lift o partial2 j i f) continuous at x)`. Proof. rewrite diff2c_domain diff2c diff2_domain; split => [h1|[h1 h2] x h3]. by split => x /h1 /=. by move: (h2 h3) (h1 h3) => /=. Qed. Lemma y_in_domain domain y w : `m_cell_domain domain y w ==> y IN interval [domain]`. case: domain => x z; rewrite m_cell_domain "GEN_ALL IN_INTERVAL" IN_NUMSEG => ineqs i. by move/ineqs => /=. Qed. Lemma domain_width p domain y w : `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> !i. i IN 1..dimindex (:N) ==> abs (p$i - y$i) <= w$i`. case: domain => x z; rewrite m_cell_domain => ineqs p_in i i_in. by move: p_in (ineqs i_in); rewrite "GEN_ALL IN_INTERVAL" -IN_NUMSEG => /(_ i_in); arith. Qed. Lemma sum_swap1 g n : `sum (1..n) (\i. sum (i + 1..n) (\j. g i j)) = sum (1..n) (\i. sum (1..i - 1) (\j. g j i))`. Proof. rewrite !SUM_SUM_PRODUCT ?FINITE_NUMSEG //= !IN_NUMSEG. set s1 := `{i, j | (1 <= i /\ i <= n) /\ i + 1 <= j /\ j <= n}`. set s2 := `{i, j | (1 <= i /\ i <= n) /\ 1 <= j /\ j <= i - 1}`. set f := `\(i,j):num#num. j, i`. have ->: `s1 = IMAGE f s2`. rewrite -s1_def -s2_def -f_def EXTENSION IN_IMAGE !IN_ELIM_THM /= => p; split. move => [i] [j] [ineq] p_eq. by exists `j, i`; rewrite p_eq /=; exists j i; move: ineq; arith. move => [p1] [p_eq] [i] [j] [ineq] p1_eq. by exists j i; rewrite p_eq p1_eq /=; move: ineq; arith. have ->: `(\(i,j). g j i) = (\(i,j). g i j) o f`. by rewrite -eq_ext o_THM -f_def; case. apply SUM_IMAGE; case => i1 j1; case => i2 j2. by rewrite -f_def /= !PAIR_EQ => [] [_] [_] [-> ->]. Qed. (* Computation of the taylor error *) Lemma m_taylor_error_eq f domain w error : `diff2c_domain domain f ==> (m_taylor_error f domain (w:real^N) error <=> (!x. x IN interval [domain] ==> sum (1..dimindex (:N)) (\i. w$i * (w$i * abs (partial2 i i f x) + &2 * sum (1..i - 1) (\j. w$j * abs (partial2 j i f x)))) <= error))`. Proof. rewrite diff2c_domain m_taylor_error => d2f. have eq: `!g1 g2. (!x. x IN interval [domain] ==> g1 x = g2 x) ==> ((!x. x IN interval [domain] ==> g1 x <= error) <=> (!x. x IN interval [domain] ==> g2 x <= error))`. move => g1 g2 eq; split => cond x Px. by rewrite -eq // cond. by rewrite eq // cond. apply: eq => x /d2f d2fx. set g := `\i j. w$i * w$j * abs (partial2 j i f x)`. set n := `dimindex (:N)`. set s1 := `sum _1 _2`. have s1_eq: `s1 = sum (1..n) (\i. sum (1..n) (\j. g i j))`. rewrite -s1_def; apply SUM_EQ => i /= i_in. by rewrite -SUM_LMUL /= -g_def partial2; apply SUM_EQ. rewrite REAL_MUL_2 !REAL_ADD_LDISTRIB -SUM_LMUL REAL_ADD_ASSOC SUM_ADD_NUMSEG /=. set s2 := `sum _1 _2`. have s2_eq: `s2 = sum (1..n) (\i. g i i + sum (1..i - 1) (\j. g i j))`; first by rewrite -s2_def -g_def. set s3 := `sum _1 _2`. have s3_eq: `s3 = sum (1..n) (\i. sum (1..i - 1) (\j. g i j))`; first by rewrite -s3_def -g_def. move: s1_def s2_def s3_def => _ _ _. suff ->: `s3 = sum (1..n) (\i. sum (i + 1..n) (\j. g i j))`. rewrite s2_eq -SUM_ADD_NUMSEG /= s1_eq; apply SUM_EQ => i /=; rewrite IN_NUMSEG => i_ineq. rewrite "REAL_ARITH `!a b c. (a + b) + c = (a + c) + b`" -(SUM_SING_NUMSEG `g i` i); rewr ETA_AX. rewrite SUM_COMBINE_R ?i_ineq; first by arith. by rewrite "GEN_ALL REAL_ADD_AC" SUM_COMBINE_L //; move: i_ineq; arith. rewrite s3_eq sum_swap1; apply SUM_EQ => i _ /=; apply SUM_EQ => j _ /=. rewrite -g_def /= "REAL_ARITH `!a b c. a * b * c = b * a * c`" !REAL_EQ_MUL_LCANCEL; right; right. by rewrite mixed_second_partials. Qed. (* Taylor bounds *) Lemma diff2_derivative2_bound domain y w p f dd_bound : `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> (!t. interval_arith t (&0, &1) ==> abs (nth_derivative 2 (f o (\t. y + t % (p - y))) t) <= dd_bound)`. Proof. rewrite diff2_domain m_taylor_error => domainH p_in df boundedH t t_in. have pt_in : `y + t % (p - y) IN interval [domain]`. rewrite "VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`" IN_CONVEX_SET. by rewrite (y_in_domain domainH) p_in -interval_arith t_in pair_eq CONVEX_INTERVAL. rewrite diff2_dir_derivative2 ?df //. rewrite o_THM /=; move: (boundedH pt_in). set s1 := `sum _1 _2`; set s2 := `sum _1 _2` => i1. apply: REAL_LE_TRANS; exists s1; rewrite i1 andbT -s1_def -s2_def. rewrite SUM_ABS_LE FINITE_NUMSEG andTb => i i_ineq /=. rewrite -SUM_LMUL SUM_ABS_LE FINITE_NUMSEG andTb => j j_ineq /=. by rewrite !REAL_ABS_MUL !REAL_LE_MUL2 ?REAL_LE_MUL !REAL_ABS_POS // VECTOR_SUB_COMPONENT; rewrite (domain_width domainH p_in) // REAL_LE_REFL. Qed. Lemma m_taylor_error_lemma domain y w p f dd_bound : `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> abs (f p - (f y + sum (1..dimindex (:N)) (\i. (p - y)$i * partial i f y))) <= dd_bound / &2`. rewrite diff2_domain; move => domainH p_in df taylor_error. have pt_in : `!t. interval_arith t (&0, &1) ==> y + t % (p - y) IN interval [domain]`. move => t t_in; rewrite "VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`" IN_CONVEX_SET. by rewrite (y_in_domain domainH) p_in -interval_arith t_in pair_eq CONVEX_INTERVAL. move: (real_taylor2_bound `f o (\t. y + t % (p - y))` dd_bound). "ANTS_TAC"; first by rewrite nth_diff_strong_int => t t_in; rewrite diff2_dir df pt_in. "ANTS_TAC"; first by apply: (diff2_derivative2_bound domainH); rewrite diff2_domain. rewrite !o_THM /= VECTOR_MUL_LID VECTOR_MUL_LZERO VECTOR_ADD_RID "GEN_ALL VECTOR_SUB_ADD2". rewrite diff2_dir_derivative ?df ?pt_in ?interval_arith; first by arith. by rewrite o_THM /= VECTOR_MUL_LZERO VECTOR_ADD_RID. Qed. Lemma m_taylor_upper_bound domain y w f dd_bound hi hi_bound : `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> f y <= hi ==> hi + sum(1..dimindex (:N)) (\i. w$i * abs (partial i f y)) + dd_bound / &2 <= hi_bound ==> !p. p IN interval [domain] ==> f p <= hi_bound`. move => domainH df errorH f_bound total_bound p p_in. move: (m_taylor_error_lemma domainH p_in df errorH). move/"REAL_ARITH `!x y e. abs (x - y) <= e ==> x <= y + e`". set s := `sum _1 _2` => ineq. apply: REAL_LE_TRANS; exists `(f y + s) + dd_bound / &2`; rewrite ineq andTb. apply: "REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" total_bound. rewrite REAL_ADD_ASSOC REAL_LE_RADD REAL_LE_ADD2 f_bound andTb. apply: REAL_LE_TRANS; exists `abs s`; rewrite REAL_ABS_LE andTb. rewrite -s_def SUM_ABS_LE FINITE_NUMSEG andTb => i i_ineq /=. by rewrite REAL_ABS_MUL REAL_LE_MUL2 !REAL_ABS_POS REAL_LE_REFL VECTOR_SUB_COMPONENT (domain_width domainH). Qed. Lemma m_taylor_lower_bound domain y w f dd_bound lo lo_bound : `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> lo <= f y ==> lo_bound <= lo - (sum(1..dimindex (:N)) (\i. w$i * abs (partial i f y)) + dd_bound / &2) ==> !p. p IN interval [domain] ==> lo_bound <= f p`. move => domainH df errorH f_bound total_bound p p_in. move: (m_taylor_error_lemma domainH p_in df errorH). move/"REAL_ARITH `!x y e. abs (x - y) <= e ==> y - e <= x`". set s := `sum _1 _2` => ineq. apply: REAL_LE_TRANS; exists `(f y + s) - dd_bound / &2`; rewrite ineq andbT. apply: ("REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" total_bound). rewrite !real_sub REAL_NEG_ADD REAL_ADD_ASSOC REAL_LE_RADD REAL_LE_ADD2 f_bound andTb. apply: REAL_LE_TRANS; exists `--abs s`; rewrite REAL_LE_NEG; split; last by arith. rewrite -s_def SUM_ABS_LE FINITE_NUMSEG andTb => i i_ineq /=. by rewrite REAL_ABS_MUL REAL_LE_MUL2 !REAL_ABS_POS REAL_LE_REFL VECTOR_SUB_COMPONENT (domain_width domainH). Qed. Lemma m_taylor_bounds domain y w f dd_bound lo hi err_bound lo_bound hi_bound : `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_error f domain w dd_bound ==> interval_arith (f y) (lo, hi) ==> sum(1..dimindex (:N)) (\i. w$i * abs(partial i f y)) + dd_bound / &2 <= err_bound ==> lo_bound <= lo - err_bound ==> hi + err_bound <= hi_bound ==> m_bounded_on_int f domain (lo_bound, hi_bound)`. rewrite m_bounded_on_int !interval_arith => domainH df errorH [f_lo f_hi] err lo_ineq hi_ineq p p_in. move: (m_taylor_lower_bound domainH df errorH f_lo lo_bound) => ->. rewrite p_in andbT; apply: REAL_LE_TRANS; exists `lo - err_bound`. by rewrite lo_ineq andTb !real_sub REAL_LE_ADD2 REAL_LE_REFL REAL_LE_NEG. move: (m_taylor_upper_bound domainH df errorH f_hi hi_bound) => -> //. rewrite p_in andbT; apply: REAL_LE_TRANS; exists `hi + err_bound`. by rewrite hi_ineq andbT REAL_LE_LADD. Qed. (* Taylor partial derivative bounds *) Lemma diff2_derivative_partial_bound domain y w p f i d_bound : `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w d_bound ==> (!t. interval_arith t (&0, &1) ==> abs (derivative (partial i f o (\t. y + t % (p - y))) t) <= d_bound)`. Proof. rewrite diff2_domain m_taylor_partial_error => domainH p_in df boundedH t t_in. have pt_in : `y + t % (p - y) IN interval [domain]`. rewrite "VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`" IN_CONVEX_SET. by rewrite (y_in_domain domainH) p_in -interval_arith t_in pair_eq CONVEX_INTERVAL. rewrite diff2_derivative_partial ?df //. apply: "REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" (boundedH pt_in). rewrite SUM_ABS_LE FINITE_NUMSEG andTb => j j_ineq /=. rewrite REAL_ABS_MUL o_THM /= REAL_LE_MUL2 !REAL_ABS_POS REAL_LE_REFL VECTOR_SUB_COMPONENT. by rewrite (domain_width domainH). Qed. Lemma m_taylor_partial_error_lemma domain y w p f i dd_bound : `m_cell_domain domain y (w:real^N) ==> p IN interval [domain] ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> abs (partial i f p - partial i f y) <= dd_bound`. Proof. rewrite diff2_domain; move => domainH p_in df partial_error. have pt_in : `!t. interval_arith t (&0, &1) ==> y + t % (p - y) IN interval [domain]`. move => t t_in; rewrite "VECTOR_ARITH `y + t % (p - y) = (&1 - t) % y + t % p:real^N`" IN_CONVEX_SET. by rewrite (y_in_domain domainH) p_in -interval_arith t_in pair_eq CONVEX_INTERVAL. move: (real_taylor1_bound `partial i f o (\t. y + t % (p - y))` dd_bound). "ANTS_TAC". move => t t_in; rewrite diff2_real_diff_partial ?df ?pt_in // (diff2_derivative_partial_bound domainH) //. by rewrite diff2_domain. by rewrite !o_THM /= VECTOR_MUL_LID VECTOR_MUL_LZERO VECTOR_ADD_RID "GEN_ALL VECTOR_SUB_ADD2". Qed. Lemma m_taylor_upper_partial_bound domain y w f i dd_bound hi hi_bound : `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> partial i f y <= hi ==> hi + dd_bound <= hi_bound ==> !p. p IN interval [domain] ==> partial i f p <= hi_bound`. Proof. move => domainH df errorH df_bound total_bound p p_in. move: (m_taylor_partial_error_lemma domainH p_in df errorH). move/"REAL_ARITH `!x y e. abs (x - y) <= e ==> x <= y + e`" => ineq. apply: ("REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" ineq). apply: "REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" total_bound. by rewrite REAL_LE_ADD2 REAL_LE_REFL. Qed. Lemma m_taylor_lower_partial_bound domain y w f i dd_bound lo lo_bound : `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> lo <= partial i f y ==> lo_bound <= lo - dd_bound ==> !p. p IN interval [domain] ==> lo_bound <= partial i f p`. Proof. move => domainH df errorH df_bound total_bound p p_in. move: (m_taylor_partial_error_lemma domainH p_in df errorH). move/"REAL_ARITH `!x y e. abs (x - y) <= e ==> y - e <= x`" => ineq. apply: "REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" ineq. apply: ("REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" total_bound). by rewrite !real_sub REAL_LE_ADD2 REAL_LE_REFL. Qed. Lemma m_taylor_partial_bounds domain y w f i dd_bound lo hi lo_bound hi_bound : `m_cell_domain domain y (w:real^N) ==> diff2_domain domain f ==> m_taylor_partial_error f i domain w dd_bound ==> interval_arith (partial i f y) (lo, hi) ==> lo_bound <= lo - dd_bound ==> hi + dd_bound <= hi_bound ==> m_bounded_on_int (partial i f) domain (lo_bound, hi_bound)`. rewrite m_bounded_on_int !interval_arith => domainH df errorH [df_lo df_hi] lo_ineq hi_ineq p p_in. move: (m_taylor_lower_partial_bound domainH df errorH df_lo lo_bound) => -> //. by move: (m_taylor_upper_partial_bound domainH df errorH df_hi hi_bound) => ->. Qed. End Taylor. (* diff2 arithmetic *) Section Diff2Arith. Variables f g : `:real^N -> real`. Variable x : `:real^N`. Variable domain : `:real^N#real^N`. Lemma differentiable_local_at s f g x : `f differentiable at x ==> open s ==> x IN s ==> (!y. y IN s ==> g y = f y) ==> g differentiable at x`. rewrite OPEN_CONTAINS_BALL => df open_s xs eq. move: (open_s xs) => [d] [d0]; rewrite SUBSET IN_BALL => in_ball. apply: (DIFFERENTIABLE_TRANSFORM_AT f); rewrite df andbT. by exists d; rewrite d0 andTb => z dzx; rewrite eq // in_ball DIST_SYM. Qed. Section Point. (* scale *) Lemma diff2_scale f c : `diff2 f x ==> diff2 (\x. c * f x) x`. Proof. rewrite !diff2 => [] [s] [open_s] [xs] df. exists s; rewrite open_s xs !andTb => z zs. rewrite f_lift_scale DIFFERENTIABLE_CMUL ?andTb; first by rewr ETA_AX; rewrite df. move => i; apply: (differentiable_local_at s `lift o (\x. c * partial i f x)`). rewrite open_s zs f_lift_scale DIFFERENTIABLE_CMUL ?andTb; first by rewr !ETA_AX; rewrite df. by move => y ys; rewrite !o_THM partial_scale ?df // LIFT_CMUL. Qed. (* neg *) Lemma diff2_neg f : `diff2 f x ==> diff2 (\x. --f x) x`. Proof. by move/(diff2_scale f `--(&1)`); rewrite -REAL_NEG_MINUS1. Qed. (* Composite *) Section Composite. Lemma has_derivative_uni_compose u f u' f' x : `(lift o f has_derivative f') (at x) ==> (u has_real_derivative u') (atreal (f x)) ==> (lift o u o f has_derivative (\x. u' % f' x)) (at x)`. move => df du. have ->: `lift o u o f = (lift o u o drop) o (lift o f)`. by rewrite -eq_ext !o_THM LIFT_DROP. have ->: `(\x. u' % f' x) = (\x. u' % x) o f'`; first by rewrite -eq_ext !o_THM /=. by rewrite DIFF_CHAIN_AT o_THM -"GEN_ALL HAS_REAL_FRECHET_DERIVATIVE_AT". Qed. Lemma diff_uni_compose u f x : `lift o f differentiable at x ==> u real_differentiable atreal (f x) ==> lift o u o f differentiable at x`. rewrite !differentiable real_differentiable => [] [f'] df [u'] du. by exists `\x. u' % f' x`; apply has_derivative_uni_compose. Qed. Lemma diff2_uni_compose u f : `diff2 f x ==> nth_diff_strong 2 u (f x) ==> diff2 (u o f) x`. Proof. rewrite !diff2 nth_diff_strong2_eq => [] [s] [open_s] [xs] df [t] [open_t] [fxt] du. set r := `{z | z IN s /\ (lift o f) z IN (IMAGE lift t)}`. have open_r : `open r`. rewrite -r_def CONTINUOUS_OPEN_PREIMAGE -REAL_OPEN open_t open_s !andbT. apply DIFFERENTIABLE_IMP_CONTINUOUS_ON; rewrite differentiable_on => y ys; rewr ETA_AX. by rewrite DIFFERENTIABLE_AT_WITHIN df. exists r; rewrite open_r -r_def !IN_ELIM_THM /= o_THM LIFT_IN_IMAGE_LIFT; split; first by exists x. move => y [z] [[zs] fzt] ->. rewrite diff_uni_compose ?df ?du // andTb => i. apply differentiable_local_at; exists r `lift o (\y. derivative u (f y) * partial i f y)`. rewrite open_r differentiable_mul ?andTb. by rewrite -(o_THM `derivative u`); rewr !ETA_AX; rewrite diff_uni_compose ?df // du. rewrite -r_def !IN_ELIM_THM /= !o_THM !LIFT_IN_IMAGE_LIFT; split; first by exists z. move => y [p] [[ps] fpt] ->. by rewrite partial_uni_compose ?df ?du. Qed. (* inv *) Lemma diff2_inv_compose : `~(f x = &0) ==> diff2 f x ==> diff2 (inv o f) x`. Proof. by move => /diff2_inv du df; rewrite diff2_uni_compose. Qed. (* sqrt *) Lemma diff2_sqrt_compose : `&0 < f x ==> diff2 f x ==> diff2 (sqrt o f) x`. Proof. by move => /diff2_sqrt du df; rewrite diff2_uni_compose. Qed. (* atn *) Lemma diff2_atn_compose : `diff2 f x ==> diff2 (atn o f) x`. Proof. by move => df; rewrite diff2_uni_compose diff2_atn. Qed. (* acs *) Lemma diff2_acs_compose : `abs (f x) < &1 ==> diff2 f x ==> diff2 (acs o f) x`. Proof. by move => /diff2_acs du df; rewrite diff2_uni_compose. Qed. End Composite. (* Binary operations *) (* add *) Lemma diff2_add f g : `diff2 f x ==> diff2 g x ==> diff2 (\x. f x + g x) x`. Proof. rewrite !diff2 => [] [s] [open_s] [xs] df [t] [open_t] [ys] dg. exists `s INTER t`; rewrite OPEN_INTER // !IN_INTER xs ys !andTb => z [zs zt]. rewrite f_lift_add DIFFERENTIABLE_ADD ?andTb. by rewr ETA_AX; rewrite df // dg. move => i; apply: (differentiable_local_at `s INTER t` `lift o (\x. partial i f x + partial i g x)`). rewrite OPEN_INTER // !IN_INTER zt zs f_lift_add DIFFERENTIABLE_ADD ?andTb. by rewr !ETA_AX; rewrite df // dg. by move => y [ys yt]; rewrite !o_THM partial_add ?df ?dg // LIFT_ADD. Qed. (* sub *) Lemma diff2_sub f g : `diff2 f x ==> diff2 g x ==> diff2 (\x. f x - g x) x`. Proof. by move => d2f d2g; rewrite real_sub diff2_add // diff2_neg. Qed. (* mul *) Lemma diff2_mul f g : `diff2 f x ==> diff2 g x ==> diff2 (\x. f x * g x) x`. rewrite !diff2 => [] [s] [open_s] [xs] df [t] [open_t] [ys] dg. exists `s INTER t`; rewrite OPEN_INTER // !IN_INTER xs ys !andTb => z [zs zt]. rewrite differentiable_mul ?df ?dg // andTb => i. apply: (differentiable_local_at `s INTER t` `lift o (\x. partial i f x * g x + f x * partial i g x)`). rewrite OPEN_INTER // !IN_INTER zt zs f_lift_add DIFFERENTIABLE_ADD ?andTb. by rewr !ETA_AX; rewrite !differentiable_mul; rewr ETA_AX; rewrite ?df ?dg. by move => y [ys yt]; rewrite !o_THM partial_mul ?df ?dg // LIFT_ADD. Qed. End Point. Section Domain. Hypothesis d2f : `diff2_domain domain f`. (* scale *) Lemma diff2_domain_scale c : `diff2_domain domain (\x. c * f x)`. Proof. by move: d2f; rewrite !diff2_domain => d2f x x_in; rewrite diff2_scale d2f. Qed. (* neg *) Lemma diff2_domain_neg : `diff2_domain domain (\x. --f x)`. Proof. by move: d2f; rewrite !diff2_domain => d2f x x_in; rewrite diff2_neg d2f. Qed. Variable bounds : `:real#real`. (* inv *) Lemma diff2_domain_inv_compose : `m_bounded_on_int f domain bounds ==> interval_not_zero bounds ==> diff2_domain domain (inv o f)`. move: d2f; rewrite m_bounded_on_int !diff2_domain => d2f ineq n0 x x_in. by rewrite diff2_inv_compose d2f // andbT (interval_arith_not_zero (ineq x_in)). Qed. (* sqrt *) Lemma diff2_domain_sqrt_compose : `m_bounded_on_int f domain bounds ==> interval_pos bounds ==> diff2_domain domain (sqrt o f)`. move: d2f; rewrite m_bounded_on_int !diff2_domain => d2f ineq n0 x x_in. by rewrite diff2_sqrt_compose d2f // andbT (interval_arith_pos (ineq x_in)). Qed. (* atn *) Lemma diff2_domain_atn_compose : `diff2_domain domain (atn o f)`. Proof. by move: d2f; rewrite !diff2_domain => d2f x x_in; rewrite diff2_atn_compose d2f. Qed. (* acs *) Lemma diff2_domain_acs_compose : `m_bounded_on_int f domain bounds ==> iabs bounds < &1 ==> diff2_domain domain (acs o f)`. move: d2f; rewrite m_bounded_on_int !diff2_domain => d2f ineq n0 x x_in. by rewrite diff2_acs_compose d2f // andbT (interval_arith_abs (ineq x_in)). Qed. (* Binary *) Hypothesis d2g : `diff2_domain domain g`. (* add *) Lemma diff2_domain_add : `diff2_domain domain (\x. f x + g x)`. Proof. by move: d2f d2g; rewrite !diff2_domain => d2f d2g x x_in; rewrite diff2_add d2f ?d2g. Qed. (* sub *) Lemma diff2_domain_sub : `diff2_domain domain (\x. f x - g x)`. Proof. by move: d2f d2g; rewrite !diff2_domain => d2f d2g x x_in; rewrite diff2_sub d2f ?d2g. Qed. (* mul *) Lemma diff2_domain_mul : `diff2_domain domain (\x. f x * g x)`. Proof. by move: d2f d2g; rewrite !diff2_domain => d2f d2g x x_in; rewrite diff2_mul d2f ?d2g. Qed. End Domain. Section SecondPartial. Lemma diff2_imp_diff f x : `diff2 f x ==> (lift o f) differentiable at x`. by rewrite diff2 => [] [s] [open_s] [xs] ->. Qed. Lemma diff2_imp_partial_diff f i x : `diff2 f x ==> (lift o partial i f) differentiable at x`. by rewrite diff2 => [] [s] [open_s] [xs] ->. Qed. Lemma partial_local s f g i x : `(lift o f) differentiable at x ==> open s ==> x IN s ==> (!y:real^N. y IN s ==> f y = g y) ==> partial i f x = partial i g x`. move => df open_s xs eq; rewrite !partial. apply: derivative_unique; apply: HAS_REAL_DERIVATIVE_LOCAL. exists `g o (\t. x + t % basis i)`; split. apply: has_derivative_alt; apply diff_imp_real_diff; rewrite diff_direction andbT. apply (differentiable_local_at s `lift o f`). rewrite /= VECTOR_MUL_LZERO VECTOR_ADD_RID df open_s xs !andTb => y ys. by rewrite !o_THM eq. move: (open_contains_open_interval open_s xs `basis i:real^N`) => [a] [b] [ab0]; rewrite SUBSET => sub. exists `real_interval (a, b)`; rewrite ab0 REAL_OPEN_REAL_INTERVAL !andTb => y y_in. by rewrite !o_THM /= eq // sub IN_IMAGE /=; exists y. Qed. Variables i j : `:num`. (* scale *) Lemma second_partial_scale f c : `diff2 f x ==> partial2 i j (\x. c * f x) x = c * partial2 i j f x`. Proof. move => d2f; rewrite !partial2 -partial_scale ?diff2_imp_partial_diff // EQ_SYM_EQ. move: d2f; rewrite diff2 => [] [s] [open_s] [xs] df. apply partial_local; exists s; rewrite open_s xs f_lift_scale DIFFERENTIABLE_CMUL ?andTb. by rewr !ETA_AX; rewrite df. by move => y ys; rewrite partial_scale ?df. Qed. (* neg *) Lemma second_partial_neg f : `diff2 f x ==> partial2 i j (\x. --f x) x = --partial2 i j f x`. Proof. by move/(second_partial_scale f `--(&1)`); rewrite -!REAL_NEG_MINUS1. Qed. (* Binary operations *) (* add *) Lemma second_partial_add f g : `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x + g x) x = partial2 i j f x + partial2 i j g x`. Proof. rewrite !diff2 => [] [s] [open_s] [xs] df [t] [open_t] [ys] dg. rewrite !partial2 -partial_add ?df ?dg // EQ_SYM_EQ; apply partial_local. exists `s INTER t`; rewrite OPEN_INTER // !IN_INTER xs ys. rewrite f_lift_add DIFFERENTIABLE_ADD ?andTb. by rewr !ETA_AX; rewrite df ?dg. by move => z [zs zt]; rewrite partial_add ?df ?dg. Qed. (* sub *) Lemma second_partial_sub f g : `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x - g x) x = partial2 i j f x - partial2 i j g x`. Proof. by move => d2f d2g; rewrite real_sub second_partial_add ?diff2_neg // second_partial_neg // -real_sub. Qed. (* mul *) Lemma second_partial_mul f g : `diff2 f x ==> diff2 g x ==> partial2 i j (\x. f x * g x) x = (partial2 i j f x * g x + partial j f x * partial i g x) + (partial i f x * partial j g x + f x * partial2 i j g x)`. rewrite !diff2 => [] [s] [open_s] [xs] df [t] [open_t] [ys] dg. rewrite !partial2 -!partial_mul -?partial_add ?df ?dg // 1?EQ_SYM_EQ. by rewrite !differentiable_mul; rewr ETA_AX; rewrite ?df ?dg. apply partial_local. exists `s INTER t`; rewrite OPEN_INTER // !IN_INTER xs ys. rewrite f_lift_add DIFFERENTIABLE_ADD ?andTb. by rewr !ETA_AX; rewrite !differentiable_mul; rewr ETA_AX; rewrite ?df ?dg. by move => z [zs zt]; rewrite partial_mul ?df ?dg. Qed. (* uni_compose *) Lemma second_partial_uni_compose f u : `diff2 f x ==> nth_diff_strong 2 u (f x) ==> partial2 i j (u o f) x = (nth_derivative 2 u (f x) * partial i f x) * partial j f x + derivative u (f x) * partial2 i j f x`. rewrite !diff2 nth_diff_strong2_eq => [] [s] [open_s] [xs] df [t] [open_t] [fxt] du. set r := `{z | z IN s /\ (lift o f) z IN (IMAGE lift t)}`. have open_r : `open r`. rewrite -r_def CONTINUOUS_OPEN_PREIMAGE -REAL_OPEN open_t open_s !andbT. apply DIFFERENTIABLE_IMP_CONTINUOUS_ON; rewrite differentiable_on => y ys; rewr ETA_AX. by rewrite DIFFERENTIABLE_AT_WITHIN df. rewrite !partial2 nth_derivative2. rewrite -partial_uni_compose ?df ?du // -(o_THM `derivative u`) -partial_mul. by rewrite diff_uni_compose ?df ?du. apply partial_local; exists r; rewrite open_r andbT. rewrite -r_def !IN_ELIM_THM /= o_THM LIFT_IN_IMAGE_LIFT; split; last first. by move => y [z] [[zs] fpz] ->; rewrite partial_uni_compose ?df ?du // o_THM. split; last by exists x. apply differentiable_local_at; exists r `lift o (\y. derivative u (f y) * partial j f y)`. rewrite open_r differentiable_mul ?andTb. by rewrite -(o_THM `derivative u`); rewr !ETA_AX; rewrite diff_uni_compose ?df // du. rewrite -r_def !IN_ELIM_THM /= !o_THM !LIFT_IN_IMAGE_LIFT; split; first by exists x. by move => y [p] [[ps] fpt] ->; rewrite partial_uni_compose ?df ?du. Qed. End SecondPartial. End Diff2Arith. (* Diff2c *) Section Diff2c. Lemma real_cont_at_local f g x s : `g real_continuous at x ==> open s ==> x IN s ==> (!y. y IN s ==> f y = g y) ==> f real_continuous at x`. Proof. rewrite !"GEN_ALL real_continuous_at" => g_cont open_s xs f_eq_g e e_gt0. have := OPEN_CONTAINS_BALL s; rewrite open_s /= ball SUBSET IN_ELIM_THM /=. move/(_ xs) => [d0] [d0_gt0] sub_s. move: (g_cont e_gt0) => [d1] [d1_gt0] dist_cond. exists `min d0 d1`. rewrite !REAL_LT_MIN d1_gt0 d0_gt0 /= => y [yd0 yd1]. rewrite !f_eq_g //. by rewrite sub_s DIST_SYM; exists y. exact: dist_cond. Qed. Lemma real_cont_atreal_local v u t x : `v real_continuous atreal x ==> real_open t ==> x IN t ==> (!y. y IN t ==> u y = v y) ==> u real_continuous atreal x`. Proof. rewrite !"GEN_ALL REAL_CONTINUOUS_CONTINUOUS_ATREAL". rewrite -!"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" REAL_OPEN => vc open_t xt v_eq_u. apply real_cont_at_local. exists `v o drop` `IMAGE lift t`. by rewrite open_t vc /= LIFT_IN_IMAGE_LIFT xt /= IN_IMAGE_LIFT_DROP !o_THM => y /v_eq_u. Qed. Implicit Type f g : `:real^N -> real`. Variable x : `:real^N`. Variable domain : `:real^N#real^N`. Section Point. (* scale *) Lemma diff2c_scale f c : `diff2c f x ==> diff2c (\x. c * f x) x`. Proof. rewrite !diff2c => [] [d2f p2c]; rewrite diff2_scale // andTb => i j. move: (p2c i j); rewrite -!"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" => p2ij. apply real_cont_at_local. move: d2f; rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] d2s. exists `(\x. c * partial2 j i f x)` s. rewrite REAL_CONTINUOUS_LMUL; first by rewr ETA_AX. rewrite open_s xs /= => y /d2s d2y. by rewrite second_partial_scale. Qed. (* neg *) Lemma diff2c_neg f : `diff2c f x ==> diff2c (\x. --f x) x`. Proof. by move/(diff2c_scale f `--(&1)`); rewrite -REAL_NEG_MINUS1. Qed. (* Composite *) Section Composite. Lemma nth_diff_strong_eq_on_open n u x : `nth_diff_strong n u x ==> ?s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_diff_strong n u y)`. Proof. rewrite !nth_diff_strong => [] [t] [open_t] [xt] dt. exists t; rewrite xt open_t /= => y yt. by exists t. Qed. Lemma diff2_imp_cont f x : `diff2 f x ==> f real_continuous at x`. Proof. rewrite diff2 => [] [s] [open_s] [xs] df. by rewrite "GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" DIFFERENTIABLE_IMP_CONTINUOUS_AT df. Qed. Lemma diff2_imp_partial_cont f i x : `diff2 f x ==> (partial i f) real_continuous at x`. Proof. rewrite diff2 => [] [s] [open_s] [xs] df. by rewrite "GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" DIFFERENTIABLE_IMP_CONTINUOUS_AT df. Qed. Lemma diff2c_uni_compose u f x : `diff2c f x ==> nth_diff_strong 2 u (f x) ==> (nth_derivative 2 u) real_continuous atreal (f x) ==> diff2c (u o f) x`. Proof. rewrite !diff2c => [] [d2f] p2c d2u u2c. rewrite diff2_uni_compose ?d2f ?d2u // andTb => i j. move: (p2c i j); rewrite -!"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" => p2ij. apply real_cont_at_local. move: d2f; rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] d2s. move: (nth_diff_strong_eq_on_open d2u) => [t] [open_t] [fxt] d2t. set r := `{z | z IN s /\ (lift o f) z IN (IMAGE lift t)}`. have open_r : `open r`. rewrite -r_def CONTINUOUS_OPEN_PREIMAGE -REAL_OPEN open_t open_s !andbT. apply DIFFERENTIABLE_IMP_CONTINUOUS_ON; rewrite differentiable_on => y ys; rewr ETA_AX. rewrite DIFFERENTIABLE_AT_WITHIN. move: (d2s ys); rewrite diff2 => [] [s'] [_] [ys']. by move/(_ ys') => /=. exists `(\x. (nth_derivative 2 u (f x) * partial j f x) * partial i f x + derivative u (f x) * partial2 j i f x)` r. rewrite open_r -r_def !IN_ELIM_THM /= o_THM LIFT_IN_IMAGE_LIFT; split; last first. move => y [z] [] [zs] fzt yz. by rewrite second_partial_uni_compose // yz d2s // d2t. split; last by exists x. rewrite REAL_CONTINUOUS_ADD !REAL_CONTINUOUS_MUL //=; rewr ETA_AX; rewrite ?(diff2_imp_partial_cont, d2s) //. rewrite andbT -[`nth_derivative 2 u _1`]o_THM; rewr ETA_AX. rewrite "GEN_ALL REAL_CONTINUOUS_CONTINUOUS1". rewrite o_ASSOC CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE diff2_imp_cont ?d2s // andTb. by rewrite -"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" REAL_CONTINUOUS_ATREAL_WITHINREAL. rewrite p2ij andbT -[`derivative u _`]o_THM; rewr ETA_AX. rewrite "GEN_ALL REAL_CONTINUOUS_CONTINUOUS1". rewrite o_ASSOC CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE diff2_imp_cont ?d2s // andTb. rewrite -"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" REAL_CONTINUOUS_ATREAL_WITHINREAL. rewrite -nth_derivative1; apply nth_derivative_continuous. exists `2`; split; last by arith. by move: (d2t fxt); rewrite nth_diff_strong nth_differentiable_on => [] [t'] [_] [fxt'] ->. Qed. Lemma real_open_delete s x : `real_open s ==> real_open (s DELETE x)`. rewrite !REAL_OPEN => /OPEN_DELETE /(_ `lift x`). by rewrite IMAGE_DELETE_INJ_COMPAT ?LIFT_EQ. Qed. (* inv *) Lemma diff2c_inv_compose f : `~(f x = &0) ==> diff2c f x ==> diff2c (inv o f) x`. Proof. move => fn0 d2f; rewrite diff2c_uni_compose. rewrite (diff2_inv fn0) d2f /=. apply: real_cont_atreal_local. exists `\x. &2 * inv (x pow 3)` `UNIV DELETE (&0)`. rewrite real_open_delete ?REAL_OPEN_UNIV /= !IN_DELETE !IN_UNIV fn0 /=; split; last first. by move => y yn0; rewrite second_derivative_inv. rewrite REAL_CONTINUOUS_LMUL REAL_CONTINUOUS_INV_ATREAL REAL_CONTINUOUS_POW ?REAL_CONTINUOUS_AT_ID. by rewrite REAL_POW_NZ. Qed. (* sqrt *) Lemma diff2c_sqrt_compose f : `&0 < f x ==> diff2c f x ==> diff2c (sqrt o f) x`. Proof. move => fn0 d2f; rewrite diff2c_uni_compose. rewrite (diff2_sqrt fn0) d2f /=. apply: real_cont_atreal_local. exists `\x. -- inv (&4 * sqrt (x pow 3))` `{x | x > &0}`. rewrite REAL_OPEN_HALFSPACE_GT !IN_ELIM_THM /= !real_gt; split; last first. by move => y [z] [z0] ->; rewrite second_derivative_sqrt. split; last by exists `f x`. rewrite REAL_CONTINUOUS_NEG REAL_CONTINUOUS_INV_ATREAL REAL_CONTINUOUS_LMUL; last first. rewrite REAL_ENTIRE negb_or andTb; split; first by arith. rewrite SQRT_EQ_0_COMPAT ?REAL_POW_NZ ?REAL_POS_NZ // REAL_POW_LE. by move: fn0; arith. have ->: `(\x. sqrt (x pow 3)) = (sqrt o (\x. x pow 3))`. by rewrite FUN_EQ_THM o_THM. rewrite REAL_CONTINUOUS_ATREAL_COMPOSE /= REAL_CONTINUOUS_POW ?REAL_CONTINUOUS_AT_ID andTb. by rewrite REAL_CONTINUOUS_AT_SQRT REAL_POW_LT. Qed. (* atn *) Lemma diff2c_atn_compose f : `diff2c f x ==> diff2c (atn o f) x`. move => d2f; rewrite diff2c_uni_compose. rewrite diff2_atn d2f /= nth_derivative2 second_derivative_atn. rewrite !REAL_CONTINUOUS_MUL ?REAL_CONTINUOUS_CONST ?REAL_CONTINUOUS_AT_ID //=. rewrite REAL_CONTINUOUS_POW REAL_CONTINUOUS_INV_ATREAL REAL_CONTINUOUS_ADD ?andTb. by rewrite REAL_CONTINUOUS_CONST REAL_CONTINUOUS_POW ?REAL_CONTINUOUS_AT_ID. rewrite REAL_RNEG_UNIQ. have := REAL_LE_POW_2 `f x`. by arith. Qed. (* acs *) Lemma diff2c_acs_compose f : `abs (f x) < &1 ==> diff2c f x ==> diff2c (acs o f) x`. Proof. move => fn1 d2f; rewrite diff2c_uni_compose. rewrite (diff2_acs fn1) d2f /=. apply: real_cont_atreal_local. exists `\x. --(x / sqrt ((&1 - x * x) pow 3))` `{x | x < &1} INTER {x | x > -- &1}`. rewrite REAL_OPEN_INTER ?REAL_OPEN_HALFSPACE_GT ?REAL_OPEN_HALFSPACE_LT //. rewrite !IN_INTER !IN_ELIM_THM /= !real_gt; split; last first. move => y [] [a] [a1] -> [b] [b1] ab; rewrite second_derivative_acs //. by move: ab b1 a1; arith. split; last by split; exists `f x`; move: fn1; arith. rewrite REAL_CONTINUOUS_NEG. apply REAL_CONTINUOUS_DIV_ATREAL. have h: `&0 < (&1 - f x * f x) pow 3`. rewrite REAL_POW_LT. rewrite "REAL_ARITH `!a. &1 - a * a = (&1 - a) * (&1 + a)`" REAL_LT_MUL. by move: fn1; arith. rewrite REAL_CONTINUOUS_AT_ID /=; split; last first. by rewrite SQRT_EQ_0_COMPAT ?REAL_LE_LT // REAL_LT_IMP_NZ. have ->: `(\x. sqrt ((&1 - x * x) pow 3)) = sqrt o (\x. (&1 - x * x) pow 3)`. by rewrite FUN_EQ_THM o_THM. rewrite REAL_CONTINUOUS_ATREAL_COMPOSE REAL_CONTINUOUS_AT_SQRT //=. rewrite REAL_CONTINUOUS_POW REAL_CONTINUOUS_SUB REAL_CONTINUOUS_CONST. by rewrite REAL_CONTINUOUS_MUL ?REAL_CONTINUOUS_AT_ID. Qed. End Composite. (* add *) Lemma diff2c_add f g : `diff2c f x ==> diff2c g x ==> diff2c (\x. f x + g x) x`. Proof. rewrite !diff2c => [] [d2f p2f] [d2g p2g]; rewrite diff2_add // andTb => i j. move: (p2f i j) (p2g i j); rewrite -!"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" => p2fij p2gij. apply real_cont_at_local. move: d2f d2g; rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] d2f. rewrite diff2_eq_diff2_on_open => [] [t] [open_t] [xt] d2g. exists `(\x. partial2 j i f x + partial2 j i g x)` `s INTER t`. rewrite !IN_INTER xs xt OPEN_INTER //= REAL_CONTINUOUS_ADD /=; first by rewr ETA_AX. by move => y [ys yt]; rewrite second_partial_add ?d2f ?d2g. Qed. (* sub *) Lemma diff2c_sub f g : `diff2c f x ==> diff2c g x ==> diff2c (\x. f x - g x) x`. Proof. by move => d2f d2g; rewrite real_sub diff2c_add // diff2c_neg. Qed. (* mul *) Lemma diff2c_mul f g : `diff2c f x ==> diff2c g x ==> diff2c (\x. f x * g x) x`. rewrite !diff2c => [] [d2f p2f] [d2g p2g]; rewrite diff2_mul // andTb => i j. move: (p2f i j) (p2g i j); rewrite -!"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" => p2fij p2gij. apply real_cont_at_local. move: d2f d2g; rewrite diff2_eq_diff2_on_open => [] [s] [open_s] [xs] d2f. rewrite diff2_eq_diff2_on_open => [] [t] [open_t] [xt] d2g. exists `(\x. (partial2 j i f x * g x + partial i f x * partial j g x) + partial j f x * partial i g x + f x * partial2 j i g x)` `s INTER t`. rewrite !IN_INTER xs xt OPEN_INTER //=; split; last first. by move => y [ys yt]; rewrite second_partial_mul ?d2f ?d2g. by rewrite !REAL_CONTINUOUS_ADD // !REAL_CONTINUOUS_MUL; rewr ETA_AX //; rewrite ?p2gij ?p2fij /= ?diff2_imp_partial_cont ?diff2_imp_cont ?d2f ?d2g. Qed. End Point. (* Domain *) Section Domain. Variables f g : `:real^N -> real`. Hypothesis d2f : `diff2c_domain domain f`. (* scale *) Lemma diff2c_domain_scale c : `diff2c_domain domain (\x. c * f x)`. Proof. by move: d2f; rewrite !diff2c_domain => d2f x x_in; rewrite diff2c_scale d2f. Qed. (* neg *) Lemma diff2c_domain_neg : `diff2c_domain domain (\x. --f x)`. Proof. by move: d2f; rewrite !diff2c_domain => d2f x x_in; rewrite diff2c_neg d2f. Qed. Variable bounds : `:real#real`. (* inv *) Lemma diff2c_domain_inv_compose : `m_bounded_on_int f domain bounds ==> interval_not_zero bounds ==> diff2c_domain domain (inv o f)`. move: d2f; rewrite m_bounded_on_int !diff2c_domain => d2f ineq n0 x x_in. by rewrite diff2c_inv_compose d2f // andbT (interval_arith_not_zero (ineq x_in)). Qed. (* sqrt *) Lemma diff2c_domain_sqrt_compose : `m_bounded_on_int f domain bounds ==> interval_pos bounds ==> diff2c_domain domain (sqrt o f)`. move: d2f; rewrite m_bounded_on_int !diff2c_domain => d2f ineq n0 x x_in. by rewrite diff2c_sqrt_compose d2f // andbT (interval_arith_pos (ineq x_in)). Qed. (* atn *) Lemma diff2c_domain_atn_compose : `diff2c_domain domain (atn o f)`. Proof. by move: d2f; rewrite !diff2c_domain => d2f x x_in; rewrite diff2c_atn_compose d2f. Qed. (* acs *) Lemma diff2c_domain_acs_compose : `m_bounded_on_int f domain bounds ==> iabs bounds < &1 ==> diff2c_domain domain (acs o f)`. move: d2f; rewrite m_bounded_on_int !diff2c_domain => d2f ineq n0 x x_in. by rewrite diff2c_acs_compose d2f // andbT (interval_arith_abs (ineq x_in)). Qed. (* Binary *) Hypothesis d2g : `diff2c_domain domain g`. (* add *) Lemma diff2c_domain_add : `diff2c_domain domain (\x. f x + g x)`. Proof. by move: d2f d2g; rewrite !diff2c_domain => d2f d2g x x_in; rewrite diff2c_add d2f ?d2g. Qed. (* sub *) Lemma diff2c_domain_sub : `diff2c_domain domain (\x. f x - g x)`. Proof. by move: d2f d2g; rewrite !diff2c_domain => d2f d2g x x_in; rewrite diff2c_sub d2f ?d2g. Qed. (* mul *) Lemma diff2c_domain_mul : `diff2c_domain domain (\x. f x * g x)`. Proof. by move: d2f d2g; rewrite !diff2c_domain => d2f d2g x x_in; rewrite diff2c_mul d2f ?d2g. Qed. End Domain. End Diff2c. (* m_lin_approx lemmas *) Section M_LinApprox. Variables f g : `:real^N -> real`. Variables bounds : `:real#real`. Variables d_bounds_list : `:(real#real)list`. Variable x : `:real^N`. (* neg *) Lemma m_lin_approx_neg : `(lift o f) differentiable at x ==> interval_arith (--f x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (--partial i f x) int) ==> m_lin_approx (\x. --f x) x bounds d_bounds_list`. move => df b db. rewrite m_lin_approx /= b f_lift_neg DIFFERENTIABLE_NEG ?andTb; first by rewr ETA_AX. by "ASM_SIMP_TAC[partial_neg]". Qed. (* scale *) Lemma m_lin_approx_scale c : `(lift o f) differentiable at x ==> interval_arith (c * f x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (c * partial i f x) int) ==> m_lin_approx (\x. c * f x) x bounds d_bounds_list`. move => df bH dbH. rewrite m_lin_approx /= bH f_lift_scale DIFFERENTIABLE_CMUL ?andTb; first by rewr ETA_AX. by "ASM_SIMP_TAC[partial_scale]". Qed. (* add *) Lemma m_lin_approx_add : `(lift o f) differentiable at x ==> (lift o g) differentiable at x ==> interval_arith (f x + g x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f x + partial i g x) int) ==> m_lin_approx (\x. f x + g x) x bounds d_bounds_list`. move => df dg bH dbH. rewrite m_lin_approx /= bH f_lift_add DIFFERENTIABLE_ADD ?andTb; first by rewr ETA_AX. by "ASM_SIMP_TAC[partial_add]". Qed. (* sub *) Lemma m_lin_approx_sub : `(lift o f) differentiable at x ==> (lift o g) differentiable at x ==> interval_arith (f x - g x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f x - partial i g x) int) ==> m_lin_approx (\x. f x - g x) x bounds d_bounds_list`. move => df dg bH dbH. rewrite m_lin_approx /= bH f_lift_sub DIFFERENTIABLE_SUB ?andTb; first by rewr ETA_AX. by "ASM_SIMP_TAC[partial_sub]". Qed. (* mul *) Lemma m_lin_approx_mul : `(lift o f) differentiable at x ==> (lift o g) differentiable at x ==> interval_arith (f x * g x) bounds ==> all_n 1 d_bounds_list (\i int. interval_arith (partial i f x * g x + f x * partial i g x) int) ==> m_lin_approx (\x. f x * g x) x bounds d_bounds_list`. move => df dg bH dbH. rewrite m_lin_approx /= bH differentiable_mul // !andTb. by "ASM_SIMP_TAC[partial_mul]". Qed. End M_LinApprox. (* m_taylor_interval *) "let second_bounded = new_definition `second_bounded f domain dd_bounds_list <=> !x. x IN interval [domain] ==> all_n 1 dd_bounds_list (\i list_i. all_n 1 list_i (\j int. interval_arith (partial2 j i f x) int))`". "let m_taylor_interval = new_definition `m_taylor_interval f domain y w f_bounds d_bounds_list dd_bounds_list <=> m_cell_domain domain y w /\ diff2c_domain domain f /\ m_lin_approx f y f_bounds d_bounds_list /\ second_bounded f domain dd_bounds_list`". (* Arithmetic of m_taylor_interval *) Section M_TaylorIntervalArith. Variables f g : `:real^N -> real`. Variables x z y w : `:real^N`. Variable domain : `:real^N#real^N`. Variables f_bounds g_bounds bounds : `:real#real`. Variables df_bounds_list dg_bounds_list d_bounds_list : `:(real#real)list`. Variables ddf_bounds_list ddg_bounds_list dd_bounds_list : `:((real#real)list)list`. Hypothesis domainH : `m_cell_domain domain y w`. (* Unary operations *) Hypothesis d2f : `diff2c_domain domain f`. (* inv *) Lemma m_taylor_inv_compose : `m_bounded_on_int f domain f_bounds ==> interval_not_zero f_bounds ==> m_lin_approx (inv o f) y bounds d_bounds_list ==> second_bounded (inv o f) domain dd_bounds_list ==> m_taylor_interval (inv o f) domain y w bounds d_bounds_list dd_bounds_list`. move => bf fn0 lin second; rewrite m_taylor_interval. by rewrite (diff2c_domain_inv_compose d2f bf). Qed. (* sqrt *) Lemma m_taylor_sqrt_compose : `m_bounded_on_int f domain f_bounds ==> interval_pos f_bounds ==> m_lin_approx (sqrt o f) y bounds d_bounds_list ==> second_bounded (sqrt o f) domain dd_bounds_list ==> m_taylor_interval (sqrt o f) domain y w bounds d_bounds_list dd_bounds_list`. move => bf fn0 lin second; rewrite m_taylor_interval. by rewrite (diff2c_domain_sqrt_compose d2f bf). Qed. (* atn *) Lemma m_taylor_atn_compose : `m_lin_approx (atn o f) y bounds d_bounds_list ==> second_bounded (atn o f) domain dd_bounds_list ==> m_taylor_interval (atn o f) domain y w bounds d_bounds_list dd_bounds_list`. by move => lin second; rewrite m_taylor_interval diff2c_domain_atn_compose. Qed. (* acs *) Lemma m_taylor_acs_compose : `m_bounded_on_int f domain f_bounds ==> iabs f_bounds < &1 ==> m_lin_approx (acs o f) y bounds d_bounds_list ==> second_bounded (acs o f) domain dd_bounds_list ==> m_taylor_interval (acs o f) domain y w bounds d_bounds_list dd_bounds_list`. move => bf fn0 lin second; rewrite m_taylor_interval. by rewrite (diff2c_domain_acs_compose d2f bf). Qed. (* neg *) Lemma m_taylor_neg : `m_lin_approx (\x. --f x) y bounds d_bounds_list ==> second_bounded (\x. --f x) domain dd_bounds_list ==> m_taylor_interval (\x. --f x) domain y w bounds d_bounds_list dd_bounds_list`. Proof. by move => lin second; rewrite m_taylor_interval diff2c_domain_neg. Qed. (* scale *) Lemma m_taylor_scale c : `m_lin_approx (\x. c * f x) y bounds d_bounds_list ==> second_bounded (\x. c * f x) domain dd_bounds_list ==> m_taylor_interval (\x. c * f x) domain y w bounds d_bounds_list dd_bounds_list`. Proof. by move => lin second; rewrite m_taylor_interval diff2c_domain_scale. Qed. (* Binary operations *) Hypothesis d2g : `diff2c_domain domain g`. (* add *) Lemma m_taylor_add : `m_lin_approx (\x. f x + g x) y bounds d_bounds_list ==> second_bounded (\x. f x + g x) domain dd_bounds_list ==> m_taylor_interval (\x. f x + g x) domain y w bounds d_bounds_list dd_bounds_list`. Proof. by move => lin second; rewrite m_taylor_interval diff2c_domain_add. Qed. (* sub *) Lemma m_taylor_sub : `m_lin_approx (\x. f x - g x) y bounds d_bounds_list ==> second_bounded (\x. f x - g x) domain dd_bounds_list ==> m_taylor_interval (\x. f x - g x) domain y w bounds d_bounds_list dd_bounds_list`. Proof. by move => lin second; rewrite m_taylor_interval diff2c_domain_sub. Qed. (* mul *) Lemma m_taylor_mul : `m_lin_approx (\x. f x * g x) y bounds d_bounds_list ==> second_bounded (\x. f x * g x) domain dd_bounds_list ==> m_taylor_interval (\x. f x * g x) domain y w bounds d_bounds_list dd_bounds_list`. Proof. by move => lin second; rewrite m_taylor_interval diff2c_domain_mul. Qed. End M_TaylorIntervalArith. (* Partial convex *) Section PartialConvex. Implicit Type f : `:real^N->real`. Lemma REAL_LE_DIV_1 a b: `&0 < b ==> (a / b <= &1 <=> a <= b)`. Proof. by move => b_gt; rewrite REAL_LE_LDIV_EQ // REAL_MUL_LID. Qed. Lemma partial_convex_max f j x z u v hi : `(!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i /\ v$i = x$i) ==> u$j = x$j ==> v$j = z$j ==> diff2_domain (x,z) f ==> (!y. y IN interval [x,z] ==> &0 <= partial2 j j f y) ==> (!y. y IN interval [x,u] ==> f y <= hi) ==> (!y. y IN interval [v,z] ==> f y <= hi) ==> (!y. y IN interval [x,z] ==> f y <= hi)`. rewrite IN_NUMSEG => uv_eq ux_eq vz_eq. rewrite diff2_domain => diff2_f partial2_pos bound1 bound2 y y_in. set y1 := `(lambda i. if i = j then x$j else y$i):real^N`. set y2 := `(lambda i. if i = j then z$j else y$i):real^N`. move: y_in; rewrite "GEN_ALL IN_INTERVAL" => y_in. have [y1_in y2_in] :`y1 IN interval [x,u] /\ y2 IN interval [v,z]`. rewrite -y1_def -y2_def !"GEN_ALL IN_INTERVAL". by split => i i_ineq; rewrite "GEN_ALL LAMBDA_BETA" //; case: (EXCLUDED_MIDDLE `i = j`) => /= ij; rewrite ?(ux_eq, vz_eq) ?REAL_LE_REFL //; rewrite uv_eq // !y_in. case: (EXCLUDED_MIDDLE `j IN 1..dimindex (:N)`); last first; rewrite IN_NUMSEG => j_in. suff: `y1 = y`; first by move => <-; apply: bound1. rewrite CART_EQ => i i_in. have inj: `~(i = j)`; first by move: j_in i_in; arith. by rewrite -y1_def "GEN_ALL LAMBDA_BETA". suff: `f y <= max (f y1) (f y2)`. move => cond. apply: ("REWRITE_RULE[GSYM IMP_IMP] REAL_LE_TRANS" cond). by move: (bound1 y1_in) (bound2 y2_in); arith. set g := `f o (\t. y1 + t % basis j)`. have ->: `f y1 = g (&0)`. by rewrite -g_def o_THM /= VECTOR_MUL_LZERO VECTOR_ADD_RID. have y_eq : `y = y1 + (y$j - x$j) % basis j /\ y2 = y1 + (z$j - x$j) % basis j`. rewrite !CART_EQ; split => i i_in; rewrite VECTOR_ADD_COMPONENT VECTOR_MUL_COMPONENT BASIS_COMPONENT //; case: (EXCLUDED_MIDDLE `i = j`) => /= ij; rewrite -?(y1_def, y2_def) !"GEN_ALL LAMBDA_BETA" //= ?REAL_MUL_RID ?REAL_SUB_ADD2 //. by rewrite ij /=; arith. by rewrite ij /=; arith. have ->: `f y = g (y$j - x$j)`; first by rewrite -g_def o_THM /= -y_eq. have ->: `f y2 = g (z$j - x$j)`; first by rewrite -g_def o_THM /= -y_eq. case: (EXCLUDED_MIDDLE `z$j = x$j`) => zx_j. suff: `y$j = x$j`; first by move => ->; rewrite zx_j REAL_SUB_REFL; arith. by move: (y_in j_in); rewrite zx_j; arith. set t := `(y$j - x$j) / (z$j - x$j)`. have zx_pos : `&0 < z$j - x$j`. rewrite "REAL_ARITH `!a b. &0 < a - b <=> ~(a = b) /\ b <= a`" zx_j /=. by apply: REAL_LE_TRANS; exists `y$j`; rewrite !y_in. have t_props : `&0 <= t /\ t <= &1 /\ y$j - x$j = (&1 - t) * &0 + t * (z$j - x$j)`. rewrite -t_def REAL_LE_DIV_1 // REAL_MUL_RZERO REAL_ADD_LID. rewrite real_div -"GEN_ALL REAL_MUL_ASSOC". rewrite REAL_MUL_LINV ?REAL_SUB_0 // REAL_MUL_RID /=. rewrite !real_sub REAL_LE_RADD y_in // andbT -!real_sub. rewrite REAL_LE_MUL REAL_LE_INV; first by rewrite "REAL_ARITH `!a. &0 < a ==> &0 <= a`". by rewrite REAL_SUB_LE y_in. rewrite t_props; apply: "GEN_ALL REAL_CONVEX_LOWER". exists `real_interval [&0, z$j - x$j]`. rewrite REAL_SUB_ADD REAL_SUB_LE !t_props !IN_REAL_INTERVAL !REAL_LE_REFL /=. rewrite "REAL_ARITH `!a. &0 < a ==> &0 <= a`" // andbT. set s := `real_interval _`; move: t_def t_props => _ _. have in_s : `!t. t IN s ==> y1 + t % basis j IN interval [x,z]`. rewrite -s_def IN_REAL_INTERVAL "GEN_ALL IN_INTERVAL" => t t_ineq i i_ineq. rewrite !VECTOR_ADD_COMPONENT VECTOR_MUL_COMPONENT BASIS_COMPONENT //. rewrite -y1_def "GEN_ALL LAMBDA_BETA" //=. case: (EXCLUDED_MIDDLE `i = j`) => /= ij; last first. by rewrite REAL_MUL_RZERO REAL_ADD_RID !y_in. by move: (y_in i_ineq) t_ineq; rewrite ij; arith. have diff2_g : `!t. t IN s ==> nth_diff_strong 2 g t`. by move => t ts; rewrite -g_def; rewrite diff2_dir diff2_f in_s. have dg : `!t. t IN s ==> derivative g t = partial j f (y1 + t % basis j)`. move => t ts; rewrite partial. move: (in_s ts) => p_in; set h := `f o _`. have ->: `h = g o (\t'. t + t')`. rewrite -eq_ext -h_def -g_def => r; rewrite !o_THM /=. by rewrite "GEN_ALL VECTOR_ADD_RDISTRIB" "GEN_ALL VECTOR_ADD_ASSOC". rewrite -derivative_translation //. by move: (diff2_g ts); rewrite nth_diff_strong2_eq => [] [e] [_] [te] ->. have d2g : `!t. t IN s ==> nth_derivative 2 g t = partial2 j j f (y1 + t % basis j)`. move => t ts; rewrite -g_def diff2_dir_derivative2 ?diff2_f ?in_s //. have s_eq: `1..dimindex (:N) = ((1..dimindex (:N)) DELETE j) UNION {j}`. rewrite EXTENSION IN_UNION IN_SING IN_DELETE => i; split. by move => ->; rewrite andTb orNb. by case => /=; rewrite IN_NUMSEG. have disj: `DISJOINT ((1..dimindex (:N)) DELETE j) {j}`. rewrite DISJOINT EXTENSION IN_INTER IN_SING NOT_IN_EMPTY IN_DELETE => i. by rewrite -andbA andNb andbF. rewrite {1}s_eq SUM_UNION ?FINITE_DELETE ?FINITE_NUMSEG ?FINITE_SING // SUM_SING /=. rewrite SUM_EQ_0 ?IN_DELETE ?REAL_ADD_LID. move => i i_in; apply SUM_EQ_0 => k k_in /=. by rewrite BASIS_COMPONENT -?IN_NUMSEG // i_in /= REAL_MUL_LZERO. rewrite s_eq SUM_UNION ?FINITE_DELETE ?FINITE_NUMSEG ?FINITE_SING // SUM_SING /=. rewrite SUM_EQ_0 ?IN_DELETE ?REAL_ADD_LID. move => i i_in /=; rewrite REAL_ENTIRE; right. by rewrite BASIS_COMPONENT -?IN_NUMSEG // i_in /= REAL_MUL_LZERO. by rewrite BASIS_COMPONENT ?j_in //= !REAL_MUL_LID partial2 o_THM. have := REAL_CONVEX_ON_SECOND_DERIVATIVE g `derivative g` `nth_derivative 2 g` s. rewrite -{1 2}s_def IS_REALINTERVAL_INTERVAL andTb NOT_EXISTS_THM => ->; last first. by move => t ts; rewrite d2g // partial2_pos in_s. split. move => t; apply: contraT; rewrite negbK EXTENSION IN_SING => eq. move: (eq `&0`) (eq `z$j - x$j`) zx_pos; rewrite !IN_REAL_INTERVAL !REAL_LE_REFL. by arith. split => t ts. move: (diff2_g ts); rewrite nth_diff_strong2_eq_alt => [] [e] [_] [te] H. by rewrite HAS_REAL_DERIVATIVE_ATREAL_WITHIN H. move: (diff2_g ts); rewrite nth_diff_strong2_eq_alt => [] [e] [_] [te] H. by rewrite HAS_REAL_DERIVATIVE_ATREAL_WITHIN H. Qed. End PartialConvex. (* Elementary functions and their taylor intervals *) Section ElementaryFunctions. Lemma f_lift_const c : `lift o (\x. c) = (\x. lift c)`. by rewrite -eq_ext o_THM. Qed. Lemma f_lift_unary f : `lift o (\x. f x) = (\x. lift (f x))`. by rewrite -eq_ext o_THM. Qed. (* const *) Lemma diff2_const c x : `diff2 (\x:real^N. c) x`. rewrite diff2; exists `(:real^N)`; rewrite OPEN_UNIV IN_UNIV !andTb => y _. by rewrite partial_const !f_lift_const !DIFFERENTIABLE_CONST. Qed. Lemma diff2_domain_const c domain : `diff2_domain domain (\x:real^N. c)`. by rewrite diff2_domain diff2_const. Qed. Lemma partial2_const i j c : `partial2 i j (\x:real^N. c) = (\x. &0)`. by rewrite partial2 !partial_const. Qed. Lemma diff2c_const c x : `diff2c (\x:real^N. c) x`. by rewrite diff2c diff2_const partial2_const -"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" REAL_CONTINUOUS_CONST. Qed. Lemma diff2c_domain_const c domain : `diff2c_domain domain (\x:real^N. c)`. Proof. by rewrite diff2c_domain diff2c_const. Qed. (* x$k *) Lemma partial_x_lemma k i : `partial i (\x:real^N. x$k) = (\x. (basis i:real^N)$k)`. rewrite -eq_ext partial => x /=. have ->: `(\x. x$k) o (\t. x + t % basis i) = (\t. x$k + t * (basis i:real^N)$k)`. by rewrite -eq_ext o_THM /= VECTOR_ADD_COMPONENT VECTOR_MUL_COMPONENT. rewrite derivative_add ?REAL_DIFFERENTIABLE_MUL_ATREAL ?REAL_DIFFERENTIABLE_CONST //. by rewrite REAL_DIFFERENTIABLE_ID REAL_DIFFERENTIABLE_CONST. rewrite derivative_const /= derivative_mul ?REAL_DIFFERENTIABLE_ID ?REAL_DIFFERENTIABLE_CONST //. by rewrite derivative_x derivative_const; arith. Qed. Lemma partial_x k i : `k IN 1..dimindex (:N) ==> partial i (\x:real^N. x$k) = (\x. if i = k then &1 else &0)`. by move => k_ineq; rewrite partial_x_lemma BASIS_COMPONENT -?IN_NUMSEG //; arith. Qed. Lemma partial2_x k i j : `partial2 i j (\x:real^N. x$k) = (\x. &0)`. by rewrite partial2 partial_x_lemma partial_const. Qed. Lemma diff2_x k x : `k IN 1..dimindex (:N) ==> diff2 (\x:real^N. x$k) x`. move => k_ineq; rewrite diff2; exists `(:real^N)`; rewrite OPEN_UNIV IN_UNIV !andTb => y _. by rewrite projection_diff // partial_x_lemma !f_lift_unary DIFFERENTIABLE_CONST. Qed. Lemma diff2_domain_x k domain : `k IN 1..dimindex (:N) ==> diff2_domain domain (\x:real^N. x$k)`. by move/diff2_x; rewrite diff2_domain => ->. Qed. Lemma diff2c_x k x : `k IN 1..dimindex (:N) ==> diff2c (\x:real^N. x$k) x`. Proof. move => k_ineq; rewrite diff2c diff2_x //. by rewrite -"GEN_ALL REAL_CONTINUOUS_CONTINUOUS1" partial2_x REAL_CONTINUOUS_CONST. Qed. Lemma diff2c_domain_x k domain : `k IN 1..dimindex (:N) ==> diff2c_domain domain (\x:real^N. x$k)`. by move/diff2c_x; rewrite diff2c_domain => ->. Qed. End ElementaryFunctions. hol-light/Formal_ineqs/taylor/theory/taylor_interval-compiled.hl000066400000000000000000011026161303454263000255540ustar00rootroot00000000000000needs "lib/ssrbool-compiled.hl";; needs "lib/ssrnat-compiled.hl";; needs "arith/interval_arith.hl";; needs "Multivariate/realanalysis.ml";; open Interval_arith;; prioritize_real();; let derivative = new_definition `derivative f = \y. @d. (f has_real_derivative d) (atreal y)`;; let nth_derivative = new_definition `nth_derivative n f = iter n derivative f`;; let nth_differentiable = define `(nth_differentiable 0 f x <=> f real_continuous atreal x) /\ (nth_differentiable (SUC n) f x <=> nth_differentiable n f x /\ nth_derivative n f real_differentiable atreal x)`;; let nth_differentiable_on = new_definition `nth_differentiable_on n s f <=> !x. x IN s ==> nth_differentiable n f x`;; let nth_differentiable_on_int = new_definition `nth_differentiable_on_int n int f <=> !x. interval_arith x int ==> nth_differentiable n f x`;; let nth_diff_weak = new_definition `nth_diff_weak n f x <=> f real_continuous atreal x /\ ?F. F 0 = f /\ !i. i < n ==> (F i has_real_derivative F (SUC i) x) (atreal x)`;; let nth_diff_strong = new_definition `nth_diff_strong n f x <=> ?s. real_open s /\ x IN s /\ nth_differentiable_on n s f`;; let nth_diff_strong_int = new_definition `nth_diff_strong_int n int f <=> !x. interval_arith x int ==> nth_diff_strong n f x`;; (* Section NthDerivatives *) begin_section "NthDerivatives";; (* Lemma has_derivative_cond *) let has_derivative_cond = section_proof ["f";"x"] `(?d. (f has_real_derivative d) (atreal x)) ==> (f has_real_derivative (derivative f x)) (atreal x)` [ (BETA_TAC THEN (case THEN (move ["d"])) THEN (move ["df"])); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`derivative f x = d`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) (exact_tac)); (((((use_arg_then "derivative")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (((use_arg_then "SELECT_UNIQUE") (thm_tac apply_tac)) THEN (simp_tac) THEN (move ["y"])) THEN ((THENL) (split_tac) [(move ["df2"]); ((((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))])); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_DERIVATIVE_UNIQUE_ATREAL") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN (done_tac)); ];; (* Lemma has_derivative_alt *) let has_derivative_alt = section_proof ["f";"x"] `f real_differentiable atreal x ==> (f has_real_derivative (derivative f x)) (atreal x)` [ (((((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "has_derivative_cond") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (done_tac)); ];; (* Lemma derivative_unique *) let derivative_unique = section_proof ["f";"f'";"x"] `(f has_real_derivative f') (atreal x) ==> derivative f x = f'` [ ((BETA_TAC THEN (move ["df"])) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_DERIVATIVE_UNIQUE_ATREAL") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac))); (((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_cond")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN ((use_arg_then "f'") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma derivative_unique_on *) let derivative_unique_on = section_proof ["s";"f";"f'"] `(!x. x IN s ==> (f has_real_derivative f' x) (atreal x)) ==> (!x. x IN s ==> f' x = derivative f x)` [ (BETA_TAC THEN (move ["df"]) THEN (move ["x"]) THEN (move ["xs"])); (((((fun arg_tac -> (fun arg_tac -> (use_arg_then "derivative_unique") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f' x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma has_derivative_lemma *) let has_derivative_lemma = section_proof ["f";"f'";"x"] `f real_differentiable atreal x /\ derivative f x = f' ==> (f has_real_derivative f') (atreal x)` [ ((BETA_TAC THEN (case THEN ((move ["diff"]) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))))) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma nth_derivative0 *) let nth_derivative0 = section_proof ["f"] `nth_derivative 0 f = f` [ (((((use_arg_then "nth_derivative")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL iter)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nth_derivativeS *) let nth_derivativeS = section_proof ["n";"f"] `nth_derivative (SUC n) f = derivative (nth_derivative n f)` [ (((repeat_tactic 1 9 (((use_arg_then "nth_derivative")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "iterS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nth_Sderivative *) let nth_Sderivative = section_proof ["n";"f"] `nth_derivative (SUC n) f = nth_derivative n (derivative f)` [ (((((use_arg_then "nth_derivative")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iterSr")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_derivative")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma nth_derivative1 *) let nth_derivative1 = section_proof ["f"] `nth_derivative 1 f = derivative f` [ (((((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_derivativeS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nth_derivative2 *) let nth_derivative2 = section_proof ["f"] `nth_derivative 2 f = derivative (derivative f)` [ (((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `2 = SUC(SUC 0)`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "iterS")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL iter)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nth_derivative_add *) let nth_derivative_add = section_proof ["n";"m";"f"] `nth_derivative n (nth_derivative m f) = nth_derivative (n + m) f` [ (((repeat_tactic 1 9 (((use_arg_then "nth_derivative")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "iter_add")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nth_diff_continuous *) let nth_diff_continuous = section_proof ["n";"f";"x"] `nth_differentiable n f x ==> f real_continuous atreal x` [ (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) THEN ((((use_arg_then "nth_differentiable")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); ((BETA_TAC THEN (case THEN (DISCH_THEN (fun snd_th -> (use_arg_then "IHn") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma nth_differentiable_cond *) let nth_differentiable_cond = section_proof ["n";"f";"x"] `nth_differentiable n f x ==> !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)` [ ((THENL_FIRST) ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) ((((use_arg_then "ltn0")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((((use_arg_then "nth_differentiable")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN ((DISCH_THEN (fun snd_th -> (use_arg_then "IHn") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["df_n"]) THEN (move ["dfn"]))) THEN (move ["i"])); (((((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqSS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_eqVlt")(thm_tac (new_rewrite [] []))))) THEN ((THENL) case [(((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))); ((DISCH_THEN (fun snd_th -> (use_arg_then "df_n") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN ((TRY done_tac)))])); (((((use_arg_then "nth_derivativeS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nth_differentiable_on_cond *) let nth_differentiable_on_cond = section_proof ["n";"s";"f"] `nth_differentiable_on n s f ==> !x. x IN s ==> !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)` [ ((((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (move ["cond"]) THEN (move ["x"])); (((DISCH_THEN (fun snd_th -> (use_arg_then "cond") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "nth_differentiable_cond") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (done_tac)); ];; (* Lemma nth_differentiable_eq *) let nth_differentiable_eq = section_proof ["n";"f";"x"] `nth_differentiable n f x <=> f real_continuous atreal x /\ !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)` [ ((THENL) (split_tac) [(move ["dn_f"]); (case THEN (move ["f_cont"]))]); (((((fun arg_tac -> (use_arg_then "nth_diff_continuous") (fun fst_arg -> (use_arg_then "dn_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_differentiable_cond") (disch_tac [])) THEN (clear_assumption "nth_differentiable_cond") THEN (exact_tac)) THEN (done_tac)); (((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) THEN (((((use_arg_then "nth_differentiable")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqSS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leq_eqVlt")(thm_tac (new_rewrite [] []))))) THEN (move ["cond"]))); ((THENL_FIRST) ((((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((BETA_TAC THEN (move ["i"]) THEN (move ["i_lt_n"])) THEN (((use_arg_then "cond") (disch_tac [])) THEN (clear_assumption "cond") THEN (DISCH_THEN apply_tac)) THEN (done_tac))); ((((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> arg_tac (Arg_term (`nth_derivative (SUC n) f x`))) (term_tac exists_tac))); (((use_arg_then "cond") (disch_tac [])) THEN (clear_assumption "cond") THEN (exact_tac)); ];; (* Lemma nth_differentiable_on_int2 *) let nth_differentiable_on_int2 = section_proof ["f";"int"] `nth_differentiable_on_int 2 int f ==> ?f' f''. f' = derivative f /\ f'' = nth_derivative 2 f /\ !x. interval_arith x int ==> (f has_real_derivative f' x) (atreal x) /\ (f' has_real_derivative f'' x) (atreal x)` [ ((((use_arg_then "nth_differentiable_on_int")(thm_tac (new_rewrite [] [])))) THEN (move ["h"])); ((((fun arg_tac -> arg_tac (Arg_term (`derivative f`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`nth_derivative 2 f`))) (term_tac exists_tac))) THEN (simp_tac) THEN (move ["x"]) THEN (move ["ineq"])); ((((use_arg_then "nth_derivative1")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "nth_derivative0") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (((use_arg_then "ONE")(thm_tac (new_rewrite [1] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `2 = SUC 1`)))(thm_tac (new_rewrite [] []))))); (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "nth_differentiable_cond") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "h")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma nth_mth_diff *) let nth_mth_diff = section_proof ["n";"m";"f";"x"] `n <= m ==> nth_differentiable m f x ==> nth_differentiable n f x` [ ((BETA_TAC THEN (move ["n_le_m"])) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN ((((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (move ["cond"])))) THEN ((((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (move ["i"]) THEN (move ["i_lt"]))); ((((use_arg_then "cond") (disch_tac [])) THEN (clear_assumption "cond") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "n_le_m") (disch_tac [])) THEN (clear_assumption "n_le_m") THEN ((use_arg_then "ltn_leq_trans") (disch_tac [])) THEN (clear_assumption "ltn_leq_trans") THEN (DISCH_THEN apply_tac)) THEN (done_tac)); ];; (* Lemma nth_differentiable1 *) let nth_differentiable1 = section_proof ["f";"x"] `nth_differentiable 1 f x <=> f real_differentiable atreal x` [ (((((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL nth_differentiable)))(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN ((THENL) (split_tac) [(((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))); (move ["df"])])); ((((use_arg_then "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma nth_diff_imp_diff *) let nth_diff_imp_diff = section_proof ["n";"f";"x"] `0 < n ==> nth_differentiable n f x ==> f real_differentiable atreal x` [ ((((((use_arg_then "ltE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["ineq"]) THEN (move ["df"])) THEN (((use_arg_then "nth_differentiable1")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_mth_diff") (disch_tac [])) THEN (clear_assumption "nth_mth_diff") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "n") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma nth_derivative_continuous *) let nth_derivative_continuous = section_proof ["n";"f";"x";"i"] `nth_differentiable n f x ==> i < n ==> nth_derivative i f real_continuous atreal x` [ ((((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (move ["df"])); (((DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (move ["cond"])) THEN (((use_arg_then "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL") THEN (DISCH_THEN apply_tac))); ((((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> arg_tac (Arg_term (`nth_derivative (SUC i) f x`))) (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma ith_derivative_differentiable *) let ith_derivative_differentiable = section_proof ["i";"n";"f";"x"] `nth_differentiable n f x ==> i < n ==> nth_differentiable (n - i) (nth_derivative i f) x` [ (BETA_TAC THEN (move ["dnf"])); ((((use_arg_then "dnf") (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (move ["cond"]) THEN (move ["i_lt_n"]))); (((((fun arg_tac -> (use_arg_then "nth_derivative_continuous") (fun fst_arg -> (use_arg_then "dnf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["j"]) THEN (move ["j_lt_ni"])); (((repeat_tactic 1 9 (((use_arg_then "nth_derivative_add")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addSn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "cond")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "j_lt_ni") (disch_tac [])) THEN (clear_assumption "j_lt_ni") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma nth_diff_strong_imp_diff *) let nth_diff_strong_imp_diff = section_proof ["n";"f";"x"] `nth_diff_strong n f x ==> nth_differentiable n f x` [ (((((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["xs"]))) THEN ((((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (move ["h"]))); (((use_arg_then "h") (disch_tac [])) THEN (clear_assumption "h") THEN (exact_tac)); ];; (* Section DerivativeArith *) begin_section "DerivativeArith";; (* Section ElementaryDerivatives *) begin_section "ElementaryDerivatives";; (* Lemma derivative_x *) let derivative_x = section_proof [] `derivative (\x. x) = (\x. &1)` [ ((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (simp_tac)); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ID")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma derivative_const *) let derivative_const = section_proof ["c"] `derivative (\x. c) = (\x. &0)` [ ((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (simp_tac)); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_CONST")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma derivative_inv *) let derivative_inv = section_proof ["x"] `~(x = &0) ==> derivative inv x = -- inv (x * x)` [ (BETA_TAC THEN (move ["xn0"])); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_INV_BASIC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_atn *) let derivative_atn = section_proof [] `derivative atn = (\x. inv (&1 + x * x))` [ (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["x"]) THEN (simp_tac)); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ATN")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma derivative_exp *) let derivative_exp = section_proof [] `derivative exp = exp` [ ((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (simp_tac)); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_EXP")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma derivative_acs *) let derivative_acs = section_proof ["x"] `abs x < &1 ==> derivative acs x = --inv(sqrt(&1 - x * x))` [ (BETA_TAC THEN (move ["x_ineq"])); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ACS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_sqrt *) let derivative_sqrt = section_proof ["x"] `&0 < x ==> derivative sqrt x = inv (&2 * sqrt x)` [ (BETA_TAC THEN (move ["xg0"])); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_SQRT")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma derivative_composition *) let derivative_composition = section_proof ["f";"g";"x"] `f real_differentiable atreal x ==> g real_differentiable atreal (f x) ==> derivative (\x. g (f x)) x = derivative f x * derivative g (f x)` [ ((BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "has_derivative_alt") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["df"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "has_derivative_alt") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["dg"])) THEN (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac))); ((THENL_FIRST) (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL HAS_REAL_DERIVATIVE_CHAIN))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative g`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`\y. y = f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN (ANTS_TAC)) ((BETA_TAC THEN (move ["y"]) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((BETA_TAC THEN (case THEN (move ["_"]))) THEN (DISCH_THEN apply_tac) THEN (done_tac)); ];; (* Section ElementaryCompose *) begin_section "ElementaryCompose";; (* Lemma REAL_DIFFERENTIABLE_AT_INV *) let REAL_DIFFERENTIABLE_AT_INV = section_proof ["x"] `~(x = &0) ==> inv real_differentiable atreal x` [ (BETA_TAC THEN (move ["xn0"])); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_DIFFERENTIABLE_INV_ATREAL") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`(\x. x:real)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (((simp_tac) THEN (((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xn0")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (done_tac)); ];; (add_section_var (mk_var ("f", (`:real->real`))));; (add_section_var (mk_var ("x", (`:real`))));; (add_section_hyp "df" (`f real_differentiable atreal x`));; (* Lemma derivative_compose_atn *) let derivative_compose_atn = section_proof [] `(\x. atn (f x)) real_differentiable atreal x /\ derivative (\x. atn (f x)) x = derivative f x / (&1 + f x * f x)` [ (split_tac); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`atn`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") THEN (DISCH_THEN apply_tac))); (((((use_arg_then "REAL_DIFFERENTIABLE_AT_ATN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_AT_ATN")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "derivative_atn")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_compose_exp *) let derivative_compose_exp = section_proof [] `(\x. exp (f x)) real_differentiable atreal x /\ derivative (\x. exp (f x)) x = exp (f x) * derivative f x` [ (split_tac); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`exp`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") THEN (DISCH_THEN apply_tac))); (((((use_arg_then "REAL_DIFFERENTIABLE_AT_EXP")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_AT_EXP")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "derivative_exp")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_compose_inv *) let derivative_compose_inv = section_proof [] `~(f x = &0) ==> (\x. inv (f x)) real_differentiable atreal x /\ derivative (\x. inv (f x)) x = -- inv (f x * f x) * derivative f x` [ ((THENL_FIRST) ((BETA_TAC THEN (move ["fn0"])) THEN (split_tac)) ((((use_arg_then "REAL_DIFFERENTIABLE_INV_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_INV_ATREAL") THEN (DISCH_THEN apply_tac)) THEN (done_tac))); (((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "derivative_inv")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_AT_INV")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_compose_sqrt *) let derivative_compose_sqrt = section_proof [] `&0 < f x ==> (\x. sqrt (f x)) real_differentiable atreal x /\ derivative (\x. sqrt (f x)) x = derivative f x / (&2 * sqrt (f x))` [ ((BETA_TAC THEN (move ["f_pos"])) THEN (split_tac)); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`sqrt`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") THEN (DISCH_THEN apply_tac))); (((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_AT_SQRT") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_AT_SQRT") THEN (DISCH_THEN apply_tac)) THEN (done_tac)); ((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_AT_SQRT")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "derivative_sqrt")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_compose_acs *) let derivative_compose_acs = section_proof [] `abs (f x) < &1 ==> (\x. acs (f x)) real_differentiable atreal x /\ derivative (\x. acs (f x)) x = -- (derivative f x / sqrt (&1 - f x * f x))` [ ((BETA_TAC THEN (move ["f_abs"])) THEN (split_tac)); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`acs`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") THEN (DISCH_THEN apply_tac))); (((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_AT_ACS")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_AT_ACS")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((((use_arg_then "derivative_acs")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_RNEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section ElementaryCompose *) let REAL_DIFFERENTIABLE_AT_INV = finalize_theorem REAL_DIFFERENTIABLE_AT_INV;; let derivative_compose_atn = finalize_theorem derivative_compose_atn;; let derivative_compose_exp = finalize_theorem derivative_compose_exp;; let derivative_compose_inv = finalize_theorem derivative_compose_inv;; let derivative_compose_sqrt = finalize_theorem derivative_compose_sqrt;; let derivative_compose_acs = finalize_theorem derivative_compose_acs;; end_section "ElementaryCompose";; (* Finalization of the section ElementaryDerivatives *) let derivative_x = finalize_theorem derivative_x;; let derivative_const = finalize_theorem derivative_const;; let derivative_inv = finalize_theorem derivative_inv;; let derivative_atn = finalize_theorem derivative_atn;; let derivative_exp = finalize_theorem derivative_exp;; let derivative_acs = finalize_theorem derivative_acs;; let derivative_sqrt = finalize_theorem derivative_sqrt;; let derivative_composition = finalize_theorem derivative_composition;; let REAL_DIFFERENTIABLE_AT_INV = finalize_theorem REAL_DIFFERENTIABLE_AT_INV;; let derivative_compose_atn = finalize_theorem derivative_compose_atn;; let derivative_compose_exp = finalize_theorem derivative_compose_exp;; let derivative_compose_inv = finalize_theorem derivative_compose_inv;; let derivative_compose_sqrt = finalize_theorem derivative_compose_sqrt;; let derivative_compose_acs = finalize_theorem derivative_compose_acs;; end_section "ElementaryDerivatives";; (add_section_var (mk_var ("f", (`:real -> real`))); add_section_var (mk_var ("g", (`:real -> real`))));; (add_section_var (mk_var ("x", (`:real`))); add_section_var (mk_var ("c", (`:real`))));; (add_section_hyp "df" (`f real_differentiable atreal x`));; (* Lemma derivative_scale *) let derivative_scale = section_proof [] `derivative (\x. c * f x) x = c * derivative f x` [ ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_LMUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_neg *) let derivative_neg = section_proof [] `derivative (\x. -- f x) x = -- derivative f x` [ ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_NEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_pow *) let derivative_pow = section_proof ["n"] `derivative (\x. f x pow n) x = &n * f x pow (n - 1) * derivative f x` [ ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_POW_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_hyp "dg" (`g real_differentiable atreal x`));; (* Lemma derivative_add *) let derivative_add = section_proof [] `derivative (\x. f x + g x) x = derivative f x + derivative g x` [ ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma derivative_mul *) let derivative_mul = section_proof [] `derivative (\x. f x * g x) x = f x * derivative g x + derivative f x * g x` [ ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_MUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma derivative_sub *) let derivative_sub = section_proof [] `derivative (\x. f x - g x) x = derivative f x - derivative g x` [ ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_SUB")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma derivative_div *) let derivative_div = section_proof [] `~(g x = &0) ==> derivative (\x. f x / g x) x = (derivative f x * g x - f x * derivative g x) / (g x * g x)` [ ((BETA_TAC THEN (move ["gn0"])) THEN (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_DIV_ATREAL")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); ((repeat_tactic 1 9 (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section DerivativeArith *) let derivative_x = finalize_theorem derivative_x;; let derivative_const = finalize_theorem derivative_const;; let derivative_inv = finalize_theorem derivative_inv;; let derivative_atn = finalize_theorem derivative_atn;; let derivative_exp = finalize_theorem derivative_exp;; let derivative_acs = finalize_theorem derivative_acs;; let derivative_sqrt = finalize_theorem derivative_sqrt;; let derivative_composition = finalize_theorem derivative_composition;; let REAL_DIFFERENTIABLE_AT_INV = finalize_theorem REAL_DIFFERENTIABLE_AT_INV;; let derivative_compose_atn = finalize_theorem derivative_compose_atn;; let derivative_compose_exp = finalize_theorem derivative_compose_exp;; let derivative_compose_inv = finalize_theorem derivative_compose_inv;; let derivative_compose_sqrt = finalize_theorem derivative_compose_sqrt;; let derivative_compose_acs = finalize_theorem derivative_compose_acs;; let derivative_scale = finalize_theorem derivative_scale;; let derivative_neg = finalize_theorem derivative_neg;; let derivative_pow = finalize_theorem derivative_pow;; let derivative_add = finalize_theorem derivative_add;; let derivative_mul = finalize_theorem derivative_mul;; let derivative_sub = finalize_theorem derivative_sub;; let derivative_div = finalize_theorem derivative_div;; end_section "DerivativeArith";; (* Section MoreDerivativeArith *) begin_section "MoreDerivativeArith";; (* Lemma differentiable_sum_numseg *) let differentiable_sum_numseg = section_proof ["G";"n";"m";"x"] `(!i. i IN n..m ==> G i real_differentiable atreal x) ==> (\x. sum (n..m) (\i. G i x)) real_differentiable atreal x` [ ((((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; ((move ["m"]) THEN (move ["IHm"]))]) THEN (move ["dG"])) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL SUM_CLAUSES_NUMSEG)))(thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`n = 0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["n_eq_0"])) THEN ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((TRY done_tac)))); (((((use_arg_then "dG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "n_eq_0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`n <= SUC m`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["n_le_Sm"]))); ((((use_arg_then "IHm") (disch_tac [])) THEN (clear_assumption "IHm") THEN (DISCH_THEN apply_tac) THEN (move ["i"]) THEN (move ["i_in"])) THEN (((use_arg_then "dG") (disch_tac [])) THEN (clear_assumption "dG") THEN (DISCH_THEN apply_tac))); ((((use_arg_then "i_in") (disch_tac [])) THEN (clear_assumption "i_in") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "REAL_DIFFERENTIABLE_ADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((use_arg_then "dG")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IHm")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "n_le_Sm")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); ((BETA_TAC THEN (move ["i"]) THEN (move ["ineq"])) THEN (((use_arg_then "dG") (disch_tac [])) THEN (clear_assumption "dG") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma derivative_sum_numseg *) let derivative_sum_numseg = section_proof ["G";"n";"m";"x"] `(!i. i IN n..m ==> G i real_differentiable atreal x) ==> derivative (\x. sum (n..m) (\i. G i x)) x = sum (n..m) (\i. derivative (G i) x)` [ ((((THENL) (((use_arg_then "m") (disch_tac [])) THEN (clear_assumption "m") THEN elim) [ALL_TAC; ((move ["m"]) THEN (move ["IHm"]))]) THEN (move ["dG"])) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL SUM_CLAUSES_NUMSEG)))(thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> arg_tac (Arg_term (`n = 0`))) (disch_tac [])) THEN case THEN (simp_tac)) THEN ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((TRY done_tac)) THEN (((use_arg_then "derivative_const")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))) THEN (done_tac)); ((THENL_ROT (-1)) (((fun arg_tac -> (use_arg_then "EXCLUDED_MIDDLE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`n <= SUC m`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN case THEN (simp_tac) THEN (move ["n_le_Sm"]))); ((((use_arg_then "IHm") (disch_tac [])) THEN (clear_assumption "IHm") THEN (DISCH_THEN apply_tac) THEN (move ["i"]) THEN (move ["i_in"])) THEN (((use_arg_then "dG") (disch_tac [])) THEN (clear_assumption "dG") THEN (DISCH_THEN apply_tac))); ((((use_arg_then "i_in") (disch_tac [])) THEN (clear_assumption "i_in") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); (((use_arg_then "IHm")(gsym_then (thm_tac (new_rewrite [] []))))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_in"])) THEN (((use_arg_then "dG") (disch_tac [])) THEN (clear_assumption "dG") THEN (DISCH_THEN apply_tac))); ((((use_arg_then "i_in") (disch_tac [])) THEN (clear_assumption "i_in") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (arith_tac)); ((((use_arg_then "derivative_add")(thm_tac (new_rewrite [] [])))) THEN ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((TRY done_tac)))); (((((use_arg_then "dG")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "leqnn")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "differentiable_sum_numseg")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_in"])); ((((use_arg_then "dG") (disch_tac [])) THEN (clear_assumption "dG") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "i_in") (disch_tac [])) THEN (clear_assumption "i_in") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Finalization of the section MoreDerivativeArith *) let differentiable_sum_numseg = finalize_theorem differentiable_sum_numseg;; let derivative_sum_numseg = finalize_theorem derivative_sum_numseg;; end_section "MoreDerivativeArith";; (* Lemma HAS_REAL_DERIVATIVE_LOCAL *) let HAS_REAL_DERIVATIVE_LOCAL = section_proof ["f";"g";"x";"g'"] `(g has_real_derivative g') (atreal x) /\ (?s. real_open s /\ x IN s /\ (!y. y IN s ==> f y = g y)) ==> (f has_real_derivative g') (atreal x)` [ (BETA_TAC THEN (case THEN (move ["dg"])) THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["f_eq_g"])); ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((fun arg_tac -> (use_arg_then "HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN") (fun fst_arg -> (use_arg_then "open_s") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac))) THEN (move ["dg"]))); (((fun arg_tac -> (use_arg_then "HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN") (fun fst_arg -> (use_arg_then "dg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`&1`))) (term_tac exists_tac)) THEN (((((use_arg_then "REAL_LT_01")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (case THEN ALL_TAC) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "f_eq_g") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma differentiable_local *) let differentiable_local = section_proof ["f";"g";"x";"s"] `g real_differentiable atreal x /\ real_open s /\ x IN s /\ (!y. y IN s ==> f y = g y) ==> f real_differentiable atreal x` [ ((repeat_tactic 1 9 (((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["f'"])) THEN (move ["dg"]) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["eq"])); (((use_arg_then "f'") (term_tac exists_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac))); (((use_arg_then "g") (term_tac exists_tac)) THEN ((((use_arg_then "dg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "s") (term_tac exists_tac)) THEN (done_tac)); ];; (* Section NthDerivativeArith *) begin_section "NthDerivativeArith";; (add_section_var (mk_var ("f", (`:real->real`))); add_section_var (mk_var ("g", (`:real->real`))));; (add_section_var (mk_var ("int", (`:real#real`))));; (add_section_var (mk_var ("n", (`:num`))));; (add_section_hyp "df" (`nth_diff_strong_int n int f`));; (* Lemma nth_derivative_scale_strong *) let nth_derivative_scale_strong = section_proof ["c";"i";"x"] `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y` [ ((((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] []))))) THEN (move ["df"]))); (((DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"]))) THEN (((((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] []))))) THEN (move ["diff"]))); ((THENL_FIRST) ((THENL) (((use_arg_then "i") (disch_tac [])) THEN (clear_assumption "i") THEN elim) [(move ["_"]); ((move ["i"]) THEN (move ["IHi"]))]) ((repeat_tactic 1 9 (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "s") (term_tac exists_tac)) THEN (done_tac))); (((((use_arg_then "nth_derivativeS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["i_lt_n"])); ((((fun arg_tac -> (use_arg_then "IHi") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ltnW") (fun fst_arg -> (use_arg_then "i_lt_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["eq"])) THEN (((use_arg_then "IHi") (disch_tac [])) THEN (clear_assumption "IHi") THEN BETA_TAC THEN (move ["_"]))); (((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac)) THEN (((((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["yt"]))))); (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`\y. c * nth_derivative i f y`))) (term_tac exists_tac)); ((((use_arg_then "HAS_REAL_DERIVATIVE_LMUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((fun arg_tac -> (use_arg_then "diff") (fun fst_arg -> (use_arg_then "ys") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac)) THEN (((((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "yt")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (move ["z_in"]) THEN (simp_tac))); ((((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma nth_derivative_scale_strong_all *) let nth_derivative_scale_strong_all = section_proof ["c";"x"] `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (fun arg_tac -> (use_arg_then "nth_derivative_scale_strong") (fun fst_arg -> (use_arg_then "c") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y)`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then "SELECT_AX") (thm_tac apply_tac))); (((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (move ["cond"])); (((use_arg_then "s") (term_tac exists_tac)) THEN ((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`INTERS (IMAGE (\i. (@) (P i)) (0..n))`))) (term_tac (set_tac "S"))); ((use_arg_then "S") (term_tac exists_tac)); ((((use_arg_then "S_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_OPEN_INTERS")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "IN_INTERS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))))) THEN (split_tac)); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (BETA_TAC THEN (move ["i"]) THEN (move ["y"]) THEN (case THEN (move ["i_le_n"]))); ((((fun arg_tac -> (use_arg_then "sel_P") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (case THEN (move ["_"])) THEN (move ["y_in"]) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`(@) (P i)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)))); ((THENL_FIRST) (ANTS_TAC) (((use_arg_then "i") (term_tac exists_tac)) THEN (((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (((use_arg_then "y_in") (disch_tac [])) THEN (clear_assumption "y_in") THEN (exact_tac)); ];; (* Lemma nth_derivative_scale *) let nth_derivative_scale = section_proof ["c";"i";"x"] `interval_arith x int ==> i <= n ==> nth_derivative i (\x. c * f x) x = c * nth_derivative i f x` [ (BETA_TAC THEN (move ["ineq"]) THEN (move ["i_le_n"])); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_scale_strong") (fun fst_arg -> (use_arg_then "c") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["xs"])) THEN (move ["h"])); (((use_arg_then "h") (disch_tac [])) THEN (clear_assumption "h") THEN (exact_tac)); ];; (* Lemma nth_diff_scale *) let nth_diff_scale = section_proof ["c"] `nth_diff_strong_int n int (\x. c * f x)` [ ((((use_arg_then "df") (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] []))))))); (BETA_TAC THEN (move ["df"]) THEN (move ["x"]) THEN (move ["ineq"])); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_scale_strong_all") (fun fst_arg -> (use_arg_then "c") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["diff"])); (((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["diff2"])); (((fun arg_tac -> arg_tac (Arg_term (`s INTER t`))) (term_tac exists_tac)) THEN (((((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["yt"]))))); (((((use_arg_then "REAL_CONTINUOUS_LMUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_lt_n"])); ((((use_arg_then "diff")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "ys")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac))); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\y. c * nth_derivative i f y)`))) (term_tac exists_tac)); ((THENL_FIRST) ((((use_arg_then "HAS_REAL_DERIVATIVE_LMUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((fun arg_tac -> (use_arg_then "diff2") (fun fst_arg -> (use_arg_then "yt") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (move ["zs"]) THEN (simp_tac))); ((((use_arg_then "diff") (disch_tac [])) THEN (clear_assumption "diff") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (add_section_hyp "dg" (`nth_diff_strong_int n int g`));; (* Lemma nth_derivative_add_strong *) let nth_derivative_add_strong = section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y` [ ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))))) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["ineq"]))); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["sf"])) THEN (case THEN (move ["open_sf"])) THEN (case THEN (move ["xsf"]))) THEN (((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC THEN (move ["_"]))); ((((fun arg_tac -> (use_arg_then "dg") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["sg"])) THEN (case THEN (move ["open_sg"])) THEN (case THEN (move ["xsg"]))) THEN (((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN BETA_TAC THEN (move ["_"]))); (((repeat_tactic 1 9 (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))))) THEN (move ["diff_g"]) THEN (move ["diff_f"])); ((THENL_FIRST) ((THENL) (((use_arg_then "i") (disch_tac [])) THEN (clear_assumption "i") THEN elim) [(move ["_"]); ((move ["i"]) THEN (move ["IHi"]))]) ((repeat_tactic 1 9 (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "sf") (term_tac exists_tac)) THEN (done_tac))); (((((use_arg_then "nth_derivativeS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["i_lt_n"])); ((((fun arg_tac -> (use_arg_then "IHi") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ltnW") (fun fst_arg -> (use_arg_then "i_lt_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["eq"])) THEN (((use_arg_then "IHi") (disch_tac [])) THEN (clear_assumption "IHi") THEN BETA_TAC THEN (move ["_"]))); ((fun arg_tac -> arg_tac (Arg_term (`sf INTER sg INTER t`))) (term_tac exists_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xsf")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xsg")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (case THEN (move ["ysf"])) THEN (case THEN ((move ["ysg"]) THEN (move ["yt"])))); (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\y. nth_derivative i f y + nth_derivative i g y)`))) (term_tac exists_tac)); ((((use_arg_then "HAS_REAL_DERIVATIVE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((fun arg_tac -> (use_arg_then "diff_f") (fun fst_arg -> (use_arg_then "ysf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_g") (fun fst_arg -> (use_arg_then "ysg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`sf INTER sg INTER t`))) (term_tac exists_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "yt")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ysf")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ysg")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))))); ((BETA_TAC THEN (move ["z"]) THEN (move ["z_in"]) THEN (simp_tac)) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma nth_derivative_add_strong_all *) let nth_derivative_add_strong_all = section_proof ["x"] `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "nth_derivative_add_strong") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y)`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then "SELECT_AX") (thm_tac apply_tac))); (((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (move ["cond"])); (((use_arg_then "s") (term_tac exists_tac)) THEN ((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`INTERS (IMAGE (\i. (@) (P i)) (0..n))`))) (term_tac (set_tac "S"))); ((use_arg_then "S") (term_tac exists_tac)); ((((use_arg_then "S_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_OPEN_INTERS")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "IN_INTERS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))))) THEN (split_tac)); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (BETA_TAC THEN (move ["i"]) THEN (move ["y"]) THEN (case THEN (move ["i_le_n"]))); ((((fun arg_tac -> (use_arg_then "sel_P") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (case THEN (move ["_"])) THEN (move ["y_in"]) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`(@) (P i)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)))); ((THENL_FIRST) (ANTS_TAC) (((use_arg_then "i") (term_tac exists_tac)) THEN (((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (((use_arg_then "y_in") (disch_tac [])) THEN (clear_assumption "y_in") THEN (exact_tac)); ];; (* Lemma nth_derivative_add *) let nth_derivative_add = section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> nth_derivative i (\x. f x + g x) x = nth_derivative i f x + nth_derivative i g x` [ (BETA_TAC THEN (move ["ineq"]) THEN (move ["i_le_n"])); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_add_strong") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["xs"])) THEN (move ["h"])); (((use_arg_then "h") (disch_tac [])) THEN (clear_assumption "h") THEN (exact_tac)); ];; (* Lemma nth_diff_add *) let nth_diff_add = section_proof [] `nth_diff_strong_int n int (\x. f x + g x)` [ (((use_arg_then "dg") (disch_tac [])) THEN ((use_arg_then "df") (disch_tac [])) THEN BETA_TAC); ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))))); (BETA_TAC THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["x"]) THEN (move ["ineq"])); ((fun arg_tac -> (use_arg_then "nth_derivative_add_strong_all") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["diff"])); (((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["tf"])) THEN (case THEN (move ["open_tf"])) THEN (case THEN (move ["xtf"])) THEN (move ["diff_f"])); (((fun arg_tac -> (use_arg_then "dg") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["tg"])) THEN (case THEN (move ["open_tg"])) THEN (case THEN (move ["xtg"])) THEN (move ["diff_g"])); (((fun arg_tac -> arg_tac (Arg_term (`s INTER tf INTER tg`))) (term_tac exists_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xtf")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xtg")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))))); (BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (case THEN ((move ["ytf"]) THEN (move ["ytg"])))))); (((((use_arg_then "REAL_CONTINUOUS_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_g")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_lt_n"])); ((((use_arg_then "diff")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "ys")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac))); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\y. nth_derivative i f y + nth_derivative i g y)`))) (term_tac exists_tac)); ((THENL_FIRST) ((((use_arg_then "HAS_REAL_DERIVATIVE_ADD")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((fun arg_tac -> (use_arg_then "diff_f") (fun fst_arg -> (use_arg_then "ytf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_g") (fun fst_arg -> (use_arg_then "ytg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (move ["zs"]) THEN (simp_tac))); ((((use_arg_then "diff") (disch_tac [])) THEN (clear_assumption "diff") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma nth_derivative_sub_strong *) let nth_derivative_sub_strong = section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y` [ ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))))) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["ineq"]))); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["sf"])) THEN (case THEN (move ["open_sf"])) THEN (case THEN (move ["xsf"]))) THEN (((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC THEN (move ["_"]))); ((((fun arg_tac -> (use_arg_then "dg") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["sg"])) THEN (case THEN (move ["open_sg"])) THEN (case THEN (move ["xsg"]))) THEN (((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN BETA_TAC THEN (move ["_"]))); (((repeat_tactic 1 9 (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))))) THEN (move ["diff_g"]) THEN (move ["diff_f"])); ((THENL_FIRST) ((THENL) (((use_arg_then "i") (disch_tac [])) THEN (clear_assumption "i") THEN elim) [(move ["_"]); ((move ["i"]) THEN (move ["IHi"]))]) ((repeat_tactic 1 9 (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "sf") (term_tac exists_tac)) THEN (done_tac))); (((((use_arg_then "nth_derivativeS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["i_lt_n"])); ((((fun arg_tac -> (use_arg_then "IHi") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ltnW") (fun fst_arg -> (use_arg_then "i_lt_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["eq"])) THEN (((use_arg_then "IHi") (disch_tac [])) THEN (clear_assumption "IHi") THEN BETA_TAC THEN (move ["_"]))); ((fun arg_tac -> arg_tac (Arg_term (`sf INTER sg INTER t`))) (term_tac exists_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xsf")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xsg")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (case THEN (move ["ysf"])) THEN (case THEN ((move ["ysg"]) THEN (move ["yt"])))); (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\y. nth_derivative i f y - nth_derivative i g y)`))) (term_tac exists_tac)); ((((use_arg_then "HAS_REAL_DERIVATIVE_SUB")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((fun arg_tac -> (use_arg_then "diff_f") (fun fst_arg -> (use_arg_then "ysf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_g") (fun fst_arg -> (use_arg_then "ysg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`sf INTER sg INTER t`))) (term_tac exists_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "yt")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ysf")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ysg")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))))); ((BETA_TAC THEN (move ["z"]) THEN (move ["z_in"]) THEN (simp_tac)) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma nth_derivative_sub_strong_all *) let nth_derivative_sub_strong_all = section_proof ["x"] `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "nth_derivative_sub_strong") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y)`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then "SELECT_AX") (thm_tac apply_tac))); (((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (move ["cond"])); (((use_arg_then "s") (term_tac exists_tac)) THEN ((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`INTERS (IMAGE (\i. (@) (P i)) (0..n))`))) (term_tac (set_tac "S"))); ((use_arg_then "S") (term_tac exists_tac)); ((((use_arg_then "S_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_OPEN_INTERS")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "IN_INTERS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))))) THEN (split_tac)); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (BETA_TAC THEN (move ["i"]) THEN (move ["y"]) THEN (case THEN (move ["i_le_n"]))); ((((fun arg_tac -> (use_arg_then "sel_P") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (case THEN (move ["_"])) THEN (move ["y_in"]) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`(@) (P i)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)))); ((THENL_FIRST) (ANTS_TAC) (((use_arg_then "i") (term_tac exists_tac)) THEN (((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (((use_arg_then "y_in") (disch_tac [])) THEN (clear_assumption "y_in") THEN (exact_tac)); ];; (* Lemma nth_derivative_sub *) let nth_derivative_sub = section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> nth_derivative i (\x. f x - g x) x = nth_derivative i f x - nth_derivative i g x` [ (BETA_TAC THEN (move ["ineq"]) THEN (move ["i_le_n"])); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_sub_strong") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["xs"])) THEN (move ["h"])); (((use_arg_then "h") (disch_tac [])) THEN (clear_assumption "h") THEN (exact_tac)); ];; (* Lemma nth_diff_sub *) let nth_diff_sub = section_proof [] `nth_diff_strong_int n int (\x. f x - g x)` [ (((use_arg_then "dg") (disch_tac [])) THEN ((use_arg_then "df") (disch_tac [])) THEN BETA_TAC); ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))))); (BETA_TAC THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["x"]) THEN (move ["ineq"])); ((fun arg_tac -> (use_arg_then "nth_derivative_sub_strong_all") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["diff"])); (((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["tf"])) THEN (case THEN (move ["open_tf"])) THEN (case THEN (move ["xtf"])) THEN (move ["diff_f"])); (((fun arg_tac -> (use_arg_then "dg") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["tg"])) THEN (case THEN (move ["open_tg"])) THEN (case THEN (move ["xtg"])) THEN (move ["diff_g"])); (((fun arg_tac -> arg_tac (Arg_term (`s INTER tf INTER tg`))) (term_tac exists_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xtf")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xtg")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))))); (BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (case THEN ((move ["ytf"]) THEN (move ["ytg"])))))); (((((use_arg_then "REAL_CONTINUOUS_SUB")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_g")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_lt_n"])); ((((use_arg_then "diff")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "ys")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((TRY done_tac))); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`(\y. nth_derivative i f y - nth_derivative i g y)`))) (term_tac exists_tac)); ((THENL_FIRST) ((((use_arg_then "HAS_REAL_DERIVATIVE_SUB")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((fun arg_tac -> (use_arg_then "diff_f") (fun fst_arg -> (use_arg_then "ytf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_g") (fun fst_arg -> (use_arg_then "ytg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (move ["zs"]) THEN (simp_tac))); ((((use_arg_then "diff") (disch_tac [])) THEN (clear_assumption "diff") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma nth_derivative_mul_strong *) let nth_derivative_mul_strong = section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)` [ ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))))) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["ineq"]))); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["sf"])) THEN (case THEN (move ["open_sf"])) THEN (case THEN (move ["xsf"]))) THEN (((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC THEN (move ["_"]))); ((((fun arg_tac -> (use_arg_then "dg") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["sg"])) THEN (case THEN (move ["open_sg"])) THEN (case THEN (move ["xsg"]))) THEN (((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN BETA_TAC THEN (move ["_"]))); (((repeat_tactic 1 9 (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))))) THEN (move ["diff_g"]) THEN (move ["diff_f"])); ((THENL) (((use_arg_then "i") (disch_tac [])) THEN (clear_assumption "i") THEN elim) [(move ["_"]); ((move ["i"]) THEN (move ["IHi"]))]); (((use_arg_then "sf") (term_tac exists_tac)) THEN (((((use_arg_then "open_sf")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xsf")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_SING_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (move ["y"]) THEN (move ["_"]) THEN (simp_tac))); (((((use_arg_then "subn0")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "binom")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "nth_derivativeS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ltE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["i_lt_n"])); ((((fun arg_tac -> (use_arg_then "IHi") (fun fst_arg -> (fun arg_tac -> (use_arg_then "ltnW") (fun fst_arg -> (use_arg_then "i_lt_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["eq"])) THEN (((use_arg_then "IHi") (disch_tac [])) THEN (clear_assumption "IHi") THEN BETA_TAC THEN (move ["_"]))); ((fun arg_tac -> arg_tac (Arg_term (`sf INTER sg INTER t`))) (term_tac exists_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xsf")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xsg")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (case THEN (move ["ysf"])) THEN (case THEN ((move ["ysg"]) THEN (move ["yt"])))); (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)); (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`\y. sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)`))) (term_tac exists_tac)); ((THENL_ROT (-1)) (split_tac)); (((fun arg_tac -> arg_tac (Arg_term (`sf INTER sg INTER t`))) (term_tac exists_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "yt")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ysf")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ysg")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))))); ((BETA_TAC THEN (move ["z"]) THEN (move ["z_in"]) THEN (simp_tac)) THEN (((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); (((use_arg_then "has_derivative_lemma") (disch_tac [])) THEN (clear_assumption "has_derivative_lemma") THEN (DISCH_THEN apply_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!k. k IN 0..i ==> nth_derivative k f real_differentiable atreal y /\ nth_derivative (i - k) g real_differentiable atreal y`))) (term_tac (have_gen_tac [](move ["diff_cond"])))); (((((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (move ["k"]) THEN (move ["ineq"]) THEN (simp_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); (((fun arg_tac -> arg_tac (Arg_term (`nth_derivative (SUC k) f y`))) (term_tac exists_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_f") (fun fst_arg -> (use_arg_then "ysf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "i_lt_n") (disch_tac [])) THEN (clear_assumption "i_lt_n") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`nth_derivative (SUC (i - k)) g y`))) (term_tac exists_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_g") (fun fst_arg -> (use_arg_then "ysg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "i_lt_n") (disch_tac [])) THEN (clear_assumption "i_lt_n") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!k. k IN 0..i ==> (\y. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y) real_differentiable atreal y`))) (term_tac (have_gen_tac [](move ["diff_cond2"])))); (BETA_TAC THEN (move ["k"]) THEN (move ["k_in"]) THEN (simp_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 1 9 (((use_arg_then "diff_cond")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN (done_tac)); (((((use_arg_then "differentiable_sum_numseg")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "derivative_sum_numseg")(thm_tac (new_rewrite [] [])))))) THEN ((simp_tac) THEN (((use_arg_then "diff_cond2")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((TRY done_tac)))); ((fun arg_tac -> arg_tac (Arg_term (`sum (0..i) _`))) (term_tac (set_tac "lhs"))); ((fun arg_tac -> arg_tac (Arg_term (`sum (0 + 1..i + 1) (\k. &(binom (i, k - 1)) * nth_derivative k f y * nth_derivative (SUC i - k) g y)`))) (term_tac (set_tac "sum1"))); ((fun arg_tac -> arg_tac (Arg_term (`sum (0..i + 1) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (SUC i - k) g y)`))) (term_tac (set_tac "sum2"))); ((fun arg_tac -> arg_tac (Arg_term (`lhs = sum1 + sum2`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); ((((use_arg_then "sum1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_OFFSET")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "addn1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "succnK")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subSS")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "sum2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "addn1")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL SUM_CLAUSES_NUMSEG)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 <= SUC i`)))(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`binom(i, SUC i) = 0`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))) ((((use_arg_then "BINOM_EQ_0")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "REAL_MUL_LZERO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ADD_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_ADD_NUMSEG")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "lhs_def")(gsym_then (thm_tac (new_rewrite [] [])))))); (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["k"]) THEN (move ["k_in"]) THEN (simp_tac)); (((((use_arg_then "derivative_scale")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((use_arg_then "diff_cond")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((((use_arg_then "REAL_ADD_LDISTRIB")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_EQ_MUL_LCANCEL")(thm_tac (new_rewrite [] []))))) THEN (DISJ2_TAC)); ((((use_arg_then "derivative_mul")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((repeat_tactic 0 10 (((use_arg_then "diff_cond")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); ((((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_derivativeS")(gsym_then (thm_tac (new_rewrite [] []))))))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`SUC (i - k) = SUC i - k`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) ((done_tac) THEN (done_tac))); ((((use_arg_then "k_in") (disch_tac [])) THEN (clear_assumption "k_in") THEN BETA_TAC) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (arith_tac) THEN (done_tac)); (((((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_CLAUSES_LEFT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "sum2_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 0 1 (((use_arg_then "SUM_CLAUSES_LEFT")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (TRY ((arith_tac)))); ((repeat_tactic 1 9 (((use_arg_then "binom")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_ADD_ASSOC")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_EQ_ADD_LCANCEL")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "sum1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SUM_ADD_NUMSEG")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> (use_arg_then "addn1") (fun fst_arg -> (use_arg_then "i") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))); (((use_arg_then "SUM_EQ") (thm_tac apply_tac)) THEN (move ["k"]) THEN (move ["k_in"]) THEN (simp_tac)); (((((use_arg_then "REAL_ADD_RDISTRIB")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_EQ_MUL_RCANCEL")(thm_tac (new_rewrite [] []))))) THEN (DISJ1_TAC)); ((THENL_FIRST) (((THENL) (((use_arg_then "k_in") (disch_tac [])) THEN (clear_assumption "k_in") THEN ((use_arg_then "k") (disch_tac [])) THEN (clear_assumption "k") THEN case) [ALL_TAC; (move ["k"])]) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) ((arith_tac) THEN (done_tac))); (((((use_arg_then "binom")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subSS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subn0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_OF_NUM_ADD")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma nth_derivative_mul_strong_all *) let nth_derivative_mul_strong_all = section_proof ["x"] `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)` [ (BETA_TAC THEN (DISCH_THEN (fun snd_th -> (use_arg_then "nth_derivative_mul_strong") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])); ((fun arg_tac -> arg_tac (Arg_term (`\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y))`))) (term_tac (set_tac "P"))); ((fun arg_tac -> arg_tac (Arg_term (`!i. i <= n:num ==> P i ((@) (P i))`))) (term_tac (have_gen_tac [](move ["sel_P"])))); ((BETA_TAC THEN (move ["i"]) THEN (move ["i_le_n"])) THEN ((use_arg_then "SELECT_AX") (thm_tac apply_tac))); (((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (move ["cond"])); (((use_arg_then "s") (term_tac exists_tac)) THEN ((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`INTERS (IMAGE (\i. (@) (P i)) (0..n))`))) (term_tac (set_tac "S"))); ((use_arg_then "S") (term_tac exists_tac)); ((((use_arg_then "S_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_OPEN_INTERS")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "FINITE_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "IN_INTERS")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_IMAGE")(thm_tac (new_rewrite [] [])))))) THEN (split_tac)); ((BETA_TAC THEN (move ["t"]) THEN (case THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))) THEN ((((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "sel_P") (thm_tac (match_mp_then snd_th MP_TAC)))))); (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN (done_tac)); (BETA_TAC THEN (move ["i"]) THEN (move ["y"]) THEN (case THEN (move ["i_le_n"]))); ((((fun arg_tac -> (use_arg_then "sel_P") (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((((use_arg_then "P_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (simp_tac)) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (case THEN (move ["_"])) THEN (move ["y_in"]) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`(@) (P i)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)))); ((THENL_FIRST) (ANTS_TAC) (((use_arg_then "i") (term_tac exists_tac)) THEN (((use_arg_then "IN_NUMSEG_0")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); (((use_arg_then "y_in") (disch_tac [])) THEN (clear_assumption "y_in") THEN (exact_tac)); ];; (* Lemma nth_derivative_mul *) let nth_derivative_mul = section_proof ["i";"x"] `interval_arith x int ==> i <= n ==> nth_derivative i (\x. f x * g x) x = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f x * nth_derivative (i - k) g x)` [ (BETA_TAC THEN (move ["ineq"]) THEN (move ["i_le_n"])); ((fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_mul_strong") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "i_le_n") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["xs"])) THEN (move ["h"])); (((use_arg_then "h") (disch_tac [])) THEN (clear_assumption "h") THEN (exact_tac)); ];; (* Lemma nth_diff_mul *) let nth_diff_mul = section_proof [] `nth_diff_strong_int n int (\x. f x * g x)` [ (((use_arg_then "dg") (disch_tac [])) THEN ((use_arg_then "df") (disch_tac [])) THEN BETA_TAC); ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))))); (BETA_TAC THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["x"]) THEN (move ["ineq"])); ((fun arg_tac -> (use_arg_then "nth_derivative_mul_strong_all") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["diff"])); (((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["tf"])) THEN (case THEN (move ["open_tf"])) THEN (case THEN (move ["xtf"])) THEN (move ["diff_f"])); (((fun arg_tac -> (use_arg_then "dg") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["tg"])) THEN (case THEN (move ["open_tg"])) THEN (case THEN (move ["xtg"])) THEN (move ["diff_g"])); (((fun arg_tac -> arg_tac (Arg_term (`s INTER tf INTER tg`))) (term_tac exists_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xtf")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "xtg")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))))); (BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (case THEN ((move ["ytf"]) THEN (move ["ytg"])))))); (((((use_arg_then "REAL_CONTINUOUS_MUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_f")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff_g")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"]) THEN (move ["i_lt_n"])); ((((use_arg_then "nth_derivativeS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_alt")(thm_tac (new_rewrite [] []))))); (((use_arg_then "differentiable_local") (disch_tac [])) THEN (clear_assumption "differentiable_local") THEN (DISCH_THEN apply_tac)); (((fun arg_tac -> arg_tac (Arg_term (`\y. sum (0..i) (\k. &(binom(i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)`))) (term_tac exists_tac)) THEN ((use_arg_then "s") (term_tac exists_tac))); ((THENL_LAST) (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (split_tac)) ((BETA_TAC THEN (move ["z"]) THEN (move ["zs"])) THEN ((((use_arg_then "diff")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "ltnW")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "differentiable_sum_numseg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_NUMSEG")(thm_tac (new_rewrite [] []))))) THEN (move ["k"]) THEN (move ["k_in"]) THEN (simp_tac)); (((repeat_tactic 1 9 (((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg])))); ((repeat_tactic 1 9 (((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); (((fun arg_tac -> arg_tac (Arg_term (`nth_derivative (SUC k) f y`))) (term_tac exists_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_f") (fun fst_arg -> (use_arg_then "ytf") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "i_lt_n") (disch_tac [])) THEN (clear_assumption "i_lt_n") THEN ((use_arg_then "k_in") (disch_tac [])) THEN (clear_assumption "k_in") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`nth_derivative (SUC (i - k)) g y`))) (term_tac exists_tac)) THEN (((fun arg_tac -> (use_arg_then "diff_g") (fun fst_arg -> (use_arg_then "ytg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "i_lt_n") (disch_tac [])) THEN (clear_assumption "i_lt_n") THEN ((use_arg_then "k_in") (disch_tac [])) THEN (clear_assumption "k_in") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Finalization of the section NthDerivativeArith *) let nth_derivative_scale_strong = finalize_theorem nth_derivative_scale_strong;; let nth_derivative_scale_strong_all = finalize_theorem nth_derivative_scale_strong_all;; let nth_derivative_scale = finalize_theorem nth_derivative_scale;; let nth_diff_scale = finalize_theorem nth_diff_scale;; let nth_derivative_add_strong = finalize_theorem nth_derivative_add_strong;; let nth_derivative_add_strong_all = finalize_theorem nth_derivative_add_strong_all;; let nth_derivative_add = finalize_theorem nth_derivative_add;; let nth_diff_add = finalize_theorem nth_diff_add;; let nth_derivative_sub_strong = finalize_theorem nth_derivative_sub_strong;; let nth_derivative_sub_strong_all = finalize_theorem nth_derivative_sub_strong_all;; let nth_derivative_sub = finalize_theorem nth_derivative_sub;; let nth_diff_sub = finalize_theorem nth_diff_sub;; let nth_derivative_mul_strong = finalize_theorem nth_derivative_mul_strong;; let nth_derivative_mul_strong_all = finalize_theorem nth_derivative_mul_strong_all;; let nth_derivative_mul = finalize_theorem nth_derivative_mul;; let nth_diff_mul = finalize_theorem nth_diff_mul;; end_section "NthDerivativeArith";; (* Finalization of the section NthDerivatives *) let has_derivative_cond = finalize_theorem has_derivative_cond;; let has_derivative_alt = finalize_theorem has_derivative_alt;; let derivative_unique = finalize_theorem derivative_unique;; let derivative_unique_on = finalize_theorem derivative_unique_on;; let has_derivative_lemma = finalize_theorem has_derivative_lemma;; let nth_derivative0 = finalize_theorem nth_derivative0;; let nth_derivativeS = finalize_theorem nth_derivativeS;; let nth_Sderivative = finalize_theorem nth_Sderivative;; let nth_derivative1 = finalize_theorem nth_derivative1;; let nth_derivative2 = finalize_theorem nth_derivative2;; let nth_derivative_add = finalize_theorem nth_derivative_add;; let nth_diff_continuous = finalize_theorem nth_diff_continuous;; let nth_differentiable_cond = finalize_theorem nth_differentiable_cond;; let nth_differentiable_on_cond = finalize_theorem nth_differentiable_on_cond;; let nth_differentiable_eq = finalize_theorem nth_differentiable_eq;; let nth_differentiable_on_int2 = finalize_theorem nth_differentiable_on_int2;; let nth_mth_diff = finalize_theorem nth_mth_diff;; let nth_differentiable1 = finalize_theorem nth_differentiable1;; let nth_diff_imp_diff = finalize_theorem nth_diff_imp_diff;; let nth_derivative_continuous = finalize_theorem nth_derivative_continuous;; let ith_derivative_differentiable = finalize_theorem ith_derivative_differentiable;; let nth_diff_strong_imp_diff = finalize_theorem nth_diff_strong_imp_diff;; let derivative_x = finalize_theorem derivative_x;; let derivative_const = finalize_theorem derivative_const;; let derivative_inv = finalize_theorem derivative_inv;; let derivative_atn = finalize_theorem derivative_atn;; let derivative_exp = finalize_theorem derivative_exp;; let derivative_acs = finalize_theorem derivative_acs;; let derivative_sqrt = finalize_theorem derivative_sqrt;; let derivative_composition = finalize_theorem derivative_composition;; let REAL_DIFFERENTIABLE_AT_INV = finalize_theorem REAL_DIFFERENTIABLE_AT_INV;; let derivative_compose_atn = finalize_theorem derivative_compose_atn;; let derivative_compose_exp = finalize_theorem derivative_compose_exp;; let derivative_compose_inv = finalize_theorem derivative_compose_inv;; let derivative_compose_sqrt = finalize_theorem derivative_compose_sqrt;; let derivative_compose_acs = finalize_theorem derivative_compose_acs;; let derivative_scale = finalize_theorem derivative_scale;; let derivative_neg = finalize_theorem derivative_neg;; let derivative_pow = finalize_theorem derivative_pow;; let derivative_add = finalize_theorem derivative_add;; let derivative_mul = finalize_theorem derivative_mul;; let derivative_sub = finalize_theorem derivative_sub;; let derivative_div = finalize_theorem derivative_div;; let differentiable_sum_numseg = finalize_theorem differentiable_sum_numseg;; let derivative_sum_numseg = finalize_theorem derivative_sum_numseg;; let HAS_REAL_DERIVATIVE_LOCAL = finalize_theorem HAS_REAL_DERIVATIVE_LOCAL;; let differentiable_local = finalize_theorem differentiable_local;; let nth_derivative_scale_strong = finalize_theorem nth_derivative_scale_strong;; let nth_derivative_scale_strong_all = finalize_theorem nth_derivative_scale_strong_all;; let nth_derivative_scale = finalize_theorem nth_derivative_scale;; let nth_diff_scale = finalize_theorem nth_diff_scale;; let nth_derivative_add_strong = finalize_theorem nth_derivative_add_strong;; let nth_derivative_add_strong_all = finalize_theorem nth_derivative_add_strong_all;; let nth_derivative_add = finalize_theorem nth_derivative_add;; let nth_diff_add = finalize_theorem nth_diff_add;; let nth_derivative_sub_strong = finalize_theorem nth_derivative_sub_strong;; let nth_derivative_sub_strong_all = finalize_theorem nth_derivative_sub_strong_all;; let nth_derivative_sub = finalize_theorem nth_derivative_sub;; let nth_diff_sub = finalize_theorem nth_diff_sub;; let nth_derivative_mul_strong = finalize_theorem nth_derivative_mul_strong;; let nth_derivative_mul_strong_all = finalize_theorem nth_derivative_mul_strong_all;; let nth_derivative_mul = finalize_theorem nth_derivative_mul;; let nth_diff_mul = finalize_theorem nth_diff_mul;; end_section "NthDerivatives";; let lin_approx = new_definition `lin_approx f x f_bounds df_bounds <=> interval_arith (f x) f_bounds /\ (?f'. (f has_real_derivative f') (atreal x) /\ interval_arith f' df_bounds)`;; let has_bounded_second_derivative = new_definition `has_bounded_second_derivative f int dd_bounds <=> nth_diff_strong_int 2 int f /\ bounded_on_int (nth_derivative 2 f) int dd_bounds`;; let taylor_interval = new_definition `taylor_interval f x y z w f_bounds df_bounds ddf_bounds <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w /\ lin_approx f y f_bounds df_bounds /\ has_bounded_second_derivative f (x, z) ddf_bounds`;; (* Lemma nth_diff_strong_imp_diff_int *) let nth_diff_strong_imp_diff_int = section_proof ["n";"int";"f"] `nth_diff_strong_int n int f ==> nth_differentiable_on_int n int f` [ ((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_on_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] []))))); (BETA_TAC THEN (move ["h"]) THEN (move ["x"]) THEN (move ["ineq"])); ((((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["_"])) THEN (case THEN (move ["xs"]))) THEN (exact_tac) THEN (done_tac)); ];; (* Lemma has_bounded_second_derivative_old *) let has_bounded_second_derivative_old = section_proof ["f";"int";"dd_bounds"] `has_bounded_second_derivative f int dd_bounds ==> ?f' f''. (!x. interval_arith x int ==> (f has_real_derivative f' x) (atreal x) /\ (f' has_real_derivative f'' x) (atreal x) /\ interval_arith (f'' x) dd_bounds)` [ ((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (DISCH_THEN (fun snd_th -> (use_arg_then "nth_diff_strong_imp_diff_int") (thm_tac (match_mp_then snd_th MP_TAC)))))); ((DISCH_THEN (fun snd_th -> (use_arg_then "nth_differentiable_on_int2") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (case THEN (move ["f'"])) THEN (case THEN (move ["f''"]))); ((BETA_TAC THEN (case THEN (move ["eq1"])) THEN (case THEN (move ["eq2"])) THEN (move ["h"]) THEN (move ["b"])) THEN ((((use_arg_then "f'") (term_tac exists_tac)) THEN ((use_arg_then "f''") (term_tac exists_tac))) THEN (move ["x"]) THEN (move ["ineq"]))); ((((use_arg_then "b") (disch_tac [])) THEN (clear_assumption "b") THEN BETA_TAC) THEN (((((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eq2")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["b"]))); (((repeat_tactic 1 9 (((use_arg_then "h")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "b")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma exists_and_left *) let exists_and_left = section_proof ["P";"Q"] `(?x. P x /\ Q x) ==> (?x. P x)` [ (BETA_TAC THEN (case THEN (move ["x"])) THEN (case THEN ((move ["Px"]) THEN (move ["_"])))); (((use_arg_then "x") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma lim_ineq *) let lim_ineq = section_proof ["a";"b"] `(!e. &0 < e ==> a <= b + e) <=> (a <= b)` [ ((THENL_ROT (-1)) ((THENL) (split_tac) [ALL_TAC; ((move ["ineq"]) THEN (move ["e"]) THEN (move ["e0"]))])); (((((fun arg_tac -> (use_arg_then "REAL_ADD_RID") (fun fst_arg -> (use_arg_then "a") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_ADD2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "contraLR") (disch_tac [])) THEN (clear_assumption "contraLR") THEN (DISCH_THEN apply_tac)) THEN (((((use_arg_then "NOT_FORALL_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "NOT_IMP")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_NOT_LE")(thm_tac (new_rewrite [] [])))))) THEN (move ["ba"]))); (((fun arg_tac -> arg_tac (Arg_term (`(a - b) / &2`))) (term_tac exists_tac)) THEN (((use_arg_then "ba") (disch_tac [])) THEN (clear_assumption "ba") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma continuous_leq *) let continuous_leq = section_proof ["f";"c";"a"] `(?b. a < b /\ !x. x IN real_interval (a, b) ==> f x <= c) /\ f real_continuous atreal a ==> f a <= c` [ (BETA_TAC THEN (case THEN ((case THEN (move ["b"])) THEN (case THEN (move ["ab"])) THEN (move ["ineq"])))); (((((use_arg_then "REAL_CONTINUOUS_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REALLIM_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (move ["f_cont"])); ((((use_arg_then "lim_ineq")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["e"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "f_cont") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["cond"])); ((fun arg_tac -> arg_tac (Arg_term (`a + min (b - a) d / &2`))) (term_tac (set_tac "r"))); ((THENL_FIRST) ((((fun arg_tac -> (use_arg_then "cond") (fun fst_arg -> (use_arg_then "r") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (ANTS_TAC)) ((((use_arg_then "ab") (disch_tac [])) THEN (clear_assumption "ab") THEN ((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN ((use_arg_then "r_def") (disch_tac [])) THEN (clear_assumption "r_def") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((THENL_LAST) ((((fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "r") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (ANTS_TAC)) ((arith_tac) THEN (done_tac))); ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ab") (disch_tac [])) THEN (clear_assumption "ab") THEN ((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN ((use_arg_then "r_def") (disch_tac [])) THEN (clear_assumption "r_def") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma continuous_reflection *) let continuous_reflection = section_proof ["f";"x"] `f real_continuous atreal x <=> (\x. f (--x)) real_continuous atreal (--x)` [ (((repeat_tactic 1 9 (((use_arg_then "REAL_CONTINUOUS_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "REALLIM_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_NEG_NEG")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((split_tac) THEN (move ["h"]) THEN (move ["e"]) THEN (move ["e0"]))); (((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (use_arg_then "e0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["cond"])); (((use_arg_then "d") (term_tac exists_tac)) THEN (((((use_arg_then "d0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["y"]) THEN (move ["ineqs"])) THEN (((use_arg_then "cond") (disch_tac [])) THEN (clear_assumption "cond") THEN (DISCH_THEN apply_tac))); ((((use_arg_then "ineqs") (disch_tac [])) THEN (clear_assumption "ineqs") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (use_arg_then "e0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["cond"])); (((use_arg_then "d") (term_tac exists_tac)) THEN (((((use_arg_then "d0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["y"]) THEN (move ["ineqs"]))); ((((fun arg_tac -> (use_arg_then "cond") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`--y`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (((use_arg_then "REAL_NEG_NEG")(thm_tac (new_rewrite [] [])))) THEN (DISCH_THEN apply_tac) THEN (((use_arg_then "ineqs") (disch_tac [])) THEN (clear_assumption "ineqs") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma continuous_leq_segment *) let continuous_leq_segment = section_proof ["f";"c";"a";"b"] `a < b ==> f real_continuous atreal a ==> f real_continuous atreal b ==> (!x. x IN real_interval (a, b) ==> f x <= c) ==> (!x. x IN real_interval [a, b] ==> f x <= c)` [ (BETA_TAC THEN (move ["ab"]) THEN (move ["f_cont_a"]) THEN (move ["f_cont_b"]) THEN (move ["ineq"]) THEN (move ["x"])); ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 2 0 (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b. a <= b <=> (a = b \/ a < b)`)))(thm_tac (new_rewrite [] [])))))); (case THEN ((THENL) case [((((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] []))))) THEN (move ["_"])); (move ["ax"])])); ((((use_arg_then "continuous_leq") (disch_tac [])) THEN (clear_assumption "continuous_leq") THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "f_cont_a")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))) THEN ((use_arg_then "b") (term_tac exists_tac)) THEN (done_tac)); ((THENL_LAST) ((THENL) case [(((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))); (move ["xb"])]) ((((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`\x. f (--x)`))) (term_tac (set_tac "g"))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`!x. f x = g (--x)`))) (term_tac (have_gen_tac [](move ["fg"])))) (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "REAL_NEG_NEG")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); ((((use_arg_then "fg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "continuous_leq") (disch_tac [])) THEN (clear_assumption "continuous_leq") THEN (DISCH_THEN apply_tac)) THEN (split_tac)); (((fun arg_tac -> arg_tac (Arg_term (`--a`))) (term_tac exists_tac)) THEN (((((use_arg_then "REAL_LT_NEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ab")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (move ["y"]))); ((((fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`--y`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "fg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_NEG_NEG")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); (((((use_arg_then "g_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "continuous_reflection")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma pair_eq *) let pair_eq = section_proof ["p"] `p = (FST p, SND p)` [ (done_tac); ];; (* Section Taylor *) begin_section "Taylor";; (* Lemma iabs_alt *) let iabs_alt = section_proof ["lo";"hi";"a"] `interval_arith a (lo, hi) ==> iabs (lo, hi) = max (abs lo) (abs hi)` [ (((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma iabs_pos *) let iabs_pos = section_proof ["lo";"hi";"a"] `interval_arith a (lo, hi) ==> &0 <= iabs (lo, hi)` [ (((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (add_section_var (mk_var ("f", (`:real -> real`))));; (add_section_var (mk_var ("x", (`:real`))); add_section_var (mk_var ("y", (`:real`))); add_section_var (mk_var ("z", (`:real`))); add_section_var (mk_var ("w", (`:real`))));; (add_section_var (mk_var ("f_bounds", (`:real#real`))); add_section_var (mk_var ("df_bounds", (`:real#real`))); add_section_var (mk_var ("ddf_bounds", (`:real#real`))));; (add_section_var (mk_var ("dd_bound", (`:real`))));; (add_section_hyp "dd_bound_eq" (`dd_bound = iabs ddf_bounds`));; (add_section_hyp "tif" (`taylor_interval f x y z w f_bounds df_bounds ddf_bounds`));; (* Lemma f_continuous *) let f_continuous = section_proof [] `!t. t IN real_interval [x, z] ==> f real_continuous atreal t` [ (((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["t"]) THEN (move ["t_in"])); (((use_arg_then "HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL") THEN (DISCH_THEN apply_tac)); ((((use_arg_then "tif") (disch_tac [])) THEN (clear_assumption "tif") THEN BETA_TAC) THEN (((((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbA")(thm_tac (new_rewrite [] [])))))) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "has_bounded_second_derivative_old") (thm_tac (match_mp_then snd_th MP_TAC)))))); (BETA_TAC THEN (case THEN (move ["f'"])) THEN (case THEN (move ["f''"])) THEN (move ["df"])); (((fun arg_tac -> arg_tac (Arg_term (`f' t`))) (term_tac exists_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma taylor_error *) let taylor_error = section_proof ["t"] `x <= t /\ t <= z ==> abs (f t - f y) <= w * iabs df_bounds + w * w * dd_bound / &2` [ (BETA_TAC THEN (move ["t_ineqs"])); (((use_arg_then "tif") (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN (((((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbA")(thm_tac (new_rewrite [] [])))))) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["domain_ineqs"])) THEN (move ["lin_app"]))); ((DISCH_THEN (fun snd_th -> (use_arg_then "has_bounded_second_derivative_old") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (case THEN (move ["f'"])) THEN (case THEN (move ["f''"])) THEN (move ["df"])); ((fun arg_tac -> arg_tac (Arg_term (`abs (t - y) <= w`))) (term_tac (have_gen_tac [](move ["abs_ty"])))); ((((use_arg_then "t_ineqs") (disch_tac [])) THEN (clear_assumption "t_ineqs") THEN ((use_arg_then "domain_ineqs") (disch_tac [])) THEN (clear_assumption "domain_ineqs") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`interval_arith y (x, z)`))) (term_tac (have_gen_tac [](move ["y_in"])))) ((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`&0 <= dd_bound /\ !p. p IN real_interval [x, z] ==> abs (f'' p) <= dd_bound`))) (term_tac (have_gen_tac [](move ["dd_prop"])))); ((((use_arg_then "dd_bound_eq")(thm_tac (new_rewrite [] [])))) THEN (split_tac)); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "y_in") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); (((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (BETA_TAC THEN (move ["p"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN ((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`abs (f t - (f y + f' y * (t - y) pow 1)) <= dd_bound * abs (t - y) pow (1 + 1) / &2`))) (term_tac (have_gen_tac []ALL_TAC)))); (((fun arg_tac -> arg_tac (Arg_term (`f' y * _`))) (term_tac (set_tac "b1"))) THEN (((fun arg_tac -> arg_tac (Arg_term (`dd_bound * _`))) (term_tac (set_tac "b2"))) THEN (move ["ineq1"]))); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`abs (f t - (f y + b1)) + abs b1`))) (term_tac exists_tac)) THEN (split_tac)); (((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b. a - b = (a - (b + b1)) + b1`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ABS_TRIANGLE")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ADD2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "b1_def")(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (((use_arg_then "REAL_POW_1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ABS_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_MUL2")(thm_tac (new_rewrite [] []))))); ((repeat_tactic 1 9 (((use_arg_then "REAL_ABS_POS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "abs_ty")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "lin_app") (disch_tac [])) THEN (clear_assumption "lin_app") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (case THEN (move ["ff"])) THEN (case THEN (move ["df'"])))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`ff = f' y`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) (((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_DERIVATIVE_UNIQUE_ATREAL") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN ((((use_arg_then "df'")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "b2") (term_tac exists_tac))); ((((use_arg_then "ineq1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "b2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_MUL2")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `1 + 1 = 2`)))(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_INV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LE_MUL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dd_prop")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LE_POW_2")(thm_tac (new_rewrite [] [])))))) THEN (TRY ((arith_tac)))); ((((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_MUL2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dd_prop")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_LE_POW_2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_SQUARE_ABS")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_ABS_ABS")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "abs_ty") (disch_tac [])) THEN (clear_assumption "abs_ty") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`\i. if i = 0 then f else if i = 1 then f' else if i = 2 then f'' else I`))) (term_tac (set_tac "Df"))); ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`))) (fun arg -> thm_tac MP_TAC arg THEN (move ["arith"]))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_TAYLOR") (fun fst_arg -> (use_arg_then "Df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`real_interval [x, z]`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dd_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); (((((use_arg_then "IS_REALINTERVAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] [])))))); ((BETA_TAC THEN (move ["i"]) THEN (move ["p"]) THEN (case THEN (move ["p_in"]))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `i <= 1 <=> i = 0 \/ i = 1`)))(thm_tac (new_rewrite [] []))))); ((case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "Df_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN ((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN") (thm_tac apply_tac)) THEN ((repeat_tactic 1 9 (((use_arg_then "arith")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((BETA_TAC THEN (move ["p"]) THEN (move ["p_in"])) THEN ((((use_arg_then "Df_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac))); (((repeat_tactic 1 9 (((use_arg_then "arith")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "dd_prop")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((BETA_TAC THEN ((fun arg_tac -> (fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "t") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC))) THEN ((repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "domain_ineqs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "t_ineqs")(thm_tac (new_rewrite [] []))))) THEN (simp_tac))); ((((use_arg_then "ONE")(thm_tac (new_rewrite [1] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL SUM_CLAUSES_NUMSEG)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SUM_SING_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "Df_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] [])))))); ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 <= 1 /\ ~(1 = 0)`)))(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL real_pow)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "FACT")(thm_tac (new_rewrite [] []))))); (((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `FACT 1 = 1 /\ FACT (1 + 1) = 2`)))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_DIV_1")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma taylor_upper_bound *) let taylor_upper_bound = section_proof [] `!t. x <= t /\ t <= z ==> f t <= SND f_bounds + (w * iabs df_bounds + w * w * dd_bound / &2)` [ (((fun arg_tac -> (use_arg_then "pair_eq") (fun fst_arg -> (use_arg_then "f_bounds") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (move ["eq"])); (BETA_TAC THEN (move ["t"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "taylor_error") (thm_tac (match_mp_then snd_th MP_TAC))))); ((((use_arg_then "tif") (disch_tac [])) THEN (clear_assumption "tif") THEN BETA_TAC) THEN (((((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbA")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "lin_approx")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["_"])) THEN (case THEN (move ["f_int"])) THEN (move ["_"]) THEN (move ["_"]))); ((((use_arg_then "f_int") (disch_tac [])) THEN (clear_assumption "f_int") THEN BETA_TAC) THEN ((((use_arg_then "eq")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma taylor_lower_bound *) let taylor_lower_bound = section_proof [] `!t. x <= t /\ t <= z ==> FST f_bounds - (w * iabs df_bounds + w * w * dd_bound / &2) <= f t` [ ((fun arg_tac -> (use_arg_then "pair_eq") (fun fst_arg -> (use_arg_then "f_bounds") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN (move ["eq"]))); (BETA_TAC THEN (move ["t"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "taylor_error") (thm_tac (match_mp_then snd_th MP_TAC))))); ((((use_arg_then "tif") (disch_tac [])) THEN (clear_assumption "tif") THEN BETA_TAC) THEN (((((use_arg_then "eq")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbA")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "lin_approx")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["_"])) THEN (case THEN (move ["f_int"])) THEN (move ["_"]) THEN (move ["_"]))); ((((use_arg_then "f_int") (disch_tac [])) THEN (clear_assumption "f_int") THEN BETA_TAC) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (arith_tac)); ];; (* Lemma taylor_derivative_error *) let taylor_derivative_error = section_proof [] `!t. x <= t /\ t <= z ==> abs (derivative f t - derivative f y) <= w * dd_bound` [ (BETA_TAC THEN (move ["t"]) THEN (move ["t_ineqs"])); (((use_arg_then "tif") (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN (((((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbA")(thm_tac (new_rewrite [] [])))))) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["domain_ineqs"])) THEN (move ["_"]))); ((DISCH_THEN (fun snd_th -> (use_arg_then "has_bounded_second_derivative_old") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN BETA_TAC THEN (case THEN (move ["f'"])) THEN (case THEN (move ["f''"])) THEN (move ["df"])); ((fun arg_tac -> arg_tac (Arg_term (`abs (t - y) <= w`))) (term_tac (have_gen_tac [](move ["abs_ty"])))); ((((use_arg_then "t_ineqs") (disch_tac [])) THEN (clear_assumption "t_ineqs") THEN ((use_arg_then "domain_ineqs") (disch_tac [])) THEN (clear_assumption "domain_ineqs") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`!p. x <= p /\ p <= z ==> derivative f p = f' p`))) (term_tac (have_gen_tac [](move ["der_eq"])))); (((((use_arg_then "IN_REAL_INTERVAL")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "EQ_SYM_EQ")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "derivative_unique_on") (disch_tac [])) THEN (clear_assumption "derivative_unique_on") THEN (DISCH_THEN apply_tac))); ((((((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["p"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (simp_tac)) THEN (done_tac)); ((repeat_tactic 1 9 (((use_arg_then "der_eq")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`&0 <= dd_bound /\ !p. p IN real_interval [x, z] ==> abs (f'' p) <= dd_bound`))) (term_tac (have_gen_tac [](move ["dd_prop"])))); (((((use_arg_then "dd_bound_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (split_tac)); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN ((((fun arg_tac -> (use_arg_then "pair_eq") (fun fst_arg -> (use_arg_then "ddf_bounds") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "domain_ineqs")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ((BETA_TAC THEN (move ["p"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN ((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`\i. if i = 0 then f' else if i = 1 then f'' else I`))) (term_tac (set_tac "Df"))); ((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`))) (fun arg -> thm_tac MP_TAC arg THEN (move ["arith"]))); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_TAYLOR") (fun fst_arg -> (use_arg_then "Df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`real_interval [x, z]`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dd_bound") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); (ANTS_TAC); (((((use_arg_then "IS_REALINTERVAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((BETA_TAC THEN (move ["i"]) THEN (move ["p"]) THEN (case THEN (move ["p_in"]))) THEN ((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `i <= 0 <=> i = 0`)))(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "Df_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "arith")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ATREAL_WITHIN") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_ATREAL_WITHIN") THEN (DISCH_THEN apply_tac))); (((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_REAL_INTERVAL")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((BETA_TAC THEN (move ["p"]) THEN (move ["p_in"])) THEN ((((use_arg_then "Df_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac))); (((repeat_tactic 1 9 (((use_arg_then "arith")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "dd_prop")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((BETA_TAC THEN ((fun arg_tac -> (fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "t") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC))) THEN ((repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "domain_ineqs")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "t_ineqs")(thm_tac (new_rewrite [] []))))) THEN (simp_tac))); ((((use_arg_then "ONE")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "SUM_SING_NUMSEG")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "Df_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL real_pow)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "arith")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "FACT")(thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `FACT 1 = 1`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_DIV_1")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "REAL_POW_1")(thm_tac (new_rewrite [] [])))) THEN (move ["ineq"])); ((((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`dd_bound * abs (t - y)`))) (term_tac exists_tac))); (((((use_arg_then "ineq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_RMUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dd_prop")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "abs_ty")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma derivative_interval *) let derivative_interval = section_proof [] `FST df_bounds <= derivative f y /\ derivative f y <= SND df_bounds` [ ((fun arg_tac -> (use_arg_then "pair_eq") (fun fst_arg -> (use_arg_then "df_bounds") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN (move ["eq"]))); ((((use_arg_then "tif") (disch_tac [])) THEN (clear_assumption "tif") THEN BETA_TAC) THEN (((((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "lin_approx")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbA")(thm_tac (new_rewrite [] [])))))) THEN ALL_TAC THEN (case THEN ALL_TAC) THEN (case THEN (move ["ineqs"])) THEN (case THEN (move ["g"])) THEN (case THEN ((move ["fg"]) THEN (move ["g_int"]))) THEN (move ["_"]))); ((THENL_FIRST) (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`derivative f y = g`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))) ((((use_arg_then "g_int") (disch_tac [])) THEN (clear_assumption "g_int") THEN BETA_TAC) THEN ((((use_arg_then "eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "REAL_DERIVATIVE_UNIQUE_ATREAL") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((((use_arg_then "fg")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_derivative_cond")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN ((use_arg_then "g") (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma taylor_derivative_upper_bound *) let taylor_derivative_upper_bound = section_proof [] `!t. x <= t /\ t <= z ==> derivative f t <= SND df_bounds + w * dd_bound` [ ((BETA_TAC THEN (move ["t"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "taylor_derivative_error") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (((use_arg_then "derivative_interval") (disch_tac [])) THEN (clear_assumption "derivative_interval") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma taylor_derivative_lower_bound *) let taylor_derivative_lower_bound = section_proof [] `!t. x <= t /\ t <= z ==> FST df_bounds - w * dd_bound <= derivative f t` [ ((BETA_TAC THEN (move ["t"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "taylor_derivative_error") (thm_tac (match_mp_then snd_th MP_TAC))))) THEN (((use_arg_then "derivative_interval") (disch_tac [])) THEN (clear_assumption "derivative_interval") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Finalization of the section Taylor *) let iabs_alt = finalize_theorem iabs_alt;; let iabs_pos = finalize_theorem iabs_pos;; let f_continuous = finalize_theorem f_continuous;; let taylor_error = finalize_theorem taylor_error;; let taylor_upper_bound = finalize_theorem taylor_upper_bound;; let taylor_lower_bound = finalize_theorem taylor_lower_bound;; let taylor_derivative_error = finalize_theorem taylor_derivative_error;; let derivative_interval = finalize_theorem derivative_interval;; let taylor_derivative_upper_bound = finalize_theorem taylor_derivative_upper_bound;; let taylor_derivative_lower_bound = finalize_theorem taylor_derivative_lower_bound;; end_section "Taylor";; (* Section LinearApproximation *) begin_section "LinearApproximation";; (add_section_var (mk_var ("f", (`:real->real`))));; (add_section_var (mk_var ("f_bounds", (`:real#real`))); add_section_var (mk_var ("df_bounds", (`:real#real`))));; (add_section_var (mk_var ("x", (`:real`))));; (* Lemma lin_approx_eq *) let lin_approx_eq = section_proof [] `lin_approx f x f_bounds df_bounds <=> (f real_differentiable atreal x /\ interval_arith (f x) f_bounds /\ interval_arith (derivative f x) df_bounds)` [ (((((use_arg_then "lin_approx")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] []))))) THEN ((THENL) (split_tac) [(case THEN ((((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (case THEN (move ["f'"])) THEN (case THEN ((move ["df'"]) THEN (move ["int_f'"]))))); ((case THEN ((case THEN (move ["f'"])) THEN (move ["df"]))) THEN (case THEN ((((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (move ["df_int"]))))])); ((THENL_FIRST) (split_tac) (((use_arg_then "f'") (term_tac exists_tac)) THEN (done_tac))); ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "derivative_unique") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN ((use_arg_then "f'") (term_tac exists_tac)) THEN ((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "derivative_unique") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f'") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (add_section_hyp "approx_f" (`lin_approx f x f_bounds df_bounds`));; (* Lemma lin_approx_imp_f_interval *) let lin_approx_imp_f_interval = section_proof [] `interval_arith (f x) f_bounds` [ ((((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma lin_approx_imp_df_interval *) let lin_approx_imp_df_interval = section_proof [] `interval_arith (derivative f x) df_bounds` [ ((((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma lin_approx_imp_f_diff *) let lin_approx_imp_f_diff = section_proof [] `f real_differentiable atreal x` [ ((((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ];; (* Finalization of the section LinearApproximation *) let lin_approx_eq = finalize_theorem lin_approx_eq;; let lin_approx_imp_f_interval = finalize_theorem lin_approx_imp_f_interval;; let lin_approx_imp_df_interval = finalize_theorem lin_approx_imp_df_interval;; let lin_approx_imp_f_diff = finalize_theorem lin_approx_imp_f_diff;; end_section "LinearApproximation";; (* Section MoreLinearApproximation *) begin_section "MoreLinearApproximation";; (add_section_var (mk_var ("f", (`:real->real`))); add_section_var (mk_var ("g", (`:real->real`))));; (add_section_var (mk_var ("x", (`:real`))));; (add_section_var (mk_var ("f_bounds", (`:real#real`))); add_section_var (mk_var ("df_bounds", (`:real#real`))));; (add_section_var (mk_var ("g_bounds", (`:real#real`))); add_section_var (mk_var ("dg_bounds", (`:real#real`))));; (* Lemma interval_arith_not_zero *) let interval_arith_not_zero = section_proof ["x";"int"] `interval_arith x int ==> interval_not_zero int ==> ~(x = &0)` [ (((((fun arg_tac -> (use_arg_then "PAIR") (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_not_zero")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma interval_arith_pos *) let interval_arith_pos = section_proof ["x";"int"] `interval_arith x int ==> interval_pos int ==> &0 < x` [ ((((use_arg_then "int") (disch_tac [])) THEN (clear_assumption "int") THEN case) THEN ((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_pos")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma interval_arith_abs *) let interval_arith_abs = section_proof ["x";"int";"y"] `interval_arith x int ==> iabs int < y ==> abs x < y` [ (((((fun arg_tac -> (use_arg_then "PAIR") (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "iabs")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma lin_approx_x *) let lin_approx_x = section_proof [] `lin_approx (\x. x) x (x, x) (&1, &1)` [ (((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_x")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma lin_approx_const *) let lin_approx_const = section_proof ["c"] `lin_approx (\x. c) x (c, c) (&0, &0)` [ ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] []))))); ((repeat_tactic 1 9 (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Section LinearApproxUnivariateComposition *) begin_section "LinearApproxUnivariateComposition";; (add_section_hyp "approx_f" (`lin_approx f x f_bounds df_bounds`));; (* Lemma lin_approx_compose_atn *) let lin_approx_compose_atn = section_proof [] `(\x. atn (f x)) real_differentiable atreal x /\ derivative (\x. atn (f x)) x = derivative f x / (&1 + f x * f x)` [ ((((use_arg_then "derivative_compose_atn") (disch_tac [])) THEN (clear_assumption "derivative_compose_atn") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma lin_approx_compose_exp *) let lin_approx_compose_exp = section_proof [] `(\x. exp (f x)) real_differentiable atreal x /\ derivative (\x. exp (f x)) x = exp (f x) * derivative f x` [ ((((use_arg_then "derivative_compose_exp") (disch_tac [])) THEN (clear_assumption "derivative_compose_exp") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma lin_approx_compose_inv *) let lin_approx_compose_inv = section_proof [] `interval_not_zero f_bounds ==> (\x. inv (f x)) real_differentiable atreal x /\ derivative (\x. inv (f x)) x = -- inv (f x * f x) * derivative f x` [ ((((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN ((move ["df"]) THEN (move ["h"]))) THEN (move ["f0"]))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`~(f x = &0)`))) (term_tac (have_gen_tac [](move ["fn0"])))) ((((use_arg_then "interval_arith_not_zero") (disch_tac [])) THEN (clear_assumption "interval_arith_not_zero") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "f_bounds") (term_tac exists_tac)) THEN (done_tac))); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "derivative_compose_inv") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "fn0") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (exact_tac)); ];; (* Lemma lin_approx_compose_sqrt *) let lin_approx_compose_sqrt = section_proof [] `interval_pos f_bounds ==> (\x. sqrt (f x)) real_differentiable atreal x /\ derivative (\x. sqrt (f x)) x = derivative f x / (&2 * sqrt (f x))` [ ((((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN ((move ["df"]) THEN (move ["h"]))) THEN (move ["f_ineq"]))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`&0 < f x`))) (term_tac (have_gen_tac [](move ["f_pos"])))) ((((use_arg_then "interval_arith_pos") (disch_tac [])) THEN (clear_assumption "interval_arith_pos") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "f_bounds") (term_tac exists_tac)) THEN (done_tac))); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "derivative_compose_sqrt") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f_pos") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (exact_tac)); ];; (* Lemma lin_approx_compose_acs *) let lin_approx_compose_acs = section_proof [] `iabs f_bounds < &1 ==> (\x. acs (f x)) real_differentiable atreal x /\ derivative (\x. acs (f x)) x = -- (derivative f x / sqrt (&1 - f x * f x))` [ ((((use_arg_then "approx_f") (disch_tac [])) THEN (clear_assumption "approx_f") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN ((move ["df"]) THEN (move ["h"]))) THEN (move ["f_ineq"]))); ((THENL_FIRST) ((fun arg_tac -> arg_tac (Arg_term (`abs (f x) < &1`))) (term_tac (have_gen_tac [](move ["f_abs"])))) ((((use_arg_then "interval_arith_abs") (disch_tac [])) THEN (clear_assumption "interval_arith_abs") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "f_bounds") (term_tac exists_tac)) THEN (done_tac))); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "derivative_compose_acs") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f_abs") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN (exact_tac)); ];; (* Finalization of the section LinearApproxUnivariateComposition *) let lin_approx_compose_atn = finalize_theorem lin_approx_compose_atn;; let lin_approx_compose_exp = finalize_theorem lin_approx_compose_exp;; let lin_approx_compose_inv = finalize_theorem lin_approx_compose_inv;; let lin_approx_compose_sqrt = finalize_theorem lin_approx_compose_sqrt;; let lin_approx_compose_acs = finalize_theorem lin_approx_compose_acs;; end_section "LinearApproxUnivariateComposition";; (add_section_hyp "approx_f" (`lin_approx f x f_bounds df_bounds`));; (add_section_hyp "approx_g" (`lin_approx g x g_bounds dg_bounds`));; (* Lemma lin_approx_imp_add_diff *) let lin_approx_imp_add_diff = section_proof [] `(\x. f x + g x) real_differentiable atreal x` [ (((use_arg_then "REAL_DIFFERENTIABLE_ADD") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_ADD") THEN (DISCH_THEN apply_tac)); (((((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma lin_approx_imp_sub_diff *) let lin_approx_imp_sub_diff = section_proof [] `(\x. f x - g x) real_differentiable atreal x` [ (((use_arg_then "REAL_DIFFERENTIABLE_SUB") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_SUB") THEN (DISCH_THEN apply_tac)); (((((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma lin_approx_imp_mul_diff *) let lin_approx_imp_mul_diff = section_proof [] `(\x. f x * g x) real_differentiable atreal x` [ (((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_MUL_ATREAL") THEN (DISCH_THEN apply_tac)); (((((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma lin_approx_imp_div_diff *) let lin_approx_imp_div_diff = section_proof [] `interval_not_zero g_bounds ==> (\x. f x / g x) real_differentiable atreal x` [ ((BETA_TAC THEN (move ["gn0"])) THEN (((use_arg_then "REAL_DIFFERENTIABLE_DIV_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_DIV_ATREAL") THEN (DISCH_THEN apply_tac))); ((((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (use_arg_then "lin_approx_imp_f_diff") (fun fst_arg -> (use_arg_then "approx_g") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "interval_arith_not_zero") (disch_tac [])) THEN (clear_assumption "interval_arith_not_zero") THEN (DISCH_THEN apply_tac)) THEN ((use_arg_then "g_bounds") (term_tac exists_tac))); ((((use_arg_then "approx_g") (disch_tac [])) THEN (clear_assumption "approx_g") THEN BETA_TAC) THEN ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section MoreLinearApproximation *) let interval_arith_not_zero = finalize_theorem interval_arith_not_zero;; let interval_arith_pos = finalize_theorem interval_arith_pos;; let interval_arith_abs = finalize_theorem interval_arith_abs;; let lin_approx_x = finalize_theorem lin_approx_x;; let lin_approx_const = finalize_theorem lin_approx_const;; let lin_approx_compose_atn = finalize_theorem lin_approx_compose_atn;; let lin_approx_compose_exp = finalize_theorem lin_approx_compose_exp;; let lin_approx_compose_inv = finalize_theorem lin_approx_compose_inv;; let lin_approx_compose_sqrt = finalize_theorem lin_approx_compose_sqrt;; let lin_approx_compose_acs = finalize_theorem lin_approx_compose_acs;; let lin_approx_imp_add_diff = finalize_theorem lin_approx_imp_add_diff;; let lin_approx_imp_sub_diff = finalize_theorem lin_approx_imp_sub_diff;; let lin_approx_imp_mul_diff = finalize_theorem lin_approx_imp_mul_diff;; let lin_approx_imp_div_diff = finalize_theorem lin_approx_imp_div_diff;; end_section "MoreLinearApproximation";; (* Section LinearApproxArith *) begin_section "LinearApproxArith";; (add_section_var (mk_var ("f1", (`:real->real`))); add_section_var (mk_var ("f2", (`:real->real`))));; (add_section_var (mk_var ("f1_bounds", (`:real#real`))); add_section_var (mk_var ("f2_bounds", (`:real#real`))));; (add_section_var (mk_var ("df1_lo", (`:real`))); add_section_var (mk_var ("df1_hi", (`:real`))); add_section_var (mk_var ("df2_lo", (`:real`))); add_section_var (mk_var ("df2_hi", (`:real`))));; (add_section_var (mk_var ("f_bounds", (`:real#real`))));; (add_section_var (mk_var ("df_lo", (`:real`))); add_section_var (mk_var ("df_hi", (`:real`))));; (add_section_var (mk_var ("x", (`:real`))));; (add_section_hyp "approx1" (`lin_approx f1 x f1_bounds (df1_lo, df1_hi)`));; (* Lemma lin_approx_scale *) let lin_approx_scale = section_proof ["c"] `&0 <= c ==> interval_arith (c * f1 x) f_bounds /\ df_lo <= c * df1_lo /\ c * df1_hi <= df_hi ==> lin_approx (\x. c * f1 x) x f_bounds (df_lo, df_hi)` [ (((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (move ["c0"]) THEN (move ["ineqs"])); (((((use_arg_then "lin_approx")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (split_tac)); ((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineqs") (disch_tac [])) THEN (clear_assumption "ineqs") THEN ((use_arg_then "approx1") (disch_tac [])) THEN (clear_assumption "approx1") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "lin_approx")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "approx1") (disch_tac [])) THEN (clear_assumption "approx1") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "lin_approx")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["int_f1"])) THEN (case THEN (move ["f1'"])) THEN (case THEN ((move ["df1"]) THEN (move ["int_f1'"]))))); (((fun arg_tac -> arg_tac (Arg_term (`c * f1'`))) (term_tac exists_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_LMUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "int_f1'") (disch_tac [])) THEN (clear_assumption "int_f1'") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (move ["ineqs2"])) THEN (split_tac) THEN (((use_arg_then "REAL_LE_TRANS") (disch_tac [])) THEN (clear_assumption "REAL_LE_TRANS") THEN (DISCH_THEN apply_tac))); (((fun arg_tac -> arg_tac (Arg_term (`c * df1_lo`))) (term_tac exists_tac)) THEN ((((use_arg_then "ineqs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_LMUL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`c * df1_hi`))) (term_tac exists_tac)) THEN ((((use_arg_then "ineqs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_LMUL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_hyp "approx2" (`lin_approx f2 x f2_bounds (df2_lo, df2_hi)`));; (* Lemma lin_approx_add *) let lin_approx_add = section_proof [] `interval_arith (f1 x + f2 x) f_bounds /\ df_lo <= df1_lo + df2_lo /\ df1_hi + df2_hi <= df_hi ==> lin_approx (\x. f1 x + f2 x) x f_bounds (df_lo, df_hi)` [ (((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (move ["ineqs"])); (((((use_arg_then "lin_approx")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (split_tac)); ((((use_arg_then "pair_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineqs") (disch_tac [])) THEN (clear_assumption "ineqs") THEN ((use_arg_then "approx2") (disch_tac [])) THEN (clear_assumption "approx2") THEN ((use_arg_then "approx1") (disch_tac [])) THEN (clear_assumption "approx1") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "lin_approx")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "approx2") (disch_tac [])) THEN (clear_assumption "approx2") THEN ((use_arg_then "approx1") (disch_tac [])) THEN (clear_assumption "approx1") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "lin_approx")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["int_f1"])) THEN (case THEN (move ["f1'"])) THEN (case THEN ((move ["df1"]) THEN (move ["int_f1'"]))))); (BETA_TAC THEN (case THEN (move ["int_f2"])) THEN (case THEN (move ["f2'"])) THEN (case THEN ((move ["df2"]) THEN (move ["int_f2'"])))); (((fun arg_tac -> arg_tac (Arg_term (`f1' + f2':real`))) (term_tac exists_tac)) THEN ((((use_arg_then "HAS_REAL_DERIVATIVE_ADD")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "int_f2'") (disch_tac [])) THEN (clear_assumption "int_f2'") THEN ((use_arg_then "int_f1'") (disch_tac [])) THEN (clear_assumption "int_f1'") THEN ((use_arg_then "ineqs") (disch_tac [])) THEN (clear_assumption "ineqs") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Finalization of the section LinearApproxArith *) let lin_approx_scale = finalize_theorem lin_approx_scale;; let lin_approx_add = finalize_theorem lin_approx_add;; end_section "LinearApproxArith";; (* Section SecondDerivativeBound *) begin_section "SecondDerivativeBound";; (add_section_var (mk_var ("f1", (`:real->real`))); add_section_var (mk_var ("f2", (`:real->real`))));; (add_section_var (mk_var ("int", (`:real#real`))));; (add_section_var (mk_var ("dd1", (`:real#real`))); add_section_var (mk_var ("dd2", (`:real#real`))));; (* Lemma nth_diff_strong2_eq_alt *) let nth_diff_strong2_eq_alt = section_proof ["f";"x"] `nth_diff_strong 2 f x <=> ?s. real_open s /\ x IN s /\ !y. y IN s ==> (f has_real_derivative derivative f y) (atreal y) /\ (derivative f has_real_derivative nth_derivative 2 f y) (atreal y)` [ ((((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `i < 2 <=> i = 0 \/ i = 1`)))(thm_tac (new_rewrite [] []))))); ((split_tac) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (case THEN (move ["_"])) THEN (move ["h"]))); ((((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`1`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (use_arg_then "h") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`0`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (simp_tac)) THEN (((((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "TWO")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"]))); ((((use_arg_then "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "real_differentiable")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> arg_tac (Arg_term (`derivative f y`))) (term_tac exists_tac)) THEN (done_tac)); ((BETA_TAC THEN (move ["i"])) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((repeat_tactic 0 10 (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 0 10 (((use_arg_then "TWO")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((fun arg_tac ->(use_arg_then "nth_derivative0")(fun tmp_arg1 -> (use_arg_then "nth_derivative1")(fun tmp_arg2 -> arg_tac (Arg_theorem (CONJ (get_arg_thm tmp_arg1) (get_arg_thm tmp_arg2))))))(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ];; (* Lemma nth_diff_strong2_eq *) let nth_diff_strong2_eq = section_proof ["f";"x"] `nth_diff_strong 2 f x <=> ?s. real_open s /\ x IN s /\ !y. y IN s ==> f real_differentiable atreal y /\ derivative f real_differentiable atreal y` [ ((((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "TWO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL nth_differentiable)))(thm_tac (new_rewrite [] [])))))); ((((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_derivative1")(thm_tac (new_rewrite [] []))))); ((split_tac) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["df"])); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"])) THEN (done_tac)); (((use_arg_then "s") (term_tac exists_tac)) THEN (((((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["y"]) THEN (DISCH_THEN (fun snd_th -> (use_arg_then "df") (thm_tac (match_mp_then snd_th MP_TAC)))) THEN (move ["h"]))); (((repeat_tactic 1 9 (((use_arg_then "h")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma lin_approx_compose *) let lin_approx_compose = section_proof ["f";"g";"y";"g_bounds";"f_bounds";"d_bounds"] `nth_diff_strong_int 2 g_bounds f ==> g real_differentiable atreal y ==> interval_arith (g y) g_bounds ==> bounded_on_int f g_bounds f_bounds ==> interval_arith (derivative g y * derivative f (g y)) d_bounds ==> lin_approx (\x. f (g x)) y f_bounds d_bounds` [ (((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["g_int"]) THEN (move ["f_int"]) THEN (move ["dfg_int"])); ((fun arg_tac -> arg_tac (Arg_term (`f real_differentiable atreal (g y)`))) (term_tac (have_gen_tac [](move ["dfgy"])))); ((((fun arg_tac -> (use_arg_then "df") (fun fst_arg -> (use_arg_then "g_int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["ys"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "lin_approx_eq")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "dfg_int")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "f_int")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") (disch_tac [])) THEN (clear_assumption "REAL_DIFFERENTIABLE_COMPOSE_ATREAL") THEN (exact_tac)) THEN (done_tac)); ];; (* Lemma second_derivative_atn_eq *) let second_derivative_atn_eq = section_proof ["x"] `((\x. inv (&1 + x pow 2)) has_real_derivative (-- &2 * x) * inv (&1 + x pow 2) pow 2) (atreal x)` [ (((((use_arg_then "REAL_POW_INV")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_div")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_NEG_LMUL")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_INV_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((fun arg_tac -> (use_arg_then "REAL_ADD_LID") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`&2 * x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ADD")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "REAL_POW_2")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `&2 * x = x * &1 + &1 * x`)))(thm_tac (new_rewrite [] []))))); (((((use_arg_then "HAS_REAL_DERIVATIVE_MUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "REAL_POS_NZ")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_ADD1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_POW_2")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_atn *) let second_derivative_atn = section_proof [] `derivative (derivative atn) = (\x. (-- &2 * x) * inv (&1 + x pow 2) pow 2)` [ ((((((use_arg_then "derivative_atn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (move ["x"]) THEN (simp_tac)) THEN (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac))); (((((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "second_derivative_atn_eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_atn *) let diff2_atn = section_proof ["x"] `nth_diff_strong 2 atn x` [ ((((use_arg_then "nth_diff_strong2_eq_alt")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> arg_tac (Arg_term (`(:real)`))) (term_tac exists_tac))); (((((use_arg_then "IN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_OPEN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_UNIV")(thm_tac (new_rewrite [] []))))) THEN (move ["y"]) THEN (simp_tac)); ((((use_arg_then "derivative_atn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ATN")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "second_derivative_atn")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "second_derivative_atn_eq")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_inv *) let second_derivative_inv = section_proof ["x"] `~(x = &0) ==> nth_derivative 2 inv x = &2 * inv (x pow 3)` [ ((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (move ["xn0"])); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac))); (((fun arg_tac -> arg_tac (Arg_term (`(\x. -- inv (x * x))`))) (term_tac exists_tac)) THEN (split_tac)); (((fun arg_tac -> arg_tac (Arg_theorem ((DISCH_ALL o REAL_DIFF_CONV) `((\x. -- inv(x * x)) has_real_derivative f) (atreal x)`))) (disch_tac [])) THEN BETA_TAC); ((((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xn0")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_NEG_NEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_2")(gsym_then (thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `(x * x) pow 2 = x * x pow 3`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] [])))))); (((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. (&2 * x) * inv x * a = &2 * (x * inv x) * a`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (x - abs x, x + abs x)`))) (term_tac exists_tac)); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))))) THEN ((THENL) (split_tac) [ALL_TAC; ((move ["y"]) THEN (move ["ineq"]))])); ((((use_arg_then "xn0") (disch_tac [])) THEN (clear_assumption "xn0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "derivative_inv")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((((use_arg_then "xn0") (disch_tac [])) THEN (clear_assumption "xn0") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma diff2_inv *) let diff2_inv = section_proof ["x"] `~(x = &0) ==> nth_diff_strong 2 inv x` [ ((((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] [])))) THEN (move ["xn0"])); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (x - abs x, x + abs x)`))) (term_tac exists_tac)); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))))) THEN ((THENL) (split_tac) [ALL_TAC; ((move ["y"]) THEN (move ["ineq"]))])); ((((use_arg_then "xn0") (disch_tac [])) THEN (clear_assumption "xn0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL_FIRST) ((((use_arg_then "REAL_DIFFERENTIABLE_AT_INV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "xn0") (disch_tac [])) THEN (clear_assumption "xn0") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "differentiable_local") (disch_tac [])) THEN (clear_assumption "differentiable_local") THEN (DISCH_THEN apply_tac)) THEN (((fun arg_tac -> arg_tac (Arg_term (`\x. --inv (x * x)`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`real_interval (y - abs y, y + abs y)`))) (term_tac exists_tac)))); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((use_arg_then "REAL_DIFFERENTIABLE_NEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_INV_ATREAL")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "xn0") (disch_tac [])) THEN (clear_assumption "xn0") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL) (split_tac) [ALL_TAC; ((move ["z"]) THEN (move ["ineq2"]))]); ((((use_arg_then "xn0") (disch_tac [])) THEN (clear_assumption "xn0") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); (((((use_arg_then "derivative_inv")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (((use_arg_then "xn0") (disch_tac [])) THEN (clear_assumption "xn0") THEN ((use_arg_then "ineq2") (disch_tac [])) THEN (clear_assumption "ineq2") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma SQRT_POW *) let SQRT_POW = section_proof ["x";"n"] `&0 <= x ==> sqrt x pow n = sqrt (x pow n)` [ ((BETA_TAC THEN (move ["ineq"])) THEN ((THENL) (((use_arg_then "n") (disch_tac [])) THEN (clear_assumption "n") THEN elim) [ALL_TAC; ((move ["n"]) THEN (move ["IHn"]))]) THEN ((repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL real_pow)))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "SQRT_1")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((((use_arg_then "IHn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SQRT_MUL_COMPAT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_POW_LE")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_sqrt *) let second_derivative_sqrt = section_proof ["x"] `&0 < x ==> nth_derivative 2 sqrt x = -- inv(&4 * sqrt (x pow 3))` [ ((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (move ["x_pos"])); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac))); (((fun arg_tac -> arg_tac (Arg_term (`(\x. inv (&2 * sqrt x))`))) (term_tac exists_tac)) THEN (split_tac)); (((fun arg_tac -> arg_tac (Arg_theorem ((DISCH_ALL o REAL_DIFF_CONV) `((\x. inv(&2 * sqrt x)) has_real_derivative f) (atreal x)`))) (disch_tac [])) THEN BETA_TAC); ((fun arg_tac -> arg_tac (Arg_term (`~(&2 * sqrt x = &0)`))) (term_tac (have_gen_tac [](move ["ineq"])))); (((((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "negb_or")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SQRT_EQ_0_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN (((use_arg_then "x_pos") (disch_tac [])) THEN (clear_assumption "x_pos") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "x_pos")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ineq")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_INV_POW")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LNEG")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL real_pow)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_INV_POW")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_POW_MUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SQRT_POW")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL real_pow)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] []))))); ((THENL_FIRST) ((((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))))) ((arith_tac) THEN (done_tac))); (((((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `&2 pow 2 = &4`)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `SUC 2 = 3`)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (&0, x + &1)`))) (term_tac exists_tac)); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))))) THEN ((THENL) (split_tac) [ALL_TAC; ((move ["y"]) THEN (move ["ineq"]))])); ((((use_arg_then "x_pos") (disch_tac [])) THEN (clear_assumption "x_pos") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "derivative_sqrt")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma diff2_sqrt *) let diff2_sqrt = section_proof ["x"] `&0 < x ==> nth_diff_strong 2 sqrt x` [ ((((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] [])))) THEN (move ["x_pos"])); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (&0, x + &1)`))) (term_tac exists_tac)); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))))) THEN ((THENL) (split_tac) [ALL_TAC; ((move ["y"]) THEN (move ["ineq"]))])); ((((use_arg_then "x_pos") (disch_tac [])) THEN (clear_assumption "x_pos") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL_FIRST) ((((use_arg_then "REAL_DIFFERENTIABLE_AT_SQRT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "x_pos") (disch_tac [])) THEN (clear_assumption "x_pos") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "differentiable_local") (disch_tac [])) THEN (clear_assumption "differentiable_local") THEN (DISCH_THEN apply_tac)) THEN (((fun arg_tac -> arg_tac (Arg_term (`\x. inv (&2 * sqrt x)`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`real_interval (&0, y + &1)`))) (term_tac exists_tac)))); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((use_arg_then "REAL_DIFFERENTIABLE_INV_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_AT_SQRT")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SQRT_EQ_0_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN (((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL_FIRST) ((THENL) (split_tac) [ALL_TAC; ((move ["z"]) THEN (move ["ineq2"]))]) ((((use_arg_then "x_pos") (disch_tac [])) THEN (clear_assumption "x_pos") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "derivative_sqrt")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma real_powS *) let real_powS = section_proof ["x";"n"] `x pow (SUC n) = x * x pow n` [ ((((use_arg_then "real_pow")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma second_derivative_acs *) let second_derivative_acs = section_proof ["x"] `abs x < &1 ==> nth_derivative 2 acs x = --(x / sqrt ((&1 - x * x) pow 3))` [ ((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (move ["x_ineq"])); ((((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac))); (((fun arg_tac -> arg_tac (Arg_term (`\x. --inv (sqrt (&1 - x * x))`))) (term_tac exists_tac)) THEN (split_tac)); (((fun arg_tac -> arg_tac (Arg_theorem ((DISCH_ALL o REAL_DIFF_CONV) `((\x. --inv (sqrt (&1 - x * x))) has_real_derivative f) (atreal x)`))) (disch_tac [])) THEN BETA_TAC); ((fun arg_tac -> arg_tac (Arg_term (`&0 < &1 - x * x /\ ~(sqrt(&1 - x * x) = &0)`))) (term_tac (have_gen_tac [](move ["ineqs"])))); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`&0 < &1 - x * x`))) (term_tac (have_gen_tac [](move ["h"]))))); (((((use_arg_then "SQRT_EQ_0_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))) THEN (((use_arg_then "h") (disch_tac [])) THEN (clear_assumption "h") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `&1 - x * x = (&1 - x) * (&1 + x)`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_MUL")(thm_tac (new_rewrite [] []))))); ((((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((repeat_tactic 1 9 (((use_arg_then "ineqs")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_SUB_LZERO")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_NEG_NEG")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] []))))))); ((((use_arg_then "REAL_INV_MUL")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "real_powS")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "SQRT_POW")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_2")(gsym_then (thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. (&2 * x) * inv (&2) * a = (&2 * inv (&2)) * x * a`)))(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `SUC 2 = 3`)))(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))))) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`&1 - abs x`))) (term_tac (set_tac "e"))); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (x - e, x + e)`))) (term_tac exists_tac)); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))))) THEN ((THENL) (split_tac) [ALL_TAC; ((move ["y"]) THEN (move ["ineq"]))])); ((((use_arg_then "e_def") (disch_tac [])) THEN (clear_assumption "e_def") THEN ((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "derivative_acs")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((((use_arg_then "e_def") (disch_tac [])) THEN (clear_assumption "e_def") THEN ((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma diff2_acs *) let diff2_acs = section_proof ["x"] `abs x < &1 ==> nth_diff_strong 2 acs x` [ ((((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] [])))) THEN (move ["x_ineq"])); ((fun arg_tac -> arg_tac (Arg_term (`&1 - abs x`))) (term_tac (set_tac "e"))); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (x - e, x + e)`))) (term_tac exists_tac)); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))))) THEN ((THENL) (split_tac) [ALL_TAC; ((move ["y"]) THEN (move ["ineq"]))])); ((((use_arg_then "e_def") (disch_tac [])) THEN (clear_assumption "e_def") THEN ((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((THENL_FIRST) ((((use_arg_then "REAL_DIFFERENTIABLE_AT_ACS")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) ((((use_arg_then "e_def") (disch_tac [])) THEN (clear_assumption "e_def") THEN ((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`&1 - abs y`))) (term_tac (set_tac "e2"))); ((((use_arg_then "differentiable_local") (disch_tac [])) THEN (clear_assumption "differentiable_local") THEN (DISCH_THEN apply_tac)) THEN (((fun arg_tac -> arg_tac (Arg_term (`\x. --inv (sqrt (&1 - x * x))`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`real_interval (y - e2, y + e2)`))) (term_tac exists_tac)))); (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((((use_arg_then "REAL_DIFFERENTIABLE_NEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_INV_ATREAL")(thm_tac (new_rewrite [] []))))); ((fun arg_tac -> arg_tac (Arg_term (`&0 < &1 - y * y`))) (term_tac (have_gen_tac [](move ["gt0"])))); (((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `&1 - y * y = (&1 - y) * (&1 + y)`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LT_MUL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "e_def") (disch_tac [])) THEN (clear_assumption "e_def") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "SQRT_EQ_0_COMPAT")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_LT_IMP_NZ")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`(\x. sqrt (&1 - x * x)) = sqrt o (\x. &1 - x * x)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "eq_ext")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "o_THM")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN (done_tac)); ((((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_AT_SQRT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "REAL_DIFFERENTIABLE_SUB")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_DIFFERENTIABLE_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "REAL_DIFFERENTIABLE_ID")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((THENL) (split_tac) [ALL_TAC; ((move ["z"]) THEN (move ["ineq2"]))]); ((((use_arg_then "e2_def") (disch_tac [])) THEN (clear_assumption "e2_def") THEN ((use_arg_then "e_def") (disch_tac [])) THEN (clear_assumption "e_def") THEN ((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "derivative_acs")(thm_tac (new_rewrite [] [])))) THEN ((simp_tac THEN TRY done_tac))); ((((use_arg_then "ineq2") (disch_tac [])) THEN (clear_assumption "ineq2") THEN ((use_arg_then "e2_def") (disch_tac [])) THEN (clear_assumption "e2_def") THEN ((use_arg_then "e_def") (disch_tac [])) THEN (clear_assumption "e_def") THEN ((use_arg_then "ineq") (disch_tac [])) THEN (clear_assumption "ineq") THEN ((use_arg_then "x_ineq") (disch_tac [])) THEN (clear_assumption "x_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Section SecondDerivativeCompose *) begin_section "SecondDerivativeCompose";; (* Lemma REAL_CONTINUOUS_OPEN_PREIMAGE *) let REAL_CONTINUOUS_OPEN_PREIMAGE = section_proof ["f";"s";"t"] `f real_continuous_on s ==> real_open s ==> real_open t ==> real_open {x | x IN s /\ f x IN t}` [ (BETA_TAC THEN (move ["f_cont"]) THEN (move ["open_s"]) THEN (move ["open_t"])); (((use_arg_then "REAL_OPEN")(thm_tac (new_rewrite [] [])))); (((THENL_ROT 1)) ((fun arg_tac -> arg_tac (Arg_term (`IMAGE lift {x | x IN s /\ f x IN t} = {x | x IN (IMAGE lift s) /\ (lift o f o drop) x IN (IMAGE lift t)}`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))))); (((((use_arg_then "CONTINUOUS_OPEN_PREIMAGE")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_OPEN")(gsym_then (thm_tac (new_rewrite [] []))))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_CONTINUOUS_ON")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((((use_arg_then "EXTENSION")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "IN_IMAGE_LIFT_DROP")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_IMAGE_LIFT_DROP")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (simp_tac)) THEN (split_tac)); ((BETA_TAC THEN (case THEN (move ["x"])) THEN (case THEN (move ["x_in"])) THEN (move ["x_eq"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`lift x`))) (term_tac exists_tac))); (((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "x_in")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "x_eq")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((repeat_tactic 1 9 (((use_arg_then "o_THM")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "LIFT_DROP")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["x"])) THEN (case THEN (move ["x_in"])) THEN (move ["x_eq"])); (((fun arg_tac -> arg_tac (Arg_term (`drop x`))) (term_tac exists_tac)) THEN (done_tac)); ];; (* Lemma second_derivative_compose *) let second_derivative_compose = section_proof ["f";"g";"x"] `nth_diff_strong 2 g x ==> nth_diff_strong 2 f (g x) ==> nth_derivative 2 (\x. f (g x)) x = nth_derivative 2 f (g x) * (derivative g x) pow 2 + derivative f (g x) * nth_derivative 2 g x` [ (BETA_TAC THEN (move ["dg"]) THEN (move ["df"])); ((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_unique") (disch_tac [])) THEN (clear_assumption "derivative_unique") THEN (DISCH_THEN apply_tac)) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_LOCAL") (disch_tac [])) THEN (clear_assumption "HAS_REAL_DERIVATIVE_LOCAL") THEN (DISCH_THEN apply_tac))); ((THENL_ROT (-1)) (((fun arg_tac -> arg_tac (Arg_term (`\x. derivative f (g x) * derivative g x`))) (term_tac exists_tac)) THEN (split_tac))); ((((use_arg_then "dg") (disch_tac [])) THEN ((use_arg_then "df") (disch_tac [])) THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["gxs"])) THEN (move ["d_f"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["xt"])) THEN (move ["d_g"]))); ((fun arg_tac -> arg_tac (Arg_term (`{z | z IN t /\ g z IN s}`))) (term_tac (set_tac "s'"))); ((fun arg_tac -> arg_tac (Arg_term (`real_open s'`))) (term_tac (have_gen_tac [](move ["open_s'"])))); ((((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_CONTINUOUS_OPEN_PREIMAGE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_t")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (move ["y"]) THEN (move ["yt"])); (((((use_arg_then "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "d_g")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`t INTER s'`))) (term_tac exists_tac)) THEN ((((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); (((((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)) THEN ((use_arg_then "x") (term_tac exists_tac)) THEN (done_tac)); ((BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["yt"]) THEN (move ["ys'"])))) THEN ((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); (((((use_arg_then "d_g")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "d_f")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (((use_arg_then "ys'") (disch_tac [])) THEN (clear_assumption "ys'") THEN BETA_TAC) THEN (((((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["z"])) THEN (simp_tac)) THEN (done_tac)); ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong2_eq_alt")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (move ["d_f"]) THEN (case THEN (move ["_"])) THEN (move ["d_g"]))); ((THENL_ROT (-1)) (((((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_POW_2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_MUL_ATREAL")(thm_tac (new_rewrite [] []))))) THEN (split_tac))); ((((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "d_g")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative f`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN (((use_arg_then "REAL_DIFF_CHAIN_ATREAL")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "d_g")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "d_f")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_compose *) let diff2_compose = section_proof ["f";"g";"x"] `nth_diff_strong 2 g x ==> nth_diff_strong 2 f (g x) ==> nth_diff_strong 2 (\x. f (g x)) x` [ ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] []))))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (move ["dg"]) THEN (case THEN (move ["t"])) THEN (case THEN (move ["open_t"])) THEN (case THEN (move ["gxt"])) THEN (move ["df"])); ((fun arg_tac -> arg_tac (Arg_term (`{z | z IN s /\ g z IN t}`))) (term_tac (set_tac "s'"))); ((fun arg_tac -> arg_tac (Arg_term (`real_open s'`))) (term_tac (have_gen_tac [](move ["open_s'"])))); ((((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_CONTINUOUS_OPEN_PREIMAGE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_t")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "open_s")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbT")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (move ["y"]) THEN (move ["yt"])); (((((use_arg_then "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((fun arg_tac -> arg_tac (Arg_term (`s INTER s'`))) (term_tac exists_tac)) THEN ((((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); (((((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "xs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "x") (term_tac exists_tac)) THEN (simp_tac)) THEN (done_tac)); (BETA_TAC THEN (move ["y"]) THEN (case THEN ((move ["ys"]) THEN (move ["ys'"])))); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [1] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)))); ((((use_arg_then "ys'") (disch_tac [])) THEN (clear_assumption "ys'") THEN BETA_TAC) THEN (((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["z"])) THEN (simp_tac)) THEN (done_tac)); (((use_arg_then "differentiable_local") (disch_tac [])) THEN (clear_assumption "differentiable_local") THEN (DISCH_THEN apply_tac)); ((THENL_ROT (-1)) ((((fun arg_tac -> arg_tac (Arg_term (`\x. derivative g x * derivative f (g x)`))) (term_tac exists_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`s INTER s'`))) (term_tac exists_tac))) THEN (split_tac))); (((((use_arg_then "REAL_OPEN_INTER")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (repeat_tactic 1 9 (((use_arg_then "IN_INTER")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ys")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ys'")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["z"]) THEN (move ["z_in"])); ((((use_arg_then "derivative_composition")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "z_in") (disch_tac [])) THEN (clear_assumption "z_in") THEN BETA_TAC) THEN (((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["_"])) THEN (case THEN (move ["_"])) THEN (simp_tac)) THEN (done_tac)); ((((use_arg_then "REAL_DIFFERENTIABLE_MUL_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((use_arg_then "dg")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); ((((fun arg_tac -> (use_arg_then "o_THM") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`derivative f`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "ETA_AX")(fun arg -> ONCE_REWRITE_TAC[get_arg_thm arg]))) THEN ((((use_arg_then "REAL_DIFFERENTIABLE_COMPOSE_ATREAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); ((((use_arg_then "ys'") (disch_tac [])) THEN (clear_assumption "ys'") THEN BETA_TAC) THEN (((use_arg_then "s'_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((((use_arg_then "IN_ELIM_THM")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["z"])) THEN (simp_tac)) THEN (done_tac)); ];; (* Lemma continuous_not0_exists_open *) let continuous_not0_exists_open = section_proof ["f";"x"] `~(f x = &0) ==> f real_continuous atreal x ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> ~(f y = &0)` [ ((((use_arg_then "real_continuous_atreal")(thm_tac (new_rewrite [] [])))) THEN (move ["fn0"]) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`abs (f x)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC))); ((THENL_FIRST) (ANTS_TAC) ((((use_arg_then "fn0") (disch_tac [])) THEN (clear_assumption "fn0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (BETA_TAC THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["ineq"])); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (x - d, x + d)`))) (term_tac exists_tac)); ((THENL_FIRST) (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN ((THENL) (split_tac) [ALL_TAC; (move ["y"])])) ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "fn0") (disch_tac [])) THEN (clear_assumption "fn0") THEN ((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN ((fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma continuous_gt_exists_open *) let continuous_gt_exists_open = section_proof ["a";"f";"x"] `a < f x ==> f real_continuous atreal x ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> a < f y` [ ((BETA_TAC THEN (move ["f_ineq"])) THEN ((((use_arg_then "real_continuous_atreal")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f x - a`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)))); ((THENL_FIRST) (ANTS_TAC) ((((use_arg_then "f_ineq") (disch_tac [])) THEN (clear_assumption "f_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (BETA_TAC THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["ineq"])); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (x - d, x + d)`))) (term_tac exists_tac)); ((THENL_FIRST) (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN ((THENL) (split_tac) [ALL_TAC; (move ["y"])])) ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "f_ineq") (disch_tac [])) THEN (clear_assumption "f_ineq") THEN ((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN ((fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma continuous_lt_exists_open *) let continuous_lt_exists_open = section_proof ["a";"f";"x"] `f x < a ==> f real_continuous atreal x ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> f y < a` [ ((BETA_TAC THEN (move ["f_ineq"])) THEN ((((use_arg_then "real_continuous_atreal")(thm_tac (new_rewrite [] [])))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`a - f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)))); ((THENL_FIRST) (ANTS_TAC) ((((use_arg_then "f_ineq") (disch_tac [])) THEN (clear_assumption "f_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); (BETA_TAC THEN (case THEN (move ["d"])) THEN (case THEN (move ["d0"])) THEN (move ["ineq"])); ((fun arg_tac -> arg_tac (Arg_term (`real_interval (x - d, x + d)`))) (term_tac exists_tac)); ((THENL_FIRST) (((((use_arg_then "REAL_OPEN_REAL_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_REAL_INTERVAL")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN ((THENL) (split_tac) [ALL_TAC; (move ["y"])])) ((((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "f_ineq") (disch_tac [])) THEN (clear_assumption "f_ineq") THEN ((use_arg_then "d0") (disch_tac [])) THEN (clear_assumption "d0") THEN ((fun arg_tac -> (use_arg_then "ineq") (fun fst_arg -> (use_arg_then "y") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (add_section_var (mk_var ("f", (`:real->real`))));; (add_section_var (mk_var ("x", (`:real`))));; (add_section_hyp "df" (`nth_diff_strong 2 f x`));; (* Lemma second_derivative_compose_atn *) let second_derivative_compose_atn = section_proof [] `nth_derivative 2 (\x. atn (f x)) x = (nth_derivative 2 f x * (&1 + f x * f x) - &2 * f x * derivative f x pow 2) / (&1 + f x * f x) pow 2` [ ((((use_arg_then "second_derivative_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_atn")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "second_derivative_atn")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "derivative_atn")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "real_sub")(gsym_then (thm_tac (new_rewrite [] [])))))); (((fun arg_tac -> arg_tac (Arg_term (`_1 * _2`))) (term_tac (set_tac "lhs1"))) THEN ((fun arg_tac -> arg_tac (Arg_term (`_1 * _2`))) (term_tac (set_tac "lhs2")))); ((((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_INV_POW")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_SUB_RDISTRIB")(thm_tac (new_rewrite [] []))))); (((fun arg_tac -> arg_tac (Arg_term (`_1 * _2`))) (term_tac (set_tac "rhs1"))) THEN ((fun arg_tac -> arg_tac (Arg_term (`_1 * _2`))) (term_tac (set_tac "rhs2")))); (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `lhs1 = rhs1 /\ lhs2 = rhs2 ==> lhs1 - lhs2 = rhs1 - rhs2`))) (disch_tac [])) THEN (DISCH_THEN apply_tac)); (((((use_arg_then "lhs2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "rhs2_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] [(`_1 * _2 pow 2`)])))) THEN (((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN ((split_tac) THEN ((TRY done_tac)))); ((((use_arg_then "rhs1_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_POW_2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_ASSOC")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c d. a * b * c * d = a * (b * c) * d`)))(thm_tac (new_rewrite [] []))))); ((((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "lhs1_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((fun arg_tac -> (use_arg_then "REAL_LE_SQUARE") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma second_derivative_compose_inv *) let second_derivative_compose_inv = section_proof [] `~(f x = &0) ==> nth_derivative 2 (\x. inv (f x)) x = (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / (f x pow 3)` [ (BETA_TAC THEN (move ["fn0"])); ((((use_arg_then "second_derivative_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_inv")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "second_derivative_inv")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "derivative_inv")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_sub")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_SUB_RDISTRIB")(thm_tac (new_rewrite [] []))))); ((THENL_FIRST) ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c d. a = c /\ b = d ==> a - b = c - d`))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN (split_tac)) ((arith_tac) THEN (done_tac))); ((((use_arg_then "REAL_INV_POW")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `3 = SUC 2`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_powS")(thm_tac (new_rewrite [] []))))); ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c d. (a * b) * c * d = a * (b * c) * d`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_POW_2")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_MUL_SYM")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_compose_sqrt *) let second_derivative_compose_sqrt = section_proof [] `&0 < f x ==> nth_derivative 2 (\x. sqrt (f x)) x = (&2 * nth_derivative 2 f x * f x - derivative f x pow 2) / (&4 * sqrt (f x pow 3))` [ (BETA_TAC THEN (move ["f_pos"])); ((((use_arg_then "second_derivative_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_sqrt")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "second_derivative_sqrt")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "derivative_sqrt")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_sub")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_SUB_RDISTRIB")(thm_tac (new_rewrite [] []))))); ((THENL_LAST) ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c d. a = c /\ b = d ==> a - b = c - d`))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN (split_tac)) ((arith_tac) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`sqrt (f x pow 3) = sqrt (f x) * f x`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "SQRT_POW")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `3 = SUC 2`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_powS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SQRT_POW_2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_IMP_LE")(thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (repeat_tactic 1 9 (((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] []))))); (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c d. (&2 * a * b) * inv (&4) * c * d = (inv (&2) * c) * a * (b * d)`)))(thm_tac (new_rewrite [] [])))); (((((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_POS_NZ")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_compose_acs *) let second_derivative_compose_acs = section_proof [] `abs (f x) < &1 ==> nth_derivative 2 (\x. acs (f x)) x = -- ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))` [ (BETA_TAC THEN (move ["f_ineq"])); ((((use_arg_then "second_derivative_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_acs")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "second_derivative_acs")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "derivative_acs")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))); ((repeat_tactic 1 9 (((use_arg_then "REAL_MUL_LNEG")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_NEG_ADD")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_EQ_NEG2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_ADD_RDISTRIB")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_ADD_SYM")(thm_tac (new_rewrite [] []))))); ((THENL_LAST) ((((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c d. a = c /\ b = d ==> a + b = c + d`))) (disch_tac [])) THEN (DISCH_THEN apply_tac)) THEN (split_tac)) ((arith_tac) THEN (done_tac))); ((fun arg_tac -> arg_tac (Arg_term (`&1 - f x * f x`))) (term_tac (set_tac "y"))); ((fun arg_tac -> arg_tac (Arg_term (`&0 <= y /\ &0 < y /\ ~(y = &0)`))) (term_tac (have_gen_tac [](move ["y_ineq"])))); ((((use_arg_then "y_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a. &1 - a * a = (&1 - a) * (&1 + a)`)))(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_ENTIRE")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_MUL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "REAL_LT_MUL")(thm_tac (new_rewrite [] [])))))) THEN (((use_arg_then "f_ineq") (disch_tac [])) THEN (clear_assumption "f_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`sqrt (y pow 3) = sqrt y * y`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "SQRT_POW")(gsym_then (thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `3 = SUC 2`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_powS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "SQRT_POW_2")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (REAL_ARITH `!a b c d. (a * b) * c * d = c * a * (b * d)`)))(thm_tac (new_rewrite [] []))))); (((((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_RID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_compose_atn *) let diff2_compose_atn = section_proof [] `nth_diff_strong 2 (\x. atn (f x)) x` [ (((((use_arg_then "diff2_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_atn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_compose_inv *) let diff2_compose_inv = section_proof [] `~(f x = &0) ==> nth_diff_strong 2 (\x. inv (f x)) x` [ ((BETA_TAC THEN (move ["fn0"])) THEN ((((use_arg_then "diff2_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_inv")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_compose_sqrt *) let diff2_compose_sqrt = section_proof [] `&0 < f x ==> nth_diff_strong 2 (\x. sqrt (f x)) x` [ ((BETA_TAC THEN (move ["f_pos"])) THEN ((((use_arg_then "diff2_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_sqrt")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_compose_acs *) let diff2_compose_acs = section_proof [] `abs (f x) < &1 ==> nth_diff_strong 2 (\x. acs (f x)) x` [ ((BETA_TAC THEN (move ["f_abs"])) THEN ((((use_arg_then "diff2_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_acs")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section SecondDerivativeCompose *) let REAL_CONTINUOUS_OPEN_PREIMAGE = finalize_theorem REAL_CONTINUOUS_OPEN_PREIMAGE;; let second_derivative_compose = finalize_theorem second_derivative_compose;; let diff2_compose = finalize_theorem diff2_compose;; let continuous_not0_exists_open = finalize_theorem continuous_not0_exists_open;; let continuous_gt_exists_open = finalize_theorem continuous_gt_exists_open;; let continuous_lt_exists_open = finalize_theorem continuous_lt_exists_open;; let second_derivative_compose_atn = finalize_theorem second_derivative_compose_atn;; let second_derivative_compose_inv = finalize_theorem second_derivative_compose_inv;; let second_derivative_compose_sqrt = finalize_theorem second_derivative_compose_sqrt;; let second_derivative_compose_acs = finalize_theorem second_derivative_compose_acs;; let diff2_compose_atn = finalize_theorem diff2_compose_atn;; let diff2_compose_inv = finalize_theorem diff2_compose_inv;; let diff2_compose_sqrt = finalize_theorem diff2_compose_sqrt;; let diff2_compose_acs = finalize_theorem diff2_compose_acs;; end_section "SecondDerivativeCompose";; (* Lemma second_derivative_mul *) let second_derivative_mul = section_proof ["f";"g";"x"] `nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x * g x) x = f x * nth_derivative 2 g x + &2 * derivative f x * derivative g x + nth_derivative 2 f x * g x` [ ((BETA_TAC THEN (move ["df0"]) THEN (move ["dg0"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`(x,x)`))) (term_tac (set_tac "int")))); ((fun arg_tac -> arg_tac (Arg_term (`interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`))) (term_tac (have_gen_tac [](case THEN ((move ["ineq"]) THEN (case THEN ((move ["df"]) THEN (move ["dg"])))))))); ((repeat_tactic 1 9 (((use_arg_then "int_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONST_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((split_tac) THEN (move ["y"])) THEN (((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ANTISYM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_mul") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN ((((use_arg_then "leqnn")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)))); ((((use_arg_then "TWO")(thm_tac (new_rewrite [1] [])))) THEN (((use_arg_then "ONE")(thm_tac (new_rewrite [1] [])))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL SUM_CLAUSES_NUMSEG)))(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `!n. 0 <= SUC n`)))(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "TWO")(gsym_then (thm_tac (new_rewrite [] [])))))); ((((use_arg_then "subnn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "subn0")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `2 - 1 = 1`)))(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_derivative1")(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "binom")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "BINOM_1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "BINOM_REFL")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_ADD_ASSOC")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_div *) let second_derivative_div = section_proof ["f";"g";"x"] `~(g x = &0) ==> nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x / g x) x = ((nth_derivative 2 f x * g x - f x * nth_derivative 2 g x) * g x - &2 * derivative g x * (derivative f x * g x - f x * derivative g x)) / (g x pow 3)` [ (BETA_TAC THEN (move ["gn0"]) THEN (move ["diff_f"]) THEN (move ["diff_g"])); (((fun arg_tac -> arg_tac (Arg_term (`derivative g x`))) (term_tac (set_tac "dg"))) THEN ((fun arg_tac -> arg_tac (Arg_term (`derivative f x`))) (term_tac (set_tac "df")))); (((fun arg_tac -> arg_tac (Arg_term (`nth_derivative 2 g x`))) (term_tac (set_tac "ddg"))) THEN ((fun arg_tac -> arg_tac (Arg_term (`nth_derivative 2 f x`))) (term_tac (set_tac "ddf")))); ((repeat_tactic 1 9 (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "second_derivative_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "second_derivative_compose_inv")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "diff2_compose_inv")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); (((use_arg_then "derivative_compose_inv")(thm_tac (new_rewrite [] [])))); ((((use_arg_then "diff_g") (disch_tac [])) THEN (clear_assumption "diff_g") THEN BETA_TAC) THEN ((((use_arg_then "nth_diff_strong2_eq")(thm_tac (new_rewrite [] [])))) THEN ALL_TAC THEN (case THEN (move ["s"])) THEN (case THEN (move ["open_s"])) THEN (case THEN (move ["xs"])) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac))) THEN (done_tac)); ((((use_arg_then "ddf_def")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ddg_def")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df_def")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dg_def")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "real_div")(thm_tac (new_rewrite [] [])))))); ((fun arg_tac -> arg_tac (Arg_term (`_1 + _2`))) (term_tac (set_tac "lhs"))); (((fun arg_tac -> arg_tac (Arg_theorem (REAL_RING `!f g x. ((ddf * g x - f x * ddg) * g x - &2 * dg * (df * g x - f x * dg)) * inv (g x pow 3) = f x * (&2 * dg pow 2 - ddg * g x) * inv (g x pow 3) + &2 * df * --(g x * inv (g x pow 3)) * dg + ddf * (g x * g x * inv (g x pow 3))`)))(thm_tac (new_rewrite [] [])))); ((fun arg_tac -> arg_tac (Arg_term (`g x * inv (g x pow 3) = inv (g x pow 2)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `3 = SUC 2`)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_powS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((fun arg_tac -> arg_tac (Arg_term (`g x * inv (g x pow 2) = inv (g x)`))) (term_tac (have_gen_tac [](((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))))); (((((use_arg_then "TWO")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "real_powS")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_INV_MUL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_ASSOC")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_MUL_RINV")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "REAL_MUL_LID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_POW_1")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((fun arg_tac -> (use_arg_then "REAL_POW_2") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`g x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "lhs_def")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma diff2_div *) let diff2_div = section_proof ["f";"g";"x"] `~(g x = &0) ==> nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_diff_strong 2 (\x. f x / g x) x` [ ((BETA_TAC THEN (move ["gn0"]) THEN (move ["df0"]) THEN (move ["dg0"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`(x,x)`))) (term_tac (set_tac "int")))); ((fun arg_tac -> arg_tac (Arg_term (`interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`))) (term_tac (have_gen_tac [](case THEN ((move ["ineq"]) THEN (case THEN ((move ["df"]) THEN (move ["dg"])))))))); ((repeat_tactic 1 9 (((use_arg_then "int_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONST_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((split_tac) THEN (move ["y"])) THEN (((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ANTISYM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); ((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_diff_mul") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`\x. inv (g x)`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)); ((((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN ((split_tac) THEN ((TRY done_tac)) THEN (move ["y"]))); (((((use_arg_then "int_def")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ANTISYM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))); ((((use_arg_then "diff2_compose_inv")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma second_derivative_scale *) let second_derivative_scale = section_proof ["f";"c";"x"] `nth_diff_strong 2 f x ==> nth_derivative 2 (\x. c * f x) x = c * nth_derivative 2 f x` [ ((BETA_TAC THEN (move ["df0"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`(x,x)`))) (term_tac (set_tac "int")))); ((fun arg_tac -> arg_tac (Arg_term (`interval_arith x int /\ nth_diff_strong_int 2 int f`))) (term_tac (have_gen_tac [](case THEN ((move ["ineq"]) THEN (move ["df"])))))); ((repeat_tactic 1 9 (((use_arg_then "int_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONST_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); ((BETA_TAC THEN (move ["y"])) THEN (((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ANTISYM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_scale") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "c") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN ((((use_arg_then "leqnn")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_add *) let second_derivative_add = section_proof ["f";"g";"x"] `nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x + g x) x = nth_derivative 2 f x + nth_derivative 2 g x` [ ((BETA_TAC THEN (move ["df0"]) THEN (move ["dg0"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`(x,x)`))) (term_tac (set_tac "int")))); ((fun arg_tac -> arg_tac (Arg_term (`interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`))) (term_tac (have_gen_tac [](case THEN ((move ["ineq"]) THEN (case THEN ((move ["df"]) THEN (move ["dg"])))))))); ((repeat_tactic 1 9 (((use_arg_then "int_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONST_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((split_tac) THEN (move ["y"])) THEN (((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ANTISYM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_add") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN ((((use_arg_then "leqnn")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_sub *) let second_derivative_sub = section_proof ["f";"g";"x"] `nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x - g x) x = nth_derivative 2 f x - nth_derivative 2 g x` [ ((BETA_TAC THEN (move ["df0"]) THEN (move ["dg0"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`(x,x)`))) (term_tac (set_tac "int")))); ((fun arg_tac -> arg_tac (Arg_term (`interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`))) (term_tac (have_gen_tac [](case THEN ((move ["ineq"]) THEN (case THEN ((move ["df"]) THEN (move ["dg"])))))))); ((repeat_tactic 1 9 (((use_arg_then "int_def")(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "CONST_INTERVAL")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))); (((split_tac) THEN (move ["y"])) THEN (((((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "REAL_LE_ANTISYM")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(gsym_then (thm_tac (new_rewrite [] [])))))) THEN (done_tac)); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "nth_derivative_sub") (fun fst_arg -> (use_arg_then "df") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "dg") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`2`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun arg -> thm_tac MP_TAC arg THEN ALL_TAC)) THEN ((((use_arg_then "leqnn")(thm_tac (new_rewrite [] [])))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_compose_bounds *) let second_derivative_compose_bounds = section_proof ["f";"g";"int";"g_bounds";"dd_bounds"] `nth_diff_strong_int 2 int g ==> bounded_on_int g int g_bounds ==> nth_diff_strong_int 2 g_bounds f ==> bounded_on_int (\x. nth_derivative 2 f (g x) * derivative g x pow 2 + derivative f (g x) * nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f (g x)) int dd_bounds` [ ((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)); ((BETA_TAC THEN (move ["dg"]) THEN (move ["g_bounded"]) THEN (move ["df"]) THEN (move ["bounded"])) THEN ((split_tac) THEN (move ["x"]) THEN (move ["ineq"]))); (((((use_arg_then "diff2_compose")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "g_bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_compose")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "g_bounded")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_atn_bounds *) let second_derivative_atn_bounds = section_proof ["dd_bounds"] `bounded_on_int (\x. (-- &2 * x) * inv(&1 + x pow 2) pow 2) int dd_bounds ==> has_bounded_second_derivative atn int dd_bounds` [ (((((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] []))))) THEN (move ["ineq"])); ((THENL_LAST) (split_tac) (((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "second_derivative_atn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (done_tac))); (((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "diff2_atn")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_compose_atn_bounds *) let second_derivative_compose_atn_bounds = section_proof ["f";"dd_bounds"] `nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (nth_derivative 2 f x * (&1 + f x * f x) - &2 * f x * derivative f x pow 2) / (&1 + f x * f x) pow 2) int dd_bounds ==> has_bounded_second_derivative (\x. atn (f x)) int dd_bounds` [ ((((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["df"]) THEN (move ["bounded"])) THEN ((split_tac) THEN (move ["x"]) THEN (move ["ineq"]))); (((((use_arg_then "diff2_compose_atn")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_compose_atn")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_inv_bounds *) let second_derivative_inv_bounds = section_proof ["dd_bounds"] `interval_not_zero int ==> bounded_on_int (\x. &2 * inv (x pow 3)) int dd_bounds ==> has_bounded_second_derivative inv int dd_bounds` [ ((((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["int0"]) THEN (move ["bounded"])) THEN ((split_tac) THEN (move ["x"]) THEN (move ["ineq"]))); (((((use_arg_then "diff2_inv")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_not_zero") (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_inv")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_not_zero") (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_compose_inv_bounds *) let second_derivative_compose_inv_bounds = section_proof ["f";"f_bounds";"dd_bounds"] `bounded_on_int f int f_bounds ==> interval_not_zero f_bounds ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / f x pow 3) int dd_bounds ==> has_bounded_second_derivative (\x. inv (f x)) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["f_bounded"]) THEN (move ["f0"]) THEN (move ["df"]) THEN (move ["bounded"])); ((fun arg_tac -> arg_tac (Arg_term (`!x. interval_arith x int ==> ~(f x = &0)`))) (term_tac (have_gen_tac [](move ["fn0"])))); ((BETA_TAC THEN (move ["x"]) THEN (move ["ineq"])) THEN ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_not_zero") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f_bounds") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "f_bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((split_tac) THEN (move ["x"]) THEN (move ["ineq"])); (((((use_arg_then "diff2_compose_inv")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "fn0")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_compose_inv")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "fn0")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_sqrt_bounds *) let second_derivative_sqrt_bounds = section_proof ["dd_bounds"] `interval_pos int ==> bounded_on_int (\x. --inv (&4 * sqrt (x pow 3))) int dd_bounds ==> has_bounded_second_derivative sqrt int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["int_pos"]) THEN (move ["bounded"])); ((split_tac) THEN (move ["x"]) THEN (move ["ineq"])); (((((use_arg_then "diff2_sqrt")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_pos") (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_sqrt")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_pos") (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_compose_sqrt_bounds *) let second_derivative_compose_sqrt_bounds = section_proof ["f";"f_bounds";"dd_bounds"] `bounded_on_int f int f_bounds ==> interval_pos f_bounds ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (&2 * nth_derivative 2 f x * f x - derivative f x pow 2) / (&4 * sqrt (f x pow 3))) int dd_bounds ==> has_bounded_second_derivative (\x. sqrt (f x)) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["f_bounded"]) THEN (move ["f_int"]) THEN (move ["df"]) THEN (move ["bounded"])); ((fun arg_tac -> arg_tac (Arg_term (`!x. interval_arith x int ==> &0 < f x`))) (term_tac (have_gen_tac [](move ["f_pos"])))); ((BETA_TAC THEN (move ["x"]) THEN (move ["ineq"])) THEN ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_pos") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f_bounds") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "f_bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((split_tac) THEN (move ["x"]) THEN (move ["ineq"])); (((((use_arg_then "diff2_compose_sqrt")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "f_pos")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_compose_sqrt")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "f_pos")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_acs_bounds *) let second_derivative_acs_bounds = section_proof ["dd_bounds"] `iabs int < &1 ==> bounded_on_int (\x. --(x / sqrt ((&1 - x * x) pow 3))) int dd_bounds ==> has_bounded_second_derivative acs int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["int_abs"]) THEN (move ["bounded"])); ((split_tac) THEN (move ["x"]) THEN (move ["ineq"])); (((((use_arg_then "diff2_acs")(thm_tac (new_rewrite [] [])))) THEN (((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_abs") (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_acs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_abs") (fun fst_arg -> (use_arg_then "x") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "int") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_compose_acs_bounds *) let second_derivative_compose_acs_bounds = section_proof ["f";"f_bounds";"dd_bounds"] `bounded_on_int f int f_bounds ==> iabs f_bounds < &1 ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. --((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))) int dd_bounds ==> has_bounded_second_derivative (\x. acs (f x)) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (simp_tac)) THEN (move ["f_bounded"]) THEN (move ["f_abs"]) THEN (move ["df"]) THEN (move ["bounded"])); ((fun arg_tac -> arg_tac (Arg_term (`!x. interval_arith x int ==> abs (f x) < &1`))) (term_tac (have_gen_tac [](move ["fabs"])))); ((BETA_TAC THEN (move ["x"]) THEN (move ["ineq"])) THEN ((((fun arg_tac -> (fun arg_tac -> (use_arg_then "interval_arith_abs") (fun fst_arg -> (fun arg_tac -> arg_tac (Arg_term (`f x`))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "f_bounds") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg)))(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "f_bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((split_tac) THEN (move ["x"]) THEN (move ["ineq"])); (((((use_arg_then "diff2_compose_acs")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "fabs")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "second_derivative_compose_acs")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "fabs")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_scale_bounds *) let second_derivative_scale_bounds = section_proof ["c";"f";"dd_bounds"] `nth_diff_strong_int 2 int f ==> bounded_on_int (\x. c * nth_derivative 2 f x) int dd_bounds ==> has_bounded_second_derivative (\x. c * f x) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))))) THEN (simp_tac) THEN (move ["df"]) THEN (move ["b"])); (((((use_arg_then "nth_diff_scale")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (move ["ineq"])); ((((use_arg_then "second_derivative_scale")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "b")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (exact_tac) THEN (done_tac)); ];; (* Lemma second_derivative_add_bounds *) let second_derivative_add_bounds = section_proof ["f";"g";"dd_bounds"] `nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. nth_derivative 2 f x + nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f x + g x) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))))) THEN (simp_tac) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["b"])); (((((use_arg_then "nth_diff_add")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (move ["ineq"])); ((((use_arg_then "second_derivative_add")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "b")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_sub_bounds *) let second_derivative_sub_bounds = section_proof ["f";"g";"dd_bounds"] `nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. nth_derivative 2 f x - nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f x - g x) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))))) THEN (simp_tac) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["b"])); (((((use_arg_then "nth_diff_sub")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (move ["ineq"])); ((((use_arg_then "second_derivative_sub")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "b")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_mul_bounds *) let second_derivative_mul_bounds = section_proof ["f";"g";"dd_bounds"] `nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. f x * nth_derivative 2 g x + &2 * derivative f x * derivative g x + nth_derivative 2 f x * g x) int dd_bounds ==> has_bounded_second_derivative (\x. f x * g x) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))))) THEN (simp_tac) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["b"])); (((((use_arg_then "nth_diff_mul")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["x"]) THEN (move ["ineq"])); ((((use_arg_then "second_derivative_mul")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "b")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac))); ((((use_arg_then "dg") (disch_tac [])) THEN (clear_assumption "dg") THEN ((use_arg_then "df") (disch_tac [])) THEN (clear_assumption "df") THEN BETA_TAC) THEN ((repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma second_derivative_div_bounds *) let second_derivative_div_bounds = section_proof ["f";"g";"g_bounds";"dd_bounds"] `bounded_on_int g int g_bounds ==> interval_not_zero g_bounds ==> nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. ((nth_derivative 2 f x * g x - f x * nth_derivative 2 g x) * g x - &2 * derivative g x * (derivative f x * g x - f x * derivative g x)) / g x pow 3) int dd_bounds ==> has_bounded_second_derivative (\x. f x / g x) int dd_bounds` [ (((((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))))) THEN (move ["bg"]) THEN (move ["gn0"]) THEN (simp_tac) THEN (move ["df"]) THEN (move ["dg"]) THEN (move ["b"])); ((fun arg_tac -> arg_tac (Arg_term (`!x. interval_arith x int ==> ~(g x = &0)`))) (term_tac (have_gen_tac [](move ["g0"])))); ((BETA_TAC THEN (move ["x"]) THEN (move ["ineq"])) THEN (((use_arg_then "interval_arith_not_zero") (disch_tac [])) THEN (clear_assumption "interval_arith_not_zero") THEN (DISCH_THEN apply_tac)) THEN ((fun arg_tac -> arg_tac (Arg_term (`g_bounds`))) (term_tac exists_tac)) THEN (((use_arg_then "bg")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((THENL_FIRST) ((split_tac) THEN (move ["x"]) THEN (move ["ineq"])) (((((use_arg_then "diff2_div")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "g0")(thm_tac (new_rewrite [] [])))) THEN ((TRY done_tac)) THEN (((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] [])))))) THEN (done_tac))); (((((use_arg_then "second_derivative_div")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 0 10 (((use_arg_then "g0")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "df")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 0 10 (((use_arg_then "dg")(thm_tac (new_rewrite [] []))))) THEN ((TRY done_tac)) THEN (((use_arg_then "b")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Finalization of the section SecondDerivativeBound *) let nth_diff_strong2_eq_alt = finalize_theorem nth_diff_strong2_eq_alt;; let nth_diff_strong2_eq = finalize_theorem nth_diff_strong2_eq;; let lin_approx_compose = finalize_theorem lin_approx_compose;; let second_derivative_atn_eq = finalize_theorem second_derivative_atn_eq;; let second_derivative_atn = finalize_theorem second_derivative_atn;; let diff2_atn = finalize_theorem diff2_atn;; let second_derivative_inv = finalize_theorem second_derivative_inv;; let diff2_inv = finalize_theorem diff2_inv;; let SQRT_POW = finalize_theorem SQRT_POW;; let second_derivative_sqrt = finalize_theorem second_derivative_sqrt;; let diff2_sqrt = finalize_theorem diff2_sqrt;; let real_powS = finalize_theorem real_powS;; let second_derivative_acs = finalize_theorem second_derivative_acs;; let diff2_acs = finalize_theorem diff2_acs;; let REAL_CONTINUOUS_OPEN_PREIMAGE = finalize_theorem REAL_CONTINUOUS_OPEN_PREIMAGE;; let second_derivative_compose = finalize_theorem second_derivative_compose;; let diff2_compose = finalize_theorem diff2_compose;; let continuous_not0_exists_open = finalize_theorem continuous_not0_exists_open;; let continuous_gt_exists_open = finalize_theorem continuous_gt_exists_open;; let continuous_lt_exists_open = finalize_theorem continuous_lt_exists_open;; let second_derivative_compose_atn = finalize_theorem second_derivative_compose_atn;; let second_derivative_compose_inv = finalize_theorem second_derivative_compose_inv;; let second_derivative_compose_sqrt = finalize_theorem second_derivative_compose_sqrt;; let second_derivative_compose_acs = finalize_theorem second_derivative_compose_acs;; let diff2_compose_atn = finalize_theorem diff2_compose_atn;; let diff2_compose_inv = finalize_theorem diff2_compose_inv;; let diff2_compose_sqrt = finalize_theorem diff2_compose_sqrt;; let diff2_compose_acs = finalize_theorem diff2_compose_acs;; let second_derivative_mul = finalize_theorem second_derivative_mul;; let second_derivative_div = finalize_theorem second_derivative_div;; let diff2_div = finalize_theorem diff2_div;; let second_derivative_scale = finalize_theorem second_derivative_scale;; let second_derivative_add = finalize_theorem second_derivative_add;; let second_derivative_sub = finalize_theorem second_derivative_sub;; let second_derivative_compose_bounds = finalize_theorem second_derivative_compose_bounds;; let second_derivative_atn_bounds = finalize_theorem second_derivative_atn_bounds;; let second_derivative_compose_atn_bounds = finalize_theorem second_derivative_compose_atn_bounds;; let second_derivative_inv_bounds = finalize_theorem second_derivative_inv_bounds;; let second_derivative_compose_inv_bounds = finalize_theorem second_derivative_compose_inv_bounds;; let second_derivative_sqrt_bounds = finalize_theorem second_derivative_sqrt_bounds;; let second_derivative_compose_sqrt_bounds = finalize_theorem second_derivative_compose_sqrt_bounds;; let second_derivative_acs_bounds = finalize_theorem second_derivative_acs_bounds;; let second_derivative_compose_acs_bounds = finalize_theorem second_derivative_compose_acs_bounds;; let second_derivative_scale_bounds = finalize_theorem second_derivative_scale_bounds;; let second_derivative_add_bounds = finalize_theorem second_derivative_add_bounds;; let second_derivative_sub_bounds = finalize_theorem second_derivative_sub_bounds;; let second_derivative_mul_bounds = finalize_theorem second_derivative_mul_bounds;; let second_derivative_div_bounds = finalize_theorem second_derivative_div_bounds;; end_section "SecondDerivativeBound";; (* Section TaylorArith *) begin_section "TaylorArith";; let cell_domain = new_definition `cell_domain x y z w <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w`;; (* Lemma taylor_x *) let taylor_x = section_proof ["x";"y";"z";"w"] `cell_domain x y z w ==> taylor_interval (\x. x) x y z w (y, y) (&1, &1) (&0, &0)` [ ((((use_arg_then "cell_domain")(thm_tac (new_rewrite [] [])))) THEN (move ["ineqs"])); ((((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ineqs")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "lin_approx_x")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))); (((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((BETA_TAC THEN (move ["p"]) THEN (move ["_"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`(:real)`))) (term_tac exists_tac)) THEN (((((use_arg_then "REAL_OPEN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_UNIV")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["q"]) THEN (simp_tac))); (((((use_arg_then "REAL_CONTINUOUS_AT_ID")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"])); ((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `i < 2 <=> i = 0 \/ i = 1`)))(thm_tac (new_rewrite [] [])))) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_x")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_ID")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "nth_derivative1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "TWO")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_x")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); ((((use_arg_then "HAS_REAL_DERIVATIVE_CONST")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_x")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); (((repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma taylor_const *) let taylor_const = section_proof ["c";"x";"y";"z";"w"] `cell_domain x y z w ==> taylor_interval (\x. c) x y z w (c, c) (&0, &0) (&0, &0)` [ ((((use_arg_then "cell_domain")(thm_tac (new_rewrite [] [])))) THEN (move ["ineqs"])); ((((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "ineqs")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "lin_approx_const")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))); (((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] [])))); (((((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_diff_strong")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_on")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "nth_differentiable_eq")(thm_tac (new_rewrite [] []))))) THEN (split_tac)); ((BETA_TAC THEN (move ["p"]) THEN (move ["_"])) THEN ((fun arg_tac -> arg_tac (Arg_term (`(:real)`))) (term_tac exists_tac)) THEN (((((use_arg_then "REAL_OPEN_UNIV")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "IN_UNIV")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "andTb")(thm_tac (new_rewrite [] [])))))) THEN (move ["q"]) THEN (simp_tac))); (((((use_arg_then "REAL_CONTINUOUS_CONST")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andTb")(thm_tac (new_rewrite [] []))))) THEN (move ["i"])); ((((fun arg_tac -> arg_tac (Arg_theorem (ARITH_RULE `i < 2 <=> i = 0 \/ i = 1`)))(thm_tac (new_rewrite [] [])))) THEN (case THEN (((conv_thm_tac DISCH_THEN)(thm_tac (new_rewrite [] [])))))); (((((use_arg_then "nth_derivative0")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "ONE")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "derivative_const")(thm_tac (new_rewrite [] [])))) THEN (simp_tac) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_CONST")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); (((((use_arg_then "nth_derivative1")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "TWO")(gsym_then (thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "derivative_const")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "HAS_REAL_DERIVATIVE_CONST")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ((((use_arg_then "nth_derivative2")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "derivative_const")(thm_tac (new_rewrite [] []))))) THEN (simp_tac) THEN (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (simp_tac)); (((repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "REAL_LE_REFL")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (add_section_var (mk_var ("f", (`:real->real`))));; (add_section_var (mk_var ("x", (`:real`))); add_section_var (mk_var ("y", (`:real`))); add_section_var (mk_var ("z", (`:real`))); add_section_var (mk_var ("w", (`:real`))));; (add_section_var (mk_var ("f_bounds", (`:real#real`))); add_section_var (mk_var ("df_bounds", (`:real#real`))); add_section_var (mk_var ("dd_bounds", (`:real#real`))));; (add_section_var (mk_var ("f_lo", (`:real`))); add_section_var (mk_var ("f_hi", (`:real`))); add_section_var (mk_var ("df_lo", (`:real`))); add_section_var (mk_var ("df_hi", (`:real`))));; (* Lemma taylor_f_bounds *) let taylor_f_bounds = section_proof ["df";"dd";"lo";"hi";"t"] `taylor_interval f x y z w (f_lo, f_hi) df_bounds dd_bounds ==> iabs df_bounds = df ==> iabs dd_bounds = dd ==> w * (df + w * dd * inv(&2)) <= t ==> f_hi + t <= hi ==> lo <= f_lo - t ==> bounded_on_int f (x, z) (lo, hi)` [ (BETA_TAC THEN (move ["taylor_f"]) THEN (move ["iabs_df"]) THEN (move ["iabs_dd"]) THEN (move ["t_ineq"]) THEN (move ["hi_ineq"]) THEN (move ["lo_ineq"])); (((((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))))) THEN (move ["p"]) THEN (move ["ineq"])); (((fun arg_tac -> (fun arg_tac -> (use_arg_then "taylor_upper_bound") (fun fst_arg -> (fun arg_tac -> (use_arg_then "EQ_SYM") (fun fst_arg -> (use_arg_then "iabs_dd") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "taylor_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN ((fun arg_tac -> (fun arg_tac -> (use_arg_then "taylor_lower_bound") (fun fst_arg -> (fun arg_tac -> (use_arg_then "EQ_SYM") (fun fst_arg -> (use_arg_then "iabs_dd") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "taylor_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); (((simp_tac) THEN (repeat_tactic 1 9 (((use_arg_then "real_div")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "iabs_df")(thm_tac (new_rewrite [] []))))) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (move ["ineq1"]) THEN ((fun arg_tac -> (conv_thm_tac DISCH_THEN) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (thm_tac MP_TAC)) THEN (move ["ineq2"])); ((((use_arg_then "t_ineq") (disch_tac [])) THEN (clear_assumption "t_ineq") THEN ((use_arg_then "hi_ineq") (disch_tac [])) THEN (clear_assumption "hi_ineq") THEN ((use_arg_then "lo_ineq") (disch_tac [])) THEN (clear_assumption "lo_ineq") THEN ((use_arg_then "ineq2") (disch_tac [])) THEN (clear_assumption "ineq2") THEN ((use_arg_then "ineq1") (disch_tac [])) THEN (clear_assumption "ineq1") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma taylor_df_bounds *) let taylor_df_bounds = section_proof ["dd";"lo";"hi"] `taylor_interval f x y z w f_bounds (df_lo, df_hi) dd_bounds ==> iabs dd_bounds = dd ==> df_hi + w * dd <= hi ==> lo <= df_lo - w * dd ==> bounded_on_int (derivative f) (x, z) (lo, hi)` [ (BETA_TAC THEN (move ["taylor_f"]) THEN (move ["iabs_dd"]) THEN (move ["hi_ineq"]) THEN (move ["lo_ineq"])); (((((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "interval_arith")(thm_tac (new_rewrite [] [])))))) THEN (move ["p"]) THEN (move ["ineq"])); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "taylor_derivative_lower_bound") (fun fst_arg -> (fun arg_tac -> (use_arg_then "EQ_SYM") (fun fst_arg -> (use_arg_then "iabs_dd") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "taylor_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); (((fun arg_tac -> (fun arg_tac -> (fun arg_tac -> (use_arg_then "taylor_derivative_upper_bound") (fun fst_arg -> (fun arg_tac -> (use_arg_then "EQ_SYM") (fun fst_arg -> (use_arg_then "iabs_dd") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "taylor_f") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (fun fst_arg -> (use_arg_then "ineq") (fun snd_arg -> combine_args_then arg_tac fst_arg snd_arg))) (disch_tac [])) THEN BETA_TAC); ((((use_arg_then "hi_ineq") (disch_tac [])) THEN (clear_assumption "hi_ineq") THEN ((use_arg_then "lo_ineq") (disch_tac [])) THEN (clear_assumption "lo_ineq") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac)); ];; (* Lemma bounded_on_int_compose *) let bounded_on_int_compose = section_proof ["g";"int";"g_bounds"] `bounded_on_int g int g_bounds ==> bounded_on_int f g_bounds f_bounds ==> bounded_on_int (\x. f (g x)) int f_bounds` [ ((repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] []))))) THEN (move ["g_bounded"]) THEN (move ["f_bounded"]) THEN (move ["x"]) THEN (move ["ineq"]) THEN (simp_tac)); (((((use_arg_then "f_bounded")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "g_bounded")(thm_tac (new_rewrite [] []))))) THEN (done_tac)); ];; (* Lemma bounded_on_int_imp_interval_arith *) let bounded_on_int_imp_interval_arith = section_proof ["int"] `bounded_on_int f int f_bounds ==> interval_arith y int ==> interval_arith (f y) f_bounds` [ ((((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))) THEN (move ["bounded_f"]) THEN (move ["int_y"])); ((((use_arg_then "bounded_f")(thm_tac (new_rewrite [] [])))) THEN (done_tac)); ];; (* Lemma taylor_interval_narrow *) let taylor_interval_narrow = section_proof ["x0";"z0";"w0"] `taylor_interval f x y z w f_bounds df_bounds dd_bounds ==> cell_domain x0 y z0 w0 ==> x <= x0 ==> z0 <= z ==> taylor_interval f x0 y z0 w0 f_bounds df_bounds dd_bounds` [ (((repeat_tactic 1 9 (((use_arg_then "taylor_interval")(thm_tac (new_rewrite [] []))))) THEN (((use_arg_then "cell_domain")(thm_tac (new_rewrite [] [])))) THEN (repeat_tactic 1 9 (((use_arg_then "andbA")(thm_tac (new_rewrite [] [])))))) THEN ALL_TAC THEN (case THEN ((case THEN ((move ["ineq"]) THEN (move ["lin"]))) THEN (move ["dd"]))) THEN (move ["c"]) THEN (move ["i1"]) THEN (move ["i2"])); ((THENL_FIRST) (((((use_arg_then "lin")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "andbT")(thm_tac (new_rewrite [] []))))) THEN (split_tac)) ((((use_arg_then "i2") (disch_tac [])) THEN (clear_assumption "i2") THEN ((use_arg_then "i1") (disch_tac [])) THEN (clear_assumption "i1") THEN ((use_arg_then "c") (disch_tac [])) THEN (clear_assumption "c") THEN BETA_TAC) THEN (arith_tac) THEN (done_tac))); ((((use_arg_then "dd") (disch_tac [])) THEN (clear_assumption "dd") THEN BETA_TAC) THEN (((repeat_tactic 1 9 (((use_arg_then "has_bounded_second_derivative")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "nth_diff_strong_int")(thm_tac (new_rewrite [] []))))) THEN (repeat_tactic 1 9 (((use_arg_then "bounded_on_int")(thm_tac (new_rewrite [] [])))))) THEN (move ["df"]))); ((split_tac) THEN (move ["p"]) THEN (move ["int_p"])); ((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "i2") (disch_tac [])) THEN (clear_assumption "i2") THEN ((use_arg_then "i1") (disch_tac [])) THEN (clear_assumption "i1") THEN ((use_arg_then "int_p") (disch_tac [])) THEN (clear_assumption "int_p") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL interval_arith)))(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ((((use_arg_then "df")(thm_tac (new_rewrite [] [])))) THEN (((use_arg_then "i2") (disch_tac [])) THEN (clear_assumption "i2") THEN ((use_arg_then "i1") (disch_tac [])) THEN (clear_assumption "i1") THEN ((use_arg_then "int_p") (disch_tac [])) THEN (clear_assumption "int_p") THEN BETA_TAC) THEN (repeat_tactic 1 9 (((fun arg_tac -> arg_tac (Arg_theorem (GEN_ALL interval_arith)))(thm_tac (new_rewrite [] []))))) THEN (arith_tac) THEN (done_tac)); ];; (* Finalization of the section TaylorArith *) let taylor_x = finalize_theorem taylor_x;; let taylor_const = finalize_theorem taylor_const;; let taylor_f_bounds = finalize_theorem taylor_f_bounds;; let taylor_df_bounds = finalize_theorem taylor_df_bounds;; let bounded_on_int_compose = finalize_theorem bounded_on_int_compose;; let bounded_on_int_imp_interval_arith = finalize_theorem bounded_on_int_imp_interval_arith;; let taylor_interval_narrow = finalize_theorem taylor_interval_narrow;; end_section "TaylorArith";; hol-light/Formal_ineqs/taylor/theory/taylor_interval.vhl000066400000000000000000002542031303454263000241470ustar00rootroot00000000000000(* =========================================================== *) (* Theory of univariate taylor intervals *) (* Requires SSReflect/HOL Light for translation *) (* See http://code.google.com/p/flyspeck/downloads/list *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) "needs \"lib/ssrbool-compiled.hl\"". "needs \"lib/ssrnat-compiled.hl\"". "needs \"arith/interval_arith.hl\"". "needs \"Multivariate/realanalysis.ml\"". "open Interval_arith". "prioritize_real()". "let derivative = new_definition `derivative f = \y. @d. (f has_real_derivative d) (atreal y)`". "let nth_derivative = new_definition `nth_derivative n f = iter n derivative f`". "let nth_differentiable = define `(nth_differentiable 0 f x <=> f real_continuous atreal x) /\ (nth_differentiable (SUC n) f x <=> nth_differentiable n f x /\ nth_derivative n f real_differentiable atreal x)`". "let nth_differentiable_on = new_definition `nth_differentiable_on n s f <=> !x. x IN s ==> nth_differentiable n f x`". "let nth_differentiable_on_int = new_definition `nth_differentiable_on_int n int f <=> !x. interval_arith x int ==> nth_differentiable n f x`". "let nth_diff_weak = new_definition `nth_diff_weak n f x <=> f real_continuous atreal x /\ ?F. F 0 = f /\ !i. i < n ==> (F i has_real_derivative F (SUC i) x) (atreal x)`". "let nth_diff_strong = new_definition `nth_diff_strong n f x <=> ?s. real_open s /\ x IN s /\ nth_differentiable_on n s f`". "let nth_diff_strong_int = new_definition `nth_diff_strong_int n int f <=> !x. interval_arith x int ==> nth_diff_strong n f x`". Section NthDerivatives. Lemma has_derivative_cond f x : `(?d. (f has_real_derivative d) (atreal x)) ==> (f has_real_derivative (derivative f x)) (atreal x)`. move => [d] df. suff ->: `derivative f x = d`; first exact. rewrite derivative /=; apply SELECT_UNIQUE => /= y; split => [df2 | -> //]. by apply: (REAL_DERIVATIVE_UNIQUE_ATREAL f x). Qed. Lemma has_derivative_alt f x : `f real_differentiable atreal x ==> (f has_real_derivative (derivative f x)) (atreal x)`. by rewrite real_differentiable => /has_derivative_cond. Qed. Lemma derivative_unique f f' x : `(f has_real_derivative f') (atreal x) ==> derivative f x = f'`. move => df; apply: (REAL_DERIVATIVE_UNIQUE_ATREAL f x). by rewrite df has_derivative_cond //; exists f'. Qed. Lemma derivative_unique_on s f f': `(!x. x IN s ==> (f has_real_derivative f' x) (atreal x)) ==> (!x. x IN s ==> f' x = derivative f x)`. move => df x xs. by rewrite (derivative_unique f `f' x`) // df. Qed. Lemma has_derivative_lemma f f' x : `f real_differentiable atreal x /\ derivative f x = f' ==> (f has_real_derivative f') (atreal x)`. by move => [diff <-]; rewrite has_derivative_alt. Qed. Lemma nth_derivative0 f : `nth_derivative 0 f = f`. by rewrite nth_derivative "GEN_ALL iter". Qed. Lemma nth_derivativeS n f : `nth_derivative (SUC n) f = derivative (nth_derivative n f)`. by rewrite !nth_derivative iterS. Qed. Lemma nth_Sderivative n f : `nth_derivative (SUC n) f = nth_derivative n (derivative f)`. by rewrite nth_derivative iterSr -nth_derivative. Qed. Lemma nth_derivative1 f : `nth_derivative 1 f = derivative f`. by rewrite ONE nth_derivativeS nth_derivative0. Qed. Lemma nth_derivative2 f : `nth_derivative 2 f = derivative (derivative f)`. by rewrite "ARITH_RULE `2 = SUC(SUC 0)`" nth_derivative !iterS "GEN_ALL iter". Qed. Lemma nth_derivative_add n m f : `nth_derivative n (nth_derivative m f) = nth_derivative (n + m) f`. by rewrite !nth_derivative iter_add. Qed. Lemma nth_diff_continuous n f x : `nth_differentiable n f x ==> f real_continuous atreal x`. elim: n => [|n IHn]; rewrite nth_differentiable //. by move => [/IHn] /=. Qed. Lemma nth_differentiable_cond n f x : `nth_differentiable n f x ==> !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)`. elim: n => [|n IHn]; first by rewrite ltn0. rewrite nth_differentiable => [] [/IHn df_n dfn] i. rewrite ltE leqSS leq_eqVlt; case => [-> | /df_n //]. by rewrite nth_derivativeS has_derivative_alt. Qed. Lemma nth_differentiable_on_cond n s f : `nth_differentiable_on n s f ==> !x. x IN s ==> !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)`. rewrite nth_differentiable_on => cond x. by move/cond => /nth_differentiable_cond. Qed. Lemma nth_differentiable_eq n f x : `nth_differentiable n f x <=> f real_continuous atreal x /\ !i. i < n ==> (nth_derivative i f has_real_derivative (nth_derivative (SUC i) f x)) (atreal x)`. split => [dn_f | [f_cont]]. by rewrite (nth_diff_continuous dn_f) andTb; exact: nth_differentiable_cond. elim: n => [|n IHn]; rewrite nth_differentiable // ltE leqSS leq_eqVlt => cond. rewrite IHn ?andTb; first by move => i i_lt_n; apply: cond. rewrite real_differentiable; exists `nth_derivative (SUC n) f x`. exact: cond. Qed. Lemma nth_differentiable_on_int2 f int : `nth_differentiable_on_int 2 int f ==> ?f' f''. f' = derivative f /\ f'' = nth_derivative 2 f /\ !x. interval_arith x int ==> (f has_real_derivative f' x) (atreal x) /\ (f' has_real_derivative f'' x) (atreal x)`. rewrite nth_differentiable_on_int => h. exists `derivative f` `nth_derivative 2 f` => /= x ineq. rewrite -nth_derivative1 -{1}(nth_derivative0 f) {1}ONE "ARITH_RULE `2 = SUC 1`". by rewrite !(nth_differentiable_cond `2`) // h //; arith. Qed. Lemma nth_mth_diff n m f x: `n <= m ==> nth_differentiable m f x ==> nth_differentiable n f x`. Proof. move => n_le_m; rewrite !nth_differentiable_eq => [] [-> cond]; rewrite andTb => i i_lt. by apply: cond; apply: ltn_leq_trans n_le_m. Qed. Lemma nth_differentiable1 f x : `nth_differentiable 1 f x <=> f real_differentiable atreal x`. rewrite ONE !"GEN_ALL nth_differentiable" nth_derivative0; split => [-> | df]. by rewrite REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL. Qed. Lemma nth_diff_imp_diff n f x : `0 < n ==> nth_differentiable n f x ==> f real_differentiable atreal x`. by rewrite ltE -ONE => ineq df; rewrite -nth_differentiable1; apply: nth_mth_diff; exists n. Qed. Lemma nth_derivative_continuous n f x i: `nth_differentiable n f x ==> i < n ==> nth_derivative i f real_continuous atreal x`. rewrite nth_differentiable_eq => [] [_] df. move/df => cond; apply: REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL. by rewrite real_differentiable; exists `nth_derivative (SUC i) f x`. Qed. Lemma ith_derivative_differentiable i n f x: `nth_differentiable n f x ==> i < n ==> nth_differentiable (n - i) (nth_derivative i f) x`. move => dnf. move: (dnf); rewrite !nth_differentiable_eq => [] [_] cond i_lt_n. rewrite (nth_derivative_continuous dnf) // andTb => j j_lt_ni. by rewrite !nth_derivative_add addSn cond; move: j_lt_ni; arith. Qed. Lemma nth_diff_strong_imp_diff n f x : `nth_diff_strong n f x ==> nth_differentiable n f x`. rewrite nth_diff_strong => [] [s] [_] [xs]; rewrite nth_differentiable_on => h. exact: h. Qed. Section DerivativeArith. (* Elementary derivatives *) Section ElementaryDerivatives. Lemma derivative_x : `derivative (\x. x) = (\x. &1)`. rewrite -eq_ext => x /=. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_ID. Qed. Lemma derivative_const c : `derivative (\x. c) = (\x. &0)`. rewrite -eq_ext => x /=. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_CONST. Qed. Lemma derivative_inv x : `~(x = &0) ==> derivative inv x = -- inv (x * x)`. move => xn0. by apply: derivative_unique; rewrite -REAL_POW_2 HAS_REAL_DERIVATIVE_INV_BASIC. Qed. Lemma derivative_atn : `derivative atn = (\x. inv (&1 + x * x))`. rewrite -eq_ext -REAL_POW_2 => x /=. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_ATN. Qed. Lemma derivative_exp : `derivative exp = exp`. rewrite -eq_ext => x /=. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_EXP. Qed. Lemma derivative_acs x : `abs x < &1 ==> derivative acs x = --inv(sqrt(&1 - x * x))`. move => x_ineq. by apply: derivative_unique; rewrite -REAL_POW_2 HAS_REAL_DERIVATIVE_ACS. Qed. Lemma derivative_sqrt x : `&0 < x ==> derivative sqrt x = inv (&2 * sqrt x)`. move => xg0. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_SQRT. Qed. Lemma derivative_composition f g x: `f real_differentiable atreal x ==> g real_differentiable atreal (f x) ==> derivative (\x. g (f x)) x = derivative f x * derivative g (f x)`. move => /has_derivative_alt df /has_derivative_alt dg; apply: derivative_unique. have := "GEN_ALL HAS_REAL_DERIVATIVE_CHAIN" `derivative f x` `derivative g` `\y. y = f x` f g; "ANTS_TAC"; first by move => y ->. by move => [_]; apply. Qed. Section ElementaryCompose. Lemma REAL_DIFFERENTIABLE_AT_INV x : `~(x = &0) ==> inv real_differentiable atreal x`. move => xn0. have := REAL_DIFFERENTIABLE_INV_ATREAL `(\x. x:real)` x. by rewrite /= REAL_DIFFERENTIABLE_ID xn0 /=; rewr ETA_AX. Qed. Variable f : `:real->real`. Variable x : `:real`. Hypothesis df : `f real_differentiable atreal x`. Lemma derivative_compose_atn : `(\x. atn (f x)) real_differentiable atreal x /\ derivative (\x. atn (f x)) x = derivative f x / (&1 + f x * f x)`. split. rewrite -(o_THM `atn`); rewr ETA_AX; apply: REAL_DIFFERENTIABLE_COMPOSE_ATREAL. by rewrite REAL_DIFFERENTIABLE_AT_ATN df. rewrite derivative_composition ?df ?REAL_DIFFERENTIABLE_AT_ATN //. by rewrite derivative_atn /= real_div. Qed. Lemma derivative_compose_exp : `(\x. exp (f x)) real_differentiable atreal x /\ derivative (\x. exp (f x)) x = exp (f x) * derivative f x`. split. rewrite -(o_THM `exp`); rewr ETA_AX; apply: REAL_DIFFERENTIABLE_COMPOSE_ATREAL. by rewrite REAL_DIFFERENTIABLE_AT_EXP df. rewrite derivative_composition ?df ?REAL_DIFFERENTIABLE_AT_EXP //. by rewrite derivative_exp REAL_MUL_SYM. Qed. Lemma derivative_compose_inv : `~(f x = &0) ==> (\x. inv (f x)) real_differentiable atreal x /\ derivative (\x. inv (f x)) x = -- inv (f x * f x) * derivative f x`. move => fn0; split; first by apply: REAL_DIFFERENTIABLE_INV_ATREAL. by rewrite derivative_composition ?derivative_inv ?REAL_MUL_SYM // df REAL_DIFFERENTIABLE_AT_INV. Qed. Lemma derivative_compose_sqrt : `&0 < f x ==> (\x. sqrt (f x)) real_differentiable atreal x /\ derivative (\x. sqrt (f x)) x = derivative f x / (&2 * sqrt (f x))`. move => f_pos; split. rewrite -(o_THM `sqrt`); rewr ETA_AX; apply: REAL_DIFFERENTIABLE_COMPOSE_ATREAL. by rewrite df andTb; apply: REAL_DIFFERENTIABLE_AT_SQRT. rewrite derivative_composition ?df ?REAL_DIFFERENTIABLE_AT_SQRT //. by rewrite derivative_sqrt // real_div. Qed. Lemma derivative_compose_acs : `abs (f x) < &1 ==> (\x. acs (f x)) real_differentiable atreal x /\ derivative (\x. acs (f x)) x = -- (derivative f x / sqrt (&1 - f x * f x))`. move => f_abs; split. rewrite -(o_THM `acs`); rewr ETA_AX; apply: REAL_DIFFERENTIABLE_COMPOSE_ATREAL. by rewrite df andTb REAL_DIFFERENTIABLE_AT_ACS. rewrite derivative_composition ?df ?REAL_DIFFERENTIABLE_AT_ACS //. by rewrite derivative_acs // REAL_MUL_RNEG real_div. Qed. End ElementaryCompose. End ElementaryDerivatives. Variables f g : `:real -> real`. Variables x c : `:real`. (* One function *) Hypothesis df : `f real_differentiable atreal x`. Lemma derivative_scale : `derivative (\x. c * f x) x = c * derivative f x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_LMUL_ATREAL has_derivative_alt. Qed. Lemma derivative_neg : `derivative (\x. -- f x) x = -- derivative f x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_NEG has_derivative_alt. Qed. Lemma derivative_pow n : `derivative (\x. f x pow n) x = &n * f x pow (n - 1) * derivative f x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_POW_ATREAL has_derivative_alt. Qed. (* The second function *) Hypothesis dg : `g real_differentiable atreal x`. Lemma derivative_add : `derivative (\x. f x + g x) x = derivative f x + derivative g x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_ADD !has_derivative_alt. Qed. Lemma derivative_mul : `derivative (\x. f x * g x) x = f x * derivative g x + derivative f x * g x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_MUL_ATREAL !has_derivative_alt. Qed. Lemma derivative_sub : `derivative (\x. f x - g x) x = derivative f x - derivative g x`. by apply: derivative_unique; rewrite HAS_REAL_DERIVATIVE_SUB !has_derivative_alt. Qed. Lemma derivative_div : `~(g x = &0) ==> derivative (\x. f x / g x) x = (derivative f x * g x - f x * derivative g x) / (g x * g x)`. move => gn0; apply: derivative_unique; rewrite -REAL_POW_2 HAS_REAL_DERIVATIVE_DIV_ATREAL //. by rewrite !has_derivative_alt. Qed. End DerivativeArith. Section MoreDerivativeArith. Lemma differentiable_sum_numseg G n m x : `(!i. i IN n..m ==> G i real_differentiable atreal x) ==> (\x. sum (n..m) (\i. G i x)) real_differentiable atreal x`. elim: m => [|m IHm] dG; rewrite !"GEN_ALL SUM_CLAUSES_NUMSEG". case: (EXCLUDED_MIDDLE `n = 0`) => /= n_eq_0; rewr ETA_AX REAL_DIFFERENTIABLE_CONST //. by rewrite dG IN_NUMSEG n_eq_0 leqnn. case: (EXCLUDED_MIDDLE `n <= SUC m`) => /= n_le_Sm; last first. apply: IHm => i i_in; apply: dG. by move: i_in; rewrite !IN_NUMSEG; arith. rewrite REAL_DIFFERENTIABLE_ADD; rewr ETA_AX; rewrite dG ?IHm // IN_NUMSEG ?n_le_Sm ?leqnn //. move => i ineq; apply: dG; rewrite IN_NUMSEG. by move: ineq; arith. Qed. (* Sum *) Lemma derivative_sum_numseg G n m x : `(!i. i IN n..m ==> G i real_differentiable atreal x) ==> derivative (\x. sum (n..m) (\i. G i x)) x = sum (n..m) (\i. derivative (G i) x)`. elim: m => [|m IHm] dG; rewrite !"GEN_ALL SUM_CLAUSES_NUMSEG". by case: `n = 0` => /=; rewr ETA_AX // derivative_const. case: (EXCLUDED_MIDDLE `n <= SUC m`) => /= n_le_Sm; last first. apply: IHm => i i_in; apply: dG. by move: i_in; rewrite !IN_NUMSEG; arith. rewrite -IHm. move => i i_in; apply: dG. move: i_in; rewrite !IN_NUMSEG; arith. rewrite derivative_add; rewr ETA_AX //. rewrite dG ?IN_NUMSEG ?leqnn // andbT differentiable_sum_numseg => i i_in. by apply: dG; move: i_in; rewrite !IN_NUMSEG; arith. Qed. End MoreDerivativeArith. Lemma HAS_REAL_DERIVATIVE_LOCAL f g x g': `(g has_real_derivative g') (atreal x) /\ (?s. real_open s /\ x IN s /\ (!y. y IN s ==> f y = g y)) ==> (f has_real_derivative g') (atreal x)`. Proof. move => [dg] [s] [open_s] [xs] f_eq_g. move: dg; rewrite -!(HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN open_s) // => dg. apply: (HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN dg). by exists `&1`; rewrite REAL_LT_01 xs !andTb => y [] /f_eq_g ->. Qed. Lemma differentiable_local f g x s : `g real_differentiable atreal x /\ real_open s /\ x IN s /\ (!y. y IN s ==> f y = g y) ==> f real_differentiable atreal x`. rewrite !real_differentiable => [] [] [f'] dg [open_s] [xs] eq. exists f'; apply: HAS_REAL_DERIVATIVE_LOCAL. by exists g; rewrite dg andTb; exists s. Qed. Section NthDerivativeArith. Variables f g : `:real->real`. Variable int : `:real#real`. Variable n : `:num`. (* Unary operation *) Hypothesis df : `nth_diff_strong_int n int f`. Lemma nth_derivative_scale_strong c i x : `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y`. move: df; rewrite nth_diff_strong_int nth_diff_strong => df. move/df => [s] [open_s] [xs]; rewrite nth_differentiable_on nth_differentiable_eq => diff. elim: i => [_|i IHi]; first by rewrite !nth_derivative0; exists s. rewrite nth_derivativeS -ltE => i_lt_n. move: (IHi (ltnW i_lt_n)) => [t] [open_t] [xt] eq; move: IHi => _. exists `s INTER t`; rewrite REAL_OPEN_INTER // !IN_INTER xt xs !andTb => y [ys yt]. apply: derivative_unique. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `\y. c * nth_derivative i f y`. rewrite HAS_REAL_DERIVATIVE_LMUL_ATREAL ?andTb. by rewr ETA_AX; rewrite (diff ys). exists `s INTER t`; rewrite REAL_OPEN_INTER // !IN_INTER {1}yt {1}ys !andTb => z z_in /=. by rewrite eq. Qed. Lemma nth_derivative_scale_strong_all c x : `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y`. move => /(nth_derivative_scale_strong c) h. set P := `\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. c * f y) y = c * nth_derivative i f y)`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. move: (h i_le_n) => [s] cond. by exists s; rewrite -P_def /=. set S := `INTERS (IMAGE (\i. (@) (P i)) (0..n))`. exists S. rewrite -S_def REAL_OPEN_INTERS ?FINITE_IMAGE ?FINITE_NUMSEG ?IN_IMAGE ?andTb. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. rewrite !IN_INTERS !IN_IMAGE; split. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. move => i y [i_le_n]. move: (sel_P i_le_n); rewrite -{1}P_def /= => [] [_] [_] y_in /(_ `(@) (P i)`). "ANTS_TAC"; first by exists i; rewrite IN_NUMSEG_0. exact: y_in. Qed. Lemma nth_derivative_scale c i x : `interval_arith x int ==> i <= n ==> nth_derivative i (\x. c * f x) x = c * nth_derivative i f x`. move => ineq i_le_n. have := nth_derivative_scale_strong c ineq i_le_n. move => [s] [_] [xs] h. exact: h. Qed. Lemma nth_diff_scale c : `nth_diff_strong_int n int (\x. c * f x)`. move: (df); rewrite !nth_diff_strong_int !nth_diff_strong !nth_differentiable_on !nth_differentiable_eq. move => df x ineq. have := nth_derivative_scale_strong_all c ineq. move => [s] [open_s] [xs] diff. move: (df ineq) => [t] [open_t] [xt] diff2. exists `s INTER t`; rewrite REAL_OPEN_INTER // IN_INTER {1}xs {1}xt !andTb => y [ys yt]. rewrite REAL_CONTINUOUS_LMUL ?diff2 // andTb => i i_lt_n. rewrite diff ?ys -?ltE //. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `(\y. c * nth_derivative i f y)`. rewrite HAS_REAL_DERIVATIVE_LMUL_ATREAL ?andTb; first by rewr ETA_AX; rewrite (diff2 yt). exists s; rewrite open_s {1}ys !andTb => z zs /=. by apply: diff; rewrite ltnW. Qed. (* Binary operations *) Hypothesis dg : `nth_diff_strong_int n int g`. (* Addition *) Lemma nth_derivative_add_strong i x : `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y`. move: df dg; rewrite !nth_diff_strong_int !nth_diff_strong => df dg ineq. move: (df ineq) => [sf] [open_sf] [xsf]; move: df => _. move: (dg ineq) => [sg] [open_sg] [xsg]; move: dg => _. rewrite !nth_differentiable_on !nth_differentiable_eq => diff_g diff_f. elim: i => [_|i IHi]; first by rewrite !nth_derivative0; exists sf. rewrite nth_derivativeS -ltE => i_lt_n. move: (IHi (ltnW i_lt_n)) => [t] [open_t] [xt] eq; move: IHi => _. exists `sf INTER sg INTER t`. rewrite !REAL_OPEN_INTER // !IN_INTER xt xsf xsg !andTb => y [ysf] [ysg yt]. apply: derivative_unique. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `(\y. nth_derivative i f y + nth_derivative i g y)`. rewrite HAS_REAL_DERIVATIVE_ADD ?andTb. by rewr ETA_AX; rewrite (diff_f ysf) // (diff_g ysg). exists `sf INTER sg INTER t`; rewrite !REAL_OPEN_INTER // !IN_INTER {1}yt {1}ysf {1}ysg !andTb. by move => z z_in /=; rewrite eq. Qed. Lemma nth_derivative_add_strong_all x : `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y`. move => /(nth_derivative_add_strong) h. set P := `\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y + g y) y = nth_derivative i f y + nth_derivative i g y)`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. move: (h i_le_n) => [s] cond. by exists s; rewrite -P_def /=. set S := `INTERS (IMAGE (\i. (@) (P i)) (0..n))`. exists S. rewrite -S_def REAL_OPEN_INTERS ?FINITE_IMAGE ?FINITE_NUMSEG ?IN_IMAGE ?andTb. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. rewrite !IN_INTERS !IN_IMAGE; split. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. move => i y [i_le_n]. move: (sel_P i_le_n); rewrite -{1}P_def /= => [] [_] [_] y_in /(_ `(@) (P i)`). "ANTS_TAC"; first by exists i; rewrite IN_NUMSEG_0. exact: y_in. Qed. Lemma nth_derivative_add i x : `interval_arith x int ==> i <= n ==> nth_derivative i (\x. f x + g x) x = nth_derivative i f x + nth_derivative i g x`. move => ineq i_le_n. have := nth_derivative_add_strong ineq i_le_n. move => [s] [_] [xs] h. exact: h. Qed. Lemma nth_diff_add : `nth_diff_strong_int n int (\x. f x + g x)`. move: (df) (dg). rewrite !nth_diff_strong_int !nth_diff_strong !nth_differentiable_on !nth_differentiable_eq. move => df dg x ineq. have := nth_derivative_add_strong_all ineq. move => [s] [open_s] [xs] diff. move: (df ineq) => [tf] [open_tf] [xtf] diff_f. move: (dg ineq) => [tg] [open_tg] [xtg] diff_g. exists `s INTER tf INTER tg`; rewrite !REAL_OPEN_INTER // !IN_INTER {1}xs {1}xtf {1}xtg !andTb. move => y [ys [ytf ytg]]. rewrite REAL_CONTINUOUS_ADD ?diff_f ?diff_g // andTb => i i_lt_n. rewrite diff ?ys -?ltE //. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `(\y. nth_derivative i f y + nth_derivative i g y)`. rewrite HAS_REAL_DERIVATIVE_ADD ?andTb; first by rewr ETA_AX; rewrite (diff_f ytf) // (diff_g ytg). exists s; rewrite open_s {1}ys !andTb => z zs /=. by apply: diff; rewrite ltnW. Qed. (* Subtraction *) Lemma nth_derivative_sub_strong i x : `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y`. move: df dg; rewrite !nth_diff_strong_int !nth_diff_strong => df dg ineq. move: (df ineq) => [sf] [open_sf] [xsf]; move: df => _. move: (dg ineq) => [sg] [open_sg] [xsg]; move: dg => _. rewrite !nth_differentiable_on !nth_differentiable_eq => diff_g diff_f. elim: i => [_|i IHi]; first by rewrite !nth_derivative0; exists sf. rewrite nth_derivativeS -ltE => i_lt_n. move: (IHi (ltnW i_lt_n)) => [t] [open_t] [xt] eq; move: IHi => _. exists `sf INTER sg INTER t`. rewrite !REAL_OPEN_INTER // !IN_INTER xt xsf xsg !andTb => y [ysf] [ysg yt]. apply: derivative_unique. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `(\y. nth_derivative i f y - nth_derivative i g y)`. rewrite HAS_REAL_DERIVATIVE_SUB ?andTb. by rewr ETA_AX; rewrite (diff_f ysf) // (diff_g ysg). exists `sf INTER sg INTER t`; rewrite !REAL_OPEN_INTER // !IN_INTER {1}yt {1}ysf {1}ysg !andTb. by move => z z_in /=; rewrite eq. Qed. Lemma nth_derivative_sub_strong_all x : `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y`. move => /(nth_derivative_sub_strong) h. set P := `\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y - g y) y = nth_derivative i f y - nth_derivative i g y)`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. move: (h i_le_n) => [s] cond. by exists s; rewrite -P_def /=. set S := `INTERS (IMAGE (\i. (@) (P i)) (0..n))`. exists S. rewrite -S_def REAL_OPEN_INTERS ?FINITE_IMAGE ?FINITE_NUMSEG ?IN_IMAGE ?andTb. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. rewrite !IN_INTERS !IN_IMAGE; split. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. move => i y [i_le_n]. move: (sel_P i_le_n); rewrite -{1}P_def /= => [] [_] [_] y_in /(_ `(@) (P i)`). "ANTS_TAC"; first by exists i; rewrite IN_NUMSEG_0. exact: y_in. Qed. Lemma nth_derivative_sub i x : `interval_arith x int ==> i <= n ==> nth_derivative i (\x. f x - g x) x = nth_derivative i f x - nth_derivative i g x`. move => ineq i_le_n. have := nth_derivative_sub_strong ineq i_le_n. move => [s] [_] [xs] h. exact: h. Qed. Lemma nth_diff_sub : `nth_diff_strong_int n int (\x. f x - g x)`. move: (df) (dg). rewrite !nth_diff_strong_int !nth_diff_strong !nth_differentiable_on !nth_differentiable_eq. move => df dg x ineq. have := nth_derivative_sub_strong_all ineq. move => [s] [open_s] [xs] diff. move: (df ineq) => [tf] [open_tf] [xtf] diff_f. move: (dg ineq) => [tg] [open_tg] [xtg] diff_g. exists `s INTER tf INTER tg`; rewrite !REAL_OPEN_INTER // !IN_INTER {1}xs {1}xtf {1}xtg !andTb. move => y [ys [ytf ytg]]. rewrite REAL_CONTINUOUS_SUB ?diff_f ?diff_g // andTb => i i_lt_n. rewrite diff ?ys -?ltE //. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `(\y. nth_derivative i f y - nth_derivative i g y)`. rewrite HAS_REAL_DERIVATIVE_SUB ?andTb; first by rewr ETA_AX; rewrite (diff_f ytf) // (diff_g ytg). exists s; rewrite open_s {1}ys !andTb => z zs /=. by apply: diff; rewrite ltnW. Qed. (* Multiplication *) Lemma nth_derivative_mul_strong i x : `interval_arith x int ==> i <= n ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)`. move: df dg; rewrite !nth_diff_strong_int !nth_diff_strong => df dg ineq. move: (df ineq) => [sf] [open_sf] [xsf]; move: df => _. move: (dg ineq) => [sg] [open_sg] [xsg]; move: dg => _. rewrite !nth_differentiable_on !nth_differentiable_eq => diff_g diff_f. elim: i => [_|i IHi]. exists sf; rewrite open_sf xsf !andTb !nth_derivative0 SUM_SING_NUMSEG => y _ /=. by rewrite subn0 !nth_derivative0 binom REAL_MUL_LID. rewrite nth_derivativeS -ltE => i_lt_n. move: (IHi (ltnW i_lt_n)) => [t] [open_t] [xt] eq; move: IHi => _. exists `sf INTER sg INTER t`. rewrite !REAL_OPEN_INTER // !IN_INTER xt xsf xsg !andTb => y [ysf] [ysg yt]. apply: derivative_unique. apply: HAS_REAL_DERIVATIVE_LOCAL. exists `\y. sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)`. split; last first. exists `sf INTER sg INTER t`; rewrite !REAL_OPEN_INTER // !IN_INTER {1}yt {1}ysf {1}ysg !andTb. by move => z z_in /=; rewrite eq. apply: has_derivative_lemma. have diff_cond : `!k. k IN 0..i ==> nth_derivative k f real_differentiable atreal y /\ nth_derivative (i - k) g real_differentiable atreal y`. rewrite IN_NUMSEG => k ineq /=; rewrite !real_differentiable; split. exists `nth_derivative (SUC k) f y`; rewrite (diff_f ysf). by move: ineq i_lt_n; arith. exists `nth_derivative (SUC (i - k)) g y`; rewrite (diff_g ysg). by move: ineq i_lt_n; arith. have diff_cond2 : `!k. k IN 0..i ==> (\y. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y) real_differentiable atreal y`. move => k k_in /=. by rewrite !REAL_DIFFERENTIABLE_MUL_ATREAL ?REAL_DIFFERENTIABLE_CONST; rewr ETA_AX; rewrite !diff_cond //. rewrite differentiable_sum_numseg ?derivative_sum_numseg; rewr /= diff_cond2 //. set lhs := `sum (0..i) _`. set sum1 := `sum (0 + 1..i + 1) (\k. &(binom (i, k - 1)) * nth_derivative k f y * nth_derivative (SUC i - k) g y)`. set sum2 := `sum (0..i + 1) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (SUC i - k) g y)`. have ->: `lhs = sum1 + sum2`. rewrite -sum1_def SUM_OFFSET /= addn1 succnK subSS. rewrite -sum2_def addn1 "GEN_ALL SUM_CLAUSES_NUMSEG" "ARITH_RULE `0 <= SUC i`" /=. have ->: `binom(i, SUC i) = 0`; first by rewrite BINOM_EQ_0; arith. rewrite REAL_MUL_LZERO REAL_ADD_RID -SUM_ADD_NUMSEG /= -lhs_def. apply SUM_EQ => k k_in /=. rewrite derivative_scale ?REAL_DIFFERENTIABLE_MUL_ATREAL; rewr ETA_AX; rewrite ?diff_cond //. rewrite -REAL_ADD_LDISTRIB REAL_EQ_MUL_LCANCEL; right. rewrite derivative_mul; rewr ETA_AX; rewrite ?diff_cond //. rewrite REAL_ADD_SYM -!nth_derivativeS. suff ->: `SUC (i - k) = SUC i - k`; first by done. by move: k_in; rewrite IN_NUMSEG; arith. rewrite REAL_ADD_SYM SUM_CLAUSES_LEFT -?sum2_def 1?SUM_CLAUSES_LEFT /=; try arith. rewrite !binom !REAL_MUL_LID -REAL_ADD_ASSOC REAL_EQ_ADD_LCANCEL. rewrite -sum1_def -SUM_ADD_NUMSEG (addn1 i). apply SUM_EQ => k k_in /=. rewrite -REAL_ADD_RDISTRIB REAL_EQ_MUL_RCANCEL; left. case: k k_in => [|k]; rewrite IN_NUMSEG; first by arith. by rewrite binom ONE subSS subn0 REAL_OF_NUM_ADD. Qed. Lemma nth_derivative_mul_strong_all x : `interval_arith x int ==> ?s. real_open s /\ x IN s /\ !i y. i <= n /\ y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)`. move => /(nth_derivative_mul_strong) h. set P := `\i s. real_open s /\ x IN s /\ (!y. y IN s ==> nth_derivative i (\y. f y * g y) y = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f y * nth_derivative (i - k) g y))`. have sel_P : `!i. i <= n:num ==> P i ((@) (P i))`. move => i i_le_n; apply SELECT_AX. move: (h i_le_n) => [s] cond. by exists s; rewrite -P_def /=. set S := `INTERS (IMAGE (\i. (@) (P i)) (0..n))`. exists S. rewrite -S_def REAL_OPEN_INTERS ?FINITE_IMAGE ?FINITE_NUMSEG ?IN_IMAGE ?andTb. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. rewrite !IN_INTERS !IN_IMAGE; split. move => t [i] [->]; rewrite IN_NUMSEG_0 => /sel_P. by rewrite -{1}P_def /=. move => i y [i_le_n]. move: (sel_P i_le_n); rewrite -{1}P_def /= => [] [_] [_] y_in /(_ `(@) (P i)`). "ANTS_TAC"; first by exists i; rewrite IN_NUMSEG_0. exact: y_in. Qed. Lemma nth_derivative_mul i x : `interval_arith x int ==> i <= n ==> nth_derivative i (\x. f x * g x) x = sum (0..i) (\k. &(binom (i, k)) * nth_derivative k f x * nth_derivative (i - k) g x)`. move => ineq i_le_n. have := nth_derivative_mul_strong ineq i_le_n. move => [s] [_] [xs] h. exact: h. Qed. Lemma nth_diff_mul : `nth_diff_strong_int n int (\x. f x * g x)`. move: (df) (dg). rewrite !nth_diff_strong_int !nth_diff_strong !nth_differentiable_on !nth_differentiable_eq. move => df dg x ineq. have := nth_derivative_mul_strong_all ineq. move => [s] [open_s] [xs] diff. move: (df ineq) => [tf] [open_tf] [xtf] diff_f. move: (dg ineq) => [tg] [open_tg] [xtg] diff_g. exists `s INTER tf INTER tg`; rewrite !REAL_OPEN_INTER // !IN_INTER {1}xs {1}xtf {1}xtg !andTb. move => y [ys [ytf ytg]]. rewrite REAL_CONTINUOUS_MUL ?diff_f ?diff_g // andTb => i i_lt_n. rewrite nth_derivativeS has_derivative_alt. apply: differentiable_local. exists `\y. sum (0..i) (\k. &(binom(i, k)) * nth_derivative k f y * nth_derivative (i - k) g y)` s. rewrite open_s {1}ys !andTb; split; last by move => z zs; rewrite diff // ltnW. rewrite differentiable_sum_numseg IN_NUMSEG => k k_in /=. rewrite !REAL_DIFFERENTIABLE_MUL_ATREAL ?REAL_DIFFERENTIABLE_CONST //; rewr ETA_AX. rewrite !real_differentiable; split. exists `nth_derivative (SUC k) f y`; rewrite (diff_f ytf). by move: k_in i_lt_n; arith. exists `nth_derivative (SUC (i - k)) g y`; rewrite (diff_g ytg). by move: k_in i_lt_n; arith. Qed. End NthDerivativeArith. End NthDerivatives. (* Linear approximation and Taylor interval *) "let lin_approx = new_definition `lin_approx f x f_bounds df_bounds <=> interval_arith (f x) f_bounds /\ (?f'. (f has_real_derivative f') (atreal x) /\ interval_arith f' df_bounds)`". "let has_bounded_second_derivative = new_definition `has_bounded_second_derivative f int dd_bounds <=> nth_diff_strong_int 2 int f /\ bounded_on_int (nth_derivative 2 f) int dd_bounds`". "let taylor_interval = new_definition `taylor_interval f x y z w f_bounds df_bounds ddf_bounds <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w /\ lin_approx f y f_bounds df_bounds /\ has_bounded_second_derivative f (x, z) ddf_bounds`". Lemma nth_diff_strong_imp_diff_int n int f: `nth_diff_strong_int n int f ==> nth_differentiable_on_int n int f`. rewrite nth_diff_strong_int nth_differentiable_on_int nth_diff_strong nth_differentiable_on. move => h x ineq. by move: (h ineq) => [s] [_] [xs]; exact. Qed. Lemma has_bounded_second_derivative_old f int dd_bounds : `has_bounded_second_derivative f int dd_bounds ==> ?f' f''. (!x. interval_arith x int ==> (f has_real_derivative f' x) (atreal x) /\ (f' has_real_derivative f'' x) (atreal x) /\ interval_arith (f'' x) dd_bounds)`. rewrite has_bounded_second_derivative => [] [/nth_diff_strong_imp_diff_int]. move/nth_differentiable_on_int2 => [f'] [f'']. move => [eq1] [eq2] h b; exists f' f'' => x ineq. move: b; rewrite bounded_on_int -eq2 => b. by rewrite !h // b. Qed. Lemma exists_and_left P Q : `(?x. P x /\ Q x) ==> (?x. P x)`. move => [x] [Px _]. by exists x. Qed. Lemma lim_ineq a b : `(!e. &0 < e ==> a <= b + e) <=> (a <= b)`. split => [| ineq e e0]; last first. by rewrite -(REAL_ADD_RID a) REAL_LE_ADD2 ineq REAL_LT_IMP_LE. apply: contraLR; rewrite NOT_FORALL_THM NOT_IMP !REAL_NOT_LE => ba. by exists `(a - b) / &2`; move: ba; arith. Qed. Lemma continuous_leq f c a: `(?b. a < b /\ !x. x IN real_interval (a, b) ==> f x <= c) /\ f real_continuous atreal a ==> f a <= c`. move => [[b] [ab] ineq]. rewrite REAL_CONTINUOUS_ATREAL REALLIM_ATREAL => f_cont. rewrite -lim_ineq => e /f_cont [d] [d0] cond. set r := `a + min (b - a) d / &2`. move: (cond r); "ANTS_TAC"; first by move: r_def d0 ab; arith. move: (ineq r); "ANTS_TAC"; last by arith. by rewrite IN_REAL_INTERVAL; move: r_def d0 ab; arith. Qed. Lemma continuous_reflection f x : `f real_continuous atreal x <=> (\x. f (--x)) real_continuous atreal (--x)`. rewrite !REAL_CONTINUOUS_ATREAL /= !REALLIM_ATREAL REAL_NEG_NEG /=; split => h e e0. move: (h e0) => [d] [d0] cond. exists d; rewrite d0 andTb => y ineqs; apply: cond. by move: ineqs; arith. move: (h e0) => [d] [d0] cond. exists d; rewrite d0 andTb => y ineqs. by move: (cond `--y`); rewrite REAL_NEG_NEG; apply; move: ineqs; arith. Qed. Lemma continuous_leq_segment f c a b : `a < b ==> f real_continuous atreal a ==> f real_continuous atreal b ==> (!x. x IN real_interval (a, b) ==> f x <= c) ==> (!x. x IN real_interval [a, b] ==> f x <= c)`. move => ab f_cont_a f_cont_b ineq x. rewrite IN_REAL_INTERVAL 2!"REAL_ARITH `!a b. a <= b <=> (a = b \/ a < b)`". case; case => [<- _| ax]. by apply: continuous_leq; rewrite f_cont_a andbT; exists b. case => [-> | xb]; last by apply: ineq; rewrite IN_REAL_INTERVAL. set g := `\x. f (--x)`. have fg: `!x. f x = g (--x)`; first by rewrite -g_def /= REAL_NEG_NEG. rewrite fg; apply: continuous_leq; split. exists `--a`; rewrite REAL_LT_NEG ab andTb IN_REAL_INTERVAL => y. by move: (ineq `--y`); rewrite IN_REAL_INTERVAL fg REAL_NEG_NEG; arith. by rewrite -g_def -continuous_reflection. Qed. Lemma pair_eq p : `p = (FST p, SND p)`. done. Qed. (* Properties of taylor_interval *) Section Taylor. Lemma iabs_alt lo hi a : `interval_arith a (lo, hi) ==> iabs (lo, hi) = max (abs lo) (abs hi)`. by rewrite interval_arith iabs; arith. Qed. Lemma iabs_pos lo hi a : `interval_arith a (lo, hi) ==> &0 <= iabs (lo, hi)`. by rewrite interval_arith iabs; arith. Qed. Variable f : `:real -> real`. Variables x y z w : `:real`. Variables f_bounds df_bounds ddf_bounds : `:real#real`. Variable dd_bound : `:real`. Hypothesis dd_bound_eq : `dd_bound = iabs ddf_bounds`. Hypothesis tif : `taylor_interval f x y z w f_bounds df_bounds ddf_bounds`. Lemma f_continuous : `!t. t IN real_interval [x, z] ==> f real_continuous atreal t`. rewrite IN_REAL_INTERVAL -interval_arith => t t_in. apply: HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL. move: tif; rewrite taylor_interval !andbA => [] [_] /has_bounded_second_derivative_old. move => [f'] [f''] df. by exists `f' t`; rewrite df. Qed. Lemma taylor_error t : `x <= t /\ t <= z ==> abs (f t - f y) <= w * iabs df_bounds + w * w * dd_bound / &2`. move => t_ineqs. have := tif; rewrite taylor_interval !andbA => [] [] [domain_ineqs] lin_app. move/has_bounded_second_derivative_old => [f'] [f''] df. have abs_ty : `abs (t - y) <= w`. by move: domain_ineqs t_ineqs; arith. have y_in : `interval_arith y (x, z)`; first by rewrite interval_arith. have dd_prop : `&0 <= dd_bound /\ !p. p IN real_interval [x, z] ==> abs (f'' p) <= dd_bound`. rewrite dd_bound_eq; split. by move: (df y_in); rewrite pair_eq interval_arith iabs; arith. by rewrite IN_REAL_INTERVAL -interval_arith; move => p /df; rewrite pair_eq interval_arith iabs; arith. suff: `abs (f t - (f y + f' y * (t - y) pow 1)) <= dd_bound * abs (t - y) pow (1 + 1) / &2`. set b1 := `f' y * _`; set b2 := `dd_bound * _` => ineq1. apply: REAL_LE_TRANS; exists `abs (f t - (f y + b1)) + abs b1`; split. by rewrite "REAL_ARITH `!a b. a - b = (a - (b + b1)) + b1`" REAL_ABS_TRIANGLE. rewrite REAL_ADD_SYM REAL_LE_ADD2 -{1}b1_def REAL_POW_1 REAL_ABS_MUL REAL_MUL_SYM REAL_LE_MUL2. rewrite !REAL_ABS_POS abs_ty !andTb pair_eq iabs. move: lin_app; rewrite lin_approx => [] [_] [ff] [df']. suff ->: `ff = f' y`; first by rewrite pair_eq interval_arith; arith. by apply: (REAL_DERIVATIVE_UNIQUE_ATREAL f y); rewrite df' df // IN_REAL_INTERVAL. rewrite andTb; apply: REAL_LE_TRANS; exists b2. rewrite ineq1 andTb -b2_def !real_div !REAL_MUL_ASSOC REAL_LE_MUL2 "ARITH_RULE `1 + 1 = 2`". rewrite REAL_LE_REFL REAL_LE_INV ?REAL_LE_MUL ?dd_prop ?REAL_LE_POW_2; try arith. rewrite andTb !andbT REAL_MUL_SYM -REAL_POW_2 REAL_LE_MUL2 REAL_LE_REFL dd_prop. by rewrite REAL_LE_POW_2 andTb !andbT -REAL_LE_SQUARE_ABS REAL_ABS_ABS; move: abs_ty; arith. set Df := `\i. if i = 0 then f else if i = 1 then f' else if i = 2 then f'' else I`. have arith := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`". have := REAL_TAYLOR Df `1` `real_interval [x, z]` dd_bound. "ANTS_TAC". rewrite IS_REALINTERVAL_INTERVAL andTb; split. rewrite IN_REAL_INTERVAL -interval_arith. move => i p [p_in]; rewrite "ARITH_RULE `i <= 1 <=> i = 0 \/ i = 1`". by case => ->; rewrite -Df_def /=; apply HAS_REAL_DERIVATIVE_ATREAL_WITHIN; rewrite !arith /= df. move => p p_in; rewrite -Df_def /=. by rewrite !arith /= dd_prop. move => /(_ y t); rewrite !IN_REAL_INTERVAL !domain_ineqs !t_ineqs /=. rewrite {1}ONE "GEN_ALL SUM_CLAUSES_NUMSEG" SUM_SING_NUMSEG /= -Df_def /= -ONE. rewrite !"ARITH_RULE `0 <= 1 /\ ~(1 = 0)`" /= "GEN_ALL real_pow" FACT. by rewrite !"ARITH_RULE `FACT 1 = 1 /\ FACT (1 + 1) = 2`" !REAL_DIV_1 REAL_MUL_RID. Qed. Lemma taylor_upper_bound : `!t. x <= t /\ t <= z ==> f t <= SND f_bounds + (w * iabs df_bounds + w * w * dd_bound / &2)`. move: (pair_eq f_bounds) => eq. move => t /taylor_error. move: tif; rewrite taylor_interval !andbA lin_approx => [] [] [_] [f_int] _ _. by move: f_int; rewrite {1}eq interval_arith; arith. Qed. Lemma taylor_lower_bound : `!t. x <= t /\ t <= z ==> FST f_bounds - (w * iabs df_bounds + w * w * dd_bound / &2) <= f t`. have eq := pair_eq f_bounds. move => t /taylor_error. move: tif; rewrite {1}eq taylor_interval !andbA lin_approx => [] [] [_] [f_int] _ _. move: f_int; rewrite interval_arith; arith. Qed. Lemma taylor_derivative_error : `!t. x <= t /\ t <= z ==> abs (derivative f t - derivative f y) <= w * dd_bound`. move => t t_ineqs. have := tif; rewrite taylor_interval !andbA => [] [] [domain_ineqs] _. move/has_bounded_second_derivative_old => [f'] [f''] df. have abs_ty : `abs (t - y) <= w`. by move: domain_ineqs t_ineqs; arith. have der_eq: `!p. x <= p /\ p <= z ==> derivative f p = f' p`. rewrite -IN_REAL_INTERVAL EQ_SYM_EQ; apply: derivative_unique_on. by rewrite IN_REAL_INTERVAL -interval_arith => p /df /=. rewrite !der_eq //. have dd_prop : `&0 <= dd_bound /\ !p. p IN real_interval [x, z] ==> abs (f'' p) <= dd_bound`. rewrite dd_bound_eq IN_REAL_INTERVAL -interval_arith; split. by move: (df y); rewrite (pair_eq ddf_bounds) !interval_arith iabs !domain_ineqs; arith. by move => p /df; rewrite pair_eq interval_arith iabs; arith. set Df := `\i. if i = 0 then f' else if i = 1 then f'' else I`. have arith := "ARITH_RULE `0 + 1 = 1 /\ ~(1 = 0) /\ 1 + 1 = 2 /\ ~(2 = 1) /\ ~(2 = 1) /\ ~(2 = 0)`". have := REAL_TAYLOR Df `0` `real_interval [x, z]` dd_bound. "ANTS_TAC". rewrite IS_REALINTERVAL_INTERVAL andTb; split. move => i p [p_in]; rewrite "ARITH_RULE `i <= 0 <=> i = 0`" => ->. rewrite -Df_def /= !arith /=; apply: HAS_REAL_DERIVATIVE_ATREAL_WITHIN. by rewrite df interval_arith -IN_REAL_INTERVAL. move => p p_in; rewrite -Df_def /=. by rewrite !arith /= dd_prop. move => /(_ y t); rewrite !IN_REAL_INTERVAL !domain_ineqs !t_ineqs /=. rewrite {1}ONE SUM_SING_NUMSEG /= -Df_def /= -ONE. rewrite "GEN_ALL real_pow" !arith !FACT "ARITH_RULE `FACT 1 = 1`" !REAL_DIV_1 REAL_MUL_RID. rewrite REAL_POW_1 => ineq. apply: REAL_LE_TRANS; exists `dd_bound * abs (t - y)`. by rewrite ineq andTb REAL_MUL_SYM REAL_LE_RMUL dd_prop abs_ty. Qed. Lemma derivative_interval : `FST df_bounds <= derivative f y /\ derivative f y <= SND df_bounds`. have eq := pair_eq df_bounds. move: tif; rewrite taylor_interval lin_approx !andbA => [] [] [ineqs] [g] [fg g_int] _. suff ->: `derivative f y = g`; first by move: g_int; rewrite eq interval_arith. apply: (REAL_DERIVATIVE_UNIQUE_ATREAL f y). by rewrite fg has_derivative_cond //; exists g. Qed. Lemma taylor_derivative_upper_bound : `!t. x <= t /\ t <= z ==> derivative f t <= SND df_bounds + w * dd_bound`. by move => t /taylor_derivative_error; move: derivative_interval; arith. Qed. Lemma taylor_derivative_lower_bound : `!t. x <= t /\ t <= z ==> FST df_bounds - w * dd_bound <= derivative f t`. by move => t /taylor_derivative_error; move: derivative_interval; arith. Qed. End Taylor. Section LinearApproximation. Variable f : `:real->real`. Variables f_bounds df_bounds : `:real#real`. Variable x : `:real`. Lemma lin_approx_eq : `lin_approx f x f_bounds df_bounds <=> (f real_differentiable atreal x /\ interval_arith (f x) f_bounds /\ interval_arith (derivative f x) df_bounds)`. rewrite lin_approx real_differentiable; split => [[-> [f'] [df' int_f']] | [[f'] df] [-> df_int]]. split; first by exists f'. by rewrite (derivative_unique f f'). by rewrite andTb; exists f'; rewrite df -(derivative_unique f f' x). Qed. Hypothesis approx_f : `lin_approx f x f_bounds df_bounds`. Lemma lin_approx_imp_f_interval : `interval_arith (f x) f_bounds`. by move: approx_f; rewrite lin_approx_eq /=. Qed. Lemma lin_approx_imp_df_interval : `interval_arith (derivative f x) df_bounds`. by move: approx_f; rewrite lin_approx_eq /=. Qed. Lemma lin_approx_imp_f_diff : `f real_differentiable atreal x`. by move: approx_f; rewrite lin_approx_eq /=. Qed. End LinearApproximation. Section MoreLinearApproximation. (* f, g *) Variable f g : `:real->real`. Variable x : `:real`. Variables f_bounds df_bounds : `:real#real`. Variables g_bounds dg_bounds : `:real#real`. Lemma interval_arith_not_zero x int : `interval_arith x int ==> interval_not_zero int ==> ~(x = &0)`. by rewrite -(PAIR int) interval_arith interval_not_zero; arith. Qed. Lemma interval_arith_pos x int : `interval_arith x int ==> interval_pos int ==> &0 < x`. by case: int; rewrite interval_arith interval_pos; arith. Qed. Lemma interval_arith_abs x int y : `interval_arith x int ==> iabs int < y ==> abs x < y`. by rewrite -(PAIR int) interval_arith iabs; arith. Qed. Lemma lin_approx_x : `lin_approx (\x. x) x (x, x) (&1, &1)`. by rewrite lin_approx_eq derivative_x !interval_arith /= REAL_DIFFERENTIABLE_ID !REAL_LE_REFL. Qed. Lemma lin_approx_const c : `lin_approx (\x. c) x (c, c) (&0, &0)`. rewrite lin_approx_eq derivative_const !interval_arith /= REAL_DIFFERENTIABLE_CONST. by rewrite !REAL_LE_REFL. Qed. Section LinearApproxUnivariateComposition. Hypothesis approx_f : `lin_approx f x f_bounds df_bounds`. Lemma lin_approx_compose_atn : `(\x. atn (f x)) real_differentiable atreal x /\ derivative (\x. atn (f x)) x = derivative f x / (&1 + f x * f x)`. by apply: derivative_compose_atn; move: approx_f; rewrite lin_approx_eq => ->. Qed. Lemma lin_approx_compose_exp : `(\x. exp (f x)) real_differentiable atreal x /\ derivative (\x. exp (f x)) x = exp (f x) * derivative f x`. by apply: derivative_compose_exp; move: approx_f; rewrite lin_approx_eq => ->. Qed. Lemma lin_approx_compose_inv : `interval_not_zero f_bounds ==> (\x. inv (f x)) real_differentiable atreal x /\ derivative (\x. inv (f x)) x = -- inv (f x * f x) * derivative f x`. move: approx_f; rewrite lin_approx_eq => [] [df h] f0. have fn0 : `~(f x = &0)`; first by apply: interval_arith_not_zero; exists f_bounds. exact: (derivative_compose_inv df fn0). Qed. Lemma lin_approx_compose_sqrt : `interval_pos f_bounds ==> (\x. sqrt (f x)) real_differentiable atreal x /\ derivative (\x. sqrt (f x)) x = derivative f x / (&2 * sqrt (f x))`. move: approx_f; rewrite lin_approx_eq => [] [df h] f_ineq. have f_pos : `&0 < f x`; first by apply: interval_arith_pos; exists f_bounds. exact: (derivative_compose_sqrt df f_pos). Qed. Lemma lin_approx_compose_acs : `iabs f_bounds < &1 ==> (\x. acs (f x)) real_differentiable atreal x /\ derivative (\x. acs (f x)) x = -- (derivative f x / sqrt (&1 - f x * f x))`. move: approx_f; rewrite lin_approx_eq => [] [df h] f_ineq. have f_abs : `abs (f x) < &1`; first by apply: interval_arith_abs; exists f_bounds. exact: (derivative_compose_acs df f_abs). Qed. End LinearApproxUnivariateComposition. Hypothesis approx_f : `lin_approx f x f_bounds df_bounds`. Hypothesis approx_g : `lin_approx g x g_bounds dg_bounds`. Lemma lin_approx_imp_add_diff : `(\x. f x + g x) real_differentiable atreal x`. apply: REAL_DIFFERENTIABLE_ADD. by rewrite (lin_approx_imp_f_diff approx_f) (lin_approx_imp_f_diff approx_g). Qed. Lemma lin_approx_imp_sub_diff : `(\x. f x - g x) real_differentiable atreal x`. apply: REAL_DIFFERENTIABLE_SUB. by rewrite (lin_approx_imp_f_diff approx_f) (lin_approx_imp_f_diff approx_g). Qed. Lemma lin_approx_imp_mul_diff : `(\x. f x * g x) real_differentiable atreal x`. apply: REAL_DIFFERENTIABLE_MUL_ATREAL. by rewrite (lin_approx_imp_f_diff approx_f) (lin_approx_imp_f_diff approx_g). Qed. Lemma lin_approx_imp_div_diff : `interval_not_zero g_bounds ==> (\x. f x / g x) real_differentiable atreal x`. move => gn0; apply: REAL_DIFFERENTIABLE_DIV_ATREAL. rewrite (lin_approx_imp_f_diff approx_f) (lin_approx_imp_f_diff approx_g) !andTb. apply: interval_arith_not_zero; exists g_bounds. by move: approx_g; rewrite lin_approx_eq => ->. Qed. End MoreLinearApproximation. (* Arithmetic of linear approximations *) Section LinearApproxArith. Variables f1 f2 : `:real->real`. Variables f1_bounds f2_bounds : `:real#real`. Variables df1_lo df1_hi df2_lo df2_hi : `:real`. Variables f_bounds : `:real#real`. Variables df_lo df_hi : `:real`. Variable x : `:real`. Hypothesis approx1 : `lin_approx f1 x f1_bounds (df1_lo, df1_hi)`. Lemma lin_approx_scale c : `&0 <= c ==> interval_arith (c * f1 x) f_bounds /\ df_lo <= c * df1_lo /\ c * df1_hi <= df_hi ==> lin_approx (\x. c * f1 x) x f_bounds (df_lo, df_hi)`. rewrite pair_eq interval_arith => c0 ineqs. rewrite lin_approx /=; split. by rewrite pair_eq; move: approx1 ineqs; rewrite !lin_approx !interval_arith; arith. move: approx1; rewrite !lin_approx => [] [int_f1] [f1'] [df1 int_f1']. exists `c * f1'`; rewrite HAS_REAL_DERIVATIVE_LMUL_ATREAL // andTb. move: int_f1'; rewrite !interval_arith => ineqs2; split; apply: REAL_LE_TRANS. by exists `c * df1_lo`; rewrite ineqs REAL_LE_LMUL. by exists `c * df1_hi`; rewrite ineqs REAL_LE_LMUL. Qed. Hypothesis approx2 : `lin_approx f2 x f2_bounds (df2_lo, df2_hi)`. Lemma lin_approx_add : `interval_arith (f1 x + f2 x) f_bounds /\ df_lo <= df1_lo + df2_lo /\ df1_hi + df2_hi <= df_hi ==> lin_approx (\x. f1 x + f2 x) x f_bounds (df_lo, df_hi)`. rewrite pair_eq interval_arith => ineqs. rewrite lin_approx /=; split. by rewrite pair_eq; move: approx1 approx2 ineqs; rewrite !lin_approx !interval_arith; arith. move: approx1 approx2; rewrite !lin_approx => [] [int_f1] [f1'] [df1 int_f1']. move => [int_f2] [f2'] [df2 int_f2']. exists `f1' + f2':real`; rewrite HAS_REAL_DERIVATIVE_ADD // andTb. by move: ineqs int_f1' int_f2'; rewrite !interval_arith; arith. Qed. End LinearApproxArith. (* Bounds on the second derivative *) Section SecondDerivativeBound. Variables f1 f2 : `:real->real`. Variable int : `:real#real`. Variables dd1 dd2 : `:real#real`. Lemma nth_diff_strong2_eq_alt f x : `nth_diff_strong 2 f x <=> ?s. real_open s /\ x IN s /\ !y. y IN s ==> (f has_real_derivative derivative f y) (atreal y) /\ (derivative f has_real_derivative nth_derivative 2 f y) (atreal y)`. rewrite nth_diff_strong nth_differentiable_on nth_differentiable_eq "ARITH_RULE `i < 2 <=> i = 0 \/ i = 1`". split => [] [s] [open_s] [xs] df. exists s; rewrite open_s xs !andTb => y /df [_] h. by move: (h `0`) (h `1`) => /=; rewrite -ONE nth_derivative1 nth_derivative0 -TWO => -> ->. exists s; rewrite open_s {1}xs !andTb => y /df h. rewrite REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL ?andTb. by rewrite real_differentiable; exists `derivative f y`. by move => i; case => ->; rewrite -?ONE -?TWO !(nth_derivative0, nth_derivative1). Qed. Lemma nth_diff_strong2_eq f x : `nth_diff_strong 2 f x <=> ?s. real_open s /\ x IN s /\ !y. y IN s ==> f real_differentiable atreal y /\ derivative f real_differentiable atreal y`. rewrite nth_diff_strong nth_differentiable_on TWO ONE !"GEN_ALL nth_differentiable". rewrite -ONE nth_derivative0 nth_derivative1. split => [] [s] [open_s] [xs] df. by exists s; rewrite open_s xs !andTb => y /df h. exists s; rewrite open_s {1}xs !andTb => y /df h. by rewrite !h REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL. Qed. Lemma lin_approx_compose f g y g_bounds f_bounds d_bounds: `nth_diff_strong_int 2 g_bounds f ==> g real_differentiable atreal y ==> interval_arith (g y) g_bounds ==> bounded_on_int f g_bounds f_bounds ==> interval_arith (derivative g y * derivative f (g y)) d_bounds ==> lin_approx (\x. f (g x)) y f_bounds d_bounds`. rewrite nth_diff_strong_int nth_diff_strong2_eq bounded_on_int => df dg g_int f_int dfg_int. have dfgy : `f real_differentiable atreal (g y)`. by move: (df g_int) => [s] [open_s] [ys] ->. rewrite lin_approx_eq derivative_composition // dfg_int /= f_int // andbT. by rewrite -(o_THM f); rewr ETA_AX; exact: REAL_DIFFERENTIABLE_COMPOSE_ATREAL. Qed. (* atn *) Lemma second_derivative_atn_eq x : `((\x. inv (&1 + x pow 2)) has_real_derivative (-- &2 * x) * inv (&1 + x pow 2) pow 2) (atreal x)`. rewrite REAL_POW_INV -real_div -REAL_NEG_LMUL HAS_REAL_DERIVATIVE_INV_ATREAL; split. rewrite -(REAL_ADD_LID `&2 * x`) HAS_REAL_DERIVATIVE_ADD HAS_REAL_DERIVATIVE_CONST andTb. rewrite REAL_POW_2 "REAL_ARITH `&2 * x = x * &1 + &1 * x`". by rewrite HAS_REAL_DERIVATIVE_MUL_ATREAL HAS_REAL_DERIVATIVE_ID. by rewrite REAL_POS_NZ // REAL_ADD_SYM REAL_LT_ADD1 REAL_LE_POW_2. Qed. Lemma second_derivative_atn : `derivative (derivative atn) = (\x. (-- &2 * x) * inv (&1 + x pow 2) pow 2)`. rewrite derivative_atn -eq_ext => x /=; apply: derivative_unique. by rewrite -REAL_POW_2 second_derivative_atn_eq. Qed. Lemma diff2_atn x : `nth_diff_strong 2 atn x`. rewrite nth_diff_strong2_eq_alt; exists `(:real)`. rewrite IN_UNIV REAL_OPEN_UNIV !andTb IN_UNIV => y /=. rewrite derivative_atn -REAL_POW_2 /= HAS_REAL_DERIVATIVE_ATN andTb. by rewrite nth_derivative2 second_derivative_atn /= second_derivative_atn_eq. Qed. (* inv *) Lemma second_derivative_inv x : `~(x = &0) ==> nth_derivative 2 inv x = &2 * inv (x pow 3)`. rewrite nth_derivative2 => xn0. apply: derivative_unique; apply: HAS_REAL_DERIVATIVE_LOCAL. exists `(\x. -- inv (x * x))`; split. move: "(DISCH_ALL o REAL_DIFF_CONV) `((\x. -- inv(x * x)) has_real_derivative f) (atreal x)`". rewrite REAL_ENTIRE xn0 /= real_div REAL_MUL_LNEG REAL_NEG_NEG REAL_MUL_LID REAL_MUL_RID -REAL_MUL_2. rewrite "REAL_ARITH `(x * x) pow 2 = x * x pow 3`" !REAL_INV_MUL. by rewrite "REAL_ARITH `!a. (&2 * x) * inv x * a = &2 * (x * inv x) * a`" REAL_MUL_RINV ?REAL_MUL_LID. exists `real_interval (x - abs x, x + abs x)`. rewrite REAL_OPEN_REAL_INTERVAL andTb !IN_REAL_INTERVAL; split => [|y ineq]. by move: xn0; arith. rewrite derivative_inv //=. by move: ineq xn0; arith. Qed. Lemma diff2_inv x : `~(x = &0) ==> nth_diff_strong 2 inv x`. rewrite nth_diff_strong2_eq => xn0. exists `real_interval (x - abs x, x + abs x)`. rewrite REAL_OPEN_REAL_INTERVAL andTb !IN_REAL_INTERVAL; split => [|y ineq]. by move: xn0; arith. rewrite REAL_DIFFERENTIABLE_AT_INV ?andTb; first by move: ineq xn0; arith. apply: differentiable_local; exists `\x. --inv (x * x)` `real_interval (y - abs y, y + abs y)`. rewrite REAL_OPEN_REAL_INTERVAL !IN_REAL_INTERVAL andTb; split. rewrite REAL_DIFFERENTIABLE_NEG REAL_DIFFERENTIABLE_INV_ATREAL. rewrite REAL_DIFFERENTIABLE_MUL_ATREAL ?REAL_DIFFERENTIABLE_ID // REAL_ENTIRE. by move: ineq xn0; arith. split => [|z ineq2]. by move: ineq xn0; arith. by rewrite derivative_inv //; move: ineq ineq2 xn0; arith. Qed. (* sqrt *) Lemma SQRT_POW x n : `&0 <= x ==> sqrt x pow n = sqrt (x pow n)`. move => ineq; elim: n => [|n IHn]; rewrite !"GEN_ALL real_pow" ?SQRT_1 //. by rewrite IHn SQRT_MUL_COMPAT // REAL_POW_LE. Qed. Lemma second_derivative_sqrt x : `&0 < x ==> nth_derivative 2 sqrt x = -- inv(&4 * sqrt (x pow 3))`. rewrite nth_derivative2 => x_pos. apply: derivative_unique; apply: HAS_REAL_DERIVATIVE_LOCAL. exists `(\x. inv (&2 * sqrt x))`; split. move: "(DISCH_ALL o REAL_DIFF_CONV) `((\x. inv(&2 * sqrt x)) has_real_derivative f) (atreal x)`". have ineq : `~(&2 * sqrt x = &0)`. by rewrite REAL_ENTIRE negb_or SQRT_EQ_0_COMPAT ?REAL_LT_IMP_LE //; move: x_pos; arith. rewrite x_pos ineq /= real_div REAL_INV_POW REAL_MUL_LID -REAL_MUL_LNEG -REAL_MUL_ASSOC. rewrite -"GEN_ALL real_pow" -REAL_INV_POW REAL_POW_MUL !REAL_INV_MUL SQRT_POW ?REAL_LT_IMP_LE //. rewrite REAL_MUL_ASSOC "GEN_ALL real_pow" REAL_MUL_LNEG REAL_INV_MUL REAL_MUL_ASSOC. rewrite REAL_MUL_RINV ?REAL_MUL_LID; first by arith. by rewrite REAL_MUL_LNEG "REAL_ARITH `&2 pow 2 = &4`" "ARITH_RULE `SUC 2 = 3`". exists `real_interval (&0, x + &1)`. rewrite REAL_OPEN_REAL_INTERVAL andTb !IN_REAL_INTERVAL; split => [|y ineq]. by move: x_pos; arith. by rewrite derivative_sqrt. Qed. Lemma diff2_sqrt x : `&0 < x ==> nth_diff_strong 2 sqrt x`. rewrite nth_diff_strong2_eq => x_pos. exists `real_interval (&0, x + &1)`. rewrite REAL_OPEN_REAL_INTERVAL andTb !IN_REAL_INTERVAL; split => [|y ineq]. by move: x_pos; arith. rewrite REAL_DIFFERENTIABLE_AT_SQRT ?andTb; first by move: ineq x_pos; arith. apply: differentiable_local; exists `\x. inv (&2 * sqrt x)` `real_interval (&0, y + &1)`. rewrite REAL_OPEN_REAL_INTERVAL !IN_REAL_INTERVAL andTb; split. rewrite REAL_DIFFERENTIABLE_INV_ATREAL REAL_DIFFERENTIABLE_MUL_ATREAL. by rewrite REAL_DIFFERENTIABLE_CONST REAL_DIFFERENTIABLE_AT_SQRT. by rewrite REAL_ENTIRE SQRT_EQ_0_COMPAT ?REAL_LT_IMP_LE //; move: ineq; arith. split => [|z ineq2]; first by move: ineq x_pos; arith. by rewrite derivative_sqrt. Qed. (* acs *) Lemma real_powS x n : `x pow (SUC n) = x * x pow n`. by rewrite real_pow. Qed. Lemma second_derivative_acs x : `abs x < &1 ==> nth_derivative 2 acs x = --(x / sqrt ((&1 - x * x) pow 3))`. rewrite nth_derivative2 => x_ineq. apply: derivative_unique; apply: HAS_REAL_DERIVATIVE_LOCAL. exists `\x. --inv (sqrt (&1 - x * x))`; split. move: "(DISCH_ALL o REAL_DIFF_CONV) `((\x. --inv (sqrt (&1 - x * x))) has_real_derivative f) (atreal x)`". have ineqs: `&0 < &1 - x * x /\ ~(sqrt(&1 - x * x) = &0)`. suff h: `&0 < &1 - x * x`. by rewrite SQRT_EQ_0_COMPAT ?REAL_LT_IMP_LE //; move: h; arith. rewrite "REAL_ARITH `&1 - x * x = (&1 - x) * (&1 + x)`" REAL_LT_MUL. by move: x_ineq; arith. rewrite !ineqs /= !real_div REAL_INV_MUL REAL_SUB_LZERO !REAL_MUL_LNEG REAL_NEG_NEG -!REAL_MUL_ASSOC. rewrite -REAL_INV_MUL -real_powS SQRT_POW ?REAL_LT_IMP_LE //. rewrite REAL_MUL_LID REAL_MUL_RID -REAL_MUL_2. rewrite "REAL_ARITH `!a. (&2 * x) * inv (&2) * a = (&2 * inv (&2)) * x * a`" "ARITH_RULE `SUC 2 = 3`". by rewrite REAL_MUL_RINV ?REAL_MUL_LID; arith. set e := `&1 - abs x`. exists `real_interval (x - e, x + e)`. rewrite REAL_OPEN_REAL_INTERVAL andTb !IN_REAL_INTERVAL; split => [|y ineq]. by move: x_ineq e_def; arith. rewrite derivative_acs //=. by move: ineq x_ineq e_def; arith. Qed. Lemma diff2_acs x : `abs x < &1 ==> nth_diff_strong 2 acs x`. rewrite nth_diff_strong2_eq => x_ineq. set e := `&1 - abs x`. exists `real_interval (x - e, x + e)`. rewrite REAL_OPEN_REAL_INTERVAL andTb !IN_REAL_INTERVAL; split => [|y ineq]. by move: x_ineq e_def; arith. rewrite REAL_DIFFERENTIABLE_AT_ACS ?andTb; first by move: ineq x_ineq e_def; arith. set e2 := `&1 - abs y`. apply: differentiable_local; exists `\x. --inv (sqrt (&1 - x * x))` `real_interval (y - e2, y + e2)`. rewrite REAL_OPEN_REAL_INTERVAL !IN_REAL_INTERVAL andTb; split. rewrite REAL_DIFFERENTIABLE_NEG REAL_DIFFERENTIABLE_INV_ATREAL. have gt0 : `&0 < &1 - y * y`. by rewrite "REAL_ARITH `&1 - y * y = (&1 - y) * (&1 + y)`" REAL_LT_MUL; move: ineq e_def; arith. rewrite SQRT_EQ_0_COMPAT ?REAL_LT_IMP_LE // REAL_LT_IMP_NZ //=. have ->: `(\x. sqrt (&1 - x * x)) = sqrt o (\x. &1 - x * x)`. by rewrite -eq_ext o_THM /=. rewrite REAL_DIFFERENTIABLE_COMPOSE_ATREAL REAL_DIFFERENTIABLE_AT_SQRT //. rewrite REAL_DIFFERENTIABLE_SUB // REAL_DIFFERENTIABLE_CONST REAL_DIFFERENTIABLE_MUL_ATREAL //. by rewrite REAL_DIFFERENTIABLE_ID. split => [|z ineq2]. by move: ineq x_ineq e_def e2_def; arith. rewrite derivative_acs //=. by move: x_ineq ineq e_def e2_def ineq2; arith. Qed. Section SecondDerivativeCompose. Lemma REAL_CONTINUOUS_OPEN_PREIMAGE f s t : `f real_continuous_on s ==> real_open s ==> real_open t ==> real_open {x | x IN s /\ f x IN t}`. move => f_cont open_s open_t. rewrite REAL_OPEN. suff ->: `IMAGE lift {x | x IN s /\ f x IN t} = {x | x IN (IMAGE lift s) /\ (lift o f o drop) x IN (IMAGE lift t)}`. by rewrite CONTINUOUS_OPEN_PREIMAGE -!REAL_OPEN; rewr ETA_AX; rewrite -REAL_CONTINUOUS_ON. rewrite EXTENSION IN_IMAGE_LIFT_DROP !IN_ELIM_THM !IN_IMAGE_LIFT_DROP => z /=; split. move => [x] [x_in] x_eq; exists `lift x`. by rewrite !o_THM !LIFT_DROP !x_in -x_eq LIFT_DROP. rewrite !o_THM LIFT_DROP => [] [x] [x_in] x_eq. by exists `drop x`. Qed. Lemma second_derivative_compose f g x : `nth_diff_strong 2 g x ==> nth_diff_strong 2 f (g x) ==> nth_derivative 2 (\x. f (g x)) x = nth_derivative 2 f (g x) * (derivative g x) pow 2 + derivative f (g x) * nth_derivative 2 g x`. move => dg df. rewrite nth_derivative2; apply: derivative_unique; apply: HAS_REAL_DERIVATIVE_LOCAL. exists `\x. derivative f (g x) * derivative g x`; split; last first. move: (df) (dg); rewrite !nth_diff_strong2_eq => [] [s] [open_s] [gxs] d_f [t] [open_t] [xt] d_g. set s' := `{z | z IN t /\ g z IN s}`. have open_s' : `real_open s'`. rewrite -s'_def REAL_CONTINUOUS_OPEN_PREIMAGE open_t open_s !andbT. rewrite REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT // => y yt. by rewrite REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL d_g. exists `t INTER s'`; rewrite REAL_OPEN_INTER // !IN_INTER andTb; split. by rewrite -s'_def IN_ELIM_THM xt andTb /=; exists x. move => y [yt ys']; rewrite derivative_composition ?REAL_MUL_SYM //. by rewrite d_g // d_f //; move: ys'; rewrite -s'_def IN_ELIM_THM => [] [z] /=. move: df dg; rewrite !nth_diff_strong2_eq_alt => [] [_] d_f [_] d_g. rewrite REAL_ADD_SYM REAL_POW_2 REAL_MUL_ASSOC HAS_REAL_DERIVATIVE_MUL_ATREAL; split; last first. by rewr ETA_AX; rewrite d_g. rewrite -(o_THM `derivative f`); rewr ETA_AX; rewrite REAL_DIFF_CHAIN_ATREAL. by rewrite d_g // d_f. Qed. Lemma diff2_compose f g x : `nth_diff_strong 2 g x ==> nth_diff_strong 2 f (g x) ==> nth_diff_strong 2 (\x. f (g x)) x`. rewrite !nth_diff_strong2_eq => [] [s] [open_s] [xs] dg [t] [open_t] [gxt] df. set s' := `{z | z IN s /\ g z IN t}`. have open_s' : `real_open s'`. rewrite -s'_def REAL_CONTINUOUS_OPEN_PREIMAGE open_t open_s !andbT. rewrite REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT // => y yt. by rewrite REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL dg. exists `s INTER s'`; rewrite REAL_OPEN_INTER // !IN_INTER andTb; split. by rewrite -s'_def IN_ELIM_THM xs andTb; exists x => /=. move => y [ys ys']. rewrite -{1}(o_THM f); rewr ETA_AX; rewrite REAL_DIFFERENTIABLE_COMPOSE_ATREAL ?dg ?df ?andTb //. by move: ys'; rewrite -s'_def; rewrite IN_ELIM_THM => [] [z] /=. apply: differentiable_local. exists `\x. derivative g x * derivative f (g x)` `s INTER s'`; split; last first. rewrite REAL_OPEN_INTER // !IN_INTER {1}ys {1}ys' !andTb => z z_in. rewrite derivative_composition // dg // df //. by move: z_in; rewrite -s'_def; rewrite IN_ELIM_THM => [] [_] [_] /=. rewrite REAL_DIFFERENTIABLE_MUL_ATREAL; rewr ETA_AX; rewrite dg // andTb. rewrite -(o_THM `derivative f`); rewr ETA_AX; rewrite REAL_DIFFERENTIABLE_COMPOSE_ATREAL dg // df //. by move: ys'; rewrite -s'_def; rewrite IN_ELIM_THM => [] [z] /=. Qed. (* Auxiliary results about open sets *) Lemma continuous_not0_exists_open f x : `~(f x = &0) ==> f real_continuous atreal x ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> ~(f y = &0)`. rewrite real_continuous_atreal => fn0 /(_ `abs (f x)`). "ANTS_TAC"; first by move: fn0; arith. move => [d] [d0] ineq. exists `real_interval (x - d, x + d)`. rewrite REAL_OPEN_REAL_INTERVAL !IN_REAL_INTERVAL andTb; split => [|y]; first by move: d0; arith. by move: (ineq y) d0 fn0; arith. Qed. Lemma continuous_gt_exists_open a f x : `a < f x ==> f real_continuous atreal x ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> a < f y`. move => f_ineq; rewrite real_continuous_atreal => /(_ `f x - a`). "ANTS_TAC"; first by move: f_ineq; arith. move => [d] [d0] ineq. exists `real_interval (x - d, x + d)`. rewrite REAL_OPEN_REAL_INTERVAL !IN_REAL_INTERVAL andTb; split => [|y]; first by move: d0; arith. by move: (ineq y) d0 f_ineq; arith. Qed. Lemma continuous_lt_exists_open a f x : `f x < a ==> f real_continuous atreal x ==> ?s. real_open s /\ x IN s /\ !y. y IN s ==> f y < a`. move => f_ineq; rewrite real_continuous_atreal => /(_ `a - f x`). "ANTS_TAC"; first by move: f_ineq; arith. move => [d] [d0] ineq. exists `real_interval (x - d, x + d)`. rewrite REAL_OPEN_REAL_INTERVAL !IN_REAL_INTERVAL andTb; split => [|y]; first by move: d0; arith. by move: (ineq y) d0 f_ineq; arith. Qed. Variable f : `:real->real`. Variable x : `:real`. Hypothesis df : `nth_diff_strong 2 f x`. Lemma second_derivative_compose_atn : `nth_derivative 2 (\x. atn (f x)) x = (nth_derivative 2 f x * (&1 + f x * f x) - &2 * f x * derivative f x pow 2) / (&1 + f x * f x) pow 2`. rewrite second_derivative_compose ?diff2_atn // nth_derivative2 second_derivative_atn /= derivative_atn /=. rewrite REAL_ADD_SYM !REAL_MUL_LNEG -real_sub. set lhs1 := `_1 * _2`; set lhs2 := `_1 * _2`. rewrite real_div REAL_INV_POW REAL_SUB_RDISTRIB. set rhs1 := `_1 * _2`; set rhs2 := `_1 * _2`. apply: "REAL_ARITH `lhs1 = rhs1 /\ lhs2 = rhs2 ==> lhs1 - lhs2 = rhs1 - rhs2`". rewrite -lhs2_def -rhs2_def -!REAL_MUL_ASSOC [`_1 * _2 pow 2`]REAL_MUL_SYM -REAL_POW_2; split => //. rewrite -rhs1_def REAL_POW_2 -!REAL_MUL_ASSOC "REAL_ARITH `!a b c d. a * b * c * d = a * (b * c) * d`". rewrite REAL_MUL_RINV -?lhs1_def ?REAL_MUL_LID ?REAL_MUL_SYM //. by move: (REAL_LE_SQUARE `f x`); arith. Qed. Lemma second_derivative_compose_inv : `~(f x = &0) ==> nth_derivative 2 (\x. inv (f x)) x = (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / (f x pow 3)`. move => fn0. rewrite second_derivative_compose ?diff2_inv // second_derivative_inv // derivative_inv //. rewrite REAL_MUL_LNEG -real_sub real_div REAL_SUB_RDISTRIB. apply: "REAL_ARITH `!a b c d. a = c /\ b = d ==> a - b = c - d`"; split; first by arith. rewrite REAL_INV_POW "ARITH_RULE `3 = SUC 2`" real_powS. rewrite "REAL_ARITH `!a b c d. (a * b) * c * d = a * (b * c) * d`" REAL_MUL_RINV // REAL_MUL_LID. by rewrite REAL_INV_MUL -REAL_POW_2 REAL_MUL_SYM. Qed. Lemma second_derivative_compose_sqrt : `&0 < f x ==> nth_derivative 2 (\x. sqrt (f x)) x = (&2 * nth_derivative 2 f x * f x - derivative f x pow 2) / (&4 * sqrt (f x pow 3))`. move => f_pos. rewrite second_derivative_compose ?diff2_sqrt // second_derivative_sqrt // derivative_sqrt //. rewrite REAL_MUL_LNEG REAL_ADD_SYM -real_sub real_div REAL_SUB_RDISTRIB. apply: "REAL_ARITH `!a b c d. a = c /\ b = d ==> a - b = c - d`"; split; last by arith. have ->: `sqrt (f x pow 3) = sqrt (f x) * f x`. by rewrite -SQRT_POW ?REAL_LT_IMP_LE // "ARITH_RULE `3 = SUC 2`" real_powS SQRT_POW_2 ?REAL_LT_IMP_LE. rewrite !REAL_INV_MUL. rewrite "REAL_ARITH `!a b c d. (&2 * a * b) * inv (&4) * c * d = (inv (&2) * c) * a * (b * d)`". by rewrite REAL_MUL_RINV ?REAL_POS_NZ // REAL_MUL_RID. Qed. Lemma second_derivative_compose_acs : `abs (f x) < &1 ==> nth_derivative 2 (\x. acs (f x)) x = -- ((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))`. move => f_ineq. rewrite second_derivative_compose ?diff2_acs // second_derivative_acs // derivative_acs //. rewrite !REAL_MUL_LNEG -REAL_NEG_ADD REAL_EQ_NEG2 !real_div REAL_ADD_RDISTRIB REAL_ADD_SYM. apply: "REAL_ARITH `!a b c d. a = c /\ b = d ==> a + b = c + d`"; split; last by arith. set y := `&1 - f x * f x`. have y_ineq: `&0 <= y /\ &0 < y /\ ~(y = &0)`. rewrite -y_def "REAL_ARITH `!a. &1 - a * a = (&1 - a) * (&1 + a)`". by rewrite REAL_ENTIRE REAL_LE_MUL ?REAL_LT_MUL; move: f_ineq; arith. have ->: `sqrt (y pow 3) = sqrt y * y`. by rewrite -SQRT_POW // "ARITH_RULE `3 = SUC 2`" real_powS SQRT_POW_2. rewrite REAL_INV_MUL "REAL_ARITH `!a b c d. (a * b) * c * d = c * a * (b * d)`". by rewrite REAL_MUL_RINV // REAL_MUL_RID. Qed. (* atn *) Lemma diff2_compose_atn : `nth_diff_strong 2 (\x. atn (f x)) x`. by rewrite diff2_compose diff2_atn. Qed. (* inv *) Lemma diff2_compose_inv : `~(f x = &0) ==> nth_diff_strong 2 (\x. inv (f x)) x`. by move => fn0; rewrite diff2_compose diff2_inv. Qed. (* sqrt *) Lemma diff2_compose_sqrt : `&0 < f x ==> nth_diff_strong 2 (\x. sqrt (f x)) x`. by move => f_pos; rewrite diff2_compose diff2_sqrt. Qed. (* acs *) Lemma diff2_compose_acs : `abs (f x) < &1 ==> nth_diff_strong 2 (\x. acs (f x)) x`. by move => f_abs; rewrite diff2_compose diff2_acs. Qed. End SecondDerivativeCompose. (* mul *) Lemma second_derivative_mul f g x : `nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x * g x) x = f x * nth_derivative 2 g x + &2 * derivative f x * derivative g x + nth_derivative 2 f x * g x`. move => df0 dg0; set int := `(x,x)`. have [ineq [df dg]]: `interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`. rewrite -!int_def !nth_diff_strong_int CONST_INTERVAL andTb. by split => y; rewrite interval_arith REAL_LE_ANTISYM => <-. have := nth_derivative_mul df dg `2` ineq; rewrite leqnn => -> //. rewrite {1}TWO {1}ONE !"GEN_ALL SUM_CLAUSES_NUMSEG" !"ARITH_RULE `!n. 0 <= SUC n`" /= -ONE -TWO. rewrite subnn subn0 "ARITH_RULE `2 - 1 = 1`" !nth_derivative0 !nth_derivative1. by rewrite binom BINOM_1 BINOM_REFL !REAL_MUL_LID REAL_ADD_ASSOC. Qed. (* div *) Lemma second_derivative_div f g x : `~(g x = &0) ==> nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x / g x) x = ((nth_derivative 2 f x * g x - f x * nth_derivative 2 g x) * g x - &2 * derivative g x * (derivative f x * g x - f x * derivative g x)) / (g x pow 3)`. move => gn0 diff_f diff_g. set dg := `derivative g x`; set df := `derivative f x`. set ddg := `nth_derivative 2 g x`; set ddf := `nth_derivative 2 f x`. rewrite !real_div second_derivative_mul ?second_derivative_compose_inv ?diff2_compose_inv //. rewrite derivative_compose_inv. by move: diff_g; rewrite nth_diff_strong2_eq => [] [s] [open_s] [xs] -> //. rewrite ddf_def ddg_def df_def dg_def !real_div. set lhs := `_1 + _2`. rewrite "REAL_RING `!f g x. ((ddf * g x - f x * ddg) * g x - &2 * dg * (df * g x - f x * dg)) * inv (g x pow 3) = f x * (&2 * dg pow 2 - ddg * g x) * inv (g x pow 3) + &2 * df * --(g x * inv (g x pow 3)) * dg + ddf * (g x * g x * inv (g x pow 3))`". have ->: `g x * inv (g x pow 3) = inv (g x pow 2)`. by rewrite "ARITH_RULE `3 = SUC 2`" real_powS REAL_INV_MUL REAL_MUL_ASSOC REAL_MUL_RINV // REAL_MUL_LID. have ->: `g x * inv (g x pow 2) = inv (g x)`. by rewrite TWO real_powS REAL_INV_MUL REAL_MUL_ASSOC REAL_MUL_RINV // REAL_MUL_LID REAL_POW_1. by rewrite (REAL_POW_2 `g x`) lhs_def. Qed. Lemma diff2_div f g x : `~(g x = &0) ==> nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_diff_strong 2 (\x. f x / g x) x`. move => gn0 df0 dg0; set int := `(x,x)`. have [ineq [df dg]]: `interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`. rewrite -!int_def !nth_diff_strong_int CONST_INTERVAL andTb. by split => y; rewrite interval_arith REAL_LE_ANTISYM => <-. have := nth_diff_mul `2` int f `\x. inv (g x)` df. rewrite !nth_diff_strong_int /= real_div => ->; split => // y. rewrite -int_def interval_arith REAL_LE_ANTISYM => <-. by rewrite diff2_compose_inv. Qed. (* scale *) Lemma second_derivative_scale f c x : `nth_diff_strong 2 f x ==> nth_derivative 2 (\x. c * f x) x = c * nth_derivative 2 f x`. move => df0; set int := `(x,x)`. have [ineq df]: `interval_arith x int /\ nth_diff_strong_int 2 int f`. rewrite -!int_def !nth_diff_strong_int CONST_INTERVAL andTb. by move => y; rewrite interval_arith REAL_LE_ANTISYM => <-. by have := nth_derivative_scale df c `2` ineq; rewrite leqnn => ->. Qed. (* add *) Lemma second_derivative_add f g x : `nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x + g x) x = nth_derivative 2 f x + nth_derivative 2 g x`. move => df0 dg0; set int := `(x,x)`. have [ineq [df dg]]: `interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`. rewrite -!int_def !nth_diff_strong_int CONST_INTERVAL andTb. by split => y; rewrite interval_arith REAL_LE_ANTISYM => <-. by have := nth_derivative_add df dg `2` ineq; rewrite leqnn => ->. Qed. (* sub *) Lemma second_derivative_sub f g x : `nth_diff_strong 2 f x ==> nth_diff_strong 2 g x ==> nth_derivative 2 (\x. f x - g x) x = nth_derivative 2 f x - nth_derivative 2 g x`. move => df0 dg0; set int := `(x,x)`. have [ineq [df dg]]: `interval_arith x int /\ nth_diff_strong_int 2 int f /\ nth_diff_strong_int 2 int g`. rewrite -!int_def !nth_diff_strong_int CONST_INTERVAL andTb. by split => y; rewrite interval_arith REAL_LE_ANTISYM => <-. by have := nth_derivative_sub df dg `2` ineq; rewrite leqnn => ->. Qed. (*************************) (* Bounds *) (* Composition *) Lemma second_derivative_compose_bounds f g int g_bounds dd_bounds : `nth_diff_strong_int 2 int g ==> bounded_on_int g int g_bounds ==> nth_diff_strong_int 2 g_bounds f ==> bounded_on_int (\x. nth_derivative 2 f (g x) * derivative g x pow 2 + derivative f (g x) * nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f (g x)) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /=. move => dg g_bounded df bounded; split => x ineq. by rewrite diff2_compose dg // df // g_bounded. by rewrite second_derivative_compose ?dg ?df ?g_bounded // bounded. Qed. (* atn *) Lemma second_derivative_atn_bounds dd_bounds : `bounded_on_int (\x. (-- &2 * x) * inv(&1 + x pow 2) pow 2) int dd_bounds ==> has_bounded_second_derivative atn int dd_bounds`. rewrite bounded_on_int has_bounded_second_derivative => ineq. split; last by rewrite nth_derivative2 second_derivative_atn bounded_on_int. by rewrite nth_diff_strong_int diff2_atn. Qed. Lemma second_derivative_compose_atn_bounds f dd_bounds : `nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (nth_derivative 2 f x * (&1 + f x * f x) - &2 * f x * derivative f x pow 2) / (&1 + f x * f x) pow 2) int dd_bounds ==> has_bounded_second_derivative (\x. atn (f x)) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => df bounded; split => x ineq. by rewrite diff2_compose_atn df. by rewrite second_derivative_compose_atn ?df // bounded. Qed. (* inv *) Lemma second_derivative_inv_bounds dd_bounds : `interval_not_zero int ==> bounded_on_int (\x. &2 * inv (x pow 3)) int dd_bounds ==> has_bounded_second_derivative inv int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => int0 bounded; split => x ineq. by rewrite diff2_inv (interval_arith_not_zero x int). by rewrite second_derivative_inv ?(interval_arith_not_zero x int) // bounded. Qed. Lemma second_derivative_compose_inv_bounds f f_bounds dd_bounds : `bounded_on_int f int f_bounds ==> interval_not_zero f_bounds ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (&2 * derivative f x pow 2 - nth_derivative 2 f x * f x) / f x pow 3) int dd_bounds ==> has_bounded_second_derivative (\x. inv (f x)) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => f_bounded f0 df bounded. have fn0: `!x. interval_arith x int ==> ~(f x = &0)`. by move => x ineq; rewrite (interval_arith_not_zero `f x` f_bounds) // f_bounded. split => x ineq. by rewrite diff2_compose_inv df // fn0. by rewrite second_derivative_compose_inv ?df ?fn0 // bounded. Qed. (* sqrt *) Lemma second_derivative_sqrt_bounds dd_bounds : `interval_pos int ==> bounded_on_int (\x. --inv (&4 * sqrt (x pow 3))) int dd_bounds ==> has_bounded_second_derivative sqrt int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => int_pos bounded. split => x ineq. by rewrite diff2_sqrt (interval_arith_pos x int). by rewrite second_derivative_sqrt ?(interval_arith_pos x int) // bounded. Qed. Lemma second_derivative_compose_sqrt_bounds f f_bounds dd_bounds : `bounded_on_int f int f_bounds ==> interval_pos f_bounds ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. (&2 * nth_derivative 2 f x * f x - derivative f x pow 2) / (&4 * sqrt (f x pow 3))) int dd_bounds ==> has_bounded_second_derivative (\x. sqrt (f x)) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => f_bounded f_int df bounded. have f_pos: `!x. interval_arith x int ==> &0 < f x`. by move => x ineq; rewrite (interval_arith_pos `f x` f_bounds) // f_bounded. split => x ineq. by rewrite diff2_compose_sqrt df // f_pos. by rewrite second_derivative_compose_sqrt ?df ?f_pos // bounded. Qed. (* acs *) Lemma second_derivative_acs_bounds dd_bounds : `iabs int < &1 ==> bounded_on_int (\x. --(x / sqrt ((&1 - x * x) pow 3))) int dd_bounds ==> has_bounded_second_derivative acs int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => int_abs bounded. split => x ineq. by rewrite diff2_acs (interval_arith_abs x int). by rewrite second_derivative_acs ?(interval_arith_abs x int) // bounded. Qed. Lemma second_derivative_compose_acs_bounds f f_bounds dd_bounds : `bounded_on_int f int f_bounds ==> iabs f_bounds < &1 ==> nth_diff_strong_int 2 int f ==> bounded_on_int (\x. --((nth_derivative 2 f x * (&1 - f x * f x) + f x * derivative f x pow 2) / sqrt ((&1 - f x * f x) pow 3))) int dd_bounds ==> has_bounded_second_derivative (\x. acs (f x)) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int /= => f_bounded f_abs df bounded. have fabs: `!x. interval_arith x int ==> abs (f x) < &1`. by move => x ineq; rewrite (interval_arith_abs `f x` f_bounds) // f_bounded. split => x ineq. by rewrite diff2_compose_acs df // fabs. by rewrite second_derivative_compose_acs ?df ?fabs // bounded. Qed. (* scale *) Lemma second_derivative_scale_bounds c f dd_bounds : `nth_diff_strong_int 2 int f ==> bounded_on_int (\x. c * nth_derivative 2 f x) int dd_bounds ==> has_bounded_second_derivative (\x. c * f x) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int => /= df b. rewrite nth_diff_scale // andTb => x ineq. rewrite second_derivative_scale ?b //. by move: df; rewrite nth_diff_strong_int; exact. Qed. (* add *) Lemma second_derivative_add_bounds f g dd_bounds : `nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. nth_derivative 2 f x + nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f x + g x) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int => /= df dg b. rewrite nth_diff_add // andTb => x ineq. rewrite second_derivative_add ?b //. by move: df dg; rewrite !nth_diff_strong_int => -> // ->. Qed. (* sub *) Lemma second_derivative_sub_bounds f g dd_bounds : `nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. nth_derivative 2 f x - nth_derivative 2 g x) int dd_bounds ==> has_bounded_second_derivative (\x. f x - g x) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int => /= df dg b. rewrite nth_diff_sub // andTb => x ineq. rewrite second_derivative_sub ?b //. by move: df dg; rewrite !nth_diff_strong_int => -> // ->. Qed. (* mul *) Lemma second_derivative_mul_bounds f g dd_bounds : `nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. f x * nth_derivative 2 g x + &2 * derivative f x * derivative g x + nth_derivative 2 f x * g x) int dd_bounds ==> has_bounded_second_derivative (\x. f x * g x) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int => /= df dg b. rewrite nth_diff_mul // andTb => x ineq. rewrite second_derivative_mul ?b //. by move: df dg; rewrite !nth_diff_strong_int => -> // ->. Qed. (* div *) Lemma second_derivative_div_bounds f g g_bounds dd_bounds : `bounded_on_int g int g_bounds ==> interval_not_zero g_bounds ==> nth_diff_strong_int 2 int f ==> nth_diff_strong_int 2 int g ==> bounded_on_int (\x. ((nth_derivative 2 f x * g x - f x * nth_derivative 2 g x) * g x - &2 * derivative g x * (derivative f x * g x - f x * derivative g x)) / g x pow 3) int dd_bounds ==> has_bounded_second_derivative (\x. f x / g x) int dd_bounds`. rewrite has_bounded_second_derivative !bounded_on_int !nth_diff_strong_int => bg gn0 /= df dg b. have g0 : `!x. interval_arith x int ==> ~(g x = &0)`. by move => x ineq; apply: interval_arith_not_zero; exists `g_bounds`; rewrite bg. split => x ineq; first by rewrite diff2_div g0 // df ?dg. by rewrite second_derivative_div ?g0 ?df ?dg // b. Qed. End SecondDerivativeBound. Section TaylorArith. "let cell_domain = new_definition `cell_domain x y z w <=> x <= y /\ y <= z /\ y - x <= w /\ z - y <= w`". Lemma taylor_x x y z w: `cell_domain x y z w ==> taylor_interval (\x. x) x y z w (y, y) (&1, &1) (&0, &0)`. rewrite cell_domain => ineqs. rewrite taylor_interval !ineqs lin_approx_x !andTb. rewrite has_bounded_second_derivative. rewrite nth_diff_strong_int nth_diff_strong nth_differentiable_on nth_differentiable_eq; split. move => p _; exists `(:real)`; rewrite REAL_OPEN_UNIV !IN_UNIV !andTb => q /=. rewrite REAL_CONTINUOUS_AT_ID andTb => i. rewrite "ARITH_RULE `i < 2 <=> i = 0 \/ i = 1`"; case => ->. by rewrite nth_derivative0 -ONE nth_derivative1 derivative_x /= HAS_REAL_DERIVATIVE_ID. rewrite nth_derivative1 -TWO nth_derivative2 derivative_x /= derivative_const /=. by rewrite HAS_REAL_DERIVATIVE_CONST. rewrite nth_derivative2 derivative_x /= derivative_const bounded_on_int /=. by rewrite !interval_arith REAL_LE_REFL. Qed. Lemma taylor_const c x y z w: `cell_domain x y z w ==> taylor_interval (\x. c) x y z w (c, c) (&0, &0) (&0, &0)`. rewrite cell_domain => ineqs. rewrite taylor_interval !ineqs lin_approx_const !andTb. rewrite has_bounded_second_derivative. rewrite nth_diff_strong_int nth_diff_strong nth_differentiable_on nth_differentiable_eq; split. move => p _; exists `(:real)`; rewrite REAL_OPEN_UNIV !IN_UNIV !andTb => q /=. rewrite REAL_CONTINUOUS_CONST andTb => i. rewrite "ARITH_RULE `i < 2 <=> i = 0 \/ i = 1`"; case => ->. by rewrite nth_derivative0 -ONE nth_derivative1 derivative_const /= HAS_REAL_DERIVATIVE_CONST. by rewrite nth_derivative1 -TWO nth_derivative2 !derivative_const /= HAS_REAL_DERIVATIVE_CONST. rewrite nth_derivative2 !derivative_const /= bounded_on_int /=. by rewrite !interval_arith REAL_LE_REFL. Qed. Variable f : `:real->real`. Variables x y z w : `:real`. Variables f_bounds df_bounds dd_bounds : `:real#real`. Variables f_lo f_hi df_lo df_hi : `:real`. Lemma taylor_f_bounds df dd lo hi t : `taylor_interval f x y z w (f_lo, f_hi) df_bounds dd_bounds ==> iabs df_bounds = df ==> iabs dd_bounds = dd ==> w * (df + w * dd * inv(&2)) <= t ==> f_hi + t <= hi ==> lo <= f_lo - t ==> bounded_on_int f (x, z) (lo, hi)`. move => taylor_f iabs_df iabs_dd t_ineq hi_ineq lo_ineq. rewrite bounded_on_int !interval_arith => p ineq. move: (taylor_lower_bound (EQ_SYM iabs_dd) taylor_f) (taylor_upper_bound (EQ_SYM iabs_dd) taylor_f). rewrite /= !real_div iabs_df => /(_ ineq) ineq1 /(_ ineq) ineq2. by move: ineq1 ineq2 lo_ineq hi_ineq t_ineq; arith. Qed. Lemma taylor_df_bounds dd lo hi: `taylor_interval f x y z w f_bounds (df_lo, df_hi) dd_bounds ==> iabs dd_bounds = dd ==> df_hi + w * dd <= hi ==> lo <= df_lo - w * dd ==> bounded_on_int (derivative f) (x, z) (lo, hi)`. move => taylor_f iabs_dd hi_ineq lo_ineq. rewrite bounded_on_int !interval_arith => p ineq. move: (taylor_derivative_lower_bound (EQ_SYM iabs_dd) taylor_f ineq). move: (taylor_derivative_upper_bound (EQ_SYM iabs_dd) taylor_f ineq). by move: lo_ineq hi_ineq; arith. Qed. Lemma bounded_on_int_compose g int g_bounds : `bounded_on_int g int g_bounds ==> bounded_on_int f g_bounds f_bounds ==> bounded_on_int (\x. f (g x)) int f_bounds`. rewrite !bounded_on_int => g_bounded f_bounded x ineq /=. by rewrite f_bounded g_bounded. Qed. Lemma bounded_on_int_imp_interval_arith int : `bounded_on_int f int f_bounds ==> interval_arith y int ==> interval_arith (f y) f_bounds`. rewrite bounded_on_int => bounded_f int_y. by rewrite bounded_f. Qed. Lemma taylor_interval_narrow x0 z0 w0: `taylor_interval f x y z w f_bounds df_bounds dd_bounds ==> cell_domain x0 y z0 w0 ==> x <= x0 ==> z0 <= z ==> taylor_interval f x0 y z0 w0 f_bounds df_bounds dd_bounds`. rewrite !taylor_interval cell_domain !andbA => [] [[ineq lin] dd] c i1 i2. rewrite lin andbT; split; first by move: c i1 i2; arith. move: dd; rewrite !has_bounded_second_derivative !nth_diff_strong_int !bounded_on_int => df. split => p int_p. by rewrite df; move: int_p i1 i2; rewrite !"GEN_ALL interval_arith"; arith. by rewrite df; move: int_p i1 i2; rewrite !"GEN_ALL interval_arith"; arith. Qed. End TaylorArith. (********************************) (* Lemma second_derivative_scale a dd : `abs a * dd1 <= dd ==> has_bounded_second_derivative (\x. a * f1 x) s dd`. move => ineq; move: ddf1; rewrite !has_bounded_second_derivative. move => [dd1_pos] [f'] [f''] ddf; split. by apply: REAL_LE_TRANS; exists `abs a * dd1`; rewrite ineq REAL_LE_MUL // REAL_ABS_POS. exists `\x. a * f' x` `\x. a * f'' x` => x xs /=. rewrite !HAS_REAL_DERIVATIVE_LMUL_ATREAL ?ddf // !andTb. apply: REAL_LE_TRANS; exists `abs a * dd1`; rewrite ineq REAL_ABS_MUL REAL_LE_MUL2 //. by rewrite !REAL_ABS_POS REAL_LE_REFL ddf. Qed. Hypothesis ddf2 : `has_bounded_second_derivative f2 s dd2`. Lemma second_derivative_add dd : `dd1 + dd2 <= dd ==> has_bounded_second_derivative (\x. f1 x + f2 x) s dd`. move => ineq; move: ddf1 ddf2; rewrite !has_bounded_second_derivative. move => [dd1_pos] [f1'] [f1''] ddf1 [dd2_pos] [f2'] [f2''] ddf2; split. by apply: REAL_LE_TRANS; exists `dd1 + dd2:real`; rewrite ineq REAL_LE_ADD. exists `\x. f1' x + f2' x:real` `\x. f1'' x + f2'' x:real` => x xs /=. rewrite !HAS_REAL_DERIVATIVE_ADD ?ddf1 ?ddf2 // !andTb. apply: REAL_LE_TRANS; exists `dd1 + dd2 : real`; rewrite ineq andbT. apply: REAL_LE_TRANS; exists `abs (f1'' x) + abs (f2'' x)`. by rewrite REAL_LE_ADD2 ?ddf1 ?ddf2 // REAL_ABS_TRIANGLE. Qed. Lemma second_derivative_sub dd : `dd1 + dd2 <= dd ==> has_bounded_second_derivative (\x. f1 x - f2 x) s dd`. move => ineq; move: ddf1 ddf2; rewrite !has_bounded_second_derivative. move => [dd1_pos] [f1'] [f1''] ddf1 [dd2_pos] [f2'] [f2''] ddf2; split. by apply: REAL_LE_TRANS; exists `dd1 + dd2:real`; rewrite ineq REAL_LE_ADD. exists `\x. f1' x - f2' x:real` `\x. f1'' x - f2'' x:real` => x xs /=. rewrite !HAS_REAL_DERIVATIVE_SUB ?ddf1 ?ddf2 // !andTb real_sub. apply: REAL_LE_TRANS; exists `dd1 + dd2 : real`; rewrite ineq andbT. apply: REAL_LE_TRANS; exists `abs (f1'' x) + abs (-- f2'' x)`. by rewrite {2}REAL_ABS_NEG REAL_LE_ADD2 ?ddf1 ?ddf2 // REAL_ABS_TRIANGLE. Qed. Lemma second_derivative_mul dd bf1 bf2 bdf1 bdf2 : `bounded_on f1 s bf1 ==> bounded_on f2 s bf2 ==> bounded_on (derivative f1) s bdf1 ==> bounded_on (derivative f2) s bdf2 ==> dd1 * bf2 + &2 * bdf1 * bdf2 + dd2 * bf1 <= dd ==> has_bounded_second_derivative (\x. f1 x * f2 x) s dd`. rewrite !bounded_on => b_f1 b_f2 b_df1 b_df2 ineq. move: ddf1 ddf2; rewrite !has_bounded_second_derivative. move => [dd1_pos] [f1'] [f1''] ddf1 [dd2_pos] [f2'] [f2''] ddf2; split. apply: REAL_LE_TRANS; exists `dd1 * bf2 + &2 * bdf1 * bdf2 + dd2 * bf1`. by rewrite ineq andbT !REAL_LE_ADD ?REAL_LE_MUL //; arith. have : `bounded_on f1' s bdf1`. rewrite bounded_on b_df1 andTb => x xs. suff ->: `f1' x = derivative f1 x`; first by rewrite b_df1. by rewrite EQ_SYM_EQ; apply: derivative_unique; rewrite ddf1. have : `bounded_on f2' s bdf2`. rewrite bounded_on b_df2 andTb => x xs. suff ->: `f2' x = derivative f2 x`; first by rewrite b_df2. by rewrite EQ_SYM_EQ; apply: derivative_unique; rewrite ddf2. rewrite !bounded_on => b_f2' b_f1'. exists `\x. f1 x * f2' x + f1' x * f2 x`. exists `\x. f1'' x * f2 x + &2 * f1' x * f2' x + f1 x * f2'' x` => x xs /=. rewrite HAS_REAL_DERIVATIVE_MUL_ATREAL ?ddf1 ?ddf2 // andTb; split; last first. apply: REAL_LE_TRANS; exists `dd1 * bf2 + &2 * bdf1 * bdf2 + dd2 * bf1`. rewrite ineq andbT. apply: REAL_LE_TRANS; exists `abs (f1'' x * f2 x) + abs (&2 * f1' x * f2' x + f1 x * f2'' x)`. rewrite REAL_ABS_TRIANGLE andTb REAL_LE_ADD2 REAL_ABS_MUL. rewrite REAL_LE_MUL2 ?REAL_ABS_POS ?ddf1 ?b_f2 // andTb. apply: REAL_LE_TRANS; exists `abs (&2 * f1' x * f2' x) + abs (f1 x * f2'' x)`. rewrite REAL_ABS_TRIANGLE andTb REAL_LE_ADD2 !REAL_ABS_MUL [`dd2 * _`]REAL_MUL_SYM. rewrite !REAL_LE_MUL2 ?REAL_ABS_POS ?b_f1' ?b_f2' ?b_f1 ?ddf2 // REAL_LE_MUL ?REAL_ABS_POS //. by arith. rewrite "REAL_ARITH `f1'' (x:real) * f2 x + &2 * f1' x * f2' x + f1 x * f2'' x = (f1 x * f2'' x + f1' x * f2' x) + (f1' x * f2' x + f1'' x * f2 x)`". by rewrite HAS_REAL_DERIVATIVE_ADD !HAS_REAL_DERIVATIVE_MUL_ATREAL ?ddf1 ?ddf2. Qed. *) hol-light/Formal_ineqs/verifier/000077500000000000000000000000001303454263000171775ustar00rootroot00000000000000hol-light/Formal_ineqs/verifier/interval_m/000077500000000000000000000000001303454263000213375ustar00rootroot00000000000000hol-light/Formal_ineqs/verifier/interval_m/interval.ml000066400000000000000000000120051303454263000235130ustar00rootroot00000000000000(* =========================================================== *) (* OCaml interval arithmetic *) (* Author: Thomas C. Hales *) (* Date: 2011-08-21 *) (* =========================================================== *) (* port of interval.cc, This file gives a simple implementation of interval arithmetic, together with the basic arithmetic operations on intervals. It has been incompletely implemented. For now, I am not implementing directed roundings. However, McLaughlin implemented directed rounding several years ago: See http://perso.ens-lyon.fr/nathalie.revol/mpfi.html ~/Library/McLaughlinOCAML/ocaml/src/extensions/ocaml-mpfi/ *) needs "verifier/interval_m/types.ml";; module Interval = struct open Interval_types;; let mk_interval (a,b) = { lo = a; hi = b; };; let string_of_interval x = Printf.sprintf "[%f;%f]" x.lo x.hi;; (* let izero = mk_interval(0.0,0.0);; *) let zero = mk_interval(0.0,0.0);; let one = mk_interval(1.0,1.0);; let two = mk_interval(2.0,2.0);; let four = mk_interval(4.0,4.0);; let is_zero x =(x.lo=0.0)&&(x.hi=0.0);; let pos x = if (x.lo >= 0.0) then x else mk_interval(0.0, if (x.hi < 0.0) then 0.0 else x.hi );; let imax (x,y) = let t=max x.hi y.hi in mk_interval(t,t);; let imin (x,y) = let t = min x.lo y.lo in mk_interval(t,t);; let imin3(x,y,z) = imin(x,imin(y,z));; let imax3(x,y,z) = imax(x,imax(y,z));; let imax4(w,x,y,z) = imax(imax(w,x),imax(y,z));; let sup x = x.hi;; let inf x = x.lo;; let iabs x = max x.hi (~-. (x.lo));; let ilt x y = (x.hi < y.lo);; let igt x y = (x.lo > y.hi);; let ieq x y = (x.lo = y.lo && x.hi = y.hi);; (* need rounding modes -- BUG *) (* start of bug section *) let up() = ( (* bug *) );; let down() = ( (* bug *) );; let nearest() = ( (* bug *) );; let upadd x y = ( x +. y);; (* bug *) let upmul x y = (x *. y);; let updiv x y = (x /. y);; let upsub x y = (x -. y);; let downadd x y = (x +. y);; let downmul x y = (x *. y);; let downdiv x y = (x /. y);; let downsub x y = (x -. y);; (* end of bug section *) let interval_of_string = let dbl_min =1.0e-300 in fun (s1,s2) -> let ( - ) = (down(); downsub) in let lo = float_of_string s1 - dbl_min in let ( + ) = (up(); upadd) in let hi = float_of_string s2 + dbl_min in mk_interval(lo,hi);; let interval_of_single s = interval_of_string (s,s);; let ineg x = mk_interval(~-. (x.hi), ~-. (x.lo));; let iadd x y = mk_interval((down(); downadd x.lo y.lo), (up(); upadd x.hi y.hi));; let slowcases x y = if (x.lo >= 0.0) then (if (y.lo >= 0.0) then (x.lo,y.lo,x.hi,y.hi) else if (y.hi <= 0.0) then (x.hi,y.lo,x.lo,y.hi ) else (x.hi,y.lo,x.hi,y.hi)) else if (x.hi <= 0.0) then (if (y.hi <= 0.0) then (x.hi,y.hi,x.lo,y.lo) else if (y.lo >= 0.0) then (x.lo,y.hi,x.hi,y.lo) else (x.lo,y.hi,x.lo,y.lo)) else (if (y.lo >=0.0) then (x.lo,y.hi,x.hi,y.hi) else if (y.hi <=0.0) then (x.hi,y.lo,x.lo,y.lo) else (let lo = (down(); min (downmul x.hi y.lo) (downmul x.lo y.hi)) in let hi = (up(); max (upmul x.hi y.hi) (upmul x.lo y.lo)) in (lo,1.0,hi,1.0)));; let slowmul x y = let (xlo,ylo,xhi,yhi) = slowcases x y in mk_interval((down(); downmul xlo ylo),(up(); upmul xhi yhi));; let _ = let test_slowmul x y = let all = [x.lo *. y.lo; x.hi *. y.lo; x.lo *. y.hi; x.hi *. y.hi] in let m = end_itlist min all in let M = end_itlist max all in ( mk_interval(m,M) = slowmul x y) in let xs = map mk_interval [(~-. 7.0, ~-. 5.0);(~-. 3.0,9.0);(11.0,13.0)] in let ys = map mk_interval [(~-. 16.0, ~-. 14.0);(~-. 10.0,12.0); (18.0,22.0)] in let test i j = test_slowmul (List.nth xs i) (List.nth ys j) or failwith (Printf.sprintf "%d %d" i j) in for i=0 to 2 do for j= 0 to 2 do let _ = test i j in (); done; done;; let imul x y = if (x.lo > 0.0 && y.lo > 0.0) then mk_interval((down(); downmul x.lo y.lo, (up(); upmul x.hi y.hi))) else slowmul x y;; let isub x y = mk_interval((down();downsub x.lo y.hi),(up(); upsub x.hi y.lo));; let isqrt = let sqrt = Pervasives.sqrt in fun x -> mk_interval( (if (x.lo <= 0.0) then 0.0 else (down(); sqrt(x.lo))), (if (x.hi <= 0.0) then 0.0 else (up(); sqrt(x.hi))));; let iatan x = let _ = nearest() in mk_interval((down(); atan x.lo),(up(); atan x.hi));; let iacos x = let _ = nearest() in mk_interval((down(); acos x.hi),(up(); acos x.lo));; let combine x y = mk_interval(inf(imin(x,y)),sup(imax(x,y)));; let rand01 = let random_int_seed = 81757 in let _ = Random.init(random_int_seed) in fun _ -> Random.float(1.0);; let bounded_from_zero = let dbl_epsilon = 1.0e-8 in fun x-> (x.hi < ~-. dbl_epsilon or x.lo > dbl_epsilon);; let idiv x y = if (bounded_from_zero y) then imul x (mk_interval((down(); downdiv 1.0 y.hi),(up(); updiv 1.0 y.lo))) else raise Unstable;; (* overload arithmetic ops *) (* let (+) = iadd;; let (-) = isub;; let (/) = idiv;; let (~-) = ineg;; *) end;; hol-light/Formal_ineqs/verifier/interval_m/line_interval.ml000066400000000000000000000055571303454263000245400ustar00rootroot00000000000000(* =========================================================== *) (* OCaml linear approximation of functions *) (* Author: Thomas C. Hales *) (* Date: 2011-08-21 *) (* =========================================================== *) (* port of lineInterval.cc. Only the top section has been translated. The rest should be automatically generated from HOL Light specs. This impements basic operations on the type line, such as addition and scalar multiplication. *) needs "verifier/interval_m/interval.ml";; module Line_interval = struct open Interval_types;; open List;; open Interval;; (* general utilities *) let iter8 = 0--7;; let table f = map f iter8;; let table2 f = map (fun i -> map (fun j-> f i j) iter8) iter8;; let rth m x i = if (i >=0) && (i < m) then List.nth x i else failwith (Printf.sprintf "index %d not in 0..%d" i (m-1));; let mth x i = if (i >=0) && (i < 8) then List.nth x i else failwith (Printf.sprintf "index %d not in 0..8" i );; let mth2 a i j = mth (mth a i) j;; let maxl xs = end_itlist max xs;; let minl xs = end_itlist min xs;; (* line interval proper *) let partial line i = mth line.df i ;; let mk_line(f1,df1) = { f = f1; df =df1};; let line_zero = let z = zero in mk_line(z,replicate z 8);; let line_unit = mk_line(one,replicate zero 8);; let lmul = let ( * ) = imul in let ( + ) = iadd in fun a b -> mk_line ( a.f * b.f, map (fun i -> a.f * mth b.df i + b.f * mth a.df i) iter8);; let smul = let ( * ) = imul in fun a b -> mk_line ( a.f * b, map (fun x -> x * b) a.df);; let ldiv = let one = mk_interval(1.0,1.0) in let ( * ) = imul in let ( - ) = isub in let ( / ) = idiv in fun b a -> let r = one/a.f in let f = b.f * r in let r2 = r * r in mk_line ( f, map (fun i -> ((mth b.df i) * a.f - (mth a.df i) * b.f)* r2) iter8);; let ladd = let ( + ) = iadd in fun b a -> mk_line(b.f + a.f, map (fun i -> mth b.df i + mth a.df i) iter8);; let lsub = let ( - ) = isub in fun b a -> mk_line(b.f - a.f, map (fun i -> mth b.df i - mth a.df i) iter8);; let lneg = let ineg = ineg in fun a -> mk_line(ineg a.f, map ineg a.df);; let lsqrt = let one = mk_interval(1.0,1.0) in let two = mk_interval(2.0,2.0) in let ( * ) = imul in let ( / ) = idiv in fun a -> let f = isqrt a.f in let rs = one / (two * f) in mk_line(f, map (fun i -> mth a.df i * rs) iter8);; let latan = (* arctan (a/b) *) let one = mk_interval(1.0,1.0) in let ( * ) = imul in let ( + ) = iadd in let ( - ) = isub in let ( / ) = idiv in fun a b -> let f = iatan (a.f/b.f) in let rden = one/ (a.f * a.f + b.f * b.f) in mk_line(f, map (fun i -> rden * (mth a.df i * b.f - mth b.df i * a.f)) iter8);; end;; hol-light/Formal_ineqs/verifier/interval_m/recurse.ml000066400000000000000000000266721303454263000233560ustar00rootroot00000000000000(* =========================================================== *) (* OCaml verification procedure *) (* Authors: Thomas C. Hales, Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) (* port of recurse.cc *) (* This is the code that verifies a disjunct of nonlinear inequalities. The are given as a list (tf:tfunction list). If tf = [f1;....;fk], then the list represents the inequality (f1 < 0 \/ f2 < 0 .... fk < 0). The end user should only need to define a cell option, and then call recursive_verifier, which recursively bisects the domain until a partition of the domain is found on which verifier_cell gives a pass on each piece of the partition. *) needs "verifier/interval_m/taylor.ml";; needs "verifier/interval_m/report.ml";; needs "verifier_options.hl";; module Recurse = struct open Interval_types;; open Interval;; open Univariate;; open Line_interval;; open Taylor;; open Verifier_options;; open List;; type cellOption = { only_check_deriv1_negative : bool; is_using_dihmax : bool; is_using_bigface126 : bool; width_cutoff : float; allow_sharp : bool; allow_derivatives : bool; mutable iteration_count : int; iteration_limit : int; recursion_depth : int; mono_pass : bool; convex_flag : bool; raw_int_flag : bool; eps : float; };; (* cell verification is complex, and we use exceptions to exit as soon as the status has been determined. *) type mono_status = { variable : int; decr_flag : bool; df0_flag : bool; ti_flag : bool; };; type cell_status = | Cell_pass of mono_status list list * bool | Cell_pass_mono of mono_status list list * mono_status | Cell_counterexample | Cell_inconclusive_ti of (mono_status list list * taylor_interval * float list * float list * float list * float list) | Cell_inconclusive of (mono_status list list * float list * float list * float list * float list);; exception Return of cell_status;; type result_tree = | Result_false of (float list * float list) | Result_pass of (bool * float list * float list) | Result_pass_mono of mono_status | Result_pass_ref of int | Result_mono of mono_status list * result_tree (* variable, convex_flag, r1, r2 *) | Result_glue of (int * bool * result_tree * result_tree);; type p_status = { pp : int; };; type p_result_tree = | P_result_pass of p_status * bool | P_result_mono of p_status * mono_status list * p_result_tree | P_result_glue of p_status * int * bool * p_result_tree * p_result_tree | P_result_ref of int;; let rec result_size r = match r with | Result_false _ -> failwith "False result detected" | Result_mono (_,r1) -> result_size r1 | Result_glue (_, _, r1, r2) -> result_size r1 + result_size r2 | Result_pass_mono _ -> 1 | Result_pass _ -> 1 | _ -> 0;; let rec p_result_size r = match r with | P_result_pass _ -> 1 | P_result_mono (_, _, r1) -> p_result_size r1 | P_result_glue (_, _, _, r1, r2) -> p_result_size r1 + p_result_size r2 | _ -> 0;; let return c = raise (Return c);; (* error checking and reporting functions *) let string_of_domain x = let n = mth in Printf.sprintf "{%f, %f, %f, %f, %f, %f, %f, %f}" (n x 0) (n x 1) (n x 2) (n x 3) (n x 4) (n x 5) (n x 6) (n x 7);; let string3 (x,z,s) = (string_of_domain x ^"\n"^ string_of_domain z ^ "\n" ^ s);; let boolify _ = true;; let report_current = boolify o Report.report_timed o string3;; let report_error = boolify o Report.report_error o string3;; let report_fatal = boolify o Report.report_fatal o string3;; (* let t = [0.1;0.2;0.3;0.4;0.5;0.6] in report_error (t,t,"ok");; *) let periodic_count = let end_count = ref 0 in fun () -> let _ = end_count := !end_count + 1 in (0 = ( !end_count mod 1000));; let check_limit opt depth = let _ = opt.iteration_count <- opt.iteration_count + 1 in ( opt.iteration_count < opt.iteration_limit or opt.iteration_limit = 0 ) && (depth < opt.recursion_depth);; let sgn x = if (x.lo > 0.0) then 1 else if (x.hi < 0.0) then -1 else 0;; let rec same_sgn x y = (x = []) or (sgn (hd x) = sgn (hd y) && same_sgn (tl x) (tl y));; (* has_monotone *) let rec has_monotone opt tf ti domain0 x z x0 z0 is found = match is with | [] -> (x,z,x0,z0,List.rev found) | j::js when (mth x j >= mth z j) -> has_monotone opt tf ti domain0 x z x0 z0 js found | j::js -> let df_int = if opt.raw_int_flag then try evalf0 tf (j + 1) (fst domain0) (snd domain0) with Unstable -> mk_interval (-1.0,1.0) else mk_interval (-1.0, 1.0) in let allpos_df0, allpos_ti = df_int.lo >= opt.eps, lower_partial ti j >= opt.eps in let allneg_df0, allneg_ti = df_int.hi < ~-.(opt.eps), upper_partial ti j < ~-.(opt.eps) in if (allpos_df0 or allpos_ti) then let status = {variable = j + 1; decr_flag = false; df0_flag = allpos_df0; ti_flag = allpos_ti} in if opt.mono_pass && mth z j < mth z0 j then return (Cell_pass_mono ([], status)) else let setj u = table (fun i -> (if i=j then mth z j else mth u i)) in has_monotone opt tf ti domain0 (setj x) (setj z) (setj x0) (setj z0) js (status :: found) else if (allneg_df0 or allneg_ti) then let status = {variable = j + 1; decr_flag = true; df0_flag = allneg_df0; ti_flag = allneg_ti} in if opt.mono_pass && mth x j > mth x0 j then return (Cell_pass_mono ([], status)) else let setj u = table (fun i -> (if i=j then mth x j else mth u i)) in has_monotone opt tf ti domain0 (setj x) (setj z) (setj x0) (setj z0) js (status :: found) else has_monotone opt tf ti domain0 x z x0 z0 js found;; (* loop as long as monotonicity keeps making progress. *) let rec going_strong(x,z,x0,z0,tf,opt,mono) = let (y,w) = center_form (x,z) in let maxwidth = maxl w in let target0 = if opt.raw_int_flag then try evalf0 tf 0 x z with Unstable -> one else one in let _ = target0.hi >= ~-.(opt.eps) or return (Cell_pass (mono, true)) in let target = try evalf tf x z with Unstable -> return (Cell_inconclusive (mono,x,z,x0,z0)) in let _ = upper_bound target >= ~-.(opt.eps) or return (Cell_pass (mono, false)) in let _ = lower_bound target < 0.0 or return Cell_counterexample in let epsilon_width = 1.0e-8 in let _ = (maxwidth >= epsilon_width) or return Cell_counterexample in let (x,z,x0,z0,strong) = if (opt.allow_derivatives) then try has_monotone opt tf target (x,z) x z x0 z0 iter8 [] with Return (Cell_pass_mono (_, status)) -> return (Cell_pass_mono (mono, status)) else (x,z,x0,z0,[]) in if (strong <> []) then going_strong(x,z,x0,z0,tf,opt,mono @ [strong]) else (target,x,z,x0,z0,maxwidth,mono);; (* This procedure is mostly guided by heuristics that don't require formal verification. In particular, no justification is required for tossing out inequalities (since they appear as disjuncts, we can choose which one to prove). Formal verification is required whenever a Cell_passes is issued, and whenever the domain (x,z) is restricted. The record (x0,z0) of the current outer boundary must be restricted to (x,z) whenever an inequality is tossed out. *) let rec verify_cell (x,z,x0,z0,tf,opt) = try ( let _ = not(periodic_count () && !info_print_level >= 2) or report_current (x,z,"periodic report") in let (ti,x,z,x0,z0,maxwidth,mono) = going_strong(x,z,x0,z0,tf,opt,[]) in if opt.convex_flag then Cell_inconclusive_ti (mono,ti,x,z,x0,z0) else Cell_inconclusive (mono,x,z,x0,z0) ) with Return c -> c;; let recursive_verifier (x,z,x0,z0,tf,opt) = let w_init, indices = unzip (filter (fun p -> fst p > 1e-8) (zip (map2 (-.) z x) (1--length x))) in let ws = map2 (-.) z x in let total_vol = itlist ( *. ) w_init 1.0 in let verified_vol = ref 0.0 in let last_report = ref 0 in let compute_vol x z w = let rec compute i indices x z w = match indices with | [] -> 1.0 | (r :: t) when r = i -> let l = hd z -. hd x in (if l > 1e-8 then l else hd w) *. compute (i + 1) t (tl x) (tl z) (tl w) | _ -> compute (i + 1) indices (tl x) (tl z) (tl w) in compute 1 indices x z w in let update_verified_vol x z w = if !info_print_level > 0 then let _ = verified_vol := !verified_vol +. compute_vol x z w in let verified = int_of_float (!verified_vol /. total_vol *. 100.5) in if verified > !last_report then let _ = last_report := verified in report0 (sprintf "%d " !last_report) else () else () in let rec rec_verifier (depth,x,z,x0,z0,w0,tf) = let _ = check_limit opt depth or report_fatal(x,z,Printf.sprintf "depth %d" depth) in let split_and_verify j x z x0 z0 convex_flag = let ( ++ ), ( / ) = up(); upadd, updiv in let yj = (mth x j ++ mth z j) / 2.0 in let delta b v = table (fun i-> if (i = j && b) then yj else mth v i) in let x1, z1 = if convex_flag then x, table (fun i -> if i = j then mth x i else mth z i) else delta false x, delta true z in let x2, z2 = if convex_flag then table (fun i -> if i = j then mth z i else mth x i), z else delta true x, delta false z in let w1 = table (fun i -> if i = j then mth w0 i / 2.0 else mth w0 i) in let r1 = rec_verifier(depth+1,x1,z1,x0,z0,w1,tf) in match r1 with | Result_false t -> Result_false t | _ -> (let r2 = rec_verifier(depth+1,x2,z2,x0,z0,w1,tf) in match r2 with | Result_false t -> Result_false t | _ -> Result_glue (j, convex_flag, r1, r2)) in let add_mono mono r1 = itlist (fun m r -> Result_mono (m, r)) mono r1 in match verify_cell(x,z,x0,z0,tf,opt) with | Cell_counterexample -> Result_false (x,z) | Cell_pass (mono, f0_flag) -> let _ = update_verified_vol x z w0 in add_mono mono (Result_pass (f0_flag,x,z)) | Cell_pass_mono (mono, status) -> let _ = update_verified_vol x z w0 in add_mono mono (Result_pass_mono status) | Cell_inconclusive_ti(mono,ti,x,z,x0,z0) -> let dds = map (fun i -> mth (mth ti.dd i) i, i) iter8 in let convex_dds = filter (fun dd, i -> dd.lo >= opt.eps && mth x i < mth z i) dds in let convex_i = map snd convex_dds in let w2 = List.map2 upsub z x in let convex_flag, ws, ws_i = if convex_dds = [] then false, w2, iter8 else true, map (mth w2) convex_i, convex_i in let maxwidth2 = maxl ws in let j_wide = try( find (fun i -> mth w2 i = maxwidth2) ws_i) with | _ -> failwith "recursive_verifier find" in add_mono mono (split_and_verify j_wide x z x0 z0 convex_flag) | Cell_inconclusive(mono,x,z,x0,z0) -> let w2 = List.map2 upsub z x in let maxwidth2 = maxl w2 in let j_wide = try( find (fun i -> mth w2 i = maxwidth2) iter8) with | _ -> failwith "recursive_verifier find" in add_mono mono (split_and_verify j_wide x z x0 z0 false) in rec_verifier (0,x,z,x0,z0,ws,tf);; end;; hol-light/Formal_ineqs/verifier/interval_m/recurse0.ml000066400000000000000000000141011303454263000234160ustar00rootroot00000000000000(* ============================================================= *) (* OCaml verification procedure (basic interval arithmetic only) *) (* Authors: Thomas C. Hales, Alexey Solovyev *) (* Date: 2012-10-27 *) (* ============================================================= *) (* Recursive verification of inequalities using the basic interval arithmetic only *) needs "verifier/interval_m/recurse.ml";; module Recurse0 = struct open Interval_types;; open Interval;; open Univariate;; open Line_interval;; open Taylor;; open Recurse;; (* has_monotone *) let rec has_monotone0 opt tf domain0 x z x0 z0 is found = match is with | [] -> (x,z,x0,z0,List.rev found) | j::js when (mth x j >= mth z j) -> has_monotone0 opt tf domain0 x z x0 z0 js found | j::js -> let df_int = try evalf0 tf (j + 1) (fst domain0) (snd domain0) with Unstable -> mk_interval (-1.0,1.0) in let allpos_df0 = df_int.lo >= opt.eps in let allneg_df0 = df_int.hi < ~-.(opt.eps) in if allpos_df0 then let status = {variable = j + 1; decr_flag = false; df0_flag = allpos_df0; ti_flag = false} in if opt.mono_pass && mth z j < mth z0 j then return (Cell_pass_mono ([], status)) else let setj u = table (fun i -> (if i=j then mth z j else mth u i)) in has_monotone0 opt tf domain0 (setj x) (setj z) (setj x0) (setj z0) js (status :: found) else if allneg_df0 then let status = {variable = j + 1; decr_flag = true; df0_flag = allneg_df0; ti_flag = false} in if opt.mono_pass && mth x j > mth x0 j then return (Cell_pass_mono ([], status)) else let setj u = table (fun i -> (if i=j then mth x j else mth u i)) in has_monotone0 opt tf domain0 (setj x) (setj z) (setj x0) (setj z0) js (status :: found) else has_monotone0 opt tf domain0 x z x0 z0 js found;; (* loop as long as monotonicity keeps making progress. *) let rec going_strong0(x,z,x0,z0,tf,opt,mono) = let (y,w) = center_form (x,z) in let maxwidth = maxl w in let target0 = try evalf0 tf 0 x z with Unstable -> return (Cell_inconclusive (mono,x,z,x0,z0)) in let _ = target0.hi >= ~-.(opt.eps) or return (Cell_pass (mono, true)) in let epsilon_width = 1.0e-8 in let _ = (maxwidth >= epsilon_width) or return Cell_counterexample in let (x,z,x0,z0,strong) = if (opt.allow_derivatives) then try has_monotone0 opt tf (x,z) x z x0 z0 iter8 [] with Return (Cell_pass_mono (_, status)) -> return (Cell_pass_mono (mono, status)) else (x,z,x0,z0,[]) in if (strong <> []) then going_strong0(x,z,x0,z0,tf,opt,mono @ [strong]) else (x,z,x0,z0,maxwidth,mono);; (* This procedure is mostly guided by heuristics that don't require formal verification. In particular, no justification is required for tossing out inequalities (since they appear as disjuncts, we can choose which one to prove). Formal verification is required whenever a Cell_passes is issued, and whenever the domain (x,z) is restricted. The record (x0,z0) of the current outer boundary must be restricted to (x,z) whenever an inequality is tossed out. *) let rec verify_cell0 (x,z,x0,z0,tf,opt) = try ( let _ = not(periodic_count ()) or report_current (x,z,"periodic report") in let (x,z,x0,z0,maxwidth,mono) = going_strong0(x,z,x0,z0,tf,opt,[]) in if opt.convex_flag then let ti = try evalf tf x z with Unstable -> return (Cell_inconclusive (mono,x,z,x0,z0)) in Cell_inconclusive_ti (mono,ti,x,z,x0,z0) else Cell_inconclusive (mono,x,z,x0,z0) ) with Return c -> c;; let rec recursive_verifier0 (depth,x,z,x0,z0,tf,opt) = let _ = check_limit opt depth or report_fatal(x,z,Printf.sprintf "depth %d" depth) in let split_and_verify j x z x0 z0 convex_flag = let ( ++ ), ( / ) = up(); upadd, updiv in let yj = (mth x j ++ mth z j) / 2.0 in let delta b v = table (fun i-> if (i = j && b) then yj else mth v i) in let x1, z1 = if convex_flag then x, table (fun i -> if i = j then mth x i else mth z i) else delta false x, delta true z in let x2, z2 = if convex_flag then table (fun i -> if i = j then mth z i else mth x i), z else delta true x, delta false z in let r1 = recursive_verifier0(depth+1,x1,z1,x0,z0,tf,opt) in match r1 with | Result_false t -> Result_false t | _ -> (let r2 = recursive_verifier0(depth+1,x2,z2,x0,z0,tf,opt) in match r2 with | Result_false t -> Result_false t | _ -> Result_glue (j, convex_flag, r1, r2)) in let add_mono mono r1 = itlist (fun m r -> Result_mono (m, r)) mono r1 in match verify_cell0(x,z,x0,z0,tf,opt) with | Cell_counterexample -> Result_false (x,z) | Cell_pass (mono, f0_flag) -> add_mono mono (Result_pass (f0_flag,x,z)) | Cell_pass_mono (mono, status) -> add_mono mono (Result_pass_mono status) | Cell_inconclusive_ti(mono,ti,x,z,x0,z0) -> let dds = map (fun i -> mth (mth ti.dd i) i, i) iter8 in let convex_dds = filter (fun dd, i -> dd.lo >= opt.eps && mth x i < mth z i) dds in let convex_i = map snd convex_dds in let w2 = List.map2 upsub z x in let convex_flag, ws, ws_i = if convex_dds = [] then false, w2, iter8 else true, map (mth w2) convex_i, convex_i in let maxwidth2 = maxl ws in let j_wide = try( find (fun i -> mth w2 i = maxwidth2) ws_i) with | _ -> failwith "recursive_verifier find" in add_mono mono (split_and_verify j_wide x z x0 z0 convex_flag) | Cell_inconclusive(mono,x,z,x0,z0) -> let w2 = List.map2 upsub z x in let maxwidth2 = maxl w2 in let j_wide = try( find (fun i -> mth w2 i = maxwidth2) iter8) with | _ -> failwith "recursive_verifier find" in add_mono mono (split_and_verify j_wide x z x0 z0 false);; end;; hol-light/Formal_ineqs/verifier/interval_m/report.ml000066400000000000000000000032301303454263000232020ustar00rootroot00000000000000(* =========================================================== *) (* Report functions *) (* Author: Thomas C. Hales *) (* Date: 2011-08-21 *) (* =========================================================== *) (* port of error.cc basic procedures to print messages to the standard output and to count errors. *) needs "verifier/interval_m/types.ml";; module Report = struct open Interval_types;; let time_string () = Printf.sprintf "time(%.0f)" (Sys.time());; let (get_error_count,reset_error_count,inc_error_count) = let error_count = ref 0 in ((fun _ -> !error_count),(fun _ -> error_count := 0), (fun _ -> error_count:= !error_count + 1));; let (get_corner_count,reset_corner_count,inc_corner_count) = let corner_count = ref 0 in ((fun _ -> !corner_count),(fun _ -> corner_count := 0), (fun _ -> corner_count:= !corner_count + 1));; let diagnostic_string () = let d = get_error_count() in if (d>0) then Printf.sprintf "(errors %d)" (get_error_count()) else "(no errors)";; let report s = Format.print_string s; Format.print_newline(); Format.print_flush();; let report_timed s = report (s^" "^(time_string()));; let report_error = let error_max = 25 in (* was 200, recurse.cc had a separate counter limit at 25 *) fun s -> let ec = get_error_count() in (inc_error_count(); report_timed (Printf.sprintf "error(%d) --\n%s" ec s); Pervasives.ignore(get_error_count() < error_max or raise Fatal));; let report_fatal s = ( inc_error_count(); report_timed ("error --\n"^s); raise Fatal);; end;; hol-light/Formal_ineqs/verifier/interval_m/taylor.ml000066400000000000000000000333511303454263000232100ustar00rootroot00000000000000(* =========================================================== *) (* OCaml taylor intervals *) (* Author: Thomas C. Hales *) (* Date: 2011-08-21 *) (* Modified: Alexey Solovyev, 2012-10-27 *) (* =========================================================== *) (* port of taylor functions, taylor interval *) (* The first part of the file implements basic operations on type taylor_interval. Then a type tfunction is defined that represents a twice continuously differentiable function of six variables. It can be evaluated, which is the taylor_interval data associated with it. Sometimes a tfunction f is used to represent an inequality f < 0. (See recurse.hl. *) needs "verifier/interval_m/line_interval.ml";; needs "verifier/interval_m/univariate.ml";; module Taylor = struct open Interval_types;; open Interval;; open Univariate;; open Line_interval;; (* general utilities *) let m8_sum = let ( + ) = iadd in fun dd1 dd2 -> let r8_sum (x,y) = table (fun i -> mth x i + mth y i) in map r8_sum (zip dd1 dd2);; let center_form(x,z) = let ( + ) , ( - ), ( / ) = up(); upadd,upsub,updiv in let y = table (fun i -> if (mth x i=mth z i) then mth x i else (mth x i + mth z i)/ 2.0) in let w = table (fun i -> max (mth z i - mth y i) (mth y i - mth x i)) in let _ = (minl w >= 0.0) or failwith "centerform" in (y,w);; (* start with taylor interval operations *) let make_taylor_interval (l1,w1,dd1) = {l = l1; w = w1; dd=dd1;};; let ti_add (ti1,ti2) = let _ = (ti1.w = ti2.w) or failwith ("width mismatch in ti") in make_taylor_interval( ladd ti1.l ti2.l,ti1.w, m8_sum ti1.dd ti2.dd);; let ti_scale (ti,t) = make_taylor_interval( smul ti.l t,ti.w, table2 (fun i j -> imul (mth2 ti.dd i j) t));; let taylor_error ti = let ( + ), ( * ) , ( / )= up(); upadd, upmul, updiv in let dot_abs_row r = List.fold_left2 (fun a b c -> a + b * iabs c) 0.0 ti.w r in let dots = map dot_abs_row (ti.dd) in (List.fold_left2 (fun a b c -> a + b * c) 0.0 ti.w dots) / 2.0;; (* (end_itlist ( + ) p) / 2.0 ;; *) let upper_bound ti = let e = taylor_error ti in let ( + ), ( * ) = up(); upadd, upmul in let t = ti.l.f.hi + e in t + List.fold_left2 (fun a b c -> a + b * iabs c) 0.0 ti.w ti.l.df;; let lower_bound ti = let e = taylor_error ti in let ( + ), ( * ),(- ) = down(); downadd,downmul,downsub in let t = ti.l.f.lo - e in t + List.fold_left2 (fun a b c -> a + ( ~-. b) * iabs c) 0.0 ti.w ti.l.df;; let upper_partial ti i = let ( + ), ( * ) = up(); upadd,upmul in let err = List.fold_left2 (fun a b c -> a + b*(max c.hi (~-. (c.lo)))) 0.0 ti.w (mth ti.dd i) in err + Interval.sup ( mth ti.l.df i);; let lower_partial ti i = let ( + ), ( * ), ( - ) = down();downadd,downmul,downsub in let err = List.fold_left2 (fun a b c -> a + b * min c.lo (~-. (c.hi))) 0.0 ti.w (mth ti.dd i) in Interval.inf ( mth ti.l.df i) + err;; let ti_mul (ti1,ti2) = let _ = (ti1.w = ti2.w) or failwith ("ti_mul: width mismatch in ti") in let line = lmul ti1.l ti2.l in let f1_int = let lo, hi = lower_bound ti1, upper_bound ti1 in mk_interval (lo, hi) in let f2_int = let lo, hi = lower_bound ti2, upper_bound ti2 in mk_interval (lo, hi) in let d1_ints = table (fun i -> mk_interval (lower_partial ti1 i, upper_partial ti1 i)) in let d2_ints = table (fun i -> mk_interval (lower_partial ti2 i, upper_partial ti2 i)) in let dd = table2 (fun i j -> let ( + ), ( * ) = iadd, imul in mth2 ti1.dd i j * f2_int + mth d1_ints i * mth d2_ints j + mth d1_ints j * mth d2_ints i + f1_int * mth2 ti2.dd i j) in make_taylor_interval(line, ti1.w, dd);; (* primitive A *) type primitiveA = { f_df : int -> float list -> float list -> interval; hfn : float list -> line; second : float list -> float list -> interval list list; };; let make_primitiveA (f,h1,s1) = {f_df = f; hfn = h1; second = s1; };; let unitA = let zero2 = table2 (fun i j -> zero) in make_primitiveA ( (fun i x z -> if i = 0 then one else zero), (fun y -> line_unit), (fun x z -> zero2) );; let evalf4A pA w x y z = make_taylor_interval( pA.hfn y, w, pA.second x z );; let line_estimateA pA y = pA.hfn y;; (* primitive U *) type primitiveU = { slot: int; uv: univariate; };; let mk_primitiveU s1 uv1 = let _ = (s1 < 8) or failwith (Printf.sprintf "slot %d" s1) in { slot = s1; uv = uv1; };; let line_estimateU p y = let y0 = mth y p.slot in let t = mk_interval(y0,y0) in let d = table (fun i -> if (i=p.slot) then eval p.uv t 1 else zero) in mk_line ( eval p.uv t 0, d );; let evalf4U = let row0 = table (fun i -> zero) in fun p w x y z -> let t = mk_interval(mth x p.slot,mth z p.slot) in let row_slot = table (fun i -> if (i=p.slot) then eval p.uv t 2 else zero) in let dd = table (fun i -> if (i=p.slot) then row_slot else row0) in make_taylor_interval( line_estimateU p y, w, dd );; type tfunction = | Prim_a of primitiveA | Uni of primitiveU | Plus of tfunction * tfunction | Product of tfunction * tfunction | Scale of tfunction * interval | Uni_compose of univariate * tfunction | Composite of tfunction * (* F(g1,g2,g3,g4,g5,g6,g7,g8) *) tfunction *tfunction *tfunction * tfunction *tfunction *tfunction * tfunction *tfunction;; let unit = Prim_a unitA;; let x1 = Uni (mk_primitiveU 0 ux1);; let x2 = Uni (mk_primitiveU 1 ux1);; let x3 = Uni (mk_primitiveU 2 ux1);; let x4 = Uni (mk_primitiveU 3 ux1);; let x5 = Uni (mk_primitiveU 4 ux1);; let x6 = Uni (mk_primitiveU 5 ux1);; let x1x2 = let tab2 = table2 (fun i j -> if (i+j=1) then one else zero) in Prim_a (make_primitiveA( (fun i x z -> let x1 = mk_interval (mth x 0, mth z 0) in let x2 = mk_interval (mth x 1, mth z 1) in if i = 0 then imul x1 x2 else if i = 1 then x2 else if i = 2 then x1 else zero), (fun y -> let u1 = mth y 0 in let u2 = mth y 1 in let x1 = mk_interval(u1,u1) in let x2 = mk_interval(u2,u2) in mk_line( imul x1 x2, table (fun i -> if i=0 then x2 else if i=1 then x1 else zero) )), (fun x z -> tab2)));; let tf_product tf1 tf2 = Composite(x1x2,tf1,tf2,unit,unit,unit,unit,unit,unit);; (* This is one of the most difficult functions in the interval code. It uses the chain rule to compute the second partial derivatives with respect to x(i) x(j), of a function composition F(x1,...,x6) = f(g1(x1,...x6),g2(x1,...x6),...,g6(x1,...x6)). (F i j) = sum {k m} (f k m) (gk i) (gm j) + sum {r} (f r) (gr i j). Fast performance of this function is very important, especially when many of the functions g* are constant. There is a bit of imperative programming here, in computing the sums. Note that ( + ) and ( * ) have different types in various subsections. *) let eval_composite = let rest = () in let sparse_table h f = filter h (List.flatten (table2 f)) in fun hdr p1 p2 p3 p4 p5 p6 p7 p8 w -> let p = [p1;p2;p3;p4;p5;p6;p7;p8] in (* wide and narrow ranges of p *) let (aw,bw) = map (lower_bound) p, map (upper_bound) p in let (a,b) = map (fun p -> p.l.f.lo) p, map (fun p -> p.l.f.hi) p in (* wide and narrow widths from a to b *) let (u,wu,wf) = let ( + ),( - ),( / ) = up();upadd,upsub,updiv in let u = table (fun i -> (mth a i + mth b i) / 2.0) in let wu = table (fun i -> max (mth bw i - mth u i) (mth u i - mth aw i)) in let wf = table (fun i -> max (mth b i - mth u i) (mth u i - mth a i)) in (u,wu,wf) in let (fu:taylor_interval) = hdr wu aw u bw in let fpy = let t = make_taylor_interval(fu.l,wf,fu.dd) in mk_line ( mk_interval(lower_bound t, upper_bound t), table (fun i -> mk_interval(lower_partial t i,upper_partial t i)) ) in (* use chain rule imperatively to compute narrow first derivative *) let df_tmp = Array.create 8 zero in let ( + ) = iadd in let ( * ) = imul in let _ = for j=0 to 7 do let dfj = mth fpy.df j in if is_zero dfj then rest else for i=0 to 7 do let r = mth (mth p j).l.df i in if (is_zero r) then rest else df_tmp.(i) <- df_tmp.(i) + dfj * r; done; done in let lin = mk_line ( fpy.f, Array.to_list df_tmp ) in (* second derivative init *) let fW_partial = table (fun i -> mk_interval(lower_partial fu i,upper_partial fu i)) in let pW_partial = sparse_table (fun (_,_,z) ->not (is_zero z)) (fun k i -> (k,i,(mk_interval(lower_partial (mth p k) i,upper_partial (mth p k) i)))) in (* chain rule 4-nested loop!, but flattened with sparse table *) let dcw = Array.make_matrix 8 8 zero in let _ = for i=0 to 7 do for j=0 to 7 do for k=0 to 7 do if (is_zero (mth2 (mth p k).dd i j)) then rest else dcw.(i).(j) <- dcw.(i).(j) + mth fW_partial k * mth2 ((mth p k).dd) i j ; done; done; done in let len = List.length pW_partial in let _ = for ki = 0 to len-1 do let (k,i,rki) = List.nth pW_partial ki in for mj=0 to len-1 do let (m,j,rmj) = List.nth pW_partial mj in (* Report.report (Printf.sprintf "k i m j rki rmj fuddkm = %d %d %d %d %f %f %f" k i m j rki.lo rmj.lo (mth2 fu.dd k m).lo); *) dcw.(i).(j) <- dcw.(i).(j) + mth2 fu.dd k m * rki * rmj; (* innermost loop *) done; done in let dcw_list = map Array.to_list (Array.to_list dcw) in make_taylor_interval(lin,w,dcw_list);; let rec evalf4 tf w x y z = match tf with | Prim_a p -> evalf4A p w x y z | Uni p -> evalf4U p w x y z | Plus (tf1,tf2) -> ti_add(evalf4 tf1 w x y z, evalf4 tf2 w x y z) | Product (tf1,tf2) -> ti_mul(evalf4 tf1 w x y z, evalf4 tf2 w x y z) | Composite(h,g1,g2,g3,g4,g5,g6,g7,g8) -> let [p1;p2;p3;p4;p5;p6;p7;p8] = map (fun t-> evalf4 t w x y z) [g1;g2;g3;g4;g5;g6;g7;g8] in eval_composite (evalf4 h) p1 p2 p3 p4 p5 p6 p7 p8 w | Scale (tf,t) -> ti_scale ((evalf4 tf w x y z),t) | Uni_compose (uf,tf) -> let ti = evalf4 tf w x y z in let fy = ti.l.f in let u_fy = uf.u fy in let du_fy = uf.du fy in let line = let ( * ) = imul in mk_line (u_fy, table (fun i -> du_fy * mth ti.l.df i)) in let fx = mk_interval (lower_bound ti, upper_bound ti) in let dfx = table (fun i -> mk_interval (lower_partial ti i, upper_partial ti i)) in let du_fx = uf.du fx in let ddu_fx = uf.ddu fx in let dd = table2 (fun i j -> let ( + ), ( * ) = iadd, imul in (ddu_fx * mth dfx j) * mth dfx i + du_fx * mth2 ti.dd j i) in make_taylor_interval(line, w, dd);; (* evalf4 (Composite(Uni (mk_primitiveU 0 uf),tf,unit,unit,unit,unit,unit,unit,unit)) w x y z;; *) let evalf tf x z = let (y,w) = center_form (x,z) in evalf4 tf w x y z;; (* Evaluates a function (i = 0) and its first derivatives (i = 1, 2, ...) at the given interval *) let rec evalf0 tf i x z = match tf with | Prim_a p -> p.f_df i x z | Uni p -> let int = mk_interval (mth x p.slot, mth z p.slot) in if i = 0 then eval p.uv int 0 else if i = p.slot + 1 then eval p.uv int 1 else zero | Plus (tf1, tf2) -> iadd (evalf0 tf1 i x z) (evalf0 tf2 i x z) | Product (tf1, tf2) -> let itf1, itf2 = evalf0 tf1 0 x z, evalf0 tf2 0 x z in if i = 0 then imul itf1 itf2 else let i_df1, i_df2 = evalf0 tf1 i x z, evalf0 tf2 i x z in iadd (imul i_df1 itf2) (imul itf1 i_df2) | Scale (tf, t) -> imul (evalf0 tf i x z) t | Uni_compose (uf, tf) -> let itf = evalf0 tf 0 x z in if i = 0 then eval uf itf 0 else let i_df = evalf0 tf i x z in imul (eval uf itf 1) i_df | Composite (h,g1,g2,g3,g4,g5,g6,g7,g8) -> let gs = [g1;g2;g3;g4;g5;g6;g7;g8] in let ps = map (fun t -> let int = evalf0 t 0 x z in int.lo, int.hi) gs in let x', z' = unzip ps in if i = 0 then evalf0 h 0 x' z' else let dhs = table (fun j -> evalf0 h (j + 1) x' z') in let dgs = map (fun t -> evalf0 t i x z) gs in let ( + ), ( * ) = iadd, imul in itlist2 (fun a b c -> a * b + c) dhs dgs zero;; (* let line_estimate_composite = let ( + ) = iadd in let ( * ) = imul in fun h p1 p2 p3 p4 p5 p6 p7 p8 -> let p = [p1;p2;p3;p4;p5;p6;p7;p8] in let (a,b) = map (fun p -> p.f.lo) p, map (fun p -> p.f.hi) p in let fN = evalf h a b in let fN_partial = table (fun i -> mk_interval(lower_partial fN i,upper_partial fN i)) in let pN_partial =table2(fun i j-> (mth (mth p i).df j)) in let cN_partial2 = table2 (fun i j -> mth fN_partial j * mth2 pN_partial j i) in let cN_partial = map (end_itlist ( + )) cN_partial2 in mk_line ( fN.l.f, cN_partial );; let rec line_estimate tf y = match tf with | Prim_a p -> line_estimateA p y | Uni p -> line_estimateU p y | Plus (p,q) -> ladd (line_estimate p y) (line_estimate q y) | Scale (p,t) -> smul (line_estimate p y) t | Uni_compose (uf,tf) -> line_estimate (Composite(Uni { slot=0; uv=uf; },tf,unit,unit,unit,unit,unit,unit,unit)) y | Composite(h,g1,g2,g3,g4,g5,g6,g7,g8) -> let [p1;p2;p3;p4;p5;p6;p7;p8] = map (fun t-> line_estimate t y) [g1;g2;g3;g4;g5;g6;g7;g8] in line_estimate_composite h p1 p2 p3 p4 p5 p6 p7 p8;; *) end;; hol-light/Formal_ineqs/verifier/interval_m/types.ml000066400000000000000000000027061303454263000230420ustar00rootroot00000000000000(* =========================================================== *) (* Declaration of types and exceptions *) (* Author: Thomas C. Hales *) (* Date: 2011-08-21 *) (* =========================================================== *) module Interval_types = struct exception Unstable;; (* generally thrown when there is a divide by zero *) exception Fatal;; (* generally indicates an uncorrected bug *) (* represents a closed interval [lo,hi] of the real line *) type interval = { lo : float; hi : float; };; (* represents a function u:real->real, its derivative du, and 2nd derivative *) type univariate = { u : interval -> interval; du : interval -> interval; ddu : interval -> interval; };; (* represents the value f of function of six variables at some point y. and the value df of its six partial derivatives, evaluated at the same point y. The length of the list df should always be 8. *) type line = { f : interval; df : (interval) list; };; (* represents approximation data for a function f on a rectangular domain [x,z]. l gives the value and partial derivatives of f at some point y in the domain. dd gives interval bounds on the second derivatives over the entire domain. w i is an upper bound on widths (z i - y i) and (y i - x i). *) type taylor_interval = { l : line; w : float list; dd : interval list list; };; end;; hol-light/Formal_ineqs/verifier/interval_m/univariate.ml000066400000000000000000000043551303454263000240470ustar00rootroot00000000000000(* =========================================================== *) (* OCaml univariate functions *) (* Author: Thomas C. Hales *) (* Date: 2011-08-21 *) (* =========================================================== *) (* port of univariate.cc a univariate represents a function u:real->real. its first derivative du:real->real and its second derivative ddu;real->real. For example, if the function is x |-> x, its derivative is x |-> 1, and second derivative is x |-> 0, which is implemented as ux1. We give a few other examples, sqrt, 1/x, atan. *) needs "verifier/interval_m/interval.ml";; module Univariate = struct open Interval_types;; open Interval;; let eval uni x = function | 0 -> uni.u x | 1 -> uni.du x | _ -> uni.ddu x;; let mk_univariate (u1,du1,ddu1) = { u = u1; du = du1; ddu = ddu1; };; let raise_zero x = bounded_from_zero x or raise Unstable ;; (* here are a couple of examples *) let ux1 = mk_univariate( (fun x -> x), (fun x -> one), (fun x-> zero) );; let usqrt = let ( / ) = idiv in let ( * ) = imul in mk_univariate( isqrt, (fun x -> let _ = raise_zero x in one / (two * isqrt x)), (fun x -> let _ = raise_zero x in ineg (one / ((two * isqrt x) * (two * x)))) );; let uinv = let ( / ) = idiv in let ( * ) = imul in mk_univariate( (fun x -> let _ = raise_zero x in one / x), (fun x -> let _ = raise_zero x in ineg (one / ( x * x))), (fun x -> let _ = raise_zero x in two / ( x * (x * x))) );; let uatan = let ( / ) = idiv in let ( * ) = imul in let ( + ) = iadd in mk_univariate( iatan, (fun x -> one / (one + x * x)), (fun x -> let t = one / (one + x * x) in (ineg two * x) * (t * t)) );; let uacos = let ( / ) = idiv in let ( * ) = imul in let ( - ) = isub in mk_univariate( iacos, (fun x -> ineg (one / isqrt (one - x * x))), (fun x -> let t = one - x * x in ineg (x / isqrt (t * t * t))) );; end;; hol-light/Formal_ineqs/verifier/interval_m/verifier.ml000066400000000000000000000240731303454263000235120ustar00rootroot00000000000000(* =========================================================== *) (* OCaml verification and result transformation functions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "verifier/interval_m/recurse.ml";; needs "verifier/interval_m/recurse0.ml";; module Verifier = struct open Interval_types;; open Interval;; open Univariate;; open Line_interval;; open Taylor;; open Recurse;; type certificate_stats = { pass : int; pass_raw : int; pass_mono : int; mono : int; glue : int; glue_convex : int; };; let dummy_stats = { pass = 0; pass_raw = 0; pass_mono = 0; mono = 0; glue = 0; glue_convex = 0; };; (**********************************) let run_test f x z min_flag min_max allow_d convex_flag mono_pass_flag raw_int_flag eps = let pad = replicate 0.0 (8 - length x) in let xx = x @ pad and zz = z @ pad in let mone = mk_interval(-1.0,-1.0) in let neg_f = Scale(f, mone) in let ff = if min_flag then Plus(neg_f, Scale(unit,mk_interval(min_max, min_max))) else Plus(f, Scale(unit, ineg (mk_interval(min_max, min_max)))) in let opt = { only_check_deriv1_negative = false; is_using_dihmax =false; is_using_bigface126 =false; width_cutoff =0.05; allow_sharp =false; allow_derivatives =allow_d; iteration_count =0; iteration_limit =0; recursion_depth =200; mono_pass = mono_pass_flag; convex_flag = convex_flag; raw_int_flag = raw_int_flag; eps = eps; } in recursive_verifier(xx,zz,xx,zz,ff,opt);; (* A verification procedure which uses raw interval arithmetic only *) (* open Recurse0;; let run_test0 f x z min_flag min_max allow_d convex_flag mono_pass_flag eps = let pad = replicate 0.0 (8 - length x) in let xx = x @ pad and zz = z @ pad in let mone = mk_interval(-1.0,-1.0) in let neg_f = Scale(f, mone) in let ff = if min_flag then Plus(neg_f, Scale(unit,mk_interval(min_max, min_max))) else Plus(f, Scale(unit, ineg (mk_interval(min_max, min_max)))) in let opt = { only_check_deriv1_negative = false; is_using_dihmax =false; is_using_bigface126 =false; width_cutoff =0.05; allow_sharp =false; allow_derivatives =allow_d; iteration_count =0; iteration_limit =0; recursion_depth =200; mono_pass = mono_pass_flag; convex_flag = convex_flag; raw_int_flag = true; eps = eps; } in recursive_verifier0(0,xx,zz,xx,zz,ff,opt);; *) (****************************************) let domain_str x z = let s1 = map string_of_float x and s2 = map string_of_float z in sprintf "[%s], [%s]" (String.concat "; " s1) (String.concat "; " s2);; let path_str p = String.concat "," (map (fun s, j -> sprintf "%s(%d)" s j) p);; (* get_results0 *) (* This function finds all subtrees of the given solution tree which can be veified immediately (no Result_pass_mono). These subtrees are added to the accumulator. Paths to the roots of all subtrees are also saved in the accumulator. The third returned value is a solution tree where all found subtrees are replaced with Result_pass_ref j, with j = #of the corresponding subtree in the accumulator (1-based) *) let get_results0 path r acc = let dummy_tree = Result_false ([], []) in let is_ref r = match r with Result_pass_ref _ -> true | _ -> false in let rec get_rec path r acc = match r with | Result_mono (mono, r1) -> let get_m m = (if m.decr_flag then "ml" else "mr"), m.variable in let path' = rev_itlist (fun m l -> get_m m :: l) mono path in let flag, acc', tree = get_rec path' r1 acc in if flag then true, acc', dummy_tree else false, acc', Result_mono (mono, tree) | Result_glue (j, convex_flag, r1, r2) -> let s1, s2 = if convex_flag then "ml", "mr" else "l", "r" in let p1, p2 = ((s1, j + 1) :: path), ((s2, j + 1) :: path) in let flag1, acc1, tree1 = get_rec p1 r1 acc in let flag2, acc', tree2 = get_rec p2 r2 acc1 in let n = (length acc' + 1) in if flag1 then if flag2 then true, acc', dummy_tree else if is_ref r1 then false, acc', Result_glue (j, convex_flag, r1, tree2) else false, acc' @ [rev p1, r1], Result_glue (j, convex_flag, Result_pass_ref n, tree2) else if flag2 then if is_ref r2 then false, acc', Result_glue (j, convex_flag, tree1, r2) else false, acc' @ [rev p2, r2], Result_glue (j, convex_flag, tree1, Result_pass_ref n) else false, acc', Result_glue (j, convex_flag, tree1, tree2) | Result_pass_mono _ -> false, acc, r | _ -> true, acc, dummy_tree in get_rec path r acc;; (* transform_result *) let transform_result x z r = (* get_domain *) (* Subdivides the given domain (x,z) according to the given path *) let domain_hash = Hashtbl.create 1000 in let find_hash, mem_hash, add_hash = Hashtbl.find domain_hash, Hashtbl.mem domain_hash, Hashtbl.add domain_hash in let get_domain path = let n = length x in let table f = map f (0--(n - 1)) in let rec rec_domain (x, z) path hash = match path with | [] -> x, z | (s, j) :: ps -> let hash' = hash^s^(string_of_int j) in if mem_hash hash' then rec_domain (find_hash hash') ps hash' else let j = j - 1 in let domain' = if s = "l" or s = "r" then let ( ++ ), ( / ) = up(); upadd, updiv in let yj = (mth x j ++ mth z j) / 2.0 in let delta b v = table (fun i -> if i = j && b then yj else mth v i) in if s = "l" then delta false x, delta true z else delta true x, delta false z else if s = "ml" then x, table (fun i -> if i = j then mth x i else mth z i) else table (fun i -> if i = j then mth z i else mth x i), z in let _ = add_hash hash' domain' in rec_domain domain' ps hash' in rec_domain (x,z) path "" in (* sub_domain *) (* Verifies if interval [x',z'] SUBSET interval [x,z] *) let sub_domain (x',z') (x,z) = let le a b = itlist2 (fun a b c -> c & (a <= b)) a b true in le x x' & le z' z in (* transform_pass_mono *) (* Replaces all (Result_pass_mono m) with (Result_mono [m] (Result_ref j)) where j is the reference to the corresponding domain *) let transform_pass_mono x z domains r = let domains_i = zip domains (1--length domains) in let find_domain x' z' = try find (fun d, _ -> sub_domain (x', z') d) domains_i with Failure _ -> (x,z), -1 in let get_m m = (if m.decr_flag then "ml" else "mr"), m.variable in let rec rec_transform path r = match r with | Result_mono (mono, r1) -> let path' = rev_itlist (fun m l -> get_m m :: l) mono path in Result_mono (mono, rec_transform path' r1) | Result_glue (j, convex_flag, r1, r2) -> let s1, s2 = if convex_flag then "ml", "mr" else "l", "r" in let p1, p2 = ((s1, j + 1) :: path), ((s2, j + 1) :: path) in let t1 = rec_transform p1 r1 in let t2 = rec_transform p2 r2 in Result_glue (j, convex_flag, t1, t2) | Result_pass_mono m -> let path' = rev (get_m m :: path) in let x', z' = get_domain path' in let _, i = find_domain x' z' in (* let _ = report (sprintf "p = %s, d = %s, found: %d" (domain_str x' z') (path_str path') i) in *) if i >= 0 then Result_mono ([m], Result_pass_ref (-i)) else r | _ -> r in rec_transform [] r in let rec transform acc r = let flag, rs, r' = get_results0 [] r acc in if flag then (rs @ [[], r]) else let domains = map (fun p, _ -> get_domain p) rs in let r_next = transform_pass_mono x z domains r' in let _ = r_next <> r' or failwith "transform_result: deadlock" in transform rs r_next in transform [] r;; (* Computes result statistics *) let result_stats result = let pass = ref 0 and mono = ref 0 and glue = ref 0 and pass_mono = ref 0 and pass_raw = ref 0 and glue_convex = ref 0 in let rec count r = match r with | Result_false _ -> failwith "False result" | Result_pass (flag, _, _) -> pass := !pass + 1; if flag then pass_raw := !pass_raw + 1 else () | Result_pass_mono _ -> pass_mono := !pass_mono + 1 | Result_mono (_, r1) -> mono := !mono + 1; count r1 | Result_glue (_, flag, r1, r2) -> glue := !glue + 1; if flag then glue_convex := !glue_convex + 1 else (); count r1; count r2 in let _ = count result in {pass = !pass; pass_raw = !pass_raw; pass_mono = !pass_mono; mono = !mono; glue = !glue; glue_convex = !glue_convex};; let report_stats stats = let s = sprintf "pass = %d (pass_raw = %d)\nmono = %d\nglue = %d (glue_convex = %d)\npass_mono = %d" stats.pass stats.pass_raw stats.mono stats.glue stats.glue_convex stats.pass_mono in report s;; let result_p_stats glue_flag p_result = let p_table = Hashtbl.create 10 in let add1 p = let c = if Hashtbl.mem p_table p then Hashtbl.find p_table p else 0 in Hashtbl.replace p_table p (succ c) in let rec count r = match r with | P_result_ref _ -> () | P_result_pass (pp, _) -> add1 pp.pp | P_result_mono (pp, _, r1) -> add1 pp.pp; count r1 | P_result_glue (pp, _, _, r1, r2) -> if glue_flag then add1 pp.pp else (); count r1; count r2 in let _ = count p_result in let s = Hashtbl.fold (fun p c s -> (sprintf "p = %d: %d\n" p c) ^ s) p_table "" in report s;; end;; hol-light/Formal_ineqs/verifier/m_verifier.hl000066400000000000000000001500211303454263000216520ustar00rootroot00000000000000(* =========================================================== *) (* Formal verification functions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "taylor/m_taylor.hl";; needs "verifier/interval_m/verifier.ml";; needs "misc/vars.hl";; needs "verifier_options.hl";; module M_verifier = struct open Arith_misc;; open Arith_float;; open M_taylor;; open Misc_vars;; open Verifier_options;; type verification_funs = { (* p_lin -> p_second -> domain_th -> taylor_th *) taylor : int -> int -> thm -> thm; (* pp -> lo -> hi -> interval_th *) f : int -> term -> term -> thm; (* i -> pp -> lo -> hi -> interval_th *) df : int -> int -> term -> term -> thm; (* i -> j -> pp -> lo -> hi -> interval_th *) ddf : int -> int -> int -> term -> term -> thm; (* lo -> hi -> diff2_th *) diff2_f : term -> term -> thm; };; let mk_real_vars n name = map (fun i -> mk_var (sprintf "%s%d" name i, real_ty)) (1--n);; (*************************************) let BOUNDED_INTERVAL_ARITH_IMP_HI' = (MY_RULE o prove) (`(!x. x IN interval [domain] ==> interval_arith (f x) (lo, hi)) ==> (!x. x IN interval [domain] ==> f x <= hi)`, SIMP_TAC[interval_arith]);; let BOUNDED_INTERVAL_ARITH_IMP_LO' = (MY_RULE o prove) (`(!x. x IN interval [domain] ==> interval_arith (f x) (lo, hi)) ==> (!x. x IN interval [domain] ==> lo <= f x)`, SIMP_TAC[interval_arith]);; let eval_interval_arith_hi n bound_th = let tm0 = (snd o dest_forall o concl) bound_th in let int_tm, concl_tm = dest_comb tm0 in let domain_tm = (rand o rator o rand o rand o rand) int_tm in let ltm, bounds_tm = dest_interval_arith concl_tm in let f_tm, (lo_tm, hi_tm) = rator ltm, dest_pair bounds_tm in let f_var = mk_var ("f", type_of f_tm) and domain_var = mk_var ("domain", type_of domain_tm) in (MY_PROVE_HYP bound_th o INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real; lo_tm, lo_var_real] o inst_first_type_var n_type_array.(n)) BOUNDED_INTERVAL_ARITH_IMP_HI';; let eval_interval_arith_lo n bound_th = let tm0 = (snd o dest_forall o concl) bound_th in let int_tm, concl_tm = dest_comb tm0 in let domain_tm = (rand o rator o rand o rand o rand) int_tm in let ltm, bounds_tm = dest_interval_arith concl_tm in let f_tm, (lo_tm, hi_tm) = rator ltm, dest_pair bounds_tm in let f_var = mk_var ("f", type_of f_tm) and domain_var = mk_var ("domain", type_of domain_tm) in (MY_PROVE_HYP bound_th o INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real; lo_tm, lo_var_real] o inst_first_type_var n_type_array.(n)) BOUNDED_INTERVAL_ARITH_IMP_LO';; (*************************************) (* subdomains *) let eval_subset_trans = let SUBSET_TRANS' = MY_RULE SUBSET_TRANS in fun st_th tu_th -> let ltm, t_tm = dest_comb (concl st_th) in let s_tm = rand ltm and u_tm = rand (concl tu_th) in let ty = (hd o snd o dest_type o type_of) s_tm and s_var = mk_var ("s", type_of s_tm) and t_var = mk_var ("t", type_of t_tm) and u_var = mk_var ("u", type_of u_tm) in (MY_PROVE_HYP st_th o MY_PROVE_HYP tu_th o INST[s_tm, s_var; t_tm, t_var; u_tm, u_var] o inst_first_type_var ty) SUBSET_TRANS';; let eval_subset_refl = let SUBSET_REFL' = MY_RULE SUBSET_REFL in fun s_tm -> let ty = (hd o snd o dest_type o type_of) s_tm and s_var = mk_var ("s", type_of s_tm) in (INST[s_tm, s_var] o inst_first_type_var ty) SUBSET_REFL';; let SUBSET_INTERVAL_IMP = prove(`!a b c d. (!i. i IN 1..dimindex (:N) ==> a$i <= c$i /\ d$i <= b$i) ==> interval [c:real^N,d] SUBSET interval [a,b]`, SIMP_TAC[SUBSET_INTERVAL; GSYM IN_NUMSEG]);; let gen_subset_interval_lemma n = let a_vars = mk_real_vars n "a" and b_vars = mk_real_vars n "b" and c_vars = mk_real_vars n "c" and d_vars = mk_real_vars n "d" in let a_tm = mk_vector_list a_vars and b_tm = mk_vector_list b_vars and c_tm = mk_vector_list c_vars and d_tm = mk_vector_list d_vars in let th0 = (SPEC_ALL o ISPECL [a_tm; b_tm; c_tm; d_tm]) SUBSET_INTERVAL_IMP in let th1 = REWRITE_RULE[dimindex_array.(n); IN_NUMSEG; gen_in_interval n; ARITH] th0 in let th2 = REWRITE_RULE (Array.to_list comp_thms_array.(n)) th1 in MY_RULE th2;; let subset_interval_thms_array = Array.init (max_dim + 1) (fun n -> if n < 1 then TRUTH else gen_subset_interval_lemma n);; let m_subset_interval n a_tm b_tm c_tm d_tm = let a_vars = mk_real_vars n "a" and b_vars = mk_real_vars n "b" and c_vars = mk_real_vars n "c" and d_vars = mk_real_vars n "d" in let a_s = dest_vector a_tm and b_s = dest_vector b_tm and c_s = dest_vector c_tm and d_s = dest_vector d_tm in let th0 = (INST (zip a_s a_vars) o INST (zip b_s b_vars) o INST (zip c_s c_vars) o INST (zip d_s d_vars)) subset_interval_thms_array.(n) in let prove_le tm = let ltm, rtm = dest_binop le_op_real tm in EQT_ELIM (float_le ltm rtm) in let hyp_ths = map prove_le (hyp th0) in itlist (fun hyp_th th -> MY_PROVE_HYP hyp_th th) hyp_ths th0;; (*************************************) let M_RESTRICT_RIGHT_LEMMA = prove(`!j x z y w u y' w'. m_cell_domain (x:real^N,z) y w /\ (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i /\ y'$i = y$i /\ w'$i = w$i) /\ u$j = z$j /\ y'$j = z$j /\ w'$j = &0 ==> m_cell_domain (u,z) y' w' /\ interval [u,z] SUBSET interval [x,z]`, REWRITE_TAC[m_cell_domain; SUBSET_INTERVAL; GSYM IN_NUMSEG] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[REAL_LE_REFL; REAL_SUB_REFL; real_max]; ALL_TAC ] THEN REPEAT (FIRST_ASSUM (new_rewrite [] []) THEN ASM_REWRITE_TAC[]); ALL_TAC ] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[REAL_LE_REFL] THEN REPEAT (FIRST_X_ASSUM (MP_TAC o SPEC `j:num`)) THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC ] THEN REPEAT (FIRST_ASSUM (new_rewrite [] [])) THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; let M_RESTRICT_LEFT_LEMMA = prove(`!j x z y w u y' w'. m_cell_domain (x:real^N,z) y w /\ (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i /\ y'$i = y$i /\ w'$i = w$i) /\ u$j = x$j /\ y'$j = x$j /\ w'$j = &0 ==> m_cell_domain (x,u) y' w' /\ interval [x,u] SUBSET interval [x,z]`, REWRITE_TAC[m_cell_domain; SUBSET_INTERVAL; GSYM IN_NUMSEG] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[REAL_LE_REFL; REAL_SUB_REFL; real_max]; ALL_TAC ] THEN REPEAT (FIRST_ASSUM (new_rewrite [] []) THEN ASM_REWRITE_TAC[]); ALL_TAC ] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[REAL_LE_REFL] THEN REPEAT (FIRST_X_ASSUM (MP_TAC o SPEC `j:num`)) THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC ] THEN REPEAT (FIRST_ASSUM (new_rewrite [] [])) THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; let gen_restrict_lemma n j left_flag = let xs = mk_real_vars n "x" and zs = mk_real_vars n "z" and ys = mk_real_vars n "y" and ws = mk_real_vars n "w" and j_tm = mk_small_numeral j in let a, b = if left_flag then zs, xs else xs, zs in let x_tm = mk_vector_list xs and z_tm = mk_vector_list zs and y_tm = mk_vector_list ys and w_tm = mk_vector_list ws and u_tm = mk_vector_list (map (fun i -> List.nth (if i = j then b else a) (i - 1)) (1--n)) and y'_tm = mk_vector_list (map (fun i -> List.nth (if i = j then b else ys) (i - 1)) (1--n)) and w'_tm = mk_vector_list (map (fun i -> if i = j then `&0` else List.nth ws (i - 1)) (1--n)) in let th0 = (SPEC_ALL o ISPECL [j_tm; x_tm; z_tm; y_tm; w_tm; u_tm; y'_tm; w'_tm]) (if left_flag then M_RESTRICT_LEFT_LEMMA else M_RESTRICT_RIGHT_LEMMA) in let th1 = REWRITE_RULE[dimindex_array.(n); IN_NUMSEG; gen_in_interval n; ARITH] th0 in let th2 = REWRITE_RULE (Array.to_list comp_thms_array.(n)) th1 in MY_RULE_FLOAT th2;; let left_restrict_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_restrict_lemma n j true));; let right_restrict_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_restrict_lemma n j false));; (******************************) (* m_cell_pass *) let m_cell_pass = new_definition `m_cell_pass f domain <=> (!x. x IN interval [domain] ==> f x < &0)`;; let dest_m_cell_pass pass_tm = let ltm, domain = dest_comb pass_tm in rand ltm, domain;; (*********************************) let M_CELL_PASS_LEMMA = prove(`(!x. x IN interval [domain] ==> f x <= hi) /\ (hi < &0 <=> T) ==> m_cell_pass f domain`, REWRITE_TAC[m_cell_pass] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `hi:real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let M_CELL_PASS_LEMMA' = MY_RULE M_CELL_PASS_LEMMA;; let M_CELL_PASS_INTERVAL_LEMMA' = (MY_RULE o prove) (`(!x. x IN interval [domain] ==> interval_arith (f x) (lo, hi)) /\ hi < &0 ==> m_cell_pass f domain`, REWRITE_TAC[interval_arith] THEN STRIP_TAC THEN MATCH_MP_TAC M_CELL_PASS_LEMMA THEN ASM_SIMP_TAC[]);; let M_CELL_PASS_SUBSET' = (MY_RULE o prove)(`m_cell_pass f domain /\ interval [domain2] SUBSET interval [domain] ==> m_cell_pass f domain2`, REWRITE_TAC[m_cell_pass; SUBSET] THEN REPEAT STRIP_TAC THEN REPEAT (FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[]);; (* m_cell_pass with taylor_interval *) let m_taylor_cell_pass n pp m_taylor_th = let upper_th = eval_m_taylor_upper_bound n pp m_taylor_th in let tm0 = (snd o dest_forall o concl) upper_th in let int_tm, concl_tm = dest_comb tm0 in let domain_tm = (rand o rator o rand o rand o rand) int_tm in let ltm, hi_tm = dest_comb concl_tm in let f_tm = (rator o rand) ltm in let f_var = mk_var ("f", type_of f_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let hi_lt0_th = float_lt0 hi_tm in if (fst o dest_const o rand o concl) hi_lt0_th = "F" then failwith "m_taylor_cell_pass: hi < &0 <=> F" else (MY_PROVE_HYP upper_th o MY_PROVE_HYP hi_lt0_th o INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real] o inst_first_type_var n_type_array.(n)) M_CELL_PASS_LEMMA';; (* m_cell_pass with a raw interval *) let m_taylor_cell_pass0 n bound_th = let tm0 = (snd o dest_forall o concl) bound_th in let int_tm, concl_tm = dest_comb tm0 in let domain_tm = (rand o rator o rand o rand o rand) int_tm in let ltm, bounds_tm = dest_interval_arith concl_tm in let f_tm, (lo_tm, hi_tm) = rator ltm, dest_pair bounds_tm in let f_var = mk_var ("f", type_of f_tm) and domain_var = mk_var ("domain", type_of domain_tm) in let hi_lt0_th = try EQT_ELIM (float_lt0 hi_tm) with Failure _ -> failwith "m_taylor_cell_pass0" in (MY_PROVE_HYP bound_th o MY_PROVE_HYP hi_lt0_th o INST[f_tm, f_var; domain_tm, domain_var; hi_tm, hi_var_real; lo_tm, lo_var_real] o inst_first_type_var n_type_array.(n)) M_CELL_PASS_INTERVAL_LEMMA';; (**********************) let M_CELL_PASS_SUBDOMAIN' = (MY_RULE o prove)(`interval [domain2] SUBSET interval [domain] /\ m_cell_pass f domain ==> m_cell_pass f domain2`, REWRITE_TAC[m_cell_pass; SUBSET] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);; let m_cell_pass_subdomain domain2_tm pass_th = let f_tm, domain_tm = dest_m_cell_pass (concl pass_th) in let f_var = mk_var ("f", type_of f_tm) and domain_var = mk_var ("domain", type_of domain_tm) and domain2_var = mk_var ("domain2", type_of domain2_tm) in let a, b = dest_pair domain_tm and c, d = dest_pair domain2_tm in let n = get_dim a in let sub_th = m_subset_interval n a b c d in (MY_PROVE_HYP sub_th o MY_PROVE_HYP pass_th o INST[domain_tm, domain_var; domain2_tm, domain2_var; f_tm, f_var] o inst_first_type_var n_type_array.(n)) M_CELL_PASS_SUBDOMAIN';; (******************************) let M_CELL_PASS_GLUE_LEMMA = prove(`!j x z v u f. (!i. 1 <= i /\ i <= dimindex (:N) ==> ~(i = j) ==> u$i = x$i /\ v$i = z$i) ==> v$j = u$j ==> m_cell_pass f (x,v) ==> m_cell_pass f (u,z) ==> m_cell_pass f (x,z:real^N)`, REWRITE_TAC[m_cell_pass; IN_INTERVAL] THEN REPEAT GEN_TAC THEN move ["eq1"; "eq_vu"; "cell1"; "cell2"; "y"; "ineq"] THEN ASM_CASES_TAC `(y:real^N)$j <= (v:real^N)$j` THENL [ REMOVE_THEN "cell1" MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN USE_THEN "ineq" (new_rewrite [] []) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i = j:num` THENL [ REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN SIMP_TAC[]; ALL_TAC ] THEN USE_THEN "eq1" (new_rewrite [] []) THEN ASM_REWRITE_TAC[] THEN USE_THEN "ineq" (new_rewrite [] []) THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN POP_ASSUM (ASSUME_TAC o MATCH_MP (REAL_ARITH `~(a <= b) ==> b <= a:real`)) THEN REMOVE_THEN "cell2" MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN USE_THEN "ineq" (new_rewrite [] []) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[] THEN USE_THEN "eq_vu" (fun th -> REWRITE_TAC[SYM th]) THEN REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN SIMP_TAC[]; ALL_TAC ] THEN USE_THEN "eq1" (new_rewrite [] []) THEN ASM_REWRITE_TAC[] THEN USE_THEN "ineq" (new_rewrite [] []) THEN ASM_REWRITE_TAC[]);; let gen_glue_lemma n j = let mk_vars name = map (fun i -> mk_var (sprintf "%s%d" name i, real_ty)) (1--n) in let xs = mk_vars "x" and zs = mk_vars "z" and t_var = mk_var ("t", real_ty) and j_tm = mk_small_numeral j in let x_tm = mk_vector_list xs and z_tm = mk_vector_list zs and v_tm = mk_vector_list (map (fun i -> if i = j then t_var else List.nth zs (i - 1)) (1--n)) and u_tm = mk_vector_list (map (fun i -> if i = j then t_var else List.nth xs (i - 1)) (1--n)) in let th0 = (SPEC_ALL o ISPECL [j_tm; x_tm; z_tm; v_tm; u_tm]) M_CELL_PASS_GLUE_LEMMA in let th1 = REWRITE_RULE[dimindex_array.(n); gen_in_interval n; ARITH] th0 in let th2 = REWRITE_RULE (Array.to_list comp_thms_array.(n)) th1 in MY_RULE th2;; let glue_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_glue_lemma n j));; (***************************************) let M_CELL_SUP = prove(`!f x z. lift o f continuous_on interval [x,z:real^N] /\ m_cell_pass f (x,z) ==> ?a. a < &0 /\ !y. y IN interval [x,z] ==> f y <= a`, REWRITE_TAC[m_cell_pass] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval [x:real^N,z] = {}` THENL [ EXISTS_TAC `-- &1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REAL_ARITH_TAC; ALL_TAC ] THEN MP_TAC (SPECL [`f:real^N->real`; `interval [x,z:real^N]`] CONTINUOUS_ATTAINS_SUP) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN DISCH_THEN (X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^N->real) y` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let DIFF2_DOMAIN_IMP_CONTINUOUS_ON = prove(`!(f:real^N->real) domain. diff2_domain domain f ==> lift o f continuous_on interval [domain]`, REWRITE_TAC[diff2_domain] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN MATCH_MP_TAC diff2_imp_diff THEN ASM_SIMP_TAC[]);; let M_CELL_INCREASING_PASS_LEMMA = prove(`!j x z u domain lo f. interval [x,z] SUBSET interval [domain] ==> diff2c_domain domain f ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = x$i) ==> u$j = z$j ==> &0 <= lo ==> (!y. y IN interval [domain] ==> lo <= partial j f y) ==> m_cell_pass f (u,z) ==> m_cell_pass f (x,z:real^N)`, REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[m_cell_pass] THEN X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `~(!i. i IN 1..dimindex (:N) ==> (x:real^N)$i <= (z:real^N)$i)` THENL [ POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_INTERVAL; GSYM IN_NUMSEG] THEN DISCH_THEN (CHOOSE_THEN STRIP_ASSUME_TAC) THEN DISCH_THEN (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC ] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[negbK] THEN DISCH_TAC THEN SUBGOAL_THEN `diff2_domain domain (f:real^N->real)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN SIMP_TAC[diff2_domain; diff2c_domain; diff2c]; ALL_TAC ] THEN MP_TAC (SPECL [`f:real^N->real`; `u:real^N`; `z:real^N`] M_CELL_SUP) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF2_DOMAIN_IMP_CONTINUOUS_ON THEN UNDISCH_TAC `diff2_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2_domain] THEN REPEAT STRIP_TAC THEN REPEAT (FIRST_X_ASSUM MATCH_MP_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM (new_rewrite [] []) THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC ] THEN DISCH_THEN (CHOOSE_THEN STRIP_ASSUME_TAC) THEN DISCH_TAC THEN MP_TAC (SPECL [`f:real^N->real`; `j:num`; `u:real^N`; `x:real^N`; `z:real^N`; `a:real`] partial_increasing_right) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN MATCH_MP_TAC diff2_imp_diff THEN UNDISCH_TAC `diff2_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2_domain] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `lo:real` THEN ASM_REWRITE_TAC[] THEN REPEAT (FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]); ALL_TAC ] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let M_CELL_DECREASING_PASS_LEMMA = prove(`!j x z u domain hi f. interval [x,z] SUBSET interval [domain] ==> diff2c_domain domain f ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i) ==> u$j = x$j ==> hi <= &0 ==> (!y. y IN interval [domain] ==> partial j f y <= hi) ==> m_cell_pass f (x,u) ==> m_cell_pass f (x,z:real^N)`, REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[m_cell_pass] THEN X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `~(!i. i IN 1..dimindex (:N) ==> (x:real^N)$i <= (z:real^N)$i)` THENL [ POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_INTERVAL; GSYM IN_NUMSEG] THEN DISCH_THEN (CHOOSE_THEN STRIP_ASSUME_TAC) THEN DISCH_THEN (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC ] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[negbK] THEN DISCH_TAC THEN SUBGOAL_THEN `diff2_domain domain (f:real^N->real)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain domain (f:real^N->real)` THEN SIMP_TAC[diff2_domain; diff2c_domain; diff2c]; ALL_TAC ] THEN MP_TAC (SPECL [`f:real^N->real`; `x:real^N`; `u:real^N`] M_CELL_SUP) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF2_DOMAIN_IMP_CONTINUOUS_ON THEN UNDISCH_TAC `diff2_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2_domain] THEN REPEAT STRIP_TAC THEN REPEAT (FIRST_X_ASSUM MATCH_MP_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM (new_rewrite [] []) THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC ] THEN DISCH_THEN (CHOOSE_THEN STRIP_ASSUME_TAC) THEN DISCH_TAC THEN MP_TAC (SPECL [`f:real^N->real`; `j:num`; `u:real^N`; `x:real^N`; `z:real^N`; `a:real`] partial_decreasing_left) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN MATCH_MP_TAC diff2_imp_diff THEN UNDISCH_TAC `diff2_domain domain (f:real^N->real)` THEN REWRITE_TAC[diff2_domain] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC ] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `hi:real` THEN ASM_REWRITE_TAC[] THEN REPEAT (FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]); ALL_TAC ] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let M_CELL_CONVEX_PASS_LEMMA = prove(`!j x z u v lo f. diff2c_domain (x,z) f ==> (!i. i IN 1..dimindex (:N) ==> ~(i = j) ==> u$i = z$i /\ v$i = x$i) ==> u$j = x$j ==> v$j = z$j ==> &0 <= lo ==> (!y. y IN interval [x,z] ==> lo <= partial2 j j f y) ==> m_cell_pass f (x,u) ==> m_cell_pass f (v,z) ==> m_cell_pass f (x:real^N,z)`, REPEAT STRIP_TAC THEN REWRITE_TAC[m_cell_pass] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!i. i IN 1..dimindex (:N) ==> (x:real^N)$i <= (z:real^N)$i` ASSUME_TAC THENL [ POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(y:real^N)$i` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM IN_NUMSEG]; ALL_TAC ] THEN SUBGOAL_THEN `diff2_domain (x,z) (f:real^N->real)` ASSUME_TAC THENL [ UNDISCH_TAC `diff2c_domain (x,z) (f:real^N->real)` THEN SIMP_TAC[diff2_domain; diff2c_domain; diff2c]; ALL_TAC ] THEN MP_TAC (SPECL [`f:real^N->real`; `v:real^N`; `z:real^N`] M_CELL_SUP) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF2_DOMAIN_IMP_CONTINUOUS_ON THEN UNDISCH_TAC `diff2_domain (x,z) (f:real^N->real)` THEN REWRITE_TAC[diff2_domain] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM (new_rewrite [] []) THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC ] THEN DISCH_THEN (CHOOSE_THEN STRIP_ASSUME_TAC) THEN MP_TAC (SPECL [`f:real^N->real`; `x:real^N`; `u:real^N`] M_CELL_SUP) THEN ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF2_DOMAIN_IMP_CONTINUOUS_ON THEN UNDISCH_TAC `diff2_domain (x,z) (f:real^N->real)` THEN REWRITE_TAC[diff2_domain] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_CASES_TAC `i = j:num` THENL [ ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM (new_rewrite [] []) THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC ] THEN DISCH_THEN (CHOOSE_THEN STRIP_ASSUME_TAC) THEN MP_TAC (SPECL [`f:real^N->real`; `j:num`; `x:real^N`; `z:real^N`; `u:real^N`; `v:real^N`; `max a a'`] partial_convex_max) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `lo:real` THEN ASM_REWRITE_TAC[] THEN REPEAT (FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]); ALL_TAC ] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a':real` THEN ASM_SIMP_TAC[] THEN REAL_ARITH_TAC; ALL_TAC ] THEN ANTS_TAC THENL [ REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a:real` THEN ASM_SIMP_TAC[] THEN REAL_ARITH_TAC; ALL_TAC ] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `max a a'` THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; (*********************) let ZERO_EQ_ZERO_CONST = prove(`0 = _0`, REWRITE_TAC[NUMERAL]);; let gen_increasing_lemma n j = let mk_vars name = map (fun i -> mk_var (sprintf "%s%d" name i, real_ty)) (1--n) in let xs = mk_vars "x" and zs = mk_vars "z" and j_tm = mk_small_numeral j in let x_tm = mk_vector_list xs and z_tm = mk_vector_list zs and u_tm = mk_vector_list (map (fun i -> List.nth (if i = j then zs else xs) (i - 1)) (1--n)) in let th0 = (SPEC_ALL o ISPECL [j_tm; x_tm; z_tm; u_tm]) M_CELL_INCREASING_PASS_LEMMA in let th1 = REWRITE_RULE[dimindex_array.(n); IN_NUMSEG; gen_in_interval n; ARITH] th0 in let th2 = REWRITE_RULE (Array.to_list comp_thms_array.(n)) th1 in let th3 = MY_RULE_NUM th2 in (UNDISCH_ALL o ONCE_REWRITE_RULE[GSYM ZERO_EQ_ZERO_CONST] o DISCH (last (hyp th3))) th3;; let gen_mono_lemma0 th = let h2 = List.nth (hyp th) 1 in let domain_tm = (lhand o rand o lhand) h2 in let domain_var = mk_var ("domain", type_of domain_tm) in (UNDISCH_ALL o REWRITE_RULE[SUBSET_REFL] o DISCH_ALL o INST[domain_tm, domain_var]) th;; let incr_gen_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_increasing_lemma n j));; let incr_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_mono_lemma0 incr_gen_thms_array.(n).(j)));; let gen_decreasing_lemma n j = let mk_vars name = map (fun i -> mk_var (sprintf "%s%d" name i, real_ty)) (1--n) in let xs = mk_vars "x" and zs = mk_vars "z" and j_tm = mk_small_numeral j in let x_tm = mk_vector_list xs and z_tm = mk_vector_list zs and u_tm = mk_vector_list (map (fun i -> List.nth (if i = j then xs else zs) (i - 1)) (1--n)) in let th0 = (SPEC_ALL o ISPECL [j_tm; x_tm; z_tm; u_tm]) M_CELL_DECREASING_PASS_LEMMA in let th1 = REWRITE_RULE[dimindex_array.(n); IN_NUMSEG; gen_in_interval n; ARITH] th0 in let th2 = REWRITE_RULE (Array.to_list comp_thms_array.(n)) th1 in let th3 = MY_RULE_NUM th2 in (UNDISCH_ALL o ONCE_REWRITE_RULE[GSYM ZERO_EQ_ZERO_CONST] o DISCH (last (hyp th3))) th3;; let decr_gen_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_decreasing_lemma n j));; let decr_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_mono_lemma0 decr_gen_thms_array.(n).(j)));; (****************************************) let gen_convex_max_lemma n j = let xs = mk_real_vars n "x" and zs = mk_real_vars n "z" and j_tm = mk_small_numeral j in let x_tm = mk_vector_list xs and z_tm = mk_vector_list zs and u_tm = mk_vector_list (map (fun i -> List.nth (if i = j then xs else zs) (i - 1)) (1--n)) and v_tm = mk_vector_list (map (fun i -> List.nth (if i = j then zs else xs) (i - 1)) (1--n)) in let th0 = (SPEC_ALL o ISPECL [j_tm; x_tm; z_tm; u_tm; v_tm]) M_CELL_CONVEX_PASS_LEMMA in let th1 = REWRITE_RULE[dimindex_array.(n); IN_NUMSEG; gen_in_interval n; ARITH] th0 in let th2 = REWRITE_RULE (Array.to_list comp_thms_array.(n)) th1 in let th3 = MY_RULE_NUM th2 in (UNDISCH_ALL o ONCE_REWRITE_RULE[GSYM ZERO_EQ_ZERO_CONST] o DISCH (last (hyp th3))) th3;; let convex_thms_array = Array.init (max_dim + 1) (fun n -> Array.init (n + 1) (fun j -> if j < 1 then TRUTH else gen_convex_max_lemma n j));; (******************************************) let m_glue_cells n j pass_th1 pass_th2 = let f_tm, domain1 = dest_m_cell_pass (concl pass_th1) and domain2 = rand (concl pass_th2) in let x1, z1 = dest_pair domain1 and x2, z2 = dest_pair domain2 in let x1s = dest_vector x1 and x2s = dest_vector x2 and z2s = dest_vector z2 in let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) and f_var = mk_var ("f", type_of f_tm) and t_tm = List.nth x2s (j - 1) in let th0 = (INST[t_tm, t_var_real; f_tm, f_var] o INST (zip z2s z_vars) o INST (zip x1s x_vars)) glue_thms_array.(n).(j) in (MY_PROVE_HYP pass_th1 o MY_PROVE_HYP pass_th2) th0;; (**********************) let m_mono_pass_gen n j decr_flag diff2_th partial_mono_th sub_th pass_th = let f_tm, domain0 = dest_m_cell_pass (concl pass_th) and domain = (rand o rator o concl) diff2_th and xv, zv = (dest_pair o lhand o rand o lhand o concl) sub_th and bound_tm = ((if decr_flag then rand else lhand) o rand o snd o dest_forall o concl) partial_mono_th in let xs = dest_vector xv and zs = dest_vector zv in let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) and domain_var = mk_var ("domain", type_of domain) and f_var = mk_var ("f", type_of f_tm) and bound_var = mk_var ((if decr_flag then "hi" else "lo"), real_ty) in let le_th0 = (if decr_flag then float_le0 else float_ge0) bound_tm in let le_th = try EQT_ELIM le_th0 with Failure _ -> failwith (sprintf "m_mono_pass_gen: j = %d, th = %s" j (string_of_thm le_th0)) in let th0 = (INST[f_tm, f_var; bound_tm, bound_var; domain, domain_var] o INST (zip xs x_vars) o INST (zip zs z_vars)) (if decr_flag then decr_gen_thms_array.(n).(j) else incr_gen_thms_array.(n).(j)) in (MY_PROVE_HYP le_th o MY_PROVE_HYP pass_th o MY_PROVE_HYP diff2_th o MY_PROVE_HYP sub_th o MY_PROVE_HYP partial_mono_th) th0;; (* m_incr_pass *) let m_incr_pass n pp j m_taylor_th pass_th0 = let _, diff2_th, _, _ = dest_m_taylor_thms n m_taylor_th in let partial_bound = eval_m_taylor_partial_lower n pp j m_taylor_th in let f_tm, domain0 = dest_m_cell_pass (concl pass_th0) and domain = (rand o rator o concl) diff2_th and lo_tm = (lhand o rand o snd o dest_forall o concl) partial_bound in let lo_ge0_th = EQT_ELIM (float_ge0 lo_tm) in let x_tm, z_tm = dest_pair domain in let xs = dest_vector x_tm and zs = dest_vector z_tm in let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) and f_var = mk_var ("f", type_of f_tm) in let th0 = (INST[f_tm, f_var; lo_tm, lo_var_real] o INST (zip zs z_vars) o INST (zip xs x_vars)) incr_thms_array.(n).(j) in (MY_PROVE_HYP lo_ge0_th o MY_PROVE_HYP pass_th0 o MY_PROVE_HYP diff2_th o MY_PROVE_HYP partial_bound) th0;; (* m_decr_pass *) let m_decr_pass n pp j m_taylor_th pass_th0 = let _, diff2_th, _, _ = dest_m_taylor_thms n m_taylor_th in let partial_bound = eval_m_taylor_partial_upper n pp j m_taylor_th in let f_tm, domain0 = dest_m_cell_pass (concl pass_th0) and domain = (rand o rator o concl) diff2_th and hi_tm = (rand o rand o snd o dest_forall o concl) partial_bound in let hi_le0_th = EQT_ELIM (float_le0 hi_tm) in let x_tm, z_tm = dest_pair domain in let xs = dest_vector x_tm and zs = dest_vector z_tm in let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) and f_var = mk_var ("f", type_of f_tm) in let th0 = (INST[f_tm, f_var; hi_tm, hi_var_real] o INST (zip zs z_vars) o INST (zip xs x_vars)) decr_thms_array.(n).(j) in (MY_PROVE_HYP hi_le0_th o MY_PROVE_HYP pass_th0 o MY_PROVE_HYP diff2_th o MY_PROVE_HYP partial_bound) th0;; (*************************) (* m_convex_pass *) let m_convex_pass n j diff2_th partial2_bound_th pass1_th pass2_th = let f_tm, domain1 = dest_m_cell_pass (concl pass1_th) and _, domain2 = dest_m_cell_pass (concl pass2_th) in let x_tm, _ = dest_pair domain1 and _, z_tm = dest_pair domain2 and bound_tm = (lhand o rand o snd o dest_forall o concl) partial2_bound_th in let xs = dest_vector x_tm and zs = dest_vector z_tm in let x_vars = map (fun i -> x_vars_array.(i)) (1--n) and z_vars = map (fun i -> z_vars_array.(i)) (1--n) and f_var = mk_var ("f", type_of f_tm) in let le_th0 = float_ge0 bound_tm in let le_th = try EQT_ELIM le_th0 with Failure _ -> failwith ("m_convex_pass: "^string_of_thm le_th0) in let th0 = (INST[f_tm, f_var; bound_tm, lo_var_real] o INST (zip xs x_vars) o INST (zip zs z_vars)) convex_thms_array.(n).(j) in (MY_PROVE_HYP le_th o MY_PROVE_HYP pass1_th o MY_PROVE_HYP pass2_th o MY_PROVE_HYP diff2_th o MY_PROVE_HYP partial2_bound_th) th0;; (***********************) (* split_domain *) let split_domain n pp j domain_th = let domain_tm, y_tm, _ = dest_m_cell_domain (concl domain_th) in let x_tm, z_tm = dest_pair domain_tm in let xs = dest_vector x_tm and zs = dest_vector z_tm and t = List.nth (dest_vector y_tm) (j - 1) in let vv = map (fun i -> if i = j then t else List.nth zs (i - 1)) (1--n) and uu = map (fun i -> if i = j then t else List.nth xs (i - 1)) (1--n) in let domain1_th = mk_m_center_domain n pp (rand x_tm) (mk_list (vv, real_ty)) and domain2_th = mk_m_center_domain n pp (mk_list (uu, real_ty)) (rand z_tm) in domain1_th, domain2_th;; (* restrict_domain *) let restrict_domain n j left_flag domain_th = let domain_tm, y_tm, w_tm = dest_m_cell_domain (concl domain_th) in let x_tm, z_tm = dest_pair domain_tm in let xs = dest_vector x_tm and zs = dest_vector z_tm and ys = dest_vector y_tm and ws = dest_vector w_tm in let th0 = (INST (zip xs (mk_real_vars n "x")) o INST (zip zs (mk_real_vars n "z")) o INST (zip ys (mk_real_vars n "y")) o INST (zip ws (mk_real_vars n "w"))) (if left_flag then left_restrict_thms_array.(n).(j) else right_restrict_thms_array.(n).(j)) in let ths = CONJUNCTS (MY_PROVE_HYP domain_th th0) in hd ths, hd (tl ths);; (****************************************) open Verifier;; open Recurse;; let m_verify_raw (report_start, total_size) n pp fs certificate domain_th0 th_list = let r_size = result_size certificate in let r_size2 = float_of_int (if total_size > 0 then total_size else (if r_size > 0 then r_size else 1)) in let k = ref 0 in let kk = ref report_start in let last_report = ref (int_of_float (float_of_int !kk /. r_size2 *. 100.0)) in let rec rec_verify = let rec apply_trans sub_ths th0 acc = match sub_ths with | [] -> rev acc | th :: ths -> let th' = eval_subset_trans th th0 in apply_trans ths th' (th' :: acc) in let rec mk_domains mono th0 acc = match mono with | [] -> rev acc | m :: ms -> let j, flag = m.variable, m.decr_flag in let ths = restrict_domain n j flag th0 in mk_domains ms (fst ths) (ths :: acc) in let verify_mono mono domain_th certificate = let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let xx, zz = dest_pair domain in let df0_flags = itlist (fun m b -> m.df0_flag && b) mono true in let _ = !info_print_level < 2 or (report (sprintf "df0_flags = %b" df0_flags); true) in let taylor_th, diff2_th = if df0_flags then TRUTH, fs.diff2_f xx zz else let t_th = fs.taylor pp pp domain_th in let _, d_th, _, _ = dest_m_taylor_thms n t_th in t_th, d_th in let domain_ths = mk_domains mono domain_th [] in (* let domains = domain_th :: map fst (butlast domain_ths) in *) (* let gen_mono (m, domain_th) = *) let gen_mono m = if m.df0_flag then if m.decr_flag then eval_interval_arith_hi n (fs.df m.variable pp xx zz) else eval_interval_arith_lo n (fs.df m.variable pp xx zz) else if m.decr_flag then eval_m_taylor_partial_upper n pp m.variable taylor_th else eval_m_taylor_partial_lower n pp m.variable taylor_th in (* let mono_ths = map gen_mono (zip mono domains) in *) let mono_ths = map gen_mono mono in let pass_th0 = rec_verify ((fst o last) domain_ths) certificate in let sub_th0 = (eval_subset_refl o rand o concl o snd o hd) domain_ths in let sub_ths = apply_trans (sub_th0 :: map snd (butlast domain_ths)) sub_th0 [] in let th = rev_itlist (fun ((m, mono_th), sub_th) pass_th -> let j, flag = m.variable, m.decr_flag in m_mono_pass_gen n j flag diff2_th mono_th sub_th pass_th) (rev (zip (zip mono mono_ths) sub_ths)) pass_th0 in if hyp th <> [] then failwith ("hyp <> []: "^string_of_thm th) else th in fun domain_th certificate -> match certificate with | Result_mono (mono, r1) -> let _ = !info_print_level < 2 or (let mono_strs = map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") m.variable m.df0_flag) mono in report (sprintf "Mono: [%s]" (String.concat ";" mono_strs)); true) in verify_mono mono domain_th r1 | Result_pass (f0_flag, xx, zz) -> let _ = k := !k + 1 in let _ = !info_print_level < 2 or (report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag); true) in let _ = !info_print_level < 1 or (let r = int_of_float (float_of_int !kk /. r_size2 *. 100.0) in let _ = if r <> !last_report then (last_report := r; report0 (sprintf "%d " r)) else () in true) in if f0_flag then let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let xx, zz = dest_pair domain in m_taylor_cell_pass0 n (fs.f pp xx zz) else let taylor_th = fs.taylor pp pp domain_th in m_taylor_cell_pass n pp taylor_th | Result_glue (i, convex_flag, r1, r2) -> let domain1_th, domain2_th = if convex_flag then let d1, _ = restrict_domain n (i + 1) true domain_th in let d2, _ = restrict_domain n (i + 1) false domain_th in d1, d2 else split_domain n pp (i + 1) domain_th in let th1 = rec_verify domain1_th r1 in let th2 = rec_verify domain2_th r2 in if convex_flag then let _ = !info_print_level < 2 or (report (sprintf "GlueConvex: %d" (i + 1)); true) in let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let xx, zz = dest_pair domain in let diff2_th = fs.diff2_f xx zz in let partial2_th = fs.ddf (i + 1) (i + 1) pp xx zz in let lo_partial2_th = eval_interval_arith_lo n partial2_th in m_convex_pass n (i + 1) diff2_th lo_partial2_th th1 th2 else m_glue_cells n (i + 1) th1 th2 | Result_pass_ref i -> let _ = !info_print_level < 2 or (report (sprintf "Ref: %d" i); true) in if i > 0 then List.nth th_list (i - 1) else let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let pass_th = List.nth th_list (-i - 1) in m_cell_pass_subdomain domain pass_th | _ -> failwith "False result" in rec_verify domain_th0 certificate;; (*****************) let m_verify_raw0 n pp fs certificate xx zz = m_verify_raw (0, 0) n pp fs certificate (mk_m_center_domain n pp xx zz) [];; let m_verify_list n pp fs certificate_list xx zz = let domain_hash = Hashtbl.create (length certificate_list * 10) in let mem, find, add = Hashtbl.mem domain_hash, Hashtbl.find domain_hash, Hashtbl.add domain_hash in let get_m_cell_domain n pp domain0 path = let rec get_rec domain_th path hash = match path with | [] -> domain_th | (s, j) :: ps -> let hash' = hash^s^(string_of_int j) in if mem hash' then get_rec (find hash') ps hash' else if s = "l" or s = "r" then let domain1_th, domain2_th = split_domain n pp j domain_th in let hash1 = hash^"l"^(string_of_int j) and hash2 = hash^"r"^(string_of_int j) in let _ = add hash1 domain1_th; add hash2 domain2_th in if s = "l" then get_rec domain1_th ps hash' else get_rec domain2_th ps hash' else let l_flag = (s = "ml") in let domain_th', _ = restrict_domain n j l_flag domain_th in let _ = add hash' domain_th' in get_rec domain_th' ps hash' in get_rec domain0 path "" in let domain_th0 = mk_m_center_domain n pp xx zz in let size = length certificate_list in let k = ref 0 in let kk = ref 0 in let total_size = end_itlist (+) (map (result_size o snd) certificate_list) in let rec rec_verify certificate_list th_list = match certificate_list with | [] -> last th_list | (path, certificate) :: cs -> let _ = k := !k + 1 in let _ = !info_print_level < 2 or (report (sprintf "List: %d/%d" !k size); true) in let domain_th = get_m_cell_domain n pp domain_th0 path in let th = m_verify_raw (!kk, total_size) n pp fs certificate domain_th th_list in let _ = kk := !kk + result_size certificate in rec_verify cs (th_list @ [th]) in rec_verify certificate_list [];; (***************************) (* Verification based on a p_result_tree *) let m_p_verify_raw (report_start, total_size) n p_split fs certificate domain_th0 th_list = let r_size = p_result_size certificate in let r_size2 = float_of_int (if total_size > 0 then total_size else (if r_size > 0 then r_size else 1)) in let k = ref 0 in let kk = ref report_start in let last_report = ref (int_of_float (float_of_int !kk /. r_size2 *. 100.0)) in let rec rec_verify = let rec apply_trans sub_ths th0 acc = match sub_ths with | [] -> rev acc | th :: ths -> let th' = eval_subset_trans th th0 in apply_trans ths th' (th' :: acc) in let rec mk_domains mono th0 acc = match mono with | [] -> rev acc | m :: ms -> let j, flag = m.variable, m.decr_flag in let ths = restrict_domain n j flag th0 in mk_domains ms (fst ths) (ths :: acc) in let verify_mono p_stat mono domain_th certificate = let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let xx, zz = dest_pair domain in let df0_flags = itlist (fun m b -> m.df0_flag && b) mono true in let _ = !info_print_level < 2 or (report (sprintf "df0_flags = %b" df0_flags); true) in let taylor_th, diff2_th = if df0_flags then TRUTH, fs.diff2_f xx zz else let t_th = fs.taylor p_stat.pp p_stat.pp domain_th in let _, d_th, _, _ = dest_m_taylor_thms n t_th in t_th, d_th in let domain_ths = mk_domains mono domain_th [] in let gen_mono m = if m.df0_flag then if m.decr_flag then eval_interval_arith_hi n (fs.df m.variable p_stat.pp xx zz) else eval_interval_arith_lo n (fs.df m.variable p_stat.pp xx zz) else if m.decr_flag then eval_m_taylor_partial_upper n p_stat.pp m.variable taylor_th else eval_m_taylor_partial_lower n p_stat.pp m.variable taylor_th in let mono_ths = map gen_mono mono in let pass_th0 = rec_verify ((fst o last) domain_ths) certificate in let sub_th0 = (eval_subset_refl o rand o concl o snd o hd) domain_ths in let sub_ths = apply_trans (sub_th0 :: map snd (butlast domain_ths)) sub_th0 [] in let th = rev_itlist (fun ((m, mono_th), sub_th) pass_th -> let j, flag = m.variable, m.decr_flag in m_mono_pass_gen n j flag diff2_th mono_th sub_th pass_th) (rev (zip (zip mono mono_ths) sub_ths)) pass_th0 in if hyp th <> [] then failwith ("hyp <> []: "^string_of_thm th) else th in fun domain_th certificate -> match certificate with | P_result_mono (p_stat, mono, r1) -> let _ = !info_print_level < 2 or (let mono_strs = map (fun m -> sprintf "%s%d (%b)" (if m.decr_flag then "-" else "") m.variable m.df0_flag) mono in report (sprintf "Mono: [%s]" (String.concat ";" mono_strs)); true) in verify_mono p_stat mono domain_th r1 | P_result_pass (p_stat, f0_flag) -> let _ = k := !k + 1; kk := !kk + 1 in let _ = !info_print_level < 2 or (report (sprintf "Verifying: %d/%d (f0_flag = %b)" !k r_size f0_flag); true) in let _ = !info_print_level <> 1 or (let r = int_of_float (float_of_int !kk /. r_size2 *. 100.0) in let _ = if r <> !last_report then (last_report := r; report0 (sprintf "%d " r)) else () in true) in if f0_flag then let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let xx, zz = dest_pair domain in m_taylor_cell_pass0 n (fs.f p_stat.pp xx zz) else let taylor_th = fs.taylor p_stat.pp p_stat.pp domain_th in m_taylor_cell_pass n p_stat.pp taylor_th | P_result_glue (p_stat, i, convex_flag, r1, r2) -> let domain1_th, domain2_th = if convex_flag then let d1, _ = restrict_domain n (i + 1) true domain_th in let d2, _ = restrict_domain n (i + 1) false domain_th in d1, d2 else split_domain n p_split (i + 1) domain_th in let th1 = rec_verify domain1_th r1 in let th2 = rec_verify domain2_th r2 in if convex_flag then let _ = !info_print_level < 2 or (report (sprintf "GlueConvex: %d" (i + 1)); true) in let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let xx, zz = dest_pair domain in let diff2_th = fs.diff2_f xx zz in let partial2_th = fs.ddf (i + 1) (i + 1) p_stat.pp xx zz in let lo_partial2_th = eval_interval_arith_lo n partial2_th in m_convex_pass n (i + 1) diff2_th lo_partial2_th th1 th2 else m_glue_cells n (i + 1) th1 th2 | P_result_ref i -> let _ = !info_print_level < 2 or (report (sprintf "Ref: %d" i); true) in if i > 0 then List.nth th_list (i - 1) else let domain, _, _ = (dest_m_cell_domain o concl) domain_th in let pass_th = List.nth th_list (-i - 1) in m_cell_pass_subdomain domain pass_th in rec_verify domain_th0 certificate;; (*****************) let m_p_verify_raw0 n p_split fs certificate xx zz = m_p_verify_raw (0, 0) n p_split fs certificate (mk_m_center_domain n p_split xx zz) [];; let m_p_verify_list n p_split fs certificate_list xx zz = let domain_hash = Hashtbl.create (length certificate_list * 10) in let mem, find, add = Hashtbl.mem domain_hash, Hashtbl.find domain_hash, Hashtbl.add domain_hash in let get_m_cell_domain n pp domain0 path = let rec get_rec domain_th path hash = match path with | [] -> domain_th | (s, j) :: ps -> let hash' = hash^s^(string_of_int j) in if mem hash' then get_rec (find hash') ps hash' else if s = "l" or s = "r" then let domain1_th, domain2_th = split_domain n pp j domain_th in let hash1 = hash^"l"^(string_of_int j) and hash2 = hash^"r"^(string_of_int j) in let _ = add hash1 domain1_th; add hash2 domain2_th in if s = "l" then get_rec domain1_th ps hash' else get_rec domain2_th ps hash' else let l_flag = (s = "ml") in let domain_th', _ = restrict_domain n j l_flag domain_th in let _ = add hash' domain_th' in get_rec domain_th' ps hash' in get_rec domain0 path "" in let domain_th0 = mk_m_center_domain n p_split xx zz in let size = length certificate_list in let k = ref 0 in let kk = ref 0 in let total_size = end_itlist (+) (map (p_result_size o snd) certificate_list) in let rec rec_verify certificate_list th_list = match certificate_list with | [] -> last th_list | (path, certificate) :: cs -> let _ = k := !k + 1 in let _ = !info_print_level < 2 or (report (sprintf "List: %d/%d" !k size); true) in let domain_th = get_m_cell_domain n p_split domain_th0 path in let th = m_p_verify_raw (!kk, total_size) n p_split fs certificate domain_th th_list in let _ = kk := !kk + p_result_size certificate in rec_verify cs (th_list @ [th]) in rec_verify certificate_list [];; end;; hol-light/Formal_ineqs/verifier/m_verifier_build.hl000066400000000000000000000166541303454263000230460ustar00rootroot00000000000000(* =========================================================== *) (* Auxiliary formal verification functions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "arith/eval_interval.hl";; needs "arith/more_float.hl";; needs "taylor/m_taylor.hl";; needs "verifier/interval_m/taylor.ml";; needs "informal/informal_m_verifier.hl";; needs "verifier_options.hl";; needs "misc/vars.hl";; module M_verifier_build = struct open More_float;; open Eval_interval;; open M_taylor;; open Interval_types;; open Interval;; open Line_interval;; open Taylor;; open M_verifier;; open Misc_vars;; open Verifier_options;; (****************************) (* Interval polynomial functions for the native OCaml arithmetic *) type int_poly_fun = | F_int_var of int | F_int_const of interval | F_int_pow of int * int_poly_fun | F_int_neg of int_poly_fun | F_int_add of int_poly_fun * int_poly_fun | F_int_sub of int_poly_fun * int_poly_fun | F_int_mul of int_poly_fun * int_poly_fun;; let ipow = Arith_misc.gen_pow imul Interval.one;; let eval_int_poly_fun i_fun = fun x -> let rec eval_rec f = match f with | F_int_var i -> List.nth x (i - 1) | F_int_const int -> int | F_int_neg f1 -> ineg (eval_rec f1) | F_int_pow (n,f1) -> ipow n (eval_rec f1) | F_int_add (f1,f2) -> iadd (eval_rec f1) (eval_rec f2) | F_int_sub (f1,f2) -> isub (eval_rec f1) (eval_rec f2) | F_int_mul (f1,f2) -> imul (eval_rec f1) (eval_rec f2) in eval_rec i_fun;; (****************************) (* Automatic conversion of formal interval polynomials into functions (polynomials) *) (* TODO: take Int_ref into account *) let rec build_poly_fun i_fun = match i_fun with | Int_var tm -> (try F_int_var (dest_small_numeral (rand tm)) with Failure _ -> let name = (fst o dest_var) tm in F_int_var (int_of_string (String.sub name 1 (String.length name - 1)))) | Int_const th -> let f1, f2 = (dest_pair o rand o concl) th in let int = mk_interval (float_of_float_tm f1, float_of_float_tm f2) in F_int_const int | Int_pow (n, f) -> F_int_pow (n, build_poly_fun f) | Int_unary (op, f) -> let f' = build_poly_fun f in if op = neg_op_real then F_int_neg f' else failwith ("Unsupported operator: "^string_of_term op) | Int_binary (op, f1, f2) -> let f1', f2' = build_poly_fun f1, build_poly_fun f2 in if op = add_op_real then F_int_add (f1',f2') else if op = sub_op_real then F_int_sub (f1',f2') else if op = mul_op_real then F_int_mul (f1',f2') else failwith ("Unsupported operator: "^string_of_term op) | _ -> failwith "Unsupported function";; let build_polyL pp lin_th = let funs = map (fst o dest_interval_arith) ((striplist dest_conj o rand o concl) lin_th) in let i_funs = map (eval_constants pp o build_interval_fun) funs in let fs = map build_poly_fun i_funs @ (replicate (F_int_const zero) (8 - length funs + 1)) in let eval_fs = map eval_int_poly_fun fs in let f, df = hd eval_fs, tl eval_fs in (fun i x z -> let vars = map2 (curry mk_interval) x z in if i = 0 then f vars else (List.nth df (i - 1)) vars), (fun x -> let vars = map (fun x -> mk_interval (x,x)) x in mk_line (f vars, map (fun df -> df vars) df));; let build_polyL0 pp poly_tm = let lin_th = gen_lin_approx_poly_thm0 poly_tm in build_polyL pp lin_th;; let build_polyDD pp second_th = let poly_tm = (lhand o rator o lhand o concl) second_th in let n = (get_dim o fst o dest_abs) poly_tm in let ns = 1--n in let funs = (striplist dest_conj o rand o snd o dest_forall o rand o concl) second_th in let i_funs = map (eval_constants pp o build_interval_fun o fst o dest_interval_arith) funs in let fs0 = map build_poly_fun i_funs in let pad1 = replicate zero (8 - n) and pad2 = replicate zero 8 in let pad3 = replicate pad2 (8 - n) in let get_el dd i j = let i', j' = if j <= i then i, j else j, i in let index = (i' - 1) * i' / 2 + (j' - 1) in List.nth dd index in let eval_fs = map eval_int_poly_fun fs0 in fun x z -> let ints = map2 (curry mk_interval) x z in let vals = map (fun f -> f ints) eval_fs in map (fun i -> map (fun j -> get_el vals i j) ns @ pad1) ns @ pad3;; let build_polyDD0 pp poly_tm = let second_th = gen_second_bounded_poly_thm0 poly_tm in build_polyDD pp second_th;; (******) let build_poly_taylor pp lin_th second_th = let f_df, lin = build_polyL pp lin_th and dd = build_polyDD pp second_th in Prim_a (make_primitiveA (f_df, lin, dd));; let build_poly_taylor0 pp poly_tm = build_poly_taylor pp (gen_lin_approx_poly_thm0 poly_tm) (gen_second_bounded_poly_thm0 poly_tm);; (**********************************) (* mk_verification_functions *) let mk_verification_functions_poly pp0 poly_tm = let x_tm, body_tm = dest_abs poly_tm in let new_f = poly_tm in let n = get_dim x_tm in let _ = !info_print_level = 0 or (report0 (sprintf "Computing partial derivatives (%d)..." n); true) in let partials = map (fun i -> let _ = !info_print_level = 0 or (report0 (sprintf " %d" i); true) in gen_partial_poly i new_f) (1--n) in let get_partial i eq_th = let partial_i = gen_partial_poly i (rand (concl eq_th)) in let pi = (rator o lhand o concl) partial_i in REWRITE_RULE[GSYM partial2] (TRANS (AP_TERM pi eq_th) partial_i) in let partials2 = map (fun j -> let th = List.nth partials (j - 1) in map (fun i -> let _ = !info_print_level = 0 or (report0 (sprintf " %d,%d" j i); true) in get_partial i th) (1--j)) (1--n) in let _ = !info_print_level = 0 or (report0 " done\n"; true) in let diff_th = gen_diff_poly new_f in let lin_th = gen_lin_approx_poly_thm new_f diff_th partials in let diff2_th = gen_diff2c_domain_poly new_f in let second_th = gen_second_bounded_poly_thm new_f partials2 in let replace_numeral i th = let num_eq = (REWRITE_RULE[Arith_hash.NUM_THM] o Arith_nat.NUMERAL_TO_NUM_CONV) (mk_small_numeral i) in GEN_REWRITE_RULE (LAND_CONV o RATOR_CONV o DEPTH_CONV) [num_eq] th in let eval0 = mk_eval_function pp0 new_f in let eval1 = map (fun i -> let d_th = List.nth partials (i - 1) in let eq_th = replace_numeral i d_th in mk_eval_function_eq pp0 eq_th) (1--n) in let eval2 = map (fun i -> map (fun j -> let d2_th = List.nth (List.nth partials2 (i - 1)) (j - 1) in let eq_th' = replace_numeral i d2_th in let eq_th = replace_numeral j eq_th' in mk_eval_function_eq pp0 eq_th) (1--i)) (1--n) in let diff2_f = eval_diff2_poly diff2_th in let eval_f = eval_m_taylor pp0 diff2_th lin_th second_th in let taylor_f = build_poly_taylor pp0 lin_th second_th in {taylor = eval_f; f = eval0; df = (fun i -> List.nth eval1 (i - 1)); ddf = (fun i j -> List.nth (List.nth eval2 (j - 1)) (i - 1)); diff2_f = diff2_f; }, taylor_f, Informal_verifier.mk_verification_functions_poly pp0 new_f partials partials2;; end;; hol-light/Formal_ineqs/verifier/m_verifier_main.hl000066400000000000000000000422751303454263000226710ustar00rootroot00000000000000(* =========================================================== *) (* Main formal verification functions *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) needs "verifier/interval_m/verifier.ml";; needs "verifier/m_verifier.hl";; needs "verifier/m_verifier_build.hl";; needs "taylor/m_taylor_arith2.hl";; needs "misc/vars.hl";; #load "unix.cma";; module M_verifier_main = struct open Arith_misc;; open Interval_arith;; open Eval_interval;; open More_float;; open M_verifier;; open M_verifier_build;; open M_taylor;; open M_taylor_arith2;; open Taylor;; open Misc_vars;; open Verifier_options;; (* Parameters *) type verification_parameters = { (* If true, then monotonicity properties can be used *) (* to reduce the dimension of a problem *) allow_derivatives : bool; (* If true, then convexity can be used *) (* to reduce the dimension of a problem *) convex_flag : bool; (* If true, then verification on internal subdomains can be skipped *) (* for a monotone function *) mono_pass_flag : bool; (* If true, then raw interval arithmetic can be used *) (* (without Taylor approximations) *) raw_intervals_flag : bool; (* If true, then an informal procedure is used to determine *) (* the optimal precision for the formal verification *) adaptive_precision : bool; (* This parameter might be used in cases when the certificate search *) (* procedure returns a wrong result due to rounding errors *) (* (this parameter will be eliminated when the search procedure is corrected) *) eps : float; };; let default_params = { allow_derivatives = true; convex_flag = true; mono_pass_flag = true; raw_intervals_flag = true; adaptive_precision = true; eps = 0.0; };; type verification_stats = { total_time : float; formal_verification_time : float; certificate : Verifier.certificate_stats; };; (********************************) (* Adds a constant approximation to the table of known constants *) let add_constant_interval int_th = Eval_interval.add_constant_interval int_th; Informal_eval_interval.add_constant_interval int_th;; (* Tests if an expression has only given binary and unary operations *) let test_expression bin_ops unary_ops = let rec test = (* Tests if the expression is in the form `a$i` *) let test_vector tm = let var, index = dest_binary "$" tm in dest_var var, dest_small_numeral index in (* Tests if the expression is a valid binary operation *) let test_binary tm = try let lhs, rhs = dest_comb tm in let op, lhs = dest_comb lhs in let c, _ = dest_const op in if mem c bin_ops then (test lhs && test rhs) else false with Failure _ -> false in (* Tests if the expression is a valid unary operation *) let test_unary tm = try let lhs, rhs = dest_comb tm in let c, _ = dest_const lhs in if mem c unary_ops then test rhs else false with Failure _ -> false in fun tm -> frees tm = [] or can dest_var tm or can test_vector tm or test_unary tm or test_binary tm in test;; (* Tests if the given expression is a polynomial expression *) let is_poly = let bin_ops = ["real_add"; "real_mul"; "real_sub"; "real_pow"] in let unary_ops = ["real_neg"] in test_expression bin_ops unary_ops;; (**********************************) (* Creates basic verification functions *) let rec mk_funs = (* add *) let mk_add n (f1, tf1, ti1) (f2, tf2, ti2) = (fun p1 p2 x -> let a = f1 p1 p2 x and b = f2 p1 p2 x in eval_m_taylor_add2 n p1 p2 a b), Plus (tf1, tf2), (fun p1 p2 x -> let a = ti1 p1 p2 x and b = ti2 p1 p2 x in Informal_taylor.eval_m_taylor_add p1 p2 a b) in (* sub *) let mk_sub n (f1, tf1, ti1) (f2, tf2, ti2) = let neg_one = Interval.mk_interval(-1.0, -1.0) in (fun p1 p2 x -> let a = f1 p1 p2 x and b = f2 p1 p2 x in eval_m_taylor_sub2 n p1 p2 a b), Plus (tf1, Scale(tf2, neg_one)), (fun p1 p2 x -> let a = ti1 p1 p2 x and b = ti2 p1 p2 x in Informal_taylor.eval_m_taylor_sub p1 p2 a b) in (* mul *) let mk_mul n (f1, tf1, ti1) (f2, tf2, ti2) = (fun p1 p2 x -> let a = f1 p1 p2 x and b = f2 p1 p2 x in eval_m_taylor_mul2 n p1 p2 a b), Product (tf1, tf2), (fun p1 p2 x -> let a = ti1 p1 p2 x and b = ti2 p1 p2 x in Informal_taylor.eval_m_taylor_mul p1 p2 a b) in (* neg *) let mk_neg n (f1, tf1, ti1) = (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_neg2 n a), Scale (tf1, Interval.mk_interval (-1.0, -1.0)), (fun p1 p2 x -> let a = ti1 p1 p2 x in Informal_taylor.eval_m_taylor_neg a) in (* sqrt *) let mk_sqrt n (f1, tf1, ti1) = (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_sqrt2 n p1 p2 a), Uni_compose (Univariate.usqrt, tf1), (fun p1 p2 x -> let a = ti1 p1 p2 x in Informal_taylor.eval_m_taylor_sqrt p1 p2 a) in (* inv *) let mk_inv n (f1, tf1, ti1) = (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_inv2 n p1 p2 a), Uni_compose (Univariate.uinv, tf1), (fun p1 p2 x -> let a = ti1 p1 p2 x in Informal_taylor.eval_m_taylor_inv p1 p2 a) in (* atn *) let mk_atn n (f1, tf1, ti1) = (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_atn2 n p1 p2 a), Uni_compose (Univariate.uatan, tf1), (fun p1 p2 x -> let a = ti1 p1 p2 x in Informal_taylor.eval_m_taylor_atn p1 p2 a) in (* acs *) let mk_acs n (f1, tf1, ti1) = (fun p1 p2 x -> let a = f1 p1 p2 x in eval_m_taylor_acs2 n p1 p2 a), Uni_compose (Univariate.uacos, tf1), (fun p1 p2 x -> let a = ti1 p1 p2 x in Informal_taylor.eval_m_taylor_acs p1 p2 a) in (* binary operations *) let bin_ops = ["real_add", mk_add; "real_sub", mk_sub; "real_mul", mk_mul] in (* unary operations *) let unary_ops = ["real_neg", mk_neg; "sqrt", mk_sqrt; "atn", mk_atn; "acs", mk_acs; "real_inv", mk_inv] in (* makes a binary operation *) let mk_bin n pp x_var tm = let lhs, rhs = dest_comb tm in let op, lhs = dest_comb lhs in let mk_f = assoc ((fst o dest_const) op) bin_ops in let l_funs = mk_funs n pp (mk_abs(x_var, lhs)) and r_funs = mk_funs n pp (mk_abs(x_var, rhs)) in mk_f n l_funs r_funs in (* makes an unary operation *) let mk_unary n pp x_var tm = let op, rhs = dest_comb tm in let mk_f = assoc ((fst o dest_const) op) unary_ops in let funs = mk_funs n pp (mk_abs(x_var, rhs)) in mk_f n funs in (* the main function *) fun n pp fun_tm -> let x_var, body_tm = dest_abs fun_tm in if is_poly body_tm then let eval_fs, tf, ti = mk_verification_functions_poly pp fun_tm in eval_fs.taylor, tf, ti.Informal_verifier.taylor else try mk_bin n pp x_var body_tm with Failure _ -> mk_unary n pp x_var body_tm;; (* Prepares verification functions *) (* fun_tm must be in the form `\x. f x` *) let mk_verification_functions = let dummy_f pp lo hi = failwith "dummy f" and dummy_df i pp lo hi = failwith "dummy df" and dummy_ddf i j pp lo hi = failwith "dummy ddf" and dummy_diff2 lo hi = failwith "dummy diff2" in fun params pp fun_tm -> let x_var, body_tm = dest_abs fun_tm in if is_poly body_tm then mk_verification_functions_poly pp fun_tm else let n = get_dim x_var in let eval_taylor, tf, eval_ti = mk_funs n pp fun_tm in let _ = params := {!params with raw_intervals_flag = false; convex_flag = false} in {taylor = eval_taylor; f = dummy_f; df = dummy_df; ddf = dummy_ddf; diff2_f = dummy_diff2}, tf, {Informal_verifier.taylor = eval_ti; Informal_verifier.f = dummy_f; Informal_verifier.df = dummy_df; Informal_verifier.ddf = dummy_ddf};; (********************************) let convert_to_float_list pp lo_flag list_tm = let tms = dest_list list_tm in let i_funs = map build_interval_fun tms in let ints = map (fun f -> eval_interval_fun pp f [] []) i_funs in let extract = (if lo_flag then fst else snd) o dest_pair o rand o concl in mk_list (map extract ints, real_ty);; (* Creates a theorem |- interval[xx_tm, zz_tm] SUBSET interval[float(xx_tm), float(zz_tm)] and two lists: float(xx_tm) and float(zz_tm) *) let mk_float_domain pp (xx_tm, zz_tm) = let xx_list = dest_list xx_tm and zz_list = dest_list zz_tm in let n = length xx_list in let get_intervals tms = let i_funs = map build_interval_fun tms in map (fun f -> eval_interval_fun pp f [] []) i_funs in let xx_ints = get_intervals xx_list and zz_ints = get_intervals zz_list in let xx_ineqs = map (CONJUNCT1 o ONCE_REWRITE_RULE[interval_arith]) xx_ints and zz_ineqs = map (CONJUNCT2 o ONCE_REWRITE_RULE[interval_arith]) zz_ints in let a_vals = map (lhand o concl) xx_ineqs and b_vals = map (rand o concl) zz_ineqs in let a_vars = mk_real_vars n "a" and b_vars = mk_real_vars n "b" and c_vars = mk_real_vars n "c" and d_vars = mk_real_vars n "d" in let th0 = (INST (zip xx_list c_vars) o INST (zip zz_list d_vars) o INST (zip a_vals a_vars) o INST (zip b_vals b_vars)) subset_interval_thms_array.(n) in itlist MY_PROVE_HYP (xx_ineqs @ zz_ineqs) th0, (mk_list (a_vals, real_ty), mk_list (b_vals, real_ty));; (* Given a term a < b, returns the theorem |- a - b < &0 <=> a < b *) (* Also, deals with > and / *) (* A user can provide additional rewrite theorems *) let mk_standard_ineq = let lemma = REAL_ARITH `a < b <=> a - b < &0` in fun thms tm -> let th0 = (REWRITE_CONV([real_gt; real_div] @ thms) THENC DEPTH_CONV let_CONV) tm in let rhs = rand (concl th0) in let th1 = (ONCE_REWRITE_CONV[lemma] THENC PURE_REWRITE_CONV[REAL_NEG_0; REAL_SUB_RZERO; REAL_SUB_LZERO]) rhs in TRANS th0 th1;; (* Converts a term in the form `x + y` into the term `\x:real^2. x$1 + x$2` *) let expr_to_vector_fun = let comp_op = `$` in fun expr_tm -> let vars = List.sort Pervasives.compare (frees expr_tm) in let n = length vars in let x_var = mk_var ("x", n_vector_type_array.(if n = 0 then 1 else n)) in let x_tm = mk_icomb (comp_op, x_var) in let vars2 = map (fun i -> mk_comb (x_tm, mk_small_numeral i)) (1--n) in mk_abs (x_var, subst (zip vars2 vars) expr_tm), (if n = 0 then mk_vector_list [x_var] else mk_vector_list vars);; (* Given an inequality `P x y`, variable names and the corresponding bounds, yields `(x0 <= x /\ x <= x1) /\ (y0 <= y /\ y <= y1) ==> P x y` *) let mk_ineq ineq_tm names dom_tm = let lo_list = dest_list (fst dom_tm) and hi_list = dest_list (snd dom_tm) in let vars = map (fun name -> mk_var (name, real_ty)) names in let lo_ineqs = map2 (fun tm1 tm2 -> mk_binop le_op_real tm1 tm2) lo_list vars and hi_ineqs = map2 (fun tm1 tm2 -> mk_binop le_op_real tm1 tm2) vars hi_list in let ineqs = map2 (fun tm1 tm2 -> mk_conj (tm1, tm2)) lo_ineqs hi_ineqs in let cond = end_itlist (curry mk_conj) ineqs in mk_imp (cond, ineq_tm);; (* Reverts the effect of mk_ineq function *) let dest_ineq ineq_tm = if frees ineq_tm = [] then ineq_tm, [], (real_empty_list, real_empty_list) else let tm0 = (rand o concl o PURE_REWRITE_CONV[IMP_IMP; GSYM CONJ_ASSOC]) ineq_tm in let cond, ineq = dest_imp tm0 in let conds = striplist dest_conj cond in let ineqs = ref [] in let decode_ineq tm = let lhs, rhs = dest_binop le_op_real tm in let lo_flag = (frees lhs = []) in let name = (fst o dest_var) (if lo_flag then rhs else lhs) in let val_ref = try assoc name !ineqs with Failure _ -> let val_ref = ref (x_var_real, x_var_real) in ineqs := ((name, val_ref) :: !ineqs); val_ref in val_ref := if lo_flag then (lhs, snd !val_ref) else (fst !val_ref, rhs) in let _ = map (fun tm -> (try decode_ineq tm with Failure _ -> failwith ("Bad variable bound inequality: "^string_of_term tm))) conds in let names, bounds0 = unzip !ineqs in let lo, hi = unzip (map (fun r -> !r) bounds0) in let test_bounds bounds bound_name = let _ = map2 (fun tm name -> if frees tm <> [] then failwith (bound_name^" bound is not defined for "^name) else ()) bounds names in () in let _ = test_bounds hi "Upper"; test_bounds lo "Lower" in ineq, names, (mk_real_list lo, mk_real_list hi);; (*********************************) (* Normalizes a verification result *) let normalize_result norm_flag v1 eq_th1 domain_sub_th pass_thm = let th0 = REWRITE_RULE[m_cell_pass] pass_thm in let n = (get_dim o fst o dest_forall o concl) th0 in let th1 = SPEC v1 th0 in let comp_thms = end_itlist CONJ (Array.to_list comp_thms_array.(n)) in let th2 = REWRITE_RULE[comp_thms] th1 in let th3 = (UNDISCH_ALL o REWRITE_RULE[GSYM eq_th1]) th2 in let dom_th = (UNDISCH_ALL o SPEC v1 o REWRITE_RULE[SUBSET]) domain_sub_th in let th4 = (DISCH_ALL o MY_PROVE_HYP dom_th) th3 in let th5 = REWRITE_RULE[IN_INTERVAL; dimindex_array.(n); gen_in_interval n; comp_thms] th4 in if norm_flag then GEN_ALL th5 else th4;; (* Verifies the given inequality *) (* Returns the final theorem and verification statistics *) let verify_ineq0 params0 norm_flag pp ineq_tm var_names (lo_tm, hi_tm) rewrite_thms = let total_start = Unix.gettimeofday() in let eq_th1 = mk_standard_ineq rewrite_thms ineq_tm in let ineq_tm1 = (lhand o rand o concl) eq_th1 in if frees ineq_tm1 = [] then let i_fun = build_interval_fun ineq_tm1 in let th0 = eval_interval_fun pp i_fun [] [] in let th1 = float_interval_lt0 th0 in let total = Unix.gettimeofday() -. total_start in REWRITE_RULE[GSYM eq_th1] th1, {total_time = total; formal_verification_time = total; certificate = Verifier.dummy_stats} else let fun_tm, v1 = expr_to_vector_fun ineq_tm1 in let vars = map (fst o dest_var) (dest_vector v1) in let lo_list = dest_list lo_tm and hi_list = dest_list hi_tm in let bounds0 = zip var_names (zip lo_list hi_list) in let bounds = itlist (fun name list -> assoc name bounds0 :: list) vars [] in let xx, zz = unzip bounds in let xx, zz = mk_real_list xx, mk_real_list zz in let domain_sub_th, (xx1, zz1) = mk_float_domain pp (xx, zz) in let n = (get_dim o fst o dest_abs) fun_tm in let xx2 = Informal_taylor.convert_to_float_list pp true xx and zz2 = Informal_taylor.convert_to_float_list pp false zz in let xx_float = map float_of_float_tm (dest_list xx1) and zz_float = map float_of_float_tm (dest_list zz1) in let params = ref params0 in let eval_fs, tf, ti = mk_verification_functions params pp fun_tm in let _ = !info_print_level < 1 or (report0 "Constructing a solution certificate... "; true) in let certificate = Verifier.run_test tf xx_float zz_float false 0.0 !params.allow_derivatives !params.convex_flag !params.mono_pass_flag !params.raw_intervals_flag !params.eps in let stats = Verifier.result_stats certificate in let _ = !info_print_level < 1 or (report0 " done\n"; true) in let _ = !info_print_level < 1 or (Verifier.report_stats stats; true) in let c1 = Verifier.transform_result xx_float zz_float certificate in let start, finish, result = if !params.adaptive_precision then let _ = !info_print_level < 1 or (report0 "Informal verification... "; true) in let c1p = Informal_verifier.m_verify_list pp 1 pp ti c1 xx2 zz2 in let _ = !info_print_level < 1 or (report0 " done\n"; true) in let _ = !info_print_level < 1 or (report0 "Formal verification... "; true) in let start = Unix.gettimeofday() in let result = m_p_verify_list n pp eval_fs c1p xx1 zz1 in let finish = Unix.gettimeofday() in let _ = !info_print_level < 1 or (report0 " done\n"; true) in start, finish, result else let _ = !info_print_level < 1 or (report0 "Formal verification... "; true) in let start = Unix.gettimeofday() in let result = m_verify_list n pp eval_fs c1 xx1 zz1 in let finish = Unix.gettimeofday() in let _ = !info_print_level < 1 or (report0 " done\n"; true) in start, finish, result in normalize_result norm_flag v1 eq_th1 domain_sub_th result, {total_time = finish -. total_start; formal_verification_time = finish -. start; certificate = stats};; (* A simple verification function which accepts a list of rewrite theorems which are applied to the inequality before verification *) let verify_ineq_and_rewrite rewrite_thms params pp ineq_tm = let ineq, vars, bounds = dest_ineq ineq_tm in verify_ineq0 params true pp ineq vars bounds rewrite_thms;; (* The simplest verification function *) let verify_ineq = verify_ineq_and_rewrite [];; end;; hol-light/Formal_ineqs/verifier_options.hl000066400000000000000000000011251303454263000212760ustar00rootroot00000000000000(* =========================================================== *) (* Options of the verification library *) (* Author: Alexey Solovyev *) (* Date: 2012-10-27 *) (* =========================================================== *) module Verifier_options = struct let report0 s = Format.print_string s; Format.print_flush();; (* Debug/info printing level: 0 - no debug/info printing 1 - print important messages only 2 - print all information *) let info_print_level = ref 1;; end;; hol-light/Functionspaces/000077500000000000000000000000001303454263000157315ustar00rootroot00000000000000hol-light/Functionspaces/L2.ml000066400000000000000000000624671303454263000165570ustar00rootroot00000000000000(* ========================================================================= *) (* *) (* Quantum optics library: single mode electromagnetic field. *) (* *) (* (c) Copyright, Mohamed Yousri Mahmoud , 2012-2014 *) (* Hardware Verification Group, *) (* Concordia University *) (* *) (* Contact: , *) (* *) (* Last update: April 18, 2016 *) (* *) (* ========================================================================= *) needs "Functionspaces/cfunspace.ml";; (*****************************************************************************) (* SQUARE INTEGRABLE FUNCTIONS (L2) *) (*****************************************************************************) parse_as_infix("complex_measurable_on",(12,"right"));; let complex_measurable = new_definition `f complex_measurable_on s <=> (\x. Re (f x)) real_measurable_on s /\ (\x. Im (f x)) real_measurable_on s`;; let sq_integrable = new_specification ["sq_integrable"] (prove(`?s. !f. f IN s <=> f complex_measurable_on (:real) /\ (\x. norm (f x) pow 2) real_integrable_on (:real)`, EXISTS_TAC `{f| f complex_measurable_on (:real) /\ (\x. norm (f x) pow 2) real_integrable_on (:real)}` THEN SIMP_TAC[IN_ELIM_THM]));; let r_inprod = new_definition `r_inprod f g = complex(real_integral (:real) (\x:real. Re (cnj (f x) * (g x))), real_integral (:real) (\x. Im (cnj (f x) * (g x))) )`;; (*****************************************************************************) (*We will prove each property of the inner space in the following *) (*theorems. We will conclude all properties in one theorem at the very end *) (*****************************************************************************) let FRECHET_REAL_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL = prove (`!f f' f'' x a b. a < b /\ x IN real_interval[a,b] /\ (f has_real_derivative f') (atreal x within (real_interval[a,b])) /\ (f has_real_derivative f'') (atreal x within (real_interval[a,b])) ==> f' = f''`, let tem = REWRITE_RULE[MESON[] `A/\B/\C ==> Q <=> C ==> A /\ B ==> Q `] FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL in REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN ] THEN REWRITE_TAC[MESON[] `A/\B/\C ==> Q <=> C ==> A /\ B ==> Q `; IMAGE_LIFT_REAL_INTERVAL ] THEN DISCH_THEN (ASSUME_TAC o (MATCH_MP tem)) THEN POP_ASSUM(ASSUME_TAC o( SIMP_RULE[LIFT_IN_INTERVAL ;DIMINDEX_1;LIFT_DROP; ARITH_RULE`x <= i /\ i <= x <=> i=(x:num)`;lift;LAMBDA_BETA])) THEN DISCH_THEN (fun th1 -> POP_ASSUM (MP_TAC o (SIMP_RULE[GSYM LIFT_EQ_CMUL; LIFT_EQ])o(Pa.SPEC `vec 1:`)o (SIMP_RULE[th1;FUN_EQ_THM]))) THEN REWRITE_TAC[]);; let cfun_almost_zero = new_specification ["cfun_almost_zero"] (prove(`?f.(?k. real_negligible k /\ !x. ~(x IN k) ==> f x = Cx(&0))`, Pa.EXISTS_TAC `cfun_zero:` THEN REWRITE_TAC[cfun_zero;K_THM]THEN Pa.EXISTS_TAC `{}:` THEN REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY]));; let is_almost_zero = new_definition `is_almost_zero1 f = !a b. (?k. real_negligible k /\ !x. x IN real_interval[a,b] DIFF k ==> f x = Cx(&0))`;; let REAL_INTEGRA_ZERO_SUBINTERVALS = prove (`!f. (!x. &0 <= f x) /\ (f has_real_integral &0) (:real) ==> !a b. (f has_real_integral &0) (real_interval[a,b])`, REPEAT STRIP_TAC THEN Pa.ASM_CASES_TAC `b<=a:` THENL[ASM_SIMP_TAC[HAS_REAL_INTEGRAL_NULL];ALL_TAC] THEN Pa.SUBGOAL_THEN `!a b. f real_integrable_on (real_interval[a,b]):` ASSUME_TAC THENL[ RULE_ASSUM_TAC(REWRITE_RULE[HAS_REAL_INTEGRAL_ALT;SET_RULE `x IN (:real)`;ETA_AX]) THEN ASM_REWRITE_TAC[];ALL_TAC] THEN MP_TAC (Pa.SPECL [`f:`;`real_interval[a,b]:`] REAL_INTEGRAL_POS) THEN ASM_SIMP_TAC[] THEN MP_TAC (Pa.SPECL [`f:`;`real_interval[a,b]:`;`(:real):`] REAL_INTEGRAL_SUBSET_LE) THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL]) THEN IMP_REWRITE_TAC[SET_RULE `!s. ~(s={}) ==> s SUBSET (:real)`; REAL_INTERVAL_NE_EMPTY;GSYM REAL_LE_ANTISYM; HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN ASM_SIMP_TAC[REAL_ARITH `~(b <= a) ==> a <= b`]);; let REAL_POW2_0 = REWRITE_RULE[REAL_ADD_LID;REAL_POW_ZERO; ARITH] (SPEC `&0` REAL_SOS_EQ_0);; let RINPROD_ALMOST_ZERO = prove( `!f. f IN sq_integrable ==> (r_inprod f f = Cx (&0) <=> is_almost_zero1 f)`, REWRITE_TAC[sq_integrable;r_inprod;r_inprod;RE_CX;IM_CX;GSYM CX_DEF; COMPLEX_MUL_CNJ;GSYM CX_POW;REAL_INTEGRAL_0; CX_INJ] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL[ POP_ASSUM MP_TAC THEN REWRITE_TAC[MESON[] `P==>Q==>A <=> P/\Q ==>A`] THEN DISCH_THEN (fun thm -> ASSUME_TAC(REWRITE_RULE [GSYM HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] thm) THEN MP_TAC thm) THEN Pa.SUBGOAL_THEN `!a b. (\x. norm (f x) pow 2) real_integrable_on (real_interval[a,b]):` ASSUME_TAC THENL[ RULE_ASSUM_TAC(REWRITE_RULE[HAS_REAL_INTEGRAL_ALT;SET_RULE `x IN (:real)`;ETA_AX]) THEN ASM_REWRITE_TAC[];ALL_TAC] THEN MP_TAC (Pa.SPEC `(\x. norm ((f:real->complex) x) pow 2):` HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL) THEN ASM_REWRITE_TAC[] THEN MP_TAC (Pa.SPEC `(\x. norm ((f:real->complex) x) pow 2):` REAL_INTEGRA_ZERO_SUBINTERVALS) THEN ASM_SIMP_TAC[REAL_LE_POW_2;HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(!a b. ?k. real_negligible k /\ (!x. x IN real_interval [a,b] DIFF k ==> ((\x. &0) has_real_derivative norm ((f:real->complex) x) pow 2) (atreal x within real_interval [a,b]))) ==> (!a b. ?k. real_negligible k /\ (!x. x IN real_interval [a,b] DIFF k ==> norm (f x) pow 2 = &0))` ASSUME_TAC THENL[REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o SPECL [`a:real`;`b:real`]) THEN REPEAT STRIP_TAC THEN Pa.ASM_CASES_TAC `a < b:` THENL[ Pa.EXISTS_TAC `k:` THEN ASM_SIMP_TAC[] THEN ASSUME_TAC (Pa.SPECL [`&0:`;`atreal x within real_interval [a,b]:`] HAS_REAL_DERIVATIVE_CONST) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_REAL_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL THEN MAP_EVERY Pa.EXISTS_TAC [`(\x. &0):`;`x':`;`a:`;`b:`] THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[IN_DIFF ]; Pa.EXISTS_TAC `{a}:` THEN ASM_SIMP_TAC[REAL_NEGLIGIBLE_FINITE ;FINITE_SING;real_interval;IN_ELIM_THM;IN_DIFF;IN_SING] THEN ASM_MESON_TAC[REAL_FIELD `~(a < b) /\ (a <= x /\ x <= b) /\ ~(x = a) <=> F`]];ALL_TAC] THEN DISCH_THEN (fun th -> POP_ASSUM (fun th1 -> ASSUME_TAC (SIMP_RULE[REAL_POW2_0;COMPLEX_NORM_ZERO ](MATCH_MP th1 th)))) THEN ASM_SIMP_TAC[is_almost_zero];ALL_TAC] THEN REWRITE_TAC[is_almost_zero] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_REAL_INTEGRAL_ALT;SET_RULE `x IN (:real)`] THEN Pa.SUBGOAL_THEN `!a b. ((\x. norm (f x) pow 2) has_real_integral &0) (real_interval [a,b]):` ASSUME_TAC THENL[ IMP_REWRITE_TAC[HAS_REAL_INTEGRAL_NEGLIGIBLE;REAL_POW2_0;COMPLEX_NORM_ZERO ]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[HAS_REAL_INTEGRAL_INTEGRABLE]; EXISTS_TAC `&1` THEN ASM_SIMP_TAC [REAL_ARITH `&0 < &1`] THEN REPEAT STRIP_TAC THEN IMP_REWRITE_TAC[REAL_INTEGRAL_UNIQUE] THEN EXISTS_TAC `&0` THEN ASM_SIMP_TAC [REAL_ARITH `&0 - &0 = &0`;REAL_ABS_NUM]]);; let ALOMST_ZERO_ZERO = prove (`!f g. is_almost_zero1 f ==> r_inprod g f = Cx(&0)`, REWRITE_TAC[r_inprod;COMPLEX_EQ;CX_DEF;RE;IM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_REAL_INTEGRAL_ALT;SET_RULE `x IN (:real)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[is_almost_zero]) THENL[Pa.SUBGOAL_THEN `!a b. ((\x. Re (cnj (g x) * f x)) has_real_integral &0) (real_interval [a,b]):` ASSUME_TAC THENL[ REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_NEGLIGIBLE THEN POP_ASSUM ( (X_CHOOSE_TAC `s:real->bool`) o SPEC_ALL) THEN Pa.EXISTS_TAC `s:` THEN ASM_SIMP_TAC[COMPLEX_MUL_RZERO;RE_CX;IM_CX];ALL_TAC]; Pa.SUBGOAL_THEN `!a b. ((\x. Im (cnj (g x) * f x)) has_real_integral &0) (real_interval [a,b]):` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_NEGLIGIBLE THEN POP_ASSUM ( (X_CHOOSE_TAC `s:real->bool`) o SPEC_ALL) THEN Pa.EXISTS_TAC `s:` THEN ASM_SIMP_TAC[COMPLEX_MUL_RZERO;RE_CX;IM_CX];ALL_TAC]] THEN ASM_MESON_TAC[REAL_SUB_RZERO;HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL;REAL_ABS_0]);; let RINPROD_ZERO_EQ = prove (`!x y. x IN sq_integrable /\ r_inprod x x = Cx(&0) ==> r_inprod y x = Cx(&0)`, MESON_TAC[ALOMST_ZERO_ZERO;RINPROD_ALMOST_ZERO]);; let SQ_RULE = REAL_FIELD `(a+b) pow 2 = a pow 2 + b pow 2 + &2 * a * b`;; let SQ_RULE_SUB = REAL_FIELD `(a-b) pow 2 = a pow 2 + b pow 2 - &2 * a * b`;; let ABS_POW_2 = MESON[REAL_ABS_REFL;REAL_LE_POW_2] `!x. abs (x pow 2) = x pow 2`;; let SQ_INTEGRABLE_SUBSPACE = prove( `is_cfun_subspace sq_integrable`, REWRITE_TAC[is_cfun_subspace;sq_integrable;complex_measurable;cfun_zero; K_THM;RE_CX;IM_CX;REAL_MEASURABLE_ON_0;COMPLEX_NORM_0;REAL_POW_ZERO; ARITH;REAL_INTEGRABLE_0] THEN REPEAT STRIP_TAC THENL[ ASM_SIMP_TAC[CFUN_SMUL;REAL_MEASURABLE_ON_LMUL;RE;complex_mul; REAL_MEASURABLE_ON_SUB] ;ASM_SIMP_TAC[CFUN_SMUL;REAL_MEASURABLE_ON_LMUL;IM;complex_mul; REAL_MEASURABLE_ON_ADD] ;ASM_SIMP_TAC[CFUN_SMUL;COMPLEX_NORM_MUL;REAL_POW_MUL;REAL_INTEGRABLE_LMUL] ;ASM_SIMP_TAC[CFUN_ADD_THM;RE_ADD;REAL_MEASURABLE_ON_ADD] ;ASM_SIMP_TAC[CFUN_ADD_THM;IM_ADD;REAL_MEASURABLE_ON_ADD] ;RULE_ASSUM_TAC(REWRITE_RULE[SQ_RULE;COMPLEX_SQNORM]) THEN ASM_SIMP_TAC[CFUN_ADD_THM;complex_add;COMPLEX_SQNORM;RE;IM;SQ_RULE; REAL_FIELD `((a1:real)+b1+c1) + a2 + b2 + c2 = (a1+a2) + (b1+b2) + c1+ c2`] THEN MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.( Re (x x') pow 2 + Im (x x') pow 2) + (Re (y x') pow 2 + Im (y x') pow 2):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_ABS_MUL;REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+a2-c1)+b1+b2`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2]; ALL_TAC] THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.( Re (x x') pow 2 + Im (x x') pow 2) + (Re (y x') pow 2 + Im (y x') pow 2):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_ABS_MUL;REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+a2)+(b1+b2-c1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2]]);; let RINPROD_SELF_POS = prove( `!f. f IN sq_integrable ==> real (r_inprod f f) /\ &0 <= real_of_complex (r_inprod f f)`, REWRITE_TAC[sq_integrable;REAL;r_inprod;COMPLEX_MUL_CNJ;RE_CX;IM_CX;GSYM CX_POW ;RE;IM;REAL_INTEGRAL_0;GSYM CX_DEF;REAL_OF_COMPLEX_CX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[REAL_LE_POW_2]);; let RINPROD_CNJ = prove( `!f g. f IN sq_integrable /\ g IN sq_integrable ==> cnj (r_inprod f g) = r_inprod g f`, REWRITE_TAC[sq_integrable;complex_measurable;RE;IM;cnj;COMPLEX_SQNORM; r_inprod;complex_mul] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN REPEAT STRIP_TAC THENL[AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Re (f x) * Im (g x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (g x') pow 2 + Im (g x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+b2-c1)+(b1+a2)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Im (f x) * Re (g x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (g x') pow 2 + Im (g x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (b1+a2-c1)+(b2+a1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_NEG_LMUL;REAL_INTEGRABLE_SUB;REAL_INTEGRABLE_NEG;REAL_INTEGRABLE_ADD; GSYM REAL_INTEGRAL_NEG] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC);; let RINPROD_RSMUL = prove( `!f g a. f IN sq_integrable /\ g IN sq_integrable ==> r_inprod f (a%g) = a * r_inprod f g`, REWRITE_TAC[sq_integrable;complex_measurable;CFUN_SMUL;RE;IM;cnj;COMPLEX_SQNORM; r_inprod;complex_mul] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN Pa.SUBGOAL_THEN `(\x. Re (f x) * Im (g x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (g x') pow 2 + Im (g x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+b2-c1)+(b1+a2)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Im (f x) * Re (g x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (g x') pow 2 + Im (g x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (b1+a2-c1)+(b2+a1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Re (f x) * Re (g x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (g x') pow 2 + Im (g x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+a2-c1)+(b2+b1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Im (f x) * Im (g x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (g x') pow 2 + Im (g x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (b1+b2-c1)+(a2+a1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN IMP_REWRITE_TAC[GSYM REAL_NEG_LMUL;REAL_INTEGRABLE_SUB; REAL_INTEGRABLE_NEG;REAL_INTEGRABLE_ADD; GSYM REAL_INTEGRAL_LMUL;REAL_INTEGRABLE_LMUL; GSYM REAL_INTEGRAL_SUB;GSYM REAL_INTEGRAL_ADD] THEN REPEAT STRIP_TAC THEN ((AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC) ORELSE (MATCH_MP_TAC REAL_INTEGRABLE_LMUL ORELSE ALL_TAC)) THEN (MATCH_MP_TAC REAL_INTEGRABLE_SUB ORELSE MATCH_MP_TAC REAL_INTEGRABLE_ADD) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_NEG]);; let RINPROD_LADD = prove (`!f g z. f IN sq_integrable /\ g IN sq_integrable /\ z IN sq_integrable ==> r_inprod (f+g) z= r_inprod f z + r_inprod g z`, REWRITE_TAC[sq_integrable;complex_measurable;CFUN_ADD_THM;RE;IM;cnj;COMPLEX_SQNORM; r_inprod;complex_mul;RE_ADD;IM_ADD;GSYM REAL_NEG_LMUL;REAL_SUB_RNEG; REAL_ADD_RDISTRIB;GSYM real_sub;complex_add] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN Pa.SUBGOAL_THEN `(\x. Re (f x) * Im (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+b2-c1)+(b1+a2)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Im (f x) * Re (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (b1+a2-c1)+(b2+a1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Re (g x) * Im (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (g x') pow 2 + Im (g x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+b2-c1)+(b1+a2)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Im (g x) * Re (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (g x') pow 2 + Im (g x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (b1+a2-c1)+(b2+a1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Re (f x) * Re (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+a2-c1)+(b2+b1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Im (f x) * Im (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (f x') pow 2 + Im (f x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (b1+b2-c1)+(a2+a1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Re (g x) * Re (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (g x') pow 2 + Im (g x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (a1+a2-c1)+(b2+b1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN Pa.SUBGOAL_THEN `(\x. Im (g x) * Im (z x)) real_integrable_on (:real):` ASSUME_TAC THENL[ MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN Pa.EXISTS_TAC `\x'.inv (&2) * (( Re (g x') pow 2 + Im (g x') pow 2) + (Re (z x') pow 2 + Im (z x') pow 2)):` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_LMUL;REAL_MEASURABLE_ON_MUL; REAL_INTEGRABLE_ADD;REAL_INTEGRABLE_LMUL;REAL_ABS_MUL;REAL_ABS_NUM ;REAL_FIELD `x <= inv (&2) * y <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM ABS_POW_2] THEN REWRITE_TAC[REAL_ARITH `(((a1:real)+b1)+a2+b2)-c1 = (b1+b2-c1)+(a2+a1)`; GSYM SQ_RULE_SUB;REAL_ABS_POW] THEN MESON_TAC[REAL_LE_ADD;REAL_LE_POW_2] ;ALL_TAC] THEN IMP_REWRITE_TAC[GSYM REAL_NEG_LMUL;REAL_INTEGRABLE_SUB; REAL_INTEGRABLE_NEG;REAL_INTEGRABLE_ADD; GSYM REAL_INTEGRAL_LMUL;REAL_INTEGRABLE_LMUL; GSYM REAL_INTEGRAL_SUB;GSYM REAL_INTEGRAL_ADD] THEN REPEAT STRIP_TAC THEN ((AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC) ORELSE (MATCH_MP_TAC REAL_INTEGRABLE_LMUL ORELSE ALL_TAC)) THEN (MATCH_MP_TAC REAL_INTEGRABLE_SUB ORELSE MATCH_MP_TAC REAL_INTEGRABLE_ADD) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_NEG]);; let SQ_INTEGRABLE_INNER_SPACE = prove (`is_inner_space (sq_integrable, r_inprod)`, REWRITE_TAC[is_inner_space] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RINPROD_LADD;RINPROD_RSMUL;RINPROD_RSMUL;RINPROD_ZERO_EQ;RINPROD_CNJ; RINPROD_SELF_POS;SQ_INTEGRABLE_SUBSPACE] );; hol-light/Functionspaces/README000066400000000000000000000011031303454263000166040ustar00rootroot00000000000000 Library of complex function vector spaces (c) Copyright, Mohamed Yousri Mahmoud, Vincent Aravantinos, 2012-2013 Hardware Verification Group, Concordia University Contact: , Distributed with HOL Light under same license terms hol-light/Functionspaces/cfunspace.ml000066400000000000000000003327141303454263000202440ustar00rootroot00000000000000(* ========================================================================= *) (* *) (* Library of complex function vector spaces. *) (* *) (* (c) Copyright, Mohamed Yousri Mahmoud, Vincent Aravantinos, 2012-2013 *) (* Hardware Verification Group, *) (* Concordia University *) (* *) (* Contact: , *) (* Last update: April 2016 *) (* ========================================================================= *) needs "Functionspaces/utils.ml";; (* ------------------------------------------------------------------------- *) (* EMBEDDING OF REALS IN COMPLEX NUMBERS *) (* ------------------------------------------------------------------------- *) let real_of_complex = new_definition `real_of_complex c = @r. c = Cx r`;; let REAL_OF_COMPLEX = prove (`!c. real c ==> Cx(real_of_complex c) = c`, MESON_TAC[REAL;real_of_complex]);; let REAL_OF_COMPLEX_RE = prove (`!c. real c ==> real_of_complex c = Re c`, MESON_TAC[RE_CX;REAL_OF_COMPLEX]);; let REAL_OF_COMPLEX_CX = prove (`!r. real_of_complex (Cx r) = r`, SIMP_TAC[REAL_CX;REAL_OF_COMPLEX_RE;RE_CX]);; let REAL_OF_COMPLEX_NORM = prove (`!c. real c ==> norm c = abs (real_of_complex c)`, IMP_REWRITE_TAC[REAL_NORM;REAL_OF_COMPLEX_RE]);; let REAL_OF_COMPLEX_ADD = prove (`!x y. real x /\ real y ==> real_of_complex (x+y) = real_of_complex x + real_of_complex y`, MESON_TAC[REAL_ADD;REAL_OF_COMPLEX_RE;RE_ADD]);; let REAL_OF_COMPLEX_SUB = prove (`!x y. real x /\ real y ==> real_of_complex (x-y) = real_of_complex x - real_of_complex y`, MESON_TAC[REAL_SUB;REAL_OF_COMPLEX_RE;RE_SUB]);; let REAL_OF_COMPLEX_ZERO = prove (`!x y. real x ==> (real_of_complex x = &0 <=> x = Cx(&0))`, MESON_TAC[ REAL_OF_COMPLEX_RE;real; SIMPLE_COMPLEX_ARITH `Im x = &0 ==> (Re x = &0 <=> x = Cx(&0))`]);; let REAL_MUL = prove (`!x y. real x /\ real y ==> real (x*y)`, REWRITE_TAC[real] THEN SIMPLE_COMPLEX_ARITH_TAC);; let REAL_OF_COMPLEX_MUL = prove (`!x y. real x /\ real y ==> real_of_complex (x*y) = real_of_complex x * real_of_complex y`, MESON_TAC[REAL_MUL;REAL_OF_COMPLEX;CX_MUL;REAL_OF_COMPLEX_CX]);; let NORM2_ADD_REAL = prove (`!x y. real x /\ real y ==> norm (x + ii * y) pow 2 = norm x pow 2 + norm y pow 2`, SIMP_TAC[real;complex_norm;RE_ADD;IM_ADD;RE_MUL_II;IM_MUL_II;REAL_NEG_0; REAL_ADD_LID;REAL_ADD_RID;REAL_POW_ZERO;ARITH_RULE `~(2=0)`;REAL_LE_POW_2; SQRT_POW_2;REAL_LE_ADD]);; let real_thms = ref [];; let add_real_thm thm = real_thms := GIMP_IMP thm :: !real_thms;; let add_real_thms = List.iter add_real_thm;; let REAL_TAC ?(alternatives=[]) g = let is_meta_variable v = try (fst (dest_var v)).[0] = '_' with _ -> false in let contain_meta_variable = can (find_term is_meta_variable) in let MATCH_MP_TAC x = (fun g -> MATCH_MP_TAC x g) THEN (fun (_,concl as g) -> if contain_meta_variable concl then NO_TAC g else ALL_TAC g) in let TRY_REAL_THM = ASM (MAP_FIRST (fun x -> MATCH_ACCEPT_TAC x ORELSE MATCH_MP_TAC x)) !real_thms in let LOOP = TRY_REAL_THM ORELSE (ASM_SIMP_TAC[] THEN NO_TAC) ORELSE (CHANGED_TAC (ASM_SIMP_TAC[real]) THEN CONV_TAC COMPLEX_FIELD) ORELSE FIRST alternatives in (REPEAT STRIP_TAC THEN (fun (_,concl as g) -> if not (repeat rator concl = `real :complex -> bool`) then FAIL_TAC "bad goal" g else CHANGED_TAC (REPEAT (LOOP THEN REPEAT CONJ_TAC)) g)) g;; add_real_thm REAL_MUL;; (* ------------------------------------------------------------------------- *) (* MAP OVER FUNCTIONS *) (* ------------------------------------------------------------------------- *) let fun_map2 = new_definition `fun_map2 (f:B->C->D) (g1:A->B) (g2:A->C) = \x. f (g1 x) (g2 x)`;; let FUN_MAP2_THM = prove (`!f g1 g2 x. fun_map2 f g1 g2 x = f (g1 x) (g2 x)`, REWRITE_TAC[fun_map2]);; let K_DEF = new_definition `K (x:A) = \y:B. x`;; let K_THM = prove (`!x y. K x y = x`, REWRITE_TAC[K_DEF]);; let fun_map_defs = CONJS [K_DEF;o_DEF;fun_map2];; let FUN_MAP_THMS = CONJS [K_THM;o_THM;FUN_MAP2_THM];; (* --------------------------------------------------------------------------- *) (* COMPLEX VALUED FUNCTIONS *) (* --------------------------------------------------------------------------- *) new_type_abbrev("cfun",`:A->complex`);; new_type_abbrev("cfunB",`:B->complex`);; new_type_abbrev("cfunC",`:C->complex`);; let cfun_add = new_definition `cfun_add:cfun->cfun->cfun = fun_map2 (+)`;; let cfun_smul = new_definition `cfun_smul (a:complex) :cfun->cfun = (o) (( * ) a)`;; let cfun_neg = new_definition `cfun_neg:cfun->cfun = (o) (--)`;; let cfun_sub = new_definition `cfun_sub:cfun->cfun->cfun = fun_map2 (-)`;; let cfun_zero = new_definition `cfun_zero:cfun = K (Cx(&0))`;; let cfun_cnj = new_definition `cfun_cnj:cfun->cfun = (o) cnj`;; let cfun_defs = CONJS [cfun_add;cfun_sub;cfun_smul;cfun_neg;cfun_cnj;cfun_zero];; make_overloadable "%" `:A->B->B`;; parse_as_infix("%",(25,"left"));; let prioritize_cfun () = overload_interface("+",`cfun_add:cfun->cfun->cfun`); overload_interface("%",`cfun_smul:complex->cfun->cfun`); overload_interface("--",`cfun_neg : cfun->cfun`); overload_interface("-",`cfun_sub:cfun->cfun->cfun`);; prioritize_cfun ();; (* Intended restriction of FUN_EQ_THM to the type :cfun *) let CFUN_EQ = prove (`!f g:cfun. f = g <=> !x. f x = g x`, REWRITE_TAC[FUN_EQ_THM]);; let CFUN_TO_COMPLEX = CONJS [FUN_MAP_THMS;cfun_defs;CFUN_EQ];; (* General tactic *) let CFUN_ARITH_TAC = let lemma = MESON[] `(!x. P x <=> Q x) ==> (!x. P x) = (!x. Q x)` in REWRITE_TAC[CFUN_TO_COMPLEX] THEN (CONV_TAC COMPLEX_FIELD ORELSE SIMPLE_COMPLEX_ARITH_TAC ORELSE (REPEAT STRIP_TAC THEN CONV_TAC PRENEX_CONV THEN MATCH_MP_TAC lemma THEN CONV_TAC COMPLEX_FIELD));; let CFUN_ARITH t = prove(t,CFUN_ARITH_TAC);; (* Properties *) let CFUN_SUB = CFUN_ARITH `!f g. f - g = \x. f x - g x`;; let CFUN_SUB_THM = CFUN_ARITH `!f g. (f - g) x = f x - g x`;; let CFUN_ADD = CFUN_ARITH `!f g. f + g = \x. f x + g x`;; let CFUN_ADD_THM = CFUN_ARITH `!f g. (f + g) x = f x + g x`;; let CFUN_SMUL = CFUN_ARITH `!a f. a % f = \x. a * f x`;; let CFUN_NEG_LAMBDA = CFUN_ARITH `!f. --f = \x. --(f x)`;; let CFUN_SMUL_LNEG = CFUN_ARITH `!a f. (--a) % f = --(a % f)`;; let CFUN_SMUL_RNEG = CFUN_ARITH `!a f. a % (--f) = --(a % f)`;; let CFUN_ADD_SYM = CFUN_ARITH `!x y. x + y = y + x`;; let CFUN_ADD_ASSOC = CFUN_ARITH `!x y z. (x + y) + z = x + y + z`;; let CFUN_SUB_NEG = CFUN_ARITH `!x y. x - y = x + --y`;; let CFUN_SMUL_LZERO = CFUN_ARITH `!x. Cx(&0) % x = cfun_zero`;; let CFUN_ADD_LID = CFUN_ARITH `!x. cfun_zero + x = x`;; let CFUN_ADD_RID = CFUN_ARITH `!x. x + cfun_zero = x`;; let CFUN_SUB_RID = CFUN_ARITH `!x. x - cfun_zero = x`;; let CFUN_SMUL_RZERO = CFUN_ARITH `!a. a % cfun_zero = cfun_zero`;; let CFUN_SUB_REFL = CFUN_ARITH `!x. x - x = cfun_zero`;; let CFUN_ZERO_CLAUSES = CONJS [CFUN_SUB_REFL;CFUN_ADD_RID;CFUN_SMUL_LZERO;CFUN_SMUL_RZERO];; let CFUN_SMUL_SYM = CFUN_ARITH `!a b x. a % (b % x) = b % (a % x)`;; let CFUN_SMUL_DIS = CFUN_ARITH `!a x y. a % (x + y) = a % x + a % y`;; let CFUN_SMUL_ASSOC = CFUN_ARITH `!a b x. a % (b % x) = (a * b) % x`;; let CFUN_ADD_RDISTRIB = CFUN_ARITH `!a b x. (a + b) % x = a % x + b % x`;; let CFUN_SUB_RDISTRIB = CFUN_ARITH `!a b x. (a - b) % x = a % x - b % x`;; let CFUN_SUB_RADD = CFUN_ARITH `!x y z. x - (y + z) = x - y - z`;; let CFUN_ADD_RSUB = CFUN_ARITH `!x y z. x + (y - z) = (x + y) - z`;; let CFUN_SUB_ADD = CFUN_ARITH `!x y z. (x - y) + z= (x + z) - y`;; let CFUN_SUB_SUB = CFUN_ARITH `!x y z. x - (y - z) = x - y + z`;; let CFUN_EQ_LSUB = CFUN_ARITH `!x y z. x - y = z <=> x = z + y`;; let CFUN_EQ_RSUB = CFUN_ARITH `!x y z. x = y - z <=> x + z = y`;; let CFUN_ZERO_ADD = CFUN_ARITH `!x y. y + x = x <=> y = cfun_zero`;; let CFUN_SUB_LDISTRIB = CFUN_ARITH `!a x y. a % (x - y) = a % x - a % y`;; let CFUN_ADD_LDISTRIB = CFUN_ARITH `!a x y. a % (x + y) = a % x + a % y`;; let CFUN_SMUL_DISTRIB = CFUN_ARITH `!a b f. a % (b % f) = (a * b) % f`;; let CFUN_SMUL_LID = CFUN_ARITH `!v. Cx(&1) % v = v`;; let CFUN_SMUL_LID_NEG = CFUN_ARITH `!v. (--Cx(&1)) % v = --v`;; let CFUN_EQ_NEG2 = CFUN_ARITH `!x y. --x = --y <=> x = y`;; let CFUN_EQ_ADD_LCANCEL = CFUN_ARITH `!x y z. x + y = x + z <=> y = z`;; let CFUN_EQ_ADD_RCANCEL = CFUN_ARITH `!x y z. x + z = y + z <=> x = y`;; let CFUN_EQ_SUB_LCANCEL = CFUN_ARITH `!x y z. x - y = x - z <=> y = z`;; let CFUN_EQ_SUB_RADD = CFUN_ARITH `!x y z. x - y = z <=> x = z + y`;; let CFUN_SUB_ADD2 = CFUN_ARITH `!x y. y + x - y = x`;; let CFUN_SUB_0 = CFUN_ARITH `!x y. x - y = cfun_zero <=> x = y`;; let CFUN_ENTIRE = CFUN_ARITH `!a x. a % x = cfun_zero <=> a = Cx(&0) \/ x = cfun_zero`;; let CFUN_EQ_SMUL_LCANCEL = CFUN_ARITH `!x y a. a % x = a % y <=> a = Cx(&0) \/ x = y`;; let CFUN_EQ_SMUL_LCANCEL2 = prove (`!a x y. ~(a=Cx(&0)) ==> (a % x = y <=> x = inv a % y)`, REWRITE_TAC[CFUN_TO_COMPLEX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (MESON[] `(!x. P x <=> Q x) ==> (!x. P x) = (!x. Q x)`) THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; (* Sub-space *) let is_cfun_subspace = new_definition `is_cfun_subspace (spc:cfun->bool) <=> cfun_zero IN spc /\ !x. x IN spc ==> (!a. a % x IN spc) /\ !y. y IN spc ==> x+y IN spc`;; let CFUN_SUBSPACE_ZERO = prove (`!s. is_cfun_subspace s ==> cfun_zero IN s`, SIMP_TAC[is_cfun_subspace]);; let CFUN_SUBSPACE_SMUL = prove (`!s a x. is_cfun_subspace s /\ x IN s ==> a%x IN s`, SIMP_TAC[is_cfun_subspace]);; let CFUN_SUBSPACE_ADD = prove (`!s x y. is_cfun_subspace s /\ x IN s /\ y IN s ==> x+y IN s`, SIMP_TAC[is_cfun_subspace]);; let CFUN_SUBSPACE_NEG = prove (`!s x. is_cfun_subspace s /\ x IN s ==> --x IN s`, SIMP_TAC[GSYM CFUN_SMUL_LID_NEG;CFUN_SUBSPACE_SMUL]);; let CFUN_SUBSPACE_SUB = prove (`!s x y. is_cfun_subspace s /\ x IN s /\ y IN s ==> x-y IN s`, SIMP_TAC[CFUN_SUB_NEG;CFUN_SUBSPACE_NEG;CFUN_SUBSPACE_ADD]);; let CFUN_SUBSPACE_SING_CFUNZERO = prove (`is_cfun_subspace {cfun_zero}`, SIMP_TAC[is_cfun_subspace;IN_SING;CFUN_SMUL_RZERO;CFUN_ADD_RID]);; (* ------------------------------------------------------------------------- *) (* EMBEDDING COMPLEX NUMBERS IN CFUNS *) (* ------------------------------------------------------------------------- *) let SING_IND,SING_REC = define_type "singleton = SING_ELT";; let SING_EQ = prove (`!x. x = SING_ELT`, MATCH_MP_TAC SING_IND THEN REFL_TAC);; let cfun_of_complex = new_definition `cfun_of_complex = K :complex->singleton->complex`;; let CFUN_OF_COMPLEX_ADD = prove (`!x y. cfun_of_complex (x+y) = cfun_of_complex x + cfun_of_complex y`, REWRITE_TAC[cfun_of_complex] THEN CFUN_ARITH_TAC);; let CFUN_OF_COMPLEX_SUB = prove (`!x y. cfun_of_complex (x-y) = cfun_of_complex x - cfun_of_complex y`, REWRITE_TAC[cfun_of_complex] THEN CFUN_ARITH_TAC);; let CFUN_OF_COMPLEX_NEG = prove (`!x. cfun_of_complex (--x) = -- cfun_of_complex x`, REWRITE_TAC[cfun_of_complex] THEN CFUN_ARITH_TAC);; let CFUN_OF_COMPLEX_SMUL = prove (`!a x. cfun_of_complex (a*x) = a % cfun_of_complex x`, REWRITE_TAC[cfun_of_complex] THEN CFUN_ARITH_TAC);; let CFUN_OF_COMPLEX_CNJ = prove (`!x. cfun_of_complex (cnj x) = cfun_cnj (cfun_of_complex x)`, REWRITE_TAC[cfun_of_complex] THEN CFUN_ARITH_TAC);; let CFUN_OF_COMPLEX_ZERO = prove (`cfun_of_complex (Cx(&0)) = cfun_zero`, REWRITE_TAC[cfun_of_complex] THEN CFUN_ARITH_TAC);; let complex_of_cfun = new_definition `complex_of_cfun f :complex = f SING_ELT`;; let COMPLEX_OF_CFUN_ADD = prove (`!x y. complex_of_cfun (x + y) = complex_of_cfun x + complex_of_cfun y`, REWRITE_TAC[complex_of_cfun] THEN CFUN_ARITH_TAC);; let COMPLEX_OF_CFUN_SUB = prove (`!x y. complex_of_cfun (x - y) = complex_of_cfun x - complex_of_cfun y`, REWRITE_TAC[complex_of_cfun] THEN CFUN_ARITH_TAC);; let COMPLEX_OF_CFUN_NEG = prove (`!x. complex_of_cfun (--x) = -- complex_of_cfun x`, REWRITE_TAC[complex_of_cfun] THEN CFUN_ARITH_TAC);; let COMPLEX_OF_CFUN_SMUL = prove (`!a x. complex_of_cfun (a % x) = a * complex_of_cfun x`, REWRITE_TAC[complex_of_cfun] THEN CFUN_ARITH_TAC);; let COMPLEX_OF_CFUN_OF_COMPLEX = prove (`complex_of_cfun o cfun_of_complex = I`, REWRITE_TAC[complex_of_cfun;cfun_of_complex;o_DEF;K_THM;I_DEF]);; let CFUN_OF_COMPLEX_OF_CFUN = prove (`cfun_of_complex o complex_of_cfun = I`, REWRITE_TAC[complex_of_cfun;cfun_of_complex;o_DEF;K_DEF;FUN_EQ_THM;I_THM] THEN ONCE_REWRITE_TAC[SING_EQ] THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* INNER PRODUCT *) (* ------------------------------------------------------------------------- *) new_type_abbrev("inprod",`:cfun->cfun->complex`);; parse_as_infix("equv",(24,"left"));; let are_equv = new_definition ` ((f:cfun) equv (g:cfun)) inprod <=> inprod (f-g) (f-g) = Cx(&0)`;; new_type_abbrev("inner_space",`:(cfun->bool)#inprod`);; let is_inner_space = new_definition `is_inner_space ((s,inprod):inner_space) <=> is_cfun_subspace s /\ !x. x IN s ==> real (inprod x x) /\ &0 <= real_of_complex (inprod x x) /\ !y. y IN s ==> (inprod x x = Cx(&0) ==> inprod y x = Cx(&0)) /\ cnj (inprod y x) = inprod x y /\ (!a. inprod x (a%y) = a * (inprod x y)) /\ !z. z IN s ==> inprod (x+y) z = inprod x z + inprod y z`;; (* EVERY THEOREM proved using "inner_space_prove" implicitly has the assumption * "!s inprod. is_inner_space (s,inprod) ==>" *) let inner_space_parse s = parse_term (`!s inprod. is_inner_space (s,inprod) ==> :` ^ s);; let inner_space_prove (s,p) = prove(gimp_imp (inner_space_parse s),p);; let inner_space_g s = g (gimp_imp (inner_space_parse s));; let full_inner_space_parse s = parse_term (`!is. is_inner_space is ==> :` ^ s);; let full_inner_space_prove (s,p) = prove(gimp_imp (full_inner_space_parse s),p);; let full_inner_space_g s = g (gimp_imp (full_inner_space_parse s));; let FORALL_INNER_SPACE_THM = prove (`!P. (!is:inner_space. P is) <=> !s inprod. P (s,inprod)`, REWRITE_TAC[FORALL_PAIR_THM]);; let INNER_SPACE_IS_SUBSPACE = inner_space_prove (`is_cfun_subspace s:`, SIMP_TAC[is_inner_space]);; let INNER_SPACE_ZERO = inner_space_prove (`cfun_zero IN s:`, MESON_TAC[INNER_SPACE_IS_SUBSPACE;CFUN_SUBSPACE_ZERO]);; let INNER_SPACE_SMUL = inner_space_prove (`!x a. x IN s ==> a%x IN s:`, MESON_TAC[INNER_SPACE_IS_SUBSPACE;CFUN_SUBSPACE_SMUL]);; let INNER_SPACE_ADD = inner_space_prove (`!x y. x IN s /\ y IN s ==> x+y IN s:`, MESON_TAC[INNER_SPACE_IS_SUBSPACE;CFUN_SUBSPACE_ADD]);; let INNER_SPACE_NEG = inner_space_prove (`!x. x IN s ==> --x IN s:`, MESON_TAC[INNER_SPACE_IS_SUBSPACE;CFUN_SUBSPACE_NEG]);; let INNER_SPACE_SUB = inner_space_prove (`!x y. x IN s /\ y IN s ==> x-y IN s:`, MESON_TAC[INNER_SPACE_IS_SUBSPACE;CFUN_SUBSPACE_SUB]);; let INPROD_CNJ = inner_space_prove (`!x y. x IN s /\ y IN s ==> cnj(inprod y x) = inprod x y:`, SIMP_TAC[is_inner_space]);; let INPROD_SELF_REAL = inner_space_prove (`!x. x IN s ==> real (inprod x x):`, SIMP_TAC[is_inner_space]);; let INPROD_SELF_POS = inner_space_prove (`!x. x IN s ==> &0 <= real_of_complex (inprod x x):`, SIMP_TAC[is_inner_space]);; let INPROD_RSMUL = inner_space_prove (`!x y a. x IN s /\ y IN s ==> inprod x (a%y) = a * inprod x y:`, SIMP_TAC[is_inner_space]);; let INPROD_ADD_RDIST = inner_space_prove (`!x y z. x IN s /\ y IN s /\ z IN s ==> inprod (x+y) z = inprod x z + inprod y z:`, SIMP_TAC[is_inner_space]);; let INPROD_ZERO_EQ = inner_space_prove (`!x y. x IN s /\ y IN s ==> (inprod x x = Cx(&0) ==> inprod y x = Cx(&0)):`, SIMP_TAC[is_inner_space]);; let INPROD_LZERO_EQ = inner_space_prove (`!x y. x IN s /\ y IN s ==> (inprod x x = Cx(&0) ==> inprod x y = Cx(&0)):`, MESON_TAC[INPROD_ZERO_EQ;INPROD_CNJ]);; let INPROD_NORM = inner_space_prove (`!x. x IN s ==> real (inprod x x) /\ &0 <= real_of_complex (inprod x x):`, SIMP_TAC[is_inner_space]);; add_real_thm (MESON[INPROD_SELF_REAL] `!s inprod x. is_inner_space (s,inprod) /\ x IN s ==> real(inprod x x)`);; (* More involved properties *) let INPROD_LSMUL = inner_space_prove (`!x y a. x IN s /\ y IN s ==> inprod (a%x) y = cnj a * inprod x y:`, MESON_TAC[is_inner_space;is_cfun_subspace;CNJ_MUL]);; let INPROD_LNEG = inner_space_prove (`!x y. x IN s /\ y IN s ==> inprod (--x) y = --inprod x y:`, MESON_TAC [GSYM CFUN_SMUL_LID_NEG;INPROD_LSMUL;CNJ_NEG;CNJ_CX; COMPLEX_NEG_MINUS1]);; let INPROD_SUB_RDIST = inner_space_prove (`!x y z. x IN s /\ y IN s /\ z IN s ==> inprod (x-y) z = inprod x z - inprod y z:`, IMP_REWRITE_TAC[CFUN_SUB_NEG;complex_sub;INPROD_ADD_RDIST;INPROD_LNEG; CFUN_SUBSPACE_NEG;INNER_SPACE_IS_SUBSPACE]);; let INPROD_RNEG = inner_space_prove (`!x y. x IN s /\ y IN s ==> inprod x (--y) = --inprod x y:`, MESON_TAC[GSYM CFUN_SMUL_LID_NEG;INPROD_RSMUL;COMPLEX_NEG_MINUS1]);; let INPROD_ADD_LDIST = inner_space_prove (`!x y z. x IN s /\ y IN s /\ z IN s ==> inprod z (x+y) = inprod z x + inprod z y:`, MESON_TAC[INPROD_CNJ;INNER_SPACE_IS_SUBSPACE;CFUN_SUBSPACE_ADD; INPROD_ADD_RDIST;CNJ_ADD]);; let INPROD_SUB_LDIST = inner_space_prove (`!x y z. x IN s /\ y IN s /\ z IN s ==> inprod z (x-y) = inprod z x - inprod z y:`, IMP_REWRITE_TAC[CFUN_SUB_NEG;complex_sub;INPROD_ADD_LDIST;INPROD_RNEG; CFUN_SUBSPACE_NEG;INNER_SPACE_IS_SUBSPACE]);; let INPROD_RZERO = inner_space_prove (`!x. x IN s ==> inprod x cfun_zero = Cx(&0):`, IMP_REWRITE_TAC[GSYM CFUN_SMUL_LZERO;INPROD_RSMUL;COMPLEX_MUL_LZERO]);; let INPROD_LZERO = inner_space_prove (`!x. x IN s ==> inprod cfun_zero x = Cx(&0):`, IMP_REWRITE_TAC[GSYM CFUN_SMUL_LZERO;INPROD_LSMUL;CNJ_CX;COMPLEX_MUL_LZERO]);; let INPROD_ZERO = inner_space_prove (`inprod cfun_zero cfun_zero = Cx(&0):`, MESON_TAC[INPROD_LZERO;INNER_SPACE_ZERO]);; let INPROD_SELF_CNJ = inner_space_prove (`!x. x IN s ==> cnj (inprod x x) = inprod x x:`, SIMP_TAC[GSYM REAL_CNJ;is_inner_space]);; let INPROD_ADD_CNJ = inner_space_prove (`!x y. x IN s /\ y IN s ==> inprod x y + inprod y x = Cx(&2 * Re (inprod x y)):`, IMP_REWRITE_TAC[GSYM COMPLEX_ADD_CNJ;INPROD_CNJ]);; let INPROD_SELF_NORM = inner_space_prove (`!x. x IN s ==> norm (inprod x x) = real_of_complex (inprod x x):`, MESON_TAC[is_inner_space;REAL_OF_COMPLEX;COMPLEX_NORM_CX;REAL_ABS_REFL]);; let INPROD_SELF_RE = inner_space_prove (`!x. x IN s ==> real_of_complex (inprod x x) = Re (inprod x x):`, MESON_TAC[is_inner_space;REAL_OF_COMPLEX_RE]);; let INPROD_NEG = inner_space_prove (`!x y. x IN s /\ y IN s ==> inprod (--x) (--y) = inprod x y:`, IMP_REWRITE_TAC[CFUN_SUBSPACE_NEG;INNER_SPACE_IS_SUBSPACE;INPROD_RNEG ;INPROD_LNEG;COMPLEX_NEG_NEG]);; (* TODO RIESZ *) let EQUV_ZERO = prove (`!x inprod. inprod x x = Cx(&0) <=> (x equv cfun_zero) inprod`, REWRITE_TAC[are_equv;CFUN_SUB_RID]);; let INPROD_NOT_ZERO = inner_space_prove (`!x. x IN s /\ ~(x equv cfun_zero) inprod ==> ~(x = cfun_zero):`, MESON_TAC[are_equv;INPROD_ZERO;CFUN_SUB_RID]);; let EQUV_SUB_ZERO = prove (`!x inprod. (x equv y) inprod <=> ((x - y) equv cfun_zero) inprod`, REWRITE_TAC[are_equv;CFUN_SUB_RID]);; let INPROD_ZERO_EQUV = inner_space_prove (`!x y. x IN s /\ y IN s ==> (x equv cfun_zero) inprod ==> inprod y x = Cx(&0):`, MESON_TAC[EQUV_ZERO;INPROD_ZERO_EQ]);; let INPROD_EQUV_SYM = inner_space_prove (`!x y. x IN s /\ y IN s ==> ((x equv y) inprod <=> (y equv x) inprod):`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[are_equv] THEN DISCH_TAC THEN TARGET_REWRITE_TAC[CFUN_ARITH `! x y. x-y = --(y-x)`]INPROD_NEG THEN ASM_MESON_TAC[INNER_SPACE_SUB]);; let INPROD_EQUV_RREPLACE = prove (`!s inprod x y z. (x equv y) inprod ==> is_inner_space (s,inprod) /\ x IN s /\ y IN s /\ z IN s ==> inprod z x = inprod z y`, ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0;EQUV_SUB_ZERO] THEN REPEAT GEN_TAC THEN MESON_TAC[INNER_SPACE_SUB;Pa.SPECL ["s";"inprod";"x-y";"z"] (GSYM INPROD_ZERO_EQUV);INPROD_SUB_LDIST]);; let INPROD_EQUV_LREPLACE = prove (`!s inprod x y z. (x equv y) inprod ==> is_inner_space (s,inprod) /\ x IN s /\ y IN s /\ z IN s ==> inprod x z = inprod y z`, MESON_TAC[GSYM INPROD_CNJ;INPROD_EQUV_RREPLACE]);; let INPROD_INJ_ALT = inner_space_prove (`!x y. x IN s /\ y IN s ==> ((x equv y) inprod <=> (!z. z IN s ==> inprod x z = inprod y z)):`, REPEAT STRIP_TAC THEN EQ_TAC THENL[ASM_MESON_TAC[INPROD_EQUV_LREPLACE];ALL_TAC] THEN TARGET_REWRITE_TAC[GSYM COMPLEX_SUB_0] (GSYM INPROD_SUB_RDIST) THEN ASM_MESON_TAC [are_equv;COMPLEX_SUB_0;CFUN_SUBSPACE_SUB; INNER_SPACE_IS_SUBSPACE]);; let INPROD_EQUV_TAC ths = ASSUM_LIST(fun thl-> let mthl = map (fun th-> try CONJ (MATCH_MP INPROD_EQUV_RREPLACE th) (MATCH_MP INPROD_EQUV_LREPLACE th) with |Failure explanation -> th ) thl in IMP_REWRITE_TAC (mthl@ths));; let INPROD_EQUV_TRANSTIVE = inner_space_prove (`!x y z. x IN s /\ y IN s /\ z IN s ==> (x equv y) inprod /\ (y equv z) inprod ==> (x equv z) inprod:`, REPEAT STRIP_TAC THEN INPROD_EQUV_TAC[are_equv;INPROD_SUB_RDIST;INPROD_SUB_LDIST;INNER_SPACE_SUB; COMPLEX_SUB_REFL]);; (* ------------------------------------------------------------------------- *) (* ORTHOGONALITY *) (* ------------------------------------------------------------------------- *) let are_orthogonal = new_definition `are_orthogonal1 ((s,inprod):inner_space) u v <=> is_inner_space (s,inprod) /\ u IN s /\ v IN s ==> inprod u v = Cx(&0)`;; let ARE_ORTHOGONAL = inner_space_prove (`!u v. u IN s /\ v IN s ==> (are_orthogonal1 (s,inprod) u v <=> inprod u v = Cx(&0)):`, MESON_TAC [are_orthogonal]);; let ARE_ORTHOGONAL_SYM = inner_space_prove (`!u v. u IN s /\ v IN s ==> (are_orthogonal1 (s,inprod) u v <=> are_orthogonal1 (s,inprod) v u):`, SIMP_TAC[ARE_ORTHOGONAL] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ONCE_REWRITE_TAC[GSYM CNJ_INJ] THEN ASM_MESON_TAC[CNJ_CX;INPROD_CNJ]);; let ARE_ORTHOGONAL_LSCALAR = inner_space_prove (`!u v. u IN s /\ v IN s /\ are_orthogonal1 (s,inprod) u v ==> !a. are_orthogonal1 (s,inprod) (a % u) v:`, IMP_REWRITE_TAC[are_orthogonal;INPROD_LSMUL;COMPLEX_MUL_RZERO]);; let ORTHOGONAL_SUM_NORM = inner_space_prove (`!u v. u IN s /\ v IN s /\ are_orthogonal1 (s,inprod) u v ==> inprod (u+v) (u+v) = inprod u u + inprod v v:`, IMP_REWRITE_TAC[are_orthogonal;INPROD_ADD_LDIST;INPROD_ADD_RDIST; CFUN_SUBSPACE_ADD;INNER_SPACE_IS_SUBSPACE] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN (CONV_TAC o DEPTH_CONV o CHANGED_CONV) COMPLEX_POLY_CONV THEN MESON_TAC[INPROD_CNJ;CNJ_CX]);; let ORTHOGONAL_DECOMPOS_WRT_CFUN = inner_space_prove (`!u v. u IN s /\ v IN s ==> let proj_v = inprod v u / inprod v v in let orthogonal_component = u - proj_v % v in u = proj_v % v + orthogonal_component /\ are_orthogonal1 (s,inprod) v orthogonal_component:`, REWRITE_TAC[LET_DEFS;CFUN_SUB_ADD2;are_orthogonal] THEN IMP_REWRITE_TAC [INPROD_SUB_LDIST;INPROD_RSMUL;CFUN_SUBSPACE_SMUL; INNER_SPACE_IS_SUBSPACE] THEN REPEAT STRIP_TAC THEN Pa.ASM_CASES_TAC `(v equv cfun_zero) inprod:` THENL [ INPROD_EQUV_TAC [CFUN_SMUL_RZERO;INPROD_LZERO;CFUN_SUBSPACE_ZERO; INNER_SPACE_IS_SUBSPACE]; IMP_REWRITE_TAC [COMPLEX_DIV_RMUL;INPROD_NOT_ZERO;EQUV_ZERO] ] THEN SIMPLE_COMPLEX_ARITH_TAC);; let ORTHOGONAL_DECOMPOS_WRT_CFUN_DECOMPOSITION = inner_space_prove (`!u v. u IN s /\ v IN s ==> let proj_v = inprod v u / inprod v v in let orthogonal_component = u - proj_v % v in u = proj_v % v + orthogonal_component:`, REWRITE_TAC [LET_DEFS] THEN MESON_TAC[REWRITE_RULE [LET_DEFS] ORTHOGONAL_DECOMPOS_WRT_CFUN]);; let ORTHOGONAL_DECOMPOS_WRT_CFUN_ORTHOGONAL = inner_space_prove (`!u v. u IN s /\ v IN s ==> are_orthogonal1 (s,inprod) v (u - (inprod v u / inprod v v) % v):`, REWRITE_TAC [LET_DEFS] THEN MESON_TAC[REWRITE_RULE [LET_DEFS] ORTHOGONAL_DECOMPOS_WRT_CFUN]);; let SCHWARZ_INEQUALITY = inner_space_prove (`!x y. x IN s /\ y IN s ==> norm (inprod x y) pow 2 <= real_of_complex (inprod x x) * real_of_complex (inprod y y):`, IMP_REWRITE_TAC [GSYM INPROD_SELF_NORM;INPROD_SELF_RE] THEN REWRITE_TAC[MATCH_MP (TAUT `(A ==> B) ==> ((A ==> C) <=> (A /\ B ==> C))`) (SPEC_ALL (REWRITE_RULE [LET_DEFS] ORTHOGONAL_DECOMPOS_WRT_CFUN))] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM (wrap (CHANGED_TAC o GEN_REWRITE_TAC (PATH_CONV "rl" o ONCE_DEPTH_CONV))) THEN IMP_REWRITE_TAC [ORTHOGONAL_SUM_NORM;ARE_ORTHOGONAL_LSCALAR; CFUN_SUBSPACE_SUB;INPROD_RSMUL;CFUN_SUBSPACE_SMUL;INNER_SPACE_IS_SUBSPACE; INPROD_LSMUL] THEN REWRITE_TAC[complex_div;CNJ_MUL;CNJ_INV] THEN IMP_REWRITE_TAC [INPROD_SELF_NORM] THEN REWRITE_TAC[GSYM RE_MUL_CX] THEN IMP_REWRITE_TAC [REAL_OF_COMPLEX;INPROD_SELF_REAL] THEN IMP_REWRITE_TAC [INPROD_SELF_CNJ] THEN REWRITE_TAC[COMPLEX_ADD_RDISTRIB; Pa.COMPLEX_FIELD `((x*y)*(z*t)*u)*v = (x*z)*(u*t)*(v*y):`; ONCE_REWRITE_RULE[GSYM COMPLEX_NORM_CNJ] COMPLEX_MUL_CNJ] THEN CASES_REWRITE_TAC COMPLEX_MUL_RINV THENL [ IMP_REWRITE_TAC [INPROD_CNJ] THEN REWRITE_TAC[RE_ADD;RE_CX;COMPLEX_MUL_RID;GSYM CX_POW;REAL_LE_ADDR] THEN IMP_REWRITE_TAC [GSYM REAL_OF_COMPLEX_RE;REAL_OF_COMPLEX_MUL; REAL_LE_MUL;INPROD_SELF_POS;INPROD_SELF_POS;CFUN_SUBSPACE_SUB; CFUN_SUBSPACE_SMUL;INNER_SPACE_IS_SUBSPACE ] THEN REAL_TAC THEN HINT_EXISTS_TAC THEN IMP_REWRITE_TAC [CFUN_SUBSPACE_SUB;CFUN_SUBSPACE_SMUL;INNER_SPACE_IS_SUBSPACE] THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[] THEN GCONV_TAC COMPLEX_POLY_CONV THEN IMP_REWRITE_TAC [INPROD_ZERO_EQ] THEN REWRITE_TAC[COMPLEX_NORM_0;RE_CX] THEN ARITH_TAC ]);; let SCHWARZ_INEQUALITY2 = inner_space_prove (`!x y. x IN s /\ y IN s ==> norm (inprod x y) <= sqrt (real_of_complex (inprod x x)) * sqrt(real_of_complex (inprod y y)):`, TARGET_REWRITE_TAC[GSYM (GEN_ALL (Pa.SPEC `norm z:` POW_2_SQRT));GSYM SQRT_MUL] SQRT_MONO_LE_EQ THEN IMP_REWRITE_TAC[ SCHWARZ_INEQUALITY; INPROD_SELF_POS;NORM_POS_LE;REAL_LE_MUL;REAL_LE_POW_2]);; let SCHWARZ_INEQUALITY_ENHANCED = inner_space_prove (`!x y. x IN s /\ y IN s ==> real_of_complex ((inprod x y - inprod y x) / (Cx(&2) * ii)) pow 2 <= real_of_complex (inprod x x) * real_of_complex (inprod y y):`, IMP_REWRITE_TAC [MATCH_MP (MESON[REAL_LE_TRANS] `!f g. (P ==> f x y <= g x y) ==> P /\ z <= f x y ==> z <= g x y`) (SPEC_ALL SCHWARZ_INEQUALITY); MATCH_MP (REAL_ARITH `x=y+z ==> &0<=y /\ t=z ==> t<=x`) COMPLEX_SQNORM] THEN REWRITE_TAC[REAL_LE_POW_2] THEN IMP_REWRITE_TAC [MESON[] `(x:real) = y ==> x pow 2 = y pow 2`] THEN ONCE_REWRITE_TAC[GSYM CX_INJ] THEN REWRITE_TAC[CX_IM_CNJ;GSYM COMPLEX_INV_II;complex_div;COMPLEX_INV_MUL] THEN IMP_REWRITE_TAC [INPROD_CNJ;REAL_OF_COMPLEX] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x*y*inv ii=inv ii*(x*y)`; COMPLEX_INV_II;GSYM complex_div] THEN MESON_TAC[INPROD_CNJ;CX_IM_CNJ;REAL_CX]);; (* ------------------------------------------------------------------------- *) (* OPERATORS *) (* ------------------------------------------------------------------------- *) (* "cop" stands for "Complex-valued function OPerator" *) new_type_abbrev ("cop",`:cfunB->cfun`);; new_type_abbrev ("copB",`:cfunC->cfunB`);; new_type_abbrev ("cops",`:cfun->cfun`);; let cop_add = new_definition `cop_add:cop->cop->cop = fun_map2 (+)`;; let cop_sub = new_definition `cop_sub:cop->cop->cop = fun_map2 (-)`;; let cop_neg = new_definition `cop_neg:cop->cop = (o) (--)`;; let cop_mul = new_definition `cop_mul:cop->copB->(cfunC->cfun) = (o)`;; let cop_smul = new_definition `cop_smul:complex->cop->cop = (o) o (%)`;; let cop_zero = new_definition `cop_zero:cop = K cfun_zero`;; let cop_pow = define `cop_pow (op:cfun->cfun) 0 = I /\ cop_pow op (SUC n) = cop_mul op (cop_pow op n)`;; let cop_cnj = new_definition `cop_cnj:cop->cop = (o) cfun_cnj`;; let cop_defs = CONJS [cop_add;cop_sub;cop_neg;cop_mul;cop_smul;cop_zero;I_THM;cop_pow;cop_cnj];; let prioritize_cop () = overload_interface("+",`cop_add:cop->cop->cop`); overload_interface("-",`cop_sub:cop->cop->cop`); overload_interface("--",`cop_neg:cop->cop`); overload_interface("**",`cop_mul:cop->copB->(cfunC->cfun)`); overload_interface("pow",`cop_pow:(cfun->cfun)->num->(cfun->cfun)`); overload_interface("%",`cop_smul:complex->cop->cop`);; prioritize_cop ();; (* Intended restriction of FUN_EQ_THM to the type :cop *) let COP_EQ = prove (`!f g:cop. f = g <=> (!x. f x = g x)`, REWRITE_TAC[FUN_EQ_THM]);; let COP_TO_CFUN = CONJS [FUN_MAP_THMS;o_THM;cop_defs;COP_EQ];; let COP_POW_CONV = let th = REWRITE_CONV[cop_pow;cop_mul;I_O_ID] `cop_pow t (SUC 0)` in fun t -> let (h,_) = strip_comb t in if name_of h = "cop_pow" then (CHANGED_CONV (RAND_CONV (REDEPTH_CONV num_CONV) THENC REWRITE_CONV[cop_pow;th])) t else failwith "COP_POW_CONV";; let COP_ARITH_TAC = let lemma = MESON[] `(!x. P x <=> Q x) ==> (!x. P x) = (!x. Q x)` in CONV_TAC (TOP_DEPTH_CONV COP_POW_CONV) THEN REWRITE_TAC[COP_TO_CFUN] THEN (CFUN_ARITH_TAC ORELSE (REPEAT STRIP_TAC THEN CONV_TAC PRENEX_CONV THEN MATCH_MP_TAC lemma THEN CFUN_ARITH_TAC));; let COP_ARITH t = prove(t,COP_ARITH_TAC);; (* Properties *) let COP_ZERO = COP_ARITH `!x. cop_zero x = cfun_zero`;; let COP_SMUL = COP_ARITH `!a op. a % op = \x. a * op x`;; let COP_SMUL_THM = COP_ARITH `!a op x. (a % op) x = a % op x`;; let COP_SMUL_ALT = COP_ARITH `!a op. a % op = \x. a * op x`;; let COP_MUL = COP_ARITH `!op1 op2. op1 ** op2 = \x. op1 (op2 x)`;; let COP_ADD = COP_ARITH `!op1 op2. op1 + op2 = \x. op1 x + op2 x`;; let COP_SUB_ABS = COP_ARITH `!op1 op2. op1 - op2 = \x. op1 x - op2 x`;; let COP_ADD_THM = COP_ARITH `!op1 op2 x. (op1 + op2) x = op1 x + op2 x`;; let COP_SUB_THM = COP_ARITH `!op1 op2 x. (op1 - op2) x = op1 x - op2 x`;; let COP_ZERO_THM = COP_ARITH `cop_zero x = cfun_zero`;; let COP_MUL_LID = COP_ARITH `!op. I ** op = op`;; let COP_MUL_RID = COP_ARITH `!op. op ** I = op`;; let COP_I_ID = CONJ COP_MUL_LID COP_MUL_RID;; let COP_ENTIRE = COP_ARITH `!a x. a % x = cop_zero <=> a = Cx(&0) \/ x = cop_zero`;; let COP_ZERO_NEQ_ID = prove (`~(I = cop_zero)`, REWRITE_TAC[COP_TO_CFUN;CFUN_TO_COMPLEX;NOT_FORALL_THM] THEN Pa.EXISTS_TAC `\x. Cx(&1):` THEN CONV_TAC COMPLEX_FIELD);; let COP_SMUL_I_ZERO = prove (`!a. a % I = cop_zero <=> a = Cx(&0)`, REWRITE_TAC[COP_ENTIRE;COP_ZERO_NEQ_ID]);; let COP_SMUL_I_ONE = prove (`!a. a % I = I <=> a = Cx(&1)`, REWRITE_TAC[COP_TO_CFUN;CFUN_TO_COMPLEX] THEN GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (MP_TAC o Pa.SPEC `\x.Cx(&1):`); ALL_TAC] THEN CONV_TAC COMPLEX_FIELD);; let COP_MUL_I_SYM = COP_ARITH `!op. op ** I = I ** op`;; let COP_ADD_I_SYM = COP_ARITH `!op. op + I = I + op`;; let COP_I_SCALAR = COP_ARITH `(\x. a % x) = a % I`;; let COP_MUL_THM = COP_ARITH `!x op1 op2. (op1 ** op2) x = op1 (op2 x)`;; let COP_SMUL_LNEG = COP_ARITH `!a op. --a % op = --(a % op)`;; let COP_SMUL_RNEG = COP_ARITH `!a op. a % --op = --(a % op)`;; let COP_SUB = COP_ARITH `!op1 op2. op1 - op2 = op1 + --op2`;; let COP_SUB_NEG = COP_ARITH `!op1 op2. op1 - op2 = op1 + --op2`;; let COP_NEG_NEG = COP_ARITH `!op. --(--op) = op`;; let COP_NEG_ADD = COP_ARITH `!op1 op2. --(op1 + op2) = --op1 + --op2`;; let COP_NEG_SUB = COP_ARITH `!op1 op2. --(op1 - op2) = --op1 + op2`;; let COP_NEG_CLAUSES = CONJS [COP_NEG_NEG;COP_NEG_ADD;COP_NEG_SUB; COP_SUB;COP_SUB_NEG];; let COP_SMUL_ASSOC = COP_ARITH `!a b op. a % (b % op) = (a * b) % op`;; let COP_SMUL_SYM = COP_ARITH `!a b op. a % (b % op) = b % (a % op)`;; let COP_MUL_LSMUL = COP_ARITH `!op1 op2. a % op1 ** op2 = a % (op1 ** op2)`;; let COP_ADD_LDISTRIB = COP_ARITH `!a op1 op2. a % (op1 + op2) = a % op1 + a % op2`;; let COP_ADD_RDISTRIB = COP_ARITH `!a b op. (a + b) % op = a % op + b % op`;; let COP_SMUL_INV_ID = COP_ARITH `!a op. ~(a = Cx (&0)) ==> a % (inv a % op) = op`;; let COP_SUB_LDISTRIB = COP_ARITH `!a x y. a % (x - y) = a % x - a % y`;; let COP_SUB_RADD = COP_ARITH `!x y z. x - (y + z) = x - y - z`;; let COP_ADD_RSUB = COP_ARITH `!x y z. x + (y - z) = (x + y) - z`;; let COP_SUB_SUB = COP_ARITH `!x y z. x - (y - z) = x - y + z`;; let COP_ADD_SYM = COP_ARITH `!op1 op2. op1 + op2 = op2 + op1`;; let COP_ADD_ASSOC = COP_ARITH `!x y z. (x + y) + z = x + y + z`;; let COP_ADD_AC = COP_ARITH `!m n p. m + n = n + m /\ (m + n) + p = m + n + p /\ m + n + p = n + m + p`;; let COP_MUL_ASSOC = COP_ARITH `!x y z . (x ** y) ** z = x ** y ** z`;; let COP_SUB_ADD = COP_ARITH `!x y z. (x-y)+z= (x+z)-y`;; let COP_NEG_INJ = COP_ARITH `!x y. --x = --y <=> x = y`;; let COP_EQ_ADD_LCANCEL = COP_ARITH `!x y z. x + y = x + z <=> y=z`;; let COP_EQ_ADD_RCANCEL = COP_ARITH `!x y z. x + z = y + z <=> x=y`;; let COP_EQ_SUB_LCANCEL = COP_ARITH `!x y z. x - y = x - z <=> y=z`;; let COP_EQ_LSUB = COP_ARITH `!x y z. x - y = z <=> x = z + y`;; let COP_EQ_RSUB = COP_ARITH `!x y z. x = y - z <=> x + z = y`;; let COP_MUL_LZERO = COP_ARITH `!op. cop_zero ** op = cop_zero`;; let COP_SUB_REFL = COP_ARITH `!op. op - op = cop_zero`;; let COP_SMUL_LID_NEG = COP_ARITH `!x. (--Cx(&1)) % x = --x`;; let COP_ADD_RID = COP_ARITH `!op. op + cop_zero = op`;; let COP_ADD_LID = COP_ARITH `!op. cop_zero + op = op`;; let COP_SMUL_LID = COP_ARITH `!op. Cx(&1) % op = op`;; let COP_SMUL_RZERO = COP_ARITH `!op. a % cop_zero = cop_zero`;; let COP_SUB_LZERO = COP_ARITH `!op. cop_zero - op = --op`;; let COP_SUB_RZERO = COP_ARITH `!op. op - cop_zero = op`;; let COP_SMUL_LZERO = COP_ARITH `!x. Cx(&0) % x = cop_zero`;; let COP_ZERO_CLAUSES = CONJS [COP_MUL_LZERO;COP_SUB_REFL;COP_ADD_RID;COP_ADD_LID;COP_SMUL_RZERO];; let COP_ADD_MUL_RDISTRIB = COP_ARITH `!op1 op2 op3. (op1 + op2) ** op3 = op1 ** op3 + op2 ** op3`;; let COP_SUB_MUL_RDISTRIB = COP_ARITH `!op1 op2 op3. (op1 - op2) ** op3 = op1 ** op3 - op2 ** op3`;; let COP_EQ_LSUB_LSUB = COP_ARITH `!x y z. x - y = z <=> x - z = y`;; let COP_EQ_LSMUL = COP_ARITH `!a x y. a % x = a % y <=> x = y \/ a = Cx(&0)`;; let COP_EQ_MUL_LCANCEL2 = prove (`!x y z t:cop. ~(x=Cx(&0)) ==> (x % y = z % t <=> y = (z / x) % t)`, REWRITE_TAC[COP_TO_CFUN;CFUN_TO_COMPLEX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (MESON[] `(!x y. P x y <=> Q x y) ==> (!x y. P x y) = !x y. Q x y`) THEN REPEAT GEN_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; let COP_POW_2 = COP_ARITH `!op. op pow 2 = op ** op`;; let COP_POW_I = prove (`!n. I pow n = I`, INDUCT_TAC THEN ASM_SIMP_TAC[cop_pow;COP_MUL_LID]);; let COP_POW_ZERO = prove( `!n. cop_zero pow (n+1) = cop_zero`, INDUCT_TAC THEN ASM_MESON_TAC[cop_pow;ADD_CLAUSES;ADD1;COP_MUL_LZERO;COP_MUL_RID]);; let COP_POW_COMMUTE_N = prove (`!op1 op2. op1 ** op2 = op2 ** op1 ==> !n. op1 ** op2 pow n = op2 pow n ** op1`, REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[cop_pow; GSYM COP_MUL_ASSOC;COP_MUL_LID;COP_MUL_RID] THEN ASM_REWRITE_TAC[GSYM cop_pow;COP_MUL_ASSOC]);; let COP_ADD_2 = COP_ARITH `!op. Cx(&2) % op = op + op`;; (* ------------------------------------------------------------------------- *) (* Bounded OPERATORS *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* LINEAR OPERATORS *) (* ------------------------------------------------------------------------- *) let is_linear_cop = new_definition `is_linear_cop (op:cop) <=> !x y. op (x + y) = op x + op y /\ !a. op (a % x) = a % (op x)`;; let LINCOP_ADD = prove (`!x y op. is_linear_cop op ==> op (x + y) = op x + op y`, SIMP_TAC[is_linear_cop]);; let LINCOP_SMUL = prove (`!a x op. is_linear_cop op ==> op (a % x) = a % op x`, SIMP_TAC[is_linear_cop]);; let LINCOP_SUB = prove (`!x y op. is_linear_cop op ==> op (x - y) = op x - op y`, SIMP_TAC[is_linear_cop;CFUN_SUB_NEG;GSYM CFUN_SMUL_LID_NEG]);; let LINCOP_MUL_RSMUL = prove (`!a op1 op2. is_linear_cop op2 ==> op2 ** (a % op1) = a % (op2 ** op1)`, SIMP_TAC[is_linear_cop;COP_TO_CFUN]);; let LINCOP_SMUL_CLAUSES = CONJS [LINCOP_MUL_RSMUL;COP_ADD_LDISTRIB; COP_SUB_LDISTRIB;COP_MUL_LSMUL;COP_MUL_ASSOC;COP_MUL_LID];; let LINCOP_MUL_RMUL = prove (`!op1 op2. is_linear_cop op2 ==> op2 ** (a % op1) = a % (op2 ** op1)`, SIMP_TAC[is_linear_cop;COP_TO_CFUN]);; let LINCOP_ADD_MUL_LDISTRIB = prove (`!op1 op2 op3. is_linear_cop op3 ==> op3 ** (op1 + op2) = op3 ** op1 + op3 ** op2`, SIMP_TAC[is_linear_cop;COP_TO_CFUN]);; let LINCOP_SUB_MUL_LDISTRIB = prove (`!op1 op2 op3. is_linear_cop op3 ==> op3 ** (op1 - op2) = op3 ** op1 - op3 ** op2`, SIMP_TAC[is_linear_cop;COP_TO_CFUN;LINCOP_SUB]);; let LINCOP_MUL_DISTRIB_CLAUSES = CONJS[COP_ADD_MUL_RDISTRIB;COP_SUB_MUL_RDISTRIB;LINCOP_ADD_MUL_LDISTRIB; LINCOP_SUB_MUL_LDISTRIB];; let LINCOP_CFUN_ZERO = prove (`!op. is_linear_cop op ==> op cfun_zero = cfun_zero`, MESON_TAC[is_linear_cop;CFUN_SMUL_LZERO]);; let COP_POW_SMUL = prove (`!op. is_linear_cop op ==> !n a. (a % op) pow n = (a pow n) % (op pow n)`, REWRITE_TAC[is_linear_cop] THEN REPEAT (INDUCT_TAC ORELSE STRIP_TAC) THEN ASM_REWRITE_TAC[COP_TO_CFUN;complex_pow] THEN CFUN_ARITH_TAC);; let COP_POW_SMUL2 = prove (`!op n a. is_linear_cop op ==> (a % op) pow n = (a pow n) % (op pow n)`, MESON_TAC[COP_POW_SMUL]);; (* Congruence properties *) let ADD_LINCOP = prove (`!op1 op2. is_linear_cop op1 /\ is_linear_cop op2 ==> is_linear_cop (op1 + op2)`, SIMP_TAC[is_linear_cop;COP_TO_CFUN] THEN REPEAT STRIP_TAC THEN COP_ARITH_TAC);; let SUB_LINCOP = prove (`!op1 op2. is_linear_cop op1 /\ is_linear_cop op2 ==> is_linear_cop (op1 - op2)`, SIMP_TAC[is_linear_cop;COP_TO_CFUN] THEN REPEAT STRIP_TAC THEN COP_ARITH_TAC);; let SMUL_LINCOP = prove (`!a op. is_linear_cop op ==> is_linear_cop (a % op)`, SIMP_TAC[is_linear_cop;COP_TO_CFUN] THEN REPEAT STRIP_TAC THEN COP_ARITH_TAC);; let MUL_LINCOP = prove (`!op1 op2. is_linear_cop op1 /\ is_linear_cop op2 ==> is_linear_cop (op1 ** op2)`, SIMP_TAC[is_linear_cop;COP_TO_CFUN] THEN REPEAT STRIP_TAC THEN COP_ARITH_TAC);; let ARITH_LINCOP_CLAUSES = CONJS [ADD_LINCOP;SUB_LINCOP;SMUL_LINCOP;MUL_LINCOP];; let linearity_thms = ref [];; let add_linearity_thm thm = let thm = GIMP_IMP thm in linearity_thms := thm :: !linearity_thms; let eta_thm = SIMP_RULE[ETA_AX] thm in if (not (equals_thm thm eta_thm)) then linearity_thms := eta_thm :: !linearity_thms;; let add_linearity_thms = List.iter add_linearity_thm;; add_linearity_thms [ADD_LINCOP;SUB_LINCOP;SMUL_LINCOP;MUL_LINCOP; REWRITE_RULE[cop_smul] SMUL_LINCOP];; let I_LINCOP = prove (`is_linear_cop I`, REWRITE_TAC[is_linear_cop;I_DEF]);; let COP_POW_SCALAR = prove (`!a n. (\x. a % x) pow n = (\x. (a pow n) % x)`, SIMP_TAC[COP_ARITH `(\x. a % x) = a % I`;COP_POW_SMUL;I_LINCOP;COP_POW_I]);; add_linearity_thms [I_LINCOP;REWRITE_RULE[I_DEF] I_LINCOP];; let ZERO_LINCOP = prove (`is_linear_cop cop_zero`, REWRITE_TAC[is_linear_cop;COP_ZERO_THM] THEN COP_ARITH_TAC);; add_linearity_thms [ZERO_LINCOP];; let SCALAR_LINCOP = prove (`!a. is_linear_cop \x. a % x`, REWRITE_TAC[is_linear_cop] THEN CFUN_ARITH_TAC);; let POW_LINCOP = prove (`!op. is_linear_cop op ==> !n. is_linear_cop (op pow n)`, REPEAT (INDUCT_TAC ORELSE STRIP_TAC) THEN ASM_SIMP_TAC[cop_pow;I_LINCOP;MUL_LINCOP]);; add_linearity_thms [SCALAR_LINCOP;POW_LINCOP];; let LINEARITY_TAC g = let MATCH_MP_TAC x y = MATCH_MP_TAC x y in let TRY_LINEARITY_THM = ASM (MAP_FIRST (fun x -> MATCH_ACCEPT_TAC x ORELSE MATCH_MP_TAC x)) !linearity_thms in let LOOP = TRY_LINEARITY_THM ORELSE (SIMP_TAC[ETA_AX] THEN TRY_LINEARITY_THM) ORELSE (ASM_SIMP_TAC[] THEN NO_TAC) in (REPEAT STRIP_TAC THEN CHANGED_TAC (REPEAT (LOOP THEN REPEAT CONJ_TAC))) g;; let is_set_linear_cop = new_definition `is_set_linear_cop s (op:cop) <=> !x y. x IN s /\ y IN s ==> op (x + y) = op x + op y /\ !a. op (a % x) = a % (op x)`;; let LINCOP_SLINCOP = prove (`!s op. is_linear_cop op ==> is_set_linear_cop s op`, SIMP_TAC[is_linear_cop;is_set_linear_cop]);; let SLINCOP_SMUL = prove(`!a x op s. x IN s /\ is_set_linear_cop s op ==> op (a % x) = a % op x`, MESON_TAC[is_set_linear_cop]);; let SLINCOP_ADD = prove (`!x y op s. is_set_linear_cop s op /\ x IN s /\ y IN s ==> op (x + y) = op x + op y`, SIMP_TAC[is_set_linear_cop]);; let SLINCOP_SUB = prove (`!x y op s. is_cfun_subspace s /\ is_set_linear_cop s op /\ x IN s /\ y IN s ==> op (x - y) = op x - op y`, MESON_TAC[SLINCOP_SMUL;CFUN_SUBSPACE_SMUL ;SLINCOP_ADD;CFUN_SUB_NEG;GSYM CFUN_SMUL_LID_NEG]);; let SLINCOP_CFUN_ZERO = prove (`!op s. is_set_linear_cop s op /\ is_cfun_subspace s ==> op cfun_zero = cfun_zero`, ONCE_REWRITE_TAC[GSYM (Pa.SPEC `cfun_zero:` CFUN_SMUL_LZERO)] THEN MESON_TAC[SLINCOP_SMUL;CFUN_SMUL_LZERO;CFUN_SUBSPACE_ZERO]);; (* ------------------------------------------------------------------------- *) (* DUAL SPACE *) (* ------------------------------------------------------------------------- *) new_type_abbrev("cfun_dual",`:cfun->complex`);; new_type_abbrev("cfun_dualB",`:cfunB->complex`);; (* Note that all the above operations still apply on the dual space since * `:cfun_dual` is an instance of `cfun` itself. *) let cfun_dual = new_definition `cfun_dual (spc:cfun->bool) = { f:cfun->complex | is_linear_cop (cfun_of_complex o f) }`;; (* *let cfun_topological_dual = new_definition * `cfun_topological_dual spc = * { f | f IN cfun_dual spc /\ !x. f continuous (within (:cfun)) }`;; *) let cop_transpose = new_definition `cop_transpose (f:cop) :cfun_dual->cfun_dualB = \phi. phi o f`;; (* ------------------------------------------------------------------------- *) (* FREQUENTLY USED OPERATORS *) (* ------------------------------------------------------------------------- *) let commutator = new_definition `commutator (op1:cfun->cfun) op2 = op1 ** op2 - op2 ** op1`;; make_overloadable "com" `:A->A->A`;; parse_as_infix("com",(24,"left"));; overload_interface("com",`commutator:cops->cops->cops`);; let COMMUTATOR_NEG = prove (`!op1 op2. commutator op1 op2 = -- commutator op2 op1`, REWRITE_TAC[commutator] THEN COP_ARITH_TAC);; let COMMUTATOR_COMPOSIT = prove (`!op1 op2 a b c d. is_linear_cop op1 /\ is_linear_cop op2 ==> commutator (a%op1+b%op2) (c%op1+d%op2) = (a*d)% commutator op1 op2 - (b*c)% commutator op1 op2`, SIMP_TAC[commutator;LINCOP_MUL_DISTRIB_CLAUSES; LINCOP_SMUL_CLAUSES;COP_SMUL_ASSOC;COP_SUB_RADD] THEN COP_ARITH_TAC);; let COMMUTATOR_SMUL = GEN_ALL( REWRITE_RULE[COP_SMUL_LZERO;COMPLEX_MUL_LZERO; COP_SUB_RZERO;COP_ADD_RID;COP_ADD_LID] (SPEC_V (`b:`,`Cx(&0):`) (SPEC_V(`c:`,`Cx(&0):`) COMMUTATOR_COMPOSIT)));; let COMMUTATOR_ZERO_SYM = prove (`!op1 op2. commutator op1 op2 = cop_zero <=> commutator op2 op1 = cop_zero`, REWRITE_TAC[commutator;COP_EQ_LSUB;COP_ADD_LID] THEN MESON_TAC[]);; let COMMUTATOR_SCALAR = prove (`!op a. is_linear_cop op ==> commutator op (\x. a%x) = cop_zero`, SIMP_TAC[commutator;COP_SUB_ABS;COP_MUL;LINCOP_SMUL] THEN COP_ARITH_TAC);; let COMMUTATOR_SCALAR_OP = prove (`!op a. is_linear_cop op ==> commutator op (a%op) = cop_zero`, SIMP_TAC[commutator;LINCOP_MUL_RSMUL] THEN COP_ARITH_TAC);; let COMMUTATOR_ZERO = prove (`!op. is_linear_cop op ==> commutator op cop_zero = cop_zero`, SIMP_TAC[cop_zero;K_DEF;GSYM CFUN_SMUL_LZERO;commutator; COP_SUB_ABS;COP_MUL;LINCOP_SMUL] THEN COP_ARITH_TAC);; let LINCOP_COMMUTATOR = prove (`!op1 op2. is_linear_cop op1 /\ is_linear_cop op2 ==> is_linear_cop (commutator op1 op2)`, REWRITE_TAC[commutator] THEN REPEAT STRIP_TAC THEN LINEARITY_TAC);; add_linearity_thm LINCOP_COMMUTATOR;; let expectation = new_definition `expectation (inprod:inprod) f op = inprod f (op f)`;; let deviation = new_definition `deviation (inprod:inprod) f op = op - (\x. expectation inprod f op % x)`;; let DEVIATION_ALT = prove (`!inprod f op. deviation inprod f op = op - expectation inprod f op % I`, REWRITE_TAC[deviation] THEN COP_ARITH_TAC);; let LINCOP_DEVIATION = prove (`!inprod state op. is_linear_cop op ==> is_linear_cop (deviation inprod state op)`, REWRITE_TAC[deviation;GSYM COP_SMUL] THEN LINEARITY_TAC);; add_linearity_thm LINCOP_DEVIATION;; let variance = new_definition `variance (inprod:inprod) f op = expectation inprod f (deviation inprod f op ** deviation inprod f op)`;; let DEVIATION_COMMUTATOR = prove (`!inprod op1 op2 state. is_linear_cop op1 /\ is_linear_cop op2 ==> commutator (deviation inprod state op1) (deviation inprod state op2) = commutator op1 op2`, SIMP_TAC[DEVIATION_ALT;commutator] THEN IMP_REWRITE_TAC [LINCOP_SUB_MUL_LDISTRIB] THEN REPEAT STRIP_TAC THEN TRY LINEARITY_TAC THEN ASM_SIMP_TAC[LINCOP_MUL_DISTRIB_CLAUSES;COP_MUL_LSMUL;COP_I_ID; LINCOP_MUL_RMUL;MESON[COP_SMUL_SYM] `f (a % (b % op)) (b % (a % op)) = f (a % (b % op)) (a % (b % op))`] THEN COP_ARITH_TAC);; let EXPEC_ZERO_STATE = prove (`!s inprod op. is_linear_cop op /\ is_inner_space (s,inprod) ==> expectation inprod cfun_zero op = Cx(&0)`, MESON_TAC[expectation;INPROD_ZERO;LINCOP_CFUN_ZERO]);; (* ------------------------------------------------------------------------- *) (* CLOSURE *) (* ------------------------------------------------------------------------- *) let is_closed_by = new_definition `is_closed_by s f <=> !x. x IN s ==> f x IN s`;; let IS_CLOSED_BY_THM = prove (`!x s f. is_closed_by s f /\ x IN s ==> f x IN s`,SIMP_TAC[is_closed_by]);; let IS_CLOSED_BY_COMPOSE = prove (`!s f g. is_closed_by s f /\ is_closed_by s g ==> is_closed_by s (f o g)`, REWRITE_TAC[is_closed_by;o_DEF] THEN MESON_TAC[]);; let IS_CLOSED_BY_I = prove (`!s. is_closed_by s I`, REWRITE_TAC[is_closed_by;I_THM]);; let IS_CLOSED_BY_COP_ADD = prove (`!s op1 op2. is_cfun_subspace s /\ is_closed_by s op1 /\ is_closed_by s op2 ==> is_closed_by s (op1+op2)`, REWRITE_TAC[is_closed_by;COP_TO_CFUN] THEN MESON_TAC[CFUN_SUBSPACE_ADD]);; let IS_CLOSED_BY_COP_SUB = prove (`!s op1 op2. is_cfun_subspace s /\ is_closed_by s op1 /\ is_closed_by s op2 ==> is_closed_by s (op1-op2)`, REWRITE_TAC[is_closed_by;COP_TO_CFUN] THEN MESON_TAC[CFUN_SUBSPACE_SUB]);; let IS_CLOSED_BY_COP_MUL = prove (`!s op1 op2. is_closed_by s op1 /\ is_closed_by s op2 ==> is_closed_by s (op1**op2)`, REWRITE_TAC[is_closed_by;COP_TO_CFUN] THEN MESON_TAC[]);; let IS_CLOSED_SCALAR = prove (`!s a. is_cfun_subspace s ==> is_closed_by s (a % I)`, SIMP_TAC[is_closed_by;is_cfun_subspace;COP_TO_CFUN]);; let IS_CLOSED_INPROD_SCALAR = inner_space_prove (`!a. is_closed_by s (a % I):`, SIMP_TAC[is_closed_by;is_inner_space;IS_CLOSED_SCALAR]);; let IS_CLOSED_BY_COP_SMUL = prove (`!s a op. is_cfun_subspace s /\ is_closed_by s op ==> is_closed_by s (a % op)`, IMP_REWRITE_TAC[is_closed_by;COP_TO_CFUN;CFUN_SUBSPACE_SMUL]);; let IS_CLOSED_BY_COMMUTATOR = prove (`!s a op. is_cfun_subspace s /\ is_closed_by s op1 /\ is_closed_by s op2 ==> is_closed_by s (commutator op1 op2)`, IMP_REWRITE_TAC[commutator;IS_CLOSED_BY_COP_MUL;IS_CLOSED_BY_COP_SUB]);; (* ------------------------------------------------------------------------- *) (* HERMITIAN *) (* ------------------------------------------------------------------------- *) let is_hermitian = new_definition `is_hermitian ((s,inprod):inner_space) op1 op2 <=> is_inner_space (s,inprod) ==> is_closed_by s op1 /\ is_closed_by s op2 /\ is_linear_cop op1 /\ is_linear_cop op2 /\ !x y. x IN s /\ y IN s ==> inprod x (op1 y) = inprod (op2 x) y`;; let HERM_LINCOP = full_inner_space_prove (`!op1 op2. is_hermitian is op1 op2 ==> is_linear_cop op1 /\ is_linear_cop op2:`, SIMP_TAC[FORALL_INNER_SPACE_THM;is_hermitian]);; let HERM_LINCOP_L = full_inner_space_prove (`!op1 op2. is_hermitian is op1 op2 ==> is_linear_cop op1:`, SIMP_TAC[FORALL_INNER_SPACE_THM;is_hermitian]);; let HERM_LINCOP_R = full_inner_space_prove (`!op1 op2. is_hermitian is op1 op2 ==> is_linear_cop op2:`, SIMP_TAC[FORALL_INNER_SPACE_THM;is_hermitian]);; let HERM_IS_CLOSED_BY_L = inner_space_prove (`!op1 op2. is_hermitian (s,inprod) op1 op2 ==> is_closed_by s op1:`, SIMP_TAC[is_hermitian]);; let HERM_IS_CLOSED_BY_R = inner_space_prove (`!op1 op2. is_hermitian (s,inprod) op1 op2 ==> is_closed_by s op2:`, SIMP_TAC[is_hermitian]);; let HERM_ITSELF = inner_space_prove (`!op1 op2 x y. is_hermitian (s,inprod) op1 op2 /\ x IN s /\ y IN s ==> inprod x (op1 y) = inprod (op2 x) y:`, SIMP_TAC[is_hermitian]);; let ADD_HERM = full_inner_space_prove (`!op1 op2 op3 op4. is_hermitian is op1 op2 /\ is_hermitian is op3 op4 ==> is_hermitian is (op1+op3) (op2+op4):`, REWRITE_TAC[FORALL_INNER_SPACE_THM;is_hermitian;is_closed_by] THEN SIMP_HORN_TAC THEN REPEAT STRIP_TAC THEN TRY LINEARITY_TAC THEN IMP_REWRITE_TAC [COP_TO_CFUN;CFUN_SUBSPACE_ADD;INNER_SPACE_IS_SUBSPACE; INPROD_ADD_LDIST;INPROD_ADD_RDIST]);; let SUB_HERM = full_inner_space_prove (`!op1 op2 op3 op4. is_hermitian is op1 op2 /\ is_hermitian is op3 op4 ==> is_hermitian is (op1-op3) (op2-op4):`, REWRITE_TAC[FORALL_INNER_SPACE_THM;is_hermitian;is_closed_by] THEN SIMP_HORN_TAC THEN REPEAT STRIP_TAC THEN TRY LINEARITY_TAC THEN IMP_REWRITE_TAC [COP_TO_CFUN;CFUN_SUBSPACE_SUB;INNER_SPACE_IS_SUBSPACE; INPROD_SUB_LDIST;INPROD_SUB_RDIST]);; let MUL_HERM = full_inner_space_prove (`!op1 op2 op3 op4. is_hermitian is op1 op2 /\ is_hermitian is op3 op4 ==> is_hermitian is (op1**op3) (op4**op2):`, REWRITE_TAC[FORALL_INNER_SPACE_THM;is_hermitian;is_closed_by] THEN SIMP_HORN_TAC THEN REPEAT STRIP_TAC THEN TRY LINEARITY_TAC THEN REWRITE_TAC[COP_TO_CFUN;cop_mul;o_DEF] THEN ASM_MESON_TAC[]);; let SMUL_HERM = full_inner_space_prove (`!a op1 op2 op3 op4. is_hermitian is op1 op2 /\ is_hermitian is op3 op4 ==> is_hermitian is (a % op1) (cnj a % op2):`, REWRITE_TAC[FORALL_INNER_SPACE_THM;is_hermitian;is_closed_by] THEN SIMP_HORN_TAC THEN REPEAT STRIP_TAC THEN TRY LINEARITY_TAC THEN IMP_REWRITE_TAC [COP_TO_CFUN;CFUN_SUBSPACE_SMUL;INNER_SPACE_IS_SUBSPACE; INPROD_LSMUL;INPROD_RSMUL] THEN ASM_MESON_TAC[CNJ_CNJ]);; let HERMITAIN_INPROD = inner_space_prove (`!op1 op2 op3. is_hermitian (s,inprod) op1 op2 /\ is_closed_by s op3 ==> !x y. x IN s /\ y IN s ==> inprod x ((op1 ** op3) y) = inprod (op2 x) (op3 y):`, MESON_TAC[HERM_ITSELF;COP_MUL;is_closed_by]);; let ZERO_HERM = prove (`!is. is_hermitian is cop_zero cop_zero`, REWRITE_TAC[FORALL_INNER_SPACE_THM;is_hermitian] THEN IMP_REWRITE_TAC[is_closed_by;ZERO_LINCOP; COP_ZERO_THM;CFUN_SUBSPACE_ZERO;INNER_SPACE_IS_SUBSPACE;INPROD_RZERO; INPROD_LZERO]);; let ARITH_HERM_CLAUSES = CONJS [ADD_HERM;SUB_HERM;MUL_HERM;SMUL_HERM];; let HERM_SYM = prove (`!is op1 op2. is_hermitian is op1 op2 <=> is_hermitian is op2 op1`, REWRITE_TAC[FORALL_INNER_SPACE_THM;is_hermitian;is_closed_by] THEN MESON_TAC[CX_INJ;INPROD_CNJ]);; let HERM_UNIQUENESS = prove (`!s inprod op1 op2 op3. is_inner_space (s,inprod) /\ is_hermitian (s,inprod) op1 op2 /\ is_hermitian (s,inprod) op1 op3 ==> !x. x IN s ==> (op2 x equv op3 x) inprod`, IMP_REWRITE_TAC [is_hermitian;COP_EQ;is_closed_by;INPROD_INJ_ALT] THEN ASM_MESON_TAC[]);; let HERM_UNIQUENESS_ALT = prove (`!s inprod op1 op2 op3. is_inner_space (s,inprod) /\ is_hermitian (s,inprod) op2 op1 /\ is_hermitian (s,inprod) op3 op1 ==> !x. x IN s ==> (op2 x equv op3 x) inprod`, MESON_TAC[HERM_SYM;HERM_UNIQUENESS]);; let HERM_PROP_ADVANCED = inner_space_prove (`!a b op1 op2 op3 op4 op5. is_hermitian (s,inprod) op1 op2 /\ is_hermitian (s,inprod) op3 op4 /\ is_hermitian (s,inprod) op5 (a % op1 + b % op3) ==> !x. x IN s ==> (op5 x equv (cnj a % op2 + cnj b % op4) x) inprod:`, IMP_REWRITE_TAC[COP_EQ;GIMP_IMP HERM_UNIQUENESS_ALT] THEN MESON_TAC[ARITH_HERM_CLAUSES;CNJ_CNJ;HERM_SYM]);; (* ------------------------------------------------------------------------- *) (* SELF ADJOINT *) (* ------------------------------------------------------------------------- *) let is_self_adjoint = new_definition `is_self_adjoint1 is op <=> is_hermitian is op op`;; let IS_SELF_ADJOINT = REWRITE_RULE[FORALL_INNER_SPACE_THM;is_hermitian] is_self_adjoint;; let SELF_ADJ_IS_LINCOP = full_inner_space_prove (`!op. is_self_adjoint1 is op ==> is_linear_cop op:`, IMP_REWRITE_TAC[is_self_adjoint;HERM_LINCOP_L]);; let SELF_ADJ_IS_CLOSED_BY = inner_space_prove (`!op. is_self_adjoint1 (s,inprod) op ==> is_closed_by s op:`, IMP_REWRITE_TAC[is_self_adjoint;HERM_IS_CLOSED_BY_L]);; let SELF_ADJ_INPROD = inner_space_prove (`!op1 op2. is_self_adjoint1 (s,inprod) op1 /\ is_closed_by s op2 ==> !x y. x IN s /\ y IN s ==> inprod x ((op1 ** op2) y) = inprod (op1 x) (op2 y):`, REWRITE_TAC[IS_SELF_ADJOINT;COP_MUL;is_closed_by] THEN MESON_TAC[]);; let ADD_SELF_ADJ = full_inner_space_prove (`!op1 op2. is_self_adjoint1 is op1 /\ is_self_adjoint1 is op2 ==> is_self_adjoint1 is (op1 + op2):`, IMP_REWRITE_TAC[is_self_adjoint;ADD_HERM]);; let SUB_SELF_ADJ = full_inner_space_prove (`!op1 op2. is_self_adjoint1 is op1 /\ is_self_adjoint1 is op2 ==> is_self_adjoint1 is (op1 - op2):`, IMP_REWRITE_TAC[is_self_adjoint;SUB_HERM]);; let SMUL_SELF_ADJ = full_inner_space_prove (`!a op. real a /\ is_self_adjoint1 is op ==> is_self_adjoint1 is (a % op):`, MESON_TAC[is_self_adjoint;SMUL_HERM;REAL_CNJ]);; let MUL_SELF_ADJ = full_inner_space_prove (`!op1 op2. is_self_adjoint1 is op1 /\ is_self_adjoint1 is op2 /\ op1 ** op2 = op2 ** op1 ==> is_self_adjoint1 is (op1 ** op2):`, MESON_TAC[is_self_adjoint;MUL_HERM]);; let I_SELF_ADJ = prove (`!is. is_self_adjoint1 is I`, REWRITE_TAC[FORALL_INNER_SPACE_THM;IS_SELF_ADJOINT;I_LINCOP;I_THM; IS_CLOSED_BY_I]);; let ZERO_SELF_ADJ = prove (`!is. is_self_adjoint1 is cop_zero`, REWRITE_TAC[is_self_adjoint;ZERO_HERM]);; let selfadjoint_thms = ref [];; let add_selfadjoint_thm thm = let thm = GIMP_IMP thm in selfadjoint_thms := thm :: !selfadjoint_thms; let eta_thm = SIMP_RULE[ETA_AX] thm in if (not (equals_thm thm eta_thm)) then selfadjoint_thms := eta_thm :: !selfadjoint_thms;; let add_selfadjoint_thms = List.iter add_selfadjoint_thm;; let rec SELF_ADJOINT_TAC g = let MATCH_MP_TAC x y = MATCH_MP_TAC x y in let TRY_SELFADJOINT_THM = ASM (MAP_FIRST (fun x -> MATCH_ACCEPT_TAC x ORELSE MATCH_MP_TAC x)) !selfadjoint_thms in let LOOP = TRY_SELFADJOINT_THM ORELSE (SIMP_TAC[ETA_AX] THEN TRY_SELFADJOINT_THM) ORELSE (ASM_SIMP_TAC[] THEN NO_TAC) ORELSE LINEARITY_TAC ORELSE REAL_TAC ~alternatives:[SELF_ADJOINT_TAC;LINEARITY_TAC] in (REPEAT STRIP_TAC THEN (fun (_,c as g) -> let head = fst (strip_comb c) in if (name_of head = "is_self_adjoint1" && can (type_match `:inner_space->cop->bool` (type_of head)) []) then CHANGED_TAC (REPEAT (LOOP THEN REPEAT CONJ_TAC)) g else FAIL_TAC "bad goal" g)) g;; let REAL_TAC ?(alternatives=[]) = REAL_TAC ~alternatives:(SELF_ADJOINT_TAC::LINEARITY_TAC::alternatives);; add_selfadjoint_thms [ADD_SELF_ADJ;SUB_SELF_ADJ;SMUL_SELF_ADJ; REWRITE_RULE[COP_SMUL] SMUL_SELF_ADJ;MUL_SELF_ADJ;I_SELF_ADJ;ZERO_SELF_ADJ];; let ANTI_COMMUTATOR_SELF_ADJ = full_inner_space_prove (`!op1 op2. is_self_adjoint1 is op1 /\ is_self_adjoint1 is op2 ==> is_self_adjoint1 is (op1 ** op2 + op2 ** op1):`, REWRITE_TAC[FORALL_INNER_SPACE_THM;IS_SELF_ADJOINT] THEN SIMP_HORN_TAC THEN REPEAT STRIP_TAC THEN TRY LINEARITY_TAC THEN ASM IMP_REWRITE_TAC[IS_CLOSED_BY_COP_ADD;IS_CLOSED_BY_COP_MUL;COP_MUL; COP_ADD;IS_CLOSED_BY_COP_MUL;INNER_SPACE_IS_SUBSPACE;INPROD_ADD_LDIST; INPROD_ADD_RDIST] THEN ASM_MESON_TAC[COMPLEX_ADD_SYM;is_closed_by]);; add_selfadjoint_thm ANTI_COMMUTATOR_SELF_ADJ;; let NEG_SELF_ADJ = full_inner_space_prove (`!op. is_linear_cop op /\ is_self_adjoint1 is op ==> is_self_adjoint1 is (--op):`, ONCE_REWRITE_TAC[GSYM COP_SUB_LZERO] THEN SELF_ADJOINT_TAC);; add_selfadjoint_thm NEG_SELF_ADJ;; let SCALAR_II_HERM = inner_space_prove (`!op. is_linear_cop op /\ (!x y. inprod (op x) y = -- (inprod x (op y))) /\ is_closed_by s op ==> is_self_adjoint1 (s,inprod) (ii % op):`, IMP_REWRITE_TAC[IS_SELF_ADJOINT;COP_SMUL_THM;IS_CLOSED_BY_COP_SMUL; is_closed_by;INNER_SPACE_IS_SUBSPACE;INPROD_LSMUL;INPROD_RSMUL; CNJ_II;COMPLEX_NEG_MUL2] THEN LINEARITY_TAC);; add_selfadjoint_thm SCALAR_II_HERM;; let COMMUTATOR_ANTI_HERM = inner_space_prove (`!op1 op2. is_self_adjoint1 (s,inprod) op1 /\ is_self_adjoint1 (s,inprod) op2 ==> !x y. x IN s /\ y IN s ==> inprod (commutator op1 op2 x) y = --(inprod x (commutator op1 op2 y)):`, IMP_REWRITE_TAC[commutator;IS_SELF_ADJOINT;COP_MUL_THM;COP_SUB_THM; is_closed_by;INPROD_SUB_LDIST;INPROD_SUB_RDIST;COMPLEX_NEG_SUB]);; add_selfadjoint_thm COMMUTATOR_ANTI_HERM;; let II_COMMUTATOR_HERM = full_inner_space_prove (`!op1 op2. is_self_adjoint1 is op1 /\ is_self_adjoint1 is op2 ==> is_self_adjoint1 is (ii % commutator op1 op2):`, REWRITE_TAC[FORALL_INNER_SPACE_THM;IS_SELF_ADJOINT] THEN IMP_REWRITE_TAC[COP_SMUL_THM;INPROD_RSMUL; INPROD_LSMUL;IS_CLOSED_BY_COMMUTATOR;IS_CLOSED_BY_COP_SMUL;CNJ_II;II_NZ; INNER_SPACE_IS_SUBSPACE;COMPLEX_MUL_LNEG;GSYM COMPLEX_MUL_RNEG; COMPLEX_EQ_MUL_LCANCEL;] THEN ONCE_REWRITE_TAC[COMPLEX_FIELD `x = --y <=> y = --x:complex`] THEN IMP_REWRITE_TAC [GIMP_IMP COMMUTATOR_ANTI_HERM;is_self_adjoint; is_hermitian;REWRITE_RULE[is_closed_by] IS_CLOSED_BY_COMMUTATOR; INNER_SPACE_IS_SUBSPACE;is_closed_by] THEN LINEARITY_TAC);; add_selfadjoint_thm II_COMMUTATOR_HERM;; let EXPEC_HERM_REAL = inner_space_prove (`!op state. is_self_adjoint1 (s,inprod) op /\ state IN s ==> real (expectation inprod state op):`, IMP_REWRITE_TAC[IS_SELF_ADJOINT;expectation;is_closed_by ;REAL_CNJ;INPROD_CNJ]);; add_real_thms [EXPEC_HERM_REAL; REWRITE_RULE[expectation] EXPEC_HERM_REAL];; let DEVIATION_HERM = inner_space_prove (`!op state. is_self_adjoint1 (s,inprod) op /\ state IN s ==> is_self_adjoint1 (s,inprod) (deviation inprod state op):`, REWRITE_TAC[DEVIATION_ALT] THEN SELF_ADJOINT_TAC THEN ASM_MESON_TAC[]);; add_selfadjoint_thms [DEVIATION_HERM; REWRITE_RULE[deviation] DEVIATION_HERM];; let VARIANCE_REAL = inner_space_prove (`!op state. state IN s /\ is_self_adjoint1 (s,inprod) op ==> real (variance inprod state op):`, REWRITE_TAC[variance] THEN REAL_TAC THEN HINT_EXISTS_TAC THEN SELF_ADJOINT_TAC);; add_real_thm VARIANCE_REAL;; (* ------------------------------------------------------------------------- *) (* EIGEN VALUES AND VECTORS *) (* ------------------------------------------------------------------------- *) let is_eigen_pair = new_definition `is_eigen_pair (op:cfun->cfun) (x,a) <=> is_linear_cop op ==> op x = a % x /\ ~(x = cfun_zero)`;; let EIGEN_PAIR_SMUL = prove (`!op v x. is_eigen_pair op (x,v) ==> !a. ~(a = Cx(&0)) ==> is_eigen_pair op (a % x,v)`, SIMP_TAC[is_eigen_pair;CFUN_ENTIRE;LINCOP_SMUL;CFUN_SMUL_SYM]);; let EIGEN_PAIR_ADD = prove (`!op v x y. is_eigen_pair op (x,v) /\ is_eigen_pair op (y,v) /\ ~(x + y = cfun_zero) ==> is_eigen_pair op (x+y,v)`, SIMP_TAC[is_eigen_pair;LINCOP_ADD;CFUN_ADD_LDISTRIB]);; let EIGEN_SPACE_THM = prove (`!op. is_linear_cop op ==> !a. is_cfun_subspace ({ x | is_eigen_pair op (x,a) } UNION { cfun_zero })`, SIMP_TAC[is_cfun_subspace;IN_ELIM_THM;IN_UNION;IN_SING;CFUN_ENTIRE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CFUN_ADD_RID;CFUN_ADD_LID] THEN ASM_MESON_TAC[EIGEN_PAIR_SMUL;EIGEN_PAIR_ADD]);; let is_eigen_val = new_definition `is_eigen_val (op:cfun->cfun) a <=> ?x. is_eigen_pair op (x,a)`;; let is_eigen_fun = new_definition `is_eigen_fun (op:cfun->cfun) x <=> ?a. is_eigen_pair op (x,a)`;; (*****************************************************************************) (* Unbounded Operators *) (*****************************************************************************) (*****************************************************************************) (* Linear Operators *) (*****************************************************************************) let is_unbounded_linear_cop = new_definition `is_unbounded_linear_cop s (op:cop) <=> is_cfun_subspace s /\ !x y. x IN s /\ y IN s ==> op (x + y) = op x + op y /\ !a. op (a % x) = a % (op x)`;; let ULINCOP_SUBSPACE = prove(`!op s. is_unbounded_linear_cop s op ==> is_cfun_subspace s`, MESON_TAC[is_unbounded_linear_cop]);; let ULINCOP_SMUL = prove(`!op s a x. is_unbounded_linear_cop s op /\ x IN s ==> op (a % x) = a % op x`, MESON_TAC[is_unbounded_linear_cop]);; let ULINCOP_ADD = prove (`!op s x y. is_unbounded_linear_cop s op /\ x IN s /\ y IN s ==> op (x + y) = op x + op y`, SIMP_TAC[is_unbounded_linear_cop]);; let ULINCOP_SUBSPACE = prove (`!op s. is_unbounded_linear_cop s op ==> is_cfun_subspace s`, SIMP_TAC[is_unbounded_linear_cop]);; let ULINCOP_SUB = prove (`!x y op s. is_unbounded_linear_cop s op /\ x IN s /\ y IN s ==> op (x - y) = op x - op y`, IMP_REWRITE_TAC[CFUN_SUBSPACE_SMUL;ULINCOP_SUBSPACE ;ULINCOP_ADD;CFUN_SUB_NEG;GSYM CFUN_SMUL_LID_NEG] THEN ASM_MESON_TAC[ ULINCOP_SMUL]);; let ULINCOP_ZERO = prove (`!op s. is_unbounded_linear_cop s op ==> op cfun_zero = cfun_zero`, ONCE_REWRITE_TAC[GSYM (Pa.SPEC `cfun_zero:` CFUN_SMUL_LZERO)] THEN MESON_TAC[ULINCOP_SMUL;CFUN_SMUL_LZERO;CFUN_SUBSPACE_ZERO;ULINCOP_SUBSPACE]);; let SUBSPACE_INTER = prove (`!s1 s2. is_cfun_subspace s1 /\ is_cfun_subspace s2 ==> is_cfun_subspace (s1 INTER s2)`, SIMP_TAC[is_cfun_subspace;INTER;IN_ELIM_THM]);; let CFUN_ADD_AC = CFUN_ARITH `!m n p:cfun. m + n = n + m /\ (m + n) + p = m + n + p /\ m + n + p = n + m + p`;; let ADD_ULINCOP = prove (`!s1 s2 op1 op2. is_unbounded_linear_cop s1 op1 /\ is_unbounded_linear_cop s2 op2 ==> is_unbounded_linear_cop (s1 INTER s2) (op1+op2)`, SIMP_TAC[is_unbounded_linear_cop ;SUBSPACE_INTER;IN_INTER;CFUN_ADD_AC;COP_ADD_THM] THEN MESON_TAC[CFUN_ADD_LDISTRIB]);; let SMUL_ULINCOP = prove (`!s op a. is_unbounded_linear_cop s op ==> is_unbounded_linear_cop s (a%op)`, SIMP_TAC[is_unbounded_linear_cop;COP_TO_CFUN;COP_ADD_THM;CFUN_ADD_LDISTRIB] THEN MESON_TAC[COMPLEX_MUL_SYM;CFUN_SMUL_DISTRIB]);; let SUB_ULINCOP = prove (`!s1 s2 op1 op2. is_unbounded_linear_cop s1 op1 /\ is_unbounded_linear_cop s2 op2 ==> is_unbounded_linear_cop (s1 INTER s2) (op1-op2)`, IMP_REWRITE_TAC[ADD_ULINCOP;REWRITE_RULE[CNJ_CX] (SPEC_V ("a","Cx x")SMUL_ULINCOP);COP_SUB; GSYM COP_SMUL_LID_NEG;GSYM CX_NEG]);; let I_ULINCOP = prove (`!s1. is_cfun_subspace s1 ==> is_unbounded_linear_cop s1 I`, REWRITE_TAC[is_unbounded_linear_cop;I_THM]);; let MUL_LEMMA = prove (`!s1 s2 op2. is_cfun_subspace s1 /\ is_unbounded_linear_cop s2 op2 ==> is_cfun_subspace {x| x IN s2 /\ op2 x IN s1}`, REPEAT STRIP_TAC THEN REWRITE_TAC[is_cfun_subspace;IN_ELIM_THM] THEN IMP_REWRITE_TAC[ULINCOP_SMUL;ULINCOP_SUBSPACE;CFUN_SUBSPACE_SMUL; CFUN_SUBSPACE_ADD;ULINCOP_ADD;CFUN_SUBSPACE_ZERO;ULINCOP_ZERO]; );; let MUL_ULINCOP = prove (`!s1 s2 op1 op2. is_unbounded_linear_cop s1 op1 /\ is_unbounded_linear_cop s2 op2 ==> is_unbounded_linear_cop {x| x IN s2 /\ op2 x IN s1} (op1**op2)`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[is_unbounded_linear_cop] THEN IMP_REWRITE_TAC[MUL_LEMMA;ULINCOP_SUBSPACE] THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN SIMP_TAC[is_unbounded_linear_cop;COP_TO_CFUN;COP_ADD_THM;CFUN_ADD_LDISTRIB ;IN_ELIM_THM] THEN ASM_MESON_TAC[COMPLEX_MUL_SYM;CFUN_SMUL_DISTRIB]);; let ulinearity_thms = ref [];; let add_ulinearity_thm thm = let thm = GIMP_IMP thm in ulinearity_thms := thm :: !ulinearity_thms; let eta_thm = SIMP_RULE[ETA_AX] thm in if (not (equals_thm thm eta_thm)) then ulinearity_thms := eta_thm :: !ulinearity_thms;; let add_ulinearity_thms = List.iter add_ulinearity_thm;; add_ulinearity_thms [ADD_ULINCOP;SUB_ULINCOP;SMUL_ULINCOP;MUL_ULINCOP; REWRITE_RULE[cop_smul] SMUL_ULINCOP];; let ULINEARITY_TAC g = let MATCH_MP_TAC x y = MATCH_MP_TAC x y in let TRY_LINEARITY_THM = ASM (MAP_FIRST (fun x -> MATCH_ACCEPT_TAC x ORELSE MATCH_MP_TAC x)) !ulinearity_thms in let LOOP = TRY_LINEARITY_THM ORELSE (SIMP_TAC[ETA_AX] THEN TRY_LINEARITY_THM) ORELSE (ASM_SIMP_TAC[] THEN NO_TAC) in (REPEAT STRIP_TAC THEN CHANGED_TAC (REPEAT (LOOP THEN REPEAT CONJ_TAC))) g;; let COMMUTAOR_ULINCOP = prove (`!op1 s1 op2 s2. is_unbounded_linear_cop s1 op1 /\ is_unbounded_linear_cop s2 op2 ==> is_unbounded_linear_cop ({x|x IN s2 /\ op2 x IN s1} INTER {x|x IN s1 /\ op1 x IN s2}) (commutator op1 op2)`, REWRITE_TAC[commutator] THEN ULINEARITY_TAC);; (*****************************************************************************) (* Adjoints of Unbounded Linear Operators *) (*****************************************************************************) let is_hermitian_unbounded = new_definition `is_hermitian_unbounded ((s,inprod):inner_space) s1 s2 op1 op2 <=> is_inner_space (s,inprod) ==> s1 SUBSET s /\ s2 SUBSET s /\ is_unbounded_linear_cop s1 op1 /\ is_unbounded_linear_cop s2 op2 /\ (!x. x IN s1 ==> op1 x IN s) /\ (!x. x IN s2 ==> op2 x IN s) /\ (!x y. x IN s2 /\ y IN s1 ==> inprod x (op1 y) = inprod (op2 x) y)`;; let ADD_HERM_UNBOUNDED = prove (`!op1 op2 op3 op4 s1 s2 s3 s4 s inprod. is_hermitian_unbounded ((s,inprod):inner_space) s1 s2 op1 op2 /\ is_hermitian_unbounded ((s,inprod):inner_space) s3 s4 op3 op4 ==> is_hermitian_unbounded ( (s,inprod):inner_space) (s1 INTER s3) (s2 INTER s4) (op1+op3) (op2+op4)`, REWRITE_TAC[is_hermitian_unbounded;IN_INTER] THEN REPEAT STRIP_TAC THENL[ ASSUM_LIST SET_TAC;ASSUM_LIST SET_TAC;ASM_SIMP_TAC[ADD_ULINCOP]; ASM_SIMP_TAC[ADD_ULINCOP]; REWRITE_TAC[COP_ADD_THM] THEN ASM_MESON_TAC[INNER_SPACE_ADD;SUBSET]; REWRITE_TAC[COP_ADD_THM] THEN ASM_MESON_TAC[INNER_SPACE_ADD;SUBSET]; IMP_REWRITE_TAC[COP_ADD_THM;INPROD_ADD_RDIST;INPROD_ADD_LDIST] THEN ASM_MESON_TAC[INNER_SPACE_ADD;SUBSET] ]);; let SMUL_HERM_UNBOUNDED = prove (`!a op1 op2 op3 op4 s1 s2 s3 s4 s inprod. is_hermitian_unbounded ((s,inprod):inner_space) s1 s2 op1 op2 ==> is_hermitian_unbounded ((s,inprod):inner_space) s1 s2 (a % op1) (cnj a % op2)`, SIMP_TAC[is_hermitian_unbounded;SMUL_ULINCOP] THEN REPEAT STRIP_TAC THEN IMP_REWRITE_TAC[INPROD_LSMUL;INPROD_RSMUL;CNJ_CNJ;INNER_SPACE_SMUL;SUBSET;COP_TO_CFUN] THEN ASM_MESON_TAC[INNER_SPACE_SMUL;SUBSET;COP_TO_CFUN]);; let SUB_HERM_UNBOUNDED = prove (`!op1 op2 op3 op4 s1 s2 s3 s4 s inprod. is_hermitian_unbounded ((s,inprod):inner_space) s1 s2 op1 op2 /\ is_hermitian_unbounded ((s,inprod):inner_space) s3 s4 op3 op4 ==> is_hermitian_unbounded ((s,inprod):inner_space) (s1 INTER s3) (s2 INTER s4) (op1-op3) (op2-op4)`, IMP_REWRITE_TAC[ADD_HERM_UNBOUNDED;REWRITE_RULE[CNJ_CX] (SPEC_V ("a","Cx x")SMUL_HERM_UNBOUNDED);COP_SUB; GSYM COP_SMUL_LID_NEG;GSYM CX_NEG]);; let MUL_HERM_UNBOUNDED = prove (`!op1 op2 op3 op4 s1 s2 s3 s4 s inprod. is_hermitian_unbounded ((s,inprod):inner_space) s1 s2 op1 op2 /\ is_hermitian_unbounded ((s,inprod):inner_space) s3 s4 op3 op4 ==> is_hermitian_unbounded ((s,inprod):inner_space) {x| x IN s3 /\ op3 x IN s1} {x| x IN s2 /\ op2 x IN s4} (op1**op3) (op4**op2)`, SIMP_TAC[is_hermitian_unbounded;MUL_ULINCOP] THEN SIMP_TAC[IN_ELIM_THM;COP_MUL;SUBSET]);; let HERM_ITSELF_UNBOUNDED = inner_space_prove (`!op1 op2 s1 s2 x y. is_hermitian_unbounded (s,inprod) s1 s2 op1 op2 /\ x IN s2 /\ y IN s1 ==> inprod x (op1 y) = inprod (op2 x) y:`, SIMP_TAC[is_hermitian_unbounded]);; let HERMITAIN_INPROD_UNBOUNDED = inner_space_prove (`!op1 op2 op3 s1 s2. is_hermitian_unbounded (s,inprod) s1 s2 op1 op2 ==> !x y. x IN s2 /\ op3 y IN s1 ==> inprod x ((op1 ** op3) y) = inprod (op2 x) (op3 y):`, MESON_TAC[HERM_ITSELF_UNBOUNDED;COP_MUL]);; let HERM_SYM_UNBOUNDED = prove (`!is op1 op2 s1 s2. is_hermitian_unbounded is s1 s2 op1 op2 <=> is_hermitian_unbounded is s2 s1 op2 op1`, REWRITE_TAC[FORALL_INNER_SPACE_THM;is_hermitian_unbounded] THEN MESON_TAC[SUBSET;INPROD_CNJ]);; (* ------------------------------------------------------------------------- *) (* SYMMETRIC Operators *) (* ------------------------------------------------------------------------- *) let is_symmetric = new_definition `is_symmetric is s op <=> is_hermitian_unbounded is s s op op`;; let IS_SYMMETRIC = REWRITE_RULE[FORALL_INNER_SPACE_THM;is_hermitian_unbounded] is_symmetric;; let SYMMETRIC_IS_LINCOP = prove (`!op s1 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op ==> is_unbounded_linear_cop s1 op`, MESON_TAC[is_symmetric;is_hermitian_unbounded]);; let SYMMETRIC_SUBSET = prove (`!op s1 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op ==> s1 SUBSET s`, MESON_TAC[is_symmetric;is_hermitian_unbounded]);; let SYMMETRIC_CLOSURE = prove (`!op s1 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op ==> !x. x IN s1 ==> op x IN s`, MESON_TAC[is_symmetric;is_hermitian_unbounded]);; let SYMMETRIC_ITSELF = prove (`!op s1 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op ==> (!x y. x IN s1 /\ y IN s1 ==> inprod x (op y) = inprod (op x) y) `, MESON_TAC[is_symmetric;is_hermitian_unbounded]);; let IS_SYMMETRIC_INPROD = prove (`!op1 op2 s1 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op1 ==> !x y. x IN s1 /\ op2 y IN s1 ==> inprod x ((op1 ** op2) y) = inprod (op1 x) (op2 y)`, MESON_TAC[is_symmetric;HERMITAIN_INPROD_UNBOUNDED]);; let ADD_SYMMETRIC = prove (`!op1 op2 s1 s2 s inprod. is_symmetric (s,inprod) s1 op1 /\ is_symmetric (s,inprod) s2 op2 ==> is_symmetric (s,inprod) (s1 INTER s2) (op1 + op2)`, MESON_TAC[is_symmetric;ADD_HERM_UNBOUNDED]);; let SUB_SYMMETRIC = prove (`!op1 op2 s1 s2 s inprod. is_symmetric (s,inprod) s1 op1 /\ is_symmetric (s,inprod) s2 op2 ==> is_symmetric (s,inprod) (s1 INTER s2) (op1 - op2)`, MESON_TAC[is_symmetric;SUB_HERM_UNBOUNDED]);; let SMUL_SYMMETRIC = prove (`!a ops s inprod. real a /\ is_symmetric (s,inprod) s1 op ==> is_symmetric (s,inprod) s1 (a % op)`, MESON_TAC[is_symmetric;SMUL_HERM_UNBOUNDED;REAL_CNJ]);; let POW2_SYM_UNBOUNDED = prove (`!op s1 s inprod. is_symmetric (s,inprod) s1 op ==> is_symmetric ((s,inprod):inner_space) {x| x IN s1 /\ op x IN s1} (op**op)`, SIMP_TAC[is_symmetric;MUL_HERM_UNBOUNDED]);; let I_SYMMETRIC = prove (`!s1 s inprod. s1 SUBSET s /\ is_cfun_subspace s1 ==> is_symmetric (s,inprod) s1 I`, SIMP_TAC[IS_SYMMETRIC;I_ULINCOP;is_unbounded_linear_cop;I_THM;SUBSET]);; let symmetric_thms = ref [];; let add_symmetric_thm thm = let thm = GIMP_IMP thm in symmetric_thms := thm :: !symmetric_thms; let eta_thm = SIMP_RULE[ETA_AX] thm in if (not (equals_thm thm eta_thm)) then selfadjoint_thms := eta_thm :: !symmetric_thms;; let add_symmetric_thms = List.iter add_symmetric_thm;; add_symmetric_thms [ADD_SYMMETRIC;SUB_SYMMETRIC;SMUL_SYMMETRIC; REWRITE_RULE[COP_SMUL] SMUL_SYMMETRIC;I_SYMMETRIC;POW2_SYM_UNBOUNDED];; let rec SYMMETRIC_TAC g = let MATCH_MP_TAC x y = MATCH_MP_TAC x y in let TRY_SYMMETRIC_THM = ASM (MAP_FIRST (fun x -> MATCH_ACCEPT_TAC x ORELSE MATCH_MP_TAC x)) !symmetric_thms in let LOOP = TRY_SYMMETRIC_THM ORELSE (SIMP_TAC[ETA_AX] THEN TRY_SYMMETRIC_THM) ORELSE (ASM_SIMP_TAC[] THEN NO_TAC) ORELSE ULINEARITY_TAC ORELSE REAL_TAC ~alternatives:[SYMMETRIC_TAC;ULINEARITY_TAC] in (REPEAT STRIP_TAC THEN (fun (_,c as g) -> let head = fst (strip_comb c) in if (name_of head = "is_symmetric" && can (type_match `:inner_space->(cfun->boo)->cop->bool` (type_of head)) []) then CHANGED_TAC (REPEAT (LOOP THEN REPEAT CONJ_TAC)) g else FAIL_TAC "bad goal" g)) g;; let REAL_TAC ?(alternatives=[]) = REAL_TAC ~alternatives:(SYMMETRIC_TAC::ULINEARITY_TAC::SELF_ADJOINT_TAC::LINEARITY_TAC::alternatives);; let ANTI_COMMUTATOR_SYMMETRIC = prove (`!op1 op2 s1 s2 s inprod. is_symmetric (s,inprod) s1 op1 /\ is_symmetric (s,inprod) s2 op2 ==> is_symmetric (s,inprod) ( {x| x IN s2 /\ op2 x IN s1} INTER {x| x IN s1 /\ op1 x IN s2}) (op1 ** op2 + op2 ** op1)`, REWRITE_TAC[IS_SYMMETRIC] THEN SIMP_HORN_TAC THEN REPEAT STRIP_TAC THENL[RULE_ASSUM_TAC (REWRITE_RULE [INTER;IN_ELIM_THM]) THEN IMP_REWRITE_TAC[COP_MUL;INPROD_ADD_LDIST;INPROD_ADD_RDIST;SUBSET;INTER;COP_ADD_THM] THEN ASM_SIMP_TAC[COMPLEX_ADD_SYM] THEN ASM_MESON_TAC[SUBSET]; IMP_REWRITE_TAC[SUBSET;INNER_SPACE_ADD;COP_ADD_THM;COP_MUL] THEN ASSUM_LIST SET_TAC; ULINEARITY_TAC; ASSUM_LIST SET_TAC]);; add_symmetric_thm ANTI_COMMUTATOR_SYMMETRIC;; let NEG_SYMMETRIC = prove (`!op s1 s inprod. is_symmetric (s,inprod) s1 op ==> is_symmetric (s,inprod) s1 (--op)`, REWRITE_TAC[COP_ARITH `--op = --Cx(&1) % op`] THEN SYMMETRIC_TAC THEN REWRITE_TAC[REAL_CX;GSYM CX_NEG]);; add_symmetric_thm NEG_SYMMETRIC;; let SCALAR_II_HERM_UNBOUND = prove (`!op s1 s inprod. is_unbounded_linear_cop s1 op /\ s1 SUBSET s /\ (!x. x IN s1 ==> op x IN s) /\ (!x y. x IN s1 /\ y IN s1 ==> inprod (op x) y = -- (inprod x (op y))) ==> is_symmetric (s,inprod) s1 (ii % op)`, REPEAT STRIP_TAC THEN IMP_REWRITE_TAC[IS_SYMMETRIC;COP_SMUL_THM;INPROD_LSMUL;INPROD_RSMUL; CNJ_II;COMPLEX_NEG_MUL2;SUBSET ;INNER_SPACE_SMUL;SMUL_ULINCOP] THEN ASSUM_LIST SET_TAC);; add_symmetric_thm SCALAR_II_HERM_UNBOUND;; let COMMUTATOR_ANTI_UNBOUNDED_HERM = prove (`!op1 op2 s1 s2 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op1 /\ is_symmetric (s,inprod) s2 op2 ==> !x y. x IN s2 /\ op2 x IN s1 /\ x IN s1 /\ op1 x IN s2 /\ y IN s2 /\ op2 y IN s1 /\ y IN s1 /\ op1 y IN s2 ==> inprod (commutator op1 op2 x) y = --(inprod x (commutator op1 op2 y))`, IMP_REWRITE_TAC[commutator;IS_SYMMETRIC;COP_MUL_THM;COP_SUB_THM;INPROD_SUB_LDIST; INPROD_SUB_RDIST;COMPLEX_NEG_SUB;INPROD_SUB_LDIST;INPROD_SUB_RDIST;COMPLEX_NEG_SUB] THEN SET_TAC[]);; add_symmetric_thm COMMUTATOR_ANTI_UNBOUNDED_HERM;; let II_COMMUTATOR_UNBOUNDED_HERM = prove (`!op1 op2 s1 s2 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op1 /\ is_symmetric (s,inprod) s2 op2 ==> is_symmetric (s,inprod) ({x| x IN s2 /\ op2 x IN s1} INTER {x| x IN s1 /\ op1 x IN s2}) (ii % commutator op1 op2)`, SYMMETRIC_TAC THENL [REWRITE_TAC[commutator] THEN ULINEARITY_TAC THEN ASM_MESON_TAC[SYMMETRIC_IS_LINCOP] ;REWRITE_TAC[SUBSET;INTER;IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET;SYMMETRIC_SUBSET] ; REWRITE_TAC[commutator;INTER;IN_ELIM_THM;COP_SUB_THM;COP_MUL] THEN ASM_MESON_TAC[SYMMETRIC_CLOSURE;SYMMETRIC_SUBSET;SUBSET;INNER_SPACE_SUB] ;REWRITE_TAC[commutator;INTER;IN_ELIM_THM;COP_SUB_THM;COP_MUL] THEN IMP_REWRITE_TAC[INPROD_SUB_RDIST;INPROD_SUB_LDIST] THEN IMP_REWRITE_TAC[SYMMETRIC_ITSELF;COMPLEX_FIELD `--(a:complex-b) = b-a` ;SYMMETRIC_SUBSET;SYMMETRIC_CLOSURE] THEN ASM_MESON_TAC[SYMMETRIC_SUBSET;SUBSET]]);; add_symmetric_thm II_COMMUTATOR_UNBOUNDED_HERM;; let EXPEC_UNBOUNDED_HERM_REAL = prove (`!op s1 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op ==> !state. state IN s1 ==> real (expectation inprod state op)`, IMP_REWRITE_TAC[IS_SYMMETRIC;expectation;REAL_CNJ;INPROD_CNJ] THEN SIMP_TAC[SUBSET]);; add_real_thms [EXPEC_UNBOUNDED_HERM_REAL; REWRITE_RULE[expectation] EXPEC_UNBOUNDED_HERM_REAL];; let DEVIATION_UNBOUNDED_HERM_ALT = prove (`!op s1 s inprod state. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op /\ state IN s1 ==> is_symmetric (s,inprod) (s1 INTER s1) (deviation inprod state op)`, REWRITE_TAC[DEVIATION_ALT] THEN SYMMETRIC_TAC THEN ASM_MESON_TAC[SYMMETRIC_SUBSET;SUBSET;SYMMETRIC_IS_LINCOP;ULINCOP_SUBSPACE]);; let DEVIATION_UNBOUNDED_HERM = REWRITE_RULE [SET_RULE`s INTER s = s`] DEVIATION_UNBOUNDED_HERM_ALT;; add_symmetric_thms [DEVIATION_UNBOUNDED_HERM; REWRITE_RULE[deviation] DEVIATION_UNBOUNDED_HERM];; let VARIANCE_UNBOUNDED_REAL = prove (`!op s1 s inprod. is_inner_space (s,inprod) /\ is_symmetric (s,inprod) s1 op ==> !state. state IN s1 /\ deviation inprod state op state IN s1 ==> real (variance inprod state op)`, REWRITE_TAC[variance] THEN REAL_TAC THEN Pa.EXISTS_TAC `{x| x IN s1 /\ deviation inprod state op x IN s1}:` THEN Pa.EXISTS_TAC "s" THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN SYMMETRIC_TAC);; add_real_thm VARIANCE_REAL;; let is_eigen_pair_unbounded = new_definition `is_eigen_pair_unbounded s (op:cfun->cfun) (x,a) <=> is_unbounded_linear_cop s op ==> x IN s /\ op x = a % x /\ ~(x = cfun_zero)`;; let EIGEN_PAIR_SMUL_UNBOUNDED = prove (`!op s v x. is_eigen_pair_unbounded s op (x,v) ==> !a. ~(a = Cx(&0)) ==> is_eigen_pair_unbounded s op (a % x,v)`, SIMP_TAC[is_eigen_pair_unbounded;CFUN_ENTIRE] THEN MESON_TAC[ULINCOP_SMUL;ULINCOP_SUBSPACE; CFUN_SMUL_SYM;CFUN_SUBSPACE_SMUL]);; let EIGEN_PAIR_ADD_UNBOUNDED = prove (`!op s v x y. is_eigen_pair_unbounded s op (x,v) /\ is_eigen_pair_unbounded s op (y,v) /\ ~(x + y = cfun_zero) ==> is_eigen_pair_unbounded s op (x+y,v)`, SIMP_TAC[is_eigen_pair_unbounded]THEN MESON_TAC[ULINCOP_ADD;CFUN_ADD_LDISTRIB ;ULINCOP_SUBSPACE;CFUN_SUBSPACE_ADD]);; (* ------------------------------------------------------------------------- *) (* cfun norm *) (* ------------------------------------------------------------------------- *) let cfun_norm = new_definition `cfun_norm inprod (x:cfun) = sqrt(real_of_complex (inprod x x))`;; let INPROD_SUB_SELF = inner_space_prove( `!x y. x IN s /\ y IN s ==> real_of_complex (inprod (x-y) (x-y)) = real_of_complex(inprod x x) + real_of_complex(inprod y y) - &2*Re(inprod y x):`, IMP_REWRITE_TAC[INNER_SPACE_SUB;INPROD_SUB_LDIST;INPROD_SUB_RDIST; COMPLEX_FIELD `x:complex - y - (z - h) = x + h - (z+y)`;INPROD_ADD_CNJ] THEN IMP_REWRITE_TAC[REAL_OF_COMPLEX_ADD;REAL_OF_COMPLEX_CX; REAL_OF_COMPLEX_SUB;INPROD_SELF_REAL;REAL_CX;REAL_SUB]);; let INPROD_ADD_SELF = inner_space_prove( `!x y. x IN s /\ y IN s ==> real_of_complex (inprod (x+y) (x+y)) = real_of_complex(inprod x x) + real_of_complex(inprod y y) + &2*Re(inprod x y):`, IMP_REWRITE_TAC[INNER_SPACE_ADD ;INPROD_ADD_LDIST;INPROD_ADD_RDIST; COMPLEX_FIELD `((x:complex) + y) + z + h = x + h + (y+z)`;INPROD_ADD_CNJ] THEN IMP_REWRITE_TAC[REAL_OF_COMPLEX_ADD;REAL_OF_COMPLEX_CX; INPROD_SELF_REAL;REAL_CX;REAL_ADD]);; let INPROD_TRIANGLE_INEQ = inner_space_prove( `!x y. x IN s /\ y IN s ==> real_of_complex(inprod (x+y) (x+y)) <= (sqrt(real_of_complex (inprod x x)) + sqrt(real_of_complex (inprod y y))) pow 2:`, REWRITE_TAC[REAL_POW_2] THEN SIMP_TAC[REAL_ADD_LDISTRIB;REAL_ADD_RDISTRIB;REAL_MUL_SYM;GSYM REAL_ADD_ASSOC; REAL_ARITH `x*x+x*y+x*y+y*y = x pow 2 + y pow 2 + &2*x*y`] THEN IMP_REWRITE_TAC[SQRT_POW_2;INPROD_SELF_POS] THEN IMP_REWRITE_TAC[INPROD_ADD_SELF;REAL_ADD_ASSOC;REAL_LE_LADD_IMP; REAL_LE_LMUL_EQ] THEN MESON_TAC[GEN_ALL (Pa.SPEC `Re z:` REAL_ABS_LE);COMPLEX_NORM_GE_RE_IM; REAL_INT_LT_CONV `&0 < &2`;SCHWARZ_INEQUALITY2;REAL_LE_TRANS]);; let INPROD_TRIANGLE_INEQ2 = inner_space_prove( `!x y. x IN s /\ y IN s ==> sqrt (real_of_complex(inprod (x+y) (x+y))) <= sqrt(real_of_complex (inprod x x)) + sqrt(real_of_complex (inprod y y)):`, let REAL_MANOP = GEN_ALL(Pa.SPECL[`sqrt x:`;`sqrt y + sqrt z:`] (GEN_ALL(REAL_ARITH `&0 <= x /\ &0<= y ==> ( x <= y <=> abs x <= abs y)`))) in IMP_REWRITE_TAC[REAL_MANOP;REAL_LE_SQUARE_ABS;SQRT_POW_2;INPROD_TRIANGLE_INEQ; INPROD_SELF_POS;SQRT_POS_LE;INNER_SPACE_ADD;REAL_LE_ADD]);; let CFUN_NORM_SUB = inner_space_prove( `!x y. x IN s /\ y IN s ==> cfun_norm inprod (x-y) = cfun_norm inprod (y-x):`, IMP_REWRITE_TAC[cfun_norm;INPROD_SUB_SELF] THEN ONCE_REWRITE_TAC[GSYM (Pa.SPEC `&2 *Re r:` RE_CX)] THEN IMP_REWRITE_TAC[GSYM INPROD_ADD_CNJ] THEN ONCE_SIMP_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[REAL_ARITH `(x:real)+y-z = y+x-z`]);; let CFUN_NORM_SUB_INEQ = inner_space_prove( `!x y. x IN s /\ y IN s ==> cfun_norm inprod x - cfun_norm inprod y <= cfun_norm inprod (x-y):`, let arrange = MESON[CFUN_ARITH `x = (x:cfun) - y + y`] `cfun_norm inprod x - cfun_norm inprod y = cfun_norm inprod (x-y+y) - cfun_norm inprod y` in ONCE_REWRITE_TAC[arrange] THEN IMP_REWRITE_TAC[INPROD_TRIANGLE_INEQ2;REAL_LE_SUB_RADD;cfun_norm; INNER_SPACE_SUB]);; let cfun_dist = new_definition `cfun_dist (inprod:inprod) (x:cfun) (y:cfun) = sqrt (real_of_complex(inprod (x-y) (x-y)))`;; let CFUN_DIST_TRIANGLE_ADD = inner_space_prove( `!x y x' y'. x IN s /\ y IN s /\ x' IN s /\ y' IN s ==> cfun_dist inprod (x+y) (x'+y') <= cfun_dist inprod x x' + cfun_dist inprod y y':`, IMP_REWRITE_TAC[cfun_dist;CFUN_ARITH `((x:cfun)+y)-(x'+y') = x-x'+y-y'`; INPROD_TRIANGLE_INEQ2;INNER_SPACE_SUB;INPROD_SELF_POS;SQRT_POS_LE; SQRT_MONO_LE;REAL_ABS_REFL;SQRT_POW_2;POW_2_SQRT]);; let CFUN_DIST_REFL = inner_space_prove( `!x. cfun_dist inprod x x = &0:`, REWRITE_TAC[cfun_dist;CFUN_SUB_REFL] THEN MESON_TAC[INPROD_ZERO;SQRT_0;REAL_OF_COMPLEX_CX]);; let CFUN_NORM_0 = inner_space_prove( `cfun_norm inprod cfun_zero = &0:`, MESON_TAC[cfun_norm;INPROD_ZERO;REAL_OF_COMPLEX_CX;SQRT_0]);; let CFUN_NORM_EQ_0 = inner_space_prove( `!x. x IN s ==> (cfun_norm inprod x = &0 <=> (x equv cfun_zero) inprod):`, MESON_TAC[cfun_norm;SQRT_EQ_0;REAL_OF_COMPLEX_ZERO;INPROD_NORM;GSYM EQUV_ZERO]);; let CFUN_NORM_POS_LE = inner_space_prove( `!x. x IN s ==> &0 <= cfun_norm inprod x :`, MESON_TAC[cfun_norm;SQRT_POS_LE;INPROD_SELF_POS]);; let CFUN_NORM_POW2 = inner_space_prove( `!x. x IN s ==> cfun_norm inprod x pow 2 = real_of_complex (inprod x x):`, MESON_TAC[cfun_norm;SQRT_POW_2;INPROD_SELF_POS]);; let CFUN_NORM_INPROD_0 = inner_space_prove( `!x. x IN s ==> (cfun_norm inprod x = &0 <=> real_of_complex(inprod x x) = &0):`, MESON_TAC[cfun_norm;INPROD_SELF_POS;SQRT_EQ_0]);; let CFUN_NORM_NZ = inner_space_prove( `!x. x IN s ==> (~((x equv cfun_zero) inprod) <=> &0 < cfun_norm inprod x):`, IMP_REWRITE_TAC[ GSYM CFUN_NORM_EQ_0] THEN MESON_TAC[REAL_ARITH ` y <= x ==> (~(x=y) <=> y < x)`;CFUN_NORM_POS_LE] );; let CFUN_NORM_SMUL = inner_space_prove( `!x a. x IN s ==> cfun_norm inprod (a%x) = norm a * cfun_norm inprod x:`, IMP_REWRITE_TAC[cfun_norm;INPROD_RSMUL;INPROD_LSMUL;INNER_SPACE_SMUL] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC;COMPLEX_MUL_CNJ;COMPLEX_POW_2; GSYM CX_MUL;GSYM REAL_POW_2] THEN IMP_REWRITE_TAC[REAL_CX; INPROD_SELF_REAL; REAL_OF_COMPLEX_MUL;REAL_OF_COMPLEX_CX; SQRT_MUL;INPROD_SELF_POS;REAL_LE_POW_2;POW_2_SQRT;NORM_POS_LE]);; let CFUN_DIST_NZ = inner_space_prove( `!x y. x IN s /\ y IN s ==> (~((x equv y) inprod) <=> &0 < cfun_dist inprod x y):`, ONCE_REWRITE_TAC[GSYM CFUN_SUB_0] THEN REWRITE_TAC[cfun_dist;GSYM cfun_norm] THEN MESON_TAC[CFUN_NORM_NZ;EQUV_SUB_ZERO;INNER_SPACE_SUB] );; (* ------------------------------------------------------------------------- *) (* FINITE/INFINITE summation of cfun *) (* ------------------------------------------------------------------------- *) let cfun_sum = new_definition`cfun_sum = iterate cfun_add`;; let NEUTRAL_CFUN_ADD = prove (`neutral cfun_add = cfun_zero`,REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[CFUN_ADD_LID;CFUN_ADD_RID]);; let MONOIDAL_CFUN_ADD = prove (`monoidal cfun_add`, REWRITE_TAC[monoidal; NEUTRAL_CFUN_ADD] THEN CFUN_ARITH_TAC);; let CFUN_SUM_CLAUSES = prove (`(!f. cfun_sum {} f = cfun_zero) /\ (!x f s. FINITE s ==> cfun_sum (x INSERT s) f = (if x IN s then cfun_sum s f else f x + cfun_sum s f))`, REWRITE_TAC[cfun_sum; GSYM NEUTRAL_CFUN_ADD] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MESON_TAC[ITERATE_CLAUSES;MONOIDAL_CFUN_ADD]);; let CFUN_SUM_CLAUSES_NUMSEG = REWRITE_RULE[GSYM NEUTRAL_CFUN_ADD; GSYM cfun_sum] (MATCH_MP ITERATE_CLAUSES_NUMSEG MONOIDAL_CFUN_ADD);; let CFUN_SUM_CLAUSES_LEFT = prove (`!f m n. m <= n ==> cfun_sum (m..n) f = f(m) + cfun_sum(m+1..n) f`, SIMP_TAC[GSYM NUMSEG_LREC; CFUN_SUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; let CFUN_SUM_IMAGE = prove (`!f g s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> (cfun_sum (IMAGE f s) g = cfun_sum s (g o f))`, REWRITE_TAC[cfun_sum; GSYM NEUTRAL_CFUN_ADD] THEN MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_CFUN_ADD]);; let NUMSEG_EMPTY_IMP = prove(`!m n. n < m ==> (m..n = {}) `, SIMP_TAC[NUMSEG_EMPTY] );; let CFUN_SUM_TRIV_NUMSEG = prove (`!m n f. n < m ==> cfun_sum (m..n) f = cfun_zero`, SIMP_TAC[NUMSEG_EMPTY_IMP;CFUN_SUM_CLAUSES]);; let CFUN_SUM_OFFSET = prove (`!p f m n. cfun_sum(m+p..n+p) f = cfun_sum(m..n) (\i. f(i + p))`, SIMP_TAC[NUMSEG_OFFSET_IMAGE; CFUN_SUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[o_DEF]);; let CFUN_SUM_OFFSET_0 = prove (`!f m n. m <= n ==> (cfun_sum(m..n) f = cfun_sum(0..n-m) (\i. f(i + m)))`, SIMP_TAC[GSYM CFUN_SUM_OFFSET; ADD_CLAUSES; SUB_ADD]);; let CFUN_SUM_CONST = prove (`!c s. FINITE s ==> (cfun_sum s (\n. c) = Cx(&(CARD s)) % c)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CFUN_SUM_CLAUSES; CARD_CLAUSES; GSYM REAL_OF_NUM_SUC] THEN REPEAT STRIP_TAC THEN CFUN_ARITH_TAC);; let CFUN_SUM_EQ_0 = prove (`!f s. (!x:A. x IN s ==> (f(x) = cfun_zero)) ==> (cfun_sum s f = cfun_zero)`, REWRITE_TAC[cfun_sum; GSYM NEUTRAL_CFUN_ADD] THEN SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_CFUN_ADD]);; let CFUN_SUM_0 = prove (`!s:A->bool. cfun_sum s (\n. cfun_zero) = cfun_zero`, SIMP_TAC[CFUN_SUM_EQ_0]);; let CFUN_SUM_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (cfun_sum s f = cfun_sum s g)`, REWRITE_TAC[cfun_sum] THEN MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_CFUN_ADD]);; let CFUN_SUM_SING = prove (`!f x. cfun_sum {x} f = f(x)`, SIMP_TAC[CFUN_SUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; CFUN_ADD_RID]);; let CFUN_SUM_SING_NUMSEG = prove (`!f n. cfun_sum(n..n) f = f(n)`, SIMP_TAC[CFUN_SUM_SING; NUMSEG_SING]);; let CFUN_SUM_EQ_NUMSEG = prove (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) ==> (cfun_sum(m..n) f = cfun_sum(m..n) g)`, MESON_TAC[CFUN_SUM_EQ; FINITE_NUMSEG; IN_NUMSEG]);; let CFUN_SUM_IN_SPC = prove (`!g spc. is_cfun_subspace spc /\ (!n. g n IN spc) ==> !s. FINITE s ==> cfun_sum s g IN spc`, REPEAT GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CFUN_SUM_CLAUSES] THEN ASM_SIMP_TAC[CFUN_SUBSPACE_ZERO;CFUN_SUBSPACE_ADD]);; let SLINEAR_CFUN_SUM = prove (`! spc f g. is_cfun_subspace spc /\ (!n. g n IN spc) /\ is_set_linear_cop spc f ==> !s. FINITE s ==> (f(cfun_sum s g) = cfun_sum s (f o g))`, REPEAT GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CFUN_SUM_CLAUSES] THEN REPEAT STRIP_TAC THENL[ASM_MESON_TAC[SLINCOP_CFUN_ZERO];IMP_REWRITE_TAC[SLINCOP_ADD]] THEN Pa.EXISTS_TAC `spc:` THEN ASM_SIMP_TAC[CFUN_SUM_IN_SPC;o_DEF]);; let SLINEAR_CFUN_SUM_IMP = prove (`! spc f g s. is_cfun_subspace spc /\ (!n. g n IN spc) /\ is_set_linear_cop spc f /\FINITE s ==> (f(cfun_sum s g) = cfun_sum s (f o g))`, MESON_TAC [SLINEAR_CFUN_SUM]);; let LINEAR_CFUN_SUM = prove (`!f g s. is_linear_cop f /\ FINITE s ==> (f(cfun_sum s g) = cfun_sum s (f o g))`, GEN_TAC THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CFUN_SUM_CLAUSES] THEN FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP LINCOP_CFUN_ZERO th; MATCH_MP LINCOP_ADD th; o_THM]));; let CFUN_SUM_ADD = prove (`!f g s. FINITE s ==> (cfun_sum s (\x. f(x) + g(x)) = cfun_sum s f + cfun_sum s g)`, SIMP_TAC[cfun_sum; ITERATE_OP; MONOIDAL_CFUN_ADD]);; let CFUN_SUM_SMUL = prove (`!f a s. FINITE s ==> (cfun_sum s (\x. a % f(x) ) = a % cfun_sum s f)`, ONCE_REWRITE_TAC[MESON[] `a % (y:cfun) = (\x. a%x) y`] THEN SIMP_TAC[REWRITE_RULE [o_DEF] (GSYM LINEAR_CFUN_SUM); SCALAR_LINCOP]);; let CFUN_SUM_SUB = prove (`!f g s. FINITE s ==> (cfun_sum s (\x. f(x) - g(x)) = cfun_sum s f - cfun_sum s g)`, ONCE_REWRITE_TAC[CFUN_SUB_NEG] THEN ONCE_REWRITE_TAC[GSYM CFUN_SMUL_LID_NEG] THEN SIMP_TAC[CFUN_SUM_SMUL; CFUN_SUM_ADD]);; let CUN_SUM_ADD_NUMSEG = prove (`!f g m n. cfun_sum(m..n) (\i. f(i) + g(i)) = cfun_sum(m..n) f + cfun_sum(m..n) g`, SIMP_TAC[CFUN_SUM_ADD; FINITE_NUMSEG]);; let cfun_lim = new_definition `cfun_lim1 (s,inprod) f l net <=> is_inner_space (s,inprod) /\ l IN s /\ (!x. (f x) IN s) /\ (!e. &0 < e ==> eventually (\x. cfun_dist inprod (f x) l < e) net)`;; let CFUN_LIM_INNER_SPACE = prove (`!innerspc f l net. cfun_lim1 innerspc f l net ==> is_inner_space innerspc`, SIMP_TAC[FORALL_INNER_SPACE_THM;cfun_lim]);; let is_bounded = new_definition `is_bounded1 (s,inprod) h <=> is_inner_space (s,inprod) ==> ?B. &0 < B /\ (!x. x IN s /\ h x IN s ==> sqrt(real_of_complex(inprod (h x) (h x))) <= B * sqrt(real_of_complex(inprod x x)))`;; let is_bounded_linear = new_definition `is_bounded_linear1 (s,inprod) h <=> is_inner_space (s,inprod) ==> is_linear_cop h /\ is_closed_by s h /\ ?B. &0 < B /\ (!x. x IN s ==> sqrt(real_of_complex(inprod (h x) (h x))) <= B * sqrt(real_of_complex(inprod x x)))`;; let SCALAR_BOUNDED = prove (`!a is. is_bounded1 is (\x:cfun. a % x)`, SIMP_TAC[FORALL_INNER_SPACE_THM;is_bounded] THEN REPEAT STRIP_TAC THEN Pa.ASM_CASES_TAC `a = Cx(&0):` THENL[ Pa.EXISTS_TAC `&1:` THEN ASM_REWRITE_TAC[REAL_LT_01;CFUN_SMUL_LZERO;REAL_MUL_LID] THEN ASM_MESON_TAC[SQRT_POS_LE;REAL_OF_COMPLEX_CX;SQRT_0;INPROD_ZERO; INPROD_SELF_POS];Pa.EXISTS_TAC `norm a:` THEN IMP_REWRITE_TAC[COMPLEX_NORM_NZ;REAL_LE_REFL;GSYM cfun_norm; CFUN_NORM_SMUL]]);; let CFUN_LIM = prove (`cfun_lim1 (s,inprod) f l net <=> is_inner_space (s,inprod) /\ l IN s /\ (!x. (f x) IN s) /\ (trivial_limit net \/ !e. &0 < e ==> ?y. (?x. netord(net) x y) /\ !x. netord(net) x y ==> cfun_dist inprod (f x) l < e)`, REWRITE_TAC[cfun_lim; eventually] THEN MESON_TAC[]);; let CFUN_LIM_ULINEAR = prove (`!net:(A)net h s1 f l s inprod. cfun_lim1 (s,inprod) f l net /\ is_unbounded_linear_cop s1 h /\ (!x. x IN s1 ==> x IN s /\ h x IN s) /\ (!x. f x IN s1) /\ l IN s1 /\ is_bounded1 (s,inprod) h ==> cfun_lim1 (s,inprod) (\x.h (f x)) (h l) net`, REWRITE_TAC[FORALL_INNER_SPACE_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CFUN_LIM] THEN ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_SIMP_TAC[is_bounded;is_closed_by] THEN STRIP_TAC THEN FIRST_ASSUM(fun thm -> FIRST_ASSUM (ASSUME_TAC o MP thm)) THEN FIRST_ASSUM STRIP_ASSUME_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o Pa.SPEC `e / B:`) THEN ASM_SIMP_TAC[REAL_LT_DIV;cfun_dist;REAL_LT_RDIV_EQ] THEN IMP_REWRITE_TAC[GSYM (Pa.SPEC "s1" ULINCOP_SUB);ULINCOP_SUBSPACE] THEN REPEAT STRIP_TAC THEN Pa.EXISTS_TAC "y" THEN CONJ_TAC THENL[ASM_MESON_TAC[];ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN Pa.EXISTS_TAC "sqrt (real_of_complex (inprod (f x' - l) (f x' - l))) * B" THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN IMP_REWRITE_TAC[INNER_SPACE_SUB] THEN ASM_MESON_TAC[ULINCOP_SUB;INNER_SPACE_SUB]);; let cfun_sums = new_definition `cfun_sums innerspc f l s <=> cfun_lim1 innerspc (\n. cfun_sum (s INTER (0..n)) f) l sequentially`;; let cfun_infsum = new_definition `cfun_infsum innerspc s f = @l. cfun_sums innerspc f l s`;; let cfun_summable = new_definition `cfun_summable innerspc s f = ?l. cfun_sums innerspc f l s`;; let CFUN_SUMS_INNER_SPACE = prove (`!innerspc f l s. cfun_sums innerspc f l s ==> is_inner_space innerspc`, SIMP_TAC[FORALL_INNER_SPACE_THM;cfun_sums;cfun_lim]);; let CFUN_SUMS_SUMMABLE = prove (`!f l s innerspc. cfun_sums innerspc f l s ==> cfun_summable innerspc s f`, REWRITE_TAC[cfun_summable] THEN MESON_TAC[]);; let CFUN_SUMS_INFSUM = prove (`!f s innerspc. cfun_sums innerspc f (cfun_infsum innerspc s f) s <=> cfun_summable innerspc s f`, REWRITE_TAC[cfun_infsum;cfun_summable] THEN MESON_TAC[]);; let CFUN_SUM_RESTRICT = prove (`!f s. FINITE s ==> (cfun_sum s (\x. if x IN s then f(x) else cfun_zero) = cfun_sum s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CFUN_SUM_EQ THEN ASM_SIMP_TAC[]);; let CFUN_SUM_SUPERSET = prove (`!f u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = cfun_zero)) ==> (cfun_sum v f = cfun_sum u f)`, SIMP_TAC[cfun_sum; GSYM NEUTRAL_CFUN_ADD; ITERATE_SUPERSET; MONOIDAL_CFUN_ADD]);; let CFUN_LIM_SEQUENTIALLY = prove (`!f l s inprod. cfun_lim1 (s,inprod) f l sequentially <=> is_inner_space (s,inprod) /\ l IN s /\ (!x. f x IN s) /\ (!e. &0 < e ==> ?N. !n. N <= n ==> cfun_dist inprod (f n) l < e)`, REWRITE_TAC[cfun_lim; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);; let CFUN_LIM_NEG = prove (`!net f l innerspc. cfun_lim1 innerspc f l net ==> cfun_lim1 innerspc (\x. --(f x)) (--l) net`, REWRITE_TAC[FORALL_INNER_SPACE_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CFUN_LIM;cfun_dist] THEN IMP_REWRITE_TAC[CFUN_ARITH `--(x:cfun) - --y = --(x - y)`; INPROD_NEG;CFUN_SUBSPACE_SUB;CFUN_SUBSPACE_NEG] THEN MESON_TAC[INNER_SPACE_IS_SUBSPACE]);; let CFUN_LIM_ADD = prove (`!net f g l m innerspc. cfun_lim1 innerspc f l net /\ cfun_lim1 innerspc g m net ==> cfun_lim1 innerspc (\x. f(x) + g(x)) (l+m) net`, REWRITE_TAC[FORALL_INNER_SPACE_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CFUN_LIM;CONJ_ACI] THEN Pa.ASM_CASES_TAC `trivial_limit net:` THEN IMP_REWRITE_TAC[INNER_SPACE_ADD] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2` o REWRITE_RULE[MESON[] `!A B C D E F.A /\ B /\ C /\ D /\ (!x. E x) /\ (!x. F x) /\ G <=> !x. A /\ B /\ C /\D /\ G /\E x /\ F x `]) THEN REPEAT STRIP_TAC THEN POP_ASSUM( fun thm1 -> POP_ASSUM (fun thm2 -> MP_TAC (CONJS[thm1;thm2]))) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_ACI] NET_DILEMMA)) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THENL[ MATCH_MP_TAC REAL_LET_TRANS THEN Pa.EXISTS_TAC `cfun_dist inprod (f x') l + cfun_dist inprod (g x') m:` THEN ASM_MESON_TAC[REAL_HALF;CFUN_DIST_TRIANGLE_ADD;REAL_LT_ADD2];ASM_MESON_TAC[]]);; let CFUN_LIM_SUB = prove (`!net f g l m innerspc. cfun_lim1 innerspc f l net /\ cfun_lim1 innerspc g m net ==> cfun_lim1 innerspc (\x. f(x) - g(x)) (l-m) net`, REWRITE_TAC[CFUN_SUB_NEG] THEN ASM_SIMP_TAC[CFUN_LIM_ADD;CFUN_LIM_NEG]);; let CFUN_LIM_CONST = prove (`!net s inprod y. y IN s /\ is_inner_space (s,inprod) ==> cfun_lim1 (s,inprod) (\x. y) y net`, IMP_REWRITE_TAC[CFUN_LIM; CFUN_DIST_REFL; trivial_limit] THEN MESON_TAC[]);; let CFUN_LIM_SMUL = prove (`!a net f l innerspc. cfun_lim1 innerspc f l net ==> cfun_lim1 innerspc (\x. a% f(x)) (a%l) net`, REWRITE_TAC[FORALL_INNER_SPACE_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CFUN_LIM_ULINEAR THEN Pa.EXISTS_TAC "s" THEN ASM_SIMP_TAC[REWRITE_RULE [ETA_AX]SCALAR_BOUNDED;is_unbounded_linear_cop] THEN RULE_ASSUM_TAC(REWRITE_RULE[cfun_lim]) THEN ASM_MESON_TAC[INNER_SPACE_IS_SUBSPACE;CFUN_SUBSPACE_SMUL;CFUN_ADD_LDISTRIB;CFUN_SMUL_ASSOC;COMPLEX_MUL_SYM] );; let CFUN_LIM_NORM_UBOUND = prove (`!net:(A)net f l b s inprod. ~(trivial_limit net) /\ cfun_lim1 (s,inprod) f l net /\ eventually (\x. cfun_norm inprod (f x) <= b) net ==> cfun_norm inprod l <= b`, let STEP = MESON[CFUN_NORM_SUB_INEQ;CFUN_NORM_SUB; REAL_ARITH `z <= b /\ x-z <= y ==> x <= y+b`] `is_inner_space (s,inprod) /\ l IN s /\ f IN s ==> cfun_norm inprod l <= cfun_norm inprod (f-l) + b \/ ~(cfun_norm inprod f <= b)` in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[CFUN_LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[eventually] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN Pa.SUBGOAL_THEN `?x:A. cfun_dist inprod (f x) l < cfun_norm inprod l - b /\ cfun_norm inprod(f x) <= b:` (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; cfun_dist;GSYM cfun_norm] THEN MATCH_MP_TAC STEP THEN ASM_REWRITE_TAC[] );; let CFUN_LIM_UNIQUE = prove (`!net:(A)net f l l' s inprod. ~(trivial_limit net) /\ cfun_lim1 (s,inprod) f l net /\ cfun_lim1 (s,inprod) f l' net ==> (l equv l') inprod`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN (fun thm -> ASSUME_TAC (REWRITE_RULE[cfun_lim] thm) THEN (ASSUME_TAC (REWRITE_RULE[CFUN_SUB_REFL] (MATCH_MP CFUN_LIM_SUB thm)))) THEN Pa.SUBGOAL_THEN `!e. &0 < e ==> cfun_norm inprod (l-l') <= e:` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CFUN_LIM_NORM_UBOUND THEN MAP_EVERY Pa.EXISTS_TAC [`net:(A)net:`; `\x:A. cfun_zero:`;`s:`] THEN ASM_REWRITE_TAC[] THEN IMP_REWRITE_TAC[CFUN_NORM_0; REAL_LT_IMP_LE] THEN ASM_MESON_TAC[eventually]; DISCH_THEN(MP_TAC o Pa.SPEC `cfun_norm inprod (l-l') / &2:`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN IMP_REWRITE_TAC[CFUN_DIST_NZ] THEN REWRITE_TAC[cfun_dist;GSYM cfun_norm] THEN DISCH_THEN (fun thm -> ASSUM_LIST(fun thms -> MP_TAC (REWRITE_RULE thms (Pa.SPECL [`s:`] thm)))) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REAL_ARITH_TAC]);; let CFUN_SERIES_ADD = prove (`!f g l l' s innerspc. cfun_sums innerspc f l s /\ cfun_sums innerspc g l' s ==> cfun_sums innerspc (\n.f n + g n) (l+l') s`, SIMP_TAC[cfun_sums; FINITE_INTER_NUMSEG; CFUN_SUM_ADD; CFUN_LIM_ADD]);; let CFUN_SERIES_SUB = prove (`!f g l l' s innerspc. cfun_sums innerspc f l s /\ cfun_sums innerspc g l' s ==> cfun_sums innerspc (\n.f n - g n) (l-l') s`, SIMP_TAC[cfun_sums; FINITE_INTER_NUMSEG; CFUN_SUM_SUB; CFUN_LIM_SUB]);; let CFUN_SERIES_SMUL = prove (`!a f l s innerspc. cfun_sums innerspc f l s ==> cfun_sums innerspc (\n.a% (f n)) (a%l) s`, SIMP_TAC[cfun_sums; FINITE_INTER_NUMSEG; CFUN_SUM_SMUL; CFUN_LIM_SMUL]);; let CFUN_SERIES_UNIQUE = prove (`!f l l' s s1 inprod. cfun_sums (s1,inprod) f l s /\ cfun_sums (s1,inprod) f l' s ==> (l equv l') inprod`, REWRITE_TAC[cfun_sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; CFUN_LIM_UNIQUE]);; let CFUN_INFSUM_UNIQUE = prove (`!f l s s1 inprod. cfun_sums (s1,inprod) f l s ==> (cfun_infsum (s1,inprod) s f equv l) inprod`, MESON_TAC[CFUN_SERIES_UNIQUE; CFUN_SUMS_INFSUM; cfun_summable]);; let INFSUM_IN_SPC = prove (`!spc inprod f l s. cfun_summable (spc,inprod) s f ==> (cfun_infsum (spc,inprod) s f) IN spc`, REWRITE_TAC[cfun_summable;cfun_lim;cfun_infsum;cfun_sums] THEN MESON_TAC[CFUN_LIM_UNIQUE]);; let CFUN_SERIES_0 = prove (`!s spc inprod. is_inner_space (spc,inprod) ==> cfun_sums (spc,inprod) (\n. cfun_zero) (cfun_zero) s`, IMP_REWRITE_TAC[cfun_sums; CFUN_SUM_0; CFUN_LIM_CONST;INNER_SPACE_ZERO]);; let CFUN_SERIES_FINITE = prove (`!f s spc inprod. (!x. f x IN spc) /\ is_inner_space (spc,inprod) /\ FINITE s ==> cfun_sums (spc,inprod) f (cfun_sum s f) s`, REPEAT STRIP_TAC THEN POP_ASSUM (fun thm -> MP_TAC thm THEN ASSUME_TAC thm) THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[cfun_sums; CFUN_LIM_SEQUENTIALLY] THEN IMP_REWRITE_TAC[CFUN_SUM_IN_SPC;FINITE_INTER_NUMSEG; INNER_SPACE_IS_SUBSPACE] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `s INTER (0..m) = s` (fun th -> ASM_SIMP_TAC[th]) THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[LE_TRANS;CFUN_DIST_REFL]);; let CFUN_SERIES_SLINEAR = prove (`!f h l s s1 s2 inprod. cfun_sums (s2,inprod) f l s /\ is_unbounded_linear_cop s1 h /\ is_bounded1 (s2,inprod) h /\ (!x. x IN s1 ==> x IN s2 /\ h x IN s2) /\ (!n. f n IN s1) /\ l IN s1 ==> cfun_sums (s2,inprod) (\n. h(f n)) (h l) s `, REWRITE_TAC[cfun_sums] THEN REPEAT STRIP_TAC THEN Pa.SUBGOAL_THEN `!n. cfun_sum (s INTER(0..n)) (\x. h(f x)) = h(cfun_sum (s INTER(0..n)) f):` ASSUME_TAC THENL[IMP_REWRITE_TAC[FINITE_INTER; FINITE_NUMSEG; GSYM(REWRITE_RULE[o_DEF] SLINEAR_CFUN_SUM_IMP)] THEN ASM_MESON_TAC[ULINCOP_SUBSPACE;ULINCOP_ADD;ULINCOP_SMUL;is_set_linear_cop]; ASM_SIMP_TAC[cfun_sums] THEN MATCH_MP_TAC CFUN_LIM_ULINEAR THEN Pa.EXISTS_TAC "s1" THEN ASM_MESON_TAC[CFUN_SUM_IN_SPC;ULINCOP_SUBSPACE;FINITE_INTER; FINITE_NUMSEG] ]);; let CFUN_INFSUM_0 = prove (`!spc inprod s. is_inner_space (spc,inprod) ==> (cfun_infsum (spc,inprod) s (\i. cfun_zero) equv cfun_zero) inprod`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CFUN_INFSUM_UNIQUE THEN ASM_SIMP_TAC[CFUN_SERIES_0]);; let CFUN_INFSUM_SLINEAR = prove (`!f h l s s1 s2 inprod. cfun_summable (s2,inprod) s f /\ is_unbounded_linear_cop s1 h /\ is_bounded1 (s2,inprod) h /\ (!x. x IN s1 ==> x IN s2 /\ h x IN s2) /\ (!n. f n IN s1) /\ (cfun_infsum (s2,inprod) s f) IN s1 ==> (cfun_infsum (s2,inprod) s (\n. h(f n)) equv h (cfun_infsum (s2,inprod) s f)) inprod`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CFUN_INFSUM_UNIQUE THEN MATCH_MP_TAC CFUN_SERIES_SLINEAR THEN Pa.EXISTS_TAC "s1" THEN ASM_SIMP_TAC[CFUN_SUMS_INFSUM]);; let CFUN_INFSUM_SMUL = prove (`!a f s s1 inprod. cfun_summable (s1,inprod) s f ==> (cfun_infsum (s1,inprod) s (\n.a% (f n)) equv a % (cfun_infsum (s1,inprod) s f)) inprod`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CFUN_INFSUM_UNIQUE THEN MATCH_MP_TAC CFUN_SERIES_SMUL THEN ASM_REWRITE_TAC[CFUN_SUMS_INFSUM]);; let CFUN_SERIES_RESTRICT = prove (`!f k l innerspc. cfun_sums innerspc (\n. if n IN k then f(n) else cfun_zero) l (:num) <=> cfun_sums innerspc f l k`, REPEAT GEN_TAC THEN REWRITE_TAC[cfun_sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[INTER_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] ` cfun_sum s f = cfun_sum t f /\ cfun_sum t f = cfun_sum t g ==> cfun_sum s f = cfun_sum t g`) THEN CONJ_TAC THENL [MATCH_MP_TAC CFUN_SUM_SUPERSET THEN SET_TAC[]; MATCH_MP_TAC CFUN_SUM_EQ THEN SIMP_TAC[IN_INTER]]);; let CFUN_SUMS_FINITE_DIFF = prove (`!f l s t spc inpord. t SUBSET s /\ FINITE t /\ (!x. f x IN spc) /\ cfun_sums (spc,inpord) f l s ==> cfun_sums (spc,inpord) f (l - cfun_sum t f) (s DIFF t)`, let lem = MESON[]`(P /\ Q /\ E ==> C)<=> (E ==> P ==> Q ==>C)` in REPEAT STRIP_TAC THEN FIRST_ASSUM (ASSUME_TAC o MATCH_MP CFUN_SUMS_INNER_SPACE) THEN ASSUME_TAC (REWRITE_RULE[lem] CFUN_SERIES_FINITE) THEN REPEAT (FIRST_X_ASSUM (fun thm1 -> POP_ASSUM (fun thm2 -> ASSUME_TAC ( MATCH_MP thm2 thm1)))) THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CFUN_SERIES_RESTRICT] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CFUN_SERIES_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN ASM_REWRITE_TAC[CFUN_SUB_REFL;CFUN_SUB_RID]);; let CFUN_SUMS_OFFSET = prove (`!f l m n s inprod. cfun_sums (s,inprod) f l (from m) /\ (!x. f x IN s) /\ m < n ==> cfun_sums (s,inprod) f (l - cfun_sum (m..(n-1)) f) (from n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC; MATCH_MP_TAC CFUN_SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);; let CFUN_SUMMABLE_OFFSET = prove (`!f s inprod n. cfun_summable (s,inprod) (from m) f /\ (!x. f x IN s) /\ m < n ==> cfun_summable (s,inprod) (from n) f`, MESON_TAC[cfun_summable;CFUN_SUMS_OFFSET]);; let CFUN_INFSUM_OFFSET = prove (`!f s inprod n m. cfun_summable (s,inprod) (from m) f /\ (!x. f x IN s) /\ m < n ==> (cfun_infsum (s,inprod) (from n) f equv ( cfun_infsum (s,inprod) (from m) f - cfun_sum (m..n-1) f))inprod`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CFUN_SUMS_INFSUM] THEN DISCH_THEN(MP_TAC o MATCH_MP CFUN_SUMS_OFFSET) THEN MESON_TAC[CFUN_INFSUM_UNIQUE]);; let CFUN_SUMS_REINDEX = prove (`!f innerspc n l k. cfun_sums innerspc (\x. f(x+k)) l (from n) <=> cfun_sums innerspc f l (from (n+k))`, REWRITE_TAC[FORALL_INNER_SPACE_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[cfun_sums; FROM_INTER_NUMSEG] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CFUN_SUM_OFFSET] THEN REWRITE_TAC[CFUN_LIM_SEQUENTIALLY] THEN EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THENL[Pa.ASM_CASES_TAC ` k <= x:` THENL[ FIRST_ASSUM(fun th -> ASM_MESON_TAC[SUB_ADD; Pa.SPEC `x-k:` th]); IMP_REWRITE_TAC[CFUN_SUM_TRIV_NUMSEG;INNER_SPACE_ZERO] THEN POP_ASSUM MP_TAC THEN ARITH_TAC];ALL_TAC;ALL_TAC] THEN ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`; ARITH_RULE `N + k:num <= n ==> N <= n + k`]);; let CFUN_SUMMABLE_REINDEX = prove (`!f innerspc n k. cfun_summable innerspc (from n) (\x. f(x+k)) <=> cfun_summable innerspc (from (n+k)) f`, MESON_TAC[cfun_summable;CFUN_SUMS_REINDEX]);; let CFUN_INFSUM_REINDEX = prove (`!f s inprod n k. cfun_summable (s,inprod) (from n) (\x. f (x + k)) ==> (cfun_infsum (s,inprod) (from (n+k)) f equv cfun_infsum (s,inprod) (from n) (\x. f(x+k))) inprod `, REPEAT STRIP_TAC THEN MATCH_MP_TAC CFUN_INFSUM_UNIQUE THEN ASM_SIMP_TAC[GSYM CFUN_SUMS_REINDEX;CFUN_SUMS_INFSUM]);; (* ------------------------------------------------------------------------- *) (* FINITE summation of cop *) (* ------------------------------------------------------------------------- *) let cop_sum = new_definition`cop_sum s f = \x. cfun_sum s (\n.(f n) x)`;; let COP_BINOMIAL_THEOREM = prove (`!n op1 op2. op1 ** op2 = op2 ** op1 /\ is_linear_cop op1 /\ is_linear_cop op2 ==> (op1 + op2) pow n = cop_sum (0..n) (\k. Cx (&(binom (n,k))) % (op1 pow k ** op2 pow (n - k)))`, INDUCT_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[cop_pow;cop_sum] THEN REWRITE_TAC[CFUN_SUM_SING_NUMSEG; binom; SUB_REFL; cop_pow; COP_MUL_LID; I_THM;GSYM I_DEF;COP_SMUL_LID] THEN SIMP_TAC[CFUN_SUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; CFUN_SUM_OFFSET] THEN ASM_SIMP_TAC[cop_pow; binom; GSYM ADD1;COP_MUL_LID;COP_SMUL_LID;cop_sum] THEN ASM_SIMP_TAC[LINEAR_CFUN_SUM;ADD_LINCOP;COP_MUL;FINITE_NUMSEG; o_DEF;COP_ADD_MUL_RDISTRIB] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD;CX_ADD;COP_ADD_RDISTRIB; CUN_SUM_ADD_NUMSEG;SUB_0;GSYM COP_ADD; COP_ADD_THM] THEN MATCH_MP_TAC( MESON[COP_ADD_AC] `a = e /\ b = c + d ==> a + b = c + d + e`) THEN CONJ_TAC THEN REWRITE_TAC[GSYM COP_MUL;GSYM COP_MUL_THM; GSYM I_DEF ; COP_MUL_RID] THENL [ASM_SIMP_TAC[GSYM LINCOP_MUL_RMUL;SUB_SUC;COP_MUL]; SIMP_TAC[GSYM cop_pow;GSYM COP_MUL_ASSOC]] THEN SIMP_TAC[ADD1; SYM(REWRITE_CONV[CFUN_SUM_OFFSET] `cfun_sum(m+1..n+1) (\i. f i)`)] THEN REWRITE_TAC[CFUN_SUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN SIMP_TAC[CFUN_SUM_CLAUSES_LEFT; LE_0; BINOM_LT; LT; COP_SMUL_LID; SUB_0; cop_pow;binom; COP_SMUL_LZERO;COP_ZERO;CFUN_ADD_RID;COP_MUL_LID] THEN ASM_SIMP_TAC[GSYM COP_ADD; COP_MUL_RID;COP_EQ_ADD_LCANCEL; LINCOP_MUL_RMUL;ARITH;ETA_AX;GSYM COP_MUL_ASSOC] THEN ABS_TAC THEN RULE_ASSUM_TAC GSYM THEN MATCH_MP_TAC CFUN_SUM_EQ_NUMSEG THEN SIMP_TAC[ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; cop_pow] THEN ASM_SIMP_TAC[COP_POW_COMMUTE_N] THEN SIMP_TAC[COP_POW_COMMUTE_N; COP_MUL_ASSOC]);; hol-light/Functionspaces/make.ml000066400000000000000000000026521303454263000172050ustar00rootroot00000000000000(* ========================================================================= *) (* Library of complex function vector spaces. *) (* *) (* (c) Copyright, Mohamed Yousri Mahmoud, Vincent Aravantinos, 2012-2013 *) (* Hardware Verification Group, *) (* Concordia University *) (* *) (* Contact: , *) (* Last update: Mar 2015 *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* Load the "q" module for more convenient parsing with type inference. *) (* ------------------------------------------------------------------------- *) needs "Library/q.ml";; (* ------------------------------------------------------------------------- *) (* The main files. *) (* ------------------------------------------------------------------------- *) needs "Functionspaces/utils.ml";; needs "Functionspaces/cfunspace.ml";; needs "Functionspaces/L2.ml";; hol-light/Functionspaces/utils.ml000066400000000000000000000132411303454263000174240ustar00rootroot00000000000000(* ========================================================================= *) (* *) (* Quantum optics library: utilities. *) (* *) (* (c) Copyright, Mohamed Yousri Mahmoud, Vincent Aravantinos, 2012-2013 *) (* Hardware Verification Group, *) (* Concordia University *) (* *) (* Contact: , *) (* *) (* Last update: Feb 27, 2013 *) (* *) (* ========================================================================= *) needs "Library/q.ml";; let EQ_TO_IMP = TAUT `!P Q. (P <=> Q) <=> (P ==> Q) /\ (Q==>P)`;; let EQ_NOT = TAUT `!P Q.(~P <=> ~Q) <=> (P <=> Q)`;; let LET_DEFS = CONJ LET_DEF LET_END_DEF;; module Pa = struct include Pa let COMPLEX_FIELD = call_with_interface prioritize_complex COMPLEX_FIELD;; let SIMPLE_COMPLEX_ARITH = call_with_interface prioritize_complex SIMPLE_COMPLEX_ARITH; end;; let HINT_EXISTS_TAC (hs,c as g) = let hs = map snd hs in let v,c' = dest_exists c in let vs,c' = strip_exists c' in let hyp_match c h = ignore (check (not o exists (C mem vs) o frees) c); term_match (subtract (frees c) [v]) c (concl h), h in let (_,subs,_),h = tryfind (C tryfind hs o hyp_match) (binops `/\` c') in let witness = match subs with |[] -> v |[t,u] when u = v -> t |_ -> failwith "HINT_EXISTS_TAC not applicable" in (EXISTS_TAC witness THEN REWRITE_TAC hs) g;; let GEN_PURE_MP_REWR_TAC sel th = let PART_MATCH = let concl = snd o dest_imp in let body = snd o strip_forall o concl in try PART_MATCH (lhs o body) th with _ -> let f1 = PART_MATCH concl th and f2 = PART_MATCH body th in fun t -> try f1 t with _ -> f2 t in fun (_,c as g) -> let th = ref TRUTH in let match_term t = try th := PART_MATCH t; true with _ -> false in ignore (find_term match_term (sel c)); let _,big_th = EQ_IMP_RULE (ONCE_REWRITE_CONV[UNDISCH (SPEC_ALL !th)] c) in let mp_th = (GEN_ALL o ONCE_REWRITE_RULE[IMP_IMP] o DISCH_ALL) big_th in MATCH_MP_TAC mp_th g;; let PURE_MP_REWR_TAC = GEN_PURE_MP_REWR_TAC I;; let GEN_MP_REWR_TAC s x = GEN_PURE_MP_REWR_TAC s x THEN TRY HINT_EXISTS_TAC THEN ASM_REWRITE_TAC[];; let MP_REWR_TAC = GEN_MP_REWR_TAC I;; let MP_REWRITE_TAC = MAP_EVERY MP_REWR_TAC;; let CASES_REWRITE_TAC th (_,c as g) = let PART_MATCH = let concl = snd o dest_imp in let body = snd o strip_forall o concl in try PART_MATCH (lhs o body) th with _ -> let f1 = PART_MATCH concl th and f2 = PART_MATCH body th in fun t -> try f1 t with _ -> f2 t in let th = ref TRUTH in ignore (find_term (fun t -> try th := PART_MATCH t; true with _ -> false) c); (ASM_CASES_TAC (lhand (concl !th)) THENL [ POP_ASSUM (fun x -> REWRITE_TAC[MP !th x] THEN ASSUME_TAC x); POP_ASSUM (ASSUME_TAC o REWRITE_RULE[NOT_CLAUSES])]) g;; let wrap f x = f [x];; let CONJS xs = end_itlist CONJ xs;; let rec simp_horn_conv = let fact (x,y) = if x = [] then y else fail () in let rec tl = function [] -> [] | _::xs -> xs in fun l -> let fixpoint = ref true in let l' = rev_itlist (fun (hs,cs) (dones,todos) -> let facts = flat (mapfilter fact (dones@todos)) in let f = filter (not o C mem facts) in let hs' = f hs in let cs' = filter (not o C mem hs') (f cs) in if not (hs' = hs) || not (cs' = cs) then fixpoint := false; if (cs' = [] && cs <> []) then (dones,tl todos) else ((hs',cs')::dones),tl todos) l ([],tl l) in if !fixpoint then l else simp_horn_conv (fst l');; let horns_of_term = let strip_conj = binops `(/\)` in fun t -> map (fun t -> try let h,c = dest_imp t in strip_conj h,strip_conj c with _ -> [],[t]) (strip_conj t);; let term_of_horns = let term_of_horn = function |[],cs -> list_mk_conj cs |_,[] -> `T` |hs,cs -> mk_imp (list_mk_conj hs,list_mk_conj cs) in list_mk_conj o map term_of_horn;; let SIMP_HORN_CONV t = TAUT (mk_eq (t,((term_of_horns o simp_horn_conv o horns_of_term) t)));; let SIMP_HORN_TAC = ASSUM_LIST (fun xs -> TRY (fun g -> (MP_TAC (CONJS xs) THEN REWRITE_TAC[IMP_IMP]) g) THEN CONV_TAC (TOP_DEPTH_CONV (CHANGED_CONV SIMP_HORN_CONV)) THEN REWRITE_TAC xs);; let rec fixpoint f x = let y = f x in if y = x then y else fixpoint f y;; let gimp_imp = let rec self vars premisses t = try let v,b = dest_forall t in self (v::vars) premisses b with _ -> try let p,c = dest_imp t in self vars (p::premisses) c with _ -> let body = match premisses with |[] -> t |_::_ -> mk_imp(list_mk_conj (rev premisses),t) in list_mk_forall(rev vars,body) in self [] [];; let GIMP_IMP_CONV t = MESON[](mk_eq(t,gimp_imp t));; let GIMP_IMP = CONV_RULE GIMP_IMP_CONV;; let MATCH_TRANS thm1 thm2 = GEN_ALL (DISCH_ALL (MATCH_MP thm2 (UNDISCH (SPEC_ALL thm1))));; let GCONV_TAC = CONV_TAC o DEPTH_CONV o CHANGED_CONV;; let LET_RULE thm = REWRITE_RULE[LET_DEF;LET_END_DEF] thm;; let LET_RULE_L l thm = REWRITE_RULE([LET_DEF;LET_END_DEF]@l) thm;; let SPEC_V (x,v) thm = (Pa.SPEC v o Pa.GEN x o SPEC_ALL) thm;; hol-light/Help/000077500000000000000000000000001303454263000136355ustar00rootroot00000000000000hol-light/Help/.joinparsers.doc000066400000000000000000000017211303454263000167420ustar00rootroot00000000000000\DOC ++ \TYPE {(++) : ('a -> 'b * 'c) -> ('c -> 'd * 'e) -> 'a -> ('b * 'd) * 'e} \SYNOPSIS Sequentially compose two parsers. \DESCRIBE If {p1} and {p2} are two parsers, {p1 ++ p2} is a new parser that parses as much of the input as possible using {p1} and then as much of what remains using {p2}, returning the pair of parse results and the unparsed input. \FAILURE Never fails. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, >>, |||, a, atleast, elistof, finished, fix, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/.orparser.doc000066400000000000000000000017511303454263000162430ustar00rootroot00000000000000\DOC ||| \TYPE {(|||) : ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b} \SYNOPSIS Produce alternative composition of two parsers. \DESCRIBE If {p1} and {p2} are two parsers, {p1 ||| p2} is a new parser that first tries to parse the input using {p1}, and if that fails with exception {Noparse}, tries {p2} instead. The output is whatever parse result was achieved together with the unparsed input. \FAILURE Never fails. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, >>, a, atleast, elistof, finished, fix, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/.pipeparser.doc000066400000000000000000000016401303454263000165550ustar00rootroot00000000000000\DOC >> \TYPE {(>>) : ('a -> 'b * 'c) -> ('b -> 'd) -> 'a -> 'd * 'c} \SYNOPSIS Apply function to parser result. \DESCRIBE If {p} is a parser and {f} a function from the parse result type, {p >> f} gives a new parser that `pipes the original parser output through f', i.e. applies {f} to the result of the parse. \FAILURE Never fails. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, a, atleast, elistof, finished, fix, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/.singlefun.doc000066400000000000000000000014141303454263000163740ustar00rootroot00000000000000\DOC |=> \TYPE {(|=>) : 'a -> 'b -> ('a, 'b) func} \SYNOPSIS Gives a one-point finite partial function. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The call {x |=> y} gives a finite partial function that maps {x} to {y} and is undefined for all arguments other than {x}. \EXAMPLE { # let f = (1 |=> 2);; val f : (int, int) func = # apply f 1;; val it : int = 2 # apply f 2;; Exception: Failure "apply". } \SEEALSO |->, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/.upto.doc000066400000000000000000000006311303454263000153710ustar00rootroot00000000000000\DOC -- \TYPE {(--) : int -> int -> int list} \SYNOPSIS Gives a finite list of integers between the given bounds. \DESCRIBE The call {m--n} returns the list of consecutive numbers from {m} to {n}. \EXAMPLE { # 1--10;; val it : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10] # 5--5;; val it : int list = [5] # (-1)--1;; val it : int list = [-1; 0; 1] # 2--1;; val it : int list = [] } \ENDDOC hol-light/Help/.valmod.doc000066400000000000000000000017041303454263000156660ustar00rootroot00000000000000\DOC |-> \TYPE {(|->) : 'a -> 'b -> ('a, 'b) func -> ('a, 'b) func} \SYNOPSIS Modify a finite partial function at one point. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} is a finite partial function then {(x |-> y) f} gives a modified version that maps {x} to {y} (whether or not {f} was defined on {x} before and regardless of the old value) but is otherwise the same. \FAILURE Never fails. \EXAMPLE { # let f = (1 |-> 2) undefined;; val f : (int, int) func = # let g = (1 |-> 3) f;; val g : (int, int) func = # apply f 1;; val it : int = 2 # apply g 1;; val it : int = 3 } \SEEALSO |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/ABBREV_TAC.doc000066400000000000000000000020431303454263000157530ustar00rootroot00000000000000\DOC ABBREV_TAC \TYPE {ABBREV_TAC : term -> (string * thm) list * term -> goalstate} \SYNOPSIS Tactic to introduce an abbreviation. \DESCRIBE The tactic {ABBREV_TAC `x = t`} abbreviates any instances of the term {t} in the goal (assumptions or conclusion) with {x}, and adds a new assumption {t = x}. (Reversed so that rules like {ASM_REWRITE_TAC} will not immediately expand it again.) The LHS may be of the form {f x} in which case abstraction will happen first. \FAILURE Fails unless the left-hand side is a variable or a variable applied to a list of variable arguments. \EXAMPLE { # g `(12345 + 12345) + f(12345 + 12345) = f(12345 + 12345)`;; Warning: Free variables in goal: f val it : goalstack = 1 subgoal (1 total) `(12345 + 12345) + f (12345 + 12345) = f (12345 + 12345)` # e(ABBREV_TAC `n = 12345 + 12345`);; val it : goalstack = 1 subgoal (1 total) 0 [`12345 + 12345 = n`] `n + f n = f n` } \USES Convenient for abbreviating large and unwieldy expressions as a sort of `local definition'. \SEEALSO EXPAND_TAC. \ENDDOC hol-light/Help/ABS.doc000066400000000000000000000010361303454263000147310ustar00rootroot00000000000000\DOC ABS \TYPE {ABS : term -> thm -> thm} \SYNOPSIS Abstracts both sides of an equation. \KEYWORDS rule, abstraction. \DESCRIBE { A |- t1 = t2 ------------------------ ABS `x` [Where x is not free in A] A |- (\x.t1) = (\x.t2) } \FAILURE If the theorem is not an equation, or if the variable {x} is free in the assumptions {A}. \EXAMPLE { # ABS `m:num` (REFL `m:num`);; val it : thm = |- (\m. m) = (\m. m) } \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO ETA_CONV. \ENDDOC hol-light/Help/ABS_CONV.doc000066400000000000000000000020161303454263000155550ustar00rootroot00000000000000\DOC ABS_CONV \TYPE {ABS_CONV : conv -> conv} \SYNOPSIS Applies a conversion to the body of an abstraction. \KEYWORDS conversional, abstraction. \DESCRIBE If {c} is a conversion that maps a term {`t`} to the theorem {|- t = t'}, then the conversion {ABS_CONV c} maps abstractions of the form {`\x. t`} to theorems of the form: { |- (\x. t) = (\x. t') } \noindent That is, {ABS_CONV c `\x. t`} applies {c} to the body of the abstraction {`\x. t`}. \FAILURE {ABS_CONV c tm} fails if {tm} is not an abstraction or if {tm} has the form {`\x. t`} but the conversion {c} fails when applied to the term {t}, or if the theorem returned has assumptions in which the abstracted variable {x} is free. The function returned by {ABS_CONV c} may also fail if the ML function {c:term->thm} is not, in fact, a conversion (i.e. a function that maps a term {t} to a theorem {|- t = t'}). \EXAMPLE { # ABS_CONV SYM_CONV `\x. 1 = x`;; val it : thm = |- (\x. 1 = x) = (\x. x = 1) } \SEEALSO GABS_CONV, RAND_CONV, RATOR_CONV, SUB_CONV. \ENDDOC hol-light/Help/ABS_TAC.doc000066400000000000000000000012601303454263000154170ustar00rootroot00000000000000\DOC ABS_TAC \TYPE {ABS_TAC : tactic} \SYNOPSIS Strips an abstraction from each side of an equational goal. \KEYWORDS tactic. \DESCRIBE {ABS_TAC} reduces a goal of the form {A ?- (\x. s[x]) = (\y. t[y])} by stripping away the abstractions to give a new goal {A ?- s[x'] = t[x']} where {x'} is a variant of {x}, the bound variable on the left-hand side, chosen not to be free in the current goal's assumptions or conclusion. { A ?- (\x. s[x]) = (\y. t[y]) ================================ ABS_TAC A ?- s[x'] = t[x'] } \FAILURE Fails unless the goal is equational, with both sides being abstractions. \SEEALSO AP_TERM_TAC, AP_THM_TAC, BINOP_TAC, MK_COMB_TAC. \ENDDOC hol-light/Help/AC.doc000066400000000000000000000036571303454263000146220ustar00rootroot00000000000000\DOC AC \TYPE {AC : thm -> term -> thm} \SYNOPSIS Proves equality of terms using associative, commutative, and optionally idempotence laws. \KEYWORDS conversion, associative, commutative. \DESCRIBE Suppose {_} is a function, which is assumed to be infix in the following syntax, and {acth} is a theorem expressing associativity and commutativity in the particular canonical form: { acth = |- m _ n = n _ m /\ (m _ n) _ p = m _ n _ p /\ m _ n _ p = n _ m _ p } \noindent Then {AC acth} will prove equations whose left and right sides can be made identical using these associative and commutative laws. If the input theorem also has idempotence property in this canonical form: { |- (p _ q = q _ p) /\ ((p _ q) _ r = p _ q _ r) /\ (p _ q _ r = q _ p _ r) /\ (p _ p = p) /\ (p _ p _ q = p _ q) } then idempotence will also be applied. \FAILURE Fails if the terms are not proved equivalent under the appropriate laws. This may happen because the input theorem does not have the correct canonical form. The latter problem will not in itself cause failure until it is applied to the term. \EXAMPLE { # AC ADD_AC `1 + 2 + 3 = 2 + 1 + 3`;; val it : thm = |- 1 + 2 + 3 = 2 + 1 + 3 # AC CONJ_ACI `p /\ (q /\ p) <=> (p /\ q) /\ (p /\ q)`;; val it : thm = |- p /\ q /\ p <=> (p /\ q) /\ p /\ q } \COMMENTS Note that pre-proved theorems in the correct canonical form for {AC} are already present for many standard operators, e.g. {ADD_AC}, {MULT_AC}, {INT_ADD_AC}, {INT_MUL_AC}, {REAL_ADD_AC}, {REAL_MUL_AC}, {CONJ_ACI}, {DISJ_ACI} and {INSERT_AC}. The underlying algorithm is not particularly delicate, and normalization under the associative/commutative/idempotent laws can be achieved by direct rewriting with the same canonical theorems. For some cases, specially optimized rules are available such as {CONJ_ACI_RULE} and {DISJ_ACI_RULE}. \SEEALSO ASSOC_CONV, CONJ_ACI_RULE, DISJ_ACI_RULE, SYM_CONV. \ENDDOC hol-light/Help/ACCEPT_TAC.doc000066400000000000000000000016171303454263000157570ustar00rootroot00000000000000\DOC ACCEPT_TAC \TYPE {ACCEPT_TAC : thm_tactic} \SYNOPSIS Solves a goal if supplied with the desired theorem (up to alpha-conversion). \KEYWORDS tactic. \DESCRIBE {ACCEPT_TAC} maps a given theorem {th} to a tactic that solves any goal whose conclusion is alpha-convertible to the conclusion of {th}. \FAILURE {ACCEPT_TAC th (A ?- g)} fails if the term {g} is not alpha-convertible to the conclusion of the supplied theorem {th}. \EXAMPLE The theorem {BOOL_CASES_AX = |- !t. (t <=> T) \/ (t <=> F)} can be used to solve the goal: { # g `!x. (x <=> T) \/ (x <=> F)`;; } \noindent by { # e(ACCEPT_TAC BOOL_CASES_AX);; val it : goalstack = No subgoals } \USES Used for completing proofs by supplying an existing theorem, such as an axiom, or a lemma already proved. Often this can simply be done by rewriting, but there are times when greater delicacy is wanted. \SEEALSO MATCH_ACCEPT_TAC. \ENDDOC hol-light/Help/ADD_ASSUM.doc000066400000000000000000000014011303454263000156600ustar00rootroot00000000000000\DOC ADD_ASSUM \TYPE {ADD_ASSUM : term -> thm -> thm} \SYNOPSIS Adds an assumption to a theorem. \KEYWORDS rule, assumption. \DESCRIBE When applied to a boolean term {s} and a theorem {A |- t}, the inference rule {ADD_ASSUM} returns the theorem {A u {{s}} |- t}. { A |- t -------------- ADD_ASSUM `s` A u {{s}} |- t } \noindent {ADD_ASSUM} performs straightforward set union with the new assumption; it checks for identical assumptions, but not for alpha-equivalent ones. The position at which the new assumption is inserted into the assumption list should not be relied on. \FAILURE Fails unless the given term has type {bool}. \EXAMPLE { # ADD_ASSUM `q:bool` (ASSUME `p:bool`);; val it : thm = p, q |- p } \SEEALSO ASSUME, UNDISCH. \ENDDOC hol-light/Help/ALL_CONV.doc000066400000000000000000000006101303454263000155560ustar00rootroot00000000000000\DOC ALL_CONV \TYPE {ALL_CONV : conv} \SYNOPSIS Conversion that always succeeds and leaves a term unchanged. \KEYWORDS conversion, identity. \DESCRIBE When applied to a term {`t`}, the conversion {ALL_CONV} returns the theorem {|- t = t}. It is just {REFL} explicitly regarded as a conversion. \FAILURE Never fails. \USES Identity element for {THENC}. \SEEALSO NO_CONV, REFL. \ENDDOC hol-light/Help/ALL_TAC.doc000066400000000000000000000021541303454263000154250ustar00rootroot00000000000000\DOC ALL_TAC \TYPE {ALL_TAC : tactic} \SYNOPSIS Passes on a goal unchanged. \KEYWORDS tactic, identity. \DESCRIBE {ALL_TAC} applied to a goal {g} simply produces the subgoal list {[g]}. It is the identity for the {THEN} tactical. \FAILURE Never fails. \EXAMPLE Suppose we want to solve the goal: { # g `~(n MOD 2 = 0) <=> n MOD 2 = 1`;; ... } We could just solve it with {e ARITH_TAC}, but suppose we want to introduce a little lemma that {n MOD 2 < 2}, proving that by {ARITH_TAC}. We could do { # e(SUBGOAL_THEN `n MOD 2 < 2` ASSUME_TAC THENL [ARITH_TAC; ...rest of proof...]);; } However if we split off many lemmas, we get a deeply nested proof structure that's a bit confusing. In cases where the proofs of the lemmas are trivial one-liners like this we might just want to keep the proof basically linear with { # e(SUBGOL_THEN `n MOD 2 < 2` ASSUME_TAC THENL [ARITH_TAC; ALL_TAC] THEN ...rest of proof...);; } \USES Keeping proof structures linear, as in the above example, or convenient algebraic combinations in complicated tactic structures. \SEEALSO NO_TAC, REPEAT, THENL. \ENDDOC hol-light/Help/ALL_THEN.doc000066400000000000000000000013131303454263000155500ustar00rootroot00000000000000\DOC ALL_THEN \TYPE {ALL_THEN : thm_tactical} \SYNOPSIS Passes a theorem unchanged to a theorem-tactic. \KEYWORDS theorem-tactic, identity. \DESCRIBE For any theorem-tactic {ttac} and theorem {th}, the application {ALL_THEN ttac th} results simply in {ttac th}, that is, the theorem is passed unchanged to the theorem-tactic. {ALL_THEN} is the identity theorem-tactical. \FAILURE The application of {ALL_THEN} to a theorem-tactic never fails. The resulting theorem-tactic fails under exactly the same conditions as the original one \USES Writing compound tactics or tacticals, e.g. terminating list iterations of theorem-tacticals. \SEEALSO ALL_TAC, FAIL_TAC, NO_TAC, NO_THEN, THEN_TCL, ORELSE_TCL. \ENDDOC hol-light/Help/ALPHA_CONV.doc000066400000000000000000000015531303454263000160020ustar00rootroot00000000000000\DOC ALPHA_CONV \TYPE {ALPHA_CONV : term -> term -> thm} \SYNOPSIS Renames the bound variable of a lambda-abstraction. \KEYWORDS conversion, alpha. \DESCRIBE If {`y`} is a variable of type {ty} and {`\x. t`} is an abstraction in which the bound variable {x} also has type {ty} and {y} does not occur free in {t}, then {ALPHA_CONV `y` `\x. t`} returns the theorem: { |- (\x. t) = (\y. t[y/x]) } \FAILURE Fails if the first argument is not a variable, the second is not an abstraction, if the types of the new variable and the bound variable in the abstraction differ, or if the new variable is already free in the body of the abstraction. \EXAMPLE { # ALPHA_CONV `y:num` `\x. x + 1`;; val it : thm = |- (\x. x + 1) = (\y. y + 1) # ALPHA_CONV `y:num` `\x. x + y`;; Exception: Failure "alpha: Invalid new variable". } \SEEALSO ALPHA, GEN_ALPHA_CONV. \ENDDOC hol-light/Help/ALPHA_UPPERCASE.doc000066400000000000000000000011551303454263000165620ustar00rootroot00000000000000\DOC ALPHA \TYPE {ALPHA : term -> term -> thm} \SYNOPSIS Proves equality of alpha-equivalent terms. \KEYWORDS rule, alpha. \DESCRIBE When applied to a pair of terms {t1} and {t1'} which are alpha-equivalent, {ALPHA} returns the theorem {|- t1 = t1'}. { ------------- ALPHA `t1` `t1'` |- t1 = t1' } \FAILURE Fails unless the terms provided are alpha-equivalent. \EXAMPLE { # ALPHA `!x:num. x = x` `!y:num. y = y`;; val it : thm = |- (!x. x = x) <=> (!y. y = y) # ALPHA `\w. w + z` `\z'. z' + z`;; val it : thm = |- (\w. w + z) = (\z'. z' + z) } \SEEALSO aconv, ALPHA_CONV, GEN_ALPHA_CONV. \ENDDOC hol-light/Help/ANTE_RES_THEN.doc000066400000000000000000000031701303454263000164030ustar00rootroot00000000000000\DOC ANTE_RES_THEN \TYPE {ANTE_RES_THEN : thm_tactical} \SYNOPSIS Resolves implicative assumptions with an antecedent. \KEYWORDS theorem-tactic, resolution. \DESCRIBE Given a theorem-tactic {ttac} and a theorem {A |- t}, the function {ANTE_RES_THEN} produces a tactic that attempts to match {t} to the antecedent of each implication { Ai |- !x1...xn. ui ==> vi } \noindent (where {Ai} is just {!x1...xn. ui ==> vi}) that occurs among the assumptions of a goal. If the antecedent {ui} of any implication matches {t}, then an instance of {Ai u A |- vi} is obtained by specialization of the variables {x1}, ..., {xn} and type instantiation, followed by an application of modus ponens. Because all implicative assumptions are tried, this may result in several modus-ponens consequences of the supplied theorem and the assumptions. Tactics are produced using {ttac} from all these theorems, and these tactics are applied in sequence to the goal. That is, { ANTE_RES_THEN ttac (A |- t) g } \noindent has the effect of: { MAP_EVERY ttac [A1 u A |- v1; ...; Am u A |- vm] g } \noindent where the theorems {Ai u A |- vi} are all the consequences that can be drawn by a (single) matching modus-ponens inference from the implications that occur among the assumptions of the goal {g} and the supplied theorem {A |- t}. \FAILURE {ANTE_RES_THEN ttac (A |- t)} fails when applied to a goal {g} if any of the tactics produced by {ttac (Ai u A |- vi)}, where {Ai u A |- vi} is the {i}th resolvent obtained from the theorem {A |- t} and the assumptions of {g}, fails when applied in sequence to {g}. \SEEALSO IMP_RES_THEN, MATCH_MP, MATCH_MP_TAC. \ENDDOC hol-light/Help/ANTS_TAC.doc000066400000000000000000000006121303454263000155570ustar00rootroot00000000000000\DOC ANTS_TAC \TYPE {ANTS_TAC : tactic} \SYNOPSIS Split off antecedent of antecedent of goal as a new subgoal. \DESCRIBE { A ?- (p ==> q) ==> r ======================= ANTS_TAC A ?- p A ?- q ==> r } \FAILURE Fails unless the goal is of the specified form. \USES Convenient for focusing on assumptions of an implicational theorem that one wants to use. \SEEALSO MP_TAC. \ENDDOC hol-light/Help/AP_TERM.doc000066400000000000000000000012411303454263000154510ustar00rootroot00000000000000\DOC AP_TERM \TYPE {AP_TERM : term -> thm -> thm} \SYNOPSIS Applies a function to both sides of an equational theorem. \KEYWORDS rule. \DESCRIBE When applied to a term {f} and a theorem {A |- x = y}, the inference rule {AP_TERM} returns the theorem {A |- f x = f y}. { A |- x = y ---------------- AP_TERM `f` A |- f x = f y } \FAILURE Fails unless the theorem is equational and the supplied term is a function whose domain type is the same as the type of both sides of the equation. \EXAMPLE { # NUM_ADD_CONV `2 + 2`;; val it : thm = |- 2 + 2 = 4 # AP_TERM `(+) 1` it;; val it : thm = |- 1 + 2 + 2 = 1 + 4 } \SEEALSO AP_THM, MK_COMB. \ENDDOC hol-light/Help/AP_TERM_TAC.doc000066400000000000000000000010371303454263000161430ustar00rootroot00000000000000\DOC AP_TERM_TAC \TYPE {AP_TERM_TAC : tactic} \SYNOPSIS Strips a function application from both sides of an equational goal. \KEYWORDS tactic. \DESCRIBE {AP_TERM_TAC} reduces a goal of the form {A ?- f x = f y} by stripping away the function applications, giving the new goal {A ?- x = y}. { A ?- f x = f y ================ AP_TERM_TAC A ?- x = y } \FAILURE Fails unless the goal is equational, with both sides being applications of the same function. \SEEALSO ABS_TAC, AP_TERM, AP_THM_TAC, BINOP_TAC, MK_COMB_TAC. \ENDDOC hol-light/Help/AP_THM.doc000066400000000000000000000013151303454263000153340ustar00rootroot00000000000000\DOC AP_THM \TYPE {AP_THM : thm -> term -> thm} \SYNOPSIS Proves equality of equal functions applied to a term. \KEYWORDS rule. \DESCRIBE When applied to a theorem {A |- f = g} and a term {x}, the inference rule {AP_THM} returns the theorem {A |- f x = g x}. { A |- f = g ---------------- AP_THM (A |- f = g) `x` A |- f x = g x } \FAILURE Fails unless the conclusion of the theorem is an equation, both sides of which are functions whose domain type is the same as that of the supplied term. \EXAMPLE { # REWRITE_RULE[GSYM FUN_EQ_THM] ADD1;; val it : thm = |- SUC = (\m. m + 1) # AP_THM it `11`;; val it : thm = |- SUC 11 = (\m. m + 1) 11 } \SEEALSO AP_TERM, ETA_CONV, MK_COMB. \ENDDOC hol-light/Help/AP_THM_TAC.doc000066400000000000000000000011031303454263000160160ustar00rootroot00000000000000\DOC AP_THM_TAC \TYPE {AP_THM_TAC : tactic} \SYNOPSIS Strips identical operands from functions on both sides of an equation. \KEYWORDS tactic. \DESCRIBE When applied to a goal of the form {A ?- f x = g x}, the tactic {AP_THM_TAC} strips away the operands of the function application: { A ?- f x = g x ================ AP_THM_TAC A ?- f = g } \FAILURE Fails unless the goal has the above form, namely an equation both sides of which consist of function applications to the same argument. \SEEALSO ABS_TAC, AP_TERM_TAC, AP_THM, BINOP_TAC, MK_COMB_TAC. \ENDDOC hol-light/Help/ARITH_RULE.doc000066400000000000000000000020531303454263000160220ustar00rootroot00000000000000\DOC ARITH_RULE \TYPE {ARITH_RULE : term -> thm} \SYNOPSIS Automatically proves natural number arithmetic theorems needing basic rearrangement and linear inequality reasoning only. \DESCRIBE The function {ARITH_RULE} can automatically prove natural number theorems using basic algebraic normalization and inequality reasoning. For nonlinear equational reasoning use {NUM_RING}. \FAILURE Fails if the term is not boolean or if it cannot be proved using the basic methods employed, e.g. requiring nonlinear inequality reasoning. \EXAMPLE { # ARITH_RULE `x = 1 ==> y <= 1 \/ x < y`;; val it : thm = |- x = 1 ==> y <= 1 \/ x < y # ARITH_RULE `x <= 127 ==> ((86 * x) DIV 256 = x DIV 3)`;; val it : thm = |- x <= 127 ==> (86 * x) DIV 256 = x DIV 3 # ARITH_RULE `2 * a * b EXP 2 <= b * a * b ==> (SUC c - SUC(a * b * b) <= c)`;; val it : thm = |- 2 * a * b EXP 2 <= b * a * b ==> SUC c - SUC (a * b * b) <= c } \USES Disposing of elementary arithmetic goals. \SEEALSO ARITH_TAC, INT_ARITH, NUM_RING, REAL_ARITH, REAL_FIELD, REAL_RING. \ENDDOC hol-light/Help/ARITH_TAC.doc000066400000000000000000000014471303454263000156700ustar00rootroot00000000000000\DOC ARITH_TAC \TYPE {ARITH_TAC : tactic} \SYNOPSIS Tactic for proving arithmetic goals needing basic rearrangement and linear inequality reasoning only. \DESCRIBE {ARITH_TAC} will automatically prove goals that require basic algebraic normalization and inequality reasoning over the natural numbers. For nonlinear equational reasoning use {NUM_RING} and derivatives. \FAILURE Fails if the automated methods do not suffice. \EXAMPLE { # g `1 <= x /\ x <= 3 ==> x = 1 \/ x = 2 \/ x = 3`;; Warning: Free variables in goal: x val it : goalstack = 1 subgoal (1 total) `1 <= x /\ x <= 3 ==> x = 1 \/ x = 2 \/ x = 3` # e ARITH_TAC;; val it : goalstack = No subgoals } \USES Solving basic arithmetic goals. \SEEALSO ARITH_RULE, ASM_ARITH_TAC, INT_ARITH_TAC, NUM_RING, REAL_ARITH_TAC. \ENDDOC hol-light/Help/ASM.doc000066400000000000000000000011141303454263000147410ustar00rootroot00000000000000\DOC ASM \TYPE {ASM : (thm list -> tactic) -> thm list -> tactic} \SYNOPSIS Augments a tactic's theorem list with the assumptions. \DESCRIBE If {tac} is a tactic that expects a list of theorems as its arguments, e.g. {MESON_TAC}, {REWRITE_TAC} or {SET_TAC}, then {ASM tac} converts it to a tactic where that list is augmented by the goal's assumptions. \FAILURE Never fails (though the resulting tactic may do). \EXAMPLE { The inbuilt {ASM_REWRITE_TAC} is in fact defined as just {ASM REWRITE_TAC}. } \SEEALSO ASSUM_LIST, FREEZE_THEN, HYP, MESON_TAC, REWRITE_TAC, SET_TAC. \ENDDOC hol-light/Help/ASM_ARITH_TAC.doc000066400000000000000000000025421303454263000163650ustar00rootroot00000000000000\DOC ASM_ARITH_TAC \TYPE {ASM_ARITH_TAC : tactic} \SYNOPSIS Tactic for proving arithmetic goals needing basic rearrangement and linear inequality reasoning only, using assumptions \DESCRIBE {ASM_ARITH_TAC} will automatically prove goals that require basic algebraic normalization and inequality reasoning over the natural numbers. For nonlinear equational reasoning use {NUM_RING} and derivatives. Unlike plain {ARITH_TAC}, {ASM_ARITH_TAC} uses any assumptions that are not universally quantified as additional hypotheses. \FAILURE Fails if the automated methods do not suffice. \EXAMPLE This example illustrates how {ASM_ARITH_TAC} uses assumptions while {ARITH_TAC} does not. Of course, this is for illustration only: plain {ARITH_TAC} would solve the entire goal before application of {STRIP_TAC}. { # g `1 <= 6 * x /\ 2 * x <= 3 ==> x = 1`;; Warning: Free variables in goal: x val it : goalstack = 1 subgoal (1 total) `1 <= 6 * x /\ 2 * x <= 3 ==> x = 1` # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`1 <= 6 * x`] 1 [`2 * x <= 3`] `x = 1` # e ARITH_TAC;; Exception: Failure "linear_ineqs: no contradiction". # e ASM_ARITH_TAC;; val it : goalstack = No subgoals } \USES Solving basic arithmetic goals. \SEEALSO ARITH_RULE, ARITH_TAC, INT_ARITH_TAC, NUM_RING, REAL_ARITH_TAC. \ENDDOC hol-light/Help/ASM_CASES_TAC.doc000066400000000000000000000020371303454263000163530ustar00rootroot00000000000000\DOC ASM_CASES_TAC \TYPE {ASM_CASES_TAC : term -> tactic} \SYNOPSIS Given a term, produces a case split based on whether or not that term is true. \KEYWORDS tactic, cases. \DESCRIBE Given a term {u}, {ASM_CASES_TAC} applied to a goal produces two subgoals, one with {u} as an assumption and one with {~u}: { A ?- t ================================ ASM_CASES_TAC `u` A u {{u}} ?- t A u {{~u}} ?- t } \FAILURE Fails if {u} does not have boolean type. \EXAMPLE The tactic {ASM_CASES_TAC `&0 <= u`} can be used to produce a case analysis on {`&0 <= u`}: { # g `&0 <= (u:real) pow 2`;; Warning: Free variables in goal: u val it : goalstack = 1 subgoal (1 total) `&0 <= u pow 2` # e(ASM_CASES_TAC `&0 <= u`);; val it : goalstack = 2 subgoals (2 total) 0 [`~(&0 <= u)`] `&0 <= u pow 2` 0 [`&0 <= u`] `&0 <= u pow 2` } \USES Performing a case analysis according to whether a given term is true or false. \SEEALSO BOOL_CASES_TAC, COND_CASES_TAC, ITAUT, DISJ_CASES_TAC, STRUCT_CASES_TAC, TAUT. \ENDDOC hol-light/Help/ASM_FOL_TAC.doc000066400000000000000000000016171303454263000161400ustar00rootroot00000000000000\DOC ASM_FOL_TAC \TYPE {ASM_FOL_TAC : (string * thm) list * term -> goalstate} \SYNOPSIS Fix up function arities for first-order proof search. \DESCRIBE This function attempts to make the assumptions of a goal more `first-order'. Functions that are not consistently used with the same arity, e.g. a function {f} that is sometimes applied {f(a)} and sometimes used as an argument to other functions, {g(f)}, will be identified. Applications of the function will then be modified by the introduction of the identity function {I} (which can be thought of later as binary `function application') so that {f(a)} becomes {I f a}. This gives a more natural formulation as a prelude to traditional first-order proof search. \FAILURE Never fails. \COMMENTS This function is not intended for general use, but is part of the initial normalization in {MESON} and {MESON_TAC}. \SEEALSO MESON, MESON_TAC. \ENDDOC hol-light/Help/ASM_INT_ARITH_TAC.doc000066400000000000000000000027201303454263000170750ustar00rootroot00000000000000\DOC ASM_INT_ARITH_TAC \TYPE {ASM_INT_ARITH_TAC : tactic} \SYNOPSIS Attempt to prove goal using basic algebra and linear arithmetic over the integers. \DESCRIBE The tactic {ASM_INT_ARITH_TAC} is the tactic form of {INT_ARITH}. Roughly speaking, it will automatically prove any formulas over the reals that are effectively universally quantified and can be proved valid by algebraic normalization and linear equational and inequality reasoning. See {REAL_ARITH} for more information about the algorithm used and its scope. Unlike plain {INT_ARITH_TAC}, {ASM_INT_ARITH_TAC} uses any assumptions that are not universally quantified as additional hypotheses. \FAILURE Fails if the goal is not in the subset solvable by these means, or is not valid. \EXAMPLE This example illustrates how {ASM_INT_ARITH_TAC} uses assumptions while {INT_ARITH_TAC} does not. Of course, this is for illustration only: plain {INT_ARITH_TAC} would solve the entire goal before application of {STRIP_TAC}. { # g `!x y:int. x <= y /\ &2 * y <= &2 * x + &1 ==> x = y`;; val it : goalstack = 1 subgoal (1 total) `!x y. x <= y /\ &2 * y <= &2 * x + &1 ==> x = y` # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`x <= y`] 1 [`&2 * y <= &2 * x + &1`] `x = y` # e INT_ARITH_TAC;; Exception: Failure "linear_ineqs: no contradiction". # e ASM_INT_ARITH_TAC;; val it : goalstack = No subgoals } \SEEALSO ARITH_TAC, INT_ARITH, INT_ARITH_TAC, REAL_ARITH_TAC. \ENDDOC hol-light/Help/ASM_MESON_TAC.doc000066400000000000000000000013061303454263000163740ustar00rootroot00000000000000\DOC ASM_MESON_TAC \TYPE {ASM_MESON_TAC : thm list -> tactic} \SYNOPSIS Automated first-order proof search tactic using assumptions of goal. \DESCRIBE A call to {ASM_MESON_TAC[theorems]} will attempt to establish the goal using pure first-order reasoning, taking {theorems} and the assumptions of the goal as the starting-point. It will usually either solve the goal completely or run for an infeasible length of time before terminating, but it may sometimes fail quickly. For more details, see {MESON} or {MESON_TAC}. \FAILURE Fails if the goal is unprovable within the search bounds, though not necessarily in a feasible amount of time. \SEEALSO ASM_METIS_TAC, GEN_MESON_TAC, MESON, MESON_TAC. \ENDDOC hol-light/Help/ASM_METIS_TAC.doc000066400000000000000000000012021303454263000163670ustar00rootroot00000000000000\DOC ASM_METIS_TAC \TYPE {ASM_METIS_TAC : thm list -> tactic} \SYNOPSIS Automated first-order proof search tactic using assumptions of goal. \DESCRIBE A call to {ASM_METIS_TAC[theorems]} will attempt to establish the goal using pure first-order reasoning, taking {theorems} and the assumptions of the goal as the starting-point. It will usually either solve the goal completely or run for an infeasible length of time before terminating, but it may sometimes fail quickly. For more details, see {METIS} or {METIS_TAC}. \FAILURE Fails if the goal is unprovable within the search bounds. \SEEALSO ASM_MESON_TAC, METIS, METIS_TAC. \ENDDOC hol-light/Help/ASM_REAL_ARITH_TAC.doc000066400000000000000000000034211303454263000171650ustar00rootroot00000000000000\DOC ASM_REAL_ARITH_TAC \TYPE {ASM_REAL_ARITH_TAC : tactic} \SYNOPSIS Attempt to prove goal using basic algebra and linear arithmetic over the reals. \DESCRIBE The tactic {ASM_REAL_ARITH_TAC} is the tactic form of {REAL_ARITH}. Roughly speaking, it will automatically prove any formulas over the reals that are effectively universally quantified and can be proved valid by algebraic normalization and linear equational and inequality reasoning. See {REAL_ARITH} for more information about the algorithm used and its scope. Unlike plain {REAL_ARITH_TAC}, {ASM_REAL_ARITH_TAC} uses any assumptions that are not universally quantified as additional hypotheses. \FAILURE Fails if the goal is not in the subset solvable by these means, or is not valid. \EXAMPLE This example illustrates how {ASM_REAL_ARITH_TAC} uses assumptions while {REAL_ARITH_TAC} does not. Of course, this is for illustration only: plain {REAL_ARITH_TAC} would solve the entire goal before application of {STRIP_TAC}. { # g `!x y z:real. abs(x) <= y ==> abs(x - z) <= abs(y + abs(z))`;; val it : goalstack = 1 subgoal (1 total) `!x y z. abs x <= y ==> abs (x - z) <= abs (y + abs z)` # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`abs x <= y`] `abs (x - z) <= abs (y + abs z)` # e REAL_ARITH_TAC;; Exception: Failure "linear_ineqs: no contradiction". # e ASM_REAL_ARITH_TAC;; val it : goalstack = No subgoals } \COMMENTS For nonlinear equational reasoning, use {CONV_TAC REAL_RING} or {CONV_TAC REAL_FIELD}. For nonlinear inequality reasoning, there are no powerful rules built into HOL Light, but the additional derived rules defined in {Examples/sos.ml} and {Rqe/make.ml} may be useful. \SEEALSO ARITH_TAC, INT_ARITH_TAC, REAL_ARITH, REAL_ARITH_TAC, REAL_FIELD, REAL_RING. \ENDDOC hol-light/Help/ASM_REWRITE_RULE.doc000066400000000000000000000017241303454263000170000ustar00rootroot00000000000000\DOC ASM_REWRITE_RULE \TYPE {ASM_REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem including built-in rewrites and the theorem's assumptions. \KEYWORDS rule. \DESCRIBE {ASM_REWRITE_RULE} rewrites with the tautologies in {basic_rewrites}, the given list of theorems, and the set of hypotheses of the theorem. All hypotheses are used. No ordering is specified among applicable rewrites. Matching subterms are searched for recursively, starting with the entire term of the conclusion and stopping when no rewritable expressions remain. For more details about the rewriting process, see {GEN_REWRITE_RULE}. To avoid using the set of basic tautologies, see {PURE_ASM_REWRITE_RULE}. \FAILURE {ASM_REWRITE_RULE} does not fail, but may result in divergence. To prevent divergence where it would occur, {ONCE_ASM_REWRITE_RULE} can be used. \SEEALSO GEN_REWRITE_RULE, ONCE_ASM_REWRITE_RULE, PURE_ASM_REWRITE_RULE, PURE_ONCE_ASM_REWRITE_RULE, REWRITE_RULE. \ENDDOC hol-light/Help/ASM_REWRITE_TAC.doc000066400000000000000000000032421303454263000166350ustar00rootroot00000000000000\DOC ASM_REWRITE_TAC \TYPE {ASM_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal including built-in rewrites and the goal's assumptions. \KEYWORDS tactic. \DESCRIBE {ASM_REWRITE_TAC} generates rewrites with the tautologies in {basic_rewrites}, the set of assumptions, and a list of theorems supplied by the user. These are applied top-down and recursively on the goal, until no more matches are found. The order in which the set of rewrite equations is applied is an implementation matter and the user should not depend on any ordering. Rewriting strategies are described in more detail under {GEN_REWRITE_TAC}. For omitting the common tautologies, see the tactic {PURE_ASM_REWRITE_TAC}. \FAILURE {ASM_REWRITE_TAC} does not fail, but it can diverge in certain situations. For rewriting to a limited depth, see {ONCE_ASM_REWRITE_TAC}. The resulting tactic may not be valid if the applicable replacement introduces new assumptions into the theorem eventually proved. \EXAMPLE The use of assumptions in rewriting, specially when they are not in an obvious equational form, is illustrated below: { # g `P ==> (P /\ Q /\ R <=> R /\ Q /\ P)`;; Warning: Free variables in goal: P, Q, R val it : goalstack = 1 subgoal (1 total) `P ==> (P /\ Q /\ R <=> R /\ Q /\ P)` # e DISCH_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`P`] `P /\ Q /\ R <=> R /\ Q /\ P` # e(ASM_REWRITE_TAC[]);; val it : goalstack = 1 subgoal (1 total) 0 [`P`] `Q /\ R <=> R /\ Q` } \SEEALSO basic_rewrites, GEN_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC hol-light/Help/ASM_SIMP_TAC.doc000066400000000000000000000013411303454263000162620ustar00rootroot00000000000000\DOC ASM_SIMP_TAC \TYPE {ASM_SIMP_TAC : thm list -> tactic} \SYNOPSIS Perform simplification of goal by conditional contextual rewriting using assumptions and built-in simplifications. \DESCRIBE A call to {ASM_SIMP_TAC[theorems]} will apply conditional contextual rewriting with {theorems} and the current assumptions of the goal to the goal's conclusion, as well as the default simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of rewriting, see {SIMP_CONV}. If the extra generality of contextual conditional rewriting is not needed, {REWRITE_TAC} is usually more efficient. \FAILURE Never fails, but may loop indefinitely. \SEEALSO ASM_REWRITE_TAC, SIMP_CONV, SIMP_TAC, REWRITE_TAC. \ENDDOC hol-light/Help/ASSOC_CONV.doc000066400000000000000000000021211303454263000160150ustar00rootroot00000000000000\DOC ASSOC_CONV \TYPE {ASSOC_CONV : thm -> term -> thm} \SYNOPSIS Right-associates a term with respect to an associative binary operator. \DESCRIBE The conversion {ASSOC_CONV} expects a theorem asserting that a certain binary operator is associative, in the standard form (with optional universal quantifiers): { x op (y op z) = (x op y) op z } It is then applied to a term, and will right-associate any toplevel combinations built up from the operator {op}. Note that if {op} is polymorphic, the type instance of the theorem needs to be the same as in the term to which it is applied. \FAILURE May fail if the theorem is malformed. On application to the term, it never fails, but returns a reflexive theorem when itis inapplicable. \EXAMPLE { # ASSOC_CONV ADD_ASSOC `((1 + 2) + 3) + (4 + 5) + (6 + 7)`;; val it : thm = |- ((1 + 2) + 3) + (4 + 5) + 6 + 7 = 1 + 2 + 3 + 4 + 5 + 6 + 7 # ASSOC_CONV CONJ_ASSOC `((p /\ q) /\ (r /\ s)) /\ t`;; val it : thm = |- ((p /\ q) /\ r /\ s) /\ t <=> p /\ q /\ r /\ s /\ t } \SEEALSO AC, CNF_CONV, CONJ_ACI_RULE, DISJ_ACI_RULE, DNF_CONV. \ENDDOC hol-light/Help/ASSUME.doc000066400000000000000000000007631303454263000153270ustar00rootroot00000000000000\DOC ASSUME \TYPE {ASSUME : term -> thm} \SYNOPSIS Introduces an assumption. \KEYWORDS rule, assumption. \DESCRIBE When applied to a term {t}, which must have type {bool}, the inference rule {ASSUME} returns the theorem {t |- t}. { -------- ASSUME `t` t |- t } \FAILURE Fails unless the term {t} has type {bool}. \EXAMPLE { # ASSUME `p /\ q`;; val it : thm = p /\ q |- p /\ q } \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO ADD_ASSUM, REFL. \ENDDOC hol-light/Help/ASSUME_TAC.doc000066400000000000000000000031201303454263000160040ustar00rootroot00000000000000\DOC ASSUME_TAC \TYPE {ASSUME_TAC : thm_tactic} \SYNOPSIS Adds an assumption to a goal. \KEYWORDS tactic, assumption. \DESCRIBE Given a theorem {th} of the form {A' |- u}, and a goal, {ASSUME_TAC th} adds {u} to the assumptions of the goal. { A ?- t ============== ASSUME_TAC (A' |- u) A u {{u}} ?- t } \noindent Note that unless {A'} is a subset of {A}, this tactic is invalid. The new assumption is unlabelled; for a named assumption use {LABEL_TAC}. \FAILURE Never fails. \EXAMPLE One can add an external theorem as an assumption if desired, for example so that {ASM_REWRITE_TAC[]} will automatically apply it. But usually the theorem is derived from some theorem-tactical, e.g. by discharging the antecedent of an implication or doing forward inference on another assumption. For example iff faced with the goal: { # g `0 = x ==> f(2 * x) = f(x * f(x))`;; } \noindent one might not want to just do {DISCH_TAC} or {STRIP_TAC} because the assumption will be {`0 = x`}. One can swap it first then put it on the assumptions by: { # e(DISCH_THEN(ASSUME_TAC o SYM));; val it : goalstack = 1 subgoal (1 total) 0 [`x = 0`] `f (2 * x) = f (x * f x)` } \noindent after which the goal can very easily be solved: { # e(ASM_REWRITE_TAC[MULT_CLAUSES]);; val it : goalstack = No subgoals } \USES Useful as a parameter to various theorem-tacticals such as {X_CHOOSE_THEN}, {DISCH_THEN} etc. when it is simply desired to add the theorem that has been deduced to the assumptions rather than used further at once. \SEEALSO ACCEPT_TAC, DESTRUCT_TAC, LABEL_TAC, STRIP_ASSUME_TAC. \ENDDOC hol-light/Help/ASSUM_LIST.doc000066400000000000000000000024341303454263000160520ustar00rootroot00000000000000\DOC ASSUM_LIST \TYPE {ASSUM_LIST : (thm list -> tactic) -> tactic} \SYNOPSIS Applies a tactic generated from the goal's assumption list. \KEYWORDS theorem-tactic, assumption. \DESCRIBE When applied to a function of type {thm list -> tactic} and a goal, {ASSUM_LIST} constructs a tactic by applying {f} to a list of {ASSUME}d assumptions of the goal, then applies that tactic to the goal. { ASSUM_LIST f ({{A1;...;An}} ?- t) = f [A1 |- A1; ... ; An |- An] ({{A1;...;An}} ?- t) } \FAILURE Fails if the function fails when applied to the list of {ASSUME}d assumptions, or if the resulting tactic fails when applied to the goal. \COMMENTS There is nothing magical about {ASSUM_LIST}: the same effect can usually be achieved just as conveniently by using {ASSUME a} wherever the assumption {a} is needed. If {ASSUM_LIST} is used, it is extremely unwise to use a function which selects elements from its argument list by number, since the ordering of assumptions should not be relied on. \EXAMPLE The tactic: { ASSUM_LIST(MP_TAC o end_itlist CONJ) } \noindent adds a conjunction of all assumptions as an antecedent of a goal. \USES Making more careful use of the assumption list than simply rewriting. \SEEALSO ASM_REWRITE_TAC, EVERY_ASSUM, POP_ASSUM, POP_ASSUM_LIST, REWRITE_TAC. \ENDDOC hol-light/Help/AUGMENT_SIMPSET.doc000066400000000000000000000012731303454263000166330ustar00rootroot00000000000000\DOC AUGMENT_SIMPSET \TYPE {AUGMENT_SIMPSET : thm -> simpset -> simpset} \SYNOPSIS Augment context of a simpset with a list of theorems. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset'. Given a list of theorems {thl} and a simpset {ss}, the call {AUGMENT_SIMPSET thl ss} augments the state of the simpset, adding the theorems as new rewrite rules and also making any provers in the simpset process the new context appropriately. \FAILURE Never fails unless some of the simpset functions are ill-formed. \USES Mostly for experts wishing to customize the simplifier. \SEEALSO augment, SIMP_CONV. \ENDDOC hol-light/Help/BETA.doc000066400000000000000000000021211303454263000150330ustar00rootroot00000000000000\DOC BETA \TYPE {BETA : term -> thm} \SYNOPSIS Special primitive case of beta-reduction. \DESCRIBE Given a term of the form {(\x. t[x]) x}, i.e. a lambda-term applied to exactly the same variable that occurs in the abstraction, {BETA} returns the theorem {|- (\x. t[x]) x = t[x]}. \FAILURE Fails if the term is not of the required form. \EXAMPLE { # BETA `(\n. n + 1) n`;; val it : thm = |- (\n. n + 1) n = n + 1 } \noindent Note that more general beta-reduction is not handled by {BETA}, but will be by {BETA_CONV}: { # BETA `(\n. n + 1) m`;; Exception: Failure "BETA: not a trivial beta-redex". # BETA_CONV `(\n. n + 1) m`;; val it : thm = |- (\n. n + 1) m = m + 1 } \USES This is more efficient than {BETA_CONV} in the special case in which it works, because no traversal and replacement of the body of the abstraction is needed. \COMMENTS This is one of HOL Light's 10 primitive inference rules. The more general case of beta-reduction, where a lambda-term is applied to any term, is implemented by {BETA_CONV}, derived in terms of this primitive. \SEEALSO BETA_CONV. \ENDDOC hol-light/Help/BETAS_CONV.doc000066400000000000000000000007361303454263000160150ustar00rootroot00000000000000\DOC BETAS_CONV \TYPE {BETAS_CONV : conv} \SYNOPSIS Beta conversion over multiple arguments. \DESCRIBE Given a term {t} of the form {`(\x1 ... xn. t[x1,...,xn]) s1 ... sn`}, the call {BETAS_CONV t} returns { |- (\x1 ... xn. t[x1,...,xn]) s1 ... sn = t[s1,...,sn] } \FAILURE Fails if the term is not of the form shown, for some {n}. \EXAMPLE { # BETAS_CONV `(\x y. x + y) 1 2`;; val it : thm = |- (\x y. x + y) 1 2 = 1 + 2 } \SEEALSO BETA_CONV, RIGHT_BETAS. \ENDDOC hol-light/Help/BETA_CONV.doc000066400000000000000000000020561303454263000156670ustar00rootroot00000000000000\DOC BETA_CONV \TYPE {BETA_CONV : term -> thm} \SYNOPSIS Performs a simple beta-conversion. \KEYWORDS conversion. \DESCRIBE The conversion {BETA_CONV} maps a beta-redex {`(\x.u)v`} to the theorem { |- (\x.u)v = u[v/x] } \noindent where {u[v/x]} denotes the result of substituting {v} for all free occurrences of {x} in {u}, after renaming sufficient bound variables to avoid variable capture. This conversion is one of the primitive inference rules of the HOL system. \FAILURE {BETA_CONV tm} fails if {tm} is not a beta-redex. \EXAMPLE { # BETA_CONV `(\x. x + 1) y`;; val it : thm = |- (\x. x + 1) y = y + 1 # BETA_CONV `(\x y. x + y) y`;; val it : thm = |- (\x y. x + y) y = (\y'. y + y') } \COMMENTS The HOL Light primitive rule {BETA} is the special case where the argument is the same as the bound variable. If you know that you are in this case, {BETA} is significantly more efficient. Though traditionally a primitive, {BETA_CONV} is actually a derived rule in HOL Light. \SEEALSO BETA, BETA_RULE, BETA_TAC, GEN_BETA_CONV, MATCH_CONV. \ENDDOC hol-light/Help/BETA_RULE.doc000066400000000000000000000015471303454263000156750ustar00rootroot00000000000000\DOC BETA_RULE \TYPE {BETA_RULE : thm -> thm} \SYNOPSIS Beta-reduces all the beta-redexes in the conclusion of a theorem. \KEYWORDS rule. \DESCRIBE When applied to a theorem {A |- t}, the inference rule {BETA_RULE} beta-reduces all beta-redexes, at any depth, in the conclusion {t}. Variables are renamed where necessary to avoid free variable capture. { A |- ....((\x. s1) s2).... ---------------------------- BETA_RULE A |- ....(s1[s2/x]).... } \FAILURE Never fails, but will have no effect if there are no beta-redexes. \EXAMPLE The following example is a simple reduction which illustrates variable renaming: { # let x = ASSUME `f = ((\x y. x + y) y)`;; val x : thm = f = (\x y. x + y) y |- f = (\x y. x + y) y # BETA_RULE x;; val it : thm = f = (\x y. x + y) y |- f = (\y'. y + y') } \SEEALSO BETA_CONV, BETA_TAC, GEN_BETA_CONV. \ENDDOC hol-light/Help/BETA_TAC.doc000066400000000000000000000015041303454263000155260ustar00rootroot00000000000000\DOC BETA_TAC \TYPE {BETA_TAC : tactic} \SYNOPSIS Beta-reduces all the beta-redexes in the conclusion of a goal. \KEYWORDS tactic. \DESCRIBE When applied to a goal {A ?- t}, the tactic {BETA_TAC} produces a new goal which results from beta-reducing all beta-redexes, at any depth, in {t}. Variables are renamed where necessary to avoid free variable capture. { A ?- ...((\x. s1) s2)... ========================== BETA_TAC A ?- ...(s1[s2/x])... } \FAILURE Never fails, but will have no effect if there are no beta-redexes. \COMMENTS Beta-reduction, and indeed, generalized beta reduction ({GEN_BETA_CONV}) are already among the basic rewrites, so happen anyway simply on {REWRITE_TAC[]}. But occasionally it is convenient to be able to invoke them separately. \SEEALSO BETA_CONV, BETA_RULE, GEN_BETA_CONV. \ENDDOC hol-light/Help/BINDER_CONV.doc000066400000000000000000000015271303454263000161210ustar00rootroot00000000000000\DOC BINDER_CONV \TYPE {BINDER_CONV : conv -> term -> thm} \SYNOPSIS Applies conversion to the body of a binder. \DESCRIBE If {c} is a conversion such that {c `t`} returns {|- t = t'}, then {BINDER_CONV c `b (\x. t)`} returns {|- b (\x. t) = b (\x. t')}, i.e. applies the core conversion to the body of a `binder'. In fact, {b} here can be any term, but it is typically a binder constant such as a quantifier. \FAILURE Fails if the core conversion does, or if the theorem returned by it is not of the right form. \EXAMPLE { # BINDER_CONV SYM_CONV `@n. n = m + 1`;; val it : thm = |- (@n. n = m + 1) = (@n. m + 1 = n) # BINDER_CONV (REWR_CONV SWAP_FORALL_THM) `!x y z. x + y + z = y + x + z`;; val it : thm = |- (!x y z. x + y + z = y + x + z) <=> (!x z y. x + y + z = y + x + z) } \SEEALSO ABS_CONV, RAND_CONV, RATOR_CONV. \ENDDOC hol-light/Help/BINOP_CONV.doc000066400000000000000000000013641303454263000160240ustar00rootroot00000000000000\DOC BINOP_CONV \TYPE {BINOP_CONV : (term -> thm) -> term -> thm} \SYNOPSIS Applies a conversion to both arguments of a binary operator. \DESCRIBE If {c} is a conversion where {c `l`} returns {|- l = l'} and {c `r`} returns {|- r = r'}, then {BINOP_CONV `op l r`} returns {|- op l r = op l' r'}. The term {op} is arbitrary, but is often a constant such as addition or conjunction. \FAILURE Never fails when applied to the conversion. But may fail when applied to the term if one of the core conversions fails or returns an inappropriate theorem on the subterms. \EXAMPLE { # BINOP_CONV NUM_ADD_CONV `(1 + 1) * (2 + 2)`;; val it : thm = |- (1 + 1) * (2 + 2) = 2 * 4 } \SEEALSO ABS_CONV, COMB_CONV, COMB2_CONV, RAND_CONV, RATOR_CONV. \ENDDOC hol-light/Help/BINOP_TAC.doc000066400000000000000000000022501303454263000156610ustar00rootroot00000000000000\DOC BINOP_TAC \TYPE {BINOP_TAC : tactic} \SYNOPSIS Breaks apart equation between binary operator applications into equality between their arguments. \DESCRIBE Given a goal whose conclusion is an equation between applications of the same curried binary function {f}, the tactic {BINOP_TAC} breaks it down to two subgoals expressing equality of the corresponding arguments: { A ?- f x1 y1 = f x2 y2 ================================ BINOP_TAC A ?- x1 = x2 A ?- y1 = y2 } \FAILURE Fails if the conclusion of the goal is not an equation between applications of the same curried binary operator. \EXAMPLE We can set up the following goal which is an equation between applications of the binary operator {+}: { # g `f(2 * x + 1) + w * z = f(SUC(x + 1) * 2 - 1) + z * w`;; } \noindent and it is simplest to prove if we split it up into two subgoals: { # e BINOP_TAC;; val it : goalstack = 2 subgoals (2 total) `w * z = z * w` `f (2 * x + 1) = f (SUC (x + 1) * 2 - 1)` } \noindent the first of which can be solved by {ARITH_TAC}, and the second by {AP_TERM_TAC THEN ARITH_TAC}. \SEEALSO ABS_TAC, AP_TERM_TAC, AP_THM_TAC, MK_BINOP, MK_COMB_TAC. \ENDDOC hol-light/Help/BOOL_CASES_TAC.doc000066400000000000000000000026561303454263000164750ustar00rootroot00000000000000\DOC BOOL_CASES_TAC \TYPE {BOOL_CASES_TAC : term -> tactic} \SYNOPSIS Performs boolean case analysis on a (free) term in the goal. \KEYWORDS tactic, cases. \DESCRIBE When applied to a term {x} (which must be of type {bool} but need not be simply a variable), and a goal {A ?- t}, the tactic {BOOL_CASES_TAC} generates the two subgoals corresponding to {A ?- t} but with any free instances of {x} replaced by {F} and {T} respectively. { A ?- t ============================ BOOL_CASES_TAC `x` A ?- t[F/x] A ?- t[T/x] } \noindent The term given does not have to be free in the goal, but if it isn't, {BOOL_CASES_TAC} will merely duplicate the original goal twice. Note that in the new goals, we don't have {x} and {~x} as assumptions; for that use {ASM_CASES_TAC}. \FAILURE Fails unless the term {x} has type {bool}. \EXAMPLE The goal: { # g `(b ==> ~b) ==> (b ==> a)`;; } \noindent can be completely solved by using {BOOL_CASES_TAC} on the variable {b}, then simply rewriting the two subgoals using only the inbuilt tautologies, i.e. by applying the following tactic: { # e(BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; val it : goalstack = No subgoals } \USES Avoiding fiddly logical proofs by brute-force case analysis, possibly only over a key term as in the above example, possibly over all free boolean variables. \SEEALSO ASM_CASES_TAC, COND_CASES_TAC, DISJ_CASES_TAC, ITAUT, STRUCT_CASES_TAC, TAUT. \ENDDOC hol-light/Help/C.doc000066400000000000000000000003411303454263000145040ustar00rootroot00000000000000\DOC C \TYPE {C : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c} \SYNOPSIS Permutes first two arguments to curried function: {C f x y} = {f y x}. \KEYWORDS combinator, permute. \FAILURE Never fails. \SEEALSO F_F, I, K, W. \ENDDOC hol-light/Help/CACHE_CONV.doc000066400000000000000000000022021303454263000157500ustar00rootroot00000000000000\DOC CACHE_CONV \TYPE {CACHE_CONV : (term -> thm) -> term -> thm} \SYNOPSIS Accelerates a conversion by cacheing previous results. \DESCRIBE If {cnv} is any conversion, then {CACHE_CONV cnv} gives a new conversion that is functionally identical but keeps a cache of previous arguments and results, and simply returns the cached result if the same input is encountered again. \FAILURE Never fails, though the subsequent application to a term may. \EXAMPLE The following call takes a while, making several applications to the same expression: { # time (DEPTH_CONV NUM_RED_CONV) `31 EXP 31 + 31 EXP 31 + 31 EXP 31`;; CPU time (user): 1.542 val it : thm = |- 31 EXP 31 + 31 EXP 31 + 31 EXP 31 = 51207522392169707875831929087177944268134203293 } \noindent whereas the cached variant is faster since the result for {31 EXP 31} is stored away and re-used after the first call: { # time (DEPTH_CONV(CACHE_CONV NUM_RED_CONV)) `31 EXP 31 + 31 EXP 31 + 31 EXP 31`;; CPU time (user): 0.461 val it : thm = |- 31 EXP 31 + 31 EXP 31 + 31 EXP 31 = 51207522392169707875831929087177944268134203293 } \SEEALSO \ENDDOC hol-light/Help/CASE_REWRITE_TAC.doc000066400000000000000000000026111303454263000167270ustar00rootroot00000000000000\DOC CASE_REWRITE_TAC \TYPE {CASE_REWRITE_TAC : thm -> tactic} \SYNOPSIS Performs casewise rewriting. \DESCRIBE Same usage as {IMP_REWRITE_TAC} but applies case rewriting instead of implicational rewriting, i.e. given a theorem of the form {!x_1... x_n. P ==> !y_1... y_m. l = r} and a goal with an atom {A} containing a subterm matching {l}, turns the atom into {(P' ==> A') /\ (~P' ==> A)} where {A'} is the atom in which the matching subterm of {l} is rewritten, and where {P'} is the instantiation of {P} so that the rewrite is valid. Note that this tactic takes only one theorem since in practice there is seldom a need to apply it subsequently with several theorems. \FAILURE Fails if no subterm matching {l} occurs in the goal. \EXAMPLE { # g ‘!a b c. a < b ==> (a - b) / (a - b) * c = c‘;; val it : goalstack = 1 subgoal (1 total) ‘!a b c. a < b ==> (a - b) / (a - b) * c = c‘ # e(CASE_REWRITE_TAC REAL_DIV_REFL);; val it : goalstack = 1 subgoal (1 total) ‘!a b c. a < b ==> (~(a - b = &0) ==> &1 * c = c) /\ (a - b = &0 ==> (a - b) / (a - b) * c = c)‘ } \USES Similar to {IMP_REWRITE_TAC}, but instead of assuming that a precondition holds, one just wants to make a distinction between the case where this precondition holds, and the one where it does not. \SEEALSO IMP_REWRITE_TAC, REWRITE_TAC, SIMP_TAC, SEQ_IMP_REWRITE_TAC, TARGET_REWRITE_TAC. \ENDDOC hol-light/Help/CCONTR.doc000066400000000000000000000012441303454263000153150ustar00rootroot00000000000000\DOC CCONTR \TYPE {CCONTR : term -> thm -> thm} \SYNOPSIS Implements the classical contradiction rule. \KEYWORDS rule, contradiction. \DESCRIBE When applied to a term {t} and a theorem {A |- F}, the inference rule {CCONTR} returns the theorem {A - {{~t}} |- t}. { A |- F --------------- CCONTR `t` A - {{~t}} |- t } \FAILURE Fails unless the term has type {bool} and the theorem has {F} as its conclusion. \COMMENTS The usual use will be when {~t} exists in the assumption list; in this case, {CCONTR} corresponds to the classical contradiction rule: if {~t} leads to a contradiction, then {t} must be true. \SEEALSO CONTR, CONTR_TAC, NOT_ELIM. \ENDDOC hol-light/Help/CHANGED_CONV.doc000066400000000000000000000024201303454263000162000ustar00rootroot00000000000000\DOC CHANGED_CONV \TYPE {CHANGED_CONV : conv -> conv} \SYNOPSIS Makes a conversion fail if applying it leaves a term unchanged. \KEYWORDS conversional. \DESCRIBE For a conversion {cnv}, the construct {CHANGED_CONV c} gives a new conversion that has the same action as {cnv}, except that it will fail on terms {t} such that {cnv t} returns a reflexive theorem {|- t = t}, or more precisely {|- t = t'} where {t} and {t'} are alpha-equivalent. \FAILURE Never fails when applied to the conversion, but fails on further application to a term if the original conversion does or it returns a reflexive theorem. \EXAMPLE { # ONCE_DEPTH_CONV num_CONV `x + 0`;; val it : thm = |- x + 0 = x + 0 # CHANGED_CONV(ONCE_DEPTH_CONV num_CONV) `x + 0`;; Exception: Failure "CHANGED_CONV". # CHANGED_CONV(ONCE_DEPTH_CONV num_CONV) `6`;; val it : thm = |- 6 = SUC 5 # REPEATC(CHANGED_CONV(ONCE_DEPTH_CONV num_CONV)) `6`;; val it : thm = |- 6 = SUC (SUC (SUC (SUC (SUC (SUC 0))))) } \USES {CHANGED_CONV} is used to transform a conversion that may leave terms unchanged, and therefore may cause a nonterminating computation if repeated, into one that can safely be repeated until application of it fails to substantially modify its input term, as in the last example above. \ENDDOC hol-light/Help/CHANGED_TAC.doc000066400000000000000000000011511303454263000160420ustar00rootroot00000000000000\DOC CHANGED_TAC \TYPE {CHANGED_TAC : tactic -> tactic} \SYNOPSIS Makes a tactic fail if it has no effect. \KEYWORDS tactical. \DESCRIBE When applied to a tactic {t}, the tactical {CHANGED_TAC} gives a new tactic which is the same as {t} if that has any effect, and otherwise fails. \FAILURE The application of {CHANGED_TAC} to a tactic never fails. The resulting tactic fails if the basic tactic either fails or has no effect. \USES Occasionally useful in controlling complicated tactic compositions. Also sometimes convenient just to check that a step did indeed modify a goal. \SEEALSO TRY, VALID. \ENDDOC hol-light/Help/CHAR_EQ_CONV.doc000066400000000000000000000021701303454263000162530ustar00rootroot00000000000000\DOC CHAR_EQ_CONV \TYPE {CHAR_EQ_CONV : term -> thm} \SYNOPSIS Proves equality or inequality of two HOL character literals. \DESCRIBE If {s} and {t} are two character literal terms in the HOL logic, {CHAR_EQ_CONV `s = t`} returns: { |- s = t <=> T or |- s = t <=> F } \noindent depending on whether the character literals are equal or not equal, respectively. \FAILURE {CHAR_EQ_CONV tm} fails f {tm} is not of the specified form, an equation between character literals. \EXAMPLE { # let t = mk_eq(mk_char 'A',mk_char 'A');; val t : term = `ASCII F T F F F F F T = ASCII F T F F F F F T` # CHAR_EQ_CONV t;; val it : thm = |- ASCII F T F F F F F T = ASCII F T F F F F F T <=> T } \USES Performing basic equality reasoning while producing a proof about characters. \COMMENTS There is no particularly convenient parser/printer support for the HOL {char} type, but when combined into lists they are considered as strings and provided with more intuitive parser/printer support. There is a corresponding proof rule {STRING_EQ_CONV} for strings. \SEEALSO dest_char, mk_char, NUM_EQ_CONV, STRING_EQ_CONV. \ENDDOC hol-light/Help/CHEAT_TAC.doc000066400000000000000000000010621303454263000156360ustar00rootroot00000000000000\DOC CHEAT_TAC \TYPE {CHEAT_TAC : tactic} \SYNOPSIS Proves goal by asserting it as an axiom. \DESCRIBE Given any goal {A ?- p}, the tactic {CHEAT_TAC} solves it by using {mk_thm}, which in turn involves essentially asserting the goal as a new axiom. \FAILURE Never fails. \USES Temporarily plugging boring parts of a proof to deal with the interesting parts. \COMMENTS Needless to say, this should be used with caution since once new axioms are asserted there is no guarantee that logical consistency is preserved. \SEEALSO new_axiom, mk_thm. \ENDDOC hol-light/Help/CHOOSE_TAC.doc000066400000000000000000000022001303454263000157650ustar00rootroot00000000000000\DOC CHOOSE_TAC \TYPE {CHOOSE_TAC : thm_tactic} \SYNOPSIS Adds the body of an existentially quantified theorem to the assumptions of a goal. \KEYWORDS tactic, existential. \DESCRIBE When applied to a theorem {A' |- ?x. t} and a goal, {CHOOSE_TAC} adds {t[x'/x]} to the assumptions of the goal, where {x'} is a variant of {x} which is not free in the assumption list; normally {x'} is just {x}. { A ?- u ==================== CHOOSE_TAC (A' |- ?x. t) A u {{t[x'/x]}} ?- u } \noindent Unless {A'} is a subset of {A}, this is not a valid tactic. \FAILURE Fails unless the given theorem is existentially quantified. \EXAMPLE Suppose we have a goal asserting that the output of an electrical circuit (represented as a boolean-valued function) will become high at some time: { ?- ?t. output(t) } \noindent and we have the following theorems available: { t1 = |- ?t. input(t) t2 = !t. input(t) ==> output(t+1) } \noindent Then the goal can be solved by the application of: { CHOOSE_TAC t1 THEN EXISTS_TAC `t+1` THEN UNDISCH_TAC `input (t:num) :bool` THEN MATCH_ACCEPT_TAC t2 } \SEEALSO CHOOSE_THEN, X_CHOOSE_TAC. \ENDDOC hol-light/Help/CHOOSE_THEN.doc000066400000000000000000000027671303454263000161360ustar00rootroot00000000000000\DOC CHOOSE_THEN \TYPE {CHOOSE_THEN : thm_tactical} \SYNOPSIS Applies a tactic generated from the body of existentially quantified theorem. \KEYWORDS theorem-tactic, existential. \DESCRIBE When applied to a theorem-tactic {ttac}, an existentially quantified theorem {A' |- ?x. t}, and a goal, {CHOOSE_THEN} applies the tactic {ttac (t[x'/x] |- t[x'/x])} to the goal, where {x'} is a variant of {x} chosen not to be free in the assumption list of the goal. Thus if: { A ?- s1 ========= ttac (t[x'/x] |- t[x'/x]) B ?- s2 } \noindent then { A ?- s1 ========== CHOOSE_THEN ttac (A' |- ?x. t) B ?- s2 } \noindent This is invalid unless {A'} is a subset of {A}. \FAILURE Fails unless the given theorem is existentially quantified, or if the resulting tactic fails when applied to the goal. \EXAMPLE This theorem-tactical and its relatives are very useful for using existentially quantified theorems. For example one might use the inbuilt theorem { LT_EXISTS = |- !m n. m < n <=> (?d. n = m + SUC d) } \noindent to help solve the goal { # g `x < y ==> 0 < y * y`;; } \noindent by starting with the following tactic { # e(DISCH_THEN(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LT_EXISTS]));; } \noindent reducing the goal to { val it : goalstack = 1 subgoal (1 total) `0 < (x + SUC d) * (x + SUC d)` } \noindent which can then be finished off quite easily, by, for example just {ARITH_TAC}, or { # e(REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; LT_0]);; } \SEEALSO CHOOSE_TAC, X_CHOOSE_THEN. \ENDDOC hol-light/Help/CHOOSE_UPPERCASE.doc000066400000000000000000000017461303454263000167230ustar00rootroot00000000000000\DOC CHOOSE \TYPE {CHOOSE : term * thm -> thm -> thm} \SYNOPSIS Eliminates existential quantification using deduction from a particular witness. \KEYWORDS rule, existential. \DESCRIBE When applied to a term-theorem pair {(v,A1 |- ?x. s)} and a second theorem of the form {A2 |- t}, the inference rule {CHOOSE} produces the theorem {A1 u (A2 - {{s[v/x]}}) |- t}. { A1 |- ?x. s[x] A2 |- t ------------------------------- CHOOSE (`v`,(A1 |- ?x. s)) A1 u (A2 - {{s[v/x]}}) |- t } \noindent Where {v} is not free in {A2 - {{s[v/x]}}}, {s} or {t}. \FAILURE Fails unless the terms and theorems correspond as indicated above; in particular, {v} must be a variable and have the same type as the variable existentially quantified over, and it must not be free in {A2 - {{s[v/x]}}}, {s} or {t}. \COMMENTS For the special case of simply existentially quantifying an assumption over a variable, {SIMPLE_CHOOSE} is easier. \SEEALSO CHOOSE_TAC, EXISTS, EXISTS_TAC, SIMPLE_CHOOSE. \ENDDOC hol-light/Help/CLAIM_TAC.doc000066400000000000000000000025441303454263000156450ustar00rootroot00000000000000\DOC CLAIM_TAC \TYPE {CLAIM_TAC : string -> term -> tactic} \SYNOPSIS Breaks down and labels an intermediate claim in a proof. \DESCRIBE Given a Boolean term {t} and a string {s} of the form expected by {DESTRUCT_TAC} indicating how to break down and label that assertion, {CLAIM_TAC s t} breaks the current goal into two or more subgoals. One of these is to establish {t} using the current context and the others are to establish the original goal with the broken-down form of {t} as additional assumptions. \FAILURE Fails if the term is not Boolean or the pattern is ill-formed or does not match the form of the theorem. \EXAMPLE Here we show how we can attack a propositional goal (admittedly trivial with {TAUT}). { # g `(p <=> q) ==> p \/ ~q`;; val it : goalstack = 1 subgoal (1 total) `(p <=> q) ==> p \/ ~q` # e DISCH_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`p <=> q`] `p \/ ~q` } We establish the intermediate goal {p /\ q \/ ~p /\ ~q}, the disjunction being in turn broken down into two labelled hypotheses {yes} and {no}: { # e(CLAIM_TAC "yes|no" `p /\ q \/ ~p /\ ~q`);; val it : goalstack = 3 subgoals (3 total) 0 [`p <=> q`] 1 [`~p /\ ~q`] (no) `p \/ ~q` 0 [`p <=> q`] 1 [`p /\ q`] (yes) `p \/ ~q` 0 [`p <=> q`] `p /\ q \/ ~p /\ ~q` } \SEEALSO DESTRUCT_TAC, SUBGOAL_TAC, SUBGOAL_THEN. \ENDDOC hol-light/Help/CNF_CONV.doc000066400000000000000000000017121303454263000155600ustar00rootroot00000000000000\DOC CNF_CONV \TYPE {CNF_CONV : conv} \SYNOPSIS Converts a term already in negation normal form into conjunctive normal form. \DESCRIBE When applied to a term already in negation normal form (see {NNF_CONV}), meaning that all other propositional connectives have been eliminated in favour of conjunction, disjunction and negation, and negation is only applied to atomic formulas, {CNF_CONV} puts the term into an equivalent conjunctive normal form, which is a right-associated conjunction of disjunctions without repetitions. No reduction by subsumption is performed, however, e.g. from {a /\ (a \/ b)} to just {a}). \FAILURE Never fails; non-Boolean terms will just yield a reflexive theorem. \EXAMPLE { # CNF_CONV `(a /\ b) \/ (a /\ b /\ c) \/ d`;; val it : thm = |- a /\ b \/ a /\ b /\ c \/ d <=> (a \/ d) /\ (a \/ b \/ d) /\ (a \/ c \/ d) /\ (b \/ d) /\ (b \/ c \/ d) } \SEEALSO DNF_CONV, NNF_CONV, WEAK_CNF_CONV, WEAK_DNF_CONV. \ENDDOC hol-light/Help/COMB2_CONV.doc000066400000000000000000000012551303454263000157560ustar00rootroot00000000000000\DOC COMB2_CONV \TYPE {COMB2_CONV : (term -> thm) -> (term -> thm) -> term -> thm} \SYNOPSIS Applies two conversions to the two sides of an application. \DESCRIBE If {c1} and {c2} are conversions such that {c1 `f`} returns {|- f = f'} and {c2 `x`} returns {|- x = x'}, then {COMB2_CONV c1 c2 `f x`} returns {|- f x = f' x'}. That is, the conversions {c1} and {c2} are applied respectively to the two immediate subterms. \FAILURE Never fails when applied to the initial conversions. On application to the term, it fails if either {c1} or {c2} does, or if either returns a theorem that is of the wrong form. \SEEALSO BINOP_CONV, COMB_CONV, LAND_CONV, RAND_CONV, RATOR_CONV \ENDDOC hol-light/Help/COMB_CONV.doc000066400000000000000000000011441303454263000156710ustar00rootroot00000000000000\DOC COMB_CONV \TYPE {COMB_CONV : conv -> conv} \SYNOPSIS Applies a conversion to the two sides of an application. \DESCRIBE If {c} is a conversion such that {c `f`} returns {|- f = f'} and {c `x`} returns {|- x = x'}, then {COMB_CONV c `f x`} returns {|- f x = f' x'}. That is, the conversion {c} is applied to the two immediate subterms. \FAILURE Never fails when applied to the initial conversion. On application to the term, it fails if conversion given as the argument does, or if the theorem returned by it is inappropriate. \SEEALSO BINOP_CONV, COMB2_CONV, LAND_CONV, RAND_CONV, RATOR_CONV \ENDDOC hol-light/Help/CONDS_CELIM_CONV.doc000066400000000000000000000030561303454263000167340ustar00rootroot00000000000000\DOC CONDS_CELIM_CONV \TYPE {CONDS_CELIM_CONV : conv} \SYNOPSIS Remove all conditional expressions from a Boolean formula. \DESCRIBE When applied to a Boolean term, {CONDS_CELIM_CONV} identifies subterms that are conditional expressions of the form `{if p then x else y}', and eliminates them. First they are ``pulled out'' as far as possible, e.g. from `{f (if p then x else y)}' to `{if p then f(x) else f(y)}' and so on. When a quantifier that binds one of the variables in the expression is reached, the subterm is of Boolean type, say `{if p then q else r}', and it is replaced by a propositional equivalent of the form `{(~p \/ q) /\ (p \/ r)}'. \FAILURE Never fails, but will just return a reflexive theorem if the term is not Boolean. \EXAMPLE { # CONDS_CELIM_CONV `y <= z ==> !x. (if x <= y then y else x) <= z`;; val it : thm = |- y <= z ==> (!x. (if x <= y then y else x) <= z) <=> y <= z ==> (!x. (~(x <= y) \/ y <= z) /\ (x <= y \/ x <= z)) } \USES Mostly for initial normalization in automated rules, but may be helpful for other uses. \COMMENTS The function {CONDS_ELIM_CONV} is functionally similar, but will do the final propositional splitting in a ``disjunctive'' rather than ``conjunctive'' way. The disjunctive way is usually better when the term will subsequently be passed to a refutation procedure, whereas the conjunctive form is better for non-refutation procedures. In each case, the policy is changed in an appropriate way after passing through quantifiers. \SEEALSO COND_CASES_TAC, COND_ELIM_CONV, CONDS_ELIM_CONV. \ENDDOC hol-light/Help/CONDS_ELIM_CONV.doc000066400000000000000000000032451303454263000166310ustar00rootroot00000000000000\DOC CONDS_ELIM_CONV \TYPE {CONDS_ELIM_CONV : conv} \SYNOPSIS Remove all conditional expressions from a Boolean formula. \DESCRIBE When applied to a Boolean term, {CONDS_ELIM_CONV} identifies subterms that are conditional expressions of the form `{if p then x else y}', and eliminates them. First they are ``pulled out'' as far as possible, e.g. from `{f (if p then x else y)}' to `{if p then f(x) else f(y)}' and so on. When a quantifier that binds one of the variables in the expression is reached, the subterm is of Boolean type, say `{if p then q else r}', and it is replaced by a propositional equivalent of the form `{p /\ q \/ ~p /\ r}'. \FAILURE Never fails, but will just return a reflexive theorem if the term is not Boolean. \EXAMPLE Note that in contrast to {COND_ELIM_CONV}, there are no freeness restrictions, and the Boolean split will be done inside quantifiers if necessary: { # CONDS_ELIM_CONV `!x y. (if x <= y then y else x) <= z ==> x <= z`;; val it : thm = |- (!x y. (if x <= y then y else x) <= z ==> x <= z) <=> (!x y. ~(x <= y) \/ (y <= z ==> x <= z)) } \USES Mostly for initial normalization in automated rules, but may be helpful for other uses. \COMMENTS The function {CONDS_CELIM_CONV} is functionally similar, but will do the final propositional splitting in a ``conjunctive'' rather than ``disjunctive'' way. The disjunctive way is usually better when the term will subsequently be passed to a refutation procedure, whereas the conjunctive form is better for non-refutation procedures. In each case, the policy is changed in an appropriate way after passing through quantifiers. \SEEALSO COND_CASES_TAC, COND_ELIM_CONV, CONDS_CELIM_CONV. \ENDDOC hol-light/Help/COND_CASES_TAC.doc000066400000000000000000000040641303454263000164600ustar00rootroot00000000000000\DOC COND_CASES_TAC \TYPE {COND_CASES_TAC : tactic} \SYNOPSIS Induces a case split on a conditional expression in the goal. \KEYWORDS tactic, conditional, cases. \DESCRIBE {COND_CASES_TAC} searches for a free conditional subterm in the term of a goal, i.e. a subterm of the form {if p then u else v}, choosing some topmost one if there are several. It then induces a case split over {p} as follows: { A ?- t ========================================== COND_CASES_TAC A u {{p}} ?- t[T/p; u/(if p then u else v)] A u {{~p}} ?- t[F/p; v/(if p then u else v)] } \noindent where {p} is not a constant, and the term {p then u else v} is free in {t}. Note that it both enriches the assumptions and inserts the assumed value into the conditional. \FAILURE {COND_CASES_TAC} fails if there is no conditional sub-term as described above. \EXAMPLE We can prove the following just by {REAL_ARITH `!x y:real. x <= max x y`}, but it is instructive to consider a manual proof. { # g `!x y:real. x <= max x y`;; val it : goalstack = 1 subgoal (1 total) `!x y. x <= max x y` # e(REPEAT GEN_TAC THEN REWRITE_TAC[real_max]);;' val it : goalstack = 1 subgoal (1 total) `x <= (if x <= y then y else x)` # e COND_CASES_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`~(x <= y)`] `x <= x` } \USES Useful for case analysis and replacement in one step, when there is a conditional sub-term in the term part of the goal. When there is more than one such sub-term and one in particular is to be analyzed, {COND_CASES_TAC} cannot always be depended on to choose the `desired' one. It can, however, be used repeatedly to analyze all conditional sub-terms of a goal. \COMMENTS Note that logically it should only be necessary for {p} to be free in the whole term, not the two branches {x} and {y}. However, as an artifact of the current implementation, we need them to be free too. The more sophisticated conversion {CONDS_ELIM_CONV} handles this better. \SEEALSO ASM_CASES_TAC, COND_ELIM_CONV, CONDS_ELIM_CONV, DISJ_CASES_TAC, STRUCT_CASES_TAC. \ENDDOC hol-light/Help/COND_ELIM_CONV.doc000066400000000000000000000032451303454263000165060ustar00rootroot00000000000000\DOC COND_ELIM_CONV \TYPE {COND_ELIM_CONV : term -> thm} \SYNOPSIS Conversion to eliminate one free conditional subterm. \DESCRIBE When applied to a term {`....(if p then x else y)...`} containing a free conditional subterm, {COND_ELIM_CONV} returns a theorem asserting its equivalence to a term with the conditional eliminated: { |- ....(if p then x else y).... <=> (p ==> ....x....) /\ (~p ==> ....y....) } If the term contains many free conditional subterms, a topmost one will be used. \FAILURE Fails if there are no free conditional subterms. \EXAMPLE We can prove the little equivalence noted by Dijkstra in EWD1176 automatically: { # REAL_ARITH `!a b:real. a + b >= max a b <=> a >= &0 /\ b >= &0`;; val it : thm = |- !a b. a + b >= max a b <=> a >= &0 /\ b >= &0 } However, if our automated tools were unfamiliar with {max}, we might expand its definition (theorem {real_max}) and then eliminate the resulting conditional by {COND_ELIM_CONV}: { # COND_ELIM_CONV `a + b >= (if a <= b then b else a) <=> a >= &0 /\ b >= &0`;; val it : thm = |- (a + b >= (if a <= b then b else a) <=> a >= &0 /\ b >= &0) <=> (a <= b ==> (a + b >= b <=> a >= &0 /\ b >= &0)) /\ (~(a <= b) ==> (a + b >= a <=> a >= &0 /\ b >= &0)) } \USES Eliminating conditionals as a prelude to other automated proof steps that are not equipped to handle them. \COMMENTS Note that logically it should only be necessary for {p} to be free in the whole term, not the two branches {x} and {y}. However, as an artifact of the current implementation, we need them to be free too. The more sophisticated {CONDS_ELIM_CONV} handles this better. \SEEALSO COND_CASES_TAC, CONDS_ELIM_CONV. \ENDDOC hol-light/Help/CONJ.doc000066400000000000000000000006231303454263000150560ustar00rootroot00000000000000\DOC CONJ \TYPE {CONJ : thm -> thm -> thm} \SYNOPSIS Introduces a conjunction. \KEYWORDS rule, conjunction. \DESCRIBE { A1 |- t1 A2 |- t2 ------------------------ CONJ A1 u A2 |- t1 /\ t2 } \FAILURE Never fails. \EXAMPLE { # CONJ (NUM_REDUCE_CONV `2 + 2`) (ASSUME `p:bool`);; val it : thm = p |- 2 + 2 = 4 /\ p } \SEEALSO CONJUNCT1, CONJUNCT2, CONJUNCTS, CONJ_PAIR. \ENDDOC hol-light/Help/CONJUNCT1.doc000066400000000000000000000006111303454263000156260ustar00rootroot00000000000000\DOC CONJUNCT1 \TYPE {CONJUNCT1 : thm -> thm} \SYNOPSIS Extracts left conjunct of theorem. \KEYWORDS rule, conjunction. \DESCRIBE { A |- t1 /\ t2 --------------- CONJUNCT1 A |- t1 } \FAILURE Fails unless the input theorem is a conjunction. \EXAMPLE { # CONJUNCT1(ASSUME `p /\ q`);; val it : thm = p /\ q |- p } \SEEALSO CONJ_PAIR, CONJUNCT2, CONJ, CONJUNCTS. \ENDDOC hol-light/Help/CONJUNCT2.doc000066400000000000000000000006121303454263000156300ustar00rootroot00000000000000\DOC CONJUNCT2 \TYPE {CONJUNCT2 : thm -> thm} \SYNOPSIS Extracts right conjunct of theorem. \KEYWORDS rule, conjunction. \DESCRIBE { A |- t1 /\ t2 --------------- CONJUNCT2 A |- t2 } \FAILURE Fails unless the input theorem is a conjunction. \EXAMPLE { # CONJUNCT2(ASSUME `p /\ q`);; val it : thm = p /\ q |- q } \SEEALSO CONJ_PAIR, CONJUNCT1, CONJ, CONJUNCTS. \ENDDOC hol-light/Help/CONJUNCTS_THEN.doc000066400000000000000000000024441303454263000165140ustar00rootroot00000000000000\DOC CONJUNCTS_THEN \TYPE {CONJUNCTS_THEN : thm_tactical} \SYNOPSIS Applies a theorem-tactic to each conjunct of a theorem. \KEYWORDS theorem-tactic, conjunction. \DESCRIBE {CONJUNCTS_THEN} takes a theorem-tactic {ttac}, and a theorem {t} whose conclusion must be a conjunction. {CONJUNCTS_THEN} breaks {t} into two new theorems, {t1} and {t2} which are {CONJUNCT1} and {CONJUNCT2} of {t} respectively, and then returns a new tactic: {ttac t1 THEN ttac t2}. That is, { CONJUNCTS_THEN ttac (A |- l /\ r) = ttac (A |- l) THEN ttac (A |- r) } \noindent so if { A1 ?- t1 A2 ?- t2 ========== ttac (A |- l) ========== ttac (A |- r) A2 ?- t2 A3 ?- t3 } \noindent then { A1 ?- t1 ========== CONJUNCTS_THEN ttac (A |- l /\ r) A3 ?- t3 } \FAILURE {CONJUNCTS_THEN ttac} will fail if applied to a theorem whose conclusion is not a conjunction. \COMMENTS {CONJUNCTS_THEN ttac (A |- u1 /\ ... /\ un)} results in the tactic: { ttac (A |- u1) THEN ttac (A |- u2 /\ ... /\ un) } \noindent The iterated effect: { ttac (A |- u1) THEN ... THEN ttac(A |- un) } \noindent can be achieved by { REPEAT_TCL CONJUNCTS_THEN ttac (A |- u1 /\ ... /\ un) } \SEEALSO CONJUNCT1, CONJUNCT2, CONJUNCTS, CONJUNCTS_TAC, CONJUNCTS_THEN2, STRIP_THM_THEN. \ENDDOC hol-light/Help/CONJUNCTS_THEN2.doc000066400000000000000000000021361303454263000165740ustar00rootroot00000000000000\DOC CONJUNCTS_THEN2 \TYPE {CONJUNCTS_THEN2 : thm_tactic -> thm_tactic -> thm_tactic} \SYNOPSIS Applies two theorem-tactics to the corresponding conjuncts of a theorem. \KEYWORDS theorem-tactic, conjunction. \DESCRIBE {CONJUNCTS_THEN2} takes two theorem-tactics, {f1} and {f2}, and a theorem {t} whose conclusion must be a conjunction. {CONJUNCTS_THEN2} breaks {t} into two new theorems, {t1} and {t2} which are {CONJUNCT1} and {CONJUNCT2} of {t} respectively, and then returns the tactic {f1 t1 THEN f2 t2}. Thus { CONJUNCTS_THEN2 f1 f2 (A |- l /\ r) = f1 (A |- l) THEN f2 (A |- r) } \noindent so if { A1 ?- t1 A2 ?- t2 ========== f1 (A |- l) ========== f2 (A |- r) A2 ?- t2 A3 ?- t3 } \noindent then { A1 ?- t1 ========== CONJUNCTS_THEN2 f1 f2 (A |- l /\ r) A3 ?- t3 } \FAILURE {CONJUNCTS_THEN f} will fail if applied to a theorem whose conclusion is not a conjunction. \USES The construction of complex {tactical}s like {CONJUNCTS_THEN}. \SEEALSO CONJUNCT1, CONJUNCT2, CONJUNCTS, CONJUNCTS_TAC, CONJUNCTS_THEN2, STRIP_THM_THEN. \ENDDOC hol-light/Help/CONJUNCTS_UPPERCASE.doc000066400000000000000000000012501303454263000172770ustar00rootroot00000000000000\DOC CONJUNCTS \TYPE {CONJUNCTS : thm -> thm list} \SYNOPSIS Recursively splits conjunctions into a list of conjuncts. \KEYWORDS rule, conjunction. \DESCRIBE Flattens out all conjuncts, regardless of grouping. Returns a singleton list if the input theorem is not a conjunction. { A |- t1 /\ t2 /\ ... /\ tn ----------------------------------- CONJUNCTS A |- t1 A |- t2 ... A |- tn } \FAILURE Never fails. \EXAMPLE { # CONJUNCTS(ASSUME `(x /\ y) /\ z /\ w`);; val it : thm list = [(x /\ y) /\ z /\ w |- x; (x /\ y) /\ z /\ w |- y; (x /\ y) /\ z /\ w |- z; (x /\ y) /\ z /\ w |- w] } \SEEALSO CONJ, CONJUNCT1, CONJUNCT2, CONJ_PAIR. \ENDDOC hol-light/Help/CONJ_ACI_RULE.doc000066400000000000000000000017041303454263000163620ustar00rootroot00000000000000\DOC CONJ_ACI_RULE \TYPE {CONJ_ACI_RULE : term -> thm} \SYNOPSIS Proves equivalence of two conjunctions containing same set of conjuncts. \DESCRIBE The call {CONJ_ACI_RULE `t1 /\ ... /\ tn <=> u1 /\ ... /\ um`}, where both sides of the equation are conjunctions of exactly the same set of conjuncts, (with arbitrary ordering, association, and repetitions), will return the corresponding theorem {|- t1 /\ ... /\ tn <=> u1 /\ ... /\ um}. \FAILURE Fails if applied to a term that is not a Boolean equation or the two sets of conjuncts are different. \EXAMPLE { # CONJ_ACI_RULE `(a /\ b) /\ (a /\ c) <=> (a /\ (c /\ a)) /\ b`;; val it : thm = |- (a /\ b) /\ a /\ c <=> (a /\ c /\ a) /\ b } \COMMENTS The same effect can be had with the more general {AC} construct. However, for the special case of conjunction, {CONJ_ACI_RULE} is substantially more efficient when there are many conjuncts involved. \SEEALSO AC, CONJ_CANON_CONV, DISJ_ACI_RULE. \ENDDOC hol-light/Help/CONJ_CANON_CONV.doc000066400000000000000000000014061303454263000166210ustar00rootroot00000000000000\DOC CONJ_CANON_CONV \TYPE {CONJ_CANON_CONV : term -> thm} \SYNOPSIS Puts an iterated conjunction in canonical form. \DESCRIBE When applied to a term, {CONJ_CANON_CONV} splits it into the set of conjuncts and produces a theorem asserting the equivalence of the term and the new term with the disjuncts right-associated without repetitions and in a canonical order. \FAILURE Fails if applied to a non-Boolean term. If applied to a term that is not a conjunction, it will trivially work in the sense of regarding it as a single conjunct and returning a reflexive theorem. \EXAMPLE { # CONJ_CANON_CONV `(a /\ b) /\ ((b /\ d) /\ a) /\ c`;; val it : thm = |- (a /\ b) /\ ((b /\ d) /\ a) /\ c <=> a /\ b /\ c /\ d } \SEEALSO AC, CONJ_ACI_CONV, DISJ_CANON_CONV. \ENDDOC hol-light/Help/CONJ_PAIR.doc000066400000000000000000000007751303454263000157010ustar00rootroot00000000000000\DOC CONJ_PAIR \TYPE {CONJ_PAIR : thm -> thm * thm} \SYNOPSIS Extracts both conjuncts of a conjunction. \KEYWORDS rule, conjunction. \DESCRIBE { A |- t1 /\ t2 ---------------------- CONJ_PAIR A |- t1 A |- t2 } \noindent The two resultant theorems are returned as a pair. \FAILURE Fails if the input theorem is not a conjunction. \EXAMPLE { # CONJ_PAIR(ASSUME `p /\ q`);; val it : thm * thm = (p /\ q |- p, p /\ q |- q) } \SEEALSO CONJUNCT1, CONJUNCT2, CONJ, CONJUNCTS. \ENDDOC hol-light/Help/CONJ_TAC.doc000066400000000000000000000007241303454263000155470ustar00rootroot00000000000000\DOC CONJ_TAC \TYPE {CONJ_TAC : tactic} \SYNOPSIS Reduces a conjunctive goal to two separate subgoals. \KEYWORDS tactic, conjunction. \DESCRIBE When applied to a goal {A ?- t1 /\ t2}, the tactic {CONJ_TAC} reduces it to the two subgoals corresponding to each conjunct separately. { A ?- t1 /\ t2 ====================== CONJ_TAC A ?- t1 A ?- t2 } \FAILURE Fails unless the conclusion of the goal is a conjunction. \SEEALSO STRIP_TAC. \ENDDOC hol-light/Help/CONTR.doc000066400000000000000000000011561303454263000152140ustar00rootroot00000000000000\DOC CONTR \TYPE {CONTR : term -> thm -> thm} \SYNOPSIS Implements the intuitionistic contradiction rule. \KEYWORDS rule, contradiction. \DESCRIBE When applied to a term {t} and a theorem {A |- F}, the inference rule {CONTR} returns the theorem {A |- t}. { A |- F -------- CONTR `t` A |- t } \FAILURE Fails unless the term has type {bool} and the theorem has {F} as its conclusion. \EXAMPLE { # let th = REWRITE_RULE[ARITH] (ASSUME `1 = 0`);; val th : thm = 1 = 0 |- F # CONTR `Russell:Person = Pope` th;; val it : thm = 1 = 0 |- Russell = Pope } \SEEALSO CCONTR, CONTR_TAC, NOT_ELIM. \ENDDOC hol-light/Help/CONTRAPOS_CONV.doc000066400000000000000000000010041303454263000165140ustar00rootroot00000000000000\DOC CONTRAPOS_CONV \TYPE {CONTRAPOS_CONV : term -> thm} \SYNOPSIS Proves the equivalence of an implication and its contrapositive. \KEYWORDS conversion, contrapositive, implication. \DESCRIBE When applied to an implication {`p ==> q`}, the conversion {CONTRAPOS_CONV} returns the theorem: { |- (p ==> q) <=> (~q ==> ~p) } \FAILURE Fails if applied to a term that is not an implication. \COMMENTS The same effect can be had by {GEN_REWRITE_CONV I [GSYM CONTRAPOS_THM]} \SEEALSO CCONTR, CONTR_TAC. \ENDDOC hol-light/Help/CONTR_TAC.doc000066400000000000000000000011341303454263000156770ustar00rootroot00000000000000\DOC CONTR_TAC \TYPE {CONTR_TAC : thm_tactic} \SYNOPSIS Solves any goal from contradictory theorem. \KEYWORDS tactic, contradiction. \DESCRIBE When applied to a contradictory theorem {A' |- F}, and a goal {A ?- t}, the tactic {CONTR_TAC} completely solves the goal. This is an invalid tactic unless {A'} is a subset of {A}. { A ?- t ======== CONTR_TAC (A' |- F) } \USES One quite common pattern is to use a contradictory hypothesis via {FIRST_ASSUM CONTR_TAC}. \FAILURE Fails unless the theorem is contradictory, i.e. has {F} as its conclusion. \SEEALSO CCONTR, CONTR, NOT_ELIM. \ENDDOC hol-light/Help/CONV_RULE.doc000066400000000000000000000020701303454263000157170ustar00rootroot00000000000000\DOC CONV_RULE \TYPE {CONV_RULE : conv -> thm -> thm} \SYNOPSIS Makes an inference rule from a conversion. \KEYWORDS conversional, rule. \DESCRIBE If {c} is a conversion, then {CONV_RULE c} is an inference rule that applies {c} to the conclusion of a theorem. That is, if {c} maps a term {`t`} to the theorem {|- t = t'}, then the rule {CONV_RULE c} infers {|- t'} from the theorem {|- t}. More precisely, if {c `t`} returns {A' |- t = t'}, then: { A |- t -------------- CONV_RULE c A u A' |- t' } \noindent Note that if the conversion {c} returns a theorem with assumptions, then the resulting inference rule adds these to the assumptions of the theorem it returns. \FAILURE {CONV_RULE c th} fails if {c} fails when applied to the conclusion of {th}. The function returned by {CONV_RULE c} will also fail if the ML function {c} is not, in fact, a conversion (i.e. a function that maps a term {t} to a theorem {|- t = t'}). \EXAMPLE { # CONV_RULE BETA_CONV (ASSUME `(\x. x < 2) 1`);; val it : thm = (\x. x < 2) 1 |- 1 < 2 } \SEEALSO CONV_TAC. \ENDDOC hol-light/Help/CONV_TAC.doc000066400000000000000000000043571303454263000155710ustar00rootroot00000000000000\DOC CONV_TAC \TYPE {CONV_TAC : conv -> tactic} \SYNOPSIS Makes a tactic from a conversion. \KEYWORDS conversional, tactical. \DESCRIBE If {c} is a conversion, then {CONV_TAC c} is a tactic that applies {c} to the goal. That is, if {c} maps a term {`g`} to the theorem {|- g = g'}, then the tactic {CONV_TAC c} reduces a goal {g} to the subgoal {g'}. More precisely, if {c `g`} returns {A' |- g = g'}, then: { A ?- g =============== CONV_TAC c A ?- g' } \noindent In the special case where {`g`} is {`T`}, the call immediately solves the goal rather than generating a subgoal {A ?- T}. And in a slightly liberal interpretation of ``conversion'', the conversion may also just prove the goal and return {A' |- g}, in which case again the goal will be completely solved. Note that in all cases the conversion {c} should return a theorem whose assumptions are also among the assumptions of the goal (normally, the conversion will returns a theorem with no assumptions). {CONV_TAC} does not fail if this is not the case, but the resulting tactic will be invalid, so the theorem ultimately proved using this tactic will have more assumptions than those of the original goal. \FAILURE {CONV_TAC c} applied to a goal {A ?- g} fails if {c} fails when applied to the term {g}. The function returned by {CONV_TAC c} will also fail if the function {c} is not, in fact, a conversion (i.e. a function that maps a term {t} to a theorem {|- t = t'}). \USES {CONV_TAC} can be used to apply simplifications that can't be expressed as equations (rewrite rules). For example, a goal: { # g `abs(pi - &22 / &7) <= abs(&355 / &113 - &22 / &7)`;; } \noindent can be simplified by rational number arithmetic: { # e(CONV_TAC REAL_RAT_REDUCE_CONV);; val it : goalstack = 1 subgoal (1 total) `abs (pi - &22 / &7) <= &1 / &791` } It is also handy for invoking decision procedures that only have a ``rule'' form, and no special ``tactic'' form. (Indeed, the tactic form can be defined in terms of the rule form by using {CONV_TAC}.) For example, the goal: { # g `!x:real. &0 < x ==> &1 / x - &1 / (x + &1) = &1 / (x * (x + &1))`;; } \noindent can be solved by: { # e(CONV_TAC REAL_FIELD);; ... val it : goalstack = No subgoals } \SEEALSO CONV_RULE. \ENDDOC hol-light/Help/DEDUCT_ANTISYM_RULE.doc000066400000000000000000000016671303454263000173410ustar00rootroot00000000000000\DOC DEDUCT_ANTISYM_RULE \TYPE {DEDUCT_ANTISYM_RULE : thm -> thm -> thm} \SYNOPSIS Deduces logical equivalence from deduction in both directions. \DESCRIBE When applied to two theorems, this rule deduces logical equivalence between their conclusions with a modified assumption list: { A |- p B |- q ---------------------------------- (A - {{q}}) u (B - {{p}}) |- p <=> q } The special case when {A = {{q}}} and {B = {{p}}} is perhaps the easiest to understand: { {{q}} |- p {{p}} |- q -------------------------- |- p <=> q } \FAILURE Never fails. \EXAMPLE { # let th1 = SYM(ASSUME `x:num = y`) and th2 = SYM(ASSUME `y:num = x`);; val th1 : thm = x = y |- y = x val th2 : thm = y = x |- x = y # DEDUCT_ANTISYM_RULE th1 th2;; val it : thm = |- y = x <=> x = y } \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO IMP_ANTISYM_RULE, PROVE_HYP. \ENDDOC hol-light/Help/DENUMERAL.doc000066400000000000000000000006411303454263000156410ustar00rootroot00000000000000\DOC DENUMERAL \TYPE {DENUMERAL : thm -> thm} \SYNOPSIS Remove instances of the {NUMERAL} constant from a theorem. \DESCRIBE The call {DENUMERAL th} removes from the conclusion of {th} any instances of the constant {NUMERAL}, used in the internal representation of numerals. \FAILURE Never fails. \USES Only intended for users manipulating the internal structure of numerals. \SEEALSO NUM_REDUCE_CONV. \ENDDOC hol-light/Help/DEPTH_BINOP_CONV.doc000066400000000000000000000027241303454263000167510ustar00rootroot00000000000000\DOC DEPTH_BINOP_CONV \TYPE {DEPTH_BINOP_CONV : term -> (term -> thm) -> term -> thm} \SYNOPSIS Applied a conversion to the leaves of a tree of binary operator expressions. \DESCRIBE If a term {t} is built up from terms {t1,...,tn} using a binary operator {op} (for example {op (op t1 t2) (op (op t3 t4) t5)}), the call {DEPTH_BINOP_CONV `op` cnv t} will apply the conversion {cnv} to each {ti} to give a theorem {|- ti = ti'}, and return the equational theorem {|- t = t'} where {t'} results from replacing each {ti} in {t} with the corresponding {ti'}. \FAILURE Fails only if the core conversion {cnv} fails on one of the chosen subterms. \EXAMPLE One can always completely evaluate arithmetic expressions with {NUM_REDUCE_CONV}, e.g. { # NUM_REDUCE_CONV `(1 + 2) + (3 * (4 + 5) + 6) + (7 DIV 8)`;; val it : thm = |- (1 + 2) + (3 * (4 + 5) + 6) + 7 DIV 8 = 36 } However, if one wants for some reason not to reduce the top-level combination of additions, one can do instead: { # DEPTH_BINOP_CONV `(+):num->num->num` NUM_REDUCE_CONV `(1 + 2) + (3 * (4 + 5) + 6) + (7 DIV 8)`;; val it : thm = |- (1 + 2) + (3 * (4 + 5) + 6) + 7 DIV 8 = (1 + 2) + (27 + 6) + 0 # NUM_REDUCE_CONV `(1 + 2) + (3 * (4 + 5) + 6) + (7 DIV 8)`;; } Note that the subterm {`3 * (4 + 5)`} did get completely evaluated, because the addition was not part of the toplevel tree, but was nested inside a multiplication. \SEEALSO BINOP_CONV, ONCE_DEPTH_CONV, PROP_ATOM_CONV, TOP_DEPTH_CONV. \ENDDOC hol-light/Help/DEPTH_CONV.doc000066400000000000000000000046521303454263000160240ustar00rootroot00000000000000\DOC DEPTH_CONV \TYPE {DEPTH_CONV : conv -> conv} \SYNOPSIS Applies a conversion repeatedly to all the sub-terms of a term, in bottom-up order. \KEYWORDS conversional. \DESCRIBE {DEPTH_CONV c tm} repeatedly applies the conversion {c} to all the subterms of the term {tm}, including the term {tm} itself. The supplied conversion is applied repeatedly (zero or more times, as is done by {REPEATC}) to each subterm until it fails. The conversion is applied to subterms in bottom-up order. \FAILURE {DEPTH_CONV c tm} never fails but can diverge if the conversion {c} can be applied repeatedly to some subterm of {tm} without failing. \EXAMPLE The following example shows how {DEPTH_CONV} applies a conversion to all subterms to which it applies: { # DEPTH_CONV BETA_CONV `(\x. (\y. y + x) 1) 2`;; val it : thm = |- (\x. (\y. y + x) 1) 2 = 1 + 2 } \noindent Here, there are two beta-redexes in the input term, one of which occurs within the other. {DEPTH_CONV BETA_CONV} applies beta-conversion to innermost beta-redex {(\y. y + x) 1} first. The outermost beta-redex is then {(\x. 1 + x) 2}, and beta-conversion of this redex gives {1 + 2}. Because {DEPTH_CONV} applies a conversion bottom-up, the final result may still contain subterms to which the supplied conversion applies. For example, in: { # DEPTH_CONV BETA_CONV `(\f x. (f x) + 1) (\y.y) 2`;; val it : thm = |- (\f x. f x + 1) (\y. y) 2 = (\y. y) 2 + 1 } \noindent the right-hand side of the result still contains a beta-redex, because the redex {`(\y.y)2`} is introduced by virtue an application of {BETA_CONV} higher-up in the structure of the input term. By contrast, in the example: { # DEPTH_CONV BETA_CONV `(\f x. (f x)) (\y.y) 2`;; val it : thm = |- (\f x. f x) (\y. y) 2 = 2 } \noindent all beta-redexes are eliminated, because {DEPTH_CONV} repeats the supplied conversion (in this case, {BETA_CONV}) at each subterm (in this case, at the top-level term). \USES If the conversion {c} implements the evaluation of a function in logic, then {DEPTH_CONV c} will do bottom-up evaluation of nested applications of it. For example, the conversion {ADD_CONV} implements addition of natural number constants within the logic. Thus, the effect of: { # DEPTH_CONV NUM_ADD_CONV `(1 + 2) + (3 + 4 + 5)`;; val it : thm = |- (1 + 2) + 3 + 4 + 5 = 15 } \noindent is to compute the sum represented by the input term. \SEEALSO ONCE_DEPTH_CONV, REDEPTH_CONV, TOP_DEPTH_CONV, TOP_SWEEP_CONV. \ENDDOC hol-light/Help/DEPTH_SQCONV.doc000066400000000000000000000011011303454263000162520ustar00rootroot00000000000000\DOC DEPTH_SQCONV \TYPE {DEPTH_SQCONV : strategy} \SYNOPSIS Applies simplification repeatedly to all the sub-terms of a term, in bottom-up order. \DESCRIBE HOL Light's simplification functions (e.g. {SIMP_TAC}) have their traversal algorithm controlled by a ``strategy''. {DEPTH_SQCONV} is a strategy corresponding to {DEPTH_CONV} for ordinary conversions: simplification is applied repeatedly to all the sub-terms of a term, in bottom-up order. \FAILURE Not applicable. \SEEALSO DEPTH_CONV, ONCE_DEPTH_SQCONV, REDEPTH_SQCONV, TOP_DEPTH_SQCONV, TOP_SWEEP_SQCONV. \ENDDOC hol-light/Help/DESTRUCT_TAC.doc000066400000000000000000000036461303454263000162610ustar00rootroot00000000000000\DOC DESTRUCT_TAC \TYPE {DESTRUCT_TAC : string -> thm_tactic} \SYNOPSIS Performs elimination on a theorem within a tactic proof. \DESCRIBE Given a string {s} and a theorem {th}, {DESTRUCT_TAC s th} performs the elimination of {th} according with the pattern given in {s}. The syntax of the pattern {s} is the following: \begin{{itemize}} \item An identifier {l} other than {`_`} and {`+`} assumes a hypothesis with label {l} \item The identifier {`_'} does nothing (discard the hypothesis) \item The identifier {`+'} adds the theorem as antecedent as with MP\_TAC \item A sequence of patterns (separated by spaces) destructs a conjunction \item A sequence of pattern separated by {|} destructs a disjunction \item A prefix {@x.} introduces an existential \end{{itemize}} \FAILURE Fails if the pattern is ill-formed or does not match the form of the theorem. \EXAMPLE Here we use the cases theorem for numerals, performing a disjunctive split and introducing names for the resulting hypotheses: { # let th = SPEC `n:num` (cases "num");; # g `n = 0 \/ (1 <= n /\ ?m. n = m + 1)`;; # e (DESTRUCT_TAC "neq0 | @m. neqsuc" th);; val it : goalstack = 2 subgoals (2 total) 0 [`n = SUC m`] (neqsuc) `n = 0 \/ 1 <= n /\ (?m. n = m + 1)` 0 [`n = 0`] (neq0) `n = 0 \/ 1 <= n /\ (?m. n = m + 1)` } Here we use the theorem { # let th = SPEC `n+2` EVEN_EXISTS_LEMMA;; val th : thm = |- (EVEN (n + 2) ==> (?m. n + 2 = 2 * m)) /\ (~EVEN (n + 2) ==> (?m. n + 2 = SUC (2 * m))) } \noindent adding as antecedent the right-hand side of the disjunction { # g `!n. ~EVEN n ==> ?a. n + 2 = 2 * a + 1`;; # e (REPEAT STRIP_TAC THEN DESTRUCT_TAC "_ +" th);; val it : goalstack = 1 subgoal (1 total) 0 [`~EVEN n`] `(~EVEN (n + 2) ==> (?m. n + 2 = SUC (2 * m))) ==> (?a. n + 2 = 2 * a + 1)` } \SEEALSO ASSUME_TAC, CLAIM_TAC, FIX_TAC, GEN_TAC, INTRO_TAC, LABEL_TAC, MP_TAC, REMOVE_THEN, STRIP_TAC, USE_THEN. \ENDDOC hol-light/Help/DISCH.doc000066400000000000000000000011261303454263000151560ustar00rootroot00000000000000\DOC DISCH \TYPE {DISCH : term -> thm -> thm} \SYNOPSIS Discharges an assumption. \KEYWORDS rule, discharge, assumption, implication. \DESCRIBE { A |- t -------------------- DISCH `u` A - {{u}} |- u ==> t } \FAILURE {DISCH} will fail if {`u`} is not boolean. \COMMENTS The term {`u`} need not be a hypothesis. Discharging {`u`} will remove any identical and alpha-equivalent hypotheses. \EXAMPLE { # DISCH `p /\ q` (CONJUNCT1(ASSUME `p /\ q`));; val it : thm = |- p /\ q ==> p } \SEEALSO DISCH_ALL, DISCH_TAC, DISCH_THEN, STRIP_TAC, UNDISCH, UNDISCH_ALL, UNDISCH_TAC. \ENDDOC hol-light/Help/DISCH_ALL.doc000066400000000000000000000016321303454263000156500ustar00rootroot00000000000000\DOC DISCH_ALL \TYPE {DISCH_ALL : thm -> thm} \SYNOPSIS Discharges all hypotheses of a theorem. \KEYWORDS rule, discharge, assumption, implication. \DESCRIBE { A1, ..., An |- t ---------------------------- DISCH_ALL |- A1 ==> ... ==> An ==> t } \FAILURE {DISCH_ALL} will not fail if there are no hypotheses to discharge, it will simply return the theorem unchanged. \EXAMPLE { # end_itlist CONJ (map ASSUME [`p:bool`; `q:bool`; `r:bool`]);; val it : thm = p, q, r |- p /\ q /\ r # DISCH_ALL it;; val it : thm = |- r ==> q ==> p ==> p /\ q /\ r } \COMMENTS Users should not rely on the hypotheses being discharged in any particular order. Two or more alpha-convertible hypotheses will be discharged by a single implication; users should not rely on which hypothesis appears in the implication. \SEEALSO DISCH, DISCH_TAC, DISCH_THEN, STRIP_TAC, UNDISCH, UNDISCH_ALL, UNDISCH_TAC. \ENDDOC hol-light/Help/DISCH_TAC.doc000066400000000000000000000014411303454263000156450ustar00rootroot00000000000000\DOC DISCH_TAC \TYPE {DISCH_TAC : tactic} \SYNOPSIS Moves the antecedent of an implicative goal into the assumptions. \KEYWORDS tactic, undischarge, antecedent, implication. \DESCRIBE { A ?- u ==> v ============== DISCH_TAC A u {{u}} ?- v } \noindent Note that {DISCH_TAC} treats {`~u`} as {`u ==> F`}, so will also work when applied to a goal with a negated conclusion. \FAILURE {DISCH_TAC} will fail for goals which are not implications or negations. \USES Solving goals of the form {`u ==> v`} by rewriting {`v`} with {`u`}, although the use of {DISCH_THEN} is usually more elegant in such cases. \COMMENTS If the antecedent already appears in the assumptions, it will be duplicated. \SEEALSO DISCH, DISCH_ALL, DISCH_THEN, STRIP_TAC, UNDISCH, UNDISCH_ALL, UNDISCH_TAC. \ENDDOC hol-light/Help/DISCH_THEN.doc000066400000000000000000000025511303454263000157770ustar00rootroot00000000000000\DOC DISCH_THEN \TYPE {DISCH_THEN : thm_tactic -> tactic} \SYNOPSIS Undischarges an antecedent of an implication and passes it to a theorem-tactic. \KEYWORDS theorem-tactic, undischarge, antecedent, implication. \DESCRIBE {DISCH_THEN} removes the antecedent and then creates a theorem by {ASSUME}ing it. This new theorem is passed to the theorem-tactic given as {DISCH_THEN}'s argument. The consequent tactic is then applied. Thus: { DISCH_THEN ttac (asl ?- t1 ==> t2) = ttac (ASSUME `t1`) (asl ?- t2) } \noindent For example, if { A ?- t ======== ttac (ASSUME `u`) B ?- v } \noindent then { A ?- u ==> t ============== DISCH_THEN ttac B ?- v } \noindent Note that {DISCH_THEN} treats {`~u`} as {`u ==> F`}. \FAILURE {DISCH_THEN} will fail for goals that are not implications or negations. \EXAMPLE Given the goal: { # g `!x. x = 0 ==> f(x) * x = x + 2 * x`;; } \noindent we can discharge the antecedent and substitute with it immediately by: { # e(GEN_TAC THEN DISCH_THEN SUBST1_TAC);; val it : goalstack = 1 subgoal (1 total) `f 0 * 0 = 0 + 2 * 0` } \noindent and now {REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES]} will finish the job. \COMMENTS The tactical {REFUTE_THEN} provides a more general classical `assume otherwise' function. \SEEALSO DISCH, DISCH_ALL, DISCH_TAC, REFUTE_THEN, STRIP_TAC, UNDISCH, UNDISCH_ALL, UNDISCH_TAC. \ENDDOC hol-light/Help/DISJ1.doc000066400000000000000000000006361303454263000151430ustar00rootroot00000000000000\DOC DISJ1 \TYPE {DISJ1 : thm -> term -> thm} \SYNOPSIS Introduces a right disjunct into the conclusion of a theorem. \KEYWORDS rule, disjunction. \DESCRIBE { A |- t1 --------------- DISJ1 (A |- t1) `t2` A |- t1 \/ t2 } \FAILURE Fails unless the term argument is boolean. \EXAMPLE { # DISJ1 TRUTH `F`;; val it : thm = |- T \/ F } \SEEALSO DISJ1_TAC, DISJ2, DISJ2_TAC, DISJ_CASES. \ENDDOC hol-light/Help/DISJ1_TAC.doc000066400000000000000000000004571303454263000156330ustar00rootroot00000000000000\DOC DISJ1_TAC \TYPE {DISJ1_TAC : tactic} \SYNOPSIS Selects the left disjunct of a disjunctive goal. \KEYWORDS tactic, disjunction. \DESCRIBE { A ?- t1 \/ t2 =============== DISJ1_TAC A ?- t1 } \FAILURE Fails if the goal is not a disjunction. \SEEALSO DISJ1, DISJ2, DISJ2_TAC. \ENDDOC hol-light/Help/DISJ2.doc000066400000000000000000000006221303454263000151370ustar00rootroot00000000000000\DOC DISJ2 \TYPE {DISJ2 : term -> thm -> thm} \SYNOPSIS Introduces a left disjunct into the conclusion of a theorem. \KEYWORDS rule, disjunction. \DESCRIBE { A |- t2 --------------- DISJ2 `t1` A |- t1 \/ t2 } \FAILURE Fails if the term argument is not boolean. \EXAMPLE { # DISJ2 `F` TRUTH;; val it : thm = |- F \/ T } \SEEALSO DISJ1, DISJ1_TAC, DISJ2_TAC, DISJ_CASES. \ENDDOC hol-light/Help/DISJ2_TAC.doc000066400000000000000000000004641303454263000156320ustar00rootroot00000000000000\DOC DISJ2_TAC \TYPE {DISJ2_TAC : tactic} \SYNOPSIS Selects the right disjunct of a disjunctive goal. \KEYWORDS tactic, disjunction. \DESCRIBE { A ?- t1 \/ t2 =============== DISJ2_TAC A ?- t2 } \FAILURE Fails if the goal is not a disjunction. \SEEALSO DISJ1, DISJ1_TAC, DISJ2. \ENDDOC hol-light/Help/DISJ_ACI_RULE.doc000066400000000000000000000016611303454263000163640ustar00rootroot00000000000000\DOC DISJ_ACI_RULE \TYPE {DISJ_ACI_RULE : term -> thm} \SYNOPSIS Proves equivalence of two disjunctions containing same set of disjuncts. \DESCRIBE The call {DISJ_ACI_RULE `t1 \/ ... \/ tn <=> u1 \/ ... \/ um`}, where both sides of the equation are disjunctions of exactly the same set of disjuncts, (with arbitrary ordering, association, and repetitions), will return the corresponding theorem {|- t1 \/ ... \/ tn <=> u1 \/ ... \/ um}. \FAILURE Fails if applied to a term that is not a Boolean equation or the two sets of disjuncts are different. \EXAMPLE { # DISJ_ACI_RULE `(p \/ q) \/ (q \/ r) <=> r \/ q \/ p`;; val it : thm = |- (p \/ q) \/ q \/ r <=> r \/ q \/ p } \COMMENTS The same effect can be had with the more general {AC} construct. However, for the special case of disjunction, {DISJ_ACI_RULE} is substantially more efficient when there are many disjuncts involved. \SEEALSO AC, CONJ_ACI_RULE, DISJ_CANON_CONV. \ENDDOC hol-light/Help/DISJ_CANON_CONV.doc000066400000000000000000000014001303454263000166130ustar00rootroot00000000000000\DOC DISJ_CANON_CONV \TYPE {DISJ_CANON_CONV : term -> thm} \SYNOPSIS Puts an iterated disjunction in canonical form. \DESCRIBE When applied to a term, {DISJ_CANON_CONV} splits it into the set of disjuncts and produces a theorem asserting the equivalence of the term and the new term with the disjuncts right-associated without repetitions and in a canonical order. \FAILURE Fails if applied to a non-Boolean term. If applied to a term that is not a disjunction, it will trivially work in the sense of regarding it as a single disjunct and returning a reflexive theorem. \EXAMPLE { # DISJ_CANON_CONV `(c \/ a \/ b) \/ (b \/ a \/ d)`;; val it : thm = |- (c \/ a \/ b) \/ b \/ a \/ d <=> a \/ b \/ c \/ d } \SEEALSO AC, CONJ_CANON_CONV, DISJ_ACI_CONV. \ENDDOC hol-light/Help/DISJ_CASES.doc000066400000000000000000000031601303454263000157730ustar00rootroot00000000000000\DOC DISJ_CASES \TYPE {DISJ_CASES : thm -> thm -> thm -> thm} \SYNOPSIS Eliminates disjunction by cases. \KEYWORDS rule, disjunction, cases. \DESCRIBE The rule {DISJ_CASES} takes a disjunctive theorem, and two `case' theorems, each with one of the disjuncts as a hypothesis while sharing alpha-equivalent conclusions. A new theorem is returned with the same conclusion as the `case' theorems, and the union of all assumptions excepting the disjuncts. { A |- t1 \/ t2 A1 |- t A2 |- t -------------------------------------------------- DISJ_CASES A u (A1 - {{t1}}) u (A2 - {{t2}}) |- t } \FAILURE Fails if the first argument is not a disjunctive theorem, or if the conclusions of the other two theorems are not alpha-convertible. \EXAMPLE Let us create several theorems. Note that {th1} and {th2} draw the same conclusion from different hypotheses, while {th} proves the disjunction of the two hypotheses: { # let [th; th1; th2] = map (UNDISCH_ALL o REAL_FIELD) [`~(x = &0) \/ x = &0`; `~(x = &0) ==> x * (inv(x) * x - &1) = &0`; `x = &0 ==> x * (inv(x) * x - &1) = &0`];; ... val th : thm = |- ~(x = &0) \/ x = &0 val th1 : thm = ~(x = &0) |- x * (inv x * x - &1) = &0 val th2 : thm = x = &0 |- x * (inv x * x - &1) = &0 } \noindent so we can apply {DISJ_CASES}: { # DISJ_CASES th th1 th2;; val it : thm = |- x * (inv x * x - &1) = &0 } \COMMENTS Neither of the `case' theorems is required to have either disjunct as a hypothesis, but otherwise {DISJ_CASES} is pointless. \SEEALSO DISJ_CASES_TAC, DISJ_CASES_THEN, DISJ_CASES_THEN2, DISJ1, DISJ2, SIMPLE_DISJ_CASES. \ENDDOC hol-light/Help/DISJ_CASES_TAC.doc000066400000000000000000000022501303454263000164610ustar00rootroot00000000000000\DOC DISJ_CASES_TAC \TYPE {DISJ_CASES_TAC : thm_tactic} \SYNOPSIS Produces a case split based on a disjunctive theorem. \KEYWORDS tactic, disjunction, cases. \DESCRIBE Given a theorem {th} of the form {A |- u \/ v}, {DISJ_CASES_TAC th} applied to a goal produces two subgoals, one with {u} as an assumption and one with {v}: { A ?- t ================================= DISJ_CASES_TAC (A |- u \/ v) A u {{u}} ?- t A u {{v}}?- t } \FAILURE Fails if the given theorem does not have a disjunctive conclusion. \EXAMPLE Given the simple fact about arithmetic {th}, {|- m = 0 \/ (?n. m = SUC n)}, the tactic {DISJ_CASES_TAC th} can be used to produce a case split: { # let th = SPEC `m:num` num_CASES;; val th : thm = |- m = 0 \/ (?n. m = SUC n) # g `(P:num -> bool) m`;; Warning: Free variables in goal: P, m val it : goalstack = 1 subgoal (1 total) `P m` # e(DISJ_CASES_TAC th);; val it : goalstack = 2 subgoals (2 total) 0 [`?n. m = SUC n`] `P m` 0 [`m = 0`] `P m` } \USES Performing a case analysis according to a disjunctive theorem. \SEEALSO ASSUME_TAC, ASM_CASES_TAC, COND_CASES_TAC, DISJ_CASES_THEN, STRUCT_CASES_TAC. \ENDDOC hol-light/Help/DISJ_CASES_THEN.doc000066400000000000000000000035311303454263000166130ustar00rootroot00000000000000\DOC DISJ_CASES_THEN \TYPE {DISJ_CASES_THEN : thm_tactical} \SYNOPSIS Applies a theorem-tactic to each disjunct of a disjunctive theorem. \KEYWORDS theorem-tactic, disjunction, cases. \DESCRIBE If the theorem-tactic {f:thm->tactic} applied to either {ASSUME}d disjunct produces results as follows when applied to a goal {(A ?- t)}: { A ?- t A ?- t ========= f (u |- u) and ========= f (v |- v) A ?- t1 A ?- t2 } \noindent then applying {DISJ_CASES_THEN f (|- u \/ v)} to the goal {(A ?- t)} produces two subgoals. { A ?- t ====================== DISJ_CASES_THEN f (|- u \/ v) A ?- t1 A ?- t2 } \FAILURE Fails if the theorem is not a disjunction. An invalid tactic is produced if the theorem has any hypothesis which is not alpha-convertible to an assumption of the goal. \EXAMPLE Given the theorem { th = |- (m = 0) \/ (?n. m = SUC n) } \noindent and a goal of the form {?- (PRE m = m) = (m = 0)}, applying the tactic { DISJ_CASES_THEN MP_TAC th } \noindent produces two subgoals, each with one disjunct as an added antecedent { # let th = SPEC `m:num` num_CASES;; val th : thm = |- m = 0 \/ (?n. m = SUC n) # g `PRE m = m <=> m = 0`;; Warning: Free variables in goal: m val it : goalstack = 1 subgoal (1 total) `PRE m = m <=> m = 0` # e(DISJ_CASES_THEN MP_TAC th);; val it : goalstack = 2 subgoals (2 total) `(?n. m = SUC n) ==> (PRE m = m <=> m = 0)` `m = 0 ==> (PRE m = m <=> m = 0)` } \USES Building cases tactics. For example, {DISJ_CASES_TAC} could be defined by: { let DISJ_CASES_TAC = DISJ_CASES_THEN ASSUME_TAC } \COMMENTS Use {DISJ_CASES_THEN2} to apply different tactic generating functions to each case. \SEEALSO STRIP_THM_THEN, CHOOSE_THEN, CONJUNCTS_THEN, CONJUNCTS_THEN2, DISJ_CASES_TAC, DISJ_CASES_THEN2. \ENDDOC hol-light/Help/DISJ_CASES_THEN2.doc000066400000000000000000000042121303454263000166720ustar00rootroot00000000000000\DOC DISJ_CASES_THEN2 \TYPE {DISJ_CASES_THEN2 : thm_tactic -> thm_tactic -> thm_tactic} \SYNOPSIS Applies separate theorem-tactics to the two disjuncts of a theorem. \KEYWORDS theorem-tactic, disjunction, cases. \DESCRIBE If the theorem-tactics {ttac1} and {ttac2}, applied to the {ASSUME}d left and right disjunct of a theorem {|- u \/ v} respectively, produce results as follows when applied to a goal {(A ?- t)}: { A ?- t A ?- t ========= ttac1 (u |- u) and ========= ttac2 (v |- v) A ?- t1 A ?- t2 } \noindent then applying {DISJ_CASES_THEN2 ttac1 ttac2 (|- u \/ v)} to the goal {(A ?- t)} produces two subgoals. { A ?- t ====================== DISJ_CASES_THEN2 ttac1 ttac2 (|- u \/ v) A ?- t1 A ?- t2 } \FAILURE Fails if the theorem is not a disjunction. An invalid tactic is produced if the theorem has any hypothesis which is not alpha-convertible to an assumption of the goal. \EXAMPLE Given the theorem { # let th = SPEC `m:num` num_CASES;; val th : thm = |- m = 0 \/ (?n. m = SUC n) } \noindent and a goal: { # g `PRE m = m <=> m = 0`;; } \noindent the following produces two subgoals: { # e(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC th);; val it : goalstack = 2 subgoals (2 total) `(?n. m = SUC n) ==> (PRE m = m <=> m = 0)` `PRE 0 = 0 <=> 0 = 0` } \noindent The first subgoal has had the disjunct {m = 0} used for a substitution, and the second has added the disjunct as an antecedent. Alternatively, we can make the second theorem-tactic also choose a witness for the existential quantifier and follow by also substituting: { # e(DISJ_CASES_THEN2 SUBST1_TAC (CHOOSE_THEN SUBST1_TAC) th);; val it : goalstack = 2 subgoals (2 total) `PRE (SUC n) = SUC n <=> SUC n = 0` `PRE 0 = 0 <=> 0 = 0` } \noindent Either subgoal can be finished with {ARITH_TAC}, but the way, but so could the initial goal. \USES Building cases tacticals. For example, {DISJ_CASES_THEN} could be defined by: { let DISJ_CASES_THEN f = DISJ_CASES_THEN2 f f } \SEEALSO STRIP_THM_THEN, CHOOSE_THEN, CONJUNCTS_THEN, CONJUNCTS_THEN2, DISJ_CASES_THEN. \ENDDOC hol-light/Help/DNF_CONV.doc000066400000000000000000000016261303454263000155650ustar00rootroot00000000000000\DOC DNF_CONV \TYPE {DNF_CONV : conv} \SYNOPSIS Converts a term already in negation normal form into disjunctive normal form. \DESCRIBE When applied to a term already in negation normal form (see {NNF_CONV}), meaning that all other propositional connectives have been eliminated in favour of disjunction, disjunction and negation, and negation is only applied to atomic formulas, {DNF_CONV} puts the term into an equivalent disjunctive normal form, which is a right-associated disjunction of conjunctions without repetitions. No reduction by subsumption is performed, however, e.g. from {a \/ a /\ b} to just {a}). \FAILURE Never fails; non-Boolean terms will just yield a reflexive theorem. \EXAMPLE { # DNF_CONV `(a \/ b) /\ (a \/ c /\ e)`;; val it : thm = |- (a \/ b) /\ (a \/ c /\ e) <=> a \/ a /\ b \/ a /\ c /\ e \/ b /\ c /\ e } \SEEALSO CNF_CONV, NNF_CONV, WEAK_CNF_CONV, WEAK_DNF_CONV. \ENDDOC hol-light/Help/EQF_ELIM.doc000066400000000000000000000006421303454263000155470ustar00rootroot00000000000000\DOC EQF_ELIM \TYPE {EQF_ELIM : thm -> thm} \SYNOPSIS Replaces equality with {F} by negation. \KEYWORDS rule, negation, falsity. \DESCRIBE { A |- tm <=> F --------------- EQF_ELIM A |- ~tm } \FAILURE Fails if the argument theorem is not of the form {A |- tm <=> F}. \EXAMPLE { # EQF_ELIM(REFL `F`);; val it : thm = |- ~F } \SEEALSO EQF_INTRO, EQT_ELIM, EQT_INTRO, NOT_ELIM, NOT_INTRO. \ENDDOC hol-light/Help/EQF_INTRO.doc000066400000000000000000000007131303454263000157130ustar00rootroot00000000000000\DOC EQF_INTRO \TYPE {EQF_INTRO : thm -> thm} \SYNOPSIS Converts negation to equality with {F}. \KEYWORDS rule, negation, falsity. \DESCRIBE { A |- ~tm --------------- EQF_INTRO A |- tm <=> F } \FAILURE Fails if the argument theorem is not a negation. \EXAMPLE { # let th = ASSUME `~p`;; val th : thm = ~p |- ~p # EQF_INTRO th;; val it : thm = ~p |- p <=> F } \SEEALSO EQF_ELIM, EQT_ELIM, EQT_INTRO, NOT_ELIM, NOT_INTRO. \ENDDOC hol-light/Help/EQT_ELIM.doc000066400000000000000000000006341303454263000155660ustar00rootroot00000000000000\DOC EQT_ELIM \TYPE {EQT_ELIM : thm -> thm} \SYNOPSIS Eliminates equality with {T}. \KEYWORDS rule, truth. \DESCRIBE { A |- tm <=> T --------------- EQT_ELIM A |- tm } \FAILURE Fails if the argument theorem is not of the form {A |- tm <=> T}. \EXAMPLE { # REFL `T`;; val it : thm = |- T <=> T # EQT_ELIM it;; val it : thm = |- T } \SEEALSO EQF_ELIM, EQF_INTRO, EQT_INTRO. \ENDDOC hol-light/Help/EQT_INTRO.doc000066400000000000000000000005171303454263000157330ustar00rootroot00000000000000\DOC EQT_INTRO \TYPE {EQT_INTRO : thm -> thm} \SYNOPSIS Introduces equality with {T}. \KEYWORDS rule, truth. \DESCRIBE { A |- tm --------------- EQF_INTRO A |- tm <=> T } \FAILURE Never fails. \EXAMPLE { # EQT_INTRO (REFL `2`);; val it : thm = |- 2 = 2 <=> T } \SEEALSO EQF_ELIM, EQF_INTRO, EQT_ELIM. \ENDDOC hol-light/Help/EQ_IMP_RULE.doc000066400000000000000000000014661303454263000161740ustar00rootroot00000000000000\DOC EQ_IMP_RULE \TYPE {EQ_IMP_RULE : thm -> thm * thm} \SYNOPSIS Derives forward and backward implication from equality of boolean terms. \KEYWORDS rule, implication, equality. \DESCRIBE When applied to a theorem {A |- t1 <=> t2}, where {t1} and {t2} both have type {bool}, the inference rule {EQ_IMP_RULE} returns the theorems {A |- t1 ==> t2} and {A |- t2 ==> t1}. { A |- t1 <=> t2 ----------------------------------- EQ_IMP_RULE A |- t1 ==> t2 A |- t2 ==> t1 } \FAILURE Fails unless the conclusion of the given theorem is an equation between boolean terms. \EXAMPLE { # SPEC_ALL CONJ_SYM;; val it : thm = |- t1 /\ t2 <=> t2 /\ t1 # EQ_IMP_RULE it;; val it : thm * thm = (|- t1 /\ t2 ==> t2 /\ t1, |- t2 /\ t1 ==> t1 /\ t2) } \SEEALSO EQ_MP, EQ_TAC, IMP_ANTISYM_RULE. \ENDDOC hol-light/Help/EQ_MP.doc000066400000000000000000000017271303454263000152340ustar00rootroot00000000000000\DOC EQ_MP \TYPE {EQ_MP : thm -> thm -> thm} \SYNOPSIS Equality version of the Modus Ponens rule. \KEYWORDS rule, equality, modus, ponens. \DESCRIBE When applied to theorems {A1 |- t1 <=> t2} and {A2 |- t1'} where {t1} and {t1'} are alpha-equivalent (for example, identical), the inference rule {EQ_MP} returns the theorem {A1 u A2 |- t2}. { A1 |- t1 <=> t2 A2 |- t1' ----------------------------- EQ_MP A1 u A2 |- t2 } \FAILURE Fails unless the first theorem is equational and its left side is the same as the conclusion of the second theorem (and is therefore of type {bool}), up to alpha-conversion. \EXAMPLE { # let th1 = SPECL [`p:bool`; `q:bool`] CONJ_SYM and th2 = ASSUME `p /\ q`;; val th1 : thm = |- p /\ q <=> q /\ p val th2 : thm = p /\ q |- p /\ q # EQ_MP th1 th2;; val it : thm = p /\ q |- q /\ p } \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO EQ_IMP_RULE, IMP_ANTISYM_RULE, MP, PROVE_HYP. \ENDDOC hol-light/Help/EQ_TAC.doc000066400000000000000000000011161303454263000153170ustar00rootroot00000000000000\DOC EQ_TAC \TYPE {EQ_TAC : tactic} \SYNOPSIS Reduces goal of equality of boolean terms to forward and backward implication. \KEYWORDS tactic, equality, implication. \DESCRIBE When applied to a goal {A ?- t1 <=> t2}, where {t1} and {t2} have type {bool}, the tactic {EQ_TAC} returns the subgoals {A ?- t1 ==> t2} and {A ?- t2 ==> t1}. { A ?- t1 <=> t2 ================================= EQ_TAC A ?- t1 ==> t2 A ?- t2 ==> t1 } \FAILURE Fails unless the conclusion of the goal is an equation between boolean terms. \SEEALSO EQ_IMP_RULE, IMP_ANTISYM_RULE. \ENDDOC hol-light/Help/ETA_CONV.doc000066400000000000000000000012511303454263000155610ustar00rootroot00000000000000\DOC ETA_CONV \TYPE {ETA_CONV : term -> thm} \SYNOPSIS Performs a toplevel eta-conversion. \KEYWORDS conversion, extentionality. \DESCRIBE {ETA_CONV} maps an eta-redex {`\x. t x`}, where {x} does not occur free in {t}, to the theorem {|- (\x. t x) = t}. \FAILURE Fails if the input term is not an eta-redex. \EXAMPLE { # ETA_CONV `\n. SUC n`;; val it : thm = |- (\n. SUC n) = SUC # ETA_CONV `\n. 1 + n`;; val it : thm = |- (\n. 1 + n) = (+) 1 # ETA_CONV `\n. n + 1`;; Exception: Failure "ETA_CONV". } \COMMENTS The same basic effect can be achieved by rewriting with {ETA_AX}. The theorem {ETA_AX} is one of HOL Light's three mathematical axioms. \ENDDOC hol-light/Help/EVERY.doc000066400000000000000000000014751303454263000152250ustar00rootroot00000000000000\DOC EVERY \TYPE {EVERY : tactic list -> tactic} \SYNOPSIS Sequentially applies all the tactics in a given list of tactics. \KEYWORDS tactical. \DESCRIBE When applied to a list of tactics {[t1; ... ;tn]}, and a goal {g}, the tactical {EVERY} applies each tactic in sequence to every subgoal generated by the previous one. This can be represented as: { EVERY [t1;...;tn] = t1 THEN ... THEN tn } \noindent If the tactic list is empty, the resulting tactic has no effect. \FAILURE The application of {EVERY} to a tactic list never fails. The resulting tactic fails iff any of the component tactics do. \COMMENTS It is possible to use {EVERY} instead of {THEN}, but probably stylistically inferior. {EVERY} is more useful when applied to a list of tactics generated by a function. \SEEALSO FIRST, MAP_EVERY, THEN. \ENDDOC hol-light/Help/EVERY_ASSUM.doc000066400000000000000000000015671303454263000161770ustar00rootroot00000000000000\DOC EVERY_ASSUM \TYPE {EVERY_ASSUM : thm_tactic -> tactic} \SYNOPSIS Sequentially applies all tactics given by mapping a function over the assumptions of a goal. \KEYWORDS theorem-tactical, assumption. \DESCRIBE When applied to a theorem-tactic {f} and a goal {({{A1;...;An}} ?- C)}, the {EVERY_ASSUM} tactical maps {f} over the list of assumptions then applies the resulting tactics, in sequence, to the goal: { EVERY_ASSUM f ({{A1;...;An}} ?- C) = (f(.. |- A1) THEN ... THEN f(.. |- An)) ({{A1;...;An}} ?- C) } \noindent If the goal has no assumptions, then {EVERY_ASSUM} has no effect. \FAILURE The application of {EVERY_ASSUM} to a theorem-tactic and a goal fails if the theorem-tactic fails when applied to any of the assumptions of the goal, or if any of the resulting tactics fail when applied sequentially. \SEEALSO ASSUM_LIST, MAP_EVERY, MAP_FIRST, THEN. \ENDDOC hol-light/Help/EVERY_CONV.doc000066400000000000000000000016461303454263000160520ustar00rootroot00000000000000\DOC EVERY_CONV \TYPE {EVERY_CONV : conv list -> conv} \SYNOPSIS Applies in sequence all the conversions in a given list of conversions. \KEYWORDS conversional. \DESCRIBE {EVERY_CONV [c1;...;cn] `t`} returns the result of applying the conversions {c1}, ..., {cn} in sequence to the term {`t`}. The conversions are applied in the order in which they are given in the list. In particular, if {ci `ti`} returns {|- ti=ti+1} for {i} from {1} to {n}, then {EVERY_CONV [c1;...;cn] `t1`} returns {|- t1=t(n+1)}. If the supplied list of conversions is empty, then {EVERY_CONV} returns the identity conversion. That is, {EVERY_CONV [] `t`} returns {|- t=t}. \FAILURE {EVERY_CONV [c1;...;cn] `t`} fails if any one of the conversions {c1}, ..., {cn} fails when applied in sequence as specified above. \EXAMPLE { # EVERY_CONV [BETA_CONV; NUM_ADD_CONV] `(\x. x + 2) 5`;; val it : thm = |- (\x. x + 2) 5 = 7 } \SEEALSO THENC. \ENDDOC hol-light/Help/EVERY_TCL.doc000066400000000000000000000014411303454263000157200ustar00rootroot00000000000000\DOC EVERY_TCL \TYPE {EVERY_TCL : thm_tactical list -> thm_tactical} \SYNOPSIS Composes a list of theorem-tacticals. \KEYWORDS theorem-tactical. \DESCRIBE When given a list of theorem-tacticals and a theorem, {EVERY_TCL} simply composes their effects on the theorem. The effect is: { EVERY_TCL [ttl1;...;ttln] = ttl1 THEN_TCL ... THEN_TCL ttln } \noindent In other words, if: { ttl1 ttac th1 = ttac th2 ... ttln ttac thn = ttac thn' } \noindent then: { EVERY_TCL [ttl1;...;ttln] ttac th1 = ttac thn' } \noindent If the theorem-tactical list is empty, the resulting theorem-tactical behaves in the same way as {ALL_THEN}, the identity theorem-tactical. \FAILURE The application to a list of theorem-tacticals never fails. \SEEALSO FIRST_TCL, ORELSE_TCL, REPEAT_TCL, THEN_TCL. \ENDDOC hol-light/Help/EXISTENCE.doc000066400000000000000000000012201303454263000156460ustar00rootroot00000000000000\DOC EXISTENCE \TYPE {EXISTENCE : thm -> thm} \SYNOPSIS Deduces existence from unique existence. \KEYWORDS rule, unique, existential. \DESCRIBE When applied to a theorem with a unique-existentially quantified conclusion, {EXISTENCE} returns the same theorem with normal existential quantification over the same variable. { A |- ?!x. p ------------- EXISTENCE A |- ?x. p } \FAILURE Fails unless the conclusion of the theorem is unique-existentially quantified. \EXAMPLE { # let th = MESON[] `?!n. n = m`;; ... val th : thm = |- ?!n. n = m # EXISTENCE th;; val it : thm = |- ?n. n = m } \SEEALSO EXISTS, SIMPLE_EXISTS. \ENDDOC hol-light/Help/EXISTS_EQUATION.doc000066400000000000000000000017471303454263000166610ustar00rootroot00000000000000\DOC EXISTS_EQUATION \TYPE {EXISTS_EQUATION : term -> thm -> thm} \SYNOPSIS Derives existence from explicit equational constraint. \DESCRIBE Given a term {`x = t`} where {x} does not occur free in {t}, and a theorem {A |- p[x]}, the rule {EXISTS_EQUATION} returns {A - {{x = t}} |- ?x. p[x]}. Normally, the equation {x = t} is one of the hypotheses of the theorem, so this rule allows one to derive an existence assertion ignoring the actual ``definition''. \FAILURE Fails if the term is not an equation, if the LHS is not a variable, or if the variable occurs free in the RHS. \EXAMPLE { # let th = (UNDISCH o EQT_ELIM o SIMP_CONV[ARITH]) `x = 3 ==> ODD(x) /\ x > 2`;; val th : thm = x = 3 |- ODD x /\ x > 2 # EXISTS_EQUATION `x = 3` th;; val it : thm = |- ?x. ODD x /\ x > 2 } \noindent Note that it is not obligatory for the term to be an assumption: { # EXISTS_EQUATION `x = 1` (REFL `x:num`);; val it : thm = |- ?x. x = x } \SEEALSO EXISTS, SIMPLE_EXISTS. \ENDDOC hol-light/Help/EXISTS_TAC.doc000066400000000000000000000015461303454263000160400ustar00rootroot00000000000000\DOC EXISTS_TAC \TYPE {EXISTS_TAC : term -> tactic} \SYNOPSIS Reduces existentially quantified goal to one involving a specific witness. \KEYWORDS tactic, quantifier, existential, choose, witness. \DESCRIBE When applied to a term {u} and a goal {A ?- ?x. t}, the tactic {EXISTS_TAC} reduces the goal to {A ?- t[u/x]} (substituting {u} for all free instances of {x} in {t}, with variable renaming if necessary to avoid free variable capture). { A ?- ?x. t ============= EXISTS_TAC `u` A ?- t[u/x] } \FAILURE Fails unless the goal's conclusion is existentially quantified and the term supplied has the same type as the quantified variable in the goal. \EXAMPLE The goal: { # g `?x. 1 < x /\ x < 3`;; } \noindent can be solved by: { # e(EXISTS_TAC `2` THEN ARITH_TAC);; val it : goalstack = No subgoals } \SEEALSO EXISTS, HINT_EXISTS_TAC. \ENDDOC hol-light/Help/EXISTS_UPPERCASE.doc000066400000000000000000000017251303454263000167570ustar00rootroot00000000000000\DOC EXISTS \TYPE {EXISTS : term * term -> thm -> thm} \SYNOPSIS Introduces existential quantification given a particular witness. \KEYWORDS rule, existential. \DESCRIBE When applied to a pair of terms and a theorem, the first term an existentially quantified pattern indicating the desired form of the result, and the second a witness whose substitution for the quantified variable gives a term which is the same as the conclusion of the theorem, {EXISTS} gives the desired theorem. { A |- p[u/x] ------------- EXISTS (`?x. p`,`u`) A |- ?x. p } \FAILURE Fails unless the substituted pattern is the same as the conclusion of the theorem. \EXAMPLE The following examples illustrate how it is possible to deduce different things from the same theorem: { # EXISTS (`?x. x <=> T`,`T`) (REFL `T`);; val it : thm = |- ?x. x <=> T # EXISTS (`?x:bool. x = x`,`T`) (REFL `T`);; val it : thm = |- ?x. x <=> x } \SEEALSO CHOOSE, EXISTS_TAC, SIMPLE_EXISTS. \ENDDOC hol-light/Help/EXPAND_CASES_CONV.doc000066400000000000000000000016031303454263000170460ustar00rootroot00000000000000\DOC EXPAND_CASES_CONV \TYPE {EXPAND_CASES_CONV : conv} \SYNOPSIS Expand a numerical range {`!i. i < n ==> P[i]`}. \DESCRIBE When applied to a term of the form {`!i. i < n ==> P[i]`} for some {P[i]} and a numeral {n}, the conversion {EXPAND_CASES_CONV} returns { |- (!i. i < n ==> P[i]) <=> P[0] /\ ... /\ P[n-1] } \FAILURE Fails if applied to a term that is not of the right form. \EXAMPLE { # EXPAND_CASES_CONV `(!n. n < 5 ==> ~(n = 0) ==> 12 MOD n = 0)`;; val it : thm = |- (!n. n < 5 ==> ~(n = 0) ==> 12 MOD n = 0) <=> (~(1 = 0) ==> 12 MOD 1 = 0) /\ (~(2 = 0) ==> 12 MOD 2 = 0) /\ (~(3 = 0) ==> 12 MOD 3 = 0) /\ (~(4 = 0) ==> 12 MOD 4 = 0) # (EXPAND_CASES_CONV THENC NUM_REDUCE_CONV) `(!n. n < 5 ==> ~(n = 0) ==> 12 MOD n = 0)`;; val it : thm = |- (!n. n < 5 ==> ~(n = 0) ==> 12 MOD n = 0) <=> T } \SEEALSO NUM_REDUCE_CONV. \ENDDOC hol-light/Help/EXPAND_TAC.doc000066400000000000000000000014241303454263000157730ustar00rootroot00000000000000\DOC EXPAND_TAC \TYPE {EXPAND_TAC : string -> tactic} \SYNOPSIS Expand an abbreviation in the hypotheses. \DESCRIBE The tactic {EXPAND_TAC "x"}, applied to a goal, looks for a hypothesis of the form {`t = x`} where {x} is a variable with the given name. It then replaces {x} by {t} throughout the conclusion of the goal. \FAILURE Fails if there is no suitable assumption in the goal. \EXAMPLE Consider the final goal in the example given for {ABBREV_TAC}: { val it : goalstack = 1 subgoal (1 total) 0 [`12345 + 12345 = n`] `n + f n = f n` } \noindent If we expand it, we get: { # e(EXPAND_TAC "n");; val it : goalstack = 1 subgoal (1 total) 0 [`12345 + 12345 = n`] `(12345 + 12345) + f (12345 + 12345) = f (12345 + 12345)` } \SEEALSO ABBREV_TAC. \ENDDOC hol-light/Help/FAIL_TAC.doc000066400000000000000000000017601303454263000155320ustar00rootroot00000000000000\DOC FAIL_TAC \TYPE {FAIL_TAC : string -> tactic} \SYNOPSIS Tactic that always fails, with the supplied string. \KEYWORDS tactic. \DESCRIBE Whatever goal it is applied to, {FAIL_TAC "s"} always fails with {Failure "s"}. \FAILURE The application of {FAIL_TAC} to a string never fails; the resulting tactic always fails. \EXAMPLE The following example uses the fact that if a tactic {t1} solves a goal, then the tactic {t1 THEN t2} never results in the application of {t2} to anything, because {t1} produces no subgoals. In attempting to solve the following goal: { # g `if x then T else T`;; } \noindent the tactic { # e(REWRITE_TAC[] THEN FAIL_TAC "Simple rewriting failed to solve goal");; Exception: Failure "Simple rewriting failed to solve goal". } \noindent fails with the message provided, whereas the following quietly solves the goal: { # e(REWRITE_TAC[COND_ID] THEN FAIL_TAC "Using that failed to solve goal");; val it : goalstack = No subgoals } \SEEALSO ALL_TAC, NO_TAC. \ENDDOC hol-light/Help/FIND_ASSUM.doc000066400000000000000000000033171303454263000160200ustar00rootroot00000000000000\DOC FIND_ASSUM \TYPE {FIND_ASSUM : thm_tactic -> term -> tactic} \SYNOPSIS Apply a theorem-tactic to the the first assumption equal to given term. \DESCRIBE The tactic {FIND_ASSUM ttac `t`} finds the first assumption whose conclusion is {t}, and applies {ttac} to it. If there is no such assumption, the call fails. \FAILURE Fails if there is no assumption the same as the given term, or if the theorem-tactic itself fails on the assumption. \EXAMPLE Suppose we set up this goal: { # g `0 = x /\ y = 0 ==> f(x + f(y)) = f(f(f(x) * x * y))`;; } \noindent and move the hypotheses into the assumption list: { # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`0 = x`] 1 [`y = 0`] `f (x + f y) = f (f (f x * x * y))` } We can't just use {ASM_REWRITE_TAC[]} to solve the goal, but we can more directly use the assumptions: { # e(FIND_ASSUM SUBST1_TAC `y = 0` THEN FIND_ASSUM (SUBST1_TAC o SYM) `0 = x`);; val it : goalstack = 1 subgoal (1 total) 0 [`0 = x`] 1 [`y = 0`] `f (0 + f 0) = f (f (f 0 * 0 * 0))` } \noindent after which simple rewriting solves the goal: { # e(REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES]);; val it : goalstack = No subgoals } \USES Identifying an assumption to use by explicitly quoting it. \COMMENTS A similar effect can be achieved by {ttac(ASSUME `t`)}. The use of {FIND_ASSUM} may be considered preferable because it immediately fails if there is no assumption {t}, whereas the {ASSUME} construct only generates a validity failure. Still, the the above example, it would have been a little briefer to write: { # e(REWRITE_TAC[ASSUME `y = 0`; SYM(ASSUME `0 = x`); ADD_CLAUSES; MULT_CLAUSES]);; } \SEEALSO ASSUME, VALID. \ENDDOC hol-light/Help/FIRST.doc000066400000000000000000000012701303454263000152130ustar00rootroot00000000000000\DOC FIRST \TYPE {FIRST : tactic list -> tactic} \SYNOPSIS Applies the first tactic in a tactic list that succeeds. \KEYWORDS tactical. \DESCRIBE When applied to a list of tactics {[t1;...;tn]}, and a goal {g}, the tactical {FIRST} tries applying the tactics to the goal until one succeeds. If the first tactic which succeeds is {tm}, then the effect is the same as just {tm}. Thus {FIRST} effectively behaves as follows: { FIRST [t1;...;tn] = t1 ORELSE ... ORELSE tn } \FAILURE The application of {FIRST} to a tactic list never fails. The resulting tactic fails iff all the component tactics do when applied to the goal, or if the tactic list is empty. \SEEALSO EVERY, ORELSE. \ENDDOC hol-light/Help/FIRST_ASSUM.doc000066400000000000000000000023501303454263000161630ustar00rootroot00000000000000\DOC FIRST_ASSUM \TYPE {FIRST_ASSUM : thm_tactic -> tactic} \SYNOPSIS Applied theorem-tactic to first assumption possible. \KEYWORDS theorem-tactical, assumption. \DESCRIBE The tactic { FIRST_ASSUM ttac ([A1; ...; An], g) } \noindent has the effect of applying the first tactic which can be produced by {ttac} from the assumptions {(.. |- A1)}, ..., {(.. |- An)} and which succeeds when applied to the goal. Failures of {ttac} to produce a tactic are ignored. The similar function {FIRST_X_ASSUM} is the same except that the assumption used is then removed from the goal. \FAILURE Fails if {ttac (.. |- Ai)} fails for every assumption {Ai}, or if the assumption list is empty, or if all the tactics produced by {ttac} fail when applied to the goal. \EXAMPLE The tactic { FIRST_ASSUM (fun asm -> CONTR_TAC asm ORELSE ACCEPT_TAC asm) } \noindent searches the assumptions for either a contradiction or the desired conclusion. The tactic { FIRST_ASSUM MATCH_MP_TAC } \noindent searches the assumption list for an implication whose conclusion matches the goal, reducing the goal to the antecedent of the corresponding instance of this implication. \SEEALSO ASSUM_LIST, EVERY, EVERY_ASSUM, FIRST, FIRST_X_ASSUM, MAP_EVERY, MAP_FIRST. \ENDDOC hol-light/Help/FIRST_CONV.doc000066400000000000000000000013121303454263000160350ustar00rootroot00000000000000\DOC FIRST_CONV \TYPE {FIRST_CONV : conv list -> conv} \SYNOPSIS Apply the first of the conversions in a given list that succeeds. \KEYWORDS conversional. \DESCRIBE {FIRST_CONV [c1;...;cn] `t`} returns the result of applying to the term {`t`} the first conversion {ci} that succeeds when applied to {`t`}. The conversions are tried in the order in which they are given in the list. \FAILURE {FIRST_CONV [c1;...;cn] `t`} fails if all the conversions {c1}, ..., {cn} fail when applied to the term {`t`}. {FIRST_CONV cs `t`} also fails if {cs} is the empty list. \EXAMPLE { # FIRST_CONV [NUM_ADD_CONV; NUM_MULT_CONV; NUM_EXP_CONV] `12 * 12`;; val it : thm = |- 12 * 12 = 144 } \SEEALSO ORELSEC. \ENDDOC hol-light/Help/FIRST_TCL.doc000066400000000000000000000013201303454263000157110ustar00rootroot00000000000000\DOC FIRST_TCL \TYPE {FIRST_TCL : thm_tactical list -> thm_tactical} \SYNOPSIS Applies the first theorem-tactical in a list that succeeds. \KEYWORDS theorem-tactical. \DESCRIBE When applied to a list of theorem-tacticals, a theorem-tactic and a theorem, {FIRST_TCL} returns the tactic resulting from the application of the first theorem-tactical to the theorem-tactic and theorem that succeeds. The effect is the same as: { FIRST_TCL [ttl1;...;ttln] = ttl1 ORELSE_TCL ... ORELSE_TCL ttln } \FAILURE {FIRST_TCL} fails iff each tactic in the list fails when applied to the theorem-tactic and theorem. This is trivially the case if the list is empty. \SEEALSO EVERY_TCL, ORELSE_TCL, REPEAT_TCL, THEN_TCL. \ENDDOC hol-light/Help/FIRST_X_ASSUM.doc000066400000000000000000000022211303454263000164470ustar00rootroot00000000000000\DOC FIRST_X_ASSUM \TYPE {FIRST_X_ASSUM : thm_tactic -> tactic} \SYNOPSIS Applies theorem-tactic to first assumption possible, extracting assumption. \KEYWORDS theorem-tactical, assumption. \DESCRIBE The tactic { FIRST_X_ASSUM ttac ([A1; ...; An], g) } \noindent has the effect of applying the first tactic which can be produced by {ttac} from the assumptions {(.. |- A1)}, ..., {(.. |- An)} and which succeeds when applied to the goal with that assumption removed. Failures of {ttac} to produce a tactic are ignored. The similar function {FIRST_ASSUM} is the same except that the assumption used is not removed from the goal. \FAILURE Fails if {ttac (.. |- Ai)} fails for every assumption {Ai}, or if the assumption list is empty, or if all the tactics produced by {ttac} fail when applied to the goal. \EXAMPLE The tactic { FIRST_X_ASSUM MATCH_MP_TAC } \noindent searches the assumption list for an implication whose conclusion matches the goal, removing that assumption and reducing the goal to the antecedent of the corresponding instance of this implication. \SEEALSO ASSUM_LIST, EVERY, EVERY_ASSUM, FIRST, FIRST_ASSUM, MAP_EVERY, MAP_FIRST. \ENDDOC hol-light/Help/FIX_TAC.doc000066400000000000000000000033631303454263000154460ustar00rootroot00000000000000\DOC FIX_TAC \TYPE {FIX_TAC : string -> tactic} \SYNOPSIS Fixes universally quantified variables in goal. \DESCRIBE Given a string {s} indicating a sequence of variable names, {FIX_TAC s} performs the introduction of the indicated universally quantified variables. It is not required to specify the variables in any particular order. The syntax for the string argument s allows the following patterns: \begin{{itemize}} \item a variable name {varname} (meaning introduce the variable varname) \item a pattern {[newname/varname]} (meaning introduce {varname} and call it {newname}) \item a pattern {[newname]} (meaning introduce the outermost variable and call it {newname}) \item a final {*} (meaning introduce the remaining outermost universal quantified variables) \end{{itemize}} \FAILURE Fails if the string specifying the variables is ill-formed or if some of the indicated variables are not present as outer universal quantifiers in the goal. \EXAMPLE Here we fix just the variable {a}: { # g `!x a. a + x = x + a`;; # e (FIX_TAC "a");; val it : goalstack = 1 subgoal (1 total) `!x. a + x = x + a` } \noindent while here we rename one of the variables and fix all the others: { # g `!a b x. a + b + x = (a + b) + x`;; # e (FIX_TAC "[d/x] *");; val it : goalstack = 1 subgoal (1 total) `a + b + d = (a + b) + d` } Here we fix an automatically generated variable and choose a meaningful name for it { # g `(@x. x = 0) + 0 = 0`;; # e SELECT_ELIM_TAC;; val it : goalstack = 1 subgoal (1 total) `!_75605. (!x. x = 0 ==> _75605 = 0) ==> _75605 + 0 = 0` # e (FIX_TAC "[y]");; val it : goalstack = 1 subgoal (1 total) `(!x. x = 0 ==> y = 0) ==> y + 0 = 0` } \SEEALSO GEN, GEN_TAC, INTRO_TAC, STRIP_TAC, X_GEN_TAC. \ENDDOC hol-light/Help/FORALL_UNWIND_CONV.doc000066400000000000000000000020431303454263000172130ustar00rootroot00000000000000\DOC FORALL_UNWIND_CONV \TYPE {FORALL_UNWIND_CONV : term -> thm} \SYNOPSIS Eliminates universally quantified variables that are equated to something. \KEYWORDS conversion. \DESCRIBE The conversion {FORALL_UNWIND_CONV}, applied to a formula with one or more universal quantifiers around an implication, eliminates any quantifiers where the antecedent of the implication contains a conjunct equating its variable to some other term (with that variable not free in it). \FAILURE {FORALL_UNWIND_CONV tm} fails if {tm} is not reducible according to that description. \EXAMPLE { # FORALL_UNWIND_CONV `!a b c d. a + 1 = b /\ b + 1 = c + 1 /\ d = e ==> a + b + c + d + e = 2`;; val it : thm = |- (!a b c d. a + 1 = b /\ b + 1 = c + 1 /\ d = e ==> a + b + c + d + e = 2) <=> (!a c. (a + 1) + 1 = c + 1 ==> a + (a + 1) + c + e + e = 2) # FORALL_UNWIND_CONV `!a b c. a = b /\ b = c ==> a + b = b + c`;; val it : thm = |- (!a b c. a = b /\ b = c ==> a + b = b + c) <=> (!c. c + c = c + c) } \SEEALSO UNWIND_CONV. \ENDDOC hol-light/Help/FREEZE_THEN.doc000066400000000000000000000022721303454263000161250ustar00rootroot00000000000000\DOC FREEZE_THEN \TYPE {FREEZE_THEN : thm_tactical} \SYNOPSIS `Freezes' a theorem to prevent instantiation of its free variables. \KEYWORDS theorem-tactic, selective, free. \DESCRIBE {FREEZE_THEN} expects a tactic-generating function {f:thm->tactic} and a theorem {(A1 |- w)} as arguments. The tactic-generating function {f} is applied to the theorem {(w |- w)}. If this tactic generates the subgoal: { A ?- t ========= f (w |- w) A ?- t1 } \noindent then applying {FREEZE_THEN f (A1 |- w)} to the goal {(A ?- t)} produces the subgoal: { A ?- t ========= FREEZE_THEN f (A1 |- w) A ?- t1 } \noindent Since the term {w} is a hypothesis of the argument to the function {f}, none of the free variables present in {w} may be instantiated or generalized. The hypothesis is discharged by {PROVE_HYP} upon the completion of the proof of the subgoal. \FAILURE Failures may arise from the tactic-generating function. An invalid tactic arises if the hypotheses of the theorem are not alpha-convertible to assumptions of the goal. \USES Used in serious proof hacking to limit the matches achievable by rewriting etc. \SEEALSO ASSUME, IMP_RES_TAC, PROVE_HYP, RES_TAC, REWR_CONV. \ENDDOC hol-light/Help/F_F.doc000066400000000000000000000004251303454263000147570ustar00rootroot00000000000000\DOC F_F \TYPE {(F_F) : ('a -> 'b) -> ('c -> 'd) -> 'a * 'c -> 'b * 'd} \SYNOPSIS Infix operator. Applies two functions to a pair: {(f F_F g) (x,y)} = {(f x, g y)}. \KEYWORDS \LIBRARY \DESCRIBE \FAILURE Never fails. \EXAMPLE \USES \COMMENTS \SEEALSO f_f_ \ENDDOC hol-light/Help/GABS_CONV.doc000066400000000000000000000020141303454263000156620ustar00rootroot00000000000000\DOC GABS_CONV \TYPE {GABS_CONV : conv -> term -> thm} \SYNOPSIS Applies a conversion to the body of a generalized abstraction. \DESCRIBE If {c} is a conversion that maps a term {`t`} to the theorem {|- t = t'}, then the conversion {ABS_CONV c} maps generalized abstractions of the form {`\vs. t`} to theorems of the form: { |- (\vs. t) = (\vs. t') } \noindent That is, {ABS_CONV c `\vs. t`} applies {c} to the body of the generalized abstraction {`\vs. t`}. It is permissible to use it on a basic abstraction, in which case the effect is the same as {ABS_CONV}. \FAILURE Fails if applied to a term that is not a generalized abstraction (or a basic one), or if the conversion {c} fails when applied to the term {t}, or if the theorem returned has assumptions in which one of the variables in the abstraction varstruct is free. \EXAMPLE { # GABS_CONV SYM_CONV `\(x,y,z). x + y + z = 7`;; val it : thm = |- (\(x,y,z). x + y + z = 7) = (\(x,y,z). 7 = x + y + z) } \SEEALSO ABS_CONV, RAND_CONV, RATOR_CONV, SUB_CONV. \ENDDOC hol-light/Help/GEN.doc000066400000000000000000000017651303454263000147460ustar00rootroot00000000000000\DOC GEN \TYPE {GEN : term -> thm -> thm} \SYNOPSIS Generalizes the conclusion of a theorem. \KEYWORDS rule, quantifier, universal. \DESCRIBE When applied to a term {x} and a theorem {A |- t}, the inference rule {GEN} returns the theorem {A |- !x. t}, provided {x} is a variable not free in any of the assumptions. There is no compulsion that {x} should be free in {t}. { A |- t ------------ GEN `x` [where x is not free in A] A |- !x. t } \FAILURE Fails if {x} is not a variable, or if it is free in any of the assumptions. \EXAMPLE This is a basic example: { # GEN `x:num` (REFL `x:num`);; val it : thm = |- !x. x = x } \noindent while the following example shows how the above side-condition prevents the derivation of the theorem {x <=> T |- !x. x <=> T}, which is invalid. { # let t = ASSUME `x <=> T`;; val t : thm = x <=> T |- x <=> T # GEN `x:bool` t;; Exception: Failure "GEN". } \SEEALSO GENL, GEN_ALL, GEN_TAC, SPEC, SPECL, SPEC_ALL, SPEC_TAC. \ENDDOC hol-light/Help/GENERAL_REWRITE_CONV.doc000066400000000000000000000013361303454263000174320ustar00rootroot00000000000000\DOC GENERAL_REWRITE_CONV \TYPE {GENERAL_REWRITE_CONV : bool -> (conv -> conv) -> gconv net -> thm list -> conv} \SYNOPSIS Rewrite with theorems as well as an existing net. \DESCRIBE The call {GENERAL_REWRITE_CONV b cnvl net thl} will regard {thl} as rewrite rules, and if {b = true}, also potentially as conditional rewrite rules. These extra rules will be incorporated into the existing {net}, and rewriting applied with a search strategy {cnvl} (e.g. {DEPTH_CONV}). \COMMENTS This is mostly for internal use, but it can sometimes be more efficient when rewriting with large sets of theorems repeatedly if they are first composed into a net and then augmented like this. \SEEALSO GEN_REWRITE_CONV, REWRITES_CONV. \ENDDOC hol-light/Help/GENL.doc000066400000000000000000000016471303454263000150610ustar00rootroot00000000000000\DOC GENL \TYPE {GENL : term list -> thm -> thm} \SYNOPSIS Generalizes zero or more variables in the conclusion of a theorem. \KEYWORDS rule, quantifier, universal. \DESCRIBE When applied to a term list {[x1;...;xn]} and a theorem {A |- t}, the inference rule {GENL} returns the theorem {A |- !x1...xn. t}, provided none of the variables {xi} are free in any of the assumptions. It is not necessary that any or all of the {xi} should be free in {t}. { A |- t ------------------ GENL `[x1;...;xn]` [where no xi is free in A] A |- !x1...xn. t } \FAILURE Fails unless all the terms in the list are variables, none of which are free in the assumption list. \EXAMPLE { # SPEC `m + p:num` ADD_SYM;; val it : thm = |- !n. (m + p) + n = n + m + p # GENL [`m:num`; `p:num`] it;; val it : thm = |- !m p n. (m + p) + n = n + m + p } \SEEALSO GEN, GEN_ALL, GEN_TAC, SPEC, SPECL, SPEC_ALL, SPEC_TAC. \ENDDOC hol-light/Help/GEN_ALL.doc000066400000000000000000000013501303454263000154240ustar00rootroot00000000000000\DOC GEN_ALL \TYPE {GEN_ALL : thm -> thm} \SYNOPSIS Generalizes the conclusion of a theorem over its own free variables. \KEYWORDS rule, quantifier, universal. \DESCRIBE When applied to a theorem {A |- t}, the inference rule {GEN_ALL} returns the theorem {A |- !x1...xn. t}, where the {xi} are all the variables, if any, which are free in {t} but not in the assumptions. { A |- t ------------------ GEN_ALL A |- !x1...xn. t } \FAILURE Never fails. \EXAMPLE { # let th = ARITH_RULE `x < y ==> 2 * x + y + 1 < 3 * y`;; val th : thm = |- x < y ==> 2 * x + y + 1 < 3 * y # GEN_ALL th;; val it : thm = |- !x y. x < y ==> 2 * x + y + 1 < 3 * y } \SEEALSO GEN, GENL, GEN_ALL, SPEC, SPECL, SPEC_ALL, SPEC_TAC. \ENDDOC hol-light/Help/GEN_ALPHA_CONV.doc000066400000000000000000000016031303454263000164670ustar00rootroot00000000000000\DOC GEN_ALPHA_CONV \TYPE {GEN_ALPHA_CONV : term -> term -> thm} \SYNOPSIS Renames the bound variable of an abstraction or binder. \DESCRIBE The conversion {GEN_ALPHA_CONV} provides alpha conversion for lambda abstractions of the form {`\x. t`}, as well as other terms of the form {`b (\x. t)`} such as quantifiers and other binders. (Note that whether {b} is a constant or parses as a binder is irrelevant, though this is usually the case in applications.) The call {GEN_ALPHA_CONV `y` `\x. t`} returns { |- (\x. t) = (\y. t[y/x]) } \noindent while {GEN_ALPHA_CONV `y` `b (\x. t)`} returns { |- b (\x. t) = b (\y. t[y/x]) } \FAILURE {GEN_ALPHA_CONV `y` tm} fails if {y} is not a variable, or if {tm} does not have one of the forms {`\x. t`} or {`b (\x. t)`}, or if the types of {x} and {y} differ, or if {y} is already free in the body {t}. \SEEALSO alpha, ALPHA, ALPHA_CONV. \ENDDOC hol-light/Help/GEN_BETA_CONV.doc000066400000000000000000000022261303454263000163570ustar00rootroot00000000000000\DOC GEN_BETA_CONV \TYPE {GEN_BETA_CONV : term -> thm} \SYNOPSIS Beta-reduces general beta-redexes (e.g. paired ones). \KEYWORDS conversion. \DESCRIBE The conversion {GEN_BETA_CONV} will perform beta-reduction of simple beta-redexes in the manner of {BETA_CONV}, or of generalized beta-redexes such as paired redexes. \FAILURE {GEN_BETA_CONV tm} fails if {tm} is neither a simple nor a tupled beta-redex. \EXAMPLE The following examples show the action of {GEN_BETA_CONV} on tupled redexes and others: { # GEN_BETA_CONV `(\x. x + 1) 2`;; val it : thm = |- (\x. x + 1) 2 = 2 + 1 # GEN_BETA_CONV `(\(x,y,z). x + y + z) (1,2,3)`;; val it : thm = |- (\(x,y,z). x + y + z) (1,2,3) = 1 + 2 + 3 # GEN_BETA_CONV `(\[a;b;c]. b) [1;2;3]`;; val it : thm = |- (\[a; b; c]. b) [1; 2; 3] = 2 } However, it will fail if there is a mismatch between the varstruct and the argument, or if it is unable to make sense of the generalized abstraction: { # GEN_BETA_CONV `(\(SUC n). n) 3`;; Exception: Failure "term_pmatch". # GEN_BETA_CONV `(\(x,y,z). x + y + z) (1,x)`;; Exception: Failure "dest_comb: not a combination". } \SEEALSO BETA_CONV, MATCH_CONV. \ENDDOC hol-light/Help/GEN_MESON_TAC.doc000066400000000000000000000026561303454263000163760ustar00rootroot00000000000000\DOC GEN_MESON_TAC \TYPE {GEN_MESON_TAC : int -> int -> int -> thm list -> tactic} \SYNOPSIS First-order proof search with specified search limits and increment. \DESCRIBE This is a slight generalization of the usual tactics for first-order proof search. Normally {MESON}, {MESON_TAC} and {ASM_MESON_TAC} explore the search space by successively increasing a size limit from 0, increasing it by 1 per step and giving up when a depth of 50 is reached. The more general tactic {GEN_MESON_TAC} allows the user to specify the starting, finishing and stepping value, but is otherwise identical to {ASM_MESON_TAC}. In fact, that is defined as: { # let ASM_MESON_TAC = GEN_MESON_TAC 0 50 1;; } \FAILURE If the goal is unprovable, {GEN_MESON_TAC} will fail, though not necessarily in a feasible amount of time. \USES Normally, the defaults built into {MESON_TAC} and {ASM_MESON_TAC} are reasonably effective. However, very occasionally a goal exhibits a small search space yet still requires a deep proof, so you may find {GEN_MESON_TAC} with a larger ``maximum'' value than 50 useful. Another potential use is to start the search at a depth that you know will succeed, to reduce the search time when a proof is re-run. However, the inconvenience of doing this is seldom repaid by a dramatic improvement in performance, since exploration is normally at least exponential with the size bound. \SEEALSO ASM_MESON_TAC, MESON, MESON_TAC, METIS_TAC. \ENDDOC hol-light/Help/GEN_NNF_CONV.doc000066400000000000000000000033711303454263000162670ustar00rootroot00000000000000\DOC GEN_NNF_CONV \TYPE {GEN_NNF_CONV : bool -> conv * (term -> thm * thm) -> conv} \SYNOPSIS General NNF (negation normal form) conversion. \DESCRIBE The function {GEN_NNF_CONV} is a highly general conversion for putting a term in `negation normal form' (NNF). This means that other propositional connectives are eliminated in favour of conjunction (`{/\}'), disjunction (`{\/}') and negation (`{~}'), and the negations are pushed down to the level of atomic formulas, also through universal and existential quantifiers, with double negations eliminated. This function is very general. The first, boolean, argument determines how logical equivalences `{p <=> q}' are split. If the flag is {true}, toplevel equivalences are split ``conjunctively'' into `{(p \/ ~q) /\ (~p \/ q)}', while if it is false they are split ``disjunctively'' into `{(p /\ q) \/ (~p /\ ~q)}'. At subformulas, the effect is modified appropriately in order to make the resulting formula simpler in conjunctive normal form (if the flag is true) or disjunctive normal form (if the flag is false). The second argument has two components. The first is a conversion to apply to literals, that is atomic formulas or their negations. The second is a slightly more elaborate variant of the same thing, taking an atomic formula {p} and returning desired equivalences for both {p} and {~p} in a pair. This interface avoids multiple recomputations in terms involving many nested logical equivalences, where otherwise the core conversion would be called several times. \FAILURE Never fails but may have no effect. \COMMENTS The simple functions like {NNF_CONV} should be adequate most of the time, with this somewhat intricate interface being reserved for special situations. \SEEALSO NNF_CONV, NNFC_CONV. \ENDDOC hol-light/Help/GEN_PART_MATCH.doc000066400000000000000000000027751303454263000165120ustar00rootroot00000000000000\DOC GEN_PART_MATCH \TYPE {GEN_PART_MATCH : (term -> term) -> thm -> term -> thm} \SYNOPSIS Instantiates a theorem by matching part of it to a term. \DESCRIBE When applied to a `selector' function of type {term -> term}, a theorem and a term: { GEN_PART_MATCH fn (A |- !x1...xn. t) tm } \noindent the function {GEN_PART_MATCH} applies {fn} to {t'} (the result of specializing universally quantified variables in the conclusion of the theorem), and attempts to match the resulting term to the argument term {tm}. If it succeeds, the appropriately instantiated version of the theorem is returned. Limited higher-order matching is supported, and some attempt is made to maintain bound variable names in higher-order matching. Unlike {PART_MATCH}, free variables in the initial theorem that are unconstrained by the instantiation will be renamed if necessary to avoid clashes with determined free variables. \FAILURE Fails if the selector function {fn} fails when applied to the instantiated theorem, or if the match fails with the term it has provided. \EXAMPLE See {MATCH_MP_TAC} for more basic examples. The following illustrates the difference with that function { # let th = ARITH_RULE `m = n ==> m + p = n + p`;; val th : thm = |- m = n ==> m + p = n + p # PART_MATCH lhand th `n:num = p`;; val it : thm = |- n = p ==> n + p = p + p # GEN_PART_MATCH lhand th `n:num = p`;; val it : thm = |- n = p ==> n + p' = p + p' } \SEEALSO INST_TYPE, INST_TY_TERM, MATCH_MP, PART_MATCH, REWR_CONV, term_match. \ENDDOC hol-light/Help/GEN_REAL_ARITH.doc000066400000000000000000000042651303454263000164760ustar00rootroot00000000000000\DOC GEN_REAL_ARITH \TYPE {GEN_REAL_ARITH : ((thm list * thm list * thm list -> positivstellensatz -> thm) -> thm list * thm list * thm list -> thm) -> term -> thm} \SYNOPSIS Initial normalization and proof reconstruction wrapper for real decision procedure. \DESCRIBE The function {GEN_REAL_ARITH} takes two arguments, the first of which is an underlying `prover', and the second a term to prove. This function is mainly intended for internal use: the function {REAL_ARITH} is essentially implemented as { GEN_REAL_ARITH REAL_LINEAR_PROVER } The wrapper {GEN_REAL_ARITH} performs various initial normalizations, such as eliminating {max}, {min} and {abs}, and passes to the prover a proof reconstruction function, say {reconstr}, and a triple of theorem lists to refute. The theorem lists are respectively a list of equations of the form {A_i |- p_i = &0}, a list of non-strict inequalities of the form {B_j |- q_i >= &0}, and a list of strict inequalities of the form {C_k |- r_k > &0}, with both sides being real in each case. The underlying prover merely needs to find a ``Positivstellensatz'' refutation, and pass the triple of theorems actually used and the Positivstellensatz refutation back to the reconstruction function {reconstr}. A Positivstellensatz refutation is essentially a representation of how to add and multiply equalities or inequalities chosen from the list to reach a trivially false equation or inequality such as {&0 > &0}. Note that the underlying prover may choose to augment the list of inequalities before proceeding with the proof, e.g. {REAL_LINEAR_PROVER} adds theorems {|- &0 <= &n} for relevant numeral terms {&n}. This is why the interface passes in a reconstruction function rather than simply expecting a Positivstellensatz refutation back. \FAILURE Never fails at this stage, though it may fail when subsequently applied to a term. \EXAMPLE As noted, the built-in decision procedure {REAL_ARITH} is a simple application. See also the file {Examples/sos.ml}, where a more sophisticated nonlinear prover is plugged into {GEN_REAL_ARITH} in place of {REAL_LINEAR_PROVER}. \COMMENTS Mainly intended for experts. \SEEALSO REAL_ARITH, REAL_LINEAR_PROVER, REAL_POLY_CONV. \ENDDOC hol-light/Help/GEN_REWRITE_CONV.doc000066400000000000000000000052431303454263000167670ustar00rootroot00000000000000\DOC GEN_REWRITE_CONV \TYPE {GEN_REWRITE_CONV : (conv -> conv) -> thm list -> conv} \SYNOPSIS Rewrites a term, selecting terms according to a user-specified strategy. \KEYWORDS conversion. \DESCRIBE Rewriting in HOL is based on the use of equational theorems as left-to-right replacements on the subterms of an object theorem. This replacement is mediated by the use of {REWR_CONV}, which finds matches between left-hand sides of given equations in a term and applies the substitution. Equations used in rewriting are obtained from the theorem lists given as arguments to the function. These are at first transformed into a form suitable for rewriting. Conjunctions are separated into individual rewrites. Theorems with conclusions of the form {`~t`} are transformed into the corresponding equations {`t = F`}. Theorems {`t`} which are not equations are cast as equations of form {`t = T`}. If a theorem is used to rewrite a term, its assumptions are added to the assumptions of the returned theorem. The matching involved uses variable instantiation. Thus, all free variables are generalized, and terms are instantiated before substitution. Theorems may have universally quantified variables. The theorems with which rewriting is done are divided into two groups, to facilitate implementing other rewriting tools. However, they are considered in an order-independent fashion. (That is, the ordering is an implementation detail which is not specified.) The search strategy for finding matching subterms is the first argument to the rule. Matching and substitution may occur at any level of the term, according to the specified search strategy: the whole term, or starting from any subterm. The search strategy also specifies the depth of the search: recursively up to an arbitrary depth until no matches occur, once over the selected subterm, or any more complex scheme. \FAILURE {GEN_REWRITE_CONV} fails if the search strategy fails. It may also cause a non-terminating sequence of rewrites, depending on the search strategy used. \USES This conversion is used in the system to implement all other rewritings conversions, and may provide a user with a method to fine-tune rewriting of terms. \EXAMPLE Suppose we have a term of the form: { `(1 + 2) + 3 = (3 + 1) + 2` } \noindent and we would like to rewrite the left-hand side with the theorem {ADD_SYM} without changing the right hand side. This can be done by using: { GEN_REWRITE_CONV (RATOR_CONV o ONCE_DEPTH_CONV) [ADD_SYM] mythm } \noindent Other rules, such as {ONCE_REWRITE_CONV}, would match and substitute on both sides, which would not be the desirable result. \SEEALSO ONCE_REWRITE_CONV, PURE_REWRITE_CONV, REWR_CONV, REWRITE_CONV. \ENDDOC hol-light/Help/GEN_REWRITE_RULE.doc000066400000000000000000000054061303454263000167720ustar00rootroot00000000000000\DOC GEN_REWRITE_RULE \TYPE {GEN_REWRITE_RULE : (conv -> conv) -> thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem, selecting terms according to a user-specified strategy. \KEYWORDS rule. \DESCRIBE Rewriting in HOL is based on the use of equational theorems as left-to-right replacements on the subterms of an object theorem. This replacement is mediated by the use of {REWR_CONV}, which finds matches between left-hand sides of given equations in a term and applies the substitution. Equations used in rewriting are obtained from the theorem lists given as arguments to the function. These are at first transformed into a form suitable for rewriting. Conjunctions are separated into individual rewrites. Theorems with conclusions of the form {`~t`} are transformed into the corresponding equations {`t = F`}. Theorems {`t`} which are not equations are cast as equations of form {`t = T`}. If a theorem is used to rewrite the object theorem, its assumptions are added to the assumptions of the returned theorem, unless they are alpha-convertible to existing assumptions. The matching involved uses variable instantiation. Thus, all free variables are generalized, and terms are instantiated before substitution. Theorems may have universally quantified variables. The theorems with which rewriting is done are divided into two groups, to facilitate implementing other rewriting tools. However, they are considered in an order-independent fashion. (That is, the ordering is an implementation detail which is not specified.) The search strategy for finding matching subterms is the first argument to the rule. Matching and substitution may occur at any level of the term, according to the specified search strategy: the whole term, or starting from any subterm. The search strategy also specifies the depth of the search: recursively up to an arbitrary depth until no matches occur, once over the selected subterm, or any more complex scheme. \FAILURE {GEN_REWRITE_RULE} fails if the search strategy fails. It may also cause a non-terminating sequence of rewrites, depending on the search strategy used. \USES This rule is used in the system to implement all other rewriting rules, and may provide a user with a method to fine-tune rewriting of theorems. \EXAMPLE Suppose we have a theorem of the form: { mythm = |- (1 + 2) + 3 = (3 + 1) + 2 } \noindent and we would like to rewrite the left-hand side with the theorem {ADD_SYM} without changing the right hand side. This can be done by using: { GEN_REWRITE_RULE (RATOR_CONV o ONCE_DEPTH_CONV) [] [ADD_SYM] mythm } \noindent Other rules, such as {ONCE_REWRITE_RULE}, would match and substitute on both sides, which would not be the desirable result. \SEEALSO ASM_REWRITE_RULE, ONCE_REWRITE_RULE, PURE_REWRITE_RULE, REWR_CONV, REWRITE_RULE. \ENDDOC hol-light/Help/GEN_REWRITE_TAC.doc000066400000000000000000000061421303454263000166300ustar00rootroot00000000000000\DOC GEN_REWRITE_TAC \TYPE {GEN_REWRITE_TAC : (conv -> conv) -> thm list -> tactic} \SYNOPSIS Rewrites a goal, selecting terms according to a user-specified strategy. \KEYWORDS tactic. \DESCRIBE Distinct rewriting tactics differ in the search strategies used in finding subterms on which to apply substitutions, and the built-in theorems used in rewriting. In the case of {REWRITE_TAC}, this is a recursive traversal starting from the body of the goal's conclusion part, while in the case of {ONCE_REWRITE_TAC}, for example, the search stops as soon as a term on which a substitution is possible is found. {GEN_REWRITE_TAC} allows a user to specify a more complex strategy for rewriting. The basis of pattern-matching for rewriting is the notion of conversions, through the application of {REWR_CONV}. Conversions are rules for mapping terms with theorems equating the given terms to other semantically equivalent ones. When attempting to rewrite subterms recursively, the use of conversions (and therefore rewrites) can be automated further by using functions which take a conversion and search for instances at which they are applicable. Examples of these functions are {ONCE_DEPTH_CONV} and {RAND_CONV}. The first argument to {GEN_REWRITE_TAC} is such a function, which specifies a search strategy; i.e. it specifies how subterms (on which substitutions are allowed) should be searched for. The second argument is a list of theorems used for rewriting. The order in which these are used is not specified. The theorems need not be in equational form: negated terms, say {"~ t"}, are transformed into the equivalent equational form {"t = F"}, while other non-equational theorems with conclusion of form {"t"} are cast as the corresponding equations {"t = T"}. Conjunctions are separated into the individual components, which are used as distinct rewrites. \FAILURE {GEN_REWRITE_TAC} fails if the search strategy fails. It may also cause a non-terminating sequence of rewrites, depending on the search strategy used. The resulting tactic is invalid when a theorem which matches the goal (and which is thus used for rewriting it with) has a hypothesis which is not alpha-convertible to any of the assumptions of the goal. Applying such an invalid tactic may result in a proof of a theorem which does not correspond to the original goal. \USES Detailed control of rewriting strategy, allowing a user to specify a search strategy. \EXAMPLE Given a goal such as: { ?- a - (b + c) = a - (c + b) } \noindent we may want to rewrite only one side of it with a theorem, say {ADD_SYM}. Rewriting tactics which operate recursively result in divergence; the tactic {ONCE_REWRITE_TAC [ADD_SYM]} rewrites on both sides to produce the following goal: { ?- a - (c + b) = a - (b + c) } \noindent as {ADD_SYM} matches at two positions. To rewrite on only one side of the equation, the following tactic can be used: { GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] } \noindent which produces the desired goal: { ?- a - (c + b) = a - (c + b) } \SEEALSO ASM_REWRITE_TAC, GEN_REWRITE_RULE, ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWR_CONV, REWRITE_TAC, \ENDDOC hol-light/Help/GEN_SIMPLIFY_CONV.doc000066400000000000000000000011321303454263000170730ustar00rootroot00000000000000\DOC GEN_SIMPLIFY_CONV \TYPE {GEN_SIMPLIFY_CONV : strategy -> simpset -> int -> thm list -> conv} \SYNOPSIS General simplification with given strategy and simpset and theorems. \DESCRIBE The call {GEN_SIMPLIFY_CONV strat ss n thl} incorporates the rewrites and conditional rewrites derived from {thl} into the simpset {ss}, then simplifies using that simpset, controlling the traversal of the term by {strat}, and starting at level {n}. \FAILURE Never fails unless some component is malformed. \SEEALSO GEN_REWRITE_CONV, ONCE_SIMPLIFY_CONV, SIMPLIFY_CONV, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/GEN_TAC.doc000066400000000000000000000014431303454263000154260ustar00rootroot00000000000000\DOC GEN_TAC \TYPE {GEN_TAC : tactic} \SYNOPSIS Strips the outermost universal quantifier from the conclusion of a goal. \KEYWORDS tactic, quantifier, universal. \DESCRIBE When applied to a goal {A ?- !x. t}, the tactic {GEN_TAC} reduces it to {A ?- t[x'/x]} where {x'} is a variant of {x} chosen to avoid clashing with any variables free in the goal's assumption list. Normally {x'} is just {x}. { A ?- !x. t ============== GEN_TAC A ?- t[x'/x] } \FAILURE Fails unless the goal's conclusion is universally quantified. \USES The tactic {REPEAT GEN_TAC} strips away any universal quantifiers, and is commonly used before tactics relying on the underlying term structure. \SEEALSO FIX_TAC, GEN, GENL, GEN_ALL, INTRO_TAC, SPEC, SPECL, SPEC_ALL, SPEC_TAC, STRIP_TAC, X_GEN_TAC. \ENDDOC hol-light/Help/GSYM.doc000066400000000000000000000014631303454263000151070ustar00rootroot00000000000000\DOC GSYM \TYPE {GSYM : thm -> thm} \SYNOPSIS Reverses the first equation(s) encountered in a top-down search. \KEYWORDS rule, symmetry, equality. \DESCRIBE The inference rule {GSYM} reverses the first equation(s) encountered in a top-down search of the conclusion of the argument theorem. An equation will be reversed iff it is not a proper subterm of another equation. If a theorem contains no equations, it will be returned unchanged. { A |- ..(s1 = s2)...(t1 = t2).. -------------------------------- GSYM A |- ..(s2 = s1)...(t2 = t1).. } \FAILURE Never fails, and never loops infinitely. \EXAMPLE { # ADD;; val it : thm = |- (!n. 0 + n = n) /\ (!m n. SUC m + n = SUC (m + n)) # GSYM ADD;; val it : thm = |- (!n. n = 0 + n) /\ (!m n. SUC (m + n) = SUC m + n) } \SEEALSO REFL, SYM. \ENDDOC hol-light/Help/HAS_SIZE_CONV.doc000066400000000000000000000012541303454263000164200ustar00rootroot00000000000000\DOC HAS_SIZE_CONV \TYPE {HAS_SIZE_CONV : term -> thm} \SYNOPSIS Converts statement about set's size into existential enumeration. \DESCRIBE Given a term of the form {`s HAS_SIZE n`} for a numeral {n}, the conversion {HAS_SIZE_CONV} returns an equivalent form postulating the existence of {n} pairwise distinct elements that make up the set. \FAILURE Fails if applied to a term of the wrong form. \EXAMPLE { # HAS_SIZE_CONV `s HAS_SIZE 1`;; ... val it : thm = |- s HAS_SIZE 1 <=> (?a. s = {{a}}) # HAS_SIZE_CONV `t HAS_SIZE 3`;; ... val it : thm = |- t HAS_SIZE 3 <=> (?a a' a''. ~(a' = a'') /\ ~(a = a') /\ ~(a = a'') /\ t = {{a, a', a''}}) } \ENDDOC hol-light/Help/HIGHER_REWRITE_CONV.doc000066400000000000000000000042021303454263000173160ustar00rootroot00000000000000\DOC HIGHER_REWRITE_CONV \TYPE {HIGHER_REWRITE_CONV : thm list -> bool -> term -> thm} \SYNOPSIS Rewrite once using more general higher order matching. \DESCRIBE The call {HIGHER_REWRITE_CONV [th1;...;thn] flag t} will find a higher-order match for the whole term {t} against one of the left-hand sides of the equational theorems in the list {[th1;...;thn]}. Each such theorem should be of the form {|- P pat <=> t} where {f} is a variable. A free subterm {pat'} of {t} will be found that matches (in the usual restricted higher-order sense) the pattern {pat}. If the {flag} argument is true, this will be some topmost matchable term, while if it is false, some innermost matchable term will be selected. The rewrite is then applied by instantiating {P} to a lambda-term reflecting how {t} is built up from {pat'}, and beta-reducing as in normal higher-order matching. However, this process is more general than HOL Light's normal higher-order matching (as in {REWRITE_CONV} etc., with core behaviour inherited from {PART_MATCH}), because {pat'} need not be uniquely determined by bound variable correspondences. \FAILURE Fails if no match is found. \EXAMPLE The theorem {COND_ELIM_THM} can be applied to eliminate conditionals: { # COND_ELIM_THM;; val it : thm = |- P (if c then x else y) <=> (c ==> P x) /\ (~c ==> P y) } \noindent in a term like this: { # let t = `z = if x = 0 then if y = 0 then 0 else x + y else x + y`;; val t : term = `z = (if x = 0 then if y = 0 then 0 else x + y else x + y)` } \noindent either outermost first: { # HIGHER_REWRITE_CONV[COND_ELIM_THM] true t;; val it : thm = |- z = (if x = 0 then if y = 0 then 0 else x + y else x + y) <=> (x = 0 ==> z = (if y = 0 then 0 else x + y)) /\ (~(x = 0) ==> z = x + y) } \noindent or innermost first: { # HIGHER_REWRITE_CONV[COND_ELIM_THM] false t;; val it : thm = |- z = (if x = 0 then if y = 0 then 0 else x + y else x + y) <=> (y = 0 ==> z = (if x = 0 then 0 else x + y)) /\ (~(y = 0) ==> z = (if x = 0 then x + y else x + y)) } \USES Applying general simplification patterns without manual instantiation. \SEEALSO PART_MATCH, REWRITE_CONV. \ENDDOC hol-light/Help/HINT_EXISTS_TAC.doc000066400000000000000000000035161303454263000166610ustar00rootroot00000000000000\DOC HINT_EXISTS_TAC \TYPE {HINT_EXISTS_TAC : tactic} \SYNOPSIS Attemps to instantiate existential goals from context. \DESCRIBE Given a goal which contains some subformula of the form {?x_1... x_k. P_1 y^1_1 ... y^1_m1 /\ ... /\ P_n y^n_1 ... y^n_mn} in a context where {P_i t_1 ... t_mi} holds for some {t_1,...,t_mi}, then instantiates {x_i1,...,x_i_mi} with {t_1,...,t_mi}. The ``context'' consists in the assumptions or in the premisses of the implications where the existential subformula occurs. Note: it is enough that just P t holds, not the complete existentially quantified formula. As the name suggests, we just use the context as a ``hint'' but it is (in most general uses) not sufficient to solve the existential completely: if this is doable automatically, then other techniques can do the job in a better way (typically {MESON}). \FAILURE Fails if no instantiation is found from the context. \EXAMPLE { # g `!P Q R S. P 1 /\ Q 2 /\ R 3 ==> ?x y. P x /\ R y /\ S x y`;; val it : goalstack = 1 subgoal (1 total) `!P Q R S. P 1 /\ Q 2 /\ R 3 ==> (?x y. P x /\ R y /\ S x y)` # e HINT_EXISTS_TAC;; val it : goalstack = 1 subgoal (1 total) `!P Q R S. P 1 /\ Q 2 /\ R 3 ==> S 1 3` } \USES When facing an existential goal, it happens often that the context ``suggests'' a candidate to be a witness. In many cases, this is because the existential goal is partly satisfied by a proposition in the context. However, often, the context does not allow to automatically prove completely the existential using this witness. Therefore, usual automation tactics are useless. Usually, in such circumstances, one has to provide the witness explicitly. This is tedious and time-consuming whereas this witness can be found automatically from the context, this is what this tactic allows to do. \SEEALSO EXISTS_TAC, IMP_REWRITE_TAC, SIMP_TAC. \ENDDOC hol-light/Help/HYP_TAC.doc000077500000000000000000000034421303454263000154610ustar00rootroot00000000000000\DOC HYP_TAC \TYPE {HYP_TAC : string -> (thm -> thm) -> tactic} \SYNOPSIS Applies a rule to a named hypothesis. \DESCRIBE Given a string {s} and a rule {r}, {HYP_TAC s r} applies {r} to the hypothesis labeled {l} as specified by the pattern {s} which can be of one of the following form: \begin{{itemize}} \item "{l} : {patt}", meaning apply {r} to hypothesis {l} and destruct it with {patt}, like {REMOVE_THEN l (DESTRUCT_TAC patt o r)} \item a label {"l"}, meaning apply {r} to the hypothesis {l}, a shorthand for {HYP_TAC "l : l" r} \item "{l} : {patt}", meaning apply {r} to hypothesis {l} and destruct it with {patt} but keep hypothesis {l}, like {USE_THEN l (DESTRUCT_TAC patt o r)} \end{{itemize}} \FAILURE Applied to its arguments fails if the pattern is ill-formed. When executed as a tactic, fails if it refers to non-existent hypothesis or the rule fails or do not produce a theorem of a suitable form. \EXAMPLE Here we use the theorem {MEMBER_NOT_EMPTY} to obtain an element {a} from a non empty set {s} { # g `!s. ~(s = {}) ==> (minimal n. n IN s) IN s`;; # e (INTRO_TAC "!s; s");; # e (HYP_TAC "s : @a. +" (REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]));; val it : goalstack = 1 subgoal (1 total) `a IN s ==> (minimal n. n IN s) IN s` } \noindent next we can finish with this goal with { # e (MESON_TAC[MINIMAL]);; } Here we derive that a strictly positive number is a non negative number { # g `!x. &0 < x ==> &0 <= inv x`;; # e (INTRO_TAC "!x; xgt");; # e (HYP_TAC "xgt -> xge" (MATCH_MP REAL_LT_IMP_LE));; val it : goalstack = 1 subgoal (1 total) 0 [`&0 < x`] (xgt) 1 [`&0 <= x`] (xge) `&0 <= inv x` } \noindent then we can solve the goal with { # e (HYP SIMP_TAC "xge" [REAL_LE_INV]);; } \SEEALSO DESTRUCT_TAC, HYP, LABEL_TAC, REMOVE_THEN, USE_THEN \ENDDOC hol-light/Help/HYP_UPPERCASE.doc000066400000000000000000000026731303454263000164030ustar00rootroot00000000000000\DOC HYP \TYPE {HYP : (thm list -> tactic) -> string -> thm list -> tactic} \SYNOPSIS Augments a tactic's theorem list with named assumptions. \DESCRIBE If {tac} is a tactic that expects a list of theorems as its arguments, e.g. {MESON_TAC}, {REWRITE_TAC} or {SET_TAC}, then {HYP tac s} converts it to a tactic where that list is augmented by the goal's assumptions specified in the string argument s, which is a list of alphanumeric identifiers separated by whitespace, e.g. {"lab1 lab2"}. \FAILURE When fully applied to a goal, it will fail if the string specifying the labels is ill-formed, if any of the specified assumption labels are not found in the goal, or if the tactic itself fails on the combined list of theorems. \EXAMPLE With the following trivial goal { # g `p /\ q /\ r ==> r /\ q`;; } We may start by assuming and labelling the hypotheses, which may conveniently be done using {INTRO_TAC}: { # e(INTRO_TAC "asm_p asm_q asm_r");; val it : goalstack = 1 subgoal (1 total) 0 [`p`] (asm_p) 1 [`q`] (asm_q) 2 [`r`] (asm_r) `r /\ q` } The resulting goal can trivially be solved in any number of ways, but if we want to ensure that {MESON_TAC} uses exactly the assumptions relating to {q} and {r} and no extraneous ones, we could do: { # e(HYP MESON_TAC "asm_r asm_q" []);; val it : goalstack = No subgoals } \SEEALSO ASM, ASSUM_LIST, FREEZE_THEN, LABEL_TAC, MESON_TAC, REMOVE_THEN, REWRITE_TAC, SET_TAC, USE_THEN. \ENDDOC hol-light/Help/I.doc000066400000000000000000000002561303454263000145170ustar00rootroot00000000000000\DOC I \TYPE {I : 'a -> 'a} \SYNOPSIS Performs identity operation: {I x} = {x}. \KEYWORDS combinator, identity. \FAILURE Never fails. \SEEALSO C, K, F_F, o, W. \ENDDOC hol-light/Help/IMP_ANTISYM_RULE.doc000066400000000000000000000015601303454263000170060ustar00rootroot00000000000000\DOC IMP_ANTISYM_RULE \TYPE {IMP_ANTISYM_RULE : thm -> thm -> thm} \SYNOPSIS Deduces equality of boolean terms from forward and backward implications. \KEYWORDS rule, implication, equality. \DESCRIBE When applied to the theorems {A1 |- t1 ==> t2} and {A2 |- t2 ==> t1}, the inference rule {IMP_ANTISYM_RULE} returns the theorem {A1 u A2 |- t1 <=> t2}. { A1 |- t1 ==> t2 A2 |- t2 ==> t1 ------------------------------------- IMP_ANTISYM_RULE A1 u A2 |- t1 <=> t2 } \FAILURE Fails unless the theorems supplied are a complementary implicative pair as indicated above. \EXAMPLE { # let th1 = TAUT `p /\ q ==> q /\ p` and th2 = TAUT `q /\ p ==> p /\ q`;; val th1 : thm = |- p /\ q ==> q /\ p val th2 : thm = |- q /\ p ==> p /\ q # IMP_ANTISYM_RULE th1 th2;; val it : thm = |- p /\ q <=> q /\ p } \SEEALSO EQ_IMP_RULE, EQ_MP, EQ_TAC. \ENDDOC hol-light/Help/IMP_RES_THEN.doc000066400000000000000000000074161303454263000163100ustar00rootroot00000000000000\DOC IMP_RES_THEN \TYPE {IMP_RES_THEN : thm_tactical} \SYNOPSIS Resolves an implication with the assumptions of a goal. \KEYWORDS theorem-tactic, resolution, implication. \DESCRIBE The function {IMP_RES_THEN} is the basic building block for resolution in HOL. This is not full higher-order, or even first-order, resolution with unification, but simply one way simultaneous pattern-matching (resulting in term and type instantiation) of the antecedent of an implicative theorem to the conclusion of another theorem (the candidate antecedent). Given a theorem-tactic {ttac} and a theorem {th}, the theorem-tactical {IMP_RES_THEN} produces a tactic that, when applied to a goal {A ?- g} attempts to match each antecedent {ui} to each assumption {aj |- aj} in the assumptions {A}. If the antecedent {ui} of any implication matches the conclusion {aj} of any assumption, then an instance of the theorem {Ai u {{aj}} |- vi}, called a `resolvent', is obtained by specialization of the variables {x1}, ..., {xn} and type instantiation, followed by an application of modus ponens. There may be more than one canonical implication and each implication is tried against every assumption of the goal, so there may be several resolvents (or, indeed, none). Tactics are produced using the theorem-tactic {ttac} from all these resolvents (failures of {ttac} at this stage are filtered out) and these tactics are then applied in an unspecified sequence to the goal. That is, { IMP_RES_THEN ttac th (A ?- g) } \noindent has the effect of: { MAP_EVERY (mapfilter ttac [... ; (Ai u {{aj}} |- vi) ; ...]) (A ?- g) } \noindent where the theorems {Ai u {{aj}} |- vi} are all the consequences that can be drawn by a (single) matching modus-ponens inference from the assumptions of the goal {A ?- g} and the implications derived from the supplied theorem {th}. The sequence in which the theorems {Ai u {{aj}} |- vi} are generated and the corresponding tactics applied is unspecified. \FAILURE Evaluating {IMP_RES_THEN ttac th} fails if the supplied theorem {th} is not an implication, or if no implications can be derived from {th} by the transformation process involved. Evaluating {IMP_RES_THEN ttac th (A ?- g)} fails if no assumption of the goal {A ?- g} can be resolved with the implication or implications derived from {th}. Evaluation also fails if there are resolvents, but for every resolvent {Ai u {{aj}} |- vi} evaluating the application {ttac (Ai u {{aj}} |- vi)} fails---that is, if for every resolvent {ttac} fails to produce a tactic. Finally, failure is propagated if any of the tactics that are produced from the resolvents by {ttac} fails when applied in sequence to the goal. \EXAMPLE The following example shows a straightforward use of {IMP_RES_THEN} to infer an equational consequence of the assumptions of a goal, use it once as a substitution in the conclusion of goal, and then `throw it away'. Suppose the goal is: { # g `!a n. a + n = a ==> !k. k - n = k`;; } \noindent and we start out with: { # e(REPEAT GEN_TAC THEN DISCH_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`a + n = a`] `!k. k - n = k` } \noindent By using the theorem: { # let ADD_INV_0 = ARITH_RULE `!m n. m + n = m ==> n = 0`;; } \noindent the assumption of this goal implies that {n} equals {0}. A single-step resolution with this theorem followed by substitution: { # e(IMP_RES_THEN SUBST1_TAC ADD_INV_0);; val it : goalstack = 1 subgoal (1 total) 0 [`a + n = a`] `!k. k - 0 = k` } \noindent Here, a single resolvent {a + n = a |- n = 0} is obtained by matching the antecedent of {ADD_INV_0} to the assumption of the goal. This is then used to substitute {0} for {n} in the conclusion of the goal. The goal is now solvable by {ARITH_TAC} (as indeed was the original goal). \SEEALSO IMP_RES_THEN, MATCH_MP, MATCH_MP_TAC. \ENDDOC hol-light/Help/IMP_REWRITE_TAC.doc000066400000000000000000000112721303454263000166440ustar00rootroot00000000000000\DOC IMP_REWRITE_TAC \TYPE {IMP_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Performs implicational rewriting, adding new assumptions if necessary. \DESCRIBE Given a list of theorems {[th_1;...;th_k]} of the form {!x_1... x_n. P ==> !y_1... y_m. l = r}, the tactic {IMP_REWRITE_TAC [th_1;...;th_k]} applies implicational rewriting using all theorems, i.e. replaces any occurrence of {l} by {r} in the goal, even if {P} does not hold. This may involve adding some propositional atoms (typically instantations of {P}) or existentials, but in the end, you are (almost) sure that l is replaced by r. Note that P can be ``empty'', in which case implicational rewriting is just rewriting. Additional remarks: \begin{{itemize}} \item A theorem of the form {!x_1... x_n. l = r} is turned into {!x_1... x_n. T ==> l = r} (so that {IMP_REWRITE_TAC} can be used as a replacement for {REWRITE_TAC} and {SIMP_TAC}). \item A theorem of the form {!x_1... x_n. P ==> !y_1... y_m. Q} is turned into {!x_1... x_n. P ==> !y_1... y_m. Q = T} (so that {IMP_REWRITE_TAC} can be used as a ``deep'' replacement for {MATCH_MP_TAC}). \item A theorem of the form {!x_1... x_n. P ==> !y_1... y_m. ~Q} is turned into {!x_1... x_n. P ==> !y_1... y_m. Q = F}. \item A theorem of the form {!x_1... x_n. P ==> !y_1... y_k. Q ... ==> l = r} is turned into {!x_1... x_n,y_1... y_k,... P \wedge Q \wedge ... ==> l = r} \item A theorem of the form {!x_1... x_n. P ==> (!y^1_1... y^1_k. Q_1 ... ==> l_1 = r_1 /\ !y^2_1... y^2_k. Q_2 ... ==> l_2=r_2 /\ ...)} is turned into the list of theorems {!x_1... x_n, y^1_1... y^1_k,... P /\ Q_1 /\ ... ==> l_1 = r_1}, {!x_1... x_n,y^2_1... y^2_k,... P /\ Q_2 /\ ... ==> l_2 = r_2} etc. \end{{itemize}} \FAILURE Fails if no rewrite can be achieved. If the usual behavior of leaving the goal unchanged is desired, one can wrap the coal in {TRY_TAC}. \EXAMPLE This is a simple example: { # REAL_DIV_REFL;; val it : thm = |- !x. ~(x = &0) ==> x / x = &1 # g `!a b c. a < b ==> (a - b) / (a - b) * c = c`;; val it : goalstack = 1 subgoal (1 total) `!a b c. a < b ==> (a - b) / (a - b) * c = c` # e(IMP_REWRITE_TAC[REAL_DIV_REFL]);; val it : goalstack = 1 subgoal (1 total) `!a b c. a < b ==> &1 * c = c / ~(a - b = &0)` } We can actually do more in one step: { # g `!a b c. a < b ==> (a - b) / (a - b) * c = c`;; val it : goalstack = 1 subgoal (1 total) `!a b c. a < b ==> (a - b) / (a - b) * c = c` # e(IMP_REWRITE_TAC[REAL_DIV_REFL;REAL_MUL_LID;REAL_SUB_0]);; val it : goalstack = 1 subgoal (1 total) `!a b. a < b ==> ~(a = b)` } And one can easily conclude with: { # e(IMP_REWRITE_TAC[REAL_LT_IMP_NE]);; val it : goalstack = No subgoals } This illustrates the use of this tactic as a replacement for {MATCH_MP_TAC}: { # g `!a b. &0 < a - b ==> ~(b = a)`;; val it : goalstack = 1 subgoal (1 total) `!a b. &0 < a - b ==> ~(b = a)` # e(IMP_REWRITE_TAC[REAL_LT_IMP_NE]);; val it : goalstack = 1 subgoal (1 total) `!a b. &0 < a - b ==> b < a` } Actually the goal can be completely proved just by: { # e(IMP_REWRITE_TAC[REAL_LT_IMP_NE;REAL_SUB_LT]);; val it : goalstack = No subgoals } Of course on this simple example, it would actually be enough to use {SIMP_TAC}. \USES Allows to make some progress when {REWRITE_TAC} or {SIMP_TAC} cannot. Namely, if the precondition P cannot be proved automatically, then these classic tactics cannot be used, and one must generally add the precondition explicitly using {SUBGOAL_THEN} or {SUBGOAL_TAC}. {IMP_REWRITE_TAC} allows one to do this automatically. Additionally, it can add this precondition deep in a term, actually to the deepest where it is meaningful. Thus there is no need to first use {REPEAT STRIP_TAC} (which often forces to decompose the goal into subgoals whereas the user would not want to do so). {IMP_REWRITE_TAC} can also be used like {MATCH_MP_TAC}, but, again, deep in a term. Therefore you can avoid the common preliminary {REPEAT STRIP_TAC}. The only disadvantages w.r.t. {REWRITE_TAC}, {SIMP_TAC} and {MATCH_MP_TAC} are that {IMP_REWRITE_TAC} uses only first-order matching and is generally a little bit slower. \COMMENTS Contrarily to {REWRITE_TAC} or {SIMP_TAC}, the goal obtained by using implicational rewriting is generally not equivalent to the initial goal. This is actually what makes this tactic so useful: applying only ``reversible'' reasoning steps is quite a big restriction compared to all the reasoning steps that could be achieved (and often wanted). We use only first-order matching because higher-order matching happens to match ``too much''. In situations where they can be used, {REWRITE_TAC} and {SIMP_TAC} are generally more efficient. \SEEALSO CASE_REWRITE_TAC, REWRITE_TAC, SEQ_IMP_REWRITE_TAC, SIMP_TAC, TARGET_REWRITE_TAC. \ENDDOC hol-light/Help/IMP_REWR_CONV.doc000066400000000000000000000020601303454263000164330ustar00rootroot00000000000000\DOC IMP_REWR_CONV \TYPE {IMP_REWR_CONV : thm -> term -> thm} \SYNOPSIS Basic conditional rewriting conversion. \DESCRIBE Given an equational theorem {A |- !x1...xn. p ==> s = t} that expresses a conditional rewrite rule, the conversion {IMP_REWR_CONV} gives a conversion that applied to any term {s'} will attempt to match the left-hand side of the equation {s = t} to {s'}, and return the corresponding theorem {A |- p' ==> s' = t'}. \FAILURE Fails if the theorem is not of the right form or the two terms cannot be matched, for example because the variables that need to be instantiated are free in the hypotheses {A}. \EXAMPLE We use the following theorem: { # DIV_MULT;; val it : thm = |- !m n. ~(m = 0) ==> (m * n) DIV m = n } \noindent to make a conditional rewrite: { # IMP_REWR_CONV DIV_MULT `(2 * x) DIV 2`;; val it : thm = |- ~(2 = 0) ==> (2 * x) DIV 2 = x } \USES One of the building-blocks for conditional rewriting as implemented by {SIMP_CONV}, {SIMP_RULE}, {SIMP_TAC} etc. \SEEALSO ORDERED_IMP_REWR_CONV, REWR_CONV, SIMP_CONV. \ENDDOC hol-light/Help/IMP_TRANS.doc000066400000000000000000000015541303454263000157250ustar00rootroot00000000000000\DOC IMP_TRANS \TYPE {IMP_TRANS : thm -> thm -> thm} \SYNOPSIS Implements the transitivity of implication. \KEYWORDS rule, implication, transitivity. \DESCRIBE When applied to theorems {A1 |- t1 ==> t2} and {A2 |- t2 ==> t3}, the inference rule {IMP_TRANS} returns the theorem {A1 u A2 |- t1 ==> t3}. { A1 |- t1 ==> t2 A2 |- t2 ==> t3 ----------------------------------- IMP_TRANS A1 u A2 |- t1 ==> t3 } \FAILURE Fails unless the theorems are both implicative, with the consequent of the first being the same as the antecedent of the second (up to alpha-conversion). \EXAMPLE { # let th1 = TAUT `p /\ q /\ r ==> p /\ q` and th2 = TAUT `p /\ q ==> p`;; val th1 : thm = |- p /\ q /\ r ==> p /\ q val th2 : thm = |- p /\ q ==> p # IMP_TRANS th1 th2;; val it : thm = |- p /\ q /\ r ==> p } \SEEALSO IMP_ANTISYM_RULE, SYM, TRANS. \ENDDOC hol-light/Help/INDUCT_TAC.doc000066400000000000000000000035161303454263000160060ustar00rootroot00000000000000\DOC INDUCT_TAC \TYPE {INDUCT_TAC : tactic} \SYNOPSIS Performs tactical proof by mathematical induction on the natural numbers. \KEYWORDS tactic, induction. \DESCRIBE {INDUCT_TAC} reduces a goal {A ?- !n. P[n]}, where {n} has type {num}, to two subgoals corresponding to the base and step cases in a proof by mathematical induction on {n}. The induction hypothesis appears among the assumptions of the subgoal for the step case. The specification of {INDUCT_TAC} is: { A ?- !n. P ======================================== INDUCT_TAC A ?- P[0/n] A u {{P}} ?- P[SUC n'/n] } \noindent where {n'} is a primed variant of {n} that does not appear free in the assumptions {A} (usually, {n'} is just {n}). \FAILURE {INDUCT_TAC g} fails unless the conclusion of the goal {g} has the form {`!n. t`}, where the variable {n} has type {num}. \EXAMPLE Suppose we want to prove the classic `sum of the first {n} integers' theorem: { # g `!n. nsum(1..n) (\i. i) = (n * (n + 1)) DIV 2`;; } \noindent This is a classic example of an inductive proof. If we apply induction, we get two subgoals: { # e INDUCT_TAC;; val it : goalstack = 2 subgoals (2 total) 0 [`nsum (1 .. n) (\i. i) = (n * (n + 1)) DIV 2`] `nsum (1 .. SUC n) (\i. i) = (SUC n * (SUC n + 1)) DIV 2` `nsum (1 .. 0) (\i. i) = (0 * (0 + 1)) DIV 2` } \noindent each of which can be solved by just: { # e(ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; } \COMMENTS Essentially the same effect can be had by {MATCH_MP_TAC num_INDUCTION}. This does not subsequently break down the goal in such a convenient way, but gives more control over choice of variable. You can also equally well use it for other kinds of induction, e.g. use {MATCH_MP_TAC num_WF} for wellfounded (complete, noetherian) induction. \SEEALSO LIST_INDUCT_TAC, MATCH_MP_TAC, WF_INDUCT_TAC. \ENDDOC hol-light/Help/INSTANTIATE_ALL.doc000066400000000000000000000016331303454263000166020ustar00rootroot00000000000000\DOC INSTANTIATE_ALL \TYPE {INSTANTIATE_ALL : instantiation -> thm -> thm} \SYNOPSIS Apply a higher-order instantiation to assumptions and conclusion of a theorem. \DESCRIBE The call {INSTANTIATE_ALL i t}, where {i} is an instantiation as returned by {term_match}, will perform the instantiation indicated by {i} in the conclusion of the theorem {th}: types and terms will be instantiated and the beta-reductions that are part of higher-order matching will be applied. \FAILURE Never fails on a valid instantiation. \COMMENTS This is not intended for general use. {PART_MATCH} is generally a more convenient packaging. The function {INSTANTIATE} is almost the same but does not instantiate hypotheses and may fail if type variables or term variables free in the hypotheses make the instantiation impossible. \SEEALSO INSTANTIATE, INSTANTIATE_ALL, PART_MATCH, term_match. \ENDDOC hol-light/Help/INSTANTIATE_UPPERCASE.doc000066400000000000000000000021611303454263000175160ustar00rootroot00000000000000\DOC INSTANTIATE \TYPE {INSTANTIATE : instantiation -> thm -> thm} \SYNOPSIS Apply a higher-order instantiation to conclusion of a theorem. \DESCRIBE The call {INSTANTIATE i t}, where {i} is an instantiation as returned by {term_match}, will perform the instantiation indicated by {i} in the conclusion of the theorem {th}: types and terms will be instantiated and the beta-reductions that are part of higher-order matching will be applied. \FAILURE Fails if the instantiation is impossible because of free term or type variables in the hypotheses. \EXAMPLE { # let t = lhs(concl(SPEC_ALL NOT_FORALL_THM));; val t : term = `~(!x. P x)` # let i = term_match [] t `~(!n. prime(n) ==> ODD(n))`;; val i : instantiation = ([(1, `P`)], [(`\n. prime n ==> ODD n`, `P`)], [(`:num`, `:A`)]) # INSTANTIATE i (SPEC_ALL NOT_FORALL_THM);; val it : thm = |- ~(!x. prime x ==> ODD x) <=> (?x. ~(prime x ==> ODD x)) } \COMMENTS This is not intended for general use. {PART_MATCH} is generally a more convenient packaging. \SEEALSO instantiate, INSTANTIATE_ALL, PART_MATCH, term_match. \ENDDOC hol-light/Help/INST_TYPE.doc000066400000000000000000000023571303454263000157510ustar00rootroot00000000000000\DOC INST_TYPE \TYPE {INST_TYPE : (hol_type * hol_type) list -> thm -> thm} \SYNOPSIS Instantiates types in a theorem. \KEYWORDS rule, type, instantiate. \DESCRIBE {INST_TYPE [ty1,tv1;...;tyn,tvn]} will systematically replaces all instances of each type variable {tvi} by the corresponding type {tyi} in both assumptions and conclusions of a theorem: { A |- t ----------------------------------- INST_TYPE [ty1,tv1;...;tyn,tvn] A[ty1,...,tyn/tv1,...,tvn] |- t[ty1,...,tyn/tv1,...,tvn] } Variables will be renamed if necessary to prevent variable capture. \FAILURE Never fails. \USES {INST_TYPE} is employed to make use of polymorphic theorems. \EXAMPLE Suppose one wanted to specialize the theorem {EQ_SYM_EQ} for particular values, the first attempt could be to use {SPECL} as follows: { # SPECL [`a:num`; `b:num`] EQ_SYM_EQ ;; Exception: Failure "SPECL". } \noindent The failure occurred because {EQ_SYM_EQ} contains polymorphic types. The desired specialization can be obtained by using {INST_TYPE}: { # SPECL [`a:num`; `b:num`] (INST_TYPE [`:num`,`:A`] EQ_SYM_EQ) ;; val it : thm = |- a = b <=> b = a } \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO INST, ISPEC, ISPECL. \ENDDOC hol-light/Help/INST_UPPERCASE.doc000066400000000000000000000031201303454263000165040ustar00rootroot00000000000000\DOC INST \TYPE {INST : (term * term) list -> thm -> thm} \SYNOPSIS Instantiates free variables in a theorem. \DESCRIBE When {INST [t1,x1; ...; tn,xn]} is applied to a theorem, it gives a new theorem that systematically replaces free instances of each variable {xi} with the corresponding term {ti} in both assumptions and conclusion. { A |- t ----------------------------------- INST [t1,x1;...;tn,xn] A[t1,...,tn/x1,...,xn] |- t[t1,...,tn/x1,...,xn] } Bound variables will be renamed if necessary to avoid capture. All variables are substituted in parallel, so there is no problem if there is an overlap between the terms {ti} and {xi}. \FAILURE Fails if any of the pairs {ti,xi} in the instantiation list has {xi} and {ti} with different types, or {xi} a non-variable. Multiple instances of the same {xi} in the list are not trapped, but only the first one will be used consistently. \EXAMPLE Here is a simple example { # let th = SPEC_ALL ADD_SYM;; val th : thm = |- m + n = n + m # INST [`1`,`m:num`; `x:num`,`n:num`] th;; val it : thm = |- 1 + x = x + 1 } \noindent and here is one where bound variable renaming is needed. { # let th = SPEC_ALL LE_EXISTS;; val th : thm = |- m <= n <=> (?d. n = m + d) # INST [`d:num`,`m:num`] th;; val it : thm = |- d <= n <=> (?d'. n = d + d') } \USES This is the most efficient way to obtain instances of a theorem; though sometimes more convenient, {SPEC} and {SPECL} are significantly slower. \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO INST_TYPE, ISPEC, ISPECL, SPEC, SPECL. \ENDDOC hol-light/Help/INTEGER_RULE.doc000066400000000000000000000037171303454263000162600ustar00rootroot00000000000000\DOC INTEGER_RULE \TYPE {INTEGER_RULE : term -> thm} \SYNOPSIS Automatically prove elementary divisibility property over the integers. \DESCRIBE {INTEGER_RULE} is a partly heuristic rule that can often automatically prove elementary ``divisibility'' properties of the integers. The precise subset that is dealt with is difficult to describe rigorously, but many universally quantified combinations of {divides}, {coprime}, {gcd} and congruences {(x == y) (mod n)} can be proved automatically, as well as some existentially quantified goals. The examples below may give a feel for what can be done. \FAILURE Fails if the goal is not accessible to the methods used. \EXAMPLE All sorts of elementary Boolean combinations of divisibility and congruence properties can be solved, e.g. { # INTEGER_RULE `!x y n:int. (x == y) (mod n) ==> (n divides x <=> n divides y)`;; ... val it : thm = |- !x y n. (x == y) (mod n) ==> (n divides x <=> n divides y) # INTEGER_RULE `!a b d:int. d divides gcd(a,b) <=> d divides a /\ d divides b`;; ... val it : thm = |- !a b d. d divides gcd (a,b) <=> d divides a /\ d divides b } \noindent including some less obvious ones: { # INTEGER_RULE `!x y. coprime(x * y,x pow 2 + y pow 2) <=> coprime(x,y)`;; ... val it : thm = |- !x y. coprime (x * y,x pow 2 + y pow 2) <=> coprime (x,y) } \noindent A limited class of existential goals is solvable too, e.g. a classic sufficient condition for a linear congruence to have a solution: { # INTEGER_RULE `!a b n:int. coprime(a,n) ==> ?x. (a * x == b) (mod n)`;; ... val it : thm = |- !a b n. coprime (a,n) ==> (?x. (a * x == b) (mod n)) } \noindent or the two-number Chinese Remainder Theorem: { # INTEGER_RULE `!a b u v:int. coprime(a,b) ==> ?x. (x == u) (mod a) /\ (x == v) (mod b)`;; ... val it : thm = |- !a b u v. coprime (a,b) ==> (?x. (x == u) (mod a) /\ (x == v) (mod b)) } \SEEALSO ARITH_RULE, INTEGER_TAC, INT_ARITH, INT_RING, NUMBER_RULE. \ENDDOC hol-light/Help/INTEGER_TAC.doc000066400000000000000000000023251303454263000161120ustar00rootroot00000000000000\DOC INTEGER_TAC \TYPE {INTEGER_TAC : tactic} \SYNOPSIS Automated tactic for elementary divisibility properties over the integers. \DESCRIBE The tactic {INTEGER_TAC} is a partly heuristic tactic that can often automatically prove elementary ``divisibility'' properties of the integers. The precise subset that is dealt with is difficult to describe rigorously, but many universally quantified combinations of {divides}, {coprime}, {gcd} and congruences {(x == y) (mod n)} can be proved automatically, as well as some existentially quantified goals. See the documentation for {INTEGER_RULE} for a larger set of representative examples. \FAILURE Fails if the goal is not accessible to the methods used. \EXAMPLE A typical elementary divisibility property is that if two linear congruences have a common solution modulo {n}, then {n} divides the resultant of the two equations. If we set this as our goal { # g `!c2 c1 c0 n x:int. (c0 * x == c1) (mod n) /\ (c1 * x == c2) (mod n) ==> n divides (c1 * c1 - c0 * c2)`;; } \noindent It can be solved automatically using {INTEGER_TAC}: { # e INTEGER_TAC;; ... val it : goalstack = No subgoals } \SEEALSO INTEGER_RULE, INT_ARITH_TAC, INT_RING, NUMBER_RULE. \ENDDOC hol-light/Help/INTRO_TAC.doc000066400000000000000000000042241303454263000157100ustar00rootroot00000000000000\DOC INTRO_TAC \TYPE {INTRO_TAC : string -> tactic} \SYNOPSIS Breaks down outer quantifiers in goal, introducing variables and named hypotheses. \DESCRIBE Given a string {s}, {INTRO_TAC s} breaks down outer universal quantifiers and implications in the goal, fixing variables and introducing assumptions with names. It combines several forms of introduction of logical connectives. The introduction pattern uses the following syntax: \begin{{itemize}} \item {! fix_pattern} introduces universally quantified variables as with {FIX_TAC} \item a destruct pattern introduces and destructs an implication as with {DESTRUCT_TAC} \item {#n} selects disjunct {n} in the goal \end{{itemize}} Several fix patterns and destruct patterns can be combined sequentially, separed by semicolons `;'. \FAILURE Fails if the pattern is ill-formed or does not match the form of the goal. \EXAMPLE Here we introduce the universally quantified outer variables, assume the antecedent, splitting apart conjunctions and disjunctions: { # g `!p q r. p \/ (q /\ r) ==> p /\ q \/ p /\ r`;; # e (INTRO_TAC "!p q r; p | q r");; val it : goalstack = 2 subgoals (2 total) 0 [`q`] (q) 1 [`r`] (r) `p /\ q \/ p /\ r` 0 [`p`] (p) `p /\ q \/ p /\ r` } Now a further step will select the first disjunct to prove in the top goal: { # e (INTRO_TAC "#1");; val it : goalstack = 1 subgoal (2 total) 0 [`p`] (p) `p /\ q` } In the next example we introduce an alternation of universally quantified variables and antecedents. Along the way we split a disjunction and rename variables x1, x2 into n, n'. All is done in a single tactic invocation. { # g `!a. ~(a = 0) ==> ONE_ONE (\n. a * n)`;; # e (REWRITE_TAC[ONE_ONE; EQ_MULT_LCANCEL]);; val it : goalstack = 1 subgoal (1 total) `!a. ~(a = 0) ==> (!x1 x2. a = 0 \/ x1 = x2 ==> x1 = x2)` # e (INTRO_TAC "!a; anz; ![n] [n']; az | eq");; val it : goalstack = 2 subgoals (2 total) 0 [`~(a = 0)`] (anz) 1 [`n = n'`] (eq) `n = n'` 0 [`~(a = 0)`] (anz) 1 [`a = 0`] (az) `n = n'` } \SEEALSO DESTRUCT_TAC, DISCH_TAC, FIX_TAC, GEN_TAC, LABEL_TAC, REMOVE_THEN, STRIP_TAC, USE_THEN. \ENDDOC hol-light/Help/INT_ABS_CONV.doc000066400000000000000000000013441303454263000162720ustar00rootroot00000000000000\DOC INT_ABS_CONV \TYPE {INT_ABS_CONV : conv} \SYNOPSIS Conversion to produce absolute value of an integer literal of type {:int}. \DESCRIBE The call {INT_ABS_CONV `abs c`}, where {c} is an integer literal of type {:int}, returns the theorem {|- abs c = d} where {d} is the canonical integer literal that is equal to {c}'s absolute value. The literal {c} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the negation of one of the permitted forms of integer literal of type {:int}. \EXAMPLE { # INT_ABS_CONV `abs(-- &42)`;; val it : thm = |- abs (-- &42) = &42 } \SEEALSO INT_REDUCE_CONV, REAL_RAT_ABS_CONV. \ENDDOC hol-light/Help/INT_ADD_CONV.doc000066400000000000000000000013141303454263000162520ustar00rootroot00000000000000\DOC INT_ADD_CONV \TYPE {INT_ADD_CONV : conv} \SYNOPSIS Conversion to perform addition on two integer literals of type {:int}. \DESCRIBE The call {INT_ADD_CONV `c1 + c2`} where {c1} and {c2} are integer literals of type {:int}, returns {|- c1 + c2 = d} where {d} is the canonical integer literal that is equal to {c1 + c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the sum of two permitted integer literals of type {:int}. \EXAMPLE { # INT_ADD_CONV `-- &17 + &25`;; val it : thm = |- -- &17 + &25 = &8 } \SEEALSO INT_REDUCE_CONV, REAL_RAT_ADD_CONV. \ENDDOC hol-light/Help/INT_ARITH.doc000066400000000000000000000015251303454263000157100ustar00rootroot00000000000000\DOC INT_ARITH \TYPE {INT_ARITH : term -> thm} \SYNOPSIS Proves integer theorems needing basic rearrangement and linear inequality reasoning only. \DESCRIBE {INT_ARITH} is a rule for automatically proving natural number theorems using basic algebraic normalization and inequality reasoning. \FAILURE Fails if the term is not boolean or if it cannot be proved using the basic methods employed, e.g. requiring nonlinear inequality reasoning. \EXAMPLE { # INT_ARITH `!x y:int. x <= y + &1 ==> x + &2 < y + &4`;; val it : thm = |- !x y. x <= y + &1 ==> x + &2 < y + &4 # INT_ARITH `(x + y:int) pow 2 = x pow 2 + &2 * x * y + y pow 2`;; val it : thm = |- (x + y) pow 2 = x pow 2 + &2 * x * y + y pow 2 } \USES Disposing of elementary arithmetic goals. \SEEALSO ARITH_RULE, INT_ARITH_TAC, NUM_RING, REAL_ARITH, REAL_FIELD, REAL_RING. \ENDDOC hol-light/Help/INT_ARITH_TAC.doc000066400000000000000000000025341303454263000164000ustar00rootroot00000000000000\DOC INT_ARITH_TAC \TYPE {INT_ARITH_TAC : tactic} \SYNOPSIS Attempt to prove goal using basic algebra and linear arithmetic over the integers. \DESCRIBE The tactic {INT_ARITH_TAC} is the tactic form of {INT_ARITH}. Roughly speaking, it will automatically prove any formulas over the reals that are effectively universally quantified and can be proved valid by algebraic normalization and linear equational and inequality reasoning. See {REAL_ARITH} for more information about the algorithm used and its scope. \FAILURE Fails if the goal is not in the subset solvable by these means, or is not valid. \EXAMPLE Here is a goal that holds by virtue of pure algebraic normalization: { # prioritize_int();; val it : unit = () # g `(x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) * (y1 pow 2 + y2 pow 2 + y3 pow 2 + y4 pow 2) = (x1 * y1 - x2 * y2 - x3 * y3 - x4 * y4) pow 2 + (x1 * y2 + x2 * y1 + x3 * y4 - x4 * y3) pow 2 + (x1 * y3 - x2 * y4 + x3 * y1 + x4 * y2) pow 2 + (x1 * y4 + x2 * y3 - x3 * y2 + x4 * y1) pow 2`;; } \noindent and here is one that holds by linear inequality reasoning: { # g `!x y:int. abs(x + y) < abs(x) + abs(y) + &1`;; } \noindent so either goal is solved simply by: { # e INT_ARITH_TAC;; val it : goalstack = No subgoals } \SEEALSO ARITH_TAC, ASM_INT_ARITH_TAC, INT_ARITH, REAL_ARITH_TAC. \ENDDOC hol-light/Help/INT_EQ_CONV.doc000066400000000000000000000016701303454263000161740ustar00rootroot00000000000000\DOC INT_EQ_CONV \TYPE {INT_EQ_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:int} is equal to another. \DESCRIBE The call {INT_EQ_CONV `c1 < c2`} where {c1} and {c2} are integer literals of type {:int}, returns whichever of {|- c1 = c2 <=> T} or {|- c1 = c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not an equality comparison on two permitted integer literals of type {:int}. \EXAMPLE { # INT_EQ_CONV `&1 = &2`;; val it : thm = |- &1 = &2 <=> F # INT_EQ_CONV `-- &1 = -- &1`;; val it : thm = |- -- &1 = -- &1 <=> T } \COMMENTS The related function {REAL_RAT_EQ_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_REDUCE_CONV, REAL_RAT_EQ_CONV. \ENDDOC hol-light/Help/INT_GE_CONV.doc000066400000000000000000000012211303454263000161520ustar00rootroot00000000000000\DOC INT_GE_CONV \TYPE {INT_GE_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:int} is {>=} another. \DESCRIBE The call {INT_GE_CONV `c1 >= c2`} where {c1} and {c2} are integer literals of type {:int}, returns whichever of {|- c1 >= c2 <=> T} or {|- c1 >= c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:int}. \EXAMPLE { # INT_GE_CONV `&7 >= &6`;; val it : thm = |- &7 >= &6 <=> T } \SEEALSO INT_REDUCE_CONV, REAL_RAT_GE_CONV. \ENDDOC hol-light/Help/INT_GT_CONV.doc000066400000000000000000000012131303454263000161720ustar00rootroot00000000000000\DOC INT_GT_CONV \TYPE {INT_GT_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:int} is {<} another. \DESCRIBE The call {INT_GT_CONV `c1 > c2`} where {c1} and {c2} are integer literals of type {:int}, returns whichever of {|- c1 > c2 <=> T} or {|- c1 > c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:int}. \EXAMPLE { # INT_GT_CONV `&1 > &2`;; val it : thm = |- &1 > &2 <=> F } \SEEALSO INT_REDUCE_CONV, REAL_RAT_GT_CONV. \ENDDOC hol-light/Help/INT_LE_CONV.doc000066400000000000000000000012251303454263000161630ustar00rootroot00000000000000\DOC INT_LE_CONV \TYPE {INT_LE_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:int} is {<=} another. \DESCRIBE The call {INT_LE_CONV `c1 <= c2`} where {c1} and {c2} are integer literals of type {:int}, returns whichever of {|- c1 <= c2 <=> T} or {|- c1 <= c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:int}. \EXAMPLE { # INT_LE_CONV `&11 <= &77`;; val it : thm = |- &11 <= &77 <=> T } \SEEALSO INT_REDUCE_CONV, REAL_RAT_LE_CONV. \ENDDOC hol-light/Help/INT_LT_CONV.doc000066400000000000000000000016011303454263000162000ustar00rootroot00000000000000\DOC INT_LT_CONV \TYPE {INT_LT_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:int} is {<} another. \DESCRIBE The call {INT_LT_CONV `c1 < c2`} where {c1} and {c2} are integer literals of type {:int}, returns whichever of {|- c1 < c2 <=> T} or {|- c1 < c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:int}. \EXAMPLE { # INT_LT_CONV `-- &18 < &64`;; val it : thm = |- -- &18 < &64 <=> T } \COMMENTS The related function {REAL_RAT_LT_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_REDUCE_CONV, REAL_RAT_LT_CONV. \ENDDOC hol-light/Help/INT_MAX_CONV.doc000066400000000000000000000013621303454263000163120ustar00rootroot00000000000000\DOC INT_MAX_CONV \TYPE {INT_MAX_CONV : conv} \SYNOPSIS Conversion to perform addition on two integer literals of type {:int}. \DESCRIBE The call {INT_MAX_CONV `max c1 c2`} where {c1} and {c2} are integer literals of type {:int}, returns {|- max c1 c2 = d} where {d} is the canonical integer literal that is equal to {max c1 c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the maximum operator applied to two permitted integer literals of type {:int}. \EXAMPLE { # INT_MAX_CONV `max (-- &1) (&2)`;; val it : thm = |- max (-- &1) (&2) = &2 } \SEEALSO INT_REDUCE_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/INT_MIN_CONV.doc000066400000000000000000000013621303454263000163100ustar00rootroot00000000000000\DOC INT_MIN_CONV \TYPE {INT_MIN_CONV : conv} \SYNOPSIS Conversion to perform addition on two integer literals of type {:int}. \DESCRIBE The call {INT_MIN_CONV `min c1 c2`} where {c1} and {c2} are integer literals of type {:int}, returns {|- min c1 c2 = d} where {d} is the canonical integer literal that is equal to {min c1 c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the minimum operator applied to two permitted integer literals of type {:int}. \EXAMPLE { # INT_MIN_CONV `min (-- &1) (&2)`;; val it : thm = |- min (-- &1) (&2) = &2 } \SEEALSO INT_REDUCE_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/INT_MUL_CONV.doc000066400000000000000000000013261303454263000163220ustar00rootroot00000000000000\DOC INT_MUL_CONV \TYPE {INT_MUL_CONV : conv} \SYNOPSIS Conversion to perform multiplication on two integer literals of type {:int}. \DESCRIBE The call {INT_MUL_CONV `c1 * c2`} where {c1} and {c2} are integer literals of type {:int}, returns {|- c1 * c2 = d} where {d} is the canonical integer literal that is equal to {c1 * c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the product of two permitted integer literals of type {:int}. \EXAMPLE { # INT_MUL_CONV `&6 * -- &9`;; val it : thm = |- &6 * -- &9 = -- &54 } \SEEALSO INT_REDUCE_CONV, REAL_RAT_MUL_CONV. \ENDDOC hol-light/Help/INT_NEG_CONV.doc000066400000000000000000000016761303454263000163060ustar00rootroot00000000000000\DOC INT_NEG_CONV \TYPE {INT_NEG_CONV : conv} \SYNOPSIS Conversion to negate an integer literal of type {:int}. \DESCRIBE The call {INT_NEG_CONV `--c`}, where {c} is an integer literal of type {:int}, returns the theorem {|- --c = d} where {d} is the canonical integer literal that is equal to {c}'s negation. The literal {c} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the negation of one of the permitted forms of integer literal of type {:int}. \EXAMPLE { # INT_NEG_CONV `-- (-- &3 / &2)`;; val it : thm = |- --(-- &3 / &2) = &3 / &2 } \COMMENTS The related function {REAL_RAT_NEG_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_REDUCE_CONV, REAL_RAT_NEG_CONV. \ENDDOC hol-light/Help/INT_OF_REAL_THM.doc000066400000000000000000000025541303454263000166630ustar00rootroot00000000000000\DOC INT_OF_REAL_THM \TYPE {INT_OF_REAL_THM : thm -> thm} \SYNOPSIS Map a universally quantified theorem from reals to integers. \DESCRIBE We often regard integers as a subset of the reals, so any universally quantified theorem over the reals also holds for the integers, and indeed any other subset. In HOL, integers and reals are completely separate types ({int} and {real} respectively). However, there is a natural injection (actually called {dest_int}) from integers to reals that maps integer operations to their real counterparts, and using this we can similarly show that any universally quantified formula over the reals also holds over the integers with operations mapped to the right type. The rule {INT_OF_REAL_THM} embodies this procedure; given a universally quantified theorem over the reals, it maps it to a corresponding theorem over the integers. \FAILURE Never fails. \EXAMPLE { # REAL_ABS_TRIANGLE;; val it : thm = |- !x y. abs (x + y) <= abs x + abs y # map dest_var (variables(concl it));; val it : (string * hol_type) list = [("y", `:real`); ("x", `:real`)] # INT_OF_REAL_THM REAL_ABS_TRIANGLE;; val it : thm = |- !x y. abs (x + y) <= abs x + abs y # map dest_var (variables(concl it));; val it : (string * hol_type) list = [("y", `:int`); ("x", `:int`)] } \SEEALSO ARITH_RULE, INT_ARITH, INT_ARITH_TAC, NUM_TO_INT_CONV, REAL_ARITH. \ENDDOC hol-light/Help/INT_POLY_CONV.doc000066400000000000000000000036351303454263000164550ustar00rootroot00000000000000\DOC INT_POLY_CONV \TYPE {INT_POLY_CONV : term -> thm} \SYNOPSIS Converts a integer polynomial into canonical form. \DESCRIBE Given a term of type {:int} that is built up using addition, subtraction, negation and multiplication, {INT_POLY_CONV} converts it into a canonical polynomial form and returns a theorem asserting the equivalence of the original and canonical terms. The basic elements need not simply be variables or constants; anything not built up using the operators given above will be considered `atomic' for the purposes of this conversion. The canonical polynomial form is a `multiplied out' sum of products, with the monomials (product terms) ordered according to the canonical OCaml order on terms. In particular, it is just {&0} if the polynomial is identically zero. \FAILURE Never fails, even if the term has the wrong type; in this case it merely returns a reflexive theorem. \EXAMPLE This illustrates how terms are `multiplied out': { # INT_POLY_CONV `(x + y) pow 3`;; val it : thm = |- (x + y) pow 3 = x pow 3 + &3 * x pow 2 * y + &3 * x * y pow 2 + y pow 3 } \noindent while the following verifies a remarkable `sum of cubes' identity due to Yasutoshi Kohmoto: { # INT_POLY_CONV `(&1679616 * a pow 16 - &66096 * a pow 10 * b pow 6 + &153 * a pow 4 * b pow 12) pow 3 + (-- &1679616 * a pow 16 - &559872 * a pow 13 * b pow 3 - &27216 * a pow 10 * b pow 6 + &3888 * a pow 7 * b pow 9 + &63 * a pow 4 * b pow 12 - &3 * a * b pow 15) pow 3 + (&1679616 * a pow 15 * b + &279936 * a pow 12 * b pow 4 - &11664 * a pow 9 * b pow 7 - &648 * a pow 6 * b pow 10 + &9 * a pow 3 * b pow 13 + b pow 16) pow 3`;; val it : thm = |- ... = b pow 48 } \USES Keeping terms in normal form. For simply proving equalities, {INT_RING} is more powerful and usually more convenient. \SEEALSO INT_ARITH, INT_RING, REAL_POLY_CONV, SEMIRING_NORMALIZERS_CONV. \ENDDOC hol-light/Help/INT_POW_CONV.doc000066400000000000000000000014261303454263000163330ustar00rootroot00000000000000\DOC INT_POW_CONV \TYPE {INT_POW_CONV : conv} \SYNOPSIS Conversion to perform exponentiation on a integer literal of type {:int}. \DESCRIBE The call {INT_POW_CONV `c pow n`} where {c} is an integer literal of type {:int} and {n} is a numeral of type {:num}, returns {|- c pow n = d} where {d} is the canonical integer literal that is equal to {c} raised to the {n}th power. The literal {c} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not a permitted integer literal of type {:int} raised to a numeral power. \EXAMPLE { # INT_POW_CONV `(-- &2) pow 77`;; val it : thm = |- -- &2 pow 77 = -- &151115727451828646838272 } \SEEALSO INT_POW_CONV, INT_REDUCE_CONV. \ENDDOC hol-light/Help/INT_REDUCE_CONV.doc000066400000000000000000000023351303454263000166350ustar00rootroot00000000000000\DOC INT_REDUCE_CONV \TYPE {INT_REDUCE_CONV : conv} \SYNOPSIS Evaluate subexpressions built up from integer literals of type {:int}, by proof. \DESCRIBE When applied to a term, {INT_REDUCE_CONV} performs a recursive bottom-up evaluation by proof of subterms built from integer literals of type {:int} using the unary operators `{--}', `{inv}' and `{abs}', and the binary arithmetic (`{+}', `{-}', `{*}', `{/}', `{pow}') and relational (`{<}', `{<=}', `{>}', `{>=}', `{=}') operators, as well as propagating literals through logical operations, e.g. {T /\ x <=> x}, returning a theorem that the original and reduced terms are equal. The permissible integer literals are of the form {&n} or {-- &n} for numeral {n}, nonzero in the negative case. \FAILURE Never fails, but may have no effect. \EXAMPLE { # INT_REDUCE_CONV `if &5 pow 4 < &4 pow 5 then (&2 pow 3 - &1) pow 2 + &1 else &99`;; val it : thm = |- (if &5 pow 4 < &4 pow 5 then (&2 pow 3 - &1) pow 2 + &1 else &99) = &50 } \COMMENTS The corresponding {INT_REDUCE_CONV} works for the type of integers. The more general function {REAL_RAT_REDUCE_CONV} works similarly over {:int} but for arbitrary rational literals. \SEEALSO INT_RED_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/INT_RED_CONV.doc000066400000000000000000000024651303454263000163040ustar00rootroot00000000000000\DOC INT_RED_CONV \TYPE {INT_RED_CONV : term -> thm} \SYNOPSIS Performs one arithmetic or relational operation on integer literals of type {:int}. \DESCRIBE When applied to any of the terms {`--c`}, {`abs c`}, {`c1 + c2`}, {`c1 - c2`}, {`c1 * c2`}, {`c pow n`}, {`c1 <= c2`}, {`c1 < c2`}, {`c1 >= c2`}, {`c1 > c2`}, {`c1 = c2`}, where {c}, {c1} and {c2} are integer literals of type {:int} and {n} is a numeral of type {:num}, {INT_RED_CONV} returns a theorem asserting the equivalence of the term to a canonical integer (for the arithmetic operators) or a truth-value (for the relational operators). The integer literals are terms of the form {&n} or {-- &n} (with nonzero {n} in the latter case). \FAILURE Fails if applied to an inappropriate term. \USES More convenient for most purposes is {INT_REDUCE_CONV}, which applies these evaluation conversions recursively at depth, or still more generally {REAL_RAT_REDUCE_CONV} which applies to any rational numbers, not just integers. Still, access to this `one-step' reduction can be handy if you want to add a conversion {conv} for some other operator on int number literals, which you can conveniently incorporate it into {INT_REDUCE_CONV} with { # let INT_REDUCE_CONV' = DEPTH_CONV(INT_RED_CONV ORELSEC conv);; } \SEEALSO INT_REDUCE_CONV, REAL_RAT_RED_CONV. \ENDDOC hol-light/Help/INT_RING.doc000066400000000000000000000055271303454263000156060ustar00rootroot00000000000000\DOC INT_RING \TYPE {INT_RING : term -> thm} \SYNOPSIS Ring decision procedure instantiated to integers. \DESCRIBE The rule {INT_RING} should be applied to a formula that, after suitable normalization, can be considered a universally quantified Boolean combination of equations and inequations between terms of type {:int}. If that formula holds in all integral domains, {INT_RING} will prove it. Any ``alien'' atomic formulas that are not integer equations will not contribute to the proof but will not in themselves cause an error. The function is a particular instantiation of {RING}, which is a more generic procedure for ring and semiring structures. \FAILURE Fails if the formula is unprovable by the methods employed. This does not necessarily mean that it is not valid for {:int}, but rather that it is not valid on all integral domains (see below). \EXAMPLE Here is a nice identity taken from one of Ramanujan's notebooks: { # INT_RING `!a b c:int. a + b + c = &0 ==> &2 * (a * b + a * c + b * c) pow 2 = a pow 4 + b pow 4 + c pow 4 /\ &2 * (a * b + a * c + b * c) pow 4 = (a * (b - c)) pow 4 + (b * (a - c)) pow 4 + (c * (a - b)) pow 4`;; ... val it : thm = |- !a b c. a + b + c = &0 ==> &2 * (a * b + a * c + b * c) pow 2 = a pow 4 + b pow 4 + c pow 4 /\ &2 * (a * b + a * c + b * c) pow 4 = (a * (b - c)) pow 4 + (b * (a - c)) pow 4 + (c * (a - b)) pow 4 } The reasoning {INT_RING} is capable of includes, of course, the degenerate case of simple algebraic identity, e.g. Brahmagupta's identity: { # INT_RING `(a pow 2 + b pow 2) * (c pow 2 + d pow 2) = (a * c - b * d) pow 2 + (a * d + b * c) pow 2`;; } \noindent or the more complicated 4-squares variant: { # INT_RING `(x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) * (y1 pow 2 + y2 pow 2 + y3 pow 2 + y4 pow 2) = (x1 * y1 - x2 * y2 - x3 * y3 - x4 * y4) pow 2 + (x1 * y2 + x2 * y1 + x3 * y4 - x4 * y3) pow 2 + (x1 * y3 - x2 * y4 + x3 * y1 + x4 * y2) pow 2 + (x1 * y4 + x2 * y3 - x3 * y2 + x4 * y1) pow 2`;; ... } Note that formulas depending on specific features of the integers are not always provable by this generic ring procedure. For example we cannot prove: { # INT_RING `x pow 2 = &2 ==> F`;; 1 basis elements and 0 critical pairs Exception: Failure "find". } Although it is possible to deal with special cases like this, there can be no general algorithm for testing such properties over the integers: the set of true universally quantified equations over the integers with addition and multiplication is not recursively enumerable. (This follows from Matiyasevich's results on diophantine sets leading to the undecidability of Hilbert's 10th problem.) \SEEALSO INT_ARITH, INT_ARITH_TAC, int_ideal_cofactors, NUM_RING, REAL_RING, REAL_FIELD. \ENDDOC hol-light/Help/INT_SUB_CONV.doc000066400000000000000000000013241303454263000163140ustar00rootroot00000000000000\DOC INT_SUB_CONV \TYPE {INT_SUB_CONV : conv} \SYNOPSIS Conversion to perform subtraction on two integer literals of type {:int}. \DESCRIBE The call {INT_SUB_CONV `c1 - c2`} where {c1} and {c2} are integer literals of type {:int}, returns {|- c1 - c2 = d} where {d} is the canonical integer literal that is equal to {c1 - c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the difference of two permitted integer literals of type {:int}. \EXAMPLE { # INT_SUB_CONV `&33 - &77`;; val it : thm = |- &33 - &77 = -- &44 } \SEEALSO INT_REDUCE_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/ISPEC.doc000066400000000000000000000016371303454263000151760ustar00rootroot00000000000000\DOC ISPEC \TYPE {ISPEC : term -> thm -> thm} \SYNOPSIS Specializes a theorem, with type instantiation if necessary. \KEYWORDS rule, type. \DESCRIBE This rule specializes a quantified variable as does {SPEC}; it differs from it in also instantiating the type if needed, both in the conclusion and hypotheses: { A |- !x:ty.tm ----------------------- ISPEC `t:ty'` A[ty'/ty] |- tm[t/x] } \noindent (where {t} is free for {x} in {tm}, and {ty'} is an instance of {ty}). \FAILURE {ISPEC} fails if the input theorem is not universally quantified, or if the type of the given term is not an instance of the type of the quantified variable. \EXAMPLE { # ISPEC `0` EQ_REFL;; val it : thm = |- 0 = 0 } \noindent Note that the corresponding call to {SPEC} would fail because of the type mismatch: { # SPEC `0` EQ_REFL;; Exception: Failure "SPEC". } \SEEALSO INST, INST_TYPE, ISPECL, SPEC, type_match. \ENDDOC hol-light/Help/ISPECL.doc000066400000000000000000000017031303454263000153040ustar00rootroot00000000000000\DOC ISPECL \TYPE {ISPECL : term list -> thm -> thm} \SYNOPSIS Specializes a theorem zero or more times, with type instantiation if necessary. \KEYWORDS rule, type. \DESCRIBE {ISPECL} is an iterative version of {ISPEC} { A |- !x1...xn.t ----------------------------- ISPECL [`t1`,...,`tn`] A' |- t[t1,...tn/x1,...,xn] } \noindent (where {ti} is free for {xi} in {tm}) in which {A'} results from applying all the corresponding type instantiations to the assumption list {A}. \FAILURE {ISPECL} fails if the list of terms is longer than the number of quantified variables in the term, or if the type instantiation fails. \EXAMPLE { # ISPECL [`x:num`; `2`] EQ_SYM_EQ;; val it : thm = |- x = 2 <=> 2 = x } \noindent Note that the corresponding call to {SPECL} would fail because of the type mismatch: { # SPECL [`x:num`; `2`] EQ_SYM_EQ;; Exception: Failure "SPECL". } \SEEALSO INST_TYPE, INST, ISPEC, SPEC, SPECL, type_match. \ENDDOC hol-light/Help/ITAUT.doc000066400000000000000000000025441303454263000152170ustar00rootroot00000000000000\DOC ITAUT \TYPE {ITAUT : term -> thm} \SYNOPSIS Attempt to prove term using intuitionistic first-order logic. \DESCRIBE The call {ITAUT `p`} attempts to prove {p} using a basic tableau-type proof search for intuitionistic first-order logic. The restriction to intuitionistic logic means that no principles such as the ``law of the excluded middle'' or ``law of double negation'' are used. \FAILURE Fails if the goal is non-Boolean. May also fail if it's unprovable, though more usually this results in indefinite looping. \EXAMPLE This is intuitionistically valid, so it works: { # ITAUT `~(~(~p)) ==> ~p`;; ... val it : thm = |- ~ ~ ~p ==> ~p } \noindent whereas this, one of the main non-intuitionistic principles, is not: { # ITAUT `~(~p) ==> p`;; Searching with limit 0 Searching with limit 1 Searching with limit 2 Searching with limit 3 ... } \noindent so the procedure loops; you can as usual terminate such loops with control-C. \COMMENTS Normally, first-order reasoning should be performed by {MESON[]}, which is much more powerful, complete for all classical logic, and handles equality. The function {ITAUT} is mainly for ``bootstrapping'' purposes. Nevertheless it may sometimes be intellectually interesting to see that certain logical formulas are provable intuitionistically. \SEEALSO BOOL_CASES_TAC, ITAUT_TAC, MESON, MESON_TAC. \ENDDOC hol-light/Help/ITAUT_TAC.doc000066400000000000000000000032041303454263000157000ustar00rootroot00000000000000\DOC ITAUT_TAC \TYPE {ITAUT_TAC : tactic} \SYNOPSIS Simple intuitionistic logic prover. \DESCRIBE The tactic {ITAUT} attempts to prove the goal using a basic tableau-type proof search for intuitionistic first-order logic. The restriction to intuitionistic logic means that no principles such as the ``law of the excluded middle'' or ``law of double negation'' are used. \FAILURE May fail if the goal is unprovable, e.g. for purely propositional problems. For unsolvable problems with quantifiers it usually just loops. \EXAMPLE Suppose we try to prove the logical equivalence of ``contraposition'', already embedded in the pre-proved theorem {CONTRAPOS_THM}: { # g `!p q. (p ==> q) <=> (~q ==> ~p)`;; } \noindent by splitting it into two subgoals: { # e(REPEAT GEN_TAC THEN EQ_TAC);; val it : goalstack = 2 subgoals (2 total) `(~q ==> ~p) ==> p ==> q` `(p ==> q) ==> ~q ==> ~p` } \noindent The first subgoal (printed at the bottom) can be solved by {ITAUT_TAC}, indicating that it's intuitionistically valid: { # e ITAUT_TAC;; ... val it : goalstack = 1 subgoal (1 total) `(~q ==> ~p) ==> p ==> q` } \noindent but the other one isn't, though it is solvable by full classical logic: { # e(MESON_TAC[]);; val it : goalstack = No subgoals } \COMMENTS Normally, first-order reasoning should be performed by {MESON_TAC[]}, which is much more powerful, complete for all classical logic, and handles equality. The function {ITAUT_TAC} is mainly for ``bootstrapping'' purposes. Nevertheless it may sometimes be intellectually interesting to see that certain logical formulas are provable intuitionistically. \SEEALSO ITAUT, MESON_TAC. \ENDDOC hol-light/Help/K.doc000066400000000000000000000002661303454263000145220ustar00rootroot00000000000000\DOC K \TYPE {K : 'a -> 'b -> 'a} \SYNOPSIS Forms a constant function: {(K x) y} = {x}. \KEYWORDS combinator, constant. \FAILURE Never fails. \SEEALSO C, F_F, I, o, W. \ENDDOC hol-light/Help/LABEL_TAC.doc000066400000000000000000000057261303454263000156440ustar00rootroot00000000000000\DOC LABEL_TAC \TYPE {LABEL_TAC : string -> thm_tactic} \SYNOPSIS Add an assumption with a named label to a goal. \DESCRIBE Given a theorem {th}, the tactic {LABEL_TAC "name" th} will add {th} as a new hypothesis, just as {ASSUME_TAC} does, but will also give it {name} as a label. The name will show up when the goal is printed, and can be used to refer to the theorem in tactics like {USE_THEN} and {REMOVE_THEN}. \FAILURE Never fails, though may be invalid if the theorem has assumptions that are not a subset of those in the goal, up to alpha-equivalence. \EXAMPLE Suppose we want to prove that a binary relation {<<=} that is antisymmetric and has a strong wellfoundedness property is also total and transitive, and hence a wellorder: { # g `(!x y. x <<= y /\ y <<= x ==> x = y) /\ (!s. ~(s = {{}}) ==> ?a:A. a IN s /\ !x. x IN s ==> a <<= x) ==> (!x y. x <<= y \/ y <<= x) /\ (!x y z. x <<= y /\ y <<= z ==> x <<= z)`;; } \noindent We might start by putting the two hypotheses on the assumption list with intuitive names: { # e(DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "antisym") (LABEL_TAC "wo")));; val it : goalstack = 1 subgoal (1 total) 0 [`!x y. x <<= y /\ y <<= x ==> x = y`] (antisym) 1 [`!s. ~(s = {{}}) ==> (?a. a IN s /\ (!x. x IN s ==> a <<= x))`] (wo) `(!x y. x <<= y \/ y <<= x) /\ (!x y z. x <<= y /\ y <<= z ==> x <<= z)` } Now we break down the goal a bit { # e(REPEAT STRIP_TAC);; val it : goalstack = 2 subgoals (2 total) 0 [`!x y. x <<= y /\ y <<= x ==> x = y`] (antisym) 1 [`!s. ~(s = {{}}) ==> (?a. a IN s /\ (!x. x IN s ==> a <<= x))`] (wo) 2 [`x <<= y`] 3 [`y <<= z`] `x <<= z` 0 [`!x y. x <<= y /\ y <<= x ==> x = y`] (antisym) 1 [`!s. ~(s = {{}}) ==> (?a. a IN s /\ (!x. x IN s ==> a <<= x))`] (wo) `x <<= y \/ y <<= x` } \noindent We want to specialize the wellordering assumption to an appropriate set for each case, and we can identify it using the label {wo}; the problem is then simple set-theoretic reasoning: { # e(USE_THEN "wo" (MP_TAC o SPEC `{{x:A,y:A}}`) THEN SET_TAC[]);; ... val it : goalstack = 1 subgoal (1 total) 0 [`!x y. x <<= y /\ y <<= x ==> x = y`] (antisym) 1 [`!s. ~(s = {{}}) ==> (?a. a IN s /\ (!x. x IN s ==> a <<= x))`] (wo) 2 [`x <<= y`] 3 [`y <<= z`] `x <<= z` } \noindent Similarly for the other one: { # e(USE_THEN "wo" (MP_TAC o SPEC `{{x:A,y:A,z:A}}`) THEN ASM SET_TAC[]);; ... val it : goalstack = No subgoals } \USES Convenient for referring to an assumption explicitly, just as in mathematics books one sometimes marks a theorem with an asterisk or dagger, then refers to it using that symbol. \COMMENTS There are other ways of identifying assumptions than by label, but they are not always convenient. For example, explicitly doing {ASSUME `asm`} is cumbersome if {asm} is large, and using its number in the assumption list can make proofs very brittle under later changes. \SEEALSO ASSUME_TAC, DESTRUCT_TAC, HYP, INTRO_TAC, REMOVE_THEN, USE_THEN. \ENDDOC hol-light/Help/LAMBDA_ELIM_CONV.doc000066400000000000000000000016301303454263000166770ustar00rootroot00000000000000\DOC LAMBDA_ELIM_CONV \TYPE {LAMBDA_ELIM_CONV : conv} \SYNOPSIS Eliminate lambda-terms that are not part of quantifiers from Boolean term. \DESCRIBE When applied to a Boolean term, {LAMBDA_ELIM_CONV} returns an equivalent version with `bare' lambda-terms (those not part of quantifiers) removed. They are replaced with new `function' variables and suitable hypotheses about them; for example a lambda-term {\x. t[x]} is replaced by a function {f} with an additional hypothesis {!x. f x = t[x]}. \FAILURE Never fails. \EXAMPLE { # LAMBDA_ELIM_CONV `MAP (\x. x + 1) l = l'`;; val it : thm = |- MAP (\x. x + 1) l = l' <=> (!_73141. (!x. _73141 x = x + 1) ==> MAP _73141 l = l') } \USES This is mostly intended for normalization prior to automated proof procedures, and is used by {MESON}, for example. However, it may sometimes be useful in itself. \SEEALSO SELECT_ELIM_TAC, CONDS_ELIM_CONV. \ENDDOC hol-light/Help/LAND_CONV.doc000066400000000000000000000010651303454263000156710ustar00rootroot00000000000000\DOC LAND_CONV \TYPE {LAND_CONV : conv -> conv} \SYNOPSIS Apply a conversion to left-hand argument of binary operator. \DESCRIBE If {c} is a conversion where {c `l`} gives {|- l = l'}, then {LAND_CONV c `op l r`} gives {|- op l r = op l' r}. \FAILURE Fails if the underlying conversion does or returns an inappropriate theorem (i.e. is not really a conversion). \EXAMPLE { # LAND_CONV NUM_ADD_CONV `(2 + 2) + (2 + 2)`;; val it : thm = |- (2 + 2) + 2 + 2 = 4 + 2 + 2 } \SEEALSO ABS_CONV, COMB_CONV, COMB_CONV2, RAND_CONV, RATOR_CONV, SUB_CONV. \ENDDOC hol-light/Help/LET_TAC.doc000066400000000000000000000020131303454263000154330ustar00rootroot00000000000000\DOC LET_TAC \TYPE {LET_TAC : tactic} \SYNOPSIS Eliminates a let binding in a goal by introducing equational assumptions. \DESCRIBE Given a goal {A ?- t} where {t} contains a free let-expression {let x1 = E1 and ... let xn = En in E}, the tactic {LET_TAC} replaces that subterm by simply {E} but adds new assumptions {E1 = x1}, ..., {En = xn}. That is, the local let bindings are replaced with new assumptions, put in reverse order so that {ASM_REWRITE_TAC} will not immediately expand them. In cases where the term contains several let-expression candidates, a topmost one will be selected. In particular, if let-expressions are nested, the outermost one will be handled. \FAILURE Fails if the goal contains no eligible let-term. \EXAMPLE { # g `let x = 2 and y = 3 in x + 1 <= y`;; val it : goalstack = 1 subgoal (1 total) `let x = 2 and y = 3 in x + 1 <= y` # e LET_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`2 = x`] 1 [`3 = y`] `x + 1 <= y` } \SEEALSO ABBREV_TAC, EXPAND_TAC, let_CONV. \ENDDOC hol-light/Help/LE_IMP.doc000066400000000000000000000013671303454263000153400ustar00rootroot00000000000000\DOC LE_IMP \TYPE {LE_IMP : thm -> thm} \SYNOPSIS Perform transitivity chaining for non-strict natural number inequality. \DESCRIBE When applied to a theorem {A |- s <= t} where {s} and {t} have type {num}, the rule {LE_IMP} returns {A |- !x1...xn z. t <= z ==> s <= z}, where {z} is some variable and the {x1,...,xn} are free variables in {s} and {t}. \FAILURE Fails if applied to a theorem whose conclusion is not of the form {`s <= t`} for some natural number terms {s} and {t}. \EXAMPLE { # LE_IMP (ARITH_RULE `n <= SUC(m + n)`);; val it : thm = |- !m n p. SUC (m + n) <= p ==> n <= p } \USES Can make transitivity chaining in goals easier, e.g. by {FIRST_ASSUM(MATCH_MP_TAC o LE_IMP)}. \SEEALSO ARITH_RULE, REAL_LE_IMP, REAL_LET_IMP. \ENDDOC hol-light/Help/LIST_CONV.doc000066400000000000000000000012101303454263000157160ustar00rootroot00000000000000\DOC LIST_CONV \TYPE {LIST_CONV : conv -> conv} \SYNOPSIS Apply a conversion to each element of a list. \DESCRIBE If {cnv `ti`} returns {|- ti = ti'} for {i} ranging from {1} to {n}, then {LIST_CONV cnv `[t1; ...; tn]`} returns {|- [t1; ...; tn] = [t1'; ...; tn']}. \FAILURE Fails if the conversion fails on any list element. \EXAMPLE { # LIST_CONV num_CONV `[1;2;3;4;5]`;; val it : thm = |- [1; 2; 3; 4; 5] = [SUC 0; SUC 1; SUC 2; SUC 3; SUC 4] } \USES Applying a conversion more delicately than simply by {DEPTH_CONV} etc. \SEEALSO DEPTH_BINOP_CONV, DEPTH_CONV, ONCE_DEPTH_CONV, REDEPTH_CONV, TOP_DEPTH_CONV, TOP_SWEEP_CONV. \ENDDOC hol-light/Help/LIST_INDUCT_TAC.doc000066400000000000000000000057151303454263000166440ustar00rootroot00000000000000\DOC LIST_INDUCT_TAC \TYPE {LIST_INDUCT_TAC : tactic} \SYNOPSIS Performs tactical proof by structural induction on lists. \KEYWORDS tactic, list, induction. \DESCRIBE {LIST_INDUCT_TAC} reduces a goal {A ?- !l. P[l]}, where {l} ranges over lists, to two subgoals corresponding to the base and step cases in a proof by structural induction on {l}. The induction hypothesis appears among the assumptions of the subgoal for the step case. The specification of {LIST_INDUCT_TAC} is: { A ?- !l. P ===================================================== LIST_INDUCT_TAC A |- P[[]/l] A u {{P[t/l]}} ?- P[CONS h t/l] } \FAILURE {LIST_INDUCT_TAC g} fails unless the conclusion of the goal {g} has the form {`!l. t`}, where the variable {l} has type {(ty)list} for some type {ty}. \EXAMPLE Many simple list theorems can be proved simply by list induction then just first-order reasoning (or even rewriting) with definitions of the operations involved. For example if we want to prove that mapping a composition of functions over a list is the same as successive mapping of the two functions: { # g `!l f:A->B g:B->C. MAP (g o f) l = MAP g (MAP f l)`;; } \noindent we can start by list induction: { # e LIST_INDUCT_TAC;; val it : goalstack = 2 subgoals (2 total) 0 [`!f g. MAP (g o f) t = MAP g (MAP f t)`] `!f g. MAP (g o f) (CONS h t) = MAP g (MAP f (CONS h t))` `!f g. MAP (g o f) [] = MAP g (MAP f [])` } \noindent and each resulting subgoal is just solved at once by: { # e(ASM_REWRITE_TAC[MAP; o_THM]);; } \COMMENTS Essentially the same effect can be had by {MATCH_MP_TAC list_INDUCT}. This does not subsequently break down the goal in such a convenient way, but gives more control over choice of variable. For example, starting with the same goal: { # g `!l f:A->B g:B->C. MAP (g o f) l = MAP g (MAP f l)`;; } \noindent we get: { # e(MATCH_MP_TAC list_INDUCT);; val it : goalstack = 1 subgoal (1 total) `(!f g. MAP (g o f) [] = MAP g (MAP f [])) /\ (!a0 a1. (!f g. MAP (g o f) a1 = MAP g (MAP f a1)) ==> (!f g. MAP (g o f) (CONS a0 a1) = MAP g (MAP f (CONS a0 a1))))` } \noindent and after getting rid of some trivia: { # e(REWRITE_TAC[MAP]);; val it : goalstack = 1 subgoal (1 total) `!a0 a1. (!f g. MAP (g o f) a1 = MAP g (MAP f a1)) ==> (!f g. CONS ((g o f) a0) (MAP (g o f) a1) = CONS (g (f a0)) (MAP g (MAP f a1)))` } \noindent we can carefully choose the variable names: { # e(MAP_EVERY X_GEN_TAC [`k:A`; `l:A list`]);; val it : goalstack = 1 subgoal (1 total) `(!f g. MAP (g o f) l = MAP g (MAP f l)) ==> (!f g. CONS ((g o f) k) (MAP (g o f) l) = CONS (g (f k)) (MAP g (MAP f l)))` } \noindent This kind of control can be useful when the sub-proof is more challenging. Here of course the same simple pattern as before works: { # e(SIMP_TAC[o_THM]);; val it : goalstack = No subgoals } \SEEALSO INDUCT_TAC, MATCH_MP_TAC, WF_INDUCT_TAC. \ENDDOC hol-light/Help/MAP_EVERY.doc000066400000000000000000000020221303454263000157070ustar00rootroot00000000000000\DOC MAP_EVERY \TYPE {MAP_EVERY : ('a -> tactic) -> 'a list -> tactic} \SYNOPSIS Sequentially applies all tactics given by mapping a function over a list. \KEYWORDS theorem-tactical, list. \DESCRIBE When applied to a tactic-producing function {f} and an operand list {[x1;...;xn]}, the elements of which have the same type as {f}'s domain type, {MAP_EVERY} maps the function {f} over the list, producing a list of tactics, then applies these tactics in sequence as in the case of {EVERY}. The effect is: { MAP_EVERY f [x1;...;xn] = (f x1) THEN ... THEN (f xn) } \noindent If the operand list is empty, then {MAP_EVERY} has no effect. \FAILURE The application of {MAP_EVERY} to a function and operand list fails iff the function fails when applied to any element in the list. The resulting tactic fails iff any of the resulting tactics fails. \EXAMPLE A convenient way of doing case analysis over several boolean variables is: { MAP_EVERY BOOL_CASES_TAC [`v1:bool`;...;`vn:bool`] } \SEEALSO EVERY, FIRST, MAP_FIRST, THEN. \ENDDOC hol-light/Help/MAP_FIRST.doc000066400000000000000000000044151303454263000157140ustar00rootroot00000000000000\DOC MAP_FIRST \TYPE {MAP_FIRST : ('a -> tactic) -> 'a list -> tactic} \SYNOPSIS Applies first tactic that succeeds in a list given by mapping a function over a list. \KEYWORDS theorem-tactical, list. \DESCRIBE When applied to a tactic-producing function {f} and an operand list {[x1;...;xn]}, the elements of which have the same type as {f}'s domain type, {MAP_FIRST} maps the function {f} over the list, producing a list of tactics, then tries applying these tactics to the goal till one succeeds. If {f(xm)} is the first to succeed, then the overall effect is the same as applying {f(xm)}. Thus: { MAP_FIRST f [x1;...;xn] = (f x1) ORELSE ... ORELSE (f xn) } \FAILURE The application of {MAP_FIRST} to a function and tactic list fails iff the function does when applied to any of the elements of the list. The resulting tactic fails iff all the resulting tactics fail when applied to the goal. \EXAMPLE Using the definition of integer-valued real numbers: { # needs "Library/floor.ml";; } \noindent we have a set of `composition' theorems asserting that the predicate is closed under various arithmetic operations: { # INTEGER_CLOSED;; val it : thm = |- (!n. integer (&n)) /\ (!x y. integer x /\ integer y ==> integer (x + y)) /\ (!x y. integer x /\ integer y ==> integer (x - y)) /\ (!x y. integer x /\ integer y ==> integer (x * y)) /\ (!x r. integer x ==> integer (x pow r)) /\ (!x. integer x ==> integer (--x)) /\ (!x. integer x ==> integer (abs x)) } \noindent if we want to prove that some composite term has integer type: { # g `integer(x) /\ integer(y) ==> integer(&2 * (x - &1) pow 7 + &11 * (y + &1))`;; ... # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`integer x`] 1 [`integer y`] `integer (&2 * (x - &1) pow 7 + &11 * (y + &1))` } A direct proof using {ASM_MESON_TAC[INTEGER_CLOSED]} works fine. However if we want to control the application of composition theorems more precisely we might do: { # let INT_CLOSURE_TAC = MAP_FIRST MATCH_MP_TAC (CONJUNCTS(CONJUNCT2 INTEGER_CLOSED)) THEN TRY CONJ_TAC;; } \noindent and then could solve the goal by: { e(REPEAT INT_CLOSURE_TAC THEN ASM_REWRITE_TAC[CONJUNCT1 INTEGER_CLOSED]);; } \SEEALSO EVERY, FIRST, MAP_EVERY, ORELSE. \ENDDOC hol-light/Help/MATCH_ACCEPT_TAC.doc000066400000000000000000000016771303454263000167010ustar00rootroot00000000000000\DOC MATCH_ACCEPT_TAC \TYPE {MATCH_ACCEPT_TAC : thm_tactic} \SYNOPSIS Solves a goal which is an instance of the supplied theorem. \KEYWORDS tactic. \DESCRIBE When given a theorem {A' |- t} and a goal {A ?- t'} where {t} can be matched to {t'} by instantiating variables which are either free or universally quantified at the outer level, including appropriate type instantiation, {MATCH_ACCEPT_TAC} completely solves the goal. { A ?- t' ========= MATCH_ACCEPT_TAC (A' |- t) } \noindent Unless {A'} is a subset of {A}, this is an invalid tactic. \FAILURE Fails unless the theorem has a conclusion which is instantiable to match that of the goal. \EXAMPLE The following example shows variable and type instantiation at work. Suppose we have the following simple goal: { # g `HD [1;2] = 1`;; } \noindent we can do it via the polymorphic theorem {HD = |- !h t. HD(CONS h t) = h}: { # e(MATCH_ACCEPT_TAC HD);; } \SEEALSO ACCEPT_TAC. \ENDDOC hol-light/Help/MATCH_CONV.doc000066400000000000000000000047101303454263000160070ustar00rootroot00000000000000\DOC MATCH_CONV \TYPE {MATCH_CONV : term -> thm} \SYNOPSIS Expands application of pattern-matching construct to particular case. \KEYWORDS conversion. \DESCRIBE The conversion {MATCH_CONV} will reduce the application of a pattern to a specific argument, either for a term {match x with ...} or {(function ...) x}. In the case of a sequential pattern, the first match will be reduced, resulting either in a conditional expression or simply one of the cases if it can be deduced just from the pattern. In the case of a single pattern, it will be reduced immediately. \FAILURE {MATCH_CONV tm} fails if {tm} is neither of the two applications of a pattern to an argument. \EXAMPLE In cases where the structure of the argument determines the match, a complete reduction is performed: { # MATCH_CONV `match [1;2;3;4;5] with CONS x (CONS y z) -> z`;; val it : thm = |- (match [1; 2; 3; 4; 5] with CONS x (CONS y z) -> z) = [3; 4; 5] } \noindent However, only one reduction is performed for a sequential match: { # MATCH_CONV `(function [] -> 0 | CONS h t -> h + 1) [1;2;3;4]`;; val it : thm = |- (function [] -> 0 | CONS h t -> h + 1) [1; 2; 3; 4] = (function CONS h t -> h + 1) [1; 2; 3; 4] } \noindent so the conversion may need to be repeated: { # TOP_DEPTH_CONV MATCH_CONV `(function [] -> 0 | CONS h t -> h + 1) [1;2;3;4]`;; val it : thm = |- (function [] -> 0 | CONS h t -> h + 1) [1; 2; 3; 4] = 1 + 1 } \noindent In cases where the structure of the argument cannot be determined, a conditional expression or other more involved result may be returned: { # MATCH_CONV `(function [] -> 0 | CONS h t -> h + 1) l`;; val it : thm = |- (function [] -> 0 | CONS h t -> h + 1) l = (if [] = l then (function [] -> 0) l else (function CONS h t -> h + 1) l) } \COMMENTS The simple cases where the structure completely determines the result are built into the default rewrites, though nothing will happen in more general cases, even if the conditions can be discharged straightforwardly, e.g: { # REWRITE_CONV[] `match [1;2;3] with CONS h t when h = 1 -> h + LENGTH t`;; val it : thm = |- (match [1; 2; 3] with CONS h t when h = 1 -> h + LENGTH t) = 1 + LENGTH [2; 3] # REWRITE_CONV[] `match [1;2;3] with CONS h t when h < 7 -> h + LENGTH t`;; val it : thm = |- (match [1; 2; 3] with CONS h t when h < 7 -> h + LENGTH t) = (match [1; 2; 3] with CONS h t when h < 7 -> h + LENGTH t) } \SEEALSO BETA_CONV, GEN_BETA_CONV. \ENDDOC hol-light/Help/MATCH_MP.doc000066400000000000000000000035341303454263000155610ustar00rootroot00000000000000\DOC MATCH_MP \TYPE {MATCH_MP : thm -> thm -> thm} \SYNOPSIS Modus Ponens inference rule with automatic matching. \KEYWORDS rule, modus ponens, implication. \DESCRIBE When applied to theorems {A1 |- !x1...xn. t1 ==> t2} and {A2 |- t1'}, the inference rule {MATCH_MP} matches {t1} to {t1'} by instantiating free or universally quantified variables in the first theorem (only), and returns a theorem {A1 u A2 |- !xa..xk. t2'}, where {t2'} is a correspondingly instantiated version of {t2}. Polymorphic types are also instantiated if necessary. Variables free in the consequent but not the antecedent of the first argument theorem will be replaced by variants if this is necessary to maintain the full generality of the theorem, and any which were universally quantified over in the first argument theorem will be universally quantified over in the result, and in the same order. { A1 |- !x1..xn. t1 ==> t2 A2 |- t1' -------------------------------------- MATCH_MP A1 u A2 |- !xa..xk. t2' } \FAILURE Fails unless the first theorem is a (possibly repeatedly universally quantified) implication whose antecedent can be instantiated to match the conclusion of the second theorem, without instantiating any variables which are free in {A1}, the first theorem's assumption list. \EXAMPLE In this example, automatic renaming occurs to maintain the most general form of the theorem, and the variant corresponding to {z} is universally quantified over, since it was universally quantified over in the first argument theorem. { # let ith = ARITH_RULE `!x z:num. x = y ==> (w + z) + x = (w + z) + y`;; val ith : thm = |- !x z. x = y ==> (w + z) + x = (w + z) + y # let th = ASSUME `w:num = z`;; val th : thm = w = z |- w = z # MATCH_MP ith th;; val it : thm = w = z |- !z'. (w + z') + w = (w + z') + z } \SEEALSO EQ_MP, MATCH_MP_TAC, MP, MP_TAC. \ENDDOC hol-light/Help/MATCH_MP_TAC.doc000066400000000000000000000030461303454263000162460ustar00rootroot00000000000000\DOC MATCH_MP_TAC \TYPE {MATCH_MP_TAC : thm_tactic} \SYNOPSIS Reduces the goal using a supplied implication, with matching. \KEYWORDS tactic, modus ponens, implication. \DESCRIBE When applied to a theorem of the form { A' |- !x1...xn. s ==> t } \noindent {MATCH_MP_TAC} produces a tactic that reduces a goal whose conclusion {t'} is a substitution and/or type instance of {t} to the corresponding instance of {s}. Any variables free in {s} but not in {t} will be existentially quantified in the resulting subgoal: { A ?- t' ====================== MATCH_MP_TAC (A' |- !x1...xn. s ==> t) A ?- ?z1...zp. s' } \noindent where {z1}, ..., {zp} are (type instances of) those variables among {x1}, ..., {xn} that do not occur free in {t}. Note that this is not a valid tactic unless {A'} is a subset of {A}. \EXAMPLE The following goal might be solved by case analysis: { # g `!n:num. n <= n * n`;; } We can ``manually'' perform induction by using the following theorem: { # num_INDUCTION;; val it : thm = |- !P. P 0 /\ (!n. P n ==> P (SUC n)) ==> (!n. P n) } \noindent which is useful with {MATCH_MP_TAC} because of higher-order matching: { # e(MATCH_MP_TAC num_INDUCTION);; val it : goalstack = 1 subgoal (1 total) `0 <= 0 * 0 /\ (!n. n <= n * n ==> SUC n <= SUC n * SUC n)` } \noindent The goal can be finished with {ARITH_TAC}. \FAILURE Fails unless the theorem is an (optionally universally quantified) implication whose consequent can be instantiated to match the goal. \SEEALSO EQ_MP, MATCH_MP, MP, MP_TAC, PART_MATCH, TRANS_TAC. \ENDDOC hol-light/Help/MESON.doc000066400000000000000000000035631303454263000152140ustar00rootroot00000000000000\DOC MESON \TYPE {MESON : thm list -> term -> thm} \SYNOPSIS Attempt to prove a term by first-order proof search. \DESCRIBE A call {MESON[theorems] `tm`} will attempt to prove {tm} using pure first-order reasoning, taking {theorems} as the starting-point. It will usually either solve it completely or run for an infeasible length of time before terminating, but it may sometimes fail quickly. Although {MESON} is capable of some fairly non-obvious pieces of first-order reasoning, and will handle equality adequately, it does purely logical reasoning. It will exploit no special properties of the constants in the goal, other than equality and logical primitives. Any properties that are needed must be supplied explicitly in the theorem list, e.g. {LE_REFL} to tell it that {<=} on natural numbers is reflexive, or {REAL_ADD_SYM} to tell it that addition on real numbers is symmetric. For more challenging first-order problems the related {METIS} rule often performs better. \FAILURE Will fail if the term is not provable, but not necessarily in a feasible amount of time. \EXAMPLE A typical application is to prove some elementary logical lemma for use inside a tactic proof: { # MESON[] `!P. P F /\ P T ==> !x. P x`;; ... val it : thm = |- !P. P F /\ P T ==> (!x. P x) } To prove the following lemma, we need to provide the key property of real negation: { # MESON[REAL_NEG_NEG] `(!x. P(--x)) ==> !x:real. P x`;; ... val it : thm = |- (!x. P (--x)) ==> (!x. P x) } \noindent If the lemma is not supplied, {MESON} will fail: { # MESON[] `(!x. P(--x)) ==> !x:real. P x`;; ... Exception: Failure "solve_goal: Too deep". } {MESON} is also capable of proving less straightforward results; see the documentation for {MESON_TAC} to find more examples. \USES Generating simple logical lemmas as part of a large proof. \SEEALSO ASM_MESON_TAC, GEN_MESON_TAC, MESON_TAC, METIS. \ENDDOC hol-light/Help/MESON_TAC.doc000066400000000000000000000054531303454263000157030ustar00rootroot00000000000000\DOC MESON_TAC \TYPE {MESON_TAC : thm list -> tactic} \SYNOPSIS Automated first-order proof search tactic. \DESCRIBE A call to {MESON_TAC[theorems]} will attempt to establish the current goal using pure first-order reasoning, taking {theorems} as the starting-point. (It does not take the assumptions of the goal into account, but the similar function {ASM_MESON_TAC} does.) It will usually either solve the goal completely or run for an infeasible length of time before terminating, but it may sometimes fail quickly. Although {MESON_TAC} is capable of some fairly non-obvious pieces of first-order reasoning, and will handle equality adequately, it does purely logical reasoning. It will exploit no special properties of the constants in the goal, other than equality and logical primitives. Any properties that are needed must be supplied explicitly in the theorem list, e.g. {LE_REFL} to tell it that {<=} on natural numbers is reflexive, or {REAL_ADD_SYM} to tell it that addition on real numbers is symmetric. For more challenging first-order problems, {METIS_TAC} may be recommended. \FAILURE Fails if the goal is unprovable within the search bounds, though not necessarily in a feasible amount of time. \EXAMPLE Here is a simple logical property taken from Dijstra's EWD 1062-1, which we set as our goal: { # g `(!x. x <= x) /\ (!x y z. x <= y /\ y <= z ==> x <= z) /\ (!x y. f(x) <= y <=> x <= g(y)) ==> (!x y. x <= y ==> f(x) <= f(y))`;; } It is solved quickly by: { # e(MESON_TAC[]);; 0..0..1..3..8..17..solved at 25 CPU time (user): 0. val it : goalstack = No subgoals } Note however that the proof did not rely on any special features of `{<=}'; any binary relation symbol would have worked. Even simple proofs that rely on special properties of the constants need to have those properties supplied in the list. Note also that {MESON} is limited to essentially first-order reasoning, meaning that it cannot invent higher-order quantifier instantiations. Thus, it cannot prove the following, which involves a quantification over a function {g}: { # g `!f:A->B s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) <=> (?g. !x. x IN s ==> (g(f(x)) = x))`;; } \noindent However, we can manually reduce it to two subgoals: { # e(REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `?g:B->A. !y x. x IN s /\ y = f x ==> g y = x` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SKOLEM_THM]; AP_TERM_TAC THEN ABS_TAC]);; val it : goalstack = 2 subgoals (2 total) `(!y x. x IN s /\ y = f x ==> g y = x) <=> (!x. x IN s ==> g (f x) = x)` `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> (!y. ?g. !x. x IN s /\ y = f x ==> g = x)` } \noindent and both of those are solvable directly by {MESON_TAC[]}. \SEEALSO ASM_MESON_TAC, GEN_MESON_TAC, MESON, METIS_TAC. \ENDDOC hol-light/Help/META_EXISTS_TAC.doc000066400000000000000000000016641303454263000166470ustar00rootroot00000000000000\DOC META_EXISTS_TAC \TYPE {META_EXISTS_TAC : (string * thm) list * term -> goalstate} \SYNOPSIS Changes existentially quantified variable to metavariable. \DESCRIBE Given a goal of the form {A ?- ?x. t[x]}, the tactic {X_META_EXISTS_TAC} gives the new goal {A ?- t[x]} where {x} is a new metavariable. In the resulting proof, it is as if the variable has been assigned here to the later choice for this metavariable, which can be made through for example {UNIFY_ACCEPT_TAC}. \FAILURE Never fails. \EXAMPLE See {UNIFY_ACCEPT_TAC} for an example of using metavariables. \USES Delaying instantiations until the correct term becomes clearer. \COMMENTS Users should probably steer clear of using metavariables if possible. Note that the metavariable instantiations apply across the whole fringe of goals, not just the current goal, and can lead to confusion. \SEEALSO EXISTS_TAC, META_SPEC_TAC, UNIFY_ACCEPT_TAC, X_META_EXISTS_TAC. \ENDDOC hol-light/Help/META_SPEC_TAC.doc000066400000000000000000000017131303454263000163550ustar00rootroot00000000000000\DOC META_SPEC_TAC \TYPE {META_SPEC_TAC : term -> thm -> tactic} \SYNOPSIS Replaces universally quantified variable in theorem with metavariable. \DESCRIBE Given a variable {v} and a theorem {th} of the form {A |- !x. p[x]}, the tactic {META_SPEC_TAC `v` th} is a tactic that adds the theorem {A |- p[v]} to the assumptions of the goal, with {v} a new metavariable. This can later be instantiated, e.g. by {UNIFY_ACCEPT_TAC}, and it is as if the instantiation were done at this point. \FAILURE Fails if {v} is not a variable. \EXAMPLE See {UNIFY_ACCEPT_TAC} for an example of using metavariables. \USES Delaying instantiations until the right choice becomes clearer. \COMMENTS Users should probably steer clear of using metavariables if possible. Note that the metavariable instantiations apply across the whole fringe of goals, not just the current goal, and can lead to confusion. \SEEALSO EXISTS_TAC, EXISTS_TAC, UNIFY_ACCEPT_TAC, X_META_EXISTS_TAC. \ENDDOC hol-light/Help/METIS.doc000066400000000000000000000024551303454263000152130ustar00rootroot00000000000000\DOC METIS \TYPE {METIS : thm list -> term -> thm} \SYNOPSIS Attempt to prove a term by first-order proof search using Metis algorithm. \DESCRIBE A call {METIS[theorems] `tm`} will attempt to prove {tm} using pure first-order reasoning, taking {theorems} as the starting-point. It will usually either prove it completely or run for an infeasibly long time, but it may sometimes fail quickly. Although {METIS} is capable of some fairly non-obvious pieces of first-order reasoning, and will handle equality adequately, it does purely logical reasoning. It will exploit no special properties of the constants in the goal, other than equality and logical primitives. Any properties that are needed must be supplied explicitly in the theorem list, e.g. {LE_REFL} to tell it that {<=} on natural numbers is reflexive, or {REAL_ADD_SYM} to tell it that addition on real numbers is symmetric. Sometimes the similar {MESON} rule is faster, especially on simpler problems. \FAILURE Fails if the term is unprovable within the search bounds. \EXAMPLE A typical application is to prove some elementary logical lemma for use inside a tactic proof: { # METIS[num_CASES] `(!n. P n) <=> P 0 /\ (!n. P (SUC n))`;; } \USES Generating simple logical lemmas as part of a large proof. \SEEALSO ASM_METIS_TAC, MESON, METIS_TAC. \ENDDOC hol-light/Help/METIS_TAC.doc000066400000000000000000000034161303454263000157000ustar00rootroot00000000000000\DOC METIS_TAC \TYPE {METIS_TAC : thm list -> tactic} \SYNOPSIS Automated first-order proof search tactic using Metis algorithm. \DESCRIBE A call to {METIS_TAC[theorems]} will attempt to establish the current goal using pure first-order reasoning, taking {theorems} as the starting-point. (It does not take the assumptions of the goal into account, but the similar function {ASM_METIS_TAC} does.) It will usually either solve the goal completely or run for an infeasibly long time, but it may sometimes fail quickly. This tactic is closely related to {MESON_TAC}, and many of the same general comments apply. Generally speaking, {METIS_TAC} is capable of solving more challenging problems than {MESON_TAC}, though the latter is often faster where it succeeds. Like {MESON_TAC}, it will exploit no special properties of the constants in the goal, other than equality and logical primitives. Any properties that are needed must be supplied explicitly in the theorem list, e.g. {LE_REFL} to tell it that {<=} on natural numbers is reflexive, or {REAL_ADD_SYM} to tell it that addition on real numbers is symmetric. Sometimes the similar {MESON_TAC} tactic is faster, especially on simpler goals. \FAILURE Fails if the goal is unprovable within the search bounds. \EXAMPLE Here is a simple `group theory' type property about a binary function {m}: { # g `(!x y z. m(x, m(y,z)) = m(m(x,y), z) /\ m(x,y) = m(y,x)) ==> m(a, m(b, m(c, m(d, m(e, f))))) = m(f, m(e, m(d, m(c, m(b, a)))))`;; } It is solved in a fraction of a second by: { # e(METIS_TAC[]);; val it : goalstack = No subgoals } This is an example where {METIS_TAC} substantially outperforms {MESON_TAC}, which does not seem to be able to solve that problem in a reasonable time. \SEEALSO ASM_METIS_TAC, MESON_TAC, METIS. \ENDDOC hol-light/Help/MK_BINOP_UPPERCASE.doc000066400000000000000000000012461303454263000171740ustar00rootroot00000000000000\DOC MK_BINOP \TYPE {MK_BINOP : term -> thm * thm -> thm} \SYNOPSIS Compose equational theorems with binary operator. \DESCRIBE Given a term {op} and the pair of theorems {(|- l = l'),(|- r = r')}, the function {MK_BINOP} returns the theorem {|- op l r = op l' r'}, provided the types are compatible. \FAILURE Fails if the types are incompatible for the term {op l r}. \EXAMPLE { # let th1 = NUM_REDUCE_CONV `2 * 2` and th2 = NUM_REDUCE_CONV `2 EXP 2`;; val th1 : thm = |- 2 * 2 = 4 val th2 : thm = |- 2 EXP 2 = 4 # MK_BINOP `(+):num->num->num` (th1,th2);; val it : thm = |- 2 * 2 + 2 EXP 2 = 4 + 4 } \SEEALSO BINOP_CONV, DEPTH_BINOP_CONV, MK_COMB. \ENDDOC hol-light/Help/MK_COMB_TAC.doc000066400000000000000000000012041303454263000161170ustar00rootroot00000000000000\DOC MK_COMB_TAC \TYPE {MK_COMB_TAC : tactic} \SYNOPSIS Breaks down a goal between function applications into equality of functions and arguments. \DESCRIBE Given a goal whose conclusion is an equation between function applications {A ?- f x = g y}, the tactic {MK_COMB_TAC} breaks it down to two subgoals expressing equality of the corresponding rators and rands: { A ?- f x = g y ================================ MK_COMB_TAC A ?- f = g A ?- x = y } \FAILURE Fails if the conclusion of the goal is not an equation between applications. \SEEALSO ABS_TAC, AP_TERM_TAC, AP_THM_TAC, BINOP_TAC, MK_COMB. \ENDDOC hol-light/Help/MK_COMB_UPPERCASE.doc000066400000000000000000000023511303454263000170430ustar00rootroot00000000000000\DOC MK_COMB \TYPE {MK_COMB : thm * thm -> thm} \SYNOPSIS Proves equality of combinations constructed from equal functions and operands. \KEYWORDS rule, combination, equality. \DESCRIBE When applied to theorems {A1 |- f = g} and {A2 |- x = y}, the inference rule {MK_COMB} returns the theorem {A1 u A2 |- f x = g y}. { A1 |- f = g A2 |- x = y --------------------------- MK_COMB A1 u A2 |- f x = g y } \FAILURE Fails unless both theorems are equational and {f} and {g} are functions whose domain types are the same as the types of {x} and {y} respectively. \EXAMPLE { # let th1 = ABS `n:num` (ARITH_RULE `SUC n = n + 1`) and th2 = NUM_REDUCE_CONV `2 + 2`;; val th1 : thm = |- (\n. SUC n) = (\n. n + 1) val th2 : thm = |- 2 + 2 = 4 # let th3 = MK_COMB(th1,th2);; val th3 : thm = |- (\n. SUC n) (2 + 2) = (\n. n + 1) 4 # let th1 = NOT_DEF and th2 = TAUT `p /\ p <=> p`;; val th1 : thm = |- (~) = (\p. p ==> F) val th2 : thm = |- p /\ p <=> p # MK_COMB(th1,th2);; val it : thm = |- ~(p /\ p) <=> (\p. p ==> F) p } \COMMENTS This is one of HOL Light's 10 primitive inference rules. It underlies, among other things, the replacement of subterms in rewriting. \SEEALSO AP_TERM, AP_THM, BETA_CONV, TRANS. \ENDDOC hol-light/Help/MK_CONJ_UPPERCASE.doc000066400000000000000000000014751303454263000170620ustar00rootroot00000000000000\DOC MK_CONJ \TYPE {MK_CONJ : thm -> thm -> thm} \SYNOPSIS Conjoin both sides of two equational theorems. \DESCRIBE Given two theorems, each with a Boolean equation as conclusion, {MK_CONJ} returns the equation resulting from conjoining their respective sides: { A |- p <=> p' B |- q <=> q' ----------------------------------- MK_CONJ A u B |- p /\ q <=> p' /\ q' } \FAILURE Fails unless both input theorems are Boolean equations (iff). \EXAMPLE { # let th1 = ARITH_RULE `0 < n <=> ~(n = 0)` and th2 = ARITH_RULE `1 <= n <=> ~(n = 0)`;; val th1 : thm = |- 0 < n <=> ~(n = 0) val th2 : thm = |- 1 <= n <=> ~(n = 0) # MK_CONJ th1 th2;; val it : thm = |- 0 < n /\ 1 <= n <=> ~(n = 0) /\ ~(n = 0) } \SEEALSO AP_TERM, AP_THM, MK_BINOP, MK_COMB, MK_DISJ, MK_EXISTS, MK_FORALL. \ENDDOC hol-light/Help/MK_DISJ_UPPERCASE.doc000066400000000000000000000015331303454263000170550ustar00rootroot00000000000000\DOC MK_DISJ \TYPE {MK_DISJ : thm -> thm -> thm} \SYNOPSIS Disjoin both sides of two equational theorems. \DESCRIBE Given two theorems, each with a Boolean equation as conclusion, {MK_DISJ} returns the equation resulting from disjoining their respective sides: { A |- p <=> p' B |- q <=> q' ----------------------------------- MK_DISJ A u B |- p \/ q <=> p' \/ q' } \FAILURE Fails unless both input theorems are Boolean equations (iff). \EXAMPLE { # let th1 = ARITH_RULE `1 < x <=> 1 <= x - 1` and th2 = ARITH_RULE `~(1 < x) <=> x = 0 \/ x = 1`;; val th1 : thm = |- 1 < x <=> 1 <= x - 1 val th2 : thm = |- ~(1 < x) <=> x = 0 \/ x = 1 # MK_DISJ th1 th2;; val it : thm = |- 1 < x \/ ~(1 < x) <=> 1 <= x - 1 \/ x = 0 \/ x = 1 } \SEEALSO AP_TERM, AP_THM, MK_BINOP, MK_COMB, MK_CONJ, MK_EXISTS, MK_FORALL. \ENDDOC hol-light/Help/MK_EXISTS_UPPERCASE.doc000066400000000000000000000016311303454263000173420ustar00rootroot00000000000000\DOC MK_EXISTS \TYPE {MK_EXISTS : term -> thm -> thm} \SYNOPSIS Existentially quantifies both sides of equational theorem. \DESCRIBE Given a theorem {th} whose conclusion is a Boolean equation (iff), the rule {MK_EXISTS `v` th} existentially quantifies both sides of {th} over the variable {v}, provided it is not free in the hypotheses { A |- p <=> q ---------------------------- MK_EXISTS `v` [where v not free in A] A |- (?v. p) <=> (?v. q) } \FAILURE Fails if the term is not a variable or is free in the hypotheses of the theorem, or if the theorem does not have a Boolean equation for its conclusion. \EXAMPLE { # let th = ARITH_RULE `f(x:A) >= 1 <=> ~(f(x) = 0)`;; val th : thm = |- f x >= 1 <=> ~(f x = 0) # MK_EXISTS `x:A` th;; val it : thm = |- (?x. f x >= 1) <=> (?x. ~(f x = 0)) } \SEEALSO AP_TERM, AP_THM, MK_BINOP, MK_COMB, MK_CONJ, MK_DISJ, MK_FORALL. \ENDDOC hol-light/Help/MK_FORALL_UPPERCASE.doc000066400000000000000000000016271303454263000173070ustar00rootroot00000000000000\DOC MK_FORALL \TYPE {MK_FORALL : term -> thm -> thm} \SYNOPSIS Universally quantifies both sides of equational theorem. \DESCRIBE Given a theorem {th} whose conclusion is a Boolean equation (iff), the rule {MK_FORALL `v` th} universally quantifies both sides of {th} over the variable {v}, provided it is not free in the hypotheses { A |- p <=> q ---------------------------- MK_FORALL `v` [where v not free in A] A |- (!v. p) <=> (!v. q) } \FAILURE Fails if the term is not a variable or is free in the hypotheses of the theorem, or if the theorem does not have a Boolean equation for its conclusion. \EXAMPLE { # let th = ARITH_RULE `f(x:A) >= 1 <=> ~(f(x) = 0)`;; val th : thm = |- f x >= 1 <=> ~(f x = 0) # MK_FORALL `x:A` th;; val it : thm = |- (!x. f x >= 1) <=> (!x. ~(f x = 0)) } \SEEALSO AP_TERM, AP_THM, MK_BINOP, MK_COMB, MK_CONJ, MK_DISJ, MK_EXISTS. \ENDDOC hol-light/Help/MONO_TAC.doc000066400000000000000000000015701303454263000155660ustar00rootroot00000000000000\DOC MONO_TAC \TYPE {MONO_TAC : tactic} \SYNOPSIS Attempt to prove monotonicity theorem automatically. \DESCRIBE \FAILURE Never fails but may have no effect. \EXAMPLE We set up the following goal: { # g `(!x. P x ==> Q x) ==> (?y. P y /\ ~Q y) ==> (?y. Q y /\ ~P y)`;; ... } \noindent and after breaking it down, we reach the standard form expected for monotonicity goals: { # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`!x. P x ==> Q x`] `(?y. P y /\ ~Q y) ==> (?y. Q y /\ ~P y)` } \noindent Indeed, it is solved automatically: { # e MONO_TAC;; val it : goalstack = No subgoals } \COMMENTS Normally, this kind of reasoning is automated by the inductive definitions package, so explicit use of this tactic is rare. \SEEALSO monotonicity_theorems, new_inductive_definition, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC hol-light/Help/MP.doc000066400000000000000000000013731303454263000146440ustar00rootroot00000000000000\DOC MP \TYPE {MP : thm -> thm -> thm} \SYNOPSIS Implements the Modus Ponens inference rule. \KEYWORDS rule, modus ponens, implication. \DESCRIBE When applied to theorems {A1 |- t1 ==> t2} and {A2 |- t1}, the inference rule {MP} returns the theorem {A1 u A2 |- t2}. { A1 |- t1 ==> t2 A2 |- t1 ---------------------------- MP A1 u A2 |- t2 } \FAILURE Fails unless the first theorem is an implication whose antecedent is the same as the conclusion of the second theorem (up to alpha-conversion). \EXAMPLE { # let th1 = TAUT `p ==> p \/ q` and th2 = ASSUME `p:bool`;; val th1 : thm = |- p ==> p \/ q val th2 : thm = p |- p # MP th1 th2;; val it : thm = p |- p \/ q } \SEEALSO EQ_MP, MATCH_MP, MATCH_MP_TAC, MP_TAC. \ENDDOC hol-light/Help/MP_CONV.doc000066400000000000000000000022011303454263000154600ustar00rootroot00000000000000\DOC MP_CONV \TYPE {MP_CONV : conv -> thm -> thm} \SYNOPSIS Removes antecedent of implication theorem by solving it with a conversion. \DESCRIBE The call {MP_CONV conv th}, where the theorem {th} has the form {A |- p ==> q}, attempts to solve the antecedent {p} by applying the conversion {conv} to it. If this conversion returns either {|- p} or {|- p <=> T}, then {MP_CONV} returns {A |- q}. Otherwise it fails. \FAILURE Fails if the conclusion of the theorem is not implicational or if the conversion fails to prove its antecedent. \EXAMPLE Suppose we generate this `epsilon-delta' theorem: { # let th = MESON[LE_REFL] `(!e. &0 < e / &2 <=> &0 < e) /\ (!a x y e. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 ==> abs(x - y) < e) ==> (!e. &0 < e ==> ?n. !m. n <= m ==> abs(x m - a) < e) ==> (!e. &0 < e ==> ?n. !m. n <= m ==> abs(x m - x n) < e)`;; } \noindent We can eliminate the antecedent: { # MP_CONV REAL_ARITH th;; val it : thm = |- (!e. &0 < e ==> (?n. !m. n <= m ==> abs (x m - a) < e)) ==> (!e. &0 < e ==> (?n. !m. n <= m ==> abs (x m - x n) < e)) } \SEEALSO MP, MATCH_MP. \ENDDOC hol-light/Help/MP_TAC.doc000066400000000000000000000012201303454263000153220ustar00rootroot00000000000000\DOC MP_TAC \TYPE {MP_TAC : thm_tactic} \SYNOPSIS Adds a theorem as an antecedent to the conclusion of the goal. \KEYWORDS tactic, modus, ponens, implication, antecedent. \DESCRIBE When applied to the theorem {A' |- s} and the goal {A ?- t}, the tactic {MP_TAC} reduces the goal to {A ?- s ==> t}. Unless {A'} is a subset of {A}, this is an invalid tactic. { A ?- t ============== MP_TAC (A' |- s) A ?- s ==> t } \FAILURE Never fails. \USES For moving assumptions into the conclusion of the goal, which often makes it easier to manipulate via {REWRITE_TAC} or decompose by {ANTS_TAC}. \SEEALSO MATCH_MP_TAC, MP, UNDISCH_TAC. \ENDDOC hol-light/Help/NNFC_CONV.doc000066400000000000000000000026161303454263000157020ustar00rootroot00000000000000\DOC NNFC_CONV \TYPE {NNFC_CONV : conv} \SYNOPSIS Convert a term to negation normal form. \DESCRIBE The conversion {NNFC_CONV} proves a term equal to an equivalent in `negation normal form' (NNF). This means that other propositional connectives are eliminated in favour of conjunction (`{/\}'), disjunction (`{\/}') and negation (`{~}'), and the negations are pushed down to the level of atomic formulas, also through universal and existential quantifiers, with double negations eliminated. \FAILURE Never fails; on non-Boolean terms it just returns a reflexive theorem. \EXAMPLE { # NNFC_CONV `(!x. p(x) <=> q(x)) ==> ~ ?y. p(y) /\ ~q(y)`;; Warning: inventing type variables val it : thm = |- (!x. p x <=> q x) ==> ~(?y. p y /\ ~q y) <=> (?x. (p x \/ q x) /\ (~p x \/ ~q x)) \/ (!y. ~p y \/ q y) } \USES Mostly useful as a prelude to automated proof procedures, but users may sometimes find it useful. \COMMENTS A toplevel equivalence {p <=> q} is converted to {(p \/ ~q) /\ (~p \/ q)}. In general this ``splitting'' of equivalences is done with the expectation that the final formula may be put into conjunctive normal form (CNF), as a prelude to a proof (rather than refutation) procedure. An otherwise similar conversion {NNC_CONV} prefers a `disjunctive' splitting and is better suited for a term that will later be translated to DNF for refutation. \SEEALSO GEN_NNF_CONV, NNF_CONV. \ENDDOC hol-light/Help/NNF_CONV.doc000066400000000000000000000025531303454263000155770ustar00rootroot00000000000000\DOC NNF_CONV \TYPE {NNF_CONV : conv} \SYNOPSIS Convert a term to negation normal form. \DESCRIBE The conversion {NNF_CONV} proves a term equal to an equivalent in `negation normal form' (NNF). This means that other propositional connectives are eliminated in favour of conjunction (`{/\}'), disjunction (`{\/}') and negation (`{~}'), and the negations are pushed down to the level of atomic formulas, also through universal and existential quantifiers, with double negations eliminated. \FAILURE Never fails; on non-Boolean terms it just returns a reflexive theorem. \EXAMPLE { # NNF_CONV `(!x. p(x) <=> q(x)) ==> ~ ?y. p(y) /\ ~q(y)`;; Warning: inventing type variables val it : thm = |- (!x. p x <=> q x) ==> ~(?y. p y /\ ~q y) <=> (?x. p x /\ ~q x \/ ~p x /\ q x) \/ (!y. ~p y \/ q y) } \USES Mostly useful as a prelude to automated proof procedures, but users may sometimes find it useful. \COMMENTS A toplevel equivalence {p <=> q} is converted to {(p /\ q) \/ (~p /\ ~q)}. In general this ``splitting'' of equivalences is done with the expectation that the final formula may be put into disjunctive normal form (DNF), as a prelude to a refutation procedure. An otherwise similar conversion {NNFC_CONV} prefers a `conjunctive' splitting and is better suited for a term that will later be translated to CNF. \SEEALSO GEN_NNF_CONV, NNFC_CONV. \ENDDOC hol-light/Help/NOT_ELIM.doc000066400000000000000000000010541303454263000155720ustar00rootroot00000000000000\DOC NOT_ELIM \TYPE {NOT_ELIM : thm -> thm} \SYNOPSIS Transforms {|- ~t} into {|- t ==> F}. \KEYWORDS rule, implication, negation. \DESCRIBE When applied to a theorem {A |- ~t}, the inference rule {NOT_ELIM} returns the theorem {A |- t ==> F}. { A |- ~t -------------- NOT_ELIM A |- t ==> F } \FAILURE Fails unless the theorem has a negated conclusion. \EXAMPLE { # let th = UNDISCH(TAUT `p ==> ~ ~p`);; val th : thm = p |- ~ ~p # NOT_ELIM th;; val it : thm = p |- ~p ==> F } \SEEALSO EQF_ELIM, EQF_INTRO, NOT_INTRO. \ENDDOC hol-light/Help/NOT_INTRO.doc000066400000000000000000000010751303454263000157420ustar00rootroot00000000000000\DOC NOT_INTRO \TYPE {NOT_INTRO : thm -> thm} \SYNOPSIS Transforms {|- t ==> F} into {|- ~t}. \KEYWORDS rule, negation, implication. \DESCRIBE When applied to a theorem {A |- t ==> F}, the inference rule {NOT_INTRO} returns the theorem {A |- ~t}. { A |- t ==> F -------------- NOT_INTRO A |- ~t } \FAILURE Fails unless the theorem has an implicative conclusion with {F} as the consequent. \EXAMPLE { # let th = TAUT `F ==> F`;; val th : thm = |- F ==> F # NOT_INTRO th;; val it : thm = |- ~F } \SEEALSO EQF_ELIM, EQF_INTRO, NOT_ELIM. \ENDDOC hol-light/Help/NO_CONV.doc000066400000000000000000000002441303454263000154650ustar00rootroot00000000000000\DOC NO_CONV \TYPE {NO_CONV : conv} \SYNOPSIS Conversion that always fails. \KEYWORDS conversion. \FAILURE {NO_CONV} always fails. \SEEALSO ALL_CONV. \ENDDOC hol-light/Help/NO_TAC.doc000066400000000000000000000021611303454263000153270ustar00rootroot00000000000000\DOC NO_TAC \TYPE {NO_TAC : tactic} \SYNOPSIS Tactic that always fails. \KEYWORDS tactic. \DESCRIBE Whatever goal it is applied to, {NO_TAC} always fails with {Failure "NO_TAC"}. \FAILURE Always fails. \EXAMPLE However trivial the goal, {NO_TAC} always fails: { # g `T`;; val it : goalstack = 1 subgoal (1 total) `T` # e NO_TAC;; Exception: Failure "NO_TAC". } \noindent however, {tac THEN NO_TAC} will never reach {NO_TAC} if {tac} leaves no subgoals: { # e(REWRITE_TAC[] THEN NO_TAC);; val it : goalstack = No subgoals } \USES Can be useful in forcing certain ``speculative'' tactics to fail unless they solve the goal completely. For example, you might wish to break down a huge conjunction of goals and attempt to solve as many conjuncts as possible by just rewriting with a list of theorems {[thl]}. You could do: { REPEAT CONJ_TAC THEN REWRITE_TAC[thl] } \noindent However, if you don't want to apply the rewrites unless they result in an immediate solution, you can do instead: { REPEAT CONJ_TAC THEN TRY(REWRITE_TAC[thl] THEN NO_TAC) } \SEEALSO ALL_TAC, ALL_THEN, FAIL_TAC, NO_THEN. \ENDDOC hol-light/Help/NO_THEN.doc000066400000000000000000000007431303454263000154620ustar00rootroot00000000000000\DOC NO_THEN \TYPE {NO_THEN : thm_tactical} \SYNOPSIS Theorem-tactical which always fails. \KEYWORDS theorem-tactic. \DESCRIBE When applied to a theorem-tactic and a theorem, the theorem-tactical {NO_THEN} always fails with {Failwith "NO_THEN"}. \FAILURE Always fails when applied to a theorem-tactic and a theorem (note that it never gets as far as being applied to a goal!) \USES Writing compound tactics or tacticals. \SEEALSO ALL_TAC, ALL_THEN, FAIL_TAC, NO_TAC. \ENDDOC hol-light/Help/NUMBER_RULE.doc000066400000000000000000000021671303454263000161510ustar00rootroot00000000000000\DOC NUMBER_RULE \TYPE {NUMBER_RULE : term -> thm} \SYNOPSIS Automatically prove elementary divisibility property over the natural numbers. \DESCRIBE {NUMBER_RULE} is a partly heuristic rule that can often automatically prove elementary ``divisibility'' properties of the natural numbers. The precise subset that is dealt with is difficult to describe rigorously, but many universally quantified combinations of {divides}, {coprime}, {gcd} and congruences {(x == y) (mod n)} can be proved automatically, as well as some existentially quantified goals. See a similar rule {INTEGER_RULE} for the integers for a representative set of examples. \FAILURE Fails if the goal is not accessible to the methods used. \EXAMPLE Here is a typical example, which would be rather tedious to prove manually: { # NUMBER_RULE `!a b a' b'. ~(gcd(a,b) = 0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b) ==> coprime(a',b')`;; ... val it : thm = |- !a b a' b'. ~(gcd (a,b) = 0) /\ a = a' * gcd (a,b) /\ b = b' * gcd (a,b) ==> coprime (a',b') } \SEEALSO ARITH_RULE, INTEGER_RULE, NUMBER_TAC, NUM_RING. \ENDDOC hol-light/Help/NUMBER_TAC.doc000066400000000000000000000025401303454263000160040ustar00rootroot00000000000000\DOC NUMBER_TAC \TYPE {NUMBER_TAC : tactic} \SYNOPSIS Automated tactic for elementary divisibility properties over the natural numbers. \DESCRIBE The tactic {NUMBER_TAC} is a partly heuristic tactic that can often automatically prove elementary ``divisibility'' properties of the natural numbers. The precise subset that is dealt with is difficult to describe rigorously, but many universally quantified combinations of {divides}, {coprime}, {gcd} and congruences {(x == y) (mod n)} can be proved automatically, as well as some existentially quantified goals. See the documentation for {INTEGER_RULE} for a larger set of representative examples. \FAILURE Fails if the goal is not accessible to the methods used. \EXAMPLE A typical elementary divisibility property is that if two numbers are congruent with respect to two coprime (without non-trivial common factors) moduli, then they are congruent with respect to their product: { # g `!m n x y:num. (x == y) (mod m) /\ (x == y) (mod n) /\ coprime(m,n) ==> (x == y) (mod (m * n))`;; ... } \noindent It can be solved automatically using {NUMBER_TAC}: { # e NUMBER_TAC;; ... val it : goalstack = No subgoals } The analogous goal without the coprimality assumption will fail, and indeed the goal would be false without it. \SEEALSO ARITH_TAC, INTEGER_TAC, NUMBER_RULE, NUM_RING. \ENDDOC hol-light/Help/NUMSEG_CONV.doc000066400000000000000000000012201303454263000161420ustar00rootroot00000000000000\DOC NUMSEG_CONV \TYPE {NUMSEG_CONV : conv} \SYNOPSIS Expands a specific interval {m..n} to a set enumeration. \DESCRIBE When applied to a term {`m..n`} (the segment of natural numbers between {m} and {n}) for specific numerals {m} and {n}, the conversion {NUMSEG_CONV} returns a theorem of the form {|- m..n = {{m, ..., n}}} expressing that segment as a set enumeration. \FAILURE Fails unless applied to a term of the form {m..n} for specific numerals {m} and {n}. \EXAMPLE { # NUMSEG_CONV `7..11`;; val it : thm = |- 7..11 = {{7, 8, 9, 10, 11}} # NUMSEG_CONV `24..7`;; val it : thm = |- 24..7 = {{}} } \SEEALSO SET_RULE, SET_TAC. \ENDDOC hol-light/Help/NUM_ADD_CONV.doc000066400000000000000000000015671303454263000162710ustar00rootroot00000000000000\DOC NUM_ADD_CONV \TYPE {NUM_ADD_CONV : term -> thm} \SYNOPSIS Proves what the sum of two natural number numerals is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_ADD_CONV `n + m`} returns the theorem: { |- n + m = s } \noindent where {s} is the numeral that denotes the sum of the natural numbers denoted by {n} and {m}. \FAILURE {NUM_ADD_CONV tm} fails if {tm} is not of the form {`n + m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_ADD_CONV `75 + 25`;; val it : thm = |- 75 + 25 = 100 } \SEEALSO NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_CANCEL_CONV.doc000066400000000000000000000022101303454263000166100ustar00rootroot00000000000000\DOC NUM_CANCEL_CONV \TYPE {NUM_CANCEL_CONV : term -> thm} \SYNOPSIS Cancels identical terms from both sides of natural number equation. \DESCRIBE Given an equational term {`t1 + ... + tn = s1 + ... + sm`} (with arbitrary association of the additions) where both sides have natural number type, the conversion identifies common elements among the {ti} and {si}, and cancels them from both sides, returning a theorem: { |- t1 + ... + tn = s1 + ... + sm <=> u1 + ... + uk = v1 + ... + vl } \noindent where the {ui} and {vi} are the remaining elements of the {ti} and {si} respectively, in some order. \FAILURE Fails if applied to a term that is not an equation between natural number terms. \EXAMPLE { # NUM_CANCEL_CONV `(a + b + x * y + SUC c) + d = SUC c + d + y * z`;; val it : thm = |- (a + b + x * y + SUC c) + d = SUC c + d + y * z <=> x * y + b + a = y * z } \USES Simplifying equations where explicitly directing the cancellation would be tedious. However, this is mostly intended for ``bootstrapping'', before more powerful rules like {ARITH_RULE} and {NUM_RING} are available. \SEEALSO ARITH_RULE, ARITH_TAC, NUM_RING. \ENDDOC hol-light/Help/NUM_DIV_CONV.doc000066400000000000000000000024021303454263000163100ustar00rootroot00000000000000\DOC NUM_DIV_CONV \TYPE {NUM_DIV_CONV : term -> thm} \SYNOPSIS Proves what the truncated quotient of two natural number numerals is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_DIV_CONV `n DIV m`} returns the theorem: { |- n DIV m = s } \noindent where {s} is the numeral that denotes the truncated quotient of the numbers denoted by {n} and {m}. \FAILURE {NUM_DIV_CONV tm} fails if {tm} is not of the form {`n DIV m`}, where {n} and {m} are numerals, or if the second numeral {m} is zero. \EXAMPLE { # NUM_DIV_CONV `99 DIV 9`;; val it : thm = |- 99 DIV 9 = 11 # NUM_DIV_CONV `334 DIV 3`;; val it : thm = |- 334 DIV 3 = 111 # NUM_DIV_CONV `11 DIV 0`;; Exception: Failure "NUM_DIV_CONV". } \COMMENTS For definiteness, quotients with zero denominator are in fact designed to be zero. However, it is perhaps bad style to rely on this fact, so the conversion just fails in this case. \SEEALSO NUM_ADD_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_EQ_CONV.doc000066400000000000000000000020161303454263000161740ustar00rootroot00000000000000\DOC NUM_EQ_CONV \TYPE {NUM_EQ_CONV : conv} \SYNOPSIS Proves equality or inequality of two numerals. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_EQ_CONV `n = m`} returns: { |- (n = m) <=> T or |- (n = m) <=> F } \noindent depending on whether the natural numbers represented by {n} and {m} are equal or not equal, respectively. \FAILURE {NUM_EQ_CONV tm} fails if {tm} is not of the form {`n = m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_EQ_CONV `1 = 2`;; val it : thm = |- 1 = 2 <=> F # NUM_EQ_CONV `12 = 12`;; val it : thm = |- 12 = 12 <=> T } \USES Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_EVEN_CONV.doc000066400000000000000000000016511303454263000164300ustar00rootroot00000000000000\DOC NUM_EVEN_CONV \TYPE {NUM_EVEN_CONV : conv} \SYNOPSIS Proves whether a natural number numeral is even. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then {NUM_EVEN_CONV `n`} returns one of the theorems: { |- EVEN(n) <=> T } \noindent or { |- EVEN(n) <=> F } \noindent according to whether the number denoted by {n} is even. \FAILURE Fails if applied to a term that is not of the form {`EVEN n`} with {n} a numeral. \EXAMPLE { # NUM_EVEN_CONV `EVEN 99`;; val it : thm = |- EVEN 99 <=> F # NUM_EVEN_CONV `EVEN 123456`;; val it : thm = |- EVEN 123456 <=> T } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_EXP_CONV.doc000066400000000000000000000021701303454263000163240ustar00rootroot00000000000000\DOC NUM_EXP_CONV \TYPE {NUM_EXP_CONV : term -> thm} \SYNOPSIS Proves what the exponential of two natural number numerals is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_EXP_CONV `n EXP m`} returns the theorem: { |- n EXP m = s } \noindent where {s} is the numeral that denotes the natural number denoted by {n} raised to the power of the one denoted by {m}. \FAILURE {NUM_EXP_CONV tm} fails if {tm} is not of the form {`n EXP m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_EXP_CONV `2 EXP 64`;; val it : thm = |- 2 EXP 64 = 18446744073709551616 # NUM_EXP_CONV `1 EXP 99`;; val it : thm = |- 1 EXP 99 = 1 # NUM_EXP_CONV `0 EXP 0`;; val it : thm = |- 0 EXP 0 = 1 # NUM_EXP_CONV `0 EXP 10000`;; val it : thm = |- 0 EXP 10000 = 0 } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_FACT_CONV.doc000066400000000000000000000020121303454263000164000ustar00rootroot00000000000000\DOC NUM_FACT_CONV \TYPE {NUM_FACT_CONV : term -> thm} \SYNOPSIS Proves what the factorial of a natural number numeral is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then {NUM_FACT_CONV `FACT n`} returns the theorem: { |- FACT n = s } \noindent where {s} is the numeral that denotes the factorial of the natural number denoted by {n}. \FAILURE {NUM_FACT_CONV tm} fails if {tm} is not of the form {`FACT n`}, where {n} is a numeral. \EXAMPLE { # NUM_FACT_CONV `FACT 0`;; val it : thm = |- FACT 0 = 1 # NUM_FACT_CONV `FACT 6`;; val it : thm = |- FACT 6 = 720 # NUM_FACT_CONV `FACT 30`;; val it : thm = |- FACT 30 = 265252859812191058636308480000000 } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_GE_CONV.doc000066400000000000000000000021231303454263000161610ustar00rootroot00000000000000\DOC NUM_GE_CONV \TYPE {NUM_GE_CONV : conv} \SYNOPSIS Proves whether one numeral is greater than or equal to another. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_GE_CONV `n >= m`} returns: { |- n >= m <=> T or |- n >= m <=> F } \noindent depending on whether the natural number represented by {n} is greater than or equal to the one represented by {m}. \FAILURE {NUM_GE_CONV tm} fails if {tm} is not of the form {`n >= m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_GE_CONV `1 >= 0`;; val it : thm = |- 1 >= 0 <=> T # NUM_GE_CONV `181 >= 211`;; val it : thm = |- 181 >= 211 <=> F } \USES Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_GT_CONV.doc000066400000000000000000000020571303454263000162060ustar00rootroot00000000000000\DOC NUM_GT_CONV \TYPE {NUM_GT_CONV : conv} \SYNOPSIS Proves whether one numeral is greater than another. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_GT_CONV `n > m`} returns: { |- n > m <=> T or |- n > m <=> F } \noindent depending on whether the natural number represented by {n} is greater than the one represented by {m}. \FAILURE {NUM_GT_CONV tm} fails if {tm} is not of the form {`n > m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_GT_CONV `3 > 2`;; val it : thm = |- 3 > 2 <=> T # NUM_GT_CONV `77 > 77`;; val it : thm = |- 77 > 77 <=> F } \USES Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_LE_CONV.doc000066400000000000000000000021311303454263000161650ustar00rootroot00000000000000\DOC NUM_LE_CONV \TYPE {NUM_LE_CONV : conv} \SYNOPSIS Proves whether one numeral is less than or equal to another. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_LE_CONV `n <= m`} returns: { |- n <= m <=> T or |- n <= m <=> F } \noindent depending on whether the natural number represented by {n} is less than or equal to the one represented by {m}. \FAILURE {NUM_LE_CONV tm} fails if {tm} is not of the form {`n <= m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_LE_CONV `12 <= 19`;; val it : thm = |- 12 <= 19 <=> T # NUM_LE_CONV `12345 <= 12344`;; val it : thm = |- 12345 <= 12344 <=> F } \USES Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_LT_CONV.doc000066400000000000000000000027471303454263000162210ustar00rootroot00000000000000\DOC NUM_LT_CONV \TYPE {NUM_LT_CONV : conv} \SYNOPSIS Proves whether one numeral is less than another. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are two numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_LT_CONV `n < m`} returns: { |- n < m <=> T or |- n < m <=> F } \noindent depending on whether the natural number represented by {n} is less than the one represented by {m}. \FAILURE {NUM_LT_CONV tm} fails if {tm} is not of the form {`n < m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_LT_CONV `42 < 42`;; val it : thm = |- 42 < 42 <=> F # NUM_LT_CONV `11 < 19`;; val it : thm = |- 11 < 19 <=> T } \USES Performing basic arithmetic reasoning while producing a proof. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_MAX_CONV.doc000066400000000000000000000015721303454263000163220ustar00rootroot00000000000000\DOC NUM_MAX_CONV \TYPE {NUM_MAX_CONV : term -> thm} \SYNOPSIS Proves what the maximum of two natural number numerals is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_MAX_CONV `MAX m n`} returns the theorem: { |- MAX m n = s } \noindent where {s} is the numeral that denotes the maximum of the natural numbers denoted by {n} and {m}. \FAILURE {NUM_MAX_CONV tm} fails if {tm} is not of the form {`MAX m n`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_MAX_CONV `MAX 11 12`;; val it : thm = |- MAX 11 12 = 12 } \SEEALSO NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_MIN_CONV.doc000066400000000000000000000015721303454263000163200ustar00rootroot00000000000000\DOC NUM_MIN_CONV \TYPE {NUM_MIN_CONV : term -> thm} \SYNOPSIS Proves what the minimum of two natural number numerals is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_MIN_CONV `MIN m n`} returns the theorem: { |- MIN m n = s } \noindent where {s} is the numeral that denotes the minimum of the natural numbers denoted by {n} and {m}. \FAILURE {NUM_MIN_CONV tm} fails if {tm} is not of the form {`MIN m n`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_MIN_CONV `MIN 11 12`;; val it : thm = |- MIN 11 12 = 12 } \SEEALSO NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_MOD_CONV.doc000066400000000000000000000024411303454263000163100ustar00rootroot00000000000000\DOC NUM_MOD_CONV \TYPE {NUM_MOD_CONV : term -> thm} \SYNOPSIS Proves what the remainder on dividing one natural number numeral by another is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_MOD_CONV `n MOD m`} returns the theorem: { |- n MOD m = s } \noindent where {s} is the numeral that denotes the remainder on dividing the number denoted by {n} by the one denoted by {m}. \FAILURE {NUM_MOD_CONV tm} fails if {tm} is not of the form {`n MOD m`}, where {n} and {m} are numerals, or if the second numeral {m} is zero. \EXAMPLE { # NUM_MOD_CONV `1089 MOD 9`;; val it : thm = |- 1089 MOD 9 = 0 # NUM_MOD_CONV `1234 MOD 3`;; val it : thm = |- 1234 MOD 3 = 1 # NUM_MOD_CONV `11 MOD 0`;; Exception: Failure "NUM_MOD_CONV". } \COMMENTS For definiteness, remainders with zero denominator are in fact designed to be zero. However, it is perhaps bad style to rely on this fact, so the conversion just fails in this case. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_MULT_CONV.doc000066400000000000000000000016241303454263000164540ustar00rootroot00000000000000\DOC NUM_MULT_CONV \TYPE {NUM_MULT_CONV : term -> thm} \SYNOPSIS Proves what the product of two natural number numerals is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_MULT_CONV `n * m`} returns the theorem: { |- n * m = s } \noindent where {s} is the numeral that denotes the product of the natural numbers denoted by {n} and {m}. \FAILURE {NUM_MULT_CONV tm} fails if {tm} is not of the form {`n * m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_MULT_CONV `12345 * 12345`;; val it : thm = |- 12345 * 12345 = 152399025 } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV,NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_NORMALIZE_CONV.doc000066400000000000000000000022701303454263000172310ustar00rootroot00000000000000\DOC NUM_NORMALIZE_CONV \TYPE {NUM_NORMALIZE_CONV : term -> thm} \SYNOPSIS Puts natural number expressions built using addition, multiplication and powers in canonical polynomial form. \DESCRIBE Given a term {t} of natural number type built up from other ``atomic'' components (not necessarily simple variables) and numeral constants by addition, multiplication and exponentiation by constant exponents, {NUM_NORMALIZE_CONV t} will return {|- t = t'} where {t'} is the result of putting the term into a normalized form, essentially a multiplied-out polynomial with a specific ordering of and within monomials. \FAILURE Should never fail. \EXAMPLE { # NUM_NORMALIZE_CONV `1 + (1 + x + x EXP 2) * (x + (x * x) EXP 2)`;; val it : thm = |- 1 + (1 + x + x EXP 2) * (x + (x * x) EXP 2) = x EXP 6 + x EXP 5 + x EXP 4 + x EXP 3 + x EXP 2 + x + 1 } \COMMENTS This can be used to prove simple algebraic equations, but {NUM_RING} or {ARITH_RULE} are generally more powerful and convenient for that. In particular, this function does not handle cutoff subtraction or other such operations. \SEEALSO ARITH_RULE, NUM_REDUCE_CONV, NUM_RING, REAL_POLY_CONV, SEMIRING_NORMALIZERS_CONV. \ENDDOC hol-light/Help/NUM_ODD_CONV.doc000066400000000000000000000016341303454263000163020ustar00rootroot00000000000000\DOC NUM_ODD_CONV \TYPE {NUM_ODD_CONV : conv} \SYNOPSIS Proves whether a natural number numeral is odd. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then {NUM_ODD_CONV `n`} returns one of the theorems: { |- ODD(n) <=> T } \noindent or { |- ODD(n) <=> F } \noindent according to whether the number denoted by {n} is odd. \FAILURE Fails if applied to a term that is not of the form {`ODD n`} with {n} a numeral. \EXAMPLE { # NUM_ODD_CONV `ODD 123`;; val it : thm = |- ODD 123 <=> T # NUM_ODD_CONV `ODD 1234`;; val it : thm = |- ODD 1234 <=> F } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_PRE_CONV.doc000066400000000000000000000020131303454263000163120ustar00rootroot00000000000000\DOC NUM_PRE_CONV \TYPE {NUM_PRE_CONV : term -> thm} \SYNOPSIS Proves what the cutoff predecessor of a natural number numeral is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then {NUM_PRE_CONV `PRE n`} returns the theorem: { |- PRE n = s } \noindent where {s} is the numeral that denotes the cutoff predecessor of the natural number denoted by {n} (that is, the result of subtracting 1 from it, or zero if it is already zero). \FAILURE {NUM_PRE_CONV tm} fails if {tm} is not of the form {`PRE n`}, where {n} is a numeral. \EXAMPLE { # NUM_PRE_CONV `PRE 0`;; val it : thm = |- PRE 0 = 0 # NUM_PRE_CONV `PRE 12345`;; val it : thm = |- PRE 12345 = 12344 } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_REDUCE_CONV.doc000066400000000000000000000030271303454263000166410ustar00rootroot00000000000000\DOC NUM_REDUCE_CONV \TYPE {NUM_REDUCE_CONV : term -> thm} \SYNOPSIS Evaluate subexpressions built up from natural number numerals, by proof. \KEYWORDS conversion, number, arithmetic. \DESCRIBE When applied to a term, {NUM_REDUCE_CONV} performs a recursive bottom-up evaluation by proof of subterms built from numerals using the unary operators `{SUC}', `{PRE}' and `{FACT}' and the binary arithmetic (`{+}', `{-}', `{*}', `{EXP}', `{DIV}', `{MOD}') and relational (`{<}', `{<=}', `{>}', `{>=}', `{=}') operators, as well as propagating constants through logical operations, e.g. {T /\ x <=> x}, returning a theorem that the original and reduced terms are equal. \FAILURE Never fails, but may have no effect. \EXAMPLE { # NUM_REDUCE_CONV `(432 - 234) + 198`;; val it : thm = |- 432 - 234 + 198 = 396 # NUM_REDUCE_CONV `if 100 < 200 then 2 EXP (8 DIV 2) else 3 EXP ((26 EXP 0) * 3)`;; val it : thm = |- (if 100 < 200 then 2 EXP (8 DIV 2) else 3 EXP (26 EXP 0 * 3)) = 16 # NUM_REDUCE_CONV `(!x. f(x + 2 + 2) < f(x + 0)) ==> f(12 * x) = f(12 * 12)`;; val it : thm = |- (!x. f (x + 2 + 2) < f (x + 0)) ==> f (12 * x) = f (12 * 12) <=> (!x. f (x + 4) < f (x + 0)) ==> f (12 * x) = f 144 } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_TAC, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/NUM_REDUCE_TAC.doc000066400000000000000000000024321303454263000165020ustar00rootroot00000000000000\DOC NUM_REDUCE_TAC \TYPE {NUM_REDUCE_TAC : tactic} \SYNOPSIS Evaluate subexpressions of goal built up from natural number numerals. \KEYWORDS conversion, number, arithmetic. \DESCRIBE When applied to a goal, {NUM_REDUCE_TAC} performs a recursive bottom-up evaluation by proof of subterms of the conclusion built from numerals using the unary operators `{SUC}', `{PRE}' and `{FACT}' and the binary arithmetic (`{+}', `{-}', `{*}', `{EXP}', `{DIV}', `{MOD}') and relational (`{<}', `{<=}', `{>}', `{>=}', `{=}') operators, as well as propagating constants through logical operations, e.g. {T /\ x <=> x}, returning a new subgoal where all these subexpressions are reduced. \FAILURE Never fails, but may have no effect. \EXAMPLE { # g `1 EXP 3 + 12 EXP 3 = 1729 /\ 9 EXP 3 + 10 EXP 3 = 1729`;; val it : goalstack = 1 subgoal (1 total) `1 EXP 3 + 12 EXP 3 = 1729 /\ 9 EXP 3 + 10 EXP 3 = 1729` # e NUM_REDUCE_TAC;; val it : goalstack = No subgoals } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/NUM_RED_CONV.doc000066400000000000000000000035221303454263000163040ustar00rootroot00000000000000\DOC NUM_RED_CONV \TYPE {NUM_RED_CONV : term -> thm} \SYNOPSIS Performs one arithmetic or relational operation on natural number numerals by proof. \KEYWORDS conversion, number, arithmetic. \DESCRIBE When applied to a term that is either a unary operator application {`SUC n`}, {`PRE n`} or {`FACT n`} for a numeral {n}, or a relational operator application {`m < n`}, {`m <= n`}, {`m > n`}, {`m >= n`} or {`m = n`}, or a binary arithmetic operation {`m + n`}, {`m - n`}, {`m * n`}, {`m EXP n`}, {`m DIV n`} or {`m MOD n`} applied to numerals {m} and {n}, the conversion {NUM_RED_CONV} will `reduce' it and return a theorem asserting its equality to the reduced form. \FAILURE {NUM_RED_CONV tm} fails if {tm} is not of one of the forms specified. \EXAMPLE { # NUM_RED_CONV `2 + 2`;; val it : thm = |- 2 + 2 = 4 # NUM_RED_CONV `1089 < 2231`;; val it : thm = |- 1089 < 2231 <=> T # NUM_RED_CONV `FACT 11`;; val it : thm = |- FACT 11 = 39916800 } Note that the immediate operands must be numerals. For deeper reduction of combinations of numerals, use {NUM_REDUCE_CONV}: { # NUM_RED_CONV `(432 - 234) + 198`;; Exception: Failure "REWRITES_CONV". # NUM_REDUCE_CONV `(432 - 234) + 198`;; val it : thm = |- 432 - 234 + 198 = 396 } \USES Access to this `one-step' reduction is not usually especially useful, but if you want to add a conversion {conv} for some other operator on numbers, you can conveniently incorporate it into {NUM_REDUCE_CONV} with { # let NUM_REDUCE_CONV' = DEPTH_CONV(REAL_RAT_RED_CONV ORELSEC conv);; } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_REL_CONV, NUM_SUB_CONV, NUM_SUC_CONV, REAL_RAT_RED_CONV. \ENDDOC hol-light/Help/NUM_REL_CONV.doc000066400000000000000000000024171303454263000163160ustar00rootroot00000000000000\DOC NUM_REL_CONV \TYPE {NUM_REL_CONV : term -> thm} \SYNOPSIS Performs relational operation on natural number numerals by proof. \KEYWORDS conversion, number, arithmetic. \DESCRIBE When applied to a term that is a relational operator application {`m < n`}, {`m <= n`}, {`m > n`}, {`m >= n`} or {`m = n`} applied to numerals {m} and {n}, the conversion {NUM_REL_CONV} will `reduce' it and return a theorem asserting its equality to {`T`} or {`F`} as appropriate. \FAILURE {NUM_REL_CONV tm} fails if {tm} is not of one of the forms specified. \EXAMPLE { # NUM_REL_CONV `1089 < 2231`;; val it : thm = |- 1089 < 2231 <=> T # NUM_REL_CONV `1089 >= 2231`;; val it : thm = |- 1089 >= 2231 <=> F } Note that the immediate operands must be numerals. For deeper reduction of combinations of numerals, use {NUM_REDUCE_CONV}. { # NUM_REL_CONV `2 + 2 = 4`;; Exception: Failure "REWRITES_CONV". # NUM_REDUCE_CONV `2 + 2 = 4`;; val it : thm = |- 2 + 2 = 4 <=> T } \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_SUB_CONV, NUM_SUC_CONV, REAL_RAT_RED_CONV. \ENDDOC hol-light/Help/NUM_RING.doc000066400000000000000000000036211303454263000156040ustar00rootroot00000000000000\DOC NUM_RING \TYPE {NUM_RING : term -> thm} \SYNOPSIS Ring decision procedure instantiated to natural numbers. \DESCRIBE The rule {NUM_RING} should be applied to a formula that, after suitable normalization, can be considered a universally quantified Boolean combination of equations and inequations between terms of type {:num}. If that formula holds in all integral domains, {NUM_RING} will prove it. Any ``alien'' atomic formulas that are not natural number equations will not contribute to the proof but will not in themselves cause an error. The function is a particular instantiation of {RING}, which is a more generic procedure for ring and semiring structures. \FAILURE Fails if the formula is unprovable by the methods employed. This does not necessarily mean that it is not valid for {:num}, but rather that it is not valid on all integral domains (see below). \EXAMPLE The following formula is proved because it holds in all integral domains: { # NUM_RING `(x + y) EXP 2 = x EXP 2 ==> y = 0 \/ y + 2 * x = 0`;; 1 basis elements and 0 critical pairs Translating certificate to HOL inferences val it : thm = |- (x + y) EXP 2 = x EXP 2 ==> y = 0 \/ y + 2 * x = 0 } \noindent but the following isn't, even though over {:num} it is equivalent: { # NUM_RING `(x + y) EXP 2 = x EXP 2 ==> y = 0 \/ x = 0`;; 2 basis elements and 1 critical pairs 3 basis elements and 2 critical pairs 3 basis elements and 1 critical pairs 4 basis elements and 1 critical pairs 4 basis elements and 0 critical pairs Exception: Failure "find". } \COMMENTS Note that since we are working over {:num}, which is not really a ring, cutoff subtraction is not true ring subtraction and the ability of {NUM_RING} to handle it is limited. Instantiations of {RING} to actual rings, such as {REAL_RING}, have no such problems. \SEEALSO ARITH_RULE, ARITH_TAC, ideal_cofactors, NUM_NORMALIZE_CONV, REAL_RING, RING. \ENDDOC hol-light/Help/NUM_SIMPLIFY_CONV.doc000066400000000000000000000026001303454263000171220ustar00rootroot00000000000000\DOC NUM_SIMPLIFY_CONV \TYPE {NUM_SIMPLIFY_CONV : conv} \SYNOPSIS Eliminates predecessor, cutoff subtraction, even and odd, division and modulus. \DESCRIBE When applied to a term, {NUM_SIMPLIFY_CONV} tries to get rid of instances of the natural number operators {PRE}, {DIV}, {MOD} and {-} (which is cutoff subtraction), as well as the {EVEN} and {ODD} predicates, by rephrasing properties in terms of multiplication and addition, adding new variables if necessary. Some attempt is made to introduce quantifiers so that they are effectively universally quantified. However, the input formula should be in NNF for this aspect to be completely reliable. \FAILURE Should never fail, but in obscure situations may leave some instance of the troublesome operators (for example, if they are mapped over a list instead of simply applied). \EXAMPLE { # NUM_SIMPLIFY_CONV `~(n = 0) ==> PRE(n) + 1 = n`;; val it : thm = |- ~(n = 0) ==> PRE n + 1 = n <=> (!m. ~(n = SUC m) /\ (~(m = 0) \/ ~(n = 0)) \/ n = 0 \/ m + 1 = n) } \USES Not really intended for most users, but a prelude inside several automated routines such as {ARITH_RULE}. It is because of this preprocessing step that such rules can handle these troublesome operators to some extent, e.g. { # ARITH_RULE `~(n = 0) ==> n DIV 3 < n`;; val it : thm = |- ~(n = 0) ==> n DIV 3 < n } \SEEALSO ARITH_RULE, ARITH_TAC, NUM_RING. \ENDDOC hol-light/Help/NUM_SUB_CONV.doc000066400000000000000000000023771303454263000163320ustar00rootroot00000000000000\DOC NUM_SUB_CONV \TYPE {NUM_SUB_CONV : term -> thm} \SYNOPSIS Proves what the cutoff difference of two natural number numerals is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} and {m} are numerals (e.g. {0}, {1}, {2}, {3},...), then {NUM_SUB_CONV `n - m`} returns the theorem: { |- n - m = s } \noindent where {s} is the numeral that denotes the result of subtracting the natural number denoted by {m} from the one denoted by {n}, returning zero for all cases where {m} is greater than {n} (cutoff subtraction over the natural numbers). \FAILURE {NUM_SUB_CONV tm} fails if {tm} is not of the form {`n - m`}, where {n} and {m} are numerals. \EXAMPLE { # NUM_SUB_CONV `4321 - 1234`;; val it : thm = |- 4321 - 1234 = 3087 # NUM_SUB_CONV `77 - 88`;; val it : thm = |- 77 - 88 = 0 } \COMMENTS Note that subtraction over type {:num} is defined as this cutoff subtraction. If you want a number system with negative numbers, use {:int} or {:real}. \SEEALSO NUM_ADD_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUC_CONV. \ENDDOC hol-light/Help/NUM_SUC_CONV.doc000066400000000000000000000017331303454263000163260ustar00rootroot00000000000000\DOC NUM_SUC_CONV \TYPE {NUM_SUC_CONV : term -> thm} \SYNOPSIS Proves what the successor of a natural number numeral is. \KEYWORDS conversion, number, arithmetic. \DESCRIBE If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then {NUM_SUC_CONV `SUC n`} returns the theorem: { |- SUC n = s } \noindent where {s} is the numeral that denotes the successor of the natural number denoted by {n} (that is, the result of adding 1 to it). \FAILURE {NUM_SUC_CONV tm} fails if {tm} is not of the form {`SUC n`}, where {n} is a numeral. \EXAMPLE { # NUM_SUC_CONV `SUC 0`;; val it : thm = |- SUC 0 = 1 # NUM_SUC_CONV `SUC 12345`;; val it : thm = |- SUC 12345 = 12346 } \SEEALSO NUM_ADD_CONV, num_CONV, NUM_DIV_CONV, NUM_EQ_CONV, NUM_EVEN_CONV, NUM_EXP_CONV, NUM_FACT_CONV, NUM_GE_CONV, NUM_GT_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_MAX_CONV, NUM_MIN_CONV, NUM_MOD_CONV, NUM_MULT_CONV, NUM_ODD_CONV, NUM_PRE_CONV, NUM_REDUCE_CONV, NUM_RED_CONV, NUM_REL_CONV, NUM_SUB_CONV. \ENDDOC hol-light/Help/NUM_TO_INT_CONV.doc000066400000000000000000000016101303454263000167220ustar00rootroot00000000000000\DOC NUM_TO_INT_CONV \TYPE {NUM_TO_INT_CONV : conv} \SYNOPSIS Maps an assertion over natural numbers to equivalent over reals. \DESCRIBE Given a term, with arbitrary quantifier alternations over the natural numbers, {NUM_TO_INT_CONV} proves its equivalence to a term involving integer operations and quantifiers. Some preprocessing removes certain natural-specific operations such as {PRE} and cutoff subtraction, quantifiers are systematically relativized to the set of positive integers. \FAILURE Never fails. \EXAMPLE { # NUM_TO_INT_CONV `n - m <= n`;; val it : thm = |- n - m <= n <=> (!i. ~(&0 <= i) \/ (~(&m = &n + i) \/ &0 <= &n) /\ (~(&n = &m + i) \/ i <= &n)) } \USES Mostly intended as a preprocessing step to allow rules for the integers to deduce facts about natural numbers too. \SEEALSO ARITH_RULE, INT_ARITH, INT_OF_REAL_THM, NUM_SIMPLIFY_CONV. \ENDDOC hol-light/Help/ONCE_ASM_REWRITE_RULE.doc000066400000000000000000000020041303454263000175740ustar00rootroot00000000000000\DOC ONCE_ASM_REWRITE_RULE \TYPE {ONCE_ASM_REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem once including built-in rewrites and the theorem's assumptions. \KEYWORDS rule. \DESCRIBE {ONCE_ASM_REWRITE_RULE} applies all possible rewrites in one step over the subterms in the conclusion of the theorem, but stops after rewriting at most once at each subterm. This strategy is specified as for {ONCE_DEPTH_CONV}. For more details see {ASM_REWRITE_RULE}, which does search recursively (to any depth) for matching subterms. The general strategy for rewriting theorems is described under {GEN_REWRITE_RULE}. \FAILURE Never fails. \USES This tactic is used when rewriting with the hypotheses of a theorem (as well as a given list of theorems and {basic_rewrites}), when more than one pass is not required or would result in divergence. \SEEALSO ASM_REWRITE_RULE, GEN_REWRITE_RULE, ONCE_DEPTH_CONV, ONCE_REWRITE_RULE, PURE_ASM_REWRITE_RULE, PURE_ONCE_ASM_REWRITE_RULE, PURE_REWRITE_RULE, REWRITE_RULE. \ENDDOC hol-light/Help/ONCE_ASM_REWRITE_TAC.doc000066400000000000000000000034171303454263000174450ustar00rootroot00000000000000\DOC ONCE_ASM_REWRITE_TAC \TYPE {ONCE_ASM_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal once including built-in rewrites and the goal's assumptions. \KEYWORDS tactic. \DESCRIBE {ONCE_ASM_REWRITE_TAC} behaves in the same way as {ASM_REWRITE_TAC}, but makes one pass only through the term of the goal. The order in which the given theorems are applied is an implementation matter and the user should not depend on any ordering. See {GEN_REWRITE_TAC} for more information on rewriting a goal in HOL. \FAILURE {ONCE_ASM_REWRITE_TAC} does not fail and, unlike {ASM_REWRITE_TAC}, does not diverge. The resulting tactic may not be valid, if the rewrites performed add new assumptions to the theorem eventually proved. \EXAMPLE The use of {ONCE_ASM_REWRITE_TAC} to control the amount of rewriting performed is illustrated on this goal: { # g `a = b /\ b = c ==> (P a b <=> P c a)`;; Warning: inventing type variables Warning: Free variables in goal: P, a, b, c val it : goalstack = 1 subgoal (1 total) `a = b /\ b = c ==> (P a b <=> P c a)` # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`a = b`] 1 [`b = c`] `P a b <=> P c a` } The application of {ONCE_ASM_REWRITE_TAC} rewrites each applicable subterm just once: { # e(ONCE_ASM_REWRITE_TAC[]);; val it : goalstack = 1 subgoal (1 total) 0 [`a = b`] 1 [`b = c`] `P b c <=> P c b` } \USES {ONCE_ASM_REWRITE_TAC} can be applied once or iterated as required to give the effect of {ASM_REWRITE_TAC}, either to avoid divergence or to save inference steps. \SEEALSO basic_rewrites, ASM_REWRITE_TAC, GEN_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC hol-light/Help/ONCE_ASM_SIMP_TAC.doc000066400000000000000000000015001303454263000170630ustar00rootroot00000000000000\DOC ONCE_ASM_SIMP_TAC \TYPE {ONCE_ASM_SIMP_TAC : thm list -> tactic} \SYNOPSIS Simplify toplevel applicable terms in goal using assumptions and context. \DESCRIBE A call to {ONCE_ASM_SIMP_TAC[theorems]} will apply conditional contextual rewriting with {theorems} and the current assumptions of the goal to the goal's conclusion. The {ONCE} prefix means that the toplevel simplification is only applied once to the toplevel terms, though any conditional subgoals generated are then simplified repeatedly. For more details on this kind of rewriting, see {SIMP_CONV}. If the extra generality of contextual conditional rewriting is not needed, {ONCE_ASM_REWRITE_TAC} is usually more efficient. \FAILURE Never fails, but may loop indefinitely. \SEEALSO ASM_SIMP_TAC, ONCE_ASM_REWRITE_TAC, SIMP_CONV, SIMP_TAC, REWRITE_TAC. \ENDDOC hol-light/Help/ONCE_DEPTH_CONV.doc000066400000000000000000000044661303454263000166330ustar00rootroot00000000000000\DOC ONCE_DEPTH_CONV \TYPE {ONCE_DEPTH_CONV : conv -> conv} \SYNOPSIS Applies a conversion once to the first suitable sub-term(s) encountered in top-down order. \KEYWORDS conversional. \DESCRIBE {ONCE_DEPTH_CONV c tm} applies the conversion {c} once to the first subterm or subterms encountered in a top-down `parallel' search of the term {tm} for which {c} succeeds. If the conversion {c} fails on all subterms of {tm}, the theorem returned is {|- tm = tm}. \FAILURE Never fails. \EXAMPLE The following example shows how {ONCE_DEPTH_CONV} applies a conversion to only the first suitable subterm(s) found in a top-down search: { # ONCE_DEPTH_CONV BETA_CONV `(\x. (\y. y + x) 1) 2`;; val it : thm = |- (\x. (\y. y + x) 1) 2 = (\y. y + 2) 1 } \noindent Here, there are two beta-redexes in the input term. One of these occurs within the other, so {BETA_CONV} is applied only to the outermost one. Note that the supplied conversion is applied by {ONCE_DEPTH_CONV} to all independent subterms at which it succeeds. That is, the conversion is applied to every suitable subterm not contained in some other subterm for which the conversions also succeeds, as illustrated by the following example: { # ONCE_DEPTH_CONV num_CONV `(\x. (\y. y + x) 1) 2`;; val it : thm = |- (\x. (\y. y + x) 1) 2 = (\x. (\y. y + x) (SUC 0)) (SUC 1) } \noindent Here {num_CONV} is applied to both {1} and {2}, since neither term occurs within a larger subterm for which the conversion {num_CONV} succeeds. \USES {ONCE_DEPTH_CONV} is frequently used when there is only one subterm to which the desired conversion applies. This can be much faster than using other functions that attempt to apply a conversion to all subterms of a term (e.g. {DEPTH_CONV}). If, for example, the current goal in a goal-directed proof contains only one beta-redex, and one wishes to apply {BETA_CONV} to it, then the tactic { CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) } \noindent may, depending on where the beta-redex occurs, be much faster than { CONV_TAC (TOP_DEPTH_CONV BETA_CONV) } {ONCE_DEPTH_CONV c} may also be used when the supplied conversion {c} never fails, in which case using a conversion such as {DEPTH_CONV c}, which applies {c} repeatedly would never terminate. \SEEALSO DEPTH_BINOP_CONV, DEPTH_CONV, PROP_ATOM_CONV, REDEPTH_CONV, TOP_DEPTH_CONV, TOP_SWEEP_CONV. \ENDDOC hol-light/Help/ONCE_DEPTH_SQCONV.doc000066400000000000000000000011331303454263000170630ustar00rootroot00000000000000\DOC ONCE_DEPTH_SQCONV \TYPE {ONCE_DEPTH_SQCONV : strategy} \SYNOPSIS Applies simplification to the first suitable sub-term(s) encountered in top-down order. \DESCRIBE HOL Light's simplification functions (e.g. {SIMP_TAC}) have their traversal algorithm controlled by a ``strategy''. {ONCE_DEPTH_SQCONV} is a strategy corresponding to {ONCE_DEPTH_CONV} for ordinary conversions: simplification is applied to the first suitable subterm(s) encountered in top-down order. \FAILURE Not applicable. \SEEALSO DEPTH_SQCONV, ONCE_DEPTH_CONV, REDEPTH_SQCONV, TOP_DEPTH_SQCONV, TOP_SWEEP_SQCONV. \ENDDOC hol-light/Help/ONCE_REWRITE_CONV.doc000066400000000000000000000014351303454263000171010ustar00rootroot00000000000000\DOC ONCE_REWRITE_CONV \TYPE {ONCE_REWRITE_CONV : thm list -> conv} \SYNOPSIS Rewrites a term, including built-in tautologies in the list of rewrites. \KEYWORDS conversion. \DESCRIBE {ONCE_REWRITE_CONV} searches for matching subterms and applies rewrites once at each subterm, in the manner specified for {ONCE_DEPTH_CONV}. The rewrites which are used are obtained from the given list of theorems and the set of tautologies stored in {basic_rewrites}. See {GEN_REWRITE_CONV} for the general method of using theorems to rewrite a term. \FAILURE {ONCE_REWRITE_CONV} does not fail; it does not diverge. \USES {ONCE_REWRITE_CONV} can be used to rewrite a term when recursive rewriting is not desired. \SEEALSO GEN_REWRITE_CONV, PURE_ONCE_REWRITE_CONV, PURE_REWRITE_CONV, REWRITE_CONV. \ENDDOC hol-light/Help/ONCE_REWRITE_RULE.doc000066400000000000000000000015271303454263000171050ustar00rootroot00000000000000\DOC ONCE_REWRITE_RULE \TYPE {ONCE_REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem, including built-in tautologies in the list of rewrites. \KEYWORDS rule. \DESCRIBE {ONCE_REWRITE_RULE} searches for matching subterms and applies rewrites once at each subterm, in the manner specified for {ONCE_DEPTH_CONV}. The rewrites which are used are obtained from the given list of theorems and the set of tautologies stored in {basic_rewrites}. See {GEN_REWRITE_RULE} for the general method of using theorems to rewrite an object theorem. \FAILURE {ONCE_REWRITE_RULE} does not fail; it does not diverge. \USES {ONCE_REWRITE_RULE} can be used to rewrite a theorem when recursive rewriting is not desired. \SEEALSO ASM_REWRITE_RULE, GEN_REWRITE_RULE, ONCE_ASM_REWRITE_RULE, PURE_ONCE_REWRITE_RULE, PURE_REWRITE_RULE, REWRITE_RULE. \ENDDOC hol-light/Help/ONCE_REWRITE_TAC.doc000066400000000000000000000034561303454263000167500ustar00rootroot00000000000000\DOC ONCE_REWRITE_TAC \TYPE {ONCE_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal only once with {basic_rewrites} and the supplied list of theorems. \KEYWORDS tactic. \DESCRIBE A set of equational rewrites is generated from the theorems supplied by the user and the set of basic tautologies, and these are used to rewrite the goal at all subterms at which a match is found in one pass over the term part of the goal. The result is returned without recursively applying the rewrite theorems to it. The order in which the given theorems are applied is an implementation matter and the user should not depend on any ordering. More details about rewriting can be found under {GEN_REWRITE_TAC}. \FAILURE {ONCE_REWRITE_TAC} does not fail and does not diverge. It results in an invalid tactic if any of the applied rewrites introduces new assumptions to the theorem eventually proved. \EXAMPLE Given a theorem list: { # let thl = map (num_CONV o mk_small_numeral) (1--3);; val thl : thm list = [|- 1 = SUC 0; |- 2 = SUC 1; |- 3 = SUC 2] } \noindent and the following goal: { # g `0 < 3`;; val it : goalstack = 1 subgoal (1 total) `0 < 3` } \noindent the tactic {ONCE_REWRITE_TAC thl} performs a single rewrite { # e(ONCE_REWRITE_TAC thl);; val it : goalstack = 1 subgoal (1 total) `0 < SUC 2` } \noindent in contrast to {REWRITE_TAC thl} which would rewrite the goal repeatedly into this form: { # e(REWRITE_TAC thl);; val it : goalstack = 1 subgoal (1 total) `0 < SUC (SUC (SUC 0))` } \USES {ONCE_REWRITE_TAC} can be used iteratively to rewrite when recursive rewriting would diverge. It can also be used to save inference steps. \SEEALSO ASM_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC hol-light/Help/ONCE_SIMPLIFY_CONV.doc000066400000000000000000000016101303454263000172070ustar00rootroot00000000000000\DOC ONCE_SIMPLIFY_CONV \TYPE {ONCE_SIMPLIFY_CONV : simpset -> thm list -> conv} \SYNOPSIS General top-level simplification with arbitrary simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset'. Given a simpset {ss} and an additional list of theorems {thl} to be used as (conditional or unconditional) rewrite rules, {SIMPLIFY_CONV ss thl} gives a simplification conversion with a top-down single simplification traversal strategy ({ONCE_DEPTH_SQCONV}) and a nesting limit of 1 for the recursive solution of subconditions by further simplification. \FAILURE Never fails. \USES Usually some other interface to the simplifier is more convenient, but you may want to use this to employ a customized simpset. \SEEALSO GEN_SIMPLIFY_CONV, ONCE_DEPTH_SQCONV, SIMPLIFY_CONV, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/ONCE_SIMP_CONV.doc000066400000000000000000000014161303454263000165270ustar00rootroot00000000000000\DOC ONCE_SIMP_CONV \TYPE {ONCE_SIMP_CONV : thm list -> conv} \SYNOPSIS Simplify a term once by conditional contextual rewriting. \DESCRIBE A call {ONCE_SIMP_CONV thl tm} will return {|- tm = tm'} where {tm'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of conditional rewriting, see {SIMP_TAC}. The {ONCE} prefix indicates that the first applicable terms in a toplevel term will be simplified once only, though conditional subgoals generated will be simplified repeatedly. \FAILURE Never fails, but may return a reflexive theorem {|- tm = tm} if no simplifications can be made. \SEEALSO ASM_SIMP_TAC, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/ONCE_SIMP_RULE.doc000066400000000000000000000014061303454263000165300ustar00rootroot00000000000000\DOC ONCE_SIMP_RULE \TYPE {ONCE_SIMP_RULE : thm list -> thm -> thm} \SYNOPSIS Simplify conclusion of a theorem once by conditional contextual rewriting. \DESCRIBE A call {ONCE_SIMP_RULE thl (|- tm)} will return {|- tm'} where {tm'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of conditional rewriting, see {SIMP_CONV}. The {ONCE} prefix indicates that the first applicable terms in a toplevel term will be simplified once only, though conditional subgoals generated will be simplified repeatedly. \FAILURE Never fails, but may return the initial theorem unchanged. \SEEALSO ASM_SIMP_TAC, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/ONCE_SIMP_TAC.doc000066400000000000000000000017061303454263000163730ustar00rootroot00000000000000\DOC ONCE_SIMP_TAC \TYPE {ONCE_SIMP_TAC : thm list -> tactic} \SYNOPSIS Simplify conclusion of goal once by conditional contextual rewriting. \DESCRIBE When applied to a goal {A ?- g}, the tactic {ONCE_SIMP_TAC thl} returns a new goal {A ?- g'} where {g'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of conditional rewriting, see {SIMP_CONV}. The {ONCE} prefix indicates that the first applicable terms in a toplevel term will be simplified once only. Moreover, in contrast to the other simplification tactics, any unsolved subgoals arising from conditions on rewrites will be split off as new goals, allowing simplification to proceed more interactively. \FAILURE Never fails, though may not change the goal if no simplifications are applicable. \SEEALSO ONCE_SIMP_CONV, ONCE_SIMP_RULE, SIMP_CONV, SIMP_TAC. \ENDDOC hol-light/Help/ORDERED_IMP_REWR_CONV.doc000066400000000000000000000024131303454263000176010ustar00rootroot00000000000000\DOC ORDERED_IMP_REWR_CONV \TYPE {ORDERED_IMP_REWR_CONV : (term -> term -> bool) -> thm -> term -> thm} \SYNOPSIS Basic conditional rewriting conversion restricted by term order. \DESCRIBE Given an ordering relation {ord}, an equational theorem {A |- !x1...xn. p ==> s = t} that expresses a conditional rewrite rule, the conversion {ORDERED_IMP_REWR_CONV} gives a conversion that applied to any term {s'} will attempt to match the left-hand side of the equation {s = t} to {s'}, and return the corresponding theorem {A |- p' ==> s' = t'}, but only if {ord `s'` `t'`}, i.e. if the left-hand side is ``greater'' in the ordering than the right-hand side, after instantiation. If the ordering condition is violated, it will fail, even if the match is fine. \FAILURE Fails if the theorem is not of the right form or the two terms cannot be matched, for example because the variables that need to be instantiated are free in the hypotheses {A}, or if the ordering requirement fails. \EXAMPLE \USES Applying conditional rewrite rules that are permutative and would loop without some ordering restriction. Applied automatically to some permutative rewrite rules in the simplifier, e.g. in {SIMP_CONV}. \SEEALSO IMP_REWR_CONV, ORDERED_REWR_CONV, REWR_CONV, SIMP_CONV, term_order. \ENDDOC hol-light/Help/ORDERED_REWR_CONV.doc000066400000000000000000000034371303454263000171030ustar00rootroot00000000000000\DOC ORDERED_REWR_CONV \TYPE {ORDERED_REWR_CONV : (term -> term -> bool) -> thm -> term -> thm} \SYNOPSIS Basic rewriting conversion restricted by term order. \DESCRIBE Given an ordering relation {ord}, an equational theorem {A |- !x1...xn. s = t} that expresses a rewrite rule, the conversion {ORDERED_REWR_CONV} gives a conversion that applied to any term {s'} will attempt to match the left-hand side of the equation {s = t} to {s'}, and return the corresponding theorem {A |- s' = t'}, but only if {ord `s'` `t'`}, i.e. if the left-hand side is ``greater'' in the ordering than the right-hand side, after instantiation. If the ordering condition is violated, it will fail, even if the match is fine. \FAILURE Fails if the theorem is not of the right form or the two terms cannot be matched, for example because the variables that need to be instantiated are free in the hypotheses {A}, or if the ordering requirement fails. \EXAMPLE We apply the permutative rewrite: { # ADD_SYM;; val it : thm = |- !m n. m + n = n + m } \noindent with the default term ordering {term_order} designed for this kind of application. Note that it applies in one direction: { # ORDERED_REWR_CONV term_order ADD_SYM `1 + 2`;; val it : thm = |- 1 + 2 = 2 + 1 } \noindent but not the other: { # ORDERED_REWR_CONV term_order ADD_SYM `2 + 1`;; Exception: Failure "ORDERED_REWR_CONV: wrong orientation". } \USES Applying conditional rewrite rules that are permutative and would loop without some restriction. Thanks to the fact that higher-level rewriting operations like {REWRITE_CONV} and {REWRITE_TAC} have ordering built in for permutative rewrite rules, rewriting with theorem like {ADD_AC} will effectively normalize terms. \SEEALSO IMP_REWR_CONV, ORDERED_IMP_REWR_CONV, REWR_CONV, SIMP_CONV, term_order. \ENDDOC hol-light/Help/ORELSE.doc000066400000000000000000000022661303454263000153230ustar00rootroot00000000000000\DOC ORELSE \TYPE {(ORELSE) : tactic -> tactic -> tactic} \SYNOPSIS Applies first tactic, and iff it fails, applies the second instead. \KEYWORDS tactical. \DESCRIBE If {t1} and {t2} are tactics, {t1 ORELSE t2} is a tactic which applies {t1} to a goal, and iff it fails, applies {t2} to the goal instead. \FAILURE The application of {ORELSE} to a pair of tactics never fails. The resulting tactic fails if both {t1} and {t2} fail when applied to the relevant goal. \EXAMPLE The tactic {STRIP_TAC} breaks down the logical structure of a goal in various ways, e.g. stripping off universal quantifiers and putting the antecedent of implicational conclusions into the assumptions. However it does not break down equivalences into two implications, as {EQ_TAC} does. So you might start breaking down a goal corresponding to the inbuilt theorem {MOD_EQ_0} { # g `!m n. ~(n = 0) ==> ((m MOD n = 0) <=> (?q. m = q * n))`;; ... } \noindent as follows { # e(REPEAT(STRIP_TAC ORELSE EQ_TAC));; val it : goalstack = 2 subgoals (2 total) 0 [`~(n = 0)`] 1 [`m = q * n`] `m MOD n = 0` 0 [`~(n = 0)`] 1 [`m MOD n = 0`] `?q. m = q * n` } \SEEALSO EVERY, FIRST, THEN. \ENDDOC hol-light/Help/ORELSEC.doc000066400000000000000000000012331303454263000154170ustar00rootroot00000000000000\DOC ORELSEC \TYPE {(ORELSEC) : conv -> conv -> conv} \SYNOPSIS Applies the first of two conversions that succeeds. \KEYWORDS conversional. \DESCRIBE {(c1 ORELSEC c2) `t`} returns the result of applying the conversion {c1} to the term {`t`} if this succeeds. Otherwise {(c1 ORELSEC c2) `t`} returns the result of applying the conversion {c2} to the term {`t`}. \FAILURE {(c1 ORELSEC c2) `t`} fails both {c1} and {c2} fail when applied to {`t`}. \EXAMPLE { # (NUM_ADD_CONV ORELSEC NUM_MULT_CONV) `2 + 2`;; val it : thm = |- 2 + 2 = 4 # (NUM_ADD_CONV ORELSEC NUM_MULT_CONV) `1 * 1`;; val it : thm = |- 1 * 1 = 1 } \SEEALSO FIRST_CONV, THENC. \ENDDOC hol-light/Help/ORELSE_TCL.doc000066400000000000000000000011121303454263000160120ustar00rootroot00000000000000\DOC ORELSE_TCL \TYPE {(ORELSE_TCL) : thm_tactical -> thm_tactical -> thm_tactical} \SYNOPSIS Applies a theorem-tactical, and if it fails, tries a second. \KEYWORDS theorem-tactical. \DESCRIBE When applied to two theorem-tacticals, {ttl1} and {ttl2}, a theorem-tactic {ttac}, and a theorem {th}, if {ttl1 ttac th} succeeds, that gives the result. If it fails, the result is {ttl2 ttac th}, which may itself fail. \FAILURE {ORELSE_TCL} fails if both the theorem-tacticals fail when applied to the given theorem-tactic and theorem. \SEEALSO EVERY_TCL, FIRST_TCL, THEN_TCL. \ENDDOC hol-light/Help/PART_MATCH.doc000066400000000000000000000041151303454263000160070ustar00rootroot00000000000000\DOC PART_MATCH \TYPE {PART_MATCH : (term -> term) -> thm -> term -> thm} \SYNOPSIS Instantiates a theorem by matching part of it to a term. \DESCRIBE When applied to a `selector' function of type {term -> term}, a theorem and a term: { PART_MATCH fn (A |- !x1...xn. t) tm } \noindent the function {PART_MATCH} applies {fn} to {t'} (the result of specializing universally quantified variables in the conclusion of the theorem), and attempts to match the resulting term to the argument term {tm}. If it succeeds, the appropriately instantiated version of the theorem is returned. Limited higher-order matching is supported, and some attempt is made to maintain bound variable names in higher-order matching. \FAILURE Fails if the selector function {fn} fails when applied to the instantiated theorem, or if the match fails with the term it has provided. \EXAMPLE Suppose that we have the following theorem: { th = |- !x. x ==> x } \noindent then the following: { PART_MATCH (fst o dest_imp) th `T` } \noindent results in the theorem: { |- T ==> T } \noindent because the selector function picks the antecedent of the implication (the inbuilt specialization gets rid of the universal quantifier), and matches it to {T}. For a higher-order case rather similar to what goes on inside HOL's {INDUCT_TAC}: { # num_INDUCTION;; val it : thm = |- !P. P 0 /\ (!n. P n ==> P (SUC n)) ==> (!n. P n) # PART_MATCH rand it `!n. n <= n * n`;; val it : thm = |- 0 <= 0 * 0 /\ (!n. n <= n * n ==> SUC n <= SUC n * SUC n) ==> (!n. n <= n * n) } To show a more interesting case with higher-order matching, where the pattern is not quite a higher-order pattern in the usual sense, consider the theorem: { # let th = MESON[num_CASES; NOT_SUC] `(!n. P(SUC n)) <=> !n. ~(n = 0) ==> P n` ... val th : thm = |- (!n. P (SUC n)) <=> (!n. ~(n = 0) ==> P n) } \noindent and instantiate it as follows: { # PART_MATCH lhs th `!n. 1 <= SUC n`;; val it : thm = |- (!n. 1 <= SUC n) <=> (!n. ~(n = 0) ==> 1 <= n) } \SEEALSO GEN_PART_MATCH, INST_TYPE, INST_TY_TERM, MATCH_MP, REWR_CONV, term_match. \ENDDOC hol-light/Help/PATH_CONV.doc000066400000000000000000000020401303454263000157010ustar00rootroot00000000000000\DOC PATH_CONV \TYPE {PATH_CONV : string -> conv -> conv} \SYNOPSIS Applies a conversion to the subterm indicated by a path string. \DESCRIBE The call {PATH_CONV p cnv} gives a new conversion that applies {cnv} to the subterm of a term identified by the path string {p}. This path string is interpreted as a sequence of direction indications: \begin{{itemize}} \item {"b"}: take the body of an abstraction \item {"l"}: take the left (rator) path in an application \item {"r"}: take the right (rand) path in an application \end{{itemize}} \FAILURE The basic call to the path string and conversion never fails, but when applied to the term it may, if the path is not meaningful or if the conversion itself fails on the indicated subterm. \USES More concise indication of sub-conversion application than by composing {RATOR_CONV}, {RAND_CONV} and {ABS_CONV}. \EXAMPLE { # PATH_CONV "rlr" NUM_ADD_CONV `(1 + 2) + (3 + 4) + (5 + 6)`;; val it : thm = |- (1 + 2) + (3 + 4) + 5 + 6 = (1 + 2) + 7 + 5 + 6 } \SEEALSO find_path, follow_path. \ENDDOC hol-light/Help/PAT_CONV.doc000066400000000000000000000023201303454263000155720ustar00rootroot00000000000000\DOC PAT_CONV \TYPE {PAT_CONV : term -> conv -> conv} \SYNOPSIS Apply a conversion at subterms identified by a ``pattern'' lambda-abstraction. \DESCRIBE The call {PAT_CONV `\x1 ... xn. t[x1,...,xn]` cnv} gives a new conversion that applies {cnv} to subterms of the target term corresponding to the free instances of any {xi} in the pattern {t[x1,...,xn]}. The fact that the pattern is a function has no logical significance; it is just used as a convenient format for the pattern. \FAILURE Never fails until applied to a term, but then it may fail if the core conversion does on the chosen subterms. \EXAMPLE Here we choose to evaluate just two subterms: { # PAT_CONV `\x. x + a + x` NUM_ADD_CONV `(1 + 2) + (3 + 4) + (5 + 6)`;; val it : thm = |- (1 + 2) + (3 + 4) + 5 + 6 = 3 + (3 + 4) + 11 } \noindent while here we swap two particular quantifiers in a long chain: { # PAT_CONV `\x. !x1 x2 x3 x4 x5. x` (REWR_CONV SWAP_FORALL_THM) `!a b c d e f g h. something`;; Warning: inventing type variables Warning: inventing type variables val it : thm = |- (!a b c d e f g h. something) <=> (!a b c d e g f h. something) } \SEEALSO ABS_CONV, BINDER_CONV, BINOP_CONV, PATH_CONV, RAND_CONV, RATOR_CONV. \ENDDOC hol-light/Help/PINST.doc000066400000000000000000000024611303454263000152240ustar00rootroot00000000000000\DOC PINST \TYPE {PINST : (hol_type * hol_type) list -> (term * term) list -> thm -> thm} \SYNOPSIS Instantiate types and terms in a theorem. \DESCRIBE The call {PINST [ty1,tv1; ...; tyn,tvn] [tm1,v1; ...; tmk,vk] th} instantiates both types and terms in the theorem {th} using the two instantiation lists. The {tyi} should be types, the {tvi} type variables, the {tmi} terms and the {vi} term variables. Note carefully that the {vi} refer to variables in the theorem {{\em before}} type instantiation, but the {tmi} should be replacements for the type-instantiated ones. More explicitly, the behaviour is as follows. First, the type variables in {th} are instantiated according to the list {[ty1,tv1; ...; tyn,tvn]}, exactly as for {INST_TYPE}. Moreover the same type instantiation is applied to the variables in the second list, to give {[tm1,v1'; ...; tmk,vk']}. This is then used to instantiate the already type-instantiated theorem. \FAILURE Fails if the instantiation lists are ill-formed, as with {INST} and {INST_TYPE}, for example if some {tvi} is not a type variable. \EXAMPLE { # let th = MESON[] `(x:A = y) <=> (y = x)`;; ... val th : thm = |- x = y <=> y = x # PINST [`:num`,`:A`] [`2 + 2`,`x:A`; `4`,`y:A`] th;; val it : thm = |- 2 + 2 = 4 <=> 4 = 2 + 2 } \SEEALSO INST, INST_TYPE. \ENDDOC hol-light/Help/POP_ASSUM.doc000066400000000000000000000046001303454263000157320ustar00rootroot00000000000000\DOC POP_ASSUM \TYPE {POP_ASSUM : thm_tactic -> tactic} \SYNOPSIS Applies tactic generated from the first element of a goal's assumption list. \KEYWORDS theorem-tactic, assumption. \DESCRIBE When applied to a theorem-tactic and a goal, {POP_ASSUM} applies the theorem-tactic to the first element of the assumption list, and applies the resulting tactic to the goal without the first assumption in its assumption list: { POP_ASSUM f ({{A1;...;An}} ?- t) = f (... |- A1) ({{A2;...;An}} ?- t) } \FAILURE Fails if the assumption list of the goal is empty, or the theorem-tactic fails when applied to the popped assumption, or if the resulting tactic fails when applied to the goal (with depleted assumption list). \COMMENTS It is possible simply to use the theorem {ASSUME `A1`} as required rather than use {POP_ASSUM}; this will also maintain {A1} in the assumption list, which is generally useful. In addition, this approach can equally well be applied to assumptions other than the first. There are admittedly times when {POP_ASSUM} is convenient, but it is unwise to use it if there is more than one assumption in the assumption list, since this introduces a dependency on the ordering and makes proofs somewhat brittle with respect to changes. Another point to consider is that if the relevant assumption has been obtained by {DISCH_TAC}, it is often cleaner to use {DISCH_THEN} with a theorem-tactic. For example, instead of: { DISCH_TAC THEN POP_ASSUM (fun th -> SUBST1_TAC (SYM th)) } \noindent one might use { DISCH_THEN (SUBST1_TAC o SYM) } \EXAMPLE Starting with the goal: { # g `!f x. 0 = x ==> f(x * f(x)) = f(x)`;; } \noindent and breaking it down: { # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`0 = x`] `f (x * f x) = f x` } \noindent we might use the equation to substitute backwards: { # e(POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[MULT_CLAUSES]);; } \noindent but another alternative would have been: { # e(REWRITE_TAC[MULT_CLAUSES; SYM(ASSUME `0 = x`)]);; } \noindent and we could even have avoided putting the equation in the assumptions at all by from the beginning doing: { # e(REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[MULT_CLAUSES]);; } \USES Making more delicate use of an assumption than rewriting or resolution using it. \SEEALSO ASSUME, ASSUM_LIST, EVERY_ASSUM, POP_ASSUM_LIST, REWRITE_TAC. \ENDDOC hol-light/Help/POP_ASSUM_LIST.doc000066400000000000000000000024261303454263000165710ustar00rootroot00000000000000\DOC POP_ASSUM_LIST \TYPE {POP_ASSUM_LIST : (thm list -> tactic) -> tactic} \SYNOPSIS Generates a tactic from the assumptions, discards the assumptions and applies the tactic. \KEYWORDS theorem-tactic. \DESCRIBE When applied to a function and a goal, {POP_ASSUM_LIST} applies the function to a list of theorems corresponding to the assumptions of the goal, then applies the resulting tactic to the goal with an empty assumption list. { POP_ASSUM_LIST f ({{A1;...;An}} ?- t) = f [.. |- A1; ... ; .. |- An] (?- t) } \FAILURE Fails if the function fails when applied to the list of assumptions, or if the resulting tactic fails when applied to the goal with no assumptions. \COMMENTS There is nothing magical about {POP_ASSUM_LIST}: the same effect can be achieved by using {ASSUME a} explicitly wherever the assumption {a} is used. If {POP_ASSUM_LIST} is used, it is unwise to select elements by number from the {ASSUME}d-assumption list, since this introduces a dependency on ordering. \EXAMPLE We can collect all the assumptions of a goal into a conjunction and make them a new antecedent by: { POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) } \USES Making more delicate use of the assumption list than simply rewriting etc. \SEEALSO ASSUM_LIST, EVERY_ASSUM, POP_ASSUM, REWRITE_TAC. \ENDDOC hol-light/Help/PRENEX_CONV.doc000066400000000000000000000013661303454263000161600ustar00rootroot00000000000000\DOC PRENEX_CONV \TYPE {PRENEX_CONV : conv} \SYNOPSIS Puts a term already in NNF into prenex form. \DESCRIBE When applied to a term already in negation normal form (see {NNF_CONV}, for example), the conversion {PRENEX_CONV} proves it equal to an equivalent in prenex form, with all quantifiers at the top level and a propositional body. \FAILURE Never fails; even on non-Boolean terms it will just produce a reflexive theorem. \EXAMPLE { # PRENEX_CONV `(!x. ?y. P x y) \/ (?u. !v. ?w. Q u v w)`;; Warning: inventing type variables val it : thm = |- (!x. ?y. P x y) \/ (?u. !v. ?w. Q u v w) <=> (!x. ?y u. !v. ?w. P x y \/ Q u v w) } \SEEALSO CNF_CONV, DNF_CONV, NNFC_CONV, NNF_CONV, SKOLEM_CONV, WEAK_CNF_CONV, WEAK_DNF_CONV. \ENDDOC hol-light/Help/PRESIMP_CONV.doc000066400000000000000000000016431303454263000162740ustar00rootroot00000000000000\DOC PRESIMP_CONV \TYPE {PRESIMP_CONV : conv} \SYNOPSIS Applies basic propositional simplifications and some miniscoping. \DESCRIBE The conversion {PRESIMP_CONV} applies various routine simplifications to Boolean terms involving constants, e.g. {p /\ T <=> p}. It also tries to push universal quantifiers through conjunctions and existential quantifiers through disjunctions, e.g. {(?x. p[x] \/ q[x]) <=> (?x. p[x]) \/ (?x. q[x])} (``miniscoping'') but does not transform away other connectives like implication that would allow it do do this more completely. \FAILURE Never fails. \EXAMPLE { # PRESIMP_CONV `?x. x = 1 /\ y = 1 \/ F \/ T /\ y = 2`;; val it : thm = |- (?x. x = 1 /\ y = 1 \/ F \/ T /\ y = 2) <=> (?x. x = 1) /\ y = 1 \/ y = 2 } \USES Useful as an initial simplification before more substantial normal form conversions. \SEEALSO CNF_CONV, DNF_CONV, NNF_CONV, PRENEX_CONV, SKOLEM_CONV. \ENDDOC hol-light/Help/PROP_ATOM_CONV.doc000066400000000000000000000025131303454263000165520ustar00rootroot00000000000000\DOC PROP_ATOM_CONV \TYPE {PROP_ATOM_CONV : conv -> conv} \SYNOPSIS Applies a conversion to the `atomic subformulas' of a formula. \DESCRIBE When applied to a Boolean term, {PROP_ATOM_CONV conv} descends recursively through any number of the core propositional connectives `{~}', `{/\}', `{\/}', `{==>}' and `{<=>}', as well as the quantifiers `{!x. p[x]}', `{?x. p[x]}' and `{?!x. p[x]}'. When it reaches a subterm that can no longer be decomposed into any of those items (e.g. the starting term if it is not of Boolean type), the conversion {conv} is tried, with a reflexive theorem returned in case of failure. That is, the conversion is applied to the ``atomic subformulas'' in the usual sense of first-order logic. \FAILURE Never fails. \EXAMPLE Here we swap all equations in a formula, but not any logical equivalences that are part of its logical structure: { # PROP_ATOM_CONV(ONCE_DEPTH_CONV SYM_CONV) `(!x. x = y ==> x = z) <=> (y = z <=> 1 + z = z + 1)`;; val it : thm = |- ((!x. x = y ==> x = z) <=> y = z <=> 1 + z = z + 1) <=> (!x. y = x ==> z = x) <=> z = y <=> z + 1 = 1 + z } \noindent By contrast, just {ONCE_DEPTH_CONV SYM_CONV} would just swap the top-level logical equivalence. \USES Carefully constraining the application of conversions. \SEEALSO DEPTH_BINOP_CONV, ONCE_DEPTH_CONV. \ENDDOC hol-light/Help/PROVE_HYP.doc000066400000000000000000000021171303454263000157400ustar00rootroot00000000000000\DOC PROVE_HYP \TYPE {PROVE_HYP : thm -> thm -> thm} \SYNOPSIS Eliminates a provable assumption from a theorem. \KEYWORDS rule, assumption. \DESCRIBE When applied to two theorems, {PROVE_HYP} gives a new theorem with the conclusion of the second and the union of the assumption list minus the conclusion of the first theorem. { A1 |- t1 A2 |- t2 ------------------------- PROVE_HYP A1 u (A2 - {{t1}}) |- t2 } If {t1} does not occurr in {A2} then the function simply returns the second theorem {A2 |- t2} unchanged without including the assumptions {A1}. \FAILURE Never fails. \EXAMPLE { # let th1 = CONJUNCT2(ASSUME `p /\ q /\ r`) and th2 = CONJUNCT2(ASSUME `q /\ r`);; val th1 : thm = p /\ q /\ r |- q /\ r val th2 : thm = q /\ r |- r # PROVE_HYP th1 th2;; val it : thm = p /\ q /\ r |- r } \COMMENTS This is sometimes known as the Cut rule. Although it is not necessary for the conclusion of the first theorem to be the same as an assumption of the second, {PROVE_HYP} is otherwise of doubtful value. \SEEALSO DEDUCT_ANTISYM_RULE, DISCH, MP, UNDISCH. \ENDDOC hol-light/Help/PURE_ASM_REWRITE_RULE.doc000066400000000000000000000015251303454263000176320ustar00rootroot00000000000000\DOC PURE_ASM_REWRITE_RULE \TYPE {PURE_ASM_REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem including the theorem's assumptions as rewrites. \KEYWORDS rule. \DESCRIBE The list of theorems supplied by the user and the assumptions of the object theorem are used to generate a set of rewrites, without adding implicitly the basic tautologies stored under {basic_rewrites}. The rule searches for matching subterms in a top-down recursive fashion, stopping only when no more rewrites apply. For a general description of rewriting strategies see {GEN_REWRITE_RULE}. \FAILURE Rewriting with {PURE_ASM_REWRITE_RULE} does not result in failure. It may diverge, in which case {PURE_ONCE_ASM_REWRITE_RULE} may be used. \SEEALSO ASM_REWRITE_RULE, GEN_REWRITE_RULE, ONCE_REWRITE_RULE, PURE_REWRITE_RULE, PURE_ONCE_ASM_REWRITE_RULE. \ENDDOC hol-light/Help/PURE_ASM_REWRITE_TAC.doc000066400000000000000000000016641303454263000174760ustar00rootroot00000000000000\DOC PURE_ASM_REWRITE_TAC \TYPE {PURE_ASM_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal including the goal's assumptions as rewrites. \KEYWORDS tactic. \DESCRIBE {PURE_ASM_REWRITE_TAC} generates a set of rewrites from the supplied theorems and the assumptions of the goal, and applies these in a top-down recursive manner until no match is found. See {GEN_REWRITE_TAC} for more information on the group of rewriting tactics. \FAILURE {PURE_ASM_REWRITE_TAC} does not fail, but it can diverge in certain situations. For limited depth rewriting, see {PURE_ONCE_ASM_REWRITE_TAC}. It can also result in an invalid tactic. \USES To advance or solve a goal when the current assumptions are expected to be useful in reducing the goal. \SEEALSO ASM_REWRITE_TAC, GEN_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC hol-light/Help/PURE_ASM_SIMP_TAC.doc000066400000000000000000000013351303454263000171200ustar00rootroot00000000000000\DOC PURE_ASM_SIMP_TAC \TYPE {PURE_ASM_SIMP_TAC : thm list -> tactic} \SYNOPSIS Perform simplification of goal by conditional contextual rewriting using assumptions. \DESCRIBE A call to {PURE_ASM_SIMP_TAC[theorems]} will apply conditional contextual rewriting with {theorems} and the current assumptions of the goal to the goal's conclusion, but not the default simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of rewriting, see {SIMP_CONV}. If the extra generality of contextual conditional rewriting is not needed, {REWRITE_TAC} is usually more efficient. \FAILURE Never fails, but may loop indefinitely. \SEEALSO ASM_REWRITE_TAC, ASM_SIMP_TAC, SIMP_CONV, SIMP_TAC, REWRITE_TAC. \ENDDOC hol-light/Help/PURE_ONCE_ASM_REWRITE_RULE.doc000066400000000000000000000013161303454263000204340ustar00rootroot00000000000000\DOC PURE_ONCE_ASM_REWRITE_RULE \TYPE {PURE_ONCE_ASM_REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem once, including the theorem's assumptions as rewrites. \KEYWORDS rule. \DESCRIBE {PURE_ONCE_ASM_REWRITE_RULE} excludes the basic tautologies in {basic_rewrites} from the theorems used for rewriting. It searches for matching subterms once only, without recursing over already rewritten subterms. For a general introduction to rewriting tools see {GEN_REWRITE_RULE}. \FAILURE {PURE_ONCE_ASM_REWRITE_RULE} does not fail and does not diverge. \SEEALSO ASM_REWRITE_RULE, GEN_REWRITE_RULE, ONCE_ASM_REWRITE_RULE, ONCE_REWRITE_RULE, PURE_ASM_REWRITE_RULE, PURE_REWRITE_RULE, REWRITE_RULE. \ENDDOC hol-light/Help/PURE_ONCE_ASM_REWRITE_TAC.doc000066400000000000000000000020321303454263000202700ustar00rootroot00000000000000\DOC PURE_ONCE_ASM_REWRITE_TAC \TYPE {PURE_ONCE_ASM_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal once, including the goal's assumptions as rewrites. \KEYWORDS tactic. \DESCRIBE A set of rewrites generated from the assumptions of the goal and the supplied theorems is used to rewrite the term part of the goal, making only one pass over the goal. The basic tautologies are not included as rewrite theorems. The order in which the given theorems are applied is an implementation matter and the user should not depend on any ordering. See {GEN_REWRITE_TAC} for more information on rewriting tactics in general. \FAILURE {PURE_ONCE_ASM_REWRITE_TAC} does not fail and does not diverge. \USES Manipulation of the goal by rewriting with its assumptions, in instances where rewriting with tautologies and recursive rewriting is undesirable. \SEEALSO ASM_REWRITE_TAC, GEN_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC hol-light/Help/PURE_ONCE_REWRITE_CONV.doc000066400000000000000000000012571303454263000177360ustar00rootroot00000000000000\DOC PURE_ONCE_REWRITE_CONV \TYPE {PURE_ONCE_REWRITE_CONV : thm list -> conv} \SYNOPSIS Rewrites a term once with only the given list of rewrites. \KEYWORDS conversion. \DESCRIBE {PURE_ONCE_REWRITE_CONV} generates rewrites from the list of theorems supplied by the user, without including the tautologies given in {basic_rewrites}. The applicable rewrites are employed once, without entailing in a recursive search for matches over the term. See {GEN_REWRITE_CONV} for more details about rewriting strategies in HOL. \FAILURE This rule does not fail, and it does not diverge. \SEEALSO GEN_REWRITE_CONV, ONCE_DEPTH_CONV, ONCE_REWRITE_CONV, PURE_REWRITE_CONV, REWRITE_CONV. \ENDDOC hol-light/Help/PURE_ONCE_REWRITE_RULE.doc000066400000000000000000000013071303454263000177340ustar00rootroot00000000000000\DOC PURE_ONCE_REWRITE_RULE \TYPE {PURE_ONCE_REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem once with only the given list of rewrites. \KEYWORDS rule. \DESCRIBE {PURE_ONCE_REWRITE_RULE} generates rewrites from the list of theorems supplied by the user, without including the tautologies given in {basic_rewrites}. The applicable rewrites are employed once, without entailing in a recursive search for matches over the theorem. See {GEN_REWRITE_RULE} for more details about rewriting strategies in HOL. \FAILURE This rule does not fail, and it does not diverge. \SEEALSO ASM_REWRITE_RULE, GEN_REWRITE_RULE, ONCE_DEPTH_CONV, ONCE_REWRITE_RULE, PURE_REWRITE_RULE, REWRITE_RULE. \ENDDOC hol-light/Help/PURE_ONCE_REWRITE_TAC.doc000066400000000000000000000017541303454263000176020ustar00rootroot00000000000000\DOC PURE_ONCE_REWRITE_TAC \TYPE {PURE_ONCE_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal using a supplied list of theorems, making one rewriting pass over the goal. \KEYWORDS tactic. \DESCRIBE {PURE_ONCE_REWRITE_TAC} generates a set of rewrites from the given list of theorems, and applies them at every match found through searching once over the term part of the goal, without recursing. It does not include the basic tautologies as rewrite theorems. The order in which the rewrites are applied is unspecified. For more information on rewriting tactics see {GEN_REWRITE_TAC}. \FAILURE {PURE_ONCE_REWRITE_TAC} does not fail and does not diverge. \USES This tactic is useful when the built-in tautologies are not required as rewrite equations and recursive rewriting is not desired. \SEEALSO ASM_REWRITE_TAC, GEN_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC hol-light/Help/PURE_REWRITE_CONV.doc000066400000000000000000000014061303454263000171260ustar00rootroot00000000000000\DOC PURE_REWRITE_CONV \TYPE {PURE_REWRITE_CONV : thm list -> conv} \SYNOPSIS Rewrites a term with only the given list of rewrites. \KEYWORDS conversion. \DESCRIBE This conversion provides a method for rewriting a term with the theorems given, and excluding simplification with tautologies in {basic_rewrites}. Matching subterms are found recursively, until no more matches are found. For more details on rewriting see {GEN_REWRITE_CONV}. \USES {PURE_REWRITE_CONV} is useful when the simplifications that arise by rewriting a theorem with {basic_rewrites} are not wanted. \FAILURE Does not fail. May result in divergence, in which case {PURE_ONCE_REWRITE_CONV} can be used. \SEEALSO GEN_REWRITE_CONV, ONCE_REWRITE_CONV, PURE_ONCE_REWRITE_CONV, REWRITE_CONV. \ENDDOC hol-light/Help/PURE_REWRITE_RULE.doc000066400000000000000000000016101303454263000171250ustar00rootroot00000000000000\DOC PURE_REWRITE_RULE \TYPE {PURE_REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem with only the given list of rewrites. \KEYWORDS rule. \DESCRIBE This rule provides a method for rewriting a theorem with the theorems given, and excluding simplification with tautologies in {basic_rewrites}. Matching subterms are found recursively starting from the term in the conclusion part of the theorem, until no more matches are found. For more details on rewriting see {GEN_REWRITE_RULE}. \USES {PURE_REWRITE_RULE} is useful when the simplifications that arise by rewriting a theorem with {basic_rewrites} are not wanted. \FAILURE Does not fail. May result in divergence, in which case {PURE_ONCE_REWRITE_RULE} can be used. \SEEALSO ASM_REWRITE_RULE, GEN_REWRITE_RULE, ONCE_REWRITE_RULE, PURE_ASM_REWRITE_RULE, PURE_ONCE_ASM_REWRITE_RULE, PURE_ONCE_REWRITE_RULE, REWRITE_RULE. \ENDDOC hol-light/Help/PURE_REWRITE_TAC.doc000066400000000000000000000034071303454263000167730ustar00rootroot00000000000000\DOC PURE_REWRITE_TAC \TYPE {PURE_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal with only the given list of rewrites. \KEYWORDS tactic. \DESCRIBE {PURE_REWRITE_TAC} behaves in the same way as {REWRITE_TAC}, but without the effects of the built-in tautologies. The order in which the given theorems are applied is an implementation matter and the user should not depend on any ordering. For more information on rewriting strategies see {GEN_REWRITE_TAC}. \FAILURE {PURE_REWRITE_TAC} does not fail, but it can diverge in certain situations; in such cases {PURE_ONCE_REWRITE_TAC} may be used. \USES This tactic is useful when the built-in tautologies are not required as rewrite equations. It is sometimes useful in making more time-efficient replacements according to equations for which it is clear that no extra reduction via tautology will be needed. (The difference in efficiency is only apparent, however, in quite large examples.) {PURE_REWRITE_TAC} advances goals but solves them less frequently than {REWRITE_TAC}; to be precise, {PURE_REWRITE_TAC} only solves goals which are rewritten to {`T`} (i.e. {TRUTH}) without recourse to any other tautologies. \EXAMPLE It might be necessary, say for subsequent application of an induction hypothesis, to resist reducing a term {`b = T`} to {`b`}. { # g `b <=> T`;; Warning: Free variables in goal: b val it : goalstack = 1 subgoal (1 total) `b <=> T` # e(PURE_REWRITE_TAC[]);; val it : goalstack = 1 subgoal (1 total) `b <=> T` # e(REWRITE_TAC[]);; val it : goalstack = 1 subgoal (1 total) `b` } \SEEALSO ASM_REWRITE_TAC, GEN_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, PURE_ONCE_REWRITE_TAC, REWRITE_TAC, SUBST_ALL_TAC, SUBST1_TAC. \ENDDOC hol-light/Help/PURE_SIMP_CONV.doc000066400000000000000000000013051303454263000165530ustar00rootroot00000000000000\DOC PURE_SIMP_CONV \TYPE {PURE_SIMP_CONV : thm list -> conv} \SYNOPSIS Simplify a term repeatedly by conditional contextual rewriting, not using default simplifications. \DESCRIBE A call {SIMP_CONV thl tm} will return {|- tm = tm'} where {tm'} results from applying the theorems in {thl} as (conditional) rewrite rules. This is similar to {SIMP_CONV}, and the documentation for that contains more details. The {PURE} prefix means that the usual built-in simplifications (see {basic_rewrites} and {basic_convs}) are not applied. \FAILURE Never fails, but may return a reflexive theorem {|- tm = tm} if no simplifications can be made. \SEEALSO PURE_REWRITE_CONV, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/PURE_SIMP_RULE.doc000066400000000000000000000013501303454263000165550ustar00rootroot00000000000000\DOC PURE_SIMP_RULE \TYPE {PURE_SIMP_RULE : thm list -> thm -> thm} \SYNOPSIS Simplify conclusion of a theorem repeatedly by conditional contextual rewriting, not using default simplifications. \DESCRIBE A call {SIMP_CONV thl (|- tm)} will return {|- tm'} where {tm'} results from applying the theorems in {thl} as (conditional) rewrite rules. Howver, the {PURE} prefix indicates that it will not automatically include the usual built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of conditional rewriting, see {SIMP_CONV}. \FAILURE Never fails, but may return the input theorem unchanged if no simplifications were applicable. \SEEALSO ONCE_SIMP_RULE, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/PURE_SIMP_TAC.doc000066400000000000000000000014741303454263000164240ustar00rootroot00000000000000\DOC PURE_SIMP_TAC \TYPE {PURE_SIMP_TAC : thm list -> tactic} \SYNOPSIS Simplify a goal repeatedly by conditional contextual rewriting without default simplifications. \DESCRIBE When applied to a goal {A ?- g}, the tactic {PURE_SIMP_TAC thl} returns a new goal {A ?- g'} where {g'} results from applying the theorems in {thl} as (conditional) rewrite rules. The {PURE} prefix means that it does not apply the built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details, see {SIMP_CONV}. \FAILURE Never fails, though may not change the goal if no simplifications are applicable. \COMMENTS To add the assumptions of the goal to the rewrites, use {PURE_ASM_SIMP_TAC} (or just {ASM PURE_SIMP_TAC}). \SEEALSO ASM, ASM_SIMP_TAC, mk_rewrites, ONCE_SIMP_CONV, REWRITE_TAC, SIMP_CONV, SIMP_RULE. \ENDDOC hol-light/Help/RAND_CONV.doc000066400000000000000000000016721303454263000157030ustar00rootroot00000000000000\DOC RAND_CONV \TYPE {RAND_CONV : conv -> conv} \SYNOPSIS Applies a conversion to the operand of an application. \KEYWORDS conversional. \DESCRIBE If {c} is a conversion that maps a term {`t2`} to the theorem {|- t2 = t2'}, then the conversion {RAND_CONV c} maps applications of the form {`t1 t2`} to theorems of the form: { |- (t1 t2) = (t1 t2') } \noindent That is, {RAND_CONV c `t1 t2`} applies {c} to the operand of the application {`t1 t2`}. \FAILURE {RAND_CONV c tm} fails if {tm} is not an application or if {tm} has the form {`t1 t2`} but the conversion {c} fails when applied to the term {t2}. The function returned by {RAND_CONV c} may also fail if the ML function {c} is not, in fact, a conversion (i.e. a function that maps a term {t} to a theorem {|- t = t'}). \EXAMPLE { # RAND_CONV num_CONV `SUC 2`;; val it : thm = |- SUC 2 = SUC (SUC 1) } \SEEALSO ABS_CONV, COMB_CONV, COMB_CONV2, LAND_CONV, RATOR_CONV, SUB_CONV. \ENDDOC hol-light/Help/RATOR_CONV.doc000066400000000000000000000017341303454263000160450ustar00rootroot00000000000000\DOC RATOR_CONV \TYPE {RATOR_CONV : conv -> conv} \SYNOPSIS Applies a conversion to the operator of an application. \KEYWORDS conversional. \DESCRIBE If {c} is a conversion that maps a term {`t1`} to the theorem {|- t1 = t1'}, then the conversion {RATOR_CONV c} maps applications of the form {`t1 t2`} to theorems of the form: { |- (t1 t2) = (t1' t2) } \noindent That is, {RATOR_CONV c `t1 t2`} applies {c} to the operator of the application {`t1 t2`}. \FAILURE {RATOR_CONV c tm} fails if {tm} is not an application or if {tm} has the form {`t1 t2`} but the conversion {c} fails when applied to the term {t1}. The function returned by {RATOR_CONV c} may also fail if the ML function {c:term->thm} is not, in fact, a conversion (i.e. a function that maps a term {t} to a theorem {|- t = t'}). \EXAMPLE { # RATOR_CONV BETA_CONV `(\x y. x + y) 1 2`;; val it : thm = |- (\x y. x + y) 1 2 = (\y. 1 + y) 2 } \SEEALSO ABS_CONV, COMB_CONV, COMB2_CONV, RAND_CONV, SUB_CONV. \ENDDOC hol-light/Help/REAL_ARITH.doc000066400000000000000000000040111303454263000157720ustar00rootroot00000000000000\DOC REAL_ARITH \TYPE {REAL_ARITH : term -> thm} \SYNOPSIS Attempt to prove term using basic algebra and linear arithmetic over the reals. \DESCRIBE {REAL_ARITH} is the basic tool for proving elementary lemmas about real equations and inequalities. Given a term, it first applies various normalizations, eliminating constructs such as {max}, {min} and {abs} by introducing case splits, splitting over the arms of conditionals and putting any equations and inequalities into a form {p(x) <><> 0} where {<><>} is an equality or inequality function and {p(x)} is in a normal form for polynomials as produced by {REAL_POLY_CONV}. The problem is split into the refutation of various conjunctions of such subformulas. A refutation of each is attempted using simple linear inequality reasoning (essentially Fourier-Motzkin elimination). Note that no non-trivial nonlinear inequality reasoning is performed (see below). \FAILURE Fails if the term is not provable using the algorithm sketched above. \EXAMPLE Here is some simple inequality reasoning, showing how constructs like {abs}, {max} and {min} can be handled: { # REAL_ARITH `abs(x) < min e d / &2 /\ abs(y) < min e d / &2 ==> abs(x + y) < d + e`;; val it : thm = |- abs x < min e d / &2 /\ abs y < min e d / &2 ==> abs (x + y) < d + e } The following example also involves inequality reasoning, but the initial algebraic normalization is critical to make the pieces match up: { # REAL_ARITH `(&1 + x) * (&1 - x) * (&1 + x pow 2) < &1 ==> &0 < x pow 4`;; val it : thm = |- (&1 + x) * (&1 - x) * (&1 + x pow 2) < &1 ==> &0 < x pow 4 } \USES Very convenient for providing elementary lemmas that would otherwise be painful to prove manually. \COMMENTS For nonlinear equational reasoning, use {REAL_RING} or {REAL_FIELD}. For nonlinear inequality reasoning, there are no powerful rules built into HOL Light, but the additional derived rules defined in {Examples/sos.ml} and {Rqe/make.ml} may be useful. \SEEALSO ARITH_TAC, INT_ARITH_TAC, REAL_ARITH_TAC, REAL_FIELD, REAL_RING. \ENDDOC hol-light/Help/REAL_ARITH_TAC.doc000066400000000000000000000031241303454263000164650ustar00rootroot00000000000000\DOC REAL_ARITH_TAC \TYPE {REAL_ARITH_TAC : tactic} \SYNOPSIS Attempt to prove goal using basic algebra and linear arithmetic over the reals. \DESCRIBE The tactic {REAL_ARITH_TAC} is the tactic form of {REAL_ARITH}. Roughly speaking, it will automatically prove any formulas over the reals that are effectively universally quantified and can be proved valid by algebraic normalization and linear equational and inequality reasoning. See {REAL_ARITH} for more information about the algorithm used and its scope. \FAILURE Fails if the goal is not in the subset solvable by these means, or is not valid. \EXAMPLE Here is a goal that holds by virtue of pure algebraic normalization: { # g `(x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2 = ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4 + (x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4) / &6`;; } \noindent and here is one that holds by linear inequality reasoning: { # g `&26 < x / &2 ==> abs(x / &4 + &1) < abs(x / &3)`;; } \noindent so either goal is solved simply by: { # e REAL_ARITH_TAC;; val it : goalstack = No subgoals } \COMMENTS For nonlinear equational reasoning, use {CONV_TAC REAL_RING} or {CONV_TAC REAL_FIELD}. For nonlinear inequality reasoning, there are no powerful rules built into HOL Light, but the additional derived rules defined in {Examples/sos.ml} and {Rqe/make.ml} may be useful. \SEEALSO ARITH_TAC, ASM_REAL_ARITH_TAC, INT_ARITH_TAC, REAL_ARITH, REAL_FIELD, REAL_RING. \ENDDOC hol-light/Help/REAL_FIELD.doc000066400000000000000000000027161303454263000157600ustar00rootroot00000000000000\DOC REAL_FIELD \TYPE {REAL_FIELD : term -> thm} \SYNOPSIS Prove basic `field' facts over the reals. \DESCRIBE Most of the built-in HOL arithmetic decision procedures have limited ability to deal with inversion or division. {REAL_FIELD} is an enhancement of {REAL_RING} that has the same underlying method but first performs various case-splits, reducing a goal involving the inverse {inv(t)} of a term {t} to the cases where {t = 0} where {t * inv(t) = &1}, repeatedly for all such {t}. After subsequently splitting the goal into normal form, {REAL_RING} (for algebraic reasoning) is applied; if this fails then {REAL_ARITH} is also tried, since this allows some {t = 0} cases to be excluded by simple linear reasoning. \FAILURE Fails if the term is not provable using the methods described. \EXAMPLE Here we do some simple algebraic simplification, ruling out the degenerate {x = &0} case using the inequality in the antecedent. { # REAL_FIELD `!x. &0 < x ==> &1 / x - &1 / (x + &1) = &1 / (x * (x + &1))`;; ... val it : thm = |- !x. &0 < x ==> &1 / x - &1 / (x + &1) = &1 / (x * (x + &1)) } \COMMENTS Except for the discharge of conditions using linear reasoning, this rule is essentially equational. For nonlinear inequality reasoning, there are no powerful rules built into HOL Light, but the additional derived rules defined in {Examples/sos.ml} and {Rqe/make.ml} may be useful. \SEEALSO ARITH_TAC, INT_ARITH_TAC, REAL_ARITH, REAL_ARITH_TAC, REAL_RING. \ENDDOC hol-light/Help/REAL_IDEAL_CONV.doc000066400000000000000000000021151303454263000165710ustar00rootroot00000000000000\DOC REAL_IDEAL_CONV \TYPE {REAL_IDEAL_CONV : term list -> term -> thm} \SYNOPSIS Produces identity proving ideal membership over the reals. \DESCRIBE The call {REAL_IDEAL_CONV [`p1`; ...; `pn`] `p`}, where all the terms have type {:real} and can be considered as polynomials, will test whether {p} is in the ideal generated by the {p1,...,pn}. If so, it will return a corresponding theorem {|- p = q1 * p1 + ... + qn * pn} showing how to express {p} in terms of the other polynomials via some `cofactors' {qi}. \FAILURE Fails if the terms are ill-typed, or if ideal membership fails. \EXAMPLE In the case of a singleton list, this just corresponds to dividing one multivariate polynomial by another, e.g. { # REAL_IDEAL_CONV [`x - &1`] `x pow 4 - &1`;; 1 basis elements and 0 critical pairs val it : thm = |- x pow 4 - &1 = (&1 * x pow 3 + &1 * x pow 2 + &1 * x + &1) * (x - &1) } \SEEALSO ideal_cofactors, real_ideal_cofactors, REAL_RING, RING, RING_AND_IDEAL_CONV. \ENDDOC hol-light/Help/REAL_INT_ABS_CONV.doc000066400000000000000000000017731303454263000171030ustar00rootroot00000000000000\DOC REAL_INT_ABS_CONV \TYPE {REAL_INT_ABS_CONV : conv} \SYNOPSIS Conversion to produce absolute value of an integer literal of type {:real}. \DESCRIBE The call {REAL_INT_ABS_CONV `abs c`}, where {c} is an integer literal of type {:real}, returns the theorem {|- abs c = d} where {d} is the canonical integer literal that is equal to {c}'s absolute value. The literal {c} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the negation of one of the permitted forms of integer literal of type {:real}. \EXAMPLE { # REAL_INT_ABS_CONV `abs(-- &42)`;; val it : thm = |- abs (-- &42) = &42 } \COMMENTS The related function {REAL_RAT_ABS_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_ABS_CONV, REAL_RAT_ABS_CONV, REAL_INT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_ADD_CONV.doc000066400000000000000000000017431303454263000170630ustar00rootroot00000000000000\DOC REAL_INT_ADD_CONV \TYPE {REAL_INT_ADD_CONV : conv} \SYNOPSIS Conversion to perform addition on two integer literals of type {:real}. \DESCRIBE The call {REAL_INT_ADD_CONV `c1 + c2`} where {c1} and {c2} are integer literals of type {:real}, returns {|- c1 + c2 = d} where {d} is the canonical integer literal that is equal to {c1 + c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the sum of two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_ADD_CONV `-- &17 + &25`;; val it : thm = |- -- &17 + &25 = &8 } \COMMENTS The related function {REAL_RAT_ADD_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_ADD_CONV, REAL_RAT_ADD_CONV, REAL_INT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_EQ_CONV.doc000066400000000000000000000017461303454263000170030ustar00rootroot00000000000000\DOC REAL_INT_EQ_CONV \TYPE {REAL_INT_EQ_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:real} is equal to another. \DESCRIBE The call {REAL_INT_EQ_CONV `c1 < c2`} where {c1} and {c2} are integer literals of type {:real}, returns whichever of {|- c1 = c2 <=> T} or {|- c1 = c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not an equality comparison on two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_EQ_CONV `&1 = &2`;; val it : thm = |- &1 = &2 <=> F # REAL_INT_EQ_CONV `-- &1 = -- &1`;; val it : thm = |- -- &1 = -- &1 <=> T } \COMMENTS The related function {REAL_RAT_EQ_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_EQ_CONV, REAL_RAT_EQ_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_GE_CONV.doc000066400000000000000000000016461303454263000167700ustar00rootroot00000000000000\DOC REAL_INT_GE_CONV \TYPE {REAL_INT_GE_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:real} is {>=} another. \DESCRIBE The call {REAL_INT_GE_CONV `c1 >= c2`} where {c1} and {c2} are integer literals of type {:real}, returns whichever of {|- c1 >= c2 <=> T} or {|- c1 >= c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_GE_CONV `&7 >= &6`;; val it : thm = |- &7 >= &6 <=> T } \COMMENTS The related function {REAL_RAT_GE_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_GE_CONV, REAL_RAT_GE_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_GT_CONV.doc000066400000000000000000000016401303454263000170010ustar00rootroot00000000000000\DOC REAL_INT_GT_CONV \TYPE {REAL_INT_GT_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:real} is {<} another. \DESCRIBE The call {REAL_INT_GT_CONV `c1 > c2`} where {c1} and {c2} are integer literals of type {:real}, returns whichever of {|- c1 > c2 <=> T} or {|- c1 > c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_GT_CONV `&1 > &2`;; val it : thm = |- &1 > &2 <=> F } \COMMENTS The related function {REAL_RAT_GT_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_GT_CONV, REAL_RAT_GT_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_LE_CONV.doc000066400000000000000000000016521303454263000167720ustar00rootroot00000000000000\DOC REAL_INT_LE_CONV \TYPE {REAL_INT_LE_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:real} is {<=} another. \DESCRIBE The call {REAL_INT_LE_CONV `c1 <= c2`} where {c1} and {c2} are integer literals of type {:real}, returns whichever of {|- c1 <= c2 <=> T} or {|- c1 <= c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_LE_CONV `&11 <= &77`;; val it : thm = |- &11 <= &77 <=> T } \COMMENTS The related function {REAL_RAT_LE_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_LE_CONV, REAL_RAT_LE_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_LT_CONV.doc000066400000000000000000000016521303454263000170110ustar00rootroot00000000000000\DOC REAL_INT_LT_CONV \TYPE {REAL_INT_LT_CONV : conv} \SYNOPSIS Conversion to prove whether one integer literal of type {:real} is {<} another. \DESCRIBE The call {REAL_INT_LT_CONV `c1 < c2`} where {c1} and {c2} are integer literals of type {:real}, returns whichever of {|- c1 < c2 <=> T} or {|- c1 < c2 <=> F} is true. By an integer literal we mean either {&n} or {-- &n} where {n} is a numeral. \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_LT_CONV `-- &18 < &64`;; val it : thm = |- -- &18 < &64 <=> T } \COMMENTS The related function {REAL_RAT_LT_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_LT_CONV, REAL_RAT_LT_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_MUL_CONV.doc000066400000000000000000000017551303454263000171330ustar00rootroot00000000000000\DOC REAL_INT_MUL_CONV \TYPE {REAL_INT_MUL_CONV : conv} \SYNOPSIS Conversion to perform multiplication on two integer literals of type {:real}. \DESCRIBE The call {REAL_INT_MUL_CONV `c1 * c2`} where {c1} and {c2} are integer literals of type {:real}, returns {|- c1 * c2 = d} where {d} is the canonical integer literal that is equal to {c1 * c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the product of two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_MUL_CONV `&6 * -- &9`;; val it : thm = |- &6 * -- &9 = -- &54 } \COMMENTS The related function {REAL_RAT_MUL_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_MUL_CONV, REAL_RAT_MUL_CONV, REAL_INT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_NEG_CONV.doc000066400000000000000000000017501303454263000171020ustar00rootroot00000000000000\DOC REAL_INT_NEG_CONV \TYPE {REAL_INT_NEG_CONV : conv} \SYNOPSIS Conversion to negate an integer literal of type {:real}. \DESCRIBE The call {REAL_INT_NEG_CONV `--c`}, where {c} is an integer literal of type {:real}, returns the theorem {|- --c = d} where {d} is the canonical integer literal that is equal to {c}'s negation. The literal {c} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the negation of one of the permitted forms of integer literal of type {:real}. \EXAMPLE { # REAL_INT_NEG_CONV `-- (-- &3 / &2)`;; val it : thm = |- --(-- &3 / &2) = &3 / &2 } \COMMENTS The related function {REAL_RAT_NEG_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_NEG_CONV, REAL_RAT_NEG_CONV, REAL_INT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_POW_CONV.doc000066400000000000000000000020621303454263000171330ustar00rootroot00000000000000\DOC REAL_INT_POW_CONV \TYPE {REAL_INT_POW_CONV : conv} \SYNOPSIS Conversion to perform exponentiation on a integer literal of type {:real}. \DESCRIBE The call {REAL_INT_POW_CONV `c pow n`} where {c} is an integer literal of type {:real} and {n} is a numeral of type {:num}, returns {|- c pow n = d} where {d} is the canonical integer literal that is equal to {c} raised to the {n}th power. The literal {c} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not a permitted integer literal of type {:real} raised to a numeral power. \EXAMPLE { # REAL_INT_POW_CONV `(-- &2) pow 77`;; val it : thm = |- -- &2 pow 77 = -- &151115727451828646838272 } \COMMENTS The related function {REAL_RAT_POW_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_POW_CONV, REAL_INT_POW_CONV, REAL_INT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_RAT_CONV.doc000066400000000000000000000014371303454263000171210ustar00rootroot00000000000000\DOC REAL_INT_RAT_CONV \TYPE {REAL_INT_RAT_CONV : conv} \SYNOPSIS Convert basic rational constant of real type to canonical form. \DESCRIBE When applied to a term that is a rational constant of type {:real}, {REAL_INT_RAT_CONV} converts it to an explicit ratio {&p / &q} or {-- &p / &q}; {q} is always there, even if it is {1}. \FAILURE Never fails; simply has no effect if it is not applied to a suitable constant. \EXAMPLE { # REAL_INT_RAT_CONV `&22 / &7`;; val it : thm = |- &22 / &7 = &22 / &7 # REAL_INT_RAT_CONV `&42`;; val it : thm = |- &42 = &42 / &1 # REAL_INT_RAT_CONV `#3.1415926`;; val it : thm = |- #3.1415926 = &31415926 / &10000000 } \USES Mainly for internal use as a preprocessing step in rational-number calculations. \SEEALSO REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_REDUCE_CONV.doc000066400000000000000000000024111303454263000174330ustar00rootroot00000000000000\DOC REAL_INT_REDUCE_CONV \TYPE {REAL_INT_REDUCE_CONV : conv} \SYNOPSIS Evaluate subexpressions built up from integer literals of type {:real}, by proof. \DESCRIBE When applied to a term, {REAL_INT_REDUCE_CONV} performs a recursive bottom-up evaluation by proof of subterms built from integer literals of type {:real} using the unary operators `{--}', `{inv}' and `{abs}', and the binary arithmetic (`{+}', `{-}', `{*}', `{/}', `{pow}') and relational (`{<}', `{<=}', `{>}', `{>=}', `{=}') operators, as well as propagating literals through logical operations, e.g. {T /\ x <=> x}, returning a theorem that the original and reduced terms are equal. The permissible integer literals are of the form {&n} or {-- &n} for numeral {n}, nonzero in the negative case. \FAILURE Never fails, but may have no effect. \EXAMPLE { # REAL_INT_REDUCE_CONV `if &5 pow 4 < &4 pow 5 then (&2 pow 3 - &1) pow 2 + &1 else &99`;; val it : thm = |- (if &5 pow 4 < &4 pow 5 then (&2 pow 3 - &1) pow 2 + &1 else &99) = &50 } \COMMENTS The corresponding {INT_REDUCE_CONV} works for the type of integers. The more general function {REAL_RAT_REDUCE_CONV} works similarly over {:real} but for arbitrary rational literals. \SEEALSO NUM_REDUCE_CONV, INT_REDUCE_CONV, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_INT_RED_CONV.doc000066400000000000000000000025631303454263000171060ustar00rootroot00000000000000\DOC REAL_INT_RED_CONV \TYPE {REAL_INT_RED_CONV : term -> thm} \SYNOPSIS Performs one arithmetic or relational operation on integer literals of type {:real}. \DESCRIBE When applied to any of the terms {`--c`}, {`abs c`}, {`c1 + c2`}, {`c1 - c2`}, {`c1 * c2`}, {`c pow n`}, {`c1 <= c2`}, {`c1 < c2`}, {`c1 >= c2`}, {`c1 > c2`}, {`c1 = c2`}, where {c}, {c1} and {c2} are integer literals of type {:real} and {n} is a numeral of type {:num}, {REAL_INT_RED_CONV} returns a theorem asserting the equivalence of the term to a canonical integer (for the arithmetic operators) or a truth-value (for the relational operators). The integer literals are terms of the form {&n} or {-- &n} (with nonzero {n} in the latter case). \FAILURE Fails if applied to an inappropriate term. \USES More convenient for most purposes is {REAL_INT_REDUCE_CONV}, which applies these evaluation conversions recursively at depth, or still more generally {REAL_RAT_REDUCE_CONV} which applies to any rational numbers, not just integers. Still, access to this `one-step' reduction can be handy if you want to add a conversion {conv} for some other operator on real number literals, which you can conveniently incorporate it into {REAL_INT_REDUCE_CONV} with { # let REAL_INT_REDUCE_CONV' = DEPTH_CONV(REAL_INT_RED_CONV ORELSEC conv);; } \SEEALSO INT_RED_CONV, REAL_INT_REDUCE_CONV, REAL_RAT_RED_CONV. \ENDDOC hol-light/Help/REAL_INT_SUB_CONV.doc000066400000000000000000000017531303454263000171250ustar00rootroot00000000000000\DOC REAL_INT_SUB_CONV \TYPE {REAL_INT_SUB_CONV : conv} \SYNOPSIS Conversion to perform subtraction on two integer literals of type {:real}. \DESCRIBE The call {REAL_INT_SUB_CONV `c1 - c2`} where {c1} and {c2} are integer literals of type {:real}, returns {|- c1 - c2 = d} where {d} is the canonical integer literal that is equal to {c1 - c2}. The literals {c1} and {c2} may be of the form {&n} or {-- &n} (with nonzero {n} in the latter case) and the result will be of the same form. \FAILURE Fails if applied to a term that is not the difference of two permitted integer literals of type {:real}. \EXAMPLE { # REAL_INT_SUB_CONV `&33 - &77`;; val it : thm = |- &33 - &77 = -- &44 } \COMMENTS The related function {REAL_RAT_SUB_CONV} subsumes this functionality, also applying to rational literals. Unless the restriction to integers is desired or a tiny efficiency difference matters, it should be used in preference. \SEEALSO INT_SUB_CONV, REAL_RAT_SUB_CONV, REAL_INT_REDUCE_CONV. \ENDDOC hol-light/Help/REAL_LET_IMP.doc000066400000000000000000000014531303454263000162630ustar00rootroot00000000000000\DOC REAL_LET_IMP \TYPE {REAL_LET_IMP : thm -> thm} \SYNOPSIS Perform transitivity chaining for mixed strict/non-strict real number inequality. \DESCRIBE When applied to a theorem {A |- s <= t} where {s} and {t} have type {real}, the rule {REAL_LE_IMP} returns {A |- !x1...xn z. t < z ==> s < z}, where {z} is some variable and the {x1,...,xn} are free variables in {s} and {t}. \FAILURE Fails if applied to a theorem whose conclusion is not of the form {`s <= t`} for some real number terms {s} and {t}. \EXAMPLE { # REAL_LET_IMP (REAL_ARITH `abs(x + y) <= abs(x) + abs(y)`);; val it : thm = |- !x y z. abs x + abs y < z ==> abs (x + y) < z } \USES Can make transitivity chaining in goals easier, e.g. by {FIRST_ASSUM(MATCH_MP_TAC o REAL_LE_IMP)}. \SEEALSO LE_IMP, REAL_ARITH, REAL_LE_IMP. \ENDDOC hol-light/Help/REAL_LE_IMP.doc000066400000000000000000000013771303454263000161440ustar00rootroot00000000000000\DOC REAL_LE_IMP \TYPE {REAL_LE_IMP : thm -> thm} \SYNOPSIS Perform transitivity chaining for non-strict real number inequality. \DESCRIBE When applied to a theorem {A |- s <= t} where {s} and {t} have type {real}, the rule {REAL_LE_IMP} returns {A |- !x1...xn z. t <= z ==> s <= z}, where {z} is some variable and the {x1,...,xn} are free variables in {s} and {t}. \FAILURE Fails if applied to a theorem whose conclusion is not of the form {`s <= t`} for some real number terms {s} and {t}. \EXAMPLE { # REAL_LE_IMP (REAL_ARITH `x:real <= abs(x)`);; val it : thm = |- !x z. abs x <= z ==> x <= z } \USES Can make transitivity chaining in goals easier, e.g. by {FIRST_ASSUM(MATCH_MP_TAC o REAL_LE_IMP)}. \SEEALSO LE_IMP, REAL_ARITH, REAL_LET_IMP. \ENDDOC hol-light/Help/REAL_LINEAR_PROVER.doc000066400000000000000000000043671303454263000172100ustar00rootroot00000000000000\DOC REAL_LINEAR_PROVER \TYPE {REAL_LINEAR_PROVER : (thm list * thm list * thm list -> positivstellensatz -> thm) -> thm list * thm list * thm list -> thm} \SYNOPSIS Refute real equations and inequations by linear reasoning (not intended for general use). \DESCRIBE The {REAL_LINEAR_PROVER} function should be given two arguments. The first is a proof translator that constructs a contradiction from a tuple of three theorem lists using a Positivstellensatz refutation, which is essentially a representation of how to add and multiply equalities or inequalities chosen from the list to reach a trivially false equation or inequality such as {&0 > &0}. The second argument is a triple of theorem lists, respectively a list of equations of the form {A_i |- p_i = &0}, a list of non-strict inequalities of the form {B_j |- q_i >= &0}, and a list of strict inequalities of the form {C_k |- r_k > &0}, with both sides being real in each case. Any theorems not of that form will not lead to an error, but will be ignored and cannot contribute to the proof. The prover attempts to construct a Positivstellensatz refutation by normalization as in {REAL_POLY_CONV} then linear inequality reasoning, and if successful will apply the translator function to this refutation to obtain {D |- F} where all assumptions {D} occurs among the {A_i}, {B_j} or {C_k}. Otherwise, or if the translator itself fails, the call fails. \FAILURE Fails if there is no refutation using linear reasoning or if an improper form inhibits proof for other reasons, or if the translator fails. \USES This is not intended for general use. The core real inequality reasoner {REAL_ARITH} is implemented by: { # let REAL_ARITH = GEN_REAL_ARITH REAL_LINEAR_PROVER;; } In this way, all specifically linear functionality is isolated in {REAL_LINEAR_PROVER}, and the rest of the infrastructure of Positivstellensatz proof translation and initial normalization (including elimination of {abs}, {max}, {min}, conditional expressions etc.) is available for use with more advanced nonlinear provers. Such a prover, based on semidefinite programming and requiring support of an external SDP solver to find Positivstellensatz refutations, can be found in {Examples/sos.ml}. \SEEALSO GEN_REAL_ARITH, REAL_ARITH, REAL_POLY_CONV. \ENDDOC hol-light/Help/REAL_POLY_ADD_CONV.doc000066400000000000000000000023111303454263000172040ustar00rootroot00000000000000\DOC REAL_POLY_ADD_CONV \TYPE {REAL_POLY_ADD_CONV : term -> thm} \SYNOPSIS Adds two real polynomials while retaining canonical form. \DESCRIBE For many purposes it is useful to retain polynomials in a canonical form. For more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function {REAL_POLY_ADD_CONV} is a more delicate conversion that, given a term {p1 + p2} where {p1} and {p2} are real polynomials in normal form, returns a theorem {|- p1 + p2 = p} where {p} is in normal form. \FAILURE Fails if applied to a term that is not the sum of two real terms. If these subterms are not polynomials in normal form, the overall normalization is not guaranteed. \EXAMPLE { # REAL_POLY_ADD_CONV `(x pow 2 + x) + (x pow 2 + -- &1 * x + &1)`;; val it : thm = |- (x pow 2 + x) + x pow 2 + -- &1 * x + &1 = &2 * x pow 2 + &1 } \USES More delicate polynomial operations that simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO REAL_ARITH, REAL_POLY_CONV, REAL_POLY_MUL_CONV, REAL_POLY_NEG_CONV, REAL_POLY_POW_CONV, REAL_POLY_SUB_CONV, REAL_RING. \ENDDOC hol-light/Help/REAL_POLY_CONV.doc000066400000000000000000000045711303454263000165460ustar00rootroot00000000000000\DOC REAL_POLY_CONV \TYPE {REAL_POLY_CONV : term -> thm} \SYNOPSIS Converts a real polynomial into canonical form. \DESCRIBE Given a term of type {:real} that is built up using addition, subtraction, negation, multiplication, and inversion and division of constants, {REAL_POLY_CONV} converts it into a canonical polynomial form and returns a theorem asserting the equivalence of the original and canonical terms. The basic elements need not simply be variables or constants; anything not built up using the operators given above will be considered `atomic' for the purposes of this conversion, for example {inv(x)} where {x} is a variable. The canonical polynomial form is a `multiplied out' sum of products, with the monomials (product terms) ordered according to the canonical OCaml order on terms. In particular, it is just {&0} if the polynomial is identically zero. \FAILURE Never fails, even if the term has the wrong type; in this case it merely returns a reflexive theorem. \EXAMPLE This illustrates how terms are `multiplied out': { # REAL_POLY_CONV `(x + &1) * (x pow 2 + &1) * (x pow 4 + &1)`;; val it : thm = |- (x + &1) * (x pow 2 + &1) * (x pow 4 + &1) = x pow 7 + x pow 6 + x pow 5 + x pow 4 + x pow 3 + x pow 2 + x + &1 } \noindent and the following is an example of how a complicated algebraic identity (due to Liouville?) simplifies to zero. Note that division is permissible because it is only by constants. { # REAL_POLY_CONV `((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) / &6 + ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4) / &6 - (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2`;; val it : thm = |- ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) / &6 + ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4) / &6 - (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2 = &0 } \USES Keeping terms in normal form. For simply proving equalities, {REAL_RING} is more powerful and usually more convenient. \SEEALSO INT_POLY_CONV, REAL_ARITH, REAL_RING, SEMIRING_NORMALIZERS_CONV. \ENDDOC hol-light/Help/REAL_POLY_MUL_CONV.doc000066400000000000000000000023151303454263000172550ustar00rootroot00000000000000\DOC REAL_POLY_MUL_CONV \TYPE {REAL_POLY_MUL_CONV : term -> thm} \SYNOPSIS Multiplies two real polynomials while retaining canonical form. \DESCRIBE For many purposes it is useful to retain polynomials in a canonical form. For more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function {REAL_POLY_MUL_CONV} is a more delicate conversion that, given a term {p1 * p2} where {p1} and {p2} are real polynomials in normal form, returns a theorem {|- p1 * p2 = p} where {p} is in normal form. \FAILURE Fails if applied to a term that is not the product of two real terms. If these subterms are not polynomials in normal form, the overall normalization is not guaranteed. \EXAMPLE { # REAL_POLY_MUL_CONV `(x pow 2 + x) * (x pow 2 + -- &1 * x + &1)`;; val it : thm = |- (x pow 2 + x) * (x pow 2 + -- &1 * x + &1) = x pow 4 + x } \USES More delicate polynomial operations that simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO REAL_ARITH, REAL_POLY_ADD_CONV, REAL_POLY_CONV, REAL_POLY_NEG_CONV, REAL_POLY_POW_CONV, REAL_POLY_SUB_CONV, REAL_RING. \ENDDOC hol-light/Help/REAL_POLY_NEG_CONV.doc000066400000000000000000000022241303454263000172300ustar00rootroot00000000000000\DOC REAL_POLY_NEG_CONV \TYPE {REAL_POLY_NEG_CONV : term -> thm} \SYNOPSIS Negates real polynomial while retaining canonical form. \DESCRIBE For many purposes it is useful to retain polynomials in a canonical form. For more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function {REAL_POLY_NEG_CONV} is a more delicate conversion that, given a term {--p} where {p} is a real polynomial in normal form, returns a theorem {|- --p = p'} where {p'} is in normal form. \FAILURE Fails if applied to a term that is not the negation of a real term. If negation is applied to a polynomial in non-normal form, the overall normalization is not guaranteed. \EXAMPLE { # REAL_POLY_NEG_CONV `--(x pow 2 + -- &1)`;; val it : thm = |- --(x pow 2 + -- &1) = -- &1 * x pow 2 + &1 } \USES More delicate polynomial operations than simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO REAL_ARITH, REAL_POLY_ADD_CONV, REAL_POLY_CONV, REAL_POLY_MUL_CONV, REAL_POLY_POW_CONV, REAL_POLY_SUB_CONV, REAL_RING. \ENDDOC hol-light/Help/REAL_POLY_POW_CONV.doc000066400000000000000000000023301303454263000172620ustar00rootroot00000000000000\DOC REAL_POLY_POW_CONV \TYPE {REAL_POLY_POW_CONV : term -> thm} \SYNOPSIS Raise real polynomial to numeral power while retaining canonical form. \DESCRIBE For many purposes it is useful to retain polynomials in a canonical form. For more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function {REAL_POLY_POW_CONV} is a more delicate conversion that, given a term {p1 pow n} where {p} is a real polynomial in normal form and {n} a numeral, returns a theorem {|- p pow n = p'} where {p'} is in normal form. \FAILURE Fails if applied to a term that is not a real term raised to a numeral power. If the subterm is not a polynomial in normal form, the overall normalization is not guaranteed. \EXAMPLE { # REAL_POLY_POW_CONV `(x + &1) pow 4`;; val it : thm = |- (x + &1) pow 4 = x pow 4 + &4 * x pow 3 + &6 * x pow 2 + &4 * x + &1 } \USES More delicate polynomial operations that simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO REAL_ARITH, REAL_POLY_ADD_CONV, REAL_POLY_CONV, REAL_POLY_MUL_CONV, REAL_POLY_NEG_CONV, REAL_POLY_SUB_CONV, REAL_RING. \ENDDOC hol-light/Help/REAL_POLY_SUB_CONV.doc000066400000000000000000000023221303454263000172470ustar00rootroot00000000000000\DOC REAL_POLY_SUB_CONV \TYPE {REAL_POLY_SUB_CONV : term -> thm} \SYNOPSIS Subtracts two real polynomials while retaining canonical form. \DESCRIBE For many purposes it is useful to retain polynomials in a canonical form. For more information on the usual normal form in HOL Light, see the function {REAL_POLY_CONV}, which converts a polynomial to normal form while proving the equivalence of the original and normalized forms. The function {REAL_POLY_SUB_CONV} is a more delicate conversion that, given a term {p1 - p2} where {p1} and {p2} are real polynomials in normal form, returns a theorem {|- p1 - p2 = p} where {p} is in normal form. \FAILURE Fails if applied to a term that is not the difference of two real terms. If these subterms are not polynomials in normal form, the overall normalization is not guaranteed. \EXAMPLE { # REAL_POLY_SUB_CONV `(x pow 2 + x) - (x pow 2 + -- &1 * x + &1)`;; val it : thm = |- (x pow 2 + x) - (x pow 2 + -- &1 * x + &1) = &2 * x + -- &1 } \USES More delicate polynomial operations that simply the direct normalization with {REAL_POLY_CONV}. \SEEALSO REAL_ARITH, REAL_POLY_SUB_CONV, REAL_POLY_CONV, REAL_POLY_MUL_CONV, REAL_POLY_NEG_CONV, REAL_POLY_POW_CONV, REAL_RING. \ENDDOC hol-light/Help/REAL_RAT_ABS_CONV.doc000066400000000000000000000023641303454263000170740ustar00rootroot00000000000000\DOC REAL_RAT_ABS_CONV \TYPE {REAL_RAT_ABS_CONV : term -> thm} \SYNOPSIS Conversion to produce absolute value of a rational literal of type {:real}. \DESCRIBE The call {REAL_RAT_ABS_CONV `abs c`}, where {c} is a rational literal of type {:real}, returns the theorem {|- abs c = d} where {d} is the canonical rational literal that is equal to {c}'s absolute value. The literal {c} may be an integer literal ({&n} or {-- &n}), a ratio ({&p / &q} or {-- &p / &q}), or a decimal ({#DDD.DDDD} or {#DDD.DDDDeNN}). The returned value {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the absolute value function applied to one of the permitted forms of rational literal of type {:real}. \EXAMPLE { # REAL_RAT_ABS_CONV `abs(-- &3 / &2)`;; val it : thm = |- abs (-- &3 / &2) = &3 / &2 } \SEEALSO REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_ADD_CONV.doc000066400000000000000000000023021303454263000170470ustar00rootroot00000000000000\DOC REAL_RAT_ADD_CONV \TYPE {REAL_RAT_ADD_CONV : conv} \SYNOPSIS Conversion to perform addition on two rational literals of type {:real}. \DESCRIBE The call {REAL_RAT_ADD_CONV `c1 + c2`} where {c1} and {c2} are rational literals of type {:real}, returns {|- c1 + c2 = d} where {d} is the canonical rational literal that is equal to {c1 + c2}. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). The result {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the sum of two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_ADD_CONV `-- &11 / &12 + #0.09`;; val it : thm = |- -- &11 / &12 + #0.09 = -- &62 / &75 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_DIV_CONV.doc000066400000000000000000000023411303454263000171040ustar00rootroot00000000000000\DOC REAL_RAT_DIV_CONV \TYPE {REAL_RAT_DIV_CONV : conv} \SYNOPSIS Conversion to perform division on two rational literals of type {:real}. \DESCRIBE The call {REAL_RAT_DIV_CONV `c1 / c2`} where {c1} and {c2} are rational literals of type {:real}, returns {|- c1 / c2 = d} where {d} is the canonical rational literal that is equal to {c1 / c2}. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). The result {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the quotient of two permitted rational literals of type {:real}, or if the divisor is zero. \EXAMPLE { # REAL_RAT_DIV_CONV `&2000 / (-- &40 / &12)`;; val it : thm = |- &2000 / (-- &40 / &12) = -- &600 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_EQ_CONV.doc000066400000000000000000000021341303454263000167670ustar00rootroot00000000000000\DOC REAL_RAT_EQ_CONV \TYPE {REAL_RAT_EQ_CONV : conv} \SYNOPSIS Conversion to prove whether one rational constant of type {:real} is equal to another. \DESCRIBE The call {REAL_RAT_EQ_CONV `c1 = c2`} where {c1} and {c2} are rational constants of type {:real}, returns whichever of {|- c1 = c2 <=> T} or {|- c1 = c2 <=> F} is true. The constants {c1} and {c2} may be integer constants ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). \FAILURE Fails if applied to a term that is not an equality comparison on two permitted rational constants of type {:real}. \EXAMPLE { # REAL_RAT_EQ_CONV `#0.40 = &2 / &5`;; val it : thm = |- #0.40 = &2 / &5 <=> T # REAL_RAT_EQ_CONV `#3.14 = &22 / &7`;; val it : thm = |- #3.14 = &22 / &7 <=> F } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_GE_CONV.doc000066400000000000000000000020351303454263000167550ustar00rootroot00000000000000\DOC REAL_RAT_GE_CONV \TYPE {REAL_RAT_GE_CONV : conv} \SYNOPSIS Conversion to prove whether one rational literal of type {:real} is {>=} another. \DESCRIBE The call {REAL_RAT_GE_CONV `c1 >= c2`} where {c1} and {c2} are rational literals of type {:real}, returns whichever of {|- c1 >= c2 <=> T} or {|- c1 >= c2 <=> F} is true. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_GE_CONV `#3.1415926 >= &22 / &7`;; val it : thm = |- #3.1415926 >= &22 / &7 <=> F } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_GT_CONV.doc000066400000000000000000000020131303454263000167700ustar00rootroot00000000000000\DOC REAL_RAT_GT_CONV \TYPE {REAL_RAT_GT_CONV : conv} \SYNOPSIS Conversion to prove whether one rational literal of type {:real} is {>} another. \DESCRIBE The call {REAL_RAT_GT_CONV `c1 > c2`} where {c1} and {c2} are rational literals of type {:real}, returns whichever of {|- c1 > c2 <=> T} or {|- c1 > c2 <=> F} is true. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_GT_CONV `&3 / &2 > #1.11`;; val it : thm = |- &3 / &2 > #1.11 <=> T } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_INV_CONV.doc000066400000000000000000000024431303454263000171210ustar00rootroot00000000000000\DOC REAL_RAT_INV_CONV \TYPE {REAL_RAT_INV_CONV : term -> thm} \SYNOPSIS Conversion to invert a rational constant of type {:real}. \DESCRIBE The call {REAL_RAT_INV_CONV `inv c`}, where {c} is a rational constant of type {:real}, returns the theorem {|- inv c = d} where {d} is the canonical rational constant that is equal to {c}'s multiplicative inverse (reciprocal). The constant {c} may be an integer constant ({&n} or {-- &n}), a ratio ({&p / &q} or {-- &p / &q}), or a decimal ({#DDD.DDDD} or {#DDD.DDDDeNN}). The returned value {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the multiplicative inverse function applied to one of the permitted forms of rational constant of type {:real}, or if the constant is zero. \EXAMPLE { # REAL_RAT_INV_CONV `inv(-- &5 / &9)`;; val it : thm = |- inv (-- &5 / &9) = -- &9 / &5 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_LE_CONV.doc000066400000000000000000000020351303454263000167620ustar00rootroot00000000000000\DOC REAL_RAT_LE_CONV \TYPE {REAL_RAT_LE_CONV : conv} \SYNOPSIS Conversion to prove whether one rational literal of type {:real} is {<=} another. \DESCRIBE The call {REAL_RAT_LE_CONV `c1 <= c2`} where {c1} and {c2} are rational literals of type {:real}, returns whichever of {|- c1 <= c2 <=> T} or {|- c1 <= c2 <=> F} is true. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_LE_CONV `#3.1415926 <= &22 / &7`;; val it : thm = |- #3.1415926 <= &22 / &7 <=> T } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_LT_CONV.doc000066400000000000000000000020351303454263000170010ustar00rootroot00000000000000\DOC REAL_RAT_LT_CONV \TYPE {REAL_RAT_LT_CONV : conv} \SYNOPSIS Conversion to prove whether one rational literal of type {:real} is {<} another. \DESCRIBE The call {REAL_RAT_LT_CONV `c1 < c2`} where {c1} and {c2} are rational literals of type {:real}, returns whichever of {|- c1 < c2 <=> T} or {|- c1 < c2 <=> F} is true. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). \FAILURE Fails if applied to a term that is not the appropriate inequality comparison on two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_LT_CONV `#3.1415926 < &355 / &113`;; val it : thm = |- #3.1415926 < &355 / &113 <=> T } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_MAX_CONV.doc000066400000000000000000000023121303454263000171050ustar00rootroot00000000000000\DOC REAL_RAT_MAX_CONV \TYPE {REAL_RAT_MAX_CONV : conv} \SYNOPSIS Conversion to perform addition on two rational literals of type {:real}. \DESCRIBE The call {REAL_RAT_MAX_CONV `max c1 c2`} where {c1} and {c2} are rational literals of type {:real}, returns {|- max c1 c2 = d} where {d} is the canonical rational literal that is equal to {max c1 c2}. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). The result {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the maximum operator applied to two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_MAX_CONV `max (-- &9) (&22 / &7)`;; val it : thm = |- max (-- &9) (&22 / &7) = &22 / &7 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_MIN_CONV.doc000066400000000000000000000023071303454263000171070ustar00rootroot00000000000000\DOC REAL_RAT_MIN_CONV \TYPE {REAL_RAT_MIN_CONV : conv} \SYNOPSIS Conversion to perform addition on two rational literals of type {:real}. \DESCRIBE The call {REAL_RAT_MIN_CONV `min c1 c2`} where {c1} and {c2} are rational literals of type {:real}, returns {|- min c1 c2 = d} where {d} is the canonical rational literal that is equal to {min c1 c2}. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). The result {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the minimum operator applied to two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_MIN_CONV `min (-- &9) (&22 / &7)`;; val it : thm = |- min (-- &9) (&22 / &7) = -- &9 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_MUL_CONV.doc000066400000000000000000000024751303454263000171270ustar00rootroot00000000000000\DOC REAL_RAT_MUL_CONV \TYPE {REAL_RAT_MUL_CONV : conv} \SYNOPSIS Conversion to perform multiplication on two rational literals of type {:real}. \DESCRIBE The call {REAL_RAT_MUL_CONV `c1 * c2`} where {c1} and {c2} are rational literals of type {:real}, returns {|- c1 * c2 = d} where {d} is the canonical rational literal that is equal to {c1 * c2}. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). The result {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the product of two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_MUL_CONV `#3.16227766016837952 * #3.16227766016837952`;; val it : thm = |- #3.16227766016837952 * #3.16227766016837952 = &24414062500000002902889155426649 / &2441406250000000000000000000000 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_LT_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_NEG_CONV.doc000066400000000000000000000022761303454263000171020ustar00rootroot00000000000000\DOC REAL_RAT_NEG_CONV \TYPE {REAL_RAT_NEG_CONV : term -> thm} \SYNOPSIS Conversion to negate a rational literal of type {:real}. \DESCRIBE The call {REAL_RAT_NEG_CONV `--c`}, where {c} is a rational literal of type {:real}, returns the theorem {|- --c = d} where {d} is the canonical rational literal that is equal to {c}'s negation. The literal {c} may be an integer literal ({&n} or {-- &n}), a ratio ({&p / &q} or {-- &p / &q}), or a decimal ({#DDD.DDDD} or {#DDD.DDDDeNN}). The returned value {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the negation of one of the permitted forms of rational literal of type {:real}. \EXAMPLE { # REAL_RAT_NEG_CONV `-- (-- &3 / &2)`;; val it : thm = |- --(-- &3 / &2) = &3 / &2 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_POW_CONV.doc000066400000000000000000000023601303454263000171300ustar00rootroot00000000000000\DOC REAL_RAT_POW_CONV \TYPE {REAL_RAT_POW_CONV : conv} \SYNOPSIS Conversion to perform exponentiation on a rational literal of type {:real}. \DESCRIBE The call {REAL_RAT_POW_CONV `c pow n`} where {c} is a rational literal of type {:real} and {n} is a numeral of type {:num}, returns {|- c pow n = d} where {d} is the canonical rational literal that is equal to {c} raised to the {n}th power. The literal {c} may be an integer literal ({&n} or {-- &n}), a ratios ({&p / &q} or {-- &p / &q}), or a decimal ({#DDD.DDDD} or {#DDD.DDDDeNN}). The result {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not a permitted rational literal of type {:real} raised to a numeral power. \EXAMPLE { # REAL_RAT_POW_CONV `#1.414 pow 2`;; val it : thm = |- #1.414 pow 2 = &1999396 / &1000000 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_REDUCE_CONV.doc000066400000000000000000000030331303454263000174300ustar00rootroot00000000000000\DOC REAL_RAT_REDUCE_CONV \TYPE {REAL_RAT_REDUCE_CONV : conv} \SYNOPSIS Evaluate subexpressions built up from rational literals of type {:real}, by proof. \DESCRIBE When applied to a term, {REAL_RAT_REDUCE_CONV} performs a recursive bottom-up evaluation by proof of subterms built from rational literals of type {:real} using the unary operators `{--}', `{inv}' and `{abs}', and the binary arithmetic (`{+}', `{-}', `{*}', `{/}', `{pow}') and relational (`{<}', `{<=}', `{>}', `{>=}', `{=}') operators, as well as propagating literals through logical operations, e.g. {T /\ x <=> x}, returning a theorem that the original and reduced terms are equal. The permissible rational literals are integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). Any numeric result is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Never fails, but may have no effect. \EXAMPLE { # REAL_RAT_REDUCE_CONV `#3.1415926535 < &355 / &113 /\ &355 / &113 < &3 + &1 / &7`;; val it : thm = |- #3.1415926535 < &355 / &113 /\ &355 / &113 < &3 + &1 / &7 <=> T } \SEEALSO NUM_REDUCE_CONV, REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_RED_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_RED_CONV.doc000066400000000000000000000035001303454263000170720ustar00rootroot00000000000000\DOC REAL_RAT_RED_CONV \TYPE {REAL_RAT_RED_CONV : term -> thm} \SYNOPSIS Performs one arithmetic or relational operation on rational literals of type {:real}. \DESCRIBE When applied to any of the terms {`--c`}, {`inv c`}, {`abs c`}, {`c1 + c2`}, {`c1 - c2`}, {`c1 * c2`}, {`c1 / c2`}, {`c pow n`}, {`c1 <= c2`}, {`c1 < c2`}, {`c1 >= c2`}, {`c1 > c2`}, {`c1 = c2`}, where {c}, {c1} and {c2} are rational literals of type {:real} and {n} is a numeral of type {:num}, {REAL_RAT_RED_CONV} returns a theorem asserting the equivalence of the term to a canonical rational (for the arithmetic operators) or a truth-value (for the relational operators). The permissible rational literals are integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). Any numeric result is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to an inappropriate term, or if {c} is zero in {`inv c`}, or if {c2} is zero in {c1 / c2}. \USES More convenient for most purposes is {REAL_RAT_REDUCE_CONV}, which applies these evaluation conversions recursively at depth. But access to this `one-step' reduction can be handy if you want to add a conversion {conv} for some other operator on real number literals, which you can conveniently incorporate it into {REAL_RAT_REDUCE_CONV} with { # let REAL_RAT_REDUCE_CONV' = DEPTH_CONV(REAL_RAT_RED_CONV ORELSEC conv);; } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_SUB_CONV. \ENDDOC hol-light/Help/REAL_RAT_SUB_CONV.doc000066400000000000000000000023531303454263000171160ustar00rootroot00000000000000\DOC REAL_RAT_SUB_CONV \TYPE {REAL_RAT_SUB_CONV : conv} \SYNOPSIS Conversion to perform subtraction on two rational literals of type {:real}. \DESCRIBE The call {REAL_RAT_SUB_CONV `c1 - c2`} where {c1} and {c2} are rational literals of type {:real}, returns {|- c1 - c2 = d} where {d} is the canonical rational literal that is equal to {c1 - c2}. The literals {c1} and {c2} may be integer literals ({&n} or {-- &n}), ratios ({&p / &q} or {-- &p / &q}), or decimals ({#DDD.DDDD} or {#DDD.DDDDeNN}). The result {d} is always put in the form {&p / &q} or {-- &p / &q} with {q > 1} and {p} and {q} sharing no common factor, or simply {&p} or {-- &p} when that is impossible. \FAILURE Fails if applied to a term that is not the subtraction function applied to two permitted rational literals of type {:real}. \EXAMPLE { # REAL_RAT_SUB_CONV `&355 / &113 - #3.1415926`;; val it : thm = |- &355 / &113 - #3.1415926 = &181 / &565000000 } \SEEALSO REAL_RAT_ABS_CONV, REAL_RAT_ADD_CONV, REAL_RAT_DIV_CONV, REAL_RAT_EQ_CONV, REAL_RAT_GE_CONV, REAL_RAT_GT_CONV, REAL_RAT_INV_CONV, REAL_RAT_LE_CONV, REAL_RAT_LT_CONV, REAL_RAT_MAX_CONV, REAL_RAT_MIN_CONV, REAL_RAT_MUL_CONV, REAL_RAT_NEG_CONV, REAL_RAT_POW_CONV, REAL_RAT_REDUCE_CONV, REAL_RAT_RED_CONV. \ENDDOC hol-light/Help/REAL_RING.doc000066400000000000000000000062301303454263000156670ustar00rootroot00000000000000\DOC REAL_RING \TYPE {REAL_RING : term -> thm} \SYNOPSIS Ring decision procedure instantiated to real numbers. \DESCRIBE The rule {REAL_RING} should be applied to a formula that, after suitable normalization, can be considered a universally quantified Boolean combination of equations and inequations between terms of type {:real}. If that formula holds in all integral domains, {REAL_RING} will prove it. Any ``alien'' atomic formulas that are not real number equations will not contribute to the proof but will not in themselves cause an error. The function is a particular instantiation of {RING}, which is a more generic procedure for ring and semiring structures. \FAILURE Fails if the formula is unprovable by the methods employed. This does not necessarily mean that it is not valid for {:real}, but rather that it is not valid on all integral domains (see below). \EXAMPLE This simple example is based on the inversion of a homographic function (from Gosper's notes on continued fractions): { # REAL_RING `y * (c * x + d) = a * x + b ==> x * (c * y - a) = b - d * y`;; 2 basis elements and 0 critical pairs val it : thm = |- y * (c * x + d) = a * x + b ==> x * (c * y - a) = b - d * y } The following more complicated example verifies a classic Cardano reduction formula for cubic equations: { # REAL_RING `p = (&3 * a1 - a2 pow 2) / &3 /\ q = (&9 * a1 * a2 - &27 * a0 - &2 * a2 pow 3) / &27 /\ z = x - a2 / &3 /\ x * w = w pow 2 - p / &3 /\ ~(p = &0) ==> (z pow 3 + a2 * z pow 2 + a1 * z + a0 = &0 <=> (w pow 3) pow 2 - q * (w pow 3) - p pow 3 / &27 = &0)`;; ... } Note that formulas depending on specific features of the real numbers are not always provable by this generic ring procedure. For example we can prove: { # REAL_RING `s pow 2 = &2 ==> (x pow 4 + &1 = &0 <=> x pow 2 + s * x + &1 = &0 \/ x pow 2 - s * x + &1 = &0)`;; ... } \noindent but not the much simpler real-specific fact: { # REAL_RING `x pow 4 + 1 = &0 ==> F`;; Exception: Failure "tryfind". } To support real-specific nonlinear reasoning, you may like to investigate the experimental decision procedure in {Examples/sos.ml}. For general support for division (fields) see {REAL_FIELD}. \USES Often useful for generating non-trivial algebraic lemmas. Even when it is not capable of solving the whole problem, it can often deal with the most tedious algebraic parts. For example after loading in the definitions of trig functions: { # needs "Library/transc.ml";; } \noindent you may wish to prove a tedious trig identity such as: { # g `(--((&7 * cos x pow 6) * sin x) * &7) / &49 - (--((&5 * cos x pow 4) * sin x) * &5) / &25 * &3 + --((&3 * cos x pow 2) * sin x) + sin x = sin x pow 7`;; } \noindent which can be done by {REAL_RING} together with one simple lemma: { # SIN_CIRCLE;; val it : thm = |- !x. sin x pow 2 + cos x pow 2 = &1 } \noindent as follows: { # e(MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; 2 basis elements and 0 critical pairs val it : goalstack = No subgoals } \SEEALSO ARITH_RULE, ARITH_TAC, INT_RING, NUM_RING, real_ideal_cofactors, REAL_ARITH, REAL_FIELD, RING. \ENDDOC hol-light/Help/RECALL_ACCEPT_TAC.doc000066400000000000000000000015301303454263000167730ustar00rootroot00000000000000\DOC RECALL_ACCEPT_TAC \TYPE {RECALL_ACCEPT_TAC : ('a -> thm) -> 'a -> goal -> goalstate} \SYNOPSIS Delay evaluation of theorem-producing function till needed. \DESCRIBE Given a theorem-producing inference rule {f} and its argument {a}, the tactic {RECALL_ACCEPT_TAC f a} will evaluate {th = f a} and do {ACCEPT_TAC th}, but only when the tactic is applied to a goal. \FAILURE Never fails until subsequently applied to a goal, but then may fail if the theorem-producing function does. \EXAMPLE You might for example do { RECALL_ACCEPT_TAC (EQT_ELIM o NUM_REDUCE_CONV) `16 EXP 53 < 15 EXP 55`;; } \noindent and the call { (EQT_ELIM o NUM_REDUCE_CONV) `16 EXP 53 < 15 EXP 55` } \noindent will be delayed until the tactic is applied. \USES Delaying a time-consuming compound inference rule in a tactic script until it is actually used. \ENDDOC hol-light/Help/REDEPTH_CONV.doc000066400000000000000000000034041303454263000162450ustar00rootroot00000000000000\DOC REDEPTH_CONV \TYPE {REDEPTH_CONV : conv -> conv} \SYNOPSIS Applies a conversion bottom-up to all subterms, retraversing changed ones. \KEYWORDS conversional. \DESCRIBE {REDEPTH_CONV c tm} applies the conversion {c} repeatedly to all subterms of the term {tm} and recursively applies {REDEPTH_CONV c} to each subterm at which {c} succeeds, until there is no subterm remaining for which application of {c} succeeds. More precisely, {REDEPTH_CONV c tm} repeatedly applies the conversion {c} to all the subterms of the term {tm}, including the term {tm} itself. The supplied conversion {c} is applied to the subterms of {tm} in bottom-up order and is applied repeatedly (zero or more times, as is done by {REPEATC}) to each subterm until it fails. If {c} is successfully applied at least once to a subterm, {t} say, then the term into which {t} is transformed is retraversed by applying {REDEPTH_CONV c} to it. \FAILURE {REDEPTH_CONV c tm} never fails but can diverge if the conversion {c} can be applied repeatedly to some subterm of {tm} without failing. \EXAMPLE The following example shows how {REDEPTH_CONV} retraverses subterms: { # REDEPTH_CONV BETA_CONV `(\f x. (f x) + 1) (\y.y) 2`;; val it : thm = |- (\f x. f x + 1) (\y. y) 2 = 2 + 1 } \noindent Here, {BETA_CONV} is first applied successfully to the (beta-redex) subterm: { `(\f x. (f x) + 1) (\y.y)` } \noindent This application reduces this subterm to: { `(\x. ((\y.y) x) + 1)` } \noindent {REDEPTH_CONV BETA_CONV} is then recursively applied to this transformed subterm, eventually reducing it to {`(\x. x + 1)`}. Finally, a beta-reduction of the top-level term, now the simplified beta-redex {`(\x. x + 1) 2`}, produces {`2 + 1`}. \SEEALSO DEPTH_CONV, ONCE_DEPTH_CONV, TOP_DEPTH_CONV, TOP_SWEEP_CONV. \ENDDOC hol-light/Help/REDEPTH_SQCONV.doc000066400000000000000000000010671303454263000165140ustar00rootroot00000000000000\DOC REDEPTH_SQCONV \TYPE {REDEPTH_SQCONV : strategy} \SYNOPSIS Applies simplification bottom-up to all subterms, retraversing changed ones. \DESCRIBE HOL Light's simplification functions (e.g. {SIMP_TAC}) have their traversal algorithm controlled by a ``strategy''. {REDEPTH_SQCONV} is a strategy corresponding to {REDEPTH_CONV} for ordinary conversions: simplification is applied bottom-up to all subterms, retraversing changed ones. \FAILURE Not applicable. \SEEALSO DEPTH_SQCONV, ONCE_DEPTH_SQCONV, REDEPTH_CONV, TOP_DEPTH_SQCONV, TOP_SWEEP_SQCONV. \ENDDOC hol-light/Help/REFL.doc000066400000000000000000000007061303454263000150570ustar00rootroot00000000000000\DOC REFL \TYPE {REFL : term -> thm} \SYNOPSIS Returns theorem expressing reflexivity of equality. \KEYWORDS rule, reflexive, equality. \DESCRIBE {REFL} maps any term {`t`} to the corresponding theorem {|- t = t}. \FAILURE Never fails. \EXAMPLE { # REFL `2`;; val it : thm = |- 2 = 2 # REFL `p:bool`;; val it : thm = |- p <=> p } \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO ALL_CONV, REFL_TAC. \ENDDOC hol-light/Help/REFL_TAC.doc000066400000000000000000000007351303454263000155500ustar00rootroot00000000000000\DOC REFL_TAC \TYPE {REFL_TAC : tactic} \SYNOPSIS Solves a goal that is an equation between alpha-equivalent terms. \KEYWORDS tactic, reflexive, equality, alpha. \DESCRIBE When applied to a goal {A ?- t = t'}, where {t} and {t'} are alpha-equivalent, {REFL_TAC} completely solves it. { A ?- t = t' ============= REFL_TAC } \FAILURE Fails unless the goal is an equation between alpha-equivalent terms. \SEEALSO ACCEPT_TAC, MATCH_ACCEPT_TAC, REWRITE_TAC. \ENDDOC hol-light/Help/REFUTE_THEN.doc000066400000000000000000000026261303454263000161420ustar00rootroot00000000000000\DOC REFUTE_THEN \TYPE {REFUTE_THEN : thm_tactic -> goal -> goalstate} \SYNOPSIS Assume the negation of the goal and apply theorem-tactic to it. \DESCRIBE The tactic {REFUTE_THEN ttac} applied to a goal {g}, assumes the negation of the goal and applies {ttac} to it and a similar goal with a conclusion of {F}. More precisely, if the original goal {A ?- u} is unnegated and {ttac}'s action is { A ?- F ======== ttac (ASSUME `~u`) B ?- v } \noindent then we have { A ?- u ============== REFUTE_THEN ttac B ?- v } For example, if {ttac} is just {ASSUME_TAC}, this corresponds to a classic `proof by contradiction': { A ?- u ================= REFUTE_THEN ASSUME_TAC A u {{~u}} ?- F } Whatever {ttac} may be, if the conclusion {u} of the goal is negated, the effect is the same except that the assumed theorem will not be double-negated, so the effect is the same as {DISCH_THEN}. \FAILURE Never fails unless the underlying theorem-tactic {ttac} does. \USES Classical `proof by contradiction'. \COMMENTS When applied to an unnegated goal, this tactic embodies implicitly the classical principle of `proof by contradiction', but for negated goals the tactic is also intuitionistically valid. \SEEALSO BOOL_CASES_TAC, DISCH_THEN. \ENDDOC hol-light/Help/REMOVE_THEN.doc000066400000000000000000000012371303454263000161420ustar00rootroot00000000000000\DOC REMOVE_THEN \TYPE {REMOVE_THEN : string -> thm_tactic -> tactic} \SYNOPSIS Apply a theorem tactic to named assumption, removing the assumption. \DESCRIBE The tactic {REMOVE_THEN "name" ttac} applies the theorem-tactic {ttac} to the assumption labelled {name} (or the first in the list if there is more than one), removing the assumption from the goal. \FAILURE Fails if there is no assumption of that name or if the theorem-tactic fails when applied to it. \EXAMPLE See {LABEL_TAC} for a relevant example. \USES Using an assumption identified by name that will not be needed again in the proof. \SEEALSO ASSUME, FIND_ASSUM, HYP, LABEL_TAC, USE_THEN. \ENDDOC hol-light/Help/REPEATC.doc000066400000000000000000000017071303454263000154140ustar00rootroot00000000000000\DOC REPEATC \TYPE {REPEATC : conv -> conv} \SYNOPSIS Repeatedly apply a conversion (zero or more times) until it fails. \KEYWORDS conversional. \DESCRIBE If {c} is a conversion effects a transformation of a term {t} to a term {t'}, that is if {c} maps {t} to the theorem {|- t = t`}, then {REPEATC c} is the conversion that repeats this transformation as often as possible. More exactly, if {c} maps the term {`ti`} to {|- ti=t(i+1)} for {i} from {1} to {n}, but fails when applied to the {n+1}th term {`t(n+1)`}, then {REPEATC c `t1`} returns {|- t1 = t(n+1)}. And if {c `t`} fails, them {REPEATC c `t`} returns {|- t = t}. \FAILURE Never fails, but can diverge if the supplied conversion never fails. \EXAMPLE { # BETA_CONV `(\x. (\y. x + y) (x + 1)) 1`;; val it : thm = |- (\x. (\y. x + y) (x + 1)) 1 = (\y. 1 + y) (1 + 1) # REPEATC BETA_CONV `(\x. (\y. x + y) (x + 1)) 1`;; val it : thm = |- (\x. (\y. x + y) (x + 1)) 1 = 1 + 1 + 1 } \ENDDOC hol-light/Help/REPEAT_GTCL.doc000066400000000000000000000015071303454263000161200ustar00rootroot00000000000000\DOC REPEAT_GTCL \TYPE {REPEAT_GTCL : thm_tactical -> thm_tactical} \SYNOPSIS Applies a theorem-tactical until it fails when applied to a goal. \KEYWORDS theorem-tactical. \DESCRIBE When applied to a theorem-tactical, a theorem-tactic, a theorem and a goal: { REPEAT_GTCL ttl ttac th goal } \noindent {REPEAT_GTCL} repeatedly modifies the theorem according to {ttl} till the result of handing it to {ttac} and applying it to the goal fails (this may be no times at all). \FAILURE Fails iff the theorem-tactic fails immediately when applied to the theorem and the goal. \EXAMPLE The following tactic matches {th}'s antecedents against the assumptions of the goal until it can do so no longer, then puts the resolvents onto the assumption list: { REPEAT_GTCL IMP_RES_THEN ASSUME_TAC th } \SEEALSO REPEAT_TCL, THEN_TCL. \ENDDOC hol-light/Help/REPEAT_TCL.doc000066400000000000000000000024421303454263000160100ustar00rootroot00000000000000\DOC REPEAT_TCL \TYPE {REPEAT_TCL : thm_tactical -> thm_tactical} \SYNOPSIS Repeatedly applies a theorem-tactical until it fails when applied to the theorem. \KEYWORDS theorem-tactical. \DESCRIBE When applied to a theorem-tactical, a theorem-tactic and a theorem: { REPEAT_TCL ttl ttac th } \noindent {REPEAT_TCL} repeatedly modifies the theorem according to {ttl} until it fails when given to the theorem-tactic {ttac}. \FAILURE Fails iff the theorem-tactic fails immediately when applied to the theorem. \EXAMPLE It is often desirable to repeat the action of basic theorem-tactics. For example {CHOOSE_THEN} strips off a single existential quantification, so one might use {REPEAT_TCL CHOOSE_THEN} to get rid of them all. Alternatively, one might want to repeatedly break apart a theorem which is a nested conjunction and apply the same theorem-tactic to each conjunct. For example the following goal: { # g `(0 = w /\ 0 = x) /\ 0 = y /\ 0 = z ==> w + x + y + z = 0`;; Warning: Free variables in goal: w, x, y, z val it : goalstack = 1 subgoal (1 total) `(0 = w /\ 0 = x) /\ 0 = y /\ 0 = z ==> w + x + y + z = 0` } \noindent might be solved by { # e(DISCH_THEN (REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN REWRITE_TAC[ADD_CLAUSES]);; } \SEEALSO REPEAT_GTCL, THEN_TCL. \ENDDOC hol-light/Help/REPEAT_UPPERCASE.doc000066400000000000000000000021441303454263000167140ustar00rootroot00000000000000\DOC REPEAT \TYPE {REPEAT : tactic -> tactic} \SYNOPSIS Repeatedly applies a tactic until it fails. \KEYWORDS tactical. \DESCRIBE The tactic {REPEAT t} is a tactic which applies {t} to a goal, and while it succeeds, continues applying it to all subgoals generated. \FAILURE The application of {REPEAT} to a tactic never fails, and neither does the composite tactic, even if the basic tactic fails immediately, unless it raises an exception other that {Failure ...}. \EXAMPLE If we start with a goal having many universal quantifiers: { # g `!w x y z. w < z /\ x < y ==> w * x + 1 <= y * z`;; } \noindent then {GEN_TAC} will strip them off one at a time: { # e GEN_TAC;; val it : goalstack = 1 subgoal (1 total) `!x y z. w < z /\ x < y ==> w * x + 1 <= y * z` } \noindent and {REPEAT GEN_TAC} will strip them off as far as possible: { # e(REPEAT GEN_TAC);; val it : goalstack = 1 subgoal (1 total) `w < z /\ x < y ==> w * x + 1 <= y * z` } Similarly, {REPEAT COND_CASES_TAC} will eliminate all free conditionals in the goal instead of just one. \SEEALSO EVERY, FIRST, ORELSE, THEN, THENL. \ENDDOC hol-light/Help/REPLICATE_TAC.doc000066400000000000000000000011411303454263000163200ustar00rootroot00000000000000\DOC REPLICATE_TAC \TYPE {REPLICATE_TAC : int -> tactic -> tactic} \SYNOPSIS Apply a tactic a specific number of times. \DESCRIBE The call {REPLICATE n tac} gives a new tactic that it equivalent to an {n}-fold repetition of {tac}, i.e. {tac THEN tac THEN ... THEN tac}. \FAILURE The call {REPLICATE n tac} never fails, but when applied to a goal it will fail if the tactic does. \EXAMPLE We might conceivably want to strip off exactly three universal quantifiers from a goal that contains more than three. We can use {REPLICATE_TAC 3 GEN_TAC} to do that. \SEEALSO EVERY, MAP_EVERY, THEN. \ENDDOC hol-light/Help/REWRITES_CONV.doc000066400000000000000000000017201303454263000164150ustar00rootroot00000000000000\DOC REWRITES_CONV \TYPE {REWRITES_CONV : ('a * (term -> 'b)) net -> term -> 'b} \SYNOPSIS Apply a prioritized conversion net to the term at the top level. \DESCRIBE The underlying machinery in rewriting and simplification assembles (conditional) rewrite rules and other conversions into a net, including a priority number so that, for example, pure rewrites get applied before conditional rewrites. If {net} is such a net (for example, constructed using {mk_rewrites} and {net_of_thm}), then {REWRITES_CONV net} is a conversion that uses all those conversions at the toplevel to attempt to rewrite the term. If a conditional rewrite is applied, the resulting theorem will have an assumption. This is the primitive operation that performs HOL Light rewrite steps. \FAILURE Fails when applied to the term if none of the conversions in the net are applicable. \SEEALSO GENERAL_REWRITE_CONV, GEN_REWRITE_CONV, mk_rewrites, net_of_conv, net_of_thm, REWRITE_CONV. \ENDDOC hol-light/Help/REWRITE_CONV.doc000066400000000000000000000031471303454263000162770ustar00rootroot00000000000000\DOC REWRITE_CONV \TYPE {REWRITE_CONV : thm list -> conv} \SYNOPSIS Rewrites a term including built-in tautologies in the list of rewrites. \KEYWORDS conversion. \DESCRIBE Rewriting a term using {REWRITE_CONV} utilizes as rewrites two sets of theorems: the tautologies in the ML list {basic_rewrites} and the ones supplied by the user. The rule searches top-down and recursively for subterms which match the left-hand side of any of the possible rewrites, until none of the transformations are applicable. There is no ordering specified among the set of rewrites. Variants of this conversion allow changes in the set of equations used: {PURE_REWRITE_CONV} and others in its family do not rewrite with the theorems in {basic_rewrites}. The top-down recursive search for matches may not be desirable, as this may increase the number of inferences being made or may result in divergence. In this case other rewriting tools such as {ONCE_REWRITE_CONV} and {GEN_REWRITE_CONV} can be used, or the set of theorems given may be reduced. See {GEN_REWRITE_CONV} for the general strategy for simplifying theorems in HOL using equational theorems. \FAILURE Does not fail, but may diverge if the sequence of rewrites is non-terminating. \USES Used to manipulate terms by rewriting them with theorems. While resulting in high degree of automation, {REWRITE_CONV} can spawn a large number of inference steps. Thus, variants such as {PURE_REWRITE_CONV}, or other rules such as {SUBS_CONV}, may be used instead to improve efficiency. \SEEALSO basic_rewrites, GEN_REWRITE_CONV, ONCE_REWRITE_CONV, PURE_REWRITE_CONV, REWR_CONV, SUBS_CONV. \ENDDOC hol-light/Help/REWRITE_RULE.doc000066400000000000000000000034411303454263000162760ustar00rootroot00000000000000\DOC REWRITE_RULE \TYPE {REWRITE_RULE : thm list -> thm -> thm} \SYNOPSIS Rewrites a theorem including built-in tautologies in the list of rewrites. \KEYWORDS rule. \DESCRIBE Rewriting a theorem using {REWRITE_RULE} utilizes as rewrites two sets of theorems: the tautologies in the ML list {basic_rewrites} and the ones supplied by the user. The rule searches top-down and recursively for subterms which match the left-hand side of any of the possible rewrites, until none of the transformations are applicable. There is no ordering specified among the set of rewrites. Variants of this rule allow changes in the set of equations used: {PURE_REWRITE_RULE} and others in its family do not rewrite with the theorems in {basic_rewrites}. Rules such as {ASM_REWRITE_RULE} add the assumptions of the object theorem (or a specified subset of these assumptions) to the set of possible rewrites. The top-down recursive search for matches may not be desirable, as this may increase the number of inferences being made or may result in divergence. In this case other rewriting tools such as {ONCE_REWRITE_RULE} and {GEN_REWRITE_RULE} can be used, or the set of theorems given may be reduced. See {GEN_REWRITE_RULE} for the general strategy for simplifying theorems in HOL using equational theorems. \FAILURE Does not fail, but may diverge if the sequence of rewrites is non-terminating. \USES Used to manipulate theorems by rewriting them with other theorems. While resulting in high degree of automation, {REWRITE_RULE} can spawn a large number of inference steps. Thus, variants such as {PURE_REWRITE_RULE}, or other rules such as {SUBST}, may be used instead to improve efficiency. \SEEALSO ASM_REWRITE_RULE, basic_rewrites, GEN_REWRITE_RULE, ONCE_REWRITE_RULE, PURE_REWRITE_RULE, REWR_CONV, REWRITE_CONV, SUBST. \ENDDOC hol-light/Help/REWRITE_TAC.doc000066400000000000000000000072211303454263000161360ustar00rootroot00000000000000\DOC REWRITE_TAC \TYPE {REWRITE_TAC : thm list -> tactic} \SYNOPSIS Rewrites a goal including built-in tautologies in the list of rewrites. \KEYWORDS tactic. \DESCRIBE Rewriting tactics in HOL provide a recursive left-to-right matching and rewriting facility that automatically decomposes subgoals and justifies segments of proof in which equational theorems are used, singly or collectively. These include the unfolding of definitions, and the substitution of equals for equals. Rewriting is used either to advance or to complete the decomposition of subgoals. {REWRITE_TAC} transforms (or solves) a goal by using as rewrite rules (i.e. as left-to-right replacement rules) the conclusions of the given list of (equational) theorems, as well as a set of built-in theorems (common tautologies) held in the ML variable {basic_rewrites}. Recognition of a tautology often terminates the subgoaling process (i.e. solves the goal). The equational rewrites generated are applied recursively and to arbitrary depth, with matching and instantiation of variables and type variables. A list of rewrites can set off an infinite rewriting process, and it is not, of course, decidable in general whether a rewrite set has that property. The order in which the rewrite theorems are applied is unspecified, and the user should not depend on any ordering. See {GEN_REWRITE_TAC} for more details on the rewriting process. Variants of {REWRITE_TAC} allow the use of a different set of rewrites. Some of them, such as {PURE_REWRITE_TAC}, exclude the basic tautologies from the possible transformations. {ASM_REWRITE_TAC} and others include the assumptions at the goal in the set of possible rewrites. Still other tactics allow greater control over the search for rewritable subterms. Several of them such as {ONCE_REWRITE_TAC} do not apply rewrites recursively. {GEN_REWRITE_TAC} allows a rewrite to be applied at a particular subterm. \FAILURE {REWRITE_TAC} does not fail. Certain sets of rewriting theorems on certain goals may cause a non-terminating sequence of rewrites. Divergent rewriting behaviour results from a term {t} being immediately or eventually rewritten to a term containing {t} as a sub-term. The exact behaviour depends on the {HOL} implementation; it may be possible (unfortunately) to fall into Lisp in this event. \EXAMPLE The arithmetic theorem {GT}, {|- !n m. m > n <=> n < m}, is used below to advance a goal: { # g `4 < 5`;; val it : goalstack = 1 subgoal (1 total) `4 < 5` # e(REWRITE_TAC[GT]);; val it : goalstack = 1 subgoal (1 total) `4 < 5` } \noindent It is used below with the theorem {LT_0}, {|- !n. 0 < SUC n}, to solve a goal: { # g `SUC n > 0`;; Warning: Free variables in goal: n val it : goalstack = 1 subgoal (1 total) `SUC n > 0` # e(REWRITE_TAC[GT; LT_0]);; val it : goalstack = No subgoals } \USES Rewriting is a powerful and general mechanism in HOL, and an important part of many proofs. It relieves the user of the burden of directing and justifying a large number of minor proof steps. {REWRITE_TAC} fits a forward proof sequence smoothly into the general goal-oriented framework. That is, (within one subgoaling step) it produces and justifies certain forward inferences, none of which are necessarily on a direct path to the desired goal. {REWRITE_TAC} may be more powerful a tactic than is needed in certain situations; if efficiency is at stake, alternatives might be considered. \SEEALSO ASM_REWRITE_TAC, GEN_REWRITE_TAC, IMP_REWRITE_TAC, ONCE_ASM_REWRITE_TAC, ONCE_REWRITE_TAC, PURE_ASM_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, PURE_ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWR_CONV, REWRITE_CONV, SUBST_ALL_TAC, SUBST1_TAC, TARGET_REWRITE_TAC. \ENDDOC hol-light/Help/REWR_CONV.doc000066400000000000000000000132001303454263000157240ustar00rootroot00000000000000\DOC REWR_CONV \TYPE {REWR_CONV : thm -> term -> thm} \SYNOPSIS Uses an instance of a given equation to rewrite a term. \KEYWORDS conversion. \DESCRIBE {REWR_CONV} is one of the basic building blocks for the implementation of rewriting in the HOL system. In particular, the term replacement or rewriting done by all the built-in rewriting rules and tactics is ultimately done by applications of {REWR_CONV} to appropriate subterms. The description given here for {REWR_CONV} may therefore be taken as a specification of the atomic action of replacing equals by equals that is used in all these higher level rewriting tools. The first argument to {REWR_CONV} is expected to be an equational theorem which is to be used as a left-to-right rewrite rule. The general form of this theorem is: { A |- t[x1,...,xn] = u[x1,...,xn] } \noindent where {x1}, ..., {xn} are all the variables that occur free in the left-hand side of the conclusion of the theorem but do not occur free in the assumptions. Any of these variables may also be universally quantified at the outermost level of the equation, as for example in: { A |- !x1...xn. t[x1,...,xn] = u[x1,...,xn] } \noindent Note that {REWR_CONV} will also work, but will give a generally undesirable result (see below), if the right-hand side of the equation contains free variables that do not also occur free on the left-hand side, as for example in: { A |- t[x1,...,xn] = u[x1,...,xn,y1,...,ym] } \noindent where the variables {y1}, ..., {ym} do not occur free in {t[x1,...,xn]}. If {th} is an equational theorem of the kind shown above, then {REWR_CONV th} returns a conversion that maps terms of the form {t[e1,...,en/x1,...,xn]}, in which the terms {e1}, ..., {en} are free for {x1}, ..., {xn} in {t}, to theorems of the form: { A |- t[e1,...,en/x1,...,xn] = u[e1,...,en/x1,...,xn] } \noindent That is, {REWR_CONV th tm} attempts to match the left-hand side of the rewrite rule {th} to the term {tm}. If such a match is possible, then {REWR_CONV} returns the corresponding substitution instance of {th}. If {REWR_CONV} is given a theorem {th}: { A |- t[x1,...,xn] = u[x1,...,xn,y1,...,ym] } \noindent where the variables {y1}, ..., {ym} do not occur free in the left-hand side, then the result of applying the conversion {REWR_CONV th} to a term {t[e1,...,en/x1,...,xn]} will be: { A |- t[e1,...,en/x1,...,xn] = u[e1,...,en,v1,...,vm/x1,...,xn,y1,...,ym] } \noindent where {v1}, ..., {vm} are variables chosen so as to be free nowhere in {th} or in the input term. The user has no control over the choice of the variables {v1}, ..., {vm}, and the variables actually chosen may well be inconvenient for other purposes. This situation is, however, relatively rare; in most equations the free variables on the right-hand side are a subset of the free variables on the left-hand side. In addition to doing substitution for free variables in the supplied equational theorem (or `rewrite rule'), {REWR_CONV th tm} also does type instantiation, if this is necessary in order to match the left-hand side of the given rewrite rule {th} to the term argument {tm}. If, for example, {th} is the theorem: { A |- t[x1,...,xn] = u[x1,...,xn] } \noindent and the input term {tm} is (a substitution instance of) an instance of {t[x1,...,xn]} in which the types {ty1}, ..., {tyi} are substituted for the type variables {vty1}, ..., {vtyi}, that is if: { tm = t[ty1,...,tyn/vty1,...,vtyn][e1,...,en/x1,...,xn] } \noindent then {REWR_CONV th tm} returns: { A |- (t = u)[ty1,...,tyn/vty1,...,vtyn][e1,...,en/x1,...,xn] } \noindent Note that, in this case, the type variables {vty1}, ..., {vtyi} must not occur anywhere in the hypotheses {A}. Otherwise, the conversion will fail. \FAILURE {REWR_CONV th} fails if {th} is not an equation or an equation universally quantified at the outermost level. If {th} is such an equation: { th = A |- !v1....vi. t[x1,...,xn] = u[x1,...,xn,y1,...,yn] } \noindent then {REWR_CONV th tm} fails unless the term {tm} is alpha-equivalent to an instance of the left-hand side {t[x1,...,xn]} which can be obtained by instantiation of free type variables (i.e. type variables not occurring in the assumptions {A}) and substitution for the free variables {x1}, ..., {xn}. \EXAMPLE The following example illustrates a straightforward use of {REWR_CONV}. The supplied rewrite rule is polymorphic, and both substitution for free variables and type instantiation may take place. {EQ_SYM_EQ} is the theorem: { |- !x y:A. x = y <=> y = x } \noindent and {REWR_CONV EQ_SYM} behaves as follows: { # REWR_CONV EQ_SYM_EQ `1 = 2`;; val it : thm = |- 1 = 2 <=> 2 = 1 # REWR_CONV EQ_SYM_EQ `1 < 2`;; Exception: Failure "term_pmatch". } \noindent The second application fails because the left-hand side {`x = y`} of the rewrite rule does not match the term to be rewritten, namely {`1 < 2`}. In the following example, one might expect the result to be the theorem {A |- f 2 = 2}, where {A} is the assumption of the supplied rewrite rule: { # REWR_CONV (ASSUME `!x:A. f x = x`) `f 2:num`;; Exception: Failure "term_pmatch: can't instantiate local constant". } \noindent The application fails, however, because the type variable {A} appears in the assumption of the theorem returned by {ASSUME `!x:A. f x = x`}. Failure will also occur in situations like: { # REWR_CONV (ASSUME `f (n:num) = n`) `f 2:num`;; Exception: Failure "term_pmatch: can't instantiate local constant". } \noindent where the left-hand side of the supplied equation contains a free variable (in this case {n}) which is also free in the assumptions, but which must be instantiated in order to match the input term. \SEEALSO IMP_REWR_CONV, ORDERED_REWR_CONV, REWRITE_CONV. \ENDDOC hol-light/Help/RIGHT_BETAS.doc000066400000000000000000000013111303454263000161130ustar00rootroot00000000000000\DOC RIGHT_BETAS \TYPE {RIGHT_BETAS : term list -> thm -> thm} \SYNOPSIS Apply and beta-reduce equational theorem with abstraction on RHS. \DESCRIBE Given a list of arguments {[`a1`; ...; `an`]} and a theorem of the form {A |- f = \x1 ... xn. t[x1,...xn]}, the rule {RIGHT_BETAS} returns {A |- f a1 ... an = t[a1,...,an]}. That is, it applies the theorem to the list of arguments and beta-reduces the right-hand side. \FAILURE Fails if the argument types are wrong or the RHS has too few abstractions. \EXAMPLE { # RIGHT_BETAS [`x:num`; `y:num`] (ASSUME `f = \a b c. a + b + c + 1`);; val it : thm = f = (\a b c. a + b + c + 1) |- f x y = (\c. x + y + c + 1) } \SEEALSO BETA_CONV, BETAS_CONV. \ENDDOC hol-light/Help/RING.doc000066400000000000000000000077651303454263000151020ustar00rootroot00000000000000\DOC RING \TYPE {RING : (term -> num) * (num -> term) * conv * term * term * term * term * term * term * term * thm * thm * (term -> thm) -> term -> thm} \SYNOPSIS Generic ring procedure. \DESCRIBE The {RING} function takes a number of arguments specifying a ring structure and giving operations for computing and proving over it. Specifically the call is: { RING(toterm,tonum,EQ_CONV, neg,add,sub,inv,mul,div,pow, INTEGRAL_TH,FIELD_TH,POLY_CONV) } \noindent where {toterm} is a conversion from constant terms in the structure to rational numbers (e.g. {rat_of_term} for the reals), {tonum} is the opposite (e.g. {term_of_rat} for the reals), {EQ_CONV} is an equality test conversion (e.g. {REAL_RAT_EQ_CONV}), {neg} is negation, {add} is addition, {sub} is subtraction, {inv} is multiplicative inverse, {div} is division, {pow} is power, {INTEGRAL_TH} is an integrality theorem and {FIELD_TH} is a field theorem (see below) and {POLY_CONV} is a polynomial normalization theorem for the structure as returned by {SEMIRING_NORMALIZERS_CONV} (e.g. {REAL_POLY_CONV} for the reals). The integrality theorem essentially states that if a product is zero, so is one of the factors (i.e. the structure is an integral domain), but this is stated in an unnatural way to allow application to structures without negation. It is permissible in this case to use boolean variables instead of operators such as negation and subtraction. The precise form of the theorem (notation for natural numbers, but this is supposed to be over the same structure): { |- (!x. 0 * x = 0) /\ (!x y z. x + y = x + z <=> y = z) /\ (!w x y z. w * y + x * z = w * z + x * y <=> w = x \/ y = z) } The field theorem is of the following form. It is not logically necessary, and if the structure is not a field you can just pass in {TRUTH} instead. However, it is usually beneficial for performance to include it. { |- !x y. ~(x = y) <=> ?z. (x - y) * z = 1 } It returns a proof procedure that will attempt to prove a formula that, after suitable normalization, can be considered a universally quantified Boolean combination of equations and inequations between terms of the right type. If that formula holds in all integral domains, it will prove it. Any ``alien'' atomic formulas that are not natural number equations will not contribute to the proof. \FAILURE Fails if the theorems are malformed. \EXAMPLE The instantiation for the real numbers (in fact this is already available under the name {REAL_RING}) could be coded as: { let REAL_RING = let REAL_INTEGRAL = prove (`(!x. &0 * x = &0) /\ (!x y z. (x + y = x + z) <=> (y = z)) /\ (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM REAL_ENTIRE] THEN REAL_ARITH_TAC) and REAL_INVERSE = prove (`!x y:real. ~(x = y) <=> ?z. (x - y) * z = &1`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_SUB_0] THEN MESON_TAC[REAL_MUL_RINV; REAL_MUL_LZERO; REAL_ARITH `~(&1 = &0)`]) in RING(rat_of_term,term_of_rat,REAL_RAT_EQ_CONV, `(--):real->real`,`(+):real->real->real`,`(-):real->real->real`, `(inv):real->real`,`(*):real->real->real`,`(/):real->real->real`, `(pow):real->num->real`, REAL_INTEGRAL,REAL_INVERSE,REAL_POLY_CONV);; } \noindent after which, for example, we can verify a reduction for cubic equations to quadratics entirely automatically: { # REAL_RING `p = (&3 * a1 - a2 pow 2) / &3 /\ q = (&9 * a1 * a2 - &27 * a0 - &2 * a2 pow 3) / &27 /\ z = x - a2 / &3 /\ x * w = w pow 2 - p / &3 /\ ~(p = &0) ==> (z pow 3 + a2 * z pow 2 + a1 * z + a0 = &0 <=> (w pow 3) pow 2 - q * (w pow 3) - p pow 3 / &27 = &0)`;; } \SEEALSO ideal_cofactors, NUM_RING, REAL_FIELD, REAL_RING, real_ideal_cofactors, RING_AND_IDEAL_CONV. \ENDDOC hol-light/Help/RING_AND_IDEAL_CONV.doc000066400000000000000000000014711303454263000172730ustar00rootroot00000000000000\DOC RING_AND_IDEAL_CONV \TYPE {RING_AND_IDEAL_CONV : (term -> num) * (num -> term) * conv * term * term * term * term * term * term * term * thm * (term -> thm) -> (term -> thm) * (term list -> term -> term list)} \SYNOPSIS Returns a pair giving a ring proof procedure and an ideal membership routine. \DESCRIBE This function combines the functionality of {RING} and {ideal_cofactors}. Each of these requires the same rather lengthy input. When you want to apply both to the same set of parameters, you can do so using {RING_AND_IDEAL_CONV}. That is: { RING_AND_IDEAL_CONV parms } \noindent is functionally equivalent to: { RING parms,ideal_cofactors parms } For more information, see the documentation for those two functions. \FAILURE Fails if the parameters are wrong. \SEEALSO ideal_cofactors, RING. \ENDDOC hol-light/Help/RULE_ASSUM_TAC.doc000066400000000000000000000014451303454263000165360ustar00rootroot00000000000000\DOC RULE_ASSUM_TAC \TYPE {RULE_ASSUM_TAC : (thm -> thm) -> tactic} \SYNOPSIS Maps an inference rule over the assumptions of a goal. \KEYWORDS tactic, assumption, rule. \DESCRIBE When applied to an inference rule {f} and a goal {({{A1;...;An}} ?- t)}, the {RULE_ASSUM_TAC} tactical applies the inference rule to each of the assumptions to give a new goal. { {{A1,...,An}} ?- t ==================================== RULE_ASSUM_TAC f {{f(.. |- A1),...,f(.. |- An)}} ?- t } \FAILURE The application of {RULE_ASSUM_TAC f} to a goal fails iff {f} fails when applied to any of the assumptions of the goal. \COMMENTS It does not matter if the goal has no assumptions, but in this case {RULE_ASSUM_TAC} has no effect. \SEEALSO ASSUM_LIST, MAP_EVERY, MAP_FIRST, POP_ASSUM_LIST. \ENDDOC hol-light/Help/SELECT_CONV.doc000066400000000000000000000027061303454263000161350ustar00rootroot00000000000000\DOC SELECT_CONV \TYPE {SELECT_CONV : term -> thm} \SYNOPSIS Eliminates an epsilon term by introducing an existential quantifier. \KEYWORDS conversion, epsilon. \DESCRIBE The conversion {SELECT_CONV} expects a boolean term of the form {`P[@x.P[x]/x]`}, which asserts that the epsilon term {@x.P[x]} denotes a value, {x} say, for which {P[x]} holds. This assertion is equivalent to saying that there exists such a value, and {SELECT_CONV} applied to a term of this form returns the theorem {|- P[@x.P[x]/x] = ?x. P[x]}. \FAILURE Fails if applied to a term that is not of the form {`P[@x.P[x]/x]`}. \EXAMPLE { # SELECT_CONV `(@n. n < m) < m`;; val it : thm = |- (@n. n < m) < m <=> (?n. n < m) } \USES Particularly useful in conjunction with {CONV_TAC} for proving properties of values denoted by epsilon terms. For example, suppose that one wishes to prove the goal { # g `!m. 0 < m ==> (@n. n < m) < SUC m`;; } \noindent We start off: { # e(REPEAT STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE `!m n. m < n ==> m < SUC n`));; val it : goalstack = 1 subgoal (1 total) 0 [`0 < m`] `(@n. n < m) < m` } \noindent This is now in the correct form for using {SELECT_CONV}: { # e(CONV_TAC SELECT_CONV);; val it : goalstack = 1 subgoal (1 total) 0 [`0 < m`] `?n. n < m` } \noindent and the resulting subgoal is straightforward to prove, e.g. by {ASM_MESON_TAC[]} or {EXISTS_TAC `0` THEN ASM_REWRITE_TAC[]}. \SEEALSO SELECT_ELIM, SELECT_RULE. \ENDDOC hol-light/Help/SELECT_ELIM_TAC.doc000066400000000000000000000024251303454263000166030ustar00rootroot00000000000000\DOC SELECT_ELIM_TAC \TYPE {SELECT_ELIM_TAC : tactic} \SYNOPSIS Eliminate select terms from a goal. \DESCRIBE The tactic {SELECT_ELIM_TAC} attempts to remove from a goal any select terms, i.e. instances of the Hilbert choice operator {@x. P[x]}. First, any instances that occur inside their own predicate, i.e. {P[@x. P[x]]}, are replaced simply by {?x. P[x]}, as with {SELECT_CONV}. Other select-terms are eliminated by replacing each on with a new variable {v} and adding a corresponding instance of the axiom {SELECT_AX}, of the form {!x. P[x] ==> P[v]}. Note that the latter does not strictly preserve logical equivalence, only implication. So it is possible to replace a provable goal by an unprovable one. But since not much is provable about a select term except via the axiom {SELECT_AX}, this is not likely in practice. \FAILURE Never fails. \EXAMPLE Suppose we set the goal: { # g `(@n. n < 3) < 3 /\ (@n. n < 3) < 5`;; } \noindent An application of {SELECT_ELIM_TAC} returns: { # e SELECT_ELIM_TAC;; val it : goalstack = 1 subgoal (1 total) `!_73133. (!x. x < 3 ==> _73133 < 3) ==> (?n. n < 3) /\ _73133 < 5` } \USES This is already applied as an initial normalization by {MESON} and other rules. Users may occasionally find it helpful. \SEEALSO SELECT_CONV. \ENDDOC hol-light/Help/SELECT_RULE.doc000066400000000000000000000020321303454263000161270ustar00rootroot00000000000000\DOC SELECT_RULE \TYPE {SELECT_RULE : thm -> thm} \SYNOPSIS Introduces an epsilon term in place of an existential quantifier. \KEYWORDS rule, epsilon. \DESCRIBE The inference rule {SELECT_RULE} expects a theorem asserting the existence of a value {x} such that {P} holds. The equivalent assertion that the epsilon term {@x.P} denotes a value of {x} for which {P} holds is returned as a theorem. { A |- ?x. P ------------------ SELECT_RULE A |- P[(@x.P)/x] } \FAILURE Fails if applied to a theorem the conclusion of which is not existentially quantified. \EXAMPLE The axiom {INFINITY_AX} in the theory {ind} is of the form: { |- ?f. ONE_ONE f /\ ~ONTO f } \noindent Applying {SELECT_RULE} to this theorem returns the following. { # SELECT_RULE INFINITY_AX;; val it : thm = |- ONE_ONE (@f. ONE_ONE f /\ ~ONTO f) /\ ~ONTO (@f. ONE_ONE f /\ ~ONTO f) } \USES May be used to introduce an epsilon term to permit rewriting with a constant defined using the epsilon operator. \SEEALSO CHOOSE, SELECT_AX, SELECT_CONV. \ENDDOC hol-light/Help/SEMIRING_NORMALIZERS_CONV.doc000066400000000000000000000102161303454263000202530ustar00rootroot00000000000000\DOC SEMIRING_NORMALIZERS_CONV \TYPE {SEMIRING_NORMALIZERS_CONV : thm -> thm -> (term -> bool) * conv * conv * conv -> (term -> term -> bool) -> (term -> thm) * (term -> thm) * (term -> thm) * (term -> thm) * (term -> thm) * (term -> thm)} \SYNOPSIS Produces normalizer functions over a ring or even a semiring. \DESCRIBE The function {SEMIRING_NORMALIZERS_CONV} should be given two theorems about some binary operators that we write as infix `{+}', `{*}' and `{^}' and ground terms `{ZERO}' and `{ONE}'. (The conventional symbols make the import of the theorem easier to grasp, but they are essentially arbitrary.) The first theorem is of the following form, essentially stating that the operators form a semiring structure with `{^}' as the ``power'' operator: { |- (!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. ZERO + x = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x y. x * y = y * x) /\ (!x. ONE * x = x) /\ (!x. ZERO * x = ZERO) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x. x^0 = ONE) /\ (!x n. x^(SUC n) = x * x^n) } The second theorem may just be {TRUTH = |- T}, in which case it will be assumed that the structure is just a semiring. Otherwise, it may be of the following form for ``negation'' ({neg}) and ``subtraction'' functions, plus a ground term {MINUS1} thought of as {-1}: { |- (!x. neg x = MINUS1 * x) /\ (!x y. x - y = x + MINUS1 * y) } If the second theorem is provided, the eventual normalizer will also handle the negation and subtraction operations. Generally this is beneficial, but is impossible on structures like {:num} with no negative numbers. The remaining arguments are a tuple. The first is an ordering on terms, used to determine the polynomial form. Normally, the default OCaml ordering is fine. The rest are intended to be functions for operating on `constants' (e.g. numerals), which should handle at least `{ZERO}', `{ONE}' and, in the case of a ring, `{MINUS1}'. The functions are: (i) a test for membership in the set of `constants', (ii) an addition conversion on constants, (iii) a multiplication conversion on constants, and (iv) a conversion to raise a constant to a numeral power. Note that no subtraction or negation operations are needed explicitly because this is subsumed in the presence of {-1} as a constant. The function then returns conversions for putting terms of the structure into a canonical form, essentially multiplied-out polynomials with a particular ordering. The functions respectively negate, add, subtract, multiply, exponentiate terms already in the canonical form, putting the result back in canonical form. The final return value is an overall normalization function. \FAILURE Fails if the theorems are malformed. \EXAMPLE There are already instantiations of the main normalizer for natural numbers ({NUM_NORMALIZE_CONV}) and real numbers ({REAL_POLY_CONV}). Here is how the latter is first constructed (it is later enhanced to handle some additional functions more effectively, so use the inbuilt definition, not this one): { # let REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_SUB_CONV, REAL_POLY_MUL_CONV,REAL_POLY_POW_CONV,REAL_POLY_CONV = SEMIRING_NORMALIZERS_CONV REAL_POLY_CLAUSES REAL_POLY_NEG_CLAUSES (is_ratconst, REAL_RAT_ADD_CONV,REAL_RAT_MUL_CONV,REAL_RAT_POW_CONV) (<);; val ( REAL_POLY_NEG_CONV ) : term -> thm = val ( REAL_POLY_ADD_CONV ) : term -> thm = val ( REAL_POLY_SUB_CONV ) : term -> thm = val ( REAL_POLY_MUL_CONV ) : term -> thm = val ( REAL_POLY_POW_CONV ) : term -> thm = val ( REAL_POLY_CONV ) : term -> thm = } For examples of the resulting main function in action, see {REAL_POLY_CONV}. \USES This is a highly generic function, intended only for occasional use by experts. Users reasoning in any sort of ring structure may find it a useful building-block for a decision procedure. \COMMENTS This is a subcomponent of more powerful generic decision procedures such as {RING}. These can handle more sophisticated reasoning that direct equality through normalization. \SEEALSO ideal_cofactors, NUM_NORMALIZE_CONV, REAL_POLY_CONV, RING_AND_IDEAL_CONV. \ENDDOC hol-light/Help/SEQ_IMP_REWRITE_TAC.doc000066400000000000000000000042321303454263000173520ustar00rootroot00000000000000\DOC SEQ_IMP_REWRITE_TAC \TYPE {SEQ_IMP_REWRITE_TAC : thm list -> tactic} \SYNOPSIS Performs sequential implicational rewriting, adding new assumptions if necessary. \DESCRIBE This tactic is closely related to {IMP_REWRITE_TAC} but uses the provided theorems sequentially instead of simultaneously: given a list of theorems {[th_1;...;th_k]}, the tactic call {SEQ_IMP_REWRITE_TAC [th_1;...;th_k]} applies as many implicational rewriting as it can with {th_1}, then with {th_2}, etc. When {th_k} is reached, start over from {th_1}. Repeat till no more rewrite can be achieved. \FAILURE Fails if no rewrite can be achieved. If the usual behavior of leaving the goal unchanged is desired, one can wrap the coal in {TRY_TAC}. \EXAMPLE This uses the basic {IMP_REWRITE_TAC}: { # g `!a b c. a < b ==> (a - b) / (a - b) * c = c`;; val it : goalstack = 1 subgoal (1 total) `!a b c. a < b ==> (a - b) / (a - b) * c = c` # e(IMP_REWRITE_TAC[REAL_DIV_REFL;REAL_MUL_LID;REAL_SUB_0; REAL_LT_IMP_NE]);; val it : goalstack = 1 subgoal (1 total) `!a b. ~(a < b)` } But with {SEQ_IMP_REWRITE_TAC}, the same sequence of theorems solves the goal: { # e(SEQ_IMP_REWRITE_TAC[REAL_DIV_REFL;REAL_MUL_LID;REAL_SUB_0; REAL_LT_IMP_NE]);; val it : goalstack = No subgoals } \USES This addresses a problem which happens already with {REWRITE_TAC} or {SIMP_TAC}: one generally rewrites with one theorem, then with another, etc. and, in the end, once every step is done, (s)he packs everything in a list and provides this list to {IMP_REWRITE_TAC}; but it then happens that some surprises happen at this point because the simultaneous use of all theorems does not yield the same result as their subsequent use. A usual solution is simply to decompose the call into two calls by identifying manually which theorems are the source of the unexpected behavior when used together. Or one can simply use {SEQ_IMP_REWRITE_TAC}. Note that this is however a lot slower than {IMP_REWRITE_TAC}. The user may prefer to first use {IMP_REWRITE_TAC} and if it does not work like the sequential use of single implicational rewrites then use {SEQ_IMP_REWRITE_TAC}. \SEEALSO IMP_REWRITE_TAC, REWRITE_TAC, SIMP_TAC. \ENDDOC hol-light/Help/SET_RULE.doc000066400000000000000000000015061303454263000156100ustar00rootroot00000000000000\DOC SET_RULE \TYPE {SET_RULE : term -> thm} \SYNOPSIS Attempt to prove elementary set-theoretic lemma. \DESCRIBE The function {SET_RULE} is a crude automated prover for set-theoretic facts. When applied to a term, it expands various set-theoretic definitions explicitly and then attempts to solve the result using {MESON}. \FAILURE Fails if the simple translation does not suffice, or the resulting goal is too deep for {MESON}. \EXAMPLE { # SET_RULE `{{x | ~(x IN s <=> x IN t)}} = (s DIFF t) UNION (t DIFF s)`;; ... val it : thm = |- {{x | ~(x IN s <=> x IN t)}} = s DIFF t UNION t DIFF s # SET_RULE `UNIONS {{t y | y IN x INSERT s}} = t x UNION UNIONS {{t y | y IN s}}`;; val it : thm = |- UNIONS {{t y | y IN x INSERT s}} = t x UNION UNIONS {{t y | y IN s}} } \SEEALSO MESON, MESON_TAC[], SET_TAC. \ENDDOC hol-light/Help/SET_TAC.doc000066400000000000000000000015171303454263000154520ustar00rootroot00000000000000\DOC SET_TAC \TYPE {SET_TAC : thm list -> tactic} \SYNOPSIS Attempt to prove goal using basic set-theoretic reasoning. \DESCRIBE When applied to a goal and a list of lemmas to use, the tactic {SET_TAC} puts the lemmas into the goal as antecedents, expands various set-theoretic definitions explicitly and then attempts to solve the result using {MESON}. It does not by default use the assumption list of the goal, but this can be done using {ASM SET_TAC} in place of plain {SET_TAC}. \FAILURE Fails if the simple translation does not suffice, or the resulting goal is too deep for {MESON}. \EXAMPLE Given the following goal: { # g `!s. (UNIONS s = {{}}) <=> !t. t IN s ==> t = {{}}`;; } \noindent the following solves it: { # e(SET_TAC[]);; ... val it : goalstack = No subgoals } \SEEALSO ASM, MESON, MESON_TAC, SET_RULE. \ENDDOC hol-light/Help/SIMPLE_CHOOSE.doc000066400000000000000000000015571303454263000163650ustar00rootroot00000000000000\DOC SIMPLE_CHOOSE \TYPE {SIMPLE_CHOOSE : term -> thm -> thm} \SYNOPSIS Existentially quantifies a hypothesis of a theorem. \DESCRIBE A call {SIMPLE_CHOOSE `v` th} existentially quantifies a hypothesis of the theorem over the variable {v}. It is intended for use when there is only one hypothesis so that the choice of assumption is unambiguous. In general, it picks the one that happens to be first in the list. \FAILURE Fails if {v} is not a variable or if it is free in the conclusion of the theorem {th}. \EXAMPLE { # let th = SYM(ASSUME `x:num = y`);; val th : thm = x = y |- y = x # SIMPLE_EXISTS `x:num` th;; val it : thm = x = y |- ?x. y = x # SIMPLE_CHOOSE `x:num` it;; val it : thm = ?x. x = y |- ?x. y = x } \COMMENTS The more general function is {CHOOSE}, but this is simpler in the special case. \SEEALSO CHOOSE, EXISTS, SIMPLE_EXISTS. \ENDDOC hol-light/Help/SIMPLE_DISJ_CASES.doc000066400000000000000000000022401303454263000170420ustar00rootroot00000000000000\DOC SIMPLE_DISJ_CASES \TYPE {SIMPLE_DISJ_CASES : thm -> thm -> thm} \SYNOPSIS Disjoins hypotheses of two theorems with same conclusion. \DESCRIBE The rule {SIMPLE_DISJ_CASES} takes two `case' theorems with alpha-equivalent conclusions and returns a theorem with the first hypotheses disjoined: { A u {{p}} |- r B u {{q}} |- r ----------------------------------------- SIMPLE_DISJ_CASES (A - {{p}}) u (B - {{q}}) u {{p \/ q}} |- r } To avoid dependency on the order of the hypotheses, it is only recommended when each theorem has exactly one hypothesis: { {{p}} |- r {{q}} |- r ---------------------------- SIMPLE_DISJ_CASES {{p \/ q}} |- r } For more sophisticated or-elimination, use {DISJ_CASES}. \FAILURE Fails if the conclusions of the theorems are not alpha-equivalent. \EXAMPLE { # let [th1; th2] = map (UNDISCH o TAUT) [`~p ==> p ==> q`; `q ==> p ==> q`];; ... val th1 : thm = ~p |- p ==> q val th2 : thm = q |- p ==> q # SIMPLE_DISJ_CASES th1 th2;; val it : thm = ~p \/ q |- p ==> q } \SEEALSO DISJ_CASES, DISJ_CASES_TAC, DISJ_CASES_THEN, DISJ_CASES_THEN2, DISJ1, DISJ2. \ENDDOC hol-light/Help/SIMPLE_EXISTS.doc000066400000000000000000000014121303454263000164120ustar00rootroot00000000000000\DOC SIMPLE_EXISTS \TYPE {SIMPLE_EXISTS : term -> thm -> thm} \SYNOPSIS Introduces an existential quantifier over a variable in a theorem. \DESCRIBE When applied to a pair consisting of a variable {v} and a theorem {|- p}, {SIMPLE_EXISTS} returns the theorem {|- ?v. p}. It is not compulsory for {v} to appear free in {p}, but otherwise the quantification is vacuous. \FAILURE Fails only if {v} is not a variable. \EXAMPLE { # SIMPLE_EXISTS `x:num` (REFL `x:num`);; val it : thm = |- ?x. x = x } \COMMENTS The {EXISTS} function is more general: it can introduce an existentially quantified variable to replace chosen instances of any term in the theorem. However, {SIMPLE_EXISTS} is easier to use when the simple case is needed. \SEEALSO CHOOSE, EXISTS. \ENDDOC hol-light/Help/SIMPLIFY_CONV.doc000066400000000000000000000015701303454263000164100ustar00rootroot00000000000000\DOC SIMPLIFY_CONV \TYPE {SIMPLIFY_CONV : simpset -> thm list -> conv} \SYNOPSIS General simplification at depth with arbitrary simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset'. Given a simpset {ss} and an additional list of theorems {thl} to be used as (conditional or unconditional) rewrite rules, {SIMPLIFY_CONV ss thl} gives a simplification conversion with a repeated top-down traversal strategy ({TOP_DEPTH_SQCONV}) and a nesting limit of 3 for the recursive solution of subconditions by further simplification. \FAILURE Never fails. \USES Usually some other interface to the simplifier is more convenient, but you may want to use this to employ a customized simpset. \SEEALSO GEN_SIMPLIFY_CONV, ONCE_SIMPLIFY_CONV, SIMP_CONV, SIMP_RULE, SIMP_TAC, TOP_DEPTH_SQCONV. \ENDDOC hol-light/Help/SIMP_CONV.doc000066400000000000000000000042611303454263000157240ustar00rootroot00000000000000\DOC SIMP_CONV \TYPE {SIMP_CONV : thm list -> conv} \SYNOPSIS Simplify a term repeatedly by conditional contextual rewriting. \DESCRIBE A call {SIMP_CONV thl tm} will return {|- tm = tm'} where {tm'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as built-in simplifications (see {basic_rewrites} and {basic_convs}). The theorems are first split up into individual rewrite rules, either conditional ({|- c ==> l = r}) or unconditional ({|- l = r}), as described in the documentation for {mk_rewrites}. These are then applied repeatedly to replace subterms in the goal that are instances {l'} of the left-hand side with a corresponding {r'}. Rewrite rules that are permutative, with each side an instance of the other, have an ordering imposed on them so that they tend to force terms into canonical form rather than looping (see {ORDERED_REWR_CONV}). In the case of applying a conditional rewrite, the condition {c} needs to be eliminated before the rewrite can be applied. This is attempted by recursively applying the same simplifications to {c} in the hope of reducing it to {T}. If this can be done, the conditional rewrite is applied, otherwise not. To add additional provers to dispose of side-conditions beyond application of the basic rewrites, see {mk_prover} and {ss_of_provers}. \FAILURE Never fails, but may return a reflexive theorem {|- tm = tm} if no simplifications can be made. \EXAMPLE Here we use the conditional and contextual facilities: { # SIMP_CONV[SUB_ADD; ARITH_RULE `0 < n ==> 1 <= n`] `0 < n ==> (n - 1) + 1 = n + f(k + 1)`;; val it : thm = |- 0 < n ==> n - 1 + 1 = n + f (k + 1) <=> 0 < n ==> n = n + f (k + 1) } \noindent and here we show how a permutative rewrite achieves normalization (the same would work with plain {REWRITE_CONV}: { # REWRITE_CONV[ADD_AC] `(a + c + e) + ((b + a + d) + e):num`;; val it : thm = |- (a + c + e) + (b + a + d) + e = a + a + b + c + d + e + e } \COMMENTS For simply rewriting with unconditional equations, {REWRITE_CONV} and relatives are simpler and more efficient. \SEEALSO ASM_SIMP_TAC, ONCE_SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/SIMP_RULE.doc000066400000000000000000000011461303454263000157250ustar00rootroot00000000000000\DOC SIMP_RULE \TYPE {SIMP_RULE : thm list -> thm -> thm} \SYNOPSIS Simplify conclusion of a theorem repeatedly by conditional contextual rewriting. \DESCRIBE A call {SIMP_CONV thl (|- tm)} will return {|- tm'} where {tm'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details on this kind of conditional rewriting, see {SIMP_CONV}. \FAILURE Never fails, but may return the input theorem unchanged if no simplifications were applicable. \SEEALSO ONCE_SIMP_RULE, SIMP_CONV, SIMP_TAC. \ENDDOC hol-light/Help/SIMP_TAC.doc000066400000000000000000000013761303454263000155720ustar00rootroot00000000000000\DOC SIMP_TAC \TYPE {SIMP_TAC : thm list -> tactic} \SYNOPSIS Simplify a goal repeatedly by conditional contextual rewriting. \DESCRIBE When applied to a goal {A ?- g}, the tactic {SIMP_TAC thl} returns a new goal {A ?- g'} where {g'} results from applying the theorems in {thl} as (conditional) rewrite rules, as well as built-in simplifications (see {basic_rewrites} and {basic_convs}). For more details, see {SIMP_CONV}. \FAILURE Never fails, though may not change the goal if no simplifications are applicable. \COMMENTS To add the assumptions of the goal to the rewrites, use {ASM_SIMP_TAC} (or just {ASM SIMP_TAC}). \SEEALSO ASM, ASM_SIMP_TAC, IMP_REWRITE_TAC, mk_rewrites, ONCE_SIMP_CONV, REWRITE_TAC, SIMP_CONV, SIMP_RULE, TARGET_REWRITE_TAC. \ENDDOC hol-light/Help/SKOLEM_CONV.doc000066400000000000000000000026371303454263000161530ustar00rootroot00000000000000\DOC SKOLEM_CONV \TYPE {SKOLEM_CONV : conv} \SYNOPSIS Completely Skolemize a term already in negation normal form. \DESCRIBE Skolemization amounts to rewriting with the equivalence { # SKOLEM_THM;; val it : thm = |- !P. (!x. ?y. P x y) <=> (?y. !x. P x (y x)) } The conversion {SKOLEM_CONV} will apply this transformation and pull out quantifiers to give a form with all existential quantifiers pulled to the outside. However, it assumes that the input is in negation normal form, i.e. built up by conjunction and disjunction from possibly negated atomic formulas. \FAILURE Never fails. \EXAMPLE Here is a simple example: { # SKOLEM_CONV `(!x. ?y. P x y) \/ (?u. !v. ?z. P (f u v) z)`;; Warning: inventing type variables val it : thm = |- (!x. ?y. P x y) \/ (?u. !v. ?z. P (f u v) z) <=> (?y u z. (!x. P x (y x)) \/ (!v. P (f u v) (z v))) } However, note that it doesn't work properly when the input involves implication, and hence is not in NNF: { # SKOLEM_CONV `(!x. ?y. P x y) ==> (?u. !v. ?z. P (f u v) z)`;; Warning: inventing type variables val it : thm = |- (!x. ?y. P x y) ==> (?u. !v. ?z. P (f u v) z) <=> (?y. !x. P x (y x)) ==> (?u z. !v. P (f u v) (z v)) } \USES A useful component in decision procedures, to simplify the class of formulas that need to be considered. Used internally in several such procedures like {MESON_TAC}. \SEEALSO NNF_CONV, NNFC_CONV, PRENEX_CONV. \ENDDOC hol-light/Help/SPEC.doc000066400000000000000000000023011303454263000150520ustar00rootroot00000000000000\DOC SPEC \TYPE {SPEC : term -> thm -> thm} \SYNOPSIS Specializes the conclusion of a theorem. \KEYWORDS rule. \DESCRIBE When applied to a term {u} and a theorem {A |- !x. t}, then {SPEC} returns the theorem {A |- t[u/x]}. If necessary, variables will be renamed prior to the specialization to ensure that {u} is free for {x} in {t}, that is, no variables free in {u} become bound after substitution. { A |- !x. t -------------- SPEC `u` A |- t[u/x] } \FAILURE Fails if the theorem's conclusion is not universally quantified, or if {x} and {u} have different types. \EXAMPLE The following example shows how {SPEC} renames bound variables if necessary, prior to substitution: a straightforward substitution would result in the clearly invalid theorem {|- ~y ==> (!y. y ==> ~y)}. { # let xv = `x:bool` and yv = `y:bool` in (GEN xv o DISCH xv o GEN yv o DISCH yv) (ASSUME xv);; val it : thm = |- !x. x ==> (!y. y ==> x) # SPEC `~y` it;; val it : thm = |- ~y ==> (!y'. y' ==> ~y) } \COMMENTS In order to specialize variables while also instantiating types of polymorphic variables, use {ISPEC} instead. \SEEALSO GEN, GENL, GEN_ALL, ISPEC, ISPECL, SPECL, SPEC_ALL, SPEC_VAR. \ENDDOC hol-light/Help/SPECL.doc000066400000000000000000000026161303454263000151770ustar00rootroot00000000000000\DOC SPECL \TYPE {SPECL : term list -> thm -> thm} \SYNOPSIS Specializes zero or more variables in the conclusion of a theorem. \KEYWORDS rule. \DESCRIBE When applied to a term list {[u1;...;un]} and a theorem {A |- !x1...xn. t}, the inference rule {SPECL} returns the theorem {A |- t[u1/x1]...[un/xn]}, where the substitutions are made sequentially left-to-right in the same way as for {SPEC}, with the same sort of alpha-conversions applied to {t} if necessary to ensure that no variables which are free in {ui} become bound after substitution. { A |- !x1...xn. t -------------------------- SPECL [`u1`;...;`un`] A |- t[u1/x1]...[un/xn] } \noindent It is permissible for the term-list to be empty, in which case the application of {SPECL} has no effect. \FAILURE Fails unless each of the terms is of the same as that of the appropriate quantified variable in the original theorem. \EXAMPLE The following is a specialization of a theorem from theory {arithmetic}. { # let t = ARITH_RULE `!m n p q. m <= p /\ n <= q ==> (m + n) <= (p + q)`;; val t : thm = |- !m n p q. m <= p /\ n <= q ==> m + n <= p + q # SPECL [`1`; `2`; `3`; `4`] t;; val it : thm = |- 1 <= 3 /\ 2 <= 4 ==> 1 + 2 <= 3 + 4 } \COMMENTS In order to specialize variables while also instantiating types of polymorphic variables, use {ISPECL} instead. \SEEALSO GEN, GENL, GEN_ALL, GEN_TAC, SPEC, SPEC_ALL, SPEC_TAC. \ENDDOC hol-light/Help/SPEC_ALL.doc000066400000000000000000000017271303454263000155550ustar00rootroot00000000000000\DOC SPEC_ALL \TYPE {SPEC_ALL : thm -> thm} \SYNOPSIS Specializes the conclusion of a theorem with its own quantified variables. \KEYWORDS rule. \DESCRIBE When applied to a theorem {A |- !x1...xn. t}, the inference rule {SPEC_ALL} returns the theorem {A |- t[x1'/x1]...[xn'/xn]} where the {xi'} are distinct variants of the corresponding {xi}, chosen to avoid clashes with any variables free in the assumption list. Normally {xi'} is just {xi}, in which case {SPEC_ALL} simply removes all universal quantifiers. { A |- !x1...xn. t --------------------------- SPEC_ALL A |- t[x1'/x1]...[xn'/xn] } \FAILURE Never fails. \EXAMPLE The following example shows how variables are also renamed to avoid clashing with those in assumptions. { # let th = ADD_ASSUM `m = 1` ADD_SYM;; val th : thm = m = 1 |- !m n. m + n = n + m # SPEC_ALL th;; val it : thm = m = 1 |- m' + n = n + m' } \SEEALSO GEN, GENL, GEN_ALL, GEN_TAC, SPEC, SPECL, SPEC_ALL, SPEC_TAC. \ENDDOC hol-light/Help/SPEC_TAC.doc000066400000000000000000000012311303454263000155420ustar00rootroot00000000000000\DOC SPEC_TAC \TYPE {SPEC_TAC : term * term -> tactic} \SYNOPSIS Generalizes a goal. \KEYWORDS tactic. \DESCRIBE When applied to a pair of terms {(`u`,`x`)}, where {x} is just a variable, and a goal {A ?- t}, the tactic {SPEC_TAC} generalizes the goal to {A ?- !x. t[x/u]}, that is, all (free) instances of {u} are turned into {x}. { A ?- t ================= SPEC_TAC (`u`,`x`) A ?- !x. t[x/u] } \FAILURE Fails unless {x} is a variable with the same type as {u}. \USES Removing unnecessary speciality in a goal, particularly as a prelude to an inductive proof. \SEEALSO GEN, GENL, GEN_ALL, GEN_TAC, SPEC, SPECL, SPEC_ALL, STRIP_TAC. \ENDDOC hol-light/Help/SPEC_VAR.doc000066400000000000000000000015141303454263000155670ustar00rootroot00000000000000\DOC SPEC_VAR \TYPE {SPEC_VAR : thm -> term * thm} \SYNOPSIS Specializes the conclusion of a theorem, returning the chosen variant. \KEYWORDS rule. \DESCRIBE When applied to a theorem {A |- !x. t}, the inference rule {SPEC_VAR} returns the term {x'} and the theorem {A |- t[x'/x]}, where {x'} is a variant of {x} chosen to avoid clashing with free variables in assumptions. { A |- !x. t -------------- SPEC_VAR A |- t[x'/x] } \FAILURE Fails unless the theorem's conclusion is universally quantified. \EXAMPLE Note how the variable is renamed to avoid the free {m} in the assumptions: { # let th = ADD_ASSUM `m = 1` ADD_SYM;; val th : thm = m = 1 |- !m n. m + n = n + m # SPEC_VAR th;; val it : term * thm = (`m'`, m = 1 |- !n. m' + n = n + m') } \SEEALSO GEN, GENL, GEN_ALL, GEN_TAC, SPEC, SPECL, SPEC_ALL. \ENDDOC hol-light/Help/STRING_EQ_CONV.doc000066400000000000000000000015131303454263000165440ustar00rootroot00000000000000\DOC STRING_EQ_CONV \TYPE {STRING_EQ_CONV : term -> thm} \SYNOPSIS Proves equality or inequality of two HOL string literals. \DESCRIBE If {"s"} and {"t"} are two string literals in the HOL logic, {STRING_EQ_CONV `"s" = "t"`} returns: { |- "s" = "t" <=> T or |- "s" = "t" <=> F } \noindent depending on whether the string literals are equal or not equal, respectively. \FAILURE {STRING_EQ_CONV tm} fails if {tm} is not of the specified form, an equation between string literals. \EXAMPLE { # STRING_EQ_CONV `"same" = "same"`;; val it : thm = |- "same" = "same" <=> T # STRING_EQ_CONV `"knowledge" = "power"`;; val it : thm = |- "knowledge" = "power" <=> F } \USES Performing basic equality reasoning while producing string-related proofs. \SEEALSO dest_string, CHAR_EQ_CONV, mk_string, NUM_EQ_CONV. \ENDDOC hol-light/Help/STRIP_ASSUME_TAC.doc000066400000000000000000000044511303454263000167750ustar00rootroot00000000000000\DOC STRIP_ASSUME_TAC \TYPE {STRIP_ASSUME_TAC : thm_tactic} \SYNOPSIS Splits a theorem into a list of theorems and then adds them to the assumptions. \KEYWORDS tactic. \DESCRIBE Given a theorem {th} and a goal {(A,t)}, {STRIP_ASSUME_TAC th} splits {th} into a list of theorems. This is done by recursively breaking conjunctions into separate conjuncts, cases-splitting disjunctions, and eliminating existential quantifiers by choosing arbitrary variables. Schematically, the following rules are applied: { A ?- t ====================== STRIP_ASSUME_TAC (A' |- v1 /\ ... /\ vn) A u {{v1,...,vn}} ?- t A ?- t ================================= STRIP_ASSUME_TAC (A' |- v1 \/ ... \/ vn) A u {{v1}} ?- t ... A u {{vn}} ?- t A ?- t ==================== STRIP_ASSUME_TAC (A' |- ?x.v) A u {{v[x'/x]}} ?- t } \noindent where {x'} is a variant of {x}. If the conclusion of {th} is not a conjunction, a disjunction or an existentially quantified term, the whole theorem {th} is added to the assumptions. As assumptions are generated, they are examined to see if they solve the goal (either by being alpha-equivalent to the conclusion of the goal or by deriving a contradiction). The assumptions of the theorem being split are not added to the assumptions of the goal(s), but they are recorded in the proof. This means that if {A'} is not a subset of the assumptions {A} of the goal (up to alpha-conversion), {STRIP_ASSUME_TAC (A' |- v)} results in an invalid tactic. \FAILURE Never fails. \EXAMPLE When solving the goal { # g `m = 0 + m`;; } \noindent assuming the clauses for addition with {STRIP_ASSUME_TAC ADD_CLAUSES} results in the goal { # e(STRIP_ASSUME_TAC ADD_CLAUSES);; val it : goalstack = 1 subgoal (1 total) 0 [`!n. 0 + n = n`] 1 [`!m. m + 0 = m`] 2 [`!m n. SUC m + n = SUC (m + n)`] 3 [`!m n. m + SUC n = SUC (m + n)`] `m = 0 + m` } \noindent while the same tactic directly solves the goal { ?- !m. 0 + m = m } \USES {STRIP_ASSUME_TAC} is used when applying a previously proved theorem to solve a goal, or when enriching its assumptions so that rewriting with assumptions and other operations involving assumptions have more to work with. \SEEALSO ASSUME_TAC, CHOOSE_TAC, CHOOSE_THEN, CONJUNCTS_THEN, DISJ_CASES_TAC, DISJ_CASES_THEN. \ENDDOC hol-light/Help/STRIP_GOAL_THEN.doc000066400000000000000000000037271303454263000166560ustar00rootroot00000000000000\DOC STRIP_GOAL_THEN \TYPE {STRIP_GOAL_THEN : thm_tactic -> tactic} \SYNOPSIS Splits a goal by eliminating one outermost connective, applying the given theorem-tactic to the antecedents of implications. \KEYWORDS theorem-tactic. \DESCRIBE Given a theorem-tactic {ttac} and a goal {(A,t)}, {STRIP_GOAL_THEN} removes one outermost occurrence of one of the connectives {!}, {==>}, {~} or {/\} from the conclusion of the goal {t}. If {t} is a universally quantified term, then {STRIP_GOAL_THEN} strips off the quantifier: { A ?- !x.u ============== STRIP_GOAL_THEN ttac A ?- u[x'/x] } \noindent where {x'} is a primed variant that does not appear free in the assumptions {A}. If {t} is a conjunction, then {STRIP_GOAL_THEN} simply splits the conjunction into two subgoals: { A ?- v /\ w ================= STRIP_GOAL_THEN ttac A ?- v A ?- w } \noindent If {t} is an implication {"u ==> v"} and if: { A ?- v =============== ttac (u |- u) A' ?- v' } \noindent then: { A ?- u ==> v ==================== STRIP_GOAL_THEN ttac A' ?- v' } \noindent Finally, a negation {~t} is treated as the implication {t ==> F}. \FAILURE {STRIP_GOAL_THEN ttac (A,t)} fails if {t} is not a universally quantified term, an implication, a negation or a conjunction. Failure also occurs if the application of {ttac} fails, after stripping the goal. \EXAMPLE When solving the goal { # g `n = 1 ==> n * n = n`;; Warning: Free variables in goal: n val it : goalstack = 1 subgoal (1 total) `n = 1 ==> n * n = n` } \noindent a possible initial step is to apply { # e(STRIP_GOAL_THEN SUBST1_TAC);; val it : goalstack = 1 subgoal (1 total) `1 * 1 = 1` } \noindent which is immediate by {ARITH_TAC}, for example. \USES {STRIP_GOAL_THEN} is used when manipulating intermediate results (obtained by stripping outer connectives from a goal) directly, rather than as assumptions. \SEEALSO CONJ_TAC, DISCH_THEN, GEN_TAC, STRIP_ASSUME_TAC, STRIP_TAC. \ENDDOC hol-light/Help/STRIP_TAC.doc000066400000000000000000000040301303454263000157110ustar00rootroot00000000000000\DOC STRIP_TAC \TYPE {STRIP_TAC : tactic} \SYNOPSIS Splits a goal by eliminating one outermost connective. \KEYWORDS tactic. \DESCRIBE Given a goal {(A,t)}, {STRIP_TAC} removes one outermost occurrence of one of the connectives {!}, {==>}, {~} or {/\} from the conclusion of the goal {t}. If {t} is a universally quantified term, then {STRIP_TAC} strips off the quantifier: { A ?- !x.u ============== STRIP_TAC A ?- u[x'/x] } \noindent where {x'} is a primed variant that does not appear free in the assumptions {A}. If {t} is a conjunction, then {STRIP_TAC} simply splits the conjunction into two subgoals: { A ?- v /\ w ================= STRIP_TAC A ?- v A ?- w } \noindent If {t} is an implication, {STRIP_TAC} moves the antecedent into the assumptions, stripping conjunctions, disjunctions and existential quantifiers according to the following rules: { A ?- v1 /\ ... /\ vn ==> v A ?- v1 \/ ... \/ vn ==> v ============================ ================================= A u {{v1,...,vn}} ?- v A u {{v1}} ?- v ... A u {{vn}} ?- v A ?- ?x.w ==> v ==================== A u {{w[x'/x]}} ?- v } \noindent where {x'} is a primed variant of {x} that does not appear free in {A}. Finally, a negation {~t} is treated as the implication {t ==> F}. \FAILURE {STRIP_TAC (A,t)} fails if {t} is not a universally quantified term, an implication, a negation or a conjunction. \EXAMPLE Starting with the goal: { # g `!m n. m <= n /\ n <= m ==> m = n`;; } \noindent the repeated application of {STRIP_TAC} strips off the universal quantifiers, breaks apart the antecedent and adds the conjuncts to the hypotheses: { # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`m <= n`] 1 [`n <= m`] `m = n` } \USES When trying to solve a goal, often the best thing to do first is {REPEAT STRIP_TAC} to split the goal up into manageable pieces. \SEEALSO CONJ_TAC, DISCH_TAC, DESTRUCT_TAC, DISCH_THEN, GEN_TAC, INTRO_TAC, STRIP_ASSUME_TAC, STRIP_GOAL_THEN. \ENDDOC hol-light/Help/STRIP_THM_THEN.doc000066400000000000000000000044221303454263000165550ustar00rootroot00000000000000\DOC STRIP_THM_THEN \TYPE {STRIP_THM_THEN : thm_tactical} \SYNOPSIS {STRIP_THM_THEN} applies the given theorem-tactic using the result of stripping off one outer connective from the given theorem. \KEYWORDS theorem-tactic. \DESCRIBE Given a theorem-tactic {ttac}, a theorem {th} whose conclusion is a conjunction, a disjunction or an existentially quantified term, and a goal {(A,t)}, {STRIP_THM_THEN ttac th} first strips apart the conclusion of {th}, next applies {ttac} to the theorem(s) resulting from the stripping and then applies the resulting tactic to the goal. In particular, when stripping a conjunctive theorem {A' |- u /\ v}, the tactic { ttac(u |- u) THEN ttac(v |- v) } \noindent resulting from applying {ttac} to the conjuncts, is applied to the goal. When stripping a disjunctive theorem {A' |- u \/ v}, the tactics resulting from applying {ttac} to the disjuncts, are applied to split the goal into two cases. That is, if { A ?- t A ?- t ========= ttac (u |- u) and ========= ttac (v |- v) A ?- t1 A ?- t2 } \noindent then: { A ?- t ================== STRIP_THM_THEN ttac (A' |- u \/ v) A ?- t1 A ?- t2 } \noindent When stripping an existentially quantified theorem {A' |- ?x.u}, the tactic {ttac(u |- u)}, resulting from applying {ttac} to the body of the existential quantification, is applied to the goal. That is, if: { A ?- t ========= ttac (u |- u) A ?- t1 } \noindent then: { A ?- t ============= STRIP_THM_THEN ttac (A' |- ?x. u) A ?- t1 } The assumptions of the theorem being split are not added to the assumptions of the goal(s) but are recorded in the proof. If {A'} is not a subset of the assumptions {A} of the goal (up to alpha-conversion), {STRIP_THM_THEN ttac th} results in an invalid tactic. \FAILURE {STRIP_THM_THEN ttac th} fails if the conclusion of {th} is not a conjunction, a disjunction or an existentially quantified term. Failure also occurs if the application of {ttac} fails, after stripping the outer connective from the conclusion of {th}. \USES {STRIP_THM_THEN} is used enrich the assumptions of a goal with a stripped version of a previously-proved theorem. \SEEALSO CHOOSE_THEN, CONJUNCTS_THEN, DISJ_CASES_THEN, STRIP_ASSUME_TAC. \ENDDOC hol-light/Help/STRUCT_CASES_TAC.doc000066400000000000000000000035741303454263000167660ustar00rootroot00000000000000\DOC STRUCT_CASES_TAC \TYPE {STRUCT_CASES_TAC : thm_tactic} \SYNOPSIS Performs very general structural case analysis. \KEYWORDS tactic, cases. \DESCRIBE When it is applied to a theorem of the form: { th = A' |- ?y11...y1m. x = t1 /\ (B11 /\ ... /\ B1k) \/ ... \/ ?yn1...ynp. x = tn /\ (Bn1 /\ ... /\ Bnp) } \noindent in which there may be no existential quantifiers where a `vector' of them is shown above, {STRUCT_CASES_TAC th} splits a goal {A ?- s} into {n} subgoals as follows: { A ?- s =============================================================== A u {{B11,...,B1k}} ?- s[t1/x] ... A u {{Bn1,...,Bnp}} ?- s[tn/x] } \noindent that is, performs a case split over the possible constructions (the {ti}) of a term, providing as assumptions the given constraints, having split conjoined constraints into separate assumptions. Note that unless {A'} is a subset of {A}, this is an invalid tactic. \FAILURE Fails unless the theorem has the above form, namely a conjunction of (possibly multiply existentially quantified) terms which assert the equality of the same variable {x} and the given terms. \EXAMPLE Suppose we have the goal: { # g `~(l:(A)list = []) ==> LENGTH l > 0`;; } \noindent then we can get rid of the universal quantifier from the inbuilt list theorem {list_CASES}: { list_CASES = !l. l = [] \/ (?h t. l = CONS h t) } \noindent and then use {STRUCT_CASES_TAC}. This amounts to applying the following tactic: { # e(STRUCT_CASES_TAC (SPEC_ALL list_CASES));; val it : goalstack = 2 subgoals (2 total) `~(CONS h t = []) ==> LENGTH (CONS h t) > 0` `~([] = []) ==> LENGTH [] > 0` } \noindent and both of these are solvable by {REWRITE_TAC[GT; LENGTH; LT_0]}. \USES Generating a case split from the axioms specifying a structure. \SEEALSO ASM_CASES_TAC, BOOL_CASES_TAC, COND_CASES_TAC, DISJ_CASES_TAC, STRUCT_CASES_THEN. \ENDDOC hol-light/Help/STRUCT_CASES_THEN.doc000066400000000000000000000032221303454263000171030ustar00rootroot00000000000000\DOC STRUCT_CASES_THEN \TYPE {STRUCT_CASES_THEN : thm_tactic -> thm_tactic} \SYNOPSIS Performs structural case analysis, applying theorem-tactic to results. \KEYWORDS tactic, cases. \DESCRIBE When it is applied to a theorem-tactic {ttac} and a theorem {th} of the form: { th = A' |- ?y11...y1m. x = t1 /\ (B11 /\ ... /\ B1k) \/ ... \/ ?yn1...ynp. x = tn /\ (Bn1 /\ ... /\ Bnp) } \noindent in which there may be no existential quantifiers where a `vector' of them is shown above, {STRUCT_CASES_THEN ttac th} splits a goal {A ?- s} into {n} subgoals, where goal {k} results the initial goal by applying {ttac} to the theorem {x = tn |- x = tn}. That is, it performs a case split over the possible constructions (the {ti}) of a term and applies {ttac} to the resulting case assumptions. Note that unless {A'} is a subset of {A}, this is an invalid tactic. \FAILURE Fails unless the theorem has the above form, namely a conjunction of (possibly multiply existentially quantified) terms which assert the equality of the same variable {x} and the given terms. \EXAMPLE Suppose we have the goal: { # g `n > 0 ==> PRE(n) + 1 = n`;; } \noindent We can use the inbuilt theorem {num_CASES} to perform a case analysis on {n}, adding each case as a new assumption by {ASSUME_TAC} like this: { # e(STRUCT_CASES_THEN ASSUME_TAC (SPEC `n:num` num_CASES));; val it : goalstack = 2 subgoals (2 total) 0 [`n = SUC n'`] `n > 0 ==> PRE n + 1 = n` 0 [`n = 0`] `n > 0 ==> PRE n + 1 = n` } \USES Generating a case split from the axioms specifying a structure. \SEEALSO ASM_CASES_TAC, BOOL_CASES_TAC, COND_CASES_TAC, DISJ_CASES_TAC, STRUCT_CASES_TAC. \ENDDOC hol-light/Help/SUBGOAL_TAC.doc000066400000000000000000000022131303454263000161050ustar00rootroot00000000000000\DOC SUBGOAL_TAC \TYPE {SUBGOAL_TAC : string -> term -> tactic list -> tactic} \SYNOPSIS Encloses the sub-proof of a named lemma. \DESCRIBE The call {SUBGOAL_TAC "name" `t` [tac]} introduces a new subgoal {t} with the current assumptions, runs on that subgoal the tactic {tac}, and attaches the result as a new hypothesis called {name} in the current subgoal. The {[tac]} argument is always a one-element list, for stylistic reasons. If {tac} does not prove the goal, any resulting subgoals from it will appear first. \FAILURE Fails if {t} is not Boolean or if {tac} fails on it. \EXAMPLE If we want to prove { # g `(n MOD 2) IN {{0,1}}`;; } \noindent we might start by establishing a lemma: { # e(SUBGOAL_TAC "ml2" `n MOD 2 < 2` [SIMP_TAC[DIVISION; ARITH]]);; val it : goalstack = 1 subgoal (1 total) 0 [`n MOD 2 < 2`] (ml2) `n MOD 2 IN {{0, 1}}` } \noindent after which, for example, we could finish things with { # e(REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; val it : goalstack = No subgoals } \USES Structuring proofs via a sequence of simple lemmas. \SEEALSO CLAIM_TAC, SUBGOAL_THEN. \ENDDOC hol-light/Help/SUBGOAL_THEN.doc000066400000000000000000000073721303454263000162470ustar00rootroot00000000000000\DOC SUBGOAL_THEN \TYPE {SUBGOAL_THEN : term -> thm_tactic -> tactic} \SYNOPSIS Introduces a lemma as a new subgoal. \KEYWORDS theorem-tactic, lemma. \DESCRIBE The user proposes a lemma and is then invited to prove it under the current assumptions. The lemma is then used with the {thm_tactic} to apply to the goal. That is, if { A1 ?- t1 ========== ttac (t |- t) A2 ?- t2 } \noindent then { A1 ?- t1 ==================== SUBGOAL_THEN `t` ttac A1 ?- t A2 ?- t2 } In the quite common special case where {ttac} is {ASSUME_TAC}, the net behaviour is simply to present the user with two subgoals, one in which the lemma is to be proved and one in which it may be assumed: { A1 ?- t1 ============================ SUBGOAL_THEN `t` ASSUME_TAC A1 ?- t A1 u {{t}} ?- t2 } \FAILURE {SUBGOAL_THEN} will fail if an attempt is made to use a non-boolean term as a lemma. \USES Introducing lemmas into the same basic proof script without separately binding them to names. This is often a good structuring technique for large tactic proofs, where separate lemmas might look artificial because of all the ad-hoc context in which they occur. \EXAMPLE Consider the proof of the Knaster-Tarski fixpoint theorem, to be found in {Library/card.ml}. This (in its set-lattice context) states that every monotonic function has a fixpoint. After setting the initial goal: { # g `!f. (!s t. s SUBSET t ==> f(s) SUBSET f(t)) ==> ?s:A->bool. f(s) = s`;; } \noindent we start off the proof, already proceeding via a series of lemmas with {SUBGOAL_THEN}, though we will focus our attention on a later one: { # e(REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`Y = {{b:A->bool | f(b) SUBSET b}}`; `a:A->bool = INTERS Y`] THEN SUBGOAL_THEN `!b:A->bool. b IN Y <=> f(b) SUBSET b` ASSUME_TAC THENL [EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN SUBGOAL_THEN `!b:A->bool. b IN Y ==> f(a:A->bool) SUBSET b` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; IN_INTERS; SUBSET]; ALL_TAC]);; ... val it : goalstack = 1 subgoal (1 total) 0 [`!s t. s SUBSET t ==> f s SUBSET f t`] 1 [`{{b | f b SUBSET b}} = Y`] 2 [`INTERS Y = a`] 3 [`!b. b IN Y <=> f b SUBSET b`] 4 [`!b. b IN Y ==> f a SUBSET b`] `?s. f s = s` } Now we select a particularly interesting lemma: { # e(SUBGOAL_THEN `f(a:A->bool) SUBSET a` ASSUME_TAC);; val it : goalstack = 2 subgoals (2 total) 0 [`!s t. s SUBSET t ==> f s SUBSET f t`] 1 [`{{b | f b SUBSET b}} = Y`] 2 [`INTERS Y = a`] 3 [`!b. b IN Y <=> f b SUBSET b`] 4 [`!b. b IN Y ==> f a SUBSET b`] 5 [`f a SUBSET a`] `?s. f s = s` 0 [`!s t. s SUBSET t ==> f s SUBSET f t`] 1 [`{{b | f b SUBSET b}} = Y`] 2 [`INTERS Y = a`] 3 [`!b. b IN Y <=> f b SUBSET b`] 4 [`!b. b IN Y ==> f a SUBSET b`] `f a SUBSET a` } \noindent The lemma is relatively easy to prove by giving {MESON_TAC} the right lemmas: { # e(ASM_MESON_TAC[IN_INTERS; SUBSET]);; ... val it : goalstack = 1 subgoal (1 total) 0 [`!s t. s SUBSET t ==> f s SUBSET f t`] 1 [`{{b | f b SUBSET b}} = Y`] 2 [`INTERS Y = a`] 3 [`!b. b IN Y <=> f b SUBSET b`] 4 [`!b. b IN Y ==> f a SUBSET b`] 5 [`f a SUBSET a`] `?s. f s = s` } \noindent and the remaining subgoal is also quite easy for {MESON_TAC}: { # e(ASM_MESON_TAC[SUBSET_ANTISYM; IN_INTERS]);; ... val it : goalstack = No subgoals } On the other hand, without splitting off the last lemmas, {MESON_TAC} finds the automated step rather large. If you step back three steps with { # b(); b(); b();; } \noindent then although the following works, it takes half a minute: { # e(ASM_MESON_TAC[IN_INTERS; SUBSET; SUBSET_ANTISYM]);; .... val it : goalstack = No subgoals } \SEEALSO CLAIM_TAC, MATCH_MP_TAC, MP_TAC, SUBGOAL_TAC. \ENDDOC hol-light/Help/SUBS.doc000066400000000000000000000037211303454263000151030ustar00rootroot00000000000000\DOC SUBS \TYPE {SUBS : thm list -> thm -> thm} \SYNOPSIS Makes simple term substitutions in a theorem using a given list of theorems. \KEYWORDS rule. \DESCRIBE Term substitution in HOL is performed by replacing free subterms according to the transformations specified by a list of equational theorems. Given a list of theorems {A1|-t1=v1,...,An|-tn=vn} and a theorem {A|-t}, {SUBS} simultaneously replaces each free occurrence of {ti} in {t} with {vi}: { A1|-t1=v1 ... An|-tn=vn A|-t --------------------------------------------- SUBS[A1|-t1=v1;...;An|-tn=vn] A1 u ... u An u A |- t[v1,...,vn/t1,...,tn] (A|-t) } \noindent No matching is involved; the occurrence of each {ti} being substituted for must be a free in {t} (see {SUBST_MATCH}). An occurrence which is not free can be substituted by using rewriting rules such as {REWRITE_RULE}, {PURE_REWRITE_RULE} and {ONCE_REWRITE_RULE}. \FAILURE {SUBS [th1;...;thn] (A|-t)} fails if the conclusion of each theorem in the list is not an equation. No change is made to the theorem {A |- t} if no occurrence of any left-hand side of the supplied equations appears in {t}. \EXAMPLE Substitutions are made with the theorems { # let thm1 = SPEC_ALL ADD_SYM and thm2 = SPEC_ALL(CONJUNCT1 ADD_CLAUSES);; val thm1 : thm = |- m + n = n + m val thm2 : thm = |- 0 + n = n } \noindent depending on the occurrence of free subterms { # SUBS [thm1; thm2] (ASSUME `(n + 0) + (0 + m) = m + n`);; val it : thm = (n + 0) + 0 + m = m + n |- (n + 0) + 0 + m = n + m # SUBS [thm1; thm2] (ASSUME `!n. (n + 0) + (0 + m) = m + n`);; val it : thm = !n. (n + 0) + 0 + m = m + n |- !n. (n + 0) + 0 + m = m + n } \USES {SUBS} can sometimes be used when rewriting (for example, with {REWRITE_RULE}) would diverge and term instantiation is not needed. Moreover, applying the substitution rules is often much faster than using the rewriting rules. \SEEALSO ONCE_REWRITE_RULE, PURE_REWRITE_RULE, REWRITE_RULE, SUBS_CONV. \ENDDOC hol-light/Help/SUBST1_TAC.doc000066400000000000000000000037671303454263000160110ustar00rootroot00000000000000\DOC SUBST1_TAC \TYPE {SUBST1_TAC : thm_tactic} \SYNOPSIS Makes a simple term substitution in a goal using a single equational theorem. \KEYWORDS tactic. \DESCRIBE Given a theorem {A' |- u = v} and a goal {(A ?- t)}, the tactic {SUBST1_TAC (A' |- u = v)} rewrites the term {t} into {t[v/u]}, by substituting {v} for each free occurrence of {u} in {t}: { A ?- t ============= SUBST1_TAC (A' |- u = v) A ?- t[v/u] } \noindent The assumptions of the theorem used to substitute with are not added to the assumptions of the goal but are recorded in the proof. If {A'} is not a subset of the assumptions {A} of the goal (up to alpha-conversion), then {SUBST1_TAC (A' |- u = v)} results in an invalid tactic. {SUBST1_TAC} automatically renames bound variables to prevent free variables in {v} becoming bound after substitution. However, by contrast with rewriting tactics such as {REWRITE_TAC}, it does not instantiate free or universally quantified variables in the theorem to make them match the target term. This makes it less powerful but also more precisely controlled. \FAILURE {SUBST1_TAC th (A ?- t)} fails if the conclusion of {th} is not an equation. No change is made to the goal if no free occurrence of the left-hand side of {th} appears in {t}. \EXAMPLE Suppose we start with the goal: { # g `!p x y. 1 = x /\ p(1) ==> p(x)`;; } We could, of course, solve it immediately with {MESON_TAC[]}. However, for a more ``manual'' proof, we might do: { # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`1 = x`] 1 [`p 1`] `p x` } \noindent and then use {SUBST1_TAC} to substitute: { # e(FIRST_X_ASSUM(SUBST1_TAC o SYM));; val it : goalstack = 1 subgoal (1 total) 0 [`p 1`] `p 1` } \noindent after which just {ASM_REWRITE_TAC[]} will finish. \USES {SUBST1_TAC} can be used when rewriting with a single theorem using tactics such as {REWRITE_TAC} is too expensive or would diverge. \SEEALSO ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBS_CONV, SUBST_ALL_TAC. \ENDDOC hol-light/Help/SUBST_ALL_TAC.doc000066400000000000000000000040471303454263000164100ustar00rootroot00000000000000\DOC SUBST_ALL_TAC \TYPE {SUBST_ALL_TAC : thm -> tactic} \SYNOPSIS Substitutes using a single equation in both the assumptions and conclusion of a goal. \KEYWORDS tactic. \DESCRIBE {SUBST_ALL_TAC} breaches the style of natural deduction, where the assumptions are kept fixed. Given a theorem {A |- u = v} and a goal {([A1;...;An] ?- t)}, {SUBST_ALL_TAC (A |- u = v)} transforms the assumptions {A1},...,{An} and the term {t} into {A1[v/u]},...,{An[v/u]} and {t[v/u]} respectively, by substituting {v} for each free occurrence of {u} in both the assumptions and the conclusion of the goal. { {{A1,...,An}} ?- t ================================= SUBST_ALL_TAC (A |- u = v) {{A1[v/u],...,An[v/u]}} ?- t[v/u] } \noindent The assumptions of the theorem used to substitute with are not added to the assumptions of the goal, but they are recorded in the proof. If {A} is not a subset of the assumptions of the goal (up to alpha-conversion), then {SUBST_ALL_TAC (A |- u = v)} results in an invalid tactic. {SUBST_ALL_TAC} automatically renames bound variables to prevent free variables in {v} becoming bound after substitution. \FAILURE {SUBST_ALL_TAC th (A ?- t)} fails if the conclusion of {th} is not an equation. No change is made to the goal if no occurrence of the left-hand side of {th} appears free in {(A ?- t)}. \EXAMPLE Suppose we start with the goal: { # g `!p x y. 1 = x /\ p(x - 1) ==> p(x EXP 2 - x)`;; } \noindent and, as often, begin by breaking it down routinely: { # e(REPEAT STRIP_TAC);; val it : goalstack = 1 subgoal (1 total) 0 [`1 = x`] 1 [`p (x - 1)`] `p (x EXP 2 - x)` } \noindent Now we can use {SUBST_ALL_TAC} to substitute {1} for {x} in both assumptions and conclusion: { # e(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM));; val it : goalstack = 1 subgoal (1 total) 0 [`p (1 - 1)`] `p (1 EXP 2 - 1)` } One can finish things off in various ways, e.g. { # e(POP_ASSUM MP_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[]);; } \SEEALSO ONCE_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, SUBS_CONV, SUBST1_TAC. \ENDDOC hol-light/Help/SUBST_VAR_TAC.doc000066400000000000000000000020731303454263000164250ustar00rootroot00000000000000\DOC SUBST_VAR_TAC \TYPE {SUBST_VAR_TAC : thm -> tactic} \SYNOPSIS Use an equation to substitute ``safely'' in goal. \DESCRIBE When applied to a theorem with an equational hypothesis {A |- s = t}, {SUBST_ VAR_TAC} has no effect if {s} and {t} are alpha-equivalent. Otherwise, if either side of the equation is a variable not free in the other side, or a constant, and the conclusion contains no free variables not free in some assumption of the goal, then the theorem is used to replace that constant or variable throughout the goal, assumptions and conclusions. If none of these cases apply, or the conclusion is not even an equation, the application fails. \FAILURE Fails if applied to a non-equation for which none of the cases above hold. \USES By some sequence like {REPEAT(FIRST_X_ASSUM SUBST_VAR_TAC)} one can use all possible assumptions to substitute ``safely'', in the sense that it will not change the provability status of the goal. This is sometimes a useful prelude to other automatic techniques. \COMMENTS \SEEALSO SUBST1_TAC, SUBST_ALL_TAC. \ENDDOC hol-light/Help/SUBS_CONV.doc000066400000000000000000000022671303454263000157340ustar00rootroot00000000000000\DOC SUBS_CONV \TYPE {SUBS_CONV : thm list -> term -> thm} \SYNOPSIS Substitution conversion. \DESCRIBE The call {SUBS_CONV [th1; ...; th2] t}, where the theorems in the list are all equations, will return the theorem {|- t = t'} where {t'} results from substituting any terms that are the same as the left-hand side of some {thi} with the corresponding right-hand side. Note that no matching or instantiation is done, in contrast to rewriting conversions. \FAILURE May fail if the theorems are not equational. \EXAMPLE Here we substitute with a simplification theorem, but only instances that are the same as the LHS: { # SUBS_CONV[ARITH_RULE `x + 0 = x`] `(x + 0) + (y + 0) + (x + 0) + (0 + 0)`;; val it : thm = |- (x + 0) + (y + 0) + (x + 0) + 0 + 0 = x + (y + 0) + x + 0 + 0 } \noindent By contrast, the analogous rewriting conversion will treat the variable {x} as universally quantified and replace more subterms by matching the LHS against them: { # REWRITE_CONV[ARITH_RULE `x + 0 = x`] `(x + 0) + (y + 0) + (x + 0) + (0 + 0)`;; val it : thm = |- (x + 0) + (y + 0) + (x + 0) + 0 + 0 = x + y + x } \SEEALSO GEN_REWRITE_CONV, REWR_CONV, REWRITE_CONV, PURE_REWRITE_CONV. \ENDDOC hol-light/Help/SUB_CONV.doc000066400000000000000000000030211303454263000155760ustar00rootroot00000000000000\DOC SUB_CONV \TYPE {SUB_CONV : conv -> conv} \SYNOPSIS Applies a conversion to the top-level subterms of a term. \KEYWORDS conversional. \DESCRIBE For any conversion {c}, the function returned by {SUB_CONV c} is a conversion that applies {c} to all the top-level subterms of a term. If the conversion {c} maps {t} to {|- t = t'}, then {SUB_CONV c} maps an abstraction {`\x. t`} to the theorem: { |- (\x. t) = (\x. t') } \noindent That is, {SUB_CONV c `\x. t`} applies {c} to the body of the abstraction {`\x. t`}. If {c} is a conversion that maps {`t1`} to the theorem {|- t1 = t1'} and {`t2`} to the theorem {|- t2 = t2'}, then the conversion {SUB_CONV c} maps an application {`t1 t2`} to the theorem: { |- (t1 t2) = (t1' t2') } \noindent That is, {SUB_CONV c `t1 t2`} applies {c} to the both the operator {t1} and the operand {t2} of the application {`t1 t2`}. Finally, for any conversion {c}, the function returned by {SUB_CONV c} acts as the identity conversion on variables and constants. That is, if {`t`} is a variable or constant, then {SUB_CONV c `t`} returns {|- t = t}. \FAILURE {SUB_CONV c tm} fails if {tm} is an abstraction {`\x. t`} and the conversion {c} fails when applied to {t}, or if {tm} is an application {`t1 t2`} and the conversion {c} fails when applied to either {t1} or {t2}. The function returned by {SUB_CONV c} may also fail if the ML function {c} is not, in fact, a conversion (i.e. a function that maps a term {t} to a theorem {|- t = t'}). \SEEALSO ABS_CONV, COMB_CONV, RAND_CONV, RATOR_CONV. \ENDDOC hol-light/Help/SYM.doc000066400000000000000000000013431303454263000147750ustar00rootroot00000000000000\DOC SYM \TYPE {SYM : thm -> thm} \SYNOPSIS Swaps left-hand and right-hand sides of an equation. \KEYWORDS rule, symmetry, equality. \DESCRIBE When applied to a theorem {A |- t1 = t2}, the inference rule {SYM} returns {A |- t2 = t1}. { A |- t1 = t2 -------------- SYM A |- t2 = t1 } \FAILURE Fails unless the theorem is equational. \EXAMPLE { # NUM_REDUCE_CONV `12 * 12`;; val it : thm = |- 12 * 12 = 144 # SYM it;; val it : thm = |- 144 = 12 * 12 } \COMMENTS The {SYM} rule requires the input theorem to be a simple equation, without additional structure such as outer universal quantifiers. To reverse equality signs deeper inside theorems, you may use {GSYM} instead. \SEEALSO GSYM, REFL, TRANS. \ENDDOC hol-light/Help/SYM_CONV.doc000066400000000000000000000007051303454263000156230ustar00rootroot00000000000000\DOC SYM_CONV \TYPE {SYM_CONV : term -> thm} \SYNOPSIS Interchanges the left and right-hand sides of an equation. \KEYWORDS conversion, symmetry, equality. \DESCRIBE When applied to an equational term {t1 = t2}, the conversion {SYM_CONV} returns the theorem: { |- t1 = t2 <=> t2 = t1 } \FAILURE Fails if applied to a term that is not an equation. \EXAMPLE { # SYM_CONV `2 = x`;; val it : thm = |- 2 = x <=> x = 2 } \SEEALSO SYM. \ENDDOC hol-light/Help/TAC_PROOF.doc000066400000000000000000000011541303454263000157010ustar00rootroot00000000000000\DOC TAC_PROOF \TYPE {TAC_PROOF : goal * tactic -> thm} \SYNOPSIS Attempts to prove a goal using a given tactic. \DESCRIBE When applied to a goal-tactic pair {(A ?- t,tac)}, the {TAC_PROOF} function attempts to prove the goal {A ?- t}, using the tactic {tac}. If it succeeds, it returns the theorem {A' |- t} corresponding to the goal, where the assumption list {A'} may be a proper superset of {A} unless the tactic is valid; there is no inbuilt validity checking. \FAILURE Fails unless the goal has hypotheses and conclusions all of type {bool}, and the tactic can solve the goal. \SEEALSO prove, VALID. \ENDDOC hol-light/Help/TARGET_REWRITE_TAC.doc000066400000000000000000000113601303454263000172030ustar00rootroot00000000000000\DOC TARGET_REWRITE_TAC \TYPE {TARGET_REWRITE_TAC : thm list -> thm -> tactic} \SYNOPSIS Performs target implicational rewriting. \DESCRIBE Given a theorem {th} (the ``support theorem''), and another theorem {uh} (the ``target theorem''), target rewriting generates all the goals that can be obtained by rewriting with {th}, until it becomes possible to rewrite with {uh}. Contrarily to standard rewriting techniques, only one position is rewritten at a time ({REWRITE_TAC}, {SIMP_TAC}, {IMP_REWRITE_TAC}, or even {ONCE_REWRITE_TAC} apply rewriting to several parallel positions if applicable). Therefore only the rewrites that are useful for the application of the theorem {uh} are achieved in the end. More precisely, given a list of theorems {[th_1;...;th_k]} of the form {!x_1... x_n. P ==> !y_1... y_m. l = r}, and a theorem {uh} of the form {!x_1... x_n. Q ==> !y_1... y_m. l' = r'}, {TARGET_REWRITE_TAC [th_1;...;th_k] uh} applies target implicational rewriting, i.e. tries all the possible implicational rewrites with {th_1}, ..., {th_k} until it obtains a goal where implicational rewrite with {uh} becomes possible. To understand better the difference with {REWRITE_TAC} and the need for a target theorem, consider a goal g where more than one subterm can be rewritten using {th}: with {REWRITE_TAC}, all such subterms are rewritten simultaneously; whereas, with {TARGET_REWRITE_TAC}, every of these subterms are rewritten independently, thus yielding as many goals. If one of these goals can be rewritten (in one position or more) by {uh}, then the tactic returns this goal. Otherwise, the ``one-subterm rewriting'' is applied again on every of the new goals, iteratively until a goal which can be rewritten by {uh} is obtained. \FAILURE Fails if no rewrite can be achieved using the support theorems. It may also fail if no path is found to apply the target theorem, but, most of the time, it does not terminate in this situation. \EXAMPLE This is a simple example: { # REAL_ADD_RINV;; val it : thm = |- !x. x + --x = &0 # g `!x y z. --y + x + y = &0`;; Warning: inventing type variables val it : goalstack = 1 subgoal (1 total) `!x y z. --y + x + y = &0` # e(TARGET_REWRITE_TAC[REAL_ADD_AC] REAL_ADD_RINV);; val it : goalstack = 1 subgoal (1 total) `!x. x + &0 = &0` } And a slightly more complex one: { # REAL_MUL_RINV;; val it : thm = |- !x. ~(x = &0) ==> x * inv x = &1 # g `!x y. inv y * x * y = x`;; Warning: inventing type variables val it : goalstack = 1 subgoal (1 total) `!x y z. inv y * x * y = x` # e(TARGET_REWRITE_TAC[REAL_MUL_AC] REAL_MUL_RINV);; val it : goalstack = 1 subgoal (1 total) `!x y. x * &1 = x / ~(y = &0)` } Let us finally consider an example which does not involve associativity and commutativity. Consider the following goal: { # g `!z. norm (cnj z) = norm z`;; val it : goalstack = 1 subgoal (1 total) `!z. norm (cnj z) = norm z` } A preliminary step here is to decompose the left-side z into its polar coordinates. This can be done by applying the following theorem: { # ARG;; val it : thm = |- !z. &0 <= Arg z /\ Arg z < &2 * pi /\ z = Cx (norm z) * cexp (ii * Cx (Arg z)) } But using standard rewriting would rewrite both sides and would not terminate (or actually, in the current implementation of {REWRITE_TAC}, simply would not apply). Instead we can use {TARGET_REWRITE_TAC} by noting that we actually plan to decompose into polar coordinates with the intention of using {CNJ_MUL} afterwards, which yields: { # e(TARGET_REWRITE_TAC[ARG] CNJ_MUL);; val it : goalstack = 1 subgoal (1 total) `!z. norm (cnj (Cx (norm z)) * cnj (cexp (ii * Cx (Arg z)))) = norm z` } \USES This tactic is useful each time someone does not want to rewrite a theorem everywhere or if a rewriting diverges. Therefore, it can replace most calls to {ONCE_REWRITE_TAC} or {GEN_REWRITE_TAC}: most of the time, these tactics are used to control rewriting more precisely than {REWRITE_TAC}. However, their use is tedious and time-consuming whereas the corresponding reasoning is not complex. In addition, even when the user manages to come out with a working tactic, this tactic is generally very fragile. Instead, with {TARGET_REWRITE_TAC}, the user does not have to think about the low-level control of rewriting but just gives the theorem which corresponds to the next step in the proof (see examples): this is extremely simple and fast to devise. Note in addition that, contrarily to an explicit (and therefore fragile) path, the target theorem represents a reasoning step which has few chances to change in further refinements of the script. When using associativity-commutativity theorems as support theorems, this tactic allows to achieve AC-rewriting. \SEEALSO CASE_REWRITE_TAC, IMP_REWRITE_TAC, REWRITE_TAC, SEQ_IMP_REWRITE_TAC, SIMP_TAC. \ENDDOC hol-light/Help/TAUT.doc000066400000000000000000000026761303454263000151140ustar00rootroot00000000000000\DOC TAUT \TYPE {TAUT : term -> thm} \SYNOPSIS Proves a propositional tautology. \DESCRIBE The call {TAUT `t`} where {t} is a propositional tautology, will prove it automatically and return {|- t}. A propositional tautology is a formula built up using the logical connectives `{~}', `{/\}', `{\/}', `{==>}' and `{<=>}' from terms that can be considered ``atomic'' that is logically valid whatever truth-values are assigned to the atomic formulas. \FAILURE Fails if {t} is not a propositional tautology. \EXAMPLE Here is a simple and potentially useful tautology: { # TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`;; val it : thm = |- a \/ b ==> c <=> (a ==> c) /\ (b ==> c) } \noindent and here is a more surprising one: { # TAUT `(p ==> q) \/ (q ==> p)`;; val it : thm = |- (p ==> q) \/ (q ==> p) } \noindent Note that the ``atomic'' formulas need not just be variables: { # TAUT `(x > 2 ==> y > 3) \/ (y < 3 ==> x > 2)`;; val it : thm = |- (x > 2 ==> y > 3) \/ (y < 3 ==> x > 2) } \USES Solving a tautologous goal completely by {CONV_TAC TAUT}, or generating a tautology to massage the goal into a more convenient equivalent form by {REWRITE_TAC[TAUT `...`]} or {ONCE_REWRITE_TAC[TAUT `...`]}. \COMMENTS The algorithm used is quite naive, and not efficient on large formulas. For more general first-order reasoning, with quantifier instantiation, use MESON-based methods. \SEEALSO BOOL_CASES_TAC, ITAUT, ITAUT_TAC, MESON, MESON_TAC. \ENDDOC hol-light/Help/THEN.doc000066400000000000000000000034141303454263000150640ustar00rootroot00000000000000\DOC THEN \TYPE {(THEN) : tactic -> tactic -> tactic} \SYNOPSIS Applies two tactics in sequence. \KEYWORDS tactical. \DESCRIBE If {t1} and {t2} are tactics, {t1 THEN t2} is a tactic which applies {t1} to a goal, then applies the tactic {t2} to all the subgoals generated. If {t1} solves the goal then {t2} is never applied. \FAILURE The application of {THEN} to a pair of tactics never fails. The resulting tactic fails if {t1} fails when applied to the goal, or if {t2} does when applied to any of the resulting subgoals. \EXAMPLE Suppose we want to prove the inbuilt theorem {DELETE_INSERT} ourselves: { # g `!x y. (x INSERT s) DELETE y = if x = y then s DELETE y else x INSERT (s DELETE y)`;; } We may wish to perform a case-split using {COND_CASES_TAC}, but since variables in the if-then-else construct are bound, this is inapplicable. Thus we want to first strip off the universally quantified variables: { # e(REPEAT GEN_TAC);; val it : goalstack = 1 subgoal (1 total) `(x INSERT s) DELETE y = (if x = y then s DELETE y else x INSERT (s DELETE y))` } \noindent and then apply {COND_CASES_TAC}: { # e COND_CASES_TAC;; ... } A quicker way (starting again from the initial goal) would be to combine the tactics using {THEN}: { # e(REPEAT GEN_TAC THEN COND_CASES_TAC);; ... } \COMMENTS Although normally used to sequence tactics which generate a single subgoal, it is worth remembering that it is sometimes useful to apply the same tactic to multiple subgoals; sequences like the following: { EQ_TAC THENL [ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]] } \noindent can be replaced by the briefer: { EQ_TAC THEN ASM_REWRITE_TAC[] } If using this several times in succession, remember that {THEN} is left-associative. \SEEALSO EVERY, ORELSE, THENL. \ENDDOC hol-light/Help/THENC.doc000066400000000000000000000020231303454263000151620ustar00rootroot00000000000000\DOC THENC \TYPE {(THENC) : conv -> conv -> conv} \SYNOPSIS Applies two conversions in sequence. \KEYWORDS conversional. \DESCRIBE If the conversion {c1} returns {|- t = t'} when applied to a term {`t`}, and {c2} returns {|- t' = t''} when applied to {`t'`}, then the composite conversion {(c1 THENC c2) `t`} returns {|- t = t''}. That is, {(c1 THENC c2) `t`} has the effect of transforming the term {`t`} first with the conversion {c1} and then with the conversion {c2}. \FAILURE {(c1 THENC c2) `t`} fails if either the conversion {c1} fails when applied to {`t`}, or if {c1 `t`} succeeds and returns {|- t = t'} but {c2} fails when applied to {`t'`}. {(c1 THENC c2) `t`} may also fail if either of {c1} or {c2} is not, in fact, a conversion (i.e. a function that maps a term {t} to a theorem {|- t = t'}). \EXAMPLE { # BETA_CONV `(\x. x + 1) 3`;; val it : thm = |- (\x. x + 1) 3 = 3 + 1 # (BETA_CONV THENC NUM_ADD_CONV) `(\x. x + 1) 3`;; val it : thm = |- (\x. x + 1) 3 = 4 } \SEEALSO EVERY_CONV, ORELSEC, REPEATC. \ENDDOC hol-light/Help/THENL.doc000066400000000000000000000037241303454263000152040ustar00rootroot00000000000000\DOC THENL \TYPE {(THENL) : tactic -> tactic list -> tactic} \SYNOPSIS Applies a list of tactics to the corresponding subgoals generated by a tactic. \KEYWORDS tactical. \DESCRIBE If {t,t1,...,tn} are tactics, {t THENL [t1;...;tn]} is a tactic which applies {t} to a goal, and if it does not fail, applies the tactics {t1,...,tn} to the corresponding subgoals, unless {t} completely solves the goal. \FAILURE The application of {THENL} to a tactic and tactic list never fails. The resulting tactic fails if {t} fails when applied to the goal, or if the goal list is not empty and its length is not the same as that of the tactic list, or finally if {ti} fails when applied to the {i}'th subgoal generated by {t}. \EXAMPLE If we want to prove the inbuilt theorem {LE_LDIV} ourselves: { # g `!a b n. ~(a = 0) /\ b <= a * n ==> b DIV a <= n`;; ... } \noindent we may start by proving a lemma {n = (a * n) DIV a} from the given hypotheses. The following step generates two subgoals: { # e(REPEAT STRIP_TAC THEN SUBGOAL_THEN `n = (a * n) DIV a` SUBST1_TAC);; val it : goalstack = 2 subgoals (2 total) 0 [`~(a = 0)`] 1 [`b <= a * n`] `b DIV a <= (a * n) DIV a` 0 [`~(a = 0)`] 1 [`b <= a * n`] `n = (a * n) DIV a` } Each subgoal has a relatively short proof, but these proofs are quite different. We can combine them with the initial tactic above using {THENL}, so the following would solve the initial goal: { # e(REPEAT STRIP_TAC THEN SUBGOAL_THEN `n = (a * n) DIV a` SUBST1_TAC THENL [ASM_SIMP_TAC[DIV_MULT]; MATCH_MP_TAC DIV_MONO THEN ASM_REWRITE_TAC[]]);; } Note that it is quite a common situation for the same tactic to be applied to all generated subgoals. In that case, you can just use {THEN}, e.g. in the proof of the pre-proved theorem {ADD_0}: { # g `!m. m + 0 = m`;; ... # e(INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]);; val it : goalstack = No subgoals } \USES Applying different tactics to different subgoals. \SEEALSO EVERY, ORELSE, THEN. \ENDDOC hol-light/Help/THEN_TCL.doc000066400000000000000000000010771303454263000155710ustar00rootroot00000000000000\DOC THEN_TCL \TYPE {(THEN_TCL) : thm_tactical -> thm_tactical -> thm_tactical} \SYNOPSIS Composes two theorem-tacticals. \KEYWORDS theorem-tactical. \DESCRIBE If {ttl1} and {ttl2} are two theorem-tacticals, {ttl1 THEN_TCL ttl2} is a theorem-tactical which composes their effect; that is, if: { ttl1 ttac th1 = ttac th2 } \noindent and { ttl2 ttac th2 = ttac th3 } \noindent then { (ttl1 THEN_TCL ttl2) ttac th1 = ttac th3 } \FAILURE The application of {THEN_TCL} to a pair of theorem-tacticals never fails. \SEEALSO EVERY_TCL, FIRST_TCL, ORELSE_TCL. \ENDDOC hol-light/Help/TOP_DEPTH_CONV.doc000066400000000000000000000037001303454263000165370ustar00rootroot00000000000000\DOC TOP_DEPTH_CONV \TYPE {TOP_DEPTH_CONV : conv -> conv} \SYNOPSIS Applies a conversion top-down to all subterms, retraversing changed ones. \KEYWORDS conversional. \DESCRIBE {TOP_DEPTH_CONV c tm} repeatedly applies the conversion {c} to all the subterms of the term {tm}, including the term {tm} itself. The supplied conversion {c} is applied to the subterms of {tm} in top-down order and is applied repeatedly (zero or more times, as is done by {REPEATC}) at each subterm until it fails. If a subterm {t} is changed (except for alpha-equivalence) by virtue of the application of {c} to its own subterms, then the term into which {t} is transformed is retraversed by applying {TOP_DEPTH_CONV c} to it. \FAILURE {TOP_DEPTH_CONV c tm} never fails but can diverge. \EXAMPLE Both {TOP_DEPTH_CONV} and {REDEPTH_CONV} repeatedly apply a conversion until no more applications are possible anywhere in the term. For example, {TOP_DEPTH_CONV BETA_CONV} or {REDEPTH_CONV BETA_CONV} will eliminate all beta redexes: { # TOP_DEPTH_CONV BETA_CONV `(\x. (\y. (\z. z + y) (y + 1)) (x + 2)) 3`;; val it : thm = |- (\x. (\y. (\z. z + y) (y + 1)) (x + 2)) 3 = ((3 + 2) + 1) + 3 + 2 } The main difference is that {TOP_DEPTH_CONV} proceeds top-down, whereas {REDEPTH_CONV} proceeds bottom-up. Reasons for preferring {TOP_DEPTH_CONV} might be that a transformation near the top obviates the need for transformations lower down. For example, this is quick because everything is done by one top-level rewrite: { # let conv = GEN_REWRITE_CONV I [MULT_CLAUSES] ORELSEC NUM_RED_CONV;; val conv : conv = # time (TOP_DEPTH_CONV conv) `0 * 25 EXP 100`;; CPU time (user): 0. val it : thm = |- 0 * 25 EXP 100 = 0 } \noindent whereas the following takes markedly longer: { # time (REDEPTH_CONV conv) `0 * 25 EXP 100`;; CPU time (user): 2.573 val it : thm = |- 0 * 25 EXP 100 = 0 } \SEEALSO DEPTH_CONV, ONCE_DEPTH_CONV, REDEPTH_CONV, TOP_DEPTH_SQCONV, TOP_SWEEP_CONV. \ENDDOC hol-light/Help/TOP_DEPTH_SQCONV.doc000066400000000000000000000010751303454263000170060ustar00rootroot00000000000000\DOC TOP_DEPTH_SQCONV \TYPE {TOP_DEPTH_SQCONV : strategy} \SYNOPSIS Applies simplification top-down to all subterms, retraversing changed ones. \DESCRIBE HOL Light's simplification functions (e.g. {SIMP_TAC}) have their traversal algorithm controlled by a ``strategy''. {TOP_DEPTH_SQCONV} is a strategy corresponding to {TOP_DEPTH_CONV} for ordinary conversions: simplification is applied top-down to all subterms, retraversing changed ones. \FAILURE Not applicable. \SEEALSO DEPTH_SQCONV, ONCE_DEPTH_SQCONV, REDEPTH_SQCONV, TOP_DEPTH_CONV, TOP_SWEEP_SQCONV. \ENDDOC hol-light/Help/TOP_SWEEP_CONV.doc000066400000000000000000000020471303454263000165610ustar00rootroot00000000000000\DOC TOP_SWEEP_CONV \TYPE {TOP_SWEEP_CONV : conv -> conv} \SYNOPSIS Repeatedly applies a conversion top-down at all levels, but after descending to subterms, does not return to higher ones. \DESCRIBE The call {TOP_SWEEP_CONV conv} applies {conv} repeatedly at the top level of a term, and then descends into subterms of the result, recursively doing the same thing. However, once the subterms are dealt with, it does not, unlike {TOP_DEPTH_CONV conv}, return to re-examine them. \FAILURE Never fails. \EXAMPLE If we create an equation between large tuples: { # let tm = let pairup x i t = mk_pair(mk_var(x^string_of_int i,aty),t) in let mkpairs x = itlist (pairup x) (1--200) (mk_var(x,aty)) in mk_eq(mkpairs "x",mkpairs "y");; ... } \noindent we can observe that { # time (TOP_DEPTH_CONV(REWR_CONV PAIR_EQ)); ();; } \noindent is a little bit slower than { # time (TOP_SWEEP_CONV(REWR_CONV PAIR_EQ)); ();; } \SEEALSO DEPTH_CONV, ONCE_DEPTH_CONV, REDEPTH_CONV, TOP_DEPTH_CONV. \ENDDOC hol-light/Help/TOP_SWEEP_SQCONV.doc000066400000000000000000000012071303454263000170220ustar00rootroot00000000000000\DOC TOP_SWEEP_SQCONV \TYPE {TOP_SWEEP_SQCONV : strategy} \SYNOPSIS Applies simplification top-down at all levels, but after descending to subterms, does not return to higher ones. \DESCRIBE HOL Light's simplification functions (e.g. {SIMP_TAC}) have their traversal algorithm controlled by a ``strategy''. {TOP_SWEEP_SQCONV} is a strategy corresponding to {TOP_SWEEP_CONV} for ordinary conversions: simplification is applied top-down at all levels, but after descending to subterms, does not return to higher ones. \FAILURE Not applicable. \SEEALSO DEPTH_SQCONV, ONCE_DEPTH_SQCONV, REDEPTH_SQCONV, TOP_DEPTH_SQCONV, TOP_SWEEP_CONV. \ENDDOC hol-light/Help/TRANS.doc000066400000000000000000000024201303454263000152110ustar00rootroot00000000000000\DOC TRANS \TYPE {TRANS : thm -> thm -> thm} \SYNOPSIS Uses transitivity of equality on two equational theorems. \KEYWORDS rule, transitivity, equality. \DESCRIBE When applied to a theorem {A1 |- t1 = t2} and a theorem {A2 |- t2' = t3}, where {t2} and {t2'} are alpha-equivalent (in particular, where they are identical), the inference rule {TRANS} returns the theorem {A1 u A2 |- t1 = t3}. { A1 |- t1 = t2 A2 |- t2' = t3 -------------------------------- TRANS A1 u A2 |- t1 = t3 } \FAILURE Fails unless the theorems are equational, with the right side of the first being the same as the left side of the second, up to alpha-equivalence. \EXAMPLE The following shows identical uses of {TRANS}, one on Boolean equations (shown as {<=>}) and one on numerical equations. { # let t1 = ASSUME `a:bool = b` and t2 = ASSUME `b:bool = c`;; val t1 : thm = a <=> b |- a <=> b val t2 : thm = b <=> c |- b <=> c # TRANS t1 t2;; val it : thm = a <=> b, b <=> c |- a <=> c # let t1 = ASSUME `x:num = 1` and t2 = num_CONV `1`;; val t1 : thm = x = 1 |- x = 1 val t2 : thm = |- 1 = SUC 0 # TRANS t1 t2;; val it : thm = x = 1 |- x = SUC 0 } \COMMENTS This is one of HOL Light's 10 primitive inference rules. \SEEALSO EQ_MP, IMP_TRANS, REFL, SYM, TRANS_TAC. \ENDDOC hol-light/Help/TRANS_TAC.doc000066400000000000000000000031071303454263000157030ustar00rootroot00000000000000\DOC TRANS_TAC \TYPE {TRANS_TAC : thm -> term -> tactic} \SYNOPSIS Applies transitivity theorem to goal with chosen intermediate term. \KEYWORDS tactic, modus ponens, implication. \DESCRIBE When applied to a `transitivity' theorem, i.e. one of the form { |- !xs. R1 x y /\ R2 y z ==> R3 x z } \noindent and a term {t}, {TRANS_TAC} produces a tactic that reduces a goal with conclusion of the form {R3 s u} to one with conclusion {R1 s t /\ R2 t u}. { A ?- R3 s u ======================== TRANS_TAC (|- !xs. R1 x y /\ R2 y z ==> R3 x z) `t` A ?- R1 s t /\ R2 t u } \EXAMPLE Consider the simple inequality goal: { # g `n < (m + 2) * (n + 1)`;; } We can use the following transitivity theorem { # LET_TRANS;; val it : thm = |- !m n p. m <= n /\ n < p ==> m < p } { # e(TRANS_TAC LET_TRANS `1 * (n + 1)`);; val it : goalstack = 1 subgoal (1 total) `n <= 1 * (n + 1) /\ 1 * (n + 1) < (m + 2) * (n + 1)` } \FAILURE Fails unless the input theorem is of the expected form (some of the relations {R1}, {R2} and {R3} may be, and often are, the same) and the conclusion matches the goal, in the usual sense of higher-order matching. \COMMENTS The effect of {TRANS_TAC th t} can often be replicated by the more primitive tactic sequence {MATCH_MP_TAC th THEN EXISTS_TAC t}. The use of {TRANS_TAC} is not only less verbose, but it is also more general in that it ensures correct type-instantiation of the theorem, whereas in highly polymorphic theorems the use of {MATCH_MP_TAC} may leave the wrong types for the subsequent {EXISTS_TAC} step. \SEEALSO MATCH_MP_TAC, TRANS. \ENDDOC hol-light/Help/TRY.doc000066400000000000000000000020731303454263000150040ustar00rootroot00000000000000\DOC TRY \TYPE {TRY : tactic -> tactic} \SYNOPSIS Makes a tactic have no effect rather than fail. \KEYWORDS tactical, failure. \DESCRIBE For any tactic {t}, the application {TRY t} gives a new tactic which has the same effect as {t} if that succeeds, and otherwise has no effect. \FAILURE The application of {TRY} to a tactic never fails. The resulting tactic never fails. \EXAMPLE We might want to try a certain tactic ``speculatively'', even if we're not sure that it will work, for example, to handle the ``easy'' subgoals from breaking apart a large conjunction. On a small scale, we might want to prove: { # g `(x + 1) EXP 2 = x EXP 2 + 2 * x + 1 /\ (x EXP 2 = y EXP 2 ==> x = y) /\ (x < y ==> 2 * x + 1 < 2 * y)`;; ... } \noindent and just see which conjuncts we can get rid of automatically by {ARITH_TAC}. It turns out that it only leaves one subgoal with some nonlinear reasoning: { # e(REPEAT CONJ_TAC THEN TRY ARITH_TAC);; val it : goalstack = 1 subgoal (1 total) `x EXP 2 = y EXP 2 ==> x = y` } \SEEALSO CHANGED_TAC, VALID. \ENDDOC hol-light/Help/TRY_CONV.doc000066400000000000000000000010231303454263000156230ustar00rootroot00000000000000\DOC TRY_CONV \TYPE {TRY_CONV : conv -> conv} \SYNOPSIS Attempts to apply a conversion; applies identity conversion in case of failure. \KEYWORDS conversion, failure. \DESCRIBE {TRY_CONV c `t`} attempts to apply the conversion {c} to the term {`t`}; if this fails, then the identity conversion is applied instead giving the reflexive theorem {|- t = t}. \FAILURE Never fails. \EXAMPLE { # num_CONV `0`;; Exception: Failure "num_CONV". # TRY_CONV num_CONV `0`;; val it : thm = |- 0 = 0 } \SEEALSO ALL_CONV. \ENDDOC hol-light/Help/UNDISCH.doc000066400000000000000000000007341303454263000154250ustar00rootroot00000000000000\DOC UNDISCH \TYPE {UNDISCH : thm -> thm} \SYNOPSIS Undischarges the antecedent of an implicative theorem. \KEYWORDS rule, undischarge, antecedent. \DESCRIBE { A |- t1 ==> t2 ---------------- UNDISCH A, t1 |- t2 } \FAILURE {UNDISCH} will fail on theorems which are not implications. \EXAMPLE { # UNDISCH(TAUT `p /\ q ==> p`);; val it : thm = p /\ q |- p } \SEEALSO DISCH, DISCH_ALL, DISCH_TAC, DISCH_THEN, STRIP_TAC, UNDISCH_ALL, UNDISCH_TAC. \ENDDOC hol-light/Help/UNDISCH_ALL.doc000066400000000000000000000012061303454263000161100ustar00rootroot00000000000000\DOC UNDISCH_ALL \TYPE {UNDISCH_ALL : thm -> thm} \SYNOPSIS Iteratively undischarges antecedents in a chain of implications. \KEYWORDS rule, undischarge, antecedent. \DESCRIBE { A |- t1 ==> ... ==> tn ==> t ------------------------------ UNDISCH_ALL A, t1, ..., tn |- t } \FAILURE Unlike {UNDISCH}, {UNDISCH_ALL} will, when called on something other than an implication, return its argument unchanged rather than failing. \EXAMPLE { # UNDISCH_ALL(TAUT `p ==> q ==> r ==> p /\ q /\ r`);; val it : thm = p, q, r |- p /\ q /\ r } \SEEALSO DISCH, DISCH_ALL, DISCH_TAC, DISCH_THEN, STRIP_TAC, UNDISCH, UNDISCH_TAC. \ENDDOC hol-light/Help/UNDISCH_TAC.doc000066400000000000000000000007541303454263000161160ustar00rootroot00000000000000\DOC UNDISCH_TAC \TYPE {UNDISCH_TAC : term -> tactic} \SYNOPSIS Undischarges an assumption. \KEYWORDS tactic, discharge. \DESCRIBE { A ?- t ==================== UNDISCH_TAC `v` A - {{v}} ?- v ==> t } \FAILURE {UNDISCH_TAC} will fail if {`v`} is not an assumption. \COMMENTS {UNDISCH}arging {`v`} will remove all assumptions that are alpha-equivalent to {`v`}. \SEEALSO DISCH, DISCH_ALL, DISCH_TAC, DISCH_THEN, STRIP_TAC, UNDISCH, UNDISCH_ALL, UNDISCH_THEN. \ENDDOC hol-light/Help/UNDISCH_THEN.doc000066400000000000000000000012351303454263000162400ustar00rootroot00000000000000\DOC UNDISCH_THEN \TYPE {UNDISCH_THEN : term -> thm_tactic -> tactic} \SYNOPSIS Undischarges an assumption and applies theorem-tactic to it. \DESCRIBE The tactic {UNDISCH_THEN `a` ttac} applied to a goal {A |- t} takes {a} out of the assumptions to give a goal {A - {{a}} |- t}, and applies the theorem-tactic {ttac} to the assumption {.. |- a} and that new goal. \FAILURE Fails if {a} is not an assumption; when applied to the goal it fails exactly if the theorem-tactic fails on the modified goal. \COMMENTS The tactic {UNDISCH_TAC `t`} can be considered the special case of {UNDISCH_THEN `t` MP_TAC}. \SEEALSO FIND_ASSUM, FIRST_X_ASSUM, UNDISCH_TAC. \ENDDOC hol-light/Help/UNIFY_ACCEPT_TAC.doc000066400000000000000000000040221303454263000167220ustar00rootroot00000000000000\DOC UNIFY_ACCEPT_TAC \TYPE {UNIFY_ACCEPT_TAC : term list -> thm -> 'a * term -> ('b list * instantiation) * 'c list * (instantiation -> 'd list -> thm)} \SYNOPSIS Unify free variables in theorem and metavariables in goal to accept theorem. \DESCRIBE Given a list {l} of assignable metavariables, a theorem {th} of the form {A |- t} and a goal {A' ?- t'}, the tactic {UNIFY_ACCEPT_TAC} attempts to unify {t} and {t'} by instantiating free variables in {t} and metavariables in the list {l} in the goal {t'} so that they match, then accepts the theorem as the solution of the goal. \FAILURE Fails if no unification will work. In fact, type instantiation is not at present included in the unification. \EXAMPLE An inherently uninteresting but instructive example is the goal: { # g `(?x:num. p(x) /\ q(x) /\ r(x)) ==> ?y. p(y) /\ (q(y) <=> r(y))`;; } \noindent which could of course be solved directly by {MESON_TAC[]} or {ITAUT_TAC}. In fact, the process we will outline is close to what {ITAUT_TAC} does automatically. Let's start with: { # e STRIP_TAC;; val it : goalstack = 1 subgoal (1 total) 0 [`p x`] 1 [`q x`] 2 [`r x`] `?y. p y /\ (q y <=> r y)` } \noindent and defer the actual choice of existential witness by introducing a metavariable: { # e (X_META_EXISTS_TAC `n:num` THEN CONJ_TAC);; val it : goalstack = 2 subgoals (2 total) 0 [`p x`] 1 [`q x`] 2 [`r x`] `q n <=> r n` 0 [`p x`] 1 [`q x`] 2 [`r x`] `p n` } \noindent Now we finally fix the metavariable to match our assumption: { # e(FIRST_X_ASSUM(UNIFY_ACCEPT_TAC [`n:num`]));; val it : goalstack = 1 subgoal (1 total) 0 [`p x`] 1 [`q x`] 2 [`r x`] `q x <=> r x` } \noindent Note that the metavariable has also been correspondingly instantiated in the remaining goal, which we can solve easily: { # e(ASM_REWRITE_TAC[]);; val it : goalstack = No subgoals } \USES Terminating proof search when using metavariables. Used in {ITAUT_TAC} \SEEALSO ACCEPT_TAC, ITAUT, ITAUT_TAC, MATCH_ACCEPT_TAC. \ENDDOC hol-light/Help/UNWIND_CONV.doc000066400000000000000000000016641303454263000161640ustar00rootroot00000000000000\DOC UNWIND_CONV \TYPE {UNWIND_CONV : term -> thm} \SYNOPSIS Eliminates existentially quantified variables that are equated to something. \KEYWORDS conversion. \DESCRIBE The conversion {UNWIND_CONV}, applied to a formula with one or more existential quantifiers, eliminates any existential quantifiers where the body contains a conjunct equating its variable to some other term (with that variable not free in it). \FAILURE {UNWIND_CONV tm} fails if {tm} is not reducible according to that description. \EXAMPLE { # UNWIND_CONV `?a b c d. b = 7 /\ 2 = d /\ a + b + c + d = 97`;; val it : thm = |- (?a b c d. b = 7 /\ 2 = d /\ a + b + c + d = 97) <=> (?a c. a + 7 + c + 2 = 97) # UNWIND_CONV `?w x y z. w = z /\ x = 1 /\ x + y = z /\ y = 42`;; val it : thm = |- (?w x y z. w = z /\ x = 1 /\ x + y = z /\ y = 42) <=> T # UNWIND_CONV `x = 2`;; Exception: Failure "CHANGED_CONV". } \SEEALSO FORALL_UNWIND_CONV. \ENDDOC hol-light/Help/USE_THEN.doc000066400000000000000000000010571303454263000156010ustar00rootroot00000000000000\DOC USE_THEN \TYPE {USE_THEN : string -> thm_tactic -> tactic} \SYNOPSIS Apply a theorem tactic to named assumption. \DESCRIBE The tactic {USE_THEN "name" ttac} applies the theorem-tactic {ttac} to the assumption labelled {name} (or the first in the list if there is more than one). \FAILURE Fails if there is no assumption of that name or if the theorem-tactic fails when applied to it. \EXAMPLE See {LABEL_TAC} for an extended example. \USES Using an assumption identified by name. \SEEALSO ASSUME, FIND_ASSUM, HYP, LABEL_TAC, REMOVE_THEN. \ENDDOC hol-light/Help/VALID.doc000066400000000000000000000024051303454263000151640ustar00rootroot00000000000000\DOC VALID \TYPE {VALID : tactic -> tactic} \SYNOPSIS Tries to ensure that a tactic is valid. \KEYWORDS tactical. \DESCRIBE For any tactic {t}, the application {VALID t} gives a new tactic that does exactly the same as {t} except that it also checks validity of the tactic and will fail if it is violated. Validity means that the subgoals produced by {t} can, if proved, be used by the justification function given by {t} to construct a theorem corresponding to the original goal. This check is performed by actually creating, using {mk_fthm}, theorems corresponding to the subgoals, and seeing if the result of applying the justification function to them gives a theorem corresponding to the original goal. If it does, then {VALID t} simply applies {t}, and if not it fails. In principle, the extra dummy hypothesis used by {mk_fthm} (necessary to ensure logical soundness) could interfere with the mechanism of the tactic, but this never seems to happen. \COMMENTS You can always force validity checking whenever it is applied by using {VALID} on a tactic. But if the goal is initially proved by using the subgoal stack this is probably not necessary since {VALID} is already implicitly applied in the {e} (expand) function. \SEEALSO CHANGED_TAC, e, mk_fthm, TRY. \ENDDOC hol-light/Help/W.doc000066400000000000000000000003131303454263000145270ustar00rootroot00000000000000\DOC W \TYPE {W : ('a -> 'a -> 'b) -> 'a -> 'b} \SYNOPSIS Duplicates function argument : {W f x} = {f x x}. \KEYWORDS combinator, duplicate. \FAILURE Never fails. \SEEALSO C, F_F, I, K, o. \ENDDOC hol-light/Help/WEAK_CNF_CONV.doc000066400000000000000000000021211303454263000163620ustar00rootroot00000000000000\DOC WEAK_CNF_CONV \TYPE {WEAK_CNF_CONV : conv} \SYNOPSIS Converts a term already in negation normal form into conjunctive normal form. \DESCRIBE When applied to a term already in negation normal form (see {NNF_CONV}), meaning that all other propositional connectives have been eliminated in favour of conjunction, disjunction and negation, and negation is only applied to atomic formulas, {WEAK_CNF_CONV} puts the term into an equivalent conjunctive normal form, which is a conjunction of disjunctions. \FAILURE Never fails; non-Boolean terms will just yield a reflexive theorem. \EXAMPLE { # WEAK_CNF_CONV `(a /\ b) \/ (a /\ b /\ c) \/ d`;; val it : thm = |- a /\ b \/ a /\ b /\ c \/ d <=> ((a \/ a \/ d) /\ (b \/ a \/ d)) /\ ((a \/ b \/ d) /\ (b \/ b \/ d)) /\ (a \/ c \/ d) /\ (b \/ c \/ d) } \COMMENTS The ordering and associativity of the resulting form are not guaranteed, and it may contain duplicates. See {CNF_CONV} for a stronger (but somewhat slower) variant where this is important. \SEEALSO CNF_CONV, DNF_CONV, NNF_CONV, WEAK_DNF_CONV. \ENDDOC hol-light/Help/WEAK_DNF_CONV.doc000066400000000000000000000017751303454263000164010ustar00rootroot00000000000000\DOC WEAK_DNF_CONV \TYPE {WEAK_DNF_CONV : conv} \SYNOPSIS Converts a term already in negation normal form into disjunctive normal form. \DESCRIBE When applied to a term already in negation normal form (see {NNF_CONV}), meaning that all other propositional connectives have been eliminated in favour of disjunction, disjunction and negation, and negation is only applied to atomic formulas, {WEAK_DNF_CONV} puts the term into an equivalent disjunctive normal form, which is a disjunction of conjunctions. \FAILURE Never fails; non-Boolean terms will just yield a reflexive theorem. \EXAMPLE { # WEAK_DNF_CONV `(a \/ b) /\ (a \/ c /\ e)`;; val it : thm = |- (a \/ b) /\ (a \/ c /\ e) <=> (a /\ a \/ b /\ a) \/ a /\ c /\ e \/ b /\ c /\ e } \COMMENTS The ordering and associativity of the resulting form are not guaranteed, and it may contain duplicates. See {DNF_CONV} for a stronger (but somewhat slower) variant where this is important. \SEEALSO CNF_CONV, DNF_CONV, NNF_CONV, WEAK_CNF_CONV. \ENDDOC hol-light/Help/WF_INDUCT_TAC.doc000066400000000000000000000035111303454263000163750ustar00rootroot00000000000000\DOC WF_INDUCT_TAC \TYPE {WF_INDUCT_TAC : term -> (string * thm) list * term -> goalstate} \SYNOPSIS Performs wellfounded induction with respect to a given `measure'. \DESCRIBE The tactic {WF_INDUCT_TAC} is applied to two arguments. The second is a goal to prove, and the first is an expression to use as a ``measure''. The result is a new subgoal where the same goal is to be proved but as an assumption it holds for all smaller values of the measure, universally quantified over the free variables in the measure term (which should also be free in the goal). \FAILURE Never fails. \EXAMPLE Suppose we define a Euclidean GCD algorithm: { # let egcd = define `egcd(m,n) = if m = 0 then n else if n = 0 then m else if m <= n then egcd(m,n - m) else egcd(m - n,n)`;; } \noindent and after picking up from the library an infix `{divides}' relation for divisibility: { # needs "Library/prime.ml";; } \noindent we want to prove something about the result, e.g. { # g `!m n d. d divides egcd(m,n) <=> d divides m /\ d divides n`;; } \noindent A natural way to proceed is by induction on the sum of the arguments: { # e(GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `m + n`);; val it : goalstack = 1 subgoal (1 total) 0 [`!m'' n'. m'' + n' < m + n ==> (!d. d divides egcd (m'',n') <=> d divides m'' /\ d divides n')`] `!d. d divides egcd (m,n) <=> d divides m /\ d divides n` } \noindent Note that we have the same goal, but an assumption that it holds for smaller values of the measure term. \COMMENTS Wellfounded induction can always be performed on any relation by using {WF_IND} together with an assumption of wellfoundedness such as {num_WF} or {WF_MEASURE}. This tactic is just a slightly more convenient packaging. \SEEALSO INDUCT_TAC, LIST_INDUCT_TAC. \ENDDOC hol-light/Help/X_CHOOSE_TAC.doc000066400000000000000000000025651303454263000162720ustar00rootroot00000000000000\DOC X_CHOOSE_TAC \TYPE {X_CHOOSE_TAC : term -> thm_tactic} \SYNOPSIS Assumes a theorem, with existentially quantified variable replaced by a given witness. \KEYWORDS tactic, witness, quantifier, existential. \DESCRIBE {X_CHOOSE_TAC} expects a variable {y} and theorem with an existentially quantified conclusion. When applied to a goal, it adds a new assumption obtained by introducing the variable {y} as a witness for the object {x} whose existence is asserted in the theorem. { A ?- t =================== X_CHOOSE_TAC `y` (A1 |- ?x. w) A u {{w[y/x]}} ?- t (`y` not free anywhere) } \FAILURE Fails if the theorem's conclusion is not existentially quantified, or if the first argument is not a variable. Failures may arise in the tactic-generating function. An invalid tactic is produced if the introduced variable is free in {w} or {t}, or if the theorem has any hypothesis which is not alpha-convertible to an assumption of the goal. \EXAMPLE Given a goal: { # g `(?y. x = y + 2) ==> x < x * x`;; } \noindent the following may be applied: { # e(DISCH_THEN(X_CHOOSE_TAC `d:num`));; val it : goalstack = 1 subgoal (1 total) 0 [`x = d + 2`] `x < x * x` } \noindent after which the following will finish things: { # e(ASM_REWRITE_TAC[] THEN ARITH_TAC);; val it : goalstack = No subgoals } \SEEALSO CHOOSE, CHOOSE_THEN, X_CHOOSE_THEN. \ENDDOC hol-light/Help/X_CHOOSE_THEN.doc000066400000000000000000000041061303454263000164120ustar00rootroot00000000000000\DOC X_CHOOSE_THEN \TYPE {X_CHOOSE_THEN : term -> thm_tactical} \SYNOPSIS Replaces existentially quantified variable with given witness, and passes it to a theorem-tactic. \KEYWORDS theorem-tactic, quantifier, existential. \DESCRIBE {X_CHOOSE_THEN} expects a variable {y}, a tactic-generating function {ttac}, and a theorem of the form {(A1 |- ?x. w)} as arguments. A new theorem is created by introducing the given variable {y} as a witness for the object {x} whose existence is asserted in the original theorem, {(w[y/x] |- w[y/x])}. If the tactic-generating function {ttac} applied to this theorem produces results as follows when applied to a goal {(A ?- t)}: { A ?- t ========= ttac ({{w[y/x]}} |- w[y/x]) A ?- t1 } \noindent then applying {(X_CHOOSE_THEN `y` ttac (A1 |- ?x. w))} to the goal {(A ?- t)} produces the subgoal: { A ?- t ========= X_CHOOSE_THEN `y` ttac (A1 |- ?x. w) A ?- t1 (`y` not free anywhere) } \FAILURE Fails if the theorem's conclusion is not existentially quantified, or if the first argument is not a variable. Failures may arise in the tactic-generating function. An invalid tactic is produced if the introduced variable is free in {w} or {t}, or if the theorem has any hypothesis which is not alpha-convertible to an assumption of the goal. \EXAMPLE Suppose we have the following goal: { # g `!m n. m < n ==> m EXP 2 + 2 * m <= n EXP 2`;; } \noindent and rewrite with a theorem to get an existential antecedent: { # e(REPEAT GEN_TAC THEN REWRITE_TAC[LT_EXISTS]);; val it : goalstack = 1 subgoal (1 total) `(?d. n = m + SUC d) ==> m EXP 2 + 2 * m <= n EXP 2` } \noindent we may then use {X_CHOOSE_THEN} to introduce the name {e} for the existential variable and immediately substitute it in the goal: { # e(DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST1_TAC));; val it : goalstack = 1 subgoal (1 total) `m EXP 2 + 2 * m <= (m + SUC e) EXP 2` } \noindent at which point {ARITH_TAC} will finish it. \SEEALSO CHOOSE, CHOOSE_THEN, CONJUNCTS_THEN, CONJUNCTS_THEN2, DISJ_CASES_THEN, DISJ_CASES_THEN2, STRIP_THM_THEN, X_CHOOSE_TAC. \ENDDOC hol-light/Help/X_GEN_TAC.doc000066400000000000000000000016171303454263000157200ustar00rootroot00000000000000\DOC X_GEN_TAC \TYPE {X_GEN_TAC : term -> tactic} \SYNOPSIS Specializes a goal with the given variable. \KEYWORDS tactic. \DESCRIBE When applied to a term {x'}, which should be a variable, and a goal {A ?- !x. t}, the tactic {X_GEN_TAC} returns the goal {A ?- t[x'/x]}. { A ?- !x. t ============== X_GEN_TAC `x'` A ?- t[x'/x] } \FAILURE Fails unless the goal's conclusion is universally quantified and the term a variable of the appropriate type. It also fails if the variable given is free in either the assumptions or (initial) conclusion of the goal. \USES It is perhaps good practice to use this rather than {GEN_TAC}, to ensure that there is no dependency on the bound variable name in the goal, which can sometimes arise somewhat arbitrarily, e.g. in higher-order matching. \SEEALSO FIX_TAC, GEN, GENL, GEN_ALL, GEN_TAC, INTRO_TAC, SPEC, SPECL, SPEC_ALL, SPEC_TAC, STRIP_TAC. \ENDDOC hol-light/Help/X_META_EXISTS_TAC.doc000066400000000000000000000017151303454263000171330ustar00rootroot00000000000000\DOC X_META_EXISTS_TAC \TYPE {X_META_EXISTS_TAC : term -> tactic} \SYNOPSIS Replaces existentially quantified variable with given metavariables. \DESCRIBE Given a variable {v} and a goal of the form {A ?- ?x. t[x]}, the tactic {X_META_EXISTS_TAC} gives the new goal {A ?- t[v]} where {v} is a new metavariable. In the resulting proof, it is as if the variable has been assigned here to the later choice for this metavariable, which can be made through {UNIFY_ACCEPT_TAC}. \FAILURE Fails if the metavariable is not a variable. \EXAMPLE See {UNIFY_ACCEPT_TAC} for an example of using metavariables. \USES Delaying instantiations until the correct term becomes clearer. \COMMENTS Users should probably steer clear of using metavariables if possible. Note that the metavariable instantiations apply across the whole fringe of goals, not just the current goal, and can lead to confusion. \SEEALSO EXISTS_TAC, META_EXISTS_TAC, META_SPEC_TAC, UNIFY_ACCEPT_TAC. \ENDDOC hol-light/Help/a.doc000066400000000000000000000016341303454263000145500ustar00rootroot00000000000000\DOC a \TYPE {a : 'a -> 'a list -> 'a * 'a list} \SYNOPSIS Parser that requires a specific item. \DESCRIBE The call {a x} gives a parser that parses a single item that is exactly {x}, raising {Noparse} if the first item is something different. \FAILURE The call {a x} never fails, though the resulting parser may raise {Noparse}. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, atleast, elistof, finished, fix, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/aconv.doc000066400000000000000000000017211303454263000154330ustar00rootroot00000000000000\DOC aconv \TYPE {aconv : term -> term -> bool} \SYNOPSIS Tests for alpha-convertibility of terms. \KEYWORDS alpha. \DESCRIBE When applied to two terms, {aconv} returns {true} if they are alpha-convertible, and {false} otherwise. \FAILURE Never fails. \EXAMPLE A simple case of alpha-convertibility is the renaming of a single quantified variable: { # aconv `?x. x <=> T` `?y. y <=> T`;; val it : bool = true } but other cases can be more involved: { # aconv `\x y z. x + y + z` `\y x z. y + x + z`;; val it : bool = true } \COMMENTS The code for alpha-conversion first checks for simple equality with pointer equality shortcutting, and can therefore often returns {true} without a full traversal. In principle, most of the HOL Light deductive apparatus should work modulo alpha-conversion. With the exception of {BETA}, all the primitive inference rules do, as does {BETA_CONV}, which properly generalizes {BETA}. \SEEALSO ALPHA, ALPHA_CONV, alphaorder. \ENDDOC hol-light/Help/allpairs.doc000066400000000000000000000007761303454263000161450ustar00rootroot00000000000000\DOC allpairs \TYPE {allpairs : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list} \SYNOPSIS Compute list of all results from applying function to pairs from two lists. \DESCRIBE The call {allpairs f [x1;...;xm] [y1;...;yn]} returns the list of results {[f x1 y1; f x1 y2; ... ; f x1 yn; f x2 y1; ...; f xm yn]}. \FAILURE Never fails. \EXAMPLE { # allpairs (fun x y -> (x,y)) [1;2;3] [4;5];; val it : (int * int) list = [(1, 4); (1, 5); (2, 4); (2, 5); (3, 4); (3, 5)] } \SEEALSO map2, zip. \ENDDOC hol-light/Help/alpha.doc000066400000000000000000000012431303454263000154110ustar00rootroot00000000000000\DOC alpha \TYPE {alpha : term -> term -> term} \SYNOPSIS Changes the name of a bound variable. \DESCRIBE The call {alpha `v'` `\v. t[v]`} returns the second argument with the top bound variable changed to {v'}, and other variables renamed if necessary. \FAILURE Fails if the first term is not a variable, or if the second is not an abstraction, if the corresponding types are not the same, or if the desired new variable is already free in the abstraction. \EXAMPLE { # alpha `y:num` `\x y. x + y + 2`;; val it : term = `\y y'. y + y' + 2` # alpha `y:num` `\x. x + y + 1`;; Exception: Failure "alpha: Invalid new variable". } \SEEALSO ALPHA, aconv. \ENDDOC hol-light/Help/alphaorder.doc000066400000000000000000000020631303454263000164460ustar00rootroot00000000000000\DOC alphaorder \TYPE {alphaorder : term -> term -> int} \SYNOPSIS Total ordering on terms respecting alpha-equivalence. \KEYWORDS alpha. \DESCRIBE The function {alphaorder} implements a total order on terms, using {-1}, {0} or {+1} to indicate that the first term argument is respectively `less than', `equal to' or `greater than' the second term argument. The ordering is largely arbitrary, but it is transitive and (in contrast to the inbuilt OCaml polymorphic ordering) respects alpha-equivalence, i.e. returns {0} if and only if the two terms are alpha-convertible. \FAILURE Never fails. \EXAMPLE Any two terms can be compared, and swapping the arguments negates the result: { # alphaorder `x + 1` `p ==> q`;; val it : int = -1 # alphaorder `p ==> q` `x + 1`;; val it : int = 1 } \noindent while alpha-equivalent terms, and only alpha-convertible terms, are `equal': { # alphaorder `!x. ?y. x + 1 < y` `!y. ?z. y + 1 < z`;; val it : int = 0 # alphaorder `!x. ?y. x + 1 < y` `!x. ?y. x + 1 < y + 1`;; val it : int = -1 } \SEEALSO aconv. \ENDDOC hol-light/Help/apply.doc000066400000000000000000000013631303454263000154540ustar00rootroot00000000000000\DOC apply \TYPE {apply : ('a, 'b) func -> 'a -> 'b} \SYNOPSIS Applies a finite partial function, failing on undefined points. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} is a finite partial function and {x} an argument, {apply f x} tries to apply {f} to {x} and fails if it is undefined. \EXAMPLE { # apply undefined 1;; Exception: Failure "apply". # apply (1 |=> 2) 1;; val it : int = 2 } \SEEALSO |->, |=>, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/apply_prover.doc000066400000000000000000000023601303454263000170470ustar00rootroot00000000000000\DOC apply_prover \TYPE {apply_prover : prover -> term -> thm} \SYNOPSIS Apply a prover to a term. \DESCRIBE The HOL Light simplifier (e.g. as invoked by {SIMP_TAC}) allows provers of type {prover} to be installed into simpsets, to automatically dispose of side-conditions. These may maintain a state dynamically and augment it as more theorems become available (e.g. a theorem {p |- p} becomes available when simplifying the consequent of an implication {`p ==> q`}). In order to allow maximal flexibility in the data structure used to maintain state, provers are set up in an `object-oriented' style, where the context is part of the prover function itself. A call {apply_prover p `tm`} applies the prover with its current context to attempt to prove the term {tm}. \FAILURE The call {apply_prover p} never fails, but it may fail to prove the term. \USES Mainly intended for users customizing the simplifier. \COMMENTS I learned of this ingenious trick for maintaining context from Don Syme, who discovered it by reading some code written by Richard Boulton. I was told by Simon Finn that there are similar ideas in the functional language literature for simulating existential types. \SEEALSO augment, mk_prover, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/applyd.doc000066400000000000000000000016461303454263000156240ustar00rootroot00000000000000\DOC applyd \TYPE {applyd : ('a, 'b) func -> ('a -> 'b) -> 'a -> 'b} \SYNOPSIS Applies a finite partial function, with a backup function for undefined points. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} is a finite partial function, {g} a conventional function and {x} an argument, {tryapply f g x} tries to apply {f} to {x} as with {apply f x}, but instead returns {g x} is {f} is undefined on {x}. \FAILURE Can only fail if the backup function fails. \EXAMPLE { # applyd undefined (fun x -> x) 1;; val it : int = 1 # applyd (1 |=> 2) (fun x -> x) 1;; val it : int = 2 } \SEEALSO |->, |=>, apply, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/assoc.doc000066400000000000000000000007661303454263000154450ustar00rootroot00000000000000\DOC assoc \TYPE {assoc : 'a -> ('a * 'b) list -> 'b} \SYNOPSIS Searches a list of pairs for a pair whose first component equals a specified value. \KEYWORDS list. \DESCRIBE {assoc x [(x1,y1);...;(xn,yn)]} returns the first {yi} in the list such that {xi} equals {x}. \FAILURE Fails if no matching pair is found. This will always be the case if the list is empty. \EXAMPLE { # assoc 2 [1,4; 3,2; 2,5; 2,6];; val it : int = 5 } \SEEALSO rev_assoc, find, mem, tryfind, exists, forall. \ENDDOC hol-light/Help/assocd.doc000066400000000000000000000012221303454263000155750ustar00rootroot00000000000000\DOC assocd \TYPE {assocd : 'a -> ('a * 'b) list -> 'b -> 'b} \SYNOPSIS Looks up item in association list taking default in case of failure. \DESCRIBE The call {assocd x [x1,y1; ...; xn,yn] y} returns the first {yi} in the list where the corresponding {xi} is the same as {x}. If there is no such item, it returns the value {y}. This is similar to {assoc} except that the latter will fail rather than take a default. \FAILURE Never fails. \EXAMPLE { # assocd 2 [1,2; 2,4; 3,6] (-1);; val it : int = 4 # assocd 4 [1,2; 2,4; 3,6] (-1);; val it : int = -1 } \USES Simple lookup without exception handling. \SEEALSO assoc, rev_assocd. \ENDDOC hol-light/Help/atleast.doc000066400000000000000000000020131303454263000157550ustar00rootroot00000000000000\DOC atleast \TYPE {atleast : int -> ('a -> 'b * 'a) -> 'a -> 'b list * 'a} \SYNOPSIS Parses at least a given number of successive items using given parser. \DESCRIBE If {p} is a parser and {n} an integer, {atleast n p} is a new parser that attempts to parse at least {n} successive items using parser {p} and fails otherwise. Unless {n} is positive, this is equivalent to {many p}. \FAILURE The call to {atleast n p} itself never fails. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/aty.doc000066400000000000000000000006361303454263000151260ustar00rootroot00000000000000\DOC aty \TYPE {aty : hol_type} \SYNOPSIS The type variable {`:A`}. \DESCRIBE This name is bound to the HOL type {:A}. \FAILURE Not applicable. \USES Exploiting the very common type variable {:A} inside derived rules (e.g. an instantiation list for {inst} or {type_subst}) without the inefficiency or inconvenience of calling a quotation parser or explicit constructor. \SEEALSO bty, bool_ty. \ENDDOC hol-light/Help/augment.doc000066400000000000000000000023571303454263000157730ustar00rootroot00000000000000\DOC augment \TYPE {augment : prover -> thm list -> prover} \SYNOPSIS Augments a prover's context with new theorems. \DESCRIBE The HOL Light simplifier (e.g. as invoked by {SIMP_TAC}) allows provers of type {prover} to be installed into simpsets, to automatically dispose of side-conditions. These may maintain a state dynamically and augment it as more theorems become available (e.g. a theorem {p |- p} becomes available when simplifying the consequent of an implication {`p ==> q`}). In order to allow maximal flexibility in the data structure used to maintain state, provers are set up in an `object-oriented' style, where the context is part of the prover function itself. A call {augment p thl} maps a prover {p} to a new prover with theorems {thl} added to the initial state. \FAILURE Never fails unless the prover is abnormal. \USES This is mostly for experts wishing to customize the simplifier. \COMMENTS I learned of this ingenious trick for maintaining context from Don Syme, who discovered it by reading some code written by Richard Boulton. I was told by Simon Finn that there are similar ideas in the functional language literature for simulating existential types. \SEEALSO apply_prover, mk_prover, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/axioms.doc000066400000000000000000000013251303454263000156250ustar00rootroot00000000000000\DOC axioms \TYPE {axioms : unit -> thm list} \SYNOPSIS Returns the current set of axioms. \DESCRIBE A call {axioms()} returns the current list of axioms. \FAILURE Never fails. \EXAMPLE Under normal circumstances, the list of axioms will be as follows, containing the axioms of infinity, choice and extensionality. { # axioms();; val it : thm list = [|- ?f. ONE_ONE f /\ ~ONTO f; |- !P x. P x ==> P ((@) P); |- !t. (\x. t x) = t] } If other axioms are used, the consistency of the resulting theory cannot be guaranteed. However, new definitions and type definitions are always safe and are not considered as true `axioms'. \SEEALSO define, definitions, new_axiom, new_definition, the_definitions. \ENDDOC hol-light/Help/b.doc000066400000000000000000000020031303454263000145400ustar00rootroot00000000000000\DOC b \TYPE {b : unit -> goalstack} \SYNOPSIS Restores the proof state, undoing the effects of a previous expansion. \DESCRIBE The function {b} is part of the subgoal package. It allows backing up from the last state change (caused by calls to {e}, {g}, {r}, {set_goal} etc.) The package maintains a backup list of previous proof states. A call to {b} restores the state to the previous state (which was on top of the backup list). \FAILURE The function {b} will fail if the backup list is empty. \EXAMPLE { # g `(HD[1;2;3] = 1) /\ (TL[1;2;3] = [2;3])`;; val it : goalstack = 1 subgoal (1 total) `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` # e CONJ_TAC;; val it : goalstack = 2 subgoals (2 total) `TL [1; 2; 3] = [2; 3]` `HD [1; 2; 3] = 1` # b();; val it : goalstack = 1 subgoal (1 total) `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` } \USES Back tracking in a goal-directed proof to undo errors or try different tactics. \SEEALSO e, g, p, r, set_goal, top_goal, top_thm. \ENDDOC hol-light/Help/basic_congs.doc000066400000000000000000000025551303454263000166050ustar00rootroot00000000000000\DOC basic_congs \TYPE {basic_congs : unit -> thm list} \SYNOPSIS Lists the congruence rules used by the simplifier. \DESCRIBE The HOL Light simplifier (as invoked by {SIMP_TAC} etc.) uses congruence rules to determine how it uses context when descending through a term. These are essentially theorems showing how to decompose one equality to a series of other inequalities in context. A call to {basic_congs()} returns those congruences that are built into the system. \FAILURE Never fails. \EXAMPLE Here is the effect in HOL Light's initial state: { # basic_congs();; val it : thm list = [|- (!x. x IN s ==> f x = g x) ==> sum s (\i. f i) = sum s g; |- (!i. a <= i /\ i <= b ==> f i = g i) ==> sum (a..b) (\i. f i) = sum (a..b) g; |- (!x. p x ==> f x = g x) ==> sum {{y | p y}} (\i. f i) = sum {{y | p y}} g; |- (!x. x IN s ==> f x = g x) ==> nsum s (\i. f i) = nsum s g; |- (!i. a <= i /\ i <= b ==> f i = g i) ==> nsum (a..b) (\i. f i) = nsum (a..b) g; |- (!x. p x ==> f x = g x) ==> nsum {{y | p y}} (\i. f i) = nsum {{y | p y}} g; |- (g <=> g') ==> (g' ==> t = t') ==> (~g' ==> e = e') ==> (if g then t else e) = (if g' then t' else e'); |- (p <=> p') ==> (p' ==> (q <=> q')) ==> (p ==> q <=> p' ==> q')] } \SEEALSO extend_basic_congs, set_basic_congs, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/basic_convs.doc000066400000000000000000000022261303454263000166170ustar00rootroot00000000000000\DOC basic_convs \TYPE {basic_convs : unit -> (string * (term * conv)) list} \SYNOPSIS List the current default conversions used in rewriting and simplification. \DESCRIBE The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. A call to {basic_convs()} returns the current set of conversions. \FAILURE Never fails. \EXAMPLE In the default HOL Light state the only conversions are for generalized beta reduction and the reduction of pattern-matching constructs such as {match...with}. All the other default simplifications are done by rewrite rules. { # basic_convs();; val it : (string * (term * conv)) list = [("FUN_ONEPATTERN_CONV", (`_FUNCTION (\y z. P y z) x`, )); ("MATCH_ONEPATTERN_CONV", (`_MATCH x (\y z. P y z)`, )); ("FUN_SEQPATTERN_CONV", (`_FUNCTION (_SEQPATTERN r s) x`, )); ("MATCH_SEQPATTERN_CONV", (`_MATCH x (_SEQPATTERN r s)`, )); ("GEN_BETA_CONV", (`GABS (\a. b) c`, ))] } \SEEALSO basic_rewrites, extend_basic_convs, set_basic_convs. \ENDDOC hol-light/Help/basic_net.doc000066400000000000000000000012551303454263000162560ustar00rootroot00000000000000\DOC basic_net \TYPE {basic_net : unit -> gconv net} \SYNOPSIS Returns the term net used to optimize access to default rewrites and conversions. \DESCRIBE The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. Internally, these are maintained in a term net (see {enter} and {lookup} for more information), and a call to {basic_net()} returns that net. \FAILURE Never fails. \USES Only useful for those who are delving deep into the implementation of rewriting. \SEEALSO basic_convs, basic_rewrites, enter, lookup. \ENDDOC hol-light/Help/basic_prover.doc000066400000000000000000000015221303454263000170020ustar00rootroot00000000000000\DOC basic_prover \TYPE {basic_prover : (simpset -> 'a -> term -> thm) -> simpset -> 'a -> term -> thm} \SYNOPSIS The basic prover use function used in the simplifier. \DESCRIBE The HOL Light simplifier (e.g. as invoked by {SIMP_TAC}) allows provers of type {prover} to be installed into simpsets, to automatically dispose of side-conditions. There is another component of the simpset that controls how these are applied to unproven subgoals arising in simplification. The {basic_prover} function, which is used in all the standard simpsets, simply tries to simplify the goals with the rewrites as far as possible, then tries the provers one at a time on the resulting subgoals till one succeeds. \FAILURE Never fails, though the later application to a term may fail to prove it. \SEEALSO mk_prover, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/basic_rectype_net.doc000066400000000000000000000013211303454263000200030ustar00rootroot00000000000000\DOC basic_rectype_net \TYPE {basic_rectype_net : (int * (term -> thm)) net ref} \SYNOPSIS Net of injectivity and distinctness properties for recursive type constructors. \DESCRIBE HOL Light maintains a net of theorems used to simplify equations between elements of recursive datatypes; essentially these include injectivity and distinctness, e.g. {CONS_11} and {NOT_CONS_NIL} for lists. This net is used in some situations where such things need to be proved automatically, notably in {define}. A call to {basic_rectype_net()} returns that net. It is automatically updated whenever a type is defined by {define_type}. \FAILURE Never fails. \SEEALSO cases, define, distinctness, GEN_BETA_CONV, injectivity. \ENDDOC hol-light/Help/basic_rewrites.doc000066400000000000000000000034501303454263000173330ustar00rootroot00000000000000\DOC basic_rewrites \TYPE {basic_rewrites : unit -> thm list} \SYNOPSIS Returns the set of built-in theorems used, by default, in rewriting. \DESCRIBE The list of theorems returned by {basic_rewrites()} is applied by default in rewriting conversions, rules and tactics such as {ONCE_REWRITE_CONV}, {REWRITE_RULE} and {SIMP_TAC}, though not in the `pure' variants like {PURE_REWRITE_TAC}. This default set can be modified using {extend_basic_rewrites}, {set_basic_rewrites}. Other conversions, not necessarily expressible as rewriting with a theorem, can be added using {set_basic_convs} and {extend_basic_convs} and examined by {basic_convs}. \EXAMPLE The following shows the list of default rewrites in the standard HOL Light state. Most of them are basic logical tautologies. { # basic_rewrites();; val it : thm list = [|- FST (x,y) = x; |- SND (x,y) = y; |- FST x,SND x = x; |- (if x = x then y else z) = y; |- (if T then t1 else t2) = t1; |- (if F then t1 else t2) = t2; |- ~ ~t <=> t; |- ~T <=> F; |- ~F <=> T; |- (@y. y = x) = x; |- x = x <=> T; |- (T <=> t) <=> t; |- (t <=> T) <=> t; |- (F <=> t) <=> ~t; |- (t <=> F) <=> ~t; |- ~T <=> F; |- ~F <=> T; |- T /\ t <=> t; |- t /\ T <=> t; |- F /\ t <=> F; |- t /\ F <=> F; |- t /\ t <=> t; |- T \/ t <=> T; |- t \/ T <=> T; |- F \/ t <=> t; |- t \/ F <=> t; |- t \/ t <=> t; |- T ==> t <=> t; |- t ==> T <=> T; |- F ==> t <=> T; |- t ==> t <=> T; |- t ==> F <=> ~t; |- (!x. t) <=> t; |- (?x. t) <=> t; |- (\x. f x) y = f y; |- x = x ==> p <=> p] } \USES The {basic_rewrites} are included in the set of equations used by some of the rewriting tools. \SEEALSO extend_basic_rewrites, set_basic_rewrites, set_basic_convs, extend_basic_convs, basic_convs, REWRITE_CONV, REWRITE_RULE, REWRITE_TAC, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/basic_ss.doc000066400000000000000000000011121303454263000161050ustar00rootroot00000000000000\DOC basic_ss \TYPE {basic_ss : thm list -> simpset} \SYNOPSIS Construct a straightforward simpset from a list of theorems. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset'. A call {basic_ss thl} gives a straightforward simpset used by the default simplifier instances like {SIMP_TAC}, which has the given theorems as well as the basic rewrites and conversions, and no other provers. \FAILURE Never fails. \SEEALSO basic_convs, basic_rewrites, empty_ss, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/binders.doc000066400000000000000000000011041303454263000157460ustar00rootroot00000000000000\DOC binders \TYPE {binders : unit -> string list} \SYNOPSIS Lists the binders. \DESCRIBE The function {binders} returns a list of all the binders declared so far. A binder {b} is then parsed in constructs like {b x. t[x]} as an abbreviation for {(b) (\x. t[x])}. The set of binders can be changed with {parse_as_binder} and {unparse_as_binder}. \FAILURE Never fails \EXAMPLE { # binders();; val it : string list = ["\\"; "!"; "?"; "?!"; "@"; "minimal"; "lambda"] } \SEEALSO parse_as_binder, parses_as_binder, parse_as_infix, parse_as_prefix, unparse_as_binder. \ENDDOC hol-light/Help/binops.doc000066400000000000000000000013441303454263000156200ustar00rootroot00000000000000\DOC binops \TYPE {binops : term -> term -> term list} \SYNOPSIS Repeatedly breaks apart an iterated binary operator into components. \DESCRIBE The call {binops op t} repeatedly breaks down applications of the binary operator {op} within {t}. If {t} is of the form {(op l) r} (thinking of {op} as infix, {l op r}), then it recursively breaks down {l} and {r} in the same way and appends the results. Otherwise, a singleton list of the original term is returned. \FAILURE Never fails. \EXAMPLE { # binops `(+):num->num->num` `((1 + 2) + 3) + 4 + 5 + 6`;; val it : term list = [`1`; `2`; `3`; `4`; `5`; `6`] # binops `(+):num->num->num` `F`;; val it : term list = [`F`] } \SEEALSO dest_binop, mk_binop, striplist. \ENDDOC hol-light/Help/bndvar.doc000066400000000000000000000004461303454263000156040ustar00rootroot00000000000000\DOC bndvar \TYPE {bndvar : term -> term} \SYNOPSIS Returns the bound variable of an abstraction. \DESCRIBE {bndvar `\var. t`} returns {`var`}. \FAILURE Fails unless the term is an abstraction. \EXAMPLE { # bndvar `\x. x + 1`;; val it : term = `x` } \SEEALSO body, dest_abs. \ENDDOC hol-light/Help/body.doc000066400000000000000000000004301303454263000152560ustar00rootroot00000000000000\DOC body \TYPE {body : term -> term} \SYNOPSIS Returns the body of an abstraction. \DESCRIBE {body `\var. t`} returns {`t`}. \FAILURE Fails unless the term is an abstraction. \EXAMPLE { # body `\x. x + 1`;; val it : term = `x + 1` } \SEEALSO bndvar, dest_abs. \ENDDOC hol-light/Help/bool_ty.doc000066400000000000000000000005341303454263000157750ustar00rootroot00000000000000\DOC bool_ty \TYPE {bool_ty : hol_type} \SYNOPSIS The type {`:bool`}. \DESCRIBE This name is bound to the HOL type {:bool}. \FAILURE Not applicable. \USES Exploiting the very common type {:bool} inside derived rules without the inefficiency or inconvenience of calling a quotation parser or explicit constructor. \SEEALSO aty, bty. \ENDDOC hol-light/Help/bty.doc000066400000000000000000000006361303454263000151270ustar00rootroot00000000000000\DOC bty \TYPE {bty : hol_type} \SYNOPSIS The type variable {`:B`}. \DESCRIBE This name is bound to the HOL type {:B}. \FAILURE Not applicable. \USES Exploiting the very common type variable {:B} inside derived rules (e.g. an instantiation list for {inst} or {type_subst}) without the inefficiency or inconvenience of calling a quotation parser or explicit constructor. \SEEALSO aty, bool_ty. \ENDDOC hol-light/Help/butlast.doc000066400000000000000000000004151303454263000160020ustar00rootroot00000000000000\DOC butlast \TYPE {butlast : 'a list -> 'a list} \SYNOPSIS Computes the sub-list of a list consisting of all but the last element. \DESCRIBE {butlast [x1;...;xn]} returns {[x1;...;x(n-1)]}. \FAILURE Fails if the list is empty. \SEEALSO last, hd, tl, el. \ENDDOC hol-light/Help/by.doc000066400000000000000000000005021303454263000147330ustar00rootroot00000000000000\DOC by \TYPE {by : tactic -> refinement} \SYNOPSIS Converts a tactic to a refinement. \DESCRIBE The call {by tac} for a tactic {tac} gives a refinement of the current list of subgoals that applies {tac} to the first subgoal. \COMMENTS Only of interest to users who want to handle `refinements' explicitly. \ENDDOC hol-light/Help/can.doc000066400000000000000000000006031303454263000150640ustar00rootroot00000000000000\DOC can \TYPE {can : ('a -> 'b) -> 'a -> bool} \SYNOPSIS Tests for failure. \DESCRIBE {can f x} evaluates to {true} if the application of {f} to {x} succeeds. It evaluates to {false} if the application fails with a {Failure _} exception. \FAILURE Never fails. \EXAMPLE { # can hd [1;2];; val it : bool = true # can hd [];; val it : bool = false } \SEEALSO check. \ENDDOC hol-light/Help/cases.doc000066400000000000000000000014541303454263000154260ustar00rootroot00000000000000\DOC cases \TYPE {cases : string -> thm} \SYNOPSIS Produce cases theorem for an inductive type. \DESCRIBE A call {cases "ty"} where {"ty"} is the name of a recursive type defined with {define_type}, returns a ``cases'' theorem asserting that each element of the type is an instance of one of the type constructors. The effect is exactly the same is if {prove_cases_thm} were applied to the induction theorem produced by {define_type}, and the documentation for {prove_cases_thm} gives a lengthier discussion. \FAILURE Fails if {ty} is not the name of a recursive type. \EXAMPLE { # cases "num";; val it : thm = |- !m. m = 0 \/ (?n. m = SUC n) # cases "list";; val it : thm = |- !x. x = [] \/ (?a0 a1. x = CONS a0 a1) } \SEEALSO define_type, distinctness, injectivity, prove_cases_thm. \ENDDOC hol-light/Help/check.doc000066400000000000000000000011421303454263000153770ustar00rootroot00000000000000\DOC check \TYPE {check : ('a -> bool) -> 'a -> 'a} \SYNOPSIS Checks that a value satisfies a predicate. \DESCRIBE {check p x} returns {x} if the application {p x} yields {true}. Otherwise, {check p x} fails. \FAILURE {check p x} fails with {Failure "check"} if the predicate {p} yields {false} when applied to the value {x}. \EXAMPLE { # check is_var `x:bool`;; val it : term = `x` # check is_var `x + 2`;; Exception: Failure "check". } \USES Can be used to filter out candidates from a set of terms, e.g. to apply theorem-tactics to assumptions with a certain pattern. \SEEALSO can. \ENDDOC hol-light/Help/checkpoint.doc000066400000000000000000000015271303454263000164600ustar00rootroot00000000000000\DOC checkpoint \TYPE {checkpoint : string -> unit} \SYNOPSIS Exits HOL Light but saves current state ready to restart. \DESCRIBE This is only available in Linux. A call {checkpoint s} calls the {freeze} function from CryoPID to create a checkpoint of the current state of HOL Light, named {hol.snapshot}. When this image is restarted, the string {s} is printed as well as the usual startup banner. \FAILURE Never fails, except in the face of OS-level problems such as running out of disc space. \USES To quickly save the state of HOL Light when it would take a long time to regenerate. \COMMENTS Unfortunately I do not know of any checkpointing tool that can give this behaviour under Windows or Mac OS X. See the README file and tutorial for additional information on Linux checkpointing options. \SEEALSO self_destruct, startup_banner. \ENDDOC hol-light/Help/choose.doc000066400000000000000000000017701303454263000156110ustar00rootroot00000000000000\DOC choose \TYPE {choose : ('a, 'b) func -> 'a * 'b} \SYNOPSIS Picks an arbitrary element from the graph of a finite partial function. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} is a finite partial function, {choose f} picks an arbitrary pair of values from its graph, i.e. a pair {x,y} where {f} maps {x} to {y}. The particular choice is implementation-defined, and it is not likely to be the most obvious `first' value. \FAILURE Fails if and only if the finite partial function is completely undefined. \EXAMPLE { # let f = itlist I [1 |-> 2; 2 |-> 3; 3 |-> 4] undefined;; val f : (int, int) func = # choose f;; val it : int * int = (2, 3) } \SEEALSO |->, |=>, apply, applyd, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/chop_list.doc000066400000000000000000000006561303454263000163170ustar00rootroot00000000000000\DOC chop_list \TYPE {chop_list : int -> 'a list -> 'a list * 'a list} \SYNOPSIS Chops a list into two parts at a specified point. \DESCRIBE {chop_list i [x1;...;xn]} returns {([x1;...;xi],[x(i+1);...;xn])}. \FAILURE Fails with {chop_list} if {i} is negative or greater than the length of the list. \EXAMPLE { # chop_list 3 [1;2;3;4;5];; val it : int list * int list = ([1; 2; 3], [4; 5]) } \SEEALSO partition. \ENDDOC hol-light/Help/combine.doc000066400000000000000000000034561303454263000157500ustar00rootroot00000000000000\DOC combine \TYPE {combine : ('a -> 'a -> 'a) -> ('a -> bool) -> ('b, 'a) func -> ('b, 'a) func -> ('b, 'a) func} \SYNOPSIS Combine together two finite partial functions using pointwise operation. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} and {g} are finite partial functions, then {combine op z f g} will combine them together in the following somewhat complicated way. If just one of the functions {f} and {g} is defined at point {x}, that will give the value of the combined function. If both {f} and {g} are defined at {x} with values {y1} and {y2}, the value of the combined function will be {op y1 y2}. However, if the resulting value {y} satisfies the predicate {z}, the new function will be undefined at that point; the intuition is that the two values {y1} and {y2} cancel each other out. \FAILURE Can only fail if the given operation fails. \EXAMPLE { # let f = itlist I [1 |-> 2; 2 |-> 3; 3 |-> 6] undefined and g = itlist I [1 |-> 5; 2 |-> -3] undefined;; val f : (int, int) func = val g : (int, int) func = # graph(combine (+) (fun x -> x = 0) f g);; val it : (int * int) list = [(1, 7); (3, 6)] } \USES When finite partial functions are used to represent values with a numeric domain (e.g. matrices or polynomials), this can be used to perform addition pointwise by using addition for the {op} argument. Using a zero test as the predicate {z} will ensure that no zero values are included in the result, giving a canonical representation. \SEEALSO |->, |=>, apply, applyd, choose, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/comment_token.doc000066400000000000000000000024311303454263000171660ustar00rootroot00000000000000\DOC comment_token \TYPE {comment_token : lexcode ref} \SYNOPSIS HOL Light comment token. \DESCRIBE Users may insert comments in HOL Light terms that are ignored in parsing. Comments are introduced by a special comment token and terminated by the next end of line. (There are no multi-line comments supported in HOL Light terms.) The reference {comment_token} stores the token that introduces a comment, which by default is {Resword "//"} as in BCPL, C++, Java etc. The user may change it to another token, though this should be done with care in case other proofs break. \FAILURE Not applicable. \EXAMPLE Here we change the comment token to be `{--}' (as used in Ada, Eiffel, Haskell, Occam and several other programming languages): { # comment_token := Ident "--";; val it : unit = () } \noindent and we can test that it works: { # `let wordsize = 32 -- may change to 64 later and radix = 2 -- only care about binary in radix EXP wordsize`;; val it : term = `let wordsize = 32 and radix = 2 in radix EXP wordsize` } \COMMENTS Comments are handled at the level of the lexical analyzer, so can also be used in types and the strings used for the specification of inductive types. \SEEALSO define_type, lex, parse_inductive_type_specification, parse_term, parse_type. \ENDDOC hol-light/Help/compose_insts.doc000066400000000000000000000013431303454263000172120ustar00rootroot00000000000000\DOC compose_insts \TYPE {compose_insts : instantiation -> instantiation -> instantiation} \SYNOPSIS Compose two instantiations. \DESCRIBE Given two instantiations {i1} and {i2} (with type {instantiation}, as returned by {term_match} for example), the call {compose_insts i1 i2} will give a new instantiation that results from composing them, with {i1} applied first and then {i2}. For example, {instantiate (compose_insts i1 i2) t} should be the same as {instantiate i2 (instantiate i1 t)}. \FAILURE Never fails. \COMMENTS Mostly of specialized interest; used in sequencing tactics like {THEN} to compose metavariable instantiations. \SEEALSO instantiate, INSTANTIATE, INSTANTIATE_ALL, inst_goal, PART_MATCH, term_match. \ENDDOC hol-light/Help/concl.doc000066400000000000000000000006451303454263000154270ustar00rootroot00000000000000\DOC concl \TYPE {concl : thm -> term} \SYNOPSIS Returns the conclusion of a theorem. \DESCRIBE When applied to a theorem {A |- t}, the function {concl} returns {t}. \FAILURE Never fails. \EXAMPLE { # ADD_SYM;; val it : thm = |- !m n. m + n = n + m # concl ADD_SYM;; val it : term = `!m n. m + n = n + m` # concl (ASSUME `1 = 0`);; val it : term = `1 = 0` } \SEEALSO dest_thm, hyp. \ENDDOC hol-light/Help/conjuncts.doc000066400000000000000000000022211303454263000163270ustar00rootroot00000000000000\DOC conjuncts \TYPE {conjuncts : term -> term list} \SYNOPSIS Iteratively breaks apart a conjunction. \DESCRIBE If a term {t} is a conjunction {p /\ q}, then {conjuncts t} will recursively break down {p} and {q} into conjuncts and append the resulting lists. Otherwise it will return the singleton list {[t]}. So if {t} is of the form {t1 /\ ... /\ tn} with any reassociation, no {ti} itself being a conjunction, the list returned will be {[t1; ...; tn]}. But { conjuncts(list_mk_conj([t1;...;tn])) } \noindent will not return {[t1;...;tn]} if any of {t1},...,{tn} is a conjunction. \FAILURE Never fails, even if the term is not boolean. \EXAMPLE { # conjuncts `((p /\ q) /\ r) /\ ((p /\ s /\ t) /\ u)`;; val it : term list = [`p`; `q`; `r`; `p`; `s`; `t`; `u`] # conjuncts(list_mk_conj [`a /\ b`; `c:bool`; `d /\ e /\ f`]);; val it : term list = [`a`; `b`; `c`; `d`; `e`; `f`] } \COMMENTS Because {conjuncts} splits both the left and right sides of a conjunction, this operation is not the inverse of {list_mk_conj}. You can also use {splitlist dest_conj} to split in a right-associated way only. \SEEALSO dest_conj, disjuncts, is_conj. \ENDDOC hol-light/Help/constants.doc000066400000000000000000000004631303454263000163430ustar00rootroot00000000000000\DOC constants \TYPE {constants : unit -> (string * hol_type) list} \SYNOPSIS Returns a list of the constants currently defined. \DESCRIBE The call { constants();; } returns a list of all the constants that have been defined so far. \FAILURE Never fails. \SEEALSO axioms, binders, infixes. \ENDDOC hol-light/Help/current_goalstack.doc000066400000000000000000000007161303454263000200420ustar00rootroot00000000000000\DOC current_goalstack \TYPE {current_goalstack : goalstack ref} \SYNOPSIS Reference variable holding current goalstack. \DESCRIBE The reference variable {current_goalstack} contains the current goalstack. A goalstack is a type containing a list of goalstates. \FAILURE Not applicable. \COMMENTS Users will probably not often want to examine this variable explicitly, since various proof commands modify it in various ways. \SEEALSO b, g, e, r. \ENDDOC hol-light/Help/curry.doc000066400000000000000000000007051303454263000154720ustar00rootroot00000000000000\DOC curry \TYPE {curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c} \SYNOPSIS Converts a function on a pair to a corresponding curried function. \DESCRIBE The application {curry f} returns {\x y. f(x,y)}, so that { curry f x y = f(x,y) } \FAILURE Never fails. \EXAMPLE { # curry mk_var;; val it : string -> hol_type -> term = # it "x";; val it : hol_type -> term = # it `:bool`;; val it : term = `x` } \SEEALSO uncurry. \ENDDOC hol-light/Help/decreasing.doc000066400000000000000000000011211303454263000164230ustar00rootroot00000000000000\DOC decreasing \TYPE {decreasing : ('a -> 'b) -> 'a -> 'a -> bool} \SYNOPSIS When applied to a ``measure'' function {f}, the call {increasing f} returns a binary function ordering elements in a call {increasing f x y} by {f(y) term -> term} \SYNOPSIS Modify bound variable according to renaming scheme. \DESCRIBE When applied to a list of string-string pairs { deep_alpha ["x1'","x1"; ...; "xn'","xn"] } \noindent a conversion results that will attempt to traverse a term and systematically replace any bound variable called {xi} with one called {xi'}. It will quietly do nothing in cases where that is impossible because of variable capture. \EXAMPLE { # deep_alpha ["x'","x"; "y'","y"] `?x. x <=> !y. y = y`;; Warning: inventing type variables val it : term = `?x'. x' <=> (!y'. y' = y')` } \COMMENTS This is used inside {PART_MATCH} to try to achieve a reasonable correspondence in bound variable names, e.g. so that the bound variable is still called `{n}' rather than `{x}' here: { # REWR_CONV NOT_FORALL_THM `~(!n. n < m)`;; val it : thm = |- ~(!n. n < m) <=> (?n. ~(n < m)) } \SEEALSO alpha, PART_MATCH. \ENDDOC hol-light/Help/define.doc000066400000000000000000000063031303454263000155600ustar00rootroot00000000000000\DOC define \TYPE {define : term -> thm} \SYNOPSIS Defines a general recursive function. \DESCRIBE The function {define} should be applied to a conjunction of `definitional' clauses {`def_1[f] /\ ... /\ def_n[f]`} for some variable {f}, where each clause {def_i} is a universally quantified equation with an application of {f} to arguments on the left-hand side. The idea is that these clauses define the action of {f} on arguments of various kinds, for example on an empty list and nonempty list: { (f [] = a) /\ (!h t. CONS h t = k[f,h,t]) } \noindent or on even numbers and odd numbers: { (!n. f(2 * n) = a[f,n]) /\ (!n. f(2 * n + 1) = b[f,n]) } The {define} function attempts to prove that there is indeed a function satisfying all these properties, and if it succeeds it defines a new function {f} and returns the input term with the variable {f} replaced by the newly defined constant. \FAILURE Fails if the definition is malformed or if some of the necessary conditions for the definition to be admissible cannot be proved automatically, or if there is already a constant of the given name. \EXAMPLE This is a `multifactorial' function: { # define `multifactorial m n = if m = 0 then 1 else if n <= m then n else n * multifactorial m (n - m)`;; val it : thm = |- multifactorial m n = (if m = 0 then 1 else if n <= m then n else n * multifactorial m (n - m)) } Note that it fails without the {m = 0} guard because then there's no reason to suppose that {n - m} decreases and hence the recursion is apparently illfounded. Perhaps a more surprising example is the Collatz function: { # define `!n. collatz(n) = if n <= 1 then n else if EVEN(n) then collatz(n DIV 2) else collatz(3 * n + 1)`;; } Note that the definition was made successfully because there provably is a function satisfying these recursion equations, notwithstanding the fact that it is unknown whether the recursion is wellfounded. (Tail-recursive functions are always logically consistent, though they may not have any useful provable properties.) \COMMENTS Assuming the definition is well-formed and the constant name is unused, failure indicates that {define} was unable to prove one or both of the following two properties: (i) the clauses are not mutually inconsistent (more than one clause could apply to some arguments, and the results are not obviously the same), or (ii) the definition is recursive and no ordering justifying the recursion could be arrived at by the automated heuristic. In order to make progress in such cases, try applying {prove_general_recursive_function_exists} or {pure_prove_recursive_function_exists} to the same definition with existential quantification over {f}, to see the unproven side-conditions. An example is in the documentation for {prove_general_recursive_function_exists}. On the other hand, for suitably simple and regular primitive recursive definitions, the explicit alternative {prove_recursive_functions_exist} is often much faster than any of these. \SEEALSO new_definition, new_recursive_definition, new_specification, prove_general_recursive_function_exists, prove_recursive_functions_exist, pure_prove_recursive_function_exists. \ENDDOC hol-light/Help/define_finite_type.doc000066400000000000000000000022211303454263000201520ustar00rootroot00000000000000\DOC define_finite_type \TYPE {define_finite_type : int -> thm} \SYNOPSIS Defines a new type of a specified finite size. \DESCRIBE The call {define_finite_type n} where {n} is a positive integer defines a new type also called simply `{n}', and returns a theorem asserting that its universe has size {n}, in the form: { |- (:n) HAS_SIZE n } \noindent where {(:n)} is the customary HOL Light printing of the universe set {UNIV:n->bool}. \FAILURE Fails if {n} is zero or negative, or if there is a type of the same name (unless it was also defined by the same call for {define_finite_type}, which is perfectly permissible), or if the names of the type constructor and destructor functions are already in use: { mk_auto_define_finite_type_n:num->n dest_auto_define_finite_type_n:32->num } \EXAMPLE Here we define a 32-element type, perhaps useful for indexing the bits of a word: { # define_finite_type 32;; val it : thm = |- (:32) HAS_SIZE 32 } \USES In conjunction with Cartesian powers such as {real^3}, where only the size of the indexing type is relevant and the simple name {n} is intuitive. \SEEALSO define_type, new_type_definition. \ENDDOC hol-light/Help/define_quotient_type.doc000066400000000000000000000052651303454263000205570ustar00rootroot00000000000000\DOC define_quotient_type \TYPE {define_quotient_type : string -> string * string -> term -> thm * thm} \SYNOPSIS Defines a quotient type based on given equivalence relation. \DESCRIBE The call {define_quotient_type "qty" ("abs","rep") `R`}, where {R:A->A->bool} is a binary relation, defines a new ``quotient type'' {:qty} and two new functions {abs:(A->bool)->qty} and {rep:qty->(A->bool)}, and returns the pair of theorems {|- abs(rep a) = a} and {|- (?x. r = R x) <=> rep(abs r) = r}. Normally, {R} will be an equivalence relation (reflexive, symmetric and transitive), in which case the quotient type will be in bijection with the set of {R}-equivalence classes. \FAILURE Fails if there is already a type {qty} or if either {abs} or {rep} is already in use as a constant. \EXAMPLE For some purposes we may want to use ``multisets'' or ``bags''. These are like sets in that order is irrelevant, but like lists in that multiplicity is counted. We can define a type of finite multisets as a quotient of lists by the relation: { # let multisame = new_definition `multisame l1 l2 <=> !a:A. FILTER (\x. x = a) l1 = FILTER (\x. x = a) l2`;; } \noindent as follows: { # let multiset_abs,multiset_rep = define_quotient_type "multiset" ("multiset_of_list","list_of_multiset") `multisame:A list -> A list -> bool`;; val multiset_abs : thm = |- multiset_of_list (list_of_multiset a) = a val multiset_rep : thm = |- (?x. r = multisame x) <=> list_of_multiset (multiset_of_list r) = r } For development of this example, see the documentation entries for {lift_function} and {lift_theorem} (in that order). Similarly we could define a type of finite sets by: { define_quotient_type "finiteset" ("finiteset_of_list","list_of_finiteset") `\l1 l2. !a:A. MEM a l1 <=> MEM a l2`;; val it : thm * thm = (|- finiteset_of_list (list_of_finiteset a) = a, |- (?x. r = (\l1 l2. !a. MEM a l1 <=> MEM a l2) x) <=> list_of_finiteset (finiteset_of_list r) = r) } \USES Convenient creation of quotient structures. Using related functions {lift_function} and {lift_theorem}, functions, relations and theorems can be lifted from the representing type to the type of equivalence classes. As well as those shown above, characteristic applications are the definition of rationals as equivalence classes of pairs of integers under cross-multiplication, or of `directions' as equivalence classes of vectors under parallelism. \COMMENTS If {R} is not an equivalence relation, the basic operation of {define_quotient_type} will work equally well, but the usefulness of the new type will be limited. In particular, {lift_function} and {lift_theorem} may not be usable. \SEEALSO lift_function, lift_theorem. \ENDDOC hol-light/Help/define_type.doc000066400000000000000000000137711303454263000166300ustar00rootroot00000000000000\DOC define_type \TYPE {define_type : string -> thm * thm} \SYNOPSIS Automatically define user-specified inductive data types. \DESCRIBE The function {define_type} automatically defines an inductive data type or a mutually inductive family of them. These may optionally contain nested instances of other inductive data types. The function returns two theorems that together identify the type up to isomorphism. The input is just a string indicating the desired pattern of recursion. The simplest case where we define a single type is: { "op = C1 ty ... ty | C2 ty ... ty | ... | Cn ty ... ty" } \noindent where {op} is the name of the type constant or type operator to be defined, {C1}, ..., {Cn} are identifiers, and each {ty} is either a (logical) type expression valid in the current theory (in which case {ty} must not contain {op}) or just the identifier "{op}' itself. A string of this form describes an n-ary type operator {op}, where n is the number of distinct type variables in the types {ty} on the right hand side of the equation. If n is zero then {op} is a type constant; otherwise {op} is an n-ary type operator. The type described by the specification has {n} distinct constructors {C1}, ..., {Cn}. Each constructor {Ci} is a function that takes arguments whose types are given by the associated type expressions {ty} in the specification. If one or more of the type expressions {ty} is the type {op} itself, then the equation specifies a recursive data type. In any specification, at least one constructor must be non-recursive, i.e. all its arguments must have types which already exist in the current theory. Each of the types {ty} above may be built from the type being defined using other inductive type operators already defined, e.g. {list}. Moreover, one can actually have a mutually recursive family of types, where the format is a sequence of specifications in the above form separated by semicolons: { "op1 = C1_1 ty ... ty | C1_2 ty ... ty | ... | C1_n1 ty ... ty; op2 = C2_1 ty ... ty | ... | C2_n2 ty ... ty; ... opk = Ck_1 ty ... ty | ... | ... | Ck_nk ty ... ty" } Given a type specification of the form described above, {define_type} makes an appropriate type definition for the type operator or type operators. It then makes appropriate definitions for the constants {Ci_j} and automatically proves and returns two theorems that characterize the type up to isomorphism. Roughly, the first theorem allows one to prove properties over the new (family of) types by (mutual) induction, while the latter allows one to defined functions by recursion. Rather than presenting these in full generality, it is probably easier to consider some simple examples. \FAILURE The evaluation fails if one of the types or constructor constants is already defined, or if there are certain improper kinds of recursion, e.g. involving function spaces of one of the types being defined. \EXAMPLE The following call to {define_type} defines {tri} to be a simple enumerated type with exactly three distinct values: { # define_type "tri = ONE | TWO | THREE";; val it : thm * thm = (|- !P. P ONE /\ P TWO /\ P THREE ==> (!x. P x), |- !f0 f1 f2. ?fn. fn ONE = f0 /\ fn TWO = f1 /\ fn THREE = f2) } \noindent The theorem returned is a degenerate `primitive recursion' theorem for the concrete type {tri}. An example of a recursive type that can be defined using {define_type} is a type of binary trees: { # define_type "btree = LEAF A | NODE btree btree";; val it : thm * thm = (|- !P. (!a. P (LEAF a)) /\ (!a0 a1. P a0 /\ P a1 ==> P (NODE a0 a1)) ==> (!x. P x), |- !f0 f1. ?fn. (!a. fn (LEAF a) = f0 a) /\ (!a0 a1. fn (NODE a0 a1) = f1 a0 a1 (fn a0) (fn a1))) } \noindent The theorem returned by {define_type} in this case asserts the unique existence of functions defined by primitive recursion over labelled binary trees. For an example of nested recursion, here we use the type of lists in a nested fashion to define a type of first-order terms: { # define_type "term = Var num | Fn num (term list)";; val it : thm * thm = (|- !P0 P1. (!a. P0 (Var a)) /\ (!a0 a1. P1 a1 ==> P0 (Fn a0 a1)) /\ P1 [] /\ (!a0 a1. P0 a0 /\ P1 a1 ==> P1 (CONS a0 a1)) ==> (!x0. P0 x0) /\ (!x1. P1 x1), |- !f0 f1 f2 f3. ?fn0 fn1. (!a. fn1 (Var a) = f0 a) /\ (!a0 a1. fn1 (Fn a0 a1) = f1 a0 a1 (fn0 a1)) /\ fn0 [] = f2 /\ (!a0 a1. fn0 (CONS a0 a1) = f3 a0 a1 (fn1 a0) (fn0 a1))) } \noindent and here we have an example of mutual recursion, defining syntax trees for commands and expressions for a hypothetical programming language: { # define_type "command = Assign num expression | Ite expression command command; expression = Variable num | Constant num | Plus expression expression | Valof command";; val it : thm * thm = (|- !P0 P1. (!a0 a1. P1 a1 ==> P0 (Assign a0 a1)) /\ (!a0 a1 a2. P1 a0 /\ P0 a1 /\ P0 a2 ==> P0 (Ite a0 a1 a2)) /\ (!a. P1 (Variable a)) /\ (!a. P1 (Constant a)) /\ (!a0 a1. P1 a0 /\ P1 a1 ==> P1 (Plus a0 a1)) /\ (!a. P0 a ==> P1 (Valof a)) ==> (!x0. P0 x0) /\ (!x1. P1 x1), |- !f0 f1 f2 f3 f4 f5. ?fn0 fn1. (!a0 a1. fn0 (Assign a0 a1) = f0 a0 a1 (fn1 a1)) /\ (!a0 a1 a2. fn0 (Ite a0 a1 a2) = f1 a0 a1 a2 (fn1 a0) (fn0 a1) (fn0 a2)) /\ (!a. fn1 (Variable a) = f2 a) /\ (!a. fn1 (Constant a) = f3 a) /\ (!a0 a1. fn1 (Plus a0 a1) = f4 a0 a1 (fn1 a0) (fn1 a1)) /\ (!a. fn1 (Valof a) = f5 a (fn0 a))) } \SEEALSO INDUCT_THEN, new_recursive_definition, new_type_abbrev, prove_cases_thm, prove_constructors_distinct, prove_constructors_one_one, prove_induction_thm, prove_rec_fn_exists. \ENDDOC hol-light/Help/define_type_raw.doc000066400000000000000000000012751303454263000174750ustar00rootroot00000000000000\DOC define_type_raw \TYPE {define_type_raw : (hol_type * (string * hol_type list) list) list -> thm * thm} \SYNOPSIS Like {define_type} but from a more structured representation than a string. \DESCRIBE The core functionality of {define_type_raw} is the same as {define_type}, but the input is a more structured format for the type specification. In fact, {define_type} is just the composition of {define_type_raw} and {parse_inductive_type_specification}. \FAILURE May fail for the usual reasons {define_type} may. \USES Not intended for general use, but sometimes useful in proof tools that want to generate inductive types. \SEEALSO define_type, parse_inductive_type_specification. \ENDDOC hol-light/Help/defined.doc000066400000000000000000000015201303454263000157200ustar00rootroot00000000000000\DOC defined \TYPE {defined : ('a, 'b) func -> 'a -> bool} \SYNOPSIS Tests if a finite partial function is defined on a certain domain value. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The call {defined f x} returns {true} if the finite partial function {f} is defined on domain value {x}, and {false} otherwise. \FAILURE Never fails. \EXAMPLE { # defined (1 |=> 2) 1;; val it : bool = true # defined (1 |=> 2) 2;; val it : bool = false # defined undefined 1;; val it : bool = false } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefined. \ENDDOC hol-light/Help/definitions.doc000066400000000000000000000016761303454263000166510ustar00rootroot00000000000000\DOC definitions \TYPE {definitions : unit -> thm list} \SYNOPSIS Returns the current set of primitive definitions. \DESCRIBE A call {definitions()} returns the current list of basic definitions made in the HOL Light kernel. \FAILURE Never fails. \COMMENTS This is a more logically primitive list than the one maintained in the list {!the_definitions}, and is intended mainly for auditing a proof development that uses axioms to ensure that no axioms and definitions clash. Under normal circumstances axioms are not used and so this information is not needed. Definitions returned by {definitions()} are in their primitive equational form, and include everything defined in the kernel. By contrast, those in the list {!the_definitions} are often quantified and eta-expanded, and the list may be incomplete since it is only maintained outside the logical kernel as a convenience. \SEEALSO define, new_axiom, new_definition, the_definitions. \ENDDOC hol-light/Help/delete_parser.doc000066400000000000000000000007401303454263000171430ustar00rootroot00000000000000\DOC delete_parser \TYPE {delete_parser : string -> unit} \SYNOPSIS Uninstall a user parser. \DESCRIBE HOL Light allows user parsing functions to be installed, and will try them on all terms during parsing before the usual parsers. The call {delete_parser "s"} removes any parsers associated with string {"s"}. \FAILURE Never fails, regardless of whether there are any parsers associated with the string. \SEEALSO install_parser, installed_parsers, try_user_parser. \ENDDOC hol-light/Help/delete_user_printer.doc000066400000000000000000000013341303454263000203700ustar00rootroot00000000000000\DOC delete_user_printer \TYPE {delete_user_printer : string -> unit} \SYNOPSIS Remove user-defined printer from the HOL Light term printing. \DESCRIBE HOL Light allows arbitrary user printers to be inserted into the toplevel printer so that they are invoked on all applicable subterms (see {install_user_printer}). The call {delete_user_printer s} removes any such printer associated with the tag {s}. \FAILURE Never fails, even if there is no printer with the given tag. \EXAMPLE If a user printer has been installed as in the example given for {install_user_printer}, it can be removed again by: { # delete_user_printer "print_typed_var";; val it : unit = () } \SEEALSO install_user_printer, try_user_printer. \ENDDOC hol-light/Help/denominator.doc000066400000000000000000000011731303454263000166450ustar00rootroot00000000000000\DOC denominator \TYPE {denominator : num -> num} \SYNOPSIS Returns denominator of rational number in canonical form. \DESCRIBE Given a rational number as supported by the {Num} library, {denominator} returns the denominator $q$ from the rational number cancelled to its reduced form, $p/q$ where $q > 0$ and $p$ and $q$ have no common factor. \FAILURE Never fails. \EXAMPLE { # denominator(Int 22 // Int 7);; val it : num = 7 # denominator(Int 0);; val it : num = 1 # denominator(Int 100);; val it : num = 1 # denominator(Int 4 // Int(-2));; val it : num = 1 } \SEEALSO numdom, numerator. \ENDDOC hol-light/Help/derive_nonschematic_inductive_relations.doc000066400000000000000000000046031303454263000244720ustar00rootroot00000000000000\DOC derive_nonschematic_inductive_relations \TYPE {derive_nonschematic_inductive_relations : term -> thm} \SYNOPSIS Deduce inductive definitions properties from an explicit assignment. \DESCRIBE Given a set of clauses as given to {new_inductive_definitions}, the call {derive_nonschematic_inductive_relations} will introduce explicit equational constraints (``definitions'', though only assumptions of the theorem, not actually constant definitions) that allow it to deduce those clauses. It will in general have additional `monotonicity' hypotheses, but these may be removable by {prove_monotonicity_hyps}. None of the arguments are treated as schematic. \FAILURE Fails if the format of the clauses is wrong. \EXAMPLE Here we try one of the classic examples of a mutually inductive definition, defining odd-ness and even-ness of natural numbers: { # (prove_monotonicity_hyps o derive_nonschematic_inductive_relations) `even(0) /\ odd(1) /\ (!n. even(n) ==> odd(n + 1)) /\ (!n. odd(n) ==> even(n + 1))`;; val it : thm = odd = (\a0. !odd' even'. (!a0. a0 = 1 \/ (?n. a0 = n + 1 /\ even' n) ==> odd' a0) /\ (!a1. a1 = 0 \/ (?n. a1 = n + 1 /\ odd' n) ==> even' a1) ==> odd' a0), even = (\a1. !odd' even'. (!a0. a0 = 1 \/ (?n. a0 = n + 1 /\ even' n) ==> odd' a0) /\ (!a1. a1 = 0 \/ (?n. a1 = n + 1 /\ odd' n) ==> even' a1) ==> even' a1) |- (even 0 /\ odd 1 /\ (!n. even n ==> odd (n + 1)) /\ (!n. odd n ==> even (n + 1))) /\ (!odd' even'. even' 0 /\ odd' 1 /\ (!n. even' n ==> odd' (n + 1)) /\ (!n. odd' n ==> even' (n + 1)) ==> (!a0. odd a0 ==> odd' a0) /\ (!a1. even a1 ==> even' a1)) /\ (!a0. odd a0 <=> a0 = 1 \/ (?n. a0 = n + 1 /\ even n)) /\ (!a1. even a1 <=> a1 = 0 \/ (?n. a1 = n + 1 /\ odd n)) } \noindent Note that the final theorem has two assumptions that one can think of as the appropriate explicit definitions of these relations, and the conclusion gives the rule, induction and cases theorems. \COMMENTS Normally, use {prove_inductive_relations_exist} or {new_inductive_definition}. This function is only needed for a very fine level of control. \SEEALSO new_inductive_definition, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC hol-light/Help/derive_strong_induction.doc000066400000000000000000000050441303454263000212550ustar00rootroot00000000000000\DOC derive_strong_induction \TYPE {derive_strong_induction : thm * thm -> thm} \SYNOPSIS Derive stronger induction theorem from inductive definition. \DESCRIBE The function {derive_strong_induction} is applied to a pair of theorems as returned by {new_inductive_definition}. The first theorem is the `rule' theorem, the second the `induction' theorem; the `case' theorem returned by {new_inductive_definition} is not needed. It returns a stronger induction theorem where instances of each inductive predicate occurring in hypotheses is conjoined with the corresponding inductive relation too. \FAILURE Fails if the two input theorems are not of the correct form for rule and induction theorems returned by {new_inductive_definition}. \EXAMPLE A simple example of a mutually inductive definition is: { # let eo_RULES,eo_INDUCT, eo_CASES = new_inductive_definition `even(0) /\ odd(1) /\ (!n. even(n) ==> odd(n + 1)) /\ (!n. odd(n) ==> even(n + 1))`;; val eo_RULES : thm = |- even 0 /\ odd 1 /\ (!n. even n ==> odd (n + 1)) /\ (!n. odd n ==> even (n + 1)) val eo_INDUCT : thm = |- !odd' even'. even' 0 /\ odd' 1 /\ (!n. even' n ==> odd' (n + 1)) /\ (!n. odd' n ==> even' (n + 1)) ==> (!a0. odd a0 ==> odd' a0) /\ (!a1. even a1 ==> even' a1) val eo_CASES : thm = |- (!a0. odd a0 <=> a0 = 1 \/ (?n. a0 = n + 1 /\ even n)) /\ (!a1. even a1 <=> a1 = 0 \/ (?n. a1 = n + 1 /\ odd n)) } The stronger induction theorem can be derived as follows. Note that it is similar in form to {eo_INDUCT} but has stronger hypotheses for two of the conjuncts in the antecedent. { # derive_strong_induction(eo_RULES,eo_INDUCT);; val it : thm = |- !odd' even'. even' 0 /\ odd' 1 /\ (!n. even n /\ even' n ==> odd' (n + 1)) /\ (!n. odd n /\ odd' n ==> even' (n + 1)) ==> (!a0. odd a0 ==> odd' a0) /\ (!a1. even a1 ==> even' a1) } \COMMENTS This function needs to discharge monotonicity theorems as part of its internal working, just as {new_inductive_definition} does when the inductive definition is made. Usually this is automatic and the user doesn't see it, but in difficult cases, the theorem returned may have additional monotonicity hypotheses that are unproven. In such cases, you can either try to prove them manually or extend {monotonicity_theorems} to make the built-in monotonicity prover more powerful. \SEEALSO new_inductive_definition, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC hol-light/Help/dest_abs.doc000066400000000000000000000007101303454263000161060ustar00rootroot00000000000000\DOC dest_abs \TYPE {dest_abs : term -> term * term} \SYNOPSIS Breaks apart an abstraction into abstracted variable and body. \DESCRIBE {dest_abs} is a term destructor for abstractions: {dest_abs `\var. t`} returns {(`var`,`t`)}. \FAILURE Fails with {dest_abs} if term is not an abstraction. \EXAMPLE { # dest_abs `\x. x + 1`;; val it : term * term = (`x`, `x + 1`) } \SEEALSO dest_comb, dest_const, dest_var, is_abs, mk_abs, strip_abs. \ENDDOC hol-light/Help/dest_binary.doc000066400000000000000000000011241303454263000166250ustar00rootroot00000000000000\DOC dest_binary \TYPE {dest_binary : string -> term -> term * term} \SYNOPSIS Breaks apart an instance of a binary operator with given name. \DESCRIBE The call {dest_binary s tm} will, if {tm} is a binary operator application {(op l) r} where {op} is a constant with name {s}, return the two arguments to which it is applied as a pair {l,r}. Otherwise, it fails. Note that {op} is required to be a constant. \FAILURE Never fails. \EXAMPLE This one succeeds: { # dest_binary "+" `1 + 2`;; val it : term * term = (`1`, `2`) } \SEEALSO dest_binop, is_binary, is_comb, mk_binary. \ENDDOC hol-light/Help/dest_binder.doc000066400000000000000000000012261303454263000166070ustar00rootroot00000000000000\DOC dest_binder \TYPE {dest_binder : string -> term -> term * term} \SYNOPSIS Breaks apart a ``binder''. \DESCRIBE Applied to a term {tm} of the form {`c (\x. t)`} where {c} is a constant whose name is {"s"}, the call {dest_binder "c" tm} returns {(`x`,`t`)}. Note that this is actually independent of whether the name parses as a binder, but the usual application is where it does. \FAILURE Fails if the term is not of the appropriate form with a constant of the same name. \EXAMPLE The call {dest_binder "!"} is the same as {dest_forall}, and is in fact how that function is implemented. \SEEALSO dest_abs, dest_comb, dest_const, dest_var. \ENDDOC hol-light/Help/dest_binop.doc000066400000000000000000000011551303454263000164540ustar00rootroot00000000000000\DOC dest_binop \TYPE {dest_binop : term -> term -> term * term} \SYNOPSIS Breaks apart an application of a given binary operator to two arguments. \DESCRIBE The call {dest_binop op t}, where {t} is of the form {(op l) r}, will return the pair {l,r}. If {t} is not of that form, it fails. Note that {op} can be any term; it need not be a constant nor parsed infix. \FAILURE Fails if the term is not a binary application of operator {op}. \EXAMPLE { # dest_binop `(+):num->num->num` `1 + 2 + 3`;; val it : term * term = (`1`, `2 + 3`) } \SEEALSO dest_binary, is_binary, is_binop, mk_binary, mk_binop. \ENDDOC hol-light/Help/dest_char.doc000066400000000000000000000012721303454263000162620ustar00rootroot00000000000000\DOC dest_char \TYPE {dest_char : term -> char} \SYNOPSIS Produces OCaml character corresponding to object-level character. \DESCRIBE {dest_char t} where {t} is a term of HOL type {char}, produces the corresponding OCaml character. \FAILURE Fails if the term is not of type {char} \EXAMPLE { # lhand `"hello"`;; val it : term = `ASCII F T T F T F F F` # dest_char it;; val it : char = 'h' } \COMMENTS There is no particularly convenient parser/printer support for the HOL {char} type, but when combined into lists they are considered as strings and provided with more intuitive parser/printer support. \SEEALSO dest_string, mk_char, mk_string. \ENDDOC hol-light/Help/dest_comb.doc000066400000000000000000000012401303454263000162600ustar00rootroot00000000000000\DOC dest_comb \TYPE {dest_comb : term -> term * term} \SYNOPSIS Breaks apart a combination (function application) into rator and rand. \DESCRIBE {dest_comb} is a term destructor for combinations: { dest_comb `t1 t2` } \noindent returns {(`t1`,`t2`)}. \FAILURE Fails with {dest_comb} if term is not a combination. \EXAMPLE { # dest_comb `SUC 0`;; val it : term * term = (`SUC`, `0`) } We can use {dest_comb} to reveal more about the internal representation of numerals: { # dest_comb `12`;; val it : term * term = (`NUMERAL`, `BIT0 (BIT0 (BIT1 (BIT1 _0)))`) } \SEEALSO dest_abs, dest_const, dest_var, is_comb, list_mk_comb, mk_comb, strip_comb. \ENDDOC hol-light/Help/dest_cond.doc000066400000000000000000000005651303454263000162740ustar00rootroot00000000000000\DOC dest_cond \TYPE {dest_cond : term -> term * (term * term)} \SYNOPSIS Breaks apart a conditional into the three terms involved. \DESCRIBE {dest_cond} is a term destructor for conditionals: { dest_cond `if t then t1 else t2` } \noindent returns {(`t`,`t1`,`t2`)}. \FAILURE Fails with {dest_cond} if term is not a conditional. \SEEALSO mk_cond, is_cond. \ENDDOC hol-light/Help/dest_conj.doc000066400000000000000000000004031303454263000162710ustar00rootroot00000000000000\DOC dest_conj \TYPE {dest_conj : term -> term * term} \SYNOPSIS Term destructor for conjunctions. \DESCRIBE {dest_conj(`t1 /\ t2`)} returns {(`t1`,`t2`)}. \FAILURE Fails with {dest_conj} if term is not a conjunction. \SEEALSO is_conj, mk_conj. \ENDDOC hol-light/Help/dest_cons.doc000066400000000000000000000007431303454263000163110ustar00rootroot00000000000000\DOC dest_cons \TYPE {dest_cons : term -> term * term} \SYNOPSIS Breaks apart a `CONS pair' into head and tail. \DESCRIBE {dest_cons} is a term destructor for `CONS pairs'. When applied to a term representing a nonempty list {`[t;t1;...;tn]`} (which is equivalent to {`CONS t [t1;...;tn]`}), it returns the pair of terms {(`t`,`[t1;...;tn]`)}. \FAILURE Fails with {dest_cons} if the term is not a non-empty list. \SEEALSO dest_list, is_cons, is_list, mk_cons, mk_list. \ENDDOC hol-light/Help/dest_const.doc000066400000000000000000000007351303454263000164760ustar00rootroot00000000000000\DOC dest_const \TYPE {dest_const : term -> string * hol_type} \SYNOPSIS Breaks apart a constant into name and type. \DESCRIBE {dest_const} is a term destructor for constants: { dest_const `const:ty` } \noindent returns {("const",`:ty`)}. \FAILURE Fails with {dest_const} if term is not a constant. \EXAMPLE { # dest_const `T`;; val it : string * hol_type = ("T", `:bool`) } \SEEALSO dest_abs, dest_comb, dest_var, is_const, mk_const, mk_mconst, name_of. \ENDDOC hol-light/Help/dest_disj.doc000066400000000000000000000005251303454263000162760ustar00rootroot00000000000000\DOC dest_disj \TYPE {dest_disj : term -> term * term} \SYNOPSIS Breaks apart a disjunction into the two disjuncts. \DESCRIBE {dest_disj} is a term destructor for disjunctions: { dest_disj `t1 \/ t2` } \noindent returns {(`t1`,`t2`)}. \FAILURE Fails with {dest_disj} if term is not a disjunction. \SEEALSO is_disj, mk_disj. \ENDDOC hol-light/Help/dest_eq.doc000066400000000000000000000005001303454263000157430ustar00rootroot00000000000000\DOC dest_eq \TYPE {dest_eq : term -> term * term} \SYNOPSIS Term destructor for equality. \DESCRIBE {dest_eq(`t1 = t2`)} returns {(`t1`,`t2`)}. \FAILURE Fails with {dest_eq} if term is not an equality. \EXAMPLE { # dest_eq `2 + 2 = 4`;; val it : term * term = (`2 + 2`, `4`) } \SEEALSO is_eq, mk_eq. \ENDDOC hol-light/Help/dest_exists.doc000066400000000000000000000006351303454263000166660ustar00rootroot00000000000000\DOC dest_exists \TYPE {dest_exists : term -> term * term} \SYNOPSIS Breaks apart an existentially quantified term into quantified variable and body. \DESCRIBE {dest_exists} is a term destructor for existential quantification: {dest_exists `?var. t`} returns {(`var`,`t`)}. \FAILURE Fails with {dest_exists} if term is not an existential quantification. \SEEALSO is_exists, mk_exists, strip_exists. \ENDDOC hol-light/Help/dest_forall.doc000066400000000000000000000006251303454263000166250ustar00rootroot00000000000000\DOC dest_forall \TYPE {dest_forall : term -> term * term} \SYNOPSIS Breaks apart a universally quantified term into quantified variable and body. \DESCRIBE {dest_forall} is a term destructor for universal quantification: {dest_forall `!var. t`} returns {(`var`,`t`)}. \FAILURE Fails with {dest_forall} if term is not a universal quantification. \SEEALSO is_forall, mk_forall, strip_forall. \ENDDOC hol-light/Help/dest_fun_ty.doc000066400000000000000000000011661303454263000166530ustar00rootroot00000000000000\DOC dest_fun_ty \TYPE {dest_fun_ty : hol_type -> hol_type * hol_type} \SYNOPSIS Break apart a function type into domain and range. \DESCRIBE The call {dest_fun_ty `:s->t`} breaks apart the function type {s->t} and returns the pair {`:s`,`:t`}. \FAILURE Fails if the type given as argument is not a function type (constructor {"fun"}). \EXAMPLE { # dest_fun_ty `:A->B`;; val it : hol_type * hol_type = (`:A`, `:B`) # dest_fun_ty `:num->num->bool`;; val it : hol_type * hol_type = (`:num`, `:num->bool`) # dest_fun_ty `:A#B`;; Exception: Failure "dest_fun_ty". } \SEEALSO dest_type, mk_fun_ty. \ENDDOC hol-light/Help/dest_gabs.doc000066400000000000000000000016421303454263000162620ustar00rootroot00000000000000\DOC dest_gabs \TYPE {dest_gabs : term -> term * term} \SYNOPSIS Breaks apart a generalized abstraction into abstracted varstruct and body. \DESCRIBE {dest_pabs} is a term destructor for generalized abstractions: for example with a paired varstruct the effect on {dest_pabs `\(v1..(..)..vn). t`} is to return the pair {(`(v1..(..)..vn)`,`t`)}. It will also act as for {dest_abs} on basic abstractions. \FAILURE Fails unless the term is a basic or generalized abstraction. \EXAMPLE These are fairly typical applications: { # dest_gabs `\(x,y). x + y`;; val it : term * term = (`x,y`, `x + y`) # dest_gabs `\(CONS h t). h + 1`;; val it : term * term = (`CONS h t`, `h + 1`) } \noindent while the following shows that it also works on basic abstractions: { # dest_gabs `\x. x`;; Warning: inventing type variables val it : term * term = (`x`, `x`) } \SEEALSO GEN_BETA_CONV, is_gabs, mk_gabs, strip_gabs. \ENDDOC hol-light/Help/dest_iff.doc000066400000000000000000000011401303454263000161030ustar00rootroot00000000000000\DOC dest_iff \TYPE {dest_iff : term -> term * term} \SYNOPSIS Term destructor for logical equivalence. \DESCRIBE {dest_iff(`t1 <=> t2`)} returns {(`t1`,`t2`)}. \FAILURE Fails with if term is not a logical equivalence, i.e. an equation between terms of Boolean type. \EXAMPLE { # dest_iff `x = y <=> y = 1`;; val it : term * term = (`x = y`, `y = 1`) } \COMMENTS The function {dest_eq} has the same effect, but the present function checks that the types of the two sides are indeed Boolean, whereas {dest_eq} will break apart any equation. \SEEALSO dest_eq, is_iff, mk_iff. \ENDDOC hol-light/Help/dest_imp.doc000066400000000000000000000005541303454263000161340ustar00rootroot00000000000000\DOC dest_imp \TYPE {dest_imp : term -> term * term} \SYNOPSIS Breaks apart an implication into antecedent and consequent. \DESCRIBE {dest_imp} is a term destructor for implications. Thus { dest_imp `t1 ==> t2` } \noindent returns { (`t1`,`t2`) } \FAILURE Fails with {dest_imp} if term is not an implication. \SEEALSO is_imp, mk_imp, strip_imp. \ENDDOC hol-light/Help/dest_intconst.doc000066400000000000000000000011471303454263000172070ustar00rootroot00000000000000\DOC dest_intconst \TYPE {dest_intconst : term -> num} \SYNOPSIS Converts an integer literal of type {:int} to an OCaml number. \DESCRIBE The call {dest_intconst t} where {t} is a canonical integer literal of type {:int}, returns the corresponding OCaml number (type {num}). The permissible forms of integer literals are `{&n}' for a numeral {n} or `{-- &n}' for a nonzero numeral {n}. \FAILURE Fails if applied to a term that is not a canonical integer literal of type {:int}. \EXAMPLE { # dest_intconst `-- &11 :int`;; val it : num = -11 } \SEEALSO dest_realintconst, is_intconst, mk_intconst. \ENDDOC hol-light/Help/dest_let.doc000066400000000000000000000011211303454263000161220ustar00rootroot00000000000000\DOC dest_let \TYPE {dest_let : term -> (term * term) list * term} \SYNOPSIS Breaks apart a let-expression. \DESCRIBE {dest_let} is a term destructor for general let-expressions: {dest_let `let x1 = e1 and ... and xn = en in E`} returns a pair of the list {[`x1`,`e1`; ... ; `xn`,`en`]} and {`E`}. \FAILURE Fails with {dest_let} if term is not a {let}-expression. \EXAMPLE { # dest_let `let m = 256 and n = 65536 in (x MOD m + y MOD m) MOD n`;; val it : (term * term) list * term = ([(`m`, `256`); (`n`, `65536`)], `(x MOD m + y MOD m) MOD n`) } \SEEALSO mk_let, is_let. \ENDDOC hol-light/Help/dest_list.doc000066400000000000000000000005511303454263000163170ustar00rootroot00000000000000\DOC dest_list \TYPE {dest_list : term -> term list} \SYNOPSIS Iteratively breaks apart a list term. \DESCRIBE {dest_list} is a term destructor for lists: {dest_list(`[t1;...;tn]:(ty)list`)} returns {[`t1`;...;`tn`]}. \FAILURE Fails with {dest_list} if the term is not a list. \SEEALSO dest_cons, dest_setenum, is_cons, is_list, mk_cons, mk_list. \ENDDOC hol-light/Help/dest_neg.doc000066400000000000000000000004361303454263000161170ustar00rootroot00000000000000\DOC dest_neg \TYPE {dest_neg : term -> term} \SYNOPSIS Breaks apart a negation, returning its body. \DESCRIBE {dest_neg} is a term destructor for negations: {dest_neg `~t`} returns {`t`}. \FAILURE Fails with {dest_neg} if term is not a negation. \SEEALSO is_neg, mk_neg. \ENDDOC hol-light/Help/dest_numeral.doc000066400000000000000000000015441303454263000170120ustar00rootroot00000000000000\DOC dest_numeral \TYPE {dest_numeral : term -> num} \SYNOPSIS Converts a HOL numeral term to unlimited-precision integer. \DESCRIBE The call {dest_numeral t} where {t} is the HOL numeral representation of {n}, returns {n} as an unlimited-precision intger (type {num}). It fails if the term is not a numeral. \FAILURE Fails if the term is not a numeral. \EXAMPLE { # dest_numeral `0`;; val it : num = 0 # dest_numeral `18446744073709551616`;; val it : num = 18446744073709551616 } \COMMENTS The similar function {dest_small_numeral} maps to a machine integer, which means it may overflow. So the use of {dest_numeral} is better unless you are very sure of the range. { # dest_small_numeral `18446744073709551616`;; Exception: Failure "int_of_big_int". } \SEEALSO dest_small_numeral, is_numeral, mk_numeral, mk_small_numeral, rat_of_term. \ENDDOC hol-light/Help/dest_pair.doc000066400000000000000000000006341303454263000163010ustar00rootroot00000000000000\DOC dest_pair \TYPE {dest_pair : term -> term * term} \SYNOPSIS Breaks apart a pair into two separate terms. \DESCRIBE {dest_pair} is a term destructor for pairs: {dest_pair `(t1,t2)`} returns {(`t1`,`t2`)}. \FAILURE Fails with {dest_pair} if term is not a pair. \EXAMPLE { # dest_pair `(1,2),(3,4),(5,6)`;; val it : term * term = (`1,2`, `(3,4),5,6`) } \SEEALSO dest_cons, is_pair, mk_pair. \ENDDOC hol-light/Help/dest_realintconst.doc000066400000000000000000000012151303454263000200470ustar00rootroot00000000000000\DOC dest_realintconst \TYPE {dest_realintconst : term -> num} \SYNOPSIS Converts an integer literal of type {:real} to an OCaml number. \DESCRIBE The call {dest_realintconst t} where {t} is a canonical integer literal of type {:real}, returns the corresponding OCaml number (type {num}). The permissible forms of integer literals are `{&n}' for a numeral {n} or `{-- &n}' for a nonzero numeral {n}. \FAILURE Fails if applied to a term that is not a canonical integer literal of type {:real}. \EXAMPLE { # dest_realintconst `-- &27 :real`;; val it : num = -27 } \SEEALSO dest_intconst, is_realintconst, mk_realintconst, rat_of_term. \ENDDOC hol-light/Help/dest_select.doc000066400000000000000000000005551303454263000166270ustar00rootroot00000000000000\DOC dest_select \TYPE {dest_select : term -> term * term} \SYNOPSIS Breaks apart a choice term into selected variable and body. \DESCRIBE {dest_select} is a term destructor for choice terms: { dest_select `@var. t` } \noindent returns {(`var`,`t`)}. \FAILURE Fails with {dest_select} if term is not an epsilon-term. \SEEALSO mk_select, is_select. \ENDDOC hol-light/Help/dest_setenum.doc000066400000000000000000000013161303454263000170240ustar00rootroot00000000000000\DOC dest_setenum \TYPE {dest_setenum : term -> term list} \SYNOPSIS Breaks apart a set enumeration. \DESCRIBE {dest_setenum} is a term destructor for set enumerations: {dest_setenum `{{t1,...,tn}}`} returns {[`t1`;...;`tn`]}. Note that the list follows the syntactic pattern of the set enumeration, even if it contains duplicates. (The underlying set is still a set logically, of course, but can be represented redundantly.) \FAILURE Fails if the term is not a set enumeration. \EXAMPLE { # dest_setenum `{{1,2,3,4}}`;; val it : term list = [`1`; `2`; `3`; `4`] # dest_setenum `{{1,2,1,2}}`;; val it : term list = [`1`; `2`; `1`; `2`] } \SEEALSO dest_list, is_setenum, mk_fset, mk_setenum. \ENDDOC hol-light/Help/dest_small_numeral.doc000066400000000000000000000016411303454263000202000ustar00rootroot00000000000000\DOC dest_small_numeral \TYPE {dest_small_numeral : term -> int} \SYNOPSIS Converts a HOL numeral term to machine integer. \DESCRIBE The call {dest_small_numeral t} where {t} is the HOL numeral representation of {n}, returns {n} as an OCaml machine integer. It fails if the term is not a numeral or the result doesn't fit in a machine integer. \FAILURE Fails if the term is not a numeral or if the result doesn't fit in a machine integer. \EXAMPLE { # dest_small_numeral `12`;; val it : int = 12 # dest_small_numeral `18446744073709551616`;; Exception: Failure "int_of_big_int". } \COMMENTS If overflow is a danger, you may be better off using OCaml type {num} and the analogous function {dest_numeral}. However, none of HOL's inference rules depend on the behaviour of machine integers, so logical soundness is not an issue. \SEEALSO dest_numeral, is_numeral, mk_numeral, mk_small_numeral, rat_of_term. \ENDDOC hol-light/Help/dest_string.doc000066400000000000000000000010001303454263000166400ustar00rootroot00000000000000\DOC dest_string \TYPE {dest_string : term -> string} \SYNOPSIS Produces OCaml string corresponding to object-level string. \DESCRIBE {dest_string t} where {t} is a literal string in the HOL object logic of type {string} (which is an abbreviation for {char list}), produces the corresponding OCaml string. \FAILURE Fails if the term is not a literal term of type {string} \EXAMPLE { # dest_string `"HOL"`;; val it : string = "HOL" } \SEEALSO dest_char, dest_list, mk_char, mk_list, mk_string. \ENDDOC hol-light/Help/dest_thm.doc000066400000000000000000000005321303454263000161330ustar00rootroot00000000000000\DOC dest_thm \TYPE {dest_thm : thm -> term list * term} \SYNOPSIS Breaks a theorem into assumption list and conclusion. \DESCRIBE {dest_thm (t1,...,tn |- t)} returns {([`t1`;...;`tn`],`t`)}. \FAILURE Never fails. \EXAMPLE { # dest_thm (ASSUME `1 = 0`);; val it : term list * term = ([`1 = 0`], `1 = 0`) } \SEEALSO concl, hyp. \ENDDOC hol-light/Help/dest_type.doc000066400000000000000000000011151303454263000163220ustar00rootroot00000000000000\DOC dest_type \TYPE {dest_type : hol_type -> string * hol_type list} \SYNOPSIS Breaks apart a type (other than a variable type). \DESCRIBE {dest_type(`:(ty1,...,tyn)op`)} returns {("op",[`:ty1`;...;`:tyn`])}. \FAILURE Fails with {dest_type} if the type is a type variable. \EXAMPLE { # dest_type `:bool`;; val it : string * hol_type list = ("bool", []) # dest_type `:(bool)list`;; val it : string * hol_type list = ("list", [`:bool`]) # dest_type `:num -> bool`;; val it : string * hol_type list = ("fun", [`:num`; `:bool`]) } \SEEALSO mk_type, dest_vartype. \ENDDOC hol-light/Help/dest_uexists.doc000066400000000000000000000006031303454263000170460ustar00rootroot00000000000000\DOC dest_uexists \TYPE {dest_uexists : term -> term * term} \SYNOPSIS Breaks apart a unique existence term. \DESCRIBE If {t} has the form {?!x. p[x]} (there exists a unique [x} such that {p[x]} then {dest_uexists t} returns the pair {x,p[x]}; otherwise it fails. \FAILURE Fails if the term is not a `unique existence' term. \SEEALSO dest_exists, dest_forall, is_uexists. \ENDDOC hol-light/Help/dest_var.doc000066400000000000000000000006051303454263000161340ustar00rootroot00000000000000\DOC dest_var \TYPE {dest_var : term -> string * hol_type} \SYNOPSIS Breaks apart a variable into name and type. \DESCRIBE {dest_var `var:ty`} returns {("var",`:ty`)}. \FAILURE Fails with {dest_var} if term is not a variable. \EXAMPLE { # dest_var `x:num`;; val it : string * hol_type = ("x", `:num`) } \SEEALSO mk_var, is_var, dest_const, dest_comb, dest_abs, name_of. \ENDDOC hol-light/Help/dest_vartype.doc000066400000000000000000000007301303454263000170350ustar00rootroot00000000000000\DOC dest_vartype \TYPE {dest_vartype : hol_type -> string} \SYNOPSIS Breaks a type variable down to its name. \DESCRIBE {dest_vartype ":A"} returns {"A"} when {A} is a type variable. \FAILURE Fails with {dest_vartype} if the type is not a type variable. \EXAMPLE { # dest_vartype `:A`;; val it : string = "A" # dest_vartype `:A->B`;; Exception: Failure "dest_vartype: type constructor not a variable". } \SEEALSO mk_vartype, is_vartype, dest_type. \ENDDOC hol-light/Help/disjuncts.doc000066400000000000000000000024601303454263000163340ustar00rootroot00000000000000\DOC disjuncts \TYPE {disjuncts : term -> term list} \SYNOPSIS Iteratively breaks apart a disjunction. \DESCRIBE If a term {t} is a disjunction {p \/ q}, then {disjuncts t} will recursively break down {p} and {q} into disjuncts and append the resulting lists. Otherwise it will return the singleton list {[t]}. So if {t} is of the form {t1 \/ ... \/ tn} with any reassociation, no {ti} itself being a disjunction, the list returned will be {[t1; ...; tn]}. But { disjuncts(list_mk_disj([t1;...;tn])) } \noindent will not return {[t1;...;tn]} if any of {t1},...,{tn} is a disjunction. \FAILURE Never fails, even if the term is not boolean. \EXAMPLE { # list_mk_disj [`a \/ b`;`c \/ d`;`e \/ f`];; val it : term = `(a \/ b) \/ (c \/ d) \/ e \/ f` # disjuncts it;; val it : term list = [`a`; `b`; `c`; `d`; `e`; `f`] # disjuncts `1`;; val it : term list = [`1`] } \COMMENTS Because {disjuncts} splits both the left and right sides of a disjunction, this operation is not the inverse of {list_mk_disj}. You can also use {splitlist dest_disj} to split in a right-associated way only. \SEEALSO conjuncts, dest_disj, list_mk_disj. \ENDDOC hol-light/Help/distinctness.doc000066400000000000000000000016171303454263000170430ustar00rootroot00000000000000\DOC distinctness \TYPE {distinctness : string -> thm} \SYNOPSIS Produce distinctness theorem for an inductive type. \DESCRIBE A call {distinctness "ty"} where {"ty"} is the name of a recursive type defined with {define_type}, returns a ``distinctness'' theorem asserting that elements constructed by different type constructors are always different. The effect is exactly the same as if {prove_constructors_distinct} were applied to the recursion theorem produced by {define_type}, and the documentation for {prove_constructors_distinct} gives a lengthier discussion. \FAILURE Fails if {ty} is not the name of a recursive type, or if the type has only one constructor. \EXAMPLE { # distinctness "num";; val it : thm = |- !n'. ~(0 = SUC n') # distinctness "list";; val it : thm = |- !a0' a1'. ~([] = CONS a0' a1') } \SEEALSO cases, define_type, injectivity, prove_constructors_distinct. \ENDDOC hol-light/Help/distinctness_store.doc000066400000000000000000000007011303454263000202500ustar00rootroot00000000000000\DOC distinctness_store \TYPE {distinctness_store : (string * thm) list ref} \SYNOPSIS Internal theorem list of distinctness theorems. \DESCRIBE This list contains all the distinctness theorems (see {distinct}) for the recursive types defined so far. It is automatically extended by {define_type} and used as a cache by {distinct}. \FAILURE Not applicable. \SEEALSO define_type, distinctness, extend_rectype_net, injectivity_store. \ENDDOC hol-light/Help/do_list.doc000066400000000000000000000012451303454263000157630ustar00rootroot00000000000000\DOC do_list \TYPE {do_list : ('a -> 'b) -> 'a list -> unit} \SYNOPSIS Apply imperative function to each element of a list. \DESCRIBE The call {do_list f [x1; ... ; xn]} evaluates in sequence the expressions {f x1}, ..., {f xn} in that order, discarding the results. Presumably the applications will have some side-effect, such as printing something to the terminal. \EXAMPLE { # do_list (fun x -> print_string x; print_newline()) (explode "john");; j o h n val it : unit = () # do_list (fun x -> print_string x) (rev(explode "nikolas"));; salokinval it : unit = () } \USES Running imperative code parametrized by list members. \SEEALSO map. \ENDDOC hol-light/Help/dom.doc000066400000000000000000000015131303454263000151030ustar00rootroot00000000000000\DOC dom \TYPE {dom : ('a, 'b) func -> 'a list} \SYNOPSIS Returns domain of a finite partial function. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The {dom} operation returns the domain of such a function, i.e. the set of points on which it is defined. \FAILURE Attempts to sort the resulting list, so may fail if the domain type does not admit comparisons. \EXAMPLE { # dom (1 |=> "1");; val it : int list = [1] # dom(itlist I [2|->4; 3|->6] undefined);; val it : int list = [2; 3] } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/dpty.doc000066400000000000000000000003571303454263000153110ustar00rootroot00000000000000\DOC dpty \TYPE {dpty : pretype} \SYNOPSIS Dummy pretype. \DESCRIBE This is a dummy pretype, intended as a placeholder until the correct one is discovered. \FAILURE Not applicable. \SEEALSO pretype_of_type, type_of_pretype. \ENDDOC hol-light/Help/e.doc000066400000000000000000000031541303454263000145530ustar00rootroot00000000000000\DOC e \TYPE {e : tactic -> goalstack} \SYNOPSIS Applies a tactic to the current goal, stacking the resulting subgoals. \DESCRIBE The function {e} is part of the subgoal package. It applies a tactic to the current goal to give a new proof state. The previous state is stored on the backup list. If the tactic produces subgoals, the new proof state is formed from the old one by adding a new level consisting of its subgoals. The tactic applied is a validating version of the tactic given. It ensures that the justification of the tactic does provide a proof of the goal from the subgoals generated by the tactic. It will cause failure if this is not so. The tactical {VALID} performs this validation. For a description of the subgoal package, see {set_goal}. \FAILURE {e tac} fails if the tactic {tac} fails for the top goal. It will diverge if the tactic diverges for the goal. It will fail if there are no unproven goals. This could be because no goal has been set using {set_goal} or because the last goal set has been completely proved. It will also fail in cases when the tactic is invalid. \EXAMPLE { # g `(HD[1;2;3] = 1) /\ (TL[1;2;3] = [2;3])`;; val it : goalstack = 1 subgoal (1 total) `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` # e CONJ_TAC;; val it : goalstack = 2 subgoals (2 total) `TL [1; 2; 3] = [2; 3]` `HD [1; 2; 3] = 1` # e (REWRITE_TAC[HD]);; val it : goalstack = 1 subgoal (1 total) `TL [1; 2; 3] = [2; 3]` # e (REWRITE_TAC[TL]);; val it : goalstack = No subgoals } \USES Doing a step in an interactive goal-directed proof. \SEEALSO b, g, p, r, set_goal, top_goal, top_thm. \ENDDOC hol-light/Help/el.doc000066400000000000000000000006061303454263000147260ustar00rootroot00000000000000\DOC el \TYPE {el : int -> 'a list -> 'a} \SYNOPSIS Extracts a specified element from a list. \DESCRIBE {el i [x0;x1;...;xn]} returns {xi}. Note that the elements are numbered starting from {0}, not {1}. \FAILURE Fails with {el} if the integer argument is negative or greater than the length of the list. \EXAMPLE { # el 3 [1;2;7;1];; val it : int = 1 } \SEEALSO hd, tl. \ENDDOC hol-light/Help/elistof.doc000066400000000000000000000024251303454263000157740ustar00rootroot00000000000000\DOC elistof \TYPE {elistof : ('a -> 'b * 'a) -> ('a -> 'c * 'a) -> string -> 'a -> 'b list * 'a} \SYNOPSIS Parses a possibly empty separated list of items. \DESCRIBE If {p} is a parser for ``items'' of some kind, {s} is a parser for a ``separator'', and {e} is an error message, then {elistof p s e} parses a possibly empty list of successive items using {p}, where adjacent items are separated by something parseable by {s}. If a separator is parsed successfully but there is no following item that can be parsed by {s}, an exception {Failure e} is raised. (So note that the separator must not terminate the final element.) \FAILURE The call {elistof p s e} itself never fails, though the resulting parser may. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, finished, fix, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/empty_net.doc000066400000000000000000000012701303454263000163300ustar00rootroot00000000000000\DOC empty_net \TYPE {empty_net : 'a net} \SYNOPSIS Empty term net. \DESCRIBE Term nets (type {'a net}) are a lookup structure associating objects of type {'a}, e.g. conversions, with a corresponding `pattern' term. For a given term, one can then relatively quickly look up all objects whose pattern terms might possibly match to it. This is used, for example, in rewriting to quickly filter out obviously inapplicable rewrites rather than attempting each one in turn. The (polymorphic) object {empty_net} is the term net with no objects defined; it can then be augmented by {enter} or {merge_nets} and used in {lookup}. \FAILURE Not applicable. \SEEALSO enter, lookup, merge_nets. \ENDDOC hol-light/Help/empty_ss.doc000066400000000000000000000007711303454263000161740ustar00rootroot00000000000000\DOC empty_ss \TYPE {empty_ss : simpset} \SYNOPSIS Simpset consisting of only the default rewrites and conversions. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset'. The simpset {empty_ss} has just the basic rewrites and conversions (see {basic_rewrites} and {basic_convs}), and no other provers. \FAILURE Not applicable. \SEEALSO basic_convs, basic_rewrites, basic_ss, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/end_itlist.doc000066400000000000000000000006771303454263000164740ustar00rootroot00000000000000\DOC end_itlist \TYPE {end_itlist : ('a -> 'a -> 'a) -> 'a list -> 'a} \SYNOPSIS List iteration function. Applies a binary function between adjacent elements of a list. \DESCRIBE {end_itlist f [x1;...;xn]} returns {f x1 ( ... (f x(n-1) xn)...)}. Returns {x} for a one-element list {[x]}. \FAILURE Fails with {end_itlist} if list is empty. \EXAMPLE { # end_itlist (+) [1;2;3;4];; val it : int = 10 } \SEEALSO itlist, rev_itlist. \ENDDOC hol-light/Help/enter.doc000066400000000000000000000043351303454263000154460ustar00rootroot00000000000000\DOC enter \TYPE {enter : term list -> term * 'a -> 'a net -> 'a net} \SYNOPSIS Enter an object and its pattern term into a term net. \DESCRIBE Term nets (type {'a net}) are a lookup structure associating objects of type {'a}, e.g. conversions, with a corresponding `pattern' term. For a given term, one can then relatively quickly look up all objects whose pattern terms might possibly match to it. This is used, for example, in rewriting to quickly filter out obviously inapplicable rewrites rather than attempting each one in turn. The call {enter lconsts (pat,obj) net} enters the item {obj} into a net {obj} with indexing pattern term {pat}. The list {lconsts} lists variables that should be considered `local constants' when matching, so will only match terms with exactly the same variable in corresponding places. \FAILURE Never fails. \EXAMPLE Here we construct a net with the conversions for various arithmetic operations on numerals, each with a pattern term to identify the class of terms to which it might apply: { let arithnet = itlist (enter []) [`SUC n`,NUM_SUC_CONV; `m + n:num`,NUM_ADD_CONV; `m - n:num`,NUM_SUB_CONV; `m * n:num`,NUM_MULT_CONV; `m EXP n`,NUM_EXP_CONV; `m DIV n`,NUM_DIV_CONV; `m MOD n`,NUM_MOD_CONV] empty_net;; } Now we can define a conversion that uses lookup in this net as a first-stage filter and tries to apply the results. { let NUM_ARITH_CONV tm = FIRST_CONV (lookup tm arithnet) tm;; } Note that this is functionally not really different from just { let NUM_ARITH_CONV' = FIRST_CONV [NUM_SUC_CONV; NUM_ADD_CONV; NUM_SUB_CONV; NUM_MULT_CONV; NUM_EXP_CONV; NUM_DIV_CONV; NUM_MOD_CONV];; } \noindent but it may be significantly more efficient because instead of successive attempts to apply the conversions, each one is only invoked when the term has the right pattern. { # let tm = funpow 5 (fun x -> mk_binop `(*):num->num->num` x x) `12`;; ... time (DEPTH_CONV NUM_ARITH_CONV) term;; CPU time (user): 0.12 ... time (DEPTH_CONV NUM_ARITH_CONV') term;; CPU time (user): 0.22 ... } In situations with very many conversions, each one quite fast, the difference can be much more striking. \SEEALSO empty_net, lookup, merge_nets. \ENDDOC hol-light/Help/equals_goal.doc000066400000000000000000000010571303454263000166230ustar00rootroot00000000000000\DOC equals_goal \TYPE {equals_goal : goal -> goal -> bool} \SYNOPSIS Equality test on goals. \DESCRIBE The relation {equals_goal} tests if two goals have exactly the same structure, with the same assumptions, conclusions and even labels, with the assumptions in the same order. The only respect in which this differs from a pure equality tests is that the various term components are tested modulo alpha-conversion. \FAILURE Never fails. \COMMENTS Probably not generally useful. Used inside {CHANGED_TAC}. \SEEALSO CHANGED_TAC, equals_thm. \ENDDOC hol-light/Help/equals_thm.doc000066400000000000000000000010121303454263000164600ustar00rootroot00000000000000\DOC equals_thm \TYPE {equals_thm : thm -> thm -> bool} \SYNOPSIS Equality test on theorems. \DESCRIBE The call {equals_thm th1 th2} returns {true} if and only if both the conclusions and assumptions of the two theorems {th1} and {th2} are exactly the same. The same can be achieved by a simple equality test, but it is better practice to use this function because it will also work in the proof recording version of HOL Light (see the {Proofrecording} subdirectory). \FAILURE Never fails. \SEEALSO =?. \ENDDOC hol-light/Help/exactly.doc000066400000000000000000000003751303454263000160020ustar00rootroot00000000000000\DOC exactly \TYPE {exactly : term -> term} \SYNOPSIS Query to {search} for a term alpha-equivalent to pattern. \DESCRIBE The function {exactly} is intended for use solely with the {search} function. \FAILURE Never fails. \SEEALSO search. \ENDDOC hol-light/Help/exists.doc000066400000000000000000000010701303454263000156410ustar00rootroot00000000000000\DOC exists \TYPE {exists : ('a -> bool) -> 'a list -> bool} \SYNOPSIS Tests a list to see if some element satisfy a predicate. \KEYWORDS list. \DESCRIBE {exists p [x1;...;xn]} returns {true} if {(p xi)} is true for some {xi} in the list. Otherwise, for example if the list is empty, it returns {false}. \FAILURE Never fails. \EXAMPLE { # exists (fun n -> n mod 2 = 0) [2;3;5;7;11;13;17];; val it : bool = true # exists (fun n -> n mod 2 = 0) [3;5;7;9;11;13;15];; val it : bool = false } \SEEALSO find, forall, tryfind, mem, assoc, rev_assoc. \ENDDOC hol-light/Help/explode.doc000066400000000000000000000007161303454263000157700ustar00rootroot00000000000000\DOC explode \TYPE {explode : string -> string list} \SYNOPSIS Converts a string into a list of single-character strings. \DESCRIBE {explode s} returns the list of single-character strings that make up {s}, in the order in which they appear in {s}. If {s} is the empty string, then an empty list is returned. \FAILURE Never fails. \EXAMPLE { # explode "example";; val it : string list = ["e"; "x"; "a"; "m"; "p"; "l"; "e"] } \SEEALSO implode. \ENDDOC hol-light/Help/extend_basic_congs.doc000066400000000000000000000024131303454263000201450ustar00rootroot00000000000000\DOC extend_basic_congs \TYPE {extend_basic_congs : thm list -> unit} \SYNOPSIS Extends the set of congruence rules used by the simplifier. \DESCRIBE The HOL Light simplifier (as invoked by {SIMP_TAC} etc.) uses congruence rules to determine how it uses context when descending through a term. These are essentially theorems showing how to decompose one equality to a series of other inequalities in context. A call to {extend_basic_congs thl} adds the congruence rules in {thl} to the defaults. \FAILURE Never fails. \EXAMPLE By default, the simplifier uses context {p} when simplifying {q} within an implication {p ==> q}. Some users would like the simplifier to do likewise for a conjunction {p /\ q}, which is not done by default: { # SIMP_CONV[] `x = 1 /\ x < 2`;; val it : thm = |- x = 1 /\ x < 2 <=> x = 1 /\ x < 2 } \noindent You can make it do so with { # extend_basic_congs [TAUT `(p <=> p') ==> (p' ==> (q <=> q')) ==> (p /\ q <=> p' /\ q')`];; val it : unit = () } \noindent as you can see: { # SIMP_CONV[] `x = 1 /\ x < 2`;; val it : thm = |- x = 1 /\ x < 2 <=> x = 1 /\ 1 < 2 # SIMP_CONV[ARITH] `x = 1 /\ x < 2`;; val it : thm = |- x = 1 /\ x < 2 <=> x = 1 } \SEEALSO basic_congs, set_basic_congs, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/extend_basic_convs.doc000066400000000000000000000024751303454263000201740ustar00rootroot00000000000000\DOC extend_basic_convs \TYPE {extend_basic_convs : string * (term * conv) -> unit} \SYNOPSIS Extend the set of default conversions used by rewriting and simplification. \DESCRIBE The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. The latter are normally term transformations that cannot be expressed as single (conditional or unconditional) rewrite rules. A call to { extend_basic_convs("name",(`pat`,conv)) } will add the conversion {conv} into the default set, using the name {name} to refer to it and restricting it to subterms encountered that match {pat}. \FAILURE Never fails. \EXAMPLE By default, no arithmetic is done in rewriting, though rewriting with the theorem {ARITH} gives that effect. { # REWRITE_CONV[] `x = 1 + 2 + 3 + 4`;; val it : thm = |- x = 1 + 2 + 3 + 4 <=> x = 1 + 2 + 3 + 4 } You can add {NUM_ADD_CONV} to the set of default conversions by { # extend_basic_convs("addition on nat",(`m + n:num`,NUM_ADD_CONV));; val it : unit = () } \noindent and now it happens by default: { # REWRITE_CONV[] `x = 1 + 2 + 3 + 4`;; val it : thm = |- x = 1 + 2 + 3 + 4 <=> x = 10 } \SEEALSO basic_convs, extend_basic_rewrites, set_basic_convs. \ENDDOC hol-light/Help/extend_basic_rewrites.doc000066400000000000000000000011401303454263000206740ustar00rootroot00000000000000\DOC extend_basic_rewrites \TYPE {extend_basic_rewrites : thm list -> unit} \SYNOPSIS Extend the set of default rewrites used by rewriting and simplification. \DESCRIBE The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. A call to {extend_basic_rewrites thl} extends the former with the list of theorems {thl}, so they will thereafter happen by default. \FAILURE Never fails. \SEEALSO basic_rewrites, extend_basic_convs, set_basic_rewrites. \ENDDOC hol-light/Help/extend_rectype_net.doc000066400000000000000000000016061303454263000202170ustar00rootroot00000000000000\DOC extend_rectype_net \TYPE {extend_rectype_net : string * ('a * 'b * thm) -> unit} \SYNOPSIS Extends internal store of distinctness and injectivity theorems for a new inductive type. \DESCRIBE HOL Light maintains several data structures based on the current set of distinctness and injectivity theorems for the inductive data type so far defined. A call {extend_rectype_net ("tyname",(_,_,rth))} where {rth} is the recursion theorem for the type as returned as the second item from {define_type}, extend these structures for a new type. Two arguments are ignored just for regularity with some other internal data structures. \FAILURE Never fails, even if the theorem is malformed. \COMMENTS This function is called automatically by {define_type}, and normally users will not need to invoke it explicitly. \SEEALSO basic_rectype_net, define_type, distinctness_store, injectivity_store. \ENDDOC hol-light/Help/f_f_.doc000066400000000000000000000002101303454263000152060ustar00rootroot00000000000000\DOC f_f_ \TYPE {f_f_ : ('a -> 'b) -> ('c -> 'd) -> 'a * 'c -> 'b * 'd} \SYNOPSIS Non-infix version of {F_F}. \SEEALSO F_F. \ENDDOC hol-light/Help/fail.doc000066400000000000000000000012221303454263000152340ustar00rootroot00000000000000\DOC fail \TYPE {fail : unit -> 'a} \SYNOPSIS Fail with empty string. \DESCRIBE In HOL Light, the class of exceptions {Failure "string"} is used consistently. This makes it easy to catch all HOL-related exceptions by a {Failure _} pattern without accidentally catching others. In general, the failure can be generated by {failwith "string"}, but the special case of an empty string is bound to the function {fail}. \FAILURE Always fails. \USES Useful when there is no intention to propagate helpful information about the cause of the exception, for example because you know it will be caught and handled without discrimination. \SEEALSO \ENDDOC hol-light/Help/file_of_string.doc000066400000000000000000000012461303454263000173200ustar00rootroot00000000000000\DOC file_of_string \TYPE {file_of_string : string -> string -> unit} \SYNOPSIS Write out a string to a named file. \DESCRIBE Given a filename {fn} and a string {s}, the call {file_of_string fn s} attempts to open the file {fn} for writing and writes the string {s} to it before closing. If the file exists, it will be overwritten, and otherwise a new file will be created. \FAILURE Fails if the file cannot be opened for writing. \EXAMPLE The call { # file_of_string "/tmp/hello" "Hello world\nGoodbye world";; val it : unit = () } will result in a file {/tmp/hello} containing the text: { Hello world Goodbye world \SEEALSO string_of_file, strings_of_file. \ENDDOC hol-light/Help/file_on_path.doc000066400000000000000000000015771303454263000167650ustar00rootroot00000000000000\DOC file_on_path \TYPE {file_on_path : string list -> string -> string} \SYNOPSIS Expands relative filename to first available one in path. \DESCRIBE When given an absolute filename, (e.g. on Linux/Unix one starting with a slash or tilde), this function returns it unchanged. Otherwise it tries to find the file in one of the directories in the path argument. An initial dollar sign {$} in each path is interpreted as a reference to the current setting of {hol_dir}. To get an actual {$} at the start of the filename, actually use two dollar signs {$$}. \FAILURE Fails if no file is found on the path. \EXAMPLE { # file_on_path (!load_path) "Library/analysis.ml";; val it : string = "/home/johnh/holl/Library/analysis.ml" # file_on_path (!load_path) "Library/wibble.ml";; Exception: Not_found. } \SEEALSO help_path, hol_dir, load_on_path, load_path, loads, loadt, needs. \ENDDOC hol-light/Help/filter.doc000066400000000000000000000006411303454263000156120ustar00rootroot00000000000000\DOC filter \TYPE {filter : ('a -> bool) -> 'a list -> 'a list} \SYNOPSIS Filters a list to the sublist of elements satisfying a predicate. \KEYWORDS list. \DESCRIBE {filter p l} applies {p} to every element of {l}, returning a list of those that satisfy {p}, in the order they appeared in the original list. \FAILURE Fails if the predicate fails on any element. \SEEALSO mapfilter, partition, remove. \ENDDOC hol-light/Help/find.doc000066400000000000000000000006571303454263000152540ustar00rootroot00000000000000\DOC find \TYPE {find : ('a -> bool) -> 'a list -> 'a} \SYNOPSIS Returns the first element of a list which satisfies a predicate. \KEYWORDS list. \DESCRIBE {find p [x1;...;xn]} returns the first {xi} in the list such that {(p xi)} is {true}. \FAILURE Fails with {find} if no element satisfies the predicate. This will always be the case if the list is empty. \SEEALSO tryfind, mem, exists, forall, assoc, rev_assoc. \ENDDOC hol-light/Help/find_path.doc000066400000000000000000000014551303454263000162650ustar00rootroot00000000000000\DOC find_path \TYPE {find_path : (term -> bool) -> term -> string} \SYNOPSIS Returns a path to some subterm satisfying a predicate. \DESCRIBE The call {find_path p t} traverses the term {t} top-down until it finds a subterm satisfying the predicate {p}. It then returns a path indicating how to reach it; this is just a string with each character interpreted as: \begin{{itemize}} \item {"b"}: take the body of an abstraction \item {"l"}: take the left (rator) path in an application \item {"r"}: take the right (rand) path in an application \end{{itemize}} \FAILURE Fails if there is no subterm satisfying {p}. \EXAMPLE { # find_path is_list `!x. ~(x = []) ==> CONS (HD x) (TL x) = x`;; Warning: inventing type variables val it : string = "rblrrr" } \SEEALSO follow_path, PATH_CONV. \ENDDOC hol-light/Help/find_term.doc000066400000000000000000000007011303454263000162710ustar00rootroot00000000000000\DOC find_term \TYPE {find_term : (term -> bool) -> term -> term} \SYNOPSIS Searches a term for a subterm that satisfies a given predicate. \DESCRIBE The largest subterm, in a depth-first, left-to-right search of the given term, that satisfies the predicate is returned. \FAILURE Fails if no subterm of the given term satisfies the predicate. \EXAMPLE { # find_term is_var `x + y + z`;; val it : term = `x` } \SEEALSO find_terms. \ENDDOC hol-light/Help/find_terms.doc000066400000000000000000000011271303454263000164570ustar00rootroot00000000000000\DOC find_terms \TYPE {find_terms : (term -> bool) -> term -> term list} \SYNOPSIS Searches a term for all subterms that satisfy a predicate. \DESCRIBE A list of subterms of a given term that satisfy the predicate is returned. \FAILURE Never fails. \EXAMPLE This is a simple example: { # find_terms is_var `x + y + z`;; val it : term list = [`z`; `y`; `x`] } \noindent while the following shows that the terms returned may overlap or contain each other: { # find_terms is_comb `x + y + z`;; val it : term list = [`(+) y`; `y + z`; `(+) x`; `x + y + z`] } \SEEALSO find_term. \ENDDOC hol-light/Help/finished.doc000066400000000000000000000017131303454263000161170ustar00rootroot00000000000000\DOC finished \TYPE {finished : 'a list -> int * 'a list} \SYNOPSIS Parser that checks emptiness of the input. \DESCRIBE The function {finished} tests if its input is the empty list, and if so returns a pair of zero and that input. Otherwise it fails. \FAILURE Fails on nonempty input. \USES This function is intended to check that some parsing operation has absorbed all the input. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, fix, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/fix.doc000066400000000000000000000020341303454263000151110ustar00rootroot00000000000000\DOC fix \TYPE {fix : string -> ('a -> 'b) -> 'a -> 'b} \SYNOPSIS Applies parser and fails if it raises {Noparse}. \DESCRIBE Parsers raise {Noparse} to indicate that they were not able to make any progress at all. If {p} is such a parser, {fix s p} gives a new parser where a {Noparse} exception from {p} will result in a {Failure s} exception, but is otherwise the same as {p}. \FAILURE The immediate call {fix s p} never fails, but the resulting parser may. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, leftbin, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/flat.doc000066400000000000000000000005371303454263000152570ustar00rootroot00000000000000\DOC flat \TYPE {flat : 'a list list -> 'a list} \SYNOPSIS Flattens a list of lists into one long list. \KEYWORDS list. \DESCRIBE {flat [l1;...;ln]} returns {(l1 @ ... @ ln)} where each li is a list and {@} is list concatenation. \FAILURE Never fails. \EXAMPLE { # flat [[1;2];[3;4;5];[6]];; val it : int list = [1; 2; 3; 4; 5; 6] } \ENDDOC hol-light/Help/flush_goalstack.doc000066400000000000000000000007641303454263000175040ustar00rootroot00000000000000\DOC flush_goalstack \TYPE {flush_goalstack : unit -> unit} \SYNOPSIS Eliminate all but the current goalstate from the current goalstack. \DESCRIBE Normally, the current goalstack has the current goalstate at the head and all previous intermediate states further back in the list. This function {flush_goalstack()} keeps just the current goalstate and eliminates all previous states. \FAILURE Fails if there is no current goalstate, i.e. if the goalstack is empty. \SEEALSO b, g, r. \ENDDOC hol-light/Help/foldl.doc000066400000000000000000000025411303454263000154260ustar00rootroot00000000000000\DOC foldl \TYPE {foldl : ('a -> 'b -> 'c -> 'a) -> 'a -> ('b, 'c) func -> 'a} \SYNOPSIS Folds an operation iteratively over the graph of a finite partial function. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If a finite partial function {p} has graph {[x1,y1; ...; xn,yn]} then the application {foldl f a p} returns { f (f ... (f (f a x1 y1) x2 y2) ...) xn yn } Note that the order in which the pairs are operated on depends on the internal structure of the finite partial function, and is often not the most obvious. \FAILURE Fails if one of the embedded function applications does. \EXAMPLE The {graph} function is implemented based on the following invocation of {foldl}, with an additional sorting phase afterwards: { # let f = (1 |-> 2) (2 |=> 3);; val f : (int, int) func = # graph f;; val it : (int * int) list = [(1, 2); (2, 3)] # foldl (fun a x y -> (x,y)::a) [] f;; val it : (int * int) list = [(1, 2); (2, 3)] } Note that in this case the order happened to be the same, but this is an accident. \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/foldr.doc000066400000000000000000000026311303454263000154340ustar00rootroot00000000000000\DOC foldr \TYPE {foldr : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) func -> 'c -> 'c} \SYNOPSIS Folds an operation iteratively over the graph of a finite partial function. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If a finite partial function {p} has graph {[x1,y1; ...; xn,yn]} then the application {foldl f p a} returns { f x1 y1 (f x2 y2 (f x3 y3 (f ... (f xn yn a) ... ))) } Note that the order in which the pairs are operated on depends on the internal structure of the finite partial function, and is often not the most obvious. \FAILURE Fails if one of the embedded function applications does. \EXAMPLE { # let f = (1 |-> 2) (2 |=> 3);; val f : (int, int) func = # graph f;; val it : (int * int) list = [(1, 2); (2, 3)] # foldr (fun x y a -> (x,y)::a) f [];; val it : (int * int) list = [(2, 3); (1, 2)] } Note how the pairs are actually processed in the opposite order to the order in which they are presented by {graph}. The order will in general not be obvious, and generally this is applied to operations with appropriate commutativity properties. \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/follow_path.doc000066400000000000000000000013741303454263000166470ustar00rootroot00000000000000\DOC follow_path \TYPE {follow_path : string -> term -> term} \SYNOPSIS Find the subterm of a given term indicated by a path. \DESCRIBE A call {follow_path p t} follows path {p} inside {t} and returns the subterm encountered. The path is a string with the successive characters interpreted as follows: \begin{{itemize}} \item {"b"}: take the body of an abstraction \item {"l"}: take the left (rator) path in an application \item {"r"}: take the right (rand) path in an application \end{{itemize}} \FAILURE Fails if the path is not meaningful for the term, e.g. if a {"b"} is encountered for a subterm that is not an abstraction. \EXAMPLE { # follow_path "rrlr" `1 + 2 + 3 + 4 + 5`;; val it : term = `3` } \SEEALSO find_path, PATH_CONV. \ENDDOC hol-light/Help/forall.doc000066400000000000000000000010641303454263000156040ustar00rootroot00000000000000\DOC forall \TYPE {forall : ('a -> bool) -> 'a list -> bool} \SYNOPSIS Tests a list to see if all its elements satisfy a predicate. \KEYWORDS list. \DESCRIBE {forall p [x1;...;xn]} returns {true} if {(p xi)} is true for all {xi} in the list. Otherwise it returns {false}. If the list is empty, this function always returns true. \FAILURE Never fails. \EXAMPLE { # forall (fun x -> x <= 2) [0;1;2];; val it : bool = true # forall (fun x -> x <= 2) [1;2;3];; val it : bool = false } \SEEALSO exists, find, tryfind, mem, assoc, rev_assoc. \ENDDOC hol-light/Help/forall2.doc000066400000000000000000000013271303454263000156700ustar00rootroot00000000000000\DOC forall2 \TYPE {forall2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool} \SYNOPSIS Tests if corresponding elements of two lists all satisfy a relation. \DESCRIBE {forall p [x1;...;xn] [y1;...;yn]} returns {true} if {(p xi yi)} is true for all corresponding {xi} and {yi} in the list. Otherwise, or if the lengths of the lists are different, it returns {false}. \FAILURE Never fails. \EXAMPLE Here we check whether all elements of the first list are less than the corresponding element of the second: { # forall2 (<) [1;2;3] [2;3;4];; val it : bool = true # forall2 (<) [1;2;3;4] [5;4;3;2];; val it : bool = false # forall2 (<) [1] [2;3];; val it : bool = false } \SEEALSO exists, forall. \ENDDOC hol-light/Help/free_in.doc000066400000000000000000000016021303454263000157320ustar00rootroot00000000000000\DOC free_in \TYPE {free_in : term -> term -> bool} \SYNOPSIS Tests if one term is free in another. \DESCRIBE When applied to two terms {t1} and {t2}, the function {free_in} returns {true} if {t1} is free in {t2}, and {false} otherwise. It is not necessary that {t1} be simply a variable. \FAILURE Never fails. \EXAMPLE In the following example {free_in} returns {false} because the {x} in {SUC x} in the second term is bound: { # free_in `SUC x` `!x. SUC x = x + 1`;; val it : bool = false } \noindent whereas the following call returns {true} because the first instance of {x} in the second term is free, even though there is also a bound instance: { # free_in `x:bool` `x /\ (?x. x=T)`;; val it : bool = true } \COMMENTS If the term {t1} is a variable, the rule {vfree_in} is more basic and probably more efficient. \SEEALSO frees, freesin, freesl, thm_frees, vfree_in. \ENDDOC hol-light/Help/frees.doc000066400000000000000000000010511303454263000154250ustar00rootroot00000000000000\DOC frees \TYPE {frees : term -> term list} \SYNOPSIS Returns a list of the variables free in a term. \DESCRIBE When applied to a term, {frees} returns a list of the free variables in that term. There are no repetitions in the list produced even if there are multiple free instances of some variables. \FAILURE Never fails. \EXAMPLE Clearly in the following term, {x} and {y} are free, whereas {z} is bound: { # frees `x = 1 /\ y = 2 /\ !z. z >= 0`;; val it : term list = [`x`; `y`] } \SEEALSO freesl, free_in, thm_frees, variables. \ENDDOC hol-light/Help/freesin.doc000066400000000000000000000013461303454263000157630ustar00rootroot00000000000000\DOC freesin \TYPE {freesin : term list -> term -> bool} \SYNOPSIS Tests if all free variables of a term appear in a list. \DESCRIBE The call {freesin l t} tests whether all free variables of {t} occur in the list {l}. The special case where {l = []} will therefore test whether {t} is closed (i.e. contains no free variables). \FAILURE Never fails. \EXAMPLE { # freesin [] `!x y. x + y >= 0`;; val it : bool = true # freesin [] `x + y >= 0`;; val it : bool = false # freesin [`x:num`; `y:num`; `z:num`] `x + y >= 0`;; val it : bool = true } \USES Can be attractive to fold together some free-variable tests without explicitly constructing the set of free variables in a term. \SEEALSO frees, freesl, vfree_in. \ENDDOC hol-light/Help/freesl.doc000066400000000000000000000011731303454263000156060ustar00rootroot00000000000000\DOC freesl \TYPE {freesl : term list -> term list} \SYNOPSIS Returns a list of the free variables in a list of terms. \DESCRIBE When applied to a list of terms, {freesl} returns a list of the variables which are free in any of those terms. There are no repetitions in the list produced even if several terms contain the same free variable. \FAILURE Never fails. \EXAMPLE In the following example there are free instances of each of {w}, {x} and {y}, whereas the only instances of {z} are bound: { # freesl [`x + y = 2`; `!z. z >= x - w`];; val it : term list = [`y`; `x`; `w`] } \SEEALSO frees, free_in, thm_frees. \ENDDOC hol-light/Help/funpow.doc000066400000000000000000000013401303454263000156400ustar00rootroot00000000000000\DOC funpow \TYPE {funpow : int -> ('a -> 'a) -> 'a -> 'a} \SYNOPSIS Iterates a function a fixed number of times. \DESCRIBE {funpow n f x} applies {f} to {x}, {n} times, giving the result {f (f ... (f x)...)} where the number of {f}'s is {n}. {funpow 0 f x} returns {x}. If {n} is negative, it is treated as zero. \FAILURE {funpow n f x} fails if any of the {n} applications of f fail. \EXAMPLE Apply {tl} three times to a list: { # funpow 3 tl [1;2;3;4;5];; val it : int list = [4; 5] } \noindent Apply {tl} zero times: { # funpow 0 tl [1;2;3;4;5];; val it : int list = [1; 2; 3; 4; 5] } \noindent Apply {tl} six times to a list of only five elements: { # funpow 6 tl [1;2;3;4;5];; Exception: Failure "tl". } \ENDDOC hol-light/Help/g.doc000066400000000000000000000011351303454263000145520ustar00rootroot00000000000000\DOC g \TYPE {g : term -> goalstack} \SYNOPSIS Initializes the subgoal package with a new goal which has no assumptions. \DESCRIBE The call { g `tm` } \noindent is equivalent to { set_goal([],`tm`) } \noindent and clearly more convenient if a goal has no assumptions. For a description of the subgoal package, see {set_goal}. \FAILURE Fails unless the argument term has type {bool}. \EXAMPLE { # g `HD[1;2;3] = 1 /\ TL[1;2;3] = [2;3]`;; val it : goalstack = 1 subgoal (1 total) `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` } \SEEALSO b, e, p, r, set_goal, top_goal, top_thm. \ENDDOC hol-light/Help/gcd.doc000066400000000000000000000010211303454263000150530ustar00rootroot00000000000000\DOC gcd \TYPE {gcd : int -> int -> int} \SYNOPSIS Computes greatest common divisor of two integers. \DESCRIBE The call {gcd m n} for two integers {m} and {n} returns the (nonnegative) greatest common divisor of {m} and {n}. If {m} and {n} are both zero, it returns zero. \FAILURE Never fails. \EXAMPLE { # gcd 10 12;; val it : int = 2 # gcd 11 27;; val it : int = 1 # gcd (-33) 76;; val it : int = 1 # gcd 0 99;; val it : int = 99 # gcd 0 0;; val it : int = 0 } \SEEALSO gcd_num, lcm_num. \ENDDOC hol-light/Help/gcd_num.doc000066400000000000000000000012431303454263000157400ustar00rootroot00000000000000\DOC gcd_num \TYPE {gcd_num : num -> num -> num} \SYNOPSIS Computes greatest common divisor of two unlimited-precision integers. \DESCRIBE The call {gcd_num m n} for two unlimited-precision (type {num}) integers {m} and {n} returns the (positive) greatest common divisor of {m} and {n}. If both {m} and {n} are zero, it returns zero. \FAILURE Fails if either number is not an integer (the type {num} supports arbitrary rationals). \EXAMPLE { # gcd_num (Int 35) (Int(-77));; val it : num = 7 # gcd_num (Int 11) (Int 0);; val it : num = 11 # gcd_num (Int 22 // Int 7) (Int 2);; Exception: Failure "big_int_of_ratio". } \SEEALSO gcd, lcm_num. \ENDDOC hol-light/Help/genvar.doc000066400000000000000000000015351303454263000156120ustar00rootroot00000000000000\DOC genvar \TYPE {genvar : hol_type -> term} \SYNOPSIS Returns a `fresh' variable with specified type. \DESCRIBE When given a type, {genvar} returns a variable of that type whose name has not previously been produced by {genvar}. \FAILURE Never fails. \EXAMPLE The following indicates the typical stylized form of the names (this should not be relied on, of course): { # genvar `:bool`;; val it : term = `_56799` } There is no guard against users' own variables clashing, but if the user avoids names in the same lexical style, that can be guaranteed. \USES The unique variables are useful in writing derived rules, for specializing terms without having to worry about such things as free variable capture. If the names are to be visible to a typical user, the function {variant} can provide rather more meaningful names. \SEEALSO variant. \ENDDOC hol-light/Help/get_const_type.doc000066400000000000000000000006571303454263000173620ustar00rootroot00000000000000\DOC get_const_type \TYPE {get_const_type : string -> hol_type} \SYNOPSIS Gets the generic type of a constant from the name of the constant. \DESCRIBE {get_const_type "c"} returns the generic type of {`c`}, if {`c`} is a constant. \FAILURE {get_const_type st} fails if {st} is not the name of a constant. \EXAMPLE { # get_const_type "COND";; val it : hol_type = `:bool->A->A->A` } \SEEALSO dest_const, is_const. \ENDDOC hol-light/Help/get_infix_status.doc000066400000000000000000000013301303454263000177000ustar00rootroot00000000000000\DOC get_infix_status \TYPE {get_infix_status : string -> int * string} \SYNOPSIS Get the precedence and associativity of an infix operator. \DESCRIBE Certain identifiers are treated as infix operators with a given precedence and associativity (left or right). The call {get_infix_status "op"} looks up {op} in this list and returns a pair consisting of its precedence and its associativity; the latter is one of the strings {"left"} or {"right"}. \FAILURE Fails if the given string does not have infix status. \EXAMPLE { # get_infix_status "/";; val it : int * string = (22, "left") # get_infix_status "UNION";; val it : int * string = (16, "right") } \SEEALSO infixes, parse_as_infix, unparse_as_infix. \ENDDOC hol-light/Help/get_type_arity.doc000066400000000000000000000011421303454263000173520ustar00rootroot00000000000000\DOC get_type_arity \TYPE {get_type_arity : string -> int} \SYNOPSIS Returns the arity of a type constructor. \DESCRIBE When applied to the name of a type constructor, {arity} returns its arity, i.e. how many types it is supposed to be applied to. Base types like {:bool} are regarded as constructors with zero arity. \FAILURE Fails if there is no type constructor of that name. \EXAMPLE { # get_type_arity "bool";; val it : int = 0 # get_type_arity "fun";; val it : int = 2 # get_type_arity "nocon";; Exception: Failure "find". } \SEEALSO new_type, new_type_definition, types. \ENDDOC hol-light/Help/graph.doc000066400000000000000000000016071303454263000154310ustar00rootroot00000000000000\DOC graph \TYPE {graph : ('a, 'b) func -> ('a * 'b) list} \SYNOPSIS Returns the graph of a finite partial function. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The {graph} function takes a finite partial function that maps {x1} to {y1}, ..., {xn} to {yn} and returns its graph as a set/list: {[x1,y1; ...; xn,yn]}. \FAILURE Attempts to sort the resulting list, so may fail if the type of the pairs does not permit comparison. \EXAMPLE { # graph undefined;; val it : ('a * 'b) list = [] # graph (1 |=> 2);; val it : (int * int) list = [(1, 2)] } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/hd.doc000066400000000000000000000003251303454263000147170ustar00rootroot00000000000000\DOC hd \TYPE {hd : 'a list -> 'a} \SYNOPSIS Computes the first element (the head) of a list. \DESCRIBE {hd [x1;...;xn]} returns {x1}. \FAILURE Fails with {hd} if the list is empty. \SEEALSO tl, el. \ENDDOC hol-light/Help/help.doc000066400000000000000000000032731303454263000152610ustar00rootroot00000000000000\DOC help \TYPE {help : string -> unit} \SYNOPSIS Displays help on a given identifier in the system. \DESCRIBE A call {help "s"} will attempt to display the help file associated with a particular identifier {s} in the system. If there is no entry for identifier {s}, the call responds instead with some possibly helpful suggestions as to what you might have meant, based on a simple `edit distance' criterion. The built-in help files are stored in the {Help} subdirectory of HOL Light. Users can add additional locations by modifying {help_path}. Normally the help file for an identifier {name} would be called {name.doc}, but there are a few exceptions, because some identifiers have characters that cannot be put in filenames and some platforms like Cygwin have inadequate case sensitivity. \FAILURE Never fails. \EXAMPLE Here is a successful call: { # help "lhs";; ------------------------------------------------------------------- lhs : term -> term SYNOPSIS Returns the left-hand side of an equation. DESCRIPTION lhs `t1 = t2` returns `t1`. FAILURE CONDITIONS Fails with lhs if the term is not an equation. EXAMPLES # lhs `2 + 2 = 4`;; val it : term = `2 + 2` SEE ALSO dest_eq, lhand, rand, rhs. ------------------------------------------------------------------- val it : unit = () } \noindent and here is one for a non-existent identifier: { # help "IMP_TAC";; ------------------------------------------------------------------- No help found for "IMP_TAC"; did you mean: help "SIMP_TAC";; help "MP_TAC";; help "IMP_TRANS";; ? -------------------------------------------------------------------- } \SEEALSO help_path, hol_version. \ENDDOC hol-light/Help/help_path.doc000066400000000000000000000011371303454263000162720ustar00rootroot00000000000000\DOC help_path \TYPE {help_path : string list ref} \SYNOPSIS Path where HOL Light tries to find help files. \DESCRIBE The reference variable {help_path} gives a list of directories. When using the online {help} function, HOL Light will search in these places for help files. An initial dollar sign {$} in each path is interpreted as a reference to the current setting of {hol_dir}. To get an actual {$} at the start of the filename, actually use two dollar signs {$$}. \FAILURE Not applicable. \SEEALSO file_on_path, help, hol_dir, hol_expand_directory, load_on_path, load_path, loads, loadt. \ENDDOC hol-light/Help/hide_constant.doc000066400000000000000000000012041303454263000171430ustar00rootroot00000000000000\DOC hide_constant \TYPE {hide_constant : string -> unit} \SYNOPSIS Stops the quotation parser from recognizing a constant. \DESCRIBE A call {hide_constant "c"} where {c} is the name of a constant, will prevent the quotation parser from parsing it as such; it will just be parsed as a variable. The effect can be reversed by {unhide_constant "c"}. \FAILURE Fails if the given name is not a constant of the current theory, or if the named constant is already hidden. \COMMENTS The hiding of a constant only affects the quotation parser; the constant is still there in a theory, and may not be redefined. \SEEALSO unhide_constant. \ENDDOC hol-light/Help/hol_dir.doc000066400000000000000000000012611303454263000157440ustar00rootroot00000000000000\DOC hol_dir \TYPE {hol_dir : string ref} \SYNOPSIS Base directory in which HOL Light is installed. \DESCRIBE This reference variable holds the directory (folder) for the base of the HOL Light distribution. This information is used, for example, when loading files with {loads}. Normally set to the current directory when HOL Light is loaded or built, but picked up from the system variable {HOLLIGHT_DIR} if it is defined. \FAILURE Not applicable. \EXAMPLE On my laptop, the value is: { # !hol_dir;; val it : string = "/home/johnh/holl" } \USES Ensuring that HOL Light can find any libraries or other system files needed to support proofs. \SEEALSO load_path, loads. \ENDDOC hol-light/Help/hol_expand_directory.doc000066400000000000000000000014011303454263000205250ustar00rootroot00000000000000\DOC hol_expand_directory \TYPE {hol_expand_directory : string -> string} \SYNOPSIS Modifies directory name starting with {$} to include HOL directory \DESCRIBE The function {hol_expand_directory} takes a string indicating a directory. If it does not begin with a dollar sign {$}, the string is returned unchanged. Otherwise, the initial dollar sign is replaced with the current HOL Light directory {hol_dir}. To get an actual {$} at the start of the returned directory, actually use two dollar signs {$$}. \FAILURE Never fails. \EXAMPLE { # hol_dir;; val it : string ref = {contents = "/home/johnh/holl"} # hol_expand_directory "$/Help";; val it : string = "/home/johnh/holl/Help" } \SEEALSO file_on_path, help_path, load_on_path, load_path. \ENDDOC hol-light/Help/hol_version.doc000066400000000000000000000004761303454263000166620ustar00rootroot00000000000000\DOC hol_version \TYPE {hol_version : string} \SYNOPSIS A string indicating the version of HOL Light. \DESCRIBE This string is a numeric version number for HOL Light. \FAILURE Not applicable. \EXAMPLE On my laptop, the value is: { # hol_version;; val it : string = "2.10" } \SEEALSO startup_banner. \ENDDOC hol-light/Help/hyp.doc000066400000000000000000000006511303454263000151260ustar00rootroot00000000000000\DOC hyp \TYPE {hyp : thm -> term list} \SYNOPSIS Returns the hypotheses of a theorem. \DESCRIBE When applied to a theorem {A |- t}, the function {hyp} returns {A}, the list of hypotheses of the theorem. \FAILURE Never fails. \EXAMPLE { # let th = ADD_ASSUM `x = 1` (ASSUME `y = 2`);; val th : thm = y = 2, x = 1 |- y = 2 # hyp th;; val it : term list = [`y = 2`; `x = 1`] } \SEEALSO dest_thm, concl. \ENDDOC hol-light/Help/ideal_cofactors.doc000066400000000000000000000022561303454263000174520ustar00rootroot00000000000000\DOC ideal_cofactors \TYPE {ideal_cofactors : (term -> num) * (num -> term) * conv * term * term * term * term * term * term * term * thm * (term -> thm) -> term list -> term -> term list} \SYNOPSIS Generic procedure to compute cofactors for ideal membership. \DESCRIBE The {ideal_cofactors} function takes first the same set of arguments as {RING}, defining a suitable ring for it to operate over. (See the entry for {RING} for details.) It then yields a function that given a list of terms {[p1; ...; pn]} and another term {p}, all of which have the right type to be considered as polynomials over the ring, attempts to find a corresponding set of `cofactors' {[q1; ...; qn]} such that the following is an algebraic ring identity: { p = p1 * q1 + ... + pn * qn } That is, it provides a concrete certificate for the fact that {p} is in the ideal generated by the {p1,...,pn}. If {p} is not in this ideal, the function will fail. \FAILURE Fails if the `polynomials' are of the wrong type, or if ideal membership does not hold. \EXAMPLE For an example of the real-number instantiation in action, see {real_ideal_cofactors}. \SEEALSO real_ideal_cofactors, RING, RING_AND_IDEAL_CONV. \ENDDOC hol-light/Help/ignore_constant_varstruct.doc000066400000000000000000000016721303454263000216430ustar00rootroot00000000000000\DOC ignore_constant_varstruct \TYPE {ignore_constant_varstruct : bool ref} \SYNOPSIS Interpret a simple varstruct as a variable, even if there is a constant of that name. \DESCRIBE As well as conventional abstractions {`\x. t`} where {x} is a variable, HOL Light permits generalized abstractions where the varstruct is a more complex term, e.g. {`\(x,y). x + y`}. This includes the degenerate case of just a constant. However, one may want a regular abstraction whose bound variable happens to be in use as a constant. When parsing a quotation {"\c. t"} where {c} is the name of a constant, HOL Light interprets it as a simple abstraction with a variable {c} when the flag {ignore_constant_varstruct} is {true}, as it is by default. It will interpret it as a degenerate generalized abstraction, only useful when applied to the constant {c}, if the flag is {false}. \FAILURE Not applicable. \SEEALSO GEN_BETA_CONV, is_abs, is_gabs. \ENDDOC hol-light/Help/implode.doc000066400000000000000000000010401303454263000157500ustar00rootroot00000000000000\DOC implode \TYPE {implode : string list -> string} \SYNOPSIS Concatenates a list of strings into one string. \DESCRIBE {implode [s1;...;sn]} returns the string formed by concatenating the strings {s1 ... sn}. If {n} is zero (the list is empty), then the empty string is returned. \FAILURE Never fails; accepts empty or multi-character component strings. \EXAMPLE { # implode ["e";"x";"a";"m";"p";"l";"e"];; val it : string = "example" # implode ["ex";"a";"mpl";"";"e"];; val it : string = "example" } \SEEALSO explode. \ENDDOC hol-light/Help/increasing.doc000066400000000000000000000012211303454263000164420ustar00rootroot00000000000000\DOC increasing \TYPE {increasing : ('a -> 'b) -> 'a -> 'a -> bool} \SYNOPSIS Returns a total ordering based on a measure function \DESCRIBE When applied to a ``measure'' function {f}, the call {increasing f} returns a binary function ordering elements in a call {increasing f x y} by {f(x) 'a list -> int} \SYNOPSIS Returns position of given element in list. \DESCRIBE The call {index x l} where l is a list returns the position number of the first instance of x in the list, failing if there is none. The indices start at zero, corresponding to {el}. \EXAMPLE { # index "j" (explode "abcdefghijklmnopqrstuvwxyz");; val it : int = 9 } This is a sort of inverse to the indexing into a string by {el}: { # el 9 (explode "abcdefghijklmnopqrstuvwxyz");; val it : string = "j" } \SEEALSO el, find. \ENDDOC hol-light/Help/inductive_type_store.doc000066400000000000000000000031511303454263000205730ustar00rootroot00000000000000\DOC inductive_type_store \TYPE {inductive_type_store : (string * (int * thm * thm)) list ref} \SYNOPSIS List of inductive types defined with corresponding theorems. \DESCRIBE The reference variable {inductive_type_store} holds an association list that associates with the name of each inductive type defined so far (e.g. {"list"} or {"1"}) a triple: the number of constructors, the induction theorem and the recursion theorem for it. The two theorems are exactly of the form returned by {define_type}. \FAILURE Not applicable. \EXAMPLE This example is characteristic: { # assoc "list" (!inductive_type_store);; val it : int * thm * thm = (2, |- !P. P [] /\ (!a0 a1. P a1 ==> P (CONS a0 a1)) ==> (!x. P x), |- !NIL' CONS'. ?fn. fn [] = NIL' /\ (!a0 a1. fn (CONS a0 a1) = CONS' a0 a1 (fn a1))) } \noindent while the following shows that there is an entry for the Boolean type, for the sake of regularity, even though it is not normally considered an inductive type: { # assoc "bool" (!inductive_type_store);; val it : int * thm * thm = (2, |- !P. P F /\ P T ==> (!x. P x), |- !a b. ?f. f F = a /\ f T = b) } \USES This list is mainly for internal use. For example it is employed by {define} to automatically prove the existence of recursive functions over inductive types. Users may find the information helpful to implement their own proof tools. However, while the list may be inspected, it should not be modified explicitly or there may be unwanted side-effects on {define}. \SEEALSO define, define_type, new_recursive_definition, prove_recursive_functions_exist. \ENDDOC hol-light/Help/infixes.doc000066400000000000000000000007001303454263000157660ustar00rootroot00000000000000\DOC infixes \TYPE {infixes : unit -> (string * (int * string)) list} \SYNOPSIS Lists the infixes currently recognized by the parser. \DESCRIBE The function {infixes} should be applied to the unit {()} and will then return a list of all the infixes currently recognized by the parser together with their precedence and associativity (left or right). \FAILURE Never fails. \SEEALSO get_infix_status, parse_as_infix, unparse_as_infix. \ENDDOC hol-light/Help/injectivity.doc000066400000000000000000000017011303454263000166640ustar00rootroot00000000000000\DOC injectivity \TYPE {injectivity : string -> thm} \SYNOPSIS Produce injectivity theorem for an inductive type. \DESCRIBE A call {injectivity "ty"} where {"ty"} is the name of a recursive type defined with {define_type}, returns a ``injectivity'' theorem asserting that elements constructed by different type constructors are always different. The effect is exactly the same as if {prove_constructors_injective} were applied to the recursion theorem produced by {define_type}, and the documentation for {prove_constructors_injective} gives a lengthier discussion. \FAILURE Fails if {ty} is not the name of a recursive type, or if all its constructors are nullary. \EXAMPLE { # injectivity "num";; val it : thm = |- !n n'. SUC n = SUC n' <=> n = n' # injectivity "list";; val it : thm = |- !a0 a1 a0' a1'. CONS a0 a1 = CONS a0' a1' <=> a0 = a0' /\ a1 = a1' } \SEEALSO cases, define_type, distinctness, prove_constructors_injective. \ENDDOC hol-light/Help/injectivity_store.doc000066400000000000000000000007001303454263000200760ustar00rootroot00000000000000\DOC injectivity_store \TYPE {injectivity_store : (string * thm) list ref} \SYNOPSIS Internal theorem list of injectivity theorems. \DESCRIBE This list contains all the injectivity theorems (see {injectivity}) for the recursive types defined so far. It is automatically extended by {define_type} and used as a cache by {injectivity}. \FAILURE Not applicable. \SEEALSO define_type, distinctness_store, extend_rectype_net, injectivity. \ENDDOC hol-light/Help/insert.doc000066400000000000000000000010451303454263000156300ustar00rootroot00000000000000\DOC insert \TYPE {insert : 'a -> 'a list -> 'a list} \SYNOPSIS Adds element to the head of a list if not already present. \DESCRIBE The call {insert x l} returns just {l} if {x} is already in the list, and otherwise returns {x::l}. \EXAMPLE { # insert 5 (1--10);; val it : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10] # insert 15 (1--10);; val it : int list = [15; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10] } \USES An analog to the basic list constructor {::} but treating the list more like a set. \SEEALSO union, intersect, subtract. \ENDDOC hol-light/Help/insert_prime.doc000066400000000000000000000014041303454263000170230ustar00rootroot00000000000000\DOC insert' \TYPE {insert' : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list} \SYNOPSIS Insert element into list unless it contains an equivalent one already. \DESCRIBE If {r} is a binary relation, {x} an element and {l} a list, the call {insert' r x l} will add {x} to the head of the list, unless the list already contains an element {x'} with {r x x'}; if it does, the list is returned unchanged. The function {insert} is the special case where {r} is equality. \FAILURE Fails only if the relation fails. \EXAMPLE { # insert' (fun x y -> abs(x) = abs(y)) (-1) [1;2;3];; val it : int list = [1; 2; 3] # insert' (fun x y -> abs(x) = abs(y)) (-1) [2;3;4];; val it : int list = [-1; 2; 3; 4] } \SEEALSO insert, mem', subtract', union', unions'. \ENDDOC hol-light/Help/inst.doc000066400000000000000000000025351303454263000153060ustar00rootroot00000000000000\DOC inst \TYPE {inst : (hol_type * hol_type) list -> term -> term} \SYNOPSIS Instantiate type variables in a term. \DESCRIBE The call {inst [ty1,tv1; ...; tyn,tvn] t} will systematically replace each type variable {tvi} by the corresponding type {tyi} inside the term {t}. Bound variables will be renamed if necessary to avoid capture. \FAILURE Never fails. Repeated type variables in the instantiation list are not detected, and the first such element will be used. \EXAMPLE Here is a simple example: { # inst [`:num`,`:A`] `x:A = x`;; val it : term = `x = x` # type_of(rand it);; val it : hol_type = `:num` } To construct an example where variable renaming is necessary we need to construct terms with identically-named variables of different types, which cannot be done directly in the term parser: { # let tm = mk_abs(`x:A`,`x + 1`);; val tm : term = `\x. x + 1` } \noindent Note that the two variables {x} are different; this is a constant boolean function returning {x + 1}. Now if we instantiate type variable {:A} to {:num}, we still get a constant function, thanks to variable renaming: { # inst [`:num`,`:A`] tm;; val it : term = `\x'. x + 1` } \noindent It would have been incorrect to just keep the same name, for that would have been the successor function, something different. \SEEALSO subst, type_subst, vsubst. \ENDDOC hol-light/Help/inst_goal.doc000066400000000000000000000010751303454263000163060ustar00rootroot00000000000000\DOC inst_goal \TYPE {inst_goal : instantiation -> goal -> goal} \SYNOPSIS Apply higher-order instantiation to a goal. \DESCRIBE The call {inst_goal i g} where {i} is an instantiation (as returned by {term_match} for example), will perform the instantiation indicated by {i} in both assumptions and conclusion of the goal {g}. \FAILURE Should never fail on a valid instantiation. \COMMENTS Probably only of specialist interest to those writing tactics from scratch. \SEEALSO compose_insts, instantiate, INSTANTIATE, INSTANTIATE_ALL, PART_MATCH, term_match. \ENDDOC hol-light/Help/install_parser.doc000066400000000000000000000010431303454263000173440ustar00rootroot00000000000000\DOC install_parser \TYPE {install_parser : string * (lexcode list -> preterm * lexcode list) -> unit} \SYNOPSIS Install a user parser. \DESCRIBE HOL Light allows user parsing functions to be installed, and will try them on all terms during parsing before the usual parsers. The call {install_parser(s,p)} installs the parser {p} among the user parsers to try in this way. The string {s} is there so that the parser can conveniently be deleted again. \FAILURE Never fails. \SEEALSO delete_parser, installed_parsers, try_user_parser. \ENDDOC hol-light/Help/install_user_printer.doc000066400000000000000000000037651303454263000206060ustar00rootroot00000000000000\DOC install_user_printer \TYPE {install_user_printer : string * (formater -> term -> unit) -> unit} \SYNOPSIS Install a user-defined printing function into the HOL Light term printer. \DESCRIBE The call {install_user_printer(s,pr)} sets up {pr} inside the HOL Light toplevel printer. On each subterm encountered, {pr} will be tried first, and only if it fails with {Failure ...} will the normal HOL Light printing be invoked. The additional string argument {s} is just to provide a convenient handle for later removal through {delete_user_printer}. However, any previous user printer with the same string tag will be removed when {install_user_printer} is called. The printing function takes two arguments, the second being the term to print and the first being the formatter to be used; this ensures that the printer will automatically have its output sent to the current formatter by the overall printer. \FAILURE Never fails. \EXAMPLE The user might wish to print every variable with its type: { # let print_typed_var fmt tm = let s,ty = dest_var tm in pp_print_string fmt ("("^s^":"^string_of_type ty^")") in install_user_printer("print_typed_var",print_typed_var);; val it : unit = () # ADD_ASSOC;; val it : thm = |- !(m:num) (n:num) (p:num). (m:num) + (n:num) + (p:num) = ((m:num) + (n:num)) + (p:num) } \USES Modification of printing in this way is particularly useful when the HOL logic is used to embed some other formalism such as a programming language, hardware description language or other logic. This can then be printed in a ``native'' fashion without any artifacts of its HOL formalization. \COMMENTS Since user printing functions are tried on every subterm encountered in the regular printing function, it is important that they fail quickly when inapplicable, or the printing process can be slowed. They should also not generate exceptions other than {Failure ...} or the toplevel printer will start to fail. \SEEALSO delete_user_printer, try_user_printer. \ENDDOC hol-light/Help/installed_parsers.doc000066400000000000000000000007531303454263000200470ustar00rootroot00000000000000\DOC installed_parsers \TYPE {installed_parsers : unit -> (string * (lexcode list -> preterm * lexcode list)) list} \SYNOPSIS List the user parsers currently installed. \DESCRIBE HOL Light allows user parsing functions to be installed, and will try them on all terms during parsing before the usual parsers. The call {installed_parsers()} lists the parsing functions that have been so installed. \FAILURE Never fails. \SEEALSO delete_parser, install_parser, try_user_parser. \ENDDOC hol-light/Help/instantiate.doc000066400000000000000000000022651303454263000166540ustar00rootroot00000000000000\DOC instantiate \TYPE {instantiate : instantiation -> term -> term} \SYNOPSIS Apply a higher-order instantiation to a term. \DESCRIBE The call {instantiate i t}, where {i} is an instantiation as returned by {term_match}, will perform the instantiation indicated by {i} in the term {t}: types and terms will be instantiated and the beta-reductions that are part of higher-order matching will be applied. \FAILURE Should never fail on a valid instantiation. \EXAMPLE We first compute an instantiation: { # let t = `(!x. P x) <=> ~(?x. P x)`;; Warning: inventing type variables val t : term = `(!x. P x) <=> ~(?x. P x)` # let i = term_match [] (lhs t) `!p. prime(p) ==> p = 2 \/ ODD(p)`;; val i : instantiation = ([(1, `P`)], [(`\p. prime p ==> p = 2 \/ ODD p`, `P`)], [(`:num`, `:?61195`)]) } \noindent and now apply it. Notice that the type variable name is not corrected, as is done inside {PART_MATCH}: { # instantiate i t;; val it : term = `(!x. prime x ==> x = 2 \/ ODD x) <=> ~(?x. prime x ==> x = 2 \/ ODD x)` } \COMMENTS This is probably not useful for most users. \SEEALSO compose_insts, INSTANTIATE, INSTANTIATE_ALL, inst_goal, PART_MATCH, term_match. \ENDDOC hol-light/Help/instantiate_casewise_recursion.doc000066400000000000000000000033321303454263000226240ustar00rootroot00000000000000\DOC instantiate_casewise_recursion \TYPE {instantiate_casewise_recursion : term -> thm} \SYNOPSIS Instantiate the general scheme for a recursive function existence assertion. \DESCRIBE The function {instantiate_casewise_recursion} should be applied to an existentially quantified term {`?f. def_1[f] /\ ... /\ def_n[f]`}, where each clause {def_i} is a universally quantified equation with an application of {f} to arguments on the left-hand side. The idea is that these clauses define the action of {f} on arguments of various kinds, for example on an empty list and nonempty list: { ?f. (f [] = a) /\ (!h t. CONS h t = k[f,h,t]) } \noindent or on even numbers and odd numbers: { ?f. (!n. f(2 * n) = a[f,n]) /\ (!n. f(2 * n + 1) = b[f,n]) } The returned value is a theorem whose conclusion matches the input term, with an assumption sufficient for the existence assertion. This is not normally in a very convenient form for the user. \FAILURE Fails only if the definition is malformed. However it is possible that for an inadmissible definition the assumption of the theorem may not hold. \USES This is seldom a convenient function for users. Normally, use {prove_general_recursive_function_exists} to prove something like this while attempting to discharge the side-conditions automatically, or {define} to actually make a definition. In situations where the automatic discharge of the side-conditions fails, one may prefer instead {pure_prove_recursive_function_exists}. The even more minimal {instantiate_casewise_recursion} is for the rare cases where one wants to force no processing at all of the side-conditions to be undertaken. \SEEALSO define, prove_general_recursive_function_exists, pure_prove_recursive_function_exists. \ENDDOC hol-light/Help/int_ideal_cofactors.doc000066400000000000000000000035761303454263000203320ustar00rootroot00000000000000\DOC int_ideal_cofactors \TYPE {int_ideal_cofactors : term list -> term -> term list} \SYNOPSIS Produces cofactors proving that one integer polynomial is in the ideal generated by others. \DESCRIBE The call {int_ideal_cofactors [`p1`; ...; `pn`] `p`}, where all the terms have type {:int} and can be considered as polynomials, will test whether {p} is in the ideal generated by the {p1,...,pn}. If so, it will return a corresponding list {[`q1`; ...; `qn`]} of `cofactors' such that the following is an algebraic identity provable by {INT_RING} or a slight elaboration of {INT_POLY_CONV}, for example) { p = p1 * q1 + ... + pn * qn } \noindent hence providing an explicit certificate for the ideal membership. If ideal membership does not hold, {int_ideal_cofactors} fails. The test is performed using a Gr\"obner basis procedure. \FAILURE Fails if the terms are ill-typed, or if ideal membership fails. At present this is a generic version for fields, and in rare cases it may fail because cofactors are found involving non-trivial rational numbers even where there are integer cofactors. This imperfection should be fixed eventually, and is not usually a problem in practice. \EXAMPLE In the case of a singleton list, ideal membership just amounts to polynomial divisibility, e.g. { # prioritize_int();; val it : unit = () # int_ideal_cofactors [`r * x * (&1 - x) - x`] `r * (r * x * (&1 - x)) * (&1 - r * x * (&1 - x)) - x`;; [`&1 * r pow 2 * x pow 2 + -- &1 * r pow 2 * x + -- &1 * r * x + &1 * r + &1`] } \COMMENTS When we say that terms can be `considered as polynomials', we mean that initial normalization, essentially in the style of {INT_POLY_CONV}, will be applied, but some complex constructs such as conditional expressions will be treated as atomic. \SEEALSO ideal_cofactors, INT_IDEAL_CONV, INT_RING, real_ideal_cofactors, RING, RING_AND_IDEAL_CONV. \ENDDOC hol-light/Help/intersect.doc000066400000000000000000000012201303454263000163170ustar00rootroot00000000000000\DOC intersect \TYPE {intersect : 'a list -> 'a list -> 'a list} \SYNOPSIS Computes the intersection of two `sets'. \KEYWORDS list, set. \DESCRIBE {intersect l1 l2} returns a list consisting of those elements of {l1} that also appear in {l2}. If both sets are free of repetitions, this can be considered a set-theoretic intersection operation. \FAILURE Never fails. \COMMENTS Duplicate elements in the first list will still be present in the result. \EXAMPLE { # intersect [1;2;3] [3;5;4;1];; val it : int list = [1; 3] # intersect [1;2;4;1] [1;2;3;2];; val it : int list = [1; 2; 1] } \SEEALSO setify, set_equal, union, subtract. \ENDDOC hol-light/Help/is_abs.doc000066400000000000000000000006221303454263000155640ustar00rootroot00000000000000\DOC is_abs \TYPE {is_abs : term -> bool} \SYNOPSIS Tests a term to see if it is an abstraction. \DESCRIBE {is_abs `\var. t`} returns {true}. If the term is not an abstraction the result is {false}. \FAILURE Never fails. \EXAMPLE { # is_abs `\x. x + 1`;; val it : bool = true # is_abs `!x. x >= 0`;; val it : bool = false } \SEEALSO mk_abs, dest_abs, is_var, is_const, is_comb. \ENDDOC hol-light/Help/is_binary.doc000066400000000000000000000012771303454263000163120ustar00rootroot00000000000000\DOC is_binary \TYPE {is_binary : string -> term -> bool} \SYNOPSIS Tests if a term is an application of a named binary operator. \DESCRIBE The call {is_binary s tm} tests if term {tm} is an instance of a binary operator {(op l) r} where {op} is a constant with name {s}. If so, it returns true; otherwise it returns false. Note that {op} is required to be a constant. \FAILURE Never fails. \EXAMPLE This one succeeds: { # is_binary "+" `1 + 2`;; val it : bool = true } \noindent but this one fails unless {f} has been declared a constant: { # is_binary "f" `f x y`;; Warning: inventing type variables val it : bool = false } \SEEALSO dest_binary, is_binop, is_comb, mk_binary. \ENDDOC hol-light/Help/is_binder.doc000066400000000000000000000013031303454263000162570ustar00rootroot00000000000000\DOC is_binder \TYPE {is_binder : string -> term -> bool} \SYNOPSIS Tests if a term is a binder construct with named constant. \DESCRIBE The call {is_binder "c" t} tests whether the term {t} has the form of an application of a constant {c} to an abstraction. Note that this has nothing to do with the parsing status of the name {c} as a binder, but only the form of the term. \FAILURE Never fails. \EXAMPLE { # is_binder "!" `!x. x >= 0`;; val it : bool = true } \noindent Note how only the basic logical form is tested, even taking in things that we wouldn't really think of as binders: { # is_binder "=" `(=) (\x. x + 1)`;; val it : bool = true } \SEEALSO dest_binder, mk_binder. \ENDDOC hol-light/Help/is_binop.doc000066400000000000000000000011521303454263000161250ustar00rootroot00000000000000\DOC is_binop \TYPE {is_binop : term -> term -> bool} \SYNOPSIS Tests if a term is an application of the given binary operator. \DESCRIBE The call {is_binop op t} returns {true} if the term {t} is of the form {(op l) r} for any two terms {l} and {r}, and {false} otherwise. \FAILURE Never fails. \EXAMPLE This is a fairly typical example: { # is_binop `(/\)` `p /\ q`;; val it : bool = true } \noindent but note that the operator needn't be a constant: { # is_binop `f:num->num->num` `(f:num->num->num) x y`;; val it : bool = true } \SEEALSO dest_binary, dest_binop, is_binary, mk_binary, mk_binop. \ENDDOC hol-light/Help/is_comb.doc000066400000000000000000000006341303454263000157420ustar00rootroot00000000000000\DOC is_comb \TYPE {is_comb : term -> bool} \SYNOPSIS Tests a term to see if it is a combination (function application). \DESCRIBE {is_comb "t1 t2"} returns {true}. If the term is not a combination the result is {false}. \FAILURE Never fails \EXAMPLE { # is_comb `x + 1`;; val it : bool = true # is_comb `T`;; val it : bool = false } \SEEALSO dest_comb, is_var, is_const, is_abs, mk_comb. \ENDDOC hol-light/Help/is_cond.doc000066400000000000000000000004261303454263000157440ustar00rootroot00000000000000\DOC is_cond \TYPE {is_cond : term -> bool} \SYNOPSIS Tests a term to see if it is a conditional. \DESCRIBE {is_cond `if t then t1 else t2`} returns {true}. If the term is not a conditional the result is {false}. \FAILURE Never fails. \SEEALSO mk_cond, dest_cond. \ENDDOC hol-light/Help/is_conj.doc000066400000000000000000000004121303454263000157450ustar00rootroot00000000000000\DOC is_conj \TYPE {is_conj : term -> bool} \SYNOPSIS Tests a term to see if it is a conjunction. \DESCRIBE {is_conj `t1 /\ t2`} returns {true}. If the term is not a conjunction the result is {false}. \FAILURE Never fails. \SEEALSO dest_conj, mk_conj. \ENDDOC hol-light/Help/is_cons.doc000066400000000000000000000004651303454263000157660ustar00rootroot00000000000000\DOC is_cons \TYPE {is_cons : term -> bool} \SYNOPSIS Tests a term to see if it is an application of {CONS}. \DESCRIBE {is_cons} returns {true} of a term representing a non-empty list. Otherwise it returns {false}. \FAILURE Never fails. \SEEALSO dest_cons, dest_list, is_list, mk_cons, mk_list. \ENDDOC hol-light/Help/is_const.doc000066400000000000000000000011241303454263000161430ustar00rootroot00000000000000\DOC is_const \TYPE {is_const : term -> bool} \SYNOPSIS Tests a term to see if it is a constant. \DESCRIBE {is_const `const:ty`} returns {true}. If the term is not a constant the result is {false}. \FAILURE Never fails. \EXAMPLE { # is_const `T`;; val it : bool = true # is_const `x:bool`;; val it : bool = false } Note that numerals are not constants; they are composite constructs hidden by prettyprinting: { # is_const `0`;; val it : bool = false # is_numeral `12345`;; val it : bool = true } \SEEALSO dest_const, is_abs, is_comb, is_numeral, is_var, mk_const. \ENDDOC hol-light/Help/is_disj.doc000066400000000000000000000004121303454263000157450ustar00rootroot00000000000000\DOC is_disj \TYPE {is_disj : term -> bool} \SYNOPSIS Tests a term to see if it is a disjunction. \DESCRIBE {is_disj `t1 \/ t2`} returns {true}. If the term is not a disjunction the result is {false}. \FAILURE Never fails. \SEEALSO dest_disj, mk_disj. \ENDDOC hol-light/Help/is_eq.doc000066400000000000000000000010131303454263000154170ustar00rootroot00000000000000\DOC is_eq \TYPE {is_eq : term -> bool} \SYNOPSIS Tests a term to see if it is an equation. \DESCRIBE {is_eq `t1 = t2`} returns {true}. If the term is not an equation the result is {false}. Note that logical equivalence is just equality on type {:bool}, even though it is printed as {<=>}. \FAILURE Never fails. \EXAMPLE { # is_eq `2 + 2 = 4`;; val it : bool = true # is_eq `p /\ q <=> q /\ p`;; val it : bool = true # is_eq `p ==> p`;; val it : bool = false } \SEEALSO dest_eq, is_beq, mk_eq. \ENDDOC hol-light/Help/is_exists.doc000066400000000000000000000004631303454263000163410ustar00rootroot00000000000000\DOC is_exists \TYPE {is_exists : term -> bool} \SYNOPSIS Tests a term to see if it as an existential quantification. \DESCRIBE {is_exists `?var. t`} returns {true}. If the term is not an existential quantification the result is {false}. \FAILURE Never fails. \SEEALSO dest_exists, mk_exists. \ENDDOC hol-light/Help/is_forall.doc000066400000000000000000000004551303454263000163020ustar00rootroot00000000000000\DOC is_forall \TYPE {is_forall : term -> bool} \SYNOPSIS Tests a term to see if it is a universal quantification. \DESCRIBE {is_forall `!var. t`} returns {true}. If the term is not a universal quantification the result is {false}. \FAILURE Never fails. \SEEALSO dest_forall, mk_forall. \ENDDOC hol-light/Help/is_gabs.doc000066400000000000000000000012671303454263000157410ustar00rootroot00000000000000\DOC is_gabs \TYPE {is_gabs : term -> bool} \SYNOPSIS Tests if a term is a basic or generalized abstraction. \DESCRIBE The call {is_gabs t} tests if {t} is either a basic logical abstraction (as identified by {is_abs}) or a generalized one (a standard composite logical structure to support a non-variable vastruct). If so, it returns {true}, and otherwise it returns {false}. \FAILURE Never fails. \EXAMPLE This shows that ordinary abstractions are allowed: { # is_gabs `\x. x + 1`;; val it : bool = true } \noindent while the following shows a more typical case: { # is_gabs `\(x,y,z). x + y + z + 1`;; val it : bool = true } \SEEALSO GEN_BETA_CONV, dest_gabs, mk_gabs. \ENDDOC hol-light/Help/is_hidden.doc000066400000000000000000000011371303454263000162540ustar00rootroot00000000000000\DOC is_hidden \TYPE {is_hidden : string -> bool} \SYNOPSIS Determines whether a constant is hidden. \DESCRIBE This predicate returns {true} if the named {ML} constant has been hidden by the function {hide_constant}; it returns {false} if the constant is not hidden. Hiding a constant forces the quotation parser to treat the constant as a variable (lexical rules permitting). \FAILURE Never fails. \EXAMPLE { # is_hidden "SUC";; val it : bool = false # hide_constant "SUC";; val it : unit = () # is_hidden "SUC";; val it : bool = true } \SEEALSO hide_constant, unhide_constant \ENDDOC hol-light/Help/is_iff.doc000066400000000000000000000012061303454263000155620ustar00rootroot00000000000000\DOC is_iff \TYPE {is_iff : term -> bool} \SYNOPSIS Tests if a term is an equation between Boolean terms (iff / logical equivalence). \DESCRIBE Recall that in HOL, the Boolean operation variously called logical equivalence, bi-implication or `if and only if' (iff) is simply the equality relation on Boolean type. The call {is_iff t} returns {true} if {t} is an equality between terms of Boolean type, and {false} otherwise. \FAILURE Never fails. \EXAMPLE { # is_iff `p = T`;; val it : bool = true # is_iff `p <=> q`;; val it : bool = true # is_iff `0 = 1`;; val it : bool = false } \SEEALSO dest_iff, is_eq, mk_iff. \ENDDOC hol-light/Help/is_imp.doc000066400000000000000000000004401303454263000156020ustar00rootroot00000000000000\DOC is_imp \TYPE {is_imp : term -> bool} \SYNOPSIS Tests if a term is an application of implication. \DESCRIBE The call {is_imp t} returns {true} if {t} is of the form {p ==> q} for some {p} and {q}, and returns {false} otherwise. \FAILURE Never fails. \SEEALSO dest_imp. \ENDDOC hol-light/Help/is_intconst.doc000066400000000000000000000010571303454263000166630ustar00rootroot00000000000000\DOC is_intconst \TYPE {is_intconst : term -> bool} \SYNOPSIS Tests if a term is an integer literal of type {:int}. \DESCRIBE The call {is_intconst t} tests whether the term {t} is a canonical integer literal of type {:int}, i.e. either `{&n}' for a numeral {n} or `{-- &n}' for a nonzero numeral {n}. If so it returns {true}, otherwise {false}. \FAILURE Never fails. \EXAMPLE { # is_intconst `-- &3 :int`;; val it : bool = true # is_intconst `-- &0 :int`;; val it : bool = false } \SEEALSO dest_intconst, is_realintconst, mk_intconst. \ENDDOC hol-light/Help/is_let.doc000066400000000000000000000007031303454263000156030ustar00rootroot00000000000000\DOC is_let \TYPE {is_let : term -> bool} \SYNOPSIS Tests a term to see if it is a {let}-expression. \DESCRIBE {is_let `let x1 = e1 and ... and xn = en in E`} returns {true}. If the term is not a {let}-expression of any kind, the result is {false}. \FAILURE Never fails. \EXAMPLE { # is_let `let x = 1 in x + x`;; val it : bool = true # is_let `let x = 2 and y = 3 in y + x`;; val it : bool = true } \SEEALSO mk_let, dest_let. \ENDDOC hol-light/Help/is_list.doc000066400000000000000000000004311303454263000157700ustar00rootroot00000000000000\DOC is_list \TYPE {is_list : term -> bool} \SYNOPSIS Tests a term to see if it is a list. \DESCRIBE {is_list} returns {true} of a term representing a list. Otherwise it returns {false}. \FAILURE Never fails. \SEEALSO dest_cons, dest_list, is_cons, mk_cons, mk_list. \ENDDOC hol-light/Help/is_neg.doc000066400000000000000000000004111303454263000155640ustar00rootroot00000000000000\DOC is_neg \TYPE {is_neg : term -> bool} \SYNOPSIS Tests a term to see if it is a logical negation. \DESCRIBE {is_neg `~t`} returns {true}. If the term is not a logical negation the result is {false}. \FAILURE Never fails. \SEEALSO dest_neg, mk_neg. \ENDDOC hol-light/Help/is_numeral.doc000066400000000000000000000005021303454263000164570ustar00rootroot00000000000000\DOC is_numeral \TYPE {is_numeral : term -> bool} \SYNOPSIS Tests if a term is a natural number numeral. \DESCRIBE When applied to a term, {is_numeral} returns {true} if and only if the term is a canonical natural number numeral ({0}, {1}, {2} etc.) \FAILURE Never fails. \SEEALSO dest_numeral, is_numeral. \ENDDOC hol-light/Help/is_pair.doc000066400000000000000000000005601303454263000157530ustar00rootroot00000000000000\DOC is_pair \TYPE {is_pair : term -> bool} \SYNOPSIS Tests a term to see if it is a pair. \DESCRIBE {is_pair `(t1,t2)`} returns {true}. If the term is not a pair the result is {false}. \FAILURE Never fails. \EXAMPLE { # is_pair `1,2,3`;; val it : bool = true # is_pair `[1;2;3]`;; val it : bool = false } \SEEALSO dest_pair, is_cons, mk_pair. \ENDDOC hol-light/Help/is_prefix.doc000066400000000000000000000006471303454263000163230ustar00rootroot00000000000000\DOC is_prefix \TYPE {is_prefix : string -> bool} \SYNOPSIS Tests if an identifier has prefix status. \DESCRIBE Certain identifiers {c} have prefix status, meaning that combinations of the form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The call {is_prefix "c"} tests if {c} is one of those identifiers. \FAILURE Never fails. \SEEALSO parse_as_prefix, prefixes, unparse_as_prefix. \ENDDOC hol-light/Help/is_ratconst.doc000066400000000000000000000013221303454263000166520ustar00rootroot00000000000000\DOC is_ratconst \TYPE {is_ratconst : term -> bool} \SYNOPSIS Tests if a term is a canonical rational literal of type {:real}. \DESCRIBE The call {is_ratconst t} tests whether the term {t} is a canonical rational literal of type {:real}. This means an integer literal {&n} for numeral {n}, {-- &n} for a nonzero numeral {n}, or a ratio {&p / &q} or {-- &p / &q} where {p} is nonzero, {q > 1} and {p} and {q} share no common factor. If so, {is_ratconst} returns {true}, and otherwise {false}. \FAILURE Never fails. \EXAMPLE { # is_ratconst `&22 / &7`;; val it : bool = true # is_ratconst `&4 / &2`;; val it : bool = false } \SEEALSO is_realintconst, rat_of_term, REAL_RAT_REDUCE_CONV, term_of_rat. \ENDDOC hol-light/Help/is_realintconst.doc000066400000000000000000000011251303454263000175230ustar00rootroot00000000000000\DOC is_realintconst \TYPE {is_realintconst : term -> bool} \SYNOPSIS Tests if a term is an integer literal of type {:real}. \DESCRIBE The call {is_realintconst t} tests whether the term {t} is a canonical integer literal of type {:real}, i.e. either `{&n}' for a numeral {n} or `{-- &n}' for a nonzero numeral {n}. If so it returns {true}, otherwise {false}. \FAILURE Never fails. \EXAMPLE { # is_realintconst `-- &3 :real`;; val it : bool = true # is_realintconst `&1 :int`;; val it : bool = false } \SEEALSO dest_realintconst, is_intconst, is_ratconst, mk_realintconst. \ENDDOC hol-light/Help/is_reserved_word.doc000066400000000000000000000007131303454263000176720ustar00rootroot00000000000000\DOC is_reserved_word \TYPE {is_reserved_word : string -> bool} \SYNOPSIS Tests if a string is one of the reserved words. \DESCRIBE Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', meaning that they are special to the parser and cannot be used as ordinary identifiers. The call {is_reserved_word s} tests if the string {s} is one of them. \FAILURE Never fails. \SEEALSO reserved_words, reserve_words, unreserve_words. \ENDDOC hol-light/Help/is_select.doc000066400000000000000000000004301303454263000162730ustar00rootroot00000000000000\DOC is_select \TYPE {is_select : term -> bool} \SYNOPSIS Tests a term to see if it is a choice binding. \DESCRIBE {is_select `@var. t`} returns {true}. If the term is not an epsilon-term the result is {false}. \FAILURE Never fails. \SEEALSO mk_select, dest_select. \ENDDOC hol-light/Help/is_setenum.doc000066400000000000000000000010401303454263000164720ustar00rootroot00000000000000\DOC is_setenum \TYPE {is_setenum : term -> bool} \SYNOPSIS Tests if a term is a set enumeration. \DESCRIBE When applied to a term that is an explicit set enumeration {`{{t1,...,tn}}`}, the function {is_setenum} returns {true}; otherwise it returns {false}. \FAILURE Never fails. \EXAMPLE { # is_setenum `1 INSERT 2 INSERT {{}}`;; val it : bool = true # is_setenum `{{1,2,3,4,1,2,3,4}}`;; val it : bool = true # is_setenum `1 INSERT 2 INSERT s`;; val it : bool = false } \SEEALSO dest_setenum, mk_fset, mk_setenum. \ENDDOC hol-light/Help/is_type.doc000066400000000000000000000007551303454263000160070ustar00rootroot00000000000000\DOC is_type \TYPE {is_type : hol_type -> bool} \SYNOPSIS Tests whether a type is an instance of a type constructor. \DESCRIBE {is_type ty} returns {true} if {ty} is a base type or constructed by an outer type constructor, and {false} if it is a type variable. \FAILURE Never fails. \EXAMPLE { # is_type `:bool`;; val it : bool = true # is_type `:bool->int`;; val it : bool = true # is_type `:Tyvar`;; val it : bool = false } \SEEALSO get_type_arity, is_vartype. \ENDDOC hol-light/Help/is_uexists.doc000066400000000000000000000005261303454263000165260ustar00rootroot00000000000000\DOC is_uexists \TYPE {is_uexists : term -> bool} \SYNOPSIS Tests if a term is of the form `there exists a unique ...' \DESCRIBE If {t} has the form {?!x. p[x]} (there exists a unique {x} such that {p[x]} then {is_uexists t} returns {true}, otherwise {false}. \FAILURE Never fails. \SEEALSO dest_uexists, is_exists, is_forall. \ENDDOC hol-light/Help/is_undefined.doc000066400000000000000000000015061303454263000167620ustar00rootroot00000000000000\DOC is_undefined \TYPE {is_undefined : ('a, 'b) func -> bool} \SYNOPSIS Tests if a finite partial function is defined nowhere. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The predicate {is_undefined} tests if the argument is the completely undefined function. \FAILURE Never fails. \EXAMPLE { # let x = undefined and y = (1 |=> 2);; val x : ('a, 'b) func = val y : (int, int) func = # is_undefined x;; val it : bool = true # is_undefined y;; val it : bool = false } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/is_var.doc000066400000000000000000000005741303454263000156150ustar00rootroot00000000000000\DOC is_var \TYPE {is_var : term -> bool} \SYNOPSIS Tests a term to see if it is a variable. \DESCRIBE {is_var `var:ty`} returns {true}. If the term is not a variable the result is {false}. \FAILURE Never fails. \EXAMPLE { # is_var `x:bool`;; val it : bool = true # is_var `T`;; val it : bool = false } \SEEALSO mk_var, dest_var, is_const, is_comb, is_abs. \ENDDOC hol-light/Help/is_vartype.doc000066400000000000000000000007241303454263000165140ustar00rootroot00000000000000\DOC is_vartype \TYPE {is_vartype : hol_type -> bool} \SYNOPSIS Tests a type to see if it is a type variable. \DESCRIBE Returns {true} if applied to a type variable. For types that are not type variables it returns {false}. \FAILURE Never fails. \EXAMPLE { # is_vartype `:A`;; val it : bool = true # is_vartype `:bool`;; val it : bool = false # is_vartype (mk_vartype "bool");; val it : bool = true } \SEEALSO mk_vartype, dest_vartype. \ENDDOC hol-light/Help/isalnum.doc000066400000000000000000000006741303454263000160030ustar00rootroot00000000000000\DOC isalnum \TYPE {isalnum : string -> bool} \SYNOPSIS Tests if a one-character string is alphanumeric. \DESCRIBE The call {isalnum s} tests whether the first character of string {s} (normally it is the only character) is alphanumeric, i.e. an uppercase or lowercase letter, a digit, an underscore or a prime character. \FAILURE Fails if the string is empty. \SEEALSO isalpha, isbra, isnum, issep, isspace, issymb. \ENDDOC hol-light/Help/isalpha.doc000066400000000000000000000006571303454263000157550ustar00rootroot00000000000000\DOC isalpha \TYPE {isalpha : string -> bool} \SYNOPSIS Tests if a one-character string is alphabetic. \DESCRIBE The call {isalpha s} tests whether the first character of string {s} (normally it is the only character) is alphabetic, i.e. an uppercase or lowercase letter, an underscore or a prime character. \FAILURE Fails if the string is empty. \SEEALSO isalnum, isbra, isnum, issep, isspace, issymb. \ENDDOC hol-light/Help/isbra.doc000066400000000000000000000006631303454263000154310ustar00rootroot00000000000000\DOC isbra \TYPE {isbra : string -> bool} \SYNOPSIS Tests if a one-character string is some kind of bracket. \DESCRIBE The call {isbra s} tests whether the first character of string {s} (normally it is the only character) is a bracket, meaning an opening or closing parenthesis, square bracket or curly brace. \FAILURE Fails if the string is empty. \SEEALSO isalnum, isalpha, isnum, issep, isspace, issymb. \ENDDOC hol-light/Help/isnum.doc000066400000000000000000000005511303454263000154600ustar00rootroot00000000000000\DOC isnum \TYPE {isnum : string -> bool} \SYNOPSIS Tests if a one-character string is a decimal digit. \DESCRIBE The call {isnum s} tests whether the first character of string {s} (normally it is the only character) is a decimal digit. \FAILURE Fails if the string is empty. \SEEALSO isalnum, isalpha, isbra, issep, isspace, issymb. \ENDDOC hol-light/Help/issep.doc000066400000000000000000000005721303454263000154530ustar00rootroot00000000000000\DOC issep \TYPE {issep : string -> bool} \SYNOPSIS Tests if a one-character string is a separator. \DESCRIBE The call {issep s} tests whether the first character of string {s} (normally it is the only character) is one of the separators `{,}' or `{;}'. \FAILURE Fails if the string is empty. \SEEALSO isalnum, isalpha, isbra, isnum, isspace, issymb. \ENDDOC hol-light/Help/isspace.doc000066400000000000000000000006061303454263000157550ustar00rootroot00000000000000\DOC isspace \TYPE {isspace : string -> bool} \SYNOPSIS Tests if a one-character string is some kind of space. \DESCRIBE The call {isspace s} tests whether the first character of string {s} (normally it is the only character) is a `space' of some kind, including tab and newline. \FAILURE Fails if the string is empty. \SEEALSO isalnum, isalpha, isbra, isnum, issep, issymb. \ENDDOC hol-light/Help/issymb.doc000066400000000000000000000013061303454263000156320ustar00rootroot00000000000000\DOC issymb \TYPE {issymb : string -> bool} \SYNOPSIS Tests if a one-character string is a symbol other than bracket or separator. \DESCRIBE The call {issymb s} tests whether the first character of string {s} (normally it is the only character) is ``symbolic''. This means that it is one of the usual ASCII characters but is not alphanumeric, not an underscore or prime character, and is also not one of the two separators `{,}' or `{;}' nor any bracket, parenthesis or curly brace. More explicitly, the set of symbolic characters is: { \ ! @ # $ % ^ & * - + | \ \ < = > / ? ~ . : } \FAILURE Fails if the string is empty. \SEEALSO isalnum, isalpha, isbra, isnum, issep, isspace. \ENDDOC hol-light/Help/it.doc000066400000000000000000000007541303454263000147460ustar00rootroot00000000000000\DOC it \TYPE {it : 'a} \SYNOPSIS Binds the value of the last expression evaluated at top level. \DESCRIBE The identifier {it} is bound to the value of the last expression evaluated at top level. Declarations do not effect the value of {it}. \EXAMPLE { # 2 + 3;; val it : int = 5 # let x = 2*3;; val x : int = 6 # it;; val it : int = 5 # it + 12;; val it : int = 17 } \USES Used in evaluating expressions that require the value of the last evaluated expression. \ENDDOC hol-light/Help/itlist.doc000066400000000000000000000007621303454263000156410ustar00rootroot00000000000000\DOC itlist \TYPE {itlist : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b} \SYNOPSIS List iteration function. Applies a binary function between adjacent elements of a list. \KEYWORDS list. \DESCRIBE {itlist f [x1;...;xn] y} returns { f x1 (f x2 ... (f xn y)...) } \noindent It returns {y} if list is empty. \FAILURE Never fails. \EXAMPLE { # itlist (+) [1;2;3;4;5] 0;; val it : int = 15 # itlist (+) [1;2;3;4;5] 6;; val it : int = 21 } \SEEALSO rev_itlist, end_itlist. \ENDDOC hol-light/Help/itlist2.doc000066400000000000000000000012421303454263000157150ustar00rootroot00000000000000\DOC itlist2 \TYPE {itlist2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c} \SYNOPSIS Applies a paired function between adjacent elements of 2 lists. \KEYWORDS list. \DESCRIBE {itlist2 f ([x1;...;xn],[y1;...;yn]) z} returns { f x1 y1 (f x2 y2 ... (f xn yn z)...) } \noindent It returns {z} if both lists are empty. \FAILURE Fails if the two lists are of different lengths. \EXAMPLE This takes a `dot product' of two vectors of integers: { # let dot v w = itlist2 (fun x y z -> x * y + z) v w 0;; val dot : int list -> int list -> int = # dot [1;2;3] [4;5;6];; val it : int = 32 } \SEEALSO itlist, rev_itlist, end_itlist, uncurry. \ENDDOC hol-light/Help/last.doc000066400000000000000000000003361303454263000152710ustar00rootroot00000000000000\DOC last \TYPE {last : 'a list -> 'a} \SYNOPSIS Computes the last element of a list. \DESCRIBE {last [x1;...;xn]} returns {xn}. \FAILURE Fails with {last} if the list is empty. \SEEALSO butlast, hd, tl, el. \ENDDOC hol-light/Help/lcm_num.doc000066400000000000000000000010501303454263000157520ustar00rootroot00000000000000\DOC lcm_num \TYPE {lcm_num : num -> num -> num} \SYNOPSIS Computes lowest common multiple of two unlimited-precision integers. \DESCRIBE The call {lcm_num m n} for two unlimited-precision (type {num}) integers {m} and {n} returns the (positive) lowest common multiple of {m} and {n}. If either {m} or {n} (or both) are both zero, it returns zero. \FAILURE Fails if either number is not an integer (the type {num} supports arbitrary rationals). \EXAMPLE { # lcm_num (Int 35) (Int(-77));; val it : num = 385 } \SEEALSO gcd, gcd_num. \ENDDOC hol-light/Help/leftbin.doc000066400000000000000000000030111303454263000157420ustar00rootroot00000000000000\DOC leftbin \TYPE {leftbin : ('a -> 'b * 'c) -> ('c -> 'd * 'a) -> ('d -> 'b -> 'b -> 'b) -> string -> 'a -> 'b * 'c} \SYNOPSIS Parses iterated left-associated binary operator. \DESCRIBE If {p} is a parser for ``items'' of some kind, {s} is a parser for some ``separator'', {c} is a `constructor' function taking an element as parsed by {s} and two other elements as parsed by {p} and giving a new such element, and {e} is an error message, then {leftbin p s c e} will parse an iterated sequence of items by {p} and separated by something parsed with {s}. It will repeatedly apply the constructor function {c} to compose these elements into one, associating to the left. For example, the input: { } meaning successive segments {pi} that are parsed by {p} and {sj} that are parsed by {s}, will result in { c (c s2 (c s1 p1 p2) p3) p4 } \FAILURE The call {leftbin p s c e} never fails, though the resulting parser may. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, listof, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/length.doc000066400000000000000000000002521303454263000156040ustar00rootroot00000000000000\DOC length \TYPE {length : 'a list -> int} \SYNOPSIS Computes the length of a list: {length [x1;...;xn]} returns {n}. \KEYWORDS list. \FAILURE Never fails. \ENDDOC hol-light/Help/let_CONV.doc000066400000000000000000000037061303454263000157430ustar00rootroot00000000000000\DOC let_CONV \TYPE {let_CONV : term -> thm} \SYNOPSIS Evaluates {let}-terms in the HOL logic. \KEYWORDS conversion. \DESCRIBE The conversion {let_CONV} implements evaluation of object-language {let}-terms. When applied to a {let}-term of the form: { let v1 = t1 and ... and vn = tn in t } \noindent where {v1}, ..., {vn} are variables, {let_CONV} proves and returns the theorem: { |- (let v1 = t1 and ... and vn = tn in t) = t[t1,...,tn/v1,...,vn] } \noindent where {t[t1,...,tn/v1,...,vn]} denotes the result of substituting {ti} for {v1} in parallel in {t}, with automatic renaming of bound variables to prevent free variable capture. {let_CONV} also works on {let}-terms that bind terms built up from applications of inductive type constructors. For example, if {} is an arbitrarily-nested tuple of distinct variables {v1}, ..., {vn} and {} is a structurally similar tuple of values, that is {} equals {[t1,...,tn/v1,...,vn]} for some terms {t1}, ..., {tn}, then: { let_CONV `let = in t` } \noindent returns { |- (let = in t) = t[t1,...,tn/v1,...,vn] } \noindent That is, the term {ti} is substituted for the corresponding variable {vi} in {t}. This form of {let}-reduction also works with simultaneous binding of tuples using {and}. \FAILURE {let_CONV tm} fails if {tm} is not a reducible {let}-term of one of the forms specified above. \EXAMPLE A simple example of the use of {let_CONV} to eliminate a single local variable is the following: { # let_CONV `let x = 1 in x+y`;; val it : thm = |- (let x = 1 in x + y) = 1 + y } \noindent and an example showing a tupled binding is: { # let_CONV `let (x,y) = (1,2) in x+y`;; val it : thm = |- (let x,y = 1,2 in x + y) = 1 + 2 } \noindent Simultaneous introduction of two bindings is illustrated by: { # let_CONV `let x = 1 and y = 2 in x + y + z`;; val it : thm = |- (let x = 1 and y = 2 in x + y + z) = 1 + 2 + z } \SEEALSO BETA_CONV, GEN_BETA_CONV. \ENDDOC hol-light/Help/lex.doc000066400000000000000000000030011303454263000151060ustar00rootroot00000000000000\DOC lex \TYPE {lex : string list -> lexcode list} \SYNOPSIS Lexically analyze an input string. \DESCRIBE The function {lex} expects a list of single-character strings representing input (as produced by {explode}, for example) and analyzes it into a sequence of tokens according to HOL Light lexical conventions. A token is either {Ident "s"} or {Resword "s"}; in each case this encodes a string but in the latter case indicates that the string is a reserved word. Lexical analysis essentially regards any number of alphanumeric characters (see {isalnum}) or any number of symbolic characters (see {issymb}) as a single token, except that certain brackets (see {isbra}) are only allowed to be single-character tokens and other separators (see {issep}) can only be combined with multiple instances of themselves not other characters. Whitespace including spaces, tabs and newlines (see {isspace}) is eliminated and serves only to separate tokens that would otherwise be one. Comments introduced by the comment token (see {comment_token}) are removed. \FAILURE Fails if the input is highly malformed, e.g. contains illegal characters. \EXAMPLE { # lex(explode "if p+1=2 then x + 1 else y - 1");; val it : lexcode list = [Resword "if"; Ident "p"; Ident "+"; Ident "1"; Ident "="; Ident "2"; Resword "then"; Ident "x"; Ident "+"; Ident "1"; Resword "else"; Ident "y"; Ident "-"; Ident "1"] } \SEEALSO comment_token, explode, isalnum, isbra, issep, isspace, issymb, is_reserved_word, parse_term, parse_type. \ENDDOC hol-light/Help/lhand.doc000066400000000000000000000017021303454263000154120ustar00rootroot00000000000000\DOC lhand \TYPE {lhand : term -> term} \SYNOPSIS Take left-hand argument of a binary operator. \DESCRIBE When applied to a term {t} that is an application of a binary operator to two arguments, i.e. is of the form {(op l) r}, the call {lhand t} will return the left-hand argument {l}. The terms {op} and {r} are arbitrary, though in many applications {op} is a constant such as addition or equality. \FAILURE Fails if the term is not of the indicated form. \EXAMPLE { # lhand `1 + 2`;; val it : term = `1` # lhand `2 + 2 = 4`;; val it : term = `2 + 2` # lhand `f x y z`;; Warning: inventing type variables val it : term = `y` # lhand `if p then q else r`;; Warning: inventing type variables val it : term = `q` } \COMMENTS On equations, {lhand} has the same effect as {lhs}, but may be slightly quicker because it does not check whether the operator {op} is indeed the equality constant. \SEEALSO lhs, rand, rhs. \ENDDOC hol-light/Help/lhs.doc000066400000000000000000000004551303454263000151160ustar00rootroot00000000000000\DOC lhs \TYPE {lhs : term -> term} \SYNOPSIS Returns the left-hand side of an equation. \DESCRIBE {lhs `t1 = t2`} returns {`t1`}. \FAILURE Fails with {lhs} if the term is not an equation. \EXAMPLE { # lhs `2 + 2 = 4`;; val it : term = `2 + 2` } \SEEALSO dest_eq, lhand, rand, rhs. \ENDDOC hol-light/Help/lift_function.doc000066400000000000000000000106761303454263000172010ustar00rootroot00000000000000\DOC lift_function \TYPE {lift_function : thm -> thm * thm -> string -> thm -> thm * thm} \SYNOPSIS Lift a function on representing type to quotient type of equivalence classes. \DESCRIBE Suppose type {qty} is a quotient type of {rty} under an equivalence relation {R:rty->rty->bool}, as defined by {define_quotient_type}, and {f} is a function {f:ty1->...->tyn->ty}, some {tyi} being the representing type {rty}. The term {lift_function} should be applied to (i) a theorem of the form {|- (?x. r = R x) <=> rep(abs r) = r} as returned by {define_quotient_type}, (ii) a pair of theorems asserting that {R} is reflexive and transitive, (iii) a desired name for the counterpart of {f} lifted to the type of equivalence classes, and (iv) a theorem asserting that {f} is ``welldefined'', i.e. respects the equivalence class. This last theorem essentially asserts that the value of {f} is independent of the choice of representative: any {R}-equivalent inputs give an equal output, or an {R}-equivalent one. Syntactically, the welldefinedness theorem should be of the form: { |- !x1 x1' .. xn xn'. (x1 == x1') /\ ... /\ (xn == xn') ==> (f x1 .. xn == f x1' .. f nx') } \noindent where each {==} may be either equality or the relation {R}, the latter of course only if the type of that argument is {rty}. The reflexivity and transitivity theorems should be { |- !x. R x x } \noindent and { |- !x y z. R x y /\ R y z ==> R x z } It returns two theorems, a definition and a consequential theorem that can be used by {lift_theorem} later. \FAILURE Fails if the theorems are malformed or if there is already a constant of the given name. \EXAMPLE Suppose that we have defined a type of finite multisets as in the documentation for {define_quotient_type}, based on the equivalence relation {multisame} on lists. First we prove that the equivalence relation {multisame} is indeed reflexive and transitive: { # let MULTISAME_REFL,MULTISAME_TRANS = (CONJ_PAIR o prove) (`(!l:(A)list. multisame l l) /\ (!l1 l2 l3:(A)list. multisame l1 l2 /\ multisame l2 l3 ==> multisame l1 l3)`, REWRITE_TAC[multisame] THEN MESON_TAC[]);; } We would like to define the multiplicity of an element in a multiset. First we define this notion on the representing type of lists: { # let listmult = new_definition `listmult a l = LENGTH (FILTER (\x:A. x = a) l)`;; } \noindent and prove that it is welldefined. Note that the second argument is the only one we want to lift to the quotient type, so that's the only one for which we use the relation {multisame}. For the first argument and the result we only use equality: { # let LISTMULT_WELLDEF = prove (`!a a':A l l'. a = a' /\ multisame l l' ==> listmult a l = listmult a' l'`, SIMP_TAC[listmult; multisame]);; } \noindent Now we can lift it to a multiplicity function on the quotient type: { # let multiplicity,multiplicity_th = lift_function multiset_rep (MULTISAME_REFL,MULTISAME_TRANS) "multiplicity" LISTMULT_WELLDEF;; val multiplicity : thm = |- multiplicity a l = (@u. ?l. listmult a l = u /\ list_of_multiset l l) val multiplicity_th : thm = |- listmult a l = multiplicity a (multiset_of_list (multisame l)) } Another example is the `union' of multisets, which we can consider as the lifting of the {APPEND} operation on lists, which we show is welldefined: { # let APPEND_WELLDEF = prove (`!l l' m m' :A list. multisame l l' /\ multisame m m' ==> multisame (APPEND l m) (APPEND l' m')`, SIMP_TAC[multisame; FILTER_APPEND]);; } \noindent and lift as follows: { # let munion,munion_th = lift_function multiset_rep (MULTISAME_REFL,MULTISAME_TRANS) "munion" APPEND_WELLDEF;; val munion : thm = |- munion l m = multiset_of_list (\u. ?l m. multisame (APPEND l m) u /\ list_of_multiset l l /\ list_of_multiset m m) val munion_th : thm = |- multiset_of_list (multisame (APPEND l m)) = munion (multiset_of_list (multisame l)) (multiset_of_list (multisame m)) } For continuation of this example, showing how to lift theorems from the representing functions to the functions on the quotient type, see the documentation entry for {lift_theorem}. \COMMENTS If, as in these examples, the representing type is parametrized by type variables, make sure that the same type variables are used consistently in the various theorems. \SEEALSO define_quotient_type, lift_theorem. \ENDDOC hol-light/Help/lift_theorem.doc000066400000000000000000000066461303454263000170210ustar00rootroot00000000000000\DOC lift_theorem \TYPE {lift_theorem : thm * thm -> thm * thm * thm -> thm list -> thm -> thm} \SYNOPSIS Lifts a theorem to quotient type from representing type. \DESCRIBE The function {lift_theorem} should be applied (i) a pair of type bijection theorems as returned by {define_quotient_type} for equivalence classes over a binary relation {R}, (ii) a triple of theorems asserting that the relation {R} is reflexive, symmetric and transitive in exactly the following form: { |- !x. R x x |- !x y. R x y <=> R y x |- !x y z. R x y /\ R y z ==> R x z } \noindent and (iii) the list of theorems returned as the second component of the pairs from {lift_function} for all functions that should be mapped. Finally, it is then applied to a theorem about the representing type. It automatically maps it over to the quotient type, appropriately modifying quantification over the representing type into quantification over the new quotient type, and replacing functions over the representing type with their corresponding lifted counterparts. Note that all variables should be bound by quantifiers; these may be existential or universal but if any types involve the representing type {rty} it must be just {rty} and not a composite or higher-order type such as {rty->rty} or {rty#num}. \FAILURE Fails if any of the input theorems are malformed (e.g. symmetry stated with implication instead of equivalence) or fail to correspond (e.g. different polymorphic type variables in the type bijections and the equivalence theorem). Otherwise it will not fail, but if used improperly may not map the theorem across cleanly. \EXAMPLE This is a continuation of the example in the documentation entries for {define_quotient_type} and {lift_function}, where a type of finite multisets is defined as the quotient of the type of lists by a suitable equivalence relation {multisame}. We can take the theorems asserting that this is indeed reflexive, symmetric and transitive: { # let [MULTISAME_REFL;MULTISAME_SYM;MULTISAME_TRANS] = (CONJUNCTS o prove) (`(!l:(A)list. multisame l l) /\ (!l l':(A)list. multisame l l' <=> multisame l' l) /\ (!l1 l2 l3:(A)list. multisame l1 l2 /\ multisame l2 l3 ==> multisame l1 l3)`, REWRITE_TAC[multisame] THEN MESON_TAC[]);; } \noindent and can now lift theorems. For example, we know that {APPEND} is itself associative, and so in particular: { # let MULTISAME_APPEND_ASSOC = prove (`!l m n. multisame (APPEND l (APPEND m n)) (APPEND (APPEND l m) n)`, REWRITE_TAC[APPEND_ASSOC; MULTISAME_REFL]);; } \noindent and we can easily show how list multiplicity interacts with {APPEND}: { # let LISTMULT_APPEND = prove (`!a l m. listmult a (APPEND l m) = listmult a l + listmult a m`, REWRITE_TAC[listmult; LENGTH_APPEND; FILTER_APPEND]);; } These theorems and any others like them can now be lifted to equivalence classes: { # let [MULTIPLICITY_MUNION;MUNION_ASSOC] = map (lift_theorem (multiset_abs,multiset_rep) (MULTISAME_REFL,MULTISAME_SYM,MULTISAME_TRANS) [multiplicity_th; munion_th]) [LISTMULT_APPEND; MULTISAME_APPEND_ASSOC];; val ( MULTIPLICITY_MUNION ) : thm = |- !a l m. multiplicity a (munion l m) = multiplicity a l + multiplicity a m val ( MUNION_ASSOC ) : thm = |- !l m n. munion l (munion m n) = munion (munion l m) n } \SEEALSO define_quotient_type, lift_function. \ENDDOC hol-light/Help/list_mk_abs.doc000066400000000000000000000006351303454263000166170ustar00rootroot00000000000000\DOC list_mk_abs \TYPE {list_mk_abs : term list * term -> term} \SYNOPSIS Iteratively constructs abstractions. \DESCRIBE {list_mk_abs([`x1`;...;`xn`],`t`)} returns {`\x1 ... xn. t`}. \FAILURE Fails with {list_mk_abs} if the terms in the list are not variables. \EXAMPLE { # list_mk_abs([`m:num`; `n:num`],`m + n + 1`);; val it : term = `\m n. m + n + 1` } \SEEALSO dest_abs, mk_abs, strip_abs. \ENDDOC hol-light/Help/list_mk_binop.doc000066400000000000000000000020251303454263000171540ustar00rootroot00000000000000\DOC list_mk_binop \TYPE {list_mk_binop : term -> term list -> term} \SYNOPSIS Makes an iterative application of a binary operator. \DESCRIBE The call {list_mk_binop op [t1; ...; tn]} constructs the term {op t1 (op t2 (op ... (op tn-1 tn) ...)))}. If we think of {op} as an infix operator we can write it {t1 op t2 op t3 ... op tn}, but the call will work for any term {op} compatible with all the types. \FAILURE Fails if the list of terms is empty or if the types would not work for the composite term. In particular, if the list contains at least three items, all the types must be the same. \EXAMPLE This example is typical: { # list_mk_binop `(+):num->num->num` (map mk_small_numeral (1--10));; val it : term = `1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10` } \noindent while these show that for smaller lists, one can just regard it as {mk_comb} or {mk_binop}: { # list_mk_binop `SUC` [`0`];; val it : term = `0` # list_mk_binop `f:A->B->C` [`x:A`; `y:B`];; val it : term = `f x y` } \SEEALSO binops, mk_binop. \ENDDOC hol-light/Help/list_mk_comb.doc000066400000000000000000000013041303454263000167640ustar00rootroot00000000000000\DOC list_mk_comb \TYPE {list_mk_comb : term * term list -> term} \SYNOPSIS Iteratively constructs combinations (function applications). \DESCRIBE {list_mk_comb(`t`,[`t1`;...;`tn`])} returns {`t t1 ... tn`}. \FAILURE Fails with {list_mk_comb} if the types of {t1},...,{tn} are not equal to the argument types of {t}. It is not necessary for all the arguments of {t} to be given. In particular the list of terms {t1},...,{tn} may be empty. \EXAMPLE { # list_mk_comb(`1`,[]);; val it : term = `1` # list_mk_comb(`(/\)`,[`T`]);; val it : term = `(/\) T` # list_mk_comb(`(/\)`,[`1`]);; Exception: Failure "mk_comb: types do not agree". } \SEEALSO list_mk_icomb, mk_comb, strip_comb. \ENDDOC hol-light/Help/list_mk_conj.doc000066400000000000000000000010731303454263000170000ustar00rootroot00000000000000\DOC list_mk_conj \TYPE {list_mk_conj : term list -> term} \SYNOPSIS Constructs the conjunction of a list of terms. \DESCRIBE {list_mk_conj([`t1`;...;`tn`])} returns {`t1 /\ ... /\ tn`}. \FAILURE Fails with {list_mk_conj} if the list is empty or if the list has more than one element, one or more of which are not of type {`:bool`}. \EXAMPLE { # list_mk_conj [`T`;`F`;`T`];; val it : term = `T /\ F /\ T` # list_mk_conj [`T`;`1`;`F`];; Exception: Failure "mk_binary". # list_mk_conj [`1`];; val it : term = `1` } \SEEALSO conjuncts, mk_conj. \ENDDOC hol-light/Help/list_mk_disj.doc000066400000000000000000000011041303454263000167730ustar00rootroot00000000000000\DOC list_mk_disj \TYPE {list_mk_disj : term list -> term} \SYNOPSIS Constructs the disjunction of a list of terms. \DESCRIBE {list_mk_disj([`t1`;...;`tn`])} returns {`t1 \/ ... \/ tn`}. \FAILURE Fails with {list_mk_disj} if the list is empty or if the list has more than one element, one or more of which are not of type {`:bool`}. \EXAMPLE { # list_mk_disj [`T`;`F`;`T`];; val it : term = `T \/ F \/ T` # list_mk_disj [`T`;`1`;`F`];; Exception: Failure "mk_binary". # list_mk_disj [`1`];; val it : term = `1` } \SEEALSO disjuncts, is_disj, mk_disj. \ENDDOC hol-light/Help/list_mk_exists.doc000066400000000000000000000014671303454263000173750ustar00rootroot00000000000000\DOC list_mk_exists \TYPE {list_mk_exists : term list * term -> term} \SYNOPSIS Multiply existentially quantifies both sides of an equation using the given variables. \KEYWORDS rule, quantifier, existential. \DESCRIBE When applied to a list of terms {[x1;...;xn]}, where the {ti} are all variables, and a theorem {A |- t1 = t2}, the inference rule {LIST_MK_EXISTS} existentially quantifies both sides of the equation using the variables given, none of which should be free in the assumption list. { A |- t1 <=> t2 ---------------------------------------- LIST_MK_EXISTS [`x1`;...;`xn`] A |- (?x1...xn. t1) <=> (?x1...xn. t2) } \FAILURE Fails if any term in the list is not a variable or is free in the assumption list, or if the theorem is not equational. \SEEALSO EXISTS_EQ, MK_EXISTS. \ENDDOC hol-light/Help/list_mk_forall.doc000066400000000000000000000010641303454263000173260ustar00rootroot00000000000000\DOC list_mk_forall \TYPE {list_mk_forall : term list * term -> term} \SYNOPSIS Iteratively constructs a universal quantification. \DESCRIBE {list_mk_forall([`x1`;...;`xn`],`t`)} returns {`!x1 ... xn. t`}. \FAILURE Fails if any term in the list is not a variable or if {t} is not of type {`:bool`} and the list of terms is non-empty. If the list of terms is empty the type of {t} can be anything. \EXAMPLE { # list_mk_forall([`x:num`; `y:num`],`x + y + 1 = SUC z`);; val it : term = `!x y. x + y + 1 = SUC z` } \SEEALSO mk_forall, strip_forall. \ENDDOC hol-light/Help/list_mk_gabs.doc000066400000000000000000000010221303454263000167550ustar00rootroot00000000000000\DOC list_mk_gabs \TYPE {list_mk_gabs : term list * term -> term} \SYNOPSIS Iteratively makes a generalized abstraction. \DESCRIBE The call {list_mk_gabs([vs1; ...; vsn],t)} constructs an interated generalized abstraction {\vs1. \vs2. ... \vsn. t}. See {mk_gabs} for more details on constructing generalized abstractions. \FAILURE Never fails. \EXAMPLE { # list_mk_gabs([`(x:num,y:num)`; `(w:num,z:num)`],`x + w + 1`);; val it : term = `\(x,y). \(w,z). x + w + 1` } \SEEALSO dest_gabs, is_gabs, mk_gabs. \ENDDOC hol-light/Help/list_mk_icomb.doc000066400000000000000000000017251303454263000171440ustar00rootroot00000000000000\DOC list_mk_icomb \TYPE {list_mk_icomb : string -> term list -> term} \SYNOPSIS Applies constant to list of arguments, instantiating constant type as needed. \DESCRIBE The call {list_mk_icomb "c" [a1; ...; an]} will make the term {c a1 ... an} where c is a constant, after first instantiating {c}'s generic type so that the types are compatible. \FAILURE Fails if {c} is not a constant or if the types cannot be instantiated to match up with the argument list. \EXAMPLE This would fail with the basic {list_mk_comb} function { # list_mk_icomb "=" [`1`; `2`];; val it : term = `1 = 2` } \COMMENTS Note that in general the generic type of the constant is only instantiated sufficiently to make its type match the arguments, which does not necessarily determine it completely. Unless you are sure this will be sufficient, it is safer and probably more efficient to instantiate the type manually using {inst} first. \SEEALSO list_mk_comb, mk_mconst, mk_icomb. \ENDDOC hol-light/Help/listof.doc000066400000000000000000000023751303454263000156330ustar00rootroot00000000000000\DOC listof \TYPE {listof : ('a -> 'b * 'c) -> ('c -> 'd * 'a) -> string -> 'a -> 'b list * 'c} \SYNOPSIS Parses a separated list of items. \DESCRIBE If {p} is a parser for ``items'' of some kind, {s} is a parser for a ``separator'', and {e} is an error message, then {listof p s e} parses a nonempty list of successive items using {p}, where adjacent items are separated by something parseable by {s}. If a separator is parsed successfully but there is no following item that can be parsed by {s}, an exception {Failure e} is raised. (So note that the separator must not terminate the final element.) \FAILURE The call {listof p s e} itself never fails, though the resulting parser may. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, leftbin, many, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/load_on_path.doc000066400000000000000000000013631303454263000167560ustar00rootroot00000000000000\DOC load_on_path \TYPE {load_on_path : string list -> string -> unit} \SYNOPSIS Finds a file on a path and loads it into HOL Light. \DESCRIBE When given a filename and a path, the file is found either directly by its filename or on the given path, as explained in {file_on_path}. An initial dollar sign {$} in each path is interpreted as a reference to the current setting of {hol_dir}. (To get an actual {$} at the start of the filename, actually use two dollar signs {$$}.) It is then loaded into HOL, updating the list of loaded files. \FAILURE Fails if the file is not found or generates an exception when loaded (e.g. a syntax problem or runtime exception). \SEEALSO file_on_path, hol_expand_directory, load_path, loads, loadt, needs. \ENDDOC hol-light/Help/load_path.doc000066400000000000000000000011531303454263000162570ustar00rootroot00000000000000\DOC load_path \TYPE {load_path : string list ref} \SYNOPSIS Path where HOL Light tries to find files to load. \DESCRIBE The reference variable {load_path} gives a list of directories. When HOL loads files with {loadt}, it will try these places in order on all non-absolute filenames. An initial dollar sign {$} in each path is interpreted as a reference to the current setting of {hol_dir}. To get an actual {$} character at the start of the filename, use two dollar signs {$$}. \FAILURE Not applicable. \SEEALSO file_on_path, help_path, hol_dir, hol_expand_directory, load_on_path, loads, loadt, needs. \ENDDOC hol-light/Help/loaded_files.doc000066400000000000000000000010231303454263000167320ustar00rootroot00000000000000\DOC loaded_files \TYPE {loaded_files : (string * Digest.t) list ref} \SYNOPSIS List of files loaded so far. \DESCRIBE This reference variable stores a list of previously loaded files together with MD5 digests. It is updated by all the main loading functions {load_on_path}, {loads}, {loadt} and {needs}, and is used by {needs} to avoid reloading the same file multiple times. \FAILURE Not applicable. \USES Not really intended for average users to examine or modify. \SEEALSO load_on_path, loads, loadt, needs. \ENDDOC hol-light/Help/loads.doc000066400000000000000000000013711303454263000154300ustar00rootroot00000000000000\DOC loads \TYPE {loads : string -> unit} \SYNOPSIS Load a file from the HOL Light system tree. \DESCRIBE Finds the named file, either by its absolute pathname or by starting in the base of the HOL installation stored by {hol_dir}, and loads it. \FAILURE Fails if the file is not found or generates an exception. \EXAMPLE To load a library with more number theory: { # loads "Library/prime.ml";; - : unit = () val ( MULT_MONO_EQ ) : thm = |- !m i n. SUC n * m = SUC n * i <=> m = i ... ... val ( GCD_CONV ) : term -> thm = val it : unit = () } \USES Loading HOL Light standard libraries without accidentally picking up other files of the same name in the current directory or on {load_path} \SEEALSO load_path, loadt, needs. \ENDDOC hol-light/Help/loadt.doc000066400000000000000000000016101303454263000154250ustar00rootroot00000000000000\DOC loadt \TYPE {loadt : string -> unit} \SYNOPSIS Finds a file on the load path and loads it. \DESCRIBE The function {loadt} takes a string indicating an OCaml file name as argument and loads it. If the filename is relative, it is found on the load path {load_path}, and it is then loaded, updating the list of loaded files. \FAILURE {loadt} will fail if the file named by the argument does not exist in the search path. It will of course fail if the file is not a valid OCaml file. Failure in the OCaml file will also terminate loading. \EXAMPLE If we have an ML file called {foo.ml} on the load path, e.g. in the current directory, which contains the line { let x=2+2;; } \noindent this can be loaded as follows: { # loadt "foo.ml";; } \noindent and the system would respond with: { # loadt "foo.ml";; val x : int = 4 val it : unit = () } \SEEALSO load_path, loads, needs. \ENDDOC hol-light/Help/lookup.doc000066400000000000000000000052051303454263000156370ustar00rootroot00000000000000\DOC lookup \TYPE {lookup : term -> 'a net -> 'a list} \SYNOPSIS Look up term in a term net. \DESCRIBE Term nets (type {'a net}) are a lookup structure associating objects of type {'a}, e.g. conversions, with a corresponding `pattern' term. For a given term, one can then relatively quickly look up all objects whose pattern terms might possibly match to it. This is used, for example, in rewriting to quickly filter out obviously inapplicable rewrites rather than attempting each one in turn. The call {lookup t net} for a term {t} returns the list of objects whose patterns might possibly be matchable to {t}. Note that this is conservative: if the pattern could be matched (even higher-order matched) in the sense of {term_match}, it will be in the list, but it is possible that some non-matchable objects will be returned. (For example, a pattern term {x + x} will match any term of the form {a + b}, even if {a} and {b} are the same.) It is intended that nets are a first-level filter for efficiency; finer discrimination may be embodied in the subsequent action with the list of returned objects. \FAILURE Never fails. \EXAMPLE If we want to create ourselves the kind of automated rewriting with the basic rewrites that is done by {REWRITE_CONV}, we could simply try in succession all the rewrites: { # let BASIC_REWRITE_CONV' = FIRST_CONV (map REWR_CONV (basic_rewrites()));; val ( BASIC_REWRITE_CONV' ) : conv = } However, it would be more efficient to use the left-hand sides as patterns in a term net to organize the different rewriting conversions: { # let rewr_net = let enter_thm th = enter (freesl(hyp th)) (lhs(concl th),REWR_CONV th) in itlist enter_thm (basic_rewrites()) empty_net;; } Now given a term, we get only the items with matchable patterns, usually much less than the full list: { # lookup `(\x. x + 1) 2` rewr_net;; val it : (term -> thm) list = [] # lookup `T /\ T` rewr_net;; val it : (term -> thm) list = [; ; ] } The three items returned in the last call are rewrites based on the theorems {|- T /\ t <=> t}, {|- t /\ T <=> t} and {|- t /\ t <=> t}, which are the only ones matchable. We can use this net for a more efficient version of the same conversion: { # let BASIC_REWRITE_CONV tm = FIRST_CONV (lookup tm rewr_net) tm;; val ( BASIC_REWRITE_CONV ) : term -> conv = } To see that it is indeed more efficient, consider: { # let tm = funpow 8 (fun x -> mk_conj(x,x)) `T`;; ... time (DEPTH_CONV BASIC_REWRITE_CONV) tm;; CPU time (user): 0.08 ... time (DEPTH_CONV BASIC_REWRITE_CONV') tm;; CPU time (user): 1.121 ... } \SEEALSO empty_net, enter, merge_nets. \ENDDOC hol-light/Help/make_args.doc000066400000000000000000000011601303454263000162530ustar00rootroot00000000000000\DOC make_args \TYPE {make_args : string -> term list -> hol_type list -> term list} \SYNOPSIS Make a list of terms with stylized variable names \DESCRIBE The call {make_args "s" avoids [ty0; ...; tyn]} constructs a list of variables of types {ty0}, ..., {tyn}, normally called {s0}, ..., {sn} but primed if necessary to avoid clashing with any in {avoids} \FAILURE Never fails. \EXAMPLE { # make_args "arg" [`arg2:num`] [`:num`; `:num`; `:num`];; val it : term list = [`arg0`; `arg1`; `arg2'`] } \USES Constructing arbitrary but relatively natural names for argument lists. \SEEALSO genvar, variant. \ENDDOC hol-light/Help/make_overloadable.doc000066400000000000000000000025671303454263000177720ustar00rootroot00000000000000\DOC make_overloadable \TYPE {make_overloadable : string -> hol_type -> unit} \SYNOPSIS Makes a symbol overloadable within the specified type skeleton. \DESCRIBE HOL Light allows the same identifier to denote several different underlying constants, with the choice being determined by types and/or an order of priority (see {prioritize_overload}). However, any identifier {ident} to be overloaded must first be declared overloadable using {make_overloadable "ident" `:ty`}. The ``type skeleton'' argument {`:ty`} is the most general type that the various instances may have. The type skeleton can simply be a type variable, in which case any type is acceptable, but it is good practice to constrain it where possible to allow more information to be inferred during typechecking. For example, the symbol `{+}' has the type skeleton {`:A->A->A`} (as you can find out by examining the list {the_overload_skeletons}) indicating that it is always overloaded to a binary operator that returns and element of the same type as its two arguments. \FAILURE Fails if the symbol has previously been made overloadable but with a different type skeleton. \EXAMPLE { # make_overloadable "<=" `:A->A->bool`;; val it : unit = () } \SEEALSO overload_interface, override_interface, prioritize_overload, reduce_interface, remove_interface, the_implicit_types, the_interface, the_overload_skeletons. \ENDDOC hol-light/Help/many.doc000066400000000000000000000020521303454263000152670ustar00rootroot00000000000000\DOC many \TYPE {many : ('a -> 'b * 'a) -> 'a -> 'b list * 'a} \SYNOPSIS Parses zero or more successive items using given parser. \DESCRIBE If {p} is a parser then {many p} gives a new parser that parses a series of successive items using {p} and returns the result as a list, with the expected left-to-right order. \FAILURE The immediate call {many} never fails. The resulting parser may fail when applied, though any {Noparse} exception in the core parser will be trapped. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, leftbin, listof, nothing, possibly, rightbin, some. \ENDDOC hol-light/Help/map.doc000066400000000000000000000005311303454263000151000ustar00rootroot00000000000000\DOC map \TYPE {map : ('a -> 'b) -> 'a list -> 'b list} \SYNOPSIS Applies a function to every element of a list. \DESCRIBE {map f [x1;...;xn]} returns {[(f x1);...;(f xn)]}. \FAILURE Never fails. \EXAMPLE { # map (fun x -> x * 2) [];; val it : int list = [] # map (fun x -> x * 2) [1;2;3];; val it : int list = [2; 4; 6] } \ENDDOC hol-light/Help/map2.doc000066400000000000000000000006441303454263000151670ustar00rootroot00000000000000\DOC map2 \TYPE {map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list} \SYNOPSIS Maps a binary function over two lists to create one new list. \DESCRIBE {map2 f ([x1;...;xn],[y1;...;yn])} returns {[f(x1,y1);...;f(xn,yn)]}. \FAILURE Fails with {map2} if the two lists are of different lengths. \EXAMPLE { # map2 (+) [1;2;3] [30;20;10];; val it : int list = [31; 22; 13] } \SEEALSO map, uncurry. \ENDDOC hol-light/Help/mapf.doc000066400000000000000000000016601303454263000152520ustar00rootroot00000000000000\DOC mapf \TYPE {mapf : ('a -> 'b) -> ('c, 'a) func -> ('c, 'b) func} \SYNOPSIS Maps a function over the range of a finite partial function \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The function {mapf f p} applies the (ordinary OCaml) function {f} to all the range elements of a finite partial function, so if it originally mapped {xi} to {yi} for it now maps {xi} to {f(yi)}. \FAILURE Fails if the function fails on one of the {yi}. \EXAMPLE { # let f = (1 |=> 2);; val f : (int, int) func = # mapf string_of_int f;; val it : (int, string) func = # apply it 1;; } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/mapfilter.doc000066400000000000000000000012521303454263000163070ustar00rootroot00000000000000\DOC mapfilter \TYPE {mapfilter : ('a -> 'b) -> 'a list -> 'b list} \SYNOPSIS Applies a function to every element of a list, returning a list of results for those elements for which application succeeds. \KEYWORDS list. \FAILURE Fails if an exception not of the form {Failure _} is generated by any application to the elements. \EXAMPLE { # mapfilter hd [[1;2;3];[4;5];[];[6;7;8];[]];; val it : int list = [1; 4; 6] # mapfilter (fun (h::t) -> h) [[1;2;3];[4;5];[];[6;7;8];[]];; Warning: this pattern-matching is not exhaustive. Here is an example of a value that is not matched: [] Exception: Match_failure ("", 24547, -35120). } \SEEALSO filter, map. \ENDDOC hol-light/Help/mem.doc000066400000000000000000000004721303454263000151050ustar00rootroot00000000000000\DOC mem \TYPE {mem : 'a -> 'a list -> bool} \SYNOPSIS Tests whether a list contains a certain member. \DESCRIBE {mem x [x1;...;xn]} returns {true} if some {xi} in the list is equal to {x}. Otherwise it returns {false}. \FAILURE Never fails. \SEEALSO find, tryfind, exists, forall, assoc, rev_assoc. \ENDDOC hol-light/Help/mem_prime.doc000066400000000000000000000014551303454263000163030ustar00rootroot00000000000000\DOC mem' \TYPE {mem' : ('a -> 'b -> bool) -> 'a -> 'b list -> bool} \SYNOPSIS Tests if an element is equivalent to a member of a list w.r.t. some relation. \DESCRIBE If {r} is a binary relation, {x} an element and {l} a list, the call {mem' r x l} tests if there is an element in the list {l} that is equivalent to {x} according to {r}, that is, if {r x x'} holds for some {x'} in {l}. The function {mem} is the special case where the relation is equality. \FAILURE Fails only if the relation {r} fails. \EXAMPLE { # mem' (fun x y -> abs(x) = abs(y)) (-1) [1;2;3];; val it : bool = true # mem' (fun x y -> abs(x) = abs(y)) (-1) [2;3;4];; val it : bool = false } \USES Set operations modulo some equivalence such as alpha-equivalence. \SEEALSO insert', mem, subtract', union', unions'. \ENDDOC hol-light/Help/merge.doc000066400000000000000000000012141303454263000154210ustar00rootroot00000000000000\DOC merge \TYPE {merge : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list} \SYNOPSIS Merges together two sorted lists with respect to a given ordering. \DESCRIBE If two lists {l1} and {l2} are sorted with respect to the given ordering {ord}, then {merge ord l1 l2} will merge them into a sorted list of all the elements. The merge keeps any duplicates; it is not a set operation. \FAILURE Never fails, but if the lists are not appropriately sorted the results will not in general be correct. \EXAMPLE { # merge (<) [1;2;3;4;5;6] [2;4;6;8];; val it : int list = [1; 2; 2; 3; 4; 4; 5; 6; 6; 8] } \SEEALSO mergesort, sort, uniq. \ENDDOC hol-light/Help/merge_nets.doc000066400000000000000000000021351303454263000164550ustar00rootroot00000000000000\DOC merge_nets \TYPE {merge_nets : 'a net * 'a net -> 'a net} \SYNOPSIS Merge together two term nets. \DESCRIBE Term nets (type {'a net}) are a lookup structure associating objects of type {'a}, e.g. conversions, with a corresponding `pattern' term. For a given term, one can then relatively quickly look up all objects whose pattern terms might possibly match to it. This is used, for example, in rewriting to quickly filter out obviously inapplicable rewrites rather than attempting each one in turn. The call {merge_nets(net1,net2)} merges two nets together; the list of objects is the union of those objects in the two nets {net1} and {net2}, with the term patterns adjusted appropriately. \FAILURE Never fails. \EXAMPLE If we have one term net containing the addition conversion: { # let net1 = enter [] (`x + y`,NUM_ADD_CONV) empty_net;; ... } \noindent and another with beta-conversion: { # let net2 = enter [] (`(\x. t) y`,BETA_CONV) empty_net;; ... } \noindent we can combine them into a single net: { # let net = merge_nets(net1,net2);; ... } \SEEALSO empty_net, enter, lookup. \ENDDOC hol-light/Help/mergesort.doc000066400000000000000000000013331303454263000163330ustar00rootroot00000000000000\DOC mergesort \TYPE {mergesort : ('a -> 'a -> bool) -> 'a list -> 'a list} \SYNOPSIS Sorts the list with respect to given ordering using mergesort algorithm. \DESCRIBE If {ord} is a total order, a call {mergesort ord l} will sort the list {l} according to the order {ord}. It works internally by a mergesort algorithm. From a user's point of view, this just means: (i) its worst-case performance is much better than {sort}, which uses quicksort, but (ii) it will not reliably topologically sort for a non-total order, whereas {sort} will. \FAILURE Never fails unless the ordering function fails. \EXAMPLE { # mergesort (<) [6;2;5;9;2;5;3];; val it : int list = [2; 2; 3; 5; 5; 6; 9] } \SEEALSO merge, sort. \ENDDOC hol-light/Help/meson_brand.doc000066400000000000000000000017661303454263000166250ustar00rootroot00000000000000\DOC meson_brand \TYPE {meson_brand : bool ref} \SYNOPSIS Makes {MESON} handle equations using Brand's transformation. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, {MESON_TAC} and related rules and tactics. When {meson_brand} is {true}, equations are handled inside {MESON} by applying Brand's transformation. When it is {false}, as it is by default, equations are handled in a more ``naive'' way, which nevertheless appears generally better. \FAILURE Not applicable. \USES For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \COMMENTS For more details of Brand's modification, see his paper ``Proving theorems with the modification method'', SIAM Journal on Computing volume 4, 1975. See also Moser and Steinbach's Munich technical report ``STE-modification revisited'' (AR-97-03, 1997) for another look at the subject. \SEEALSO meson_chatty, meson_dcutin, meson_depth, meson_prefine, meson_skew, meson_split_limit, \ENDDOC hol-light/Help/meson_chatty.doc000066400000000000000000000012501303454263000170170ustar00rootroot00000000000000\DOC meson_chatty \TYPE {meson_chatty : bool ref} \SYNOPSIS Make {MESON}'s output more verbose and detailed. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, {MESON_TAC} and related rules and tactics. When {meson_chatty} is set to {true}, {MESON} provides more verbose output, reporting at each level of iterative deepening search the current size limit and number of inferences on a fresh line. When {meson_chatty} is {false}, as it is by default, the core inference numbers are condensed into 1-line output. \FAILURE Not applicable. \SEEALSO meson_brand, meson_dcutin, meson_depth, meson_prefine, meson_skew, meson_split_limit, \ENDDOC hol-light/Help/meson_dcutin.doc000066400000000000000000000014041303454263000170120ustar00rootroot00000000000000\DOC meson_dcutin \TYPE {meson_dcutin : int ref} \SYNOPSIS Determines cut-in point for divide-and-conquer refinement in {MESON}. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, {MESON_TAC} and related rules and tactics. This number (by default 1) determines the number of current subgoals at which point a special divide-and-conquer refinement will be invoked. \FAILURE Not applicable. \USES For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \COMMENTS For more details of this optimization, see Harrison's paper ``Optimizing Proof Search in Model Elimination'', CADE-13, 1996. \SEEALSO meson_brand, meson_chatty, meson_depth, meson_prefine, meson_skew, meson_split_limit, \ENDDOC hol-light/Help/meson_depth.doc000066400000000000000000000014561303454263000166370ustar00rootroot00000000000000\DOC meson_depth \TYPE {meson_depth : bool ref} \SYNOPSIS Make {MESON}'s search algorithm work by proof depth rather than size. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, {MESON_TAC} and related rules and tactics. The basic search strategy is iterated deepening, searching for proofs with higher and higher limits on the search space. The flag {meson_depth}, when set to {true}, limits the search space based on proof depth, i.e. the longest branch. When set to {false}, as it is by default, the proof is limited based on total size. \FAILURE Not applicable. \USES For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \SEEALSO meson_brand, meson_chatty, meson_dcutin, meson_prefine, meson_skew, meson_split_limit, \ENDDOC hol-light/Help/meson_prefine.doc000066400000000000000000000016551303454263000171640ustar00rootroot00000000000000\DOC meson_prefine \TYPE {meson_prefine : bool ref} \SYNOPSIS Makes {MESON} apply Plaisted's positive refinement. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, {MESON_TAC} and related rules and tactics. When the flag {meson_prefine} is {true}, as it is by default, Plaisted's ``positive refinement'' is used in proof search; this limits the search space at the cost of sometimes requiring longer proofs. When {meson_prefine} is false, this refinement is not applied. \FAILURE Not applicable. \USES For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \COMMENTS For more details, see Plaisted's article ``A Sequent-Style Model Elimination Strategy and a Positive Refinement'', Journal of Automated Reasoning volume 6, 1990. \SEEALSO meson_brand, meson_chatty, meson_dcutin, meson_depth, meson_skew, meson_split_limit, \ENDDOC hol-light/Help/meson_skew.doc000066400000000000000000000017451303454263000165050ustar00rootroot00000000000000\DOC meson_skew \TYPE {meson_skew : int ref} \SYNOPSIS Determines skew in {MESON} proof tree search limits. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, {MESON_TAC} and related rules and tactics. During search, {MESON} successively searches for proofs of larger and larger `size'. The ``skew'' value determines what proportion of the entire proof size is permitted in the left-hand half of the list of subgoals. The symmetrical value is {2} (meaning one half), the default setting of {3} (one third) seems generally better because it can cut down on redundancy in proofs. \FAILURE Not applicable. \USES For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \COMMENTS For more details of {MESON}'s search strategy, see Harrison's paper ``Optimizing Proof Search in Model Elimination'', CADE-13, 1996. \SEEALSO meson_brand, meson_chatty, meson_dcutin, meson_depth, meson_prefine, meson_split_limit, \ENDDOC hol-light/Help/meson_split_limit.doc000066400000000000000000000017001303454263000200540ustar00rootroot00000000000000\DOC meson_split_limit \TYPE {meson_split_limit : int ref} \SYNOPSIS Limit initial case splits before {MESON} proper is applied. \DESCRIBE This is one of several parameters determining the behavior of {MESON}, {MESON_TAC} and related rules and tactics. Before these rules or tactics are applied, the formula to be proved is often decomposed by splitting, for example an equivalence {p <=> q} to two separate implications {p ==> q} and {q ==> p}. This often makes the eventual proof much easier for {MESON}. On the other hand, if splitting is applied too many times, it can become inefficient. The value {meson_split_limit} (default {8}) is the maximum number of times that splitting can be applied before {MESON} proper. \FAILURE Not applicable. \USES For users requiring fine control over the algorithms used in {MESON}'s first-order proof search. \SEEALSO meson_brand, meson_chatty, meson_dcutin, meson_depth, meson_prefine, meson_skew. \ENDDOC hol-light/Help/mk_abs.doc000066400000000000000000000007371303454263000155670ustar00rootroot00000000000000\DOC mk_abs \TYPE {mk_abs : term * term -> term} \SYNOPSIS Constructs an abstraction. \DESCRIBE If {v} is a variable and {t} any term, then {mk_abs(v,t)} produces the abstraction term {\v. t}. It is not necessary that {v} should occur free in {t}. \FAILURE Fails if {v} is not a variable. See {mk_gabs} for constructing generalized abstraction terms. \EXAMPLE { # mk_abs(`x:num`,`x + 1`);; val it : term = `\x. x + 1` } \SEEALSO dest_abs, is_abs, mk_gabs. \ENDDOC hol-light/Help/mk_binary.doc000066400000000000000000000014701303454263000163010ustar00rootroot00000000000000\DOC mk_binary \TYPE {mk_binary : string -> term * term -> term} \SYNOPSIS Constructs an instance of a named monomorphic binary operator. \DESCRIBE The call {mk_binary s (l,r)} constructs a binary application {(op l) r} where {op} is the monomorphic constant with name {s}. Note that it will in general {{\em not}} work if the constant is polymorphic. \FAILURE If there is no constant at all with name {s}, or if the constant is polymorphic and the terms do not match its most general type. \EXAMPLE This case works fine: { # mk_binary "+" (`1`,`2`);; val it : term = `1 + 2` } \noindent but here we hit the monomorphism restriction: { # mk_binary "=" (`a:A`,`b:A`);; val it : term = `a = b` # mk_binary "=" (`1`,`2`);; Exception: Failure "mk_binary". } \SEEALSO dest_binary, is_binary, mk_binop. \ENDDOC hol-light/Help/mk_binder.doc000066400000000000000000000013461303454263000162620ustar00rootroot00000000000000\DOC mk_binder \TYPE {mk_binder : string -> term * term -> term} \SYNOPSIS Constructs a term with a named constant applied to an abstraction. \DESCRIBE The call {mk_binder "c" (x,t)} returns the term {c (\x. t)} where {c} is a constant with the given name appropriately type-instantiated. Note that the binder parsing status of {c} is irrelevant, though only if it is parsed as a binder will the resulting term be printed and parseable as {c x. t}. \FAILURE Failus if {x} is not a variable, if there is no constant {c} or if the type of that constant cannot be instantiated to match the abstraction. \EXAMPLE { # mk_binder "!" (`x:num`,`x + 1 > 0`);; val it : term = `!x. x + 1 > 0` } \SEEALSO dest_binder, is_binder. \ENDDOC hol-light/Help/mk_binop.doc000066400000000000000000000012221303454263000161170ustar00rootroot00000000000000\DOC mk_binop \TYPE {mk_binop : term -> term -> term -> term} \SYNOPSIS The call {mk_binop op l r} returns the term {(op l) r}. \KEYWORDS \LIBRARY \DESCRIBE The call {mk_binop op l r} returns the term {(op l) r} provided that is well-typed. Otherwise it fails. The term {op} need not be a constant nor parsed as infix, but that is the usual case. Note that type variables in {op} are not instantiated, so it needs to be the correct instance for the terms {l} and {r}. \FAILURE Fails if the types are incompatible. \EXAMPLE { # mk_binop `(+):num->num->num` `1` `2`;; val it : term = `1 + 2` } \SEEALSO dest_binop, is_binop, mk_binary. \ENDDOC hol-light/Help/mk_char.doc000066400000000000000000000011051303454263000157250ustar00rootroot00000000000000\DOC mk_char \TYPE {mk_char : char -> term} \SYNOPSIS Constructs object-level character from OCaml character. \DESCRIBE {mk_char 'c'} produces the HOL term of type {char} corresponding to the OCaml character {c}. \FAILURE Never fails \EXAMPLE { # mk_char 'c';; val it : term = `ASCII F T T F F F T T` } \COMMENTS There is no particularly convenient parser/printer support for the HOL {char} type, but when combined into lists they are considered as strings and provided with more intuitive parser/printer support. \SEEALSO dest_char, dest_string, mk_string. \ENDDOC hol-light/Help/mk_comb.doc000066400000000000000000000011131303454263000157270ustar00rootroot00000000000000\DOC mk_comb \TYPE {mk_comb : term * term -> term} \SYNOPSIS Constructs a combination. \DESCRIBE Given two terms {f} and {x}, the call {mk_comb(f,x)} returns the combination or application {f x}. It is necessary that {f} has a function type with domain type the same as {x}'s type. \FAILURE Fails if the types of the terms are not compatible as specified above. \EXAMPLE { # mk_comb(`SUC`,`0`);; val it : term = `SUC 0` # mk_comb(`SUC`,`T`);; Exception: Failure "mk_comb: types do not agree". } \SEEALSO dest_comb, is_comb, list_mk_comb, list_mk_icomb, mk_icomb. \ENDDOC hol-light/Help/mk_cond.doc000066400000000000000000000004751303454263000157440ustar00rootroot00000000000000\DOC mk_cond \TYPE {mk_cond : term * term * term -> term} \SYNOPSIS Constructs a conditional term. \DESCRIBE {mk_cond(`t`,`t1`,`t2`)} returns {`if t then t1 else t2`}. \FAILURE Fails with {mk_cond} if {t} is not of type {`:bool`} or if {t1} and {t2} are of different types. \SEEALSO dest_cond, is_cond. \ENDDOC hol-light/Help/mk_conj.doc000066400000000000000000000005651303454263000157520ustar00rootroot00000000000000\DOC mk_conj \TYPE {mk_conj : term * term -> term} \SYNOPSIS Constructs a conjunction. \DESCRIBE {mk_conj(`t1`,`t2`)} returns {`t1 /\ t2`}. \FAILURE Fails with {mk_conj} if either {t1} or {t2} are not of type {`:bool`}. \EXAMPLE { # mk_conj(`1 + 1 = 2`,`2 + 2 = 4`);; val it : term = `1 + 1 = 2 /\ 2 + 2 = 4` } \SEEALSO dest_conj, is_conj, list_mk_conj. \ENDDOC hol-light/Help/mk_cons.doc000066400000000000000000000007401303454263000157560ustar00rootroot00000000000000\DOC mk_cons \TYPE {mk_cons : term -> term -> term} \SYNOPSIS Constructs a {CONS} pair. \DESCRIBE {mk_cons `h` `t`} returns {`CONS h t`}. \FAILURE Fails if second term is not of list type or if the first term is not of the same type as the elements of the list. \EXAMPLE { # mk_cons `1` `l:num list`;; val it : term = `CONS 1 l` # mk_cons `1` `[2;3;4]`;; val it : term = `[1; 2; 3; 4]` } \SEEALSO dest_cons, dest_list, is_cons, is_list, mk_flist, mk_list. \ENDDOC hol-light/Help/mk_const.doc000066400000000000000000000017231303454263000161440ustar00rootroot00000000000000\DOC mk_const \TYPE {mk_const : string * (hol_type * hol_type) list -> term} \SYNOPSIS Produce constant term by applying an instantiation to its generic type. \DESCRIBE This is the basic way of constructing a constant term in HOL Light, applying a specific instantiation (by {type_subst}) to its generic type. It may sometimes be more convenient to use {mk_mconst}, which just takes the desired type for the constant and finds the instantiation itself; that is also a natural inverse for {dest_const}. However, {mk_const} is likely to be significantly faster. \FAILURE Fails if there is no constant of the given type. \EXAMPLE { # get_const_type "=";; val it : hol_type = `:A->A->bool` # mk_const("=",[`:num`,`:A`]);; val it : term = `(=)` # type_of it;; val it : hol_type = `:num->num->bool` # mk_const("=",[`:num`,`:A`]) = mk_mconst("=",`:num->num->bool`);; val it : bool = true } \SEEALSO dest_const, is_const, mk_mconst, type_subst. \ENDDOC hol-light/Help/mk_disj.doc000066400000000000000000000005471303454263000157520ustar00rootroot00000000000000\DOC mk_disj \TYPE {mk_disj : term * term -> term} \SYNOPSIS Constructs a disjunction. \DESCRIBE {mk_disj(`t1`,`t2`)} returns {`t1 \/ t2`}. \FAILURE Fails with {mk_disj} if either {t1} or {t2} are not of type {`:bool`}. \EXAMPLE { # mk_disj(`x = 1`,`y <= 2`);; val it : term = `x = 1 \/ y <= 2` } \SEEALSO dest_disj, is_disj, list_mk_disj. \ENDDOC hol-light/Help/mk_eq.doc000066400000000000000000000004521303454263000154210ustar00rootroot00000000000000\DOC mk_eq \TYPE {mk_eq : term * term -> term} \SYNOPSIS Constructs an equation. \DESCRIBE {mk_eq(`t1`,`t2`)} returns {`t1 = t2`}. \FAILURE Fails with {mk_eq} if {t1} and {t2} have different types. \EXAMPLE { # mk_eq(`1`,`2`);; val it : term = `1 = 2` } \SEEALSO dest_eq, is_eq. \ENDDOC hol-light/Help/mk_exists.doc000066400000000000000000000006301303454263000163310ustar00rootroot00000000000000\DOC mk_exists \TYPE {mk_exists : term * term -> term} \SYNOPSIS Term constructor for existential quantification. \DESCRIBE {mk_exists(`v`,`t`)} returns {`?v. t`}. \FAILURE Fails with if first term is not a variable or if {t} is not of type {`:bool`}. \EXAMPLE { # mk_exists(`x:num`,`x + 1 = 1 + x`);; val it : term = `?x. x + 1 = 1 + x` } \SEEALSO dest_exists, is_exists, list_mk_exists. \ENDDOC hol-light/Help/mk_flist.doc000066400000000000000000000011561303454263000161370ustar00rootroot00000000000000\DOC mk_flist \TYPE {mk_flist : term list -> term} \SYNOPSIS Constructs object-level list from nonempty list of terms. \DESCRIBE {mk_flist [`t1`;...;`tn`]} returns {`[t1;...;tn]`}. The list must be nonempty, since the type could not be inferred for that case. For cases where you may need to construct an empty list, use {mk_list}. \FAILURE Fails if the list is empty or if the types of any elements differ from each other. \EXAMPLE { # mk_flist(map mk_small_numeral (1--10));; val it : term = `[1; 2; 3; 4; 5; 6; 7; 8; 9; 10]` } \SEEALSO dest_cons, dest_list, is_cons, is_list, mk_cons, mk_list. \ENDDOC hol-light/Help/mk_forall.doc000066400000000000000000000006261303454263000162760ustar00rootroot00000000000000\DOC mk_forall \TYPE {mk_forall : term * term -> term} \SYNOPSIS Term constructor for universal quantification. \DESCRIBE {mk_forall(`v`,`t`)} returns {`!v. t`}. \FAILURE Fails with if first term is not a variable or if {t} is not of type {`:bool`}. \EXAMPLE { # mk_forall(`x:num`,`x + 1 = 1 + x`);; val it : term = `!x. x + 1 = 1 + x` } \SEEALSO dest_forall, is_forall, list_mk_forall. \ENDDOC hol-light/Help/mk_fset.doc000066400000000000000000000014621303454263000157570ustar00rootroot00000000000000\DOC mk_fset \TYPE {mk_fset : term list -> term} \SYNOPSIS Constructs an explicit set enumeration from a nonempty list of elements. \DESCRIBE When applied to a list of terms {[`t1`; ...; `tn`]} of the same type, the function {mk_fset} constructs an explicit set enumeration term {`{{t1, ..., tn}}`}. Note that duplicated elements are maintained in the resulting term, though this is logically the same as the set without them. If you need to generate enumerations for empty sets, use {mk_setenum}; in this case the type also needs to be specified. \FAILURE Fails if there are terms of more than one type in the list, or if the list is empty. \EXAMPLE { # mk_fset (map mk_small_numeral (0--7));; val it : term = `{{0, 1, 2, 3, 4, 5, 6, 7}}` } \SEEALSO dest_setenum, is_setenum, mk_flist, mk_setenum. \ENDDOC hol-light/Help/mk_fthm.doc000066400000000000000000000014271303454263000157550ustar00rootroot00000000000000\DOC mk_fthm \TYPE {mk_fthm : term list * term -> thm} \SYNOPSIS Create arbitrary theorem by adding additional `false' assumption. \DESCRIBE The call {mk_fthm(asl,c)} returns a theorem with conclusion {c} and assumption list {asl} together with the special assumption {_FALSITY_}, which is defined to be logically equivalent to {F} (false). This is the closest approach to {mk_thm} that does not involve adding a new axiom and so potentially compromising soundness. \FAILURE Fails if any of the given terms does not have Boolean type. \EXAMPLE { # mk_fthm([],`1 = 2`);; val it : thm = _FALSITY_ |- 1 = 2 } \USES Used for validity-checking of justification functions as a sanity check in tactic applications: see {VALID}. \SEEALSO CHEAT_TAC, mk_thm, new_axiom, VALID. \ENDDOC hol-light/Help/mk_fun_ty.doc000066400000000000000000000007671303454263000163310ustar00rootroot00000000000000\DOC mk_fun_ty \TYPE {mk_fun_ty : hol_type -> hol_type -> hol_type} \SYNOPSIS Construct a function type. \DESCRIBE The call {mk_fun_ty ty1 ty2} gives the function type {ty1->ty2}. This is an exact synonym of {mk_type("fun",[ty1; ty2])}, but a little more convenient. \FAILURE Never fails. \EXAMPLE { # mk_fun_ty `:num` `:num`;; val it : hol_type = `:num->num` # itlist mk_fun_ty [`:A`; `:B`; `:C`] `:bool`;; val it : hol_type = `:A->B->C->bool` } \SEEALSO dest_type, mk_type. \ENDDOC hol-light/Help/mk_gabs.doc000066400000000000000000000025121303454263000157270ustar00rootroot00000000000000\DOC mk_gabs \TYPE {mk_gabs : term * term -> term} \SYNOPSIS Constructs a generalized abstraction. \DESCRIBE Given a pair of terms {s} and {t}, the call {mk_gabs(s,t)} constructs a canonical `generalized abstraction' that is thought of as `some function that always maps {s} to {t}'. In the case where {s} is a variable, the result is an ordinary abstraction as constructed by {mk_abs}. In other cases, the canonical composite structure is created. Note that the logical construct is welldefined even if there is no function mapping {s} to {t}, and this function will always succeed, even if the resulting structure is not really useful. \FAILURE Never fails. \EXAMPLE Here is a simple abstraction: { # mk_gabs(`x:bool`,`~x`);; val it : term = `\x. ~x` } \noindent and here are a couple of potentially useful generalized ones: { # mk_gabs(`(x:num,y:num)`,`x + y + 1`);; val it : term = `\(x,y). x + y + 1` # mk_gabs(`CONS (h:num) t`,`if h = 0 then t else CONS h t`);; val it : term = `\CONS h t. if h = 0 then t else CONS h t` } \noindent while here is a vacuous one about which nothing interesting will be proved, because there is no welldefined function that always maps {x + y} to {x}: { # mk_gabs(`x + y:num`,`x:num`);; val it : term = `\(x + y). x` } \SEEALSO dest_gabs, GEN_BETA_CONV, is_gabs, list_mk_gabs. \ENDDOC hol-light/Help/mk_goalstate.doc000066400000000000000000000006211303454263000167750ustar00rootroot00000000000000\DOC mk_goalstate \TYPE {mk_goalstate : goal -> goalstate} \SYNOPSIS Converts a goal into a 1-element goalstate. \DESCRIBE Given a goal {g}, the call {mk_goalstate g} converts it into a goalstate with that goal as its only member. (A goalstate consists of a list of subgoals as well as justification and metavariable information.) \FAILURE Never fails. \SEEALSO g, set_goal, TAC_PROOF. \ENDDOC hol-light/Help/mk_icomb.doc000066400000000000000000000014011303454263000161000ustar00rootroot00000000000000\DOC mk_icomb \TYPE {mk_icomb : term * term -> term} \SYNOPSIS Makes a combination, instantiating types in rator if necessary. \DESCRIBE The call {mk_icomb(f,x)} makes the combination {f x}, just as with {mk_comb}, but if necessary to ensure the types are compatible it will instantiate type variables in {f} first. \FAILURE Fails if the rator type is impossible to instantiate compatibly. \EXAMPLE The analogous call to the following using plain {mk_const} would fail: { # mk_icomb(`(!)`,`\x. x = 1`);; Warning: inventing type variables val it : term = `!x. x = 1` } \USES A handy way of making combinations involving polymorphic constants, without needing a manual instantiation of the generic type. \SEEALSO list_mk_icomb, mk_comb, type_match. \ENDDOC hol-light/Help/mk_iff.doc000066400000000000000000000010141303454263000155530ustar00rootroot00000000000000\DOC mk_iff \TYPE {mk_iff : term * term -> term} \SYNOPSIS Constructs a logical equivalence (Boolean equation). \DESCRIBE {mk_iff(`t1`,`t2`)} returns {`t1 <=> t2`}. \FAILURE Fails with unless {t1} and {t2} both have Boolean type. \EXAMPLE { # mk_iff(`x = 1`,`1 = x`);; val it : term = `x = 1 <=> 1 = x` } \COMMENTS Simply {mk_eq} has the same effect on successful calls. However {mk_iff} is slightly more efficient, and will fail if the terms do not have Boolean type. \SEEALSO dest_iff, is_iff,mk_eq. \ENDDOC hol-light/Help/mk_imp.doc000066400000000000000000000005371303454263000156050ustar00rootroot00000000000000\DOC mk_imp \TYPE {mk_imp : term * term -> term} \SYNOPSIS Constructs an implication. \DESCRIBE {mk_imp(`t1`,`t2`)} returns {`t1 ==> t2`}. \FAILURE Fails with {mk_imp} if either {t1} or {t2} are not of type {`:bool`}. \EXAMPLE { # mk_imp(`p /\ q`,`r:bool`);; val it : term = `p /\ q ==> r` } \SEEALSO dest_imp, is_imp, list_mk_imp. \ENDDOC hol-light/Help/mk_intconst.doc000066400000000000000000000013301303454263000166510ustar00rootroot00000000000000\DOC mk_intconst \TYPE {mk_intconst : num -> term} \SYNOPSIS Converts an OCaml number to a canonical integer literal of type {:int}. \DESCRIBE The call {mk_intconst n} where {n} is an OCaml number (type {num}) produces the canonical integer literal of type {:int} representing the integer {n}. This will be of the form `{&m}' for a numeral {m} (when {n} is nonnegative) or `{-- &m}' for a nonzero numeral {m} (when {n} is negative). \FAILURE Fails if applied to a number that is not an integer (type {num} also includes rational numbers). \EXAMPLE { # mk_intconst (Int (-101));; val it : term = `-- &101` # type_of it;; val it : hol_type = `:int` } \SEEALSO dest_intconst, is_intconst, mk_realintconst. \ENDDOC hol-light/Help/mk_let.doc000066400000000000000000000012511303454263000155760ustar00rootroot00000000000000\DOC mk_let \TYPE {mk_let : (term * term) list * term -> term} \SYNOPSIS Constructs a let-expression. \DESCRIBE Given argument {([l1,r1; ...; ln,rn],bod)}, the {mk_let} constructor produces the let-expression {let l1 = r1 and ... and ln = rn in bod}. \FAILURE Fails if the list of left-hand and right-hand sides is empty or if some corresponding pair of left-hand and right-hand sides have different types. \EXAMPLE { # mk_let([`x:num`,`1`],`x + 2`);; val it : term = `let x = 1 in x + 2` # mk_let([`CONS (h:bool) t`,`[F;F;F;F]`; `z:num`,`1`],`h ==> z = 2`);; val it : term = `let CONS h t = [F; F; F; F] and z = 1 in h ==> z = 2` } \SEEALSO mk_let, is_let. \ENDDOC hol-light/Help/mk_list.doc000066400000000000000000000013271303454263000157710ustar00rootroot00000000000000\DOC mk_list \TYPE {mk_list : term list * hol_type -> term} \SYNOPSIS Constructs object-level list from list of terms. \DESCRIBE {mk_list([`t1`;...;`tn`],`:ty`)} returns {`[t1;...;tn]:(ty)list`}. The type argument is required so that empty lists can be constructed. If you know the list is nonempty, you can just use {mk_flist} where this is not required. \FAILURE Fails with if any term in the list is not of the type specified as the second argument. \EXAMPLE { # mk_list([`1`; `2`],`:num`);; val it : term = `[1; 2]` # mk_list([],`:num`);; val it : term = `[]` # type_of it;; val it : hol_type = `:(num)list` } \SEEALSO dest_cons, dest_list, is_cons, is_list, mk_cons, mk_flist. \ENDDOC hol-light/Help/mk_mconst.doc000066400000000000000000000016531303454263000163230ustar00rootroot00000000000000\DOC mk_mconst \TYPE {mk_mconst : string * hol_type -> term} \SYNOPSIS Constructs a constant with type matching. \DESCRIBE {mk_mconst("const",`:ty`)} returns the constant {`const:ty`}. \FAILURE Fails with {mk_mconst: ...} if the string supplied is not the name of a known constant, or if it is known but the type supplied is not the correct type for the constant. \EXAMPLE { # mk_mconst ("T",`:bool`);; val it : term = `T` # mk_mconst ("T",`:num`);; Exception: Failure "mk_const: generic type cannot be instantiated". } \COMMENTS The primitive HOL Light facility for making constants is {mk_const}, which takes a type instantiation to apply to the constant's generic type. The function {mk_mconst} requires type matching and so is in general somewhat less efficient. However it is sometimes more convenient, and a natural inverse for {dest_const}. \SEEALSO mk_const, dest_const, is_const, mk_var, mk_comb, mk_abs. \ENDDOC hol-light/Help/mk_neg.doc000066400000000000000000000005141303454263000155640ustar00rootroot00000000000000\DOC mk_neg \TYPE {mk_neg : term -> term} \SYNOPSIS Constructs a logical negation. \DESCRIBE {mk_neg `t`} returns {`~t`}. \FAILURE Fails with {mk_neg} unless {t} is of type {bool}. \EXAMPLE { # mk_neg `p /\ q`;; val it : term = `~(p /\ q)` # mk_neg `~p`;; val it : term = `~ ~p` } \SEEALSO dest_neg, is_neg. \ENDDOC hol-light/Help/mk_numeral.doc000066400000000000000000000014101303454263000164520ustar00rootroot00000000000000\DOC mk_numeral \TYPE {mk_numeral : num -> term} \SYNOPSIS Maps a nonnegative integer to corresponding numeral term. \DESCRIBE The call {mk_numeral n} where {n} is a nonnegative integer of type {num} (this is OCaml's type of unlimited-precision numbers) returns the HOL numeral representation of {n}. \FAILURE Fails if the argument is negative or not integral (type {num} can include rationals). \EXAMPLE { # mk_numeral (Int 10);; val it : term = `10` # mk_numeral(pow2 64);; val it : term = `18446744073709551616` } \COMMENTS The similar function {mk_small_numeral} works from a regular machine integer, Ocaml type {int}. If that suffices, it may be simpler. \SEEALSO dest_numeral, dest_small_numeral, is_numeral, mk_small_numeral, term_of_rat. \ENDDOC hol-light/Help/mk_pair.doc000066400000000000000000000004621303454263000157500ustar00rootroot00000000000000\DOC mk_pair \TYPE {mk_pair : term * term -> term} \SYNOPSIS Constructs object-level pair from a pair of terms. \DESCRIBE {mk_pair(`t1`,`t2`)} returns {`(t1,t2)`}. \FAILURE Never fails. \EXAMPLE { # mk_pair(`x:real`,`T`);; val it : term = `x,T` } \SEEALSO dest_pair, is_pair, mk_cons. \ENDDOC hol-light/Help/mk_primed_var.doc000066400000000000000000000017011303454263000171420ustar00rootroot00000000000000\DOC mk_primed_var \TYPE {mk_primed_var : term list -> term -> term} \SYNOPSIS Rename variable to avoid specified names and constant names. \DESCRIBE The call {mk_primed_var avoid v} will return a renamed variant of {v}, by adding primes, so that its name is not the same as any of the variables in the list {avoid}, nor the same as any constant name. It is a more conservative version of the renaming function {variant}. \FAILURE Fails if one of the items in the list {avoids} is not a variable, or if {v} itself is not. \EXAMPLE This shows how the effect is more conservative than {variant} because it even avoids variables of the same name and different type: { # variant [`x:bool`] `x:num`;; val it : term = `x` # mk_primed_var [`x:bool`] `x:num`;; val it : term = `x'` } \noindent and this shows how it also avoids constant names: { # mk_primed_var [] (mk_var("T",`:num`));; val it : term = `T'` } \SEEALSO variant, variants. \ENDDOC hol-light/Help/mk_prover.doc000066400000000000000000000034021303454263000163270ustar00rootroot00000000000000\DOC mk_prover \TYPE {mk_prover : ('a -> conv) -> ('a -> thm list -> 'a) -> 'a -> prover} \SYNOPSIS Construct a prover from applicator and state augmentation function. \DESCRIBE The HOL Light simplifier (e.g. as invoked by {SIMP_TAC}) allows provers of type {prover} to be installed into simpsets, to automatically dispose of side-conditions. These may maintain a state dynamically and augment it as more theorems become available (e.g. a theorem {p |- p} becomes available when simplifying the consequent of an implication {`p ==> q`}). In order to allow maximal flexibility in the data structure used to maintain state, provers are set up in an `object-oriented' style, where the context is part of the prover function itself. A call {mk_prover app aug} where {app: 'a -> conv} is an application operation to prove a term using the context of type {'a} and {aug : 'a -> thm list -> 'a} is an augmentation operation to add whatever representation of the theorem list in the state of the prover is chosen, gives a canonical prover of this form. The crucial point is that the type {'a} is invisible in the resulting prover, so different provers can maintain their state in different ways. (In the trivial case, one might just use {thm list} for the state, and appending for the augmentation.) \FAILURE Does not normally fail unless the functions provided are abnormal. \USES This is mostly for experts wishing to customize the simplifier. \COMMENTS I learned of this ingenious trick for maintaining context from Don Syme, who discovered it by reading some code written by Richard Boulton. I was told by Simon Finn that there are similar ideas in the functional language literature for simulating existential types. \SEEALSO apply_prover, augment, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/mk_realintconst.doc000066400000000000000000000013641303454263000175240ustar00rootroot00000000000000\DOC mk_realintconst \TYPE {mk_realintconst : num -> term} \SYNOPSIS Converts an OCaml number to a canonical integer literal of type {:real}. \DESCRIBE The call {mk_realintconst n} where {n} is an OCaml number (type {num}) produces the canonical literal of type {:real} representing the integer {n}. This will be of the form `{&m}' for a numeral {m} (when {n} is nonnegative) or `{-- &m}' for a nonzero numeral {m} (when {n} is negative). \FAILURE Fails if applied to a number that is not an integer (type {num} also includes rational numbers). \EXAMPLE { # mk_realintconst (Int (-101));; val it : term = `-- &101` # type_of it;; val it : hol_type = `:real` } \SEEALSO dest_realintconst, is_realintconst, mk_intconst, rat_of_term. \ENDDOC hol-light/Help/mk_rewrites.doc000066400000000000000000000023341303454263000166610ustar00rootroot00000000000000\DOC mk_rewrites \TYPE {mk_rewrites : bool -> thm -> thm list -> thm list} \SYNOPSIS Turn theorem into list of (conditional) rewrites. \DESCRIBE Given a Boolean flag {b}, a theorem {th} and a list of theorems {thl}, the call {mk_rewrites b th thl} breaks {th} down into a collection of rewrites (for example, splitting conjunctions up into several sub-theorems) and appends them to the front of {thl} (which are normally theorems already processed in this way). Non-equational theorems {|- p} are converted to {|- p <=> T}. If the flag {b} is true, then implicational theorems {|- p ==> s = t} are used as conditional rewrites; otherwise they are converted to {|- (p ==> s = t) <=> T}. This function is applied inside {extend_basic_rewrites} and {set_basic_rewrites}. \FAILURE Never fails. \EXAMPLE { # ADD_CLAUSES;; val it : thm = |- (!n. 0 + n = n) /\ (!m. m + 0 = m) /\ (!m n. SUC m + n = SUC (m + n)) /\ (!m n. m + SUC n = SUC (m + n)) # mk_rewrites false ADD_CLAUSES [];; val it : thm list = [|- 0 + n = n; |- m + 0 = m; |- SUC m + n = SUC (m + n); |- m + SUC n = SUC (m + n)] } \SEEALSO extend_basic_rewrites, GEN_REWRITE_CONV, REWRITE_CONV, set_basic_rewrites, SIMP_CONV. \ENDDOC hol-light/Help/mk_select.doc000066400000000000000000000003761303454263000163000ustar00rootroot00000000000000\DOC mk_select \TYPE {mk_select : term * term -> term} \SYNOPSIS Constructs a choice binding. \DESCRIBE The call {mk_select(`v`,`t`)} returns the choice term {`@v. t`}. \FAILURE Fails if {v} is not a variable. \SEEALSO is_slect, mk_select. \ENDDOC hol-light/Help/mk_setenum.doc000066400000000000000000000015121303454263000164720ustar00rootroot00000000000000\DOC mk_setenum \TYPE {mk_setenum : term list * hol_type -> term} \SYNOPSIS Constructs an explicit set enumeration from a list of elements. \DESCRIBE When applied to a list of terms {[`t1`; ...; `tn`]} and a type {ty}, where each term in the list has type {ty}, the function {mk_setenum} constructs an explicit set enumeration term {`{{t1, ..., tn}}`}. Note that duplicated elements are maintained in the resulting term, though this is logically the same as the set without them. The type is needed so that the empty set can be constructed; if you know that the list is nonempty, you can use {mk_fset} instead. \FAILURE Fails if some term in the list has the wrong type, i.e. not {ty}. \EXAMPLE { # mk_setenum([`1`; `2`; `3`],`:num`);; val it : term = `{{1, 2, 3}}` } \SEEALSO dest_setenum, is_setenum, mk_fset, mk_list. \ENDDOC hol-light/Help/mk_small_numeral.doc000066400000000000000000000012671303454263000176540ustar00rootroot00000000000000\DOC mk_small_numeral \TYPE {mk_small_numeral : int -> term} \SYNOPSIS Maps a nonnegative integer to corresponding numeral term. \DESCRIBE The call {mk_small_numeral n} where {n} is a nonnegative OCaml machine integer returns the HOL numeral representation of {n}. \FAILURE Fails if the argument is negative. \EXAMPLE { # mk_small_numeral 12;; val it : term = `12` } \COMMENTS The similar function {mk_numeral} works from an unlimited precision integer, OCaml type {num}. However, none of HOL's inference rules depend on the behaviour of machine integers, so logical soundness is not an issue. \SEEALSO dest_numeral, dest_small_numeral, is_numeral, mk_numeral, term_of_rat. \ENDDOC hol-light/Help/mk_string.doc000066400000000000000000000007411303454263000163230ustar00rootroot00000000000000\DOC mk_string \TYPE {mk_string : string -> term} \SYNOPSIS Constructs object-level string from OCaml string. \DESCRIBE {mk_string "..."} produces the HOL term of type {string} (which is an abbreviation for {char list}) corresponding to the OCaml string {"..."}. \FAILURE Never fails \EXAMPLE { # mk_string "hello";; val it : term = `"hello"` # type_of it;; val it : hol_type = `:(char)list` } \SEEALSO dest_char, dest_list, dest_string, mk_char, mk_list. \ENDDOC hol-light/Help/mk_thm.doc000066400000000000000000000017261303454263000156110ustar00rootroot00000000000000\DOC mk_thm \TYPE {mk_thm : term list * term -> thm} \SYNOPSIS Creates an arbitrary theorem as an axiom (dangerous!) \DESCRIBE The function {mk_thm} can be used to construct an arbitrary theorem. It is applied to a pair consisting of the desired assumption list (possibly empty) and conclusion. All the terms therein should be of type {bool}. { mk_thm([`a1`;...;`an`],`c`) = ({{a1,...,an}} |- c) } \FAILURE Fails unless all the terms provided for assumptions and conclusion are of type {bool}. \EXAMPLE The following shows how to create a simple contradiction: { #mk_thm([],`F`);; |- F } \COMMENTS Although {mk_thm} can be useful for experimentation or temporarily plugging gaps, its use should be avoided if at all possible in important proofs, because it can be used to create theorems leading to contradictions. You can check whether any axioms have been asserted by {mk_thm} or {new_axiom} by the call {axioms()}. \SEEALSO CHEAT_TAC, mk_fthm, new_axiom. \ENDDOC hol-light/Help/mk_type.doc000066400000000000000000000013151303454263000157740ustar00rootroot00000000000000\DOC mk_type \TYPE {mk_type : string * hol_type list -> hol_type} \SYNOPSIS Constructs a type (other than a variable type). \DESCRIBE {mk_type("op",[`:ty1`;...;`:tyn`])} returns {`:(ty1,...,tyn)op`} where {op} is the name of a known {n}-ary type constructor. \FAILURE Fails with {mk_type} if the string is not the name of a known type, or if the type is known but the length of the list of argument types is not equal to the arity of the type constructor. \EXAMPLE { # mk_type ("bool",[]);; val it : hol_type = `:bool` # mk_type ("list",[`:bool`]);; val it : hol_type = `:(bool)list` # mk_type ("fun",[`:num`;`:bool`]);; val it : hol_type = `:num->bool` } \SEEALSO dest_type, mk_vartype. \ENDDOC hol-light/Help/mk_uexists.doc000066400000000000000000000006331303454263000165210ustar00rootroot00000000000000\DOC mk_uexists \TYPE {mk_uexists : term * term -> term} \SYNOPSIS Term constructor for unique existence. \DESCRIBE {mk_uexists(`v`,`t`)} returns {`?!v. t`}. \FAILURE Fails with if first term is not a variable or if {t} is not of type {`:bool`}. \EXAMPLE { # mk_uexists(`n:num`,`prime(n) /\ EVEN(n)`);; val it : term = `?!n. prime n /\ EVEN n` } \SEEALSO dest_uexists, is_uexists, mk_exists. \ENDDOC hol-light/Help/mk_var.doc000066400000000000000000000007301303454263000156030ustar00rootroot00000000000000\DOC mk_var \TYPE {mk_var : string * hol_type -> term} \SYNOPSIS Constructs a variable of given name and type. \DESCRIBE {mk_var("var",`:ty`)} returns the variable {`var:ty`}. \FAILURE Never fails. \COMMENTS {mk_var} can be used to construct variables with names which are not acceptable to the term parser. In particular, a variable with the name of a known constant can be constructed using {mk_var}. \SEEALSO dest_var, is_var, mk_const, mk_comb, mk_abs. \ENDDOC hol-light/Help/mk_vartype.doc000066400000000000000000000013421303454263000165050ustar00rootroot00000000000000\DOC mk_vartype \TYPE {mk_vartype : string -> hol_type} \SYNOPSIS Constructs a type variable of the given name. \DESCRIBE {mk_vartype "A"} returns a type variable {`:A`}. \FAILURE Never fails. \EXAMPLE { # mk_vartype "Test";; val it : hol_type = `:Test` # mk_vartype "bool";; val it : hol_type = `:bool` } Note that the second type is {{\em not}} the inbuilt type of Booleans, even though it prints like it. \COMMENTS {mk_vartype} can be used to create type variables with names which will not parse, i.e. they cannot be entered by quotation. Using such type variables is probably bad practice. HOL Light convention is to start type variables with an uppercase letter. \SEEALSO dest_vartype, is_vartype, mk_type. \ENDDOC hol-light/Help/monotonicity_theorems.doc000066400000000000000000000035131303454263000207670ustar00rootroot00000000000000\DOC monotonicity_theorems \TYPE {monotonicity_theorems : thm list ref} \SYNOPSIS List of monotonicity theorems for inductive definitions package. \DESCRIBE The various tools for making inductive definitions, such as {new_inductive_definition}, need to prove certain `monotonicity' side-conditions. They attempt to do so automatically by using various pre-proved theorems asserting the monotonicity of certain operators. Normally, all this happens smoothly without user intervention, but if the inductive definition involves new operators, you may need to augment this list with corresponding monotonicity theorems. \FAILURE Not applicable. \EXAMPLE Suppose we define a `lexical order' construct: { # let LEX = define `(LEX(<<) [] l <=> F) /\ (LEX(<<) l [] <=> F) /\ (LEX(<<) (CONS h1 t1) (CONS h2 t2) <=> if h1 << h2 then LENGTH t1 = LENGTH t2 else (h1 = h2) /\ LEX(<<) t1 t2)`;; } If we want to make an inductive definition that uses this --- for example a lexicographic path order on a representation of first-order terms --- we need to add a theorem asserting that this operation is monotonic. To prove it, we first establish a lemma: { # let LEX_LENGTH = prove (`!l1 l2 R. LEX(R) l1 l2 ==> (LENGTH l1 = LENGTH l2)`, REPEAT(LIST_INDUCT_TAC THEN SIMP_TAC[LEX]) THEN ASM_MESON_TAC[LENGTH]);; } \noindent and hence derive monotonicity: { # let MONO_LEX = prove (`(!x:A y:A. R x y ==> S x y) ==> LEX R x y ==> LEX S x y`, DISCH_TAC THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`x:A list`; `y:A list`] THEN REPEAT(LIST_INDUCT_TAC THEN REWRITE_TAC[LEX]) THEN ASM_MESON_TAC[LEX_LENGTH]);; } \noindent We can now make the inductive definitions package aware of it by: { # monotonicity_theorems := MONO_LEX::(!monotonicity_theorems);; } \SEEALSO new_inductive_definition. \ENDDOC hol-light/Help/name.doc000066400000000000000000000003721303454263000152460ustar00rootroot00000000000000\DOC name \TYPE {name : string -> term} \SYNOPSIS Query to {search} for a theorem whose name contains a string. \DESCRIBE The function {name} is intended for use solely with the {search} function. \FAILURE Never fails. \SEEALSO search. \ENDDOC hol-light/Help/name_of.doc000066400000000000000000000010511303454263000157250ustar00rootroot00000000000000\DOC name_of \TYPE {name_of : term -> string} \SYNOPSIS Gets the name of a constant or variable. \DESCRIBE When applied to a term that is either a constant or a variable, {name_of} returns its name (its true name, even if there is an interface mapping for it in effect). When applied to any other term, it returns the empty string. \FAILURE Never fails. \EXAMPLE { # name_of `x:int`;; val it : string = "x" # name_of `SUC`;; val it : string = "SUC" # name_of `x + 1`;; val it : string = "" } \SEEALSO dest_const, dest_var. \ENDDOC hol-light/Help/needs.doc000066400000000000000000000017141303454263000154250ustar00rootroot00000000000000\DOC needs \TYPE {needs : string -> unit} \SYNOPSIS Load a file if not already loaded. \DESCRIBE The given file is loaded from the path as for {loadt}, unless it has already been loaded into the current session (by {loads}, {loadt} or {needs}) and has apparently (based on an MD5 checksum) not changed since then. \FAILURE Fails if the file is not found or generates a failure on loading. \EXAMPLE If a proof relies on more number theory, you might start it with { needs "Library/prime.ml";; needs "Library/pocklington.ml";; } If necessary, these files will be loaded as for {loadt}. However, if they have already been loaded (e.g. if the current proof is a component of a larger proof that has already used them), they will not be reloaded. \USES The {needs} function gives a simple form of dependency management. It is good practice to start every file with a {needs} declaration for any library that it depends on. \SEEALSO load_path, loads, loadt. \ENDDOC hol-light/Help/net_of_cong.doc000066400000000000000000000014261303454263000166070ustar00rootroot00000000000000\DOC net_of_cong \TYPE {net_of_cong : thm -> (int * (term -> thm)) net -> (int * (term -> thm)) net} \SYNOPSIS Add a congruence rule to a net. \DESCRIBE The underlying machinery in rewriting and simplification assembles (conditional) rewrite rules and other conversions into a net, including a priority number so that, for example, pure rewrites get applied before conditional rewrites. The congruence rules used by the simplifier to establish context (see {extend_basic_congs}) are also stored in this structure, with the lowest priority 4. A call {net_of_cong th net} adds {th} as a new congruence rule to {net} to yield an updated net. \FAILURE Fails unless the congruence is of the appropriate implicational form. \SEEALSO extend_basic_congs, net_of_conv, net_of_thm. \ENDDOC hol-light/Help/net_of_conv.doc000066400000000000000000000015161303454263000166260ustar00rootroot00000000000000\DOC net_of_conv \TYPE {net_of_conv : term -> 'a -> (int * 'a) net -> (int * 'a) net} \SYNOPSIS The underlying machinery in rewriting and simplification assembles (conditional) rewrite rules and other conversions into a net, including a priority number so that, for example, pure rewrites get applied before conditional rewrites. A call {net_of_conv `pat` cnv net} will add {cnv} to {net} with priority 2 (lower than pure rewrites but higher than conditional ones) to give a new net; this net can be used by {REWRITES_CONV}, for example. The term {pat} is a pattern used inside the net to place {conv} appropriately (see {enter} for more details). This means that {cnv} will never even be tried on terms that clearly cannot be instances of {pat}. \FAILURE Never fails. \SEEALSO enter, net_of_cong, lookup, net_of_thm, REWRITES_CONV. \ENDDOC hol-light/Help/net_of_thm.doc000066400000000000000000000023031303454263000164440ustar00rootroot00000000000000\DOC net_of_thm \TYPE {net_of_thm : bool -> thm -> (int * (term -> thm)) net -> (int * (term -> thm)) net} \SYNOPSIS Insert a theorem into a net as a (conditional) rewrite. \DESCRIBE The underlying machinery in rewriting and simplification assembles (conditional) rewrite rules and other conversions into a net, including a priority number so that, for example, pure rewrites get applied before conditional rewrites. Such a net can then be used by {REWRITES_CONV}. A call {net_of_thm rf th net} where {th} is a pure or conditional equation (as constructed by {mk_rewrites}, for example) will insert that rewrite rule into the net with priority 1 (the highest) for a pure rewrite or 3 for a conditional rewrite, to yield an updated net. If {rf} is {true}, it indicates that this net will be used for repeated rewriting (e.g. as in {REWRITE_CONV} rather than {ONCE_REWRITE_CONV}), and therefore equations are simply discarded without changing the net if the LHS occurs free in the RHS. This does not exclude more complicated looping situations, but is still useful. \FAILURE Fails on a theorem that is neither a pure nor conditional equation. \SEEALSO mk_rewrites, net_of_cong, net_of_conv, REWRITES_CONV. \ENDDOC hol-light/Help/new_axiom.doc000066400000000000000000000023101303454263000163060ustar00rootroot00000000000000\DOC new_axiom \TYPE {new_axiom : term -> thm} \SYNOPSIS Sets up a new axiom. \DESCRIBE If {tm} is a term of type {bool}, a call {new_axiom tm} creates a theorem { |- tm } \FAILURE Fails if the given term does not have type {bool}. \EXAMPLE { # let ax = new_axiom `x = 1`;; val ax : thm = |- x = 1 } Note that as with all theorems, variables are implicitly universally quantified, so this axiom asserts that all numbers are equal to 1. Of course, we can then derive a contradiction: { CONV_RULE NUM_REDUCE_CONV (INST [`0`,`x:num`] ax);; val it : thm = |- F } Normal use of HOL Light should avoid asserting axioms. They can lead to inconsistency, albeit not in such an obvious way. Provided theories are extended by definitions, consistency is preserved. \COMMENTS For most purposes, it is unnecessary to declare new axioms: all of classical mathematics can be derived by definitional extension alone. Proceeding by definition is not only more elegant, but also guarantees the consistency of the deductions made. However, there are certain entities which cannot be modelled in simple type theory without further axioms, such as higher transfinite ordinals. \SEEALSO axioms, mk_thm, new_definition. \ENDDOC hol-light/Help/new_basic_definition.doc000066400000000000000000000032351303454263000204710ustar00rootroot00000000000000\DOC new_basic_definition \TYPE {new_basic_definition : term -> thm} \SYNOPSIS Makes a simple new definition of the form {c = t}. \DESCRIBE If {t} is a closed term and {c} a variable whose name has not been used as a constant, then {new_basic_definition `c = t`} will define a new constant {c} and return the theorem {|- c = t} for that new constant (not the variable in the given term). There is an additional restriction that all type variables involved in {t} must occur in the constant's type. \FAILURE Fails if {c} is already a constant. \EXAMPLE Here is a simple example { # let googolplex = new_basic_definition `googolplex = 10 EXP (10 EXP 100)`;; val googolplex : thm = |- googolplex = 10 EXP (10 EXP 100) } \noindent and of course we can equally well use logical equivalence: { # let true_def = new_basic_definition `true <=> T`;; val true_def : thm = |- true <=> T } \noindent The following example helps to explain why the restriction on type variables is present: { # new_basic_definition `trivial <=> !x y:A. x = y`;; Exception: Failure "new_definition: Type variables not reflected in constant". } If we had been allowed to get back a definitional theorem, we could separately type-instantiate it to the 1-element type {1} and the 2-element type {bool}. In one case the RHS is true, and in the other it is false, yet both are asserted equal to the constant {trivial}. \COMMENTS There are simpler or more convenient ways of making definitions, such as {define} and {new_definition}, but this is the primitive principle underlying them all. \SEEALSO define, new_definition, new_inductive_definition, new_recursive_definition, new_specification. \ENDDOC hol-light/Help/new_basic_type_definition.doc000066400000000000000000000040441303454263000215310ustar00rootroot00000000000000\DOC new_basic_type_definition \TYPE {new_basic_type_definition : string -> string * string -> thm -> thm * thm} \SYNOPSIS Introduces a new type in bijection with a nonempty subset of an existing type. \DESCRIBE The call {new_basic_type_definition "ty" ("mk","dest") th} where {th} is a theorem of the form {|- P x} (say {x} has type {rep}) will introduce a new type called {ty} plus two new constants {mk:rep->ty} and {dest:ty->rep}, and return two theorems that together assert that {mk} and {dest} establish a bijection between the universe of the new type {ty} and the subset of the type {rep} identified by the predicate {P}: {|- mk(dest a) = a} and {|- P r <=> dest(mk r) = r}. If the theorem involves type variables {A1,...,An} then the new type will be an $n$-ary type constructor rather than a basic type. The theorem is needed to ensure that that set is nonempty; all types in HOL are nonempty. \FAILURE Fails if any of the type or constant names is already in use, if the theorem has a nonempty list of hypotheses, if the conclusion of the theorem is not a combination, or if its rator {P} contains free variables. \EXAMPLE Here we define a basic type with 32 elements: { # let th = ARITH_RULE `(\x. x < 32) 0`;; val th : thm = |- (\x. x < 32) 0 # let absth,repth = new_basic_type_definition "32" ("mk_32","dest_32") th;; val absth : thm = |- mk_32 (dest_32 a) = a val repth : thm = |- (\x. x < 32) r <=> dest_32 (mk_32 r) = r } \noindent and here is a declaration of a type of finite sets over a base type, a unary type constructor: { # let th = CONJUNCT1 FINITE_RULES;; val th : thm = |- FINITE {{}} # let tybij = new_basic_type_definition "fin" ("mk_fin","dest_fin") th;; val tybij : thm * thm = (|- mk_fin (dest_fin a) = a, |- FINITE r <=> dest_fin (mk_fin r) = r) } \noindent so now types like {:(num)fin} make sense. \COMMENTS This is the primitive principle of type definition in HOL Light, but other functions like {define_type} or {new_type_definition} are usually more convenient. \SEEALSO define_type, new_type_definition. \ENDDOC hol-light/Help/new_constant.doc000066400000000000000000000011211303454263000170210ustar00rootroot00000000000000\DOC new_constant \TYPE {new_constant : string * hol_type -> unit} \SYNOPSIS Declares a new constant. \DESCRIBE A call {new_constant("c",`:ty`)} makes {c} a constant with most general type {ty}. \FAILURE Fails if there is already a constant of that name in the current theory. \EXAMPLE { #new_constant("graham's_number",`:num`);; val it : unit = () } \USES Can be useful for declaring some arbitrary parameter, but more usually a prelude to some new axioms about the constant introduced. Take care when using {new_axiom}! \SEEALSO constants, new_axiom, new_definition. \ENDDOC hol-light/Help/new_definition.doc000066400000000000000000000031721303454263000173300ustar00rootroot00000000000000\DOC new_definition \TYPE {new_definition : term -> thm} \SYNOPSIS Declare a new constant and a definitional axiom. \DESCRIBE The function {new_definition} provides a facility for definitional extensions. It takes a term giving the desired definition. The value returned by {new_definition} is a theorem stating the definition requested by the user. Let {v_1},...,{v_n} be tuples of distinct variables, containing the variables {x_1,...,x_m}. Evaluating {new_definition `c v_1 ... v_n = t`}, where {c} is a variable whose name is not already used as a constant, declares {c} to be a new constant and returns the theorem: { |- !x_1 ... x_m. c v_1 ... v_n = t } Optionally, the definitional term argument may have any of its variables universally quantified. \FAILURE {new_definition} fails if {c} is already a constant or if the definition does not have the right form. \EXAMPLE A NAND relation on signals indexed by `time' can be defined as follows. { # new_definition `NAND2 (in_1,in_2) out <=> !t:num. out t <=> ~(in_1 t /\ in_2 t)`;; val it : thm = |- !out in_1 in_2. NAND2 (in_1,in_2) out <=> (!t. out t <=> ~(in_1 t /\ in_2 t)) } \COMMENTS Note that the conclusion of the theorem returned is essentially the same as the term input by the user, except that {c} was a variable in the original term but is a constant in the returned theorem. The function {define} is significantly more flexible in the kinds of definition it allows, but for some purposes this more basic principle is fine. \SEEALSO define, new_basic_definition, new_inductive_definition, new_recursive_definition, new_specification. \ENDDOC hol-light/Help/new_inductive_definition.doc000066400000000000000000000117001303454263000213760ustar00rootroot00000000000000\DOC new_inductive_definition \TYPE {new_inductive_definition : term -> thm * thm * thm} \SYNOPSIS Define a relation or family of relations inductively. \DESCRIBE The function {new_inductive_definition} is applied to a conjunction of ``rules'' of the form {!x1...xn. Pi ==> Ri t1 ... tk}. This conjunction is interpreted as an inductive definition of a set of relations {Ri} (however many appear in the consequents of the rules). That is, the relations are defined to be the smallest ones closed under the rules. The function {new_inductive_definition} will convert this into explicit definitions, define a new constant for each {Ri}, and return a triple of theorems. The first one will be the ``rule'' theorem, which essentially matches the input clauses except that the {Ri} are now the new constants; this simply says that the new relations are indeed closed under the rules. The second theorem is an induction theorem, asserting that the relations are the least ones closed under the rules. Finally, the cases theorem gives a case analysis theorem showing how each set of values satisfying the relation may be composed. \FAILURE Fails if the clauses are malformed, if the constants are already in use, or if there are unproven monotonicity hypotheses. In the last case, you can try {prove_inductive_relations_exist} to examine these hypotheses, and either try to prove them manually or extend {monotonicity_theorems} to let HOL do it. \EXAMPLE A classic example where we have mutual induction is the set of even and odd numbers: { # let eo_RULES,eo_INDUCT, eo_CASES = new_inductive_definition `even(0) /\ odd(1) /\ (!n. even(n) ==> odd(n + 1)) /\ (!n. odd(n) ==> even(n + 1))`;; val eo_RULES : thm = |- even 0 /\ odd 1 /\ (!n. even n ==> odd (n + 1)) /\ (!n. odd n ==> even (n + 1)) val eo_INDUCT : thm = |- !odd' even'. even' 0 /\ odd' 1 /\ (!n. even' n ==> odd' (n + 1)) /\ (!n. odd' n ==> even' (n + 1)) ==> (!a0. odd a0 ==> odd' a0) /\ (!a1. even a1 ==> even' a1) val eo_CASES : thm = |- (!a0. odd a0 <=> a0 = 1 \/ (?n. a0 = n + 1 /\ even n)) /\ (!a1. even a1 <=> a1 = 0 \/ (?n. a1 = n + 1 /\ odd n)) } Note that the `rules' theorem corresponds exactly to the input, and says that indeed the relations do satisfy the rules. The `induction' theorem says that the relations are the minimal ones satisfying the rules. You can use this to prove properties by induction, e.g. the relationship with the pre-defined concepts of odd and even: { # g `(!n. odd(n) ==> ODD(n)) /\ (!n. even(n) ==> EVEN(n))`;; } \noindent applying the induction theorem: { # e(MATCH_MP_TAC eo_INDUCT);; val it : goalstack = 1 subgoal (1 total) `EVEN 0 /\ ODD 1 /\ (!n. EVEN n ==> ODD (n + 1)) /\ (!n. ODD n ==> EVEN (n + 1))` } \noindent This is easily finished off by, for example: { # e(REWRITE_TAC[GSYM NOT_EVEN; EVEN_ADD; ARITH]);; val it : goalstack = No subgoals } For another example, consider defining a simple propositional logic: { # parse_as_infix("-->",(13,"right"));; val it : unit = () # let form_tybij = define_type "form = False | --> form form";; val form_tybij : thm * thm = (|- !P. P False /\ (!a0 a1. P a0 /\ P a1 ==> P (a0 --> a1)) ==> (!x. P x), |- !f0 f1. ?fn. fn False = f0 /\ (!a0 a1. fn (a0 --> a1) = f1 a0 a1 (fn a0) (fn a1))) } \noindent and making an inductive definition of the provability relation: { # parse_as_infix("|--",(11,"right"));; val it : unit = () # let provable_RULES,provable_INDUCT,provable_CASES = new_inductive_definition `(!p. p IN A ==> A |-- p) /\ (!p q. A |-- p --> (q --> p)) /\ (!p q r. A |-- (p --> q --> r) --> (p --> q) --> (p --> r)) /\ (!p. A |-- ((p --> False) --> False) --> p) /\ (!p q. A |-- p --> q /\ A |-- p ==> A |-- q)`;; val provable_RULES : thm = |- !A. (!p. p IN A ==> A |-- p) /\ (!p q. A |-- p --> q --> p) /\ (!p q r. A |-- (p --> q --> r) --> (p --> q) --> p --> r) /\ (!p. A |-- ((p --> False) --> False) --> p) /\ (!p q. A |-- p --> q /\ A |-- p ==> A |-- q) val provable_INDUCT : thm = |- !A |--'. (!p. p IN A ==> |--' p) /\ (!p q. |--' (p --> q --> p)) /\ (!p q r. |--' ((p --> q --> r) --> (p --> q) --> p --> r)) /\ (!p. |--' (((p --> False) --> False) --> p)) /\ (!p q. |--' (p --> q) /\ |--' p ==> |--' q) ==> (!a. A |-- a ==> |--' a) val provable_CASES : thm = |- !A a. A |-- a <=> a IN A \/ (?p q. a = p --> q --> p) \/ (?p q r. a = (p --> q --> r) --> (p --> q) --> p --> r) \/ (?p. a = ((p --> False) --> False) --> p) \/ (?p. A |-- p --> a /\ A |-- p) } Note that {A} is not universally quantified in the clauses, and is therefore treated as a parameter. \SEEALSO derive_strong_induction, new_inductive_set, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC hol-light/Help/new_inductive_set.doc000066400000000000000000000066071303454263000200530ustar00rootroot00000000000000\DOC new_inductive_set \TYPE {new_inductive_set : term -> thm * thm * thm} \SYNOPSIS Define a set or family of sets inductively. \DESCRIBE The function {new_inductive_set} is applied to a conjunction of ``rules'', each of the form {!x1...xn. Pi ==> ti IN Sk}. This conjunction is interpreted as an inductive definition of a family of sets {Sk} (however many appear in the consequents of the rules). That is, the sets are defined to be the smallest ones closed under the rules. The function {new_inductive_set} will convert this into explicit definitions, define a new constant for each {Sk}, and return a triple of theorems. The first one will be the ``rule'' theorem, which essentially matches the input clauses except that the {Si} are now the new constants; this simply says that the new sets are indeed closed under the rules. The second theorem is an induction theorem, asserting that the sets are the least ones closed under the rules. Finally, the cases theorem gives a case analysis theorem showing how each set of values satisfying the set may be composed. \FAILURE Fails if the clauses are malformed, if the constants are already in use, or if there are unproven monotonicity hypotheses. See {new_inductive_definition} for more detailed discussion in the similar case of indunctive relations. \EXAMPLE A classic example where we have mutual induction is the set of even and odd numbers: { # let EO_RULES, EO_INDUCT, EO_CASES = new_inductive_set `0 IN even_numbers /\ (!n. n IN even_numbers ==> SUC n IN odd_numbers) /\ 1 IN odd_numbers /\ (!n. n IN odd_numbers ==> SUC n IN even_numbers)`;; val EO_RULES : thm = |- 0 IN even_numbers /\ (!n. n IN even_numbers ==> SUC n IN odd_numbers) /\ 1 IN odd_numbers /\ (!n. n IN odd_numbers ==> SUC n IN even_numbers) val EO_INDUCT : thm = |- !odd_numbers' even_numbers'. even_numbers' 0 /\ (!n. even_numbers' n ==> odd_numbers' (SUC n)) /\ odd_numbers' 1 /\ (!n. odd_numbers' n ==> even_numbers' (SUC n)) ==> (!a0. a0 IN odd_numbers ==> odd_numbers' a0) /\ (!a1. a1 IN even_numbers ==> even_numbers' a1) val EO_CASES : thm = |- (!a0. a0 IN odd_numbers <=> (?n. a0 = SUC n /\ n IN even_numbers) \/ a0 = 1) /\ (!a1. a1 IN even_numbers <=> a1 = 0 \/ (?n. a1 = SUC n /\ n IN odd_numbers)) } Note that the `rules' theorem corresponds exactly to the input, and says that indeed the sets do satisfy the rules. The `induction' theorem says that the sets are the minimal ones satisfying the rules. You can use this to prove properties by induction, e.g. the relationship with the pre-defined concepts of odd and even: { # g `(!n. n IN odd_numbers ==> ODD(n)) /\ (!n. n IN even_numbers ==> EVEN(n))`;; } \noindent applying the induction theorem: { # e(MATCH_MP_TAC EO_INDUCT);; val it : goalstack = 1 subgoal (1 total) `EVEN 0 /\ (!n. EVEN n ==> ODD (SUC n)) /\ ODD 1 /\ (!n. ODD n ==> EVEN (SUC n))` } \noindent This is easily finished off by, for example: { # e(REWRITE_TAC[GSYM NOT_EVEN; EVEN; ARITH]);; val it : goalstack = No subgoals } This function uses {new_inductive_relation} internally, and the documentation for that function gives additional information and other relevant examples. \SEEALSO derive_strong_induction, new_inductive_definition, prove_inductive_relations_exist, prove_monotonicity_hyps. \ENDDOC hol-light/Help/new_recursive_definition.doc000066400000000000000000000062021303454263000214140ustar00rootroot00000000000000\DOC new_recursive_definition \TYPE {new_recursive_definition : thm -> term -> thm} \SYNOPSIS Define recursive function over inductive type. \DESCRIBE {new_recursive_definition} provides the facility for defining primitive recursive functions on arbitrary inductive types. The first argument is the primitive recursion theorem for the concrete type in question; this is normally the second theorem obtained from {define_type}. The second argument is a term giving the desired primitive recursive function definition. The value returned by {new_recursive_definition} is a theorem stating the primitive recursive definition requested by the user. This theorem is derived by formal proof from an instance of the general primitive recursion theorem given as the second argument. Let {C1}, ..., {Cn} be the constructors of the type, and let `{(Ci vs)}' represent a (curried) application of the {i}th constructor to a sequence of variables. Then a curried primitive recursive function {fn} over {ty} can be specified by a conjunction of (optionally universally-quantified) clauses of the form: { fn v1 ... (C1 vs1) ... vm = body1 /\ fn v1 ... (C2 vs2) ... vm = body2 /\ . . fn v1 ... (Cn vsn) ... vm = bodyn } \noindent where the variables {v1}, ..., {vm}, {vs} are distinct in each clause, and where in the {i}th clause {fn} appears (free) in {bodyi} only as part of an application of the form: { `fn t1 ... v ... tm` } \noindent in which the variable {v} of type {ty} also occurs among the variables {vsi}. If {} is a conjunction of clauses, as described above, then evaluating: { new_recursive_definition th ``;; } \noindent automatically proves the existence of a function {fn} that satisfies the defining equations, and then declares a new constant with this definition as its specification. {new_recursive_definition} also allows the supplied definition to omit clauses for any number of constructors. If a defining equation for the {i}th constructor is omitted, then the value of {fn} at that constructor: { fn v1 ... (Ci vsi) ... vn } \noindent is left unspecified ({fn}, however, is still a total function). \FAILURE Fails if the definition cannot be matched up with the recursion theorem provided (you may find that {define} still works in such cases), or if there is already a constant of the given name. \EXAMPLE The following defines a function to produce the union of a list of sets: { # let LIST_UNION = new_recursive_definition list_RECURSION `(LIST_UNION [] = {{}}) /\ (LIST_UNION (CONS h t) = h UNION (LIST_UNION t))`;; Warning: inventing type variables val ( LIST_UNION ) : thm = |- LIST_UNION [] = {{}} /\ LIST_UNION (CONS h t) = h UNION LIST_UNION t } \COMMENTS For many purposes, {define} is a simpler way of defining recursive types; it has a simpler interface (no need to specify the recursion theorem to use) and it is more general. However, for suitably constrained definitions {new_recursive_definition} works well and is much more efficient. \SEEALSO define, prove_inductive_relations_exist, prove_recursive_functions_exist. \ENDDOC hol-light/Help/new_specification.doc000066400000000000000000000032011303454263000200110ustar00rootroot00000000000000\DOC new_specification \TYPE {new_specification : string list -> thm -> thm} \SYNOPSIS Introduces a constant or constants satisfying a given property. \DESCRIBE The ML function {new_specification} implements the primitive rule of constant specification for the HOL logic. Evaluating: { new_specification ["c1";...;"cn"] |- ?x1...xn. t } \noindent simultaneously introduces new constants named {c1}, ..., {cn} satisfying the property: { |- t[c1,...,cn/x1,...,xn] } \noindent This theorem is returned by the call to {new_specification}. \FAILURE {new_specification} fails if any one of {`c1`}, ..., {`cn`} is already a constant. \USES {new_specification} can be used to introduce constants that satisfy a given property without having to make explicit equational constant definitions for them. For example, the built-in constants {MOD} and {DIV} are defined in the system by first proving the theorem: { # DIVMOD_EXIST_0;; val it : thm = |- !m n. ?q r. if n = 0 then q = 0 /\ r = 0 else m = q * n + r /\ r < n } \noindent Skolemizing it to made the parametrization explicit: { # let th = REWRITE_RULE[SKOLEM_THM] DIVMOD_EXIST_0;; val th : thm = |- ?q r. !m n. if n = 0 then q m n = 0 /\ r m n = 0 else m = q m n * n + r m n /\ r m n < n } \noindent and then making the constant specification: { # new_specification ["DIV"; "MOD"] th;; } \noindent giving the theorem: { # DIVISION_0;; val it : thm = |- !m n. if n = 0 then m DIV n = 0 /\ m MOD n = 0 else m = m DIV n * n + m MOD n /\ m MOD n < n } \SEEALSO define, new_definition. \ENDDOC hol-light/Help/new_type.doc000066400000000000000000000017041303454263000161600ustar00rootroot00000000000000\DOC new_type \TYPE {new_type : string * int -> unit} \SYNOPSIS Declares a new type or type constructor. \DESCRIBE A call {new_type("t",n)} declares a new {n}-ary type constructor called {t}; if {n} is zero, this is just a new base type. \FAILURE Fails if there is already a type operator of that name. \EXAMPLE A version of ZF set theory might declare a new type {set} and start using it as follows: { # new_type("set",0);; val it : unit = () # new_constant("mem",`:set->set->bool`);; val it : unit = () # parse_as_infix("mem",(11,"right"));; val it : unit = () # let ZF_EXT = new_axiom `(!z. z mem x <=> z mem y) ==> (x = y)`;; val ( ZF_EXT ) : thm = |- (!z. z mem x <=> z mem y) ==> x = y } \COMMENTS As usual, asserting new concepts is discouraged; if possible it is better to use type definitions; see {new_type_definition} and {define_type}. \SEEALSO define_type, new_axiom, new_constant, new_definition, new_type_definition. \ENDDOC hol-light/Help/new_type_abbrev.doc000066400000000000000000000016731303454263000175060ustar00rootroot00000000000000\DOC new_type_abbrev \TYPE {new_type_abbrev : string * hol_type -> unit} \SYNOPSIS Sets up a new type abbreviation. \DESCRIBE A call {new_type_abbrev("ab",`:ty`} creates a new type abbreviation {ab} for the type {ty}. In future, {`:ab`} may be used rather than the perhaps complicated expression {`:ty`}. Note that the association is purely an abbreviation for parsing. Type abbreviations have no logical significance; types are internally represented after the abbreviations have been fully expanded. At present, type abbreviations are not reversed when printing types, mainly because this may contract abbreviations where it is unwanted. \FAILURE Never fails. \EXAMPLE { # new_type_abbrev("bitvector",`:bool list`);; val it : unit = () # `LENGTH(x:bitvector)`;; val it : term = `LENGTH x` # type_of (rand it);; val it : hol_type = `:(bool)list` } \SEEALSO define_type, new_type_definition, remove_type_abbrev, type_abbrevs. \ENDDOC hol-light/Help/new_type_definition.doc000066400000000000000000000037341303454263000203750ustar00rootroot00000000000000\DOC new_type_definition \TYPE {new_type_definition : string -> string * string -> thm -> thm} \SYNOPSIS Introduces a new type in bijection with a nonempty subset of an existing type. \DESCRIBE The call {new_basic_type_definition "ty" ("mk","dest") th} where {th} is a theorem of the form {|- ?x. P[x]} (say {x} has type {rep}) will introduce a new type called {ty} plus two new constants {mk:rep->ty} and {dest:ty->rep}, and return a theorem asserting that {mk} and {dest} establish a bijection between the universe of the new type {ty} and the subset of the type {rep} identified by the predicate {P}: { |- (!a. mk(dest a) = a) /\ (!r. P[r] <=> dest(mk r) = r) } \noindent If the theorem involves type variables {A1,...,An} then the new type will be an $n$-ary type constructor rather than a basic type. The theorem is needed to ensure that that set is nonempty; all types in HOL are nonempty. \EXAMPLE Here we define a basic type with 7 elements: { # let th = prove(`?x. x < 7`,EXISTS_TAC `0` THEN ARITH_TAC);; val th : thm = |- ?x. x < 7 # let tybij = new_type_definition "7" ("mk_7","dest_7") th;; val tybij : thm = |- (!a. mk_7 (dest_7 a) = a) /\ (!r. r < 7 <=> dest_7 (mk_7 r) = r) } \noindent and here is a declaration of a type of finite sets over a base type, a unary type constructor: { # let th = MESON[FINITE_RULES] `?s:A->bool. FINITE s`;; 0..0..solved at 2 CPU time (user): 0. val th : thm = |- ?s. FINITE s # let tybij = new_type_definition "finiteset" ("mk_fin","dest_fin") th;; val tybij : thm = |- (!a. mk_fin (dest_fin a) = a) /\ (!r. FINITE r <=> dest_fin (mk_fin r) = r) } \noindent so now types like {:(num)finiteset} make sense. \FAILURE Fails if any of the type or constant names is already in use, if the theorem has a nonempty list of hypotheses, if the conclusion of the theorem is not an existentially quantified term, or the conclusion contains free variables. \SEEALSO define_type, new_basic_type_definition, new_type_abbrev. \ENDDOC hol-light/Help/nothing.doc000066400000000000000000000016511303454263000157750ustar00rootroot00000000000000\DOC nothing \TYPE {nothing : 'a -> 'b list * 'a} \SYNOPSIS Trivial parser that parses nothing. \DESCRIBE The parser {nothing} parses nothing: it returns the empty list as its parsed item and all the input as its unparsed input. \FAILURE Never fails. \USES This can be useful in alternations (`{|||}') with other parsers producing a list of items. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, leftbin, listof, many, possibly, rightbin, some. \ENDDOC hol-light/Help/nsplit.doc000066400000000000000000000011101303454263000156260ustar00rootroot00000000000000\DOC nsplit \TYPE {nsplit : ('a -> 'b * 'a) -> 'c list -> 'a -> 'b list * 'a} \SYNOPSIS Applies a destructor in right-associative mode a specified number of times. \DESCRIBE If {d} is an inverse to a binary constructor {f}, then { nsplit d l (f(x1,f(x2,...f(xn,y)))) } \noindent where the list {l} has length {k}, returns { ([x1;...;xk],f(x(k+1),...f(xn,y)) } \FAILURE Never fails. \EXAMPLE { # nsplit dest_conj [1;2;3] `a /\ b /\ c /\ d /\ e /\ f`;; val it : term list * term = ([`a`; `b`; `c`], `d /\ e /\ f`) } \SEEALSO splitlist, rev_splitlist, striplist. \ENDDOC hol-light/Help/null_inst.doc000066400000000000000000000010321303454263000163270ustar00rootroot00000000000000\DOC null_inst \TYPE {null_inst : instantiation} \SYNOPSIS Empty instantiation. \DESCRIBE Several functions use objects of type {instantiation}, consisting of type and term instantiations and higher-order matching information. This instantiation {null_inst} is the trivial instantiation that does nothing. \FAILURE Not applicable. \EXAMPLE Instantiating a term with it has no effect: { # instantiate null_inst `x + 1 = 2`;; val it : term = `x + 1 = 2` } \SEEALSO instantiate, INSTANTIATE, INSTANTIATE_ALL, term_match. \ENDDOC hol-light/Help/null_meta.doc000066400000000000000000000007461303454263000163130ustar00rootroot00000000000000\DOC null_meta \TYPE {null_meta : term list * instantiation} \SYNOPSIS Empty metavariable information. \DESCRIBE This is a pair consisting of an empty list of terms and a null instantiation (see {null_inst}). It is used inside most tactics to indicate that they do nothing interesting with metavariables. \FAILURE Not applicable. \COMMENTS This is not intended for general use, but readers writing custom tactics from scratch may find it convenient. \SEEALSO null_inst. \ENDDOC hol-light/Help/num_0.doc000066400000000000000000000005721303454263000153460ustar00rootroot00000000000000\DOC num_0 \TYPE {num_0 : num} \SYNOPSIS Constant zero in unlimited-size integers. \DESCRIBE The constant {num_0} is bound to the integer constant 0 in the unlimited-precision numbers provided by the OCaml {Num} library. \FAILURE Not applicable. \USES Exactly the same as {Int 0}, but may save recreation of a cons cell each time. \SEEALSO num_1, num_2, num_10. \ENDDOC hol-light/Help/num_1.doc000066400000000000000000000005701303454263000153450ustar00rootroot00000000000000\DOC num_1 \TYPE {num_1 : num} \SYNOPSIS Constant one in unlimited-size integers. \DESCRIBE The constant {num_1} is bound to the integer constant 1 in the unlimited-precision numbers provided by the OCaml {Num} library. \FAILURE Not applicable. \USES Exactly the same as {Int 1}, but may save recreation of a cons cell each time. \SEEALSO num_0, num_2, num_10. \ENDDOC hol-light/Help/num_10.doc000066400000000000000000000005741303454263000154310ustar00rootroot00000000000000\DOC num_10 \TYPE {num_10 : num} \SYNOPSIS Constant ten in unlimited-size integers. \DESCRIBE The constant {num_10} is bound to the integer constant 10 in the unlimited-precision numbers provided by the OCaml {Num} library. \FAILURE Not applicable. \USES Exactly the same as {Int 10}, but may save recreation of a cons cell each time. \SEEALSO num_0, num_1, num_2. \ENDDOC hol-light/Help/num_2.doc000066400000000000000000000005701303454263000153460ustar00rootroot00000000000000\DOC num_2 \TYPE {num_2 : num} \SYNOPSIS Constant two in unlimited-size integers. \DESCRIBE The constant {num_2} is bound to the integer constant 2 in the unlimited-precision numbers provided by the OCaml {Num} library. \FAILURE Not applicable. \USES Exactly the same as {Int 2}, but may save recreation of a cons cell each time. \SEEALSO num_0, num_1, num_10. \ENDDOC hol-light/Help/num_CONV.doc000066400000000000000000000011721303454263000157510ustar00rootroot00000000000000\DOC num_CONV \TYPE {num_CONV : term -> thm} \SYNOPSIS Provides definitional axiom for a nonzero numeral. \KEYWORDS conversion, number, arithmetic. \DESCRIBE {num_CONV} is an axiom-scheme from which one may obtain a defining equation for any numeral not equal to {0} (i.e. {1}, {2}, {3},...). If {`n`} is such a constant, then {num_CONV `n`} returns the theorem: { |- n = SUC m } \noindent where {m} is the numeral that denotes the predecessor of the number denoted by {n}. \FAILURE {num_CONV tm} fails if {tm} is {`0`} or if not {tm} is not a numeral. \EXAMPLE { # num_CONV `3`;; val it : thm = |- 3 = SUC 2 } \ENDDOC hol-light/Help/num_of_string.doc000066400000000000000000000012171303454263000171760ustar00rootroot00000000000000\DOC num_of_string \TYPE {num_of_string : string -> num} \SYNOPSIS Converts decimal, hex or binary string representation into number. \DESCRIBE The call {num_of_string "n"} converts the string {"n"} into an OCaml unlimited-precision number (type {num}). The string may be simply a sequence of decimal digits (e.g. {"123"}), or a hexadecimal representation starting with {0x} as in C (e.g. {"0xFF"}), or a binary number starting with {0b} (e.g. {"0b101"}). \FAILURE Fails unless the string is a valid representation of one of these forms. \EXAMPLE { # num_of_string "0b11000000";; val it : num = 192 } \SEEALSO dest_numeral, mk_numeral. \ENDDOC hol-light/Help/numdom.doc000066400000000000000000000012421303454263000156220ustar00rootroot00000000000000\DOC numdom \TYPE {numdom : num -> num * num} \SYNOPSIS Returns numerator and denominator of normalized fraction. \DESCRIBE Given a rational number as supported by the {Num} library, {numdom} returns a numerator-denominator pair corresponding to that rational number cancelled down to its reduced form, $p/q$ where $q > 0$ and $p$ and $q$ have no common factor. \FAILURE Never fails. \EXAMPLE { # numdom(Int 22 // Int 7);; val it : num * num = (22, 7) # numdom(Int 0);; val it : num * num = (0, 1) # numdom(Int 100);; val it : num * num = (100, 1) # numdom(Int 4 // Int(-2));; val it : num * num = (-2, 1) } \SEEALSO denominator, numerator. \ENDDOC hol-light/Help/numerator.doc000066400000000000000000000011571303454263000163440ustar00rootroot00000000000000\DOC numerator \TYPE {numerator : num -> num} \SYNOPSIS Returns numerator of rational number in canonical form. \DESCRIBE Given a rational number as supported by the {Num} library, {numerator} returns the numerator $p$ from the rational number cancelled to its reduced form, $p/q$ where $q > 0$ and $p$ and $q$ have no common factor. \FAILURE Never fails. \EXAMPLE { # numerator(Int 22 // Int 7);; val it : num = 22 # numerator(Int 0);; val it : num = 0 # numerator(Int 100);; val it : num = 100 # numerator(Int 4 // Int(-2));; val it : num = -2 } \SEEALSO denominator, numdom. \ENDDOC hol-light/Help/o.doc000066400000000000000000000003071303454263000145620ustar00rootroot00000000000000\DOC o \TYPE {o : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b} \SYNOPSIS Composes two functions: {(f o g) x} = {f (g x)}. \KEYWORDS combinator. \FAILURE Never fails. \SEEALSO C, F_F, I, K, W. \ENDDOC hol-light/Help/occurs_in.doc000066400000000000000000000011661303454263000163140ustar00rootroot00000000000000\DOC occurs_in \TYPE {occurs_in : hol_type -> hol_type -> bool} \SYNOPSIS Tests if one type occurs in another. \DESCRIBE The call {occurs_in ty1 ty2} returns {true} if {ty1} occurs as a subtype of {ty2}, including the case where {ty1} and {ty2} are the same. If returns {false} otherwise. The type {ty1} does not have to be a type variable. \FAILURE Never fails. \EXAMPLE { # occurs_in `:A` `:(A)list->bool`;; val it : bool = true # occurs_in `:num->num` `:num->num->bool`;; val it : bool = false # occurs_in `:num->bool` `:num->num->bool`;; val it : bool = true } \SEEALSO free_in, tyvars, vfree_in. \ENDDOC hol-light/Help/omit.doc000066400000000000000000000003551303454263000152770ustar00rootroot00000000000000\DOC omit \TYPE {omit : term -> term} \SYNOPSIS Omit anything satisfying the given {search} query. \DESCRIBE The function {omit} is intended for use solely with the {search} function. \FAILURE Never fails. \SEEALSO search. \ENDDOC hol-light/Help/orelse_.doc000066400000000000000000000002001303454263000157440ustar00rootroot00000000000000\DOC orelse_ \TYPE {orelse_ : tactic -> tactic -> tactic} \SYNOPSIS Non-infix version of {ORELSE}. \SEEALSO ORELSE. \ENDDOC hol-light/Help/orelse_tcl_.doc000066400000000000000000000002421303454263000166140ustar00rootroot00000000000000\DOC orelse_tcl_ \TYPE {orelse_tcl_ : thm_tactical -> thm_tactical -> thm_tactical} \SYNOPSIS Non-infix version of {ORELSE_TCL}. \SEEALSO ORELSE_TCL. \ENDDOC hol-light/Help/orelsec_.doc000066400000000000000000000001761303454263000161230ustar00rootroot00000000000000\DOC orelsec_ \TYPE {orelsec_ : conv -> conv -> conv} \SYNOPSIS Non-infix version of {ORELSEC}. \SEEALSO ORELSEC. \ENDDOC hol-light/Help/overload_interface.doc000066400000000000000000000040721303454263000201620ustar00rootroot00000000000000\DOC overload_interface \TYPE {overload_interface : string * term -> unit} \SYNOPSIS Overload a symbol so it may denote a particular underlying constant. \DESCRIBE HOL Light allows the same identifier to denote several different underlying constants. A call to {overload_interface("ident",`cname`)}, where {cname} is either a constant to be denoted or a variable with the same name and type (if the constant is not yet defined) will include {cname} as one of the possible overload resolutions of the symbol {ident}. Moreover, when the resolution is not possible from type information, {cname} will now be the default. However, before any calls to {overload_interface}, the constant must have been declared overloadable with {make_overloadable}, and the term {`cname`} must have a type that is an instance of the most general ``type skeleton'' specified there. \FAILURE Fails if the identifier has not been declared overloadable, if the term is not a constant or variable, or it its type is not an instance of the declared type skeleton. \EXAMPLE The symbol `{+}' has an overload skeleton of type {`:A->A->A`}. Here we overload it on type {:bool} to denote logical `or'. (This is just for illustration; it's strongly recommended that you don't do this, since you will typically need to add more type annotations in terms to compensate for the ambiguity.) { # overload_interface("+",`(\/)`);; val it : unit = () } \noindent Now we can use the symbol `{+}' with multiple meanings in the same terms; the underlying constants are still the original ones, though: { # `(x = 1) + (1 + 1 = 2)`;; val it : term = `(x = 1) + (1 + 1 = 2)` } You can also overload polymorphic symbols, e.g. overload `{+}' so that it maps to list append: { # overload_interface("+",`APPEND`);; Warning: inventing type variables val it : unit = () # APPEND;; val it : thm = |- (!l. [] + l = l) /\ (!h t l. CONS h t + l = CONS h (t + l)) } \SEEALSO make_overloadable, override_interface, prioritize_overload, reduce_interface, remove_interface, the_implicit_types, the_interface, the_overload_skeletons. \ENDDOC hol-light/Help/override_interface.doc000066400000000000000000000037551303454263000201750ustar00rootroot00000000000000\DOC override_interface \TYPE {override_interface : string * term -> unit} \SYNOPSIS Map identifier to specific underlying constant. \DESCRIBE A call to {override_interface("name",`cname`)} makes the parser map instances of identifier {name} to whatever constant is called {cname}. Note that the term {`cname`} in the call may either be that constant or a variable of the appropriate type. This contrasts with {overload_interface}, which can make the same identifier map to several underlying constants, depending on type. A call to {override_interface} removes all other overloadings of the identifier, if any. \FAILURE Fails unless the term is a constant or variable. \EXAMPLE You might want to make the exponentiation operation {EXP} on natural numbers parse and print as `{^}'. You can do this with { # override_interface("^",`(EXP)`);; val it : unit = () } Note that the special parse status (infix in this case) is based on the interface identifier, not the underlying constant, so that does not make `{^}' parse as infix: { # EXP;; val it : thm = |- (!m. ^ m 0 = 1) /\ (!m n. ^ m (SUC n) = m * ^ m n) } \noindent but you can do that with a separate {parse_as_infix} call. It is also possible to override polymorphic constants, and all instances will be handled. For example, HOL Light's built-in list operations don't look much like OCaml: { # APPEND;; val it : thm = |- (!l. APPEND [] l = l) /\ (!h t l. APPEND (CONS h t) l = CONS h (APPEND t l)) } \noindent but after a few interface modifications: { # parse_as_infix("::",(25,"right"));; # parse_as_infix("@",(16,"right"));; # override_interface("::",`CONS`);; # override_interface("@",`APPEND`);; } \noindent it looks closer (you can remove the spaces round {::} using {unspaced_binops}): { # APPEND;; val it : thm = |- (!l. [] @ l = l) /\ (!h t l. h :: t @ l = h :: (t @ l)) } \SEEALSO overload_interface, parse_as_infix, reduce_interface, remove_interface, the_implicit_types, the_interface, the_overload_skeletons. \ENDDOC hol-light/Help/p.doc000066400000000000000000000010101303454263000145530ustar00rootroot00000000000000\DOC p \TYPE {p : unit -> goalstack} \SYNOPSIS Prints the top level of the subgoal package goal stack. \DESCRIBE The function {p} is part of the subgoal package, and prints the current goalstate. \FAILURE Never fails. \USES Examining the proof state during an interactive proof session. \COMMENTS Strictly speaking this function is side-effect-free. It simply {{\em returns}} the current goalstate. However, automatic printing will normally then print it, so that is the net effect. \SEEALSO b, e, g, r. \ENDDOC hol-light/Help/parse_as_binder.doc000066400000000000000000000012551303454263000174470ustar00rootroot00000000000000\DOC parse_as_binder \TYPE {parse_as_binder : string -> unit} \SYNOPSIS Makes the quotation parser treat a name as a binder. \DESCRIBE The call {parse_as_binder "c"} will make the quotation parser treat {c} as a binder, that is, allow the syntactic sugaring {`c x. y`} as a shorthand for {`c (\x. y)`}. As with normal binders, e.g. the universal quantifier, the special syntactic status may be suppressed by enclosing {c} in parentheses: {(c)}. \FAILURE Never fails. \EXAMPLE { # parse_as_binder "infinitely_many";; val it : unit = () # `infinitely_many p:num. prime(p)`;; `infinitely_many p. prime(p)`;; } \SEEALSO binders, parses_as_binder, unparse_as_binder. \ENDDOC hol-light/Help/parse_as_infix.doc000066400000000000000000000022341303454263000173170ustar00rootroot00000000000000\DOC parse_as_infix \TYPE {parse_as_infix : string * (int * string) -> unit} \SYNOPSIS Adds identifier to list of infixes, with given precedence and associativity. \DESCRIBE Certain identifiers are treated as infix operators with a given precedence and associativity (left or right). The call {parse_as_infix("op",(p,a))} adds {op} to the infix operators with precedence {p} and associativity {a} (it should be one of the two strings {"left"} or {"right"}). Note that the infix status is based purely on the name, which can be alphanumeric or symbolic, and does not depend on whether the name denotes a constant. \FAILURE Never fails; if the given string was already an infix, its precedence and associativity are changed to the new values. \EXAMPLE { # strip_comb `n choose k`;; Warning: inventing type variables val it : term * term list = (`n`, [`choose`; `k`]) # parse_as_infix("choose",(22,"right"));; val it : unit = () # strip_comb `n choose k`;; Warning: inventing type variables val it : term * term list = (`(choose)`, [`n`; `k`]) } \USES Adding user-defined binary operators. \SEEALSO get_infix_status, infixes, unparse_as_infix. \ENDDOC hol-light/Help/parse_as_prefix.doc000066400000000000000000000007321303454263000175000ustar00rootroot00000000000000\DOC parse_as_prefix \TYPE {parse_as_prefix : string -> unit} \SYNOPSIS Gives an identifier prefix status. \DESCRIBE Certain identifiers {c} have prefix status, meaning that combinations of the form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The call {parse_as_prefix "c"} adds {c} to the list of such identifiers. \FAILURE Never fails, even if the string already has prefix status. \SEEALSO is_prefix, prefixes, unparse_as_prefix. \ENDDOC hol-light/Help/parse_inductive_type_specification.doc000066400000000000000000000013641303454263000234550ustar00rootroot00000000000000\DOC parse_inductive_type_specification \TYPE {parse_inductive_type_specification : string -> (hol_type * (string * hol_type list) list) list} \SYNOPSIS Parses the specification for an inductive type into a structured format. \DESCRIBE The underlying function {define_type_raw} used inside {define_type} expects the inductive type specification in a more structured format. The function {parse_inductive_type_specification} parses the usual string form as handed to {define_type} and yields this structured form. In fact, {define_type} is just the composition of {define_type_raw} and {parse_inductive_type_specification}. \FAILURE Fails if there is a parsing error in the inductive type specification. \SEEALSO define_type, define_type_raw. \ENDDOC hol-light/Help/parse_preterm.doc000066400000000000000000000011321303454263000171710ustar00rootroot00000000000000\DOC parse_preterm \TYPE {parse_preterm : lexcode list -> preterm * lexcode list} \SYNOPSIS Parses a preterm. \DESCRIBE The call {parse_preterm t}, where {t} is a list of lexical tokens (as produced by {lex}), parses the tokens and returns a preterm as well as the unparsed tokens. \FAILURE Fails if there is a syntax error in the token list. \USES This is mostly an internal function; pretypes and preterms are used as an intermediate representation for typechecking and overload resolution and are not normally of concern to users. \SEEALSO lex, parse_pretype, parse_term, parse_type. \ENDDOC hol-light/Help/parse_pretype.doc000066400000000000000000000011341303454263000172050ustar00rootroot00000000000000\DOC parse_pretype \TYPE {parse_pretype : lexcode list -> pretype * lexcode list} \SYNOPSIS Parses a pretype. \DESCRIBE The call {parse_pretype t}, where {t} is a list of lexical tokens (as produced by {lex}), parses the tokens and returns a pretype as well as the unparsed tokens. \FAILURE Fails if there is a syntax error in the token list. \USES This is mostly an internal function; pretypes and preterms are used as an intermediate representation for typechecking and overload resolution and are not normally of concern to users. \SEEALSO lex, parse_preterm, parse_term, parse_type. \ENDDOC hol-light/Help/parse_term.doc000066400000000000000000000013771303454263000164750ustar00rootroot00000000000000\DOC parse_term \TYPE {parse_term : string -> term} \SYNOPSIS Parses a string into a HOL term. \DESCRIBE The call {parse_term "s"} parses the string {s} into a HOL term. This is the function that is invoked automatically when a term is written in quotations {`s`}. \FAILURE Fails in the event of a syntax error or unparsed input. \EXAMPLE { # parse_term "p /\\ q ==> r";; val it : term = `p /\ q ==> r` } \COMMENTS Note that backslash characters should be doubled up when entering OCaml strings, as in the example above, since they are the string escape character. This is handled automatically by the quotation parser, so one doesn't need to do it (indeed shouldn't do it) when entering quotations between backquotes. \SEEALSO lex, parse_type. \ENDDOC hol-light/Help/parse_type.doc000066400000000000000000000007351303454263000165040ustar00rootroot00000000000000\DOC parse_type \TYPE {parse_type : string -> hol_type} \SYNOPSIS Parses a string into a HOL type. \DESCRIBE The call {parse_type "s"} parses the string {s} into a HOL type. This is the function that is invoked automatically when a type is written in quotations with an initial colon {`:s`}. \FAILURE Fails in the event of a syntax error or unparsed input. \EXAMPLE { # parse_type "num->bool";; val it : hol_type = `:num->bool` } \SEEALSO lex, parse_term. \ENDDOC hol-light/Help/parses_as_binder.doc000066400000000000000000000010441303454263000176260ustar00rootroot00000000000000\DOC parses_as_binder \TYPE {parses_as_binder : string -> bool} \SYNOPSIS Tests if a string has binder status in the parser. \DESCRIBE Certain identifiers {c} have binder status, meaning that {`c x. y`} is parsed as a shorthand for {`(c) (\x. y)'}. The call {parses_as_binder "c"} tests if {c} is one of the identifiers with binder status. \FAILURE Never fails. \EXAMPLE { # parses_as_binder "!";; val it : bool = true # parses_as_binder "==>";; val it : bool = false } \SEEALSO binders, parses_as_binder, unparse_as_binder. \ENDDOC hol-light/Help/partition.doc000066400000000000000000000007751303454263000163460ustar00rootroot00000000000000\DOC partition \TYPE {partition : ('a -> bool) -> 'a list -> 'a list * 'a list} \SYNOPSIS Separates a list into two lists using a predicate. \DESCRIBE {partition p l} returns a pair of lists. The first list contains the elements which satisfy {p}. The second list contains all the other elements. \FAILURE Never fails. \EXAMPLE { # partition (fun x -> x mod 2 = 0) (1--10);; val it : int list * int list = ([2; 4; 6; 8; 10], [1; 3; 5; 7; 9]) } \SEEALSO chop_list, remove, filter. \ENDDOC hol-light/Help/possibly.doc000066400000000000000000000017431303454263000161750ustar00rootroot00000000000000\DOC possibly \TYPE {possibly : ('a -> 'b * 'a) -> 'a -> 'b list * 'a} \SYNOPSIS Attempts to parse, returning empty list of items in case of failure. \DESCRIBE If {p} is a parser, then {possibly p} is another parser that attempts to parse with {p} and if successful returns the result as a singleton list, but will return the empty list instead if the core parser {p} raises {Noparse}. \FAILURE Never fails. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, leftbin, listof, many, nothing, rightbin, some. \ENDDOC hol-light/Help/pow10.doc000066400000000000000000000006251303454263000152750ustar00rootroot00000000000000\DOC pow10 \TYPE {pow10 : int -> num} \SYNOPSIS Returns power of 10 as unlimited-size integer. \DESCRIBE When applied to an integer {n} (type {int}), {pow10} returns $10^n$ as an unlimited-precision integer (type {num}). The argument may be negative. \FAILURE Never fails. \EXAMPLE { # pow10(-1);; val it : num = 1/10 # pow10(16);; val it : num = 10000000000000000 } \SEEALSO pow2. \ENDDOC hol-light/Help/pow2.doc000066400000000000000000000006211303454263000152120ustar00rootroot00000000000000\DOC pow2 \TYPE {pow2 : int -> num} \SYNOPSIS Returns power of 2 as unlimited-size integer. \DESCRIBE When applied to an integer {n} (type {int}), {pow2} returns $2^n$ as an unlimited-precision integer (type {num}). The argument may be negative. \FAILURE Never fails. \EXAMPLE { # pow2(-2);; val it : num = 1/4 # pow2(64);; val it : num = 18446744073709551616 } \SEEALSO pow10. \ENDDOC hol-light/Help/pp_print_qterm.doc000066400000000000000000000007421303454263000173720ustar00rootroot00000000000000\DOC pp_print_qterm \TYPE {pp_print_qterm : formatter -> term -> unit} \SYNOPSIS Prints a term with surrounding quotes to formatter. \DESCRIBE The call {pp_print_term fmt tm} prints the usual textual representation of the term {tm} to the formatter {fmt}, in the form {`tm`}. \FAILURE Should never fail unless the formatter does. \COMMENTS The usual case where the formatter is the standard output is {print_qterm}. \SEEALSO pp_print_term, print_qterm, print_term. \ENDDOC hol-light/Help/pp_print_qtype.doc000066400000000000000000000007711303454263000174060ustar00rootroot00000000000000\DOC pp_print_qtype \TYPE {pp_print_qtype : formatter -> hol_type -> unit} \SYNOPSIS Prints a type with initial colon and surrounding quotes to formatter. \DESCRIBE The call {pp_print_type fmt ty} prints the usual textual representation of the type {ty} to the formatter {fmt}, in the form {`:ty`}. \FAILURE Should never fail unless the formatter does. \COMMENTS The usual case where the formatter is the standard output is {print_qtype}. \SEEALSO pp_print_type, print_qtype, print_type. \ENDDOC hol-light/Help/pp_print_term.doc000066400000000000000000000007511303454263000172110ustar00rootroot00000000000000\DOC pp_print_term \TYPE {pp_print_term : formatter -> term -> unit} \SYNOPSIS Prints a term (without quotes) to formatter. \DESCRIBE The call {pp_print_term fmt tm} prints the usual textual representation of the term {tm} to the formatter {fmt}. The string is just {tm} not {`tm`}. \FAILURE Should never fail unless the formatter does. \COMMENTS The usual case where the formatter is the standard output is {print_term}. \SEEALSO pp_print_qterm, print_qterm, print_term. \ENDDOC hol-light/Help/pp_print_thm.doc000066400000000000000000000006251303454263000170320ustar00rootroot00000000000000\DOC pp_print_thm \TYPE {pp_print_thm : formatter -> thm -> unit} \SYNOPSIS Prints a theorem to formatter. \DESCRIBE The call {pp_print_thm fmt th} prints the usual textual representation of the theorem {th} to the formatter {fmt}. \FAILURE Should never fail unless the formatter does. \COMMENTS The usual case where the formatter is the standard output is {print_thm}. \SEEALSO print_thm. \ENDDOC hol-light/Help/pp_print_type.doc000066400000000000000000000007671303454263000172320ustar00rootroot00000000000000\DOC pp_print_type \TYPE {pp_print_type : formatter -> hol_type -> unit} \SYNOPSIS Prints a type (without colon or quotes) to formatter. \DESCRIBE The call {pp_print_type fmt ty} prints the usual textual representation of the type {ty} to the formatter {fmt}. The string is just {ty} not {`:ty`}. \FAILURE Should never fail unless the formatter does. \COMMENTS The usual case where the formatter is the standard output is {print_type}. \SEEALSO pp_print_qtype, print_qtype, print_type. \ENDDOC hol-light/Help/prebroken_binops.doc000066400000000000000000000015671303454263000176760ustar00rootroot00000000000000\DOC prebroken_binops \TYPE {prebroken_binops : string list ref} \SYNOPSIS Determines which binary operators are line-broken to the left \DESCRIBE The reference variable {prebroken_binops} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic printing of terms and theorems at the toplevel. It holds a list of the names of binary operators that, when a line break is needed, will be printed after the line break rather than before it. By default it contains just implication. \FAILURE Not applicable. \COMMENTS Putting more operators such as conjunction in this list gives an output format closer to the one advocated in Lamport's ``How to write a large formula'' paper. \SEEALSO pp_print_term, print_all_thm, print_unambiguous_comprehensions, reverse_interface_mapping, typify_universal_set, unspaced_binops. \ENDDOC hol-light/Help/prefixes.doc000066400000000000000000000011371303454263000161530ustar00rootroot00000000000000\DOC prefixes \TYPE {prefixes : unit -> string list} \SYNOPSIS Certain identifiers {c} have prefix status, meaning that combinations of the form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The call {prefixes()} returns the list of all such identifiers. \FAILURE Never fails. \EXAMPLE In the default HOL state: { # prefixes();; val it : string list = ["~"; "--"; "mod"] } This explains, for example, why `{~ ~ p}' parses as `{~(~p)}' rather than parsing as `{(~ ~) p}' and generating a typechecking error. \SEEALSO is_prefix, parse_as_prefix, unparse_as_prefix. \ENDDOC hol-light/Help/preterm_of_term.doc000066400000000000000000000011261303454263000175150ustar00rootroot00000000000000\DOC preterm_of_term \TYPE {preterm_of_term : term -> preterm} \SYNOPSIS Converts a term into a preterm. \DESCRIBE HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for parsing and typechecking, which are later converted to types and terms. A call {preterm_of_term `tm`} converts in the other direction, from a normal HOL term back to a preterm. \FAILURE Never fails. \USES User manipulation of preterms is not usually necessary, unless you seek to radically change aspects of parsing and typechecking. \SEEALSO pretype_of_type, term_of_preterm. \ENDDOC hol-light/Help/pretype_of_type.doc000066400000000000000000000011161303454263000175400ustar00rootroot00000000000000\DOC pretype_of_type \TYPE {pretype_of_type : hol_type -> pretype} \SYNOPSIS Converts a type into a pretype. \DESCRIBE HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for parsing and typechecking, which are later converted to types and terms. A call {preterm_of_term `tm`} converts in the other direction, from a normal HOL term back to a preterm. \FAILURE Never fails. \USES User manipulation of pretypes is not usually necessary, unless you seek to radically change aspects of parsing and typechecking. \SEEALSO preterm_of_term, type_of_pretype. \ENDDOC hol-light/Help/print_all_thm.doc000066400000000000000000000015541303454263000171650ustar00rootroot00000000000000\DOC print_all_thm \TYPE {print_all_thm : bool ref} \SYNOPSIS Flag determining whether the assumptions of theorems are printed explicitly. \DESCRIBE The reference variable {print_all_thm} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic printing of terms and theorems at the toplevel. When it is {true}, as it is by default, all assumptions of theorems are printed. When it is {false}, they are abbreviated by dots. \FAILURE Not applicable. \EXAMPLE { # let th = ADD_ASSUM `1 + 1 = 2` (ASSUME `2 + 2 = 4`);; val th : thm = 2 + 2 = 4, 1 + 1 = 2 |- 2 + 2 = 4 # print_all_thm := false;; val it : unit = () # th;; val it : thm = ... |- 2 + 2 = 4 } \SEEALSO pp_print_term, prebroken_binops, print_unambiguous_comprehensions, reverse_interface_mapping, typify_universal_set, unspaced_binops. \ENDDOC hol-light/Help/print_fpf.doc000066400000000000000000000007031303454263000163130ustar00rootroot00000000000000\DOC print_fpf \TYPE {print_fpf : ('a, 'b) func -> unit} \SYNOPSIS Print a finite partial function. \DESCRIBE This prints a finite partial function but only as a trivial string `{}'. Installed automatically at the top level and probably not useful for most users. \FAILURE Never fails. \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/print_goal.doc000066400000000000000000000006071303454263000164650ustar00rootroot00000000000000\DOC print_goal \TYPE {print_goal : goal -> unit} \SYNOPSIS Print a goal. \DESCRIBE {print_goalstack g} prints the goal {g} to standard output, with no following newline. \FAILURE Never fails. \COMMENTS This is invoked automatically when something of type {goal} is produced at the top level, so manual invocation is not normally needed. \SEEALSO print_goalstack, print_term. \ENDDOC hol-light/Help/print_goalstack.doc000066400000000000000000000006451303454263000175150ustar00rootroot00000000000000\DOC print_goalstack \TYPE {print_goalstack : goalstack -> unit} \SYNOPSIS Print a goalstack. \DESCRIBE {print_goalstack gs} prints the goalstack {gs} to standard output, with no following newline. \FAILURE Never fails. \COMMENTS This is invoked automatically when something of type {goalstack} is produced at the top level, so manual invocation is not normally needed. \SEEALSO print_goal, print_term. \ENDDOC hol-light/Help/print_num.doc000066400000000000000000000005731303454263000163440ustar00rootroot00000000000000\DOC print_num \TYPE {print_num : num -> unit} \SYNOPSIS Print an arbitrary-precision number to the terminal. \DESCRIBE This function prints an arbitrary-precision (type {num}) number to the terminal. It is automatically invoked on anything of type {num} at the toplevel anyway, but it may sometimes be useful to issue it under user control. \FAILURE Never fails. \ENDDOC hol-light/Help/print_qterm.doc000066400000000000000000000006741303454263000166770ustar00rootroot00000000000000\DOC print_qterm \TYPE {print_qterm : term -> unit} \SYNOPSIS Prints a HOL term with surrounding quotes to standard output. \DESCRIBE The call {print_term tm} prints the usual textual representation of the term {tm} to the standard output, that is {`:tm`}. \FAILURE Never fails. \COMMENTS This is the function that is invoked automatically in the toplevel when printing terms. \SEEALSO pp_print_qterm, pp_print_term, print_term. \ENDDOC hol-light/Help/print_qtype.doc000066400000000000000000000007061303454263000167050ustar00rootroot00000000000000\DOC print_qtype \TYPE {print_qtype : hol_type -> unit} \SYNOPSIS Prints a type with colon and surrounding quotes to standard output. \DESCRIBE The call {print_type ty} prints the usual textual representation of the type {ty} to the standard output, that is {`:ty`}. \FAILURE Never fails. \COMMENTS This is the function that is invoked automatically in the toplevel when printing types. \SEEALSO pp_print_qtype, pp_print_type, print_type. \ENDDOC hol-light/Help/print_term.doc000066400000000000000000000010161303454263000165050ustar00rootroot00000000000000\DOC print_term \TYPE {print_term : term -> unit} \SYNOPSIS Prints a HOL term (without quotes) to the standard output. \DESCRIBE The call {print_term tm} prints the usual textual representation of the term {tm} to the standard output. The string is just {tm} not {`tm`}. \FAILURE Never fails. \USES Producing debugging output in complex rules. Note that terms are already printed at the toplevel anyway, so it is not needed to examine results interactively. \SEEALSO pp_print_qterm, pp_print_term, print_qterm. \ENDDOC hol-light/Help/print_thm.doc000066400000000000000000000005371303454263000163350ustar00rootroot00000000000000\DOC print_thm \TYPE {print_thm : thm -> unit} \SYNOPSIS Prints a HOL theorem to the standard output. \DESCRIBE The call {print_thm th} prints the usual textual representation of the theorem {th} to the standard output. \COMMENTS This is invoked automatically at the toplevel when theorems are printed. \SEEALSO print_type, print_term. \ENDDOC hol-light/Help/print_to_string.doc000066400000000000000000000014121303454263000175460ustar00rootroot00000000000000\DOC print_to_string \TYPE {print_to_string : (formatter -> 'a -> 'b) -> 'a -> string} \SYNOPSIS Modifies a formatting printing function to return its output as a string. \DESCRIBE If {p} is a printing function whose first argument is a formatter (a standard OCaml datatype indicating an output for printing functions), {print_to_string P} gives a function that invokes it and collects and returns its output as a string. \FAILURE Fails only if the core printing function fails. \EXAMPLE The standard function {string_of_term} is defined as: { # let string_of_term = print_to_string pp_print_term;; } \USES Converting a general printing function to a `convert to string' function, as in the example above. \SEEALSO pp_print_term, pp_print_thm, pp_print_type. \ENDDOC hol-light/Help/print_type.doc000066400000000000000000000010241303454263000165160ustar00rootroot00000000000000\DOC print_type \TYPE {print_type : hol_type -> unit} \SYNOPSIS Prints a type (without colon or quotes) to standard output. \DESCRIBE The call {print_type ty} prints the usual textual representation of the type {ty} to the standard output. The string is just {ty} not {`:ty`}. \FAILURE Never fails. \USES Producing debugging output in complex rules. Note that terms are already printed at the toplevel anyway, so it is not needed to examine results interactively. \SEEALSO pp_print_qtype, pp_print_type, print_qtype. \ENDDOC hol-light/Help/print_unambiguous_comprehensions.doc000066400000000000000000000027551303454263000232230ustar00rootroot00000000000000\DOC print_unambiguous_comprehensions \TYPE {print_unambiguous_comprehensions : bool ref} \SYNOPSIS Determines whether bound variables in set abstractions are made explicit. \DESCRIBE The reference variable {print_unambiguous_comprehensions} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic printing of terms and theorems at the toplevel. When it is {true}, all set comprehensions are printed with an explicit indication of the bound variables in the middle: {`{{t | vs | p}}`}. When it is {false}, as it is by default, this printing of the set of bound variables is only done when the term would otherwise fail to match the default parsing behaviour on input, and otherwise just printed as {`{{t | p}}`}. The parsing behaviour for such a term is to take the bound variables to be those free in both {t} and {p}, unless there is just one variable free in {t} (in which case that variable is the only bound one) or there are none free in {p} (in which case all free variables of {t} are taken). \FAILURE Not applicable. \EXAMPLE { # print_unambiguous_comprehensions := false;; val it : unit = () # `{{x + y | x | EVEN(x)}}`;; val it : term = `{{x + y | EVEN x}}` # print_unambiguous_comprehensions := true;; val it : unit = () # `{{x + y | x | EVEN(x)}}`;; val it : term = `{{x + y | x | EVEN x}}` } \SEEALSO pp_print_term, prebroken_binops, print_all_thm, reverse_interface_mapping, typify_universal_set, unspaced_binops. \ENDDOC hol-light/Help/prioritize_int.doc000066400000000000000000000031211303454263000173730ustar00rootroot00000000000000\DOC prioritize_int \TYPE {prioritize_int : unit -> unit} \SYNOPSIS Give integer type {int} priority in operator overloading. \DESCRIBE Symbols for several arithmetical (`{+}', `{-}', ...) and relational (`{<}', `{>=}', ...) operators are overloaded so that they may denote the operators for several different number systems, particularly {num} (natural numbers), {int} (integers) and {real} (real numbers). The choice is normally made based on some known types, or the presence of operators that are not overloaded for the number systems. (For example, numerals like {42} are always assumed to be of type {num}, while the division operator `{/}' is only defined for {real}.) In the absence of any such indication, a default choice will be made. The effect of {prioritize_int()} is to make {int}, the integer type, the default. \FAILURE Never fails. \EXAMPLE With integer priority, most things are interpreted as type {int} { # prioritize_int();; val it : unit = () # type_of `x + y`;; val it : hol_type = `:int` } \noindent except that numerals are always of type {num}, and so: { # type_of `x + 1`;; val it : hol_type = `:num` } \noindent and any explicit type information is used before using the defaults: { # type_of `(x:real) + y`;; val it : hol_type = `:real` } \COMMENTS It is perhaps better practice to insert types explicitly to avoid dependence on such defaults, otherwise proofs can become context-dependent. However it is often very convenient. \SEEALSO make_overloadable, overload_interface, prioritize_num, prioritize_overload, prioritize_real, the_overload_skeletons. \ENDDOC hol-light/Help/prioritize_num.doc000066400000000000000000000034131303454263000174040ustar00rootroot00000000000000\DOC prioritize_num \TYPE {prioritize_num : unit -> unit} \SYNOPSIS Give natural number type {num} priority in operator overloading. \DESCRIBE Symbols for several arithmetical (`{+}', `{-}', ...) and relational (`{<}', `{>=}', ...) operators are overloaded so that they may denote the operators for several different number systems, particularly {num} (natural numbers), {int} (integers) and {real} (real numbers). The choice is normally made based on some known types, or the presence of operators that are not overloaded for the number systems. (For example, numerals like {42} are always assumed to be of type {num}, while the division operator `{/}' is only defined for {real}.) In the absence of any such indication, a default choice will be made. The effect of {prioritize_num()} is to make {num}, the natural number type, the default. \FAILURE Never fails. \EXAMPLE With real priority, most things are interpreted as type {real}: { # prioritize_real();; val it : unit = () # type_of `x + y`;; val it : hol_type = `:real` } \noindent except that numerals are always of type {num}, and so: { # type_of `x + 1`;; val it : hol_type = `:num` } \noindent By making {num} the priority, everything is interpreted as {num}: { # prioritize_num();; val it : unit = () # type_of `x + y`;; val it : hol_type = `:num` } \noindent unless there is some explicit type information to the contrary: { # type_of `(x:real) + y`;; val it : hol_type = `:real` } \COMMENTS It is perhaps better practice to insert types explicitly to avoid dependence on such defaults, otherwise proofs can become context-dependent. However it is often very convenient. \SEEALSO make_overloadable, overload_interface, prioritize_int, prioritize_overload, prioritize_real, the_overload_skeletons. \ENDDOC hol-light/Help/prioritize_overload.doc000066400000000000000000000033631303454263000204240ustar00rootroot00000000000000\DOC prioritize_overload \TYPE {prioritize_overload : hol_type -> unit} \SYNOPSIS Give overloaded constants involving a given type priority in operator overloading. \DESCRIBE In general, overloaded operators in the concrete syntax, such as `{+}', are ambiguous, referring to one of several underlying constants. The choice is normally made based on some known types, or the presence of operators that are not overloaded for the number systems. (For example, numerals like {42} are always assumed to be of type {num}, while the division operator `{/}' is only defined for {real}.) In the absence of any such indication, a default choice will be made. The effect of {prioritize_overload `:ty`} is to run through the overloaded symbols making the first instance of each where the generic type variables in the type skeleton are replaced by type {`:ty`} the first priority when no other indication is made. \FAILURE Never fails. \EXAMPLE With real priority, most things are interpreted as type {real}: { # prioritize_overload `:real`;; val it : unit = () # type_of `x + y`;; val it : hol_type = `:real` } \noindent By making {int} the priority, everything is interpreted as {int}: { # prioritize_overload `:int`;; val it : unit = () # type_of `x + y`;; val it : hol_type = `:int` } \noindent unless there is some explicit type information to the contrary: { # type_of `(x:real) + y`;; val it : hol_type = `:real` } \COMMENTS It is perhaps better practice to insert types explicitly to avoid dependence on such defaults, otherwise proofs can become context-dependent. However it is often very convenient. \SEEALSO make_overloadable, overload_interface, prioritize_int, prioritize_num, prioritize_real, the_implicit_types, the_overload_skeletons. \ENDDOC hol-light/Help/prioritize_real.doc000066400000000000000000000031341303454263000175300ustar00rootroot00000000000000\DOC prioritize_real \TYPE {prioritize_real : unit -> unit} \SYNOPSIS Give real number type {real} priority in operator overloading. \DESCRIBE Symbols for several arithmetical (`{+}', `{-}', ...) and relational (`{<}', `{>=}', ...) operators are overloaded so that they may denote the operators for several different number systems, particularly {num} (natural numbers), {int} (integers) and {real} (real numbers). The choice is normally made based on some known types, or the presence of operators that are not overloaded for the number systems. (For example, numerals like {42} are always assumed to be of type {num}, while the division operator `{/}' is only defined for {real}.) In the absence of any such indication, a default choice will be made. The effect of {prioritize_real()} is to make {real}, the real number type, the default. \FAILURE Never fails. \EXAMPLE With real priority, most things are interpreted as type {real}: { # prioritize_real();; val it : unit = () # type_of `x + y`;; val it : hol_type = `:real` } \noindent except that numerals are always of type {num}, and so: { # type_of `x + 1`;; val it : hol_type = `:num` } \noindent and any explicit type information is used before using the defaults: { # type_of `(x:int) + y`;; val it : hol_type = `:int` } \COMMENTS It is perhaps better practice to insert types explicitly to avoid dependence on such defaults, otherwise proofs can become context-dependent. However it is often very convenient. \SEEALSO make_overloadable, overload_interface, prioritize_int, prioritize_num, prioritize_overload, the_overload_skeletons. \ENDDOC hol-light/Help/prove.doc000066400000000000000000000013731303454263000154630ustar00rootroot00000000000000\DOC prove \TYPE {prove : term * tactic -> thm} \SYNOPSIS Attempts to prove a boolean term using the supplied tactic. \KEYWORDS apply. \DESCRIBE When applied to a term-tactic pair {(tm,tac)}, the function {prove} attempts to prove the goal {?- tm}, that is, the term {tm} with no assumptions, using the tactic {tac}. If {prove} succeeds, it returns the corresponding theorem {A |- tm}, where the assumption list {A} may not be empty if the tactic is invalid; {prove} has no inbuilt validity-checking. \FAILURE Fails if the term is not of type {bool} (and so cannot possibly be the conclusion of a theorem), or if the tactic cannot solve the goal. In the latter case {prove} will list the unsolved goals to help the user. \SEEALSO TAC_PROOF, VALID. \ENDDOC hol-light/Help/prove_cases_thm.doc000066400000000000000000000027501303454263000175110ustar00rootroot00000000000000\DOC prove_cases_thm \TYPE {prove_cases_thm : thm -> thm} \SYNOPSIS Proves a structural cases theorem for an automatically-defined concrete type. \DESCRIBE {prove_cases_thm} takes as its argument a structural induction theorem, in the form returned by {prove_induction_thm} for an automatically-defined concrete type. When applied to such a theorem, {prove_cases_thm} automatically proves and returns a theorem which states that every value the concrete type in question is denoted by the value returned by some constructor of the type. \FAILURE Fails if the argument is not a theorem of the form returned by {prove_induction_thm} \EXAMPLE The following type definition for labelled binary trees: { # let ith,rth = define_type "tree = LEAF num | NODE tree tree";; val ith : thm = |- !P. (!a. P (LEAF a)) /\ (!a0 a1. P a0 /\ P a1 ==> P (NODE a0 a1)) ==> (!x. P x) val rth : thm = |- !f0 f1. ?fn. (!a. fn (LEAF a) = f0 a) /\ (!a0 a1. fn (NODE a0 a1) = f1 a0 a1 (fn a0) (fn a1)) } \noindent returns an induction theorem {ith} that can then be fed to {prove_cases_thm}: { # prove_cases_thm ith;; val it : thm = |- !x. (?a. x = LEAF a) \/ (?a0 a1. x = NODE a0 a1) } \COMMENTS An easier interface is {cases "tree"}. This function is mainly intended to generate the cases theorems for that function. \SEEALSO cases, define_type, INDUCT_THEN, new_recursive_definition, prove_constructors_distinct, prove_constructors_one_one, prove_induction_thm. \ENDDOC hol-light/Help/prove_constructors_distinct.doc000066400000000000000000000034441303454263000222150ustar00rootroot00000000000000\DOC prove_constructors_distinct \TYPE {prove_constructors_distinct : thm -> thm} \SYNOPSIS Proves that the constructors of an automatically-defined concrete type yield distinct values. \DESCRIBE {prove_constructors_distinct} takes as its argument a primitive recursion theorem, in the form returned by {define_type} for an automatically-defined concrete type. When applied to such a theorem, {prove_constructors_distinct} automatically proves and returns a theorem which states that distinct constructors of the concrete type in question yield distinct values of this type. \FAILURE Fails if the argument is not a theorem of the form returned by {define_type}, or if the concrete type in question has only one constructor. \EXAMPLE The following type definition for labelled binary trees: { # let ith,rth = define_type "tree = LEAF num | NODE tree tree";; val ith : thm = |- !P. (!a. P (LEAF a)) /\ (!a0 a1. P a0 /\ P a1 ==> P (NODE a0 a1)) ==> (!x. P x) val rth : thm = |- !f0 f1. ?fn. (!a. fn (LEAF a) = f0 a) /\ (!a0 a1. fn (NODE a0 a1) = f1 a0 a1 (fn a0) (fn a1)) } \noindent returns a recursion theorem {rth} that can then be fed to {prove_constructors_distinct}: { # prove_constructors_distinct rth;; val it : thm = |- !a a0' a1'. ~(LEAF a = NODE a0' a1') } This states that leaf nodes are different from internal nodes. When the concrete type in question has more than two constructors, the resulting theorem is just conjunction of inequalities of this kind. \COMMENTS An easier interface is {distinctness "tree"}; this function is mainly intended to generate that theorem internally. \SEEALSO define_type, distinctness, INDUCT_TAC, new_recursive_definition, prove_cases_thm, prove_constructors_one_one, prove_induction_thm, prove_rec_fn_exists. \ENDDOC hol-light/Help/prove_constructors_injective.doc000066400000000000000000000036071303454263000223550ustar00rootroot00000000000000\DOC prove_constructors_injective \TYPE {prove_constructors_injective : thm -> thm} \SYNOPSIS Proves that the constructors of an automatically-defined concrete type are injective. \DESCRIBE {prove_constructors_one_one} takes as its argument a primitive recursion theorem, in the form returned by {define_type} for an automatically-defined concrete type. When applied to such a theorem, {prove_constructors_one_one} automatically proves and returns a theorem which states that the constructors of the concrete type in question are injective (one-to-one). The resulting theorem covers only those constructors that take arguments (i.e. that are not just constant values). \FAILURE Fails if the argument is not a theorem of the form returned by {define_type}, or if all the constructors of the concrete type in question are simply constants of that type. \EXAMPLE The following type definition for labelled binary trees: { # let ith,rth = define_type "tree = LEAF num | NODE tree tree";; val ith : thm = |- !P. (!a. P (LEAF a)) /\ (!a0 a1. P a0 /\ P a1 ==> P (NODE a0 a1)) ==> (!x. P x) val rth : thm = |- !f0 f1. ?fn. (!a. fn (LEAF a) = f0 a) /\ (!a0 a1. fn (NODE a0 a1) = f1 a0 a1 (fn a0) (fn a1)) } \noindent returns a recursion theorem {rth} that can then be fed to {prove_constructors_injective}: { # prove_constructors_injective rth;; val it : thm = |- (!a a'. LEAF a = LEAF a' <=> a = a') /\ (!a0 a1 a0' a1'. NODE a0 a1 = NODE a0' a1' <=> a0 = a0' /\ a1 = a1') } \noindent This states that the constructors {LEAF} and {NODE} are both injective. \COMMENTS An easier interface is {injectivity "tree"}; the present function is mainly intended to generate that theorem internally. \SEEALSO define_type, INDUCT_THEN, injectivity, new_recursive_definition, prove_cases_thm, prove_constructors_distinct, prove_induction_thm, prove_rec_fn_exists. \ENDDOC hol-light/Help/prove_general_recursive_function_exists.doc000066400000000000000000000061751303454263000245600ustar00rootroot00000000000000\DOC prove_general_recursive_function_exists \TYPE {prove_general_recursive_function_exists : term -> thm} \SYNOPSIS Proves existence of general recursive function. \DESCRIBE The function {prove_general_recursive_function_exists} should be applied to an existentially quantified term {`?f. def_1[f] /\ ... /\ def_n[f]`}, where each clause {def_i} is a universally quantified equation with an application of {f} to arguments on the left-hand side. The idea is that these clauses define the action of {f} on arguments of various kinds, for example on an empty list and nonempty list: { ?f. (f [] = a) /\ (!h t. CONS h t = k[f,h,t]) } \noindent or on even numbers and odd numbers: { ?f. (!n. f(2 * n) = a[f,n]) /\ (!n. f(2 * n + 1) = b[f,n]) } The returned value is a theorem whose conclusion matches the input term, with zero, one or two assumptions, depending on what conditions had been proven automatically. Roughly, one assumption states that the clauses are not mutually contradictory, as in { ?f. (!n. f(n + 1) = 1) /\ (!n. f(n + 2) = 2) } \noindent and the other states that there is some wellfounded order making any recursion admissible. \FAILURE Fails only if the definition is malformed. However it is possible that for an inadmissible definition the assumptions of the theorem may not hold. \EXAMPLE In the definition of the Fibonacci numbers, the function successfully eliminates all the hypotheses and just proves the claimed existence assertion: { # prove_general_recursive_function_exists `?fib. fib 0 = 1 /\ fib 1 = 1 /\ !n. fib(n + 2) = fib(n) + fib(n + 1)`;; val it : thm = |- ?fib. fib 0 = 1 /\ fib 1 = 1 /\ (!n. fib (n + 2) = fib n + fib (n + 1)) } \noindent whereas in the following case, the function cannot automatically discover the appropriate ordering to make the recursion admissible, so an assumption is included: { # let eth = prove_general_recursive_function_exists `?upto. !m n. upto m n = if n < m then [] else if m = n then [n] else CONS m (upto (m + 1) n)`;; val eth : thm = ?(<<). WF (<<) /\ (!m n. (T /\ ~(n < m)) /\ ~(m = n) ==> m + 1,n << m,n) |- ?upto. !m n. upto m n = (if n < m then [] else if m = n then [n] else CONS m (upto (m + 1) n)) } \noindent You can prove the condition by supplying an appropriate ordering, e.g. { # let wfth = prove(hd(hyp eth), EXISTS_TAC `MEASURE (\(m:num,n:num). n - m)` THEN REWRITE_TAC[WF_MEASURE; MEASURE] THEN ARITH_TAC);; val wfth : thm = |- ?(<<). WF (<<) /\ (!m n. (T /\ ~(n < m)) /\ ~(m = n) ==> m + 1,n << m,n) } \noindent and so get the pure existence theorem with {PROVE_HYP wfth eth}. \USES To prove existence of a recursive function defined by clauses without actually defining it. In order to define it, use {define}. To further forestall attempts to prove conditions automatically, consider {pure_prove_recursive_function_exists} or even {instantiate_casewise_recursion}. \SEEALSO define, instantiate_casewise_recursion, pure_prove_recursive_function_exists. \ENDDOC hol-light/Help/prove_inductive_relations_exist.doc000066400000000000000000000045061303454263000230320ustar00rootroot00000000000000\DOC prove_inductive_relations_exist \TYPE {prove_inductive_relations_exist : term -> thm} \SYNOPSIS Prove existence of inductively defined relations without defining them. \DESCRIBE The function {prove_inductive_relations_exist} should be given a specification for an inductively defined relation {R}, or more generally a family {R1,...,Rn} of mutually inductive relations; the required format is explained further in the entry for {new_inductive_definition}. It returns an existential theorem {A |- ?R1 ... Rn. rules /\ induction /\ cases}, where {rules}, {induction} and {cases} are the rule, induction and cases theorems, explained further in the entry for {new_inductive_definition}. In contrast with {new_inductive_definition}, no actual definitions are made. The assumption list {A} is normally empty, but will include any monotonicity hypotheses that were not proven automatically. \FAILURE Fails if the form of the rules is wrong. \EXAMPLE The traditional example of even and odd numbers: { # prove_inductive_relations_exist `even(0) /\ odd(1) /\ (!n. even(n) ==> odd(n + 1)) /\ (!n. odd(n) ==> even(n + 1))`;; val it : thm = |- ?even odd. (even 0 /\ odd 1 /\ (!n. even n ==> odd (n + 1)) /\ (!n. odd n ==> even (n + 1))) /\ (!odd' even'. even' 0 /\ odd' 1 /\ (!n. even' n ==> odd' (n + 1)) /\ (!n. odd' n ==> even' (n + 1)) ==> (!a0. odd a0 ==> odd' a0) /\ (!a1. even a1 ==> even' a1)) /\ (!a0. odd a0 <=> a0 = 1 \/ (?n. a0 = n + 1 /\ even n)) /\ (!a1. even a1 <=> a1 = 0 \/ (?n. a1 = n + 1 /\ odd n)) } \noindent Here is a example where we get a nonempty list of hypotheses because HOL cannot prove monotonicity (and indeed, it doesn't hold). { # prove_inductive_relations_exist `!x. ~P(x) ==> P(x+1)`;; val it : thm = !P P'. (!a. P a ==> P' a) ==> (!a. (?x. a = x + 1 /\ ~P x) ==> (?x. a = x + 1 /\ ~P' x)) |- ?P. (!x. ~P x ==> P (x + 1)) /\ (!P'. (!x. ~P' x ==> P' (x + 1)) ==> (!a. P a ==> P' a)) /\ (!a. P a <=> (?x. a = x + 1 /\ ~P x)) } \USES Using existence of inductive relations as an auxiliary device inside a proof. \SEEALSO derive_strong_induction, new_inductive_definition, prove_monotonicity_hyps. \ENDDOC hol-light/Help/prove_monotonicity_hyps.doc000066400000000000000000000013541303454263000213400ustar00rootroot00000000000000\DOC prove_monotonicity_hyps \TYPE {prove_monotonicity_hyps : thm -> thm} \SYNOPSIS Attempt to prove monotonicity hypotheses of theorem automatically. \DESCRIBE Given a theorem {A |- t}, the rule {prove_monotonicity_hyps} attempts to prove and remove all hypotheses that are not equations, by breaking them down and repeatedly using {MONO_TAC}. Any that are equations or are not automatically provable will be left as they are. \FAILURE Never fails but may have no effect. \COMMENTS Normally, this kind of reasoning is automated by the inductive definitions package, so explicit use of this tactic is rare. \SEEALSO MONO_TAC, monotonicity_theorems, new_inductive_definition, prove_inductive_relations_exist. \ENDDOC hol-light/Help/prove_recursive_functions_exist.doc000066400000000000000000000074741303454263000230660ustar00rootroot00000000000000\DOC prove_recursive_functions_exist \TYPE {prove_recursive_functions_exist : thm -> term -> thm} \SYNOPSIS Prove existence of recursive function over inductive type. \DESCRIBE This function has essentially the same interface and functionality as {new_recursive_definition}, but it merely proves the existence of the function rather than defining it. The first argument to {prove_recursive_functions_exist} is the primitive recursion theorem for the concrete type in question; this is normally the second theorem obtained from {define_type}. The second argument is a term giving the desired primitive recursive function definition. The value returned by {prove_recursive_functions_exist} is a theorem stating the existence of a function satisfying the `definition' clauses. This theorem is derived by formal proof from an instance of the general primitive recursion theorem given as the second argument. Let {C1}, ..., {Cn} be the constructors of this type, and let `{(Ci vs)}' represent a (curried) application of the {i}th constructor to a sequence of variables. Then a curried primitive recursive function {fn} over {ty} can be specified by a conjunction of (optionally universally-quantified) clauses of the form: { fn v1 ... (C1 vs1) ... vm = body1 /\ fn v1 ... (C2 vs2) ... vm = body2 /\ . . fn v1 ... (Cn vsn) ... vm = bodyn } \noindent where the variables {v1}, ..., {vm}, {vs} are distinct in each clause, and where in the {i}th clause {fn} appears (free) in {bodyi} only as part of an application of the form: { `fn t1 ... v ... tm` } \noindent in which the variable {v} of type {ty} also occurs among the variables {vsi}. If {} is a conjunction of clauses, as described above, then evaluating: { prove_recursive_functions_exist th ``;; } \noindent automatically proves the existence of a function {fn} that satisfies the defining equations supplied, and returns a theorem: { |- ?fn. } {prove_recursive_functions_exist} also allows the supplied definition to omit clauses for any number of constructors. If a defining equation for the {i}th constructor is omitted, then the value of {fn} at that constructor: { fn v1 ... (Ci vsi) ... vn } \noindent is left unspecified ({fn}, however, is still a total function). \FAILURE Fails if the clauses cannot be matched up with the recursion theorem. You may find that {prove_general_recursive_function_exists} still works in such cases. \EXAMPLE Here we show that there exists a product function: { prove_recursive_functions_exist num_RECURSION `(prod f 0 = 1) /\ (!n. prod f (SUC n) = f(SUC n) * prod f n)`;; val it : thm = |- ?prod. prod f 0 = 1 /\ (!n. prod f (SUC n) = f (SUC n) * prod f n) } \COMMENTS Often {prove_general_recursive_function_exists} is an easier route to the same goal. Its interface is simpler (no need to specify the recursion theorem) and it is more powerful. However, for suitably constrained definitions {prove_recursive_functions_exist} works well and is much more efficient. \USES It is more usual to want to actually make definitions of recursive functions. However, if a recursive function is needed in the middle of a proof, and seems to ad-hoc for general use, you may just use {prove_recursive_functions_exist}, perhaps adding the ``definition'' as an assumption of the goal with {CHOOSE_TAC}. \SEEALSO new_inductive_definition, new_recursive_definition, prove_general_recursive_function_exists. \ENDDOC hol-light/Help/pure_prove_recursive_function_exists.doc000066400000000000000000000046451303454263000241160ustar00rootroot00000000000000\DOC pure_prove_recursive_function_exists \TYPE {pure_prove_recursive_function_exists : term -> thm} \SYNOPSIS Proves existence of general recursive function but leaves unproven assumptions. \DESCRIBE The function {pure_prove_recursive_function_exists} should be applied to an existentially quantified term {`?f. def_1[f] /\ ... /\ def_n[f]`}, where each clause {def_i} is a universally quantified equation with an application of {f} to arguments on the left-hand side. The idea is that these clauses define the action of {f} on arguments of various kinds, for example on an empty list and nonempty list: { ?f. (f [] = a) /\ (!h t. CONS h t = k[f,h,t]) } \noindent or on even numbers and odd numbers: { ?f. (!n. f(2 * n) = a[f,n]) /\ (!n. f(2 * n + 1) = b[f,n]) } The returned value is a theorem whose conclusion matches the input term, with in general one or two assumptions stating what properties must hold so that the existence of such a function to be deduced. Roughly, one assumption states that the clauses are not mutually contradictory, as in { ?f. (!n. f(n + 1) = 1) /\ (!n. f(n + 2) = 2) } \noindent and the other states that there is some wellfounded order making any recursion admissible. This rule attempts to eliminate any hypotheses of the first kind, but does not attempt to guess a wellfounded ordering as {prove_general_recursive_function_exists} does. \FAILURE Fails only if the definition is malformed. However it is possible that for an inadmissible definition the assumptions of the theorem may not hold. \EXAMPLE In the definition of the Fibonacci numbers, the function successfully eliminates the mutual consistency hypotheses: { # pure_prove_recursive_function_exists `?fib. fib 0 = 1 /\ fib 1 = 1 /\ !n. fib(n + 2) = fib(n) + fib(n + 1)`;; val it : thm = ?(<<). WF (<<) /\ (!n. T ==> n << n + 2) /\ (!n. T ==> n + 1 << n + 2) |- ?fib. fib 0 = 1 /\ fib 1 = 1 /\ (!n. fib (n + 2) = fib n + fib (n + 1)) } \noindent but leaves a wellfounded ordering to be given. (By contrast, {prove_general_recursive_function_exists} will automatically eliminate it.) \USES Normally, use {prove_general_recursive_function_exists} for this operation. Use the present function only when the attempt by {prove_general_recursive_function_exists} to discharge the proof obligations is not successful and merely wastes time. \SEEALSO define, instantiate_casewise_recursion, prove_general_recursive_function_exists. \ENDDOC hol-light/Help/qmap.doc000066400000000000000000000030071303454263000152620ustar00rootroot00000000000000\DOC qmap \TYPE {qmap : ('a -> 'a) -> 'a list -> 'a list} \SYNOPSIS Maps a function of type {'a -> 'a} over a list, optimizing the unchanged case. \DESCRIBE The call {qmap f [x1;...;xn]} returns the list {[f(x1);...;f(xn)]}. In this respect it behaves like {map}. However with {qmap}, the function {f} must have the same domain and codomain type, and in cases where the function returns the argument unchanged (actually pointer-equal, tested by `{==}'), the implementation often avoids rebuilding an equal copy of the list, so can be much more efficient. \FAILURE Fails if one of the embedded evaluations of {f} fails, but not otherwise. \EXAMPLE Let us map the identity function over a million numbers: { # let million = 1--1000000;; val million : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; ...] } First we use ordinary {map}; the computation takes some time because the list is traversed and reconstructed, giving a fresh copy: { # time (map I) million == million;; CPU time (user): 2.95 val it : bool = false } But {qmap} is markedly faster, uses no extra heap memory, and the result is pointer-equal to the input: { # time (qmap I) million == million;; CPU time (user): 0.13 val it : bool = true } \USES Many logical operations, such as substitution, may in common cases return their arguments unchanged. In this case it is very useful to optimize the traversal in this way. Several internal logical manipulations like {vsubst} use this technique. \SEEALSO map. \ENDDOC hol-light/Help/quotexpander.doc000066400000000000000000000010751303454263000170460ustar00rootroot00000000000000\DOC quotexpander \TYPE {quotexpander : string -> string} \SYNOPSIS Quotation expander. \DESCRIBE This function determines how anything in {`backquotes`} is expanded on input. \FAILURE Never fails. \EXAMPLE { # quotexpander "1 + 1";; val it : string = "parse_term \"1 + 1\"" # quotexpander ":num";; val it : string = "parse_type \"num\"" } \COMMENTS Not intended for general use, but automatically invoked when anything is typed in backquotes {`like this`}. May be of some interest for users wishing to change the behavior of the quotation parser. \ENDDOC hol-light/Help/r.doc000066400000000000000000000017601303454263000145710ustar00rootroot00000000000000\DOC r \TYPE {r : int -> goalstack} \SYNOPSIS Reorders the subgoals on top of the subgoal package goal stack. \DESCRIBE The function {r} is part of the subgoal package. It `rotates' the current list of goals by the given number, which may be positive or negative. For a description of the subgoal package, see {set_goal}. \FAILURE If there are no goals. \EXAMPLE { # g `(HD[1;2;3] = 1) /\ (TL[1;2;3] = [2;3]) /\ (HD (TL[1;2;3]) = 2)`;; val it : goalstack = 1 subgoal (1 total) `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3] /\ HD (TL [1; 2; 3]) = 2` # e (REPEAT CONJ_TAC);; val it : goalstack = 3 subgoals (3 total) `HD (TL [1; 2; 3]) = 2` `TL [1; 2; 3] = [2; 3]` `HD [1; 2; 3] = 1` # r 1;; val it : goalstack = 1 subgoal (3 total) `TL [1; 2; 3] = [2; 3]` # r 1;; val it : goalstack = 1 subgoal (3 total) `HD (TL [1; 2; 3]) = 2` } \USES Proving subgoals in a different order from that generated by the subgoal package. \SEEALSO b, e, g, p, set_goal, top_thm. \ENDDOC hol-light/Help/ran.doc000066400000000000000000000014531303454263000151070ustar00rootroot00000000000000\DOC ran \TYPE {ran : ('a, 'b) func -> 'b list} This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The {ran} operation returns the range of such a function, i.e. the set of result values for the points on which it is defined. \FAILURE Attempts to {setify} the resulting list, so may fail if the range type does not admit comparisons. \EXAMPLE { # ran (1 |=> "1");; val it : string list = ["1"] # ran(itlist I [2|->4; 3|->6] undefined);; val it : int list = [4; 6] } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine, undefined. \ENDDOC hol-light/Help/rand.doc000066400000000000000000000005411303454263000152500ustar00rootroot00000000000000\DOC rand \TYPE {rand : term -> term} \SYNOPSIS Returns the operand from a combination (function application). \DESCRIBE {rand `t1 t2`} returns {`t2`}. \FAILURE Fails with {rand} if term is not a combination. \EXAMPLE { # rand `SUC 0`;; val it : term = `0` # rand `x + y`;; val it : term = `y` } \SEEALSO rator, lhand, dest_comb. \ENDDOC hol-light/Help/rat_of_term.doc000066400000000000000000000013441303454263000166270ustar00rootroot00000000000000\DOC rat_of_term \TYPE {rat_of_term : term -> num} \SYNOPSIS Converts a canonical rational literal of type {:real} to an OCaml number. \DESCRIBE The call {rat_of_term t} where term {t} is a canonical rational literal of type {:real} returns the corresponding OCaml rational number (type {num}). The canonical literals are integer literals {&n} for numeral {n}, {-- &n} for a nonzero numeral {n}, or ratios {&p / &q} or {-- &p / &q} where {p} is nonzero, {q > 1} and {p} and {q} share no common factor. \FAILURE Fails when applied to a term that is not a canonical rational literal. \EXAMPLE { # rat_of_term `-- &22 / &7`;; val it : num = -22/7 } \SEEALSO is_ratconst, mk_realintconst, REAL_RAT_REDUCE_CONV, term_of_rat. \ENDDOC hol-light/Help/rator.doc000066400000000000000000000007131303454263000154540ustar00rootroot00000000000000\DOC rator \TYPE {rator : term -> term} \SYNOPSIS Returns the operator from a combination (function application). \DESCRIBE {rator(`t1 t2`)} returns {`t1`}. \FAILURE Fails with {rator} if term is not a combination. \EXAMPLE { # rator `f(x)`;; Warning: inventing type variables val it : term = `f` # rator `~p`;; val it : term = `(~)` # rator `x + y`;; val it : term = `(+) x` } \SEEALSO dest_comb, lhand, lhs, rand. \ENDDOC hol-light/Help/real_ideal_cofactors.doc000066400000000000000000000035661303454263000204620ustar00rootroot00000000000000\DOC real_ideal_cofactors \TYPE {real_ideal_cofactors : term list -> term -> term list} \SYNOPSIS Produces cofactors proving that one real polynomial is in the ideal generated by others. \DESCRIBE The call {real_ideal_cofactors [`p1`; ...; `pn`] `p`}, where all the terms have type {:real} and can be considered as polynomials, will test whether {p} is in the ideal generated by the {p1,...,pn}. If so, it will return a corresponding list {[`q1`; ...; `qn`]} of `cofactors' such that the following is an algebraic identity (provable by {REAL_RING} or a slight elaboration of {REAL_POLY_CONV}, for example): { p = p1 * q1 + ... + pn * qn } \noindent hence providing an explicit certificate for the ideal membership. If ideal membership does not hold, {real_ideal_cofactors} fails. The test is performed using a Gr\"obner basis procedure. \FAILURE Fails if the terms are ill-typed, or if ideal membership fails. \EXAMPLE Here is a fairly simple example: { # prioritize_real();; val it : unit = () # real_ideal_cofactors [`y1 * y3 + x1 * x3`; `y3 * (y2 - y3) + (x2 - x3) * x3`] `x3 * y3 * (y1 * (x2 - x3) - x1 * (y2 - y3))`;; ... val it : term list = [`&1 * y3 pow 2 + -- &1 * y2 * y3`; `&1 * y1 * y3`] } \noindent and we can confirm the identity as follows (note that {REAL_IDEAL_CONV} already does this directly): { # REAL_RING `(&1 * y3 pow 2 + -- &1 * y2 * y3) * (y1 * y3 + x1 * x3) + (&1 * y1 * y3) * (y3 * (y2 - y3) + (x2 - x3) * x3) = x3 * y3 * (y1 * (x2 - x3) - x1 * (y2 - y3))`;; } \COMMENTS When we say that terms can be `considered as polynomials', we mean that initial normalization, essentially in the style of {REAL_POLY_CONV}, will be applied, but some complex constructs such as conditional expressions will be treated as atomic. \SEEALSO ideal_cofactors, int_ideal_cofactors, REAL_IDEAL_CONV, REAL_RING, RING, RING_AND_IDEAL_CONV. \ENDDOC hol-light/Help/reduce_interface.doc000066400000000000000000000011151303454263000176110ustar00rootroot00000000000000\DOC reduce_interface \TYPE {reduce_interface : string * term -> unit} \SYNOPSIS Remove a specific overload/interface mapping for an identifier. \DESCRIBE HOL Light allows an identifier to map to a specific constant (see {override_interface}) or be overloaded to several depending on type (see {overload_interface}). A call to {remove_interface "ident"} removes all such mappings for the identifier {ident}. \FAILURE Never fails, whether or not there were any interface mappings in effect. \SEEALSO overload_interface, override_interface, remove_interface, the_interface. \ENDDOC hol-light/Help/refine.doc000066400000000000000000000010571303454263000155770ustar00rootroot00000000000000\DOC refine \TYPE {refine : refinement -> goalstack} \SYNOPSIS Applies a refinement to the current goalstack. \DESCRIBE The call {refine r} applies the refinement {r} to the current goalstate, adding the resulting goalstate at the head of the current goalstack list. (A goalstate consists of a list of subgoals as well as justification and metavariable information.) \FAILURE Fails if the refinement fails. \COMMENTS Most users will not want to handle refinements explicitly. Usually one just applies a tactic to the first goal in a goalstate. \ENDDOC hol-light/Help/remark.doc000066400000000000000000000012311303454263000156020ustar00rootroot00000000000000\DOC remark \TYPE {remark : string -> unit} \SYNOPSIS Output a string and newline if and only if {verbose} flag is set. \DESCRIBE If the {verbose} flag is set to {true}, then the call {remark s} prints the string {s} and a following newline. If the {verbose} flag is set to {false}, this call does nothing. This function is used for informative output in several automated rules such as {MESON}. \FAILURE Never fails. \EXAMPLE { # remark "Proof is going OK so far";; Proof is going OK so far val it : unit = () # verbose := false;; val it : unit = () # remark "Proof is going OK so far";; val it : unit = () } \SEEALSO report, verbose. \ENDDOC hol-light/Help/remove.doc000066400000000000000000000006421303454263000156230ustar00rootroot00000000000000\DOC remove \TYPE {remove : ('a -> bool) -> 'a list -> 'a * 'a list} \SYNOPSIS Separates the first element of a list to satisfy a predicate from the rest of the list. \FAILURE Fails if no element satisfies the predicate. This will always be the case for an empty list. \EXAMPLE { # remove (fun x -> x >= 3) [1;2;3;4;5;6];; val it : int * int list = (3, [1; 2; 4; 5; 6]) } \SEEALSO partition, filter. \ENDDOC hol-light/Help/remove_interface.doc000066400000000000000000000010751303454263000176440ustar00rootroot00000000000000\DOC remove_interface \TYPE {remove_interface : string -> unit} \SYNOPSIS Remove all overload/interface mappings for an identifier. \DESCRIBE HOL Light allows an identifier to map to a specific constant (see {override_interface}) or be overloaded to several depending on type (see {overload_interface}). A call to {remove_interface "ident"} removes all such mappings for the identifier {ident}. \FAILURE Never fails, whether or not there were any interface mappings in effect. \SEEALSO overload_interface, override_interface, reduce_interface, the_interface. \ENDDOC hol-light/Help/remove_type_abbrev.doc000066400000000000000000000014651303454263000202110ustar00rootroot00000000000000\DOC remove_type_abbrev \TYPE {remove_type_abbrev : string -> unit} \SYNOPSIS Removes use of name as a type abbreviation. \DESCRIBE A call {remove_type_abbrev "s"} removes any use of {s} as a type abbreviation, whether there is one already. Note that since type abbreviations have no logical status, being only a parsing abbreviation, this has no logical significance. \FAILURE Never fails. \EXAMPLE Suppose we set up a type abbreviation: { # new_type_abbrev("btriple",`:bool#bool#bool`);; val it : unit = () # type_abbrevs();; val it : (string * hol_type) list = [("btriple", `:bool#bool#bool`)] } \noindent We can remove it again: { # remove_type_abbrev "btriple";; val it : unit = () # type_abbrevs();; val it : (string * hol_type) list = [] } \SEEALSO new_type_abbrev, type_abbrevs. \ENDDOC hol-light/Help/repeat.doc000066400000000000000000000010641303454263000156050ustar00rootroot00000000000000\DOC repeat \TYPE {repeat : ('a -> 'a) -> 'a -> 'a} \SYNOPSIS Repeatedly apply a function until it fails. \DESCRIBE The call {repeat f x} successively applies {f} over and over again starting with {x}, and stops at the first point when a {Failure _} exception occurs. \FAILURE Never fails. If {f} fails at once it returns {x}. \EXAMPLE { # repeat (snd o dest_forall) `!x y z. x + y + z < 1`;; val it : term = `x + y + z < 1` } \COMMENTS If you know exactly how many times you want to apply it, you may prefer {funpow}. \SEEALSO funpow, fail. \ENDDOC hol-light/Help/replicate.doc000066400000000000000000000004331303454263000162740ustar00rootroot00000000000000\DOC replicate \TYPE {replicate : 'a -> int -> 'a list} \SYNOPSIS Makes a list consisting of a value replicated a specified number of times. \DESCRIBE {replicate x n} returns {[x;...;x]}, a list of length {n}. \FAILURE Fails if number of replications is less than zero. \ENDDOC hol-light/Help/report.doc000066400000000000000000000005321303454263000156370ustar00rootroot00000000000000\DOC report \TYPE {report : string -> unit} \SYNOPSIS Prints a string and a following line break. \DESCRIBE The call {report s} prints the string {s} to the terminal and then a following newline. \FAILURE Never fails. \EXAMPLE { # report "Proof completed OK";; Proof completed OK val it : unit = () } \SEEALSO remark, warn. \ENDDOC hol-light/Help/report_timing.doc000066400000000000000000000014521303454263000172100ustar00rootroot00000000000000\DOC report_timing \TYPE {report_timing : bool ref} \SYNOPSIS Flag to determine whether {time} function outputs CPU time measure. \DESCRIBE When {report_timing} is true, a call {time f x} will evaluate {f x} as usual but also as a side-effect print out the CPU time taken. If {report_timing} is false, nothing will be printed. Times are already printed in this way automatically as informative output in some rules like {MESON}, so this can be used to silence them. \FAILURE Not applicable. \EXAMPLE { # time NUM_REDUCE_CONV `2 EXP 300 < 2 EXP 200`;; CPU time (user): 0.13 val it : thm = |- 2 EXP 300 < 2 EXP 200 <=> F # report_timing := false;; val it : unit = () # time NUM_REDUCE_CONV `2 EXP 300 < 2 EXP 200`;; val it : thm = |- 2 EXP 300 < 2 EXP 200 <=> F } \SEEALSO time. \ENDDOC hol-light/Help/reserve_words.doc000066400000000000000000000010331303454263000172120ustar00rootroot00000000000000\DOC reserve_words \TYPE {reserve_words : string list -> unit} \SYNOPSIS Add given strings to the set of reserved words. \DESCRIBE Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', meaning that they are special to the parser and cannot be used as ordinary identifiers. A call {reserve_words l} adds all strings in {l} to the list of reserved identifiers. \FAILURE Never fails, regardless of whether the given strings were already reserved. \SEEALSO is_reserved_word, reserved_words, unreserve_words. \ENDDOC hol-light/Help/reserved_words.doc000066400000000000000000000011771303454263000173670ustar00rootroot00000000000000\DOC reserved_words \TYPE {reserved_words : unit -> string list} \SYNOPSIS Returns the list of reserved words. \DESCRIBE Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', meaning that they are special to the parser and cannot be used as ordinary identifiers. The call {reserved_words()} returns a list of such identifiers. \FAILURE Never fails. \EXAMPLE In the default HOL state: { # reserved_words();; val it : string list = ["("; ")"; "["; "]"; "{"; "}"; ":"; ";"; "."; "|"; "let"; "in"; "and"; "if"; "then"; "else"; "//"] } \SEEALSO is_reserved_word, reserve_words, unreserve_words. \ENDDOC hol-light/Help/retypecheck.doc000066400000000000000000000013461303454263000166360ustar00rootroot00000000000000\DOC retypecheck \TYPE {retypecheck : (string * pretype) list -> preterm -> preterm} \SYNOPSIS Typecheck a term, iterating over possible overload resolutions. \DESCRIBE This is the main HOL Light typechecking function. Given an environment {env} of pretype assignments for variables, it assigns a pretype to all variables and constants, including performing resolution of overloaded constants based on what type information there is. Normally, this happens implicitly when a term is entered in the quotation parser. \FAILURE Fails if some terms cannot be consistently assigned a type. \COMMENTS Only users seeking to change HOL's parser and typechecker quite radically need to use this function. \SEEALSO term_of_preterm. \ENDDOC hol-light/Help/rev.doc000066400000000000000000000002541303454263000151210ustar00rootroot00000000000000\DOC rev \TYPE {rev : 'a list -> 'a list} \SYNOPSIS Reverses a list. \KEYWORDS list. \DESCRIBE {rev [x1;...;xn]} returns {[xn;...;x1]}. \FAILURE Never fails. \ENDDOC hol-light/Help/rev_assoc.doc000066400000000000000000000010221303454263000163030ustar00rootroot00000000000000\DOC rev_assoc \TYPE {rev_assoc : 'a -> ('b * 'a) list -> 'b} \SYNOPSIS Searches a list of pairs for a pair whose second component equals a specified value. \KEYWORDS list. \DESCRIBE {rev_assoc y [(x1,y1);...;(xn,yn)]} returns the first {xi} in the list such that {yi} equals {y}. \FAILURE Fails if no matching pair is found. This will always be the case if the list is empty. \EXAMPLE { # rev_assoc 2 [(1,4);(3,2);(2,5);(2,6)];; val it : int = 3 } \SEEALSO assoc, find, mem, tryfind, exists, forall. \ENDDOC hol-light/Help/rev_assocd.doc000066400000000000000000000012471303454263000164600ustar00rootroot00000000000000\DOC rev_assocd \TYPE {rev_assocd : 'a -> ('b * 'a) list -> 'b -> 'b} \SYNOPSIS Looks up item in association list taking default in case of failure. \DESCRIBE The call {rev_assocd y [x1,y1; ...; xn,yn] x} returns the first {xi} in the list where the corresponding {yi} is the same as {y}. If there is no such item, it returns the value {x}. This is similar to {rev_assoc} except that the latter will fail rather than take a default. \FAILURE Never fails. \EXAMPLE { # rev_assocd 6 [1,2; 2,4; 3,6] (-1);; val it : int = 3 # rev_assocd 8 [1,2; 2,4; 3,6] (-1);; val it : int = -1 } \USES Simple lookup without exception handling. \SEEALSO assocd, rev_assoc. \ENDDOC hol-light/Help/rev_itlist.doc000066400000000000000000000006771303454263000165220ustar00rootroot00000000000000\DOC rev_itlist \TYPE {rev_itlist : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b} \SYNOPSIS Applies a binary function between adjacent elements of the reverse of a list. \KEYWORDS list. \DESCRIBE {rev_itlist f [x1;...;xn] y} returns {f xn ( ... (f x2 (f x1 y))...)}. It returns {y} if the list is empty. \FAILURE Never fails. \EXAMPLE { # rev_itlist (fun x y -> x * y) [1;2;3;4] 1;; val it : int = 24 } \SEEALSO itlist, end_itlist. \ENDDOC hol-light/Help/rev_itlist2.doc000066400000000000000000000013001303454263000165640ustar00rootroot00000000000000\DOC rev_itlist2 \TYPE {rev_itlist2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c} \SYNOPSIS Applies a paired function between adjacent elements of 2 lists. \KEYWORDS list. \DESCRIBE {itlist2 f ([x1;...;xn],[y1;...;yn]) z} returns { f xn yn ( ... (f x2 y2 (f x1 y1 z))...)}. } \noindent It returns {z} if both lists are empty. \FAILURE Fails if the two lists are of different lengths. \EXAMPLE This takes a `dot product' of two vectors of integers: { # let dot v w = rev_itlist2 (fun x y z -> x * y + z) v w 0;; val dot : int list -> int list -> int = # dot [1;2;3] [4;5;6];; val it : int = 32 } \SEEALSO itlist, rev_itlist, rev_itlist2, end_itlist, uncurry. \ENDDOC hol-light/Help/rev_splitlist.doc000066400000000000000000000012671303454263000172350ustar00rootroot00000000000000\DOC rev_splitlist \TYPE {rev_splitlist : ('a -> 'a * 'b) -> 'a -> 'a * 'b list} \SYNOPSIS Applies a binary destructor repeatedly in right-associative mode. \DESCRIBE If a destructor function {d} inverts a binary constructor {f}, for example {dest_comb} for {mk_comb}, and fails when applied to {y}, then: { rev_splitlist d f(...(f(f(w,x1),x2),...xn) } \noindent returns { (w,[x1; ... ; xn]) } \FAILURE Never fails. \EXAMPLE The function {strip_comb} is actually just defined as {rev_splitlist dest_comb}, which acts as follows: { # rev_splitlist dest_comb `x + 1 + 2`;; val it : term * term list = (`(+)`, [`x`; `1 + 2`]) } \SEEALSO itlist, nsplit, splitlist, striplist. \ENDDOC hol-light/Help/reverse_interface_mapping.doc000066400000000000000000000024731303454263000215400ustar00rootroot00000000000000\DOC reverse_interface_mapping \TYPE {reverse_interface_mapping : bool ref} \SYNOPSIS Determines whether interface map is printed on output (default {true}). \DESCRIBE The reference variable {reverse_interface_mapping} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic printing of terms and theorems at the toplevel. When {reverse_interface_mapping} is {true} (as it is by default), the front-end interface map for a constant or variable is printed. When it is {false}, the core constant or variable is printed. \FAILURE Not applicable. \EXAMPLE Here is a simple library theorem about real numbers as it usually appears: { # reverse_interface_mapping := true;; val it : unit = () # REAL_EQ_SUB_LADD;; val it : thm = |- !x y z. x = y - z <=> x + z = y } \noindent but with another setting of {reverse_interface_mapping} we see that the usual symbol `{+}' is an interface for {real_add}, while the `iff' sign is just an interface for Boolean equality: { # reverse_interface_mapping := false;; val it : unit = () # REAL_EQ_SUB_LADD;; val it : thm = |- !x y z. (x = real_sub y z) = real_add x z = y } \SEEALSO pp_print_term, prebroken_binops, print_all_thm, print_unambiguous_comprehensions, the_interface, typify_universal_set, unspaced_binops. \ENDDOC hol-light/Help/rhs.doc000066400000000000000000000004371303454263000151240ustar00rootroot00000000000000\DOC rhs \TYPE {rhs : term -> term} \SYNOPSIS Returns the right-hand side of an equation. \DESCRIBE {rhs `t1 = t2`} returns {`t2`}. \FAILURE Fails with {rhs} if term is not an equality. \EXAMPLE { # rhs `2 + 2 = 4`;; val it : term = `4` } \SEEALSO dest_eq, lhs, rand. \ENDDOC hol-light/Help/rightbin.doc000066400000000000000000000030211303454263000161260ustar00rootroot00000000000000\DOC rightbin \TYPE {rightbin : ('a -> 'b * 'c) -> ('c -> 'd * 'a) -> ('d -> 'b -> 'b -> 'b) -> string -> 'a -> 'b * 'c} \SYNOPSIS Parses iterated right-associated binary operator. \DESCRIBE If {p} is a parser for ``items'' of some kind, {s} is a parser for some ``separator'', {c} is a `constructor' function taking an element as parsed by {s} and two other elements as parsed by {p} and giving a new such element, and {e} is an error message, then {rightbin p s c e} will parse an iterated sequence of items by {p} and separated by something parsed with {s}. It will repeatedly apply the constructor function {c} to compose these elements into one, associating to the right. For example, the input: { } meaning successive segments {pi} that are parsed by {p} and {sj} that are parsed by {s}, will result in { c s1 c1 (c s2 p2 (c s3 p3 p4)) } \FAILURE The call {rightbin p s c e} never fails, though the resulting parser may. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, leftbin, listof, many, nothing, possibly, some. \ENDDOC hol-light/Help/rotate.doc000066400000000000000000000005501303454263000156220ustar00rootroot00000000000000\DOC rotate \TYPE {rotate : int -> refinement} \SYNOPSIS Rotate a goalstate. \DESCRIBE The function {rotate n gl} rotates a list {gl} of subgoals by {n} places. The function {r} is the special case where this modification is applied to the imperative variable of unproven subgoals. \FAILURE Fails only if the list of goals is empty. \SEEALSO r. \ENDDOC hol-light/Help/search.doc000066400000000000000000000047541303454263000156030ustar00rootroot00000000000000\DOC search \TYPE {search : term list -> (string * thm) list} \SYNOPSIS Search the database of theorems according to query patterns. \DESCRIBE The {search} function is intended to locate a desired theorem by searching based on term patterns or names. The database of theorems to be searched is held in {theorems}, which initially contains all theorems individually bound to OCaml identifiers in the main system, and can be augmented or otherwise modified by the user. (See in particular the update script in {update_database.ml} which creates a database according to the current OCaml environment.) The input to {search} is a list of terms that are treated as patterns. Normally, a term {pat} is interpreted as a search for `a theorem with any subterm of the form {pat}', e.g. a pattern {x + y} for any subterm of the form {s + t}. However, several syntax functions create composite terms that are interpreted specially by {search}: \begin{{itemize}} \item {omit pat} --- Search for theorems {{\em not}} satisfying {pat} \item {exactly `t`} --- Search for theorems with subterms alpha-equivalent to {t} (not just of the general form {t}) \item {name "str"} --- Search for theorems whose name contains {str} as a substring. \end{{itemize}} \FAILURE Never fails. \EXAMPLE Search for theorems with a subterm of the form {s <= t / u}: { # search [`x <= y / z`];; val it : (string * thm) list = [("RAT_LEMMA4", |- &0 < y1 /\ &0 < y2 ==> (x1 / y1 <= x2 / y2 <=> x1 * y2 <= x2 * y1)); ("REAL_LE_DIV", |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x / y); ("REAL_LE_DIV2_EQ", |- !x y z. &0 < z ==> (x / z <= y / z <=> x <= y)); ("REAL_LE_RDIV_EQ", |- !x y z. &0 < z ==> (x <= y / z <=> x * z <= y)); ("SUM_BOUND_GEN", |- !s t b. FINITE s /\ ~(s = {{}}) /\ (!x. x IN s ==> f x <= b / &(CARD s)) ==> sum s f <= b)] } Search for theorems whose name contains {"CROSS"} and whose conclusion involves the cardinality function {CARD}: { # search [name "CROSS"; `CARD`];; Warning: inventing type variables val it : (string * thm) list = [("CARD_CROSS", |- !s t. FINITE s /\ FINITE t ==> CARD (s CROSS t) = CARD s * CARD t)] } Search for theorems that involve finiteness of the image of a set under a function, but also do not involve logical equivalence: { # search [`FINITE(IMAGE f s)`; omit `(<=>)`];; Warning: inventing type variables val it : (string * thm) list = [("FINITE_IMAGE", |- !f s. FINITE s ==> FINITE (IMAGE f s))] } \SEEALSO theorems. \ENDDOC hol-light/Help/self_destruct.doc000066400000000000000000000044571303454263000172040ustar00rootroot00000000000000\DOC self_destruct \TYPE {self_destruct : string -> unit} \SYNOPSIS Exits HOL Light but saves current state ready to restart. \DESCRIBE This operation is only available in HOL images created using checkpointing (as in the default Linux build arising from {make all}), not when the HOL Light sources have simply been loaded into the OCaml toplevel without checkpointing. A call {self_destruct s} will exit the current OCaml / HOL Light session, but save the current state to an image {hol.snapshot}. Users can then start this image; it will display the usual banner and also the string {s}, and the user will then be in the same state as before {self_destruct}. \FAILURE Never fails, except in the face of OS-level problems such as running out of disc space. \USES Very useful to start HOL Light quickly with many background theories or tools loaded, rather than needing to rebuild them from sources. \COMMENTS Unfortunately I do not know of any checkpointing tool that can give this behaviour under Windows or Mac OS X. See the README file and tutorial for additional information on Linux checkpointing options. \EXAMPLE Suppose that all the proofs you are doing at the moment need more theorems about prime numbers, and also a list of all prime numbers up to 1000. We reach a suitable state: { # needs "Library/prime.ml";; ... # let primes_1000 = rev(rev_itlist (fun q ps -> if exists (fun p -> q mod p = 0) ps then ps else q::ps) (2--1000) []);; ... } \noindent and now issue the checkpointing command: { self_destruct "Preloaded with prime number material";; } HOL Light will exit and a new file {hol.snapshot} will be created. You might want to rename it as {hol.prime} in the OS so it has a more intuitive name and doesn't get overwritten by later checkpoints { $ mv hol.snapshot hol.prime } \noindent You can then start the new image just by {hol.prime}: { $ hol.prime HOL Light 2.10, built 16 March 2006 on OCaml 3.08.3 Preloaded with prime number material val it : unit = () # } \noindent and continue where you left off, with all the prime-number material available instantly: { # PRIME_DIVPROD;; val it : thm = |- !p a b. prime p /\ p divides a * b ==> p divides a \/ p divides b # el 100 primes_1000;; val it : int = 547 } \SEEALSO checkpoint, startup_banner. \ENDDOC hol-light/Help/set_basic_congs.doc000066400000000000000000000013331303454263000174510ustar00rootroot00000000000000\DOC set_basic_congs \TYPE {set_basic_congs : thm list -> unit} \SYNOPSIS Change the set of basic congruences used by the simplifier. \DESCRIBE The HOL Light simplifier (as invoked by {SIMP_TAC} etc.) uses congruence rules to determine how it uses context when descending through a term. These are essentially theorems showing how to decompose one equality to a series of other inequalities in context. A call to {set_basic_congs thl} sets the congruence rules to the list of theorems {thl}. \FAILURE Never fails. \COMMENTS Normally, users only need to extend the congruences; for an example of how to do that see {extend_basic_congs}. \SEEALSO basic_congs, extend_basic_congs, SIMP_CONV, SIMP_RULE, SIMP_TAC. \ENDDOC hol-light/Help/set_basic_convs.doc000066400000000000000000000016621303454263000174750ustar00rootroot00000000000000\DOC set_basic_convs \TYPE {set_basic_convs : (string * (term * conv)) list -> unit} \SYNOPSIS Assign the set of default conversions. \DESCRIBE The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. The latter are normally term transformations that cannot be expressed as single (conditional or unconditional) rewrite rules. A call to {set_basic_convs l} where {l} is a list of items ("name",(`pat`,conv)) will make the default conversions just that set, using the name {name} to refer to each one and restricting it to subterms encountered that match {pat}. \FAILURE Never fails. \COMMENTS Normally, users will only want to extend the existing set of conversions using {extend_basic_convs}. \SEEALSO basic_convs, extend_basic_convs, set_basic_rewrites, REWRITE_TAC, SIMP_TAC. \ENDDOC hol-light/Help/set_basic_rewrites.doc000066400000000000000000000013511303454263000202040ustar00rootroot00000000000000\DOC set_basic_rewrites \TYPE {set_basic_rewrites : thm list -> unit} \SYNOPSIS Assign the set of default rewrites used by rewriting and simplification. \DESCRIBE The HOL Light rewriter ({REWRITE_TAC} etc.) and simplifier ({SIMP_TAC} etc.) have default sets of (conditional) equations and other conversions that are applied by default, except in the {PURE_} variants. A call to {extend_basic_rewrites thl} sets this to be the list of theorems {thl} (after processing into rewrite rules by {mk_rewrites}). \FAILURE Never fails. \COMMENTS Users will most likely want to extend the existing set by {extend_basic_rewrites} rather than completely change it like this. \SEEALSO basic_rewrites, extend_basic_convs, set_basic_convs. \ENDDOC hol-light/Help/set_eq.doc000066400000000000000000000010401303454263000155770ustar00rootroot00000000000000\DOC set_eq \TYPE {set_eq : 'a list -> 'a list -> bool} \SYNOPSIS Tests two `sets' for equality. \DESCRIBE {set_eq l1 l2} returns {true} if every element of {l1} appears in {l2} and every element of {l2} appears in {l1}. Otherwise it returns {false}. In other words, it tests if the lists are the same considered as sets, i.e. ignoring duplicates. \FAILURE Never fails. \EXAMPLE { # set_eq [1;2] [2;1;2];; val it : bool = true # set_eq [1;2] [1;3];; val it : bool = false } \SEEALSO setify, union, intersect, subtract. \ENDDOC hol-light/Help/set_goal.doc000066400000000000000000000036701303454263000161270ustar00rootroot00000000000000\DOC set_goal \TYPE {set_goal : term list * term -> goalstack} \SYNOPSIS Initializes the subgoal package with a new goal. \DESCRIBE The function {set_goal} initializes the subgoal management package. A proof state of the package consists of either a goal stack and a justification stack if a proof is in progress, or a theorem if a proof has just been completed. {set_goal} sets a new proof state consisting of an empty justification stack and a goal stack with the given goal as its sole goal. The goal is printed. \FAILURE Fails unless all terms in the goal are of type {bool}. \EXAMPLE { # set_goal([], `(HD[1;2;3] = 1) /\ (TL[1;2;3] = [2;3])`);; val it : goalstack = 1 subgoal (1 total) `HD [1; 2; 3] = 1 /\ TL [1; 2; 3] = [2; 3]` } \USES Starting an interactive proof session with the subgoal package. The subgoal package implements a simple framework for interactive goal-directed proof. When conducting a proof that involves many subgoals and tactics, the user must keep track of all the justifications and compose them in the correct order. While this is feasible even in large proofs, it is tedious. The subgoal package provides a way of building and traversing the tree of subgoals top-down, stacking the justifications and applying them properly. The package maintains a proof state consisting of either a goal stack of outstanding goals and a justification stack, or a theorem. Tactics are used to expand the current goal (the one on the top of the goal stack) into subgoals and justifications. These are pushed onto the goal stack and justification stack, respectively, to form a new proof state. All preceding proof states are saved and can be returned to if a mistake is made in the proof. The goal stack is divided into levels, a new level being created each time a tactic is successfully applied to give new subgoals. The subgoals of the current level may be considered in any order. \SEEALSO b, e, g, p, r, top_goal, top_thm. \ENDDOC hol-light/Help/setify.doc000066400000000000000000000007541303454263000156350ustar00rootroot00000000000000\DOC setify \TYPE {setify : 'a list -> 'a list} \SYNOPSIS Removes repeated elements from a list. Makes a list into a `set'. \DESCRIBE {setify l} removes repeated elements from {l}, leaving the last occurrence of each duplicate in the list. \FAILURE Never fails. \EXAMPLE { # setify [1;2;3;1;4;3];; val it : int list = [1; 2; 3; 4] } \COMMENTS The current implementation will in fact return a sorted list according to the basic OCaml polymorphic ordering. \SEEALSO uniq. \ENDDOC hol-light/Help/shareout.doc000066400000000000000000000013011303454263000161510ustar00rootroot00000000000000\DOC shareout \TYPE {shareout : 'a list list -> 'b list -> 'b list list} \SYNOPSIS Shares out the elements of the second list according to pattern in first. \DESCRIBE The call {shareout pat l} shares out the elements of {l} into the same groups as the pattern list {pat}, while keeping them in the same order. If there are more elements in {l} than needed, they will be discarded, but if there are fewer, failure will occur. \FAILURE Fails if there are too few elements in the second list. \EXAMPLE { # shareout [[1;2;3]; [4;5]; [6]; [7;8;9]] (explode "abcdefghijklmnopq");; val it : string list list = [["a"; "b"; "c"]; ["d"; "e"]; ["f"]; ["g"; "h"; "i"]] } \SEEALSO chop_list. \ENDDOC hol-light/Help/some.doc000066400000000000000000000017041303454263000152710ustar00rootroot00000000000000\DOC some \TYPE {some : ('a -> bool) -> 'a list -> 'a * 'a list} \SYNOPSIS Parses any single item satisfying a predicate. \DESCRIBE If {p} is a predicate on input tokens of some kind, {some p} is a parser that parses and returns any first token satisfying the predicate {p}, and raises {Noparse} on a first token not satisfying {p}. \FAILURE The call {some p} never fails. \COMMENTS This is one of a suite of combinators for manipulating ``parsers''. A parser is simply a function whose OCaml type is some instance of {:('a)list -> 'b * ('a)list}. The function should take a list of objects of type {:'a} (e.g. characters or tokens), parse as much of it as possible from left to right, and return a pair consisting of the object derived from parsing (e.g. a term or a special syntax tree) and the list of elements that were not processed. \SEEALSO ++, |||, >>, a, atleast, elistof, finished, fix, leftbin, listof, many, nothing, possibly, rightbin. \ENDDOC hol-light/Help/sort.doc000066400000000000000000000035611303454263000153200ustar00rootroot00000000000000\DOC sort \TYPE {sort : ('a -> 'a -> bool) -> 'a list -> 'a list} \SYNOPSIS Sorts a list using a given transitive `ordering' relation. \DESCRIBE The call { sort op list } \noindent where {op} is a transitive relation on the elements of {list}, will topologically sort the list, i.e. will permute it such that if {x op y} but not {y op x} then {x} will occur to the left of {y} in the sorted list. In particular if {op} is a total order, the list will be sorted in the usual sense of the word. \FAILURE Never fails. \EXAMPLE A simple example is: { # sort (<) [3; 1; 4; 1; 5; 9; 2; 6; 5; 3; 5; 8; 9; 7; 9];; val it : int list = [1; 1; 2; 3; 3; 4; 5; 5; 5; 6; 7; 8; 9; 9; 9] } \noindent The following example is a little more complicated, and shows how a topological sorting under the relation `is free in' can be achieved. This is actually sometimes useful to consider subterms of a term in an appropriate order: { # sort free_in [`(x + 1) + 2`; `x + 2`; `x:num`; `x + 1`; `1`];; val it : term list = [`1`; `x`; `x + 1`; `x + 2`; `(x + 1) + 2`] } \COMMENTS This function uses the Quicksort algorithm internally, which has good typical-case performance and will sort topologically. However, its worst-case performance is quadratic. By contrast {mergesort} gives a good worst-case performance but requires a total order. Note that any comparison-based topological sorting function must have quadratic behaviour in the worst case. For an $n$-element list, there are $n (n - 1) / 2$ pairs. For any topological sorting algorithm, we can make sure the first $n (n - 1) / 2 - 1$ pairs compared are unrelated in either direction, while still leaving the option of choosing for the last pair $(a,b)$ either $a < b$ or $b < a$, eventually giving a partial order. So at least $n (n - 1) / 2$ comparisons are needed to distinguish these two partial orders correctly. \SEEALSO mergesort. \ENDDOC hol-light/Help/splitlist.doc000066400000000000000000000012741303454263000163570ustar00rootroot00000000000000\DOC splitlist \TYPE {splitlist : ('a -> 'b * 'a) -> 'a -> 'b list * 'a} \SYNOPSIS Applies a binary destructor repeatedly in left-associative mode. \DESCRIBE If a destructor function {d} inverts a binary constructor {f}, for example {dest_comb} for {mk_comb}, and fails when applied to {y}, then: { splitlist d (f(x1,f(x2,f(...f(xn,y))))) } \noindent returns { ([x1; ... ; xn],y) } \FAILURE Never fails. \EXAMPLE The function {strip_forall} is actually just defined as {splitlist dest_forall}, which acts as follows: { # splitlist dest_forall `!x y z. x + y = z`;; val it : term list * term = ([`x`; `y`; `z`], `x + y = z`) } \SEEALSO itlist, nsplit, rev_splitlist, striplist. \ENDDOC hol-light/Help/ss_of_congs.doc000066400000000000000000000015061303454263000166300ustar00rootroot00000000000000\DOC ss_of_congs \TYPE {ss_of_congs : thm list -> simpset -> simpset} \SYNOPSIS Add congruence rules to a simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and unconditional rewrite rules, conversions and provers for conditions, as well as a determination of how to use the prover on the conditions and how to process theorems into rewrites. A call {ss_of_congs thl ss} adds {thl} as new congruence rules to the simpset {ss} to yield a new simpset. For an illustration of how congruence rules can be used, see {extend_basic_congs}. \FAILURE Never fails unless the congruence rules are malformed. \SEEALSO mk_rewrites, SIMP_CONV, ss_of_conv, ss_of_maker, ss_of_prover, ss_of_provers, ss_of_thms. \ENDDOC hol-light/Help/ss_of_conv.doc000066400000000000000000000015401303454263000164620ustar00rootroot00000000000000\DOC ss_of_conv \TYPE {ss_of_conv : term -> conv -> simpset -> simpset} \SYNOPSIS Add a new conversion to a simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and unconditional rewrite rules, conversions and provers for conditions, as well as a determination of how to use the prover on the conditions and how to process theorems into rewrites. A call {ss_of_conv pat cnv ss} adds the conversion {cnv} to the simpset {ss} to yield a new simpset, restricting the initial filtering of potential subterms to those matching {pat}. \FAILURE Never fails. \EXAMPLE { # ss_of_conv `x + y:num` NUM_ADD_CONV empty_ss;; ... } \SEEALSO mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_maker, ss_of_prover, ss_of_provers, ss_of_thms. \ENDDOC hol-light/Help/ss_of_maker.doc000066400000000000000000000016521303454263000166200ustar00rootroot00000000000000\DOC ss_of_maker \TYPE {ss_of_maker : (thm -> thm list -> thm list) -> simpset -> simpset} \SYNOPSIS Change the rewrite maker in a simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and unconditional rewrite rules, conversions and provers for conditions, as well as a determination of how to use the prover on the conditions and how to process theorems into rewrites. A call {ss_of_maker maker ss} changes the ``rewrite maker'' in {ss} to yield a new simpset; use of this simpset with additional theorems will process those theorems using the new rewrite maker. The default rewrite maker is {mk_rewrites} with an appropriate flag, and it is unusual to want to change it. \FAILURE Never fails. \SEEALSO mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_prover, ss_of_provers, ss_of_thms. \ENDDOC hol-light/Help/ss_of_prover.doc000066400000000000000000000016061303454263000170350ustar00rootroot00000000000000\DOC ss_of_prover \TYPE {ss_of_prover : (strategy -> strategy) -> simpset -> simpset} \SYNOPSIS Change the method of prover application in a simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and unconditional rewrite rules, conversions and provers for conditions, as well as a determination of how to use the prover on the conditions and how to process theorems into rewrites. The default `prover use' method is to first recursively apply all the simplification to conditions and then try the provers, if any, one by one until one succeeds. It is unusual to want to change this, but if desired you can do it with {ss_of_prover str ss}. \FAILURE Never fails. \SEEALSO mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_maker, ss_of_provers, ss_of_thms. \ENDDOC hol-light/Help/ss_of_provers.doc000066400000000000000000000014421303454263000172160ustar00rootroot00000000000000\DOC ss_of_provers \TYPE {ss_of_provers : prover list -> simpset -> simpset} \SYNOPSIS Add new provers to a simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and unconditional rewrite rules, conversions and provers for conditions, as well as a determination of how to use the prover on the conditions and how to process theorems into rewrites. A call {ss_of_provers prs ss} adds the provers in {prs} to the simpset {ss} to yield a new simpset. See {mk_prover} for more explanation of how to create something of type {prover}. \FAILURE Never fails. \SEEALSO mk_prover, mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_maker, ss_of_prover, ss_of_thms. \ENDDOC hol-light/Help/ss_of_thms.doc000066400000000000000000000015251303454263000164730ustar00rootroot00000000000000\DOC ss_of_thms \TYPE {ss_of_thms : thm list -> simpset -> simpset} \SYNOPSIS Add theorems to a simpset. \DESCRIBE In their maximal generality, simplification operations in HOL Light (as invoked by {SIMP_TAC}) are controlled by a `simpset', which may contain conditional and unconditional rewrite rules, conversions and provers for conditions, as well as a determination of how to use the prover on the conditions and how to process theorems into rewrites. A call {ss_of_thms thl ss} processes the theorems {thl} according to the rewrite maker in the simpset {ss} (normally {mk_rewrites}) and adds them to the theorems in {ss} to yield a new simpset. \FAILURE Never fails. \EXAMPLE { # ss_of_thms [ADD_CLAUSES] empty_ss;; ... } \SEEALSO mk_rewrites, SIMP_CONV, ss_of_congs, ss_of_conv, ss_of_maker, ss_of_prover, ss_of_provers. \ENDDOC hol-light/Help/startup_banner.doc000066400000000000000000000012661303454263000173600ustar00rootroot00000000000000\DOC startup_banner \TYPE {startup_banner : string} \SYNOPSIS The one-line startup banner for HOL Light. \DESCRIBE This string is the startup banner for HOL Light, and is displayed when standalone images (see {self_destruct}) are started up. It is only available in HOL images created using checkpointing (as in the default Linux build arising from {make all}), not when the HOL Light sources have simply been loaded into the OCaml toplevel without checkpointing. \FAILURE Not applicable. \EXAMPLE On my home computer, the value is currently: { # startup_banner;; val it : string = " HOL Light 2.10, built 16 March 2006 on OCaml 3.08.3" } \SEEALSO self_destruct. \ENDDOC hol-light/Help/string_of_file.doc000066400000000000000000000012201303454263000173100ustar00rootroot00000000000000\DOC string_of_file \TYPE {string_of_file : string -> string} \SYNOPSIS Read file and convert content into a string. \DESCRIBE When given a filename, the function {strings_of_file} attempts to open the file for input, and if this is successful reads and closes it, returning the contents as a single string. \FAILURE Fails if the file cannot be opened (e.g. it does not exist, or the permissions are wrong). \EXAMPLE If the file {/tmp/greeting} contains the text { Hello world Goodbye world } \noindent then { # string_of_file "/tmp/greeting";; val it : string = "Hello world\nGoodbye world" } \SEEALSO file_of_string, strings_of_file. \ENDDOC hol-light/Help/string_of_term.doc000066400000000000000000000011361303454263000173460ustar00rootroot00000000000000\DOC string_of_term \TYPE {string_of_term : term -> string} \SYNOPSIS Converts a HOL term to a string representation. \DESCRIBE The call {string_of_term tm} produces a textual representation of the term {tm} as a string, similar to what is printed automatically at the toplevel, though without the surrounding quotes. \FAILURE Never fails. \EXAMPLE { # string_of_term `x + 1 < 2 <=> x = 0`;; val it : string = "x + 1 < 2 <=> x = 0" } \COMMENTS The string may contain newlines for large terms, broken in a similar fashion to automatic printing. \SEEALSO string_of_thm, string_of_type. \ENDDOC hol-light/Help/string_of_thm.doc000066400000000000000000000015041303454263000171660ustar00rootroot00000000000000\DOC string_of_thm \TYPE {string_of_thm : thm -> string} \SYNOPSIS Converts a HOL theorem to a string representation. \DESCRIBE The call {string_of_thm th} produces a textual representation of the theorem {th} as a string, similar to what is printed automatically at the toplevel. \FAILURE Never fails. \EXAMPLE { # string_of_thm ADD_CLAUSES;; val it : string = "|- (!n. 0 + n = n) /\\\n (!m. m + 0 = m) /\\\n (!m n. SUC m + n = SUC (m + n)) /\\\n (!m n. m + SUC n = SUC (m + n))" # print_string it;; |- (!n. 0 + n = n) /\ (!m. m + 0 = m) /\ (!m n. SUC m + n = SUC (m + n)) /\ (!m n. m + SUC n = SUC (m + n)) val it : unit = () } \COMMENTS The string may contain newlines for large terms, broken in a similar fashion to automatic printing. \SEEALSO string_of_thm, string_of_type. \ENDDOC hol-light/Help/string_of_type.doc000066400000000000000000000007401303454263000173600ustar00rootroot00000000000000\DOC string_of_type \TYPE {string_of_type : hol_type -> string} \SYNOPSIS Converts a HOL type to a string representation. \DESCRIBE The call {string_of_type ty} produces a textual representation of the type {ty} as a string, similar to what is printed automatically at the toplevel, though without the surrounding quotes and colon. \FAILURE Never fails. \EXAMPLE { # string_of_type bool_ty;; val it : string = "bool" } \SEEALSO string_of_term, string_of_thm. \ENDDOC hol-light/Help/strings_of_file.doc000066400000000000000000000013031303454263000174750ustar00rootroot00000000000000\DOC strings_of_file \TYPE {strings_of_file : string -> string list} \SYNOPSIS Read file and convert content into a list of strings. \DESCRIBE When given a filename, the function {strings_of_file} attempts to open the file for input, and if this is successful reads and closes it, returning a list of strings corresponding to the lines in the file. \FAILURE Fails if the file cannot be opened (e.g. it does not exist, or the permissions are wrong). \EXAMPLE If the file {/tmp/greeting} contains the text { Hello world Goodbye world } \noindent then { # strings_of_file "/tmp/greeting";; val it : string list = ["Hello world"; "Goodbye world"] } \SEEALSO file_of_string, string_of_file. \ENDDOC hol-light/Help/strip_abs.doc000066400000000000000000000007641303454263000163210ustar00rootroot00000000000000\DOC strip_abs \TYPE {strip_abs : term -> term list * term} \SYNOPSIS Iteratively breaks apart abstractions. \DESCRIBE {strip_abs `\x1 ... xn. t`} returns {([`x1`;...;`xn`],`t`)}. Note that { strip_abs(list_mk_abs([`x1`;...;`xn`],`t`)) } \noindent will not return {([`x1`;...;`xn`],`t`)} if {t} is an abstraction. \FAILURE Never fails. \EXAMPLE { # strip_abs `\x y z. x /\ y /\ z`;; val it : term list * term = ([`x`; `y`; `z`], `x /\ y /\ z`) } \SEEALSO list_mk_abs, dest_abs. \ENDDOC hol-light/Help/strip_comb.doc000066400000000000000000000011141303454263000164620ustar00rootroot00000000000000\DOC strip_comb \TYPE {strip_comb : term -> term * term list} \SYNOPSIS Iteratively breaks apart combinations (function applications). \DESCRIBE {strip_comb `t t1 ... tn`} returns {(`t`,[`t1`;...;`tn`])}. Note that { strip_comb(list_mk_comb(`t`,[`t1`;...;`tn`])) } \noindent will not return {(`t`,[`t1`;...;`tn`])} if {t} is a combination. \FAILURE Never fails. \EXAMPLE { # strip_comb `x /\ y`;; val it : term * term list = (`(/\)`, [`x`; `y`]) # strip_comb `T`;; val it : term * term list = (`T`, []) } \SEEALSO dest_comb, list_mk_comb, splitlist, striplist. \ENDDOC hol-light/Help/strip_exists.doc000066400000000000000000000006641303454263000170720ustar00rootroot00000000000000\DOC strip_exists \TYPE {strip_exists : term -> term list * term} \SYNOPSIS Iteratively breaks apart existential quantifications. \DESCRIBE {strip_exists `?x1 ... xn. t`} returns {([`x1`;...;`xn`],`t`)}. Note that { strip_exists(list_mk_exists([`x1`;...;`xn`],`t`)) } \noindent will not return {([`x1`;...;`xn`],`t`)} if {t} is an existential quantification. \FAILURE Never fails. \SEEALSO dest_exists, list_mk_exists. \ENDDOC hol-light/Help/strip_forall.doc000066400000000000000000000006571303454263000170340ustar00rootroot00000000000000\DOC strip_forall \TYPE {strip_forall : term -> term list * term} \SYNOPSIS Iteratively breaks apart universal quantifications. \DESCRIBE {strip_forall `!x1 ... xn. t`} returns {([`x1`;...;`xn`],`t`)}. Note that { strip_forall(list_mk_forall([`x1`;...;`xn`],`t`)) } \noindent will not return {([`x1`;...;`xn`],`t`)} if {t} is a universal quantification. \FAILURE Never fails. \SEEALSO dest_forall, list_mk_forall. \ENDDOC hol-light/Help/strip_gabs.doc000066400000000000000000000013061303454263000164610ustar00rootroot00000000000000\DOC strip_gabs \TYPE {strip_gabs : term -> term list * term} \SYNOPSIS Breaks apart an iterated generalized or basic abstraction. \DESCRIBE If the term {t} is iteratively constructed by basic or generalized abstractions, i.e. is of the form {\vs1. \vs2. ... \vsn. t}, then the call {strip_gabs t} returns a pair of the list of varstructs and the term {[vs1; vs2; ...; vsn],t}. \FAILURE Never fails, though the list of varstructs will be empty if the initial term is no sort of abstraction. \EXAMPLE { # strip_gabs `\(a,b) c ((d,e),f). (a - b) + c + (d - e) * f`;; val it : term list * term = ([`a,b`; `c`; `(d,e),f`], `a - b + c + (d - e) * f`) } \SEEALSO dest_gabs, is_gabs, mk_gabs. \ENDDOC hol-light/Help/strip_ncomb.doc000066400000000000000000000015601303454263000166450ustar00rootroot00000000000000\DOC strip_ncomb \TYPE {strip_ncomb : int -> term -> term * term list} \SYNOPSIS Strip away a given number of arguments from a combination. \DESCRIBE Given a number {n} and a combination term {`f a1 ... an`}, the function {strip_ncomb} returns the result of stripping away exactly {n} arguments: the pair {`f`,[`a1`;...;`an`]}. Note that exactly {n} arguments are stripped even if {f} is a combination. \FAILURE Fails if there are not {n} arguments to strip off. \EXAMPLE Note how the behaviour is more limited compared with simple {strip_comb}: { # strip_ncomb 2 `f u v x y z`;; Warning: inventing type variables val it : term * term list = (`f u v x`, [`y`; `z`]) # strip_comb `f u v x y z`;; Warning: inventing type variables val it : term * term list = (`f`, [`u`; `v`; `x`; `y`; `z`]) } \USES Delicate term decompositions. \SEEALSO strip_comb. \ENDDOC hol-light/Help/striplist.doc000066400000000000000000000012361303454263000163630ustar00rootroot00000000000000\DOC striplist \TYPE {striplist : ('a -> 'a * 'a) -> 'a -> 'a list} \SYNOPSIS Applies a binary destructor repeatedly, flattening the construction tree into a list. \DESCRIBE If a destructor function {d} inverts a binary constructor {f}, for example {dest_comb} for {mk_comb}, and fails when applied to components {xi}, then when applied to any object built up repeatedly by {f} applied to base values {xi} returns the list {[x1;...;xn]}. \FAILURE Never fails. \EXAMPLE { # striplist dest_conj `(a /\ (b /\ ((c /\ d) /\ e)) /\ f) /\ g`;; val it : term list = [`a`; `b`; `c`; `d`; `e`; `f`; `g`] } \SEEALSO nsplit, splitlist, rev_splitlist, end_itlist. \ENDDOC hol-light/Help/subset.doc000066400000000000000000000010031303454263000156230ustar00rootroot00000000000000\DOC subset \TYPE {subset : 'a list -> 'a list -> bool} \SYNOPSIS Tests if one list is a subset of another. \DESCRIBE The call {subset l1 l2} returns {true} if every element of {l1} also occurs in {l2}, regardless of whether an element appears once or more than once in each list. So when {l1} and {l2} are regarded as sets, this is a subset test. \FAILURE Never fails. \EXAMPLE { # subset [1;1;2;2] [1;2;3];; val it : bool = true } \SEEALSO insert, intersect, set_eq, setify, subtract, union. \ENDDOC hol-light/Help/subst.doc000066400000000000000000000022341303454263000154650ustar00rootroot00000000000000\DOC subst \TYPE {subst : (term * term) list -> term -> term} \SYNOPSIS Substitute terms for other terms inside a term. \DESCRIBE The call {subst [t1',t1; ...; tn',tn] t} systematically replaces free instances of each term {ti} inside {t} with the corresponding {ti'} from the instantiation list. (A subterm is considered free if none of its free variables are bound by its context.) Bound variables will be renamed if necessary to avoid capture. \FAILURE Fails if any of the pairs {ti',ti} in the instantiation list has {ti} and {ti'} with different types. Multiple instances of the same {ti} in the list are not trapped, but only the first one will be used consistently. \EXAMPLE Here is a relatively simple example { # subst [`x + 1`,`1 + 2`] `(1 + 2) + 1 + 2 + 3`;; val it : term = `(x + 1) + 1 + 2 + 3` } \noindent and here is a more complex instance where renaming of bound variables is needed: { # subst [`x:num`,`1`] `!x. x > 0 <=> x >= 1`;; val it : term = `!x'. x' > 0 <=> x' >= x` } \COMMENTS This is the most general term substitution function, but if all the {ti} are variables, the {vsubst} function is more efficient. \SEEALSO inst, vsubst. \ENDDOC hol-light/Help/subtract.doc000066400000000000000000000010761303454263000161570ustar00rootroot00000000000000\DOC subtract \TYPE {subtract : 'a list -> 'a list -> 'a list} \SYNOPSIS Computes the set-theoretic difference of two `sets'. \KEYWORDS list, set. \DESCRIBE {subtract l1 l2} returns a list consisting of those elements of {l1} that do not appear in {l2}. If both lists are initially free of repetitions, this can be considered a set difference operation. \FAILURE Never fails. \EXAMPLE { # subtract [1;2;3] [3;5;4;1];; val it : int list = [2] # subtract [1;2;4;1] [4;5];; val it : int list = [1; 2; 1] } \SEEALSO setify, set_equal, union, intersect. \ENDDOC hol-light/Help/subtract_prime.doc000066400000000000000000000014231303454263000173470ustar00rootroot00000000000000\DOC subtract' \TYPE {subtract' : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list} \SYNOPSIS Subtraction of sets modulo an equivalence. \DESCRIBE The call {subtract' r l1 l2} removes from the list {l1} all elements {x} such that there is an {x'} in {l2} with {r x x'}. If {l1} and {l2} were free of equivalents under {r}, the resulting list will be too, so this is a set operation modulo an equivalence. The function {subtract} is the special case where the relation is just equality. \FAILURE Fails only if the function {r} fails. \EXAMPLE { # subtract' (fun x y -> abs(x) = abs(y)) [-1; 2; 1] [-2; -3; 4; -4];; val it : int list = [-1; 1] } \USES Maintaining sets modulo an equivalence such as alpha-equivalence. \SEEALSO insert', mem', union, union', unions'. \ENDDOC hol-light/Help/temp_path.doc000066400000000000000000000006051303454263000163060ustar00rootroot00000000000000\DOC temp_path \TYPE {temp_path : string ref} \SYNOPSIS Directory in which to create temporary files. \DESCRIBE Some HOL Light derived rules in the libraries (none in the core system) need to create temporary files. This is the directory in which they do so. \FAILURE Not applicable. \EXAMPLE On my laptop: { # !temp_path;; val it : string = "/tmp" } \SEEALSO hol_dir. \ENDDOC hol-light/Help/term_match.doc000066400000000000000000000023311303454263000164460ustar00rootroot00000000000000\DOC term_match \TYPE {term_match : term list -> term -> term -> instantiation} \SYNOPSIS Match one term against another. \DESCRIBE The call {term_match lcs t t'} attempts to find an instantiation for free variables in {t}, not permitting assignment of `local constant' variables in the list {lcs}, so that it is alpha-equivalent to {t'}. If it succeeds, the appropriate instantiation is returned. Otherwise it fails. The matching is higher-order in a limited sense; see {PART_MATCH} for more illustrations. \FAILURE Fails if terms cannot be matched. \EXAMPLE { # term_match [] `x + y + 1` `(y + 1) + z + 1`;; val it : instantiation = ([], [(`z`, `y`); (`y + 1`, `x`)], []) # term_match [] `~(?x:A. P x)` `~(?n. 5 < n /\ n < 6)`;; val it : instantiation = ([(1, `P`)], [(`\n. 5 < n /\ n < 6`, `P`)], [(`:num`, `:A`)]) } \COMMENTS This function can occasionally `succeed' yet produce a match that does not in fact work. In typical uses, this will be implicitly checked by a subsequent inference process. However, to get a self-contained matching effect, the user should check that the instantiation returned does achieve a match, e.g. by applying {instantiate}. \SEEALSO instantiate, INSTANTIATE, PART_MATCH. \ENDDOC hol-light/Help/term_of_preterm.doc000066400000000000000000000013031303454263000175120ustar00rootroot00000000000000\DOC term_of_preterm \TYPE {term_of_preterm : preterm -> term} \SYNOPSIS Converts a preterm into a term. \DESCRIBE HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for parsing and typechecking, which are later converted to types and terms. A call {term_of_preterm ptm} attempts to convert preterm {ptm} into a HOL term. \FAILURE Fails if some constants used in the preterm have not been defined, or if there are other inconsistencies in the types so that a consistent typing cannot be arrived at. \COMMENTS Only users seeking to change HOL's parser and typechecker quite radically need to use this function. \SEEALSO preterm_of_term, retypecheck, type_of_pretype. \ENDDOC hol-light/Help/term_of_rat.doc000066400000000000000000000012571303454263000166320ustar00rootroot00000000000000\DOC term_of_rat \TYPE {term_of_rat : num -> term} \SYNOPSIS Converts OCaml number to canonical rational literal of type {:real}. \DESCRIBE The call {term_of_rat n}, where {n} is an OCaml rational number (type {num}), returns the canonical rational literal of type {:real} that represents it. The canonical literals are integer literals {&n} for numeral {n}, {-- &n} for a nonzero numeral {n}, or ratios {&p / &q} or {-- &p / &q} where {p} is nonzero, {q > 1} and {p} and {q} share no common factor. \FAILURE Never fails. \EXAMPLE { # term_of_rat (Int 3 // Int 2);; val it : term = `&3 / &2` } \SEEALSO is_ratconst, mk_realintconst, rat_of_term, REAL_RAT_REDUCE_CONV. \ENDDOC hol-light/Help/term_order.doc000066400000000000000000000020761303454263000164730ustar00rootroot00000000000000\DOC term_order \TYPE {term_order : term -> term -> bool} \SYNOPSIS Term order for use in AC-rewriting. \DESCRIBE This binary predicate implements a crude but fairly efficient ordering on terms that is appropriate for ensuring that ordered rewriting will perform normalization. \FAILURE Never fails. \EXAMPLE This example shows how using ordered rewriting with this term ordering can give normalization under associative and commutative laws given the appropriate rewrites: { # ADD_AC;; val it : thm = |- m + n = n + m /\ (m + n) + p = m + n + p /\ m + n + p = n + m + p } \noindent { # TOP_DEPTH_CONV (FIRST_CONV(map (ORDERED_REWR_CONV term_order) (CONJUNCTS ADD_AC))) `d + (f + a) + b + (c + e):num`;; val it : thm = |- d + (f + a) + b + c + e = a + b + c + d + e + f } \USES It is used automatically when applying permutative rewrite rules inside rewriting and simplification. Users will not normally want to use it explicitly, though the example above shows roughly what goes on there. \SEEALSO ORDERED_IMP_REWR_CONV, ORDERED_REWR_CONV. \ENDDOC hol-light/Help/term_unify.doc000066400000000000000000000012121303454263000165010ustar00rootroot00000000000000\DOC term_unify \TYPE {term_unify : term list -> term -> term -> instantiation} \SYNOPSIS Unify two terms. \DESCRIBE Given two terms {tm1} and {tm2}, a call {term_unify vars tm1 tm2} attempts to find instantiations of the variables {vars} in the two terms to make them alpha-equivalent. At present, no type instantiation is done. The unification is also purely first-order. In these respects it is less general than {term_match}, and this may be improved in the future. \FAILURE Fails if the two terms are not first-order unifiable by instantiating the given variables without type instantiation. \SEEALSO instantiate, term_match. \ENDDOC hol-light/Help/term_union.doc000066400000000000000000000015141303454263000165040ustar00rootroot00000000000000\DOC term_union \TYPE {term_union : term list -> term list -> term list} \SYNOPSIS Union of two sets of terms up to alpha-equivalence. \DESCRIBE The call {term_union l1 l2} for two lists of terms {l1} and {l2} returns a list including all of {l2} and all terms of {l1} for which no alpha-equivalent term occurs in {l2} or earlier in {l1}. If both lists were sets modulo alpha-conversion, i.e. contained no alpha-equivalent pairs, then so will be the result. \FAILURE Never fails. \EXAMPLE { # term_union [`1`; `2`] [`2`; `3`];; val it : term list = [`1`; `2`; `3`] # term_union [`!x. x >= 0`; `?u. u > 0`] [`?w. w > 0`; `!u. u >= 0`];; val it : term list = [`?w. w > 0`; `!u. u >= 0`] } \USES For combining assumption lists of theorems without duplication of alpha-equivalent ones. \SEEALSO aconv, union, union'. \ENDDOC hol-light/Help/the_definitions.doc000066400000000000000000000035711303454263000175050ustar00rootroot00000000000000\DOC the_definitions \TYPE {the_definitions : thm list ref} \SYNOPSIS List of all definitions introduced so far. \DESCRIBE The reference variable {the_definitions} holds the list of definitions made so far. Various definitional rules such as {new_definition} automatically augment it. Note that in some cases (e.g. {new_inductive_definition}) the stored form of the definition may look very different from what the user sees or enters at the top level. \FAILURE Not applicable. \EXAMPLE If we examine the list in HOL Light's initial state, we see the most recent definition at the head ({superadmissible} is connected with HOL's automated definitional rule {define}) and the oldest, logical truth {T}, at the tail: { # !the_definitions;; val it : thm list = [|- !(<<) p s t. superadmissible (<<) p s t <=> admissible (<<) (\f a. T) s p ==> tailadmissible (<<) p s t; ... ... |- (/\) = (\p q. (\f. f p q) = (\f. f T T)); |- T <=> (\p. p) = (\p. p)] } If we make a new definition of any sort, e.g. { # new_definition `false <=> F`;; val it : thm = |- false <=> F } \noindent we will see a new entry at the head: { # !the_definitions;; val it : thm list = [|- false <=> F; ... ... |- (/\) = (\p q. (\f. f p q) = (\f. f T T)); |- T <=> (\p. p) = (\p. p)] } \USES This list is not logically necessary and is not part of HOL Light's logical core, but it is used outside the core so that multiple instances of the same definition are quietly ``ignored'' rather than rejected. (By contrast, the list of new constants introduced by definitions is logically necessary to avoid inconsistent redefinition.) Users may also sometimes find it convenient. \SEEALSO axioms, constants, define, definitions, new_definition, new_inductive_definition, new_recursive_definition, new_specification, the_inductive_definitions, the_specifications. \ENDDOC hol-light/Help/the_implicit_types.doc000066400000000000000000000033701303454263000202250ustar00rootroot00000000000000\DOC the_implicit_types \TYPE {the_implicit_types : (string * hol_type) list ref} \SYNOPSIS Restrict variables to a particular type or type scheme. \DESCRIBE Normally, the types of variables in term quotations are restricted only by the context in which they appear and will otherwise have maximally general types inferred. By associating variable names with type schemes in the list of pairs {the_implicit_types}, the types of variables will be suitably restricted. This can be a convenience in reducing the amount of manual type annotation in terms. The facility is somewhat analogous to the schemas specified for constants in {the_overload_skeletons}. \FAILURE Not applicable. \EXAMPLE If we parse the following term, in which all names denote variables (assume neither {mul} nor {x} has been declared a constant), then the type of {x} is completely unrestricted if {the_implicit_types} is empty as in HOL Light's initial state: { # the_implicit_types := [];; val it : unit = () # `mul 1 x`;; Warning: inventing type variables val it : term = `mul 1 x` # map dest_var (frees it);; val it : (string * hol_type) list = [("mul", `:num->?83058->?83057`); ("x", `:?83058`)] } However, if we use the implicit types to require that the variable {mul} has an instance of a generic type scheme each time it is parsed, all types follow implicitly: { # the_implicit_types := ["mul",`:A->A->A`; "iv",`:A->A`];; val it : unit = () # `mul 1 x`;; val it : term = `mul 1 x` # map dest_var (frees it);; val it : (string * hol_type) list = [("mul", `:num->num->num`); ("x", `:num`)] } \SEEALSO make_overloadable, overload_interface, override_interface, prioritize_overload, reduce_interface, remove_interface, the_interface, the_overload_skeletons. \ENDDOC hol-light/Help/the_inductive_definitions.doc000066400000000000000000000024101303454263000215460ustar00rootroot00000000000000\DOC the_inductive_definitions \TYPE {the_inductive_definitions : thm list ref} \SYNOPSIS List of all definitions introduced so far. \DESCRIBE The reference variable {the_inductive_definitions} holds the list of inductive definitions made so far using {new_inductive_definition}, which automatically augments it. \FAILURE Not applicable. \EXAMPLE If we examine the list in HOL Light's initial state, we see the most recent inductive definition is finiteness of a set: { # !the_inductive_definitions;; val it : (thm * thm * thm) list = [(|- FINITE {} /\ (!x s. FINITE s ==> FINITE (x INSERT s)), |- !FINITE'. FINITE' {} /\ (!x s. FINITE' s ==> FINITE' (x INSERT s)) ==> (!a. FINITE a ==> FINITE' a), |- !a. FINITE a <=> a = {} \/ (?x s. a = x INSERT s /\ FINITE s)); ... ...] } \USES This list is not logically necessary and is not part of HOL Light's logical core, but it is used outside the core so that multiple instances of the same inductive definition are quietly ``ignored'' rather than rejected. Users may also sometimes find it convenient. \SEEALSO axioms, constants, define, definitions, new_definition, new_inductive_definition, new_recursive_definition, new_specification, the_definitions, the_specifications. \ENDDOC hol-light/Help/the_inductive_types.doc000066400000000000000000000006511303454263000204040ustar00rootroot00000000000000\DOC the_inductive_types \TYPE {the_inductive_types : (string * (thm * thm)) list ref} \SYNOPSIS List of previously declared inductive types. \DESCRIBE This reference variable contains a list of the inductive types, together with their induction and recursion theorems as returned by {define_type}. The list is automatically extended by a call of {define_type}. \FAILURE Not applicable. \SEEALSO define_type. \ENDDOC hol-light/Help/the_interface.doc000066400000000000000000000010501303454263000171200ustar00rootroot00000000000000\DOC the_interface \TYPE {the_interface : (string * (string * hol_type)) list ref} \SYNOPSIS List of active interface mappings. \DESCRIBE HOL Light allows the same identifier to map to one or more underlying constants using an overloading mechanism with resolution based on type. The reference variable {the_interface} stores the current list of all interface mappings. \SEEALSO make_overloadable, overload_interface, override_interface, prioritize_overload, reduce_interface, remove_interface, the_implicit_types, the_overload_skeletons. \ENDDOC hol-light/Help/the_overload_skeletons.doc000066400000000000000000000027761303454263000211020ustar00rootroot00000000000000\DOC the_overload_skeletons \TYPE {the_overload_skeletons : (string * hol_type) list ref} \SYNOPSIS List of overload skeletons for all overloadable identifiers. \DESCRIBE HOL Light allows the same identifier to denote several different underlying constants, with the choice being determined by types and/or an order of priority (see {prioritize_overload}). The reference variable {the_overload_skeletons} contains a list of all the overloadable symbols (you can add more using {make_overloadable}) and their type skeletons. All constants to which an identifier is overloaded must have a type that is an instance of this skeleton, although you can make it a type variable in which case any type would be allowed. The variable {the_implicit_types} offers somewhat analogous features for variables. \FAILURE Not applicable. \EXAMPLE In the initial state of HOL Light: { # !the_overload_skeletons;; val it : (string * hol_type) list = [("gcd", `:A#A->A`); ("coprime", `:A#A->bool`); ("mod", `:A->A->A->bool`); ("divides", `:A->A->bool`); ("&", `:num->A`); ("min", `:A->A->A`); ("max", `:A->A->A`); ("abs", `:A->A`); ("inv", `:A->A`); ("pow", `:A->num->A`); ("--", `:A->A`); (">=", `:A->A->bool`); (">", `:A->A->bool`); ("<=", `:A->A->bool`); ("<", `:A->A->bool`); ("/", `:A->A->A`); ("*", `:A->A->A`); ("-", `:A->A->A`); ("+", `:A->A->A`)] } \SEEALSO make_overloadable, overload_interface, override_interface, prioritize_overload, reduce_interface, remove_interface, the_implicit_types, the_interface. \ENDDOC hol-light/Help/the_specifications.doc000066400000000000000000000020031303454263000201620ustar00rootroot00000000000000\DOC the_specifications \TYPE {the_specifications : thm list ref} \SYNOPSIS List of all constant specifications introduced so far. \DESCRIBE The reference variable {the_specifications} holds the list of constant specifications made so far by {new_specification}. It is a list of triples, with the first two components being the list of variables and the existential theorem used as input, and the last being the returned theorem. \FAILURE Not applicable. \USES This list is not logically necessary and is not part of HOL Light's logical core, but it is used outside the core so that multiple instances of the same specification are quietly ``ignored'' rather than rejected. (By contrast, the list of new constants introduced by definitions is logically necessary to avoid inconsistent redefinition.) Users may also sometimes find it convenient. \SEEALSO axioms, constants, define, new_definition, new_inductive_definition, new_recursive_definition, new_specification, the_definitions, the_inductive_definitions. \ENDDOC hol-light/Help/the_type_definitions.doc000066400000000000000000000023351303454263000205430ustar00rootroot00000000000000\DOC the_type_definitions \TYPE {the_type_definitions : ((string * string * string) * (thm * thm)) list ref} \SYNOPSIS List of type definitions made so far. \DESCRIBE The reference variable {the_type_definitions} holds a list of entries, one for each type definition made so far with {new_type_definition}. It is not normally explicitly manipulated by the user, but is automatically augmented by each call of {new_type_definition}. Each entry contains three strings (the type name, type constructor name and destructor name) and two theorems (the input nonemptiness theorem and the returned type bijections). That is, for a call: { bijth = new_type_definition tyname (absname,repname) nonempth;; } \noindent the entry created in this list is: { (tyname,absname,repname),(nonempth,bijth) } Note that the entries made using other interfaces to {new_basic_type_definition}, such as {define_type}, are not included in this list. \FAILURE Not applicable. \USES This is mainly intended for internal use in {new_type_definition}, so that repeated instances of the same definition are ignored rather than rejected. Some users may find the information useful too. \SEEALSO axioms, constants, new_type_definition, the_definitions. \ENDDOC hol-light/Help/then_.doc000066400000000000000000000001701303454263000154170ustar00rootroot00000000000000\DOC then_ \TYPE {then_ : tactic -> tactic -> tactic} \SYNOPSIS Non-infix version of {THEN}. \SEEALSO THEN. \ENDDOC hol-light/Help/then_tcl_.doc000066400000000000000000000002321303454263000162600ustar00rootroot00000000000000\DOC then_tcl_ \TYPE {then_tcl_ : thm_tactical -> thm_tactical -> thm_tactical} \SYNOPSIS Non-infix version of {THEN_TCL}. \SEEALSO THEN_TCL. \ENDDOC hol-light/Help/thenc_.doc000066400000000000000000000001661303454263000155670ustar00rootroot00000000000000\DOC thenc_ \TYPE {thenc_ : conv -> conv -> conv} \SYNOPSIS Non-infix version of {THENC}. \SEEALSO THENC. \ENDDOC hol-light/Help/thenl_.doc000066400000000000000000000002011303454263000155660ustar00rootroot00000000000000\DOC thenl_ \TYPE {thenl_ : tactic -> tactic list -> tactic} \SYNOPSIS Non-infix version of {THENL}. \SEEALSO THENL. \ENDDOC hol-light/Help/theorems.doc000066400000000000000000000017071303454263000161570ustar00rootroot00000000000000\DOC theorems \TYPE {theorems : (string * thm) list ref} \SYNOPSIS Database of theorems for {search} tools. \DESCRIBE The reference variable {theorems} holds a list of name-theorem pairs that is used by {search} to find theorems according to term patterns or by name. Initially, this contains all theorems individually bound to OCaml identifiers in the main system. However, it can be updated by users, and there is a script in {update_database.ml} that will automatically update the database according to the current OCaml bindings. \FAILURE Not applicable. \EXAMPLE In the initial HOL Light state we see: { # theorems;; val it : (string * thm) list ref = {contents = [("ABSORPTION", |- !x s. x IN s <=> x INSERT s = s); ("ABS_SIMP", |- !t1 t2. (\x. t1) t2 = t1); ("ADD", |- (!n. 0 + n = n) /\ (!m n. SUC m + n = SUC (m + n))); ("ADD1", |- !m. SUC m = m + 1); ("ADD_0", |- !m. m + 0 = m); ... } \SEEALSO search. \ENDDOC hol-light/Help/thm_frees.doc000066400000000000000000000010521303454263000162760ustar00rootroot00000000000000\DOC thm_frees \TYPE {thm_frees : thm -> term list} \SYNOPSIS Returns a list of the variables free in a theorem's assumptions and conclusion. \DESCRIBE When applied to a theorem, {A |- t}, the function {thm_frees} returns a list, without repetitions, of those variables which are free either in {t} or in some member of the assumption list {A}. \FAILURE Never fails. \EXAMPLE { # let th = CONJUNCT1 (ASSUME `p /\ q`);; val th : thm = p /\ q |- p # thm_frees th;; val it : term list = [`q`; `p`] } \SEEALSO frees, freesl, free_in. \ENDDOC hol-light/Help/time.doc000066400000000000000000000012371303454263000152650ustar00rootroot00000000000000\DOC time \TYPE {time : ('a -> 'b) -> 'a -> 'b} \SYNOPSIS Report CPU time taken by a function. \DESCRIBE A call {time f x} will evaluate {f x} as usual, but will also (provided the {report_timing} flag is {true} as it is by default) print the CPU time taken by that function evaluation. \FAILURE Never fails in itself, though it propagates any exception generated by the call {f x} itself. \EXAMPLE { # time NUM_REDUCE_CONV `123 EXP 14`;; CPU time (user): 0.09 val it : thm = |- 123 EXP 14 = 181414317867238075368413196009 } \USES Monitoring CPU time taken, e.g. to test different algorithms or implementation optimizations. \SEEALSO report_timing. \ENDDOC hol-light/Help/tl.doc000066400000000000000000000003721303454263000147450ustar00rootroot00000000000000\DOC tl \TYPE {tl : 'a list -> 'a list} \SYNOPSIS Computes the tail of a list (the original list less the first element). \DESCRIBE {tl [x1;...;xn]} returns {[x2;...;xn]}. \FAILURE Fails with {tl} if the list is empty. \SEEALSO hd, el. \ENDDOC hol-light/Help/top_goal.doc000066400000000000000000000011451303454263000161310ustar00rootroot00000000000000\DOC top_goal \TYPE {top_goal : unit -> term list * term} \SYNOPSIS Returns the current goal of the subgoal package. \DESCRIBE The function {top_goal} is part of the subgoal package. It returns the top goal of the goal stack in the current proof state. For a description of the subgoal package, see {set_goal}. \FAILURE A call to {top_goal} will fail if there are no unproven goals. This could be because no goal has been set using {set_goal} or because the last goal set has been completely proved. \USES Examining the proof state after a proof fails. \SEEALSO b, e, g, p, r, set_goal, top_thm. \ENDDOC hol-light/Help/top_realgoal.doc000066400000000000000000000010011303454263000167640ustar00rootroot00000000000000\DOC top_realgoal \TYPE {top_realgoal : unit -> (string * thm) list * term} \SYNOPSIS Returns the actual internal structure of the current goal. \DESCRIBE Returns the actual internal representation of the current goal, including the labels and the theorems that are the assumptions. \USES For users interested in the precise internal structure of the goal, e.g. to debug subtle free variable problems. Normally the simpler structure returned by {top_goal} is entirely adequate. \SEEALSO top_goal. \ENDDOC hol-light/Help/top_thm.doc000066400000000000000000000014261303454263000160010ustar00rootroot00000000000000\DOC top_thm \TYPE {top_thm : unit -> thm} \SYNOPSIS Returns the theorem just proved using the subgoal package. \DESCRIBE The function {top_thm} is part of the subgoal package. A proof state of the package consists of either goal and justification stacks if a proof is in progress or a theorem if a proof has just been completed. If the proof state consists of a theorem, {top_thm} returns that theorem. For a description of the subgoal package, see {set_goal}. \FAILURE {top_thm} will fail if the proof state does not hold a theorem. This will be so either because no goal has been set or because a proof is in progress with unproven subgoals. \USES Accessing the result of an interactive proof session with the subgoal package. \SEEALSO b, e, g, p, r, set_goal, top_goal. \ENDDOC hol-light/Help/try_user_parser.doc000066400000000000000000000010311303454263000175470ustar00rootroot00000000000000\DOC try_user_parser \TYPE {try_user_parser : lexcode list -> preterm * lexcode list} \SYNOPSIS Try all user parsing functions. \DESCRIBE HOL Light allows user parsing functions to be installed, and will try them on all terms during parsing before the usual parsers. The call {try_user_parser l} attempts to parse the list of tokens {l} using all the user parsers, taking the results from whichever one succeeds first. \FAILURE Fails if all user parsers fail. \SEEALSO delete_parser, install_parser, installed_parsers. \ENDDOC hol-light/Help/try_user_printer.doc000066400000000000000000000017201303454263000177430ustar00rootroot00000000000000\DOC try_user_printer \TYPE {try_user_printer : formatter -> term -> unit} \SYNOPSIS Try user-defined printers on a term. \DESCRIBE HOL Light allows arbitrary user printers to be inserted into the toplevel printer so that they are invoked on all applicable subterms (see {install_user_printer}). The call {try_user_printer fmt tm} attempts all installed user printers on the term {tm} in an implementation-defined order, sending output to the formatter {fmt}. If one succeeds, the call returns {()}, and otherwise it fails. \FAILURE Fails if no user printer is applicable to the given term (e.g. if no user printers have been installed). \EXAMPLE After installing the printer for variables with types in the example for {install_user_printer}, you can try: { # try_user_printer std_formatter `x:num`;; (x:num)val it : unit = () # try_user_printer std_formatter `1`;; Exception: Failure "tryfind". } \SEEALSO delete_user_printer, install_user_printer. \ENDDOC hol-light/Help/tryapplyd.doc000066400000000000000000000016171303454263000163610ustar00rootroot00000000000000\DOC tryapplyd \TYPE {tryapplyd : ('a, 'b) func -> 'a -> 'b -> 'b} \SYNOPSIS Applies a finite partial function, with a default for undefined points. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. If {f} is a finite partial function, {x} an element of its domain type and {y} of its range type, the call {tryapplyd f x y} tries to apply {f} to the value {x}, as with {apply f x}, but if it is undefined, simply returns {y} \FAILURE Never fails. \EXAMPLE { # tryapplyd (1 |=> 2) 1 (-1);; val it : int = 2 # tryapplyd undefined 1 (-1);; val it : int = -1 } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, undefine, undefined. \ENDDOC hol-light/Help/tryfind.doc000066400000000000000000000010131303454263000157760ustar00rootroot00000000000000\DOC tryfind \TYPE {tryfind : ('a -> 'b) -> 'a list -> 'b} \SYNOPSIS Returns the result of the first successful application of a function to the elements of a list. \KEYWORDS list. \DESCRIBE {tryfind f [x1;...;xn]} returns {(f xi)} for the first {xi} in the list for which application of {f} succeeds. \FAILURE Fails with {tryfind} if the application of the function fails for all elements in the list. This will always be the case if the list is empty. \SEEALSO find, mem, exists, forall, assoc, rev_assoc. \ENDDOC hol-light/Help/type_abbrevs.doc000066400000000000000000000005521303454263000170130ustar00rootroot00000000000000\DOC type_abbrevs \TYPE {type_abbrevs : unit -> (string * hol_type) list} \SYNOPSIS Lists all current type abbreviations. \DESCRIBE The call {type_abbrevs()} returns a list of all current type abbreviations, which are applied when parsing types but have no logical significance. \FAILURE Never fails. \SEEALSO new_type_abbrev, remove_type_abbrev. \ENDDOC hol-light/Help/type_invention_error.doc000066400000000000000000000026601303454263000206130ustar00rootroot00000000000000\DOC type_invention_error \TYPE {type_invention_error : bool ref} \SYNOPSIS Determines if invented type variables are treated as an error. \DESCRIBE If HOL Light is unable to assign specific types to a term entered in quotation, it will invent its own type variables to use in the most general type. The flag {type_invention_error} determines whether in such cases the term parser treats it as an error. The default is {false}, since sometimes the invention of type variables is immaterial, e.g. in ad-hoc logical lemmas used inside a proof. However, to enforce a more careful style, set it to {true}. \FAILURE Not applicable. \EXAMPLE When the following term is entered, HOL Light invents a type variable to use as the most general type. In the normal course of events this merely results in a warning (see {type_invention_warning} to remove even this warning): { # let tm = `x = x`;; Warning: inventing type variables val tm : term = `x = x` } \noindent whereas if {type_invention_error} is set to {true}, the term parser fails with an error message: { # type_invention_error := true;; val it : unit = () # let tm = `x = x`;; Exception: Failure "typechecking error (cannot infer type of variables)". } \noindent You can avoid the error by explicitly giving appropriate types or type variables yourself: { # let tm = `(x:int) = x`;; val tm : term = `x = x` } \SEEALSO retypecheck, term_of_preterm, type_invention_warning. \ENDDOC hol-light/Help/type_invention_warning.doc000066400000000000000000000033211303454263000211220ustar00rootroot00000000000000\DOC type_invention_warning \TYPE {type_invention_warning : bool ref} \SYNOPSIS Determined if user is warned about invented type variables. \DESCRIBE If HOL Light is unable to assign specific types to a term entered in quotation, it will invent its own type variables to use in the most general type. The flag {type_invention_warning} determines whether the user is warned in such situations. The default is {true}, since this can often indicate a user error (e.g. the user forgot to define a constant before using it in a term or overlooked more general types than expected). To disable the warnings, set it to {false}, while to make the checking even more rigorous and treat it as an error, set {type_invention_error} to {true}. \FAILURE Not applicable. \EXAMPLE When the following term is entered, HOL Light invents a type variable to use as the most general type: { # let tm = `x IN s`;; Warning: inventing type variables val tm : term = `x IN s` } \noindent which are not particularly intuitive, as you can see: { # map dest_var (frees tm);; val it : (string * hol_type) list = [("x", `:?47676`); ("s", `:?47676->bool`)] } \noindent You can avoid this by explicitly giving appropriate types or type variables yourself: { # let tm = `(x:A) IN s`;; val tm : term = `x IN s` } But if you often want to let HOL Light invent types for itself without warning you, set { # type_invention_warning := false;; val it : unit = () } One reason why you might find the warning more irritating than helpful is if you are rewriting with ad-hoc set theory lemmas generated like this: { # SET_RULE `x IN UNIONS (a INSERT t) <=> x IN UNIONS t \/ x IN a`;; } \SEEALSO retypecheck, term_of_preterm, type_invention_error. \ENDDOC hol-light/Help/type_match.doc000066400000000000000000000025141303454263000164630ustar00rootroot00000000000000\DOC type_match \TYPE {type_match : hol_type -> hol_type -> (hol_type * hol_type) list -> (hol_type * hol_type) list} \SYNOPSIS Computes a type instantiation to match one type to another. \DESCRIBE The call {type_match vty cty []} will if possible find an instantiation of the type variables in {vty} to make it the same as {cty}, and will fail if this is not possible. The instantiation is returned in a list of term-variable pairs as expected by type instantiation operations like {inst} and {INST_TYPE}. More generally, {type_match vty cty env} will attempt to find such a match assuming that the instantiations already in the list {env} are needed (this is helpful, for example, in matching multiple pairs of types in parallel). \FAILURE Fails if there is no match under the chosen constraints. \EXAMPLE Here is a basic example with an empty last argument: { # type_match `:A->B->bool` `:num->num->bool` [];; val it : (hol_type * hol_type) list = [(`:num`, `:A`); (`:num`, `:B`)] } \noindent and here is an illustration of how the extra argument can be used to perform parallel matches. { # itlist2 type_match [`:A->A->bool`; `:B->B->bool`] [`:num->num->bool`; `:bool->bool->bool`] [];; val it : (hol_type * hol_type) list = [(`:num`, `:A`); (`:bool`, `:B`)] } \SEEALSO inst, INST_TYPE, mk_mconst, term_match. \ENDDOC hol-light/Help/type_of.doc000066400000000000000000000002651303454263000157740ustar00rootroot00000000000000\DOC type_of \TYPE {type_of : term -> hol_type} \SYNOPSIS Returns the type of a term. \FAILURE Never fails. \EXAMPLE { # type_of `T`;; val it : hol_type = `:bool` } \ENDDOC hol-light/Help/type_of_pretype.doc000066400000000000000000000012011303454263000175330ustar00rootroot00000000000000\DOC type_of_pretype \TYPE {type_of_pretype : pretype -> hol_type} \SYNOPSIS Converts a pretype to a type. \DESCRIBE HOL Light uses ``pretypes'' and ``preterms'' as intermediate structures for parsing and typechecking, which are later converted to types and terms. A call {type_of_pretype pty} attempts to convert pretype {pty} into a HOL type. \FAILURE Fails if some type constants used in the pretype have not been defined, or if the arities are wrong. \COMMENTS Only users seeking to change HOL's parser and typechecker quite radically need to use this function. \SEEALSO pretype_of_type, retypecheck, term_of_preterm. \ENDDOC hol-light/Help/type_subst.doc000066400000000000000000000013431303454263000165260ustar00rootroot00000000000000\DOC type_subst \TYPE {type_subst : (hol_type * hol_type) list -> hol_type -> hol_type} \SYNOPSIS Substitute chosen types for type variables in a type. \DESCRIBE The call {type_subst [ty1,tv1; ... ; tyn,tvn] ty} where each {tyi} is a type and each {tvi} is a type variable, will systematically replace each instance of {tvi} in the type {ty} by the corresponding type {tyi}. \FAILURE Never fails. If some of the {tvi} are not type variables they will be ignored, and if several {tvi} are the same, the first one in the list will be used to determine the substitution. \EXAMPLE { # type_subst [`:num`,`:A`; `:bool`,`:B`] `:A->(B)list->A#B#C`;; val it : hol_type = `:num->(bool)list->num#bool#C` } \SEEALSO inst, tysubst. \ENDDOC hol-light/Help/type_vars_in_term.doc000066400000000000000000000012011303454263000200470ustar00rootroot00000000000000\DOC type_vars_in_term \TYPE {type_vars_in_term : term -> hol_type list} \SYNOPSIS Returns the set of type variables used in a term. \DESCRIBE The call {type_vars_in_term t} returns the set of all type variables occurring anywhere inside any subterm of {t}. \FAILURE Never fails. \EXAMPLE Note that the list of types occurring somewhere in the term may be larger than the set of type variables in the term's toplevel type. For example: { # type_vars_in_term `!x:A. x = x`;; val it : hol_type list = [`:A`] } \noindent whereas { # tyvars(type_of `!x:A. x = x`);; val it : hol_type list = [] } \SEEALSO frees, tyvars. \ENDDOC hol-light/Help/types.doc000066400000000000000000000013111303454263000154640ustar00rootroot00000000000000\DOC types \TYPE {types : unit -> (string * int) list} \SYNOPSIS Lists all the types presently declared. \DESCRIBE The function {types} should be applied to {()} and returns a list of all the type constructors declared, in the form of arity-name pairs. \FAILURE Never fails. \EXAMPLE In the initial state we have: { # types();; val it : (string * int) list = [("finite_sum", 2); ("cart", 2); ("finite_image", 1); ("int", 0); ("real", 0); ("hreal", 0); ("nadd", 0); ("3", 0); ("2", 0); ("list", 1); ("option", 1); ("sum", 2); ("recspace", 1); ("num", 0); ("ind", 0); ("prod", 2); ("1", 0); ("bool", 0); ("fun", 2)] } \SEEALSO axioms, constants, new_type, new_type_definition. \ENDDOC hol-light/Help/typify_universal_set.doc000066400000000000000000000022261303454263000206150ustar00rootroot00000000000000\DOC typify_universal_set \TYPE {typify_universal_set : bool ref} \SYNOPSIS Determines whether the universe set on a type is printed just as the type. \DESCRIBE The reference variable {typify_universal_set} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic printing of terms and theorems at the toplevel. When it is {true}, as it is by default, any universal set {UNIV:A->bool} ({UNIV} is a predefined set constant valid over all types) is printed just as {(:A)}. When {typify_universal_set} is {false}, it is printed as {UNIV}, just as for any other constant. \FAILURE Not applicable. \EXAMPLE Note that having this setting is quite useful here: { # CART_EQ;; val it : thm = |- !x y. x = y <=> (!i. 1 <= i /\ i <= dimindex (:B) ==> x $ i = y $ i) } \USES HOL Light's Cartesian power type (constructor `{^}') uses a type to index the power. When this flag is {true}, formulas often become easier to understand when printed, as in the above example. \SEEALSO pp_print_term, prebroken_binops, print_all_thm, print_unambiguous_comprehensions, reverse_interface_mapping, unspaced_binops. \ENDDOC hol-light/Help/tysubst.doc000066400000000000000000000014311303454263000160400ustar00rootroot00000000000000\DOC tysubst \TYPE {tysubst : (hol_type * hol_type) list -> hol_type -> hol_type} \DESCRIBE The call {tysubst [ty1',ty1; ... ; tyn',tyn] ty} will systematically traverse the type {ty} and replace the topmost instances of any {tyi} encountered with the corresponding {tyi'}. In the (usual) case where all the {tyi} are type variables, this is the same as {type_subst}, but also works when they are not. \FAILURE Never fails. If several {tyi} are the same, the first one in the list will be used to determine the substitution. \EXAMPLE { # tysubst [`:num`,`:A`; `:bool`,`:B`] `:A->(B)list->A#B#C`;; val it : hol_type = `:num->(bool)list->num#bool#C` # tysubst [`:A`,`:(num)list`] `:num->(num)list->(num)list`;; val it : hol_type = `:num->A->A` } \SEEALSO inst, type_subst. \ENDDOC hol-light/Help/tyvars.doc000066400000000000000000000005611303454263000156560ustar00rootroot00000000000000\DOC tyvars \TYPE {tyvars : hol_type -> hol_type list} \SYNOPSIS Returns a list of the type variables in a type. \DESCRIBE When applied to a type, {tyvars} returns a list (possibly empty) of the type variables that it involves. \FAILURE Never fails. \EXAMPLE { # tyvars `:(A->bool)->A`;; val it : hol_type list = [`:A`] } \SEEALSO type_vars_in_term. \ENDDOC hol-light/Help/uncurry.doc000066400000000000000000000005031303454263000160310ustar00rootroot00000000000000\DOC uncurry \TYPE {uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c} \SYNOPSIS Converts a function taking two arguments into a function taking a single paired argument. \DESCRIBE The application {uncurry f} returns {fun (x,y) -> f x y}, so that { uncurry f (x,y) = f x y } \FAILURE Never fails. \SEEALSO curry. \ENDDOC hol-light/Help/undefine.doc000066400000000000000000000016641303454263000161300ustar00rootroot00000000000000\DOC undefine \TYPE {undefine : 'a -> ('a, 'b) func -> ('a, 'b) func} \SYNOPSIS Remove definition of a finite partial function on specific domain value. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The call {undefine x f} removes a definition for the domain value {x} in the finite partial function {f}; if there was none to begin with the function is unchanged. \FAILURE Never fails. \EXAMPLE { # let f = itlist I [1 |-> "1"; 2 |-> "2"; 3 |-> "3"] undefined;; val f : (int, string) func = # dom f;; val it : int list = [1; 2; 3] # dom(undefine 2 f);; val it : int list = [1; 3] } \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefined. \ENDDOC hol-light/Help/undefined.doc000066400000000000000000000014451303454263000162710ustar00rootroot00000000000000\DOC undefined \TYPE {undefined : ('a, 'b) func} \SYNOPSIS Completely undefined finite partial function. \DESCRIBE This is one of a suite of operations on finite partial functions, type {('a,'b)func}. These may sometimes be preferable to ordinary functions since they permit more operations such as equality comparison, extraction of domain etc. The value {undefined} is the `empty' finite partial function that is nowhere defined. \FAILURE Not applicable. \EXAMPLE { # (undefined:(string,term)func);; val it : (string, term) func = # apply it "anything";; Exception: Failure "apply". } \USES Starting a function to be augmented pointwise. \SEEALSO |->, |=>, apply, applyd, choose, combine, defined, dom, foldl, foldr, graph, is_undefined, mapf, ran, tryapplyd, undefine. \ENDDOC hol-light/Help/unhide_constant.doc000066400000000000000000000012161303454263000175110ustar00rootroot00000000000000\DOC unhide_constant \TYPE {unhide_constant : string -> unit} \SYNOPSIS Restores recognition of a constant by the quotation parser. \DESCRIBE A call {unhide_constant "c"}, where {c} is a hidden constant, will unhide the constant, that is, will make the quotation parser recognize it as such rather than parsing it as a variable. It reverses the effect of the call {hide_constant name}. \FAILURE Fails unless the given name is a hidden constant in the current theory. \COMMENTS The hiding of a constant only affects the quotation parser; the constant is still there in a theory, and may not be redefined. \SEEALSO hide_constant, is_hidden. \ENDDOC hol-light/Help/union.doc000066400000000000000000000010741303454263000154560ustar00rootroot00000000000000\DOC union \TYPE {union : 'a list -> 'a list -> 'a list} \SYNOPSIS Computes the union of two `sets'. \KEYWORDS list, set. \DESCRIBE {union l1 l2} returns a list consisting of the elements of {l1} not already in {l2} concatenated with {l2}. If {l1} and {l2} are initially free from duplicates, this gives a set-theoretic union operation. \FAILURE Never fails. \EXAMPLE { # union [1;2;3] [1;5;4;3];; val it : int list = [2; 1; 5; 4; 3] # union [1;1;1] [1;2;3;2];; val it : int list = [1; 2; 3; 2] } \SEEALSO setify, set_equal, intersect, subtract. \ENDDOC hol-light/Help/union_prime.doc000066400000000000000000000015031303454263000166470ustar00rootroot00000000000000\DOC union' \TYPE {union' : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list} \SYNOPSIS Union of sets modulo an equivalence. \DESCRIBE The call {union' r l1 l2} appends to the list {l2} all those elements {x} of {l1} for which there is not already an equivalent {x'} with {r x x'} in {l2} or earlier in {l1}. If {l1} and {l2} were free of equivalents under {r}, the resulting list will be too, so this is a set operation modulo an equivalence. The function {union} is the special case where the relation is just equality. \FAILURE Fails only if the function {r} fails. \EXAMPLE { # union' (fun x y -> abs(x) = abs(y)) [-1; 2; 1] [-2; -3; 4; -4];; val it : int list = [1; -2; -3; 4; -4] } \USES Maintaining sets modulo an equivalence such as alpha-equivalence. \SEEALSO insert', mem', subtract', union, unions'. \ENDDOC hol-light/Help/unions.doc000066400000000000000000000007121303454263000156370ustar00rootroot00000000000000\DOC unions \TYPE {unions : 'a list list -> 'a list} \SYNOPSIS Performs the union of a set of sets. \DESCRIBE Applied to a list of lists, {union} returns a list of all the elements of them, in some unspecified order, with no repetitions. It can be considered as the union of the family of `sets'. \FAILURE Never fails. \EXAMPLE { # unions [[1;2]; [2;2;2;]; [2;3;4;5]];; val it : int list = [1; 2; 3; 4; 5] } \SEEALSO intersect, subtract. \ENDDOC hol-light/Help/unions_prime.doc000066400000000000000000000012551303454263000170360ustar00rootroot00000000000000\DOC unions' \TYPE {unions' : ('a -> 'a -> bool) -> 'a list list -> 'a list} \SYNOPSIS Compute union of a family of sets modulo an equivalence. \DESCRIBE If {r} is an equivalence relation an {l} a list of lists, the call {unions' r l} returns a list with one representative of each {r}-equivalence class occurring in any of the members. It thus gives a union of a family of sets with no duplicates under the equivalence {r}. \FAILURE Fails only if the relation {r} fails. \EXAMPLE { # unions' (fun x y -> abs(x) = abs(y)) [[-1; 2; 3]; [-2; -3; -4]; [4; 5; -6]];; val it : int list = [-1; -2; -3; 4; 5; -6] } \SEEALSO insert', mem', subtract', union', unions. \ENDDOC hol-light/Help/uniq.doc000066400000000000000000000006751303454263000153100ustar00rootroot00000000000000\DOC uniq \TYPE {uniq : 'a list -> 'a list} \SYNOPSIS Eliminate adjacent identical elements from a list. \DESCRIBE When applied to a list, {uniq} gives a new list that results from coalescing adjacent (only) elements of the list into one. \FAILURE Never fails. \EXAMPLE { # uniq [1;2;3;1;2;3];; val it : int list = [1; 2; 3; 1; 2; 3] # uniq [1;1;1;2;3;3;3;3;4];; val it : int list = [1; 2; 3; 4] } \SEEALSO setify, sort. \ENDDOC hol-light/Help/unparse_as_binder.doc000066400000000000000000000015011303454263000200040ustar00rootroot00000000000000\DOC unparse_as_binder \TYPE {unparse_as_binder : string -> unit} \SYNOPSIS Stops the quotation parser from treating a name as a binder. \DESCRIBE Certain identifiers {c} have binder status, meaning that {`c x. y`} is parsed as a shorthand for {`(c) (\x. y)'}. The call {unparse_as_binder "c"} will remove {c} from the list of binders if it is there. \FAILURE Never fails, even if the string was not a binder. \EXAMPLE { # `!x. x < 2`;; val it : term = `!x. x < 2` # unparse_as_binder "!";; val it : unit = () # `!x. x < 2`;; Exception: Failure "Unexpected junk after term". } \COMMENTS Removing binder status for the pre-existing binders like the quantifiers should only be done with great care, since it can cause other parser invocations to break. \SEEALSO binders, parses_as_binder, parse_as_binder. \ENDDOC hol-light/Help/unparse_as_infix.doc000066400000000000000000000011551303454263000176630ustar00rootroot00000000000000\DOC unparse_as_infix \TYPE {unparse_as_infix : string -> unit} \SYNOPSIS Removes string from the list of infix operators. \DESCRIBE Certain identifiers are treated as infix operators with a given precedence and associativity (left or right). The call {unparse_as_infix "op"} removes {op} from the list of infix identifiers, if it was indeed there. \FAILURE Never fails, even if the given string did not originally have infix status. \COMMENTS Take care with applying this to some of the built-in operators, or parsing may fail in existing libraries. \SEEALSO get_infix_status, infixes, parse_as_infix. \ENDDOC hol-light/Help/unparse_as_prefix.doc000066400000000000000000000007661303454263000200520ustar00rootroot00000000000000\DOC unparse_as_prefix \TYPE {unparse_as_prefix : string -> unit} \SYNOPSIS Removes prefix status for an identifier. \DESCRIBE Certain identifiers {c} have prefix status, meaning that combinations of the form {c f x} will be parsed as {c (f x)} rather than the usual {(c f) x}. The call {unparse_as_prefix "c"} removes {c} from the list of such identifiers. \FAILURE Never fails, regardless of whether {c} originally did have prefix status. \SEEALSO is_prefix, parse_as_prefix, prefixes. \ENDDOC hol-light/Help/unreserve_words.doc000066400000000000000000000013161303454263000175610ustar00rootroot00000000000000\DOC unreserve_words \TYPE {unreserve_words : string list -> unit} \SYNOPSIS Remove given strings from the set of reserved words. \DESCRIBE Certain identifiers in HOL are reserved, e.g. `{if}', `{let}' and `{|}', meaning that they are special to the parser and cannot be used as ordinary identifiers. The call {unreserve_words l} removes all strings in {l} from the list of reserved identifiers. \FAILURE Never fails, regardless of whether the given strings were in fact reserved. \COMMENTS The initial set of reserved words in HOL Light should be unreserved only with great care, since then various elementary constructs may fail to parse. \SEEALSO is_reserved_word, reserved_words, reserve_words. \ENDDOC hol-light/Help/unspaced_binops.doc000066400000000000000000000016311303454263000175010ustar00rootroot00000000000000\DOC unspaced_binops \TYPE {unspaced_binops : string list ref} \SYNOPSIS Determines which binary operators are printed with surrounding spaces. \DESCRIBE The reference variable {unspaced_binops} is one of several settable parameters controlling printing of terms by {pp_print_term}, and hence the automatic printing of terms and theorems at the toplevel. It holds a list of the names of infix binary operators that are printed without surrounding spaces. By default, it contains just the pairing operation `{,}', the numeric range `{..}' and the cartesian power indexing `{$}'. \FAILURE Not applicable. \EXAMPLE { # `x + 1`;; val it : term = `x + 1` # unspaced_binops := "+"::(!unspaced_binops);; val it : unit = () # `x + 1`;; val it : term = `x+1` } \SEEALSO pp_print_term, prebroken_binops, print_all_thm, print_unambiguous_comprehensions, reverse_interface_mapping, typify_universal_set. \ENDDOC hol-light/Help/unzip.doc000066400000000000000000000004101303454263000154640ustar00rootroot00000000000000\DOC unzip \TYPE {unzip : ('a * 'b) list -> 'a list * 'b list} \SYNOPSIS Converts a list of pairs into a pair of lists. \KEYWORDS list. \DESCRIBE {unzip [(x1,y1);...;(xn,yn)]} returns {([x1;...;xn],[y1;...;yn])}. \FAILURE Never fails. \SEEALSO zip. \ENDDOC hol-light/Help/use_file.doc000066400000000000000000000005251303454263000161210ustar00rootroot00000000000000\DOC use_file \TYPE {use_file : string -> unit} \SYNOPSIS Load a file, much like OCaml's {#use} directive. \DESCRIBE Essentially the same as OCaml's {#use} directive, but a regular OCaml function and therefore easier to exploit programmatically. \FAILURE Only fails if the included file causes failure. \SEEALSO loads, loadt. \ENDDOC hol-light/Help/variables.doc000066400000000000000000000006421303454263000162760ustar00rootroot00000000000000\DOC variables \TYPE {variables : term -> term list} \SYNOPSIS Determines the variables used, free or bound, in a given term. \DESCRIBE Given a term argument, {variables} returns a list of variables that occur free or bound in that term. \EXAMPLE { # variables `\a:bool. a`;; val it : term list = [`a`] # variables `(a:num) + (b:num)`;; val it : term list = [`b`; `a`] } \SEEALSO frees, free_in. \ENDDOC hol-light/Help/variant.doc000066400000000000000000000023551303454263000157750ustar00rootroot00000000000000\DOC variant \TYPE {variant : term list -> term -> term} \SYNOPSIS Modifies a variable name to avoid clashes. \DESCRIBE The call {variant avoid v} returns a variant of {v}, with the name changed by adding primes as much as necessary to avoid clashing with any free variables of the terms in the list {avoid}. Usually {avoid} is just a list of variables, in which case {v} is renamed so as to be different from all of them. The exact form of the variable name should not be relied on, except that the original variable will be returned unmodified unless it is free in some term in the {avoid} list. \FAILURE {variant l t} fails if any term in the list {l} is not a variable or if {t} is neither a variable nor a constant. \EXAMPLE The following shows a few typical cases: { # variant [`y:bool`; `z:bool`] `x:bool`;; val it : term = `x` # variant [`x:bool`; `x':num`; `x'':num`] `x:bool`;; val it : term = `x'` # variant [`x:bool`; `x':bool`; `x'':bool`] `x:bool`;; val it : term = `x'''` } \USES The function {variant} is extremely useful for complicated derived rules which need to rename variables to avoid free variable capture while still making the role of the variable obvious to the user. \SEEALSO genvar, hide_constant. \ENDDOC hol-light/Help/variants.doc000066400000000000000000000012631303454263000161550ustar00rootroot00000000000000\DOC variants \TYPE {variants : term list -> term list -> term list} \SYNOPSIS Pick a list of variants of variables, avoiding a list of variables and each other. \DESCRIBE The call {variants av vs},s where {av} and {vs} are both lists of variables, will return a list {vs'} of variants of the variables in the list {vs}, renamed as necessary by adding primes to avoid clashing with any free variables of the terms in the list {av} or with each other. \FAILURE Fails if any of the terms in the list is not a variable. \EXAMPLE { # variants [`x':num`; `x'':num`; `y:bool`] [`x:num`; `x':num`];; val it : term list = [`x`; `x'''`] } \SEEALSO genvar, mk_primed_var, variant. \ENDDOC hol-light/Help/verbose.doc000066400000000000000000000027311303454263000157740ustar00rootroot00000000000000\DOC verbose \TYPE {verbose : bool ref} \SYNOPSIS Flag to control verbosity of informative output. \DESCRIBE When the value of {verbose} is set to {true}, the function {remark} will output its string argument whenever called. This is used for most informative output in automated rules. \FAILURE Not applicable. \EXAMPLE Consider this call MESON to prove a first-order formula: { # MESON[] `!f g:num->num. (?!x. x = g(f(x))) <=> (?!y. y = f(g(y)))`;; 0..0..1..solved at 4 CPU time (user): 0.01 0..0..1..2..6..11..19..28..37..46..94..151..247..366..584..849..solved at 969 CPU time (user): 0.12 0..0..1..solved at 4 CPU time (user): 0. 0..0..1..2..6..11..19..28..37..46..94..151..247..366..584..849..solved at 969 CPU time (user): 0.06 val it : thm = |- !f g. (?!x. x = g (f x)) <=> (?!y. y = f (g y)) } \noindent By changing the verbosity level, most of the output disappears: { # verbose := false;; val it : unit = () # MESON[] `!f g:num->num. (?!x. x = g(f(x))) <=> (?!y. y = f(g(y)))`;; CPU time (user): 0.01 CPU time (user): 0.13 CPU time (user): 0. CPU time (user): 0.081 val it : thm = |- !f g. (?!x. x = g (f x)) <=> (?!y. y = f (g y)) } \noindent and if we also disable timing reporting the action is silent: { # report_timing := false;; val it : unit = () # MESON[] `!f g:num->num. (?!x. x = g(f(x))) <=> (?!y. y = f(g(y)))`;; val it : thm = |- !f g. (?!x. x = g (f x)) <=> (?!y. y = f (g y)) } \SEEALSO remark, report_timing. \ENDDOC hol-light/Help/vfree_in.doc000066400000000000000000000026071303454263000161260ustar00rootroot00000000000000\DOC vfree_in \TYPE {vfree_in : term -> term -> bool} \SYNOPSIS Tests whether a variable (or constant) occurs free in a term. \DESCRIBE The call {vfree_in v t}, where {v} is a variable (or constant, though this is not usually exploited) and {t} any term, tests whether {v} occurs free in {t}, and returns {true} if so, {false} if not. This is functionally equivalent to {mem v (frees t)} but may be more efficient because it never constructs the list of free variables explicitly. \FAILURE Never fails. \EXAMPLE Here's a simple example: { # vfree_in `x:num` `x + y + 1`;; val it : bool = true # vfree_in `x:num` `x /\ y /\ z`;; val it : bool = false } To see how using {vfree_in} can be more efficient than examining the free variable list explicitly, consider a huge term with one free and one bound variable: { # let tm = mk_abs(`p:bool`,funpow 17 (fun s -> mk_conj(s,s)) `p /\ q`);; .... } \noindent It takes an appreciable time to get the list of free variables: { # time frees tm;; CPU time (user): 0.31 val it : term list = [`q`] } \noindent yet we can test if {p} or {q} is free almost instantaneously. Only a little of the term needs to be traversed to find the answer (just one level in the case of {p}, since it is bound at the outer term constructor). { # time (vfree_in `q:bool`) tm;; CPU time (user): 0. val it : bool = true } \SEEALSO free_in, frees, freesin. \ENDDOC hol-light/Help/vsubst.doc000066400000000000000000000022641303454263000156560ustar00rootroot00000000000000\DOC vsubst \TYPE {vsubst : (term * term) list -> term -> term} \SYNOPSIS Substitute terms for variables inside a term. \DESCRIBE The call {vsubst [t1,x1; ...; tn,xn] t} systematically replaces free instances of each variable {xi} inside {t} with the corresponding {ti} from the instantiation list. Bound variables will be renamed if necessary to avoid capture. \FAILURE Fails if any of the pairs {ti,xi} in the instantiation list has {xi} and {ti} with different types, or {xi} a non-variable. Multiple instances of the same {xi} in the list are not trapped, but only the first one will be used consistently. \EXAMPLE Here is a relatively simple example { # vsubst [`1`,`x:num`; `2`,`y:num`] `x + y + 3`;; val it : term = `1 + 2 + 3` } \noindent and here is a more complex instance where renaming of bound variables is needed: { # vsubst [`y:num`,`x:num`] `!y. x + y < x + y + 1`;; val it : term = `!y'. y + y' < y + y' + 1` } \COMMENTS An analogous function {subst} is more general, and will substitute for free occurrences of any term, not just variables. However, {vsubst} is generally much more efficient if you do just need substitution for variables. \SEEALSO inst, subst. \ENDDOC hol-light/Help/warn.doc000066400000000000000000000007311303454263000152740ustar00rootroot00000000000000\DOC warn \TYPE {warn : bool -> string -> unit} \SYNOPSIS Prints out a warning string \DESCRIBE When applied to a boolean value {b} and a string {s}, the call {warn b s} prints out ``{Warning: s}'' and a following newline to the terminal if {b} is true and otherwise does nothing. \FAILURE Never fails. \EXAMPLE { # let n = 7;; val n : int = 7 # warn (n <> 0) "Nonzero value";; Warning: Nonzero value val it : unit = () } \SEEALSO remark, report. \ENDDOC hol-light/Help/zip.doc000066400000000000000000000004261303454263000151300ustar00rootroot00000000000000\DOC zip \TYPE {zip : 'a list -> 'b list -> ('a * 'b) list} \SYNOPSIS Converts a pair of lists into a list of pairs. \DESCRIBE {zip [x1;...;xn] [y1;...;yn]} returns {[(x1,y1);...;(xn,yn)]}. \FAILURE Fails if the two lists are of different lengths. \SEEALSO unzip. \ENDDOC hol-light/IEEE/000077500000000000000000000000001303454263000134545ustar00rootroot00000000000000hol-light/IEEE/README000066400000000000000000000022171303454263000143360ustar00rootroot00000000000000 FORMAL THEORY OF IEEE FLOATING-POINT NUMBERS (c) Charlie Jacobsen, 2014 University of Utah Distributed under the same license as HOL Light Also available at https://github.com/skoobit/formal-ieee Overview -------- This repository contains a formalization of IEEE floating point numbers. First, we formalize fixed point numbers so we can model IEEE subnormal numbers (in fixed.hl and fixed_thms.hl). Next, we formalize `generalized' floating point numbers to model IEEE normal numbers (in float.hl and float_thms.hl; Cf. John Harrison's work and the Coq formalization). Finally, we piece the two formalizations together to formalize IEEE (ieee.hl and ieee_thms.hl). In the process, we needed a formalization and basic theorems for raising real numbers to an integer power; this is in common.hl. IEEE floating point numbers are treated as a subset of the real numbers. We can model mostly everything except signed zero and NaNs. Usage ----- To load the theorems and formalizations, load IEEE/make.ml after loading base HOL Light, e.g. loadt "IEEE/make.ml";; hol-light/IEEE/common.hl000066400000000000000000001061151303454263000152750ustar00rootroot00000000000000(* ========================================================================== *) (* COMMON DEFINITIONS AND THEOREMS *) (* ========================================================================== *) (* -------------------------------------------------------------------------- *) (* LABEL_CONJUNCTS_TAC *) (* -------------------------------------------------------------------------- *) let rec LABEL_CONJUNCTS_TAC labels thm = if is_conj(concl(thm)) then CONJUNCTS_THEN2 (fun c1 -> LABEL_TAC (hd labels) c1) (fun c2 -> LABEL_CONJUNCTS_TAC (tl labels) c2) thm else LABEL_TAC (hd labels) thm;; (* -------------------------------------------------------------------------- *) (* ipow: pow with integer exponent *) (* -------------------------------------------------------------------------- *) unparse_as_infix("ipow");; let ipow = define `ipow (x:real) (e:int) = (if (&0 <= e) then (x pow (num_of_int e)) else (inv (x pow (num_of_int (--e)))))`;; parse_as_infix("ipow",(24,"left"));; let IPOW_LT_0 = prove(`!(r:real) (i:int). &0 < r ==> &0 < r ipow i`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ipow] THEN COND_CASES_TAC THENL [ (* 0 <= i *) CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (i:int)`)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; (* i < 0 *) SUBGOAL_THEN `&0 <= --(i:int)` (fun thm -> CHOOSE_THEN (fun thm2 -> REWRITE_TAC[thm2]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] thm)) THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]]);; let IPOW_INV_NEG = prove(`!(x:real) (i:int). ~(x = &0) ==> x ipow i = inv(x ipow -- i)`, REPEAT GEN_TAC THEN DISCH_THEN(fun thm -> LABEL_TAC "xn0" thm) THEN REWRITE_TAC[ipow] THEN ASM_CASES_TAC `&0 <= (i:int)` THENL [ ASM_CASES_TAC `&0 <= --(i:int)` THENL [ (* i = 0 *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (i:int) /\ &0 <= --i ==> i = &0`) (CONJ (ASSUME `&0 <= (i:int)`) (ASSUME `&0 <= --(i:int)`))] THEN REWRITE_TAC[ARITH_RULE `-- (&0:int) = (&0:int)`] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN ARITH_TAC; (* -i < 0, so i > 0 *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `-- -- (x:int) = x`] THEN CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (i:int)`)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[REAL_INV_INV]]; (* i < 0 *) ASM_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(&0 <= (i:int)) ==> (&0 <= --i <=> T)`) (ASSUME `~(&0 <= (i:int))`)]]);; (* I'm sure this proof could be shortened ... yikes! *) let IPOW_ADD_EXP = prove(`!(x:real) (u:int) (v:int). ~(x = &0) ==> (x ipow u) * (x ipow v) = (x ipow (u + v))`, (* lemma 1: prove when u, v non-negative *) SUBGOAL_THEN `!(x:real) (u:int) (v:int). ~(x = &0) /\ &0 <= u /\ &0 <= v ==> (x ipow u) * (x ipow v) = (x ipow (u + v))` (LABEL_TAC "lem1") THENL [ REPEAT GEN_TAC THEN DISCH_THEN(fun thm -> CONJUNCTS_THEN2 (fun xn0 -> LABEL_TAC "xn0" xn0) (fun uvge0 -> CONJUNCTS_THEN2 (fun uge0 -> LABEL_TAC "uge0" uge0) (fun vge0 -> LABEL_TAC "vge0" vge0) uvge0) thm) THEN REWRITE_TAC[ipow] THEN ASM_REWRITE_TAC[] THEN USE_THEN "uge0" (fun uge0 -> USE_THEN "vge0" (fun vge0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (u:int) /\ &0 <= (v:int) ==> &0 <= u + v`) (CONJ uge0 vge0)])) THEN USE_THEN "uge0" (fun uge0 -> X_CHOOSE_THEN `n:num` (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] uge0)) THEN USE_THEN "vge0" (fun vge0 -> X_CHOOSE_THEN `m:num` (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] vge0)) THEN REWRITE_TAC[INT_OF_NUM_ADD] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[GSYM REAL_POW_ADD]; ALL_TAC] THEN (* lemma 2: proof when u negative, v non-negative *) SUBGOAL_THEN `!(x:real) (u:int) (v:int). ~(x = &0) /\ u < &0 /\ &0 <= v ==> (x ipow u) * (x ipow v) = (x ipow (u + v))` (LABEL_TAC "lem2") THENL [ REPEAT GEN_TAC THEN DISCH_THEN(fun thm -> CONJUNCTS_THEN2 (fun xn0 -> LABEL_TAC "xn0" xn0) (fun uv -> CONJUNCTS_THEN2 (fun ul0 -> LABEL_TAC "ul0" ul0) (fun vge0 -> LABEL_TAC "vge0" vge0) uv) thm) THEN REWRITE_TAC[ipow] THEN ASM_REWRITE_TAC[] THEN USE_THEN "ul0" (fun ul0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(u:int) < &0 ==> ~(&0 <= u)`) ul0]) THEN USE_THEN "ul0" (fun ul0 -> X_CHOOSE_THEN `n:num` (LABEL_TAC "ueqn") (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] (MATCH_MP (ARITH_RULE `(x:int) < &0 ==> &0 <= --x`) ul0))) THEN USE_THEN "vge0" (fun vge0 -> X_CHOOSE_THEN `m:num` (LABEL_TAC "veqm") (REWRITE_RULE [GSYM INT_OF_NUM_EXISTS] vge0)) THEN ASM_CASES_TAC `&0 <= (u:int) + (v:int)` THENL [ LABEL_TAC "upvge0" (ASSUME `&0 <= (u:int) + (v:int)`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(u:int) + (&m:int) = &m - (--u)`] THEN ASM_REWRITE_TAC[] THEN USE_THEN "ueqn" (fun ueqn -> USE_THEN "veqm" (fun veqm -> USE_THEN "upvge0" (fun upvge0 -> LABEL_TAC "nlem" (REWRITE_RULE [INT_OF_NUM_LE] (REWRITE_RULE [ueqn; veqm] (MATCH_MP (ARITH_RULE `&0 <= (u:int) + (v:int) ==> --u <= v`) upvge0)))))) THEN USE_THEN "nlem" (fun nlem -> REWRITE_TAC [MATCH_MP INT_OF_NUM_SUB nlem]) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN REWRITE_TAC[GSYM real_div] THEN USE_THEN "xn0" (fun xn0 -> REWRITE_TAC [MATCH_MP REAL_DIV_POW2 xn0]) THEN ASM_REWRITE_TAC[]; (* u + v negative *) LABEL_TAC "upvnge0" (ASSUME `~(&0 <= (u:int) + (v:int))`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `--((u:int) + (&m:int)) = -- u - &m`] THEN ASM_REWRITE_TAC[] THEN USE_THEN "ueqn" (fun ueqn -> USE_THEN "veqm" (fun veqm -> USE_THEN "upvnge0" (fun upvnge0 -> LABEL_TAC "mln" (REWRITE_RULE [INT_OF_NUM_LT] (REWRITE_RULE [ueqn; veqm] (MATCH_MP (ARITH_RULE `~(&0 <= (u:int) + (v:int)) ==> v < --u`) upvnge0)))))) THEN USE_THEN "mln" (fun mln -> REWRITE_TAC [MATCH_MP INT_OF_NUM_SUB (MATCH_MP (ARITH_RULE `m < n ==> m <= n`) mln)]) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN REWRITE_TAC[GSYM real_div] THEN USE_THEN "xn0" (fun xn0 -> REWRITE_TAC[MATCH_MP REAL_DIV_POW2 xn0]) THEN ASM_ARITH_TAC]; ALL_TAC] THEN (* MAIN RESULT *) REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xn0") THEN (* A: xn0 *) ASM_CASES_TAC `&0 <= (u:int)` THENL [ (* u non-negative *) ASM_CASES_TAC `&0 <= (v:int)` THENL [ (* v non-negative; use lemma 1 *) USE_THEN "lem1" (fun lem1 -> MATCH_MP_TAC lem1 THEN ASM_REWRITE_TAC[]); (* v negative; use lemma 2 *) ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:int) + (b:int) = b + a`] THEN USE_THEN "lem2" (fun lem2 -> MATCH_MP_TAC lem2 THEN ASM_ARITH_TAC)]; (* u negative *) ASM_CASES_TAC `&0 <= (v:int)` THENL [ (* v non-negative; use lemma 2 *) USE_THEN "lem2" (fun lem2 -> MATCH_MP_TAC lem2) THEN ASM_ARITH_TAC; (* v negative; use lemma 1 *) USE_THEN "xn0" (fun xn0 -> ONCE_REWRITE_TAC[MATCH_MP IPOW_INV_NEG xn0]) THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[REAL_EQ_INV2] THEN REWRITE_TAC[ARITH_RULE `--((u:int) + (v:int)) = --u + --v`] THEN USE_THEN "lem1" (fun lem1 -> MATCH_MP_TAC lem1) THEN ASM_ARITH_TAC]]);; let IPOW_EQ_EXP = prove(`!(r:num) (i:int). &0 <= i ==> ?(m:num). m = num_of_int(i) /\ &r ipow i = &(r EXP m)`, REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN(fun thm -> LABEL_TAC "ige0" thm) THEN EXISTS_TAC `num_of_int(i)` THEN ASM_REWRITE_TAC[] THEN USE_THEN "ige0" (fun ige0 -> CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] ige0)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[REAL_OF_NUM_POW]);; let IPOW_EQ_EXP_P = prove(`!(r:num) (p:num). 0 < p ==> &r ipow (&p - &1) = &(r EXP (p - 1))`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> LABEL_TAC "pg0" thm) THEN USE_THEN "pg0" (fun pg0 -> (LABEL_TAC "pm1ge0" (MATCH_MP (ARITH_RULE `0 < p ==> 0 <= p - 1`) pg0))) THEN USE_THEN "pm1ge0" (fun pm1ge0 -> LABEL_TAC "intge0" (REWRITE_RULE[GSYM INT_OF_NUM_LE] pm1ge0)) THEN USE_THEN "intge0" (fun intge0 -> CHOOSE_THEN (fun thm -> LABEL_TAC "m" thm) (MATCH_MP (SPEC `r:num` IPOW_EQ_EXP) intge0)) THEN USE_THEN "m" (fun m -> MAP_EVERY (fun pair -> (LABEL_TAC (fst pair) (snd pair))) (zip ["m1"; "m2"] (CONJUNCTS m))) THEN USE_THEN "pg0" (fun pg0 -> REWRITE_TAC[MATCH_MP INT_OF_NUM_SUB (REWRITE_RULE[ARITH_RULE `0 < x <=> 1 <= x`] pg0)]) THEN USE_THEN "m1" (fun m1 -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM (REWRITE_RULE[ NUM_OF_INT_OF_NUM] m1)]) THEN ASM_REWRITE_TAC[]);; let IPOW_BETWEEN = prove(`!(x:real) (y:num) (z:num) (e:int). &0 < x /\ &y * x ipow e <= &z * x ipow e /\ &z * x ipow e <= (&y + &1) * x ipow e ==> z = y \/ z = y + 1`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgt0"; "ineq1"; "ineq2"]) THEN (* lemma: y <= z *) SUBGOAL_THEN `(y:num) <= z` (LABEL_TAC "ylez") THENL [ REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `(x ipow e)` THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IPOW_LT_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* lemma: z <= y + 1 *) SUBGOAL_THEN `(z:num) <= y + 1` (LABEL_TAC "zleyp1") THENL [ REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `(x ipow e)` THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IPOW_LT_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC);; let IPOW_TO_1 = prove(`!(x:real). x ipow &1 = x`, GEN_TAC THEN REWRITE_TAC[ipow] THEN REWRITE_TAC[ARITH_RULE `&0 <= (&1:int) <=> T`] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN ARITH_TAC);; let IPOW_TO_0 = prove(`!(x:real). x ipow &0 = &1`, GEN_TAC THEN REWRITE_TAC[ipow] THEN REWRITE_TAC[ARITH_RULE `&0 <= (&0:int) <=> T`] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN ARITH_TAC);; let IPOW_LE_1 = prove(`!(x:real) (e:int). &1 <= x /\ &0 <= e ==> &1 <= x ipow e`, REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgeq1"; "egeq0"]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "egeq0" (fun egeq0 -> CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] egeq0)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC REAL_POW_LE_1 THEN ASM_REWRITE_TAC[]);; let IPOW_LT_1 = prove(`!(x:real) (e:int). &1 < x /\ &0 < e ==> &1 < x ipow e`, REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgt1"; "egt0"]) THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 < (e:int) ==> ((&0 <= e) <=> T)`) (ASSUME `&0 < (e:int)`)] THEN USE_THEN "egt0" (fun egt0 -> CHOOSE_THEN (LABEL_TAC "eeqn") (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (MATCH_MP (ARITH_RULE `&0 < (e:int) ==> &0 <= e`) egt0))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC (SPEC `n:num` REAL_POW_LT_1) THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN USE_THEN "eeqn" (fun eeqn -> REWRITE_TAC[GSYM eeqn]) THEN ASM_ARITH_TAC; ASM_ARITH_TAC]);; let IPOW_LE_NUM = let lem1 = prove(`!(r:num) (n:num). 2 <= r ==> ?(e:int). &0 <= e /\ &n <= &r ipow e`, GEN_TAC THEN INDUCT_TAC THENL [ (* base case *) DISCH_TAC THEN EXISTS_TAC `(&0):int` THEN REWRITE_TAC[ARITH_RULE `&0 <= (&0:int) <=> T`] THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> &0 <= x`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; (* inductive step *) DISCH_THEN (LABEL_TAC "rgeq2") THEN USE_THEN "rgeq2" (fun rgeq2 -> CHOOSE_THEN (LABEL_TAC "nleqpow") (MATCH_MP (ASSUME `2 <= r ==> (?e. &0 <= e /\ &n <= &r ipow e)`) rgeq2)) THEN EXISTS_TAC `e + (&1:int)` THEN REWRITE_TAC[ADD1] THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&r ipow (e + &1) = &r ipow e * &r ipow &1` (fun thm -> REWRITE_TAC[thm]) THENL [ ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MATCH_MP_TAC IPOW_ADD_EXP THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IPOW_TO_1] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * &r ipow e` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[ARITH_RULE `&2 * x = x + (x:real)`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC (ARITH_RULE `x <= (y:real) /\ z <= w ==> x + z <= y + w`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IPOW_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(a:real) * b = b * a`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> &0 <= x`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]]) in prove(`!(r:num) (n:num). 2 <= r ==> ?(e:int). &n <= &r ipow e`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> CHOOSE_TAC (SPEC `n:num` (MATCH_MP lem1 thm))) THEN EXISTS_TAC `e:int` THEN ASM_REWRITE_TAC[]);; let IPOW_LE_REAL = prove(`!(r:num) (z:real). 2 <= r ==> ?(e:int). z <= &r ipow e`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "rgeq2") THEN CHOOSE_THEN (LABEL_TAC "nbound") (SPEC `z:real` REAL_ARCH_SIMPLE) THEN USE_THEN "rgeq2" (fun rgeq2 -> CHOOSE_TAC (SPEC `n:num` (MATCH_MP IPOW_LE_NUM rgeq2))) THEN EXISTS_TAC `e:int` THEN ASM_ARITH_TAC);; let IPOW_LE_REAL_2 = prove(`!(r:num) (z:real). &0 < z /\ 2 <= r ==> ?(e:int). &r ipow e <= z`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["zgt0"; "rgeq2"]) THEN USE_THEN "rgeq2" (fun rgeq2 -> CHOOSE_THEN (LABEL_TAC "recip") (SPEC `&1 / (z:real)` (MATCH_MP IPOW_LE_REAL rgeq2))) THEN EXISTS_TAC `-- (e:int)` THEN USE_THEN "rgeq2" (fun rgeq2 -> ONCE_REWRITE_TAC[MATCH_MP IPOW_INV_NEG (MATCH_MP (ARITH_RULE `&2 <= &r ==> ~(&r = &0)`) (REWRITE_RULE[GSYM REAL_OF_NUM_LE] rgeq2))]) THEN REWRITE_TAC[ARITH_RULE `-- -- (e:int) = e`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_INV THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(x:real) = &1 * x`] THEN REWRITE_TAC[GSYM real_div] THEN ASM_REWRITE_TAC[]]);; let IPOW_MONOTONE = prove(`!(x:num) (e1:int) (e2:int). 2 <= x /\ &x ipow e1 <= &x ipow e2 ==> e1 <= e2`, REPEAT GEN_TAC THEN REWRITE_TAC[ipow] THEN ASM_CASES_TAC `&0 <= (e1:int)` THENL [ (* 0 <= e1 *) ASM_CASES_TAC `&0 <= (e2:int)` THENL [ (* 0 <= e2 *) ASM_REWRITE_TAC[] THEN CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (e1:int)`)) THEN CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (e2:int)`)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[INT_OF_NUM_LE] THEN REWRITE_TAC[LE_EXP] THEN REWRITE_TAC[GSYM IMP_IMP] THEN DISCH_THEN (LABEL_TAC "xgeq2") THEN USE_THEN "xgeq2" (fun xgeq2 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= x ==> ((x = 0) <=> F)`) xgeq2]) THEN DISCH_THEN DISJ_CASES_TAC THENL [ ASM_ARITH_TAC; ASM_REWRITE_TAC[]]; (* e2 < 0 *) REWRITE_TAC[GSYM ipow] THEN REWRITE_TAC[GSYM IMP_IMP] THEN DISCH_THEN (LABEL_TAC "xgeq2") THEN SUBGOAL_THEN `&x ipow e2 = inv (&x ipow -- e2)` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?e2':int. &0 < e2' /\ --e2 = e2'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e2pgeq0"; "e2eq"])) THENL [ EXISTS_TAC `-- e2:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `inv (&x ipow e2') < &x ipow e1` (LABEL_TAC "e2plte1") THENL [ MATCH_MP_TAC (ARITH_RULE `!y. (x:real) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `&1:real` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[ ARITH_RULE `(&1:real) = (inv (&1:real))`] THEN MATCH_MP_TAC REAL_LT_INV2 THEN CONJ_TAC THENL [ ARITH_TAC; MATCH_MP_TAC IPOW_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; MATCH_MP_TAC IPOW_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; ALL_TAC] THEN DISCH_TAC THEN ASM_ARITH_TAC]; (* e1 < 0 *) ASM_CASES_TAC `&0 <= (e2:int)` THENL [ (* 0 <= e2 *) DISCH_TAC THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `(&0):int` THEN ASM_ARITH_TAC; (* e2 < 0 *) REWRITE_TAC[GSYM ipow] THEN REWRITE_TAC[GSYM IMP_IMP] THEN DISCH_THEN (LABEL_TAC "xgeq2") THEN SUBGOAL_THEN `&x ipow e1 = inv (&x ipow -- e1)` (LABEL_TAC "e1eqinv") THENL [ MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&x ipow e2 = inv (&x ipow -- e2)` (LABEL_TAC "e2eqinv") THENL [ MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `&x ipow -- e2 <= &x ipow -- e1` MP_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN USE_THEN "e1eqinv" (fun e1eqinv -> REWRITE_TAC[GSYM e1eqinv]) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?e1':int. &0 <= e1' /\ --e1 = e1'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e1pgeq0"; "e1eq"])) THENL [ EXISTS_TAC `-- e1:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?e2':int. &0 <= e2' /\ --e2 = e2'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e2pgeq0"; "e2eq"])) THENL [ EXISTS_TAC `-- e2:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `e1 <= (e2:int) <=> e2' <= (e1':int)` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ipow] THEN ASM_REWRITE_TAC[] THEN USE_THEN "e1pgeq0" (fun e1pgeq0 -> CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] e1pgeq0)) THEN USE_THEN "e2pgeq0" (fun e2pgeq0 -> CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] e2pgeq0)) THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN REWRITE_TAC[REAL_OF_NUM_POW] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[INT_OF_NUM_LE] THEN REWRITE_TAC[LE_EXP] THEN REWRITE_TAC[GSYM IMP_IMP] THEN USE_THEN "xgeq2" (fun xgeq2 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= x ==> ((x = 0) <=> F)`) xgeq2]) THEN DISCH_THEN DISJ_CASES_TAC THENL [ ASM_ARITH_TAC; ASM_REWRITE_TAC[]]]]);; let IPOW_MONOTONE_2 = prove(`!(x:real) (e1:int) (e2:int). &1 <= x /\ e1 <= e2 ==> x ipow e1 <= x ipow e2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xgeq1"; "e1leqe2"]) THEN REWRITE_TAC[ipow] THEN ASM_CASES_TAC `&0 <= (e1:int)` THENL [ (* 0 <= e1 *) SUBGOAL_THEN `&0 <= (e2:int)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (e1:int)`)) THEN CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] (ASSUME `&0 <= (e2:int)`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_ARITH_TAC; (* e1 < 0 *) REWRITE_TAC[GSYM ipow] THEN ASM_CASES_TAC `&0 <= (e2:int)` THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1:real` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[MATCH_MP IPOW_INV_NEG (MATCH_MP (ARITH_RULE `&1 <= (x:real) ==> ~(x = &0)`) (ASSUME `&1 <= (x:real)`))] THEN SUBGOAL_THEN `?(e1':int). &0 <= e1' /\ -- e1 = e1'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e1geq0"; "e1eq"])) THENL [ EXISTS_TAC `-- e1:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MATCH_MP_TAC IPOW_LE_1 THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC IPOW_LE_1 THEN ASM_REWRITE_TAC[]]; (* e2 < 0 *) ONCE_REWRITE_TAC[MATCH_MP IPOW_INV_NEG (MATCH_MP (ARITH_RULE `&1 <= (x:real) ==> ~(x = &0)`) (ASSUME `&1 <= (x:real)`))] THEN SUBGOAL_THEN `?(e1':int). &0 <= e1' /\ -- e1 = e1'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e1geq0"; "e1eq"])) THENL [ EXISTS_TAC `-- e1:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?(e2':int). &0 <= e2' /\ -- e2 = e2'` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["e2geq0"; "e2eq"])) THENL [ EXISTS_TAC `-- e2:int` THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN USE_THEN "xgeq1" (fun xgeq1 -> REWRITE_TAC[MATCH_MP (SPEC `x:real` IPOW_LT_0) (MATCH_MP (ARITH_RULE `&1 <= (x:real) ==> &0 < x`) xgeq1)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ipow] THEN USE_THEN "e1geq0" (fun e1geq0 -> CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] e1geq0)) THEN USE_THEN "e2geq0" (fun e2geq0 -> CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] e2geq0)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_ARITH_TAC]]);; let IPOW_MUL_INV_EQ_1 = prove(`!(x:real) (i:int). &0 < x ==> x ipow i * x ipow (-- i) = &1`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xgt0") THEN SUBGOAL_THEN `~(x = &0)` (LABEL_TAC "xneq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) [MATCH_MP IPOW_INV_NEG xneq0]) THEN ONCE_REWRITE_TAC[ARITH_RULE `x * y = y * (x:real)`] THEN MATCH_MP_TAC REAL_MUL_RINV THEN MATCH_MP_TAC (ARITH_RULE `&0 < z ==> ~(z = &0)`) THEN MATCH_MP_TAC IPOW_LT_0 THEN ASM_REWRITE_TAC[]);; (* -------------------------------------------------------------------------- *) (* rerror *) (* -------------------------------------------------------------------------- *) let rerror = define `rerror (a:real) (b:real) = abs((b - a) / a)`;; (* -------------------------------------------------------------------------- *) (* closer *) (* -------------------------------------------------------------------------- *) let closer = define `closer (x:real) (y:real) (z:real) = (abs(x - z) < abs(y - z))`;; (* -------------------------------------------------------------------------- *) (* Misc helpful theorems *) (* -------------------------------------------------------------------------- *) let DOUBLE_NOT_ODD = prove(`!(n:num). ODD(2 * n) <=> F`, REWRITE_TAC[GSYM NOT_EVEN] THEN REWRITE_TAC[EVEN_DOUBLE]);; let DOUBLE_NEG_1_ODD = prove(`!(f:num). 0 < f ==> ODD(2 * f - 1)`, GEN_TAC THEN DISCH_THEN(fun thm -> CHOOSE_TAC (REWRITE_RULE[ADD] (REWRITE_RULE[LT_EXISTS] thm))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `2 * SUC(d) - 1 = SUC(2 *d)`] THEN REWRITE_TAC[ODD_DOUBLE]);; let REAL_MULT_NOT_0 = REAL_RING `z = x * y /\ ~(z = &0) ==> ~(x = &0) /\ ~(y = &0)`;; let EXP_LE_1 = prove(`!(x:num) (n:num). ~(x = 0) ==> 1 <= x EXP n`, REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [ARITH_RULE `1 = x EXP 0`] THEN REWRITE_TAC[LE_EXP] THEN COND_CASES_TAC THENL [ ASM_ARITH_TAC; ARITH_TAC]);; let NUM_LE_MUL_1 = prove(`!(a:num) (b:num). 1 <= a * b ==> 1 <= a`, REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE `a = 0 \/ 1 <= a`) THENL [ DISJ_CASES_TAC (ARITH_RULE `b = 0 \/ 1 <= b`) THENL [ ASM_REWRITE_TAC[] THEN ARITH_TAC; ASM_REWRITE_TAC[] THEN ARITH_TAC]; DISJ_CASES_TAC (ARITH_RULE `b = 0 \/ 1 <= b`) THENL [ ASM_REWRITE_TAC[] THEN ARITH_TAC; ASM_ARITH_TAC]]);; (* -------------------------------------------------------------------------- *) (* Supremum for naturals and integers *) (* -------------------------------------------------------------------------- *) let is_sup_num = define `is_sup_num (s:num->bool) (n:num) = (n IN s /\ !n'. n' IN s ==> n' <= n)`;; let is_sup_int = define `is_sup_int (s:int->bool) (e:int) = (e IN s /\ !e'. e' IN s ==> e' <= e)`;; let sup_num = define `sup_num (s:num->bool) = (@(n:num). is_sup_num s n)`;; let sup_int = define `sup_int (s:int->bool) = (@(e:int). is_sup_int s e)`;; (* by induction *) let SUP_NUM_BOUNDED = prove(`!(s:num->bool) (b:num). ~(s = {}) /\ (!n. n IN s ==> n <= b) ==> ?(n':num). sup_num s = n' /\ is_sup_num s n'`, GEN_TAC THEN INDUCT_TAC THENL [ (* base case *) DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN EXISTS_TAC `0:num` THEN SUBGOAL_THEN `is_sup_num s 0` (LABEL_TAC "supeq0") THENL [ REWRITE_TAC[is_sup_num] THEN ASM_REWRITE_TAC[] THEN USE_THEN "snote" (fun snote -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["smallestins"; "notins"]) (MATCH_MP (REWRITE_RULE[WF] WF_num) (REWRITE_RULE[GSYM MEMBER_NOT_EMPTY] snote))) THEN SUBGOAL_THEN `x = 0` ASSUME_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `x <= 0 ==> x = 0`) THEN USE_THEN "smallestins" (fun smallestins -> USE_THEN "bound" (fun bound -> REWRITE_TAC[MATCH_MP bound smallestins])); ALL_TAC] THEN REWRITE_TAC[GSYM (ASSUME `x = 0`)] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. is_sup_num s x ==> x = 0` (LABEL_TAC "all0") THENL [ GEN_TAC THEN REWRITE_TAC[is_sup_num] THEN DISCH_THEN ( LABEL_CONJUNCTS_TAC ["xins"; "bound2"]) THEN MATCH_MP_TAC (ARITH_RULE `x <= 0 ==> x = 0`) THEN USE_THEN "bound" (fun bound -> REWRITE_TAC[MATCH_MP bound (ASSUME `(x:num) IN s`)]); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[sup_num] THEN SELECT_ELIM_TAC THEN GEN_TAC THEN USE_THEN "supeq0" (fun supeq0 -> USE_THEN "all0" (fun all0 -> DISCH_THEN (fun thm -> REWRITE_TAC[MATCH_MP all0 (MATCH_MP thm supeq0)]))); (* inductive step *) DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN ASM_CASES_TAC `SUC(b) IN s` THENL [ EXISTS_TAC `SUC(b)` THEN SUBGOAL_THEN `is_sup_num s (SUC b)` (LABEL_TAC "supeq") THENL [ REWRITE_TAC[is_sup_num] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. is_sup_num s x ==> x = SUC b` (LABEL_TAC "alleq") THENL [ GEN_TAC THEN REWRITE_TAC[is_sup_num] THEN DISCH_THEN ( LABEL_CONJUNCTS_TAC ["xins"; "bound2"]) THEN SUBGOAL_THEN `x <= SUC b` ASSUME_TAC THENL [ USE_THEN "xins" (fun xins -> USE_THEN "bound" (fun bound -> REWRITE_TAC[MATCH_MP bound xins])); ALL_TAC] THEN SUBGOAL_THEN `SUC b <= x` ASSUME_TAC THENL [ USE_THEN "bound2" (fun bound -> REWRITE_TAC[MATCH_MP bound (ASSUME `SUC b IN s`)]); ALL_TAC] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[sup_num] THEN SELECT_ELIM_TAC THEN GEN_TAC THEN USE_THEN "supeq" (fun supeq -> USE_THEN "alleq" (fun alleq -> DISCH_THEN (fun thm -> REWRITE_TAC[MATCH_MP alleq (MATCH_MP thm supeq)]))); (* suc b not in s *) SUBGOAL_THEN `!n. n IN s ==> n <= (b:num)` (LABEL_TAC "bound2") THENL [ GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC (ARITH_RULE `~(n = SUC b) /\ n <= (SUC b) ==> n <= b`) THEN USE_THEN "bound" (fun bound -> REWRITE_TAC[MATCH_MP bound (ASSUME `(n:num) IN s`)]) THEN SUBGOAL_THEN `!x. x = SUC b ==> ~(x IN s)` (fun thm -> MATCH_MP_TAC (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] thm)) THENL [ GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "snote" (fun snote -> USE_THEN "bound2" (fun bound2 -> REWRITE_TAC[MATCH_MP (ASSUME `~(s = {}) /\ (!n. n IN s ==> n <= b) ==> (?n'. sup_num s = n' /\ is_sup_num s n')`) (CONJ snote bound2)]))]]);; let SUP_INT_BOUNDED = let lem1 = prove(`!(s:int->bool) (b:int). ~(s = {}) /\ (!e. e IN s ==> e <= b) ==> ?(e':int). is_sup_int s e'`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["snote"; "bound"]) THEN SUBGOAL_THEN `?e. (e:int) IN s` (CHOOSE_THEN (LABEL_TAC "eins")) THENL [ USE_THEN "snote" (fun snote -> ASSUME_TAC( MATCH_MP CHOICE_DEF snote)) THEN EXISTS_TAC `CHOICE (s:int->bool)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~({n | ?(e'':int). n = num_of_int(e'' - e) /\ e'' IN s /\ e <= e''} = {})` (LABEL_TAC "nnote") THENL [ REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `0:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `e:int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_LE_REFL] THEN REWRITE_TAC[ARITH_RULE `e - (e:int) = &0`] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM]; ALL_TAC] THEN SUBGOAL_THEN `?(bn:num). !n. n IN {n | ?(e'':int). n = num_of_int(e'' - e) /\ e'' IN s /\ e <= e''} ==> n <= bn` (CHOOSE_THEN (LABEL_TAC "bound2")) THENL [ EXISTS_TAC `num_of_int(b - e)` THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (fun thm -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["eqn"; "eins2"; "eleq"]) thm) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN SUBGOAL_THEN `&0 <= e'' - (e:int)` (fun thm -> REWRITE_TAC[REWRITE_RULE[NUM_OF_INT] thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= b - (e:int)` (fun thm -> REWRITE_TAC[REWRITE_RULE[NUM_OF_INT] thm]) THENL [ USE_THEN "bound" (fun bound -> USE_THEN "eins" (fun eins -> ASSUME_TAC (MATCH_MP bound eins))) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "bound" (fun bound -> USE_THEN "eins2" (fun eins2 -> ASSUME_TAC (MATCH_MP bound eins2))) THEN ASM_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `(int_of_num ( sup_num {n | ?(e'':int). n = num_of_int(e'' - e) /\ e'' IN s /\ e <= e''})) + e` THEN USE_THEN "nnote" (fun nnote -> USE_THEN "bound2" (fun bound2 -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["supnumeq"; "issupnum"]) (MATCH_MP SUP_NUM_BOUNDED (CONJ nnote bound2)))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_sup_int] THEN USE_THEN "issupnum" (fun issupnum -> LABEL_CONJUNCTS_TAC ["nins"; "nbounds"] (REWRITE_RULE[is_sup_num] issupnum)) THEN SUBGOAL_THEN `?(e'':int). e'' IN s /\ e <= e'' /\ (int_of_num n') = e'' - e` (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["eins2"; "eleq"; "emine"])) THENL [ USE_THEN "nins" (fun nins -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["eins2"; "emine"; "eleq"]) (REWRITE_RULE[IN_ELIM_THM] nins)) THEN EXISTS_TAC `e'':int` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= e'' - (e:int)` (fun thm -> REWRITE_TAC[REWRITE_RULE[NUM_OF_INT] thm]) THENL [ ASM_ARITH_TAC]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(e:int) - e' + e' = e`] THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "epins") THEN ASM_CASES_TAC `e' < (e:int)` THENL [ ASM_ARITH_TAC; ONCE_REWRITE_TAC[ARITH_RULE `(z:int) <= y <=> z - e <= y - e`] THEN USE_THEN "emine" (fun emine -> REWRITE_TAC[GSYM emine]) THEN SUBGOAL_THEN `&0 <= (e':int) - e` (fun thm -> CHOOSE_THEN (LABEL_TAC "eqepmine") (REWRITE_RULE[GSYM INT_OF_NUM_EXISTS] thm)) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "eqepmine" (fun eqepmine -> REWRITE_TAC[eqepmine]) THEN REWRITE_TAC[INT_OF_NUM_LE] THEN USE_THEN "nbounds" (fun nbounds -> MATCH_MP_TAC nbounds) THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `e':int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM] THEN ASM_ARITH_TAC]) in prove(`!(s:int->bool) (b:int). ~(s = {}) /\ (!e. e IN s ==> e <= b) ==> ?(e':int). sup_int s = e' /\ is_sup_int s e'`, REPEAT GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `sup_int s` THEN REWRITE_TAC[] THEN REWRITE_TAC[sup_int] THEN SELECT_ELIM_TAC THEN MATCH_MP_TAC lem1 THEN EXISTS_TAC `b:int` THEN ASM_REWRITE_TAC[]);; hol-light/IEEE/fixed.hl000066400000000000000000000116041303454263000151020ustar00rootroot00000000000000(* ========================================================================== *) (* FIXED POINT DEFINITIONS *) (* ========================================================================== *) (* needs "IEEE/common.hl";; *) (* -------------------------------------------------------------------------- *) (* Fixed point format *) (* -------------------------------------------------------------------------- *) (* Fix r:num > 1 and even, p:num > 0, and e:int. A fixed point number is a *) (* real number that can be written as *) (* *) (* +/- f * r^(e - p + 1) *) (* *) (* where *) (* *) (* -- f:num *) (* -- 0 <= f < r^(p - 1) *) let is_valid_fformat = define `is_valid_fformat (r:num, p:num, e:int) = (1 < r /\ (EVEN r) /\ (0 < p))`;; let fformat_typbij = new_type_definition "fformat" ("mk_fformat", "dest_fformat") (prove (`?(fmt:num#num#int). is_valid_fformat fmt`, EXISTS_TAC `(2:num, 1:num, (&0):int)` THEN REWRITE_TAC[is_valid_fformat] THEN ARITH_TAC));; let fr = define `fr (fmt:fformat) = (FST (dest_fformat fmt))`;; let fp = define `fp (fmt:fformat) = (FST (SND (dest_fformat fmt)))`;; let fe = define `fe (fmt:fformat) = (SND (SND (dest_fformat fmt)))`;; let is_frac = define `is_frac (fmt:fformat) (x:real) (f:num) = (f <= (fr fmt) EXP ((fp fmt) - 1) /\ abs(x) = &f * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1))`;; let ff = define `ff (fmt:fformat) (x:real) = (@(f:num) . is_frac(fmt) x f)`;; let is_fixed = define `is_fixed (fmt:fformat) (x:real) = (?(f:num) . is_frac(fmt) x f)`;; let is_finite_fixed = `is_fixed (fmt:fformat) (x:real) = (?(f:num) . (is_frac(fmt) x f) /\ f < (fr fmt) EXP ((fp fmt) - 1))`;; (* -------------------------------------------------------------------------- *) (* Helpful constants *) (* -------------------------------------------------------------------------- *) (* fixed point ulp *) let fulp = define `fulp (fmt:fformat) = (&(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1))`;; (* fixed point infinity *) let finf = define `finf (fmt:fformat) = (&(fr fmt) ipow (fe fmt))`;; let fixed = define `fixed (fmt:fformat) = { x | is_fixed(fmt) x }`;; (* -------------------------------------------------------------------------- *) (* Greatest / least *) (* -------------------------------------------------------------------------- *) let is_lb = define `is_lb (fmt:fformat) (x:real) (y:real) = (y IN (fixed fmt) /\ y <= x)`;; let is_glb = define `is_glb (fmt:fformat) (x:real) (y:real) = (is_lb(fmt) x y /\ (!y'. is_lb(fmt) x y' ==> y' <= y))`;; let is_ub = define `is_ub (fmt:fformat) (x:real) (y:real) = (y IN (fixed fmt) /\ x <= y)`;; let is_lub = define `is_lub (fmt:fformat) (x:real) (y:real) = (is_ub(fmt) x y /\ (!y'. is_ub(fmt) x y' ==> y <= y'))`;; (* Simple wrappers around sup / inf *) let glb = define `glb (fmt:fformat) (x:real) = sup({y:real | y IN (fixed fmt) /\ y <= x})`;; let lub = define `lub (fmt:fformat) (x:real) = inf({y:real | y IN (fixed fmt) /\ x <= y})`;; (* -------------------------------------------------------------------------- *) (* Fixed point rounding *) (* -------------------------------------------------------------------------- *) let roundmode_INDUCT, roundmode_RECURSION = define_type "roundmode = To_near | To_zero | To_pinf | To_ninf";; let fround = define `((fround (fmt:fformat) (To_near) (x:real) = (let lo = (glb(fmt) x) and hi = (lub(fmt) x) in (if (closer lo hi x) then lo else if (closer hi lo x) then hi else if (EVEN (ff(fmt) lo)) then lo else hi))) /\ (fround (fmt:fformat) (To_zero) (x:real) = (if (&0 <= x) then (glb(fmt) x) else (lub(fmt) x))) /\ (fround (fmt:fformat) (To_pinf) (x:real) = (lub(fmt) x)) /\ (fround (fmt:fformat) (To_ninf) (x:real) = (glb(fmt) x)))`;; hol-light/IEEE/fixed_thms.hl000066400000000000000000003434241303454263000161450ustar00rootroot00000000000000(* ========================================================================== *) (* FIXED POINT THEOREMS *) (* ========================================================================== *) (* needs "IEEE/common.hl";; *) (* needs "IEEE/fixed.hl";; *) (* -------------------------------------------------------------------------- *) (* Valid fformat properties *) (* -------------------------------------------------------------------------- *) let FFORMAT_SPLIT = TAUT `!(fmt:fformat). (dest_fformat fmt) = (FST (dest_fformat fmt), (FST (SND (dest_fformat fmt)), SND (SND (dest_fformat fmt))))`;; let FFORMAT_VALID_IMP_RADIX_LT_1 = prove(`!(r:num) (p:num) (e:int). ((is_valid_fformat (r,p,e)) ==> 1 < (FST (r,p,e)))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_fformat] THEN ARITH_TAC);; let FFORMAT_VALID_IMP_RADIX_EVEN = prove(`!(r:num) (p:num) (e:int). ((is_valid_fformat (r,p,e)) ==> EVEN (FST (r,p,e)))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_fformat] THEN MESON_TAC[]);; let FFORMAT_VALID_IMP_PREC_LT_0 = prove(`!(r:num) (p:num) (e:int). ((is_valid_fformat (r,p,e)) ==> 0 < (FST (SND (r,p,e))))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_fformat] THEN MESON_TAC[]);; let FFORMAT_VALID = prove(`!(fmt:fformat). is_valid_fformat (dest_fformat fmt)`, REWRITE_TAC[fformat_typbij]);; let FFORMAT_RADIX_LT_1 = prove(`!(fmt:fformat). 1 < (fr fmt)`, GEN_TAC THEN REWRITE_TAC[fr] THEN ONCE_REWRITE_TAC[FFORMAT_SPLIT] THEN MATCH_MP_TAC FFORMAT_VALID_IMP_RADIX_LT_1 THEN REWRITE_TAC[FFORMAT_VALID]);; let FFORMAT_RADIX_LT_0 = prove(`!(fmt:fformat). 0 < (fr fmt)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 0 < x`) THEN REWRITE_TAC[FFORMAT_RADIX_LT_1]);; let FFORMAT_RADIX_NE_0 = prove(`!(fmt:fformat). ~(&(fr fmt) = &0)`, GEN_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC (ARITH_RULE `0 < x ==> ~(x = 0)`) THEN REWRITE_TAC[FFORMAT_RADIX_LT_0]);; let FFORMAT_RADIX_EVEN = prove(`!(fmt:fformat). EVEN (fr fmt)`, GEN_TAC THEN REWRITE_TAC[fr] THEN ONCE_REWRITE_TAC[FFORMAT_SPLIT] THEN MATCH_MP_TAC FFORMAT_VALID_IMP_RADIX_EVEN THEN REWRITE_TAC[FFORMAT_VALID]);; let FFORMAT_PREC_LT_0 = prove(`!(fmt:fformat). 0 < (fp fmt)`, GEN_TAC THEN REWRITE_TAC[fp] THEN ONCE_REWRITE_TAC[FFORMAT_SPLIT] THEN MATCH_MP_TAC FFORMAT_VALID_IMP_PREC_LT_0 THEN REWRITE_TAC[FFORMAT_VALID]);; let FFORMAT_PREC_MINUS_1 = prove(`!(fmt:fformat). &0 <= (&(fp fmt):int) - (&1:int)`, REWRITE_TAC[ARITH_RULE `&0 <= x:int - &1:int <=> &1 <= x`] THEN REWRITE_TAC[INT_OF_NUM_LE] THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> 0 < n`] THEN REWRITE_TAC[FFORMAT_PREC_LT_0]);; let FFORMAT_PREC_IPOW_EQ_EXP = prove(`!(fmt:fformat). &(fr fmt) ipow (&(fp fmt) - &1) = &((fr fmt) EXP ((fp fmt) - 1))`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_EQ_EXP_P THEN REWRITE_TAC[FFORMAT_PREC_LT_0]);; let FFORMAT_RADIX_IPOW_LE_0 = prove(`!(fmt:fformat) (e:int). &0 <= &(fr fmt) ipow e`, REPEAT GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> &0 <= x`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FFORMAT_RADIX_LT_0]);; let FFORMAT_RADIX_IPOW_LT_0 = prove(`!(fmt:fformat) (e:int). &0 < &(fr fmt) ipow e`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FFORMAT_RADIX_LT_0]);; let FFORMAT_RADIX_IPOW_NEQ_0 = prove(`!(fmt:fformat) (e:int). ~(&(fr fmt) ipow e = &0)`, REPEAT GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> ~(x = &0)`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FFORMAT_RADIX_LT_0]);; let FFORMAT_RADIX_IPOW_ADD_EXP = prove(`!(fmt:fformat) (u:int) (v:int). &(fr fmt) ipow u * &(fr fmt) ipow v = &(fr fmt) ipow (u + v)`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_ADD_EXP THEN REWRITE_TAC[FFORMAT_RADIX_NE_0]);; (* -------------------------------------------------------------------------- *) (* Some useful properties of fixed point numbers *) (* -------------------------------------------------------------------------- *) let FIXED_NEG_SYM = prove(`!(fmt:fformat) (x:real). (x IN (fixed fmt)) <=> (-- x IN (fixed fmt))`, REPEAT GEN_TAC THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_fixed] THEN REWRITE_TAC[is_frac] THEN REWRITE_TAC[ARITH_RULE `abs(-- x) = abs(x)`]);; let FIXED_FINF_IN_FIXED = prove(`!(fmt:fformat). ((finf fmt) IN (fixed fmt) /\ (-- (finf fmt)) IN (fixed fmt))`, GEN_TAC THEN (* lemma: finf in fixed *) SUBGOAL_THEN `(finf fmt) IN (fixed fmt)` (LABEL_TAC "infixed") THENL [ REWRITE_TAC[finf; fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_fixed] THEN REWRITE_TAC[is_frac] THEN EXISTS_TAC `(fr (fmt:fformat)) EXP ((fp fmt) - 1)` THEN REWRITE_TAC[ARITH_RULE `(x:num) <= x`] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(fr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:fformat` FFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP IPOW_ADD_EXP (SPEC `fmt:fformat` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(x:int) - (y:int) + (z:int) - x + y = z`] THEN REWRITE_TAC[REWRITE_RULE[GSYM REAL_ABS_REFL] (MATCH_MP (ARITH_RULE `&0 < (x:real) ==> &0 <= x`) (SPEC `(fe fmt)` (MATCH_MP IPOW_LT_0 (REWRITE_RULE[GSYM REAL_OF_NUM_LT] (SPEC `fmt:fformat` FFORMAT_RADIX_LT_0)))))]; ALL_TAC] THEN (* main result *) ASM_REWRITE_TAC[] THEN USE_THEN "infixed" (fun infixed -> REWRITE_TAC[ONCE_REWRITE_RULE[ SPEC `fmt:fformat` FIXED_NEG_SYM] infixed]));; let FIXED_ZERO_IN_FIXED = prove(`!(fmt:fformat). &0 IN (fixed fmt)`, GEN_TAC THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_fixed] THEN EXISTS_TAC `0:num` THEN REWRITE_TAC[is_frac] THEN ARITH_TAC);; let FIXED_FULP_IN_FIXED = prove(`!(fmt:fformat). (fulp fmt) IN (fixed fmt)`, GEN_TAC THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_fixed] THEN EXISTS_TAC `1:num` THEN REWRITE_TAC[is_frac] THEN CONJ_TAC THENL [ MATCH_MP_TAC EXP_LE_1 THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FFORMAT_RADIX_NE_0]; REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) (SPECL [`fmt:fformat`;`(fe fmt) - &(fp fmt) + &1`] FFORMAT_RADIX_IPOW_LE_0)] THEN ARITH_TAC]);; let FIXED_FINF_BOUNDS = prove(`!(fmt:fformat) (x:real). x IN (fixed fmt) ==> -- (finf fmt) <= x /\ x <= (finf fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["frac1"; "frac2"]) (REWRITE_RULE[is_frac] (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] thm))))) THEN SUBGOAL_THEN `&f * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1) <= (finf fmt)` (LABEL_TAC "leqfinf") THENL [ REWRITE_TAC[finf] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(fe fmt) = (&(fp fmt) - &1) + (fe fmt) - &(fp fmt) + &1`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM FFORMAT_RADIX_IPOW_ADD_EXP] THEN ONCE_REWRITE_TAC[ ARITH_RULE `(x:real) * y <= z * y <=> y * x <= y * z`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0] THEN REWRITE_TAC[FFORMAT_PREC_IPOW_EQ_EXP] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ (* neg finf *) ONCE_REWRITE_TAC[ARITH_RULE `-- (x:real) <= y <=> -- y <= x`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x)` THEN REWRITE_TAC[ARITH_RULE `-- (z:real) <= abs(z)`] THEN ASM_REWRITE_TAC[]; (* pos finf *) MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x)` THEN REWRITE_TAC[ARITH_RULE `(z:real) <= abs(z)`] THEN ASM_REWRITE_TAC[]]);; let FIXED_FRAC_LT_0 = prove(`!(fmt:fformat) (u:real) (f:num). ~(u = &0) /\ (is_frac(fmt) u f) ==> 0 < f`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> LABEL_CONJUNCTS_TAC ["a1"; "a2"; "a3"] (REWRITE_RULE[is_frac] thm)) THEN MATCH_MP_TAC (ARITH_RULE `~(f = 0) ==> 0 < f`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN USE_THEN "a1" (fun a1 -> USE_THEN "a3" (fun a3 -> REWRITE_TAC[MATCH_MP REAL_MULT_NOT_0 (CONJ a3 (ONCE_REWRITE_RULE[ARITH_RULE `~((u:real) = &0) <=> ~(abs(u) = &0)`] a1))])));; let FIXED_FF_EXISTS = prove(`!(fmt:fformat) (x:real). (x IN (fixed fmt)) ==> (?(f:num). ff(fmt) x = f /\ is_frac(fmt) x f)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xfixed") THEN EXISTS_TAC `ff(fmt) x` THEN REWRITE_TAC[] THEN REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN USE_THEN "xfixed" (fun xfixed -> CHOOSE_THEN ASSUME_TAC (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] xfixed)))) THEN EXISTS_TAC `f:num` THEN ASM_REWRITE_TAC[]);; let FIXED_FF_UNIQUE = prove(`!(fmt:fformat) (x:real) (f1:num) (f2:num). (is_frac(fmt) x f1) /\ (is_frac(fmt) x f2) ==> f1 = f2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["f1frac"; "f2frac"]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> ~(x = &0)`) THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LT_0]; USE_THEN "f1frac" (fun f1frac -> ASSUME_TAC (REWRITE_RULE[is_frac] f1frac)) THEN USE_THEN "f2frac" (fun f2frac -> ASSUME_TAC (REWRITE_RULE[is_frac] f2frac)) THEN ASM_ARITH_TAC]);; let FIXED_FULP_LE_0 = prove(`!(fmt:fformat). &0 <= (fulp fmt)`, GEN_TAC THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LE_0]);; let FIXED_FULP_LT_0 = prove(`!(fmt:fformat). &0 < (fulp fmt)`, GEN_TAC THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LT_0]);; let FIXED_FULP_LE_FINF = prove(`!(fmt:fformat). (fulp fmt) <= (finf fmt)`, GEN_TAC THEN REWRITE_TAC[fulp] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&((fr fmt) EXP ((fp fmt) - 1)) * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)` THEN CONJ_TAC THENL [ GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `x:real = &1 * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_LE] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [ARITH_RULE `1 = (fr fmt) EXP 0`] THEN REWRITE_TAC[SPEC `(fr fmt)` LE_EXP] THEN COND_CASES_TAC THENL [ ASSUME_TAC (REWRITE_RULE[REAL_OF_NUM_EQ] (SPEC `fmt:fformat` FFORMAT_RADIX_NE_0)) THEN ASM_ARITH_TAC; DISJ2_TAC THEN MATCH_MP_TAC (ARITH_RULE `0 < n ==> 0 <= n - 1`) THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_PREC_LT_0]]; REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LE_0]]; REWRITE_TAC[GSYM(MATCH_MP (SPEC `(fr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:fformat` FFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(fr fmt)` IPOW_ADD_EXP) (SPEC `fmt:fformat` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(x:int) - y + z - x + y = z`] THEN REWRITE_TAC[finf] THEN ARITH_TAC]);; let FIXED_FF_LE = prove(`!(fmt:fformat) (x:real). is_fixed(fmt) x ==> ff(fmt) x <= (fr fmt) EXP ((fp fmt) - 1)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xfixed") THEN SUBGOAL_THEN `is_frac(fmt) x (ff(fmt) x)` (LABEL_TAC "ffisfrac") THENL [ REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN USE_THEN "xfixed" (fun xfixed -> REWRITE_TAC[REWRITE_RULE[is_fixed] xfixed]); ALL_TAC] THEN USE_THEN "ffisfrac" (fun ffisfrac -> REWRITE_TAC[REWRITE_RULE[is_frac] ffisfrac]));; let FIXED_FF_LT = prove(`!(fmt:fformat) (x:real). is_fixed(fmt) x /\ abs(x) < (finf fmt) ==> ff(fmt) x < (fr fmt) EXP ((fp fmt) - 1)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xfixed"; "absxlt"]) THEN SUBGOAL_THEN `is_frac(fmt) x (ff(fmt) x)` (LABEL_TAC "ffisfrac") THENL [ REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN USE_THEN "xfixed" (fun xfixed -> REWRITE_TAC[REWRITE_RULE[is_fixed] xfixed]); ALL_TAC] THEN REMOVE_THEN "ffisfrac" (fun ffisfrac -> ASSUME_TAC (REWRITE_RULE[is_frac] ffisfrac)) THEN SUBGOAL_THEN `&(ff fmt x) * &(fr fmt) ipow (fe fmt - &(fp fmt) + &1) < (finf fmt)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(fr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:fformat` FFORMAT_PREC_LT_0))] THEN SUBGOAL_THEN `&0 < &(fr fmt) ipow (fe fmt - &(fp fmt) + &1)` (fun thm -> ONCE_REWRITE_TAC[GSYM (MATCH_MP REAL_LT_RMUL_EQ thm)]) THENL [ REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN REWRITE_TAC[MATCH_MP (SPEC `&(fr fmt)` IPOW_ADD_EXP) (SPEC `fmt:fformat` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e2 - e + &1 = e2`] THEN REWRITE_TAC[GSYM finf] THEN ASM_REWRITE_TAC[]);; let FIXED_FF_FINF = prove(`!(fmt:fformat). ff(fmt) (finf fmt) = (fr fmt) EXP ((fp fmt) - 1)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `is_frac(fmt) (finf fmt) (ff(fmt) (finf fmt))` (LABEL_TAC "ffisfrac") THENL [ REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN REWRITE_TAC[REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_FINF_IN_FIXED))]; ALL_TAC] THEN REMOVE_THEN "ffisfrac" (fun ffisfrac -> ASSUME_TAC (REWRITE_RULE[is_frac] ffisfrac)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(fr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:fformat` FFORMAT_PREC_LT_0))] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(fr fmt) ipow (fe fmt - &(fp fmt) + &1)` THEN CONJ_TAC THENL [ REWRITE_TAC[FFORMAT_RADIX_IPOW_NEQ_0]; ALL_TAC] THEN REWRITE_TAC[MATCH_MP (SPEC `&(fr fmt)` IPOW_ADD_EXP) (SPEC `fmt:fformat` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e2 - e + &1 = e2`] THEN REWRITE_TAC[GSYM finf] THEN SUBGOAL_THEN `(finf fmt) = abs((finf fmt))` (fun thm -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ MATCH_MP_TAC (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) THEN REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0]; ALL_TAC] THEN ASM_ARITH_TAC);; let FIXED_FF_NEG = prove(`!(fmt:fformat) (x:real). is_fixed(fmt) x ==> ff(fmt) (-- x) = ff(fmt) x`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xfixed") THEN SUBGOAL_THEN `is_frac(fmt) x (ff(fmt) x)` (LABEL_TAC "ffisfrac") THENL [ REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN USE_THEN "xfixed" (fun xfixed -> REWRITE_TAC[REWRITE_RULE[is_fixed] xfixed]); ALL_TAC] THEN SUBGOAL_THEN `is_frac(fmt) x (ff(fmt) (-- x))` (LABEL_TAC "ffnegisfrac") THENL [ REWRITE_TAC[ff] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [is_frac] THEN REWRITE_TAC[ARITH_RULE `abs(--x) = abs(x)`] THEN REWRITE_TAC[GSYM is_frac] THEN SELECT_ELIM_TAC THEN USE_THEN "xfixed" (fun xfixed -> REWRITE_TAC[REWRITE_RULE[is_fixed] xfixed]); ALL_TAC] THEN MATCH_MP_TAC FIXED_FF_UNIQUE THEN EXISTS_TAC `fmt:fformat` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]);; let FIXED_FF_REP = prove(`!(fmt:fformat) (x:real). is_fixed(fmt) x ==> abs(x) = &(ff(fmt) x) * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xfixed") THEN SUBGOAL_THEN `is_frac(fmt) x (ff(fmt) x)` (LABEL_TAC "ffisfrac") THENL [ REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN USE_THEN "xfixed" (fun xfixed -> REWRITE_TAC[REWRITE_RULE[is_fixed] xfixed]); ALL_TAC] THEN USE_THEN "ffisfrac" (fun ffisfrac -> REWRITE_TAC[REWRITE_RULE[is_frac] ffisfrac]));; let FIXED_FF_ZERO = prove(`!(fmt:fformat). ff(fmt) (&0) = 0`, GEN_TAC THEN LABEL_TAC "zerofixed" (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] (SPEC `fmt:fformat` FIXED_ZERO_IN_FIXED))) THEN SUBGOAL_THEN `is_frac(fmt) (&0) (ff(fmt) (&0))` (LABEL_TAC "ffisfrac") THENL [ REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN USE_THEN "zerofixed" (fun zerofixed -> REWRITE_TAC[REWRITE_RULE[is_fixed] zerofixed]); ALL_TAC] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN MATCH_MP_TAC (TAUT `!(b:bool). (~b) /\ (a \/ b) ==> a`) THEN EXISTS_TAC `&(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1) = &0` THEN REWRITE_TAC[GSYM REAL_EQ_MUL_RCANCEL] THEN CONJ_TAC THENL [ REWRITE_TAC[FFORMAT_RADIX_IPOW_NEQ_0]; REWRITE_TAC[ARITH_RULE `&0 * (x:real) = abs(&0)`] THEN USE_THEN "ffisfrac" (fun ffisfrac -> REWRITE_TAC[REWRITE_RULE[is_frac] ffisfrac])]);; (* -------------------------------------------------------------------------- *) (* Set of fixed point numbers is finite. *) (* -------------------------------------------------------------------------- *) let FIXED_CORR = define `fixed_corr (fmt:fformat) (n:num) = (if (n = 0) then &0 else if (ODD n) then -- &((n + 1) DIV 2) * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1) else &(n DIV 2) * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1))`;; let FIXED_PREIMAGE = define `fixed_preimage (fmt:fformat) = { n:num | 0 <= n /\ n <= 2 * (fr fmt) EXP ((fp fmt) - 1) }`;; let FIXED_IN_IMAGE = prove(`!(fmt:fformat) (x:real). x IN (fixed fmt) ==> ?(n:num). n IN (fixed_preimage fmt) /\ (fixed_corr fmt n) = x`, REPEAT GEN_TAC THEN REWRITE_TAC[FIXED_CORR] THEN DISCH_THEN(fun thm -> CHOOSE_THEN (LABEL_TAC "a1") (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] thm)))) THEN USE_THEN "a1" (fun a1 -> LABEL_CONJUNCTS_TAC ["frac1"; "frac2"] (REWRITE_RULE[is_frac] a1)) THEN ASM_CASES_TAC `&0 <= x` THENL [ (* case 1.1: x is non-negative *) EXISTS_TAC `2 * f` THEN COND_CASES_TAC THENL [ (* n = 0 *) SUBGOAL_THEN `f = 0` (LABEL_TAC "f0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "frac2" (fun frac2 -> USE_THEN "f0" (fun f0 -> LABEL_TAC "f0sub" (REWRITE_RULE [f0] frac2))) THEN USE_THEN "f0sub" (fun f0sub -> LABEL_TAC "f0subsimp" (REWRITE_RULE[ARITH_RULE `&0 * x = &0`] f0sub)) THEN USE_THEN "f0subsimp" (fun f0subsimp -> REWRITE_TAC [GSYM (REWRITE_RULE[REAL_ABS_ZERO] f0subsimp)]) THEN REWRITE_TAC[FIXED_PREIMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_ARITH_TAC; COND_CASES_TAC THENL [ (* n odd *) CONTR_TAC(REWRITE_RULE[DOUBLE_NOT_ODD] (ASSUME `ODD(2 * f)`)); (* n even *) REWRITE_TAC[ARITH_RULE `(2 * z) DIV 2 = z`] THEN LABEL_TAC "absx" (REWRITE_RULE[GSYM REAL_ABS_REFL] (ASSUME `&0 <= x`)) THEN USE_THEN "absx" (fun absx -> USE_THEN "frac2" (fun frac2 -> REWRITE_TAC[MATCH_MP EQ_TRANS (CONJ (GSYM absx) frac2)])) THEN REWRITE_TAC[FIXED_PREIMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_ARITH_TAC]]; (* case 1.2: x is negative *) USE_THEN "a1" (fun a1 -> LABEL_TAC "fpos" (MATCH_MP (SPEC `fmt:fformat` FIXED_FRAC_LT_0) (CONJ (MATCH_MP (ARITH_RULE `~(&0 <= x) ==> ~(x = &0)`) (ASSUME `~(&0 <= x)`)) a1))) THEN EXISTS_TAC `2 * f - 1` THEN COND_CASES_TAC THENL [ (* 2f - 1 = 0 *) ASM_ARITH_TAC; COND_CASES_TAC THENL [ (* 2f - 1 odd *) REWRITE_TAC[ARITH_RULE `(2 * f - 1 + 1) DIV 2 = f`] THEN SUBGOAL_THEN `x = -- abs(x)` (fun thm -> ONCE_REWRITE_TAC[thm]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "frac2" (fun frac2 -> REWRITE_TAC[ONCE_REWRITE_RULE [ARITH_RULE `(x:real) = y * z <=> --y * z = --x`] frac2]) THEN REWRITE_TAC[FIXED_PREIMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_ARITH_TAC; (* 2f - 1 even *) USE_THEN "fpos" (fun fpos -> CONTR_TAC (REWRITE_RULE [TAUT `~a /\ a <=> F`] (CONJ (ASSUME `~ODD(2 * f - 1)`) (MATCH_MP DOUBLE_NEG_1_ODD fpos))))]]]);; let FIXED_FINITE = prove(`!(fmt:fformat). FINITE(fixed fmt)`, (* lemma 1 *) SUBGOAL_THEN `!(fmt:fformat). FINITE(fixed_preimage fmt)` (LABEL_TAC "lem1") THENL [ GEN_TAC THEN REWRITE_TAC[FIXED_PREIMAGE] THEN REWRITE_TAC[GSYM numseg] THEN REWRITE_TAC[FINITE_NUMSEG]; ALL_TAC] THEN (* lemma 2 *) SUBGOAL_THEN `!(fmt:fformat). FINITE({(y:real) | ?(n:num). n IN (fixed_preimage fmt) /\ y = (fixed_corr fmt n)})` (LABEL_TAC "lem2") THENL [ GEN_TAC THEN REWRITE_TAC[GSYM IMAGE] THEN MATCH_MP_TAC FINITE_IMAGE THEN USE_THEN "lem1" (fun lem1 -> REWRITE_TAC[lem1]); ALL_TAC] THEN (* lemma 3 *) SUBGOAL_THEN `!(fmt:fformat). (fixed fmt) SUBSET {(y:real) | ?(n:num). n IN (fixed_preimage fmt) /\ y = (fixed_corr fmt n)}` (LABEL_TAC "lem3") THENL [ GEN_TAC THEN REWRITE_TAC[SUBSET] THEN GEN_REWRITE_TAC (RAND_CONV o ABS_CONV o RAND_CONV o ONCE_DEPTH_CONV) [IN_ELIM_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ABS_CONV o RAND_CONV o RAND_CONV o ABS_CONV o RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[SPEC `fmt:fformat` FIXED_IN_IMAGE]; ALL_TAC] THEN (* main result *) GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{y | ?n. n IN fixed_preimage fmt /\ y = fixed_corr fmt n}` THEN ASM_REWRITE_TAC[]);; let FIXED_NONEMPTY = prove(`!(fmt:fformat). ~((fixed fmt) = {})`, GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `(&0):real` THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[UNION] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_fixed] THEN REWRITE_TAC[is_frac] THEN EXISTS_TAC `0:num` THEN REWRITE_TAC[ARITH_RULE `&0 * x = &0`] THEN REWRITE_TAC[REWRITE_RULE [GSYM EXP_LT_0] (DISJ1 (SPEC `fmt:fformat` (REWRITE_RULE[REAL_OF_NUM_EQ] FFORMAT_RADIX_NE_0)) `(fp fmt) - 1 = 0`)] THEN ARITH_TAC);; (* -------------------------------------------------------------------------- *) (* glb/lub exist, properties *) (* -------------------------------------------------------------------------- *) let FIXED_GLB_EXISTS = prove(`!(fmt:fformat) (x:real). abs(x) <= finf(fmt) ==> ?(y:real). (glb(fmt) x) = y /\ (is_glb(fmt) x y)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN REWRITE_TAC[glb] THEN (* lemma: {z | z is fixed /\ z <= x} is finite. *) SUBGOAL_THEN `FINITE({z | z IN (fixed fmt) /\ z <= x})` (LABEL_TAC "fin") THENL [ MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `(fixed fmt)` THEN REWRITE_TAC[FIXED_FINITE] THEN REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[TAUT `a /\ b ==> a`]; ALL_TAC] THEN (* lemma: {z | z is fixed /\ z <= x} is non-empty. *) SUBGOAL_THEN `~({z | z IN (fixed fmt) /\ z <= x} = {})` (LABEL_TAC "notempty") THENL [ REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `--(finf fmt)` THEN REWRITE_TAC[INTER] THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[REWRITE_RULE [REAL_ABS_BOUNDS] absx]) THEN REWRITE_TAC[FIXED_FINF_IN_FIXED]; ALL_TAC] THEN (* back to main result ... *) USE_THEN "fin" (fun fin -> USE_THEN "notempty" (fun notempty -> LABEL_TAC "sup0" (MATCH_MP SUP_FINITE (CONJ fin notempty)))) THEN EXISTS_TAC `sup ({z | z IN (fixed fmt) /\ z <= (x:real)})` THEN REWRITE_TAC[] THEN REWRITE_TAC[is_glb] THEN REWRITE_TAC[is_lb] THEN USE_THEN "sup0" (fun sup0 -> LABEL_CONJUNCTS_TAC ["sup1"; "sup2"] sup0) THEN USE_THEN "sup1" (fun sup1 -> REWRITE_TAC[ONCE_REWRITE_RULE[IN_ELIM_THM] sup1]) THEN USE_THEN "sup2" (fun sup2 -> REWRITE_TAC[ONCE_REWRITE_RULE[ IN_ELIM_THM] sup2]));; (* It might be possible to re-use FIXED_GLB_EXISTS, but it would probably be *) (* tedious. *) let FIXED_LUB_EXISTS = prove(`!(fmt:fformat) (x:real). abs(x) <= finf(fmt) ==> ?(y:real). (lub(fmt) x) = y /\ (is_lub(fmt) x y)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN REWRITE_TAC[lub] THEN (* lemma: {z | z is fixed /\ x <= z} is finite. *) SUBGOAL_THEN `FINITE({z | z IN (fixed fmt) /\ x <= z})` (LABEL_TAC "fin") THENL [ MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `(fixed fmt)` THEN REWRITE_TAC[FIXED_FINITE] THEN REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[TAUT `a /\ b ==> a`]; ALL_TAC] THEN (* lemma: {z | z is fixed /\ z <= x} is non-empty. *) SUBGOAL_THEN `~({z | z IN (fixed fmt) /\ x <= z} = {})` (LABEL_TAC "notempty") THENL [ REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `(finf fmt)` THEN REWRITE_TAC[INTER] THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[REWRITE_RULE [REAL_ABS_BOUNDS] absx]) THEN REWRITE_TAC[FIXED_FINF_IN_FIXED]; ALL_TAC] THEN (* back to main result ... *) USE_THEN "fin" (fun fin -> USE_THEN "notempty" (fun notempty -> LABEL_TAC "inf0" (MATCH_MP INF_FINITE (CONJ fin notempty)))) THEN EXISTS_TAC `inf ({z | z IN (fixed fmt) /\ x <= (z:real)})` THEN REWRITE_TAC[] THEN REWRITE_TAC[is_lub] THEN REWRITE_TAC[is_ub] THEN USE_THEN "inf0" (fun inf0 -> LABEL_CONJUNCTS_TAC ["inf1"; "inf2"] inf0) THEN USE_THEN "inf1" (fun inf1 -> REWRITE_TAC[ONCE_REWRITE_RULE[IN_ELIM_THM] inf1]) THEN USE_THEN "inf2" (fun inf2 -> REWRITE_TAC[ONCE_REWRITE_RULE[ IN_ELIM_THM] inf2]));; let FIXED_GLB_UNIQUE = prove(`!(fmt:fformat) (x:real) (y1:real) (y2:real). abs(x) <= (finf fmt) /\ is_glb(fmt) x y1 /\ is_glb(fmt) x y2 ==> y1 = y2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "glby11"; "glby21"]) THEN USE_THEN "glby11" (fun glby11 -> LABEL_CONJUNCTS_TAC ["glby12"; "glby13"] (REWRITE_RULE[is_glb] glby11)) THEN USE_THEN "glby21" (fun glby21 -> LABEL_CONJUNCTS_TAC ["glby22"; "glby23"] (REWRITE_RULE[is_glb] glby21)) THEN SUBGOAL_THEN `y1:real <= y2` ASSUME_TAC THENL [ USE_THEN "glby23" (fun glby23 -> MATCH_MP_TAC glby23) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `y2:real <= y1` ASSUME_TAC THENL [ USE_THEN "glby13" (fun glby13 -> MATCH_MP_TAC glby13) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC);; let FIXED_LUB_UNIQUE = prove(`!(fmt:fformat) (x:real) (y1:real) (y2:real). abs(x) <= (finf fmt) /\ is_lub(fmt) x y1 /\ is_lub(fmt) x y2 ==> y1 = y2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "luby11"; "luby21"]) THEN USE_THEN "luby11" (fun luby11 -> LABEL_CONJUNCTS_TAC ["luby12"; "luby13"] (REWRITE_RULE[is_lub] luby11)) THEN USE_THEN "luby21" (fun luby21 -> LABEL_CONJUNCTS_TAC ["luby22"; "luby23"] (REWRITE_RULE[is_lub] luby21)) THEN SUBGOAL_THEN `y1:real <= y2` ASSUME_TAC THENL [ USE_THEN "luby13" (fun luby13 -> MATCH_MP_TAC luby13) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `y2:real <= y1` ASSUME_TAC THENL [ USE_THEN "luby23" (fun luby23 -> MATCH_MP_TAC luby23) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC);; let FIXED_GLB_IS_FIXED = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> (glb(fmt) x) IN (fixed fmt)`, REPEAT GEN_TAC THEN DISCH_THEN(fun thm -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["glbeq"; "isglb"]) (MATCH_MP FIXED_GLB_EXISTS thm)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "isglb" (fun isglb -> REWRITE_TAC[REWRITE_RULE[is_lb] ( REWRITE_RULE[is_glb] isglb)]));; let FIXED_LUB_IS_FIXED = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> (lub(fmt) x) IN (fixed fmt)`, REPEAT GEN_TAC THEN DISCH_THEN(fun thm -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["lubeq"; "islub"]) (MATCH_MP FIXED_LUB_EXISTS thm)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "islub" (fun islub -> REWRITE_TAC[REWRITE_RULE[is_ub] ( REWRITE_RULE[is_lub] islub)]));; let FIXED_PLUS_FULP_NNEG = prove(`!(fmt:fformat) (u:real) (f:num). &0 <= u /\ (is_frac(fmt) u f) ==> u + (fulp fmt) = &(f + 1) * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> LABEL_CONJUNCTS_TAC ["a1"; "a2"; "a3"] (REWRITE_RULE[is_frac] thm)) THEN USE_THEN "a1" (fun a1 -> USE_THEN "a3" (fun a3 -> REWRITE_TAC[REWRITE_RULE[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) a1] a3])) THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[ARITH_RULE `(&x:real) * y + y = (&x + &1) * y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD]);; let FIXED_PLUS_FULP_NEG = prove(`!(fmt:fformat) (u:real) (f:num). u < &0 /\ (is_frac(fmt) u f) ==> u + (fulp fmt) = -- &(f - 1) * &(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> LABEL_CONJUNCTS_TAC ["a1"; "a2"] thm) THEN USE_THEN "a2" (fun a2 -> LABEL_CONJUNCTS_TAC ["a3"; "a4"] (REWRITE_RULE[is_frac] a2)) THEN USE_THEN "a1" (fun a1 -> USE_THEN "a4" (fun a4 -> REWRITE_TAC[REWRITE_RULE[MATCH_MP (ARITH_RULE `(x:real) < &0 ==> (abs(x) = z <=> x = -- z)`) a1] a4])) THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[ARITH_RULE `-- ((&x:real) * y) + y = -- (&x - &1) * y`] THEN USE_THEN "a1" (fun a1 -> USE_THEN "a2" (fun a2 -> LABEL_TAC "a5" (MATCH_MP FIXED_FRAC_LT_0 (CONJ (MATCH_MP (ARITH_RULE `(u:real) < &0 ==> ~(u = &0)`) a1) a2)))) THEN USE_THEN "a5" (fun a5 -> REWRITE_TAC[MATCH_MP REAL_OF_NUM_SUB (MATCH_MP (ARITH_RULE `0 < f ==> 1 <= f`) a5)]));; let FIXED_FULP_DISTANCE = prove(`!(fmt:fformat) (u:real) (v:real). (u IN (fixed fmt)) /\ (v IN (fixed fmt)) /\ (u <= v) /\ (v <= u + (fulp fmt)) ==> (v = u \/ v = u + (fulp fmt))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["ufixed"; "vfixed"; "ulev"; "vlefulp"]) THEN USE_THEN "ufixed" (fun ufixed -> X_CHOOSE_THEN `f1:num` (LABEL_TAC "ufrac") (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] ufixed)))) THEN USE_THEN "vfixed" (fun vfixed -> X_CHOOSE_THEN `f2:num` (LABEL_TAC "vfrac") (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] vfixed)))) THEN USE_THEN "ufrac" (fun ufrac -> LABEL_CONJUNCTS_TAC ["ufrac1"; "ufrac2"] (REWRITE_RULE[is_frac] ufrac)) THEN USE_THEN "vfrac" (fun vfrac -> LABEL_CONJUNCTS_TAC ["vfrac1"; "vfrac2"] (REWRITE_RULE[is_frac] vfrac)) THEN ASM_CASES_TAC `&0 <= (u:real)` THENL [ (* u non-negative *) LABEL_TAC "uge0" (ASSUME `&0 <= (u:real)`) THEN USE_THEN "ulev" (fun ulev -> USE_THEN "uge0" (fun uge0 -> LABEL_TAC "vge0" (MATCH_MP REAL_LE_TRANS (CONJ uge0 ulev)))) THEN SUBGOAL_THEN `&0 <= (u:real) /\ (is_frac(fmt) u f1)` (fun thm -> LABEL_TAC "ulp" (MATCH_MP FIXED_PLUS_FULP_NNEG thm)) THENL [ ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "uge0" (fun uge0 -> USE_THEN "ufrac2" (fun ufrac2 -> LABEL_TAC "ueq" (REWRITE_RULE[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) uge0] ufrac2))) THEN USE_THEN "vge0" (fun vge0 -> USE_THEN "vfrac2" (fun vfrac2 -> LABEL_TAC "veq" (REWRITE_RULE[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) vge0] vfrac2))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_NEQ_0] THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC IPOW_BETWEEN THEN EXISTS_TAC `&(fr fmt)` THEN EXISTS_TAC `(fe fmt) - &(fp fmt) + (&1:int)` THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN USE_THEN "ulp" (fun ulp -> REWRITE_TAC[GSYM ulp]) THEN USE_THEN "ueq" (fun ueq -> REWRITE_TAC[GSYM ueq]) THEN USE_THEN "veq" (fun veq -> REWRITE_TAC[GSYM veq]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FFORMAT_RADIX_LT_0]; (* u negative *) LABEL_TAC "unleq0" (ASSUME `~(&0 <= (u:real))`) THEN USE_THEN "unleq0" (fun unleq0 -> LABEL_TAC "ul0" (MATCH_MP (ARITH_RULE `~(&0 <= (x:real)) ==> x < &0`) unleq0)) THEN USE_THEN "unleq0" (fun unleq0 -> USE_THEN "ufrac" (fun ufrac -> LABEL_TAC "fgt0" (MATCH_MP (SPEC `fmt:fformat` FIXED_FRAC_LT_0) (CONJ (MATCH_MP (ARITH_RULE `~(&0 <= (u:real)) ==> ~(u = &0)`) unleq0) ufrac)))) THEN USE_THEN "ul0" (fun ul0 -> USE_THEN "ufrac" (fun ufrac -> LABEL_TAC "ulp" (MATCH_MP FIXED_PLUS_FULP_NEG (CONJ ul0 ufrac)))) THEN (* lemma: u + fulp <= 0 *) SUBGOAL_THEN `(u:real) + (fulp fmt) <= &0` (LABEL_TAC "ulpleq0") THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(-- (a:real)) * b = -- (a * b)`] THEN REWRITE_TAC[ARITH_RULE `-- (x:real) <= &0 <=> &0 <= x`] THEN REWRITE_TAC[ARITH_RULE `&0 <= (x:real) * y <=> &0 * y <= x * y`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0] THEN USE_THEN "fgt0" (fun fgt0 -> REWRITE_TAC[GSYM(MATCH_MP REAL_OF_NUM_SUB (MATCH_MP (ARITH_RULE `0 < x ==> 1 <= x`) fgt0))]) THEN REWRITE_TAC[ARITH_RULE `&0 <= (x:real) - &1 <=> &1 <= x`] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(v:real) <= &0` (LABEL_TAC "vle0") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `u + (fulp fmt)` THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN USE_THEN "ul0" (fun ul0 -> USE_THEN "ufrac2" (fun ufrac2 -> LABEL_TAC "ueq" (REWRITE_RULE[MATCH_MP (ARITH_RULE `(x:real) < &0 ==> (abs(x) = z <=> x = --z)`) ul0] ufrac2))) THEN USE_THEN "vle0" (fun vle0 -> USE_THEN "vfrac2" (fun vfrac2 -> LABEL_TAC "veq" (REWRITE_RULE[MATCH_MP (ARITH_RULE `(x:real) <= &0 ==> (abs(x) = z <=> x = --z)`) vle0] vfrac2))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(-- (a:real) * b) = -- (a * b)`] THEN REWRITE_TAC[REAL_EQ_NEG2] THEN REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_NEQ_0] THEN USE_THEN "fgt0" (fun fgt0 -> REWRITE_TAC[GSYM(MATCH_MP REAL_OF_NUM_SUB (MATCH_MP (ARITH_RULE `0 < x ==> 1 <= x`) fgt0))]) THEN REWRITE_TAC[ARITH_RULE `(x:real) = (y:real) - &1 <=> x + &1 = y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN ONCE_REWRITE_TAC[ARITH_RULE `((a:num) = b) <=> (b = a)`] THEN MATCH_MP_TAC IPOW_BETWEEN THEN EXISTS_TAC `&(fr fmt)` THEN EXISTS_TAC `(fe fmt) - &(fp fmt) + &1` THEN REWRITE_TAC[ARITH_RULE `((x:real) + &1) * y = x * y + &1 * y`] THEN REWRITE_TAC[ARITH_RULE `(x:real) <= y + z <=> x - z <= y`] THEN REWRITE_TAC[ARITH_RULE `(x:real) * z - &1 * z = (x - &1) * z`] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN REWRITE_TAC[ARITH_RULE `--((a:real) * b) = (--a) * b`] THEN USE_THEN "fgt0" (fun fgt0 -> REWRITE_TAC[MATCH_MP REAL_OF_NUM_SUB (MATCH_MP (ARITH_RULE `0 < n ==> 1 <= n`) fgt0)]) THEN USE_THEN "ulp" (fun ulp -> REWRITE_TAC[GSYM ulp]) THEN REWRITE_TAC[ARITH_RULE `(-- (a:real)) * b = -- (a * b)`] THEN USE_THEN "ueq" (fun ueq -> REWRITE_TAC[GSYM ueq]) THEN USE_THEN "veq" (fun veq -> REWRITE_TAC[GSYM veq]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FFORMAT_RADIX_LT_0]]);; let FIXED_GLB_LUB_BOUNDS = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> glb(fmt) x <= lub(fmt) x /\ lub(fmt) x <= glb(fmt) x + (fulp fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> LABEL_TAC "absx" thm) THEN USE_THEN "absx" (fun absx -> X_CHOOSE_THEN `y1:real` (LABEL_CONJUNCTS_TAC ["glbeq"; "isglb"]) (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_EXISTS) absx)) THEN USE_THEN "absx" (fun absx -> X_CHOOSE_THEN `y2:real` (LABEL_CONJUNCTS_TAC ["lubeq"; "islub"]) (MATCH_MP (SPEC `fmt:fformat` FIXED_LUB_EXISTS) absx)) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ (* y1 <= y2 is easy *) USE_THEN "isglb" (fun isglb -> LABEL_CONJUNCTS_TAC ["islb"; "isgreat"] (REWRITE_RULE[is_glb] isglb)) THEN USE_THEN "islub" (fun islub -> LABEL_CONJUNCTS_TAC ["isub"; "isleast"] (REWRITE_RULE[is_lub] islub)) THEN USE_THEN "islb" (fun islb -> LABEL_CONJUNCTS_TAC ["y1fixed"; "y1leqx"] (REWRITE_RULE[is_lb] islb)) THEN USE_THEN "isub" (fun isub -> LABEL_CONJUNCTS_TAC ["y2fixed"; "xleqy2"] (REWRITE_RULE[is_ub] isub)) THEN ASM_ARITH_TAC; (* y2 <= y1 + fulp is harder *) ASM_CASES_TAC `&0 <= (y1:real)` THENL [ (* y1 non-negative *) LABEL_TAC "y1geq0" (ASSUME `&0 <= (y1:real)`) THEN ASM_CASES_TAC `y1 < (finf fmt)` THENL [ (* this is the interesting case when y1 != finf *) USE_THEN "isglb" (fun isglb -> LABEL_CONJUNCTS_TAC ["islb"; "isgreat"] (REWRITE_RULE[is_glb] isglb)) THEN USE_THEN "islb" (fun islb -> LABEL_CONJUNCTS_TAC ["y1fixed"; "y1leqx"] (REWRITE_RULE[is_lb] islb)) THEN USE_THEN "y1fixed" (fun y1fixed -> X_CHOOSE_THEN `f1:num` (LABEL_CONJUNCTS_TAC ["y1frac1"; "y1frac2"]) (REWRITE_RULE[is_frac] (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] y1fixed))))) THEN (* lemma: f1 + 1 <= r^(p - 1) *) SUBGOAL_THEN `f1 + 1 <= (fr fmt) EXP ((fp fmt) - 1)` (LABEL_TAC "f1leq") THENL [ MATCH_MP_TAC (ARITH_RULE `x < y ==> x + 1 <= y`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN REWRITE_TAC[GSYM FFORMAT_PREC_IPOW_EQ_EXP] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)` THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0] THEN REWRITE_TAC[MATCH_MP IPOW_ADD_EXP (SPEC `fmt:fformat` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `((x:int) - y + &1) + y - &1 = x`] THEN REWRITE_TAC[GSYM finf] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN USE_THEN "y1geq0" (fun y1geq0 -> USE_THEN "y1frac2" (fun y1frac2 -> REWRITE_TAC[GSYM(REWRITE_RULE[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) y1geq0] y1frac2)])) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* lemma: y1 + fulp is a fixed point number *) SUBGOAL_THEN `(y1 + (fulp fmt)) IN fixed(fmt)` (LABEL_TAC "ulpfixed") THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_fixed] THEN REWRITE_TAC[is_frac] THEN EXISTS_TAC `f1 + 1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `&0 <= x /\ x = y ==> abs(x) = y`) THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&0 <= x /\ &0 <= y ==> &0 <= x + y`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0]; MATCH_MP_TAC FIXED_PLUS_FULP_NNEG THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_frac] THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `(y1 + (fulp fmt)) <= x` THENL [ (* contradiction in the positive case *) LABEL_TAC "ulpleqx" (ASSUME `y1 + (fulp fmt) <= x`) THEN (* lemma: y1 + fulp is a lower bound *) SUBGOAL_THEN `is_lb(fmt) x (y1 + (fulp fmt))` (LABEL_TAC "ulpislb") THENL [ REWRITE_TAC[is_lb] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* lemma: y1 is less than y1 + fulp *) SUBGOAL_THEN `y1 < (y1 + (fulp fmt))` (LABEL_TAC "y1lequlp") THENL [ REWRITE_TAC[ARITH_RULE `x:real < x + y <=> &0 < y`] THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN USE_THEN "isgreat" (fun isgreat -> USE_THEN "ulpislb" (fun ulpislb -> ASSUME_TAC (MATCH_MP isgreat ulpislb))) THEN ASM_ARITH_TAC; (* y1 + fulp > x *) LABEL_TAC "ulpgeqx" (MATCH_MP (ARITH_RULE `~((z:real) <= y) ==> y <= z`) (ASSUME `~(y1 + (fulp fmt) <= x)`)) THEN (* lemma: y1 + fulp is an upper bound *) SUBGOAL_THEN `is_ub(fmt) x (y1 + (fulp fmt))` (LABEL_TAC "ulpisub") THENL [ REWRITE_TAC[is_ub] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "islub" (fun islub -> LABEL_CONJUNCTS_TAC ["islb"; "isleast"] (REWRITE_RULE[is_lub] islub)) THEN USE_THEN "isleast" (fun isleast -> MATCH_MP_TAC isleast) THEN ASM_REWRITE_TAC[]]; (* y1 >= finf, so y1 = finf *) SUBGOAL_THEN `y1 = (finf fmt)` (LABEL_TAC "eqinf") THENL [ REWRITE_TAC[ARITH_RULE `(x:real) = y <=> x <= y /\ y <= x`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(x:real) <= y <=> ~(y < x)`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `--(finf fmt) <= x /\ x <= (finf fmt) ==> x <= (finf fmt)`) THEN MATCH_MP_TAC FIXED_FINF_BOUNDS THEN USE_THEN "isglb" (fun isglb -> REWRITE_TAC[ (REWRITE_RULE[is_lb] (REWRITE_RULE[is_glb] isglb))]); ALL_TAC] THEN MATCH_MP_TAC (ARITH_RULE `&0 <= z /\ (x:real) <= y ==> x <= y + z`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0] THEN MATCH_MP_TAC (ARITH_RULE `--(finf fmt) <= x /\ x <= (finf fmt) ==> x <= (finf fmt)`) THEN MATCH_MP_TAC FIXED_FINF_BOUNDS THEN USE_THEN "islub" (fun islub -> REWRITE_TAC[ (REWRITE_RULE[is_ub] (REWRITE_RULE[is_lub] islub))])]; (* y1 negative *) LABEL_TAC "y1neg" (REWRITE_RULE[ARITH_RULE `~(&0 <= y) <=> y < &0`] (ASSUME `~(&0 <= (y1:real))`)) THEN USE_THEN "isglb" (fun isglb -> LABEL_CONJUNCTS_TAC ["islb"; "isgreat"] (REWRITE_RULE[is_glb] isglb)) THEN USE_THEN "islb" (fun islb -> LABEL_CONJUNCTS_TAC ["y1fixed"; "y1leqx"] (REWRITE_RULE[is_lb] islb)) THEN USE_THEN "y1fixed" (fun y1fixed -> X_CHOOSE_THEN `f1:num` (LABEL_CONJUNCTS_TAC ["y1frac0"]) (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] y1fixed)))) THEN USE_THEN "y1frac0" (fun y1frac0 -> (LABEL_CONJUNCTS_TAC ["y1frac1"; "y1frac2"]) (REWRITE_RULE[is_frac] y1frac0)) THEN (* lemma: f1 > 0 *) SUBGOAL_THEN `0 < f1` (LABEL_TAC "f1gt0") THENL [ MATCH_MP_TAC (SPEC `fmt:fformat` FIXED_FRAC_LT_0) THEN EXISTS_TAC `y1:real` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN (* lemma: f1 - 1 <= r^(p - 1) *) SUBGOAL_THEN `f1 - 1 <= (fr fmt) EXP ((fp fmt) - 1)` (LABEL_TAC "f1leq") THENL [ MATCH_MP_TAC (ARITH_RULE `x <= y ==> x - 1 <= y`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN REWRITE_TAC[GSYM FFORMAT_PREC_IPOW_EQ_EXP] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* lemma: y1 + fulp is a fixed point number *) SUBGOAL_THEN `(y1 + (fulp fmt)) IN fixed(fmt)` (LABEL_TAC "ulpfixed") THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_fixed] THEN REWRITE_TAC[is_frac] THEN EXISTS_TAC `f1 - 1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `x <= &0 /\ -- x = y ==> abs(x) = y`) THEN CONJ_TAC THENL [ USE_THEN "y1neg" (fun y1neg -> USE_THEN "y1frac0" (fun y1frac0 -> REWRITE_TAC[MATCH_MP FIXED_PLUS_FULP_NEG (CONJ y1neg y1frac0)])) THEN REWRITE_TAC[ARITH_RULE `(-- (a:real)) * b <= &0 <=> &0 <= a * b`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; ONCE_REWRITE_TAC[ARITH_RULE `-- (x:real) = a * b <=> x = (-- a) * b`] THEN MATCH_MP_TAC FIXED_PLUS_FULP_NEG THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `(y1 + (fulp fmt)) <= x` THENL [ (* contradiction in the positive case *) LABEL_TAC "ulpleqx" (ASSUME `y1 + (fulp fmt) <= x`) THEN (* lemma: y1 + fulp is a lower bound *) SUBGOAL_THEN `is_lb(fmt) x (y1 + (fulp fmt))` (LABEL_TAC "ulpislb") THENL [ REWRITE_TAC[is_lb] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* lemma: y1 is less than y1 + fulp *) SUBGOAL_THEN `y1 < (y1 + (fulp fmt))` (LABEL_TAC "y1lequlp") THENL [ REWRITE_TAC[ARITH_RULE `x:real < x + y <=> &0 < y`] THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN USE_THEN "isgreat" (fun isgreat -> USE_THEN "ulpislb" (fun ulpislb -> ASSUME_TAC (MATCH_MP isgreat ulpislb))) THEN ASM_ARITH_TAC; (* y1 + fulp > x *) LABEL_TAC "ulpgeqx" (MATCH_MP (ARITH_RULE `~((z:real) <= y) ==> y <= z`) (ASSUME `~(y1 + (fulp fmt) <= x)`)) THEN (* lemma: y1 + fulp is an upper bound *) SUBGOAL_THEN `is_ub(fmt) x (y1 + (fulp fmt))` (LABEL_TAC "ulpisub") THENL [ REWRITE_TAC[is_ub] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "islub" (fun islub -> LABEL_CONJUNCTS_TAC ["islb"; "isleast"] (REWRITE_RULE[is_lub] islub)) THEN USE_THEN "isleast" (fun isleast -> MATCH_MP_TAC isleast) THEN ASM_REWRITE_TAC[]]]]);; let FIXED_GLB_LUB_DIST = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> lub(fmt) x = glb(fmt) x \/ lub(fmt) x = glb(fmt) x + (fulp fmt)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FIXED_FULP_DISTANCE THEN REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ b) /\ (c /\ d)`] THEN CONJ_TAC THENL [ CONJ_TAC THENL [ MATCH_MP_TAC FIXED_GLB_IS_FIXED THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC FIXED_LUB_IS_FIXED THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC FIXED_GLB_LUB_BOUNDS THEN ASM_REWRITE_TAC[]]);; let FIXED_GLB_LUB_DIST_2 = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> abs(lub(fmt) x - glb(fmt) x) <= (fulp fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> DISJ_CASES_TAC (MATCH_MP FIXED_GLB_LUB_DIST thm)) THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `abs((x:real) - x) = &0`] THEN REWRITE_TAC[SPEC `fmt:fformat` FIXED_FULP_LE_0]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - x = y`] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) (SPEC `fmt:fformat` FIXED_FULP_LE_0)] THEN ARITH_TAC]);; let dump_glb_lub_info absx = CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["glb1"; "glb2"]) (MATCH_MP FIXED_GLB_EXISTS absx) THEN CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["lub1"; "lub2"]) (MATCH_MP FIXED_LUB_EXISTS absx) THEN USE_THEN "glb2" (fun glb2 -> LABEL_CONJUNCTS_TAC ["glb3"; "glb4"] (REWRITE_RULE[is_glb] glb2)) THEN USE_THEN "glb3" (fun glb3 -> LABEL_CONJUNCTS_TAC ["glb5"; "glb6"] (REWRITE_RULE[is_lb] glb3)) THEN USE_THEN "glb5" (fun glb5 -> CHOOSE_THEN (LABEL_TAC "glb7") (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[ fixed] glb5)))) THEN USE_THEN "glb7" (fun glb7 -> LABEL_CONJUNCTS_TAC ["glb8"; "glb9"] (REWRITE_RULE[is_frac] glb7)) THEN USE_THEN "lub2" (fun lub2 -> LABEL_CONJUNCTS_TAC ["lub3"; "lub4"] (REWRITE_RULE[is_lub] lub2)) THEN USE_THEN "lub3" (fun lub3 -> LABEL_CONJUNCTS_TAC ["lub5"; "lub6"] (REWRITE_RULE[is_ub] lub3)) THEN USE_THEN "lub5" (fun lub5 -> CHOOSE_THEN (LABEL_TAC "lub7") (REWRITE_RULE[is_fixed] (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[ fixed] lub5)))) THEN USE_THEN "lub7" (fun lub7 -> LABEL_CONJUNCTS_TAC ["lub8"; "lub9"] (REWRITE_RULE[is_frac] lub7));; let FIXED_GLB_LUB_FRAC = prove(`!(fmt:fformat) (x:real) (f1:num) (f2:num). abs(x) <= (finf fmt) ==> ((is_frac(fmt) (lub(fmt) x) f1) /\ (is_frac(fmt) (glb(fmt) x) f2) ==> (f1 = f2 /\ (lub(fmt) x = glb(fmt) x)) \/ f1 = f2 + 1 \/ f1 = f2 - 1)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["lubfrac"; "glbfrac"]) THEN SUBGOAL_THEN `(f1:num) = f'` (LABEL_TAC "f1eq") THENL [ MATCH_MP_TAC (SPEC `fmt:fformat` FIXED_FF_UNIQUE) THEN EXISTS_TAC `lub(fmt) x` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(f2:num) = f` (LABEL_TAC "f2eq") THENL [ MATCH_MP_TAC (SPEC `fmt:fformat` FIXED_FF_UNIQUE) THEN EXISTS_TAC `glb(fmt) x` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN USE_THEN "absx" (fun absx -> DISJ_CASES_TAC (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DIST) absx)) THENL [ (* eq *) DISJ1_TAC THEN USE_THEN "glb1" (fun glb1 -> ONCE_REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> ONCE_REWRITE_TAC[GSYM lub1]) THEN REWRITE_TAC[ASSUME `lub(fmt) x = glb(fmt) x`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> ~(x = &0)`) THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LT_0]; USE_THEN "glb9" (fun glb9 -> REWRITE_TAC[GSYM glb9]) THEN USE_THEN "lub9" (fun lub9 -> REWRITE_TAC[GSYM lub9]) THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN ASM_ARITH_TAC]; (* eq glb + ulp *) ASM_CASES_TAC `&0 <= glb(fmt) x` THENL [ (* glb non-negative *) DISJ2_TAC THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> ~(x = &0)`) THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LT_0]; USE_THEN "glb1" (fun glb1 -> LABEL_TAC "yge0" (MATCH_MP (ARITH_RULE `x = y /\ &0 <= x ==> &0 <= (y:real)`) (CONJ glb1 (ASSUME `&0 <= (glb fmt x)`)))) THEN USE_THEN "yge0" (fun yge0 -> USE_THEN "glb7" (fun glb7 -> REWRITE_TAC[GSYM (MATCH_MP (SPEC `fmt:fformat` FIXED_PLUS_FULP_NNEG) (CONJ yge0 glb7))])) THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN SUBGOAL_THEN `&0 <= lub(fmt) x` (LABEL_TAC "lubgeq0") THENL [ MATCH_MP_TAC (ARITH_RULE `!x. &0 <= x /\ x <= y ==> &0 <= (y:real)`) THEN EXISTS_TAC `glb(fmt) x` THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "lub9" (fun lub9 -> REWRITE_TAC[GSYM lub9]) THEN ASM_ARITH_TAC]; (* glb < 0 *) DISJ2_TAC THEN DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(fr fmt) ipow ((fe fmt) - &(fp fmt) + &1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> ~(x = &0)`) THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LT_0]; USE_THEN "glb1" (fun glb1 -> LABEL_TAC "ylt0" (MATCH_MP (ARITH_RULE `x = y /\ ~(&0 <= x) ==> (y:real) < &0`) (CONJ glb1 (ASSUME `~(&0 <= (glb fmt x))`)))) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(a:real) * b = -- (-- a * b)`] THEN USE_THEN "ylt0" (fun ylt0 -> USE_THEN "glb7" (fun glb7 -> LABEL_TAC "plusulp" (MATCH_MP (SPEC `fmt:fformat` FIXED_PLUS_FULP_NEG) (CONJ ylt0 glb7)))) THEN USE_THEN "plusulp" (fun plusulp -> REWRITE_TAC[GSYM plusulp]) THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN SUBGOAL_THEN `lub(fmt) x <= &0` (LABEL_TAC "lubgeq0") THENL [ ONCE_REWRITE_TAC[ASSUME `lub(fmt) x = glb(fmt) x + (fulp fmt)`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(-- a) * (b:real) <= &0 <=> &0 <= (a * b)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN USE_THEN "lub9" (fun lub9 -> REWRITE_TAC[GSYM lub9]) THEN ASM_ARITH_TAC]]]);; let FIXED_GLB_LUB_DISCRETE = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> (!(s:real). s IN (fixed fmt) ==> s <= glb(fmt) x \/ lub(fmt) x <= s)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s < glb(fmt) x \/ lub(fmt) x < s` THENL [ (* first case is trivial *) ASM_ARITH_TAC; USE_THEN "absx" (fun absx -> DISJ_CASES_TAC (MATCH_MP FIXED_GLB_LUB_DIST absx)) THENL [ (* the first sub case is somewhat trivial *) ASM_REWRITE_TAC[] THEN ARITH_TAC; ASM_REWRITE_TAC[] THEN LABEL_TAC "sbounds" ( REWRITE_RULE[ASSUME `lub(fmt) x = glb(fmt) x + (fulp fmt)`] (REWRITE_RULE[ ARITH_RULE `~((x:real) < y \/ z < x) <=> (y <= x /\ x <= z)`] (ASSUME `~((s:real) < glb(fmt) x \/ lub(fmt) x < s)`))) THEN MATCH_MP_TAC ( ARITH_RULE `(x:real) = y \/ x = z ==> x <= y \/ z <= x`) THEN USE_THEN "sbounds" (fun sbounds -> USE_THEN "absx" (fun absx -> REWRITE_TAC[MATCH_MP FIXED_FULP_DISTANCE (CONJ (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_IS_FIXED ) absx) (CONJ (ASSUME `(s:real) IN (fixed fmt)`) sbounds))]))]]);; let FIXED_GLB_LE_0 = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) /\ &0 <= x ==> &0 <= (glb(fmt) x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "xgeq0"]) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `is_lb(fmt) x (&0)` (LABEL_TAC "zerolb") THENL [ REWRITE_TAC[is_lb] THEN REWRITE_TAC[FIXED_ZERO_IN_FIXED] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "glb4" (fun glb4 -> USE_THEN "zerolb" (fun zerolb -> REWRITE_TAC[MATCH_MP glb4 zerolb])));; let FIXED_GLB_LE_0_2 = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) /\ x <= &0 ==> (glb(fmt) x) <= &0`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "xgeq0"]) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]);; let FIXED_LUB_LE_0 = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) /\ &0 <= x ==> &0 <= (lub(fmt) x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "xgeq0"]) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]);; let FIXED_LUB_LE_0_2 = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) /\ x <= &0 ==> (lub(fmt) x) <= &0`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "xgeq0"]) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `is_ub(fmt) x (&0)` (LABEL_TAC "zerolb") THENL [ REWRITE_TAC[is_ub] THEN REWRITE_TAC[FIXED_ZERO_IN_FIXED] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "lub4" (fun lub4 -> USE_THEN "zerolb" (fun zerolb -> REWRITE_TAC[MATCH_MP lub4 zerolb])));; (* -------------------------------------------------------------------------- *) (* Basic round-to-nearest thms *) (* -------------------------------------------------------------------------- *) let CLOSER_LOWER = prove(`!(x:real) (y:real) (z:real). x < y /\ y <= z ==> closer y x z`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN DISCH_TAC THEN SUBGOAL_THEN `x < (z:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs(x - z) = z - (x:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(y - z) = z - (y:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let CLOSER_HIGHER = prove(`!(x:real) (y:real) (z:real). x <= y /\ y < z ==> closer y z x`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN DISCH_TAC THEN SUBGOAL_THEN `x < (z:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs(x - z) = z - (x:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(y - z) = z - (y:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let CLOSER_EQ = prove(`!(x:real) (y:real). closer y y x <=> F`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSER_NEG = prove(`!(a:real) (x:real) (y:real). (closer x y a) ==> ~(closer y x a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSER_TRANS = prove(`!(a:real) (x:real) (y:real) (z:real). (closer x y a) /\ (closer y z a) ==> (closer x z a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSER_TRANS_2 = prove(`!(a:real) (x:real) (y:real) (z:real). ~(closer x y a) /\ ~(closer y x a) /\ (closer y z a) ==> (closer x z a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSER_BETWEEN_1 = prove(`!(a:real) (x:real) (y:real). (closer x y a \/ ~closer y x a) /\ x <= a /\ a <= y ==> abs(x - a) <= abs(y - x) / &2`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSER_BETWEEN_2 = prove(`!(a:real) (x:real) (y:real). (closer y x a \/ ~closer x y a) /\ x <= a /\ a <= y ==> abs(y - a) <= abs(y - x) / &2`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let is_closest = define `is_closest (fmt:fformat) (x:real) (y:real) = (!(s:real). (s IN (fixed fmt)) /\ ~(s = y) ==> ((closer y s x) \/ ~(closer s y x)))`;; let to_even = define `to_even (fmt:fformat) (x:real) (y:real) = (!(y2:real) (f:num). (y2 IN (fixed fmt)) /\ (is_closest(fmt) x y) /\ (is_closest(fmt) x y2) /\ ~(y2 = y) /\ (is_frac(fmt) y f) ==> (EVEN f))`;; let glb_fixed_proof = USE_THEN "absx" (fun absx -> LABEL_TAC "glbfixed" (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] (MATCH_MP FIXED_GLB_IS_FIXED absx)))) THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "glbfixed" (fun glbfixed -> REWRITE_TAC[glbfixed]);; let lub_fixed_proof = USE_THEN "absx" (fun absx -> LABEL_TAC "lubfixed" (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] (MATCH_MP FIXED_LUB_IS_FIXED absx)))) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN USE_THEN "lubfixed" (fun lubfixed -> REWRITE_TAC[lubfixed]);; let FIXED_RD_NEAREST_CLOSEST = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> ?(y:real). fround(fmt) To_near x = y /\ is_fixed(fmt) y /\ is_closest(fmt) x y`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN REWRITE_TAC[is_closest] THEN REWRITE_TAC[fround] THEN LET_TAC THEN (* might as well dump all of the facts ... *) LABEL_TAC "lodef" (ASSUME `glb(fmt) x = lo`) THEN LABEL_TAC "hidef" (ASSUME `lub(fmt) x = hi`) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "lodef" (fun lodef -> REWRITE_TAC[GSYM lodef]) THEN USE_THEN "hidef" (fun hidef -> REWRITE_TAC[GSYM hidef]) THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[lub1]) THEN COND_CASES_TAC THENL [ (* the glb is closer *) EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN (* show it is fixed *) CONJ_TAC THENL [glb_fixed_proof; ALL_TAC] THEN (* show it is closest *) REWRITE_TAC[is_closest] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sfixed"; "sneqy"]) THEN DISJ1_TAC THEN USE_THEN "absx" (fun absx -> USE_THEN "sfixed" (fun sfixed -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DISCRETE) absx) sfixed))) THENL [ (* s <= glb *) SUBGOAL_THEN `s < glb fmt x` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC; (* lub <= s *) ASM_CASES_TAC `s = lub(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[lub1]) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CLOSER_TRANS THEN EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC]]; ALL_TAC] THEN COND_CASES_TAC THENL [ (* the lub is closer *) EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN (* show fixed *) CONJ_TAC THENL [lub_fixed_proof; ALL_TAC] THEN (* show closest *) GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sfixed"; "sneqyp"]) THEN DISJ1_TAC THEN USE_THEN "absx" (fun absx -> USE_THEN "sfixed" (fun sfixed -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DISCRETE) absx) sfixed))) THENL [ ASM_CASES_TAC `s = glb(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[glb1]) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CLOSER_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC]; MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC]; ALL_TAC] THEN COND_CASES_TAC THENL [ (* neither is closer, but the glb has an even frac *) EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN (* show fixed *) CONJ_TAC THENL [glb_fixed_proof; ALL_TAC] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sfixed"; "sneqy"]) THEN DISJ2_TAC THEN USE_THEN "absx" (fun absx -> USE_THEN "sfixed" (fun sfixed -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DISCRETE) absx) sfixed))) THENL [ (* s <= glb *) ASM_CASES_TAC `s = glb(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[glb1]) THEN REWRITE_TAC[CLOSER_EQ]; MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC]; (* lub <= s *) ASM_CASES_TAC `s = lub(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "lub1" (fun lub1 -> ONCE_REWRITE_TAC[lub1]) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_TRANS_2 THEN EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC]]; (* neither is closer, but the glb does not have an even frac *) EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN (* show fixed *) CONJ_TAC THENL [lub_fixed_proof; ALL_TAC] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sfixed"; "sneqyp"]) THEN DISJ2_TAC THEN USE_THEN "absx" (fun absx -> USE_THEN "sfixed" (fun sfixed -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DISCRETE) absx) sfixed))) THENL [ (* s <= glb *) ASM_CASES_TAC `s = glb(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[glb1]) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_TRANS_2 THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC]; (* lub <= s *) ASM_CASES_TAC `s = lub(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "lub1" (fun lub1 -> ONCE_REWRITE_TAC[lub1]) THEN REWRITE_TAC[CLOSER_EQ]; MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC]]]);; let FIXED_RD_NEAREST_EVEN = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> ?(y:real). fround(fmt) To_near x = y /\ is_fixed(fmt) y /\ to_even(fmt) x y`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN REWRITE_TAC[fround] THEN LET_TAC THEN (* might as well dump all of the facts ... *) LABEL_TAC "lodef" (ASSUME `glb(fmt) x = lo`) THEN LABEL_TAC "hidef" (ASSUME `lub(fmt) x = hi`) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "lodef" (fun lodef -> REWRITE_TAC[GSYM lodef]) THEN USE_THEN "hidef" (fun hidef -> REWRITE_TAC[GSYM hidef]) THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[lub1]) THEN COND_CASES_TAC THENL [ (* the glb is closer *) EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [glb_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_even] THEN REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["y2fixed"; "yclosest"; "y2closest"; "y2neqy"; "yfrac"]) THEN SUBGOAL_THEN `~(is_closest(fmt) x y2)` (LABEL_TAC "notcl") THENL [ REWRITE_TAC[is_closest] THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `y:real` THEN REWRITE_TAC[NOT_IMP] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN USE_THEN "absx" (fun absx -> USE_THEN "y2fixed" (fun y2fixed -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DISCRETE) absx) y2fixed))) THENL [ (* y2 <= glb *) SUBGOAL_THEN `~(y2 = glb(fmt) x)` (LABEL_TAC "y2negglb") THENL [ USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[glb1]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC; MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC]; (* lub <= y2 *) ASM_CASES_TAC `y2 = lub(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[lub1]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_NEG THEN ASM_REWRITE_TAC[]; CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_TRANS THEN EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC; MATCH_MP_TAC CLOSER_TRANS THEN EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC]]]; ALL_TAC] THEN USE_THEN "y2closest" (fun y2closest -> USE_THEN "notcl" (fun notcl -> CONTR_TAC(REWRITE_RULE[TAUT `a /\ ~a <=> F`] (CONJ y2closest notcl)))); ALL_TAC] THEN COND_CASES_TAC THENL [ (* the lub is closer *) EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [lub_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_even] THEN REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["y2fixed"; "yclosest"; "y2closest"; "y2neqy"; "yfrac"]) THEN SUBGOAL_THEN `~(is_closest(fmt) x y2)` (LABEL_TAC "notcl") THENL [ REWRITE_TAC[is_closest] THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `y':real` THEN REWRITE_TAC[NOT_IMP] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN USE_THEN "absx" (fun absx -> USE_THEN "y2fixed" (fun y2fixed -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DISCRETE) absx) y2fixed))) THENL [ (* y2 <= glb *) ASM_CASES_TAC `y2 = glb(fmt) x` THENL [ ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[glb1]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_NEG THEN ASM_REWRITE_TAC[]; CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC; MATCH_MP_TAC CLOSER_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC]]; (* lub <= y2 *) SUBGOAL_THEN `~(y2 = lub(fmt) x)` ASSUME_TAC THENL [ USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[lub1]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC; MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC]]; ALL_TAC] THEN USE_THEN "y2closest" (fun y2closest -> USE_THEN "notcl" (fun notcl -> CONTR_TAC(REWRITE_RULE[TAUT `a /\ ~a <=> F`] (CONJ y2closest notcl)))); ALL_TAC] THEN COND_CASES_TAC THENL [ (* neither is closer, but the glb has an even frac *) EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [glb_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_even] THEN REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["y2fixed"; "yclosest"; "y2closest"; "y2neqy"; "yfrac"]) THEN USE_THEN "glb7" (fun glb7 -> USE_THEN "yfrac" (fun yfrac -> LABEL_TAC "feq" (MATCH_MP (SPEC `fmt:fformat` FIXED_FF_UNIQUE) (CONJ glb7 yfrac)))) THEN USE_THEN "feq" (fun feq -> REWRITE_TAC[GSYM feq]) THEN USE_THEN "glb5" (fun glb5 -> X_CHOOSE_THEN `fy:num` (LABEL_CONJUNCTS_TAC ["e1"; "e2"]) (MATCH_MP FIXED_FF_EXISTS glb5)) THEN USE_THEN "glb7" (fun glb7 -> USE_THEN "e2" (fun e2 -> LABEL_TAC "f2eq" (MATCH_MP (SPEC `fmt:fformat` FIXED_FF_UNIQUE) (CONJ glb7 e2)))) THEN USE_THEN "f2eq" (fun f2eq -> REWRITE_TAC[f2eq]) THEN USE_THEN "e1" (fun e1 -> REWRITE_TAC[GSYM e1]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* neither is closer, rtn = lub *) EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [lub_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_even] THEN REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["y2fixed"; "yclosest"; "y2closest"; "y2neqy"; "yfrac"]) THEN SUBGOAL_THEN `~(y' = (y:real))` (LABEL_TAC "lubneqglb") THENL [ USE_THEN "absx" (fun absx -> USE_THEN "y2fixed" (fun y2fixed -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_DISCRETE) absx) y2fixed))) THENL [ (* y2 <= glb *) ASM_CASES_TAC `y2 = glb(fmt) x` THENL [ ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN USE_THEN "glb1" (fun glb1 -> ONCE_REWRITE_TAC[GSYM glb1]) THEN ONCE_REWRITE_TAC[GSYM(ASSUME `y2 = glb(fmt) x`)] THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `~(is_closest(fmt) x y2)` (LABEL_TAC "notcl") THENL [ REWRITE_TAC[is_closest] THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `y':real` THEN REWRITE_TAC[NOT_IMP] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_TRANS_2 THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC; MATCH_MP_TAC CLOSER_TRANS_2 THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSER_LOWER THEN ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "y2closest" (fun y2closest -> USE_THEN "notcl" (fun notcl -> CONTR_TAC(REWRITE_RULE[TAUT `a /\ ~a <=> F`] (CONJ y2closest notcl))))]; (* lub <= y2 *) ASM_CASES_TAC `y2 = lub(fmt) x` THENL [ USE_THEN "lub1" (fun lub1 -> USE_THEN "y2neqy" (fun y2neqy -> CONTR_TAC( REWRITE_RULE[TAUT `a /\ ~a <=> F`] (CONJ (REWRITE_RULE[lub1] (ASSUME `y2 = lub(fmt) x`)) y2neqy)))); SUBGOAL_THEN `~(is_closest(fmt) x y2)` (LABEL_TAC "notcl") THENL [ REWRITE_TAC[is_closest] THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `y':real` THEN REWRITE_TAC[NOT_IMP] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_NEG THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC; MATCH_MP_TAC CLOSER_HIGHER THEN ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "y2closest" (fun y2closest -> USE_THEN "notcl" (fun notcl -> CONTR_TAC(REWRITE_RULE[TAUT `a /\ ~a <=> F`] (CONJ y2closest notcl))))]]; ALL_TAC] THEN (* okay, now we can assume lub != glb *) USE_THEN "lub7" (fun lub7 -> USE_THEN "yfrac" (fun yfrac -> LABEL_TAC "feq" (MATCH_MP (SPEC `fmt:fformat` FIXED_FF_UNIQUE) (CONJ lub7 yfrac)))) THEN USE_THEN "feq" (fun feq -> REWRITE_TAC[GSYM feq]) THEN USE_THEN "glb5" (fun glb5 -> X_CHOOSE_THEN `fy:num` (LABEL_CONJUNCTS_TAC ["e1"; "e2"]) (MATCH_MP FIXED_FF_EXISTS glb5)) THEN USE_THEN "glb7" (fun glb7 -> USE_THEN "e2" (fun e2 -> LABEL_TAC "f2eq" (MATCH_MP (SPEC `fmt:fformat` FIXED_FF_UNIQUE) (CONJ glb7 e2)))) THEN USE_THEN "absx" (fun absx -> USE_THEN "glb7" (fun glb7 -> USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> USE_THEN "lub7" (fun lub7 -> DISJ_CASES_TAC (MATCH_MP (MATCH_MP (SPEC `fmt:fformat` FIXED_GLB_LUB_FRAC) absx) (CONJ (REWRITE_RULE[GSYM lub1] lub7) (REWRITE_RULE[GSYM glb1] glb7)))))))) THENL [ (* glb = lub, contradiction *) ASM_ARITH_TAC; ALL_TAC] THEN DISJ_CASES_TAC (ASSUME `f':num = f + 1 \/ f' = f - 1`) THENL [ REWRITE_TAC[ASSUME `f':num = f + 1`] THEN ASM_REWRITE_TAC[] THEN USE_THEN "e1" (fun e1 -> ONCE_REWRITE_TAC[GSYM e1]) THEN REWRITE_TAC[GSYM ADD1] THEN REWRITE_TAC[EVEN] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[ASSUME `f':num = f - 1`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EVEN_SUB] THEN DISJ2_TAC THEN REWRITE_TAC[ARITH_RULE `1 = SUC(0)`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EVEN] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EVEN] THEN REWRITE_TAC[] THEN USE_THEN "e1" (fun e1 -> REWRITE_TAC[GSYM e1]) THEN ASM_REWRITE_TAC[]]);; (* simple combination of previous thms *) let FIXED_RD_NEAREST_EXISTS = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> ?(y:real). fround(fmt) To_near x = y /\ is_fixed(fmt) y /\ is_closest(fmt) x y /\ to_even(fmt) x y`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["eq1"; "fixed1"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST absx)) THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["eq2"; "fixed2"; "even"]) (MATCH_MP FIXED_RD_NEAREST_EVEN absx)) THEN EXISTS_TAC `y:real` THEN EXPAND_TAC "y" THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "y" THEN USE_THEN "eq2" (fun eq2 -> REWRITE_TAC[eq2]) THEN ASM_REWRITE_TAC[]);; (* -------------------------------------------------------------------------- *) (* Round-to-zero, -to-pinf, and -to-ninf *) (* -------------------------------------------------------------------------- *) let to_zero = define `to_zero (fmt:fformat) (x:real) (y:real) = (if (&0 <= x) then (&0 <= y) /\ (y <= x) /\ !(y':real). y' IN (fixed fmt) /\ y' <= x ==> y' <= y else (y <= &0) /\ (x <= y) /\ !(y':real). y' IN (fixed fmt) /\ x <= y' ==> y <= y')`;; let FIXED_RD_ZERO_EXISTS = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> ?(y:real). fround(fmt) To_zero x = y /\ is_fixed(fmt) y /\ to_zero(fmt) x y`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN REWRITE_TAC[fround] THEN COND_CASES_TAC THENL [ (* 0 <= x, rtz = glb *) EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [glb_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_zero] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ (* 0 <= glb *) SUBGOAL_THEN `is_lb(fmt) x (&0)` (LABEL_TAC "zerolb") THENL [ REWRITE_TAC[is_lb] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FIXED_ZERO_IN_FIXED]; ALL_TAC] THEN USE_THEN "zerolb" (fun zerolb -> USE_THEN "glb4" (fun glb4 -> REWRITE_TAC[MATCH_MP glb4 zerolb])); (* y is closest to x, from zero *) REWRITE_TAC[GSYM is_lb] THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN (* x < 0 *) EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [lub_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_zero] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ (* lub <= 0 *) SUBGOAL_THEN `is_ub(fmt) x (&0)` (LABEL_TAC "zeroub") THENL [ REWRITE_TAC[is_ub] THEN REWRITE_TAC[FIXED_ZERO_IN_FIXED] THEN MATCH_MP_TAC (ARITH_RULE `~(&0 <= (x:real)) ==> x <= &0`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "zeroub" (fun zeroub -> USE_THEN "lub4" (fun lub4 -> REWRITE_TAC[MATCH_MP lub4 zeroub])); (* y is closest to x, from zero *) REWRITE_TAC[GSYM is_ub] THEN ASM_REWRITE_TAC[]]);; let to_pinf = define `to_pinf (fmt:fformat) (x:real) (y:real) = (x <= y /\ !(y':real). y' IN (fixed fmt) /\ x <= y' ==> y <= y')`;; let FIXED_RD_PINF_EXISTS = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> ?(y:real). fround(fmt) To_pinf x = y /\ is_fixed(fmt) y /\ to_pinf(fmt) x y`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN REWRITE_TAC[fround] THEN EXISTS_TAC `y':real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [lub_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_pinf] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM is_ub] THEN ASM_REWRITE_TAC[]);; let to_ninf = define `to_ninf (fmt:fformat) (x:real) (y:real) = (y <= x /\ !(y':real). y' IN (fixed fmt) /\ y' <= x ==> y' <= y)`;; let FIXED_RD_NINF_EXISTS = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> ?(y:real). fround(fmt) To_ninf x = y /\ is_fixed(fmt) y /\ to_ninf(fmt) x y`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN REWRITE_TAC[fround] THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [glb_fixed_proof; ALL_TAC] THEN REWRITE_TAC[to_ninf] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM is_lb] THEN ASM_REWRITE_TAC[]);; (* -------------------------------------------------------------------------- *) (* Useful properties *) (* -------------------------------------------------------------------------- *) let FIXED_RD_IS_GLB_LUB = prove(`!(fmt:fformat) (x:real) (m:roundmode) (y:real). fround(fmt) m x = y ==> y = glb(fmt) x \/ y = lub(fmt) x`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC roundmode_INDUCT THEN REWRITE_TAC[fround] THEN SIMP_TAC[] THEN CONJ_TAC THENL [ LET_TAC THEN COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN SIMP_TAC[]; COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN SIMP_TAC[]]);; let FIXED_RD_IS_GLB_LUB_2 = prove(`!(fmt:fformat) (x:real) (m:roundmode). fround(fmt) m x = glb(fmt) x \/ fround(fmt) m x = lub(fmt) x`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC roundmode_INDUCT THEN REWRITE_TAC[fround] THEN CONJ_TAC THENL [ LET_TAC THEN LET_TAC THEN COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN SIMP_TAC[]; COND_CASES_TAC THENL [ SIMP_TAC[]; ALL_TAC] THEN SIMP_TAC[]]);; let FIXED_RD_LE_0 = prove(`!(fmt:fformat) (x:real) (m:roundmode). abs(x) <= (finf fmt) /\ &0 <= x ==> &0 <= (fround(fmt) m x)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC (SPECL [`fmt:fformat`; `x:real`; `m:roundmode`] FIXED_RD_IS_GLB_LUB_2) THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[FIXED_GLB_LE_0]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[FIXED_LUB_LE_0]]);; let FIXED_RD_LE_0_2 = prove(`!(fmt:fformat) (x:real) (m:roundmode). abs(x) <= (finf fmt) /\ x <= &0 ==> (fround(fmt) m x) <= &0`, REPEAT GEN_TAC THEN DISJ_CASES_TAC (SPECL [`fmt:fformat`; `x:real`; `m:roundmode`] FIXED_RD_IS_GLB_LUB_2) THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[FIXED_GLB_LE_0_2]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[FIXED_LUB_LE_0_2]]);; let FIXED_RD_MONO = prove(`!(fmt:fformat) (x:real) (y:real) (m:roundmode). abs(x) <= (finf fmt) /\ is_fixed(fmt) y /\ x <= y ==> (fround(fmt) m x) <= y`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "yfixed"; "xleqy"]) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `lub(fmt) x` THEN CONJ_TAC THENL [ DISJ_CASES_TAC (SPECL [`fmt:fformat`; `x:real`; `m:roundmode`] FIXED_RD_IS_GLB_LUB_2) THENL [ ASM_REWRITE_TAC[] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[MATCH_MP FIXED_GLB_LUB_BOUNDS absx]); ASM_ARITH_TAC]; USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN ASM_REWRITE_TAC[] THEN USE_THEN "lub4" (fun lub4 -> MATCH_MP_TAC lub4) THEN REWRITE_TAC[is_ub] THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]]);; let FIXED_RD_MONO_2 = prove(`!(fmt:fformat) (x:real) (y:real) (m:roundmode). abs(x) <= (finf fmt) /\ is_fixed(fmt) y /\ y <= x ==> y <= (fround(fmt) m x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "yfixed"; "yleqx"]) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `glb(fmt) x` THEN CONJ_TAC THENL [ USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN ASM_REWRITE_TAC[] THEN USE_THEN "glb4" (fun glb4 -> MATCH_MP_TAC glb4) THEN REWRITE_TAC[is_lb] THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; DISJ_CASES_TAC (SPECL [`fmt:fformat`; `x:real`; `m:roundmode`] FIXED_RD_IS_GLB_LUB_2) THENL [ ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[MATCH_MP FIXED_GLB_LUB_BOUNDS absx])]]);; let FIXED_RD_EQ_0 = prove(`!(fmt:fformat) (m:roundmode). (fround(fmt) m (&0)) = &0`, REPEAT GEN_TAC THEN SUBGOAL_THEN `&0 <= (fround(fmt) m (&0))` ASSUME_TAC THENL [ MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ REWRITE_TAC[ARITH_RULE `abs(&0) = &0`] THEN REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0]; ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `(fround(fmt) m (&0)) <= &0` ASSUME_TAC THENL [ MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ REWRITE_TAC[ARITH_RULE `abs(&0) = &0`] THEN REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0]; ARITH_TAC]; ALL_TAC] THEN ASM_ARITH_TAC);; let FIXED_RD_IS_FIXED = prove(`!(fmt:fformat) (x:real) (m:roundmode). abs(x) <= (finf fmt) ==> is_fixed(fmt) (fround(fmt) m x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN DISJ_CASES_TAC (SPECL [`fmt:fformat`; `x:real`; `m:roundmode`] FIXED_RD_IS_GLB_LUB_2) THENL [ ASM_REWRITE_TAC[] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[ REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] (MATCH_MP FIXED_GLB_IS_FIXED absx))]); ASM_REWRITE_TAC[] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[ REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] (MATCH_MP FIXED_LUB_IS_FIXED absx))])]);; (* -------------------------------------------------------------------------- *) (* Absolute error when rounding *) (* -------------------------------------------------------------------------- *) let FIXED_RD_NEAREST_ABS_ERROR = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> abs(fround(fmt) To_near x - x) <= (fulp fmt) / &2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "rdfixed"; "closeassum"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST absx)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "freq" (fun freq -> DISJ_CASES_TAC (MATCH_MP FIXED_RD_IS_GLB_LUB freq)) THENL [ ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(x:real) = (y:real)` THENL [ (* x = glb *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[ ARITH_RULE `abs((y:real) - y) = &0`] THEN MATCH_MP_TAC (ARITH_RULE `&0 <= (x:real) ==> &0 <= x / &2`) THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[SPEC `fmt:fformat` FFORMAT_RADIX_IPOW_LE_0]; (* glb < x *) SUBGOAL_THEN `~(y' = (y:real))` ASSUME_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!(x:real). z1 < x /\ x <= z2 ==> ~(z2 = z1)`) THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `(y:real) <= x /\ ~(x = y) ==> y < x`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - y) / &2` THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_BETWEEN_1 THEN ASM_REWRITE_TAC[] THEN USE_THEN "closeassum" (fun closeassum -> USE_THEN "glb1" (fun glb1 -> MATCH_MP_TAC (REWRITE_RULE[is_closest] ( REWRITE_RULE[glb1] (REWRITE_RULE[ASSUME `y'' = glb(fmt) x`] closeassum))))) THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `y' = y + (fulp fmt)` ASSUME_TAC THENL [ USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> MP_TAC (REWRITE_RULE[GSYM glb1] (REWRITE_RULE[GSYM lub1] (ASSUME `~(y' = (y:real))`))))) THEN REWRITE_TAC[TAUT `a ==> b <=> ~a \/ b`] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[MATCH_MP FIXED_GLB_LUB_DIST absx]); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((y:real) + x) - y = x`] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) (SPEC `fmt:fformat` FIXED_FULP_LE_0)] THEN ARITH_TAC]]; ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(x:real) = (y':real)` THENL [ (* x = lub *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[ ARITH_RULE `abs((y':real) - y') = &0`] THEN MATCH_MP_TAC (ARITH_RULE `&0 <= (x:real) ==> &0 <= x / &2`) THEN REWRITE_TAC[SPEC `fmt:fformat` FIXED_FULP_LE_0]; (* x < lub *) SUBGOAL_THEN `~(y' = (y:real))` ASSUME_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!(x:real). z1 <= x /\ x < z2 ==> ~(z2 = z1)`) THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `(x:real) <= y /\ ~(x = y) ==> x < y`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - y) / &2` THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_BETWEEN_2 THEN ASM_REWRITE_TAC[] THEN USE_THEN "closeassum" (fun closeassum -> USE_THEN "lub1" (fun lub1 -> MATCH_MP_TAC (REWRITE_RULE[is_closest] ( REWRITE_RULE[lub1] (REWRITE_RULE[ASSUME `y'' = lub(fmt) x`] closeassum))))) THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `y' = y + (fulp fmt)` ASSUME_TAC THENL [ USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> MP_TAC (REWRITE_RULE[GSYM glb1] (REWRITE_RULE[GSYM lub1] (ASSUME `~(y' = (y:real))`))))) THEN REWRITE_TAC[TAUT `a ==> b <=> ~a \/ b`] THEN USE_THEN "absx" (fun absx -> REWRITE_TAC[MATCH_MP FIXED_GLB_LUB_DIST absx]); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((y:real) + x) - y = x`] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) (SPEC `fmt:fformat` FIXED_FULP_LE_0)] THEN ARITH_TAC]]]);; (* if I had proved the existence theorems a bit differently, I could have *) (* done this for all rounding modes in one shot ... *) let FIXED_RD_ZERO_ABS_ERROR = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> abs(fround(fmt) To_zero x - x) <= fulp fmt`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "rdfixed"; "closeassum"]) (MATCH_MP FIXED_RD_ZERO_EXISTS absx)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "freq" (fun freq -> DISJ_CASES_TAC (MATCH_MP FIXED_RD_IS_GLB_LUB freq)) THENL [ (* rtz = glb *) ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - (y:real))` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(z:real) <= a /\ a <= w ==> abs(z - a) <= abs(w - z)`) THEN ASM_REWRITE_TAC[]; USE_THEN "absx" (fun absx -> USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[glb1] (REWRITE_RULE[lub1] (SPECL [`fmt:fformat`;`x:real`] FIXED_GLB_LUB_DIST_2))) absx])))]; (* rtz = lub *) ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - (y:real))` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(z:real) <= a /\ a <= w ==> abs(w - a) <= abs(w - z)`) THEN ASM_REWRITE_TAC[]; USE_THEN "absx" (fun absx -> USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[glb1] (REWRITE_RULE[lub1] (SPECL [`fmt:fformat`;`x:real`] FIXED_GLB_LUB_DIST_2))) absx])))]]);; let FIXED_RD_PINF_ABS_ERROR = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> abs(fround(fmt) To_pinf x - x) <= fulp fmt`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "rdfixed"; "closeassum"]) (MATCH_MP FIXED_RD_PINF_EXISTS absx)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "freq" (fun freq -> DISJ_CASES_TAC (MATCH_MP FIXED_RD_IS_GLB_LUB freq)) THENL [ (* rt pinf = glb *) ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - (y:real))` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(z:real) <= a /\ a <= w ==> abs(z - a) <= abs(w - z)`) THEN ASM_REWRITE_TAC[]; USE_THEN "absx" (fun absx -> USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[glb1] (REWRITE_RULE[lub1] (SPECL [`fmt:fformat`;`x:real`] FIXED_GLB_LUB_DIST_2))) absx])))]; (* rtz = lub *) ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - (y:real))` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(z:real) <= a /\ a <= w ==> abs(w - a) <= abs(w - z)`) THEN ASM_REWRITE_TAC[]; USE_THEN "absx" (fun absx -> USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[glb1] (REWRITE_RULE[lub1] (SPECL [`fmt:fformat`;`x:real`] FIXED_GLB_LUB_DIST_2))) absx])))]]);; let FIXED_RD_NINF_ABS_ERROR = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) ==> abs(fround(fmt) To_ninf x - x) <= fulp fmt`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absx") THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "rdfixed"; "closeassum"]) (MATCH_MP FIXED_RD_NINF_EXISTS absx)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "freq" (fun freq -> DISJ_CASES_TAC (MATCH_MP FIXED_RD_IS_GLB_LUB freq)) THENL [ (* rt pinf = glb *) ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - (y:real))` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(z:real) <= a /\ a <= w ==> abs(z - a) <= abs(w - z)`) THEN ASM_REWRITE_TAC[]; USE_THEN "absx" (fun absx -> USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[glb1] (REWRITE_RULE[lub1] (SPECL [`fmt:fformat`;`x:real`] FIXED_GLB_LUB_DIST_2))) absx])))]; (* rtz = lub *) ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(y' - (y:real))` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(z:real) <= a /\ a <= w ==> abs(w - a) <= abs(w - z)`) THEN ASM_REWRITE_TAC[]; USE_THEN "absx" (fun absx -> USE_THEN "glb1" (fun glb1 -> USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[glb1] (REWRITE_RULE[lub1] (SPECL [`fmt:fformat`;`x:real`] FIXED_GLB_LUB_DIST_2))) absx])))]]);; (* -------------------------------------------------------------------------- *) (* Relative error when rounding *) (* -------------------------------------------------------------------------- *) (* The relative error is unbounded for to-pinf and to-ninf, so it only makes *) (* sense to prove for to-nearest and to-zero. *) let FIXED_RD_NEAREST_TO_GLB = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) /\ x < glb(fmt) x + (fulp fmt) / &2 ==> (fround(fmt) To_near x) = glb(fmt) x`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "xleqglb"]) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "rdfixed"; "closeassum"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST absx)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "absx" (fun absx -> DISJ_CASES_TAC (MATCH_MP FIXED_GLB_LUB_DIST absx)) THENL [ USE_THEN "freq" (fun freq -> DISJ_CASES_TAC (MATCH_MP FIXED_RD_IS_GLB_LUB freq)) THENL [ ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN REWRITE_TAC[ASSUME `lub(fmt) x = glb(fmt) x`]]; (* this is the harder part ... *) SUBGOAL_THEN `(closer (glb(fmt) x) (lub(fmt) x) x)` (LABEL_TAC "glbcloser") THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN USE_THEN "glb6" (fun glb6 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(y:real) <= x ==> abs(y - x) = x - y`) glb6]) THEN USE_THEN "lub6" (fun lub6 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(y:real) <= x ==> abs(x - y) = x - y`) lub6]) THEN ONCE_REWRITE_TAC[ARITH_RULE `(x:real) - y < y' - x <=> &2 * x - y < y'`] THEN ONCE_REWRITE_TAC[ARITH_RULE `&2 * (x:real) - y < y' <=> &2 * x - &2 * y < y' - y`] THEN ONCE_REWRITE_TAC[ARITH_RULE `&2 * (x:real) - &2 * y = &2 * (x - y)`] THEN ONCE_REWRITE_TAC[ARITH_RULE `&2 * (x - y) < y' - y <=> x - y < (y' - y) / &2`] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN REWRITE_TAC[ASSUME `lub(fmt) x = glb(fmt) x + (fulp fmt)`] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - x = y`] THEN ONCE_REWRITE_TAC[ARITH_RULE `(x:real) - z < y <=> x < z + y`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "freq" (fun freq -> REWRITE_TAC[GSYM freq]) THEN REWRITE_TAC[fround] THEN LET_TAC THEN ASM_REWRITE_TAC[]]);; let FIXED_RD_NEAREST_TO_LUB = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) /\ lub(fmt) x - (fulp fmt) / &2 < x ==> (fround(fmt) To_near x) = lub(fmt) x`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "xleqglb"]) THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "absx" (fun absx -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "rdfixed"; "closeassum"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST absx)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "absx" (fun absx -> DISJ_CASES_TAC (MATCH_MP FIXED_GLB_LUB_DIST absx)) THENL [ USE_THEN "freq" (fun freq -> DISJ_CASES_TAC (MATCH_MP FIXED_RD_IS_GLB_LUB freq)) THENL [ ASM_REWRITE_TAC[] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN REWRITE_TAC[ASSUME `lub(fmt) x = glb(fmt) x`]; ASM_REWRITE_TAC[]]; (* this is the harder part ... *) SUBGOAL_THEN `(closer (lub(fmt) x) (glb(fmt) x) x)` (LABEL_TAC "lubcloser") THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN USE_THEN "glb6" (fun glb6 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(y:real) <= x ==> abs(y - x) = x - y`) glb6]) THEN USE_THEN "lub6" (fun lub6 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(y:real) <= x ==> abs(x - y) = x - y`) lub6]) THEN REWRITE_TAC[ARITH_RULE `(y':real) - x < x - y <=> y' - x < (y' - y) / &2`] THEN USE_THEN "glb1" (fun glb1 -> REWRITE_TAC[GSYM glb1]) THEN USE_THEN "lub1" (fun lub1 -> REWRITE_TAC[GSYM lub1]) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ASSUME `lub(fmt) x = glb(fmt) x + (fulp fmt)`] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - x = y`] THEN ONCE_REWRITE_TAC[ARITH_RULE `(x:real) - z < y <=> x - y < z`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "freq" (fun freq -> REWRITE_TAC[GSYM freq]) THEN REWRITE_TAC[fround] THEN USE_THEN "lubcloser" (fun lubcloser -> ASSUME_TAC ( MATCH_MP CLOSER_NEG lubcloser)) THEN LET_TAC THEN ASM_REWRITE_TAC[]]);; let FIXED_RD_NEAREST_TO_0 = prove(`!(fmt:fformat) (x:real). abs(x) < (fulp fmt) / &2 ==> (fround(fmt) To_near x) = &0`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absxleqfulp") THEN SUBGOAL_THEN `abs(x) <= (finf fmt)` (LABEL_TAC "absx") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `fulp fmt` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; REWRITE_TAC[FIXED_FULP_LE_FINF]]; ALL_TAC] THEN LABEL_TAC "zerofixed" (SPEC `fmt:fformat` FIXED_ZERO_IN_FIXED) THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ SUBGOAL_THEN `is_glb(fmt) x (&0)` (LABEL_TAC "isglb0") THENL [ (* there's got to be an easier way ... *) REWRITE_TAC[is_glb] THEN REWRITE_TAC[is_lb] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FIXED_ZERO_IN_FIXED] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["yfixed"; "yleqx"]) THEN ASM_CASES_TAC `&0 <= (y':real)` THENL [ SUBGOAL_THEN `(y':real) <= &0 + (fulp fmt)` (LABEL_TAC "yleqfulp") THENL [ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yleqfulp" (fun yleqfulp -> USE_THEN "zerofixed" (fun zerofixed -> USE_THEN "yfixed" (fun yfixed -> DISJ_CASES_TAC (MATCH_MP (SPEC `fmt:fformat` FIXED_FULP_DISTANCE) (CONJ zerofixed (CONJ yfixed (CONJ (ASSUME `&0 <= (y':real)`) yleqfulp))))))) THENL [ ASM_REWRITE_TAC[] THEN ARITH_TAC; SUBGOAL_THEN `~(y' = &0 + (fulp fmt))` ASSUME_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(x:real) < y ==> ~(x = y)`) THEN REWRITE_TAC[ARITH_RULE `&0 + x = (x:real)`] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:real) <= y /\ y < z ==> x < z`) THEN EXISTS_TAC `(fulp fmt) / &2` THEN USE_THEN "absxleqfulp" (fun absxleqfulp -> ASSUME_TAC ( REWRITE_RULE[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) (ASSUME `&0 <= (x:real)`)] absxleqfulp)) THEN CONJ_TAC THENL [ ASM_ARITH_TAC; REWRITE_TAC[ARITH_RULE `(x:real) / &2 < x <=> &0 < x`] THEN REWRITE_TAC[FIXED_FULP_LT_0]]; ALL_TAC] THEN ASM_ARITH_TAC]; (* y' < 0 *) ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "isglb0" (fun isglb0 -> USE_THEN "glb2" (fun glb2 -> USE_THEN "absx" (fun absx -> LABEL_TAC "yeq0" (MATCH_MP FIXED_GLB_UNIQUE (CONJ absx (CONJ glb2 isglb0)))))) THEN SUBGOAL_THEN `x < glb(fmt) x + (fulp fmt) / &2` (LABEL_TAC "xleqfulp") THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `&0 + (x:real) = x`] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) (ASSUME `&0 <= (x:real)`)] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "absx" (fun absx -> USE_THEN "xleqfulp" (fun xleqfulp -> REWRITE_TAC[MATCH_MP FIXED_RD_NEAREST_TO_GLB (CONJ absx xleqfulp)])) THEN ASM_REWRITE_TAC[]; (* x < 0 *) SUBGOAL_THEN `is_lub(fmt) x (&0)` (LABEL_TAC "islub0") THENL [ REWRITE_TAC[is_lub] THEN REWRITE_TAC[is_ub] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FIXED_ZERO_IN_FIXED] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `~(&0 <= (x:real)) ==> x <= &0`) (ASSUME `~(&0 <= (x:real))`)] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["yfixed"; "yleqx"]) THEN ASM_CASES_TAC `(y':real) <= &0` THENL [ SUBGOAL_THEN `-- (fulp fmt) <= (y':real)` (LABEL_TAC "fulpleqy") THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `-- (fulp fmt) IN (fixed fmt)` (LABEL_TAC "negfulpfixed") THENL [ REWRITE_TAC[GSYM FIXED_NEG_SYM] THEN REWRITE_TAC[FIXED_FULP_IN_FIXED]; ALL_TAC] THEN SUBGOAL_THEN `(y':real) <= -- (fulp fmt) + (fulp fmt)` (LABEL_TAC "yleqfulp0") THENL [ REWRITE_TAC[ARITH_RULE `-- (x:real) + x = &0`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "fulpleqy" (fun fulpleqy -> USE_THEN "negfulpfixed" (fun negfulpfixed -> USE_THEN "yfixed" (fun yfixed -> USE_THEN "yleqfulp0" (fun yleqfulp0 -> DISJ_CASES_TAC (MATCH_MP (SPEC `fmt:fformat` FIXED_FULP_DISTANCE) (CONJ negfulpfixed (CONJ yfixed (CONJ fulpleqy yleqfulp0)))))))) THENL [ SUBGOAL_THEN `~(y' = -- (fulp fmt))` ASSUME_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `(x:real) < y ==> ~(y = x)`) THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:real) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `(-- (fulp fmt)) / &2` THEN USE_THEN "absxleqfulp" (fun absxleqfulp -> ASSUME_TAC ( REWRITE_RULE[MATCH_MP (ARITH_RULE `~(&0 <= (x:real)) ==> (abs(x) < z <=> x > -- z)`) (ASSUME `~(&0 <= (x:real))`)] absxleqfulp)) THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN ASM_ARITH_TAC; ASM_ARITH_TAC]; ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "absx" (fun absx -> dump_glb_lub_info absx) THEN USE_THEN "islub0" (fun islub0 -> USE_THEN "lub2" (fun lub2 -> USE_THEN "absx" (fun absx -> LABEL_TAC "yeq0" (MATCH_MP FIXED_LUB_UNIQUE (CONJ absx (CONJ lub2 islub0)))))) THEN SUBGOAL_THEN `lub(fmt) x - (fulp fmt) / &2 < x` (LABEL_TAC "fulpleqx") THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `&0 - (x:real) = -- x`] THEN USE_THEN "absxleqfulp" (fun absxleqfulp -> ASSUME_TAC ( REWRITE_RULE[MATCH_MP (ARITH_RULE `~(&0 <= (x:real)) ==> (abs(x) < z <=> x > -- z)`) (ASSUME `~(&0 <= (x:real))`)] absxleqfulp)) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absx" (fun absx -> USE_THEN "fulpleqx" (fun fulpleqx -> REWRITE_TAC[MATCH_MP FIXED_RD_NEAREST_TO_LUB (CONJ absx fulpleqx)])) THEN ASM_REWRITE_TAC[]]);; (* this is the tightest bound possible for fixed point *) let FIXED_RD_NEAREST_REL_ERROR = prove(`!(fmt:fformat) (x:real). abs(x) <= (finf fmt) /\ ~(x = &0) ==> (rerror x (fround(fmt) To_near x)) <= &1`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absx"; "xneq0"]) THEN ASM_CASES_TAC `abs(x) < (fulp fmt) / &2` THENL [ (* rtn = 0 *) ASSUME_TAC (MATCH_MP FIXED_RD_NEAREST_TO_0 (ASSUME `abs(x) < (fulp fmt) / &2`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[rerror] THEN ONCE_REWRITE_TAC[ARITH_RULE `(&0 - x) / x = -- (x / x)`] THEN ONCE_REWRITE_TAC[ARITH_RULE `abs(-- x) = abs(x)`] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[MATCH_MP REAL_DIV_REFL xneq0]) THEN ARITH_TAC; (* other case *) REWRITE_TAC[rerror] THEN REWRITE_TAC[REAL_ABS_DIV] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs((x:real))` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; REWRITE_TAC[ARITH_RULE `(x:real) * &1 = x`] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * (b / c) = b * (a / c)`] THEN REWRITE_TAC[GSYM REAL_ABS_DIV] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[MATCH_MP REAL_DIV_REFL xneq0]) THEN REWRITE_TAC[ARITH_RULE `(a:real) * abs(&1) = a`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(fulp fmt) / &2` THEN CONJ_TAC THENL [ MATCH_MP_TAC FIXED_RD_NEAREST_ABS_ERROR THEN ASM_REWRITE_TAC[]; ASM_ARITH_TAC]]]);; (* -------------------------------------------------------------------------- *) (* Some lemmas for rounding *) (* -------------------------------------------------------------------------- *) (* let FIXED_RD_ *) hol-light/IEEE/float.hl000066400000000000000000000314521303454263000151130ustar00rootroot00000000000000(* ========================================================================== *) (* FLOATING POINT DEFINITIONS *) (* ========================================================================== *) (* needs "IEEE/common.hl";; *) (* needs "IEEE/fixed.hl";; *) (* References: *) (* *) (* [ 1 ] John Harrison, "A Machine-Checked Theory of Floating Point *) (* Arithmetic", from Lecture Notes in Computer Science, Vol. 1690, *) (* September 1999. *) (* [ 2 ] David Goldberg, "What Every Computer Scientist Should Know About *) (* Floating-Point Arithmetic", from Computing Surveys, March 1991 *) (* issue. *) (* [ 3 ] Nicholas Higham, "Accuracy and Stability of Numerical Algorithms", *) (* Second Edition, 2002. *) (* [ 4 ] IEEE 754 Standard for Floating Point Arithmetic, 2008. *) (* *) (* A large part of this formalization is based on John Harrison's work. *) (* ========================================================================== *) (* -------------------------------------------------------------------------- *) (* Floating point format *) (* -------------------------------------------------------------------------- *) (* Fix r:num > 1 and even, p:num > 1. A floating point number is a real *) (* number that can be written as *) (* *) (* +/- f * r^(e - p + 1) *) (* *) (* where *) (* *) (* -- e is an integer *) (* -- 0 < f < r^p (so zero is not a floating point number) *) (* *) (* Why is p > 1? If p = 0, the set of floating point numbers is empty. If *) (* p = 1, round to even is not possible for some scenarios. For example, take *) (* r = 4 and p = 1. If x lies half way between 3 * 4^(1 - p + 1) and *) (* 1 * 4^(2 - p + 1), there is no way to round to even, since both enclosing *) (* floating point numbers have odd fractions. *) (* *) (* Why is r > 1? If r = 0 or 1, the set of floating point numbers is *) (* empty (no f satisfies 0 < f < r^p for those r). *) (* *) (* r needs to be even for a couple reasons. *) (* *) (* #1: *) (* *) (* I should confess first: *) (* *) (* The formalization below of floating point round to nearest will *not* *) (* round to even *when r is odd*, and will in fact be biased to round toward *) (* zero. Rounding the remainder to even does not round the floating point *) (* number to even *when r is odd*. After looking at #2 and #3 below, you *) (* might see why. *) (* *) (* Goldberg claims we always assume r is even, so I took it at face value at *) (* first. Here are a couple more compelling reasons I came up with; there *) (* could be a more fundamental reason. *) (* *) (* #2: *) (* *) (* If r is odd, fixed point round to nearest would be biased to round toward *) (* zero. For example, take r = 2, p = 2, and e = 1; then e - p + 1 = 0, and *) (* the possible fixed point numbers are *) (* *) (* -2 * 1 -1 * 1 0 * 1 1 * 1 2 * 1 *) (* *) (* We are equally likely to round down as we are to round up, when we tie, *) (* and we are equally likely to round *away* from zero as we are to round *) (* toward zero. *) (* *) (* Now take r = 3, p = 2, and e = 1; then e - p + 1 = 0, and the possible *) (* fixed point numbers are *) (* *) (* -3 * 1 -2 * 1 -1 * 1 0 * 1 1 * 1 2 * 1 3 * 1 *) (* *) (* If we round to even, we are still equally likely to round down as we are *) (* to round up, when we tie; but on the positive side, we're more likely to *) (* round down, and on the negative side, we're more likely to round up. *) (* *) (* Notice that no matter how we try to break ties, the positive/negative side *) (* will be biased to round a certain direction. *) (* *) (* Floating point numbers aren't as badly biased when r is odd, but there is *) (* still some interesting patterns. For r = 4, p = 2, the set of possible *) (* normalized fractions is 4 - 15, and a section looks like: *) (* *) (* | | *) (* | | | | *) (* 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, (16=4^2) *) (* | | | | *) (* | | *) (* *) (* When we round to even for ties, we are equally likely to round up as we *) (* are to round down--but also, within each subsection, we are equally likely *) (* to round up as we are down (e.g., in the 4 - 8 interval, the rounding *) (* pattern is down-up-down-up). *) (* *) (* When r is odd, the pattern is more peculiar. For r = 3, p = 2, the set *) (* of possible normalized fractions is 3 - 8, and a section looks like: *) (* *) (* | | *) (* | | | *) (* 3, 4, 5, 6, 7, 8, (9=3^2) *) (* | | | *) (* | | *) (* *) (* When we round to even for ties, we are equally likely to round up as we *) (* are to round down--but in the (3 - 6) interval, the pattern is *) (* up-down-up, while in the (6 - 9) interval, the pattern is down-up-down. If *) (* we tried to use a consistent rounding pattern in each, then we would be *) (* biased to round a certain direction. *) (* *) (* #3: *) (* *) (* If we want the machine epsilon to be a floating point number, r needs to *) (* be even. The machine epsilon is *) (* *) (* (r / 2) * r^(-p) *) (* *) (* When r is even, r = 2k, so mach eps = k * r^(-p). This is a floating *) (* point number with f = k and e = -1 (and could also be normalized). *) (* *) (* When r is odd, the mach eps is not a floating number in that format. For *) (* example, take r = 3 and p = 2; then mach eps = 1/6, but 1/6 is half way *) (* between 4/27 and 5/27, the closest floating point numbers to it. *) let is_valid_flformat = define `is_valid_flformat (r:num, p:num) = (1 < r /\ (EVEN r) /\ (1 < p))`;; let flformat_typbij = new_type_definition "flformat" ("mk_flformat", "dest_flformat") (prove (`?(fmt:num#num). is_valid_flformat fmt`, EXISTS_TAC `(2:num, 2:num)` THEN REWRITE_TAC[is_valid_flformat] THEN ARITH_TAC));; let flr = define `flr (fmt:flformat) = (FST (dest_flformat fmt))`;; let flp = define `flp (fmt:flformat) = (SND (dest_flformat fmt))`;; let is_frac_and_exp = define `is_frac_and_exp (fmt:flformat) (x:real) (f:num) (e:int) = (0 < f /\ f < (flr fmt) EXP (flp fmt) /\ abs(x) = &f * &(flr fmt) ipow (e - &(flp fmt) + &1))`;; let is_float = define `is_float (fmt:flformat) (x:real) = (?(f:num) (e:int) . is_frac_and_exp(fmt) x f e)`;; let to_fformat = define `to_fformat (fmt:flformat) (e:int) = (mk_fformat ((flr fmt), (flp fmt), e))`;; (* -------------------------------------------------------------------------- *) (* Normalization *) (* -------------------------------------------------------------------------- *) (* x = +/- m * r^e + y *) let greatest_e = define `greatest_e (fmt:flformat) (x:real) = sup_int({ (z:int) | &(flr fmt) ipow z <= abs(x) })`;; let greatest_m = define `greatest_m (fmt:flformat) (x:real) = sup_num({ (m:num) | &m * &(flr fmt) ipow (greatest_e(fmt) x) <= abs(x) })`;; let greatest_r = define `greatest_r (fmt:flformat) (x:real) = (if (&0 <= x) then (x - &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)) else (x + &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)))`;; (* -------------------------------------------------------------------------- *) (* Rounding *) (* -------------------------------------------------------------------------- *) let flround = define `flround (fmt:flformat) (mode:roundmode) (x:real) = (let m = (greatest_m(fmt) x) and e = (greatest_e(fmt) x) and y = (greatest_r(fmt) x) in (if (&0 <= x) then (&m * &(flr fmt) ipow e + (fround(to_fformat fmt e) mode y)) else (-- (&m * &(flr fmt) ipow e) + (fround(to_fformat fmt e) mode y))))`;; (* -------------------------------------------------------------------------- *) (* Machine Epsilon *) (* -------------------------------------------------------------------------- *) (* Definition: For a flformat fmt, the _machine epsilon_ is *) (* *) (* fl_eps = r^(-p + 1) / 2 *) (* *) (* This is *a little bit more than* the worst possible relative error when *) (* rounding to nearest. *) let fl_eps = define `fl_eps (fmt:flformat) = (&(flr fmt) ipow (&1 - &(flp fmt))) / &2`;; hol-light/IEEE/float_thms.hl000066400000000000000000010024741303454263000161510ustar00rootroot00000000000000(* ========================================================================== *) (* FLOATING POINT THEOREMS *) (* ========================================================================== *) (* needs "IEEE/common.hl";; *) (* needs "IEEE/fixed_thms.hl";; *) (* needs "IEEE/fixed.hl";; *) (* needs "IEEE/float.hl";; *) (* -------------------------------------------------------------------------- *) (* Valid flformat properties *) (* -------------------------------------------------------------------------- *) let FLFORMAT_SPLIT = TAUT `!(fmt:flformat). (dest_flformat fmt) = (FST (dest_flformat fmt), SND (dest_flformat fmt))`;; let FLFORMAT_VALID_IMP_RADIX_LT_1 = prove(`!(r:num) (p:num). ((is_valid_flformat (r,p)) ==> 1 < (FST (r,p)))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_flformat] THEN ARITH_TAC);; let FLFORMAT_VALID_IMP_RADIX_EVEN = prove(`!(r:num) (p:num). ((is_valid_flformat (r,p)) ==> EVEN (FST (r,p)))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_flformat] THEN MESON_TAC[]);; let FLFORMAT_VALID_IMP_PREC_LT_1 = prove(`!(r:num) (p:num). ((is_valid_flformat (r,p)) ==> 1 < (SND (r,p)))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_flformat] THEN MESON_TAC[]);; let FLFORMAT_VALID = prove(`!(fmt:flformat). is_valid_flformat (dest_flformat fmt)`, REWRITE_TAC[flformat_typbij]);; let FLFORMAT_RADIX_LT_1 = prove(`!(fmt:flformat). 1 < (flr fmt)`, GEN_TAC THEN REWRITE_TAC[flr] THEN ONCE_REWRITE_TAC[FLFORMAT_SPLIT] THEN MATCH_MP_TAC FLFORMAT_VALID_IMP_RADIX_LT_1 THEN REWRITE_TAC[FLFORMAT_VALID]);; let FLFORMAT_RADIX_LT_0 = prove(`!(fmt:flformat). 0 < (flr fmt)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 0 < x`) THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1]);; let FLFORMAT_RADIX_NE_0 = prove(`!(fmt:flformat). ~(&(flr fmt) = &0)`, GEN_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC (ARITH_RULE `0 < x ==> ~(x = 0)`) THEN REWRITE_TAC[FLFORMAT_RADIX_LT_0]);; let FLFORMAT_RADIX_EVEN = prove(`!(fmt:flformat). EVEN (flr fmt)`, GEN_TAC THEN REWRITE_TAC[flr] THEN ONCE_REWRITE_TAC[FLFORMAT_SPLIT] THEN MATCH_MP_TAC FLFORMAT_VALID_IMP_RADIX_EVEN THEN REWRITE_TAC[FLFORMAT_VALID]);; let FLFORMAT_RADIX_LE_2 = prove(`!(fmt:flformat). 2 <= (flr fmt)`, GEN_TAC THEN SUBGOAL_THEN `!x. ~(x = 0) /\ EVEN x ==> 2 <= x` MATCH_MP_TAC THENL [ GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "evenx"]) THEN ASM_CASES_TAC `x = 0` THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `x = 1` THENL [ USE_THEN "evenx" (fun evenx -> ASSUME_TAC (REWRITE_RULE[ASSUME `x = 1`] evenx)) THEN ASSUME_TAC (REWRITE_RULE[GSYM NOT_EVEN] (ARITH_RULE `ODD 1`)) THEN ASM_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[REWRITE_RULE[REAL_OF_NUM_EQ] FLFORMAT_RADIX_NE_0] THEN REWRITE_TAC[FLFORMAT_RADIX_EVEN]);; let FLFORMAT_PREC_LT_1 = prove(`!(fmt:flformat). 1 < (flp fmt)`, GEN_TAC THEN REWRITE_TAC[flp] THEN ONCE_REWRITE_TAC[FLFORMAT_SPLIT] THEN MATCH_MP_TAC FLFORMAT_VALID_IMP_PREC_LT_1 THEN REWRITE_TAC[FLFORMAT_VALID]);; let FLFORMAT_PREC_LT_0 = prove(`!(fmt:flformat). 0 < (flp fmt)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 0 < x`) THEN REWRITE_TAC[FLFORMAT_PREC_LT_1]);; let FLFORMAT_PREC_MINUS_1 = prove(`!(fmt:flformat). &0 <= (&(flp fmt):int) - (&1:int)`, REWRITE_TAC[ARITH_RULE `&0 <= x:int - &1:int <=> &1 <= x`] THEN REWRITE_TAC[INT_OF_NUM_LE] THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> 0 < n`] THEN REWRITE_TAC[FLFORMAT_PREC_LT_0]);; let FLFORMAT_PREC_IPOW_EQ_EXP = prove(`!(fmt:flformat). &(flr fmt) ipow (&(flp fmt) - &1) = &((flr fmt) EXP ((flp fmt) - 1))`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_EQ_EXP_P THEN REWRITE_TAC[FLFORMAT_PREC_LT_0]);; let FLFORMAT_PREC_EXP_EQ_IPOW = prove(`!(fmt:flformat) (n:num). &((flr fmt) EXP n) = &(flr fmt) ipow (&n)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[ipow] THEN SUBGOAL_THEN `(&0:int) <= (&n)` (fun thm -> REWRITE_TAC[thm]) THENL [ REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM]);; let FLFORMAT_RADIX_IPOW_LE_0 = prove(`!(fmt:flformat) (e:int). &0 <= &(flr fmt) ipow e`, REPEAT GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> &0 <= x`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_0]);; let FLFORMAT_RADIX_IPOW_LT_0 = prove(`!(fmt:flformat) (e:int). &0 < &(flr fmt) ipow e`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_0]);; let FLFORMAT_RADIX_IPOW_NEQ_0 = prove(`!(fmt:flformat) (e:int). ~(&(flr fmt) ipow e = &0)`, REPEAT GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> ~(x = &0)`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_0]);; let FLFORMAT_RADIX_IPOW_ADD_EXP = prove(`!(fmt:flformat) (u:int) (v:int). &(flr fmt) ipow u * &(flr fmt) ipow v = &(flr fmt) ipow (u + v)`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_ADD_EXP THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]);; let FLFORMAT_TO_FFORMAT = prove(`!(fmt:flformat) (e:int). ?(fmt':fformat). (to_fformat fmt e) = fmt' /\ (fr fmt') = (flr fmt) /\ (fp fmt') = (flp fmt) /\ (fe fmt') = e`, REPEAT GEN_TAC THEN EXISTS_TAC `mk_fformat ((flr fmt), (flp fmt), e)` THEN REWRITE_TAC[to_fformat] THEN REWRITE_TAC[fr;fp;fe] THEN SUBGOAL_THEN `is_valid_fformat ((flr fmt), (flp fmt), e)` (LABEL_TAC "valid") THENL [ REWRITE_TAC[is_valid_fformat] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1] THEN REWRITE_TAC[FLFORMAT_RADIX_EVEN] THEN REWRITE_TAC[FLFORMAT_PREC_LT_0]; ALL_TAC] THEN USE_THEN "valid" (fun valid -> REWRITE_TAC[REWRITE_RULE[fformat_typbij] valid]));; (* a saner version *) let FLFORMAT_TO_FFORMAT_2 = prove(`!(fmt:flformat) (e:int). (fr (to_fformat fmt e)) = (flr fmt) /\ (fp (to_fformat fmt e)) = (flp fmt) /\ (fe (to_fformat fmt e)) = e`, REPEAT GEN_TAC THEN REWRITE_TAC[to_fformat] THEN SUBGOAL_THEN `is_valid_fformat (flr fmt, flp fmt, (e:int))` (fun thm -> ASSUME_TAC (REWRITE_RULE[fformat_typbij] thm)) THENL [ REWRITE_TAC[is_valid_fformat] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1] THEN REWRITE_TAC[FLFORMAT_RADIX_EVEN] THEN REWRITE_TAC[FLFORMAT_PREC_LT_0]; ALL_TAC] THEN REWRITE_TAC[fr; fp; fe] THEN ASM_REWRITE_TAC[]);; (* -------------------------------------------------------------------------- *) (* Useful ipow/exp properties, translated over to floating point *) (* -------------------------------------------------------------------------- *) let FLOAT_IPOW_LE_REAL = prove(`!(fmt:flformat) (z:real). ?(e:int). z <= &(flr fmt) ipow e`, GEN_TAC THEN REWRITE_TAC[MATCH_MP IPOW_LE_REAL (SPEC `fmt:flformat`FLFORMAT_RADIX_LE_2)]);; let FLOAT_IPOW_LE_REAL_2 = prove(`!(fmt:flformat) (z:real). &0 < z ==> ?(e:int). &(flr fmt) ipow e <= z`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> REWRITE_TAC[MATCH_MP IPOW_LE_REAL_2 (CONJ thm (SPEC `fmt:flformat`FLFORMAT_RADIX_LE_2))]));; (* -------------------------------------------------------------------------- *) (* Various float props *) (* -------------------------------------------------------------------------- *) let dump_float_defn isfloat = LABEL_TAC "isfloat" isfloat THEN CHOOSE_THEN (CHOOSE_THEN (LABEL_TAC "isfracexp")) (REWRITE_RULE[is_float] isfloat) THEN USE_THEN "isfracexp" (fun isfracexp -> LABEL_CONJUNCTS_TAC ["fgt0"; "fltrp"; "absxeq"] (REWRITE_RULE[is_frac_and_exp] isfracexp));; let FLOAT_NEG = prove(`!(fmt:flformat) (x:real). is_float(fmt) x <=> is_float(fmt) (-- x)`, REPEAT GEN_TAC THEN REWRITE_TAC[is_float] THEN REWRITE_TAC[is_frac_and_exp] THEN REWRITE_TAC[ARITH_RULE `abs(-- x) = abs(x)`] );; let FLOAT_NOT_ZERO = prove(`!(fmt:flformat) (x:real). is_float(fmt) x ==> ~(x = &0)`, REPEAT GEN_TAC THEN DISCH_THEN dump_float_defn THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_ZERO] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:real) = y /\ ~(y = &0) ==> ~(x = &0)`) THEN EXISTS_TAC `&f * &(flr fmt) ipow (e - &(flp fmt) + &1)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ENTIRE] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; MATCH_MP_TAC (ARITH_RULE `&0 < x ==> ~(x = &0)`) THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]);; (* -------------------------------------------------------------------------- *) (* greatest_e, greatest_m, greatest_r *) (* -------------------------------------------------------------------------- *) let is_greatest_e = define `is_greatest_e (fmt:flformat) (x:real) (e:int) = (&(flr fmt) ipow e <= abs(x) /\ !(e':int). &(flr fmt) ipow e' <= abs(x) ==> e' <= e)`;; let FLOAT_GREATEST_E_EXISTS = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> ?(e:int). greatest_e(fmt) x = e /\ is_greatest_e(fmt) x e`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN SUBGOAL_THEN `~({ e:int | &(flr fmt) ipow e <= abs(x) } = {})` (LABEL_TAC "neqempty") THENL [ REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[MATCH_MP FLOAT_IPOW_LE_REAL_2 (MATCH_MP (ARITH_RULE `~((x:real) = &0) ==> &0 < abs(x)`) xneq0)]); ALL_TAC] THEN SUBGOAL_THEN `?(b:int). !(e:int). e IN { e:int | &(flr fmt) ipow e <= abs(x) } ==> e <= b` (CHOOSE_THEN (LABEL_TAC "bound")) THENL [ CHOOSE_TAC (SPECL [`fmt:flformat`; `abs((x:real))`] FLOAT_IPOW_LE_REAL) THEN EXISTS_TAC `e:int` THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC IPOW_MONOTONE THEN EXISTS_TAC `(flr fmt)` THEN REWRITE_TAC[FLFORMAT_RADIX_LE_2] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "neqempty" (fun neqempty -> USE_THEN "bound" (fun bound -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["supint"; "issupint"]) (MATCH_MP SUP_INT_BOUNDED (CONJ neqempty bound)))) THEN EXISTS_TAC `e':int` THEN REWRITE_TAC[greatest_e; is_greatest_e] THEN ASM_REWRITE_TAC[] THEN USE_THEN "issupint" (fun issupint -> (LABEL_CONJUNCTS_TAC ["inset"; "biggest"]) (REWRITE_RULE[is_sup_int] issupint)) THEN CONJ_TAC THENL [ USE_THEN "inset" (fun inset -> REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] inset]); USE_THEN "biggest" (fun biggest -> REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] biggest])]);; let dump_ge_info xneq0 lbl = let concat s = String.concat "" [lbl; s] in CHOOSE_THEN (LABEL_CONJUNCTS_TAC [concat "geeq"; concat "gebig"]) (MATCH_MP (SPEC `fmt:flformat` FLOAT_GREATEST_E_EXISTS) xneq0) THEN USE_THEN (concat "gebig") (fun gebig -> LABEL_CONJUNCTS_TAC [concat "gebig1"; concat "gebig2"] (REWRITE_RULE[is_greatest_e] gebig));; let dump_fl_ge_info isfloat lbl = dump_ge_info (MATCH_MP (SPEC `fmt:flformat` FLOAT_NOT_ZERO) isfloat) lbl;; let FLOAT_GREATEST_E_UNIQUE = prove(`!(fmt:flformat) (x:real) (e1:int) (e2:int). is_greatest_e(fmt) x e1 /\ is_greatest_e(fmt) x e2 ==> e1 = e2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["e1ge"; "e2ge"]) THEN USE_THEN "e1ge" (fun e1ge -> LABEL_CONJUNCTS_TAC ["e1leqx"; "e1big"] (REWRITE_RULE[is_greatest_e] e1ge)) THEN USE_THEN "e2ge" (fun e2ge -> LABEL_CONJUNCTS_TAC ["e2leqx"; "e2big"] (REWRITE_RULE[is_greatest_e] e2ge)) THEN SUBGOAL_THEN `(e1:int) <= e2` ASSUME_TAC THENL [ USE_THEN "e2big" (fun e2big -> MATCH_MP_TAC e2big) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(e2:int) <= e1` ASSUME_TAC THENL [ USE_THEN "e1big" (fun e1big -> MATCH_MP_TAC e1big) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC);; let FLOAT_GREATEST_E_NEG = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> greatest_e(fmt) (-- x) = greatest_e(fmt) x`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN MATCH_MP_TAC FLOAT_GREATEST_E_UNIQUE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `-- x` THEN SUBGOAL_THEN `~(-- x = &0)` (LABEL_TAC "negxneq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "negxneq0" (fun negxneq0 -> dump_ge_info negxneq0 "negx") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_greatest_e] THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `abs(-- x) = abs(x)`] THEN ASM_REWRITE_TAC[]);; let is_greatest_m = define `is_greatest_m (fmt:flformat) (x:real) (m:num) = (&m * &(flr fmt) ipow (greatest_e(fmt) x) <= abs(x) /\ !(m':num). &m' * &(flr fmt) ipow (greatest_e(fmt) x) <= abs(x) ==> m' <= m)`;; let FLOAT_GREATEST_M_EXISTS = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> ?(m:num). greatest_m(fmt) x = m /\ is_greatest_m(fmt) x m /\ 1 <= m /\ m < (flr fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN SUBGOAL_THEN `1 IN { (m:num) | &m * &(flr fmt) ipow (greatest_e(fmt) x) <= abs(x) }` (LABEL_TAC "oneins") THENL [ REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[ARITH_RULE `&1 * (x:real) = x`] THEN USE_THEN "xneq0" (fun xneq0 -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["geeq"; "isge"]) (SPEC `fmt:flformat` (MATCH_MP FLOAT_GREATEST_E_EXISTS xneq0))) THEN ASM_REWRITE_TAC[] THEN USE_THEN "isge" (fun isge -> REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[is_greatest_e] isge)]); ALL_TAC] THEN SUBGOAL_THEN `~({ (m:num) | &m * &(flr fmt) ipow (greatest_e(fmt) x) <= abs(x) } = {})` (LABEL_TAC "neqempty") THENL [ REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `1:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!(m:num). m IN { (m:num) | &m * &(flr fmt) ipow (greatest_e(fmt) x) <= abs(x) } ==> m < (flr fmt)` (LABEL_TAC "bound") THENL [ GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "xneq0" (fun xneq0 -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["geeq"; "isge"]) (SPEC `fmt:flformat` (MATCH_MP FLOAT_GREATEST_E_EXISTS xneq0))) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `m < (flr fmt)` THENL [ ASM_ARITH_TAC; SUBGOAL_THEN `?k. m = (flr fmt) + k` CHOOSE_TAC THENL [ EXISTS_TAC `m - (flr fmt)` THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `&(flr fmt) ipow (e + &1) <= abs(x)` (LABEL_TAC "eplus1") THENL [ REWRITE_TAC[GSYM(MATCH_MP IPOW_ADD_EXP (SPEC `fmt:flformat`FLFORMAT_RADIX_NE_0))] THEN REWRITE_TAC[IPOW_TO_1] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:real) * b = b * a`] THEN ASSUME_TAC (REWRITE_RULE[ARITH_RULE `((a:real) + b) * c = a * c + b * c`] (REWRITE_RULE[GSYM REAL_OF_NUM_ADD] (ASSUME `&(flr fmt + k) * &(flr fmt) ipow e <= abs x`))) THEN MATCH_MP_TAC (ARITH_RULE `!z. &0 <= z /\ (a:real) + z <= b ==> a <= b`) THEN EXISTS_TAC `&k * &(flr fmt) ipow e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN USE_THEN "eplus1" (fun eplus1 -> USE_THEN "isge" (fun isge -> LABEL_TAC "eplus1leqe" (MATCH_MP (CONJUNCT2 ( REWRITE_RULE[is_greatest_e] isge)) eplus1))) THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!(m:num). m IN { (m:num) | &m * &(flr fmt) ipow (greatest_e(fmt) x) <= abs(x) } ==> m <= (flr fmt)` (LABEL_TAC "bound2") THENL [ GEN_TAC THEN DISCH_THEN (fun thm -> USE_THEN "bound" (fun bound -> ASSUME_TAC (MATCH_MP bound thm))) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "neqempty" (fun neqempty -> USE_THEN "bound2" (fun bound2 -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["supnum"; "issupnum"]) (MATCH_MP SUP_NUM_BOUNDED (CONJ neqempty bound2)))) THEN EXISTS_TAC `n':num` THEN REWRITE_TAC[greatest_m; is_greatest_m] THEN ASM_REWRITE_TAC[] THEN USE_THEN "issupnum" (fun issupnum -> (LABEL_CONJUNCTS_TAC ["inset"; "biggest"]) (REWRITE_RULE[is_sup_num] issupnum)) THEN CONJ_TAC THENL [ CONJ_TAC THENL [ USE_THEN "inset" (fun inset -> REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] inset]); USE_THEN "biggest" (fun biggest -> REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] biggest])]; CONJ_TAC THENL [ USE_THEN "oneins" (fun oneins -> USE_THEN "biggest" (fun biggest -> REWRITE_TAC[MATCH_MP biggest oneins])); USE_THEN "bound" (fun bound -> USE_THEN "inset" (fun inset -> REWRITE_TAC[MATCH_MP bound inset]))]]);; let dump_gm_info xneq0 lbl = let concat s = String.concat "" [lbl; s] in CHOOSE_THEN (LABEL_CONJUNCTS_TAC [concat "gmeq"; concat "gmbig"; concat "gmgeq1"; concat "gmltr"]) (MATCH_MP (SPEC `fmt:flformat` FLOAT_GREATEST_M_EXISTS) xneq0) THEN USE_THEN (concat "gmbig") (fun gmbig -> LABEL_CONJUNCTS_TAC [concat "gmbig1"; concat "gmbig2"] (REWRITE_RULE[is_greatest_m] gmbig));; let dump_fl_gm_info isfloat lbl = dump_gm_info (MATCH_MP (SPEC `fmt:flformat` FLOAT_NOT_ZERO) isfloat) lbl;; let FLOAT_GREATEST_M_UNIQUE = prove(`!(fmt:flformat) (x:real) (m1:num) (m2:num). is_greatest_m(fmt) x m1 /\ is_greatest_m(fmt) x m2 ==> m1 = m2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["m1ge"; "m2ge"]) THEN USE_THEN "m1ge" (fun m1ge -> LABEL_CONJUNCTS_TAC ["m1leqx"; "m1big"] (REWRITE_RULE[is_greatest_m] m1ge)) THEN USE_THEN "m2ge" (fun m2ge -> LABEL_CONJUNCTS_TAC ["m2leqx"; "m2big"] (REWRITE_RULE[is_greatest_m] m2ge)) THEN SUBGOAL_THEN `(m1:num) <= m2` ASSUME_TAC THENL [ USE_THEN "m2big" (fun m2big -> MATCH_MP_TAC m2big) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(m2:num) <= m1` ASSUME_TAC THENL [ USE_THEN "m1big" (fun m1big -> MATCH_MP_TAC m1big) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC);; let FLOAT_GREATEST_M_NEG = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> greatest_m(fmt) (-- x) = greatest_m(fmt) x`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN MATCH_MP_TAC FLOAT_GREATEST_M_UNIQUE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `-- x` THEN SUBGOAL_THEN `~(-- x = &0)` (LABEL_TAC "negxneq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "negxneq0" (fun negxneq0 -> dump_gm_info negxneq0 "negx") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_greatest_m] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[MATCH_MP FLOAT_GREATEST_E_NEG xneq0]) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `abs(-- x) = abs(x)`] THEN ASM_REWRITE_TAC[]);; let old_dump_ge_gm_info xneq0 = CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["geeq"; "isge"]) (SPEC `fmt:flformat` (MATCH_MP FLOAT_GREATEST_E_EXISTS xneq0)) THEN REMOVE_THEN "isge" (fun isge -> LABEL_CONJUNCTS_TAC ["geleqx"; "gebig"] (REWRITE_RULE[is_greatest_e] isge)) THEN CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["gmeq"; "isgm"; "gmgeq1"; "gmltr"]) (SPEC `fmt:flformat` (MATCH_MP FLOAT_GREATEST_M_EXISTS xneq0)) THEN REMOVE_THEN "isgm" (fun isgm -> LABEL_CONJUNCTS_TAC ["gmleqx2"; "gmbig2"] (REWRITE_RULE[is_greatest_m] isgm)) THEN REMOVE_THEN "gmleqx2" (fun gmleqx2 -> USE_THEN "geeq" (fun geeq -> LABEL_TAC "gmleqx" (REWRITE_RULE[geeq] gmleqx2))) THEN REMOVE_THEN "gmbig2" (fun gmbig2 -> USE_THEN "geeq" (fun geeq -> LABEL_TAC "gmbig" (REWRITE_RULE[geeq] gmbig2)));; let dump_flformat_conv expterm = CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["fmteq"; "fmteqr"; "fmteqp"; "fmteqe"]) (SPECL [`fmt:flformat`; expterm] FLFORMAT_TO_FFORMAT);; let FLOAT_GREATEST_R_EXISTS = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> ?(y:real). greatest_r(fmt) x = y /\ abs(y) < (finf (to_fformat fmt (greatest_e(fmt) x)))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN USE_THEN "xneq0" (fun xneq0 -> old_dump_ge_gm_info xneq0) THEN ASM_REWRITE_TAC[] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[greatest_r] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ (* 0 <= x *) ASM_REWRITE_TAC[] THEN EXISTS_TAC `x - &m * &(flr fmt) ipow e` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `abs(x - &m * &(flr fmt) ipow e) = x - &m * &(flr fmt) ipow e` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[finf] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) - y < z <=> x < y + z`] THEN USE_THEN "gmbig" (fun gmbig -> LABEL_TAC "mplus1" (MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] gmbig) (ARITH_RULE `~(m + 1 <= m)`))) THEN REWRITE_TAC[ARITH_RULE `(a:real) * b + b = (a + &1) * b`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; (* x < 0 *) ASM_REWRITE_TAC[] THEN EXISTS_TAC `x + &m * &(flr fmt) ipow e` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `abs(x + &m * &(flr fmt) ipow e) = -- x - &m * &(flr fmt) ipow e` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[finf] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) - y < z <=> x < y + z`] THEN USE_THEN "gmbig" (fun gmbig -> LABEL_TAC "mplus1" (MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] gmbig) (ARITH_RULE `~(m + 1 <= m)`))) THEN REWRITE_TAC[ARITH_RULE `(a:real) * b + b = (a + &1) * b`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]);; let FLOAT_GREATEST_R_NEG = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> greatest_r(fmt) (-- x) = -- greatest_r(fmt) x`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[greatest_r] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[MATCH_MP FLOAT_GREATEST_E_NEG xneq0] THEN REWRITE_TAC[MATCH_MP FLOAT_GREATEST_M_NEG xneq0]) THEN COND_CASES_TAC THENL [ ASM_ARITH_TAC; ASM_ARITH_TAC]);; let dump_gr_info xneq0 lbl = let concat s = String.concat "" [lbl; s] in CHOOSE_THEN (LABEL_CONJUNCTS_TAC [concat "greq"; concat "grleq"]) (SPEC `fmt:flformat` (MATCH_MP FLOAT_GREATEST_R_EXISTS xneq0));; let dump_fl_gr_info isfloat lbl = dump_gr_info (MATCH_MP (SPEC `fmt:flformat` FLOAT_NOT_ZERO) isfloat) lbl;; let FLOAT_GREATEST_R_LE_0 = prove(`!(fmt:flformat) (x:real). ~(x = &0) /\ &0 <= x ==> &0 <= greatest_r(fmt) x`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "xgeq0"]) THEN REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `&0 <= (z:real) - w <=> w <= z`] THEN USE_THEN "xgeq0" (fun xgeq0 -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) xgeq0]) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[]);; let FLOAT_GREATEST_R_LE_0_2 = prove(`!(fmt:flformat) (x:real). ~(x = &0) /\ ~(&0 <= x) ==> greatest_r(fmt) x <= &0`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "xgeq0"]) THEN REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((z:real) + w <= &0) <=> (w <= -- z)`] THEN USE_THEN "xgeq0" (fun xgeq0 -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (ARITH_RULE `~(&0 <= (x:real)) ==> -- x = abs(x)`) xgeq0]) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[]);; let old_dump_ge_gm_gr_info xneq0 = old_dump_ge_gm_info xneq0 THEN CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["greq"; "grleq2"]) (SPEC `fmt:flformat` (MATCH_MP FLOAT_GREATEST_R_EXISTS xneq0)) THEN USE_THEN "geeq" (fun geeq -> dump_flformat_conv (rand (concl geeq))) THEN REMOVE_THEN "grleq2" (fun grleq2 -> USE_THEN "fmteq" (fun fmteq -> USE_THEN "geeq" (fun geeq -> LABEL_TAC "grleq" (REWRITE_RULE[fmteq] (REWRITE_RULE[geeq] grleq2)))));; let FLOAT_NORMALIZE_REAL = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (if (&0 <= x) then x = &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + (greatest_r(fmt) x) else x = -- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)) + (greatest_r(fmt) x))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN USE_THEN "xneq0" (fun xneq0 -> old_dump_ge_gm_gr_info xneq0) THEN REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; let FLOAT_NORM_FRAC = prove(`!(fmt:flformat) (x:real). is_float(fmt) x ==> ?(f:num) (e:int). (flr fmt) EXP ((flp fmt) - 1) <= f /\ is_frac_and_exp(fmt) x f e`, REPEAT GEN_TAC THEN DISCH_THEN dump_float_defn THEN SUBGOAL_THEN `?n. (flr fmt) EXP ((flp fmt) - 1) <= f * (flr fmt) EXP n` (LABEL_TAC "nexist") THENL [ EXISTS_TAC `(flp fmt) - 1` THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `n:num = n * 1`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(n:num) * m = m * n`] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "nexist" (fun nexist -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["expn"; "nsmall"]) (MATCH_MP (REWRITE_RULE[WF] WF_num) nexist)) THEN EXISTS_TAC `f * (flr fmt) EXP n` THEN EXISTS_TAC `(e:int) - &n` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXP_LT_0] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; CONJ_TAC THENL [ DISJ_CASES_TAC (SPEC `n:num` num_CASES) THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXP] THEN ASM_ARITH_TAC; CHOOSE_THEN (LABEL_TAC "neqnp") (ASSUME `?n'. n = SUC n'`) THEN CHOOSE_THEN (LABEL_TAC "peqpp") (MATCH_MP (REWRITE_RULE[TAUT `a \/ b <=> ~a ==> b`] num_CASES) (MATCH_MP (ARITH_RULE `0 < a ==> ~(a = 0)`) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXP] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a:num) * b * c = b * (a * c)`] THEN REWRITE_TAC[LT_MULT_LCANCEL] THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; SUBGOAL_THEN `n'' = (flp fmt) - 1` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(n':num) < n` (LABEL_TAC "npltn") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(a:num) < b <=> ~(b <= a)`] THEN USE_THEN "npltn" (fun npltn -> USE_THEN "nsmall" (fun nsmall -> REWRITE_TAC[MATCH_MP nsmall npltn]))]]; (* cancel the common factor ... *) REWRITE_TAC[ARITH_RULE `(e:int) - &n - &(flp fmt) + &1 = (-- &n) + (e - &(flp fmt) + &1)`] THEN ONCE_REWRITE_TAC[GSYM(MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0))] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (SPEC `&(flr fmt)` IPOW_INV_NEG) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `-- -- (&n:int) = &n`] THEN SUBGOAL_THEN `&(flr fmt) ipow &n = &((flr fmt) EXP n)` (fun thm -> REWRITE_TAC[thm]) THENL [ SUBGOAL_THEN `&0 <= (&n:int)` (fun thm -> CHOOSE_THEN ASSUME_TAC (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP) thm)) THENL [ ARITH_TAC; ALL_TAC ] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NUM_OF_INT_OF_NUM]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN SUBGOAL_THEN `(&((flr fmt) EXP n)) * inv (&((flr fmt) EXP n)) = &1` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN REWRITE_TAC[EXP_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `((x:real) * y) * inv y * z = (y * inv y) * x * z`] THEN ASM_REWRITE_TAC[] THEN ARITH_TAC]]);; let FLOAT_NORM_M = prove(`!(fmt:flformat) (x:real). is_float(fmt) x ==> (?(m:num) (e:int) (f':num). f' < (flr fmt) EXP ((flp fmt) - 1) /\ 1 <= m /\ m < (flr fmt) /\ abs(x) = &(m * (flr fmt) EXP ((flp fmt) - 1) + f') * &(flr fmt) ipow (e - &(flp fmt) + &1))`, REPEAT GEN_TAC THEN DISCH_THEN (fun thm -> CHOOSE_THEN (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["flow"; "isfracexp"])) (MATCH_MP FLOAT_NORM_FRAC thm)) THEN REMOVE_THEN "isfracexp" (fun isfracexp -> LABEL_CONJUNCTS_TAC ["fpos"; "fleqrp"; "absxeq"] (REWRITE_RULE[is_frac_and_exp] isfracexp)) THEN SUBGOAL_THEN `?(m:num) (f':num). f = m * ((flr fmt) EXP ((flp fmt) - 1)) + f' /\ f' < (flr fmt) EXP ((flp fmt) - 1)` (CHOOSE_THEN (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["feqmfp"; "fpleq"]))) THENL [ MATCH_MP_TAC DIVMOD_EXIST THEN REWRITE_TAC[EXP_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN EXISTS_TAC `m:num` THEN EXISTS_TAC `e:int` THEN EXISTS_TAC `f':num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ MATCH_MP_TAC NUM_LE_MUL_1 THEN EXISTS_TAC `(flr fmt) EXP ((flp fmt) - 1)` THEN REWRITE_TAC[ARITH_RULE `1 <= b <=> 0 < b`] THEN MATCH_MP_TAC (ARITH_RULE `!b. (a:num) < b /\ b <= c ==> a < c`) THEN EXISTS_TAC `(flr fmt) EXP ((flp fmt) - 1) - f'` THEN ASM_ARITH_TAC; MATCH_MP_TAC (ARITH_RULE `!(a:num). x < (y:num) /\ ~(a = 0) ==> x < y`) THEN EXISTS_TAC `(flr fmt) EXP ((flp fmt) - 1)` THEN REWRITE_TAC[GSYM LT_MULT_RCANCEL] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM EXP] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < n ==> SUC (n - 1) = n`) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0)] THEN ASM_ARITH_TAC]);; let FLOAT_NORM_GREATEST = prove(`!(fmt:flformat) (x:real). is_float(fmt) x ==> (?(f':num). f' < (flr fmt) EXP ((flp fmt) - 1) /\ abs(x) = &((greatest_m(fmt) x) * ((flr fmt) EXP ((flp fmt) - 1)) + f') * &(flr fmt) ipow ((greatest_e(fmt) x) - &(flp fmt) + &1))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "isfloat") THEN USE_THEN "isfloat" (fun isfloat -> CHOOSE_THEN (CHOOSE_THEN (CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["fpleqrp"; "mgeq1"; "mltr"; "absxeq"]))) (MATCH_MP FLOAT_NORM_M isfloat)) THEN EXISTS_TAC `f':num` THEN ASM_REWRITE_TAC[] THEN USE_THEN "isfloat" (fun isfloat -> LABEL_TAC "xneq0" (MATCH_MP FLOAT_NOT_ZERO isfloat)) THEN USE_THEN "xneq0" (fun xneq0 -> old_dump_ge_gm_info xneq0) THEN SUBGOAL_THEN `&(flr fmt) ipow e <= abs(x)` (LABEL_TAC "eleqabs") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(x:real) = &1 * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(m * flr fmt EXP (flp fmt - 1) + f') * &(flr fmt) ipow (e - &(flp fmt) + &1)` THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC (ARITH_RULE `(a:real) = b /\ &0 <= (c:real) ==> a <= b + c`) THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP IPOW_ADD_EXP (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(x:int) - &1 + e - x + &1 = e`]; MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]]; ASM_ARITH_TAC]]; ALL_TAC] THEN USE_THEN "eleqabs" (fun eleqabs -> USE_THEN "gebig" (fun gebig -> DISJ_CASES_TAC (MATCH_MP (ARITH_RULE `(e:int) <= b ==> e = b \/ e < b`) (MATCH_MP gebig eleqabs)))) THENL [ (* e = e' *) SUBGOAL_THEN `&m * &(flr fmt) ipow e' <= abs(x)` (LABEL_TAC "mleqabs") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(m * flr fmt EXP (flp fmt - 1) + f') * &(flr fmt) ipow (e - &(flp fmt) + &1)` THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC (ARITH_RULE `(a:real) = b /\ &0 <= (c:real) ==> a <= b + c`) THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP IPOW_ADD_EXP (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(x:int) - &1 + e - x + &1 = e`] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]]; ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "mleqabs" (fun mleqabs -> USE_THEN "gmbig" (fun gmbig -> DISJ_CASES_TAC (MATCH_MP (ARITH_RULE `(e:num) <= b ==> e = b \/ e < b`) (MATCH_MP gmbig mleqabs)))) THENL [ (* m = m' *) ASM_REWRITE_TAC[]; (* m < m' *) SUBGOAL_THEN `&(m + 1) * &(flr fmt) ipow e' <= abs(x)` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&m' * &(flr fmt) ipow e'` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs(x) < &(m + 1) * &(flr fmt) ipow e'` ASSUME_TAC THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC (ARITH_RULE `(a:real) < b /\ c = d ==> c + a < d + b`) THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!b. (a:real) < b /\ b = c ==> a < c`) THEN EXISTS_TAC `&((flr fmt) EXP ((flp fmt) - 1)) * &(flr fmt) ipow (e' - &(flp fmt) + &1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_RMUL THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0] THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e' - e + &1 = e'`] THEN ARITH_TAC]; REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e' - e + &1 = e'`]]; ALL_TAC] THEN ASM_ARITH_TAC]; (* e < e' *) SUBGOAL_THEN `&(flr fmt) ipow (e + &1) <= abs(x)` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(flr fmt) ipow e'` THEN CONJ_TAC THENL [ MATCH_MP_TAC IPOW_MONOTONE_2 THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 1 <= x`) THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1]; ASM_ARITH_TAC]; ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `abs(x) < &(flr fmt) ipow (e + &1)` ASSUME_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!b. (a:real) < b /\ b <= d ==> a < d`) THEN EXISTS_TAC `&(m + 1) * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC (ARITH_RULE `(a:real) < b /\ c = d ==> c + a < d + b`) THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!b. (a:real) < b /\ b = c ==> a < c`) THEN EXISTS_TAC `&((flr fmt) EXP ((flp fmt) - 1)) * &(flr fmt) ipow (e - &(flp fmt) + &1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_RMUL THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0] THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e' - e + &1 = e'`] THEN ARITH_TAC]; REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e' - e + &1 = e'`]]; REWRITE_TAC[GSYM (MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0))] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(a:real) * b = b * a`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN REWRITE_TAC[IPOW_TO_1] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; ALL_TAC] THEN ASM_ARITH_TAC]);; let FLOAT_NORMALIZE_FLOAT = prove(`!(fmt:flformat) (x:real). is_float(fmt) x ==> is_fixed(to_fformat fmt (greatest_e(fmt) x)) (greatest_r(fmt) x) /\ (if (&0 <= x) then x = &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + (greatest_r(fmt) x) else x = -- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)) + (greatest_r(fmt) x))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "isfloat") THEN CONJ_TAC THENL [ USE_THEN "isfloat" (fun isfloat -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["fltrp"; "absxeq"]) (MATCH_MP FLOAT_NORM_GREATEST isfloat)) THEN dump_flformat_conv `greatest_e(fmt) x` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `x - &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x = &f' * &(flr fmt) ipow (greatest_e fmt x - &(flp fmt) + &1)` (fun thm -> REWRITE_TAC[thm]) THENL [ SUBGOAL_THEN `x = abs(x)` (fun thm -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `((a:real) - b = c) <=> (a = b + c)`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b = c + b) <=> a = c`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e2 - e + &1 = e2`]; ALL_TAC] THEN REWRITE_TAC[is_fixed] THEN EXISTS_TAC `f':num` THEN REWRITE_TAC[is_frac] THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]]; (* x < 0 *) REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `x + &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x = -- (&f' * &(flr fmt) ipow (greatest_e fmt x - &(flp fmt) + &1))` (fun thm -> REWRITE_TAC[thm]) THENL [ SUBGOAL_THEN `x = -- abs(x)` (fun thm -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(-- (a:real) + b = -- c) <=> (a = b + c)`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b = c + b) <=> a = c`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e2 - e + &1 = e2`]; ALL_TAC] THEN REWRITE_TAC[is_fixed] THEN EXISTS_TAC `f':num` THEN REWRITE_TAC[is_frac] THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `&0 <= (x:real) ==> abs(-- x) = x`) THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]]]; USE_THEN "isfloat" (fun isfloat -> REWRITE_TAC[MATCH_MP FLOAT_NORMALIZE_REAL (MATCH_MP FLOAT_NOT_ZERO isfloat)])]);; (* -------------------------------------------------------------------------- *) (* Discreteness and rounding lemmas *) (* -------------------------------------------------------------------------- *) let real_normalize xneq0 signthm lbl = let concat s = String.concat "" [lbl; s] in LABEL_TAC (concat "normed2") (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0) THEN REMOVE_THEN (concat "normed2") (fun normed2 -> LABEL_TAC (concat "normed") (REWRITE_RULE[signthm] normed2));; let float_normalize isfloat signthm lbl = let concat s = String.concat "" [lbl; s] in LABEL_CONJUNCTS_TAC [concat "grfixed"; concat "normed2"] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_FLOAT) isfloat) THEN REMOVE_THEN (concat "normed2") (fun normed2 -> LABEL_TAC (concat "normed") (REWRITE_RULE[signthm] normed2));; let FLOAT_EQ_IPOW = prove(`!(fmt:flformat) (x:real) (e:int) (m:num). ~(x = &0) /\ 1 <= m /\ m < (flr fmt) /\ abs(x) = &m * &(flr fmt) ipow e ==> greatest_e(fmt) x = e /\ greatest_m(fmt) x = m`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "mgeq1"; "mltr"; "mrleq"; "absxeq"]) THEN SUBGOAL_THEN `greatest_e(fmt) x = e` (LABEL_TAC "xgeeqe") THENL [ MATCH_MP_TAC FLOAT_GREATEST_E_UNIQUE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_greatest_e] THEN CONJ_TAC THENL [ (* show e is a lower bound *) MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(x:real) = &1 * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ARITH_TAC]; ALL_TAC] THEN (* show e is biggest *) GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `~((i:real) <= j) <=> j < i`] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:real) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `&m * &(flr fmt) ipow e + finf (to_fformat fmt e)` THEN CONJ_TAC THENL [ USE_THEN "mrleq" (fun mrleq -> REWRITE_TAC[GSYM mrleq]) THEN REWRITE_TAC[ARITH_RULE `(x:real) < x + y <=> &0 < y`] THEN REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(flr fmt) ipow (e + &1)` THEN CONJ_TAC THENL [ (* one side *) REWRITE_TAC[finf] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0))] THEN REWRITE_TAC[IPOW_TO_1] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(a:real) * b = b * a`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; (* the other side *) MATCH_MP_TAC IPOW_MONOTONE_2 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < x ==> 1 <= x`) (SPEC `fmt:flformat` FLFORMAT_RADIX_LT_0)] THEN ASM_ARITH_TAC]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN (* show m is x's gm *) MATCH_MP_TAC FLOAT_GREATEST_M_UNIQUE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_greatest_m] THEN CONJ_TAC THENL [ (* lower bound is easy *) ASM_REWRITE_TAC[] THEN ARITH_TAC; (* show m is the biggest *) GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `~((i:real) <= j) <=> j < i`] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:real) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `&m * &(flr fmt) ipow e + finf (to_fformat fmt e)` THEN CONJ_TAC THENL [ USE_THEN "mrleq" (fun mrleq -> REWRITE_TAC[GSYM mrleq]) THEN REWRITE_TAC[ARITH_RULE `(x:real) < x + y <=> &0 < y`] THEN REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(m + 1) * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ (* one side *) REWRITE_TAC[finf] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN ARITH_TAC; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]]);; let FLOAT_EQ_IPOW_R_0 = prove(`!(fmt:flformat) (x:real) (e:int) (m:num). ~(x = &0) /\ 1 <= m /\ m < (flr fmt) /\ abs(x) = &m * &(flr fmt) ipow e ==> greatest_r(fmt) x = &0`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "mgeq1"; "mltr"; "mrleq"; "absxeq"]) THEN SUBGOAL_THEN `greatest_e(fmt) x = e /\ greatest_m(fmt) x = m` ASSUME_TAC THENL [ MATCH_MP_TAC FLOAT_EQ_IPOW THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let FLOAT_BETWEEN = prove(`!(fmt:flformat) (x:real) (e:int) (m:num). ~(x = &0) /\ 1 <= m /\ m < (flr fmt) /\ &m * &(flr fmt) ipow e <= abs(x) /\ abs(x) < &m * &(flr fmt) ipow e + (finf (to_fformat fmt e)) ==> greatest_e(fmt) x = e /\ greatest_m(fmt) x = m`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "mgeq1"; "mltr"; "mrleq"; "absxleq"]) THEN SUBGOAL_THEN `greatest_e(fmt) x = e` (LABEL_TAC "xgeeqe") THENL [ MATCH_MP_TAC FLOAT_GREATEST_E_UNIQUE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_greatest_e] THEN CONJ_TAC THENL [ (* show e is a lower bound *) MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(x:real) = &1 * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; (* show e is biggest *) GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `~((i:real) <= j) <=> j < i`] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:real) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `&m * &(flr fmt) ipow e + finf (to_fformat fmt e)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(flr fmt) ipow (e + &1)` THEN CONJ_TAC THENL [ (* one side *) REWRITE_TAC[finf] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0))] THEN REWRITE_TAC[IPOW_TO_1] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(a:real) * b = b * a`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; (* the other side *) MATCH_MP_TAC IPOW_MONOTONE_2 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < x ==> 1 <= x`) (SPEC `fmt:flformat` FLFORMAT_RADIX_LT_0)] THEN ASM_ARITH_TAC]]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN (* show m is x's gm *) MATCH_MP_TAC FLOAT_GREATEST_M_UNIQUE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[is_greatest_m] THEN CONJ_TAC THENL [ (* lower bound is easy *) ASM_REWRITE_TAC[]; (* show m is the biggest *) GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `~((i:real) <= j) <=> j < i`] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:real) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `&m * &(flr fmt) ipow e + finf (to_fformat fmt e)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(m + 1) * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ (* one side *) REWRITE_TAC[finf] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN ARITH_TAC; MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]]);; (* -------------------------------------------------------------------------- *) (* Rounding existence theorems *) (* -------------------------------------------------------------------------- *) let FLOAT_RD_IS_FLOAT = prove(`!(fmt:flformat) (x:real) (mode:roundmode). ~(x = &0) ==> is_float(fmt) (flround(fmt) mode x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ REWRITE_TAC[is_float] THEN SUBGOAL_THEN `is_fixed(to_fformat fmt (greatest_e fmt x)) (fround (to_fformat fmt (greatest_e fmt x)) mode (greatest_r fmt x))` (LABEL_TAC "froundfixed") THENL [ MATCH_MP_TAC FIXED_RD_IS_FIXED THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "froundfixed" (fun froundfixed -> DISJ_CASES_TAC (MATCH_MP (ARITH_RULE `(x:num) <= y ==> x < y \/ x = y`) (MATCH_MP (SPEC `(to_fformat fmt (greatest_e(fmt) x))` FIXED_FF_LE) froundfixed))) THENL [ EXISTS_TAC `(greatest_m(fmt) x) * (flr fmt) EXP ((flp fmt) - 1) + (ff(to_fformat fmt (greatest_e(fmt) x)) (fround(to_fformat fmt (greatest_e(fmt) x)) mode (greatest_r(fmt) x)))` THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `0 < x ==> 0 < x + y`) THEN REWRITE_TAC[LT_MULT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `0 < x <=> 1 <= x`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EXP_LE_1 THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN CONJ_TAC THENL [ SUBGOAL_THEN `greatest_m fmt x * flr fmt EXP (flp fmt - 1) <= ((flr fmt) - 1) * flr fmt EXP (flp fmt - 1)` (LABEL_TAC "mtimes") THENL [ REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y = z ==> x < z`) THEN EXISTS_TAC `((flr fmt) - 1) * (flr fmt) EXP ((flp fmt) - 1) + (flr fmt) EXP ((flp fmt) - 1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC LET_ADD2 THEN ASM_REWRITE_TAC[] THEN dump_flformat_conv `greatest_e(fmt) x` THEN USE_THEN "fmteqr" (fun fmteqr -> REWRITE_TAC[GSYM fmteqr]) THEN USE_THEN "fmteqp" (fun fmteqp -> REWRITE_TAC[GSYM fmteqp]) THEN USE_THEN "fmteq" (fun fmteq -> REWRITE_TAC[GSYM fmteq]) THEN REWRITE_TAC[ASSUME `ff (to_fformat fmt (greatest_e fmt x)) (fround (to_fformat fmt (greatest_e fmt x)) mode (greatest_r fmt x)) < fr (to_fformat fmt (greatest_e fmt x)) EXP (fp (to_fformat fmt (greatest_e fmt x)) - 1)`]; REWRITE_TAC[ARITH_RULE `(n - 1) * z + z = ((n - 1) + 1) * z`] THEN REWRITE_TAC[REWRITE_RULE[ARITH_RULE `~(x = 0) <=> x - 1 + 1 = x`] (REWRITE_RULE[REAL_OF_NUM_EQ] FLFORMAT_RADIX_NE_0)] THEN ONCE_REWRITE_TAC[GSYM EXP] THEN REWRITE_TAC[REWRITE_RULE[ARITH_RULE `(0 < x) <=> SUC (x - 1) = x`] (REWRITE_RULE[REAL_OF_NUM_EQ] FLFORMAT_PREC_LT_0)]]; ALL_TAC] THEN REWRITE_TAC[flround] THEN LET_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) * z = x * z + y * z`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` (LABEL_TAC "mgeq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= fround (to_fformat fmt e) mode y` (LABEL_TAC "frgeq0") THENL [ MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN USE_THEN "mgeq0" (fun mgeq0 -> USE_THEN "frgeq0" (fun frgeq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x /\ &0 <= y ==> abs(x + y) = x + y`) (CONJ mgeq0 frgeq0)])) THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN USE_THEN "frgeq0" (fun frgeq0 -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) frgeq0]) THEN dump_flformat_conv `e:int` THEN USE_THEN "fmteq" (fun fmteq -> REWRITE_TAC[fmteq]) THEN USE_THEN "fmteqr" (fun fmteqr -> REWRITE_TAC[GSYM fmteqr]) THEN USE_THEN "fmteqp" (fun fmteqp -> REWRITE_TAC[GSYM fmteqp]) THEN USE_THEN "fmteqe" (fun fmteqe -> REWRITE_TAC[GSYM fmteqe]) THEN MATCH_MP_TAC FIXED_FF_REP THEN MATCH_MP_TAC FIXED_RD_IS_FIXED THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM (ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "fmteq" (fun fmteq -> REWRITE_TAC[GSYM fmteq]) THEN REWRITE_TAC[GSYM (ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; (* rounds to top *) ASM_CASES_TAC `(greatest_m(fmt) x) < (flr fmt) - 1` THENL [ EXISTS_TAC `((greatest_m(fmt) x) + 1) * (flr fmt) EXP ((flp fmt) - 1)` THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `0 < m + 1`] THEN MATCH_MP_TAC (ARITH_RULE `1 <= x ==> 0 < x`) THEN MATCH_MP_TAC EXP_LE_1 THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y = z ==> x < z`) THEN EXISTS_TAC `(flr fmt) * flr fmt EXP (flp fmt - 1)` THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT_RCANCEL] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXP_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ONCE_REWRITE_TAC[GSYM EXP] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < x ==> SUC(x - 1) = x`) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0)]]; ALL_TAC] THEN REWRITE_TAC[flround] THEN LET_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` (LABEL_TAC "mgeq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= fround (to_fformat fmt e) mode y` (LABEL_TAC "frgeq0") THENL [ MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN USE_THEN "mgeq0" (fun mgeq0 -> USE_THEN "frgeq0" (fun frgeq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x /\ &0 <= y ==> abs(x + y) = x + y`) (CONJ mgeq0 frgeq0)])) THEN SUBGOAL_THEN `fround (to_fformat fmt e) mode y = &(flr fmt) ipow e` (LABEL_TAC "froundeq") THENL [ USE_THEN "frgeq0" (fun frgeq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) frgeq0]) THEN USE_THEN "froundfixed" (fun froundfixed -> REWRITE_TAC[MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_FF_REP) froundfixed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(fr (to_fformat fmt e))` IPOW_EQ_EXP_P) (SPEC `(to_fformat fmt e)` FFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(fr (to_fformat fmt e))` IPOW_ADD_EXP) (SPEC `(to_fformat fmt e)` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`]; (* rounds to tip tip top *) EXISTS_TAC `(flr fmt) EXP ((flp fmt) - 1)` THEN EXISTS_TAC `(greatest_e(fmt) x) + &1` THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `1 <= x ==> 0 < x`) THEN MATCH_MP_TAC EXP_LE_1 THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN CONJ_TAC THENL [ REWRITE_TAC[LT_EXP] THEN REWRITE_TAC[FLFORMAT_RADIX_LE_2] THEN DISJ1_TAC THEN REWRITE_TAC[ARITH_RULE `x - 1 < x <=> 0 < x`] THEN REWRITE_TAC[FLFORMAT_PREC_LT_0]; ALL_TAC] THEN REWRITE_TAC[flround] THEN LET_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` (LABEL_TAC "mgeq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= fround (to_fformat fmt e) mode y` (LABEL_TAC "frgeq0") THENL [ MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN USE_THEN "mgeq0" (fun mgeq0 -> USE_THEN "frgeq0" (fun frgeq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x /\ &0 <= y ==> abs(x + y) = x + y`) (CONJ mgeq0 frgeq0)])) THEN SUBGOAL_THEN `fround (to_fformat fmt e) mode y = &(flr fmt) ipow e` (LABEL_TAC "froundeq") THENL [ USE_THEN "frgeq0" (fun frgeq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) frgeq0]) THEN USE_THEN "froundfixed" (fun froundfixed -> REWRITE_TAC[MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_FF_REP) froundfixed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(fr (to_fformat fmt e))` IPOW_EQ_EXP_P) (SPEC `(to_fformat fmt e)` FFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(fr (to_fformat fmt e))` IPOW_ADD_EXP) (SPEC `(to_fformat fmt e)` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN SUBGOAL_THEN `m + 1= (flr fmt)` (fun thm -> REWRITE_TAC[thm]) THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0))] THEN REWRITE_TAC[IPOW_TO_1] THEN ARITH_TAC]]; ALL_TAC] THEN (* x < 0 *) REWRITE_TAC[is_float] THEN SUBGOAL_THEN `is_fixed(to_fformat fmt (greatest_e fmt x)) (fround (to_fformat fmt (greatest_e fmt x)) mode (greatest_r fmt x))` (LABEL_TAC "froundfixed") THENL [ MATCH_MP_TAC FIXED_RD_IS_FIXED THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "froundfixed" (fun froundfixed -> DISJ_CASES_TAC (MATCH_MP (ARITH_RULE `(x:num) <= y ==> x < y \/ x = y`) (MATCH_MP (SPEC `(to_fformat fmt (greatest_e(fmt) x))` FIXED_FF_LE) froundfixed))) THENL [ EXISTS_TAC `(greatest_m(fmt) x) * (flr fmt) EXP ((flp fmt) - 1) + (ff(to_fformat fmt (greatest_e(fmt) x)) (fround(to_fformat fmt (greatest_e(fmt) x)) mode (greatest_r(fmt) x)))` THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `0 < x ==> 0 < x + y`) THEN REWRITE_TAC[LT_MULT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `0 < x <=> 1 <= x`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EXP_LE_1 THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN CONJ_TAC THENL [ SUBGOAL_THEN `greatest_m fmt x * flr fmt EXP (flp fmt - 1) <= ((flr fmt) - 1) * flr fmt EXP (flp fmt - 1)` (LABEL_TAC "mtimes") THENL [ REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y = z ==> x < z`) THEN EXISTS_TAC `((flr fmt) - 1) * (flr fmt) EXP ((flp fmt) - 1) + (flr fmt) EXP ((flp fmt) - 1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC LET_ADD2 THEN ASM_REWRITE_TAC[] THEN dump_flformat_conv `greatest_e(fmt) x` THEN USE_THEN "fmteqr" (fun fmteqr -> REWRITE_TAC[GSYM fmteqr]) THEN USE_THEN "fmteqp" (fun fmteqp -> REWRITE_TAC[GSYM fmteqp]) THEN USE_THEN "fmteq" (fun fmteq -> REWRITE_TAC[GSYM fmteq]) THEN REWRITE_TAC[ASSUME `ff (to_fformat fmt (greatest_e fmt x)) (fround (to_fformat fmt (greatest_e fmt x)) mode (greatest_r fmt x)) < fr (to_fformat fmt (greatest_e fmt x)) EXP (fp (to_fformat fmt (greatest_e fmt x)) - 1)`]; REWRITE_TAC[ARITH_RULE `(n - 1) * z + z = ((n - 1) + 1) * z`] THEN REWRITE_TAC[REWRITE_RULE[ARITH_RULE `~(x = 0) <=> x - 1 + 1 = x`] (REWRITE_RULE[REAL_OF_NUM_EQ] FLFORMAT_RADIX_NE_0)] THEN ONCE_REWRITE_TAC[GSYM EXP] THEN REWRITE_TAC[REWRITE_RULE[ARITH_RULE `(0 < x) <=> SUC (x - 1) = x`] (REWRITE_RULE[REAL_OF_NUM_EQ] FLFORMAT_PREC_LT_0)]]; ALL_TAC] THEN REWRITE_TAC[flround] THEN LET_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) * z = x * z + y * z`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` (LABEL_TAC "mgeq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `fround (to_fformat fmt e) mode y <= &0` (LABEL_TAC "frleq0") THENL [ MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN USE_THEN "mgeq0" (fun mgeq0 -> USE_THEN "frleq0" (fun frleq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x /\ y <= &0 ==> abs(-- x + y) = x + -- y`) (CONJ mgeq0 frleq0)])) THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN USE_THEN "frleq0" (fun frleq0 -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (ARITH_RULE `(x:real) <= &0 ==> -- x = abs(x)`) frleq0]) THEN dump_flformat_conv `e:int` THEN USE_THEN "fmteq" (fun fmteq -> REWRITE_TAC[fmteq]) THEN USE_THEN "fmteqr" (fun fmteqr -> REWRITE_TAC[GSYM fmteqr]) THEN USE_THEN "fmteqp" (fun fmteqp -> REWRITE_TAC[GSYM fmteqp]) THEN USE_THEN "fmteqe" (fun fmteqe -> REWRITE_TAC[GSYM fmteqe]) THEN MATCH_MP_TAC FIXED_FF_REP THEN MATCH_MP_TAC FIXED_RD_IS_FIXED THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM (ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "fmteq" (fun fmteq -> REWRITE_TAC[GSYM fmteq]) THEN REWRITE_TAC[GSYM (ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; (* rounds to top *) ASM_CASES_TAC `(greatest_m(fmt) x) < (flr fmt) - 1` THENL [ EXISTS_TAC `((greatest_m(fmt) x) + 1) * (flr fmt) EXP ((flp fmt) - 1)` THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `0 < m + 1`] THEN MATCH_MP_TAC (ARITH_RULE `1 <= x ==> 0 < x`) THEN MATCH_MP_TAC EXP_LE_1 THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y = z ==> x < z`) THEN EXISTS_TAC `(flr fmt) * flr fmt EXP (flp fmt - 1)` THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT_RCANCEL] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXP_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ONCE_REWRITE_TAC[GSYM EXP] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < x ==> SUC(x - 1) = x`) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0)]]; ALL_TAC] THEN REWRITE_TAC[flround] THEN LET_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` (LABEL_TAC "mgeq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `fround (to_fformat fmt e) mode y <= &0` (LABEL_TAC "frleq0") THENL [ MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN USE_THEN "mgeq0" (fun mgeq0 -> USE_THEN "frleq0" (fun frleq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x /\ y <= &0 ==> abs(-- x + y) = x + -- y`) (CONJ mgeq0 frleq0)])) THEN SUBGOAL_THEN `-- fround (to_fformat fmt e) mode y = &(flr fmt) ipow e` (LABEL_TAC "froundeq") THENL [ USE_THEN "frleq0" (fun frleq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `(x:real) <= &0 ==> -- x = abs(x)`) frleq0]) THEN USE_THEN "froundfixed" (fun froundfixed -> REWRITE_TAC[MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_FF_REP) froundfixed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(fr (to_fformat fmt e))` IPOW_EQ_EXP_P) (SPEC `(to_fformat fmt e)` FFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(fr (to_fformat fmt e))` IPOW_ADD_EXP) (SPEC `(to_fformat fmt e)` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`]; (* rounds to tip tip top *) EXISTS_TAC `(flr fmt) EXP ((flp fmt) - 1)` THEN EXISTS_TAC `(greatest_e(fmt) x) + &1` THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `1 <= x ==> 0 < x`) THEN MATCH_MP_TAC EXP_LE_1 THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN CONJ_TAC THENL [ REWRITE_TAC[LT_EXP] THEN REWRITE_TAC[FLFORMAT_RADIX_LE_2] THEN DISJ1_TAC THEN REWRITE_TAC[ARITH_RULE `x - 1 < x <=> 0 < x`] THEN REWRITE_TAC[FLFORMAT_PREC_LT_0]; ALL_TAC] THEN REWRITE_TAC[flround] THEN LET_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` (LABEL_TAC "mgeq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `fround (to_fformat fmt e) mode y <= &0` (LABEL_TAC "frleq0") THENL [ MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e fmt x = e`)] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r fmt x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN USE_THEN "mgeq0" (fun mgeq0 -> USE_THEN "frleq0" (fun frleq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x /\ y <= &0 ==> abs(-- x + y) = x + -- y`) (CONJ mgeq0 frleq0)])) THEN SUBGOAL_THEN `-- fround (to_fformat fmt e) mode y = &(flr fmt) ipow e` (LABEL_TAC "froundeq") THENL [ USE_THEN "frleq0" (fun frleq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `(x:real) <= &0 ==> -- x = abs(x)`) frleq0]) THEN USE_THEN "froundfixed" (fun froundfixed -> REWRITE_TAC[MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_FF_REP) froundfixed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(fr (to_fformat fmt e))` IPOW_EQ_EXP_P) (SPEC `(to_fformat fmt e)` FFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(fr (to_fformat fmt e))` IPOW_ADD_EXP) (SPEC `(to_fformat fmt e)` FFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN dump_flformat_conv `e:int` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) * y + y = (x + &1) * y`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(i:int) - &1 + e - i + &1 = e`] THEN SUBGOAL_THEN `m + 1= (flr fmt)` (fun thm -> REWRITE_TAC[thm]) THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0))] THEN REWRITE_TAC[IPOW_TO_1] THEN ARITH_TAC]]);; let CLOSER_BETWEEN_3 = prove(`!(a:real) (x:real) (y:real). x < y /\ y <= a ==> (closer y x a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSER_BETWEEN_4 = prove(`!(a:real) (x:real) (y:real) (z:real). (closer x y a) /\ ((closer z x a) \/ ~(closer x z a)) ==> (closer z y a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSER_BETWEEN_5 = prove(`!(a:real) (x:real) (y:real). a <= y /\ y < x ==> (closer y x a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let fl_is_closest = define `fl_is_closest (fmt:flformat) (x:real) (y:real) = (!(s:real). is_float(fmt) s /\ ~(s = y) ==> ((closer y s x) \/ ~(closer s y x)))`;; let FLOAT_RD_NEAREST_CLOSEST = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> ?(z:real). flround(fmt) To_near x = z /\ fl_is_closest(fmt) x z`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[flround] THEN LET_TAC THEN COND_CASES_TAC THENL [ (* 0 <= x *) LABEL_TAC "xgeq0" (ASSUME `&0 <= (x:real)`) THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "xgeq0" (fun xgeq0 -> real_normalize xneq0 xgeq0 "x")) THEN EXISTS_TAC `&m * &(flr fmt) ipow e + fround (to_fformat fmt e) To_near y` THEN REWRITE_TAC[] THEN REWRITE_TAC[fl_is_closest] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sfloat"; "sneq"]) THEN (* run through cases *) ASM_CASES_TAC `s < &m * &(flr fmt) ipow e` THENL [ (* s below the window *) DISJ1_TAC THEN MATCH_MP_TAC CLOSER_BETWEEN_4 THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_BETWEEN_3 THEN ASM_REWRITE_TAC[] THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x" THEN dump_gm_info xneq0 "x") THEN USE_THEN "xgeq0" (fun xgeq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) xgeq0]) THEN ONCE_REWRITE_TAC[GSYM (CONJ (ASSUME `greatest_e(fmt) x = e`) (ASSUME `greatest_m(fmt) x = m`))] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN USE_THEN "xgmbig1" (fun xgmbig1 -> REWRITE_TAC[xgmbig1]); ASM_CASES_TAC `fround (to_fformat fmt e) To_near y = &0` THENL [ (* the remainder is zero *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN ARITH_TAC; (* the remainder is non-zero *) REWRITE_TAC[closer] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN REWRITE_TAC[GSYM (CONJ (ASSUME `greatest_m fmt x = m`) (CONJ (ASSUME `greatest_e fmt x = e`) (ASSUME `greatest_r fmt x = y`)))] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[ARITH_RULE `(x:real) - (x + z) = &0 - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "xgeq0" (fun xgeq0 -> dump_gr_info xneq0 "x")) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[FIXED_ZERO_IN_FIXED]; ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN REWRITE_TAC[ASSUME `greatest_e(fmt) x = e`] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[ASSUME `greatest_r(fmt) x = y`] THEN REWRITE_TAC[ASSUME `~(fround (to_fformat fmt e) To_near y = &0)`]]]]; ALL_TAC] THEN (* s above window *) ASM_CASES_TAC `&m * &(flr fmt) ipow e + (finf (to_fformat fmt e)) < s` THENL [ DISJ1_TAC THEN MATCH_MP_TAC CLOSER_BETWEEN_4 THEN EXISTS_TAC `&m * &(flr fmt) ipow e + (finf (to_fformat fmt e))` THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_BETWEEN_5 THEN ASM_REWRITE_TAC[] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) + y <= x + z <=> y <= z`] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN SUBGOAL_THEN `&0 <= (y':real)` (LABEL_TAC "ypgeq0") THENL [ USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `&0 <= (x:real) - y <=> y <= x`] THEN USE_THEN "xgeq0" (fun xgeq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) xgeq0]) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[GSYM(CONJ (ASSUME `greatest_e(fmt) x = e`) (ASSUME `greatest_m(fmt) x = m`))] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN USE_THEN "xgmbig1" (fun xgmbig1 -> REWRITE_TAC[xgmbig1]); ALL_TAC] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "ypgeq0" (fun ypgreq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> x = abs(x)`) ypgreq0]) THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e`)] THEN ASM_ARITH_TAC; ASM_CASES_TAC `fround (to_fformat fmt e) To_near y = (finf (to_fformat fmt e))` THENL [ (* the remainder is finf *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN ARITH_TAC; (* the remainder is non-finf *) REWRITE_TAC[closer] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN REWRITE_TAC[GSYM (CONJ (ASSUME `greatest_m fmt x = m`) (CONJ (ASSUME `greatest_e fmt x = e`) (ASSUME `greatest_r fmt x = y`)))] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "xgeq0" (fun xgeq0 -> dump_gr_info xneq0 "x")) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[FIXED_FINF_IN_FIXED]; ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN REWRITE_TAC[ASSUME `greatest_e(fmt) x = e`] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[ASSUME `greatest_r(fmt) x = y`] THEN REWRITE_TAC[ASSUME `~(fround (to_fformat fmt e) To_near y = finf (to_fformat fmt e))`]]]]; ALL_TAC] THEN (* s is inside the window, but could be at top *) ASM_CASES_TAC `s = &m * &(flr fmt) ipow e + finf (to_fformat fmt e)` THENL [ (* take care of trivial case *) ASM_CASES_TAC `fround (to_fformat fmt e) To_near y = finf (to_fformat fmt e)` THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN ARITH_TAC; ALL_TAC] THEN (* now may assume we're not rounding to finf *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "xgeq0" (fun xgeq0 -> dump_gr_info xneq0 "x")) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e(fmt) x = e`)] THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[FIXED_FINF_IN_FIXED]; ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN (* we can now assume s is inside the window *) SUBGOAL_THEN `&0 <= (s:real)` (LABEL_TAC "sgeq0") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL[ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `~(s = &0)` (LABEL_TAC "sneq0") THENL [ MATCH_MP_TAC (ARITH_RULE `&0 < (s:real) ==> ~(s = &0)`) THEN MATCH_MP_TAC (ARITH_RULE `!y. &0 < (y:real) /\ y <= s ==> &0 < s`) THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_m(fmt) x = m`)] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN USE_THEN "xgmgeq1" (fun xgmgeq1 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `1 <= m' ==> 0 < m'`) xgmgeq1]) THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `greatest_e(fmt) s = e /\ greatest_m(fmt) s = m` (LABEL_TAC "sgegm") THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN ASM_REWRITE_TAC[] THEN USE_THEN "sgeq0" (fun sgeq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (s:real) ==> abs(s) = s`) sgeq0]) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_m(fmt) x = m`)] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[GSYM xgmeq]) THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[GSYM xgmeq]) THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "sfloat" (fun sfloat -> USE_THEN "sgeq0" (fun sgeq0 -> float_normalize sfloat sgeq0 "s")) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "sgegm" (fun sgegm -> REWRITE_TAC[sgegm]) THEN REWRITE_TAC[closer] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "xgeq0" (fun xgeq0 -> dump_gr_info xneq0 "x")) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e(fmt) x = e`)] THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN USE_THEN "sgegm" (fun sgegm -> REWRITE_TAC[GSYM sgegm]) THEN USE_THEN "sgrfixed" (fun sgrfixed -> REWRITE_TAC[sgrfixed]); ONCE_REWRITE_TAC[ARITH_RULE `(x:real) = y <=> &(greatest_m fmt s) * &(flr fmt) ipow greatest_e fmt s + x = &(greatest_m fmt s) * &(flr fmt) ipow greatest_e fmt s + y`] THEN USE_THEN "snormed" (fun snormed -> REWRITE_TAC[GSYM snormed]) THEN USE_THEN "sgegm" (fun sgegm -> REWRITE_TAC[sgegm]) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[ASSUME `greatest_r(fmt) x = y`] THEN REWRITE_TAC[ASSUME `greatest_e(fmt) x = e`] THEN USE_THEN "sneq" (fun sneq -> REWRITE_TAC[sneq])]; (* x < 0 ------------------------------------ *) LABEL_TAC "xlt0" (ASSUME `~(&0 <= (x:real))`) THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "xlt0" (fun xlt0 -> real_normalize xneq0 xlt0 "x")) THEN EXISTS_TAC `-- (&m * &(flr fmt) ipow e) + fround (to_fformat fmt e) To_near y` THEN REWRITE_TAC[] THEN REWRITE_TAC[fl_is_closest] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sfloat"; "sneq"]) THEN (* run through cases *) ASM_CASES_TAC `-- (&m * &(flr fmt) ipow e) < s` THENL [ (* s above the window *) DISJ1_TAC THEN MATCH_MP_TAC CLOSER_BETWEEN_4 THEN EXISTS_TAC `-- (&m * &(flr fmt) ipow e)` THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_BETWEEN_5 THEN ASM_REWRITE_TAC[] THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x" THEN dump_gm_info xneq0 "x") THEN USE_THEN "xlt0" (fun xlt0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(&0 <= (x:real)) ==> x = -- abs(x)`) xlt0]) THEN REWRITE_TAC[ARITH_RULE `(-- (x:real)) <= -- y <=> y <= x`] THEN ONCE_REWRITE_TAC[GSYM (CONJ (ASSUME `greatest_e(fmt) x = e`) (ASSUME `greatest_m(fmt) x = m`))] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN USE_THEN "xgmbig1" (fun xgmbig1 -> REWRITE_TAC[xgmbig1]); ASM_CASES_TAC `fround (to_fformat fmt e) To_near y = &0` THENL [ (* the remainder is zero *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN ARITH_TAC; (* the remainder is non-zero *) REWRITE_TAC[closer] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN REWRITE_TAC[GSYM (CONJ (ASSUME `greatest_m fmt x = m`) (CONJ (ASSUME `greatest_e fmt x = e`) (ASSUME `greatest_r fmt x = y`)))] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[ARITH_RULE `(x:real) - (x + z) = &0 - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[FIXED_ZERO_IN_FIXED]; ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN REWRITE_TAC[ASSUME `greatest_e(fmt) x = e`] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[ASSUME `greatest_r(fmt) x = y`] THEN REWRITE_TAC[ASSUME `~(fround (to_fformat fmt e) To_near y = &0)`]]]]; ALL_TAC] THEN (* s below window *) ASM_CASES_TAC `s < -- (&m * &(flr fmt) ipow e) - (finf (to_fformat fmt e))` THENL [ DISJ1_TAC THEN MATCH_MP_TAC CLOSER_BETWEEN_4 THEN EXISTS_TAC `-- (&m * &(flr fmt) ipow e) - (finf (to_fformat fmt e))` THEN CONJ_TAC THENL [ MATCH_MP_TAC CLOSER_BETWEEN_3 THEN ASM_REWRITE_TAC[] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) + y <= x + z <=> y <= z`] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN SUBGOAL_THEN `(y':real) <= &0` (LABEL_TAC "ypleq0") THENL [ USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[greatest_r] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(x:real) + y <= &0 <=> x <= -- y`] THEN USE_THEN "xlt0" (fun xlt0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(&0 <= (x:real)) ==> x = -- abs(x)`) xlt0]) THEN REWRITE_TAC[ARITH_RULE `-- x <= -- y <=> y <= x`] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[GSYM(CONJ (ASSUME `greatest_e(fmt) x = e`) (ASSUME `greatest_m(fmt) x = m`))] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN USE_THEN "xgmbig1" (fun xgmbig1 -> REWRITE_TAC[xgmbig1]); ALL_TAC] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "ypleq0" (fun ypleq0 -> ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `(x:real) <= &0 ==> x = -- abs(x)`) ypleq0]) THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e`)] THEN ASM_ARITH_TAC; ASM_CASES_TAC `fround (to_fformat fmt e) To_near y = -- (finf (to_fformat fmt e))` THENL [ (* the remainder is finf *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN ARITH_TAC; (* the remainder is non-finf *) REWRITE_TAC[closer] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN REWRITE_TAC[GSYM (CONJ (ASSUME `greatest_m fmt x = m`) (CONJ (ASSUME `greatest_e fmt x = e`) (ASSUME `greatest_r fmt x = y`)))] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[ARITH_RULE `((x:real) - y) - (x + z) = -- y - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[FIXED_FINF_IN_FIXED]; ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN REWRITE_TAC[ASSUME `greatest_e(fmt) x = e`] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[ASSUME `greatest_r(fmt) x = y`] THEN REWRITE_TAC[ASSUME `~(fround (to_fformat fmt e) To_near y = -- finf (to_fformat fmt e))`]]]]; ALL_TAC] THEN (* s is inside the window, but could be at top *) ASM_CASES_TAC `s = -- (&m * &(flr fmt) ipow e) - finf (to_fformat fmt e)` THENL [ (* take care of trivial case *) ASM_CASES_TAC `fround (to_fformat fmt e) To_near y = -- finf (to_fformat fmt e)` THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN ARITH_TAC; ALL_TAC] THEN (* now may assume we're not rounding to finf *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[closer] THEN USE_THEN "xnormed" (fun xnormed -> ONCE_REWRITE_TAC[xnormed]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[ARITH_RULE `((x:real) - y) - (x + z) = -- y - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e(fmt) x = e`)] THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM FIXED_NEG_SYM] THEN REWRITE_TAC[FIXED_FINF_IN_FIXED]; ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN (* we can now assume s is inside the window *) SUBGOAL_THEN `(s:real) <= &0` (LABEL_TAC "sleq0") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `-- (&m * &(flr fmt) ipow e)` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; MATCH_MP_TAC (ARITH_RULE `&0 <= (x:real) ==> -- x <= &0`) THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL[ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]; ALL_TAC] THEN SUBGOAL_THEN `~(s = &0)` (LABEL_TAC "sneq0") THENL [ MATCH_MP_TAC (ARITH_RULE `(s:real) < &0 ==> ~(s = &0)`) THEN MATCH_MP_TAC (ARITH_RULE `!y. (y:real) < &0 /\ s <= y ==> s < &0`) THEN EXISTS_TAC `-- (&m * &(flr fmt) ipow e)` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> -- x < &0`) THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_m(fmt) x = m`)] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN USE_THEN "xgmgeq1" (fun xgmgeq1 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `1 <= m' ==> 0 < m'`) xgmgeq1]) THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `greatest_e(fmt) s = e /\ greatest_m(fmt) s = m` (LABEL_TAC "sgegm") THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN ASM_REWRITE_TAC[] THEN USE_THEN "sleq0" (fun sleq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(s:real) <= &0 ==> abs(s) = -- s`) sleq0]) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_m(fmt) x = m`)] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[GSYM xgmeq]) THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[GSYM xgmeq]) THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "sfloat" (fun sfloat -> USE_THEN "sleq0" (fun sleq0 -> USE_THEN "sneq0" (fun sneq0 -> float_normalize sfloat (MATCH_MP (ARITH_RULE `~(s = &0) /\ s <= &0 ==> ~(&0 <= (s:real))`) (CONJ sneq0 sleq0)) "s"))) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "sgegm" (fun sgegm -> REWRITE_TAC[sgegm]) THEN REWRITE_TAC[closer] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((x:real) + y) - (x + z) = y - z`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "xgrleq" (fun xgrleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "froundfixed"; "closest"]) (MATCH_MP FIXED_RD_NEAREST_CLOSEST (MATCH_MP (ARITH_RULE `(x:real) < y ==> x <= y`) xgrleq))) THEN REWRITE_TAC[GSYM(ASSUME `greatest_e(fmt) x = e`)] THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN USE_THEN "closest" (fun closest -> MATCH_MP_TAC (REWRITE_RULE[is_closest] closest)) THEN CONJ_TAC THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN USE_THEN "sgegm" (fun sgegm -> REWRITE_TAC[GSYM sgegm]) THEN USE_THEN "sgrfixed" (fun sgrfixed -> REWRITE_TAC[sgrfixed]); ONCE_REWRITE_TAC[ARITH_RULE `(x:real) = y <=> -- (&(greatest_m fmt s) * &(flr fmt) ipow greatest_e fmt s) + x = -- (&(greatest_m fmt s) * &(flr fmt) ipow greatest_e fmt s) + y`] THEN USE_THEN "snormed" (fun snormed -> REWRITE_TAC[GSYM snormed]) THEN USE_THEN "sgegm" (fun sgegm -> REWRITE_TAC[sgegm]) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[GSYM froundeq]) THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[GSYM xgreq]) THEN REWRITE_TAC[ASSUME `greatest_r(fmt) x = y`] THEN REWRITE_TAC[ASSUME `greatest_e(fmt) x = e`] THEN USE_THEN "sneq" (fun sneq -> REWRITE_TAC[sneq])]]);; let FLOAT_M_POW_E_IS_FLOAT = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> is_float(fmt) (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[is_float] THEN REWRITE_TAC[is_frac_and_exp] THEN EXISTS_TAC `(greatest_m(fmt) x) * (flr fmt) EXP ((flp fmt) - 1)` THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT] THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; REWRITE_TAC[EXP_LT_0] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]]; ALL_TAC] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y = z ==> x < z`) THEN EXISTS_TAC `(flr fmt) * flr fmt EXP ((flp fmt) - 1)` THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT_RCANCEL] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXP_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ONCE_REWRITE_TAC[GSYM EXP] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < x ==> SUC(x - 1) = x`) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0)]]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= &(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)` (LABEL_TAC "mgeq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ALL_TAC] THEN USE_THEN "mgeq0" (fun mgeq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= (x:real) ==> abs(x) = x`) mgeq0]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM(MATCH_MP IPOW_EQ_EXP_P (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + (e2:int) - e + &1 = e2`]);; let FLOAT_NEG_IS_FLOAT = prove(`!(fmt:flformat) (x:real). is_float(fmt) x <=> is_float(fmt) (-- x)`, REPEAT GEN_TAC THEN REWRITE_TAC[is_float] THEN REWRITE_TAC[is_frac_and_exp] THEN REWRITE_TAC[ARITH_RULE `abs(-- x) = abs(x)`]);; let FLOAT_PLUS_FIXED_IS_FLOAT = prove(`!(fmt:flformat) (x:real) (z:real). ~(x = &0) /\ &0 <= z /\ is_fixed(to_fformat(fmt) (greatest_e(fmt) x)) z ==> is_float(fmt) (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + z)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "zgeq0"; "zisfixed"]) THEN REWRITE_TAC[is_float] THEN REWRITE_TAC[is_frac_and_exp] THEN SUBGOAL_THEN `!(m:num). abs(&m * &(flr fmt) ipow (greatest_e(fmt) x) + z) = &m * &(flr fmt) ipow (greatest_e(fmt) x) + z` (LABEL_TAC "mgeq0") THENL [ GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `&0 <= (x:real) /\ &0 <= y ==> abs(x + y) = x + y`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL[ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ALL_TAC] THEN (* take care of edge case when z = finf *) ASM_CASES_TAC `z = (finf (to_fformat fmt (greatest_e(fmt) x)))` THENL [ (* take care of edge case when m = r - 1 *) ASM_CASES_TAC `greatest_m(fmt) x = (flr fmt) - 1` THENL [ EXISTS_TAC `(flr fmt) EXP ((flp fmt) - 1)` THEN EXISTS_TAC `greatest_e(fmt) x + &1` THEN (* show fraction is > 0 *) CONJ_TAC THENL [ REWRITE_TAC[EXP_LT_0] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN (* show fraction is < r^p *) CONJ_TAC THENL [ GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (ARITH_RULE `0 < (n:num) ==> n = SUC(n - 1)`) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0)] THEN REWRITE_TAC[EXP] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `n:num = 1 * n`] THEN REWRITE_TAC[LT_MULT_RCANCEL] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1] THEN REWRITE_TAC[EXP_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN (* show magnitude is equal *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[finf] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + (e2:int) - e + &1 = e2`] THEN SUBGOAL_THEN `1 <= (flr fmt)` (fun thm -> REWRITE_TAC[GSYM (MATCH_MP REAL_OF_NUM_SUB thm)]) THENL [ ASSUME_TAC (SPEC `fmt:flformat` FLFORMAT_RADIX_LT_1) THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `((x:real) - &1) * (z:real) + z = x * z`] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM IPOW_TO_1] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(a:int) + b = b + a`] THEN ARITH_TAC; ALL_TAC] THEN (* may assume now that m < r - 1 *) EXISTS_TAC `((greatest_m(fmt) x) + 1) * (flr fmt) EXP ((flp fmt) - 1)` THEN EXISTS_TAC `greatest_e(fmt) x` THEN (* show fraction is > 0 *) CONJ_TAC THENL [ REWRITE_TAC[LT_MULT] THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; REWRITE_TAC[EXP_LT_0] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]]; ALL_TAC] THEN (* show fraction is < r^p *) CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y = z ==> x < z`) THEN EXISTS_TAC `(flr fmt) * (flr fmt) EXP ((flp fmt) - 1)` THEN CONJ_TAC THENL [ REWRITE_TAC[LT_MULT_RCANCEL] THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; REWRITE_TAC[EXP_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]]; SUBGOAL_THEN `(flp fmt) = SUC((flp fmt) - 1)` (fun thm -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ ASSUME_TAC (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0) THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXP]]; ALL_TAC] THEN (* show magnitude is equal *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[finf] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + (e2:int) - e + &1 = e2`] THEN REWRITE_TAC[ARITH_RULE `(x:real) * z + z = (x + &1) * z`] THEN REWRITE_TAC[REAL_OF_NUM_ADD]; ALL_TAC] THEN (* okay, edge cases out of the way, we can now assume z < finf *) EXISTS_TAC `(greatest_m(fmt) x) * (flr fmt) EXP ((flp fmt) - 1) + ff(to_fformat fmt (greatest_e(fmt) x)) z` THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN (* show frac > 0 *) CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `0 < x ==> 0 < x + y`) THEN REWRITE_TAC[LT_MULT] THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; REWRITE_TAC[EXP_LT_0] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]]; ALL_TAC] THEN (* show frac < r^p *) CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y = z ==> x < z`) THEN EXISTS_TAC `(flr fmt) * (flr fmt) EXP ((flp fmt) - 1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `!y. (x:num) < y /\ y <= z ==> x < z`) THEN EXISTS_TAC `(greatest_m(fmt) x) * (flr fmt) EXP ((flp fmt) - 1) + (flr fmt) EXP ((flp fmt) - 1)` THEN CONJ_TAC THENL [ SUBGOAL_THEN `abs(z) < finf (to_fformat fmt (greatest_e(fmt) x))` (LABEL_TAC "abszlt") THENL [ USE_THEN "zisfixed" (fun zisfixed -> ASSUME_TAC (MATCH_MP (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] (SPEC `(to_fformat fmt (greatest_e(fmt) x))` FIXED_FINF_BOUNDS))) zisfixed)) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "zisfixed" (fun zisfixed -> USE_THEN "abszlt" (fun abszlt -> LABEL_TAC "fflt" (MATCH_MP (SPEC `(to_fformat fmt (greatest_e(fmt) x))` FIXED_FF_LT) (CONJ zisfixed abszlt)))) THEN REWRITE_TAC[LT_ADD_LCANCEL] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN USE_THEN "fmteqr" (fun fmteqr -> REWRITE_TAC[GSYM fmteqr]) THEN USE_THEN "fmteqp" (fun fmteqp -> REWRITE_TAC[GSYM fmteqp]) THEN USE_THEN "fmteq" (fun fmteq -> REWRITE_TAC[GSYM fmteq]) THEN USE_THEN "fflt" (fun fflt -> REWRITE_TAC[fflt]); REWRITE_TAC[ARITH_RULE `(m:num) * n + n = (m + 1) * n`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC]; SUBGOAL_THEN `(flp fmt) = SUC((flp fmt) - 1)` (fun thm -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ ASSUME_TAC (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0) THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXP]]; ALL_TAC] THEN (* show magnitude is equal *) ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) * c = a * c + b * c`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM (MATCH_MP (SPEC `(flr fmt)` IPOW_EQ_EXP_P) (SPEC `fmt:flformat` FLFORMAT_PREC_LT_0))] THEN REWRITE_TAC[ARITH_RULE `((a:real) * b) * c = a * (b * c)`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + (e2:int) - e + &1 = e2`] THEN REWRITE_TAC[ARITH_RULE `(x:real) * z + z = (x + &1) * z`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN SUBGOAL_THEN `z = abs(z)` (fun thm -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN USE_THEN "fmteqr" (fun fmteqr -> REWRITE_TAC[GSYM fmteqr]) THEN USE_THEN "fmteqp" (fun fmteqp -> REWRITE_TAC[GSYM fmteqp]) THEN USE_THEN "fmteqe" (fun fmteqe -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM fmteqe]) THEN USE_THEN "fmteq" (fun fmteq -> ONCE_REWRITE_TAC[GSYM fmteq]) THEN USE_THEN "zisfixed" (fun zisfixed -> REWRITE_TAC[MATCH_MP (SPEC `(to_fformat fmt (greatest_e(fmt) x))` FIXED_FF_REP) zisfixed]));; let FLOAT_PLUS_FIXED_IS_FLOAT_2 = prove(`!(fmt:flformat) (x:real) (z:real). ~(x = &0) /\ ~(&0 <= z) /\ is_fixed(to_fformat(fmt) (greatest_e(fmt) x)) z ==> is_float(fmt) ((-- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x))) + z)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "zlt0"; "zisfixed"]) THEN SUBGOAL_THEN `is_fixed (to_fformat fmt (greatest_e fmt x)) (-- z)` (LABEL_TAC "negzfixed") THENL [ USE_THEN "zisfixed" (fun zisfixed -> REWRITE_TAC[ONCE_REWRITE_RULE[ REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_NEG_SYM)] zisfixed]); ALL_TAC] THEN SUBGOAL_THEN `&0 <= (-- z)` (LABEL_TAC "negzgeq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[FLOAT_NEG_IS_FLOAT] THEN REWRITE_TAC[ARITH_RULE `-- ( (-- (x:real)) + z) = x + (-- z)`] THEN MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT THEN ASM_REWRITE_TAC[]);; let FLOAT_REVERSE_NORMALIZE_FLOAT = prove(`!(fmt:flformat) (x:real) (y:real). ~(x = &0) /\ is_float(fmt) y /\ fl_is_closest(fmt) x y ==> (~(abs(y) = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (finf (to_fformat fmt (greatest_e(fmt) x)))) ==> (greatest_m(fmt) y) = (greatest_m(fmt) x) /\ (greatest_e(fmt) y) = (greatest_e(fmt) x)) /\ ?(z:real). is_fixed(to_fformat fmt (greatest_e(fmt) x)) z /\ (if (&0 <= y) then y = &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + z else y = -- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)) + z)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "yisfloat"; "yisclosest"]) THEN (* easy case 1 *) ASM_CASES_TAC `abs(y) = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x` THENL [ CONJ_TAC THENL [ DISCH_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b <=> b /\ a`] THEN MATCH_MP_TAC FLOAT_EQ_IPOW THEN ASM_REWRITE_TAC[] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (SPEC `fmt:flformat` FLOAT_NOT_ZERO) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EXISTS_TAC `&0` THEN REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_ZERO_IN_FIXED)] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN (* easy case 2 *) ASM_CASES_TAC `abs(y) = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (finf (to_fformat fmt (greatest_e(fmt) x)))` THENL [ CONJ_TAC THENL [ ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `&0 <= (y:real)` THENL [ ASM_REWRITE_TAC[] THEN EXISTS_TAC `(finf (to_fformat fmt (greatest_e(fmt) x)))` THEN REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_FINF_IN_FIXED)] THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN EXISTS_TAC `-- (finf (to_fformat fmt (greatest_e(fmt) x)))` THEN REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] (ONCE_REWRITE_RULE[FIXED_NEG_SYM] FIXED_FINF_IN_FIXED))] THEN ASM_ARITH_TAC]; ALL_TAC] THEN (* easy cases out of the way, now re-use float between theorem *) (* first show lower bound *) SUBGOAL_THEN `&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) <= abs y` (LABEL_TAC "absylower") THENL [ ASM_CASES_TAC `&0 <= (x:real)` THENL [ (* we will use MP with the float m * r^e and defn of is closest *) SUBGOAL_THEN `&0 <= &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)` ASSUME_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "misfloat" (MATCH_MP (SPEC `fmt:flformat` FLOAT_M_POW_E_IS_FLOAT) xneq0)) THEN SUBGOAL_THEN `~(&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x) = y)` (LABEL_TAC "mneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs ((&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)) - x) = x - &(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)` ASSUME_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yisclosest" (fun yisclosest -> USE_THEN "misfloat" (fun misfloat -> USE_THEN "mneq" (fun mneq -> DISJ_CASES_TAC (MATCH_MP (REWRITE_RULE[fl_is_closest] yisclosest) (CONJ misfloat mneq))))) THENL [ (* y closer to x *) ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `closer y (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x) x`)) THEN ASM_ARITH_TAC; ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `~(closer (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x) y x)`)) THEN ASM_ARITH_TAC]; (* x < 0 *) SUBGOAL_THEN `&0 < &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)` ASSUME_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "misfloat" (ONCE_REWRITE_RULE[FLOAT_NEG_IS_FLOAT] (MATCH_MP (SPEC `fmt:flformat` FLOAT_M_POW_E_IS_FLOAT) xneq0))) THEN SUBGOAL_THEN `abs (-- (&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)) - x) = (-- x) - &(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)` ASSUME_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(-- (&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)) = y)` (LABEL_TAC "mneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yisclosest" (fun yisclosest -> USE_THEN "misfloat" (fun misfloat -> USE_THEN "mneq" (fun mneq -> DISJ_CASES_TAC (MATCH_MP (REWRITE_RULE[fl_is_closest] yisclosest) (CONJ misfloat mneq))))) THENL [ (* y closer to x *) ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `closer y (-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) x`)) THEN ASM_ARITH_TAC; ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `~(closer (-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) y x)`)) THEN ASM_ARITH_TAC]]; ALL_TAC] THEN (* show upper bound on abs(y) *) SUBGOAL_THEN `abs(y) < &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + (finf (to_fformat fmt (greatest_e(fmt) x)))` (LABEL_TAC "absyupper") THENL [ ASM_CASES_TAC `&0 <= (x:real)` THENL [ (* we will use MP with the float m * r^e + finf and defn of closest *) SUBGOAL_THEN `&0 <= &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + (finf (to_fformat fmt (greatest_e(fmt) x)))` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]; REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0]]; ALL_TAC] THEN SUBGOAL_THEN `is_float(fmt) (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + (finf (to_fformat fmt (greatest_e(fmt) x))))` (LABEL_TAC "misfloat") THENL [ MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LE_0]; REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_FINF_IN_FIXED)]]; ALL_TAC] THEN SUBGOAL_THEN `~( &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (finf (to_fformat fmt (greatest_e fmt x))) = y)` (LABEL_TAC "mneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs ( &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (finf (to_fformat fmt (greatest_e fmt x))) - x) = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (finf (to_fformat fmt (greatest_e fmt x))) - x` ASSUME_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" ( REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN USE_THEN "xnormed" (fun xnormed -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [xnormed]) THEN USE_THEN "xnormed" (fun xnormed -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [xnormed]) THEN REWRITE_TAC[ARITH_RULE `(x:real) + (y - (x + z)) = y - z`] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yisclosest" (fun yisclosest -> USE_THEN "misfloat" (fun misfloat -> USE_THEN "mneq" (fun mneq -> DISJ_CASES_TAC (MATCH_MP (REWRITE_RULE[fl_is_closest] yisclosest) (CONJ misfloat mneq))))) THENL [ (* y closer to x *) ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `closer y (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + finf (to_fformat fmt (greatest_e fmt x))) x`)) THEN ASM_ARITH_TAC; ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `~closer (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + finf (to_fformat fmt (greatest_e fmt x))) y x`)) THEN ASM_ARITH_TAC]; (* x < 0 *) SUBGOAL_THEN `&0 < &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + (finf (to_fformat fmt (greatest_e(fmt) x)))` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LT_ADD THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]; REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]]; ALL_TAC] THEN SUBGOAL_THEN `is_float(fmt) ((-- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x))) + (-- (finf (to_fformat fmt (greatest_e(fmt) x)))))` (LABEL_TAC "misfloat") THENL [ MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT_2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ REWRITE_TAC[finf] THEN REWRITE_TAC[ARITH_RULE `~(&0 <= -- (x:real)) <=> &0 < x`] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_FINF_IN_FIXED)]]; ALL_TAC] THEN SUBGOAL_THEN `~( (-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + (-- (finf (to_fformat fmt (greatest_e fmt x)))) = y)` (LABEL_TAC "mneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs ( (-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + (-- (finf (to_fformat fmt (greatest_e fmt x)))) - x) = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (finf (to_fformat fmt (greatest_e fmt x))) - (-- x)` ASSUME_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" ( REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN USE_THEN "xnormed" (fun xnormed -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [xnormed]) THEN USE_THEN "xnormed" (fun xnormed -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [xnormed]) THEN REWRITE_TAC[ARITH_RULE `(x:real) + (y - (x + z)) = y - z`] THEN REWRITE_TAC[ARITH_RULE `(x:real) + (y - (-- ((-- x) + z))) = y - (-- z)`] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yisclosest" (fun yisclosest -> USE_THEN "misfloat" (fun misfloat -> USE_THEN "mneq" (fun mneq -> DISJ_CASES_TAC (MATCH_MP (REWRITE_RULE[fl_is_closest] yisclosest) (CONJ misfloat mneq))))) THENL [ (* y closer to x *) ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `closer y (--(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x) + --finf (to_fformat fmt (greatest_e fmt x))) x`)) THEN ASM_ARITH_TAC; ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `~closer (--(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x) + --finf (to_fformat fmt (greatest_e fmt x))) y x`)) THEN ASM_ARITH_TAC]]; ALL_TAC] THEN (* OKAY: now most of the hard work is done *) SUBGOAL_THEN `greatest_e(fmt) y = greatest_e(fmt) x /\ greatest_m(fmt) y = greatest_m(fmt) x` (LABEL_TAC "ygegmeq") THENL [ (* use float between theorem *) MATCH_MP_TAC FLOAT_BETWEEN THEN CONJ_TAC THENL [ MATCH_MP_TAC (SPEC `fmt:flformat` FLOAT_NOT_ZERO) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN EXISTS_TAC `greatest_r(fmt) y` THEN USE_THEN "ygegmeq" (fun ygegmeq -> REWRITE_TAC[GSYM ygegmeq]) THEN MATCH_MP_TAC FLOAT_NORMALIZE_FLOAT THEN ASM_REWRITE_TAC[]);; let FLOAT_REVERSE_NORMALIZE_LE = prove(`!(fmt:flformat) (x:real) (y:real). ~(x = &0) /\ &0 <= x /\ fl_is_closest(fmt) x y ==> &0 <= y`, (* we will use MP with the float m * r^e and defn of is closest *) REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "xgeq0"; "yisclosest"]) THEN SUBGOAL_THEN `&0 <= &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)` ASSUME_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "misfloat" (MATCH_MP (SPEC `fmt:flformat` FLOAT_M_POW_E_IS_FLOAT) xneq0)) THEN (* get edge case out of the way *) ASM_CASES_TAC `&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x) = y` THENL [ ASM_ARITH_TAC; ALL_TAC] THEN LABEL_TAC "mneq" (ASSUME `~(&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x) = y)`) THEN SUBGOAL_THEN `abs ((&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)) - x) = x - &(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)` ASSUME_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yisclosest" (fun yisclosest -> USE_THEN "misfloat" (fun misfloat -> USE_THEN "mneq" (fun mneq -> DISJ_CASES_TAC (MATCH_MP (REWRITE_RULE[fl_is_closest] yisclosest) (CONJ misfloat mneq))))) THENL [ (* y closer to x *) ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `closer y (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x) x`)) THEN ASM_ARITH_TAC; ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `~(closer (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x) y x)`)) THEN ASM_ARITH_TAC]);; let FLOAT_REVERSE_NORMALIZE_LE_2 = prove(`!(fmt:flformat) (x:real) (y:real). ~(x = &0) /\ ~(&0 <= x) /\ fl_is_closest(fmt) x y ==> ~(&0 <= y)`, (* we will use MP with the float m * r^e and defn of is closest *) REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "xlt0"; "yisclosest"]) THEN SUBGOAL_THEN `&0 < &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)` ASSUME_TAC THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "misfloat" (ONCE_REWRITE_RULE[FLOAT_NEG_IS_FLOAT] (MATCH_MP (SPEC `fmt:flformat` FLOAT_M_POW_E_IS_FLOAT) xneq0))) THEN SUBGOAL_THEN `abs (-- (&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)) - x) = (-- x) - &(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x)` ASSUME_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN (* get edge case out of the way *) ASM_CASES_TAC `(-- (&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x))) = y` THENL [ ASM_ARITH_TAC; ALL_TAC] THEN LABEL_TAC "mneq" (ASSUME `~((-- (&(greatest_m fmt x) * &(flr fmt) ipow (greatest_e fmt x))) = y)`) THEN USE_THEN "yisclosest" (fun yisclosest -> USE_THEN "misfloat" (fun misfloat -> USE_THEN "mneq" (fun mneq -> DISJ_CASES_TAC (MATCH_MP (REWRITE_RULE[fl_is_closest] yisclosest) (CONJ misfloat mneq))))) THENL [ (* y closer to x *) ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `closer y (-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) x`)) THEN ASM_ARITH_TAC; ASSUME_TAC (REWRITE_RULE[closer] (ASSUME `~(closer (-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) y x)`)) THEN ASM_ARITH_TAC]);; let CLOSEST_LEMMA_1 = prove(`!(a:real) (x:real) (y:real) (z:real). ((closer x y a) \/ ~(closer y x a)) /\ y <= a /\ z < y ==> (closer x z a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let CLOSEST_LEMMA_2 = prove(`!(a:real) (x:real) (y:real) (z:real). ((closer x y a) \/ ~(closer y x a)) /\ (a <= y) /\ y < z ==> (closer x z a)`, REPEAT GEN_TAC THEN REWRITE_TAC[closer] THEN ARITH_TAC);; let FLOAT_IS_CLOSEST_FIXED = prove(`!(fmt:flformat) (x:real) (y:real). ~(x = &0) /\ is_float(fmt) y /\ fl_is_closest(fmt) x y ==> ?(z:real). is_fixed(to_fformat fmt (greatest_e(fmt) x)) z /\ is_closest(to_fformat fmt (greatest_e(fmt) x)) (greatest_r(fmt) x) z /\ (if (&0 <= y) then y = &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + z else y = -- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)) + z) /\ (EVEN (ff(to_fformat fmt (greatest_e(fmt) y)) (greatest_r(fmt) y)) <=> EVEN (ff(to_fformat fmt (greatest_e(fmt) x)) z))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "yisfloat"; "yisclosest"; "yfracexp"]) THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "yisfloat" (fun yisfloat -> USE_THEN "yisclosest" (fun yisclosest -> LABEL_CONJUNCTS_TAC ["eqclauses"; "zexists"] (MATCH_MP (SPEC `fmt:flformat` FLOAT_REVERSE_NORMALIZE_FLOAT) (CONJ xneq0 (CONJ yisfloat yisclosest)))))) THEN REMOVE_THEN "zexists" (fun zexists -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["zfixed"; "ynormed"]) zexists) THEN EXISTS_TAC `z:real` THEN ASM_REWRITE_TAC[] THEN (* edge case when z = 0 *) ASM_CASES_TAC `(z:real) = &0` THENL [ SUBGOAL_THEN `abs(y) = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x` (LABEL_TAC "absyeq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(abs y = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + finf (to_fformat fmt (greatest_e fmt x)))` (LABEL_TAC "absyneq") THENL [ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `~(&0 = y) ==> ~((x:real) = x + y)`) THEN REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_NEQ_0]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `a /\ b <=> b /\ a`] THEN (* show ff = 0 *) REWRITE_TAC[FIXED_FF_ZERO] THEN REWRITE_TAC[EVEN] THEN SUBGOAL_THEN `(greatest_r(fmt) y) = &0` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC FLOAT_EQ_IPOW_R_0 THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN EXISTS_TAC `(greatest_m(fmt) x)` THEN ASM_REWRITE_TAC[] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (SPEC `fmt:flformat` FLOAT_NOT_ZERO) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[FIXED_FF_ZERO] THEN REWRITE_TAC[EVEN] THEN (* show 0 is closest *) REWRITE_TAC[is_closest] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sinfixed"; "sneq0"]) THEN (* time for a tedious case analysis ... *) ASM_CASES_TAC `&0 <= (x:real)` THENL [ (* 0 <= s *) ASM_CASES_TAC `&0 <= (s:real)` THENL [ REWRITE_TAC[closer] THEN (* construct floating point nums *) REWRITE_TAC[ARITH_RULE `abs((z:real) - y) = abs(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + z - (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + y))`] THEN SUBGOAL_THEN `&0 <= (y:real)` (LABEL_TAC "ygeq0") THENL [ MATCH_MP_TAC (SPECL [`fmt:flformat`; `x:real`] FLOAT_REVERSE_NORMALIZE_LE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[GSYM(REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN SUBGOAL_THEN `&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x = y` (LABEL_TAC "eqy") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN REWRITE_TAC[ARITH_RULE `(x:real) + (&0 - y) = x - y`] THEN SUBGOAL_THEN `is_float(fmt) (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + s)` (LABEL_TAC "splusfloat") THENL [ MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT THEN ASM_REWRITE_TAC[] THEN USE_THEN "sinfixed" (fun sinfixed -> REWRITE_TAC[ REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] sinfixed)]); ALL_TAC] THEN SUBGOAL_THEN `~(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + s = y)` (LABEL_TAC "sneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(a:real) + (b - c) = (a + b) - c`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "yisclosest" (fun yisclosest -> MATCH_MP_TAC (REWRITE_RULE[fl_is_closest] yisclosest)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* s < 0 *) DISJ1_TAC THEN MATCH_MP_TAC CLOSER_LOWER THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* x < 0 *) ASM_CASES_TAC `&0 <= (s:real)` THENL [ (* 0 <= s *) SUBGOAL_THEN `&0 < (s:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN DISJ1_TAC THEN MATCH_MP_TAC CLOSER_HIGHER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* s < 0 *) REWRITE_TAC[closer] THEN (* construct floating point nums *) REWRITE_TAC[ARITH_RULE `abs((z:real) - y) = abs((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + z - ((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + y))`] THEN SUBGOAL_THEN `~(&0 <= (y:real))` (LABEL_TAC "ygeq0") THENL [ MATCH_MP_TAC (SPECL [`fmt:flformat`; `x:real`] FLOAT_REVERSE_NORMALIZE_LE_2) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[GSYM(REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN SUBGOAL_THEN `(-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) = y` (LABEL_TAC "eqy") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN REWRITE_TAC[ARITH_RULE `(x:real) + (&0 - y) = x - y`] THEN SUBGOAL_THEN `is_float(fmt) ((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + s)` (LABEL_TAC "splusfloat") THENL [ MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT_2 THEN ASM_REWRITE_TAC[] THEN USE_THEN "sinfixed" (fun sinfixed -> REWRITE_TAC[ REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] sinfixed)]); ALL_TAC] THEN SUBGOAL_THEN `~((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + s = y)` (LABEL_TAC "sneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(a:real) + (b - c) = (a + b) - c`] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "yisclosest" (fun yisclosest -> MATCH_MP_TAC (REWRITE_RULE[fl_is_closest] yisclosest)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* OKAY: now we can assume z != 0, so z is just as or closer to *) (* to x's remainder as zero is *) SUBGOAL_THEN `closer z (&0) (greatest_r(fmt) x) \/ ~(closer (&0) z (greatest_r(fmt) x))` (LABEL_TAC "zcloser0") THENL [ REWRITE_TAC[closer] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ REWRITE_TAC[ARITH_RULE `abs((z:real) - y) = abs(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + z - (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + y))`] THEN SUBGOAL_THEN `&0 <= (y:real)` (LABEL_TAC "ygeq0") THENL [ MATCH_MP_TAC (SPECL [`fmt:flformat`; `x:real`] FLOAT_REVERSE_NORMALIZE_LE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[GSYM(REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN SUBGOAL_THEN `&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + z= y` (LABEL_TAC "eqy") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(a:real) + (b - y) = (a + b) - y`] THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) [eqy]) THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN SUBGOAL_THEN `is_float(fmt) (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (&0))` (LABEL_TAC "splusfloat") THENL [ MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_ZERO_IN_FIXED)]; ALL_TAC] THEN SUBGOAL_THEN `~(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + (&0) = y)` (LABEL_TAC "sneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "yisclosest" (fun yisclosest -> MATCH_MP_TAC (REWRITE_RULE[fl_is_closest] yisclosest)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* x < 0 *) REWRITE_TAC[closer] THEN REWRITE_TAC[ARITH_RULE `abs((z:real) - y) = abs((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + z - ((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + y))`] THEN SUBGOAL_THEN `~(&0 <= (y:real))` (LABEL_TAC "ygeq0") THENL [ MATCH_MP_TAC (SPECL [`fmt:flformat`; `x:real`] FLOAT_REVERSE_NORMALIZE_LE_2) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[GSYM(REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN SUBGOAL_THEN `(-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + z = y` (LABEL_TAC "eqy") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(a:real) + (b - c) = (a + b) - c`] THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN REWRITE_TAC[ARITH_RULE `(x:real) + (&0 - y) = x - y`] THEN REWRITE_TAC[ARITH_RULE `(x:real) + (&0) = x`] THEN SUBGOAL_THEN `is_float(fmt) ((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)))` (LABEL_TAC "splusfloat") THENL [ REWRITE_TAC[GSYM FLOAT_NEG_IS_FLOAT] THEN ONCE_REWRITE_TAC[ARITH_RULE `(x:real) = x + (&0)`] THEN MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_ZERO_IN_FIXED)]; ALL_TAC] THEN SUBGOAL_THEN `~((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) = y)` (LABEL_TAC "sneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "yisclosest" (fun yisclosest -> MATCH_MP_TAC (REWRITE_RULE[fl_is_closest] yisclosest)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* OK: now we've shown closer z (&0) (greatest_r ... *) (* show z is closest *) CONJ_TAC THENL [ REWRITE_TAC[is_closest] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["sinfixed"; "sneqz"]) THEN REMOVE_THEN "sinfixed" (fun sinfixed -> LABEL_TAC "sfixed" (REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] sinfixed))) THEN (* no choice but to do cases again :( ... ) *) ASM_CASES_TAC `&0 <= (x:real)` THENL [ (* 0 <= x *) ASM_CASES_TAC `&0 <= (s:real)` THENL [ (* 0 <= s *) REWRITE_TAC[closer] THEN (* construct floating point nums *) REWRITE_TAC[ARITH_RULE `abs((z:real) - y) = abs(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + z - (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + y))`] THEN SUBGOAL_THEN `&0 <= (y:real)` (LABEL_TAC "ygeq0") THENL [ MATCH_MP_TAC (SPECL [`fmt:flformat`; `x:real`] FLOAT_REVERSE_NORMALIZE_LE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[GSYM(REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN REWRITE_TAC[ARITH_RULE `(a:real) + (b - c) = (a + b) - c`] THEN SUBGOAL_THEN `&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + z= y` (LABEL_TAC "eqy") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN SUBGOAL_THEN `is_float(fmt) (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + s)` (LABEL_TAC "splusfloat") THENL [ MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + s = y)` (LABEL_TAC "sneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "yisclosest" (fun yisclosest -> MATCH_MP_TAC (REWRITE_RULE[fl_is_closest] yisclosest)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* 0 <= x, s < 0 *) DISJ1_TAC THEN MATCH_MP_TAC CLOSEST_LEMMA_1 THEN EXISTS_TAC `(&0):real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]; ASM_ARITH_TAC]; ALL_TAC] THEN (* x < 0 *) ASM_CASES_TAC `&0 <= (s:real)` THENL [ (* 0 <= s *) ASM_CASES_TAC `(s:real) = &0` THENL [ ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < (s:real)` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN DISJ1_TAC THEN MATCH_MP_TAC CLOSEST_LEMMA_2 THEN EXISTS_TAC `(&0):real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* s < 0 *) REWRITE_TAC[closer] THEN (* construct floating point nums *) REWRITE_TAC[ARITH_RULE `abs((z:real) - y) = abs((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + z - ((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + y))`] THEN SUBGOAL_THEN `~(&0 <= (y:real))` (LABEL_TAC "ygeq0") THENL [ MATCH_MP_TAC (SPECL [`fmt:flformat`; `x:real`] FLOAT_REVERSE_NORMALIZE_LE_2) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> REWRITE_TAC[GSYM(REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN SUBGOAL_THEN `(-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + z = y` (LABEL_TAC "eqy") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `(a:real) + (b - c) = (a + b) - c`] THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN USE_THEN "eqy" (fun eqy -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV o ONCE_DEPTH_CONV) [eqy]) THEN SUBGOAL_THEN `is_float(fmt) ((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + s)` (LABEL_TAC "splusfloat") THENL [ MATCH_MP_TAC FLOAT_PLUS_FIXED_IS_FLOAT_2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((-- (&(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x)) + s = y)` (LABEL_TAC "sneq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM closer] THEN USE_THEN "yisclosest" (fun yisclosest -> MATCH_MP_TAC (REWRITE_RULE[fl_is_closest] yisclosest)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* DONE SHOWING IS CLOSEST *) (* take care of edge case first *) ASM_CASES_TAC `abs y = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + finf (to_fformat fmt (greatest_e fmt x))` THENL [ SUBGOAL_THEN `(greatest_r(fmt) y) = &0` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_CASES_TAC `(greatest_m(fmt) x) = (flr fmt) - 1` THENL [ MATCH_MP_TAC FLOAT_EQ_IPOW_R_0 THEN EXISTS_TAC `(greatest_e(fmt) x) + &1` THEN EXISTS_TAC `1` THEN CONJ_TAC THENL [ MATCH_MP_TAC (SPEC `fmt:flformat` FLOAT_NOT_ZERO) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ REWRITE_TAC[FLFORMAT_RADIX_LT_1]; ALL_TAC ] THEN REWRITE_TAC[GSYM(MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0))] THEN REWRITE_TAC[IPOW_TO_1] THEN REWRITE_TAC[ARITH_RULE `(&1) * (x:real) * y = y * x`] THEN ONCE_REWRITE_TAC[ARITH_RULE `(x:real) * y = (x - &1) * y + y`] THEN SUBGOAL_THEN `(&(flr fmt) - &1) = &((flr fmt) - 1)` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC REAL_OF_NUM_SUB THEN MATCH_MP_TAC (ARITH_RULE `1 < n ==> 1 <= n`) THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[finf] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* m != r - 1 *) MATCH_MP_TAC FLOAT_EQ_IPOW_R_0 THEN EXISTS_TAC `(greatest_e(fmt) x)` THEN EXISTS_TAC `(greatest_m(fmt) x) + 1` THEN CONJ_TAC THENL [ MATCH_MP_TAC (SPEC `fmt:flformat` FLOAT_NOT_ZERO) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `m + 1 < (flr fmt) <=> m < (flr fmt) - 1`] THEN MATCH_MP_TAC (ARITH_RULE `(x:num) < y /\ ~(x = y - 1) ==> x < y - 1`) THEN CONJ_TAC THENL [ ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[GSYM xgmeq]) THEN REWRITE_TAC[ASSUME `~(greatest_m fmt x = flr fmt - 1)`]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `((x:real) + &1) * z = x * z + z`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[finf] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* (abs(y) = mr^e + finf) done showing fraction is zero *) REWRITE_TAC[FIXED_FF_ZERO] THEN REWRITE_TAC[EVEN] THEN ASM_CASES_TAC `&0 <= (y:real)` THENL [ SUBGOAL_THEN `z = (finf (to_fformat fmt (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FIXED_FF_FINF] THEN REWRITE_TAC[EVEN_EXP] THEN REWRITE_TAC[FFORMAT_RADIX_EVEN] THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> ~(x - 1 = 0)`) THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FLFORMAT_PREC_LT_1]; (* y < 0 *) SUBGOAL_THEN `z = -- (finf (to_fformat fmt (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN ` (ff (to_fformat fmt (greatest_e fmt x)) (--finf (to_fformat fmt (greatest_e fmt x)))) = (ff (to_fformat fmt (greatest_e fmt x)) (finf (to_fformat fmt (greatest_e fmt x))))` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC FIXED_FF_NEG THEN REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] (REWRITE_RULE[fixed] FIXED_FINF_IN_FIXED)]; ALL_TAC] THEN REWRITE_TAC[FIXED_FF_FINF] THEN REWRITE_TAC[EVEN_EXP] THEN REWRITE_TAC[FFORMAT_RADIX_EVEN] THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> ~(x - 1 = 0)`) THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FLFORMAT_PREC_LT_1]]; ALL_TAC] THEN (* done with fraction edge case ! *) USE_THEN "eqclauses" (fun eqclauses -> LABEL_CONJUNCTS_TAC ["ygmeq"; "ygeeq"] (MATCH_MP eqclauses (ASSUME `~(abs y = &(greatest_m fmt x) * &(flr fmt) ipow greatest_e fmt x + finf (to_fformat fmt (greatest_e fmt x)))`))) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(greatest_r(fmt) y) = z` (fun thm -> REWRITE_TAC[thm]) THENL [ REWRITE_TAC[greatest_r] THEN COND_CASES_TAC THENL [ REWRITE_TAC[ARITH_RULE `(y:real) - x = z <=> y = x + z`] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; REWRITE_TAC[ARITH_RULE `(y:real) + x = z <=> y = (-- x) + z`] THEN REWRITE_TAC[ARITH_RULE `(-- x:real) * y = -- (x * y)`] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; (* A floating point number's normalized frac is m * r^(p - 1) + the fraction *) (* of its fixed point remainder. *) let fl_norm_frac = define `fl_norm_frac (fmt:flformat) (y:real) = ( (greatest_m(fmt) y) * (flr fmt) EXP ((flp fmt) - 1) + (ff (to_fformat fmt (greatest_e(fmt) y)) (greatest_r(fmt) y)) )`;; let fl_to_even = define `fl_to_even (fmt:flformat) (x:real) (y:real) = (!(y2:real). is_float(fmt) y2 /\ (fl_is_closest(fmt) x y) /\ (fl_is_closest(fmt) x y2) /\ ~(y2 = y) ==> (EVEN (fl_norm_frac(fmt) y)))`;; let FLOAT_RD_NEAREST_EVEN = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> fl_to_even(fmt) x (flround(fmt) To_near x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[fl_to_even] THEN GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["y2float"; "roundclose"; "y2close"; "y2neq"]) THEN SUBGOAL_THEN `is_float(fmt) (flround(fmt) To_near x)` (LABEL_TAC "roundfloat") THENL [ MATCH_MP_TAC FLOAT_RD_IS_FLOAT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "y2float" (fun y2float -> USE_THEN "y2close" (fun y2close -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["zpfixed"; "zpeq"; "zpclose"; "zpfrac"]) (MATCH_MP (SPEC `fmt:flformat` FLOAT_IS_CLOSEST_FIXED) (CONJ xneq0 (CONJ y2float y2close)))))) THEN USE_THEN "xneq0" (fun xneq0 -> USE_THEN "roundfloat" (fun roundfloat -> USE_THEN "roundclose" (fun roundclose -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["zfixed"; "zeq"; "zclose"; "zfrac"]) (MATCH_MP (SPEC `fmt:flformat` FLOAT_IS_CLOSEST_FIXED) (CONJ xneq0 (CONJ roundfloat roundclose)))))) THEN SUBGOAL_THEN `fround (to_fformat fmt (greatest_e(fmt) x)) To_near (greatest_r(fmt) x) = z'` (LABEL_TAC "eqzp") THENL [ ASM_CASES_TAC `&0 <= (x:real)` THENL [ ONCE_REWRITE_TAC[ARITH_RULE `(x:real) = y <=> &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + x = &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + y`] THEN SUBGOAL_THEN `&0 <= (flround(fmt) To_near x)` ASSUME_TAC THENL [ MATCH_MP_TAC FLOAT_REVERSE_NORMALIZE_LE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x) + fround (to_fformat fmt (greatest_e(fmt) x)) To_near (greatest_r(fmt) x) = (flround(fmt) To_near x)` ASSUME_TAC THENL [ REWRITE_TAC[flround] THEN LET_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; (* x < 0 *) ONCE_REWRITE_TAC[ARITH_RULE `(x:real) = y <=> (-- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x))) + x = (-- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x))) + y`] THEN SUBGOAL_THEN `~(&0 <= (flround(fmt) To_near x))` ASSUME_TAC THENL [ MATCH_MP_TAC FLOAT_REVERSE_NORMALIZE_LE_2 THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(-- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x))) + fround (to_fformat fmt (greatest_e(fmt) x)) To_near (greatest_r(fmt) x) = (flround(fmt) To_near x)` ASSUME_TAC THENL [ REWRITE_TAC[flround] THEN LET_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]; ALL_TAC ] THEN (* showed z' = fround *) REWRITE_TAC[fl_norm_frac] THEN REWRITE_TAC[EVEN_ADD] THEN REWRITE_TAC[EVEN_MULT] THEN REWRITE_TAC[EVEN_EXP] THEN REWRITE_TAC[FLFORMAT_RADIX_EVEN] THEN REWRITE_TAC[ARITH_RULE `~(x - 1 = 0) <=> 1 < x`] THEN REWRITE_TAC[FLFORMAT_PREC_LT_1] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(greatest_r(fmt) x) <= (finf (to_fformat fmt (greatest_e(fmt) x)))` (LABEL_TAC "grbnd") THENL [ MATCH_MP_TAC (ARITH_RULE `(x:real) < y ==> x <= y`) THEN USE_THEN "xneq0" (fun xneq0 -> CHOOSE_THEN (fun thm -> REWRITE_TAC[thm]) (MATCH_MP (SPEC `fmt:flformat` FLOAT_GREATEST_R_EXISTS) xneq0)); ALL_TAC] THEN USE_THEN "grbnd" (fun grbnd -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["froundeq"; "frisfixed"; "frtoeven"]) (MATCH_MP (SPEC `(to_fformat fmt (greatest_e(fmt) x))` FIXED_RD_NEAREST_EVEN) grbnd)) THEN SUBGOAL_THEN `z IN (fixed (to_fformat fmt (greatest_e(fmt) x)))` (LABEL_TAC "zpinfixed") THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((z:real) = z')` (LABEL_TAC "zneq") THENL [ ASM_CASES_TAC `&0 <= (x:real)` THENL [ SUBGOAL_THEN `&0 <= (flround(fmt) To_near x)` ASSUME_TAC THENL [ MATCH_MP_TAC FLOAT_REVERSE_NORMALIZE_LE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= (y2:real)` ASSUME_TAC THENL [ MATCH_MP_TAC FLOAT_REVERSE_NORMALIZE_LE THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC; SUBGOAL_THEN `~(&0 <= (flround(fmt) To_near x))` ASSUME_TAC THENL [ MATCH_MP_TAC FLOAT_REVERSE_NORMALIZE_LE_2 THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(&0 <= (y2:real))` ASSUME_TAC THENL [ MATCH_MP_TAC FLOAT_REVERSE_NORMALIZE_LE_2 THEN EXISTS_TAC `fmt:flformat` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `is_frac (to_fformat fmt (greatest_e(fmt) x)) z' (ff (to_fformat fmt (greatest_e(fmt) x)) z')` (LABEL_TAC "zfrac") THENL [ REWRITE_TAC[ff] THEN SELECT_ELIM_TAC THEN REWRITE_TAC[GSYM is_fixed] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `to_even (to_fformat fmt (greatest_e fmt x)) (greatest_r fmt x) z'` (LABEL_TAC "frtoeven2") THENL [ USE_THEN "eqzp" (fun eqzp -> REWRITE_TAC[GSYM eqzp]) THEN USE_THEN "froundeq" (fun froundeq -> REWRITE_TAC[froundeq]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* OK! now we're ready ... *) USE_THEN "frtoeven2" (fun frtoeven2 -> MATCH_MP_TAC (REWRITE_RULE[to_even] frtoeven2)) THEN EXISTS_TAC `z:real` THEN ASM_REWRITE_TAC[]);; (* -------------------------------------------------------------------------- *) (* Round to zero *) (* -------------------------------------------------------------------------- *) let fl_to_zero = define `fl_to_zero (fmt:flformat) (x:real) (y:real) = (if (&0 <= x) then (&0 <= y) /\ (y <= x) /\ !(y':real). is_float(fmt) y' /\ y' <= x ==> y' <= y else (y <= &0) /\ (x <= y) /\ !(y':real). is_float(fmt) y' /\ x <= y' ==> y <= y')`;; let FLOAT_RD_ZERO_EXISTS = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> fl_to_zero(fmt) x (flround (fmt) To_zero x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[fl_to_zero] THEN COND_CASES_TAC THENL [ (* 0 <= x *) CONJ_TAC THENL [ (* show round is non-negative *) REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]]; ALL_TAC] THEN (* show to zero is below x *) CONJ_TAC THENL [ REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[ REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_LADD] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "yleqfinf") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yleqfinf" (fun yleqfinf -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "tozero"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_ZERO_EXISTS) yleqfinf)) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 <= (y:real)` (LABEL_TAC "ygeq0") THENL [ EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "tozero" (fun tozero -> USE_THEN "ygeq0" (fun ygeq0 -> REWRITE_TAC[REWRITE_RULE[ygeq0] (REWRITE_RULE[to_zero] tozero)])); ALL_TAC] THEN (* show no other float below x is closer *) GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["ypfloat"; "ypleqx"]) THEN ASM_CASES_TAC `y' < &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)` THENL [ (* case 1 of 2: y' < m * r^e *) REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN MATCH_MP_TAC (ARITH_RULE `(x:real) < y /\ &0 <= z ==> x <= y + z`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]; (* case 2 of 2: y >= m * r^e *) REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN (* prepare to reverse normalize ... *) SUBGOAL_THEN `&m * &(flr fmt) ipow e <= abs(y')` (LABEL_TAC "absypgeq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ALL_TAC] THEN SUBGOAL_THEN `abs(y') < &m * &(flr fmt) ipow e + (finf (to_fformat fmt e))` (LABEL_TAC "absyplt") THENL [ MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs(x) = x` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[ REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LT_LADD] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN SUBGOAL_THEN `y'' = abs(y'')` (fun thm -> ONCE_REWRITE_TAC[thm]) THENL [ SUBGOAL_THEN `&0 <= (y'':real)` ASSUME_TAC THENL [ EXPAND_TAC "y''" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xgrleq" (fun xgrleq -> REWRITE_TAC[xgrleq]); ALL_TAC] THEN (* now ready for reverse norm *) SUBGOAL_THEN `(greatest_e(fmt) y') = e /\ (greatest_m(fmt) y') = m` (LABEL_CONJUNCTS_TAC ["ype"; "ypm"]) THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "m'" THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `!z. &0 < z /\ z <= y ==> ~(y = &0)`) THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= (y':real)` (LABEL_TAC "ypgeq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "ypfloat" (fun ypfloat -> USE_THEN "ypgeq0" (fun ypgeq0 -> LABEL_CONJUNCTS_TAC ["remfloat"; "ypnorm"] (REWRITE_RULE[ypgeq0] (MATCH_MP FLOAT_NORMALIZE_FLOAT ypfloat)))) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "ype" (fun ype -> REWRITE_TAC[ype]) THEN USE_THEN "ypm" (fun ypm -> REWRITE_TAC[ypm]) THEN REWRITE_TAC[REAL_LE_LADD] THEN SUBGOAL_THEN `greatest_r(fmt) y' <= y` (LABEL_TAC "grypleqy") THENL [ ONCE_REWRITE_TAC[GSYM (SPEC `&m * &(flr fmt) ipow e` REAL_LE_LADD)] THEN USE_THEN "ypm" (fun ypm -> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM ypm]) THEN USE_THEN "ype" (fun ype -> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM ype]) THEN USE_THEN "ypnorm" (fun ypnorm -> ONCE_REWRITE_TAC[GSYM ypnorm]) THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" (REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN REWRITE_TAC[GSYM (ASSUME `greatest_m(fmt) x = m`)] THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e`)] THEN REWRITE_TAC[GSYM (ASSUME `greatest_r(fmt) x = y`)] THEN USE_THEN "xnormed" (fun xnormed -> REWRITE_TAC[GSYM xnormed]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "absyleq") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e`)] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frtozero"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_ZERO_EXISTS) absyleq)) THEN SUBGOAL_THEN `&0 <= (y:real)` (LABEL_TAC "ygeq0") THENL [ EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "frtozero" (fun frtozero -> USE_THEN "ygeq0" (fun ygeq0 -> LABEL_CONJUNCTS_TAC ["frgeq0"; "frleqx"; "frclose"] (REWRITE_RULE[ygeq0] (REWRITE_RULE[to_zero] frtozero)))) THEN ASM_REWRITE_TAC[] THEN USE_THEN "frclose" (fun frclose -> MATCH_MP_TAC frclose) THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "e" THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN (* x < 0 ---------------------------------------- *) CONJ_TAC THENL [ (* show round is non-positive *) REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN REWRITE_TAC[ARITH_RULE `-- (z:real) + y <= &0 <=> &0 <= z + (-- y)`] THEN MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; REWRITE_TAC[ARITH_RULE `&0 <= (-- x) <=> x <= &0`] THEN MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]]; ALL_TAC] THEN (* show to-zero is above x *) CONJ_TAC THENL [ REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[ REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_LADD] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "yleqfinf") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "yleqfinf" (fun yleqfinf -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "tozero"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_ZERO_EXISTS) yleqfinf)) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(y:real) <= &0` (LABEL_TAC "ygeq0") THENL [ EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(y':real) <= &0` (LABEL_TAC "ypleq0") THENL [ EXPAND_TAC "y'" THEN MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `~(&0 <= (y:real))` THENL [ USE_THEN "tozero" (fun tozero -> REWRITE_TAC[REWRITE_RULE[ASSUME `~(&0 <= (y:real))`] (REWRITE_RULE[to_zero] tozero)]); SUBGOAL_THEN `&0 <= (y:real)` (LABEL_TAC "ygeq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "tozero" (fun tozero -> USE_THEN "ygeq0" (fun ygeq0 -> ASSUME_TAC (REWRITE_RULE[ygeq0] (REWRITE_RULE[to_zero] tozero)))) THEN ASM_ARITH_TAC]; ALL_TAC] THEN (* show no other float above x is closer *) GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["ypfloat"; "ypgeqx"]) THEN ASM_CASES_TAC `-- (&(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)) < y'` THENL [ (* case 1 of 2: - m * r^e < y' *) REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN REWRITE_TAC[ ARITH_RULE `(-- (z:real)) + y <= y' <=> (-- y') <= z + (-- y)`] THEN MATCH_MP_TAC (ARITH_RULE `(x:real) < y /\ &0 <= z ==> x <= y + z`) THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `&0 <= (-- (x:real)) <=> x <= &0`] THEN MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; (* case 2 of 2: y <= - m * r^e *) REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN (* prepare to reverse normalize ... *) SUBGOAL_THEN `&m * &(flr fmt) ipow e <= abs(y')` (LABEL_TAC "absypgeq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= &m * &(flr fmt) ipow e` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ALL_TAC] THEN SUBGOAL_THEN `abs(y') < &m * &(flr fmt) ipow e + (finf (to_fformat fmt e))` (LABEL_TAC "absyplt") THENL [ MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs(x) = -- x` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[ REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ ARITH_RULE `-- ((-- (z:real)) + y) = z + (-- y)`] THEN REWRITE_TAC[REAL_LT_LADD] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN SUBGOAL_THEN `(-- y'') = abs(y'')` (fun thm -> ONCE_REWRITE_TAC[thm]) THENL [ SUBGOAL_THEN `(y'':real) <= &0` ASSUME_TAC THENL [ EXPAND_TAC "y''" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xgrleq" (fun xgrleq -> REWRITE_TAC[xgrleq]); ALL_TAC] THEN (* now ready for reverse norm *) SUBGOAL_THEN `(greatest_e(fmt) y') = e /\ (greatest_m(fmt) y') = m` (LABEL_CONJUNCTS_TAC ["ype"; "ypm"]) THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "m'" THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (ARITH_RULE `!z. &0 < z /\ y <= (-- z) ==> ~(y = &0)`) THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `&0 < &m * &(flr fmt) ipow e` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN REWRITE_TAC[GSYM (ASSUME `greatest_m(fmt) x = m`)] THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN SUBGOAL_THEN `~(&0 <= (y':real))` (LABEL_TAC "yplt0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "ypfloat" (fun ypfloat -> USE_THEN "yplt0" (fun yplt0 -> LABEL_CONJUNCTS_TAC ["remfloat"; "ypnorm"] (REWRITE_RULE[yplt0] (MATCH_MP FLOAT_NORMALIZE_FLOAT ypfloat)))) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "ype" (fun ype -> REWRITE_TAC[ype]) THEN USE_THEN "ypm" (fun ypm -> REWRITE_TAC[ypm]) THEN REWRITE_TAC[REAL_LE_LADD] THEN SUBGOAL_THEN `y <= greatest_r(fmt) y'` (LABEL_TAC "yleqgryp") THENL [ ONCE_REWRITE_TAC[GSYM (SPEC `-- (&m * &(flr fmt) ipow e)` REAL_LE_LADD)] THEN USE_THEN "ypm" (fun ypm -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ypm]) THEN USE_THEN "ype" (fun ype -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ype]) THEN USE_THEN "ypnorm" (fun ypnorm -> ONCE_REWRITE_TAC[GSYM ypnorm]) THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" (REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN REWRITE_TAC[GSYM (ASSUME `greatest_m(fmt) x = m`)] THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e`)] THEN REWRITE_TAC[GSYM (ASSUME `greatest_r(fmt) x = y`)] THEN USE_THEN "xnormed" (fun xnormed -> REWRITE_TAC[GSYM xnormed]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "absyleq") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e`)] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frtozero"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_ZERO_EXISTS) absyleq)) THEN SUBGOAL_THEN `(y:real) <= &0` (LABEL_TAC "yleq0") THENL [ EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `~(&0 <= (y:real))` THENL [ (* interesting case ... *) USE_THEN "frtozero" (fun frtozero -> LABEL_CONJUNCTS_TAC ["frgeq0"; "frleqx"; "frclose"] (REWRITE_RULE[ASSUME `~(&0 <= (y:real))`] (REWRITE_RULE[to_zero] frtozero))) THEN ASM_REWRITE_TAC[] THEN USE_THEN "frclose" (fun frclose -> MATCH_MP_TAC frclose) THEN REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "e" THEN ASM_REWRITE_TAC[]; (* annoying edge case when y = 0 *) SUBGOAL_THEN `&0 <= (y:real)` (LABEL_TAC "ygeq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(y:real) = &0` (LABEL_TAC "yeq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "frtozero" (fun frtozero -> USE_THEN "ygeq0" (fun ygeq0 -> LABEL_CONJUNCTS_TAC ["frgeq0"; "frleqx"; "frclose"] (REWRITE_RULE[ygeq0] (REWRITE_RULE[to_zero] frtozero)))) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `y'' = &0` (fun thm -> REWRITE_TAC[thm]) THENL [ EXPAND_TAC "y''" THEN USE_THEN "yeq0" (fun yeq0 -> REWRITE_TAC[yeq0]) THEN REWRITE_TAC[FIXED_RD_EQ_0]; ALL_TAC] THEN ASM_ARITH_TAC]]);; (* -------------------------------------------------------------------------- *) (* Round to pinf *) (* -------------------------------------------------------------------------- *) let fl_to_pinf = define `fl_to_pinf (fmt:flformat) (x:real) (y:real) = (x <= y /\ !(y':real). is_float(fmt) y' /\ x <= y' ==> y <= y')`;; let FLOAT_RD_PINF_EXISTS = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> fl_to_pinf(fmt) x (flround(fmt) To_pinf x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[fl_to_pinf] THEN CONJ_TAC THENL [ (* show x <= to-pinf *) REWRITE_TAC[flround] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ (* 0 <= x *) ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" (REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN ONCE_ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN REWRITE_TAC[REAL_LE_LADD] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "absyleq") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frpinf"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_PINF_EXISTS) absyleq)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "frpinf" (fun frpinf -> REWRITE_TAC[REWRITE_RULE[to_pinf] frpinf]); (* x < 0 *) ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" (REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN ONCE_ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN REWRITE_TAC[REAL_LE_LADD] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "absyleq") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frpinf"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_PINF_EXISTS) absyleq)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "frpinf" (fun frpinf -> REWRITE_TAC[REWRITE_RULE[to_pinf] frpinf])]; ALL_TAC] THEN (* show to-pinf is closest *) GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["ypfloat"; "xleqyp"]) THEN REWRITE_TAC[flround] THEN LET_TAC THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `&m * &(flr fmt) ipow e + (finf (to_fformat fmt e)) <= y'` THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&m * &(flr fmt) ipow e + (finf (to_fformat fmt e))` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_LADD] THEN SUBGOAL_THEN `(fround (to_fformat fmt e) To_pinf y) IN (fixed (to_fformat fmt e))` (LABEL_TAC "frfixed") THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC FIXED_RD_IS_FIXED THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "frfixed" (fun frfixed -> REWRITE_TAC[MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_FINF_BOUNDS) frfixed]); (* interesting case when m * r^e <= y < (m+1)*r^e *) (* get ready to reverse normalize *) SUBGOAL_THEN `&m * &(flr fmt) ipow e <= abs(y')` (LABEL_TAC "absygeq") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x)` THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `abs(y') < &m * &(flr fmt) ipow e + (finf (to_fformat fmt e))` (LABEL_TAC "absylt") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `greatest_e(fmt) y' = e /\ greatest_m(fmt) y' = m` (LABEL_TAC "emeq") THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN CONJ_TAC THENL [ MATCH_MP_TAC FLOAT_NOT_ZERO THEN EXISTS_TAC `fmt:flformat` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= (y':real)` (LABEL_TAC "ypgeq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "ypfloat" (fun ypfloat -> USE_THEN "ypgeq0" (fun ypgeq0 -> LABEL_CONJUNCTS_TAC ["ypremfloat"; "ypnormed"] (REWRITE_RULE[ypgeq0] (MATCH_MP FLOAT_NORMALIZE_FLOAT ypfloat)))) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[emeq]) THEN REWRITE_TAC[REAL_LE_LADD] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN SUBGOAL_THEN `abs(y) <= finf (to_fformat fmt (greatest_e fmt x))` (LABEL_TAC "absyleq") THENL [ EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frtopinf"]) (MATCH_MP FIXED_RD_PINF_EXISTS absyleq)) THEN USE_THEN "frtopinf" (fun frtopinf -> LABEL_CONJUNCTS_TAC ["frlower"; "frclose"] (REWRITE_RULE[to_pinf] frtopinf)) THEN EXPAND_TAC "e" THEN ASM_REWRITE_TAC[] THEN USE_THEN "frclose" (fun frclose -> MATCH_MP_TAC frclose) THEN CONJ_TAC THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "ypremfloat" (fun ypremfloat -> REWRITE_TAC[ypremfloat]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[ARITH_RULE `a <= b <=> &m * &(flr fmt) ipow e + a <= &m * &(flr fmt) ipow e + b`] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN EXPAND_TAC "y" THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[GSYM (REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN USE_THEN "ypnormed" (fun ypnormed -> REWRITE_TAC[GSYM ypnormed]) THEN USE_THEN "xleqyp" (fun xleqyp -> REWRITE_TAC[xleqyp])]]; (* x < 0 *) ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `-- (&m * &(flr fmt) ipow e) <= y'` THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `-- (&m * &(flr fmt) ipow e)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(z:real) = z + &0`] THEN REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; (* interesting case when -- m * r^e - finf <= y < m * r^e *) (* get ready to reverse normalize *) SUBGOAL_THEN `(&m * &(flr fmt) ipow e) <= abs(y')` (LABEL_TAC "absygeq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(y':real) < &0` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `--(&m * &(flr fmt) ipow e)` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[ARITH_RULE `-- (x:real) < &0 <=> &0 < x`] THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN CONJ_TAC THENL [ ASM_ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN SUBGOAL_THEN `abs(y') < (&m * &(flr fmt) ipow e) + (finf (to_fformat fmt e))` (LABEL_TAC "absylt") THENL [ MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; SUBGOAL_THEN `abs(x) = -- x` (fun thm -> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0)]) THEN REWRITE_TAC[ARITH_RULE `-- (-- (a:real) + b) = a + (-- b)`] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN REWRITE_TAC[REAL_LT_LADD] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `--(y:real) = abs(y)` (fun thm -> REWRITE_TAC[thm]) THENL [ SUBGOAL_THEN `(y:real) <= &0` ASSUME_TAC THENL [ EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC; ALL_TAC ] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC]; ALL_TAC ] THEN SUBGOAL_THEN `greatest_e(fmt) y' = e /\ greatest_m(fmt) y' = m` (LABEL_TAC "emeq") THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN CONJ_TAC THENL [ MATCH_MP_TAC FLOAT_NOT_ZERO THEN EXISTS_TAC `fmt:flformat` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(&0 <= (y':real))` (LABEL_TAC "yplt0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "ypfloat" (fun ypfloat -> USE_THEN "yplt0" (fun yplt0 -> LABEL_CONJUNCTS_TAC ["ypremfloat"; "ypnormed"] (REWRITE_RULE[yplt0] (MATCH_MP FLOAT_NORMALIZE_FLOAT ypfloat)))) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[emeq]) THEN REWRITE_TAC[REAL_LE_LADD] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN SUBGOAL_THEN `abs(y) <= finf (to_fformat fmt (greatest_e fmt x))` (LABEL_TAC "absyleq") THENL [ EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frtopinf"]) (MATCH_MP FIXED_RD_PINF_EXISTS absyleq)) THEN USE_THEN "frtopinf" (fun frtopinf -> LABEL_CONJUNCTS_TAC ["frlower"; "frclose"] (REWRITE_RULE[to_pinf] frtopinf)) THEN EXPAND_TAC "e" THEN ASM_REWRITE_TAC[] THEN USE_THEN "frclose" (fun frclose -> MATCH_MP_TAC frclose) THEN CONJ_TAC THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "ypremfloat" (fun ypremfloat -> REWRITE_TAC[ypremfloat]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[ARITH_RULE `a <= b <=> (-- (&m * &(flr fmt) ipow e)) + a <= (-- (&m * &(flr fmt) ipow e)) + b`] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN EXPAND_TAC "y" THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[GSYM (REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN USE_THEN "ypnormed" (fun ypnormed -> REWRITE_TAC[GSYM ypnormed]) THEN USE_THEN "xleqyp" (fun xleqyp -> REWRITE_TAC[xleqyp])]]]);; (* -------------------------------------------------------------------------- *) (* Round to ninf *) (* -------------------------------------------------------------------------- *) let fl_to_ninf = define `fl_to_ninf (fmt:flformat) (x:real) (y:real) = (y <= x /\ !(y':real). is_float(fmt) y' /\ y' <= x ==> y' <= y)`;; let FLOAT_RD_NINF_EXISTS = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> fl_to_ninf(fmt) x (flround(fmt) To_ninf x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[fl_to_ninf] THEN CONJ_TAC THENL [ (* show to-ninf <= x *) REWRITE_TAC[flround] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ (* 0 <= x *) ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" (REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN ONCE_ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN REWRITE_TAC[REAL_LE_LADD] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "absyleq") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frpinf"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_NINF_EXISTS) absyleq)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "frpinf" (fun frpinf -> REWRITE_TAC[REWRITE_RULE[to_ninf] frpinf]); (* x < 0 *) ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> LABEL_TAC "xnormed" (REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))) THEN ONCE_ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN REWRITE_TAC[REAL_LE_LADD] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(y) <= (finf (to_fformat fmt e))` (LABEL_TAC "absyleq") THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frpinf"]) (MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_RD_NINF_EXISTS) absyleq)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "frpinf" (fun frpinf -> REWRITE_TAC[REWRITE_RULE[to_ninf] frpinf])]; ALL_TAC] THEN (* show to-ninf is closest *) GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["ypfloat"; "xleqyp"]) THEN REWRITE_TAC[flround] THEN LET_TAC THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `y' < &m * &(flr fmt) ipow e` THENL [ MATCH_MP_TAC (ARITH_RULE `(a:real) < b ==> a <= b`) THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `(x:real) = x + &0`] THEN REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]; (* interesting case when m * r^e <= y < (m+1)*r^e *) (* get ready to reverse normalize *) SUBGOAL_THEN `&m * &(flr fmt) ipow e <= abs(y')` (LABEL_TAC "absygeq") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= (y':real)` ASSUME_TAC THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&m * &(flr fmt) ipow e` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `abs(y') < &m * &(flr fmt) ipow e + (finf (to_fformat fmt e))` (LABEL_TAC "absylt") THENL [ MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN CONJ_TAC THENL [ ASM_ARITH_TAC; SUBGOAL_THEN `abs(x) = x` (fun thm -> REWRITE_TAC[thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LT_LADD] THEN SUBGOAL_THEN `y = abs(y)` (fun thm -> ONCE_REWRITE_TAC[thm]) THENL [ SUBGOAL_THEN `&0 <= (y:real)` ASSUME_TAC THENL [ EXPAND_TAC "y" THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN EXPAND_TAC "e" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `greatest_e(fmt) y' = e /\ greatest_m(fmt) y' = m` (LABEL_TAC "emeq") THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN CONJ_TAC THENL [ MATCH_MP_TAC FLOAT_NOT_ZERO THEN EXISTS_TAC `fmt:flformat` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= (y':real)` (LABEL_TAC "ypgeq0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "ypfloat" (fun ypfloat -> USE_THEN "ypgeq0" (fun ypgeq0 -> LABEL_CONJUNCTS_TAC ["ypremfloat"; "ypnormed"] (REWRITE_RULE[ypgeq0] (MATCH_MP FLOAT_NORMALIZE_FLOAT ypfloat)))) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[emeq]) THEN REWRITE_TAC[REAL_LE_LADD] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN SUBGOAL_THEN `abs(y) <= finf (to_fformat fmt (greatest_e fmt x))` (LABEL_TAC "absyleq") THENL [ EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frtopinf"]) (MATCH_MP FIXED_RD_NINF_EXISTS absyleq)) THEN USE_THEN "frtopinf" (fun frtopinf -> LABEL_CONJUNCTS_TAC ["frlower"; "frclose"] (REWRITE_RULE[to_ninf] frtopinf)) THEN EXPAND_TAC "e" THEN ASM_REWRITE_TAC[] THEN USE_THEN "frclose" (fun frclose -> MATCH_MP_TAC frclose) THEN CONJ_TAC THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "ypremfloat" (fun ypremfloat -> REWRITE_TAC[ypremfloat]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[ARITH_RULE `a <= b <=> &m * &(flr fmt) ipow e + a <= &m * &(flr fmt) ipow e + b`] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN EXPAND_TAC "y" THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[GSYM (REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN USE_THEN "ypnormed" (fun ypnormed -> REWRITE_TAC[GSYM ypnormed]) THEN USE_THEN "xleqyp" (fun xleqyp -> REWRITE_TAC[xleqyp])]]; (* x < 0 *) ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `y' <= -- (&m * &(flr fmt) ipow e) + (-- (finf (to_fformat fmt e)))` THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `-- (&m * &(flr fmt) ipow e) + (-- (finf (to_fformat fmt e)))` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_LADD] THEN SUBGOAL_THEN `(fround (to_fformat fmt e) To_ninf y) IN (fixed (to_fformat fmt e))` (LABEL_TAC "frinfixed") THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC FIXED_RD_IS_FIXED THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "frinfixed" (fun frinfixed -> REWRITE_TAC[MATCH_MP (SPEC `(to_fformat fmt e)` FIXED_FINF_BOUNDS) frinfixed]); (* interesting case when -- m * r^e - finf < y <= m * r^e *) (* get ready to reverse normalize *) SUBGOAL_THEN `(y':real) < &0` ASSUME_TAC THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `abs(y') < (&m * &(flr fmt) ipow e) + (finf (to_fformat fmt e))` (LABEL_TAC "absylt") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(&m * &(flr fmt) ipow e) <= abs(y')` (LABEL_TAC "absygeq") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x)` THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[]; ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `greatest_e(fmt) y' = e /\ greatest_m(fmt) y' = m` (LABEL_TAC "emeq") THENL [ MATCH_MP_TAC FLOAT_BETWEEN THEN CONJ_TAC THENL [ MATCH_MP_TAC FLOAT_NOT_ZERO THEN EXISTS_TAC `fmt:flformat` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "m" THEN USE_THEN "xgmeq" (fun xgmeq -> REWRITE_TAC[xgmeq]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(&0 <= (y':real))` (LABEL_TAC "yplt0") THENL [ ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "ypfloat" (fun ypfloat -> USE_THEN "yplt0" (fun yplt0 -> LABEL_CONJUNCTS_TAC ["ypremfloat"; "ypnormed"] (REWRITE_RULE[yplt0] (MATCH_MP FLOAT_NORMALIZE_FLOAT ypfloat)))) THEN ONCE_ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[emeq]) THEN REWRITE_TAC[REAL_LE_LADD] THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN SUBGOAL_THEN `abs(y) <= finf (to_fformat fmt (greatest_e fmt x))` (LABEL_TAC "absyleq") THENL [ EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; ALL_TAC] THEN USE_THEN "absyleq" (fun absyleq -> CHOOSE_THEN (LABEL_CONJUNCTS_TAC ["freq"; "frfixed"; "frtopinf"]) (MATCH_MP FIXED_RD_NINF_EXISTS absyleq)) THEN USE_THEN "frtopinf" (fun frtopinf -> LABEL_CONJUNCTS_TAC ["frlower"; "frclose"] (REWRITE_RULE[to_ninf] frtopinf)) THEN EXPAND_TAC "e" THEN ASM_REWRITE_TAC[] THEN USE_THEN "frclose" (fun frclose -> MATCH_MP_TAC frclose) THEN CONJ_TAC THENL [ REWRITE_TAC[fixed] THEN REWRITE_TAC[IN_ELIM_THM] THEN USE_THEN "ypremfloat" (fun ypremfloat -> REWRITE_TAC[ypremfloat]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[ARITH_RULE `a <= b <=> (-- (&m * &(flr fmt) ipow e)) + a <= (-- (&m * &(flr fmt) ipow e)) + b`] THEN EXPAND_TAC "m" THEN EXPAND_TAC "e" THEN EXPAND_TAC "y" THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[GSYM (REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP (SPEC `fmt:flformat` FLOAT_NORMALIZE_REAL) xneq0))]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "emeq" (fun emeq -> REWRITE_TAC[GSYM emeq]) THEN USE_THEN "ypnormed" (fun ypnormed -> REWRITE_TAC[GSYM ypnormed]) THEN USE_THEN "xleqyp" (fun xleqyp -> REWRITE_TAC[xleqyp])]]]);; (* -------------------------------------------------------------------------- *) (* Absolute Error bounds *) (* -------------------------------------------------------------------------- *) (* these are refreshingly easy ... *) let FLOAT_RD_NEAR_ABS_ERR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> abs( (flround(fmt) To_near x) - x ) <= (fulp (to_fformat fmt (greatest_e(fmt) x))) / &2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[flround] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_NEAREST_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_NEAREST_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC]);; let FLOAT_RD_ZERO_ABS_ERR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> abs( (flround(fmt) To_zero x) - x ) <= (fulp (to_fformat fmt (greatest_e(fmt) x)))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[flround] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_ZERO_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_ZERO_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC]);; let FLOAT_RD_PINF_ABS_ERR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> abs( (flround(fmt) To_pinf x) - x ) <= (fulp (to_fformat fmt (greatest_e(fmt) x)))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[flround] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_PINF_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_PINF_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC]);; let FLOAT_RD_NINF_ABS_ERR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> abs( (flround(fmt) To_ninf x) - x ) <= (fulp (to_fformat fmt (greatest_e(fmt) x)))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[flround] THEN ASM_CASES_TAC `&0 <= (x:real)` THENL [ ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `&0 <= (x:real)`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_NINF_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN LET_TAC THEN USE_THEN "xneq0" (fun xneq0 -> ONCE_REWRITE_TAC[REWRITE_RULE[ASSUME `~(&0 <= (x:real))`] (MATCH_MP FLOAT_NORMALIZE_REAL xneq0)]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `((a:real) + b) - (a + c) = b - c`] THEN MATCH_MP_TAC FIXED_RD_NINF_ABS_ERROR THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN EXPAND_TAC "y" THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN EXPAND_TAC "e" THEN ASM_ARITH_TAC]);; (* -------------------------------------------------------------------------- *) (* Relative Error bounds *) (* -------------------------------------------------------------------------- *) (* unlike fixed point, we can put a bound on the abs error for all rounding *) (* modes ... *) let FLOAT_RD_NEAR_REL_ERROR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (rerror x (flround(fmt) To_near x)) <= fl_eps(fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[rerror] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(fulp (to_fformat fmt (greatest_e fmt x)) / &2) / abs(x)` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ABS_DIV] THEN SUBGOAL_THEN `&0 < abs(x)` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC FLOAT_RD_NEAR_ABS_ERR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `fulp (to_fformat fmt (greatest_e fmt x)) / &2 / (&(flr fmt) ipow (greatest_e(fmt) x))` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_INV THEN MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0] THEN ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]; REWRITE_TAC[REAL_INV_DIV] THEN SUBGOAL_THEN `&0 < (fulp (to_fformat fmt (greatest_e fmt x)) / &2)` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ARITH_TAC]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[fulp] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&(flr fmt) ipow greatest_e fmt x = inv (&(flr fmt) ipow (-- (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN ONCE_REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_INV_INV] THEN REWRITE_TAC[ARITH_RULE `(a:real) / b * c = (a * c) / b`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `((e:int) - p + &1) + (-- e) = &1 - p`] THEN REWRITE_TAC[fl_eps] THEN ARITH_TAC);; let FLOAT_RD_ZERO_REL_ERROR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (rerror x (flround(fmt) To_zero x)) <= &2 * fl_eps(fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[rerror] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(fulp (to_fformat fmt (greatest_e fmt x))) / abs(x)` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ABS_DIV] THEN SUBGOAL_THEN `&0 < abs(x)` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC FLOAT_RD_ZERO_ABS_ERR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `fulp (to_fformat fmt (greatest_e fmt x)) / (&(flr fmt) ipow (greatest_e(fmt) x))` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_INV THEN MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0] THEN ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]; REWRITE_TAC[REAL_INV_DIV] THEN SUBGOAL_THEN `&0 < (fulp (to_fformat fmt (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[fulp] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&(flr fmt) ipow greatest_e fmt x = inv (&(flr fmt) ipow (-- (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN ONCE_REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_INV_INV] THEN REWRITE_TAC[ARITH_RULE `(a:real) / b * c = (a * c) / b`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `((e:int) - p + &1) + (-- e) = &1 - p`] THEN REWRITE_TAC[fl_eps] THEN ARITH_TAC);; let FLOAT_RD_PINF_REL_ERROR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (rerror x (flround(fmt) To_pinf x)) <= &2 * fl_eps(fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[rerror] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(fulp (to_fformat fmt (greatest_e fmt x))) / abs(x)` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ABS_DIV] THEN SUBGOAL_THEN `&0 < abs(x)` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC FLOAT_RD_PINF_ABS_ERR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `fulp (to_fformat fmt (greatest_e fmt x)) / (&(flr fmt) ipow (greatest_e(fmt) x))` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_INV THEN MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0] THEN ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]; REWRITE_TAC[REAL_INV_DIV] THEN SUBGOAL_THEN `&0 < (fulp (to_fformat fmt (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[fulp] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&(flr fmt) ipow greatest_e fmt x = inv (&(flr fmt) ipow (-- (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN ONCE_REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_INV_INV] THEN REWRITE_TAC[ARITH_RULE `(a:real) / b * c = (a * c) / b`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `((e:int) - p + &1) + (-- e) = &1 - p`] THEN REWRITE_TAC[fl_eps] THEN ARITH_TAC);; let FLOAT_RD_NINF_REL_ERROR = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (rerror x (flround(fmt) To_ninf x)) <= &2 * fl_eps(fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN REWRITE_TAC[rerror] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(fulp (to_fformat fmt (greatest_e fmt x))) / abs(x)` THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_ABS_DIV] THEN SUBGOAL_THEN `&0 < abs(x)` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC FLOAT_RD_NINF_ABS_ERR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `fulp (to_fformat fmt (greatest_e fmt x)) / (&(flr fmt) ipow (greatest_e(fmt) x))` THEN CONJ_TAC THENL [ ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_INV THEN MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0] THEN ARITH_TAC; REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]]; REWRITE_TAC[REAL_INV_DIV] THEN SUBGOAL_THEN `&0 < (fulp (to_fformat fmt (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[MATCH_MP REAL_LE_DIV2_EQ thm]) THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ALL_TAC] THEN USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[fulp] THEN dump_flformat_conv `(greatest_e(fmt) x)` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&(flr fmt) ipow greatest_e fmt x = inv (&(flr fmt) ipow (-- (greatest_e fmt x)))` (fun thm -> REWRITE_TAC[thm]) THENL [ MATCH_MP_TAC IPOW_INV_NEG THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; ALL_TAC] THEN ONCE_REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_INV_INV] THEN REWRITE_TAC[ARITH_RULE `(a:real) / b * c = (a * c) / b`] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `((e:int) - p + &1) + (-- e) = &1 - p`] THEN REWRITE_TAC[fl_eps] THEN ARITH_TAC);; (* -------------------------------------------------------------------------- *) (* Delta bound *) (* -------------------------------------------------------------------------- *) let FLOAT_RD_NEAR_REL_DELTA = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (?(d:real). flround(fmt) To_near x = (&1 + d) * x /\ abs(d) <= fl_eps(fmt))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN EXISTS_TAC `((flround(fmt) To_near x) - x) / x` THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN SUBGOAL_THEN `!z. z / x * x = z` (fun thm -> REWRITE_TAC[thm]) THENL [ GEN_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[GSYM rerror] THEN MATCH_MP_TAC FLOAT_RD_NEAR_REL_ERROR THEN ASM_REWRITE_TAC[]);; let FLOAT_RD_ZERO_REL_DELTA = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (?(d:real). flround(fmt) To_zero x = (&1 + d) * x /\ abs(d) <= &2 * fl_eps(fmt))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN EXISTS_TAC `((flround(fmt) To_zero x) - x) / x` THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN SUBGOAL_THEN `!z. z / x * x = z` (fun thm -> REWRITE_TAC[thm]) THENL [ GEN_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[GSYM rerror] THEN MATCH_MP_TAC FLOAT_RD_ZERO_REL_ERROR THEN ASM_REWRITE_TAC[]);; let FLOAT_RD_PINF_REL_DELTA = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (?(d:real). flround(fmt) To_pinf x = (&1 + d) * x /\ abs(d) <= &2 * fl_eps(fmt))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN EXISTS_TAC `((flround(fmt) To_pinf x) - x) / x` THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN SUBGOAL_THEN `!z. z / x * x = z` (fun thm -> REWRITE_TAC[thm]) THENL [ GEN_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[GSYM rerror] THEN MATCH_MP_TAC FLOAT_RD_PINF_REL_ERROR THEN ASM_REWRITE_TAC[]);; let FLOAT_RD_NINF_REL_DELTA = prove(`!(fmt:flformat) (x:real). ~(x = &0) ==> (?(d:real). flround(fmt) To_ninf x = (&1 + d) * x /\ abs(d) <= &2 * fl_eps(fmt))`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "xneq0") THEN EXISTS_TAC `((flround(fmt) To_ninf x) - x) / x` THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN SUBGOAL_THEN `!z. z / x * x = z` (fun thm -> REWRITE_TAC[thm]) THENL [ GEN_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[GSYM rerror] THEN MATCH_MP_TAC FLOAT_RD_NINF_REL_ERROR THEN ASM_REWRITE_TAC[]);; (* -------------------------------------------------------------------------- *) (* Some useful identities, properties *) (* -------------------------------------------------------------------------- *) let FLOAT_GREATEST_E_OF = prove(`!(fmt:flformat) (e:int) (f:num). (flr fmt) EXP ((flp fmt) - 1) <= f /\ f < (flr fmt) EXP (flp fmt) ==> greatest_e(fmt) (&f * &(flr fmt) ipow (e - &(flp fmt) + &1)) = e`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["fraclo"; "frachi"]) THEN SUBGOAL_THEN `~(&f * &(flr fmt) ipow (e - &(flp fmt) + &1) = &0)` (LABEL_TAC "neq0") THENL [ REWRITE_TAC[REAL_ENTIRE] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC (ARITH_RULE `0 < f ==> ~(f = 0)`) THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `flr fmt EXP (flp fmt - 1)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXP_LT_0] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[FLFORMAT_RADIX_NE_0]; REWRITE_TAC[FLFORMAT_RADIX_IPOW_NEQ_0]]; ALL_TAC] THEN MATCH_MP_TAC (SPECL [`fmt:flformat`; `&f * &(flr fmt) ipow (e - &(flp fmt) + &1)`] FLOAT_GREATEST_E_UNIQUE) THEN CONJ_TAC THENL [ USE_THEN "neq0" (fun neq0 -> dump_ge_info neq0 "fe") THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[is_greatest_e] THEN CONJ_TAC THENL [ (* show lower bound *) MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(flr fmt EXP (flp fmt - 1)) * &(flr fmt) ipow (e - &(flp fmt) + &1)` THEN CONJ_TAC THENL [ REWRITE_TAC[GSYM FLFORMAT_PREC_IPOW_EQ_EXP] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) - &1 + e2 - e + &1 = e2`] THEN ARITH_TAC; SUBGOAL_THEN `&0 <= &f * &(flr fmt) ipow (e - &(flp fmt) + &1)` (LABEL_TAC "leq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ALL_TAC] THEN USE_THEN "leq0" (fun leq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x ==> abs(x) = x`) leq0]) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN (* show it is the greatest *) GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN (LABEL_TAC "epgte") THEN REWRITE_TAC[REAL_NOT_LE] THEN SUBGOAL_THEN `&0 <= &f * &(flr fmt) ipow (e - &(flp fmt) + &1)` (LABEL_TAC "leq0") THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ALL_TAC] THEN USE_THEN "leq0" (fun leq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x ==> abs(x) = x`) leq0]) THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&(flr fmt EXP flp fmt) * &(flr fmt) ipow (e - &(flp fmt) + &1)` THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LT_RMUL THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LT_0]; REWRITE_TAC[FLFORMAT_PREC_EXP_EQ_IPOW] THEN REWRITE_TAC[GSYM FLFORMAT_PREC_IPOW_EQ_EXP] THEN REWRITE_TAC[MATCH_MP (SPEC `&(flr fmt)` IPOW_ADD_EXP) (SPEC `fmt:flformat` FLFORMAT_RADIX_NE_0)] THEN REWRITE_TAC[ARITH_RULE `(e:int) + e2 - e + &1 = e2 + &1`] THEN MATCH_MP_TAC IPOW_MONOTONE_2 THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&1 < x ==> &1 <= x`) THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1]; ASM_ARITH_TAC]]);; let FLOAT_RD_LE_0 = prove(`!(fmt:flformat) (x:real) (m:roundmode). ~(x = &0) /\ &0 <= x ==> &0 <= (flround(fmt) m x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "xgeq0"]) THEN REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN SUBGOAL_THEN `&0 <= (fround (to_fformat fmt e) m y)` (LABEL_TAC "frgeq0") THENL [ MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN REWRITE_TAC[GSYM(ASSUME `greatest_e(fmt) x = e`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]);; let FLOAT_RD_LE_0_2 = prove(`!(fmt:flformat) (x:real) (m:roundmode). ~(x = &0) /\ ~(&0 <= x) ==> (flround(fmt) m x) <= &0`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "xlt0"]) THEN REWRITE_TAC[flround] THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN SUBGOAL_THEN `(fround (to_fformat fmt e) m y) <= &0` ASSUME_TAC THENL [ MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN REWRITE_TAC[GSYM(ASSUME `greatest_e(fmt) x = e`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(ASSUME `greatest_r(fmt) x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `--(x:real) + y <= &0 <=> &0 <= x + (-- y)`] THEN MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL [ REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ASM_ARITH_TAC]);; let FLOAT_RD_MONO = prove(`!(fmt:flformat) (x:real) (e:int) (m:roundmode). ~(x = &0) /\ &(flr fmt) ipow e <= abs(x) ==> &(flr fmt) ipow e <= abs(flround(fmt) m x)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "absxgeq"]) THEN SUBGOAL_THEN `&(flr fmt) ipow e <= &(greatest_m(fmt) x) * &(flr fmt) ipow (greatest_e(fmt) x)` (LABEL_TAC "lb1") THENL [ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(flr fmt) ipow (greatest_e(fmt) x)` THEN CONJ_TAC THENL [ USE_THEN "xneq0" (fun xneq0 -> dump_ge_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IPOW_MONOTONE_2 THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `&1 < x ==> &1 <= x`) THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[FLFORMAT_RADIX_LT_1]; ALL_TAC] THEN USE_THEN "xgebig2" (fun xgebig2 -> MATCH_MP_TAC xgebig2) THEN ASM_REWRITE_TAC[]; USE_THEN "xneq0" (fun xneq0 -> dump_gm_info xneq0 "x") THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `x = &1 * (x:real)`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]]; ALL_TAC] THEN REWRITE_TAC[flround] THEN LET_TAC THEN COND_CASES_TAC THENL [ SUBGOAL_THEN `&0 <= fround (to_fformat fmt e') m y` (LABEL_TAC "geq0_1") THENL [ MATCH_MP_TAC FIXED_RD_LE_0 THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `x < y ==> x <= (y:real)`) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM (ASSUME `greatest_r(fmt) x = y`)] THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e'`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM (ASSUME `greatest_r(fmt) x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= &m' * &(flr fmt) ipow e' + fround (to_fformat fmt e') m y` (LABEL_TAC "geq0") THENL [ MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ASM_REWRITE_TAC[]]; ALL_TAC] THEN USE_THEN "geq0" (fun geq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x ==> abs(x) = x`) geq0]) THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `x = x + &0`] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[]; (* x < 0 ... *) SUBGOAL_THEN `fround (to_fformat fmt e') m y <= &0` (LABEL_TAC "geq0_1") THENL [ MATCH_MP_TAC FIXED_RD_LE_0_2 THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `x < y ==> x <= (y:real)`) THEN USE_THEN "xneq0" (fun xneq0 -> dump_gr_info xneq0 "x") THEN REWRITE_TAC[GSYM (ASSUME `greatest_r(fmt) x = y`)] THEN REWRITE_TAC[GSYM (ASSUME `greatest_e(fmt) x = e'`)] THEN USE_THEN "xgreq" (fun xgreq -> REWRITE_TAC[xgreq]) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM (ASSUME `greatest_r(fmt) x = y`)] THEN MATCH_MP_TAC FLOAT_GREATEST_R_LE_0_2 THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `--(&m' * &(flr fmt) ipow e') + fround (to_fformat fmt e') m y <= &0` (LABEL_TAC "geq0") THENL [ REWRITE_TAC[ ARITH_RULE `--(x:real) + y <= &0 <=> &0 <= x + (--y)`] THEN MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL [ MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[FLFORMAT_RADIX_IPOW_LE_0]; ASM_ARITH_TAC]; ALL_TAC] THEN USE_THEN "geq0" (fun geq0 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `x <= &0 ==> abs(x) = -- x`) geq0]) THEN REWRITE_TAC[ARITH_RULE `-- ((-- (x:real)) + y) = x + (-- y)`] THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `x = x + &0`] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; hol-light/IEEE/ieee.hl000066400000000000000000000175531303454263000147230ustar00rootroot00000000000000(* ========================================================================== *) (* FLOATING POINT DEFINITIONS *) (* ========================================================================== *) (* needs "IEEE/common.hl";; *) (* needs "IEEE/fixed.hl";; *) (* needs "IEEE/float.hl";; *) (* ========================================================================== *) (* -------------------------------------------------------------------------- *) (* IEEE Floating point format *) (* -------------------------------------------------------------------------- *) (* Fix r:num > 1 and even, p:num > 1, emin:int, and emax:int >= emin. x is an *) (* IEEE floating point number if: *) (* *) (* -- x is a fixed point number in the format (r, p, emin) *) (* -- x is a floating point number in the format (r, p) and its normalized *) (* exponent e satisfies emin <= e <= emax *) (* -- x has absolute value >= r^(emax + 1) (all real numbers in this range *) (* are `absorbed' to +/- inf) *) (* *) (* This specification says nothing about NaNs. *) let is_valid_ieee_format = define `is_valid_ieee_format (r:num, p:num, emin:int, emax:int) = (1 < r /\ (EVEN r) /\ (1 < p) /\ (emin <= emax))`;; let ieee_format_typbij = new_type_definition "ieee_format" ("mk_ieee_format", "dest_ieee_format") (prove (`?(fmt:num#num#int#int). is_valid_ieee_format fmt`, EXISTS_TAC `(2:num, 2:num, (&0):int, (&0):int)` THEN REWRITE_TAC[is_valid_ieee_format] THEN ARITH_TAC));; let ieee_r = define `ieee_r (fmt:ieee_format) = (FST (dest_ieee_format fmt))`;; let ieee_p = define `ieee_p (fmt:ieee_format) = (FST (SND (dest_ieee_format fmt)))`;; let ieee_emin = define `ieee_emin (fmt:ieee_format) = (FST (SND (SND (dest_ieee_format fmt))))`;; let ieee_emax = define `ieee_emax (fmt:ieee_format) = (SND (SND (SND (dest_ieee_format fmt))))`;; let ieee_to_fformat = define `ieee_to_fformat (fmt:ieee_format) = (mk_fformat ((ieee_r fmt), (ieee_p fmt), (ieee_emin fmt)))`;; let ieee_to_flformat = define `ieee_to_flformat (fmt:ieee_format) = (mk_flformat ((ieee_r fmt), (ieee_p fmt)))`;; (* Largest ieee fp magnitude = f_max * r^(emax - p + 1) *) let max_ieee = define `max_ieee (fmt:ieee_format) = (&(((ieee_r fmt) EXP (ieee_p fmt)) - 1) * &(ieee_r fmt) ipow ((ieee_emax fmt) - &(ieee_p fmt) + &1))`;; (* If a real number's magnitude is larger than threshold, it gets absorbed *) (* into the +/- ieee infinity equivalence classes (depending on the real *) (* number's sign). The threshold is *) (* *) (* max_ieee + (ulp for the largest fp phase) *) (* *) (* where the ulp in the largest fp phase is r^(emax - p + 1). In terms of the *) (* floating point machine epsilon, this is *) (* *) (* max_ieee + 2 * machine_eps * r^emax *) (* *) let ieee_threshold = define `ieee_threshold (fmt:ieee_format) = (max_ieee(fmt) + &(ieee_r fmt) ipow ((ieee_emax fmt) - &(ieee_p fmt) + &1))`;; let is_ieee_pinf = define `is_ieee_pinf (fmt:ieee_format) (x:real) = ((ieee_threshold fmt) <= x)`;; let is_ieee_ninf = define `is_ieee_ninf (fmt:ieee_format) (x:real) = (x <= (-- (ieee_threshold fmt)))`;; let is_ieee = define `is_ieee (fmt:ieee_format) (x:real) = (is_fixed(ieee_to_fformat fmt) x \/ (is_float(ieee_to_flformat fmt) x /\ (ieee_emin fmt) <= (greatest_e(ieee_to_flformat fmt) x) /\ (greatest_e(ieee_to_flformat fmt) x) <= (ieee_emax fmt)) \/ is_ieee_pinf(fmt) x \/ is_ieee_ninf(fmt) x)`;; let ieee_exp = define `ieee_exp (fmt:ieee_format) (x:real) = (if abs(x) <= (finf(ieee_to_fformat fmt)) then (ieee_emin fmt) else (greatest_e(ieee_to_flformat fmt) x))`;; (* -------------------------------------------------------------------------- *) (* Rounding *) (* -------------------------------------------------------------------------- *) (* -- If x is within the fixed point number range, round to the closest fixed *) (* point number. *) (* -- If x is outside of the fixed point number range, but within the *) (* floating point number range, round to the closest floating point number *) (* (this could round to ieee +/- infinity) *) (* -- If x is outside of the threshold, the result depends on the rounding *) (* mode: *) (* -- round to nearest *) (* ans = x (= +/- ieee infinity, depending on the sign of x) *) (* -- round to zero *) (* ans = ieee fp number with largest magnitude and proper sign *) (* -- round to pinf *) (* ans = most negative ieee fp number if x is negative *) (* ans = x (= + ieee infinity) if x is positive *) (* -- round to ninf *) (* ans = most positive ieee fp number if x is positive *) (* ans = x (= - ieee infinity) if x is negative *) let ieee_round = define `((ieee_round (fmt:ieee_format) (To_near) (x:real) = (if (abs(x) <= (finf (ieee_to_fformat fmt))) then (fround(ieee_to_fformat fmt) To_near x) else if (abs(x) <= (ieee_threshold fmt)) then (flround(ieee_to_flformat fmt) To_near x) else x)) /\ (ieee_round (fmt:ieee_format) (To_zero) (x:real) = (if (abs(x) <= (finf (ieee_to_fformat fmt))) then (fround(ieee_to_fformat fmt) To_zero x) else if (abs(x) <= (ieee_threshold fmt)) then (flround(ieee_to_flformat fmt) To_zero x) else if (x > (ieee_threshold fmt)) then (max_ieee fmt) else (-- (max_ieee fmt)))) /\ (ieee_round (fmt:ieee_format) (To_pinf) (x:real) = (if (abs(x) <= (finf (ieee_to_fformat fmt))) then (fround(ieee_to_fformat fmt) To_pinf x) else if x <= (-- (max_ieee fmt)) then (-- (max_ieee fmt)) else (flround(ieee_to_flformat fmt) To_pinf x))) /\ (ieee_round (fmt:ieee_format) (To_ninf) (x:real) = (if (abs(x) <= (finf (ieee_to_fformat fmt))) then (fround(ieee_to_fformat fmt) To_ninf x) else if (max_ieee fmt) <= x then (max_ieee fmt) else (flround(ieee_to_flformat fmt) To_ninf x))))`;; (* -------------------------------------------------------------------------- *) (* Machine Epsilon *) (* -------------------------------------------------------------------------- *) (* Simple wrapper around floating point machine eps. *) let ieee_eps = define `ieee_eps (fmt:ieee_format) = (fl_eps (ieee_to_flformat fmt))`;; hol-light/IEEE/ieee_thms.hl000066400000000000000000000473371303454263000157610ustar00rootroot00000000000000(* ========================================================================== *) (* IEEE FLOATING POINT THEOREMS *) (* ========================================================================== *) (* needs "IEEE/common.hl";; *) (* needs "IEEE/fixed_thms.hl";; *) (* needs "IEEE/fixed.hl";; *) (* needs "IEEE/float_thms.hl";; *) (* needs "IEEE/float.hl";; *) (* needs "IEEE/ieee.hl";; *) (* -------------------------------------------------------------------------- *) (* Valid ieee_format properties *) (* -------------------------------------------------------------------------- *) let IEEE_FORMAT_SPLIT = TAUT `!(fmt:ieee_format). (dest_ieee_format fmt) = (FST (dest_ieee_format fmt), (FST (SND (dest_ieee_format fmt))), (FST (SND (SND (dest_ieee_format fmt)))), (SND (SND (SND (dest_ieee_format fmt)))))`;; let IEEE_FORMAT_VALID_IMP_RADIX_LT_1 = prove(`!(r:num) (p:num) (emin:int) (emax:int). ((is_valid_ieee_format (r,p,emin,emax)) ==> 1 < (FST (r,p,emin,emax)))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_ieee_format] THEN ARITH_TAC);; let IEEE_FORMAT_VALID_IMP_RADIX_EVEN = prove(`!(r:num) (p:num) (emin:int) (emax:int). ((is_valid_ieee_format (r,p,emin,emax)) ==> EVEN (FST (r,p,emin,emax)))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_ieee_format] THEN MESON_TAC[]);; let IEEE_FORMAT_VALID_IMP_PREC_LT_1 = prove(`!(r:num) (p:num) (emin:int) (emax:int). ((is_valid_ieee_format (r,p,emin,emax)) ==> 1 < (FST (SND (r,p,emin,emax))))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_ieee_format] THEN MESON_TAC[]);; let IEEE_FORMAT_VALID_IMP_EMIN_LE_EMAX = prove(`!(r:num) (p:num) (emin:int) (emax:int). ((is_valid_ieee_format (r,p,emin,emax)) ==> (FST (SND (SND (r,p,emin,emax)))) <= (SND (SND (SND (r,p,emin,emax)))))`, REPEAT GEN_TAC THEN REWRITE_TAC[is_valid_ieee_format] THEN MESON_TAC[]);; let IEEE_FORMAT_VALID = prove(`!(fmt:ieee_format). is_valid_ieee_format (dest_ieee_format fmt)`, REWRITE_TAC[ieee_format_typbij]);; let IEEE_FORMAT_RADIX_LT_1 = prove(`!(fmt:ieee_format). 1 < (ieee_r fmt)`, GEN_TAC THEN REWRITE_TAC[ieee_r] THEN ONCE_REWRITE_TAC[IEEE_FORMAT_SPLIT] THEN MATCH_MP_TAC IEEE_FORMAT_VALID_IMP_RADIX_LT_1 THEN REWRITE_TAC[IEEE_FORMAT_VALID]);; let IEEE_FORMAT_RADIX_LT_0 = prove(`!(fmt:ieee_format). 0 < (ieee_r fmt)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 0 < x`) THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_1]);; let IEEE_FORMAT_RADIX_NE_0 = prove(`!(fmt:ieee_format). ~(&(ieee_r fmt) = &0)`, GEN_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC (ARITH_RULE `0 < x ==> ~(x = 0)`) THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_0]);; let IEEE_FORMAT_RADIX_EVEN = prove(`!(fmt:ieee_format). EVEN (ieee_r fmt)`, GEN_TAC THEN REWRITE_TAC[ieee_r] THEN ONCE_REWRITE_TAC[IEEE_FORMAT_SPLIT] THEN MATCH_MP_TAC IEEE_FORMAT_VALID_IMP_RADIX_EVEN THEN REWRITE_TAC[IEEE_FORMAT_VALID]);; let IEEE_FORMAT_RADIX_LE_2 = prove(`!(fmt:ieee_format). 2 <= (ieee_r fmt)`, GEN_TAC THEN SUBGOAL_THEN `!x. ~(x = 0) /\ EVEN x ==> 2 <= x` MATCH_MP_TAC THENL [ GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["xneq0"; "evenx"]) THEN ASM_CASES_TAC `x = 0` THENL [ ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `x = 1` THENL [ USE_THEN "evenx" (fun evenx -> ASSUME_TAC (REWRITE_RULE[ASSUME `x = 1`] evenx)) THEN ASSUME_TAC (REWRITE_RULE[GSYM NOT_EVEN] (ARITH_RULE `ODD 1`)) THEN ASM_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[REWRITE_RULE[REAL_OF_NUM_EQ] IEEE_FORMAT_RADIX_NE_0] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_EVEN]);; let IEEE_FORMAT_PREC_LT_1 = prove(`!(fmt:ieee_format). 1 < (ieee_p fmt)`, GEN_TAC THEN REWRITE_TAC[ieee_p] THEN ONCE_REWRITE_TAC[IEEE_FORMAT_SPLIT] THEN MATCH_MP_TAC IEEE_FORMAT_VALID_IMP_PREC_LT_1 THEN REWRITE_TAC[IEEE_FORMAT_VALID]);; let IEEE_FORMAT_PREC_LE_1 = prove(`!(fmt:ieee_format). 1 <= (ieee_p fmt)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 1 <= x`) THEN REWRITE_TAC[IEEE_FORMAT_PREC_LT_1]);; let IEEE_FORMAT_PREC_LT_0 = prove(`!(fmt:ieee_format). 0 < (ieee_p fmt)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 0 < x`) THEN REWRITE_TAC[IEEE_FORMAT_PREC_LT_1]);; let IEEE_FORMAT_PREC_NE_0 = prove(`!(fmt:ieee_format). ~((ieee_p fmt) = 0)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `0 < n ==> ~(n = 0)`) THEN REWRITE_TAC[IEEE_FORMAT_PREC_LT_0]);; let IEEE_FORMAT_PREC_MINUS_1 = prove(`!(fmt:ieee_format). &0 <= (&(ieee_p fmt):int) - (&1:int)`, REWRITE_TAC[ARITH_RULE `&0 <= x:int - &1:int <=> &1 <= x`] THEN REWRITE_TAC[INT_OF_NUM_LE] THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> 0 < n`] THEN REWRITE_TAC[IEEE_FORMAT_PREC_LT_0]);; let IEEE_FORMAT_PREC_IPOW_EQ_EXP = prove(`!(fmt:ieee_format). &(ieee_r fmt) ipow (&(ieee_p fmt) - &1) = &((ieee_r fmt) EXP ((ieee_p fmt) - 1))`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_EQ_EXP_P THEN REWRITE_TAC[IEEE_FORMAT_PREC_LT_0]);; let IEEE_FORMAT_RADIX_IPOW_LE_0 = prove(`!(fmt:ieee_format) (e:int). &0 <= &(ieee_r fmt) ipow e`, REPEAT GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> &0 <= x`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_0]);; let IEEE_FORMAT_RADIX_IPOW_LT_0 = prove(`!(fmt:ieee_format) (e:int). &0 < &(ieee_r fmt) ipow e`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_0]);; let IEEE_FORMAT_RADIX_IPOW_NEQ_0 = prove(`!(fmt:ieee_format) (e:int). ~(&(ieee_r fmt) ipow e = &0)`, REPEAT GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `&0 < (x:real) ==> ~(x = &0)`) THEN MATCH_MP_TAC IPOW_LT_0 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_0]);; let IEEE_FORMAT_RADIX_IPOW_ADD_EXP = prove(`!(fmt:ieee_format) (u:int) (v:int). &(ieee_r fmt) ipow u * &(ieee_r fmt) ipow v = &(ieee_r fmt) ipow (u + v)`, REPEAT GEN_TAC THEN MATCH_MP_TAC IPOW_ADD_EXP THEN REWRITE_TAC[IEEE_FORMAT_RADIX_NE_0]);; let IEEE_FORMAT_EMIN_LE_EMAX = prove(`!(fmt:ieee_format). (ieee_emin fmt) <= (ieee_emax fmt)`, GEN_TAC THEN REWRITE_TAC[ieee_emin] THEN REWRITE_TAC[ieee_emax] THEN ONCE_REWRITE_TAC[IEEE_FORMAT_SPLIT] THEN MATCH_MP_TAC IEEE_FORMAT_VALID_IMP_EMIN_LE_EMAX THEN REWRITE_TAC[IEEE_FORMAT_VALID]);; let IEEE_FORMAT_TO_FFORMAT = prove(`!(fmt:ieee_format). (fr (ieee_to_fformat fmt)) = (ieee_r fmt) /\ (fp (ieee_to_fformat fmt)) = (ieee_p fmt) /\ (fe (ieee_to_fformat fmt)) = (ieee_emin fmt)`, GEN_TAC THEN REWRITE_TAC[ieee_to_fformat] THEN SUBGOAL_THEN `is_valid_fformat (ieee_r fmt, ieee_p fmt, ieee_emin fmt)` (fun thm -> ASSUME_TAC (REWRITE_RULE[fformat_typbij] thm)) THENL [ REWRITE_TAC[is_valid_fformat] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_1] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_EVEN] THEN REWRITE_TAC[IEEE_FORMAT_PREC_LT_0]; ALL_TAC] THEN REWRITE_TAC[fr; fp; fe] THEN ASM_REWRITE_TAC[]);; let IEEE_FORMAT_TO_FLFORMAT = prove(`!(fmt:ieee_format). (flr (ieee_to_flformat fmt)) = (ieee_r fmt) /\ (flp (ieee_to_flformat fmt)) = (ieee_p fmt)`, GEN_TAC THEN REWRITE_TAC[ieee_to_flformat] THEN SUBGOAL_THEN `is_valid_flformat (ieee_r fmt, ieee_p fmt)` (fun thm -> ASSUME_TAC (REWRITE_RULE[flformat_typbij] thm)) THENL [ REWRITE_TAC[is_valid_flformat] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_1] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_EVEN] THEN REWRITE_TAC[IEEE_FORMAT_PREC_LT_1]; ALL_TAC] THEN REWRITE_TAC[flr; flp] THEN ASM_REWRITE_TAC[]);; let IEEE_FORMAT_DISJ_EXP = prove(`!(fmt:ieee_format). (ieee_emin fmt) = (ieee_emax fmt) \/ (ieee_emin fmt) < (ieee_emax fmt)`, GEN_TAC THEN MATCH_MP_TAC (ARITH_RULE `(a:int) <= b ==> (a = b) \/ (a < b)`) THEN REWRITE_TAC[IEEE_FORMAT_EMIN_LE_EMAX]);; (* -------------------------------------------------------------------------- *) (* Useful arithmetic lemmas *) (* -------------------------------------------------------------------------- *) let IEEE_RADIX_EXP_PREC_LT_1 = prove(`!(fmt:ieee_format). 1 < (ieee_r fmt) EXP (ieee_p fmt)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM(SPEC `(ieee_p fmt)` EXP_ONE)] THEN REWRITE_TAC[EXP_MONO_LT] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_1] THEN REWRITE_TAC[IEEE_FORMAT_PREC_NE_0]);; (* -------------------------------------------------------------------------- *) (* Useful properties of special ieee fp values *) (* -------------------------------------------------------------------------- *) let IEEE_MAX_IEEE_LE_0 = prove(`!(fmt:ieee_format). &0 <= (max_ieee fmt)`, GEN_TAC THEN REWRITE_TAC[max_ieee] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ SUBGOAL_THEN `&(ieee_r fmt EXP ieee_p fmt - 1) = &(ieee_r fmt EXP ieee_p fmt) - &1` (fun thm -> REWRITE_TAC[thm]) THENL [ ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 1 <= x`) THEN REWRITE_TAC[IEEE_RADIX_EXP_PREC_LT_1]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `&0 <= x - &1 <=> &1 <= x`] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 1 <= x`) THEN REWRITE_TAC[IEEE_RADIX_EXP_PREC_LT_1]; REWRITE_TAC[IEEE_FORMAT_RADIX_IPOW_LE_0]]);; let IEEE_MAX_IEEE_IS_IEEE = prove(`!(fmt:ieee_format). (is_ieee(fmt) (max_ieee fmt))`, GEN_TAC THEN REWRITE_TAC[is_ieee] THEN DISJ2_TAC THEN DISJ1_TAC THEN REWRITE_TAC[is_float] THEN CONJ_TAC THENL [ EXISTS_TAC `(ieee_r fmt) EXP (ieee_p fmt) - 1` THEN EXISTS_TAC `(ieee_emax fmt)` THEN REWRITE_TAC[is_frac_and_exp] THEN CONJ_TAC THENL [ MATCH_MP_TAC (ARITH_RULE `1 < x ==> 0 < x - 1`) THEN REWRITE_TAC[IEEE_RADIX_EXP_PREC_LT_1]; ALL_TAC] THEN CONJ_TAC THENL [ REWRITE_TAC[IEEE_FORMAT_TO_FLFORMAT] THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> x - 1 < x`) THEN REWRITE_TAC[IEEE_RADIX_EXP_PREC_LT_1]; ALL_TAC] THEN REWRITE_TAC[MATCH_MP (ARITH_RULE `&0 <= x ==> abs(x) = x`) (SPEC `fmt:ieee_format` IEEE_MAX_IEEE_LE_0)] THEN REWRITE_TAC[IEEE_FORMAT_TO_FLFORMAT] THEN REWRITE_TAC[max_ieee]; ALL_TAC] THEN REWRITE_TAC[max_ieee] THEN SUBGOAL_THEN `greatest_e (ieee_to_flformat fmt) (&(ieee_r fmt EXP ieee_p fmt - 1) * &(ieee_r fmt) ipow (ieee_emax fmt - &(ieee_p fmt) + &1)) = (ieee_emax fmt)` (fun thm -> REWRITE_TAC[thm]) THENL [ REWRITE_TAC[GSYM IEEE_FORMAT_TO_FLFORMAT] THEN MATCH_MP_TAC FLOAT_GREATEST_E_OF THEN REWRITE_TAC[IEEE_FORMAT_TO_FLFORMAT] THEN (* this is harder than it should be ... *) CONJ_TAC THENL [ (* switch to real numbers for a second, it will be easier *) REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN SUBGOAL_THEN `&(ieee_r fmt EXP ieee_p fmt - 1) = &(ieee_r fmt EXP ieee_p fmt) - &1` (fun thm -> REWRITE_TAC[thm]) THENL [ ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN ONCE_REWRITE_TAC[GSYM (SPEC `(ieee_p fmt)` EXP_ONE)] THEN REWRITE_TAC[EXP_MONO_LE] THEN DISJ1_TAC THEN MATCH_MP_TAC (ARITH_RULE `1 < x ==> 1 <= x`) THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_1]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `x <= y - &1 <=> &1 <= y - x`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN SUBGOAL_THEN `(ieee_p fmt) = (ieee_p fmt) - 1 + 1` (fun thm -> GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) [thm]) THENL [ MATCH_MP_TAC (ARITH_RULE `1 <= n ==> n = n - 1 + 1`) THEN REWRITE_TAC[IEEE_FORMAT_PREC_LE_1]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[REAL_POW_1] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `x = (x:real) * &1`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `&1 = &1 * &1`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN CONJ_TAC THENL [ GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM (SPEC `(ieee_p fmt) - 1` REAL_POW_ONE)] THEN MATCH_MP_TAC REAL_POW_LE2 THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC (ARITH_RULE `&1 < x ==> &1 <= x`) THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LT_1]; ALL_TAC] THEN CONJ_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN REWRITE_TAC[ARITH_RULE `&1 <= x - &1 <=> &2 <= x`] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_LE_2]; MATCH_MP_TAC (ARITH_RULE `0 < x ==> x - 1 < x`) THEN REWRITE_TAC[EXP_LT_0] THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[IEEE_FORMAT_RADIX_NE_0]]; ALL_TAC] THEN REWRITE_TAC[IEEE_FORMAT_EMIN_LE_EMAX] THEN ARITH_TAC);; (* -------------------------------------------------------------------------- *) (* Absolute error theorems *) (* -------------------------------------------------------------------------- *) (* rounding to pinf / ninf requires tricky logic, so I'm ommitting them *) (* for now *) let IEEE_ROUND_NEAR_ABS_ERR = prove(`!(fmt:ieee_format) (x:real). abs(x) <= (ieee_threshold fmt) ==> abs(x - (ieee_round(fmt) To_near x)) <= &(ieee_r fmt) ipow ((ieee_exp(fmt) x) - &(ieee_p fmt) + &1) / &2`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absxthresh") THEN REWRITE_TAC[ieee_round] THEN COND_CASES_TAC THENL [ REWRITE_TAC[ieee_exp] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM IEEE_FORMAT_TO_FFORMAT] THEN REWRITE_TAC[GSYM fulp] THEN ONCE_REWRITE_TAC[ARITH_RULE `abs(x - y) = abs(y - x)`] THEN MATCH_MP_TAC FIXED_RD_NEAREST_ABS_ERROR THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[ieee_exp] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE `abs(x - y) = abs(y - x)`] THEN SUBGOAL_THEN `&(ieee_r fmt) ipow (greatest_e (ieee_to_flformat fmt) x - &(ieee_p fmt) + &1) = fulp (to_fformat (ieee_to_flformat fmt) (greatest_e (ieee_to_flformat fmt) x))` (fun thm -> REWRITE_TAC[thm]) THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FLFORMAT_TO_FFORMAT_2] THEN REWRITE_TAC[IEEE_FORMAT_TO_FLFORMAT]; ALL_TAC] THEN MATCH_MP_TAC FLOAT_RD_NEAR_ABS_ERR THEN MATCH_MP_TAC (ARITH_RULE `&0 < abs(x) ==> ~(x = &0)`) THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `finf (ieee_to_fformat fmt)` THEN CONJ_TAC THENL [ REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ASM_ARITH_TAC]]);; let IEEE_ROUND_ZERO_ABS_ERR = prove(`!(fmt:ieee_format) (x:real). abs(x) <= (ieee_threshold fmt) ==> abs(x - (ieee_round(fmt) To_zero x)) <= &(ieee_r fmt) ipow ((ieee_exp(fmt) x) - &(ieee_p fmt) + &1)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "absxthresh") THEN REWRITE_TAC[ieee_round] THEN COND_CASES_TAC THENL [ REWRITE_TAC[ieee_exp] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM IEEE_FORMAT_TO_FFORMAT] THEN REWRITE_TAC[GSYM fulp] THEN ONCE_REWRITE_TAC[ARITH_RULE `abs(x - y) = abs(y - x)`] THEN MATCH_MP_TAC FIXED_RD_ZERO_ABS_ERROR THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[ieee_exp] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE `abs(x - y) = abs(y - x)`] THEN SUBGOAL_THEN `&(ieee_r fmt) ipow (greatest_e (ieee_to_flformat fmt) x - &(ieee_p fmt) + &1) = fulp (to_fformat (ieee_to_flformat fmt) (greatest_e (ieee_to_flformat fmt) x))` (fun thm -> REWRITE_TAC[thm]) THENL [ REWRITE_TAC[fulp] THEN REWRITE_TAC[FLFORMAT_TO_FFORMAT_2] THEN REWRITE_TAC[IEEE_FORMAT_TO_FLFORMAT]; ALL_TAC] THEN MATCH_MP_TAC FLOAT_RD_ZERO_ABS_ERR THEN MATCH_MP_TAC (ARITH_RULE `&0 < abs(x) ==> ~(x = &0)`) THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `finf (ieee_to_fformat fmt)` THEN CONJ_TAC THENL [ REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ASM_ARITH_TAC]]);; (* -------------------------------------------------------------------------- *) (* Relative error theorems *) (* -------------------------------------------------------------------------- *) (* for r^emin <= |x| <= threshold (x is in the range of normalized fp *) (* numbers), round to near relative error bounded by the machine epsilon. *) (* This is basically the generalized float thm, but `lifted' to ieee. *) let IEEE_ROUND_NEAR_REL_ERR = prove(`!(fmt:ieee_format) (x:real). ~(abs(x) <= (finf (ieee_to_fformat fmt))) /\ abs(x) <= (ieee_threshold fmt) ==> (rerror x (ieee_round(fmt) To_near x)) <= ieee_eps(fmt)`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absxlow"; "absxhi"]) THEN REWRITE_TAC[ieee_round] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ieee_eps] THEN MATCH_MP_TAC FLOAT_RD_NEAR_REL_ERROR THEN MATCH_MP_TAC (ARITH_RULE `&0 < abs(x) ==> ~(x = &0)`) THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `finf (ieee_to_fformat fmt)` THEN CONJ_TAC THENL [ REWRITE_TAC[finf] THEN REWRITE_TAC[FFORMAT_RADIX_IPOW_LT_0]; ASM_ARITH_TAC]);; (* for |x| <= r^emin (x is in the range of subnormal fp numbers), round to *) (* near relative error bounded by 1 (and this is the tightest upper bound). *) (* Basically the fixed thm, but `lifted' to ieee. *) let IEEE_ROUND_NEAR_REL_ERR = prove(`!(fmt:ieee_format) (x:real). (abs(x) <= (finf (ieee_to_fformat fmt))) /\ ~(x = &0) ==> (rerror x (ieee_round(fmt) To_near x)) <= &1`, REPEAT GEN_TAC THEN DISCH_THEN (LABEL_CONJUNCTS_TAC ["absxlow"; "absxhi"]) THEN REWRITE_TAC[ieee_round] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FIXED_RD_NEAREST_REL_ERROR THEN ASM_REWRITE_TAC[]);; (* -------------------------------------------------------------------------- *) (* Delta bounds *) (* -------------------------------------------------------------------------- *) hol-light/IEEE/make.ml000066400000000000000000000006521303454263000147260ustar00rootroot00000000000000(* -------------------------------------------------------------------------- *) (* Load this file to get all theorems and formalizations. *) (* -------------------------------------------------------------------------- *) loadt "IEEE/common.hl";; loadt "IEEE/fixed.hl";; loadt "IEEE/fixed_thms.hl";; loadt "IEEE/float.hl";; loadt "IEEE/float_thms.hl";; loadt "IEEE/ieee.hl";; loadt "IEEE/ieee_thms.hl";; hol-light/IsabelleLight/000077500000000000000000000000001303454263000154555ustar00rootroot00000000000000hol-light/IsabelleLight/README000066400000000000000000000064651303454263000163500ustar00rootroot00000000000000 ========================================================================= Isabelle Light Isabelle/Procedural style additions and other user-friendly shortcuts. Petros Papapanagiotou, Jacques Fleuriot Center of Intelligent Systems and their Applications University of Edinburgh 2009-2012 ========================================================================= This README contains some brief information on the usage of this system. Please refer to the paper [1] for a general description as well as the comments in the code for details on each available function. HOW TO LOAD: ------------ loads "IsabelleLight/make.ml";; LIST OF FILES: -------------- make.ml : HOL Light style makefile with some examples. isalight.ml : Main loader. support.ml : Support functions and various shortcuts. new_tactics.ml : Various tactics to facilitate procedural-style users. meta_rules.ml : Main emulation of Isabelle's natural deduction rules and tactics. BRIEF DESCRIPTION OF AVAILABLE FUNCTIONS AND TACTICS: (refer to the comments in the files for more information) --------------------------------------------------------------------------- e_all tac : Same as "e" but applies tactic tac to all subgoals. ROTATE_TAC : Rotates the assumptions once. ROTATE_N_TAC n : Rotates the assumptions n times. DRULE_N_TAC n rule : Applies rule to nth assumption and deletes it. FRULE_N_TAC n rule : Applies rule to nth assumption and adds result as a new assumption. FRULE_MN_TAC m n rule : Applies rule (such as MP) on mth and nth assumptions. REWRITE_ASM_TAC thl : Rewrites assumptions. PURE_, ONCE_ and PURE_ONCE_ versions also available. FULL_REWRITE_TAC thl : Rewrites assumptions then goal. FULL_SIMP_TAC thl : SIMP_TAC then FULL_REWRITE_TAC. X_MATCH_CHOOSE_TAC tm : X_CHOOSE_TAC with type matching. gen_case_tac : Applies case_tac to leading universally quantified variable in the goal. LIST OF ISABELLE STYLE TACTICS AND RULES: (refer to the comments in the files and the paper [1] for more information) --------------------------------------------------------------------------- TACTICS: -------- simp assumption case_tac subgoal_tac cut_tac rule erule drule frule rule_tac erule_tac drule_tac frule_tac RULES: ------ conjI conjunct1 conjunct2 conjE disjI1 disjI2 disjE impI impE mp iffI iffE allE exI notI notE EXTRAS: ------- meta_assumption mvs : Use this for assumption matching with meta-variables. exE : Use this tactic for existential elimination. allI : Use this tactic for forall introduction. meson : Shortcut to automated procedure MESON. erulen : Use these to match numbered assumptions. drulen frulen erulen_tac drulen_tac frulen_tac [1] Papapanagiotou, P. and Fleuriot, J.: An Isabelle-Like Procedural Mode for HOL Light. Logic for Programming, Artificial Intelligence, and Reasoning, # pp 565-580, Springer (2010) hol-light/IsabelleLight/isalight.ml000066400000000000000000000022541303454263000176160ustar00rootroot00000000000000(* ========================================================================= *) (* Isabelle Light *) (* Isabelle/Procedural style additions and other user-friendly shortcuts. *) (* *) (* Petros Papapanagiotou, Jacques Fleuriot *) (* Center of Intelligent Systems and their Applications *) (* University of Edinburgh *) (* 2009-2012 *) (* ========================================================================= *) (* FILE : isahol.ml *) (* DESCRIPTION : Main loader. *) (* LAST MODIFIED: December 2010 *) (* ========================================================================= *) let paths = [".";"$/IsabelleLight"] in map (fun st -> load_on_path paths st) ["support.ml"; "new_tactics.ml"; "meta_rules.ml"];; hol-light/IsabelleLight/make.ml000066400000000000000000000032451303454263000167300ustar00rootroot00000000000000(* ========================================================================= *) (* Isabelle Light *) (* Isabelle/Procedural style additions and other user-friendly shortcuts. *) (* *) (* Petros Papapanagiotou, Jacques Fleuriot *) (* Center of Intelligent Systems and their Applications *) (* University of Edinburgh *) (* 2009-2012 *) (* ========================================================================= *) (* FILE : make.ml *) (* DESCRIPTION : Makefile. Simply calls the loader but it was written to *) (* match the rest of HOL Light's packages and for future use. *) (* LAST MODIFIED: October 2010 *) (* ========================================================================= *) loads "IsabelleLight/isalight.ml";; (* Some examples: *) prove( `p/\q==>q`, rule impI THEN erule conjE THEN assumption);; prove (`(!x. P x) ==> P (y+1)`, rule impI THEN erule_tac [`a`,`y+1`] allE THEN assumption);; prove (`p\/q==>q\/p`, rule impI THEN erule disjE THENL [ rule disjI2 ; rule disjI1 ] THEN assumption);; prove (`p/\q ==> p\/q`, rule impI THEN rule disjI1 THEN drule conjunct1 THEN assumption);; prove (`p/\q ==> p\/q`, DISCH_TAC THEN DISJ1_TAC THEN FIRST_ASSUM(CONJUNCTS_THEN ACCEPT_TAC));; prove (`P x /\ x =0 ==> P 0`, rule impI THEN erule conjE THEN simp[]);; hol-light/IsabelleLight/meta_rules.ml000066400000000000000000001551071303454263000201600ustar00rootroot00000000000000(* ========================================================================= *) (* Isabelle Light *) (* Isabelle/Procedural style additions and other user-friendly shortcuts. *) (* *) (* Petros Papapanagiotou, Jacques Fleuriot *) (* Center of Intelligent Systems and their Applications *) (* University of Edinburgh *) (* 2009-2012 *) (* ========================================================================= *) (* FILE : meta_rules.ml *) (* DESCRIPTION : Meta rules is a formalisation used to accommodate *) (* Isabelle's inference rules in HOL Light.The technical *) (* details are described in the comments that follow. *) (* Isabelle rule application tactics (rule, erule, etc.) have *) (* been defined to work with meta rules. *) (* We have not been able to accommodate first order rules *) (* allI and exE. We also make use of metavariables which are *) (* restricted by the limitations of term_unify *) (* (ie. no HO unification and no type instantiation). *) (* LAST MODIFIED: October 2012 *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* ----------------------- META-LEVEL IMPLICATION -------------------------- *) (* ------------------------------------------------------------------------- *) (* Emulation of meta-level implication at the object level. *) (* This is purely for syntax and parsing purposes. It solves a number of *) (* problems when parsing theorems as meta-rules (see below). *) (* It is applied at the logic level only for transparency. *) (* ------------------------------------------------------------------------- *) (* Thanks to Phil Scott for the suggestion. *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* Syntax definition. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("===>",(4,"right"));; let is_mimp = is_binary "===>";; let dest_mimp = dest_binary "===>";; (* ------------------------------------------------------------------------- *) (* Logic definition: Equivalent to object-level implication. *) (* ------------------------------------------------------------------------- *) let MIMP_DEF = new_basic_definition `(===>) = \p q. p ==> q`;; (* ------------------------------------------------------------------------- *) (* CONV, RULE and TACTIC to get rid of meta-level implication in proofs. *) (* ------------------------------------------------------------------------- *) let MIMP_TO_IMP_CONV = BETA_RULE o (PURE_REWRITE_CONV [MIMP_DEF]);; let MIMP_TO_IMP_RULE = BETA_RULE o (PURE_REWRITE_RULE [MIMP_DEF]);; let MIMP_TAC = (PURE_REWRITE_TAC [MIMP_DEF]) THEN BETA_TAC;; (* ------------------------------------------------------------------------- *) (* Equivalent of TAUT after getting rid of meta-level implication. *) (* Helps prove simple propositional meta-rules easily. *) (* ------------------------------------------------------------------------- *) let MTAUT tm = let th = MIMP_TO_IMP_CONV tm in EQ_MP (SYM th) ((TAUT o snd o dest_iff o concl) th);; (* ------------------------------------------------------------------------- *) (* RULE to replace implication by meta-level implication to easily create *) (* meta-theorems from normal theorems. *) (* ------------------------------------------------------------------------- *) let MIMP_THM = MTAUT `(p==>q) <=> (p===>q)`;; let MIMP_RULE = PURE_REWRITE_RULE[MIMP_THM];; (* ------------------------------------------------------------------------- *) (* UNDISCH for meta-level implication. *) (* Also gets rid of meta-level implication in the undischarged term. *) (* ------------------------------------------------------------------------- *) let MUNDISCH th = let mth = BETA_RULE (AP_THM (AP_THM MIMP_DEF `p:bool`) `q:bool`) in let th = PURE_ONCE_REWRITE_RULE [mth] th in try let undisch_tm = (rand o rator o concl) th in PROVE_HYP ((UNDISCH o snd o EQ_IMP_RULE o MIMP_TO_IMP_CONV) undisch_tm) (UNDISCH th) with Failure _ -> failwith "MUNDISCH";; (* ------------------------------------------------------------------------- *) (* -------------------------- HELPFUL FUNCTIONS ---------------------------- *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* REV_PART_MATCH_I: term list -> (term -> term) -> thm -> term *) (* -> instantiation *) (* Does a reverse PART_MATCH and returns the resulting instantiation. *) (* Avoids instantiating any of the given variables/constants. *) (* Does not apply SPEC_ALL like PART_MATCH does. *) (* ------------------------------------------------------------------------- *) (* The original PART_MATCH matches a term to part of a theorem so that we can*) (* instantiate that part with the term. *) (* The reverse used here, matches the part of the theorem with the term so *) (* that the term can be instantiated with the part of the theorem. *) (* We use this in cases such as erule where we want (part of) an assumption *) (* to match a premise of the rule. We need the instantiation of the rule when*) (* matched to the assumption (thm) and not the other way around. *) (* ------------------------------------------------------------------------- *) let REV_PART_MATCH_I = let rec match_bvs t1 t2 acc = try let v1,b1 = dest_abs t1 and v2,b2 = dest_abs t2 in let n1 = fst(dest_var v1) and n2 = fst(dest_var v2) in let newacc = if n1 = n2 then acc else insert (n1,n2) acc in match_bvs b1 b2 newacc with Failure _ -> try let l1,r1 = dest_comb t1 and l2,r2 = dest_comb t2 in match_bvs l1 l2 (match_bvs r1 r2 acc) with Failure _ -> acc in fun avoids partfn th -> let bod = concl th in let pbod = partfn bod in let lconsts = union avoids (intersect (frees (concl th)) (freesl(hyp th))) in fun tm -> let bvms = match_bvs pbod tm [] in let atm = deep_alpha bvms tm in term_match lconsts atm (partfn bod) ;; (* whereas in PART_MATCH we do it the other way around *) (* ------------------------------------------------------------------------- *) (* term_to_asm_match : term list -> term -> (string * thm) list -> *) (* (string * thm) list * (thm * instantiation) *) (* ------------------------------------------------------------------------- *) (* term_to_asm_match tries to match key to one of the assumptions using *) (* REV_PART_MATCH_I. Returns the new assumption list (with the matching *) (* assumption removed), the matching assumption and the resulting *) (* instantiation used. *) (* ------------------------------------------------------------------------- *) (* It is doubtful that this has practical use outside the Xrule_tac's. *) (* It is used in erule, drule and frule to match the major premise to one of *) (* the assumptions. *) (* ------------------------------------------------------------------------- *) let rec (term_to_asm_match: term list -> term -> (string * thm) list -> (string * thm) list * (thm * instantiation)) = fun avoids key asms -> if (asms = []) then failwith ("No assumptions match `" ^ (string_of_term key) ^ "`!") else try let asm = (snd o hd) asms in let i = REV_PART_MATCH_I avoids I asm key in (tl asms),(asm,i) with Failure _ -> let res,inst = term_to_asm_match avoids key (tl asms) in ((hd asms)::res),inst;; (* ------------------------------------------------------------------------- *) (* term_to_asm_n_match : term list -> term -> (string * thm) list -> int -> *) (* (string * thm) list * (thm * instantiation) *) (* ------------------------------------------------------------------------- *) (* Same as term_to_asm_match but only tries to match nth assumption. *) (* ------------------------------------------------------------------------- *) (* It is doubtful that this has practical use outside the Xrulen_tac's. *) (* It is used in erulen, drulen and frulen to match the major premise to one *) (* of the assumptions. *) (* ------------------------------------------------------------------------- *) let rec (term_to_asm_n_match: term list -> term -> (string * thm) list -> int -> (string * thm) list * (thm * instantiation)) = fun avoids key asms n -> if (asms = []) then failwith "No such assumption found!" else try match n with 0 -> let asm = (snd o hd) asms in let i = REV_PART_MATCH_I avoids I asm key in (tl asms),(asm,i) | _ -> let re_asms,m = term_to_asm_n_match avoids key (tl asms) (n-1) in (hd asms)::re_asms,m with Failure _ -> failwith ("Assumption `" ^ ((string_of_term o concl o snd o hd) asms) ^ "` doesn't match `" ^ (string_of_term key) ^ "`!");; (* gmm is not to be used until qed is updated *) (* We need a MDISCH for that... *) let gmm t = let fvs = sort (<) (map (fst o dest_var) (frees t)) in (if fvs <> [] then let errmsg = end_itlist (fun s t -> s^", "^t) fvs in warn true ("Free variables in goal: "^errmsg) else ()); let rec split_mimp = fun tm -> if (is_mimp tm) then let (a,b) = dest_mimp tm in let (asms, concl) = split_mimp b in (a::asms,concl) else ([],tm) in set_goal (split_mimp t);; (* ------------------------------------------------------------------------- *) (* gm : term -> goalstack *) (* This is used to set a term containing meta-level implication as a goal. *) (* ------------------------------------------------------------------------- *) (* (+) Uses g to set the goal then MIMP_TAC to get rid of meta-implication. *) (* (+) Note that if the goal has normal implication it gets discharged as *) (* well. This will be fixed when gmm is fixed. *) (* ------------------------------------------------------------------------- *) let gm t = g t ; e (MIMP_TAC THEN REPEAT DISCH_TAC);; (* ------------------------------------------------------------------------- *) (* Isabelle's natural deduction rules as thms with meta-level implication. *) (* ------------------------------------------------------------------------- *) let conjI = MTAUT `p===>q===>p/\q`;; let conjunct1 = MTAUT `p/\q===>p`;; let conjunct2 = MTAUT `p/\q===>q`;; let conjE = MTAUT `p/\q===>(p===>q===>r)===>r`;; let disjI1 = MTAUT `p===>p\/q`;; let disjI2 = MTAUT `q===>p\/q`;; let disjE = MTAUT `p\/q===>(p===>r)===>(q===>r)===>r`;; let impI = MTAUT `(p===>q)===>(p==>q)`;; let impE = MTAUT `(p==>q)===>p===>(q===>r)===>r`;; let mp = MTAUT `(p==>q)===>(p===>q)`;; let iffI = MTAUT `(a===>b)===>(b===>a)===>(a<=>b)`;; let iffE = MTAUT `(a<=>b)===>((a==>b) ===> (b==>a) ===> r) ===> r`;; let allE = prove( `(!x:A. P x) ===> (P (a:A) ===> (r:bool)) ===> r` , MIMP_TAC THEN MESON_TAC[]);; let exI = prove (`P (a:A)===> ?x:A. P x`, MIMP_TAC THEN DISCH_TAC THEN (EXISTS_TAC `a:A`) THEN (FIRST_ASSUM ACCEPT_TAC));; let notI = MTAUT `(p===>F)===> ~p`;; let notE = MTAUT `~a ===> a ===> r`;; (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* ------------------------ META-RULES START HERE!! ------------------------ *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* meta_rule (type) *) (* The representation of an Isabelle inference rule in HOL Light. *) (* ------------------------------------------------------------------------- *) (* term = The conclusion of the inference rule. *) (* goal list = The premises represented as "meta-subgoals". *) (* thm = The representation of the rule as a theorem used for justification. *) (* *) (* (+) thm must be of the form H1,H2,...,Hn |- G *) (* (+) H1--Hn must be represented as "meta-subgoals" in any order (1) *) (* (+) [|P;Q|] ==> R (in Isabelle notation) is translated as "meta-subgoal" *) (* P,Q ?- R and as P==>Q==>R in the justification theorem. *) (* (+) The form of the premises (assumption order etc) must be kept in the *) (* justification theorem (see example in (2)) *) (* (+) Use "mk_meta_rule" to create proper meta rules from theorems. *) (* ------------------------------------------------------------------------- *) (* (1) Since we use PROVE_HYP instead of MP to justify rule, erule etc, the *) (* order of the subgoals is no longer essential. *) (* (2) Example: conjE *) (* In Isabelle: P/\Q [|P;Q|]==> R *) (* ------------------ *) (* R *) (* *) (* As a meta rule (briefly - see conjEm below for full notation): *) (* `R`, - conclusion *) (* [ - premises list *) (* [ ], `P/\Q` ; *) (* [`P`;`Q`], `R` *) (* ], *) (* `P/\Q, P==>Q==>R |- R` - justification theorem *) (* *) (* The form of the premises must be preserved in the justification theorem. *) (* ie. using `P/\Q, Q==>P==>R |- R` or `Q/\P, P==>Q==>R |- R` as a *) (* justification theorem would break the justification and result in an *) (* "invalid tactic" exception. *) (* ------------------------------------------------------------------------- *) type meta_rule = term * goal list * thm;; let print_meta_rule: meta_rule->unit = fun (c,glist,j) -> print_term c ; hd (map (print_newline () ; print_goal) glist) ; print_newline () ; print_thm j ; print_newline ();; (* ------------------------------------------------------------------------- *) (* inst_meta_rule: instantiation -> meta_rule -> meta_rule *) (* ------------------------------------------------------------------------- *) (* Instantiates all parts of meta_rules based on an instantiation. *) (* ------------------------------------------------------------------------- *) let inst_meta_rule:instantiation->meta_rule->meta_rule = fun inst (c,glist,j) -> instantiate inst c, map (inst_goal inst) glist, INSTANTIATE_ALL inst j;; (* ------------------------------------------------------------------------- *) (* meta_rule_frees: meta_rule -> term list *) (* ------------------------------------------------------------------------- *) (* Returns the list of free variables (or Isabelle ?metavariables) in a *) (* meta_rule. *) (* ------------------------------------------------------------------------- *) let meta_rule_frees: meta_rule -> term list = fun (c,glist,l) -> itlist (union o gl_frees) glist (union (frees c) (thm_frees l));; (* ------------------------------------------------------------------------- *) (* meta_rule_mk_primed_vars_I: term_list -> meta_rule -> *) (* meta_rule * instantiation *) (* ------------------------------------------------------------------------- *) (* Applies mk_primed_var to all the free variables in a meta_rule. *) (* Returns the new meta_rule and the instantiation for the variable renaming.*) (* ------------------------------------------------------------------------- *) let meta_rule_mk_primed_vars_I: term list -> meta_rule -> meta_rule * instantiation = fun avoids r -> let fvars = meta_rule_frees r in let rec mk_primed_l = fun avoids vars -> match vars with [] -> null_inst | v::rest -> let new_v = mk_primed_var avoids v in compose_insts (term_match [] v new_v) (mk_primed_l (new_v::avoids) rest) in let inst = mk_primed_l avoids fvars in (inst_meta_rule inst r),inst;; (* ------------------------------------------------------------------------- *) (* meta_rule_mk_primed_vars: term_list -> meta_rule -> meta_rule *) (* ------------------------------------------------------------------------- *) (* Applies mk_primed_var to all the free variables in a meta_rule. *) (* ------------------------------------------------------------------------- *) let meta_rule_mk_primed_vars: term list -> meta_rule -> meta_rule = fun avoids r -> fst (meta_rule_mk_primed_vars_I avoids r);; (* ------------------------------------------------------------------------- *) (* inst_meta_rule_vars: *) (* (term * term) list -> meta_rule -> term list -> meta_rule *) (* ------------------------------------------------------------------------- *) (* Instantiates the free variables in a meta_rule. Also renames the *) (* uninstantiated variables so as to avoid clashes with free variables and *) (* constants in the given goal. *) (* Essentially it prepares the meta_rule for use with any of xrulem_tac. *) (* ------------------------------------------------------------------------- *) (* (+) By instlist we mean the list of variables and instantiation pairs *) (* given by the user. *) (* (+) First we check the terms given as variables in the instlist. We must *) (* check if they are indeed variables and if they are free variables in the *) (* given meta_rule. *) (* (+) "match_var" is used to compare a variable with a free variable in the *) (* meta_rule. *NOTE* that a variable is accepted as long as it can match a *) (* free variable in the meta_rule allowing only type instantiation. *) (* (+) "mcheck_var" does the is_var check and tries to find a match with the *) (* meta_rule's free vars (rfrees) using match_var. *) (* (+) "mcheck_gvar" tries to match variables on the rhs of each instlist *) (* pair with the free variables in the goal so as to instantiate their types *) (* properly. This is done to free the user from declaring the variable types.*) (* (+) Given variables are replaced with the meta_rule variables (effectively*) (* achieving type instantiation) and later recombined into the instlist. *) (* (+) Secondly, we rename all the variables in the meta_rule using *) (* "meta_rule_mk_primed_vars_I" so that they don't match any of the free *) (* variables in the goal. *) (* (+) We use the same instantiation to rename instlist variables so that *) (* they properly match the new variables of the meta_rule. *) (* (+) "new_instlist" should contain variables that fully match primed *) (* variables in the meta_rule (new_r). *) (* (+) For each instlist pair, we find the instantiation that allows the *) (* variable to be substituted by the given term. *NOTE* that no check is *) (* made on that term. It is the user's responsibility to give a sensible, *) (* matching and correctly typed term. *) (* (+) All the instantiations produced by the instlist are composed into one *) (* which is then applied to new_r to give the result. *) (* ------------------------------------------------------------------------- *) let inst_meta_rule_vars: (term * term) list -> meta_rule -> term list -> meta_rule = fun instlist r gfrees -> let rfrees = meta_rule_frees r in let vars,subs = List.split instlist in let match_var = fun tm1 tm2 -> let inst = try term_match [] tm1 tm2 with Failure _ -> [],[tm2,tm1],[] in match inst with [],[],_ -> tm2 | _ -> failwith "match_var: no match" in let mcheck_var = fun tm -> if (not (is_var tm)) then failwith ("inst_meta_rule_vars: `" ^ string_of_term tm ^ "` is not a variable") else try list_match_first (match_var tm) rfrees with Failure _ -> failwith ("inst_meta_rule_vars: `" ^ string_of_term tm ^ "` could not be found in the meta_rule") in let mcheck_gvar = fun var -> try let mvar = list_match_first (match_var var) gfrees in term_match [] var mvar with Failure _ -> warn true ("inst_meta_rule_vars: `" ^ string_of_term var ^ "` could not be found in the goal") ; null_inst in let new_r,prim_inst = meta_rule_mk_primed_vars_I gfrees r in let new_vars = map ((instantiate prim_inst) o mcheck_var) vars in let subs_vars = flat (map frees subs) in let new_subs_inst = itlist compose_insts (map mcheck_gvar subs_vars) null_inst in let new_subs = map (instantiate new_subs_inst) subs in let new_instlist = List.combine new_vars new_subs in let mk_inst = fun t1,t2 -> term_match [] t1 t2 in let inst = itlist compose_insts (map mk_inst new_instlist) null_inst in let result_r = inst_meta_rule inst new_r in result_r;; (* ------------------------------------------------------------------------- *) (* mk_meta_rule: thm -> meta_rule *) (* Creates a meta_rule out of a theorem. *) (* Theorem must be of the form |- H1 ===> H2 ===> ...===> Hn ===> C *) (* "===>" is the emulation of meta-level implication so this corresponds to *) (* [|H1;H2;...;Hn|] ==> C in Isabelle) *) (* For each Hi that is a meta-level implication, a "meta_subgoal" is created.*) (* ------------------------------------------------------------------------- *) (* (+) undisch_premises uses MUNDISCH to handle meta-level implication. All *) (* the premises are undischarged. It returns the list of premises paired *) (* with the resulting theorem. Note that MUNDISCH also removes meta-level *) (* implication from the undischarged premises. *) (* (+) "mk_meta_subgoal" creates a meta_subgoal from a term. If the term is *) (* an implication, the lhs is added as an assumption/premise of the *) (* meta_subgoal and mk_meta_subgoal is called recursively for the rhs. *) (* (+) The conclusion of the undischarged theorem is the first part of the *) (* produced meta_rule. *) (* (+) mk_meta_subgoal creates the meta_subgoals for all the premises. They *) (* form the second part of the meta_rule. *) (* (+) The theorem itself is used as the justification theorem, after *) (* eliminating any remaining meta-level implication in the conclusion. *) (* In theory, the conclusion should never have any remaining meta-level *) (* implications. We're just making sure because we don't want any meta-level *) (* implications to appear in our new subgoals. *) (* ------------------------------------------------------------------------- *) let (mk_meta_rule: thm -> meta_rule) = fun thm -> let rec undisch_premises th = if is_mimp (concl th) then let rest,res_th = undisch_premises (MUNDISCH th) in (rand(rator(concl th)))::rest,res_th else [],th in let (prems,thm) = undisch_premises thm in let rec mk_meta_subgoal tm = ( if (is_mimp(tm)) then let (a,c) = dest_mimp tm in let (prems,concl) = mk_meta_subgoal c in ("",ASSUME a)::prems,concl else [],tm ) in concl thm,map mk_meta_subgoal prems,MIMP_TO_IMP_RULE thm;; (* ------------------------------------------------------------------------- *) (* mk_meta_rule_old: thm -> meta_rule *) (* Creates a meta_rule out of a theorem. === DEPRECATED === *) (* Theorem must be of the form H1,H2,...,Hn |- C *) (* If Hi is of the form Hi1==>Hi2==>...==>Hik==>HiC then it is treated as *) (* Hi1,Hi2,...,Hik ?- HiC (or "meta-level" implication *) (* [|Hi1;Hi2;...;Hik|] ==> HiC in Isabelle) and the corresponding *) (* meta_subgoal is created. *) (* ------------------------------------------------------------------------- *) (* --As a result you CANNOT have rules with implication in their premises!-- *) (* (You'll have to use mk_elim_meta_rule or build the meta_rule yourself.) *) (* ------------------------------------------------------------------------- *) (* (+) The theorem is destroyed to its hypothesis list and its conclusion. *) (* The conclusion is the first part of the meta_rule. *) (* (+) "mk_meta_subgoal" creates a meta_subgoal from a term. If the term is *) (* an implication, the lhs is added as an assumption/premise of the *) (* meta_subgoal and mk_meta_subgoal is called recursively for the rhs. *) (* (+) The theorem itself is used as the justification theorem. *) (* ------------------------------------------------------------------------- *) (* Deprecated. New mk_meta_rule uses meta-level implication. *) (* Kept until new mk_meta_rule is tested and stable. *) (* ------------------------------------------------------------------------- *) let (mk_meta_rule_old: thm -> meta_rule) = fun thm -> let (hyps,concl) = dest_thm thm in let rec mk_meta_subgoal tm = ( if (is_imp(tm)) then let (a,c) = dest_imp tm in let (prems,concl) = mk_meta_subgoal c in ("",ASSUME a)::prems,concl else [],tm ) in concl,map mk_meta_subgoal hyps,thm;; (* ------------------------------------------------------------------------- *) (* mk_elim_meta_rule_old: thm -> meta_rule *) (* Creates a meta_rule out of a theorem. === DEPRECATED === *) (* Works like mk_meta_rule but acommodates elimination/destruction rules *) (* a little bit better by not breaking the major premise. This effectively *) (* allows the major premise to be an implication. *) (* ------------------------------------------------------------------------- *) (* In an elimination or destruction rule, the first or major premise is *) (* matched against one of the assumptions. Therefore, you cannot have a *) (* meta_subgoal for a major premise. If there is an implication there we *) (* shall leave it intact and not treat it as "meta-level" implication. *) (* This still disallows the use of implication in the rest of the premises *) (* (by treating it as "meta-level" implication). *) (* ------------------------------------------------------------------------- *) (* Deprecated. New mk_meta_rule uses meta-level implication. *) (* Kept until new mk_meta_rule is tested and stable. *) (* ------------------------------------------------------------------------- *) let (mk_elim_meta_rule_old: thm -> meta_rule) = fun thm -> let (hyps,concl) = dest_thm thm in if (hyps = []) then failwith "mk_elim_meta_rule: Invalid rule - no premises!" else let major_prem,hyps = ([],hd hyps),tl hyps in let rec mk_meta_subgoal tm = ( if (is_imp(tm)) then let (a,c) = dest_imp tm in let (prems,concl) = mk_meta_subgoal c in ("",ASSUME a)::prems,concl else [],tm ) in concl,major_prem :: (map mk_meta_subgoal hyps),thm;; (* ------------------------------------------------------------------------- *) (* Isabelle's natural deduction inference rules as meta_rules. *) (* ------------------------------------------------------------------------- *) (* The trailing 'm' indicates they are represented as meta_rules as opposed *) (* to theorems. *) (* Use "mk_meta_rule" to create meta_rules from theorems. *) (* Most of the following can be created using mk_meta_rule but are left here *) (* as examples. *) (* ------------------------------------------------------------------------- *) (* Deprecated. New mk_meta_rule uses meta-level implication so now ALL of *) (* these can be represented at the object-level and turned into meta_rules *) (* using mk_meta_rule. *) (* ------------------------------------------------------------------------- *) let conjIm:meta_rule = (`p/\q`, [ [],`p:bool`; [],`q:bool` ], conjI);; let conjEm:meta_rule = (`r:bool`, [ [],`p/\q`; [("",ASSUME `p:bool`);("",ASSUME `q:bool`)],`r:bool` ], (UNDISCH o UNDISCH o TAUT) `p/\q==>(p==>q==>r)==>r` );; let notEm:meta_rule = (`r:bool`, [ [],`~a`; [],`a:bool` ], (UNDISCH o UNDISCH o TAUT) `~a==>a==>r` );; let disjI1m:meta_rule = (`p\/q`, [ [],`p:bool`; ], UNDISCH ( TAUT `p==>p\/q` ));; let disjI2m:meta_rule = (`p\/q`, [ [],`q:bool`; ], UNDISCH ( TAUT `q==>p\/q` ));; let disjEm:meta_rule = (`r:bool`, [ [],`p\/q`; [("",ASSUME `p:bool`)],`r:bool`; [("",ASSUME `q:bool`)],`r:bool` ], (UNDISCH o UNDISCH o UNDISCH) ( TAUT `p\/q==>(p==>r)==>(q==>r)==>r`) );; let impIm:meta_rule = (`p==>q`, [ [("",ASSUME `p:bool`)],`q:bool` ], UNDISCH (TAUT `(p==>q)==>(p==>q)`) );; let impEm:meta_rule = (`r:bool`, [ [],`p==>q`; [],`p:bool`; [("",ASSUME `q:bool`)],`r:bool` ], (UNDISCH o UNDISCH o UNDISCH o TAUT) `(p==>q)==>p==>(q==>r)==>r` );; let mpm:meta_rule = (`q:bool`, [ [],`p==>q`; [],`p:bool` ], (UNDISCH o UNDISCH o TAUT) `(p==>q)==>(p==>q)` );; (* Note from old mk_meta_rule: *) (* This one cannot be expressed as a theorem because HOL Light insists on *) (* ordering the assumptions of the theorem so the major premise is `p` *) (* instead of `~p`. *) let notEm:meta_rule = (`r:bool`, [ [],`~a`; [],`a:bool` ], (UNDISCH o UNDISCH o TAUT) `~a==>a==>r` );; (* ------------------------------------------------------------------------- *) (* rulem_tac: ((term * term) list -> meta_rule -> tactic): *) (* Isabelle's rule as a HOL Light meta_rule tactic. *) (* Uses a rule of the form H1,H2,...,Hn |- C represented as a meta_rule *) (* to solve A1,A2,...,Am ?- G *) (* Matches C to the goal G, then splits the goal to *) (* A1,A2,...,Am ?- H1 *) (* A1,A2,...,Am ?- H2 *) (* ... *) (* A1,A2,...,Am ?- Hn *) (* Hi can be of the form Hi1,Hi2,...,Hik ?- HiC then the goal produced is *) (* A1,A2,...,Am,Hi1,Hi2,...,Hik ?- HiC *) (* ------------------------------------------------------------------------- *) (* (+) "avoids" lists all the free variables in the assumptions and goal so *) (* as to avoid instantiating those (as in variable conflicts with the rule *) (* or partly instantiated rule in the case of erule) *) (* (+) First we check if C matches G. If it does we keep the resulting *) (* instantiation (ins). *) (* (+) We instantiate the "meta-subgoals" of the meta_rule using ins. *) (* In essence we're instantiating the premises of the rule. (new_hyps) *) (* (+) The "create_goal" function creates the new goals by adding the *) (* assumption list A1--Am to the instantiated "meta-subgoal". *) (* (+) create_goal is mapped on new_hyps to create the new subgoal list. *) (* (+) The "create_dischl" function creates the list of the terms involved *) (* in the premises of each instantiated meta-subgoal. In order to create the *) (* justification of the tactic, we need to convert Hi1,Hi2,...,Hik |- HiC *) (* into |- Hi1==>Hi2==>...==>Hik==>HiC. That is the only way we can capture *) (* the notion of a "subgoal" within a HOL Light object-level theorem. *) (* We will then use PROVE_HYP to eliminate each of the proven subgoals from *) (* the rule's justification theorem. In order to achieve this conversion we *) (* need to keep a list of the instantiated premises of the rule (dischls) *) (* for each meta_subgoal so as to avoid discharging the original goal's *) (* assumptions or _FALSITY_. *) (* (+) "disch_pair" is used for convenience. dishls is combined with the *) (* list of proven subgoals so that each subgoal is attached to its *) (* corresponding premises list (dischl). disch_pair then does the discharges.*) (* It also takes care of instantiating the meta-variables in those premises *) (* for proper justification. *) (* (+) normalfrees is used to calculate the list of metavariables that will *) (* end up in the new subgoals. It contains all the free variables in the *) (* goal and instlist. *) (* (+) The newly introduced metavariables are found by subtracting *) (* normalfrees from the set of all free variables in all new goals. *) (* ------------------------------------------------------------------------- *) let (rulem_tac: (term*term) list->meta_rule->tactic) = fun instlist r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in let ins = try ( term_match [] c w ) with Failure _ -> failwith "Rule doesn't match!" in let new_hyps = map (inst_goal ins) hyps in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = map (create_goal asl) new_hyps in let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) (map (disch_pair i) (List.combine dischls l));; (* ------------------------------------------------------------------------- *) (* erulem_tac: ((term * term) list -> meta_rule -> tactic): *) (* Isabelle's erule as a HOL Light meta_rule tactic. *) (* Works like rulem but also matches the first hypothesis H1 with one of the *) (* assumptions A1--Am and instantiates accordingly. *) (* A "proper" elimination rule H1 is of the form ?- H1 (ie. has no premises) *) (* ------------------------------------------------------------------------- *) (* Same as rulem with some added stuff. *) (* (+) If there are no "meta_subgoals" (no new subgoals to create) we fail. *) (* (+) Otherwise we use the first "meta_subgoal" as our primary hypothesis *) (* (the one that will be eliminated - prim_hyp). *) (* (+) If prim_hyp has premises then this is not a "proper" elimination rule.*) (* (+) Otherwise try to match any of the assumptions with prim_hyp. The *) (* resulting instantiation is elim_inst. *) (* (+) Instantiate all generated meta_subgoals with elim_inst. Retrieve the *) (* (now instantiated) prim_hyp and remove it from the new subgoals (it is *) (* trivially proven). We get a "pattern-matching is not exhaustive" warning *) (* here, but we have already checked that new_hyps is non-empty. *) (* (+) prim_thm is a trivial theorem that proves the subgoal corresponding *) (* to prim_hyp. *) (* (+) Instantiate the justification theorem with elim_thm. *) (* (+) Add prim_hyp to the justification (pretending its a proven subgoal). *) (* (+) Use a hack to add the eliminated assumption to the proven subgoals so *) (* that we pass the validity check properly. *) (* ------------------------------------------------------------------------- *) let (erulem_tac: (term * term) list -> meta_rule->tactic) = fun instlist r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in let ins = try ( term_match [] c w ) with Failure _ -> failwith "Rule doesn't match!" in let new_hyps = map (inst_goal ins) hyps in let (prems,prim_hyp) = if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" else hd new_hyps in let avoids = gl_frees g in let asl,(prim_thm,elim_inst) = if (prems = []) then try term_to_asm_match avoids prim_hyp asl with Failure s -> failwith ("erule: " ^ s) else failwith "erule: Not a proper elimination rule: major premise has assumptions!" in let (_,prim_hyp)::new_hyps = map (inst_goal elim_inst) new_hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = map (create_goal asl) new_hyps in let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i prim_thm in List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l)));; (* ------------------------------------------------------------------------- *) (* drulem_tac: ((term * term) list -> meta_rule -> tactic): *) (* Isabelle's drule as a HOL Light meta_rule tactic. *) (* Uses rules as shown in "rule". *) (* Matches the first hypothesis H1 with one of the *) (* assumptions A1--Am and instantiates accordingly. *) (* The assumption is removed from the list and the trivial goal is proven *) (* automatically. *) (* A "proper" destructio rule H1 is of the form ?- H1 (ie. has no premises) *) (* The goal A1,A2,...,Am,G ?- C is also added. *) (* ------------------------------------------------------------------------- *) (* Same as erulem with a few differences. *) (* [+] Does not try to match the goal c. *) (* [+] Adds an extra goal c ?- w after instantiating c. *) (* [+] The new goal is treated slightly different in the justification. *) (* It is the one whose premises must be proven so as to get to the final *) (* goal. So it gets proven using PROVE_HYP by the result of the *) (* justification on the original rule. *) (* ------------------------------------------------------------------------- *) let (drulem_tac: (term * term) list -> meta_rule->tactic) = fun instlist r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in let (prems,major_prem) = if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in let asl,(major_thm,elim_inst) = if (prems = []) then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("drule: " ^ s) else failwith "drule: not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in (* We add an empty discharge list at the end for the extra goal. *) let dischls = map create_dischl new_hyps @ [[]] in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l))) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; (* ------------------------------------------------------------------------- *) (* frulem_tac: ((term * term) list -> meta_rule -> tactic): *) (* Isabelle's frule as a HOL Light meta_rule tactic. *) (* Same as drule, but does not remove the matching assumption from the list. *) (* ------------------------------------------------------------------------- *) (* Same as drulem only skipping the parts that eat up the assumption and *) (* re-add it to the proven subgoals. *) (* ------------------------------------------------------------------------- *) let (frulem_tac: (term * term) list -> meta_rule->tactic) = fun instlist r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in let (prems,major_prem) = if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in let _,(major_thm,elim_inst) = if (prems = []) then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("frule: " ^ s) else failwith "frule: Not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps @ [[]] in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: ((map (disch_pair i)) o (List.combine dischls)) l) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; (* ------------------------------------------------------------------------- *) (* cutm_tac: ((term * term) list -> meta_rule -> tactic): *) (* Isabelle's cut_tac as a HOL Light meta_rule tactic. *) (* Inserts a theorem in the assumptions. *) (* ------------------------------------------------------------------------- *) (* (+) WARNING: It does not introduce metavariables like the other tactics *) (* do! In the TODO list... *) (* ------------------------------------------------------------------------- *) let (cutm_tac: (term * term) list -> meta_rule->tactic) = fun instlist r g -> let (_,_,thm) = inst_meta_rule_vars instlist r (gl_frees g) in (ASSUME_TAC thm) g;; (* ------------------------------------------------------------------------- *) (* erulenm_tac : (term * term) list -> int -> meta_rule->tactic) *) (* drulenm_tac : (term * term) list -> int -> meta_rule->tactic) *) (* frulenm_tac : (term * term) list -> int -> meta_rule->tactic) *) (* Identical to their counterparts, the only difference being that they try *) (* to match a particular assumption given by number. *) (* ------------------------------------------------------------------------- *) let (erulenm_tac: (term * term) list -> int -> meta_rule->tactic) = fun instlist n r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in let ins = try ( term_match [] c w ) with Failure _ -> failwith "Rule doesn't match!" in let new_hyps = map (inst_goal ins) hyps in let (prems,prim_hyp) = if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" else hd new_hyps in let avoids = gl_frees g in let asl,(prim_thm,elim_inst) = if (prems = []) then try term_to_asm_n_match avoids prim_hyp (rev asl) n with Failure s -> failwith ("erule: " ^ s) else failwith "erule: Not a proper elimination rule: major premise has assumptions!" in let (_,prim_hyp)::new_hyps = map (inst_goal elim_inst) new_hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = map (create_goal asl) new_hyps in let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i prim_thm in List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l)));; let (drulenm_tac: (term * term) list -> int -> meta_rule->tactic) = fun instlist n r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in let (prems,major_prem) = if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in let asl,(major_thm,elim_inst) = if (prems = []) then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("drule: " ^ s) else failwith "drule: not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in (* We add an empty discharge list at the end for the extra goal. *) let dischls = map create_dischl new_hyps @ [[]] in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l))) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; let (frulenm_tac: (term * term) list -> int -> meta_rule->tactic) = fun instlist n r ((asl,w) as g) -> let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in let (prems,major_prem) = if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" else hd hyps in let avoids = gl_frees g in let _,(major_thm,elim_inst) = if (prems = []) then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("frule: " ^ s) else failwith "frule: Not a proper destruction rule: major premise has assumptions!" in let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in let thm = INSTANTIATE_ALL elim_inst thm in let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in let dischls = map create_dischl new_hyps @ [[]] in let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in (mvs,null_inst),new_goals,fun i l -> let major_thmi = INSTANTIATE_ALL i major_thm in let l = (major_thmi :: ((map (disch_pair i)) o (List.combine dischls)) l) in PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; (* ------------------------------------------------------------------------- *) (* Xrulem versions for empty instlist. *) (* ------------------------------------------------------------------------- *) let rulem: meta_rule -> tactic = rulem_tac [];; let erulem: meta_rule -> tactic = erulem_tac [];; let drulem: meta_rule -> tactic = drulem_tac [];; let frulem: meta_rule -> tactic = frulem_tac [];; let erulenm: int -> meta_rule -> tactic = erulenm_tac [];; let drulenm: int -> meta_rule -> tactic = drulenm_tac [];; let frulenm: int -> meta_rule -> tactic = frulenm_tac [];; (* For consistency with HOL Light capitalized tactics: *) let RULEM,ERULEM,DRULEM,FRULEM = rulem,erulem,drulem,frulem;; let ERULENM,DRULENM,FRULENM = erulenm,drulenm,frulenm;; (* ------------------------------------------------------------------------- *) (* Xrule and Xrule_tac using arbitrary inference rules in the form of thms. *) (* (see mk_meta_rule and meta_rule type) *) (* ------------------------------------------------------------------------- *) let rule_tac: (term * term) list -> thm -> tactic = fun instlist thm -> rulem_tac instlist (mk_meta_rule thm);; let erule_tac: (term * term) list -> thm -> tactic = fun instlist thm -> erulem_tac instlist (mk_meta_rule thm);; let drule_tac: (term * term) list -> thm -> tactic = fun instlist thm -> drulem_tac instlist (mk_meta_rule thm);; let frule_tac: (term * term) list -> thm -> tactic = fun instlist thm -> frulem_tac instlist (mk_meta_rule thm);; let cut_tac: (term * term) list -> thm -> tactic = fun instlist thm -> cutm_tac instlist (mk_meta_rule thm);; let RULE_TAC,ERULE_TAC,DRULE_TAC,FRULE_TAC,CUT_TAC = rule_tac,erule_tac,drule_tac,frule_tac,cut_tac;; let erulen_tac: (term * term) list -> int -> thm -> tactic = fun instlist n thm -> erulenm_tac instlist n (mk_meta_rule thm);; let drulen_tac: (term * term) list -> int -> thm -> tactic = fun instlist n thm -> drulenm_tac instlist n (mk_meta_rule thm);; let frulen_tac: (term * term) list -> int -> thm -> tactic = fun instlist n thm -> frulenm_tac instlist n (mk_meta_rule thm);; let ERULEN_TAC,DRULEN_TAC,FRULEN_TAC = erulen_tac,drulen_tac,frulen_tac;; let rule: (thm -> tactic) = rule_tac [];; let erule: (thm -> tactic) = erule_tac [];; let drule: (thm -> tactic) = drule_tac [];; let frule: (thm -> tactic) = frule_tac [];; let RULE,ERULE,DRULE,FRULE = rule,erule,drule,frule;; let erulen: (int -> thm -> tactic) = erulen_tac [];; let drulen: (int -> thm -> tactic) = drulen_tac [];; let frulen: (int -> thm -> tactic) = frulen_tac [];; let ERULEN,DRULEN,FRULEN = erulen,drulen,frulen;; hol-light/IsabelleLight/new_tactics.ml000066400000000000000000000430371303454263000203210ustar00rootroot00000000000000(* ========================================================================= *) (* Isabelle Light *) (* Isabelle/Procedural style additions and other user-friendly shortcuts. *) (* *) (* Petros Papapanagiotou, Jacques Fleuriot *) (* Center of Intelligent Systems and their Applications *) (* University of Edinburgh *) (* 2009-2010 *) (* ========================================================================= *) (* FILE : new_tactics.ml *) (* DESCRIPTION : Various tactics to facilitate procedural-style users. *) (* Mostly inspired by Isabelle's similar tactics. *) (* LAST MODIFIED: October 2012 *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* e_all : tactic -> goalstack *) (* Same as "e" but applies tactic to ALL subgoals. *) (* ------------------------------------------------------------------------- *) let e_all tac = let c = (count_goals()) in let rec f i = ( if (i = 0) then (!current_goalstack) else let _ = e tac in let _ = r 1 in f (i-1) ) in f c;; (* ------------------------------------------------------------------------- *) (* ROTATE_N_TAC: *) (* Rotates assumptions N times. *) (* ------------------------------------------------------------------------- *) (* Pops the entire assumption list doing nothing (K ALL_TAC) then maps *) (* LABEL_TAC to the rotated list of assumptions. The list is reversed so as *) (* to match the external order. The result is applied to (asl,w) so as to *) (* obtain the resulting goalstate as required by the tactic type. *) (* ------------------------------------------------------------------------- *) let (ROTATE_N_TAC :int->tactic) = fun n (asl,w) -> let rotateasm = fun (asl) -> (tl asl)@[hd asl] in (POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY (fun (s,th) -> LABEL_TAC s th) (funpow n rotateasm (rev asl))) (asl,w);; (* ------------------------------------------------------------------------- *) (* ROTATE_TAC: *) (* Rotates assumptions once. *) (* ------------------------------------------------------------------------- *) let (ROTATE_TAC :tactic) = (ROTATE_N_TAC 1);; (* ------------------------------------------------------------------------- *) (* DRULE_N_TAC: *) (* Applies an inference rule to Nth assumption only. *) (* Like drule for HOL Light's inference rules without matching. *) (* ------------------------------------------------------------------------- *) (* Works like RULE_ASSUM_TAC except it numbers the assumption list with *) (* num_list and only applies the rule to the Nth assumption. *) (* ------------------------------------------------------------------------- *) let (DRULE_N_TAC :int->(thm->thm)->tactic) = fun n rule (asl,w) -> (POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY (fun (i,(s,th)) -> LABEL_TAC s (if (i=n) then (rule th) else th)) (num_list(rev asl))) (asl,w);; (* ------------------------------------------------------------------------- *) (* FRULE_N_TAC: *) (* Applies an inference rule to Nth assumption only then adds the result as *) (* a new assumption. *) (* Like frule for HOL Light's inference rules without matching. *) (* ------------------------------------------------------------------------- *) (* Works like DRULE_N_TAC except it leaves the assumption intact and *) (* adds the result as a new assumption. *) (* ------------------------------------------------------------------------- *) let (FRULE_N_TAC :int->(thm->thm)->tactic) = fun n rule (asl,w) -> ( let asmlist = num_list(rev asl) in let (_,asm_n) = try assoc n asmlist with Failure _ -> failwith("FRULE_N_TAC: didn't find assumption "^string_of_int(n)) in ASSUME_TAC (rule asm_n)) (asl,w);; (* ------------------------------------------------------------------------- *) (* FRULE_MN_TAC: *) (* Applies an inference rule (such as MP) to the Mth and Nth assumptions and *) (* adds the result as a new assumption. *) (* ------------------------------------------------------------------------- *) (* Numbers the assumption list, finds the Mth and Nth assumptions, applies *) (* the rule to them and adds the result as a new assumption. *) (* ------------------------------------------------------------------------- *) let (FRULE_MN_TAC :int->int->(thm->thm->thm)->tactic) = fun m n rule (asl,w) -> ( let asmlist = num_list(rev asl) in let (_,asm_m) = try assoc m asmlist with Failure _ -> failwith("FRULE_MN_TAC: didn't find assumption "^string_of_int(m)) in let (_,asm_n) = try assoc n asmlist with Failure _ -> failwith("FRULE_MN_TAC: didn't find assumption "^string_of_int(n)) in ASSUME_TAC (rule asm_m asm_n)) (asl,w);; (* ------------------------------------------------------------------------- *) (* ----------------------- SIMP TACTICS START HERE!! ----------------------- *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* GENERAL_ASM_TAC: (thm list -> thm -> thm) -> thm list -> tactic *) (* General function that uses a rewrite rule to rewrite the assumptions. *) (* Each assumption is rewritten using the rest of the assumptions and the *) (* given list of theorems. *) (* ------------------------------------------------------------------------- *) (* A filter is applied to ensure that the assumption is not used to rewrite *) (* itself. *) (* ------------------------------------------------------------------------- *) let GENERAL_ASM_TAC = fun rule thl (asl,w) -> let asm = map snd asl in (POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY (fun (s,th) -> LABEL_TAC s (rule ((filter (fun x -> not (th = x)) asm) @ thl) th) ) (rev asl)) (asl,w);; (* ------------------------------------------------------------------------- *) (* Using the above GENERAL_ASSUM_TAC, we define 4 tactics to rewrite *) (* assumptions based on the 4 rewrite rules available in HOL Light. *) (* ------------------------------------------------------------------------- *) let REWRITE_ASM_TAC,ONCE_REWRITE_ASM_TAC,PURE_REWRITE_ASM_TAC, PURE_ONCE_REWRITE_ASM_TAC = GENERAL_ASM_TAC REWRITE_RULE, GENERAL_ASM_TAC ONCE_REWRITE_RULE, GENERAL_ASM_TAC PURE_REWRITE_RULE, GENERAL_ASM_TAC PURE_ONCE_REWRITE_RULE;; (* ------------------------------------------------------------------------- *) (* And for simplification. *) (* ------------------------------------------------------------------------- *) let SIMP_ASM_TAC,ONCE_SIMP_ASM_TAC,PURE_SIMP_ASM_TAC = GENERAL_ASM_TAC SIMP_RULE, GENERAL_ASM_TAC ONCE_SIMP_RULE, GENERAL_ASM_TAC PURE_SIMP_RULE;; (* ------------------------------------------------------------------------- *) (* FULL_REWRITE_TAC : thm list -> tactic *) (* simp : thm list -> tactic *) (* Similar to Isabelle's simp. Rewrites assumptions then rewrites goal *) (* using the assumptions. *) (* ------------------------------------------------------------------------- *) let FULL_REWRITE_TAC thl = REWRITE_ASM_TAC thl THEN ASM_SIMP_TAC thl;; let simp = FULL_REWRITE_TAC;; (* ------------------------------------------------------------------------- *) (* FULL_SIMP_TAC : thm list -> tactic *) (* Hybrid simplifier. Uses HOL Light's SIMP_TAC then FULL_REWRITE_TAC. *) (* ------------------------------------------------------------------------- *) let FULL_SIMP_TAC thl = SIMP_TAC thl THEN REWRITE_ASM_TAC thl THEN ASM_REWRITE_TAC thl;; (* ------------------------------------------------------------------------- *) (* assumption (tactic): *) (* Shortcut to match an assumption to the goal as Isabelle's "assumption". *) (* ------------------------------------------------------------------------- *) let assumption = FIRST_ASSUM MATCH_ACCEPT_TAC;; (* ------------------------------------------------------------------------- *) (* ALL_UNIFY_ACCEPT_TAC (term list -> thm -> tactic): *) (* Altered UNIFY_ACCEPT_TAC. Uses INSTANTIATE_ALL instead of INSTANTIATE. *) (* ------------------------------------------------------------------------- *) (* This allows for some valid instantiations that weren't otherwise allowed. *) (* eg After using allE, the `a` metavariable can't be instantiated otherwise.*) (* ------------------------------------------------------------------------- *) let ALL_UNIFY_ACCEPT_TAC mvs th (asl,w) = let insts = term_unify mvs (concl th) w in ([],insts),[], let th' = INSTANTIATE_ALL insts th in fun i [] -> INSTANTIATE_ALL i th';; (* ------------------------------------------------------------------------- *) (* meta_assumption (term list -> tactic): *) (* Shortcut to match an assumption to the goal as Isabelle's "assumption". *) (* This version also tries unification by instantiation of meta-variables *) (* which, unfortunately, need to be given manually in a list. *) (* ------------------------------------------------------------------------- *) (* Invalid instantiations may be produced. *) (* eg g `!x:num. (?a:num. R a x) ==> (?y. R y x)`;; *) (* e GEN_TAC;; *) (* e (rule impI);; *) (* e (rule exI);; *) (* e (FIRST_X_ASSUM (X_CHOOSE_TAC `b:num`));; *) (* e (meta_assumption [`a:num`]);; *) (* This succeeds but top_thm() is unable to reconstruct the theorem. *) (* ------------------------------------------------------------------------- *) let meta_assumption mvs = (FIRST_ASSUM MATCH_ACCEPT_TAC) ORELSE (FIRST_ASSUM (ALL_UNIFY_ACCEPT_TAC mvs));; (* ------------------------------------------------------------------------- *) (* Shortcut for interactive proofs so that you don't have to enumerate *) (* metavariables. *) (* ------------------------------------------------------------------------- *) let ema () = (e o meta_assumption o top_metas o p) () ;; (* ------------------------------------------------------------------------- *) (* X_MATCH_CHOOSE_TAC : (term -> tactic) *) (* Version of X_CHOOSE_TAC with type matching. *) (* ------------------------------------------------------------------------- *) (* If the variable given as an argument has a vartype then its type is *) (* instantiated to the type of the existentially quantified variable. *) (* Usefull so that the user need not specify the type for his variable. *) (* It is still acceptable if the user does specify it. *) (* ------------------------------------------------------------------------- *) let (X_MATCH_CHOOSE_TAC: term -> thm_tactic) = fun x' xth -> try let xtm = concl xth in let x,bod = dest_exists xtm in let x'type = type_of x' in let x'' = if (is_vartype x'type) then inst (type_match x'type (type_of x) []) x' else x' in let pat = vsubst[x'',x] bod in let xth' = ASSUME pat in fun (asl,w) -> let avoids = itlist (union o frees o concl o snd) asl (union (frees w) (thm_frees xth)) in if mem x' avoids then failwith "X_CHOOSE_TAC" else null_meta,[("",xth')::asl,w], fun i [th] -> CHOOSE(x'',INSTANTIATE_ALL i xth) th with Failure _ -> failwith "X_CHOOSE_TAC";; (* ------------------------------------------------------------------------- *) (* exE : (term -> tactic) *) (* Existential elimination tactic (since we are unable to accommodate *) (* erule exE with the current meta_rule system because of lack of meta-level *) (* quantification). *) (* ------------------------------------------------------------------------- *) let exE = FIRST_X_ASSUM o X_MATCH_CHOOSE_TAC;; (* ------------------------------------------------------------------------- *) (* allI : (term -> tactic) *) (* Universal introduction tactic (since we are unable to accommodate *) (* rule allI with the current meta_rule system because of lack of meta-level *) (* quantification). *) (* ------------------------------------------------------------------------- *) (* (+) We can use X_GEN_TAC to allow the user to give his own term, but *) (* this is rarely useful in procedural style proofs. *) (* ------------------------------------------------------------------------- *) let allI = GEN_TAC;; (* ------------------------------------------------------------------------- *) (* qed : (unit -> thm) *) (* Reconstructs the theorem at the end of an interactive proof. *) (* May fail if an incorrect metavariable instantiation has occured during the*) (* proof. *) (* ------------------------------------------------------------------------- *) (* (+) There are plans to upgrade this for better accommodation of proofs *) (* containing meta-level implication (see meta_rules.ml and gmm). *) (* ------------------------------------------------------------------------- *) let qed = top_thm;; (* ------------------------------------------------------------------------- *) (* ASM_STRUCT_CASES_TAC : (thm_tactic) *) (* Replacement/fix of STRUCT_CASES_TAC where each case is added as an *) (* assumption like ASM_CASES_TAC does for booleans. *) (* ------------------------------------------------------------------------- *) let ASM_STRUCT_CASES_TAC = REPEAT_TCL STRIP_THM_THEN ASSUME_TAC;; (* ------------------------------------------------------------------------- *) (* case_tac : (term -> tactic) *) (* Isabelle's case_tac for splitting cases. *) (* ------------------------------------------------------------------------- *) let (case_tac:term->tactic) = fun tm ((_,w) as g) -> let trymatch = fun tm1 tm2 -> try ( let inst = term_match (gl_frees g) tm1 tm2 in if (is_var tm1) then match inst with [],[],_ -> true | _ -> false else true ) with Failure _ -> false in let tm' = try (find_term (trymatch tm) w) with Failure _ -> tm in let ty = (fst o dest_type o type_of) tm' in let thm = try (cases ty) with Failure _ -> failwith ("case_tac: Failed to find cases theorem for type \"" ^ ty ^ "\".") in ASM_STRUCT_CASES_TAC (ISPEC tm' thm) g;; (* ------------------------------------------------------------------------- *) (* gen_case_tac : tactic *) (* Case split on the leading universal quantifier of the goal. *) (* ------------------------------------------------------------------------- *) let (gen_case_tac:tactic) = fun ((_,w) as g) -> case_tac ((fst o dest_forall) w) g;; (* ------------------------------------------------------------------------- *) (* subgoal_tac : (term -> tactic) *) (* Introduces a new subgoal which gets added as an assumption. *) (* Isabelle's subgoal_tac. *) (* ------------------------------------------------------------------------- *) let subgoal_tac = fun tm -> SUBGOAL_THEN tm ASSUME_TAC;; (* ------------------------------------------------------------------------- *) (* meson : (thm list -> tactic) *) (* Lower-case shortcut for ASM_MESON_TAC *) (* ------------------------------------------------------------------------- *) let meson = ASM_MESON_TAC;; hol-light/IsabelleLight/support.ml000066400000000000000000000272641303454263000175360ustar00rootroot00000000000000(* ========================================================================= *) (* Isabelle Light *) (* Isabelle/Procedural style additions and other user-friendly shortcuts. *) (* *) (* Petros Papapanagiotou, Jacques Fleuriot *) (* Center of Intelligent Systems and their Applications *) (* University of Edinburgh *) (* 2009-2012 *) (* ========================================================================= *) (* FILE : support.ml *) (* DESCRIPTION : Support functions and various shortcuts. *) (* LAST MODIFIED: October 2012 *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Functions to deal with triplets: *) (* ------------------------------------------------------------------------- *) let fst3 (x,_,_) = x;; let snd3 (_,x,_) = x;; let thd3 (_,_,x) = x;; (*----------------------------------------------------------------------------*) (* num_list : a' list -> (a' * int) list *) (* *) (* Numbers a list of elements, *) (* e.g. [`a`;`b`;`c`] ---> [(0,`a`);(1,`b`);(2,`c`)]. *) (*----------------------------------------------------------------------------*) let num_list l = let rec number_list' n l = if ( l = [] ) then [] else (n,hd l)::(number_list' (n + 1) (tl l)) in number_list' 0 l;; (* ------------------------------------------------------------------------- *) (* list_match_first: (a' -> b') -> a' list -> b' *) (* Tries to apply a function to the members of a list. Returns the result *) (* from the first member that succeeds. *) (* ------------------------------------------------------------------------- *) let rec list_match_first f alist = if (alist = []) then failwith "list_match_first: No matches!" else try f (hd alist) with Failure _ -> list_match_first f (tl alist);; (* ------------------------------------------------------------------------- *) (* terms_match: term list -> term -> term list -> instantiation *) (* Tries to apply term_match to the first possible term in a list. *) (* Returns the insantiation. *) (* ------------------------------------------------------------------------- *) let (terms_match: term list -> term -> term list -> instantiation ) = fun consts key tlist -> try (list_match_first (term_match consts key) tlist) with Failure _ -> failwith "terms_match: No terms match!";; (* ------------------------------------------------------------------------- *) (* thm_mk_primed_vars: term list -> thm -> thm *) (* Renames all free variables in a theorem to avoid specified and constant *) (* names. *) (* ------------------------------------------------------------------------- *) let thm_mk_primed_vars avoids thm = let fvars = thm_frees thm in let new_vars = map (mk_primed_var avoids) fvars in let insts = List.combine new_vars fvars in INST insts thm;; (* ------------------------------------------------------------------------- *) (* gl_frees: goal -> term list *) (* Finds the free variables in a subgoal (assumptions and goal). *) (* ------------------------------------------------------------------------- *) let gl_frees : goal -> term list = fun (asl,w) -> itlist (union o thm_frees o snd) asl (frees w);; (* ------------------------------------------------------------------------- *) (* ADD_HYP: thm -> thm -> thm *) (* Trivially adds the hypotheses of a theorem to the premises of another. *) (* ------------------------------------------------------------------------- *) (* (+) Used in the justification of erule and drule to add the eliminated *) (* assumption to the proven subgoals. *) (* (+) Could have been based on ADD_ASSUM but it's more convenient this way. *) (* ------------------------------------------------------------------------- *) let ADD_HYP hyp_thm thm = CONJUNCT2 (CONJ hyp_thm thm);; (* ------------------------------------------------------------------------- *) (* DISCHL: term list -> thm -> thm *) (* Applies DISCH for several terms. *) (* ------------------------------------------------------------------------- *) let rec (DISCHL: term list -> thm -> thm) = fun tms thm -> if (tms = []) then thm else DISCH (hd tms) (DISCHL (tl tms) thm);; (* ------------------------------------------------------------------------- *) (* print_thl: *) (* Print a list of theorems (for debugging). *) (* ------------------------------------------------------------------------- *) let print_thl thl = map (fun thm -> ( print_thm thm ; print_newline ())) thl;; (* ------------------------------------------------------------------------- *) (* print_tml: *) (* Print a list of terms (for debugging). *) (* ------------------------------------------------------------------------- *) let print_tml tml = map (fun tm -> ( print_term tm ; print_newline ())) tml;; (* ------------------------------------------------------------------------- *) (* print_varandtype, show_types, hide_types: *) (* Prints the type after each variable. Useful for "debugging" type issues. *) (* ------------------------------------------------------------------------- *) (* Source: *) (* http://code.google.com/p/flyspeck/wiki/TipsAndTricks#Investigating_Types *) (* ------------------------------------------------------------------------- *) let print_varandtype fmt tm = let hop,args = strip_comb tm in let s = name_of hop and ty = type_of hop in if is_var hop && args = [] then (pp_print_string fmt "("; pp_print_string fmt s; pp_print_string fmt ":"; pp_print_type fmt ty; pp_print_string fmt ")") else fail() ;; let show_types,hide_types = (fun () -> install_user_printer ("Show Types",print_varandtype)), (fun () -> try delete_user_printer "Show Types" with Failure _ -> failwith ("hide_types: "^ "Types are already hidden."));; (* ------------------------------------------------------------------------- *) (* count_goals : unit -> int *) (* Shortcut to count the subgoals in the current goalstate. *) (* ------------------------------------------------------------------------- *) let count_goals () = if (!current_goalstack = []) then 0 else ( let _,gls,_ = hd !current_goalstack in length gls );; (* ------------------------------------------------------------------------- *) (* top_asms : goalstack -> (string * thm) list *) (* Shortcut to get the assumption list of the top goal of a given goalstack. *) (* ------------------------------------------------------------------------- *) let top_asms (gs:goalstack) = (fst o hd o snd3 o hd) gs;; (* ------------------------------------------------------------------------- *) (* top_metas : goalstack -> term list *) (* Returns the list of metavariables in the current goalstate. *) (* ------------------------------------------------------------------------- *) let top_metas (gs:goalstack) = (fst o fst3 o hd) gs;; (* ------------------------------------------------------------------------- *) (* top_inst : goalstack -> instantiation *) (* Returns the metavariable instantiations in the current goalstate. *) (* ------------------------------------------------------------------------- *) let top_inst (gs:goalstack) = (snd o fst3 o hd) gs;; (* ------------------------------------------------------------------------- *) (* print_goalstack_all : *) (* Alternative goalstack printer that always prints all subgoals. *) (* Also prints list of metavariables with their types. *) (* ------------------------------------------------------------------------- *) (* Original printer only prints more than one subgoals iff they were *) (* generated by the last step. Otherwise it only prints the 'active' subgoal.*) (* Replace by #install_printer print_goalstack_all;; *) (* Revert to original by #install_printer print_goalstack;; *) (* ------------------------------------------------------------------------- *) let (print_goalstack_all:goalstack->unit) = let print_goalstate k gs = let ((mvs,_),gl,_) = gs in let n = length gl in let s = if n = 0 then "No subgoals" else (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") ^" ("^(string_of_int n)^" total)" in let print_mv v = print_string " `" ; print_varandtype std_formatter v ; print_string "`;" in print_string s; print_newline(); if (length mvs > 0) then ( print_string "Metas:" ; let _ = map print_mv mvs in () ; print_newline() ) ; if gl = [] then () else do_list (print_goal o C el gl) (rev(0--(k-1))) in fun l -> if l = [] then print_string "Empty goalstack" else let (_,gl,_ as gs) = hd l in print_goalstate (length gl) gs;; (* ------------------------------------------------------------------------- *) (* print_goalstack : *) (* Upgrade to print_goalstack that also prints a list of metavariables with *) (* their types. *) (* ------------------------------------------------------------------------- *) let (print_goalstack:goalstack->unit) = let print_goalstate k gs = let ((mvs,_),gl,_) = gs in let n = length gl in let s = if n = 0 then "No subgoals" else (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") ^" ("^(string_of_int n)^" total)" in let print_mv v = print_string " `" ; print_varandtype std_formatter v ; print_string "`;" in print_string s; print_newline(); if (length mvs > 0) then ( print_string "Metas:" ; let _ = map print_mv mvs in () ; print_newline() ) ; if gl = [] then () else do_list (print_goal o C el gl) (rev(0--(k-1))) in fun l -> if l = [] then print_string "Empty goalstack" else if tl l = [] then let (_,gl,_ as gs) = hd l in print_goalstate 1 gs else let (_,gl,_ as gs) = hd l and (_,gl0,_) = hd(tl l) in let p = length gl - length gl0 in let p' = if p < 1 then 1 else p + 1 in print_goalstate p' gs;; #install_printer print_goalstack;; hol-light/Jordan/000077500000000000000000000000001303454263000141625ustar00rootroot00000000000000hol-light/Jordan/float.ml000066400000000000000000002002461303454263000156250ustar00rootroot00000000000000(* ------------------------------------------------------------------ *) (* Author and Copyright: Thomas C. Hales *) (* License: GPL http://www.gnu.org/copyleft/gpl.html *) (* Project: FLYSPECK http://www.math.pitt.edu/~thales/flyspeck/ *) (* ------------------------------------------------------------------ *) prioritize_real();; let add_test,test = new_test_suite();; let twopow = new_definition( `twopow x = if (?n. (x = (int_of_num n))) then ((&2) pow (nabs x)) else inv((&2) pow (nabs x))`);; let float = new_definition( `float x n = (real_of_int x)*(twopow n)`);; let interval = new_definition( `interval x f eps = ((abs (x-f)) <= eps)`);; (*--------------------------------------------------------------------*) let mk_interval a b ex = mk_comb(mk_comb (mk_comb (`interval`,a),b),ex);; add_test("mk_interval", mk_interval `#3` `#4` `#1` = `interval #3 #4 #1`);; let dest_interval intv = let (h1,ex) = dest_comb intv in let (h2,f) = dest_comb h1 in let (h3,a) = dest_comb h2 in let _ = assert(h3 = `interval`) in (a,f,ex);; add_test("dest_interval", let a = `#3` and b = `#4` and c = `#1` in dest_interval (mk_interval a b c) = (a,b,c));; (*--------------------------------------------------------------------*) let (dest_int:term-> Num.num) = fun b -> let dest_pos_int a = let (op,nat) = dest_comb a in if (fst (dest_const op) = "int_of_num") then (dest_numeral nat) else fail() in let (op',u) = (dest_comb b) in try (if (fst (dest_const op') = "int_neg") then minus_num (dest_pos_int u) else dest_pos_int b) with Failure _ -> failwith "dest_int ";; let (mk_int:Num.num -> term) = fun a -> let sgn = Num.sign_num a in let abv = Num.abs_num a in let r = mk_comb(` &: `,mk_numeral abv) in try (if (sgn<0) then mk_comb (` --: `,r) else r) with Failure _ -> failwith ("dest_int "^(string_of_num a));; add_test("mk_int", (mk_int (Int (-1443)) = `--: (&:1443)`) && (mk_int (Int 37) = `(&:37)`));; (* ------------------------------------------------------------------ *) let (split_ratio:Num.num -> Num.num*Num.num) = function (Ratio r) -> (Big_int (Ratio.numerator_ratio r)), (Big_int (Ratio.denominator_ratio r))| u -> (u,(Int 1));; add_test("split_ratio", let (a,b) = split_ratio ((Int 4)//(Int 20)) in (a =/ (Int 1)) && (b =/ (Int 5)));; (* ------------------------------------------------------------------ *) (* break nonzero int r into a*(C**b) with a prime to C . *) let (factor_C:int -> Num.num -> Num.num*Num.num) = function c -> let intC = (Int c) in let rec divC (a,b) = if ((Int 0) =/ mod_num a intC) then (divC (a//intC,b+/(Int 1))) else (a,b) in function r-> if ((Num.is_integer_num r)&& not((Num.sign_num r) = 0)) then divC (r,(Int 0)) else failwith "factor_C";; add_test("factor_C", (factor_C 2 (Int (4096+32)) = (Int 129,Int 5)) && (factor_C 10 (Int (5000)) = (Int 5,Int 3)) && (cannot (factor_C 2) ((Int 50)//(Int 3))));; (*--------------------------------------------------------------------*) let (dest_float:term -> Num.num) = fun f -> let (a,b) = dest_binop `float` f in (dest_int a)*/ ((Int 2) **/ (dest_int b));; add_test("dest_float", dest_float `float (&:3) (&:17)` = (Int 393216));; add_test("dest_float2", (* must express as numeral first *) cannot dest_float `float ((&:3)+:(&:1)) (&:17)`);; (* ------------------------------------------------------------------ *) (* creates float of the form `float a b` with a odd *) let (mk_float:Num.num -> term) = function r -> let (a,b) = split_ratio r in let (a',exp_a) = if (a=/(Int 0)) then ((Int 0),(Int 0)) else factor_C 2 a in let (b',exp_b) = factor_C 2 b in let c = a'//b' in if (Num.is_integer_num c) then mk_binop `float` (mk_int c) (mk_int (exp_a -/ exp_b)) else failwith "mk_float";; add_test("mk_float", mk_float (Int (4096+32)) = `float (&:129) (&:5)` && (mk_float (Int 0) = `float (&:0) (&:0)`));; add_test("mk_float2", (* throws exception exactly when denom != 2^k *) let rtest = fun t -> (t =/ dest_float (mk_float t)) in rtest ((Int 3)//(Int 1024)) && (cannot rtest ((Int 1)//(Int 3))));; add_test("mk_float dest_float", (* constructs canonical form of float *) mk_float (dest_float `float (&:4) (&:3)`) = `float (&:1) (&:5)`);; (* ------------------------------------------------------------------ *) (* creates decimal of the form `DECIMAL a b` with a prime to 10 *) let (mk_pos_decimal:Num.num -> term) = function r -> let _ = assert (r >=/ (Int 0)) in let (a,b) = split_ratio r in if (a=/(Int 0)) then `#0` else let (a1,exp_a5) = factor_C 5 a in let (a2,exp_a2) = factor_C 2 a1 in let (b1,exp_b5) = factor_C 5 b in let (b2,exp_b2) = factor_C 2 b1 in let _ = assert(b2 =/ (Int 1)) in let c = end_itlist Num.max_num [exp_b5-/exp_a5;exp_b2-/exp_a2;(Int 0)] in let a' = a2*/((Int 2)**/ (c +/ exp_a2 -/ exp_b2))*/ ((Int 5)**/(c +/ exp_a5 -/ exp_b5)) in let b' = (Int 10) **/ c in mk_binop `DECIMAL` (mk_numeral a') (mk_numeral b');; add_test("mk_pos_decimal", mk_pos_decimal (Int (5000)) = `#5000` && (mk_pos_decimal ((Int 30)//(Int 40)) = `#0.75`) && (mk_pos_decimal (Int 0) = `#0`) && (mk_pos_decimal ((Int 15)//(Int 25)) = `#0.6`) && (mk_pos_decimal ((Int 25)//(Int 4)) = `#6.25`) && (mk_pos_decimal ((Int 2)//(Int 25)) = `#0.08`));; let (mk_decimal:Num.num->term) = function r -> let a = Num.sign_num r in let b = mk_pos_decimal (Num.abs_num r) in if (a < 0) then (mk_comb (`--.`, b)) else b;; add_test("mk_decimal", (mk_decimal (Int 3) = `#3`) && (mk_decimal (Int (-3)) = `--. (#3)`));; (*--------------------------------------------------------------------*) let (dest_decimal:term -> Num.num) = fun f -> let (a,b) = dest_binop `DECIMAL` f in let a1 = dest_numeral a in let b1 = dest_numeral b in a1//b1;; add_test("dest_decimal", dest_decimal `#3.4` =/ ((Int 34)//(Int 10)));; add_test("dest_decimal2", cannot dest_decimal `--. (#3.4)`);; (*--------------------------------------------------------------------*) (* Properties of integer powers of 2. *) (* ------------------------------------------------------------------ *) let TWOPOW_POS = prove(`!n. (twopow (int_of_num n) = (&2) pow n)`, (REWRITE_TAC[twopow]) THEN GEN_TAC THEN COND_CASES_TAC THENL [AP_TERM_TAC;ALL_TAC] THEN (REWRITE_TAC[NABS_POS]) THEN (UNDISCH_EL_TAC 0) THEN (TAUT_TAC (` ( A ) ==> (~ A ==> B)`)) THEN (MESON_TAC[]));; let TWOPOW_NEG = prove(`!n. (twopow (--(int_of_num n)) = inv((&2) pow n))`, GEN_TAC THEN (REWRITE_TAC[twopow]) THEN (COND_CASES_TAC THENL [ALL_TAC;REWRITE_TAC[NABS_NEG]]) THEN (POP_ASSUM CHOOSE_TAC) THEN (REWRITE_TAC[NABS_NEG]) THEN (UNDISCH_EL_TAC 0) THEN (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL]) THEN (REWRITE_TAC[prove (`! u y.((--(real_of_num u) = (real_of_num y))= ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)]) THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ;ADD_EQ_0]) THEN (DISCH_TAC) THEN (ASM_REWRITE_TAC[real_pow;REAL_INV_1]));; let TWOPOW_INV = prove(`!a. (twopow (--: a) = (inv (twopow a)))`, (GEN_TAC) THEN ((ASSUME_TAC (SPEC `a:int` INT_REP2))) THEN ((POP_ASSUM CHOOSE_TAC)) THEN ((POP_ASSUM DISJ_CASES_TAC)) THEN ((ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG;REAL_INV_INV;INT_NEG_NEG])));; let INT_REP3 = prove(`!a .(?n.( (a = &: n) \/ (a = --: (&: (n+1)))))`, (GEN_TAC) THEN ((ASSUME_TAC (SPEC `a:int` INT_REP2))) THEN ((POP_ASSUM CHOOSE_TAC)) THEN ((DISJ_CASES_TAC (prove (`((a:int) = (&: 0)) \/ ~((a:int) =(&: 0))`, MESON_TAC[])))) (* cases *) THENL[ ((EXISTS_TAC `0`)) THEN ((ASM_REWRITE_TAC[]));ALL_TAC] THEN ((UNDISCH_EL_TAC 0)) THEN ((POP_ASSUM DISJ_CASES_TAC)) THENL [DISCH_TAC THEN ((ASM MESON_TAC)[]);ALL_TAC] THEN (DISCH_TAC) THEN ((EXISTS_TAC `PRE n`)) THEN ((DISJ2_TAC)) THEN ((ASM_REWRITE_TAC[INT_EQ_NEG2])) (*** Changed by JRH, 2006/03/28 to avoid PRE_ELIM_TAC ***) THEN (FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))) THEN (ASM_REWRITE_TAC[INT_NEG_EQ_0; INT_OF_NUM_EQ]) THEN (ARITH_TAC));; let REAL_EQ_INV = prove(`!x y. ((x:real = y) <=> (inv(x) = inv (y)))`, ((REPEAT GEN_TAC)) THEN (EQ_TAC) THENL [((DISCH_TAC THEN (ASM_REWRITE_TAC[]))); (* branch 2*) ((DISCH_TAC)) THEN ((ONCE_REWRITE_TAC [(GSYM REAL_INV_INV)])) THEN ((ASM_REWRITE_TAC[]))]);; let TWOPOW_ADD_1 = prove(`!a. (twopow (a +: (&:1)) = twopow (a) *. (twopow (&:1)))`, EVERY[ GEN_TAC; CHOOSE_TAC (SPEC `a:int` INT_REP3); POP_ASSUM DISJ_CASES_TAC THENL[ ASM_REWRITE_TAC[TWOPOW_POS;INT_OF_NUM_ADD;REAL_POW_ADD]; EVERY[ ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD;INT_NEG_ADD;GSYM INT_ADD_ASSOC;INT_ADD_LINV;INT_ADD_RID]; REWRITE_TAC[GSYM INT_NEG_ADD;INT_OF_NUM_ADD;TWOPOW_NEG;TWOPOW_POS]; ONCE_REWRITE_TAC[SPEC `(&. 2) pow 1` (GSYM REAL_INV_INV)]; REWRITE_TAC[GSYM REAL_INV_MUL;GSYM REAL_EQ_INV;REAL_POW_ADD;GSYM REAL_MUL_ASSOC;REAL_POW_1]; REWRITE_TAC[MATCH_MP REAL_MUL_RINV (REAL_ARITH `~((&. 2) = (&. 0))`); REAL_MUL_RID] ] ] ]);; let REAL_INV2 = prove( `(inv(&. 2)*(&. 2) = (&.1)) /\ ((&. 2)*inv(&. 2) = (&.1))`, SUBGOAL_TAC `~((&.2) = (&.0))` THENL[ REAL_ARITH_TAC; SIMP_TAC[REAL_MUL_RINV;REAL_MUL_LINV]]);; let TWOPOW_0 = prove(`twopow (&: 0) = (&. 1)`, (REWRITE_TAC[TWOPOW_POS;real_pow]));; let TWOPOW_SUB_NUM = prove(`!m n.( twopow((&:m) - (&: n)) = twopow((&:m))*. twopow(--: (&:n)))`, ((INDUCT_TAC)) THENL [REWRITE_TAC[INT_SUB_LZERO;REAL_MUL_LID;TWOPOW_0];ALL_TAC] THEN ((INDUCT_TAC THEN ( (ASM_REWRITE_TAC[INT_SUB_RZERO;TWOPOW_0;REAL_MUL_RID;INT_NEG_0;ADD1;GSYM INT_OF_NUM_ADD])))) THEN ((ASM_REWRITE_TAC [TWOPOW_ADD_1;TWOPOW_INV;prove (`((&:m)+(&:1)) -: ((&:n) +: (&:1)) = ((&:m)-: (&:n))`,INT_ARITH_TAC)])) THEN ((REWRITE_TAC[REAL_INV_MUL])) THEN ((ABBREV_TAC `a:real = twopow (&: m)`)) THEN ((ABBREV_TAC `b:real = inv(twopow (&: n))`)) THEN ((REWRITE_TAC[TWOPOW_POS;REAL_POW_1;GSYM REAL_MUL_ASSOC;prove (`!(x:real). ((&.2)*x = x*(&.2))`,REAL_ARITH_TAC)])) THEN ((REWRITE_TAC[REAL_INV2;REAL_MUL_RID])));; let TWOPOW_ADD_NUM = prove( `!m n. (twopow ((&:m) + (&:n)) = twopow((&:m))*. twopow((&:n)))`, (REWRITE_TAC[TWOPOW_POS;REAL_POW_ADD;INT_OF_NUM_ADD]));; let TWOPOW_ADD_INT = prove( `!a b. (twopow (a +: b) = twopow(a) *. (twopow(b)))`, ((REPEAT GEN_TAC)) THEN ((ASSUME_TAC (SPEC `a:int` INT_REP))) THEN ((POP_ASSUM CHOOSE_TAC)) THEN ((POP_ASSUM CHOOSE_TAC)) THEN ((ASSUME_TAC (SPEC `b:int` INT_REP))) THEN ((REPEAT (POP_ASSUM CHOOSE_TAC))) THEN ((ASM_REWRITE_TAC[])) THEN ((SUBGOAL_TAC `&: n -: &: m +: &: n' -: &: m' = (&: (n+n')) -: (&: (m+m'))`)) (* branch *) THENL[ ((REWRITE_TAC[GSYM INT_OF_NUM_ADD])) THEN ((INT_ARITH_TAC));ALL_TAC] (* 2nd *) THEN ((DISCH_TAC)) THEN ((ASM_REWRITE_TAC[TWOPOW_SUB_NUM;TWOPOW_INV;TWOPOW_POS;REAL_POW_ADD;REAL_INV_MUL;GSYM REAL_MUL_ASSOC])) THEN ((ABBREV_TAC `a':real = inv ((&. 2) pow m)`)) THEN ((ABBREV_TAC `c :real = (&. 2) pow n`)) THEN ((ABBREV_TAC `d :real = (&. 2) pow n'`)) THEN ((ABBREV_TAC `e :real = inv ((&. 2) pow m')`)) THEN (MESON_TAC[REAL_MUL_AC]));; let TWOPOW_ABS = prove(`!a. ||. (twopow a) = (twopow a)`, (GEN_TAC) THEN ((CHOOSE_THEN DISJ_CASES_TAC (SPEC `a:int` INT_REP2))) (* branch *) THEN ((ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG;REAL_ABS_POW;REAL_ABS_NUM;REAL_ABS_INV])));; let REAL_POW_POW = prove( `!x m n . (x **. m) **. n = x **. (m *| n)`, ((GEN_TAC THEN GEN_TAC THEN INDUCT_TAC)) (* branch *) THENL[ ((REWRITE_TAC[real_pow;MULT_0])); (* second branch *) ((REWRITE_TAC[real_pow])) THEN ((ASM_REWRITE_TAC[ADD1;LEFT_ADD_DISTRIB;REAL_POW_ADD;REAL_MUL_AC;MULT_CLAUSES]))]);; let INT_POW_POW = INT_OF_REAL_THM REAL_POW_POW;; let TWOPOW_POW = prove( `!a n. (twopow a) pow n = twopow (a *: (&: n))`, ((REPEAT GEN_TAC)) THEN ((CHOOSE_THEN DISJ_CASES_TAC (SPEC `a:int` INT_REP2))) (* branch *) THEN ((ASM_REWRITE_TAC[TWOPOW_POS;INT_OF_NUM_MUL; REAL_POW_POW;TWOPOW_NEG;REAL_POW_INV;INT_OF_NUM_MUL;GSYM INT_NEG_LMUL])));; (* ------------------------------------------------------------------ *) (* Arithmetic operations on float *) (* ------------------------------------------------------------------ *) let FLOAT_NEG = prove(`!a m. --. (float a m) = float (--: a) m`, REPEAT GEN_TAC THEN REWRITE_TAC[float;GSYM REAL_MUL_LNEG;int_neg_th]);; let FLOAT_MUL = prove(`!a b m n. (float a m) *. (float b n) = (float (a *: b) (m +: n))`, ((REPEAT GEN_TAC)) THEN ((REWRITE_TAC[float;GSYM REAL_MUL_ASSOC;TWOPOW_ADD_INT;int_mul_th])) THEN ((MESON_TAC[REAL_MUL_AC])));; let FLOAT_ADD = prove( `!a b c m. (float a (m+: (&:c))) +. (float b m) = (float ( (&:(2 EXP c))*a +: b) m)`, ((REWRITE_TAC[float;int_add_th;REAL_ADD_RDISTRIB;int_mul_th;TWOPOW_ADD_INT])) THEN ((REPEAT GEN_TAC)) THEN ((REWRITE_TAC[TWOPOW_POS;INT_NUM_REAL;GSYM REAL_OF_NUM_POW])) THEN ((MESON_TAC[REAL_MUL_AC])));; let FLOAT_ADD_EQ = prove( `!a b m. (float a m) +. (float b m) = (float (a+:b) m)`, ((REPEAT GEN_TAC)) THEN ((REWRITE_TAC[REWRITE_RULE[INT_ADD_RID] (SPEC `m:int` (SPEC `0` (SPEC `b:int` (SPEC `a:int` FLOAT_ADD))))])) THEN ((REWRITE_TAC[EXP;INT_MUL_LID])));; let FLOAT_ADD_NP = prove( `!a b m n. (float b (--:(&: n))) +. (float a (&: m)) = (float a (&: m)) +. (float b (--:(&: n)))`, (REWRITE_TAC[REAL_ADD_AC]));; let FLOAT_ADD_PN = prove( `!a b m n. (float a (&: m)) +. (float b (--(&: n))) = (float ( (&:(2 EXP (m+| n)))*a + b) (--:(&: n)))`, ((REPEAT GEN_TAC)) THEN ((SUBGOAL_TAC `&: m = (--:(&: n)) + (&:(m+n))`)) THENL[ ((REWRITE_TAC[GSYM INT_OF_NUM_ADD])) THEN ((INT_ARITH_TAC)); (* branch *) ((DISCH_TAC)) THEN ((ASM_REWRITE_TAC[FLOAT_ADD]))]);; let FLOAT_ADD_PP = prove( `!a b m n. ((n <=| m) ==>( (float a (&: m)) +. (float b (&: n)) = (float ((&:(2 EXP (m -| n))) *a + b) (&: n))))`, ((REPEAT GEN_TAC)) THEN (DISCH_TAC) THEN ((SUBGOAL_TAC `&: m = (&: n) + (&: (m-n))`)) THENL[ ((REWRITE_TAC[INT_OF_NUM_ADD])) THEN (AP_TERM_TAC) THEN ((REWRITE_TAC[prove (`!(m:num) n. (n+m-n) = (m-n)+n`,REWRITE_TAC[ADD_AC])])) THEN ((UNDISCH_EL_TAC 0)) THEN ((MATCH_ACCEPT_TAC(GSYM SUB_ADD))); (* branch *) ((DISCH_TAC)) THEN ((ASM_REWRITE_TAC[FLOAT_ADD]))]);; let FLOAT_ADD_PPv2 = prove( `!a b m n. ((m <| n) ==>( (float a (&: m)) +. (float b (&: n)) = (float ((&:(2 EXP (n -| m))) *b + a) (&: m))))`, ((REPEAT GEN_TAC)) THEN (DISCH_TAC) THEN ((H_MATCH_MP (THM (prove(`!m n. m<|n ==> m <=|n`,MESON_TAC[LT_LE]))) (HYP_INT 0))) THEN ((UNDISCH_EL_TAC 0)) THEN ((SIMP_TAC[GSYM FLOAT_ADD_PP])) THEN (DISCH_TAC) THEN ((REWRITE_TAC[REAL_ADD_AC])));; let FLOAT_ADD_NN = prove( `!a b m n. ((n <=| m) ==>( (float a (--:(&: m))) +. (float b (--:(&: n))) = (float ((&:(2 EXP (m -| n))) *b + a) (--:(&: m)))))`, ((REPEAT GEN_TAC)) THEN (DISCH_TAC) THEN ((SUBGOAL_TAC `--: (&: n) = --: (&: m) + (&: (m-n))`)) THENL [((UNDISCH_EL_TAC 0)) THEN ((SIMP_TAC [INT_OF_REAL_THM (GSYM REAL_OF_NUM_SUB)])) THEN (DISCH_TAC) THEN ((INT_ARITH_TAC)); (*branch*) ((DISCH_TAC)) THEN (ASM_REWRITE_TAC[GSYM FLOAT_ADD;REAL_ADD_AC])]);; let FLOAT_ADD_NNv2 = prove( `!a b m n. ((m <| n) ==>( (float a (--:(&: m))) +. (float b (--:(&: n))) = (float ((&:(2 EXP (n -| m))) *a + b) (--:(&: n)))))`, ((REPEAT GEN_TAC)) THEN (DISCH_TAC) THEN (((H_MATCH_MP (THM (prove(`!m n. m<|n ==> m <=|n`,MESON_TAC[LT_LE]))) (HYP_INT 0)))) THEN (((UNDISCH_EL_TAC 0))) THEN (((SIMP_TAC[GSYM FLOAT_ADD_NN]))) THEN ((DISCH_TAC)) THEN (((REWRITE_TAC[REAL_ADD_AC]))));; let FLOAT_SUB = prove( `!a b n m. (float a n) -. (float b m) = (float a n) +. (float (--: b) m)`, REWRITE_TAC[float;int_neg_th;real_sub;REAL_NEG_LMUL]);; let FLOAT_ABS = prove( `!a n. ||. (float a n) = (float (||: a) n)`, (REWRITE_TAC[float;int_abs_th;REAL_ABS_MUL;TWOPOW_ABS]));; let FLOAT_POW = prove( `!a n m. (float a n) **. m = (float (a **: m) (n *: (&:m)))`, (REWRITE_TAC[float;REAL_POW_MUL;int_pow_th;TWOPOW_POW]));; let INT_SUB = prove( `!a b. (a -: b) = (a +: (--: b))`, (REWRITE_TAC[GSYM INT_SUB_RNEG;INT_NEG_NEG]));; let INT_ABS_NUM = prove( `!n. ||: (&: n) = (&: n)`, (REWRITE_TAC[int_eq;int_abs_th;INT_NUM_REAL;REAL_ABS_NUM]));; let INT_ABS_NEG_NUM = prove( `!n. ||: (--: (&: n)) = (&: n)`, (REWRITE_TAC[int_eq;int_abs_th;int_neg_th;INT_NUM_REAL;REAL_ABS_NUM;REAL_ABS_NEG]));; let INT_ADD_NEG_NUM = prove(`!x y. --: (&: x) +: (&: y) = (&: y) +: (--: (&: x))`, (REWRITE_TAC[INT_ADD_AC]));; let INT_POW_MUL = INT_OF_REAL_THM REAL_POW_MUL;; let INT_POW_NEG1 = prove ( `!x n. (--: (&: x)) **: n = ((--: (&: 1)) **: n) *: ((&: x) **: n)`, (REWRITE_TAC[GSYM INT_POW_MUL; GSYM INT_NEG_MINUS1]));; let INT_POW_EVEN_NEG1 = prove( `!x n. (--: (&: x)) **: (NUMERAL (BIT0 n)) = ((&: x) **: (NUMERAL (BIT0 n)))`, ((REPEAT GEN_TAC)) THEN ((ONCE_REWRITE_TAC[INT_POW_NEG1])) THEN ((ABBREV_TAC `a = &: 1`)) THEN ((ABBREV_TAC `b = (&: x)**: (NUMERAL (BIT0 n))`)) THEN ((REWRITE_TAC[NUMERAL;BIT0])) THEN ((REWRITE_TAC[GSYM MULT_2;GSYM INT_POW_POW;INT_OF_REAL_THM REAL_POW_2;INT_NEG_MUL2])) THEN ((EXPAND_TAC "a")) THEN ((REWRITE_TAC[INT_MUL_RID;INT_MUL_LID;INT_OF_REAL_THM REAL_POW_ONE])));; let INT_POW_ODD_NEG1 = prove( `!x n. (--: (&: x)) **: (NUMERAL (BIT1 n)) = --: ((&: x) **: (NUMERAL (BIT1 n)))`, ((REPEAT GEN_TAC)) THEN ((ONCE_REWRITE_TAC[INT_POW_NEG1])) THEN (((ABBREV_TAC `a = &: 1`))) THEN (((ABBREV_TAC `b = (&: x)**: (NUMERAL (BIT1 n))`))) THEN ((REWRITE_TAC[NUMERAL;BIT1])) THEN ((ONCE_REWRITE_TAC[ADD1])) THEN ((EXPAND_TAC "a")) THEN ((REWRITE_TAC[GSYM MULT_2])) THEN ((REWRITE_TAC[INT_OF_REAL_THM POW_MINUS1;INT_OF_REAL_THM REAL_POW_ADD])) THEN ((REWRITE_TAC[INT_OF_REAL_THM POW_1;INT_MUL_LID;INT_MUL_LNEG])));; (* subtraction of integers *) let INT_ADD_NEG = prove( `!x y. (x < y ==> ((&: x) +: (--: (&: y)) = --: (&: (y - x))))`, ((REPEAT GEN_TAC)) THEN ((DISCH_TAC)) THEN ((SUBGOAL_TAC `&: (y-x ) = (&: y) - (&: x)`)) THENL [((SUBGOAL_TAC `x <=| y`)) (* branch *) THENL [(((ASM MESON_TAC)[LE_LT]));((SIMP_TAC[GSYM (INT_OF_REAL_THM REAL_OF_NUM_SUB)]))] (* branch *) ; ((DISCH_TAC)) THEN ((ASM_REWRITE_TAC[])) THEN (ACCEPT_TAC(INT_ARITH `&: x +: --: (&: y) = --: (&: y -: &: x)`))]);; let INT_ADD_NEGv2 = prove( `!x y. (y <= x ==> ((&: x) +: (--: (&: y)) = (&: (x - y))))`, ((REPEAT GEN_TAC)) THEN ((DISCH_TAC)) THEN ((SUBGOAL_TAC `&: (x - y) = (&: x) - (&: y)`)) THENL[ ((UNDISCH_EL_TAC 0)) THEN ((SIMP_TAC[GSYM (INT_OF_REAL_THM REAL_OF_NUM_SUB)])); ((DISCH_TAC)) THEN ((ASM_REWRITE_TAC[INT_SUB])) ] );; (* assumes a term of the form &:a +: (--: (&: b)) *) let INT_SUB_CONV t = let a,b = dest_binop `(+:)` t in let (_,a) = dest_comb a in let (_,b) = dest_comb b in let (_,b) = dest_comb b in let a = dest_numeral a in let b = dest_numeral b in let thm = if (b <=/ a) then INT_ADD_NEGv2 else INT_ADD_NEG in (ARITH_SIMP_CONV[thm]) t;; (* (SIMP_CONV[thm;ARITH]) t;; *) (* ------------------------------------------------------------------ *) (* Simplifies an arithmetic expression in floats *) (* A workhorse *) (* ------------------------------------------------------------------ *) let FLOAT_CONV = (ARITH_SIMP_CONV[FLOAT_MUL;FLOAT_SUB;FLOAT_ABS;FLOAT_POW; FLOAT_ADD_NN;FLOAT_ADD_NNv2;FLOAT_ADD_PP;FLOAT_ADD_PPv2; FLOAT_ADD_NP;FLOAT_ADD_PN;FLOAT_NEG; INT_NEG_NEG;INT_SUB; INT_ABS_NUM;INT_ABS_NEG_NUM; INT_MUL_LNEG;INT_MUL_RNEG;INT_NEG_MUL2;INT_OF_NUM_MUL; INT_OF_NUM_ADD;GSYM INT_NEG_ADD;INT_ADD_NEG_NUM; INT_OF_NUM_POW;INT_POW_ODD_NEG1;INT_POW_EVEN_NEG1; INT_ADD_NEG;INT_ADD_NEGv2 (* ; ARITH *) ]) ;; add_test("FLOAT_CONV1", let f z = let (x,y) = dest_eq z in let (u,v) = dest_thm (FLOAT_CONV x) in (u=[]) && (z = v) in f `float (&:3) (&:0) = float (&:3) (&:0)` && f `float (&:3) (&:3) = float (&:3) (&:3)` && f `float (&:3) (&:0) +. (float (&:4) (&:0)) = (float (&:7) (&:0))` && f `float (&:1 + (&:3)) (&:4) = float (&:4) (&:4)` && f `float (&:3 - (&:7)) (&:0) = float (--:(&:4)) (&:0)` && f `float (&:3) (&:4) *. (float (--: (&:2)) (&:3)) = float (--: (&:6)) (&:7)` && f `--. (float (--: (&:3)) (&:0)) = float (&:3) (&:0)` );; (* ------------------------------------------------------------------ *) (* Operations on interval. Preliminary stuff to deal with *) (* chains of inequalities. *) (* ------------------------------------------------------------------ *) let REAL_ADD_LE_SUBST_RHS = prove( `!a b c P. ((a <=. ((P b)) /\ (!x. (P x) = x + (P (&. 0))) /\ (b <=. c)) ==> (a <=. (P c)))`, (((REPEAT GEN_TAC))) THEN (((REPEAT (TAUT_TAC `(b ==> a==> c) ==> (a /\ b ==> c)`)))) THEN (((REPEAT DISCH_TAC))) THEN ((((H_RULER(ONCE_REWRITE_RULE))[HYP_INT 1] (HYP_INT 0)))) THEN ((((ASM ONCE_REWRITE_TAC)[]))) THEN ((((ASM MESON_TAC)[REAL_LE_RADD;REAL_LE_TRANS]))));; let REAL_ADD_LE_SUBST_LHS = prove( `!a b c P. (((P(a) <=. b /\ (!x. (P x) = x + (P (&. 0))) /\ (c <=. a))) ==> ((P c) <=. b))`, (REP_GEN_TAC) THEN (DISCH_ALL_TAC) THEN (((H_RULER(ONCE_REWRITE_RULE)) [HYP_INT 1] (HYP_INT 0))) THEN (((ASM ONCE_REWRITE_TAC)[])) THEN (((ASM MESON_TAC)[REAL_LE_RADD;REAL_LE_TRANS])));; (* let rec SPECL = function [] -> I | (a::b) -> fun thm ->(SPECL b (SPEC a thm));; *) (* input: rel: b <=. c thm: a <=. P(b). output: a <=. P(c). condition: REAL_ARITH must be able to prove !x. P(x) = x+. P(&.0). condition: the term `a` must appear exactly once the lhs of the thm. *) let IWRITE_REAL_LE_RHS rel thm = let bvar = genvar `:real` in let (bt,_) = dest_binop `(<=.)` (concl rel) in let sub = SUBS_CONV[ASSUME (mk_eq(bt,bvar))] in let rule = (fun th -> EQ_MP (sub (concl th)) th) in let (subrel,subthm) = (rule rel,rule thm) in let (a,p) = dest_binop `(<=.)` (concl subthm) in let (_,c) = dest_binop `(<=.)` (concl subrel) in let pfn = mk_abs (bvar,p) in let imp_th = BETA_RULE (SPECL [a;bvar;c;pfn] REAL_ADD_LE_SUBST_RHS) in let ppart = REAL_ARITH (fst(dest_conj(snd(dest_conj(fst(dest_imp(concl imp_th))))))) in let prethm = MATCH_MP imp_th (CONJ subthm (CONJ ppart subrel)) in let prethm2 = SPEC bt (GEN bvar (DISCH (find (fun x -> try(bvar = rhs x) with failure -> false) (hyp prethm)) prethm)) in MATCH_MP prethm2 (REFL bt);; (* input: rel: c <=. a thm: P a <=. b output: P c <=. b condition: REAL_ARITH must be able to prove !x. P(x) = x+. P(&.0). condition: the term `a` must appear exactly once the lhs of the thm. *) let IWRITE_REAL_LE_LHS rel thm = let avar = genvar `:real` in let (_,at) = dest_binop `(<=.)` (concl rel) in let sub = SUBS_CONV[ASSUME (mk_eq(at,avar))] in let rule = (fun th -> EQ_MP (sub (concl th)) th) in let (subrel,subthm) = (rule rel,rule thm) in let (p,b) = dest_binop `(<=.)` (concl subthm) in let (c,_) = dest_binop `(<=.)` (concl subrel) in let pfn = mk_abs (avar,p) in let imp_th = BETA_RULE (SPECL [avar;b;c;pfn] REAL_ADD_LE_SUBST_LHS) in let ppart = REAL_ARITH (fst(dest_conj(snd(dest_conj(fst(dest_imp(concl imp_th))))))) in let prethm = MATCH_MP imp_th (CONJ subthm (CONJ ppart subrel)) in let prethm2 = SPEC at (GEN avar (DISCH (find (fun x -> try(avar = rhs x) with failure -> false) (hyp prethm)) prethm)) in MATCH_MP prethm2 (REFL at);; (* ------------------------------------------------------------------ *) (* INTERVAL ADD, NEG, SUBTRACT *) (* ------------------------------------------------------------------ *) let INTERVAL_ADD = prove( `!x f ex y g ey. interval x f ex /\ interval y g ey ==> interval (x +. y) (f +. g) (ex +. ey)`, EVERY[ REPEAT GEN_TAC; TAUT_TAC `(A==>B==>C)==>(A/\ B ==> C)`; REWRITE_TAC[interval]; REWRITE_TAC[prove(`(x+.y) -. (f+.g) = (x-.f) +. (y-.g)`,REAL_ARITH_TAC)]; ABBREV_TAC `a = x-.f`; ABBREV_TAC `b = y-.g`; ASSUME_TAC (SPEC `b:real` (SPEC `a:real` ABS_TRIANGLE)); UNDISCH_EL_TAC 0; ABBREV_TAC `a':real = abs a`; ABBREV_TAC `b':real = abs b`; REPEAT DISCH_TAC; (H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 2); (H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 2) (HYP_INT 0); ASM_REWRITE_TAC[]]);; let INTERVAL_NEG = prove( `!x f ex. interval x f ex = interval (--. x) (--. f) ex`, (REWRITE_TAC[interval;REAL_ABS_NEG;REAL_ARITH `!x y. -- x -. (-- y) = --. (x -. y)`]));; let INTERVAL_NEG2 = prove( `!x f ex. interval (--. x) f ex = interval x (--. f) ex`, (REWRITE_TAC[interval;REAL_ABS_NEG;REAL_ARITH `!x y. -- x -. y = --. (x -. (--. y))`]));; let INTERVAL_SUB = prove( `!x f ex y g ey. interval x f ex /\ interval y g ey ==> interval (x -. y) (f -. g) (ex +. ey)`, ((REWRITE_TAC[real_sub])) THEN (DISCH_ALL_TAC) THEN (((H_RULER (ONCE_REWRITE_RULE))[THM(INTERVAL_NEG)] (HYP_INT 1))) THEN (((ASM MESON_TAC)[INTERVAL_ADD])));; (* ------------------------------------------------------------------ *) (* INTERVAL MULTIPLICATION *) (* ------------------------------------------------------------------ *) let REAL_PROP_LE_LABS = prove( `!x y z. (y <=. z) ==> ((abs x)* y <=. (abs x) *z)`,(SIMP_TAC[REAL_LE_LMUL_IMP;ABS_POS]));; (* renamed from REAL_LE_ABS_RMUL *) let REAL_PROP_LE_RABS = prove( `!x y z. (y <=. z) ==> ( y * (abs x) <=. z *(abs x))`,(SIMP_TAC[REAL_LE_RMUL_IMP;ABS_POS]));; let REAL_LE_ABS_MUL = prove( `!x y z w. (( x <=. y) /\ (abs z <=. w)) ==> (x*.w <=. y*.w) `, (DISCH_ALL_TAC) THEN ((ASSUME_TAC (REAL_ARITH `abs z <=. w ==> (&.0) <=. w`))) THEN (((ASM MESON_TAC)[REAL_LE_RMUL_IMP])));; let INTERVAL_MUL = prove( `!x f ex y g ey. (interval x f ex) /\ (interval y g ey) ==> (interval (x *. y) (f *. g) (abs(f)*.ey +. ex*. abs(g) +. ex*.ey))`, (REP_GEN_TAC) THEN ((REWRITE_TAC[interval])) THEN ((REWRITE_TAC[REAL_ARITH `(x*. y -. f*. g) = (f *.(y -. g) +. (x -. f)*.g +. (x-.f)*.(y-. g))`])) THEN (DISCH_ALL_TAC) THEN ((ASSUME_TAC (SPECL [`f*.(y-g)`;`(x-f)*g +. (x-f)*.(y-g)`] ABS_TRIANGLE))) THEN ((ASSUME_TAC (SPECL [`(x-f)*.g`;`(x-f)*.(y-g)`] ABS_TRIANGLE))) THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) THEN ((H_REWRITE_RULE [THM ABS_MUL] (HYP_INT 0))) THEN ((H_MATCH_MP (THM (SPECL [`g:real`; `abs (x -. f)`; `ex:real`] REAL_PROP_LE_RABS)) (HYP_INT 4))) THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) THEN ((H_MATCH_MP (THM (SPECL [`f:real`; `abs (y -. g)`; `ey:real`] REAL_PROP_LE_LABS)) (HYP_INT 7))) THEN (((H_VAL2 (IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) THEN ((H_MATCH_MP (THM (SPECL [`x-.f`; `abs (y -. g)`; `ey:real`] REAL_PROP_LE_LABS)) (HYP_INT 9))) THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) THEN ((ASSUME_TAC (SPECL [`abs(x-.f)`;`ex:real`;`y-.g`;`ey:real`] REAL_LE_ABS_MUL))) THEN ((H_CONJ (HYP_INT 11) (HYP_INT 12))) THEN ((H_MATCH_MP (HYP_INT 1) (HYP_INT 0))) THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 3))) THEN ((POP_ASSUM ACCEPT_TAC)));; (* ------------------------------------------------------------------ *) (* INTERVAL BASIC OPERATIONS *) (* ------------------------------------------------------------------ *) let INTERVAL_NUM = prove( `!n. (interval(&.n) (float(&:n) (&:0)) (float (&: 0) (&:0)))`, (REWRITE_TAC[interval;float;TWOPOW_POS;pow;REAL_MUL_RID;INT_NUM_REAL;REAL_SUB_REFL;REAL_ABS_0;REAL_LE_REFL]));; let INTERVAL_CENTER = prove( `!x f ex g. (interval x f ex) ==> (interval x g (abs(f-g)+.ex))`, ((REWRITE_TAC[interval])) THEN (DISCH_ALL_TAC) THEN ((ASSUME_TAC (REAL_ARITH `abs(x -. g) <=. abs(f-.g) +. abs(x -. f)`))) THEN ((H_VAL2 IWRITE_REAL_LE_RHS (HYP_INT 1) (HYP_INT 0))) THEN ((ASM_REWRITE_TAC[])));; let INTERVAL_WIDTH = prove( `!x f ex ex'. (ex <=. ex') ==> (interval x f ex) ==> (interval x f ex')`, ((REWRITE_TAC[interval])) THEN (DISCH_ALL_TAC) THEN ((H_VAL2 IWRITE_REAL_LE_RHS (HYP_INT 1) (HYP_INT 0))) THEN ((ASM_REWRITE_TAC[])));; let INTERVAL_MAX = prove( `!x f ex. interval x f ex ==> (x <=. f+.ex)`, (REWRITE_TAC[interval]) THEN REAL_ARITH_TAC);; let INTERVAL_MIN = prove( `!x f ex. interval x f ex ==> (f-. ex <=. x)`, (REWRITE_TAC[interval]) THEN REAL_ARITH_TAC);; let INTERVAL_ABS_MIN = prove( `!x f ex. interval x f ex ==> (abs(f)-. ex <=. abs(x))`, (REWRITE_TAC[interval] THEN REAL_ARITH_TAC) );; let INTERVAL_ABS_MAX = prove( `!x f ex. interval x f ex ==> (abs(x) <=. abs(f)+. ex)`, (REWRITE_TAC[interval] THEN REAL_ARITH_TAC) );; let REAL_RINV_2 = prove( `&.2 *. (inv (&.2 )) = &. 1`, EVERY[ MATCH_MP_TAC REAL_MUL_RINV; REAL_ARITH_TAC]);; let INTERVAL_MK = prove( `let half = float(&:1)(--:(&:1)) in !x xmin xmax. ((xmin <=. x) /\ (x <=. xmax)) ==> interval x ((xmin+.xmax)*.half) ((xmax-.xmin)*.half)`, EVERY[ REWRITE_TAC[LET_DEF;LET_END_DEF]; DISCH_ALL_TAC; REWRITE_TAC[interval;float;TWOPOW_NEG;INT_NUM_REAL;REAL_POW_1;REAL_MUL_LID]; REWRITE_TAC[GSYM INTERVAL_ABS]; CONJ_TAC ] THENL[ EVERY[ REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; REWRITE_TAC[REAL_ARITH `(b+.a)-.(a-.b)=b*.(&.2)`;GSYM REAL_MUL_ASSOC]; ASM_REWRITE_TAC[REAL_RINV_2;REAL_MUL_RID] ]; EVERY[ REWRITE_TAC[GSYM REAL_ADD_RDISTRIB]; REWRITE_TAC[REAL_ARITH `(b+.a)+. a -. b=a*.(&.2)`;GSYM REAL_MUL_ASSOC]; ASM_REWRITE_TAC[REAL_RINV_2;REAL_MUL_RID] ] ]);; let INTERVAL_EPS_POS = prove(`!x f ex. (interval x f ex) ==> (&.0 <=. ex)`, EVERY[ REWRITE_TAC[interval]; REPEAT (GEN_TAC); DISCH_THEN(fun x -> (MP_TAC (CONJ (SPEC `x-.f` REAL_ABS_POS) x))); MATCH_ACCEPT_TAC REAL_LE_TRANS]);; let INTERVAL_EPS_0 = prove( `!x f n. (interval x f (float (&:0) n)) ==> (x = f)`, EVERY[ REWRITE_TAC[interval;float;int_of_num_th;REAL_MUL_LZERO]; REAL_ARITH_TAC]);; let REAL_EQ_RCANCEL_IMP' = prove(`!x y z.(x * z = y * z) ==> (~(z = &0) ==> (x=y))`, MESON_TAC[REAL_EQ_RCANCEL_IMP]);; (* renamed from REAL_ABS_POS *) let REAL_MK_POS_ABS_' = prove (`!x. (~(x=(&.0))) ==> (&.0 < abs(x))`, MESON_TAC[REAL_PROP_NZ_ABS;ABS_POS;REAL_LT_LE]);; (* ------------------------------------------------------------------ *) (* INTERVAL DIVIDE *) (* ------------------------------------------------------------------ *) let INTERVAL_DIV = prove(`!x f ex y g ey h ez. (((interval x f ex) /\ (interval y g ey) /\ (ey <. (abs g)) /\ ((ex +. (abs (f -. (h*.g))) +. (abs h)*. ey) <=. (ez*.((abs g) -. ey)))) ==> (interval (x / y) h ez))`, let lemma1 = prove( `&.0 < u /\ ||. z <=. e*. u ==> (&.0) <=. e`, EVERY[ DISCH_ALL_TAC; ASSUME_TAC (SPEC `z:real` REAL_MK_NN_ABS); H_MATCH_MP (THM REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 2)); H_MATCH_MP (THM REAL_PROP_NN_RCANCEL) (H_RULE2 CONJ (HYP_INT 2) (HYP_INT 0)); ASM_REWRITE_TAC[] ]) in EVERY[ DISCH_ALL_TAC; SUBGOAL_TAC `~(y= (&.0))` THENL[ EVERY[ UNDISCH_LIST[1;2]; REWRITE_TAC[interval]; REAL_ARITH_TAC ]; EVERY[ REWRITE_TAC[interval]; DISCH_TAC THEN (H I (HYP_INT 0)) THEN (UNDISCH_EL_TAC 0); DISCH_THEN (fun th -> (MP_TAC(MATCH_MP REAL_MK_POS_ABS_' th))); MATCH_MP_TAC REAL_MUL_RTIMES_LE; REWRITE_TAC[GSYM ABS_MUL;REAL_SUB_RDISTRIB;real_div;GSYM REAL_MUL_ASSOC]; ASM_SIMP_TAC[REAL_MUL_LINV;REAL_MUL_RID]; H (REWRITE_RULE[interval]) (HYP_INT 1); H (REWRITE_RULE[interval]) (HYP_INT 3); H (MATCH_MP INTERVAL_ABS_MIN) (HYP_INT 4); POPL_TAC[3;4;5]; H_VAL2 (IWRITE_REAL_LE_LHS) (HYP_INT 2) (HYP_INT 4); H (REWRITE_RULE[ REAL_ADD_ASSOC]) (HYP_INT 0); H_VAL2 (IWRITE_REAL_LE_LHS) (THM (SPEC `f-. h*g` (SPEC `x-.f` ABS_TRIANGLE))) (HYP_INT 0); H (ONCE_REWRITE_RULE[REAL_ABS_SUB]) (HYP_INT 4); H (MATCH_MP (SPEC `h:real` REAL_PROP_LE_LABS)) (HYP_INT 0); H (REWRITE_RULE[GSYM ABS_MUL]) (HYP_INT 0); H_VAL2 (IWRITE_REAL_LE_LHS) (HYP_INT 0) (HYP_INT 3); H_VAL2 (IWRITE_REAL_LE_LHS) (THM (SPEC `h*.(g-.y)` (SPEC`(x-.f)+(f-. h*g)` ABS_TRIANGLE))) (HYP_INT 0); POPL_TAC[1;2;3;4;5;6;7;9;10;12]; H (ONCE_REWRITE_RULE[REAL_ARITH `((x-.f) +. (f -. h*. g)) +. h*.(g-. y) = x -. h*. y `]) (HYP_INT 0); ABBREV_TAC `z = x -. h*.y`; H (ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) (HYP_INT 4); ABBREV_TAC `u = abs(g) -. ey`; POPL_TAC[0;2;4;6]; H (MATCH_MP lemma1 ) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 1)); H (MATCH_MP REAL_PROP_LE_LMUL) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 3)); H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0)); ASM_REWRITE_TAC[] ]; ]]);; (* ------------------------------------------------------------------ *) (* INTERVAL ABS VALUE *) (* ------------------------------------------------------------------ *) let INTERVAL_ABSV = prove(`!x f ex. interval x f ex ==> (interval (abs x) (abs f) ex)`, EVERY[ REWRITE_TAC[interval]; DISCH_ALL_TAC; ASSUME_TAC (SPECL [`x:real`;`f:real`] REAL_ABS_SUB_ABS); ASM_MESON_TAC[REAL_LE_TRANS] ]);; (* 7 minutes *) (* ------------------------------------------------------------------ *) (* INTERVAL SQRT *) (* This requires some preliminaries. Extend sqrt by 0 on negatives *) (* ------------------------------------------------------------------ *) let ssqrt = new_definition `ssqrt x = if (x <. (&.0)) then (&.0) else sqrt x`;; (*2m*) let LET_TAC = REWRITE_TAC[LET_DEF;LET_END_DEF];; let REAL_SSQRT_NEG = prove(`!x. (x <. (&.0)) ==> (ssqrt x = (&.0))`, EVERY[ DISCH_ALL_TAC; REWRITE_TAC[ssqrt]; COND_CASES_TAC THENL[ ACCEPT_TAC (REFL `&.0`); ASM_MESON_TAC[] ] ]);; (* 5 min*) let REAL_SSQRT_NN = prove(`!x. (&.0) <=. x ==> (ssqrt x = (sqrt x))`, EVERY[ DISCH_ALL_TAC; REWRITE_TAC[ssqrt]; COND_CASES_TAC THENL[ ASM_MESON_TAC[real_lt]; ACCEPT_TAC (REFL `sqrt x`) ] ]);; (* 12 min, mostly spent loading *index-shell* *) (*17 minutes*) let REAL_MK_NN_SSQRT = prove(`!x. (&.0) <=. (ssqrt x)`, EVERY[ GEN_TAC; DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL) THENL[ POP_ASSUM (fun th -> MP_TAC(MATCH_MP (REAL_SSQRT_NEG) th)) THEN MESON_TAC[REAL_LE_REFL]; POP_ASSUM (fun th -> ASSUME_TAC(CONJ th (MATCH_MP (REAL_SSQRT_NN) th))) THEN ASM_MESON_TAC[REAL_PROP_NN_SQRT] ] ]);; let REAL_SV_SSQRT_0 = prove(`!x. ssqrt (&.0) = (&.0)`, EVERY[ GEN_TAC; MP_TAC (SPEC `&.0` REAL_LE_REFL); DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_SSQRT_NN th]); ACCEPT_TAC REAL_SV_SQRT_0 ]);; (* 6 minutes *) let REAL_SSQRT_EQ_0 = prove(`!(x:real). (ssqrt(x) = (&.0)) ==> (x <=. (&.0))`, EVERY[ GEN_TAC; DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL) THENL[ ASM_MESON_TAC[REAL_LT_IMP_LE]; ASM_SIMP_TAC[REAL_SSQRT_NN] THEN ASM_MESON_TAC[SQRT_EQ_0;REAL_EQ_IMP_LE] ] ]);; (* 15 minutes *) let REAL_SSQRT_MONO = prove(`!x. (x<=. y) ==> (ssqrt x <=. (ssqrt y))`, EVERY[ GEN_TAC; DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL) THENL[ ASM_MESON_TAC[REAL_SSQRT_NEG;REAL_MK_NN_SSQRT]; ASM_MESON_TAC[REAL_LE_TRANS;REAL_SSQRT_NN;REAL_PROP_LE_SQRT]; ] ]);; (* 5 minutes *) let REAL_SSQRT_CHAR = prove(`!x t. (&.0 <=. t /\ (t*t = x)) ==> (t = (ssqrt x))`, EVERY[ DISCH_ALL_TAC; H_ASSUME_TAC (H_RULE_LIST REWRITE_RULE[HYP_INT 1] (THM (SPEC `t:real` REAL_MK_NN_SQUARE))); ASM_MESON_TAC[REAL_SSQRT_NN;SQRT_MUL;POW_2_SQRT_ABS;REAL_POW_2;REAL_ABS_REFL]; ]);; (* 13 minutes *) let REAL_SSQRT_SQUARE = prove(`!x. (&.0 <=. x) ==> ((ssqrt x)*.(ssqrt x) = x)`, MESON_TAC[REAL_SSQRT_NN;POW_2;SQRT_POW_2]);;(* 7min *) let REAL_SSQRT_SQUARE' = prove(`!x. (&.0<=. x) ==> (ssqrt (x*.x) = x)`, DISCH_ALL_TAC THEN REWRITE_TAC[(MATCH_MP REAL_SSQRT_NN (SPEC `x:real` REAL_MK_NN_SQUARE))] THEN ASM_SIMP_TAC[SQRT_MUL;GSYM POW_2;SQRT_POW_2]);; (*20min*) (* an alternate proof appears in RCS *) let INTERVAL_SSQRT = prove(`!x f ex u ey ez v. (interval x f ex) /\ (interval (u*.u) f ey) /\ (ex +.ey <=. ez*.(v+.u)) /\ (v*.v <=. f-.ex) /\ (&.0 <. u) /\ (&.0 <=. v) ==> (interval (ssqrt x) u ez)`, EVERY[ DISCH_ALL_TAC; H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (THM (SPEC `v:real` REAL_MK_NN_SQUARE)) (HYP_INT 3)); H (MATCH_MP (INTERVAL_MIN)) (HYP_INT 1); H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0)); H (MATCH_MP INTERVAL_EPS_POS) (HYP_INT 3); H (MATCH_MP INTERVAL_EPS_POS) (HYP_INT 5); H (MATCH_MP REAL_PROP_NN_ADD2) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0)); H (MATCH_MP REAL_PROP_POS_LADD) (H_RULE2 CONJ (HYP_INT 11) (HYP_INT 10)); H (MATCH_MP REAL_PROP_POS_LADD) (H_RULE2 CONJ (THM (SPEC `x:real` REAL_MK_NN_SSQRT)) (HYP_INT 11)); H (MATCH_MP REAL_PROP_POS_INV) (HYP_INT 0); ASSUME_TAC (REAL_ARITH `(ssqrt x -. u) = (ssqrt x -. u)*.(&.1)`); H (MATCH_MP REAL_MK_NZ_POS) (HYP_INT 2); H (MATCH_MP REAL_MUL_RINV) (HYP_INT 0); H_REWRITE_RULE[(H_RULE GSYM) (HYP_INT 0)] (HYP_INT 2); POPL_TAC[1;2;3]; H (REWRITE_RULE[REAL_MUL_ASSOC]) (HYP_INT 0); H (REWRITE_RULE[ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_DIFFSQ]) (HYP_INT 0); POPL_TAC[1;2]; H_SIMP_RULE[HYP_INT 7;THM REAL_SSQRT_SQUARE] (HYP_INT 0); ASSUME_TAC (REAL_ARITH `abs(x -. u*.u) <=. abs(x -. f) + abs(f-. u*.u)`); H (REWRITE_RULE[interval]) (HYP_INT 12); H (ONCE_REWRITE_RULE[interval]) (HYP_INT 14); H (ONCE_REWRITE_RULE[REAL_ABS_SUB]) (HYP_INT 0); POPL_TAC[1;5;15;16]; H (MATCH_MP REAL_LE_ADD2) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0)); H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0)); POPL_TAC[1;2;3;4]; H (AP_TERM `||.`) (HYP_INT 1); H (REWRITE_RULE[ABS_MUL]) (HYP_INT 0); H (MATCH_MP REAL_LT_IMP_LE) (HYP_INT 4); H (REWRITE_RULE[GSYM REAL_ABS_REFL]) (HYP_INT 0); H_REWRITE_RULE [HYP_INT 0] (HYP_INT 2); H (MATCH_MP REAL_LE_RMUL) (H_RULE2 CONJ (HYP_INT 5) (HYP_INT 2)); H_REWRITE_RULE [H_RULE GSYM (HYP_INT 1)] (HYP_INT 0); POPL_TAC[1;2;3;5;6;7;8]; H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 12) (HYP_INT 9)); H (MATCH_MP REAL_SSQRT_MONO) (HYP_INT 0); H (MATCH_MP REAL_SSQRT_SQUARE') (HYP_INT 16); H_REWRITE_RULE [HYP_INT 0] (HYP_INT 1); H (ONCE_REWRITE_RULE[GSYM (SPECL[`v:real`;`ssqrt x`;`u:real`] REAL_LE_RADD)]) (HYP_INT 0); H (MATCH_MP REAL_LE_INV2) (H_RULE2 CONJ (HYP_INT 9) (HYP_INT 0)); POPL_TAC[1;2;3;4;5;7;8;9;12;13]; H (MATCH_MP REAL_LE_LMUL) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0)); H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 2) (HYP_INT 0)); H (MATCH_MP REAL_PROP_POS_INV) (HYP_INT 4); H (MATCH_MP REAL_LT_IMP_LE) (HYP_INT 0); H (MATCH_MP REAL_LE_RMUL) (H_RULE2 CONJ (HYP_INT 11) (HYP_INT 0)); H (REWRITE_RULE[GSYM REAL_MUL_ASSOC]) (HYP_INT 0); H (MATCH_MP REAL_MK_NZ_POS) (HYP_INT 8); H (MATCH_MP REAL_MUL_RINV) (HYP_INT 0); H_REWRITE_RULE[HYP_INT 0; THM REAL_MUL_RID] (HYP_INT 2); H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 7) (HYP_INT 0)); ASM_REWRITE_TAC[interval] ]);; test();; (* conversion for interval *) (* ------------------------------------------------------------------ *) (* Take a term x of type real. Convert to a thm of the form *) (* interval x f eps *) (* *) (* ------------------------------------------------------------------ *) let DOUBLE_CONV_FILE=true;; let add_test,test = new_test_suite();; (* Num package docs at http://caml.inria.fr/ocaml/htmlman/libref/Num.html *) (* ------------------------------------------------------------------ *) (* num_exponent Take the absolute value of input. Write it as a*2^k, where 1 <= a < 2, return k. Except: num_exponent (Int 0) is -1. *) let (num_exponent:Num.num -> Num.num) = fun a -> let afloat = float_of_num (abs_num a) in Int ((snd (frexp afloat)) - 1);; (*test*)let f (u,v) = ((num_exponent u) =(Int v)) in add_test("num_exponenwt", forall f [Int 1,0; Int 65,6; Int (-65),6; Int 0,-1; (Int 3)//(Int 4),-1]);; (* ------------------------------------------------------------------ *) let dest_unary op tm = try let xop,r = dest_comb tm in if xop = op then r else fail() with Failure _ -> failwith "dest_unary";; (* ------------------------------------------------------------------ *) (* finds a nearby (outward-rounded) Int with only prec_b significant bits *) let (round_outward: int -> Num.num -> Num.num) = fun prec_b a -> let b = abs_num a in let sign = if (a =/ b) then I else minus_num in let throw_bits = Num.max_num (Int 0) ((num_exponent b)-/ (Int prec_b)) in let twoexp = power_num (Int 2) throw_bits in (sign (ceiling_num (b // twoexp)))*/twoexp;; let (round_inward: int-> Num.num -> Num.num) = fun prec_b a -> let b = abs_num a in let sign = if (a=/b) then I else minus_num in let throw_bits = Num.max_num (Int 0) ((num_exponent b)-/ (Int prec_b)) in let twoexp = power_num (Int 2) throw_bits in (sign (floor_num (b // twoexp)))*/twoexp;; let round_rat bprec n = let b = abs_num n in let sign = if (b =/ n) then I else minus_num in let powt = ((Int 2) **/ (Int bprec)) in sign ((round_outward bprec (Num.ceiling_num (b */ powt)))//powt);; let round_inward_rat bprec n = let b = abs_num n in let sign = if (b =/ n) then I else minus_num in let powt = ((Int 2) **/ (Int bprec)) in sign ((round_inward bprec (Num.floor_num (b */ powt)))//powt);; let (round_outward_float: int -> float -> Num.num) = fun bprec f -> if (f=0.0) then (Int 0) else begin let b = abs_float f in let sign = if (f >= 0.0) then I else minus_num in let (x,n) = frexp b in let u = int_of_float( ceil (ldexp x bprec)) in sign ((Int u)*/ ((Int 2) **/ (Int (n - bprec)))) end;; let (round_inward_float: int -> float -> Num.num) = fun bprec f -> if (f=0.0) then (Int 0) else begin (* avoid overflow on 30 bit integers *) let bprec = if (bprec > 25) then 25 else bprec in let b = abs_float f in let sign = if (f >= 0.0) then I else minus_num in let (x,n) = frexp b in let u = int_of_float( floor (ldexp x bprec)) in sign ((Int u)*/ ((Int 2) **/ (Int (n - bprec)))) end;; (* ------------------------------------------------------------------ *) (* This doesn't belong here. A general term substitution function *) let SUBST_TERM sublist tm = rhs (concl ((SPECL (map fst sublist)) (GENL (map snd sublist) (REFL tm))));; add_test("SUBST_TERM", SUBST_TERM [(`#1`,`a:real`);(`#2`,`b:real`)] (`a +. b +. c`) = `#1 + #2 + c`);; (* ------------------------------------------------------------------ *) (* take a term of the form `interval x f ex` and clean up the f and ex *) let INTERVAL_CLEAN_CONV:conv = fun interv -> let (ixf,ex) = dest_comb interv in let (ix,f) = dest_comb ixf in let fthm = FLOAT_CONV f in let exthm = FLOAT_CONV ex in let ixfthm = AP_TERM ix fthm in MK_COMB (ixfthm, exthm);; (*test*) add_test("INTERVAL_CLEAN_CONV", let testval = INTERVAL_CLEAN_CONV `interval ((&.1) +. (&.1)) (float (&:3) (&:4) +. (float (&:2) (--: (&:3)))) (float (&:1) (&:2) *. (float (&:3) (--: (&:2))))` in let hypval = hyp testval in let concval = concl testval in (length hypval = 0) && concval = `interval (&1 + &1) (float (&:3) (&:4) + float (&:2) (--: (&:3))) (float (&:1) (&:2) * float (&:3) (--: (&:2))) = interval (&1 + &1) (float (&:386) (--: (&:3))) (float (&:3) (&:0))` );; (* ------------------------------------------------------------------ *) (* GENERAL lemmas *) (* ------------------------------------------------------------------ *) (* verifies statement of the form `float a b = float a' b'` *) let FLOAT_EQ = prove( `!a b a' b'. (float a b = (float a' b')) <=> ((float a b) -. (float a' b') = (&.0))`,MESON_TAC[REAL_SUB_0]);; let FLOAT_LT = prove( `!a b a' b'. (float a b <. (float a' b')) <=> ((&.0) <. (float a' b') -. (float a b))`,MESON_TAC[REAL_SUB_LT]);; let FLOAT_LE = prove( `!a b a' b'. (float a b <=. (float a' b')) <=> ((&.0) <=. (float a' b') -. (float a b))`,MESON_TAC[REAL_SUB_LE]);; let TWOPOW_MK_POS = prove( `!a. (&.0 <. ( twopow a))`, EVERY[ GEN_TAC; CHOOSE_TAC (SPEC `a:int` INT_REP2); POP_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG]; TRY (MATCH_MP_TAC REAL_INV_POS); MATCH_MP_TAC REAL_POW_LT ; REAL_ARITH_TAC; ]);; let TWOPOW_NZ = prove( `!a. ~(twopow a = (&.0))`, GEN_TAC THEN ACCEPT_TAC (MATCH_MP REAL_MK_NZ_POS (SPEC `a:int` TWOPOW_MK_POS)));; let FLOAT_ZERO = prove( `!a b. (float a b = (&.0)) <=> (a = (&:0))`, EVERY[ REWRITE_TAC[float;REAL_ENTIRE;INT_OF_NUM_DEST]; MESON_TAC[TWOPOW_NZ]; ]);; let INT_ZERO = prove( `!n. ((&:n = (&:0)) = (n=0))`,REWRITE_TAC[INT_OF_NUM_EQ]);; let INT_ZERO_NEG=prove( `!n. ((--: (&:n) = (&:0))) <=> (n=0)`, REWRITE_TAC[INT_NEG_EQ_0;INT_ZERO]);; let FLOAT_NN = prove( `!a b. ((&.0) <=. (float a b)) <=> (&:0 <=: a)`, EVERY[ REWRITE_TAC[float;INT_OF_NUM_DEST]; REP_GEN_TAC; EQ_TAC THENL[EVERY[ DISCH_ALL_TAC; INPUT_COMBO[THM REAL_PROP_NN_RCANCEL;THM (SPEC `b:int` TWOPOW_MK_POS) &&& (HYP"0")]; ASM_MESON_TAC[int_le;int_of_num_th]]; EVERY[ DISCH_ALL_TAC; INPUT_COMBO[THM REAL_PROP_NN_POS;THM(SPEC`b:int`TWOPOW_MK_POS)]; INPUT_COMBO[THM int_of_num_th ; THM int_le ;(HYP"0")]; INPUT_COMBO[THM REAL_PROP_NN_MUL2; (HYP"2")&&&(HYP"1")]; ASM_REWRITE_TAC[]]] ]);; let INT_NN = INT_POS;; let INT_NN_NEG = prove(`!n. ((&:0) <=: (--:(&:n))) <=> (n = 0)`, REWRITE_TAC[INT_NEG_GE0;INT_OF_NUM_LE] THEN ARITH_TAC );; let FLOAT_POS = prove(`!a b. ((&.0) <. (float a b)) <=> (&:0 <: a)`, MESON_TAC[FLOAT_NN;FLOAT_ZERO;INT_LT_LE;REAL_LT_LE]);; let INT_POS' = prove(`!n. (&:0) <: (&:n) <=> (~(n=0) )`, REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC);; let INT_POS_NEG =prove(`!n. ((&:0) <: (--:(&:n))) <=> F`, REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC);; let RAT_LEMMA1_SUB = prove(`~(y1 = &0) /\ ~(y2 = &0) ==> ((x1 / y1) - (x2 / y2) = (x1 * y2 - x2 * y1) * inv(y1) * inv(y2))`, EVERY[REWRITE_TAC[real_div]; REWRITE_TAC[real_sub;GSYM REAL_MUL_LNEG]; REWRITE_TAC[GSYM real_div]; SIMP_TAC[RAT_LEMMA1]; DISCH_TAC; MESON_TAC[real_div]]);; let INTERVAL_0 = prove(`! a f ex. (interval a f ex <=> (&.0 <= (ex - (abs (a -. f)))))`, MESON_TAC[interval;REAL_SUB_LE]);; let ABS_NUM = prove (`!m n. abs (&. n -. (&. m)) = &.((m-|n) + (n-|m))`, REPEAT GEN_TAC THEN DISJ_CASES_TAC (SPECL [`m:num`;`n:num`] LTE_CASES) THENL[ (* first case *) EVERY[ LABEL_ALL_TAC; H_REWRITE_RULE [THM (GSYM REAL_OF_NUM_LT)] (HYP "0"); LABEL_ALL_TAC; H_ONCE_REWRITE_RULE[THM (GSYM REAL_SUB_LT)] (HYP "1"); LABEL_ALL_TAC; H_MATCH_MP (THM REAL_LT_IMP_LE) (HYP "2"); LABEL_ALL_TAC; H_REWRITE_RULE [THM (GSYM ABS_REFL)] (HYP "3"); ASM_REWRITE_TAC[]; H_MATCH_MP (THM LT_IMP_LE) (HYP "0"); ASM_SIMP_TAC[REAL_OF_NUM_SUB]; REWRITE_TAC[REAL_OF_NUM_EQ]; ONCE_REWRITE_TAC[ARITH_RULE `!x:num y:num. (x = y) = (y = x)`]; REWRITE_TAC[EQ_ADD_RCANCEL_0]; ASM_REWRITE_TAC[SUB_EQ_0]]; (* second case *) EVERY[LABEL_ALL_TAC; H_REWRITE_RULE [THM (GSYM REAL_OF_NUM_LE)] (HYP "0"); LABEL_ALL_TAC; H_ONCE_REWRITE_RULE[THM (GSYM REAL_SUB_LE)] (HYP "1"); LABEL_ALL_TAC; H_REWRITE_RULE [THM (GSYM ABS_REFL)] (HYP "2"); ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG]; REWRITE_TAC[REAL_ARITH `!x y. --.(x -. y) = (y-x)`]; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[REAL_OF_NUM_SUB]; REWRITE_TAC[REAL_OF_NUM_EQ]; ONCE_REWRITE_TAC[ARITH_RULE `!x:num y:num. (x = y) <=> (y = x)`]; REWRITE_TAC[EQ_ADD_LCANCEL_0]; ASM_REWRITE_TAC[SUB_EQ_0]]]);; let INTERVAL_TO_LESS = prove( `!a f ex b g ey. ((interval a f ex) /\ (interval b g ey) /\ (&.0 <. (g -. (ey +. ex +. f)))) ==> (a <. b)`, let lemma1 = REAL_ARITH `!ex ey f g. (&.0 <. (g -. (ey +. ex +. f))) ==> ((f +. ex)<. (g -. ey)) ` in EVERY[ REPEAT GEN_TAC; DISCH_ALL_TAC; H_MATCH_MP (THM lemma1) (HYP "2"); H_MATCH_MP (THM INTERVAL_MAX) (HYP "0"); H_MATCH_MP (THM INTERVAL_MIN) (HYP "1"); LABEL_ALL_TAC; H_MATCH_MP (THM REAL_LET_TRANS) (H_RULE2 CONJ (HYP "4") (HYP "5")); LABEL_ALL_TAC; H_MATCH_MP (THM REAL_LTE_TRANS) (H_RULE2 CONJ (HYP "6") (HYP "3")); ASM_REWRITE_TAC[] ]);; let ABS_TO_INTERVAL = prove( `!c u k. (abs (c - u) <=. k) ==> (!f g ex ey.((interval u f ex) /\ (interval k g ey) ==> (interval c f (g+.ey+.ex))))`, EVERY[ REWRITE_TAC[interval]; DISCH_ALL_TAC; REPEAT GEN_TAC; DISCH_ALL_TAC; ONCE_REWRITE_TAC [REAL_ARITH `c -. f = (c-. u) + (u-. f)`]; ONCE_REWRITE_TAC [REAL_ADD_ASSOC]; ASSUME_TAC (SPECL [`c-.u`;`u-.f`] ABS_TRIANGLE); IMP_RES_THEN ASSUME_TAC (REAL_ARITH `||.(k-.g) <=. ey ==> (k <=. (g +. ey))`); MATCH_MP_TAC (REAL_ARITH `(?a b.((x <=. (a+.b)) /\ (a <=. u) /\ (b <=. v))) ==> (x <=. (u +. v))`); EXISTS_TAC `abs (c-.u)`; EXISTS_TAC `abs(u-.f)`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LE_TRANS]; ]);; (* end of general lemmas *) (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) (* Cache of computed constants (abs (c - u) <= k) *) (* ------------------------------------------------------------------ *) let calculated_constants = ref ([]:(term*thm) list);; let add_real_constant ineq = try( let (abst,k) = dest_binop `(<=.)` (concl ineq) in let (absh,cmu) = dest_comb abst in let (c,u) = dest_binop `(-.)` cmu in calculated_constants := (c,ineq)::(!calculated_constants)) with _ -> (try( let (c,f,ex) = dest_interval (concl ineq) in calculated_constants := (c,ineq)::(!calculated_constants)) with _ -> failwith "calculated_constants format : abs(c - u) <= k");; let get_real_constant tm = assoc tm !calculated_constants;; let remove_real_constant tm = calculated_constants := filter (fun t -> not ((fst t) = tm)) !calculated_constants;; (* ------------------------------------------------------------------ *) (* term of the form '&.n'. Assume error checking done already. *) let INTERVAL_OF_NUM:conv = fun tm -> let tm1 = snd (dest_comb tm) in let th1 = (ARITH_REWRITE_CONV[] tm1) in ONCE_REWRITE_RULE[AP_TERM `&.` (GSYM th1)] (SPEC (rhs (concl th1)) INTERVAL_NUM);; add_test("INTERVAL_OF_NUM", dest_thm (INTERVAL_OF_NUM `&.3`) = ([], `interval (&3) (float (&:3) (&:0)) (float (&:0) (&:0))`));; (* term of the form `--. (&.n)`. Assume format checking already done. *) let INTERVAL_OF_NEG:conv = fun tm -> let (sign,u) = dest_comb tm in let _ = assert(sign = `--.`) in let (amp,tm1) = (dest_comb u) in let _ = assert(amp = `&.`) in let th1 = (ARITH_REWRITE_CONV[] tm1) in ONCE_REWRITE_RULE[FLOAT_NEG] ( ONCE_REWRITE_RULE[INTERVAL_NEG] ( ONCE_REWRITE_RULE[AP_TERM `&.` (GSYM th1)] ( (SPEC (rhs (concl th1)) INTERVAL_NUM))));; add_test("INTERVAL_OF_NEG", dest_thm (INTERVAL_OF_NEG `--.(&. (3+4))`) = ([],`interval( --.(&.(3 + 4)) ) (float (--: (&:7)) (&:0)) (float (&:0) (&:0))`));; (* ------------------------------------------------------------------ *) let INTERVAL_TO_LESS_CONV = fun thm1 thm2 -> let (a,f,ex) = dest_interval (concl thm1) in let (b,g,ey) = dest_interval (concl thm2) in let rthm = ASSUME `!f g ex ey. (&.0 <. (g -. (ey +. ex +. f)))` in let rspec = concl (SPECL [f;g;ex;ey] rthm) in let rspec_simp = FLOAT_CONV (snd (dest_binop `(<.)` rspec)) in let rthm2 = prove (rspec,REWRITE_TAC[rspec_simp;FLOAT_POS;INT_POS'; INT_POS_NEG] THEN ARITH_TAC) in let fthm = CONJ thm1 (CONJ thm2 rthm2) in MATCH_MP INTERVAL_TO_LESS fthm;; add_test("INTERVAL_TO_LESS_CONV", let thm1 = ASSUME `interval (#0.1) (float (&:1) (--: (&:1))) (float (&:1) (--: (&:2)))` in let thm2 = ASSUME `interval (#7) (float (&:4) (&:1)) (float (&:1) (&:0))` in let thm3 = INTERVAL_TO_LESS_CONV thm1 thm2 in concl thm3 = `#0.1 <. (#7)`);; add_test("INTERVAL_TO_LESS_CONV2", let (h,c) = dest_thm (INTERVAL_TO_LESS_CONV (INTERVAL_OF_NUM `&.3`) (INTERVAL_OF_NUM `&.8`)) in (h=[]) && (c = `&.3 <. (&.8)`));; (* ------------------------------------------------------------------ *) (* conversion for DEC <= posfloat and posfloat <= DEC *) let lemma1 = prove( `!n m p. ((&.p/(&.m)) <= (&.n)) <=> ((&.p/(&.m)) <= (&.n)/(&.1))`, MESON_TAC[REAL_DIV_1]);; let lemma2 = prove( `!n m p. ((&.p) <= ((&.n)/(&.m))) <=> ((&.p/(&.1)) <= (&.n)/(&.m))`, MESON_TAC[REAL_DIV_1]);; let lemma3 = prove(`!a b c d. ( ((0 (&.a/(&.b) <=. ((&.c)/(&.d))))`, EVERY[REPEAT GEN_TAC; DISCH_ALL_TAC; ASM_SIMP_TAC[RAT_LEMMA4;REAL_LT;REAL_OF_NUM_MUL;REAL_LE]]);; let DEC_FLOAT = EQT_ELIM o ARITH_SIMP_CONV[DECIMAL;float;TWOPOW_POS;TWOPOW_NEG;GSYM real_div; REAL_OF_NUM_POW;INT_NUM_REAL;REAL_OF_NUM_MUL; lemma1;lemma2;lemma3];; add_test("DEC_FLOAT", let f c x = dest_thm (c x) = ([],x) in ((f DEC_FLOAT `#10.0 <= (float (&:3) (&:2))`) && (f DEC_FLOAT `#10 <= (float (&:3) (&:2))`) && (f DEC_FLOAT `#0.1 <= (float (&:1) (--: (&:2)))`) && (f DEC_FLOAT `float (&:3) (&:2) <= (#13.0)`) && (f DEC_FLOAT `float (&:3) (&:2) <= (#13)`) && (f DEC_FLOAT `float (&:1) (--: (&:2)) <= (#0.3)`)));; (* ------------------------------------------------------------------ *) (* conversion for float inequalities *) let FLOAT_INEQ_CONV t = let thm1= (ONCE_REWRITE_CONV[GSYM REAL_SUB_LT;GSYM REAL_SUB_LE] t) in let rhsx= rhs (concl thm1) in let thm2= prove(rhsx,REWRITE_TAC[FLOAT_CONV (snd (dest_comb rhsx))] THEN REWRITE_TAC[FLOAT_NN;FLOAT_POS;INT_NN;INT_NN_NEG; INT_POS';INT_POS_NEG] THEN ARITH_TAC) in REWRITE_RULE[GSYM thm1] thm2;; let t1 = `(float (&:3) (&:0)) +. (float (&:4) (&:0)) <. (float (&:8) (&:1))`;; add_test("FLOAT_INEQ_CONV", let f c x = dest_thm (c x) = ([],x) in let t1 = `(float (&:3) (&:0)) +. (float (&:4) (&:0)) <. (float (&:8) (&:1))` in ((f FLOAT_INEQ_CONV t1)));; (* ------------------------------------------------------------------ *) (* converts a DECIMAL TO A THEOREM *) let INTERVAL_MINMAX = prove(`!x f ex. ((f -. ex) <= x) /\ (x <=. (f +. ex)) ==> (interval x f ex)`, EVERY[REPEAT GEN_TAC; REWRITE_TAC[interval;ABS_BOUNDS]; REAL_ARITH_TAC]);; let INTERVAL_OF_DECIMAL bprec dec = let a_num = dest_decimal dec in let f_num = round_rat bprec a_num in let ex_num = round_rat bprec (Num.abs_num (f_num -/ a_num)) in let _ = assert (ex_num <=/ f_num) in let f = mk_float f_num in let ex= mk_float ex_num in let fplus_ex = FLOAT_CONV (mk_binop `(+.)` f ex) in let fminus_ex= FLOAT_CONV (mk_binop `(-.)` f ex) in let fplus_term = rhs (concl fplus_ex) in let fminus_term = rhs (concl fminus_ex) in let th1 = DEC_FLOAT (mk_binop `(<=.)` fminus_term dec) in let th2 = DEC_FLOAT (mk_binop `(<=.)` dec fplus_term) in let intv = mk_interval dec f ex in EQT_ELIM (SIMP_CONV[INTERVAL_MINMAX;fplus_ex;fminus_ex;th1;th2] intv);; add_test("INTERVAL_OF_DECIMAL", let (h,c) = dest_thm (INTERVAL_OF_DECIMAL 4 `#36.1`) in let (x,f,ex) = dest_interval c in (h=[]) && (x = `#36.1`));; add_test("INTERVAL_OF_DECIMAL2", can (fun() -> INTERVAL_TO_LESS_CONV (INTERVAL_OF_DECIMAL 4 `#33.33`) (INTERVAL_OF_DECIMAL 4 `#36.1`)) ());; (*--------------------------------------------------------------------*) (* functions to check format. *) (* There are various implicit rules: *) (* NUMERAL is followed by bits and no other kind of num, etc. *) (* FLOAT a b, both a and b are &:NUMERAL or --:&:NUMERAL, etc. *) (*--------------------------------------------------------------------*) (* converts exceptions to false *) let falsify_ex f x = try (f x) with _ -> false;; let is_bits_format = let rec format x = if (x = `_0`) then true else let (h,t) = dest_comb x in (((h = `BIT1`) || (h = `BIT0`)) && (format t)) in falsify_ex format;; let is_numeral_format = let fn x = let (h,t) = dest_comb x in ((h = `NUMERAL`) && (is_bits_format t)) in falsify_ex fn;; let is_decimal_format = let fn x = let (t1,t2) = dest_binop `DECIMAL` x in ((is_numeral_format t1) && (is_numeral_format t2)) in falsify_ex fn;; let is_pos_int_format = let fn x = let (h,t) = dest_comb x in (h = ` &: `) && (is_numeral_format t) in falsify_ex fn;; let is_neg_int_format = let fn x = let (h,t) = dest_comb x in (h = ` --: `) && (is_pos_int_format t) in falsify_ex fn;; let is_int_format x = (is_neg_int_format x) || (is_pos_int_format x);; let is_float_format = let fn x = let (t1,t2) = dest_binop `float` x in (is_int_format t1) && (is_int_format t2) in falsify_ex fn;; let is_interval_format = let fn x = let (a,b,c) = dest_interval x in (is_float_format b) && (is_float_format c) in falsify_ex fn;; let is_neg_real = let fn x = let (h,t) = dest_comb x in (h= `--.`) in falsify_ex fn;; let is_real_num_format = let fn x = let (h,t) = dest_comb x in (h=`&.`) && (is_numeral_format t) in falsify_ex fn;; let is_comb_of t u = let fn t u = t = (fst (dest_comb u)) in try (fn t u) with failure -> false;; (* ------------------------------------------------------------------ *) (* Heron's formula for the square root of A Return a value x that is always at most the actual square root and such that abs (x - A/x ) < epsilon *) let rec heron_sqrt depth A x eps = let half = (Int 1)//(Int 2) in if (depth <= 0) then raise (Failure "sqrt recursion depth exceeded") else if (Num.abs_num (x -/ (A//x) ) =/ A) then (A//x) else let x' = half */ (x +/ (A//x)) in heron_sqrt (depth -1) A x' eps;; let INTERVAL_OF_TWOPOW = prove( `!n. interval (twopow n) (float (&:1) n) (float (&:0) (&:0))`, REWRITE_TAC[interval;float;int_of_num_th] THEN REAL_ARITH_TAC );; (* ------------------------------------------------------------------ *) let rec INTERVAL_OF_TERM bprec tm = (* treat cached values first *) if (can get_real_constant tm) then begin try( let int_thm = get_real_constant tm in if (can dest_interval (concl int_thm)) then int_thm else ( let absthm = get_real_constant tm in let (abst,k) = dest_binop `(<=.)` (concl absthm) in let (absh,cmu) = dest_comb abst in let (c,u) = dest_binop `(-.)` cmu in let intk = INTERVAL_OF_TERM bprec k in let intu = INTERVAL_OF_TERM bprec u in let thm1 = MATCH_MP ABS_TO_INTERVAL absthm in let thm2 = MATCH_MP thm1 (CONJ intu intk) in let (_,f,ex)= dest_interval (concl thm2) in let fthm = FLOAT_CONV f in let exthm = FLOAT_CONV ex in let thm3 = REWRITE_RULE[fthm;exthm] thm2 in (add_real_constant thm3; thm3) )) with _ -> failwith "INTERVAL_OF_TERM : CONSTANT" end else if (is_real_num_format tm) then (INTERVAL_OF_NUM tm) else if (is_decimal_format tm) then (INTERVAL_OF_DECIMAL bprec tm) (* treat negative terms *) else if (is_neg_real tm) then begin try( let (_,t) = dest_comb tm in let int1 = INTERVAL_OF_TERM bprec t in let (_,b,_) = dest_interval (concl int1) in let thm1 = FLOAT_CONV (mk_comb (`--.`, b)) in REWRITE_RULE[thm1] (ONCE_REWRITE_RULE[INTERVAL_NEG] int1)) with _ -> failwith "INTERVAL_OF_TERM : NEG" end (* treat abs value *) else if (is_comb_of `||.` tm) then begin try( let (_,b) = dest_comb tm in let b_int = MATCH_MP INTERVAL_ABSV (INTERVAL_OF_TERM bprec b) in let (_,f,_) = dest_interval (concl b_int) in let thm1 = FLOAT_CONV f in REWRITE_RULE[thm1] b_int) with _ -> failwith "INTERVAL_OF_TERM : ABS" end (* treat twopow *) else if (is_comb_of `twopow` tm) then begin try( let (_,b) = dest_comb tm in SPEC b INTERVAL_OF_TWOPOW ) with _ -> failwith "INTERVAL_OF_TERM : TWOPOW" end (* treat addition *) else if (can (dest_binop `(+.)`) tm) then begin try( let (a,b) = dest_binop `(+.)` tm in let a_int = INTERVAL_OF_TERM bprec a in let b_int = INTERVAL_OF_TERM bprec b in let c_int = MATCH_MP INTERVAL_ADD (CONJ a_int b_int) in let (_,f,ex) = dest_interval (concl c_int) in let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in REWRITE_RULE[thm1;thm2] c_int) with _ -> failwith "INTERVAL_OF_TERM : ADD" end (* treat subtraction *) else if (can (dest_binop `(-.)`) tm) then begin try( let (a,b) = dest_binop `(-.)` tm in let a_int = INTERVAL_OF_TERM bprec a in let b_int = INTERVAL_OF_TERM bprec b in let c_int = MATCH_MP INTERVAL_SUB (CONJ a_int b_int) in let (_,f,ex) = dest_interval (concl c_int) in let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in REWRITE_RULE[thm1;thm2] c_int) with _ -> failwith "INTERVAL_OF_TERM : SUB" end (* treat multiplication *) else if (can (dest_binop `( *. )`) tm) then begin try( let (a,b) = dest_binop `( *. )` tm in let a_int = INTERVAL_OF_TERM bprec a in let b_int = INTERVAL_OF_TERM bprec b in let c_int = MATCH_MP INTERVAL_MUL (CONJ a_int b_int) in let (_,f,ex) = dest_interval (concl c_int) in let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in REWRITE_RULE[thm1;thm2] c_int) with _ -> failwith "INTERVAL_OF_TERM : MUL" end (* treat division : instantiate INTERVAL_DIV *) else if (can (dest_binop `( / )`) tm) then begin try( let (a,b) = dest_binop `( / )` tm in let a_int = INTERVAL_OF_TERM bprec a in let b_int = INTERVAL_OF_TERM bprec b in let (_,f,ex) = dest_interval (concl a_int) in let (_,g,ey) = dest_interval (concl b_int) in let f_num = dest_float f in let ex_num = dest_float ex in let g_num = dest_float g in let ey_num = dest_float ey in let h_num = round_rat bprec (f_num//g_num) in let h = mk_float h_num in let ez_rat = (ex_num +/ abs_num (f_num -/ (h_num*/ g_num)) +/ (abs_num h_num */ ey_num))//((abs_num g_num) -/ (ey_num)) in let ez_num = round_rat bprec (ez_rat) in let _ = assert((ez_num >=/ (Int 0))) in let ez = mk_float ez_num in let hyp1 = a_int in let hyp2 = b_int in let hyp3 = FLOAT_INEQ_CONV (mk_binop `(<.)` ey (mk_comb (`||.`,g))) in let thm = SPECL [a;f;ex;b;g;ey;h;ez] INTERVAL_DIV in let conj2 x = snd (dest_conj x) in let hyp4t = (conj2 (conj2 (conj2 (fst(dest_imp (concl thm)))))) in let hyp4 = FLOAT_INEQ_CONV hyp4t in let hyp_all = end_itlist CONJ [hyp1;hyp2;hyp3;hyp4] in MATCH_MP thm hyp_all) with _ -> failwith "INTERVAL_OF_TERM :DIV" end (* treat sqrt : instantiate INTERVAL_SSQRT *) else if (can (dest_unary `ssqrt`) tm) then begin try( let x = dest_unary `ssqrt` tm in let x_int = INTERVAL_OF_TERM bprec x in let (_,f,ex) = dest_interval (concl x_int) in let f_num = dest_float f in let ex_num = dest_float ex in let fd_num = f_num -/ ex_num in let fe_f = Num.float_of_num fd_num in let apprx_sqrt = Pervasives.sqrt fe_f in (* put in heron's formula *) let v_num1 = round_inward_float 25 (apprx_sqrt) in let v_num = round_inward_rat bprec (heron_sqrt 10 fd_num v_num1 ((Int 2) **/ (Int (-bprec-4)))) in let u_num1 = round_inward_float 25 (Pervasives.sqrt (float_of_num f_num)) in let u_num = round_inward_rat bprec (heron_sqrt 10 f_num u_num1 ((Int 2) **/ (Int (-bprec-4)))) in let ey_num = round_rat bprec (abs_num (f_num -/ (u_num */ u_num))) in let ez_num = round_rat bprec ((ex_num +/ ey_num)//(u_num +/ v_num)) in let (v,u) = (mk_float v_num,mk_float u_num) in let (ey,ez) = (mk_float ey_num,mk_float ez_num) in let thm = SPECL [x;f;ex;u;ey;ez;v] INTERVAL_SSQRT in let conjhyp = fst (dest_imp (concl thm)) in let [hyp6;hyp5;hyp4;hyp3;hyp2;hyp1] = let rec break_conj c acc = if (not(is_conj c)) then (c::acc) else let (u,v) = dest_conj c in break_conj v (u::acc) in (break_conj conjhyp []) in let thm2 = prove(hyp2,REWRITE_TAC[interval] THEN (CONV_TAC FLOAT_INEQ_CONV)) in let thm3 = FLOAT_INEQ_CONV hyp3 in let thm4 = FLOAT_INEQ_CONV hyp4 in let float_tac = REWRITE_TAC[FLOAT_NN;FLOAT_POS;INT_NN;INT_NN_NEG; INT_POS';INT_POS_NEG] THEN ARITH_TAC in let thm5 = prove( hyp5,float_tac) in let thm6 = prove( hyp6,float_tac) in let ant = end_itlist CONJ[x_int;thm2;thm3;thm4;thm5;thm6] in MATCH_MP thm ant ) with _ -> failwith "INTERVAL_OF_TERM : SSQRT" end else failwith "INTERVAL_OF_TERM : case not installed";; let real_ineq bprec tm = let (t1,t2) = dest_binop `(<.)` tm in let int1 = INTERVAL_OF_TERM bprec t1 in let int2 = INTERVAL_OF_TERM bprec t2 in INTERVAL_TO_LESS_CONV int1 int2;; pop_priority();; hol-light/Jordan/jordan_curve_theorem.ml000066400000000000000000064206301303454263000207330ustar00rootroot00000000000000(* Proof of the Jordan curve theorem Format: HOL-LIGHT (OCaml version 2003) File started April 20, 2004 Completed January 19, 2005 Author: Thomas C. Hales The proof follows Carsten Thomassen "The Jordan-Schoenflies theorem and the classification of surfaces" American Math Monthly 99 (1992) 116 - 130. There is one major difference from Thomassen's proof. He uses general polygonal jordan curves in the "easy" case of the Jordan curve theorem. This file restricts the "easy" case even further to jordan curves that are made of horizontal and vertical segments with integer length. Thomassen shows finite planar graphs admit polygonal embeddings. This file shows that finite planar graphs such that every vertex has degree at most 4 admit embeddings with edges that are piecewise horizontal and vertical segments of integer length. I have apologies: 1. I'm still a novice and haven't settled on a style. The entire proof is a clumsy experiment. 2. The lemmas have been ordered by my stream of consciousness. The file is long, the dependencies are nontrivial, and reordering is best accomplished by an automated tool. *) let jordan_def = local_definition "jordan";; mk_local_interface "jordan";; prioritize_real();; let basic_rewrite_bak = basic_rewrites();; let basic_net_bak = basic_net();; let PARTIAL_REWRITE_CONV thl = GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net_bak) thl;; let PARTIAL_REWRITE_TAC thl = CONV_TAC(PARTIAL_REWRITE_CONV thl);; let reset() = (set_basic_rewrites basic_rewrite_bak);; extend_basic_rewrites (* sets *) [(* UNIV *) INR IN_UNIV; UNIV_NOT_EMPTY; EMPTY_NOT_UNIV; DIFF_UNIV; INSERT_UNIV; INTER_UNIV ; EQ_UNIV; UNIV_SUBSET; SUBSET_UNIV; (* EMPTY *) IN;IN_ELIM_THM'; (* EMPTY_EXISTS; *) (* leave EMPTY EXISTS out next time *) EMPTY_DELETE; INTERS_EMPTY; INR NOT_IN_EMPTY; EMPTY_SUBSET; (* SUBSET_EMPTY; *) (* leave out *) (* INTERS *) inters_singleton; (* SUBSET_INTER; *) (* unions *) UNIONS_0; UNIONS_1; ];; let DISCH_THEN_REWRITE = (DISCH_THEN (fun t -> REWRITE_TAC[t]));; let ISUBSET = INR SUBSET;; (* ------------------------------------------------------------------ *) (* Logic, Sets, Metric Space Material *) (* ------------------------------------------------------------------ *) (* logic *) (* sets *) let PAIR_LEMMAv2 = prove_by_refinement( `!x (i:A) (j:B). (x = (i,j)) <=> ((FST x = i) /\ (SND x = j))` , (* {{{ proof *) [ MESON_TAC[FST;SND;PAIR]; ]);; (* }}} *) let PAIR_SPLIT = prove_by_refinement( `!x (y:A#B). (x = y) <=> ((FST x = FST y) /\ (SND x = SND y))` , (* {{{ proof *) [ MESON_TAC[FST;SND;PAIR]; ]);; (* }}} *) let single_inter = prove_by_refinement( `!(a:A) U. ( ~({a} INTER U = EMPTY) <=> U a)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[INSERT;INTER;EMPTY_EXISTS ]; ASM_MESON_TAC[]; ]);; (* }}} *) let inters_inter = prove_by_refinement( `!(X:A->bool) Y. (X INTER Y) = (INTERS {X,Y})`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `{X,Y} Y` SUBGOAL_TAC; REWRITE_TAC[INSERT ]; DISCH_TAC; USE 0 (MATCH_MP delete_inters); ASM_REWRITE_TAC[DELETE_INSERT; ]; COND_CASES_TAC; ASM_REWRITE_TAC[INTER;]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let unions_delete_choice = prove_by_refinement( `!(A:(A->bool)->bool). ~(A =EMPTY) ==> (UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A))`, (* {{{ proof *) [ REWRITE_TAC[]; DISCH_ALL_TAC; REWRITE_TAC[UNIONS;UNION;DELETE ]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC; IMATCH_MP_TAC (INR CHOICE_DEF ); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let image_delete_choice = prove_by_refinement( `!(A:(A->bool)) (f:A->B). ~(A= EMPTY) ==> (IMAGE f A = ((IMAGE f (A DELETE CHOICE A)) UNION {(f (CHOICE A))}))`, (* {{{ proof *) [ REWRITE_TAC[]; DISCH_ALL_TAC; REWRITE_TAC[IMAGE;UNION;DELETE]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INSERT ]; TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC; IMATCH_MP_TAC (INR CHOICE_DEF ); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let UNIONS_UNION = prove_by_refinement( `!(A:(A->bool)->bool) B. UNIONS (A UNION B) = (UNIONS A) UNION (UNIONS B)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[UNIONS;UNION]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; MESON_TAC[]; ]);; (* }}} *) (* reals *) let half_pos = prove_by_refinement( `!x. (&.0 < x) ==> (&.0 < x/(&.2)) /\ (x/(&.2)) < x`, (* {{{ proof *) [ MESON_TAC[REAL_LT_HALF2;REAL_LT_HALF1]; ]);; (* }}} *) (* topology *) let convex_inter = prove_by_refinement( `!S T. (convex S) /\ (convex T) ==> (convex (S INTER T))`, (* {{{ proof *) [ REWRITE_TAC[convex;mk_segment;INTER;SUBSET_INTER ]; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPEL_THEN [`x`;`y`] (USE 0 o ISPECL); REWR 0; TYPEL_THEN [`x`;`y`] (USE 1 o ISPECL); REWR 1; ]);; (* }}} *) let closed_inter2 = prove_by_refinement( `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==> (closed_ U (A INTER B))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[inters_inter]; IMATCH_MP_TAC closed_inter ; ASM_REWRITE_TAC[INR INSERT;EMPTY_EXISTS ]; ASM_MESON_TAC[]; ]);; (* }}} *) let closure_univ = prove_by_refinement( `!U (X:A->bool). ~(X SUBSET UNIONS U) ==> (closure U X = UNIV)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closure;closed]; TYPE_THEN `{B | (B SUBSET UNIONS U /\ open_ U (UNIONS U DIFF B)) /\ X SUBSET B} = EMPTY ` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 1 (REWRITE_RULE[EMPTY_EXISTS ]); CHO 1; ASM_MESON_TAC[SUBSET_TRANS]; DISCH_THEN_REWRITE; ]);; (* }}} *) let closure_inter = prove_by_refinement( `!(X:A->bool) Y U. (topology_ U) ==> ((closure U (X INTER Y) SUBSET (closure U X) INTER closure U Y))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `X SUBSET UNIONS U` ASM_CASES_TAC THEN (TYPE_THEN `Y SUBSET UNIONS U` ASM_CASES_TAC) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t]) closure_univ) THEN ( IMATCH_MP_TAC closure_subset ); ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC closed_inter2; ASM_SIMP_TAC[closure_closed ]; REWRITE_TAC[INTER;ISUBSET ]; ASM_MESON_TAC[subset_closure;ISUBSET]; ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ]; ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ]; ]);; (* }}} *) let closure_open_ball = prove_by_refinement( `!(X:A->bool) d Z . ((metric_space(X,d)) /\ (Z SUBSET X)) ==> (({a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))} = closure (top_of_metric(X,d)) Z))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `topology_ (top_of_metric(X,d)) /\ (Z SUBSET (UNIONS (top_of_metric (X,d))))` SUBGOAL_TAC; ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions]; DISCH_TAC; USE 2 (MATCH_MP closure_open); TYPE_THEN `{a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}` (USE 2 o SPEC); ASM_REWRITE_TAC[]; CONJ_TAC; (* 1st prong *) REWRITE_TAC[ISUBSET;]; GEN_TAC; DISCH_TAC; DISCH_ALL_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_MESON_TAC[SUBSET;IN;INR open_ball_nonempty]; CONJ_TAC; REWRITE_TAC[closed;open_DEF ]; ASM_SIMP_TAC[GSYM top_of_metric_unions]; CONJ_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';open_ball ;]; DISCH_ALL_TAC; TYPE_THEN `&.1` (USE 3 o SPEC); UND 3; REDUCE_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); MESON_TAC[]; ASM_SIMP_TAC[top_of_metric_nbd]; REWRITE_TAC[IN;DIFF; ISUBSET ]; CONJ_TAC; MESON_TAC[]; DISCH_ALL_TAC; LEFT 4 "r"; CHO 4; USE 4 (REWRITE_RULE[NOT_IMP]); TYPE_THEN `r` EXISTS_TAC; NAME_CONFLICT_TAC; ASM_REWRITE_TAC[NOT_IMP]; DISCH_ALL_TAC; AND 4; SUBCONJ_TAC; UND 5; REWRITE_TAC[open_ball; ]; MESON_TAC[]; DISCH_TAC; LEFT_TAC "r'"; JOIN 0 5; USE 0 (MATCH_MP (INR open_ball_center)); CHO 0; TYPE_THEN `r'` EXISTS_TAC; UND 0; UND 4; MESON_TAC[SUBSET;IN]; (* final prong *) (* fp *) ONCE_REWRITE_TAC[TAUT (`a /\ b ==> e <=> (a /\ ~e ==> ~b)`)]; REWRITE_TAC[open_DEF;EMPTY_EXISTS ]; DISCH_ALL_TAC; CHO 4; USE 4 (REWRITE_RULE[INTER ]); AND 4; UND 3; ASM_SIMP_TAC[top_of_metric_nbd;]; DISCH_ALL_TAC; TSPEC `u` 6; REWR 6; CHO 6; TSPEC `r` 4; REWR 4; CHO 4; TYPE_THEN `z` EXISTS_TAC; REWRITE_TAC[INTER]; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let closed_union = prove_by_refinement( `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==> (closed_ U (A UNION B))`, (* {{{ proof *) [ REWRITE_TAC[closed;open_DEF;union_subset ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `UNIONS U DIFF (A UNION B) = (UNIONS U DIFF A) INTER (UNIONS U DIFF B)` SUBGOAL_TAC; REWRITE_TAC[DIFF;UNION;IN;INTER;IN_ELIM_THM']; IMATCH_MP_TAC EQ_EXT; GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[SUBSET;IN]; DISCH_THEN (fun t->REWRITE_TAC[t]); ASM_MESON_TAC[top_inter]; ]);; (* }}} *) (* euclid *) let euclid_scale0 = prove_by_refinement( `!x. (&.0 *# x) = (euclid0)`, (* {{{ proof *) [ REWRITE_TAC[euclid_scale;euclid0]; REDUCE_TAC; ]);; (* }}} *) let euclid_minus0 = prove_by_refinement( `!x. (x - euclid0) = x`, (* {{{ proof *) [ REWRITE_TAC[euclid0;euclid_minus]; REDUCE_TAC; (*** Changed by JRH since MESON no longer automatically applies extensionality MESON_TAC[]; ***) REWRITE_TAC[FUN_EQ_THM] ]);; (* }}} *) let norm_scale2 = prove_by_refinement( `!t x. (euclidean x) ==> (norm (t *# x) = abs(t) * norm x)`, (* {{{ proof *) [ DISCH_ALL_TAC; USE 0 (MATCH_MP norm_scale); TYPEL_THEN [`t`;`&.0`] (USE 0 o ISPECL); USE 0 (REWRITE_RULE[euclid_scale0;d_euclid;euclid_minus0]); UND 0; REDUCE_TAC; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* half-spaces *) (* ------------------------------------------------------------------ *) let closed_half_space = jordan_def `closed_half_space n v b = {z | (euclid n z) /\ (dot v z <=. b) }`;; let open_half_space = jordan_def `open_half_space n v b = {z | (euclid n z) /\ (dot v z <. b) }`;; let hyperplane = jordan_def `hyperplane n v b = {z | (euclid n z) /\ (dot v z = b) }`;; let closed_half_space_euclid = prove_by_refinement( `!n v b. (closed_half_space n v b SUBSET euclid n)`, (* {{{ proof *) [ REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let open_half_space_euclid = prove_by_refinement( `!n v b. (open_half_space n v b SUBSET euclid n)`, (* {{{ proof *) [ REWRITE_TAC[open_half_space;SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let hyperplane_euclid = prove_by_refinement( `!n v b. (hyperplane n v b SUBSET euclid n)`, (* {{{ proof *) [ REWRITE_TAC[hyperplane;SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let closed_half_space_scale = prove_by_refinement( `!n v b r. ( &.0 < r) /\ (euclid n v) ==> (closed_half_space n (r *# v) (r * b) = closed_half_space n v b)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closed_half_space]; IMATCH_MP_TAC EQ_EXT ; GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); DISCH_ALL_TAC; JOIN 1 2; USE 1 (MATCH_MP dot_scale); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[dot_scale]; IMATCH_MP_TAC REAL_LE_LMUL_EQ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let open_half_space_scale = prove_by_refinement( `!n v b r. ( &.0 < r) /\ (euclid n v) ==> (open_half_space n (r *# v) (r * b) = open_half_space n v b)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[open_half_space]; IMATCH_MP_TAC EQ_EXT ; GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); DISCH_ALL_TAC; JOIN 1 2; USE 1 (MATCH_MP dot_scale); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[dot_scale]; IMATCH_MP_TAC REAL_LT_LMUL_EQ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let hyperplane_scale = prove_by_refinement( `!n v b r. ~( r = &.0) /\ (euclid n v) ==> (hyperplane n (r *# v) (r * b)= hyperplane n v b)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[hyperplane]; IMATCH_MP_TAC EQ_EXT ; GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); DISCH_ALL_TAC; JOIN 1 2; USE 1 (MATCH_MP dot_scale); ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL ]; ]);; (* }}} *) let open_half_space_diff = prove_by_refinement( `!n v b. (euclid n v) ==> ((euclid n) DIFF (open_half_space n v b) = (closed_half_space n (-- v) (--. b)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[open_half_space;closed_half_space;DIFF ]; REWRITE_TAC[IN; IN_ELIM_THM']; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM;dot_neg ]; GEN_TAC; IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); DISCH_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ]);; (* }}} *) let closed_half_space_diff = prove_by_refinement( `!n v b. (euclid n v) ==> ((euclid n) DIFF (closed_half_space n v b) = (open_half_space n (-- v) (--. b)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[open_half_space;closed_half_space;DIFF ]; REWRITE_TAC[IN; IN_ELIM_THM']; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM;dot_neg ]; GEN_TAC; IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); DISCH_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ]);; (* }}} *) let closed_half_space_inter = prove_by_refinement( `!n v b. (euclid n v) ==> (closed_half_space n v b INTER closed_half_space n (-- v) (--b) = hyperplane n v b)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closed_half_space;INTER;IN;hyperplane;IN_ELIM_THM' ]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; REWRITE_TAC[GSYM CONJ_ASSOC ]; IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); DISCH_TAC; ASM_REWRITE_TAC[dot_neg ]; REAL_ARITH_TAC; ]);; (* }}} *) let open_half_space_convex = prove_by_refinement( `!n v b. (euclid n v) ==> (convex (open_half_space n v b))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[convex;open_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN ]; DISCH_ALL_TAC; DISCH_ALL_TAC; CHO 5; UND 5; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; KILL 7; ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;]; TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC; ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ]; DISCH_THEN (fun t -> REWRITE_TAC[t]); ASM_CASES_TAC `&.0 = a`; EXPAND_TAC "a"; REDUCE_TAC; ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`]; IMATCH_MP_TAC REAL_LTE_ADD2; CONJ_TAC; MP_TAC (REAL_ARITH `~(&.0 = a) /\ (&.0 <= a) ==> (&.0 < a)`); ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_LMUL_EQ]; REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; IMATCH_MP_TAC REAL_LE_LMUL; UND 6; UND 4; REAL_ARITH_TAC; ]);; (* }}} *) let closed_half_space_convex = prove_by_refinement( `!n v b. (euclid n v) ==> (convex (closed_half_space n v b))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[convex;closed_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN]; DISCH_ALL_TAC; DISCH_ALL_TAC; CHO 5; UND 5; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; KILL 7; ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;]; TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC; ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ]; DISCH_THEN (fun t -> REWRITE_TAC[t]); GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`]; IMATCH_MP_TAC REAL_LE_ADD2; REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; USE 6 (MATCH_MP (REAL_ARITH `(a <= &.1) ==> (&.0 <= (&1-a))`)); CONJ_TAC THEN (IMATCH_MP_TAC REAL_LE_LMUL) THEN ASM_REWRITE_TAC[]; ]);; (* }}} *) let hyperplane_convex = prove_by_refinement( `!n v b. (euclid n v) ==> convex(hyperplane n v b)`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[GSYM closed_half_space_inter]; IMATCH_MP_TAC convex_inter; ASM_MESON_TAC[closed_half_space_convex;neg_dim ]; ]);; (* }}} *) let open_half_space_open = prove_by_refinement( `!n v b. (euclid n v) ==> (top_of_metric(euclid n,d_euclid)) (open_half_space n v b)`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[top_of_metric_nbd;metric_euclid;SUBSET;IN;IN_ELIM_THM' ]; REWRITE_TAC[open_half_space;open_ball;IN_ELIM_THM' ]; CONJ_TAC ; MESON_TAC[]; DISCH_ALL_TAC; ASM_CASES_TAC `v = euclid0`; UND 2; ASM_REWRITE_TAC[dot_lzero]; MESON_TAC[]; TYPE_THEN `(b - (dot v a))/(norm v)` EXISTS_TAC; TYPE_THEN `&.0 < (norm v)` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `&0 <= x /\ (~(x = &.0)) ==> (&.0 < x)`); ASM_MESON_TAC[norm;norm_nonneg;dot_nonneg;SQRT_EQ_0;dot_zero]; DISCH_ALL_TAC; SUBCONJ_TAC; ASM_SIMP_TAC[REAL_LT_RDIV_0]; UND 2; REAL_ARITH_TAC; DISCH_ALL_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(x:num->real) = a + (x - a)` SUBGOAL_TAC; REWRITE_TAC[euclid_plus;euclid_minus]; IMATCH_MP_TAC EQ_EXT; GEN_TAC THEN BETA_TAC; REAL_ARITH_TAC; DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]); TYPE_THEN `dot v (a + (x - a)) = (dot v a) + (dot v (x-a))` SUBGOAL_TAC; IMATCH_MP_TAC dot_linear2; TYPE_THEN `n` EXISTS_TAC; ASM_SIMP_TAC[euclid_sub_closure]; DISCH_THEN (fun t -> REWRITE_TAC[t]); IMATCH_MP_TAC (REAL_ARITH `(?d. (b<=d) /\ d < C - a) ==> a +b < C`); TYPE_THEN `(norm v)*. (d_euclid a x)` EXISTS_TAC; CONJ_TAC; ASSUME_TAC metric_euclid; TYPE_THEN `n` (USE 9 o SPEC); COPY 7; JOIN 6 7; JOIN 9 6; USE 6 (MATCH_MP metric_space_symm); ASM_REWRITE_TAC[]; REWRITE_TAC[d_euclid]; IMATCH_MP_TAC (REAL_ARITH `||. u <=. C ==> (u <=. C)`); IMATCH_MP_TAC cauchy_schwartz; ASM_MESON_TAC[euclidean;euclid_sub_closure]; UND 8; ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; REAL_ARITH_TAC; ]);; (* }}} *) let closed_half_space_closed = prove_by_refinement( `!n v b. (euclid n v) ==> closed_ (top_of_metric(euclid n,d_euclid)) (closed_half_space n v b)`, (* {{{ proof *) [ REWRITE_TAC[closed;open_DEF ]; DISCH_ALL_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;closed_half_space_diff;open_half_space_open;euclid_neg_closure ]; REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let hyperplane_closed = prove_by_refinement( `!n v b. (euclid n v) ==> closed_ (top_of_metric(euclid n,d_euclid)) (hyperplane n v b)`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[GSYM closed_half_space_inter]; IMATCH_MP_TAC closed_inter2; ASM_MESON_TAC[euclid_neg_closure;top_of_metric_top ;metric_euclid ;closed_half_space_closed;]; ]);; (* }}} *) let closure_half_space = prove_by_refinement( `!n v b. (euclid n v) /\ (~(v = euclid0)) ==> ((closure (top_of_metric(euclid n,d_euclid)) (open_half_space n v b)) = (closed_half_space n v b))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC closure_subset; ASM_SIMP_TAC [top_of_metric_top;metric_euclid]; ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;closed_half_space_closed]; REWRITE_TAC[SUBSET;IN;closed_half_space;open_half_space;IN_ELIM_THM' ]; MESON_TAC[REAL_ARITH `a < b ==> a <=. b`]; ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;open_half_space_euclid]; REWRITE_TAC[open_half_space;closed_half_space;SUBSET;IN;IN_ELIM_THM']; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `t = ((r/(&.2))/(norm v ))` ABBREV_TAC; TYPE_THEN `u = x - (t)*# v` ABBREV_TAC; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `&.0 < (dot v v)` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 < x)`); REWRITE_TAC[dot_nonneg]; ASM_MESON_TAC[euclidean;dot_zero_euclidean ]; DISCH_TAC; TYPE_THEN `&.0 < t` SUBGOAL_TAC; EXPAND_TAC "t"; IMATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[REAL_LT_HALF1]; REWRITE_TAC[norm]; IMATCH_MP_TAC SQRT_POS_LT; ASM_REWRITE_TAC[]; DISCH_TAC; SUBCONJ_TAC; CONJ_TAC; ASM_MESON_TAC[euclid_sub_closure ;euclid_scale_closure ]; TYPE_THEN `dot v u = (dot v x - t* (dot v v))` SUBGOAL_TAC; EXPAND_TAC "u"; ASM_MESON_TAC[dot_minus_linear2;dot_scale2;euclid_sub_closure;euclid_scale_closure]; DISCH_THEN (fun t->REWRITE_TAC[t]); IMATCH_MP_TAC (REAL_ARITH `(a <= b) /\ (&.0 < C) ==> (a - C < b)`); ASM_REWRITE_TAC[]; IMATCH_MP_TAC REAL_LT_MUL; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; ASM_REWRITE_TAC[open_ball;IN_ELIM_THM' ]; EXPAND_TAC "u"; REWRITE_TAC[d_euclid]; TYPE_THEN `euclid_minus x (euclid_minus x (t *# v)) = ( t) *# v` SUBGOAL_TAC; REWRITE_TAC[euclid_minus;euclid_scale]; IMATCH_MP_TAC EQ_EXT; GEN_TAC THEN BETA_TAC; REAL_ARITH_TAC ; DISCH_THEN (fun t-> REWRITE_TAC[t]); TYPE_THEN `norm (t *# v) = t * norm v` SUBGOAL_TAC; ASM_MESON_TAC[euclidean;norm_scale2;ABS_REFL;REAL_ARITH `&.0 < t ==> &.0 <= t`]; DISCH_THEN (fun t -> REWRITE_TAC[t]); EXPAND_TAC "t"; TYPE_THEN `((r / &2) / norm v) * norm v = r/(&.2)` SUBGOAL_TAC; IMATCH_MP_TAC REAL_DIV_RMUL; REWRITE_TAC[norm]; ASM_MESON_TAC[SQRT_POS_LT;REAL_ARITH `&.0 < x ==> ~(x = &.0)`]; DISCH_THEN (fun t-> REWRITE_TAC[t]); ASM_MESON_TAC[half_pos]; ]);; (* }}} *) let subset_of_closure = prove_by_refinement( `!(A:A->bool) B U. (topology_ U) /\ (A SUBSET B) ==> (closure U A SUBSET closure U B)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(A SUBSET (UNIONS U))` ASM_CASES_TAC; TYPE_THEN `(B SUBSET (UNIONS U))` ASM_CASES_TAC; IMATCH_MP_TAC closure_subset; ASM_REWRITE_TAC[]; WITH 0 (MATCH_MP subset_closure); USE 4 (ISPEC `B:A->bool`); JOIN 1 4; USE 1 (MATCH_MP SUBSET_TRANS); ASM_REWRITE_TAC[]; ASM_MESON_TAC [closure_closed;]; USE 3 (MATCH_MP closure_univ); ASM_REWRITE_TAC[]; TYPE_THEN `~(B SUBSET UNIONS U)` SUBGOAL_TAC; UND 2; UND 1; REWRITE_TAC[ISUBSET]; MESON_TAC[]; DISCH_TAC; USE 2 (MATCH_MP closure_univ); USE 3 (MATCH_MP closure_univ); ASM_REWRITE_TAC[]; ]);; (* }}} *) let closure_union = prove_by_refinement( `!(A:A->bool) B U. (topology_ U) ==> (closure U (A UNION B) = (closure U A) UNION (closure U B))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `A SUBSET UNIONS U` ASM_CASES_TAC THEN (TYPE_THEN `B SUBSET UNIONS U` ASM_CASES_TAC ) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t;UNION_UNIV;SUBSET_UNIV;INTER_UNIV]) closure_univ) THEN TRY (IMATCH_MP_TAC closure_univ) THEN TRY (UNDISCH_FIND_TAC `(~)`); IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC closure_subset; ASM_REWRITE_TAC[]; CONJ_TAC; ASM_MESON_TAC[closed_union; closure_closed]; REWRITE_TAC[union_subset]; TYPE_THEN `(A SUBSET closure U A) /\ (B SUBSET closure U B)` SUBGOAL_TAC; ASM_SIMP_TAC[subset_closure]; REWRITE_TAC[UNION;ISUBSET ]; ASM_MESON_TAC[]; REWRITE_TAC[union_subset]; CONJ_TAC THEN IMATCH_MP_TAC subset_of_closure THEN ASM_REWRITE_TAC[ISUBSET;UNION ] THEN (MESON_TAC []); REWRITE_TAC [UNION;SUBSET; ]; MESON_TAC[]; REWRITE_TAC[UNION;SUBSET]; MESON_TAC[]; REWRITE_TAC[UNION;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let closure_empty = prove_by_refinement( `!U. (topology_ U) ==> (closure U (EMPTY:A->bool) = EMPTY)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; ASM_MESON_TAC[SUBSET_EMPTY;closure_subset;empty_closed]; ]);; (* }}} *) let closure_unions = prove_by_refinement( `!(A:(A->bool)->bool) U. (topology_ U) /\ (FINITE A) ==> (closure U (UNIONS A) = UNIONS (IMAGE (closure U) A))`, (* {{{ proof *) [ REP_GEN_TAC; TYPE_THEN `n = CARD A` ABBREV_TAC; UND 0; TYPE_THEN `A` (fun t-> SPEC_TAC (t,t)); TYPE_THEN `n` (fun t-> SPEC_TAC (t,t)); INDUCT_TAC; DISCH_ALL_TAC; TYPE_THEN `A HAS_SIZE 0` SUBGOAL_TAC; ASM_REWRITE_TAC[HAS_SIZE]; ASM_REWRITE_TAC[HAS_SIZE_0]; DISCH_THEN_REWRITE; ASM_SIMP_TAC [closure_empty;IMAGE_CLAUSES]; DISCH_ALL_TAC; TYPE_THEN `~(A HAS_SIZE 0)` SUBGOAL_TAC; ASM_REWRITE_TAC[HAS_SIZE]; ARITH_TAC; TYPE_THEN `A` (MP_TAC o ((C ISPEC) CARD_DELETE_CHOICE)); REWRITE_TAC[HAS_SIZE_0]; DISCH_ALL_TAC; REWR 5; USE 5 (CONV_RULE REDUCE_CONV ); TYPE_THEN `(A DELETE CHOICE A)` (USE 0 o ISPEC); USE 0 (REWRITE_RULE[FINITE_DELETE]); REWR 0; TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC; IMATCH_MP_TAC (INR CHOICE_DEF); ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A)` SUBGOAL_TAC; IMATCH_MP_TAC unions_delete_choice; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `(IMAGE (closure U) A) = (IMAGE (closure U) (A DELETE CHOICE A) UNION {(closure U (CHOICE A))})` SUBGOAL_TAC; IMATCH_MP_TAC image_delete_choice ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_SIMP_TAC[closure_union]; REWRITE_TAC[UNIONS_UNION]; ]);; (* }}} *) let metric_space_zero2 = prove_by_refinement( `!X d (x:A) y. (metric_space(X,d) /\ (X x) /\ (X y)) ==> ((d x y = &.0) <=> (x = y))`, (* {{{ proof *) [ DISCH_ALL_TAC; USE 0 (REWRITE_RULE[metric_space]); TYPEL_THEN [`x`;`y`;`x`] (USE 0 o ISPECL); ASM_MESON_TAC[]; ]);; (* }}} *) let d_euclid_zero = prove_by_refinement( `!n x y. (euclid n x) /\ (euclid n y) ==> ((d_euclid x y = &.0) <=> (x = y))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPEL_THEN [`euclid n`;`d_euclid`;`x`;`y`] (ASSUME_TAC o (C ISPECL) metric_space_zero2); ASM_MESON_TAC[metric_euclid]; ]);; (* }}} *) let d_euclid_pos2 = prove_by_refinement( `!x y n. ~(x = y) /\ euclid n x /\ euclid n y ==> &0 <. d_euclid x y`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC (REAL_ARITH `&.0 <= x /\ ~(x = &.0) ==> (&.0 < x)`); ASM_MESON_TAC[d_euclid_pos;d_euclid_zero]; ]);; (* }}} *) let euclid_segment = prove_by_refinement( `!n x y. (euclid n x) /\ (!t. (&.0 <. t) /\ (t <=. &.1) ==> (euclid n (t *# x + (&.1 - t)*# y))) ==> (euclid n y)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `t = &.1/(&.2)` ABBREV_TAC; TYPE_THEN `y = ((&.2) *# ((t *# x) + (&.1 - t)*# y)) - x` SUBGOAL_TAC; REWRITE_TAC[euclid_minus;euclid_scale;euclid_plus]; IMATCH_MP_TAC EQ_EXT; GEN_TAC THEN BETA_TAC ; REWRITE_TAC[REAL_ADD_LDISTRIB]; REWRITE_TAC[REAL_MUL_ASSOC;REAL_SUB_LDISTRIB ]; EXPAND_TAC "t"; SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&.2 = &.0)`]; REAL_ARITH_TAC; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); TYPE_THEN `t` (USE 1 o SPEC); TYPE_THEN `v = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC; KILL 3; TYPE_THEN `&0 < t /\ t <= &1` SUBGOAL_TAC; EXPAND_TAC "t"; CONJ_TAC ; IMATCH_MP_TAC REAL_LT_DIV; REAL_ARITH_TAC; IMATCH_MP_TAC REAL_LE_LDIV; REAL_ARITH_TAC; DISCH_TAC; REWR 1; ASM_SIMP_TAC[euclid_sub_closure;euclid_scale_closure]; ]);; (* }}} *) let euclid_xy = prove_by_refinement( `!n x y. (!t . (&.0 < t) /\ (t < &.1) ==> (euclid n (t *# x + (&.1-t)*# y))) ==> (euclid n x) /\ (euclid n y)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `u = (&.1/(&.3))*# x + (&.1 - (&.1/(&.3))) *# y` ABBREV_TAC; TYPE_THEN `v = (&.2/(&.3))*# x + (&.1 - (&.2/(&.3))) *# y` ABBREV_TAC; TYPE_THEN `euclid n u` SUBGOAL_TAC; EXPAND_TAC "u"; UND 0; DISCH_THEN IMATCH_MP_TAC ; CONV_TAC REAL_RAT_REDUCE_CONV; DISCH_TAC; TYPE_THEN `euclid n v` SUBGOAL_TAC; EXPAND_TAC "v"; UND 0; DISCH_THEN IMATCH_MP_TAC ; CONV_TAC REAL_RAT_REDUCE_CONV; DISCH_TAC; TYPE_THEN `x = (&.2)*# v - (&.1) *# u` SUBGOAL_TAC; EXPAND_TAC "u"; EXPAND_TAC "v"; REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale]; IMATCH_MP_TAC EQ_EXT; DISCH_ALL_TAC; BETA_TAC; TYPE_THEN `a = x x'` ABBREV_TAC ; TYPE_THEN `b= y x'` ABBREV_TAC ; real_poly_tac; DISCH_THEN_REWRITE; ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure]; TYPE_THEN `y = (&.2)*# u - (&.1) *# v` SUBGOAL_TAC; EXPAND_TAC "u"; EXPAND_TAC "v"; REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale]; IMATCH_MP_TAC EQ_EXT; DISCH_ALL_TAC; BETA_TAC; TYPE_THEN `a = x x'` ABBREV_TAC ; TYPE_THEN `b= y x'` ABBREV_TAC ; real_poly_tac; DISCH_THEN_REWRITE; ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure]; ]);; (* }}} *) let closure_segment = prove_by_refinement( `!C n x y. (C SUBSET (euclid n)) /\ (!t. (&.0 < t) /\ (t < &.1) ==> (C (t *# x + (&.1-t)*# y))) ==> (closure (top_of_metric(euclid n,d_euclid)) C y)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `euclid n x /\ (euclid n y)` SUBGOAL_TAC; IMATCH_MP_TAC euclid_xy; ASM_MESON_TAC[ISUBSET]; DISCH_ALL_TAC; (* case x=y *) TYPE_THEN `x = y` ASM_CASES_TAC ; TYPE_THEN `C SUBSET (closure (top_of_metric (euclid n,d_euclid)) C)` SUBGOAL_TAC ; IMATCH_MP_TAC subset_closure; ASM_SIMP_TAC [top_of_metric_top;metric_euclid]; REWRITE_TAC[ISUBSET]; TYPE_THEN `C x` SUBGOAL_TAC; REWR 1; USE 1 (REWRITE_RULE[trivial_lin_combo]); TSPEC `&.1/(&.2)` 1; USE 1 (CONV_RULE (REAL_RAT_REDUCE_CONV)); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* now ~(x=y) *) TYPE_THEN `&.0 < d_euclid x y` SUBGOAL_TAC; ASM_MESON_TAC[d_euclid_pos2]; DISCH_TAC; ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid]; DISCH_ALL_TAC; REWRITE_TAC[open_ball]; (* ## *) TYPE_THEN `?t. (&.0 <. t) /\ (t <. &.1) /\ (t *. (d_euclid x y) <. r)` SUBGOAL_TAC; TYPE_THEN `(&.1/(&.2))*. d_euclid x y < r` ASM_CASES_TAC; TYPE_THEN `(&.1/(&.2))` EXISTS_TAC; CONV_TAC (REAL_RAT_REDUCE_CONV); ASM_REWRITE_TAC[]; TYPE_THEN `(r/(&.2))/(d_euclid x y)` EXISTS_TAC; ASM_SIMP_TAC[REAL_LT_DIV;REAL_LT_HALF1]; CONJ_TAC; ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; REDUCE_TAC; TYPE_THEN `s = d_euclid x y ` ABBREV_TAC; ineq_lt_tac `r/(&.2) + ( (&1/(&2))*s - r)*(&1/(&2)) + (s)*(&3/(&4)) = s`; ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ;REAL_LT_RDIV;half_pos]; DISCH_TAC; CHO 7; TYPE_THEN `t` (USE 1 o SPEC); REWR 1; TYPE_THEN `z = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC ; TYPE_THEN `z` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; EXPAND_TAC "z"; ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure]; DISCH_TAC; TYPE_THEN `y = (t *# y) + ((&.1 - t)*# y)` SUBGOAL_TAC; ASM_MESON_TAC[trivial_lin_combo]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); EXPAND_TAC "z"; TYPE_THEN `euclid n (t*# y) /\ (euclid n (t *# x)) /\ (euclid n ((&.1-t)*# y))` SUBGOAL_TAC; ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure]; DISCH_TAC; USE 10 (MATCH_MP metric_translate); KILL 8; ASM_REWRITE_TAC[]; TYPE_THEN `d_euclid (t *# y) (t *# x) = d_euclid (t *# x) (t *# y)` SUBGOAL_TAC; ASM_MESON_TAC [ISPEC `euclid n` metric_space_symm; euclid_scale_closure;metric_euclid]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); JOIN 2 3; USE 2 (MATCH_MP norm_scale_vec); TSPEC `t` 2; ASM_REWRITE_TAC[]; AND 7; USE 7 (MATCH_MP (REAL_ARITH `&.0 < t ==> (&.0 <=. t)`)); USE 7 (REWRITE_RULE[GSYM ABS_REFL]); ASM_REWRITE_TAC []; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* POINTS *) (* ------------------------------------------------------------------ *) let point = jordan_def `point z = (FST z) *# (dirac_delta 0) + (SND z) *# (dirac_delta 1)`;; let dest_pt = jordan_def `dest_pt p = @u. p = point u`;; let point_xy = prove_by_refinement( `!x y. point(x,y) = x *# (dirac_delta 0) + y *# (dirac_delta 1)`, (* {{{ proof *) [ REWRITE_TAC[point;]; ]);; (* }}} *) let coord01 = prove_by_refinement( `!p. (point p 0 = FST p) /\ (point p 1 = SND p)`, (* {{{ proof *) [ REWRITE_TAC[point;euclid_plus;euclid_scale ]; REWRITE_TAC[dirac_delta;ARITH_RULE `~(1=0) /\ ~(0=1)`]; REDUCE_TAC ; ]);; (* }}} *) let euclid_point = prove_by_refinement( `!p. euclid 2 (point p)`, (* {{{ proof *) [ REWRITE_TAC[point;euclid]; REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta ]; DISCH_ALL_TAC; USE 0 (MATCH_MP (ARITH_RULE `(2 <=| m) ==> (~(0=m) /\ (~(1=m)))`)); ASM_REWRITE_TAC[]; REDUCE_TAC ; ]);; (* }}} *) let point_inj = prove_by_refinement( `!p q. (point p = point q) <=> (p = q)`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC ; DISCH_TAC ; WITH 0 (fun t -> AP_THM t `0`); USE 0 (fun t-> AP_THM t `1`); UND 0; UND 1; REWRITE_TAC[coord01;]; ASM_MESON_TAC[PAIR]; ASM_MESON_TAC[]; ]);; (* }}} *) let point_onto = prove_by_refinement( `!v. (euclid 2 v) ==> ?p. (v = point p)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(v 0 ,v 1)` EXISTS_TAC; IMATCH_MP_TAC EQ_EXT ; GEN_TAC ; REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta]; MP_TAC (ARITH_RULE `(0 = x) \/ ( 1 = x) \/ (2 <= x)`); REP_CASES_TAC; WITH 1 (MATCH_MP (ARITH_RULE `(0=x) ==> ~(1=x)`)); ASM_REWRITE_TAC[]; EXPAND_TAC "x"; REDUCE_TAC; WITH 1 (MATCH_MP (ARITH_RULE `(1=x) ==> ~(0=x)`)); ASM_REWRITE_TAC[]; EXPAND_TAC "x"; REDUCE_TAC; WITH 1 (MATCH_MP (ARITH_RULE `(2 <=| x) ==> (~(0=x)/\ ~(1=x))`)); ASM_REWRITE_TAC[]; REDUCE_TAC; ASM_MESON_TAC[euclid]; ]);; (* }}} *) let dest_pt_point = prove_by_refinement( `!p. dest_pt(point p) = p`, (* {{{ proof *) [ REWRITE_TAC[dest_pt]; DISCH_ALL_TAC; SELECT_TAC; ASM_MESON_TAC[point_inj]; ASM_MESON_TAC[]; ]);; (* }}} *) let point_dest_pt = prove_by_refinement( `!v. (euclid 2 v) <=> (point (dest_pt v) = v)`, (* {{{ proof *) [ GEN_TAC; EQ_TAC; REWRITE_TAC[dest_pt]; DISCH_ALL_TAC; SELECT_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[point_onto]; ASM_MESON_TAC[euclid_point]; ]);; (* }}} *) let Q_POINT = prove_by_refinement( `!Q z. (?u v. (point z = point (u,v)) /\ (Q z u v)) <=> (Q z (FST z) (SND z))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[point_inj]; EQ_TAC; DISCH_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `FST z` EXISTS_TAC; TYPE_THEN `SND z` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let pointI = jordan_def `pointI p = point(real_of_int (FST p),real_of_int (SND p))`;; let convex_pointI = prove_by_refinement( `!p. (convex {(pointI p)})`, (* {{{ proof *) [ REWRITE_TAC[convex;mk_segment;INSERT;IN_ELIM_THM';SUBSET; ]; REWRITE_TAC[IN;EMPTY]; DISCH_ALL_TAC; ASM_REWRITE_TAC[trivial_lin_combo]; DISCH_ALL_TAC; CHO 2; ASM_REWRITE_TAC[]; ]);; (* }}} *) let point_closure = prove_by_refinement( `!p q a b. (?r. (a *# (point p) + (b *# (point q)) = (point r)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `euclid 2 (a *# (point p) + (b *# (point q)))` SUBGOAL_TAC; IMATCH_MP_TAC euclid_add_closure; CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN REWRITE_TAC [euclid_point]; MESON_TAC[point_onto]; ]);; (* }}} *) let point_scale = prove_by_refinement( `!a u v. a *# (point (u,v)) = point(a* u,a* v)`, (* {{{ proof *) [ REWRITE_TAC[point;euclid_scale;euclid_plus ]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC THEN BETA_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let point_add = prove_by_refinement( `!u v u' v'. (point(u,v))+(point(u',v')) = (point(u+u',v+v'))`, (* {{{ proof *) [ REWRITE_TAC[point;euclid_plus;euclid_scale]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC THEN BETA_TAC; REAL_ARITH_TAC; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* the FLOOR function *) (* ------------------------------------------------------------------ *) let floor = jordan_def `floor x = @m. (real_of_int m <=. x /\ (x < (real_of_int (m + &:1))))`;; let int_suc = prove_by_refinement( `!m. (real_of_int (m + &:1) = real_of_int m + &.1)`, (* {{{ proof *) [ REWRITE_TAC[int_add_th;INT_NUM_REAL ]; ]);; (* }}} *) let floor_ineq = prove_by_refinement( `!x. (real_of_int (floor x) <=. x) /\ (x <. (real_of_int (floor x)) + &.1)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[floor]; SELECT_TAC; REWRITE_TAC[int_suc]; MP_TAC (SPEC `&.1` REAL_ARCH_LEAST); REDUCE_TAC; DISCH_TAC; ASM_CASES_TAC `&.0 <= x`; TSPEC `x` 1; REWR 1; CHO 1; LEFT 0 "y"; TSPEC `&:n` 0; USE 0 (REWRITE_RULE[INT_NUM_REAL;int_add_th;REAL_OF_NUM_ADD ]); ASM_MESON_TAC[]; TSPEC `--. x` 1; COPY 2; IMP_REAL `~(&.0 <=. x) ==> (&.0 <=. (-- x))` 2; REWR 1; CHO 1; LEFT 0 "y"; ASM_CASES_TAC `&.n = --x`; TSPEC `-- (&:n)` 0; USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL;REAL_OF_NUM_ADD]); JOIN 0 1; USE 0 (REWRITE_RULE[ GSYM REAL_OF_NUM_ADD]); PROOF_BY_CONTR_TAC; UND 0; UND 4; REAL_ARITH_TAC ; TSPEC `--: (&:(n+| 1))` 0; JOIN 1 0; USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL; GSYM REAL_OF_NUM_ADD;]); JOIN 4 0; PROOF_BY_CONTR_TAC; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let int_arch = prove_by_refinement( `!m n. (n <=: m) /\ (m <: (n +: (&:1))) <=> (n = m)`, (* {{{ proof *) [ REWRITE_TAC[int_lt;int_le;int_eq ;int_add_th;int_of_num_th ]; DISCH_ALL_TAC; EQ_TAC; MP_TAC (SPEC `m:int` dest_int_rep); DISCH_THEN (CHOOSE_THEN MP_TAC); MP_TAC (SPEC `n:int` dest_int_rep); DISCH_THEN (CHOOSE_THEN MP_TAC); REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC `(/\)`)) THEN ( ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN REDUCE_TAC THEN TRY ARITH_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let floor_int = prove_by_refinement( `!m. (floor (real_of_int m) = m)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `floor (real_of_int m) <=: m /\ (m <: (floor (real_of_int m)) + (&:1))` SUBGOAL_TAC; REWRITE_TAC[int_le;int_lt;int_add_th ;int_of_num_th;floor_ineq ]; REWRITE_TAC[int_arch ]; ]);; (* }}} *) let int_lt_suc_le = prove_by_refinement( `!m n. m <: n + &:1 <=> m <=: n`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; MP_TAC (SPEC `m:int` dest_int_rep); DISCH_THEN (CHOOSE_THEN MP_TAC); MP_TAC (SPEC `n:int` dest_int_rep); DISCH_THEN (CHOOSE_THEN MP_TAC); REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC `(+:)`)) THEN ( ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN REDUCE_TAC THEN TRY ARITH_TAC; REWRITE_TAC[int_le;int_lt;int_add_th;int_of_num_th]; REAL_ARITH_TAC; ]);; (* }}} *) let floor_le = prove_by_refinement( `!m x. (real_of_int m <=. x) <=> (m <=: (floor x))`, (* {{{ proof *) [ REP_GEN_TAC; EQ_TAC; DISCH_TAC; REWRITE_TAC[int_le]; REWRITE_TAC[GSYM int_le ;GSYM int_lt_suc_le;]; REWRITE_TAC[int_lt ;int_add_th;int_of_num_th;]; ASM_MESON_TAC[floor_ineq; REAL_LET_TRANS]; REWRITE_TAC[int_le]; MP_TAC (SPEC `x:real` floor_ineq); REAL_ARITH_TAC; ]);; (* }}} *) let floor_lt = prove_by_refinement( `!m x. (x < real_of_int m + &.1) <=> (floor x <=: m)`, (* {{{ proof *) [ REP_GEN_TAC; EQ_TAC; DISCH_TAC; REWRITE_TAC[GSYM int_lt_suc_le ;]; REWRITE_TAC[int_lt;int_add_th;int_of_num_th;]; UND 0; MP_TAC (SPEC `x:real` floor_ineq); REAL_ARITH_TAC; REWRITE_TAC[int_le;]; MP_TAC (SPEC `x:real` floor_ineq); REAL_ARITH_TAC; ]);; (* }}} *) let floor_mono = prove_by_refinement( `!x y. (x <=. y) ==> (floor x <=: floor y)`, (* {{{ proof *) [ REWRITE_TAC[GSYM floor_le]; REP_GEN_TAC; MP_TAC (SPEC `x:real` floor_ineq); REAL_ARITH_TAC; ]);; (* }}} *) let floor_level = prove_by_refinement( `!m x. ((&.0 <=. x) /\ (x <. &.1)) ==> (floor (real_of_int(m) + x) = m)`, (* {{{ proof *) [ DISCH_ALL_TAC; SUBGOAL_TAC `!a b. (b <=: a /\ ~(b <: a)) ==> (a = b)`; REWRITE_TAC[int_le;int_lt;int_eq]; REAL_ARITH_TAC; DISCH_THEN IMATCH_MP_TAC ; SUBCONJ_TAC; REWRITE_TAC[GSYM floor_le]; UND 0; REAL_ARITH_TAC; DISCH_TAC; PROOF_BY_CONTR_TAC; USE 3 (REWRITE_RULE[]); USE 3 (ONCE_REWRITE_RULE[GSYM INT_LT_RADD ]); USE 3 (GEN `z:int`); TSPEC `&:1` 3; USE 3 (REWRITE_RULE [int_lt_suc_le ;]); MP_TAC (SPEC `real_of_int m + x` floor_ineq); UND 3; UND 1; REWRITE_TAC[int_add_th;int_le;int_of_num_th]; REAL_ARITH_TAC; ]);; (* }}} *) let floor_range = prove_by_refinement( `!x m. (floor x = m) <=> (real_of_int m <=. x /\ x <. real_of_int m +. &.1)`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_THEN (fun t -> REWRITE_TAC[GSYM t;floor_ineq]); DISCH_ALL_TAC; ASM_REWRITE_TAC[GSYM INT_LE_ANTISYM;GSYM floor_lt;GSYM floor_le;]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* edges and squares *) (* ------------------------------------------------------------------ *) let h_edge = jordan_def `h_edge p = { Z | ?u v. (Z = point(u,v)) /\ (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p)+: (&:1)))) /\ (v = real_of_int (SND p)) }`;; let v_edge = jordan_def `v_edge p = { Z | ?u v. (Z = point(u,v)) /\ (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) /\ (u = real_of_int (FST p)) }`;; let squ = jordan_def `squ p = {Z | ?u v. (Z = point(u,v)) /\ (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p) +: (&:1)))) /\ (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) }`;; let row = jordan_def `row k = {Z | ?u . (Z = point(u,real_of_int k))}`;; let col = jordan_def `col k = {Z | ?v . (Z = point(real_of_int k ,v))}`;; let pointI_inj = prove_by_refinement( `!p q. (pointI p = pointI q) <=> (p = q) `, (* {{{ proof *) [ REWRITE_TAC[pointI;point_inj;PAIR_EQ;GSYM int_eq ]; MESON_TAC[PAIR;PAIR_EQ]; ]);; (* }}} *) let h_edge_row = prove_by_refinement( `!p . h_edge p SUBSET row (SND p) `, (* {{{ proof *) [ REWRITE_TAC[SUBSET;IN;h_edge;row;IN_ELIM_THM';]; DISCH_ALL_TAC; CHO 0; CHO 0; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let h_edge_floor = prove_by_refinement( `!p. h_edge p SUBSET { z | floor (z 0) = FST p }`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;IN;h_edge;IN_ELIM_THM';int_of_num_th;int_add_th;]; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[coord01;floor_range]; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let row_disj = prove_by_refinement( `!a b. ~((row a) INTER (row b) = EMPTY) <=> (a = b)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[EMPTY_EXISTS;IN;INTER;row;IN_ELIM_THM' ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; AND 0; CHO 0; CHO 1; REWRITE_TAC[int_eq]; USE 1 (GSYM); REWR 1; USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC [t]); MESON_TAC[]; ]);; (* }}} *) let h_edge_disj = prove_by_refinement( `!p q. ~(h_edge p INTER h_edge q = EMPTY) <=> (p = q)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM']; EQ_TAC; DISCH_TAC; CHO 0; ONCE_REWRITE_TAC [GSYM PAIR]; REWRITE_TAC[PAIR_EQ]; CONJ_TAC; MP_TAC h_edge_floor; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; ASM_MESON_TAC[]; MP_TAC h_edge_row; MP_TAC row_disj; REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;]; ASM_MESON_TAC[]; REWRITE_TAC[h_edge;IN_ELIM_THM' ]; DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]); NAME_CONFLICT_TAC; LEFT_TAC "u'"; TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC; TYPE_THEN `&.1/(&.2)` EXISTS_TAC; IMATCH_MP_TAC half_pos; ARITH_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `real_of_int (FST q) + x` EXISTS_TAC; LEFT_TAC "v'"; TYPE_THEN `real_of_int (SND q)` EXISTS_TAC ; TYPE_THEN `point (real_of_int (FST q) + x,real_of_int (SND q))` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let h_edge_pointI = prove_by_refinement( `!p q. ~(h_edge p (pointI q))`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[pointI;h_edge;IN_ELIM_THM' ]; PROOF_BY_CONTR_TAC; USE 0 (REWRITE_RULE[]); CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]); USE 0 GSYM ; REWR 1; REWR 2; USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]); USE 2 (REWRITE_RULE[int_le]); UND 2; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let v_edge_col = prove_by_refinement( `!p . v_edge p SUBSET col (FST p) `, (* {{{ proof *) [ REWRITE_TAC[SUBSET;IN;v_edge;col;IN_ELIM_THM';]; DISCH_ALL_TAC; CHO 0; CHO 0; TYPE_THEN `v` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let v_edge_floor = prove_by_refinement( `!p. v_edge p SUBSET { z | floor (z 1) = SND p }`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;IN;v_edge;IN_ELIM_THM';int_of_num_th;int_add_th;]; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[coord01;floor_range]; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let col_disj = prove_by_refinement( `!a b. ~((col a) INTER (col b) = EMPTY) <=> (a = b)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[EMPTY_EXISTS;IN;INTER;col;IN_ELIM_THM' ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; AND 0; CHO 0; CHO 1; REWRITE_TAC[int_eq]; USE 1 (GSYM); REWR 1; USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC [t]); MESON_TAC[]; ]);; (* }}} *) let v_edge_disj = prove_by_refinement( `!p q. ~(v_edge p INTER v_edge q = EMPTY) <=> (p = q)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM']; EQ_TAC; DISCH_TAC; CHO 0; ONCE_REWRITE_TAC [GSYM PAIR]; REWRITE_TAC[PAIR_EQ]; IMATCH_MP_TAC (TAUT `a /\ b ==> b/\ a`); CONJ_TAC; MP_TAC v_edge_floor; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; ASM_MESON_TAC[]; MP_TAC v_edge_col; MP_TAC col_disj; REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;]; ASM_MESON_TAC[]; REWRITE_TAC[v_edge;IN_ELIM_THM' ]; DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]); NAME_CONFLICT_TAC; LEFT_TAC "u'"; TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC; TYPE_THEN `&.1/(&.2)` EXISTS_TAC; IMATCH_MP_TAC half_pos; ARITH_TAC; DISCH_THEN CHOOSE_TAC; LEFT_TAC "v'"; LEFT_TAC "v'"; TYPE_THEN `real_of_int (SND q) + x` EXISTS_TAC; TYPE_THEN `real_of_int (FST q)` EXISTS_TAC ; TYPE_THEN `point (real_of_int (FST q),real_of_int (SND q) +x)` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let v_edge_pointI = prove_by_refinement( `!p q. ~(v_edge p (pointI q))`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[pointI;v_edge;IN_ELIM_THM' ]; PROOF_BY_CONTR_TAC; USE 0 (REWRITE_RULE[]); CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]); USE 0 GSYM ; REWR 1; REWR 2; USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]); USE 2 (REWRITE_RULE[int_le]); UND 2; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let row_col = prove_by_refinement( `!a b. (row b INTER col a) = { (pointI(a,b)) }`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[col;row;INTER;IN;IN_ELIM_THM';pointI]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM';INSERT;NOT_IN_EMPTY ]; GEN_TAC; ASM_MESON_TAC[PAIR_EQ ;point_inj]; ]);; (* }}} *) let hv_edge = prove_by_refinement( `!p q. h_edge p INTER v_edge q = EMPTY`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `h_edge p INTER v_edge q SUBSET (row (SND p)) INTER (col (FST q))` SUBGOAL_TAC; REWRITE_TAC[SUBSET_INTER;]; MESON_TAC[h_edge_row;v_edge_col;SUB_IMP_INTER ]; REWRITE_TAC[row_col]; DISCH_TAC; PROOF_BY_CONTR_TAC; USE 1 (REWRITE_RULE[EMPTY_EXISTS;IN ]); CHO 1; USE 0 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM';INSERT;EMPTY ]); TSPEC `u` 0; REWR 0; REWR 1; USE 1 (REWRITE_RULE[INTER;IN;IN_ELIM_THM';h_edge_pointI]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let square_col = prove_by_refinement( `!p a. (squ p INTER col a) = EMPTY `, (* {{{ proof *) [ REWRITE_TAC[squ;col]; DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]); CHO 0; USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']); AND 0; CHO 0; CHO 1; CHO 1; UND 1; DISCH_ALL_TAC; REWR 0; USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]); REWR 3; REWR 2; USE 3 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]); USE 3 (REWRITE_RULE[ int_le;]); UND 2; UND 3; REAL_ARITH_TAC; ]);; (* }}} *) let square_row = prove_by_refinement( `!p a. (squ p INTER row a) = EMPTY `, (* {{{ proof *) [ REWRITE_TAC[squ;row]; DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]); CHO 0; USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']); AND 0; CHO 0; CHO 1; CHO 1; UND 1; DISCH_ALL_TAC; REWR 0; USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]); REWR 5; REWR 4; USE 5 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]); USE 5 (REWRITE_RULE[ int_le;]); UND 5; UND 4; REAL_ARITH_TAC; ]);; (* }}} *) let pointI_row = prove_by_refinement( `!p. (row (SND p)) (pointI p)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[row;pointI;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let pointI_col = prove_by_refinement( `!p. (col (FST p)) (pointI p)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[col;pointI;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let square_v_edge = prove_by_refinement( `!p q. (squ p INTER v_edge q = EMPTY)`, (* {{{ proof *) [ REP_GEN_TAC; TYPE_THEN `squ p INTER v_edge q SUBSET squ p INTER col (FST q)` SUBGOAL_TAC; REWRITE_TAC[SUBSET_INTER]; MESON_TAC[SUB_IMP_INTER;v_edge_col;SUBSET_REFL]; REWRITE_TAC[square_col;SUBSET_EMPTY ]; ]);; (* }}} *) let square_h_edge = prove_by_refinement( `!p q. (squ p INTER h_edge q = EMPTY)`, (* {{{ proof *) [ REP_GEN_TAC; TYPE_THEN `squ p INTER h_edge q SUBSET squ p INTER row (SND q)` SUBGOAL_TAC; REWRITE_TAC[SUBSET_INTER]; MESON_TAC[SUB_IMP_INTER;h_edge_row;SUBSET_REFL]; REWRITE_TAC[square_row;SUBSET_EMPTY ]; ]);; (* }}} *) let square_pointI = prove_by_refinement( `!p q. ~(squ p (pointI q))`, (* {{{ proof *) [ REP_GEN_TAC; TYPE_THEN `q` (fun t -> ASSUME_TAC (SPEC t pointI_col)); TYPEL_THEN [`p`;`FST q`] (fun t -> MP_TAC (SPECL t square_col)); REWRITE_TAC[INTER;IN;]; IMATCH_MP_TAC (TAUT `(a ==> ~b) ==> (b ==> ~ a)`); DISCH_TAC; REWRITE_TAC[EMPTY_EXISTS;IN ]; TYPE_THEN `pointI q` EXISTS_TAC; ASM_REWRITE_TAC[IN_ELIM_THM']; ]);; (* }}} *) let square_floor0 = prove_by_refinement( `!p. (squ p SUBSET { z | (floor (z 0)) = (FST p) })`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ]; DISCH_ALL_TAC; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; ASM_REWRITE_TAC[coord01;floor_range]; UND 1; UND 2; REWRITE_TAC[int_add_th;int_of_num_th]; REAL_ARITH_TAC; ]);; (* }}} *) let square_floor1 = prove_by_refinement( `!p. (squ p SUBSET { z | (floor (z 1)) = (SND p) })`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ]; DISCH_ALL_TAC; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; ASM_REWRITE_TAC[coord01;floor_range]; UND 3; UND 4; REWRITE_TAC[int_add_th;int_of_num_th]; REAL_ARITH_TAC; ]);; (* }}} *) let square_square = prove_by_refinement( `!p q. ~(squ p INTER squ q = {}) ==> (squ p = squ q)`, (* {{{ proof *) [ MP_TAC square_floor0; MP_TAC square_floor1; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS ]; DISCH_ALL_TAC; REP_GEN_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `p = q` SUBGOAL_TAC; ONCE_REWRITE_TAC [GSYM PAIR]; REWRITE_TAC[PAIR_EQ]; ASM_MESON_TAC[]; MESON_TAC[]; ]);; (* }}} *) let square_disj = prove_by_refinement( `!p q. ~(squ p INTER squ q = EMPTY) <=> (p = q)`, (* {{{ proof *) [ MP_TAC square_floor0; MP_TAC square_floor1; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS ]; DISCH_ALL_TAC; REP_GEN_TAC; EQ_TAC; DISCH_THEN CHOOSE_TAC; ONCE_REWRITE_TAC [GSYM PAIR]; REWRITE_TAC[PAIR_EQ]; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[squ]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "u''"); TYPE_THEN `real_of_int (FST q) + (&.1/(&.2))` EXISTS_TAC; TYPE_THEN `real_of_int (SND q) + (&.1/(&.2))` EXISTS_TAC; REWRITE_TAC[int_suc]; TYPE_THEN `a = real_of_int(FST q)` ABBREV_TAC; (*** Modified by JRH since ABBREV_TAC now forbids existing variables TYPE_THEN `a = real_of_int(SND q)` ABBREV_TAC; ****) TYPE_THEN `a' = real_of_int(SND q)` ABBREV_TAC; MP_TAC (REAL_RAT_REDUCE_CONV `&.0 < &.1/(&.2) /\ (&.1/(&.2)) < &.1`); REAL_ARITH_TAC; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* cells *) (* ------------------------------------------------------------------ *) let cell = jordan_def `cell = {z | (?p. (z = { (pointI p) }) \/ (z = h_edge p) \/ (z = v_edge p) \/ (z = squ p))}`;; let cell_rules = prove_by_refinement( `!p. cell {(pointI p)} /\ (cell (h_edge p)) /\ (cell (v_edge p)) /\ (cell (squ p))`, (* {{{ proof *) [ REWRITE_TAC[cell;IN_ELIM_THM';]; MESON_TAC[]; ]);; (* }}} *) let cell_mem = prove_by_refinement( `!C. (cell C) <=> (?p. C = ({(pointI p)})) \/ (?p. C = h_edge p) \/ (?p. C = v_edge p) \/ (?p. C = squ p)`, (* {{{ proof *) [ REWRITE_TAC[cell;IN_ELIM_THM']; MESON_TAC[]; ]);; (* }}} *) let square_domain = prove_by_refinement( `!z. (let (p = (floor(FST z),floor(SND z))) in (({(pointI p)} UNION (h_edge p) UNION (v_edge p) UNION (squ p) ))) (point z) `, (* {{{ proof *) [ GEN_TAC; LET_TAC; REWRITE_TAC[UNION;IN;IN_ELIM_THM' ]; REWRITE_TAC[pointI;h_edge;v_edge;squ;int_add_th;int_of_num_th;IN_ELIM_THM';INSERT;EMPTY;point_inj;Q_POINT ]; ASSUME_TAC floor_ineq; TYPE_THEN `FST z` (WITH 0 o SPEC); TSPEC `SND z` 0; UND 0; UND 1; REWRITE_TAC[PAIR_LEMMAv2]; REWRITE_TAC[REAL_ARITH `(a <= b) <=> ((a = b) \/ (a < b))`]; ASM_MESON_TAC[]; ]);; (* }}} *) let square_cell = prove_by_refinement( `!z. (let (p = (floor(FST z),floor(SND z))) in (({(pointI p)} UNION (h_edge p) UNION (v_edge p) UNION (squ p) ))) SUBSET (UNIONS cell) `, (* {{{ proof *) [ GEN_TAC; LET_TAC; REWRITE_TAC[union_subset]; REPEAT CONJ_TAC THEN (IMATCH_MP_TAC sub_union) THEN (REWRITE_TAC[cell_rules]); ]);; (* }}} *) let cell_unions = prove_by_refinement( `!z. (UNIONS cell (point z))`, (* {{{ proof *) [ GEN_TAC; ASM_MESON_TAC[square_cell;square_domain;SUBSET;IN]; ]);; (* }}} *) let cell_partition = prove_by_refinement( `!C D. (cell C) /\ (cell D) /\ ~(C INTER D = EMPTY) ==> (C = D)`, (* {{{ proof *) let revr = PURE_ONCE_REWRITE_RULE [INTER_COMM] in [ PARTIAL_REWRITE_TAC[cell_mem;]; PARTIAL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR ]; REP_GEN_TAC; PARTIAL_REWRITE_TAC[TAUT `((a \/ b ==> C)) <=> ((a ==> C) /\ (b ==> C))`]; PARTIAL_REWRITE_TAC[TAUT `((a /\ b) ==> C) <=> (a ==> b ==> C)`]; REPEAT CONJ_TAC THEN (REPEAT (DISCH_THEN CHOOSE_TAC)) THEN (TRY (UNDISCH_FIND_TAC `(INTER)`)) THEN (ASM PARTIAL_REWRITE_TAC[]) THEN ASM PARTIAL_REWRITE_TAC[square_h_edge;square_v_edge;revr square_h_edge;revr square_v_edge;v_edge_disj;h_edge_disj;hv_edge;revr hv_edge;revr single_inter; single_inter;square_pointI;v_edge_pointI;h_edge_pointI; square_square;INR NOT_IN_EMPTY;INR IN_SING ] THEN (DISCH_THEN (fun t-> REWRITE_TAC[t])); ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* adjacency, closure, convexity, AND strict dominance on cells. *) (* ------------------------------------------------------------------ *) let top2 = jordan_def `top2 = top_of_metric (euclid 2,d_euclid)`;; let adj = jordan_def `adj X Y <=> (~(X = Y) /\ ~(closure top2 X INTER (closure top2 Y) = EMPTY))`;; let strict_dom = jordan_def `strict_dom X Y <=> (cell X) /\ (cell Y) /\ (closure top2 Y PSUBSET (closure top2 X))`;; let adj_symm = prove_by_refinement( `!X Y. (adj X Y) <=> (adj Y X)`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[adj]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM]; ASM_MESON_TAC[]; ]);; (* }}} *) let adj_irrefl = prove_by_refinement( `!X. (~(adj X X))`, (* {{{ proof *) [ REWRITE_TAC[adj;]; ]);; (* }}} *) let strict_dom_trans = prove_by_refinement( `!X Y Z. (strict_dom X Y) /\ (strict_dom Y Z) ==> (strict_dom X Z)`, (* {{{ proof *) [ REWRITE_TAC[strict_dom]; MESON_TAC[PSUBSET_TRANS]; ]);; (* }}} *) let strict_dom_irrefl = prove_by_refinement( `!X. ~(strict_dom X X)`, (* {{{ proof *) [ REWRITE_TAC[strict_dom;PSUBSET_IRREFL ]; ]);; (* }}} *) let dot_point = prove_by_refinement( `!p q . (dot (point p) (point q)) = (FST p)*(FST q) + (SND p)*(SND q)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `dot (point p) (point q) = sum (0,2) (\i. (point p i)*(point q i))` SUBGOAL_TAC; IMATCH_MP_TAC dot_euclid; ASM_SIMP_TAC[euclid_point]; DISCH_THEN_REWRITE; REWRITE_TAC[ARITH_RULE `2 = SUC 1`]; REWRITE_TAC[sum]; REWRITE_TAC[ARITH_RULE `1 = SUC 0`]; REWRITE_TAC[sum]; REDUCE_TAC; REWRITE_TAC[ARITH_RULE `SUC 0 = 1`;coord01]; ]);; (* }}} *) (* 2d half planes *) let open_half_plane2D_FLT = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (FST p <. r)) } = open_half_space 2 (point (&.1,&.0)) r `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC []; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let open_half_plane2D_LTF = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (r <. FST p )) } = open_half_space 2 (point (--. (&.1),&.0)) (--. r) `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let open_half_plane2D_SLT = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (SND p <. r )) } = open_half_space 2 (point (&.0,&.1)) ( r) `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let open_half_plane2D_LTS = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (r <. SND p )) } = open_half_space 2 (point (&.0,--.(&.1))) (--. r) `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let closed_half_plane2D_FLE = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (FST p <=. r)) } = closed_half_space 2 (point (&.1,&.0)) r `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC []; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let closed_half_plane2D_LEF = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (r <=. FST p)) } = closed_half_space 2 (point (--.(&.1),&.0)) (--. r) `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC []; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let closed_half_plane2D_SLE = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (SND p <=. r)) } = closed_half_space 2 (point (&.0,&.1)) r `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC []; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let closed_half_plane2D_LES = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (r <=. SND p )) } = closed_half_space 2 (point (&.0,(--. (&.1)))) (--. r) `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC []; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let line2D_F = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (FST p = r)) } = hyperplane 2 (point (&.1,&.0)) r `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC []; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let line2D_S = prove_by_refinement( `!r. { z | ?p. ((z = point p) /\ (SND p = r)) } = hyperplane 2 (point (&.0,&.1)) r `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASM_REWRITE_TAC[dot_point;euclid_point;]; REDUCE_TAC; ASM_REWRITE_TAC []; DISCH_ALL_TAC; USE 0 (MATCH_MP point_onto); CHO 0; REWR 1; USE 1 (REWRITE_RULE[dot_point;euclid_point]); USE 1 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; ]);; (* }}} *) let open_half_plane2D_FLT_open = prove_by_refinement( `!r. top2 { z | ?p. ((z = point p) /\ (FST p <. r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_FLT;top2]; SIMP_TAC[open_half_space_open;euclid_point]; ]);; (* }}} *) let open_half_plane2D_LTF_open = prove_by_refinement( `!r. top2 { z | ?p. ((z = point p) /\ (r <. FST p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_LTF;top2]; SIMP_TAC[open_half_space_open;euclid_point]; ]);; (* }}} *) let open_half_plane2D_SLT_open = prove_by_refinement( `!r. top2 { z | ?p. ((z = point p) /\ (SND p <. r )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_SLT;top2]; SIMP_TAC[open_half_space_open;euclid_point]; ]);; (* }}} *) let open_half_plane2D_LTS_open = prove_by_refinement( `!r. top2 { z | ?p. ((z = point p) /\ (r <. SND p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_LTS;top2]; SIMP_TAC[open_half_space_open;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_FLT_closed = prove_by_refinement( `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p <=. r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_FLE;top2]; SIMP_TAC[closed_half_space_closed;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_LTF_closed = prove_by_refinement( `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. FST p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_LEF;top2]; SIMP_TAC[closed_half_space_closed;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_SLT_closed = prove_by_refinement( `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p <=. r )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_SLE;top2]; SIMP_TAC[closed_half_space_closed;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_LTS_closed = prove_by_refinement( `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. SND p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_LES;top2]; SIMP_TAC[closed_half_space_closed;euclid_point]; ]);; (* }}} *) let line2D_F_closed = prove_by_refinement( `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p = r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[line2D_F;top2]; SIMP_TAC[hyperplane_closed;euclid_point]; ]);; (* }}} *) let line2D_S_closed = prove_by_refinement( `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p = r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[line2D_S;top2]; SIMP_TAC[hyperplane_closed;euclid_point]; ]);; (* }}} *) let open_half_plane2D_FLT_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (FST p <. r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_FLT;]; SIMP_TAC[open_half_space_convex;euclid_point]; ]);; (* }}} *) let open_half_plane2D_LTF_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (r <. FST p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_LTF;]; SIMP_TAC[open_half_space_convex;euclid_point]; ]);; (* }}} *) let open_half_plane2D_SLT_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (SND p <. r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_SLT;]; SIMP_TAC[open_half_space_convex;euclid_point]; ]);; (* }}} *) let open_half_plane2D_LTS_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (r <. SND p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_LTS;]; SIMP_TAC[open_half_space_convex;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_FLT_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (FST p <=. r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_FLE;]; SIMP_TAC[closed_half_space_convex;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_LTF_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (r <=. FST p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_LEF;]; SIMP_TAC[closed_half_space_convex;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_SLT_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (SND p <=. r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_SLE;]; SIMP_TAC[closed_half_space_convex;euclid_point]; ]);; (* }}} *) let closed_half_plane2D_LTS_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (r <=. SND p )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[closed_half_plane2D_LES;]; SIMP_TAC[closed_half_space_convex;euclid_point]; ]);; (* }}} *) let line2D_F_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ ( FST p = r )) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[line2D_F;]; SIMP_TAC[hyperplane_convex;euclid_point]; ]);; (* }}} *) let line2D_S_convex = prove_by_refinement( `!r. convex { z | ?p. ((z = point p) /\ (SND p = r)) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[line2D_S;]; SIMP_TAC[hyperplane_convex;euclid_point]; ]);; (* }}} *) let closure_FLT = prove_by_refinement( `!r. (closure top2 { z | ?p. ((z = point p) /\ (FST p <. r)) } = { z | ?p. ((z = point p) /\ (FST p <=. r)) })`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_FLT;closed_half_plane2D_FLE;top2]; TYPE_THEN `~(point(&.1,&.0) = euclid0)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 0(REWRITE_RULE[]); USE 0 (fun t -> AP_THM t `0`); USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]); ASM_REWRITE_TAC[]; SIMP_TAC[closure_half_space;euclid_point]; ]);; (* }}} *) let closure_LTF = prove_by_refinement( `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. FST p)) } = { z | ?p. ((z = point p) /\ (r <=. FST p )) })`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_LTF;closed_half_plane2D_LEF;top2]; TYPE_THEN `~(point(--. (&.1),&.0) = euclid0)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 0(REWRITE_RULE[]); USE 0 (fun t -> AP_THM t `0`); USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]); ASM_REWRITE_TAC[]; SIMP_TAC[closure_half_space;euclid_point]; ]);; (* }}} *) let closure_SLT = prove_by_refinement( `!r. (closure top2 { z | ?p. ((z = point p) /\ (SND p <. r)) } = { z | ?p. ((z = point p) /\ (SND p <=. r)) })`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_SLT;closed_half_plane2D_SLE;top2]; TYPE_THEN `~(point(&.0,&.1) = euclid0)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 0(REWRITE_RULE[]); USE 0 (fun t -> AP_THM t `1`); USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]); ASM_REWRITE_TAC[]; SIMP_TAC[closure_half_space;euclid_point]; ]);; (* }}} *) let closure_LTS = prove_by_refinement( `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. SND p)) } = { z | ?p. ((z = point p) /\ (r <=. SND p )) })`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[open_half_plane2D_LTS;closed_half_plane2D_LES;top2]; TYPE_THEN `~(point(&.0, --. (&.1)) = euclid0)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 0(REWRITE_RULE[]); USE 0 (fun t -> AP_THM t `1`); USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]); ASM_REWRITE_TAC[]; SIMP_TAC[closure_half_space;euclid_point]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION B *) (* ------------------------------------------------------------------ *) (* -> sets *) let single_subset = prove_by_refinement( `!(x:A) A. ({x} SUBSET A) <=> (A x)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;INSERT]; MESON_TAC[]; ]);; (* }}} *) let top2_top = prove_by_refinement( `topology_ top2 `, (* {{{ proof *) [ ASM_SIMP_TAC [top2;top_of_metric_top;metric_euclid]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* H_edge & v_edge, convexity, closure, closed, adj, etc. *) (* ------------------------------------------------------------------ *) let e1 = jordan_def `e1 = point(&.1,&.0)`;; let e2 = jordan_def `e2 = point(&.0,&.1)`;; let hc_edge = jordan_def `hc_edge m = (h_edge m) UNION {(pointI m)} UNION {(pointI m + e1)}`;; let vc_edge = jordan_def `vc_edge m = (v_edge m) UNION {(pointI m)} UNION {(pointI m + e2)}`;; (* H edge *) let h_edge_inter = prove_by_refinement( `!m. (h_edge m) = ({z | ?p. (z = point p) /\ (real_of_int (FST m) <. FST p)} INTER {z | ?p. (z = point p) /\ (FST p <. real_of_int(FST m +: &:1))} INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND m))})`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[INTER;h_edge]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; EQ_TAC; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[point_inj]; REPEAT CONJ_TAC THEN (TYPE_THEN `(u,real_of_int(SND m))` EXISTS_TAC) THEN ASM_REWRITE_TAC[PAIR_SPLIT]; DISCH_ALL_TAC; CHO 0; CHO 1; CHO 2; TYPE_THEN `FST p` EXISTS_TAC; TYPE_THEN `SND p` EXISTS_TAC; REWR 1; REWR 2; USE 2 (REWRITE_RULE[point_inj]); USE 1 (REWRITE_RULE[point_inj]); AND 1; AND 2; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let h_edge_convex = prove_by_refinement( `!m. (convex (h_edge m))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[h_edge_inter;]; IMATCH_MP_TAC convex_inter; CONJ_TAC; REWRITE_TAC [open_half_plane2D_LTF_convex;]; IMATCH_MP_TAC convex_inter; REWRITE_TAC[open_half_plane2D_FLT_convex;line2D_S_convex]; ]);; (* }}} *) let hc_edge_inter = prove_by_refinement( `!m. (hc_edge m) = ({z | ?p. (z = point p) /\ (real_of_int (FST m) <=. FST p)} INTER {z | ?p. (z = point p) /\ (FST p <=. real_of_int(FST m +: &:1))} INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND m))})`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[hc_edge;e1]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[union_subset]; REPEAT (CONJ_TAC); REWRITE_TAC[h_edge_inter]; REWRITE_TAC[SUBSET;INTER]; ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`]; REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc]; REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc]; REDUCE_TAC; REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) + &.1,real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; REWRITE_TAC[INTER;SUBSET;UNION;e1;h_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ]; GEN_TAC; DISCH_ALL_TAC; CHO 0; REWR 1; REWR 2; ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ]; REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])]; UND 2; UND 1; REWRITE_TAC[point_inj;]; REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])]; AND 0; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let hc_edge_closed = prove_by_refinement( `!m. (closed_ top2 (hc_edge m))`, (* {{{ proof *) [ REWRITE_TAC[hc_edge_inter]; GEN_TAC; IMATCH_MP_TAC closed_inter2; REWRITE_TAC[top2_top;closed_half_plane2D_LTF_closed]; IMATCH_MP_TAC closed_inter2; REWRITE_TAC[top2_top;closed_half_plane2D_FLT_closed;line2D_S_closed;]; ]);; (* }}} *) let hc_edge_convex = prove_by_refinement( `!m. (convex (hc_edge m))`, (* {{{ proof *) [ REWRITE_TAC[hc_edge_inter]; GEN_TAC; IMATCH_MP_TAC convex_inter; REWRITE_TAC[closed_half_plane2D_LTF_convex]; IMATCH_MP_TAC convex_inter; REWRITE_TAC[closed_half_plane2D_FLT_convex;line2D_S_convex;]; ]);; (* }}} *) let h_edge_subset = prove_by_refinement( `!m. (h_edge m SUBSET hc_edge m)`, (* {{{ proof *) [ REWRITE_TAC[hc_edge;SUBSET;UNION;]; MESON_TAC[]; ]);; (* }}} *) let h_edge_euclid = prove_by_refinement( `!m. (h_edge m) SUBSET (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;h_edge]; MESON_TAC[euclid_point]; ]);; (* }}} *) let h_edge_closure = prove_by_refinement( `!m. (closure top2 (h_edge m)) = hc_edge m`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC closure_subset; REWRITE_TAC[h_edge_subset;top2_top;hc_edge_closed]; REWRITE_TAC[hc_edge]; REWRITE_TAC[union_subset;e1;pointI;single_subset;point_add]; CONJ_TAC; IMATCH_MP_TAC subset_closure; REWRITE_TAC[top2_top]; REWRITE_TAC[top2]; SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ; REWRITE_TAC[GSYM REAL_RDISTRIB]; REAL_ARITH_TAC; DISCH_TAC; CONJ_TAC THEN (IMATCH_MP_TAC closure_segment) THEN REWRITE_TAC[h_edge_euclid]; TYPE_THEN `(pointI m)+point(&.1,&.0)` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REDUCE_TAC; ASM_REWRITE_TAC[int_suc]; TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; UND 1; UND 2; REAL_ARITH_TAC ; TYPE_THEN `pointI m` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REDUCE_TAC; ASM_REWRITE_TAC[int_suc]; TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; UND 1; UND 2; REAL_ARITH_TAC ; ]);; (* }}} *) (* move up *) let point_split = prove_by_refinement( `!z u v. (z = point(u,v)) <=> (u = z 0) /\ (v = z 1) /\ (euclid 2 z)`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC ; DISCH_THEN_REWRITE; REWRITE_TAC[coord01;euclid_point]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; DISJ_CASES_TAC (ARITH_RULE `(x = 0) \/ (x = 1) \/ (2 <= x)`); ASM_REWRITE_TAC[coord01]; UND 3; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[coord01]; ASM_MESON_TAC[euclid;euclid_point] ]);; (* }}} *) (* V edge *) let v_edge_inter = prove_by_refinement( `!m. (v_edge m) = ({z | ?p. (z = point p) /\ (real_of_int (SND m) <. SND p)} INTER {z | ?p. (z = point p) /\ (SND p <. real_of_int(SND m +: &:1))} INTER {z | ?p. (z = point p) /\ (FST p = real_of_int(FST m))})`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[INTER;v_edge;int_suc ]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; EQ_TAC; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[point_inj]; CONV_TAC (dropq_conv "p"); ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "p"); CONV_TAC (dropq_conv "p'"); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "u"); REWRITE_TAC[point_split;]; CONV_TAC (dropq_conv "v"); ASM_MESON_TAC[FST;SND;PAIR;coord01;euclid_point;point_onto]; ]);; (* }}} *) let v_edge_convex = prove_by_refinement( `!m. (convex (v_edge m))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[v_edge_inter;]; IMATCH_MP_TAC convex_inter; CONJ_TAC; REWRITE_TAC [open_half_plane2D_LTS_convex;]; IMATCH_MP_TAC convex_inter; REWRITE_TAC[open_half_plane2D_SLT_convex;line2D_F_convex]; ]);; (* }}} *) let vc_edge_inter = prove_by_refinement( `!m. (vc_edge m) = ({z | ?p. (z = point p) /\ (real_of_int (SND m) <=. SND p)} INTER {z | ?p. (z = point p) /\ (SND p <=. real_of_int(SND m +: &:1))} INTER {z | ?p. (z = point p) /\ (FST p = real_of_int(FST m))})`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[vc_edge;e2]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[union_subset]; REPEAT (CONJ_TAC); REWRITE_TAC[v_edge_inter]; REWRITE_TAC[SUBSET;INTER]; ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`]; REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc]; REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc]; REDUCE_TAC; REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) ,real_of_int(SND m) + &.1)` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; REWRITE_TAC[INTER;SUBSET;UNION;e2;v_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ]; GEN_TAC; DISCH_ALL_TAC; CHO 0; REWR 1; REWR 2; ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ]; REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])]; UND 2; UND 1; REWRITE_TAC[point_inj;]; REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])]; AND 0; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let vc_edge_closed = prove_by_refinement( `!m. (closed_ top2 (vc_edge m))`, (* {{{ proof *) [ REWRITE_TAC[vc_edge_inter]; GEN_TAC; IMATCH_MP_TAC closed_inter2; REWRITE_TAC[top2_top;closed_half_plane2D_LTS_closed]; IMATCH_MP_TAC closed_inter2; REWRITE_TAC[top2_top;closed_half_plane2D_SLT_closed;line2D_F_closed;]; ]);; (* }}} *) let vc_edge_convex = prove_by_refinement( `!m. (convex (vc_edge m))`, (* {{{ proof *) [ REWRITE_TAC[vc_edge_inter]; GEN_TAC; IMATCH_MP_TAC convex_inter; REWRITE_TAC[closed_half_plane2D_LTS_convex]; IMATCH_MP_TAC convex_inter; REWRITE_TAC[closed_half_plane2D_SLT_convex;line2D_F_convex;]; ]);; (* }}} *) let v_edge_subset = prove_by_refinement( `!m. (v_edge m SUBSET vc_edge m)`, (* {{{ proof *) [ REWRITE_TAC[vc_edge;SUBSET;UNION;]; MESON_TAC[]; ]);; (* }}} *) let v_edge_euclid = prove_by_refinement( `!m. (v_edge m) SUBSET (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;v_edge]; MESON_TAC[euclid_point]; ]);; (* }}} *) let v_edge_closure = prove_by_refinement( `!m. (closure top2 (v_edge m)) = vc_edge m`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC closure_subset; REWRITE_TAC[v_edge_subset;top2_top;vc_edge_closed]; REWRITE_TAC[vc_edge]; REWRITE_TAC[union_subset;e2;pointI;single_subset;point_add]; CONJ_TAC; IMATCH_MP_TAC subset_closure; REWRITE_TAC[top2_top]; REWRITE_TAC[top2]; SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ; REWRITE_TAC[GSYM REAL_RDISTRIB]; REAL_ARITH_TAC; DISCH_TAC; CONJ_TAC THEN (IMATCH_MP_TAC closure_segment) THEN REWRITE_TAC[v_edge_euclid]; TYPE_THEN `(pointI m)+point(&.0,&.1)` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REDUCE_TAC; ASM_REWRITE_TAC[int_suc]; TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; UND 1; UND 2; REAL_ARITH_TAC ; TYPE_THEN `pointI m` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REDUCE_TAC; ASM_REWRITE_TAC[int_suc]; TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; UND 1; UND 2; REAL_ARITH_TAC ; ]);; (* }}} *) let squ_euclid = prove_by_refinement( `!m. (squ m) SUBSET (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;squ]; MESON_TAC[euclid_point]; ]);; (* }}} *) let cell_euclid = prove_by_refinement( `!X. (cell X) ==> (X SUBSET euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[cell]; GEN_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); REP_CASES_TAC THEN ASM_REWRITE_TAC[h_edge_euclid;squ_euclid;v_edge_euclid]; REWRITE_TAC[ISUBSET;INR IN_SING;pointI;euclid_point]; ASM_MESON_TAC[euclid_point]; ]);; (* }}} *) let edge = jordan_def `edge C <=> ?m. ((C = v_edge m) \/ (C = h_edge m))`;; let edge_v = prove_by_refinement( `!m. edge (v_edge m)`, (* {{{ proof *) [ ASM_MESON_TAC[edge]; ]);; (* }}} *) let edge_h = prove_by_refinement( `!m. edge (h_edge m)`, (* {{{ proof *) [ ASM_MESON_TAC[edge]; ]);; (* }}} *) let num_closure = jordan_def `num_closure G x = CARD { C | (G C) /\ (closure top2 C x) }`;; let num_lower = jordan_def `num_lower G n = CARD { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;; let set_lower = jordan_def `set_lower G n = { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;; let num_lower_set = prove_by_refinement( `!G n. num_lower G n = CARD (set_lower G n)`, (* {{{ proof *) [ REWRITE_TAC[num_lower;set_lower]; ]);; (* }}} *) let even_cell = jordan_def `even_cell G C <=> (?m. (C = {(pointI m)}) /\ (EVEN (num_lower G m))) \/ (?m. (C = h_edge m) /\ (EVEN (num_lower G m))) \/ (?m. (C = v_edge m) /\ (EVEN (num_lower G m))) \/ (?m. (C = squ m) /\ (EVEN (num_lower G m)))`;; (* set *) let eq_sing = prove_by_refinement( (*** Parens added by JRH; parser no longer hacks "=" specially so it is really right associative `!X (y:A). X = {y} = ((X y) /\ (!u. (X u) ==> (u=y)))`, ***) `!X (y:A). (X = {y}) <=> ((X y) /\ (!u. (X u) ==> (u=y)))`, (* {{{ proof *) [ REWRITE_TAC[INSERT ;]; DISCH_ALL_TAC; EQ_TAC ; DISCH_THEN_REWRITE; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let h_edge_pointIv2 = prove_by_refinement( `!p q. ~(h_edge p = {(pointI q)})`, (* {{{ proof *) [ REWRITE_TAC[eq_sing;h_edge_pointI]; ]);; (* }}} *) let v_edge_pointIv2 = prove_by_refinement( `!p q. ~(v_edge p = {(pointI q)})`, (* {{{ proof *) [ REWRITE_TAC[eq_sing;v_edge_pointI]; ]);; (* }}} *) let square_pointIv2 = prove_by_refinement( `!p q. ~(squ p = {(pointI q)})`, (* {{{ proof *) [ REWRITE_TAC[eq_sing;square_pointI]; ]);; (* }}} *) let cell_nonempty = prove_by_refinement( `!z. (cell z) ==> ~(z = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[cell_mem]; GEN_TAC; REP_CASES_TAC ; CHO 1; USE 1( REWRITE_RULE [eq_sing]); ASM_MESON_TAC[EMPTY]; CHO 1; ASM_MESON_TAC[h_edge_disj;INTER_EMPTY]; CHO 1; ASM_MESON_TAC[v_edge_disj;INTER_EMPTY]; CHO 1; ASM_MESON_TAC[square_disj;INTER_EMPTY]; ]);; (* }}} *) let hv_edgeV2 = prove_by_refinement( `!p q. ~(h_edge p = v_edge q)`, (* {{{ proof *) [ ASM_MESON_TAC[cell_rules;cell_nonempty;hv_edge;INTER_IDEMPOT]; ]);; (* }}} *) let square_v_edgeV2 = prove_by_refinement( `!p q. ~(squ p = v_edge q)`, (* {{{ proof *) [ ASM_MESON_TAC[cell_rules;cell_nonempty;square_v_edge;INTER_IDEMPOT]; ]);; (* }}} *) let square_h_edgeV2 = prove_by_refinement( `!p q. ~(squ p = h_edge q)`, (* {{{ proof *) [ ASM_MESON_TAC[cell_rules;cell_nonempty;square_h_edge;INTER_IDEMPOT]; ]);; (* }}} *) let h_edge_inj = prove_by_refinement( `!p q . (h_edge p = h_edge q) <=> (p = q)`, (* {{{ proof *) [ ASM_MESON_TAC[cell_rules;cell_nonempty;h_edge_disj;INTER_IDEMPOT]; ]);; (* }}} *) let v_edge_inj = prove_by_refinement( `!p q . (v_edge p = v_edge q) <=> (p = q)`, (* {{{ proof *) [ ASM_MESON_TAC[cell_rules;cell_nonempty;v_edge_disj;INTER_IDEMPOT]; ]);; (* }}} *) let squ_inj = prove_by_refinement( `!p q . (squ p = squ q) <=> (p = q)`, (* {{{ proof *) [ ASM_MESON_TAC[cell_rules;cell_nonempty;square_disj;INTER_IDEMPOT]; ]);; (* }}} *) let finite_set_lower = prove_by_refinement( `!G n. (FINITE G) ==> (FINITE (set_lower G n))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `INJ h_edge (set_lower G n) G` SUBGOAL_TAC; REWRITE_TAC[INJ;set_lower;h_edge_inj]; ASM_MESON_TAC[]; DISCH_TAC; JOIN 0 1; USE 0 (MATCH_MP FINITE_INJ); ASM_REWRITE_TAC[]; ]);; (* }}} *) let even_cell_point = prove_by_refinement( `!G m. even_cell G {(pointI m)} <=> EVEN(num_lower G m)`, (* {{{ proof *) [ REWRITE_TAC[even_cell;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2]; REWRITE_TAC[pointI_inj;INSERT;eq_sing]; ASM_MESON_TAC[]; ]);; (* }}} *) let even_cell_h_edge = prove_by_refinement( `!G m. even_cell G (h_edge m) <=> EVEN(num_lower G m)`, (* {{{ proof *) [ REWRITE_TAC[even_cell;h_edge_pointIv2]; REWRITE_TAC[pointI_inj;INSERT;h_edge_inj;GSYM square_h_edgeV2;hv_edgeV2;eq_sing]; ASM_MESON_TAC[]; ]);; (* }}} *) let even_cell_v_edge = prove_by_refinement( `!G m. even_cell G (v_edge m) <=> EVEN(num_lower G m)`, (* {{{ proof *) [ REWRITE_TAC[even_cell;v_edge_pointIv2]; REWRITE_TAC[pointI_inj;INSERT;v_edge_inj;GSYM square_v_edgeV2;hv_edgeV2;eq_sing]; ASM_MESON_TAC[]; ]);; (* }}} *) let even_cell_squ = prove_by_refinement( `!G m. even_cell G (squ m) <=> EVEN(num_lower G m)`, (* {{{ proof *) [ REWRITE_TAC[even_cell;v_edge_pointIv2]; REWRITE_TAC[pointI_inj;INSERT;squ_inj;GSYM square_v_edgeV2;GSYM square_h_edgeV2;square_pointI;eq_sing]; ASM_MESON_TAC[]; ]);; (* }}} *) let h_edge_squ_parity = prove_by_refinement( `!G m. even_cell G (h_edge m) <=> even_cell G (squ m)`, (* {{{ proof *) [ REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower]; ]);; (* }}} *) let up = jordan_def `up (m:int#int) = (FST m,SND m +: (&:1))`;; let down = jordan_def `down (m:int#int) = (FST m,SND m -: (&:1))`;; let left = jordan_def `left (m:int#int) = (FST m -: (&:1),SND m)`;; let right = jordan_def `right (m:int#int) = (FST m +: (&:1),SND m)`;; let set_lower_delete = prove_by_refinement( `!G n. set_lower G (down n) = (set_lower G n) DELETE n`, (* {{{ proof *) [ REWRITE_TAC[set_lower;down;DELETE ]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[PAIR_SPLIT;INT_LE_SUB_LADD;GSYM INT_LT_DISCRETE;]; REWRITE_TAC[int_le;int_lt;]; REWRITE_TAC[ (ARITH_RULE `! x y. (x <. y) <=> ((x <= y) /\ ~(x = y))`)]; REWRITE_TAC[GSYM int_eq]; MESON_TAC[]; ]);; (* }}} *) let set_lower_n = prove_by_refinement( `!G n. set_lower G n n = (G (h_edge n))`, (* {{{ proof *) [ REWRITE_TAC[set_lower;int_le ; REAL_LE_REFL]; ]);; (* }}} *) (* set *) let CARD_SUC_DELETE = prove_by_refinement( `!(x:A) s. FINITE s /\ s x ==> ((SUC (CARD (s DELETE x))) = CARD s)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `s = (x INSERT (s DELETE x))` SUBGOAL_TAC; ASM_MESON_TAC[INR INSERT_DELETE]; USE 0 (ONCE_REWRITE_RULE[GSYM FINITE_DELETE]); TYPE_THEN `b = s DELETE x` ABBREV_TAC ; DISCH_THEN_REWRITE; ASM_SIMP_TAC [INR CARD_CLAUSES]; COND_CASES_TAC; ASM_MESON_TAC[INR IN_DELETE]; REWRITE_TAC[]; ]);; (* }}} *) let even_delete = prove_by_refinement( `!(x:A) s. FINITE s ==> ((EVEN (CARD (s DELETE x)) <=> EVEN (CARD s)) <=> ~(s x))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `s x` ASM_CASES_TAC ; ASM_MESON_TAC[CARD_SUC_DELETE;EVEN ]; ASM_SIMP_TAC[CARD_DELETE]; ]);; (* }}} *) let num_lower_down = prove_by_refinement( `!G m. (FINITE G) ==> ((EVEN (num_lower G (down m)) <=> EVEN (num_lower G m)) <=> ~(set_lower G m m))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[num_lower_set;set_lower_delete]; IMATCH_MP_TAC even_delete; REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower;down]; ASM_MESON_TAC[finite_set_lower]; ]);; (* }}} *) let squ_down = prove_by_refinement( `!G m. (FINITE G) ==> ((even_cell G (squ (down m)) <=> even_cell G (squ m)) <=> ~(set_lower G m m))`, (* {{{ proof *) [ REWRITE_TAC[even_cell_squ;num_lower_down]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* edge combinatorics *) (* ------------------------------------------------------------------ *) let pair_size_2 = prove_by_refinement( `!(a:A) b. ~(a= b) ==> ({a, b} HAS_SIZE 2)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[HAS_SIZE]; ASM_SIMP_TAC[FINITE_SING;CARD_CLAUSES;INR IN_SING ]; CONJ_TAC; REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; REWRITE_TAC[ARITH_RULE `2 = SUC 1`;SUC_INJ;]; MESON_TAC[SING;CARD_SING]; ]);; (* }}} *) let has_size2 = prove_by_refinement( `!u. (u HAS_SIZE 2) <=> (?(a:A) b. (u = {a , b}) /\ ~(a=b))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; REWRITE_TAC[HAS_SIZE]; DISCH_ALL_TAC; TYPE_THEN `~(u = EMPTY)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; REWR 2; REWR 1; USE 1 (REWRITE_RULE[CARD_CLAUSES]); UND 1; ARITH_TAC; DISCH_TAC; COPY 0; COPY 2; JOIN 0 2; USE 0 (MATCH_MP CARD_DELETE_CHOICE); TYPE_THEN `CARD (u DELETE CHOICE u) = 1` SUBGOAL_TAC; ONCE_REWRITE_TAC [GSYM SUC_INJ]; ASM_REWRITE_TAC[]; ARITH_TAC; DISCH_TAC; TYPE_THEN `u DELETE CHOICE u HAS_SIZE 1` SUBGOAL_TAC; REWRITE_TAC[HAS_SIZE]; ASM_REWRITE_TAC[FINITE_DELETE]; DISCH_TAC; USE 5 (MATCH_MP CARD_SING_CONV); USE 5 (REWRITE_RULE [SING]); CHO 5; TYPE_THEN `CHOICE u` EXISTS_TAC; TYPE_THEN `x` EXISTS_TAC; USE 5 (SYM); ASM_REWRITE_TAC[]; USE 4 (MATCH_MP CHOICE_DEF); ASM_SIMP_TAC[INSERT_DELETE]; TYPE_THEN `(u DELETE (CHOICE u)) x` SUBGOAL_TAC; USE 5 (SYM); ASM_REWRITE_TAC[INR IN_SING ]; DISCH_TAC; TYPE_THEN `~((u DELETE CHOICE u) (CHOICE u))` SUBGOAL_TAC; REWRITE_TAC[INR IN_DELETE]; ASM_MESON_TAC[]; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[]; ASM_MESON_TAC[pair_size_2]; ]);; (* }}} *) let in_pair = prove_by_refinement( `!(a:A) b t. {a , b} t <=> (t = b) \/ (t = a)`, (* {{{ proof *) [ REWRITE_TAC[INSERT]; ]);; (* }}} *) let pair_swap_select = jordan_def `pair_swap u (x:A) = @y. ~(x = y) /\ (u y)`;; let pair_swap_pair = prove_by_refinement( `!(a:A) b. ~(a = b) ==> (pair_swap {a,b} a = b) /\ (pair_swap {a,b} b = a)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[pair_swap_select]; REWRITE_TAC[in_pair]; CONJ_TAC THEN SELECT_TAC THEN (ASM_MESON_TAC[]); ]);; (* }}} *) let pair_swap = prove_by_refinement( `!u (x:A). (u HAS_SIZE 2)/\ (u x) ==> (~(pair_swap u x = x)) /\ (u (pair_swap u x))`, (* {{{ proof *) [ REWRITE_TAC[has_size2]; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[]; REWR 1; USE 1 (REWRITE_RULE[in_pair]); CONJ_TAC; ASM_MESON_TAC[pair_swap_pair]; UND 1; DISCH_THEN (DISJ_CASES_TAC) THEN ASM_SIMP_TAC [pair_swap_pair] THEN REWRITE_TAC[INSERT]; ]);; (* }}} *) let pair_swap_invol = prove_by_refinement( `!u (x:A). (u HAS_SIZE 2) /\ (u x) ==> (pair_swap u (pair_swap u x) = x)`, (* {{{ proof *) [ REWRITE_TAC[has_size2]; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[]; REWR 1; USE 1 (REWRITE_RULE[in_pair]); UND 1; DISCH_THEN (DISJ_CASES_TAC); ASM_SIMP_TAC [pair_swap_pair]; ASM_SIMP_TAC [pair_swap_pair]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION C *) (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) (* rectagons *) (* ------------------------------------------------------------------ *) let rectagon = jordan_def `rectagon G <=> (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\ (!m . ({0,2} (num_closure G (pointI m)))) /\ (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\ (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==> (S = G))`;; let segment = jordan_def `segment G <=> (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\ (!m . ({0,1,2} (num_closure G (pointI m)))) /\ (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\ (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==> (S = G))`;; let psegment = jordan_def `psegment G <=> segment G /\ ~(rectagon G)`;; let rectagon_segment = prove_by_refinement( `!G. (rectagon G ) ==> (segment G)`, (* {{{ proof *) [ REWRITE_TAC[segment;rectagon;INSERT ]; ASM_MESON_TAC[]; ]);; (* }}} *) let endpoint = jordan_def `endpoint G m <=> (num_closure G (pointI m) = 1)`;; let midpoint = jordan_def `midpoint G m <=> (num_closure G (pointI m) = 2)`;; let psegment_endpoint = prove_by_refinement( `!G. (psegment G) ==> (?m. (endpoint G m))`, (* {{{ proof *) [ REWRITE_TAC[psegment;rectagon;segment;endpoint]; DISCH_ALL_TAC; UND 5; ASM_REWRITE_TAC[]; DISCH_TAC; LEFT 5 "m"; CHO 5; TSPEC `m` 3; USE 3 (REWRITE_RULE[INSERT]); USE 5 (REWRITE_RULE[INSERT]); ASM_MESON_TAC[]; ]);; (* }}} *) let rectagon_endpoint = prove_by_refinement( `!G. (rectagon G) ==> ~(?m. (endpoint G m))`, (* {{{ proof *) [ REWRITE_TAC[rectagon;endpoint;INSERT ]; DISCH_ALL_TAC; CHO 0; ASM_MESON_TAC[ARITH_RULE `(~(1=2)) /\ ~(1=0)` ]; ]);; (* }}} *) let num_closure_mono = prove_by_refinement( `!G G' x. (FINITE G') /\ (G SUBSET G') ==> (num_closure G x <= num_closure G' x)`, (* {{{ proof *) [ REWRITE_TAC[num_closure]; DISCH_ALL_TAC; IMATCH_MP_TAC CARD_SUBSET ; REWRITE_TAC[ISUBSET]; CONJ_TAC; ASM_MESON_TAC[ISUBSET]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G'` EXISTS_TAC; ASM_REWRITE_TAC[ISUBSET]; MESON_TAC[]; ]);; (* }}} *) let endpoint_psegment = prove_by_refinement( `!G. (?m. (endpoint G m)) /\ (segment G) ==> (psegment G)`, (* {{{ proof *) [ ASM_MESON_TAC [psegment;rectagon_endpoint]; ]);; (* }}} *) let num_closure_size = prove_by_refinement( `!G x. FINITE G ==> ({C | G C /\ closure top2 C x} HAS_SIZE (num_closure G x) )`, (* {{{ proof *) [ REWRITE_TAC[HAS_SIZE;num_closure]; DISCH_ALL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; REWRITE_TAC[ISUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) let endpoint_edge = prove_by_refinement( `!G m. (FINITE G) /\ (endpoint G m) ==> (?! e. (G e) /\ (closure top2 e (pointI m)))`, (* {{{ proof *) [ REWRITE_TAC[endpoint;]; DISCH_ALL_TAC; TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} HAS_SIZE 1` SUBGOAL_TAC; UND 1; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); IMATCH_MP_TAC num_closure_size; ASM_REWRITE_TAC[]; DISCH_TAC; USE 2 (MATCH_MP CARD_SING_CONV); USE 2 (REWRITE_RULE[SING]); CHO 2; USE 2 (REWRITE_RULE[eq_sing]); REWRITE_TAC[EXISTS_UNIQUE_ALT]; ASM_MESON_TAC[]; ]);; (* }}} *) let midpoint_edge = prove_by_refinement( `!G m. (FINITE G) /\ (midpoint G m) ==> {C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2`, (* {{{ proof *) [ REWRITE_TAC[midpoint;]; DISCH_ALL_TAC; UND 1; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); IMATCH_MP_TAC num_closure_size; ASM_REWRITE_TAC[]; ]);; (* }}} *) let two_endpoint = prove_by_refinement( `!e. (edge e) ==> ({ m | (closure top2 e (pointI m)) } HAS_SIZE 2)`, (* {{{ proof *) [ REWRITE_TAC[edge]; DISCH_ALL_TAC; CHO 0; UND 0; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[v_edge_closure;h_edge_closure]; REWRITE_TAC[vc_edge;UNION;has_size2]; TYPE_THEN `m` EXISTS_TAC; TYPE_THEN `(FST m,SND m +: (&:1))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INR IN_SING ;]; TYPE_THEN `euclid_plus (pointI m) e2 = pointI (FST m,SND m +: (&:1))` SUBGOAL_TAC ; REWRITE_TAC[pointI;e2;point_add;int_suc ]; REDUCE_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[v_edge_pointI;pointI_inj;]; REWRITE_TAC[INSERT]; MESON_TAC[]; REWRITE_TAC[PAIR_SPLIT]; INT_ARITH_TAC; (* 2nd case: *) ASM_REWRITE_TAC[v_edge_closure;h_edge_closure]; REWRITE_TAC[hc_edge;UNION;has_size2]; TYPE_THEN `m` EXISTS_TAC; TYPE_THEN `(FST m +: (&:1),SND m )` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INR IN_SING ;]; TYPE_THEN `euclid_plus (pointI m) e1 = pointI (FST m +: (&:1),SND m )` SUBGOAL_TAC ; REWRITE_TAC[pointI;e1;point_add;int_suc ]; REDUCE_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[h_edge_pointI;pointI_inj;]; REWRITE_TAC[INSERT]; MESON_TAC[]; REWRITE_TAC[PAIR_SPLIT]; INT_ARITH_TAC; ]);; (* }}} *) let edge_midend = prove_by_refinement( `!G e m. (segment G) /\ (G e) /\ (closure top2 e (pointI m)) ==> (midpoint G m) \/ (endpoint G m)`, (* {{{ proof *) [ REWRITE_TAC[segment;midpoint;endpoint]; DISCH_ALL_TAC; TSPEC `m` 3; USE 3 (REWRITE_RULE[INSERT]); TYPE_THEN `~(num_closure G (pointI m) = 0)` SUBGOAL_TAC; USE 0 (MATCH_MP num_closure_size); TSPEC `pointI m` 0; PROOF_BY_CONTR_TAC; REWR 7; REWR 0; USE 0(REWRITE_RULE[HAS_SIZE_0]); UND 0; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 3; ARITH_TAC; ]);; (* }}} *) let plus_e12 = prove_by_refinement( `!m. ((pointI m) + e2 = pointI (FST m,SND m +: (&:1))) /\ ((pointI m) + e1 = pointI (FST m +: (&:1),SND m))`, (* {{{ proof *) [ REWRITE_TAC[e1;e2]; REWRITE_TAC[pointI;point_add;int_suc]; REDUCE_TAC; ]);; (* }}} *) let c_edge_euclid = prove_by_refinement( `!e. (edge e) ==> (closure top2 e) SUBSET (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[edge]; GEN_TAC; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[hc_edge;vc_edge;h_edge_closure;v_edge_closure;union_subset;plus_e12] THEN MESON_TAC[cell_rules; cell_euclid]; ]);; (* }}} *) (* slow proof... *) let inter_lattice = prove_by_refinement( `!x e e'. (edge e) /\ (edge e') /\ (~(e=e')) /\ ((closure top2 e INTER closure top2 e') x) ==> (?m. x = pointI m)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `euclid 2 x` SUBGOAL_TAC; USE 3 (REWRITE_RULE[INTER]); AND 3; USE 0 (MATCH_MP c_edge_euclid); USE 0 (REWRITE_RULE[ISUBSET]); ASM_MESON_TAC[]; DISCH_THEN (MP_TAC o (MATCH_MP point_onto)); DISCH_TAC; CHO 4; ASM_REWRITE_TAC[]; ASSUME_TAC square_domain; TSPEC `p` 5; USE 5 (CONV_RULE (NAME_CONFLICT_CONV)); UND 5; LET_TAC ; REWRITE_TAC[UNION]; UND 3; ASM_REWRITE_TAC[INTER]; KILL 4; UND 2; UND 0; REWRITE_TAC[edge] ; DISCH_THEN (CHOOSE_THEN MP_TAC); UND 1; REWRITE_TAC[edge] ; DISCH_THEN (CHOOSE_THEN MP_TAC); REP_CASES_TAC THEN UNDISCH_FIND_TAC `(~)` THEN UNDISCH_FIND_TAC `(closure)` THEN UNDISCH_FIND_TAC `(point p)` THEN ASM_REWRITE_TAC[] THEN (REWRITE_TAC[INR IN_SING;h_edge_closure;v_edge_closure;UNION;vc_edge;hc_edge;plus_e12 ]) THEN (* 1st,2nd,3rd, *) (* tx *) (let tx = REWRITE_RULE[EQ_EMPTY;INTER ] in MESON_TAC[tx hv_edge;tx v_edge_disj;tx h_edge_disj;tx square_v_edge;tx square_h_edge;v_edge_inj;h_edge_inj]); ]);; (* }}} *) let edgec_convex = prove_by_refinement( `!e. (edge e) ==> (convex (closure top2 e))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[v_edge_closure;h_edge_closure;hc_edge_convex;vc_edge_convex]; ]);; (* }}} *) let midpoint_h_edge = prove_by_refinement( `!m. (h_edge m) (((&.1)/(&.2))*# (pointI m) + ((&.1)/(&.2))*# (pointI m + e1))`, (* {{{ proof *) [ REWRITE_TAC[plus_e12]; REWRITE_TAC[h_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc]; GEN_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC; TYPE_THEN `b = real_of_int(FST m)` ABBREV_TAC; CONJ_TAC; real_poly_tac ; CONJ_TAC; ineq_lt_tac `b + (&.1/(&.2)) = &1 / &2 * b + &1 / &2 * (b + &1)`; ineq_lt_tac `((&1 / &2) * b + &1 / &2 * (b + &1)) + (&1 / &2) = b +. &1` ]);; (* }}} *) let midpoint_v_edge = prove_by_refinement( `!m. (v_edge m) (((&.1)/(&.2))*# (pointI m) + ((&.1)/(&.2))*# (pointI m + e2))`, (* {{{ proof *) [ REWRITE_TAC[plus_e12]; REWRITE_TAC[v_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc]; GEN_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC; TYPE_THEN `b = real_of_int(FST m)` ABBREV_TAC; CONJ_TAC; real_poly_tac ; CONJ_TAC; ineq_lt_tac `a +. (&1/ &2)= &1 / &2 * a + &1 / &2 * (a + &1)`; ineq_lt_tac `(&1 / &2 * a + &1 / &2 * (a + &1)) +(&1/ &2) = a + &1`; ]);; (* }}} *) let midpoint_unique = prove_by_refinement( `!x y e e'. (edge e) /\ (edge e') /\ (~(e = e')) /\ ((closure top2 e INTER closure top2 e') x) /\ ((closure top2 e INTER closure top2 e') y) ==> ( x = y)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `convex (closure top2 e INTER closure top2 e')` SUBGOAL_TAC; IMATCH_MP_TAC convex_inter ; ASM_MESON_TAC[edgec_convex]; TYPE_THEN `(?m. x = pointI m) /\ (?n. y = pointI n)` SUBGOAL_TAC; ASM_MESON_TAC[inter_lattice]; DISCH_ALL_TAC; CHO 6; CHO 7; ASM_REWRITE_TAC[]; REWR 3; REWR 4; KILL 6; KILL 7; TYPE_THEN `(closure top2 e (pointI n)) /\ closure top2 e (pointI m)` SUBGOAL_TAC; UND 4; UND 3; REWRITE_TAC[INTER]; MESON_TAC[]; DISCH_ALL_TAC; WITH 0 (MATCH_MP edgec_convex); UND 6; USE 0 (REWRITE_RULE[edge]); CHO 0; UND 0; DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[]; (* ml -- start of 1st main branch. *) DISCH_ALL_TAC; TYPE_THEN `((n = m') \/ (n = (FST m',SND m' + &:1))) /\ ((m = m') \/ (m = (FST m',SND m' + &:1)))` SUBGOAL_TAC; UND 6; UND 7; ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI]; MESON_TAC[]; REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; TYPE_THEN `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC; (* start A*) TYPE_THEN `X (pointI m') /\ X (pointI m' + e2) ==> ~(X INTER (v_edge m') = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS;INTER ]; USE 5 (REWRITE_RULE[convex;mk_segment]); DISCH_TAC ; H_MATCH_MP (HYP "5") (HYP "10"); USE 11 (REWRITE_RULE[ISUBSET]); TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e2)` ABBREV_TAC; TYPE_THEN `b` EXISTS_TAC; TSPEC `b` 11; CONJ_TAC; UND 11; DISCH_THEN IMATCH_MP_TAC ; TYPE_THEN `&1/ &2` EXISTS_TAC; CONV_TAC REAL_RAT_REDUCE_CONV; EXPAND_TAC "b"; MESON_TAC[]; EXPAND_TAC "b"; MATCH_ACCEPT_TAC midpoint_v_edge; (* end of goal A *) REWRITE_TAC[plus_e12]; (* start B*) TYPE_THEN `X INTER (v_edge m') = EMPTY ` SUBGOAL_TAC; REWRITE_TAC[EQ_EMPTY]; DISCH_ALL_TAC; USE 10 (REWRITE_RULE[INTER]); TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC; ASM_MESON_TAC[inter_lattice;edge]; DISCH_TAC; CHO 11; REWR 10; ASM_MESON_TAC[v_edge_pointI]; DISCH_THEN_REWRITE; DISCH_TAC; REP_CASES_TAC THEN ASM_MESON_TAC[]; (* end of FIRST main branch -- snd main branch -- fully parallel *) DISCH_ALL_TAC; TYPE_THEN `((n = m') \/ (n = (FST m' + &:1,SND m'))) /\ ((m = m') \/ (m = (FST m' + &:1,SND m' )))` SUBGOAL_TAC; UND 6; UND 7; ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI]; MESON_TAC[]; REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; TYPE_THEN `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC; (* start A' *) TYPE_THEN `X (pointI m') /\ X (pointI m' + e1) ==> ~(X INTER (h_edge m') = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS;INTER ]; USE 5 (REWRITE_RULE[convex;mk_segment]); DISCH_TAC ; H_MATCH_MP (HYP "5") (HYP "10"); USE 11 (REWRITE_RULE[ISUBSET]); TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e1)` ABBREV_TAC; TYPE_THEN `b` EXISTS_TAC; TSPEC `b` 11; CONJ_TAC; UND 11; DISCH_THEN IMATCH_MP_TAC ; TYPE_THEN `&1/ &2` EXISTS_TAC; CONV_TAC REAL_RAT_REDUCE_CONV; EXPAND_TAC "b"; MESON_TAC[]; EXPAND_TAC "b"; MATCH_ACCEPT_TAC midpoint_h_edge; (* end of goal A' *) REWRITE_TAC[plus_e12]; (* start B' *) TYPE_THEN `X INTER (h_edge m') = EMPTY ` SUBGOAL_TAC; REWRITE_TAC[EQ_EMPTY]; DISCH_ALL_TAC; USE 10 (REWRITE_RULE[INTER]); TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC; ASM_MESON_TAC[inter_lattice;edge]; DISCH_TAC; CHO 11; REWR 10; ASM_MESON_TAC[h_edge_pointI]; DISCH_THEN_REWRITE; DISCH_TAC; REP_CASES_TAC THEN ASM_MESON_TAC[]; ]);; (* }}} *) let edge_inter = prove_by_refinement( `!C C'. (edge C) /\ (edge C') /\ (adj C C') ==> (?m. (closure top2 C) INTER (closure top2 C') = {(pointI m)}) `, (* {{{ proof *) [ REWRITE_TAC[adj]; DISCH_ALL_TAC; USE 3 (REWRITE_RULE[EMPTY_EXISTS]); CHO 3; TYPE_THEN `(?m. u = pointI m)` SUBGOAL_TAC; ASM_MESON_TAC[inter_lattice]; DISCH_THEN (CHOOSE_TAC); REWR 3; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC [eq_sing]; ASM_MESON_TAC[midpoint_unique]; ]);; (* }}} *) let inter_midpoint = prove_by_refinement( `!G C C' m. (segment G) /\ (G C) /\ (G C') /\ (adj C C') /\ (((closure top2 C) INTER (closure top2 C')) (pointI m)) ==> (midpoint G m) `, (* {{{ proof *) [ REWRITE_TAC[midpoint;segment]; DISCH_ALL_TAC; TSPEC `m` 3; USE 3 (REWRITE_RULE[INSERT]); UND 3; USE 0 (MATCH_MP num_closure_size); TSPEC `pointI m` 0; TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ; TYPE_THEN `X C /\ X C'` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; UND 8; REWRITE_TAC[INTER]; (* done WITH subgoal *) DISCH_TAC; TYPE_THEN `~(C = C')` SUBGOAL_TAC; ASM_MESON_TAC[adj]; DISCH_TAC; REP_CASES_TAC; ASM_REWRITE_TAC[]; REWR 0; USE 0 (MATCH_MP CARD_SING_CONV); USE 0 (REWRITE_RULE[SING;eq_sing]); ASM_MESON_TAC[]; REWR 0; USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY]); ASM_MESON_TAC[]; ]);; (* }}} *) let mid_end_disj = prove_by_refinement( `!G m. ~(endpoint G m /\ midpoint G m)`, (* {{{ proof *) [ REWRITE_TAC[endpoint;midpoint]; ASM_MESON_TAC[ARITH_RULE `~(1=2)`]; ]);; (* }}} *) let two_exclusion = prove_by_refinement( `!X p q (r:A). (X HAS_SIZE 2) /\ (X p) /\ (X q) /\ (X r) /\ (~(p = r)) /\ (~(q = r)) ==> (p = q)`, (* {{{ proof *) [ REWRITE_TAC[has_size2;]; DISCH_ALL_TAC; CHO 0; CHO 0; UND 1; UND 2; UND 3; ASM_REWRITE_TAC[INSERT]; ASM_MESON_TAC[]; ]);; (* }}} *) let midpoint_exists = prove_by_refinement( `!G e. (segment G) /\ (G e) /\ (~(G = {e})) ==> (?m. (closure top2 e (pointI m)) /\ (midpoint G m))`, (* {{{ proof *) [ DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `!m. (closure top2 e (pointI m)) ==> (endpoint G m)` SUBGOAL_TAC; ASM_MESON_TAC[edge_midend]; DISCH_TAC; UND 2; REWRITE_TAC[]; UND 0; REWRITE_TAC[segment]; DISCH_ALL_TAC; TSPEC `{e}` 7; UND 7; DISCH_THEN (IMATCH_MP_TAC o GSYM); ASM_REWRITE_TAC[ISUBSET;INR IN_SING;]; CONJ_TAC; ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC [eq_sing]; DISCH_ALL_TAC; TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 C') = {(pointI m)})` SUBGOAL_TAC; IMATCH_MP_TAC edge_inter; ASM_MESON_TAC[ISUBSET]; DISCH_THEN CHOOSE_TAC; TSPEC `m` 4; TYPE_THEN `endpoint G m` SUBGOAL_TAC; UND 4; DISCH_THEN IMATCH_MP_TAC ; UND 10; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER]; MESON_TAC[]; REWRITE_TAC[endpoint]; USE 0 (MATCH_MP num_closure_size); TSPEC `(pointI m)` 0; DISCH_TAC; REWR 0; USE 0 (MATCH_MP CARD_SING_CONV); USE 0 (REWRITE_RULE[SING]); CHO 0; USE 0 (REWRITE_RULE[eq_sing]); USE 10 (REWRITE_RULE[eq_sing]); USE 10 (REWRITE_RULE[INTER]); ASM_MESON_TAC[]; ]);; (* }}} *) let pair_swap_unique = prove_by_refinement( `!u x (y:A). (u HAS_SIZE 2) /\ (u x) /\ (u y) /\ ~(x = y) ==> (y = pair_swap u x)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC two_exclusion ; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[pair_swap]; ]);; (* }}} *) let pair_swap_adj = prove_by_refinement( `!G e m e'. (segment G) /\ (G e) /\ (midpoint G m) /\ (closure top2 e (pointI m)) /\ (e' = pair_swap {C | G C /\ closure top2 C (pointI m)} e) ==> ({C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2) /\ G e' /\ adj e' e /\ (closure top2 e' (pointI m)) `, (* {{{ proof *) [ REP_GEN_TAC; TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC; DISCH_ALL_TAC; TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC; USE 3 (REWRITE_RULE[midpoint]); USE 1 (REWRITE_RULE[segment]); UND 1; DISCH_ALL_TAC; USE 1 (MATCH_MP num_closure_size); TSPEC `pointI m` 1; REWR 1; DISCH_TAC; CONJ_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `X e` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; DISCH_TAC; (* SUBCONJ_TAC; *) TYPE_THEN `X e'` SUBGOAL_TAC; ASM_MESON_TAC[pair_swap]; DISCH_TAC; SUBCONJ_TAC; UND 8; EXPAND_TAC "X"; REWRITE_TAC[]; MESON_TAC[]; DISCH_TAC; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); SUBCONJ_TAC; UND 8; EXPAND_TAC "X"; REWRITE_TAC[]; MESON_TAC[]; ASM_REWRITE_TAC[adj]; ASM_SIMP_TAC[pair_swap]; REWRITE_TAC[EMPTY_EXISTS]; ASM_REWRITE_TAC[INTER]; ASM_MESON_TAC[]; ]);; (* }}} *) (* A terminal edge is expressed as (endpoint G m) /\ (closure top2 e (pointI m)) *) let terminal_edge_adj = prove_by_refinement( `!G e m. (segment G) /\ (G e) /\ (~(G = {e})) /\ (endpoint G m) /\ (closure top2 e (pointI m)) ==> (?! e'. (G e') /\ (adj e e')) `, (* {{{ proof *) [ REP_GEN_TAC; DISCH_ALL_TAC; REWRITE_TAC[EXISTS_UNIQUE_ALT ]; TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC; IMATCH_MP_TAC midpoint_exists; ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; AND 5; COPY 5; USE 5 (REWRITE_RULE[midpoint]); TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; USE 8 (MATCH_MP num_closure_size); TSPEC `pointI m'` 8; REWR 8; TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m')}` ABBREV_TAC; TYPE_THEN `X e` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `pair_swap X e` EXISTS_TAC; GEN_TAC; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 y) = {(pointI m)}) ` SUBGOAL_TAC; IMATCH_MP_TAC edge_inter; ASM_MESON_TAC[segment;ISUBSET;]; DISCH_THEN CHOOSE_TAC; (* show m''=m', then X y, then y != e, then it is the PAIR swap *) TYPE_THEN `ec = (closure top2 e)` ABBREV_TAC; TYPE_THEN `ec (pointI m'')` SUBGOAL_TAC; UND 13; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `m'' = m'` SUBGOAL_TAC; TYPE_THEN `Z = {m | ec (pointI m)}` ABBREV_TAC; IMATCH_MP_TAC two_exclusion; TYPE_THEN `Z` EXISTS_TAC; TYPE_THEN `m` EXISTS_TAC; CONJ_TAC; EXPAND_TAC "Z"; EXPAND_TAC "ec"; IMATCH_MP_TAC two_endpoint; ASM_MESON_TAC[segment;ISUBSET]; EXPAND_TAC "Z"; ASM_REWRITE_TAC[]; TYPE_THEN `midpoint G m''` SUBGOAL_TAC ; IMATCH_MP_TAC inter_midpoint; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `y` EXISTS_TAC; ASM_REWRITE_TAC[INR IN_SING ]; ASM_MESON_TAC[mid_end_disj]; (* m'' = m' done *) DISCH_TAC; TYPE_THEN `X y` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; USE 13 (REWRITE_RULE[INTER;eq_sing]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `~(y = e)` SUBGOAL_TAC; UND 12; MESON_TAC[adj]; DISCH_TAC; IMATCH_MP_TAC (GSYM pair_swap_unique); ASM_REWRITE_TAC[]; (* now second direction nsd *) DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASSUME_TAC pair_swap_adj; TYPEL_THEN [`G`;`e`;`m'`;`pair_swap X e`] (USE 11 o ISPECL); UND 11; ASM_REWRITE_TAC[]; TYPE_THEN `X (pair_swap X e)` SUBGOAL_TAC; ASM_MESON_TAC[pair_swap]; DISCH_TAC; TYPE_THEN `closure top2 (pair_swap X e) (pointI m')` SUBGOAL_TAC; UND 11; TYPE_THEN `e'' = pair_swap X e` ABBREV_TAC ; EXPAND_TAC "X"; REWRITE_TAC[]; MESON_TAC[]; ASM_MESON_TAC[adj_symm]; ]);; (* }}} *) let psegment_edge = prove_by_refinement( `!e. (edge e) ==> (psegment {e})`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC endpoint_psegment; ASM_REWRITE_TAC[endpoint;segment;EQ_EMPTY ;INR IN_SING;FINITE_SING;ISUBSET;num_closure]; CONJ_TAC; UND 0; REWRITE_TAC[edge]; DISCH_TAC ; CHO 0; TYPE_THEN `m` EXISTS_TAC; UND 0; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC CARD_SING; REWRITE_TAC[SING]; TYPE_THEN `v_edge m` EXISTS_TAC; REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ]; MESON_TAC[]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC CARD_SING; REWRITE_TAC[SING]; TYPE_THEN `h_edge m` EXISTS_TAC; REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ]; MESON_TAC[]; CONJ_TAC; MESON_TAC[]; CONJ_TAC ; ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC[INSERT]; GEN_TAC; TYPE_THEN `closure top2 e (pointI m)` ASM_CASES_TAC ; DISJ1_TAC THEN DISJ2_TAC ; IMATCH_MP_TAC CARD_SING; REWRITE_TAC[SING ;eq_sing]; ASM_MESON_TAC[]; DISJ2_TAC ; TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI m)} = {}` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 2 (REWRITE_RULE[EMPTY_EXISTS]); CHO 2; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[CARD_CLAUSES]; DISCH_ALL_TAC; REWRITE_TAC[eq_sing]; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_delete = prove_by_refinement( `!G e m. (segment G) /\ (endpoint G m) /\ (closure top2 e (pointI m)) /\ (~(G = {e})) ==> (segment (G DELETE e))`, (* {{{ proof *) [ REP_GEN_TAC; TYPE_THEN `~G e` ASM_CASES_TAC; USE 0 (REWRITE_RULE[INR DELETE_NON_ELEMENT]); ASM_MESON_TAC[]; REWRITE_TAC[segment]; DISCH_ALL_TAC; ASM_REWRITE_TAC[FINITE_DELETE;delete_empty]; CONJ_TAC; UND 3; MESON_TAC[ISUBSET ;INR IN_DELETE]; CONJ_TAC; GEN_TAC; REWRITE_TAC[INSERT]; TYPE_THEN `num_closure (G DELETE e) (pointI m') <=| (num_closure G (pointI m'))` SUBGOAL_TAC; IMATCH_MP_TAC num_closure_mono; ASM_REWRITE_TAC[INR IN_DELETE;ISUBSET]; MESON_TAC[]; TSPEC `m'` 4; USE 4 (REWRITE_RULE[INSERT]); UND 4; ARITH_TAC; DISCH_ALL_TAC; (* tsh1 *) TYPE_THEN `(?! e'. (G e') /\ (adj e e'))` SUBGOAL_TAC; IMATCH_MP_TAC terminal_edge_adj; REWRITE_TAC[segment]; TYPE_THEN `m` EXISTS_TAC; ASM_MESON_TAC[]; REWRITE_TAC[EXISTS_UNIQUE_ALT]; DISCH_THEN CHOOSE_TAC; (* tsh2 *) TYPE_THEN `(e INSERT S = G) ==> (S = G DELETE e)` SUBGOAL_TAC; UND 9; IMATCH_MP_TAC (TAUT `(a ==> b ==> C) ==> (b ==> a ==> C)`); DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); REWRITE_TAC[DELETE_INSERT]; REWRITE_TAC[DELETE;ISUBSET;]; DISCH_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; UND 9; MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; (* tsh3 *) TYPE_THEN `S e'` ASM_CASES_TAC; TSPEC `e INSERT S` 5; UND 5; DISCH_THEN IMATCH_MP_TAC ; REWR 0; ASM_REWRITE_TAC [INR INSERT_SUBSET;NOT_INSERT_EMPTY]; CONJ_TAC; UND 9; MESON_TAC[ISUBSET;INR IN_DELETE]; DISCH_ALL_TAC; TSPEC `C` 11; TSPEC `C'` 11; REWR 11; (* ok to here *) (* oth1 *) TYPE_THEN `C' = e` ASM_CASES_TAC; ASM_REWRITE_TAC[INSERT]; ASM_REWRITE_TAC[INSERT]; (* *) (* UND 12; *) TYPE_THEN `C = e` ASM_CASES_TAC; REWR 15; TSPEC `C'` 12; REWR 12; ASM_MESON_TAC[]; (* start not not -- *) UND 11; DISCH_THEN IMATCH_MP_TAC ; CONJ_TAC; UND 5; REWRITE_TAC[INSERT]; ASM_MESON_TAC[]; UND 14; REWRITE_TAC[DELETE]; ASM_MESON_TAC[]; (* LAST case *) TSPEC `S` 5; TYPE_THEN `S = G` SUBGOAL_TAC; UND 5; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; SUBCONJ_TAC; UND 9; REWRITE_TAC[DELETE;ISUBSET]; MESON_TAC[]; DISCH_TAC; DISCH_ALL_TAC; TYPEL_THEN [`C`;`C'`] (USE 11 o ISPECL); UND 11; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[DELETE]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; TSPEC `C` 12; TYPE_THEN `G C /\ adj e C` SUBGOAL_TAC; ASM_MESON_TAC[adj_symm;ISUBSET]; DISCH_TAC; REWR 12; ASM_MESON_TAC[]; TSPEC `e'` 12; ASM_MESON_TAC[]; ]);; (* }}} *) let other_end = jordan_def `other_end e m = pair_swap {m | closure top2 e (pointI m)} m`;; let other_end_prop = prove_by_refinement( `!e m. (edge e) /\ (closure top2 e (pointI m))==> (closure top2 e (pointI (other_end e m))) /\ (~(other_end e m = m)) /\ (other_end e (other_end e m) = m)`, (* {{{ proof *) [ REWRITE_TAC[other_end]; DISCH_ALL_TAC; USE 0 (MATCH_MP two_endpoint); TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC; TYPE_THEN `X m` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC []; DISCH_TAC; ASM_SIMP_TAC[pair_swap_invol;pair_swap]; TYPE_THEN `X (pair_swap X m)` SUBGOAL_TAC ; ASM_SIMP_TAC[pair_swap]; EXPAND_TAC "X"; REWRITE_TAC[]; ]);; (* }}} *) let num_closure_delete = prove_by_refinement( `!G e p. (FINITE G) ==> ((num_closure (G DELETE e) p) = (if ((G e) /\ (closure top2 e p)) then ((num_closure G p) -| 1) else (num_closure G p)))`, (* {{{ proof *) [ DISCH_ALL_TAC; COND_CASES_TAC; REWRITE_TAC[num_closure]; TYPE_THEN `{C | (G DELETE e) C /\ closure top2 C p} = {C | G C /\ closure top2 C p} DELETE e` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[DELETE ]; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `FINITE {C | G C /\ closure top2 C p}` SUBGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[ISUBSET;]; MESON_TAC[]; DISCH_TAC; USE 2 (MATCH_MP CARD_DELETE); TSPEC `e` 2; ASM_REWRITE_TAC[]; REWRITE_TAC[num_closure;DELETE ]; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; GEN_TAC; TYPE_THEN `x = e` ASM_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let psegment_delete_end = prove_by_refinement( `!G m e. (psegment G) /\ (endpoint G m) /\ (G e) /\ (closure top2 e (pointI m)) /\ (~(G = {e})) ==> (endpoint (G DELETE e) = (((other_end e m) INSERT (endpoint G)) DELETE m))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[psegment;segment]; DISCH_TAC; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[psegment;segment;ISUBSET]; DISCH_TAC; TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC; TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC; EXPAND_TAC "X"; IMATCH_MP_TAC two_endpoint; ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[endpoint;ISUBSET;INSERT;]; GEN_TAC; ASM_SIMP_TAC[num_closure_delete]; REWRITE_TAC[DELETE]; TYPE_THEN `x = m` ASM_CASES_TAC; ASM_REWRITE_TAC[]; USE 1 (REWRITE_RULE[endpoint]); ASM_REWRITE_TAC[]; ARITH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `x = other_end e m` ASM_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; COND_CASES_TAC; DISCH_TAC; TYPE_THEN `X x /\ X m /\ X (other_end e m) /\ (~(m= other_end e m))` SUBGOAL_TAC ; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; ASM_MESON_TAC[other_end_prop]; DISCH_ALL_TAC; ASM_MESON_TAC[two_exclusion]; MESON_TAC[]; (* snd half *) REWRITE_TAC[SUBSET;endpoint;DELETE_INSERT]; ASM_SIMP_TAC[other_end_prop]; ASM_SIMP_TAC[num_closure_delete]; REWRITE_TAC[INSERT;DELETE ]; GEN_TAC; TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC; ASM_MESON_TAC[psegment;midpoint_exists]; DISCH_THEN CHOOSE_TAC; DISCH_THEN DISJ_CASES_TAC; (* ---m *) COND_CASES_TAC; TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m' = m)) /\ (~(x = m'))` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; ASM_MESON_TAC[mid_end_disj]; ASM_MESON_TAC[two_exclusion]; USE 10 (REWRITE_RULE[endpoint]); ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[other_end_prop]; TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m = m'))` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[other_end_prop]; ASM_MESON_TAC[mid_end_disj]; DISCH_TAC; TYPE_THEN `x = m'` SUBGOAL_TAC; ASM_MESON_TAC[two_exclusion]; USE 9 (REWRITE_RULE[midpoint]); ASM_MESON_TAC[ARITH_RULE `(x = 2) ==> (x -| 1 = 1)`]; ]);; (* }}} *) let endpoint_size2 = prove_by_refinement( `!G. (psegment G) ==> (endpoint G HAS_SIZE 2)`, (* {{{ proof *) [ TYPE_THEN `(!n G. (psegment G) /\ (G HAS_SIZE n) ==> (endpoint G HAS_SIZE 2)) ==> (!G. (psegment G) ==> endpoint G HAS_SIZE 2)` SUBGOAL_TAC; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `?n. G HAS_SIZE n` SUBGOAL_TAC; REWRITE_TAC[HAS_SIZE]; CONV_TAC (dropq_conv "n"); ASM_MESON_TAC[psegment;segment]; DISCH_THEN CHOOSE_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; INDUCT_TAC; REWRITE_TAC[psegment;segment]; ASM_MESON_TAC[HAS_SIZE_0]; DISCH_ALL_TAC; TYPE_THEN `(?m. (endpoint G m))` SUBGOAL_TAC; ASM_SIMP_TAC[psegment_endpoint]; DISCH_THEN CHOOSE_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC ; ASM_MESON_TAC[psegment;segment]; DISCH_TAC; TYPE_THEN `?e. (G e /\ closure top2 e (pointI m))` SUBGOAL_TAC; USE 3 (REWRITE_RULE[endpoint]); USE 4 (MATCH_MP num_closure_size); TSPEC `(pointI m)` 4; REWR 4; USE 4 (MATCH_MP CARD_SING_CONV); USE 4(REWRITE_RULE[SING]); CHO 4; USE 4 (REWRITE_RULE[eq_sing]); ASM_MESON_TAC[]; DISCH_THEN CHOOSE_TAC; TYPE_THEN `G = {e}` ASM_CASES_TAC; TYPE_THEN `endpoint G = { m | closure top2 e (pointI m)}` SUBGOAL_TAC; MATCH_MP_TAC EQ_EXT; REWRITE_TAC[endpoint]; USE 4 (MATCH_MP num_closure_size ); GEN_TAC; TSPEC `pointI x` 4; REWR 4; USE 4 (REWRITE_RULE[INR IN_SING]); EQ_TAC; DISCH_TAC; REWR 4; USE 4 (MATCH_MP CARD_SING_CONV); USE 4(REWRITE_RULE[SING;eq_sing]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI x)} ={e}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING ]; ASM_MESON_TAC[]; DISCH_TAC; REWR 4; USE 4 (REWRITE_RULE[HAS_SIZE]); ASM_MESON_TAC[CARD_SING;SING]; DISCH_THEN_REWRITE; IMATCH_MP_TAC two_endpoint; ASM_MESON_TAC[psegment;segment;ISUBSET]; (*pm*) (* main case *) TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[psegment;segment;ISUBSET]; DISCH_TAC; TSPEC `G DELETE e` 0; TYPE_THEN `psegment (G DELETE e) /\ G DELETE e HAS_SIZE n` SUBGOAL_TAC; CONJ_TAC; REWRITE_TAC[psegment]; CONJ_TAC; IMATCH_MP_TAC segment_delete; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[psegment]; ASM_MESON_TAC[psegment]; (* it isn't a rectagon if it has an endpoint *) TYPE_THEN `(endpoint (G DELETE e) (other_end e m)) ` SUBGOAL_TAC; ASM_SIMP_TAC[psegment_delete_end]; REWRITE_TAC[DELETE_INSERT]; COND_CASES_TAC; ASM_MESON_TAC[other_end_prop]; REWRITE_TAC[INSERT]; ASM_MESON_TAC[rectagon_endpoint]; UND 2; REWRITE_TAC[HAS_SIZE]; ASM_MESON_TAC[SUC_INJ;FINITE_DELETE_IMP;CARD_SUC_DELETE]; DISCH_TAC; REWR 0; UND 0; ASM_SIMP_TAC[psegment_delete_end]; DISCH_TAC; TYPE_THEN `G' = (other_end e m INSERT endpoint G)` ABBREV_TAC; TYPE_THEN `G' HAS_SIZE 3` SUBGOAL_TAC; UND 0; REWRITE_TAC[HAS_SIZE;ARITH_RULE `3 = SUC 2`;FINITE_DELETE]; TYPE_THEN `G' m` SUBGOAL_TAC; EXPAND_TAC "G'"; KILL 9; ASM_REWRITE_TAC [INSERT]; ASM_MESON_TAC[CARD_SUC_DELETE]; (* nearly there! *) EXPAND_TAC "G'"; REWRITE_TAC[HAS_SIZE;FINITE_INSERT]; DISCH_ALL_TAC; UND 11; ASM_SIMP_TAC [CARD_CLAUSES]; COND_CASES_TAC; TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC; IMATCH_MP_TAC midpoint_exists; ASM_MESON_TAC[psegment]; DISCH_THEN CHOOSE_TAC; TYPE_THEN `X = { m | closure top2 e (pointI m) }` ABBREV_TAC; TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC; USE 7 (MATCH_MP two_endpoint); EXPAND_TAC "X"; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `X m /\ X m' /\ X (other_end e m) /\ (~(m=m')) /\ (~(m= other_end e m)) /\ (~(m'=other_end e m))` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[other_end_prop]; ASM_MESON_TAC [mid_end_disj]; ASM_MESON_TAC[two_exclusion]; ARITH_TAC; ]);; (* }}} *) let sing_has_size1 = prove_by_refinement( `!(x:A). {x} HAS_SIZE 1`, (* {{{ proof *) [ REWRITE_TAC[HAS_SIZE]; DISCH_ALL_TAC; CONJ_TAC; REWRITE_TAC[FINITE_SING ]; ASM_MESON_TAC[CARD_SING;SING]; ]);; (* }}} *) let num_closure1 = prove_by_refinement( `!G x. (FINITE G) ==> ((num_closure G (x) = 1) <=> (?e. (!e'. (G e' /\ (closure top2 e' (x))) <=> (e = e'))))`, (* {{{ proof *) [ DISCH_ALL_TAC; COPY 0; USE 0 (MATCH_MP (num_closure_size)); TSPEC `x` 0; TYPE_THEN `t = num_closure G x` ABBREV_TAC; EQ_TAC; DISCH_TAC; REWR 0; USE 0 (MATCH_MP CARD_SING_CONV); USE 0 (REWRITE_RULE[SING;eq_sing]); CHO 0; TYPE_THEN `x'` EXISTS_TAC; ASM_MESON_TAC[]; DISCH_TAC; CHO 3; TYPE_THEN `{C | G C /\ closure top2 C x} = {e}` SUBGOAL_TAC; REWRITE_TAC[eq_sing]; ASM_MESON_TAC[]; DISCH_TAC; REWR 0; TYPE_THEN `e` (fun t -> ASSUME_TAC (ISPEC t sing_has_size1)); UND 5; UND 0; REWRITE_TAC [HAS_SIZE]; MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION D *) (* ------------------------------------------------------------------ *) let inductive_set = jordan_def `inductive_set G S <=> S SUBSET G /\ ~(S = {}) /\ (!C C'. S C /\ G C' /\ adj C C' ==> S C')`;; let inductive_univ = prove_by_refinement( `!G. (~(G = EMPTY )) ==> (inductive_set G G)`, (* {{{ proof *) [ REWRITE_TAC[inductive_set]; DISCH_ALL_TAC; ASM_REWRITE_TAC[SUBSET_REFL]; ASM_MESON_TAC[]; ]);; (* }}} *) let inductive_inter = prove_by_refinement( `!T G. (T SUBSET G) /\ (~(T = EMPTY )) ==> (inductive_set G (INTERS {S | (T SUBSET S) /\ (inductive_set G S)}))`, (* {{{ proof *) [ DISCH_ALL_TAC; ONCE_REWRITE_TAC[inductive_set]; CONJ_TAC; IMATCH_MP_TAC INTERS_SUBSET2; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL]; IMATCH_MP_TAC inductive_univ; UND 1; REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[ISUBSET]; CONJ_TAC; USE 1 (REWRITE_RULE[EMPTY_EXISTS]); CHO 1; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; REWRITE_TAC[INTERS]; DISCH_ALL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_ALL_TAC; USE 2 (REWRITE_RULE[INTERS]); REWRITE_TAC[INTERS]; DISCH_ALL_TAC; TSPEC `u` 2; REWR 2; ASM_MESON_TAC[inductive_set]; ]);; (* }}} *) let segment_of = jordan_def `segment_of G e = INTERS { S | S e /\ inductive_set G S }`;; let inductive_segment = prove_by_refinement( `!G e. (G e) ==> (inductive_set G (segment_of G e))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[segment_of]; ASSUME_TAC inductive_inter; TYPEL_THEN [`{e}`;`G`] (USE 1 o ISPECL); USE 1 (REWRITE_RULE[single_subset;EMPTY_EXISTS;INR IN_SING ]); UND 1; DISCH_THEN IMATCH_MP_TAC ; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_of_G = prove_by_refinement( `!G e. (G e) ==> (segment_of G e ) SUBSET G`, (* {{{ proof *) [ REWRITE_TAC[segment_of]; DISCH_ALL_TAC; IMATCH_MP_TAC (INR INTERS_SUBSET2 ); TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL]; IMATCH_MP_TAC inductive_univ; REWRITE_TAC [EMPTY_EXISTS]; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_not_in = prove_by_refinement( `!G e. ~(G e) ==> (segment_of G e = UNIV)`, (* {{{ proof *) [ REWRITE_TAC[segment_of;]; DISCH_ALL_TAC; TYPE_THEN `{S | S e /\ inductive_set G S} = EMPTY ` SUBGOAL_TAC ; REWRITE_TAC[EQ_EMPTY]; GEN_TAC; REWRITE_TAC[inductive_set]; ASM_MESON_TAC[ISUBSET]; DISCH_THEN_REWRITE; ]);; (* }}} *) let segment_of_finite = prove_by_refinement( `!G e. (FINITE G) /\ (G e) ==> (FINITE (segment_of G e))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC FINITE_SUBSET; ASM_MESON_TAC[segment_of_G]; ]);; (* }}} *) let segment_of_in = prove_by_refinement( `!G e. (segment_of G e e)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `G e` ASM_CASES_TAC; REWRITE_TAC[segment_of;INTERS;inductive_set ]; MESON_TAC[]; ASM_SIMP_TAC[segment_not_in]; ]);; (* }}} *) let segment_of_subset = prove_by_refinement( `!G e f. (G e) /\ (segment_of G e f) ==> (segment_of G f) SUBSET (segment_of G e)`, (* {{{ proof *) [ REWRITE_TAC[ISUBSET;segment_of;INTERS ]; DISCH_ALL_TAC; DISCH_ALL_TAC; DISCH_ALL_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let inductive_diff = prove_by_refinement( `!G S S'. (inductive_set G S) /\ (inductive_set G S') /\ ~(S DIFF S' = {}) ==> (inductive_set G (S DIFF S'))`, (* {{{ proof *) [ REWRITE_TAC[inductive_set;DIFF;SUBSET ]; ASM_MESON_TAC[adj_symm]; ]);; (* }}} *) (* sets *) let subset_imp_eq = prove_by_refinement( `!A (B:A->bool). (A SUBSET B) /\ (B DIFF A = EMPTY) ==> (A = B)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;DIFF;EQ_EMPTY]; MESON_TAC[EQ_EXT]; ]);; (* }}} *) let segment_of_eq = prove_by_refinement( `!G e f. (G e) /\ (segment_of G e f) ==> ((segment_of G e) = (segment_of G f))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC (GSYM subset_imp_eq); CONJ_TAC; ASM_MESON_TAC[segment_of_subset]; PROOF_BY_CONTR_TAC; TYPE_THEN `G f` SUBGOAL_TAC; USE 0 (MATCH_MP segment_of_G); USE 0 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `X = (segment_of G e DIFF segment_of G f)` ABBREV_TAC; TYPE_THEN `X e` SUBGOAL_TAC; EXPAND_TAC "X"; REWRITE_TAC[DIFF]; ASM_SIMP_TAC [segment_of_in]; DISCH_ALL_TAC; USE 2 (GSYM); USE 2 (REWRITE_RULE[EMPTY_EXISTS]); CHO 2; UND 2; EXPAND_TAC "X"; REWRITE_TAC[DIFF]; JOIN 3 5; USE 2 (MATCH_MP segment_of_subset); ASM_MESON_TAC[ISUBSET]; (* done WITH X e *) DISCH_TAC; TYPE_THEN `inductive_set G (segment_of G e DIFF segment_of G f)` SUBGOAL_TAC ; IMATCH_MP_TAC inductive_diff; ASM_SIMP_TAC[inductive_segment]; DISCH_TAC; TYPE_THEN `segment_of G e SUBSET X` SUBGOAL_TAC; REWRITE_TAC[segment_of]; IMATCH_MP_TAC INTERS_SUBSET; REWRITE_TAC[]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET]; LEFT_TAC "x"; TYPE_THEN `f` EXISTS_TAC; EXPAND_TAC "X"; REWRITE_TAC[DIFF]; ASM_MESON_TAC[segment_of_in]; ]);; (* }}} *) let segment_of_segment = prove_by_refinement( `!G P e. (segment G) /\ (P SUBSET G) /\ (P e) ==> (segment (segment_of P e))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; TYPE_THEN `FINITE P` SUBGOAL_TAC; ASM_MESON_TAC[FINITE_SUBSET]; DISCH_TAC; REWRITE_TAC[segment]; ASM_SIMP_TAC[segment_of_finite;EMPTY_EXISTS]; CONJ_TAC; ASM_MESON_TAC[segment_of_in]; SUBCONJ_TAC; UND 1; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; MP_TAC segment_of_G; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; DISCH_TAC; ASSUME_TAC segment_of_G; (* ok to here *) CONJ_TAC; GEN_TAC; REWRITE_TAC[INSERT]; TYPEL_THEN [`P`;`e`] (USE 6 o ISPECL); REWR 6; JOIN 4 6; USE 4 (MATCH_MP num_closure_mono); TSPEC `pointI m` 4; UND 4; JOIN 3 1; USE 1 (MATCH_MP num_closure_mono); TSPEC `(pointI m)` 1; UND 1; UND 0; REWRITE_TAC[segment]; REWRITE_TAC[INSERT]; DISCH_ALL_TAC; TSPEC `m` 7; UND 7; UND 0; UND 1; ARITH_TAC; (* ok2 *) DISCH_ALL_TAC; CHO 8; (* IMATCH_MP_TAC subset_imp_eq; *) IMATCH_MP_TAC SUBSET_ANTISYM; ASM_REWRITE_TAC[]; (* PROOF_BY_CONTR_TAC; *) TYPE_THEN `! C C'. S C /\ P C' /\ adj C C' ==> S C'` SUBGOAL_TAC; DISCH_ALL_TAC; TYPE_THEN `segment_of P C C'` SUBGOAL_TAC; REWRITE_TAC[segment_of;INTERS;]; X_GEN_TAC `R:((num->real)->bool)->bool`; REWRITE_TAC[inductive_set]; DISCH_ALL_TAC; ASM_MESON_TAC[]; TYPE_THEN `segment_of P e = segment_of P C` SUBGOAL_TAC ; IMATCH_MP_TAC segment_of_eq; ASM_MESON_TAC[ISUBSET]; DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `inductive_set P S` SUBGOAL_TAC; REWRITE_TAC[inductive_set]; ASM_REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[ISUBSET;segment_of_G]; TYPE_THEN `segment_of P e = segment_of P u` SUBGOAL_TAC; IMATCH_MP_TAC segment_of_eq; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[segment_of]; DISCH_TAC; IMATCH_MP_TAC (INR INTERS_SUBSET); ASM_REWRITE_TAC[]; ]);; (* }}} *) (* move up *) let rectagon_subset = prove_by_refinement( `!G S. (rectagon G) /\ (segment S) /\ (G SUBSET S) ==> (G = S)`, (* {{{ proof *) [ REWRITE_TAC[rectagon;segment]; DISCH_ALL_TAC; TSPEC `G` 9; UND 9 ; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC; ASM_MESON_TAC[edge_inter]; DISCH_TAC; CHO 14; (*loss*) COPY 10; COPY 5; JOIN 5 10; USE 5 (MATCH_MP num_closure_mono); TSPEC `pointI m` 5; TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC; TSPEC `m` 3; USE 3 (REWRITE_RULE[INSERT]); UND 3; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; UND 3; USE 0 (MATCH_MP num_closure_size); TSPEC `(pointI m)` 0; DISCH_ALL_TAC; REWR 0; USE 0 (REWRITE_RULE[HAS_SIZE_0]); UND 0; REWRITE_TAC[EMPTY_EXISTS ]; UND 14; REWRITE_TAC[INTER;eq_sing; ]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `num_closure S (pointI m) = 2` SUBGOAL_TAC; TSPEC `m` 8; USE 8(REWRITE_RULE[INSERT]); UND 8; TSPEC `m` 3; USE 3 (REWRITE_RULE[INSERT]); UND 3; UND 5; UND 10; ARITH_TAC; DISCH_TAC; (* ok *) (* num_closure G = num_closure S, C' in latter, so in former *) TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} = {C | S C /\ closure top2 C (pointI m)}` SUBGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET_LE; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `S` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET]; MESON_TAC[]; CONJ_TAC; UND 15; REWRITE_TAC[SUBSET]; MESON_TAC[]; USE 0 (MATCH_MP num_closure_size); TSPEC `pointI m` 0; USE 16 (MATCH_MP num_closure_size); TSPEC `pointI m` 16; UND 16; UND 0; ASM_REWRITE_TAC [HAS_SIZE]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; DISCH_TAC; TAPP `C'` 18; UND 18; ASM_REWRITE_TAC[]; UND 14; REWRITE_TAC[INTER;eq_sing]; MESON_TAC[]; ]);; (* }}} *) let rectagon_h_edge = prove_by_refinement( `!G. (rectagon G) ==> (?m. (G (h_edge m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `!e. G e ==> (?m. (e= (v_edge m))) ` SUBGOAL_TAC; DISCH_ALL_TAC; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[rectagon;ISUBSET]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_THEN DISJ_CASES_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `X = {m | (G (v_edge m)) }` ABBREV_TAC; TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC; CONJ_TAC; TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (v_edge) C)` SUBGOAL_TAC ; IMATCH_MP_TAC finite_subset; REWRITE_TAC[IMAGE;SUBSET]; EXPAND_TAC "X"; REWRITE_TAC[]; NAME_CONFLICT_TAC; CONJ_TAC; DISCH_ALL_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[rectagon]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; TYPE_THEN `C = X` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_ALL_TAC; UND 7; EXPAND_TAC "X"; REWRITE_TAC[]; UND 6; REWRITE_TAC[IMAGE]; DISCH_THEN_REWRITE ; DISCH_THEN CHOOSE_TAC; USE 6 (REWRITE_RULE[v_edge_inj;h_edge_inj]); ASM_MESON_TAC[]; ASM_MESON_TAC[]; USE 0 (REWRITE_RULE[rectagon]); UND 0; DISCH_ALL_TAC; USE 5(REWRITE_RULE[EMPTY_EXISTS]); CHO 5; TSPEC `u` 2; REWR 2; CHO 2; UND 0; EXPAND_TAC "X"; REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[]; DISCH_TAC; (* dwf done finite X ... Messed up. X must have type real->bool. *) TYPE_THEN `Y = IMAGE (real_of_int o SND ) X` ABBREV_TAC; TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC; CONJ_TAC; EXPAND_TAC "Y"; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE;EMPTY_EXISTS ]; CONV_TAC (dropq_conv "u"); AND 4; USE 4 (REWRITE_RULE[EMPTY_EXISTS]); CHO 4; ASM_MESON_TAC[]; DISCH_TAC; USE 6 (MATCH_MP min_finite); CHO 6; TYPE_THEN `?m. (G (v_edge m)) /\ (real_of_int (SND m) = delta)` SUBGOAL_TAC; USE 5 (REWRITE_RULE[IMAGE;o_DEF]); TAPP `delta` 5; REWR 5; CHO 5; TAPP `x` 3; REWR 3; ASM_MESON_TAC[]; DISCH_TAC; CHO 7; (* now show that m is an endpoint *) TYPE_THEN `endpoint G m` SUBGOAL_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC; ASM_SIMP_TAC[num_closure1]; TYPE_THEN `v_edge m` EXISTS_TAC; DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `edge e'` SUBGOAL_TAC; ASM_MESON_TAC[rectagon;ISUBSET]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[v_edge_inj]; REWR 10; USE 10 (REWRITE_RULE[v_edge_closure;vc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; v_edge_pointI]); UND 10; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN ` Y (real_of_int (SND m'))` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE]; TYPE_THEN `m'` EXISTS_TAC; REWRITE_TAC[o_DEF]; EXPAND_TAC "X"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; AND 6; TSPEC `(real_of_int(SND m'))` 6; REWR 6; USE 7 GSYM; REWR 6; USE 6 (REWRITE_RULE[int_suc ]); ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`]; ASM_MESON_TAC[hv_edgeV2]; DISCH_TAC; EXPAND_TAC "e'"; ASM_REWRITE_TAC[]; EXPAND_TAC "e'"; REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING ;]; ASM_MESON_TAC[rectagon_endpoint]; ]);; (* }}} *) let rectagon_v_edge = prove_by_refinement( `!G. (rectagon G) ==> (?m. (G (v_edge m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `!e. G e ==> (?m. (e= (h_edge m))) ` SUBGOAL_TAC; DISCH_ALL_TAC; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[rectagon;ISUBSET]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_THEN DISJ_CASES_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `X = {m | (G (h_edge m)) }` ABBREV_TAC; TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC; CONJ_TAC; TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (h_edge) C)` SUBGOAL_TAC ; IMATCH_MP_TAC finite_subset; REWRITE_TAC[IMAGE;SUBSET]; EXPAND_TAC "X"; REWRITE_TAC[]; NAME_CONFLICT_TAC; CONJ_TAC; DISCH_ALL_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[rectagon]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; TYPE_THEN `C = X` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_ALL_TAC; UND 7; EXPAND_TAC "X"; REWRITE_TAC[]; UND 6; REWRITE_TAC[IMAGE]; DISCH_THEN_REWRITE ; DISCH_THEN CHOOSE_TAC; USE 6 (REWRITE_RULE[h_edge_inj;v_edge_inj]); ASM_MESON_TAC[]; ASM_MESON_TAC[]; USE 0 (REWRITE_RULE[rectagon]); UND 0; DISCH_ALL_TAC; USE 5(REWRITE_RULE[EMPTY_EXISTS]); CHO 5; TSPEC `u` 2; REWR 2; CHO 2; UND 0; EXPAND_TAC "X"; REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[]; DISCH_TAC; (* dwfx done finite X ... Messed up. X must have type real->bool. *) TYPE_THEN `Y = IMAGE (real_of_int o FST ) X` ABBREV_TAC; TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC; CONJ_TAC; EXPAND_TAC "Y"; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE;EMPTY_EXISTS ]; CONV_TAC (dropq_conv "u"); AND 4; USE 4 (REWRITE_RULE[EMPTY_EXISTS]); CHO 4; ASM_MESON_TAC[]; DISCH_TAC; USE 6 (MATCH_MP min_finite); CHO 6; TYPE_THEN `?m. (G (h_edge m)) /\ (real_of_int (FST m) = delta)` SUBGOAL_TAC; USE 5 (REWRITE_RULE[IMAGE;o_DEF]); TAPP `delta` 5; REWR 5; CHO 5; TAPP `x` 3; REWR 3; ASM_MESON_TAC[]; DISCH_TAC; CHO 7; (* now show that m is an endpoint *) TYPE_THEN `endpoint G m` SUBGOAL_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC; ASM_SIMP_TAC[num_closure1]; TYPE_THEN `h_edge m` EXISTS_TAC; DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `edge e'` SUBGOAL_TAC; ASM_MESON_TAC[rectagon;ISUBSET]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN MP_TAC); IMATCH_MP_TAC (TAUT `((A \/ B) ==> C) ==> ((B \/ A) ==> C)`); DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[h_edge_inj]; REWR 10; USE 10 (REWRITE_RULE[h_edge_closure;hc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; h_edge_pointI]); UND 10; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN ` Y (real_of_int (FST m'))` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE]; TYPE_THEN `m'` EXISTS_TAC; REWRITE_TAC[o_DEF]; EXPAND_TAC "X"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; AND 6; TSPEC `(real_of_int(FST m'))` 6; REWR 6; USE 7 GSYM; REWR 6; USE 6 (REWRITE_RULE[int_suc ]); ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`]; ASM_MESON_TAC[hv_edgeV2]; DISCH_TAC; EXPAND_TAC "e'"; ASM_REWRITE_TAC[]; EXPAND_TAC "e'"; REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING ;]; ASM_MESON_TAC[rectagon_endpoint]; ]);; (* }}} *) (* move down *) let part_below = jordan_def `part_below G m = {C | G C /\ ((?n. (C = v_edge n) /\ (SND n <=: SND m) /\ (FST n = FST m)) \/ (?n. (C = h_edge n) /\ (SND n <=: SND m) /\ (closure top2 C (pointI (FST m,SND n))))) }`;; let part_below_h = prove_by_refinement( `!G m n. part_below G m (h_edge n) <=> (set_lower G m n) \/ (set_lower G (left m) n)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[part_below;set_lower;left ]; REWRITE_TAC[h_edge_closure;hc_edge;UNION ;h_edge_pointI]; REWRITE_TAC[hv_edgeV2;plus_e12;INR IN_SING ;pointI_inj ;PAIR_SPLIT ]; REWRITE_TAC[h_edge_inj]; CONV_TAC (dropq_conv "n'"); REWRITE_TAC[INT_ARITH `(x = y+: &:1) <=> (x -: (&:1) = y)`]; ASM_MESON_TAC[]; ]);; (* }}} *) let part_below_v = prove_by_refinement( `!G m n. part_below G m (v_edge n) <=> (G (v_edge n)) /\ (FST n = FST m) /\ (SND n <=: SND m)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[part_below;v_edge_closure;vc_edge;UNION;plus_e12; INR IN_SING; pointI_inj ; PAIR_SPLIT; v_edge_inj; hv_edgeV2]; ASM_MESON_TAC[]; ]);; (* }}} *) (* sets *) let has_size_bij = prove_by_refinement( `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f {m | m < n} A)`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_TAC; USE 0 (MATCH_MP (INR HAS_SIZE_INDEX)); CHO 0; REWRITE_TAC[BIJ;INJ ;SURJ ;]; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; USE 0 (REWRITE_RULE[EXISTS_UNIQUE_ALT]); ASM_MESON_TAC[]; DISCH_THEN CHOOSE_TAC; REWRITE_TAC[HAS_SIZE]; ASSUME_TAC CARD_NUMSEG_LT; TSPEC `n` 1; EXPAND_TAC "n"; SUBCONJ_TAC; ASSUME_TAC FINITE_NUMSEG_LT; TSPEC `n` 2; JOIN 2 0; USE 0 (MATCH_MP FINITE_BIJ); ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC (GSYM BIJ_CARD); TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[FINITE_NUMSEG_LT]; ]);; (* }}} *) let has_size_bij2 = prove_by_refinement( `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f A {m | m < n})`, (* {{{ proof *) [ REWRITE_TAC[has_size_bij]; DISCH_ALL_TAC; EQ_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `INV f {m | m <| n} A` EXISTS_TAC; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; TYPE_THEN `INV f A {m | m <| n}` EXISTS_TAC; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let fibre_card = prove_by_refinement( `!(f:A->B) A B m n. (B HAS_SIZE n) /\ (IMAGE f A SUBSET B) /\ (!b. (B b) ==> ({u | (A u) /\ (f u = b)} HAS_SIZE m)) ==> (A HAS_SIZE m*n)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `!b. ?g. (B b) ==> (BIJ g {u | (A u) /\ (f u = b)} {j | j <| m})` SUBGOAL_TAC; DISCH_ALL_TAC; RIGHT_TAC "g"; DISCH_TAC; REWRITE_TAC[GSYM has_size_bij2]; TSPEC `b` 2; REWR 2; DISCH_TAC; LEFT 3 "g"; CHO 3; (* case m=0 *) DISJ_CASES_TAC (ARITH_RULE `(m=0) \/ 0 < m`); ASM_REWRITE_TAC[]; REDUCE_TAC; REWRITE_TAC[HAS_SIZE_0]; REWR 2; USE 2 (REWRITE_RULE[HAS_SIZE_0]); USE 1 (REWRITE_RULE[IMAGE;ISUBSET ]); PROOF_BY_CONTR_TAC; USE 5 (REWRITE_RULE[EMPTY_EXISTS]); CHO 5; USE 1 (CONV_RULE NAME_CONFLICT_CONV); USE 1 (CONV_RULE (dropq_conv "x''")); TSPEC `u` 1; REWR 1; TSPEC `f u` 2; REWR 2; USE 2 (REWRITE_RULE[EQ_EMPTY]); ASM_MESON_TAC[]; TYPE_THEN `BIJ (\x. (f x, g (f x) x)) A {(x,y) | B x /\ {j|j <|m} y}` SUBGOAL_TAC; REWRITE_TAC[BIJ;INJ;SURJ]; SUBCONJ_TAC; SUBCONJ_TAC; DISCH_ALL_TAC; TYPE_THEN `f x` EXISTS_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "y"); SUBCONJ_TAC; UND 1; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[]; DISCH_TAC; TSPEC `f x` 3; REWR 3; UND 3; REWRITE_TAC[BIJ;SURJ]; DISCH_ALL_TAC; ASM_MESON_TAC[]; DISCH_TAC; DISCH_ALL_TAC; USE 8(REWRITE_RULE[PAIR_SPLIT]); AND 8; REWR 8; (* r8 *) TYPE_THEN `B (f y)` SUBGOAL_TAC; UND 1; REWRITE_TAC [IMAGE;SUBSET]; ASM_MESON_TAC[]; DISCH_TAC; TSPEC `f y` 3; REWR 3; USE 3 (REWRITE_RULE[BIJ;INJ]); ASM_MESON_TAC[]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; GEN_TAC; NAME_CONFLICT_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "x'"); NAME_CONFLICT_TAC; GEN_TAC; LEFT_TAC "x''"; GEN_TAC; RIGHT_TAC "y''"; DISCH_THEN_REWRITE ; RIGHT_TAC "y''"; DISCH_ALL_TAC; USE 9 GSYM; REWR 8; ASM_REWRITE_TAC[]; KILL 9; TSPEC `FST x` 2; REWR 2; TSPEC `FST x` 3; REWR 3; USE 3 (REWRITE_RULE[BIJ;SURJ]); ASM_MESON_TAC[]; REWRITE_TAC[HAS_SIZE]; DISCH_TAC; (* r9 *) TYPE_THEN `FINITE B /\ FINITE {j | j <| m}` SUBGOAL_TAC; ASM_REWRITE_TAC[FINITE_NUMSEG_LT]; ASM_MESON_TAC[HAS_SIZE]; DISCH_TAC; COPY 6; USE 6 (MATCH_MP (INR FINITE_PRODUCT)); REWR 6; COPY 7; USE 7 (MATCH_MP (INR CARD_PRODUCT)); SUBCONJ_TAC; JOIN 6 5; USE 5 (MATCH_MP FINITE_BIJ2); ASM_REWRITE_TAC[]; DISCH_TAC; JOIN 9 5; USE 5 (MATCH_MP BIJ_CARD); REWR 7; ASM_REWRITE_TAC[CARD_NUMSEG_LT]; USE 0 (REWRITE_RULE[HAS_SIZE]); ASM_REWRITE_TAC[]; ARITH_TAC; ]);; (* }}} *) (* sets *) let even_card_even = prove_by_refinement( `!X (Y:A->bool). (FINITE X) /\ (FINITE Y) /\ (X INTER Y = EMPTY) ==> ((EVEN (CARD X) <=> EVEN (CARD Y)) <=> (EVEN (CARD (X UNION Y))))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC [CARD_UNION]; REWRITE_TAC[EVEN_ADD]; ]);; (* }}} *) (* terminal edge: (endpoint G m) /\ (closure top2 e (pointI m)) produce bij-MAP from terminal edges to endpoints (of P SUBSET G) 2-1 MAP from terminal edges to segments. Hence an EVEN number of endpoints. *) let terminal_edge = jordan_def `terminal_edge G m = @e. (G e) /\ (closure top2 e (pointI m))`;; let terminal_endpoint = prove_by_refinement( `!G m. (FINITE G) /\ (endpoint G m) ==> ((G (terminal_edge G m)) /\ (closure top2 (terminal_edge G m) (pointI m)) ) `, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[terminal_edge]; SELECT_TAC; MESON_TAC[]; ASM_MESON_TAC[endpoint_edge;EXISTS_UNIQUE_ALT]; ]);; (* }}} *) let terminal_unique = prove_by_refinement( `!G m e. (FINITE G) /\ (endpoint G m) ==> ( (G e) /\ (closure top2 e (pointI m)) <=> (e = terminal_edge G m))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; REWRITE_TAC[terminal_edge]; SELECT_TAC; USE 1(REWRITE_RULE[endpoint]); ASM_MESON_TAC[num_closure1]; ASM_MESON_TAC[terminal_endpoint]; ASM_MESON_TAC[terminal_endpoint]; ]);; (* }}} *) let segment_of_endpoint = prove_by_refinement( `!P e m. (P e) /\ (FINITE P) ==> (endpoint P m /\ (segment_of P (terminal_edge P m) = segment_of P e) <=> endpoint (segment_of P e) m)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE (segment_of P e)` SUBGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; ASM_MESON_TAC[segment_of_G]; DISCH_TAC; EQ_TAC; DISCH_ALL_TAC; COPY 3; UND 5; REWRITE_TAC[endpoint]; ASM_SIMP_TAC[num_closure1]; DISCH_ALL_TAC; CHO 5; TYPE_THEN `e'` EXISTS_TAC; DISCH_ALL_TAC; EQ_TAC; USE 0 (MATCH_MP segment_of_G); ASM_MESON_TAC[ISUBSET]; DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); COPY 5; TSPEC `e'` 5; USE 5 (REWRITE_RULE[]); ASM_REWRITE_TAC[]; UND 4; DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); TSPEC `terminal_edge P m` 6; UND 4; ASM_SIMP_TAC[terminal_endpoint]; REWRITE_TAC[segment_of_in]; DISCH_TAC; (* se *) SUBCONJ_TAC; UND 3; REWRITE_TAC[endpoint]; ASM_SIMP_TAC[num_closure1]; DISCH_ALL_TAC; CHO 3; TYPE_THEN `e'` EXISTS_TAC; DISCH_ALL_TAC; EQ_TAC; TYPE_THEN `P e'' /\ closure top2 e'' (pointI m) ==> segment_of P e e''` SUBGOAL_TAC; DISCH_ALL_TAC; COPY 3; TSPEC `e'` 3; USE 3 (REWRITE_RULE []); TYPE_THEN `e'' = e'` ASM_CASES_TAC; ASM_MESON_TAC[]; USE 0 (MATCH_MP inductive_segment); USE 0 (REWRITE_RULE[inductive_set]); UND 0; DISCH_ALL_TAC; TYPEL_THEN [`e'`;`e''`] (USE 9 o ISPECL); UND 9; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[adj;EMPTY_EXISTS;]; TYPE_THEN `pointI m` EXISTS_TAC; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); ASM_MESON_TAC[segment_of_G;ISUBSET ]; (* I'm getting lost in the thickets *) (* se2 *) DISCH_TAC; IMATCH_MP_TAC (GSYM segment_of_eq); ASM_REWRITE_TAC[]; COPY 4; COPY 3; UND 3; UND 4; REWRITE_TAC[endpoint]; ASM_SIMP_TAC[num_closure1]; DISCH_THEN CHOOSE_TAC; DISCH_THEN CHOOSE_TAC; (* *) COPY 3; TSPEC `e''` 3; TYPE_THEN `e' = e''` SUBGOAL_TAC; TSPEC `e''` 4; USE 4 (REWRITE_RULE[]); ASM_MESON_TAC[segment_of_G;ISUBSET ]; DISCH_TAC; TSPEC `terminal_edge P m` 7; TYPE_THEN `e' = terminal_edge P m` SUBGOAL_TAC; ASM_MESON_TAC[terminal_endpoint]; ASM_MESON_TAC[]; ]);; (* }}} *) let fibre2 = prove_by_refinement( `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==> (!S. ({ S | (?e. (P e) /\ (S = segment_of P e)) } S) ==> ({m | (endpoint P m) /\ (segment_of P (terminal_edge P m) = S)} HAS_SIZE 2))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[]; DISCH_ALL_TAC; CHO 3; ASM_REWRITE_TAC[]; USE 3 (CONJUNCT1 ); TYPE_THEN `psegment (segment_of P e)` SUBGOAL_TAC; REWRITE_TAC[psegment]; CONJ_TAC; ASM_MESON_TAC[rectagon_subset;segment_of_G;segment_of_segment]; PROOF_BY_CONTR_TAC; TYPE_THEN `segment_of P e = G` SUBGOAL_TAC; IMATCH_MP_TAC rectagon_subset; REWR 4; ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET_TRANS;segment_of_G]; USE 3 (MATCH_MP segment_of_G); DISCH_TAC; REWR 3; JOIN 1 3; USE 1 (MATCH_MP SUBSET_ANTISYM); REWR 4; ASM_MESON_TAC[]; DISCH_TAC; USE 4 (MATCH_MP endpoint_size2); TYPE_THEN `{m | endpoint P m /\ (segment_of P (terminal_edge P m) = segment_of P e)} = endpoint (segment_of P e)` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC ; REWRITE_TAC[]; (* f2 *) IMATCH_MP_TAC segment_of_endpoint; ASM_REWRITE_TAC[]; IMATCH_MP_TAC FINITE_SUBSET; ASM_MESON_TAC[segment]; DISCH_THEN_REWRITE; ASM_MESON_TAC[]; ]);; (* }}} *) let endpoint_even = prove_by_refinement( `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==> (endpoint P HAS_SIZE 2 *| (CARD {S | (?e. (P e) /\ (S = segment_of P e))}) )`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `f = (segment_of P) o (terminal_edge P)` ABBREV_TAC; TYPE_THEN `B = { S | (?e. (P e) /\ (S = segment_of P e)) }` ABBREV_TAC; TYPE_THEN `f` (fun t-> IMATCH_MP_TAC (ISPEC t fibre_card)); TYPE_THEN `B` EXISTS_TAC; ASM_REWRITE_TAC[HAS_SIZE;IMAGE;SUBSET ; ]; EXPAND_TAC "B"; EXPAND_TAC "f"; REWRITE_TAC[o_DEF ]; SUBCONJ_TAC; TYPE_THEN `{S | ?e. P e /\ (S = segment_of P e)} = IMAGE (\x. (segment_of P x)) P` SUBGOAL_TAC; REWRITE_TAC[IMAGE]; DISCH_THEN_REWRITE; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC FINITE_SUBSET ; ASM_MESON_TAC[segment]; DISCH_TAC; CONJ_TAC; NAME_CONFLICT_TAC; GEN_TAC; DISCH_THEN CHOOSE_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `terminal_edge P x'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `FINITE P` SUBGOAL_TAC; ASM_MESON_TAC[segment;FINITE_SUBSET]; ASM_MESON_TAC[terminal_endpoint]; (* ee *) REWRITE_TAC[GSYM HAS_SIZE]; ASSUME_TAC fibre2; USE 6 (REWRITE_RULE[]); UND 6; DISCH_THEN IMATCH_MP_TAC ; ASM_MESON_TAC[]; ]);; (* }}} *) let num_closure0 = prove_by_refinement( `! G x. FINITE G ==> ((num_closure G x = 0) <=> (!e. (G e) ==> (~(closure top2 e x))))`, (* {{{ proof *) [ DISCH_ALL_TAC; USE 0 (MATCH_MP num_closure_size); TSPEC `x` 0; EQ_TAC; DISCH_TAC; REWR 0; USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY ]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `{C | G C /\ closure top2 C x} = {}` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 2 (REWRITE_RULE[EMPTY_EXISTS]); CHO 2; ASM_MESON_TAC[]; DISCH_TAC; REWR 0; USE 0 (REWRITE_RULE[HAS_SIZE]); ASM_MESON_TAC[CARD_CLAUSES]; ]);; (* }}} *) let num_closure2 = prove_by_refinement( `!G x. FINITE G ==> ((num_closure G x = 2) <=> (?a b. (~(a = b)) /\ ((!e. (G e /\ closure top2 e x) <=> (( e= a)\/ (e =b))))))`, (* {{{ proof *) [ DISCH_ALL_TAC; USE 0 (MATCH_MP num_closure_size); TSPEC `x` 0; EQ_TAC; DISCH_TAC; REWR 0; USE 0 (REWRITE_RULE[has_size2 ; ]); CHO 0; CHO 0; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; AND 0; TAPP `e` 2; USE 2(REWRITE_RULE[INSERT]); ASM_MESON_TAC[]; DISCH_TAC; CHO 1; CHO 1; TYPE_THEN `X = {C | G C /\ closure top2 C x} ` ABBREV_TAC; TYPE_THEN `(?a b. (X = {a, b}) /\ ~(a = b))` SUBGOAL_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INSERT]; EXPAND_TAC "X"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; USE 3 (REWRITE_RULE[GSYM has_size2]); RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); ASM_MESON_TAC[]; ]);; (* }}} *) let endpoint_subrectagon = prove_by_refinement( `!G P m. (rectagon G) /\ (P SUBSET G) ==> ((endpoint P m) <=> (?C C'. (P C) /\ (G C') /\ (~(P C')) /\ (~(C = C')) /\ (closure top2 C (pointI m)) /\ (closure top2 C' (pointI m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC; TYPE_THEN `FINITE P` SUBGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; ASM_MESON_TAC[]; DISCH_TAC; EQ_TAC; DISCH_TAC; TYPE_THEN `midpoint G m` SUBGOAL_TAC; REWRITE_TAC[midpoint]; USE 0 (REWRITE_RULE[rectagon;INSERT]); UND 0; DISCH_ALL_TAC; TSPEC `m` 7; UND 7; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; USE 4 (REWRITE_RULE[endpoint]); JOIN 0 1; USE 0 (MATCH_MP num_closure_mono); ASM_MESON_TAC[ARITH_RULE `~(1 <=| 0)`]; REWRITE_TAC[midpoint]; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_THEN (MP_TAC o (MATCH_MP num_closure_size)); DISCH_ALL_TAC; TSPEC `pointI m` 6; REWR 6; USE 4 (REWRITE_RULE[endpoint]); UND 4; ASM_SIMP_TAC[num_closure1]; DISCH_THEN CHOOSE_TAC; TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC; COPY 6; UND 8; REWRITE_TAC[has_size2]; DISCH_THEN CHOOSE_TAC; CHO 8; TYPE_THEN `X a /\ X b /\ X e` SUBGOAL_TAC; CONJ_TAC; ASM_REWRITE_TAC[INSERT ]; CONJ_TAC; ASM_REWRITE_TAC[INSERT]; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; TSPEC `e` 4; USE 4(REWRITE_RULE[]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `P e /\ (closure top2 e (pointI m))` SUBGOAL_TAC; TSPEC `e` 4; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `G a /\ closure top2 a (pointI m) /\ G b /\ closure top2 b (pointI m)` SUBGOAL_TAC; UND 9; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; MESON_TAC[]; DISCH_ALL_TAC; TYPE_THEN `(e =a) \/ (e = b)` SUBGOAL_TAC; ASM_MESON_TAC[two_exclusion]; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_MESON_TAC[]; TYPE_THEN `a` EXISTS_TAC; ASM_MESON_TAC[]; DISCH_ALL_TAC; CHO 4; CHO 4; UND 4; DISCH_ALL_TAC; REWRITE_TAC[endpoint]; UND 0; REWRITE_TAC[rectagon;INSERT ]; DISCH_ALL_TAC; TSPEC `m` 12; UND 12; (* rg *) DISCH_THEN DISJ_CASES_TAC; USE 3 (MATCH_MP num_closure1); ASM_REWRITE_TAC[]; USE 0 (MATCH_MP num_closure2); REWR 12; CHO 12; CHO 12; AND 12; TYPE_THEN `(C = a) \/ (C = b)` SUBGOAL_TAC; UND 12; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC; UND 12; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `C` EXISTS_TAC; DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; TSPEC `e'` 12; REWR 12; TYPE_THEN `G e'` SUBGOAL_TAC; UND 17; UND 1; MESON_TAC[ISUBSET]; DISCH_TAC; KILL 0; KILL 3; KILL 18; KILL 13; ASM_MESON_TAC[]; KILL 0; KILL 3; KILL 13; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASM_REWRITE_TAC[]; (* rg2 *) USE 0(MATCH_MP num_closure0); REWR 12; ASM_MESON_TAC[]; ]);; (* }}} *) let part_below_finite = prove_by_refinement( `!G m. (FINITE G) ==> FINITE(part_below G m)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[part_below;ISUBSET ]; MESON_TAC[]; ]);; (* }}} *) let part_below_subset = prove_by_refinement( `!G m. (part_below G m) SUBSET G`, (* {{{ proof *) [ REWRITE_TAC[part_below;ISUBSET]; MESON_TAC[]; ]);; (* }}} *) let v_edge_cpoint = prove_by_refinement( `!m n. (closure top2 (v_edge m) (pointI n) <=> ((n = m) \/ (n = (FST m,SND m +: (&:1)))))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[v_edge_closure;vc_edge;UNION]; REWRITE_TAC[v_edge_pointI;INR IN_SING ;plus_e12;pointI_inj]; ]);; (* }}} *) let h_edge_cpoint = prove_by_refinement( `!m n. (closure top2 (h_edge m) (pointI n) <=> ((n = m) \/ (n = (FST m +: (&:1),SND m ))))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[h_edge_closure;hc_edge;UNION]; REWRITE_TAC[h_edge_pointI;INR IN_SING ;plus_e12;pointI_inj]; ]);; (* }}} *) let endpoint_lemma = prove_by_refinement( `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> (? C C' m'. ((C = v_edge m') \/ (C = h_edge m')) /\ (edge C') /\ (!e. G e /\ closure top2 e (pointI x) <=> (e = C) \/ (e = C')) /\ (~(G = {})) /\ (G SUBSET edge) /\ (part_below G m C) /\ (G C') /\ (~part_below G m C') /\ (~(C = C')) /\ (closure top2 C (pointI x)) /\ (closure top2 C' (pointI x)) /\ (part_below G m SUBSET G) /\ (endpoint (part_below G m) x)) `, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC; ASM_MESON_TAC[part_below_subset]; DISCH_TAC ; COPY 2; COPY 1; UND 1; UND 3; UND 0; SIMP_TAC[endpoint_subrectagon]; DISCH_TAC; DISCH_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; USE 0 (REWRITE_RULE[rectagon;INSERT ]); UND 0; DISCH_ALL_TAC; TSPEC `x` 12; UND 12; DISCH_THEN DISJ_CASES_TAC; USE 0 (MATCH_MP num_closure2); REWR 12; CHO 12; CHO 12; KILL 0; AND 12; TYPE_THEN `(C = a) \/ (C = b)` SUBGOAL_TAC; TSPEC `C` 0; UND 0; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASM_MESON_TAC[ISUBSET]; TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; DISCH_TAC; TYPE_THEN `!e. G e /\ closure top2 e (pointI x) <=> ((e = C) \/ (e = C'))` SUBGOAL_TAC; DISCH_ALL_TAC; TSPEC `e` 0; ASM_REWRITE_TAC[]; UND 15; UND 14; UND 12; UND 7; MESON_TAC[]; DISCH_TAC; KILL 15; KILL 14; KILL 0; KILL 12; KILL 13; TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;]; DISCH_ALL_TAC; USE 0 (REWRITE_RULE[edge]); UND 0; DISCH_THEN CHOOSE_TAC; TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `m'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* snd case *) USE 0 (MATCH_MP num_closure0); REWR 12; PROOF_BY_CONTR_TAC; UND 12; UND 5; UND 9; MESON_TAC[]; ]);; (* }}} *) let endpoint_lemma_small_fst = prove_by_refinement( `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> (FST m <=: FST x +: &:1) `, (* {{{ proof *) [ REP_GEN_TAC; DISCH_TAC; COPY 0; USE 0 (MATCH_MP endpoint_lemma); CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`]; DISCH_ALL_TAC; (* setup complete *) UND 0; DISCH_THEN DISJ_CASES_TAC; REWR 6; USE 6 (REWRITE_RULE[part_below_v]); REWR 10; USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `FST x = FST m'` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 14; AND 6; AND 6; REWR 14; UND 14; INT_ARITH_TAC; (* 2nd case *) REWR 6; USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); REWR 10; USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC; ASM_MESON_TAC[]; UND 14; INT_ARITH_TAC; ]);; (* }}} *) (* identical proof to endpoint_lemma_small_fst *) let endpoint_lemma_big_fst = prove_by_refinement( `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> (FST x <=: FST m +: &:1) `, (* {{{ proof *) [ REP_GEN_TAC; DISCH_TAC; COPY 0; USE 0 (MATCH_MP endpoint_lemma); CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`]; DISCH_ALL_TAC; (* setup complete *) UND 0; DISCH_THEN DISJ_CASES_TAC; REWR 6; USE 6 (REWRITE_RULE[part_below_v]); REWR 10; USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `FST x = FST m'` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 14; AND 6; AND 6; REWR 14; UND 14; INT_ARITH_TAC; (* 2nd case *) REWR 6; USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); REWR 10; USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC; ASM_MESON_TAC[]; UND 14; INT_ARITH_TAC; ]);; (* }}} *) let endpoint_lemma_big_snd = prove_by_refinement( `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> (SND x <=: SND m +: &:1) `, (* {{{ proof *) [ REP_GEN_TAC; DISCH_TAC; COPY 0; USE 0 (MATCH_MP endpoint_lemma); CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`]; DISCH_ALL_TAC; (* setup complete *) UND 0; DISCH_THEN DISJ_CASES_TAC; REWR 6; USE 6 (REWRITE_RULE[part_below_v]); REWR 10; USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC; ASM_MESON_TAC[]; UND 14; AND 6; AND 6; UND 6; INT_ARITH_TAC; (* 2nd case *) REWR 6; USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); REWR 10; USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `SND x = SND m'` SUBGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `(SND m' <=: SND m)` SUBGOAL_TAC; ASM_MESON_TAC[]; UND 14; INT_ARITH_TAC; ]);; (* }}} *) let endpoint_lemma_mid_fst = prove_by_refinement( `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> (FST x = FST m) ==> (SND x = SND m +: &:1) `, (* {{{ proof *) [ REP_GEN_TAC; DISCH_TAC; COPY 0; USE 0 (MATCH_MP endpoint_lemma); CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; (* setup complete *) UND 2; DISCH_THEN DISJ_CASES_TAC; REWR 7; USE 7 (REWRITE_RULE[part_below_v]); REWR 11; USE 11 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC; ASM_MESON_TAC[]; AND 7; AND 7; UND 7; USE 3 (REWRITE_RULE[edge]); CHO 3; UND 3; DISCH_THEN DISJ_CASES_TAC; REWR 9; USE 7 (REWRITE_RULE[part_below_v]); REWR 8; REWR 7; REWR 12; USE 9 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(FST m'' = FST m) /\ (FST x = FST m'')` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 9; REWR 7; UND 7; UND 9; INT_ARITH_TAC; (* 2nd case *) REWR 12; USE 7 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); REWR 8; REWR 9; USE 9 (REWRITE_RULE[left ;set_lower;part_below_h]); REWR 9; TYPE_THEN `(FST x = FST m') ` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 7; DISCH_ALL_TAC; REWR 7; KILL 12; REWR 7; KILL 11; (* try *) UND 7; UND 17; UND 18; UND 9; INT_ARITH_TAC; (* 3rd case *) (* 3c *) REWR 11; USE 11(REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); USE 3(REWRITE_RULE[edge]); CHO 3; UND 3; DISCH_THEN DISJ_CASES_TAC; REWR 9; USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]); REWR 8; REWR 9; UND 9; UND 11; UND 0; REWR 12; USE 0(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); UND 0; USE 1 (MATCH_MP endpoint_lemma_big_snd ); UND 0; INT_ARITH_TAC; (* LAST case ,3d *) TYPE_THEN `G (h_edge m')` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; REWR 12; USE 12 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `SND x = SND m''` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 12; REWR 7; USE 7(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]); REWR 7; TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; UND 7; COPY 17; UND 7; DISCH_THEN_REWRITE; DISCH_TAC; REWR 9; USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]); REWR 8; REWR 9; TYPE_THEN `SND x = SND m'` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; UND 11; COPY 18; UND 11; DISCH_THEN_REWRITE; DISCH_TAC; TYPE_THEN `(FST m'' = FST m) \/ (FST m'' = FST m -: &:1)` SUBGOAL_TAC; UND 11; UND 7; UND 12; INT_ARITH_TAC; DISCH_TAC; TYPE_THEN `~(SND m'' <=: SND m)` SUBGOAL_TAC; UND 19; UND 9; INT_ARITH_TAC; UND 16; UND 18; UND 17; INT_ARITH_TAC; ]);; (* }}} *) let endpoint_lemma_upper_left = prove_by_refinement( `!G m . (rectagon G) ==> ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`, (* {{{ proof *) [ (* needs to be rewritten, template only *) REP_GEN_TAC; TYPE_THEN `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; GEN_TAC; DISCH_TAC; USE 0 (MATCH_MP endpoint_lemma); CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; UND 1; DISCH_THEN DISJ_CASES_TAC; REWR 6; USE 6 (REWRITE_RULE[part_below_v]); REWR 10; USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `FST m' = FST m` SUBGOAL_TAC; ASM_MESON_TAC[]; INT_ARITH_TAC; (* 2nd case *) REWR 6; USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); REWR 10; USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC; ASM_MESON_TAC[]; INT_ARITH_TAC; ]);; (* }}} *) let endpoint_lemma_upper_left = prove_by_refinement( `!G m . (rectagon G) ==> ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`, (* {{{ proof *) [ (* needs to be rewritten, template only *) REP_GEN_TAC; TYPE_THEN `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; GEN_TAC; DISCH_TAC; USE 0 (MATCH_MP endpoint_lemma); CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; UND 1; DISCH_THEN DISJ_CASES_TAC; REWR 6; USE 6 (REWRITE_RULE[part_below_v]); REWR 10; USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `FST m' = FST m` SUBGOAL_TAC; ASM_MESON_TAC[]; INT_ARITH_TAC; (* 2nd case *) REWR 6; USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); REWR 10; USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC; ASM_MESON_TAC[]; INT_ARITH_TAC; ]);; (* }}} *) let endpoint_lemma_upper_right = prove_by_refinement( `!G m . (rectagon G) ==> ~(endpoint (part_below G m) (FST m +: &:1, SND m +: &:1))`, (* {{{ proof *) [ (* needs to be rewritten, template only *) REP_GEN_TAC; TYPE_THEN `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m +: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m +: &:1,SND m +: &:1)))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; GEN_TAC; DISCH_TAC; USE 0 (MATCH_MP endpoint_lemma); CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; UND 1; DISCH_THEN DISJ_CASES_TAC; REWR 6; USE 6 (REWRITE_RULE[part_below_v]); REWR 10; USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `FST m +: &:1 = FST m'` SUBGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `FST m' = FST m` SUBGOAL_TAC; ASM_MESON_TAC[]; INT_ARITH_TAC; (* 2nd case *) REWR 6; USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); REWR 10; USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC; ASM_MESON_TAC[]; INT_ARITH_TAC; ]);; (* }}} *) let endpoint_lemma_summary = prove_by_refinement( `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ((FST x = FST m -: &:1) /\ (SND x <=: SND m)) \/ ((FST x = FST m +: &:1) /\ (SND x <=: SND m)) \/ ((FST x = FST m) /\ (SND x = SND m +: &:1 )) `, (* {{{ proof *) [ (* USE int -arith to show cases of fst x, then for each give *) REP_GEN_TAC; DISCH_TAC; TYPE_THEN `(FST x < FST m -: &:1) \/ (FST x = FST m -: &:1) \/ (FST x = FST m ) \/ (FST x = FST m +: &:1) \/ (FST m +: &:1 <: FST x )` SUBGOAL_TAC; INT_ARITH_TAC; REP_CASES_TAC ; USE 0 (MATCH_MP endpoint_lemma_small_fst); PROOF_BY_CONTR_TAC; UND 0; UND 1; INT_ARITH_TAC; DISJ1_TAC; ASM_REWRITE_TAC[]; COPY 0; USE 0 (MATCH_MP endpoint_lemma_big_snd); IMATCH_MP_TAC (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`); ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; REWR 3; TYPE_THEN `x = (FST m -: &:1, SND m + &:1)` SUBGOAL_TAC; ASM_REWRITE_TAC[PAIR_SPLIT]; DISCH_TAC; REWR 2; ASM_MESON_TAC[endpoint_lemma_upper_left]; USE 0 (MATCH_MP endpoint_lemma_mid_fst); ASM_MESON_TAC[]; DISJ2_TAC; DISJ1_TAC ; ASM_REWRITE_TAC[]; COPY 0; USE 0 (MATCH_MP endpoint_lemma_big_snd); IMATCH_MP_TAC (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`); ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; REWR 3; TYPE_THEN `x = (FST m +: &:1, SND m + &:1)` SUBGOAL_TAC; ASM_REWRITE_TAC[PAIR_SPLIT]; DISCH_TAC; REWR 2; ASM_MESON_TAC[endpoint_lemma_upper_right]; USE 0 (MATCH_MP endpoint_lemma_big_fst); PROOF_BY_CONTR_TAC; UND 0; UND 1; INT_ARITH_TAC; ]);; (* }}} *) let terminal_case1 = prove_by_refinement( `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\ (closure top2 (h_edge n) (pointI x)) /\ (set_lower G m n ) ==> (x = right n)`, (* {{{ proof *) [ REWRITE_TAC[h_edge_cpoint; set_lower]; DISCH_ALL_TAC; USE 2 (REWRITE_RULE[PAIR_SPLIT]); UND 2; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `FST x = FST m` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; JOIN 0 1; USE 0 (MATCH_MP endpoint_lemma_mid_fst); REWR 0; UND 0; UND 2; UND 5; INT_ARITH_TAC; TYPE_THEN `FST x = FST m +: &:1` SUBGOAL_TAC; ASM_MESON_TAC[]; REWRITE_TAC[PAIR_SPLIT;right ]; ASM_MESON_TAC[]; ]);; (* }}} *) let terminal_case2 = prove_by_refinement( `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\ (closure top2 (h_edge n) (pointI x)) /\ (set_lower G (left m) n ) ==> (x = n)`, (* {{{ proof *) [ REWRITE_TAC[h_edge_cpoint; set_lower ]; DISCH_ALL_TAC; USE 2 (REWRITE_RULE[PAIR_SPLIT]); UND 2; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `FST x = FST m` SUBGOAL_TAC; UND 2; UND 4; REWRITE_TAC[left ]; INT_ARITH_TAC ; DISCH_TAC; JOIN 0 1; USE 0 (MATCH_MP endpoint_lemma_mid_fst); AND 2; UND 2; REWR 0; DISCH_TAC; UND 5; UND 0; REWRITE_TAC[left ]; INT_ARITH_TAC; ]);; (* }}} *) let terminal_case_v = prove_by_refinement( `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\ (closure top2 (v_edge n) (pointI x)) /\ (part_below G m (v_edge n)) ==> (x = up m) /\ (m =n)`, (* {{{ proof *) [ REWRITE_TAC[part_below_v; v_edge_cpoint;]; DISCH_ALL_TAC; JOIN 0 1; USE 2 (REWRITE_RULE[PAIR_SPLIT]); REWR 1; TYPE_THEN `FST x = FST m` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 1; REWRITE_TAC[PAIR_SPLIT; up ;]; ASM_REWRITE_TAC[]; USE 0 (MATCH_MP endpoint_lemma_mid_fst); REWR 0; ASM_REWRITE_TAC[]; UND 0; UND 1; UND 5; INT_ARITH_TAC; ]);; (* }}} *) let inj_terminal = prove_by_refinement( `!G m. (rectagon G) ==> (INJ (terminal_edge (part_below G m)) (endpoint (part_below G m)) UNIV)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC ; ASM_MESON_TAC[part_below_finite;rectagon]; DISCH_TAC; REWRITE_TAC[INJ]; DISCH_ALL_TAC; TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC; TYPE_THEN `closure top2 e (pointI x) /\ closure top2 e (pointI y)` SUBGOAL_TAC; ASM_MESON_TAC[terminal_endpoint]; DISCH_ALL_TAC; TYPE_THEN `(part_below G m) e` SUBGOAL_TAC; ASM_MESON_TAC[terminal_endpoint]; DISCH_TAC; TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC; REWRITE_TAC[part_below;ISUBSET]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;rectagon]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); TYPE_THEN `(x = up m) /\ (y = up m)` SUBGOAL_TAC; ASM_MESON_TAC[terminal_case_v]; MESON_TAC[]; (* h-case *) UND 4; REWR 8; USE 4 (REWRITE_RULE[part_below_h ;]); DISCH_TAC; UND 4; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `(x = right m') /\ (y = right m')` SUBGOAL_TAC ; ASM_MESON_TAC[terminal_case1]; MESON_TAC[]; TYPE_THEN `( x= m' ) /\ (y = m') ` SUBGOAL_TAC; ASM_MESON_TAC[terminal_case2]; MESON_TAC[]; ]);; (* }}} *) (* now start on surjectivity results *) let endpoint_criterion = prove_by_refinement( `!G m e. (FINITE G) /\ (!e'. (G e' /\ (closure top2 e' (pointI m))) = (e = e')) ==> (endpoint G m) /\ (e = terminal_edge G m)`, (* {{{ proof *) [ DISCH_ALL_TAC; SUBCONJ_TAC; REWRITE_TAC[endpoint;]; ASM_SIMP_TAC[num_closure1]; ASM_MESON_TAC[]; DISCH_TAC; ASM_MESON_TAC[terminal_unique]; ]);; (* }}} *) let target_set = jordan_def `target_set G m = { e | (?n. (e = h_edge n) /\ (set_lower G m n)) \/ (?n. (e = h_edge n) /\ (set_lower G (left m) n)) \/ ((e = v_edge m) /\ G e)}`;; let target_set_subset = prove_by_refinement( `!G m. target_set G m SUBSET G`, (* {{{ proof *) [ REWRITE_TAC[ISUBSET;target_set;set_lower]; ASM_MESON_TAC[]; ]);; (* }}} *) let target_edge = prove_by_refinement( `!G m. target_set G m SUBSET edge`, (* {{{ proof *) [ REWRITE_TAC[target_set;edge;ISUBSET ]; ASM_MESON_TAC[]; ]);; (* }}} *) let target_h = prove_by_refinement( `!G m n. target_set G m (h_edge n) <=> (set_lower G m n) \/ (set_lower G (left m) n)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[target_set;h_edge_inj; hv_edgeV2;]; ASM_MESON_TAC[]; ]);; (* }}} *) let target_v = prove_by_refinement( `!G m n. target_set G m (v_edge n) <=> (n = m) /\ G (v_edge n)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[target_set;hv_edgeV2;v_edge_inj;]; ]);; (* }}} *) let part_below_subset = prove_by_refinement( `!G m. (part_below G m SUBSET G)`, (* {{{ proof *) [ REWRITE_TAC[part_below;ISUBSET]; MESON_TAC[]; ]);; (* }}} *) let part_below_finite = prove_by_refinement( `!G m. (FINITE G ==> FINITE (part_below G m))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[part_below_subset]; ]);; (* }}} *) let terminal_edge_image = prove_by_refinement( `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> (target_set G m (terminal_edge (part_below G m) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC; COPY 2; USE 2 ( MATCH_MP part_below_finite); TSPEC `m` 2; REWRITE_TAC[target_set]; TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC; TYPE_THEN `(part_below G m e) /\ (closure top2 e (pointI x))` SUBGOAL_TAC; ASM_MESON_TAC[terminal_endpoint]; DISCH_ALL_TAC; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[part_below_subset;ISUBSET;rectagon]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); ASM_REWRITE_TAC[hv_edgeV2;v_edge_inj]; REWR 5; USE 5 (REWRITE_RULE[part_below_v]); ASM_REWRITE_TAC[PAIR_SPLIT ]; REWR 6; USE 6 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); TYPE_THEN `FST x = FST m'` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 6; TYPE_THEN `SND x = SND m +: &:1` SUBGOAL_TAC; ASM_MESON_TAC[endpoint_lemma_mid_fst]; UND 6; AND 5; AND 5; UND 5; INT_ARITH_TAC; (* H edge *) ASM_REWRITE_TAC[hv_edgeV2;h_edge_inj;]; REWR 5; USE 5(REWRITE_RULE[part_below_h ]); ASM_MESON_TAC[]; ]);; (* }}} *) let terminal_edge_surj = prove_by_refinement( `!G m e. (rectagon G) /\ (target_set G m e) ==> (?x. (endpoint (part_below G m) x) /\ (e = terminal_edge (part_below G m) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC; TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC; ASM_MESON_TAC[part_below_finite]; DISCH_TAC; TYPE_THEN `(part_below G m) SUBSET G` SUBGOAL_TAC; ASM_MESON_TAC[part_below_subset]; DISCH_TAC; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[target_edge;ISUBSET]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); REWR 1; USE 1(REWRITE_RULE[target_v]); AND 1; REWR 1; REWR 5; KILL 6; TYPE_THEN `up m` EXISTS_TAC; IMATCH_MP_TAC endpoint_criterion; ASM_REWRITE_TAC[]; GEN_TAC; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `edge e'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;rectagon]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); REWR 6; USE 6 (REWRITE_RULE[part_below_v]); ASM_REWRITE_TAC [v_edge_inj;PAIR_SPLIT]; REWR 7; USE 7(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT;up;]); AND 6; AND 6; UND 6; UND 7; INT_ARITH_TAC; REWR 6; USE 6 (REWRITE_RULE[part_below_h;set_lower;left ;]); TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWR 7; USE 7(REWRITE_RULE[h_edge_cpoint; up; PAIR_SPLIT ]); UND 7; UND 9; INT_ARITH_TAC; DISCH_TAC; EXPAND_TAC "e'"; KILL 6; ASM_REWRITE_TAC [part_below_v;v_edge_cpoint;up]; INT_ARITH_TAC; (* half-on-proof , hedge *) (* hop *) REWR 1; USE 1(REWRITE_RULE[target_h]); UND 1; DISCH_THEN (DISJ_CASES_TAC); (* split LEFT and RIGHT H *) TYPE_THEN `right m'` EXISTS_TAC; IMATCH_MP_TAC endpoint_criterion; ASM_REWRITE_TAC[]; GEN_TAC; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `edge e'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;rectagon]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); (* snd H or v *) REWR 6; USE 6 (REWRITE_RULE[part_below_v]); REWR 7; USE 7(REWRITE_RULE[v_edge_cpoint;right ;PAIR_SPLIT; ]); REWRITE_TAC[h_edge_inj;hv_edgeV2;]; USE 1 (REWRITE_RULE[set_lower]); ASM_MESON_TAC[INT_ARITH `~(x +: &:1 = x)`]; ASM_REWRITE_TAC [h_edge_inj;PAIR_SPLIT ]; (* snd H *) KILL 5; UND 8; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE [t])); RULE_ASSUM_TAC (REWRITE_RULE[part_below_h;h_edge_cpoint;PAIR_SPLIT;right ]); UND 6; DISCH_THEN DISJ_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[set_lower]); ASM_MESON_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[set_lower;left ]); AND 5; AND 5; PROOF_BY_CONTR_TAC; UND 8; UND 7; UND 1; INT_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); REWRITE_TAC[part_below_h;h_edge_cpoint;right ]; ASM_REWRITE_TAC[]; KILL 5; (* finally LEFT case: now everything needs to have an endpoint *) (* hop3*) USE 1 (REWRITE_RULE[set_lower;left ]); TYPE_THEN ` m'` EXISTS_TAC ; (* was left m *) IMATCH_MP_TAC endpoint_criterion; ASM_REWRITE_TAC[]; GEN_TAC; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `edge e'` SUBGOAL_TAC; ASM_MESON_TAC[rectagon;ISUBSET]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); ASM_REWRITE_TAC[]; UND 7; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); RULE_ASSUM_TAC (REWRITE_RULE[part_below_v;v_edge_cpoint;left ;PAIR_SPLIT ;]); UND 5; UND 6; UND 1; INT_ARITH_TAC; (* now H *) ASM_REWRITE_TAC[]; UND 7; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); RULE_ASSUM_TAC (REWRITE_RULE[part_below_h;h_edge_cpoint;left ;PAIR_SPLIT ;]); UND 5; DISCH_THEN DISJ_CASES_TAC; USE 5(REWRITE_RULE[set_lower]); UND 5; UND 6; UND 1; INT_ARITH_TAC; (* hop2 *) USE 5 (REWRITE_RULE[set_lower]); REWRITE_TAC[h_edge_inj;PAIR_SPLIT;]; UND 5; UND 6; UND 1; INT_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASM_REWRITE_TAC[part_below_h;h_edge_cpoint; set_lower; left ]; ]);; (* }}} *) (* set *) let inj_subset = prove_by_refinement( `!t t' s (f:A->B). (INJ f s t') /\ (t SUBSET t') /\ (IMAGE f s SUBSET t) ==> (INJ f s t)`, (* {{{ proof *) [ REWRITE_TAC[INJ;IMAGE;SUBSET ]; ASM_MESON_TAC[]; ]);; (* }}} *) let terminal_edge_bij = prove_by_refinement( `!G m. (rectagon G) ==> (BIJ (terminal_edge (part_below G m)) (endpoint (part_below G m)) (target_set G m))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; IMATCH_MP_TAC inj_subset; TYPE_THEN `UNIV:((num->real)->bool)->bool` EXISTS_TAC; ASM_SIMP_TAC[inj_terminal]; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[terminal_edge_image]; REWRITE_TAC[INJ;SURJ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[terminal_edge_surj]; ]);; (* }}} *) let target_set_finite = prove_by_refinement( `!G m. (FINITE G) ==> (FINITE (target_set G m))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; ASM_MESON_TAC[target_set_subset]; ]);; (* }}} *) let rectagon_endpoint0 = prove_by_refinement( `!G. (rectagon G) ==> ((endpoint G) HAS_SIZE 0)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `endpoint G = {}` SUBGOAL_TAC; REWRITE_TAC[EQ_EMPTY]; ASM_MESON_TAC[rectagon_endpoint]; DISCH_THEN_REWRITE; ASM_MESON_TAC[HAS_SIZE_0]; ]);; (* }}} *) let target_set_even = prove_by_refinement( `!G m. (rectagon G) ==> (EVEN (CARD (target_set G m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `CARD (endpoint(part_below G m)) = CARD (target_set G m)` SUBGOAL_TAC; IMATCH_MP_TAC BIJ_CARD ; TYPE_THEN `terminal_edge (part_below G m)` EXISTS_TAC; ASM_SIMP_TAC[terminal_edge_bij]; ASSUME_TAC terminal_edge_bij; TYPEL_THEN [`G`;`m`] (USE 1 o ISPECL); REWR 1; ASSUME_TAC target_set_finite; TYPEL_THEN [`G`;`m`] (USE 2 o ISPECL); ASM_MESON_TAC[FINITE_BIJ2;rectagon]; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); TYPE_THEN `rectagon (part_below G m)` ASM_CASES_TAC; TYPE_THEN `CARD (endpoint (part_below G m)) =0` SUBGOAL_TAC; ASM_MESON_TAC[HAS_SIZE;rectagon_endpoint0]; MESON_TAC[EVEN]; TYPE_THEN `P = part_below G m` ABBREV_TAC ; TYPE_THEN `segment G /\ (P SUBSET G) /\ ~(rectagon P)` SUBGOAL_TAC; ASM_SIMP_TAC[rectagon_segment]; ASM_MESON_TAC[part_below_subset]; DISCH_TAC; USE 3 (MATCH_MP endpoint_even ); USE 3 (REWRITE_RULE[HAS_SIZE]); ASM_REWRITE_TAC[EVEN_DOUBLE]; ]);; (* }}} *) let bij_target_set = prove_by_refinement( `!G m. (rectagon G) /\ ~(G (v_edge m)) ==> (BIJ h_edge (set_lower G (left m) UNION (set_lower G m)) (target_set G m))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; ]; MESON_TAC[]; REWRITE_TAC[h_edge_inj;]; MESON_TAC[]; REWRITE_TAC[INJ;SURJ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[target_set;set_lower;UNION;]; GEN_TAC; REP_CASES_TAC; CHO 4; UND 4; DISCH_ALL_TAC; ASM_MESON_TAC[]; CHO 4; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let bij_target_set_odd = prove_by_refinement( `!G m. (rectagon G) /\ (G (v_edge m)) ==> (BIJ h_edge (set_lower G (left m) UNION (set_lower G m) ) (target_set G m DELETE (v_edge m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; DELETE ]; MESON_TAC[]; REWRITE_TAC[h_edge_inj;]; MESON_TAC[]; REWRITE_TAC[INJ;SURJ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[target_set;set_lower;UNION;DELETE ]; GEN_TAC; DISCH_TAC; AND 4; REWR 5; UND 5; REP_CASES_TAC; CHO 5; UND 5; DISCH_ALL_TAC; ASM_MESON_TAC[]; CHO 5; ASM_MESON_TAC[]; ]);; (* }}} *) let target_set_odd = prove_by_refinement( `!G m. (rectagon G) /\ (G (v_edge m)) ==> ~(EVEN(CARD (target_set G m DELETE (v_edge m))))`, (* {{{ proof *) [ REWRITE_TAC[GSYM EVEN]; DISCH_ALL_TAC; TYPE_THEN `FINITE (target_set G m)` SUBGOAL_TAC; ASM_MESON_TAC[target_set_finite;rectagon]; DISCH_TAC; TYPE_THEN `target_set G m (v_edge m)` SUBGOAL_TAC; ASM_REWRITE_TAC [target_v]; DISCH_TAC; TYPE_THEN `SUC (CARD (target_set G m DELETE (v_edge m))) = CARD (target_set G m )` SUBGOAL_TAC; IMATCH_MP_TAC CARD_SUC_DELETE; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_MESON_TAC[target_set_even]; ]);; (* }}} *) let squ_left_even = prove_by_refinement( `!G m. (rectagon G) /\ ~(G (v_edge m)) ==> ((even_cell G (squ (left m)) = even_cell G(squ m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC; REWRITE_TAC[even_cell_squ;num_lower_set]; TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC; IMATCH_MP_TAC even_card_even; ASM_SIMP_TAC[finite_set_lower]; REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ]; MESON_TAC[INT_ARITH `~(z = z -: &:1)`]; DISCH_THEN_REWRITE; TYPE_THEN `BIJ h_edge (set_lower G (left m) UNION (set_lower G m)) (target_set G m) ` SUBGOAL_TAC; ASM_MESON_TAC[bij_target_set]; DISCH_TAC; TYPE_THEN `CARD (set_lower G (left m) UNION (set_lower G m)) = CARD (target_set G m)` SUBGOAL_TAC; IMATCH_MP_TAC BIJ_CARD ; TYPE_THEN `h_edge` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[FINITE_UNION]; ASM_MESON_TAC[finite_set_lower]; DISCH_THEN_REWRITE; ASM_MESON_TAC[target_set_even]; ]);; (* }}} *) let squ_left_odd = prove_by_refinement( `!G m. (rectagon G) /\ (G (v_edge m)) ==> (~(even_cell G (squ (left m)) = even_cell G(squ m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC; UND 0; REWRITE_TAC[even_cell_squ;num_lower_set]; TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC; IMATCH_MP_TAC even_card_even; ASM_SIMP_TAC[finite_set_lower]; REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ]; MESON_TAC[INT_ARITH `~(z = z -: &:1)`]; DISCH_THEN_REWRITE; TYPE_THEN `BIJ h_edge (set_lower G (left m) UNION (set_lower G m)) (target_set G m DELETE (v_edge m)) ` SUBGOAL_TAC; ASM_MESON_TAC[bij_target_set_odd]; DISCH_TAC; TYPE_THEN `CARD (set_lower G (left m) UNION (set_lower G m)) = CARD (target_set G m DELETE (v_edge m))` SUBGOAL_TAC; IMATCH_MP_TAC BIJ_CARD ; TYPE_THEN `h_edge` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[FINITE_UNION]; ASM_MESON_TAC[finite_set_lower]; DISCH_THEN_REWRITE; ASM_MESON_TAC[target_set_odd]; ]);; (* }}} *) let squ_left_par = prove_by_refinement( `!G m. (rectagon G) ==> (((even_cell G (squ (left m)) = even_cell G(squ m))) <=> ~(G (v_edge m)))`, (* {{{ proof *) [ ASM_MESON_TAC[squ_left_even;squ_left_odd]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION E *) (* ------------------------------------------------------------------ *) let rectangle = jordan_def `rectangle p q = {Z | ?u v. (Z = point(u,v)) /\ (real_of_int (FST p ) <. u) /\ (u <. (real_of_int (FST q ))) /\ (real_of_int (SND p ) <. v) /\ (v <. (real_of_int (SND q))) }`;; let rectangle_inter = prove_by_refinement( `!p q. rectangle p q = {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST q)} INTER {z | ?r. (z = point r) /\ (SND r ) <. real_of_int(SND q)} `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[rectangle;INTER]; GEN_TAC; EQ_TAC; DISCH_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[point_inj]; CONV_TAC (dropq_conv "r"); ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "r"); ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "r'"); CONV_TAC (dropq_conv "r"); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; CHO 0; REWR 1; USE 1 (REWRITE_RULE[point_inj]); USE 1(CONV_RULE (dropq_conv "r'")); REWR 2; USE 2(REWRITE_RULE[point_inj]); USE 2(CONV_RULE (dropq_conv "r'")); REWR 3; USE 3(REWRITE_RULE[point_inj]); USE 3(CONV_RULE (dropq_conv "r'")); REWRITE_TAC[point_inj;PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); ASM_MESON_TAC[]; ]);; (* }}} *) let rectangle_open = prove_by_refinement( `!p q. top2 (rectangle p q)`, (* {{{ proof *) [ REWRITE_TAC[rectangle_inter]; ASSUME_TAC top2_top; DISCH_ALL_TAC; REPEAT (IMATCH_MP_TAC top_inter THEN ASM_REWRITE_TAC[top_inter;open_half_plane2D_FLT_open;open_half_plane2D_LTF_open;open_half_plane2D_SLT_open;open_half_plane2D_LTS_open]); ]);; (* }}} *) let rectangle_convex = prove_by_refinement( `!p q. convex (rectangle p q)`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[rectangle_inter]; REPEAT (IMATCH_MP_TAC convex_inter THEN REWRITE_TAC[open_half_plane2D_FLT_convex;open_half_plane2D_LTF_convex;open_half_plane2D_SLT_convex;open_half_plane2D_LTS_convex]); ]);; (* }}} *) let rectangle_squ = prove_by_refinement( `!p. squ p = rectangle p (FST p +: &:1,SND p +: &:1)`, (* {{{ proof *) [ REWRITE_TAC[squ;rectangle]; ]);; (* }}} *) let squ_inter = prove_by_refinement( `!p. squ p = {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST p +: &:1) } INTER {z | ?r. (z = point r) /\ (SND r ) <. real_of_int(SND p +: &:1) }`, (* {{{ proof *) [ REWRITE_TAC[rectangle_squ;rectangle_inter]; ]);; (* }}} *) (* set *) let subset3_absorb = prove_by_refinement( `!(A:A->bool) B C. (B SUBSET C) ==> (B INTER A = B INTER C INTER A)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[INTER_ACI]; AP_TERM_TAC; ASM_MESON_TAC[SUBSET_INTER_ABSORPTION]; ]);; (* }}} *) let rectangle_lemma1 = prove_by_refinement( `!p. squ(down p) = (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1)) INTER {z | ?r. (z = point r) /\ (SND r <. real_of_int(SND p))}`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[squ_inter;rectangle_inter;down]; REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`]; REWRITE_TAC[INTER_ACI]; AP_TERM_TAC; AP_TERM_TAC; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER;int_suc ;]; EQ_TAC; DISCH_ALL_TAC; CHO 0; ASSUME_TAC (REAL_ARITH `!u. u <. u + &.1`); CONJ_TAC; TYPE_THEN `r` EXISTS_TAC; ASM_MESON_TAC[REAL_LT_TRANS ]; ASM_MESON_TAC[]; MESON_TAC[]; ]);; (* }}} *) let rectangle_lemma2 = prove_by_refinement( `!p. squ(p) = (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1)) INTER {z | ?r. (z = point r) /\ ( real_of_int(SND p) <. SND r)}`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[squ_inter;rectangle_inter;down]; REWRITE_TAC[INTER_ACI]; AP_TERM_TAC; TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND p -: &:1) < SND r}` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th]; ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`]; ]);; (* }}} *) let rectangle_lemma3 = prove_by_refinement( `!q. h_edge q = (rectangle (FST q , SND q -: &:1) (FST q +: &:1 , SND q +: &:1)) INTER {z | ?r. (z = point r) /\ ( SND r = real_of_int(SND q))}`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[h_edge_inter;rectangle_inter;]; TYPE_THEN `B = {z | ?p. (z = point p) /\ (SND p = real_of_int (SND q))}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ; TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC; REWRITE_TAC[INTER_ACI]; DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); IMATCH_MP_TAC subset3_absorb; REWRITE_TAC[SUBSET_INTER]; EXPAND_TAC "B"; EXPAND_TAC "C"; EXPAND_TAC "D"; REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;]; ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`]; ]);; (* }}} *) let rectangle_h = prove_by_refinement( `!p. rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1) = ((squ (down p)) UNION (h_edge p) UNION (squ p) )`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[rectangle_lemma1;rectangle_lemma2;rectangle_lemma3]; REWRITE_TAC[GSYM UNION_OVER_INTER]; TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION {z | ?r. (z = point r) /\ (SND r = real_of_int (SND p))} UNION {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[UNION]; ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`]; DISCH_THEN_REWRITE; TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1) SUBSET {z | ?r. z = point r}` SUBGOAL_TAC; REWRITE_TAC[rectangle;SUBSET ]; ASM_MESON_TAC[]; REWRITE_TAC [SUBSET_INTER_ABSORPTION;]; DISCH_THEN_REWRITE; ]);; (* }}} *) let rectangle_lemma4 = prove_by_refinement( `!p. squ(left p) = (rectangle (FST p -: &:1 , SND p)(FST p +: &:1 , SND p +: &:1)) INTER {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p))}`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[squ_inter;rectangle_inter;left ]; REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`]; REWRITE_TAC[INTER_ACI]; AP_TERM_TAC; AP_TERM_TAC; TYPE_THEN `B = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)}` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; REWRITE_TAC[SUBSET;int_suc]; ASM_MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &.1`]; ]);; (* }}} *) let rectangle_lemma5 = prove_by_refinement( `!p. squ(p) = (rectangle (FST p -: &:1 , SND p) (FST p +: &:1 , SND p +: &:1)) INTER {z | ?r. (z = point r) /\ ( real_of_int(FST p) <. FST r)}`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[squ_inter;rectangle_inter;]; TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r} ` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th]; ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`]; ]);; (* }}} *) let rectangle_lemma6 = prove_by_refinement( `!q. v_edge q = (rectangle (FST q -: &:1 , SND q) (FST q +: &:1 , SND q +: &:1)) INTER {z | ?r. (z = point r) /\ ( FST r = real_of_int(FST q))}`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[v_edge_inter;rectangle_inter;]; REWRITE_TAC[INTER_ACI]; TYPE_THEN `B = {z | ?p. (z = point p) /\ (FST p = real_of_int (FST q))}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST q -: &:1) < FST r}` ABBREV_TAC ; TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST q +: &:1)}` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC; REWRITE_TAC[INTER_ACI]; DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); IMATCH_MP_TAC subset3_absorb; REWRITE_TAC[SUBSET_INTER]; EXPAND_TAC "B"; EXPAND_TAC "C"; EXPAND_TAC "D"; REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;]; ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`]; ]);; (* }}} *) let rectangle_v = prove_by_refinement( `!p. rectangle (FST p -: &:1 , SND p ) (FST p +: &:1 , SND p +: &:1) = ((squ (left p)) UNION (v_edge p) UNION (squ p) )`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[rectangle_lemma4;rectangle_lemma5;rectangle_lemma6]; REWRITE_TAC[GSYM UNION_OVER_INTER]; TYPE_THEN `({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[UNION]; ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`]; DISCH_THEN_REWRITE; TYPE_THEN `rectangle (FST p -: &:1 ,SND p) (FST p +: &:1,SND p +: &:1) SUBSET {z | ?r. z = point r}` SUBGOAL_TAC; REWRITE_TAC[rectangle;SUBSET ]; ASM_MESON_TAC[]; REWRITE_TAC [SUBSET_INTER_ABSORPTION;]; DISCH_THEN_REWRITE; ]);; (* }}} *) let long_v = jordan_def `long_v p = {z | (?r. (z = point r) /\ (FST r = real_of_int (FST p)) /\ (real_of_int(SND p) - &1 <. SND r) /\ (SND r <. real_of_int(SND p) + &1) )}`;; let long_v_inter = prove_by_refinement( `!p. long_v p = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} INTER {z | ?r. (z = point r) /\ (real_of_int(SND p -: &:1) <. SND r)} INTER {z | ?r. (z = point r) /\ (SND r <. real_of_int(SND p +: &:1))} `, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC EQ_EXT ; REWRITE_TAC[long_v;INTER;int_add_th;int_sub_th;int_of_num_th]; GEN_TAC; EQ_TAC; DISCH_THEN CHOOSE_TAC; ASM_MESON_TAC[]; DISCH_ALL_TAC; CHO 0; REWR 1; REWR 2; RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); USE 2(CONV_RULE (dropq_conv "r'")); USE 1(CONV_RULE (dropq_conv "r'")); ASM_MESON_TAC[]; ]);; (* }}} *) let long_v_lemma1 = prove_by_refinement( `!q. v_edge (down q) = long_v q INTER {z | ?r. (z = point r) /\ (SND r <. real_of_int(SND q))}`, (* {{{ proof *) [ REWRITE_TAC[v_edge_inter;long_v_inter;down ]; REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`]; GEN_TAC; TYPE_THEN `B = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q)}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ; alpha_tac; REWRITE_TAC[INTER_ACI]; IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; REWRITE_TAC[SUBSET;int_add_th;int_of_num_th]; MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &1`]; ]);; (* }}} *) let long_v_lemma2 = prove_by_refinement( `!q. v_edge q = long_v q INTER {z | ?r. (z = point r) /\ (real_of_int(SND q) <. SND r )}`, (* {{{ proof *) [ REWRITE_TAC[v_edge_inter;long_v_inter;down;int_suc;int_sub_th;int_of_num_th ]; GEN_TAC; TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (SND q) < SND r}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q) - &1 < SND r}` ABBREV_TAC ; alpha_tac; REWRITE_TAC[INTER_ACI]; IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; REWRITE_TAC[SUBSET;int_add_th;int_of_num_th]; MESON_TAC[REAL_ARITH `x <. y ==> x - &1 <. y`]; ]);; (* }}} *) let pointI_inter = prove_by_refinement( `!q. {(pointI q)} = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))} INTER {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING;pointI ]; GEN_TAC; EQ_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[point_inj]; CONV_TAC (dropq_conv "r"); CONV_TAC (dropq_conv "r'"); DISCH_ALL_TAC; CHO 0; REWR 1; USE 1(REWRITE_RULE[point_inj]); USE 1(CONV_RULE (dropq_conv "r'")); ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;]; ]);; (* }}} *) let long_v_lemma3 = prove_by_refinement( `!q. {(pointI q)} = long_v q INTER { z | ?r. (z = point r) /\ (real_of_int(SND q) = SND r)}`, (* {{{ proof *) [ REWRITE_TAC[pointI_inter;long_v_inter]; GEN_TAC; alpha_tac; TYPE_THEN `A = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))}` ABBREV_TAC ; TYPE_THEN `B = {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ; TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; AP_TERM_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION]; EXPAND_TAC "B"; EXPAND_TAC "C"; EXPAND_TAC "D"; REWRITE_TAC[SUBSET;INTER;int_sub_th;int_of_num_th;int_add_th]; ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &1 <. y /\ x <. y + &1)`]; ]);; (* }}} *) let long_v_union = prove_by_refinement( `!p. long_v p = (v_edge (down p)) UNION {(pointI p)} UNION (v_edge p)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[long_v_lemma1;long_v_lemma2;long_v_lemma3]; REWRITE_TAC[GSYM UNION_OVER_INTER]; TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION {z | ?r. (z = point r) /\ (real_of_int (SND p) = SND r)} UNION {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT ; GEN_TAC; REWRITE_TAC[UNION;]; EQ_TAC; MESON_TAC[]; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[point_inj]; CONV_TAC (dropq_conv "r'"); REAL_ARITH_TAC; DISCH_THEN_REWRITE; ONCE_REWRITE_TAC[EQ_SYM_EQ]; REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;]; REWRITE_TAC[long_v;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let two_two_lemma1 = prove_by_refinement( `!p. rectangle(FST p - &:1 , SND p - &:1) (FST p , SND p + &:1) = rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) INTER {z | (?r. (z = point r) /\ (FST r <. real_of_int(FST p)))}`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[rectangle_inter]; alpha_tac; TYPE_THEN `B = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; REWRITE_TAC[SUBSET;int_suc;]; MESON_TAC[REAL_ARITH `x <. y ==> x < y + &1`]; ]);; (* }}} *) let two_two_lemma2 = prove_by_refinement( `!p. rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1) = rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) INTER {z | (?r. (z = point r) /\ ( real_of_int(FST p) <. FST r ))}`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[rectangle_inter]; alpha_tac; TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; REWRITE_TAC[SUBSET;int_sub_th;int_add_th;int_of_num_th;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> (x - &1 <. y)`]; ]);; (* }}} *) let two_two_lemma3 = prove_by_refinement( `!p. long_v p = rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) INTER {z | (?r. (z = point r) /\ ( FST r = real_of_int(FST p) ))}`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[long_v_inter;rectangle_inter]; alpha_tac; TYPE_THEN `B = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} ` ABBREV_TAC ; TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ; TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ; REWRITE_TAC[INTER_ACI]; TYPE_THEN `!A. (B INTER C INTER D INTER A) = B INTER (C INTER D) INTER A` SUBGOAL_TAC; REWRITE_TAC[INTER_ACI]; DISCH_THEN (fun t-> PURE_REWRITE_TAC[t]); IMATCH_MP_TAC subset3_absorb; EXPAND_TAC "B"; EXPAND_TAC "C"; EXPAND_TAC "D"; REWRITE_TAC[SUBSET;INTER;int_sub_th;int_add_th;int_of_num_th]; GEN_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &.1 <. y /\ x <. y+ &1)`]; ]);; (* }}} *) let two_two_union = prove_by_refinement( `!p. rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) = rectangle(FST p - &:1 , SND p - &:1) (FST p , SND p + &:1) UNION long_v p UNION rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1)`, (* {{{ proof *) [ REWRITE_TAC[two_two_lemma1;two_two_lemma2;two_two_lemma3]; REWRITE_TAC[GSYM UNION_OVER_INTER]; GEN_TAC; TYPE_THEN `{z | ?r. (z = point r)} = ({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r})` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[UNION]; EQ_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_THEN_REWRITE; REWRITE_TAC [point_inj]; CONV_TAC (dropq_conv "r'"); REAL_ARITH_TAC; MESON_TAC[]; DISCH_TAC; USE 0 SYM; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION]; REWRITE_TAC[rectangle;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let two_two_nine = prove_by_refinement( `!p. rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) = squ (FST p -: &:1,SND p -: &:1) UNION squ (FST p -: &:1,SND p ) UNION squ (FST p,SND p -: &:1) UNION squ p UNION h_edge (left p) UNION h_edge p UNION v_edge (down p) UNION v_edge p UNION {(pointI p)}`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[two_two_union;rectangle_h;rectangle_v]; TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p,SND p +: &:1) = rectangle (FST (left p),SND (left p) -: &:1) (FST (left p) +: &:1,SND (left p) +: &:1)` SUBGOAL_TAC; REWRITE_TAC[left ;INT_ARITH `x -: &:1 +: &:1 = x`]; DISCH_THEN_REWRITE; REWRITE_TAC[rectangle_h]; REWRITE_TAC[left ;down; long_v_union]; REWRITE_TAC[UNION_ACI]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) let curve_cell = jordan_def `curve_cell G = G UNION {z | (?n. (z = {(pointI n)}) /\ (closure top2 (UNIONS G) (pointI n)))}`;; let curve_cell_cell = prove_by_refinement( `!G. (G SUBSET edge) ==> (curve_cell G SUBSET cell)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;edge;curve_cell;cell;UNION ]; DISCH_ALL_TAC; DISCH_ALL_TAC; UND 1; DISCH_THEN DISJ_CASES_TAC; TSPEC `x` 0; REWR 0; CHO 0; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let curve_cell_point = prove_by_refinement( `!G n. (FINITE G) /\ (G SUBSET edge) ==> (curve_cell G {(pointI n)} <=> (?e. (G e /\ (closure top2 e (pointI n)))))`, (* {{{ proof *) [ REWRITE_TAC[curve_cell;UNION ;edge;SUBSET ]; DISCH_ALL_TAC; EQ_TAC; DISCH_THEN DISJ_CASES_TAC; TSPEC `{(pointI n)}` 1; USE 1(GSYM); USE 1(REWRITE_RULE[eq_sing;v_edge_pointI;h_edge_pointI;]); ASM_MESON_TAC[]; USE 2 (REWRITE_RULE[eq_sing;INR IN_SING ;pointI_inj]); USE 2(CONV_RULE (dropq_conv "n'")); ASSUME_TAC top2_top; UND 2; ASM_SIMP_TAC[closure_unions]; REWRITE_TAC[IMAGE;INR IN_UNIONS ]; DISCH_THEN CHOOSE_TAC; AND 2; CHO 4; ASM_MESON_TAC[]; DISCH_THEN CHOOSE_TAC; DISJ2_TAC; REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;]; CONV_TAC (dropq_conv "n'") ; TYPE_THEN `closure top2 e SUBSET closure top2 (UNIONS G)` SUBGOAL_TAC; IMATCH_MP_TAC subset_of_closure; REWRITE_TAC[top2_top]; IMATCH_MP_TAC sub_union; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) let curve_cell_h = prove_by_refinement( `!G n. (segment G) ==> (curve_cell G (h_edge n) = G (h_edge n))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI]; ]);; (* }}} *) let curve_cell_v = prove_by_refinement( `!G n. (segment G) ==> (curve_cell G (v_edge n) = G (v_edge n))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI]; ]);; (* }}} *) let curve_cell_in = prove_by_refinement( `!C G . (G SUBSET edge) /\ (curve_cell G C) ==> (?n. (C = {(pointI n)}) \/ (C = h_edge n) \/ (C = v_edge n))`, (* {{{ proof *) [ REWRITE_TAC[curve_cell;UNION ;SUBSET; edge ]; DISCH_ALL_TAC; UND 1; DISCH_THEN DISJ_CASES_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let curve_cell_subset = prove_by_refinement( `!G. (G SUBSET (curve_cell G))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;curve_cell;UNION ]; MESON_TAC[]; ]);; (* }}} *) let curve_closure = prove_by_refinement( `!G. (segment G) ==> (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC ; ASSUME_TAC top2_top; (* ASM_SIMP_TAC[closure_unions]; *) TYPE_THEN `G SUBSET edge ` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; ASM_SIMP_TAC[closure_unions]; REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ]; DISCH_ALL_TAC; CHO 4; AND 4; CHO 5; TYPE_THEN `edge x'` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); REWR 5; REWR 4; COPY 4; USE 4(REWRITE_RULE[v_edge_closure;vc_edge;UNION ;INR IN_SING ]); UND 4; REP_CASES_TAC; TYPE_THEN `v_edge m` EXISTS_TAC; ASM_SIMP_TAC [curve_cell_v]; TYPE_THEN `{(pointI m)}` EXISTS_TAC; ASM_SIMP_TAC [curve_cell_point]; REWRITE_TAC[INR IN_SING]; ASM_MESON_TAC[]; USE 4(REWRITE_RULE[plus_e12]); TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC; ASM_SIMP_TAC [curve_cell_point]; REWRITE_TAC[INR IN_SING]; ASM_MESON_TAC[]; (* dt2 , down to 2 goals *) REWR 5; REWR 4; COPY 4; USE 4 (REWRITE_RULE[h_edge_closure;hc_edge;UNION;INR IN_SING]); UND 4; REP_CASES_TAC; TYPE_THEN `h_edge m` EXISTS_TAC; ASM_SIMP_TAC[curve_cell_h]; TYPE_THEN `{(pointI m)}` EXISTS_TAC; ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ]; ASM_MESON_TAC[]; USE 4(REWRITE_RULE[plus_e12]); TYPE_THEN `{x}` EXISTS_TAC; ASM_REWRITE_TAC[INR IN_SING]; ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ]; ASM_MESON_TAC[]; (* dt1 *) REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset]; ASM_SIMP_TAC[closure_unions]; CONJ_TAC; REWRITE_TAC[SUBSET;IMAGE;UNIONS]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "u"); NAME_CONFLICT_TAC; CHO 4; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[subset_closure;ISUBSET ]; (* // *) TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ; REWRITE_TAC[UNIONS;SUBSET ]; CONV_TAC (dropq_conv "u"); REWRITE_TAC[INR IN_SING]; MESON_TAC[]; ]);; (* }}} *) (* logic *) let not_not = prove_by_refinement( `!x y. (~x = ~y) <=> (x = y)`, (* {{{ proof *) [ MESON_TAC[]; ]);; (* }}} *) let not_eq = prove_by_refinement( `!x y. (~x = y) <=> (x = ~y)`, (* {{{ proof *) [ MESON_TAC[]; ]);; (* }}} *) let cell_inter = prove_by_refinement( `!C D. (cell C) /\ (D SUBSET cell) ==> ((C INTER (UNIONS D) = EMPTY) <=> ~(D C))`, (* {{{ proof *) [ REWRITE_TAC[INTER;IN_UNIONS;SUBSET;EQ_EMPTY ]; DISCH_ALL_TAC; RIGHT_TAC "x"; REWRITE_TAC[not_not ]; EQ_TAC; DISCH_THEN CHOOSE_TAC; AND 2; CHO 2; TYPE_THEN `t = C` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; REWRITE_TAC[EMPTY_EXISTS;INTER ]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; USE 0(MATCH_MP cell_nonempty); USE 0(REWRITE_RULE[EMPTY_EXISTS]); CHO 0; ASM_MESON_TAC[]; ]);; (* }}} *) let curve_cell_h_inter = prove_by_refinement( `!G m. (segment G) ==> (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> (~(G (h_edge m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[GSYM curve_cell_h]; IMATCH_MP_TAC cell_inter; ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; ASM_MESON_TAC[segment;curve_cell_cell]; ]);; (* }}} *) let curve_cell_v_inter = prove_by_refinement( `!G m. (segment G) ==> (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> (~(G (v_edge m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[GSYM curve_cell_v]; IMATCH_MP_TAC cell_inter; ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; ASM_MESON_TAC[segment;curve_cell_cell]; ]);; (* }}} *) let curve_cell_squ = prove_by_refinement( `!G m. (segment G) ==> ~curve_cell G (squ m)`, (* {{{ proof *) [ REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment]; REWRITE_TAC[SUBSET; edge]; DISCH_ALL_TAC; TSPEC `squ m` 3; USE 3(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;]); ASM_MESON_TAC[]; ]);; (* }}} *) let curve_cell_squ_inter = prove_by_refinement( `!G m. (segment G) ==> (((squ m) INTER (UNIONS (curve_cell G)) = {}))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `cell (squ m)` SUBGOAL_TAC; REWRITE_TAC[cell_rules]; DISCH_TAC; TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC; ASM_MESON_TAC[curve_cell_cell;segment]; DISCH_TAC; ASM_SIMP_TAC [cell_inter]; ASM_MESON_TAC [curve_cell_squ]; ]);; (* }}} *) let curve_point_unions = prove_by_refinement( `!G m. (segment G) ==> (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC; REWRITE_TAC[REWRITE_RULE[not_eq] single_inter]; DISCH_THEN_REWRITE; REWRITE_TAC [not_eq]; IMATCH_MP_TAC cell_inter; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; ASM_MESON_TAC[cell_rules;curve_cell_cell]; ]);; (* }}} *) let curve_cell_not_point = prove_by_refinement( `!G m. (segment G) ==> ((curve_cell G {(pointI m)} <=> ~(num_closure G (pointI m) = 0)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `FINITE G /\ (G SUBSET edge)` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; ASM_SIMP_TAC[curve_cell_point;num_closure0]; ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) let par_cell = jordan_def `par_cell eps G C <=> ((?m. (C = {(pointI m)}) /\ (eps = EVEN (num_lower G m))) \/ (?m. (C = h_edge m) /\ (eps = EVEN (num_lower G m))) \/ (?m. (C = v_edge m) /\ (eps = EVEN (num_lower G m))) \/ (?m. (C = squ m) /\ (eps= EVEN (num_lower G m)))) /\ (C INTER (UNIONS (curve_cell G)) = EMPTY )`;; let par_cell_curve_disj = prove_by_refinement( `!G C eps. (par_cell eps G C) ==> (C INTER (UNIONS (curve_cell G)) = EMPTY )`, (* {{{ proof *) [ REWRITE_TAC[par_cell]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let par_cell_cell = prove_by_refinement( `!G eps. (par_cell eps G SUBSET cell)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;par_cell;even_cell]; DISCH_ALL_TAC; ASM_MESON_TAC[cell_rules]; ]);; (* }}} *) let par_cell_h = prove_by_refinement( `!G m eps. (segment G) ==> ((par_cell eps G (h_edge m) <=> (~(G (h_edge m))) /\ (eps = EVEN (num_lower G m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[par_cell;eq_sing;h_edge_inj;hv_edgeV2;h_edge_pointI;]; REWRITE_TAC[square_h_edgeV2]; ASM_SIMP_TAC[curve_cell_h_inter]; CONV_TAC (dropq_conv "m'"); MESON_TAC[]; ]);; (* }}} *) let par_cell_v = prove_by_refinement( `!G m eps. (segment G) ==> ((par_cell eps G (v_edge m) <=> (~(G (v_edge m))) /\ (eps = EVEN (num_lower G m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[par_cell;eq_sing;v_edge_inj;hv_edgeV2;v_edge_pointI;]; REWRITE_TAC[square_v_edgeV2]; ASM_SIMP_TAC[curve_cell_v_inter]; CONV_TAC (dropq_conv "m'"); MESON_TAC[]; ]);; (* }}} *) let par_cell_squ = prove_by_refinement( `!G m eps. (segment G) ==> ((par_cell eps G (squ m) <=> (eps = EVEN (num_lower G m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[par_cell;eq_sing;square_h_edgeV2;square_v_edgeV2;squ_inj]; ASM_SIMP_TAC[curve_cell_squ_inter]; REWRITE_TAC[square_pointI]; CONV_TAC (dropq_conv "m'"); ]);; (* }}} *) let par_cell_point = prove_by_refinement( `!G m eps. (segment G) ==> ((par_cell eps G {(pointI m)} <=> ((num_closure G (pointI m) = 0) /\ (eps = EVEN (num_lower G m)))))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[par_cell;eq_sing;INR IN_SING;point_inj;]; SUBGOAL_TAC `!u x. ({(pointI u)} = x) <=> (x = {(pointI u)})` ; ASM_MESON_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); REWRITE_TAC[eq_sing;INR IN_SING ;h_edge_pointI; v_edge_pointI; square_pointI;]; REWRITE_TAC[pointI_inj; REWRITE_RULE[not_eq] single_inter]; CONV_TAC (dropq_conv "m'"); ASM_SIMP_TAC [curve_point_unions;curve_cell_not_point]; MESON_TAC[]; ]);; (* }}} *) let eq_sing_sym = prove_by_refinement( `!X (y:A). ({y} = X) <=> X y /\ (!u. X u ==> (u = y))`, (* {{{ proof *) [ ASM_MESON_TAC[eq_sing]; ]);; (* }}} *) let par_cell_disjoint = prove_by_refinement( `!G eps. (par_cell eps G INTER par_cell (~eps) G = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[EQ_EMPTY;INTER ]; REP_GEN_TAC; REWRITE_TAC[par_cell]; REPEAT (REPEAT (LEFT_TAC "m") THEN (GEN_TAC)); REPEAT (LEFT_TAC "m"); REPEAT (REPEAT (LEFT_TAC "m'") THEN (GEN_TAC )); REPEAT (LEFT_TAC ("m'")); REPEAT (REPEAT (LEFT_TAC "m''") THEN (GEN_TAC )); REPEAT (LEFT_TAC ("m''")); LEFT_TAC "m'''" THEN GEN_TAC; LEFT_TAC "m''''" THEN GEN_TAC; LEFT_TAC "m'''''" THEN GEN_TAC; REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; REWRITE_TAC[DE_MORGAN_THM]; REPEAT (CONJ_TAC) THEN (REWRITE_TAC[GSYM DE_MORGAN_THM;GSYM CONJ_ASSOC]) THEN (REWRITE_TAC[TAUT `~(A /\ B) <=> (A ==> ~B)`]) THEN (DISCH_THEN_REWRITE ) THEN (REWRITE_TAC[eq_sing;eq_sing_sym;pointI_inj;h_edge_pointI;v_edge_pointI;square_pointI; INR IN_SING ; hv_edgeV2; h_edge_inj ; v_edge_inj; square_v_edgeV2;square_h_edgeV2;squ_inj ]) THEN (ASM_MESON_TAC[]); ]);; (* }}} *) let par_cell_nonempty = prove_by_refinement( `!G eps. (rectagon G) ==> ~(par_cell eps G = EMPTY)`, (* {{{ proof *) [ DISCH_ALL_TAC; COPY 1; USE 1 (MATCH_MP rectagon_h_edge); CHO 1; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon]; DISCH_TAC ; USE 3(MATCH_MP squ_down); TSPEC `m` 3; USE 3 (REWRITE_RULE[set_lower_n]); UND 3; ASM_REWRITE_TAC[even_cell_squ;]; PROOF_BY_CONTR_TAC; UND 0; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon_segment]; DISCH_TAC ; TYPE_THEN `eps = EVEN (num_lower G m)` ASM_CASES_TAC; TYPE_THEN `squ m` EXISTS_TAC; ASM_SIMP_TAC [par_cell_squ]; TYPE_THEN `squ (down m)` EXISTS_TAC; ASM_SIMP_TAC[par_cell_squ]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_unions_nonempty = prove_by_refinement( `!G eps. (rectagon G) ==> ~(UNIONS (par_cell eps G) = EMPTY)`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[UNIONS;EMPTY_EXISTS ]; NAME_CONFLICT_TAC; DISCH_TAC ; USE 0 (MATCH_MP par_cell_nonempty); TSPEC `eps` 0; USE 0 (REWRITE_RULE[EMPTY_EXISTS]); CHO 0; LEFT_TAC "u'"; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `cell u` SUBGOAL_TAC; ASM_MESON_TAC[par_cell_cell;ISUBSET ]; DISCH_THEN (fun t-> MP_TAC (MATCH_MP cell_nonempty t)); REWRITE_TAC[EMPTY_EXISTS]; ]);; (* }}} *) let ctop = jordan_def `ctop G = induced_top top2 (euclid 2 DIFF (UNIONS (curve_cell G)))`;; let top2_unions = prove_by_refinement( `UNIONS (top2) = (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC [top2]; ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; ]);; (* }}} *) let curve_closed = prove_by_refinement( `!G. (segment G) ==> (closed_ top2 (UNIONS (curve_cell G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[GSYM curve_closure]; IMATCH_MP_TAC closure_closed; REWRITE_TAC[top2_top]; IMATCH_MP_TAC UNIONS_SUBSET; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; REWRITE_TAC[SUBSET;top2_unions;edge; ]; DISCH_ALL_TAC; DISCH_ALL_TAC; TSPEC `A` 1; REWR 1; CHO 1; ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid]; ]);; (* }}} *) let ctop_unions = prove_by_refinement( `!G. UNIONS (ctop G) = (euclid 2 DIFF (UNIONS (curve_cell G)))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[ctop]; REWRITE_TAC[induced_top_support]; REWRITE_TAC[top2_unions]; REWRITE_TAC[INTER;DIFF;]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_partition = prove_by_refinement( `!G eps. (segment G) ==> ((UNIONS (par_cell eps G) UNION (UNIONS (par_cell (~eps) G))) = (UNIONS (ctop G))) `, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM ; CONJ_TAC; REWRITE_TAC[union_subset]; TYPE_THEN `eps` (fun t-> SPEC_TAC (t,t)); RIGHT_TAC "eps"; SUBCONJ_TAC; GEN_TAC; IMATCH_MP_TAC UNIONS_SUBSET; REWRITE_TAC[ctop_unions;DIFF_SUBSET ]; DISCH_ALL_TAC; COPY 1; USE 2(MATCH_MP par_cell_curve_disj); ASM_REWRITE_TAC[]; IMATCH_MP_TAC cell_euclid; ASM_MESON_TAC[par_cell_cell ;ISUBSET ]; DISCH_TAC ; GEN_TAC; TSPEC `~eps` 1; ASM_REWRITE_TAC[]; REWRITE_TAC[ctop_unions;SUBSET ;DIFF ; UNION ; UNIONS ]; DISCH_ALL_TAC; USE 1(MATCH_MP point_onto); CHO 1; ASSUME_TAC cell_unions; TSPEC `p` 3; USE 3 (REWRITE_RULE[UNIONS]); CHO 3; USE 3 (REWRITE_RULE[cell]); AND 3; CHO 4; UND 4; REP_CASES_TAC; NAME_CONFLICT_TAC; ASM_REWRITE_TAC[]; REWR 3; USE 3(REWRITE_RULE[INR IN_SING;pointI;point_inj ;]); ASM_REWRITE_TAC[GSYM pointI]; LEFT_TAC "u'"; TYPE_THEN `{(pointI p')}` EXISTS_TAC; ASM_SIMP_TAC[par_cell_point]; REWRITE_TAC[INR IN_SING]; LEFT 2 "u"; TSPEC `{(pointI p')}` 2; REWR 2; USE 2(REWRITE_RULE[GSYM pointI;INR IN_SING ]); UND 2; ASM_SIMP_TAC [curve_cell_not_point]; MESON_TAC[]; (* case 2 *) LEFT_TAC "u"; TYPE_THEN `h_edge p'` EXISTS_TAC ; ASM_SIMP_TAC [par_cell_h]; LEFT 2 "u"; REWR 3; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TYPE_THEN `(G (h_edge p'))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC ; TSPEC `h_edge p'` 2; ASM_MESON_TAC[curve_cell_h]; (* case 3 *) LEFT_TAC "u"; TYPE_THEN `v_edge p'` EXISTS_TAC ; ASM_SIMP_TAC [par_cell_v]; LEFT 2 "u"; REWR 3; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TYPE_THEN `(G (v_edge p'))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC ; TSPEC `v_edge p'` 2; ASM_MESON_TAC[curve_cell_v]; (* case 4 *) LEFT_TAC "u"; TYPE_THEN `squ p'` EXISTS_TAC ; ASM_SIMP_TAC [par_cell_squ]; LEFT 2 "u"; REWR 3; ASM_REWRITE_TAC[]; MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* openness of par_cell *) (* ------------------------------------------------------------------ *) let par_cell_h_squ = prove_by_refinement( `!G m eps. (segment G) /\ (par_cell eps G (h_edge m)) ==> (par_cell eps G (squ m) /\ par_cell eps G (squ (down m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; ASM_SIMP_TAC [par_cell_h;par_cell_squ]; DISCH_ALL_TAC; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC ; ONCE_REWRITE_TAC [EQ_SYM_EQ]; ASM_SIMP_TAC[num_lower_down]; ASM_MESON_TAC[set_lower_n]; ]);; (* }}} *) let par_cell_v_squ = prove_by_refinement( `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==> (par_cell eps G (squ m) /\ par_cell eps G (squ (left m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon_segment]; ASM_SIMP_TAC [par_cell_v;par_cell_squ]; DISCH_ALL_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par]; ]);; (* }}} *) (* move up *) let segment_finite = prove_by_refinement( `!G. (segment G) ==> (FINITE G)`, (* {{{ proof *) [ ASM_MESON_TAC[segment]; ]);; (* }}} *) let num_closure0_edge = prove_by_refinement( `!G m. (FINITE G) /\ (num_closure G (pointI m) = 0) ==> ~G (v_edge m) /\ ~G (v_edge (down m)) /\ ~G (h_edge m) /\ ~G(h_edge (left m))`, (* {{{ proof *) let rule = REWRITE_RULE[down;left ;h_edge_closure;hc_edge;v_edge_closure;vc_edge;UNION ;plus_e12; INR IN_SING ; INT_ARITH `x -: &:1 +: &:1 = x`] in [ DISCH_ALL_TAC; UND 1; ASM_SIMP_TAC[num_closure0]; DISCH_TAC; REWRITE_TAC[GSYM DE_MORGAN_THM]; PURE_REWRITE_TAC [GSYM IMP_CLAUSES]; REP_CASES_TAC; TSPEC `v_edge m` 1; JOIN 1 2; USE 1(rule); ASM_MESON_TAC[]; TSPEC `v_edge (down m)` 1; JOIN 2 1; USE 1(rule); ASM_MESON_TAC[]; TSPEC `h_edge ( m)` 1; JOIN 1 2; USE 1(rule); ASM_MESON_TAC[]; TSPEC `h_edge (left m)` 1; JOIN 1 2; USE 1(rule); ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_point_h = prove_by_refinement( `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==> (par_cell eps G (h_edge m) /\ par_cell eps G (h_edge (left m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon_segment]; ASM_SIMP_TAC [par_cell_h;par_cell_point]; DISCH_ALL_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par]; UND 1; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[segment_finite]; ASM_MESON_TAC[num_closure0_edge]; ]);; (* }}} *) let par_cell_point_v = prove_by_refinement( `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==> (par_cell eps G (v_edge m) /\ par_cell eps G (v_edge (down m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon_segment]; ASM_SIMP_TAC [par_cell_v;par_cell_point]; DISCH_ALL_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_MESON_TAC[segment_finite]; ASM_SIMP_TAC[num_lower_down]; REWRITE_TAC [set_lower_n]; ASM_MESON_TAC[num_closure0_edge]; ]);; (* }}} *) let par_cell_point_rectangle = prove_by_refinement( `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==> (rectangle (FST m -: &:1,SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET (UNIONS (par_cell eps G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_SIMP_TAC[rectagon_segment]; DISCH_TAC; REWRITE_TAC[two_two_union;union_subset]; CONJ_TAC; TYPE_THEN `rectangle (FST m -: &:1,SND m -: &:1) (FST m,SND m +: &:1) = rectangle (FST (left m),SND (left m) -: &:1) (FST (left m) +: &:1,SND (left m) +: &:1)` SUBGOAL_TAC; REWRITE_TAC[left ;INT_ARITH ` x -: &:1 +: &:1 =x`]; DISCH_THEN_REWRITE; REWRITE_TAC[rectangle_h;union_subset ]; TYPE_THEN `par_cell eps G (h_edge (left m))` SUBGOAL_TAC; ASM_MESON_TAC[par_cell_point_h]; ASM_MESON_TAC[sub_union;par_cell_h_squ]; CONJ_TAC; REWRITE_TAC[long_v_union;union_subset;]; ASM_MESON_TAC[sub_union; par_cell_point_v;]; REWRITE_TAC[rectangle_h;union_subset ]; TYPE_THEN `par_cell eps G (h_edge ( m))` SUBGOAL_TAC; ASM_MESON_TAC[par_cell_point_h]; ASM_MESON_TAC[sub_union;par_cell_h_squ]; ]);; (* }}} *) let par_cell_h_rectangle = prove_by_refinement( `!G m eps. (rectagon G) /\ (par_cell eps G (h_edge m)) ==> (rectangle (FST m ,SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET (UNIONS (par_cell eps G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_SIMP_TAC[rectagon_segment]; DISCH_TAC; REWRITE_TAC[rectangle_h;union_subset ]; ASM_MESON_TAC[sub_union;par_cell_h_squ]; ]);; (* }}} *) let par_cell_v_rectangle = prove_by_refinement( `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==> (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1) SUBSET (UNIONS (par_cell eps G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_SIMP_TAC[rectagon_segment]; DISCH_TAC; REWRITE_TAC[rectangle_v;union_subset ]; ASM_MESON_TAC[sub_union;par_cell_v_squ]; ]);; (* }}} *) let par_cell_squ_rectangle = prove_by_refinement( `!G m eps. (rectagon G) /\ (par_cell eps G (squ m)) ==> (rectangle (FST m ,SND m ) (FST m +: &:1,SND m +: &:1) SUBSET (UNIONS (par_cell eps G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[GSYM rectangle_squ]; IMATCH_MP_TAC sub_union; ASM_REWRITE_TAC[]; ]);; (* }}} *) let par_cell_point_in_rectangle = prove_by_refinement( `!m. (rectangle (FST m -: &:1,SND m -: &:1) (FST m +: &:1,SND m +: &:1) (pointI m))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[two_two_union;UNION ;long_v_union ; INR IN_SING ;]; ]);; (* }}} *) let par_cell_h_in_rectangle = prove_by_refinement( `!m. (h_edge m SUBSET (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[rectangle_h; UNION ; ISUBSET; INR IN_SING ;]; MESON_TAC[]; ]);; (* }}} *) let par_cell_v_in_rectangle = prove_by_refinement( `!m. (v_edge m SUBSET (rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[rectangle_v; UNION ; ISUBSET; INR IN_SING ;]; MESON_TAC[]; ]);; (* }}} *) let ctop_top = prove_by_refinement( `!G. topology_ (ctop G)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[ctop]; IMATCH_MP_TAC induced_top_top; REWRITE_TAC[top2_top]; ]);; (* }}} *) let ctop_open = prove_by_refinement( `!G B eps. (segment G) /\ (B SUBSET UNIONS (par_cell eps G)) /\ (top2 B) ==> (ctop G B)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[ctop;induced_top;IMAGE]; TYPE_THEN `B` EXISTS_TAC; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;GSYM ctop_unions]; ASM_SIMP_TAC[GSYM par_cell_partition]; REWRITE_TAC[UNION;ISUBSET ]; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let par_cell_open = prove_by_refinement( `!G eps. (rectagon G) ==> (ctop G (UNIONS (par_cell eps G )))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_MESON_TAC[rectagon_segment]; DISCH_TAC; ASSUME_TAC ctop_top; TSPEC `G` 2; USE 2(MATCH_MP open_nbd); UND 2; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]) ; GEN_TAC; RIGHT_TAC "B"; DISCH_TAC; USE 2(REWRITE_RULE[UNIONS]); CHO 2; TYPE_THEN `?p. (u = {(pointI p)}) \/ (u = h_edge p) \/ (u = v_edge p) \/ (u = squ p)` SUBGOAL_TAC; AND 2; USE 3 (MATCH_MP (REWRITE_RULE[ISUBSET ]par_cell_cell)); USE 3(REWRITE_RULE[cell]); ASM_REWRITE_TAC[]; DISCH_THEN (CHOOSE_THEN MP_TAC ); ASSUME_TAC rectangle_open; REP_CASES_TAC ; (* 1st case *) REWR 2; USE 2(REWRITE_RULE[INR IN_SING]); ASM_REWRITE_TAC[]; TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; REWRITE_TAC[par_cell_point_in_rectangle]; SUBCONJ_TAC; ASM_SIMP_TAC[par_cell_point_rectangle]; ASM_MESON_TAC[ctop_open]; (* 2nd case *) REWR 2; TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_h_in_rectangle]; SUBCONJ_TAC; ASM_SIMP_TAC[par_cell_h_rectangle]; ASM_MESON_TAC[ctop_open]; (* 3rd case *) REWR 2; TYPE_THEN `rectangle (FST p -: &:1,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_v_in_rectangle]; SUBCONJ_TAC; ASM_SIMP_TAC[par_cell_v_rectangle]; ASM_MESON_TAC[ctop_open]; (* 4th case *) REWR 2; TYPE_THEN `rectangle (FST p,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; ASSUME_TAC rectangle_squ; TSPEC `p` 5; SUBCONJ_TAC; ASM_SIMP_TAC[par_cell_squ_rectangle]; DISCH_TAC; CONJ_TAC; ASM_MESON_TAC[PAIR]; ASM_MESON_TAC[ctop_open]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* start on connected components of ctop G *) (* ------------------------------------------------------------------ *) (* move *) let connected_empty = prove_by_refinement( `!(U:(A->bool)->bool). connected U EMPTY `, (* {{{ proof *) [ REWRITE_TAC[connected]; ]);; (* }}} *) let par_cell_union_disjoint = prove_by_refinement( `!G eps. (UNIONS (par_cell eps G) INTER (UNIONS (par_cell (~eps) G)) = EMPTY )`, (* {{{ proof *) [ REWRITE_TAC[INTER;EQ_EMPTY ;UNIONS;]; DISCH_ALL_TAC; AND 0; CHO 0; CHO 1; TYPE_THEN `cell u /\ cell u'` SUBGOAL_TAC; ASM_MESON_TAC[par_cell_cell;ISUBSET]; DISCH_TAC; TYPE_THEN `u = u'` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; REWRITE_TAC[EMPTY_EXISTS;INTER ]; ASM_MESON_TAC[]; DISCH_TAC; ASSUME_TAC par_cell_disjoint; USE 4(REWRITE_RULE[INTER;EQ_EMPTY]); TYPEL_THEN[`G`;`eps`;`u`] (USE 4 o ISPECL); USE 3 (GSYM); REWR 1; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_comp = prove_by_refinement( `!G eps x. (rectagon G) ==> (component (ctop G) x SUBSET (UNIONS (par_cell eps G))) \/ (component (ctop G) x SUBSET (UNIONS (par_cell (~eps) G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `component (ctop G) x SUBSET (UNIONS (ctop G))` SUBGOAL_TAC; REWRITE_TAC[component_DEF ;SUBSET ;connected ]; MESON_TAC[]; TYPE_THEN `segment G` SUBGOAL_TAC; ASM_MESON_TAC [rectagon_segment]; DISCH_TAC; ASM_SIMP_TAC[GSYM par_cell_partition]; DISCH_TAC; PROOF_BY_CONTR_TAC; USE 3 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]); AND 3; LEFT 3 "x'"; CHO 3; LEFT 4 "x'"; CHO 4; TYPE_THEN `component (ctop G) x x'' /\ component (ctop G) x x' ` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `component (ctop G) x' x'' ` SUBGOAL_TAC; ASM_MESON_TAC[component_symm;component_trans]; DISCH_TAC; USE 6(REWRITE_RULE[component_DEF]); CHO 6; USE 6(REWRITE_RULE[connected]); AND 6; AND 6; AND 7; TYPE_THEN `A = UNIONS (par_cell eps G)` ABBREV_TAC ; TYPE_THEN `B = UNIONS (par_cell (~eps) G)` ABBREV_TAC ; TYPEL_THEN [`A`;`B`] (USE 7 o ISPECL); UND 7; REWRITE_TAC[]; TYPE_THEN `ctop G A /\ ctop G B` SUBGOAL_TAC; ASM_MESON_TAC[par_cell_open]; DISCH_THEN_REWRITE; TYPE_THEN `Z SUBSET (A UNION B)` SUBGOAL_TAC; ASM_MESON_TAC[par_cell_partition]; DISCH_THEN_REWRITE; TYPE_THEN `A INTER B = EMPTY` SUBGOAL_TAC; EXPAND_TAC "A"; EXPAND_TAC "B"; ASM_MESON_TAC[par_cell_union_disjoint;INTER_ACI;]; DISCH_THEN_REWRITE; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) (* move *) let connected_component = prove_by_refinement( `!U Z (x:A). (connected U Z) /\ (Z x) ==> (Z SUBSET (component U x)) `, (* {{{ proof *) [ REWRITE_TAC[component_DEF ;SUBSET ]; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `Z` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let cont_mk_segment = prove_by_refinement( `!x y n. (euclid n x) /\ (euclid n y) ==> (continuous (joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0)) (top_of_metric (UNIV,d_real)) (top_of_metric (euclid n,d_euclid)))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC joinf_cont; CONJ_TAC; IMATCH_MP_TAC const_continuous; IMATCH_MP_TAC top_of_metric_top; REWRITE_TAC[metric_real]; CONJ_TAC; IMATCH_MP_TAC joinf_cont; CONJ_TAC; IMATCH_MP_TAC continuous_lin_combo; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC const_continuous; IMATCH_MP_TAC top_of_metric_top; REWRITE_TAC[metric_real]; BETA_TAC; REDUCE_TAC; REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_rzero ]; REWRITE_TAC[joinf]; REDUCE_TAC; REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero ]; ]);; (* }}} *) let mk_segment_image = prove_by_refinement( `!x y n. (euclid n x) /\ (euclid n y) ==> (?f. (continuous f (top_of_metric(UNIV,d_real)) (top_of_metric (euclid n,d_euclid))) /\ (IMAGE f {t | &.0 <=. t /\ t <=. &.1} = mk_segment x y))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC cont_mk_segment; ASM_REWRITE_TAC[]; REWRITE_TAC[joinf;IMAGE ]; REWRITE_TAC[mk_segment]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; ASM_REWRITE_TAC[]; EQ_TAC; DISCH_TAC; CHO 2; UND 2; COND_CASES_TAC; DISCH_ALL_TAC; JOIN 3 2; ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`]; DISCH_ALL_TAC; UND 5; COND_CASES_TAC; DISCH_TAC; TYPE_THEN `&1 - x''` EXISTS_TAC; SUBCONJ_TAC; UND 5; REAL_ARITH_TAC ; DISCH_TAC; CONJ_TAC; UND 3; REAL_ARITH_TAC ; ONCE_REWRITE_TAC [euclid_add_comm]; REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`]; ASM_MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; CONJ_TAC; REAL_ARITH_TAC ; CONJ_TAC; REAL_ARITH_TAC ; REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; (* 2nd half *) DISCH_TAC; CHO 2; TYPE_THEN `&1 - a` EXISTS_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; AND 2; AND 2; UND 3; UND 4; REAL_ARITH_TAC ; COND_CASES_TAC; ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`]; COND_CASES_TAC; REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; ASM_MESON_TAC [euclid_add_comm]; TYPE_THEN `a = &.0` SUBGOAL_TAC; UND 4; UND 3; AND 2; UND 3; REAL_ARITH_TAC ; DISCH_TAC; REWR 2; REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; ]);; (* }}} *) let euclid_n_convex = prove_by_refinement( `!n. (convex (euclid n))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[convex;mk_segment;SUBSET ]; DISCH_ALL_TAC; DISCH_ALL_TAC; CHO 2; ASM_REWRITE_TAC[]; ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure]; ]);; (* }}} *) let connected_mk_segment = prove_by_refinement( `!x y n. (euclid n x) /\ (euclid n y) ==> (connected (top_of_metric(euclid n,d_euclid)) (mk_segment x y))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `?f. (continuous f (top_of_metric(UNIV,d_real)) (top_of_metric (euclid n,d_euclid))) /\ (IMAGE f {t | &.0 <=. t /\ t <=. &.1} = mk_segment x y)` SUBGOAL_TAC; IMATCH_MP_TAC mk_segment_image; ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; USE 2(GSYM); ASM_REWRITE_TAC[]; IMATCH_MP_TAC connect_image; TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; USE 2(GSYM); ASM_REWRITE_TAC[]; TYPE_THEN `UNIONS (top_of_metric (euclid n,d_euclid) ) = (euclid n)` SUBGOAL_TAC; ASM_MESON_TAC [top_of_metric_unions;metric_euclid]; DISCH_THEN_REWRITE; ASM_MESON_TAC[convex;euclid_n_convex]; MATCH_ACCEPT_TAC connect_real; ]);; (* }}} *) let ctop_open = prove_by_refinement( `!G A. (top2 A /\ (A SUBSET (UNIONS (ctop G))) ==> ctop G A)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[ctop;induced_top;IMAGE ]; TYPE_THEN `A` EXISTS_TAC; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION]; REWRITE_TAC[GSYM ctop_unions]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let ctop_top2 = prove_by_refinement( `!G A. (segment G /\ ctop G A ==> top2 A)`, (* {{{ proof *) [ REWRITE_TAC[ctop;induced_top;IMAGE ;]; DISCH_ALL_TAC; TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ; TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC; EXPAND_TAC "U"; ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; CHO 1; DISCH_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC top_inter; ASM_REWRITE_TAC[top2_top;]; ASM_SIMP_TAC[GSYM curve_closure;top2]; IMATCH_MP_TAC (REWRITE_RULE[open_DEF] closed_open); IMATCH_MP_TAC closure_closed; CONJ_TAC; EXPAND_TAC "U"; ASM_MESON_TAC[top_of_metric_top;metric_euclid]; USE 3(GSYM); ASM_REWRITE_TAC[]; IMATCH_MP_TAC UNIONS_SUBSET; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; REWRITE_TAC[edge;ISUBSET;]; DISCH_ALL_TAC; DISCH_ALL_TAC; TSPEC `A'` 4; REWR 4; CHO 4; UND 4; DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] ; MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] v_edge_euclid); MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] h_edge_euclid); ]);; (* }}} *) let mk_segment_sym_lemma = prove_by_refinement( `!x y z. (mk_segment x y z ==> mk_segment y x z)`, (* {{{ proof *) [ REWRITE_TAC[mk_segment]; DISCH_ALL_TAC; CHO 0; TYPE_THEN `&1 - a` EXISTS_TAC; CONJ_TAC; ASM_MESON_TAC[REAL_ARITH `a <= &1 ==> &0 <= &1 - a`]; CONJ_TAC; ASM_MESON_TAC[REAL_ARITH `&0 <= a ==> &1 - a <= &1`]; ONCE_REWRITE_TAC[euclid_add_comm]; ASM_REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; ]);; (* }}} *) let mk_segment_sym = prove_by_refinement( `!x y. (mk_segment x y = mk_segment y x)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; EQ_TAC THEN ASM_MESON_TAC[mk_segment_sym_lemma]; ]);; (* }}} *) let mk_segment_end = prove_by_refinement( `!x y. (mk_segment x y x /\ mk_segment x y y)`, (* {{{ proof *) [ RIGHT_TAC "y"; RIGHT_TAC "x"; SUBCONJ_TAC; DISCH_ALL_TAC; REWRITE_TAC[mk_segment]; TYPE_THEN `&1` EXISTS_TAC; REDUCE_TAC; CONJ_TAC; ARITH_TAC; REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; DISCH_TAC; ONCE_REWRITE_TAC[mk_segment_sym]; ASM_MESON_TAC[]; ]);; (* }}} *) let convex_connected = prove_by_refinement( `!G Z. (segment G /\ convex Z) /\ (Z SUBSET (UNIONS (ctop G))) ==> (connected (ctop G) Z)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[connected]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; USE 7 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]); AND 7; LEFT 7 "x"; CHO 7; LEFT 8 "x"; CHO 8; TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC; USE 1(REWRITE_RULE[convex]); ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC; IMATCH_MP_TAC connected_mk_segment; USE 2(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]); ASM_MESON_TAC[]; REWRITE_TAC[connected]; DISCH_ALL_TAC; AND 11; TYPEL_THEN [`A`;`B`] (USE 11 o ISPECL); REWR 11; TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC; REWRITE_TAC[GSYM top2]; ASM_MESON_TAC[ctop_top2;top2]; DISCH_TAC; UND 11; ASM_REWRITE_TAC[]; REWRITE_TAC[DE_MORGAN_THM;ISUBSET;]; CONJ_TAC; LEFT_TAC "x''"; TYPE_THEN `x'` EXISTS_TAC; REWRITE_TAC[mk_segment_end]; ASM_MESON_TAC[]; LEFT_TAC "x''"; TYPE_THEN `x` EXISTS_TAC; REWRITE_TAC[mk_segment_end]; ASM_MESON_TAC[]; ]);; (* }}} *) let component_replace = prove_by_refinement( `!U (x:A) y. component U x y ==> (component U x = component U y)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; USE 0(MATCH_MP component_symm); ASM_MESON_TAC[component_trans]; ASM_MESON_TAC[component_trans;component_symm]; ]);; (* }}} *) let convex_component = prove_by_refinement( `!G Z x. (segment G /\ convex Z /\ (Z SUBSET (UNIONS (ctop G))) /\ (~(Z INTER (component (ctop G) x ) = EMPTY)) ==> (Z SUBSET (component (ctop G) x))) `, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC; ASM_SIMP_TAC[convex_connected]; DISCH_TAC; USE 3(REWRITE_RULE[EMPTY_EXISTS;INTER ]); CHO 3; AND 3; USE 3(MATCH_MP component_replace); ASM_REWRITE_TAC[]; IMATCH_MP_TAC connected_component; ASM_REWRITE_TAC[]; ]);; (* }}} *) let cell_convex = prove_by_refinement( `!C. (cell C) ==> (convex C)`, (* {{{ proof *) [ REWRITE_TAC[cell]; GEN_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC ) THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[v_edge_convex;h_edge_convex;convex_pointI;rectangle_squ;rectangle_convex]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) let cell_of = jordan_def `cell_of C = { A | (cell A) /\ (A SUBSET C) }`;; let unions_cell_of = prove_by_refinement( `!G x. (segment G ==> (UNIONS (cell_of (component (ctop G) x)) = component (ctop G) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; REWRITE_TAC[UNIONS;SUBSET;cell_of]; CONJ_TAC; DISCH_ALL_TAC; CHO 1; AND 1; ASM_MESON_TAC[]; DISCH_ALL_TAC; TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC; UND 1; REWRITE_TAC[component_DEF ;connected;SUBSET ;ctop_unions;DIFF ]; DISCH_THEN CHOOSE_TAC; ASM_MESON_TAC[]; DISCH_TAC; USE 2 (MATCH_MP point_onto); CHO 2; REWR 1; ASM_REWRITE_TAC[]; ASSUME_TAC cell_unions; TSPEC `p` 3; USE 3 (REWRITE_RULE[UNIONS]); CHO 3; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `u SUBSET (component (ctop G) x) ==> (!x'. u x' ==> component (ctop G) x x')` SUBGOAL_TAC; REWRITE_TAC[ISUBSET]; ASM_REWRITE_TAC[]; DISCH_THEN IMATCH_MP_TAC ; IMATCH_MP_TAC convex_component ; ASM_REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; ASM_MESON_TAC[cell_convex]; CONJ_TAC; REWRITE_TAC[ctop_unions]; REWRITE_TAC[DIFF;SUBSET ]; DISCH_ALL_TAC; CONJ_TAC; AND 3; UND 5; UND 4; ASM_MESON_TAC[cell_euclid;ISUBSET]; REWRITE_TAC[UNIONS]; LEFT_TAC "u"; GEN_TAC; DISCH_ALL_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; USE 6 (MATCH_MP curve_cell_cell); USE 6 (REWRITE_RULE[ISUBSET]); TSPEC `u'` 6; REWR 6; TYPE_THEN `u = u'` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; REWRITE_TAC[EMPTY_EXISTS;INTER]; ASM_MESON_TAC[]; DISCH_TAC; USE 1 (REWRITE_RULE[component_DEF;connected;SUBSET ]); TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC; ASM_MESON_TAC[]; REWRITE_TAC[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ]; DISJ2_TAC ; ASM_MESON_TAC[]; NAME_CONFLICT_TAC; TYPE_THEN `point p` EXISTS_TAC; ASM_REWRITE_TAC [INTER]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION F *) (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) (* num_abs_of_int *) (* ------------------------------------------------------------------ *) let num_abs_of_int_exists = prove_by_refinement( `!m. ?i. &i = abs (real_of_int(m))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[GSYM int_abs_th]; ASSUME_TAC dest_int_rep; TSPEC `||: m` 0; CHO 0; TYPE_THEN `n` EXISTS_TAC; UND 0; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; WITH 0 (REWRITE_RULE[int_abs_th]); TYPE_THEN `&0 <= abs (real_of_int m)` SUBGOAL_TAC; REWRITE_TAC[REAL_ABS_POS]; TYPE_THEN `abs (real_of_int m) <= &.0` SUBGOAL_TAC; ASM_REWRITE_TAC[]; REDUCE_TAC ; ASM_REWRITE_TAC[]; REAL_ARITH_TAC ; ]);; (* }}} *) let num_abs_of_int_select = new_definition `num_abs_of_int m = @i. (&i = abs (real_of_int m))`;; let num_abs_of_int_th = prove_by_refinement( `!m. &(num_abs_of_int m) = abs (real_of_int m)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[num_abs_of_int_select]; SELECT_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[num_abs_of_int_exists]; ]);; (* }}} *) let num_abs_of_int_mul = prove_by_refinement( `!m n. (num_abs_of_int (m * n) = num_abs_of_int m * num_abs_of_int n)`, (* {{{ proof *) [ REWRITE_TAC[GSYM REAL_OF_NUM_EQ;GSYM REAL_MUL;num_abs_of_int_th;int_mul_th;ABS_MUL;]; ]);; (* }}} *) let num_abs_of_int_num = prove_by_refinement( `!n. (num_abs_of_int (&: n) = n)`, (* {{{ proof *) [ REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_of_num_th;REAL_ABS_NUM;]; ]);; (* }}} *) let num_abs_of_int_triangle = prove_by_refinement( `!n m. num_abs_of_int (m + n) <=| num_abs_of_int(m) +| num_abs_of_int n`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_LE;num_abs_of_int_th;int_add_th;GSYM REAL_OF_NUM_ADD;ABS_TRIANGLE;]; ]);; (* }}} *) let num_abs_of_int0 = prove_by_refinement( `!m. (num_abs_of_int m = 0) <=> (m = &:0)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;REAL_ABS_ZERO;]; REWRITE_TAC[int_eq;]; REWRITE_TAC[int_of_num_th;]; ]);; (* }}} *) let num_abs_of_int_neg = prove_by_refinement( `!m. (num_abs_of_int (--: m) = num_abs_of_int m)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_neg_th;REAL_ABS_NEG;]; ]);; (* }}} *) let num_abs_of_int_suc = prove_by_refinement( `!m. (&:0 <=: m) ==> (SUC (num_abs_of_int m) = num_abs_of_int (m +: &:1))`, (* {{{ proof *) [ REWRITE_TAC[int_le;int_of_num_th;]; DISCH_ALL_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc]; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let num_abs_of_int_pre = prove_by_refinement( `!m. (m <=: &:0) ==> (SUC (num_abs_of_int m) = num_abs_of_int (m -: &:1))`, (* {{{ proof *) [ REWRITE_TAC[int_le;int_of_num_th;]; DISCH_ALL_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc;int_sub_th;int_of_num_th;]; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* closure of squares *) (* ------------------------------------------------------------------ *) let right_left = prove_by_refinement( `!m. (right (left m) = m) /\ (left (right m) = m) /\ (up (down m) = m) /\ (down (up m) = m) /\ (up (right m) = right (up m)) /\ (up (left m) = left (up m)) /\ (down (right m) = right (down m)) /\ (down (left m) = (left (down m)))`, (* {{{ proof *) [ REWRITE_TAC[right ;left ;up;down;PAIR_SPLIT]; INT_ARITH_TAC; ]);; (* }}} *) let squc = jordan_def `squc p = {Z | ?u v. (Z = point (u,v)) /\ real_of_int (FST p) <= u /\ u <= real_of_int (FST p +: &:1) /\ real_of_int (SND p) <= v /\ v <= real_of_int (SND p +: &:1)}`;; let squc_inter = prove_by_refinement( `!p. squc p = {z | ?r. (z = point r) /\ real_of_int (FST p) <= FST r} INTER {z | ?r. (z = point r) /\ real_of_int (SND p) <= SND r} INTER {z | ?r. (z = point r) /\ FST r <= real_of_int (FST p +: &:1)} INTER {z | ?r. (z = point r) /\ SND r <= real_of_int (SND p +: &:1)}`, (* {{{ proof *) [ REWRITE_TAC[squc]; GEN_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER]; EQ_TAC; DISCH_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[point_inj;]; CONV_TAC (dropq_conv "r"); ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "r"); ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "r'"); ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "r"); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; CHO 0; AND 0; REWR 1; REWRITE_TAC[point_inj;PAIR_SPLIT ;]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); USE 1 (REWRITE_RULE[point_inj;]); USE 1 (CONV_RULE (dropq_conv "r'")); REWR 2; USE 2 (REWRITE_RULE[point_inj;]); USE 2 (CONV_RULE (dropq_conv "r'")); REWR 3; USE 3 (REWRITE_RULE[point_inj;]); USE 3 (CONV_RULE (dropq_conv "r'")); ASM_REWRITE_TAC[]; ]);; (* }}} *) let squc_closed = prove_by_refinement( `!p. closed_ (top2) (squc p)`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC top2_top; REWRITE_TAC[squc_inter]; ASM_SIMP_TAC[closed_inter2;closed_half_plane2D_LTS_closed;closed_half_plane2D_SLT_closed;closed_half_plane2D_LTF_closed;closed_half_plane2D_FLT_closed]; ]);; (* }}} *) let squ_subset_sqc = prove_by_refinement( `!p. (squ p SUBSET (squc p))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[SUBSET;squ;squc]; GEN_TAC; DISCH_ALL_TAC; CHO 0; CHO 0; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_MESON_TAC[REAL_ARITH `x < y ==> x <=. y`]; ]);; (* }}} *) let squc_union_lemma1 = prove_by_refinement( `!p. squc p INTER {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} = {(pointI p)} UNION (v_edge p) UNION {(pointI (up p))}`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[squc;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;]; EQ_TAC; DISCH_ALL_TAC; CHO 0; CHO 0; REWR 1; USE 1(REWRITE_RULE[point_inj]); USE 1(CONV_RULE (dropq_conv "r")); UND 0; DISCH_ALL_TAC; UND 4; UND 5; REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`]; KILL 2; KILL 3; KILL 0; USE 1 (GSYM); ASM_REWRITE_TAC[]; KILL 0; REP_CASES_TAC; ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`]; EXPAND_TAC "v"; REWRITE_TAC[pointI;int_suc;]; ASM_REWRITE_TAC[pointI]; REWRITE_TAC[v_edge]; DISJ2_TAC ; DISJ1_TAC ; REWRITE_TAC[point_inj; PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v'"); ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[int_suc]; REP_CASES_TAC; ASM_REWRITE_TAC[pointI;point_inj;]; CONJ_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REAL_ARITH_TAC ; CONV_TAC (dropq_conv "r"); USE 0 (REWRITE_RULE[v_edge]); CHO 0; CHO 0; ASM_REWRITE_TAC[]; REWRITE_TAC[point_inj]; CONJ_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v'"); AND 0; UND 0; REWRITE_TAC[int_suc]; REAL_ARITH_TAC ; CONV_TAC (dropq_conv "r"); (* LAST *) ASM_REWRITE_TAC[pointI;point_inj;]; CONJ_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REWRITE_TAC[int_suc]; REAL_ARITH_TAC ; CONV_TAC (dropq_conv "r"); ]);; (* }}} *) let squc_union_lemma2 = prove_by_refinement( `!p. squc p INTER {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} = {(pointI (right p))} UNION (v_edge (right p)) UNION {(pointI (up (right p)))}`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[squc;right ;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;]; EQ_TAC; DISCH_ALL_TAC; CHO 0; CHO 0; REWR 1; USE 1(REWRITE_RULE[point_inj]); USE 1(CONV_RULE (dropq_conv "r")); UND 0; DISCH_ALL_TAC; UND 4; UND 5; REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`]; KILL 2; KILL 3; KILL 0; USE 1 (GSYM); ASM_REWRITE_TAC[]; KILL 0; REP_CASES_TAC; ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`]; EXPAND_TAC "v"; REWRITE_TAC[pointI;int_suc;]; (* 3 LEFT *) ASM_REWRITE_TAC[pointI;int_suc;]; (* 2 LEFT *) REWRITE_TAC[v_edge]; DISJ2_TAC ; DISJ1_TAC ; REWRITE_TAC[point_inj; PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); REWRITE_TAC[int_suc]; CONV_TAC (dropq_conv "v'"); ASM_REWRITE_TAC[]; (* second half *) ASM_REWRITE_TAC[int_suc]; REP_CASES_TAC; ASM_REWRITE_TAC[pointI;point_inj;]; CONJ_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); ASM_REWRITE_TAC[int_suc]; REAL_ARITH_TAC ; CONV_TAC (dropq_conv "r"); REWRITE_TAC[int_suc]; (* 2 LEFT *) USE 0 (REWRITE_RULE[v_edge]); CHO 0; CHO 0; ASM_REWRITE_TAC[]; REWRITE_TAC[point_inj]; CONJ_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v'"); AND 0; UND 0; REWRITE_TAC[int_suc]; REAL_ARITH_TAC ; CONV_TAC (dropq_conv "r"); REWRITE_TAC[int_suc]; (* LAST *) ASM_REWRITE_TAC[pointI;point_inj;]; CONJ_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REWRITE_TAC[int_suc]; REAL_ARITH_TAC ; CONV_TAC (dropq_conv "r"); REWRITE_TAC[int_suc]; ]);; (* }}} *) let squc_union_lemma3 = prove_by_refinement( `!p. squc p INTER {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\ (real_of_int(FST p) <. FST r) } = (h_edge p) UNION squ p UNION (h_edge (up p))`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER;squc;UNION;]; EQ_TAC; DISCH_ALL_TAC; CHO 0; CHO 0; REWR 1; USE 1 (REWRITE_RULE[point_inj]); USE 1 (CONV_RULE (dropq_conv "r")); AND 0; UND 0; DISCH_ALL_TAC; KILL 0; KILL 3; UND 4; UND 5; REWRITE_TAC[REAL_ARITH `(x <= y) <=> (y = x) \/ (x <. y)`;int_suc]; REP_CASES_TAC; ASM_MESON_TAC[REAL_ARITH `~(v = v + &1)`]; EXPAND_TAC "v"; REWRITE_TAC[up;h_edge]; DISJ2_TAC; DISJ2_TAC; REWRITE_TAC[point_inj;]; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u'"); CONV_TAC (dropq_conv "v"); ASM_REWRITE_TAC[int_suc]; (* 3 to go *) ASM_REWRITE_TAC[]; DISJ1_TAC; REWRITE_TAC[h_edge;point_inj;PAIR_SPLIT]; CONV_TAC (dropq_conv "u'"); CONV_TAC (dropq_conv "v"); ASM_REWRITE_TAC[int_suc]; (* 2 to go *) DISJ2_TAC; DISJ1_TAC; REWRITE_TAC[squ;point_inj;PAIR_SPLIT]; CONV_TAC (dropq_conv "u'"); CONV_TAC (dropq_conv "v'"); ASM_REWRITE_TAC[int_suc]; (* 2nd half *) DISCH_TAC; TYPE_THEN `?q. x = point q` ASM_CASES_TAC; CHO 1; ASM_REWRITE_TAC[point_inj]; CONJ_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REWR 0; UND 0; REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;]; REP_CASES_TAC; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); UND 0; REAL_ARITH_TAC ; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); UND 0; REAL_ARITH_TAC ; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); UND 0; REAL_ARITH_TAC ; CONV_TAC (dropq_conv "r"); REWR 0; UND 0; REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;]; REP_CASES_TAC; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); UND 0; REAL_ARITH_TAC ; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); UND 0; REAL_ARITH_TAC ; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); UND 0; REAL_ARITH_TAC ; (* 1 goal LEFT *) PROOF_BY_CONTR_TAC; KILL 2; UND 1; REWRITE_TAC[]; IMATCH_MP_TAC point_onto; ASM_MESON_TAC[h_edge_euclid;squ_euclid;v_edge_euclid;ISUBSET ]; ]);; (* }}} *) let squc_lemma4 = prove_by_refinement( `!p. squc p SUBSET {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\ (real_of_int(FST p) <. FST r) } `, (* {{{ proof *) [ REWRITE_TAC[SUBSET;UNION ;squc ]; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[point_inj ;]; LEFT_TAC "r"; CONV_TAC (dropq_conv "r"); UND 0; DISCH_ALL_TAC; UND 1; UND 2; ASM_REWRITE_TAC[int_suc]; REAL_ARITH_TAC ; ]);; (* }}} *) let squc_union = prove_by_refinement( `!p. squc p = {(pointI p)} UNION {(pointI (right p))} UNION {(pointI (up p))} UNION {(pointI (up (right p)))} UNION (h_edge p) UNION (h_edge (up p)) UNION (v_edge p) UNION (v_edge (right p)) UNION (squ p)`, (* {{{ proof *) [ GEN_TAC; TYPE_THEN `squc p = squc p INTER ({z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\ (real_of_int(FST p) <. FST r) } )` SUBGOAL_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; REWRITE_TAC [GSYM SUBSET_INTER_ABSORPTION]; MATCH_ACCEPT_TAC squc_lemma4; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[squc_union_lemma1;squc_union_lemma2;squc_union_lemma3]; REWRITE_TAC[UNION_ACI]; ]);; (* }}} *) let squ_closure_h = prove_by_refinement( `!p. (h_edge p) SUBSET (closure top2 (squ p))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;]; DISCH_ALL_TAC; ASM_REWRITE_TAC[top2]; IMATCH_MP_TAC closure_segment; ASM_REWRITE_TAC[squ_euclid]; TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; IMATCH_MP_TAC point_onto; ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid]; DISCH_TAC; CHO 1; REWR 0; KILL 1; TYPE_THEN `point (FST q, SND q + &1)` EXISTS_TAC; REWRITE_TAC[point_scale;point_add;]; UND 0; TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; REWRITE_TAC[]; DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); PURE_REWRITE_TAC[point_add;point_scale]; REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;]; DISCH_ALL_TAC; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); DISCH_ALL_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); UND 0; REWRITE_TAC[int_suc]; ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); ASM_REWRITE_TAC[]; REDUCE_TAC; ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`); ASM_REWRITE_TAC[]; REDUCE_TAC; UND 1; UND 2; REDUCE_TAC ; REAL_ARITH_TAC; ]);; (* }}} *) let squ_closure_up_h = prove_by_refinement( `!p. (h_edge (up p)) SUBSET (closure top2 (squ p))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;up ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[top2]; IMATCH_MP_TAC closure_segment; ASM_REWRITE_TAC[squ_euclid]; TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; IMATCH_MP_TAC point_onto; ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid]; DISCH_TAC; CHO 1; REWR 0; KILL 1; TYPE_THEN `point (FST q , SND q - &1)` EXISTS_TAC; REWRITE_TAC[point_scale;point_add;]; UND 0; TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; REWRITE_TAC[]; DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); PURE_REWRITE_TAC[point_add;point_scale]; REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;]; DISCH_ALL_TAC; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); DISCH_ALL_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); UND 0; REWRITE_TAC[int_suc]; ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); ASM_REWRITE_TAC[]; REDUCE_TAC; ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`); ASM_REWRITE_TAC[]; REDUCE_TAC; UND 1; UND 2; REDUCE_TAC ; REAL_ARITH_TAC; ]);; (* }}} *) let squ_closure_down_h = prove_by_refinement( `!p. (h_edge p SUBSET (closure top2 (squ (down p))))`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC squ_closure_up_h ; TSPEC `down p` 0; USE 0 (REWRITE_RULE [right_left]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let squ_closure_v = prove_by_refinement( `!p. (v_edge p) SUBSET (closure top2 (squ p))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;]; DISCH_ALL_TAC; ASM_REWRITE_TAC[top2]; IMATCH_MP_TAC closure_segment; ASM_REWRITE_TAC[squ_euclid]; TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; IMATCH_MP_TAC point_onto; ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid]; DISCH_TAC; CHO 1; REWR 0; KILL 1; TYPE_THEN `point (FST q + &1, SND q )` EXISTS_TAC; REWRITE_TAC[point_scale;point_add;]; UND 0; TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; REWRITE_TAC[]; DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); PURE_REWRITE_TAC[point_add;point_scale]; REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;]; DISCH_ALL_TAC; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); DISCH_ALL_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); UND 0; REWRITE_TAC[int_suc]; ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); ASM_REWRITE_TAC[]; REDUCE_TAC; ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`); ASM_REWRITE_TAC[]; REDUCE_TAC; UND 1; UND 2; REDUCE_TAC ; REAL_ARITH_TAC; ]);; (* }}} *) let squ_closure_right_v = prove_by_refinement( `!p. (v_edge (right p)) SUBSET (closure top2 (squ p))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;right ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[top2]; IMATCH_MP_TAC closure_segment; ASM_REWRITE_TAC[squ_euclid]; TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; IMATCH_MP_TAC point_onto; ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid]; DISCH_TAC; CHO 1; REWR 0; KILL 1; TYPE_THEN `point (FST q - &1 , SND q )` EXISTS_TAC; REWRITE_TAC[point_scale;point_add;]; UND 0; TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; REWRITE_TAC[]; DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); PURE_REWRITE_TAC[point_add;point_scale]; REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;]; DISCH_ALL_TAC; USE 0 (CONV_RULE (dropq_conv "u")); USE 0 (CONV_RULE (dropq_conv "v")); DISCH_ALL_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); UND 0; REWRITE_TAC[int_suc]; ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); ASM_REWRITE_TAC[]; REDUCE_TAC; ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`); ASM_REWRITE_TAC[]; REDUCE_TAC; UND 1; UND 2; REDUCE_TAC ; REAL_ARITH_TAC; ]);; (* }}} *) let squ_closure_left_v = prove_by_refinement( `!p. (v_edge p SUBSET (closure top2 (squ (left p))))`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC squ_closure_right_v; TSPEC `left p` 0; USE 0 (REWRITE_RULE[right_left]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let squ_closure_hc = prove_by_refinement( `!p. (hc_edge p) SUBSET (closure top2 (squ p))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[GSYM h_edge_closure]; IMATCH_MP_TAC closure_subset; ASSUME_TAC top2_top; ASM_REWRITE_TAC[squ_closure_h]; IMATCH_MP_TAC closure_closed; ASM_REWRITE_TAC[top2_unions;squ_euclid]; ]);; (* }}} *) let squ_closure_up_hc = prove_by_refinement( `!p. (hc_edge (up p)) SUBSET (closure top2 (squ p))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[GSYM h_edge_closure]; IMATCH_MP_TAC closure_subset; ASSUME_TAC top2_top; ASM_REWRITE_TAC[squ_closure_up_h]; IMATCH_MP_TAC closure_closed; ASM_REWRITE_TAC[top2_unions;squ_euclid]; ]);; (* }}} *) let squ_closure_vc = prove_by_refinement( `!p. (vc_edge p) SUBSET (closure top2 (squ p))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[GSYM v_edge_closure]; IMATCH_MP_TAC closure_subset; ASSUME_TAC top2_top; ASM_REWRITE_TAC[squ_closure_v]; IMATCH_MP_TAC closure_closed; ASM_REWRITE_TAC[top2_unions;squ_euclid]; ]);; (* }}} *) let squ_closure = prove_by_refinement( `!p. (closure top2 (squ p)) = (squc p)`, (* {{{ proof *) [ DISCH_ALL_TAC; ASSUME_TAC top2_top; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC closure_subset; ASM_REWRITE_TAC[squc_closed]; REWRITE_TAC[squc_union]; REWRITE_TAC[SUBSET;UNION]; ASM_MESON_TAC[]; REWRITE_TAC[squc_union]; REWRITE_TAC[union_subset]; ASSUME_TAC squ_closure_hc; TSPEC `p` 1; ASSUME_TAC squ_closure_up_hc; TSPEC `p` 2; USE 1 (REWRITE_RULE[hc_edge;plus_e12;union_subset]); USE 2 (REWRITE_RULE[hc_edge;plus_e12;up;union_subset]); ASM_REWRITE_TAC [up;right;squ_closure_v;REWRITE_RULE[right ] squ_closure_right_v ]; ASM_SIMP_TAC[subset_closure]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* adj_edge *) (* ------------------------------------------------------------------ *) let adj_edge = jordan_def `adj_edge x y <=> (~(x = y)) /\ (?e. (edge e) /\ (e SUBSET (closure top2 x)) /\ (e SUBSET (closure top2 y)))`;; let adj_edge_sym = prove_by_refinement( `!x y. (adj_edge x y = adj_edge y x)`, (* {{{ proof *) [ REWRITE_TAC[adj_edge]; MESON_TAC[]; ]);; (* }}} *) let adj_edge_left = prove_by_refinement( `!m. (adj_edge (squ m) (squ (left m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[adj_edge]; REWRITE_TAC[squ_closure;squ_inj;]; CONJ_TAC; REWRITE_TAC[left ;PAIR_SPLIT;]; INT_ARITH_TAC; TYPE_THEN `v_edge m` EXISTS_TAC; REWRITE_TAC[edge;v_edge_inj;]; CONV_TAC (dropq_conv "m'"); REWRITE_TAC[squc_union; SUBSET;UNION ;]; REWRITE_TAC[right_left]; ASM_MESON_TAC[]; ]);; (* }}} *) let adj_edge_right = prove_by_refinement( `!m. (adj_edge (squ m) (squ (right m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[adj_edge]; REWRITE_TAC[squ_closure;squ_inj;]; CONJ_TAC; REWRITE_TAC[right ;PAIR_SPLIT;]; INT_ARITH_TAC; TYPE_THEN `v_edge (right m)` EXISTS_TAC; REWRITE_TAC[edge;v_edge_inj;]; CONV_TAC (dropq_conv "m'"); REWRITE_TAC[squc_union; SUBSET;UNION ;]; ASM_MESON_TAC[]; ]);; (* }}} *) let adj_edge_down = prove_by_refinement( `!m. (adj_edge (squ m) (squ (down m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[adj_edge]; REWRITE_TAC[squ_closure;squ_inj;]; CONJ_TAC; REWRITE_TAC[down ;PAIR_SPLIT;]; INT_ARITH_TAC; TYPE_THEN `h_edge m` EXISTS_TAC; REWRITE_TAC[edge;h_edge_inj;]; CONV_TAC (dropq_conv "m'"); REWRITE_TAC[squc_union; SUBSET;UNION ;]; REWRITE_TAC[right_left]; ASM_MESON_TAC[]; ]);; (* }}} *) let adj_edge_right = prove_by_refinement( `!m. (adj_edge (squ m) (squ (up m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[adj_edge]; REWRITE_TAC[squ_closure;squ_inj;]; CONJ_TAC; REWRITE_TAC[up ;PAIR_SPLIT;]; INT_ARITH_TAC; TYPE_THEN `h_edge (up m)` EXISTS_TAC; REWRITE_TAC[edge;h_edge_inj;]; CONV_TAC (dropq_conv "m'"); REWRITE_TAC[squc_union; SUBSET;UNION ;]; ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* components *) (* ------------------------------------------------------------------ *) let rectangle_euclid = prove_by_refinement( `!p q. (rectangle p q SUBSET (euclid 2))`, (* {{{ proof *) [ REWRITE_TAC[rectangle;SUBSET ;]; DISCH_ALL_TAC; CHO 0; CHO 0; ASM_REWRITE_TAC[euclid_point]; ]);; (* }}} *) let component_unions = prove_by_refinement( `!U (x:A). (component U x SUBSET (UNIONS U))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET; component_DEF; connected ;]; ASM_MESON_TAC[]; ]);; (* }}} *) let comp_h_rect = prove_by_refinement( `!G m x. (segment G /\ (h_edge m SUBSET component (ctop G) x)) ==> (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC convex_component; ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; CONJ_TAC; REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;]; DISCH_ALL_TAC; AND 2; TYPE_THEN `~(squ (down m) x') /\ ~(squ m x')` SUBGOAL_TAC; USE 0(MATCH_MP curve_cell_squ_inter); COPY 0; TSPEC `m` 0; TSPEC `down m` 4; UND 4; UND 0; REWRITE_TAC [EQ_EMPTY; INTER]; ASM_MESON_TAC[]; DISCH_ALL_TAC; REWR 3; TYPE_THEN `h_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `component (ctop G) x` EXISTS_TAC; ASM_REWRITE_TAC[component_unions]; REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; h_edge_euclid; INTER;]; ASM_MESON_TAC[]; REWRITE_TAC[rectangle_h; EMPTY_EXISTS; UNION ; INTER;]; USE 1 (REWRITE_RULE[SUBSET]); TYPE_THEN `~(h_edge m = EMPTY)` SUBGOAL_TAC ; IMATCH_MP_TAC cell_nonempty; REWRITE_TAC[cell_rules]; REWRITE_TAC[EMPTY_EXISTS]; DISCH_TAC; CHO 2; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let comp_v_rect = prove_by_refinement( `!G m x. (segment G /\ (v_edge m SUBSET component (ctop G) x)) ==> (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC convex_component; ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; CONJ_TAC; REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;]; DISCH_ALL_TAC; AND 2; TYPE_THEN `~(squ (left m) x') /\ ~(squ m x')` SUBGOAL_TAC; USE 0(MATCH_MP curve_cell_squ_inter); COPY 0; TSPEC `m` 0; TSPEC `left m` 4; UND 4; UND 0; REWRITE_TAC [EQ_EMPTY; INTER]; ASM_MESON_TAC[]; DISCH_ALL_TAC; REWR 3; TYPE_THEN `v_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `component (ctop G) x` EXISTS_TAC; ASM_REWRITE_TAC[component_unions]; REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; v_edge_euclid; INTER;]; ASM_MESON_TAC[]; REWRITE_TAC[rectangle_v; EMPTY_EXISTS; UNION ; INTER;]; USE 1 (REWRITE_RULE[SUBSET]); TYPE_THEN `~(v_edge m = EMPTY)` SUBGOAL_TAC ; IMATCH_MP_TAC cell_nonempty; REWRITE_TAC[cell_rules]; REWRITE_TAC[EMPTY_EXISTS]; DISCH_TAC; CHO 2; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let long_v_convex = prove_by_refinement( `!p. (convex (long_v p))`, (* {{{ proof *) [ REWRITE_TAC[long_v_inter]; GEN_TAC; IMATCH_MP_TAC convex_inter; REWRITE_TAC[line2D_F_convex]; IMATCH_MP_TAC convex_inter; REWRITE_TAC[open_half_plane2D_LTS_convex;open_half_plane2D_SLT_convex]; ]);; (* }}} *) let long_v_euclid = prove_by_refinement( `!p. (long_v p SUBSET (euclid 2))`, (* {{{ proof *) [ REWRITE_TAC[long_v_union;union_subset;v_edge_euclid;single_subset;pointI;euclid_point]; ]);; (* }}} *) let comp_pointI_long = prove_by_refinement( `!G m x. (segment G /\ component (ctop G) x (pointI m)) ==> (long_v m SUBSET component (ctop G) x)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC convex_component; ASM_REWRITE_TAC[long_v_convex;ctop_unions;DIFF_SUBSET;long_v_euclid]; CONJ_TAC; REWRITE_TAC[long_v_union;EQ_EMPTY;UNION;INTER]; GEN_TAC; TYPE_THEN `UNIONS (ctop G) (pointI m)` SUBGOAL_TAC; ASSUME_TAC (ISPEC `(ctop G)` component_unions); ASM_MESON_TAC[ISUBSET]; REWRITE_TAC[ctop_unions;DIFF ;]; DISCH_ALL_TAC; AND 2; TYPE_THEN `~(curve_cell G {(pointI m)})` SUBGOAL_TAC; USE 4(REWRITE_RULE[UNIONS]); LEFT 4 "u"; TSPEC `{(pointI m)}` 4; USE 4(REWRITE_RULE [INR IN_SING;]); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[curve_cell_not_point;]; TYPE_THEN `FINITE G` SUBGOAL_TAC; ASM_SIMP_TAC[segment_finite]; ASM_SIMP_TAC[num_closure0]; DISCH_TAC; UND 5; REP_CASES_TAC; (* cases *) TYPE_THEN `~(v_edge (down m) INTER UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS;INTER ]; ASM_MESON_TAC[]; ASM_SIMP_TAC[curve_cell_v_inter]; DISCH_ALL_TAC; TSPEC `v_edge (down m)` 5; UND 5; ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;]; (* next case *) USE 7 (REWRITE_RULE[INR IN_SING]); ASM_MESON_TAC[]; TYPE_THEN `~(v_edge (m) INTER UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS;INTER ]; ASM_MESON_TAC[]; ASM_SIMP_TAC[curve_cell_v_inter]; DISCH_ALL_TAC; TSPEC `v_edge (m)` 5; UND 5; ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;]; (* LAST *) REWRITE_TAC[long_v_union;EMPTY_EXISTS;]; TYPE_THEN `(pointI m)` EXISTS_TAC; ASM_REWRITE_TAC[INTER;UNION;INR IN_SING;]; ]);; (* }}} *) let comp_h_squ = prove_by_refinement( `!G x m. (segment G /\ (h_edge m SUBSET (component (ctop G) x)) ==> (squ m SUBSET (component (ctop G ) x)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC; IMATCH_MP_TAC comp_h_rect; ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[rectangle_h]; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; ]);; (* }}} *) let comp_v_squ = prove_by_refinement( `!G x m. (segment G /\ (v_edge m SUBSET (component (ctop G) x)) ==> (squ m SUBSET (component (ctop G ) x)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(rectangle (FST m -: &:1 , SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC; IMATCH_MP_TAC comp_v_rect; ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[rectangle_v]; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; ]);; (* }}} *) let comp_p_squ = prove_by_refinement( `!G x m. (segment G /\ (component (ctop G) x (pointI m))) ==> (squ m SUBSET (component (ctop G ) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `long_v m SUBSET component (ctop G) x` SUBGOAL_TAC; IMATCH_MP_TAC comp_pointI_long; ASM_REWRITE_TAC[]; REWRITE_TAC[long_v_union]; REWRITE_TAC[union_subset]; DISCH_ALL_TAC; IMATCH_MP_TAC comp_v_squ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let comp_squ = prove_by_refinement( `!G x. (segment G /\ (~(component (ctop G) x = EMPTY)) ==> (?m. (squ m SUBSET (component (ctop G ) x))))`, (* {{{ proof *) [ DISCH_ALL_TAC; COPY 0; USE 0 (MATCH_MP unions_cell_of); TSPEC `x` 0; USE 0 (SYM); USE 1 (REWRITE_RULE[EMPTY_EXISTS]); CHO 1; UND 0; DISCH_THEN (fun t-> USE 1 (ONCE_REWRITE_RULE[t])); USE 0 (REWRITE_RULE[cell_of;UNIONS]); CHO 0; UND 0; DISCH_ALL_TAC; USE 0 (REWRITE_RULE[cell]); CHO 0; UND 0; REP_CASES_TAC; REWR 1; USE 1 (REWRITE_RULE[single_subset]); ASM_MESON_TAC[comp_p_squ]; ASM_MESON_TAC[comp_h_squ]; ASM_MESON_TAC[comp_v_squ]; ASM_MESON_TAC[]; ]);; (* }}} *) let comp_squ_left_rect_v = prove_by_refinement( `!G m x. (segment G /\ ~(G (v_edge ( m))) /\ (squ m SUBSET component (ctop G) x) ==> (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; ASM_SIMP_TAC[GSYM curve_cell_v]; DISCH_TAC; (* *) IMATCH_MP_TAC convex_component; ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; CONJ_TAC; REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;]; DISCH_ALL_TAC; AND 3; TYPE_THEN `~(squ (left m) x') /\ ~(squ m x')` SUBGOAL_TAC; USE 0(MATCH_MP curve_cell_squ_inter); COPY 0; TSPEC `m` 0; TSPEC `left m` 5; UND 5; UND 0; REWRITE_TAC [EQ_EMPTY; INTER]; ASM_MESON_TAC[]; DISCH_ALL_TAC; REWR 4; USE 3 (REWRITE_RULE[UNIONS;]); CHO 3; TYPE_THEN `cell u` SUBGOAL_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; ASM_MESON_TAC[ISUBSET; curve_cell_cell]; DISCH_TAC; TYPE_THEN `u = v_edge m ` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[rectangle_v;EMPTY_EXISTS;]; TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; ASM_MESON_TAC[cell_nonempty;cell_rules]; REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; USE 2(REWRITE_RULE[ISUBSET]); ASM_MESON_TAC[]; ]);; (* }}} *) let comp_squ_left_rect = prove_by_refinement( `!G m x. (segment G /\ (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))) /\ (squ m SUBSET component (ctop G) x)) ==> (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)`, (* {{{ proof *) [ DISCH_ALL_TAC; LEFT 1 "p"; TSPEC `m` 1; LEFT 1 "e"; TSPEC `v_edge m` 1; REWR 1; USE 1(REWRITE_RULE[squ_closure_v]); IMATCH_MP_TAC comp_squ_left_rect_v; ASM_REWRITE_TAC[]; ]);; (* }}} *) let comp_squ_right_rect_v = prove_by_refinement( `!G m x. (segment G /\ ~(G (v_edge (right m))) /\ (squ m SUBSET component (ctop G) x) ==> (rectangle (FST m,SND m ) (FST m +: &:2,SND m +: &:1) SUBSET component (ctop G) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; ASM_SIMP_TAC[GSYM curve_cell_v]; DISCH_TAC; (* *) IMATCH_MP_TAC convex_component; ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right m) -: &:1, SND (right m)) (FST (right m) +: &:1, SND (right m) +: &:1)` SUBGOAL_TAC; REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; DISCH_THEN_REWRITE; CONJ_TAC; REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;]; DISCH_ALL_TAC; AND 3; USE 4 (REWRITE_RULE[right_left]); TYPE_THEN `~(squ m x') /\ ~(squ (right m) x')` SUBGOAL_TAC; USE 0(MATCH_MP curve_cell_squ_inter); COPY 0; TSPEC `m` 0; TSPEC `right m` 5; UND 5; UND 0; REWRITE_TAC [EQ_EMPTY; INTER]; ASM_MESON_TAC[]; DISCH_ALL_TAC; REWR 4; USE 3 (REWRITE_RULE[UNIONS;]); CHO 3; TYPE_THEN `cell u` SUBGOAL_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; ASM_MESON_TAC[ISUBSET; curve_cell_cell]; DISCH_TAC; TYPE_THEN `u = v_edge (right m) ` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[rectangle_v;EMPTY_EXISTS;]; REWRITE_TAC[right_left]; TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; ASM_MESON_TAC[cell_nonempty;cell_rules]; REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; USE 2(REWRITE_RULE[ISUBSET]); ASM_MESON_TAC[]; ]);; (* }}} *) let comp_squ_right_rect = prove_by_refinement( `!G m x. (segment G /\ (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))) /\ (squ m SUBSET component (ctop G) x)) ==> (rectangle (FST m , SND m ) (FST m +: &:2,SND m +: &:1) SUBSET component (ctop G) x)`, (* {{{ proof *) [ DISCH_ALL_TAC; LEFT 1 "p"; TSPEC `m` 1; LEFT 1 "e"; TSPEC `v_edge (right m)` 1; REWR 1; USE 1(REWRITE_RULE[squ_closure_right_v]); IMATCH_MP_TAC comp_squ_right_rect_v; ASM_REWRITE_TAC[]; ]);; (* }}} *) let comp_squ_down_rect_h = prove_by_refinement( `!G m x. (segment G /\ ~(G (h_edge m)) /\ (squ m SUBSET component (ctop G) x) ==> (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; ASM_SIMP_TAC[GSYM curve_cell_h]; DISCH_TAC; (* *) IMATCH_MP_TAC convex_component; ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; CONJ_TAC; REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;]; DISCH_ALL_TAC; AND 3; TYPE_THEN `~(squ (down m) x') /\ ~(squ m x')` SUBGOAL_TAC; USE 0(MATCH_MP curve_cell_squ_inter); COPY 0; TSPEC `m` 0; TSPEC `down m` 5; UND 5; UND 0; REWRITE_TAC [EQ_EMPTY; INTER]; ASM_MESON_TAC[]; DISCH_ALL_TAC; REWR 4; USE 3 (REWRITE_RULE[UNIONS;]); CHO 3; TYPE_THEN `cell u` SUBGOAL_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; ASM_MESON_TAC[ISUBSET; curve_cell_cell]; DISCH_TAC; TYPE_THEN `u = h_edge m ` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[rectangle_h;EMPTY_EXISTS;]; TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; ASM_MESON_TAC[cell_nonempty;cell_rules]; REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; USE 2(REWRITE_RULE[ISUBSET]); ASM_MESON_TAC[]; ]);; (* }}} *) let comp_squ_down_rect = prove_by_refinement( `!G m x. (segment G /\ (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))) /\ (squ m SUBSET component (ctop G) x)) ==> (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)`, (* {{{ proof *) [ DISCH_ALL_TAC; LEFT 1 "p"; TSPEC `m` 1; LEFT 1 "e"; TSPEC `h_edge m` 1; REWR 1; USE 1(REWRITE_RULE[squ_closure_h]); ASM_MESON_TAC[comp_squ_down_rect_h]; ]);; (* }}} *) let comp_squ_up_rect_h = prove_by_refinement( `!G m x. (segment G /\ ~(G (h_edge (up m))) /\ (squ m SUBSET component (ctop G) x) ==> (rectangle (FST m,SND m ) (FST m +: &:1,SND m +: &:2) SUBSET component (ctop G) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; UND 1; ASM_SIMP_TAC[GSYM curve_cell_h]; DISCH_TAC; (* *) IMATCH_MP_TAC convex_component; ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up m) , SND (up m) -: &:1) (FST (up m) +: &:1, SND (up m) +: &:1)` SUBGOAL_TAC; REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; DISCH_THEN_REWRITE; CONJ_TAC; REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;]; DISCH_ALL_TAC; AND 3; USE 4 (REWRITE_RULE[right_left]); TYPE_THEN `~(squ m x') /\ ~(squ (up m) x')` SUBGOAL_TAC; USE 0(MATCH_MP curve_cell_squ_inter); COPY 0; TSPEC `m` 0; TSPEC `up m` 5; UND 5; UND 0; REWRITE_TAC [EQ_EMPTY; INTER]; ASM_MESON_TAC[]; DISCH_ALL_TAC; REWR 4; USE 3 (REWRITE_RULE[UNIONS;]); CHO 3; TYPE_THEN `cell u` SUBGOAL_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; ASM_MESON_TAC[ISUBSET; curve_cell_cell]; DISCH_TAC; TYPE_THEN `u = h_edge (up m) ` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[rectangle_h;EMPTY_EXISTS;]; REWRITE_TAC[right_left]; TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; ASM_MESON_TAC[cell_nonempty;cell_rules]; REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; USE 2(REWRITE_RULE[ISUBSET]); ASM_MESON_TAC[]; ]);; (* }}} *) let comp_squ_up_rect = prove_by_refinement( `!G m x. (segment G /\ (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))) /\ (squ m SUBSET component (ctop G) x)) ==> (rectangle (FST m , SND m ) (FST m +: &:1,SND m +: &:2) SUBSET component (ctop G) x)`, (* {{{ proof *) [ DISCH_ALL_TAC; LEFT 1 "p"; TSPEC `m` 1; LEFT 1 "e"; TSPEC `h_edge (up m)` 1; REWR 1; USE 1(REWRITE_RULE[squ_closure_up_h]); IMATCH_MP_TAC comp_squ_up_rect_h; ASM_REWRITE_TAC[]; ]);; (* }}} *) let comp_squ_right_left = prove_by_refinement( `!G x m. (segment G /\ (squ m SUBSET (component (ctop G) x)) /\ (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x)))))) ==> (squ (left m) SUBSET (component (ctop G) x)) /\ (squ (right m) SUBSET (component (ctop G) x)) /\ (squ (up m) SUBSET (component (ctop G) x)) /\ (squ (down m) SUBSET (component (ctop G) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; JOIN 2 1; JOIN 0 1; WITH 0 (MATCH_MP comp_squ_up_rect); WITH 0 (MATCH_MP comp_squ_down_rect); WITH 0 (MATCH_MP comp_squ_left_rect); WITH 0 (MATCH_MP comp_squ_right_rect); TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up m) , SND (up m) -: &:1) (FST (up m) +: &:1, SND (up m) +: &:1)` SUBGOAL_TAC; REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; DISCH_THEN (fun t-> USE 1 (REWRITE_RULE[t])); TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right m) -: &:1, SND (right m)) (FST (right m) +: &:1, SND (right m) +: &:1)` SUBGOAL_TAC; REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; DISCH_THEN (fun t-> USE 4 (REWRITE_RULE[t])); RULE_ASSUM_TAC (REWRITE_RULE[rectangle_h;rectangle_v;union_subset;right_left ]); ASM_REWRITE_TAC[]; ]);; (* }}} *) (* move *) let suc_sum = prove_by_refinement( `!j a b. (SUC j = a+ b) ==> (?k. (SUC k = a) \/ (SUC k = b))`, (* {{{ proof *) [ DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; LEFT 1 "k"; USE 1(REWRITE_RULE[DE_MORGAN_THM]); TYPE_THEN `a = 0 ` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; ASM_MESON_TAC[num_CASES]; TYPE_THEN `b = 0` SUBGOAL_TAC; ASM_MESON_TAC[num_CASES]; UND 0; ARITH_TAC; ]);; (* }}} *) let squ_induct = prove_by_refinement( `!j m n. ?p. ((SUC j) = (num_abs_of_int (FST m -: FST n) + num_abs_of_int (SND m -: SND n))) ==> ((j = (num_abs_of_int (FST p -: FST n) + num_abs_of_int (SND p -: SND n))) /\ ((p = left m) \/ (p = right m) \/ (p = up m) \/ (p = down m))) `, (* {{{ proof *) [ DISCH_ALL_TAC; RIGHT_TAC "p"; DISCH_TAC; WITH 0 (MATCH_MP suc_sum); CHO 1; UND 1; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `~(num_abs_of_int (FST m -: FST n) = 0)` SUBGOAL_TAC; UND 1; ARITH_TAC; REWRITE_TAC[num_abs_of_int0]; DISCH_TAC; TYPE_THEN `FST m <: FST n \/ FST n <: FST m` SUBGOAL_TAC; UND 2; INT_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `right m` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[right ]; ONCE_REWRITE_TAC[GSYM SUC_INJ]; REWRITE_TAC[GSYM ADD]; TYPE_THEN `(FST m +: &:1) -: FST n <=: &:0` SUBGOAL_TAC; UND 3; INT_ARITH_TAC; ASM_SIMP_TAC[num_abs_of_int_pre]; TYPE_THEN `(FST m +: &:1) -: FST n -: &:1 = FST m -: FST n` SUBGOAL_TAC; INT_ARITH_TAC; DISCH_THEN_REWRITE; (* next *) TYPE_THEN `left m` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[left ]; ONCE_REWRITE_TAC[GSYM SUC_INJ]; REWRITE_TAC[GSYM ADD]; TYPE_THEN `&:0 <=: (FST m -: &:1) -: FST n ` SUBGOAL_TAC; UND 3; INT_ARITH_TAC; ASM_SIMP_TAC[num_abs_of_int_suc]; TYPE_THEN `(FST m -: &:1 -: FST n +: &:1) = FST m -: FST n` SUBGOAL_TAC; INT_ARITH_TAC; DISCH_THEN_REWRITE; (* next *) TYPE_THEN `~(num_abs_of_int (SND m -: SND n) = 0)` SUBGOAL_TAC; UND 1; ARITH_TAC; REWRITE_TAC[num_abs_of_int0]; DISCH_TAC; TYPE_THEN `SND m <: SND n \/ SND n <: SND m` SUBGOAL_TAC; UND 2; INT_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; (* next *) TYPE_THEN `up m` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[up ]; ONCE_REWRITE_TAC[GSYM SUC_INJ]; REWRITE_TAC[GSYM ADD_SUC]; TYPE_THEN `(SND m +: &:1) -: SND n <=: &:0` SUBGOAL_TAC; UND 3; INT_ARITH_TAC; ASM_SIMP_TAC[num_abs_of_int_pre]; TYPE_THEN `((SND m +: &:1) -: SND n -: &:1) = SND m -: SND n` SUBGOAL_TAC; INT_ARITH_TAC; DISCH_THEN_REWRITE; (* final *) TYPE_THEN `down m` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[down ]; ONCE_REWRITE_TAC[GSYM SUC_INJ]; REWRITE_TAC[GSYM ADD_SUC]; TYPE_THEN `&:0 <=: (SND m -: &:1) -: SND n ` SUBGOAL_TAC; UND 3; INT_ARITH_TAC; ASM_SIMP_TAC[num_abs_of_int_suc]; TYPE_THEN `(SND m -: &:1 -: SND n +: &:1) = SND m -: SND n` SUBGOAL_TAC; INT_ARITH_TAC; DISCH_THEN_REWRITE; ]);; (* }}} *) let comp_squ_fill = prove_by_refinement( `!G x m. (segment G /\ (squ m SUBSET (component (ctop G ) x)) /\ (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x)))))) ==> (!n. (squ n SUBSET (component (ctop G) x))) `, (* {{{ proof *) [ DISCH_ALL_TAC; GEN_TAC; TYPE_THEN `(!j n. (j = (num_abs_of_int (FST n -: FST m) + num_abs_of_int (SND n -: SND m))) ==> (squ n SUBSET component (ctop G) x)) ==> (squ n SUBSET component (ctop G) x)` SUBGOAL_TAC; DISCH_ALL_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; INDUCT_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; REWRITE_TAC[ADD_EQ_0;num_abs_of_int0]; GEN_TAC; DISCH_TAC; TYPE_THEN `n = m` SUBGOAL_TAC; UND 3; REWRITE_TAC[PAIR_SPLIT]; INT_ARITH_TAC; ASM_MESON_TAC[]; DISCH_ALL_TAC; USE 4 (MATCH_MP (CONV_RULE (quant_right_CONV "p") squ_induct)); CHO 4; TSPEC `p` 3; REWR 3; AND 4; TYPE_THEN `(n = left p) \/ (n = right p) \/ (n = up p) \/ (n = down p)` SUBGOAL_TAC; UND 4; REP_CASES_TAC THEN (ASM_REWRITE_TAC[right_left]); KILL 4; KILL 5; KILL 1; JOIN 3 2; JOIN 0 1; USE 0 (MATCH_MP comp_squ_right_left); ASM_MESON_TAC[]; ]);; (* }}} *) let comp_squ_adj = prove_by_refinement( `!G x m. (segment G /\ (squ m SUBSET (component (ctop G ) x))) ==> (?p e. (G e /\ e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))`, (* {{{ proof *) [ DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `(!n. (squ n SUBSET (component (ctop G) x)))` SUBGOAL_TAC; ASM_MESON_TAC[comp_squ_fill]; DISCH_TAC; TYPE_THEN `?e. (G e /\ (edge e))` SUBGOAL_TAC; USE 0 (REWRITE_RULE [segment;EMPTY_EXISTS;SUBSET;]); ASM_MESON_TAC[]; DISCH_TAC; UND 2; REWRITE_TAC[]; LEFT_TAC "e"; CHO 4; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; AND 2; USE 2(REWRITE_RULE[edge]); CHO 2; UND 2; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `m'` EXISTS_TAC; ASM_REWRITE_TAC[squ_closure_v;squ_closure_h]; ASM_MESON_TAC[squ_closure_v;squ_closure_h]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) let along_seg = jordan_def `along_seg G e x <=> G e /\ (?p. (e SUBSET closure top2 (squ p) /\ squ p SUBSET (component (ctop G) x) ))`;; let along_lemma1 = prove_by_refinement( `!G m x. (segment G /\ (squ m SUBSET component (ctop G) x) /\ (G (v_edge m)) /\ (G (h_edge m))) ==> (?p. (h_edge m) SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `m` EXISTS_TAC; ASM_MESON_TAC[squ_closure_h]; ]);; (* }}} *) let midpoint_exclusion = prove_by_refinement( `!G m e e' e''. (segment G /\ G e /\ G e' /\ G e'' /\ (~(e = e')) /\ (closure top2 e (pointI m)) /\ (closure top2 e' (pointI m)) /\ (closure top2 e'' (pointI m)) ==> ((e'' = e) \/ (e'' = e'))) `, (* {{{ proof *) [ DISCH_ALL_TAC; USE 0 (REWRITE_RULE[segment;INSERT; ]); UND 0; DISCH_ALL_TAC; TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC; TSPEC `m` 10; UND 10; REP_CASES_TAC; ASM_REWRITE_TAC[]; UND 10; USE 0 (MATCH_MP num_closure1); ASM_REWRITE_TAC[]; DISCH_TAC; CHO 10; COPY 10; TSPEC `e` 12; TSPEC `e'` 10; ASM_MESON_TAC[]; USE 0 (MATCH_MP num_closure0); TSPEC `pointI m` 0; REWR 0; TSPEC `e` 0; ASM_MESON_TAC[]; DISCH_TAC; USE 0 (MATCH_MP num_closure_size); TSPEC `pointI m` 0; REWR 0; TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ; TYPE_THEN `X e /\ X e' /\ X e''` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; UND 0; UND 4; MESON_TAC[two_exclusion]; ]);; (* }}} *) (* indexed to here *) let along_lemma2 = prove_by_refinement( `!G m. (segment G /\ G (v_edge m) /\ G (v_edge (down m)) ==> ~(G (h_edge m)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = v_edge (down m))` SUBGOAL_TAC; IMATCH_MP_TAC midpoint_exclusion; TYPE_THEN `G` EXISTS_TAC; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[v_edge_inj;down;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;]; INT_ARITH_TAC ; REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2]; ]);; (* }}} *) let along_lemma3 = prove_by_refinement( `!G m. (segment G /\ G (v_edge m) /\ G(h_edge (left m)) ==> ~(G (h_edge m)) /\ ~(G (v_edge (down m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; CONJ_TAC; PROOF_BY_CONTR_TAC; USE 3(REWRITE_RULE[]); TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = h_edge (left m))` SUBGOAL_TAC; IMATCH_MP_TAC midpoint_exclusion; TYPE_THEN `G` EXISTS_TAC; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[v_edge_inj;left;v_edge_cpoint;GSYM hv_edgeV2;h_edge_cpoint;PAIR_SPLIT;]; INT_ARITH_TAC ; REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2;left ;h_edge_inj;PAIR_SPLIT;]; INT_ARITH_TAC; PROOF_BY_CONTR_TAC; USE 3(REWRITE_RULE[]); TYPE_THEN `(h_edge (left m) = v_edge m) \/ (h_edge (left m) = v_edge (down m))` SUBGOAL_TAC; IMATCH_MP_TAC midpoint_exclusion; TYPE_THEN `G` EXISTS_TAC; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[v_edge_inj;down;left ;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;]; INT_ARITH_TAC ; REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2]; ]);; (* }}} *) let along_lemma4 = prove_by_refinement( `!G m x. (segment G /\ (squ m SUBSET component (ctop G) x) /\ (G (v_edge m)) /\ (G (v_edge (down m)))) ==> (?p. (v_edge (down m)) SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `down m` EXISTS_TAC; CONJ_TAC; ASM_MESON_TAC[squ_closure_v]; TYPE_THEN `~(G (h_edge m))` SUBGOAL_TAC; ASM_MESON_TAC[along_lemma2]; DISCH_TAC; TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC ; IMATCH_MP_TAC comp_squ_down_rect_h; ASM_REWRITE_TAC[]; REWRITE_TAC[rectangle_h; union_subset]; MESON_TAC []; ]);; (* }}} *) let along_lemma5 = prove_by_refinement( `!G m x. (segment G /\ (squ m SUBSET component (ctop G) x) /\ (G (v_edge m)) /\ (G (h_edge (left m)))) ==> (?p. (h_edge (left m)) SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `left (down m)` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[GSYM right_left]; ASM_MESON_TAC[squ_closure_down_h]; TYPE_THEN ` ~(G (h_edge m)) /\ ~(G (v_edge (down m)))` SUBGOAL_TAC; IMATCH_MP_TAC along_lemma3; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC ; IMATCH_MP_TAC comp_squ_down_rect_h; ASM_REWRITE_TAC[]; REWRITE_TAC[rectangle_h; union_subset]; DISCH_ALL_TAC; TYPE_THEN `(rectangle (FST (down m) -: &:1,SND (down m)) (FST (down m) +: &:1,SND (down m) +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC; IMATCH_MP_TAC comp_squ_left_rect_v; ASM_REWRITE_TAC[]; REWRITE_TAC[rectangle_v;union_subset;]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let along_lemma6 = prove_by_refinement( `!G m x e. (segment G /\ (squ m SUBSET component (ctop G) x) /\ (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==> (?p. e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC ; ASM_MESON_TAC[segment]; DISCH_TAC; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;]; REWRITE_TAC[edge]; DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); REWR 4; USE 4 (REWRITE_RULE[v_edge_cpoint]); UND 4; DISCH_TAC; TYPE_THEN `(m' = m) \/ (m' = (down m))` SUBGOAL_TAC; UND 4; REWRITE_TAC[down;PAIR_SPLIT]; INT_ARITH_TAC ; KILL 4; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[squ_closure_v]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC along_lemma4; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; REWR 4; USE 4(REWRITE_RULE[h_edge_cpoint]); TYPE_THEN `(m' = m) \/ (m' = (left m))` SUBGOAL_TAC; UND 4; REWRITE_TAC[left;PAIR_SPLIT]; INT_ARITH_TAC ; KILL 4; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC along_lemma1; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC along_lemma5; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) let reflAf = jordan_def `reflAf r (x:num->real) = point(&2 * (real_of_int r) - x 0, x 1)`;; let reflAi = jordan_def `reflAi r (x:int#int) = ((&:2 *: r) -: FST x,SND x)`;; let reflBf = jordan_def `reflBf r (x:num->real) = point( x 0 , &2 * (real_of_int r) - x 1)`;; let reflBi = jordan_def `reflBi r (x:int#int) = (FST x, (&:2 *: r) -: SND x)`;; let reflCf = jordan_def `reflCf (x:num->real) = point (x 1, x 0)`;; let reflCi = jordan_def `reflCi (x:int#int) = (SND x, FST x)`;; let reflAf_inv = prove_by_refinement( `!r m. (reflAf r (reflAf r (point m)) = (point m))`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[reflAf;coord01;PAIR_SPLIT ;point_inj ;]; REAL_ARITH_TAC ; ]);; (* }}} *) let reflBf_inv = prove_by_refinement( `!r m. (reflBf r (reflBf r (point m)) = (point m))`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[reflBf;coord01;PAIR_SPLIT ;point_inj ;]; REAL_ARITH_TAC ; ]);; (* }}} *) let reflCf_inv = prove_by_refinement( `!m. (reflCf (reflCf (point m)) = (point m))`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[reflCf;coord01;PAIR_SPLIT ;point_inj ;]; ]);; (* }}} *) let reflAi_inv = prove_by_refinement( `!r x. (reflAi r (reflAi r x) = x)`, (* {{{ proof *) [ REWRITE_TAC[reflAi;PAIR_SPLIT;]; INT_ARITH_TAC; ]);; (* }}} *) let reflBi_inv = prove_by_refinement( `!r x. (reflBi r (reflBi r x) = x)`, (* {{{ proof *) [ REWRITE_TAC[reflBi;PAIR_SPLIT;]; INT_ARITH_TAC; ]);; (* }}} *) let reflCi_inv = prove_by_refinement( `!x. (reflCi (reflCi x) = x)`, (* {{{ proof *) [ REWRITE_TAC[reflCi;PAIR_SPLIT;]; ]);; (* }}} *) let invo_BIJ = prove_by_refinement( `!f. (!m . (f (f (point m)) = (point m))) /\ (!x. (euclid 2 (f x))) ==> (BIJ f (euclid 2) (euclid 2))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[BIJ;INJ;SURJ;]; SUBCONJ_TAC; CONJ_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 2 (MATCH_MP (point_onto)); USE 3 (MATCH_MP (point_onto)); CHO 2; CHO 3; REWR 4; TYPE_THEN `f` (USE 4 o AP_TERM ); REWR 4; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 4(MATCH_MP point_onto); CHO 4; ASM_REWRITE_TAC[]; TYPE_THEN ` f (point p)` EXISTS_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let reflA_BIJ = prove_by_refinement( `!r. (BIJ (reflAf r) (euclid 2) (euclid 2))`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC invo_BIJ; REWRITE_TAC[reflAf_inv]; REWRITE_TAC[reflAf;euclid_point;]; ]);; (* }}} *) let reflB_BIJ = prove_by_refinement( `!r. (BIJ (reflBf r) (euclid 2) (euclid 2))`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC invo_BIJ; REWRITE_TAC[reflBf_inv]; REWRITE_TAC[reflBf;euclid_point;]; ]);; (* }}} *) let reflC_BIJ = prove_by_refinement( `(BIJ (reflCf ) (euclid 2) (euclid 2))`, (* {{{ proof *) [ IMATCH_MP_TAC invo_BIJ; REWRITE_TAC[reflCf_inv]; REWRITE_TAC[reflCf;euclid_point;]; ]);; (* }}} *) let invo_homeo = prove_by_refinement( `!U (f:A->A). (continuous f U U) /\ (BIJ f (UNIONS U) (UNIONS U)) /\ (!x. (UNIONS U x ==> (f (f x ) = x))) ==> (homeomorphism f U U)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC bicont_homeomorphism; ASM_REWRITE_TAC[]; TYPE_THEN `!x. (UNIONS U x) ==> (INV f (UNIONS U) (UNIONS U) x = f x)` SUBGOAL_TAC; DISCH_ALL_TAC; TYPE_THEN `UNIONS U (f x)` SUBGOAL_TAC; UND 1; REWRITE_TAC[BIJ;SURJ]; ASM_MESON_TAC[]; DISCH_TAC; ASM_SIMP_TAC [(INR INVERSE_XY)]; DISCH_ALL_TAC; UND 0; REWRITE_TAC[continuous]; DISCH_ALL_TAC; DISCH_ALL_TAC; TSPEC `v` 0; REWR 0; UND 0; REWRITE_TAC[preimage]; TYPE_THEN `{x | UNIONS U x /\ v (INV f (UNIONS U) (UNIONS U) x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; IMATCH_MP_TAC (TAUT `(C ==> (A <=> B)) ==> ( C /\ A <=> C /\ B)`); DISCH_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; ]);; (* }}} *) let d_euclid_point = prove_by_refinement( `!r s. (d_euclid (point r) (point s) = sqrt ((FST r - FST s) pow 2 + ((SND r - SND s) pow 2)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `euclid 2 (point r) /\ euclid 2 (point s)` SUBGOAL_TAC; REWRITE_TAC[euclid_point]; DISCH_TAC ; USE 0(MATCH_MP d_euclid_n); ASM_REWRITE_TAC[]; AP_TERM_TAC; REWRITE_TAC[ARITH_RULE `2 = SUC 1`]; REWRITE_TAC[sum_DEF]; REDUCE_TAC; REWRITE_TAC[ARITH_RULE `1 = SUC 0`]; REWRITE_TAC[sum_DEF]; REDUCE_TAC; REWRITE_TAC[ARITH_RULE `(SUC 0 =1) /\ (SUC (SUC 0) = 2)`]; REWRITE_TAC[coord01]; REWRITE_TAC[POW_2]; ]);; (* }}} *) let reflA_cont = prove_by_refinement( `!r. continuous (reflAf r) top2 top2`, (* {{{ proof *) [ REWRITE_TAC[top2]; GEN_TAC; TYPE_THEN `(IMAGE (reflAf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET]; ASM_SIMP_TAC[metric_euclid]; CONV_TAC (dropq_conv "x"); REWRITE_TAC[reflAf;euclid_point]; DISCH_TAC; ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;]; DISCH_ALL_TAC; TYPE_THEN `epsilon` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 2(MATCH_MP point_onto); CHO 2; USE 3(MATCH_MP point_onto); CHO 3; UND 4; ASM_REWRITE_TAC[reflAf;d_euclid_point;coord01;]; TYPE_THEN `(&2 * real_of_int r - FST p - (&2 * real_of_int r - FST p')) = --. (FST p - FST p') ` SUBGOAL_TAC; REAL_ARITH_TAC ; DISCH_THEN_REWRITE; ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS]; REWRITE_TAC[ABS_NEG]; ]);; (* }}} *) let reflB_cont = prove_by_refinement( `!r. continuous (reflBf r) top2 top2`, (* {{{ proof *) [ REWRITE_TAC[top2]; GEN_TAC; TYPE_THEN `(IMAGE (reflBf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET]; ASM_SIMP_TAC[metric_euclid]; CONV_TAC (dropq_conv "x"); REWRITE_TAC[reflBf;euclid_point]; DISCH_TAC; ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;]; DISCH_ALL_TAC; TYPE_THEN `epsilon` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 2(MATCH_MP point_onto); CHO 2; USE 3(MATCH_MP point_onto); CHO 3; UND 4; ASM_REWRITE_TAC[reflBf;d_euclid_point;coord01;]; TYPE_THEN `(&2 * real_of_int r - SND p - (&2 * real_of_int r - SND p')) = --. (SND p - SND p') ` SUBGOAL_TAC; REAL_ARITH_TAC ; DISCH_THEN_REWRITE; ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS]; REWRITE_TAC[ABS_NEG]; ]);; (* }}} *) let reflC_cont = prove_by_refinement( ` continuous (reflCf) top2 top2`, (* {{{ proof *) [ REWRITE_TAC[top2]; TYPE_THEN `(IMAGE (reflCf) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET]; ASM_SIMP_TAC[metric_euclid]; CONV_TAC (dropq_conv "x"); REWRITE_TAC[reflCf;euclid_point]; DISCH_TAC; ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;]; DISCH_ALL_TAC; TYPE_THEN `epsilon` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 2(MATCH_MP point_onto); CHO 2; USE 3(MATCH_MP point_onto); CHO 3; UND 4; ASM_REWRITE_TAC[reflCf;d_euclid_point;coord01;]; REWRITE_TAC[REAL_ADD_AC]; ]);; (* }}} *) let reflA_homeo = prove_by_refinement( `!r. (homeomorphism (reflAf r) top2 top2)`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC reflA_BIJ; ASSUME_TAC top2_unions; IMATCH_MP_TAC invo_homeo; REWRITE_TAC[reflA_cont]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 2(MATCH_MP point_onto); CHO 2; ASM_REWRITE_TAC[reflAf_inv]; ]);; (* }}} *) let reflB_homeo = prove_by_refinement( `!r. (homeomorphism (reflBf r) top2 top2)`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC reflB_BIJ; ASSUME_TAC top2_unions; IMATCH_MP_TAC invo_homeo; REWRITE_TAC[reflB_cont]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 2(MATCH_MP point_onto); CHO 2; ASM_REWRITE_TAC[reflBf_inv]; ]);; (* }}} *) let reflC_homeo = prove_by_refinement( ` (homeomorphism (reflCf ) top2 top2)`, (* {{{ proof *) [ ASSUME_TAC reflC_BIJ; ASSUME_TAC top2_unions; IMATCH_MP_TAC invo_homeo; REWRITE_TAC[reflC_cont]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 2(MATCH_MP point_onto); CHO 2; ASM_REWRITE_TAC[reflCf_inv]; ]);; (* }}} *) let IMAGE2 = new_definition `IMAGE2 (f:A->B) U = IMAGE (IMAGE (f:A->B)) U`;; let reflA_h_edge = prove_by_refinement( `!m r. IMAGE (reflAf r) (h_edge m) = h_edge (left (reflAi r m))`, (* {{{ proof *) [ REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[h_edge]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "v"); REWRITE_TAC[coord01]; EQ_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 0; ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; DISCH_ALL_TAC; UND 0; UND 1; REAL_ARITH_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; UND 0; ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; DISCH_ALL_TAC; UND 2; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let reflA_v_edge = prove_by_refinement( `!m r. IMAGE (reflAf r) (v_edge m) = v_edge ( (reflAi r m))`, (* {{{ proof *) [ REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[v_edge]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "u"); REWRITE_TAC[coord01]; REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;]; MESON_TAC[]; ]);; (* }}} *) let reflA_edge = prove_by_refinement( `!r e. (edge e ==> edge (IMAGE (reflAf r) e))`, (* {{{ proof *) [ REWRITE_TAC[edge]; DISCH_ALL_TAC; CHO 0; UND 0; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; MESON_TAC[reflA_v_edge]; ASM_REWRITE_TAC[]; MESON_TAC[reflA_h_edge]; ]);; (* }}} *) let reflB_v_edge = prove_by_refinement( `!m r. IMAGE (reflBf r) (v_edge m) = v_edge (down (reflBi r m))`, (* {{{ proof *) [ REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[v_edge]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "u"); REWRITE_TAC[coord01]; EQ_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 0; ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; DISCH_ALL_TAC; UND 0; UND 1; REAL_ARITH_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; UND 0; ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; DISCH_ALL_TAC; UND 2; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let reflB_h_edge = prove_by_refinement( `!m r. IMAGE (reflBf r) (h_edge m) = h_edge ( (reflBi r m))`, (* {{{ proof *) [ REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[h_edge]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "v"); REWRITE_TAC[coord01]; REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;]; MESON_TAC[]; ]);; (* }}} *) let reflB_edge = prove_by_refinement( `!r e. (edge e ==> edge (IMAGE (reflBf r) e))`, (* {{{ proof *) [ REWRITE_TAC[edge]; DISCH_ALL_TAC; CHO 0; UND 0; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; MESON_TAC[reflB_v_edge]; ASM_REWRITE_TAC[]; MESON_TAC[reflB_h_edge]; ]);; (* }}} *) let reflC_vh_edge = prove_by_refinement( `!m . IMAGE (reflCf) (v_edge m) = h_edge ( (reflCi m))`, (* {{{ proof *) [ REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[v_edge;h_edge]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REWRITE_TAC[coord01]; ASM_MESON_TAC[]; ]);; (* }}} *) let reflC_hv_edge = prove_by_refinement( `!m . IMAGE (reflCf) (h_edge m) = v_edge ( (reflCi m))`, (* {{{ proof *) [ REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[v_edge;h_edge]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); REWRITE_TAC[coord01]; ASM_MESON_TAC[]; ]);; (* }}} *) let reflC_edge = prove_by_refinement( `!e. (edge e ==> edge (IMAGE (reflCf ) e))`, (* {{{ proof *) [ REWRITE_TAC[edge]; DISCH_ALL_TAC; CHO 0; UND 0; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; MESON_TAC[reflC_vh_edge]; ASM_REWRITE_TAC[]; MESON_TAC[reflC_hv_edge]; ]);; (* }}} *) let homeo_bij = prove_by_refinement( `!(f:A->B) U V. (homeomorphism f U V) ==> (BIJ (IMAGE f) U V)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;homeomorphism;continuous;preimage;]; DISCH_ALL_TAC; SUBCONJ_TAC; REWRITE_TAC[INJ]; ASM_REWRITE_TAC[IMAGE;]; DISCH_ALL_TAC; TAPP `u:B` 6; USE 6 (REWRITE_RULE[]); USE 6(CONV_RULE NAME_CONFLICT_CONV); IMATCH_MP_TAC EQ_EXT; USE 6 (GEN `u:B`); GEN_TAC; COPY 6; EQ_TAC; DISCH_TAC; TSPEC `f x'` 7; TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; UND 7; KILL 6; ASM_REWRITE_TAC[]; DISCH_TAC; CHO 6; CHO 9; TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC; REWRITE_TAC[UNIONS;]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC; REWRITE_TAC[UNIONS;]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `x' = x'''` SUBGOAL_TAC; USE 0(REWRITE_RULE[INJ]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `x' = x''` SUBGOAL_TAC; USE 0(REWRITE_RULE[INJ]); ASM_MESON_TAC[]; DISCH_TAC; ASM_MESON_TAC[]; (* mm *) DISCH_TAC; TSPEC `f x'` 7; TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; UND 7; KILL 6; ASM_REWRITE_TAC[]; DISCH_TAC; CHO 6; CHO 9; TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC; REWRITE_TAC[UNIONS;]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC; REWRITE_TAC[UNIONS;]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `x' = x'''` SUBGOAL_TAC; USE 0(REWRITE_RULE[INJ]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `x' = x''` SUBGOAL_TAC; USE 0(REWRITE_RULE[INJ]); ASM_MESON_TAC[]; DISCH_TAC; ASM_MESON_TAC[]; REWRITE_TAC[INJ;SURJ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; TYPE_THEN `{z | UNIONS U z /\ x (f z)}` EXISTS_TAC; CONJ_TAC; UND 2; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET ;]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); MESON_TAC[]; REWRITE_TAC[SUBSET;IMAGE]; DISCH_ALL_TAC; NAME_CONFLICT_TAC; UND 1; REWRITE_TAC[SURJ]; DISCH_ALL_TAC; TSPEC `x'` 8; TYPE_THEN `UNIONS V x'` SUBGOAL_TAC; REWRITE_TAC[UNIONS;]; ASM_MESON_TAC[]; DISCH_TAC; REWR 8; CHO 8; ASM_MESON_TAC[]; ]);; (* }}} *) let homeo_unions = prove_by_refinement( `!(f:A->B) U V. (homeomorphism f U V) ==> (IMAGE f (UNIONS U) = (UNIONS V))`, (* {{{ proof *) [ REWRITE_TAC[homeomorphism;BIJ;SURJ;IMAGE;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; GEN_TAC; NAME_CONFLICT_TAC; EQ_TAC; DISCH_ALL_TAC; CHO 5; ASM_MESON_TAC[]; DISCH_TAC; TSPEC `x` 2; ASM_MESON_TAC[]; ]);; (* }}} *) let homeo_closed = prove_by_refinement( `!(f:A->B) U V A. (homeomorphism f U V /\ (A SUBSET (UNIONS U)) ==> (closed_ V (IMAGE f A) = closed_ U A))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `BIJ f (UNIONS U) (UNIONS V)` SUBGOAL_TAC; ASM_MESON_TAC[homeomorphism]; DISCH_TAC; USE 2(MATCH_MP DIFF_SURJ); TSPEC `A` 2; REWR 2; ASM_REWRITE_TAC[closed;open_DEF]; EQ_TAC; DISCH_ALL_TAC; USE 0(REWRITE_RULE[homeomorphism;continuous]); UND 0; DISCH_ALL_TAC; USE 2 SYM; REWR 4; TSPEC `IMAGE f (UNIONS U DIFF A)` 5; REWR 5; TYPE_THEN `preimage (UNIONS U) f (IMAGE f (UNIONS U DIFF A)) = UNIONS U DIFF A` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT ; GEN_TAC; REWRITE_TAC[INR in_preimage;IMAGE;DIFF;]; USE 0(REWRITE_RULE[BIJ;INJ]); EQ_TAC; DISCH_ALL_TAC; CHO 8; ASM_MESON_TAC[]; MESON_TAC[]; DISCH_TAC; ASM_MESON_TAC[]; DISCH_TAC; CONJ_TAC; USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]); REWRITE_TAC[IMAGE;SUBSET]; GEN_TAC; NAME_CONFLICT_TAC; UND 1; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; USE 0(REWRITE_RULE[homeomorphism]); ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION G *) (* ------------------------------------------------------------------ *) let IMAGE_INTERS = prove_by_refinement( `!(f:A->B) A X . (INJ f X UNIV) /\ (UNIONS A SUBSET X) /\ ~(A = EMPTY) ==> ((IMAGE f) (INTERS A) = (INTERS (IMAGE2 f A)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[IMAGE2;INTERS;IMAGE;]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; NAME_CONFLICT_TAC; EQ_TAC; DISCH_ALL_TAC; CHO 3; AND 3; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; CHO 5; AND 5; ASM_REWRITE_TAC[]; NAME_CONFLICT_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_MESON_TAC[]; DISCH_ALL_TAC; USE 3 (CONV_RULE (dropq_conv "u'")); USE 3 (CONV_RULE (dropq_conv "y'")); USE 2(REWRITE_RULE[EMPTY_EXISTS]); CHO 2; COPY 3; TSPEC `u` 3; CHO 3; REWR 3; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 0(REWRITE_RULE[INJ]); TSPEC `u'` 4; CHO 4; REWR 4; TYPEL_THEN [`x'`;`x''`] (USE 0 o ISPECL); USE 1(REWRITE_RULE[UNIONS;ISUBSET]); ASM_MESON_TAC[]; ]);; (* }}} *) let homeo_closure = prove_by_refinement( `!(f:A->B) U V A. (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) /\ (topology_ U) ==> (IMAGE f (closure U A) = closure V (IMAGE f A))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closure]; TYPE_THEN `INJ f (UNIONS U) (UNIV)` SUBGOAL_TAC; USE 0(REWRITE_RULE[homeomorphism;BIJ;INJ;]); ASM_REWRITE_TAC[INJ]; DISCH_TAC; TYPE_THEN `C = {B | closed_ U B /\ A SUBSET B}` ABBREV_TAC ; TYPE_THEN `(UNIONS C SUBSET UNIONS U)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;]; EXPAND_TAC "C"; REWRITE_TAC[closed]; TYPE_THEN `X = UNIONS U` ABBREV_TAC ; REWRITE_TAC[UNIONS]; MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `~(C = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `UNIONS U` EXISTS_TAC; EXPAND_TAC "C"; ASM_REWRITE_TAC[closed; ISUBSET; DIFF_EQ_EMPTY;]; ASM_SIMP_TAC[INR open_EMPTY]; DISCH_TAC; JOIN 5 6; JOIN 3 5; USE 3 (MATCH_MP IMAGE_INTERS); ASM_REWRITE_TAC[]; AP_TERM_TAC; REWRITE_TAC[IMAGE2]; EXPAND_TAC "C"; IMATCH_MP_TAC EQ_EXT; GEN_TAC; TYPE_THEN `g = IMAGE f` ABBREV_TAC ; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; EQ_TAC; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "g"; KILL 5; TYPE_THEN `x' SUBSET (UNIONS U)` SUBGOAL_TAC; USE 6(REWRITE_RULE[closed]); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[homeo_closed]; DISCH_TAC; REWRITE_TAC[ISUBSET;IMAGE]; NAME_CONFLICT_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_ALL_TAC; TYPE_THEN `preimage (UNIONS U) f x` EXISTS_TAC; TYPE_THEN `x = g (preimage (UNIONS U) f x)` SUBGOAL_TAC; REWRITE_TAC[preimage]; EXPAND_TAC "g"; IMATCH_MP_TAC EQ_EXT; GEN_TAC; EQ_TAC; DISCH_TAC; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]); UND 0; DISCH_ALL_TAC; TSPEC `x'` 10; TYPE_THEN `UNIONS V x'` SUBGOAL_TAC; USE 6(REWRITE_RULE[closed]); ASM_MESON_TAC[ISUBSET]; DISCH_TAC; REWR 10; ASM_MESON_TAC[]; REWRITE_TAC[IMAGE]; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; USE 8 (SYM); ONCE_ASM_REWRITE_TAC[]; REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `preimage (UNIONS U) f x SUBSET (UNIONS U)` SUBGOAL_TAC; REWRITE_TAC[preimage;SUBSET;]; MESON_TAC[]; ASM_SIMP_TAC[GSYM homeo_closed]; REWRITE_TAC[preimage;SUBSET]; DISCH_ALL_TAC; CONJ_TAC; ASM_MESON_TAC[ISUBSET]; UND 7; EXPAND_TAC "g"; REWRITE_TAC[IMAGE;ISUBSET;]; UND 9; MESON_TAC[]; ]);; (* }}} *) let INJ_IMAGE = prove_by_refinement( `!(f :A->B) A B X . (A SUBSET X) /\ (B SUBSET X) /\ (INJ f X UNIV) ==> ((IMAGE f A = IMAGE f B) <=> (A = B))`, (* {{{ proof *) [ REP_BASIC_TAC; EQ_TAC; DISCH_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]); TAPP `y:B` 3; RULE_ASSUM_TAC (REWRITE_RULE[]); USE 3(GEN `y:B`); REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; USE 4(REWRITE_RULE [DE_MORGAN_THM]); FIRST_ASSUM (DISJ_CASES_TAC); LEFT 5 "x"; REP_BASIC_TAC; TSPEC `f x ` 3; TYPE_THEN `A x` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REP_BASIC_TAC; USE 0(REWRITE_RULE[BIJ;INJ]); TYPE_THEN `x = x'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; LEFT 5 "x"; REP_BASIC_TAC; TSPEC `f x ` 3; TYPE_THEN `B x` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; REP_BASIC_TAC; USE 0(REWRITE_RULE[BIJ;INJ]); TYPE_THEN `x = x'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; ]);; (* }}} *) let INJ_UNIV = prove_by_refinement( `!(f: A->B) X Y. (INJ f X Y) ==> (INJ f X UNIV)`, (* {{{ proof *) [ REWRITE_TAC[INJ]; REP_BASIC_TAC; ASM_MESON_TAC []; ]);; (* }}} *) let homeo_adj = prove_by_refinement( `!f X Y. (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\ (Y SUBSET euclid 2) ==> (adj X Y ==> (adj (IMAGE f X) (IMAGE f Y)))`, (* {{{ proof *) [ REWRITE_TAC[adj;INTER;EMPTY_EXISTS]; REP_BASIC_TAC; ASSUME_TAC top2_top; ASSUME_TAC top2_unions; TYPE_THEN `X SUBSET (UNIONS top2) /\ Y SUBSET (UNIONS (top2))` SUBGOAL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `closure top2 (IMAGE f X) = IMAGE f (closure top2 X)` SUBGOAL_TAC; ASM_MESON_TAC[GSYM homeo_closure]; DISCH_THEN_REWRITE; TYPE_THEN `closure top2 (IMAGE f Y) = IMAGE f (closure top2 Y)` SUBGOAL_TAC; ASM_MESON_TAC[GSYM homeo_closure]; DISCH_THEN_REWRITE; REP_BASIC_TAC; CONJ_TAC; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[]); UND 2; REWRITE_TAC[]; UND 10; TYPE_THEN `INJ f (euclid 2) UNIV` SUBGOAL_TAC; IMATCH_MP_TAC INJ_UNIV; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]); REP_BASIC_TAC; REWR 11; ASM_MESON_TAC[]; REP_BASIC_TAC; ASM_MESON_TAC[INJ_IMAGE]; (* done WITH both *) TYPE_THEN `f u` EXISTS_TAC; REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; (* converse *) ]);; (* }}} *) let homeomorphism_inv = prove_by_refinement( `!(f:A->B) U V. homeomorphism f U V ==> (homeomorphism (INV f (UNIONS U) (UNIONS V)) V U)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[homeomorphism]; ASM_SIMP_TAC[INV_homeomorphism]; USE 0(REWRITE_RULE [homeomorphism;continuous;]); REP_BASIC_TAC; ASM_SIMP_TAC[INVERSE_BIJ]; REP_BASIC_TAC; TSPEC `A` 1; REWR 1; TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ; TYPE_THEN `BIJ g (UNIONS V) (UNIONS U)` SUBGOAL_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; TYPE_THEN `!x'. (A x' ==> (f (g x') = x'))` SUBGOAL_TAC; REP_BASIC_TAC; TYPEL_THEN [`f`;`UNIONS U`;`UNIONS V`] (fun t-> ASSUME_TAC (ISPECL t (INR INVERSE_DEF))); RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); REWR 6; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; DISCH_TAC; DISCH_TAC; (* branch *) TYPE_THEN `(IMAGE g A) = preimage (UNIONS U) f A` SUBGOAL_TAC; REWRITE_TAC[IMAGE;preimage]; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; NAME_CONFLICT_TAC; EQ_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[]; EXPAND_TAC "g"; USE 2(MATCH_MP INVERSE_BIJ); RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC [UNIONS]; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `f x` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `f x = f (g (f x))` SUBGOAL_TAC; ASM_SIMP_TAC[]; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; USE 9 SYM; ASM_REWRITE_TAC[]; TYPE_THEN `UNIONS V (f x)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let inv_comp_left = prove_by_refinement( `!(f:A->B) X Y x. (BIJ f X Y /\ X x) ==> (INV f X Y (f x) = x)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `Y (f x)` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); ASM_MESON_TAC[]; ASM_MESON_TAC[INR INVERSE_XY]; ]);; (* }}} *) let inv_comp_right = prove_by_refinement( `!(f:A->B) X Y y. (BIJ f X Y /\ Y y) ==> (f (INV f X Y y) = y)`, (* {{{ proof *) [ REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); ASM_MESON_TAC[INR INVERSE_DEF;]; ]);; (* }}} *) let image_inv_image = prove_by_refinement( `!(f:A->B) A X Y. (BIJ f X Y) /\ (A SUBSET X) ==> (IMAGE (INV f X Y) (IMAGE f A) = A)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); EQ_TAC; REP_BASIC_TAC; TYPE_THEN `x = x'` SUBGOAL_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC [inv_comp_left;ISUBSET;]; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC inv_comp_left; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let homeo_adj_eq = prove_by_refinement( `!f X Y. (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\ (Y SUBSET euclid 2) ==> (adj X Y = (adj (IMAGE f X) (IMAGE f Y)))`, (* {{{ proof *) [ REP_BASIC_TAC; EQ_TAC; ASM_MESON_TAC[homeo_adj]; TYPEL_THEN [`INV f (euclid 2) (euclid 2)`;`IMAGE f X`;`IMAGE f Y`] (fun t-> MP_TAC (ISPECL t homeo_adj)); ASSUME_TAC top2_unions; TYPE_THEN `homeomorphism (INV f (euclid 2) (euclid 2)) top2 top2` SUBGOAL_TAC; ASM_MESON_TAC[homeomorphism_inv]; DISCH_THEN_REWRITE; TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[homeomorphism]; DISCH_TAC; ASM_SIMP_TAC[image_inv_image]; REP_BASIC_TAC; TYPE_THEN `IMAGE f X SUBSET euclid 2 /\ IMAGE f Y SUBSET euclid 2` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET]; NAME_CONFLICT_TAC; CONJ_TAC THEN (CONV_TAC (dropq_conv "x''")) THEN (RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ])); ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let finite_num_closure = prove_by_refinement( `!G top (x:A). FINITE G ==> (FINITE {C | G C /\ closure top C x})`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) let image_powerset = prove_by_refinement( `!(f:A->B) X Y. (BIJ f X Y ==> (BIJ (IMAGE f) {z | z SUBSET X} { z | z SUBSET Y}))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; REP_BASIC_TAC; CONJ_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC ; REWRITE_TAC[IMAGE;SUBSET;]; ASM_MESON_TAC[ISUBSET ;]; REWRITE_TAC[IMAGE;SUBSET;]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; TAPP `z:B` 1; USE 1(REWRITE_RULE[]); USE 1(GEN `z:B`); EQ_TAC; TSPEC `f x'` 1; REP_BASIC_TAC; UND 1; NAME_CONFLICT_TAC; TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; REP_BASIC_TAC; TYPE_THEN `x' = x''` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* 2 *) TSPEC `f x'` 1; REP_BASIC_TAC; UND 1; NAME_CONFLICT_TAC; TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; REP_BASIC_TAC; TYPE_THEN `x' = x''` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[INJ;SURJ]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `{z | X z /\ x (f z) }` EXISTS_TAC; SUBCONJ_TAC; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT ; REP_BASIC_TAC; REWRITE_TAC[]; NAME_CONFLICT_TAC; EQ_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; TSPEC `x'` 0; USE 3(REWRITE_RULE[SUBSET]); TSPEC `x'` 3; REWR 3; REWR 0; REP_BASIC_TAC; TYPE_THEN `y` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let image_power_inj = prove_by_refinement( `!(f:A->B) X Y A B. (BIJ f X Y /\ A SUBSET X /\ B SUBSET X ==> ((IMAGE f A = IMAGE f B) <=> (A = B)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPEL_THEN [`f`;`X`;`Y`] (fun t -> ASSUME_TAC (ISPECL t image_powerset )); REWR 3; USE 3(REWRITE_RULE[BIJ;INJ;]); REP_BASIC_TAC; EQ_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; ]);; (* }}} *) let image_power_surj = prove_by_refinement( `!(f:A->B) X Y B. (BIJ f X Y /\ B SUBSET Y ==> (?A. (A SUBSET X /\ (IMAGE f A = B))))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPEL_THEN [`f`;`X`;`Y`] (fun t -> ASSUME_TAC (ISPECL t image_powerset )); REWR 2; USE 2(REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_euclid = prove_by_refinement( `!G e. (segment G /\ G e) ==> (e SUBSET (euclid 2))`, (* {{{ proof *) [ REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); REP_BASIC_TAC; USE 3(REWRITE_RULE[SUBSET]); TSPEC `e` 3; REWR 3; USE 3(REWRITE_RULE[edge]); REP_BASIC_TAC; ASM_MESON_TAC[h_edge_euclid;v_edge_euclid]; ]);; (* }}} *) let image_app = prove_by_refinement( `!(f:A->B) X Y x t. INJ f X Y /\ x SUBSET X /\ (X t) ==> (IMAGE f x (f t) = x t)`, (* {{{ proof *) [ REWRITE_TAC[INJ;IMAGE;SUBSET ;]; REP_BASIC_TAC; EQ_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let homeo_num_closure = prove_by_refinement( `!G f m. (homeomorphism f top2 top2 /\ segment G) ==> (num_closure G (pointI m) = (num_closure (IMAGE2 f G) (f (pointI m))))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC top2_unions; ASSUME_TAC top2_top; TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); ASM_MESON_TAC []; DISCH_TAC; TYPE_THEN `G` (fun t-> ASSUME_TAC (ISPEC t segment_euclid)); REWRITE_TAC[num_closure]; IMATCH_MP_TAC BIJ_CARD; TYPE_THEN `IMAGE f` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC finite_num_closure; ASM_MESON_TAC[segment_finite]; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; REP_BASIC_TAC; CONJ_TAC; REP_BASIC_TAC; REWRITE_TAC[IMAGE2]; CONJ_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `x SUBSET (UNIONS top2)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `IMAGE f (closure top2 x) = closure top2 (IMAGE f x)` SUBGOAL_TAC; ASM_MESON_TAC [homeo_closure]; DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `x SUBSET (euclid 2) /\ y SUBSET (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; ASM_MESON_TAC[image_power_inj]; REWRITE_TAC[INJ;SURJ]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2]); UND 9; TYPE_THEN `g = IMAGE f` ABBREV_TAC ; REWRITE_TAC[IMAGE]; EXPAND_TAC "g"; REP_BASIC_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; REWR 8; UND 8; TYPE_THEN `x' SUBSET (UNIONS top2)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `closure top2 (g x') = IMAGE f (closure top2 x')` SUBGOAL_TAC; ASM_MESON_TAC [GSYM homeo_closure]; DISCH_THEN_REWRITE; (* m3 *) TYPE_THEN `INJ f (euclid 2) (euclid 2) /\ (closure top2 x' SUBSET (euclid 2)) /\ (euclid 2 (pointI m))` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); ASM_REWRITE_TAC[pointI;euclid_point]; IMATCH_MP_TAC c_edge_euclid; ASM_MESON_TAC[segment;ISUBSET]; DISCH_TAC; USE 12 (MATCH_MP image_app); ASM_REWRITE_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION H *) (* ------------------------------------------------------------------ *) let reflA_pointI = prove_by_refinement( `!r m. (reflAf r (pointI m) = pointI (reflAi r m))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[reflAi;reflAf;pointI]; REWRITE_TAC[point_inj;PAIR_SPLIT;]; REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01]; ]);; (* }}} *) let reflB_pointI = prove_by_refinement( `!r m. (reflBf r (pointI m) = pointI (reflBi r m))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[reflBi;reflBf;pointI]; REWRITE_TAC[point_inj;PAIR_SPLIT;]; REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01]; ]);; (* }}} *) let reflC_pointI = prove_by_refinement( `!m. (reflCf (pointI m) = pointI (reflCi m))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[reflCi;reflCf;pointI]; REWRITE_TAC[point_inj;PAIR_SPLIT;]; REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01]; ]);; (* }}} *) let edge_euclid2 = prove_by_refinement( `!e. (edge e ==> e SUBSET (euclid 2))`, (* {{{ proof *) [ MESON_TAC [edge;h_edge_euclid;v_edge_euclid;]; ]);; (* }}} *) let reflA_segment = prove_by_refinement( `!G r. (segment G ==> (segment (IMAGE2 (reflAf r) G)))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[segment]; COPY 0; USE 0(REWRITE_RULE[segment]); REP_BASIC_TAC; TYPE_THEN `homeomorphism (reflAf r) top2 top2` SUBGOAL_TAC; REWRITE_TAC[reflA_homeo]; DISCH_TAC; ASSUME_TAC top2_top; ASSUME_TAC top2_unions; TYPE_THEN `BIJ (reflAf r) (euclid 2) (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[homeomorphism]; DISCH_TAC; TYPE_THEN `INJ (IMAGE (reflAf r)) edge edge` SUBGOAL_TAC; REWRITE_TAC[INJ;reflA_edge;]; REP_BASIC_TAC; TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[edge_euclid2]; DISCH_TAC; ASM_MESON_TAC[image_power_inj]; DISCH_TAC; (* start cases *) SUBCONJ_TAC; REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; SUBCONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2; EQ_EMPTY]); TSPEC `IMAGE (reflAf r) u` 4; UND 4; REWRITE_TAC[]; TYPE_THEN `IMAGE (IMAGE (reflAf r)) G (IMAGE (reflAf r) u) = G u` SUBGOAL_TAC; IMATCH_MP_TAC image_app; EXISTS_TAC `edge`; EXISTS_TAC `edge`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; DISCH_TAC; (* ASM_MESON_TAC[image_power_inj]; DISCH_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; DISCH_TAC; *) SUBCONJ_TAC; REWRITE_TAC[IMAGE2;SUBSET]; GEN_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV ) [IMAGE]; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC reflA_edge; ASM_MESON_TAC[ISUBSET;]; DISCH_TAC; (* num closure clause *) CONJ_TAC; GEN_TAC; TYPE_THEN `pointI m = reflAf r (pointI (reflAi r m))` SUBGOAL_TAC; REWRITE_TAC[reflA_pointI;reflAi_inv]; DISCH_THEN_REWRITE; TYPE_THEN `num_closure (IMAGE2 (reflAf r) G) (reflAf r (pointI (reflAi r m))) = num_closure G (pointI (reflAi r m))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_num_closure); ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_MESON_TAC[]; (* inductive_set clause *) REP_BASIC_TAC; (* isc *) USE 16(REWRITE_RULE[IMAGE2]); USE 16 (MATCH_MP SUBSET_PREIMAGE); REP_BASIC_TAC; TSPEC `Z` 0; TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[]); REWR 16; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES]); ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `D = IMAGE (reflAf r) C` ABBREV_TAC ; TYPE_THEN `D' = IMAGE (reflAf r) C'` ABBREV_TAC ; TSPEC `D` 14; (* *) TSPEC `D'` 14; TYPE_THEN `S D /\ IMAGE2 (reflAf r) G D' /\ adj D D'` SUBGOAL_TAC; SUBCONJ_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "D"; TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C) = Z C` SUBGOAL_TAC; IMATCH_MP_TAC image_app; TYPE_THEN `edge` EXISTS_TAC; TYPE_THEN `edge` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISCH_TAC; (* fh1 *) SUBCONJ_TAC; EXPAND_TAC "D'"; REWRITE_TAC[IMAGE2;IMAGE]; NAME_CONFLICT_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; EXPAND_TAC "D"; EXPAND_TAC "D'"; TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;edge_euclid2]; DISCH_TAC; TYPE_THEN `(adj C C' ==> adj (IMAGE (reflAf r) C) (IMAGE (reflAf r) C'))` SUBGOAL_TAC; IMATCH_MP_TAC homeo_adj; ASM_REWRITE_TAC[]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; REWR 14; UND 14; EXPAND_TAC "D'"; TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C') = Z C'` SUBGOAL_TAC; IMATCH_MP_TAC image_app; TYPE_THEN `edge` EXISTS_TAC; TYPE_THEN `edge` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; UND 3; UND 19; ASM_MESON_TAC[ISUBSET]; MESON_TAC[]; DISCH_TAC; REWR 0; ASM_REWRITE_TAC[IMAGE2]; ]);; (* }}} *) let reflB_segment = prove_by_refinement( `!G r. (segment G ==> (segment (IMAGE2 (reflBf r) G)))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[segment]; COPY 0; USE 0(REWRITE_RULE[segment]); REP_BASIC_TAC; TYPE_THEN `homeomorphism (reflBf r) top2 top2` SUBGOAL_TAC; REWRITE_TAC[reflB_homeo]; DISCH_TAC; ASSUME_TAC top2_top; ASSUME_TAC top2_unions; TYPE_THEN `BIJ (reflBf r) (euclid 2) (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[homeomorphism]; DISCH_TAC; TYPE_THEN `INJ (IMAGE (reflBf r)) edge edge` SUBGOAL_TAC; REWRITE_TAC[INJ;reflB_edge;]; REP_BASIC_TAC; TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[edge_euclid2]; DISCH_TAC; ASM_MESON_TAC[image_power_inj]; DISCH_TAC; (* start cases *) SUBCONJ_TAC; REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; SUBCONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2; EQ_EMPTY]); TSPEC `IMAGE (reflBf r) u` 4; UND 4; REWRITE_TAC[]; TYPE_THEN `IMAGE (IMAGE (reflBf r)) G (IMAGE (reflBf r) u) = G u` SUBGOAL_TAC; IMATCH_MP_TAC image_app; EXISTS_TAC `edge`; EXISTS_TAC `edge`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; DISCH_TAC; (* ASM_MESON_TAC[image_power_inj]; DISCH_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; DISCH_TAC; *) SUBCONJ_TAC; REWRITE_TAC[IMAGE2;SUBSET]; GEN_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV ) [IMAGE]; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC reflB_edge; ASM_MESON_TAC[ISUBSET;]; DISCH_TAC; (* num closure clause *) CONJ_TAC; GEN_TAC; TYPE_THEN `pointI m = reflBf r (pointI (reflBi r m))` SUBGOAL_TAC; REWRITE_TAC[reflB_pointI;reflBi_inv]; DISCH_THEN_REWRITE; TYPE_THEN `num_closure (IMAGE2 (reflBf r) G) (reflBf r (pointI (reflBi r m))) = num_closure G (pointI (reflBi r m))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_num_closure); ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_MESON_TAC[]; (* inductive_set clause *) REP_BASIC_TAC; (* isc *) USE 16(REWRITE_RULE[IMAGE2]); USE 16 (MATCH_MP SUBSET_PREIMAGE); REP_BASIC_TAC; TSPEC `Z` 0; TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[]); REWR 16; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES]); ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `D = IMAGE (reflBf r) C` ABBREV_TAC ; TYPE_THEN `D' = IMAGE (reflBf r) C'` ABBREV_TAC ; TSPEC `D` 14; (* *) TSPEC `D'` 14; TYPE_THEN `S D /\ IMAGE2 (reflBf r) G D' /\ adj D D'` SUBGOAL_TAC; SUBCONJ_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "D"; TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C) = Z C` SUBGOAL_TAC; IMATCH_MP_TAC image_app; TYPE_THEN `edge` EXISTS_TAC; TYPE_THEN `edge` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISCH_TAC; (* fh1 *) SUBCONJ_TAC; EXPAND_TAC "D'"; REWRITE_TAC[IMAGE2;IMAGE]; NAME_CONFLICT_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; EXPAND_TAC "D"; EXPAND_TAC "D'"; TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;edge_euclid2]; DISCH_TAC; TYPE_THEN `(adj C C' ==> adj (IMAGE (reflBf r) C) (IMAGE (reflBf r) C'))` SUBGOAL_TAC; IMATCH_MP_TAC homeo_adj; ASM_REWRITE_TAC[]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; REWR 14; UND 14; EXPAND_TAC "D'"; TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C') = Z C'` SUBGOAL_TAC; IMATCH_MP_TAC image_app; TYPE_THEN `edge` EXISTS_TAC; TYPE_THEN `edge` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; UND 3; UND 19; ASM_MESON_TAC[ISUBSET]; MESON_TAC[]; DISCH_TAC; REWR 0; ASM_REWRITE_TAC[IMAGE2]; ]);; (* }}} *) let reflC_segment = prove_by_refinement( `!G . (segment G ==> (segment (IMAGE2 (reflCf) G)))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[segment]; COPY 0; USE 0(REWRITE_RULE[segment]); REP_BASIC_TAC; TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC; REWRITE_TAC[reflC_homeo]; DISCH_TAC; ASSUME_TAC top2_top; ASSUME_TAC top2_unions; TYPE_THEN `BIJ (reflCf) (euclid 2) (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[homeomorphism]; DISCH_TAC; TYPE_THEN `INJ (IMAGE (reflCf)) edge edge` SUBGOAL_TAC; REWRITE_TAC[INJ;reflC_edge;]; REP_BASIC_TAC; TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC; ASM_MESON_TAC[edge_euclid2]; DISCH_TAC; ASM_MESON_TAC[image_power_inj]; DISCH_TAC; (* start cases *) SUBCONJ_TAC; REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; SUBCONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2; EQ_EMPTY]); TSPEC `IMAGE (reflCf) u` 4; UND 4; REWRITE_TAC[]; TYPE_THEN `IMAGE (IMAGE (reflCf)) G (IMAGE (reflCf) u) = G u` SUBGOAL_TAC; IMATCH_MP_TAC image_app; EXISTS_TAC `edge`; EXISTS_TAC `edge`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; DISCH_TAC; (* ASM_MESON_TAC[image_power_inj]; DISCH_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; DISCH_TAC; *) SUBCONJ_TAC; REWRITE_TAC[IMAGE2;SUBSET]; GEN_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV ) [IMAGE]; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC reflC_edge; ASM_MESON_TAC[ISUBSET;]; DISCH_TAC; (* num closure clause *) CONJ_TAC; GEN_TAC; TYPE_THEN `pointI m = reflCf (pointI (reflCi m))` SUBGOAL_TAC; REWRITE_TAC[reflC_pointI;reflCi_inv]; DISCH_THEN_REWRITE; TYPE_THEN `num_closure (IMAGE2 (reflCf) G) (reflCf (pointI (reflCi m))) = num_closure G (pointI (reflCi m))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_num_closure); ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_MESON_TAC[]; (* inductive_set clause *) REP_BASIC_TAC; (* isc *) USE 16(REWRITE_RULE[IMAGE2]); USE 16 (MATCH_MP SUBSET_PREIMAGE); REP_BASIC_TAC; TSPEC `Z` 0; TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[]); REWR 16; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES]); ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `D = IMAGE (reflCf) C` ABBREV_TAC ; TYPE_THEN `D' = IMAGE (reflCf) C'` ABBREV_TAC ; TSPEC `D` 14; (* *) TSPEC `D'` 14; TYPE_THEN `S D /\ IMAGE2 (reflCf) G D' /\ adj D D'` SUBGOAL_TAC; SUBCONJ_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "D"; TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C) = Z C` SUBGOAL_TAC; IMATCH_MP_TAC image_app; TYPE_THEN `edge` EXISTS_TAC; TYPE_THEN `edge` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISCH_TAC; (* fh1 *) SUBCONJ_TAC; EXPAND_TAC "D'"; REWRITE_TAC[IMAGE2;IMAGE]; NAME_CONFLICT_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; EXPAND_TAC "D"; EXPAND_TAC "D'"; TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET;edge_euclid2]; DISCH_TAC; TYPE_THEN `(adj C C' ==> adj (IMAGE (reflCf) C) (IMAGE (reflCf) C'))` SUBGOAL_TAC; IMATCH_MP_TAC homeo_adj; ASM_REWRITE_TAC[]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; REWR 14; UND 14; EXPAND_TAC "D'"; TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C') = Z C'` SUBGOAL_TAC; IMATCH_MP_TAC image_app; TYPE_THEN `edge` EXISTS_TAC; TYPE_THEN `edge` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; UND 3; UND 19; ASM_MESON_TAC[ISUBSET]; MESON_TAC[]; DISCH_TAC; REWR 0; ASM_REWRITE_TAC[IMAGE2]; ]);; (* }}} *) let point_x = prove_by_refinement( `!x m. (x = point m) <=> (euclid 2 x /\ (FST m = x 0) /\ (SND m = x 1))`, (* {{{ proof *) [ REP_BASIC_TAC; EQ_TAC ; DISCH_THEN_REWRITE; REWRITE_TAC[coord01;euclid_point]; REP_BASIC_TAC; USE 2 (MATCH_MP point_onto ); REP_BASIC_TAC; ASM_REWRITE_TAC[point_inj]; REWRITE_TAC[PAIR_SPLIT]; ASM_REWRITE_TAC[coord01]; ]);; (* }}} *) (* next IMAGE of square *) let reflA_squ = prove_by_refinement( `!m r. IMAGE (reflAf r) (squ m) = squ (left (reflAi r m))`, (* {{{ proof *) [ REWRITE_TAC[squ;reflAf;reflAi;IMAGE ;left ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); REWRITE_TAC[coord01;]; REWRITE_TAC[point_x]; CONV_TAC (dropq_conv "v"); EQ_TAC ; REP_BASIC_TAC; TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 4; UND 5; USE 0 (GSYM ); ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; REAL_ARITH_TAC; (* 2 *) REP_BASIC_TAC; TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; UND 2; UND 3; USE 4 (GSYM); ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; REAL_ARITH_TAC; ]);; (* }}} *) let reflB_squ = prove_by_refinement( `!m r. IMAGE (reflBf r) (squ m) = squ (down (reflBi r m))`, (* {{{ proof *) [ REWRITE_TAC[squ;reflBf;reflBi;IMAGE ;down ;]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); REWRITE_TAC[coord01;]; REWRITE_TAC[point_x]; CONV_TAC (dropq_conv "u"); EQ_TAC ; REP_BASIC_TAC; TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 2; UND 3; USE 0 (GSYM ); ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; REAL_ARITH_TAC; (* 2 *) REP_BASIC_TAC; TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; UND 0; UND 1; USE 4 (GSYM); ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; REAL_ARITH_TAC; ]);; (* }}} *) let reflC_squ = prove_by_refinement( `!m. IMAGE (reflCf) (squ m) = squ ( (reflCi m))`, (* {{{ proof *) [ REWRITE_TAC[squ;reflCf;reflCi;IMAGE ; ]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "x'"); REWRITE_TAC[coord01;]; REWRITE_TAC[point_x]; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); MESON_TAC[]; ]);; (* }}} *) (* move to sets *) let powerset = jordan_def `powerset (X:A->bool) = { z | z SUBSET X }`;; let image_sing = prove_by_refinement( `!(f:A -> B) x. (IMAGE f {x} = {(f x)})`, (* {{{ proof *) [ REWRITE_TAC[IMAGE;INSERT]; CONV_TAC (dropq_conv "x'"); ]);; (* }}} *) let image_unions = prove_by_refinement( `!(f:A->B) U. (IMAGE f (UNIONS U) = UNIONS (IMAGE (IMAGE f) U))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[IMAGE;UNIONS;]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; EQ_TAC; REP_BASIC_TAC; CONV_TAC (dropq_conv "u"); ASM_REWRITE_TAC[]; NAME_CONFLICT_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; NAME_CONFLICT_TAC; REWR 0; KILL 1; ASM_MESON_TAC[]; ]);; (* }}} *) (* move *) let segment_euclid = prove_by_refinement( `!G. (segment G) ==> (closure top2 (UNIONS G) SUBSET euclid 2)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC closure_subset; ASM_REWRITE_TAC[top2_top;GSYM top2_unions]; CONJ_TAC; IMATCH_MP_TAC closed_UNIV; REWRITE_TAC[top2_top]; REWRITE_TAC[top2_unions;SUBSET;UNIONS;]; REP_BASIC_TAC; TYPE_THEN `edge u` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET]; ASM_MESON_TAC[edge_euclid2;ISUBSET]; ]);; (* }}} *) let image_curve_cell_reflA = prove_by_refinement( `!G r. (segment G) ==> (curve_cell (IMAGE2 (reflAf r) G) = IMAGE2 (reflAf r) (curve_cell G))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[curve_cell]; REWRITE_TAC[IMAGE2;IMAGE_UNION;]; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;UNIONS;]; REP_BASIC_TAC; TYPE_THEN `edge u` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET;]; ASM_MESON_TAC[edge_euclid2;ISUBSET]; DISCH_TAC; ASSUME_TAC top2_top; ASSUME_TAC top2_unions; (* *) TYPE_THEN `UNIONS (IMAGE (IMAGE (reflAf r)) G) = IMAGE (reflAf r) (UNIONS G)` SUBGOAL_TAC; REWRITE_TAC[GSYM image_unions]; DISCH_THEN_REWRITE ; (* *) TYPE_THEN `closure top2 (IMAGE (reflAf r) (UNIONS G)) = IMAGE (reflAf r) (closure top2 (UNIONS G))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;]; DISCH_THEN_REWRITE; (* *) TYPE_THEN `!n. IMAGE (reflAf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflAi r n))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `n' = reflAi r n` ABBREV_TAC ; TYPE_THEN `pointI n = reflAf r (pointI n')` SUBGOAL_TAC; EXPAND_TAC "n'"; KILL 4; ASM_REWRITE_TAC[reflA_pointI;reflAi_inv]; DISCH_THEN_REWRITE; IMATCH_MP_TAC image_app; TYPE_THEN `(euclid 2)` EXISTS_TAC; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC[pointI;euclid_point]; ASSUME_TAC reflA_homeo; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC segment_euclid; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* *) REWRITE_TAC[IMAGE;]; CONV_TAC (dropq_conv "x'"); (**** Modified by JRH to avoid GSPEC REWRITE_TAC[INR IN_SING;GSPEC;]; ****) REWRITE_TAC[INR IN_SING; UNWIND_THM2]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "y'"); (**** Removed by JRH REWRITE_TAC[GSPEC]; ****) (* *) EQ_TAC ; REP_BASIC_TAC; TYPE_THEN `reflAi r n'` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING; reflA_pointI; reflAi_inv;]; (*** Removed by JRH MESON_TAC[]; ****) (* *) REP_BASIC_TAC; TYPE_THEN `reflAi r n'` EXISTS_TAC; ASM_REWRITE_TAC[reflAi_inv;]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING;reflA_pointI;]; (*** Removed by JRH MESON_TAC[]; ****) ]);; (* }}} *) let image_curve_cell_reflB = prove_by_refinement( `!G r. (segment G) ==> (curve_cell (IMAGE2 (reflBf r) G) = IMAGE2 (reflBf r) (curve_cell G))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[curve_cell]; REWRITE_TAC[IMAGE2;IMAGE_UNION;]; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;UNIONS;]; REP_BASIC_TAC; TYPE_THEN `edge u` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET;]; ASM_MESON_TAC[edge_euclid2;ISUBSET]; DISCH_TAC; ASSUME_TAC top2_top; ASSUME_TAC top2_unions; (* *) TYPE_THEN `UNIONS (IMAGE (IMAGE (reflBf r)) G) = IMAGE (reflBf r) (UNIONS G)` SUBGOAL_TAC; REWRITE_TAC[GSYM image_unions]; DISCH_THEN_REWRITE ; (* *) TYPE_THEN `closure top2 (IMAGE (reflBf r) (UNIONS G)) = IMAGE (reflBf r) (closure top2 (UNIONS G))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;]; DISCH_THEN_REWRITE; (* *) TYPE_THEN `!n. IMAGE (reflBf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflBi r n))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `n' = reflBi r n` ABBREV_TAC ; TYPE_THEN `pointI n = reflBf r (pointI n')` SUBGOAL_TAC; EXPAND_TAC "n'"; KILL 4; ASM_REWRITE_TAC[reflB_pointI;reflBi_inv]; DISCH_THEN_REWRITE; IMATCH_MP_TAC image_app; TYPE_THEN `(euclid 2)` EXISTS_TAC; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC[pointI;euclid_point]; ASSUME_TAC reflB_homeo; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC segment_euclid; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* *) REWRITE_TAC[IMAGE;]; CONV_TAC (dropq_conv "x'"); (*** JRH changed this line to avoid GSPEC REWRITE_TAC[INR IN_SING;GSPEC;]; ***) REWRITE_TAC[INR IN_SING; UNWIND_THM2]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "y'"); (*** JRH removed this to avoid GSPEC REWRITE_TAC[GSPEC]; ***) (* *) EQ_TAC ; REP_BASIC_TAC; TYPE_THEN `reflBi r n'` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING; reflB_pointI; reflBi_inv;]; (*** Removed by JRH MESON_TAC[]; ****) (* *) REP_BASIC_TAC; TYPE_THEN `reflBi r n'` EXISTS_TAC; ASM_REWRITE_TAC[reflBi_inv;]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING;reflB_pointI;]; (*** Removed by JRH MESON_TAC[]; ****) ]);; (* }}} *) let image_curve_cell_reflC = prove_by_refinement( `!G . (segment G) ==> (curve_cell (IMAGE2 (reflCf ) G) = IMAGE2 (reflCf) (curve_cell G))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[curve_cell]; REWRITE_TAC[IMAGE2;IMAGE_UNION;]; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;UNIONS;]; REP_BASIC_TAC; TYPE_THEN `edge u` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET;]; ASM_MESON_TAC[edge_euclid2;ISUBSET]; DISCH_TAC; ASSUME_TAC top2_top; ASSUME_TAC top2_unions; (* *) TYPE_THEN `UNIONS (IMAGE (IMAGE (reflCf)) G) = IMAGE (reflCf) (UNIONS G)` SUBGOAL_TAC; REWRITE_TAC[GSYM image_unions]; DISCH_THEN_REWRITE ; (* *) TYPE_THEN `closure top2 (IMAGE (reflCf) (UNIONS G)) = IMAGE (reflCf) (closure top2 (UNIONS G))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;]; DISCH_THEN_REWRITE; (* *) TYPE_THEN `!n. IMAGE (reflCf) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflCi n))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `n' = reflCi n` ABBREV_TAC ; TYPE_THEN `pointI n = reflCf (pointI n')` SUBGOAL_TAC; EXPAND_TAC "n'"; KILL 4; ASM_REWRITE_TAC[reflC_pointI;reflCi_inv]; DISCH_THEN_REWRITE; IMATCH_MP_TAC image_app; TYPE_THEN `(euclid 2)` EXISTS_TAC; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC[pointI;euclid_point]; ASSUME_TAC reflC_homeo; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC segment_euclid; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* *) REWRITE_TAC[IMAGE;]; CONV_TAC (dropq_conv "x'"); (*** This line changed by JRH to avoid GSPEC REWRITE_TAC[INR IN_SING;GSPEC;]; ***) REWRITE_TAC[INR IN_SING; UNWIND_THM2]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x'"); CONV_TAC (dropq_conv "y'"); (*** Removed by JRH to avoid GSPEC REWRITE_TAC[GSPEC]; ***) (* *) EQ_TAC ; REP_BASIC_TAC; TYPE_THEN `reflCi n'` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING; reflC_pointI; reflCi_inv;]; (*** Removed by JRH MESON_TAC[]; ****) (* *) REP_BASIC_TAC; TYPE_THEN `reflCi n'` EXISTS_TAC; ASM_REWRITE_TAC[reflCi_inv;]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING;reflC_pointI;]; (*** Removed by JRH MESON_TAC[]; ****) ]);; (* }}} *) let inj_inter = prove_by_refinement( `!(f:A->B) X Y A B. (INJ f X Y) /\ (A SUBSET X) /\ (B SUBSET X) ==> (IMAGE f (A INTER B) = (IMAGE f A) INTER (IMAGE f B))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE;INTER ]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; NAME_CONFLICT_TAC; EQ_TAC; REP_BASIC_TAC; ASM_MESON_TAC[ISUBSET;]; REP_BASIC_TAC; TYPE_THEN `x' = x''` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[ISUBSET;]; REP_BASIC_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let homeomorphism_induced_top = prove_by_refinement( `!(f:A->B) U V A. (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) ==> (IMAGE2 f (induced_top U A) = induced_top V (IMAGE f A))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[induced_top;]; COPY 1; USE 1 (MATCH_MP homeo_bij); IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IMAGE2]; TYPE_THEN `g = IMAGE f` ABBREV_TAC ; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); (* *) TYPE_THEN `!t. U t ==> (g (t INTER A) = g t INTER g A)` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC inj_inter; TYPE_THEN `(UNIONS U)` EXISTS_TAC; TYPE_THEN `(UNIONS V)` EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC sub_union; ASM_REWRITE_TAC[]; DISCH_TAC; (* *) EQ_TAC; REP_BASIC_TAC; TSPEC `x'` 4; REWR 4; ASM_REWRITE_TAC[]; NAME_CONFLICT_TAC; TYPE_THEN `g x'` EXISTS_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; ASM_MESON_TAC[]; (* *) REP_BASIC_TAC; TYPE_THEN `?t. U t /\ (g t = x')` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `t` EXISTS_TAC; ASM_REWRITE_TAC[]; TSPEC `t` 4; REWR 4; ASM_REWRITE_TAC[]; ]);; (* }}} *) let ctop_reflA = prove_by_refinement( `!G r. (segment G) ==> (IMAGE2 (reflAf r) (ctop G) = ctop (IMAGE2 (reflAf r) G))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[ctop]; ASSUME_TAC reflA_homeo; TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC; REWRITE_TAC[top2_unions;DIFF;SUBSET;]; MESON_TAC[]; DISCH_TAC ; (* *) TYPE_THEN `IMAGE2 (reflAf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflAf r) (euclid 2 DIFF (UNIONS (curve_cell G))))` SUBGOAL_TAC; IMATCH_MP_TAC homeomorphism_induced_top; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; AP_TERM_TAC; TSPEC `r` 1; (* *) TYPE_THEN `IMAGE (reflAf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflAf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]); REP_BASIC_TAC; USE 4 (MATCH_MP DIFF_SURJ); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[UNIONS;SUBSET;]; REP_BASIC_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; TYPE_THEN `cell u` SUBGOAL_TAC; USE 7 (MATCH_MP curve_cell_cell); ASM_MESON_TAC[ISUBSET;]; ASM_MESON_TAC[ISUBSET;cell_euclid]; DISCH_THEN_REWRITE; AP_TERM_TAC; REWRITE_TAC[image_unions]; AP_TERM_TAC; ASM_SIMP_TAC[image_curve_cell_reflA]; REWRITE_TAC[IMAGE2]; ]);; (* }}} *) let ctop_reflB = prove_by_refinement( `!G r. (segment G) ==> (IMAGE2 (reflBf r) (ctop G) = ctop (IMAGE2 (reflBf r) G))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[ctop]; ASSUME_TAC reflB_homeo; TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC; REWRITE_TAC[top2_unions;DIFF;SUBSET;]; MESON_TAC[]; DISCH_TAC ; (* *) TYPE_THEN `IMAGE2 (reflBf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflBf r) (euclid 2 DIFF (UNIONS (curve_cell G))))` SUBGOAL_TAC; IMATCH_MP_TAC homeomorphism_induced_top; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; AP_TERM_TAC; TSPEC `r` 1; (* *) TYPE_THEN `IMAGE (reflBf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflBf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]); REP_BASIC_TAC; USE 4 (MATCH_MP DIFF_SURJ); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[UNIONS;SUBSET;]; REP_BASIC_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; TYPE_THEN `cell u` SUBGOAL_TAC; USE 7 (MATCH_MP curve_cell_cell); ASM_MESON_TAC[ISUBSET;]; ASM_MESON_TAC[ISUBSET;cell_euclid]; DISCH_THEN_REWRITE; AP_TERM_TAC; REWRITE_TAC[image_unions]; AP_TERM_TAC; ASM_SIMP_TAC[image_curve_cell_reflB]; REWRITE_TAC[IMAGE2]; ]);; (* }}} *) let ctop_reflC = prove_by_refinement( `!G . (segment G) ==> (IMAGE2 (reflCf) (ctop G) = ctop (IMAGE2 (reflCf) G))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[ctop]; ASSUME_TAC reflC_homeo; TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC; REWRITE_TAC[top2_unions;DIFF;SUBSET;]; MESON_TAC[]; DISCH_TAC ; (* *) TYPE_THEN `IMAGE2 (reflCf) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflCf) (euclid 2 DIFF (UNIONS (curve_cell G))))` SUBGOAL_TAC; IMATCH_MP_TAC homeomorphism_induced_top; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; AP_TERM_TAC; (* *) TYPE_THEN `IMAGE (reflCf) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflCf) (UNIONS (curve_cell G)))` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]); REP_BASIC_TAC; USE 4 (MATCH_MP DIFF_SURJ); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[UNIONS;SUBSET;]; REP_BASIC_TAC; TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; ASM_MESON_TAC[segment]; DISCH_TAC; TYPE_THEN `cell u` SUBGOAL_TAC; USE 7 (MATCH_MP curve_cell_cell); ASM_MESON_TAC[ISUBSET;]; ASM_MESON_TAC[ISUBSET;cell_euclid]; DISCH_THEN_REWRITE; AP_TERM_TAC; REWRITE_TAC[image_unions]; AP_TERM_TAC; ASM_SIMP_TAC[image_curve_cell_reflC]; REWRITE_TAC[IMAGE2]; ]);; (* }}} *) let connected_homeo = prove_by_refinement( `!(f:A->B) U V Z. (homeomorphism f U V /\ (Z SUBSET UNIONS U) ==> (connected V (IMAGE f Z) = connected U Z))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ; TYPE_THEN `Z = IMAGE g (IMAGE f Z)` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IMAGE]; EXPAND_TAC "g"; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); REP_BASIC_TAC; TYPE_THEN `!x'. (UNIONS U x') ==> (INV f (UNIONS U) (UNIONS V) (f x') = x')` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC inv_comp_left; ASM_REWRITE_TAC[]; DISCH_TAC; (* *) EQ_TAC; REP_BASIC_TAC; TYPE_THEN ` x` EXISTS_TAC; KILL 2; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET;]; REP_BASIC_TAC; TSPEC `x'` 5; TYPE_THEN `UNIONS U x'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; REWR 5; ASM_REWRITE_TAC[]; DISCH_TAC; EQ_TAC; REP_BASIC_TAC; UND 3; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); IMATCH_MP_TAC connect_image; TYPE_THEN `V` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC INV_homeomorphism; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;SUBSET;]; REP_BASIC_TAC; UND 3; EXPAND_TAC "g"; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `UNIONS U x''` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); TYPE_THEN `x = x''` SUBGOAL_TAC; ASM_MESON_TAC[inv_comp_left]; ASM_MESON_TAC[]; REP_BASIC_TAC; IMATCH_MP_TAC connect_image; TYPE_THEN `U` EXISTS_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]); REP_BASIC_TAC; ASM_REWRITE_TAC[SUBSET;IMAGE;]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); ASM_MESON_TAC[ISUBSET;]; ]);; (* }}} *) (* start here , Tues Jun 8 , 2004 *) let component = prove_by_refinement( `!U (x:A) . (component U x = {y | ?Z. connected U Z /\ Z x /\ Z y})`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[component_DEF ;]; ]);; (* }}} *) let component_homeo = prove_by_refinement( `!(f:A->B) U V x. (homeomorphism f U V) /\ (UNIONS U x) ==> (IMAGE f (component U x) = (component V (f x)))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[component ;IMAGE ; ]; IMATCH_MP_TAC EQ_EXT ; REP_BASIC_TAC; REWRITE_TAC[]; CONV_TAC (dropq_conv "x'"); EQ_TAC; REP_BASIC_TAC; TYPE_THEN `IMAGE f Z` EXISTS_TAC; CONJ_TAC; TYPE_THEN `Z SUBSET UNIONS U` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[connected]); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[connected_homeo]; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; (* *) REP_BASIC_TAC; (* *) TYPE_THEN `?A. A SUBSET (UNIONS U) /\ (IMAGE f A = Z)` SUBGOAL_TAC; IMATCH_MP_TAC image_power_surj; TYPE_THEN `UNIONS V` EXISTS_TAC; ASM_MESON_TAC[connected;homeomorphism]; REP_BASIC_TAC; TYPE_THEN `A` EXISTS_TAC; NAME_CONFLICT_TAC; WITH 5 (REWRITE_RULE[IMAGE]); USE 7 (GSYM); REWR 2; REP_BASIC_TAC; TYPE_THEN `x''` EXISTS_TAC; ASM_REWRITE_TAC[]; REWR 3; REP_BASIC_TAC; TYPE_THEN ` x = x'''` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; KILL 7; ASM_SIMP_TAC[GSYM connected_homeo]; ]);; (* }}} *) let bij_homeo = prove_by_refinement( `!(f:A->B) U V. (BIJ f (UNIONS U) (UNIONS V)) /\ (BIJ (IMAGE f) U V) ==> (homeomorphism f U V)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[homeomorphism;continuous;]; ASM_REWRITE_TAC[preimage;]; CONJ_TAC; REP_BASIC_TAC; COPY 1; UND 3; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ;SURJ]); REP_BASIC_TAC; TSPEC `v` 1; REWR 1; REP_BASIC_TAC; EXPAND_TAC "v"; TYPE_THEN `{x | UNIONS U x /\ IMAGE f y (f x)} = y` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; GEN_TAC; EQ_TAC; REP_BASIC_TAC; TYPE_THEN `IMAGE f y (f x) = y x` SUBGOAL_TAC; IMATCH_MP_TAC image_app ; TYPE_THEN `(UNIONS U)` EXISTS_TAC; TYPE_THEN `(UNIONS V)` EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[sub_union]; ASM_MESON_TAC[]; REP_BASIC_TAC; CONJ_TAC; ASM_MESON_TAC[sub_union;ISUBSET]; REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; (* *) REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let homeomorphism_subset = prove_by_refinement( `!(f:A->B) U V C. (homeomorphism f U V) /\ (C SUBSET U) ==> (homeomorphism f C (IMAGE2 f C))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC bij_homeo; SUBCONJ_TAC; TYPE_THEN `UNIONS C SUBSET UNIONS U` SUBGOAL_TAC; IMATCH_MP_TAC UNIONS_UNIONS ; ASM_REWRITE_TAC[]; DISCH_TAC; REWRITE_TAC[IMAGE2 ;GSYM image_unions;]; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]); REP_BASIC_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; SUBCONJ_TAC; REP_BASIC_TAC; TYPE_THEN `IMAGE f (UNIONS C) (f x) = (UNIONS C) x` SUBGOAL_TAC; IMATCH_MP_TAC (image_app); TYPE_THEN `(UNIONS U)` EXISTS_TAC; TYPE_THEN `(UNIONS V)` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISCH_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC [ISUBSET]; REWRITE_TAC[INJ]; REP_BASIC_TAC; REWRITE_TAC[SURJ]; ASM_REWRITE_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]); ASM_MESON_TAC[]; DISCH_TAC; REWRITE_TAC[BIJ]; WITH_FIRST (MATCH_MP homeo_bij); SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; REP_BASIC_TAC; REWRITE_TAC[IMAGE2;]; TYPE_THEN `g = IMAGE f` ABBREV_TAC ; REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; REWRITE_TAC[INJ;SURJ]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2]); TYPE_THEN `g = IMAGE f` ABBREV_TAC ; UND 6; REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; ]);; (* }}} *) let component_reflA = prove_by_refinement( `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==> (IMAGE (reflAf r) (component (ctop G) x) = (component (ctop (IMAGE2 (reflAf r) G)) (reflAf r x)))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC component_homeo; ASM_REWRITE_TAC[]; TYPE_THEN `ctop (IMAGE2 (reflAf r) G) = IMAGE2 (reflAf r) (ctop G)` SUBGOAL_TAC ; ASM_MESON_TAC[ctop_reflA]; DISCH_THEN_REWRITE; IMATCH_MP_TAC homeomorphism_subset; TYPE_THEN `top2` EXISTS_TAC; TYPE_THEN `top2` EXISTS_TAC; REWRITE_TAC[reflA_homeo]; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[ctop_top2]; ]);; (* }}} *) let component_reflB = prove_by_refinement( `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==> (IMAGE (reflBf r) (component (ctop G) x) = (component (ctop (IMAGE2 (reflBf r) G)) (reflBf r x)))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC component_homeo; ASM_REWRITE_TAC[]; TYPE_THEN `ctop (IMAGE2 (reflBf r) G) = IMAGE2 (reflBf r) (ctop G)` SUBGOAL_TAC ; ASM_MESON_TAC[ctop_reflB]; DISCH_THEN_REWRITE; IMATCH_MP_TAC homeomorphism_subset; TYPE_THEN `top2` EXISTS_TAC; TYPE_THEN `top2` EXISTS_TAC; REWRITE_TAC[reflB_homeo]; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[ctop_top2]; ]);; (* }}} *) let component_reflC = prove_by_refinement( `!(f:A->B) G x. (segment G) /\ (UNIONS (ctop G) x) ==> (IMAGE (reflCf) (component (ctop G) x) = (component (ctop (IMAGE2 (reflCf) G)) (reflCf x)))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC component_homeo; ASM_REWRITE_TAC[]; TYPE_THEN `ctop (IMAGE2 (reflCf) G) = IMAGE2 (reflCf) (ctop G)` SUBGOAL_TAC ; ASM_MESON_TAC[ctop_reflC]; DISCH_THEN_REWRITE; IMATCH_MP_TAC homeomorphism_subset; TYPE_THEN `top2` EXISTS_TAC; TYPE_THEN `top2` EXISTS_TAC; REWRITE_TAC[reflC_homeo]; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[ctop_top2]; ]);; (* }}} *) let subset_union_inter = prove_by_refinement( `!(X:A->bool) A B. (X SUBSET (A UNION B) ==> (~(X INTER A = EMPTY )) \/ (~(X INTER B = EMPTY)) \/ (X = EMPTY ))`, (* {{{ proof *) [ (REWRITE_TAC [EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ; ]); MESON_TAC[]; ]);; (* }}} *) let squ_disj = prove_by_refinement( `!m n. ((squ m INTER squ n = {}) <=> ~(m = n))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; REWR 1; RULE_ASSUM_TAC (REWRITE_RULE[INTER_IDEMPOT;]); ASM_MESON_TAC[cell_nonempty;cell_rules]; DISCH_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `squ m = squ n` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; ASM_MESON_TAC[cell_rules]; ASM_REWRITE_TAC[squ_inj]; ]);; (* }}} *) (* move way up *) let cell_clauses = prove_by_refinement( `(!m. (~(v_edge m = EMPTY ) /\ ~(h_edge m = EMPTY ) /\ ~(squ m = EMPTY ) /\ ~({(pointI m)} = EMPTY ))) /\ (!m n. (v_edge m INTER {(pointI n)} = EMPTY ) /\ ({(pointI n)} INTER v_edge m = EMPTY ) /\ (h_edge m INTER {(pointI n)} = EMPTY ) /\ ({(pointI n)} INTER h_edge m = EMPTY ) /\ (squ m INTER {(pointI n)} = EMPTY ) /\ ({(pointI n)} INTER squ m = EMPTY ) /\ ((v_edge m INTER v_edge n = EMPTY ) <=> ~(m = n) ) /\ ((h_edge m INTER h_edge n = EMPTY ) <=> ~(m = n) ) /\ ((squ m INTER squ n = EMPTY ) <=> ~(m = n) ) /\ (squ m INTER h_edge n = EMPTY ) /\ (h_edge n INTER squ m = EMPTY ) /\ (squ m INTER v_edge n = EMPTY ) /\ ( v_edge n INTER squ m = EMPTY ) /\ (h_edge m INTER v_edge n = EMPTY ) /\ ( v_edge n INTER h_edge m = EMPTY ) /\ (({(pointI n)} INTER {(pointI m)} = EMPTY ) <=> ~(n = m)) /\ (({(pointI n)} = {(pointI m)} ) <=> (n = m)) /\ ~(h_edge n = {(pointI m)}) /\ ~(v_edge n = {(pointI m)}) /\ ~(squ n = {(pointI m)}) /\ ~( {(pointI m)} = h_edge n) /\ ~( {(pointI m)} = v_edge n) /\ ~( {(pointI m)} = squ n) /\ ~(h_edge m = v_edge n) /\ ((h_edge m = h_edge n) <=> (m = n)) /\ ~(h_edge m = squ n) /\ ~(v_edge m = h_edge n) /\ ((v_edge m = v_edge n) <=> (m = n)) /\ ~(v_edge m = squ n) /\ ~(squ m = h_edge n) /\ ((squ m = squ n) <=> (m = n)) /\ ~(squ m = v_edge n) /\ ~(squ m (pointI n)) /\ ~(v_edge m (pointI n)) /\ ~(h_edge m (pointI n)) /\ ((pointI n = pointI m) <=> (n = m))) `, (* {{{ proof *) (let notrr = REWRITE_RULE[not_eq] in let interc = ONCE_REWRITE_RULE[INTER_COMM] in ([ CONJ_TAC ; ASM_MESON_TAC[cell_nonempty;cell_rules]; REP_BASIC_TAC; ASM_REWRITE_TAC[INTER_ACI;notrr v_edge_disj;notrr h_edge_disj;interc square_h_edge;square_h_edge;interc square_v_edge;square_v_edge;square_disj;single_inter;h_edge_inj;v_edge_inj;notrr squ_inj;INR IN_SING;hv_edgeV2; square_h_edgeV2; square_v_edgeV2;hv_edge;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2;notrr single_inter;v_edge_pointI;h_edge_pointI;square_pointI;pointI_inj;squ_disj]; REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;]; CONV_TAC (dropq_conv "u"); ASM_MESON_TAC[pointI_inj]; ])));; (* }}} *) let inter_union = prove_by_refinement( `!X A (B:A->bool). ~(X INTER (A UNION B) = EMPTY) ==> ~(X INTER A = EMPTY) \/ ~(X INTER B = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[INTER;UNION;EMPTY_EXISTS;]; MESON_TAC[]; ]);; (* }}} *) let squc_v = prove_by_refinement( `!m n. (v_edge m SUBSET squc n) ==> (n = m) \/ (n = left m)`, (* {{{ proof *) [ REWRITE_TAC[squc_union;]; REP_BASIC_TAC; USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; KILL 0; USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; ASM_REWRITE_TAC[right_left]; (* *) ]);; (* }}} *) let squc_h = prove_by_refinement( `!m n. (h_edge m SUBSET squc n) ==> (n = m) \/ (n = down m)`, (* {{{ proof *) [ REWRITE_TAC[squc_union;]; REP_BASIC_TAC; USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; KILL 0; USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[right_left]; KILL 0; REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ; ASM_MESON_TAC []; (* *) ]);; (* }}} *) let component_empty = prove_by_refinement( `!U (x:A). (topology_ U) ==> ((component U x = EMPTY) = ~(UNIONS U x))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[component ;EQ_EMPTY;]; EQ_TAC; REP_BASIC_TAC; TSPEC `x` 2; ASM_MESON_TAC[connected_sing;INR IN_SING;]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[connected]); REP_BASIC_TAC; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let image_imp = prove_by_refinement( `!(f:A->B) X t. X t ==> (IMAGE f X) (f t)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; ]);; (* }}} *) let image_inj = prove_by_refinement( `!(f:A->B) X A B. (INJ f X UNIV) /\ (A SUBSET X ) /\ (B SUBSET X) /\ (IMAGE f A SUBSET IMAGE f B) ==> (A SUBSET B)`, (* {{{ proof *) [ REWRITE_TAC[INJ;IMAGE;SUBSET;]; REP_BASIC_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let closure_euclid = prove_by_refinement( `closure (top2) (euclid 2) = euclid 2`, (* {{{ proof *) [ REWRITE_TAC[closure;top2]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC INTERS_SUBSET; REWRITE_TAC[SUBSET_REFL;]; ASM_MESON_TAC[closed_UNIV;top_of_metric_top;metric_euclid;top_of_metric_unions;]; REWRITE_TAC[INTERS;SUBSET]; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let closure_euclid = prove_by_refinement( `!A. (A SUBSET (euclid 2) ==> (closure top2 A SUBSET (euclid 2)))`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC [GSYM closure_euclid]; IMATCH_MP_TAC subset_of_closure; ASM_REWRITE_TAC[top2_top]; ]);; (* }}} *) let along_lemma7 = prove_by_refinement( `!G m n x e. (segment G /\ (squ n SUBSET component (ctop G) x) /\ (v_edge m SUBSET squc n) /\ (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==> (?p. e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))`, (* {{{ proof *) [ REP_BASIC_TAC; WITH_FIRST (MATCH_MP squc_v); FIRST_ASSUM (DISJ_CASES_TAC); REWR 3; IMATCH_MP_TAC along_lemma6; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[]; REWR 4; (* 2nd side *) REWR 4; REWR 3; KILL 6; KILL 7; TYPE_THEN `e' = IMAGE (reflAf (&:0)) e ` ABBREV_TAC ; TYPE_THEN `G' = IMAGE2 (reflAf (&:0)) G` ABBREV_TAC ; TYPE_THEN `x' = reflAf (&:0) x` ABBREV_TAC ; TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC; TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBGOAL_TAC; USE 4(REWRITE_RULE[SUBSET]); TYPE_THEN `~(squ (left m) = EMPTY)` SUBGOAL_TAC; ASM_MESON_TAC[cell_nonempty;cell_rules]; REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; TSPEC `u` 4; REWR 4; ASM_MESON_TAC[]; TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC; ASM_MESON_TAC[ctop_top]; ASM_SIMP_TAC [component_empty]; DISCH_TAC; TYPE_THEN `component (ctop G') x' = IMAGE (reflAf (&:0)) (component (ctop G) x)` SUBGOAL_TAC; ASM_MESON_TAC[component_reflA;]; DISCH_TAC; (* *) TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC; IMATCH_MP_TAC along_lemma6; TYPE_THEN `reflAi (&:0) m` EXISTS_TAC; (SUBCONJ_TAC); (* 1st claus *) EXPAND_TAC "G'"; IMATCH_MP_TAC reflA_segment; ASM_REWRITE_TAC[]; DISCH_TAC; CONJ_TAC; (* 2nd clause *) ASM_REWRITE_TAC[]; (* goal 2c *) USE 4(MATCH_MP (ISPEC `reflAf (&:0)` IMAGE_SUBSET )); TYPE_THEN `squ(reflAi (&:0) m) = IMAGE (reflAf (&:0)) (squ (left m))` SUBGOAL_TAC; REWRITE_TAC[reflA_squ]; AP_TERM_TAC; REWRITE_TAC[reflAi;left ;PAIR_SPLIT; ]; INT_ARITH_TAC; ASM_MESON_TAC[]; (* 3 *) CONJ_TAC; REWRITE_TAC[GSYM reflA_v_edge]; EXPAND_TAC "G'"; REWRITE_TAC[IMAGE2]; UND 2; (* goal 3c *) MESON_TAC[image_imp]; (* <2> *) CONJ_TAC; EXPAND_TAC "G'"; EXPAND_TAC "e'"; REWRITE_TAC[IMAGE2]; ASM_MESON_TAC[image_imp]; EXPAND_TAC "e'"; TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) e) = IMAGE (reflAf (&:0)) (closure top2 e)` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;]; TYPE_THEN `edge e ` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET]; MESON_TAC[ISUBSET;edge_euclid2;]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM reflA_pointI]; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* <1> *) TYPE_THEN `p = left (reflAi (&:0) p')` ABBREV_TAC ; TYPE_THEN `squ p' = IMAGE (reflAf (&:0) ) (squ p)` SUBGOAL_TAC; ASM_REWRITE_TAC[reflA_squ;]; AP_TERM_TAC; EXPAND_TAC "p"; REWRITE_TAC[left ;reflAi;PAIR_SPLIT;]; INT_ARITH_TAC; DISCH_TAC; TYPE_THEN `p` EXISTS_TAC; (* LAST *) ASSUME_TAC top2_top; TYPE_THEN `homeomorphism (reflAf (&:0)) top2 top2` SUBGOAL_TAC; ASM_MESON_TAC[reflA_homeo]; DISCH_TAC; ASSUME_TAC top2_unions; TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC; MESON_TAC[squ_euclid;top2_unions]; DISCH_TAC; CONJ_TAC; (* split *) UND 12; ASM_REWRITE_TAC[]; EXPAND_TAC "e'"; TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) (squ p)) = IMAGE (reflAf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* x *) DISCH_TAC; IMATCH_MP_TAC (ISPEC `reflAf (&:0)` image_inj); TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC INJ_UNIV; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;]; CONJ_TAC; TYPE_THEN `edge e ` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET]; MESON_TAC[ISUBSET;edge_euclid2;]; IMATCH_MP_TAC closure_euclid; REWRITE_TAC[squ_euclid]; (* last'' *) IMATCH_MP_TAC (ISPEC `reflAf (&:0)` image_inj); TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC INJ_UNIV; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;]; CONJ_TAC; REWRITE_TAC[squ_euclid]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; ASM_REWRITE_TAC[component_unions;ctop_unions]; REWRITE_TAC[DIFF;SUBSET]; MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let v_edge_cases = prove_by_refinement( `!j m. closure top2 (v_edge j) (pointI m) ==> (j = m) \/ (j = down m)`, (* {{{ proof *) [ REWRITE_TAC[v_edge_closure;vc_edge]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[UNION;cell_clauses;INR IN_SING;plus_e12]); FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; DISJ2_TAC; ASM_REWRITE_TAC[down;PAIR_SPLIT;]; INT_ARITH_TAC; ]);; (* }}} *) let squ_squc = prove_by_refinement( `!r n m. (IMAGE (reflBf r) (squ n) = squ m) ==> (IMAGE (reflBf r) (squc n) = squc m)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[GSYM squ_closure]; TYPE_THEN `IMAGE (reflBf r) (closure top2 (squ n)) = closure top2 (IMAGE (reflBf r) (squ n))` SUBGOAL_TAC; IMATCH_MP_TAC homeo_closure; ASM_REWRITE_TAC[top2_top;top2_unions;reflB_homeo;squ_euclid;]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; ]);; (* }}} *) let squ_squc_C = prove_by_refinement( `!n m. (IMAGE (reflCf) (squ n) = squ m) ==> (IMAGE (reflCf) (squc n) = squc m)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[GSYM squ_closure]; TYPE_THEN `IMAGE (reflCf) (closure top2 (squ n)) = closure top2 (IMAGE (reflCf) (squ n))` SUBGOAL_TAC; IMATCH_MP_TAC homeo_closure; ASM_REWRITE_TAC[top2_top;top2_unions;reflC_homeo;squ_euclid;]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; ]);; (* }}} *) let along_lemma8 = prove_by_refinement( `!G m n j x e. (segment G /\ (squ n SUBSET component (ctop G) x) /\ (v_edge j SUBSET squc n) /\ (closure top2 (v_edge j) (pointI m)) /\ (G (v_edge j)) /\ G e /\ (closure top2 e (pointI m)) ==> (?p. e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))`, (* {{{ proof *) [ REP_BASIC_TAC; USE_FIRST (MATCH_MP v_edge_cases); FIRST_ASSUM (DISJ_CASES_TAC); IMATCH_MP_TAC along_lemma7; ASM_MESON_TAC[]; KILL 3; REWR 4; REWR 2; KILL 7; (* INSERT lemmas here *) TYPE_THEN `e' = IMAGE (reflBf (&:0)) e ` ABBREV_TAC ; TYPE_THEN `G' = IMAGE2 (reflBf (&:0)) G` ABBREV_TAC ; TYPE_THEN `x' = reflBf (&:0) x` ABBREV_TAC ; TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC; TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBGOAL_TAC; USE 5(REWRITE_RULE[SUBSET]); TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC; ASM_MESON_TAC[cell_nonempty;cell_rules]; REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; ASM_MESON_TAC[]; TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC; ASM_MESON_TAC[ctop_top]; ASM_SIMP_TAC [component_empty]; DISCH_TAC; TYPE_THEN `component (ctop G') x' = IMAGE (reflBf (&:0)) (component (ctop G) x)` SUBGOAL_TAC; ASM_MESON_TAC[component_reflB;]; DISCH_TAC; (* gok to here *) TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC; IMATCH_MP_TAC along_lemma7; TYPE_THEN `(reflBi (&:0)) m` EXISTS_TAC; TYPE_THEN `down (reflBi (&:0) n)` EXISTS_TAC; (SUBCONJ_TAC); (* 1st claus *) EXPAND_TAC "G'"; IMATCH_MP_TAC reflB_segment; ASM_REWRITE_TAC[]; DISCH_TAC; CONJ_TAC; (* 2nd clause *) ASM_REWRITE_TAC[GSYM reflB_squ]; (* goal 2c *) IMATCH_MP_TAC (ISPEC `reflBf (&:0)` IMAGE_SUBSET ); ASM_REWRITE_TAC[]; (* 3 *) TYPE_THEN `squc (down (reflBi (&:0) n)) = IMAGE (reflBf (&:0)) (squc n)` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM squ_squc); REWRITE_TAC[reflB_squ]; DISCH_THEN_REWRITE; (* end *) TYPE_THEN `v_edge (reflBi (&:0) m) = IMAGE (reflBf (&:0)) (v_edge (down m))` SUBGOAL_TAC; REWRITE_TAC[reflB_v_edge]; AP_TERM_TAC ; REWRITE_TAC[reflBi;down;PAIR_SPLIT ]; INT_ARITH_TAC; DISCH_THEN_REWRITE; CONJ_TAC; IMATCH_MP_TAC IMAGE_SUBSET; ASM_REWRITE_TAC[]; (* gok2 *) CONJ_TAC; EXPAND_TAC "G'"; REWRITE_TAC[IMAGE2]; UND 2; (* goal 3c *) MESON_TAC[image_imp]; (* <2> gok1 *) CONJ_TAC; EXPAND_TAC "G'"; EXPAND_TAC "e'"; REWRITE_TAC[IMAGE2]; ASM_MESON_TAC[image_imp]; EXPAND_TAC "e'"; (* 2 total *) TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) e) = IMAGE (reflBf (&:0)) (closure top2 e)` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;]; TYPE_THEN `edge e ` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET]; MESON_TAC[ISUBSET;edge_euclid2;]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM reflB_pointI]; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* <1> *) TYPE_THEN `p = down (reflBi (&:0) p')` ABBREV_TAC ; TYPE_THEN `squ p' = IMAGE (reflBf (&:0) ) (squ p)` SUBGOAL_TAC; ASM_REWRITE_TAC[reflB_squ;]; AP_TERM_TAC; EXPAND_TAC "p"; REWRITE_TAC[down ;reflBi;PAIR_SPLIT;]; INT_ARITH_TAC; DISCH_TAC; TYPE_THEN `p` EXISTS_TAC; (* LAST *) ASSUME_TAC top2_top; TYPE_THEN `homeomorphism (reflBf (&:0)) top2 top2` SUBGOAL_TAC; ASM_MESON_TAC[reflB_homeo]; DISCH_TAC; ASSUME_TAC top2_unions; TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC; MESON_TAC[squ_euclid;top2_unions]; DISCH_TAC; CONJ_TAC; (* split *) UND 12; ASM_REWRITE_TAC[]; EXPAND_TAC "e'"; TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) (squ p)) = IMAGE (reflBf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* x *) DISCH_TAC; IMATCH_MP_TAC (ISPEC `reflBf (&:0)` image_inj); TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC INJ_UNIV; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;]; CONJ_TAC; TYPE_THEN `edge e ` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET]; MESON_TAC[ISUBSET;edge_euclid2;]; IMATCH_MP_TAC closure_euclid; REWRITE_TAC[squ_euclid]; (* last'' *) IMATCH_MP_TAC (ISPEC `reflBf (&:0)` image_inj); TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC INJ_UNIV; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;]; CONJ_TAC; REWRITE_TAC[squ_euclid]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; ASM_REWRITE_TAC[component_unions;ctop_unions]; REWRITE_TAC[DIFF;SUBSET]; MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let along_lemma9 = prove_by_refinement( `!G m n e' x e. (segment G /\ (squ n SUBSET component (ctop G) x) /\ (e' SUBSET squc n) /\ (closure top2 e' (pointI m)) /\ (edge e') /\ (G e') /\ G e /\ (closure top2 e (pointI m)) ==> (?p. e SUBSET closure top2 (squ p) /\ (squ p SUBSET (component (ctop G) x))))`, (* {{{ proof *) [ REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[edge]); REP_BASIC_TAC; FIRST_ASSUM (DISJ_CASES_TAC); IMATCH_MP_TAC along_lemma8; ASM_MESON_TAC[]; TYPE_THEN `edge e` SUBGOAL_TAC; ASM_MESON_TAC[segment;ISUBSET]; ASM_SIMP_TAC[]; DISCH_TAC; KILL 3; REWR 4; REWR 2; REWR 5; KILL 8; (* INSERT lemmas here *) TYPE_THEN `e' = IMAGE (reflCf) e ` ABBREV_TAC ; TYPE_THEN `G' = IMAGE2 (reflCf) G` ABBREV_TAC ; TYPE_THEN `x' = reflCf x` ABBREV_TAC ; TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC; TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBGOAL_TAC; USE 6(REWRITE_RULE[SUBSET]); TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC; ASM_MESON_TAC[cell_nonempty;cell_rules]; REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; ASM_MESON_TAC[]; TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC; ASM_MESON_TAC[ctop_top]; ASM_SIMP_TAC [component_empty]; DISCH_TAC; TYPE_THEN `component (ctop G') x' = IMAGE (reflCf) (component (ctop G) x)` SUBGOAL_TAC; ASM_MESON_TAC[component_reflC;]; DISCH_TAC; (* gok to here *) TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC; IMATCH_MP_TAC along_lemma8; TYPE_THEN `(reflCi) m` EXISTS_TAC; TYPE_THEN `(reflCi n)` EXISTS_TAC; TYPE_THEN `reflCi m'` EXISTS_TAC; (SUBCONJ_TAC); (* 1st claus *) EXPAND_TAC "G'"; IMATCH_MP_TAC reflC_segment; ASM_REWRITE_TAC[]; DISCH_TAC; CONJ_TAC; (* 2nd clause *) ASM_REWRITE_TAC[GSYM reflC_squ]; (* goal 2c *) IMATCH_MP_TAC (ISPEC `reflCf` IMAGE_SUBSET ); ASM_REWRITE_TAC[]; (* 3 *) TYPE_THEN `squc ( (reflCi n)) = IMAGE (reflCf) (squc n)` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM squ_squc_C); REWRITE_TAC[reflC_squ]; DISCH_THEN_REWRITE; (* end *) TYPE_THEN `v_edge (reflCi m') = IMAGE (reflCf ) (h_edge ( m'))` SUBGOAL_TAC; REWRITE_TAC[reflC_hv_edge]; DISCH_THEN_REWRITE; CONJ_TAC; IMATCH_MP_TAC IMAGE_SUBSET; ASM_REWRITE_TAC[]; (* gok2 *) (* INSERT *) TYPE_THEN `!e. (edge e) ==> (closure top2 (IMAGE (reflCf ) e) = IMAGE (reflCf) (closure top2 e))` SUBGOAL_TAC; DISCH_ALL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;]; IMATCH_MP_TAC edge_euclid2; ASM_REWRITE_TAC[]; DISCH_TAC ; TYPE_THEN `edge (h_edge m')` SUBGOAL_TAC; ASM_MESON_TAC[edge]; DISCH_TAC; ASM_SIMP_TAC[]; REWRITE_TAC[GSYM reflC_pointI]; CONJ_TAC; ASM_MESON_TAC[image_imp]; (* to here *) CONJ_TAC; EXPAND_TAC "G'"; REWRITE_TAC[IMAGE2]; UND 2; (* goal 3c *) MESON_TAC[image_imp]; (* <2> gok1 *) CONJ_TAC; EXPAND_TAC "G'"; EXPAND_TAC "e'"; REWRITE_TAC[IMAGE2]; ASM_MESON_TAC[image_imp]; EXPAND_TAC "e'"; (* 2 total *) ASM_SIMP_TAC[]; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* <1> *) TYPE_THEN `p = reflCi p'` ABBREV_TAC ; TYPE_THEN `squ p' = IMAGE (reflCf ) (squ p)` SUBGOAL_TAC; ASM_REWRITE_TAC[reflC_squ;]; AP_TERM_TAC; EXPAND_TAC "p"; REWRITE_TAC[reflCi_inv;PAIR_SPLIT;]; DISCH_TAC; TYPE_THEN `p` EXISTS_TAC; (* LAST *) ASSUME_TAC top2_top; TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC; ASM_MESON_TAC[reflC_homeo]; DISCH_TAC; ASSUME_TAC top2_unions; TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC; MESON_TAC[squ_euclid;top2_unions]; DISCH_TAC; TYPE_THEN `closure top2 (IMAGE (reflCf) (squ p)) = IMAGE (reflCf) (closure top2 (squ p))` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM homeo_closure); ASM_REWRITE_TAC[]; DISCH_TAC; CONJ_TAC; (* split *) IMATCH_MP_TAC (ISPEC `reflCf` image_inj); TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC INJ_UNIV; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;]; CONJ_TAC; ASM_MESON_TAC[edge_euclid2]; CONJ_TAC; IMATCH_MP_TAC closure_euclid; REWRITE_TAC[squ_euclid]; UND 21; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); REWRITE_TAC[reflC_squ]; TYPE_THEN `reflCi p = p'` SUBGOAL_TAC; EXPAND_TAC "p"; REWRITE_TAC[reflCi_inv]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; (* last'' *) UND 13; ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC (ISPEC `reflCf` image_inj); TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC INJ_UNIV; TYPE_THEN `(euclid 2)` EXISTS_TAC; REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;]; CONJ_TAC; REWRITE_TAC[squ_euclid]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; ASM_REWRITE_TAC[component_unions;ctop_unions]; REWRITE_TAC[DIFF;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let along_lemma10 = prove_by_refinement( `!G x. (segment G /\ ~(component (ctop G) x = EMPTY) ) ==> inductive_set G { e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component (ctop G) x)) ) } `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `S = { e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component (ctop G) x)) ) } ` ABBREV_TAC ; REWRITE_TAC[inductive_set]; CONJ_TAC; EXPAND_TAC "S"; REWRITE_TAC[SUBSET]; MESON_TAC[]; CONJ_TAC; TYPE_THEN `(?m. squ m SUBSET (component (ctop G) x))` SUBGOAL_TAC; IMATCH_MP_TAC comp_squ; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(?p e. G e /\ e SUBSET closure top2 (squ p) /\ squ p SUBSET component (ctop G) x)` SUBGOAL_TAC; IMATCH_MP_TAC comp_squ_adj; ASM_MESON_TAC[]; REP_BASIC_TAC; UND 3; REWRITE_TAC[EMPTY_EXISTS ]; EXPAND_TAC "S"; REWRITE_TAC[]; REWRITE_TAC [squ_closure]; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[GSYM squ_closure]; REP_BASIC_TAC; UND 5; EXPAND_TAC "S"; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC; IMATCH_MP_TAC edge_inter; ASM_REWRITE_TAC[]; REP_BASIC_TAC; REWRITE_TAC[GSYM squ_closure]; IMATCH_MP_TAC along_lemma9; RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing;]); TYPE_THEN `m` EXISTS_TAC; TYPE_THEN `p` EXISTS_TAC; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let along_lemma11 = prove_by_refinement( `!G x e . (segment G /\ ~(component (ctop G) x = EMPTY) /\ (G e)) ==> (?p. (e SUBSET squc p) /\ (squ p SUBSET component (ctop G) x))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `S = {e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component (ctop G) x)) ) }` ABBREV_TAC ; TYPE_THEN ` S = G` SUBGOAL_TAC; COPY 2; UND 4; RULE_ASSUM_TAC (REWRITE_RULE[segment]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `inductive_set G S` SUBGOAL_TAC; EXPAND_TAC "S"; IMATCH_MP_TAC along_lemma10; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[inductive_set]; EXPAND_TAC "S"; DISCH_TAC; USE 4 GSYM; PROOF_BY_CONTR_TAC; UND 0; REWRITE_TAC[]; ONCE_ASM_REWRITE_TAC[]; REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) (* along_lemma11 is essentially the proof that there are only two connected components (because there are only two possible instantiations of p Come back and finish the proof of the Jordan curve. *) (* ------------------------------------------------------------------ *) (* SECTION I *) (* ------------------------------------------------------------------ *) (* ALL about graphs *) (*** JRH systematically changed (Y,X)graph to (X,Y)graph for all X and Y, and made corresponding changes to other type annotations. The core now alphabetically sorts the type variables in a definition. ***) let (mk_graph_t,dest_graph_t) = abbrev_type `:(A->bool)#(B->bool)#(B->(A->bool))` "graph_t";; let graph_vertex = jordan_def `graph_vertex (G:(A,B)graph_t) = FST (dest_graph_t G)`;; let graph_edge = jordan_def `graph_edge (G:(A,B)graph_t) = part1 (dest_graph_t G)`;; let graph_inc = jordan_def `graph_inc (G:(A,B)graph_t) = drop1 (dest_graph_t G)`;; let graph = jordan_def `graph (G:(A,B)graph_t) <=> (IMAGE (graph_inc G) (graph_edge G)) SUBSET { s | (s SUBSET (graph_vertex G)) /\ (s HAS_SIZE 2) }`;; let graph_incident = jordan_def `graph_incident (G:(A,B)graph_t) e x <=> (graph_edge G e) /\ (graph_inc G e x)`;; let graph_iso = jordan_def `graph_iso f (G:(A,B)graph_t) (H:(A',B')graph_t) <=> (?u v. (f = (u,v)) /\ (BIJ u (graph_vertex G) (graph_vertex H)) /\ (BIJ v (graph_edge G) (graph_edge H)) /\ (!e. (graph_edge G e) ==> (graph_inc H (v e) = IMAGE u (graph_inc G e))))`;; (* specify a graph by { {a,b}, .... } of endpoints of edges. *) let mk_simple_graph = jordan_def `mk_simple_graph (E:(A->bool)->bool) = mk_graph_t (UNIONS E, (E:(A->bool)->bool), (\ (x:A->bool) (y:A). (x y)))`;; let K33 = jordan_def `K33 = mk_simple_graph { {1,10}, {2,10}, {3,10}, {1,20}, {2,20}, {3,20}, {1,30}, {2,30}, {3,30} }`;; let graph_del = jordan_def `graph_del (G:(A,B)graph_t) V E = mk_graph_t ((graph_vertex G DIFF V), (graph_edge G DIFF (E UNION { (e:B) | ?(v:A). (V v /\ graph_incident G e v ) })), (graph_inc G))`;; let graph_path = jordan_def `graph_path (G:(A,B)graph_t) f n <=> (?v e . (f = (v,e)) /\ (INJ v { m | m <=| n } (graph_vertex G)) /\ (INJ e { m | m <| n } (graph_edge G)) /\ (!i. (i <| n ) ==> (graph_inc G (e i) = {(v i), (v (SUC i))})))`;; let graph_cycle = jordan_def `graph_cycle (G:(A,B)graph_t) f n <=> (?v e . (f = (v,e)) /\ (INJ v { m | m <| n } (graph_vertex G)) /\ (INJ e { m | m <| n } (graph_edge G)) /\ (!i. (i <| n ) ==> (graph_inc G (e i) = {(v i), (v ((SUC i) %| (n)))})))`;; let graph_connected = jordan_def `graph_connected (G:(A,B)graph_t) <=> !v v'. (graph_vertex G v) /\ (graph_vertex G v') /\ ~(v = v') ==> (?f n. (graph_path G f n) /\ (FST f 0 = v) /\ (FST f n = v'))`;; let graph_2_connected = jordan_def `graph_2_connected (G:(A,B)graph_t) <=> (graph_connected G) /\ (!v. (graph_vertex G v) ==> (graph_connected (graph_del G {v} EMPTY)))`;; let simple_arc = jordan_def `simple_arc (U:(A->bool)->bool) C <=> (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\ (continuous f (top_of_metric(UNIV,d_real)) U) /\ (INJ f { x | &.0 <= x /\ x <= &.1} (UNIONS U)))`;; let simple_closed_curve = jordan_def `simple_closed_curve (U:(A->bool)->bool) C <=> (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\ (continuous f (top_of_metric(UNIV,d_real)) U) /\ (INJ f { x | &.0 <= x /\ x < &.1} (UNIONS U)) /\ (f (&.0) = f (&.1)))`;; let simple_polygonal_arc = jordan_def `simple_polygonal_arc PE C <=> (simple_arc (top_of_metric(euclid 2,d_euclid)) C) /\ (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;; let simple_polygonal_curve = jordan_def `simple_polygonal_curve PE C <=> (simple_closed_curve (top_of_metric(euclid 2,d_euclid)) C) /\ (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;; let hv_line = jordan_def `hv_line E <=> (!e. (E e) ==> (?x y. (e = mk_line (point x) (point y)) /\ ((FST x = FST y) \/ (SND x = SND y))))`;; let p_conn = jordan_def `p_conn A x y <=> (?C. (simple_polygonal_arc hv_line C) /\ (C SUBSET A) /\ (C x) /\ (C y))`;; let subf = jordan_def `subf A (f:A->B) g x = if (A x) then (f x) else (g x)`;; let min_real_le = prove_by_refinement( `!x y. (min_real x y <= x) /\ (min_real x y <= y)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; UND 0; REAL_ARITH_TAC; UND 0; REAL_ARITH_TAC ; ]);; (* }}} *) let subf_lemma = prove_by_refinement( `!X dX B (x:A). (metric_space (X,dX)) /\ (closed_ (top_of_metric(X,dX)) B) /\ (~(B x)) /\ (X x) ==> (?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))`, (* {{{ proof *) [ REWRITE_TAC[closed;open_DEF ]; REP_BASIC_TAC; UND 2; UND 3; ASM_SIMP_TAC[GSYM top_of_metric_unions]; REP_BASIC_TAC; TYPE_THEN `(X DIFF B) x` SUBGOAL_TAC; REWRITE_TAC[DIFF]; ASM_REWRITE_TAC[]; DISCH_TAC; TYPEL_THEN [`X`;`dX`;`(X DIFF B)`;`x`] (fun t-> ASSUME_TAC (ISPECL t open_ball_nbd)); (* // *) REP_BASIC_TAC; REWR 6; TYPE_THEN `e` EXISTS_TAC; UND 6; REWRITE_TAC[open_ball;SUBSET;DIFF;]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_MESON_TAC[ISUBSET ;]; ]);; (* }}} *) let subf_cont = prove_by_refinement( `!X dX Y dY A B (f:A->B) g. ((metric_space (X,dX)) /\ (metric_space (Y,dY)) /\ (closed_ (top_of_metric(X,dX)) A ) /\ (closed_ (top_of_metric(X,dX)) B ) /\ (metric_continuous f (A,dX) (Y,dY)) /\ (metric_continuous g (B,dX) (Y,dY)) /\ (!x. (A x /\ B x) ==> (f x = g x))) ==> (metric_continuous (subf A f g) (A UNION B,dX) (Y,dY))`, (* {{{ proof *) [ REWRITE_TAC[metric_continuous;metric_continuous_pt]; DISCH_ALL_TAC; DISCH_ALL_TAC; RIGHT_TAC "delta"; DISCH_TAC; REWRITE_TAC[UNION]; TYPE_THEN `(A x \/ ~(A x)) /\ (B x \/ (~(B x)))` (fun t-> MP_TAC (TAUT t )); DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[GSYM DISJ_ASSOC;RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR] t)); REP_CASES_TAC; TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL); TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL); REP_BASIC_TAC; REWR 8; REWR 9; TYPE_THEN `min_real delta delta'` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `A y \/ (~(A y) /\ B y)` SUBGOAL_TAC; UND 9; MESON_TAC[]; DISCH_THEN DISJ_CASES_TAC; REWRITE_TAC[subf]; ASM_REWRITE_TAC[]; UND 12; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 8; (* save_goal "ss" *) TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC; REWRITE_TAC[min_real_le]; REAL_ARITH_TAC; (* 1b case *) REWRITE_TAC[subf]; ASM_REWRITE_TAC[]; TYPE_THEN `f x = g x` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; UND 10; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 8; TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC; REWRITE_TAC[min_real_le]; REAL_ARITH_TAC ; (* 2nd case *) TYPE_THEN `X x` SUBGOAL_TAC; UND 2; REWRITE_TAC[closed;open_DEF;SUBSET ;]; REP_BASIC_TAC; TSPEC `x` 8; UND 8; ASM_REWRITE_TAC[]; UND 0; SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))` SUBGOAL_TAC; IMATCH_MP_TAC subf_lemma; TYPE_THEN `X` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL); REP_BASIC_TAC; REWR 4; TYPE_THEN `min_real delta delta'` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `A y` SUBGOAL_TAC; TYPE_THEN `~(B y) ==> A y` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; UND 4; TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC; REWRITE_TAC[min_real_le]; REAL_ARITH_TAC; REWRITE_TAC[subf]; DISCH_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 4; TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC; REWRITE_TAC[min_real_le]; REAL_ARITH_TAC; (* 2 LEFT *) TYPE_THEN `X x` SUBGOAL_TAC; UND 3; REWRITE_TAC[closed;open_DEF;SUBSET ;]; REP_BASIC_TAC; TSPEC `x` 8; UND 8; ASM_REWRITE_TAC[]; UND 0; SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(A y))))` SUBGOAL_TAC; IMATCH_MP_TAC subf_lemma; TYPE_THEN `X` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL); REP_BASIC_TAC; REWR 5; TYPE_THEN `min_real delta delta'` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `~(A y)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 5; TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC; REWRITE_TAC[min_real_le]; REAL_ARITH_TAC; REWRITE_TAC[subf]; DISCH_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `B y` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; UND 5; TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC; REWRITE_TAC[min_real_le]; REAL_ARITH_TAC; (* 1 LEFT *) TYPE_THEN `&1` EXISTS_TAC; ASM_MESON_TAC [REAL_ARITH `&0 < &1`]; ]);; (* }}} *) let p_conn_subset = prove_by_refinement( `!A B x y. (A SUBSET B) /\ (p_conn A x y) ==> (p_conn B x y)`, (* {{{ proof *) [ REWRITE_TAC[p_conn]; REP_BASIC_TAC; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let mk_line_symm = prove_by_refinement( `!x y. mk_line x y = mk_line y x`, (* {{{ proof *) [ REWRITE_TAC[mk_line]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; EQ_TAC; REP_BASIC_TAC; TYPE_THEN `(&1 - t)` EXISTS_TAC; ONCE_REWRITE_TAC [euclid_add_comm]; ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`]; REP_BASIC_TAC; TYPE_THEN `(&1 - t)` EXISTS_TAC; ONCE_REWRITE_TAC [euclid_add_comm]; ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`]; ]);; (* }}} *) let mk_line_sub = prove_by_refinement( `!x y z. ( ~(x = z) /\ (mk_line x y z)) ==> (mk_line x y = mk_line x z)`, (* {{{ proof *) [ REWRITE_TAC[mk_line]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; EQ_TAC; REP_BASIC_TAC; TYPE_THEN `~(t = &1)` SUBGOAL_TAC; REP_BASIC_TAC; REWR 0; UND 0; REDUCE_TAC; REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero]; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `s = (&1 /(&1 - t))` ABBREV_TAC; TYPE_THEN `(t' - t)*s` EXISTS_TAC; ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;]; TYPE_THEN `(&1 - t) * s = &1` SUBGOAL_TAC; EXPAND_TAC "s"; IMATCH_MP_TAC REAL_DIV_LMUL; UND 3; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `(t' - t) * s + (&1 - (t' - t) * s) * t = (t' - t) *((&1- t)* s) + t ` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; TYPE_THEN `(&1 - (t' - t) * s)*(&1 - t) = (&1 - t) - (t' - t)*(&1-t)*s` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `((t' - t)* &1 + t = t') /\ (&1 - t - (t' - t)* &1 = (&1 - t'))`]; (* 2nd half *) REP_BASIC_TAC; UND 2; ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;]; DISCH_THEN_REWRITE; TYPE_THEN `t' + (&1 - t')*t` EXISTS_TAC; TYPE_THEN `(&1 - (t' + (&1 - t') * t)) = ((&1 - t') * (&1 - t))` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; ]);; (* }}} *) let mk_line_2 = prove_by_refinement( `!x y p q. (mk_line x y p) /\ (mk_line x y q) /\ (~(p = q)) ==> (mk_line x y = mk_line p q)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `x = p` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC mk_line_sub; ASM_MESON_TAC[]; ASM_MESON_TAC[mk_line_sub;mk_line_symm]; ]);; (* }}} *) let mk_line_inter = prove_by_refinement( `!x y p q. ~(mk_line x y = mk_line p q) ==> (?z. (mk_line x y INTER mk_line p q) SUBSET {z} )`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?z. (mk_line x y INTER mk_line p q) z)` ASM_CASES_TAC; REP_BASIC_TAC; TYPE_THEN `z` EXISTS_TAC; REWRITE_TAC[INTER;SUBSET;INR IN_SING;]; REP_BASIC_TAC; UND 1; REWRITE_TAC[INTER]; REP_BASIC_TAC; ASM_MESON_TAC[mk_line_2]; REWRITE_TAC[SUBSET;INR IN_SING]; ASM_MESON_TAC[]; ]);; (* }}} *) let mk_line_fin_inter = prove_by_refinement( `!E. (FINITE E) /\ (!e. (E e) ==> (?x y. e = mk_line x y)) ==> (?X. (FINITE X) /\ (!e f z. (E e) /\ (E f) /\ ~(e = f) /\ e z /\ f z ==> (X z)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `E2 = { (e,f) | (E e) /\ (E f) /\ (~(e = f)) }` ABBREV_TAC; TYPE_THEN `EE = { (e,f) | (E e) /\ (E f) }` ABBREV_TAC; (* *) TYPE_THEN `FINITE EE` SUBGOAL_TAC; EXPAND_TAC "EE"; IMATCH_MP_TAC (INR FINITE_PRODUCT); ASM_REWRITE_TAC[]; DISCH_TAC; (* *) TYPE_THEN `FINITE E2` SUBGOAL_TAC; EXPAND_TAC "E2"; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `EE` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "EE"; EXPAND_TAC "E2"; REWRITE_TAC[SUBSET;]; MESON_TAC[]; DISCH_TAC; (* *) TYPE_THEN `E3 = IMAGE (\u. (FST u INTER SND u)) E2` ABBREV_TAC; TYPE_THEN `FINITE E3` SUBGOAL_TAC; EXPAND_TAC "E3"; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; (* *) TYPE_THEN `UNIONS E3` EXISTS_TAC; CONJ_TAC; ASM_SIMP_TAC[FINITE_FINITE_UNIONS]; GEN_TAC; EXPAND_TAC "E3"; EXPAND_TAC "E2"; REWRITE_TAC[IMAGE]; CONV_TAC (dropq_conv "x"); REP_BASIC_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `e` (WITH 0 o ISPEC); TYPE_THEN `f` (USE 0 o ISPEC); UND 0; UND 12; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; (* *) TYPE_THEN `(?z. (mk_line x y INTER mk_line x' y') SUBSET {z} )` SUBGOAL_TAC; IMATCH_MP_TAC mk_line_inter; ASM_MESON_TAC[]; REP_BASIC_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{z}` EXISTS_TAC; ASM_REWRITE_TAC[FINITE_SING ]; REP_BASIC_TAC; EXPAND_TAC "E3"; EXPAND_TAC "E2"; REWRITE_TAC[IMAGE]; REWRITE_TAC[UNIONS]; CONV_TAC (dropq_conv "x"); CONV_TAC (dropq_conv "u"); REWRITE_TAC[INTER]; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let euclid_euclid0 = prove_by_refinement( `!n. (euclid n (euclid0))`, (* {{{ proof *) [ REWRITE_TAC[euclid0;euclid]; ]);; (* }}} *) let euclid0_point = prove_by_refinement( `euclid0 = point(&0,&0)`, (* {{{ proof *) [ REWRITE_TAC[point_split;euclid_euclid0]; REWRITE_TAC[euclid0]; ]);; (* }}} *) let EVEN2 = prove_by_refinement( `EVEN 0 /\ ~(EVEN 1) /\ (EVEN 2) /\ ~(EVEN 3) /\ (EVEN 4) /\ ~(EVEN 5)`, (* {{{ proof *) [ REWRITE_TAC[EVEN; ARITH_RULE `(1 = SUC 0) /\ (2 = SUC 1) /\ (3 = SUC 2) /\ (4 = SUC 3) /\ (5 = SUC 4)`]; ]);; (* }}} *) let h_seg_openball = prove_by_refinement( `!x e e'. (&0 < e) /\ (&0 <= e') /\ (e' < e) /\ (euclid 2 x) ==> (mk_segment x (x + e' *# e1) SUBSET (open_ball(euclid 2,d_euclid)) x e)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[open_ball;mk_segment;SUBSET;]; REP_BASIC_TAC; USE 4 (SYM); UND 4; REWRITE_TAC[GSYM euclid_add_assoc;euclid_ldistrib;GSYM euclid_rdistrib]; REWRITE_TAC[REAL_ARITH `a + &1 - a = &1`;euclid_scale_one;euclid_scale_act]; TYPE_THEN `x'' = (((&1 - a) * e') *# e1)` ABBREV_TAC ; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `euclid 2 x''` SUBGOAL_TAC; EXPAND_TAC "x''"; IMATCH_MP_TAC euclid_scale_closure; REWRITE_TAC[e1;euclid_point]; DISCH_TAC; SUBCONJ_TAC; EXPAND_TAC "x'"; IMATCH_MP_TAC euclid_add_closure; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `!x y. d_euclid x y = d_euclid (x+euclid0) y ` SUBGOAL_TAC; REWRITE_TAC[euclid_rzero]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); EXPAND_TAC "x'"; ASSUME_TAC euclid_euclid0; KILL 7; TYPE_THEN `d_euclid (euclid_plus x euclid0) (euclid_plus x x'') = d_euclid euclid0 x''` SUBGOAL_TAC; ASM_MESON_TAC[metric_translate_LEFT]; DISCH_THEN_REWRITE; EXPAND_TAC "x''"; REWRITE_TAC[e1;point_scale]; REDUCE_TAC; REWRITE_TAC[euclid0_point;d_euclid_point;]; REDUCE_TAC; REWRITE_TAC[EXP_2;ARITH_RULE `0 *| 0 = 0`]; REDUCE_TAC; REWRITE_TAC[REAL_ARITH `&0 - x = --x`;REAL_POW_NEG;EVEN2]; TYPE_THEN `&0 <= (&1 - a) * e'` SUBGOAL_TAC; IMATCH_MP_TAC REAL_LE_MUL; ASM_REWRITE_TAC[]; UND 5; REAL_ARITH_TAC; ASM_SIMP_TAC[POW_2_SQRT;]; DISCH_TAC; ASM_CASES_TAC `a = &0`; ASM_REWRITE_TAC[]; REDUCE_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(&1 - a) * e' < &1 * e ==> (&1 - a) * e' < e` SUBGOAL_TAC; REAL_ARITH_TAC; DISCH_THEN IMATCH_MP_TAC ; IMATCH_MP_TAC REAL_LT_MUL2; ASM_REWRITE_TAC[]; UND 5; UND 6; UND 11; REAL_ARITH_TAC; ]);; (* }}} *) let openball_convex = prove_by_refinement( `!x e n. (convex (open_ball (euclid n,d_euclid) x e))`, (* {{{ proof *) [ REWRITE_TAC[convex;open_ball;SUBSET;mk_segment;]; REP_BASIC_TAC; USE 0 SYM; ASM_REWRITE_TAC[]; SUBCONJ_TAC; EXPAND_TAC "x''"; IMATCH_MP_TAC (euclid_add_closure); CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); DISCH_TAC; TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC; REWRITE_TAC[trivial_lin_combo]; DISCH_THEN_REWRITE; EXPAND_TAC "x''"; (* special case *) ASM_CASES_TAC `a = &0` ; UND 10; DISCH_THEN_REWRITE; REDUCE_TAC; ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;]; TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u < a*e) /\ (v <= (&1- a)*e)) ==> (d < e))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `u + v < (a*e) + (&1 - a)*e` SUBGOAL_TAC; IMATCH_MP_TAC REAL_LTE_ADD2; ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`]; UND 13; REAL_ARITH_TAC ; DISCH_THEN IMATCH_MP_TAC ; TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC; TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC; TYPE_THEN `d_euclid z x''` EXISTS_TAC; TYPE_THEN `euclid n z` SUBGOAL_TAC; EXPAND_TAC "z"; IMATCH_MP_TAC (euclid_add_closure); CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); DISCH_TAC; CONJ_TAC; EXPAND_TAC "x''"; IMATCH_MP_TAC metric_space_triangle; TYPE_THEN `euclid n` EXISTS_TAC; REWRITE_TAC[metric_euclid]; ASM_REWRITE_TAC[trivial_lin_combo]; CONJ_TAC; EXPAND_TAC "z"; TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid (a *# x) (a *# x') ` SUBGOAL_TAC; IMATCH_MP_TAC metric_translate; TYPE_THEN `n` EXISTS_TAC; REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); DISCH_THEN_REWRITE; TYPE_THEN `d_euclid (a *# x) (a *# x') = abs (a) * d_euclid x x'` SUBGOAL_TAC; IMATCH_MP_TAC norm_scale_vec; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `abs a = a` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ABS_REFL]; DISCH_THEN_REWRITE; IMATCH_MP_TAC REAL_PROP_LT_LMUL; ASM_REWRITE_TAC[]; UND 10; UND 2; REAL_ARITH_TAC; (* LAST case *) EXPAND_TAC "z"; EXPAND_TAC "x''"; TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC; IMATCH_MP_TAC metric_translate_LEFT; TYPE_THEN `n` EXISTS_TAC; REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); DISCH_THEN_REWRITE; TYPE_THEN `!b. d_euclid (b *# x) (b *# y) = abs (b) * d_euclid x y` SUBGOAL_TAC; GEN_TAC; IMATCH_MP_TAC norm_scale_vec; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `abs (&1 - a) = (&1 - a)` SUBGOAL_TAC; REWRITE_TAC [REAL_ABS_REFL]; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; IMATCH_MP_TAC REAL_PROP_LE_LMUL; ASM_REWRITE_TAC[]; CONJ_TAC; UND 1; REAL_ARITH_TAC; UND 3; REAL_ARITH_TAC; ]);; (* }}} *) let openball_mk_segment_end = prove_by_refinement( `!x e n u v. (open_ball(euclid n,d_euclid) x e u) /\ (open_ball(euclid n,d_euclid) x e v) ==> (mk_segment u v SUBSET (open_ball(euclid n,d_euclid) x e))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC openball_convex; TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL); USE 2 (REWRITE_RULE[convex]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let euclid_eq_minus = prove_by_refinement( `!x y. (x = y) <=> (euclid_minus x y = euclid0)`, (* {{{ proof *) [ REWRITE_TAC[euclid_minus;euclid0]; REP_BASIC_TAC; EQ_TAC ; DISCH_THEN_REWRITE; REDUCE_TAC; DISCH_TAC; IMATCH_MP_TAC EQ_EXT; ONCE_REWRITE_TAC [REAL_ARITH `(a = b) <=> (a - b = &0)`]; GEN_TAC; FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x':num`)); BETA_TAC ; MESON_TAC[]; ]);; (* }}} *) let euclid_plus_pair = prove_by_refinement( `!x y u v. (euclid_plus (x + y) (u + v) = (x + u) + (y + v))`, (* {{{ proof *) [ REWRITE_TAC[euclid_plus]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; BETA_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let euclid_minus_scale = prove_by_refinement( `!x y. (euclid_minus x y = euclid_plus x ((-- &.1) *# y))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale]; IMATCH_MP_TAC EQ_EXT; BETA_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let euclid_scale_cancel = prove_by_refinement( `!t x y . (~(t = &0)) /\ (t *# x = t *# y) ==> (x = y)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; FIRST_ASSUM (fun t -> MP_TAC (AP_THM t `x':num`)); REWRITE_TAC[euclid_scale;]; ASM_MESON_TAC[REAL_MUL_LTIMES]; ]);; (* }}} *) let mk_segment_inj_image = prove_by_refinement( `!x y n. (euclid n x) /\ (euclid n y) /\ ~(x = y) ==> (?f. (continuous f (top_of_metric(UNIV,d_real)) (top_of_metric (euclid n,d_euclid))) /\ (INJ f {x | &0 <= x /\ x <= &1} (euclid n)) /\ (IMAGE f {t | &.0 <=. t /\ t <=. &.1} = mk_segment x y))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC cont_mk_segment; ASM_REWRITE_TAC[]; REWRITE_TAC[joinf;IMAGE ]; REWRITE_TAC[mk_segment]; CONJ_TAC; (* new stuff *) REWRITE_TAC[INJ]; CONJ_TAC; REP_BASIC_TAC; TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; UND 4; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_CASES_TAC `x' < &1`; ASM_REWRITE_TAC[]; IMATCH_MP_TAC euclid_add_closure; CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; UND 3; TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; UND 7; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `~(y' < &0)` SUBGOAL_TAC; UND 5; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC; TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC; UND 6; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `~(x' < &1)` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; REDUCE_TAC; REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; DISCH_THEN_REWRITE; TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC; TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC; UND 4; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `~(y' < &1)` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; REDUCE_TAC; REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; DISCH_THEN_REWRITE; (* th *) ONCE_REWRITE_TAC [euclid_eq_minus]; REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act]; ONCE_REWRITE_TAC [euclid_plus_pair]; REWRITE_TAC[GSYM euclid_rdistrib]; REDUCE_TAC; REWRITE_TAC[REAL_ARITH `x' + -- &1 * y' = x' - y'`]; REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`]; REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus]; (* th1 *) DISCH_TAC; PROOF_BY_CONTR_TAC; UND 2; REWRITE_TAC[]; IMATCH_MP_TAC euclid_scale_cancel; TYPE_THEN `(x' - y')` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 8; REAL_ARITH_TAC; KILL 2; (* old stuff *) IMATCH_MP_TAC EQ_EXT; GEN_TAC; ASM_REWRITE_TAC[]; EQ_TAC; DISCH_TAC; CHO 2; UND 2; COND_CASES_TAC; DISCH_ALL_TAC; JOIN 3 2; ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`]; DISCH_ALL_TAC; UND 5; COND_CASES_TAC; DISCH_TAC; TYPE_THEN `&1 - x''` EXISTS_TAC; SUBCONJ_TAC; UND 5; REAL_ARITH_TAC ; DISCH_TAC; CONJ_TAC; UND 3; REAL_ARITH_TAC ; ONCE_REWRITE_TAC [euclid_add_comm]; REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`]; ASM_MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; CONJ_TAC; REAL_ARITH_TAC ; CONJ_TAC; REAL_ARITH_TAC ; REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; (* 2nd half *) DISCH_TAC; CHO 2; TYPE_THEN `&1 - a` EXISTS_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; AND 2; AND 2; UND 3; UND 4; REAL_ARITH_TAC ; COND_CASES_TAC; ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`]; COND_CASES_TAC; REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; ASM_MESON_TAC [euclid_add_comm]; TYPE_THEN `a = &.0` SUBGOAL_TAC; UND 4; UND 3; AND 2; UND 3; REAL_ARITH_TAC ; DISCH_TAC; REWR 2; REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; ]);; (* }}} *) let h_simple_polygonal = prove_by_refinement( `!x e. (euclid 2 x) /\ (~(e = &0)) ==> (simple_polygonal_arc hv_line (mk_segment x (x + e *# e1)))`, (* {{{ proof *) [ REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ]; REP_BASIC_TAC; CONJ_TAC; ASSUME_TAC mk_segment_inj_image; TYPEL_THEN [`x`;`x + (e *# e1)`;`2`] (USE 2 o ISPECL); TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e1)) /\ ~(x = euclid_plus x (e *# e1))` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC euclid_add_closure; ASM_REWRITE_TAC[]; IMATCH_MP_TAC euclid_scale_closure; REWRITE_TAC [e1;euclid_point]; REP_BASIC_TAC; FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `0`)); REWRITE_TAC[euclid_plus;euclid_scale;e1;coord01]; UND 0; REAL_ARITH_TAC; DISCH_TAC; REWR 2; REP_BASIC_TAC; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; SIMP_TAC [GSYM top_of_metric_unions;metric_euclid]; ASM_REWRITE_TAC[]; (* E *) USE 1 (MATCH_MP point_onto); REP_BASIC_TAC; TYPE_THEN `{(mk_line (point p) (point p + (e *# e1)))}` EXISTS_TAC; REWRITE_TAC[INR IN_SING]; CONJ_TAC; REWRITE_TAC[e1;ISUBSET;mk_segment;mk_line]; REP_BASIC_TAC; TYPE_THEN `a` EXISTS_TAC; ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC[FINITE_SING]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; TYPE_THEN `(FST p + e, SND p)` EXISTS_TAC; REWRITE_TAC[]; AP_TERM_TAC; REWRITE_TAC[e1;point_scale]; REDUCE_TAC; TYPE_THEN `euclid_plus (point p) (point (e,&0)) = euclid_plus (point (FST p,SND p)) (point (e,&0))` SUBGOAL_TAC; REWRITE_TAC[]; DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]); REWRITE_TAC[point_add]; REDUCE_TAC; ]);; (* }}} *) let pconn_refl = prove_by_refinement( `!A x. (top2 A) /\ (A x) ==> (p_conn A x x)`, (* {{{ proof *) [ REWRITE_TAC[p_conn;top2]; REP_BASIC_TAC; TYPE_THEN `?e. (&0 < e) /\ (open_ball(euclid 2,d_euclid) x e SUBSET A)` SUBGOAL_TAC; ASM_MESON_TAC[open_ball_nbd;metric_euclid]; REP_BASIC_TAC; TYPE_THEN `mk_segment x (x + (e/(&2))*# e1)` EXISTS_TAC; TYPE_THEN `euclid 2 x` SUBGOAL_TAC; USE 1(MATCH_MP sub_union); UND 1; ASM_MESON_TAC [top_of_metric_unions;metric_euclid;ISUBSET]; DISCH_TAC; TYPE_THEN `~(e/(&2) = &0)` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `(&0 < x) ==> (~(x = &0))` ); ASM_REWRITE_TAC[REAL_LT_HALF1]; DISCH_TAC; CONJ_TAC; IMATCH_MP_TAC h_simple_polygonal; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `open_ball (euclid 2,d_euclid) x e ` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC h_seg_openball; ASM_REWRITE_TAC[]; UND 3; MESON_TAC[half_pos;REAL_ARITH `&0 < x ==> &0 <= x`]; REWRITE_TAC[mk_segment]; TYPE_THEN `&1` EXISTS_TAC; REDUCE_TAC; REWRITE_TAC[euclid_scale_one ;euclid_scale0;euclid_rzero;]; ARITH_TAC; ]);; (* }}} *) let pconn_symm = prove_by_refinement( `!A x y. (p_conn A x y ==> p_conn A y x)`, (* {{{ proof *) [ REWRITE_TAC[p_conn;]; MESON_TAC[]; ]);; (* }}} *) let compose_cont = prove_by_refinement( `!(f:A->B) (g:B->C) X dX Y dY Z dZ. (metric_continuous f (X,dX) (Y,dY)) /\ (metric_continuous g (Y,dY) (Z,dZ)) /\ (IMAGE f X SUBSET Y) ==> (metric_continuous (compose g f) (X,dX) (Z,dZ))`, (* {{{ proof *) [ REWRITE_TAC[metric_continuous;metric_continuous_pt]; REP_BASIC_TAC; RIGHT_TAC "delta"; DISCH_TAC; REWRITE_TAC[compose]; TYPEL_THEN [`f x`;`epsilon`] (USE 1 o ISPECL); REP_BASIC_TAC; REWR 1; REP_BASIC_TAC; TYPEL_THEN [`x`;`delta`] (USE 2 o ISPECL); REP_BASIC_TAC; REWR 2; REP_BASIC_TAC; TYPE_THEN `delta'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USE 0 (REWRITE_RULE[IMAGE;SUBSET]); ASM_MESON_TAC[]; ]);; (* }}} *) let compose_image = prove_by_refinement( `!(f:A->B) (g:B->C) X. (IMAGE (compose g f) X) = (IMAGE g (IMAGE f X))`, (* {{{ proof *) [ REWRITE_TAC[IMAGE]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; GEN_TAC; NAME_CONFLICT_TAC; REWRITE_TAC[compose]; CONV_TAC (dropq_conv "x''"); ]);; (* }}} *) let linear_cont = prove_by_refinement( `!a b. metric_continuous (\t. t * a + (&1 - t)* b) (UNIV,d_real) (UNIV,d_real)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[metric_continuous;metric_continuous_pt]; REP_BASIC_TAC; RIGHT_TAC "delta"; DISCH_TAC; TYPE_THEN `a = b` ASM_CASES_TAC; ASM_REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `!u. u + &1 - u = &1`]; REDUCE_TAC; ASM_REWRITE_TAC[d_real;REAL_ARITH `b - b = &0`;ABS_0;]; TYPE_THEN `epsilon` EXISTS_TAC; ASM_REWRITE_TAC[]; (* snd *) TYPE_THEN `delta = epsilon/(abs (a-b))` ABBREV_TAC; TYPE_THEN `delta` EXISTS_TAC; SUBCONJ_TAC; EXPAND_TAC "delta"; IMATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[]; UND 1; REAL_ARITH_TAC; DISCH_TAC; REWRITE_TAC[d_real]; REP_BASIC_TAC; TYPE_THEN `((x * a + (&1 - x) * b) - (y * a + (&1 - y) * b)) = (x - y)*(a - b)` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; TYPE_THEN `epsilon = delta * (abs (a - b))` SUBGOAL_TAC; EXPAND_TAC "delta"; ONCE_REWRITE_TAC [EQ_SYM_EQ]; IMATCH_MP_TAC REAL_DIV_RMUL; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[ABS_MUL]; IMATCH_MP_TAC REAL_PROP_LT_RMUL; ASM_REWRITE_TAC[]; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let linear_image_gen = prove_by_refinement( `!a b c d. (a < b) /\ (c < d) ==> (IMAGE (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b ) {x | c <= x /\ x <= d } = {y | a <= y /\ y <= b})`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC; UND 1; REAL_ARITH_TAC; TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; REP_BASIC_TAC; ABBREV_TAC `e = &1/(d-c)`; TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC; GEN_TAC; EXPAND_TAC "e"; REWRITE_TAC[real_div]; REDUCE_TAC; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC; EXPAND_TAC "e"; REWRITE_TAC[real_div]; REDUCE_TAC; REWRITE_TAC[GSYM real_div]; IMATCH_MP_TAC REAL_DIV_REFL; UND 3; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `&0 < e` SUBGOAL_TAC; EXPAND_TAC "e"; IMATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; (* *) EQ_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * a + ((d - x') * e) * b) ==> (a <= ((x' - c) * e) * a + ((d - x') * e) * b)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_MUL_ASSOC]; REDUCE_TAC; DISCH_THEN IMATCH_MP_TAC ; ineq_le_tac `(d-c)*e*a + (d - x')*(b - a)*e = ((x' - c) * e) * a + ((d - x') * e) * b`; TYPE_THEN `(((x' - c) * e) * a + ((d - x') * e) * b <= b*((d- c)*e)) ==> (((x' - c) * e) * a + ((d - x') * e) * b <= b)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`]; DISCH_THEN IMATCH_MP_TAC ; ineq_le_tac `(((x' - c) * e) * a + ((d - x') * e) * b) + (x'-c )*(b-a)*e = b * (d - c) * e`; (* 2nd direction *) REP_BASIC_TAC; TYPE_THEN `x' = ((d*b - a*c) - (d -c)*x)/(b - a)` ABBREV_TAC ; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `x'*(b - a) = ((d*b - a*c) - (d -c)*x)` SUBGOAL_TAC; EXPAND_TAC "x'"; IMATCH_MP_TAC REAL_DIV_RMUL; UND 1; REAL_ARITH_TAC; DISCH_TAC; (* sv *) SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`; MESON_TAC[REAL_PROP_LE_RCANCEL]; DISCH_TAC; CONJ_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `(b - a)` EXISTS_TAC; ASM_REWRITE_TAC[]; ineq_le_tac `c * (b - a) + (d-c)*(b-x) = d * b - a * c - (d - c) * x`; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `(b - a)` EXISTS_TAC; ASM_REWRITE_TAC[]; ineq_le_tac `(d * b - a * c - (d - c) * x) + (d-c)*(x-a) = d * (b - a)`; TYPE_THEN `((x' - c) * e) * a + ((d - x') * e) * b = (d*b - c*a - x'*(b-a))*e` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; TYPE_THEN `(d * b - c * a - (d * b - a * c - (d - c) * x)) = x*(d-c)` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM REAL_MUL_ASSOC]; ASM_REWRITE_TAC[]; REDUCE_TAC; ]);; (* }}} *) let linear_image_rev = prove_by_refinement( `!a b c d. (a < b) /\ (c < d) ==> (IMAGE (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a ) {x | c <= x /\ x <= d } = {y | a <= y /\ y <= b})`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC; UND 1; REAL_ARITH_TAC; TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; REP_BASIC_TAC; ABBREV_TAC `e = &1/(d-c)`; TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC; GEN_TAC; EXPAND_TAC "e"; REWRITE_TAC[real_div]; REDUCE_TAC; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC; EXPAND_TAC "e"; REWRITE_TAC[real_div]; REDUCE_TAC; REWRITE_TAC[GSYM real_div]; IMATCH_MP_TAC REAL_DIV_REFL; UND 3; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `&0 < e` SUBGOAL_TAC; EXPAND_TAC "e"; IMATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; (* *) EQ_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * b + ((d - x') * e) * a) ==> (a <= ((x' - c) * e) * b + ((d - x') * e) * a)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_MUL_ASSOC]; REDUCE_TAC; DISCH_THEN IMATCH_MP_TAC ; ineq_le_tac `(d-c)*e*a + (x' - c)*(b - a)*e = ((x' - c) * e) * b + ((d - x') * e) * a`; TYPE_THEN `(((x' - c) * e) * b + ((d - x') * e) * a <= b*((d- c)*e)) ==> (((x' - c) * e) * b + ((d - x') * e) * a <= b)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`]; DISCH_THEN IMATCH_MP_TAC ; ineq_le_tac `(((x' - c) * e) * b + ((d - x') * e) * a) + (d - x' )*(b-a)*e = b * (d - c) * e`; (* 2nd direction *) REP_BASIC_TAC; TYPE_THEN `x' = ((b*c - a*d) + (d -c)*x)/(b - a)` ABBREV_TAC ; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `x'*(b - a) = ((b*c - a*d ) + (d -c)*x)` SUBGOAL_TAC; EXPAND_TAC "x'"; IMATCH_MP_TAC REAL_DIV_RMUL; UND 1; REAL_ARITH_TAC; DISCH_TAC; (* sv *) SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`; MESON_TAC[REAL_PROP_LE_RCANCEL]; DISCH_TAC; CONJ_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `(b - a)` EXISTS_TAC; ASM_REWRITE_TAC[]; ineq_le_tac `c * (b - a) + (d-c)*(x-a) = b*c - a*d + (d - c) * x`; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `(b - a)` EXISTS_TAC; ASM_REWRITE_TAC[]; ineq_le_tac `(b*c - a*d + (d - c) * x) + (d-c)*(b - x) = d * (b - a)`; TYPE_THEN `((x' - c) * e) * b + ((d - x') * e) * a = (d*a - c*b + x'*(b-a))*e` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; TYPE_THEN `(d * a - c * b + b * c - a * d + (d - c) * x) = x*(d-c)` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM REAL_MUL_ASSOC]; ASM_REWRITE_TAC[]; REDUCE_TAC; ]);; (* }}} *) let linear_inj = prove_by_refinement( `!a b c d. (a < b) /\ (c < d) ==> (INJ (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b ) {x | c <= x /\ x <= d } {y | a <= y /\ y <= b})`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[INJ]; CONJ_TAC; REP_BASIC_TAC; ASSUME_TAC linear_image_gen; TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL); REWR 4; UND 4; REWRITE_TAC[IMAGE]; DISCH_TAC; FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * a + (d - x) / (d - c) * b`)); UND 5; REWRITE_TAC[]; DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; (* INJ proper *) REP_BASIC_TAC; UND 2; TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ; TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC"e"; REWRITE_TAC[real_div]; REDUCE_TAC; DISCH_THEN_REWRITE; DISCH_TAC; USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]); UND 8; TYPE_THEN `(((x - c) * e) * a + ((d - x) * e) * b) - (((y - c) * e) * a + ((d - y) * e) * b) = e*(b-a)*(y - x)` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; REWRITE_TAC[REAL_ENTIRE]; TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `~(e = &0)` SUBGOAL_TAC; EXPAND_TAC"e"; REWRITE_TAC[real_div]; REDUCE_TAC; REWRITE_TAC[REAL_INV_EQ_0]; UND 0; REAL_ARITH_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let linear_inj_rev = prove_by_refinement( `!a b c d. (a < b) /\ (c < d) ==> (INJ (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a ) {x | c <= x /\ x <= d } {y | a <= y /\ y <= b})`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[INJ]; CONJ_TAC; REP_BASIC_TAC; ASSUME_TAC linear_image_rev; TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL); REWR 4; UND 4; REWRITE_TAC[IMAGE]; DISCH_TAC; FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * b + (d - x) / (d - c) * a`)); UND 5; REWRITE_TAC[]; DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; (* INJ proper *) REP_BASIC_TAC; UND 2; TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ; TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC"e"; REWRITE_TAC[real_div]; REDUCE_TAC; DISCH_THEN_REWRITE; DISCH_TAC; USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]); UND 8; TYPE_THEN `(((x - c) * e) * b + ((d - x) * e) * a) - (((y - c) * e) * b + ((d - y) * e) * a) = e*(a-b)*(y - x)` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; REWRITE_TAC[REAL_ENTIRE]; TYPE_THEN `~(a-b = &0)` SUBGOAL_TAC; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `~(e = &0)` SUBGOAL_TAC; EXPAND_TAC"e"; REWRITE_TAC[real_div]; REDUCE_TAC; REWRITE_TAC[REAL_INV_EQ_0]; UND 0; REAL_ARITH_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let comp_comp = prove_by_refinement( `(o) = (compose:(B->C) -> ((A->B)-> (A->C))) `, (* {{{ proof *) [ IMATCH_MP_TAC EQ_EXT; GEN_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[o_DEF;compose]; ]);; (* }}} *) let arc_reparameter_rev = prove_by_refinement( `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | c <= x /\ x <= d} (euclid 2) /\ (a < b) /\ (c < d) ==> (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\ INJ g {x | a <= x /\ x <= b} (euclid 2) /\ (f d = g a) /\ (f c = g b) /\ (!x y x' y'. (f x = g x') /\ (f y = g y') /\ (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\ (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==> ((x < y) = (y' < x'))) /\ (IMAGE f { x | c <= x /\ x <= d } = IMAGE g { x | a <= x /\ x <= b } )))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (c) + (b - t)/(b - a) *(d) )` ABBREV_TAC ; TYPE_THEN `g = (f o f2)` ABBREV_TAC ; TYPE_THEN `g` EXISTS_TAC; (* general facts *) TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC; MESON_TAC[metric_real;top_of_metric_unions]; DISCH_TAC; (* continuity *) CONJ_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC continuous_comp; TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[top2]; ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV]; TYPE_THEN `f2 = (\t. t* (c - d + d*b - c*a)/(b - a) + (&1 - t)*(d*b-c*a)/(b - a))` SUBGOAL_TAC; EXPAND_TAC "f2"; IMATCH_MP_TAC EQ_EXT; BETA_TAC; GEN_TAC; REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`]; REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL]; DISJ1_TAC ; real_poly_tac; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[linear_cont]; (* IMAGE *) TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC; REWRITE_TAC[]; EXPAND_TAC "f2"; ASM_SIMP_TAC[linear_image_gen]; DISCH_TAC; TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC; EXPAND_TAC "g"; REWRITE_TAC[comp_comp;compose_image;]; AP_TERM_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; (* INJ *) EXPAND_TAC "g"; REWRITE_TAC[comp_comp]; (* XXX *) CONJ_TAC; IMATCH_MP_TAC (COMP_INJ); TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC; UND 2; DISCH_THEN_REWRITE; KILL 7; ASM_REWRITE_TAC[]; EXPAND_TAC "f2"; IMATCH_MP_TAC linear_inj; ASM_REWRITE_TAC[]; (* ends *) IMATCH_MP_TAC (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`); CONJ_TAC; EXPAND_TAC "f2"; REWRITE_TAC[compose]; REDUCE_TAC; REWRITE_TAC[real_div;REAL_MUL_ASSOC;]; REDUCE_TAC; TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC; IMATCH_MP_TAC REAL_MUL_RINV; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REDUCE_TAC; (* monotone *) REWRITE_TAC[compose]; REP_BASIC_TAC; TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC; USE 7 (REWRITE_RULE[IMAGE]); TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `y'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC; USE 7 (REWRITE_RULE[IMAGE]); TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `x = f2 x'` SUBGOAL_TAC; USE 2 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `y = f2 y'` SUBGOAL_TAC; USE 2 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "f2"; ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`]; REWRITE_TAC[real_div]; TYPE_THEN `e = inv(b-a)` ABBREV_TAC ; TYPE_THEN `(((y' - a) * e) * c + ((b - y') * e) * d) - (((x' - a) * e) * c + ((b - x') * e) * d) = (x' - y')*e*(d-c)` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; TYPE_THEN `&0 < e` SUBGOAL_TAC; EXPAND_TAC"e"; IMATCH_MP_TAC REAL_PROP_POS_INV; UND 1; REAL_ARITH_TAC; TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_ASSOC]; ASM_SIMP_TAC[REAL_PROP_POS_RMUL]; ]);; (* }}} *) let arc_reparameter_gen = prove_by_refinement( `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | c <= x /\ x <= d} (euclid 2) /\ (a < b) /\ (c < d) ==> (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\ INJ g {x | a <= x /\ x <= b} (euclid 2) /\ (f c = g a) /\ (f d = g b) /\ (!x y x' y'. (f x = g x') /\ (f y = g y') /\ (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\ (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==> ((x < y) = (x' < y'))) /\ (IMAGE f { x | c <= x /\ x <= d } = IMAGE g { x | a <= x /\ x <= b } )))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (d) + (b - t)/(b - a) *(c) )` ABBREV_TAC ; TYPE_THEN `g = (f o f2)` ABBREV_TAC ; TYPE_THEN `g` EXISTS_TAC; (* general facts *) TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC; MESON_TAC[metric_real;top_of_metric_unions]; DISCH_TAC; (* continuity *) CONJ_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC continuous_comp; TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[top2]; ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV]; TYPE_THEN `f2 = (\t. t* (d - c + c*b - d*a)/(b - a) + (&1 - t)*(c*b-d*a)/(b - a))` SUBGOAL_TAC; EXPAND_TAC "f2"; IMATCH_MP_TAC EQ_EXT; BETA_TAC; GEN_TAC; REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`]; REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL]; DISJ1_TAC ; real_poly_tac; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[linear_cont]; (* IMAGE *) TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC; REWRITE_TAC[]; EXPAND_TAC "f2"; ASM_SIMP_TAC[linear_image_rev]; DISCH_TAC; TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC; EXPAND_TAC "g"; REWRITE_TAC[comp_comp;compose_image;]; AP_TERM_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; (* INJ *) EXPAND_TAC "g"; REWRITE_TAC[comp_comp]; (* XXX *) CONJ_TAC; IMATCH_MP_TAC (COMP_INJ); TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC; UND 2; DISCH_THEN_REWRITE; KILL 7; ASM_REWRITE_TAC[]; EXPAND_TAC "f2"; IMATCH_MP_TAC linear_inj_rev; ASM_REWRITE_TAC[]; (* ends *) IMATCH_MP_TAC (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`); CONJ_TAC; EXPAND_TAC "f2"; REWRITE_TAC[compose]; REDUCE_TAC; REWRITE_TAC[real_div;REAL_MUL_ASSOC;]; REDUCE_TAC; TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC; IMATCH_MP_TAC REAL_MUL_RINV; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REDUCE_TAC; (* monotone *) REWRITE_TAC[compose]; REP_BASIC_TAC; TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC; USE 7 (REWRITE_RULE[IMAGE]); TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `y'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC; USE 7 (REWRITE_RULE[IMAGE]); TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `x = f2 x'` SUBGOAL_TAC; USE 2 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `y = f2 y'` SUBGOAL_TAC; USE 2 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "f2"; ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`]; REWRITE_TAC[real_div]; TYPE_THEN `e = inv(b-a)` ABBREV_TAC ; TYPE_THEN `(((y' - a) * e) * d + ((b - y') * e) * c) - (((x' - a) * e) * d + ((b - x') * e) * c) = (y' - x')*e*(d-c)` SUBGOAL_TAC; real_poly_tac; DISCH_THEN_REWRITE; TYPE_THEN `&0 < e` SUBGOAL_TAC; EXPAND_TAC"e"; IMATCH_MP_TAC REAL_PROP_POS_INV; UND 1; REAL_ARITH_TAC; TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_ASSOC]; ASM_SIMP_TAC[REAL_PROP_POS_RMUL]; ]);; (* }}} *) let image_preimage = prove_by_refinement( `!(f:A->B) X Y. IMAGE f (preimage X f Y) SUBSET Y`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE;SUBSET;INR in_preimage ;]; MESON_TAC[]; ]);; (* }}} *) let preimage_union2 = prove_by_refinement( `!(f:A->B) A B X. (preimage X f (A UNION B)) = (preimage X f A UNION preimage X f B)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[preimage_union;image_preimage;]; REWRITE_TAC[preimage;SUBSET;]; MESON_TAC[]; REWRITE_TAC[union_subset]; REWRITE_TAC[preimage;SUBSET;UNION]; MESON_TAC[]; ]);; (* }}} *) let union_diff = prove_by_refinement( `!(X:A->bool) A B. (X = A UNION B) /\ (A INTER B = EMPTY) ==> (X DIFF B = A)`, (* {{{ proof *) [ REP_GEN_TAC; SET_TAC[]; ]);; (* }}} *) let preimage_closed = prove_by_refinement( `!U V C (f:A->B). (continuous f U V) /\ (closed_ V C) /\ (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==> (closed_ U (preimage (UNIONS U) f C))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[closed;open_DEF;]; TYPE_THEN `(UNIONS U DIFF (preimage (UNIONS U) f C)) = preimage (UNIONS U) f (UNIONS V DIFF C)` SUBGOAL_TAC; IMATCH_MP_TAC union_diff; REWRITE_TAC[GSYM preimage_union2]; CONJ_TAC; TYPE_THEN `UNIONS V DIFF C UNION C = UNIONS V` SUBGOAL_TAC; TYPE_THEN `!P. C SUBSET P ==> (P DIFF C UNION C = P)` SUBGOAL_TAC; SET_TAC[]; TYPE_THEN `C SUBSET UNIONS V` SUBGOAL_TAC; UND 1; REWRITE_TAC[closed;open_DEF;]; DISCH_THEN_REWRITE; DISCH_TAC; DISCH_THEN (fun t-> ASM_SIMP_TAC[t]); DISCH_THEN_REWRITE; IMATCH_MP_TAC SUBSET_ANTISYM; ASM_REWRITE_TAC [ subset_preimage;]; REWRITE_TAC[preimage;SUBSET]; MESON_TAC[]; IMATCH_MP_TAC preimage_disjoint; SET_TAC[]; DISCH_THEN_REWRITE; CONJ_TAC; REWRITE_TAC[SUBSET;preimage]; MESON_TAC[]; UND 2; REWRITE_TAC[continuous]; DISCH_THEN IMATCH_MP_TAC ; UND 1; REWRITE_TAC[closed;open_DEF;]; MESON_TAC[]; ]);; (* }}} *) let preimage_restrict = prove_by_refinement( `!(f:A->B) Z A B. (A SUBSET B) ==> (preimage A f Z = A INTER preimage B f Z)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[preimage;INTER;]; TYPE_THEN `!y. (A SUBSET B ==> (A y /\ B y <=> A y))` SUBGOAL_TAC; MESON_TAC[ISUBSET]; ASM_SIMP_TAC[]; DISCH_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let continuous_delta = prove_by_refinement( `continuous (\x. (x *# dirac_delta 0)) (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 1,d_euclid)) `, (* {{{ proof *) [ TYPE_THEN `IMAGE (\x. (x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET;]; MESON_TAC[euclid_dirac]; ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; REP_BASIC_TAC; RIGHT_TAC "delta"; REP_BASIC_TAC; TYPE_THEN `epsilon` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_SIMP_TAC[euclid_dirac;euclid1_abs]; REWRITE_TAC[dirac_0]; USE 2 (REWRITE_RULE [d_real]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let continuous_neg_delta = prove_by_refinement( `continuous (\x. ((-- x) *# dirac_delta 0)) (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 1,d_euclid)) `, (* {{{ proof *) [ TYPE_THEN `IMAGE (\x. (-- x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET;]; MESON_TAC[euclid_dirac]; ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; REP_BASIC_TAC; RIGHT_TAC "delta"; REP_BASIC_TAC; TYPE_THEN `epsilon` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_SIMP_TAC[euclid_dirac;euclid1_abs]; REWRITE_TAC[dirac_0]; USE 2 (REWRITE_RULE [d_real]); UND 2; REAL_ARITH_TAC; ]);; (* }}} *) let compact_max_real = prove_by_refinement( `!(f:A->real) U K. continuous f U (top_of_metric (UNIV,d_real)) /\ compact U K /\ ~(K = {}) ==> (?x. K x /\ (!y. K y ==> f y <= f x ))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `g = (\x. (x *# dirac_delta 0)) o f` ABBREV_TAC ; TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC; IMATCH_MP_TAC compact_max; TYPE_THEN `U` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "g"; REWRITE_TAC[IMAGE_o]; TYPE_THEN `X = IMAGE f K` ABBREV_TAC ; REWRITE_TAC[IMAGE ;SUBSET]; CONJ_TAC; IMATCH_MP_TAC continuous_comp; TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC; ASM_REWRITE_TAC[continuous_delta]; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; MESON_TAC[euclid_dirac]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; UND 4; EXPAND_TAC "g"; REWRITE_TAC[o_DEF;dirac_0]; ASM_MESON_TAC[]; ]);; (* }}} *) let compact_min_real = prove_by_refinement( `!(f:A->real) U K. continuous f U (top_of_metric (UNIV,d_real)) /\ compact U K /\ ~(K = {}) ==> (?x. K x /\ (!y. K y ==> f x <= f y ))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `g = (\x. (-- x *# dirac_delta 0)) o f` ABBREV_TAC ; TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC; IMATCH_MP_TAC compact_max; TYPE_THEN `U` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "g"; REWRITE_TAC[IMAGE_o]; TYPE_THEN `X = IMAGE f K` ABBREV_TAC ; REWRITE_TAC[IMAGE ;SUBSET]; CONJ_TAC; IMATCH_MP_TAC continuous_comp; TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC; ASM_REWRITE_TAC[continuous_neg_delta]; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; MESON_TAC[euclid_dirac]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; UND 4; EXPAND_TAC "g"; REWRITE_TAC[o_DEF;dirac_0]; ASM_MESON_TAC[REAL_ARITH `!u v. (-- u <= --v) <=> (v <= u)`]; ]);; (* }}} *) let continuous_I = prove_by_refinement( `continuous I (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real))`, (* {{{ proof *) [ REWRITE_TAC[continuous]; REP_BASIC_TAC; REWRITE_TAC[preimage]; SIMP_TAC [GSYM top_of_metric_unions;metric_real]; REWRITE_TAC[I_DEF]; TYPE_THEN `{x | v x} = v` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; ]);; (* }}} *) let compact_sup = prove_by_refinement( `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==> (?x. (X x) /\ (!y. (X y) ==> (y <= x)))`, (* {{{ proof *) [ TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC; REWRITE_TAC[I_DEF]; DISCH_TAC; TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (fun t -> ONCE_REWRITE_TAC [t]); REP_BASIC_TAC; IMATCH_MP_TAC compact_max_real; TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; ASM_REWRITE_TAC[continuous_I]; ]);; (* }}} *) let compact_inf = prove_by_refinement( `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==> (?x. (X x) /\ (!y. (X y) ==> (x <= y)))`, (* {{{ proof *) [ TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC; REWRITE_TAC[I_DEF]; DISCH_TAC; TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (fun t -> ONCE_REWRITE_TAC [t]); REP_BASIC_TAC; IMATCH_MP_TAC compact_min_real; TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; ASM_REWRITE_TAC[continuous_I]; ]);; (* }}} *) let preimage_compact = prove_by_refinement( `!C (f:A->B) Y dY Z dZ Y0. metric_space (Y,dY) /\ metric_space (Z,dZ) /\ (compact (top_of_metric(Y,dY)) Y0) /\ (continuous f (top_of_metric(Y0,dY)) (top_of_metric(Z,dZ))) /\ (IMAGE f Y0 SUBSET Z) /\ (closed_ (top_of_metric(Z,dZ)) C) /\ ~(IMAGE f Y0 INTER C = EMPTY) ==> (compact (top_of_metric(Y,dY)) (preimage Y0 f C))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `X = preimage Y0 f C` ABBREV_TAC ; TYPE_THEN `(UNIONS (top_of_metric(Y,dY)) = Y) /\ (UNIONS(top_of_metric(Z,dZ)) = Z)` SUBGOAL_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions]; REP_BASIC_TAC; TYPE_THEN `Y0 SUBSET Y` SUBGOAL_TAC; ASM_MESON_TAC [compact;]; DISCH_TAC; WITH 10 (MATCH_MP preimage_restrict); TYPEL_THEN [`f`;`C`] (USE 11 o ISPECL); TYPE_THEN `metric_space (Y0,dY)` SUBGOAL_TAC; IMATCH_MP_TAC metric_subspace; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `closed_ (top_of_metric(Y0,dY)) X` SUBGOAL_TAC; EXPAND_TAC "X"; TYPE_THEN `preimage Y0 f C = preimage (UNIONS (top_of_metric(Y0,dY))) f C` SUBGOAL_TAC; AP_THM_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_THEN_REWRITE; IMATCH_MP_TAC preimage_closed; TYPE_THEN `(top_of_metric (Z,dZ))` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; TYPE_THEN `~(X = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS;]; UND 0; REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; UND 0; REWRITE_TAC[IMAGE;INTER]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; EXPAND_TAC "X"; REWRITE_TAC[preimage]; ASM_MESON_TAC[]; DISCH_TAC; (* next X compact in the reals , take inf X, *) TYPE_THEN `U = top_of_metric(Y,dY)` ABBREV_TAC ; TYPE_THEN `U0 = top_of_metric(Y0,dY)` ABBREV_TAC ; TYPE_THEN `U00 = top_of_metric (X,dY)` ABBREV_TAC ; TYPE_THEN `X SUBSET Y0` SUBGOAL_TAC; EXPAND_TAC "X"; KILL 7; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER;SUBSET;]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `induced_top U Y0 = U0` SUBGOAL_TAC; EXPAND_TAC "U"; EXPAND_TAC "U0"; IMATCH_MP_TAC top_of_metric_induced; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `UNIONS U = Y` SUBGOAL_TAC; EXPAND_TAC "U"; ASM_SIMP_TAC [GSYM top_of_metric_unions]; DISCH_TAC; TYPE_THEN `compact U0 Y0` SUBGOAL_TAC; KILL 16; EXPAND_TAC "U0"; ASM_SIMP_TAC[GSYM induced_compact;]; REP_BASIC_TAC; (* ok to here *) TYPE_THEN `compact U0 X` SUBGOAL_TAC; IMATCH_MP_TAC closed_compact; TYPE_THEN `Y0` EXISTS_TAC; ASM_REWRITE_TAC[]; KILL 19; EXPAND_TAC "U0"; IMATCH_MP_TAC top_of_metric_top; ASM_REWRITE_TAC[]; DISCH_TAC; (* done WITH compac U0 X *) TYPE_THEN `induced_top U0 X = U00` SUBGOAL_TAC; KILL 19; EXPAND_TAC "U0"; EXPAND_TAC "U00"; IMATCH_MP_TAC top_of_metric_induced; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `compact U00 X` SUBGOAL_TAC; EXPAND_TAC "U00"; TYPE_THEN `X SUBSET UNIONS U0` SUBGOAL_TAC; KILL 19; EXPAND_TAC "U0"; ASM_SIMP_TAC[GSYM top_of_metric_unions]; ASM_SIMP_TAC[GSYM induced_compact]; DISCH_TAC; TYPE_THEN `induced_top U X = U00` SUBGOAL_TAC; KILL 19; EXPAND_TAC "U"; KILL 23; EXPAND_TAC "U00"; IMATCH_MP_TAC top_of_metric_induced; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; DISCH_TAC; UND 24; EXPAND_TAC "U00"; TYPE_THEN `compact (induced_top U X) X = compact U X` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM induced_compact); ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; MESON_TAC[]; ]);; (* }}} *) let preimage_compact_interval = prove_by_refinement( `!C n f a b. (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) (top_of_metric(euclid n,d_euclid)) /\ (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\ (closed_ (top_of_metric(euclid n,d_euclid)) C) /\ ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==> (compact (top_of_metric(UNIV,d_real)) (preimage {x | a <= x /\ x <= b} f C))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC preimage_compact; TYPE_THEN `(euclid n)` EXISTS_TAC; TYPE_THEN `d_euclid` EXISTS_TAC; ASM_REWRITE_TAC[metric_real;metric_euclid;interval_compact;]; ]);; (* }}} *) let preimage_first = prove_by_refinement( `!C n f a b. (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) (top_of_metric(euclid n,d_euclid)) /\ (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\ (closed_ (top_of_metric(euclid n,d_euclid)) C) /\ ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==> (?t. (a <= t /\ t <= b) /\ (C (f t)) /\ (!s. (a <=s /\ s < t) ==> ~(C (f s))))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(compact (top_of_metric(UNIV,d_real)) (preimage {x | a <= x /\ x <= b} f C))` SUBGOAL_TAC; IMATCH_MP_TAC preimage_compact_interval; TYPE_THEN `n` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `~(preimage {x | a <= x /\ x <= b} f C = EMPTY)` SUBGOAL_TAC; UND 0; REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[IMAGE ;INTER;preimage]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `X = preimage {x | a <= x /\ x <= b } f C` ABBREV_TAC ; TYPE_THEN `(?x. (X x) /\ (!y. (X y) ==> (x <= y)))` SUBGOAL_TAC; IMATCH_MP_TAC compact_inf; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; UND 8; UND 7; EXPAND_TAC "X"; REWRITE_TAC[preimage]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TSPEC `s` 10; REWR 10; UND 10; UND 12; UND 8; REAL_ARITH_TAC; ]);; (* }}} *) let inj_subset_domain = prove_by_refinement( `!s s' t (f:A->B). INJ f s t /\ (s' SUBSET s) ==> INJ f s' t`, (* {{{ proof *) [ REWRITE_TAC[INJ;SUBSET;]; MESON_TAC[]; ]);; (* }}} *) let arc_restrict = prove_by_refinement( `!a b c d C f t t'. (c <= t /\ t < t' /\ t' <= d) /\ (a < b) /\ (C = IMAGE f { x | c <= x /\ x <= d }) /\ INJ f {x | c <= x /\ x <= d} (euclid 2) /\ continuous f (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) ==> (?g. (IMAGE g {x | a <= x /\ x <= b} = IMAGE f {x | t <= x /\ x <= t'}) /\ (g a = f t) /\ (g b = f t') /\ INJ g { x | a <= x /\ x <= b} (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN ` continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (a < b) /\ (t < t')` SUBGOAL_TAC; ASM_REWRITE_TAC[top2]; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;]; UND 4; UND 5; UND 6; REAL_ARITH_TAC; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[top2]; ]);; (* }}} *) let continuous_induced_domain = prove_by_refinement( `!(f:A->B) U V K. (continuous f U V) /\ (K SUBSET (UNIONS U)) ==> (continuous f (induced_top U K) V)`, (* {{{ proof *) [ REWRITE_TAC[continuous;induced_top_support;]; REWRITE_TAC[preimage;induced_top]; REP_BASIC_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `{x | UNIONS U x /\ v (f x)}` EXISTS_TAC; ASM_SIMP_TAC[]; REWRITE_TAC[INTER]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; MESON_TAC[]; ]);; (* }}} *) let inj_split = prove_by_refinement( `!A B Z (f:A->B). (INJ f A Z) /\ (INJ f B Z) /\ (IMAGE f A INTER IMAGE f B = EMPTY) ==> (INJ f (A UNION B) Z)`, (* {{{ proof *) [ REWRITE_TAC[INJ;INTER;IMAGE;UNION;]; REP_BASIC_TAC; CONJ_TAC; ASM_MESON_TAC[]; REP_GEN_TAC; REP_BASIC_TAC; UND 7; UND 6; REP_CASES_TAC; KILL 1; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 0; REWRITE_TAC[EQ_EMPTY]; NAME_CONFLICT_TAC; DISCH_TAC; TSPEC `f y` 0; USE 0 (REWRITE_RULE[DE_MORGAN_THM]); ASM_MESON_TAC[]; USE 0 (REWRITE_RULE[EQ_EMPTY]); TSPEC `f x` 0; ASM_MESON_TAC[]; KILL 3; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; ]);; (* }}} *) let joinf_inj_below = prove_by_refinement( `!(f:real->B) g a A. (A SUBSET {x | x < a}) ==> (INJ (joinf f g a) A = INJ f A)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INJ]; REP_BASIC_TAC; TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[joinf]; TSPEC `z` 0; REWR 0; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let joinf_inj_above = prove_by_refinement( `!(f:real->B) g a A. (A SUBSET {x | a <= x}) ==> (INJ (joinf f g a) A = INJ g A)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INJ]; REP_BASIC_TAC; TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[joinf]; TSPEC `z` 0; REWR 0; ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `]; REP_BASIC_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let joinf_image_below = prove_by_refinement( `!(f:real->B) g a A. (A SUBSET {x | x < a}) ==> (IMAGE (joinf f g a) A = IMAGE f A)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE]; REP_BASIC_TAC; TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[joinf]; TSPEC `z` 0; REWR 0; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let joinf_image_above = prove_by_refinement( `!(f:real->B) g a A. (A SUBSET {x | a <= x}) ==> (IMAGE (joinf f g a) A = IMAGE g A)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE]; REP_BASIC_TAC; TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[joinf]; TSPEC `z` 0; REWR 0; ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `]; REP_BASIC_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let pconn_trans = prove_by_refinement( `!A x y z. (p_conn A x y /\ p_conn A y z ==> p_conn A x z)`, (* {{{ proof *) [ REWRITE_TAC[p_conn;simple_polygonal_arc;simple_arc;]; REP_BASIC_TAC; TYPE_THEN `C' x` ASM_CASES_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `f'` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; TYPE_THEN `~(x = y)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; ASM_MESON_TAC[]; DISCH_TAC; (* now ~( x= y) *) TYPE_THEN `C z` ASM_CASES_TAC; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; TYPE_THEN `~(z = y)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; (* now ~( z = y) *) TYPE_THEN `?tx. (&0 <= tx) /\ (tx <= &1) /\ (f tx = x)` SUBGOAL_TAC; UND 10; ASM_REWRITE_TAC[IMAGE;]; REP_BASIC_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `?ty. (&0 <= ty) /\ (ty <= &1) /\ (f ty = y)` SUBGOAL_TAC; UND 9; ASM_REWRITE_TAC[IMAGE;]; REP_BASIC_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `~(tx = ty)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; (* reparameter C *) TYPE_THEN `?g. (g (&0) = x) /\ (g (&1) = y) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE g { x | &0 <= x /\ x <= &1 } SUBSET C` SUBGOAL_TAC; TYPE_THEN `(tx < ty) \/ (ty < tx)` SUBGOAL_TAC; UND 28; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `(?g. (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | tx <= x /\ x <= ty}) /\ (g (&0) = f tx) /\ (g (&1) = f ty) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; IMATCH_MP_TAC arc_restrict; TYPE_THEN `&0` EXISTS_TAC; TYPE_THEN `&1` EXISTS_TAC; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;]; UND 15; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; REP_BASIC_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; GEN_TAC; UND 24; UND 26; REAL_ARITH_TAC; TYPE_THEN `(?g. (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx}) /\ (g (&0) = f ty) /\ (g (&1) = f tx) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; IMATCH_MP_TAC arc_restrict; TYPE_THEN `&0` EXISTS_TAC; TYPE_THEN `&1` EXISTS_TAC; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;]; UND 15; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; REP_BASIC_TAC; (* REVERSE reparameter on C XX0 *) TYPE_THEN `(?g'. continuous g' (top_of_metric (UNIV,d_real)) (top2) /\ INJ g' {x | (&0) <= x /\ x <= (&1)} (euclid 2) /\ (g (&1) = g' (&0)) /\ (g (&0) = g' (&1)) /\ (!x y x' y'. (g x = g' x') /\ (g y = g' y') /\ ((&0) <= x /\ x <= (&1)) /\ ((&0) <= y /\ y <= (&1)) /\ ((&0) <= x' /\ x' <= (&1)) /\ ((&0) <= y' /\ y' <= (&1)) ==> ((x < y) <=> (y' < x'))) /\ (IMAGE g { x | (&0) <= x /\ x <= (&1) } = IMAGE g' { x | (&0) <= x /\ x <= (&1) } ))` SUBGOAL_TAC; IMATCH_MP_TAC arc_reparameter_rev; ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;top2;]; REP_BASIC_TAC; TYPE_THEN `g'` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; ASM_MESON_TAC[]; (* L80 *) CONJ_TAC; ASM_MESON_TAC[]; CONJ_TAC; ASM_MESON_TAC[top2]; TYPE_THEN `IMAGE g' {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx }` SUBGOAL_TAC; UND 34; UND 35; alpha_tac; MESON_TAC[]; DISCH_THEN_REWRITE; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; UND 23; UND 27; REAL_ARITH_TAC; REP_BASIC_TAC; (* now restrict C to [x,y'] *) (* rC *) TYPE_THEN `Cg = IMAGE g {x | &0 <= x /\ x <= &1 }` ABBREV_TAC ; TYPE_THEN `Z = Cg INTER C'` ABBREV_TAC ; TYPE_THEN `?t'. (&0 <= t' /\ t' <= &1) /\ (Z (g t')) /\ (!s. (&0 <=s /\ s < t') ==> ~(Z (g s)))` SUBGOAL_TAC; IMATCH_MP_TAC preimage_first; EXISTS_TAC `2`; (* restriction conditions *) CONJ_TAC; TYPE_THEN `induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1 } = top_of_metric ({x | &0 <= x /\ x <= &1 },d_real)` SUBGOAL_TAC; ASM_SIMP_TAC[SUBSET_UNIV;metric_real;top_of_metric_induced]; DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]); IMATCH_MP_TAC continuous_induced_domain; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; SUBCONJ_TAC; UND 31; REWRITE_TAC[INJ;IMAGE;SUBSET;]; MESON_TAC[]; DISCH_TAC; CONJ_TAC; (* rC2 *) TYPE_THEN `!C. (?f a b. (continuous f (top_of_metric(UNIV,d_real)) (top2)) /\ (INJ f {x | a <= x /\ x <= b} (euclid 2)) /\ (IMAGE f {x | a <= x /\ x <= b} = C)) ==> (closed_ top2 C)` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC compact_closed; ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid]; ASM_SIMP_TAC[top_of_metric_top;metric_euclid]; EXPAND_TAC "C''"; IMATCH_MP_TAC image_compact; TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;interval_compact]; ASM_SIMP_TAC[GSYM top2]; EXPAND_TAC "C''"; UND 38; REWRITE_TAC[INJ;IMAGE;SUBSET]; MESON_TAC[]; DISCH_TAC; REWRITE_TAC[GSYM top2]; EXPAND_TAC "Z"; IMATCH_MP_TAC closed_inter2; REWRITE_TAC[top2_top]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `g` EXISTS_TAC; TYPE_THEN `&0` EXISTS_TAC; TYPE_THEN `&1` EXISTS_TAC; ASM_REWRITE_TAC[]; (* XX2 *) ASM_SIMP_TAC[top2]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `f'` EXISTS_TAC; TYPE_THEN `&0` EXISTS_TAC; TYPE_THEN `&1` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[top2]; UND 6; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; EXPAND_TAC "Z"; REWRITE_TAC[EMPTY_EXISTS;INTER;IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `&1` EXISTS_TAC; EXPAND_TAC "Cg"; ASM_REWRITE_TAC[IMAGE;]; REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC))); EXPAND_TAC "Cg"; (* L160 *) (remark "LINE 160"; ALL_TAC); REWRITE_TAC[IMAGE]; TYPE_THEN `&1` EXISTS_TAC; REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC))); ASM_REWRITE_TAC[]; UND 1; ASM_REWRITE_TAC[IMAGE]; REP_BASIC_TAC; TYPE_THEN `(t' = &0) \/ (&0 < t')` SUBGOAL_TAC; UND 39; REAL_ARITH_TAC; (* elim t' =0 *) DISCH_THEN DISJ_CASES_TAC; UND 37; EXPAND_TAC "Z"; REWRITE_TAC[INTER]; ASM_MESON_TAC[]; (* ** START ON 2nd BRANCH ** *** ** *) (* 2b*) TYPE_THEN `?tz. (&0 <= tz) /\ (tz <= &1) /\ (f' tz = z)` SUBGOAL_TAC; UND 0; ASM_REWRITE_TAC[IMAGE;]; DISCH_THEN (CHOOSE_THEN MP_TAC); LEFT_TAC "tz"; TYPE_THEN `x'` EXISTS_TAC; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `?t''. (&0 <= t'') /\ (t'' <= &1) /\ (f' t'' = g t')` SUBGOAL_TAC; UND 37; EXPAND_TAC "Z"; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[IMAGE;]; DISCH_THEN (fun t-> MP_TAC (CONJUNCT2 t)); ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `~(tz = t'')` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `C (g t')` SUBGOAL_TAC; UND 37; EXPAND_TAC "Z"; REWRITE_TAC[INTER]; UND 29; REWRITE_TAC[SUBSET]; MESON_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; (* reparam on C' *) TYPE_THEN `?h. (h (&1/(&2)) = g t') /\ (h (&1) = z) /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE h { x | &1/(&2) <= x /\ x <= &1 } SUBSET C'` SUBGOAL_TAC; TYPE_THEN `(t'' < tz) \/ (tz < t'')` SUBGOAL_TAC; UND 47; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `(?h. (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | t'' <= x /\ x <= tz}) /\ (h (&1/(&2)) = f' t'') /\ (h (&1) = f' tz) /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; IMATCH_MP_TAC arc_restrict; TYPE_THEN `&0` EXISTS_TAC; TYPE_THEN `&1` EXISTS_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 6; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; DISCH_TAC; REWRITE_TAC[REAL_LT_HALF2]; REAL_ARITH_TAC; REP_BASIC_TAC; TYPE_THEN `h` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; GEN_TAC; UND 42; UND 46; REAL_ARITH_TAC; TYPE_THEN `(?h. (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' }) /\ (h (&1/(&2)) = f' tz) /\ (h (&1) = f' t'') /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; IMATCH_MP_TAC arc_restrict; TYPE_THEN `&0` EXISTS_TAC; TYPE_THEN `&1` EXISTS_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`]; UND 6; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; REP_BASIC_TAC; (* L240 *) (remark "LINE 240"; ALL_TAC); (* REVERSE reparameter on C *) TYPE_THEN `(?h'. continuous h' (top_of_metric (UNIV,d_real)) (top2) /\ INJ h' {x | (&1/(&2)) <= x /\ x <= (&1)} (euclid 2) /\ (h (&1) = h' (&1/(&2))) /\ (h (&1/(&2)) = h' (&1)) /\ (!x y x' y'. (h x = h' x') /\ (h y = h' y') /\ ((&1/(&2)) <= x /\ x <= (&1)) /\ ((&1/(&2)) <= y /\ y <= (&1)) /\ ((&1/(&2)) <= x' /\ x' <= (&1)) /\ ((&1/(&2)) <= y' /\ y' <= (&1)) ==> ((x < y) <=> (y' < x'))) /\ (IMAGE h { x | (&1/(&2)) <= x /\ x <= (&1) } = IMAGE h' { x | (&1/(&2)) <= x /\ x <= (&1) } ))` SUBGOAL_TAC; IMATCH_MP_TAC arc_reparameter_rev; ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`;top2;]; REP_BASIC_TAC; TYPE_THEN `h'` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; ASM_MESON_TAC[]; CONJ_TAC; ASM_MESON_TAC[]; CONJ_TAC; ASM_MESON_TAC[top2]; TYPE_THEN `IMAGE h' {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' }` SUBGOAL_TAC; UND 53; (* ZZZ *) UND 54; alpha_tac; MESON_TAC[]; DISCH_THEN_REWRITE; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; UND 43; UND 45; REAL_ARITH_TAC; REP_BASIC_TAC; (* reparam g [0,1/2] *) (* rg *) TYPE_THEN `?g'. ((g' (&0)) = x) /\ (g' (&1/(&2)) = g t') /\ INJ g' { x | &0 <= x /\ x <= &1/(&2) } (euclid 2) /\ continuous g' (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ (IMAGE g' { x | &0 <= x /\ x <= &1/(&2) } = IMAGE g {x | &0 <= x /\ x <= t'}) ` SUBGOAL_TAC; (* was SUBSET Cg *) ASSUME_TAC arc_reparameter_gen; TYPEL_THEN [`g`;`&0`;`&1/(&2)`;`&0`;`t'`] (fun t-> FIRST_ASSUM (fun s-> (MP_TAC (ISPECL t s)))); KILL 53; (* ZZZ *) ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;REAL_LT_HALF1;]; UND 30; REWRITE_TAC[top2]; DISCH_THEN_REWRITE; TYPE_THEN `INJ g {x | &0 <= x /\ x <= t'} (euclid 2)` SUBGOAL_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1 }` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; UND 38; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REP_BASIC_TAC; TYPE_THEN `g'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* deleted lines here *) REP_BASIC_TAC; TYPE_THEN `fm = joinf g' h (&1/(&2))` ABBREV_TAC ; TYPE_THEN `Cm = IMAGE fm {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; TYPE_THEN `Cm` EXISTS_TAC; (* final instantiation *) (* fi *) REPEAT (IMATCH_MP_TAC (TAUT `A /\ B/\ C ==> (A /\ B) /\C`)); CONJ_TAC; TYPE_THEN `fm` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; EXPAND_TAC "fm"; IMATCH_MP_TAC joinf_cont; ASM_REWRITE_TAC[]; TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; GEN_TAC; TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC; REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; IMATCH_MP_TAC inj_split; EXPAND_TAC "fm"; TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; KILL 58; ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below;joinf_image_above;joinf_image_below]; DISCH_TAC; (* cases *) CONJ_TAC; IMATCH_MP_TAC inj_subset_domain; (* L320 *) (remark "LINE 320"; ALL_TAC); TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2) }` EXISTS_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; CONJ_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; ASM_REWRITE_TAC[]; TYPE_THEN `IMAGE g' { x | &0 <= x /\ x <= &1/(&2)} INTER IMAGE h {x | &1/(&2) <= x /\ x <= &1} SUBSET {(g t')}` SUBGOAL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `IMAGE g { x | &0 <= x /\ x <= t' } SUBSET Cg` SUBGOAL_TAC; EXPAND_TAC "Cg"; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; UND 38; REAL_ARITH_TAC; DISCH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'} INTER Z` EXISTS_TAC; CONJ_TAC; EXPAND_TAC "Z"; UND 48; UND 60; REWRITE_TAC[SUBSET;INTER]; (* MESON_TAC[]; *) POP_ASSUM_LIST (fun t-> ALL_TAC); REP_BASIC_TAC; ASM_REWRITE_TAC[]; (* LINE 350 *) CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[]; UND 36; REWRITE_TAC[INTER;SUBSET;IMAGE]; UND 37; POP_ASSUM_LIST (fun t-> ALL_TAC); REP_BASIC_TAC; REWRITE_TAC[INR IN_SING]; UND 0; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `(x' = t') \/ (x' < t')` SUBGOAL_TAC; UND 2; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; PROOF_BY_CONTR_TAC; USE 61 (REWRITE_RULE[EMPTY_EXISTS ]); REP_BASIC_TAC; TYPE_THEN `!B' B (u:num->real). (B' u /\ B' SUBSET B) ==> (B u)` SUBGOAL_TAC; MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `{(g t')} u` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x <= &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[INTER;SUBSET;IMAGE]; MESON_TAC[REAL_ARITH `x < t ==> x <= t`]; ASM_REWRITE_TAC[]; REWRITE_TAC[INR IN_SING]; REP_BASIC_TAC; UND 62; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER;IMAGE;DE_MORGAN_THM;]; DISJ1_TAC; USE 56 SYM; ASM_REWRITE_TAC[]; UND 55; POP_ASSUM_LIST (fun t-> ALL_TAC); REWRITE_TAC[INJ]; REP_BASIC_TAC; USE 1(REWRITE_RULE [REAL_ARITH `(x < &1/(&2)) <=> (x <= &1/(&2) /\ ~(x = &1/(&2)))`]); TYPEL_THEN [`x`;`&1/(&2)`] (USE 3 o ISPECL); TYPE_THEN `&0 <= &1/ &2 /\ &1/ &2 <= &1/ (&2)` SUBGOAL_TAC; REWRITE_TAC[REAL_ARITH `x <= x`]; IMATCH_MP_TAC REAL_LE_DIV; REAL_ARITH_TAC; ASM_MESON_TAC[]; (* Now E *) (* L400 *) (remark "LINE 400"; ALL_TAC); (* ne *) TYPE_THEN ` {x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; GEN_TAC; TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC; REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`]; REAL_ARITH_TAC; EXPAND_TAC "Cm"; DISCH_THEN_REWRITE; REWRITE_TAC[IMAGE_UNION]; TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; EXPAND_TAC "fm"; KILL 58; ASM_SIMP_TAC[joinf_image_above;joinf_image_below]; DISCH_TAC; TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION IMAGE h {x | &1 / &2 <= x /\ x <= &1}) z` SUBGOAL_TAC; UND 51; REWRITE_TAC[UNION;IMAGE]; POP_ASSUM_LIST (fun t->ALL_TAC); REP_BASIC_TAC; DISJ2_TAC; TYPE_THEN `&1` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `&1 <= &1`]; IMATCH_MP_TAC REAL_LE_LDIV; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION IMAGE h {x | &1 / &2 <= x /\ x <= &1}) x` SUBGOAL_TAC; UND 57; REWRITE_TAC[UNION;IMAGE]; POP_ASSUM_LIST (fun t->ALL_TAC); REP_BASIC_TAC; DISJ1_TAC; TYPE_THEN `&0` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `&0 <= &0`]; REWRITE_TAC[REAL_LT_HALF1]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; (* gh *) UND 48; TYPE_THEN `IMAGE g' {x | &0 <= x /\ x < &1/ &2} SUBSET C` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Cg ` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; EXPAND_TAC "Cg"; TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'}` EXISTS_TAC; CONJ_TAC; USE 53 SYM; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[REAL_ARITH `x < t ==> x <= t`]; REWRITE_TAC[IMAGE;SUBSET]; UND 38; MESON_TAC[REAL_ARITH `t' <= &1 ==> (x <= t' ==> x<= &1)`]; TYPE_THEN `GCG = IMAGE g' {x | &0 <= x /\ x < &1 / &2}` ABBREV_TAC ; TYPE_THEN `HCH = IMAGE h {x | &1 / &2 <= x /\ x <= &1}` ABBREV_TAC ; UND 11; UND 2; UND 4; UND 5; UND 13; UND 14; UND 12; UND 3; POP_ASSUM_LIST (fun t->ALL_TAC); REP_BASIC_TAC; CONJ_TAC; TYPE_THEN `E UNION E'` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[UNIONS_UNION]; REWRITE_TAC[union_subset]; CONJ_TAC; UND 1; UND 7; REWRITE_TAC[UNION;SUBSET]; (* L480 *) (remark "LINE 480"; ALL_TAC); MESON_TAC[]; UND 0; UND 5; REWRITE_TAC[UNION;SUBSET]; MESON_TAC[]; CONJ_TAC; ASM_REWRITE_TAC[FINITE_UNION]; UND 8; UND 9; REWRITE_TAC[hv_line;UNION;]; MESON_TAC[]; UND 1; UND 0; UND 2; UND 3; REWRITE_TAC[SUBSET;UNION;]; MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION J *) (* ------------------------------------------------------------------ *) (* Conclusion of Jordan Curve, page 1 *) let v_simple_polygonal = prove_by_refinement( `!x e. (euclid 2 x) /\ (~(e = &0)) ==> (simple_polygonal_arc hv_line (mk_segment x (x + e *# e2)))`, (* {{{ proof *) [ REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ]; REP_BASIC_TAC; CONJ_TAC; ASSUME_TAC mk_segment_inj_image; TYPEL_THEN [`x`;`x + (e *# e2)`;`2`] (USE 2 o ISPECL); TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e2)) /\ ~(x = euclid_plus x (e *# e2))` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC euclid_add_closure; ASM_REWRITE_TAC[]; IMATCH_MP_TAC euclid_scale_closure; REWRITE_TAC [e2;euclid_point]; REP_BASIC_TAC; FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `1`)); REWRITE_TAC[euclid_plus;euclid_scale;e2;coord01]; UND 0; REAL_ARITH_TAC; DISCH_TAC; REWR 2; REP_BASIC_TAC; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; SIMP_TAC [GSYM top_of_metric_unions;metric_euclid]; ASM_REWRITE_TAC[]; (* E *) USE 1 (MATCH_MP point_onto); REP_BASIC_TAC; TYPE_THEN `{(mk_line (point p) (point p + (e *# e2)))}` EXISTS_TAC; REWRITE_TAC[INR IN_SING]; CONJ_TAC; REWRITE_TAC[e2;ISUBSET;mk_segment;mk_line]; REP_BASIC_TAC; TYPE_THEN `a` EXISTS_TAC; ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC[FINITE_SING]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; TYPE_THEN `(FST p , SND p + e)` EXISTS_TAC; REWRITE_TAC[]; AP_TERM_TAC; REWRITE_TAC[e2;point_scale]; REDUCE_TAC; TYPE_THEN `euclid_plus (point p) (point (&0,e)) = euclid_plus (point (FST p,SND p)) (point (&0,e))` SUBGOAL_TAC; REWRITE_TAC[]; DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]); REWRITE_TAC[point_add]; REDUCE_TAC; ]);; (* }}} *) let p_conn_ball = prove_by_refinement( `! x y r. (open_ball(euclid 2,d_euclid) x r y) ==> (p_conn (open_ball(euclid 2,d_euclid) x r) x y)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `open_ball (euclid 2,d_euclid) x r x` SUBGOAL_TAC; SIMP_TAC [metric_euclid;INR open_ball_nonempty_center]; REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[open_ball]); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; RULE_ASSUM_TAC (fun t -> try (MATCH_MP point_onto t) with Failure _ -> t); REP_BASIC_TAC; TYPE_THEN `y' = point(FST p,SND p')` ABBREV_TAC ; TYPE_THEN `A = open_ball(euclid 2,d_euclid) x r` ABBREV_TAC ; TYPE_THEN `y' = euclid_plus x ((SND p' - SND p) *# e2)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "y'"; REWRITE_TAC[e2]; REWRITE_TAC[point_add;point_scale;]; REDUCE_TAC; PURE_ONCE_REWRITE_TAC [GSYM PAIR]; PURE_REWRITE_TAC [point_add]; REWRITE_TAC[]; REDUCE_TAC; AP_TERM_TAC; REWRITE_TAC[PAIR_SPLIT]; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `A y'` SUBGOAL_TAC; UND 0; EXPAND_TAC "y'"; KILL 4; EXPAND_TAC "A"; KILL 5; ASM_REWRITE_TAC[open_ball;euclid_point;d_euclid_point;]; REWRITE_TAC[REAL_ARITH `(x - x = &0)`;POW_0;ARITH_RULE `2 = SUC 1`]; IMATCH_MP_TAC (REAL_ARITH `(x <= y) ==> (y < r ==> x < r)`); IMATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_ARITH `&0 + x = x`;ARITH_RULE `SUC 1 = 2`;REAL_PROP_NN_SQUARE]; IMATCH_MP_TAC (REAL_ARITH `&0 <= x ==> (y <= x + y)`); REWRITE_TAC[REAL_PROP_NN_SQUARE]; DISCH_TAC; TYPE_THEN `p_conn A x y'` SUBGOAL_TAC; TYPE_THEN `x = y'` ASM_CASES_TAC; EXPAND_TAC "y'"; IMATCH_MP_TAC pconn_refl; REWRITE_TAC[p_conn]; CONJ_TAC; EXPAND_TAC "A"; REWRITE_TAC[top2]; IMATCH_MP_TAC open_ball_open; MESON_TAC[metric_euclid]; ASM_REWRITE_TAC[]; REWRITE_TAC[p_conn]; TYPE_THEN `mk_segment x y'` EXISTS_TAC; CONJ_TAC; UND 6; DISCH_THEN_REWRITE; IMATCH_MP_TAC v_simple_polygonal; ASM_REWRITE_TAC[euclid_point]; REWRITE_TAC[REAL_SUB_0]; DISCH_ALL_TAC; UND 8; ASM_REWRITE_TAC[]; EXPAND_TAC "y'"; AP_TERM_TAC; ASM_MESON_TAC[PAIR]; CONJ_TAC; EXPAND_TAC "A"; IMATCH_MP_TAC openball_mk_segment_end; ASM_MESON_TAC[]; REWRITE_TAC[mk_segment_end]; DISCH_TAC; TYPE_THEN `y' = euclid_plus y ((FST p - FST p') *# e1)` SUBGOAL_TAC; KILL 6; ASM_REWRITE_TAC[]; EXPAND_TAC "y'"; REWRITE_TAC[e1]; REWRITE_TAC[point_add;point_scale;]; REDUCE_TAC; PURE_ONCE_REWRITE_TAC [GSYM PAIR]; PURE_REWRITE_TAC [point_add]; REWRITE_TAC[]; REDUCE_TAC; AP_TERM_TAC; REWRITE_TAC[PAIR_SPLIT]; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `p_conn A y y'` SUBGOAL_TAC; TYPE_THEN `y = y'` ASM_CASES_TAC; EXPAND_TAC "y'"; IMATCH_MP_TAC pconn_refl; CONJ_TAC; EXPAND_TAC "A"; REWRITE_TAC[top2]; IMATCH_MP_TAC open_ball_open; MESON_TAC[metric_euclid]; ASM_REWRITE_TAC[]; REWRITE_TAC[p_conn]; TYPE_THEN `mk_segment y y'` EXISTS_TAC; CONJ_TAC; UND 9; DISCH_THEN_REWRITE; IMATCH_MP_TAC h_simple_polygonal; ASM_REWRITE_TAC[euclid_point]; REWRITE_TAC[REAL_SUB_0]; DISCH_ALL_TAC; UND 10; KILL 6; ASM_REWRITE_TAC[]; EXPAND_TAC "y'"; AP_TERM_TAC; ASM_MESON_TAC[PAIR]; CONJ_TAC; EXPAND_TAC "A"; IMATCH_MP_TAC openball_mk_segment_end; ASM_MESON_TAC[]; REWRITE_TAC[mk_segment_end]; DISCH_TAC; IMATCH_MP_TAC pconn_trans; TYPE_THEN `y'` EXISTS_TAC; UND 8; DISCH_THEN_REWRITE; UND 10; MESON_TAC[pconn_symm]; (* Wed Aug 4 10:40:05 EDT 2004 *) ]);; (* }}} *) let p_conn_euclid = prove_by_refinement( `!A x. p_conn A x SUBSET (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;p_conn;simple_polygonal_arc;simple_arc;]; REP_BASIC_TAC; UND 0; ASM_REWRITE_TAC[]; UND 6; SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; REWRITE_TAC[INJ;IMAGE]; MESON_TAC[]; (* Wed Aug 4 10:55:53 EDT 2004 *) ]);; (* }}} *) let p_connA = prove_by_refinement( `!A x. p_conn A x SUBSET A`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[p_conn;SUBSET;]; ASM_MESON_TAC[]; (* Wed Aug 4 11:11:21 EDT 2004 *) ]);; (* }}} *) let p_conn_open = prove_by_refinement( `!A x. top2 A ==> (top2 (p_conn A x))`, (* {{{ proof *) [ (* Wed Aug 4 10:43:29 EDT 2004 *) REP_BASIC_TAC; ASM_SIMP_TAC[top2;top_of_metric_nbd;metric_euclid;p_conn_euclid]; REP_BASIC_TAC; TYPE_THEN `A a` SUBGOAL_TAC; ASM_MESON_TAC[p_connA;ISUBSET]; DISCH_TAC; TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC; ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;]; REP_BASIC_TAC; TYPE_THEN `r` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET;]; REP_BASIC_TAC; IMATCH_MP_TAC pconn_trans; TYPE_THEN `a` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC p_conn_subset; TYPE_THEN `open_ball (euclid 2,d_euclid) a r` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC p_conn_ball; ASM_REWRITE_TAC[]; (* Wed Aug 4 11:21:18 EDT 2004 *) ]);; (* }}} *) let p_conn_diff = prove_by_refinement( `!A x. top2 A ==> (top2 (A DIFF (p_conn A x)))`, (* {{{ proof *) [ REP_BASIC_TAC; SIMP_TAC[top2;metric_euclid;top_of_metric_nbd]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `A` EXISTS_TAC; REWRITE_TAC[SUBSET_DIFF]; UND 0; REWRITE_TAC[top2;]; DISCH_TAC; FIRST_ASSUM (fun t-> ASSUME_TAC (MATCH_MP sub_union t)); UND 1; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[DIFF]); REP_BASIC_TAC; TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC; ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;]; REP_BASIC_TAC; TYPE_THEN `r` EXISTS_TAC; ASM_REWRITE_TAC[DIFF_SUBSET]; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS;INTER]); REP_BASIC_TAC; FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP p_conn_ball t)); TYPE_THEN `p_conn A a u` SUBGOAL_TAC; IMATCH_MP_TAC p_conn_subset; ASM_MESON_TAC[]; DISCH_TAC; UND 1; REWRITE_TAC[]; IMATCH_MP_TAC pconn_trans; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[pconn_symm]; (* Wed Aug 4 12:00:13 EDT 2004 *) ]);; (* }}} *) let p_conn_conn = prove_by_refinement( `!A x y. (top2 A /\ connected top2 A /\ A x /\ A y) ==> (p_conn A x y)`, (* {{{ proof *) [ REWRITE_TAC[connected]; REP_BASIC_TAC; TYPEL_THEN [`p_conn A x`;`A DIFF (p_conn A x)`] (USE 2 o ISPECL); UND 2; ASM_SIMP_TAC[p_conn_open;p_conn_diff]; TYPE_THEN `!(w:(num->real)->bool) z. (w INTER (z DIFF w) = EMPTY)` SUBGOAL_TAC; SET_TAC[INTER;DIFF]; DISCH_THEN_REWRITE; TYPE_THEN `!(x:(num->real)->bool) y. (x SUBSET (y UNION (x DIFF y)))` SUBGOAL_TAC; SET_TAC[SUBSET;UNION;DIFF]; DISCH_THEN_REWRITE; DISCH_THEN (DISJ_CASES_TAC); ASM_MESON_TAC[ISUBSET]; UND 2; REWRITE_TAC[SUBSET;DIFF]; ASM_MESON_TAC[pconn_refl]; (* Wed Aug 4 12:42:12 EDT 2004 *) ]);; (* }}} *) let plane_graph = jordan_def `plane_graph G <=> graph_vertex G SUBSET (euclid 2) /\ graph G /\ graph_edge G SUBSET (simple_arc top2) /\ (!e. (graph_edge G e ==> (graph_inc G e = e INTER (graph_vertex G)))) /\ (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e')) ==> (e INTER e' SUBSET (graph_vertex G)))`;; let graph_isomorphic = jordan_def `graph_isomorphic (G:(A,B)graph_t) (H:(A',B')graph_t) <=> ?f. (graph_iso f G H)`;; let I_BIJ = prove_by_refinement( `!(x:A->bool). BIJ I x x`, (* {{{ proof *) [ REWRITE_TAC[BIJ;INJ;SURJ;I_THM;]; MESON_TAC[]; ]);; (* }}} *) let graph_isomorphic_refl = prove_by_refinement( `!(G:(A,B)graph_t). graph_isomorphic G G`, (* {{{ proof *) [ REWRITE_TAC[graph_isomorphic;graph_iso;]; REP_BASIC_TAC; RIGHT_TAC "f"; RIGHT_TAC "f"; TYPE_THEN `I:A->A` EXISTS_TAC; TYPE_THEN `I:B->B` EXISTS_TAC; TYPE_THEN `(I:A->A,I:B->B)` EXISTS_TAC; ASM_REWRITE_TAC[I_THM;IMAGE_I;I_BIJ]; (* Wed Aug 4 13:08:32 EDT 2004 *) ]);; (* }}} *) let graph_inc_subset = prove_by_refinement( `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e) ==> (graph_inc G e SUBSET graph_vertex G)`, (* {{{ proof *) [ REWRITE_TAC[graph;IMAGE;SUBSET;]; NAME_CONFLICT_TAC; REP_BASIC_TAC; USE 2 (CONV_RULE (dropq_conv "x''")); TSPEC `e'` 2; REWR 2; ASM_MESON_TAC[]; ]);; (* }}} *) let graph_isomorphic_symm = prove_by_refinement( `!(G:(A,B)graph_t) (H:(A',B')graph_t). graph G /\ graph_isomorphic G H ==> graph_isomorphic H G`, (* {{{ proof *) [ REWRITE_TAC[graph_isomorphic;graph_iso]; REP_BASIC_TAC; RIGHT_TAC "f"; RIGHT_TAC "f"; TYPE_THEN `u' = INV u (graph_vertex G) (graph_vertex H)` ABBREV_TAC ; TYPE_THEN `v' = INV v (graph_edge G) (graph_edge H)` ABBREV_TAC ; TYPE_THEN `u'` EXISTS_TAC; TYPE_THEN `v'` EXISTS_TAC; TYPE_THEN `(u',v')` EXISTS_TAC; REWRITE_TAC[]; CONJ_TAC; EXPAND_TAC "u'"; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; CONJ_TAC; EXPAND_TAC "v'"; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; (* LAST step *) REP_BASIC_TAC; TYPE_THEN `e' = v' e` ABBREV_TAC ; TYPE_THEN `e = v e'` SUBGOAL_TAC; ASM_MESON_TAC [inv_comp_right]; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `BIJ v' (graph_edge H) (graph_edge G)` SUBGOAL_TAC; ASM_MESON_TAC[INVERSE_BIJ]; DISCH_TAC; TYPE_THEN `graph_edge G e'` SUBGOAL_TAC; EXPAND_TAC "e'"; UND 10; REWRITE_TAC[BIJ;SURJ;]; ASM_MESON_TAC[]; DISCH_TAC; ASM_SIMP_TAC[]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; EXPAND_TAC "u'"; IMATCH_MP_TAC image_inv_image; ASM_REWRITE_TAC[]; IMATCH_MP_TAC graph_inc_subset; ASM_MESON_TAC[]; (* Wed Aug 4 13:53:24 EDT 2004 *) ]);; (* }}} *) let graph_isomorphic_trans = prove_by_refinement( `!(G:(A,B)graph_t) (H:(A',B')graph_t) (J:(A'',B'')graph_t). graph_isomorphic G H /\ graph_isomorphic H J ==> graph_isomorphic G J`, (* {{{ proof *) [ REWRITE_TAC[graph_isomorphic;graph_iso;]; REP_BASIC_TAC; KILL 3; KILL 7; RIGHT_TAC "f"; RIGHT_TAC "f"; TYPE_THEN `u' o u` EXISTS_TAC; TYPE_THEN `v' o v` EXISTS_TAC; TYPE_THEN `(u' o u, v' o v)` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; REWRITE_TAC[comp_comp]; IMATCH_MP_TAC COMP_BIJ; ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC[comp_comp]; IMATCH_MP_TAC COMP_BIJ; ASM_MESON_TAC[]; REP_BASIC_TAC; REWRITE_TAC[IMAGE_o]; REWRITE_TAC[o_DEF]; TYPE_THEN `graph_edge H (v e)` SUBGOAL_TAC; UND 5; REWRITE_TAC[BIJ;SURJ]; UND 3; MESON_TAC[]; ASM_SIMP_TAC[]; (* Wed Aug 4 14:13:25 EDT 2004 *) ]);; (* }}} *) let graph_isomorphic_graph = prove_by_refinement( `!(G:(A,B)graph_t) H. graph G /\ graph_isomorphic G (H:(A',B')graph_t) ==> graph H`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!z. (graph_edge G z ==> graph_inc G z SUBSET graph_vertex G)` SUBGOAL_TAC; ASM_MESON_TAC[graph_inc_subset]; DISCH_TAC; UND 0; UND 1; REWRITE_TAC[graph;graph_isomorphic;graph_iso]; REP_BASIC_TAC; REWRITE_TAC[SUBSET;IMAGE;]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); REP_BASIC_TAC; TYPE_THEN `?y'. (graph_edge G y' /\ (v y' = x'))` SUBGOAL_TAC; UND 1; REWRITE_TAC[BIJ;SURJ]; UND 6; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `graph_inc H x' = IMAGE u (graph_inc G y')` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `graph_inc G y' SUBSET graph_vertex G` SUBGOAL_TAC; ASM_SIMP_TAC[]; DISCH_TAC; KILL 2; SUBCONJ_TAC; ASM_REWRITE_TAC[IMAGE]; UND 10; UND 3; REWRITE_TAC[BIJ;SURJ]; MESON_TAC[ISUBSET]; DISCH_TAC; (* has size *) TYPE_THEN `(graph_inc G y') HAS_SIZE 2` SUBGOAL_TAC; UND 5; REWRITE_TAC[SUBSET;IMAGE]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); UND 8; MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[HAS_SIZE]; SUBCONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE; ASM_MESON_TAC[HAS_SIZE]; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); REP_BASIC_TAC; UND 11; DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]); IMATCH_MP_TAC CARD_IMAGE_INJ; ASM_REWRITE_TAC[]; REP_BASIC_TAC; UND 3; REWRITE_TAC[BIJ;INJ]; REP_BASIC_TAC; ASM_MESON_TAC[ISUBSET]; (* Wed Aug 4 15:18:06 EDT 2004 *) ]);; (* }}} *) let planar_graph = jordan_def `planar_graph (G:(A,B)graph_t) <=> (?H. (plane_graph H) /\ (graph_isomorphic H G))`;; let plane_planar = prove_by_refinement( `!G. (plane_graph G) ==> (planar_graph G)`, (* {{{ proof *) [ REWRITE_TAC[planar_graph]; REP_BASIC_TAC; ASM_MESON_TAC[graph_isomorphic_refl]; ]);; (* }}} *) let planar_is_graph = prove_by_refinement( `!(G:(A,B)graph_t). (planar_graph G ==> graph G)`, (* {{{ proof *) [ REWRITE_TAC[planar_graph;plane_graph]; REP_BASIC_TAC; ASM_MESON_TAC[graph_isomorphic_graph]; ]);; (* }}} *) let planar_iso = prove_by_refinement( `!G H. (planar_graph (G:(A,B)graph_t)) /\ (graph_isomorphic G H) ==> (planar_graph (H:(A',B')graph_t))`, (* {{{ proof *) [ REWRITE_TAC[planar_graph]; REP_BASIC_TAC; TYPE_THEN `H'` EXISTS_TAC; ASM_REWRITE_TAC[]; JOIN 1 0; USE 0 (MATCH_MP graph_isomorphic_trans); ASM_REWRITE_TAC[]; (* Wed Aug 4 15:41:05 EDT 2004 *) ]);; (* }}} *) (* almost the same ans num_MAX . The minimization is num_WOP. *) let select_num_max = prove_by_refinement( `!Y. FINITE Y /\ (~(Y= EMPTY)) ==> (?z. (Y z /\ (!y. Y y ==> y <=| z)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `f = \ (t:num). --. (&. t)` ABBREV_TAC ; TYPE_THEN `Z = IMAGE f Y` ABBREV_TAC ; TYPE_THEN `FINITE Z /\ ~(Z = {})` SUBGOAL_TAC; EXPAND_TAC "Z"; CONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; UND 0; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `f u` EXISTS_TAC; REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; DISCH_TAC; USE 4 (MATCH_MP min_finite); REP_BASIC_TAC; TYPE_THEN `?z. Y z /\ (f z = delta)` SUBGOAL_TAC; UND 5; EXPAND_TAC "Z"; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `z` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(f z <= f y) ==> (y <=| z)` SUBGOAL_TAC; EXPAND_TAC "f"; REDUCE_TAC; DISCH_THEN IMATCH_MP_TAC ; TYPE_THEN `Z (f y)` SUBGOAL_TAC; EXPAND_TAC "Z"; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let select_image_num_max = prove_by_refinement( `!(X:A->bool) f. (?N. (!x. (X x ==> f x <| N))) /\ ~(X = EMPTY) ==> (?z. (X z /\ (!x. (X x ==> f x <=| f z))))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ; TYPE_THEN `Y SUBSET {n | n <| N}` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE;SUBSET;]; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `FINITE Y /\ (~(Y= EMPTY))` SUBGOAL_TAC; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{n | n <| N}` EXISTS_TAC; ASM_REWRITE_TAC[FINITE_NUMSEG_LT]; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; TYPE_THEN `f u` EXISTS_TAC; UND 2; UND 0; REWRITE_TAC[IMAGE;SUBSET]; DISCH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASM_MESON_TAC[]; DISCH_TAC; USE 4 (MATCH_MP select_num_max); REP_BASIC_TAC; TYPE_THEN `?r. X r /\ (f r = z)` SUBGOAL_TAC; UND 5; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `r` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TSPEC `f x` 4; TYPE_THEN `Y (f x)` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* Wed Aug 4 16:41:51 EDT 2004 *) ]);; (* }}} *) let select_image_num_min = prove_by_refinement( `!(X:A->bool) f. (~(X = EMPTY)) ==> (?z. (X z /\ (!x. (X x ==> f z <=| f x))))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; TYPE_THEN `(?n. Y n)` SUBGOAL_TAC; TYPE_THEN `f u` EXISTS_TAC; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[]; DISCH_TAC; RULE_ASSUM_TAC (ONCE_REWRITE_RULE[num_WOP]); REP_BASIC_TAC; TYPE_THEN `?z. (X z) /\ (f z = n)` SUBGOAL_TAC; UND 3; EXPAND_TAC "Y"; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `z` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TSPEC `f x` 2; IMATCH_MP_TAC (ARITH_RULE `~(f x <| n) ==> (n <=| f x)`); DISCH_ALL_TAC; UND 2; ASM_REWRITE_TAC[]; EXPAND_TAC "Y"; KILL 1; ASM_REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[]; (* Wed Aug 4 19:37:29 EDT 2004 *) ]);; (* }}} *) let select_card_max = prove_by_refinement( `!(X:(A->bool)->bool). (~(X = EMPTY) /\ (FINITE (UNIONS X))) ==> (?z. (X z /\ (!x. (X x ==> (CARD x <= CARD z)))))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC select_image_num_max; ASM_REWRITE_TAC[]; TYPE_THEN `SUC (CARD (UNIONS X))` EXISTS_TAC; REP_BASIC_TAC; TYPE_THEN `x SUBSET (UNIONS X)` SUBGOAL_TAC; IMATCH_MP_TAC sub_union; ASM_REWRITE_TAC[]; DISCH_TAC; REWRITE_TAC[ARITH_RULE `(a <| SUC b) <=> (a <=| b)`]; IMATCH_MP_TAC CARD_SUBSET; ASM_REWRITE_TAC[]; (* Thu Aug 5 10:50:37 EDT 2004 *) ]);; (* }}} *) let select_card_min = prove_by_refinement( `!(X:(A->bool)->bool). ~(X = EMPTY) ==> (?z. (X z /\ (!x. (X x ==> (CARD z <= CARD x)))))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC select_image_num_min; ASM_REWRITE_TAC[]; (* Thu Aug 5 10:52:02 EDT 2004 *) ]);; (* }}} *) (* D embeddings of planar graphs *) let induced_top_interval = prove_by_refinement( `!a b. induced_top (top_of_metric(UNIV,d_real)) {x | a <= x /\ x <= b } = top_of_metric ({x | a <= x /\ x <= b}, d_real) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC top_of_metric_induced; ASM_REWRITE_TAC[SUBSET_UNIV;metric_real]; ]);; (* }}} *) let continuous_interval = prove_by_refinement( `!f a b. (continuous f (top_of_metric(UNIV,d_real)) top2) ==> (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) top2)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[GSYM induced_top_interval]; IMATCH_MP_TAC continuous_induced_domain; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV ]; ]);; (* }}} *) let inj_image_subset = prove_by_refinement( `!(f:A->B) X Y. (INJ f X Y ==> IMAGE f X SUBSET Y)`, (* {{{ proof *) [ REWRITE_TAC[INJ;IMAGE;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let subset_contain = prove_by_refinement( `!a b c d. (c <= a) /\ (b <= d) ==> {x | a <= x /\ x <= b} SUBSET {x | c <= x /\ x <= d}`, (* {{{ proof *) [ REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; ]);; (* }}} *) let curve_restriction = prove_by_refinement( `!C K K' a b. simple_arc top2 C /\ closed_ top2 K /\ closed_ top2 K' /\ (C INTER K INTER K' = EMPTY) /\ ~(C INTER K = EMPTY) /\ ~(C INTER K' = EMPTY) /\ (a <. b) ==> (?C' f. (C' = IMAGE f {x | a <= x /\ x <= b}) /\ (C' SUBSET C) /\ continuous f (top_of_metric(UNIV,d_real)) top2 /\ INJ f {x | a <= x /\ x <= b} (euclid 2) /\ (C' INTER K = {(f a)}) /\ (C' INTER K' = {(f b)}) ) `, (* {{{ proof *) [ REWRITE_TAC[simple_arc]; REP_BASIC_TAC; ASSUME_TAC top2_unions; (* K parameter *) TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K (f s)))` SUBGOAL_TAC; ASSUME_TAC preimage_first ; TYPEL_THEN [`K`;`2`] (USE 10 o ISPECL); FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); KILL 10; ASM_REWRITE_TAC[GSYM top2;]; ASM_SIMP_TAC[continuous_interval]; UND 2; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; REWR 6; IMATCH_MP_TAC inj_image_subset; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* K' parameter *) TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K' (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K' (f s)))` SUBGOAL_TAC; ASSUME_TAC preimage_first ; TYPEL_THEN [`K'`;`2`] (USE 14 o ISPECL); FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); KILL 14; ASM_REWRITE_TAC[GSYM top2;]; ASM_SIMP_TAC[continuous_interval]; UND 1; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; REWR 6; IMATCH_MP_TAC inj_image_subset; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(t < t' \/ t' < t)` SUBGOAL_TAC; REWRITE_TAC[(REAL_ARITH `(t < t' \/ t' < t) <=> ~( t = t')`)]; DISCH_ALL_TAC; UND 3; REWRITE_TAC[EMPTY_EXISTS;INTER;]; TYPE_THEN `(f t)` EXISTS_TAC; REWR 11; REWRITE_TAC[IMAGE;SUBSET]; CONJ_TAC; TYPE_THEN `t'` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* main cases split [main] *) ASSUME_TAC (REAL_ARITH `&0 < &1`); DISCH_THEN (DISJ_CASES_TAC); TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (&0 < &1) /\ (t < t') ` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; REWR 6; ASM_REWRITE_TAC[SUBSET ]; UND 19; UND 16; UND 13; REAL_ARITH_TAC; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); REP_BASIC_TAC; TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; TYPE_THEN `Ca INTER K' = {(g (&0))}` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[INTER;SUBSET;INR IN_SING;]; KILL 26; EXPAND_TAC "Ca"; REWRITE_TAC[IMAGE;SUBSET]; REP_BASIC_TAC; TYPE_THEN `x' < t' \/ (x' = t')` SUBGOAL_TAC; UND 28; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; PROOF_BY_CONTR_TAC; UND 26; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 29; UND 13; REAL_ARITH_TAC; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;INTER;INR IN_SING;]; KILL 26; EXPAND_TAC "Ca"; REWRITE_TAC[IMAGE;SUBSET]; NAME_CONFLICT_TAC; REP_BASIC_TAC; CONJ_TAC; TYPE_THEN `t'` EXISTS_TAC; ASM_MESON_TAC[REAL_ARITH `(t < t' ==> t<= t') /\ (t' <= t')`]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `~(Ca INTER K = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `f t` EXISTS_TAC; KILL 26; EXPAND_TAC "Ca"; REWRITE_TAC[IMAGE;SUBSET;]; ASM_REWRITE_TAC[]; TYPE_THEN `t` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `t <= t`]; ASM_SIMP_TAC[REAL_ARITH `(t < t') ==> (t <= t')`]; DISCH_TAC; KILL 21; (* ADD Ca SUBSET C *) TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC; KILL 26; EXPAND_TAC "Ca"; KILL 20; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;SUBSET]; NAME_CONFLICT_TAC; REP_BASIC_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 21; UND 26; UND 13; UND 19; UND 16; REAL_ARITH_TAC; DISCH_TAC; (* t'' parameter for g and K *) TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K (g s)))` SUBGOAL_TAC; ASSUME_TAC preimage_first ; TYPEL_THEN [`K`;`2`] (USE 29 o ISPECL); FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); KILL 29; ASM_REWRITE_TAC[GSYM top2;]; ASM_SIMP_TAC[continuous_interval]; EXPAND_TAC "Ca"; IMATCH_MP_TAC inj_image_subset; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* set up for arc_reparameter_rev *) TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\ INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'') ` SUBGOAL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC; UND 32; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET ]; UND 31; REAL_ARITH_TAC; PROOF_BY_CONTR_TAC; UND 3; REWRITE_TAC[EMPTY_EXISTS;INTER;]; TYPE_THEN `g (&0)` EXISTS_TAC; TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC; TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC; ASM_MESON_TAC[INTER_SUBSET]; REWRITE_TAC[SUBSET;INR IN_SING]; MESON_TAC[]; DISCH_TAC; CONJ_TAC; UND 3; UND 21; MESON_TAC[ISUBSET]; REWR 30; ASM_REWRITE_TAC[]; UND 15; ASM_REWRITE_TAC[]; DISCH_TAC; FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); REP_BASIC_TAC; TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ; (* now finally go after the goal in the FIRST case *) TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `g'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* now finish off the three conditions *) KILL 34; TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC; KILL 43; EXPAND_TAC "C'"; EXPAND_TAC "Ca"; IMATCH_MP_TAC IMAGE_SUBSET; IMATCH_MP_TAC subset_contain; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; CONJ_TAC; (* 1*) ASM_REWRITE_TAC[]; USE 8 GSYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Ca` EXISTS_TAC ; ASM_MESON_TAC[]; CONJ_TAC; (* 2 *) KILL 43; EXPAND_TAC "C'"; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[INTER;IMAGE;SUBSET]; NAME_CONFLICT_TAC; REP_BASIC_TAC; REWRITE_TAC[INR IN_SING]; TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC; UND 45; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TSPEC `x'` 14; UND 43; ASM_MESON_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING]; NAME_CONFLICT_TAC; REP_BASIC_TAC; CONJ_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `t''` EXISTS_TAC; ASM_MESON_TAC[REAL_ARITH `t'' <= t''`]; ASM_MESON_TAC[]; (* 3 *) IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Ca INTER K'` EXISTS_TAC; CONJ_TAC; UND 34; REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;INR IN_SING]; REWRITE_TAC[SUBSET;INTER;INR IN_SING ]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; EXPAND_TAC "C'"; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 40; REAL_ARITH_TAC; ASM_MESON_TAC[]; (* sh *) (* ******************* START THE SECOND HALF ************ *) TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t' <= x /\ x <= t} (euclid 2) /\ (&0 < &1) /\ (t' < t) ` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; REWR 6; ASM_REWRITE_TAC[SUBSET ]; UND 19; UND 12; UND 17; REAL_ARITH_TAC; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); REP_BASIC_TAC; TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; TYPE_THEN `Ca INTER K = {(g (&0))}` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[INTER;SUBSET;INR IN_SING;]; KILL 26; EXPAND_TAC "Ca"; REWRITE_TAC[IMAGE;SUBSET]; REP_BASIC_TAC; TYPE_THEN `x' < t \/ (x' = t)` SUBGOAL_TAC; UND 28; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; PROOF_BY_CONTR_TAC; UND 26; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 29; UND 17; REAL_ARITH_TAC; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;INTER;INR IN_SING;]; KILL 26; EXPAND_TAC "Ca"; REWRITE_TAC[IMAGE;SUBSET]; NAME_CONFLICT_TAC; REP_BASIC_TAC; CONJ_TAC; TYPE_THEN `t` EXISTS_TAC; ASM_MESON_TAC[REAL_ARITH `(t' < t ==> t'<= t) /\ (t <= t)`]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `~(Ca INTER K' = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `f t'` EXISTS_TAC; KILL 26; EXPAND_TAC "Ca"; REWRITE_TAC[IMAGE;SUBSET;]; ASM_REWRITE_TAC[]; TYPE_THEN `t'` EXISTS_TAC; ASM_REWRITE_TAC[REAL_ARITH `t' <= t'`]; ASM_SIMP_TAC[REAL_ARITH `(t' < t) ==> (t' <= t)`]; DISCH_TAC; KILL 21; (* ADD Ca SUBSET C *) TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC; KILL 26; EXPAND_TAC "Ca"; KILL 20; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;SUBSET]; NAME_CONFLICT_TAC; REP_BASIC_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 21; UND 26; UND 17; UND 19; UND 12; REAL_ARITH_TAC; DISCH_TAC; (* gK *) (* t'' parameter for g and K *) TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K' (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K' (g s)))` SUBGOAL_TAC; ASSUME_TAC preimage_first ; TYPEL_THEN [`K'`;`2`] (USE 29 o ISPECL); FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); KILL 29; ASM_REWRITE_TAC[GSYM top2;]; ASM_SIMP_TAC[continuous_interval]; EXPAND_TAC "Ca"; IMATCH_MP_TAC inj_image_subset; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* set up for arc_reparameter_gen *) TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\ INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'') ` SUBGOAL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC; UND 32; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET ]; UND 31; REAL_ARITH_TAC; PROOF_BY_CONTR_TAC; UND 3; REWRITE_TAC[EMPTY_EXISTS;INTER;]; TYPE_THEN `g (&0)` EXISTS_TAC; TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC; TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC; ASM_MESON_TAC[INTER_SUBSET]; REWRITE_TAC[SUBSET;INR IN_SING]; MESON_TAC[]; DISCH_TAC; CONJ_TAC; UND 3; UND 21; MESON_TAC[ISUBSET]; REWR 30; ASM_REWRITE_TAC[]; UND 11; ASM_REWRITE_TAC[]; DISCH_TAC; FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ; (* now finally go after the goal in the FIRST case *) TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `g'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* nfo *) (* now finish off the three conditions *) KILL 34; TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC; KILL 43; EXPAND_TAC "C'"; EXPAND_TAC "Ca"; IMATCH_MP_TAC IMAGE_SUBSET; IMATCH_MP_TAC subset_contain; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; CONJ_TAC; (* 1*) ASM_REWRITE_TAC[]; USE 8 GSYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Ca` EXISTS_TAC ; ASM_MESON_TAC[]; (* s2 *) IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC ; (* 2 *) KILL 43; EXPAND_TAC "C'"; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[INTER;IMAGE;SUBSET]; NAME_CONFLICT_TAC; REP_BASIC_TAC; REWRITE_TAC[INR IN_SING]; TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC; UND 45; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TSPEC `x'` 14; UND 43; ASM_MESON_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING]; NAME_CONFLICT_TAC; REP_BASIC_TAC; CONJ_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `t''` EXISTS_TAC; ASM_MESON_TAC[REAL_ARITH `t'' <= t''`]; ASM_MESON_TAC[]; (* s3 *) (* 3 *) IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Ca INTER K` EXISTS_TAC; CONJ_TAC; UND 34; REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;INR IN_SING]; REWRITE_TAC[SUBSET;INTER;INR IN_SING ]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; EXPAND_TAC "C'"; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `a` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 40; REAL_ARITH_TAC; ASM_MESON_TAC[]; (* Thu Aug 5 08:09:38 EDT 2004 *) ]);; (* }}} *) let simple_arc_end = jordan_def `simple_arc_end C v v' <=> (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1 }) /\ continuous f (top_of_metric(UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (f (&0) = v) /\ (f(&1) = v'))`;; let good_plane_graph = jordan_def `good_plane_graph G <=> plane_graph G /\ (!e v v'. (graph_edge G e /\ ~(v = v') /\ (graph_inc G e v) /\ (graph_inc G e v') ==> (simple_arc_end e v v')))`;; let graph_edge_mod = jordan_def `graph_edge_mod (G:(A,B)graph_t) (f:B->B') = mk_graph_t (graph_vertex G,IMAGE f (graph_edge G), (\ e' v. (?e. graph_edge G e /\ graph_inc G e v /\ (f e = e'))))`;; let graph_edge_mod_v = prove_by_refinement( `!(G:(A,B)graph_t) (f:B->B'). graph_vertex (graph_edge_mod G f) = graph_vertex G `, (* {{{ proof *) [ REWRITE_TAC[graph_edge_mod;graph_vertex;dest_graph_t;]; ]);; (* }}} *) let graph_edge_mod_e = prove_by_refinement( `!(G:(A,B)graph_t) (f:B->B'). graph_edge (graph_edge_mod G f) = IMAGE f (graph_edge G )`, (* {{{ proof *) [ REWRITE_TAC[graph_edge_mod;graph_edge;dest_graph_t;part1;drop0]; ]);; (* }}} *) let graph_edge_mod_i = prove_by_refinement( `!(G:(A,B)graph_t) (f:B->B') e v. graph_inc (graph_edge_mod G f) e v <=> (?e'. (graph_edge G e' /\ graph_inc G e' v /\ (f e' = e)))`, (* {{{ proof *) [ REWRITE_TAC[graph_edge_mod;graph_inc;dest_graph_t;part1;drop1]; ]);; (* }}} *) let inj_bij = prove_by_refinement( `!(f:A->B) X. (INJ f X UNIV) ==> (BIJ f X (IMAGE f X))`, (* {{{ proof *) [ REWRITE_TAC[BIJ]; REP_BASIC_TAC; REWRITE_TAC[IMAGE_SURJ]; UND 0; REWRITE_TAC[INJ;IMAGE;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let graph_edge_iso = prove_by_refinement( `! f (G:(A,B)graph_t). (INJ (f:B->B') (graph_edge G) (UNIV)) ==> (graph_isomorphic G (graph_edge_mod G f))`, (* {{{ proof *) [ REWRITE_TAC[graph_isomorphic;graph_iso]; REP_BASIC_TAC; RIGHT_TAC "f"; RIGHT_TAC "f"; TYPE_THEN `I:A->A` EXISTS_TAC ; TYPE_THEN `f` EXISTS_TAC; NAME_CONFLICT_TAC; EXISTS_TAC `(I:A->A,f:B->B')` ; REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e]; CONJ_TAC; REWRITE_TAC[I_DEF;BIJ;INJ;SURJ;]; MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC inj_bij; ASM_REWRITE_TAC[]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[graph_edge_mod_i;IMAGE_I;]; EQ_TAC; REP_BASIC_TAC; TYPE_THEN `e'' = e'` SUBGOAL_TAC; RULE_ASSUM_TAC(REWRITE_RULE [INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let graph_edge_graph = prove_by_refinement( `!f (G:(A,B)graph_t). (graph G) /\ (INJ (f:B->B') (graph_edge G) (UNIV)) ==> (graph (graph_edge_mod G f)) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC graph_isomorphic_graph; TYPE_THEN `G` EXISTS_TAC; ASM_MESON_TAC[graph_edge_iso]; ]);; (* }}} *) let plane_graph_mod = prove_by_refinement( `!G f. (plane_graph G) /\ (INJ f (graph_edge G) UNIV) /\ (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (f e INTER f e' SUBSET e INTER e') )) /\ (!e. (graph_edge G e ==> (simple_arc top2 (f e)))) /\ (!e. (graph_edge G e) ==> (e INTER graph_vertex G = (f e) INTER graph_vertex G)) ==> (plane_graph (graph_edge_mod G f)) `, (* {{{ proof *) [ REWRITE_TAC[plane_graph]; REP_BASIC_TAC; REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e;]; CONJ_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; ASM_MESON_TAC[graph_edge_graph]; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER]; REP_BASIC_TAC; REWRITE_TAC[graph_edge_mod_i]; EQ_TAC; REP_BASIC_TAC; TYPE_THEN `e' = x` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TSPEC `e'` 5; TSPEC `e'` 0; UND 0; UND 5; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; TYPE_THEN `(f x INTER graph_vertex G) x'` SUBGOAL_TAC; ASM_MESON_TAC[]; REWRITE_TAC[INTER;SUBSET]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; TSPEC `x` 5; TSPEC `x` 0; UND 0; REWR 5; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); ASM_SIMP_TAC[]; REWRITE_TAC[INTER;SUBSET]; ASM_MESON_TAC[]; REP_BASIC_TAC; UND 10; REWRITE_TAC[IMAGE]; REP_BASIC_TAC; UND 11; REWRITE_TAC[IMAGE]; REP_BASIC_TAC; TYPE_THEN `~(x = x')` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `x' INTER x` EXISTS_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Thu Aug 5 10:17:38 EDT 2004 *) ]);; (* }}} *) let compact_point = prove_by_refinement( `!U (x:A). (UNIONS U x) ==> (compact U {x})`, (* {{{ proof *) [ REWRITE_TAC[compact]; REP_BASIC_TAC; CONJ_TAC; ASM_REWRITE_TAC [single_subset]; REP_BASIC_TAC; TYPE_THEN `?u. V u /\ u x` SUBGOAL_TAC; UND 2; REWRITE_TAC[SUBSET;UNIONS;INR IN_SING]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `{u}` EXISTS_TAC; ASM_REWRITE_TAC [single_subset;FINITE_SING]; (* Thu Aug 5 12:02:40 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_select = prove_by_refinement( `!C v v'. (simple_arc top2 C) /\ (C v) /\ (C v') /\ ~(v = v') ==> (?C'. (C' SUBSET C) /\ (simple_arc_end C' v v'))`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; (* A *) TYPE_THEN `!v. (C v) ==> (closed_ top2 {v})` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC compact_closed; ASM_SIMP_TAC[top2_top;metric_hausdorff;top2;metric_euclid;compact_point]; IMATCH_MP_TAC compact_point; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; UND 3; REWRITE_TAC[simple_arc]; REP_BASIC_TAC; TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_image_subset; RULE_ASSUM_TAC (REWRITE_RULE [top2_unions]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; (* B hypotheses of curve_restriction *) TYPE_THEN `simple_arc top2 C /\ closed_ top2 {v} /\ closed_ top2 {v'} /\ (C INTER {v} INTER { v' } = EMPTY) /\ ~(C INTER {v} = EMPTY) /\ ~(C INTER {v'} = EMPTY) /\ (&0 < &1)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `&0 < &1`]; REWRITE_TAC[INTER;INR IN_SING;EMPTY_EXISTS ]; REWRITE_TAC[EQ_EMPTY]; ASM_MESON_TAC[]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP curve_restriction t)); REP_BASIC_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `!A u v. (A INTER {u} = {v}) ==> ( (v:num->real)=u)` SUBGOAL_TAC; REWRITE_TAC[eq_sing;INTER;INR IN_SING;]; MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let graph_edge2 = prove_by_refinement( `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e) ==> (graph_inc G e HAS_SIZE 2)`, (* {{{ proof *) [ REWRITE_TAC[graph]; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let simple_arc_end_symm = prove_by_refinement( `!C' v v'. (simple_arc_end C' v v' ==> simple_arc_end C' v' v)`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; TYPE_THEN `( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (&0 < &1) /\ (&0 < &1))` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`]; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); REP_BASIC_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let simple_arc_end_plane_select = prove_by_refinement( `!G e. (plane_graph G /\ graph_edge G e) ==> (?e'. (e' SUBSET e /\ (!v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==> simple_arc_end e' v v')))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]); IMATCH_MP_TAC graph_edge2; ASM_REWRITE_TAC[]; REWRITE_TAC[has_size2]; REP_BASIC_TAC; TYPE_THEN `(?e'. (e' SUBSET e) /\ (simple_arc_end e' a b))` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_select; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; CONJ_TAC; UND 5; ASM_MESON_TAC [ISUBSET]; TYPE_THEN `graph_inc G e a /\ graph_inc G e b` SUBGOAL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[in_pair]; KILL 3; ASM_SIMP_TAC[]; REWRITE_TAC[INTER;SUBSET]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `e'` EXISTS_TAC; ASM_REWRITE_TAC[in_pair]; REP_BASIC_TAC; TYPE_THEN `((v = a) /\ (v' = b)) \/ ((v = b) /\ (v' =a ))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; (* Thu Aug 5 14:10:17 EDT 2004 *) ]);; (* }}} *) let plane_graph_contain = prove_by_refinement( `!G e e'. (plane_graph G /\ graph_edge G e /\ graph_edge G e' /\ (e SUBSET e') ==> (e = e'))`, (* {{{ proof *) [ REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `e INTER e' SUBSET graph_vertex G` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `e INTER e' SUBSET e' INTER graph_vertex G` SUBGOAL_TAC; REWRITE_TAC[SUBSET_INTER]; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER;SUBSET]; MESON_TAC[]; TYPE_THEN `e' INTER graph_vertex G = graph_inc G e'` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `graph_inc G e' HAS_SIZE 2` SUBGOAL_TAC; ASM_MESON_TAC[graph_edge2]; TYPE_THEN `e INTER e' = e` SUBGOAL_TAC; UND 0; REWRITE_TAC[SUBSET_INTER_ABSORPTION]; DISCH_THEN_REWRITE; REWRITE_TAC[has_size2]; REP_BASIC_TAC; REWR 10; TYPE_THEN `simple_arc top2 e` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; REWRITE_TAC[simple_arc]; REP_BASIC_TAC; TYPE_THEN `!x. (&0 <= x /\ x <= &1) ==> {a,b} (f x)` SUBGOAL_TAC; REWR 10; UND 10; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; TYPE_THEN `(f (&0) = f(&1))` SUBGOAL_TAC; IMATCH_MP_TAC two_exclusion; TYPE_THEN `{a,b}` EXISTS_TAC; TYPE_THEN `?t. (&0 < t /\ t < &1)` SUBGOAL_TAC; TYPE_THEN `&1/ (&2)` EXISTS_TAC; IMATCH_MP_TAC half_pos; REAL_ARITH_TAC; REP_BASIC_TAC; TYPE_THEN `f t` EXISTS_TAC; CONJ_TAC; ASM_MESON_TAC[pair_size_2]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REAL_ARITH_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REAL_ARITH_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 18; UND 19; REAL_ARITH_TAC; CONJ_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `~(&0 = t)` SUBGOAL_TAC; UND 19; REAL_ARITH_TAC; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; REWR 20; ASM_REWRITE_TAC[]; UND 18; UND 19; REAL_ARITH_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `~(&1 = t)` SUBGOAL_TAC; UND 18; REAL_ARITH_TAC; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; REWR 20; ASM_REWRITE_TAC[]; UND 18; UND 19; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `~(&0 = &1)` SUBGOAL_TAC; REAL_ARITH_TAC; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* Thu Aug 5 15:11:20 EDT 2004 *) ]);; (* }}} *) let graph_edge_end_select = prove_by_refinement( `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e ==> (?v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v')))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; IMATCH_MP_TAC graph_edge2; ASM_REWRITE_TAC[]; REWRITE_TAC[has_size2]; REP_BASIC_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[in_pair]; (* Thu Aug 5 19:26:02 EDT 2004 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION K *) (* ------------------------------------------------------------------ *) (* Thu Aug 5 21:17:36 EDT 2004 *) (* Tweaked slightly now that there is an "inf" constant. JRH, 4 Dec 2011 *) let inf = let inf_def = `inf (X:real->bool) = @s. ((!x. X x ==> s <= x) /\ (!y. (!x. X x ==> y <= x) ==> (y <= s)))` in let def = subst [mk_var("inf",`:(real->bool)->real`),mk_const("inf",[])] inf_def in jordan_def def;; let interval_closed = prove_by_refinement( `!a b. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x /\ x <= b}`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC compact_closed; ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real]; ASM_SIMP_TAC[metric_hausdorff;metric_real;]; ]);; (* }}} *) let half_closed = prove_by_refinement( `!a. closed_ (top_of_metric(UNIV,d_real)) {x | x <= a}`, (* {{{ proof *) [ REWRITE_TAC[closed]; REP_BASIC_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; TYPE_THEN `UNIV DIFF {x | x <= a } = {x | a < x}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[DIFF;UNIV]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC [open_DEF;half_open_above]; ]);; (* }}} *) let half_closed_above = prove_by_refinement( `!a. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x}`, (* {{{ proof *) [ REWRITE_TAC[closed]; REP_BASIC_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; TYPE_THEN `UNIV DIFF {x | a <= x } = {x | x < a}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[DIFF;UNIV]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC [open_DEF;half_open]; ]);; (* }}} *) let inf_LB = prove_by_refinement( `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==> (!x. X x ==> inf X <= x) /\ (!y. (!x. X x ==> y <= x) ==> (y <= inf X))`, (* {{{ proof *) [ GEN_TAC; TYPE_THEN `topology_ (top_of_metric(UNIV,d_real))` SUBGOAL_TAC; ASM_SIMP_TAC[top_of_metric_top;metric_real]; DISCH_TAC; (* *) TYPE_THEN `X SUBSET closure (top_of_metric(UNIV,d_real)) X` SUBGOAL_TAC; ASM_SIMP_TAC[subset_closure]; DISCH_TAC; (* *) REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; REWRITE_TAC[inf]; SELECT_TAC; ASM_MESON_TAC[]; PROOF_BY_CONTR_TAC; UND 4; KILL 5; REWRITE_TAC[]; TYPE_THEN `XC = closure (top_of_metric(UNIV,d_real)) X INTER {x | t <= x /\ x <= u}` ABBREV_TAC ; TYPE_THEN `compact (top_of_metric(UNIV,d_real)) XC` SUBGOAL_TAC; IMATCH_MP_TAC closed_compact; TYPE_THEN `{x | t <= x /\ x <= u}` EXISTS_TAC; ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real]; EXPAND_TAC "XC"; CONJ_TAC; IMATCH_MP_TAC closed_inter2; ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real]; IMATCH_MP_TAC closure_closed; ASM_SIMP_TAC[top_of_metric_top;metric_real;GSYM top_of_metric_unions;]; ASM_REWRITE_TAC[INTER_SUBSET]; DISCH_TAC; (* *) TYPE_THEN `(?z. (XC z /\ (!y. XC y ==> z <= y)))` SUBGOAL_TAC; IMATCH_MP_TAC compact_inf; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; EXPAND_TAC "XC"; REWRITE_TAC[INTER;SUBSET]; CONJ_TAC; UND 1; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; ASM_MESON_TAC[REAL_ARITH `u <= u`]; REP_BASIC_TAC; TYPE_THEN `z` EXISTS_TAC; CONJ_TAC; REP_BASIC_TAC; TYPE_THEN `(x <= u) \/ (u < x)` SUBGOAL_TAC; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `XC x` SUBGOAL_TAC; EXPAND_TAC "XC"; REWRITE_TAC[INTER;SUBSET]; CONJ_TAC; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; UND 7; EXPAND_TAC "XC"; REWRITE_TAC[INTER;SUBSET]; REP_BASIC_TAC; ASM_MESON_TAC[REAL_ARITH `z <= u /\ u < x ==> z <= x`]; REP_BASIC_TAC; TYPE_THEN `closed_ (top_of_metric (UNIV,d_real)) {x | y' <= x }` SUBGOAL_TAC; REWRITE_TAC[half_closed_above]; DISCH_TAC; TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X SUBSET {x | y' <= x }` SUBGOAL_TAC; IMATCH_MP_TAC closure_subset; ASM_REWRITE_TAC[SUBSET ]; DISCH_TAC; TYPE_THEN `XC SUBSET {x | y' <= x}` SUBGOAL_TAC; EXPAND_TAC "XC"; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X ` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "XC"; REWRITE_TAC[INTER_SUBSET]; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* Fri Aug 6 05:51:24 EDT 2004 *) ]);; (* }}} *) let inf_eps = prove_by_refinement( `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==> (!epsilon. (&0 < epsilon) ==> (?x. X x /\ (x < inf X + epsilon)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(!y. (!x. X x ==> y <= x) ==> (y <= inf X))` SUBGOAL_TAC; ASM_MESON_TAC[inf_LB]; DISCH_TAC; TSPEC `inf X + epsilon` 3; PROOF_BY_CONTR_TAC; TYPE_THEN `(!x. X x ==> inf X + epsilon <= x)` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC (REAL_ARITH `~(v < u) ==> u <= v`); ASM_MESON_TAC[]; ASM_MESON_TAC[REAL_ARITH `(x + y <= x ==> ~(&0 < y))`]; ]);; (* }}} *) let supm = jordan_def `supm (X:real->bool) = --. (inf ({x | ?z. X z /\ (x = --. z)}))`;; let supm_UB = prove_by_refinement( `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==> (!x. X x ==> x <= supm X ) /\ (!y. (!x. X x ==> x <= y) ==> (supm X <= y))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[supm]; TYPE_THEN `Y = {x | ?z. X z /\ (x = --z)}` ABBREV_TAC ; TYPE_THEN `!u. (Y u = X (-- u)) /\ (Y (--u ) = X u)` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; MESON_TAC[REAL_ARITH `(-- (-- u) = u)`]; DISCH_TAC; TYPE_THEN `(~(Y = EMPTY) /\ (?t. !x. (Y x ==> t <= x)))` SUBGOAL_TAC; UND 1; REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; CONJ_TAC; TYPE_THEN `-- u` EXISTS_TAC; ASM_MESON_TAC[]; TYPE_THEN `-- t` EXISTS_TAC; REP_BASIC_TAC; ASM_MESON_TAC[REAL_ARITH `--t <= x <=> (-- x <= t)`]; DISCH_THEN ( ASSUME_TAC o (MATCH_MP inf_LB)); CONJ_TAC; REP_BASIC_TAC; ASM_MESON_TAC[REAL_ARITH `y <= --x <=> x <= --y`]; REP_BASIC_TAC; IMATCH_MP_TAC (REAL_ARITH `--y <= inf Y ==> -- inf Y <= y`); FIRST_ASSUM IMATCH_MP_TAC ; REP_BASIC_TAC; ASM_MESON_TAC[ REAL_ARITH `--x <= y <=> --y <= x`]; (* Fri Aug 6 06:42:14 EDT 2004 *) ]);; (* }}} *) let supm_eps = prove_by_refinement( `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==> (!epsilon.(&0 < epsilon) ==> (?x. X x /\ (supm X - epsilon < x)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC; ASM_MESON_TAC[supm_UB]; DISCH_TAC; TSPEC `supm X - epsilon` 3; PROOF_BY_CONTR_TAC; TYPE_THEN `(!x. X x ==> x <= supm X - epsilon)` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC (REAL_ARITH `~(v < u) ==> u <= v`); ASM_MESON_TAC[]; ASM_MESON_TAC[REAL_ARITH `(x <= x - y ==> ~(&0 < y))`]; (* Fri Aug 6 06:47:22 EDT 2004 *) ]);; (* }}} *) let compact_subset = prove_by_refinement( `!(X:A->bool) K d. (K SUBSET X /\ metric_space(X,d)) ==> (compact(top_of_metric(X,d)) K = compact(top_of_metric(K,d))K) `, (* {{{ proof *) [ REP_BASIC_TAC; ASM_SIMP_TAC[GSYM top_of_metric_induced]; ASM_MESON_TAC[induced_compact;top_of_metric_unions]; ]);; (* }}} *) let exp_gt1 = prove_by_refinement( `!n. (0 < n) ==> (1 < 2 **| n)`, (* {{{ proof *) [ TYPE_THEN `1 = 2 **| 0` SUBGOAL_TAC; REWRITE_TAC[EXP]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); REP_BASIC_TAC; REWRITE_TAC[LT_EXP]; UND 0; ARITH_TAC; ]);; (* }}} *) let twopow_lt = prove_by_refinement( `!a b. (a < b) ==> (twopow a < twopow b)`, (* {{{ proof *) [ ONCE_REWRITE_TAC [INT_ARITH `(a <: b) <=> (&:0 <: b -: a)`]; ASSUME_TAC twopow_pos; ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> &1*x < y`]; ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]; REWRITE_TAC[real_div]; REWRITE_TAC[GSYM TWOPOW_INV;GSYM TWOPOW_ADD_INT;GSYM INT_SUB]; REP_GEN_TAC; TYPE_THEN `C = b -: a` ABBREV_TAC ; ASSUME_TAC INT_REP2 ; TSPEC `C` 2; REP_BASIC_TAC; FIRST_ASSUM DISJ_CASES_TAC; UND 2; ASM_REWRITE_TAC[]; REWRITE_TAC[TWOPOW_POS]; REDUCE_TAC; REWRITE_TAC[INT_OF_NUM_LT;exp_gt1]; PROOF_BY_CONTR_TAC; UND 2; ASM_REWRITE_TAC[]; REWRITE_TAC[INT_ARITH `(~(&:0 <: --: y) <=> (&:0 <=: y))`]; REWRITE_TAC[INT_OF_NUM_LE]; ARITH_TAC; ]);; (* }}} *) let compact_distance = prove_by_refinement( `!(X:A->bool) d K K'. (metric_space(X,d) /\ ~(K=EMPTY) /\ ~(K' = EMPTY) /\ (compact (top_of_metric(X,d)) K) /\ (compact(top_of_metric(X,d))K')) ==> (?p p'. (K p /\ K' p' /\ (!q q'. (K q /\ K' q') ==> (d p p' <= d q q'))))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `UNIONS (top_of_metric(X,d)) = X` SUBGOAL_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; TYPE_THEN `K SUBSET X /\ K' SUBSET X` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[compact]); REWR 0; REWR 1; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `Y = { z | ?q q'. (K q /\ K' q' /\ (z = d q q'))}` ABBREV_TAC ; TYPE_THEN `!y. (Y y) ==> (&0 <= y)` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); TYPEL_THEN [`q`;`q'`;`q'`] (USE 4 o ISPECL); ASM_MESON_TAC[metric_space;ISUBSET]; REP_BASIC_TAC; (* *) TYPE_THEN `~(Y= EMPTY)` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; UND 2; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `d u' u` EXISTS_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; (* inf Y *) TYPE_THEN `(!epsilon. (&0 < epsilon) ==> (?x. Y x /\ (x < inf Y + epsilon)))` SUBGOAL_TAC; IMATCH_MP_TAC inf_eps; ASM_MESON_TAC[]; REP_BASIC_TAC; ASSUME_TAC twopow_pos; TYPE_THEN `(!n. ?p. ?p'. K p /\ K' p' /\ (d p p' < inf Y + twopow( -- (&:n))))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `(?x. Y x /\ x < inf Y + twopow (--: (&:n)))` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REP_BASIC_TAC; UND 14; EXPAND_TAC "Y"; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; RIGHT 13 "n"; REP_BASIC_TAC; (* compact,complete,totally bounded *) TYPE_THEN `metric_space (K,d) /\ metric_space(K',d)` SUBGOAL_TAC; ASM_MESON_TAC[metric_subspace]; REP_BASIC_TAC; TYPE_THEN `compact (top_of_metric(K,d)) K /\ compact (top_of_metric(K',d)) K'` SUBGOAL_TAC; ASM_MESON_TAC[compact_subset]; REP_BASIC_TAC; TYPE_THEN `complete (K,d) /\ complete (K',d) ` SUBGOAL_TAC; ASM_MESON_TAC[compact_complete]; REP_BASIC_TAC; TYPE_THEN `totally_bounded(K,d) /\ totally_bounded(K',d)` SUBGOAL_TAC; ASM_MESON_TAC[compact_totally_bounded;]; REP_BASIC_TAC; (* construct subseq of p *) TYPE_THEN `(?ss. subseq ss /\ converge (K,d) (p o ss))` SUBGOAL_TAC; IMATCH_MP_TAC convergent_subseq; ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); RIGHT 13 "p'"; ASM_MESON_TAC[]; REWRITE_TAC[converge]; REP_BASIC_TAC; (* construct q *) TYPE_THEN `!n. ?p'. K' p' /\ d x p' < inf Y + twopow(--: (&:n))` SUBGOAL_TAC; REP_BASIC_TAC; TSPEC `twopow (--: (&:(SUC(n))))` 22; REP_BASIC_TAC; REWR 22; TSPEC `SUC(n') + SUC (n)` 22; RULE_ASSUM_TAC (REWRITE_RULE[ARITH_RULE `x <=| SUC x +| y`]); TSPEC `ss (SUC n' +| SUC n)` 13; REP_BASIC_TAC; TYPE_THEN `twopow (--: (&:(ss(SUC n'+SUC n)))) < twopow(--: (&:(SUC n)))` SUBGOAL_TAC; IMATCH_MP_TAC twopow_lt; REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT;]; IMATCH_MP_TAC (ARITH_RULE `(?t. (a <= t /\ t <| b)) ==> (a <| b)`); TYPE_THEN `ss (SUC n)` EXISTS_TAC; ASM_SIMP_TAC[SEQ_SUBLE;subseq]; RULE_ASSUM_TAC (REWRITE_RULE[subseq]); FIRST_ASSUM IMATCH_MP_TAC ; ARITH_TAC; DISCH_TAC; TYPE_THEN `p'` EXISTS_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); REP_BASIC_TAC; TYPEL_THEN [`x`;`p (ss (SUC n' +| SUC n))`;`p'`] (USE 4 o ISPECL); REP_BASIC_TAC; TYPE_THEN `X x /\ X (p (ss (SUC n' +| SUC n))) /\ X p'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; REWR 4; REP_BASIC_TAC; TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC; REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double]; UND 4; UND 13; UND 27; UND 22; REWRITE_TAC[o_DEF]; REAL_ARITH_TAC; DISCH_TAC; RIGHT 25 "n" ; REP_BASIC_TAC; (* take subseq of p' *) TYPE_THEN `(?ss'. subseq ss' /\ converge (K',d) (p' o ss'))` SUBGOAL_TAC; IMATCH_MP_TAC convergent_subseq; ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); ASM_MESON_TAC[]; REWRITE_TAC[converge]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* now go in for the KILL. *) (* Show d x x' <= inf Y because d x x' < inf Y + eps *) (* [K] *) IMATCH_MP_TAC (REAL_ARITH `(?t. (t <= y) /\ (x <= t)) ==> (x <= y)`); TYPE_THEN `inf Y` EXISTS_TAC; CONJ_TAC; TYPE_THEN `(!y. Y y ==> inf Y <= y)` SUBGOAL_TAC; ASM_MESON_TAC[inf_LB]; DISCH_THEN IMATCH_MP_TAC ; EXPAND_TAC "Y"; REWRITE_TAC[]; TYPE_THEN `q` EXISTS_TAC; TYPE_THEN `q'` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBGOAL_TAC `!x y. (!e. (&0 (x < y + e)) ==> (x <= y)`; REP_GEN_TAC; DISCH_THEN (fun t -> MP_TAC (SPEC `x'' - y` t)); REAL_ARITH_TAC; DISCH_THEN IMATCH_MP_TAC ; REP_BASIC_TAC; KILL 15; KILL 14; KILL 17; KILL 16; KILL 18; KILL 19; KILL 20; KILL 21; KILL 2; KILL 3; KILL 0; KILL 1; KILL 8; KILL 29; KILL 30; (* GEN needed inequalities *) (* [L] *) TYPE_THEN `?n. (&1)* twopow(--: (&:n)) < e` SUBGOAL_TAC; ASM_MESON_TAC[twopow_eps;REAL_ARITH `&0 < &1`]; REDUCE_TAC; REP_BASIC_TAC; TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC; REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double]; REP_BASIC_TAC; TSPEC `twopow(--: (&:(SUC n)))` 26; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[twopow_pos]); TSPEC `SUC (n) + SUC n'` 2; USE 2(REWRITE_RULE[ARITH_RULE `a <=| b + SUC a`]); TSPEC `ss' (SUC n + SUC n')` 25; TYPE_THEN `twopow (--: (&:(ss' (SUC n +| SUC n')))) < twopow (--: (&:(SUC n)))` SUBGOAL_TAC; IMATCH_MP_TAC twopow_lt; REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT ]; IMATCH_MP_TAC (ARITH_RULE `(?t. (a <=| t /\ (t <| b))) ==> (a <| b)`); TYPE_THEN `(ss' (SUC n) )` EXISTS_TAC; ASM_SIMP_TAC[SEQ_SUBLE]; RULE_ASSUM_TAC (REWRITE_RULE[subseq]); FIRST_ASSUM IMATCH_MP_TAC ; ARITH_TAC; DISCH_TAC; REP_BASIC_TAC; (* metric space ineq *) TYPE_THEN `X x /\ X x' /\ X (p' (ss' (SUC n +| SUC n')))` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[o_DEF]); TYPE_THEN `r = p' (ss' (SUC n +| SUC n'))` ABBREV_TAC ; TYPE_THEN `d x' r = d r x'` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_symm; ASM_MESON_TAC[]; TYPE_THEN `d x x' <= d x r + d r x'` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_triangle; ASM_MESON_TAC[]; UND 0; UND 1; UND 2; UND 3; UND 8; REAL_ARITH_TAC; (* Fri Aug 6 11:54:33 EDT 2004 *) ]);; (* }}} *) let max_real_le = prove_by_refinement( `!x y. x <= max_real x y /\ y <= max_real x y `, (* {{{ proof *) [ REWRITE_TAC[max_real]; REP_GEN_TAC; COND_CASES_TAC; UND 0; REAL_ARITH_TAC; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let min_real_le = prove_by_refinement( `!x y. min_real x y <= x /\ min_real x y <= y`, (* {{{ proof *) [ REWRITE_TAC[min_real]; REP_GEN_TAC; COND_CASES_TAC; UND 0; REAL_ARITH_TAC; UND 0; REAL_ARITH_TAC; ]);; (* }}} *) let finite_UB = prove_by_refinement( `!X. (FINITE X) ==> (?t. (!x. X x ==> x <=. t))`, (* {{{ proof *) [ TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> x <= t))` SUBGOAL_TAC; INDUCT_TAC ; REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;]; MESON_TAC[]; REWRITE_TAC[HAS_SIZE_SUC]; REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; TSPEC `X DELETE u` 0; TYPE_THEN `(?t. !x. (X DELETE u) x ==> x <= t)` SUBGOAL_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `max_real t u` EXISTS_TAC; GEN_TAC; DISCH_TAC; TYPE_THEN `x = u` ASM_CASES_TAC; ASM_MESON_TAC[max_real_le]; TSPEC `x` 3; RULE_ASSUM_TAC (REWRITE_RULE[DELETE]); ASM_MESON_TAC[max_real_le;REAL_LE_TRANS]; REWRITE_TAC[HAS_SIZE]; ASM_MESON_TAC[]; (* Fri Aug 6 12:50:04 EDT 2004 *) ]);; (* }}} *) let finite_LB = prove_by_refinement( `!X. (FINITE X) ==> (?t. (!x. X x ==> t <=. x))`, (* {{{ proof *) [ TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> t <= x))` SUBGOAL_TAC; INDUCT_TAC ; REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;]; MESON_TAC[]; REWRITE_TAC[HAS_SIZE_SUC]; REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; TSPEC `X DELETE u` 0; TYPE_THEN `(?t. !x. (X DELETE u) x ==> t <= x)` SUBGOAL_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `min_real t u` EXISTS_TAC; GEN_TAC; DISCH_TAC; TYPE_THEN `x = u` ASM_CASES_TAC; ASM_MESON_TAC[min_real_le]; TSPEC `x` 3; RULE_ASSUM_TAC (REWRITE_RULE[DELETE]); ASM_MESON_TAC[min_real_le;REAL_LE_TRANS]; REWRITE_TAC[HAS_SIZE]; ASM_MESON_TAC[]; ]);; (* }}} *) let finite_compact = prove_by_refinement( `!(X:A->bool) U. (FINITE X) /\ (X SUBSET UNIONS U) ==> (compact U X)`, (* {{{ proof *) [ TYPE_THEN `!n (X:A->bool) U. (X HAS_SIZE n) /\ (X SUBSET UNIONS U) ==> (compact U X)` SUBGOAL_TAC; INDUCT_TAC; REWRITE_TAC[HAS_SIZE_0]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[compact]; REP_BASIC_TAC; TYPE_THEN `EMPTY:(A->bool)->bool` EXISTS_TAC; REWRITE_TAC[FINITE_RULES]; REWRITE_TAC[HAS_SIZE_SUC;EMPTY_EXISTS;compact ;]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `X DELETE u HAS_SIZE n` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPEL_THEN [`X DELETE u`;`U`] (USE 0 o ISPECL); REP_BASIC_TAC; REWR 0; TYPE_THEN `X DELETE u SUBSET UNIONS U` SUBGOAL_TAC; UND 1; REWRITE_TAC[SUBSET;DELETE]; MESON_TAC[]; DISCH_TAC; REWR 0; RULE_ASSUM_TAC (REWRITE_RULE[compact]); REP_BASIC_TAC; TSPEC `V` 0; REWR 0; TYPE_THEN `X DELETE u SUBSET UNIONS V` SUBGOAL_TAC; UND 6; REWRITE_TAC[SUBSET;DELETE]; MESON_TAC[]; DISCH_TAC; REWR 0; REP_BASIC_TAC; USE 6 (REWRITE_RULE[SUBSET;UNIONS]); TSPEC `u` 6; REWR 6; REP_BASIC_TAC; TYPE_THEN `u' INSERT W` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[INSERT_SUBSET]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[FINITE_INSERT]; REWRITE_TAC[UNIONS_INSERT]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `u' UNION (X DELETE u)` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;DELETE;UNION]; ASM_MESON_TAC[]; UND 0; REWRITE_TAC[UNION;SUBSET]; MESON_TAC[]; REWRITE_TAC[HAS_SIZE]; MESON_TAC[]; ]);; (* }}} *) let compact_supm = prove_by_refinement( `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==> X (supm X)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?x. X x /\ (!y. X y ==> y <= x))` SUBGOAL_TAC; IMATCH_MP_TAC compact_sup; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(!x. X x ==> x <= supm X ) /\ (!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC; IMATCH_MP_TAC supm_UB; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `x = supm X` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `x <= supm X /\ supm X <= x ==> (x = supm X)`); TSPEC `x` 4; REWR 4; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let compact_infm = prove_by_refinement( `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==> X (inf X)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?x. X x /\ (!y. X y ==> x <= y))` SUBGOAL_TAC; IMATCH_MP_TAC compact_inf; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(!x. X x ==> inf X <= x ) /\ (!y. (!x. X x ==> y <= x) ==> ( y <= inf X))` SUBGOAL_TAC; IMATCH_MP_TAC inf_LB; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `x = inf X` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `x <= inf X /\ inf X <= x ==> (x = inf X)`); TSPEC `x` 4; REWR 4; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* Fri Aug 6 13:45:50 EDT 2004 *) ]);; (* }}} *) let finite_supm = prove_by_refinement( `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (supm X)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC compact_supm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC finite_compact; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;]; ]);; (* }}} *) let finite_inf = prove_by_refinement( `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (inf X)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC compact_infm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC finite_compact; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;]; (* Fri Aug 6 13:49:38 EDT 2004 *) ]);; (* }}} *) let finite_supm_max = prove_by_refinement( `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> x <= supm X)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?t. !x. (X x ==> x <= t))` SUBGOAL_TAC; ASM_MESON_TAC[finite_UB]; ASM_MESON_TAC[supm_UB]; ]);; (* }}} *) let finite_inf_min = prove_by_refinement( `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> inf X <= x)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?t. !x. (X x ==> t <= x))` SUBGOAL_TAC; ASM_MESON_TAC[finite_LB]; ASM_MESON_TAC[inf_LB]; ]);; (* }}} *) let bij_inj_image = prove_by_refinement( `!(f:A->B) X Y. (INJ f X Y /\ Y SUBSET IMAGE f X) ==> (BIJ f X Y)`, (* {{{ proof *) [ REWRITE_TAC[INJ;BIJ;SURJ;SUBSET;IMAGE]; MESON_TAC[]; ]);; (* }}} *) let suc_interval = prove_by_refinement( `!n. {x | x <| SUC n} = {x | x <| n} UNION {n}`, (* {{{ proof *) [ GEN_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[UNION;INR IN_SING;]; ARITH_TAC; ]);; (* }}} *) let inj_domain_sub = prove_by_refinement( `!(f:A->B) g X Y. (!x. (X x ==> (f x = g x))) ==> (INJ f X Y = INJ g X Y)`, (* {{{ proof *) [ REWRITE_TAC[INJ]; MESON_TAC[]; ]);; (* }}} *) let image_domain_sub = prove_by_refinement( `!(f:A->B) g X . (!x. (X x ==> (f x = g x))) ==> (IMAGE f X = IMAGE g X)`, (* {{{ proof *) [ REWRITE_TAC[IMAGE]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let real_finite_increase = prove_by_refinement( `!X. ( (FINITE X) ==> (? u. (BIJ u {x | x <| CARD X} X) /\ (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==> (u i <. u j)))))`, (* {{{ proof *) [ TYPE_THEN `!n X. ( (X HAS_SIZE n) ==> (? u. (BIJ u {x | x <| CARD X} X) /\ (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==> (u i <. u j)))))` SUBGOAL_TAC; INDUCT_TAC; REWRITE_TAC[HAS_SIZE_0]; REP_BASIC_TAC; ASM_REWRITE_TAC[CARD_CLAUSES;BIJ;INJ;SURJ]; REWRITE_TAC[ARITH_RULE `~(j <| 0)`]; REP_BASIC_TAC; COPY 1; UND 1; REWRITE_TAC[HAS_SIZE_SUC;]; REP_BASIC_TAC; TYPE_THEN `X (supm X)` SUBGOAL_TAC; IMATCH_MP_TAC finite_supm; ASM_REWRITE_TAC[]; KILL 0; USE 3(REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; TSPEC `u` 1; ASM_MESON_TAC[FINITE_DELETE;HAS_SIZE;]; DISCH_TAC; TSPEC `supm X` 1; REWR 1; TSPEC `X DELETE supm X` 0; REWR 0; REP_BASIC_TAC; TYPE_THEN `v = (\j. if (j = n) then supm X else u j)` ABBREV_TAC ; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `CARD (X DELETE supm X) = n` SUBGOAL_TAC; ASM_MESON_TAC[HAS_SIZE]; DISCH_TAC; (* [th] *) TYPE_THEN `!x. ({x | x <| n} x ==> (v x = u x))` SUBGOAL_TAC; REWRITE_TAC[]; EXPAND_TAC "v"; GEN_TAC; COND_CASES_TAC; ASM_REWRITE_TAC[ARITH_RULE `~(n <| n)`]; REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `INJ v {x | x <| n} X = INJ u {x | x <| n} X` SUBGOAL_TAC; IMATCH_MP_TAC inj_domain_sub; UND 8; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `v n = supm X` SUBGOAL_TAC; EXPAND_TAC "v"; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `IMAGE v {x | x <| n} = IMAGE u {x | x <| n}` SUBGOAL_TAC; IMATCH_MP_TAC image_domain_sub; UND 8; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `IMAGE v {x | x <| n} = X DELETE supm X` SUBGOAL_TAC; ASM_REWRITE_TAC[]; UND 5; ASM_REWRITE_TAC[]; REWRITE_TAC[BIJ]; alpha_tac; MESON_TAC[SURJ_IMAGE]; DISCH_TAC; (* obligations *) CONJ_TAC; IMATCH_MP_TAC bij_inj_image; CONJ_TAC; TYPE_THEN `{x | x <| CARD X} = {x | x <| n} UNION {n}` SUBGOAL_TAC; USE 2(REWRITE_RULE[HAS_SIZE]); ASM_REWRITE_TAC[]; REWRITE_TAC[suc_interval]; DISCH_THEN_REWRITE; IMATCH_MP_TAC inj_split; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;DELETE]); REP_BASIC_TAC; ASM_REWRITE_TAC[]; UND 13; ASM_REWRITE_TAC[]; REWRITE_TAC[INJ;SUBSET]; MESON_TAC[]; CONJ_TAC; REWRITE_TAC[INJ;SUBSET;INR IN_SING]; ASM_MESON_TAC[]; REWRITE_TAC[EQ_EMPTY;INTER;image_sing;INR IN_SING;]; KILL 11; ASM_REWRITE_TAC[DELETE;SUBSET;]; MESON_TAC[]; TYPE_THEN `X = supm X INSERT (X DELETE supm X)` SUBGOAL_TAC; ASM_SIMP_TAC[INR INSERT_DELETE]; USE 2 (REWRITE_RULE[HAS_SIZE]); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); REWRITE_TAC[INSERT_SUBSET]; KILL 11; CONJ_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `n` EXISTS_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `IMAGE v {x| x <| n}` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL]; USE 12 GSYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; ARITH_TAC; REP_GEN_TAC; (* monotonicity [m] *) USE 2 (REWRITE_RULE[HAS_SIZE]); ASM_REWRITE_TAC[]; TYPE_THEN `(!x. X x ==> x <= supm X)` SUBGOAL_TAC; ASM_MESON_TAC[finite_supm_max]; DISCH_TAC; TYPE_THEN `j = n` ASM_CASES_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `(v:num->real) i`)); REWRITE_TAC[IMAGE;DELETE;]; TSPEC `(v i)` 13; UND 13; MESON_TAC[REAL_ARITH `a < b <=> (a<= b /\ ~(a = b))`]; KILL 3; KILL 4; KILL 5; REP_BASIC_TAC; TYPE_THEN `~(i = n)` SUBGOAL_TAC; UND 2; UND 3; ARITH_TAC; REWR 0; DISCH_TAC; TYPE_THEN `i <| n /\ j <| n` SUBGOAL_TAC; UND 3; UND 4; UND 14; UND 16; ARITH_TAC; REP_BASIC_TAC; REWR 8; ASM_SIMP_TAC[]; (* end *) REWRITE_TAC[HAS_SIZE]; REP_BASIC_TAC; RIGHT 1 "n" ; TSPEC `X` 1; TSPEC `CARD X` 1; alpha_tac; ASM_MESON_TAC[]; (* Fri Aug 6 19:51:16 EDT 2004 *) ]);; (* }}} *) let connected_nogap = prove_by_refinement( `!A a b. connected (top_of_metric(UNIV,d_real)) A /\ A a /\ A b ==> {x | a <= x /\ x <= b } SUBSET A`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(a = b) \/ (b < a) \/ (a < b)` SUBGOAL_TAC; REAL_ARITH_TAC; REP_CASES_TAC; ASM_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= b ==> (x = b)`]; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[REAL_ARITH `a <=x /\ x <= b ==> ~(b < a)`]; REWRITE_TAC[SUBSET]; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `a < x` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `(a <= x /\ ~(a = x)) ==> a < x`); ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `x < b` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `(x <= b /\ ~(b = x)) ==> x < b`); ASM_MESON_TAC[]; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[connected]); REP_BASIC_TAC; TYPEL_THEN [` {t | t < x}`;` {t | x < t}`] (USE 2 o SPECL); UND 2; REWRITE_TAC[half_open;half_open_above]; TYPE_THEN `({t | t < x} INTER {t | x < t} = {}) /\ A SUBSET {t | t < x} UNION {t | x < t}` SUBGOAL_TAC; REWRITE_TAC[INTER;EQ_EMPTY;UNION;SUBSET;]; REWRITE_TAC[REAL_ARITH `x' < x \/ x < x' <=> ~(x' = x)`]; CONJ_TAC; REAL_ARITH_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[SUBSET;]; ASM_MESON_TAC[REAL_ARITH `x < b ==> ~(b < x)`]; (* Fri Aug 6 20:24:45 EDT 2004 *) ]);; (* }}} *) let connected_open = prove_by_refinement( `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\ (top_of_metric(UNIV,d_real) A) /\ (~(A = EMPTY)) /\ A SUBSET {x | a <= x /\ x <= b}) ==> ( A = {x | inf A < x /\ x < supm A})`, (* {{{ proof *) [ REWRITE_TAC[SUBSET]; REP_BASIC_TAC; TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ supm A - epsilon < x))` SUBGOAL_TAC; IMATCH_MP_TAC supm_eps; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ x < inf A + epsilon))` SUBGOAL_TAC; IMATCH_MP_TAC inf_eps; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(!x. A x ==> x <= supm A)` SUBGOAL_TAC; ASM_MESON_TAC[supm_UB]; DISCH_TAC; TYPE_THEN `(!x. A x ==> inf A <= x)` SUBGOAL_TAC; ASM_MESON_TAC[inf_LB]; DISCH_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; TYPE_THEN `!x. (A x ==> ?e. &0 < e /\ open_ball(UNIV,d_real) x e SUBSET A)` SUBGOAL_TAC; UND 2; MP_TAC metric_real; MESON_TAC[open_ball_nbd]; REWRITE_TAC[open_ball;d_real]; DISCH_TAC; (* *) TYPE_THEN `!x. A x ==> (?y. A y /\ ~(x <= y))` SUBGOAL_TAC; REP_BASIC_TAC; TSPEC `x` 8; REWR 8; REP_BASIC_TAC; USE 8(REWRITE_RULE[SUBSET]); TYPE_THEN `x - e/(&2)` EXISTS_TAC; REWRITE_TAC[REAL_ARITH `~(x <= x - e/(&2)) <=> (&0 < e/(&2))`]; ASM_REWRITE_TAC[REAL_LT_HALF1]; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[REAL_ARITH `(x - (x - t)) = t`]; TYPE_THEN `abs (e/(&2)) = (e/(&2))` SUBGOAL_TAC; REWRITE_TAC[REAL_ABS_REFL]; IMATCH_MP_TAC (REAL_ARITH `(a < b) ==> (a <= b)`); ASM_REWRITE_TAC[REAL_LT_HALF1]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[REAL_LT_HALF2]; DISCH_TAC; (* *) TYPE_THEN `!x. A x ==> (?y. A y /\ ~(y <= x))` SUBGOAL_TAC; REP_BASIC_TAC; TSPEC `x` 8; REWR 8; REP_BASIC_TAC; USE 8(REWRITE_RULE[SUBSET]); TYPE_THEN `x + e/(&2)` EXISTS_TAC; REWRITE_TAC[REAL_ARITH `~( x + e/(&2) <= x) <=> (&0 < e/(&2))`]; ASM_REWRITE_TAC[REAL_LT_HALF1]; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[REAL_ARITH `(x - (x + t)) = --. t`]; TYPE_THEN `abs (--. (e/(&2))) = (e/(&2))` SUBGOAL_TAC; REWRITE_TAC[REAL_ABS_REFL;ABS_NEG;]; IMATCH_MP_TAC (REAL_ARITH `(a < b) ==> (a <= b)`); ASM_REWRITE_TAC[REAL_LT_HALF1]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[REAL_LT_HALF2]; DISCH_TAC; (* FIRST direction *) CONJ_TAC; REWRITE_TAC[SUBSET]; REP_BASIC_TAC; REWRITE_TAC[REAL_ARITH `u < v <=> (u <= v /\ ~(u = v))`]; CONJ_TAC; CONJ_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; CONJ_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* 2 *) REWRITE_TAC[SUBSET]; REP_BASIC_TAC; TYPE_THEN `?a'. A a' /\ (a' < x)` SUBGOAL_TAC; TSPEC `x - inf A` 5; USE 5 (REWRITE_RULE[REAL_ARITH `&0 < x - y <=> (y < x)`;REAL_ARITH `t + x - t = x`]); REWR 5; DISCH_TAC; TSPEC `supm A - x` 4; USE 4(REWRITE_RULE[REAL_ARITH `&0 < y - x <=> (x < y)`;REAL_ARITH `t - (t -x) = x`]); REWR 4; REP_BASIC_TAC; TYPE_THEN `{t | a' <= t /\ t <= x'} SUBSET A` SUBGOAL_TAC; IMATCH_MP_TAC connected_nogap; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_TAC; TSPEC `x` 16; FIRST_ASSUM IMATCH_MP_TAC ; UND 4; UND 14; REAL_ARITH_TAC; (* Fri Aug 6 21:34:56 EDT 2004 *) ]);; (* }}} *) let closure_real_set = prove_by_refinement( `!Z a. (closure(top_of_metric(UNIV,d_real)) Z a <=> (!e. (&0 < e) ==> (?z. Z z /\ (abs (a - z) <= e))))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `metric_space (UNIV,d_real) /\ Z SUBSET UNIV` SUBGOAL_TAC; REWRITE_TAC[metric_real;SUBSET_UNIV]; DISCH_THEN (fun t -> MP_TAC (MATCH_MP closure_open_ball t)); DISCH_THEN (fun t -> MP_TAC (AP_THM t `a:real`)); REWRITE_TAC[]; DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]); REWRITE_TAC[open_ball;d_real;]; EQ_TAC; ASM_MESON_TAC[REAL_ARITH `a < b ==> a <= b`]; REP_BASIC_TAC; TSPEC `r/(&2)` 1; RULE_ASSUM_TAC (REWRITE_RULE[REAL_LT_HALF1]); REWR 1; REP_BASIC_TAC; TYPE_THEN `z` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `(a <= b/(&2)) /\ (b/(&2) < b) ==> (a < b)`); ASM_REWRITE_TAC[]; ASM_MESON_TAC[half_pos]; (* Sat Aug 7 08:14:28 EDT 2004 *) ]);; (* }}} *) let real_div_assoc = prove_by_refinement( `!a b c. (a*b)/c = a*(b/c)`, (* {{{ proof *) [ REWRITE_TAC[real_div;REAL_MUL_AC;]; ]);; (* }}} *) let real_middle1_lt = prove_by_refinement( `!a b. (a < b) ==> a < (a + b)/(&2) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(&2*a)/(&2) < (a+b)/(&2)` SUBGOAL_TAC; ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`]; REWRITE_TAC[REAL_MUL_2]; UND 0; REAL_ARITH_TAC; REWRITE_TAC[real_div_assoc]; ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`]; ]);; (* }}} *) let real_middle2_lt = prove_by_refinement( `!a b. (a < b) ==> (a + b)/(&2) < b `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN ` (a+b)/(&2) < (&2*b)/(&2)` SUBGOAL_TAC; ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`]; REWRITE_TAC[REAL_MUL_2]; UND 0; REAL_ARITH_TAC; REWRITE_TAC[real_div_assoc]; ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`]; ]);; (* }}} *) let real_sub_half = prove_by_refinement( `!a b. (a - (a + b)/(&2) = (a - b)/(&2))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `((&2*a)/(&2) - (a+b)/(&2) = (a - b)/(&2))` SUBGOAL_TAC; REWRITE_TAC[real_div;GSYM REAL_SUB_RDISTRIB]; REWRITE_TAC[REAL_EQ_RMUL_IMP]; AP_THM_TAC; AP_TERM_TAC; REWRITE_TAC[REAL_MUL_2]; REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_ARITH `~(&2 = &0)`;REAL_DIV_LMUL;real_div_assoc]; ]);; (* }}} *) let closure_open_interval = prove_by_refinement( `!a b. (a < b) ==> (closure (top_of_metric(UNIV,d_real)) {x | a < x /\ x < b} = {x | a <= x /\ x <= b}) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC closure_subset; ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real]; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; (* 2 *) TYPE_THEN `{x | a <= x /\ x <= b} = a INSERT (b INSERT {x | a < x /\ x < b})` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INSERT]; GEN_TAC; UND 0; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[INSERT_SUBSET]; ASM_SIMP_TAC[top_of_metric_top;metric_real;subset_closure;]; (* USE closure_real_set *) REWRITE_TAC[closure_real_set]; TYPE_THEN `!e. (&0 < e) ==> (a + e < b) \/ ((b - a)/(&2) < e)` SUBGOAL_TAC; REP_BASIC_TAC; ASM_CASES_TAC `(a + e < b)`; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `(x <= y/(&2) /\ y/(&2) < y) ==> (x < y)`); ASM_SIMP_TAC [half_pos]; ASM_SIMP_TAC[REAL_LE_DIV2_EQ;REAL_ARITH `&0 < &2`]; UND 2; REAL_ARITH_TAC; DISCH_ALL_TAC; (* 1 *) CONJ_TAC; REP_BASIC_TAC; TSPEC `e` 1; REWR 1; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `a + e` EXISTS_TAC; REWRITE_TAC[REAL_ARITH `(a < a + e <=> &0 < e) /\ (a - (a + e) = --. e)`]; ASM_REWRITE_TAC[ABS_NEG;]; IMATCH_MP_TAC (REAL_ARITH `(x = y) ==> (x <= y)`); REWRITE_TAC[REAL_ABS_REFL]; UND 2; REAL_ARITH_TAC; (* 2 *) REP_BASIC_TAC; TYPE_THEN `(a + b)/(&2)` EXISTS_TAC; ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half]; UND 3; UND 0; REWRITE_TAC[real_div;ABS_MUL]; ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(a - b) = (b-a))`]; TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC; REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REAL_ARITH_TAC; (* 3 *) REP_BASIC_TAC; TSPEC `e` 1; REWR 1; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `b - e` EXISTS_TAC; REWRITE_TAC[REAL_ARITH `(b - e < b <=> &0 < e) /\ (b - (b - e) = e)`]; REWRITE_TAC[REAL_ARITH `(a < b - e) <=> (a + e < b)`]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `(x = y) ==> (x <= y)`); REWRITE_TAC[REAL_ABS_REFL]; UND 2; REAL_ARITH_TAC; (* 4 *) REP_BASIC_TAC; TYPE_THEN `(b + a)/(&2)` EXISTS_TAC; ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half]; ONCE_REWRITE_TAC [REAL_ARITH `(a + b) = (b + a)`]; ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half]; UND 3; UND 0; REWRITE_TAC[real_div;ABS_MUL]; ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(b - a) = (b-a))`]; TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC; REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REAL_ARITH_TAC; (* Sat Aug 7 09:45:29 EDT 2004 *) ]);; (* }}} *) let interval_subset = prove_by_refinement( `!a b c d. {x | a <= x /\ x <= b} SUBSET {x | c <= x /\ x <= d} <=> (b < a) \/ ((c <= a ) /\ (b <= d))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET ]; REP_BASIC_TAC; ASM_CASES_TAC `b < a` ; ASM_REWRITE_TAC[]; UND 0; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; EQ_TAC; REP_BASIC_TAC; TYPE_THEN `a` (WITH 1 o SPEC); TYPE_THEN `b` (USE 1 o SPEC); UND 0; UND 1; UND 2; REAL_ARITH_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let subset_antisym_eq = prove_by_refinement( `!(A:A->bool) B. (A = B) <=> (A SUBSET B /\ B SUBSET A) `, (* {{{ proof *) [ REWRITE_TAC[SUBSET;FUN_EQ_THM ]; MESON_TAC[]; ]);; (* }}} *) let interval_eq = prove_by_refinement( (**** Parens added by JRH for real right associativity of = `!a b c d. {x | a <= x /\ x <= b} = {x | c <= x /\ x <= d} = ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`, ****) `!a b c d. ({x | a <= x /\ x <= b} = {x | c <= x /\ x <= d}) <=> ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`, (* {{{ proof *) [ REWRITE_TAC[subset_antisym_eq;interval_subset;]; REAL_ARITH_TAC; ]);; (* }}} *) let connected_open_closure = prove_by_refinement( `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\ (top_of_metric(UNIV,d_real) A) /\ (closure (top_of_metric(UNIV,d_real)) A = {x | a <= x /\ x <= b}) ==> (A = { x | a < x /\ x < b }))`, (* {{{ proof *) [ REP_BASIC_TAC; (* deal WITH emptyset *) TYPE_THEN `A = EMPTY` ASM_CASES_TAC; REWR 0; UND 0; ASM_SIMP_TAC[top_of_metric_top;metric_real;closure_empty;]; DISCH_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; GEN_TAC; FIRST_ASSUM (fun t -> MP_TAC (AP_THM t `x:real`)); REWRITE_TAC[]; REAL_ARITH_TAC; (* deal WITH containment *) TYPE_THEN `A SUBSET {x | a <= x /\ x <= b}` SUBGOAL_TAC; USE 0 SYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_closure; ASM_SIMP_TAC[top_of_metric_top;metric_real]; DISCH_TAC; (* quote previous result *) TYPE_THEN `( A = {x | inf A < x /\ x < supm A})` SUBGOAL_TAC; IMATCH_MP_TAC connected_open; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (* now USE the closure of an open interval is the closed interval *) PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; UND 3; REWRITE_TAC[]; ASM ONCE_REWRITE_TAC []; REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `inf A < supm A` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; DISCH_TAC; USE 7(MATCH_MP closure_open_interval); UND 6; UND 0; REWRITE_TAC[]; ASM ONCE_REWRITE_TAC[]; ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; USE 0(REWRITE_RULE[interval_eq]); FIRST_ASSUM DISJ_CASES_TAC; UND 8; UND 3; UND 6; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; (* Sat Aug 7 10:38:12 EDT 2004 *) ]);; (* }}} *) (* Sat Aug 7 11:01:27 EDT 2004 *) let closed_ball_empty = prove_by_refinement( `!n a r. (r < &0) ==> (closed_ball(euclid n,d_euclid) a r = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[closed_ball;EQ_EMPTY;]; ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> ~(r < &0)`]; ]);; (* }}} *) let closed_ball_pt = prove_by_refinement( `!n a. (closed_ball(euclid n,d_euclid) a (&0) SUBSET {a})`, (* {{{ proof *) [ REWRITE_TAC[closed_ball;SUBSET;INR IN_SING;]; ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;REAL_ARITH `(x <= &0 /\ &0 <= x) ==> (x = &0)`]; ]);; (* }}} *) let closed_ball_subset_open = prove_by_refinement( `!n a r. ?r'. closed_ball(euclid n,d_euclid) a r SUBSET open_ball(euclid n,d_euclid) a r'`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[closed_ball;open_ball;SUBSET ]; TYPE_THEN `r + &1` EXISTS_TAC; MESON_TAC[ REAL_ARITH `(u <= r) ==> (u < r + &1)`]; ]);; (* }}} *) let closed_ball_compact = prove_by_refinement( `!n a r. (compact (top_of_metric(euclid n,d_euclid)) (closed_ball(euclid n,d_euclid) a r)) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `closed_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC; REWRITE_TAC[closed_ball;SUBSET]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `open_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC; REWRITE_TAC[open_ball;SUBSET]; MESON_TAC[]; DISCH_TAC; ASM_SIMP_TAC[compact_euclid;closed_ball_closed;metric_euclid;]; REWRITE_TAC[metric_bounded]; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `r + &1`EXISTS_TAC; REWRITE_TAC[open_ball;SUBSET;]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; UND 2; REWRITE_TAC[closed_ball]; REP_BASIC_TAC; TYPE_THEN `d_euclid a a = &0` SUBGOAL_TAC; ASM_MESON_TAC[d_euclid_zero]; DISCH_THEN_REWRITE; ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> &0 <= r`;REAL_ARITH `u <= r ==> (u < r + &1)`]; (* Sat Aug 7 12:15:05 EDT 2004 *) ]);; (* }}} *) let set_dist = jordan_def `set_dist d (K:A->bool) (K':B->bool) = inf { z | (?p p'. (K p /\ K' p' /\ (z = d p p')))}`;; let set_dist_inf = prove_by_refinement( `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ (K' SUBSET X) ==> (!p p'. (K p /\ K' p' ==> (set_dist d K K' <= d p p')))`, (* {{{ proof *) [ REWRITE_TAC[set_dist]; REP_BASIC_TAC; TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ; TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC; GEN_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `Y (d p p')` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC; CONJ_TAC; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `d p p'` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_THEN (ASSUME_TAC o (MATCH_MP inf_LB)); ASM_MESON_TAC[]; ]);; (* }}} *) let set_dist_nn = prove_by_refinement( `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ ~(K = EMPTY) /\ ~(K' = EMPTY) /\ (K' SUBSET X) ==> (&0 <= set_dist d K K')`, (* {{{ proof *) [ REWRITE_TAC[set_dist]; REP_BASIC_TAC; TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ; TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC; REP_BASIC_TAC; UND 6; EXPAND_TAC "Y"; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `~(Y = {})` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS]; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; TYPE_THEN `d u' u` EXISTS_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN (ASSUME_TAC o (MATCH_MP inf_LB)); ASM_MESON_TAC[]; ]);; (* }}} *) let set_dist_eq = prove_by_refinement( `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ ~(K = EMPTY) /\ ~(K' = EMPTY) /\ (compact (top_of_metric(X,d)) K) /\ (compact (top_of_metric (X,d)) K') /\ (K' SUBSET X) ==> (?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))`, (* {{{ proof *) [ REWRITE_TAC[set_dist]; REP_BASIC_TAC; TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ; TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC; REP_BASIC_TAC; UND 8; EXPAND_TAC "Y"; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); ASM_MESON_TAC[ISUBSET]; DISCH_TAC; TYPE_THEN `~(Y = {})` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS]; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; TYPE_THEN `d u' u` EXISTS_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN (ASSUME_TAC o (MATCH_MP inf_LB)); TYPE_THEN `(?p p'. K p /\ K' p' /\ (!q q'. K q /\ K' q' ==> d p p' <= d q q'))` SUBGOAL_TAC; IMATCH_MP_TAC compact_distance; TYPE_THEN `X` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `p` EXISTS_TAC; TYPE_THEN `p'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* 1 *) TYPE_THEN `Y (d p p')` SUBGOAL_TAC; EXPAND_TAC "Y"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; IMATCH_MP_TAC (REAL_ARITH `a <= b /\ b <= a ==> (a = b)`); CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; EXPAND_TAC "Y"; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Sat Aug 7 13:19:01 EDT 2004 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION L *) (* ------------------------------------------------------------------ *) let simple_arc_compact = prove_by_refinement( `!C. simple_arc top2 C ==> compact top2 C`, (* {{{ proof *) [ REWRITE_TAC[simple_arc]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC image_compact; TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[inj_image_subset;interval_compact;]; (* Sat Aug 7 12:24:22 EDT 2004 *) ]);; (* }}} *) let simple_arc_nonempty = prove_by_refinement( `!C. simple_arc top2 C ==> ~(C = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[simple_arc;EMPTY_EXISTS;]; REP_BASIC_TAC; ASM_REWRITE_TAC[IMAGE;]; TYPE_THEN `f (&0)` EXISTS_TAC; TYPE_THEN `&0` EXISTS_TAC; REWRITE_TAC[]; REAL_ARITH_TAC; ]);; (* }}} *) let graph_edge_compact = prove_by_refinement( `!G e. (plane_graph G) /\ (graph_edge G e) ==> (compact top2 e)`, (* {{{ proof *) [ REWRITE_TAC [plane_graph]; REP_BASIC_TAC; USE 3 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[simple_arc_compact]; ]);; (* }}} *) let graph_vertex_exist = prove_by_refinement( `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==> (?v. graph_vertex G v)`, (* {{{ proof *) [ REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC; ASM_SIMP_TAC[graph_inc_subset]; DISCH_TAC; TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC; ASM_SIMP_TAC[graph_edge2;]; REWRITE_TAC[has_size2]; REP_BASIC_TAC; REWR 2; UND 2; REWRITE_TAC[SUBSET ;INR in_pair ]; MESON_TAC[]; ]);; (* }}} *) let graph_vertex_2 = prove_by_refinement( `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==> (?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))`, (* {{{ proof *) [ REWRITE_TAC[EMPTY_EXISTS]; REP_BASIC_TAC; TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC; ASM_SIMP_TAC[graph_inc_subset]; DISCH_TAC; TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC; ASM_SIMP_TAC[graph_edge2;]; REWRITE_TAC[has_size2]; REP_BASIC_TAC; REWR 2; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC ; UND 2; REWRITE_TAC[SUBSET ;INR in_pair ]; ASM_MESON_TAC[]; ]);; (* }}} *) let graph_disk_lemma1 = prove_by_refinement( `!G. plane_graph G /\ FINITE (graph_vertex G) /\ FINITE (graph_edge G) ==> FINITE {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) /\ (z = (e,v)))}`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `Y = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) /\ (z = (e,v)))}` ABBREV_TAC ; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{(e,v) | graph_edge G e /\ graph_vertex G v}` EXISTS_TAC; TYPEL_THEN [`graph_edge G `;`graph_vertex G `] (fun t -> ASSUME_TAC (ISPECL t FINITE_PRODUCT)); REWR 4; ASM_REWRITE_TAC[]; EXPAND_TAC "Y"; REWRITE_TAC[SUBSET]; MESON_TAC[]; (* Sat Aug 7 14:21:19 EDT 2004 *) ]);; (* }}} *) let image_empty = prove_by_refinement( `!(A:A->bool) (f:A->B). (IMAGE f A = EMPTY) <=> (A = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[IMAGE;FUN_EQ_THM;]; MESON_TAC[]; ]);; (* }}} *) (* not used *) let pair_apply = prove_by_refinement( `!P. (!x. P x) <=> ! (u:A) (v:B) . P (u,v)`, (* {{{ proof *) [ REP_BASIC_TAC; EQ_TAC; REP_BASIC_TAC; TSPEC `(u,v)` 0; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPEL_THEN [`FST x`;`SND x`] (USE 0 o ISPECL); USE 0(REWRITE_RULE[]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let set_dist_pos = prove_by_refinement( `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ ~(K = EMPTY) /\ ~(K' = EMPTY) /\ (compact (top_of_metric(X,d)) K) /\ (compact (top_of_metric (X,d)) K') /\ (K INTER K' = EMPTY) /\ (K' SUBSET X) ==> (&0 < (set_dist d K K' ))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC (REAL_ARITH `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`); CONJ_TAC; TYPE_THEN `(?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))` SUBGOAL_TAC; IMATCH_MP_TAC set_dist_eq; TYPE_THEN `X` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `p = p'` SUBGOAL_TAC; REWR 9; TYPE_THEN `X p /\ X p'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; USE 9 SYM; REP_BASIC_TAC; UND 9; ASM_MESON_TAC [metric_space_zero2]; UND 1; UND 10; UND 11; REWRITE_TAC[EQ_EMPTY;INTER;]; MESON_TAC[]; IMATCH_MP_TAC set_dist_nn; TYPE_THEN `X` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let closed_ball_inter = prove_by_refinement( `!(x:A) y r r' X d. (metric_space(X,d) /\ ~(closed_ball(X,d) x r INTER closed_ball(X,d) y r' = EMPTY) ==> (d x y <= r + r'))`, (* {{{ proof *) [ REWRITE_TAC[closed_ball;EMPTY_EXISTS;INTER]; REP_BASIC_TAC; TYPE_THEN `d x y <= d x u + d u y` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_triangle; ASM_MESON_TAC[]; TYPE_THEN `d u y = d y u` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_symm; ASM_MESON_TAC[]; UND 0; UND 3; REAL_ARITH_TAC; ]);; (* }}} *) let graph_disk = prove_by_refinement( `!G. plane_graph G /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = EMPTY) ==> (?r. (&0 < r ) /\ (!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (closed_ball (euclid 2,d_euclid) v r INTER closed_ball (euclid 2,d_euclid) v' r = EMPTY)) /\ (!e v. (graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) ==> (e INTER closed_ball (euclid 2,d_euclid) v r = EMPTY) )))`, (* {{{ proof *) [ REP_BASIC_TAC; (* A' *) TYPE_THEN `A = { (v,v') | (graph_vertex G v) /\ graph_vertex G v' /\ ~(v = v') }` ABBREV_TAC ; TYPE_THEN `FINITE A` SUBGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{ (v,v') | (graph_vertex G v) /\ graph_vertex G v'}` EXISTS_TAC; TYPEL_THEN [`graph_vertex G`;`graph_vertex G`] (fun t-> ASSUME_TAC (ISPECL t FINITE_PRODUCT)); REWR 5; ASM_REWRITE_TAC[]; EXPAND_TAC "A"; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `A' = IMAGE (\ (v,v'). (d_euclid v v')/(&2)) A` ABBREV_TAC ; TYPE_THEN `FINITE A'` SUBGOAL_TAC; EXPAND_TAC "A'"; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; (* [B] *) TYPE_THEN `B = { (e,v) | graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) }` ABBREV_TAC ; TYPE_THEN `B' = IMAGE (\ (e,v). (set_dist d_euclid {v} e)) B` ABBREV_TAC ; TYPE_THEN `FINITE B'` SUBGOAL_TAC; EXPAND_TAC "B'"; IMATCH_MP_TAC FINITE_IMAGE; TYPE_THEN `B = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~( graph_inc G e v) /\ (z = (e,v)))}` SUBGOAL_TAC; EXPAND_TAC "B"; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; MESON_TAC[]; DISCH_THEN_REWRITE; IMATCH_MP_TAC graph_disk_lemma1; ASM_REWRITE_TAC[]; DISCH_TAC; (* [C] : A' B' C nonempty *) TYPE_THEN `C' = A' UNION B'` ABBREV_TAC ; TYPE_THEN `FINITE C' /\ ~(C' = EMPTY)` SUBGOAL_TAC; EXPAND_TAC "C'"; ASM_REWRITE_TAC[FINITE_UNION]; EXPAND_TAC "C'"; REWRITE_TAC[EMPTY_EXISTS;UNION;]; TYPE_THEN `~(A' = EMPTY)` SUBGOAL_TAC; EXPAND_TAC "A'"; REWRITE_TAC[image_empty; ]; TYPE_THEN `(?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))` SUBGOAL_TAC; IMATCH_MP_TAC graph_vertex_2; ASM_REWRITE_TAC[]; ASM_MESON_TAC[plane_graph]; REP_BASIC_TAC; UND 12; REWRITE_TAC[]; EXPAND_TAC "A"; REWRITE_TAC[EMPTY_EXISTS]; CONV_TAC (dropq_conv "u"); TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `v'` EXISTS_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; MESON_TAC[]; DISCH_TAC; (* [D]: C(inf C) *) TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; UND 3; REWRITE_TAC[plane_graph]; MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `C'(inf C')` SUBGOAL_TAC; IMATCH_MP_TAC finite_inf; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `!x. C' x ==> (inf C' <= x)` SUBGOAL_TAC; IMATCH_MP_TAC finite_inf_min; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `!v. (graph_vertex G v ==> compact top2 {v})` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC compact_point; UND 13; REWRITE_TAC[SUBSET;top2_unions]; UND 12; MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `!e. (graph_edge G e ==> compact top2 e)` SUBGOAL_TAC; ASM_MESON_TAC[graph_edge_compact]; DISCH_TAC; (* -- *) TYPE_THEN `!x. A' x <=> (?v' v''. graph_vertex G v' /\ graph_vertex G v'' /\ ~(v' = v'') /\ (x = d_euclid v' v'' / &2))` SUBGOAL_TAC; EXPAND_TAC "A'"; EXPAND_TAC "A"; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x'"); (*** Next steps removed by JRH: now paired beta-conversion automatic ***) DISCH_TAC; (* -- *) TYPE_THEN `!x. B' x <=> (?e' v'. graph_edge G e' /\ graph_vertex G v' /\ ~(graph_inc G e' v') /\ (x = set_dist d_euclid { v' } e'))` SUBGOAL_TAC; EXPAND_TAC "B'"; EXPAND_TAC "B"; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x'"); (*** Next steps removed by JRH: now paired beta-conversion automatic ***) DISCH_TAC; (* -- [temp] *) TYPE_THEN `!x. C' x ==> (&0 < x)` SUBGOAL_TAC; EXPAND_TAC "C'"; REWRITE_TAC[UNION]; GEN_TAC; DISCH_THEN DISJ_CASES_TAC; UND 20; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[REAL_LT_HALF1]; IMATCH_MP_TAC (REAL_ARITH `(&0 <= y /\ ~(y = &0) ) ==> &0 < y `); TYPE_THEN `euclid 2 v' /\ euclid 2 v''` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; UND 20; ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;]; (* -2- *) UND 20; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC set_dist_pos; TYPE_THEN `euclid 2` EXISTS_TAC ; REWRITE_TAC[metric_euclid;single_subset]; CONJ_TAC; UND 13; REWRITE_TAC[SUBSET]; UND 21; MESON_TAC[]; CONJ_TAC; REWRITE_TAC[EMPTY_EXISTS;INR IN_SING;]; MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_nonempty; UND 3; UND 22; REWRITE_TAC[plane_graph;SUBSET;]; MESON_TAC[]; REWRITE_TAC[GSYM top2]; ASM_SIMP_TAC[]; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TSPEC `e'` 25; REWR 25; TYPE_THEN `v'` (fun u -> FIRST_ASSUM (fun t-> (MP_TAC (AP_THM t u)))); ASM_REWRITE_TAC[EQ_EMPTY;]; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[INR IN_SING;]; MESON_TAC[]; UND 22; UND 17; REWRITE_TAC[compact;top2_unions]; MESON_TAC[]; DISCH_TAC; (* [E] r good for A' *) TYPE_THEN `?r. (&0 < r /\ r < inf C')` SUBGOAL_TAC; TYPE_THEN `inf C' /(&2)` EXISTS_TAC; IMATCH_MP_TAC half_pos; UND 20; UND 14; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `r` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; REP_BASIC_TAC; TYPE_THEN `A' ((d_euclid v v')/(&2))` SUBGOAL_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; (* -2- *) TYPE_THEN `r < ((d_euclid v v')/(&2))` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `(?t . (r < t /\ t <= u)) ==> (r < u)`); TYPE_THEN `inf C'` EXISTS_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; EXPAND_TAC "C'"; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; DISCH_TAC; REWRITE_TAC[EQ_EMPTY ;INTER;]; REP_BASIC_TAC; (* -2- triangle ineq *) UND 29; UND 30; UND 28; UND 21; POP_ASSUM_LIST (fun t-> ALL_TAC); REP_BASIC_TAC; (* [* temp] *) TYPE_THEN `d_euclid v v' <= r + r` SUBGOAL_TAC; IMATCH_MP_TAC closed_ball_inter; TYPE_THEN `euclid 2` EXISTS_TAC; REWRITE_TAC[INTER;EMPTY_EXISTS ;metric_euclid;]; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `d_euclid v v' < d_euclid v v'/(&2) + d_euclid v v'/(&2)` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `(?t. (d <= t + t /\ t < u)) ==> (d < u + u)`); TYPE_THEN `r` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_HALF_DOUBLE]; REAL_ARITH_TAC; (* [F] good for B' *) REP_BASIC_TAC; PROOF_BY_CONTR_TAC; USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER;]); REP_BASIC_TAC; (* -- *) TYPE_THEN `B' (set_dist d_euclid {v} e)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `r < set_dist d_euclid {v} e` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `(?t. (r < t /\ t <= q)) ==> (r < q)`); TYPE_THEN `inf C'` EXISTS_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; EXPAND_TAC "C'"; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `(!p p'. ({v} p /\ e p' ==> (set_dist d_euclid {v} e <= d_euclid p p')))` SUBGOAL_TAC; IMATCH_MP_TAC set_dist_inf; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[metric_euclid;single_subset;]; CONJ_TAC; UND 13; UND 25; MESON_TAC[ISUBSET]; UND 17; UND 26; REWRITE_TAC[compact;top2_unions;]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `set_dist d_euclid {v} e <= d_euclid v u` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[INR IN_SING]; TYPE_THEN `d_euclid v u <= r` SUBGOAL_TAC; UND 27; REWRITE_TAC[closed_ball]; MESON_TAC[]; UND 30; REAL_ARITH_TAC; (* Sat Aug 7 21:33:13 EDT 2004 *) ]);; (* }}} *) let norm2 = jordan_def `norm2 x = d_euclid x euclid0`;; let cis = jordan_def `cis x = point(cos(x),sin(x))`;; let norm2_cis = prove_by_refinement( `!x. norm2(cis(x)) = &1`, (* {{{ proof *) [ REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point]; REDUCE_TAC; ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`]; REWRITE_TAC[SIN_CIRCLE;SQRT_1]; (* Sat Aug 7 21:47:16 EDT 2004 *) ]);; (* }}} *) let norm2_nn = prove_by_refinement( `!x . (euclid 2 x) ==> &0 <= norm2 x`, (* {{{ proof *) [ REWRITE_TAC[norm2;euclid0_point]; ASM_MESON_TAC[d_euclid_pos;euclid_point]; (* Sat Aug 7 21:52:31 EDT 2004 *) ]);; (* }}} *) let norm2_0 = prove_by_refinement( `!x. (euclid 2 x) /\ (norm2 x = &0) <=> (x = euclid0)`, (* {{{ proof *) [ REP_BASIC_TAC; EQ_TAC; REWRITE_TAC[norm2;euclid0_point;]; MESON_TAC[d_euclid_zero;euclid_point]; DISCH_THEN_REWRITE; REWRITE_TAC[euclid0_point;euclid_point;norm2;]; ASM_MESON_TAC[d_euclid_zero;euclid_point]; (* Sat Aug 7 21:59:11 EDT 2004 *) ]);; (* }}} *) let cis_inj = prove_by_refinement( `!t t'. (&0 <= t /\ t < &2*pi) /\ (&0 <= t' /\ t' < &2*pi) ==> ((cis t = cis t') <=> (t = t'))`, (* {{{ proof *) [ (* A trivial direction *) REP_BASIC_TAC; REWRITE_TAC[cis;point_inj;PAIR_SPLIT ]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; EQ_TAC; DISCH_THEN_REWRITE; (* B range of s *) REP_BASIC_TAC; TYPE_THEN `s = (\t. (if (t < pi) then t else ((&2)*pi - t)))` ABBREV_TAC ; TYPE_THEN `!t. (&0 <= t /\ t < (&2 * pi)) ==> (&0 <= s t /\ s t <= pi)` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC "s"; COND_CASES_TAC; UND 9; UND 8; REAL_ARITH_TAC; CONJ_TAC; UND 7; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_2;]; UND 9; REAL_ARITH_TAC; DISCH_TAC; (* [C] : cos (s t) *) TYPE_THEN `!t. cos (s t) = cos t` SUBGOAL_TAC; EXPAND_TAC "s"; GEN_TAC; COND_CASES_TAC; REWRITE_TAC[]; REWRITE_TAC [REAL_ARITH `x - t = (--. t + x)`;COS_PERIODIC;COS_NEG]; DISCH_TAC; (* D : (s t) = (s t') *) TYPE_THEN `(s t= s t') ==> ((t = t') \/ (t' = (&2 * pi - t)))` SUBGOAL_TAC; EXPAND_TAC "s"; COND_CASES_TAC; COND_CASES_TAC; MESON_TAC[]; REAL_ARITH_TAC; COND_CASES_TAC; REAL_ARITH_TAC; REAL_ARITH_TAC; DISCH_TAC; (* E : show s t = s t' *) USE 8 GSYM; UND 5; (ASM ONCE_REWRITE_TAC []); DISCH_THEN (fun t -> MP_TAC (AP_TERM `acs` t)); DISCH_TAC; TYPE_THEN `s t = s t'` SUBGOAL_TAC; TYPE_THEN `acs (cos (s t)) = s t` SUBGOAL_TAC; IMATCH_MP_TAC COS_ACS; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `acs (cos (s t')) = s t'` SUBGOAL_TAC; IMATCH_MP_TAC COS_ACS; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; REWR 9; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; UND 4; ASM_REWRITE_TAC[]; REWRITE_TAC[(REAL_ARITH `x - y = -- y + x`);SIN_PERIODIC ;SIN_NEG ;]; REWRITE_TAC [(REAL_ARITH `(x = --x) <=> (x = &0)`)]; REWRITE_TAC[SIN_ZERO_PI]; PROOF_BY_CONTR_TAC; USE 4 (REWRITE_RULE[]); (* now t is a MULT of pi, finish *) FIRST_ASSUM DISJ_CASES_TAC; REP_BASIC_TAC; UND 2; ASM_REWRITE_TAC[]; ASSUME_TAC PI_POS; ASM_SIMP_TAC[REAL_LT_RMUL_EQ]; REWRITE_TAC [REAL_LT]; REWRITE_TAC[ARITH_RULE `n <| 2 <=> (n = 0) \/ (n =1)`]; DISCH_TAC; FIRST_ASSUM DISJ_CASES_TAC; REWR 13; REWR 11; UND 0; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; UND 12; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; REP_BASIC_TAC; UND 3; ASM_REWRITE_TAC[]; ASSUME_TAC PI_POS; REWRITE_TAC[REAL_ARITH (` ~(&0 <= -- x) <=> (&0 <. x) `)]; IMATCH_MP_TAC REAL_LT_MUL; ASM_REWRITE_TAC[REAL_LT ]; REWRITE_TAC[ARITH_RULE `0 <| n <=> ~(n = 0)`]; DISCH_TAC; UND 0; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* Sun Aug 8 08:42:13 EDT 2004 *) ]);; (* }}} *) let norm2_scale_cis = prove_by_refinement( `!x r. norm2(r *# cis(x)) = abs (r)`, (* {{{ proof *) [ REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;]; REDUCE_TAC; REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB]; ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`]; REWRITE_TAC[SIN_CIRCLE;REAL_MUL_RID;POW_2_SQRT_ABS]; (* Sun Aug 8 08:46:56 EDT 2004 *) ]);; (* }}} *) let norm2_scale = prove_by_refinement( `!x r. (euclid 2 x) ==> (norm2(r *# x) = abs (r)*norm2(x))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?u v. (x = point(u,v))` SUBGOAL_TAC; USE 0 (MATCH_MP point_onto); REP_BASIC_TAC; TYPE_THEN `FST p` EXISTS_TAC; TYPE_THEN `SND p` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;]; REDUCE_TAC; REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB]; REWRITE_TAC[GSYM POW_2_SQRT_ABS]; IMATCH_MP_TAC SQRT_MUL; REWRITE_TAC[REAL_LE_SQUARE_POW]; IMATCH_MP_TAC (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`); REWRITE_TAC[REAL_LE_SQUARE_POW]; ]);; (* }}} *) let polar_inj = prove_by_refinement( `!x x' r r'. (&0 <= r) /\ (&0 <= r') /\ (&0 <= x) /\ (&0 <= x') /\ (x < &2 *pi) /\ (x' < &2 * pi) /\ (r *# cis(x) = r' *# cis(x')) ==> ((r = &0) /\ (r' = &0)) \/ ((r = r') /\ (x = x'))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `abs r = abs r'` SUBGOAL_TAC; FIRST_ASSUM (fun t -> MP_TAC (AP_TERM `norm2` t)); REWRITE_TAC[norm2_scale_cis]; DISCH_TAC; TYPE_THEN `r' = r` SUBGOAL_TAC; ASM_MESON_TAC[ABS_REFL]; DISCH_TAC; ASM_REWRITE_TAC[]; ASM_CASES_TAC `(r = &0)` ; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REWR 0; TYPE_THEN `cis x = cis x'` SUBGOAL_TAC; IMATCH_MP_TAC euclid_scale_cancel; ASM_MESON_TAC[]; ASM_MESON_TAC[cis_inj]; ]);; (* }}} *) let norm2_bounds = prove_by_refinement( `!a b s t. (&0 < a) /\ (a < b) /\ (&0 <= t) /\ (t <= &1) ==> (a <= norm2((a + t*(b-a))*# cis(s))) /\ ( norm2((a + t*(b-a))*# cis(s)) <= b) `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[norm2_scale_cis]; TYPE_THEN `a <= a + t*(b - a)` SUBGOAL_TAC; REWRITE_TAC[REAL_ARITH `x <= x + y <=> (&0 <= y)`]; IMATCH_MP_TAC REAL_LE_MUL; ASM_REWRITE_TAC[]; UND 2; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `&0 <= a + t*(b-a)` SUBGOAL_TAC; UND 4; UND 3; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `abs (a + t*(b-a)) = a + t*(b-a)` SUBGOAL_TAC; REWRITE_TAC[ABS_REFL]; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; ineq_le_tac `(a + t*(b-a)) + (&1 - t)*(b - a) = b`; (* Sun Aug 8 09:12:18 EDT 2004 *) ]);; (* }}} *) let norm2_point = prove_by_refinement( `!u v. norm2(point(u,v)) = sqrt(u pow 2 + v pow 2)`, (* {{{ proof *) [ REWRITE_TAC[norm2;euclid0_point;d_euclid_point;]; REDUCE_TAC; ]);; (* }}} *) let cis_exist_lemma = prove_by_refinement( `!x. (euclid 2 x) /\ (norm2 x = &1) ==> (? t. x = cis(t))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `? u v. x = point (u,v)` SUBGOAL_TAC; USE 1 (MATCH_MP point_onto); REP_BASIC_TAC; TYPE_THEN `FST p` EXISTS_TAC; TYPE_THEN `SND p` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REWR 0; UND 0; REWRITE_TAC[norm2_point]; DISCH_TAC; USE 0 (fun t -> AP_TERM `\t. t pow 2` t); UND 0; BETA_TAC; REDUCE_TAC; TYPE_THEN `(sqrt (u pow 2 + v pow 2) pow 2 = u pow 2 + v pow 2)` SUBGOAL_TAC; IMATCH_MP_TAC SQRT_POW_2; IMATCH_MP_TAC (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`); ASM_REWRITE_TAC[REAL_LE_POW_2]; DISCH_THEN_REWRITE; DISCH_THEN (fun t -> MP_TAC (MATCH_MP CIRCLE_SINCOS t)); REP_BASIC_TAC; ASM_REWRITE_TAC[cis]; MESON_TAC[]; ]);; (* }}} *) let cos_period = prove_by_refinement( `! j t. (cos (t + &j * &2 *pi) = cos(t))`, (* {{{ proof *) [ INDUCT_TAC; REDUCE_TAC; REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;]; REDUCE_TAC; REWRITE_TAC[COS_PERIODIC]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let sin_period = prove_by_refinement( `! j t. (sin (t + &j * &2 *pi) = sin(t))`, (* {{{ proof *) [ INDUCT_TAC; REDUCE_TAC; REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;]; REDUCE_TAC; REWRITE_TAC[SIN_PERIODIC]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let cos_period_neg = prove_by_refinement( `! j t. (cos (t - &j * &2 *pi) = cos(t))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC cos_period; TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL); RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]); USE 0 SYM; ASM_REWRITE_TAC[]; ]);; (* }}} *) let sin_period_neg = prove_by_refinement( `! j t. (sin (t - &j * &2 *pi) = sin(t))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC sin_period; TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL); RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]); USE 0 SYM; ASM_REWRITE_TAC[]; ]);; (* }}} *) let cos_period_int = prove_by_refinement( `!m t. (cos (t + real_of_int m * &2 *pi) = cos (t))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC INT_REP2 ; TSPEC `m` 0; REP_BASIC_TAC; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[int_of_num_th;cos_period]; ASM_REWRITE_TAC[int_of_num_th;int_neg_th;cos_period_neg;GSYM real_sub;REAL_MUL_LNEG]; ]);; (* }}} *) let sin_period_int = prove_by_refinement( `!m t. (sin (t + real_of_int m * &2 *pi) = sin (t))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC INT_REP2 ; TSPEC `m` 0; REP_BASIC_TAC; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[int_of_num_th;sin_period]; ASM_REWRITE_TAC[int_of_num_th;int_neg_th;sin_period_neg;GSYM real_sub;REAL_MUL_LNEG]; ]);; (* }}} *) let cos_sin_reduce = prove_by_refinement( `!t. ?t'. (cos t = cos t') /\ (sin t = sin t') /\ (&0 <= t') /\ (t' < &2 * pi)`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC floor_ineq; TSPEC `t/(&2 *pi)` 0; TYPE_THEN `f = floor (t/(&2 * pi))` ABBREV_TAC ; REP_BASIC_TAC; TYPE_THEN `t' = t - real_of_int(f)*(&2)*pi` ABBREV_TAC ; TYPE_THEN `t'` EXISTS_TAC; TYPE_THEN `t' = t + real_of_int (--: f) *(&2)*pi` SUBGOAL_TAC; EXPAND_TAC "t'"; REWRITE_TAC[REAL_ARITH `x -y = x + (-- y)`;REAL_ARITH `-- (x * y) = (-- x)*y`;GSYM int_neg_th]; DISCH_TAC; CONJ_TAC; ASM_REWRITE_TAC[cos_period_int]; CONJ_TAC; ASM_REWRITE_TAC[sin_period_int]; EXPAND_TAC "t'"; TYPE_THEN `&0 < (&2 *pi)` SUBGOAL_TAC; REWRITE_TAC[REAL_MUL_2]; MP_TAC PI_POS; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `~(&0 = &2* pi)` SUBGOAL_TAC; UND 5; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `t = (t/(&2 *pi))*(&2 *pi)` SUBGOAL_TAC; ASM_SIMP_TAC[REAL_DIV_RMUL]; DISCH_TAC; USE 7 SYM ; TYPE_THEN `&0 <= (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi)` SUBGOAL_TAC; REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; IMATCH_MP_TAC REAL_LE_MUL; UND 2; UND 5; REAL_ARITH_TAC; KILL 4; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; EXPAND_TAC "t'"; TYPE_THEN ` (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi) < &1* &2*pi` SUBGOAL_TAC; REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; IMATCH_MP_TAC REAL_LT_RMUL; UND 0; UND 5; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; REDUCE_TAC; (* Tue Aug 10 09:57:36 EDT 2004 *) ]);; (* }}} *) let cis_lemma = prove_by_refinement( `!x. (euclid 2 x) /\ (norm2 x = &1) ==> (?t. &0 <= t /\ t < &2 * pi /\ (x = cis t))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?t. x = cis t)` SUBGOAL_TAC; IMATCH_MP_TAC cis_exist_lemma; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASSUME_TAC cos_sin_reduce; TSPEC `t` 3; REP_BASIC_TAC; ASM_REWRITE_TAC[cis;point_inj;PAIR_SPLIT]; ASM_MESON_TAC[]; (* Tue Aug 10 10:01:55 EDT 2004 *) ]);; (* }}} *) let polar_exist = prove_by_refinement( `!x. (euclid 2 x) ==> (?r t. (&0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = r *# cis(t))))`, (* {{{ proof *) [ (* A: trivial case of norm 0 *) REP_BASIC_TAC; ASM_CASES_TAC `norm2 x = &0` ; TYPE_THEN `x = euclid0` SUBGOAL_TAC; ASM_MESON_TAC[norm2_0]; DISCH_THEN_REWRITE; TYPE_THEN `&0` EXISTS_TAC; TYPE_THEN `&0` EXISTS_TAC; REWRITE_TAC[euclid_scale0;REAL_MUL_2 ]; MP_TAC PI_POS; REAL_ARITH_TAC; (* B: rescale to 1 *) TYPE_THEN `&0 < norm2 x` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`); ASM_REWRITE_TAC[]; IMATCH_MP_TAC norm2_nn; ASM_REWRITE_TAC[]; TYPE_THEN `r = norm2 x ` ABBREV_TAC ; DISCH_TAC; TYPE_THEN `r` EXISTS_TAC; TYPE_THEN `y = (&1/r)*# x` ABBREV_TAC ; TYPE_THEN `x = r*# y` SUBGOAL_TAC; EXPAND_TAC "y"; REWRITE_TAC[euclid_scale_act;GSYM real_div_assoc]; REDUCE_TAC; ASM_SIMP_TAC[REAL_DIV_REFL; euclid_scale_one;]; DISCH_TAC; REWR 2; ASM_REWRITE_TAC[]; TYPE_THEN `euclid 2 y` SUBGOAL_TAC; EXPAND_TAC "y"; IMATCH_MP_TAC euclid_scale_closure; ASM_REWRITE_TAC[]; DISCH_TAC; UND 2; ASM_SIMP_TAC[norm2_scale]; TYPE_THEN `abs r = r` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_ABS_REFL]; UND 3; REAL_ARITH_TAC; DISCH_THEN_REWRITE; DISCH_TAC; TYPE_THEN `norm2 y = &1` SUBGOAL_TAC; IMATCH_MP_TAC REAL_EQ_LCANCEL_IMP; TYPE_THEN `r` EXISTS_TAC; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (* C: invoke norm2=1 case *) TYPE_THEN `(?t. &0 <= t /\ t < &2 * pi /\ (y = cis t))` SUBGOAL_TAC; IMATCH_MP_TAC cis_lemma; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `t` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 3; REAL_ARITH_TAC; ]);; (* }}} *) (* vert r = hyperplane 2 e1 r horz r = hyperplane 2 e2 r cf. line2D_F..., line2D_S.... *) let subset_union_pair = prove_by_refinement( `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==> (A UNION B) SUBSET (A' UNION B')`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; ]);; (* }}} *) let subset_inter_pair = prove_by_refinement( `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==> (A INTER B) SUBSET (A' INTER B')`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; ]);; (* }}} *) let simple_arc_end_simple = prove_by_refinement( `!C v v'. simple_arc_end C v v' ==> simple_arc top2 C`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end;simple_arc]; REP_BASIC_TAC; REWRITE_TAC[top2_unions]; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Tue Aug 10 10:33:30 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_restriction = prove_by_refinement( `!C K K' . simple_arc top2 C /\ closed_ top2 K /\ closed_ top2 K' /\ (C INTER K INTER K' = EMPTY ) /\ ~(C INTER K = EMPTY ) /\ ~(C INTER K' = EMPTY) ==> (?C' v v'. C' SUBSET C /\ simple_arc_end C' v v' /\ (C' INTER K = {v}) /\ (C' INTER K' = {v'})) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?C' f. (C' = IMAGE f {x | &0 <= x /\ x <= &1 }) /\ C' SUBSET C /\ continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= (&1)} (euclid 2) /\ (C' INTER K = {(f (&0))}) /\ (C' INTER K' = {(f (&1))}))` SUBGOAL_TAC; IMATCH_MP_TAC curve_restriction; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; REP_BASIC_TAC; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `f(&0)` EXISTS_TAC; TYPE_THEN `f(&1)` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[simple_arc_end]; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let simple_arc_end_trans = prove_by_refinement( `!C C' v v' v'' . simple_arc_end C v v' /\ simple_arc_end C' v' v'' /\ ( C INTER C' = {v'}) ==> simple_arc_end (C UNION C') v v''`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ &0 < &1/(&2) /\ &0 < &1` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF1]; REAL_ARITH_TAC; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; KILL 12; TYPE_THEN `continuous f' (top_of_metric (UNIV,d_real)) top2 /\ INJ f' {x | &0 <= x /\ x <= &1} (euclid 2) /\ &1/(&2) < &1 /\ &0 < &1` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF2]; REAL_ARITH_TAC; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; KILL 17; TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC; (* A: prelims *) TYPE_THEN `&0 < &1/(&2) /\ &1/(&2) < &1` SUBGOAL_TAC; REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2]; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM union_closed_interval); UND 17; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `{x | &0 <= x /\ x < &1} SUBSET {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `{x | &0 <= x /\ x < &1 / &2} SUBSET {x | x < &1/(&2)}` SUBGOAL_TAC; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `{x | &1 / &2 <= x /\ x <= &1} SUBSET {x | &1/ (&2) <= x}` SUBGOAL_TAC; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)} = {x | &0 <= x /\ x < &1/(&2)} UNION {(&1 /(&2))}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING ]; GEN_TAC; UND 17; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `g (&1/(&2)) = g' (&1/(&2))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) (* [B]: IMAGE *) SUBCONJ_TAC; ASM_REWRITE_TAC[IMAGE_UNION]; ASM_SIMP_TAC[joinf_image_above;joinf_image_below]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[union_subset]; CONJ_TAC; CONJ_TAC; REWRITE_TAC[SUBSET_UNION]; REWRITE_TAC[SUBSET;UNION]; REWRITE_TAC[IMAGE;INR IN_SING;]; NAME_CONFLICT_TAC; ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "x''"); GEN_TAC; DISCH_THEN_REWRITE; UND 27; DISCH_THEN_REWRITE; DISJ2_TAC ; TYPE_THEN `&1/(&2)` EXISTS_TAC; REWRITE_TAC[]; UND 17; REAL_ARITH_TAC; REWRITE_TAC[SUBSET_UNION]; (* --2-- *) USE 26 SYM; ASM_REWRITE_TAC[GSYM IMAGE_UNION]; REWRITE_TAC[union_subset]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC IMAGE_SUBSET; ASM_REWRITE_TAC[SUBSET;]; REAL_ARITH_TAC; REWRITE_TAC[SUBSET_UNION]; REWRITE_TAC[SUBSET_UNION]; DISCH_TAC; (* [C]: cont,INJ *) CONJ_TAC; IMATCH_MP_TAC joinf_cont; ASM_REWRITE_TAC[]; (* -- *) CONJ_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_split; ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below]; CONJ_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_UNION]; (* --2-- *) TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; ASM_SIMP_TAC[joinf_image_below]; DISCH_THEN_REWRITE; TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC; ASM_SIMP_TAC[joinf_image_above]; DISCH_THEN_REWRITE; TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 / &2} INTER IMAGE g' {x | &1 / &2 <= x /\ x <= &1} SUBSET {v'}` SUBGOAL_TAC; UND 0; DISCH_THEN (fun t -> REWRITE_TAC[SYM t]); USE 26 GSYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; IMATCH_MP_TAC IMAGE_SUBSET; ASM_REWRITE_TAC[SUBSET ]; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 /(&2)} INTER {v'} = EMPTY` SUBGOAL_TAC; REWRITE_TAC[EQ_EMPTY]; GEN_TAC; REWRITE_TAC[IMAGE;INTER;INR IN_SING;DE_MORGAN_THM;]; NAME_CONFLICT_TAC; LEFT_TAC "x'"; IMATCH_MP_TAC (TAUT `(B ==> A) ==> A \/ ~B`); DISCH_THEN_REWRITE; GEN_TAC; REP_BASIC_TAC; TYPE_THEN `x' = &1/(&2)` SUBGOAL_TAC; USE 15 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; USE 27 GSYM; ASM_REWRITE_TAC[]; TYPE_THEN `g x' = g(&1/(&2))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; UND 30; UND 33; REAL_ARITH_TAC; UND 30; REAL_ARITH_TAC; UND 29; REWRITE_TAC[SUBSET;EQ_EMPTY ;INTER;INR IN_SING;]; POP_ASSUM_LIST (fun t -> ALL_TAC); REP_BASIC_TAC; TSPEC `x` 3; REWR 3; TSPEC `x` 2; REWR 2; (* [D] final touches *) CONJ_TAC; REWRITE_TAC[joinf]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[joinf]; ASM_SIMP_TAC [REAL_ARITH `&1/(&2) < &1 ==> (&1 < &1/ &2 <=> F)`]; ASM_MESON_TAC[]; (* Tue Aug 10 13:15:07 EDT 2004 *) ]);; (* }}} *) let continuous_uninduced = prove_by_refinement( `!(f:A->B) U V Y. continuous f U (induced_top V Y) /\ IMAGE f (UNIONS U) SUBSET Y ==> continuous f U V`, (* {{{ proof *) [ REWRITE_TAC[continuous;]; REP_BASIC_TAC; TSPEC `v INTER Y` 2; TYPE_THEN `induced_top V Y (v INTER Y)` SUBGOAL_TAC; REWRITE_TAC[induced_top;IMAGE;]; ASM_MESON_TAC[]; DISCH_TAC; REWR 2; UND 2; REWRITE_TAC [preimage;INTER]; TYPE_THEN `{x | UNIONS U x /\ v (f x) /\ Y (f x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; GEN_TAC; TYPE_THEN `UNIONS U x ==> Y (f x)` SUBGOAL_TAC; UND 1; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[]; MESON_TAC[]; DISCH_THEN_REWRITE; (* Tue Aug 10 19:11:27 EDT 2004 *) ]);; (* }}} *) let simple_arc_homeo = prove_by_refinement( `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\ (metric_space(X,d)) ==> (?f. homeomorphism f (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric(C,d)))`, (* {{{ proof *) [ REWRITE_TAC[simple_arc]; REP_BASIC_TAC; TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; REWR 1; (* -- *) TYPE_THEN `C SUBSET X` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_image_subset; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC; KILL 3; ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace]; DISCH_TAC; (* -- *) TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC; REWRITE_TAC[SUBSET_UNIV]; DISCH_TAC; (* -- *) TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC; IMATCH_MP_TAC metric_subspace; TYPE_THEN `UNIV:real->bool` EXISTS_TAC; ASM_REWRITE_TAC[metric_real]; DISCH_TAC; (* -- *) ASSUME_TAC metric_real; (* -- *) TYPE_THEN `compact (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; TYPEL_THEN [`UNIV:real->bool`;`{x| &0 <= x /\ x <= &1}`;`d_real`] (fun t-> ASSUME_TAC (ISPECL t compact_subset)); REWR 10; USE 10 SYM; ASM_REWRITE_TAC[interval_compact]; DISCH_TAC; (* -- *) USE 3 GSYM ; (* -- *) (* A: show homeomorphism *) TYPE_THEN `f` EXISTS_TAC; IMATCH_MP_TAC hausdorff_homeomorphsim; ASM_SIMP_TAC[GSYM top_of_metric_unions]; ASM_SIMP_TAC[top_of_metric_top;metric_subspace]; (* -- *) TYPE_THEN `metric_space (C,d)` SUBGOAL_TAC; ASM_MESON_TAC [metric_subspace]; DISCH_TAC; TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET C` SUBGOAL_TAC; ASM_REWRITE_TAC[SUBSET_REFL ]; DISCH_TAC; TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET X` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (* B: final obligations *) CONJ_TAC; EXPAND_TAC "C"; IMATCH_MP_TAC inj_bij; UND 1; REWRITE_TAC[INJ]; MESON_TAC[]; (* -- *) TYPE_THEN `induced_top (top_of_metric (UNIV,d_real)) {x| &0 <= x /\ x <= &1} {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; ASM_SIMP_TAC[top_of_metric_induced]; TYPE_THEN `topology_ (top_of_metric ({x | &0 <= x /\ x <= &1},d_real))` SUBGOAL_TAC; ASM_SIMP_TAC[top_of_metric_top]; DISCH_THEN (fun t-> MP_TAC (MATCH_MP top_univ t)); ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; TYPE_THEN `continuous f (induced_top (top_of_metric (UNIV,d_real)) {x | &0 <= x /\ x <= &1}) (top_of_metric(X,d))` SUBGOAL_TAC; IMATCH_MP_TAC continuous_induced_domain; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; ASM_SIMP_TAC[metric_real;top_of_metric_induced]; ASM_SIMP_TAC[metric_continuous_continuous;metric_subspace]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; DISCH_THEN_REWRITE; ASM_SIMP_TAC[top_of_metric_top]; IMATCH_MP_TAC metric_hausdorff; ASM_REWRITE_TAC[]; (* Tue Aug 10 20:34:30 EDT 2004 *) ]);; (* }}} *) let continuous_metric_extend = prove_by_refinement( `!(f:A->B) U C X d. (metric_space(X,d) /\ continuous f U (top_of_metric (C,d)) /\ IMAGE f (UNIONS U) SUBSET C /\ C SUBSET X ==> continuous f U (top_of_metric(X,d)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `metric_space(C,d)` SUBGOAL_TAC; IMATCH_MP_TAC metric_subspace; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d)) C` SUBGOAL_TAC; ASM_SIMP_TAC[top_of_metric_induced]; DISCH_TAC; REWR 2; IMATCH_MP_TAC continuous_uninduced; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Tue Aug 10 20:47:53 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_distinct = prove_by_refinement( `!C v v'. simple_arc_end C v v' ==> ~(v = v')`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end;INJ]; REP_BASIC_TAC; TYPE_THEN `&0 = &1` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `f (&0) = f(&1)` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; REAL_ARITH_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let bij_imp_image = prove_by_refinement( `!(f:A->B) X Y. BIJ f X Y ==> (IMAGE f X = Y)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;SURJ]; REP_BASIC_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let homeo_inj = prove_by_refinement( `!(f:A->B) U C X d. (homeomorphism f U (top_of_metric(C,d))) /\ (C SUBSET X) /\ (metric_space (X,d)) ==> ( continuous f U (top_of_metric(X,d)) /\ INJ f (UNIONS U) C /\ (IMAGE f (UNIONS U) = C))`, (* {{{ proof *) [ REWRITE_TAC[homeomorphism]; REP_BASIC_TAC; TYPE_THEN`metric_space(C,d)` SUBGOAL_TAC; ASM_MESON_TAC [metric_subspace]; DISCH_TAC; (* -- *) UND 4; ASM_SIMP_TAC[GSYM top_of_metric_unions;]; DISCH_TAC; (* -- *) TYPE_THEN `IMAGE f (UNIONS U)= C` SUBGOAL_TAC; IMATCH_MP_TAC bij_imp_image ; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC continuous_metric_extend; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL ]; (* Tue Aug 10 20:58:37 EDT 2004 *) ]);; (* }}} *) let simple_arc_coord = prove_by_refinement( `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\ (metric_space(X,d)) ==> (?f. (continuous f (top_of_metric(C,d)) (top_of_metric(UNIV,d_real))) /\ (INJ f C UNIV) /\ (IMAGE f C = {x | &0 <= x /\ x <= &1}))`, (* {{{ proof *) [ REP_BASIC_TAC; (* -- *) TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC; ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; (* -- *) TYPE_THEN `C SUBSET X` SUBGOAL_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]); REP_BASIC_TAC; USE 4 GSYM; REWR 1; EXPAND_TAC "C"; IMATCH_MP_TAC inj_image_subset; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC; ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace]; DISCH_TAC; (* -- *) TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC; REWRITE_TAC[SUBSET_UNIV]; DISCH_TAC; (* -- *) TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC; IMATCH_MP_TAC metric_subspace; TYPE_THEN `UNIV:real->bool` EXISTS_TAC; ASM_REWRITE_TAC[metric_real]; DISCH_TAC; (* -- *) ASSUME_TAC metric_real; (* -- *) TYPE_THEN `(?f. homeomorphism f (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric(C,d)))` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_homeo; TYPE_THEN `X` EXISTS_TAC; (* // *) ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* -- *) TYPE_THEN ` g = (INV f ({x | &0 <= x /\ x <= &1}) (C:A->bool))` ABBREV_TAC ; TYPE_THEN `g = INV f (UNIONS((top_of_metric({x | &0 <= x /\ x <= &1},d_real)))) (UNIONS((top_of_metric(C,d))))` SUBGOAL_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_subspace;]; DISCH_TAC; (* A: *) TYPE_THEN `g` EXISTS_TAC; (* -- *) (* TYPE_THEN `U = top_of_metric({x | &0 <= x /\ x <= &1},d_real)` ABBREV_TAC ; *) TYPE_THEN `(homeomorphism g (top_of_metric(C,d)) (top_of_metric({x | &0 <= x /\ x <= &1},d_real))) /\ ({x | &0 <= x /\ x <= &1} SUBSET UNIV) /\ (metric_space (UNIV,d_real))` SUBGOAL_TAC; ASM_REWRITE_TAC[]; TYPEL_THEN [`f`;`(top_of_metric({x | &0 <= x /\ x <= &1},d_real))`;`top_of_metric(C,d)`] (fun t-> ASSUME_TAC (ISPECL t homeomorphism_inv)); REWR 11; DISCH_TAC; USE 11 (MATCH_MP homeo_inj); REP_BASIC_TAC; KILL 9; KILL 10; ASM_REWRITE_TAC[]; UND 11; UND 12; ASM_REWRITE_TAC[]; UND 5; POP_ASSUM_LIST (fun t-> ALL_TAC); REP_BASIC_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[INJ_UNIV]; (* Tue Aug 10 21:49:22 EDT 2004 *) ]);; (* }}} *) (* slow! *) let image_interval = prove_by_refinement( `!a b f. (a < b) /\ (continuous f (top_of_metric(UNIV,d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ f {x | a <= x /\ x <= b} UNIV) ==> (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\ (IMAGE f {x | a <= x /\ x <= b} = {x | c <= x /\ x <= d}) ) `, (* {{{ proof *) [ REP_BASIC_TAC; (* -- *) ASSUME_TAC connect_real; TYPE_THEN `!a b. connected (top_of_metric(UNIV,d_real)) (IMAGE f {x | a<= x /\ x <= b})` SUBGOAL_TAC; REP_GEN_TAC; IMATCH_MP_TAC connect_image; TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC ; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; DISCH_TAC; (* -- *) TYPE_THEN `c = min_real (f a) (f b)` ABBREV_TAC ; TYPE_THEN `d = max_real (f a) (f b)` ABBREV_TAC ; TYPE_THEN `c`EXISTS_TAC; TYPE_THEN `d` EXISTS_TAC; TYPE_THEN `~(f a = f b)` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; TYPE_THEN `a = b` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 2; REAL_ARITH_TAC; UND 2; REAL_ARITH_TAC; DISCH_TAC; (* -- *) SUBCONJ_TAC; EXPAND_TAC "d"; EXPAND_TAC "c"; REWRITE_TAC[min_real;max_real]; TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC; UND 7; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `~(f b < f a)` SUBGOAL_TAC; UND 8; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; TYPE_THEN `~(f a < f b)` SUBGOAL_TAC; UND 8; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) SUBCONJ_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[in_pair]; EXPAND_TAC "d"; EXPAND_TAC "c"; REWRITE_TAC[max_real;min_real]; TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC; UND 7; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `~(f b < f a)` SUBGOAL_TAC; UND 9; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; TYPE_THEN `~(f a < f b)` SUBGOAL_TAC; UND 9; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; MESON_TAC[]; DISCH_TAC; (* B *) IMATCH_MP_TAC SUBSET_ANTISYM; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); SUBCONJ_TAC; IMATCH_MP_TAC connected_nogap; ASM_REWRITE_TAC[]; EXPAND_TAC "c"; EXPAND_TAC "d"; REWRITE_TAC[max_real;min_real]; TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC; UND 7; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `~(f b < f a)` SUBGOAL_TAC; UND 10; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`]; TYPE_THEN `~(f a < f b)` SUBGOAL_TAC; UND 10; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`]; DISCH_TAC; (* C set up cases *) REWRITE_TAC[IMAGE;SUBSET;]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USE 14 (REWRITE_RULE[DE_MORGAN_THM]); USE 9 (REWRITE_RULE[FUN_EQ_THM;in_pair ]); TYPE_THEN `((c = f a) /\ (d = f b)) \/ ((c = f b) /\ (d = f a))` SUBGOAL_TAC; UND 9; MESON_TAC[]; DISCH_TAC; TYPE_THEN `f x' < c \/ d < f x'` SUBGOAL_TAC; UND 14; ARITH_TAC; DISCH_TAC; KILL 9; KILL 14; KILL 11; (* D generic case *) TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (r < t) /\ (f r < f s) /\ (f s < f t) ==> (r < s /\ s < t))` SUBGOAL_TAC; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPEL_THEN [`r`;`t`] (USE 4 o ISPECL); USE 4(REWRITE_RULE[connected]); REP_BASIC_TAC; TYPE_THEN `IMAGE f {x | r <= x /\ x <= t} SUBSET {x | x < f s} \/ IMAGE f {x | r <= x /\ x <= t} SUBSET {x | f s < x}` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;]; CONJ_TAC; REAL_ARITH_TAC; REWRITE_TAC[IMAGE;SUBSET;UNION;]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` ); DISCH_TAC; TYPE_THEN `x'' = s` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 26; UND 27; UND 22; UND 17; REAL_ARITH_TAC; UND 9; UND 11; UND 23; UND 26; UND 27; POP_ASSUM_LIST (fun t-> ALL_TAC); REP_BASIC_TAC; TYPE_THEN `~(r = s)` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; TYPE_THEN `~(s = t)` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; KILL 1; KILL 2; UND 0; UND 3; UND 4; UND 5; REAL_ARITH_TAC; REWRITE_TAC[DE_MORGAN_THM ]; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET;]; LEFT_TAC "x"; TYPE_THEN `f t` EXISTS_TAC; LEFT_TAC "x'"; REP_BASIC_TAC; TSPEC `t` 25; UND 25; UND 9; UND 14; REAL_ARITH_TAC; REWRITE_TAC[IMAGE;SUBSET;]; LEFT_TAC "x"; TYPE_THEN `f r` EXISTS_TAC; REP_BASIC_TAC; LEFT 25 "x'" ; TSPEC `r` 25; UND 25; UND 14; UND 11; REAL_ARITH_TAC; (* D' generic case *) TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (t < r) /\ (f r < f s) /\ (f s < f t) ==> (t < s /\ s < r))` SUBGOAL_TAC; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPEL_THEN [`t`;`r`] (USE 4 o ISPECL); USE 4(REWRITE_RULE[connected]); REP_BASIC_TAC; TYPE_THEN `IMAGE f {x | t <= x /\ x <= r} SUBSET {x | x < f s} \/ IMAGE f {x | t <= x /\ x <= r} SUBSET {x | f s < x}` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;]; CONJ_TAC; REAL_ARITH_TAC; REWRITE_TAC[IMAGE;SUBSET;UNION;]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` ); DISCH_TAC; TYPE_THEN `x'' = s` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 26; UND 27; UND 18; UND 21; REAL_ARITH_TAC; UND 9; UND 11; UND 23; UND 26; UND 27; POP_ASSUM_LIST (fun t-> ALL_TAC); REP_BASIC_TAC; TYPE_THEN `~(r = s)` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; TYPE_THEN `~(s = t)` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; KILL 1; KILL 2; UND 0; UND 3; UND 4; UND 5; REAL_ARITH_TAC; REWRITE_TAC[DE_MORGAN_THM ]; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET;]; LEFT_TAC "x"; TYPE_THEN `f t` EXISTS_TAC; LEFT_TAC "x'"; REP_BASIC_TAC; TSPEC `t` 25; UND 25; UND 9; UND 14; REAL_ARITH_TAC; REWRITE_TAC[IMAGE;SUBSET;]; LEFT_TAC "x"; TYPE_THEN `f r` EXISTS_TAC; REP_BASIC_TAC; LEFT 25 "x'" ; TSPEC `r` 25; UND 25; UND 14; UND 11; REAL_ARITH_TAC; REP_BASIC_TAC; (* end generic *) KILL 4; KILL 3; KILL 0; KILL 1; KILL 10; KILL 6; KILL 5; (* E: actual cases *) UND 16; UND 15; REP_CASES_TAC; (* --2a-- *) KILL 11; TYPEL_THEN[`x'`;`a`;`b`] (USE 9 o ISPECL); TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `~(x' = b)` SUBGOAL_TAC; ASM_MESON_TAC[]; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* --2b-- *) KILL 11; TYPEL_THEN [`a`;`b`;`x'`] (USE 9 o ISPECL); TYPE_THEN `~(f a = f x')` SUBGOAL_TAC; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `~(a = x')` SUBGOAL_TAC; ASM_MESON_TAC[]; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* --2c-- *) KILL 9; TYPEL_THEN [`x'`;`b`;`a`] (USE 11 o ISPECL); TYPE_THEN `~(f x' = f a)` SUBGOAL_TAC; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `~(a = x')` SUBGOAL_TAC; ASM_MESON_TAC[]; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* --2d-- *) KILL 9; TYPEL_THEN [`b`;`a`;`x'`] (USE 11 o ISPECL); TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `~(b = x')` SUBGOAL_TAC; ASM_MESON_TAC[]; REPEAT (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* Wed Aug 11 09:36:14 EDT 2004 *) ]);; (* }}} *) let metric_continuous_range = prove_by_refinement( `!(f:A->B) X dX Y dY Y'. metric_continuous f (X,dX) (Y,dY) <=> metric_continuous f (X,dX) (Y',dY)`, (* {{{ proof *) [ REWRITE_TAC[metric_continuous;metric_continuous_pt]; ]);; (* }}} *) let continuous_range = prove_by_refinement( `!(f:A->B) X dX Y dY Y'. metric_space(X,dX) /\ metric_space(Y,dY) /\ metric_space(Y',dY) /\ continuous f (top_of_metric(X,dX)) (top_of_metric(Y,dY)) /\ IMAGE f X SUBSET Y /\ IMAGE f X SUBSET Y' ==> continuous f (top_of_metric(X,dX)) (top_of_metric(Y',dY))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y',dY)) = metric_continuous f (X,dX) (Y',dY)` SUBGOAL_TAC; IMATCH_MP_TAC metric_continuous_continuous; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y,dY)) = metric_continuous f (X,dX) (Y,dY)` SUBGOAL_TAC; IMATCH_MP_TAC metric_continuous_continuous; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; REWR 2; ASM_MESON_TAC[metric_continuous_range]; ]);; (* }}} *) let metric_continuous_domain = prove_by_refinement( `!(f:A->B) X dX Y dY Y' A. metric_continuous f (X,dX) (Y,dY) /\ A SUBSET X ==> metric_continuous f (A,dX) (Y',dY)`, (* {{{ proof *) [ REWRITE_TAC[metric_continuous;metric_continuous_pt;SUBSET]; MESON_TAC[]; ]);; (* }}} *) let pair_order_endpoint = prove_by_refinement( `!a b c d . (c < d) /\ ({c , d} = {a ,b}) ==> (c = min_real a b) /\ (d = max_real a b)`, (* {{{ proof *) [ REP_BASIC_TAC; USE 0 (REWRITE_RULE[FUN_EQ_THM;in_pair]); TYPE_THEN `((c = a) /\ (d = b)) \/ ((c = b) /\ (d = a))` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; REWR 1; ASM_REWRITE_TAC[min_real;max_real]; ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`]; ASM_REWRITE_TAC[]; REWR 1; ASM_REWRITE_TAC[min_real;max_real]; ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`]; ]);; (* }}} *) let cont_extend_real_lemma = prove_by_refinement( `!a b (f:real->A) Y dY. (a < b) /\ (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) (top_of_metric(Y,dY))) /\ (metric_space(Y,dY)) /\ IMAGE f {x | a <= x /\ x <= b} SUBSET Y ==> ( ?g. (continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(Y,dY))) /\ (!x. (a <= x /\ x <= b) ==> (f x = g x)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?t. (a < t /\ t < b)` SUBGOAL_TAC; TYPE_THEN `(a+b)/(&2)` EXISTS_TAC; ASM_MESON_TAC[real_middle1_lt;real_middle2_lt]; REP_BASIC_TAC; ASSUME_TAC metric_real; TYPE_THEN `{x | a <= x /\ x <= b} SUBSET UNIV` SUBGOAL_TAC; ASM_REWRITE_TAC[SUBSET_UNIV]; DISCH_TAC; TYPE_THEN `metric_space ({x | a <= x /\ x <= b},d_real)` SUBGOAL_TAC; IMATCH_MP_TAC metric_subspace; TYPE_THEN `UNIV:real->bool` EXISTS_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `metric_continuous f ({x | a <= x /\ x <= b},d_real) (Y,dY)` SUBGOAL_TAC; UND 2; ASM_SIMP_TAC [metric_continuous_continuous]; DISCH_TAC; TYPE_THEN `A = {x | x <= a}` ABBREV_TAC ; TYPE_THEN `B = {x | b <= x}` ABBREV_TAC ; TYPE_THEN `fA = (\(t:real). f a)` ABBREV_TAC ; TYPE_THEN `fB = (\(t:real). f b)` ABBREV_TAC ; ASSUME_TAC half_closed; ASSUME_TAC half_closed_above; (* -- *) TYPE_THEN `!r A. (Y r) ==> (metric_continuous (\t. r) (A,d_real) (Y,dY))` SUBGOAL_TAC; REWRITE_TAC[metric_continuous;metric_continuous_pt]; REP_BASIC_TAC; RIGHT_TAC "delta"; REP_BASIC_TAC; TYPE_THEN `epsilon` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_MESON_TAC[metric_space_zero]; DISCH_TAC; (* -- *) TYPE_THEN `metric_continuous (subf A fA fB) (A UNION B,d_real) (Y,dY)` SUBGOAL_TAC; IMATCH_MP_TAC subf_cont; TYPE_THEN `UNIV:real->bool` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "A"; EXPAND_TAC "B"; ASM_REWRITE_TAC[]; EXPAND_TAC "fA"; EXPAND_TAC "fB"; TYPE_THEN `!x. x <= a /\ b <= x <=> F` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC ; DISCH_THEN_REWRITE; TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC; UND 0; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; MESON_TAC[]; DISCH_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `A' = A UNION B` ABBREV_TAC ; TYPE_THEN `B' = {x | a <= x /\ x <= b}` ABBREV_TAC ; TYPE_THEN `fA' = subf A fA fB` ABBREV_TAC ; TYPE_THEN `metric_continuous (subf A' fA' f) (A' UNION B',d_real) (Y,dY)` SUBGOAL_TAC; IMATCH_MP_TAC subf_cont; TYPE_THEN `UNIV:real->bool` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "A'"; EXPAND_TAC "B'"; CONJ_TAC; IMATCH_MP_TAC closed_union; EXPAND_TAC "A"; EXPAND_TAC "B"; ASM_SIMP_TAC[top_of_metric_top]; ASM_REWRITE_TAC[interval_closed]; EXPAND_TAC "fA'"; EXPAND_TAC "A'"; EXPAND_TAC "A"; EXPAND_TAC "B"; REWRITE_TAC[UNION]; GEN_TAC ; DISCH_TAC; TYPE_THEN `(x = a) \/ (x = b)` SUBGOAL_TAC; UND 21; REAL_ARITH_TAC; EXPAND_TAC "fA"; EXPAND_TAC "fB"; DISCH_THEN DISJ_CASES_TAC; UND 22; DISCH_THEN_REWRITE; REWRITE_TAC[subf;REAL_ARITH `a <= a`]; UND 22; DISCH_THEN_REWRITE; REWRITE_TAC[subf]; TYPE_THEN `~(b <= a)` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; DISCH_THEN_REWRITE; DISCH_TAC; (* -- *) TYPE_THEN `A' UNION B' = UNIV` SUBGOAL_TAC; EXPAND_TAC "A'"; EXPAND_TAC "A"; EXPAND_TAC "B"; EXPAND_TAC "B'"; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `g = subf A' fA' f` ABBREV_TAC ; TYPE_THEN `!x. A x ==> (g x = f a)` SUBGOAL_TAC; EXPAND_TAC "g"; REWRITE_TAC[subf]; EXPAND_TAC "A'"; REWRITE_TAC[UNION]; GEN_TAC; DISCH_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "fA'"; REWRITE_TAC[subf]; ASM_REWRITE_TAC[]; EXPAND_TAC "fA"; REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `!x. B x ==> (g x = f b)` SUBGOAL_TAC; EXPAND_TAC "g"; REWRITE_TAC[subf]; EXPAND_TAC "A'"; REWRITE_TAC[UNION]; GEN_TAC; DISCH_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "fA'"; REWRITE_TAC[subf]; TYPE_THEN `~(A x)` SUBGOAL_TAC; UND 25; EXPAND_TAC "B"; EXPAND_TAC "A"; REWRITE_TAC[]; UND 3; REAL_ARITH_TAC; DISCH_THEN_REWRITE; EXPAND_TAC "fB"; REWRITE_TAC[]; DISCH_TAC; (* A *) TYPE_THEN `!x. B' x ==> (g x = f x)` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `A x` ASM_CASES_TAC; TYPE_THEN `A x /\ B' x ==> (x = a)` SUBGOAL_TAC; EXPAND_TAC "A"; EXPAND_TAC "B'"; REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; ASM_MESON_TAC[]; (* --2-- *) TYPE_THEN `B x` ASM_CASES_TAC; TYPE_THEN `B x /\ B' x ==> (x = b)` SUBGOAL_TAC; EXPAND_TAC "B"; EXPAND_TAC "B'"; REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; ASM_MESON_TAC[]; TYPE_THEN `~(A' x)` SUBGOAL_TAC; UND 27; UND 28; EXPAND_TAC "A'"; REWRITE_TAC[UNION]; MESON_TAC[]; EXPAND_TAC "g"; REWRITE_TAC[subf]; DISCH_THEN_REWRITE; DISCH_TAC; (* B start on goal *) TYPE_THEN `g` EXISTS_TAC; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC; UND 26; EXPAND_TAC "B'"; REWRITE_TAC[]; MESON_TAC[]; TYPE_THEN `IMAGE g UNIV SUBSET Y /\ metric_space (UNIV,d_real) /\ metric_space (Y,dY)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; UND 22; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); REWRITE_TAC[IMAGE_UNION;union_subset]; CONJ_TAC; EXPAND_TAC "A'"; REWRITE_TAC[IMAGE_UNION;union_subset]; UND 24; UND 25; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC; UND 0; EXPAND_TAC "B'"; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; MESON_TAC[]; MESON_TAC[]; UND 26; UND 0; EXPAND_TAC "B'"; REWRITE_TAC[IMAGE;SUBSET]; MESON_TAC[]; DISCH_TAC; COPY 27; (* C final KILL *) USE 28 (MATCH_MP metric_continuous_continuous); ASM_REWRITE_TAC[]; REWR 21; (* Wed Aug 11 12:37:40 EDT 2004 *) ]);; (* }}} *) let image_interval2 = prove_by_refinement( `!a b f. (a < b) /\ (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ f {x | a <= x /\ x <= b} UNIV) ==> (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\ (IMAGE f {x | a <= x /\ x <= b} = {x | c <= x /\ x <= d}) )`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?g. (continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real))) /\ (!x. (a <= x /\ x <= b) ==> (f x = g x))` SUBGOAL_TAC; IMATCH_MP_TAC cont_extend_real_lemma; ASM_REWRITE_TAC[metric_real]; REP_BASIC_TAC; TYPE_THEN `(a < b) /\ (continuous g (top_of_metric(UNIV,d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ g {x | a <= x /\ x <= b} UNIV)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `INJ g {x | a <= x /\ x <= b} UNIV= INJ f {x | a <= x /\ x <= b} UNIV` SUBGOAL_TAC; IMATCH_MP_TAC inj_domain_sub; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP image_interval t)); REP_BASIC_TAC; (* -- *) TYPE_THEN `c` EXISTS_TAC; TYPE_THEN `d` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `(f a = g a) /\ (f b = g b)` SUBGOAL_TAC; UND 3; UND 2; MESON_TAC[REAL_ARITH `(a < b) ==> (a<= a /\ a <= b /\ b <= b)`]; DISCH_THEN_REWRITE; USE 5 SYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC image_domain_sub; ASM_REWRITE_TAC[]; (* Wed Aug 11 12:51:52 EDT 2004 *) ]);; (* }}} *) let simple_arc_euclid = prove_by_refinement( `!C. (simple_arc top2 C ==> (C SUBSET (euclid 2)))`, (* {{{ proof *) [ REP_BASIC_TAC; USE 0 (MATCH_MP simple_arc_compact); RULE_ASSUM_TAC (REWRITE_RULE[compact;top2_unions]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let simple_arc_end_inj = prove_by_refinement( `!A B C v v'. (simple_arc_end A v v' /\ simple_arc_end B v v') /\ (simple_arc top2 C) /\ (A SUBSET C) /\ (B SUBSET C) ==> (A = B)`, (* {{{ proof *) [ (* A: *) REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; TYPE_THEN `simple_arc (top_of_metric(euclid 2,d_euclid)) C /\ (metric_space(euclid 2,d_euclid))` SUBGOAL_TAC; ASM_REWRITE_TAC[GSYM top2;metric_euclid]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_coord t)); REP_BASIC_TAC; (* push to reals *) TYPE_THEN `(IMAGE f'' A = IMAGE f'' B) <=> (A = B)` SUBGOAL_TAC; IMATCH_MP_TAC INJ_IMAGE ; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); (* -- *) TYPE_THEN `C SUBSET (euclid 2)` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_euclid; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `metric_space (C,d_euclid )` SUBGOAL_TAC; ASM_MESON_TAC[metric_subspace;metric_euclid]; DISCH_TAC; (* -- *) TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC; REWRITE_TAC[SUBSET_UNIV]; DISCH_TAC; (* -- *) TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC; IMATCH_MP_TAC metric_subspace; TYPE_THEN `UNIV:real->bool` EXISTS_TAC ; ASM_REWRITE_TAC[metric_real]; DISCH_TAC; (* -- *) (* -- *) TYPE_THEN `g = f'' o f` ABBREV_TAC ; TYPE_THEN `g'= f'' o f'` ABBREV_TAC ; TYPE_THEN `top_of_metric({x| &0 <= x /\ x <= &1},d_real) = induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM top_of_metric_induced); ASM_REWRITE_TAC[metric_real]; DISCH_TAC; (* -- *) TYPE_THEN `continuous f (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC; ASM_REWRITE_TAC[top2 ]; IMATCH_MP_TAC continuous_induced_domain; ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real]; DISCH_TAC; (* -- *) TYPE_THEN `continuous f' (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC; ASM_REWRITE_TAC[top2 ]; IMATCH_MP_TAC continuous_induced_domain; ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real]; DISCH_TAC; KILL 11; KILL 6; (* A *) TYPE_THEN `(&0 < &1) /\ (continuous g (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ g {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC; CONJ_TAC; REAL_ARITH_TAC; CONJ_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC continuous_comp; TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC; USE 22 GSYM; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM top_of_metric_unions]; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC; UND 1; ASM_REWRITE_TAC[]; IMATCH_MP_TAC continuous_range; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[GSYM top2]; ASM_SIMP_TAC[metric_euclid]; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); SUBCONJ_TAC; UND 1; ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; (* --2-- *) EXPAND_TAC "g"; IMATCH_MP_TAC (REWRITE_RULE[GSYM comp_comp] COMP_INJ); TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_subset; TYPE_THEN `(euclid 2)` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 1; ASM_REWRITE_TAC[]; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t)); REP_BASIC_TAC; (* -- *) ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM IMAGE_o]; ASM_REWRITE_TAC[]; (* B *) TYPE_THEN `(&0 < &1) /\ (continuous g' (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ g' {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC; CONJ_TAC; REAL_ARITH_TAC; CONJ_TAC; EXPAND_TAC "g'"; IMATCH_MP_TAC continuous_comp; TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC; USE 22 GSYM; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM top_of_metric_unions]; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC; UND 0; ASM_REWRITE_TAC[]; IMATCH_MP_TAC continuous_range; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[GSYM top2]; ASM_SIMP_TAC[metric_euclid]; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); SUBCONJ_TAC; UND 0; ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; (* --2-- *) EXPAND_TAC "g'"; IMATCH_MP_TAC (REWRITE_RULE[GSYM comp_comp] COMP_INJ); TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_subset; TYPE_THEN `(euclid 2)` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 0; ASM_REWRITE_TAC[]; DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t)); REP_BASIC_TAC; (* C final steps *) TYPE_THEN `(g (&0) = g'(&0)) /\ (g(&1) = g'(&1))` SUBGOAL_TAC; EXPAND_TAC "g"; EXPAND_TAC "g'"; REWRITE_TAC[o_DEF ]; ASM_REWRITE_TAC[]; DISCH_TAC; UND 11; ASM_REWRITE_TAC[]; (* temp *) DISCH_TAC; TYPE_THEN `(c = min_real (g'(&0)) (g'(&1))) /\ (d = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC; IMATCH_MP_TAC pair_order_endpoint; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `(c' = min_real (g'(&0)) (g'(&1))) /\ (d' = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC; IMATCH_MP_TAC pair_order_endpoint; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* Wed Aug 11 15:10:02 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_cut = prove_by_refinement( `!C v v' v''. simple_arc_end C v v' /\ (C v'') /\ ~(v'' = v) /\ ~(v'' = v') ==> (?C' C''. (simple_arc_end C' v v'') /\ (simple_arc_end C'' v'' v') /\ (C' INTER C'' = {v''}) /\ (C' UNION C'' = C))`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; (* -- INTER *) TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v''))` SUBGOAL_TAC; UND 2; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC; TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC; REP_BASIC_TAC; TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x <= &1} = IMAGE f ({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x <= &1})` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM inj_inter ); TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; TYPE_THEN `(euclid 2)` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; UND 9; UND 10; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `{x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x <= &1} = {t}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING]; UND 9; UND 10; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[image_sing]; ASM_REWRITE_TAC[]; (* A UNION *) REWRITE_TAC[GSYM IMAGE_UNION]; TYPE_THEN `{x | &0 <= x /\ x <= t} UNION {x | t <= x /\ x <= &1} = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;]; UND 9; UND 10; REAL_ARITH_TAC; DISCH_THEN_REWRITE; (* B FIRST piece *) CONJ_TAC; TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= t} (euclid 2) /\ &0 < &1 /\ &0 < t` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; UND 9; REAL_ARITH_TAC; TYPE_THEN `~(&0 = t)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; REWR 11; REWR 4; UND 10; REAL_ARITH_TAC; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* C LAST piece *) TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | t <= x /\ x <= &1} (euclid 2) /\ &0 < &1 /\ t < &1` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; UND 10; REAL_ARITH_TAC; TYPE_THEN `~( &1 = t)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; REWR 11; REWR 3; UND 9; REAL_ARITH_TAC; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* Wed Aug 11 15:54:37 EDT 2004 *) ]);; (* }}} *) let simple_closed_curve_pt = prove_by_refinement( `!C v. (simple_closed_curve top2 C /\ C v) ==> (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\ continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x < &1} (UNIONS top2) /\ (f (&0) = v) /\ (f (&0) = f (&1)))`, (* {{{ proof *) [ REWRITE_TAC[simple_closed_curve]; REP_BASIC_TAC; TYPE_THEN `f(&0) = v` ASM_CASES_TAC; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v))` SUBGOAL_TAC; UND 0; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `~(t = &0)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; REWR 9; REWR 6; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `~(t = &1)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `{x | t <= x /\ x <= &1} = {x | t <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING]; UND 7; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `INJ f {x | t <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC inj_split; CONJ_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC ; ASM_REWRITE_TAC[GSYM top2_unions]; REWRITE_TAC[SUBSET]; UND 8; REAL_ARITH_TAC; CONJ_TAC; REWRITE_TAC[INJ;INR IN_SING;]; USE 2 (REWRITE_RULE[top2_unions]); TYPE_THEN `euclid 2 (f (&0))` SUBGOAL_TAC; USE 2 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; MESON_TAC[]; REWRITE_TAC[EQ_EMPTY;IMAGE;INTER;image_sing;INR IN_SING;]; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "x''"); REP_GEN_TAC; REP_BASIC_TAC; TYPE_THEN `x' = &0` SUBGOAL_TAC; USE 2(REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 14; UND 8; REAL_ARITH_TAC; UND 14; UND 8; UND 9; REAL_ARITH_TAC; DISCH_TAC; (* [A] reparameter 1st part *) TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\ (INJ f {x | t <= x /\ x <= &1} (euclid 2)) /\ (&0 < &1/(&2)) /\ (t < &1)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF1]; UND 7; UND 10; REAL_ARITH_TAC; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; KILL 14; (* B 2nd part *) TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\ (INJ f {x | &0 <= x /\ x <= t} (euclid 2)) /\ (&1/(&2) < &1) /\ (&0 < t)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF2]; CONJ_TAC; USE 2(REWRITE_RULE[top2_unions]); IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x < &1} ` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET]; UND 7; UND 10; REAL_ARITH_TAC; UND 8; UND 9; REAL_ARITH_TAC; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; KILL 19; (* [C] JOIN functions *) TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC; TYPE_THEN `&0 < &1/(&2)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF1]; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `&1/(&2) < &1` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF2]; REAL_ARITH_TAC ; DISCH_TAC; (* -- *) TYPE_THEN `joinf g g' (&1/(&2)) (&0) = v` SUBGOAL_TAC; ASM_REWRITE_TAC[joinf]; ASM_MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `joinf g g' (&1/(&2)) (&1) = v` SUBGOAL_TAC; ASM_REWRITE_TAC[joinf]; ASM_SIMP_TAC[REAL_ARITH `(&1/ &2 < &1) ==> ~(&1 < (&1/(&2)))`]; ASM_MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `continuous (joinf g g' (&1 / &2)) (top_of_metric (UNIV,d_real)) top2` SUBGOAL_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC joinf_cont; ASM_REWRITE_TAC[GSYM top2]; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; (* [D] INJ *) TYPE_THEN `{x | &0 <= x /\ x < &1} = {x | &0 <= x /\ x < (&1/(&2))} UNION {x | (&1/(&2)) <= x /\ x < &1}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; ASM_REWRITE_TAC[UNION]; UND 24; UND 19; REAL_ARITH_TAC; DISCH_THEN_REWRITE; (* -- *) IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); REWRITE_TAC[top2_unions]; RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); CONJ_TAC; IMATCH_MP_TAC inj_split; TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = INJ g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; IMATCH_MP_TAC joinf_inj_below; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = INJ g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC; IMATCH_MP_TAC joinf_inj_above; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; DISCH_THEN_REWRITE ; CONJ_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &1/(&2) <= x /\ x <= &1}` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; (* --2-- E IMAGE *) REWRITE_TAC[EQ_EMPTY]; TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; IMATCH_MP_TAC joinf_image_below; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = IMAGE g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC; IMATCH_MP_TAC joinf_image_above; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[INTER]; GEN_TAC; REWRITE_TAC[IMAGE;]; DISCH_TAC; REP_BASIC_TAC; REWR 27; KILL 30; USE 13 (REWRITE_RULE[FUN_EQ_THM ]); TSPEC `g x'` 13; USE 13 (REWRITE_RULE[IMAGE]); TYPE_THEN `(?x. (&0 <= x /\ x <= &1 / &2) /\ (g x' = g x))` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`]; DISCH_TAC; REWR 13; KILL 30; REP_BASIC_TAC; USE 14 (REWRITE_RULE[FUN_EQ_THM;]); TSPEC `g' x''` 14; USE 14 (REWRITE_RULE[IMAGE]); TYPE_THEN `(?x. (&1 / &2 <= x /\ x <= &1) /\ (g' x'' = g' x))` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`]; DISCH_TAC; REWR 14; KILL 34; REP_BASIC_TAC; TYPE_THEN `(x = x''')` SUBGOAL_TAC; USE 2 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `~(x = &0)` SUBGOAL_TAC; DISCH_TAC; TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC; USE 17(REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 31; UND 24; UND 19; REAL_ARITH_TAC; UND 31; REAL_ARITH_TAC; TYPE_THEN `~(x = &1)` SUBGOAL_TAC; DISCH_TAC; TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC; USE 17(REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 31; UND 24; UND 19; REAL_ARITH_TAC; UND 31; REAL_ARITH_TAC; UND 34; UND 7; UND 10; UND 33; UND 8; UND 9; UND 30; REAL_ARITH_TAC; DISCH_TAC; (* --2-- *) TYPE_THEN `x = t` SUBGOAL_TAC; UND 36; UND 35; UND 34; UND 33; UND 30; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `g' (&1) = g'(x'')` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `&1 = x''` SUBGOAL_TAC; USE 22(REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 28; UND 24; UND 19; REAL_ARITH_TAC; UND 28; REAL_ARITH_TAC; (* F IMAGE *) TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION ]; UND 24; UND 19; REAL_ARITH_TAC; DISCH_TAC; TYPEL_THEN [`joinf g g' (&1/(&2))`;`{x | &0 <= x /\ x < &1/(&2)}`;`{x | &1/(&2) <= x /\ x <= &1}`] (fun t-> ASSUME_TAC (ISPECL t IMAGE_UNION )); ASM_REWRITE_TAC[]; USE 27 SYM; ASM_REWRITE_TAC[]; TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; IMATCH_MP_TAC joinf_image_below; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC; IMATCH_MP_TAC joinf_image_above; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_THEN_REWRITE; USE 14 GSYM ; ASM_REWRITE_TAC[]; (* F final *) TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING]; REAL_ARITH_TAC; DISCH_TAC ; (* -- *) TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= &1} = IMAGE f {x | &0 <= x /\ x < &1}` SUBGOAL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE_UNION;image_sing; ]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[union_subset;SUBSET_REFL]; REWRITE_TAC[SUBSET;INR IN_SING;]; GEN_TAC; DISCH_THEN_REWRITE; UND 1; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); REWRITE_TAC[IMAGE]; TYPE_THEN `&0` EXISTS_TAC; REWRITE_TAC[]; REAL_ARITH_TAC; REWRITE_TAC[SUBSET_UNION]; DISCH_TAC; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1/(&2)} = IMAGE f {x | t <= x /\ x < &1}` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1} DELETE (f (&1))` EXISTS_TAC; CONJ_TAC; ASM_REWRITE_TAC[SUBSET_DELETE]; CONJ_TAC; REWRITE_TAC[IMAGE;]; REP_BASIC_TAC; TYPE_THEN `x = (&1/(&2))` SUBGOAL_TAC; USE 17(REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 32; UND 19; REAL_ARITH_TAC; UND 32; REAL_ARITH_TAC; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; REWRITE_TAC[DELETE;IMAGE;SUBSET;]; REWRITE_TAC[REAL_ARITH `x <= &1 <=> (x < &1 \/ (x = &1))`]; MESON_TAC[]; (* --2--*) IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)} DELETE (g (&1/(&2)))` EXISTS_TAC; CONJ_TAC; USE 13 GSYM; USE 15 GSYM; ASM_REWRITE_TAC[SUBSET_DELETE]; CONJ_TAC; REWRITE_TAC[IMAGE;]; REP_BASIC_TAC; TYPE_THEN `&1 = x` SUBGOAL_TAC; USE 12(REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 32; REAL_ARITH_TAC; UND 32; REAL_ARITH_TAC; USE 11 SYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; REWRITE_TAC[DELETE;IMAGE;SUBSET;]; REWRITE_TAC[REAL_ARITH `x <= &1/(&2) <=> (x < &1/(&2) \/ (x = &1/(&2)))`]; MESON_TAC[]; DISCH_THEN_REWRITE; (* G *) REWRITE_TAC[GSYM IMAGE_UNION]; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UND 8; UND 7; UND 10; REAL_ARITH_TAC; (* -- World's worst proof *) (* Thu Aug 12 07:44:29 EDT 2004 *) ]);; (* }}} *) let shift_inj = prove_by_refinement( `!(f:real->A) X t. (INJ f {x | &0 <= x /\ x < &1} X) /\ (f (&0) = f(&1)) /\ (&0 < t) ==> INJ f {x | t <= x /\ x <= &1} X`, (* {{{ proof *) [ REWRITE_TAC[INJ]; REP_BASIC_TAC; CONJ_TAC; REP_BASIC_TAC; TYPE_THEN `x < &1` ASM_CASES_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 5; UND 0; REAL_ARITH_TAC; TYPE_THEN `x = &1` SUBGOAL_TAC; UND 4; UND 6; REAL_ARITH_TAC; DISCH_THEN_REWRITE; USE 1 GSYM; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; REAL_ARITH_TAC; REP_BASIC_TAC; (* -- *) TYPE_THEN `((x = &1) /\ (y = &1)) \/ ((x < &1) /\ (y = &1)) \/ ((x = &1) /\ (y < &1)) \/ ((x < &1) /\ (y < &1))` SUBGOAL_TAC; UND 5; UND 7; REAL_ARITH_TAC; REP_CASES_TAC; ASM_REWRITE_TAC[]; USE 1 SYM ; REWR 4; TYPE_THEN `x = &0` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 8; UND 0; REAL_ARITH_TAC; UND 8; UND 0; REAL_ARITH_TAC; USE 1 SYM; REWR 4; TYPE_THEN `y = &0` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 6; UND 0; REAL_ARITH_TAC; UND 6; UND 0; REAL_ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 6; UND 8; UND 0; REAL_ARITH_TAC; (* Thu Aug 12 08:33:16 EDT 2004 *) ]);; (* }}} *) let simple_arc_segment = prove_by_refinement( `!f u v. continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x < &1} (euclid 2) /\ (f (&0) = f (&1)) /\ (&0 <= u /\ u < v /\ v <= &1 /\ (&0 < u \/ v < &1)) ==> simple_arc_end (IMAGE f {x | u <= x /\ x <= v}) (f u) (f v)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[simple_arc_end]; (* -- *) TYPE_THEN `(&0 < u) ==> INJ f { x | u <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC ; DISCH_TAC; IMATCH_MP_TAC shift_inj; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `INJ f { x | u <= x /\ x <= v } (euclid 2)` SUBGOAL_TAC; UND 0; DISCH_THEN DISJ_CASES_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | u <= x /\ x <= &1}` EXISTS_TAC; REWR 7; ASM_REWRITE_TAC[SUBSET ]; UND 1; REAL_ARITH_TAC; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; UND 0; UND 3; REAL_ARITH_TAC; DISCH_TAC; (* -- *) TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | u <= x /\ x <= v} (euclid 2) /\ &0 < &1 /\ u < v` SUBGOAL_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); REP_BASIC_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Thu Aug 12 08:55:11 EDT 2004 *) ]);; (* }}} *) let simple_closed_cut = prove_by_refinement( `!C v v'. (simple_closed_curve top2 C /\ C v /\ C v' /\ ~(v = v') ==> (?C' C''. simple_arc_end C' v v' /\ simple_arc_end C'' v v' /\ ( C' UNION C'' = C) /\ (C' INTER C'' = {v,v'})))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `simple_closed_curve top2 C /\ C v` SUBGOAL_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_closed_curve_pt t)); REP_BASIC_TAC; (* -- *) TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f(t) = v'))` SUBGOAL_TAC; UND 1; ASM_REWRITE_TAC[IMAGE]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `t < &1` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `~( t= &1) /\ (t <= &1) ==> (t < &1)`); ASM_REWRITE_TAC[]; DISCH_TAC; REWR 9; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `&0 < t` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `~(t = &0) /\ (&0 <= t) ==> (&0 < t)`); ASM_REWRITE_TAC[]; DISCH_TAC; REWR 9; DISCH_TAC; (* -- *) TYPE_THEN `C' = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ; TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `C''` EXISTS_TAC; CONJ_TAC; EXPAND_TAC "C'"; EXPAND_TAC "v"; EXPAND_TAC "v'"; IMATCH_MP_TAC simple_arc_segment; RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_ARITH `x <= x`]; (* -- *) CONJ_TAC; USE 5 SYM; ASM_REWRITE_TAC[]; EXPAND_TAC "C''"; EXPAND_TAC "v'"; IMATCH_MP_TAC simple_arc_end_symm; IMATCH_MP_TAC simple_arc_segment; RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* -- *) CONJ_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "C'"; EXPAND_TAC "C''"; REWRITE_TAC[GSYM IMAGE_UNION]; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UND 13; UND 12; REAL_ARITH_TAC; (* -- *) TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x < &1} UNION IMAGE f {(&1)}` SUBGOAL_TAC; REWRITE_TAC[GSYM IMAGE_UNION]; EXPAND_TAC "C''"; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING ]; UND 12; REAL_ARITH_TAC; DISCH_THEN_REWRITE; (* -- *) REWRITE_TAC[UNION_OVER_INTER;image_sing]; EXPAND_TAC "C'"; TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x < &1})) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x < &1})` SUBGOAL_TAC; IMATCH_MP_TAC inj_inter; TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC; TYPE_THEN `(UNIONS top2)` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; UND 12; UND 13; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); (* -- *) TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x < &1}) = {t}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING]; UND 13; UND 12; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `{(f (&1))} = IMAGE f {(&0)}` SUBGOAL_TAC; REWRITE_TAC[image_sing]; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER {(&0)}) ) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {(&0)} )` SUBGOAL_TAC; IMATCH_MP_TAC inj_inter; TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC; TYPE_THEN `UNIONS top2` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;INR IN_SING]; UND 12; UND 13; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); (* -- *) TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {(&0)}) = {(&0)}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING ]; UND 11; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[image_sing]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[in_pair]; REWRITE_TAC[UNION;INR IN_SING]; ASM_MESON_TAC[]; (* Thu Aug 12 09:35:48 EDT 2004 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION M *) (* ------------------------------------------------------------------ *) let closed_point = prove_by_refinement( `!x. (euclid 2 x) ==> (closed_ top2 {x})`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC compact_closed; REWRITE_TAC[top2_top]; ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid]; IMATCH_MP_TAC compact_point; ASM_REWRITE_TAC[GSYM top2;top2_unions]; (* Fri Aug 13 08:42:22 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_closed = prove_by_refinement( `!C v v'. (simple_arc_end C v v' ==> closed_ top2 C) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC compact_closed; REWRITE_TAC[top2_top]; ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid]; REWRITE_TAC [GSYM top2]; IMATCH_MP_TAC simple_arc_compact; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; (* Fri Aug 13 09:33:35 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_end = prove_by_refinement( `!C v v'. (simple_arc_end C v v' ==> C v)`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "v"; REWRITE_TAC[IMAGE;]; TYPE_THEN `&0` EXISTS_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* Fri Aug 13 09:40:59 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_end2 = prove_by_refinement( `!C v v'. (simple_arc_end C v v' ==> C v')`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "v'"; REWRITE_TAC[IMAGE;]; TYPE_THEN `&1` EXISTS_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* Fri Aug 13 09:42:07 EDT 2004 *) ]);; (* }}} *) let simple_arc_end_end_closed = prove_by_refinement( `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v}`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC closed_point; TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; TYPE_THEN `C v` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; MESON_TAC[ISUBSET]; ]);; (* }}} *) let simple_arc_end_end_closed2 = prove_by_refinement( `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v'}`, (* {{{ proof *) [ ASM_MESON_TAC[simple_arc_end_end_closed;simple_arc_end_symm;]; ]);; (* }}} *) let simple_arc_sep3 = prove_by_refinement( `!A C1 C2 C3 x p1 p2 p3. (C1 UNION C2 UNION C3 SUBSET A) /\ (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\ (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\ (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==> (?x' C1' C2' C3'. (C1' UNION C2' UNION C3' SUBSET A) /\ (simple_arc_end C1' x' p1) /\ (simple_arc_end C2' x' p2) /\ (simple_arc_end C3' x' p3) /\ ~(C2' p3) /\ ~(C3' p2) /\ (C1' INTER C2' = {x'} ) /\ (C1' INTER C3' = {x'} )) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `K = C2 UNION C3` ABBREV_TAC ; TYPE_THEN `~((C1 INTER K) = EMPTY)` SUBGOAL_TAC; EXPAND_TAC "K"; REWRITE_TAC[EMPTY_EXISTS;INTER ]; REWRITE_TAC[UNION]; TYPE_THEN `x` EXISTS_TAC; ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; DISCH_TAC; (* -- *) TYPE_THEN `closed_ top2 K` SUBGOAL_TAC; EXPAND_TAC "K"; IMATCH_MP_TAC closed_union; ASM_MESON_TAC[simple_arc_end_closed;top2_top]; DISCH_TAC; (* -- *) TYPE_THEN `~((C1 INTER {p1}) = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[INTER;EMPTY_EXISTS;INR IN_SING]; ASM_MESON_TAC[simple_arc_end_end2]; DISCH_TAC; (* -- *) TYPE_THEN `(?C1' x' v'. C1' SUBSET C1 /\ simple_arc_end C1' x' v' /\ (C1' INTER K = {x'}) /\ (C1' INTER {p1} = {v'}))` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_restriction; ASM_REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING ]; CONJ_TAC; ASM_MESON_TAC[simple_arc_end_simple]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_end_closed2; ASM_MESON_TAC[]; CONV_TAC (dropq_conv "x"); REWRITE_TAC[DE_MORGAN_THM]; DISJ2_TAC; EXPAND_TAC "K"; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* -- *) TYPE_THEN `v' = p1` SUBGOAL_TAC; USE 14 (REWRITE_RULE[FUN_EQ_THM]); USE 14 (REWRITE_RULE[INTER;INR IN_SING]); ASM_MESON_TAC[]; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); KILL 14; (* -- *) (* [A] case x' = x *) TYPE_THEN `x' = x` ASM_CASES_TAC; UND 14; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `C1` EXISTS_TAC; TYPE_THEN `C2` EXISTS_TAC; TYPE_THEN `C3` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `C1' = C1` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `C1` EXISTS_TAC; TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `p1` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL ]; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); (* --2-- *) CONJ_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER;INR IN_SING]; EQ_TAC; USE 15 (REWRITE_RULE[FUN_EQ_THM;]); USE 14 (REWRITE_RULE[INTER;INR IN_SING]); UND 14; EXPAND_TAC "K"; REWRITE_TAC[UNION]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_MESON_TAC[simple_arc_end_end]; (* --2'-- *) IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER;INR IN_SING]; EQ_TAC; USE 15 (REWRITE_RULE[FUN_EQ_THM;]); USE 14 (REWRITE_RULE[INTER;INR IN_SING]); UND 14; EXPAND_TAC "K"; REWRITE_TAC[UNION]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_MESON_TAC[simple_arc_end_end]; (* B cut C1 at- x' *) TYPE_THEN `~(x' = p1)` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_distinct]; DISCH_TAC; (* -- *) TYPE_THEN `C1' x'` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `simple_arc_end C1 x p1 /\ C1 x' /\ ~(x' = x) /\ ~(x' = p1)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; UND 17; UND 19; MESON_TAC[ISUBSET]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); REP_BASIC_TAC; (* -- *) TYPE_THEN `C'' = C1'` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `C1` EXISTS_TAC; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `p1` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; UND 20; SET_TAC[UNION;SUBSET]; DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); (* -- *) TYPE_THEN `C1 x'` SUBGOAL_TAC; UND 19; UND 17; MESON_TAC[ISUBSET]; DISCH_TAC; (* -- *) TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `C1'` EXISTS_TAC; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[union_subset]; TYPE_THEN `C1' SUBSET A` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1 UNION K ` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_UNION]; DISCH_THEN_REWRITE; (* [C] C2 x' *) (* ------- *) TYPE_THEN `C2 x'` ASM_CASES_TAC; TYPE_THEN `simple_arc_end C2 x p2 /\ C2 x' /\ ~(x' = x) /\ ~(x' = p2)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); REP_BASIC_TAC; TYPE_THEN `C2' = C''''` ABBREV_TAC ; KILL 30; (*---- *) TYPE_THEN `C2'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `C2' SUBSET C2` SUBGOAL_TAC; USE 26 ( (REWRITE_RULE[FUN_EQ_THM])); USE 26 (REWRITE_RULE[UNION]); UND 26; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `~C2' p3` SUBGOAL_TAC; UND 30; UND 3; MESON_TAC[ISUBSET]; DISCH_THEN_REWRITE; ONCE_REWRITE_TAC [union_subset]; TYPE_THEN `C2' SUBSET A` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1 UNION K` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C2` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "K"; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `C1' INTER C2' = {x'}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING]; GEN_TAC; EQ_TAC; UND 15; UND 30; EXPAND_TAC "K"; REWRITE_TAC [eq_sing]; REWRITE_TAC[INTER;UNION;SUBSET]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end]; DISCH_THEN_REWRITE; (* --[C2]-- branch again for C3 x' -- *) TYPE_THEN `C3 x'` ASM_CASES_TAC; TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); REP_BASIC_TAC; TYPE_THEN `C3' = C''''''` ABBREV_TAC ; KILL 36; TYPE_THEN `C3'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC; UND 32; SET_TAC[UNION;SUBSET]; DISCH_TAC; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1 UNION K` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "K"; UND 36; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; CONJ_TAC; UND 36; UND 0; MESON_TAC[ISUBSET]; TYPE_THEN `C3' x'` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; DISCH_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING]; GEN_TAC; EQ_TAC; UND 15; UND 36; EXPAND_TAC "K"; REWRITE_TAC[eq_sing ]; REWRITE_TAC[UNION;SUBSET;INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; (* --[C2']-- now C3 doesn't meet x'. This will be repeated for C2 *) (* -- cut C' from {x'} to FIRST point on C3 -- *) TYPEL_THEN [`C'`;`{x'}`;`C3`] (fun t-> MP_TAC (ISPECL t simple_arc_end_restriction)); DISCH_THEN ANT_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_end_closed; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_closed; ASM_MESON_TAC[]; CONJ_TAC; UND 31; REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING]; MESON_TAC[]; CONJ_TAC; REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[INTER;INR IN_SING]; USE 23 (MATCH_MP simple_arc_end_end2); UND 23; MESON_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[INTER;INR IN_SING]; USE 23 (MATCH_MP simple_arc_end_end); UND 23; USE 2 (MATCH_MP simple_arc_end_end); UND 2; MESON_TAC[]; REP_BASIC_TAC; (* ---[a] *) TYPE_THEN `C3a = C'''''` ABBREV_TAC ; KILL 36; TYPE_THEN `v = x'` SUBGOAL_TAC; USE 33(REWRITE_RULE[FUN_EQ_THM]); USE 33(REWRITE_RULE[INTER;INR IN_SING]); UND 33; MESON_TAC[]; DISCH_THEN (fun t -> (RULE_ASSUM_TAC (REWRITE_RULE[t]))); KILL 33; TYPE_THEN `C3a SUBSET C1` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 20; SET_TAC[UNION;SUBSET]; DISCH_TAC; TYPE_THEN `C3a SUBSET A /\ simple_arc_end C3a x' v'' /\ ~(C3a p2) /\ (C1' INTER C3a = {(x')}) /\ (C3 INTER C3a = {(v'')}) /\ (~C3a p3)` SUBGOAL_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1 UNION K` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1` EXISTS_TAC; REWRITE_TAC[SUBSET_UNION]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL ]; CONJ_TAC; UND 7; UND 33; MESON_TAC[ISUBSET]; CONJ_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INR IN_SING]; EQ_TAC; UND 21; UND 35; REWRITE_TAC[eq_sing]; REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end]; (* --- *) CONJ_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INR IN_SING]; EQ_TAC; UND 32; REWRITE_TAC[eq_sing]; REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; UND 32; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER]; MESON_TAC[]; UND 35; USE 20 (REWRITE_RULE[FUN_EQ_THM]); USE 20 (REWRITE_RULE[UNION]); UND 20; UND 6; MESON_TAC [ISUBSET]; KILL 32; KILL 33; KILL 34; KILL 31; REP_BASIC_TAC; (* --[b] *) TYPE_THEN `(v'' = x)` ASM_CASES_TAC; FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); TYPE_THEN `C3 UNION C3a` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; ONCE_REWRITE_TAC[union_subset]; ASM_REWRITE_TAC[]; UND 9; EXPAND_TAC "K"; REWRITE_TAC[union_subset]; MESON_TAC[]; (* --- *) CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; CONJ_TAC; REWRITE_TAC[UNION;DE_MORGAN_THM]; ASM_REWRITE_TAC[]; (* --- *) IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;UNION;INR IN_SING]; GEN_TAC; EQ_TAC ; REWRITE_TAC[LEFT_AND_OVER_OR]; DISCH_THEN DISJ_CASES_TAC; UND 39; UND 15; EXPAND_TAC "K"; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER;UNION]; MESON_TAC[]; UND 39; UND 33; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; UND 33; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; (* -- *) (* --[c] cut off C3b at- v'' *) TYPEL_THEN [`C3`;`x`;`p3`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut)); DISCH_THEN ANT_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; UND 32; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; PROOF_BY_CONTR_TAC; USE 39 (REWRITE_RULE[]); FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); UND 31; REWRITE_TAC[]; UND 32; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `C3b = C'''''''` ABBREV_TAC ; KILL 43; TYPE_THEN `C3b SUBSET C3` SUBGOAL_TAC; UND 39; SET_TAC[UNION;SUBSET]; DISCH_TAC; (* -- [d] EXISTS_TAC *) TYPE_THEN `C3a UNION C3b` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS ; TYPE_THEN `C1 UNION K` EXISTS_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_union_pair; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 20; SET_TAC[UNION;SUBSET]; EXPAND_TAC "K"; UND 43; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; (* -- *) CONJ_TAC; IMATCH_MP_TAC simple_arc_end_trans; (* IMATCH_MP_TAC SUBSET_TRANS; *) TYPE_THEN `v''` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 43; UND 32; UND 40; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER;SUBSET]; MESON_TAC[]; (* -- *) CONJ_TAC; REWRITE_TAC[UNION;DE_MORGAN_THM]; ASM_REWRITE_TAC[]; UND 43; UND 0; MESON_TAC[ISUBSET]; IMATCH_MP_TAC EQ_EXT ; REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR]; GEN_TAC; EQ_TAC; DISCH_THEN DISJ_CASES_TAC; FIRST_ASSUM MP_TAC; UND 21; UND 33; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER]; MESON_TAC[]; FIRST_ASSUM MP_TAC; UND 43; UND 15; EXPAND_TAC "K"; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER;UNION;SUBSET]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISJ1_TAC; UND 36; MESON_TAC[simple_arc_end_end]; (* D *) TYPE_THEN `C3 x'` SUBGOAL_TAC; UND 25; UND 15; REWRITE_TAC[eq_sing]; EXPAND_TAC "K"; REWRITE_TAC[INTER;UNION]; MESON_TAC[]; DISCH_TAC; (* [E] back to ONE goal *) (* TYPE_THEN `C3 x'` ASM_CASES_TAC; *) TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); REP_BASIC_TAC; TYPE_THEN `C3' = C''''` ABBREV_TAC ; KILL 31; (*---- *) LEFT_TAC "C3'"; USE 10 (ONCE_REWRITE_RULE[UNION_COMM]); TYPE_THEN `C3'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC; USE 27 ( (REWRITE_RULE[FUN_EQ_THM])); USE 27 (REWRITE_RULE[UNION]); UND 27; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `~C3' p2` SUBGOAL_TAC; UND 31; UND 0; MESON_TAC[ISUBSET]; DISCH_THEN_REWRITE; ONCE_REWRITE_TAC [union_subset]; TYPE_THEN `C3' SUBSET A` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1 UNION K` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C3` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "K"; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `C1' INTER C3' = {x'}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING]; GEN_TAC; EQ_TAC; UND 15; UND 31; EXPAND_TAC "K"; REWRITE_TAC [eq_sing]; REWRITE_TAC[INTER;UNION;SUBSET]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end]; DISCH_THEN_REWRITE; (* --[XC2]-- now C2 doesn't meet x'. This is repeat. *) (* -- cut C' from {x'} to FIRST point on C2 -- *) TYPEL_THEN [`C'`;`{x'}`;`C2`] (fun t-> MP_TAC (ISPECL t simple_arc_end_restriction)); DISCH_THEN ANT_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_end_closed; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_closed; ASM_MESON_TAC[]; CONJ_TAC; UND 25; REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING]; MESON_TAC[]; CONJ_TAC; REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[INTER;INR IN_SING]; USE 23 (MATCH_MP simple_arc_end_end2); UND 23; MESON_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[INTER;INR IN_SING]; USE 23 (MATCH_MP simple_arc_end_end); UND 23; USE 5 (MATCH_MP simple_arc_end_end); UND 5; MESON_TAC[]; REP_BASIC_TAC; (* ---[Xa] *) TYPE_THEN `C2a = C'''''` ABBREV_TAC ; KILL 36; TYPE_THEN `v = x'` SUBGOAL_TAC; USE 33(REWRITE_RULE[FUN_EQ_THM]); USE 33(REWRITE_RULE[INTER;INR IN_SING]); UND 33; MESON_TAC[]; DISCH_THEN (fun t -> (RULE_ASSUM_TAC (REWRITE_RULE[t]))); KILL 33; TYPE_THEN `C2a SUBSET C1` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 20; SET_TAC[UNION;SUBSET]; DISCH_TAC; TYPE_THEN `C2a SUBSET A /\ simple_arc_end C2a x' v'' /\ ~(C2a p3) /\ (C1' INTER C2a = {(x')}) /\ (C2 INTER C2a = {(v'')}) /\ (~C2a p2)` SUBGOAL_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1 UNION K` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1` EXISTS_TAC; REWRITE_TAC[SUBSET_UNION]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL ]; CONJ_TAC; UND 6; UND 33; MESON_TAC[ISUBSET]; CONJ_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INR IN_SING]; EQ_TAC; UND 21; UND 35; REWRITE_TAC[eq_sing]; REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end]; (* --- *) CONJ_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INR IN_SING]; EQ_TAC; UND 32; REWRITE_TAC[eq_sing]; REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; UND 32; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER]; MESON_TAC[]; UND 35; USE 20 (REWRITE_RULE[FUN_EQ_THM]); USE 20 (REWRITE_RULE[UNION]); UND 20; UND 7; MESON_TAC [ISUBSET]; KILL 32; KILL 33; KILL 34; KILL 35; (* attention *) REP_BASIC_TAC; (* --[Xb] *) TYPE_THEN `(v'' = x)` ASM_CASES_TAC; FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); TYPE_THEN `C2 UNION C2a` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; ONCE_REWRITE_TAC[union_subset]; ASM_REWRITE_TAC[]; UND 9; EXPAND_TAC "K"; REWRITE_TAC[union_subset]; MESON_TAC[]; (* --- *) CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; CONJ_TAC; REWRITE_TAC[UNION;DE_MORGAN_THM]; ASM_REWRITE_TAC[]; (* --- *) IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;UNION;INR IN_SING]; GEN_TAC; EQ_TAC ; REWRITE_TAC[LEFT_AND_OVER_OR]; DISCH_THEN DISJ_CASES_TAC; UND 39; UND 15; EXPAND_TAC "K"; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER;UNION]; MESON_TAC[]; UND 39; UND 34; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; UND 34; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; (* -- *) (* --[Xc] cut off C3b at- v'' *) TYPEL_THEN [`C2`;`x`;`p2`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut)); DISCH_THEN ANT_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; UND 33; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; PROOF_BY_CONTR_TAC; USE 39 (REWRITE_RULE[]); FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); UND 32; REWRITE_TAC[]; UND 33; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `C2b = C''''''` ABBREV_TAC ; KILL 43; TYPE_THEN `C2b SUBSET C2` SUBGOAL_TAC; UND 39; SET_TAC[UNION;SUBSET]; DISCH_TAC; (* -- [Xd] EXISTS_TAC *) TYPE_THEN `C2a UNION C2b` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; REWRITE_TAC[union_subset ]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS ; TYPE_THEN `C1 UNION K` EXISTS_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C2` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "K"; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; (* -- *) CONJ_TAC; IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `v''` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 43; UND 33; UND 40; REWRITE_TAC[eq_sing ]; REWRITE_TAC[INTER;SUBSET]; MESON_TAC[]; (* -- *) CONJ_TAC; REWRITE_TAC[UNION;DE_MORGAN_THM]; ASM_REWRITE_TAC[]; UND 43; UND 3; MESON_TAC[ISUBSET]; IMATCH_MP_TAC EQ_EXT ; REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR]; GEN_TAC; EQ_TAC; DISCH_THEN DISJ_CASES_TAC; FIRST_ASSUM MP_TAC; UND 21; UND 34; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER]; MESON_TAC[]; FIRST_ASSUM MP_TAC; UND 43; UND 15; EXPAND_TAC "K"; REWRITE_TAC[eq_sing]; REWRITE_TAC[INTER;UNION;SUBSET]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISJ1_TAC; UND 36; MESON_TAC[simple_arc_end_end]; (* Fri Aug 13 17:43:15 EDT 2004 *) ]);; (* }}} *) let simple_arc_sep2 = prove_by_refinement( `!A C1 C2 C3 x p1 p2 p3. ( C1 UNION C2 UNION C3 SUBSET A /\ (simple_arc_end C1 x p1) /\ (simple_arc_end C2 x p2) /\ (simple_arc_end C3 x p3) /\ (C1 INTER C2 = {x}) /\ (C1 INTER C3 = {x}) /\ ~(C2 p3) /\ ~(C3 p2)) ==> (?x' C1' C2' C3'. (C1' UNION C2' UNION C3' SUBSET A) /\ (simple_arc_end C1' x' p1) /\ (simple_arc_end C2' x' p2) /\ (simple_arc_end C3' x' p3) /\ (C1' INTER C2' = {x'}) /\ (C2' INTER C3' = {x'}) /\ (C3' INTER C1' = {x'}) )`, (* {{{ proof *) [ REP_BASIC_TAC; TYPEL_THEN[`C2`;`C3`;`{p2}`] (fun t -> ANT_TAC (ISPECL t simple_arc_end_restriction)); CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_closed; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_end_closed; TYPE_THEN `C2` EXISTS_TAC; TYPE_THEN `x` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_MESON_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING]; TYPE_THEN `C2 p2` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end2]; TYPE_THEN `C2 x` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; TYPE_THEN `C3 x` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `v' = p2` SUBGOAL_TAC; UND 8; REWRITE_TAC[eq_sing; INR IN_SING;]; REWRITE_TAC[INTER;INR IN_SING ]; MESON_TAC[]; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); KILL 8; TYPE_THEN `v` EXISTS_TAC; LEFT_TAC "C2'"; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* A easy case *) TYPE_THEN `v = x` ASM_CASES_TAC; FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]); TYPE_THEN `C' = C2` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `C2` EXISTS_TAC; TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `p2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET_REFL]; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]); TYPE_THEN `C1` EXISTS_TAC; TYPE_THEN `C3` EXISTS_TAC; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC [INTER_COMM]; ASM_REWRITE_TAC[]; (* [B] general case *) TYPEL_THEN [`C3`;`x`;`p3`;`v`] (fun t-> ANT_TAC (ISPECL t simple_arc_end_cut)); ASM_REWRITE_TAC[]; CONJ_TAC; UND 9; REWRITE_TAC[eq_sing;INTER]; MESON_TAC[]; DISCH_TAC; FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); TYPE_THEN `C' p3` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; UND 1; UND 11; REWRITE_TAC[SUBSET]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `C1 UNION C''` EXISTS_TAC; TYPE_THEN `C'''` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(C1 UNION C'') UNION C' UNION C''' = C1 UNION C' UNION (C'' UNION C''')` SUBGOAL_TAC; SET_TAC[UNION]; DISCH_THEN_REWRITE; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C1 UNION C2 UNION C3` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_union_pair ; REWRITE_TAC[SUBSET_REFL]; IMATCH_MP_TAC subset_union_pair ; ASM_REWRITE_TAC[SUBSET_REFL]; (* -- *) CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING ]; GEN_TAC; EQ_TAC ; UND 2; TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC; UND 12; SET_TAC [SUBSET;UNION]; REWRITE_TAC[eq_sing;INTER;SUBSET]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; (* --[a] *) TYPE_THEN `(C1 UNION C'') v /\ (C' v) /\ (C''' v)` SUBGOAL_TAC; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; CONJ_TAC; DISJ2_TAC; ASM_MESON_TAC[simple_arc_end_end2]; ASM_MESON_TAC[simple_arc_end_end;]; DISCH_TAC; (* -- *) TYPE_THEN `C''' SUBSET C3` SUBGOAL_TAC; UND 12; SET_TAC[UNION;SUBSET]; DISCH_TAC; TYPE_THEN `C' INTER C''' = {v}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING]; GEN_TAC; EQ_TAC; UND 17; UND 9; REWRITE_TAC[eq_sing;SUBSET;INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[INTER;]; DISCH_THEN_REWRITE; (* -- *) TYPEL_THEN [`C2`;`p2`;`x`;`v`] (fun t-> ANT_TAC(ISPECL t simple_arc_end_cut)); ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; CONJ_TAC; UND 11; REP_BASIC_TAC; UND 11; UND 18; MESON_TAC[ISUBSET]; IMATCH_MP_TAC simple_arc_end_distinct; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* -- *) TYPE_THEN `C'''' = C'` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `C2` EXISTS_TAC; TYPE_THEN `p2` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; UND 16; SET_TAC[UNION;SUBSET]; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); (* -- *) TYPE_THEN `~C' x` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; REWR 24; TYPE_THEN `C''''' x` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end2]; UND 8; UND 18; UND 24; REWRITE_TAC[eq_sing;INTER;]; MESON_TAC[]; DISCH_TAC; (* -- *) KILL 7; KILL 6; KILL 5; KILL 4; TYPE_THEN `C'' x` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; DISCH_TAC; KILL 15; KILL 14; KILL 20; KILL 19; (* --[b] *) CONJ_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INTER;INR IN_SING]; GEN_TAC; EQ_TAC; TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC; UND 12; SET_TAC[UNION;SUBSET]; UND 2; UND 3; UND 11; UND 24; UND 9; REWRITE_TAC[SUBSET;INTER;eq_sing]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; UND 13; REWRITE_TAC[eq_sing;INTER]; MESON_TAC[]; (* -- *) TYPE_THEN `~ (C''' x)` SUBGOAL_TAC; DISCH_TAC; UND 13; UND 5; UND 4; UND 8; REWRITE_TAC[eq_sing;INTER;]; MESON_TAC[]; DISCH_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;UNION;INR IN_SING]; GEN_TAC; EQ_TAC ; UND 13; UND 2; UND 17; UND 5; REWRITE_TAC[SUBSET;INTER;eq_sing]; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; UND 23; REWRITE_TAC[UNION]; (* Fri Aug 13 20:36:09 EDT 2004 *) ]);; (* }}} *) let simple_arc_sep = prove_by_refinement( `!A C1 C2 C3 x p1 p2 p3. (C1 UNION C2 UNION C3 SUBSET A) /\ (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\ (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\ (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==> (?x' C1' C2' C3'. (C1' UNION C2' UNION C3' SUBSET A) /\ (simple_arc_end C1' x' p1) /\ (simple_arc_end C2' x' p2) /\ (simple_arc_end C3' x' p3) /\ (C1' INTER C2' = {x'}) /\ (C2' INTER C3' = {x'}) /\ (C3' INTER C1' = {x'}) )`, (* {{{ proof *) [ REP_GEN_TAC; DISCH_TAC; IMATCH_MP_TAC simple_arc_sep2; USE 0 (MATCH_MP simple_arc_sep3); REP_BASIC_TAC; TYPE_THEN `C1'` EXISTS_TAC; TYPE_THEN `C2'` EXISTS_TAC; TYPE_THEN `C3'` EXISTS_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION N *) (* ------------------------------------------------------------------ *) (* K33 stuff *) let isthree = prove_by_refinement( `?x. (\t. (t < 3)) x`, (* {{{ proof *) [ TYPE_THEN `0` EXISTS_TAC; BETA_TAC; ARITH_TAC; (* Sat Aug 14 11:56:32 EDT 2004 *) ]);; (* }}} *) let three_t = new_type_definition "three_t" ("ABS3","REP3") isthree;; let type_bij = prove_by_refinement( `!X (fXY:A->B) gYX. (!a. fXY (gYX a) = a) /\ (!r. X r = (gYX (fXY r) = r)) ==> (BIJ fXY X UNIV) /\ (BIJ gYX UNIV X)`, (* {{{ proof *) [ REP_BASIC_TAC; CONJ_TAC; IMATCH_MP_TAC bij_inj_image; REWRITE_TAC[INJ;SUBSET;IMAGE ;]; CONJ_TAC; REP_BASIC_TAC; USE 2 (AP_TERM `gYX:B->A` ); REWR 3; REWR 4; REWR 2; (* -- *) IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; NAME_CONFLICT_TAC; GEN_TAC; TYPE_THEN `gYX x''` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) IMATCH_MP_TAC bij_inj_image; REWRITE_TAC[INJ;SUBSET;IMAGE]; CONJ_TAC; REP_BASIC_TAC; CONJ_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; USE 2(AP_TERM `fXY:A->B`); REWR 2; REP_BASIC_TAC; TYPE_THEN `fXY x` EXISTS_TAC; REWR 2; ASM_REWRITE_TAC[]; ]);; (* }}} *) let thr_bij = prove_by_refinement( `(BIJ ABS3 {x | x < 3} UNIV) /\ (BIJ REP3 UNIV {x | x < 3})`, (* {{{ proof *) [ IMATCH_MP_TAC type_bij ; ASSUME_TAC three_t; ASM_REWRITE_TAC[]; REWRITE_TAC[three_t]; REP_BASIC_TAC; UND 0; BETA_TAC; DISCH_THEN_REWRITE; ]);; (* }}} *) let thr_finite = prove_by_refinement( `(UNIV:three_t->bool) HAS_SIZE 3`, (* {{{ proof *) [ REWRITE_TAC [has_size_bij2]; TYPE_THEN `REP3` EXISTS_TAC; ASM_REWRITE_TAC[thr_bij]; (* Sat Aug 14 12:28:58 EDT 2004 *) ]);; (* }}} *) let has_size3_bij = prove_by_refinement( `!(A:A->bool). A HAS_SIZE 3 <=> (?f. BIJ f (UNIV:three_t->bool) A)`, (* {{{ proof *) [ REWRITE_TAC[has_size_bij]; REP_BASIC_TAC; EQ_TAC; REP_BASIC_TAC; ASSUME_TAC thr_bij; TYPE_THEN `compose f REP3` EXISTS_TAC; IMATCH_MP_TAC COMP_BIJ; TYPE_THEN `{m | m < 3}` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) REP_BASIC_TAC; TYPE_THEN `compose f ABS3` EXISTS_TAC; IMATCH_MP_TAC COMP_BIJ; TYPE_THEN `UNIV:three_t->bool` EXISTS_TAC; ASM_REWRITE_TAC[thr_bij]; (* Sat Aug 14 12:36:22 EDT 2004 *) ]);; (* }}} *) let has_size3_bij2 = prove_by_refinement( `!(A:A->bool). A HAS_SIZE 3 <=> (?f. BIJ f A (UNIV:three_t->bool) )`, (* {{{ proof *) [ REWRITE_TAC[has_size_bij2]; GEN_TAC; EQ_TAC; REP_BASIC_TAC; TYPE_THEN `compose ABS3 f` EXISTS_TAC; IMATCH_MP_TAC COMP_BIJ; TYPE_THEN `{m | m < 3}` EXISTS_TAC; ASM_REWRITE_TAC[thr_bij]; (* -- *) REP_BASIC_TAC; TYPE_THEN `compose REP3 f` EXISTS_TAC; IMATCH_MP_TAC COMP_BIJ; TYPE_THEN `UNIV:three_t ->bool` EXISTS_TAC; ASM_REWRITE_TAC[thr_bij]; (* Sat Aug 14 12:40:48 EDT 2004 *) ]);; (* }}} *) let cartesian = jordan_def `cartesian (X:A->bool) (Y:B->bool) = { (x,y) | X x /\ Y y}`;; let cartesian_pair = prove_by_refinement( `!X Y (x:A) (y:B). cartesian X Y (x,y) <=> (X x) /\ (Y y)`, (* {{{ proof *) [ REWRITE_TAC[cartesian;PAIR_SPLIT ;]; MESON_TAC[]; ]);; (* }}} *) let cartesian_el = prove_by_refinement( `!X Y (x:(A#B)). cartesian X Y x <=> (X (FST x)) /\ (Y (SND x))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[cartesian]; EQ_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN`FST x` EXISTS_TAC; TYPE_THEN `SND x` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* ignore earlier K33 def *) let k33_graph = jordan_def `k33_graph = mk_graph_t ( cartesian (UNIV:three_t ->bool) UNIV, cartesian UNIV UNIV, (\e. { (FST e,T), (SND e,F)} ) )`;; let graph_edge_mk_graph = prove_by_refinement( `!(V:A->bool) (E:B->bool) C. graph_edge(mk_graph_t (V,E,C)) = E`, (* {{{ proof *) [ REWRITE_TAC[graph_edge;dest_graph_t;part1;drop0]; ]);; (* }}} *) let graph_vertex_mk_graph = prove_by_refinement( `!(V:A->bool) (E:B->bool) C. graph_vertex(mk_graph_t (V,E,C)) = V`, (* {{{ proof *) [ REWRITE_TAC[graph_vertex;dest_graph_t;]; ]);; (* }}} *) let graph_inc_mk_graph = prove_by_refinement( `!(V:A->bool) (E:B->bool) C. graph_inc(mk_graph_t (V,E,C)) = C`, (* {{{ proof *) [ REWRITE_TAC[graph_inc;dest_graph_t;drop1]; ]);; (* }}} *) let k33_isgraph = prove_by_refinement( `graph (k33_graph)`, (* {{{ proof *) [ REWRITE_TAC[graph;has_size2]; REWRITE_TAC[IMAGE;SUBSET;]; NAME_CONFLICT_TAC; REWRITE_TAC[k33_graph;graph_inc_mk_graph;graph_edge_mk_graph;graph_vertex_mk_graph;in_pair;cartesian]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[in_pair]; CONJ_TAC; GEN_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; TYPE_THEN `(x,T)` EXISTS_TAC; TYPE_THEN `(y,F)` EXISTS_TAC; REWRITE_TAC[]; REWRITE_TAC[PAIR_SPLIT]; (* Sat Aug 14 13:18:16 EDT 2004 *) ]);; (* }}} *) let k33_iso = prove_by_refinement( `!(A:A->bool) B (E:B->bool) f. A HAS_SIZE 3 /\ B HAS_SIZE 3 /\ (A INTER B = EMPTY) /\ BIJ f E (cartesian A B) ==> (graph_isomorphic k33_graph (mk_graph_t (A UNION B, E,( \ e. { (FST (f e)), (SND (f e)) }))))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[graph_isomorphic;graph_iso;k33_graph;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph;]; RULE_ASSUM_TAC (REWRITE_RULE[has_size3_bij]); REP_BASIC_TAC; TYPE_THEN `u = ( \ t. (if (SND t) then (f'' (FST t)) else (f'(FST t))))` ABBREV_TAC ; LEFT_TAC "u"; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `g = INV f E (cartesian A B)` ABBREV_TAC ; TYPE_THEN `v = ( \t . (g (f'' (FST t), f' (SND t))))` ABBREV_TAC ; LEFT_TAC "v"; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `(u,v)` EXISTS_TAC; REWRITE_TAC[]; (* A u *) CONJ_TAC; REWRITE_TAC[BIJ;SURJ;INJ]; SUBCONJ_TAC ; CONJ_TAC; EXPAND_TAC "u"; REWRITE_TAC[cartesian_el]; REWRITE_TAC[UNION;]; GEN_TAC; COND_CASES_TAC; UND 2; REWRITE_TAC[BIJ;SURJ]; MESON_TAC[]; UND 3; REWRITE_TAC[BIJ;SURJ]; MESON_TAC[]; REWRITE_TAC[cartesian_el;]; EXPAND_TAC "u"; REP_GEN_TAC ; COND_CASES_TAC; COND_CASES_TAC; UND 2; REWRITE_TAC[BIJ;INJ]; REP_BASIC_TAC; REWRITE_TAC[PAIR_SPLIT]; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; UND 1; REWRITE_TAC[EMPTY_EXISTS ]; TYPE_THEN `f'' (FST x)` EXISTS_TAC; REWRITE_TAC[INTER]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); ASM_MESON_TAC[]; COND_CASES_TAC; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; UND 1; REWRITE_TAC[EMPTY_EXISTS ]; TYPE_THEN `f' (FST x)` EXISTS_TAC; REWRITE_TAC[INTER]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); ASM_MESON_TAC[]; REWRITE_TAC[PAIR_SPLIT]; ASM_REWRITE_TAC[]; DISCH_TAC; USE 3(REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE ; REWRITE_TAC[UNION]; GEN_TAC; DISCH_THEN DISJ_CASES_TAC; TYPE_THEN `( ((INV f'' UNIV A) x ), T )` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[cartesian_el]; EXPAND_TAC "u"; REWRITE_TAC[SND ]; IMATCH_MP_TAC inv_comp_right; ASM_REWRITE_TAC[]; TYPE_THEN `( ((INV f' UNIV B) x ), F )` EXISTS_TAC; REWRITE_TAC[cartesian_el]; EXPAND_TAC "u"; REWRITE_TAC[SND ]; IMATCH_MP_TAC inv_comp_right; ASM_REWRITE_TAC[]; (* B graph_inc *) REWRITE_TAC[cartesian_el]; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC; GEN_TAC; EXPAND_TAC "u"; REWRITE_TAC[IMAGE_CLAUSES]; EXPAND_TAC "v"; EXPAND_TAC "g"; TYPE_THEN `cartesian A B (f'' (FST e), f' (SND e))` SUBGOAL_TAC; REWRITE_TAC[cartesian_el]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); ASM_MESON_TAC[]; ASM_SIMP_TAC[inv_comp_right]; (* C BIJ v *) TYPE_THEN `BIJ g (cartesian A B) E` SUBGOAL_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; DISCH_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; REWRITE_TAC[cartesian_el]; EXPAND_TAC "v"; CONJ_TAC; (* --- *) USE 7(REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[cartesian_el]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `(f'' (FST x),f' (SND x)) = (f''(FST y),f' (SND y))` SUBGOAL_TAC; USE 7(REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC [cartesian_el]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); ASM_MESON_TAC[]; REWRITE_TAC[PAIR_SPLIT]; REP_BASIC_TAC; CONJ_TAC; USE 2 (REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; USE 3 (REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[INJ;SURJ]; DISCH_THEN_REWRITE; REWRITE_TAC[cartesian_el]; EXPAND_TAC "v"; REP_BASIC_TAC; (* -- *) TYPE_THEN `?u0. (f'' u0 = FST (f x))` SUBGOAL_TAC ; USE 2 (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; USE 0 (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; TSPEC `x` 11; REWR 11; USE 11(REWRITE_RULE[cartesian_el]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* -- *) TYPE_THEN `?u1. (f' u1 = SND (f x))` SUBGOAL_TAC ; USE 3 (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; USE 0 (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; TSPEC `x` 12; REWR 12; USE 12(REWRITE_RULE[cartesian_el]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(u0,u1)` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "g"; IMATCH_MP_TAC inv_comp_left; ASM_REWRITE_TAC[]; (* Sat Aug 14 14:58:11 EDT 2004 *) ]);; (* }}} *) (* ********************************************************* *) let mk_segment_inj_image2 = prove_by_refinement( `!x y n. euclid n x /\ euclid n y /\ ~(x = y) ==> (?f. continuous f (top_of_metric (UNIV,d_real)) (top_of_metric (euclid n,d_euclid)) /\ INJ f {x | &0 <= x /\ x <= &1} (euclid n) /\ (f (&0) = x) /\ (f (&1) = y) /\ (IMAGE f {t | &0 <= t /\ t <= &1} = mk_segment x y))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC cont_mk_segment; ASM_REWRITE_TAC[]; REWRITE_TAC[joinf;IMAGE ]; REWRITE_TAC[mk_segment]; (* new new *) TYPE_THEN `((if &0 < &0 then x else if &0 < &1 then euclid_plus (&0 *# y) ((&1 - &0) *# x) else y) = x) /\ ((if &1 < &0 then x else if &1 < &1 then euclid_plus (&1 *# y) ((&1 - &1) *# x) else y) = y)` SUBGOAL_TAC; REWRITE_TAC[REAL_ARITH `~(&0 < &0) /\ ~(&1 < &0) /\ (&0 < &1) /\ ~(&1 < &1)`]; REDUCE_TAC; REWRITE_TAC[euclid_scale0; euclid_scale_one ; euclid_lzero]; DISCH_THEN_REWRITE; (* end new new *) CONJ_TAC; (* new stuff *) REWRITE_TAC[INJ]; CONJ_TAC; REP_BASIC_TAC; TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; UND 4; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_CASES_TAC `x' < &1`; ASM_REWRITE_TAC[]; IMATCH_MP_TAC euclid_add_closure; CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; UND 3; TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; UND 7; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `~(y' < &0)` SUBGOAL_TAC; UND 5; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC; TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC; UND 6; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `~(x' < &1)` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; REDUCE_TAC; REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; DISCH_THEN_REWRITE; TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC; TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC; UND 4; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `~(y' < &1)` SUBGOAL_TAC; UND 3; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; REDUCE_TAC; REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; DISCH_THEN_REWRITE; (* th *) ONCE_REWRITE_TAC [euclid_eq_minus]; REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act]; ONCE_REWRITE_TAC [euclid_plus_pair]; REWRITE_TAC[GSYM euclid_rdistrib]; REDUCE_TAC; REWRITE_TAC[REAL_ARITH `x' + -- &1 * y' = x' - y'`]; REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`]; REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus]; (* th1 *) DISCH_TAC; PROOF_BY_CONTR_TAC; UND 2; REWRITE_TAC[]; IMATCH_MP_TAC euclid_scale_cancel; TYPE_THEN `(x' - y')` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 8; REAL_ARITH_TAC; KILL 2; (* old stuff *) IMATCH_MP_TAC EQ_EXT; GEN_TAC; ASM_REWRITE_TAC[]; EQ_TAC; DISCH_TAC; CHO 2; UND 2; COND_CASES_TAC; DISCH_ALL_TAC; JOIN 3 2; ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`]; DISCH_ALL_TAC; UND 5; COND_CASES_TAC; DISCH_TAC; TYPE_THEN `&1 - x''` EXISTS_TAC; SUBCONJ_TAC; UND 5; REAL_ARITH_TAC ; DISCH_TAC; CONJ_TAC; UND 3; REAL_ARITH_TAC ; ONCE_REWRITE_TAC [euclid_add_comm]; REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`]; ASM_MESON_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; CONJ_TAC; REAL_ARITH_TAC ; CONJ_TAC; REAL_ARITH_TAC ; REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; (* 2nd half *) DISCH_TAC; CHO 2; TYPE_THEN `&1 - a` EXISTS_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; AND 2; AND 2; UND 3; UND 4; REAL_ARITH_TAC ; COND_CASES_TAC; ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`]; COND_CASES_TAC; REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; ASM_MESON_TAC [euclid_add_comm]; TYPE_THEN `a = &.0` SUBGOAL_TAC; UND 4; UND 3; AND 2; UND 3; REAL_ARITH_TAC ; DISCH_TAC; REWR 2; REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; ]);; (* }}} *) let mk_segment_simple_arc_end = prove_by_refinement( `!x y. (euclid 2 x) /\ (euclid 2 y) /\ ~(x = y) ==> simple_arc_end (mk_segment x y) x y`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[simple_arc_end]; TYPEL_THEN [`x`;`y`;`2`] (fun t-> ANT_TAC (ISPECL t mk_segment_inj_image2)); ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `f` EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[GSYM top2 ]); ASM_REWRITE_TAC[]; (* Tue Aug 17 10:10:00 EDT 2004 *) ]);; (* }}} *) let cis0 = prove_by_refinement( `cis (&0) = e1`, (* {{{ proof *) [ REWRITE_TAC[cis;COS_0;SIN_0;e1;]; ]);; (* }}} *) let cispi2 = prove_by_refinement( `cis (pi/(&2)) = e2`, (* {{{ proof *) [ REWRITE_TAC [cis;COS_PI2;SIN_PI2;e2]; ]);; (* }}} *) let neg_point = prove_by_refinement( `!x y. -- (point (x,y)) = point (--x, --y)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[euclid_neg]; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; BETA_TAC; MP_TAC (ARITH_RULE `(x' = 0) \/ (x' = 1) \/ (2 <=| x')`); REP_CASES_TAC ; ASM_REWRITE_TAC[coord01]; ASM_REWRITE_TAC[coord01]; TYPE_THEN `euclid 2(point(x,y)) /\ euclid 2(point(--x,--y))` SUBGOAL_TAC; ASM_MESON_TAC[euclid_point]; REWRITE_TAC[euclid]; REP_BASIC_TAC; TSPEC `x'` 1; TSPEC `x'` 2; ASM_MESON_TAC[REAL_ARITH `-- &0 = &0`]; (* Tue Aug 17 10:27:14 EDT 2004 *) ]);; (* }}} *) let cispi = prove_by_refinement( `cis(pi) = -- e1`, (* {{{ proof *) [ REWRITE_TAC[cis;COS_PI ;SIN_PI;e1]; REWRITE_TAC[neg_point]; AP_TERM_TAC; REWRITE_TAC[PAIR_SPLIT]; REAL_ARITH_TAC; (* Tue Aug 17 10:28:55 EDT 2004 *) ]);; (* }}} *) let cis3pi2 = prove_by_refinement( `cis(&3 *pi/(&2)) = -- e2`, (* {{{ proof *) [ TYPE_THEN `&3 *pi/(&2) = pi/(&2) + pi` SUBGOAL_TAC; REWRITE_TAC[REAL_ARITH `&3 = &1 + &1 + &1`]; REWRITE_TAC[REAL_ARITH `(x + y)*z = x*z + y*z`]; REDUCE_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[cis;COS_PERIODIC_PI;SIN_PERIODIC_PI;GSYM neg_point;]; AP_TERM_TAC; REWRITE_TAC[GSYM cis;cispi2]; (* Tue Aug 17 10:34:32 EDT 2004 *) ]);; (* }}} *) let closedball_convex = prove_by_refinement( `!x e n. (convex (closed_ball (euclid n,d_euclid) x e))`, (* {{{ proof *) [ REWRITE_TAC[convex;closed_ball;SUBSET;mk_segment;]; REP_BASIC_TAC; USE 0 SYM; ASM_REWRITE_TAC[]; SUBCONJ_TAC; EXPAND_TAC "x''"; IMATCH_MP_TAC (euclid_add_closure); CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); DISCH_TAC; TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC; REWRITE_TAC[trivial_lin_combo]; DISCH_THEN_REWRITE; EXPAND_TAC "x''"; (* special case *) ASM_CASES_TAC `a = &0` ; UND 10; DISCH_THEN_REWRITE; REDUCE_TAC; ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;]; TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u <= a*e) /\ (v <= (&1- a)*e)) ==> (d <= e))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `u + v <= (a*e) + (&1 - a)*e` SUBGOAL_TAC; IMATCH_MP_TAC REAL_LE_ADD2; ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`]; UND 13; REAL_ARITH_TAC ; DISCH_THEN IMATCH_MP_TAC ; TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC; TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC; TYPE_THEN `d_euclid z x''` EXISTS_TAC; TYPE_THEN `euclid n z` SUBGOAL_TAC; EXPAND_TAC "z"; IMATCH_MP_TAC (euclid_add_closure); CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); DISCH_TAC; CONJ_TAC; EXPAND_TAC "x''"; IMATCH_MP_TAC metric_space_triangle; TYPE_THEN `euclid n` EXISTS_TAC; REWRITE_TAC[metric_euclid]; ASM_REWRITE_TAC[trivial_lin_combo]; CONJ_TAC; EXPAND_TAC "z"; TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid (a *# x) (a *# x') ` SUBGOAL_TAC; IMATCH_MP_TAC metric_translate; TYPE_THEN `n` EXISTS_TAC; REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); DISCH_THEN_REWRITE; TYPE_THEN `d_euclid (a *# x) (a *# x') = abs (a) * d_euclid x x'` SUBGOAL_TAC; IMATCH_MP_TAC norm_scale_vec; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `abs a = a` SUBGOAL_TAC; ASM_MESON_TAC[REAL_ABS_REFL]; DISCH_THEN_REWRITE; IMATCH_MP_TAC REAL_PROP_LE_LMUL; ASM_REWRITE_TAC[]; (* LAST case *) EXPAND_TAC "z"; EXPAND_TAC "x''"; TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC; IMATCH_MP_TAC metric_translate_LEFT; TYPE_THEN `n` EXISTS_TAC; REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); DISCH_THEN_REWRITE; TYPE_THEN `!b. d_euclid (b *# x) (b *# y) = abs (b) * d_euclid x y` SUBGOAL_TAC; GEN_TAC; IMATCH_MP_TAC norm_scale_vec; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `abs (&1 - a) = (&1 - a)` SUBGOAL_TAC; REWRITE_TAC [REAL_ABS_REFL]; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; IMATCH_MP_TAC REAL_PROP_LE_LMUL; ASM_REWRITE_TAC[]; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let closedball_mk_segment_end = prove_by_refinement( `!x e n u v. (closed_ball(euclid n,d_euclid) x e u) /\ (closed_ball(euclid n,d_euclid) x e v) ==> (mk_segment u v SUBSET (closed_ball(euclid n,d_euclid) x e))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC closedball_convex; TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL); USE 2 (REWRITE_RULE[convex]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let euclid2_e12 = prove_by_refinement( `euclid 2 e1 /\ euclid 2 e2`, (* {{{ proof *) [ REWRITE_TAC[e1;e2;euclid_point]; ]);; (* }}} *) let in_union = prove_by_refinement( `!X Y Z. (X:A->bool) SUBSET Y \/ (X SUBSET Z) ==> (X SUBSET Y UNION Z)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;UNION ]; ASM_MESON_TAC[]; ]);; (* }}} *) let mk_segment_hyperplane = prove_by_refinement( `!p r i. (i < 4) /\ (&0 (mk_segment p (p + r *# (cis(&i * pi/(&2))))) SUBSET (hyperplane 2 e2 (p 1) UNION hyperplane 2 e1 (p 0)) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?x y. p = point (x,y)` SUBGOAL_TAC; USE 0 (MATCH_MP point_onto); REP_BASIC_TAC; TYPE_THEN `FST p'` EXISTS_TAC; TYPE_THEN `SND p'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; UND 3; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); REWRITE_TAC[coord01]; (* -- *) TYPE_THEN `convex(hyperplane 2 e2 y)` SUBGOAL_TAC; IMATCH_MP_TAC hyperplane_convex; REWRITE_TAC[euclid2_e12]; TYPE_THEN `convex(hyperplane 2 e1 x)` SUBGOAL_TAC; IMATCH_MP_TAC hyperplane_convex; REWRITE_TAC[euclid2_e12]; REWRITE_TAC[convex]; REP_BASIC_TAC; TYPE_THEN `hyperplane 2 e1 x (point(x,y)) /\ hyperplane 2 e2 y (point(x,y))` SUBGOAL_TAC; REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM line2D_F]; CONJ_TAC; TYPE_THEN `(x,y)` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(x,y)` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; USE 2 (MATCH_MP (ARITH_RULE (`(i < 4) ==> (i = 0) \/ (i = 1) \/ (i = 2) \/ (i = 3)`))); (* -- *) IMATCH_MP_TAC in_union; TYPE_THEN `z = (euclid_plus (point (x,y)) (r *# cis (&i * pi / &2)))` ABBREV_TAC ; TYPE_THEN `hyperplane 2 e2 y z \/ hyperplane 2 e1 x z ==> mk_segment (point (x,y)) z SUBSET hyperplane 2 e2 y \/ mk_segment (point (x,y)) z SUBSET hyperplane 2 e1 x` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; (* -- *) TYPE_THEN `( (cis (&i *pi/(&2))) 0 = &0) ==> (hyperplane 2 e1 x z)` SUBGOAL_TAC; REWRITE_TAC[e1;GSYM line2D_F]; EXPAND_TAC "z"; REWRITE_TAC[cis;coord01]; DISCH_THEN_REWRITE; REWRITE_TAC[point_scale;point_add]; REDUCE_TAC; TYPE_THEN `(x, y+ r*sin (&i *pi/(&2)))` EXISTS_TAC; REWRITE_TAC[]; (* -- *) TYPE_THEN `( (cis (&i *pi/(&2))) 1 = &0) ==> (hyperplane 2 e2 y z)` SUBGOAL_TAC; REWRITE_TAC[e2;GSYM line2D_S]; EXPAND_TAC "z"; REWRITE_TAC[cis;coord01]; DISCH_THEN_REWRITE; REWRITE_TAC[point_scale;point_add]; REDUCE_TAC; TYPE_THEN `(x + r*cos(&i *pi/(&2)) , y)` EXISTS_TAC; REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(cis (&i * pi / &2) 0 = &0) \/ (cis (&i * pi / &2) 1 = &0) ==> hyperplane 2 e2 y z \/ hyperplane 2 e1 x z` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN IMATCH_MP_TAC ; UND 2; POP_ASSUM_LIST (fun t-> ALL_TAC); (* A -- *) REP_CASES_TAC; ASM_REWRITE_TAC[]; REDUCE_TAC; ASM_REWRITE_TAC[cis0;e1;coord01]; ASM_REWRITE_TAC[]; REDUCE_TAC; ASM_REWRITE_TAC[cispi2;e2;coord01]; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_2]; REDUCE_TAC; ASM_REWRITE_TAC[cispi;e1;coord01;neg_point]; REDUCE_TAC; ASM_REWRITE_TAC[cis3pi2;e2;coord01;neg_point]; REDUCE_TAC; (* Tue Aug 17 11:46:56 EDT 2004 *) ]);; (* }}} *) let d_euclid_mk_segment = prove_by_refinement( `!n a p q . (&0 <= a) /\ (a <= &1) /\ (euclid n p) /\ (euclid n q) ==> (d_euclid p (a*#p + (&1 - a)*#q) = (&1 - a)*(d_euclid p q))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!z. d_euclid (a*# p + (&1 - a)*# p) z = d_euclid p z` SUBGOAL_TAC; REWRITE_TAC[trivial_lin_combo]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); TYPE_THEN `d_euclid (euclid_plus (a *# p) ((&1 - a) *# p)) (euclid_plus (a *# p) ((&1 - a) *# q)) = d_euclid ( ((&1 - a) *# p)) ( ((&1 - a) *# q))` SUBGOAL_TAC; ASM_MESON_TAC [metric_translate_LEFT;euclid_scale_closure]; DISCH_THEN_REWRITE; TYPE_THEN `d_euclid ((&1 - a) *# p) ((&1 - a) *# q) = abs (&1- a) * d_euclid p q` SUBGOAL_TAC; ASM_MESON_TAC[euclid_scale_closure;norm_scale_vec]; DISCH_THEN_REWRITE; TYPE_THEN `abs (&1 - a) = (&1 - a)` SUBGOAL_TAC; UND 2; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[trivial_lin_combo]; (* Tue Aug 17 12:24:07 EDT 2004 *) ]);; (* }}} *) let mk_segment_eq = prove_by_refinement( `! a p x y. ((a*# p + (&1 - a)*# x) = (a *# p + (&1 - a)*# y)) ==> (a = &1) \/ (x = y)`, (* {{{ proof *) [ ONCE_REWRITE_TAC[euclid_eq_minus]; REWRITE_TAC[euclid_minus;euclid_plus;euclid0;euclid_scale]; REP_BASIC_TAC; USE 0 (REWRITE_RULE[FUN_EQ_THM]); IMATCH_MP_TAC (TAUT `(~A ==>B) ==> (A \/ B)`); REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; BETA_TAC; USE 0 (SPEC `x':num` ); UND 0; REWRITE_TAC[REAL_ARITH `(a*b + r*c ) - (a*b + r*d) = r*c - r*d`]; REWRITE_TAC[REAL_ARITH `a*y - a*z = a*(y-z)`]; REWRITE_TAC[REAL_ENTIRE]; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let mk_segment_endpoint = prove_by_refinement( `!p x y n . (d_euclid p x = d_euclid p y) /\ ~(x = y) /\ (euclid n x) /\ (euclid n y) /\ (euclid n p) ==> (mk_segment p x INTER mk_segment p y = {p})`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING]; GEN_TAC; (* A -- *) EQ_TAC; REWRITE_TAC[mk_segment]; REP_BASIC_TAC; UND 5; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); PROOF_BY_CONTR_TAC; TYPE_THEN `~(a' = &1)` SUBGOAL_TAC; DISCH_TAC; UND 11; DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); UND 5; REDUCE_TAC; REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero]; REP_BASIC_TAC; (* -- *) TYPE_THEN `(&1- a')*d_euclid p y = (&1- a)*d_euclid p x` SUBGOAL_TAC; KILL 4; ASM_MESON_TAC[d_euclid_mk_segment]; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; REWR 12; (* -- *) TYPE_THEN `d_euclid p y = &0` ASM_CASES_TAC; TYPE_THEN `p = y` SUBGOAL_TAC; ASM_MESON_TAC [d_euclid_zero]; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); ASM_MESON_TAC[d_euclid_zero]; USE 12 (REWRITE_RULE[REAL_EQ_MUL_RCANCEL]); REWR 12; TYPE_THEN `a' = a` SUBGOAL_TAC; UND 12; REAL_ARITH_TAC; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); USE 8 (MATCH_MP mk_segment_eq); REWR 8; (* -- *) DISCH_THEN_REWRITE; REWRITE_TAC[mk_segment_end]; (* Tue Aug 17 14:04:19 EDT 2004 *) ]);; (* }}} *) let cases4 = prove_by_refinement( `!i j. (i < j) /\ (j < 4) ==> ((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/ ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/ ((i=2)/\ (j=3))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!k. (k < 4) ==> (k = 0) \/ (k =1)\/ (k=2) \/ (k=3)` SUBGOAL_TAC; ARITH_TAC; DISCH_TAC; TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2) \/ (j = 3)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `~(j=0)` SUBGOAL_TAC; UND 1; ARITH_TAC; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); TYPE_THEN `(i < 3)` SUBGOAL_TAC; UND 0; UND 1; ARITH_TAC; DISCH_TAC; TYPE_THEN `(i=0) \/ (i = 1) \/ (i=2)` SUBGOAL_TAC; UND 4; ARITH_TAC; DISCH_TAC; JOIN 5 3; USE 3 (REWRITE_RULE [RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]); TYPE_THEN `!k. ~((i = k) /\ (j = k))` SUBGOAL_TAC; GEN_TAC; UND 1; ARITH_TAC; DISCH_THEN (fun t-> USE 3 (REWRITE_RULE[t])); TYPE_THEN `~((i=2) /\ (j = 1))` SUBGOAL_TAC; UND 1; ARITH_TAC ; DISCH_THEN (fun t-> USE 3(REWRITE_RULE[t])); ASM_REWRITE_TAC[]; UND 3; REP_CASES_TAC THEN (ASM_REWRITE_TAC[]); ]);; (* }}} *) let cis_distinct = prove_by_refinement( `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (&0 < r) ==> ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))`, (* {{{ proof *) [ TYPE_THEN `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (i < j) /\ (&0 < r) ==> ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `!p x y. (euclid_plus p x = euclid_plus p y) ==> (x = y)` SUBGOAL_TAC; REWRITE_TAC[euclid_plus]; REP_BASIC_TAC; USE 6 (REWRITE_RULE[FUN_EQ_THM]); IMATCH_MP_TAC EQ_EXT; GEN_TAC; TSPEC `x'` 6; UND 6; REAL_ARITH_TAC; DISCH_THEN (fun t-> USE 0 (MATCH_MP t)); USE 0 (AP_TERM `( *# ) (&1/r)`); USE 0 (REWRITE_RULE [euclid_scale_act]); TYPE_THEN `&1/r * r = &1` SUBGOAL_TAC; ONCE_REWRITE_TAC [REAL_ARITH `x*y = y*x`]; ASM_MESON_TAC[REAL_DIV_LMUL;REAL_ARITH `&0 < r ==> ~(r = &0)`]; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); USE 0(REWRITE_RULE[euclid_scale_one]); TYPE_THEN `((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/ ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/ ((i=2)/\ (j=3))` SUBGOAL_TAC; IMATCH_MP_TAC cases4; ASM_REWRITE_TAC[]; REP_CASES_TAC THEN (FIRST_ASSUM MP_TAC) THEN (DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t;REAL_ARITH `(&1*x=x) /\ (&0*x= &0)`;e1;e2;cis0;cispi;cispi2;cis3pi2;neg_point;point_inj; PAIR_SPLIT; REAL_ARITH `~(&1 = &0) /\ ~(&0 = &1) /\ (-- &0 = &0) /\ ~(&1 = -- &1) /\ ~(-- &1 = &0) /\ ~(&0 = -- &1)`;REAL_MUL_2; REAL_HALF_DOUBLE ]))) THEN (ASM_REWRITE_TAC[]); REP_BASIC_TAC; TYPE_THEN `( i <| j) \/ (j <| i)` SUBGOAL_TAC; UND 2; ARITH_TAC; REP_CASES_TAC; TYPEL_THEN [`i`;`j`;`r`] (USE 5 o ISPECL); ASM_MESON_TAC[]; TYPEL_THEN [`j`;`i`;`r`] (USE 5 o ISPECL); ASM_MESON_TAC[]; (* Tue Aug 17 15:01:38 EDT 2004 *) ]);; (* }}} *) let cis_nz = prove_by_refinement( `!t. ~(cis(t) = euclid0)`, (* {{{ proof *) [ REP_BASIC_TAC; USE 0 (AP_TERM `norm2`); RULE_ASSUM_TAC (REWRITE_RULE[norm2_cis]); ASM_MESON_TAC[REAL_ARITH `~(&1= &0)`;norm2_0;]; ]);; (* }}} *) let polar_nz = prove_by_refinement( `!r t. ~(r = &0) ==> ~(r *# cis(t) =euclid0)`, (* {{{ proof *) [ REP_BASIC_TAC; USE 0 (AP_TERM `norm2`); RULE_ASSUM_TAC (REWRITE_RULE[norm2_scale_cis]); ASM_MESON_TAC[REAL_ARITH `(abs r = &0) ==> (r = &0)`;norm2_0]; ]);; (* }}} *) let polar_euclid = prove_by_refinement( `!r t. euclid 2 (r *# (cis t))`, (* {{{ proof *) [ REWRITE_TAC[cis;point_scale;euclid_point]; ]);; (* }}} *) let d_euclidpq = prove_by_refinement( `!n p q . (euclid n p) /\ (euclid n q) ==> (d_euclid p (p+q) = d_euclid q euclid0)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!z. d_euclid p z = d_euclid (p + euclid0) z` SUBGOAL_TAC; REWRITE_TAC[euclid_rzero]; DISCH_THEN (fun t->ONCE_REWRITE_TAC[t]); TYPE_THEN `d_euclid (euclid_plus p euclid0) (euclid_plus p q) = d_euclid euclid0 q` SUBGOAL_TAC; IMATCH_MP_TAC metric_translate_LEFT; TYPE_THEN `n` EXISTS_TAC; ASM_REWRITE_TAC[euclid_euclid0;polar_euclid;]; DISCH_THEN_REWRITE; IMATCH_MP_TAC metric_space_symm; TYPE_THEN `euclid n` EXISTS_TAC ; ASM_REWRITE_TAC[metric_euclid;euclid_euclid0;polar_euclid]; ]);; (* }}} *) let degree4_vertex_hv = prove_by_refinement( `!r p. (&0 < r) /\ (euclid 2 p) ==> (?C. (!i. (i< 4) ==> simple_arc_end (C i) p (p + r*# (cis(&i * pi/(&2))))) /\ (!i. (i < 4) ==> (C i = mk_segment p (p + r*# (cis(&i * pi/(&2)))))) /\ (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==> (C i INTER C j = {p})) /\ (!i. (i < 4) ==> (C i INTER {x | r <= d_euclid p x } = { (p + r *# (cis(&i* pi/(&2)))) })) /\ (!i. (i< 4) ==> C i SUBSET (closed_ball (euclid 2,d_euclid) p r)) /\ (!i. (i< 4) ==> C i SUBSET (hyperplane 2 e2 (p 1) UNION hyperplane 2 e1 (p 0)))) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(\i. mk_segment p (euclid_plus p (r *# cis (&i * pi / &2))))` EXISTS_TAC; BETA_TAC; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `!i. ~(r *# cis (&i * pi/(&2)) = euclid0)` SUBGOAL_TAC; REP_BASIC_TAC; ASM_MESON_TAC[polar_nz;REAL_ARITH `&0 < r ==> ~( r= &0)`]; DISCH_TAC; (* -- *) TYPE_THEN `!i . euclid 2 (r *# cis (&i * pi/(&2)))` SUBGOAL_TAC; GEN_TAC; REWRITE_TAC[polar_euclid]; DISCH_TAC; (* -- *) CONJ_TAC; REP_BASIC_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; ASM_REWRITE_TAC[]; CONJ_TAC; ASM_SIMP_TAC[euclid_add_closure]; DISCH_TAC; TSPEC `i` 2; UND 2; TYPE_THEN `z =r *# cis(&i *pi/(&2))` ABBREV_TAC ; REWRITE_TAC[euclid0]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; USE 5 (REWRITE_RULE[FUN_EQ_THM ]); TSPEC `x` 5; UND 5; REWRITE_TAC[euclid_plus]; REAL_ARITH_TAC; (* -- *) CONJ_TAC; REP_BASIC_TAC; IMATCH_MP_TAC mk_segment_endpoint; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `!i. d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi / &2)) euclid0` SUBGOAL_TAC; GEN_TAC; IMATCH_MP_TAC d_euclidpq; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[polar_euclid]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM norm2]; REWRITE_TAC[norm2_scale_cis]; CONJ_TAC; IMATCH_MP_TAC cis_distinct; ASM_REWRITE_TAC[]; ASM_MESON_TAC[polar_euclid;euclid_add_closure]; (* [B] *) TYPE_THEN `!a q. (euclid 2 q) /\ (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + q)) = (&1 - a)*(d_euclid p (p + q)))` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC d_euclid_mk_segment; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[euclid_add_closure]; DISCH_TAC; (* -- *) TYPE_THEN `!a i. (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + r *# (cis (&i * pi/(&2))))) = (&1 - a)*r)` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `d_euclid p (p + r *# (cis (&i * pi/(&2)))) = norm2 ( r *# (cis (&i * pi/(&2))))` SUBGOAL_TAC; REWRITE_TAC[norm2]; IMATCH_MP_TAC d_euclidpq; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[polar_euclid]; REWRITE_TAC[norm2_scale_cis]; TYPE_THEN `abs r = r` SUBGOAL_TAC; UND 1; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPEL_THEN [`2`;`a`;`p`;`p + (r *# cis (&i * pi / &2))`] (fun t-> ANT_TAC (ISPECL t d_euclid_mk_segment)); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[euclid_add_closure;polar_euclid]; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; REP_BASIC_TAC; (* -- *) CONJ_TAC; REP_BASIC_TAC ; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[mk_segment;INTER;INR IN_SING]; EQ_TAC; REP_BASIC_TAC; UND 8; DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL); REWR 5; ASM_REWRITE_TAC[]; REWR 7; TYPE_THEN `&1 * r <= (&1 - a) * r` SUBGOAL_TAC; REDUCE_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[REAL_LE_RMUL_EQ]; DISCH_TAC; TYPE_THEN `a = &0` SUBGOAL_TAC; UND 10; UND 8; REAL_ARITH_TAC; DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); REDUCE_TAC; REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero]; DISCH_THEN_REWRITE; CONJ_TAC; TYPE_THEN `&0` EXISTS_TAC; REWRITE_TAC [REAL_ARITH `&0 <= &0 /\ &0 <= &1`]; REDUCE_TAC; REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero]; TYPE_THEN `d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi/(&2))) euclid0` SUBGOAL_TAC; IMATCH_MP_TAC d_euclidpq; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[polar_euclid]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM norm2;norm2_scale_cis]; UND 1; REAL_ARITH_TAC; (* C-- *) CONJ_TAC; REP_BASIC_TAC ; REWRITE_TAC[SUBSET]; GEN_TAC; REWRITE_TAC[mk_segment;closed_ball]; REP_BASIC_TAC; UND 7; DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL); REWR 5; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[euclid_add_closure;polar_euclid;euclid_scale_closure]; ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1*y`]; IMATCH_MP_TAC REAL_PROP_LE_RMUL; UND 1; UND 9; REAL_ARITH_TAC; (* D-- *) REP_BASIC_TAC; IMATCH_MP_TAC mk_segment_hyperplane; ASM_REWRITE_TAC[]; (* Tue Aug 17 17:02:28 EDT 2004 *) ]);; (* }}} *) let diff_pow1 = prove_by_refinement( `!t x. (( \ x. (t*x)) diffl t) x`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(\ x. (t * x)) = (\x. (t * (\u. (u pow 1)) x))` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; BETA_TAC; REWRITE_TAC[POW_1]; DISCH_THEN_REWRITE; TYPE_THEN `((\x. (t * (\u. (u pow 1)) x)) diffl (t* &1)) x ` SUBGOAL_TAC; IMATCH_MP_TAC DIFF_CMUL; TYPEL_THEN[`1`;`x`] (fun t-> ASSUME_TAC (ISPECL t DIFF_POW)); UND 0; REWRITE_TAC[ARITH_RULE `1-1 = 0`;pow]; REDUCE_TAC; BETA_TAC; REDUCE_TAC; ]);; (* }}} *) let pi_bounds = prove_by_refinement( `&3 < pi /\ pi < &22/ (&7)`, (* {{{ proof *) let tpi = recompute_pi 12 in let t3 = INTERVAL_OF_TERM 12 `&3` in let t227 = INTERVAL_OF_TERM 12 `&22/(&7)` in let th1 = INTERVAL_TO_LESS_CONV t3 tpi in let th2 = INTERVAL_TO_LESS_CONV tpi t227 in ( [ REP_BASIC_TAC; ASSUME_TAC th2; ASSUME_TAC th1; ASM_REWRITE_TAC[]; ]));; (* }}} *) let sinx_le_x = prove_by_refinement( `!x. (&0 <=x) ==> (sin x <= x)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `x = &0` ASM_CASES_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SIN_0;]; REAL_ARITH_TAC; TYPE_THEN `&0 < x` SUBGOAL_TAC; UND 0; UND 1; REAL_ARITH_TAC; POP_ASSUM_LIST (fun t-> ALL_TAC); DISCH_TAC; (* -- *) TYPE_THEN `f = ( \ t x. t * x - sin(x))` ABBREV_TAC ; TYPE_THEN `!t. (&1 < t) ==> (!x. (&0 < x) ==> (&0 < f t x))` SUBGOAL_TAC; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; (* --- *) TYPE_THEN `!x. (f t diffl (t - cos x)) x` SUBGOAL_TAC; EXPAND_TAC "f"; GEN_TAC; IMATCH_MP_TAC DIFF_SUB; REWRITE_TAC[DIFF_SIN;diff_pow1;]; DISCH_TAC; TYPEL_THEN [`f t`;`&0`;`x'`] (fun t-> ANT_TAC (ISPECL t MVT)); ASM_REWRITE_TAC[]; CONJ_TAC; REP_BASIC_TAC; ASM_MESON_TAC[DIFF_CONT]; REWRITE_TAC[differentiable]; REP_BASIC_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; UND 6; TYPE_THEN `f t (&0) = &0` SUBGOAL_TAC; EXPAND_TAC "f"; REWRITE_TAC[SIN_0]; REDUCE_TAC; DISCH_THEN_REWRITE; REDUCE_TAC; DISCH_TAC; UND 4; REWRITE_TAC[]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC REAL_LT_MUL; ASM_REWRITE_TAC[]; TSPEC `z` 5; TYPE_THEN `l = t - cos z` SUBGOAL_TAC; IMATCH_MP_TAC DIFF_UNIQ; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; UND 3; MP_TAC COS_BOUNDS; DISCH_TAC; TSPEC `z` 3; REP_BASIC_TAC; UND 5; UND 3; REAL_ARITH_TAC; (* -- *) DISCH_TAC; IMATCH_MP_TAC (REAL_ARITH `~(x < sin x) ==> (sin x <= x)`) ; DISCH_TAC; TYPE_THEN `&1 < sin x/x` SUBGOAL_TAC; ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; TSPEC `(sin x)/x` 2; REWR 2; TSPEC `x` 2; REWR 2; UND 2; EXPAND_TAC "f"; (* -- *) ASM_SIMP_TAC[REAL_DIV_RMUL;REAL_ARITH `&0 < x ==> ~(x = &0)`]; REDUCE_TAC; (* Tue Aug 17 19:35:13 EDT 2004 *) ]);; (* }}} *) let abssinx_lemma = prove_by_refinement( `!x. (&0 <= x) ==> ((abs (sin x)) <= abs x)`, (* {{{ proof *) [ GEN_TAC; REP_BASIC_TAC; TYPE_THEN `abs x = x` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; DISCH_THEN_REWRITE; TYPE_THEN `x <= pi` ASM_CASES_TAC; TYPE_THEN `&0 <= sin x` SUBGOAL_TAC; IMATCH_MP_TAC SIN_POS_PI_LE; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `abs (sin x) = sin x` SUBGOAL_TAC; UND 2; REAL_ARITH_TAC; DISCH_THEN_REWRITE; ASM_MESON_TAC[sinx_le_x]; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `&1` EXISTS_TAC; CONJ_TAC; ASSUME_TAC SIN_BOUNDS; TSPEC `x` 2; UND 2; REAL_ARITH_TAC; UND 1; TYPE_THEN `&3 < pi` SUBGOAL_TAC; REWRITE_TAC[pi_bounds]; REAL_ARITH_TAC; (* Tue Aug 17 22:54:49 EDT 2004 *) ]);; (* }}} *) let abssinx_le = prove_by_refinement( `!x. abs (sin x) <= abs x`, (* {{{ proof *) [ GEN_TAC; TYPE_THEN `(&0 <= x) \/ (&0 <= -- x)` SUBGOAL_TAC; REAL_ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; ASM_MESON_TAC[abssinx_lemma]; TYPE_THEN `y = --x` ABBREV_TAC ; TYPE_THEN `x = --y` SUBGOAL_TAC; UND 1; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); REWRITE_TAC[SIN_NEG;REAL_ABS_NEG]; ASM_MESON_TAC[abssinx_lemma]; (* Tue Aug 17 22:59:20 EDT 2004 *) ]);; (* }}} *) let cos_double2 = prove_by_refinement( `!x. cos (&2 * x) = &1 - &2 * (sin x pow 2)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[COS_DOUBLE;GSYM SIN_CIRCLE ]; REAL_ARITH_TAC; ]);; (* }}} *) let sin_half = prove_by_refinement( `!x. &2 * (sin (x/(&2)) pow 2) = &1 - cos (x)`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC cos_double2; TSPEC `x/ &2` 0; TYPE_THEN `&2 *(x/(&2)) = x` SUBGOAL_TAC; REWRITE_TAC[REAL_MUL_2;]; REDUCE_TAC; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ]);; (* }}} *) let x_diff_y2 = prove_by_refinement( `!x y. (x - y) pow 2 = x*x - &2*x*y + y*y`, (* {{{ proof *) [ REWRITE_TAC[REAL_POW_2]; real_poly_tac; ]);; (* }}} *) let cosdiff2 = prove_by_refinement( `!x y. (cos x - cos y) pow 2 + (sin x - sin y) pow 2 = (&2 * sin ((x - y)/(&2))) pow 2`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[POW_MUL]; TYPE_THEN `!z. &2 pow 2 * z = &2 *(&2 *z)` SUBGOAL_TAC ; REWRITE_TAC[POW_2]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[sin_half]; TYPE_THEN `cos (x - y) = cos (x + (--y))` SUBGOAL_TAC; AP_TERM_TAC; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[COS_ADD ]; REWRITE_TAC[SIN_NEG;COS_NEG;REAL_ARITH `x - u*(-- v) = x + u*v`]; REWRITE_TAC[x_diff_y2]; REWRITE_TAC[POW_2]; TYPE_THEN `a = cos x` ABBREV_TAC ; TYPE_THEN `b = sin x` ABBREV_TAC ; TYPE_THEN `a' = cos y` ABBREV_TAC ; TYPE_THEN `b' = sin y` ABBREV_TAC ; REWRITE_TAC[REAL_ARITH `x*(y-z) = x*y - x*z`]; TYPE_THEN `&2 * &1 = ((b pow 2) + (a pow 2)) + ((b' pow 2) + (a' pow 2))` SUBGOAL_TAC; EXPAND_TAC "a"; EXPAND_TAC "b"; EXPAND_TAC "a'"; EXPAND_TAC "b'"; REWRITE_TAC[SIN_CIRCLE]; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[POW_2]; real_poly_tac; (* Tue Aug 17 23:38:27 EDT 2004 *) ]);; (* }}} *) let d_euclid_cis = prove_by_refinement( `!x y. d_euclid (cis x) (cis y) = &2 * (abs (sin ((x-y)/(&2))))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[cis;d_euclid_point;cosdiff2;POW_2_SQRT_ABS;ABS_MUL;]; REWRITE_TAC[REAL_ARITH `abs (&2) = &2`]; (* Tue Aug 17 23:41:30 EDT 2004 *) ]);; (* }}} *) let d_euclid_cis_ineq = prove_by_refinement( `!x y. d_euclid (cis x) (cis y) <= abs (x - y)`, (* {{{ proof *) [ REWRITE_TAC[d_euclid_cis]; REP_GEN_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `&2 * (abs ((x-y)/(&2)))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_PROP_LE_LMUL; ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`;abssinx_le]; REWRITE_TAC[REAL_ARITH `!z. &2*(abs z) = abs (&2 *z)`]; TYPE_THEN `&2 * ((x - y)/(&2)) = (x - y)` SUBGOAL_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REAL_ARITH_TAC; (* Wed Aug 18 06:42:28 EDT 2004 *) ]);; (* }}} *) let polar_fg_inj = prove_by_refinement( `!f g p. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\ (!x. (&0 <= x /\ x <= &1) ==> (&0 <= f x)) /\ (euclid 2 p) ==> INJ (\t. p + (f t)*# (cis (g t))) {x | &0 <= x /\ x <= &1} (euclid 2)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[INJ;polar_euclid]; ASM_SIMP_TAC[euclid_add_closure;polar_euclid]; REP_BASIC_TAC; (* INSERT *) TYPE_THEN `(f x *# cis (g x)) = (f y *# cis (g y))` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; USE 3 (REWRITE_RULE[FUN_EQ_THM]); TSPEC `x'` 3; USE 3(REWRITE_RULE[euclid_plus]); UND 3; REAL_ARITH_TAC; KILL 3; DISCH_TAC; (* end ins *) USE 3 (AP_TERM `norm2`); USE 3 (REWRITE_RULE[norm2_scale_cis]); TYPE_THEN `&0 <= f x /\ &0 <= f y` SUBGOAL_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[GSYM REAL_ABS_REFL]); REWR 3; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let polar_distinct = prove_by_refinement( `!f g g'. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\ (!x. (&0 <= x /\ x <= &1) ==> (&0 < f x)) /\ (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g x /\ g x < &2 * pi)) /\ (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g' x /\ g' x < &2 * pi)) ==> (!x y. (&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 /\ ((f x)*# (cis (g x)) = (f y)*# (cis (g' y)))) ==> (x = y) /\ (g x = g' y)) `, (* {{{ proof *) [ REP_BASIC_TAC; COPY 0; USE 0 (AP_TERM `norm2`); USE 0 (REWRITE_RULE[norm2_scale_cis]); TYPE_THEN `&0 < f x /\ &0 < f y` SUBGOAL_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `f x = f y` SUBGOAL_TAC; UND 0; UND 10; UND 11; REAL_ARITH_TAC; DISCH_TAC; (* -- *) SUBCONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE [INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); TYPEL_THEN [`g y`;`g' y`;`f y`;`f y`] (fun t-> ANT_TAC (ISPECL t polar_inj)); ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_ARITH `&0 < t ==> &0 <= t`]; DISCH_THEN DISJ_CASES_TAC; PROOF_BY_CONTR_TAC; REP_BASIC_TAC; UND 13; UND 10; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; (* Wed Aug 18 07:42:54 EDT 2004 *) ]);; (* }}} *) let d_euclid_eq_arg = prove_by_refinement( `!r r' x. (d_euclid (r *# (cis x)) (r' *# (cis x)) = abs (r - r'))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[cis;point_scale;d_euclid_point]; REWRITE_TAC[GSYM REAL_SUB_RDISTRIB;POW_MUL;GSYM REAL_ADD_LDISTRIB]; ONCE_REWRITE_TAC [REAL_ARITH `x + y = y + x`]; REWRITE_TAC[SIN_CIRCLE]; REDUCE_TAC; REWRITE_TAC[POW_2_SQRT_ABS]; (* Wed Aug 18 08:15:39 EDT 2004 *) ]);; (* }}} *) (* not used *) let one_over_plus1 = prove_by_refinement( `!t. (&0 <= t) ==> (t / (&1 + t) <= &1)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC REAL_LE_LDIV; UND 0; REAL_ARITH_TAC; (* Wed Aug 18 08:17:46 EDT 2004 *) ]);; (* }}} *) let polar_cont = prove_by_refinement( `!p f g. continuous f (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real)) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real)) /\ (euclid 2 p) ==> continuous (\t. p + (f t) *# cis(g t)) (top_of_metric(UNIV,d_real)) (top2)`, (* {{{ proof *) [ REP_GEN_TAC; DISCH_TAC; TYPE_THEN `IMAGE (\t. p + (f t) *# cis(g t)) UNIV SUBSET (euclid 2)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IMAGE ]; ASM_MESON_TAC[euclid_add_closure;polar_euclid]; REWRITE_TAC[top2]; UND 0; ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_euclid;metric_real]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; REP_BASIC_TAC; RIGHT_TAC "delta"; DISCH_TAC; TYPEL_THEN [`x`;`epsilon/(&2)`] (USE 3 o ISPECL); TYPEL_THEN [`x`;`(&1/(&1 + abs (f x)))*(epsilon/(&2))`] (USE 2 o ISPECL); REP_BASIC_TAC; TYPE_THEN `&0 < epsilon/(&2)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF1]; DISCH_TAC; TYPE_THEN `&0 < &1 / (&1 + abs (f x)) * epsilon / &2` SUBGOAL_TAC; IMATCH_MP_TAC REAL_PROP_POS_MUL2; ASM_REWRITE_TAC[]; IMATCH_MP_TAC REAL_LT_DIV; REAL_ARITH_TAC; DISCH_TAC; REWR 3; REWR 2; REP_BASIC_TAC; TYPE_THEN `min_real delta delta'` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[min_real]; UND 3; UND 8; COND_CASES_TAC; REAL_ARITH_TAC; REAL_ARITH_TAC; REP_BASIC_TAC; TYPE_THEN `d_real x y < delta /\ d_real x y < delta'` SUBGOAL_TAC ; UND 9; REWRITE_TAC[min_real]; COND_CASES_TAC; UND 9; REAL_ARITH_TAC; UND 9; REAL_ARITH_TAC; REP_BASIC_TAC; TSPEC `y` 2; TSPEC `y` 7; REWR 2; REWR 7; (* A-- *) IMATCH_MP_TAC REAL_LET_TRANS; TYPE_THEN `d_euclid (p + f x *# cis(g x)) (p + f x *# cis(g y)) + d_euclid (p + f x *# cis(g y)) (p + f y *# cis(g y))` EXISTS_TAC; TYPE_THEN `!z r x r' x'. d_euclid (p + r *# (cis x)) (p + r' *# (cis x')) = d_euclid (r*# (cis x)) (r' *# (cis x'))` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC metric_translate_LEFT; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[polar_euclid]; DISCH_THEN_REWRITE; (* end of add-on *) CONJ_TAC; IMATCH_MP_TAC metric_space_triangle; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_SIMP_TAC[polar_euclid;metric_euclid]; REWRITE_TAC[d_euclid_eq_arg]; TYPEL_THEN[`2`;`f x`;`cis (g x)`;`cis (g y)`] (fun t-> ANT_TAC (ISPECL t norm_scale_vec)); REWRITE_TAC[cis;euclid_point]; DISCH_THEN_REWRITE; TYPE_THEN `!x y z. (x <= z/ &2 /\ y < z/ &2 ==> x + y < z/ &2 + z/ &2)` SUBGOAL_TAC; REAL_ARITH_TAC; REWRITE_TAC[REAL_HALF_DOUBLE]; DISCH_THEN IMATCH_MP_TAC ; USE 2 (REWRITE_RULE[d_real]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `abs (f x) * (&1 / (&1 + abs (f x)) * epsilon / &2)` EXISTS_TAC; (* B-- *) CONJ_TAC; IMATCH_MP_TAC REAL_PROP_LE_LMUL; REWRITE_TAC[REAL_MK_NN_ABS]; IMATCH_MP_TAC (REAL_ARITH `!y. (x <= y /\ y < z) ==> (x <= z)`); TYPE_THEN `abs (g x - g y)` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[d_euclid_cis_ineq]; USE 7 (REWRITE_RULE[d_real]); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `(x*y*z <= z) <=> ((x*y)*(z) <= &1 * (z))`]; IMATCH_MP_TAC REAL_PROP_LE_RMUL; CONJ_TAC; REWRITE_TAC[real_div]; REDUCE_TAC; REWRITE_TAC[GSYM real_div]; IMATCH_MP_TAC REAL_LE_LDIV; REAL_ARITH_TAC; UND 5; REAL_ARITH_TAC; ]);; (* }}} *) let lc_bounds = prove_by_refinement( `!a b x. (&0 <= x /\ x <= &1) ==> (min_real a b <= x*a + (&1- x)*b) /\ (x*a + (&1 - x)*b <= max_real a b)`, (* {{{ proof *) [ REP_BASIC_TAC; CONJ_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; ineq_le_tac `a + (&1 - x)*(b - a) = (x*a + (&1- x)*b)`; ineq_le_tac `b + x*(a - b) = x*a + (&1- x)*b`; REWRITE_TAC[max_real]; COND_CASES_TAC; ineq_le_tac `(x*a + (&1 - x)*b) + (&1 - x)*(a - b) = a`; ineq_le_tac `(x*a + (&1 - x)*b) + (x*(b - a)) = b`; (* Wed Aug 18 11:52:54 EDT 2004 *) ]);; (* }}} *) let min_real_symm = prove_by_refinement( `!a b. min_real a b = min_real b a`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`)); ASM_REWRITE_TAC[]; COND_CASES_TAC; ASM_REWRITE_TAC[]; UND 0; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let max_real_symm = prove_by_refinement( `!a b. max_real a b = max_real b a`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[max_real]; COND_CASES_TAC; USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`)); ASM_REWRITE_TAC[]; COND_CASES_TAC; ASM_REWRITE_TAC[]; UND 0; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let curve_annulus_lemma = prove_by_refinement( `!r g p. (&0 < r) /\ (euclid 2 p) ==> (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t))) {x | &0 <= x /\ x <= &1}) SUBSET ({ x | (r/(&2) <= d_euclid p x /\ d_euclid p x <= r)} )`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE;SUBSET]; REP_BASIC_TAC; UND 2; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC; IMATCH_MP_TAC d_euclidpq; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[polar_euclid]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM norm2;norm2_scale_cis]; TYPE_THEN `r/(&2) < r` SUBGOAL_TAC; ASM_MESON_TAC[half_pos]; DISCH_TAC; TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC; REWRITE_TAC[min_real;max_real]; ASM_REWRITE_TAC[]; COND_CASES_TAC; UND 2; UND 5; REAL_ARITH_TAC; REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ; CONJ_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `&0 < x ==> &0 <= x`); ASM_REWRITE_TAC[REAL_LT_HALF1]; ONCE_REWRITE_TAC [min_real_symm]; ASM_MESON_TAC[lc_bounds]; REWRITE_TAC[GSYM ABS_REFL]; DISCH_THEN_REWRITE; ASM_MESON_TAC[lc_bounds;min_real_symm;max_real_symm]; (* Wed Aug 18 12:13:50 EDT 2004 *) ]);; (* }}} *) let curve_circle_lemma = prove_by_refinement( `!r g p. (&0 < r) /\ (euclid 2 p) ==> (((IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t))) {x | &0 <= x /\ x <= &1}) INTER ({ x | d_euclid p x <= (r/(&2))})) = { ( p + (r/(&2)) *# (cis (g (&0) ))) }) `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[IMAGE;SUBSET;INTER;]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; GEN_TAC; (* A *) EQ_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); REP_BASIC_TAC; CONJ_TAC; TYPE_THEN `&0` EXISTS_TAC; REDUCE_TAC; TYPEL_THEN [`2`;`p`;`(r / &2 *# cis (g (&0)))`] (fun t-> ANT_TAC (ISPECL t d_euclidpq)); ASM_REWRITE_TAC[polar_euclid]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM norm2;norm2_scale_cis;]; IMATCH_MP_TAC (REAL_ARITH `(x = y) ==> (x <= y)`); REWRITE_TAC[ABS_REFL]; IMATCH_MP_TAC (REAL_ARITH `(&0 < x) ==> (&0 <= x)`); ASM_REWRITE_TAC[REAL_LT_HALF1]; REP_BASIC_TAC; (* B other direction *) UND 3; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); PROOF_BY_CONTR_TAC; UND 2; TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC; IMATCH_MP_TAC d_euclidpq; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[polar_euclid]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM norm2;norm2_scale_cis]; TYPE_THEN `r/(&2) < r` SUBGOAL_TAC; ASM_MESON_TAC[half_pos]; DISCH_TAC; TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC; REWRITE_TAC[min_real;max_real]; ASM_REWRITE_TAC[]; COND_CASES_TAC; UND 2; UND 6; REAL_ARITH_TAC; REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ; CONJ_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `&0 < x ==> &0 <= x`); ASM_REWRITE_TAC[REAL_LT_HALF1]; ONCE_REWRITE_TAC [min_real_symm]; ASM_MESON_TAC[lc_bounds]; REWRITE_TAC[GSYM ABS_REFL]; DISCH_THEN_REWRITE; TYPE_THEN `~(x' = &0)` SUBGOAL_TAC; DISCH_TAC; UND 7; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); UND 3; REDUCE_TAC; DISCH_TAC; TYPE_THEN `&0 < x'` SUBGOAL_TAC; UND 7; UND 5; REAL_ARITH_TAC; DISCH_TAC; IMATCH_MP_TAC (REAL_ARITH `a < b ==> ~(b <= a)`); ineq_lt_tac `(r/ &2) + x'* (r - (r/(&2))) = (x' * r + (&1 - x') * r / &2)`; (* Wed Aug 18 12:41:16 EDT 2004 *) ]);; (* }}} *) let curve_simple_lemma = prove_by_refinement( `!r g p. (&0 < r) /\ (euclid 2 p) /\ (continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real))) ==> (simple_arc_end (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t))) {x | &0 <= x /\ x <= &1}) (p + (r/(&2))*# (cis (g (&0)))) (p + (r)*# (cis (g (&1)))))`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; REP_BASIC_TAC; TYPE_THEN `(\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))` EXISTS_TAC; ASM_REWRITE_TAC[]; REDUCE_TAC; CONJ_TAC; IMATCH_MP_TAC polar_cont; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV]; REWRITE_TAC[linear_cont]; IMATCH_MP_TAC polar_fg_inj; ASM_REWRITE_TAC[INJ;SUBSET_UNIV ]; (* -- *) CONJ_TAC; REP_BASIC_TAC; USE 3 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]); TYPE_THEN `(x * r + (&1 - x) * r / &2) - (y * r + (&1 - y) * r / &2) = (x - y)*(r - r/(&2)) ` SUBGOAL_TAC; real_poly_tac; DISCH_TAC; REWR 3; USE 3(REWRITE_RULE[REAL_ENTIRE]); UND 3; DISCH_THEN DISJ_CASES_TAC; UND 3; REAL_ARITH_TAC; PROOF_BY_CONTR_TAC; UND 3; TYPE_THEN `r - r/(&2) = (r/ &2 + r/ &2) - r/ &2` SUBGOAL_TAC; REWRITE_TAC[REAL_HALF_DOUBLE]; DISCH_THEN_REWRITE; REWRITE_TAC[REAL_ARITH `(x + x) - x = x`]; USE 2 (ONCE_REWRITE_RULE [GSYM REAL_HALF_DOUBLE]); USE 2 (REWRITE_RULE[REAL_DIV_LZERO]); UND 2; REAL_ARITH_TAC; (* -- *) GEN_TAC; DISCH_TAC; WITH 3 (MATCH_MP lc_bounds); TYPEL_THEN [`r`;`r/ &2`] (USE 4 o ISPECL); IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `min_real r (r/ &2)` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `r / &2 < r` SUBGOAL_TAC; UND 2; MESON_TAC [half_pos]; TYPE_THEN `&0 < r/ (&2)` SUBGOAL_TAC; ASM_MESON_TAC[half_pos]; TYPE_THEN `a = r/ &2` ABBREV_TAC ; REWRITE_TAC[min_real]; COND_CASES_TAC; REAL_ARITH_TAC; REAL_ARITH_TAC; (* Wed Aug 18 14:02:54 EDT 2004 *) ]);; (* }}} *) let segpath = jordan_def `segpath x y t = t* x + (&1 - t)*y` ;; let segpathxy = prove_by_refinement( `!x y. segpath x y = (\ t. t*x + (&1 - t)*y)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[segpath]; ]);; (* }}} *) let segpath_lemma = prove_by_refinement( `(!x y . (continuous (segpath x y) (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real)))) /\ (!x y b. (&0 <= x /\ x < b /\ &0 <= y /\ y < b ==> (!t. &0 <= t /\ t <= &1 ==> &0 <= segpath x y t /\ segpath x y t < b))) /\ (!x y x' y' t. (x < x' /\ y < y' /\ &0 <= t /\ t <= &1) ==> ~(segpath x y t = segpath x' y' t))`, (* {{{ proof *) [ REP_BASIC_TAC; CONJ_TAC; REP_BASIC_TAC; ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_real]; REWRITE_TAC[segpathxy;linear_cont]; (* -- *) CONJ_TAC; REP_BASIC_TAC; REWRITE_TAC[segpath]; CONJ_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `min_real x y` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[lc_bounds]; IMATCH_MP_TAC REAL_LET_TRANS; TYPE_THEN `max_real x y` EXISTS_TAC; CONJ_TAC; ASM_MESON_TAC[lc_bounds]; REWRITE_TAC[max_real]; COND_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[segpath]; REP_BASIC_TAC; UND 0; REWRITE_TAC[REAL_ARITH `(u + v = u' + v') <=> ((u' - u) + (v' - v) = &0)`]; REWRITE_TAC[GSYM REAL_SUB_LDISTRIB]; TYPE_THEN `t = &0` ASM_CASES_TAC; ASM_REWRITE_TAC[]; REDUCE_TAC; UND 3; REAL_ARITH_TAC; TYPE_THEN `t = &1` ASM_CASES_TAC; ASM_REWRITE_TAC[]; REDUCE_TAC; UND 4; REAL_ARITH_TAC; (* -- *) TYPE_THEN `&0 < t * (x' - x) + (&1 - t)*(y' - y)` SUBGOAL_TAC; ineq_lt_tac `&0 + t * (x' - x) + (&1 - t)*(y' - y) = (t*(x' - x) + (&1- t)*(y' - y))` ; UND 5; UND 1; REAL_ARITH_TAC; REAL_ARITH_TAC; (* Wed Aug 18 14:48:37 EDT 2004 *) ]);; (* }}} *) let segpath_end = prove_by_refinement( `!x y. ( segpath x y (&0) = y) /\ (segpath x y (&1) = x)`, (* {{{ proof *) [ REWRITE_TAC[segpath]; REAL_ARITH_TAC; ]);; (* }}} *) let segpath_inj = prove_by_refinement( `!x y. ~(x = y) ==> INJ (segpath x y) {t | &0 <= t /\ t <= &1} UNIV`, (* {{{ proof *) [ REWRITE_TAC[segpath;INJ;SUBSET_UNIV]; REP_BASIC_TAC; USE 0 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]); TYPE_THEN `(x' * x + (&1 - x') * y) - (y' * x + (&1 - y') * y) = (x' - y')*(x - y) ` SUBGOAL_TAC; real_poly_tac; DISCH_TAC; REWR 0; USE 0(REWRITE_RULE[REAL_ENTIRE]); UND 0; DISCH_THEN DISJ_CASES_TAC; UND 0; REAL_ARITH_TAC; PROOF_BY_CONTR_TAC; UND 0; UND 5; REAL_ARITH_TAC; (* Wed Aug 18 15:15:11 EDT 2004 *) ]);; (* }}} *) let degree_vertex_annulus = prove_by_refinement( `!n r p xx zz. (&0 < r) /\ (euclid 2 p) /\ (!j. j < n ==> (&0 <= xx j /\ xx j < &2 * pi)) /\ (!j. j < n ==> (&0 <= zz j /\ zz j < &2 * pi)) /\ (!i j. (i < j) /\ (j <| n) ==> (xx i < xx j)) /\ (!i j. (i < j) /\ (j < n) ==> (zz i < zz j)) ==> (?C. (!i. (i < n) ==> simple_arc_end (C i ) (p + (r/ &2)*# (cis(zz i))) (p + r*# (cis(xx i)))) /\ (!i j. (i < n) /\ (j < n) /\ (~(i=j)) ==> (C i INTER C j = EMPTY )) /\ (!i. (i< n) ==> C i SUBSET ({ x | (r/(&2) <= d_euclid p x /\ d_euclid p x <= r)} )) /\ (!i. (i< n) ==> (C i INTER ({ x | d_euclid p x <= (r/(&2))}) = { ( p + (r/(&2)) *# (cis (zz i ))) })) ) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `C = ( \ i. IMAGE ( \ t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (segpath (xx i) (zz i) t))) {t | &0 <= t /\ t <= &1})` ABBREV_TAC ; TYPE_THEN `C` EXISTS_TAC; (* -- *) CONJ_TAC; REP_BASIC_TAC; EXPAND_TAC "C"; TYPEL_THEN [`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> (ANT_TAC(ISPECL t curve_simple_lemma))); ASM_REWRITE_TAC[segpath_lemma]; REWRITE_TAC[segpath_end]; (* -- *) TYPE_THEN `&0 < r/ &2 /\ r / &2 < r` SUBGOAL_TAC; IMATCH_MP_TAC half_pos; ASM_REWRITE_TAC[]; DISCH_TAC; CONJ_TAC; REP_BASIC_TAC; TYPEL_THEN [`( \ t. t * r + (&1 - t) * r / &2)`;`segpath (xx i) (zz i)`;`segpath (xx j) (zz j)`] (fun t-> ANT_TAC (ISPECL t polar_distinct)); ASM_REWRITE_TAC[]; (* --- *) CONJ_TAC; TYPEL_THEN [`r`;`r / &2`] (fun t-> ANT_TAC(ISPECL t segpath_inj)); UND 10; REAL_ARITH_TAC; REWRITE_TAC[segpathxy]; (* --- *) CONJ_TAC; REP_BASIC_TAC; ineq_lt_tac `&0 + (x* (r - r/(&2))) + (r/ &2) = x*r + (&1 - x)*(r/ &2)`; (* --- *) ASM_MESON_TAC[segpath_lemma]; (* -- *) DISCH_TAC; EXPAND_TAC "C"; REWRITE_TAC[EQ_EMPTY]; GEN_TAC; REWRITE_TAC[IMAGE;INTER]; REP_BASIC_TAC; UND 13; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t])); TYPEL_THEN[`x'`;`x''`] (USE 12 o ISPECL); REWR 12; TYPE_THEN `((x'' * r + (&1 - x'') * r / &2) *# cis (segpath (xx j) (zz j) x'')) = ((x' * r + (&1 - x') * r / &2) *# cis (segpath (xx i) (zz i) x'))` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; USE 16 ( (REWRITE_RULE[FUN_EQ_THM])); TSPEC `x'''` 13; UND 13; REWRITE_TAC[euclid_plus]; REAL_ARITH_TAC; DISCH_TAC; KILL 16; USE 13 (ONCE_REWRITE_RULE [EQ_SYM_EQ]); REWR 12; REP_BASIC_TAC; USE 16 GSYM; UND 16; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t])); TYPE_THEN `(i <| j) \/ (j < i)` SUBGOAL_TAC; UND 7; ARITH_TAC; (* ---- *) DISCH_THEN DISJ_CASES_TAC; TYPEL_THEN [`i`;`j`] (USE 0 o ISPECL); TYPEL_THEN [`i`;`j`] (USE 1 o ISPECL); KILL 2; KILL 3; KILL 6; KILL 13; ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)]; TYPEL_THEN [`j`;`i`] (USE 0 o ISPECL); TYPEL_THEN [`j`;`i`] (USE 1 o ISPECL); KILL 2; KILL 3; KILL 6; KILL 13; ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)]; (* B-- *) CONJ_TAC; REP_BASIC_TAC; EXPAND_TAC "C"; IMATCH_MP_TAC curve_annulus_lemma; ASM_REWRITE_TAC[]; (* -- *) REP_BASIC_TAC; EXPAND_TAC "C"; TYPEL_THEN[`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> ANT_TAC(ISPECL t curve_circle_lemma)); ASM_REWRITE_TAC[]; REWRITE_TAC[segpath_end]; (* Wed Aug 18 15:57:53 EDT 2004 *) ]);; (* }}} *) let closed_ball2_center = prove_by_refinement( `!p r. closed_ball (euclid 2,d_euclid) p r p <=> (euclid 2 p) /\ (&0 <= r)`, (* {{{ proof *) [ REWRITE_TAC[closed_ball]; TYPE_THEN `!p. (euclid 2 p) ==> (d_euclid p p = &0)` SUBGOAL_TAC; DISCH_ALL_TAC; IMATCH_MP_TAC metric_space_zero; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[metric_euclid]; ASM_MESON_TAC[]; ]);; (* }}} *) let degree_vertex_disk = prove_by_refinement( `!r p xx . (&0 < r) /\ (euclid 2 p) /\ (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\ (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j)) ==> (?C. (!i. (i< 4) ==> (?C' C'' v. simple_arc_end C' p v /\ simple_arc_end C'' v (p + r*# (cis(xx i ))) /\ C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\ (C' INTER C'' = {v}) /\ (C' UNION C'' = C i )) /\ simple_arc_end (C i ) p (p + r*# (cis(xx i))) /\ C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\ C i INTER (closed_ball(euclid 2,d_euclid) p (r / &2)) SUBSET (hyperplane 2 e2 (p 1) UNION hyperplane 2 e1 (p 0))) /\ (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==> (C i INTER C j = {p} ))) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(&0 < (r /(&2))) /\ (euclid 2 p)` SUBGOAL_TAC; ASM_REWRITE_TAC[REAL_LT_HALF1]; DISCH_THEN (fun t-> MP_TAC (MATCH_MP degree4_vertex_hv t)); REP_BASIC_TAC; TYPE_THEN `C' = C` ABBREV_TAC ; KILL 10; TYPE_THEN `zz = (\j. (&j) * pi/(&2))` ABBREV_TAC ; TYPE_THEN `(&0 < r) /\ (euclid 2 p) /\ (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\ (!j. j < 4 ==> (&0 <= zz j /\ zz j < &2 * pi)) /\ (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j)) /\ (!i j. (i < j) /\ (j < 4) ==> (zz i < zz j))` SUBGOAL_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; EXPAND_TAC "zz"; REP_BASIC_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_MUL; CONJ_TAC; REDUCE_TAC; IMATCH_MP_TAC REAL_LE_DIV; MP_TAC PI_POS; REAL_ARITH_TAC; REWRITE_TAC[real_div;REAL_ARITH `pi*x = x*pi`]; REWRITE_TAC[REAL_ARITH `x*y*z = (x*y)*z`]; IMATCH_MP_TAC REAL_PROP_LT_RMUL; ASM_REWRITE_TAC[PI_POS;GSYM real_div;]; ASM_SIMP_TAC[REAL_LT_LDIV_EQ;REAL_ARITH `&0 < &2`]; REDUCE_TAC; UND 11; ARITH_TAC; REP_BASIC_TAC; EXPAND_TAC "zz"; ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> (&0 < y - x)`]; REWRITE_TAC[REAL_ARITH `x*y - z*y = (x - z)*y`]; IMATCH_MP_TAC REAL_PROP_POS_MUL2; REWRITE_TAC[PI2_BOUNDS]; REDUCE_TAC; UND 12; REWRITE_TAC[REAL_ARITH `&0 < &j - &i <=> &i < &j`]; REDUCE_TAC; DISCH_THEN (fun t-> MP_TAC (MATCH_MP degree_vertex_annulus t)); REP_BASIC_TAC; (* A *) TYPE_THEN `(\j. C' j UNION C'' j)` EXISTS_TAC; BETA_TAC; (* B 1st conjunct *) TYPE_THEN `!i. (i<| 4) ==> (simple_arc_end (C' i ) p (p + ((r/ &2) *# (cis (&i * pi/(&2))))) /\ simple_arc_end (C'' i) (p + ((r/ &2) *# (cis (&i * pi/(&2))))) (euclid_plus p (r *# cis (xx i))) /\ (C' i) SUBSET closed_ball (euclid 2,d_euclid) p (r / &2) /\ ((C' i) INTER (C'' i) = {(p + ((r/ &2) *# (cis (&i * pi/(&2)))))})) ` SUBGOAL_TAC; REP_BASIC_TAC; SUBCONJ_TAC; ASM_MESON_TAC[]; DISCH_TAC; SUBCONJ_TAC; ASM_MESON_TAC[]; DISCH_TAC; SUBCONJ_TAC; ASM_MESON_TAC[]; DISCH_TAC; REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INR IN_SING;INTER ]; EQ_TAC; DISCH_TAC; TYPE_THEN `closed_ball (euclid 2,d_euclid) p (r / &2) x` SUBGOAL_TAC; UND 18; REWRITE_TAC[SUBSET]; UND 19; MESON_TAC[]; TSPEC `i` 11; REWR 11; REWRITE_TAC[closed_ball]; FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`)); UND 19; REWRITE_TAC[INTER;INR IN_SING;]; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; EXPAND_TAC "zz"; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; UND 17; UND 16; MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; DISCH_TAC; ASM_REWRITE_TAC[]; (* [C] 1nd conjunct. simple-arc-end; *) TYPE_THEN `D = closed_ball (euclid 2,d_euclid) p (r /(&2))` ABBREV_TAC ; TYPE_THEN `!i x. (i <| 4) /\ (D x) ==> ((C' i UNION C'' i) x = C' i x)` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[UNION]; IMATCH_MP_TAC (TAUT `(b ==> a) ==> (a \/ b <=> a)`); TSPEC `i` 11; REWR 11; FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`)); UND 17; EXPAND_TAC"D"; REWRITE_TAC[closed_ball]; REWRITE_TAC[INTER;INR IN_SING]; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; ASM_MESON_TAC[simple_arc_end_end2]; DISCH_TAC; (* -- *) TYPE_THEN `!i x. (i <| 4) /\ ~(D x) ==> ((C' i UNION C'' i) x = C'' i x)` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[UNION]; IMATCH_MP_TAC (TAUT `(a ==> b) ==> (a \/ b <=> b)`); TSPEC `i` 5; REWR 5; USE 5 (REWRITE_RULE[SUBSET]); TSPEC `x` 5; UND 5; UND 18; MESON_TAC[]; DISCH_TAC; ONCE_REWRITE_TAC [TAUT `(x /\ y) <=> (y /\ x)`]; (* D-- *) CONJ_TAC; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER;INR IN_SING]; TYPE_THEN `D x` ASM_CASES_TAC; TYPEL_THEN [`i`;`x`] (WITH 17 o ISPECL); TYPEL_THEN [`j`;`x`] (WITH 17 o ISPECL); UND 23; UND 24; KILL 17; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; TYPEL_THEN [`i`;`j`;] (USE 7 o ISPECL); REWR 7; FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`)); REWRITE_TAC[INTER;INR IN_SING]; (* --2-- *) TYPEL_THEN [`i`;`x`] (WITH 18 o ISPECL); TYPEL_THEN [`j`;`x`] (WITH 18 o ISPECL); UND 23; UND 24; KILL 18; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; TYPEL_THEN [`i`;`j`;] (USE 13 o ISPECL); REWR 13; USE 13 (REWRITE_RULE[EQ_EMPTY;INTER ]); ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USE 18(REWRITE_RULE[]); UND 18; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); UND 22; REWRITE_TAC[]; EXPAND_TAC "D"; REWRITE_TAC[closed_ball2_center]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REAL_ARITH `&0 &0 <= x`); ASM_REWRITE_TAC[REAL_LT_HALF1]; (* E *) REP_BASIC_TAC; CONJ_TAC; TYPE_THEN `C' i` EXISTS_TAC; TYPE_THEN `C'' i` EXISTS_TAC; TYPE_THEN `p + (r / &2 *# cis (&i * pi / &2))` EXISTS_TAC; ASM_MESON_TAC[]; (* -- *) CONJ_TAC; IMATCH_MP_TAC simple_arc_end_trans; ASM_MESON_TAC[]; (* -- *) CONJ_TAC; REWRITE_TAC[union_subset]; CONJ_TAC; TSPEC `i` 5; UND 5; ASM_REWRITE_TAC[]; EXPAND_TAC "D"; REWRITE_TAC[SUBSET;closed_ball;]; TYPE_THEN `r / &2 < r` SUBGOAL_TAC; UND 3; MESON_TAC[half_pos]; MESON_TAC[REAL_ARITH `(x <= y) /\ (y < z) ==> (x <= z)`]; TSPEC `i` 12; UND 12; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;closed_ball]; ASM_REWRITE_TAC[]; TSPEC `i` 14; REWR 12; TYPE_THEN `C'' i SUBSET (euclid 2)` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; UND 12; MESON_TAC[]; REWRITE_TAC[SUBSET]; MESON_TAC[]; (* -- *) KILL 15; KILL 9; KILL 8; KILL 11; KILL 12; TYPE_THEN `(C' i UNION C'' i) INTER D = (C' i INTER D)` SUBGOAL_TAC; REWRITE_TAC[INTER]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; UND 17; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TSPEC `i` 4; REWR 4; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C' i` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER;SUBSET]; MESON_TAC[]; (* Thu Aug 19 07:36:47 EDT 2004 *) ]);; (* }}} *) let euclid_cancel1 = prove_by_refinement( `!x y z. (x = euclid_plus y z) <=> (x - y = z)`, (* {{{ proof *) [ REP_BASIC_TAC; EQ_TAC; DISCH_THEN_REWRITE; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[euclid_plus;euclid_minus]; REAL_ARITH_TAC; DISCH_TAC; USE 0 SYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[euclid_plus;euclid_minus]; REAL_ARITH_TAC; ]);; (* }}} *) let infinite_subset = prove_by_refinement( `!(X:A->bool) Y. INFINITE X /\ X SUBSET Y ==> INFINITE Y`, (* {{{ proof *) [ REWRITE_TAC[INFINITE]; MESON_TAC[FINITE_SUBSET]; ]);; (* }}} *) let EXPinj = prove_by_refinement( `!x y n. (1 < n) /\ (n **| x = n **| y) ==> (x = y)`, (* {{{ proof *) [ TYPE_THEN `! x y n. (x <| y) /\ (n **| x = n **| y) ==> ~(1 <| n)` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `n **| y <= n **| x` SUBGOAL_TAC; UND 1; ARITH_TAC; REWRITE_TAC[LE_EXP]; TYPE_THEN `~(n = 0)` SUBGOAL_TAC; UND 0; ARITH_TAC; DISCH_THEN_REWRITE; REWRITE_TAC[DE_MORGAN_THM]; CONJ_TAC; UND 0; ARITH_TAC; UND 2; ARITH_TAC; DISCH_TAC; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `x < y \/ y <| x` SUBGOAL_TAC; UND 3; ARITH_TAC; DISCH_THEN DISJ_CASES_TAC; TYPEL_THEN[`x`;`y`;`n`] (USE 0 o ISPECL); ASM_MESON_TAC[]; TYPEL_THEN[`y`;`x`;`n`] (USE 0 o ISPECL); ASM_MESON_TAC[]; ]);; (* }}} *) let infinite_interval = prove_by_refinement( `!a b. a < b ==> (INFINITE {x | a < x /\ x < b})`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC infinite_subset; TYPE_THEN `f = (\ n. a + (b-a)/((&2) pow (SUC n)))` ABBREV_TAC ; TYPE_THEN `IMAGE f UNIV` EXISTS_TAC ; CONJ_TAC; TYPE_THEN `(! x y. (f x = f y) ==> (x = y))` SUBGOAL_TAC; EXPAND_TAC "f"; REP_BASIC_TAC; USE 2 (REWRITE_RULE[REAL_ARITH `(a + d = a + d') <=> (d = d')`;real_div;REAL_PROP_EQ_RMUL_';]); TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC; UND 0; REAL_ARITH_TAC; DISCH_TAC; REWR 2; USE 2 (REWRITE_RULE[GSYM REAL_EQ_INV]); UND 2; REDUCE_TAC; DISCH_TAC; ONCE_REWRITE_TAC[GSYM SUC_INJ]; IMATCH_MP_TAC EXPinj; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; DISCH_TAC; TYPE_THEN `INFINITE (UNIV:num->bool) ==> INFINITE (IMAGE f UNIV)` SUBGOAL_TAC; ASM_MESON_TAC[INFINITE_IMAGE_INJ]; REWRITE_TAC[num_INFINITE]; (* -- *) REWRITE_TAC[IMAGE;SUBSET]; GEN_TAC; REP_BASIC_TAC; UND 2; DISCH_THEN_REWRITE; EXPAND_TAC "f"; CONJ_TAC; ONCE_REWRITE_TAC[REAL_ARITH `a < a + x <=> &0 < x`]; REWRITE_TAC[real_div]; IMATCH_MP_TAC REAL_PROP_POS_MUL2; CONJ_TAC; UND 0; REAL_ARITH_TAC; IMATCH_MP_TAC REAL_PROP_POS_INV; REDUCE_TAC; ARITH_TAC; ONCE_REWRITE_TAC [REAL_ARITH `a + x < b <=> x < (b - a)*(&1)`]; REWRITE_TAC[real_div]; IMATCH_MP_TAC REAL_PROP_LT_LMUL; CONJ_TAC; UND 0; REAL_ARITH_TAC; ONCE_REWRITE_TAC[GSYM REAL_INV_1]; IMATCH_MP_TAC REAL_LT_INV2; REDUCE_TAC; IMATCH_MP_TAC exp_gt1; ARITH_TAC; (* Thu Aug 19 14:59:58 EDT 2004 *) ]);; (* }}} *) let finite_augment1 = prove_by_refinement( `!n (X:A->bool) . (INFINITE X) ==> (?Z. Z SUBSET X /\ Z HAS_SIZE n)`, (* {{{ proof *) [ INDUCT_TAC; REP_BASIC_TAC; TYPE_THEN `EMPTY:A->bool` EXISTS_TAC ; REWRITE_TAC[HAS_SIZE_0]; REP_BASIC_TAC; TSPEC `X` 0; REWR 0; REP_BASIC_TAC; TYPE_THEN `INFINITE (X DIFF Z)` SUBGOAL_TAC; IMATCH_MP_TAC INFINITE_DIFF_FINITE; ASM_REWRITE_TAC[]; ASM_MESON_TAC[HAS_SIZE]; DISCH_TAC; USE 3 (MATCH_MP INFINITE_NONEMPTY); USE 3 (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; TYPE_THEN `u INSERT Z` EXISTS_TAC; CONJ_TAC; UND 2; UND 3; REWRITE_TAC[DIFF;SUBSET;INSERT]; ASM_MESON_TAC[]; (* -- *) USE 0 (REWRITE_RULE[HAS_SIZE]); ASM_SIMP_TAC [HAS_SIZE;FINITE_INSERT;CARD_CLAUSES;]; UND 3; REWRITE_TAC[DIFF]; DISCH_THEN_REWRITE; ]);; (* }}} *) let finite_augment = prove_by_refinement( `!(X:A->bool) Y n m . (n <= m) /\ (X HAS_SIZE n) /\ (INFINITE Y) /\ (X SUBSET Y) ==> (?Z. (X SUBSET Z /\ Z SUBSET Y /\ Z HAS_SIZE m))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `INFINITE (Y DIFF X)` SUBGOAL_TAC; IMATCH_MP_TAC INFINITE_DIFF_FINITE; ASM_MESON_TAC[HAS_SIZE]; DISCH_TAC; USE 4(MATCH_MP finite_augment1); USE 3(REWRITE_RULE[LE_EXISTS]); REP_BASIC_TAC; TSPEC `d` 4; REP_BASIC_TAC; TYPE_THEN `X UNION Z` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; REWRITE_TAC[union_subset]; ASM_REWRITE_TAC[]; CONJ_TAC; UND 5; SET_TAC[SUBSET;DIFF]; REWRITE_TAC[HAS_SIZE]; CONJ_TAC; ASM_REWRITE_TAC[FINITE_UNION]; ASM_MESON_TAC[HAS_SIZE]; RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); REP_BASIC_TAC; EXPAND_TAC "d"; EXPAND_TAC "n"; IMATCH_MP_TAC CARD_UNION; ASM_REWRITE_TAC[]; UND 5; REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY ]; MESON_TAC[]; (* Thu Aug 19 15:29:05 EDT 2004 *) ]);; (* }}} *) let euclid_add_cancel = prove_by_refinement( `!p q q'. (euclid_plus p q = euclid_plus p q') <=> (q = q')`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC [euclid_plus;]; REWRITE_TAC[REAL_ARITH `(x + a = x + b) <=> (a = b)`]; ]);; (* }}} *) let degree_vertex_disk_ver2 = prove_by_refinement( `!r p X. (&0 < r) /\ (euclid 2 p) /\ (FINITE X) /\ (CARD X <= 4) /\ (X SUBSET {x | (euclid 2 x) /\ (d_euclid p x = r)}) ==> (?C. (!i. (X i) ==> (?C' C'' v. simple_arc_end C' p v /\ simple_arc_end C'' v i /\ C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\ (C' INTER C'' = {v}) /\ (C' UNION C'' = C i )) /\ simple_arc_end (C i ) p i /\ C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\ C i INTER (closed_ball(euclid 2,d_euclid) p (r / &2)) SUBSET (hyperplane 2 e2 (p 1) UNION hyperplane 2 e1 (p 0))) /\ (!i j. (X i ) /\ (X j) /\ (~(i=j)) ==> (C i INTER C j = {p} )))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!x. (X x) ==> (?r t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[euclid_cancel1]; IMATCH_MP_TAC polar_exist; USE 0(REWRITE_RULE[SUBSET]); ASM_MESON_TAC[euclid_sub_closure]; DISCH_TAC; (* -- *) TYPE_THEN `!x. (X x) ==> (?t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC; REP_BASIC_TAC; TSPEC `x` 5; REWR 5; REP_BASIC_TAC; UND 5; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); TYPE_THEN `t` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; UND 4; REAL_ARITH_TAC; USE 0 (REWRITE_RULE[SUBSET]); TSPEC `euclid_plus p (r' *# cis t)` 0; REWR 0; REP_BASIC_TAC; UND 0; TYPEL_THEN[`2`;`p`;`r' *# cis t`] (fun t-> ANT_TAC (ISPECL t d_euclidpq)); ASM_REWRITE_TAC[polar_euclid]; DISCH_THEN_REWRITE; REWRITE_TAC[GSYM norm2;norm2_scale_cis]; DISCH_TAC; TYPE_THEN `abs r' = r'` SUBGOAL_TAC; UND 7; REAL_ARITH_TAC; DISCH_TAC; REWR 0; ASM_REWRITE_TAC[]; DISCH_TAC; KILL 5; (* -- *) TYPE_THEN `TX = {t | (&0 <= t /\ t < &2 *pi /\ (X( p + (r *# (cis t))))) }` ABBREV_TAC ; TYPE_THEN `BIJ ( \ t. p + r *# cis t) TX X` SUBGOAL_TAC; REWRITE_TAC[BIJ;INJ;SURJ]; SUBCONJ_TAC; CONJ_TAC; EXPAND_TAC "TX"; REWRITE_TAC[]; MESON_TAC[]; EXPAND_TAC "TX"; REWRITE_TAC[]; REP_BASIC_TAC; USE 7 (REWRITE_RULE[euclid_add_cancel]); PROOF_BY_CONTR_TAC; TYPEL_THEN[`x`;`y`;`r`;`r`] (fun t-> ANT_TAC(ISPECL t polar_inj)); ASM_REWRITE_TAC[]; UND 4; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; UND 4; REAL_ARITH_TAC; DISCH_THEN_REWRITE; REP_BASIC_TAC; EXPAND_TAC "TX"; REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `INFINITE {x | &0 <= x /\ x < &2* pi}` SUBGOAL_TAC; IMATCH_MP_TAC infinite_subset; TYPE_THEN `{x | &0 < x /\ x < &2 * pi}` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC infinite_interval; IMATCH_MP_TAC REAL_PROP_POS_MUL2; REWRITE_TAC[PI_POS]; REAL_ARITH_TAC; REWRITE_TAC[SUBSET]; MESON_TAC[REAL_ARITH `&0 < x ==> &0 <= x`]; DISCH_TAC; (* A -- *) TYPE_THEN `TX HAS_SIZE CARD X` SUBGOAL_TAC; REWRITE_TAC[HAS_SIZE]; SUBCONJ_TAC; COPY 7; JOIN 2 7; USE 2 (MATCH_MP FINITE_BIJ2); ASM_REWRITE_TAC[]; DISCH_TAC; IMATCH_MP_TAC BIJ_CARD; ASM_REWRITE_TAC []; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `(?Z. (TX SUBSET Z /\ Z SUBSET {x | &0 <= x /\ x < &2 *pi} /\ Z HAS_SIZE 4))` SUBGOAL_TAC; IMATCH_MP_TAC finite_augment; TYPE_THEN `CARD X` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC"TX"; REWRITE_TAC[SUBSET]; REAL_ARITH_TAC; REP_BASIC_TAC; (* B -- order points *) TYPE_THEN `FINITE Z` SUBGOAL_TAC; ASM_MESON_TAC[HAS_SIZE]; DISCH_TAC; USE 13 (MATCH_MP real_finite_increase); REP_BASIC_TAC; USE 10(REWRITE_RULE[HAS_SIZE]); REP_BASIC_TAC; REWR 13; REWR 14; (* -- *) TYPEL_THEN [`r`;`p`;`u`] (fun t-> ANT_TAC (ISPECL t degree_vertex_disk)); ASM_REWRITE_TAC[]; CONJ_TAC; UND 14; REWRITE_TAC[BIJ;SURJ]; REP_BASIC_TAC; USE 11(REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 16; UND 17; ARITH_TAC; REP_BASIC_TAC; (* [C] -- create C *) TYPE_THEN `f = (\t. euclid_plus p (r *# cis t))` ABBREV_TAC ; TYPE_THEN `g = INV f TX X` ABBREV_TAC ; TYPE_THEN `u' = INV u {x | x <| 4} Z` ABBREV_TAC ; TYPE_THEN `BIJ g X TX` SUBGOAL_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `BIJ u' Z {x | x <| 4}` SUBGOAL_TAC; EXPAND_TAC "u'"; IMATCH_MP_TAC INVERSE_BIJ; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `INJ (compose u' g) X { x | x <| 4}` SUBGOAL_TAC; IMATCH_MP_TAC COMP_INJ; TYPE_THEN `TX` EXISTS_TAC; CONJ_TAC; UND 21; REWRITE_TAC[BIJ]; MESON_TAC[]; IMATCH_MP_TAC inj_subset_domain; TYPE_THEN `Z` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 22; REWRITE_TAC [BIJ]; DISCH_THEN_REWRITE; DISCH_TAC; TYPE_THEN `(\ j. C ((compose u' g) j))` EXISTS_TAC; REWRITE_TAC[]; (* D -- check properties *) CONJ_TAC; REP_BASIC_TAC; TYPE_THEN `j = compose u' g i` ABBREV_TAC ; TSPEC `j` 17; TYPE_THEN `j <| 4` SUBGOAL_TAC; USE 23 (REWRITE_RULE[INJ]); REP_BASIC_TAC; EXPAND_TAC "j"; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; REWR 17; ASM_REWRITE_TAC[]; (* --2-- *) TYPE_THEN `i = f (u j)` SUBGOAL_TAC; EXPAND_TAC "j"; EXPAND_TAC "f"; EXPAND_TAC "u'"; REWRITE_TAC[compose]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; TYPE_THEN `u (INV u {x | x <| 4} Z (g i)) = (g i)` SUBGOAL_TAC; IMATCH_MP_TAC inv_comp_right; ASM_REWRITE_TAC[]; UND 21; UND 12; REWRITE_TAC[SUBSET;BIJ;SURJ;]; UND 24; MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `f (g i) = i` SUBGOAL_TAC; EXPAND_TAC "g"; IMATCH_MP_TAC inv_comp_right; ASM_REWRITE_TAC[]; EXPAND_TAC "f"; DISCH_THEN_REWRITE; EXPAND_TAC "f"; DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[GSYM t])); ASM_REWRITE_TAC[]; (* E *) REP_BASIC_TAC; TYPE_THEN `i' = compose u' g i` ABBREV_TAC ; TYPE_THEN `j' = compose u' g j` ABBREV_TAC ; KILL 17; TYPE_THEN `~(i' = j')` SUBGOAL_TAC; DISCH_TAC; UND 24; REWRITE_TAC[]; USE 23 (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; DISCH_TAC; TYPE_THEN `(i' <| 4) /\ (j' <| 4) ` SUBGOAL_TAC; EXPAND_TAC "i'"; EXPAND_TAC "j'"; USE 23 (REWRITE_RULE[INJ]); REP_BASIC_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPEL_THEN [`i'`;`j'`] (USE 16 o ISPECL); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Thu Aug 19 18:06:33 EDT 2004 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION O *) (* ------------------------------------------------------------------ *) let simple_arc_connected = prove_by_refinement( `!C. simple_arc top2 C ==> connected top2 C`, (* {{{ proof *) [ REWRITE_TAC[simple_arc;]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC connect_image; TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; ASM_REWRITE_TAC[connect_real]; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REWRITE_TAC[IMAGE;SUBSET]; REP_BASIC_TAC; ASM_SIMP_TAC[]; (* Fri Aug 20 08:32:31 EDT 2004 *) ]);; (* }}} *) let disk_endpoint = prove_by_refinement( `!C r p v v'. simple_arc_end C v v' /\ (&0 < r) /\ (euclid 2 p) /\ (C INTER (closed_ball(euclid 2,d_euclid) p r) = {v}) ==> (d_euclid p v = r)`, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `connected top2 C` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_connected; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `A = euclid 2 DIFF (closed_ball (euclid 2, d_euclid) p r)` ABBREV_TAC ; TYPE_THEN `B = closed_ball(euclid 2, d_euclid) p r` ABBREV_TAC ; TYPE_THEN `closed_ top2 B` SUBGOAL_TAC; EXPAND_TAC "B"; REWRITE_TAC[top2]; IMATCH_MP_TAC closed_ball_closed; REWRITE_TAC[metric_euclid]; DISCH_TAC; (* - *) TYPE_THEN `top2 A` SUBGOAL_TAC; UND 8; EXPAND_TAC "A"; EXPAND_TAC "B"; REWRITE_TAC[closed;top2_unions;open_DEF ;]; DISCH_THEN_REWRITE; DISCH_TAC; (* - *) TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `B' = open_ball(euclid 2,d_euclid) p r` ABBREV_TAC ; TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC; EXPAND_TAC "A"; EXPAND_TAC "B'"; EXPAND_TAC "B"; REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION]; USE 10 (REWRITE_RULE[SUBSET]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; TSPEC `x` 10; REWR 10; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USE 13 (REWRITE_RULE[DE_MORGAN_THM]); REP_BASIC_TAC; TYPE_THEN `B x` SUBGOAL_TAC; EXPAND_TAC "B"; REWRITE_TAC[closed_ball]; ASM_REWRITE_TAC[]; USE 0 (REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INTER;INR IN_SING]); ASM_MESON_TAC[REAL_ARITH `u <= v /\ ~(u = v) ==> (u < v)`]; (* - *) USE 5 (REWRITE_RULE[connected;top2_unions]); REP_BASIC_TAC; TYPEL_THEN[`B'`;`A`] (USE 12 o ISPECL); REWR 12; TYPE_THEN `top2 B'` SUBGOAL_TAC; EXPAND_TAC "B'"; REWRITE_TAC[top2]; IMATCH_MP_TAC open_ball_open; REWRITE_TAC[metric_euclid]; DISCH_THEN_FULL_REWRITE; (* - *) TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC; EXPAND_TAC "A"; EXPAND_TAC "B'"; EXPAND_TAC "B"; REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;]; REP_BASIC_TAC; UND 14; ASM_REWRITE_TAC[]; UND 16; REAL_ARITH_TAC; DISCH_THEN_FULL_REWRITE; (* - *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `C SUBSET B` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `B'` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "B"; EXPAND_TAC "B'"; REWRITE_TAC[SUBSET;open_ball;closed_ball]; MESON_TAC[REAL_ARITH `x < y ==> x <= y`]; DISCH_TAC; (* -- *) TYPE_THEN `~(v = v')` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_distinct; ASM_MESON_TAC[]; REWRITE_TAC[]; TYPE_THEN `C v'` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end2]; DISCH_TAC; TYPE_THEN `B v'` SUBGOAL_TAC; UND 15; UND 16; MESON_TAC[ISUBSET]; UND 16; UND 0; REWRITE_TAC[INTER;eq_sing]; MESON_TAC[]; (* - *) TYPE_THEN `C v` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; DISCH_TAC; TYPE_THEN `A v` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; TYPE_THEN `B v` SUBGOAL_TAC; UND 0; REWRITE_TAC[INTER;eq_sing]; DISCH_THEN_REWRITE; EXPAND_TAC "A"; REWRITE_TAC[DIFF]; DISCH_THEN_REWRITE; (* Fri Aug 20 09:12:44 EDT 2004 *) ]);; (* }}} *) let disk_endpoint_gen = prove_by_refinement( `!C B' B v v'. simple_arc_end C v v' /\ (top2 B') /\ (closed_ top2 B) /\ (B' SUBSET B) /\ (C INTER B = {v}) ==> (~(B' v))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `connected top2 C` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_connected; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `A = euclid 2 DIFF B` ABBREV_TAC ; (* - *) TYPE_THEN `top2 A` SUBGOAL_TAC; EXPAND_TAC "A"; UND 3; REWRITE_TAC[closed;top2_unions;open_DEF ;]; DISCH_THEN_REWRITE; DISCH_TAC; (* - *) TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC; EXPAND_TAC "A"; REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION]; USE 9 (REWRITE_RULE[SUBSET]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `B x` ASM_CASES_TAC; ASM_REWRITE_TAC[]; USE 1(REWRITE_RULE[INTER;eq_sing]); REP_BASIC_TAC; TYPE_THEN `(x = v)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; DISJ2_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) DISCH_TAC; USE 6 (REWRITE_RULE[connected;top2_unions]); REP_BASIC_TAC; TYPEL_THEN[`B'`;`A`] (USE 6 o ISPECL); REWR 6; (* - *) TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC; EXPAND_TAC "A"; REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; DISCH_THEN_FULL_REWRITE; (* - *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `C SUBSET B` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `B'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `~(v = v')` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_distinct; ASM_MESON_TAC[]; REWRITE_TAC[]; TYPE_THEN `C v'` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end2]; DISCH_TAC; TYPE_THEN `B v'` SUBGOAL_TAC; UND 13; UND 14; MESON_TAC[ISUBSET]; UND 14; UND 1; REWRITE_TAC[INTER;eq_sing]; MESON_TAC[]; (* - *) TYPE_THEN `C v` SUBGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; DISCH_TAC; TYPE_THEN `A v` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; TYPE_THEN `B v` SUBGOAL_TAC; UND 1; REWRITE_TAC[INTER;eq_sing]; DISCH_THEN_REWRITE; EXPAND_TAC "A"; REWRITE_TAC[DIFF]; DISCH_THEN_REWRITE; ]);; (* }}} *) let disk_endpoint_outer = prove_by_refinement( `!C r p v v'. simple_arc_end C v v' /\ (&0 < r) /\ (euclid 2 p) /\ (C INTER (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r)) = {v}) ==> (d_euclid p v = r)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `B = (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ; TYPE_THEN `B' = (euclid 2 DIFF (closed_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ; (* - *) TYPE_THEN `B' SUBSET B` SUBGOAL_TAC; EXPAND_TAC "B'"; EXPAND_TAC "B"; REWRITE_TAC[closed_ball;open_ball;SUBSET;DIFF]; MESON_TAC[REAL_ARITH `x < u ==> x <= u`]; DISCH_TAC; (* - *) TYPE_THEN `closed_ top2 B` SUBGOAL_TAC; EXPAND_TAC "B"; REWRITE_TAC[closed;top2_unions;open_DEF ;SUBSET_DIFF]; TYPE_THEN `open_ball (euclid 2,d_euclid) p r SUBSET (euclid 2)` SUBGOAL_TAC; REWRITE_TAC[open_ball;SUBSET]; MESON_TAC[]; ASM_SIMP_TAC[DIFF_DIFF2]; ASM_SIMP_TAC [open_ball_open;top2;metric_euclid]; DISCH_TAC; (* - *) TYPE_THEN `top2 B'` SUBGOAL_TAC; EXPAND_TAC "B'"; TH_INTRO_TAC [`top2`;`closed_ball (euclid 2,d_euclid) p r`] closed_open; REWRITE_TAC[metric_euclid;top2]; IMATCH_MP_TAC closed_ball_closed; REWRITE_TAC[metric_euclid]; REWRITE_TAC[open_DEF;top2_unions;]; DISCH_TAC; (* - *) TH_INTRO_TAC [`C`;`B'`;`B`;`v`;`v'`] disk_endpoint_gen; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `B v` SUBGOAL_TAC; UND 0; REWRITE_TAC[INTER;eq_sing]; DISCH_THEN_REWRITE; DISCH_TAC; (* - *) TYPE_THEN `B v /\ ~B' v ==> (d_euclid p v = r)` SUBGOAL_TAC; EXPAND_TAC "B"; EXPAND_TAC "B'"; REWRITE_TAC[DIFF;open_ball;closed_ball;]; MESON_TAC[REAL_ARITH `x <= y /\ ~(x < y) ==> (x = y)`]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let graph_edge_around = jordan_def `graph_edge_around (G:(A,B)graph_t) v = { e | graph_edge G e /\ graph_inc G e v}`;; let graph_edge_around_empty = prove_by_refinement( `!(G:(A,B)graph_t) v. (graph G) /\ ~(graph_vertex G v) ==> (graph_edge_around G v = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[graph_edge_around;EQ_EMPTY;]; REP_BASIC_TAC; TH_INTRO_TAC [`G`;`x`] graph_inc_subset; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* Fri Aug 20 09:25:57 EDT 2004 *) ]);; (* }}} *) let graph_disk_hv_preliminaries = prove_by_refinement( `!G. plane_graph G /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = EMPTY) /\ (!v. (CARD (graph_edge_around G v) <=| 4)) ==> (?NC D short_end hyper r d f. ((!e p. graph_edge G e /\ (!v. ~D v p) ==> (f e p = d e p)) /\ (!e v p. graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v /\ D v p ==> ~f e p) /\ (!e v p. (graph_edge G e /\ graph_inc G e v) /\ D v p ==> (f e p = NC e v p)) /\ (!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}) /\ (!v e e'. graph_edge G e /\ graph_edge G e' /\ graph_inc G e v /\ graph_inc G e' v /\ ~(e = e') ==> (NC e v INTER NC e' v = {v})) /\ (!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)) /\ (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (d e INTER d e' = {})) /\ (!e v. graph_edge G e /\ graph_inc G e v ==> ~graph_vertex G (short_end e v)) /\ (!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (D v INTER D v' = {})) /\ (!e v. graph_edge G e /\ graph_inc G e v ==> simple_arc_end (NC e v) v (short_end e v) /\ NC e v SUBSET D v /\ hyper (NC e v) v) /\ ((\ B v. B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) = hyper) /\ (!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v) /\ (!e v. graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v ==> (d e INTER D v = {})) /\ (!e. graph_edge G e ==> d e SUBSET e) /\ (!e v. graph_edge G e /\ graph_inc G e v ==> (d e INTER D v = {(short_end e v)}) /\ (d_euclid v (short_end e v) = r) /\ (!v'. graph_inc G e v' /\ ~(v = v') ==> simple_arc_end (d e) (short_end e v) (short_end e v'))) /\ (!v. euclid 2 v ==> D v v) /\ (!u. closed_ top2 (D u)) /\ (( \ u. closed_ball (euclid 2,d_euclid) u r) = D) /\ (&0 < r) /\ (plane_graph G))) `, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC [`G`] graph_disk; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* TYPE_THEN `r /(&2)` EXISTS_TAC; *) (* - *) TYPE_THEN `D = (\u. (closed_ball (euclid 2,d_euclid ) u r))` ABBREV_TAC ; TYPE_THEN `!u. closed_ top2 (D u)` SUBGOAL_TAC; EXPAND_TAC "D"; GEN_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC closed_ball_closed; REWRITE_TAC[metric_euclid]; DISCH_TAC; (* - *) TYPE_THEN `!v. (euclid 2 v) ==> D v v` SUBGOAL_TAC; EXPAND_TAC "D"; REWRITE_TAC[closed_ball2_center]; GEN_TAC; DISCH_THEN_REWRITE; UND 7; REAL_ARITH_TAC; DISCH_TAC; (* - *) (* [A]- Pick middle arcs *) (* {{{ *) TYPE_THEN `!e. ?d. (graph_edge G e) ==> (?u u' v v'. simple_arc_end d u u' /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') /\ (d INTER (D v) = {u}) /\ (d INTER (D v') = {u'}) /\ (d SUBSET e) /\ (d_euclid v u = r) /\ (d_euclid v' u' = r))` SUBGOAL_TAC ; GEN_TAC; RIGHT_TAC "d"; DISCH_TAC; TH_INTRO_TAC [`G`;`e`] graph_edge_end_select; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); (* -xx- *) ASM_REWRITE_TAC[]; REP_BASIC_TAC; TH_INTRO_TAC [`e`;`D v`;`D v'`] simple_arc_end_restriction; ASM_REWRITE_TAC[GSYM top2]; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; USE 16 (REWRITE_RULE[SUBSET ]); ASM_MESON_TAC[]; UND 6; DISCH_THEN (TH_INTRO_TAC [`v`;`v'`] ); ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE [plane_graph;]); ASM_MESON_TAC[REWRITE_RULE[SUBSET] graph_inc_subset]; DISCH_TAC; CONJ_TAC; EXPAND_TAC "D"; UND 6; REWRITE_TAC[INTER;EQ_EMPTY]; MESON_TAC[]; REWRITE_TAC[EMPTY_EXISTS ]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TSPEC `e` 15; REWR 15; REWR 13; REWR 14; UND 18; REWRITE_TAC[SUBSET]; UND 13; UND 14; REWRITE_TAC[INTER]; UND 10; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `v''` EXISTS_TAC; TYPE_THEN `v'''` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `v'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) CONJ_TAC; IMATCH_MP_TAC disk_endpoint; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `v'''` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 16; EXPAND_TAC "D"; DISCH_THEN_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; USE 21 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset]; (* -- *) IMATCH_MP_TAC disk_endpoint; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `v''` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 15; EXPAND_TAC "D"; DISCH_THEN_REWRITE; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; USE 21 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset]; DISCH_TAC; RIGHT 11 "e"; REP_BASIC_TAC; (* B- short_end *) TYPE_THEN `short_end = ( \ e v. @s. (d e INTER (D v)) s)` ABBREV_TAC ; TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v) ==> (d e INTER (D v) = {(short_end e v)}) /\ (d_euclid v (short_end e v) = r) /\ (!v'. (graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (d e) (short_end e v) (short_end e v'))))` SUBGOAL_TAC; REP_BASIC_TAC; TSPEC `e` 11; REWR 11; REP_BASIC_TAC; TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; IMATCH_MP_TAC graph_edge2; UND 4; REWRITE_TAC[plane_graph]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `!u. graph_inc G e u ==> (u = v') \/ (u = v'')` SUBGOAL_TAC; ASM_MESON_TAC[two_exclusion]; DISCH_TAC; TYPE_THEN `?s. (d e INTER D v) s` SUBGOAL_TAC; TSPEC `v` 24; REWR 24; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[INR IN_SING ]; MESON_TAC[]; ASM_REWRITE_TAC[INR IN_SING ]; MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `(d e INTER D v) (short_end e v)` SUBGOAL_TAC; EXPAND_TAC "short_end"; SELECT_TAC; DISCH_THEN_REWRITE ; ASM_MESON_TAC[]; DISCH_TAC; LEFT_TAC "v'"; LEFT_TAC "v'"; GEN_TAC; TYPE_THEN `(v = v') \/ (v = v'')` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `(graph_inc G e v''') ==> (v''' = v') \/ (v''' = v'')` SUBGOAL_TAC; DISCH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* --- *) DISCH_THEN DISJ_CASES_TAC; FIRST_ASSUM MP_TAC; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; TYPE_THEN `short_end e v' = u` SUBGOAL_TAC; REWR 26; USE 26 (REWRITE_RULE[INR IN_SING]); ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; REP_BASIC_TAC; KILL 24; REWR 27; UND 24; DISCH_THEN_FULL_REWRITE; TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC; TYPE_THEN `?s. (d e INTER D v'') s` SUBGOAL_TAC; ASM_REWRITE_TAC[INR IN_SING ]; MESON_TAC[]; EXPAND_TAC "short_end"; SELECT_TAC; ASM_REWRITE_TAC[INR IN_SING ]; DISCH_THEN_REWRITE; UND 24; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; (* -- *) FIRST_ASSUM MP_TAC; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC; REWR 26; USE 26 (REWRITE_RULE[INR IN_SING]); ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; REP_BASIC_TAC; KILL 24; REWR 27; UND 24; DISCH_THEN_FULL_REWRITE; TYPE_THEN `short_end e v' = u` SUBGOAL_TAC; TYPE_THEN `?s. (d e INTER D v') s` SUBGOAL_TAC; ASM_REWRITE_TAC[INR IN_SING ]; MESON_TAC[]; EXPAND_TAC "short_end"; SELECT_TAC; ASM_REWRITE_TAC[INR IN_SING ]; DISCH_THEN_REWRITE; UND 24; MESON_TAC[]; DISCH_THEN_REWRITE; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; DISCH_TAC; (* }}} *) (* [C]- *) TYPE_THEN `X = (\ v. (IMAGE (\ e. short_end e v) (graph_edge_around G v)))` ABBREV_TAC ; TYPE_THEN `!v. FINITE (graph_edge_around G v)` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[graph_edge_around]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `graph_edge G ` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `!v. graph_vertex G v ==> (FINITE (X v) /\ (CARD (X v) <=| 4) /\ ((X v) SUBSET {x | euclid 2 x /\ (d_euclid v x = r)}))` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC "X"; SUBCONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; CONJ_TAC; IMATCH_MP_TAC LE_TRANS; TYPE_THEN `CARD (graph_edge_around G v)` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC CARD_IMAGE_LE; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IMAGE]; REP_BASIC_TAC; UND 18; DISCH_THEN_FULL_REWRITE; USE 19 (REWRITE_RULE[graph_edge_around]); TSPEC `x'` 13; TSPEC `v` 13; REWR 13; REP_BASIC_TAC; ASM_REWRITE_TAC[]; UND 19; EXPAND_TAC "D"; REWRITE_TAC[INTER;eq_sing;closed_ball]; DISCH_THEN_REWRITE; DISCH_TAC; (* -D now generate curves C in disk. *) TYPE_THEN `!v. (graph_vertex G v) ==> (?C. (!i. X v i ==> (?C' C'' v'. simple_arc_end C' v v' /\ simple_arc_end C'' v' i /\ C' SUBSET closed_ball (euclid 2,d_euclid) v (r / &2) /\ (C' INTER C'' = {v'}) /\ (C' UNION C'' = C i)) /\ simple_arc_end (C i) v i /\ C i SUBSET closed_ball (euclid 2,d_euclid) v r /\ C i INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) /\ (!i j. X v i /\ X v j /\ ~(i = j) ==> (C i INTER C j = {v})))` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC degree_vertex_disk_ver2; ASM_REWRITE_TAC[]; TYPE_THEN `(\j. X v j) = X v` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; BETA_TAC; MESON_TAC[]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; TSPEC `v` 16; REWR 16; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; LEFT 17 "C"; LEFT 17 "C"; REP_BASIC_TAC; TYPE_THEN `f = (\ e. { x | d e x \/ (?v. graph_inc G e v /\ C v (short_end e v) x)})` ABBREV_TAC ; (* -[E] lets try to flatten some hypotheses *) TYPE_THEN `NC = (\ e v. (C v (short_end e v)))` ABBREV_TAC ; KILL 1; KILL 2; KILL 3; KILL 0; (* rework 5 *) TYPE_THEN `!e . graph_edge G e ==> (d e SUBSET e)` SUBGOAL_TAC; UND 11; MESON_TAC[]; DISCH_TAC; TYPE_THEN `!e v. graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v ==> (d e INTER (D v) = EMPTY)` SUBGOAL_TAC; REP_BASIC_TAC; TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL); REWR 5; UND 5; UND 0; REWRITE_TAC[SUBSET;EQ_EMPTY]; UND 3; EXPAND_TAC "D"; REWRITE_TAC[INTER]; MESON_TAC[]; DISCH_TAC; KILL 5; KILL 11; KILL 12; (* rework 16 *) TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TH_INTRO_TAC [`G`;`e`] graph_inc_subset; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> X v (short_end e v))` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC "X"; REWRITE_TAC[IMAGE]; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[graph_edge_around]; DISCH_TAC; KILL 16; KILL 14; (* rework 17 *) TYPE_THEN `hyper = (\ B v. (B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)))` ABBREV_TAC ; TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> (simple_arc_end (NC e v) v (short_end e v)) /\ (NC e v SUBSET D v) /\ (hyper (NC e v) v)` SUBGOAL_TAC; EXPAND_TAC "hyper"; EXPAND_TAC "NC"; REP_BASIC_TAC; TSPEC `v` 17; TYPE_THEN `graph_vertex G v` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; REP_BASIC_TAC; TSPEC `short_end e v` 16; TYPE_THEN `X v (short_end e v)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; EXPAND_TAC "D"; ASM_REWRITE_TAC[]; DISCH_TAC; (* F- continue simplification *) TYPE_THEN `!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (D v INTER D v' = EMPTY)` SUBGOAL_TAC; EXPAND_TAC "D"; ASM_REWRITE_TAC[]; DISCH_TAC; KILL 6; (* - *) TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> ~(graph_vertex G (short_end e v)))` SUBGOAL_TAC; REP_BASIC_TAC; TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL); REWR 13; REP_BASIC_TAC; USE 21 (REWRITE_RULE[eq_sing;INTER]); REP_BASIC_TAC; TYPE_THEN `D (short_end e v) (short_end e v)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]); REP_BASIC_TAC; USE 27 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `~(D (short_end e v) INTER D v = EMPTY)` SUBGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `short_end e v` EXISTS_TAC; ASM_REWRITE_TAC[INTER]; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USE 25 (REWRITE_RULE[]); UND 25; DISCH_THEN_FULL_REWRITE; TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_zero; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[metric_euclid]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; USE 28 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; UND 20; UND 7; REAL_ARITH_TAC; DISCH_TAC; (* - *) TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (d e INTER d e' = EMPTY)` SUBGOAL_TAC; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; USE 21 (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TYPEL_THEN [`e`;`e'`] (USE 4 o ISPECL); REWR 4; TYPE_THEN `d e INTER d e' SUBSET graph_vertex G` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `e INTER e'` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_inter_pair; UND 0; UND 20; UND 16; MESON_TAC[]; DISCH_TAC; TYPE_THEN `graph_vertex G u` SUBGOAL_TAC; USE 26 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; USE 21(REWRITE_RULE[INTER]); TYPE_THEN `graph_inc G e u` ASM_CASES_TAC; TYPEL_THEN [`e`;`u`] (USE 13 o ISPECL); REWR 13; TYPE_THEN `(d e INTER D u) u` SUBGOAL_TAC; REP_BASIC_TAC; USE 28 GSYM; ASM_REWRITE_TAC[INTER]; FIRST_ASSUM IMATCH_MP_TAC ; USE 25 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; USE 28 GSYM; REWR 28; USE 28 (REWRITE_RULE[INR IN_SING]); UND 28; DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `d e INTER D u = EMPTY ` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC []; USE 26 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[INTER]; DISCH_TAC; USE 28(REWRITE_RULE[EQ_EMPTY]); TSPEC `u` 28; DISCH_TAC; USE 28(REWRITE_RULE[INTER]); UND 28; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; USE 25 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* -G continue to simplify *) TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)` SUBGOAL_TAC; REP_BASIC_TAC; TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL); REWR 13; REP_BASIC_TAC; USE 22(REWRITE_RULE[eq_sing;INTER]); ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `! v e e'. graph_edge G e /\ graph_edge G e' /\ graph_inc G e v /\ graph_inc G e' v /\ ~(e = e') ==> (NC e v INTER NC e' v = {v})` SUBGOAL_TAC; EXPAND_TAC "NC"; REP_BASIC_TAC; TSPEC `v` 17; TYPE_THEN `graph_vertex G v` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; REP_BASIC_TAC; TYPEL_THEN [`short_end e v`;`short_end e' v`](USE 17 o ISPECL); KILL 25; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; KILL 17; DISCH_TAC; TYPE_THEN `d e (short_end e v)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `d e' (short_end e' v)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `d e INTER d e' = EMPTY ` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[EQ_EMPTY;INTER]; UND 17; MESON_TAC[]; DISCH_TAC; KILL 17; KILL 3; KILL 15; (* H- *) TYPE_THEN `!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC "f"; EXPAND_TAC "NC"; REWRITE_TAC[]; DISCH_TAC; KILL 18; KILL 19; TYPE_THEN `!e v p. (graph_edge G e /\ graph_inc G e v) /\ (D v p) ==> (f e p = NC e v p)` SUBGOAL_TAC ; REP_BASIC_TAC; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; EQ_TAC; UND 17; MESON_TAC[]; DISCH_THEN DISJ_CASES_TAC; TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL); REWR 13; REP_BASIC_TAC; USE 22 (REWRITE_RULE[eq_sing;INTER ]); REP_BASIC_TAC; TSPEC `p` 22; REWR 22; UND 22; DISCH_THEN_FULL_REWRITE; TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL); REWR 11; REP_BASIC_TAC; UND 25; MESON_TAC[simple_arc_end_end2]; REP_BASIC_TAC; TYPE_THEN `v' = v` ASM_CASES_TAC; UND 19; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `p` EXISTS_TAC; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; TYPEL_THEN[`e`;`v'`] (USE 11 o ISPECL); REWR 11; REP_BASIC_TAC; USE 24 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `!e v p. (graph_edge G e /\ (graph_vertex G v) /\ ~(graph_inc G e v) /\ (D v p) ==> ~(f e p))` SUBGOAL_TAC; ASM_REWRITE_TAC[DE_MORGAN_THM ]; REP_BASIC_TAC; CONJ_TAC; DISCH_TAC; TYPE_THEN `d e INTER D v = EMPTY` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS;INTER ]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; LEFT_TAC "v"; GEN_TAC; DISCH_TAC; REP_BASIC_TAC; TYPE_THEN `~(v = v')` SUBGOAL_TAC; DISCH_TAC; UND 23; UND 18; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPEL_THEN [`e`;`v'`] (USE 11 o ISPECL); REP_BASIC_TAC; REWR 11; REP_BASIC_TAC; USE 25 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `!e p. graph_edge G e /\ (!v. ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC ; ASM_REWRITE_TAC[]; REP_BASIC_TAC; IMATCH_MP_TAC (TAUT `~B ==> (A \/ B <=> A)`); DISCH_TAC; REP_BASIC_TAC; TSPEC `v` 18; UND 18; REWRITE_TAC[]; TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL); REWR 11; REP_BASIC_TAC; USE 18(REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* I- *) TYPE_THEN `NC` EXISTS_TAC; TYPE_THEN `D` EXISTS_TAC; TYPE_THEN `short_end` EXISTS_TAC; TYPE_THEN `hyper` EXISTS_TAC; TYPE_THEN `r` EXISTS_TAC; TYPE_THEN `d` EXISTS_TAC; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Sat Aug 21 08:06:22 EDT 2004 *) ]);; (* }}} *) let graph_vertex_exhaust = prove_by_refinement( `!(G:(A,B)graph_t) e v v'. (graph G /\ (graph_edge G e) /\ (graph_inc G e v) /\ (graph_inc G e v') /\ ~(v = v') ==> (graph_inc G e = {v,v'}))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; IMATCH_MP_TAC graph_edge2; ASM_REWRITE_TAC[]; REWRITE_TAC[has_size2]; REP_BASIC_TAC; UND 6; DISCH_THEN_FULL_REWRITE; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[in_pair]; KILL 3; KILL 4; RULE_ASSUM_TAC (REWRITE_RULE[in_pair]); ASM_MESON_TAC[]; ]);; (* }}} *) let graph_disk_hv = prove_by_refinement( `!G. plane_graph G /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = EMPTY) /\ (!v. (CARD (graph_edge_around G v) <=| 4)) ==> (?r H . graph_isomorphic G H /\ good_plane_graph H /\ (&0 < r) /\ (!v v'. graph_vertex H v /\ graph_vertex H v' /\ ~(v = v') ==> (closed_ball (euclid 2,d_euclid) v r INTER closed_ball (euclid 2,d_euclid) v' r = {})) /\ (!e v. graph_edge H e /\ graph_vertex H v /\ ~graph_inc H e v ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ (!e v. graph_edge H e /\ graph_inc H e v ==> (e INTER closed_ball (euclid 2, d_euclid) v r SUBSET (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)))) )`, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC [`G`] graph_disk_hv_preliminaries; ASM_REWRITE_TAC[]; POP_ASSUM_LIST (fun t-> ALL_TAC); REP_BASIC_TAC; (* - *) (* redo 19 *) TYPE_THEN `!e p. graph_edge G e /\ (!v. graph_inc G e v ==> ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (TAUT `~B ==> (A \/ B <=> A)`); DISCH_TAC; REP_BASIC_TAC; TSPEC `v` 20; UND 20; ASM_REWRITE_TAC[]; TYPEL_THEN[`e`;`v`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; USE 20 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; KILL 19; (* - *) TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (f e INTER f e' SUBSET e INTER e')` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[SUBSET;INTER ]; REP_BASIC_TAC; TYPE_THEN `?v. (graph_inc G e v /\ D v x)` ASM_CASES_TAC; REP_BASIC_TAC; TYPE_THEN `f e x = NC e v x` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; TYPE_THEN `graph_inc G e' v` ASM_CASES_TAC; TYPE_THEN `f e' x = NC e' v x` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; TYPE_THEN `(NC e v INTER NC e' v = {v})` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[INR IN_SING;INTER]; DISCH_TAC; TSPEC `x` 28; REWR 28; UND 28; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TYPE_THEN `e` (WITH 28 o ISPEC); TSPEC `e'` 28; UND 28; UND 32; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; DISCH_THEN_FULL_REWRITE; UND 26; UND 27; REWRITE_TAC[INTER]; DISCH_THEN_REWRITE; PROOF_BY_CONTR_TAC; UND 23; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `(f e x = d e x)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; GEN_TAC; UND 25; MESON_TAC[]; DISCH_THEN_FULL_REWRITE; TYPE_THEN `(?v. graph_inc G e' v /\ D v x)` ASM_CASES_TAC; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `d e INTER D v = {}` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; LEFT 25 "v"; TSPEC `v` 25; UND 25; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e'` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS;INTER ]; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `f e' x = d e' x` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; GEN_TAC; UND 26; MESON_TAC[]; DISCH_THEN_FULL_REWRITE; PROOF_BY_CONTR_TAC; TYPE_THEN `d e INTER d e' = EMPTY` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS ;INTER]; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (* A injective *) TYPE_THEN `INJ f (graph_edge G) UNIV` SUBGOAL_TAC; REWRITE_TAC[INJ]; REP_BASIC_TAC; TYPE_THEN ` (graph_inc G x ) HAS_SIZE 2` SUBGOAL_TAC; IMATCH_MP_TAC graph_edge2; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); ASM_REWRITE_TAC[]; REWRITE_TAC[has_size2]; REP_BASIC_TAC; TYPE_THEN `graph_inc G x a` SUBGOAL_TAC; ASM_REWRITE_TAC[in_pair]; DISCH_TAC; TYPE_THEN `d x SUBSET f x` SUBGOAL_TAC; KILL 21; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `d x (short_end x a)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `f x (short_end x a)` SUBGOAL_TAC; UND 28; UND 27; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `f x INTER f y SUBSET x INTER y` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `(x INTER y) (short_end x a)` SUBGOAL_TAC; USE 31 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; USE 21 GSYM; KILL 16; ASM_REWRITE_TAC[INTER_IDEMPOT]; TYPE_THEN `(x INTER y) SUBSET (graph_vertex G)` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `(graph_vertex G (short_end x a))` SUBGOAL_TAC; USE 33(REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* B now simple arc -- ugh *) TYPE_THEN `(!e v v'. (graph_edge G e /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (f e) v v')))` SUBGOAL_TAC; REP_BASIC_TAC; TYPE_THEN `f e = (NC e v UNION d e) UNION NC e v'` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[UNION]; ONCE_REWRITE_TAC [EQ_SYM_EQ;]; REWRITE_TAC[GSYM DISJ_ASSOC]; EQ_TAC; REP_CASES_TAC; DISJ2_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; DISJ2_TAC; TYPE_THEN `v'` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_CASES_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `graph_inc G e = {v , v'}` SUBGOAL_TAC; IMATCH_MP_TAC graph_vertex_exhaust; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); ASM_REWRITE_TAC[]; DISCH_TAC; REWR 27; USE 27 (REWRITE_RULE[in_pair]); UND 27; REP_CASES_TAC; UND 27; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; UND 27; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN ASSUME_TAC t); (* -- *) TYPE_THEN `simple_arc_end (NC e v UNION d e) v (short_end e v')` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `short_end e v` EXISTS_TAC; CONJ_TAC; TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL); REWR 5; REP_BASIC_TAC; TSPEC `v'` 5; REWR 5; (* --- *) IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING;INTER ]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; GEN_TAC; EQ_TAC; DISCH_THEN_FULL_REWRITE; CONJ_TAC; TYPE_THEN `simple_arc_end (NC e v) v (short_end e v)` SUBGOAL_TAC; TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; ASM_REWRITE_TAC[]; MESON_TAC[simple_arc_end_end2]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* --- *) DISCH_TAC; REP_BASIC_TAC; TYPE_THEN `D v x` SUBGOAL_TAC; TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; USE 29 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `d e INTER D v = {(short_end e v)}` SUBGOAL_TAC; TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL); REWR 5; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[eq_sing]; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `(short_end e v')` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING]; GEN_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; EQ_TAC; DISCH_THEN_FULL_REWRITE; CONJ_TAC; UND 27; MESON_TAC[simple_arc_end_end2]; TYPEL_THEN[`e`;`v'`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; UND 29; MESON_TAC[simple_arc_end_end2]; REP_BASIC_TAC; UND 29; REWRITE_TAC[UNION]; REP_CASES_TAC ; PROOF_BY_CONTR_TAC; TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `x` EXISTS_TAC; CONJ_TAC; TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; USE 31 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; USE 31 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `D v' x` SUBGOAL_TAC; TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; USE 30 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `d e INTER D v' = {(short_end e v')}` SUBGOAL_TAC; TYPEL_THEN [`e`;`v'`] (USE 5 o ISPECL); REWR 5; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER;eq_sing]; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* C - *) TYPE_THEN `!e v. (graph_edge G e) ==> ( e INTER graph_vertex G = (f e) INTER (graph_vertex G))` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER]; GEN_TAC; IMATCH_MP_TAC (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`); DISCH_TAC; TYPE_THEN `D x x` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `graph_inc G e x` ASM_CASES_TAC; TYPE_THEN `f e x = NC e x x` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `NC e x x` SUBGOAL_TAC; TYPEL_THEN[`e`;`x`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; UND 28; MESON_TAC[simple_arc_end_end]; DISCH_THEN_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TSPEC `e` 27; REWR 27; REWR 26; UND 26; REWRITE_TAC[INTER]; DISCH_THEN_REWRITE; TYPE_THEN `~f e x` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; DISCH_TAC; UND 26; REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TSPEC `e` 26; REWR 26; ASM_REWRITE_TAC[INTER]; DISCH_TAC; (* D start on graph and goal *) TYPE_THEN `r /(&2)` EXISTS_TAC; TYPE_THEN `graph_edge_mod G f` EXISTS_TAC; REWRITE_TAC[good_plane_graph]; ASM_REWRITE_TAC[REAL_LT_HALF1]; CONJ_TAC; IMATCH_MP_TAC graph_edge_iso; ASM_REWRITE_TAC[]; REWRITE_TAC[TAUT `(A /\ B) /\ C <=> (A /\ (B /\ C))`]; (* - *) CONJ_TAC; IMATCH_MP_TAC plane_graph_mod; USE 16 GSYM; ASM_REWRITE_TAC[]; REP_BASIC_TAC; IMATCH_MP_TAC simple_arc_end_simple; TH_INTRO_TAC [`G`;`e`] graph_edge_end_select; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); (* --x-- *) ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `v'` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i]); REP_BASIC_TAC; USE 29 GSYM; UND 29; DISCH_THEN_FULL_REWRITE; TYPE_THEN `e'' =e'` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!v. closed_ball (euclid 2, d_euclid) v (r/(&2)) SUBSET D v` SUBGOAL_TAC; GEN_TAC; EXPAND_TAC "D"; REWRITE_TAC[closed_ball;SUBSET]; TYPE_THEN `r /(&2) < r` SUBGOAL_TAC; UND 1; MESON_TAC[ half_pos]; MESON_TAC[REAL_ARITH `x <= u /\ u < v ==> x <= v`]; DISCH_TAC; (* - *) CONJ_TAC; REP_BASIC_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `D v INTER D v'` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v]); TYPE_THEN `(D v INTER D v' = EMPTY)` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[]; (* E - down to 2 *) CONJ_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v;graph_edge_mod_i;graph_edge_mod_e]); USE 27 (REWRITE_RULE[IMAGE]); REP_BASIC_TAC; UND 27; DISCH_THEN_FULL_REWRITE; LEFT 25 "e'"; TSPEC `x` 25; PROOF_BY_CONTR_TAC; USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER]); REP_BASIC_TAC; TYPE_THEN `D v u` SUBGOAL_TAC; USE 24 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `~f x u` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 25; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - final *) REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_i;graph_edge_mod_e]); USE 26 (REWRITE_RULE[IMAGE]); REP_BASIC_TAC; UND 28; DISCH_THEN_FULL_REWRITE; TYPE_THEN `e' = x` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; (* - *) TYPE_THEN `f x INTER D v = NC x v INTER D v` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER]; IMATCH_MP_TAC (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`); DISCH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `f x INTER (closed_ball (euclid 2,d_euclid) v (r/(&2))) = NC x v INTER (closed_ball(euclid 2, d_euclid) v (r/(&2)))` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INTER]; USE 28 (REWRITE_RULE[FUN_EQ_THM]); TSPEC `x'` 28; UND 28; UND 24; REWRITE_TAC[SUBSET;INTER]; MESON_TAC[]; DISCH_THEN_REWRITE; TYPEL_THEN[`x`;`v`] (USE 10 o ISPECL); REWR 10; REP_BASIC_TAC; UND 10; EXPAND_TAC "hyper"; DISCH_THEN_REWRITE; (* Sat Aug 21 14:12:41 EDT 2004 *) ]);; (* }}} *) let hv_finite = jordan_def `hv_finite C <=> (?E. C SUBSET UNIONS E /\ FINITE E /\ hv_line E)`;; let hv_finite_subset = prove_by_refinement( `!A B. hv_finite B /\ A SUBSET B ==> hv_finite A`, (* {{{ proof *) [ REWRITE_TAC[hv_finite]; REP_BASIC_TAC; TYPE_THEN `E` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `B` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let mk_line_hyper2_e1 = prove_by_refinement( `!z. mk_line (point (z, &0)) (point(z, &1)) = hyperplane 2 e1 z`, (* {{{ proof *) [ REWRITE_TAC[GSYM line2D_F;e1;mk_line;]; GEN_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[point_scale;point_add]; GEN_TAC; REDUCE_TAC; TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC; GEN_TAC; real_poly_tac; DISCH_THEN_REWRITE; EQ_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `(z, &1 - t)` EXISTS_TAC; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `&1 - (SND p)` EXISTS_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let mk_line_hyper2_e2 = prove_by_refinement( `!z. mk_line (point (&0, z)) (point(&1, z)) = hyperplane 2 e2 z`, (* {{{ proof *) [ REWRITE_TAC[GSYM line2D_S;e2;mk_line;]; GEN_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[point_scale;point_add]; GEN_TAC; REDUCE_TAC; TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC; GEN_TAC; real_poly_tac; DISCH_THEN_REWRITE; EQ_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `( &1 - t, z)` EXISTS_TAC; REWRITE_TAC[]; REP_BASIC_TAC; ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `&1 - (FST p)` EXISTS_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let hv_finite_hyper = prove_by_refinement( `!C. (?v. C SUBSET (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))) ==> (hv_finite C)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[hv_finite]; TYPE_THEN `{(hyperplane 2 e2 (v 1)), (hyperplane 2 e1 (v 0))}` EXISTS_TAC ; ASM_REWRITE_TAC[UNIONS_2;FINITE_INSERT;FINITE_SING;FINITE_RULES; ]; REWRITE_TAC[hv_line;in_pair;GSYM mk_line_hyper2_e2;GSYM mk_line_hyper2_e1]; GEN_TAC; REP_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(v 0, &0)` EXISTS_TAC; TYPE_THEN `(v 0, &1)` EXISTS_TAC; REWRITE_TAC[]; ASM_REWRITE_TAC[]; TYPE_THEN `(&0, v 1)` EXISTS_TAC; TYPE_THEN `(&1, v 1)` EXISTS_TAC; REWRITE_TAC[]; ]);; (* }}} *) let graph_hv_finite_radius = jordan_def `graph_hv_finite_radius G r <=> (good_plane_graph G /\ (&0 < r) /\ (!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (closed_ball (euclid 2,d_euclid) v r INTER closed_ball (euclid 2,d_euclid) v' r = {})) /\ (!e v. graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ (!e v. graph_edge G e /\ graph_inc G e v ==> (hv_finite (e INTER closed_ball (euclid 2, d_euclid) v r)))) `;; let p_conn_hv_finite = prove_by_refinement( `!A x y. ~(x = y) ==> (p_conn A x y <=> (?C. (hv_finite C) /\ (C SUBSET A) /\ (simple_arc_end C x y)))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[p_conn;simple_polygonal_arc]; (* - *) EQ_TAC; REP_BASIC_TAC; TH_INTRO_TAC [`C`;`x`;`y`] simple_arc_end_select; ASM_REWRITE_TAC[top2]; REP_BASIC_TAC; TYPE_THEN `C'` EXISTS_TAC; REWRITE_TAC[hv_finite]; CONJ_TAC; TYPE_THEN `E` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]); REP_BASIC_TAC; TYPE_THEN `C` EXISTS_TAC; CONJ_TAC; CONJ_TAC; REWRITE_TAC[GSYM top2]; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; ]);; (* }}} *) let graph_iso_around = prove_by_refinement( `!(G:(A,B)graph_t) (H:(A',B')graph_t) f v. (graph G) /\ graph_iso f G H /\ (graph_vertex G v) ==> (graph_edge_around H (FST f v) = (IMAGE (SND f) (graph_edge_around G v)))`, (* {{{ proof *) [ REWRITE_TAC[graph_iso;graph_edge_around]; REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REP_BASIC_TAC; REWRITE_TAC[]; EQ_TAC ; REP_BASIC_TAC; TYPE_THEN `(?y. graph_edge G y /\ (v' y = x))` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REP_BASIC_TAC; USE 8 GSYM; UND 8; DISCH_THEN_FULL_REWRITE; TSPEC `y` 1; REWR 1; REWRITE_TAC[IMAGE]; TYPE_THEN `y` EXISTS_TAC; ASM_REWRITE_TAC[]; REWR 6; USE 6 (REWRITE_RULE[IMAGE]); REP_BASIC_TAC; TYPE_THEN `v = x'` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TH_INTRO_TAC [`G`;`y`] graph_inc_subset; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE]; REP_BASIC_TAC; REWR 6; UND 6; DISCH_THEN_FULL_REWRITE; SUBCONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); ASM_MESON_TAC[]; DISCH_TAC; ASM_SIMP_TAC[]; REWRITE_TAC[IMAGE]; REP_BASIC_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Sat Aug 21 16:49:58 EDT 2004 *) ]);; (* }}} *) let graph_radius_exists = prove_by_refinement( `!G. planar_graph (G:(A,B) graph_t) /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = EMPTY) /\ (!v. (CARD (graph_edge_around G v) <=| 4)) ==> (?r H. (graph_isomorphic G H /\ graph_hv_finite_radius H r))`, (* {{{ proof *) [ REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[planar_graph]); REP_BASIC_TAC; TYPE_THEN `FINITE (graph_edge H) /\ FINITE (graph_vertex H) /\ ~(graph_edge H = EMPTY) /\ (!v. (CARD (graph_edge_around H v) <=| 4))` SUBGOAL_TAC; WITH 4 (REWRITE_RULE[graph_isomorphic]); REP_BASIC_TAC; SUBCONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]); REP_BASIC_TAC; TH_INTRO_TAC [`graph_edge H`;`graph_edge G`;`v`] FINITE_BIJ2; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; DISCH_TAC; (* -- *) CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]); REP_BASIC_TAC; TH_INTRO_TAC [`graph_vertex H`;`graph_vertex G`;`u`] FINITE_BIJ2; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; CONJ_TAC; REWRITE_TAC[EMPTY_EXISTS]; RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_iso;BIJ;SURJ]); REP_BASIC_TAC; ASM_MESON_TAC[]; GEN_TAC; (* -- *) TYPE_THEN `graph_vertex H v` ASM_CASES_TAC; TH_INTRO_TAC [`H`;`G`;`f`;`v`] graph_iso_around; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); ASM_REWRITE_TAC[]; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]); REP_BASIC_TAC; UND 12; DISCH_THEN_FULL_REWRITE; TSPEC `u v` 0; REWR 0; TH_INTRO_TAC [`v'`;`graph_edge_around H v`] CARD_IMAGE_INJ; REWRITE_TAC[]; CONJ_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ;BIJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_around]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `graph_edge H` EXISTS_TAC ; ASM_REWRITE_TAC[SUBSET;graph_edge_around]; MESON_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; TH_INTRO_TAC [`H`;`v`] graph_edge_around_empty; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[CARD_CLAUSES]; ARITH_TAC; REP_BASIC_TAC; (* - *) TH_INTRO_TAC [`H`] graph_disk_hv; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `r` EXISTS_TAC; TYPE_THEN `H'` EXISTS_TAC; REWRITE_TAC[graph_hv_finite_radius]; ASM_REWRITE_TAC[]; CONJ_TAC; TH_INTRO_TAC [`G`;`H`;`H'`] graph_isomorphic_trans; ASM_REWRITE_TAC[]; IMATCH_MP_TAC graph_isomorphic_symm; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* - *) REP_BASIC_TAC; TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); REWR 10; IMATCH_MP_TAC hv_finite_hyper; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Sat Aug 21 17:28:09 EDT 2004 *) ]);; (* }}} *) let replace = jordan_def `replace (x:A) y = (\ z. (if (z = x) then y else z))`;; let replace_x = prove_by_refinement( `!(x:A) y. replace x y x = y`, (* {{{ proof *) [ REWRITE_TAC[replace]; (* Sun Aug 22 09:01:27 EDT 2004 *) ]);; (* }}} *) let graph_replace = jordan_def `graph_replace (G:(A,B)graph_t) e e' = graph_edge_mod G (replace e e')`;; let replace_inj = prove_by_refinement( `!(x:A) y Z. ~(Z y) ==> INJ (replace x y) Z UNIV`, (* {{{ proof *) [ REWRITE_TAC[INJ;replace]; REP_BASIC_TAC; MP_TAC (TAUT `((x' = (x:A)) \/ ~(x' = x)) /\ ((y' = x) \/ ~(y' = x))`); REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; REP_CASES_TAC THEN (REWR 0); ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let graph_replace_iso = prove_by_refinement( `!(G:(A,B)graph_t) e e'. ~(graph_edge G e') ==> graph_isomorphic G (graph_replace G e e')`, (* {{{ proof *) [ REWRITE_TAC[graph_replace]; REP_BASIC_TAC; IMATCH_MP_TAC graph_edge_iso; IMATCH_MP_TAC replace_inj; ASM_REWRITE_TAC[]; (* Sun Aug 22 09:30:14 EDT 2004 *) ]);; (* }}} *) let graph_replace_plane = prove_by_refinement( `!G e e'. plane_graph G /\ ~(graph_edge G e') /\ (graph_edge G e) /\ (!e''. graph_edge G e'' /\ ~(e'' = e) ==> (e' INTER e'' SUBSET e INTER e'')) /\ (simple_arc top2 e') /\ (e INTER graph_vertex G = e' INTER graph_vertex G) ==> plane_graph (graph_replace G e e')`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[graph_replace]; IMATCH_MP_TAC plane_graph_mod; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; IMATCH_MP_TAC replace_inj; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; REP_BASIC_TAC; REWRITE_TAC[replace]; TYPE_THEN `((e'' = e) \/ ~(e'' = e)) /\ ((e''' = e) \/ ~(e''' = e))` (fun t-> MP_TAC (TAUT t)); REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; REP_CASES_TAC THEN (FIRST_ASSUM (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN (ASSUME_TAC t))); ASM_MESON_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC [INTER_COMM]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET_REFL]; (* - *) CONJ_TAC; REP_BASIC_TAC; REWRITE_TAC[replace]; COND_CASES_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) REP_BASIC_TAC; REWRITE_TAC[replace]; COND_CASES_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[]; (* Sun Aug 22 10:28:15 EDT 2004 *) ]);; (* }}} *) let good_replace = prove_by_refinement( `!G e e'. (good_plane_graph G) /\ plane_graph (graph_replace G e e') /\ ~(graph_edge G e') /\ ( e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\ (!v v'. (graph_vertex G v) /\ (graph_vertex G v') /\ ~(v = v') /\ e' v /\ e' v' ==> simple_arc_end e' v v') ==> (good_plane_graph (graph_replace G e e'))`, (* {{{ proof *) [ REWRITE_TAC[good_plane_graph;graph_replace]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i ;IMAGE ]); REP_BASIC_TAC; UND 6; DISCH_THEN_FULL_REWRITE; TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `e'''' = x` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; TYPE_THEN `e''' = x` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; (* - *) REWRITE_TAC[replace]; COND_CASES_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UNDF `x`; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REP_BASIC_TAC; TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; UNDF `e INTER u = e' INTER u`; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[INTER;]); ASM_REWRITE_TAC[]; (* - *) KILL 0; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Sun Aug 22 10:59:34 EDT 2004 *) ]);; (* }}} *) let graph_replace_hv_finite_radius = prove_by_refinement( `!G r e e'. graph_hv_finite_radius G r /\ ~(graph_edge G e') /\ good_plane_graph (graph_replace G e e') /\ (e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\ (!v. graph_vertex G v /\ ~(e' v) ==> ((e' INTER closed_ball (euclid 2,d_euclid) v r = {}))) /\ (hv_finite e') ==> graph_hv_finite_radius (graph_replace G e e') r`, (* {{{ proof *) [ REWRITE_TAC[graph_hv_finite_radius]; REP_BASIC_TAC; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; REP_BASIC_TAC; UND 7; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[graph_replace ;graph_edge_mod_v]); ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]); REP_BASIC_TAC; UNDF `e''`; DISCH_THEN_FULL_REWRITE; REWRITE_TAC[replace]; COND_CASES_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWR 13; DISCH_TAC; LEFT 10 "e'''"; TSPEC `e` 10; UND 10; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); REP_BASIC_TAC; TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[INTER]; KILL 1; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; LEFT 10 "e'''"; TSPEC `x` 1; REWR 1; (* - *) REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]); REP_BASIC_TAC; UNDF `e''`; DISCH_THEN_FULL_REWRITE; TYPE_THEN `e''' = x` SUBGOAL_TAC; TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj; ASM_REWRITE_TAC[]; REWRITE_TAC[INJ]; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; (* - *) REWRITE_TAC[replace]; COND_CASES_TAC ; UNDF `x`; DISCH_THEN_FULL_REWRITE; IMATCH_MP_TAC hv_finite_subset; TYPE_THEN `e'` EXISTS_TAC; ASM_REWRITE_TAC[INTER;SUBSET;]; MESON_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Sun Aug 22 12:09:03 EDT 2004 *) ]);; (* }}} *) let card_suc_insert = prove_by_refinement( `!(x:A) s. FINITE s /\ (~(s x)) ==> (SUC (CARD s) = CARD(x INSERT s))`, (* {{{ proof *) [ REP_BASIC_TAC; ASM_SIMP_TAC [CARD_CLAUSES]; ]);; (* }}} *) let graph_replace_card = prove_by_refinement( `!G e e'. (FINITE (graph_edge (G:(A,(num->real)->bool)graph_t))) /\ (graph_edge G e) /\ ~(graph_edge G e') /\ ~(hv_finite e) /\ (hv_finite e') ==> (CARD {x | graph_edge (graph_replace G e e') x /\ ~(hv_finite x)} < CARD{ x | graph_edge G x /\ ~hv_finite x}) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC (ARITH_RULE `(SUC x = y) ==> (x <| y)`); (* - *) TYPE_THEN `FINITE (graph_edge (graph_replace G e e'))` SUBGOAL_TAC; REWRITE_TAC[graph_edge_mod_e;graph_replace]; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `A = {x | graph_edge (graph_replace G e e') x /\ ~hv_finite x}` ABBREV_TAC ; TYPE_THEN `FINITE A` SUBGOAL_TAC; EXPAND_TAC "A"; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `graph_edge (graph_replace G e e')` EXISTS_TAC; ASM_REWRITE_TAC[]; EXPAND_TAC "A"; REWRITE_TAC[SUBSET]; MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `~A e` SUBGOAL_TAC; EXPAND_TAC"A"; REWRITE_TAC[]; ASM_REWRITE_TAC[graph_replace;graph_edge_mod_e;IMAGE]; DISCH_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[replace]); UND 8; COND_CASES_TAC; ASM_MESON_TAC[]; UND 8; REWRITE_TAC[]; MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `SUC (CARD A) = CARD(e INSERT A)` SUBGOAL_TAC; IMATCH_MP_TAC card_suc_insert; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* - *) AP_TERM_TAC; EXPAND_TAC "A"; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[INSERT;graph_replace;graph_edge_mod_e;IMAGE;replace; ]; EQ_TAC; REP_BASIC_TAC; FIRST_ASSUM DISJ_CASES_TAC; REP_BASIC_TAC; UNDF `x = u`; DISCH_THEN_FULL_REWRITE; COND_CASES_TAC; UNDF `x' = e`; DISCH_THEN_FULL_REWRITE; ASM_MESON_TAC[]; REWR 10; UNDF `x = e`; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; (* - *) REP_BASIC_TAC; TYPE_THEN `x = e` ASM_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let graph_edge_end_select_other = prove_by_refinement( `!(G:(A,B)graph_t) e v. (graph G /\ graph_edge G e /\ (graph_inc G e v) ==> (?v'. (graph_inc G e v' /\ ~(v = v'))))`, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC [`G`;`e`] graph_edge_end_select; REP_BASIC_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; IMATCH_MP_TAC graph_edge2; ASM_REWRITE_TAC[]; REWRITE_TAC[has_size2]; REP_BASIC_TAC; UND 7; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[in_pair]); REWRITE_TAC[in_pair]; TYPE_THEN `(v'' = b)` ASM_CASES_TAC; UNDF `v''`; DISCH_THEN_FULL_REWRITE; REWR 5; UNDF`v'`; DISCH_THEN_FULL_REWRITE; ASM_MESON_TAC[]; REWR 4; UNDF`v''`; DISCH_THEN_FULL_REWRITE; REWR 5; ASM_MESON_TAC[]; ]);; (* }}} *) let graph_rad_pt_select = prove_by_refinement( `!G r e v. graph_hv_finite_radius G r /\ graph_inc G e v /\ graph_edge G e ==> (?C u. (hv_finite C) /\ (simple_arc_end C v u) /\ (euclid 2 u) /\ (d_euclid v u = r) /\ (C SUBSET e) /\ (C SUBSET (closed_ball(euclid 2,d_euclid) v r))) `, (* {{{ proof *) [ REWRITE_TAC[graph_hv_finite_radius]; REP_BASIC_TAC; (* - *) TH_INTRO_TAC [`e`;`{v}`;`(euclid 2 DIFF (open_ball(euclid 2,d_euclid) v r))`] simple_arc_end_restriction; (* -- *) CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE [good_plane_graph;plane_graph;SUBSET ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* -- *) TH_INTRO_TAC[`G`;`e`;`v`] graph_edge_end_select_other; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* -- *) CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); REP_BASIC_TAC; IMATCH_MP_TAC simple_arc_end_end_closed; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `v'` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* -- *) CONJ_TAC; TH_INTRO_TAC [`top2`;`open_ball(euclid 2,d_euclid) v r`] open_closed; REWRITE_TAC[top2_top]; ASM_SIMP_TAC [top2;open_ball_open;metric_euclid;open_DEF ]; REWRITE_TAC[top2_unions]; (* -- *) CONJ_TAC; REWRITE_TAC[INTER;DIFF;EQ_EMPTY;open_ball;INR IN_SING ]; REP_BASIC_TAC; UNDF `x = v`; DISCH_THEN_FULL_REWRITE; UNDF `x < r`; ASM_REWRITE_TAC[]; TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_zero; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[metric_euclid]; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; (* -- *) CONJ_TAC; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `v` EXISTS_TAC; REWRITE_TAC[INTER;INR IN_SING]; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); REP_BASIC_TAC; UNDF `graph_inc G e = y`; DISCH_THEN (TH_INTRO_TAC [`e`]); ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[INTER]); ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `v'` EXISTS_TAC; REWRITE_TAC[INTER]; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); REP_BASIC_TAC; UNDF `graph_inc G e = y`; DISCH_THEN (TH_INTRO_TAC [`e`]); ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[INTER]); ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[DIFF]; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TH_INTRO_TAC [`G`;`e`] graph_inc_subset; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[open_ball;DE_MORGAN_THM ]; DISJ2_TAC; DISJ2_TAC; DISCH_TAC; (* -- *) TYPE_THEN `!v. graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC; TH_INTRO_TAC [`G`;`e`] graph_inc_subset; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_TAC; (* -- *) TYPE_THEN `!v. graph_inc G e v ==> euclid 2 v` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) UND 4; DISCH_THEN ( TH_INTRO_TAC [`v`;`v'`] ); ASM_MESON_TAC []; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `v` EXISTS_TAC; REWRITE_TAC[closed_ball]; TYPE_THEN `euclid 2 v` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `euclid 2 v'` SUBGOAL_TAC; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_zero; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_MESON_TAC[metric_euclid]; DISCH_THEN_REWRITE; UND 5; UND 9; TYPE_THEN `d_euclid v v' = d_euclid v' v` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_symm; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_MESON_TAC[metric_euclid]; DISCH_THEN_REWRITE; REAL_ARITH_TAC; (* A- *) REP_BASIC_TAC; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `v''` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `v' = v` SUBGOAL_TAC; UND 8; REWRITE_TAC[INTER;eq_sing;INR IN_SING ]; MESON_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `euclid 2 v''` SUBGOAL_TAC; FIRST_ASSUM MP_TAC; REWRITE_TAC[INTER;DIFF;eq_sing;]; DISCH_THEN_REWRITE; DISCH_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `d_euclid v v'' = r` SUBGOAL_TAC; IMATCH_MP_TAC disk_endpoint_outer; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; TH_INTRO_TAC [`C'`] simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; UND 9; MESON_TAC[simple_arc_end_end]; DISCH_TAC; ASM_REWRITE_TAC[]; (* B- *) TYPE_THEN `C' SUBSET closed_ball(euclid 2,d_euclid) v r` SUBGOAL_TAC; UND 7; REWRITE_TAC[SUBSET;closed_ball;INTER;open_ball;DIFF;eq_sing;INR IN_SING]; REP_BASIC_TAC; TYPE_THEN `!x. C' x ==> euclid 2 x` SUBGOAL_TAC; REP_BASIC_TAC; TH_INTRO_TAC[`C'`] simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `C' v` SUBGOAL_TAC; UND 8; REWRITE_TAC[INTER;INR IN_SING;eq_sing;]; DISCH_THEN_REWRITE; DISCH_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `x = v''` ASM_CASES_TAC; UNDF `x = v''`; DISCH_THEN_FULL_REWRITE; UND 12; REAL_ARITH_TAC; TSPEC `x` 13; PROOF_BY_CONTR_TAC; UND 19; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; SUBCONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[DE_MORGAN_THM]; DISJ2_TAC; UND 20; REAL_ARITH_TAC; DISCH_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC hv_finite_subset; TYPE_THEN `e INTER (closed_ball(euclid 2,d_euclid) v r)` EXISTS_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET_INTER]; ASM_REWRITE_TAC[]; (* Sun Aug 22 15:50:58 EDT 2004 *) ]);; (* }}} *) (* not needed here *) let top_union = prove_by_refinement( `!A B U. topology_ U /\ U A /\ U (B:A->bool) ==> U(A UNION B)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[GSYM UNIONS_2]; IMATCH_MP_TAC top_unions; ASM_REWRITE_TAC[in_pair; SUBSET;]; ASM_MESON_TAC[]; ]);; (* }}} *) let top_closed_unions = prove_by_refinement( `!(B:(A->bool)->bool) U. topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==> closed_ U(UNIONS B)`, (* {{{ proof *) [ TYPE_THEN `!n (B:(A->bool)->bool) U. (CARD B = n) /\ topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==> closed_ U(UNIONS B)` SUBGOAL_TAC; INDUCT_TAC; REP_BASIC_TAC; TYPE_THEN `B HAS_SIZE 0` SUBGOAL_TAC; ASM_REWRITE_TAC[HAS_SIZE]; REWRITE_TAC[HAS_SIZE_0]; DISCH_THEN_REWRITE; IMATCH_MP_TAC empty_closed; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* -- *) TYPE_THEN `~(B = EMPTY)` SUBGOAL_TAC; DISCH_TAC; UNDF `EMPTY`; DISCH_THEN_FULL_REWRITE; UNDF `SUC`; REWRITE_TAC[CARD_CLAUSES]; ARITH_TAC; DISCH_TAC; (* -- *) TH_INTRO_TAC [`B`] CARD_DELETE_CHOICE; ASM_REWRITE_TAC[]; DISCH_TAC; USEF `SUC` SYM; REWR 4; RULE_ASSUM_TAC (REWRITE_RULE[SUC_INJ]); TYPEL_THEN [`(B DELETE CHOICE B)`;`U`] (USE 0 o ISPECL); UNDF `n`; DISCH_THEN (TH_INTRO_TAC []); ASM_REWRITE_TAC[FINITE_DELETE]; UNDF `(SUBSET)`; REWRITE_TAC[SUBSET;DELETE]; MESON_TAC[]; (* -- *) DISCH_TAC; TYPE_THEN `closed_ U( UNIONS (B DELETE CHOICE B) UNION (CHOICE B))` SUBGOAL_TAC; IMATCH_MP_TAC closed_union; ASM_REWRITE_TAC[]; UND 1; REWRITE_TAC[SUBSET]; USEF `(~)` (MATCH_MP CHOICE_DEF); UNDF `(IN)`; REWRITE_TAC[]; MESON_TAC[]; ASM_MESON_TAC[unions_delete_choice]; ASM_MESON_TAC[]; ]);; (* }}} *) let euclid2_d0 = prove_by_refinement( `!x. (euclid 2 x) ==> (d_euclid x x = &0)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC metric_space_zero; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[metric_euclid]; ]);; (* }}} *) let union_imp_subset = prove_by_refinement( `!(Z1:A->bool) Z2 A. (Z1 UNION Z2 = A) ==> (Z1 SUBSET A /\ Z2 SUBSET A)`, (* {{{ proof *) [ SET_TAC[UNION;SUBSET]; ]);; (* }}} *) let loc_path_conn_top2 = prove_by_refinement( `loc_path_conn top2`, (* {{{ proof *) [ REWRITE_TAC[top2]; IMATCH_MP_TAC loc_path_conn_euclid; TYPE_THEN `2` EXISTS_TAC; MESON_TAC[metric_euclid;top_of_metric_top;top_of_metric_unions;top_univ]; ]);; (* }}} *) let connected_empty = prove_by_refinement( `!U. connected (U:(A->bool)->bool) EMPTY `, (* {{{ proof *) [ REWRITE_TAC[connected]; ]);; (* }}} *) let component_imp_connected = prove_by_refinement( `!U (x:A). (topology_ U) ==> (connected U (component U x))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `~(UNIONS U x)` ASM_CASES_TAC; UND 1; ASM_SIMP_TAC[GSYM component_empty]; REWRITE_TAC[connected_empty]; REWR 1; (* - *) REWRITE_TAC[connected]; CONJ_TAC; REWRITE_TAC[SUBSET;connected;component]; REP_BASIC_TAC; ASM_MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `component U x x` SUBGOAL_TAC; ASM_MESON_TAC[component_refl]; DISCH_TAC; (* - *) TYPE_THEN `A x \/ B x` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET;UNION]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!A B. component U x SUBSET A UNION B /\ (A INTER B = EMPTY) /\ U B /\ U A /\ A x ==> component U x SUBSET A` SUBGOAL_TAC; REP_BASIC_TAC; REWRITE_TAC[SUBSET]; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `B' x'` SUBGOAL_TAC; USE 11 (REWRITE_RULE[SUBSET;UNION]); TSPEC `x'` 11; ASM_MESON_TAC[]; DISCH_TAC; USE 12 (REWRITE_RULE[component]); REP_BASIC_TAC; TYPE_THEN `Z SUBSET (component U x)` SUBGOAL_TAC; IMATCH_MP_TAC connected_component; ASM_REWRITE_TAC[]; DISCH_TAC; USE 16 (REWRITE_RULE[connected]); REP_BASIC_TAC; TYPEL_THEN[`A'`;`B'`] (USE 16 o ISPECL); UND 16; ASM_REWRITE_TAC[]; TYPE_THEN `Z SUBSET A' UNION B'` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `component U x` EXISTS_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; REWRITE_TAC[DE_MORGAN_THM]; REWRITE_TAC[SUBSET]; REP_BASIC_TAC; CONJ_TAC; ASM_MESON_TAC[]; USE 10 (REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; DISCH_TAC; (* - *) DISCH_THEN DISJ_CASES_TAC; TYPEL_THEN[`A`;`B`] (USE 7 o ISPECL); ASM_MESON_TAC[]; TYPEL_THEN [`B`;`A`] (USE 7 o ISPECL); REWR 7; DISJ2_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ONCE_REWRITE_TAC[INTER_COMM]; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[UNION_COMM]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let open_induced = prove_by_refinement( `!U (A:A->bool). (topology_ U) /\ U A ==> (induced_top U A = { B | U B /\ B SUBSET A })`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[induced_top;IMAGE;]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[]; GEN_TAC; EQ_TAC; REP_BASIC_TAC; FIRST_ASSUM MP_TAC ; DISCH_THEN_FULL_REWRITE; CONJ_TAC; IMATCH_MP_TAC top_inter; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER;SUBSET]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 2; SET_TAC [INTER;SUBSET]; ]);; (* }}} *) let connected_induced = prove_by_refinement( `!U (C:A->bool) . (topology_ U /\ U C ) ==> (connected U C = connected (induced_top U C) C)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[connected]; ASM_SIMP_TAC[open_induced]; EQ_TAC; REP_BASIC_TAC; CONJ_TAC; IMATCH_MP_TAC sub_union; ASM_REWRITE_TAC[SUBSET_REFL ]; REP_BASIC_TAC; TYPEL_THEN [`A`;`B`] (USE 2 o ISPECL); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) REP_BASIC_TAC; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS {B | U B /\ B SUBSET C}` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC UNIONS_UNIONS; ONCE_REWRITE_TAC[SUBSET]; REWRITE_TAC[]; MESON_TAC[]; (* - *) REP_BASIC_TAC; TYPEL_THEN[`A INTER C`;`B INTER C`] (USE 2 o ISPECL); REWR 2; UND 2; DISCH_THEN (TH_INTRO_TAC []); TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC top_inter; ASM_REWRITE_TAC[]; DISCH_TAC; REWRITE_TAC[GSYM CONJ_ASSOC]; CONJ_TAC; ASM_MESON_TAC[]; REWRITE_TAC[INTER_SUBSET]; CONJ_TAC; ASM_MESON_TAC[]; CONJ_TAC; UND 5; SET_TAC[INTER]; UND 4; SET_TAC[SUBSET;UNION;INTER]; SET_TAC[INTER;SUBSET]; ]);; (* }}} *) let connected_induced2 = prove_by_refinement( `!U (C:A->bool) Z. (topology_ U /\ U C /\ Z SUBSET (UNIONS U)) ==> (connected (induced_top U C) Z <=> (Z SUBSET C) /\ (connected U Z))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[connected]; ASM_SIMP_TAC[open_induced]; EQ_TAC; REP_BASIC_TAC; SUBCONJ_TAC; REWRITE_TAC[SUBSET]; REP_BASIC_TAC; USE 4(REWRITE_RULE[SUBSET;UNIONS]); TSPEC `x` 4; REWR 4; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; REP_BASIC_TAC; TYPEL_THEN [`A INTER C`;`B INTER C`] (USE 3 o ISPECL); REWR 3; UND 3; DISCH_THEN (TH_INTRO_TAC []); TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC; REP_BASIC_TAC; IMATCH_MP_TAC top_inter; ASM_REWRITE_TAC[]; DISCH_TAC; REWRITE_TAC[GSYM CONJ_ASSOC]; CONJ_TAC; ASM_MESON_TAC[]; REWRITE_TAC[INTER_SUBSET]; CONJ_TAC; ASM_MESON_TAC[]; CONJ_TAC; UND 7; SET_TAC[INTER]; UND 6; UND 5; SET_TAC[INTER;SUBSET;UNION]; UND 5; SET_TAC[INTER;SUBSET;UNION]; REP_BASIC_TAC; (* - *) CONJ_TAC; UND 0; REWRITE_TAC[SUBSET;UNIONS]; REP_BASIC_TAC; TSPEC `x` 5; REWR 5; REP_BASIC_TAC; TYPE_THEN `u INTER C` EXISTS_TAC; REWRITE_TAC[GSYM CONJ_ASSOC]; CONJ_TAC; IMATCH_MP_TAC top_inter; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER]; ASM_MESON_TAC[ISUBSET ]; (* - *) REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let connected_metric = prove_by_refinement( `!X d (C:A->bool). metric_space (X,d) /\ C SUBSET X /\ (top_of_metric(X,d)C) ==> (connected(top_of_metric(X,d))C <=> connected(top_of_metric(C,d))C)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d))C` SUBGOAL_TAC; ASM_MESON_TAC[top_of_metric_induced]; DISCH_THEN_REWRITE; IMATCH_MP_TAC connected_induced; ASM_MESON_TAC[top_of_metric_top]; ]);; (* }}} *) let connected_metric_pair = prove_by_refinement( `!(X:A->bool) Y Z d. metric_space (X,d) /\ top_of_metric(X,d) Y /\ top_of_metric(X,d) Z /\ Z SUBSET Y ==> (connected (top_of_metric(X,d)) Z = connected (top_of_metric(Y,d)) Z)`, (* {{{ proof *) [ REP_BASIC_TAC; (* - *) TYPE_THEN `Y SUBSET X` SUBGOAL_TAC; USE 2(MATCH_MP sub_union); UND 2; ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_TAC; (* - *) TYPE_THEN `Z SUBSET X` SUBGOAL_TAC ; ASM_MESON_TAC[SUBSET_TRANS]; DISCH_TAC; ASM_SIMP_TAC[connected_metric]; (* - *) TYPE_THEN `metric_space (Y,d)` SUBGOAL_TAC; ASM_MESON_TAC[metric_subspace]; DISCH_TAC; (* - *) TYPE_THEN `top_of_metric(Y,d) = induced_top(top_of_metric(X,d)) Y` SUBGOAL_TAC; ASM_MESON_TAC[top_of_metric_induced]; DISCH_TAC; TYPE_THEN `top_of_metric(Y,d) Z` SUBGOAL_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[open_induced;top_of_metric_top]; DISCH_TAC; ASM_SIMP_TAC[connected_metric]; ]);; (* }}} *) let construct_hv_finite = prove_by_refinement( `!A C v v'. (top2 A) /\ (C SUBSET A) /\ (simple_arc_end C v v') ==> (?C'. C' SUBSET A /\ simple_arc_end C' v v' /\ hv_finite C')`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `A' = path_component(top_of_metric(A,d_euclid)) v` ABBREV_TAC ; TYPE_THEN `A' = component (top_of_metric(A,d_euclid)) v` SUBGOAL_TAC; EXPAND_TAC "A'"; AP_THM_TAC; IMATCH_MP_TAC loc_path_euclid_cor ; TYPE_THEN `2` EXISTS_TAC; ASM_REWRITE_TAC[GSYM top2]; DISCH_TAC; (* - *) TYPE_THEN `A SUBSET (euclid 2)` SUBGOAL_TAC; USEF `top2` (MATCH_MP sub_union ); RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN`UNIONS (top_of_metric(A,d_euclid)) = A` SUBGOAL_TAC; ASM_MESON_TAC [GSYM top_of_metric_unions;metric_euclid;metric_subspace]; DISCH_TAC; (* - *) TYPE_THEN `A' SUBSET (UNIONS (top_of_metric(A,d_euclid)))` SUBGOAL_TAC; ASM_MESON_TAC[component_unions]; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `A' SUBSET (euclid 2)` SUBGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `A` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) ASSUME_TAC loc_path_conn_top2 ; (* - *) TYPE_THEN `A v` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); UND 1; DISCH_THEN IMATCH_MP_TAC ; UND 0; MESON_TAC[simple_arc_end_end]; DISCH_TAC; (* - *) TYPE_THEN `top_of_metric(A,d_euclid) = induced_top top2 A` SUBGOAL_TAC; REWRITE_TAC[top2]; UND 5; SIMP_TAC [metric_euclid;top_of_metric_induced ]; DISCH_TAC; (* - *) TYPE_THEN `top2 A'` SUBGOAL_TAC; EXPAND_TAC "A'"; UND 11; DISCH_THEN_REWRITE; USE 9 (REWRITE_RULE[ loc_path_conn]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `~(v = v')` SUBGOAL_TAC; UND 0; ASM_MESON_TAC[simple_arc_end_distinct]; DISCH_TAC; (* A' - *) TYPE_THEN `connected (top_of_metric(A,d_euclid)) A'` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC component_imp_connected; ASM_MESON_TAC[top_of_metric_top;metric_subspace;metric_euclid]; DISCH_TAC; (* - *) TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) A'` SUBGOAL_TAC; TH_INTRO_TAC [`euclid 2`;`A`;`A'`;`d_euclid`] connected_metric_pair; ASM_MESON_TAC [metric_euclid;GSYM top2]; DISCH_THEN_REWRITE; ASM_MESON_TAC[]; REWRITE_TAC[GSYM top2]; DISCH_TAC; (* - *) TYPE_THEN `connected top2 C` SUBGOAL_TAC; IMATCH_MP_TAC simple_arc_connected; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `C SUBSET A'` SUBGOAL_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC connected_component; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\a`); CONJ_TAC; UND 0; MESON_TAC[simple_arc_end_end]; TH_INTRO_TAC[`top2`;`A`;`C`] connected_induced2; REWRITE_TAC[top2_top;top2_unions]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET_TRANS]; ASM_MESON_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `C v /\ C v'` SUBGOAL_TAC; UND 0; MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; DISCH_TAC; TYPE_THEN `A' v /\ A' v'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; DISCH_TAC; (* - *) TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_conn; ASM_REWRITE_TAC[]; DISCH_TAC; TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_hv_finite; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; REP_BASIC_TAC; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `A'` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let graph_rad_pt_center_piece = prove_by_refinement( `!G r e v v'. graph_hv_finite_radius G r /\ graph_inc G e v /\ FINITE(graph_edge G) /\ FINITE(graph_vertex G) /\ graph_edge G e /\ graph_inc G e v' /\ ~(v = v') ==> (? Cv u Cv' u' C''. (hv_finite Cv /\ hv_finite Cv' /\ (hv_finite C'') /\ ~(graph_vertex G u) /\ ~(graph_vertex G u') /\ simple_arc_end Cv v u /\ simple_arc_end Cv' v' u' /\ simple_arc_end C'' u u' /\ ~C'' v /\ ~C'' v' /\ (euclid 2 u) /\ (euclid 2 u') /\ (d_euclid v u = r) /\ (d_euclid v' u' = r) /\ (Cv SUBSET e) /\ (Cv' SUBSET e) /\ (Cv SUBSET (closed_ball(euclid 2,d_euclid) v r)) /\ (Cv' SUBSET (closed_ball(euclid 2,d_euclid) v' r)) /\ (!e'. (graph_edge G e') /\ ~(e = e') ==> (C'' INTER e' = EMPTY)) /\ (!v''. graph_vertex G v'' /\ ~(graph_inc G e v'') ==> (C'' INTER (closed_ball(euclid 2,d_euclid) v'' r) = EMPTY)) ))`, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC [`G`;`r`;`e`;`v`] graph_rad_pt_select; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `Cv = C` ABBREV_TAC ; KILL 13; TYPE_THEN `Cv` EXISTS_TAC; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; TH_INTRO_TAC [`G`;`r`;`e`;`v'`] graph_rad_pt_select; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `Cv' = C'` ABBREV_TAC ; KILL 19; TYPE_THEN `Cv'` EXISTS_TAC; TYPE_THEN `u'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* A' *) TYPE_THEN `!v''. graph_vertex G v'' ==> (euclid 2 v'')` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;SUBSET ]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `!v''. graph_inc G e v'' ==> graph_vertex G v''` SUBGOAL_TAC; REP_BASIC_TAC; TH_INTRO_TAC [`G`;`e`] graph_inc_subset; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]); ASM_REWRITE_TAC[SUBSET ]; FIRST_ASSUM MP_TAC; MESON_TAC[ISUBSET]; DISCH_TAC; (* - *) TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ; TYPE_THEN `B = (UNIONS { e' | graph_edge G e' /\ ~(e' = e)})` ABBREV_TAC ; TYPE_THEN `B' = (UNIONS { DD | ?v''. (graph_vertex G v'' /\ (DD = D v'') /\ ~(graph_inc G e v''))})` ABBREV_TAC ; TYPE_THEN `B'' = {v, v'}` ABBREV_TAC ; TYPE_THEN `A = (euclid 2 DIFF (B UNION B' UNION B''))` ABBREV_TAC ; TYPE_THEN `top2 A` SUBGOAL_TAC; TH_INTRO_TAC [`top2`;`B UNION B' UNION B''`] closed_open; IMATCH_MP_TAC closed_union; REWRITE_TAC[top2_top]; EXPAND_TAC "B"; EXPAND_TAC "B'"; EXPAND_TAC "B''"; CONJ_TAC; IMATCH_MP_TAC top_closed_unions; REWRITE_TAC[top2_top;SUBSET;]; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `graph_edge G` EXISTS_TAC ; ASM_REWRITE_TAC[SUBSET]; MESON_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]); REP_BASIC_TAC; IMATCH_MP_TAC simple_arc_end_closed; TH_INTRO_TAC [`G`;`x`] graph_edge_end_select; ASM_REWRITE_TAC[]; REP_BASIC_TAC; ASM_MESON_TAC[]; (* --- *) IMATCH_MP_TAC closed_union; REWRITE_TAC[top2_top]; CONJ_TAC; IMATCH_MP_TAC top_closed_unions; REWRITE_TAC[top2_top]; CONJ_TAC; TYPE_THEN `{DD | ?v''. graph_vertex G v'' /\ (DD = D v'') /\ ~graph_inc G e v''} = IMAGE D { v'' | graph_vertex G v'' /\ ~graph_inc G e v''}` SUBGOAL_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[]; MESON_TAC[]; DISCH_THEN_REWRITE; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `graph_vertex G` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET ]; MESON_TAC[]; REWRITE_TAC[SUBSET]; REP_BASIC_TAC; UNDF `x = D v''`; DISCH_THEN_FULL_REWRITE; EXPAND_TAC "D"; REWRITE_TAC[top2]; IMATCH_MP_TAC closed_ball_closed; REWRITE_TAC[metric_euclid]; (* --- *) TYPE_THEN `{v,v'} = {v} UNION {v'}` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[in_pair;UNION;INR IN_SING]; MESON_TAC[]; DISCH_THEN_REWRITE; IMATCH_MP_TAC closed_union; REWRITE_TAC[top2_top]; TYPE_THEN `graph_inc G e v` (FIND_ASSUM MP_TAC); TYPE_THEN `graph_inc G e v'` (FIND_ASSUM MP_TAC); ASM_MESON_TAC[closed_point]; REWRITE_TAC[open_DEF;top2_unions]; EXPAND_TAC "A"; DISCH_THEN_REWRITE; DISCH_TAC; (* B' *) TYPE_THEN `!u'' v''. graph_vertex G v'' /\ (d_euclid v'' u'' = r) ==> ~(graph_vertex G u'')` SUBGOAL_TAC; REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; TYPEL_THEN [`u''`;`v''`] (USE 31 o ISPECL); TYPE_THEN `~(u'' = v'')` SUBGOAL_TAC; DISCH_TAC; POP_ASSUM MP_TAC; DISCH_THEN_FULL_REWRITE; TYPE_THEN `d_euclid v'' v'' = &0` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_zero; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[metric_euclid]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; UNDF `&0 = r`; UNDF `&0 < r`; REAL_ARITH_TAC; DISCH_TAC; UNDF `(graph_vertex)`; ASM_REWRITE_TAC[EMPTY_EXISTS ;INTER ;closed_ball ;]; TYPE_THEN `u''` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `d_euclid u'' u'' = &0` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_zero; TYPE_THEN `euclid 2` EXISTS_TAC; ASM_REWRITE_TAC[metric_euclid]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `euclid 2 u'' ` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `euclid 2 v'' ` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; UNDF `&0 < r`; REAL_ARITH_TAC; DISCH_TAC; (* B1'- *) TYPE_THEN `~graph_vertex G u` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~graph_vertex G u'` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `v'` EXISTS_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; (* C' *) TYPE_THEN `!(X:A->bool) Y Z. (X UNION Y = Z) ==> (X SUBSET Z)` SUBGOAL_TAC; SET_TAC[UNION;SUBSET]; DISCH_TAC; (* - *) TYPE_THEN `simple_arc_end e v v'` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE [graph_hv_finite_radius;good_plane_graph]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `graph_vertex G v` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `graph_vertex G v'` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `~D v u'` SUBGOAL_TAC; EXPAND_TAC "D"; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]); REP_BASIC_TAC; GRABF `~(v = v')` (TH_INTRO_TAC [`v`;`v'`]); ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u'` EXISTS_TAC; ASM_REWRITE_TAC[INTER]; ASM_REWRITE_TAC[closed_ball]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; (* C1'- *) TYPE_THEN `~(v = u) /\ ~(v = u')` SUBGOAL_TAC; CONJ_TAC; DISCH_TAC; POP_ASSUM MP_TAC; DISCH_THEN_FULL_REWRITE; TH_INTRO_TAC[`u`] euclid2_d0; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UNDF `&0 < r`; UNDF `&0 = r`; REAL_ARITH_TAC; DISCH_TAC; POP_ASSUM MP_TAC; DISCH_THEN_FULL_REWRITE; POP_ASSUM MP_TAC; EXPAND_TAC "D"; REWRITE_TAC[closed_ball]; ASM_REWRITE_TAC[]; TH_INTRO_TAC [`u'`] euclid2_d0; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UNDF `&0 < r`; REAL_ARITH_TAC; DISCH_TAC; (* - *) TYPE_THEN `~(v' = u') ` SUBGOAL_TAC; DISCH_TAC; POP_ASSUM MP_TAC; DISCH_THEN_FULL_REWRITE; TH_INTRO_TAC[`u'`] euclid2_d0; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UNDF `&0 < r`; UNDF `&0 = r`; REAL_ARITH_TAC; DISCH_TAC; (* - *) TH_INTRO_TAC [`e`;`v`;`v'`;`u'`] simple_arc_end_cut; ASM_REWRITE_TAC[]; TYPE_THEN `Cv' u'` SUBGOAL_TAC; TYPE_THEN `simple_arc_end Cv' v' u'` (FIND_ASSUM MP_TAC ); MESON_TAC[simple_arc_end_end2]; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `Cvu' = C''` ABBREV_TAC ; POP_ASSUM (fun t-> ALL_TAC); TYPE_THEN `Cu'v' = C'''` ABBREV_TAC ; POP_ASSUM (fun t -> ALL_TAC); TYPE_THEN `Cu'v' v'` SUBGOAL_TAC; TYPE_THEN `simple_arc_end Cu'v' u' v'` (FIND_ASSUM MP_TAC ); MESON_TAC[simple_arc_end_end2]; DISCH_TAC; TYPE_THEN `~Cvu' v'` SUBGOAL_TAC; DISCH_TAC; USEF `(INTER)` (REWRITE_RULE[FUN_EQ_THM]); TSPEC `v'` 37; RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing ;INR IN_SING]); UND 37; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `~D v' u` SUBGOAL_TAC; EXPAND_TAC "D"; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]); REP_BASIC_TAC; GRABF `~(v' = v)` (TH_INTRO_TAC [`v'`;`v`]); ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[INTER]; ASM_REWRITE_TAC[closed_ball]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; (* D'- *) TYPE_THEN `Cvu' u \/ Cu'v' u` SUBGOAL_TAC; USE 35 (REWRITE_RULE[FUN_EQ_THM;]); TSPEC `u` 35 ; USE 35 (REWRITE_RULE[UNION]); ASM_REWRITE_TAC[]; USE 8(REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; UND 11; MESON_TAC[simple_arc_end_end2]; DISCH_TAC; (* - *) USE 35 (MATCH_MP union_imp_subset); TYPE_THEN `Cu'v' = Cv'` SUBGOAL_TAC; TH_INTRO_TAC [`Cu'v'`;`Cv'`;`e`;`v'`;`u'`] simple_arc_end_inj; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; DISCH_THEN_FULL_REWRITE; (* - *) TYPE_THEN `~Cv' u` SUBGOAL_TAC; DISCH_TAC; UNDF `~D v' u` ; REWRITE_TAC[]; EXPAND_TAC "D"; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; REWR 45; (* - *) TYPE_THEN `~(u = u')` SUBGOAL_TAC; DISCH_TAC; UND 47; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; GRABF `~(v=v')` (TH_INTRO_TAC[`v`;`v'`]); ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u'` EXISTS_TAC; REWRITE_TAC[INTER;closed_ball]; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `r <= r`]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TH_INTRO_TAC[`Cvu'`;`v`;`u'`;`u`] simple_arc_end_cut; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `CC = C'''''` ABBREV_TAC ; POP_ASSUM (fun t->ALL_TAC); (* E' *) TYPE_THEN `~CC v` SUBGOAL_TAC; DISCH_TAC; TYPE_THEN `C'''' v` SUBGOAL_TAC; UND 50; MESON_TAC[simple_arc_end_end]; DISCH_TAC; TYPE_THEN `v = u` SUBGOAL_TAC; UND 48; REWRITE_TAC[INTER;eq_sing;INR IN_SING]; REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_THEN_FULL_REWRITE; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `~CC v'` SUBGOAL_TAC; DISCH_TAC; USE 35 (MATCH_MP union_imp_subset); UND 43; REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `CC SUBSET A` SUBGOAL_TAC; EXPAND_TAC "A"; REWRITE_TAC[DIFF_SUBSET]; CONJ_TAC; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; UND 49; MESON_TAC[]; PROOF_BY_CONTR_TAC; USE 55 (MATCH_MP inter_union); FIRST_ASSUM MP_TAC; REWRITE_TAC[]; REWRITE_TAC[DE_MORGAN_THM]; TYPE_THEN `CC SUBSET e` SUBGOAL_TAC; USE 35 (MATCH_MP union_imp_subset); IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Cvu'` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_TAC; (* -- *) CONJ_TAC; EXPAND_TAC"B"; REWRITE_TAC[INTER;UNIONS;EQ_EMPTY ]; REP_BASIC_TAC; TYPE_THEN `e x` SUBGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); REP_BASIC_TAC ; (* we are up to 69 in the hypothesis stack *) TYPEL_THEN [`e`;`u''`] (USE 66 o ISPECL); REWR 66; TYPE_THEN `graph_vertex G x` SUBGOAL_TAC; USE 66 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[INTER]; ASM_REWRITE_TAC[]; DISCH_TAC; (* --- *) TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; IMATCH_MP_TAC graph_edge2; ASM_REWRITE_TAC[]; TYPE_THEN `graph_inc G e x` SUBGOAL_TAC; ASM_SIMP_TAC[]; ASM_REWRITE_TAC[INTER]; REP_BASIC_TAC; TH_INTRO_TAC [`graph_inc G e`;`v`;`x`;`v'`] two_exclusion; ASM_REWRITE_TAC[]; UND 60; UND 54; MESON_TAC[]; UND 60; UND 53; MESON_TAC[]; (* -- *) PROOF_BY_CONTR_TAC; USE 57 (MATCH_MP inter_union); UND 57; REWRITE_TAC[DE_MORGAN_THM]; CONJ_TAC; EXPAND_TAC "B'"; REWRITE_TAC[INTER;UNIONS;]; REWRITE_TAC [EQ_EMPTY]; REP_BASIC_TAC; UNDF `u''' = D v''` ; DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; TYPEL_THEN [`e`;`v''`] (USE 59 o ISPECL); REWR 59; UND 59; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `x` EXISTS_TAC; REWRITE_TAC[INTER]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 57; EXPAND_TAC "D"; DISCH_THEN_REWRITE; (* -- *) EXPAND_TAC "B''"; REWRITE_TAC[INTER;EQ_EMPTY;in_pair]; ASM_MESON_TAC[]; DISCH_TAC; (* F' *) TH_INTRO_TAC[`A`;`CC`;`u`;`u'`] construct_hv_finite; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `Chv = C''''''` ABBREV_TAC ; KILL 59; TYPE_THEN `Chv` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~(A v) /\ ~(A v')` SUBGOAL_TAC; EXPAND_TAC "A"; EXPAND_TAC "B''"; REWRITE_TAC[DIFF;UNION;in_pair]; DISCH_TAC; TYPE_THEN `~(Chv v) /\ ~(Chv v')` SUBGOAL_TAC; UND 59; UND 58; MESON_TAC[ISUBSET]; DISCH_THEN_REWRITE; (* - *) TYPE_THEN `(!e'. ~(e = e') /\ (graph_edge G e') ==> (A INTER e' = {}))` SUBGOAL_TAC; EXPAND_TAC "A"; EXPAND_TAC "B"; REP_BASIC_TAC; REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS ]; REP_BASIC_TAC; LEFT 64 "u"; LEFT 64 "u"; TSPEC `e'` 64; UND 64; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) CONJ_TAC; REP_BASIC_TAC; TSPEC `e'` 60; REWR 60; UND 60; UND 58; REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;]; MESON_TAC[]; (* - *) TYPE_THEN `!v''. graph_vertex G v'' /\ ~graph_inc G e v'' ==> (A INTER closed_ball (euclid 2,d_euclid) v'' r = {})` SUBGOAL_TAC; REP_BASIC_TAC; EXPAND_TAC "A"; EXPAND_TAC "B'"; REP_BASIC_TAC; REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS;]; EXPAND_TAC "D"; REP_BASIC_TAC; UND 65; REWRITE_TAC[]; DISJ2_TAC; DISJ1_TAC; CONV_TAC (dropq_conv "u"); TYPE_THEN `v''` EXISTS_TAC; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TSPEC `v''` 62; REWR 62; UND 62; UND 58; REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;]; MESON_TAC[]; (* Wed Aug 25 14:58:37 EDT 2004 *) ]);; (* }}} *) let planar_graph_hv = prove_by_refinement( `!(G:(A,B)graph_t). (planar_graph G) /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = {}) /\ (!v. CARD (graph_edge_around G v) <=| 4) ==> (?H. graph_isomorphic G H /\ good_plane_graph H /\ (!e. graph_edge H e ==> hv_finite e))`, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC[`G`] graph_radius_exists; ASM_REWRITE_TAC[]; REP_BASIC_TAC; (* - *) TYPE_THEN `X = { K | graph_isomorphic H K /\ graph_hv_finite_radius K r}` ABBREV_TAC ; TYPE_THEN `c = (\ (K:(num->real,(num->real)->bool)graph_t). CARD {x | graph_edge K x /\ ~hv_finite x})` ABBREV_TAC ; TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ; TH_INTRO_TAC[`X`;`c`] select_image_num_min; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `H` EXISTS_TAC; EXPAND_TAC "X"; REWRITE_TAC[]; ASM_REWRITE_TAC[graph_isomorphic_refl]; REP_BASIC_TAC; TYPE_THEN `K = z` ABBREV_TAC ; KILL 12; TYPE_THEN `K` EXISTS_TAC; CONJ_TAC; UND 11; EXPAND_TAC "X"; REWRITE_TAC[]; ASM_MESON_TAC[graph_isomorphic_trans]; (* - *) TYPE_THEN `graph_hv_finite_radius K r` SUBGOAL_TAC; UND 11; EXPAND_TAC "X"; REWRITE_TAC[]; DISCH_THEN_REWRITE; DISCH_TAC; (* - *) CONJ_TAC; UND 12; REWRITE_TAC[graph_hv_finite_radius]; DISCH_THEN_REWRITE; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; (* - *) TH_INTRO_TAC[`K`;`e`] graph_edge_end_select; ASM_REWRITE_TAC[]; UND 12; REWRITE_TAC[graph_hv_finite_radius;good_plane_graph;plane_graph]; DISCH_THEN_REWRITE; REP_BASIC_TAC; (* A *) TYPE_THEN `graph_isomorphic G K` SUBGOAL_TAC; TH_INTRO_TAC[`G`;`H`;`K`] graph_isomorphic_trans; ASM_REWRITE_TAC[]; UND 11; EXPAND_TAC "X"; REWRITE_TAC[]; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; DISCH_TAC; (* - *) TYPE_THEN `FINITE (graph_edge K)` SUBGOAL_TAC; USE 18(REWRITE_RULE[graph_isomorphic;graph_iso]); REP_BASIC_TAC; UND 19; UND 3; MESON_TAC[FINITE_BIJ]; DISCH_TAC; (* - *) TYPE_THEN `~(? e' . (~graph_edge K e') /\ hv_finite e' /\ simple_arc_end e' v v' /\ (e INTER (graph_vertex K) = (e' INTER (graph_vertex K))) /\ (!v. graph_vertex K v /\ ~e' v ==> (e' INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ (!e''. graph_edge K e'' /\ ~(e'' = e) ==> e' INTER e'' SUBSET e INTER e''))` SUBGOAL_TAC; DISCH_TAC; REP_BASIC_TAC; (* -- *) TH_INTRO_TAC[`K`;`e`;`e'`] graph_replace_card; ASM_REWRITE_TAC[]; TYPE_THEN `K' = graph_replace K e e'` ABBREV_TAC ; DISCH_TAC; TYPE_THEN `graph_isomorphic H K'` SUBGOAL_TAC; EXPAND_TAC "X"; EXPAND_TAC "K'"; REWRITE_TAC[]; TH_INTRO_TAC[`H`;`K`;`K'`] graph_isomorphic_trans; ASM_REWRITE_TAC[]; UND 11; EXPAND_TAC "X"; REWRITE_TAC[]; DISCH_THEN_REWRITE; EXPAND_TAC "K'"; IMATCH_MP_TAC graph_replace_iso; ASM_REWRITE_TAC[]; EXPAND_TAC "K'"; DISCH_THEN_REWRITE; DISCH_TAC; (* -- *) TYPE_THEN `plane_graph K'` SUBGOAL_TAC; EXPAND_TAC "K'"; IMATCH_MP_TAC graph_replace_plane; ASM_REWRITE_TAC[]; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `good_plane_graph K'` SUBGOAL_TAC; EXPAND_TAC "K'"; IMATCH_MP_TAC good_replace; ASM_REWRITE_TAC[]; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `e v'' /\ e v'''` SUBGOAL_TAC; USE 22 (REWRITE_RULE[FUN_EQ_THM]); TYPE_THEN `v''` (WITH 22 o ISPEC); TYPE_THEN `v'''` (USE 22 o ISPEC); RULE_ASSUM_TAC (REWRITE_RULE[INTER]); UND 22; UND 35; UND 33; UND 34; DISCH_THEN_REWRITE; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; MESON_TAC[]; REP_BASIC_TAC; TYPE_THEN `graph_inc K e = {v,v'}` SUBGOAL_TAC; IMATCH_MP_TAC graph_vertex_exhaust; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `graph_inc K e = {v'',v'''}` SUBGOAL_TAC; IMATCH_MP_TAC graph_vertex_exhaust; USE 37 (SYM); ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); REP_BASIC_TAC; ASM_REWRITE_TAC[]; TSPEC `e` 46; REWR 46; ASM_REWRITE_TAC[INTER]; DISCH_THEN_FULL_REWRITE; TYPE_THEN `((v'' = v) /\ (v''' = v')) \/ ((v'' = v') /\ (v''' = v))` SUBGOAL_TAC; USE 37 (REWRITE_RULE[FUN_EQ_THM]); TYPE_THEN `v''` (WITH 37 o ISPEC); TYPE_THEN `v'''` (USE 37 o ISPEC); UND 37; UND 38; REWRITE_TAC[in_pair]; UND 32; UND 15; MESON_TAC[]; DISCH_THEN DISJ_CASES_TAC; REP_BASIC_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; DISCH_TAC; (* -- *) TYPE_THEN `graph_hv_finite_radius K' r` SUBGOAL_TAC; EXPAND_TAC "K'"; IMATCH_MP_TAC graph_replace_hv_finite_radius; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `X K'` SUBGOAL_TAC; EXPAND_TAC "X"; ASM_REWRITE_TAC[]; DISCH_TAC; TSPEC `K'` 10; REWR 10; UND 10; EXPAND_TAC "c"; UND 27; (**** Changed by JRH; the new ARITH_TAC doesn't accept alpha-equivs (maybe) ARITH_TAC; ****) REWRITE_TAC[NOT_IMP; NOT_LE]; REWRITE_TAC[]; (* B *) TH_INTRO_TAC [`K`;`r`;`e`;`v`;`v'`] graph_rad_pt_center_piece; ASM_REWRITE_TAC[]; USE 18 (REWRITE_RULE[graph_isomorphic;graph_iso]); REP_BASIC_TAC; UND 21; UND 2; MESON_TAC[FINITE_BIJ]; REP_BASIC_TAC; KILL 4; KILL 3; KILL 2; KILL 1; KILL 0; KILL 6; KILL 5; KILL 7; KILL 8; KILL 11; KILL 10; KILL 18; KILL 19; TYPE_THEN `graph_inc K e = {v,v'}` SUBGOAL_TAC; IMATCH_MP_TAC graph_vertex_exhaust; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `e INTER graph_vertex K = {v,v'}` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); REP_BASIC_TAC; TSPEC `e` 7; REWR 7; ASM_REWRITE_TAC[]; DISCH_THEN_REWRITE; (* C- *) TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC; REP_BASIC_TAC; TH_INTRO_TAC[`K`;`e'`] graph_inc_subset; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `p_conn (Cv UNION Cv' UNION C'') v v'` SUBGOAL_TAC; IMATCH_MP_TAC pconn_trans; TYPE_THEN `u` EXISTS_TAC; CONJ_TAC; TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`u`] p_conn_hv_finite; IMATCH_MP_TAC simple_arc_end_distinct; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `Cv` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; IMATCH_MP_TAC pconn_trans; TYPE_THEN `u'` EXISTS_TAC; CONJ_TAC; TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u`;`u'`] p_conn_hv_finite; IMATCH_MP_TAC simple_arc_end_distinct; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `C''` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u'`;`v'`] p_conn_hv_finite; IMATCH_MP_TAC simple_arc_end_distinct; TYPE_THEN `Cv'` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_MESON_TAC[]; DISCH_THEN_REWRITE; TYPE_THEN `Cv'` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`v'`] p_conn_hv_finite; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REP_BASIC_TAC; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; (* D final constraints *) TYPE_THEN`graph K` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC; REP_BASIC_TAC; TH_INTRO_TAC[`K`;`e'`]graph_inc_subset; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET]; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; (* - *) CONJ_TAC; DISCH_TAC; TYPE_THEN `C = e` ASM_CASES_TAC; ASM_MESON_TAC[]; TSPEC `C` 21; REWR 11; TYPE_THEN `C SUBSET Cv UNION Cv'` SUBGOAL_TAC; UND 11; UND 4; REWRITE_TAC[SUBSET;UNION;EQ_EMPTY;INTER ]; MESON_TAC[]; DISCH_TAC; TYPE_THEN `D v INTER D v' = EMPTY ` SUBGOAL_TAC; EXPAND_TAC "D"; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UND 21; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; DISCH_TAC; (* -- *) UND 10; REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `v'` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL]; SUBCONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]); REP_BASIC_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISCH_TAC; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Cv UNION Cv'` EXISTS_TAC; ASM_REWRITE_TAC[union_subset ]; (* E *) CONJ_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[in_pair;INTER ]; GEN_TAC; EQ_TAC; DISCH_THEN DISJ_CASES_TAC; UND 8; DISCH_THEN_FULL_REWRITE; CONJ_TAC; UND 3; MESON_TAC[simple_arc_end_end2]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; UND 8; DISCH_THEN_FULL_REWRITE; CONJ_TAC; UND 3; MESON_TAC[simple_arc_end_end]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `graph_inc K e x` ASM_CASES_TAC; REWR 8; RULE_ASSUM_TAC (REWRITE_RULE[in_pair]); ASM_REWRITE_TAC[]; USE 4 (REWRITE_RULE[SUBSET ]); REP_BASIC_TAC; TSPEC `x` 4; REWR 4; USE 4(REWRITE_RULE[UNION]); UND 4; REP_CASES_TAC; DISJ2_TAC; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UND 40; DISCH_THEN (TH_INTRO_TAC[`v`;`x`]); ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `x` EXISTS_TAC; REWRITE_TAC[INTER]; CONJ_TAC; UND 4; UND 23; REWRITE_TAC[SUBSET]; MESON_TAC[]; REWRITE_TAC[closed_ball2_center]; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); REP_BASIC_TAC; CONJ_TAC; USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UNDF `&0 < r`; REAL_ARITH_TAC; (* --- *) DISJ1_TAC; PROOF_BY_CONTR_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UNDF `~(v = v')`; DISCH_THEN (TH_INTRO_TAC[`v'`;`x`]); ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `x` EXISTS_TAC; REWRITE_TAC[INTER]; CONJ_TAC; UND 4; UND 22; REWRITE_TAC[SUBSET]; MESON_TAC[]; REWRITE_TAC[closed_ball2_center]; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); REP_BASIC_TAC; CONJ_TAC; USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UNDF `&0 < r`; REAL_ARITH_TAC; (* -- *) TYPE_THEN `graph_inc K e x` ASM_CASES_TAC; REWR 18; TSPEC `x` 20; REWR 19; PROOF_BY_CONTR_TAC; UND 19; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[INTER;closed_ball2_center]; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); REP_BASIC_TAC; USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]); CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UNDF `&0 < r`; REAL_ARITH_TAC; (* F *) KILL 14; KILL 39; KILL 38; KILL 37; KILL 36; KILL 35; KILL 34; KILL 33; KILL 32; KILL 29; KILL 28; KILL 27; KILL 26; KILL 5; KILL 2; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; REP_BASIC_TAC; REWRITE_TAC[SUBSET;INTER]; REP_BASIC_TAC; USEF `(SUBSET)` (REWRITE_RULE[SUBSET]); TSPEC `x` 4; REWR 4; UND 4; REWRITE_TAC[UNION]; REP_CASES_TAC; ASM_MESON_TAC[ISUBSET]; ASM_MESON_TAC[ISUBSET]; PROOF_BY_CONTR_TAC; UND 21; DISCH_THEN (TH_INTRO_TAC[`e''`]); ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[INTER]; (* G *) REP_BASIC_TAC; TYPE_THEN `graph_inc K e v''` ASM_CASES_TAC; REWR 8; UND 8; REWRITE_TAC[in_pair]; REP_CASES_TAC; UND 8; DISCH_THEN_FULL_REWRITE; PROOF_BY_CONTR_TAC; UND 2; UND 3; MESON_TAC[simple_arc_end_end2]; UND 8; DISCH_THEN_FULL_REWRITE; PROOF_BY_CONTR_TAC; UND 2; UND 3; MESON_TAC[simple_arc_end_end]; (* - *) TYPE_THEN `C SUBSET D v UNION D v' UNION C''` SUBGOAL_TAC; EXPAND_TAC "D"; UND 4; UND 22; UND 23; REWRITE_TAC[SUBSET;UNION]; MESON_TAC[]; REWRITE_TAC[SUBSET]; DISCH_TAC; PROOF_BY_CONTR_TAC; USE 11 (REWRITE_RULE[EMPTY_EXISTS;INTER]); REP_BASIC_TAC; TSPEC `u` 10; REWR 10; USE 10 (REWRITE_RULE[UNION]); UND 10; REP_CASES_TAC ; (* -- *) UND 8; ASM_REWRITE_TAC[in_pair]; PROOF_BY_CONTR_TAC; USE 8 (REWRITE_RULE[DE_MORGAN_THM]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UND 26; DISCH_THEN (TH_INTRO_TAC[`v`;`v''`]); ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; UND 10; EXPAND_TAC "D"; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; (* -- *) UND 8; ASM_REWRITE_TAC[in_pair]; PROOF_BY_CONTR_TAC; USE 8 (REWRITE_RULE[DE_MORGAN_THM]); REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); REP_BASIC_TAC; UND 26; DISCH_THEN (TH_INTRO_TAC[`v'`;`v''`]); ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; UND 10; EXPAND_TAC "D"; DISCH_THEN_REWRITE; ASM_REWRITE_TAC[]; (* - *) UND 20; DISCH_THEN (TH_INTRO_TAC[`v''`]); ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS;INTER]; ASM_MESON_TAC[]; (* Thu Aug 26 08:46:13 EDT 2004 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION P *) (* ------------------------------------------------------------------ *) let (UNDISCHQ_TAC:(term->bool) -> tactic) = fun cond (asl,w) -> let cond' x = try (cond x) with failure -> false in let asl' = (fst(partition cond' (map (concl o snd) asl))) in EVERY (map (TRY o UNDISCH_TAC ) asl') (asl,w);; let UNABBREV_TAC tm = FIRST[ UNDISCHQ_TAC ( ((=) tm o rhs)) THEN (DISCH_THEN (MP_TAC o SYM)) ; UNDISCHQ_TAC ( ((=) tm o lhs)) ] THEN DISCH_THEN_FULL_REWRITE;; let set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net = let rewrites = ref (basic_rewrites()) and conv_net = ref (basic_net()) in let set_simp_rewrites thl = let canon_thl = itlist (mk_rewrites false) thl ([]:thm list) in (rewrites := canon_thl; conv_net := itlist (net_of_thm true) canon_thl empty_net) in let extend_simp_rewrites thl = (* is false in simp.ml . Important change. *) let canon_thl = itlist (mk_rewrites true) thl ([]:thm list) in (rewrites := canon_thl @ !rewrites; conv_net := itlist (net_of_thm true) canon_thl (!conv_net)) in let simp_rewrites() = !rewrites in let simp_net() = !conv_net in set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net;; let simp_ss = let rewmaker = mk_rewrites true in fun thl -> let cthms = itlist rewmaker thl ([]:thm list) in let net' = itlist (net_of_thm true) cthms (simp_net()) in let net'' = itlist net_of_cong (basic_congs()) net' in Simpset(net'',basic_prover,([]:prover list),rewmaker);; let RSIMP_CONV thl = ONCE_SIMPLIFY_CONV (simp_ss ([]:thm list)) thl;; let (RSIMP_TAC:thm list -> tactic) = fun (thl:thm list) -> CONV_TAC(RSIMP_CONV thl);; let ASM_RSIMP_TAC = ASM RSIMP_TAC;; EVERY_STEP_TAC := (RSIMP_TAC[]) THEN REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN (ASM_RSIMP_TAC[]) THEN (REWRITE_TAC[]) ;; let SUBAGOAL_TAC t = SUBGOAL_THEN t ASSUME_TAC;; (* EVERY_STEP_TAC := ALL_TAC *) let subset_imp = prove_by_refinement( `!A B (x:A). A x /\ A SUBSET B ==> B x`, (* {{{ proof *) [ ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) (* extend_simp_rewrites[subset_imp] *) (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) let plane_graph_image = jordan_def `plane_graph_image (f:(num->real)->(num->real)) G = mk_graph_t (IMAGE f (graph_vertex G), IMAGE2 f (graph_edge G), ( \ e v. (?e' v'. (graph_edge G e') /\ (IMAGE f e' = e) /\ (f v' = v) /\ (graph_inc G e' v'))))`;; let plane_graph_image_e = prove_by_refinement( `!f G. (graph_edge (plane_graph_image f G)) = IMAGE2 f (graph_edge G)`, (* {{{ proof *) [ REWRITE_TAC[plane_graph_image;graph_edge;part1;drop0;dest_graph_t]; (* Thu Aug 26 10:16:26 EDT 2004 *) ]);; (* }}} *) let plane_graph_image_v = prove_by_refinement( `!f G. (graph_vertex (plane_graph_image f G)) = IMAGE f (graph_vertex G)`, (* {{{ proof *) [ REWRITE_TAC[plane_graph_image;dest_graph_t;graph_vertex;]; (* Thu Aug 26 10:17:56 EDT 2004 *) ]);; (* }}} *) let plane_graph_image_i = prove_by_refinement( `!f G. (graph_inc (plane_graph_image f G)) = ( \ e v. (?e' v'. (graph_edge G e') /\ (IMAGE f e' = e) /\ (f v' = v) /\ (graph_inc G e' v')))`, (* {{{ proof *) [ REWRITE_TAC[plane_graph_image ;graph_inc;dest_graph_t;drop1]; (* Thu Aug 26 10:20:07 EDT 2004 *) ]);; (* }}} *) let plane_graph_image_bij = prove_by_refinement( `!f G. homeomorphism f top2 top2 /\ plane_graph G ==> BIJ f (graph_vertex G) (IMAGE f (graph_vertex G)) /\ BIJ (IMAGE f) (graph_edge G) (IMAGE2 f (graph_edge G))`, (* {{{ proof *) [ ALL_TAC ; (* - *) RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]); TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; (* - *) CONJ_TAC; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[subset_imp]; (* - *) USE 3 (MATCH_MP image_powerset); REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; (* ASM_MESON_TAC[ISUBSET]; *) ]);; (* }}} *) let plane_graph_image_iso = prove_by_refinement( `!f G. (homeomorphism f top2 top2 /\ plane_graph G ==> graph_isomorphic G (plane_graph_image f G))`, (* {{{ proof *) [ ALL_TAC; REWRITE_TAC[graph_isomorphic;graph_iso;]; LEFT_TAC "u"; TYPE_THEN `f` EXISTS_TAC; LEFT_TAC "v"; TYPE_THEN `IMAGE f` EXISTS_TAC; TYPE_THEN `f,IMAGE f` EXISTS_TAC; REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]; (* - *) RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]); TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); (* - *) TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; (* - *) CONJ_TAC; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[ISUBSET]; (* - *) SUBCONJ_TAC; USE 3 (MATCH_MP image_powerset); REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; (* A- *) REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; EQ_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `e' = e` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2;BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* ---- *) TYPE_THEN `e'` UNABBREV_TAC ; REWRITE_TAC[IMAGE]; USE 5 GSYM; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) USE 8(REWRITE_RULE[IMAGE]); UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* Thu Aug 26 10:49:22 EDT 2004 *) ]);; (* }}} *) extend_simp_rewrites [(REAL_ARITH `&0 < &1`)];; extend_simp_rewrites [prove_by_refinement( `metric_space(euclid 2,d_euclid)`, (* {{{ proof *) [ ASM_MESON_TAC[metric_euclid]; ])];; (* }}} *) extend_simp_rewrites [prove_by_refinement( `!G. plane_graph G ==> graph_vertex G SUBSET (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[plane_graph]; ])];; (* }}} *) let simple_arc_end_cont = prove_by_refinement( `!C v v'. simple_arc_end C v v' <=> (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\ continuous f (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (f (&0) = v) /\ (f (&1) = v'))`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; EQ_TAC; TH_INTRO_TAC [`&0`;`&1`;`f`;`euclid 2`;`d_euclid`] cont_extend_real_lemma; CONJ_TAC; ASM_REWRITE_TAC[GSYM top2]; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `g` EXISTS_TAC; CONJ_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; EQ_TAC; UNIFY_EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UNIFY_EXISTS_TAC; ASM_MESON_TAC[]; (* -- *) ASM_REWRITE_TAC[top2]; CONJ_TAC; REWRITE_TAC[INJ]; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); ASM_MESON_TAC[]; ASM_MESON_TAC[REAL_ARITH `x <=. x `;REAL_ARITH `&0 <=. &1`]; (* - *) UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC continuous_interval; (* Thu Aug 26 12:57:09 EDT 2004 *) ]);; (* }}} *) let graph_edge_euclid = prove_by_refinement( `!G e. (plane_graph G /\ graph_edge G e) ==> (e SUBSET (euclid 2))`, (* {{{ proof *) [ ALL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; ]);; (* }}} *) let plane_graph_image_plane = prove_by_refinement( `!f G. (homeomorphism f top2 top2 /\ good_plane_graph G ==> good_plane_graph(plane_graph_image f G))`, (* {{{ proof *) [ REWRITE_TAC[good_plane_graph]; TH_INTRO_TAC[`G`;`plane_graph_image f G`] graph_isomorphic_graph; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC plane_graph_image_iso; ASM_REWRITE_TAC[plane_graph]; (* - *) TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; (* - *) TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC; IMATCH_MP_TAC graph_edge_euclid; UNIFY_EXISTS_TAC; (* - *) TH_INTRO_TAC[`f`;`G`] plane_graph_image_bij; (* A- *) ASM_REWRITE_TAC[plane_graph;GSYM CONJ_ASSOC;]; TYPE_THEN `(!e v v'. graph_edge (plane_graph_image f G) e /\ ~(v = v') /\ graph_inc (plane_graph_image f G) e v /\ graph_inc (plane_graph_image f G) e v' ==> simple_arc_end e v v')` SUBGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]); TYPE_THEN `v` UNABBREV_TAC; TYPE_THEN `v'` UNABBREV_TAC; TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `e' = e''` SUBGOAL_TAC ; USE 6 (REWRITE_RULE[BIJ;INJ;IMAGE2]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `e''` UNABBREV_TAC; UND 0 THEN (DISCH_THEN (TH_INTRO_TAC [`e'`;`v'''`;`v''`])); DISCH_TAC; TYPE_THEN `v'''` UNABBREV_TAC; USE 0 (REWRITE_RULE[simple_arc_end_cont]); REWRITE_TAC[simple_arc_end_cont]; TYPE_THEN `f o f'` EXISTS_TAC; REWRITE_TAC[IMAGE_o]; (* -- *) CONJ_TAC; IMATCH_MP_TAC continuous_comp; TYPE_THEN `top2` EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); ASM_REWRITE_TAC[top2_unions]; TYPE_THEN `UNIONS (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; TH_INTRO_TAC[`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_unions; TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV ` SUBAGOAL_TAC; alpha_tac; IMATCH_MP_TAC metric_subspace; UNIFY_EXISTS_TAC; REWRITE_TAC [metric_real;]; UND 21 THEN DISCH_THEN (fun t->ONCE_REWRITE_TAC[GSYM t]); REWRITE_TAC[]; USE 15 (REWRITE_RULE[INJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; (* -- *) CONJ_TAC; REWRITE_TAC[comp_comp]; IMATCH_MP_TAC COMP_INJ; UNIFY_EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]); REWRITE_TAC[o_DEF]; (* B- *) ASM_REWRITE_TAC[]; TYPE_THEN `graph_edge (plane_graph_image f G) SUBSET simple_arc top2` SUBGOAL_TAC; REWRITE_TAC[SUBSET]; TH_INTRO_TAC[`plane_graph_image f G`;`x`] graph_edge_end_select; UND 8 THEN DISCH_THEN (TH_INTRO_TAC[`x`;`v`;`v'`]); IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; KILL 8; (* - *) CONJ_TAC; MP_TAC plane_graph_image_v THEN DISCH_THEN_FULL_REWRITE; RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;INJ;]); USE 16 (REWRITE_RULE[top2_unions]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; (* - *) CONJ_TAC; (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t )) [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]; IMATCH_MP_TAC EQ_EXT; EQ_TAC; TYPE_THEN `x` UNABBREV_TAC ; TYPE_THEN `e` UNABBREV_TAC; REWRITE_TAC[INTER]; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); TSPEC `e'` 11; REWR 10; USE 10 (REWRITE_RULE[INTER]); REWRITE_TAC[IMAGE]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE]; TYPE_THEN `v'` EXISTS_TAC; TH_INTRO_TAC [`G`;`e'`] graph_inc_subset; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; USE 8 (REWRITE_RULE[IMAGE2]); TYPE_THEN `FF = IMAGE f` ABBREV_TAC ; USE 8 (REWRITE_RULE[IMAGE]); TYPE_THEN `x'` EXISTS_TAC; USE 10 (REWRITE_RULE[INTER]); TYPE_THEN `FF` UNABBREV_TAC; USE 10 (REWRITE_RULE[IMAGE]); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `x''` EXISTS_TAC; TYPE_THEN `e` UNABBREV_TAC; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); REWRITE_TAC[INTER]; USE 13 (REWRITE_RULE[IMAGE]); TYPE_THEN `x'' =x` SUBAGOAL_TAC; USE 2(REWRITE_RULE[homeomorphism;BIJ;INJ;top2_unions]); FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; TSPEC `x'` 5; IMATCH_MP_TAC subset_imp; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* C- *) (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t )) [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]; USE 10 (REWRITE_RULE[IMAGE2]); USE 11 (REWRITE_RULE[IMAGE2]); TYPE_THEN `FF = IMAGE f` ABBREV_TAC ; USE 10 (REWRITE_RULE[IMAGE]); USE 11 (REWRITE_RULE[IMAGE]); TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `e'` UNABBREV_TAC; TH_INTRO_TAC [`f`;`euclid 2`;`euclid 2`;`x'`;`x`] (GSYM inj_inter); RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]); TYPE_THEN `FF` UNABBREV_TAC; IMATCH_MP_TAC IMAGE_SUBSET; RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); TYPEL_THEN [`x'`;`x`] (fun t-> UND 1 THEN DISCH_THEN (TH_INTRO_TAC t)); DISCH_TAC; TYPE_THEN `x'` UNABBREV_TAC; ]);; (* }}} *) (* state MP *) let h_compat = jordan_def `h_compat f <=> !x y. (SND x = SND y) ==> (IMAGE f (mk_line (point x) (point y)) = mk_line (f (point x)) (f (point y)))`;; let v_compat = jordan_def `v_compat f <=> !x y. (FST x = FST y) ==> (IMAGE f (mk_line (point x) (point y)) = mk_line (f (point x)) (f (point y)))`;; let h_translate = jordan_def `h_translate r p = p + r *# e1`;; let v_translate = jordan_def `v_translate r p = p + r *# e2`;; let r_scale = jordan_def `r_scale r p = if ( &.0 < p 0) then (point (r * p 0, p 1)) else p`;; let u_scale = jordan_def `u_scale r p = if ( &.0 < p 1) then (point ( p 0, r * p 1)) else p`;; let cont_domain = prove_by_refinement( `!(f:A->B) g U V. (continuous f U V) /\ (!x. UNIONS U x ==> (f x = g x)) ==> (continuous g U V)`, (* {{{ proof *) [ REWRITE_TAC[preimage;continuous;]; TYPE_THEN `{x | UNIONS U x /\ v (g x)} = {x | UNIONS U x /\ v (f x)}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; IMATCH_MP_TAC (TAUT `(A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`); FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let h_translate_bij = prove_by_refinement( `!r. BIJ (h_translate r) (euclid 2) (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;INJ;h_translate]; SUBCONJ_TAC; CONJ_TAC; ASM_SIMP_TAC[euclid_add_closure;e1;point_scale;euclid_point]; RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e1]); IMATCH_MP_TAC EQ_EXT; USE 0 (REWRITE_RULE[FUN_EQ_THM]); TSPEC `x'` 0; UND 0 THEN REAL_ARITH_TAC; REWRITE_TAC[SURJ;h_translate]; REP_BASIC_TAC; TYPE_THEN `x - (r *# e1)` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[point_scale;e1]; ASM_SIMP_TAC[euclid_sub_closure;euclid_point]; REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale]; IMATCH_MP_TAC EQ_EXT; REAL_ARITH_TAC; (* Tue Sep 7 10:15:46 EDT 2004 *) ]);; (* }}} *) let v_translate_bij = prove_by_refinement( `!r. BIJ (v_translate r) (euclid 2) (euclid 2)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;INJ;v_translate]; SUBCONJ_TAC; CONJ_TAC; ASM_SIMP_TAC[euclid_add_closure;e2;point_scale;euclid_point]; RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e2]); IMATCH_MP_TAC EQ_EXT; USE 0 (REWRITE_RULE[FUN_EQ_THM]); TSPEC `x'` 0; UND 0 THEN REAL_ARITH_TAC; REWRITE_TAC[SURJ;v_translate]; REP_BASIC_TAC; TYPE_THEN `x - (r *# e2)` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[point_scale;e2]; ASM_SIMP_TAC[euclid_sub_closure;euclid_point]; REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale]; IMATCH_MP_TAC EQ_EXT; REAL_ARITH_TAC; (* Tue Sep 7 10:16:38 EDT 2004 *) ]);; (* }}} *) extend_simp_rewrites [euclid_point];; extend_simp_rewrites [coord01];; let r_scale_bij = prove_by_refinement( `!r. (&0 < r) ==> BIJ (r_scale r) (euclid 2) (euclid 2)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[BIJ;INJ;r_scale;]; SUBCONJ_TAC; CONJ_TAC; COND_CASES_TAC; REWRITE_TAC[euclid_point]; USE 2 (MATCH_MP point_onto); USE 3 (MATCH_MP point_onto); REWRITE_TAC[point_inj]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `y` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; RULE_ASSUM_TAC (REWRITE_RULE[coord01]); UND 1 THEN COND_CASES_TAC; UND 1 THEN COND_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]); UND 4 THEN UND 0 THEN REAL_ARITH_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); TYPE_THEN `FST p` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 3 THEN REWRITE_TAC[]; REWRITE_TAC[real_gt]; IMATCH_MP_TAC REAL_LT_MUL; UND 1 THEN COND_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]); TYPE_THEN `FST p'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 2 THEN REWRITE_TAC[]; IMATCH_MP_TAC REAL_LT_MUL; RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); KILL 1; REWRITE_TAC[SURJ;r_scale]; KILL 2; USE 1 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `&0 < FST p` ASM_CASES_TAC; TYPE_THEN `point ((&1/r)* FST p, SND p)` EXISTS_TAC; TYPE_THEN `&0 < &1/ r * FST p` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LT_MUL; IMATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[]; AP_TERM_TAC; REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC]; TYPE_THEN `(r * &1/r) * FST p = &1 * FST p` SUBAGOAL_TAC; AP_THM_TAC; AP_TERM_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; UND 3 THEN UND 0 THEN REAL_ARITH_TAC; REDUCE_TAC; TYPE_THEN `point p` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Tue Sep 7 10:55:54 EDT 2004 *) ]);; (* }}} *) let u_scale_bij = prove_by_refinement( `!r. (&0 < r) ==> BIJ (u_scale r) (euclid 2) (euclid 2)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[BIJ;INJ;u_scale;]; SUBCONJ_TAC; CONJ_TAC; COND_CASES_TAC; USE 2 (MATCH_MP point_onto); USE 3 (MATCH_MP point_onto); REWRITE_TAC[point_inj]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `y` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; RULE_ASSUM_TAC (REWRITE_RULE[coord01]); UND 1 THEN COND_CASES_TAC; UND 1 THEN COND_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]); UND 1 THEN UND 0 THEN REAL_ARITH_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); TYPE_THEN `SND p` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 3 THEN REWRITE_TAC[]; IMATCH_MP_TAC REAL_LT_MUL; UND 1 THEN COND_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]); TYPE_THEN `SND p'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 2 THEN REWRITE_TAC[]; IMATCH_MP_TAC REAL_LT_MUL; RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); KILL 1; REWRITE_TAC[SURJ;u_scale]; KILL 2; USE 1 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `&0 < SND p` ASM_CASES_TAC; TYPE_THEN `point (FST p, (&1/r)* SND p)` EXISTS_TAC; TYPE_THEN `&0 < &1/ r * SND p` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LT_MUL; IMATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[]; AP_TERM_TAC; REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC]; TYPE_THEN `(r * &1/r) * SND p = &1 * SND p` SUBAGOAL_TAC; AP_THM_TAC; AP_TERM_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; UND 3 THEN UND 0 THEN REAL_ARITH_TAC; REDUCE_TAC; TYPE_THEN `point p` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Tue Sep 7 11:01:53 EDT 2004 *) ]);; (* }}} *) let h_translate_inv = prove_by_refinement( `!r x. (euclid 2 x) ==> (h_translate (--. r) x = INV (h_translate r) (euclid 2) (euclid 2) x)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_SYM; TH_INTRO_TAC[`h_translate r`;`euclid 2`;`euclid 2`;`h_translate (--. r) x`;`x`] INVERSE_XY; ASM_REWRITE_TAC[h_translate_bij;h_translate;e1;point_scale]; ASM_SIMP_TAC[euclid_add_closure;euclid_point]; REWRITE_TAC[h_translate;euclid_plus;e1;euclid_scale]; IMATCH_MP_TAC EQ_EXT; REAL_ARITH_TAC; (* Tue Sep 7 11:11:17 EDT 2004 *) ]);; (* }}} *) let v_translate_inv = prove_by_refinement( `!r x. (euclid 2 x) ==> (v_translate (--. r) x = INV (v_translate r) (euclid 2) (euclid 2) x)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_SYM; TH_INTRO_TAC[`v_translate r`;`euclid 2`;`euclid 2`;`v_translate (--. r) x`;`x`] INVERSE_XY; ASM_REWRITE_TAC[v_translate_bij;v_translate;e2;point_scale]; ASM_SIMP_TAC[euclid_add_closure;euclid_point]; REWRITE_TAC[v_translate;euclid_plus;e2;euclid_scale]; IMATCH_MP_TAC EQ_EXT; REAL_ARITH_TAC; (* Tue Sep 7 11:12:42 EDT 2004 *) ]);; (* }}} *) extend_simp_rewrites[prove_by_refinement( `!x r. (&0 < r) ==> (r * (&1/r) * x = x)`, (* {{{ proof *) [ REWRITE_TAC [REAL_MUL_ASSOC]; TYPE_THEN `(r * &1/r) * x = &1 * x` SUBAGOAL_TAC; AP_THM_TAC; AP_TERM_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; UND 1 THEN UND 0 THEN REAL_ARITH_TAC; REDUCE_TAC; ])];; (* }}} *) extend_simp_rewrites[ prove_by_refinement( `!r. (&0 < r) ==> (&0 < &1 / r)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC REAL_LT_DIV; ])];; (* }}} *) extend_simp_rewrites[ REAL_LE_POW_2];; extend_simp_rewrites[ prove_by_refinement( `!x y. &0 <= x pow 2 + y pow 2`, (* {{{ proof *) [ ALL_TAC; IMATCH_MP_TAC REAL_LE_ADD; ])];; (* }}} *) let r_scale_inv = prove_by_refinement( `!r x. (&0 < r) /\ (euclid 2 x) ==> (r_scale (&1/r) x = INV (r_scale r) (euclid 2) (euclid 2) x)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_SYM; TH_INTRO_TAC[`r_scale r`;`euclid 2`;`euclid 2`;`r_scale (&1/r) x`;`x`] INVERSE_XY; ASM_SIMP_TAC [r_scale_bij]; TH_INTRO_TAC[`&1/r`] r_scale_bij; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REWRITE_TAC[r_scale]; USE 0 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `&0 < FST p` ASM_CASES_TAC; REWRITE_TAC[coord01]; TYPE_THEN `&0 < (&1 / r) * FST p` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LT_MUL; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* Tue Sep 7 11:40:41 EDT 2004 *) ]);; (* }}} *) let u_scale_inv = prove_by_refinement( `!r x. (&0 < r) /\ (euclid 2 x) ==> (u_scale (&1/r) x = INV (u_scale r) (euclid 2) (euclid 2) x)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_SYM; TH_INTRO_TAC[`u_scale r`;`euclid 2`;`euclid 2`;`u_scale (&1/r) x`;`x`] INVERSE_XY; ASM_SIMP_TAC [u_scale_bij]; TH_INTRO_TAC[`&1/r`] u_scale_bij; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REWRITE_TAC[u_scale]; USE 0 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `&0 < SND p` ASM_CASES_TAC; REWRITE_TAC[coord01]; TYPE_THEN `&0 < (&1 / r) * SND p` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LT_MUL; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* Tue Sep 7 11:56:05 EDT 2004 *) ]);; (* }}} *) let metric_continuous_continuous_top2 = prove_by_refinement( `!f. (IMAGE f (euclid 2) SUBSET (euclid 2) ==> (continuous f top2 top2 = metric_continuous f (euclid 2,d_euclid) (euclid 2,d_euclid)))`, (* {{{ proof *) [ REWRITE_TAC[top2]; IMATCH_MP_TAC metric_continuous_continuous; ]);; (* }}} *) let h_translate_cont = prove_by_refinement( `!r. continuous (h_translate r) (top2) (top2)`, (* {{{ proof *) [ ALL_TAC; TH_INTRO_TAC [`h_translate r`] metric_continuous_continuous_top2; ASSUME_TAC h_translate_bij; TSPEC `r` 0; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) REWRITE_TAC[metric_continuous;metric_continuous_pt]; TYPE_THEN `epsilon` EXISTS_TAC; REP_BASIC_TAC; REWRITE_TAC[h_translate]; TH_INTRO_TAC[`2`;`x`;`y`;`r *# e1`] metric_translate; REWRITE_TAC[e1;point_scale]; (* Tue Sep 7 12:09:30 EDT 2004 *) ]);; (* }}} *) let v_translate_cont = prove_by_refinement( `!r. continuous (v_translate r) (top2) (top2)`, (* {{{ proof *) [ ALL_TAC; TH_INTRO_TAC [`v_translate r`] metric_continuous_continuous_top2; ASSUME_TAC v_translate_bij; TSPEC `r` 0; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) REWRITE_TAC[metric_continuous;metric_continuous_pt]; TYPE_THEN `epsilon` EXISTS_TAC; REP_BASIC_TAC; REWRITE_TAC[v_translate]; TH_INTRO_TAC[`2`;`x`;`y`;`r *# e2`] metric_translate; REWRITE_TAC[e2;point_scale]; (* Tue Sep 7 12:10:54 EDT 2004 *) ]);; (* }}} *) let r_scale_cont = prove_by_refinement( `!r. (&0 < r) ==> (continuous (r_scale r) top2 top2)`, (* {{{ proof *) [ ALL_TAC; TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC; UND 0 THEN REAL_ARITH_TAC; TH_INTRO_TAC[`r_scale r`] metric_continuous_continuous_top2; ASSUME_TAC r_scale_bij; TSPEC `r` 2; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[metric_continuous;metric_continuous_pt]; TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC; TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ; TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC; TYPE_THEN `epsilon'` UNABBREV_TAC; TYPE_THEN `epsilon` UNABBREV_TAC; KILL 4; SUBCONJ_TAC; ASM_MESON_TAC[REAL_PROP_POS_LMUL]; USE 5(MATCH_MP point_onto); TYPE_THEN `y` UNABBREV_TAC; USE 6(MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; (* - *) TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ]; IMATCH_MP_TAC REAL_LE_RMUL; REWRITE_TAC[REAL_POW_2]; IMATCH_MP_TAC ABS_SQUARE_LE; UND 0 THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM REAL_POW_MUL]; (* - *) TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LE_RMUL; REWRITE_TAC[REAL_POW_2]; IMATCH_MP_TAC ABS_SQUARE_LE; UND 0 THEN REAL_ARITH_TAC; UND 6 THEN REDUCE_TAC; (* - *) TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC; REWRITE_TAC[GSYM REAL_POW_MUL]; REWRITE_TAC[REAL_POW_2]; IMATCH_MP_TAC ABS_SQUARE_LE; TYPE_THEN `abs (r*x' + y') = r*x' + y'` SUBAGOAL_TAC; REWRITE_TAC[ABS_REFL]; IMATCH_MP_TAC REAL_LE_ADD; ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`]; ineq_le_tac `(r*x' + y') + x' + r*y' = (&1 + r)*(x' + y')` ; (* A - *) TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC; TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC; IMATCH_MP_TAC POW_2_SQRT; IMATCH_MP_TAC REAL_LE_MUL; UND 7 THEN UND 1 THEN REAL_ARITH_TAC; UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]); IMATCH_MP_TAC SQRT_MONO_LT; REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ]; REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ]; IMATCH_MP_TAC REAL_LT_LMUL; CONJ_TAC; IMATCH_MP_TAC REAL_PROP_POS_POW; TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT); TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC; IMATCH_MP_TAC POW_2_SQRT; UND 7 THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]); (* - *) IMATCH_MP_TAC REAL_LET_TRANS; TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC; (* B- *) REWRITE_TAC[r_scale]; COND_CASES_TAC THEN COND_CASES_TAC; UND 4 THEN REWRITE_TAC[d_euclid_point]; IMATCH_MP_TAC SQRT_MONO_LE; (* IMATCH_MP_TAC REAL_LET_TRANS; *) REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; (* 3 LEFT *) UND 4 THEN (REWRITE_TAC [d_euclid_point]); TYPE_THEN `u = --. (FST p)` ABBREV_TAC ; TYPE_THEN `FST p = -- u` SUBAGOAL_TAC; UND 12 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `x - --. y = x + y`]; IMATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; FIRST_ASSUM IMATCH_MP_TAC ; UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; (* 2 LEFT *) UND 4 THEN (REWRITE_TAC [d_euclid_point]); TYPE_THEN `u = --. (FST p')` ABBREV_TAC ; TYPE_THEN `FST p' = -- u` SUBAGOAL_TAC; UND 12 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `-- x - v = -- (v + x)`;REAL_POW_NEG;EVEN2 ]; IMATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; FIRST_ASSUM IMATCH_MP_TAC ; UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; (* 1 LEFT *) UND 4 THEN (REWRITE_TAC [d_euclid_point]); IMATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; (* Tue Sep 7 15:33:59 EDT 2004 *) ]);; (* }}} *) let u_scale_cont = prove_by_refinement( `!r. (&0 < r) ==> (continuous (u_scale r) top2 top2)`, (* {{{ proof *) [ ALL_TAC; TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC; UND 0 THEN REAL_ARITH_TAC; TH_INTRO_TAC[`u_scale r`] metric_continuous_continuous_top2; ASSUME_TAC u_scale_bij; TSPEC `r` 2; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[metric_continuous;metric_continuous_pt]; TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC; TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ; TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC; TYPE_THEN `epsilon'` UNABBREV_TAC; TYPE_THEN `epsilon` UNABBREV_TAC; KILL 4; SUBCONJ_TAC; ASM_MESON_TAC[REAL_PROP_POS_LMUL]; USE 5(MATCH_MP point_onto); TYPE_THEN `y` UNABBREV_TAC; USE 6(MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; (* - *) TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ]; IMATCH_MP_TAC REAL_LE_RMUL; REWRITE_TAC[REAL_POW_2]; IMATCH_MP_TAC ABS_SQUARE_LE; UND 0 THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM REAL_POW_MUL]; (* - *) TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LE_RMUL; REWRITE_TAC[REAL_POW_2]; IMATCH_MP_TAC ABS_SQUARE_LE; UND 0 THEN REAL_ARITH_TAC; UND 6 THEN REDUCE_TAC; (* - *) TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC; REWRITE_TAC[GSYM REAL_POW_MUL]; REWRITE_TAC[REAL_POW_2]; IMATCH_MP_TAC ABS_SQUARE_LE; TYPE_THEN `abs (r*x' + y') = r*x' + y'` SUBAGOAL_TAC; REWRITE_TAC[ABS_REFL]; IMATCH_MP_TAC REAL_LE_ADD; ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`]; ineq_le_tac `(r*x' + y') + x' + r*y' = (&1 + r)*(x' + y')` ; (* A - *) TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC; TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC; IMATCH_MP_TAC POW_2_SQRT; IMATCH_MP_TAC REAL_LE_MUL; UND 7 THEN UND 1 THEN REAL_ARITH_TAC; UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]); IMATCH_MP_TAC SQRT_MONO_LT; REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ]; REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ]; IMATCH_MP_TAC REAL_LT_LMUL; CONJ_TAC; IMATCH_MP_TAC REAL_PROP_POS_POW; TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT); TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC; IMATCH_MP_TAC POW_2_SQRT; UND 7 THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]); (* - *) IMATCH_MP_TAC REAL_LET_TRANS; TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC; (* B- *) REWRITE_TAC[u_scale]; COND_CASES_TAC THEN COND_CASES_TAC; UND 4 THEN REWRITE_TAC[d_euclid_point]; IMATCH_MP_TAC SQRT_MONO_LE; (* IMATCH_MP_TAC REAL_LET_TRANS; *) REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; (* 3 LEFT *) UND 4 THEN (REWRITE_TAC [d_euclid_point]); TYPE_THEN `u = --. (SND p)` ABBREV_TAC ; TYPE_THEN `SND p = -- u` SUBAGOAL_TAC; UND 12 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `x - --. y = x + y`]; IMATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; FIRST_ASSUM IMATCH_MP_TAC ; UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; (* 2 LEFT *) UND 4 THEN (REWRITE_TAC [d_euclid_point]); TYPE_THEN `u = --. (SND p')` ABBREV_TAC ; TYPE_THEN `SND p' = -- u` SUBAGOAL_TAC; UND 12 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `-- x - v = -- (v + x)`;REAL_POW_NEG;EVEN2 ]; IMATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; FIRST_ASSUM IMATCH_MP_TAC ; UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; (* 1 LEFT *) UND 4 THEN (REWRITE_TAC [d_euclid_point]); IMATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_LDISTRIB]; IMATCH_MP_TAC REAL_LE_ADD2; (* Tue Sep 7 15:40:34 EDT 2004 *) ]);; (* }}} *) let h_translate_hom = prove_by_refinement( `!r. (homeomorphism (h_translate r) top2 top2)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC bicont_homeomorphism; REWRITE_TAC[top2_unions;h_translate_bij;h_translate_cont]; IMATCH_MP_TAC cont_domain; REWRITE_TAC[top2_unions]; TYPE_THEN `h_translate (-- r)` EXISTS_TAC; REWRITE_TAC[h_translate_inv;h_translate_cont]; (* Tue Sep 7 15:56:20 EDT 2004 *) ]);; (* }}} *) let v_translate_hom = prove_by_refinement( `!r. (homeomorphism (v_translate r) top2 top2)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC bicont_homeomorphism; REWRITE_TAC[top2_unions;v_translate_bij;v_translate_cont]; IMATCH_MP_TAC cont_domain; REWRITE_TAC[top2_unions]; TYPE_THEN `v_translate (-- r)` EXISTS_TAC; REWRITE_TAC[v_translate_inv;v_translate_cont]; (* Tue Sep 7 15:57:06 EDT 2004 *) ]);; (* }}} *) let r_scale_hom = prove_by_refinement( `!r. (&0 < r) ==> (homeomorphism (r_scale r) top2 top2)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC bicont_homeomorphism; ASM_SIMP_TAC [top2_unions;r_scale_bij;r_scale_cont]; IMATCH_MP_TAC cont_domain; REWRITE_TAC[top2_unions]; TYPE_THEN `r_scale (&1/r)` EXISTS_TAC; TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC; ASM_SIMP_TAC [r_scale_inv;r_scale_cont]; (* Tue Sep 7 16:00:14 EDT 2004 *) ]);; (* }}} *) let u_scale_hom = prove_by_refinement( `!r. (&0 < r) ==> (homeomorphism (u_scale r) top2 top2)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC bicont_homeomorphism; ASM_SIMP_TAC [top2_unions;u_scale_bij;u_scale_cont]; IMATCH_MP_TAC cont_domain; REWRITE_TAC[top2_unions]; TYPE_THEN `u_scale (&1/r)` EXISTS_TAC; TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC; ASM_SIMP_TAC [u_scale_inv;u_scale_cont]; (* Tue Sep 7 16:01:04 EDT 2004 *) ]);; (* }}} *) let h_translate_h = prove_by_refinement( `!r. (h_compat (h_translate r))`, (* {{{ proof *) [ REWRITE_TAC[h_compat;h_translate;e1;point_scale;mk_line;IMAGE]; IMATCH_MP_TAC EQ_EXT; EQ_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `x''` UNABBREV_TAC; REDUCE_TAC; TYPE_THEN `t` EXISTS_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; TYPE_THEN `x'` UNABBREV_TAC; CONV_TAC (dropq_conv "x"); CONV_TAC (dropq_conv "x''"); TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; TYPE_THEN `t` EXISTS_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; (* Tue Sep 7 16:13:50 EDT 2004 *) ]);; (* }}} *) let v_translate_v = prove_by_refinement( `!r. (v_compat (v_translate r))`, (* {{{ proof *) [ REWRITE_TAC[v_compat;v_translate;e2;point_scale;mk_line;IMAGE]; IMATCH_MP_TAC EQ_EXT; EQ_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `x''` UNABBREV_TAC; REDUCE_TAC; TYPE_THEN `t` EXISTS_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; TYPE_THEN `x'` UNABBREV_TAC; CONV_TAC (dropq_conv "x"); CONV_TAC (dropq_conv "x''"); TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; TYPE_THEN `t` EXISTS_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; (* Tue Sep 7 16:15:33 EDT 2004 *) ]);; (* }}} *) let h_translate_v = prove_by_refinement( `!r. (v_compat (h_translate r))`, (* {{{ proof *) [ REWRITE_TAC[v_compat;h_translate;e1;point_scale;mk_line;IMAGE]; IMATCH_MP_TAC EQ_EXT; EQ_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `x''` UNABBREV_TAC; REDUCE_TAC; TYPE_THEN `t` EXISTS_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; TYPE_THEN `x'` UNABBREV_TAC; CONV_TAC (dropq_conv "x"); CONV_TAC (dropq_conv "x''"); TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; TYPE_THEN `t` EXISTS_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; (* Tue Sep 7 16:17:13 EDT 2004 *) ]);; (* }}} *) let v_translate_h = prove_by_refinement( `!r. (h_compat (v_translate r))`, (* {{{ proof *) [ REWRITE_TAC[h_compat;v_translate;e2;point_scale;mk_line;IMAGE]; IMATCH_MP_TAC EQ_EXT; EQ_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `x''` UNABBREV_TAC; REDUCE_TAC; TYPE_THEN `t` EXISTS_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; TYPE_THEN `x'` UNABBREV_TAC; CONV_TAC (dropq_conv "x"); CONV_TAC (dropq_conv "x''"); TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; TYPE_THEN `t` EXISTS_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; REWRITE_TAC[point_inj;PAIR_SPLIT ]; REAL_ARITH_TAC; (* Tue Sep 7 16:18:12 EDT 2004 *) ]);; (* }}} *) let lin_solve_x = prove_by_refinement( `!a c. ~(c = &0) ==> (?t. c*t = a)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `a/c` EXISTS_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; ASM_MESON_TAC[]; ]);; (* }}} *) let mk_line_pt = prove_by_refinement( `!x. mk_line x x = {x}`, (* {{{ proof *) [ REWRITE_TAC[mk_line;trivial_lin_combo]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING]; ]);; (* }}} *) let h_compat_bij = prove_by_refinement( `!f t. (BIJ f (euclid 2) (euclid 2) /\ (!x. f (point x) 1 = t + SND x) ==> h_compat f)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;h_compat]; TYPE_THEN `x = y` ASM_CASES_TAC; REWRITE_TAC[mk_line_pt]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE;INR IN_SING]; EQ_TAC; ASM_REWRITE_TAC[]; TYPE_THEN`point y` EXISTS_TAC; (* - *) TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, t + SND x ))` SUBAGOAL_TAC; TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); USE 5 (MATCH_MP point_onto); REWRITE_TAC[point_inj ;PAIR_SPLIT;]; TSPEC `x'` 1; REWR 1; UND 1 THEN REWRITE_TAC[coord01]; (* A- *) UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t)); IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET;]; TYPE_THEN `x'` UNABBREV_TAC; UND 7 THEN REWRITE_TAC[mk_line]; TYPE_THEN `x''` UNABBREV_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; TYPE_THEN `x' = (t' * FST x + (&1 - t') * FST y,t' * SND y + (&1 - t') * SND y)` ABBREV_TAC ; TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; REAL_ARITH_TAC; KILL 8; COPY 5; TSPEC `x'` 5; UND 5 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); REWRITE_TAC[point_inj ;PAIR_SPLIT;]; TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x; TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC; UND 8 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); REWRITE_TAC[point_inj ;PAIR_SPLIT ]; UND 5 THEN REAL_ARITH_TAC; UND 4 THEN REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM point_inj]; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `t'` EXISTS_TAC; CONJ_TAC; UND 5 THEN REAL_ARITH_TAC; REAL_ARITH_TAC; (* - *) REWRITE_TAC[mk_line;SUBSET;IMAGE]; CONV_TAC (dropq_conv "x''"); TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `?u. (euclid_plus (t' *# point (f (point x) 0,t + SND y)) ((&1 - t') *# point (f (point y) 0,t + SND y))) = point (u , t + SND y)` SUBAGOAL_TAC; REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;]; CONV_TAC (dropq_conv "u"); REAL_ARITH_TAC; KILL 6; (* - *) TYPE_THEN `?x'. point(u, t + SND y) = f (point x')` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); TSPEC `point (u,t + SND y)` 2; RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]); USE 7 (MATCH_MP point_onto); TYPE_THEN `y'` UNABBREV_TAC; TYPE_THEN `p` EXISTS_TAC; (* - *) TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x; UND 4 THEN REWRITE_TAC[PAIR_SPLIT ]; UND 7 THEN REAL_ARITH_TAC; TYPE_THEN `t'` EXISTS_TAC; AP_TERM_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;]; CONJ_TAC; UND 7 THEN REAL_ARITH_TAC; (* - *) TSPEC `x'` 5; TYPE_THEN `f (point x')` UNABBREV_TAC; USE 5 (REWRITE_RULE[point_inj;PAIR_SPLIT;]); UND 5 THEN REAL_ARITH_TAC; (* Tue Sep 7 22:08:48 EDT 2004 *) ]);; (* }}} *) let r_scale_h = prove_by_refinement( `!r. (&0 < r) ==> (h_compat (r_scale r))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC h_compat_bij; TYPE_THEN `&0` EXISTS_TAC; REDUCE_TAC; ASM_SIMP_TAC [r_scale_bij]; REWRITE_TAC[r_scale]; COND_CASES_TAC; (* Tue Sep 7 22:11:42 EDT 2004 *) ]);; (* }}} *) let h_compat_bij2 = prove_by_refinement( `!f s. (BIJ f (euclid 2) (euclid 2) /\ (!x. f (point x) 1 = s(SND x)) /\ (INJ s UNIV UNIV) ==> h_compat f)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;h_compat]; TYPE_THEN `x = y` ASM_CASES_TAC; REWRITE_TAC[mk_line_pt]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE;INR IN_SING]; EQ_TAC; ASM_REWRITE_TAC[]; TYPE_THEN`point y` EXISTS_TAC; (* - *) TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, s(SND x) ))` SUBAGOAL_TAC; TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); USE 6 (MATCH_MP point_onto); REWRITE_TAC[point_inj ;PAIR_SPLIT;]; TSPEC `x'` 2; REWR 2; UND 2 THEN REWRITE_TAC[coord01]; (* A- *) UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t)); IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET;]; TYPE_THEN `x'` UNABBREV_TAC; UND 8 THEN REWRITE_TAC[mk_line]; TYPE_THEN `x''` UNABBREV_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; TYPE_THEN `x' = (t * FST x + (&1 - t) * FST y,t * SND y + (&1 - t) * SND y)` ABBREV_TAC ; TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; REAL_ARITH_TAC; KILL 9; COPY 6; TSPEC `x'` 6; UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); REWRITE_TAC[point_inj ;PAIR_SPLIT;]; TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x; TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC; UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); REWRITE_TAC[point_inj ;PAIR_SPLIT ]; UND 6 THEN REAL_ARITH_TAC; UND 5 THEN REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM point_inj]; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `t` EXISTS_TAC; CONJ_TAC; UND 6 THEN REAL_ARITH_TAC; REAL_ARITH_TAC; (* - *) REWRITE_TAC[mk_line;SUBSET;IMAGE]; CONV_TAC (dropq_conv "x''"); TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `?u. (euclid_plus (t *# point (f (point x) 0,s(SND y))) ((&1 - t) *# point (f (point y) 0,s(SND y)))) = point (u , s(SND y))` SUBAGOAL_TAC; REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;]; CONV_TAC (dropq_conv "u"); REAL_ARITH_TAC; ONCE_ASM_REWRITE_TAC []; UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); (* - *) TYPE_THEN `?x'. point(u, s(SND y)) = f (point x')` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); TSPEC `point (u,s(SND y))` 3; RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]); USE 8 (MATCH_MP point_onto); TYPE_THEN `y'` UNABBREV_TAC; TYPE_THEN `p` EXISTS_TAC; (* B- *) TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x; UND 5 THEN REWRITE_TAC[PAIR_SPLIT ]; UND 8 THEN REAL_ARITH_TAC; TYPE_THEN `t` EXISTS_TAC; AP_TERM_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;]; CONJ_TAC; UND 8 THEN REAL_ARITH_TAC; (* - *) TSPEC `x'` 6; TYPE_THEN `f (point x')` UNABBREV_TAC; USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]); TYPE_THEN `SND y = SND x'` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 12 THEN REAL_ARITH_TAC; (* Wed Sep 8 20:04:34 EDT 2004 *) ]);; (* }}} *) let u_scale_h = prove_by_refinement( `!r. (&0 < r) ==> (h_compat (u_scale r))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC h_compat_bij2; TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC; ASM_SIMP_TAC[u_scale_bij]; CONJ_TAC; REWRITE_TAC[u_scale]; TYPE_THEN `&0 < SND x` ASM_CASES_TAC; REWRITE_TAC[coord01]; TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC; REWRITE_TAC[INJ]; UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC; IMATCH_MP_TAC REAL_EQ_LMUL_IMP; UNIFY_EXISTS_TAC; UND 0 THEN REAL_ARITH_TAC; TYPE_THEN `y` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 2 THEN REWRITE_TAC[]; IMATCH_MP_TAC REAL_PROP_POS_MUL2; TYPE_THEN `x` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 3 THEN REWRITE_TAC[]; IMATCH_MP_TAC REAL_PROP_POS_MUL2; ]);; (* }}} *) let v_compat_bij2 = prove_by_refinement( `!f s. (BIJ f (euclid 2) (euclid 2) /\ (!x. f (point x) 0 = s(FST x)) /\ (INJ s UNIV UNIV) ==> v_compat f)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;v_compat]; TYPE_THEN `x = y` ASM_CASES_TAC; REWRITE_TAC[mk_line_pt]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE;INR IN_SING]; EQ_TAC; ASM_REWRITE_TAC[]; TYPE_THEN`point y` EXISTS_TAC; (* - *) TYPE_THEN `!x. f (point x) = point(s(FST x), (f (point x)) 1 )` SUBAGOAL_TAC; TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); USE 6 (MATCH_MP point_onto); REWRITE_TAC[point_inj ;PAIR_SPLIT;]; TSPEC `x'` 2; REWR 2; UND 2 THEN REWRITE_TAC[coord01]; (* A- *) UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t)); IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET;]; TYPE_THEN `x'` UNABBREV_TAC; UND 8 THEN REWRITE_TAC[mk_line]; TYPE_THEN `x''` UNABBREV_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; TYPE_THEN `x' = (t * FST y + (&1 - t) * FST y,t * SND x + (&1 - t) * SND y)` ABBREV_TAC ; TYPE_THEN `FST x' = FST y` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; REAL_ARITH_TAC; KILL 9; COPY 6; TSPEC `x'` 6; UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); REWRITE_TAC[point_inj ;PAIR_SPLIT;]; TH_INTRO_TAC[`f (point x') 1 - f(point y) 1`;`f (point x) 1 - f (point y) 1`] lin_solve_x; TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC; UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); REWRITE_TAC[point_inj ;PAIR_SPLIT ]; UND 6 THEN REAL_ARITH_TAC; UND 5 THEN REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM point_inj]; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `t` EXISTS_TAC; CONJ_TAC; UND 6 THEN REAL_ARITH_TAC; UND 6 THEN REAL_ARITH_TAC; (* - *) REWRITE_TAC[mk_line;SUBSET;IMAGE]; CONV_TAC (dropq_conv "x''"); TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `?u. (euclid_plus (t *# (f (point x))) ((&1 - t) *# (f (point y)))) = point ( s(FST y), u)` SUBAGOAL_TAC; ONCE_ASM_REWRITE_TAC[]; REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;]; CONV_TAC (dropq_conv "u"); REAL_ARITH_TAC; (* - *) TYPE_THEN `?x'. point( s(FST y),u) = f (point x')` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); TSPEC `point (s(FST y),u)` 3; RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]); USE 9 (MATCH_MP point_onto); TYPE_THEN `y'` UNABBREV_TAC; TYPE_THEN `p` EXISTS_TAC; (* B- *) TH_INTRO_TAC[`SND x' - SND y`;`SND x - SND y`] lin_solve_x; UND 5 THEN REWRITE_TAC[PAIR_SPLIT ]; UND 9 THEN REAL_ARITH_TAC; TYPE_THEN `t'` EXISTS_TAC; AP_TERM_TAC; TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;]; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC; UND 9 THEN REAL_ARITH_TAC; (* - *) TSPEC `x'` 6; TYPE_THEN `f (point x')` UNABBREV_TAC; USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]); TYPE_THEN `FST y = FST x'` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 13 THEN REAL_ARITH_TAC; (* Wed Sep 8 21:10:34 EDT 2004 *) ]);; (* }}} *) let r_scale_v = prove_by_refinement( `!r. (&0 < r) ==> (v_compat (r_scale r))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC v_compat_bij2; TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC; ASM_SIMP_TAC[r_scale_bij]; CONJ_TAC; REWRITE_TAC[r_scale]; TYPE_THEN `&0 < FST x` ASM_CASES_TAC; REWRITE_TAC[coord01]; TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC; REWRITE_TAC[INJ]; UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC; IMATCH_MP_TAC REAL_EQ_LMUL_IMP; UNIFY_EXISTS_TAC; UND 0 THEN REAL_ARITH_TAC; TYPE_THEN `y` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 2 THEN REWRITE_TAC[]; IMATCH_MP_TAC REAL_PROP_POS_MUL2; TYPE_THEN `x` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 3 THEN REWRITE_TAC[]; IMATCH_MP_TAC REAL_PROP_POS_MUL2; ]);; (* }}} *) let u_scale_v = prove_by_refinement( `!r. (&0 < r) ==> (v_compat (u_scale r))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC v_compat_bij2; TYPE_THEN `(\ z. &0 + z)` EXISTS_TAC; ASM_SIMP_TAC[u_scale_bij]; REDUCE_TAC; CONJ_TAC; REWRITE_TAC[u_scale]; COND_CASES_TAC; REWRITE_TAC[INJ]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION Q *) (* ------------------------------------------------------------------ *) let mk_line_hyper2_fst = prove_by_refinement( `!x y. (FST x = FST y) ==> (mk_line (point x) (point y) SUBSET hyperplane 2 e1 (FST x))`, (* {{{ proof *) [ REWRITE_TAC[]; TYPE_THEN `x = y` ASM_CASES_TAC; REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ]; REWRITE_TAC[e1;GSYM line2D_F;SUBSET;mk_line;]; TYPE_THEN `y` EXISTS_TAC; (* - *) IMATCH_MP_TAC (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]])); REWRITE_TAC[GSYM mk_line_hyper2_e1]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; IMATCH_MP_TAC mk_line_2; REWRITE_TAC[mk_line_hyper2_e1;]; REWRITE_TAC[e1;GSYM line2D_F;point_inj;PAIR_SPLIT]; CONJ_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `y` EXISTS_TAC; UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT]; (* Thu Sep 9 10:13:23 EDT 2004 *) ]);; (* }}} *) let mk_line_hyper2_snd = prove_by_refinement( `!x y. (SND x = SND y) ==> (mk_line (point x) (point y) SUBSET hyperplane 2 e2 (SND x))`, (* {{{ proof *) [ REWRITE_TAC[]; TYPE_THEN `x = y` ASM_CASES_TAC; REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ]; REWRITE_TAC[e2;GSYM line2D_S;SUBSET;mk_line;]; TYPE_THEN `y` EXISTS_TAC; (* - *) IMATCH_MP_TAC (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]])); REWRITE_TAC[GSYM mk_line_hyper2_e2]; ONCE_REWRITE_TAC [EQ_SYM_EQ]; IMATCH_MP_TAC mk_line_2; REWRITE_TAC[mk_line_hyper2_e2;]; REWRITE_TAC[e2;GSYM line2D_S;point_inj;PAIR_SPLIT]; CONJ_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `y` EXISTS_TAC; UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT]; (* Thu Sep 9 10:16:19 EDT 2004 *) ]);; (* }}} *) let hv_line_hyper = prove_by_refinement( `!E e. hv_line E /\ E e ==> (?z. (e SUBSET hyperplane 2 e1 z) \/ (e SUBSET hyperplane 2 e2 z))`, (* {{{ proof *) [ REWRITE_TAC[hv_line]; TSPEC `e` 1; REP_BASIC_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `FST y` EXISTS_TAC; DISJ1_TAC; USE 3 SYM; IMATCH_MP_TAC mk_line_hyper2_fst; TYPE_THEN `SND x` EXISTS_TAC; USE 3 SYM; DISJ2_TAC; IMATCH_MP_TAC mk_line_hyper2_snd; (* Thu Sep 9 10:20:05 EDT 2004 *) ]);; (* }}} *) let hv_line_hyper2 = prove_by_refinement( `!E. hv_line E /\ FINITE E ==> (?E'. (UNIONS E SUBSET UNIONS E') /\ (FINITE E') /\ (!e. E' e ==> (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!e. ?h. (E e ==> (e SUBSET h /\ (?z. (h = hyperplane 2 e1 z) \/ (h = hyperplane 2 e2 z))))` SUBAGOAL_TAC; RIGHT_TAC "h"; TH_INTRO_TAC[`E`;`e`] hv_line_hyper; FIRST_ASSUM DISJ_CASES_TAC; UNIFY_EXISTS_TAC; TYPE_THEN `z` EXISTS_TAC; UNIFY_EXISTS_TAC; TYPE_THEN `z` EXISTS_TAC; LEFT 2 "h"; TYPE_THEN `IMAGE h E` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[UNIONS;SUBSET;IMAGE]; CONV_TAC (dropq_conv "u"); NAME_CONFLICT_TAC; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[ISUBSET]; (* - *) CONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]); ASM_MESON_TAC[]; (* Thu Sep 9 10:32:28 EDT 2004 *) ]);; (* }}} *) let finite_graph_edge = prove_by_refinement( `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_edge G) /\ graph_isomorphic G H ==> FINITE (graph_edge H)`, (* {{{ proof *) [ REWRITE_TAC[graph_isomorphic;graph_iso]; ASM_MESON_TAC[FINITE_BIJ]; ]);; (* }}} *) let finite_graph_vertex = prove_by_refinement( `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_vertex G) /\ graph_isomorphic G H ==> FINITE (graph_vertex H)`, (* {{{ proof *) [ REWRITE_TAC[graph_isomorphic;graph_iso]; ASM_MESON_TAC[FINITE_BIJ]; ]);; (* }}} *) let graph_edge_nonempty = prove_by_refinement( `!(G:(A,B)graph_t) (H:(A',B')graph_t). ~(graph_edge G = EMPTY ) /\ graph_isomorphic G H ==> ~(graph_edge H = EMPTY )`, (* {{{ proof *) [ REWRITE_TAC[graph_isomorphic;graph_iso]; USE 5 (REWRITE_RULE[EMPTY_EXISTS]); UND 0 THEN (REWRITE_TAC [EMPTY_EXISTS]); TYPE_THEN `v u'` EXISTS_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); ]);; (* }}} *) let graph_edge_around_finite = prove_by_refinement( `!(G:(A,B)graph_t) v. (FINITE (graph_edge G)) ==> (FINITE (graph_edge_around G v))`, (* {{{ proof *) [ REWRITE_TAC[graph_edge_around]; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET]; ]);; (* }}} *) let graph_edge_around4 = prove_by_refinement( `!(G:(A,B)graph_t) (H:(A',B')graph_t). (graph G) /\ (FINITE (graph_edge G)) /\ (!v. CARD (graph_edge_around G v) <=| 4) /\ graph_isomorphic G H ==> (!v. CARD (graph_edge_around H v) <=| 4)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `graph_vertex H v` ASM_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE [graph_isomorphic]); TYPE_THEN `?v'. (graph_vertex G v' /\ ((FST f) v' = v))` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT ;graph_iso]); USE 6 (REWRITE_RULE[BIJ;SURJ]); TYPE_THEN `v` UNABBREV_TAC; TH_INTRO_TAC[`G`;`H`;`f`;`v'`] graph_iso_around; TH_INTRO_TAC[`SND f`; `(graph_edge_around G v')`] CARD_IMAGE_LE; IMATCH_MP_TAC graph_edge_around_finite; IMATCH_MP_TAC LE_TRANS; UNIFY_EXISTS_TAC; ASM_MESON_TAC [ARITH_RULE `0 <=| 4`; CARD_CLAUSES;graph_isomorphic_graph;graph_edge_around_empty]; (* Thu Sep 9 11:49:01 EDT 2004 *) ]);; (* }}} *) let graph_near_support = prove_by_refinement( `!(G:(A,B)graph_t). (planar_graph G) /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = {}) /\ (!v. CARD (graph_edge_around G v) <=| 4) ==> (?H E. graph_isomorphic G H /\ (FINITE E) /\ (good_plane_graph H) /\ (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\ (!v. (graph_vertex H v ==> E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\ (!e. (E e ==> (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z)))))`, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC[`G`] planar_graph_hv; TYPE_THEN `H` EXISTS_TAC; TYPE_THEN `A = IMAGE (\ v. hyperplane 2 e1 (v 0)) (graph_vertex H)` ABBREV_TAC ; TYPE_THEN `B = IMAGE (\ v. hyperplane 2 e2 (v 1)) (graph_vertex H)` ABBREV_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]); LEFT 5 "E"; LEFT 5 "E"; TYPE_THEN `?E'. !e. (graph_edge H e ==> (e SUBSET UNIONS (E' e)) /\ (FINITE (E' e)) /\ (!e'. E' e e' ==> (?z. (e' = hyperplane 2 e1 z) \/ (e' = hyperplane 2 e2 z))))` SUBAGOAL_TAC; LEFT_TAC "e"; RIGHT_TAC "E'"; TSPEC `e` 5; TH_INTRO_TAC[`E e`] hv_line_hyper2; TYPE_THEN `E'` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; (* - *) TYPE_THEN `C = UNIONS (IMAGE E' (graph_edge H))` ABBREV_TAC ; TYPE_THEN `A UNION B UNION C` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[FINITE_UNION]; CONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC finite_graph_vertex; UNIFY_EXISTS_TAC; CONJ_TAC; TYPE_THEN `B` UNABBREV_TAC; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC finite_graph_vertex; UNIFY_EXISTS_TAC; TYPE_THEN `C` UNABBREV_TAC; TH_INTRO_TAC[`IMAGE E' (graph_edge H)`] FINITE_FINITE_UNIONS; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC finite_graph_edge; UNIFY_EXISTS_TAC; USE 11 (REWRITE_RULE[IMAGE]); ASM_MESON_TAC[]; (* - *) CONJ_TAC; REWRITE_TAC[UNIONS_UNION]; IMATCH_MP_TAC in_union; DISJ2_TAC; IMATCH_MP_TAC in_union; DISJ2_TAC; TYPE_THEN `C` UNABBREV_TAC; TSPEC `e` 10; REP_BASIC_TAC; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; IMATCH_MP_TAC UNIONS_UNIONS; REWRITE_TAC[SUBSET;UNIONS;IMAGE;]; CONV_TAC (dropq_conv "u"); UNIFY_EXISTS_TAC; (* - *) CONJ_TAC; REWRITE_TAC[UNION]; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[IMAGE]; CONJ_TAC; DISJ1_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; DISJ2_TAC; DISJ1_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) USE 12 (REWRITE_RULE[UNION]); UND 12 THEN REP_CASES_TAC; TYPE_THEN `A` UNABBREV_TAC; USE 12 (REWRITE_RULE[IMAGE]); MESON_TAC[]; TYPE_THEN `B` UNABBREV_TAC; USE 12 (REWRITE_RULE[IMAGE]); MESON_TAC[]; TYPE_THEN `C` UNABBREV_TAC; USE 12 (REWRITE_RULE[IMAGE;UNIONS]); TYPE_THEN `u` UNABBREV_TAC; TSPEC `x` 10; (* Thu Sep 9 12:12:51 EDT 2004 *) ]);; (* }}} *) let h_translate_point = prove_by_refinement( `!u v r. (h_translate r (point (u,v)) = point (u+r,v))`, (* {{{ proof *) [ REWRITE_TAC[h_translate;e1;point_scale;point_add]; REDUCE_TAC; ]);; (* }}} *) let v_translate_point = prove_by_refinement( `!u v r. (v_translate r (point (u,v)) = point (u,v + r))`, (* {{{ proof *) [ REWRITE_TAC[v_translate;e2;point_scale;point_add]; REDUCE_TAC; ]);; (* }}} *) let hyperplane1_h_translate = prove_by_refinement( `!z r. (IMAGE (h_translate r) (hyperplane 2 e1 z) = (hyperplane 2 e1 (z + r)))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e1]; ASSUME_TAC v_compat; TSPEC `(h_translate r)` 0; RULE_ASSUM_TAC (REWRITE_RULE[h_translate_v]); UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`z, &0`;`z, &1`])); REWRITE_TAC[h_translate_point]; ]);; (* }}} *) let hyperplane2_h_translate = prove_by_refinement( `!z r. (IMAGE (h_translate r) (hyperplane 2 e2 z) = (hyperplane 2 e2 z))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e2]; ASSUME_TAC h_compat; TSPEC `(h_translate r)` 0; RULE_ASSUM_TAC (REWRITE_RULE[h_translate_h]); UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;` &1,z`])); REWRITE_TAC[h_translate_point]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC mk_line_2; REWRITE_TAC[mk_line_hyper2_e2;]; REWRITE_TAC[GSYM line2D_S;e2;point_inj ]; CONJ_TAC; CONV_TAC (dropq_conv "p"); CONJ_TAC; CONV_TAC (dropq_conv "p"); RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]); UND 1 THEN REAL_ARITH_TAC; ]);; (* }}} *) let hyperplane2_v_translate = prove_by_refinement( `!z r. (IMAGE (v_translate r) (hyperplane 2 e2 z) = (hyperplane 2 e2 (z + r)))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e2]; ASSUME_TAC h_compat; TSPEC `(v_translate r)` 0; RULE_ASSUM_TAC (REWRITE_RULE[v_translate_h]); UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`])); REWRITE_TAC[v_translate_point]; ]);; (* }}} *) let hyperplane1_v_translate = prove_by_refinement( `!z r. (IMAGE (v_translate r) (hyperplane 2 e1 z) = (hyperplane 2 e1 z))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e1]; ASSUME_TAC v_compat; TSPEC `(v_translate r)` 0; RULE_ASSUM_TAC (REWRITE_RULE[v_translate_v]); UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`])); REWRITE_TAC[v_translate_point]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC mk_line_2; REWRITE_TAC[mk_line_hyper2_e1;]; REWRITE_TAC[GSYM line2D_F;e1;point_inj ]; CONJ_TAC; CONV_TAC (dropq_conv "p"); CONJ_TAC; CONV_TAC (dropq_conv "p"); RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]); UND 1 THEN REAL_ARITH_TAC; (* Thu Sep 9 13:43:45 EDT 2004 *) ]);; (* }}} *) let r_scale_point = prove_by_refinement( `!r u v. (r_scale r (point (u,v))) = point ((if (&0 < u) then r*u else u),v)`, (* {{{ proof *) [ REWRITE_TAC[r_scale]; TYPE_THEN `&0 < u` ASM_CASES_TAC; ]);; (* }}} *) let u_scale_point = prove_by_refinement( `!r u v. (u_scale r (point (u,v))) = point (u,(if (&0 < v) then r*v else v))`, (* {{{ proof *) [ REWRITE_TAC[u_scale]; TYPE_THEN `&0 < v` ASM_CASES_TAC; ]);; (* }}} *) let hyperplane2_r_scale = prove_by_refinement( `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e2 z) = (hyperplane 2 e2 z))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e2]; ASSUME_TAC h_compat; TSPEC `(r_scale r)` 1; TYPE_THEN `h_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_h];ALL_TAC]; REWR 1; UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;`&1,z`])); REWRITE_TAC[r_scale_point]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC mk_line_2; REWRITE_TAC[REAL_ARITH `~(&0 < &0)`]; REWRITE_TAC[mk_line_hyper2_e2;]; REWRITE_TAC[GSYM line2D_S;e2;point_inj ]; CONJ_TAC; CONV_TAC (dropq_conv "p"); CONJ_TAC; CONV_TAC (dropq_conv "p"); RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]); UND 3 THEN UND 0 THEN REAL_ARITH_TAC; ]);; (* }}} *) let hyperplane1_r_scale = prove_by_refinement( `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e1 z) = (hyperplane 2 e1 (if &0 < z then r*z else z)))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e1]; ASSUME_TAC v_compat; TSPEC `(r_scale r)` 1; TYPE_THEN `v_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_v];ALL_TAC]; REWR 1; UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`z,&0`;`z,&1`])); REWRITE_TAC[r_scale_point]; ]);; (* }}} *) let hyperplane1_u_scale = prove_by_refinement( `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e1 z) = (hyperplane 2 e1 z))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e1]; ASSUME_TAC v_compat; TSPEC `(u_scale r)` 1; TYPE_THEN `v_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_v];ALL_TAC]; REWR 1; UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`])); REWRITE_TAC[u_scale_point]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC mk_line_2; REWRITE_TAC[REAL_ARITH `~(&0 < &0)`]; REWRITE_TAC[mk_line_hyper2_e1;]; REWRITE_TAC[GSYM line2D_F;e1;point_inj ]; CONJ_TAC; CONV_TAC (dropq_conv "p"); CONJ_TAC; CONV_TAC (dropq_conv "p"); RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]); UND 3 THEN UND 0 THEN REAL_ARITH_TAC; ]);; (* }}} *) let hyperplane2_u_scale = prove_by_refinement( `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e2 z) = (hyperplane 2 e2 (if &0 < z then r*z else z)))`, (* {{{ proof *) [ REWRITE_TAC[GSYM mk_line_hyper2_e2]; ASSUME_TAC h_compat; TSPEC `(u_scale r)` 1; TYPE_THEN `h_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_h];ALL_TAC]; REWR 1; UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`])); REWRITE_TAC[u_scale_point]; (* Thu Sep 9 14:04:58 EDT 2004 *) ]);; (* }}} *) let homeomorphism_compose = prove_by_refinement( `!U V W (f:A->B) (g:B->C). homeomorphism f U V /\ homeomorphism g V W ==> homeomorphism (g o f) U W`, (* {{{ proof *) [ REWRITE_TAC[homeomorphism]; SUBCONJ_TAC; REWRITE_TAC[comp_comp]; IMATCH_MP_TAC COMP_BIJ; UNIFY_EXISTS_TAC; (* - *) CONJ_TAC; IMATCH_MP_TAC continuous_comp; UNIFY_EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) REWRITE_TAC[IMAGE_o]; FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let hyperplane1_inj = prove_by_refinement( `!z w. (hyperplane 2 e1 z = hyperplane 2 e1 w) ==> (z = w)`, (* {{{ proof *) [ REWRITE_TAC[e1; GSYM line2D_F]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[]); TSPEC `point(z,&0)` 0; RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); USE 0 SYM; TYPE_THEN `(?p. (z,&0 = p) /\ (FST p = z))` SUBAGOAL_TAC; CONV_TAC (dropq_conv "p"); ASM_MESON_TAC[]; ]);; (* }}} *) let hyperplane2_inj = prove_by_refinement( `!z w. (hyperplane 2 e2 z = hyperplane 2 e2 w) ==> (z = w)`, (* {{{ proof *) [ REWRITE_TAC[e2; GSYM line2D_S]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[]); TSPEC `point(z,z)` 0; RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); USE 0 SYM; TYPE_THEN `(?p. (z,z = p) /\ (SND p = z))` SUBAGOAL_TAC; CONV_TAC (dropq_conv "p"); ASM_MESON_TAC[]; ]);; (* }}} *) let graph_support_init = prove_by_refinement( `!(G:(A,B)graph_t). (planar_graph G) /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = {}) /\ (!v. CARD (graph_edge_around G v) <=| 4) ==> (?H E. graph_isomorphic G H /\ (FINITE E) /\ (good_plane_graph H) /\ (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\ (!v. (graph_vertex H v ==> E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\ (!e. (E e ==> (?z. (&0 < z) /\ ((e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))))`, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC[`G`] graph_near_support; TYPE_THEN `EH = E INTER { h | ?z. (h = hyperplane 2 e1 z) }` ABBREV_TAC ; TYPE_THEN `EV = E INTER {h | ?z. (h = hyperplane 2 e2 z) }` ABBREV_TAC ; TYPE_THEN `E = EH UNION EV` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; TYPE_THEN `EH` UNABBREV_TAC; TYPE_THEN `EV` UNABBREV_TAC; REWRITE_TAC[SUBSET;INTER;UNION]; ASM_MESON_TAC[]; REWRITE_TAC[UNION;SUBSET]; TYPE_THEN `EH` UNABBREV_TAC; TYPE_THEN `EV` UNABBREV_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INTER;GSYM LEFT_AND_OVER_OR]); (* - *) TYPE_THEN `FINITE EH /\ FINITE EV` SUBAGOAL_TAC; USE 13 SYM; USE 13 (MATCH_MP union_imp_subset); ASM_MESON_TAC[FINITE_SUBSET]; (*** Modified by JRH for new theorem name TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE; ***) TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE_IMP; TYPE_THEN `EH` UNABBREV_TAC; REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV]; (*** Modified by JRH for new theorem name TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE; ***) TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE_IMP; TYPE_THEN `EV` UNABBREV_TAC; REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV]; (* - *) WITH 21 (MATCH_MP finite_LB); WITH 18 (MATCH_MP finite_LB); TYPE_THEN `f = (h_translate (&1 - t')) o (v_translate (&1 - t))` ABBREV_TAC ; TYPE_THEN `plane_graph_image f H` EXISTS_TAC; TYPE_THEN `IMAGE2 f E` EXISTS_TAC; (* A- *) TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC; TYPE_THEN `f` UNABBREV_TAC; IMATCH_MP_TAC homeomorphism_compose; TYPE_THEN `top2` EXISTS_TAC; REWRITE_TAC[v_translate_hom;h_translate_hom]; (* - *) TYPE_THEN `graph_isomorphic H (plane_graph_image f H)` SUBAGOAL_TAC; IMATCH_MP_TAC plane_graph_image_iso; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph]); (* - *) CONJ_TAC; TH_INTRO_TAC[`G`;`H`;`plane_graph_image f H`] graph_isomorphic_trans; (* - *) CONJ_TAC; REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[FINITE_UNION]; (* - *) CONJ_TAC; IMATCH_MP_TAC plane_graph_image_plane; (* B- *) TYPE_THEN `!z. IMAGE f (hyperplane 2 e1 z) = hyperplane 2 e1 (z - t' + &1)` SUBAGOAL_TAC; TYPE_THEN `f` UNABBREV_TAC; REWRITE_TAC[IMAGE_o;hyperplane1_v_translate;hyperplane1_h_translate]; AP_TERM_TAC; REAL_ARITH_TAC; TYPE_THEN `!z. IMAGE f (hyperplane 2 e2 z) = hyperplane 2 e2 (z - t + &1)` SUBAGOAL_TAC; TYPE_THEN `f` UNABBREV_TAC; REWRITE_TAC[IMAGE_o;hyperplane2_v_translate;hyperplane2_h_translate]; AP_TERM_TAC; REAL_ARITH_TAC; REWRITE_TAC[IMAGE2;GSYM image_unions;]; REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;IMAGE2]; (* - *) CONJ_TAC; TYPE_THEN `g = IMAGE f` ABBREV_TAC ; USE 29 (REWRITE_RULE[IMAGE]); TYPE_THEN `g` UNABBREV_TAC; IMATCH_MP_TAC IMAGE_SUBSET; USE 13 GSYM; FIRST_ASSUM IMATCH_MP_TAC ; (* C- *) USE 13 GSYM; CONJ_TAC; USE 29 (REWRITE_RULE[IMAGE]); TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); USE 31 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `v` UNABBREV_TAC; TYPE_THEN `f (point p) = point(FST p - t' + &1 , SND p - t + &1)` SUBAGOAL_TAC; TYPE_THEN `f` UNABBREV_TAC; TYPE_THEN `p = FST p,SND p` SUBAGOAL_TAC; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;]; PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;]; REWRITE_TAC[point_inj ;PAIR_SPLIT]; REAL_ARITH_TAC; USE 28 GSYM ; USE 27 GSYM; TSPEC `point p` 6; CONJ_TAC; IMATCH_MP_TAC image_imp; RULE_ASSUM_TAC (REWRITE_RULE[coord01]); IMATCH_MP_TAC image_imp; RULE_ASSUM_TAC (REWRITE_RULE[coord01]); (* D- *) TYPE_THEN `g = IMAGE f` ABBREV_TAC ; USE 29 (REWRITE_RULE[IMAGE]); TYPE_THEN `EH x \/ EV x` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; RULE_ASSUM_TAC (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `EH` UNABBREV_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INTER]); ASM_REWRITE_TAC[]; TYPE_THEN `z - t' + &1` EXISTS_TAC; TYPE_THEN `s' z` SUBAGOAL_TAC; USE 16 (REWRITE_RULE[SUBSET;IMAGE]); TSPEC `x` 16; REWR 16; LEFT 16 "z'"; TSPEC `z` 16; REWR 16; TYPE_THEN `z = x'` SUBAGOAL_TAC; IMATCH_MP_TAC hyperplane1_inj; ASM_REWRITE_TAC[]; TSPEC `z` 23; UND 23 THEN REAL_ARITH_TAC; TYPE_THEN `EV` UNABBREV_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INTER]); ASM_REWRITE_TAC[]; TYPE_THEN `z - t + &1` EXISTS_TAC; TYPE_THEN `s'' z` SUBAGOAL_TAC; USE 19 (REWRITE_RULE[SUBSET;IMAGE]); TSPEC `x` 19; REWR 19; LEFT 19 "z'"; TSPEC `z` 19; REWR 19; TYPE_THEN `z = x'` SUBAGOAL_TAC; IMATCH_MP_TAC hyperplane2_inj; ASM_REWRITE_TAC[]; TSPEC `z` 22; UND 22 THEN REAL_ARITH_TAC; (* Thu Sep 9 17:00:37 EDT 2004 *) ]);; (* }}} *) let hyperplane_ne = prove_by_refinement( `!z z'. ~(hyperplane 2 e1 z = hyperplane 2 e2 z')`, (* {{{ proof *) [ REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM line2D_F]; RULE_ASSUM_TAC (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `point(z, z'+ &1)` 0; REWR 0; RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;point_inj]); USE 0 SYM; TYPE_THEN `(?p. ((z = FST p) /\ (z' + &1 = SND p)) /\ (FST p = z))` SUBAGOAL_TAC; TYPE_THEN `(z,z' + &1)` EXISTS_TAC; ASSUME_TAC (REAL_ARITH `~(z' + &1 = z')`); ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION R *) (* ------------------------------------------------------------------ *) extend_simp_rewrites[UNION_EMPTY ];; let inductive_set_restrict = prove_by_refinement( `!G A S. inductive_set G S /\ ~(S INTER A = EMPTY) /\ segment A /\ A SUBSET G ==> inductive_set A (S INTER A)`, (* {{{ proof *) [ REWRITE_TAC[inductive_set]; CONJ_TAC; REWRITE_TAC[INTER;SUBSET]; REWRITE_TAC[INTER]; FIRST_ASSUM IMATCH_MP_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[INTER]); UNIFY_EXISTS_TAC; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let inductive_set_adj = prove_by_refinement( `!A B S m. inductive_set (A UNION B) S /\ (endpoint B m) /\ (FINITE A) /\ (FINITE B) /\ (endpoint A m) /\ (A SUBSET S) ==> (~(S INTER B = EMPTY)) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?e. A e /\ closure top2 e (pointI m)` SUBAGOAL_TAC; TYPE_THEN `terminal_edge A m` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; TYPE_THEN `?e'. B e' /\ closure top2 e' (pointI m)` SUBAGOAL_TAC; TYPE_THEN `terminal_edge B m` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; RULE_ASSUM_TAC (REWRITE_RULE[inductive_set]); TSPEC `e` 6; TSPEC `e'` 6; (* - *) TYPE_THEN `e = e'` ASM_CASES_TAC; TYPE_THEN `e'` UNABBREV_TAC; RULE_ASSUM_TAC (REWRITE_RULE[SUBSET ;EQ_EMPTY;INTER; ]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `S e /\ (A UNION B) e' /\ adj e e'` SUBAGOAL_TAC; CONJ_TAC; ASM_MESON_TAC[ISUBSET]; CONJ_TAC; REWRITE_TAC[UNION]; REWRITE_TAC[adj]; REWRITE_TAC[EMPTY_EXISTS;INTER;]; UNIFY_EXISTS_TAC; REWR 6; RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY ;INTER]); ASM_MESON_TAC[]; ]);; (* }}} *) let inductive_set_join = prove_by_refinement( `!A B S . ~(S INTER A = EMPTY) /\ (segment B) /\ (segment A) /\ (?m. endpoint A m /\ endpoint B m) /\ (inductive_set (A UNION B) S) ==> (S = (A UNION B))`, (* {{{ proof *) [ REP_BASIC_TAC; TH_INTRO_TAC[`A UNION B`;`A`;`S`] inductive_set_restrict; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `(S INTER A) = A` SUBAGOAL_TAC; USE 6 (REWRITE_RULE[inductive_set]); USE 3 (REWRITE_RULE[segment]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `A SUBSET S` SUBAGOAL_TAC; UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); REWRITE_TAC[INTER;SUBSET]; (* - *) TH_INTRO_TAC [`A`;`B`;`S`;`m`] inductive_set_adj; RULE_ASSUM_TAC (REWRITE_RULE[segment]); (* - *) TH_INTRO_TAC[`A UNION B`;`B`;`S`] inductive_set_restrict; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `(S INTER B) = B` SUBAGOAL_TAC; USE 10 (REWRITE_RULE[inductive_set]); USE 4 (REWRITE_RULE[segment]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `B SUBSET S` SUBAGOAL_TAC; UND 11 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); REWRITE_TAC[INTER;SUBSET]; IMATCH_MP_TAC SUBSET_ANTISYM; USE 0 (REWRITE_RULE[inductive_set]); REWRITE_TAC[union_subset]; ]);; (* }}} *) let segment_union = prove_by_refinement( `!A B m. segment A /\ segment B /\ endpoint A m /\ endpoint B m /\ (A INTER B = EMPTY) /\ (!n. (0 < num_closure A (pointI n)) /\ (0 < num_closure B (pointI n)) ==> (n = m) ) ==> segment (A UNION B)` , (* {{{ proof *) [ REP_BASIC_TAC; (* - *) TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); (* - *) REWRITE_TAC[segment]; ASM_REWRITE_TAC[FINITE_UNION]; (* - *) CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); UND 8 THEN REWRITE_TAC[EMPTY_EXISTS;UNION]; TYPE_THEN `u` EXISTS_TAC; (* - *) CONJ_TAC; REWRITE_TAC[union_subset]; RULE_ASSUM_TAC (REWRITE_RULE[segment]); (* - *) TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; TYPE_THEN `A x` ASM_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]); TSPEC `x` 1; REWR 1; TYPE_THEN `!m. num_closure(A UNION B) (pointI m) = num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC; REWRITE_TAC[num_closure]; IMATCH_MP_TAC (CARD_UNION); CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `A` EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); REWRITE_TAC[SUBSET]; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `B` EXISTS_TAC; REWRITE_TAC[SUBSET]; REWRITE_TAC[EQ_EMPTY ]; RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]); ASM_MESON_TAC[]; (* - *) CONJ_TAC; TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC; REDUCE_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC; REDUCE_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); UND 10 THEN UND 11 THEN REWRITE_TAC [ARITH_RULE `~(x = 0) <=> (0 < x)`]; TYPE_THEN `m' = m` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[endpoint]); REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT]; (* -A *) TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC; REWRITE_TAC[inductive_set]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC; (* -- cut here *) IMATCH_MP_TAC inductive_set_join; UNIFY_EXISTS_TAC; REWR 14; TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC; UND 15 THEN UND 14 THEN UND 11 THEN UND 12 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[]; (* - *) ONCE_REWRITE_TAC [UNION_COMM]; IMATCH_MP_TAC inductive_set_join; ONCE_REWRITE_TAC [UNION_COMM]; UNIFY_EXISTS_TAC; ]);; (* }}} *) let two_endpoint_segment = prove_by_refinement( `!C p q m. segment C /\ endpoint C q /\ endpoint C p /\ endpoint C m /\ ~(m = p) ==> (q = m) \/ (q = p)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `psegment C` SUBAGOAL_TAC; IMATCH_MP_TAC endpoint_psegment; UNIFY_EXISTS_TAC; (* - *) TH_INTRO_TAC[`C`] endpoint_size2; IMATCH_MP_TAC (TAUT `(~A ==> B) ==> (A \/ B)`); IMATCH_MP_TAC two_exclusion; UNIFY_EXISTS_TAC; ]);; (* }}} *) let EQ_ANTISYM = prove_by_refinement( `!A B. (A ==>B) /\ (B ==> A) ==> (A = B)`, (* {{{ proof *) [ MESON_TAC[]; ]);; (* }}} *) let segment_union2 = prove_by_refinement( `!A B m p. segment A /\ segment B /\ ~(m = p) /\ endpoint A m /\ endpoint B m /\ endpoint A p /\ endpoint B p /\ (A INTER B = EMPTY) /\ (!n. (0 < num_closure A (pointI n)) /\ (0 < num_closure B (pointI n)) <=> (((n = m ) \/ (n = p) ))) ==> rectagon (A UNION B)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); (* - *) REWRITE_TAC[rectagon]; ASM_REWRITE_TAC[FINITE_UNION]; (* - *) CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); UND 11 THEN REWRITE_TAC[EMPTY_EXISTS;UNION]; TYPE_THEN `u` EXISTS_TAC; (* - *) CONJ_TAC; REWRITE_TAC[union_subset]; RULE_ASSUM_TAC (REWRITE_RULE[segment]); (* - *) TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; TYPE_THEN `A x` ASM_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]); TSPEC `x` 1; REWR 1; (* - *) TYPE_THEN `!m. num_closure(A UNION B) (pointI m) = num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC; REWRITE_TAC[num_closure]; IMATCH_MP_TAC (CARD_UNION); CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `A` EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); REWRITE_TAC[SUBSET]; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `B` EXISTS_TAC; REWRITE_TAC[SUBSET]; REWRITE_TAC[EQ_EMPTY ]; RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `!q. endpoint A q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC; IMATCH_MP_TAC two_endpoint_segment; UNIFY_EXISTS_TAC; TYPE_THEN `!q. endpoint B q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC; IMATCH_MP_TAC two_endpoint_segment; TYPE_THEN `B` EXISTS_TAC; UNIFY_EXISTS_TAC; (* -A *) TYPE_THEN `!m. (num_closure A (pointI m) = 1) <=> (num_closure B (pointI m) = 1)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_ANTISYM; RULE_ASSUM_TAC (REWRITE_RULE[endpoint]); CONJ_TAC; TSPEC `m'` 13; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; TSPEC `m'` 14; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; FULL_REWRITE_TAC[endpoint]; TYPE_THEN `!x. {0, 2} x <=> {0, 1, 2} x /\ ~(x = 1)` SUBAGOAL_TAC; REWRITE_TAC[INSERT]; ARITH_TAC; KILL 16; TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC; REDUCE_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); TSPEC `m'` 15; REWR 25; UND 25 THEN ARITH_TAC; (* -- *) TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC; REDUCE_TAC; RULE_ASSUM_TAC (REWRITE_RULE[segment]); ARITH_TAC; FULL_REWRITE_TAC [ARITH_RULE `~(x = 0) <=> (0 < x)`]; TYPE_THEN `(m' = m) \/ (m' = p)` SUBAGOAL_TAC; TSPEC `m'` 0; REWR 0; TYPE_THEN `num_closure A (pointI m') = 1` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; TYPE_THEN `num_closure B (pointI m') = 1` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT;ARITH_RULE `~(2 = 1)`]; (* - *) TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC; REWRITE_TAC[inductive_set]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC; (* -- *) IMATCH_MP_TAC inductive_set_join; UNIFY_EXISTS_TAC; REWR 20; TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC; UND 20 THEN UND 21 THEN UND 17 THEN UND 18 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[]; (* - *) ONCE_REWRITE_TAC [UNION_COMM]; IMATCH_MP_TAC inductive_set_join; ONCE_REWRITE_TAC [UNION_COMM]; UNIFY_EXISTS_TAC; ]);; (* }}} *) let card_inj = prove_by_refinement( `!(f:A->B) A B. INJ f A B /\ FINITE B ==> (CARD A <= CARD B)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `CARD (IMAGE f A) = CARD A` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_IMAGE_INJ; CONJ_TAC; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC FINITE_INJ; ASM_MESON_TAC[]; USE 2 GSYM; IMATCH_MP_TAC CARD_SUBSET; RULE_ASSUM_TAC (REWRITE_RULE[INJ]); REWRITE_TAC[IMAGE;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let inj_bij_size = prove_by_refinement( `!A B (f:A->B). INJ f A B /\ B HAS_SIZE (CARD A) ==> BIJ f A B`, (* {{{ proof *) [ REWRITE_TAC[HAS_SIZE]; TH_INTRO_TAC [`f`;`A`] inj_bij; FULL_REWRITE_TAC[INJ]; ASM_MESON_TAC[]; TYPE_THEN `IMAGE f A = B` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET_EQ; CONJ_TAC; FULL_REWRITE_TAC[INJ]; REWRITE_TAC[IMAGE;SUBSET]; ASM_MESON_TAC[]; IMATCH_MP_TAC EQ_SYM; IMATCH_MP_TAC BIJ_CARD; UNIFY_EXISTS_TAC; ASM_MESON_TAC[FINITE_INJ]; ASM_MESON_TAC[]; ]);; (* }}} *) let bij_empty = prove_by_refinement( `!(f:A->B). BIJ f EMPTY EMPTY `, (* {{{ proof *) [ REWRITE_TAC[BIJ;INJ;SURJ]; ]);; (* }}} *) let bij_sing = prove_by_refinement( `!(f:A->B) a b. BIJ f {a} {b} <=> (f a = b)`, (* {{{ proof *) [ REWRITE_TAC[BIJ;INJ;SURJ;INR IN_SING ]; MESON_TAC[]; ]);; (* }}} *) let card_sing = prove_by_refinement( `!(a:A). (CARD {a} = 1)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`a`;`EMPTY:A->bool`] card_suc_insert; REWRITE_TAC[FINITE_RULES]; FULL_REWRITE_TAC[CARD_CLAUSES]; TYPE_THEN `CARD {a}` UNABBREV_TAC; ARITH_TAC; ]);; (* }}} *) let pair_indistinct = prove_by_refinement( `!(a:A). {a,a} = {a}`, (* {{{ proof *) [ MESON_TAC[INR ABSORPTION;INR COMPONENT]; ]);; (* }}} *) let has_size2_distinct = prove_by_refinement( `!(a:A) b. {a,b} HAS_SIZE 2 ==> ~(a = b)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `b` UNABBREV_TAC; FULL_REWRITE_TAC [pair_indistinct]; THM_INTRO_TAC[`a`] sing_has_size1; FULL_REWRITE_TAC[HAS_SIZE]; UND 0 THEN UND 2 THEN ARITH_TAC; ]);; (* }}} *) let has_size2_subset = prove_by_refinement( `!X (a:A) b. X HAS_SIZE 2 /\ X SUBSET {a,b} ==> (X = {a,b})`, (* {{{ proof *) [ REP_BASIC_TAC; FULL_REWRITE_TAC [has_size2]; TYPE_THEN `X` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; FULL_REWRITE_TAC[SUBSET;in_pair]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; COPY 0; TSPEC `b'` 0; TSPEC `a'` 3; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let inj_subset2 = prove_by_refinement( `!t t' s (f:A->B). INJ f s t /\ t SUBSET t' ==> INJ f s t'`, (* {{{ proof *) [ REWRITE_TAC[INJ;SUBSET;]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let terminal_adj = prove_by_refinement( `!E b. segment E /\ endpoint E b /\ ~(SING E) ==> (?!e. E e /\ adj (terminal_edge E b) e )`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[EXISTS_UNIQUE_ALT]; THM_INTRO_TAC[`E`;`b`] terminal_endpoint; FULL_REWRITE_TAC[segment]; (* - *) THM_INTRO_TAC[`terminal_edge E b`] two_endpoint; FULL_REWRITE_TAC[segment;ISUBSET]; (* - *) FULL_REWRITE_TAC[has_size2]; USE 6 (REWRITE_RULE[FUN_EQ_THM]); TYPE_THEN `?x. !y. (closure top2 (terminal_edge E b) (pointI y) <=> ((y = x) \/ (y = b)))` SUBAGOAL_TAC; USE 6 (REWRITE_RULE[in_pair]); REWRITE_TAC[in_pair]; TYPE_THEN `(b = b') \/ (b = a)` SUBAGOAL_TAC; ASM_MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `a` EXISTS_TAC; ASM_MESON_TAC[]; TYPE_THEN `b'` EXISTS_TAC; (* - *) TYPE_THEN `!e. (adj (terminal_edge E b) e /\ (E e) ==> (closure top2 e (pointI x)))` SUBAGOAL_TAC; THM_INTRO_TAC[`terminal_edge E b`;`e`] edge_inter; ASM_MESON_TAC[segment;ISUBSET]; FULL_REWRITE_TAC[INTER;eq_sing]; TSPEC `m` 7; REWR 7; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; FULL_REWRITE_TAC[endpoint]; THM_INTRO_TAC[`E`;`(pointI b)`] num_closure1; FULL_REWRITE_TAC[segment]; REWR 14; COPY 14; TSPEC `terminal_edge E b` 15; TSPEC `e` 14; TYPE_THEN `e' = terminal_edge E b` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e' = e` SUBAGOAL_TAC; ASM_MESON_TAC[]; FULL_REWRITE_TAC[adj]; UND 18 THEN UND 17 THEN UND 16 THEN MESON_TAC[]; (* - *) THM_INTRO_TAC[`E`;`terminal_edge E b`] midpoint_exists; FULL_REWRITE_TAC[SING]; LEFT 0 "x" ; TSPEC `terminal_edge E b` 0; ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[midpoint]; THM_INTRO_TAC[`E`;`(pointI m)`] num_closure2; FULL_REWRITE_TAC[segment]; REWR 11; (* -DD *) TYPE_THEN `?c. ~(terminal_edge E b = c) /\ (E c) /\ (closure top2 c (pointI m))` SUBAGOAL_TAC; COPY 12; TSPEC `terminal_edge E b` 11; REWR 11; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `b''` EXISTS_TAC; TYPE_THEN `a'` EXISTS_TAC; (* - *) TYPE_THEN `c` EXISTS_TAC; COPY 7; TSPEC `m` 16; REWR 16; TYPE_THEN `adj (terminal_edge E b) c` SUBAGOAL_TAC; REWRITE_TAC[adj]; REWRITE_TAC[EMPTY_EXISTS;INTER;]; TYPE_THEN `pointI m` EXISTS_TAC; (* - *) IMATCH_MP_TAC EQ_ANTISYM ; CONJ_TAC; TYPE_THEN `closure top2 y (pointI x)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `closure top2 c (pointI x)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; KILL 6; TYPE_THEN `closure top2 (terminal_edge E b) (pointI x)` SUBAGOAL_TAC; TYPE_THEN `({0,1,2} (num_closure E (pointI x)))` SUBAGOAL_TAC; UND 2 THEN MESON_TAC[segment]; FULL_REWRITE_TAC[INSERT;]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; THM_INTRO_TAC[`E`;`(pointI x)`] num_closure0; REWR 22; THM_INTRO_TAC[`E`;`(pointI x)`] num_closure1; THM_INTRO_TAC[`E`;`(pointI x)`] num_closure2; REWR 22; UND 22 THEN REP_CASES_TAC ; TYPE_THEN `(terminal_edge E b = a'') \/ (terminal_edge E b = b''')` SUBAGOAL_TAC; TSPEC `terminal_edge E b` 22; REWR 22; TYPE_THEN `(c = a'') \/ (c = b''')` SUBAGOAL_TAC; TSPEC `c` 22; REWR 22; TYPE_THEN `(y = a'') \/ (y = b''')` SUBAGOAL_TAC; TSPEC `y` 22; REWR 22; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `a''` UNABBREV_TAC; PROOF_BY_CONTR_TAC; REWR 29; TYPE_THEN `b'''` UNABBREV_TAC; USE 18(REWRITE_RULE[adj]); UND 29 THEN UND 15 THEN UND 28 THEN MESON_TAC[]; TYPE_THEN `b'''` UNABBREV_TAC; USE 18 (REWRITE_RULE[adj]); UND 31 THEN UND 15 THEN UND 29 THEN UND 28 THEN MESON_TAC[]; (* --- *) UND 20 THEN UND 21 THEN UND 14 THEN UND 19 THEN UND 22 THEN MESON_TAC[]; UND 22 THEN UND 19 THEN UND 20 THEN MESON_TAC[]; (* - *) TYPE_THEN `y` UNABBREV_TAC; ]);; (* }}} *) let psegment_order_induct_lemma = prove_by_refinement( `!n. !E a b. psegment E /\ (CARD E = n) /\ (endpoint E a) /\ (endpoint E b) /\ ~(a = b) ==> (?f. (BIJ f { p | p < n} E) /\ (f 0 = terminal_edge E a) /\ ((0 < n) ==> (f (n - 1) = terminal_edge E b)) /\ (!i j. (i < CARD E /\ j < CARD E) ==> (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))))`, (* {{{ proof *) [ INDUCT_TAC; (* -- 0 case *) TYPE_THEN `f = (\ (x:num). terminal_edge E a)` ABBREV_TAC ; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `{ p | p < 0} = EMPTY` SUBAGOAL_TAC; REWRITE_TAC[EQ_EMPTY]; UND 6 THEN ARITH_TAC; TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC; REWRITE_TAC[HAS_SIZE]; FULL_REWRITE_TAC[psegment;segment]; FULL_REWRITE_TAC[HAS_SIZE_0]; REWRITE_TAC[ARITH_RULE `~(k <| 0)`;bij_empty]; EXPAND_TAC "f"; (* - 1 case *) REWRITE_TAC[ARITH_RULE `0 <| SUC n /\ (SUC n - 1 = n)`]; TYPE_THEN `n = 0` ASM_CASES_TAC; KILL 5; REWRITE_TAC[ARITH_RULE `i <| SUC 0 <=> (i = 0)`;]; REWRITE_TAC[ARITH_RULE `~(SUC 0 = 0)`;adj]; TYPE_THEN `n` UNABBREV_TAC; FULL_REWRITE_TAC[ARITH_RULE `SUC 0 = 1`]; TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC; FULL_REWRITE_TAC[HAS_SIZE;psegment;segment]; USE 5(MATCH_MP CARD_SING_CONV); FULL_REWRITE_TAC[SING]; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `f = (\ (y:num). x )` ABBREV_TAC ; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `FINITE {x}` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment]; TYPE_THEN `{p | p = 0} = {0}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING]; KILL 7; TYPE_THEN `f 0 = x` SUBAGOAL_TAC; EXPAND_TAC "f"; REWRITE_TAC[bij_sing]; TH_INTRO_TAC[`{x}`;`a`] terminal_endpoint; TH_INTRO_TAC[`{x}`;`b`] terminal_endpoint; FULL_REWRITE_TAC[INR IN_SING]; (* - A2 and above *) TYPE_THEN `e = terminal_edge E b` ABBREV_TAC ; TYPE_THEN `b' = other_end e b` ABBREV_TAC ; TYPE_THEN `E' = E DELETE e` ABBREV_TAC ; (* - *) TYPE_THEN `E e /\ closure top2 e (pointI b)` SUBAGOAL_TAC; TYPE_THEN `e` UNABBREV_TAC; IMATCH_MP_TAC terminal_endpoint; RULE_ASSUM_TAC (REWRITE_RULE[psegment;segment]); (* - *) TYPE_THEN `psegment E'` SUBAGOAL_TAC; REWRITE_TAC[psegment]; CONJ_TAC; TYPE_THEN `E'` UNABBREV_TAC; IMATCH_MP_TAC segment_delete; TYPE_THEN `b` EXISTS_TAC; RULE_ASSUM_TAC (REWRITE_RULE[psegment]); REWRITE_TAC[]; TYPE_THEN `E` UNABBREV_TAC; THM_INTRO_TAC [`e`] sing_has_size1; RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); UND 12 THEN UND 3 THEN UND 6 THEN ARITH_TAC; THM_INTRO_TAC [`E'`;`E`] rectagon_subset; RULE_ASSUM_TAC (REWRITE_RULE[psegment]); TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[DELETE;SUBSET]; TYPE_THEN `E'` UNABBREV_TAC; UND 13 THEN UND 11 THEN MESON_TAC[INR DELETE_NON_ELEMENT]; (* - *) TYPE_THEN `SUC (CARD E') = SUC n` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; TYPE_THEN `SUC n` UNABBREV_TAC; IMATCH_MP_TAC CARD_SUC_DELETE; FULL_REWRITE_TAC[psegment;segment]; FULL_REWRITE_TAC[SUC_INJ]; (* -B *) THM_INTRO_TAC [`E`;`b`;`e`] psegment_delete_end; REWRITE_TAC[]; TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[card_sing]; UND 3 THEN UND 6 THEN ARITH_TAC; (* - *) TYPE_THEN `endpoint E' = {a,b'}` SUBAGOAL_TAC; IMATCH_MP_TAC has_size2_subset; CONJ_TAC; IMATCH_MP_TAC endpoint_size2; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[SUBSET;INSERT;DELETE]; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC [`E`;`x`;`a`;`b`] two_endpoint_segment; FULL_REWRITE_TAC[psegment]; ASM_MESON_TAC[]; THM_INTRO_TAC[`e`;`b`] other_end_prop; UND 4 THEN REWRITE_TAC[psegment;segment;SUBSET;]; (* - *) TYPE_THEN `{a,b'} HAS_SIZE 2` SUBAGOAL_TAC; TYPE_THEN `{a,b'}` UNABBREV_TAC; IMATCH_MP_TAC endpoint_size2; USE 16 (MATCH_MP has_size2_distinct); UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`a`;`b'`]); REWRITE_TAC[in_pair]; (* - *) TYPE_THEN `g = (\ i. if (i <| n) then f i else e)` ABBREV_TAC ; TYPE_THEN `!i. (i <| n) ==> (g i = f i)` SUBAGOAL_TAC; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `g n = e` SUBAGOAL_TAC; TYPE_THEN `g` UNABBREV_TAC; REWRITE_TAC[ARITH_RULE `~(n <| n)`]; TYPE_THEN `g` EXISTS_TAC; (* - FINAL PUSH *) SUBCONJ_TAC; IMATCH_MP_TAC inj_bij_size; REWRITE_TAC[CARD_NUMSEG_LT]; CONJ_TAC; TYPE_THEN `{p | p <| SUC n} = {p | p <| n} UNION {n}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING]; ARITH_TAC; IMATCH_MP_TAC inj_split; CONJ_TAC; TYPE_THEN `INJ g {p | p <| n} E = INJ f {p | p <| n} E` SUBAGOAL_TAC; IMATCH_MP_TAC inj_domain_sub; USE 24 (REWRITE_RULE[]); RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); (* --- temp *) IMATCH_MP_TAC inj_subset2; UNIFY_EXISTS_TAC; UND 9 THEN REWRITE_TAC[SUBSET;DELETE]; TYPE_THEN `E'` UNABBREV_TAC; CONJ_TAC; REWRITE_TAC[INJ;INR IN_SING;]; REP_BASIC_TAC; REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING ]; TYPE_THEN `x''` UNABBREV_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `g n` UNABBREV_TAC; TSPEC `x'` 21; TYPE_THEN `g x'` UNABBREV_TAC; FULL_REWRITE_TAC[BIJ;SURJ]; TSPEC `x'` 22; TYPE_THEN `E'` UNABBREV_TAC; FULL_REWRITE_TAC[DELETE]; ASM_MESON_TAC[]; UND 4 THEN ASM_REWRITE_TAC[HAS_SIZE;psegment;segment;rectagon]; (* - C*) TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[DELETE;SUBSET]; (* - *) TSPEC `0` 21; TYPE_THEN `0 <| n` SUBAGOAL_TAC; UND 6 THEN ARITH_TAC; TYPE_THEN `f 0` UNABBREV_TAC; CONJ_TAC; TYPE_THEN `e' = terminal_edge E' a` ABBREV_TAC ; THM_INTRO_TAC[`E'`;`a`;`e'`] terminal_unique; REWRITE_TAC[INR in_pair]; UND 12 THEN REWRITE_TAC[psegment;segment]; TYPE_THEN `e'` UNABBREV_TAC; TYPE_THEN `g 0 ` UNABBREV_TAC; THM_INTRO_TAC[`E`;`a`;`terminal_edge E' a`] terminal_unique; UND 4 THEN (REWRITE_TAC[psegment;segment]); REWR 26; ASM_MESON_TAC[ISUBSET]; (* -D *) TYPE_THEN `E' (terminal_edge E' b')` SUBAGOAL_TAC; THM_INTRO_TAC[`E'`;`b'`] terminal_endpoint; FULL_REWRITE_TAC[psegment;segment;INR in_pair ]; (* - *) TYPE_THEN `~(E' (terminal_edge E b))` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; FULL_REWRITE_TAC[DELETE]; TYPE_THEN `terminal_edge E b` UNABBREV_TAC; (* - *) TYPE_THEN `adj e (g (n - 1))` SUBAGOAL_TAC; TYPE_THEN `g (n - 1) = f (n-1 )` SUBAGOAL_TAC; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `n - 1 < n` SUBAGOAL_TAC; UND 21 THEN ARITH_TAC; TYPE_THEN `f (n - 1)` UNABBREV_TAC; TYPE_THEN `e` UNABBREV_TAC; REWRITE_TAC[adj]; REWRITE_TAC[INTER;EMPTY_EXISTS]; CONJ_TAC; TYPE_THEN `g n` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `pointI b'` EXISTS_TAC; CONJ_TAC; TYPE_THEN `b'` UNABBREV_TAC; THM_INTRO_TAC[`terminal_edge E b`;`b`]other_end_prop; FULL_REWRITE_TAC[psegment;segment;ISUBSET]; THM_INTRO_TAC [`E'`;`b'`] terminal_endpoint; FULL_REWRITE_TAC[psegment;segment;in_pair]; (* - *) TYPE_THEN `!i. (i <| SUC n) ==> (adj (g n) (g i) = (SUC i = n))` SUBAGOAL_TAC; TYPE_THEN `( i' = n) \/ (i' <| n)` SUBAGOAL_TAC; UND 30 THEN ARITH_TAC; FIRST_ASSUM DISJ_CASES_TAC; REWRITE_TAC[adj]; ARITH_TAC; (* -- *) THM_INTRO_TAC[`E`;`b`] terminal_adj; FULL_REWRITE_TAC[psegment]; REWRITE_TAC[]; USE 35 (MATCH_MP CARD_SING); TYPE_THEN `CARD E` UNABBREV_TAC; UND 3 THEN UND 21 THEN ARITH_TAC; FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT]; TYPE_THEN `!i'. (i' <| n) ==> (adj e (g i') = (e' = (g i')))` SUBAGOAL_TAC; TSPEC `g (i'')`33; TYPE_THEN `E (g i'')` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;SURJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 34 THEN ARITH_TAC; REWR 33; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `e'` UNABBREV_TAC; TSPEC `n - 1` 34; TYPE_THEN `n - 1 < n` SUBAGOAL_TAC; UND 21 THEN ARITH_TAC; TYPE_THEN `(g i' = g (n - 1)) ==> (SUC i' = n)` SUBAGOAL_TAC; FULL_REWRITE_TAC [BIJ;INJ]; IMATCH_MP_TAC (ARITH_RULE `((i' = n - 1) /\ (0 < n)) ==> (SUC i' = n)` ); FIRST_ASSUM IMATCH_MP_TAC ; ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWR 34; (* -- *) TYPE_THEN `i' = n - 1` SUBAGOAL_TAC; UND 35 THEN UND 21 THEN ARITH_TAC; TSPEC `i'` 34; TYPE_THEN `i'` UNABBREV_TAC; REWR 32; (* -E *) TYPE_THEN `(i = n) \/ (i <| n)` SUBAGOAL_TAC; UND 26 THEN ARITH_TAC; FIRST_ASSUM DISJ_CASES_TAC; TSPEC `j` 30; UND 30 THEN ARITH_TAC; (* - *) TYPE_THEN `(j = n) \/ (j <| n)` SUBAGOAL_TAC; UND 25 THEN ARITH_TAC; FIRST_ASSUM DISJ_CASES_TAC; ONCE_REWRITE_TAC [adj_symm]; UND 26 THEN ARITH_TAC; (* - *) TYPE_THEN `g` UNABBREV_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* a couple of variants *) let psegment_order = prove_by_refinement( `!E a b. psegment E /\ (endpoint E a) /\ (endpoint E b) /\ ~(a = b) ==> (?f. (BIJ f { p | p < CARD E} E) /\ (f 0 = terminal_edge E a) /\ ((0 < CARD E) ==> (f (CARD E - 1) = terminal_edge E b)) /\ (!i j. (i < CARD E /\ j < CARD E) ==> (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`CARD E`;`E`;`a`;`b`] psegment_order_induct_lemma; REWRITE_TAC[]; ]);; (* }}} *) let psegment_order' = prove_by_refinement( `!A m. psegment A /\ endpoint A m ==> (?f. BIJ f {p | p < CARD A} A /\ (f 0 = terminal_edge A m) /\ (!i j. (i < CARD A /\ j < CARD A) ==> (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`A`] endpoint_size2; FULL_REWRITE_TAC[has_size2]; TYPE_THEN `?n. (endpoint A n) /\ ~(m = n)` SUBAGOAL_TAC; REWR 0; FULL_REWRITE_TAC[in_pair]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; THM_INTRO_TAC[`A`;`m`;`n`] psegment_order; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let order_imp_psegment = prove_by_refinement( `!f n. (INJ f { p | p < n} (edge)) /\ (0 < n) /\ (!i j. (i < n /\ j < n) ==> (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))) ==> (psegment (IMAGE f { p | p < n}))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `E = IMAGE f {p | p <| n}` ABBREV_TAC ; IMATCH_MP_TAC endpoint_psegment; REWRITE_TAC[segment;]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; IMATCH_MP_TAC FINITE_IMAGE; REWRITE_TAC[FINITE_NUMSEG_LT]; (* - *) TYPE_THEN `~(E = {})` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[image_empty]; FULL_REWRITE_TAC[EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[IMAGE;INJ;SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) TYPE_THEN `E (f 0)` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC ; REWRITE_TAC[IMAGE]; TYPE_THEN `0` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `edge (f 0)` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; (* -A *) TYPE_THEN `?m. endpoint E m` SUBAGOAL_TAC; REWRITE_TAC[endpoint]; ASM_SIMP_TAC[num_closure1]; LEFT_TAC "e"; TYPE_THEN `f 0 ` EXISTS_TAC; THM_INTRO_TAC[`f 0`] two_endpoint; FULL_REWRITE_TAC[has_size2]; ASM_CASES_TAC `n =1`; TYPE_THEN `a` EXISTS_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `n` UNABBREV_TAC; FULL_REWRITE_TAC[IMAGE]; TYPE_THEN `(x' = 0) /\ (x = 0)` SUBAGOAL_TAC; UND 7 THEN UND 13 THEN ARITH_TAC; TYPE_THEN `e'` UNABBREV_TAC; USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `a` 10; FULL_REWRITE_TAC[in_pair]; (* -- *) TYPE_THEN `E (f 1)` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `1` EXISTS_TAC; UND 11 THEN UND 1 THEN ARITH_TAC; (* -- *) TYPE_THEN `edge (f 1)` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; (* -- *) TYPE_THEN `adj (f 0 ) (f 1)` SUBAGOAL_TAC; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`;`1`]); UND 11 THEN UND 1 THEN ARITH_TAC; ARITH_TAC; THM_INTRO_TAC[`f 0`;`f 1`] edge_inter; FULL_REWRITE_TAC[INTER;INR eq_sing ]; (* -- *) TYPE_THEN `?r. closure top2 (f 0) (pointI r) /\ ~(r = m)` SUBAGOAL_TAC; USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]); FULL_REWRITE_TAC[in_pair]; TYPE_THEN `m = a` ASM_CASES_TAC; TYPE_THEN `m` UNABBREV_TAC; TYPE_THEN `b` EXISTS_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `r` EXISTS_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN`?j. (j <| n) /\ (e' = f j)` SUBAGOAL_TAC; TYPE_THEN`E` UNABBREV_TAC; FULL_REWRITE_TAC[IMAGE]; TYPE_THEN`x` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `adj (f 0) (f j)` SUBAGOAL_TAC; REWRITE_TAC[adj;EMPTY_EXISTS;INTER ]; TYPE_THEN`pointI r` EXISTS_TAC; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[` 0`;` j`] ); REWR 0; TYPE_THEN `j = 1` SUBAGOAL_TAC; UND 0 THEN ARITH_TAC; TYPE_THEN `j` UNABBREV_TAC; TSPEC `pointI r` 15; REWR 15; FULL_REWRITE_TAC[pointI_inj]; ASM_MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; CONJ_TAC; UNIFY_EXISTS_TAC; (* -B *) TYPE_THEN `!e. (E e ==> ?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[IMAGE]; ASM_MESON_TAC[]; (* - *) CONJ_TAC; REWRITE_TAC[INSERT]; ASM_SIMP_TAC [num_closure0;num_closure1;num_closure2]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; LEFT 11 "e"; LEFT 12 "e"; TSPEC `e` 12; LEFT 12 "e'"; FULL_REWRITE_TAC[NOT_IMP]; TYPE_THEN `E e' /\ closure top2 e' (pointI m') /\ ~(e = e')` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `adj e e'` SUBAGOAL_TAC; REWRITE_TAC[adj;EMPTY_EXISTS;INTER;]; UNIFY_EXISTS_TAC; TYPE_THEN `(?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC; TYPE_THEN `(?j. (j <| n) /\ (e' = f j))` SUBAGOAL_TAC; TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `e'` UNABBREV_TAC; TYPE_THEN `(SUC i = j) \/ (SUC j = i)` SUBAGOAL_TAC; ASM_MESON_TAC[]; LEFT 13 "a"; TSPEC `f i` 13; LEFT 13 "b"; TSPEC `f j` 13; UND 13 THEN REWRITE_TAC[]; REWRITE_TAC[]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `?k. (k <| n) /\ (e'' = f k)` SUBAGOAL_TAC; TYPE_THEN `e''` UNABBREV_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; TYPE_THEN `adj (f i) (f k) /\ adj (f j) (f k)` SUBAGOAL_TAC; REWRITE_TAC[adj]; REWRITE_TAC[INTER;EMPTY_EXISTS]; LEFT_TAC "u"; UNIFY_EXISTS_TAC; TYPE_THEN `(SUC j = k) \/ (SUC k = j)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `(SUC i = k) \/ (SUC k = i)` SUBAGOAL_TAC; ASM_MESON_TAC[]; UND 29 THEN UND 28 THEN UND 19 THEN ARITH_TAC; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -C *) TYPE_THEN `X = {p | p <| n /\ S (f p)}` ABBREV_TAC ; TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET]; TYPE_THEN `E u` SUBAGOAL_TAC; TYPE_THEN `(?i. (i <| n) /\ (u = f i))` SUBAGOAL_TAC; TYPE_THEN `u` UNABBREV_TAC; UNDF `EMPTY` THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `X` UNABBREV_TAC; (* - *) TYPE_THEN `!j k. X j /\ (k <| n) /\ ((SUC j = k) \/ (SUC k = j)) ==> (X k)` SUBAGOAL_TAC; TYPE_THEN `j = k` ASM_CASES_TAC; ASM_MESON_TAC[]; TYPE_THEN `S (f j)` SUBAGOAL_TAC; TYPE_THEN `X` UNABBREV_TAC; TYPE_THEN `E (f k)` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `k` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `adj (f j) (f k)` SUBAGOAL_TAC; TYPE_THEN `X` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `S (f k)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `X` UNABBREV_TAC; (* - *) TYPE_THEN `(?i. X i /\ (!m. m <| i ==> ~X m))` SUBAGOAL_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[num_WOP]; TYPE_THEN `i = 0` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `?j. SUC j = i` SUBAGOAL_TAC; TYPE_THEN `i - 1` EXISTS_TAC; UND 19 THEN ARITH_TAC; TSPEC `j` 17; UND 17 THEN DISCH_THEN (THM_INTRO_TAC[]); UND 20 THEN ARITH_TAC; UND 17 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `X` UNABBREV_TAC; UND 17 THEN UND 20 THEN ARITH_TAC; TYPE_THEN `i` UNABBREV_TAC; (* -D *) TYPE_THEN `X = { p | p <| n }` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp_eq; CONJ_TAC; TYPE_THEN `X` UNABBREV_TAC; REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `Z = ({p | p <| n} DIFF X)` ABBREV_TAC ; TYPE_THEN `?n. Z n /\ (!m. m <| n ==> ~Z m)` SUBAGOAL_TAC; UND 19 THEN MESON_TAC[num_WOP]; TYPE_THEN `Z` UNABBREV_TAC; FULL_REWRITE_TAC[DIFF]; TSPEC `n' - 1` 21; TYPE_THEN `~(n' = 0)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `n' - 1 <| n'` SUBAGOAL_TAC; UND 24 THEN ARITH_TAC; TYPE_THEN `n' - 1 <| n` SUBAGOAL_TAC; UND 20 THEN ARITH_TAC; REWR 21; UND 19 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `n' - 1` EXISTS_TAC; UND 24 THEN ARITH_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; REWRITE_TAC[SUBSET]; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `X` UNABBREV_TAC; USE 20 (REWRITE_RULE[IMAGE]); USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x'` 19; FULL_REWRITE_TAC[]; REWR 19; ]);; (* }}} *) let rectagon_nonsing = prove_by_refinement( `!G. rectagon G ==> ~SING G`, (* {{{ proof *) [ REWRITE_TAC[rectagon;SING]; TYPE_THEN `G` UNABBREV_TAC; THM_INTRO_TAC [`x`] two_endpoint; FULL_REWRITE_TAC[SUBSET;INR IN_SING;]; FULL_REWRITE_TAC[has_size2]; USE 6 (ONCE_REWRITE_RULE [FUN_EQ_THM]); FULL_REWRITE_TAC[in_pair]; TSPEC `b` 6; REWR 6; TSPEC `b` 2; THM_INTRO_TAC[`{x}`;`pointI b`] num_closure0; FULL_REWRITE_TAC[INR IN_SING]; REWR 2; LEFT 2 "e" ; TSPEC `x` 2; REWR 2; THM_INTRO_TAC[`{x}`;`pointI b`] num_closure2; REWR 8; FULL_REWRITE_TAC[INR IN_SING]; ASM_MESON_TAC[]; ]);; (* }}} *) let rectagon_2 = prove_by_refinement( `!G S. rectagon G /\ S SUBSET G /\ ~(S = EMPTY) /\ (!m. {0,2} (num_closure S (pointI m))) ==> (S = G)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `Tx = { A | ~(A = EMPTY) /\ A SUBSET S /\ (!m. {0,2} (num_closure A (pointI m))) }` ABBREV_TAC ; TYPE_THEN `~(Tx = EMPTY)` SUBAGOAL_TAC; UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `S` EXISTS_TAC; TYPE_THEN `Tx` UNABBREV_TAC; REWRITE_TAC[SUBSET]; USE 5 (MATCH_MP select_card_min); (* - *) TYPE_THEN `z SUBSET G` SUBAGOAL_TAC; TYPE_THEN `Tx` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; (* - *) TYPE_THEN `(z = G) ==> (S = G)` SUBAGOAL_TAC; TYPE_THEN `Tx` UNABBREV_TAC; IMATCH_MP_TAC EQ_EXT; FULL_REWRITE_TAC [ISUBSET]; ASM_MESON_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; KILL 8; (* - *) IMATCH_MP_TAC rectagon_subset; TYPE_THEN `segment G` SUBAGOAL_TAC; IMATCH_MP_TAC rectagon_segment; (* - *) REWRITE_TAC[rectagon]; TYPE_THEN `Tx` UNABBREV_TAC; SUBCONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; FULL_REWRITE_TAC[rectagon]; CONJ_TAC; FULL_REWRITE_TAC[rectagon]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G` EXISTS_TAC; (* -A1 *) IMATCH_MP_TAC CARD_SUBSET_LE; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; KILL 5; KILL 0; TSPEC `m` 4; FULL_REWRITE_TAC[INSERT]; USE 0 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono; UND 4 THEN UND 5 THEN ARITH_TAC; KILL 0; (* - *) TYPE_THEN `~(num_closure S' (pointI m) = 1)` ASM_CASES_TAC; THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono; UND 5 THEN UND 0 THEN UND 4 THEN ARITH_TAC; REWR 0; (* - *) THM_INTRO_TAC[`S'`;`(pointI m)`] num_closure1; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; REWR 5; (* - *) THM_INTRO_TAC[`z`;`pointI m`] num_closure2; REWR 14; COPY 14; TSPEC `e` 16; COPY 5; TSPEC `e` 5; USE 5 (REWRITE_RULE[]); TYPE_THEN `z e` SUBAGOAL_TAC; FULL_REWRITE_TAC[ISUBSET]; TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILL 16; (* -B1 *) TYPE_THEN `?e'. (closure top2 e' (pointI m)) /\ z e' /\ ~(e = e')` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_MESON_TAC[]; TYPE_THEN `a` EXISTS_TAC; ASM_MESON_TAC[]; (* - *) UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`e`;`e'`]); REWRITE_TAC[adj;INTER;EMPTY_EXISTS;]; TYPE_THEN `pointI m` EXISTS_TAC; TSPEC `e'` 17 ; ASM_MESON_TAC[]; ]);; (* }}} *) let closure_imp_adj = prove_by_refinement( `!X Y m. (closure top2 X (pointI m) /\ closure top2 Y (pointI m) /\ ~(X = Y) ==> adj X Y)`, (* {{{ proof *) [ REWRITE_TAC[adj]; REWRITE_TAC[INTER;EMPTY_EXISTS]; UNIFY_EXISTS_TAC; ]);; (* }}} *) let inductive_set_endpoint = prove_by_refinement( `!G S. FINITE G /\ inductive_set G S ==> (endpoint S SUBSET endpoint G)`, (* {{{ proof *) [ REWRITE_TAC[inductive_set]; REWRITE_TAC[SUBSET;endpoint]; TYPE_THEN `FINITE S` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; THM_INTRO_TAC[`S`;`pointI x`] num_closure1; REWR 6; ASM_SIMP_TAC[num_closure1]; TYPE_THEN `e` EXISTS_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; COPY 6; TSPEC `e'` 6; TSPEC `e` 9; REWR 6; REWR 9; PROOF_BY_CONTR_TAC; UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`e`;`e'`]); IMATCH_MP_TAC closure_imp_adj; TYPE_THEN `x` EXISTS_TAC; ASM_MESON_TAC[]; (* - *) TYPE_THEN `e'` UNABBREV_TAC; TSPEC `e` 6; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let endpoint_closure = prove_by_refinement( `!e. (edge e) ==> (endpoint {e} = {m | closure top2 e (pointI m)})`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[endpoint]; THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1; REWRITE_TAC[FINITE_SING]; REWRITE_TAC[INR IN_SING]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `e = e'` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let rectagon_delete = prove_by_refinement( `!E e. (rectagon E) /\ (E e) ==> (psegment (E DELETE e))`, (* {{{ proof *) [ REWRITE_TAC[psegment]; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC; THM_INTRO_TAC[`E DELETE e`;`E`] rectagon_subset; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; REWRITE_TAC[DELETE;SUBSET]; ASM_MESON_TAC[INR DELETE_NON_ELEMENT]; (* - *) REWRITE_TAC[segment]; CONJ_TAC; FULL_REWRITE_TAC[rectagon]; REWRITE_TAC[FINITE_DELETE]; (* - *) SUBCONJ_TAC; FULL_REWRITE_TAC[delete_empty]; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 1 (MATCH_MP rectagon_nonsing); FULL_REWRITE_TAC[SING]; ASM_MESON_TAC[]; (* - *) SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `E` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[DELETE;SUBSET]; FULL_REWRITE_TAC[rectagon]; (* - *) SUBCONJ_TAC; THM_INTRO_TAC[`E DELETE e`;`E`;`pointI m`] num_closure_mono; FULL_REWRITE_TAC[rectagon;DELETE;SUBSET]; FULL_REWRITE_TAC[rectagon]; UND 5 THEN UND 4 THEN (REWRITE_TAC[INSERT]) ; TSPEC `m` 4; UND 4 THEN UND 5 THEN ARITH_TAC; (* -A *) TYPE_THEN `~S e` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET;DELETE]; ASM_MESON_TAC[]; TYPE_THEN `(e INSERT S = E) ==> (S = E DELETE e)` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC [DELETE_INSERT]; ASM_MESON_TAC[INR DELETE_NON_ELEMENT]; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; FULL_REWRITE_TAC[rectagon]; REWRITE_TAC[DELETE;SUBSET]; (* - *) THM_INTRO_TAC[`E DELETE e`;`S`] inductive_set_endpoint; REWRITE_TAC[inductive_set]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC rectagon_2; CONJ_TAC; REWRITE_TAC[INSERT_SUBSET]; UND 6 THEN REWRITE_TAC[SUBSET;DELETE]; (* - *) CONJ_TAC; FULL_REWRITE_TAC[EQ_EMPTY;INSERT;]; ASM_MESON_TAC[]; (* -B *) TYPE_THEN `e INSERT S SUBSET E` SUBAGOAL_TAC; UND 6 THEN REWRITE_TAC[INSERT;DELETE;SUBSET]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`e INSERT S`;`E`;`pointI m`] num_closure_mono; FULL_REWRITE_TAC[rectagon]; TYPE_THEN `~(num_closure (e INSERT S) (pointI m) = 1)` ASM_CASES_TAC; TYPE_THEN `S' = e INSERT S` ABBREV_TAC ; KILL 15; FULL_REWRITE_TAC[INSERT;rectagon]; TSPEC `m` 15; UND 15 THEN UND 14 THEN UND 13 THEN ARITH_TAC; REWR 14; PROOF_BY_CONTR_TAC; KILL 13; KILL 15; KILL 9; (* - *) TYPE_THEN `!A x. (A SUBSET E) /\ (num_closure A (pointI x) = 1) ==> (num_closure E (pointI x) = 2)` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; TSPEC `x` 15; USE 15 (REWRITE_RULE[INSERT]); FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`A`;`E`;`pointI x`] num_closure_mono; UND 20 THEN UND 19 THEN UND 9 THEN ARITH_TAC; (* - *) TYPE_THEN `endpoint (E DELETE e) SUBSET endpoint {e}` SUBAGOAL_TAC; REWRITE_TAC[SUBSET;endpoint]; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`E DELETE e`;`x`]); REWRITE_TAC[SUBSET;DELETE]; THM_INTRO_TAC[`E`;`pointI x`] num_closure2; FULL_REWRITE_TAC[rectagon]; REWR 15; THM_INTRO_TAC[`E DELETE e`;`pointI x`] num_closure1; REWR 17; USE 17 (REWRITE_RULE[DELETE]); THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1; REWRITE_TAC[FINITE_SING]; REWRITE_TAC[INR IN_SING]; TYPE_THEN `e` EXISTS_TAC; IMATCH_MP_TAC EQ_ANTISYM; REWRITE_TAC[]; TYPE_THEN `e''` UNABBREV_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `E a /\ closure top2 a (pointI x)` SUBAGOAL_TAC; TYPE_THEN `E b /\ closure top2 b (pointI x)` SUBAGOAL_TAC; TSPEC `e` 15; UND 15 THEN ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC ; USE 15 (REWRITE_RULE[DE_MORGAN_THM]); COPY 17; TSPEC `a` 17; TSPEC `b` 25; KILL 18; KILL 4; KILL 7; TYPE_THEN `e' = b` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILL 25; TYPE_THEN `e' = a` SUBAGOAL_TAC; ASM_MESON_TAC[]; UND 7 THEN UND 4 THEN UND 16 THEN MESON_TAC[]; (* -C *) TYPE_THEN `endpoint S SUBSET endpoint {e}` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; KILL 13; KILL 11; (* - *) THM_INTRO_TAC[`S`;`E`] endpoint_even; SUBCONJ_TAC; ASM_MESON_TAC[rectagon_segment]; SUBCONJ_TAC; UND 12 THEN REWRITE_TAC[INSERT;SUBSET] THEN MESON_TAC[]; THM_INTRO_TAC[`S`;`E`] rectagon_subset; TYPE_THEN `S` UNABBREV_TAC; UND 8 THEN REWRITE_TAC[]; (* - *) TYPE_THEN `X = {S' | ?e. S e /\ (S' = segment_of S e)}` ABBREV_TAC ; TYPE_THEN `FINITE X` SUBAGOAL_TAC; THM_INTRO_TAC[`segment_of S`;`S`] FINITE_IMAGE; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E DELETE e` EXISTS_TAC; TYPE_THEN `X = IMAGE (segment_of S) S` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; TYPE_THEN `X` UNABBREV_TAC; REWRITE_TAC[IMAGE]; ASM_REWRITE_TAC[]; TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC; USE 5 (REWRITE_RULE[EMPTY_EXISTS]); UND 17 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `segment_of S u` EXISTS_TAC; TYPE_THEN `X` UNABBREV_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[HAS_SIZE]; (* -D *) TYPE_THEN `edge e` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[ISUBSET]; THM_INTRO_TAC[`e`] endpoint_closure; THM_INTRO_TAC[`e`] two_endpoint; FULL_REWRITE_TAC[HAS_SIZE]; (* - *) TYPE_THEN `endpoint S = endpoint {e}` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET_LE; CONJ_TAC; ASM_MESON_TAC[]; IMATCH_MP_TAC (ARITH_RULE `~(CARD X = 0) ==> 2 <= 2 * CARD X`); TYPE_THEN `X HAS_SIZE 0` SUBAGOAL_TAC; ASM_REWRITE_TAC[HAS_SIZE]; FULL_REWRITE_TAC[HAS_SIZE_0]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`e INSERT S`;`pointI m`] num_closure1; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; FULL_REWRITE_TAC[rectagon]; REWR 24; USE 24 (REWRITE_RULE[INSERT]); TYPE_THEN `closure top2 e (pointI m)` ASM_CASES_TAC; TYPE_THEN `e' = e` SUBAGOAL_TAC; TSPEC `e` 24; ASM_MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; TYPE_THEN `endpoint S m` SUBAGOAL_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`S`;`m`]endpoint_edge; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E DELETE e` EXISTS_TAC ; FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT]; TSPEC `e''` 27; TSPEC `e''` 24; TYPE_THEN `e = e''` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e''` UNABBREV_TAC; KILL 9; KILL 20; KILL 7; ASM_MESON_TAC[]; (* - *) TYPE_THEN `~endpoint S m` SUBAGOAL_TAC; UND 26 THEN ASM_REWRITE_TAC[]; (* - *) USE 26 (REWRITE_RULE[endpoint]); THM_INTRO_TAC[`S`;`E`;`pointI m`] num_closure_mono; FULL_REWRITE_TAC[rectagon]; UND 6 THEN REWRITE_TAC[DELETE;SUBSET]; TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; TYPE_THEN `FINITE S` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET ; TYPE_THEN `E DELETE e` EXISTS_TAC; TYPE_THEN `~(num_closure S (pointI m) = 0)` SUBAGOAL_TAC; THM_INTRO_TAC[`S`;`pointI m`] num_closure0; REWR 30; TSPEC `e'` 30; COPY 24; TSPEC `e` 32; TSPEC `e'` 24; REWR 24; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; KILL 4; KILL 9; ASM_MESON_TAC[]; (* - *) USE 28 (REWRITE_RULE [INSERT]); USE 28 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); FIRST_ASSUM DISJ_CASES_TAC; UND 27 THEN UND 31 THEN UND 30 THEN ARITH_TAC; KILL 28; TYPE_THEN `num_closure S (pointI m) = 2` SUBAGOAL_TAC; UND 31 THEN UND 30 THEN UND 26 THEN UND 27 THEN ARITH_TAC; KILL 31; KILL 9; KILL 4; KILL 7; KILL 30; (* -E *) THM_INTRO_TAC[`S`;`pointI m`] num_closure2; REWR 4; TYPE_THEN `S a /\ closure top2 a (pointI m)` SUBAGOAL_TAC; TYPE_THEN `S b /\ closure top2 b (pointI m)` SUBAGOAL_TAC; KILL 4; TYPE_THEN `e' = a` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e' =b` SUBAGOAL_TAC; ASM_MESON_TAC[]; UND 7 THEN REWRITE_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; ]);; (* }}} *) let rectagon_adj = prove_by_refinement( `!E e f. (rectagon E) /\ E e /\ E f ==> (adj e f <=> (?a. endpoint (E DELETE e) a /\ (f = terminal_edge (E DELETE e) a)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[DELETE;SUBSET]; (* - *) IMATCH_MP_TAC EQ_ANTISYM; IMATCH_MP_TAC (TAUT `A /\ b ==> b /\ A`); CONJ_TAC; IMATCH_MP_TAC closure_imp_adj; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `f` UNABBREV_TAC; FULL_REWRITE_TAC[endpoint]; THM_INTRO_TAC[`E DELETE e`;`pointI a`] num_closure1; REWR 5; USE 5 (REWRITE_RULE[DELETE]); TYPE_THEN `{0,2} (num_closure E (pointI a))` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; USE 7 (REWRITE_RULE[INSERT]); FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`E`;`pointI a`] num_closure2; REWR 9; TYPE_THEN `E a' /\ closure top2 a' (pointI a)` SUBAGOAL_TAC; TYPE_THEN `E b /\ closure top2 b (pointI a)` SUBAGOAL_TAC; SUBCONJ_TAC; PROOF_BY_CONTR_TAC; TSPEC `e` 9; UND 9 THEN ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USE 9(REWRITE_RULE[DE_MORGAN_THM]); COPY 5; TSPEC `a'` 5; TSPEC `b` 17; TYPE_THEN `e' = b` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; ASM_MESON_TAC[]; THM_INTRO_TAC[`E DELETE e`;`a`]terminal_endpoint; REWRITE_TAC[endpoint]; UND 17 THEN REWRITE_TAC[DELETE] THEN MESON_TAC[]; (* -- case 0 *) THM_INTRO_TAC[`E`;`pointI a`] num_closure0; REWR 9; ASM_MESON_TAC[]; (* -A *) THM_INTRO_TAC[`e`;`f`] edge_inter; FULL_REWRITE_TAC[rectagon;ISUBSET]; FULL_REWRITE_TAC[INTER;INR eq_sing]; TYPE_THEN `m` EXISTS_TAC; SUBCONJ_TAC; REWRITE_TAC[endpoint]; THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1; KILL 9; TYPE_THEN `f` EXISTS_TAC; REWRITE_TAC[DELETE]; IMATCH_MP_TAC EQ_ANTISYM; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; TYPE_THEN `e''` UNABBREV_TAC; FULL_REWRITE_TAC[adj]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `{0, 2} (num_closure E (pointI m))` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[INSERT]; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`E`;`pointI m`]num_closure2; REWR 14; PROOF_BY_CONTR_TAC; COPY 14; COPY 14; TSPEC `e` 14; TSPEC `f` 18; TSPEC `e''` 17; KILL 13; KILL 12; KILL 6; TYPE_THEN `e'' = a` ASM_CASES_TAC ; TYPE_THEN `e''` UNABBREV_TAC; TYPE_THEN `(f = b)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `f` UNABBREV_TAC; TYPE_THEN `e = b` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e` UNABBREV_TAC; FULL_REWRITE_TAC[adj]; TYPE_THEN `e'' = b` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e''` UNABBREV_TAC; TYPE_THEN `f = a` SUBAGOAL_TAC; KILL 14; ASM_MESON_TAC[]; TYPE_THEN `f` UNABBREV_TAC ; FULL_REWRITE_TAC[adj]; ASM_MESON_TAC[]; (* -- 0 case -- *) THM_INTRO_TAC[`E`;`pointI m`] num_closure0; REWR 14; KILL 6; ASM_MESON_TAC[]; (* -B *) THM_INTRO_TAC[`E DELETE e`;`m`;`f`] terminal_unique; USE 10 (ONCE_REWRITE_RULE [EQ_SYM_EQ]); ASM_REWRITE_TAC[DELETE]; ASM_MESON_TAC[adj]; ]);; (* }}} *) let rectagon_delete_end = prove_by_refinement( `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==> endpoint (E DELETE e ) m`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; REWRITE_TAC[DELETE;SUBSET]; THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1; KILL 5; REWRITE_TAC[DELETE]; (* - *) TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[INSERT]; (* - *) FIRST_ASSUM DISJ_CASES_TAC; KILL 5; THM_INTRO_TAC[`E`;`pointI m`] num_closure2; REWR 5; TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `?c. (E c /\ ~(c = e) /\ closure top2 c (pointI m)) /\ (!e'. E e' /\ closure top2 e' (pointI m) <=> (e' = e) \/ (e' = c))` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_MESON_TAC[]; TYPE_THEN `a` EXISTS_TAC; ASM_MESON_TAC[]; TYPE_THEN `c` EXISTS_TAC; TYPE_THEN `c = e''` ASM_CASES_TAC; TYPE_THEN `e''` UNABBREV_TAC; PROOF_BY_CONTR_TAC; REWR 14; KILL 5; TSPEC `e''` 9; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`E`;`pointI m`] num_closure0; REWR 7; ASM_MESON_TAC[]; ]);; (* }}} *) let rectagon_order = prove_by_refinement( `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==> (?f. BIJ f { p | p < CARD E } E /\ (f (CARD E - 1) = e) /\ (closure top2 (f 0) (pointI m)) /\ (!i j. (i < CARD E /\ j < CARD E) ==> (adj (f i) (f j) <=> ((SUC i = j) \/ (SUC j = i) \/ ((i = 0) /\ (j = (CARD E -1))) \/ ((i = CARD E -1) /\ (j = 0))))))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`;`e`] rectagon_delete; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; REWRITE_TAC[DELETE;SUBSET]; TYPE_THEN `endpoint (E DELETE e) m` SUBAGOAL_TAC; IMATCH_MP_TAC rectagon_delete_end; (* - *) TYPE_THEN `?n. (endpoint (E DELETE e) n) /\ ~(n = m)` SUBAGOAL_TAC; THM_INTRO_TAC[`E DELETE e`] endpoint_size2; FULL_REWRITE_TAC[has_size2]; TYPE_THEN `m = a` ASM_CASES_TAC ; TYPE_THEN `b` EXISTS_TAC; REWRITE_TAC[INR in_pair]; TYPE_THEN `a` EXISTS_TAC; REWRITE_TAC[INR in_pair]; (* - *) THM_INTRO_TAC[`E DELETE e`;`m`;`n`] psegment_order; THM_INTRO_TAC[`e`;`E`;] CARD_SUC_DELETE; TYPE_THEN `~(CARD E = 0)` SUBAGOAL_TAC; TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC; REWRITE_TAC[HAS_SIZE]; FULL_REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY]; ASM_MESON_TAC[]; TYPE_THEN `CARD (E DELETE e) = CARD (E) - 1` SUBAGOAL_TAC; UND 14 THEN UND 13 THEN ARITH_TAC; (* - *) TYPE_THEN `g = \ (i:num). if (i < CARD E - 1) then f i else e` ABBREV_TAC ; TYPE_THEN `(g (CARD E - 1) = e)` SUBAGOAL_TAC; TYPE_THEN `g` UNABBREV_TAC; REWRITE_TAC[ARITH_RULE `~(x <| x)`]; TYPE_THEN `(!i. (i < CARD E -| 1) ==> (g i = f i))` SUBAGOAL_TAC; TYPE_THEN `g` UNABBREV_TAC; KILL 16; TYPE_THEN `g` EXISTS_TAC; (* -A *) TYPE_THEN `{p | p < CARD E - 1} UNION {(CARD E - 1)} = {p | p <| CARD E}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING ]; UND 14 THEN ARITH_TAC; (* - *) SUBCONJ_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; USE 16 (SYM); IMATCH_MP_TAC inj_split; CONJ_TAC; FULL_REWRITE_TAC[BIJ;INJ]; TYPE_THEN `CARD (E DELETE e)` UNABBREV_TAC; CONJ_TAC; UND 20 THEN REWRITE_TAC[DELETE] THEN UND 15 THEN MESON_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; UND 15 THEN UND 21 THEN UND 22 THEN UND 18 THEN MESON_TAC[]; CONJ_TAC; REWRITE_TAC[INJ;INR IN_SING ]; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING ]; TYPE_THEN `x` UNABBREV_TAC ; TYPE_THEN `x''` UNABBREV_TAC; REWR 19; TYPE_THEN `g x' = f x'` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `g x'` UNABBREV_TAC; FULL_REWRITE_TAC[BIJ;INJ]; TYPE_THEN `CARD(E DELETE e)` UNABBREV_TAC; USE 21(REWRITE_RULE[DELETE]); ASM_MESON_TAC[]; (* -- SURJ -- *) REWRITE_TAC[SURJ]; USE 19 (REWRITE_RULE[INJ]); REWRITE_TAC[]; TYPE_THEN `x = e` ASM_CASES_TAC; TYPE_THEN `CARD E - 1` EXISTS_TAC; UND 14 THEN ARITH_TAC; TYPE_THEN `(E DELETE e) x` SUBAGOAL_TAC; ASM_REWRITE_TAC[DELETE]; FULL_REWRITE_TAC[BIJ;SURJ]; TSPEC `x` 12; REWR 12; TYPE_THEN `y` EXISTS_TAC; CONJ_TAC; UND 26 THEN ARITH_TAC; (* -B *) TYPE_THEN `~(SING E)` SUBAGOAL_TAC; FULL_REWRITE_TAC[SING]; TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[INR IN_SING]; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[psegment;segment]; FULL_REWRITE_TAC[EMPTY_EXISTS]; UND 22 THEN ASM_REWRITE_TAC[DELETE;INR IN_SING]; ASM_MESON_TAC[]; TYPE_THEN `~(CARD E = 1)` SUBAGOAL_TAC; TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC; ASM_REWRITE_TAC[HAS_SIZE]; ASM_MESON_TAC[CARD_SING_CONV]; (* - *) TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC; UND 21 THEN UND 14 THEN ARITH_TAC; COPY 18 ; TSPEC `0` 23; (* - *) SUBCONJ_TAC; THM_INTRO_TAC[`E DELETE e`;`m`]terminal_endpoint; (* -C *) UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]); ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `CARD (E DELETE e) - 1 = CARD E - 2` SUBAGOAL_TAC; UND 23 THEN ARITH_TAC; REWR 10; (* - *) TYPE_THEN `!k. endpoint (E DELETE e) k ==> (k = n) \/ (k = m)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; USE 29 (REWRITE_RULE[DE_MORGAN_THM]); THM_INTRO_TAC[`E DELETE e`] endpoint_size2; THM_INTRO_TAC[`endpoint(E DELETE e)`;`n`;`m`;`k`]two_exclusion; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!j. (j <| CARD E - 1) ==> (adj e (g j) <=> (j = 0) \/ (j = CARD E - 2))` SUBAGOAL_TAC; THM_INTRO_TAC[`E`;`e`;`g j'`] rectagon_adj; TSPEC `j'` 18; TYPE_THEN `f j'` UNABBREV_TAC; USE 19 (REWRITE_RULE[BIJ;SURJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 29 THEN ARITH_TAC; (* -- *) IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`j'`]); TYPE_THEN `g j'` UNABBREV_TAC; REWR 30; TSPEC `a` 28; FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `a` UNABBREV_TAC; DISJ2_TAC; TYPE_THEN `f j' = f (CARD E -| 2)` SUBAGOAL_TAC; USE 12(REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 29 THEN UND 23 THEN ARITH_TAC; TYPE_THEN `a` UNABBREV_TAC; DISJ1_TAC; TYPE_THEN `f j' = f 0` SUBAGOAL_TAC; USE 12 (REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* -- *) FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`E`;`e`;`f 0`] rectagon_adj; TYPE_THEN `terminal_edge (E DELETE e) m` UNABBREV_TAC; USE 22 SYM; USE 19 (REWRITE_RULE[BIJ;SURJ]); TSPEC `0` 22; FIRST_ASSUM IMATCH_MP_TAC ; UND 23 THEN ARITH_TAC; ASM_MESON_TAC[]; (* -- *) ASM_REWRITE_TAC[]; THM_INTRO_TAC[`E`;`e`;`f (CARD E - 2)`] rectagon_adj; TYPE_THEN `terminal_edge (E DELETE e) n` UNABBREV_TAC; UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`CARD E -2`]); UND 23 THEN ARITH_TAC; USE 10 GSYM; USE 19 (REWRITE_RULE[BIJ;SURJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 23 THEN ARITH_TAC; REWR 33; TYPE_THEN `n` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `i = CARD E - 1` ASM_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[adj]; UND 32 THEN UND 23 THEN ARITH_TAC; UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`j`]); UND 31 THEN UND 24 THEN ARITH_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `j` UNABBREV_TAC; DISJ2_TAC; DISJ1_TAC; UND 23 THEN ARITH_TAC; UND 32 THEN REP_CASES_TAC; TYPE_THEN `j` UNABBREV_TAC; UND 24 THEN ARITH_TAC; DISJ2_TAC; UND 32 THEN UND 23 THEN ARITH_TAC; (* - *) TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC [adj_symm]; UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); UND 30 THEN UND 25 THEN ARITH_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC ; UND 23 THEN ARITH_TAC; UND 32 THEN REP_CASES_TAC; UND 32 THEN UND 23 THEN ARITH_TAC; TYPE_THEN `i` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 25 THEN ARITH_TAC; (* - *) TYPE_THEN `i < CARD E - 1 /\ j < CARD E - 1` SUBAGOAL_TAC; UND 31 THEN UND 30 THEN UND 24 THEN UND 25 THEN ARITH_TAC; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let order_imp_psegment_shift = prove_by_refinement( `! f m n. INJ f { p | m <= p /\ p < n} edge /\ m <| n /\ (! i j. m <= i /\ i < n /\ m <= j /\ j < n ==> (adj (f i) (f j) <=> (SUC i = j) \/ (SUC j = i))) ==> psegment (IMAGE f {p | m <= p /\ p < n})`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `g = \ (i: num). f (i + m)` ABBREV_TAC ; TYPE_THEN `IMAGE f {p | m <=| p /\ p < n} = IMAGE g {p | p < n - m}` SUBAGOAL_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `x' -| m` EXISTS_TAC; CONJ_TAC; UND 5 THEN UND 6 THEN ARITH_TAC; AP_TERM_TAC; UND 6 THEN ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `x' +| m` EXISTS_TAC; UND 5 THEN UND 1 THEN ARITH_TAC; IMATCH_MP_TAC order_imp_psegment; (* - *) SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; TYPE_THEN`g`UNABBREV_TAC; FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 5 THEN UND 1 THEN ARITH_TAC; TYPE_THEN `g` UNABBREV_TAC; IMATCH_MP_TAC (ARITH_RULE `((x +| m) = (y + m)) ==> (x = y)`); FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC; (* - *) CONJ_TAC; UND 1 THEN ARITH_TAC; TYPE_THEN `g` UNABBREV_TAC; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i +| m`;`j +| m`]); UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC; REWRITE_TAC[ARITH_RULE `(SUC(i + m) = (j +| m)) <=> (SUC i = j)`]; ]);; (* }}} *) let cls = jordan_def `cls E = {m | ?e. E e /\ closure top2 e (pointI m)}`;; let cls_edge = prove_by_refinement( `!e. (cls {e} = {m | closure top2 e (pointI m)})`, (* {{{ proof *) [ REWRITE_TAC[cls;INR IN_SING ;]; IMATCH_MP_TAC EQ_EXT; MESON_TAC[]; ]);; (* }}} *) let cls_inj_lemma_v = prove_by_refinement( `!m n. (cls {(v_edge m)} = cls {(v_edge n)}) ==> (m = n)`, (* {{{ proof *) [ REWRITE_TAC[cls_edge;INR IN_SING;]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INR IN_SING]); FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT]; SUBCONJ_TAC; TSPEC `m` 0; ASM_MESON_TAC[]; TYPE_THEN `FST n` UNABBREV_TAC; COPY 0; TSPEC `m` 1; TSPEC `(FST m, SND n)` 0; REWR 0; REWR 1; UND 0 THEN UND 1 THEN INT_ARITH_TAC; ]);; (* }}} *) let cls_inj_lemma_h = prove_by_refinement( `!m n. (cls {(h_edge m)} = cls {(h_edge n)}) ==> (m = n)`, (* {{{ proof *) [ REWRITE_TAC[cls_edge;INR IN_SING;]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INR IN_SING]); FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT]; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); SUBCONJ_TAC; TSPEC `m` 0; ASM_MESON_TAC[]; TYPE_THEN `SND n` UNABBREV_TAC; COPY 0; TSPEC `m` 1; TSPEC `(FST n, SND m)` 0; REWR 0; REWR 1; UND 0 THEN UND 1 THEN INT_ARITH_TAC; ]);; (* }}} *) let cls_inj_lemma_hv = prove_by_refinement( `!m n. ~(cls {(h_edge m)} = cls {(v_edge n)})` , (* {{{ proof *) [ REWRITE_TAC[cls_edge;]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INR IN_SING]); FULL_REWRITE_TAC[v_edge_closure;vc_edge;h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT]; COPY 0; TSPEC `n` 0; TSPEC `(FST n, SND n +: &:1)` 1; REWR 0; REWR 1; TYPE_THEN `SND n = SND m` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `SND m` UNABBREV_TAC; UND 1 THEN INT_ARITH_TAC; ]);; (* }}} *) let cls_inj = prove_by_refinement( `!e f . (edge e /\ edge f /\ (cls {e} = cls {f}) ==> (e = f))`, (* {{{ proof *) [ REWRITE_TAC[edge]; JOIN 1 2 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; UND 1 THEN REP_CASES_TAC THEN REWR 0 THEN REWRITE_TAC[v_edge_inj;h_edge_inj]; IMATCH_MP_TAC cls_inj_lemma_v; ASM_MESON_TAC[cls_inj_lemma_hv]; ASM_MESON_TAC[cls_inj_lemma_hv]; IMATCH_MP_TAC cls_inj_lemma_h; ]);; (* }}} *) let adjv = jordan_def `adjv e f = @m. (closure top2 e (pointI m)) /\ (closure top2 f (pointI m))` ;; let adjv_adj = prove_by_refinement( `!e f. edge e /\ edge f /\ adj e f ==> closure top2 e (pointI (adjv e f))`, (* {{{ proof *) [ REWRITE_TAC[adjv]; SELECT_TAC ; THM_INTRO_TAC[`e`;`f`] edge_inter; FULL_REWRITE_TAC [INTER;INR eq_sing;]; ASM_MESON_TAC[]; ]);; (* }}} *) let adjv_adj2 = prove_by_refinement( `!e f. edge e /\ edge f /\ adj e f ==> closure top2 f (pointI (adjv e f))`, (* {{{ proof *) [ REWRITE_TAC[adjv]; SELECT_TAC ; THM_INTRO_TAC[`e`;`f`] edge_inter; FULL_REWRITE_TAC [INTER;INR eq_sing;]; ASM_MESON_TAC[]; ]);; (* }}} *) let has_size2_pair = prove_by_refinement( `!(X:A->bool) a b. (X HAS_SIZE 2) /\ X a /\ X b /\ ~(a = b) ==> (X = {a,b})`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC CARD_SUBSET_EQ; FULL_REWRITE_TAC[HAS_SIZE]; REWRITE_TAC[SUBSET;INR in_pair]; ASM_MESON_TAC[pair_size_2;HAS_SIZE]; ]);; (* }}} *) let adjv_unique = prove_by_refinement( `!e f n. edge e /\ edge f /\ adj e f /\ closure top2 e (pointI n) /\ closure top2 f (pointI n) ==> (n = adjv e f)`, (* {{{ proof *) [ REWRITE_TAC[adjv]; SELECT_TAC; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`e`] two_endpoint; THM_INTRO_TAC[`f`] two_endpoint; THM_INTRO_TAC[ `{m | closure top2 f (pointI m)}`;`n`;`t`] has_size2_pair; ASM_REWRITE_TAC[]; THM_INTRO_TAC[ `{m | closure top2 e (pointI m)}`;`n`;`t`] has_size2_pair; ASM_REWRITE_TAC[]; TYPE_THEN `cls {e} = cls {f}` SUBAGOAL_TAC; REWRITE_TAC[cls_edge;INR IN_SING ]; THM_INTRO_TAC[`e`;`f`] cls_inj; TYPE_THEN`f` UNABBREV_TAC; FULL_REWRITE_TAC[adj]; (* - *) ASM_MESON_TAC[]; ]);; (* }}} *) let adjv_symm = prove_by_refinement( `!e f. edge e /\ edge f /\ adj e f ==> (adjv f e = adjv e f)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC adjv_unique; THM_INTRO_TAC[`f`;`e`] adjv_adj; ASM_MESON_TAC[adj_symm]; THM_INTRO_TAC[`f`;`e`] adjv_adj2; ASM_MESON_TAC[adj_symm]; ]);; (* }}} *) let adjv_segment = prove_by_refinement( `!E e f. segment E /\ E e /\ E f /\ adj e f ==> ({C| E C /\ closure top2 C (pointI (adjv e f))} = {e,f} ) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC has_size2_pair; TYPE_THEN `~(e = f)` SUBAGOAL_TAC; FULL_REWRITE_TAC[adj]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `edge e /\ edge f` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment;ISUBSET]; (* - *) TYPE_THEN `closure top2 e (pointI (adjv e f))` SUBAGOAL_TAC; IMATCH_MP_TAC adjv_adj; TYPE_THEN `closure top2 f (pointI (adjv e f))` SUBAGOAL_TAC; IMATCH_MP_TAC adjv_adj2; (* - *) TYPE_THEN `{0,1,2} (num_closure E (pointI (adjv e f)))` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; FULL_REWRITE_TAC[INSERT]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; UND 9 THEN REP_CASES_TAC; THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure_size; REWR 11; (* -- *) THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure1; REWR 11; COPY 11; TSPEC `f` 11; TSPEC `e` 12; REWR 11; REWR 12; (* - *) THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure0; REWR 11; TSPEC `e` 11; ASM_MESON_TAC[]; ]);; (* }}} *) let num_closure_elt = prove_by_refinement( `!S m. (0 <| num_closure S m) ==> (?e. S e /\ closure top2 e m)`, (* {{{ proof *) [ REWRITE_TAC[num_closure]; TYPE_THEN `~({C | S C /\ closure top2 C m} = EMPTY)` SUBAGOAL_TAC; REWR 0; FULL_REWRITE_TAC[CARD_CLAUSES]; UND 0 THEN ARITH_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; UNIFY_EXISTS_TAC; ]);; (* }}} *) (* I shouldn't need three minor variations of the same thing here, but here they are *) let rectagon_subset_endpoint = prove_by_refinement( `!E S k. rectagon E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\ (0 <| num_closure (E DIFF S) (pointI k)) ==> (endpoint S k)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono; TYPE_THEN `{0,2} (num_closure E (pointI k))` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[INSERT]; (* - *) FIRST_ASSUM DISJ_CASES_TAC ; PROOF_BY_CONTR_TAC; TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC; REWR 5; UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC; TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET_EQ; USE 9 (REWRITE_RULE[num_closure]); USE 7 (REWRITE_RULE[num_closure]); CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET;]; REWRITE_TAC[SUBSET;]; FULL_REWRITE_TAC[ISUBSET]; (* -- *) USE 0 (REWRITE_RULE[num_closure]); USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`)); TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC; REWRITE_TAC[EQ_EMPTY ]; USE 12 (REWRITE_RULE[DIFF]); USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]); TSPEC `x` 10; REWR 10; UND 0 THEN ASM_REWRITE_TAC[]; REWRITE_TAC[CARD_CLAUSES]; UND 7 THEN UND 5 THEN UND 1 THEN ARITH_TAC; ]);; (* }}} *) let psegment_subset_endpoint = prove_by_refinement( `!E S k. psegment E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\ (0 <| num_closure (E DIFF S) (pointI k)) ==> (endpoint S k)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment]; THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono; TYPE_THEN `{0,1,2} (num_closure E (pointI k))` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment]; FULL_REWRITE_TAC[INSERT]; (* - *) FULL_REWRITE_TAC[DISJ_ACI]; FIRST_ASSUM DISJ_CASES_TAC ; PROOF_BY_CONTR_TAC; TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC; REWR 5; UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC; TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET_EQ; USE 9 (REWRITE_RULE[num_closure]); USE 7 (REWRITE_RULE[num_closure]); CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET;]; REWRITE_TAC[SUBSET;]; FULL_REWRITE_TAC[ISUBSET]; (* -- *) USE 0 (REWRITE_RULE[num_closure]); USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`)); TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC; REWRITE_TAC[EQ_EMPTY ]; USE 12 (REWRITE_RULE[DIFF]); USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]); TSPEC `x` 10; REWR 10; UND 0 THEN ASM_REWRITE_TAC[]; REWRITE_TAC[CARD_CLAUSES]; (* - *) KILL 6; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`E`;`pointI k`] num_closure1; REWR 8; USE 0 (MATCH_MP num_closure_elt); FULL_REWRITE_TAC[DIFF]; USE 1 (MATCH_MP num_closure_elt); COPY 8; TSPEC `e'` 12; TSPEC `e''` 8; FULL_REWRITE_TAC[ISUBSET]; ASM_MESON_TAC[]; (* - *) UND 6 THEN UND 5 THEN UND 1 THEN ARITH_TAC; ]);; (* }}} *) let num_closure_pos = prove_by_refinement( `!G m. FINITE G /\ (?e. G e /\ closure top2 e (pointI m)) ==> (0 <| (num_closure G (pointI m)))`, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC ; TYPE_THEN `num_closure G (pointI m) = 0` SUBAGOAL_TAC; UND 3 THEN ARITH_TAC; THM_INTRO_TAC[`G`;`pointI m`] num_closure0; REWR 5; ASM_MESON_TAC[]; ]);; (* }}} *) let cut_rectagon = prove_by_refinement( `!E m n. (rectagon E) /\ (0 < num_closure E (pointI m)) /\ (0 < num_closure E (pointI n)) /\ ~(m = n) ==> (?A B. psegment A /\ psegment B /\ (E = A UNION B) /\ (A INTER B = EMPTY) /\ (endpoint A = {m,n}) /\ (endpoint B = {m,n}) /\ (!k. (0 < num_closure A (pointI k)) /\ (0 < num_closure B (pointI k)) ==> (k = m) \/ (k = n) )) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; THM_INTRO_TAC[`E`;`pointI m`] num_closure_size; TYPE_THEN `~({C | E C /\ closure top2 C (pointI m)} = EMPTY)` SUBAGOAL_TAC; USE 6 SYM; FULL_REWRITE_TAC[HAS_SIZE]; USE 6 (AP_TERM `CARD:(((num->real)->bool)->bool)->num`); USE 6 (REWRITE_RULE[CARD_CLAUSES]); (**** Changed by JRH because of new ARITH_RULE's inability to handle alpha equivs UND 6 THEN UND 5 THEN UND 2 THEN ARITH_TAC; ****) UND 6 THEN UND 5 THEN UND 2 THEN REWRITE_TAC[ARITH_RULE `0 < x ==> (y = x) ==> (0 = y) ==> F`]; FULL_REWRITE_TAC[EMPTY_EXISTS]; (* - *) THM_INTRO_TAC[`E`;`u`;`m`] rectagon_order; TYPE_THEN `!n. (0 <| num_closure E (pointI n)) ==> (num_closure E (pointI n) = 2)` SUBAGOAL_TAC ; TYPE_THEN `{0,2} (num_closure E (pointI n'))` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[INSERT]; FIRST_ASSUM DISJ_CASES_TAC; UND 14 THEN UND 12 THEN ARITH_TAC; TYPE_THEN `u` UNABBREV_TAC; (* -A *) TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `num_closure E (pointI m) = 2` SUBAGOAL_TAC; THM_INTRO_TAC[`E`;`pointI m`] num_closure; REWR 14; THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI m)}`;`E`] CARD_SUBSET; REWRITE_TAC[SUBSET]; USE 14 SYM ; REWR 15; UND 15 THEN UND 10 THEN ARITH_TAC; (* - *) TYPE_THEN `!m. (closure top2 (f 0) (pointI m)) /\ (closure top2 (f (CARD E - 1)) (pointI m)) ==> (m = adjv (f 0) (f (CARD E -| 1)))` SUBAGOAL_TAC; IMATCH_MP_TAC adjv_unique; FULL_REWRITE_TAC[BIJ;INJ;rectagon;ISUBSET ]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; UND 10 THEN ARITH_TAC; REWRITE_TAC[adj;EMPTY_EXISTS;INTER;]; CONJ_TAC; TYPE_THEN `0 = (CARD E -| 1)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 10 THEN ARITH_TAC; UND 22 THEN UND 10 THEN ARITH_TAC; TYPE_THEN `pointI m'` EXISTS_TAC; (* -B *) TYPE_THEN `num_closure E (pointI n) = 2` SUBAGOAL_TAC; THM_INTRO_TAC[`E`;`pointI n`] num_closure2; REWR 15; TYPE_THEN `E a /\ closure top2 a (pointI n)` SUBAGOAL_TAC; TYPE_THEN `E b /\ closure top2 b (pointI n)` SUBAGOAL_TAC; TYPE_THEN `?i. (i < CARD E) /\ (f i = a)` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;SURJ]; TYPE_THEN `a` UNABBREV_TAC; TYPE_THEN `?j. (j < CARD E) /\ (f j = b)` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;SURJ]; TYPE_THEN `b` UNABBREV_TAC; COPY 8; UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); (* - *) TYPE_THEN `adj (f i) (f j)` SUBAGOAL_TAC THEN REWRITE_TAC[adj]; REWRITE_TAC[INTER;EMPTY_EXISTS ]; UNIFY_EXISTS_TAC; REWR 8; (* -C *) TYPE_THEN `edge (f i)` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon;ISUBSET]; TYPE_THEN `edge (f j)` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon;ISUBSET]; TYPE_THEN `?k. (k < CARD E -| 1) /\ (n = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `i` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; UND 27 THEN UND 23 THEN ARITH_TAC; IMATCH_MP_TAC adjv_unique; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `j` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; UND 28 THEN UND 22 THEN ARITH_TAC; IMATCH_MP_TAC adjv_unique; USE 24 (ONCE_REWRITE_RULE[adj_symm]); (* -- *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `i` UNABBREV_TAC; TYPE_THEN `j` UNABBREV_TAC; COPY 13; UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]); UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]); PROOF_BY_CONTR_TAC; UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[]; TYPE_THEN `i` UNABBREV_TAC; TYPE_THEN `j` UNABBREV_TAC; COPY 13; UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]); UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]); PROOF_BY_CONTR_TAC; UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[]; (* - *) TYPE_THEN `A = IMAGE f {p | p <| SUC(k)}` ABBREV_TAC ; TYPE_THEN `B = IMAGE f {p | SUC(k) <=| p /\ p < CARD E}` ABBREV_TAC ; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B` EXISTS_TAC; (* -D , now prove properties *) KILL 26; KILL 25; KILL 8; KILL 24; KILL 23; KILL 22; KILL 19; KILL 20; KILL 17; KILL 18; KILL 15; KILL 16; (* - *) SUBCONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC order_imp_psegment; REWRITE_TAC[ARITH_RULE `0 <| SUC k`]; (* -- *) SUBCONJ_TAC; FULL_REWRITE_TAC[BIJ;INJ]; TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon;ISUBSET]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; UND 17 THEN UND 28 THEN ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 18 THEN UND 19 THEN UND 28 THEN ARITH_TAC; (* -- *) UND 21 THEN DISCH_THEN ( THM_INTRO_TAC[`i`;`j`]); UND 8 THEN UND 15 THEN UND 28 THEN ARITH_TAC; TYPE_THEN `~(j = CARD E -| 1)` SUBAGOAL_TAC; UND 18 THEN UND 8 THEN UND 28 THEN ARITH_TAC; TYPE_THEN `~(i = CARD E -| 1)` SUBAGOAL_TAC; UND 19 THEN UND 15 THEN UND 28 THEN ARITH_TAC; (* - *) SUBCONJ_TAC; TYPE_THEN `B` UNABBREV_TAC; IMATCH_MP_TAC order_imp_psegment_shift; SUBCONJ_TAC; FULL_REWRITE_TAC[BIJ;INJ]; TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon;ISUBSET]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; UND 28 THEN ARITH_TAC; (* -- *) UND 21 THEN DISCH_THEN ( THM_INTRO_TAC[`i`;`j`]); TYPE_THEN `~(j = 0)` SUBAGOAL_TAC; UND 21 THEN UND 17 THEN ARITH_TAC; TYPE_THEN `~(i = 0)` SUBAGOAL_TAC; UND 22 THEN UND 19 THEN ARITH_TAC; (* -E *) SUBCONJ_TAC; TYPE_THEN `(IMAGE f {p | p <| CARD E} = E)` SUBAGOAL_TAC; IMATCH_MP_TAC bij_imp_image; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[GSYM IMAGE_UNION]; TYPE_THEN `cE = CARD E` ABBREV_TAC ; UND 16 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UND 28 THEN ARITH_TAC; (* - *) SUBCONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC ; REWRITE_TAC[IMAGE]; PROOF_BY_CONTR_TAC ; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `u'` UNABBREV_TAC; TYPE_THEN `x = x'` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;INJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 22 THEN UND 28 THEN ARITH_TAC; UND 20 THEN UND 19 THEN UND 22 THEN ARITH_TAC; (* - *) TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC; UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC; UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; (* - finite A ,B *) TYPE_THEN `FINITE A` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `FINITE B` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; (* -F *) TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon;ISUBSET]; KILL 16; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USE 11 (REWRITE_RULE[BIJ;SURJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN ARITH_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USE 11 (REWRITE_RULE[BIJ;SURJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN ARITH_TAC; UND 21 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]); UND 28 THEN ARITH_TAC; (* - *) TYPE_THEN `0 <| num_closure A (pointI n)` SUBAGOAL_TAC; IMATCH_MP_TAC num_closure_pos; TYPE_THEN `f k` EXISTS_TAC; TYPE_THEN `A` UNABBREV_TAC; CONJ_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `k` EXISTS_TAC; ARITH_TAC; IMATCH_MP_TAC adjv_adj; (* - *) TYPE_THEN `0 <| num_closure B (pointI n)` SUBAGOAL_TAC; IMATCH_MP_TAC num_closure_pos; TYPE_THEN `f (SUC k)` EXISTS_TAC; TYPE_THEN `B` UNABBREV_TAC; CONJ_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `SUC k` EXISTS_TAC; UND 28 THEN ARITH_TAC; IMATCH_MP_TAC adjv_adj2; (* - *) TYPE_THEN `0 <| num_closure A (pointI m)` SUBAGOAL_TAC; IMATCH_MP_TAC num_closure_pos; TYPE_THEN `f 0` EXISTS_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `0` EXISTS_TAC; ARITH_TAC; (* - *) TYPE_THEN `0 <| num_closure B (pointI m)` SUBAGOAL_TAC; IMATCH_MP_TAC num_closure_pos; KILL 16; TYPE_THEN `f (CARD E -| 1)` EXISTS_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `CARD E -| 1` EXISTS_TAC; UND 28 THEN ARITH_TAC; (* -G *) SUBCONJ_TAC; IMATCH_MP_TAC has_size2_pair; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC endpoint_size2; CONJ_TAC; IMATCH_MP_TAC rectagon_subset_endpoint; UNIFY_EXISTS_TAC ; ASM_REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; IMATCH_MP_TAC rectagon_subset_endpoint; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `n` UNABBREV_TAC; UND 34 THEN UND 27 THEN UND 0 THEN MESON_TAC[]; (* - *) SUBCONJ_TAC; IMATCH_MP_TAC has_size2_pair; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC endpoint_size2; CONJ_TAC; IMATCH_MP_TAC rectagon_subset_endpoint; UNIFY_EXISTS_TAC ; ASM_REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; IMATCH_MP_TAC rectagon_subset_endpoint; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `n` UNABBREV_TAC; UND 35 THEN UND 27 THEN UND 0 THEN MESON_TAC[]; (* - *) THM_INTRO_TAC[`E`;`A`;`k'`] rectagon_subset_endpoint; ASM_REWRITE_TAC[SUBSET;UNION]; REWR 38; USE 38 (REWRITE_RULE[INR in_pair]); UND 38 THEN MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION S *) (* ------------------------------------------------------------------ *) (* 2 - connected *) (* -------------- MOVE TO TACTICS, *) (* proves ineqs of the form a + (&:0)*c <= b. This handles ineqs such as a <=: a + &:(SUC n) that INT_ARITH_TAC can't do. *) let int_le_mp = prove_by_refinement( `!a b c. (a +: c = b) /\ (&:0 <=: c) ==> (a + (&:0)*c <=: b)`, (* {{{ proof *) [ INT_ARITH_TAC; ]);; (* }}} *) (* rewrites assumptions as 0 <= A, breaks 0 <= A + B into 2, then breaks 0 <= A*B into 2, and tries rewriting and INT_ARITH_TAC *) let int_le_tac = RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM INT_SUB_LE]) THEN IMATCH_MP_TAC int_le_mp THEN CONJ_TAC THENL [TRY INT_ARITH_TAC;ALL_TAC] THEN ASM_REWRITE_TAC[INT_POS] THEN REPEAT (IMATCH_MP_TAC INT_LE_ADD THEN CONJ_TAC THEN ASM_REWRITE_TAC[INT_POS]) THEN REPEAT (IMATCH_MP_TAC INT_LE_MUL THEN CONJ_TAC THEN ASM_REWRITE_TAC[INT_POS]) THEN ASM_REWRITE_TAC[INT_POS] THEN TRY INT_ARITH_TAC;; let clean_int_le_tac = FULL_REWRITE_TAC[INT_MUL_LZERO;INT_ADD_RID];; let test_case_int_le_tac = prove_by_refinement( `!a b n. a +: &:(SUC n) <= b ==> a <= b`, (* {{{ proof *) [ (* INT_ARITH_TAC fails *) REP_BASIC_TAC; TYPE_THEN `a + (&:0)*((b - (a +: &:(SUC n))) + (&:(SUC n))) <=: b` SUBAGOAL_TAC; int_le_tac; clean_int_le_tac; ]);; (* }}} *) (* -------------- *) let segment_end = jordan_def `segment_end S a b <=> psegment S /\ (endpoint S = {a,b})`;; let conn = jordan_def `conn E <=> (!a b. (cls E a /\ cls E b /\ ~(a = b) ==> (?S. (S SUBSET E /\ segment_end S a b))))`;; let conn2 = jordan_def `conn2 E <=> (FINITE E) /\ (2 <=| CARD E) /\ (!a b c. cls E a /\ cls E b /\ ~(a = b) /\ ~(b = c) /\ ~(a = c) ==> (?S. (S SUBSET E /\ segment_end S a b /\ ~(cls S c))))`;; let segment_end_symm = prove_by_refinement( `!S a b. (segment_end S a b = segment_end S b a)`, (* {{{ proof *) [ REWRITE_TAC[segment_end]; TYPE_THEN `{a,b} = {b,a}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR in_pair]; MESON_TAC[]; ]);; (* }}} *) let segment_end_disj = prove_by_refinement( `!S a b. segment_end S a b ==> ~(a = b)`, (* {{{ proof *) [ REWRITE_TAC[segment_end]; THM_INTRO_TAC[`S`] endpoint_size2; USE 3 (REWRITE_RULE[has_size2]); TYPE_THEN `endpoint S` UNABBREV_TAC; USE 1 (ONCE_REWRITE_RULE[FUN_EQ_THM]); FULL_REWRITE_TAC[INR in_pair]; COPY 1; TSPEC `a'` 4; TSPEC `b'` 1; REWR 1; REWR 4; ASM_MESON_TAC[]; ]);; (* }}} *) let cut_psegment = prove_by_refinement( `!E a b c. segment_end E a b /\ cls E c /\ ~(c = a) /\ ~(c = b) ==> (?A B. (E = (A UNION B)) /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {c}) /\ segment_end A a c /\ segment_end B c b)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `~(a = b)` SUBAGOAL_TAC; THM_INTRO_TAC[`E`;`a`;`b`] segment_end_disj; ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[segment_end]; FULL_REWRITE_TAC[cls]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment]; REWRITE_TAC[INR eq_sing;INTER;EQ_EMPTY ]; REWRITE_TAC[CONJ_ACI]; (* - *) THM_INTRO_TAC[`E`;`a`;`b`] psegment_order; REWRITE_TAC[INR in_pair]; TYPE_THEN `num_closure E (pointI c) = 2` SUBAGOAL_TAC; TYPE_THEN `{0,1,2} (num_closure E (pointI c))` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment]; FULL_REWRITE_TAC[INSERT;DISJ_ACI]; FIRST_ASSUM DISJ_CASES_TAC; FIRST_ASSUM DISJ_CASES_TAC; USE 3 SYM; TYPE_THEN `endpoint E c` SUBAGOAL_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `endpoint E` UNABBREV_TAC; ASM_MESON_TAC[]; THM_INTRO_TAC[`E`;`pointI c`] num_closure0; REWR 15; TSPEC `e` 15; ASM_MESON_TAC[]; (* - *) TYPE_THEN `?k. (k < CARD E -| 1) /\ (c = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; THM_INTRO_TAC[`E`;`pointI c`] num_closure2; REWR 13; TYPE_THEN `E a' /\ closure top2 a' (pointI c)` SUBAGOAL_TAC; TYPE_THEN `?i'. (i' <| CARD E) /\ ( f i' = a')` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;SURJ]; TYPE_THEN `a'` UNABBREV_TAC; TYPE_THEN `E b' /\ closure top2 b' (pointI c)` SUBAGOAL_TAC; TYPE_THEN `?j'. (j' <| CARD E) /\ ( f j' = b')` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;SURJ]; TYPE_THEN `b'` UNABBREV_TAC; UND 8 THEN DISCH_THEN ( THM_INTRO_TAC[`i'`;`j'`]); USE 8 SYM; TYPE_THEN `adj (f i') (f j')` SUBAGOAL_TAC; IMATCH_MP_TAC closure_imp_adj; UNIFY_EXISTS_TAC; REWR 8; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `i'` EXISTS_TAC; CONJ_TAC; UND 22 THEN UND 21 THEN ARITH_TAC; IMATCH_MP_TAC adjv_unique; FULL_REWRITE_TAC[psegment;segment;ISUBSET]; TYPE_THEN `j'` EXISTS_TAC; CONJ_TAC; UND 22 THEN UND 18 THEN ARITH_TAC; IMATCH_MP_TAC adjv_unique; USE 20 (ONCE_REWRITE_RULE[adj_symm]); FULL_REWRITE_TAC[psegment;segment;ISUBSET]; (* -A *) TYPE_THEN `c` UNABBREV_TAC; TYPE_THEN `A = IMAGE f { p | p <| SUC k}` ABBREV_TAC ; TYPE_THEN `B = IMAGE f { p | SUC k <=| p /\ p < CARD E}` ABBREV_TAC ; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B` EXISTS_TAC; (* - now prove properties *) TYPE_THEN `psegment A` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC order_imp_psegment; CONJ_TAC; FULL_REWRITE_TAC[BIJ;INJ]; TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment;ISUBSET]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; UND 18 THEN UND 14 THEN ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 19 THEN UND 20 THEN UND 14 THEN ARITH_TAC; CONJ_TAC; ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 13 THEN UND 16 THEN UND 14 THEN ARITH_TAC; (* - *) TYPE_THEN `psegment B` SUBAGOAL_TAC; TYPE_THEN `B` UNABBREV_TAC; IMATCH_MP_TAC order_imp_psegment_shift; CONJ_TAC; FULL_REWRITE_TAC[BIJ;INJ]; TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment;ISUBSET]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; UND 14 THEN ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) SUBCONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; FULL_REWRITE_TAC[IMAGE]; TYPE_THEN`x` UNABBREV_TAC; TYPE_THEN `x' = x''` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;INJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 15 THEN UND 14 THEN ARITH_TAC; TYPE_THEN `x''` UNABBREV_TAC; UND 15 THEN UND 20 THEN ARITH_TAC; (* -B *) TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment;ISUBSET]; (* - *) TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[BIJ;SURJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 14 THEN ARITH_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[BIJ;SURJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 14 THEN ARITH_TAC; UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]); UND 14 THEN ARITH_TAC; (* - *) TYPE_THEN `(?e. A e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC; TYPE_THEN `f k` EXISTS_TAC; TYPE_THEN `A` UNABBREV_TAC; CONJ_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `k` EXISTS_TAC; ARITH_TAC; IMATCH_MP_TAC adjv_adj; (* - *) TYPE_THEN `(?e. B e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC; TYPE_THEN `f (SUC k)` EXISTS_TAC; TYPE_THEN `B` UNABBREV_TAC; CONJ_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `SUC k` EXISTS_TAC; UND 14 THEN ARITH_TAC; IMATCH_MP_TAC adjv_adj2; (* - *) TYPE_THEN `IMAGE f {p | p <| CARD E} = E` SUBAGOAL_TAC; IMATCH_MP_TAC bij_imp_image; (* - *) TYPE_THEN `A UNION B = E` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[GSYM IMAGE_UNION]; TYPE_THEN `cE = CARD E` ABBREV_TAC ; UND 27 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t])) THEN AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UND 14 THEN ARITH_TAC; (* -C *) TYPE_THEN `FINITE A` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; USE 28 SYM; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `FINITE B` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; USE 28 SYM; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC; USE 28 SYM; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;DIFF]; UND 18 THEN MESON_TAC[]; (* - *) TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC; USE 28 SYM; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;DIFF]; UND 18 THEN MESON_TAC[]; (* - *) TYPE_THEN `endpoint A (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; IMATCH_MP_TAC psegment_subset_endpoint; UNIFY_EXISTS_TAC; USE 28 (SYM); CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`]; CONJ_TAC; THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; REWR 34; ASM_MESON_TAC[]; THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; REWR 34; ASM_MESON_TAC[]; (* - *) TYPE_THEN `endpoint B (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; IMATCH_MP_TAC psegment_subset_endpoint; UNIFY_EXISTS_TAC; USE 28 (SYM); CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`]; CONJ_TAC; THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; REWR 35; ASM_MESON_TAC[]; THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; REWR 35; ASM_MESON_TAC[]; (* -D *) TYPE_THEN `endpoint A a` SUBAGOAL_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `endpoint E a` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; THM_INTRO_TAC[`A`;`E`;`pointI a`] num_closure_mono; USE 28 SYM; REWRITE_TAC[SUBSET;UNION]; USE 35 (REWRITE_RULE[endpoint]); REWR 36; USE 36 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]); FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`A`;`pointI a`] num_closure0; REWR 38; TSPEC `f 0` 38 ; USE 10 SYM; UND 38 THEN DISCH_THEN (THM_INTRO_TAC[]); TYPE_THEN`A` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `0` EXISTS_TAC; ARITH_TAC; THM_INTRO_TAC[`E`;`a`] terminal_endpoint; REWRITE_TAC[INR in_pair]; UND 39 THEN ASM_REWRITE_TAC[]; (* -E *) TYPE_THEN `endpoint B b` SUBAGOAL_TAC; REWRITE_TAC[endpoint]; TYPE_THEN `endpoint E b` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; THM_INTRO_TAC[`B`;`E`;`pointI b`] num_closure_mono; USE 28 SYM; REWRITE_TAC[SUBSET;UNION]; USE 36 (REWRITE_RULE[endpoint]); REWR 37; USE 37 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]); FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`B`;`pointI b`] num_closure0; REWR 39; TSPEC `f (CARD E -| 1)` 39 ; UND 39 THEN DISCH_THEN (THM_INTRO_TAC[]); TYPE_THEN`B` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `CARD E -| 1` EXISTS_TAC; UND 14 THEN ARITH_TAC; THM_INTRO_TAC[`E`;`b`] terminal_endpoint; REWRITE_TAC[INR in_pair]; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]); UND 14 THEN ARITH_TAC; UND 39 THEN ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `endpoint A = {a, (adjv (f k) (f (SUC k)))}` SUBAGOAL_TAC; IMATCH_MP_TAC has_size2_pair; IMATCH_MP_TAC endpoint_size2; TYPE_THEN `endpoint B = {(adjv (f k) (f (SUC k))), b}` SUBAGOAL_TAC; IMATCH_MP_TAC has_size2_pair; IMATCH_MP_TAC endpoint_size2; (* - *) CONJ_TAC; USE 37 SYM; TYPE_THEN `endpoint A u` SUBAGOAL_TAC; IMATCH_MP_TAC psegment_subset_endpoint; UNIFY_EXISTS_TAC; CONJ_TAC; USE 28 SYM; REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; IMATCH_MP_TAC num_closure_pos; UNIFY_EXISTS_TAC; IMATCH_MP_TAC num_closure_pos; TYPE_THEN `e''''` EXISTS_TAC ; USE 38 SYM; TYPE_THEN `endpoint B u` SUBAGOAL_TAC; IMATCH_MP_TAC psegment_subset_endpoint; UNIFY_EXISTS_TAC; CONJ_TAC; USE 28 SYM; REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; IMATCH_MP_TAC num_closure_pos; TYPE_THEN `e''''` EXISTS_TAC ; IMATCH_MP_TAC num_closure_pos; TYPE_THEN `e'''` EXISTS_TAC ; TYPE_THEN `endpoint A` UNABBREV_TAC; TYPE_THEN `endpoint B` UNABBREV_TAC; FULL_REWRITE_TAC[INR in_pair]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; ASM_MESON_TAC[]; (* - *) CONJ_TAC; TYPE_THEN `e'` EXISTS_TAC; TYPE_THEN `e''` EXISTS_TAC; ]);; (* }}} *) let segment_end_inj = prove_by_refinement( `!S a b c. (segment_end S a b /\ segment_end S a c) ==> (b = c)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`S`;`a`;`b`] segment_end_disj; THM_INTRO_TAC[`S`;`a`;`c`] segment_end_disj; FULL_REWRITE_TAC[segment_end]; TYPE_THEN `endpoint S` UNABBREV_TAC; USE 0 (ONCE_REWRITE_RULE [FUN_EQ_THM]); TSPEC `b` 0; FULL_REWRITE_TAC[INR in_pair]; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_end_finite = prove_by_refinement( `!S a b. segment_end S a b ==> FINITE S`, (* {{{ proof *) [ REWRITE_TAC[segment_end;psegment;segment]; ]);; (* }}} *) let segment_superset_endpoint = prove_by_refinement( `!E S k. segment E /\ S SUBSET E /\ (endpoint S k) /\ (num_closure (E DIFF S) (pointI k) = 0) ==> (endpoint E k) `, (* {{{ proof *) [ REWRITE_TAC[endpoint]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; ASM_SIMP_TAC[num_closure1]; TYPE_THEN `FINITE S` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; THM_INTRO_TAC[`S`;`pointI k`] num_closure1; REWR 6; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `S e /\ closure top2 e (pointI k)` SUBAGOAL_TAC; TYPE_THEN `S e'` ASM_CASES_TAC; FULL_REWRITE_TAC[ISUBSET]; ASM_MESON_TAC[]; THM_INTRO_TAC[`S`;`pointI k`] num_closure0; REWR 10; FULL_REWRITE_TAC[ARITH_RULE `~(1=0)`]; TYPE_THEN `~(e = e')` SUBAGOAL_TAC; ASM_MESON_TAC[]; REWRITE_TAC[]; USE 0 (REWRITE_RULE[ARITH_RULE `(x = 0) <=> ~(0 <| x)`]); UND 0 THEN REWRITE_TAC[]; IMATCH_MP_TAC num_closure_pos; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; TYPE_THEN `e'` EXISTS_TAC; REWRITE_TAC[DIFF]; ]);; (* }}} *) let segment_end_union_lemma = prove_by_refinement( `!A B a b c. segment_end A a b /\ segment_end B b c /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {b}) ==> segment_end (A UNION B) a c `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`A`;`a`;`b`] segment_end_disj; THM_INTRO_TAC[`B`;`b`;`c`] segment_end_disj; FULL_REWRITE_TAC[cls;segment_end]; TYPE_THEN `segment (A UNION B) /\ (endpoint (A UNION B) = {a,c}) ==> psegment (A UNION B) /\ (endpoint (A UNION B) = {a, c})` SUBAGOAL_TAC; IMATCH_MP_TAC endpoint_psegment; TYPE_THEN `a` EXISTS_TAC; REWRITE_TAC[INR in_pair]; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) SUBCONJ_TAC; IMATCH_MP_TAC segment_union; TYPE_THEN `b` EXISTS_TAC; REWRITE_TAC[INR in_pair]; CONJ_TAC; FULL_REWRITE_TAC[psegment]; CONJ_TAC; FULL_REWRITE_TAC[psegment]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); FULL_REWRITE_TAC[INR IN_SING;INTER;]; TSPEC `n` 0; ASM_MESON_TAC[num_closure_elt]; (* - *) TYPE_THEN `FINITE A` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment]; TYPE_THEN `FINITE B` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment;segment]; TYPE_THEN `FINITE (A UNION B)` SUBAGOAL_TAC; REWRITE_TAC[FINITE_UNION]; (* -A *) TYPE_THEN `endpoint (A UNION B) a` SUBAGOAL_TAC; IMATCH_MP_TAC segment_superset_endpoint; TYPE_THEN `A` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;UNION ]; REWRITE_TAC[INR in_pair]; TYPE_THEN `(A UNION B) DIFF A = B` SUBAGOAL_TAC; UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; ASM_SIMP_TAC[num_closure0]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INTER;INR IN_SING]); TSPEC `a` 0; TYPE_THEN `(?e. A e /\ closure top2 e (pointI a))` SUBAGOAL_TAC; TYPE_THEN `terminal_edge A a` EXISTS_TAC; TYPE_THEN `endpoint A a` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; IMATCH_MP_TAC terminal_endpoint; ASM_MESON_TAC[]; TYPE_THEN `psegment (A UNION B)` SUBAGOAL_TAC; ASM_MESON_TAC[endpoint_psegment]; IMATCH_MP_TAC has_size2_pair; (* - *) TYPE_THEN `endpoint (A UNION B) c` SUBAGOAL_TAC; IMATCH_MP_TAC segment_superset_endpoint; TYPE_THEN `B` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;UNION ]; REWRITE_TAC[INR in_pair]; TYPE_THEN `(A UNION B) DIFF B = A` SUBAGOAL_TAC; UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; ASM_SIMP_TAC[num_closure0]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INTER;INR IN_SING]); TSPEC `c` 0; TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC; TYPE_THEN `terminal_edge B c` EXISTS_TAC; TYPE_THEN `endpoint B c` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; IMATCH_MP_TAC terminal_endpoint; ASM_MESON_TAC[]; (* - *) CONJ_TAC; IMATCH_MP_TAC endpoint_size2; (* - *) TYPE_THEN`a` UNABBREV_TAC; TYPE_THEN `endpoint B c /\ endpoint A c` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INTER;INR IN_SING]); TSPEC `c` 0; TYPE_THEN `(?e. A e /\ closure top2 e (pointI c))` SUBAGOAL_TAC; TYPE_THEN `terminal_edge A c` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC; TYPE_THEN `terminal_edge B c` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; ASM_MESON_TAC[]; ]);; (* }}} *) let cls_subset = prove_by_refinement( `!A B. A SUBSET B ==> cls A SUBSET cls B`, (* {{{ proof *) [ REWRITE_TAC[cls]; REWRITE_TAC[SUBSET]; TYPE_THEN `e` EXISTS_TAC; ASM_MESON_TAC[ISUBSET]; ]);; (* }}} *) let segment_end_union = prove_by_refinement( `!A B a b c. segment_end A a b /\ segment_end B b c /\ (cls A INTER cls B = {b}) ==> segment_end (A UNION B) a c`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC segment_end_union_lemma; TYPE_THEN `b` EXISTS_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER ]; TYPE_THEN `edge u` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end;psegment;segment;ISUBSET]; TYPE_THEN `(cls {u} ) HAS_SIZE 2` SUBAGOAL_TAC; REWRITE_TAC[cls_edge]; IMATCH_MP_TAC two_endpoint; FULL_REWRITE_TAC[has_size2]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0 (REWRITE_RULE[INR IN_SING ]); COPY 0; TSPEC `a'` 8; TSPEC `b'` 0; TYPE_THEN `cls {u} a' /\ cls {u} b'` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; KILL 7; TYPE_THEN `cls {u} SUBSET cls A` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;INR IN_SING]; TYPE_THEN `cls {u} SUBSET cls B` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;INR IN_SING]; FULL_REWRITE_TAC[ISUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_end_cls = prove_by_refinement( `!A a b. segment_end A a b ==> cls A a`, (* {{{ proof *) [ REWRITE_TAC[cls;segment_end]; TYPE_THEN `terminal_edge A a` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; FULL_REWRITE_TAC[INR in_pair;psegment;segment]; ]);; (* }}} *) let segment_end_cls2 = prove_by_refinement( `!A a b. segment_end A a b ==> cls A b`, (* {{{ proof *) [ REWRITE_TAC[cls;segment_end]; TYPE_THEN `terminal_edge A b` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; FULL_REWRITE_TAC[INR in_pair;psegment;segment]; ]);; (* }}} *) let card_subset_lt = prove_by_refinement( `!(a:A->bool) b. a SUBSET b /\ ~(a = b) /\ FINITE b ==> (CARD a < CARD b)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC (ARITH_RULE (`x <=| y /\ ~( x = y) ==> (x < y)`)); CONJ_TAC; IMATCH_MP_TAC CARD_SUBSET; UND 1 THEN REWRITE_TAC[]; IMATCH_MP_TAC CARD_SUBSET_EQ; ]);; (* }}} *) let segment_end_trans = prove_by_refinement( `!R S a b c. segment_end R a b /\ segment_end S b c /\ ~(a = c) ==> (?U. segment_end U a c /\ (U SUBSET (R UNION S)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN`SS = { (U,V,b') | segment_end U a b' /\ segment_end V b' c /\ (U SUBSET (R UNION S) /\ V SUBSET (R UNION S) ) }` ABBREV_TAC ; TYPE_THEN `~(SS = EMPTY)` SUBAGOAL_TAC; UND 4 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `(R,S,b)` EXISTS_TAC; TYPE_THEN `SS` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "U"); CONV_TAC (dropq_conv "V"); TYPE_THEN `b` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `FINITE R` SUBAGOAL_TAC; IMATCH_MP_TAC segment_end_finite; UNIFY_EXISTS_TAC; TYPE_THEN `FINITE S` SUBAGOAL_TAC; IMATCH_MP_TAC segment_end_finite; UNIFY_EXISTS_TAC; TYPE_THEN `FINITE (R UNION S)` SUBAGOAL_TAC; ASM_REWRITE_TAC[FINITE_UNION]; (* - *) TYPE_THEN `f = (\ ((U,V,b):((((num->real)->bool)->bool)#((((num->real)->bool)->bool)#(int#int))) ). (CARD U) + (CARD V))` ABBREV_TAC ; THM_INTRO_TAC[`SS`;`f`] select_image_num_min; ASM_MESON_TAC[]; (* - *) TYPE_THEN `?Um Vm bm. z = (Um,Vm,bm)` SUBAGOAL_TAC ; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `!U' V' b''. (SS (U',V',b'') ==> f (Um,Vm,bm) <=| f (U',V',b''))` SUBAGOAL_TAC; KILL 9; TYPE_THEN `SS` UNABBREV_TAC; KILL 4; (* - *) USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]); REWR 4; TYPE_THEN `U` UNABBREV_TAC; USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]); REWR 4; TYPE_THEN `V` UNABBREV_TAC; TYPE_THEN `b'` UNABBREV_TAC; (* - *) TYPE_THEN `! U V b'. f (U,V,b') = CARD U +| CARD V` SUBAGOAL_TAC; USE 8 SYM; GBETA_TAC; KILL 8; REWR 11; KILL 3; USE 4 (ONCE_REWRITE_RULE[PAIR_SPLIT]); REWR 3; USE 3 (CONV_RULE (dropq_conv "U")); USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]); REWR 3; USE 3 (CONV_RULE (dropq_conv "V")); USE 3 (CONV_RULE (dropq_conv "b''")); (* - *) TYPE_THEN `FINITE Vm` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; TYPE_THEN `FINITE Um` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; (* -A *) THM_INTRO_TAC[`S`;`b`;`c`] segment_end_disj; THM_INTRO_TAC[`R`;`a`;`b`] segment_end_disj; TYPE_THEN `cls Vm a` ASM_CASES_TAC; THM_INTRO_TAC[`Vm`;`bm`;`c`;`a`] cut_psegment; THM_INTRO_TAC[`Um`;`a`;`bm`] segment_end_disj; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Vm` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `cls Um c` ASM_CASES_TAC; THM_INTRO_TAC[`Um`;`a`;`bm`;`c`] cut_psegment; THM_INTRO_TAC[`Vm`;`bm`;`c`] segment_end_disj; TYPE_THEN `A` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Um` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `Um UNION Vm` EXISTS_TAC; IMATCH_MP_TAC (TAUT ` a /\ b ==> b /\ a`); SUBCONJ_TAC; REWRITE_TAC[union_subset]; (* - *) IMATCH_MP_TAC segment_end_union; TYPE_THEN `bm` EXISTS_TAC; REWRITE_TAC[INTER;eq_sing]; TYPE_THEN `cls Um bm /\ cls Vm bm` SUBAGOAL_TAC; ASM_MESON_TAC[segment_end_cls;segment_end_cls2]; REP_BASIC_TAC; PROOF_BY_CONTR_TAC; (* -B *) TYPE_THEN `~(u = a)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `~(u = c)` SUBAGOAL_TAC; ASM_MESON_TAC[]; THM_INTRO_TAC[`Vm`;`bm`;`c`;`u`] cut_psegment; THM_INTRO_TAC[`Um`;`a`;`bm`;`u`] cut_psegment; UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`A'`;`B`;`u`]); CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Um` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Vm` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `FINITE A'` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `Um` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `FINITE B` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `Vm` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; (* -C *) USE 34 SYM; TYPE_THEN `CARD A' < CARD Um` SUBAGOAL_TAC; IMATCH_MP_TAC card_subset_lt; USE 34 SYM; CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `B' = EMPTY` SUBAGOAL_TAC; FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY]; USE 37(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 37; FULL_REWRITE_TAC[]; ASM_MESON_TAC[]; TYPE_THEN`B'` UNABBREV_TAC; FULL_REWRITE_TAC[segment_end;segment;psegment]; (* - *) USE 29 SYM; TYPE_THEN `CARD B < CARD Vm` SUBAGOAL_TAC; IMATCH_MP_TAC card_subset_lt; USE 29 SYM; CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `A = EMPTY` SUBAGOAL_TAC; FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY]; USE 38(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 38; FULL_REWRITE_TAC[]; ASM_MESON_TAC[]; TYPE_THEN`A` UNABBREV_TAC; FULL_REWRITE_TAC[segment_end;segment;psegment]; (* - *) UND 38 THEN UND 37 THEN UND 3 THEN ARITH_TAC; ]);; (* }}} *) let cls_union = prove_by_refinement( `!A B. cls(A UNION B) = cls A UNION cls B`, (* {{{ proof *) [ REWRITE_TAC[cls;UNION ]; IMATCH_MP_TAC EQ_EXT; MESON_TAC[]; ]);; (* }}} *) let conn_union = prove_by_refinement( `!E E'. conn E /\ conn E' /\ ~(cls E INTER cls E' = EMPTY) ==> conn (E UNION E')`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[conn;cls_union]; RULE_ASSUM_TAC (REWRITE_RULE[UNION]); FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `!E E' a b u. ~(a = b) /\ ~cls E b /\ ~cls E' a /\ cls E a /\ cls E' b /\ (conn E) /\ (conn E') /\ cls E u /\ cls E' u ==> (?S. S SUBSET (E UNION E') /\ segment_end S a b)` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn]; UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`u'`]); ASM_MESON_TAC []; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`u'`;`b'`]); ASM_MESON_TAC[]; THM_INTRO_TAC[`S`;`S'`;`a'`;`u'`;`b'`] segment_end_trans; TYPE_THEN `U` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `S UNION S'` EXISTS_TAC; IMATCH_MP_TAC subset_union_pair; (* - *) TYPE_THEN `cls E a /\ cls E b` ASM_CASES_TAC; USE 2 (REWRITE_RULE[conn]); UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]); TYPE_THEN `S` EXISTS_TAC; UND 10 THEN REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `cls E' a /\ cls E' b` ASM_CASES_TAC; USE 1 (REWRITE_RULE[conn]); UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]); TYPE_THEN `S` EXISTS_TAC; UND 11 THEN REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `cls E a /\ cls E' b` ASM_CASES_TAC; REWR 9; REWR 8; UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E`;`E'`;`a`;`b`;`u`]); (* - *) TYPE_THEN `cls E' a /\ cls E b` ASM_CASES_TAC; REWR 9; REWR 8; UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`E`;`a`;`b`;`u`]); TYPE_THEN `S` EXISTS_TAC; UND 13 THEN REWRITE_TAC[SUBSET;UNION]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let cls_empty = prove_by_refinement( `cls EMPTY = EMPTY `, (* {{{ proof *) [ IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[cls]; ]);; (* }}} *) let finite_cls = prove_by_refinement( `!E. FINITE E ==> (E SUBSET edge ==> FINITE (cls E))`, (* {{{ proof *) [ IMATCH_MP_TAC FINITE_INDUCT_STRONG; REWRITE_TAC[cls_empty;FINITE_RULES ]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `cls (E UNION {x})` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[cls_union;FINITE_UNION;]; (* -- *) TYPE_THEN `edge x /\ E SUBSET edge` SUBAGOAL_TAC; FULL_REWRITE_TAC[INSERT;SUBSET]; ASM_MESON_TAC[]; REWRITE_TAC[cls_edge]; USE 5 (MATCH_MP two_endpoint); FULL_REWRITE_TAC[HAS_SIZE]; (* - *) IMATCH_MP_TAC cls_subset; REWRITE_TAC[INSERT;SUBSET;INR IN_SING;UNION ]; ]);; (* }}} *) let infinite_int = prove_by_refinement( `INFINITE (UNIV:int->bool)`, (* {{{ proof *) [ IMATCH_MP_TAC infinite_subset; TYPE_THEN `IMAGE (&:) UNIV` EXISTS_TAC; THM_INTRO_TAC[`(&:)`] INFINITE_IMAGE_INJ; ASM_MESON_TAC[INT_OF_NUM_EQ]; TSPEC `UNIV:num->bool` 0; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[num_INFINITE]; ]);; (* }}} *) let infinite_intpair = prove_by_refinement( `INFINITE (UNIV:int#int->bool)`, (* {{{ proof *) [ IMATCH_MP_TAC infinite_subset; TYPE_THEN `IMAGE (\ (i:int) . (i,&:0)) UNIV` EXISTS_TAC; THM_INTRO_TAC[`(\ (i:int) . (i,&:0))`] INFINITE_IMAGE_INJ; FULL_REWRITE_TAC[PAIR_SPLIT]; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[infinite_int]; ]);; (* }}} *) let not_cls_exists = prove_by_refinement( `!E. ?c. (FINITE E /\ E SUBSET edge) ==> ~cls E c`, (* {{{ proof *) [ REP_BASIC_TAC; RIGHT_TAC "c"; THM_INTRO_TAC[`E`] finite_cls; FULL_REWRITE_TAC[cls]; TYPE_THEN `INFINITE (UNIV DIFF {m | ?e. E e /\ closure top2 e (pointI m)})` SUBAGOAL_TAC; IMATCH_MP_TAC INFINITE_DIFF_FINITE; REWRITE_TAC[infinite_intpair]; (* - *) USE 3 (MATCH_MP INFINITE_NONEMPTY); USE 3 (REWRITE_RULE[EMPTY_EXISTS;DIFF]); ASM_MESON_TAC[]; ]);; (* }}} *) let conn2_imp_conn = prove_by_refinement( `!E. (E SUBSET edge ) /\ conn2 E ==> conn E`, (* {{{ proof *) [ REWRITE_TAC[conn;conn2]; THM_INTRO_TAC[`E`] finite_cls; THM_INTRO_TAC[`E`] not_cls_exists; UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]); UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]); ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let has_size1 = prove_by_refinement( `!(X:A -> bool). X HAS_SIZE 1 <=> SING X`, (* {{{ proof *) [ REWRITE_TAC[]; IMATCH_MP_TAC EQ_ANTISYM; ASM_REWRITE_TAC[CARD_SING_CONV]; FULL_REWRITE_TAC[SING]; REWRITE_TAC[sing_has_size1]; ]);; (* }}} *) let card_gt_3 = prove_by_refinement( `!(X:A->bool). FINITE X ==> ( 3 <= CARD X <=> (?a b c. X a /\ X b /\ X c /\ ~(a = b) /\ ~(a = c) /\ ~( b = c)))`, (* {{{ proof *) [ FULL_REWRITE_TAC[ARITH_RULE `(3 <= x) <=> ~(x = 0) /\ ~(x = 1) /\ ~(x = 2)`]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `~(X HAS_SIZE 0)` SUBAGOAL_TAC; ASM_MESON_TAC[HAS_SIZE]; FULL_REWRITE_TAC[HAS_SIZE_0 ;EMPTY_EXISTS ]; TYPE_THEN `~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2)` SUBAGOAL_TAC; ASM_MESON_TAC[HAS_SIZE]; FULL_REWRITE_TAC[has_size1 ;SING;has_size2;INR eq_sing ]; TYPE_THEN `?v. (X v /\ ~(v = u))` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; LEFT 5 "a"; TSPEC `u` 5; LEFT 5 "b"; TSPEC `v` 5; USE 5 (REWRITE_RULE[DE_MORGAN_THM]); REWR 5; USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); LEFT 5 "x"; FULL_REWRITE_TAC[INR in_pair]; TYPE_THEN `x` EXISTS_TAC; ASM_MESON_TAC[]; (* - *) TYPE_THEN `~(X HAS_SIZE 0) /\ ~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2) ==> ~(CARD X = 0) /\ ~(CARD X = 1) /\ ~(CARD X = 2)` SUBAGOAL_TAC; FULL_REWRITE_TAC[HAS_SIZE]; ASM_MESON_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; KILL 7; REWRITE_TAC[HAS_SIZE_0;has_size1;SING;EMPTY_EXISTS ]; CONJ_TAC; TYPE_THEN `a` EXISTS_TAC; CONJ_TAC; TYPE_THEN `X` UNABBREV_TAC; FULL_REWRITE_TAC[INR IN_SING]; ASM_MESON_TAC[]; THM_INTRO_TAC[`X`;`a`;`b`;`c`] two_exclusion; ASM_MESON_TAC[]; ]);; (* }}} *) let card_has_subset = prove_by_refinement( `!(A:A->bool) n. FINITE A /\ (n <= CARD A) ==> (?B. B SUBSET A /\ (B HAS_SIZE n))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `A HAS_SIZE CARD A` SUBAGOAL_TAC; REWRITE_TAC[HAS_SIZE]; FULL_REWRITE_TAC[has_size_bij]; TYPE_THEN `IMAGE f {m | m <| n}` EXISTS_TAC; CONJ_TAC; FULL_REWRITE_TAC[IMAGE;SUBSET;BIJ;SURJ]; FIRST_ASSUM IMATCH_MP_TAC ; UND 3 THEN UND 0 THEN ARITH_TAC; TYPE_THEN `f` EXISTS_TAC; IMATCH_MP_TAC inj_bij; FULL_REWRITE_TAC[INJ;BIJ;]; FIRST_ASSUM IMATCH_MP_TAC ; UND 3 THEN UND 4 THEN UND 0 THEN ARITH_TAC; ]);; (* }}} *) let cls_edge_size2 = prove_by_refinement( `!e. (edge e) ==> (cls {e} HAS_SIZE 2)`, (* {{{ proof *) [ REWRITE_TAC[cls_edge]; IMATCH_MP_TAC two_endpoint; ]);; (* }}} *) let conn2_cls3 = prove_by_refinement( `!E. (E SUBSET edge) /\ conn2 E ==> (3 <= CARD (cls E))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`] finite_cls; FULL_REWRITE_TAC[conn2]; ASM_SIMP_TAC[card_gt_3]; FULL_REWRITE_TAC[conn2]; THM_INTRO_TAC[`E`;`2`] card_has_subset; FULL_REWRITE_TAC[has_size2]; TYPE_THEN `B` UNABBREV_TAC; USE 6(REWRITE_RULE[SUBSET;INR in_pair]); TYPE_THEN `E b` SUBAGOAL_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `E a` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) USE 2(REWRITE_RULE[SUBSET]); TYPE_THEN `edge a /\ edge b` SUBAGOAL_TAC; (* - *) TYPE_THEN `cls {a} HAS_SIZE 2 /\ cls {b} HAS_SIZE 2` SUBAGOAL_TAC; ASM_MESON_TAC[cls_edge_size2]; FULL_REWRITE_TAC[has_size2]; USE 12 SYM; USE 14 SYM; TYPE_THEN `cls {a} SUBSET cls E` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;INR IN_SING]; TYPE_THEN `cls {b} SUBSET cls E` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;INR IN_SING]; (* - *) TYPE_THEN `cls E a' /\ cls E b' /\ cls E a'' /\ cls E b''` SUBAGOAL_TAC; USE 12 GSYM; USE 14 SYM; REWR 15; REWR 16; FULL_REWRITE_TAC[SUBSET;INR in_pair]; ASM_MESON_TAC[]; (* -A *) TYPE_THEN `a'` EXISTS_TAC; TYPE_THEN `b'` EXISTS_TAC; (* - *) TYPE_THEN `~(cls {a} = cls {b})` SUBAGOAL_TAC; THM_INTRO_TAC[`a`;`b`] cls_inj; ASM_MESON_TAC[]; USE 14 SYM; TYPE_THEN `cls {b} a''` ASM_CASES_TAC; REWR 22; FULL_REWRITE_TAC[INR in_pair ]; TYPE_THEN `b''` EXISTS_TAC; CONJ_TAC; TYPE_THEN `b''` UNABBREV_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `a''` UNABBREV_TAC; TYPE_THEN `cls {b}` UNABBREV_TAC; TYPE_THEN `cls {a}` UNABBREV_TAC; UND 21 THEN REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INSERT]; MESON_TAC[]; TYPE_THEN `a''` UNABBREV_TAC; (* -- *) TYPE_THEN `b''` UNABBREV_TAC; FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `a''` UNABBREV_TAC; TYPE_THEN `a''` UNABBREV_TAC; TYPE_THEN `cls {b}` UNABBREV_TAC; TYPE_THEN `cls {a}` UNABBREV_TAC; (* -B *) TYPE_THEN `a''` EXISTS_TAC; REWR 22; FULL_REWRITE_TAC[INR in_pair]; UND 22 THEN MESON_TAC[]; ]);; (* }}} *) let has_size2_subset_ne = prove_by_refinement( `!X (a:A) b. X HAS_SIZE 2 /\ {a,b} SUBSET X /\ ~(a = b) ==> (X = {a,b})`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; IMATCH_MP_TAC CARD_SUBSET_EQ; THM_INTRO_TAC[`a`;`b`] pair_size_2; ASM_MESON_TAC[]; FULL_REWRITE_TAC[HAS_SIZE]; ]);; (* }}} *) let segment_end_sing = prove_by_refinement( `!a b e. closure top2 e (pointI a) /\ closure top2 e (pointI b) /\ ~(a = b) /\ (edge e) ==> segment_end {e} a b`, (* {{{ proof *) [ REWRITE_TAC[segment_end]; CONJ_TAC ; IMATCH_MP_TAC psegment_edge; (* - *) IMATCH_MP_TAC has_size2_subset_ne; CONJ_TAC; IMATCH_MP_TAC endpoint_size2; IMATCH_MP_TAC psegment_edge; (* - *) REWRITE_TAC[endpoint;SUBSET]; FULL_REWRITE_TAC[INR in_pair]; THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1; REWRITE_TAC[FINITE_SING]; KILL 5; TYPE_THEN `e` EXISTS_TAC; REWRITE_TAC[INR IN_SING]; ASM_MESON_TAC[]; ]);; (* }}} *) let conn2_no1 = prove_by_refinement( `!E. (E SUBSET edge) /\ conn2 E ==> (!m. ~(num_closure E (pointI m) = 1))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `FINITE E` SUBAGOAL_TAC ; FULL_REWRITE_TAC[conn2]; TYPE_THEN `?e. E e /\ closure top2 e (pointI m)` SUBAGOAL_TAC; THM_INTRO_TAC[`E`;`pointI m`] num_closure1; REWR 4; MESON_TAC[]; THM_INTRO_TAC[`e`] cls_edge_size2; ASM_MESON_TAC[ISUBSET]; TYPE_THEN `?n. closure top2 e (pointI n) /\ ~(n = m)` SUBAGOAL_TAC; FULL_REWRITE_TAC[has_size2]; USE 7 SYM; TYPE_THEN `cls {e} m` SUBAGOAL_TAC; REWRITE_TAC[cls;INR IN_SING ]; ASM_MESON_TAC[]; USE 7 SYM; REWR 8; FULL_REWRITE_TAC[INR in_pair]; FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `cls{e} a` SUBAGOAL_TAC; REWRITE_TAC[INSERT]; FULL_REWRITE_TAC[cls;INR IN_SING ]; ASM_MESON_TAC[]; TYPE_THEN `b` EXISTS_TAC; TYPE_THEN `cls{e} b` SUBAGOAL_TAC; FULL_REWRITE_TAC[INR in_pair;cls; INR IN_SING]; FULL_REWRITE_TAC[cls;INR IN_SING]; ASM_MESON_TAC[]; TYPE_THEN `edge e` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; (* -A *) TYPE_THEN`?c. cls E c /\ ~(c = m) /\ ~(c = n)` SUBAGOAL_TAC; THM_INTRO_TAC[`E`] conn2_cls3; THM_INTRO_TAC[`E`] finite_cls; THM_INTRO_TAC[`cls E`] card_gt_3; REWR 12; TYPE_THEN `~(a = m) /\ ~(a = n)` ASM_CASES_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `~(b = m) /\ ~(b = n)` ASM_CASES_TAC; TYPE_THEN `b` EXISTS_TAC; TYPE_THEN `~(c = m) /\ ~(c = n)` ASM_CASES_TAC; TYPE_THEN `c` EXISTS_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[conn2]; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`c`;`n`]); REWRITE_TAC[cls]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `cls {e} n` SUBAGOAL_TAC; REWRITE_TAC[cls;INR IN_SING ]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `~S e` SUBAGOAL_TAC; TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;INR IN_SING]; FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`S`;`m`] terminal_endpoint; FULL_REWRITE_TAC[segment_end]; FULL_REWRITE_TAC[psegment;segment;INR in_pair]; THM_INTRO_TAC[`E`;`pointI m`] num_closure1; REWR 21; COPY 21; TSPEC `e` 21; TYPE_THEN `e = e'` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; TSPEC `(terminal_edge S m)` 22; REWR 22; USE 22 SYM; TYPE_THEN `E (terminal_edge S m)` SUBAGOAL_TAC; FULL_REWRITE_TAC[ISUBSET]; REWR 22; TYPE_THEN `e` UNABBREV_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let conn2_union = prove_by_refinement( `!A B. (A SUBSET edge) /\ (B SUBSET edge) /\ (conn2 A) /\ (conn2 B) /\ (?a b. ~(a = b) /\ ({a,b} SUBSET (cls A INTER cls B))) ==> (conn2 (A UNION B))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[conn2]; TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; SUBCONJ_TAC; REWRITE_TAC[FINITE_UNION]; (* - *) SUBCONJ_TAC; IMATCH_MP_TAC LE_TRANS; TYPE_THEN `CARD A` EXISTS_TAC; FULL_REWRITE_TAC[conn2]; IMATCH_MP_TAC CARD_SUBSET; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `cls A a' /\ cls A b'` ASM_CASES_TAC; FULL_REWRITE_TAC[conn2]; UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]); TYPE_THEN`S` EXISTS_TAC; UND 22 THEN REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `cls B a' /\ cls B b'` ASM_CASES_TAC; FULL_REWRITE_TAC[conn2]; UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]); TYPE_THEN`S` EXISTS_TAC; UND 23 THEN REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `?d. cls A d /\ cls B d /\ ~(c = d)` SUBAGOAL_TAC; TYPE_THEN `c = a` ASM_CASES_TAC; TYPE_THEN `c` UNABBREV_TAC; TYPE_THEN `b` EXISTS_TAC; FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair]; ASM_MESON_TAC[]; TYPE_THEN `a` EXISTS_TAC; FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair]; ASM_MESON_TAC[]; (* -A *) TYPE_THEN `!m n. cls A m /\ ~cls B m /\ ~cls A n /\ cls B n /\ ~(m = n) /\ ~(m = c) /\ ~(n = c) ==> (?S. S SUBSET A UNION B /\ segment_end S m n /\ ~cls S c)` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; UND 28 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`d`;`c`]); REWRITE_TAC[]; TYPE_THEN `m` UNABBREV_TAC; ASM_MESON_TAC[]; UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`d`;`n`;`c`]); ASM_MESON_TAC[]; THM_INTRO_TAC[`S`;`S'`;`m`;`d`;`n`] segment_end_trans; TYPE_THEN `U` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `S UNION S'` EXISTS_TAC ; IMATCH_MP_TAC subset_union_pair; TYPE_THEN `cls U SUBSET cls (S UNION S')` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; FULL_REWRITE_TAC[cls_union ]; FULL_REWRITE_TAC[ISUBSET]; TSPEC `c` 38; USE 37 (REWRITE_RULE[UNION]); ASM_MESON_TAC[]; (* -B *) FULL_REWRITE_TAC[DE_MORGAN_THM]; FULL_REWRITE_TAC[cls_union ]; USE 12(REWRITE_RULE[UNION]); USE 13 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; REWR 15; REWR 12; REWR 16; UND 20 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`]); (* - *) REWR 16; REWR 12; REWR 15; UND 20 THEN DISCH_THEN (THM_INTRO_TAC[`b'`;`a'`]); TYPE_THEN `S` EXISTS_TAC; ONCE_REWRITE_TAC[segment_end_symm]; ]);; (* }}} *) let cut_rectagon_cls = prove_by_refinement( `!E m n. rectagon E /\ ~(m = n) /\ cls E m /\ cls E n ==> (?A B. segment_end A m n /\ segment_end B m n /\ (E = A UNION B) /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {m,n}))`, (* {{{ proof *) [ REWRITE_TAC[segment_end;cls;]; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon;segment;psegment]; THM_INTRO_TAC[`E`;`m`;`n`] cut_rectagon; CONJ_TAC; IMATCH_MP_TAC num_closure_pos; ASM_MESON_TAC[]; IMATCH_MP_TAC num_closure_pos; ASM_MESON_TAC[]; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR in_pair]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; IMATCH_MP_TAC (TAUT `a \/ b ==> b \/ a`); FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; IMATCH_MP_TAC num_closure_pos; ASM_MESON_TAC[psegment;segment]; IMATCH_MP_TAC num_closure_pos; ASM_MESON_TAC[psegment;segment]; (* - *) TYPE_THEN `FINITE A` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `FINITE B` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `endpoint A m /\ endpoint A n /\ endpoint B m /\ endpoint B n` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; (* - *) FIRST_ASSUM DISJ_CASES_TAC; CONJ_TAC; TYPE_THEN `terminal_edge A n` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; TYPE_THEN `terminal_edge B n` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; CONJ_TAC; TYPE_THEN `terminal_edge A m` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; TYPE_THEN `terminal_edge B m` EXISTS_TAC; IMATCH_MP_TAC terminal_endpoint; ]);; (* }}} *) let conn2_rectagon = prove_by_refinement( `!E. rectagon E ==> conn2 E`, (* {{{ proof *) [ FULL_REWRITE_TAC[conn2]; SUBCONJ_TAC; FULL_REWRITE_TAC[rectagon]; SUBCONJ_TAC; THM_INTRO_TAC[`E`] rectagon_h_edge; THM_INTRO_TAC[`E`] rectagon_v_edge; TYPE_THEN `~(h_edge m = v_edge m')` SUBAGOAL_TAC; ASM_MESON_TAC[hv_edgeV2]; TYPE_THEN `CARD {(h_edge m),(v_edge m')} <= CARD E` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET; REWRITE_TAC[SUBSET;INR in_pair]; ASM_MESON_TAC[]; TYPE_THEN `{(h_edge m),(v_edge m')} HAS_SIZE 2` SUBAGOAL_TAC; IMATCH_MP_TAC pair_size_2; ASM_MESON_TAC[]; FULL_REWRITE_TAC[HAS_SIZE]; REWR 5; (* - *) THM_INTRO_TAC[`E`;`a`;`b`] cut_rectagon_cls; TYPE_THEN `~cls A c` ASM_CASES_TAC; TYPE_THEN `A` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; REWR 13; (* - *) TYPE_THEN `~cls B c ` SUBAGOAL_TAC; USE 8 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `c` 8; FULL_REWRITE_TAC[INTER;INR in_pair]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `B` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; ]);; (* }}} *) let rectangle_grid = jordan_def `rectangle_grid p q = { e | (?m. (e = h_edge m) /\ FST p <= FST m /\ (FST m +: &:1 <=: FST q) /\ SND p <= SND m /\ SND m <=: SND q) \/ (?m. (e = v_edge m) /\ FST p <= FST m /\ FST m <= FST q /\ SND p <= SND m /\ SND m +: &:1 <=: SND q) }`;; let rectangle_grid_h = prove_by_refinement( `!p q m. rectangle_grid p q (h_edge m) <=> (FST p <=: FST m) /\ (FST m +: &:1 <=: FST q) /\ (SND p <=: SND m) /\ (SND m <=: SND q)`, (* {{{ proof *) [ REWRITE_TAC[rectangle_grid]; REWRITE_TAC[cell_clauses;]; MESON_TAC[]; ]);; (* }}} *) let rectangle_grid_v = prove_by_refinement( `!p q m. rectangle_grid p q (v_edge m) <=> (FST p <= FST m /\ FST m <= FST q /\ SND p <= SND m /\ SND m +: &:1 <=: SND q)`, (* {{{ proof *) [ REWRITE_TAC[rectangle_grid]; REWRITE_TAC[cell_clauses;]; MESON_TAC[]; ]);; (* }}} *) let rectangle_grid_edge = prove_by_refinement( `!p q. rectangle_grid p q SUBSET edge`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;rectangle_grid;edge]; ASM_MESON_TAC[]; ]);; (* }}} *) let rectangle_grid_sq = prove_by_refinement( `!p. (rectangle_grid p (FST p +: &:1, SND p +: &:1)) = {(h_edge p), (h_edge (up p)), (v_edge p), (v_edge (right p))}`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `E = rectangle_grid p (FST p +: &:1, SND p +: &:1)` ABBREV_TAC ; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INSERT]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `edge x` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; (* - *) FULL_REWRITE_TAC[edge]; FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_v;PAIR_SPLIT]; REWRITE_TAC[cell_clauses]; REWRITE_TAC[PAIR_SPLIT;right ]; UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_h;PAIR_SPLIT]; REWRITE_TAC[cell_clauses]; REWRITE_TAC[PAIR_SPLIT;up ]; UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; (* - *) TYPE_THEN `E` UNABBREV_TAC; UND 1 THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[rectangle_grid_v;rectangle_grid_h;up;right ;] THEN INT_ARITH_TAC; ]);; (* }}} *) let rectangle_grid_sq_cls = prove_by_refinement( `!p. cls (rectangle_grid p (FST p +: &:1, SND p +: &:1)) = {(p),(right p),(up p), (up (right p))}`, (* {{{ proof *) [ REWRITE_TAC[cls]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[rectangle_grid_sq]; REWRITE_TAC[INSERT]; IMATCH_MP_TAC EQ_ANTISYM; (* - *) CONJ_TAC; FULL_REWRITE_TAC[right ;up;]; UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `e` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;] THEN ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[right ;up;]; TYPE_THEN `closure top2 (h_edge p) (pointI x) \/ closure top2 (h_edge (FST p,SND p +: &:1)) (pointI x)` SUBAGOAL_TAC; UND 0 THEN REP_CASES_TAC THEN (TYPE_THEN`x` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;]; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_end_union_rectagon = prove_by_refinement( `!A B m p. segment_end A m p /\ segment_end B m p /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {m,p}) ==> (rectagon (A UNION B))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`A`;`m`;`p`] segment_end_disj; IMATCH_MP_TAC segment_union2; TYPE_THEN `m` EXISTS_TAC; TYPE_THEN `p` EXISTS_TAC; FULL_REWRITE_TAC[segment_end;INR in_pair]; REWRITE_TAC[INR in_pair]; FULL_REWRITE_TAC[psegment]; REP_BASIC_TAC; (* - *) IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `n` 0; USE 0 (REWRITE_RULE[INR in_pair;INTER;cls]); IMATCH_MP_TAC (TAUT `a \/ b ==> b \/ a`); USE 0 SYM; CONJ_TAC; USE 10 (MATCH_MP num_closure_elt); ASM_MESON_TAC[]; USE 9 (MATCH_MP num_closure_elt); ASM_MESON_TAC[]; (* -A *) TYPE_THEN `FINITE A` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; TYPE_THEN `FINITE B` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; TYPE_THEN `endpoint B m /\ endpoint B p /\ endpoint A m /\ endpoint A p` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; CONJ_TAC; IMATCH_MP_TAC num_closure_pos; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`A`;`m`] terminal_endpoint; ASM_MESON_TAC[]; THM_INTRO_TAC[`A`;`p`] terminal_endpoint; ASM_MESON_TAC[]; IMATCH_MP_TAC num_closure_pos; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`B`;`m`] terminal_endpoint; ASM_MESON_TAC[]; THM_INTRO_TAC[`B`;`p`] terminal_endpoint; ASM_MESON_TAC[]; ]);; (* }}} *) let cls_h = prove_by_refinement( `!m. (cls {(h_edge m)} = {m, (right m)})`, (* {{{ proof *) [ REWRITE_TAC[cls]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR in_pair;INR IN_SING;]; CONV_TAC (dropq_conv "e"); REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;]; MESON_TAC[]; ]);; (* }}} *) let cls_v = prove_by_refinement( `!m. (cls {(v_edge m)} = {m, (up m)})`, (* {{{ proof *) [ REWRITE_TAC[cls]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR in_pair;INR IN_SING;]; CONV_TAC (dropq_conv "e"); REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;]; MESON_TAC[]; ]);; (* }}} *) let rectagon_rectangle_grid_sq = prove_by_refinement( `!p. rectagon ((rectangle_grid p (FST p +: &:1, SND p +: &:1)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `E = rectagon (rectangle_grid p (FST p +: &:1,SND p +: &:1))` ABBREV_TAC ; TYPE_THEN `segment_end {(h_edge p)} p (right p) /\ segment_end {(v_edge p)} p (up p) /\ segment_end { (h_edge (up p)) } (up p) (right (up p)) /\ segment_end {(v_edge (right p))} (right p) (right (up p))` SUBAGOAL_TAC; (REPEAT CONJ_TAC) THEN IMATCH_MP_TAC segment_end_sing THEN REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right ;up; vc_edge;hc_edge; UNION ;plus_e12; INR IN_SING; PAIR_SPLIT ] THEN INT_ARITH_TAC ; (* - *) THM_INTRO_TAC[`{(h_edge p)}`;`{(v_edge (right p))}`;`p`;`right p`;`right (up p)`] segment_end_union; THM_INTRO_TAC[`p`] cls_h; THM_INTRO_TAC[`right p`] cls_v; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING;]; REWRITE_TAC[INR in_pair;right ;up; PAIR_SPLIT ]; INT_ARITH_TAC; (* - *) THM_INTRO_TAC[`{(v_edge p)}`;`{(h_edge (up p))}`;`p`;`up p`;`right (up p)`] segment_end_union; THM_INTRO_TAC[`p`] cls_v; THM_INTRO_TAC[`up p`] cls_h; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR IN_SING;]; REWRITE_TAC[INR in_pair;right ;up; PAIR_SPLIT ]; INT_ARITH_TAC; (* - *) THM_INTRO_TAC[`{(v_edge p)} UNION {(h_edge (up p))}`;`{(h_edge p)} UNION {(v_edge (right p))}`;`p`;`right (up p)`] segment_end_union_rectagon; CONJ_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 7(REWRITE_RULE[INTER;UNION;INR IN_SING]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses;up;PAIR_SPLIT ]; UND 8 THEN INT_ARITH_TAC; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses;up; right ;PAIR_SPLIT ]; UND 8 THEN INT_ARITH_TAC; REWRITE_TAC[cls_h;cls_v;cls_union]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[up; right ; INTER; UNION;]; REWRITE_TAC[INR in_pair]; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `FST x = FST p` ASM_CASES_TAC; REWRITE_TAC[INT_ARITH `~(FST p = FST p +: &:1)`]; INT_ARITH_TAC; INT_ARITH_TAC; (* - *) TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `{(h_edge p), (h_edge (up p)), (v_edge p),( v_edge (right p))} = (({(v_edge p)} UNION {(h_edge (up p))}) UNION {(h_edge p)} UNION {(v_edge (right p))})` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; REWRITE_TAC[INR IN_SING]; REWRITE_TAC[INSERT]; MESON_TAC[]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let conn2_union_edge = prove_by_refinement( `!A B. A SUBSET edge /\ B SUBSET edge /\ conn2 A /\ conn2 B /\ (~(A INTER B = EMPTY)) ==> conn2 (A UNION B)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC conn2_union; USE 0 (REWRITE_RULE [EMPTY_EXISTS;INTER;]); TYPE_THEN `edge u` SUBAGOAL_TAC; ASM_MESON_TAC[ISUBSET]; USE 6 (MATCH_MP cls_edge_size2); FULL_REWRITE_TAC[has_size2]; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; USE 7 SYM; REWRITE_TAC[SUBSET_INTER]; CONJ_TAC; IMATCH_MP_TAC cls_subset; ASM_REWRITE_TAC[SUBSET;INR IN_SING]; IMATCH_MP_TAC cls_subset; ASM_REWRITE_TAC[SUBSET;INR IN_SING]; ]);; (* }}} *) let rectangle_grid_h_conn2 = prove_by_refinement( `!n p. conn2 (rectangle_grid p (FST p +: &:(SUC n), SND p +: &:1))`, (* {{{ proof *) [ INDUCT_TAC; REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ; IMATCH_MP_TAC conn2_rectagon; REWRITE_TAC[rectagon_rectangle_grid_sq]; (* - *) TYPE_THEN `rectangle_grid p (FST p +: &:(SUC (SUC n)),SND p +: &:1) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:1) UNION rectangle_grid (FST p +: &:(SUC n),SND p) (FST p +: &:(SUC (SUC n)),SND p +: &:1)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; (* - *) IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `edge x` SUBAGOAL_TAC; ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; FULL_REWRITE_TAC [edge]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_v]; UND 4 THEN UND 5 THEN INT_ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_h]; UND 4 THEN UND 5 THEN INT_ARITH_TAC; (* -- *) TYPE_THEN `edge x` SUBAGOAL_TAC; ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; FULL_REWRITE_TAC [edge]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_v]; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; UND 5 THEN INT_ARITH_TAC; TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC; int_le_tac; clean_int_le_tac; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_h]; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; UND 5 THEN INT_ARITH_TAC; TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC; int_le_tac; clean_int_le_tac; (* -A *) IMATCH_MP_TAC conn2_union_edge; REWRITE_TAC[rectangle_grid_edge]; CONJ_TAC; IMATCH_MP_TAC conn2_rectagon; THM_INTRO_TAC[`FST p +: &:(SUC n),SND p`] rectagon_rectangle_grid_sq; TYPE_THEN `(FST p +: &:(SUC (SUC n)),SND p +: &:1) = (FST (FST p +: &:(SUC n),SND p) +: &:1, SND (FST p +: &:(SUC n),SND p) +: &:1)` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT;GSYM INT_OF_NUM_SUC]; INT_ARITH_TAC; REWR 2; UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;]; TYPE_THEN `v_edge (FST p +: &:(SUC n),SND p)` EXISTS_TAC; REWRITE_TAC[rectangle_grid_v]; REPEAT CONJ_TAC THEN (TRY INT_ARITH_TAC); TYPE_THEN `FST p + (&:0)*(&:(SUC n)) <=: FST p + &: (SUC n)` SUBAGOAL_TAC; int_le_tac; clean_int_le_tac; REWRITE_TAC[GSYM INT_OF_NUM_SUC]; INT_ARITH_TAC; ]);; (* }}} *) let rectangle_grid_conn2 = prove_by_refinement( `!m n p. conn2 (rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)))`, (* {{{ proof *) [ INDUCT_TAC; REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ; REWRITE_TAC[rectangle_grid_h_conn2]; (* - *) TYPE_THEN `rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)) UNION rectangle_grid (FST p ,SND p + &:(SUC m)) (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m)))` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; (* - *) IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `edge x` SUBAGOAL_TAC; ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; FULL_REWRITE_TAC [edge]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_v]; UND 1 THEN UND 3 THEN INT_ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_h]; UND 1 THEN UND 3 THEN INT_ARITH_TAC; (* -- *) TYPE_THEN `edge x` SUBAGOAL_TAC; ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; FULL_REWRITE_TAC [edge]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_v]; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; UND 3 THEN INT_ARITH_TAC; TYPE_THEN `(SND p +: (&:0)*((SND m' - (SND p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC; int_le_tac; clean_int_le_tac; (* -- *) TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[rectangle_grid_h]; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; UND 3 THEN INT_ARITH_TAC; TYPE_THEN `(SND p +: (&:0)*((SND m' - (SND p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC; int_le_tac; clean_int_le_tac; (* -A *) IMATCH_MP_TAC conn2_union_edge; REWRITE_TAC[rectangle_grid_edge]; CONJ_TAC; THM_INTRO_TAC[`n`;`(FST p,SND p +: &:(SUC m))` ] rectangle_grid_h_conn2; TYPE_THEN `(FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = (FST (FST p,SND p +: &:(SUC m)) +: &:(SUC n), SND (FST p,SND p +: &:(SUC m)) +: &:1)` SUBAGOAL_TAC; REWRITE_TAC[GSYM INT_OF_NUM_SUC;PAIR_SPLIT ]; INT_ARITH_TAC; REWR 2; (* - // *) UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;]; TYPE_THEN `h_edge (FST p ,SND p + &:(SUC m))` EXISTS_TAC; REWRITE_TAC[rectangle_grid_h]; REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC INT_LE_LADD_IMP)) THEN (REWRITE_TAC[INT_OF_NUM_LE;INT_LE_ADDR ]) THEN (TRY INT_ARITH_TAC) THEN (TRY ARITH_TAC); ]);; (* }}} *) let conn2_has_rectagon = prove_by_refinement( `!E. (E SUBSET edge) /\ (conn2 E) ==> (?B. (B SUBSET E) /\ rectagon B)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?e. E e` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; THM_INTRO_TAC[`E`;`1`] card_has_subset; UND 2 THEN ARITH_TAC; FULL_REWRITE_TAC[has_size1;SING ]; TYPE_THEN `B` UNABBREV_TAC; FULL_REWRITE_TAC[SUBSET;INR IN_SING]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `edge e` SUBAGOAL_TAC; ASM_MESON_TAC[ISUBSET]; USE 3 (MATCH_MP cls_edge_size2); FULL_REWRITE_TAC[has_size2]; (* - *) TYPE_THEN `2 <=| num_closure E (pointI a)` SUBAGOAL_TAC; IMATCH_MP_TAC (ARITH_RULE `~(x = 0) /\ ~(x = 1) ==> 2 <= x`); CONJ_TAC; THM_INTRO_TAC[`E`;`pointI a`] num_closure0; FULL_REWRITE_TAC[conn2]; REWR 6; TYPE_THEN `cls {e} a` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; FULL_REWRITE_TAC[cls;INR IN_SING ]; ASM_MESON_TAC[]; ASM_MESON_TAC[conn2_no1]; FULL_REWRITE_TAC[num_closure]; THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI a)}`;`2`] card_has_subset; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; FULL_REWRITE_TAC[conn2]; REWRITE_TAC[SUBSET]; FULL_REWRITE_TAC[has_size2]; TYPE_THEN `B` UNABBREV_TAC; USE 7(REWRITE_RULE[SUBSET;INR in_pair ]); (* - *) TYPE_THEN `?e' . (E e' /\ closure top2 e' (pointI a) /\ ~(e = e'))` SUBAGOAL_TAC; TYPE_THEN `e = a'` ASM_CASES_TAC; TYPE_THEN `b'` EXISTS_TAC; TYPE_THEN `a'` UNABBREV_TAC; TSPEC `b'` 7; ASM_MESON_TAC[]; TYPE_THEN `a'` EXISTS_TAC; ASM_MESON_TAC[]; (* -A *) TYPE_THEN`?c. (cls {e'} = {a,c}) /\ ~(c = a) ` SUBAGOAL_TAC; TYPE_THEN `edge e'` SUBAGOAL_TAC; ASM_MESON_TAC[ISUBSET]; USE 11 (MATCH_MP cls_edge_size2); FULL_REWRITE_TAC[has_size2]; USE 12 SYM; TYPE_THEN `cls{e'} a` SUBAGOAL_TAC; REWRITE_TAC[cls;INR IN_SING ]; ASM_MESON_TAC[]; TYPE_THEN `cls {e'}` UNABBREV_TAC; FULL_REWRITE_TAC[INR in_pair]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `b''` UNABBREV_TAC; TYPE_THEN `a''` EXISTS_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR in_pair]; MESON_TAC[]; TYPE_THEN `a''` UNABBREV_TAC; TYPE_THEN `b''` EXISTS_TAC; ASM_MESON_TAC[]; (* -B *) TYPE_THEN `~(c = b)` SUBAGOAL_TAC; TYPE_THEN`c` UNABBREV_TAC; TYPE_THEN `cls{e} = cls{e'}` SUBAGOAL_TAC; ASM_MESON_TAC[cls_inj;ISUBSET]; (* - *) TYPE_THEN `?S. S SUBSET E /\ segment_end S b c /\ ~cls S a` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `cls {e} b /\ cls {e'} c` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; USE 12 SYM; USE 4 SYM; TYPE_THEN `cls {e} SUBSET cls E /\ cls {e'} SUBSET cls E` SUBAGOAL_TAC; CONJ_TAC THEN IMATCH_MP_TAC cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING]; ASM_MESON_TAC[ISUBSET]; (* -C *) THM_INTRO_TAC[`b`;`a`;`e`] segment_end_sing; TYPE_THEN `cls {e} a /\ cls {e} b` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; FULL_REWRITE_TAC[cls;INR IN_SING ]; ASM_MESON_TAC[ISUBSET]; THM_INTRO_TAC[`a`;`c`;`e'`] segment_end_sing; TYPE_THEN `cls {e'} a /\ cls {e'} c` SUBAGOAL_TAC; REWRITE_TAC[INR in_pair]; FULL_REWRITE_TAC[cls;INR IN_SING ]; ASM_MESON_TAC[ISUBSET]; (* - *) THM_INTRO_TAC[`{e}`;`{e'}`;`b`;`a`;`c`] segment_end_union; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR in_pair;INR IN_SING]; ASM_MESON_TAC[]; (* -D *) THM_INTRO_TAC[`S`;`{e} UNION {e'}`;`b`;`c`] segment_end_union_rectagon; REWRITE_TAC[cls_union; UNION_OVER_INTER; EMPTY_UNION; ]; CONJ_TAC; REWRITE_TAC[EQ_EMPTY;INTER ;INR IN_SING ]; CONJ_TAC ; TYPE_THEN `x` UNABBREV_TAC; USE 4 SYM; TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; ASM_MESON_TAC[ISUBSET;INR IN_SING]; USE 20 (REWRITE_RULE[SUBSET]); TSPEC `a` 20; TYPE_THEN `cls {e}` UNABBREV_TAC; FULL_REWRITE_TAC[INR in_pair]; ASM_MESON_TAC[]; USE 12 SYM; TYPE_THEN `cls {e'} SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; ASM_MESON_TAC[ISUBSET;INR IN_SING]; USE 22 (REWRITE_RULE[SUBSET]); TSPEC `a` 22; TYPE_THEN `cls {e'}` UNABBREV_TAC; FULL_REWRITE_TAC[INR in_pair]; ASM_MESON_TAC[]; (* --E *) REWRITE_TAC[GSYM UNION_OVER_INTER]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair]; TYPE_THEN `((x = c) \/ (x = b)) \/ (x = a)` SUBAGOAL_TAC; ASM_MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; (* -- *) REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair]; TYPE_THEN `cls S b /\ cls S c` SUBAGOAL_TAC; ASM_MESON_TAC[segment_end_cls2;segment_end_cls]; ASM_MESON_TAC[]; TYPE_THEN `(S UNION {e} UNION {e'})` EXISTS_TAC; REWRITE_TAC[union_subset]; REWRITE_TAC[SUBSET;INR IN_SING]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION T *) (* ------------------------------------------------------------------ *) (* 1.0.6 rectagon components *) (* redo some results from E that USE the segment hypothesis *) let curve_cell_h_ver2 = prove_by_refinement( `!G n. (curve_cell G (h_edge n) = G (h_edge n))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI]; ]);; (* }}} *) let curve_cell_v_ver2 = prove_by_refinement( `!G n. (curve_cell G (v_edge n) = G (v_edge n))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI]; ]);; (* }}} *) let curve_closure_ver2 = prove_by_refinement( `!G. (FINITE G) /\ (G SUBSET edge) ==> (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC top2_top; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; ASM_SIMP_TAC[closure_unions]; REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ]; TYPE_THEN `edge x'` SUBGOAL_TAC; ASM_MESON_TAC[ISUBSET]; FULL_REWRITE_TAC [edge]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `t` UNABBREV_TAC; FULL_REWRITE_TAC [v_edge_closure;vc_edge;UNION ;INR IN_SING ]; UND 3 THEN REP_CASES_TAC; TYPE_THEN `v_edge m` EXISTS_TAC; ASM_SIMP_TAC [curve_cell_v_ver2]; TYPE_THEN `{(pointI m)}` EXISTS_TAC; (* ---- *) ASM_SIMP_TAC [curve_cell_point]; REWRITE_TAC[INR IN_SING]; UNIFY_EXISTS_TAC; REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ]; TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC; ASM_SIMP_TAC [curve_cell_point]; REWRITE_TAC[INR IN_SING;plus_e12]; TYPE_THEN `v_edge m` EXISTS_TAC; REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ]; (* dt2 , down to 2 goals *) TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `t` UNABBREV_TAC; FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING]; UND 3 THEN REP_CASES_TAC; TYPE_THEN `h_edge m` EXISTS_TAC; ASM_SIMP_TAC[curve_cell_h_ver2]; TYPE_THEN `{(pointI m)}` EXISTS_TAC; ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ]; TYPE_THEN `h_edge m` EXISTS_TAC; FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING]; TYPE_THEN `{x}` EXISTS_TAC; ASM_REWRITE_TAC[INR IN_SING]; ASM_SIMP_TAC[curve_cell_point ;INR IN_SING;plus_e12 ]; TYPE_THEN `h_edge m` EXISTS_TAC; FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING;plus_e12]; (* dt1 *) REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset]; ASM_SIMP_TAC[closure_unions]; CONJ_TAC; REWRITE_TAC[SUBSET;IMAGE;UNIONS]; DISCH_ALL_TAC; CONV_TAC (dropq_conv "u"); NAME_CONFLICT_TAC; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[subset_closure;ISUBSET ]; (* // *) TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ; REWRITE_TAC[UNIONS;SUBSET ]; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC [INR IN_SING]; ASM_MESON_TAC []; ]);; (* }}} *) let curve_cell_h_inter_ver2 = prove_by_refinement( `!G m. (FINITE G) /\ (G SUBSET edge) ==> (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> (~(G (h_edge m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; ONCE_REWRITE_TAC [GSYM curve_cell_h_ver2]; IMATCH_MP_TAC cell_inter; ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; ASM_MESON_TAC[segment;curve_cell_cell]; ]);; (* }}} *) let curve_cell_v_inter_ver2 = prove_by_refinement( `!G m. (FINITE G) /\ (G SUBSET edge) ==> (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> (~(G (v_edge m))))`, (* {{{ proof *) [ DISCH_ALL_TAC; ONCE_REWRITE_TAC [GSYM curve_cell_v_ver2]; IMATCH_MP_TAC cell_inter; ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; ASM_MESON_TAC[segment;curve_cell_cell]; ]);; (* }}} *) let curve_cell_squ_ver2 = prove_by_refinement( `!G m. (FINITE G) /\ (G SUBSET edge) ==> ~curve_cell G (squ m)`, (* {{{ proof *) [ REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment]; FULL_REWRITE_TAC [SUBSET; edge]; TSPEC `squ m` 1; USE 0(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;cell_clauses]); ]);; (* }}} *) let curve_cell_squ_inter_ver2 = prove_by_refinement( `!G m. (FINITE G) /\ (G SUBSET edge) ==> (((squ m) INTER (UNIONS (curve_cell G)) = {}))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `cell (squ m)` SUBGOAL_TAC; REWRITE_TAC[cell_rules]; TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC; ASM_MESON_TAC[curve_cell_cell;segment]; ASM_SIMP_TAC [cell_inter]; ASM_MESON_TAC [curve_cell_squ_ver2]; ]);; (* }}} *) let curve_point_unions_ver2 = prove_by_refinement( `!G m. (FINITE G) /\ (G SUBSET edge) ==> (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC; REWRITE_TAC[REWRITE_RULE[not_eq] single_inter]; REWRITE_TAC [not_eq]; IMATCH_MP_TAC cell_inter; ASM_MESON_TAC[cell_rules;curve_cell_cell]; ]);; (* }}} *) let curve_cell_not_point_ver2 = prove_by_refinement( `!G m. (FINITE G) /\ (G SUBSET edge) ==> ((curve_cell G {(pointI m)} <=> ~(num_closure G (pointI m) = 0)))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[curve_cell_point;num_closure0]; ASM_MESON_TAC[]; ]);; (* }}} *) let curve_closed_ver2 = prove_by_refinement( `!G. (FINITE G) /\ (G SUBSET edge) ==> (closed_ top2 (UNIONS (curve_cell G)))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[GSYM curve_closure_ver2]; IMATCH_MP_TAC closure_closed; REWRITE_TAC[top2_top]; IMATCH_MP_TAC UNIONS_SUBSET; FULL_REWRITE_TAC [SUBSET;top2_unions;edge; ]; ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid]; ]);; (* }}} *) let ctop_top2_ver2 = prove_by_refinement( `!G A. (FINITE G) /\ (G SUBSET edge) /\ ctop G A ==> top2 A`, (* {{{ proof *) [ REWRITE_TAC[ctop;induced_top;IMAGE ;]; TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ; TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC; TYPE_THEN `U` UNABBREV_TAC; ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; IMATCH_MP_TAC top_inter; ASM_REWRITE_TAC[top2_top;]; ASM_SIMP_TAC[GSYM curve_closure_ver2;top2]; IMATCH_MP_TAC (REWRITE_RULE[open_DEF] closed_open); IMATCH_MP_TAC closure_closed; CONJ_TAC; TYPE_THEN `U` UNABBREV_TAC; ASM_MESON_TAC[top_of_metric_top;metric_euclid]; USE 5(GSYM); ASM_REWRITE_TAC[]; IMATCH_MP_TAC UNIONS_SUBSET; FULL_REWRITE_TAC [edge;ISUBSET;]; TSPEC `A'` 2; REWRITE_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[ (REWRITE_RULE[ISUBSET;] v_edge_euclid)]; ASM_MESON_TAC [(REWRITE_RULE[ISUBSET;] h_edge_euclid)]; ]);; (* }}} *) let convex_connected_ver2 = prove_by_refinement( `!G Z. (FINITE G) /\ (G SUBSET edge) /\ convex Z /\ (Z SUBSET (UNIONS (ctop G))) ==> (connected (ctop G) Z)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[connected]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; USE 8 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]); LEFT 8 "x"; LEFT 9 "x"; TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC; FULL_REWRITE_TAC [convex]; ASM_MESON_TAC[ISUBSET]; TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC; IMATCH_MP_TAC connected_mk_segment; USE 3(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]); (* - *) FULL_REWRITE_TAC [connected]; TYPEL_THEN [`A`;`B`] (USE 13 o ISPECL); REWR 13; TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC; REWRITE_TAC[GSYM top2]; ASM_MESON_TAC[ctop_top2_ver2;top2]; UND 13 THEN ASM_REWRITE_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; (* -- *) UND 9 THEN REWRITE_TAC[]; UND 8 THEN ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; ASM_MESON_TAC[mk_segment_end;ISUBSET]; ASM_MESON_TAC [mk_segment_end;ISUBSET ]; ]);; (* }}} *) let convex_component_ver2 = prove_by_refinement( `!G Z x. (FINITE G) /\ (G SUBSET edge) /\ convex Z /\ (Z SUBSET (UNIONS (ctop G))) /\ (~(Z INTER (component (ctop G) x ) = EMPTY)) ==> (Z SUBSET (component (ctop G) x)) `, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC; ASM_SIMP_TAC[convex_connected_ver2]; USE 4(REWRITE_RULE[EMPTY_EXISTS;INTER ]); USE 4(MATCH_MP component_replace); IMATCH_MP_TAC connected_component; ]);; (* }}} *) let unions_cell_of_ver2 = prove_by_refinement( `!G x. ((FINITE G) /\ (G SUBSET edge) ==> (UNIONS (cell_of (component (ctop G) x)) = component (ctop G) x))`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; REWRITE_TAC [UNIONS;SUBSET;cell_of]; CONJ_TAC; TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC; UND 2 THEN REWRITE_TAC[component_DEF ;connected;SUBSET ;ctop_unions;DIFF ]; USE 3 (MATCH_MP point_onto); TYPE_THEN `x'` UNABBREV_TAC; ASSUME_TAC cell_unions; TSPEC `p` 3; USE 3 (REWRITE_RULE[UNIONS]); TYPE_THEN `u` EXISTS_TAC; (* - *) DISCH_ALL_TAC; TYPE_THEN `u SUBSET (component (ctop G) x)` SUBAGOAL_TAC; IMATCH_MP_TAC convex_component_ver2 ; ASM_REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; ASM_MESON_TAC[cell_convex]; CONJ_TAC; REWRITE_TAC[ctop_unions]; REWRITE_TAC[DIFF;SUBSET ]; CONJ_TAC; ASM_MESON_TAC[cell_euclid;ISUBSET]; FULL_REWRITE_TAC[UNIONS]; USE 1 (MATCH_MP curve_cell_cell); USE 1 (REWRITE_RULE[ISUBSET]); TSPEC `u'` 1; TYPE_THEN `u = u'` SUBGOAL_TAC; IMATCH_MP_TAC cell_partition; REWRITE_TAC[EMPTY_EXISTS;INTER]; ASM_MESON_TAC[]; (* --- *) USE 2 (REWRITE_RULE[component_DEF;connected;SUBSET ]); TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC; USE 12(REWRITE_RULE[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ]); ASM_MESON_TAC[]; TYPE_THEN `point p` EXISTS_TAC; ASM_REWRITE_TAC [INTER]; (* - *) FULL_REWRITE_TAC [ISUBSET]; ]);; (* }}} *) let unbounded = jordan_def `unbounded C <=> (?r. !s. (r <=. s) ==> C (point(s,&.0)))`;; let curve_cell_empty = prove_by_refinement( `curve_cell EMPTY = EMPTY `, (* {{{ proof *) [ REWRITE_TAC[curve_cell]; REWRITE_TAC[EQ_EMPTY]; THM_INTRO_TAC[`top2`] closure_empty; REWRITE_TAC[top2_top]; REWR 0; ]);; (* }}} *) let curve_cell_union = prove_by_refinement( `!A B. curve_cell (A UNION B) = curve_cell A UNION curve_cell B`, (* {{{ proof *) [ REWRITE_TAC[curve_cell]; FULL_REWRITE_TAC[UNIONS_UNION;]; ASM_SIMP_TAC[top2_top;closure_union]; TYPE_THEN `{z | ?n. (z = {(pointI n)}) /\ (closure top2 (UNIONS A) UNION closure top2 (UNIONS B)) (pointI n)} = ( {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}) UNION ({z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)})` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; MESON_TAC[]; TYPE_THEN `C = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}` ABBREV_TAC ; TYPE_THEN `D = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)}` ABBREV_TAC ; REWRITE_TAC[UNION_ACI]; ]);; (* }}} *) let insert_sing = prove_by_refinement( `!A (x:A). x INSERT A = {x} UNION A`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INSERT;UNION;INR IN_SING]; MESON_TAC[]; ]);; (* }}} *) let curve_cell_sing = prove_by_refinement( `!e. (edge e) ==> (UNIONS (curve_cell {e}) = closure top2 e)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[curve_cell;UNIONS_UNION]; FULL_REWRITE_TAC[edge]; FIRST_ASSUM DISJ_CASES_TAC; REWRITE_TAC[v_edge_closure;vc_edge;plus_e12]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;UNIONS]; CONV_TAC (dropq_conv "u"); REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj]; RIGHT_TAC "n"; TYPE_THEN `v_edge m x` ASM_CASES_TAC; MESON_TAC[]; (* - *) REWRITE_TAC[h_edge_closure;hc_edge;plus_e12]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;UNIONS]; CONV_TAC (dropq_conv "u"); REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj]; RIGHT_TAC "n"; TYPE_THEN `h_edge m x` ASM_CASES_TAC; MESON_TAC[]; ]);; (* }}} *) let unbounded_elt = prove_by_refinement( `!G. (FINITE G) /\ (G SUBSET edge) ==> (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r))`, (* {{{ proof *) [ TYPE_THEN `!G. (FINITE G) ==> ((G SUBSET edge) ==> (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r)))` SUBAGOAL_TAC THENL[IMATCH_MP_TAC FINITE_INDUCT_STRONG ;ASM_MESON_TAC[]]; (* - *) CONJ_TAC; REWRITE_TAC[curve_cell_empty]; (* - *) ASSUME_TAC top2_top; ONCE_REWRITE_TAC[insert_sing]; REWRITE_TAC[curve_cell_union;UNIONS_UNION]; REWRITE_TAC[UNION;]; NAME_CONFLICT_TAC; THM_INTRO_TAC[`x`] curve_cell_sing; FULL_REWRITE_TAC[INSERT;SUBSET]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `G SUBSET edge` SUBAGOAL_TAC; FULL_REWRITE_TAC[ISUBSET;INSERT]; ASM_MESON_TAC[]; REP_BASIC_TAC; (* - *) TYPE_THEN `edge x` SUBAGOAL_TAC; FULL_REWRITE_TAC[INSERT;SUBSET;]; ASM_MESON_TAC[]; TYPE_THEN `?r. !x'. closure top2 x x' ==> x' 0 < r` SUBAGOAL_TAC; USE 7(REWRITE_RULE[edge]); FIRST_ASSUM DISJ_CASES_TAC; REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING;plus_e12 ]; TYPE_THEN `real_of_int (FST m) + (&1)` EXISTS_TAC; FULL_REWRITE_TAC[pointI]; UND 9 THEN REP_CASES_TAC THEN FULL_REWRITE_TAC[v_edge;coord01]; FULL_REWRITE_TAC[v_edge;coord01]; REAL_ARITH_TAC; REWRITE_TAC[coord01]; REAL_ARITH_TAC; REWRITE_TAC[coord01;pointI]; REAL_ARITH_TAC; (* --A *) REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING;plus_e12 ]; TYPE_THEN `real_of_int (FST m) + (&2)` EXISTS_TAC; UND 9 THEN REP_CASES_TAC; FULL_REWRITE_TAC[h_edge;coord01]; FULL_REWRITE_TAC[h_edge;coord01]; FULL_REWRITE_TAC[int_add_th;int_of_num_th]; UND 10 THEN REAL_ARITH_TAC; REWRITE_TAC[pointI]; REAL_ARITH_TAC; REWRITE_TAC[pointI]; FULL_REWRITE_TAC[int_add_th;int_of_num_th]; REAL_ARITH_TAC; (* - *) TYPE_THEN `max_real r r'` EXISTS_TAC; TSPEC `x'` 3; FIRST_ASSUM DISJ_CASES_TAC; UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `r'` EXISTS_TAC; ASM_REWRITE_TAC[max_real_le]; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `r` EXISTS_TAC; REWRITE_TAC[max_real_le]; ]);; (* }}} *) let mk_segment_convex = prove_by_refinement( `!x y. convex (mk_segment x y)`, (* {{{ proof *) [ REWRITE_TAC[convex]; FULL_REWRITE_TAC[mk_segment;SUBSET;]; REP_BASIC_TAC; REWRITE_TAC[euclid_ldistrib]; ONCE_REWRITE_TAC[euclid_plus_pair]; REWRITE_TAC[euclid_scale_act]; REWRITE_TAC[GSYM euclid_rdistrib]; TYPE_THEN `(a * a'' + (&1 - a) * a')` EXISTS_TAC; CONJ_TAC; ineq_le_tac `(&0) + (a * a'') + (&1 - a)* a' = (a * a'' + (&1 - a)*a')`; CONJ_TAC; ineq_le_tac `(a * a'' + (&1 - a) * a') + ((&1 - a)*(&1 - a')) + a*(&1 - a'') = &1`; AP_TERM_TAC; AP_THM_TAC; AP_TERM_TAC; real_poly_tac; ]);; (* }}} *) let mk_segment_h = prove_by_refinement( `!r s b x. (r <= s) ==> (mk_segment (point(r,b)) (point(s,b)) x <=> (?t. (r <= t /\ t <= s /\ (x = point(t,b)))))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[mk_segment]; REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC; CONJ_TAC; ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`; ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`; TYPE_THEN `s = r` ASM_CASES_TAC; REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`]; TYPE_THEN `&0` EXISTS_TAC; UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC; REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ; TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC; TYPE_THEN `v` UNABBREV_TAC; REWRITE_TAC[GSYM real_div_assoc]; REDUCE_TAC; IMATCH_MP_TAC REAL_DIV_REFL; UND 5 THEN UND 4 THEN REAL_ARITH_TAC; TYPE_THEN `v*(s - t)` EXISTS_TAC; TYPE_THEN `&0 < v` SUBAGOAL_TAC; TYPE_THEN `v` UNABBREV_TAC; IMATCH_MP_TAC REAL_LT_DIV; UND 4 THEN UND 0 THEN REAL_ARITH_TAC; (* - *) CONJ_TAC; IMATCH_MP_TAC REAL_LE_MUL; UND 7 THEN UND 2 THEN REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_LCANCEL_IMP; TYPE_THEN `(s - r)` EXISTS_TAC; CONJ_TAC; UND 4 THEN UND 0 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_ASSOC]; REDUCE_TAC; UND 3 THEN REAL_ARITH_TAC; TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC]; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ]);; (* }}} *) let unbounded_comp = prove_by_refinement( `!G. (FINITE G) /\ (G SUBSET edge) ==> (?x. unbounded (component (ctop G) x))` , (* {{{ proof *) [ REWRITE_TAC[unbounded]; THM_INTRO_TAC[`G`] unbounded_elt; TYPE_THEN `point(r, &0)` EXISTS_TAC; TYPE_THEN `r` EXISTS_TAC; TYPE_THEN `Z = mk_segment (point(r, &0)) (point(s, &0))` ABBREV_TAC ; THM_INTRO_TAC[`G`;`Z`;`(point(r, &0))`] convex_component_ver2; CONJ_TAC; TYPE_THEN `Z` UNABBREV_TAC; REWRITE_TAC[mk_segment_convex]; (* -- *) CONJ_TAC; TYPE_THEN `Z` UNABBREV_TAC; REWRITE_TAC[ctop_unions]; REWRITE_TAC[SUBSET;DIFF]; THM_INTRO_TAC[`r`;`s`;`&0`;`x`] mk_segment_h; REWR 5; REWRITE_TAC[euclid_point]; TSPEC `(point (t ,&0))` 2; FULL_REWRITE_TAC[coord01]; UND 2 THEN UND 7 THEN REAL_ARITH_TAC; UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `(point(r,&0))` EXISTS_TAC; REWRITE_TAC[INTER]; (* -- *) CONJ_TAC; TYPE_THEN `Z` UNABBREV_TAC; THM_INTRO_TAC[`r`;`s`;`&0`;`point(r,&0)`] mk_segment_h; TYPE_THEN `r` EXISTS_TAC; UND 3 THEN REAL_ARITH_TAC; IMATCH_MP_TAC component_refl; REWRITE_TAC[ctop_unions]; REWRITE_TAC[DIFF;euclid_point]; TSPEC `(point(r,&0))` 2; FULL_REWRITE_TAC[coord01]; UND 2 THEN REAL_ARITH_TAC; (* -A *) FULL_REWRITE_TAC[SUBSET]; TSPEC `(point(s,&0))` 5; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `Z` UNABBREV_TAC; REWRITE_TAC[mk_segment_end]; ]);; (* }}} *) let unbounded_comp_unique = prove_by_refinement( `!G x y. (FINITE G) /\ (G SUBSET edge) /\ (unbounded (component (ctop G) x)) /\ (unbounded(component (ctop G) y)) ==> (component (ctop G) x = component (ctop G) y) `, (* {{{ proof *) [ REWRITE_TAC[unbounded]; TSPEC `max_real r r'` 0; TSPEC `max_real r r'` 1; FULL_REWRITE_TAC[max_real_le]; ASM_MESON_TAC[component_replace]; ]);; (* }}} *) let unbounded_set = jordan_def `unbounded_set G x = unbounded(component (ctop G) x)`;; let bounded_set = jordan_def `bounded_set G x <=> ~(component (ctop G) x = EMPTY) /\ ~(unbounded (component (ctop G) x))`;; let bounded_unbounded_disj = prove_by_refinement( `!G. bounded_set G INTER unbounded_set G = EMPTY `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[EQ_EMPTY]; FULL_REWRITE_TAC[INTER;bounded_set;unbounded_set]; ASM_MESON_TAC[]; ]);; (* }}} *) let bounded_unbounded_union = prove_by_refinement( `!G. bounded_set G UNION unbounded_set G = UNIONS (ctop G)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;bounded_set;unbounded_set]; THM_INTRO_TAC[`G`] ctop_top; TYPE_THEN `component (ctop G) x = EMPTY` ASM_CASES_TAC; THM_INTRO_TAC[`ctop G`;`x`] component_empty; REWR 2; REWRITE_TAC[unbounded]; TSPEC `r + &1` 3; UND 3 THEN REAL_ARITH_TAC; REWRITE_TAC[TAUT `~A \/ A`]; ASM_MESON_TAC[component_empty]; ]);; (* }}} *) let bounded_subset_unions = prove_by_refinement( `!G x. (bounded_set G x ==> UNIONS (ctop G) x) `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[GSYM bounded_unbounded_union;UNION]; ]);; (* }}} *) let unbounded_subset_unions = prove_by_refinement( `!G x. (unbounded_set G x ==> UNIONS (ctop G) x) `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[GSYM bounded_unbounded_union;UNION]; ]);; (* }}} *) let unbounded_set_nonempty = prove_by_refinement( `!G. (FINITE G) /\ (G SUBSET edge) ==> ~(unbounded_set G = EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[unbounded_set]; THM_INTRO_TAC[`G`] unbounded_comp; ]);; (* }}} *) let unbounded_set_comp = prove_by_refinement( `!G. (FINITE G) /\ (G SUBSET edge) ==> (?x. unbounded_set G = component (ctop G) x)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`] unbounded_comp; TYPE_THEN `x` EXISTS_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; PROOF_BY_CONTR_TAC; USE 3(REWRITE_RULE[SUBSET]); LEFT 3 "x'"; UND 3 THEN REWRITE_TAC[]; THM_INTRO_TAC[`G`;`x`;`x'`] unbounded_comp_unique; FULL_REWRITE_TAC[unbounded_set]; IMATCH_MP_TAC component_refl; FULL_REWRITE_TAC[unbounded_set]; FULL_REWRITE_TAC[unbounded]; TSPEC `r` 3; FULL_REWRITE_TAC[ARITH_RULE `r <= r`]; TYPE_THEN `~(component (ctop G) x' = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[EQ_EMPTY]; ASM_MESON_TAC[]; THM_INTRO_TAC[`ctop G`;`x'`] component_empty; REWRITE_TAC[ctop_top]; ASM_MESON_TAC[]; (* - *) REWRITE_TAC[SUBSET]; REWRITE_TAC[unbounded_set]; TYPE_THEN `component (ctop G) x = component (ctop G) x'` SUBAGOAL_TAC; IMATCH_MP_TAC component_replace; ASM_MESON_TAC[]; ]);; (* }}} *) let unbounded_set_comp_elt = prove_by_refinement( `!G x. (FINITE G) /\ (G SUBSET edge) /\ (unbounded_set G = component (ctop G) x) ==> (unbounded_set G x)`, (* {{{ proof *) [ REP_BASIC_TAC ; THM_INTRO_TAC[`G`]unbounded_set_nonempty; FULL_REWRITE_TAC[EMPTY_EXISTS]; REWR 3; TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[EQ_EMPTY ]; ASM_MESON_TAC[]; ASSUME_TAC ctop_top; TYPE_THEN `(UNIONS (ctop G) x)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`ctop G`;`x`] component_empty; ASM_MESON_TAC[]; ASM_MESON_TAC[component_refl]; ]);; (* }}} *) let unbounded_even_subset = prove_by_refinement( `!G. rectagon G ==> (unbounded_set G SUBSET UNIONS (par_cell T G))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; THM_INTRO_TAC[`G`] unbounded_set_comp; THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp; FIRST_ASSUM DISJ_CASES_TAC; PROOF_BY_CONTR_TAC; KILL 6; KILL 4; THM_INTRO_TAC[`G`;`x`] unbounded_set_comp_elt; USE 4 (REWRITE_RULE[unbounded_set;unbounded]); THM_INTRO_TAC[`G`] unbounded_elt; TYPE_THEN `s = floor (max_real r r') + &:1` ABBREV_TAC ; TYPE_THEN `r < real_of_int s /\ r' < real_of_int s` SUBAGOAL_TAC; TYPE_THEN `s` UNABBREV_TAC; TYPE_THEN `!t u. t <= u ==> t <. real_of_int( floor u + &:1)` SUBAGOAL_TAC; REWRITE_TAC[int_add_th ; int_of_num_th]; IMATCH_MP_TAC REAL_LET_TRANS; TYPE_THEN `u` EXISTS_TAC; REWRITE_TAC[floor_ineq]; CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[max_real_le] ; (* -A *) TYPE_THEN `~(UNIONS (curve_cell G) (pointI (s, &:0)))` SUBAGOAL_TAC; TSPEC `pointI (s, &:0)` 6; USE 6 (REWRITE_RULE[pointI;coord01]); UND 6 THEN UND 8 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`G`] rectagon_segment; THM_INTRO_TAC[`G`;`(s,&:0)`] curve_point_unions; UND 12 THEN ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; (* - *) TYPE_THEN `par_cell T G {(pointI (s, &:0))}` SUBAGOAL_TAC; THM_INTRO_TAC[`G`;`(s, &:0)`;`T`] par_cell_point; CONJ_TAC; ASM_MESON_TAC[curve_cell_not_point]; REWRITE_TAC[num_lower]; TYPE_THEN `{m | G (h_edge m) /\ (FST m = s) /\ SND m <=: &:0} = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 6(REWRITE_RULE[UNIONS]); LEFT 6 "u"; LEFT 6 "u"; TSPEC `h_edge u` 6; THM_INTRO_TAC[`G`;`u`] curve_cell_h; REWR 6; USE 6(REWRITE_RULE[h_edge]); REWR 6; USE 6 (CONV_RULE (dropq_conv "x")); USE 6 (REWRITE_RULE[coord01]); USE 6 (CONV_RULE (dropq_conv "v")); TSPEC `real_of_int s + &1/ (&2)` 6; USE 6(REWRITE_RULE[int_add_th;int_of_num_th; REAL_LT_ADDR; REAL_LT_LADD; ]); UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]); IMATCH_MP_TAC half_pos; TYPE_THEN `real_of_int s < r'` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LT_TRANS; TYPE_THEN `real_of_int s + &1 / &2` EXISTS_TAC; REWRITE_TAC[REAL_LT_ADDR; REAL_LT_HALF1]; UND 18 THEN UND 8 THEN REAL_ARITH_TAC; REWRITE_TAC[CARD_CLAUSES;EVEN2]; (* -B *) TYPE_THEN `UNIONS (par_cell F G) (pointI (s,&:0))` SUBAGOAL_TAC; USE 5 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[pointI;int_of_num_th]; FIRST_ASSUM IMATCH_MP_TAC ; UND 9 THEN REAL_ARITH_TAC ; TYPE_THEN `UNIONS (par_cell T G) (pointI (s,&:0))` SUBAGOAL_TAC; REWRITE_TAC[UNIONS]; TYPE_THEN `{(pointI (s,&:0))}` EXISTS_TAC ; REWRITE_TAC[INR IN_SING]; (* - *) THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; USE 16(REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; ]);; (* }}} *) let odd_bounded_subset = prove_by_refinement( `!G. rectagon G ==> (UNIONS (par_cell F G) SUBSET bounded_set G)`, (* {{{ proof *) [ REP_BASIC_TAC; (* - *) REWRITE_TAC[SUBSET]; THM_INTRO_TAC[`G`] unbounded_even_subset; FULL_REWRITE_TAC[SUBSET]; TSPEC `x` 2; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[bounded_set;unbounded_set;DE_MORGAN_THM ]; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`G`] ctop_top; THM_INTRO_TAC[`ctop G`;`x`] component_empty; UND 6 THEN ASM_REWRITE_TAC[]; THM_INTRO_TAC[`G`]rectagon_segment; THM_INTRO_TAC[`G`;`T`] par_cell_partition; USE 7(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 7; FULL_REWRITE_TAC[UNION]; ASM_MESON_TAC[]; THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; ASM_MESON_TAC[]; ]);; (* }}} *) let unique_bounded = prove_by_refinement( `!G x y. (rectagon G) /\ bounded_set G x /\ bounded_set G y ==> (component (ctop G) x = component (ctop G) y) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`;`x`] bounded_subset_unions; THM_INTRO_TAC[`G`;`y`] bounded_subset_unions; TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC; FULL_REWRITE_TAC[rectagon]; THM_INTRO_TAC[`G`] unbounded_set_nonempty; FULL_REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`G`;`u`] unbounded_subset_unions; THM_INTRO_TAC[`G`] rectagon_h_edge; THM_INTRO_TAC[`G`] ctop_top; TYPE_THEN `~(component (ctop G) x = EMPTY) /\ ~(component (ctop G) u = EMPTY) /\ ~(component (ctop G) y = EMPTY)` SUBAGOAL_TAC; ASM_MESON_TAC[component_empty]; TYPE_THEN `segment G` SUBAGOAL_TAC; IMATCH_MP_TAC rectagon_segment; THM_INTRO_TAC[`G`;`x`;`h_edge m`] along_lemma11; THM_INTRO_TAC[`G`;`y`;`h_edge m`] along_lemma11; THM_INTRO_TAC[`G`;`u`;`h_edge m`] along_lemma11; USE 16 (MATCH_MP squc_h); USE 18 (MATCH_MP squc_h); USE 20 (MATCH_MP squc_h); TYPE_THEN `(p'' = p) \/ (p'' = p') \/ (p' = p)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `!p a b. squ p SUBSET component (ctop G) a /\ squ p SUBSET component (ctop G) b ==> (component (ctop G) a = component (ctop G) b)` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; THM_INTRO_TAC[`squ p'''`] cell_nonempty; REWRITE_TAC[cell_rules]; FULL_REWRITE_TAC[EMPTY_EXISTS]; TSPEC `u'` 22; TSPEC `u'` 23; KILL 19 THEN KILL 17 THEN KILL 15 THEN KILL 5; ASM_MESON_TAC[component_replace]; (* - *) TYPE_THEN `!a. bounded_set G a ==> ~(component (ctop G) a = component (ctop G) u)` SUBAGOAL_TAC; TYPE_THEN `unbounded_set G a` SUBAGOAL_TAC; REWRITE_TAC[unbounded_set]; REWRITE_TAC[GSYM unbounded_set]; THM_INTRO_TAC[`G`] bounded_unbounded_disj; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) UND 21 THEN REP_CASES_TAC; TYPE_THEN `p''` UNABBREV_TAC; UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p`;`u`;`x`]); UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); ASM_MESON_TAC[]; TYPE_THEN `p''` UNABBREV_TAC; UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p'`;`u`;`y`]); UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`y`]); ASM_MESON_TAC[]; TYPE_THEN `p'` UNABBREV_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; ]);; (* }}} *) let odd_bounded = prove_by_refinement( `!G. rectagon G ==> (UNIONS (par_cell F G) = bounded_set G)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC odd_bounded_subset; REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`G`;`F`] par_cell_nonempty; FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `?y. UNIONS (par_cell F G) y` SUBAGOAL_TAC; REWRITE_TAC[UNIONS]; LEFT_TAC "u"; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `cell u` SUBAGOAL_TAC; THM_INTRO_TAC[`G`;`F`] par_cell_cell; ASM_MESON_TAC[ISUBSET]; USE 4 (MATCH_MP cell_nonempty); FULL_REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`G`] odd_bounded_subset; TYPE_THEN `bounded_set G y` SUBAGOAL_TAC; ASM_MESON_TAC[ISUBSET]; (* - *) THM_INTRO_TAC[`G`;`x`;`y`] unique_bounded; TYPE_THEN `component (ctop G) y SUBSET UNIONS (par_cell F G)` SUBAGOAL_TAC; THM_INTRO_TAC[`G`;`F`;`y`] par_cell_comp; FIRST_ASSUM DISJ_CASES_TAC; USE 9 (REWRITE_RULE[SUBSET]); TSPEC `y` 9; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]); IMATCH_MP_TAC component_refl; IMATCH_MP_TAC bounded_subset_unions; THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) USE 7 SYM; REWR 8; USE 8 (REWRITE_RULE[SUBSET]); UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); IMATCH_MP_TAC component_refl; IMATCH_MP_TAC bounded_subset_unions; ASM_MESON_TAC[]; ]);; (* }}} *) let unbounded_even = prove_by_refinement( `!G. rectagon G ==> (unbounded_set G = UNIONS (par_cell T G))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; THM_INTRO_TAC[`G`] unbounded_even_subset; REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`G`] odd_bounded; USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 4; (* - *) TYPE_THEN `segment G` SUBAGOAL_TAC; IMATCH_MP_TAC rectagon_segment; TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC; THM_INTRO_TAC[`G`;`T`] par_cell_partition; USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 6; USE 6 (REWRITE_RULE[UNION]); ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`G`] bounded_unbounded_union; USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]); FULL_REWRITE_TAC[UNION]; TYPE_THEN `bounded_set G x` SUBAGOAL_TAC; ASM_MESON_TAC[]; REWR 4; THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; FULL_REWRITE_TAC[EQ_EMPTY;INTER]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_union_comp = prove_by_refinement( `!G eps x. (rectagon G) /\ (UNIONS (par_cell eps G) x) ==> (UNIONS (par_cell eps G) = component (ctop G) x)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `eps = T` ASM_CASES_TAC; TYPE_THEN `UNIONS (par_cell T G) = unbounded_set G` SUBAGOAL_TAC; ASM_MESON_TAC[unbounded_even]; TYPE_THEN `eps` UNABBREV_TAC; REWR 0; THM_INTRO_TAC[`G`]unbounded_set_comp; FULL_REWRITE_TAC[rectagon]; REWR 0; ASM_MESON_TAC[component_replace]; (* - *) TYPE_THEN `eps = F` ASM_CASES_TAC; TYPE_THEN `eps` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`G`;`x`;`x'`] unique_bounded; ASM_MESON_TAC[odd_bounded]; UND 4 THEN REWRITE_TAC[]; IMATCH_MP_TAC component_refl; IMATCH_MP_TAC bounded_subset_unions; ASM_MESON_TAC[odd_bounded]; THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp; FIRST_ASSUM DISJ_CASES_TAC; USE 4 (REWRITE_RULE [SUBSET]); UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); IMATCH_MP_TAC component_refl; IMATCH_MP_TAC bounded_subset_unions; ASM_MESON_TAC[odd_bounded]; THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) (* 1.0.7 Adding segments *) let edge_cell = prove_by_refinement( `!e. (edge e) ==> (cell e)`, (* {{{ proof *) [ REWRITE_TAC[edge]; ASM_MESON_TAC[cell_rules]; ]);; (* }}} *) let edge_subset_ctop = prove_by_refinement( `!G A. FINITE G /\ G SUBSET edge /\ A SUBSET edge /\ (A INTER G = EMPTY) ==> (UNIONS A SUBSET UNIONS (ctop G))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[ctop_unions;DIFF_SUBSET]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS edge` EXISTS_TAC ; CONJ_TAC; IMATCH_MP_TAC UNIONS_UNIONS; FULL_REWRITE_TAC[segment]; REWRITE_TAC[UNIONS;SUBSET]; USE 5 (MATCH_MP edge_euclid2); FULL_REWRITE_TAC[SUBSET]; (* - *) REWRITE_TAC[UNIONS;INTER;EQ_EMPTY]; FULL_REWRITE_TAC[EQ_EMPTY]; TSPEC `u` 0; USE 0(REWRITE_RULE[INTER]); UND 0 THEN ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `cell u /\ cell u'` SUBAGOAL_TAC; THM_INTRO_TAC[`G`] curve_cell_cell; THM_INTRO_TAC[`u`] edge_cell; FULL_REWRITE_TAC[ISUBSET]; FULL_REWRITE_TAC[ISUBSET]; (* - *) TYPE_THEN `u = u'` SUBAGOAL_TAC ; IMATCH_MP_TAC cell_partition; REWRITE_TAC[EMPTY_EXISTS;INTER ]; ASM_MESON_TAC[]; TYPE_THEN `u'` UNABBREV_TAC; TYPE_THEN `edge u` SUBAGOAL_TAC; ASM_MESON_TAC[ISUBSET]; FULL_REWRITE_TAC[edge]; ASM_MESON_TAC[curve_cell_h_ver2;curve_cell_v_ver2]; ]);; (* }}} *) let par_cell_pointI = prove_by_refinement( `!G eps m. (par_cell eps G {(pointI m)} = UNIONS (par_cell eps G) (pointI m))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[UNIONS]; TYPE_THEN `!u. cell u /\ u (pointI m) ==> ( u = {(pointI m)})` SUBAGOAL_TAC; FULL_REWRITE_TAC[cell]; UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `u` UNABBREV_TAC) THEN (FULL_REWRITE_TAC[cell_clauses;INR IN_SING;pointI_inj]); IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `{(pointI m)}` EXISTS_TAC; REWRITE_TAC[INR IN_SING]; TYPE_THEN `u = {(pointI m)}` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[par_cell_cell;subset_imp]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_pointI_trichot = prove_by_refinement( `!G eps m. (rectagon G) ==> ((par_cell eps G {(pointI m)}) \/ (par_cell (~eps) G {(pointI m)}) \/ (cls G m))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `UNIONS (ctop G) (pointI m)` ASM_CASES_TAC; THM_INTRO_TAC[`G`;`eps`] par_cell_partition; IMATCH_MP_TAC rectagon_segment; USE 2 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `pointI m` 2; REWR 2; USE 2(REWRITE_RULE[UNION]); USE 2 (REWRITE_RULE[GSYM par_cell_pointI]); ASM_MESON_TAC[]; THM_INTRO_TAC[`G`] rectagon_segment; (* - *) DISJ2_TAC; DISJ2_TAC; REWRITE_TAC[cls]; FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM ]; THM_INTRO_TAC[`G`;`m`] curve_point_unions; REWR 1; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[pointI;euclid_point]; ASM_MESON_TAC[]; THM_INTRO_TAC[`G`;`m`] curve_cell_not_point; REWR 4; THM_INTRO_TAC[`G`;`pointI m`] num_closure0; FULL_REWRITE_TAC[rectagon]; REWR 6; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_nbd = prove_by_refinement( `!G eps m e. (rectagon G) /\ (par_cell eps G {(pointI m)}) /\ edge e /\ closure top2 e (pointI m) ==> (par_cell eps G e)`, (* {{{ proof *) [ REP_BASIC_TAC; FULL_REWRITE_TAC[edge]; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_v; TYPE_THEN `e` UNABBREV_TAC; FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `m'` UNABBREV_TAC; TYPE_THEN `m` UNABBREV_TAC; TYPE_THEN `down (FST m',SND m' +: &:1) = m'` SUBAGOAL_TAC; REWRITE_TAC[down;PAIR_SPLIT]; INT_ARITH_TAC; REWR 5; (* - *) TYPE_THEN `e` UNABBREV_TAC; THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_h; FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `m'` UNABBREV_TAC; TYPE_THEN `m` UNABBREV_TAC; TYPE_THEN `left (FST m' +: &:1,SND m') = m'` SUBAGOAL_TAC; REWRITE_TAC[left ;PAIR_SPLIT]; INT_ARITH_TAC; REWR 4; ]);; (* }}} *) let segment_in_comp = prove_by_refinement( `!G A. rectagon G /\ segment A /\ (A INTER G = EMPTY) /\ (cls G INTER cls A SUBSET endpoint A) ==> (?eps. A SUBSET par_cell eps G)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?e. A e` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment;EMPTY_EXISTS ]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`G`;`A`] edge_subset_ctop; FULL_REWRITE_TAC[segment;rectagon]; (* - *) THM_INTRO_TAC[`G`] rectagon_segment; TYPE_THEN`edge e` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET;segment]; THM_INTRO_TAC[`e`] edge_cell; THM_INTRO_TAC[`e`] cell_nonempty; FULL_REWRITE_TAC[EMPTY_EXISTS]; (* - *) TYPE_THEN `?eps. ~(e INTER (UNIONS (par_cell eps G)) = EMPTY)` SUBAGOAL_TAC; REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`G`;`T`] par_cell_partition; USE 10(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `u` 10; TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `UNIONS A` EXISTS_TAC; REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; REWR 10; USE 10 (REWRITE_RULE[SUBSET ;UNION]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `T` EXISTS_TAC; TYPE_THEN `u` EXISTS_TAC; REWRITE_TAC[INTER]; REWRITE_TAC[INTER]; ASM_MESON_TAC[]; (* -A *) TYPE_THEN `eps` EXISTS_TAC; (* - *) USE 10 (REWRITE_RULE [EMPTY_EXISTS;INTER;UNIONS]); TYPE_THEN `u'' = e` SUBAGOAL_TAC; IMATCH_MP_TAC cell_partition; REWRITE_TAC[EMPTY_EXISTS;INTER ]; ASM_MESON_TAC[par_cell_cell;subset_imp ]; TYPE_THEN `u''` UNABBREV_TAC; (* - *) TYPE_THEN `S = A INTER par_cell eps G` ABBREV_TAC ; TYPE_THEN `inductive_set A S` BACK_TAC ; (* // *) FULL_REWRITE_TAC[inductive_set;segment]; TYPE_THEN `S = A` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 2 THEN MESON_TAC[]; KILL 15 THEN KILL 20 THEN KILL 16 THEN KILL 21; TYPE_THEN `S` UNABBREV_TAC; ASM_MESON_TAC[SUBSET_INTER_ABSORPTION]; (* -// *) REWRITE_TAC[inductive_set]; SUBCONJ_TAC; TYPE_THEN `S` UNABBREV_TAC ; REWRITE_TAC[INTER;SUBSET]; REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `S` UNABBREV_TAC; REWRITE_TAC[INTER]; (* -B *) USE 13(REWRITE_RULE[INTER]); TYPE_THEN `S` UNABBREV_TAC; THM_INTRO_TAC[`C`;`C'`] adjv_adj; FULL_REWRITE_TAC[segment]; ASM_MESON_TAC[subset_imp]; TYPE_THEN `m = adjv C C'` ABBREV_TAC ; (* - *) TYPE_THEN `FINITE G /\ FINITE A` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; TYPE_THEN `~endpoint A m` SUBAGOAL_TAC; FULL_REWRITE_TAC[endpoint]; THM_INTRO_TAC[`A`;`pointI m`] num_closure1; REWR 23; COPY 23; TSPEC `C` 23; TSPEC `C'` 24; TYPE_THEN `e' = C` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; THM_INTRO_TAC[`C`;`C'`] adjv_adj2; USE 2(REWRITE_RULE[segment]); ASM_MESON_TAC[subset_imp]; TYPE_THEN `C = C'` SUBAGOAL_TAC; ASM_MESON_TAC[]; FULL_REWRITE_TAC[adj]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `cls A m` SUBAGOAL_TAC; REWRITE_TAC[cls]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `~cls G m` SUBAGOAL_TAC; USE 0 (REWRITE_RULE[SUBSET;INTER]); ASM_MESON_TAC[]; (* -C *) TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC; USE 2(REWRITE_RULE[segment]); ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`G`;`eps`;`m`] par_cell_pointI_trichot; REWR 27; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`G`;`eps`;`m`;`C'`] par_cell_nbd; TYPE_THEN `m` UNABBREV_TAC; IMATCH_MP_TAC adjv_adj2; (* - *) THM_INTRO_TAC[`G`;`~eps`;`m`;`C`] par_cell_nbd; THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; ]);; (* }}} *) let segment_end_select = prove_by_refinement( `!E A a b. (E SUBSET edge) /\ segment_end A a b /\ ~cls E a /\ cls E b ==> (?B c. segment_end B a c /\ cls E c /\ B SUBSET A /\ (cls B INTER cls E = {c}))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `EE = { (B,c) | segment_end B a c /\ cls E c /\ B SUBSET A }` ABBREV_TAC ; (* - *) TYPE_THEN `~(EE = EMPTY)` SUBAGOAL_TAC; UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `(A,b)` EXISTS_TAC; TYPE_THEN `EE` UNABBREV_TAC; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL]; (* - *) THM_INTRO_TAC[`EE`;`(CARD o FST):((((num->real)->bool)->bool)#(int#int))->num`] select_image_num_min; ASM_MESON_TAC[]; (* - *) TYPE_THEN `?Bm cm. (z = (Bm,cm))` SUBAGOAL_TAC; ONCE_REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `Bm` EXISTS_TAC; TYPE_THEN `cm` EXISTS_TAC; TYPE_THEN `EE` UNABBREV_TAC; FULL_REWRITE_TAC[o_DEF]; USE 4(ONCE_REWRITE_RULE[PAIR_SPLIT]); USE 4(REWRITE_RULE[]); TYPE_THEN `c` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; (* - *) IMATCH_MP_TAC SUBSET_ANTISYM; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; FULL_REWRITE_TAC[SUBSET;INR IN_SING;INTER]; IMATCH_MP_TAC segment_end_cls2; ASM_MESON_TAC[]; (* - *) REWRITE_TAC[SUBSET;INTER;INR IN_SING]; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`Bm`;`a`;`cm`;`x`] cut_psegment; DISCH_TAC; ASM_MESON_TAC[]; (* - *) TSPEC `(A',x)` 6; USE 6 (ONCE_REWRITE_RULE[PAIR_SPLIT]); REWR 6; USE 6 (CONV_RULE (dropq_conv "B")); USE 6 (CONV_RULE (dropq_conv "c")); UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]); IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Bm` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; USE 6(MATCH_MP (ARITH_RULE `x <=| y ==> ~( y < x)`)); UND 6 THEN REWRITE_TAC[]; (* - *) IMATCH_MP_TAC card_subset_lt; CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; REWRITE_TAC[FINITE_UNION]; FULL_REWRITE_TAC[segment_end;segment;psegment]; (* - *) TYPE_THEN `~(B' = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end;segment;psegment]; UND 17 THEN UND 19 THEN MESON_TAC[]; FULL_REWRITE_TAC[EMPTY_EXISTS]; FULL_REWRITE_TAC[EQ_EMPTY;INTER ]; TSPEC `u` 15; USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `u` 6; FULL_REWRITE_TAC[UNION]; ASM_MESON_TAC[]; ]);; (* }}} *) let endpoint_cls = prove_by_refinement( `!G. FINITE G ==> (endpoint G SUBSET cls G)`, (* {{{ proof *) [ REWRITE_TAC[endpoint;SUBSET;cls]; THM_INTRO_TAC[`G`;`pointI x`] num_closure1; REWR 2; MESON_TAC[]; ]);; (* }}} *) let conn2_proper = prove_by_refinement( `!G H . (G SUBSET edge) /\ conn2 G /\ conn2 H /\ H SUBSET G /\ ~(H = G) ==> (?A. A SUBSET G /\ (A INTER H = EMPTY) /\ psegment A /\ (cls H INTER cls A = endpoint A))`, (* {{{ proof *) [ REP_BASIC_TAC; (* - *) TYPE_THEN `cls G SUBSET cls H` ASM_CASES_TAC; TYPE_THEN `?e. G e /\ ~H e` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; UND 0 THEN REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_ANTISYM; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `edge e` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `{e}` EXISTS_TAC; CONJ_TAC; ASM_REWRITE_TAC[SUBSET;INR IN_SING]; CONJ_TAC; ASM_REWRITE_TAC[EQ_EMPTY;INR IN_SING;INTER]; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC psegment_edge; TYPE_THEN `endpoint{e} = cls{e}` SUBAGOAL_TAC; ASM_SIMP_TAC[endpoint_closure;cls_edge]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_INTER_ABSORPTION]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `cls G` EXISTS_TAC; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;INR IN_SING]; (* -A *) TYPE_THEN `?a. cls G a /\ ~cls H a` SUBAGOAL_TAC; USE 5(REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `FINITE H /\ H SUBSET edge` SUBAGOAL_TAC; CONJ_TAC; FULL_REWRITE_TAC[conn2]; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; (* - *) TYPE_THEN `?b c. cls H b /\ cls H c /\ ~(b = c)` SUBAGOAL_TAC; THM_INTRO_TAC[`H`] conn2_cls3; THM_INTRO_TAC[`cls H`;`2`] card_has_subset; CONJ_TAC; ASM_MESON_TAC[finite_cls]; UND 10 THEN ARITH_TAC; FULL_REWRITE_TAC[has_size2]; TYPE_THEN `B` UNABBREV_TAC; FULL_REWRITE_TAC[SUBSET;INR in_pair]; TYPE_THEN `a'` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_MESON_TAC[]; (* -B *) TYPE_THEN `cls H SUBSET cls G` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; TYPE_THEN `~(a = b) /\ ~(a = c)` SUBAGOAL_TAC; ASM_MESON_TAC[]; (* - *) TYPE_THEN `(?U. U SUBSET G /\ segment_end U a b /\ ~cls U c)` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`H`;`U`;`a`;`b`] segment_end_select; TYPE_THEN `B SUBSET G` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `U` EXISTS_TAC; TYPE_THEN `~cls B c` SUBAGOAL_TAC; TYPE_THEN `cls B SUBSET cls U` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; USE 25 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; KILL 20 THEN KILL 16 THEN KILL 17 THEN KILL 18 THEN KILL 15 THEN KILL 10; KILL 12; TYPE_THEN `~(a = c')` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `~(c = c')` SUBAGOAL_TAC; TYPE_THEN`c'` UNABBREV_TAC; USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `c` 12; USE 12 (REWRITE_RULE[INTER;INR IN_SING]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `(?V. V SUBSET G /\ segment_end V a c /\ ~cls V c')` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`H`;`V`;`a`;`c`] segment_end_select; (* -C *) TYPE_THEN `B' SUBSET G` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `V` EXISTS_TAC; TYPE_THEN `~cls B' c'` SUBAGOAL_TAC; TYPE_THEN `cls B' SUBSET cls V` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; USE 29 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; KILL 20 THEN KILL 16 THEN KILL 17; KILL 15; KILL 12 THEN KILL 24 THEN KILL 14; (* - *) TYPE_THEN `~(c'' = c')` SUBAGOAL_TAC; TYPE_THEN `c''` UNABBREV_TAC; USE 18 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `c'` 12; USE 12 (REWRITE_RULE[INTER;INR IN_SING]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `B INTER H = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 14(REWRITE_RULE[INTER]); USE 19 SYM; TYPE_THEN `cls {u} SUBSET cls B INTER cls H` SUBAGOAL_TAC; REWRITE_TAC[SUBSET_INTER]; CONJ_TAC THEN IMATCH_MP_TAC cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING]; USE 16 SYM; REWR 17; THM_INTRO_TAC[`u`] cls_edge_size2; FULL_REWRITE_TAC[SUBSET]; FULL_REWRITE_TAC[has_size2]; REWR 17; USE 17 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]); COPY 17; TSPEC `a'` 17; TSPEC `b` 24; ASM_MESON_TAC[]; (* - *) TYPE_THEN `B' INTER H = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 15(REWRITE_RULE[INTER]); USE 18 SYM; TYPE_THEN `cls {u} SUBSET cls B' INTER cls H` SUBAGOAL_TAC; REWRITE_TAC[SUBSET_INTER]; CONJ_TAC THEN IMATCH_MP_TAC cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING]; USE 17 SYM; REWR 18; THM_INTRO_TAC[`u`] cls_edge_size2; FULL_REWRITE_TAC[SUBSET]; FULL_REWRITE_TAC[has_size2]; REWR 18; USE 18 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]); COPY 18; TSPEC `a'` 18; TSPEC `b` 29; ASM_MESON_TAC[]; (* -D *) USE 22 (ONCE_REWRITE_RULE[segment_end_symm]); THM_INTRO_TAC[`B`;`B'`;`c'`;`a`;`c''`] segment_end_trans; TYPE_THEN `U` EXISTS_TAC; SUBCONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `B UNION B'` EXISTS_TAC; REWRITE_TAC[union_subset]; (* - *) CONJ_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ]; ASM_MESON_TAC[]; (* - *) CONJ_TAC; USE 20(REWRITE_RULE[segment_end]); (* -// *) IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[INTER;SUBSET]; USE 20 (REWRITE_RULE[segment_end]); REWRITE_TAC[INR in_pair]; TYPE_THEN `cls U SUBSET cls(B UNION B')` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; USE 31(REWRITE_RULE[SUBSET;cls_union]); USE 31(REWRITE_RULE[UNION]); TSPEC `x` 31; FIRST_ASSUM DISJ_CASES_TAC; USE 19(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 19; USE 19 (REWRITE_RULE[INTER;INR IN_SING]); ASM_MESON_TAC[]; USE 18(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 18; USE 18 (REWRITE_RULE[INTER;INR IN_SING]); ASM_MESON_TAC[]; (* -E *) USE 20(REWRITE_RULE[segment_end]); REWRITE_TAC[SUBSET;INTER;INR in_pair]; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `FINITE U` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end;psegment;segment]; (* - *) USE 20 SYM; TYPE_THEN `endpoint U SUBSET cls U` SUBAGOAL_TAC; IMATCH_MP_TAC endpoint_cls; USE 31(REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; USE 20 SYM; REWRITE_TAC[INR in_pair]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION U *) (* ------------------------------------------------------------------ *) (* EVEN and ODD components. 1.0.8, Nov 28, 2004, 9am *) let parity_select = jordan_def `parity G C = @eps. par_cell eps G C`;; let cell_ununion = prove_by_refinement( `!V C u. cell C /\ C u /\ (V SUBSET cell) /\ (UNIONS V) u ==> V C`, (* {{{ proof *) [ REWRITE_TAC[UNIONS]; TYPE_THEN `u' = C` SUBAGOAL_TAC; IMATCH_MP_TAC cell_partition; CONJ_TAC; ASM_MESON_TAC[subset_imp]; UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_cell_partition = prove_by_refinement( `!G eps C. segment G /\ cell C ==> (par_cell eps G C \/ par_cell (~eps) G C \/ curve_cell G C)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `curve_cell G C` ASM_CASES_TAC; THM_INTRO_TAC[`C`] cell_nonempty; FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC; REWRITE_TAC[ctop_unions;DIFF;UNIONS ]; CONJ_TAC; THM_INTRO_TAC[`C`] cell_euclid; ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`curve_cell G`;`C`;`u`] cell_ununion; CONJ_TAC; IMATCH_MP_TAC curve_cell_cell; FULL_REWRITE_TAC[segment]; REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`G`;`eps`] par_cell_partition; USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `u` 5; REWR 5; USE 5(REWRITE_RULE[UNION]); THM_INTRO_TAC[`G`] par_cell_cell; FIRST_ASSUM DISJ_CASES_TAC; DISJ1_TAC; IMATCH_MP_TAC cell_ununion; ASM_MESON_TAC[]; DISJ2_TAC; IMATCH_MP_TAC cell_ununion; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_curve_cell_disj = prove_by_refinement( `!G eps. (G SUBSET edge) ==> (par_cell eps G INTER curve_cell G = EMPTY )`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[INTER;EQ_EMPTY]; USE 2(MATCH_MP par_cell_curve_disj); UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;UNIONS ]; TYPE_THEN `cell x` SUBAGOAL_TAC; ASM_MESON_TAC[curve_cell_cell;subset_imp]; USE 2 (MATCH_MP cell_nonempty); FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let curve_cell_edge = prove_by_refinement( `!G e . edge e ==> (curve_cell G e = G e) `, (* {{{ proof *) [ REWRITE_TAC[edge]; FIRST_ASSUM DISJ_CASES_TAC; REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ]; REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ]; ]);; (* }}} *) let parity = prove_by_refinement( `!G C. segment G /\ cell C /\ ~curve_cell G C ==> par_cell (parity G C) G C`, (* {{{ proof *) [ REWRITE_TAC[parity_select]; SELECT_TAC; THM_INTRO_TAC[`G`;`T`;`C`] par_cell_cell_partition; ASM_MESON_TAC[]; ]);; (* }}} *) let parity_unique = prove_by_refinement( `!G C eps. segment G /\ par_cell eps G C ==> (eps = parity G C)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `cell C /\ ~curve_cell G C` SUBAGOAL_TAC; SUBCONJ_TAC; ASM_MESON_TAC[par_cell_cell;subset_imp]; THM_INTRO_TAC[`G`;`eps`] par_cell_curve_cell_disj; FULL_REWRITE_TAC[segment]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; THM_INTRO_TAC[`G`;`C`] parity; PROOF_BY_CONTR_TAC; TYPE_THEN`parity G C = ~eps` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `parity G C` UNABBREV_TAC; THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; ]);; (* }}} *) let unions_curve_cell = prove_by_refinement( `!G C. (G SUBSET edge) /\ cell C ==> ((C INTER UNIONS (curve_cell G) = EMPTY) = (~curve_cell G C))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; USE 3(REWRITE_RULE[INTER;UNIONS;EQ_EMPTY]); USE 0 (MATCH_MP cell_nonempty); FULL_REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[]; (* - *) REWRITE_TAC[EQ_EMPTY;INTER]; UND 2 THEN REWRITE_TAC[]; IMATCH_MP_TAC cell_ununion; UNIFY_EXISTS_TAC; IMATCH_MP_TAC curve_cell_cell; ]);; (* }}} *) let even_num_lower_union = prove_by_refinement( `!A B m. FINITE A /\ FINITE B /\ (A INTER B = EMPTY) ==> (EVEN (num_lower (A UNION B) m) <=> (EVEN (num_lower A m) = EVEN (num_lower B m)))`, (* {{{ proof *) [ REWRITE_TAC[num_lower_set]; THM_INTRO_TAC[`set_lower A m`;`set_lower B m`] even_card_even; REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC finite_set_lower)); REWRITE_TAC[EQ_EMPTY;INTER;set_lower]; FULL_REWRITE_TAC[EQ_EMPTY;INTER]; ASM_MESON_TAC[]; (* - *) AP_TERM_TAC; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[set_lower;UNION]; TYPE_THEN `C <=> (FST x = FST m) /\ SND x <=: SND m` ABBREV_TAC ; USE 0 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `h_edge x` 0; UND 0 THEN MESON_TAC[]; ]);; (* }}} *) let eq_pair_exchange = prove_by_refinement( `!(a:bool) b c d. ((a = b) <=> (c = d)) <=> ((a = c) <=> (b = d))`, (* {{{ proof *) [ MESON_TAC[]; ]);; (* }}} *) let parity_point = prove_by_refinement( `!A p. segment A /\ ~(curve_cell A {(pointI p)}) ==> (parity A {(pointI p)} = EVEN (num_lower A p))`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC parity_unique; REWRITE_TAC[par_cell;cell_clauses]; THM_INTRO_TAC[`A`;`{(pointI p)}`] unions_curve_cell; FULL_REWRITE_TAC[cell_rules;segment]; MESON_TAC[]; ]);; (* }}} *) let parity_h = prove_by_refinement( `!A p. segment A /\ ~A (h_edge p) ==> (parity A (h_edge p) <=> EVEN (num_lower A p))`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC parity_unique; REWRITE_TAC[par_cell;cell_clauses]; THM_INTRO_TAC[`A`;`h_edge p`] unions_curve_cell; FULL_REWRITE_TAC[cell_rules;segment]; THM_INTRO_TAC[`A`;`h_edge p`] curve_cell_edge; REWRITE_TAC[edge_h]; MESON_TAC[]; ]);; (* }}} *) let parity_v = prove_by_refinement( `!A p. segment A /\ ~A (v_edge p) ==> (parity A (v_edge p) <=> EVEN (num_lower A p))`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC parity_unique; REWRITE_TAC[par_cell;cell_clauses]; THM_INTRO_TAC[`A`;`v_edge p`] unions_curve_cell; FULL_REWRITE_TAC[cell_rules;segment]; THM_INTRO_TAC[`A`;`v_edge p`] curve_cell_edge; REWRITE_TAC[edge_v]; MESON_TAC[]; ]);; (* }}} *) let parity_squ = prove_by_refinement( `!A p. segment A ==> (parity A (squ p) <=> EVEN (num_lower A p))`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC parity_unique; REWRITE_TAC[par_cell;cell_clauses]; THM_INTRO_TAC[`A`;`squ p`] unions_curve_cell; FULL_REWRITE_TAC[cell_rules;segment]; THM_INTRO_TAC[`A`;`p`] curve_cell_squ; MESON_TAC[]; ]);; (* }}} *) let parity_union = prove_by_refinement( `!A B C. segment A /\ segment B /\ segment (A UNION B) /\ (A INTER B = EMPTY) /\ cell C /\ ~curve_cell A C /\ ~curve_cell B C ==> (parity (A UNION B) C <=> (parity A C = parity B C))`, (* {{{ proof *) [ REP_BASIC_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC parity_unique; REWRITE_TAC[par_cell]; TYPE_THEN `A UNION B SUBSET edge` SUBAGOAL_TAC; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[segment]; ASM_SIMP_TAC[unions_curve_cell]; TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; ASM_SIMP_TAC[even_num_lower_union]; ONCE_REWRITE_TAC[eq_pair_exchange]; (* -A *) REWRITE_TAC[curve_cell_union]; REWRITE_TAC[UNION]; (* - *) WITH 2(REWRITE_RULE[cell_mem]); UND 10 THEN REP_CASES_TAC ; (* --cases-- *) REWRITE_TAC[cell_clauses]; TYPE_THEN`p` EXISTS_TAC; IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); TYPE_THEN `C` UNABBREV_TAC; CONJ_TAC THEN (IMATCH_MP_TAC parity_point); REWRITE_TAC[cell_clauses]; TYPE_THEN`p` EXISTS_TAC; IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); TYPE_THEN `C` UNABBREV_TAC; CONJ_TAC THEN (IMATCH_MP_TAC parity_h) THEN ASM_MESON_TAC[curve_cell_h_ver2]; REWRITE_TAC[cell_clauses]; TYPE_THEN`p` EXISTS_TAC; IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); TYPE_THEN `C` UNABBREV_TAC; CONJ_TAC THEN (IMATCH_MP_TAC parity_v) THEN ASM_MESON_TAC[curve_cell_v_ver2]; REWRITE_TAC[cell_clauses]; TYPE_THEN`p` EXISTS_TAC; IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); TYPE_THEN `C` UNABBREV_TAC; CONJ_TAC THEN (IMATCH_MP_TAC parity_squ) ; ]);; (* }}} *) (* extraneous fact *) let component_simple_arc = prove_by_refinement( `!G x y. (FINITE G /\ G SUBSET edge ) /\ ~(x = y) ==> ((component (ctop G) x y) <=> (?C. simple_arc_end C x y /\ (C INTER (UNIONS (curve_cell G)) = EMPTY)))`, (* {{{ proof *) [ (* string together :component-imp-connected, connected-induced2, p_conn_conn, p_conn_hv_finite; other_direction : simple_arc_connected, connected-induced, connected-component; *) REP_BASIC_TAC; THM_INTRO_TAC[`G`] ctop_top; ASSUME_TAC top2_top; THM_INTRO_TAC[`G`] curve_closed_ver2; TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC; USE 5 (MATCH_MP closed_open); FULL_REWRITE_TAC[top2_unions;open_DEF ]; TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ; TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC; TYPE_THEN`A` UNABBREV_TAC; REWRITE_TAC[ctop_unions]; TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC; REWRITE_TAC[ctop]; (* - *) IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected; THM_INTRO_TAC[`(top2)`;`A`;`(component (ctop G) x)`] connected_induced2; REWRITE_TAC[top2_unions]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; CONJ_TAC; KILL 7; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[component_unions]; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DIFF;SUBSET]; REWR 12; (* --A *) TYPE_THEN `B = component (ctop G) x` ABBREV_TAC ; TYPE_THEN `B x /\ B y` SUBAGOAL_TAC; TYPE_THEN `B` UNABBREV_TAC; THM_INTRO_TAC[`(ctop G)`;`x`;`y`] component_replace; IMATCH_MP_TAC component_symm; (* -- *) ASSUME_TAC loc_path_conn_top2; TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC; REWRITE_TAC[ctop]; REWRITE_TAC[top2]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC top_of_metric_induced; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DIFF;SUBSET]; (* -- *) TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC; THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid; FULL_REWRITE_TAC[top2]; ASM_MESON_TAC[]; (* -- *) THM_INTRO_TAC[`top2`] loc_path_conn; REWR 20; TSPEC `A` 20; REWR 20; TSPEC `x` 20; TYPE_THEN `A x` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `top2 B` SUBAGOAL_TAC; TYPE_THEN `B` UNABBREV_TAC; ASM_MESON_TAC[path_eq_conn]; (* --B *) THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn; (* -- *) THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite; ASM_MESON_TAC[]; REWR 24; TYPE_THEN `C` EXISTS_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `u` 7; FULL_REWRITE_TAC[DIFF]; TYPE_THEN `B u` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `A u` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; REWR 7; (* -C *) (* other_direction : simple_arc_connected, connected-induced, connected-component; *) THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple; THM_INTRO_TAC[`C`] simple_arc_connected; TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_euclid; THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2; REWRITE_TAC[top2_unions]; REWR 15; (* - *) TYPE_THEN `C SUBSET A` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DIFF_SUBSET]; REWR 15; (* - *) THM_INTRO_TAC[`(ctop G)`;`C`;`x`] connected_component; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; USE 17(REWRITE_RULE[SUBSET]); TSPEC `y` 17; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; ]);; (* }}} *) let ctop_comp_open = prove_by_refinement( `!G x . (FINITE G /\ G SUBSET edge ) ==> top2 (component (ctop G) x)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`] ctop_top; ASSUME_TAC top2_top; THM_INTRO_TAC[`G`] curve_closed_ver2; TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC; USE 4 (MATCH_MP closed_open); FULL_REWRITE_TAC[top2_unions;open_DEF ]; TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ; TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC; TYPE_THEN`A` UNABBREV_TAC; REWRITE_TAC[ctop_unions]; TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC; REWRITE_TAC[ctop]; (* - *) TYPE_THEN `B = component (ctop G) x` ABBREV_TAC ; TYPE_THEN `B = EMPTY` ASM_CASES_TAC; THM_INTRO_TAC[`top2`] open_EMPTY; FULL_REWRITE_TAC[open_DEF]; FULL_REWRITE_TAC[EMPTY_EXISTS]; (* - *) THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected; THM_INTRO_TAC[`(top2)`;`A`;`(component (ctop G) x)`] connected_induced2; REWRITE_TAC[top2_unions]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; CONJ_TAC; KILL 6; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[component_unions]; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DIFF;SUBSET]; REWR 12; (* --A *) TYPE_THEN `B x /\ B u` SUBAGOAL_TAC; TYPE_THEN `B` UNABBREV_TAC; THM_INTRO_TAC[`(ctop G)`;`x`;`u`] component_replace; IMATCH_MP_TAC component_symm; (* -- *) ASSUME_TAC loc_path_conn_top2; TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC; REWRITE_TAC[ctop]; REWRITE_TAC[top2]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC top_of_metric_induced; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DIFF;SUBSET]; (* -- *) TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC; THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid; FULL_REWRITE_TAC[top2]; ASM_MESON_TAC[]; (* -- *) THM_INTRO_TAC[`top2`] loc_path_conn; REWR 18; TSPEC `A` 18; REWR 18; TSPEC `x` 18; TYPE_THEN `A x` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `B` UNABBREV_TAC; ASM_MESON_TAC[path_eq_conn]; (* --B *) ]);; (* }}} *) let psegment_triple = jordan_def `psegment_triple A B C <=> psegment A /\ psegment B /\ psegment C /\ rectagon (A UNION B) /\ rectagon (A UNION C) /\ rectagon(B UNION C) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (cls A INTER cls B = endpoint A) /\ (cls B INTER cls C = endpoint A) /\ (cls A INTER cls C = endpoint A) /\ (endpoint A = endpoint B) /\ (endpoint B = endpoint C)`;; let psegment_triple3 = prove_by_refinement( `!A B C. psegment_triple A B C ==> psegment_triple B C A`, (* {{{ proof *) [ REP_BASIC_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM;INTER_COMM]; ASM_MESON_TAC[]; ]);; (* }}} *) let psegment_triple2 = prove_by_refinement( `!A B C. psegment_triple A B C ==> psegment_triple C B A`, (* {{{ proof *) [ FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM;INTER_COMM]; ASM_MESON_TAC[]; ]);; (* }}} *) let unions_empty_imp_empty = prove_by_refinement( `!(A:(A->bool)->bool) B. (UNIONS A INTER UNIONS B = EMPTY) /\ (!C. A C ==> ~(C = EMPTY)) ==> (A INTER B = EMPTY) `, (* {{{ proof *) [ REWRITE_TAC[EQ_EMPTY;INTER;UNIONS]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_closure = prove_by_refinement( `!G A eps. FINITE A /\ A SUBSET edge /\ rectagon G /\ A SUBSET par_cell eps G ==> (curve_cell A INTER par_cell (~eps) G = EMPTY)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC unions_empty_imp_empty; ASSUME_TAC top2_top; TYPE_THEN `(par_cell (~eps) G) = EMPTY` ASM_CASES_TAC; REWRITE_TAC[INTER_EMPTY]; FULL_REWRITE_TAC[curve_cell;UNION]; TYPE_THEN `C` UNABBREV_TAC; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[SUBSET]; TYPE_THEN `edge {}` SUBAGOAL_TAC; TYPE_THEN `cell {}` SUBAGOAL_TAC; IMATCH_MP_TAC edge_cell; USE 9 (MATCH_MP cell_nonempty); ASM_MESON_TAC[]; USE 8 SYM; FULL_REWRITE_TAC[EQ_EMPTY;INR IN_SING ]; ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `~(UNIONS (par_cell (~eps) G) = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[UNIONS;EQ_EMPTY]; TYPE_THEN `~ (u = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `u` UNABBREV_TAC; THM_INTRO_TAC[`G`;`~eps`] par_cell_cell; FULL_REWRITE_TAC[SUBSET]; TYPE_THEN `cell {}` SUBAGOAL_TAC; ASM_MESON_TAC[]; USE 8 (MATCH_MP cell_nonempty); ASM_MESON_TAC[]; FULL_REWRITE_TAC[EMPTY_EXISTS]; TSPEC `u'` 6; ASM_MESON_TAC[]; (* -A *) TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC; THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed; REWRITE_TAC[open_DEF]; FULL_REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`G`;`~eps`;`u'`] par_cell_union_comp; IMATCH_MP_TAC ctop_comp_open ; ASM_MESON_TAC[rectagon]; FULL_REWRITE_TAC[top2_unions]; (* -B *) THM_INTRO_TAC[`A`] curve_closure_ver2; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; THM_INTRO_TAC[`A`] curve_cell_cell; USE 10 (REWRITE_RULE[SUBSET]); TSPEC `C` 10; USE 9 (MATCH_MP cell_nonempty); FULL_REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[]; (* - *) TYPE_THEN`UNIONS (curve_cell A) SUBSET (euclid 2 DIFF UNIONS (par_cell (~eps) G))` SUBAGOAL_TAC; USE 8 GSYM; IMATCH_MP_TAC closure_subset; REWRITE_TAC[DIFF_SUBSET]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS edge` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC UNIONS_UNIONS; REWRITE_TAC[UNIONS;SUBSET]; THM_INTRO_TAC[`u'`] edge_euclid2; ASM_MESON_TAC[subset_imp]; REWRITE_TAC[INTER;EQ_EMPTY]; COPY 10; USE 11(REWRITE_RULE[UNIONS]); THM_INTRO_TAC[`par_cell (~eps) G`;`u'`;`x`] cell_ununion; TYPE_THEN`edge u'` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC [par_cell_cell;edge_cell]; USE 0 (REWRITE_RULE[SUBSET]); TSPEC `u'` 0; THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[DIFF_SUBSET]; ]);; (* }}} *) let cell_unions_disj = prove_by_refinement( `!U V. U SUBSET cell /\ V SUBSET cell ==> ((U INTER V = EMPTY) <=> (UNIONS U INTER UNIONS V = EMPTY))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 3(REWRITE_RULE[INTER]); TYPE_THEN `?C. V C /\ C u` SUBAGOAL_TAC; FULL_REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; TYPE_THEN `cell C` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `U C` SUBAGOAL_TAC; IMATCH_MP_TAC cell_ununion; ASM_MESON_TAC[]; USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; (* - *) IMATCH_MP_TAC unions_empty_imp_empty; REP_BASIC_TAC; TYPE_THEN `C` UNABBREV_TAC; TYPE_THEN `cell EMPTY ` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC[cell_nonempty]; ]);; (* }}} *) let unions_curve_cell_par_cell_disj = prove_by_refinement( `!G eps. (G SUBSET edge) ==> (UNIONS (par_cell eps G) INTER UNIONS (curve_cell G) = EMPTY)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`par_cell eps G`;`curve_cell G`] cell_unions_disj; THM_INTRO_TAC[`G`] curve_cell_cell; REWRITE_TAC[par_cell_cell]; USE 1 SYM; IMATCH_MP_TAC par_cell_curve_cell_disj; ]);; (* }}} *) let par_cell_simple_arc = prove_by_refinement( `!G eps x y. rectagon G /\ ~(x = y) ==> ((UNIONS (par_cell eps G) x /\ UNIONS (par_cell eps G) y) <=> (?C. simple_arc_end C x y /\ (C SUBSET (UNIONS (par_cell eps G)))) )`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; THM_INTRO_TAC[`G`;`eps`;`x`] par_cell_union_comp; THM_INTRO_TAC[`G`;`x`;`y`] component_simple_arc; FULL_REWRITE_TAC[rectagon]; REWR 2; TYPE_THEN `C` EXISTS_TAC; USE 4 SYM; REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; (* -- *) THM_INTRO_TAC[`C`;`x`;`y`;`x'`] simple_arc_end_cut; CONJ_TAC; TYPE_THEN `x'` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `x'` UNABBREV_TAC; ASM_MESON_TAC[]; (* -- *) THM_INTRO_TAC[`G`;`x`;`x'`] component_simple_arc; FULL_REWRITE_TAC[rectagon]; REWRITE_TAC[]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `~component (ctop G) x x'` SUBAGOAL_TAC; ASM_MESON_TAC[]; UND 13 THEN ASM_REWRITE_TAC[]; TYPE_THEN `C'` EXISTS_TAC; FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ]SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C INTER UNIONS (curve_cell G)` EXISTS_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; (* -A *) TYPE_THEN `C x /\ C y` SUBAGOAL_TAC; CONJ_TAC THEN ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let trap_triple_seg = prove_by_refinement( `!A B C eps eps'. psegment_triple A B C /\ C SUBSET par_cell (~eps) (A UNION B) ==> (par_cell eps (A UNION B) SUBSET par_cell eps' (A UNION C) \/ par_cell eps (A UNION B) SUBSET par_cell (~eps') (A UNION C))`, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC; USE 2 (REWRITE_RULE[SUBSET]); FULL_REWRITE_TAC[DE_MORGAN_THM]; LEFT 2 "x"; LEFT 3 "x"; UND 2 THEN REWRITE_TAC[]; PROOF_BY_CONTR_TAC; UND 3 THEN REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TYPE_THEN`cell x' /\ cell x` SUBAGOAL_TAC; ASM_MESON_TAC[par_cell_cell;subset_imp]; (* - *) TYPE_THEN `!x. cell x /\ par_cell eps (A UNION B) x ==> par_cell eps' (A UNION C) x \/ par_cell (~eps') (A UNION C) x` SUBAGOAL_TAC; THM_INTRO_TAC[`A UNION C`;`eps'`;`x''`] par_cell_cell_partition; IMATCH_MP_TAC rectagon_segment; FULL_REWRITE_TAC[psegment_triple]; USE 10 (REWRITE_RULE[curve_cell_union]); UND 10 THEN REP_CASES_TAC; USE 10 (REWRITE_RULE[UNION]); (* -- *) FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`A UNION B`;`eps`] par_cell_curve_cell_disj; FULL_REWRITE_TAC[psegment_triple]; USE 21 (REWRITE_RULE[rectagon]); USE 12 (REWRITE_RULE[INTER;EQ_EMPTY;curve_cell_union;DE_MORGAN_THM ]); TSPEC `x''` 12; REWR 12; USE 12 (REWRITE_RULE[UNION;DE_MORGAN_THM ]); ASM_MESON_TAC[]; (* -- *) THM_INTRO_TAC[`A UNION B`;`C`;`~eps`;] par_cell_closure; FULL_REWRITE_TAC[psegment_triple]; USE 22(REWRITE_RULE[psegment;segment]); USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; (* - *) COPY 8; TSPEC `x` 8; TSPEC `x'` 9; UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]); UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]); REWR 8; REWR 9; (* - *) USE 6 (MATCH_MP cell_nonempty); USE 7(MATCH_MP cell_nonempty); FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `UNIONS (par_cell eps (A UNION B)) u /\ UNIONS (par_cell eps (A UNION B)) u'` SUBAGOAL_TAC; REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `u = u'` ASM_CASES_TAC; TYPE_THEN `u'` UNABBREV_TAC; TYPE_THEN `cell x /\ cell x'` SUBAGOAL_TAC; ASM_MESON_TAC[par_cell_cell;subset_imp]; TYPE_THEN `x = x'` SUBAGOAL_TAC; IMATCH_MP_TAC cell_partition; REWRITE_TAC[INTER;EMPTY_EXISTS]; ASM_MESON_TAC[]; TYPE_THEN `x'` UNABBREV_TAC; ASM_MESON_TAC[]; (* -B *) THM_INTRO_TAC[`A UNION B`;`eps`;`u`;`u'`]par_cell_simple_arc; FULL_REWRITE_TAC[psegment_triple]; REWR 13; (* - *) TYPE_THEN `C' INTER UNIONS (curve_cell A) = EMPTY` SUBAGOAL_TAC; REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL;curve_cell_union;UNIONS_UNION]; REWRITE_TAC[SUBSET;UNION]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (par_cell eps (A UNION B)) INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET_EMPTY]; IMATCH_MP_TAC unions_curve_cell_par_cell_disj ; FULL_REWRITE_TAC[psegment_triple]; USE 24 (REWRITE_RULE[rectagon]); (* -C *) THM_INTRO_TAC[`A UNION B`;`C`;`~eps`] par_cell_closure; FULL_REWRITE_TAC[psegment_triple]; USE 26(REWRITE_RULE[psegment;segment]); REWR 16; THM_INTRO_TAC[`curve_cell C`;`par_cell eps (A UNION B)`] cell_unions_disj; CONJ_TAC; IMATCH_MP_TAC curve_cell_cell; FULL_REWRITE_TAC[psegment_triple]; USE 27(REWRITE_RULE[psegment;segment]); REWRITE_TAC[par_cell_cell]; REWR 17; TYPE_THEN `UNIONS (curve_cell C) INTER C' = EMPTY` SUBAGOAL_TAC ; REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY]; USE 17 SYM; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; (* - *) TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION C)) = EMPTY` SUBAGOAL_TAC; REWRITE_TAC[curve_cell_union;UNIONS_UNION]; REWRITE_TAC[UNION_OVER_INTER; UNION_EMPTY]; REWRITE_TAC[UNION_EMPTY]; ONCE_REWRITE_TAC[INTER_COMM]; (* -D *) THM_INTRO_TAC[`A UNION C`;`u`;`u'`] component_simple_arc; FULL_REWRITE_TAC[psegment_triple]; USE 28(REWRITE_RULE[rectagon]); (* - *) TYPE_THEN `component (ctop (A UNION C)) u u'` SUBAGOAL_TAC; TYPE_THEN `C'` EXISTS_TAC; REWR 20; TYPE_THEN `UNIONS (par_cell (eps') (A UNION C)) u'` SUBAGOAL_TAC; REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C)) u` SUBAGOAL_TAC; REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC [`A UNION C`;`eps'`] par_cell_union_disjoint; THM_INTRO_TAC[`A UNION C`;`eps'`;`u'`] par_cell_union_comp; FULL_REWRITE_TAC[psegment_triple]; THM_INTRO_TAC[`A UNION C`;`~eps'`;`u`] par_cell_union_comp; FULL_REWRITE_TAC[psegment_triple]; TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C))` UNABBREV_TAC; TYPE_THEN `UNIONS (par_cell eps' (A UNION C))` UNABBREV_TAC; USE 25 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u'` 25; REWR 25; ]);; (* }}} *) let parity_even_cell = prove_by_refinement( `!G m. (rectagon G) ==> (parity G (squ m) = even_cell G (squ m))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`;`m`] parity_squ; IMATCH_MP_TAC rectagon_segment; REWRITE_TAC[parity_squ;even_cell_squ]; ]);; (* }}} *) let par_cell_squ_neg = prove_by_refinement( `!G m eps. segment G ==> (par_cell (~eps) G (squ m) <=> ~(par_cell eps G (squ m)))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; THM_INTRO_TAC[`G`;`eps`;`squ m`] par_cell_cell_partition; REWRITE_TAC[cell_rules]; ASM_MESON_TAC[curve_cell_squ]; ]);; (* }}} *) let triple_par_cell_distinct = prove_by_refinement( `!A B C eps eps'. psegment_triple A B C ==> ~(par_cell eps (A UNION B) = par_cell eps' (A UNION C))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `s = (eps = eps')` ABBREV_TAC ; TYPE_THEN `!m. (parity (A UNION B) (squ m) = parity(A UNION C) (squ m)) = s` SUBAGOAL_TAC; TYPE_THEN `s` UNABBREV_TAC; REWRITE_TAC[EQ_SYM_EQ]; ONCE_REWRITE_TAC[eq_pair_exchange]; TYPE_THEN `eps = parity (A UNION B) (squ m)` ASM_CASES_TAC; IMATCH_MP_TAC parity_unique; USE 0 SYM; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; IMATCH_MP_TAC parity; REWRITE_TAC[cell_rules;]; SUBCONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; ASM_MESON_TAC[curve_cell_squ]; (* -- *) TYPE_THEN `!m. par_cell (~eps) (A UNION B) (squ m) = par_cell (~eps') (A UNION C) (squ m)` SUBAGOAL_TAC; TYPE_THEN `segment (A UNION B) /\ segment(A UNION C)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC THEN IMATCH_MP_TAC rectagon_segment; ASM_SIMP_TAC [par_cell_squ_neg]; TYPE_THEN `~eps = parity (A UNION B) (squ m)` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILL 2; TYPE_THEN `~(~eps' = parity (A UNION C) (squ m))` SUBAGOAL_TAC; TYPE_THEN `eps'` UNABBREV_TAC; ASM_MESON_TAC[]; KILL 3; UND 2 THEN REWRITE_TAC[]; IMATCH_MP_TAC parity_unique; TSPEC `m` 4; USE 2 SYM; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; IMATCH_MP_TAC parity; REWRITE_TAC[cell_rules;]; SUBCONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; ASM_MESON_TAC[curve_cell_squ]; (* -A *) THM_INTRO_TAC[`A UNION B`] parity_even_cell; RIGHT 4 "m"; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]); FULL_REWRITE_TAC[psegment_triple]; REWR 3; THM_INTRO_TAC[`A UNION C`] parity_even_cell; RIGHT 5 "m"; UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]); FULL_REWRITE_TAC[psegment_triple]; REWR 3; (* - *) TYPE_THEN `?e. B e /\ ~C e /\ ~A e` SUBAGOAL_TAC; TYPE_THEN `~(B = EMPTY)` SUBAGOAL_TAC ; TYPE_THEN `B` UNABBREV_TAC; FULL_REWRITE_TAC[psegment_triple]; USE 17( REWRITE_RULE[psegment;segment]); FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; REWRITE_TAC[GSYM DE_MORGAN_THM]; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `edge e` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; USE 20 (REWRITE_RULE[psegment;segment]); ASM_MESON_TAC[subset_imp]; FULL_REWRITE_TAC[edge]; TYPE_THEN `rectagon (A UNION B) /\ rectagon (A UNION C)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; (* - *) KILL 5; KILL 4; KILL 0; KILL 2; TYPE_THEN `~(A UNION C) e /\ (A UNION B) e` SUBAGOAL_TAC; ASM_REWRITE_TAC[UNION]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; THM_INTRO_TAC[`(A UNION B)`;`m`] squ_left_odd; THM_INTRO_TAC[`(A UNION C)`;`m`] squ_left_even; ASM_MESON_TAC[]; TYPE_THEN `e` UNABBREV_TAC; THM_INTRO_TAC[`A UNION B`;`m`] squ_down; FULL_REWRITE_TAC[rectagon]; THM_INTRO_TAC[`A UNION C`;`m`] squ_down; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[set_lower_n]; ASM_MESON_TAC[]; ]);; (* }}} *) let triple_in_comp = prove_by_refinement( `!A B C eps. psegment_triple A B C /\ ~(C SUBSET par_cell eps (A UNION B)) ==> (C SUBSET par_cell (~eps) (A UNION B)) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp; FULL_REWRITE_TAC[psegment_triple]; USE 12 (REWRITE_RULE[psegment]); REWRITE_TAC[cls_union;]; CONJ_TAC; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; ONCE_REWRITE_TAC[INTER_COMM]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; TYPE_THEN `endpoint A` UNABBREV_TAC; TYPE_THEN `endpoint B` UNABBREV_TAC; TYPE_THEN `endpoint C` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[SUBSET_REFL]; TYPE_THEN `eps' = eps` ASM_CASES_TAC; TYPE_THEN`eps'` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps'` UNABBREV_TAC; ]);; (* }}} *) let trap_odd_cell = prove_by_refinement( `!A B C. psegment_triple A B C ==> (A SUBSET par_cell F (B UNION C)) \/ (B SUBSET par_cell F (A UNION C)) \/ (C SUBSET par_cell F (A UNION B))`, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; TYPE_THEN `C SUBSET par_cell (~F) (A UNION B)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC triple_in_comp;ALL_TAC]; TYPE_THEN `A SUBSET par_cell (~F) (B UNION C)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC triple_in_comp;ALL_TAC]; IMATCH_MP_TAC psegment_triple3; TYPE_THEN `B SUBSET par_cell (~F) (C UNION A)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC triple_in_comp;ALL_TAC]; CONJ_TAC; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple3; USE 6(ONCE_REWRITE_RULE[UNION_COMM]); ASM_MESON_TAC[]; FULL_REWRITE_TAC[]; (* - *) TYPE_THEN `!A B. psegment_triple A B C /\ (C SUBSET par_cell T (A UNION B)) /\ (A SUBSET par_cell T (B UNION C)) ==> (par_cell F (A UNION B) SUBSET par_cell T (B UNION C))` SUBAGOAL_TAC; THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`T`] trap_triple_seg; FULL_REWRITE_TAC[UNION_COMM]; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple2; FULL_REWRITE_TAC[UNION_COMM]; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`B'`;`C`;`A'`;`F`;`F`] trap_triple_seg; IMATCH_MP_TAC psegment_triple3; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[UNION_COMM]; TYPE_THEN `par_cell F (B' UNION C) = par_cell F (A' UNION B')` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`F`] triple_par_cell_distinct; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple2; FULL_REWRITE_TAC[UNION_COMM]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `par_cell F (B' UNION A') SUBSET par_cell T (B' UNION A')` SUBAGOAL_TAC; FULL_REWRITE_TAC[UNION_COMM]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `par_cell F (B' UNION C)` EXISTS_TAC; (* -- *) THM_INTRO_TAC[`A' UNION B'`;`F` ] par_cell_nonempty; USE 9(REWRITE_RULE[psegment_triple]); FULL_REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`A' UNION B'`;`F`] par_cell_disjoint; FULL_REWRITE_TAC[EQ_EMPTY;INTER]; TSPEC `u` 16; REWR 16; USE 14(REWRITE_RULE[SUBSET]); FULL_REWRITE_TAC[UNION_COMM]; ASM_MESON_TAC[]; (* -A *) COPY 7; UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`B`]); UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`B`;`A`]); FULL_REWRITE_TAC[UNION_COMM]; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple2; (* - *) FULL_REWRITE_TAC[UNION_COMM]; THM_INTRO_TAC[`A UNION B`;`F`] par_cell_nonempty; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`A UNION B`;`u`;`F`] parity_unique; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; TYPE_THEN `par_cell T (A UNION C) u /\ par_cell T (B UNION C) u` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`A UNION C`;`u`;`T`] parity_unique; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; (* -B *) TYPE_THEN `cell u` SUBAGOAL_TAC; ASM_MESON_TAC[par_cell_cell;subset_imp]; TYPE_THEN `!A B eps. rectagon (A UNION B) /\ (par_cell eps (A UNION B) u) ==> ~curve_cell A u` SUBAGOAL_TAC; THM_INTRO_TAC[`A' UNION B'`;`eps`] par_cell_curve_cell_disj; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[EQ_EMPTY;INTER]; TSPEC `u` 19; USE 19 (REWRITE_RULE[curve_cell_union;DE_MORGAN_THM ]); FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; USE 20 (REWRITE_RULE[UNION]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `segment A /\ segment B /\ segment C /\ segment (A UNION B) /\ segment (B UNION C) /\ segment (A UNION C) /\ (A INTER B = EMPTY) /\ (B INTER C = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment]; FULL_REWRITE_TAC[UNION_COMM]; REPEAT CONJ_TAC THEN (IMATCH_MP_TAC rectagon_segment); (* -C *) THM_INTRO_TAC[`A`;`B`;`u`] parity_union; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `F` EXISTS_TAC; FULL_REWRITE_TAC[psegment_triple]; TYPE_THEN `A` EXISTS_TAC; USE 10 SYM; TYPE_THEN `F` EXISTS_TAC; FULL_REWRITE_TAC[UNION_COMM]; FULL_REWRITE_TAC[psegment_triple]; (* - *) THM_INTRO_TAC[`B`;`C`;`u`] parity_union; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `T` EXISTS_TAC; FULL_REWRITE_TAC[psegment_triple]; TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `T` EXISTS_TAC; FULL_REWRITE_TAC[UNION_COMM]; FULL_REWRITE_TAC[psegment_triple]; (* - *) THM_INTRO_TAC[`A`;`C`;`u`] parity_union; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `T` EXISTS_TAC; FULL_REWRITE_TAC[psegment_triple]; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `T` EXISTS_TAC; FULL_REWRITE_TAC[UNION_COMM]; FULL_REWRITE_TAC[psegment_triple]; REWR 28; REWR 27; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION V *) (* ------------------------------------------------------------------ *) (* -- more on 2-connectedness, etc. *) let euclid_diff_par_cell = prove_by_refinement( `!G eps. (segment G) ==> (euclid 2 DIFF UNIONS(par_cell (~eps) G) = UNIONS(par_cell eps G) UNION UNIONS (curve_cell G))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[DIFF;UNION]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; PROOF_BY_CONTR_TAC; USE 3(REWRITE_RULE[DE_MORGAN_THM]); TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC; ASM_REWRITE_TAC[ctop_unions;DIFF]; (* -- *) THM_INTRO_TAC[`G`;`eps`] par_cell_partition; USE 6 SYM; REWR 5; FULL_REWRITE_TAC[UNION]; ASM_MESON_TAC[]; (* - *) CONJ_TAC; USE 1(REWRITE_RULE[UNIONS]); LEFT 1 "u"; THM_INTRO_TAC[`u`] cell_euclid; THM_INTRO_TAC[`G`;`eps`] par_cell_cell; THM_INTRO_TAC[`G`] curve_cell_cell; FULL_REWRITE_TAC[segment]; ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC[subset_imp]; (* - *) THM_INTRO_TAC[`G`;`eps`] par_cell_union_disjoint; USE 3(REWRITE_RULE[INTER;EQ_EMPTY]); FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`G`] ctop_unions; USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 5; FULL_REWRITE_TAC[DIFF]; TYPE_THEN `~UNIONS (ctop G )x` SUBAGOAL_TAC; ASM_MESON_TAC[]; THM_INTRO_TAC[`G`;`eps`] par_cell_partition; USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]); FULL_REWRITE_TAC[UNION]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_closure_cell = prove_by_refinement( `!G C d eps. cell C /\ cell d /\ rectagon G /\ (d SUBSET closure top2 C) /\ par_cell eps G C ==> (par_cell eps G d \/ curve_cell G d)`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC top2_top; TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC; THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed; REWRITE_TAC[open_DEF]; TYPE_THEN `UNIONS (par_cell (~eps) G) = EMPTY ` ASM_CASES_TAC; USE 5 (MATCH_MP (REWRITE_RULE[open_DEF]open_EMPTY)); FULL_REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`G`;`~eps`;`u`] par_cell_union_comp; IMATCH_MP_TAC ctop_comp_open ; ASM_MESON_TAC[rectagon]; FULL_REWRITE_TAC[top2_unions]; THM_INTRO_TAC[`G`;`eps`] euclid_diff_par_cell; IMATCH_MP_TAC rectagon_segment; REWR 6; KILL 7; (* -A *) TYPE_THEN `closure top2 C SUBSET (UNIONS (par_cell eps G) UNION UNIONS (curve_cell G))` SUBAGOAL_TAC; IMATCH_MP_TAC closure_subset; IMATCH_MP_TAC in_union; DISJ1_TAC; IMATCH_MP_TAC sub_union; (* - *) TYPE_THEN `d SUBSET UNIONS (par_cell eps G) UNION UNIONS (curve_cell G)` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; FULL_REWRITE_TAC[GSYM UNIONS_UNION]; (* - *) THM_INTRO_TAC[`d`] cell_nonempty; FULL_REWRITE_TAC[EMPTY_EXISTS]; (* - *) THM_INTRO_TAC[`par_cell eps G UNION curve_cell G`;`d`;`u`] cell_ununion; CONJ_TAC; REWRITE_TAC[union_subset]; REWRITE_TAC [par_cell_cell]; THM_INTRO_TAC[`G`] curve_cell_cell; FULL_REWRITE_TAC[rectagon]; REWRITE_TAC[UNIONS;UNION]; USE 8(REWRITE_RULE[SUBSET;UNIONS]); TSPEC `u` 8; USE 8 (REWRITE_RULE[UNION]); TYPE_THEN `u'` EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[UNION]; (* Thu Dec 2 09:50:25 EST 2004 *) ]);; (* }}} *) let rectagon_curve = prove_by_refinement( `!G C a b. FINITE G /\ G SUBSET edge /\ simple_arc_end C a b /\ (C INTER UNIONS (curve_cell G) = EMPTY) ==> (C SUBSET (component (ctop G) a))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[SUBSET]; TYPE_THEN `a = x` ASM_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; IMATCH_MP_TAC component_refl; FULL_REWRITE_TAC[ctop_unions;DIFF;EQ_EMPTY ;INTER ]; CONJ_TAC; USE 1 (MATCH_MP simple_arc_end_simple); USE 1 (MATCH_MP simple_arc_euclid); ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`G`;`a`;`x`] component_simple_arc; TYPE_THEN `x = b` ASM_CASES_TAC; TYPE_THEN `C` EXISTS_TAC; (* - *) THM_INTRO_TAC[`C`;`a`;`b`;`x`] simple_arc_end_cut; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `C` UNABBREV_TAC; FULL_REWRITE_TAC[GSYM SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `(C' UNION C'') INTER UNIONS (curve_cell G)` EXISTS_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET;UNION]; (* Thu Dec 2 10:11:45 EST 2004 *) ]);; (* }}} *) (* *) let star_avoidance_lemma1 = prove_by_refinement( `!E E' R B x. bounded_set E x /\ E SUBSET E' /\ FINITE E' /\ E' SUBSET edge /\ rectagon R /\ R SUBSET E /\ ~(UNIONS (curve_cell B) x) /\ B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==> (bounded_set (E' DIFF B) x \/ unbounded_set (E' DIFF B) x)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`ctop E`;`x`] component_empty; REWRITE_TAC[ctop_top]; (* - *) TYPE_THEN `UNIONS (ctop E) x` SUBAGOAL_TAC; USE 9 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] not_eq]); FULL_REWRITE_TAC[EMPTY_EXISTS;bounded_set]; ASM_MESON_TAC[]; KILL 9; (* - *) TYPE_THEN `UNIONS (ctop (E' DIFF B)) x` SUBAGOAL_TAC; REWRITE_TAC[ctop_unions]; TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ; REWRITE_TAC[DIFF]; CONJ_TAC; USE 10(REWRITE_RULE[ctop_unions;DIFF]); TYPE_THEN `E' = E'' UNION E'` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; TYPE_THEN `E''` UNABBREV_TAC; REWRITE_TAC[DIFF;UNION]; MESON_TAC[]; THM_INTRO_TAC[`E''`;`E'`] curve_cell_union; USE 12 SYM; REWR 13; TYPE_THEN `UNIONS (curve_cell E') = UNIONS (curve_cell E'') UNION UNIONS(curve_cell E')` SUBAGOAL_TAC; REWRITE_TAC[GSYM UNIONS_UNION]; AP_TERM_TAC; ASM_MESON_TAC[]; USE 14(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 14; USE 14(REWRITE_RULE[UNION]); ASM_MESON_TAC[]; (* -A *) THM_INTRO_TAC[`E' DIFF B`] bounded_unbounded_union; USE 11(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 11; REWR 11; USE 11(REWRITE_RULE[UNION]); (* - *) ]);; (* }}} *) let curve_cell_imp_subset = prove_by_refinement( `!A B. A SUBSET B ==> curve_cell A SUBSET curve_cell B`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `B = A UNION (B DIFF A)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; FULL_REWRITE_TAC [UNION;DIFF;SUBSET ]; ASM_MESON_TAC []; TYPE_THEN `C = B DIFF A` ABBREV_TAC ; REWRITE_TAC[curve_cell_union]; REWRITE_TAC[SUBSET;UNION]; ]);; (* }}} *) let unbound_set_x_axis = prove_by_refinement( `!G. (FINITE G /\ G SUBSET edge ) ==> (?r. !s. (r <= s) ==> unbounded_set G (point(s,&0)))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[unbounded_set;unbounded;]; NAME_CONFLICT_TAC; LEFT_TAC "r'"; LEFT_TAC "r'"; THM_INTRO_TAC[`G`] unbounded_set_nonempty; FULL_REWRITE_TAC[EMPTY_EXISTS;unbounded_set;unbounded]; TYPE_THEN `r` EXISTS_TAC; TYPE_THEN `(\ (s:real). r)` EXISTS_TAC; COPY 2; TSPEC `s'` 2; TSPEC `s''` 5; USE 4 (MATCH_MP component_symm); USE 4 (MATCH_MP component_replace); ASM_REWRITE_TAC[]; ]);; (* }}} *) let star_avoidance = prove_by_refinement( `!E E' R B x. unbounded_set (E' DIFF B) x /\ E SUBSET E' /\ FINITE E' /\ E' SUBSET edge /\ rectagon R /\ R SUBSET E /\ FINITE B /\ B SUBSET edge /\ ~(UNIONS (curve_cell B) x) /\ B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==> ( unbounded_set (E) x)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ; RULE_ASSUM_TAC (REWRITE_RULE[unbounded_set;unbounded]); (* - *) THM_INTRO_TAC[`R`] unbound_set_x_axis; FULL_REWRITE_TAC[rectagon]; (* - *) TYPE_THEN `?r. !s. (r <= s) ==> component (ctop E'') x (point(s,&0)) /\ ~(x = (point(s,&0))) /\ unbounded_set R (point(s,&0)) ` SUBAGOAL_TAC; TYPE_THEN `r'' = &1 + (||. r') + (||. r) + ||. (x 0)` ABBREV_TAC ; TYPE_THEN `r''` EXISTS_TAC; TYPE_THEN `r <= s` SUBAGOAL_TAC; UNDF `r'' <= s` THEN UND 13 THEN REAL_ARITH_TAC; CONJ_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[coord01]; UND 13 THEN UND 14 THEN REAL_ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 13 THEN UND 14 THEN REAL_ARITH_TAC; KILL 12; KILL 10; (* - *) TYPE_THEN `FINITE E'' /\ E'' SUBSET edge` SUBAGOAL_TAC; TYPE_THEN `E''` UNABBREV_TAC; CONJ_TAC; IMATCH_MP_TAC FINITE_DIFF; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET_DIFF]; (* - *) TYPE_THEN `!s. ?C. (r'' <= s) ==> (simple_arc_end C x (point(s,&0)) /\ (C INTER UNIONS (curve_cell E'') = {}))` SUBAGOAL_TAC; TSPEC `s` 13; RIGHT_TAC "C"; THM_INTRO_TAC[`E''`;`x`;`point(s,&0)`] component_simple_arc; ASM_MESON_TAC[]; (* -A *) REWRITE_TAC[unbounded_set;unbounded]; TYPE_THEN `r''` EXISTS_TAC; TSPEC `s` 13; TSPEC `s` 14; THM_INTRO_TAC[`E`;`x`;`point(s,&0)`] component_simple_arc; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; ASM_MESON_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; TYPE_THEN `C` EXISTS_TAC; (* - *) TYPE_THEN `R SUBSET E''` SUBAGOAL_TAC; TYPE_THEN `E''` UNABBREV_TAC; REWRITE_TAC[DIFF_SUBSET]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj; FULL_REWRITE_TAC[rectagon]; USE 21(REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u` 21; UND 21 THEN ASM_REWRITE_TAC[]; CONJ_TAC; ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC[curve_cell_subset;subset_imp]; (* -B *) TYPE_THEN `C INTER UNIONS(curve_cell R) = EMPTY` SUBAGOAL_TAC; FULL_REWRITE_TAC[GSYM SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C INTER UNIONS (curve_cell E'')` EXISTS_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; IMATCH_MP_TAC UNIONS_UNIONS; IMATCH_MP_TAC curve_cell_imp_subset; (* - *) THM_INTRO_TAC[`R`;`C`;`x`;`point(s,&0)`] rectagon_curve; FULL_REWRITE_TAC[rectagon]; (* - *) THM_INTRO_TAC[`R`]unbounded_set_comp; FULL_REWRITE_TAC[rectagon]; TYPE_THEN `component (ctop R) x' = component (ctop R) (point(s,&0))` SUBAGOAL_TAC; IMATCH_MP_TAC component_replace; USE 23 SYM; ASM_REWRITE_TAC[]; TYPE_THEN `component (ctop R) x'` UNABBREV_TAC; TYPE_THEN `component (ctop R) x = component (ctop R) (point(s,&0))` SUBAGOAL_TAC; IMATCH_MP_TAC component_replace; USE 22(REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* -C *) THM_INTRO_TAC[`R`;`B`;`F`] par_cell_closure; (* - *) TYPE_THEN `C INTER UNIONS (curve_cell B) = EMPTY` SUBAGOAL_TAC; FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (par_cell T R) INTER UNIONS (curve_cell B)` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; THM_INTRO_TAC[`R`] unbounded_even; USE 26 SYM; ASM_MESON_TAC[]; ONCE_REWRITE_TAC[INTER_COMM]; FULL_REWRITE_TAC[SUBSET_EMPTY ]; THM_INTRO_TAC[`curve_cell B`;`par_cell T R`] cell_unions_disj; THM_INTRO_TAC[`B`]curve_cell_cell; THM_INTRO_TAC[`R`]par_cell_cell; USE 26 (ONCE_REWRITE_RULE[EQ_SYM_EQ]); ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `E SUBSET E'' UNION B` SUBAGOAL_TAC; TYPE_THEN `E''` UNABBREV_TAC; REWRITE_TAC[SUBSET;DIFF;UNION]; ASM_MESON_TAC[subset_imp]; (* - *) FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C INTER UNIONS (curve_cell (E'' UNION B))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; IMATCH_MP_TAC UNIONS_UNIONS; IMATCH_MP_TAC curve_cell_imp_subset; (* - *) REWRITE_TAC[curve_cell_union;UNIONS_UNION]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; (* Thu Dec 2 16:12:59 EST 2004 *) ]);; (* }}} *) let star_avoidance_contrp = prove_by_refinement( `!E E' R B x. bounded_set (E) x /\ E SUBSET E' /\ FINITE E' /\ E' SUBSET edge /\ rectagon R /\ R SUBSET E /\ FINITE B /\ B SUBSET edge /\ ~(UNIONS (curve_cell B) x) /\ B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==> ( bounded_set (E' DIFF B) x)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance_lemma1; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance; THM_INTRO_TAC[`E`] bounded_unbounded_disj; FULL_REWRITE_TAC[EQ_EMPTY;INTER]; ASM_MESON_TAC[]; ]);; (* }}} *) let bounded_avoidance_subset = prove_by_refinement( `!E E' x. bounded_set E x /\ E SUBSET E' /\ (E' SUBSET edge) /\ (FINITE E') /\ conn2 E /\ ~(UNIONS (curve_cell E') x) ==> (bounded_set E' x)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`] conn2_has_rectagon; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance_contrp; ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty]; FULL_REWRITE_TAC[DIFF_EMPTY]; ]);; (* }}} *) let unbounded_avoidance_subset = prove_by_refinement( `!E E' x. (unbounded_set E' x) /\ E SUBSET E' /\ (E' SUBSET edge) /\ (FINITE E') /\ conn2 E /\ ~(UNIONS (curve_cell E') x) ==> unbounded_set E x `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`] conn2_has_rectagon; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance; ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty;DIFF_EMPTY]; ]);; (* }}} *) let diff_unchange = prove_by_refinement( `! (A:A -> bool) B. (A DIFF B = A) <=> (A INTER B = EMPTY)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; USE 0(ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 0(REWRITE_RULE[DIFF]); IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[EQ_EMPTY;INTER]; ASM_MESON_TAC[]; USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); IMATCH_MP_TAC EQ_EXT; FULL_REWRITE_TAC[DIFF;INTER]; ASM_MESON_TAC[]; ]);; (* }}} *) let union_diff2 = prove_by_refinement( `!(A:A->bool) B. (A UNION B) DIFF A = (B DIFF A)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;DIFF;]; MESON_TAC[]; ]);; (* }}} *) let unbounded_triple_avoidance = prove_by_refinement( `!A B C x. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) /\ unbounded_set (B UNION C) x ==> unbounded_set (A UNION B UNION C) x`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance; CONJ_TAC; TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC; ONCE_REWRITE_TAC [union_diff2]; REWRITE_TAC[diff_unchange]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[psegment_triple]; ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[SUBSET_REFL]; CONJ_TAC; REWRITE_TAC[FINITE_UNION]; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment;segment]; (* -- *) CONJ_TAC; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment;segment]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; USE 15 (REWRITE_RULE[segment;psegment]); CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; USE 15 (REWRITE_RULE[segment;psegment]); SUBCONJ_TAC; THM_INTRO_TAC[`(B UNION C)`;`A`;`F`] par_cell_closure; FULL_REWRITE_TAC[psegment_triple]; USE 16 (REWRITE_RULE[psegment;segment]); THM_INTRO_TAC[`B UNION C`] unbounded_even; FULL_REWRITE_TAC[psegment_triple]; REWR 0; KILL 5; FULL_REWRITE_TAC[UNIONS]; TYPE_THEN `u = u'` SUBAGOAL_TAC; IMATCH_MP_TAC cell_partition; REWRITE_TAC[EMPTY_EXISTS;INTER ]; THM_INTRO_TAC[`A`] curve_cell_cell; FULL_REWRITE_TAC[psegment_triple]; USE 19 (REWRITE_RULE[psegment;segment;]); REPEAT CONJ_TAC THEN (TRY (ASM_MESON_TAC[par_cell_cell;subset_imp])); TYPE_THEN`u'` UNABBREV_TAC; USE 4 (REWRITE_RULE [EQ_EMPTY;INTER]); ASM_MESON_TAC[]; (* -A *) USE 3(ONCE_REWRITE_RULE[curve_cell_union; ]); USE 3(REWRITE_RULE[UNIONS_UNION]); TYPE_THEN `D = B UNION C` ABBREV_TAC ; USE 3(REWRITE_RULE[UNION]); REWR 3; TYPE_THEN `D` UNABBREV_TAC; THM_INTRO_TAC[`B UNION C`;`T`] unions_curve_cell_par_cell_disj; FULL_REWRITE_TAC[psegment_triple]; USE 12(REWRITE_RULE[rectagon]); THM_INTRO_TAC[`B UNION C`] unbounded_even; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; ]);; (* }}} *) let unbounded_set_comp_elt_eq = prove_by_refinement( `! G x. FINITE G /\ G SUBSET edge /\ unbounded_set G x ==> (unbounded_set G = component (ctop G) x) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`] unbounded_set_comp; IMATCH_MP_TAC component_replace; REWR 0; ]);; (* }}} *) let outer_segment_even = prove_by_refinement( `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) ==> C SUBSET par_cell T (A UNION B)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple;psegment;segment]; TYPE_THEN `C` UNABBREV_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; (* - *) THM_INTRO_TAC[`B UNION C`] unbounded_set_nonempty; FULL_REWRITE_TAC[psegment_triple]; USE 10(REWRITE_RULE [rectagon]); FULL_REWRITE_TAC[EMPTY_EXISTS]; (* - *) THM_INTRO_TAC[`B UNION C`;`u'`] unbounded_set_comp_elt_eq; FULL_REWRITE_TAC[psegment_triple]; USE 11 (REWRITE_RULE[rectagon]); THM_INTRO_TAC[`B UNION C`;`u'`;`u`] along_lemma11; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC rectagon_segment; REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; ASM_MESON_TAC[]; REWRITE_TAC[UNION]; (* - *) THM_INTRO_TAC[`squ p`] cell_nonempty; REWRITE_TAC[cell_rules]; FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `unbounded_set (B UNION C) u''` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; (* -A *) THM_INTRO_TAC[`A`;`B`;`C`;`u''`] unbounded_triple_avoidance; THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`u''`] unbounded_avoidance_subset; (* -- *) CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; FIRST_ASSUM DISJ_CASES_TAC; CONJ_TAC; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment;segment]; CONJ_TAC; REWRITE_TAC[FINITE_UNION]; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment;segment]; CONJ_TAC; IMATCH_MP_TAC conn2_rectagon; FULL_REWRITE_TAC[psegment_triple]; (* --B *) TYPE_THEN `D = B UNION C` ABBREV_TAC ; USE 10(REWRITE_RULE[curve_cell_union;]); USE 10(REWRITE_RULE[UNIONS_UNION]); USE 10(REWRITE_RULE[UNION]); THM_INTRO_TAC[`D`] unbounded_even; TYPE_THEN `D` UNABBREV_TAC; FULL_REWRITE_TAC[psegment_triple]; KILL 4; TYPE_THEN `unbounded_set D` UNABBREV_TAC; FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`D`;`A`;`F`] par_cell_closure; TYPE_THEN `D` UNABBREV_TAC; FULL_REWRITE_TAC[psegment_triple]; USE 23(REWRITE_RULE[psegment;segment]); THM_INTRO_TAC[`curve_cell A`;`par_cell T D`] cell_unions_disj; THM_INTRO_TAC[`A`] curve_cell_cell; FULL_REWRITE_TAC[psegment_triple]; USE 25(REWRITE_RULE[psegment;segment]); THM_INTRO_TAC[`D`] par_cell_cell; REWR 12; REWR 13; USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; (* -- *) THM_INTRO_TAC[`D`;`T`]unions_curve_cell_par_cell_disj; FULL_REWRITE_TAC[psegment_triple]; TYPE_THEN `D` UNABBREV_TAC; USE 19 (REWRITE_RULE[rectagon]); FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* -C *) THM_INTRO_TAC[`A UNION B`] unbounded_even; FULL_REWRITE_TAC[psegment_triple]; KILL 4; TYPE_THEN `unbounded_set (A UNION B)` UNABBREV_TAC; THM_INTRO_TAC[`par_cell T (A UNION B)`;`squ p`;`u''`] cell_ununion; REWRITE_TAC[par_cell_cell;cell_rules]; THM_INTRO_TAC[`A UNION B`;`squ p`;`u`;`T`] par_cell_closure_cell; REWRITE_TAC[cell_rules;squ_closure]; CONJ_TAC; IMATCH_MP_TAC edge_cell; FULL_REWRITE_TAC[psegment_triple]; USE 21 (REWRITE_RULE[psegment;segment]); ASM_MESON_TAC[subset_imp]; FULL_REWRITE_TAC[psegment_triple]; (* - *) THM_INTRO_TAC[`A UNION B`;`u`] curve_cell_edge; FULL_REWRITE_TAC[psegment_triple]; USE 22 (REWRITE_RULE[psegment;segment]); ASM_MESON_TAC[subset_imp]; REWR 11; KILL 12; (* - *) FIRST_ASSUM DISJ_CASES_TAC ; THM_INTRO_TAC[`A UNION B`;`C`] segment_in_comp; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[cls_union]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER;union_subset]; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[INTER_COMM]; ASM_MESON_TAC[SUBSET_REFL]; (* -- *) TYPE_THEN `eps = T` ASM_CASES_TAC; TYPE_THEN `eps` UNABBREV_TAC; TYPE_THEN `eps = F` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint; USE 15(REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u` 15; USE 13 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; (* - *) USE 12 (REWRITE_RULE[UNION]); FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; ]);; (* }}} *) let meeting_lemma = prove_by_refinement( `!R B C v eps. rectagon R /\ B SUBSET par_cell eps R /\ (C INTER R = EMPTY) /\ cls R INTER cls C SUBSET endpoint C /\ cls C v /\ cls B v /\ ~cls R v /\ segment C /\ B SUBSET edge ==> C SUBSET par_cell eps R`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`R`;`C`] segment_in_comp; TYPE_THEN `eps' = eps` ASM_CASES_TAC ; TYPE_THEN `eps'` UNABBREV_TAC; TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps'` UNABBREV_TAC; KILL 10; (* - *) TYPE_THEN `~(C INTER par_cell eps R = EMPTY)` BACK_TAC ; USE 10(REWRITE_RULE[INTER;EMPTY_EXISTS ]); THM_INTRO_TAC[`R`;`eps`] par_cell_disjoint; USE 12(REWRITE_RULE[INTER;EQ_EMPTY]); USE 9 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `?eC. closure top2 eC (pointI v) /\ C eC` SUBAGOAL_TAC; FULL_REWRITE_TAC[cls]; ASM_MESON_TAC[]; TYPE_THEN `?eB. closure top2 eB (pointI v) /\ B eB` SUBAGOAL_TAC; FULL_REWRITE_TAC[cls]; ASM_MESON_TAC[]; (* - *) UND 10 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `eC` EXISTS_TAC; IMATCH_MP_TAC par_cell_nbd; TYPE_THEN `v` EXISTS_TAC; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; FULL_REWRITE_TAC[segment]; ASM_MESON_TAC[subset_imp]; (* - *) THM_INTRO_TAC[`R`;`eB`;`{(pointI v)}`;`eps`] par_cell_closure_cell; REWRITE_TAC[cell_rules;SUBSET;INR IN_SING]; CONJ_TAC; IMATCH_MP_TAC edge_cell; ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC[subset_imp]; PROOF_BY_CONTR_TAC; REWR 10; THM_INTRO_TAC[`R`;`v`] curve_cell_not_point; IMATCH_MP_TAC rectagon_segment; UND 16 THEN ASM_REWRITE_TAC[]; THM_INTRO_TAC[`R`;`pointI v`] num_closure0; FULL_REWRITE_TAC[rectagon]; USE 2(REWRITE_RULE[cls]); ASM_MESON_TAC[]; ]);; (* }}} *) let parity_union_triple = prove_by_refinement( `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\ (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\ (A SUBSET edge) /\ A e ==> (parity (B UNION C) e = (parity B e = parity C e))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `edge e` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`B`;`C`;`e`] parity_union; CONJ_TAC; IMATCH_MP_TAC edge_cell; (* - *) TYPE_THEN `~B e /\ ~C e` SUBAGOAL_TAC; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; ASM_SIMP_TAC[curve_cell_edge]; ]);; (* }}} *) let parity_union_triple_even = prove_by_refinement( `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\ (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\ (segment A ) /\ A e /\ A SUBSET par_cell T (B UNION C) ==> (parity B e = parity C e)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple; FULL_REWRITE_TAC[segment]; USE 9(ONCE_REWRITE_RULE[EQ_SYM_EQ]); THM_INTRO_TAC[`B UNION C`;`e`;`T`] parity_unique; ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let parity_union_triple_odd = prove_by_refinement( `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\ (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\ (A SUBSET edge) /\ A e /\ A SUBSET par_cell F (B UNION C) ==> ~(parity B e = parity C e)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple; REWR 10; THM_INTRO_TAC[`B UNION C`;`e`;`F`] parity_unique; ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC[]; ]);; (* }}} *) let par_cell_even_imp = prove_by_refinement( `!A B C D. psegment_triple A B D /\ segment C /\ cls (A UNION B) INTER cls C SUBSET endpoint C /\ (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY) /\ C SUBSET par_cell T (B UNION D) /\ C SUBSET par_cell T (A UNION D) ==> C SUBSET par_cell T (A UNION B)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp; REWRITE_TAC[cls_union]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; (* - *) TYPE_THEN `eps = T` ASM_CASES_TAC; TYPE_THEN `eps` UNABBREV_TAC; TYPE_THEN `eps = F` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; KILL 9; PROOF_BY_CONTR_TAC; (* - *) TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[subset_imp]; (* - *) THM_INTRO_TAC[`C`;`A`;`D`;`e`] parity_union_triple_even; FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; IMATCH_MP_TAC rectagon_segment; THM_INTRO_TAC[`C`;`B`;`D`;`e`] parity_union_triple_even; FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; IMATCH_MP_TAC rectagon_segment; TYPE_THEN `parity D e` UNABBREV_TAC; USE 12 SYM; (* - *) THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple; FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; USE 6(REWRITE_RULE[segment]); REWR 13; (* - *) THM_INTRO_TAC[`(A UNION B)`;`e`] parity; ASM_SIMP_TAC[curve_cell_edge]; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; CONJ_TAC; IMATCH_MP_TAC edge_cell; USE 27 (REWRITE_RULE[UNION]); FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`A UNION B`;`parity(A UNION B) e`] par_cell_disjoint; USE 15(REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `e` 15; UND 15 THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let par_cell_odd_imp = prove_by_refinement( `!A B C D. psegment_triple A B D /\ segment C /\ cls (A UNION B) INTER cls C SUBSET endpoint C /\ (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY) /\ C SUBSET par_cell F (B UNION D) /\ C SUBSET par_cell T (A UNION D) ==> C SUBSET par_cell F (A UNION B)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp; REWRITE_TAC[cls_union]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; (* - *) TYPE_THEN `eps = F` ASM_CASES_TAC; TYPE_THEN `eps` UNABBREV_TAC; TYPE_THEN `eps = T` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; KILL 9; PROOF_BY_CONTR_TAC; (* - *) TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment]; FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[subset_imp]; (* - *) THM_INTRO_TAC[`C`;`A`;`D`;`e`] parity_union_triple_even; FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; IMATCH_MP_TAC rectagon_segment; THM_INTRO_TAC[`C`;`B`;`D`;`e`] parity_union_triple_odd; FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; USE 6 (REWRITE_RULE[segment]); TYPE_THEN `parity D e` UNABBREV_TAC; USE 13 GSYM; (* - *) THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple; FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; USE 6(REWRITE_RULE[segment]); (* - *) THM_INTRO_TAC[`(A UNION B)`;`e`] parity; ASM_SIMP_TAC[curve_cell_edge]; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; CONJ_TAC; IMATCH_MP_TAC edge_cell; USE 27 (REWRITE_RULE[UNION]); FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `parity(A UNION B) e = F` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILL 13 THEN REWR 14; UND 9 THEN ASM_REWRITE_TAC[]; THM_INTRO_TAC[`A UNION B`;`F`] par_cell_disjoint; USE 9(REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `e` 9; ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let curve_cell_cls = prove_by_refinement( `!G m. segment G ==> (curve_cell G {(pointI m)} = cls G m)`, (* {{{ proof *) [ REP_BASIC_TAC; ASM_SIMP_TAC[curve_cell_not_point]; THM_INTRO_TAC[`G`;`pointI m`] num_closure0; FULL_REWRITE_TAC[segment]; REWRITE_TAC[cls]; ASM_MESON_TAC[]; ]);; (* }}} *) let conn2_rect_diff_inner = prove_by_refinement( `!E R. conn2 E /\ (E SUBSET edge) /\ rectagon R /\ R SUBSET E ==> conn2 (E DIFF (E INTER par_cell F R))`, (* {{{ proof *) [ REWRITE_TAC[conn2]; TYPE_THEN `J = E INTER par_cell F R` ABBREV_TAC ; SUBCONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; (* - *) TYPE_THEN `R SUBSET E DIFF J` SUBAGOAL_TAC; REWRITE_TAC[DIFF_SUBSET]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC [EMPTY_EXISTS;INTER]; TYPE_THEN `J` UNABBREV_TAC; THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj; FULL_REWRITE_TAC[rectagon]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; TSPEC `u` 10; THM_INTRO_TAC[`R`;`u`] curve_cell_edge; FULL_REWRITE_TAC[rectagon]; ASM_MESON_TAC[subset_imp]; REWR 10; (* -/ *) THM_INTRO_TAC[`R`] conn2_rectagon; CONJ_TAC; THM_INTRO_TAC[`R`;`E DIFF J`] CARD_SUBSET; FULL_REWRITE_TAC[conn2]; UND 10 THEN UND 11 THEN ARITH_TAC; TYPE_THEN `(E DIFF J) UNION J = E` SUBAGOAL_TAC; TYPE_THEN `J` UNABBREV_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[DIFF;INTER;UNION]; MESON_TAC[]; UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]); UND 15 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); REWRITE_TAC[cls_union]; REWRITE_TAC[UNION]; (* -A *) TYPE_THEN `S SUBSET E DIFF J` ASM_CASES_TAC; TYPE_THEN `S` EXISTS_TAC; TYPE_THEN `~(S INTER J = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `~(S = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end;segment;psegment]; TYPE_THEN `S` UNABBREV_TAC ; USE 20 (REWRITE_RULE[EMPTY_EXISTS]); UND 20 THEN UND 19 THEN UND 18 THEN UND 17 THEN REWRITE_TAC[EQ_EMPTY;SUBSET;INTER;DIFF] THEN MESON_TAC[]; (* -/ *) THM_INTRO_TAC[`R`;`T`;`{(pointI a)}`] par_cell_cell_partition; REWRITE_TAC[cell_rules]; IMATCH_MP_TAC rectagon_segment; TYPE_THEN `par_cell T R {(pointI a)} \/ cls R a` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[cls]; USE 14 (REWRITE_RULE[DIFF]); THM_INTRO_TAC[`R`;`F`;`a`;`e'`] par_cell_nbd; ASM_MESON_TAC[subset_imp]; TYPE_THEN `J` UNABBREV_TAC; USE 14(REWRITE_RULE[INTER]); ASM_MESON_TAC[]; THM_INTRO_TAC[`R`;`a`]curve_cell_cls; IMATCH_MP_TAC rectagon_segment; ASM_MESON_TAC[]; (* -B/ *) KILL 20; THM_INTRO_TAC[`R`;`T`;`{(pointI b)}`] par_cell_cell_partition; REWRITE_TAC[cell_rules]; IMATCH_MP_TAC rectagon_segment; (* - *) TYPE_THEN `par_cell T R {(pointI b)} \/ cls R b` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[cls]; USE 25 (REWRITE_RULE[DIFF]); THM_INTRO_TAC[`R`;`F`;`b`;`e`] par_cell_nbd; ASM_MESON_TAC[subset_imp]; TYPE_THEN `J` UNABBREV_TAC; USE 25(REWRITE_RULE[INTER]); ASM_MESON_TAC[]; THM_INTRO_TAC[`R`;`b`]curve_cell_cls; IMATCH_MP_TAC rectagon_segment; ASM_MESON_TAC[]; KILL 20; KILL 18; USE 19 (REWRITE_RULE [EMPTY_EXISTS;INTER]); (* -C/ *) TYPE_THEN `~cls J a \/ cls R a` SUBAGOAL_TAC; UND 21 THEN DISCH_THEN DISJ_CASES_TAC; DISJ1_TAC; USE 21(REWRITE_RULE[cls]); THM_INTRO_TAC[`R`;`T`;`a`;`e`] par_cell_nbd; TYPE_THEN `J` UNABBREV_TAC; USE 23(REWRITE_RULE[INTER]); ASM_MESON_TAC[subset_imp]; TYPE_THEN `J` UNABBREV_TAC; USE 23(REWRITE_RULE[INTER]); THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; USE 25(REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; (* -/ *) TYPE_THEN `~cls J b \/ cls R b` SUBAGOAL_TAC; UND 22 THEN DISCH_THEN DISJ_CASES_TAC; DISJ1_TAC; USE 23(REWRITE_RULE[cls]); THM_INTRO_TAC[`R`;`T`;`b`;`e`] par_cell_nbd; TYPE_THEN `J` UNABBREV_TAC; USE 24(REWRITE_RULE[INTER]); ASM_MESON_TAC[subset_imp]; TYPE_THEN `J` UNABBREV_TAC; USE 24(REWRITE_RULE[INTER]); THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; USE 26(REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; (* -D/ *) TYPE_THEN `!a b S'. (S' SUBSET S) /\ segment_end S' a b /\ (cls S' INTER cls (R UNION J) = {b}) ==> cls R b /\ (S' INTER (R UNION J) = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `S' INTER (R UNION J) = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 27 (REWRITE_RULE[INTER;UNION ]); THM_INTRO_TAC[`u'`] two_endpoint; FULL_REWRITE_TAC[segment_end;psegment;segment]; UND 28 THEN UND 31 THEN MESON_TAC[subset_imp]; TYPE_THEN `!n. closure top2 u' (pointI n) ==> (n = b')` SUBAGOAL_TAC; USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `n` 24; USE 24 (REWRITE_RULE[INTER;INR IN_SING]); USE 24 SYM; TYPE_THEN `{u'} SUBSET S' /\ {u'} SUBSET (R UNION J)` SUBAGOAL_TAC; REWRITE_TAC[SUBSET;INR IN_SING;UNION ]; USE 31(MATCH_MP cls_subset); USE 32(MATCH_MP cls_subset); FULL_REWRITE_TAC[cls_edge]; FULL_REWRITE_TAC[SUBSET]; USE 29 (REWRITE_RULE[has_size2]); USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 31(REWRITE_RULE[INR in_pair]); COPY 31; TSPEC `a''` 32; TSPEC `b''` 31; REWR 31; REWR 32; UND 29 THEN REWRITE_TAC[]; (* --E *) PROOF_BY_CONTR_TAC; TYPE_THEN `cls J b'` SUBAGOAL_TAC; USE 24(ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 24(REWRITE_RULE[INTER;INR IN_SING]); TSPEC `b'` 24; USE 24(REWRITE_RULE[cls_union]); USE 24(REWRITE_RULE[UNION]); REWR 24; (* --/ *) TYPE_THEN`par_cell F R {(pointI b')}` SUBAGOAL_TAC; THM_INTRO_TAC[`R`;`T`;`{(pointI b')}`] par_cell_cell_partition; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; REWRITE_TAC[cell_rules]; UND 30 THEN REP_CASES_TAC; USE 29 (REWRITE_RULE[cls]); THM_INTRO_TAC[`R`;`e`;`{(pointI b')}`;`F`] par_cell_closure_cell; REWRITE_TAC[cell_rules]; REWRITE_TAC[SUBSET;INR IN_SING]; TYPE_THEN `J` UNABBREV_TAC; USE 31 (REWRITE_RULE[INTER]); IMATCH_MP_TAC edge_cell; UND 31 THEN UND 2 THEN MESON_TAC[subset_imp]; FIRST_ASSUM DISJ_CASES_TAC ; THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj; FULL_REWRITE_TAC[rectagon]; THM_INTRO_TAC[`R`;`b'`] curve_cell_cls; IMATCH_MP_TAC rectagon_segment; REWR 33; THM_INTRO_TAC[`R`;`b'`] curve_cell_cls; IMATCH_MP_TAC rectagon_segment; REWR 30; (* --/ *) USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 24 (REWRITE_RULE[INR IN_SING;cls_union]); TSPEC `b'` 24; USE 24 (REWRITE_RULE[INTER;UNION]); USE 31(REWRITE_RULE[cls]); THM_INTRO_TAC[`R`;`F`;`b'`;`e`] par_cell_nbd; USE 16 (REWRITE_RULE[segment_end;segment;psegment]); UND 36 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; USE 27(REWRITE_RULE[EQ_EMPTY;INTER;UNION]); TSPEC `e` 27; UND 27 THEN ASM_REWRITE_TAC[]; DISJ2_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[INTER]; UND 17 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; (* -F *) TYPE_THEN `?m. (cls R m /\ cls S m)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`R`;`S`] segment_in_comp; FULL_REWRITE_TAC[segment_end;psegment]; LEFT 25 "m" ; CONJ_TAC; PROOF_BY_CONTR_TAC; USE 28(REWRITE_RULE[EMPTY_EXISTS;INTER ]); THM_INTRO_TAC[`u'`] two_endpoint; UND 29 THEN UND 17 THEN UND 2 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; USE 30(REWRITE_RULE[has_size2]); USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `a'` 31; USE 31(REWRITE_RULE[INR in_pair]); TSPEC `a'` 25; USE 25(REWRITE_RULE[cls]); ASM_MESON_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `EMPTY:((int#int)->bool)` EXISTS_TAC; REWRITE_TAC[SUBSET_EMPTY;EQ_EMPTY;INTER;]; TSPEC `x` 25; UND 25 THEN ASM_REWRITE_TAC[]; TYPE_THEN `eps = T` ASM_CASES_TAC ; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; USE 27(REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u` 27; USE 26(REWRITE_RULE[SUBSET]); TYPE_THEN`J` UNABBREV_TAC; USE 18 (REWRITE_RULE[INTER]); UND 6 THEN UND 26 THEN UND 27 THEN UND 19 THEN MESON_TAC[]; TYPE_THEN `eps = F` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILL 27; TYPE_THEN `eps` UNABBREV_TAC; USE 16 (REWRITE_RULE[segment_end]); THM_INTRO_TAC[`S`;`a`] terminal_endpoint; USE 16 (REWRITE_RULE[FUN_EQ_THM]); TSPEC `a` 16; FULL_REWRITE_TAC[psegment;segment;INR in_pair]; TYPE_THEN `e = terminal_edge S a` ABBREV_TAC ; USE 20 (REWRITE_RULE[cls]); FIRST_ASSUM DISJ_CASES_TAC; LEFT 31 "e"; TSPEC `e` 31; TYPE_THEN `J` UNABBREV_TAC; USE 31(REWRITE_RULE[INTER]); UND 6 THEN ASM_REWRITE_TAC[]; UND 29 THEN UND 26 THEN UND 17 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; LEFT 25 "m"; TSPEC `a` 25; USE 25 (REWRITE_RULE[cls]); KILL 24; ASM_MESON_TAC[]; (* -G/ *) TYPE_THEN `conn2 R` SUBAGOAL_TAC; USE 27(REWRITE_RULE[conn2]); TSPEC `m` 27; LEFT 27 "c"; TSPEC `c` 27; (* - a case *) TYPE_THEN `(~(a = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' a m /\ ~cls S' c)` SUBAGOAL_TAC; TYPE_THEN `cls R a` ASM_CASES_TAC; UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`a`]); KILL 24; ASM_MESON_TAC[]; TYPE_THEN `S'` EXISTS_TAC; ONCE_REWRITE_TAC[segment_end_symm]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `R` EXISTS_TAC; (* -- *) TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' a m` SUBAGOAL_TAC; TYPE_THEN `m = b` ASM_CASES_TAC; TYPE_THEN `S` EXISTS_TAC; REWRITE_TAC[SUBSET_REFL]; THM_INTRO_TAC[`S`;`a`;`b`;`m`] cut_psegment; TYPE_THEN `A` EXISTS_TAC; REWRITE_TAC[SUBSET_UNION]; THM_INTRO_TAC[`R UNION J`;`S'`;`a`;`m`] segment_end_select; REWRITE_TAC[cls_union;union_subset]; ASM_REWRITE_TAC[UNION]; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; REWR 20; CONJ_TAC; FULL_REWRITE_TAC [rectagon]; TYPE_THEN `J` UNABBREV_TAC; UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[]; (* -- *) UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`c'`;`B`]); UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; TYPE_THEN `c' = m` ASM_CASES_TAC; TYPE_THEN `B` EXISTS_TAC; CONJ_TAC; USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; TYPE_THEN `c'` UNABBREV_TAC; TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; UND 39 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; (* -- *) TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC; CONJ_TAC; USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; UND 41 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; (* -- *) UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]); CONJ_TAC; TYPE_THEN `c'` UNABBREV_TAC; USE 37(MATCH_MP segment_end_cls2); UND 40 THEN ASM_REWRITE_TAC[]; TYPE_THEN `c` UNABBREV_TAC; USE 32 (MATCH_MP segment_end_cls2); TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; UND 25 THEN UND 3 THEN MESON_TAC[]; USE 42 (ONCE_REWRITE_RULE[segment_end_symm]); (* -- *) TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `R` EXISTS_TAC; THM_INTRO_TAC[`B`;`S''`;`a`;`c'`;`m`] segment_end_trans; TYPE_THEN `U` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `B UNION S''` EXISTS_TAC; REWRITE_TAC[union_subset]; TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; USE 48(REWRITE_RULE[cls_union]); UND 48 THEN UND 47 THEN UND 40 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; (* -H *) TYPE_THEN `(~(b = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' b m /\ ~cls S' c)` SUBAGOAL_TAC; TYPE_THEN `cls R b` ASM_CASES_TAC; UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`b`]); KILL 24; ASM_MESON_TAC[]; TYPE_THEN `S'` EXISTS_TAC; USE 33(ONCE_REWRITE_RULE[segment_end_symm]); IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `R` EXISTS_TAC; (* -- *) TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' b m` SUBAGOAL_TAC; TYPE_THEN `m = a` ASM_CASES_TAC; TYPE_THEN `S` EXISTS_TAC; REWRITE_TAC[SUBSET_REFL]; USE 16 (ONCE_REWRITE_RULE[segment_end_symm]); THM_INTRO_TAC[`S`;`b`;`a`;`m`] cut_psegment; USE 16 (ONCE_REWRITE_RULE[segment_end_symm]); TYPE_THEN `A` EXISTS_TAC; REWRITE_TAC[SUBSET_UNION]; (* -- *) THM_INTRO_TAC[`R UNION J`;`S'`;`b`;`m`] segment_end_select; REWRITE_TAC[cls_union;union_subset]; ASM_REWRITE_TAC[UNION]; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; REWR 23; CONJ_TAC; FULL_REWRITE_TAC [rectagon]; TYPE_THEN `J` UNABBREV_TAC; UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[]; (* -- *) UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`b`;`c'`;`B`]); UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; TYPE_THEN `c' = m` ASM_CASES_TAC; TYPE_THEN `B` EXISTS_TAC; CONJ_TAC; USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; TYPE_THEN `c'` UNABBREV_TAC; TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; UND 40 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; (* -- *) TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC; CONJ_TAC; USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; UND 42 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; (* -- *) UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]); CONJ_TAC; TYPE_THEN `c'` UNABBREV_TAC; USE 38(MATCH_MP segment_end_cls2); UND 41 THEN ASM_REWRITE_TAC[]; TYPE_THEN `c` UNABBREV_TAC; USE 33 (MATCH_MP segment_end_cls2); TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; UND 25 THEN UND 3 THEN MESON_TAC[]; (* -- *) TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `R` EXISTS_TAC; THM_INTRO_TAC[`B`;`S''`;`b`;`c'`;`m`] segment_end_trans; ONCE_REWRITE_TAC[segment_end_symm]; TYPE_THEN `U` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `B UNION S''` EXISTS_TAC; REWRITE_TAC[union_subset]; TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; USE 49(REWRITE_RULE[cls_union]); UND 49 THEN UND 48 THEN UND 41 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; (* -I *) TYPE_THEN `b = m` ASM_CASES_TAC; TYPE_THEN`m` UNABBREV_TAC; TYPE_THEN `a = m` ASM_CASES_TAC; TYPE_THEN `m` UNABBREV_TAC; TYPE_THEN `S'` EXISTS_TAC; ONCE_REWRITE_TAC[segment_end_symm]; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`S''`;`S'`;`a`;`m`;`b`] segment_end_trans; ONCE_REWRITE_TAC[segment_end_symm]; TYPE_THEN `U` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `S'' UNION S'` EXISTS_TAC; REWRITE_TAC[union_subset]; TYPE_THEN `cls U SUBSET cls (S'' UNION S')` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; USE 41(REWRITE_RULE[SUBSET;cls_union]); UND 41 THEN UND 40 THEN UND 30 THEN UND 33 THEN REWRITE_TAC[UNION] THEN MESON_TAC[]; (* Sat Dec 4 18:57:41 EST 2004 *) ]);; (* }}} *) let conn2_psegment_triple = prove_by_refinement( `!E. conn2 E /\ (E SUBSET edge) /\ ~(rectagon E) ==> (?A B C. psegment_triple A B C /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\ A SUBSET par_cell F (B UNION C))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?A B C. psegment_triple A B C /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E)` BACK_TAC; THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; USE 6 (MATCH_MP psegment_triple3); USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]); ASM_MESON_TAC[]; USE 6 (MATCH_MP psegment_triple2); USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]); ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`E`] conn2_has_rectagon; THM_INTRO_TAC[`E`;`B`] conn2_proper; CONJ_TAC; IMATCH_MP_TAC conn2_rectagon; ASM_MESON_TAC[]; THM_INTRO_TAC[`A`] endpoint_size2; FULL_REWRITE_TAC[has_size2]; THM_INTRO_TAC[`B`;`a`;`b`] cut_rectagon_cls; REWR 5; USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 5 (REWRITE_RULE[INTER;INR in_pair]); ASM_MESON_TAC[]; TYPE_THEN `C = A'` ABBREV_TAC ; TYPE_THEN `A'` UNABBREV_TAC; TYPE_THEN`A` EXISTS_TAC; TYPE_THEN `B` UNABBREV_TAC; TYPE_THEN `B'` EXISTS_TAC; TYPE_THEN `C` EXISTS_TAC; REWRITE_TAC[psegment_triple]; TYPE_THEN `psegment B' /\ psegment C` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end]; TYPE_THEN`(A INTER B' = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; USE 5 (REWRITE_RULE[cls_union]); FULL_REWRITE_TAC[UNION_OVER_INTER;]; TYPE_THEN `(endpoint B' = {a,b}) /\ (endpoint C = {a,b})` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end]; TYPE_THEN `(cls A INTER cls B' = {a, b}) /\ (cls A INTER cls C = {a, b})` SUBAGOAL_TAC; TYPE_THEN `endpoint A` UNABBREV_TAC; USE 10 (REWRITE_RULE[FUN_EQ_THM]); USE 5 (REWRITE_RULE[INTER;UNION;INR in_pair]); CONJ_TAC THEN IMATCH_MP_TAC EQ_EXT THEN REWRITE_TAC[INTER;INR in_pair]; ASM_MESON_TAC[segment_end_cls;segment_end_cls2]; ASM_MESON_TAC[segment_end_cls;segment_end_cls2]; (* - *) FULL_REWRITE_TAC[UNION_COMM]; (* - *) TYPE_THEN`segment_end A a b` SUBAGOAL_TAC; REWRITE_TAC[segment_end]; CONJ_TAC ; ASM_MESON_TAC[segment_end_union_rectagon;segment_end_symm;INTER_COMM;UNION_COMM]; ASM_MESON_TAC[union_subset]; ]);; (* }}} *) let rectagon_surround_conn2 = prove_by_refinement( `!G. conn2 G /\ G SUBSET edge ==> (?C. rectagon C /\ C SUBSET G /\ (!x. bounded_set G x ==> bounded_set C x))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `EE = {C | conn2 C /\ (C SUBSET G) /\ (!x. bounded_set G x ==> bounded_set C x)}` ABBREV_TAC ; TYPE_THEN `EE G` SUBAGOAL_TAC; TYPE_THEN `EE` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; THM_INTRO_TAC[`EE`] select_card_min; UND 4 THEN REWRITE_TAC[EMPTY_EXISTS]; ASM_MESON_TAC[]; TYPE_THEN `C = z` ABBREV_TAC ; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `rectagon C` BACK_TAC ; TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `EE` UNABBREV_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `!R. rectagon R /\ R SUBSET C ==> (C INTER par_cell F R = EMPTY)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `J = (C INTER par_cell F R )` ABBREV_TAC ; TYPE_THEN `EE (C DIFF J)` SUBAGOAL_TAC; TYPE_THEN `EE` UNABBREV_TAC; CONJ_TAC; TYPE_THEN `J` UNABBREV_TAC; IMATCH_MP_TAC conn2_rect_diff_inner; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C` EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; TSPEC `x` 2; THM_INTRO_TAC[`C`;`C`;`R`;`J`;`x`] star_avoidance_contrp; REWRITE_TAC[SUBSET_REFL]; (* --- *) TYPE_THEN `FINITE G` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; TYPE_THEN `J SUBSET G` SUBAGOAL_TAC; TYPE_THEN `J` UNABBREV_TAC; UND 3 THEN REWRITE_TAC[SUBSET;INTER] THEN MESON_TAC[]; TYPE_THEN `FINITE C /\ FINITE J` SUBAGOAL_TAC; CONJ_TAC THEN IMATCH_MP_TAC FINITE_SUBSET THEN ASM_MESON_TAC[]; TYPE_THEN `C SUBSET edge /\ J SUBSET edge` SUBAGOAL_TAC; CONJ_TAC THEN IMATCH_MP_TAC SUBSET_TRANS THEN ASM_MESON_TAC[]; TYPE_THEN `J SUBSET par_cell F R` SUBAGOAL_TAC; TYPE_THEN`J` UNABBREV_TAC; REWRITE_TAC[INTER;SUBSET]; TYPE_THEN `~(UNIONS (curve_cell G) x)` SUBAGOAL_TAC; THM_INTRO_TAC[`G`;`x`] bounded_subset_unions; USE 22(REWRITE_RULE[ctop_unions;DIFF ]); ASM_MESON_TAC[]; TYPE_THEN `!A. A SUBSET G ==> UNIONS (curve_cell A) SUBSET UNIONS(curve_cell G)` SUBAGOAL_TAC; IMATCH_MP_TAC UNIONS_UNIONS; IMATCH_MP_TAC curve_cell_imp_subset; ASM_MESON_TAC[subset_imp]; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`C DIFF J`]); USE 4(MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); UND 4 THEN ASM_REWRITE_TAC[]; IMATCH_MP_TAC card_subset_lt; CONJ_TAC; REWRITE_TAC[DIFF;SUBSET]; CONJ_TAC; TYPE_THEN `J` UNABBREV_TAC; USE 9(REWRITE_RULE[EMPTY_EXISTS]); USE 4 (REWRITE_RULE[diff_unchange]); USE 4(REWRITE_RULE[EQ_EMPTY]); FULL_REWRITE_TAC[INTER]; ASM_MESON_TAC[]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; FULL_REWRITE_TAC[conn2]; TYPE_THEN `EE` UNABBREV_TAC; (* -A *) THM_INTRO_TAC[`C`] conn2_psegment_triple; TYPE_THEN `EE` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_TRANS; ASM_MESON_TAC[]; TSPEC `(B UNION C')` 7; UND 7 THEN DISCH_THEN (THM_INTRO_TAC[]); CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; REWRITE_TAC[union_subset]; UND 7 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; TYPE_THEN `A` UNABBREV_TAC; USE 25 (REWRITE_RULE[psegment;segment]); FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let curve_cell_subset = prove_by_refinement( `!H G. (H SUBSET G) ==> UNIONS (curve_cell H) SUBSET UNIONS (curve_cell G)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC UNIONS_UNIONS; TYPE_THEN `G = H UNION (G DIFF H)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; UND 0 THEN REWRITE_TAC[SUBSET;UNION;DIFF] THEN MESON_TAC[]; UND 1 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); REWRITE_TAC[curve_cell_union]; REWRITE_TAC[SUBSET;UNION]; ]);; (* }}} *) let bounded_set_curve_cell_empty = prove_by_refinement( `!H G x. bounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`H`;`G`]curve_cell_subset; THM_INTRO_TAC[`G`] bounded_unbounded_union; USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 4; USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]); FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) let unbounded_set_curve_cell_empty = prove_by_refinement( `!H G x. unbounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`H`;`G`]curve_cell_subset; THM_INTRO_TAC[`G`] bounded_unbounded_union; USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `x` 4; USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]); FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) let bounded_triple_avoidance = prove_by_refinement( `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) ==> bounded_set (A UNION B UNION C) SUBSET bounded_set (B UNION C)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance_lemma1; REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[FINITE_UNION;union_subset]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment;segment]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[psegment;segment]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; THM_INTRO_TAC[`A`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; REWRITE_TAC[SUBSET;UNION]; ASM_MESON_TAC[]; THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; REWRITE_TAC[SUBSET_REFL ]; ASM_MESON_TAC[]; (* -A *) TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; IMATCH_MP_TAC EQ_EXT; UND 10 THEN UND 11 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION;DIFF] THEN MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; REWR 6; REWR 6; (* - *) THM_INTRO_TAC[`A`;`B`;`C`;`x`] unbounded_triple_avoidance; THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj; FULL_REWRITE_TAC[INTER;EQ_EMPTY ]; ASM_MESON_TAC[]; ]);; (* }}} *) let bounded_euclid = prove_by_refinement( `!G x. bounded_set G x ==> euclid 2 x`, (* {{{ proof *) [ REP_BASIC_TAC; USE 0(MATCH_MP bounded_subset_unions); FULL_REWRITE_TAC[ctop_unions;DIFF ]; ]);; (* }}} *) let unbounded_euclid = prove_by_refinement( `!G x. unbounded_set G x ==> euclid 2 x`, (* {{{ proof *) [ REP_BASIC_TAC; USE 0(MATCH_MP unbounded_subset_unions); FULL_REWRITE_TAC[ctop_unions;DIFF ]; ]);; (* }}} *) let bounded_triple_inner_union = prove_by_refinement( `!A B C. psegment_triple A B C ==> bounded_set (A UNION B UNION C) SUBSET (bounded_set (A UNION B) UNION bounded_set (B UNION C))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`;`A`;`B`] trap_odd_cell; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple3; UND 1 THEN REP_CASES_TAC; THM_INTRO_TAC[`C`;`A`;`B`] bounded_triple_avoidance; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple3; FULL_REWRITE_TAC[UNION_ACI;]; IMATCH_MP_TAC in_union; THM_INTRO_TAC[`A`;`B`;`C`] bounded_triple_avoidance; FULL_REWRITE_TAC[UNION_ACI;]; IMATCH_MP_TAC in_union; (* - *) REWRITE_TAC[SUBSET]; ONCE_REWRITE_TAC[UNION]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; THM_INTRO_TAC[`B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; REWRITE_TAC[UNION;SUBSET]; THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[]; TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; ASM_MESON_TAC[bounded_euclid]; THM_INTRO_TAC[`A UNION B`] bounded_unbounded_union; USE 8(ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 8(REWRITE_RULE[ctop_unions;DIFF]); TSPEC `x` 8; TYPE_THEN `R = A UNION B` ABBREV_TAC ; USE 8(REWRITE_RULE[UNION]); REWR 8; TYPE_THEN `R` UNABBREV_TAC; (* -A *) THM_INTRO_TAC[`B UNION C`] bounded_unbounded_union; USE 9(ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 9(REWRITE_RULE[ctop_unions;DIFF]); TSPEC `x` 9; TYPE_THEN `R = B UNION C` ABBREV_TAC ; USE 9(REWRITE_RULE[UNION]); REWR 9; TYPE_THEN `R'` UNABBREV_TAC; KILL 5; KILL 6; KILL 3; KILL 4; (* - *) THM_INTRO_TAC[`x`] point_onto; TYPE_THEN `x` UNABBREV_TAC; THM_INTRO_TAC[`p`] cell_unions; USE 3(REWRITE_RULE[UNIONS]); THM_INTRO_TAC[`B UNION C`] unbounded_even; FULL_REWRITE_TAC[psegment_triple]; REWR 9; KILL 5; THM_INTRO_TAC[`par_cell T (B UNION C)`;`u`;`point p`] cell_ununion; REWRITE_TAC[par_cell_cell]; KILL 6; (* - *) THM_INTRO_TAC[`A UNION B`] unbounded_even; FULL_REWRITE_TAC[psegment_triple]; REWR 8; KILL 6; THM_INTRO_TAC[`par_cell T (A UNION B)`;`u`;`point p`] cell_ununion; REWRITE_TAC[par_cell_cell]; KILL 8; (* - *) TYPE_THEN `unbounded_set (A UNION B UNION C) (point p)` ASM_CASES_TAC; THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[]; (* -B *) TYPE_THEN `~unbounded_set (B UNION C UNION A) (point p)` SUBAGOAL_TAC; FULL_REWRITE_TAC[UNION_ACI]; ASM_MESON_TAC[]; UND 9 THEN REWRITE_TAC[]; IMATCH_MP_TAC unbounded_triple_avoidance; CONJ_TAC; IMATCH_MP_TAC psegment_triple3; (* - *) FULL_REWRITE_TAC[UNION_ACI]; KILL 8; KILL 2; THM_INTRO_TAC[`A UNION C`] unbounded_even; FULL_REWRITE_TAC[psegment_triple]; REWRITE_TAC[UNIONS]; TYPE_THEN `u` EXISTS_TAC; KILL 2; (* - *) THM_INTRO_TAC[`A UNION B`;`u`;`T`] parity_unique; IMATCH_MP_TAC rectagon_segment; FULL_REWRITE_TAC[psegment_triple]; THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique; IMATCH_MP_TAC rectagon_segment; FULL_REWRITE_TAC[psegment_triple]; (* - *) TYPE_THEN `!A B. rectagon (A UNION B) /\ par_cell T (A UNION B) u ==> ~curve_cell A u` SUBAGOAL_TAC; THM_INTRO_TAC[`A' UNION B'`;`T`] par_cell_curve_cell_disj; FULL_REWRITE_TAC[rectagon]; UND 12 THEN ASM_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `u` EXISTS_TAC; REWRITE_TAC[INTER]; THM_INTRO_TAC[`A'`;`A' UNION B'`] curve_cell_imp_subset; REWRITE_TAC[SUBSET;UNION]; ASM_MESON_TAC[subset_imp]; (* - *) TYPE_THEN `~curve_cell A u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; TYPE_THEN `B` EXISTS_TAC; FULL_REWRITE_TAC[psegment_triple;psegment;]; TYPE_THEN `~curve_cell B u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; TYPE_THEN `A` EXISTS_TAC; REWRITE_TAC[UNION_ACI]; FULL_REWRITE_TAC[psegment_triple;psegment;]; TYPE_THEN `~curve_cell C u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; TYPE_THEN `B` EXISTS_TAC; REWRITE_TAC[UNION_ACI]; FULL_REWRITE_TAC[psegment_triple;psegment;]; (* -C *) THM_INTRO_TAC[`A`;`B`;`u`] parity_union; FULL_REWRITE_TAC[psegment_triple;psegment;]; IMATCH_MP_TAC rectagon_segment; REWR 13; (* - *) THM_INTRO_TAC[`B`;`C`;`u`] parity_union; FULL_REWRITE_TAC[psegment_triple;psegment;]; IMATCH_MP_TAC rectagon_segment; REWR 14; (* - *) TYPE_THEN `parity A u = parity C u` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILL 13; KILL 14; THM_INTRO_TAC[`A`;`C`;`u`] parity_union; FULL_REWRITE_TAC[psegment_triple;psegment;]; IMATCH_MP_TAC rectagon_segment; REWR 13; TYPE_THEN `parity (A UNION C) u = T` SUBAGOAL_TAC; USE 14 SYM; IMATCH_MP_TAC parity; REWRITE_TAC[curve_cell_union]; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple;psegment;]; IMATCH_MP_TAC rectagon_segment; USE 16(REWRITE_RULE[UNION]); ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION W *) (* ------------------------------------------------------------------ *) (* back to the K3 graph *) let rectagon_graph = jordan_def `rectagon_graph G <=> graph G /\ graph_edge G SUBSET psegment /\ (!e. graph_edge G e ==> (graph_inc G e = endpoint e)) /\ (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (e INTER e' = EMPTY)) /\ (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (cls e INTER cls e' = endpoint e INTER endpoint e'))`;; let rectagonal_graph = jordan_def `rectagonal_graph (G:(A,B)graph_t) <=> (?H. rectagon_graph H /\ graph_isomorphic H G)`;; let k33_rectagon_hyp = jordan_def `k33_rectagon_hyp R f <=> rectagon R /\ (!(i:three_t) j. ~(i = j) ==> (cls (f i) INTER (cls (f j)) = EMPTY)) /\ (!i j. ~(i = j) ==> ((f i) INTER (f j) = EMPTY)) /\ (!i. ?A B. (R = A UNION B) /\ psegment_triple A B (f i) /\ (!j. ~(cls (f j) INTER cls A = EMPTY) /\ ~(cls (f j) INTER cls B = EMPTY)) /\ (!j. ~(i = j) ==> (cls (f j) INTER cls A INTER cls B = EMPTY)))`;; let k33_rectagon_two_even = prove_by_refinement( `!R f i. k33_rectagon_hyp R f /\ f i SUBSET par_cell F R ==> (!j. ~(j = i) ==> (f j SUBSET par_cell T R))`, (* {{{ proof *) [ REP_BASIC_TAC; FULL_REWRITE_TAC [k33_rectagon_hyp]; COPY 2; TSPEC `i` 2; TYPE_THEN `R` UNABBREV_TAC; (* - *) THM_INTRO_TAC[`f i`;`A`;`B`] outer_segment_even; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple3; THM_INTRO_TAC[`f i`;`B`;`A`] outer_segment_even; FULL_REWRITE_TAC[UNION_ACI]; IMATCH_MP_TAC psegment_triple2; (* - *) TSPEC `j` 7; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 7 (REWRITE_RULE[INTER]); USE 11(REWRITE_RULE[INTER]); (* -A *) THM_INTRO_TAC[`f i UNION A`;`B`;`f j`;`u`;`T`] meeting_lemma; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; CONJ_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` UNABBREV_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; TSPEC `j` 6; REWRITE_TAC[GSYM SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC; CONJ_TAC; USE 42 SYM; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET;UNION]; REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[cls_union]; (* -- *) TSPEC `j` 2; REWR 2; USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u` 2; REWR 2; COPY 4; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); TYPE_THEN `i` UNABBREV_TAC; USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); TSPEC `u` 4; REWR 4; (* -- *) TYPE_THEN `B SUBSET edge` SUBAGOAL_TAC; USE 8 (REWRITE_RULE[psegment_triple]); USE 26(REWRITE_RULE[psegment;segment]); (* -- *) TYPE_THEN `segment (f j)` SUBAGOAL_TAC; TSPEC `j` 6; USE 17 (REWRITE_RULE[psegment_triple]); FULL_REWRITE_TAC[psegment]; (* -- *) IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; USE 17 (REWRITE_RULE[UNION]); REWR 17; (* -- *) ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; CONJ_TAC; UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); TYPE_THEN `j` UNABBREV_TAC; (* -- *) TSPEC `j` 6; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; USE 19 SYM; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;UNION]; USE 18(REWRITE_RULE[psegment_triple]); REWRITE_TAC[cls_union;UNION_OVER_INTER]; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[INTER_COMM]; TYPE_THEN `endpoint (f j)` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; (* -B *) THM_INTRO_TAC[`f i UNION B`;`A`;`f j`;`u'`;`T`] meeting_lemma; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; CONJ_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` UNABBREV_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; TSPEC `j` 6; REWRITE_TAC[GSYM SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC; CONJ_TAC; USE 43 SYM; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET;UNION]; REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[cls_union]; (* -- *) TSPEC `j` 2; REWR 2; USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u'` 2; REWR 2; COPY 4; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); TYPE_THEN `i` UNABBREV_TAC; USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); TSPEC `u'` 4; REWR 4; (* -- *) TYPE_THEN `A SUBSET edge` SUBAGOAL_TAC; USE 8 (REWRITE_RULE[psegment_triple]); USE 28(REWRITE_RULE[psegment;segment]); (* -- *) TYPE_THEN `segment (f j)` SUBAGOAL_TAC; TSPEC `j` 6; USE 18 (REWRITE_RULE[psegment_triple]); FULL_REWRITE_TAC[psegment]; (* -- *) IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; USE 18 (REWRITE_RULE[UNION]); REWR 18; (* -- *) ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; CONJ_TAC; UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); TYPE_THEN `j` UNABBREV_TAC; (* -- *) TSPEC `j` 6; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; USE 20 SYM; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;UNION]; USE 19(REWRITE_RULE[psegment_triple]); REWRITE_TAC[cls_union;UNION_OVER_INTER]; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[INTER_COMM]; TYPE_THEN `endpoint (f j)` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; (* -C *) IMATCH_MP_TAC par_cell_even_imp; TYPE_THEN `f i` EXISTS_TAC; FULL_REWRITE_TAC[UNION_ACI]; CONJ_TAC; TSPEC `j` 6; USE 17 (REWRITE_RULE [psegment_triple]); USE 29(REWRITE_RULE[psegment]); (* - *) CONJ_TAC; TSPEC `j` 6; FULL_REWRITE_TAC[psegment_triple]; REWRITE_TAC[cls_union ;]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[INTER_COMM]; TYPE_THEN `endpoint A'` UNABBREV_TAC; TYPE_THEN `endpoint B'` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); TYPE_THEN `j` UNABBREV_TAC; (* - *) TSPEC `j` 6; UND 17 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC)); TYPE_THEN `!C. C SUBSET (A' UNION B') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; FULL_REWRITE_TAC[SUBSET;UNION ]; ASM_MESON_TAC[]; USE 1 SYM; CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION]; ]);; (* }}} *) let psegment_triple_odd_even = prove_by_refinement( `!A B C. psegment_triple A B C /\ C SUBSET par_cell T (A UNION B) ==> (?A' B'. psegment_triple A' B' C /\ C SUBSET par_cell T (A' UNION B') /\ A' SUBSET par_cell F (B' UNION C) /\ B' SUBSET par_cell T (A' UNION C) /\ (A UNION B = A' UNION B') /\ (cls A INTER cls B = cls A' INTER cls B') /\ (!P. (P A /\ P B ) ==> P A' /\ P B'))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `A SUBSET par_cell F (B UNION C)` ASM_CASES_TAC; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC outer_segment_even; FULL_REWRITE_TAC[UNION_COMM]; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple2; THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell; UND 3 THEN REP_CASES_TAC; ASM_MESON_TAC[]; TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `A` EXISTS_TAC; FULL_REWRITE_TAC[UNION_COMM;INTER_COMM;]; CONJ_TAC; IMATCH_MP_TAC psegment_triple3; IMATCH_MP_TAC psegment_triple2; IMATCH_MP_TAC outer_segment_even; FULL_REWRITE_TAC[UNION_COMM]; IMATCH_MP_TAC psegment_triple3; (* - *) TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; TYPE_THEN `C` UNABBREV_TAC; USE 15 (REWRITE_RULE[psegment;segment]); (* - *) FULL_REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let k33_rectagon_two_odd = prove_by_refinement( `!R f i. k33_rectagon_hyp R f /\ f i SUBSET par_cell T R ==> (!j. ~(j = i) ==> (f j SUBSET par_cell F R))`, (* {{{ proof *) [ REP_BASIC_TAC; FULL_REWRITE_TAC [k33_rectagon_hyp]; COPY 2; TSPEC `i` 2; TYPE_THEN `R` UNABBREV_TAC; (* - *) THM_INTRO_TAC[`A`;`B`;`f i`] psegment_triple_odd_even; TYPE_THEN `A UNION B` UNABBREV_TAC; TYPE_THEN `cls A INTER cls B` UNABBREV_TAC; TYPE_THEN `!j. ~(cls (f j) INTER cls A' = {}) /\ ~(cls (f j) INTER cls B' = {})` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; KILL 7; (* 7 -> 10 *) KILL 9; KILL 8; (* - *) TSPEC `j` 10; FULL_REWRITE_TAC[EMPTY_EXISTS]; USE 7 (REWRITE_RULE[INTER]); USE 8(REWRITE_RULE[INTER]); (* -A *) THM_INTRO_TAC[`f i UNION A'`;`B'`;`f j`;`u`;`T`] meeting_lemma; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[UNION_COMM]; CONJ_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` UNABBREV_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; TSPEC `j` 6; FULL_REWRITE_TAC[UNION_COMM]; REWRITE_TAC[GSYM SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC; CONJ_TAC; USE 43 SYM; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET;UNION]; REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[cls_union]; (* -- *) TSPEC `j` 2; REWR 2; USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u` 2; REWR 2; COPY 4; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); TYPE_THEN `i` UNABBREV_TAC; USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); TSPEC `u` 4; REWR 4; (* -- *) TYPE_THEN `B' SUBSET edge` SUBAGOAL_TAC; USE 15 (REWRITE_RULE[psegment_triple]); USE 27(REWRITE_RULE[psegment;segment]); (* -- *) TYPE_THEN `segment (f j)` SUBAGOAL_TAC; TSPEC `j` 6; USE 18 (REWRITE_RULE[psegment_triple]); FULL_REWRITE_TAC[psegment]; (* -- *) IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; USE 18 (REWRITE_RULE[UNION]); REWR 18; (* -- *) ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); TYPE_THEN `j` UNABBREV_TAC; (* -- *) TSPEC `j` 6; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; USE 20 SYM; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;UNION]; USE 19(REWRITE_RULE[psegment_triple]); REWRITE_TAC[cls_union;UNION_OVER_INTER]; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[INTER_COMM]; TYPE_THEN `endpoint (f j)` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; (* -B *) THM_INTRO_TAC[`f i UNION B'`;`A'`;`f j`;`u'`;`F`] meeting_lemma; CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[UNION_COMM]; CONJ_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` UNABBREV_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[UNION_COMM]; TSPEC `j` 6; REWRITE_TAC[GSYM SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC; CONJ_TAC; USE 44 SYM; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET;UNION]; REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[cls_union]; (* -- *) TSPEC `j` 2; REWR 2; USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u'` 2; REWR 2; COPY 4; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); TYPE_THEN `i` UNABBREV_TAC; USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); TSPEC `u'` 4; REWR 4; (* -- *) TYPE_THEN `A' SUBSET edge` SUBAGOAL_TAC; USE 15 (REWRITE_RULE[psegment_triple]); USE 29(REWRITE_RULE[psegment;segment]); (* -- *) TYPE_THEN `segment (f j)` SUBAGOAL_TAC; TSPEC `j` 6; USE 19 (REWRITE_RULE[psegment_triple]); FULL_REWRITE_TAC[psegment]; (* -- *) IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; USE 19 (REWRITE_RULE[UNION]); REWR 19; (* -- *) ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; UND 16 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); TYPE_THEN `j` UNABBREV_TAC; (* -- *) TSPEC `j` 6; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; REWRITE_TAC[SUBSET_REFL]; USE 21 SYM; IMATCH_MP_TAC cls_subset; REWRITE_TAC[SUBSET;UNION]; USE 20(REWRITE_RULE[psegment_triple]); REWRITE_TAC[cls_union;UNION_OVER_INTER]; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[INTER_COMM]; TYPE_THEN `endpoint (f j)` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; (* -C *) IMATCH_MP_TAC par_cell_odd_imp; TYPE_THEN `f i` EXISTS_TAC; FULL_REWRITE_TAC[UNION_ACI]; CONJ_TAC; TSPEC `j` 6; USE 18 (REWRITE_RULE [psegment_triple]); USE 30(REWRITE_RULE[psegment]); (* - *) CONJ_TAC; TSPEC `j` 6; FULL_REWRITE_TAC[psegment_triple]; REWRITE_TAC[cls_union ;]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; FULL_REWRITE_TAC[INTER_COMM]; TYPE_THEN `endpoint A''` UNABBREV_TAC; TYPE_THEN `endpoint B''` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); TYPE_THEN `j` UNABBREV_TAC; (* - *) TSPEC `j` 6; UND 19 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC)); TYPE_THEN `!C. C SUBSET (A'' UNION B'') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[psegment_triple]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; FULL_REWRITE_TAC[SUBSET;UNION ]; ASM_MESON_TAC[]; USE 0 SYM; CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION]; ]);; (* }}} *) let ABS3_012 = prove_by_refinement( `(REP3 (ABS3 0) = 0) /\ (REP3(ABS3 1) = 1) /\ (REP3(ABS3 2) = 2)`, (* {{{ proof *) [ ASSUME_TAC three_t; USE 0(ONCE_REWRITE_RULE[EQ_SYM_EQ]); ARITH_TAC; ]);; (* }}} *) let three_t_not_sing = prove_by_refinement( `!i. ?(j:three_t). ~(i = j)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `i = ABS3 0` ASM_CASES_TAC; TYPE_THEN `ABS3 1` EXISTS_TAC; USE 1(AP_TERM `REP3`); FULL_REWRITE_TAC[ABS3_012]; UND 1 THEN ARITH_TAC; TYPE_THEN `ABS3 0` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let ABS3_onto = prove_by_refinement( `!(i:three_t). ?j. (i = ABS3 j) /\ (j < 3)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `REP3 i` EXISTS_TAC; REWRITE_TAC[BETA_RULE three_t]; ]);; (* }}} *) let three_t_eq = prove_by_refinement( `!i j. (i = j) <=> (REP3 i = REP3 j)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_ANTISYM; DISCH_TAC; USE 0(AP_TERM `ABS3`); FULL_REWRITE_TAC[three_t]; ]);; (* }}} *) let rep3_lt = prove_by_refinement( `!i. (REP3 i < 3)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[BETA_RULE three_t]; ]);; (* }}} *) let three_t_not_pair = prove_by_refinement( `!i j. ?(k:three_t). ~(k = i) /\ ~(k = j)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[three_t_eq]; TYPE_THEN `?k'. (k' < 3) /\ ~(k' = REP3 i) /\ ~(k' = REP3 j)` SUBAGOAL_TAC; TYPE_THEN ` ~(0 = REP3 i) /\ ~(0 = REP3 j)` ASM_CASES_TAC; ASM_MESON_TAC[ARITH_RULE `0 < 3`]; TYPE_THEN ` ~(1 = REP3 i) /\ ~(1 = REP3 j)` ASM_CASES_TAC; ASM_MESON_TAC[ARITH_RULE `1 < 3`]; TYPE_THEN ` ~(2 = REP3 i) /\ ~(2 = REP3 j)` ASM_CASES_TAC; ASM_MESON_TAC[ARITH_RULE `2 < 3`]; FULL_REWRITE_TAC[DE_MORGAN_THM]; PROOF_BY_CONTR_TAC; UND 0 THEN UND 1 THEN UND 2 THEN ARITH_TAC; TYPE_THEN` ABS3 k'` EXISTS_TAC; ASM_MESON_TAC [BETA_RULE three_t]; ]);; (* }}} *) let bool_size = prove_by_refinement( `(UNIV:bool->bool) HAS_SIZE 2`, (* {{{ proof *) [ REWRITE_TAC[has_size_bij2]; TYPE_THEN `\ u. if u then 0 else 1` EXISTS_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; COND_CASES_TAC THEN ARITH_TAC ; UND 0 THEN COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[ARITH_RULE `~(0 =1) /\ ~(1 = 0)`]; FULL_REWRITE_TAC[SURJ;INJ]; REP_BASIC_TAC; USE 2 (REWRITE_RULE[ARITH_RULE `x <| 2 <=> (x = 0)\/ (x = 1)`]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `T` EXISTS_TAC; TYPE_THEN `F` EXISTS_TAC; ]);; (* }}} *) let three_delete_size = prove_by_refinement( `!(i:three_t). (UNIV DELETE i) HAS_SIZE 2`, (* {{{ proof *) [ REWRITE_TAC[HAS_SIZE;FINITE_DELETE]; THM_INTRO_TAC[] thr_finite; FULL_REWRITE_TAC[HAS_SIZE]; IMATCH_MP_TAC (ARITH_RULE `(SUC x = 3) ==> (x = 2)`); USE 0 SYM; IMATCH_MP_TAC CARD_SUC_DELETE; ASM_REWRITE_TAC[]; ]);; (* }}} *) let has_size_bij_set = prove_by_refinement( `!(A:A->bool) (B:B->bool) n. A HAS_SIZE n /\ B HAS_SIZE n ==> (?f. BIJ f A B)`, (* {{{ proof *) [ REP_BASIC_TAC; USE 0(REWRITE_RULE [has_size_bij]); USE 1(REWRITE_RULE[has_size_bij2]); TYPE_THEN `compose f f'` EXISTS_TAC; IMATCH_MP_TAC COMP_BIJ; UNIFY_EXISTS_TAC; ]);; (* }}} *) let bool_three_delete_bij = prove_by_refinement( `!i. ?b. BIJ b (UNIV:bool->bool) ((UNIV:three_t->bool) DELETE i)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC has_size_bij_set; TYPE_THEN`2` EXISTS_TAC; REWRITE_TAC[bool_size;three_delete_size]; ]);; (* }}} *) let k33_rectagon_hyp_odd_exist = prove_by_refinement( `!R f. k33_rectagon_hyp R f ==> (?i. (f i SUBSET par_cell F R))`, (* {{{ proof *) [ REWRITE_TAC[k33_rectagon_hyp]; TYPE_THEN `j = ABS3 0` ABBREV_TAC ; TYPE_THEN `f j SUBSET par_cell F R` ASM_CASES_TAC; ASM_MESON_TAC[]; TYPE_THEN `k = ABS3 1` ABBREV_TAC ; TYPE_THEN `k` EXISTS_TAC; THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd; CONJ_TAC; ASM_REWRITE_TAC[k33_rectagon_hyp]; THM_INTRO_TAC[`R`;`f j`] segment_in_comp; TSPEC `j` 0; USE 8 (REWRITE_RULE[psegment_triple]); CONJ_TAC; USE 20(REWRITE_RULE[psegment]); REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; FULL_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[cls_union]; REWRITE_TAC[UNION_OVER_INTER;union_subset]; FULL_REWRITE_TAC[INTER_COMM]; TYPE_THEN `endpoint (f j)` UNABBREV_TAC; REWRITE_TAC[SUBSET_REFL]; TYPE_THEN `eps = F` ASM_CASES_TAC; REWR 7; TYPE_THEN `eps = T` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; (* - *) TSPEC `k` 7; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` UNABBREV_TAC; TYPE_THEN `k` UNABBREV_TAC; USE 4 (AP_TERM `REP3`); FULL_REWRITE_TAC[ABS3_012]; UND 4 THEN ARITH_TAC; ]);; (* }}} *) let k33_rectagon_hyp_false = prove_by_refinement( `!R f. ~k33_rectagon_hyp R f`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`R`;`f`] k33_rectagon_hyp_odd_exist; THM_INTRO_TAC[`R`;`f`;`i`] k33_rectagon_two_even; THM_INTRO_TAC[`i`] three_t_not_sing; COPY 2; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`j`]); TYPE_THEN `j` UNABBREV_TAC; (* - *) THM_INTRO_TAC[`i`;`j`] three_t_not_pair; TSPEC `k` 2; THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd; TSPEC `k` 7; TYPE_THEN `~(f k = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[k33_rectagon_hyp]; TSPEC `k` 0; FULL_REWRITE_TAC[psegment_triple]; USE 25(REWRITE_RULE[psegment;segment]); TYPE_THEN `f k` UNABBREV_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; FULL_REWRITE_TAC[EQ_EMPTY;INTER ]; FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) let k33_graph_edge = prove_by_refinement( `graph_edge (k33_graph) = cartesian UNIV UNIV`, (* {{{ proof *) [ REWRITE_TAC[k33_graph;graph_edge_mk_graph]; ]);; (* }}} *) let k33_graph_vertex = prove_by_refinement( `graph_vertex (k33_graph) = cartesian UNIV UNIV`, (* {{{ proof *) [ REWRITE_TAC[k33_graph;graph_vertex_mk_graph]; ]);; (* }}} *) let k33_graph_inc = prove_by_refinement( `!e v. graph_inc (k33_graph) e v <=> (v = (FST e,T)) \/ (v = (SND e,F))`, (* {{{ proof *) [ REWRITE_TAC[k33_graph;graph_inc_mk_graph;INR in_pair ]; MESON_TAC[]; ]);; (* }}} *) let cartesian_univ = prove_by_refinement( `!x. cartesian (UNIV:A->bool) (UNIV:B->bool) x`, (* {{{ proof *) [ REWRITE_TAC[cartesian;PAIR_SPLIT]; MESON_TAC[]; ]);; (* }}} *) let rectagonal_graph_k33 = prove_by_refinement( `rectagonal_graph k33_graph <=> (?f uA uB. INJ uA UNIV UNIV /\ INJ uB UNIV UNIV /\ (!(i:three_t#three_t). segment_end (f i) (uA (FST i)) (uB (SND i))) /\ (!i j. ~(f i INTER f j = EMPTY) ==> (i = j)) /\ (!i j. ~(i = j) ==> (cls (f i) INTER cls (f j) = endpoint (f i) INTER endpoint (f j)))) `, (* {{{ proof *) [ REWRITE_TAC[rectagonal_graph]; IMATCH_MP_TAC EQ_ANTISYM; (* - *) CONJ_TAC; THM_INTRO_TAC[`H`;`k33_graph`] graph_isomorphic_symm; FULL_REWRITE_TAC[rectagon_graph]; KILL 0; FULL_REWRITE_TAC [graph_isomorphic;graph_iso]; FULL_REWRITE_TAC[rectagon_graph]; FULL_REWRITE_TAC[k33_graph_edge;k33_graph_vertex;k33_graph_inc]; KILL 4; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `uA = (\ i. u (i,T))` ABBREV_TAC ; TYPE_THEN `uB = (\ i. u (i,F))` ABBREV_TAC ; TYPE_THEN `uA` EXISTS_TAC; TYPE_THEN `uB` EXISTS_TAC; (* -- *) CONJ_TAC; REWRITE_TAC[INJ]; TYPE_THEN `uA` UNABBREV_TAC; USE 3(REWRITE_RULE[BIJ;INJ]); TYPE_THEN`(x,T) = (y,T)` BACK_TAC; USE 12 (REWRITE_RULE[PAIR_SPLIT]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[cartesian_univ]; (* -- *) CONJ_TAC; REWRITE_TAC[INJ]; TYPE_THEN `uB` UNABBREV_TAC; USE 3(REWRITE_RULE[BIJ;INJ]); TYPE_THEN`(x,F) = (y,F)` BACK_TAC; USE 12 (REWRITE_RULE[PAIR_SPLIT]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[cartesian_univ]; (* --A *) TYPE_THEN `!i. graph_edge H (v i)` SUBAGOAL_TAC; FULL_REWRITE_TAC[BIJ;SURJ]; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[cartesian_univ]; FULL_REWRITE_TAC[cartesian_univ]; (* -- *) SUBCONJ_TAC; REWRITE_TAC[segment_end]; CONJ_TAC; USE 7(REWRITE_RULE[SUBSET]); USE 6 GSYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE;k33_graph_inc;INR in_pair]; TYPE_THEN `uA` UNABBREV_TAC; TYPE_THEN `uB` UNABBREV_TAC; NAME_CONFLICT_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `(SND i,F)` EXISTS_TAC; TYPE_THEN `(FST i,T)` EXISTS_TAC; (* --B *) CONJ_TAC; PROOF_BY_CONTR_TAC; UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`v i`;`v j`]); PROOF_BY_CONTR_TAC; UND 13 THEN REWRITE_TAC[]; USE 2 (REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[cartesian_univ]; ASM_MESON_TAC[]; (* -- *) FIRST_ASSUM IMATCH_MP_TAC ; DISCH_TAC; UND 12 THEN REWRITE_TAC[]; USE 2 (REWRITE_RULE[BIJ;INJ]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[cartesian_univ]; (* -C *) TYPE_THEN `?H. rectagon_graph H /\ graph_isomorphic k33_graph H` BACK_TAC; TYPE_THEN `H` EXISTS_TAC; IMATCH_MP_TAC graph_isomorphic_symm; REWRITE_TAC[k33_isgraph]; REWRITE_TAC[rectagon_graph;graph_isomorphic;graph_iso]; REWRITE_TAC[k33_graph_vertex;k33_graph_edge]; TYPE_THEN `H = mk_graph_t (IMAGE uA UNIV UNION IMAGE uB UNIV ,IMAGE f (cartesian UNIV UNIV), endpoint)` ABBREV_TAC ; TYPE_THEN `H` EXISTS_TAC; TYPE_THEN `graph_edge H = IMAGE f (cartesian UNIV UNIV)` SUBAGOAL_TAC; TYPE_THEN `H` UNABBREV_TAC; REWRITE_TAC[graph_edge_mk_graph]; TYPE_THEN `graph_vertex H = IMAGE uA UNIV UNION IMAGE uB UNIV ` SUBAGOAL_TAC; TYPE_THEN `H` UNABBREV_TAC; REWRITE_TAC[graph_vertex_mk_graph]; TYPE_THEN `graph_inc H = endpoint` SUBAGOAL_TAC; TYPE_THEN `H` UNABBREV_TAC; REWRITE_TAC[graph_inc_mk_graph]; (* - *) REWRITE_TAC[GSYM CONJ_ASSOC]; CONJ_TAC; REWRITE_TAC[graph]; REWRITE_TAC[SUBSET]; NAME_CONFLICT_TAC; REWRITE_TAC[UNION]; USE 9(REWRITE_RULE[IMAGE]); TYPE_THEN `x'` UNABBREV_TAC; CONJ_TAC; TSPEC `x''` 2; USE 2(REWRITE_RULE[segment_end]); REWR 10; USE 10 (REWRITE_RULE[INR in_pair]); FIRST_ASSUM DISJ_CASES_TAC; REWRITE_TAC[IMAGE]; MESON_TAC[]; REWRITE_TAC[IMAGE]; MESON_TAC[]; IMATCH_MP_TAC endpoint_size2; TSPEC `x''` 2; USE 2(REWRITE_RULE[segment_end]); (* -D *) CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET;cartesian_univ]; USE 2(REWRITE_RULE[segment_end]); (* - *) KILL 5; KILL 6; KILL 7; KILL 8; CONJ_TAC; FULL_REWRITE_TAC[IMAGE;cartesian_univ]; PROOF_BY_CONTR_TAC; UND 5 THEN REWRITE_TAC[]; AP_TERM_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; (* - *) CONJ_TAC; FULL_REWRITE_TAC[IMAGE;cartesian_univ]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `e'` UNABBREV_TAC; ASM_MESON_TAC[]; LEFT_TAC "u"; TYPE_THEN `u = (\ x. (if (SND x) then (uA (FST x)) else uB(FST x)))` ABBREV_TAC ; TYPE_THEN `u` EXISTS_TAC; LEFT_TAC "v"; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `(u,f)` EXISTS_TAC; (* -E *) TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC; TSPEC `(i,j)` 2; USE 2(MATCH_MP segment_end_disj); UND 2 THEN ASM_REWRITE_TAC[]; (* - *) SUBCONJ_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ;cartesian_univ]; CONJ_TAC; TYPE_THEN `u` UNABBREV_TAC; COND_CASES_TAC; REWRITE_TAC[IMAGE;UNION]; MESON_TAC[]; REWRITE_TAC[IMAGE;UNION]; MESON_TAC[]; REWRITE_TAC[PAIR_SPLIT]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; (* ---// *) TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `!x y. (uA (x) = uA (y)) ==> (x = y)` SUBAGOAL_TAC; USE 4 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `!x y. (uB (x) = uB (y)) ==> (x = y)` SUBAGOAL_TAC; USE 3 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 8 THEN REWRITE_TAC[DE_MORGAN_THM]; KILL 0 THEN KILL 1 THEN KILL 2; UND 7 THEN COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[]; (* -- *) REWRITE_TAC[SURJ]; CONJ_TAC; USE 7(REWRITE_RULE[INJ]); REWRITE_TAC[cartesian_univ]; TYPE_THEN `u` UNABBREV_TAC; USE 8 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; USE 8(REWRITE_RULE[IMAGE]); TYPE_THEN `(x',T)` EXISTS_TAC; USE 8(REWRITE_RULE[IMAGE]); TYPE_THEN `(x',F)` EXISTS_TAC; (* -F *) CONJ_TAC; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `f x` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_IDEMPOT]; TSPEC `y` 2; FULL_REWRITE_TAC[segment_end;psegment;segment]; ASM_MESON_TAC[]; (* - *) TSPEC `e` 2; FULL_REWRITE_TAC[segment_end]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR in_pair;IMAGE;k33_graph_inc]; NAME_CONFLICT_TAC; THM_INTRO_TAC[`u`;`cartesian (UNIV:three_t->bool) (UNIV:bool->bool)`;`(IMAGE uA UNIV UNION IMAGE uB UNIV)`] bij_imp_image; USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USE 10 (REWRITE_RULE[IMAGE ;cartesian_univ;UNION]); USE 10 (CONV_RULE (NAME_CONFLICT_CONV)); IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; TSPEC `uB (SND e)` 10; USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (c ==> a)`)); UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]); MESON_TAC[]; TYPE_THEN`(SND e,F)` EXISTS_TAC; TYPE_THEN `u x'` UNABBREV_TAC; TYPE_THEN `u` UNABBREV_TAC; (* -- *) TYPE_THEN `x` UNABBREV_TAC; TSPEC `uA (FST e)` 10; USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (b ==> a)`)); UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]); MESON_TAC[]; TYPE_THEN`(FST e,T)` EXISTS_TAC; TYPE_THEN `u x'` UNABBREV_TAC; TYPE_THEN `u` UNABBREV_TAC; (* - *) FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `u` UNABBREV_TAC; ]);; (* }}} *) let eq_exchange = prove_by_refinement( `!x a (b:A). (x = a) /\ (x = b) <=> (x = a) /\ (a = b)`, (* {{{ proof *) [ REP_BASIC_TAC; MESON_TAC[]; ]);; (* }}} *) let rectagon_graph_k33_false = prove_by_refinement( `~(rectagonal_graph k33_graph)`, (* {{{ proof *) [ DISCH_TAC; FULL_REWRITE_TAC[rectagonal_graph_k33]; ASSUME_TAC k33_rectagon_hyp_false; LEFT 5 "f"; TYPE_THEN `diag = (\ (i:three_t). f (i,i))` ABBREV_TAC ; TYPE_THEN `!i. diag i = f(i,i)` SUBAGOAL_TAC; TYPE_THEN `diag` UNABBREV_TAC; KILL 6; TSPEC `diag` 5; RIGHT 5 "R"; UND 5 THEN REWRITE_TAC[]; REWRITE_TAC[k33_rectagon_hyp]; TYPE_THEN `R = UNIONS { e | (?i j. ~(i = j) /\ (e = f (i,j)) ) }` ABBREV_TAC ; TYPE_THEN `R` EXISTS_TAC; (* - *) TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC; TSPEC `i,j` 2; USE 2(MATCH_MP segment_end_disj); REWR 2; (* - *) TYPE_THEN `!i j. (uA i = uA j) <=> (i = j)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_ANTISYM ; USE 4 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; (* - *) TYPE_THEN `!i j. (uB i = uB j) <=> (i = j)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_ANTISYM ; USE 3 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; (* -A *) TYPE_THEN `(!i j. ~(i = j) ==> (cls (f (i,i)) INTER cls (f (j,j)) = {}))` SUBAGOAL_TAC; UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(i,i)`;`j,j`]); USE 0 (REWRITE_RULE[PAIR_SPLIT]); ASM_MESON_TAC[]; COPY 2; TSPEC `i,i` 11; TSPEC `j,j` 2; FULL_REWRITE_TAC[segment_end]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR in_pair]; FIRST_ASSUM DISJ_CASES_TAC THEN (TYPE_THEN `x` UNABBREV_TAC); REWR 15; REWR 15; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(!i j. ~(i = j) ==> (f (i,i) INTER f (j,j) = {}))` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; UND 11 THEN ASM_REWRITE_TAC[]; TYPE_THEN `(i,i) = (j,j)` BACK_TAC; USE 11(REWRITE_RULE[PAIR_SPLIT]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; LEFT_TAC "i"; (* -B start main reduction *) TYPE_THEN `?A. (cls (A T) INTER cls (A F) SUBSET endpoint (f (i,i))) /\ (A T INTER A F = EMPTY ) /\ (A T UNION A F = R) /\ (!eps. psegment (A eps)) /\ (!j eps. ~(cls (f (j,j)) INTER cls (A eps) = EMPTY)) /\ (!eps. A eps INTER (f (i,i)) = EMPTY) /\ (!eps. endpoint (A eps) = endpoint (f(i,i))) /\ (!eps. (cls (A eps) INTER cls (f(i,i)) = endpoint (f(i,i))))` BACK_TAC; LEFT_TAC "A"; LEFT_TAC "B"; TYPE_THEN `A T` EXISTS_TAC; TYPE_THEN `A F` EXISTS_TAC; TYPE_THEN `(!j. ~(i = j) ==> (cls (f (j,j)) INTER cls (A T) INTER cls (A F) = {}))` SUBAGOAL_TAC; REWRITE_TAC[GSYM SUBSET_EMPTY]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `cls (f (j,j)) INTER cls(f (i,i))` EXISTS_TAC; REWRITE_TAC[SUBSET_EMPTY]; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; ASM_REWRITE_TAC[SUBSET_REFL]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `endpoint (f (i,i))` EXISTS_TAC; IMATCH_MP_TAC endpoint_cls; USE 2(REWRITE_RULE[segment_end;psegment;segment]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* -- *) IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); SUBCONJ_TAC; ASM_REWRITE_TAC[psegment_triple]; TYPE_THEN `cls (A T) INTER cls (A F) = endpoint (f (i,i))` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM ; COPY 13; TSPEC `T` 21; TSPEC `F` 13; REWRITE_TAC[SUBSET_INTER]; TYPE_THEN `FINITE (f(i,i))` SUBAGOAL_TAC; USE 2 (REWRITE_RULE[segment_end;psegment;segment]); CONJ_TAC; USE 21 SYM; IMATCH_MP_TAC endpoint_cls; USE 16(REWRITE_RULE[psegment;segment]); USE 13 SYM; IMATCH_MP_TAC endpoint_cls; USE 16(REWRITE_RULE[psegment;segment]); SUBCONJ_TAC; FULL_REWRITE_TAC[segment_end]; (* ---C *) TYPE_THEN `endpoint (f (i,i)) = {(uA (i)), (uB(i))}` SUBAGOAL_TAC; USE 2 (REWRITE_RULE[segment_end]); CONJ_TAC; TYPE_THEN `R` UNABBREV_TAC; USE 5 SYM; IMATCH_MP_TAC segment_end_union_rectagon; TYPE_THEN `uA i` EXISTS_TAC; TYPE_THEN `uB i` EXISTS_TAC; ASM_REWRITE_TAC[segment_end]; (* --- *) CONJ_TAC THEN IMATCH_MP_TAC segment_end_union_rectagon THEN TYPE_THEN `uA i` EXISTS_TAC THEN TYPE_THEN `uB i` EXISTS_TAC THEN ASM_REWRITE_TAC[segment_end]; (* -- *) FULL_REWRITE_TAC[psegment_triple]; KILL 5; TYPE_THEN `R` UNABBREV_TAC; (* -D *) THM_INTRO_TAC[`i`] bool_three_delete_bij; TYPE_THEN `!e. ~(b e = i)` SUBAGOAL_TAC; USE 12(REWRITE_RULE[BIJ;SURJ;DELETE ]); ASM_MESON_TAC[]; TYPE_THEN `!e e'. (b e = b e') <=> (e = e')` SUBAGOAL_TAC; USE 12 (REWRITE_RULE[BIJ;INJ]); IMATCH_MP_TAC EQ_ANTISYM; ASM_REWRITE_TAC[]; TYPE_THEN `!j. ~(j = i) ==> (?e. (j = b e))` SUBAGOAL_TAC; USE 12(REWRITE_RULE[BIJ;SURJ]); USE 12 (GSYM); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[DELETE]; TYPE_THEN `j` UNABBREV_TAC; (* - *) TYPE_THEN `A = (\ (e: bool). f(i, b e) UNION f (b (~e),b e) UNION f (b(~e),i))` ABBREV_TAC ; TYPE_THEN `A` EXISTS_TAC; (* - now satisfy constraints *) TYPE_THEN `(!eps. A eps INTER f (i,i) = {})` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; REPEAT CONJ_TAC THEN PROOF_BY_CONTR_TAC THEN (UND 1 THEN DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT] o (TRY_RULE (MATCH_MP t))))) THEN ASM_MESON_TAC[]; (* -E *) TYPE_THEN `(!eps. cls (A eps) INTER cls (f (i,i)) = endpoint (f (i,i)))` SUBAGOAL_TAC ; TYPE_THEN `A` UNABBREV_TAC; ONCE_REWRITE_TAC[INTER_COMM]; FULL_REWRITE_TAC[UNION_OVER_INTER;cls_union]; COPY 0; UND 0 THEN DISCH_THEN( THM_INTRO_TAC[`(i,i)`;`(i, b eps)`]); USE 0 (REWRITE_RULE[PAIR_SPLIT]); ASM_MESON_TAC[]; COPY 16; UND 16 THEN DISCH_THEN( THM_INTRO_TAC[`(i,i)`;`(b (~eps),i)`]); USE 16 (REWRITE_RULE[PAIR_SPLIT]); ASM_MESON_TAC[]; COPY 18; UND 18 THEN DISCH_THEN( THM_INTRO_TAC[`(i,i)`;`(b (~eps),b eps)`]); USE 18 (REWRITE_RULE[PAIR_SPLIT]); ASM_MESON_TAC[]; REWRITE_TAC[GSYM UNION_OVER_INTER]; REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] SUBSET_INTER_ABSORPTION]; USE 2 (REWRITE_RULE[segment_end]); REWRITE_TAC[SUBSET;UNION;INR in_pair ]; FIRST_ASSUM DISJ_CASES_TAC; (* - *) TYPE_THEN `(!j eps. ~(cls (f (j,j)) INTER cls (A eps) = {}))` SUBAGOAL_TAC; TYPE_THEN `j = i` ASM_CASES_TAC; TYPE_THEN `i` UNABBREV_TAC; USE 19 (ONCE_REWRITE_RULE[INTER_COMM]); TSPEC `eps` 18; REWR 19; TSPEC `(j,j)` 2; FULL_REWRITE_TAC[segment_end]; REWR 2; USE 2 SYM; USE 2(REWRITE_RULE[EQ_EMPTY;INR in_pair]); ASM_MESON_TAC[]; TYPE_THEN `A` UNABBREV_TAC; FULL_REWRITE_TAC[cls_union]; FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`]); TYPE_THEN `j` UNABBREV_TAC; TYPE_THEN `j` UNABBREV_TAC; TYPE_THEN `(e = eps) \/ (e = ~eps)` SUBAGOAL_TAC; MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(b eps,b eps)`;`(i,b eps)`] ); USE 0 (REWRITE_RULE[PAIR_SPLIT]); TYPE_THEN `i` UNABBREV_TAC; REWR 21; UND 21 THEN REWRITE_TAC[EMPTY_EXISTS ]; REWRITE_TAC[INTER]; FULL_REWRITE_TAC[segment_end;INR in_pair]; FULL_REWRITE_TAC[segment_end;INR in_pair]; TYPE_THEN `uB (b eps)` EXISTS_TAC; (* -- *) TYPE_THEN `e` UNABBREV_TAC; UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(b (~eps),b (~eps))`;`(b (~eps),i)`] ); USE 0 (REWRITE_RULE[PAIR_SPLIT]); TYPE_THEN `i` UNABBREV_TAC; REWR 16; UND 16 THEN REWRITE_TAC[EMPTY_EXISTS ]; REWRITE_TAC[INTER]; FULL_REWRITE_TAC[segment_end;INR in_pair]; FULL_REWRITE_TAC[segment_end;INR in_pair]; TYPE_THEN `uA (b (~eps))` EXISTS_TAC; (* -F *) TYPE_THEN `A T INTER A F = EMPTY ` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[UNION_OVER_INTER]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[EMPTY_UNION]; TYPE_THEN `!i j. (f i INTER f j = EMPTY) <=> ~( i = j)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `i'` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_IDEMPOT]; TSPEC `j` 2; TYPE_THEN `f j` UNABBREV_TAC; FULL_REWRITE_TAC[segment_end;psegment;segment]; PROOF_BY_CONTR_TAC; UND 16 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; REWRITE_TAC[PAIR_SPLIT]; (* - *) TYPE_THEN `A T UNION A F = R` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `R` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[SUBSET;UNION;UNIONS]; CONV_TAC (dropq_conv "u"); UND 5 THEN REP_CASES_TAC THEN UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET;UNION;UNIONS]; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `!i'. (i' = i) \/ (i' = b T) \/ (i' = b F)` SUBAGOAL_TAC; TYPE_THEN`i'' = i` ASM_CASES_TAC; UND 15 THEN DISCH_THEN ( THM_INTRO_TAC[`i''`]); ASM_MESON_TAC[]; TYPE_THEN `e = T` ASM_CASES_TAC; MESON_TAC[]; MESON_TAC[]; COPY 16; TSPEC `i'` 16; TSPEC `j` 22; JOIN 16 22 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; UND 16 THEN REP_CASES_TAC THEN REWR 5 ; TYPE_THEN `j` UNABBREV_TAC; TYPE_THEN `i'` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `j` UNABBREV_TAC; TYPE_THEN `i'` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `j` UNABBREV_TAC; TYPE_THEN `i'` UNABBREV_TAC; ASM_MESON_TAC[]; (* -G *) SUBCONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[cls_union]; REWRITE_TAC[UNION_OVER_INTER]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[union_subset]; USE 2(REWRITE_RULE[segment_end]); USE 0 (REWRITE_RULE[PAIR_SPLIT]); ASM_SIMP_TAC[]; REWRITE_TAC[INTER;SUBSET;INR in_pair]; REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; ONCE_REWRITE_TAC[eq_exchange]; ASM_REWRITE_TAC[]; (* -H *) KILL 21; KILL 20; KILL 17; KILL 19; KILL 18; TYPE_THEN `!eps. segment_end (A eps) (uA i) (uB i)` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; THM_INTRO_TAC[`f (b (~eps),i)`;`f (b (~eps),b eps)`;`uB i`;`uA(b (~eps))`;`uB(b eps)`] segment_end_union; CONJ_TAC; ONCE_REWRITE_TAC[segment_end_symm]; TSPEC `(b (~eps),i)` 2; REWR 2; CONJ_TAC; TSPEC `(b (~eps),b eps)` 2; REWR 2; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`(b (~eps),i)`;`(b (~eps),b eps)`]); USE 0(REWRITE_RULE[PAIR_SPLIT]); ASM_MESON_TAC[]; USE 2(REWRITE_RULE[segment_end]); IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;INR in_pair;INR IN_SING;]; REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; ONCE_REWRITE_TAC[eq_exchange]; ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[`f (i,b eps)`;`f (b (~eps),i) UNION f (b (~eps),b eps)`;`uA i`;`uB (b eps)`;`uB i`] segment_end_union; CONJ_TAC; TSPEC `(i,b eps)` 2; REWR 2; CONJ_TAC; ONCE_REWRITE_TAC[segment_end_symm]; REWRITE_TAC[cls_union]; COPY 0; UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(i,b eps)`;`b (~eps),i`]); USE 0 (REWRITE_RULE[PAIR_SPLIT]); ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; REWRITE_TAC[UNION_OVER_INTER]; UND 17 THEN DISCH_THEN ( THM_INTRO_TAC[`(i,b eps)`;`b (~eps),(b eps)`]); USE 17 (REWRITE_RULE[PAIR_SPLIT]); ASM_MESON_TAC[]; USE 2(REWRITE_RULE[segment_end]); IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;UNION;INR in_pair;INR IN_SING;]; REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; ONCE_REWRITE_TAC[eq_exchange]; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[UNION_COMM]; (* - *) USE 17(REWRITE_RULE[segment_end]); USE 2 (REWRITE_RULE[segment_end]); ]);; (* }}} *) (* --- *) (* ------------------------------------------------------------------ *) (* SECTION X *) (* ------------------------------------------------------------------ *) (* Continue from SECTION Q. 1.0.2 Rational approximation. *) (* work out homeo on graph_support_set properties *) (* apply h_translate (-- &1) o r_scale (&1/z) *) (* Let's go back and do it in a symmetric way for both cases. *) let eps_translate_def = jordan_def `eps_translate eps = if eps then h_translate else v_translate`;; let eps_translate = prove_by_refinement( `!eps r. eps_translate eps r = if eps then h_translate r else v_translate r`, (* {{{ proof *) [ REWRITE_TAC[eps_translate_def]; COND_CASES_TAC; ]);; (* }}} *) let homeomorphism_eps_translate = prove_by_refinement( `!eps r. homeomorphism (eps_translate eps r) top2 top2`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[eps_translate]; COND_CASES_TAC THEN REWRITE_TAC[h_translate_hom;v_translate_hom]; ]);; (* }}} *) let eps_hyper = jordan_def `eps_hyper eps z = if eps then hyperplane 2 e1 z else hyperplane 2 e2 z`;; let eps_hyper_translate = prove_by_refinement( `!eps r z. IMAGE (eps_translate eps r) (eps_hyper eps z) = (eps_hyper eps (z + r)) `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[eps_translate;eps_hyper]; COND_CASES_TAC THEN REWRITE_TAC[hyperplane1_h_translate;hyperplane2_v_translate]; ]);; (* }}} *) let eps_hyper_translate_perp = prove_by_refinement( `!eps r z. IMAGE (eps_translate eps r) (eps_hyper (~eps) z) = (eps_hyper (~eps) z) `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[eps_translate;eps_hyper]; COND_CASES_TAC THEN REWRITE_TAC[hyperplane2_h_translate;hyperplane1_v_translate]; ]);; (* }}} *) let eps_scale = jordan_def `eps_scale eps r = if eps then r_scale r else u_scale r`;; let eps_hyper_scale_perp = prove_by_refinement( `!eps r z. (&0 < r) ==> (IMAGE (eps_scale eps r) (eps_hyper (~eps) z) = (eps_hyper (~eps) z)) `, (* {{{ proof *) [ REWRITE_TAC[eps_scale;eps_hyper]; COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane1_u_scale;hyperplane2_r_scale]; ]);; (* }}} *) let eps_hyper_scale = prove_by_refinement( `!eps r z. (&0 < r) ==> (IMAGE (eps_scale eps r) (eps_hyper (eps) z) = (eps_hyper (eps) (if (&0 < z) then r*z else z))) `, (* {{{ proof *) [ REWRITE_TAC[eps_scale;eps_hyper]; COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane2_u_scale;hyperplane1_r_scale]; ]);; (* }}} *) let homeomorphism_eps_scale = prove_by_refinement( `!eps r. (&0 < r) ==> homeomorphism (eps_scale eps r) top2 top2`, (* {{{ proof *) [ REWRITE_TAC[eps_scale]; COND_CASES_TAC THEN ASM_SIMP_TAC [u_scale_hom;r_scale_hom]; ]);; (* }}} *) let graph_support_eps = jordan_def `graph_support_eps G E <=> good_plane_graph G /\ FINITE E /\ (!e. (graph_edge G e ==> e SUBSET UNIONS E)) /\ (!v. (graph_vertex G v ==> E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\ (!e. (E e ==> (?z eps. (e = eps_hyper eps z)))) /\ (!z eps. (z <= &0 /\ E (eps_hyper eps z) ==> (?j. z = -- &j)))`;; let iso_support_eps_pair = jordan_def `iso_support_eps_pair (G:(A,B)graph_t) = { (H,E) | (graph_isomorphic G H) /\ graph_support_eps H E }`;; let eps_hyper_ne = prove_by_refinement( `!z z' eps. ~(eps_hyper eps z = eps_hyper (~eps) z')`, (* {{{ proof *) [ REWRITE_TAC[eps_hyper]; UND 0 THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[hyperplane_ne;GSYM hyperplane_ne] ; ASM_MESON_TAC[]; ]);; (* }}} *) let eps_hyper_inj = prove_by_refinement( `!z z' eps eps'. (eps_hyper eps z = eps_hyper eps' z') <=> ((eps = eps') /\ (z = z'))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN`eps' = ~eps` ASM_CASES_TAC; TYPE_THEN `eps'` UNABBREV_TAC; REWRITE_TAC [eps_hyper_ne]; ASM_MESON_TAC[]; TYPE_THEN `eps' = eps` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps'` UNABBREV_TAC; REWRITE_TAC[eps_hyper]; COND_CASES_TAC THEN IMATCH_MP_TAC EQ_ANTISYM THEN CONJ_TAC; IMATCH_MP_TAC hyperplane1_inj; IMATCH_MP_TAC hyperplane2_inj; ]);; (* }}} *) let iso_support_eps_nonempty = prove_by_refinement( `!(G:(A,B)graph_t). (planar_graph G) /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = {}) /\ (!v. CARD (graph_edge_around G v) <=| 4) ==> ~(iso_support_eps_pair G = EMPTY) `, (* {{{ proof *) [ REWRITE_TAC[iso_support_eps_pair]; TH_INTRO_TAC [`G`] graph_support_init; UND 0 THEN REWRITE_TAC[EMPTY_EXISTS]; CONV_TAC (dropq_conv "u"); REWRITE_TAC[graph_support_eps]; UNIFY_EXISTS_TAC; (* - *) CONJ_TAC; REWRITE_TAC[eps_hyper]; (* - *) TYPE_THEN `(!e. E e ==> (?z eps. (&0 < z) /\ (e = eps_hyper eps z)))` SUBAGOAL_TAC; UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`e`]); FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN`z` EXISTS_TAC; TYPE_THEN `T` EXISTS_TAC; REWRITE_TAC[eps_hyper]; TYPE_THEN`z` EXISTS_TAC; TYPE_THEN `F` EXISTS_TAC; REWRITE_TAC[eps_hyper]; (* - *) CONJ_TAC; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`e`]); MESON_TAC[]; (* - *) UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`eps_hyper eps z`]); FULL_REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `z'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 14 THEN UND 13 THEN REAL_ARITH_TAC; ]);; (* }}} *) let count_iso_eps_pair = jordan_def `count_iso_eps_pair ((H:(A,B)graph_t),E) = CARD { e | (?z eps. (&0 < z) /\ E e /\ (e = eps_hyper eps z)) }`;; let iso_support_eps_finite = prove_by_refinement( `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) ==> FINITE { e | (?z eps. (&0 < z) /\ E e /\ (e = eps_hyper eps z)) }`, (* {{{ proof *) [ REWRITE_TAC[iso_support_eps_pair ;PAIR_SPLIT; graph_support_eps;]; TYPE_THEN `E'` UNABBREV_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[SUBSET]; ]);; (* }}} *) let iso_eps_support0 = prove_by_refinement( `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\ (count_iso_eps_pair (H,E) = 0) ==> good_plane_graph H /\ FINITE E /\ (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\ (!v. (graph_vertex H v ==> E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\ (!e. (E e ==> (?z eps. (e = eps_hyper eps z) ))) /\ (!z eps. (E (eps_hyper eps z) ==> (?j. z = -- &j))) `, (* {{{ proof *) [ REWRITE_TAC[count_iso_eps_pair;]; TYPE_THEN `A = { e | (?z eps. (&0 < z) /\ E e /\ (e = eps_hyper eps z)) }` ABBREV_TAC ; TYPE_THEN `A HAS_SIZE 0` SUBAGOAL_TAC; REWRITE_TAC[HAS_SIZE]; TYPE_THEN `A` UNABBREV_TAC; TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite; RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;graph_support_eps;iso_support_eps_pair]); TYPE_THEN `E'` UNABBREV_TAC; TYPE_THEN `H'` UNABBREV_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN`eps` EXISTS_TAC; FULL_REWRITE_TAC[HAS_SIZE_0]; TYPE_THEN `A` UNABBREV_TAC; PROOF_BY_CONTR_TAC; USE 2 (MATCH_MP (REAL_ARITH `~( z <= &0) ==> (&0 < z)`)); UND 3 THEN REWRITE_TAC[EMPTY_EXISTS]; CONV_TAC (dropq_conv "u"); UNIFY_EXISTS_TAC; ]);; (* }}} *) let iso_support_eps_min = prove_by_refinement( `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\ (0 < count_iso_eps_pair (H,E)) ==> (?z eps. (&0 < z) /\ E (eps_hyper eps z) /\ (!w. (&0 < w /\ w < z) ==> ~(E (eps_hyper eps w))))`, (* {{{ proof *) [ REWRITE_TAC[count_iso_eps_pair]; TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ; TYPE_THEN `FINITE A` SUBAGOAL_TAC; TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `~(A HAS_SIZE 0) ` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); UND 4 THEN UND 0 THEN ARITH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE_0;EMPTY_EXISTS]); TYPE_THEN `?r eps. (u = eps_hyper eps r)` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; MESON_TAC[]; TYPE_THEN `u` UNABBREV_TAC; (* - *) TH_INTRO_TAC[`{z | &0 < z}`;`eps_hyper eps`;`{e | ?z. (&0 < z) /\ E e /\ (e = eps_hyper eps z)}`] finite_subset; REWRITE_TAC[SUBSET;IMAGE]; CONJ_TAC; TYPE_THEN `z` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]); UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `A` UNABBREV_TAC; UNIFY_EXISTS_TAC; FULL_REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `inf C` EXISTS_TAC; (* - *) TYPE_THEN `C (inf C)` SUBAGOAL_TAC; IMATCH_MP_TAC finite_inf; (* - *) TYPE_THEN `(!z. C z ==> inf C <= z)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC finite_inf_min;ALL_TAC ]; TYPE_THEN `z = inf C` ABBREV_TAC ; KILL 11; KILL 8; (* - *) TYPE_THEN `eps` EXISTS_TAC; USE 5(REWRITE_RULE[IMAGE]); USE 5(ONCE_REWRITE_RULE[FUN_EQ_THM]); COPY 5; TSPEC `eps_hyper eps z` 5; USE 5(REWRITE_RULE[INR IN_SING]); USE 5(MATCH_MP (TAUT `(a <=> b) ==> (b ==> a)`)); UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]); UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `z'` UNABBREV_TAC; REP_BASIC_TAC; (* - *) TSPEC `eps_hyper eps w` 8; USE 8(MATCH_MP (TAUT `(a <=> b) ==> (a ==> b)`)); UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]); TYPE_THEN `w` EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `x` UNABBREV_TAC; UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`w`]); UND 8 THEN UND 13 THEN REAL_ARITH_TAC; ]);; (* }}} *) let graph_eps_scale_image = prove_by_refinement( `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps (plane_graph_image (eps_scale eps r)G) (IMAGE2 (eps_scale eps r) E) `, (* {{{ proof *) [ REWRITE_TAC[graph_support_eps]; THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale; SUBCONJ_TAC; IMATCH_MP_TAC plane_graph_image_plane; (* - *) REWRITE_TAC[plane_graph_image_e;plane_graph_image_v]; SUBCONJ_TAC; REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC FINITE_IMAGE; (* - *) SUBCONJ_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; USE 10 (REWRITE_RULE[IMAGE]); UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); FULL_REWRITE_TAC [SUBSET;UNIONS]; REWRITE_TAC[IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `im` UNABBREV_TAC; USE 3(CONV_RULE NAME_CONFLICT_CONV); USE 13 (REWRITE_RULE[IMAGE]); TYPE_THEN `x'` UNABBREV_TAC; TSPEC `x''` 3; REP_BASIC_TAC; TYPE_THEN `u'` EXISTS_TAC; REWRITE_TAC[IMAGE]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* -A *) SUBCONJ_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; REWRITE_TAC[IMAGE]; TYPE_THEN `im` UNABBREV_TAC; USE 11(REWRITE_RULE[IMAGE]); UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); CONJ_TAC; UNIFY_EXISTS_TAC; (* ? *) TYPE_THEN `eps = T` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; REWRITE_TAC[eps_scale;r_scale]; COND_CASES_TAC; TYPE_THEN `eps = F` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp; AP_TERM_TAC; REWRITE_TAC[eps_scale;u_scale]; COND_CASES_TAC; (* -- *) TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC; TYPE_THEN `eps = F` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; REWRITE_TAC[eps_scale;u_scale]; COND_CASES_TAC; TYPE_THEN `eps = T` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp; AP_TERM_TAC; REWRITE_TAC[eps_scale;r_scale]; COND_CASES_TAC; (* -B *) CONJ_TAC; USE 12(REWRITE_RULE[IMAGE2]); TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; USE 12(REWRITE_RULE[IMAGE]); UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); TYPE_THEN `im` UNABBREV_TAC; LEFT_TAC "eps''"; TYPE_THEN `eps'` EXISTS_TAC; TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_scale_perp]; MESON_TAC[]; TYPE_THEN `eps' = eps` SUBAGOAL_TAC; UND 13 THEN MESON_TAC[]; ASM_SIMP_TAC[eps_hyper_scale]; MESON_TAC[]; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `eps'` EXISTS_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; USE 12 (REWRITE_RULE[IMAGE]); TYPE_THEN `im` UNABBREV_TAC; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); REWR 12; TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC; UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `eps''` UNABBREV_TAC; TYPE_THEN `eps'' = eps` SUBAGOAL_TAC; UND 14 THEN MESON_TAC[]; TYPE_THEN `eps''` UNABBREV_TAC; UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale]; FULL_REWRITE_TAC[eps_hyper_inj]; UND 12 THEN COND_CASES_TAC; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LT_MUL; PROOF_BY_CONTR_TAC; UND 12 THEN UND 13 THEN REAL_ARITH_TAC; TYPE_THEN `z'` UNABBREV_TAC; TYPE_THEN `x` UNABBREV_TAC; ]);; (* }}} *) let graph_eps_scale_image = prove_by_refinement( `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps (plane_graph_image (eps_scale eps r)G) (IMAGE2 (eps_scale eps r) E) `, (* {{{ proof *) [ REWRITE_TAC[graph_support_eps]; THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale; SUBCONJ_TAC; IMATCH_MP_TAC plane_graph_image_plane; (* - *) REWRITE_TAC[plane_graph_image_e;plane_graph_image_v]; SUBCONJ_TAC; REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC FINITE_IMAGE; (* - *) SUBCONJ_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; USE 10 (REWRITE_RULE[IMAGE]); UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); FULL_REWRITE_TAC [SUBSET;UNIONS]; REWRITE_TAC[IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `im` UNABBREV_TAC; USE 3(CONV_RULE NAME_CONFLICT_CONV); USE 13 (REWRITE_RULE[IMAGE]); TYPE_THEN `x'` UNABBREV_TAC; TSPEC `x''` 3; REP_BASIC_TAC; TYPE_THEN `u'` EXISTS_TAC; REWRITE_TAC[IMAGE]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* -A *) SUBCONJ_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; REWRITE_TAC[IMAGE]; TYPE_THEN `im` UNABBREV_TAC; USE 11(REWRITE_RULE[IMAGE]); UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); CONJ_TAC; UNIFY_EXISTS_TAC; (* ? *) TYPE_THEN `eps = T` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; REWRITE_TAC[eps_scale;r_scale]; COND_CASES_TAC; TYPE_THEN `eps = F` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp; AP_TERM_TAC; REWRITE_TAC[eps_scale;u_scale]; COND_CASES_TAC; (* -- *) TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC; TYPE_THEN `eps = F` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; REWRITE_TAC[eps_scale;u_scale]; COND_CASES_TAC; TYPE_THEN `eps = T` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp; AP_TERM_TAC; REWRITE_TAC[eps_scale;r_scale]; COND_CASES_TAC; (* -B *) CONJ_TAC; USE 12(REWRITE_RULE[IMAGE2]); TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; USE 12(REWRITE_RULE[IMAGE]); UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); TYPE_THEN `im` UNABBREV_TAC; LEFT_TAC "eps''"; TYPE_THEN `eps'` EXISTS_TAC; TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_scale_perp]; MESON_TAC[]; TYPE_THEN `eps' = eps` SUBAGOAL_TAC; UND 13 THEN MESON_TAC[]; ASM_SIMP_TAC[eps_hyper_scale]; MESON_TAC[]; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `eps'` EXISTS_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; USE 12 (REWRITE_RULE[IMAGE]); TYPE_THEN `im` UNABBREV_TAC; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); REWR 12; TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC; UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `eps''` UNABBREV_TAC; TYPE_THEN `eps'' = eps` SUBAGOAL_TAC; UND 14 THEN MESON_TAC[]; TYPE_THEN `eps''` UNABBREV_TAC; UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale]; FULL_REWRITE_TAC[eps_hyper_inj]; UND 12 THEN COND_CASES_TAC; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LT_MUL; PROOF_BY_CONTR_TAC; UND 12 THEN UND 13 THEN REAL_ARITH_TAC; TYPE_THEN `z'` UNABBREV_TAC; TYPE_THEN `x` UNABBREV_TAC; ]);; (* }}} *) let graph_eps_translate_image = prove_by_refinement( `!G E eps r. (?j. -- &j = r) /\ (!w. (&0 < w /\ w < -- r) ==> ~(E (eps_hyper eps w))) /\ graph_support_eps G E ==> graph_support_eps (plane_graph_image (eps_translate eps r)G) (IMAGE2 (eps_translate eps r) E) `, (* {{{ proof *) [ REWRITE_TAC[graph_support_eps]; THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_translate; SUBCONJ_TAC; IMATCH_MP_TAC plane_graph_image_plane; (* - *) REWRITE_TAC[plane_graph_image_e;plane_graph_image_v]; SUBCONJ_TAC; REWRITE_TAC[IMAGE2]; IMATCH_MP_TAC FINITE_IMAGE; (* - *) SUBCONJ_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; USE 11 (REWRITE_RULE[IMAGE]); UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); FULL_REWRITE_TAC [SUBSET;UNIONS]; REWRITE_TAC[IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `im` UNABBREV_TAC; USE 3(CONV_RULE NAME_CONFLICT_CONV); USE 14 (REWRITE_RULE[IMAGE]); TYPE_THEN `x'` UNABBREV_TAC; TSPEC `x''` 3; REP_BASIC_TAC; TYPE_THEN `u'` EXISTS_TAC; REWRITE_TAC[IMAGE]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* -A *) SUBCONJ_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; REWRITE_TAC[IMAGE]; TYPE_THEN `im` UNABBREV_TAC; USE 12(REWRITE_RULE[IMAGE]); UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); CONJ_TAC; UNIFY_EXISTS_TAC; (* --- *) TYPE_THEN `eps = T` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj]; REWRITE_TAC[eps_translate;h_translate]; REWRITE_TAC[euclid_plus;e1;point_scale]; REAL_ARITH_TAC; TYPE_THEN `eps = F` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_translate_perp; FULL_REWRITE_TAC []; AP_TERM_TAC; REWRITE_TAC[eps_translate;v_translate]; REWRITE_TAC[euclid_plus;e2;point_scale]; REAL_ARITH_TAC; (* -- *) TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC; TYPE_THEN `eps = F` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj]; REWRITE_TAC[eps_translate;v_translate]; REWRITE_TAC[euclid_plus;e2;point_scale]; REAL_ARITH_TAC; TYPE_THEN `eps = T` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `eps` UNABBREV_TAC; THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_translate_perp; FULL_REWRITE_TAC[]; AP_TERM_TAC; REWRITE_TAC[eps_translate;h_translate]; REWRITE_TAC[euclid_plus;e1;point_scale]; REAL_ARITH_TAC; (* -B *) CONJ_TAC; USE 13(REWRITE_RULE[IMAGE2]); TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; USE 13(REWRITE_RULE[IMAGE]); UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); TYPE_THEN `im` UNABBREV_TAC; LEFT_TAC "eps''"; TYPE_THEN `eps'` EXISTS_TAC; TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; ASM_SIMP_TAC [eps_hyper_translate_perp]; MESON_TAC[]; TYPE_THEN `eps' = eps` SUBAGOAL_TAC; UND 14 THEN MESON_TAC[]; ASM_SIMP_TAC[eps_hyper_translate]; MESON_TAC[]; (* -C *) TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; TYPE_THEN `eps'` UNABBREV_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `~eps` EXISTS_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; USE 13 (REWRITE_RULE[IMAGE]); TYPE_THEN `im` UNABBREV_TAC; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); REWR 13; TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `eps'` UNABBREV_TAC; TYPE_THEN `eps' = eps` SUBAGOAL_TAC; UND 15 THEN MESON_TAC[]; TYPE_THEN `eps'` UNABBREV_TAC; UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate]; FULL_REWRITE_TAC[eps_hyper_inj]; UND 17 THEN MESON_TAC[]; (* -D *) TYPE_THEN `eps' = eps` SUBAGOAL_TAC; UND 15 THEN MESON_TAC[]; TYPE_THEN`eps'` UNABBREV_TAC; TYPE_THEN `E(eps_hyper eps (z + &j))` SUBAGOAL_TAC; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; USE 13 (REWRITE_RULE[IMAGE]); TYPE_THEN `im` UNABBREV_TAC; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); REWR 13; TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC; UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp]; FULL_REWRITE_TAC[eps_hyper_inj]; UND 18 THEN MESON_TAC[]; TYPE_THEN `eps'' = eps` SUBAGOAL_TAC; UND 16 THEN MESON_TAC[]; TYPE_THEN `eps''` UNABBREV_TAC; FULL_REWRITE_TAC[eps_hyper_translate;eps_hyper_inj]; TYPE_THEN `r` UNABBREV_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `!a. (z' + (-- a)) + a = z'` SUBAGOAL_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `z = &0` ASM_CASES_TAC; TYPE_THEN `0` EXISTS_TAC; REAL_ARITH_TAC; UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`z + &j`;`eps`]); IMATCH_MP_TAC (REAL_ARITH `~(&0 < z + &j) ==> (z + &j <= &0)`); UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`z + &j`]); TYPE_THEN `r` UNABBREV_TAC; UND 17 THEN UND 14 THEN REAL_ARITH_TAC; UND 6 THEN REWRITE_TAC[]; TYPE_THEN `j +| j'` EXISTS_TAC; UND 0 THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ]);; (* }}} *) let count_iso_scale = prove_by_refinement( `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> (count_iso_eps_pair (G,E) = count_iso_eps_pair ((plane_graph_image(eps_scale eps r) G), (IMAGE2 (eps_scale eps r) E))) `, (* {{{ proof *) [ REWRITE_TAC[count_iso_eps_pair]; THM_INTRO_TAC[`G`;`E`;`eps`;`r`] graph_eps_scale_image; FULL_REWRITE_TAC[graph_support_eps]; IMATCH_MP_TAC BIJ_CARD; TYPE_THEN `IMAGE (eps_scale eps r)` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET ; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[SUBSET]; (* - *) FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v]; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; (* - *) REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; TYPE_THEN `if (eps = eps') then r* z else z` EXISTS_TAC; TYPE_THEN `eps'` EXISTS_TAC; CONJ_TAC; COND_CASES_TAC; IMATCH_MP_TAC REAL_LT_MUL; CONJ_TAC; IMATCH_MP_TAC image_imp; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `im` UNABBREV_TAC; COND_CASES_TAC; ASM_SIMP_TAC[eps_hyper_scale]; TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; UND 13 THEN MESON_TAC[]; ASM_SIMP_TAC[eps_hyper_scale_perp]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `y` UNABBREV_TAC; TYPE_THEN `im` UNABBREV_TAC; TYPE_THEN `(eps' = eps) \/ (eps' = ~eps)` SUBAGOAL_TAC; MESON_TAC[]; TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC; MESON_TAC[]; REWRITE_TAC[eps_hyper_inj]; JOIN 13 15 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR]; UND 13 THEN REP_CASES_TAC THEN UND 14 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_scale_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`]; IMATCH_MP_TAC REAL_EQ_LCANCEL_IMP; TYPE_THEN `r` EXISTS_TAC; UND 1 THEN REAL_ARITH_TAC; (* - *) REWRITE_TAC[SURJ]; CONJ_TAC; FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; (* - *) CONV_TAC (dropq_conv "y"); TYPE_THEN `x` UNABBREV_TAC; LEFT_TAC "eps"; TYPE_THEN `eps'` EXISTS_TAC; USE 16 (REWRITE_RULE[IMAGE]); UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `z'` EXISTS_TAC; TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then r*z' else z')` SUBAGOAL_TAC; TYPE_THEN `im` UNABBREV_TAC; COND_CASES_TAC; TYPE_THEN `eps''` UNABBREV_TAC; UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; COND_CASES_TAC; REWR 17; TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC; UND 8 THEN MESON_TAC[]; TYPE_THEN `eps''` UNABBREV_TAC; UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale_perp;eps_hyper_inj]; (* - *) TYPE_THEN `eps''` UNABBREV_TAC; REWR 17; UND 17 THEN COND_CASES_TAC; THM_INTRO_TAC[`r`;`z'`] REAL_LT_LMUL_0; USE 19 SYM; ASM_REWRITE_TAC[]; ]);; (* }}} *) let count_iso_translate = prove_by_refinement( `!G E eps . graph_support_eps G E /\ (!w. (&0 < w /\ w < &1) ==> ~(E (eps_hyper eps w))) /\ E (eps_hyper eps (&1)) ==> (count_iso_eps_pair (G,E) = SUC(count_iso_eps_pair ((plane_graph_image(eps_translate eps (-- &1)) G), (IMAGE2 (eps_translate eps (-- &1)) E)))) `, (* {{{ proof *) [ REWRITE_TAC[count_iso_eps_pair]; TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ; TYPE_THEN `A (eps_hyper eps (&1))` SUBAGOAL_TAC; TYPE_THEN`A` UNABBREV_TAC; TYPE_THEN `&1` EXISTS_TAC; MESON_TAC[]; (* - *) TYPE_THEN`FINITE A` SUBAGOAL_TAC; FULL_REWRITE_TAC[graph_support_eps]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[SUBSET]; (* - *) THM_INTRO_TAC[`(eps_hyper eps (&1))`;`A`]CARD_SUC_DELETE; TYPE_THEN `CARD A` UNABBREV_TAC; REWRITE_TAC[SUC_INJ]; THM_INTRO_TAC[`G`;`E`;`eps`;`-- &1`] graph_eps_translate_image; CONJ_TAC; MESON_TAC[]; FULL_REWRITE_TAC[REAL_ARITH `-- -- x = x`]; ASM_MESON_TAC[]; FULL_REWRITE_TAC[graph_support_eps]; (* -A0 *) IMATCH_MP_TAC BIJ_CARD; TYPE_THEN `IMAGE (eps_translate eps (-- &1))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC FINITE_DELETE_IMP; (* - *) FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v]; FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_translate eps (-- &1))` ABBREV_TAC ; (* -A *) REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; FULL_REWRITE_TAC[DELETE]; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `if (eps = eps'') then z' - &1 else z'` EXISTS_TAC; TYPE_THEN `eps''` EXISTS_TAC; TYPE_THEN `eps'` UNABBREV_TAC; CONJ_TAC; COND_CASES_TAC; TYPE_THEN `eps''` UNABBREV_TAC; IMATCH_MP_TAC (REAL_ARITH `~((z' = &1) \/ (z' < &1)) ==> (&0 < z' - &1)`); REWR 3; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`z'`]); UND 1 THEN ASM_REWRITE_TAC[]; (* --- *) CONJ_TAC; IMATCH_MP_TAC image_imp; TYPE_THEN `im` UNABBREV_TAC; COND_CASES_TAC; ASM_SIMP_TAC[eps_hyper_translate]; AP_TERM_TAC; REAL_ARITH_TAC; TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC; UND 3 THEN MESON_TAC[]; ASM_SIMP_TAC[eps_hyper_translate_perp]; TYPE_THEN `A` UNABBREV_TAC; FULL_REWRITE_TAC[DELETE]; TYPE_THEN `x` UNABBREV_TAC; (* -// *) TYPE_THEN `y` UNABBREV_TAC; TYPE_THEN `im` UNABBREV_TAC; TYPE_THEN `(eps''' = eps) \/ (eps''' = ~eps)` SUBAGOAL_TAC; MESON_TAC[]; TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC; MESON_TAC[]; REWRITE_TAC[eps_hyper_inj]; JOIN 17 20 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR]; UND 17 THEN REP_CASES_TAC THEN UND 18 THEN ASM_SIMP_TAC[eps_hyper_translate;eps_hyper_translate_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`]; UND 17 THEN REAL_ARITH_TAC; (* -B *) REWRITE_TAC[SURJ]; FULL_REWRITE_TAC[INJ]; (* - *) REP_BASIC_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DELETE]; CONV_TAC (dropq_conv "y"); (* -// *) LEFT_TAC "eps"; TYPE_THEN `eps'` EXISTS_TAC; KILL 18; KILL 19; FULL_REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `z'` UNABBREV_TAC; TYPE_THEN `eps''` UNABBREV_TAC; (* - *) USE 21 (REWRITE_RULE[IMAGE]); UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `z''` EXISTS_TAC; TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then z'' - &1 else z'')` SUBAGOAL_TAC; TYPE_THEN `im` UNABBREV_TAC; COND_CASES_TAC; TYPE_THEN `eps''` UNABBREV_TAC; USE 3 (REWRITE_RULE [eps_hyper_translate;eps_hyper_inj]); REAL_ARITH_TAC; TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC; UND 12 THEN MESON_TAC[]; TYPE_THEN `eps''` UNABBREV_TAC; USE 3 (REWRITE_RULE[ eps_hyper_translate_perp;eps_hyper_inj]); (* - *) TYPE_THEN `eps''` UNABBREV_TAC; TYPE_THEN `z` UNABBREV_TAC; CONJ_TAC; UND 22 THEN COND_CASES_TAC; UND 12 THEN REAL_ARITH_TAC; TYPE_THEN `z''` UNABBREV_TAC; TYPE_THEN `eps'` UNABBREV_TAC; UND 22 THEN REAL_ARITH_TAC; ]);; (* }}} *) let iso_support_min_int = prove_by_refinement( `!G:(A,B)graph_t H E. iso_support_eps_pair G (H,E) /\ (0 <| count_iso_eps_pair (H,E)) ==> (?H' E'. iso_support_eps_pair G (H',E') /\ (count_iso_eps_pair(H',E') = count_iso_eps_pair(H,E)) /\ (?eps. E' (eps_hyper eps (&1)) /\ (!w. (&0 < w /\ w < &1) ==> ~(E'(eps_hyper eps w)))))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_min; TYPE_THEN `z' = &1/z` ABBREV_TAC ; TYPE_THEN `H' = plane_graph_image (eps_scale eps z') H` ABBREV_TAC ; TYPE_THEN `E' = IMAGE2 (eps_scale eps z') E` ABBREV_TAC ; TYPE_THEN `H'` EXISTS_TAC; TYPE_THEN `E'` EXISTS_TAC; (* - *) TYPE_THEN `&0 < z'` SUBAGOAL_TAC; TYPE_THEN `z'` UNABBREV_TAC; (* - *) TYPE_THEN `z' * z = &1` SUBAGOAL_TAC; TYPE_THEN `z'` UNABBREV_TAC; IMATCH_MP_TAC REAL_DIV_RMUL; UND 5 THEN UND 4 THEN REAL_ARITH_TAC; (* - *) SUBCONJ_TAC; FULL_REWRITE_TAC[iso_support_eps_pair]; FULL_REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `E''` UNABBREV_TAC; TYPE_THEN `H''` UNABBREV_TAC; TYPE_THEN `H'` EXISTS_TAC; TYPE_THEN `E'` EXISTS_TAC; TYPE_THEN `H'` UNABBREV_TAC; TYPE_THEN `E'` UNABBREV_TAC; CONJ_TAC; THM_INTRO_TAC[`eps_scale eps z'`;`H`] plane_graph_image_iso; ASM_SIMP_TAC [homeomorphism_eps_scale]; FULL_REWRITE_TAC[graph_support_eps;good_plane_graph]; THM_INTRO_TAC[`G`;`H`;`(plane_graph_image (eps_scale eps z') H)`] graph_isomorphic_trans; IMATCH_MP_TAC graph_eps_scale_image; (* - *) SUBCONJ_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; TYPE_THEN `E'` UNABBREV_TAC; TYPE_THEN `H'` UNABBREV_TAC; IMATCH_MP_TAC count_iso_scale; FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; ASM_MESON_TAC[]; TYPE_THEN `eps` EXISTS_TAC; TYPE_THEN `E'` UNABBREV_TAC; (* - *) SUBCONJ_TAC; REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ; REWRITE_TAC[IMAGE]; TYPE_THEN `eps_hyper eps z` EXISTS_TAC; TYPE_THEN `im` UNABBREV_TAC; ASM_SIMP_TAC [eps_hyper_scale]; (* - *) FULL_REWRITE_TAC[IMAGE2]; TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ; USE 7(REWRITE_RULE[IMAGE]); TYPE_THEN `im` UNABBREV_TAC; UND 2 THEN DISCH_THEN (THM_INTRO_TAC[ `z*w` ]); CONJ_TAC; IMATCH_MP_TAC REAL_LT_MUL; IMATCH_MP_TAC (REAL_ARITH `z * w < z* &1 ==> z*w < z`); IMATCH_MP_TAC REAL_LT_LMUL; TYPE_THEN `x = eps_hyper eps (z * w)` SUBAGOAL_TAC; USE 1 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]); TYPE_THEN `E''` UNABBREV_TAC; USE 17 (REWRITE_RULE[graph_support_eps]); UND 17 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); TYPE_THEN `x` UNABBREV_TAC; REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `eps' = eps` ASM_CASES_TAC; TYPE_THEN `eps'` UNABBREV_TAC; UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_inj]; COND_CASES_TAC; UND 9 THEN REWRITE_TAC[REAL_MUL_AC]; ASM_REWRITE_TAC [REAL_MUL_ASSOC]; REAL_ARITH_TAC; REWR 13; TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; UND 17 THEN MESON_TAC[]; TYPE_THEN `eps'` UNABBREV_TAC; UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale_perp;eps_hyper_inj]; TYPE_THEN `x` UNABBREV_TAC; UND 2 THEN ASM_REWRITE_TAC[]; ]);; (* }}} *) let iso_int_model_lemma = prove_by_refinement( `!(G:(A,B)graph_t) . (planar_graph G) /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = {}) /\ (!v. CARD (graph_edge_around G v) <=| 4) ==> (?H E. iso_support_eps_pair G (H,E) /\ (count_iso_eps_pair (H,E) = 0))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `c = count_iso_eps_pair:((num->real,(num->real)->bool)graph_t#(((num->real)->bool)->bool))->num` ABBREV_TAC ; THM_INTRO_TAC[`G`] iso_support_eps_nonempty; THM_INTRO_TAC[`iso_support_eps_pair G`;`c`] select_image_num_min; UND 6 THEN ASM_REWRITE_TAC[]; TYPE_THEN `?H E. z = H,E` SUBAGOAL_TAC ; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `H` EXISTS_TAC; TYPE_THEN `E` EXISTS_TAC; TYPE_THEN `c` UNABBREV_TAC; IMATCH_MP_TAC (ARITH_RULE `~(0 < x) ==> (x = 0)`); THM_INTRO_TAC[`G`;`H`;`E`] iso_support_min_int; THM_INTRO_TAC[`H'`;`E'`;`eps`] count_iso_translate; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; ASM_MESON_TAC[]; TYPE_THEN `H'' = plane_graph_image (eps_translate eps (-- &1)) H'` ABBREV_TAC ; TYPE_THEN `E'' = IMAGE2 (eps_translate eps ( -- &1)) E'`ABBREV_TAC ; UND 7 THEN DISCH_THEN (THM_INTRO_TAC[ `(H'',E'')`]); TYPE_THEN `H''` UNABBREV_TAC; TYPE_THEN `E''` UNABBREV_TAC; REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; CONV_TAC (dropq_conv "H"); CONV_TAC (dropq_conv "E"); (* -- *) CONJ_TAC; TYPE_THEN `graph_isomorphic H' (plane_graph_image (eps_translate eps (-- &1)) H')` SUBAGOAL_TAC; IMATCH_MP_TAC plane_graph_image_iso; REWRITE_TAC[homeomorphism_eps_translate;]; USE 12 (REWRITE_RULE[iso_support_eps_pair;graph_support_eps;good_plane_graph;PAIR_SPLIT]); ASM_MESON_TAC[]; THM_INTRO_TAC[`G`;`H'`;`(plane_graph_image (eps_translate eps (-- &1)) H')`] graph_isomorphic_trans; USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]); ASM_MESON_TAC[]; (* -- *) IMATCH_MP_TAC graph_eps_translate_image; CONJ_TAC; MESON_TAC[]; ASM_REWRITE_TAC[ARITH_RULE `-- (-- x) = x`]; USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]); ASM_MESON_TAC[]; UND 7 THEN UND 13 THEN UND 11 THEN ARITH_TAC; ]);; (* }}} *) let graph_int_model = prove_by_refinement( `!(G:(A,B)graph_t) . (planar_graph G) /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = {}) /\ (!v. CARD (graph_edge_around G v) <=| 4) ==> (?H E. graph_isomorphic G H /\ good_plane_graph H /\ FINITE E /\ (!e. graph_edge H e ==> e SUBSET UNIONS E) /\ (!v. graph_vertex H v ==> E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1))) /\ (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\ (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) )`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`]iso_int_model_lemma; TYPE_THEN `H` EXISTS_TAC; TYPE_THEN `E` EXISTS_TAC; THM_INTRO_TAC[`G`;`H`;`E`] iso_eps_support0; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION Y *) (* ------------------------------------------------------------------ *) (* if a graph has an int model then it is a rectagonal graph *) (* k33_nonplanar proved! *) let h_edge_ball = prove_by_refinement( `!m. h_edge m SUBSET open_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e1) (&1 / &2)`, (* {{{ proof *) [ REWRITE_TAC[h_edge;open_ball;SUBSET;euclid_point;e1;point_scale;pointI;point_add]; REWRITE_TAC[euclid_point;]; TYPE_THEN `v` UNABBREV_TAC; REDUCE_TAC; REWRITE_TAC[d_euclid_point]; REDUCE_TAC; TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC; REWRITE_TAC[EXP_EQ_0]; UND 0 THEN ARITH_TAC; REDUCE_TAC; REWRITE_TAC[POW_2_SQRT_ABS]; FULL_REWRITE_TAC[int_add_th;int_of_num_th]; REWRITE_TAC[GSYM REAL_ABS_BETWEEN]; CONJ_TAC; REWRITE_TAC[REAL_LT_HALF1]; CONJ_TAC; REWRITE_TAC[REAL_LT_SUB_RADD]; REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE]; UND 2 THEN REAL_ARITH_TAC; ]);; (* }}} *) let v_edge_ball = prove_by_refinement( `!m. v_edge m SUBSET open_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e2) (&1 / &2)`, (* {{{ proof *) [ REWRITE_TAC[v_edge;open_ball;SUBSET;euclid_point;e2;point_scale;pointI;point_add]; REWRITE_TAC[euclid_point;]; TYPE_THEN `u` UNABBREV_TAC; REDUCE_TAC; REWRITE_TAC[d_euclid_point]; REDUCE_TAC; TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC; REWRITE_TAC[EXP_EQ_0]; UND 0 THEN ARITH_TAC; REDUCE_TAC; REWRITE_TAC[POW_2_SQRT_ABS]; FULL_REWRITE_TAC[int_add_th;int_of_num_th]; REWRITE_TAC[GSYM REAL_ABS_BETWEEN]; CONJ_TAC; REWRITE_TAC[REAL_LT_HALF1]; CONJ_TAC; REWRITE_TAC[REAL_LT_SUB_RADD]; REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE]; UND 2 THEN REAL_ARITH_TAC; ]);; (* }}} *) let sqrt_frac = prove_by_refinement( `!n m. sqrt ((&n/ &m) pow 2) = &n/ (&m) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC POW_2_SQRT; IMATCH_MP_TAC REAL_LE_DIV; REWRITE_TAC[REAL_POS]; ]);; (* }}} *) let abs_dest_int_half = prove_by_refinement( `!m. &1 / &2 <= abs (real_of_int m - &1 / &2)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC REAL_LE_LCANCEL_IMP; TYPE_THEN `&2` EXISTS_TAC; CONJ_TAC; REAL_ARITH_TAC; TYPE_THEN `&2 * (&1/ &2) = &1` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; UND 0 THEN REAL_ARITH_TAC; TYPE_THEN `&2 = abs (&2)` SUBAGOAL_TAC; REAL_ARITH_TAC; TYPE_THEN`!x. &2 * abs x = abs (&2 * x)` SUBAGOAL_TAC; UND 1 THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_SUB_LDISTRIB]; REWRITE_TAC[GSYM int_of_num_th;GSYM int_mul_th;GSYM int_sub_th;GSYM int_abs_th;GSYM int_le]; TYPE_THEN `!x. ~(&:0 = ||: x) ==> (&:1 <= ||: x)` SUBAGOAL_TAC; THM_INTRO_TAC[`x`] INT_ABS_POS; UND 3 THEN UND 4 THEN INT_ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USE 4 SYM; FULL_REWRITE_TAC[INT_ABS_ZERO]; THM_INTRO_TAC[`m`] INT_REP; TYPE_THEN`m` UNABBREV_TAC; FULL_REWRITE_TAC[INT_OF_NUM_MUL;INT_SUB_LDISTRIB;INT_EQ_SUB_RADD;INT_OF_NUM_ADD;INT_OF_NUM_EQ;]; UND 4 THEN REDUCE_TAC ; TYPE_THEN `ODD (2 *| n)` SUBAGOAL_TAC; REWRITE_TAC[ODD_EXISTS]; TYPE_THEN `m'` EXISTS_TAC; ARITH_TAC; KILL 4; TYPE_THEN `EVEN (2 *| n)` SUBAGOAL_TAC; REWRITE_TAC[EVEN_EXISTS]; MESON_TAC[]; ASM_MESON_TAC[EVEN_AND_ODD]; ]);; (* }}} *) let REAL_LT_SQUARE_ABS = prove_by_refinement( `!x y. abs x < abs y <=> x pow 2 < y pow 2`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y /\ ~(y <= x))`]; MESON_TAC[REAL_LE_SQUARE_ABS]; ]);; (* }}} *) let h_edge_closed_ball = prove_by_refinement( `!e m. edge e /\ ~(e INTER closed_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e1) (&1 / &2) = EMPTY) ==> (e = h_edge m)`, (* {{{ proof *) [ REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; (* - *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; PROOF_BY_CONTR_TAC; USE 1 (MATCH_MP point_onto); TYPE_THEN `u` UNABBREV_TAC; KILL 5; FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;v_edge;point_inj]; TYPE_THEN `p` UNABBREV_TAC; TYPE_THEN `u'` UNABBREV_TAC; USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); UND 0 THEN REWRITE_TAC[]; TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; REWRITE_TAC[sqrt_frac]; IMATCH_MP_TAC SQRT_MONO_LT; IMATCH_MP_TAC (REAL_ARITH `(x <= u /\ &0 < v) ==> x < u + v` ); (* -- *) CONJ_TAC; REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS]; TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_DIV;ABS_N]; ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG]; TYPE_THEN `--((real_of_int (FST m) + &1 / &2) - real_of_int (FST m')) = (real_of_int (FST m' - FST m)) - &1 / &2 ` SUBAGOAL_TAC; REWRITE_TAC[int_sub_th]; REAL_ARITH_TAC; REWRITE_TAC[abs_dest_int_half]; (* -- *) IMATCH_MP_TAC (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`); REWRITE_TAC[]; USE 1 (MATCH_MP POW_ZERO); TYPE_THEN `v = real_of_int (SND m)` SUBAGOAL_TAC; UND 1 THEN REAL_ARITH_TAC; TYPE_THEN `v` UNABBREV_TAC; FULL_REWRITE_TAC[GSYM int_lt]; UND 3 THEN UND 5 THEN INT_ARITH_TAC; (* - *) REWRITE_TAC[cell_clauses]; TYPE_THEN `e` UNABBREV_TAC; FULL_REWRITE_TAC[h_edge]; TYPE_THEN `v` UNABBREV_TAC; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; REWRITE_TAC[PAIR_SPLIT]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; (* - *) USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); UND 0 THEN REWRITE_TAC[]; TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; REWRITE_TAC[sqrt_frac]; IMATCH_MP_TAC SQRT_MONO_LT; (* - *) FIRST_ASSUM DISJ_CASES_TAC; IMATCH_MP_TAC (REAL_ARITH `(x < u /\ &0 <= v) ==> x < u + v` ); (* --B *) REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_DIV;ABS_N]; KILL 0; TYPE_THEN `!x y. x < abs y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC; REAL_ARITH_TAC; TYPE_THEN `&1 / &2 < (real_of_int (FST m) + &1 / &2) - u'` ASM_CASES_TAC; DISJ1_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `&1 / &2` EXISTS_TAC; CONJ_TAC ; IMATCH_MP_TAC REAL_LE_DIV; REAL_ARITH_TAC; UND 9 THEN REAL_ARITH_TAC; (* -- *) TYPE_THEN `real_of_int (FST m) + &1 < u'` BACK_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LT_TRANS; TYPE_THEN `real_of_int (FST m) + &1 - u'` EXISTS_TAC; CONJ_TAC; TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC; REWRITE_TAC[REAL_LT_HALF2]; UND 11 THEN REAL_ARITH_TAC; UND 10 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE; UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t])); UND 10 THEN REAL_ARITH_TAC; (* -- *) PROOF_BY_CONTR_TAC; TYPE_THEN `u' <= real_of_int (FST m) + &1` SUBAGOAL_TAC; UND 10 THEN REAL_ARITH_TAC; TYPE_THEN `real_of_int (FST m) <= u'` SUBAGOAL_TAC; UND 9 THEN REAL_ARITH_TAC; TYPE_THEN `~(u' = real_of_int (FST m) + &1)` SUBAGOAL_TAC; TYPE_THEN `u'` UNABBREV_TAC; FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;]; UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC; TYPE_THEN `u' < real_of_int (FST m) + &1` SUBAGOAL_TAC; UND 13 THEN UND 11 THEN ARITH_TAC; (* -- *) TYPE_THEN `floor u' = (FST m')` SUBAGOAL_TAC; FULL_REWRITE_TAC[int_add_th;int_of_num_th]; ASM_REWRITE_TAC[floor_range]; UND 6 THEN REAL_ARITH_TAC; USE 15 SYM; TYPE_THEN `floor u' = FST m` SUBAGOAL_TAC; REWRITE_TAC[floor_range]; ASM_MESON_TAC[]; (* -C different second coord *) IMATCH_MP_TAC (REAL_ARITH `x < z /\ &0 <= y ==> x < y + z`); REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; REDUCE_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `&1` EXISTS_TAC; CONJ_TAC; KILL 0; REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM]; REWRITE_TAC[REAL_LT_HALF2]; REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;]; UND 7 THEN INT_ARITH_TAC; ]);; (* }}} *) let v_edge_closed_ball = prove_by_refinement( `!e m. edge e /\ ~(e INTER closed_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e2) (&1 / &2) = EMPTY) ==> (e = v_edge m)`, (* {{{ proof *) [ REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; (* - *) USE 4 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; PROOF_BY_CONTR_TAC; USE 1 (MATCH_MP point_onto); TYPE_THEN `u` UNABBREV_TAC; KILL 5; FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;h_edge;point_inj]; TYPE_THEN `p` UNABBREV_TAC; TYPE_THEN `v ` UNABBREV_TAC; USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); UND 0 THEN REWRITE_TAC[]; TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; REWRITE_TAC[sqrt_frac]; IMATCH_MP_TAC SQRT_MONO_LT; IMATCH_MP_TAC (REAL_ARITH `(x <= v /\ &0 < u) ==> x < u + v` ); (* -- *) CONJ_TAC; REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS]; TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_DIV;ABS_N]; ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG]; TYPE_THEN `--((real_of_int (SND m) + &1 / &2) - real_of_int (SND m')) = (real_of_int (SND m' - SND m)) - &1 / &2 ` SUBAGOAL_TAC; REWRITE_TAC[int_sub_th]; REAL_ARITH_TAC; REWRITE_TAC[abs_dest_int_half]; (* --// *) IMATCH_MP_TAC (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`); REWRITE_TAC[]; USE 1 (MATCH_MP POW_ZERO); TYPE_THEN `u' = real_of_int (FST m)` SUBAGOAL_TAC; UND 1 THEN REAL_ARITH_TAC; TYPE_THEN `u'` UNABBREV_TAC; FULL_REWRITE_TAC[GSYM int_lt]; UND 3 THEN UND 5 THEN INT_ARITH_TAC; (* - *) REWRITE_TAC[cell_clauses]; TYPE_THEN `e` UNABBREV_TAC; FULL_REWRITE_TAC[v_edge]; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `u'` UNABBREV_TAC; FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; REWRITE_TAC[PAIR_SPLIT]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; (* - *) USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); UND 0 THEN REWRITE_TAC[]; TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; REWRITE_TAC[sqrt_frac]; IMATCH_MP_TAC SQRT_MONO_LT; (* - *) USE 3 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); FIRST_ASSUM DISJ_CASES_TAC; IMATCH_MP_TAC (REAL_ARITH `(x < v /\ &0 <= u) ==> x < u + v` ); (* --B *) REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_DIV;ABS_N]; KILL 0; TYPE_THEN `!x y. x < abs y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC; REAL_ARITH_TAC; TYPE_THEN `&1 / &2 < (real_of_int (SND m) + &1 / &2) - v` ASM_CASES_TAC; DISJ1_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `&1 / &2` EXISTS_TAC; CONJ_TAC ; IMATCH_MP_TAC REAL_LE_DIV; REAL_ARITH_TAC; UND 9 THEN REAL_ARITH_TAC; (* -- *) TYPE_THEN `real_of_int (SND m) + &1 < v` BACK_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LT_TRANS; TYPE_THEN `real_of_int (SND m) + &1 - v` EXISTS_TAC; CONJ_TAC; TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC; REWRITE_TAC[REAL_LT_HALF2]; UND 11 THEN REAL_ARITH_TAC; UND 10 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE; UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t])); UND 10 THEN REAL_ARITH_TAC; (* -- *) PROOF_BY_CONTR_TAC; TYPE_THEN `v <= real_of_int (SND m) + &1` SUBAGOAL_TAC; UND 10 THEN REAL_ARITH_TAC; TYPE_THEN `real_of_int (SND m) <= v` SUBAGOAL_TAC; UND 9 THEN REAL_ARITH_TAC; TYPE_THEN `~(v = real_of_int (SND m) + &1)` SUBAGOAL_TAC; TYPE_THEN `v` UNABBREV_TAC; FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;]; UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC; TYPE_THEN `v < real_of_int (SND m) + &1` SUBAGOAL_TAC; UND 13 THEN UND 11 THEN ARITH_TAC; (* -- *) TYPE_THEN `floor v = (SND m')` SUBAGOAL_TAC; FULL_REWRITE_TAC[int_add_th;int_of_num_th]; ASM_REWRITE_TAC[floor_range]; UND 6 THEN REAL_ARITH_TAC; USE 15 SYM; TYPE_THEN `floor v = SND m` SUBAGOAL_TAC; REWRITE_TAC[floor_range]; ASM_MESON_TAC[]; (* -C different second coord *) IMATCH_MP_TAC (REAL_ARITH `x < y /\ &0 <= z ==> x < y + z`); REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; REDUCE_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `&1` EXISTS_TAC; CONJ_TAC; KILL 0; REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM]; REWRITE_TAC[REAL_LT_HALF2]; REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;]; UND 7 THEN INT_ARITH_TAC; ]);; (* }}} *) let connected_in_edge = prove_by_refinement( `!C. connected top2 C /\ C SUBSET (UNIONS edge) ==> (?e. edge e /\ C SUBSET e)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `C = EMPTY` ASM_CASES_TAC ; REWRITE_TAC[connected_empty]; TYPE_THEN `C` UNABBREV_TAC; TYPE_THEN `h_edge (&:0,&:0)` EXISTS_TAC; REWRITE_TAC[edge_h]; (* - *) TYPE_THEN `?e. edge e /\ ~(C INTER e = EMPTY)` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET;UNIONS;EMPTY_EXISTS]; TSPEC `u` 0; REWRITE_TAC[INTER ]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `e` EXISTS_TAC; FULL_REWRITE_TAC[connected;edge]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `A = open_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ; TYPE_THEN `B = closed_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ; TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ; UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`])); CONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC open_ball_open; CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[top2]; THM_INTRO_TAC[`top2`;`B`] closed_open ; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC closed_ball_closed; FULL_REWRITE_TAC[open_DEF;top2_unions;]; FULL_REWRITE_TAC[top2]; CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[EQ_EMPTY;INTER;DIFF]; UND 1 THEN REWRITE_TAC[]; ASM_MESON_TAC[open_ball_sub_closed;subset_imp;]; USE 0 (REWRITE_RULE[SUBSET;UNIONS]); REWRITE_TAC[SUBSET;UNION]; TSPEC `x` 0; REWRITE_TAC[]; TYPE_THEN `u = v_edge m` ASM_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; DISJ1_TAC; ASM_MESON_TAC[v_edge_ball;subset_imp ]; DISJ2_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[DIFF]; CONJ_TAC; FULL_REWRITE_TAC[top2_unions]; ASM_MESON_TAC[subset_imp]; UND 10 THEN REWRITE_TAC[]; IMATCH_MP_TAC v_edge_closed_ball; REWRITE_TAC[EMPTY_EXISTS;INTER]; ASM_MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; USE 0 (REWRITE_RULE[SUBSET;UNIONS]); REWRITE_TAC[SUBSET]; TSPEC `x` 0; REWRITE_TAC[]; TYPE_THEN `u = v_edge m` BACK_TAC ; ASM_MESON_TAC[]; IMATCH_MP_TAC v_edge_closed_ball; REWRITE_TAC[INTER;EMPTY_EXISTS ]; TYPE_THEN `x` EXISTS_TAC; ASM_MESON_TAC[open_ball_sub_closed;subset_imp]; USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]); PROOF_BY_CONTR_TAC; UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET]; TSPEC `u` 8; UND 8 THEN REWRITE_TAC[DE_MORGAN_THM]; DISJ2_TAC; ASM_MESON_TAC[v_edge_ball;subset_imp;open_ball_sub_closed]; (* -A *) TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `A = open_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ; TYPE_THEN `B = closed_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ; TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ; UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`])); CONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC open_ball_open; CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[top2]; THM_INTRO_TAC[`top2`;`B`] closed_open ; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC closed_ball_closed; FULL_REWRITE_TAC[open_DEF;top2_unions;]; FULL_REWRITE_TAC[top2]; CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[EQ_EMPTY;INTER;DIFF]; UND 1 THEN REWRITE_TAC[]; ASM_MESON_TAC[open_ball_sub_closed;subset_imp;]; USE 0 (REWRITE_RULE[SUBSET;UNIONS]); REWRITE_TAC[SUBSET;UNION]; TSPEC `x` 0; REWRITE_TAC[]; (* -- *) TYPE_THEN `u = h_edge m` ASM_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; DISJ1_TAC; ASM_MESON_TAC[h_edge_ball;subset_imp ]; DISJ2_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[DIFF]; CONJ_TAC; FULL_REWRITE_TAC[top2_unions]; ASM_MESON_TAC[subset_imp]; UND 10 THEN REWRITE_TAC[]; IMATCH_MP_TAC h_edge_closed_ball; REWRITE_TAC[EMPTY_EXISTS;INTER]; ASM_MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; USE 0 (REWRITE_RULE[SUBSET;UNIONS]); REWRITE_TAC[SUBSET]; TSPEC `x` 0; REWRITE_TAC[]; TYPE_THEN `u = h_edge m` BACK_TAC ; ASM_MESON_TAC[]; IMATCH_MP_TAC h_edge_closed_ball; REWRITE_TAC[INTER;EMPTY_EXISTS ]; TYPE_THEN `x` EXISTS_TAC; ASM_MESON_TAC[open_ball_sub_closed;subset_imp]; USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]); PROOF_BY_CONTR_TAC; (* - *) UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET]; TSPEC `u` 8; UND 8 THEN REWRITE_TAC[DE_MORGAN_THM]; DISJ2_TAC; ASM_MESON_TAC[h_edge_ball;subset_imp;open_ball_sub_closed]; (* - *) (* Mon Dec 20 15:16:18 EST 2004 *) ]);; (* }}} *) let int_pow2_gt1 = prove_by_refinement( `!x. ~(x = &:0) ==> &1 <= (real_of_int x) pow 2`, (* {{{ proof *) [ TYPE_THEN `&1 = &1 pow 2` SUBAGOAL_TAC ; REDUCE_TAC; UND 1 THEN DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]); REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS;GSYM int_le;GSYM int_abs_th ;GSYM int_of_num_th;]; UND 0 THEN INT_ARITH_TAC; ]);; (* }}} *) let d_euclid_pointI_pos = prove_by_refinement( `!m n. d_euclid (pointI m) (pointI n) < &1 ==> (m = n)`, (* {{{ proof *) [ REWRITE_TAC[pointI;d_euclid_point;PAIR_SPLIT]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; USE 0 (MATCH_MP (REAL_ARITH `x < y ==> ~(y <= x)`)); UND 0 THEN REWRITE_TAC[]; TYPE_THEN `&1 = sqrt(&1)` SUBAGOAL_TAC; ONCE_REWRITE_TAC [EQ_SYM_EQ]; IMATCH_MP_TAC SQRT_POS_UNIQ; REDUCE_TAC; UND 0 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); IMATCH_MP_TAC SQRT_MONO_LE; REDUCE_TAC; FULL_REWRITE_TAC[GSYM int_sub_th]; USE 1 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] INT_SUB_0]); FIRST_ASSUM DISJ_CASES_TAC; IMATCH_MP_TAC (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= x + y`); IMATCH_MP_TAC int_pow2_gt1; ASM_MESON_TAC[]; IMATCH_MP_TAC (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= y + x`); IMATCH_MP_TAC int_pow2_gt1; ASM_MESON_TAC[]; ]);; (* }}} *) extend_simp_rewrites[prove_by_refinement( `&0 < &1 / &2`, (* {{{ proof *) [ REWRITE_TAC[REAL_LT_HALF1]; ])];; (* }}} *) extend_simp_rewrites[prove_by_refinement( `&2 * &1/ &2 = &1`, (* {{{ proof *) [ IMATCH_MP_TAC REAL_DIV_LMUL; UND 0 THEN REAL_ARITH_TAC; ])];; (* }}} *) let totally_bounded_pointI = prove_by_refinement( `?eps. !x m n. (&0 (m = n)) `, (* {{{ proof *) [ TYPE_THEN `&1/ &2` EXISTS_TAC; REWRITE_TAC[]; IMATCH_MP_TAC d_euclid_pointI_pos; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`x`;`&1 / &2`] BALL_DIST; TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let simple_arc_finite_pointI = prove_by_refinement( `! e . simple_arc top2 e ==> (?X. FINITE X /\ (!m. e (pointI m) ==> X m))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`e`] simple_arc_compact; THM_INTRO_TAC[`e`] simple_arc_euclid; THM_INTRO_TAC[`e`;`d_euclid`] compact_totally_bounded; CONJ_TAC; THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace; THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] compact_subset; FULL_REWRITE_TAC[top2]; ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[totally_bounded]; THM_INTRO_TAC[] totally_bounded_pointI; TSPEC `eps` 3; RIGHT 4 "n"; RIGHT 4 "m"; RIGHT 4 "x"; REWRITE_TAC[]; TYPE_THEN `X = { m | ?b. B b /\ b (pointI m) }` ABBREV_TAC ; TYPE_THEN `X` EXISTS_TAC; (* - *) TYPE_THEN `!m. ?b. (X m) ==> (B b /\ b (pointI m))` SUBAGOAL_TAC; TYPE_THEN `X` UNABBREV_TAC; MESON_TAC[]; LEFT 9 "b"; CONJ_TAC; THM_INTRO_TAC[`X`;`B`;`b`] FINITE_INJ; REWRITE_TAC[INJ]; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; COPY 9; TSPEC `x` 13; TSPEC `y` 9; COPY 6; TSPEC `b x` 16; TSPEC `b y` 6; TYPE_THEN `x'` EXISTS_TAC; (* // *) TYPE_THEN `b y` UNABBREV_TAC; TYPE_THEN `b x` UNABBREV_TAC; THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace; THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`;`x'`;`eps`] open_ball_subspace; CONJ_TAC THEN ASM_MESON_TAC[subset_imp]; (* - *) TYPE_THEN `X` UNABBREV_TAC; FULL_REWRITE_TAC[UNIONS]; ASM_MESON_TAC[]; (* Mon Dec 20 18:39:42 EST 2004 *) ]);; (* }}} *) let simple_arc_finite_lemma1 = prove_by_refinement( `!e v v'. simple_arc_end e v v' ==> (?X f. (X SUBSET {x | &0 <= x /\ x <= &1}) /\ FINITE X /\ (f (&0) = v) /\ (f (&1) = v') /\ (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\ continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (!x. &0 <= x /\ x <= &1 ==> ( (?m. f x = pointI m) <=> (X x))))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_simple; THM_INTRO_TAC[`e`] simple_arc_finite_pointI; THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end; REWR 4; TYPE_THEN `Y = {x | &0 <= x /\ x <= &1 /\ (?m. (f x = pointI m))}` ABBREV_TAC ; TYPE_THEN `Y` EXISTS_TAC; TYPE_THEN `f` EXISTS_TAC; (* - *) SUBCONJ_TAC; TYPE_THEN`Y` UNABBREV_TAC; REWRITE_TAC[SUBSET]; (* - *) FULL_REWRITE_TAC[top2_unions]; CONJ_TAC; THM_INTRO_TAC[`Y`;`IMAGE (pointI) X`;`f`] FINITE_INJ; CONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE; FULL_REWRITE_TAC[INJ]; CONJ_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `Y` UNABBREV_TAC; TYPE_THEN `m` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USE 9 SYM; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `Y` UNABBREV_TAC; (* - *) TYPE_THEN `Y` UNABBREV_TAC; ]);; (* }}} *) let simple_arc_finite_lemma2 = prove_by_refinement( `!e v v'. simple_arc_end e v v'==> (?(N:num) t f. (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\ (f (&0) = v) /\ (f (&1) = v') /\ (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\ (!i j. (i < j) /\ (i < N) /\ (j < N) ==> (t i < t j)) /\ continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (!x. &0 <= x /\ x <= &1 ==> ( (?m. f x = pointI m) <=> (?k. (k < N) /\ (x = t k)))))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma1; THM_INTRO_TAC[`X`] real_finite_increase; TYPE_THEN `CARD X` EXISTS_TAC; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `f` EXISTS_TAC; (* - *) SUBCONJ_TAC; FULL_REWRITE_TAC[BIJ;IMAGE;SURJ]; FULL_REWRITE_TAC[SUBSET]; TSPEC `x'` 11; (* - *) SUBCONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) TSPEC `x` 1; REWR 1; FULL_REWRITE_TAC[BIJ;SURJ]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let connected_unions_common = prove_by_refinement( `!U (ZZ:(A->bool)->bool). (!Z. ZZ Z ==> connected U Z) /\ (!Z Z'. ZZ Z /\ ZZ Z' ==> ~(Z INTER Z' = EMPTY)) ==> (connected U (UNIONS ZZ))`, (* {{{ proof *) [ REWRITE_TAC[connected]; SUBCONJ_TAC; TYPE_THEN `UU = UNIONS U` ABBREV_TAC ; REWRITE_TAC[UNIONS;SUBSET]; TSPEC `u` 1; REWRITE_TAC[]; ASM_MESON_TAC[subset_imp]; (* - *) TYPE_THEN `!Z. ZZ Z ==> Z SUBSET A \/ Z SUBSET B` SUBAGOAL_TAC; TSPEC `Z` 1; REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; USE 2 (REWRITE_RULE[UNIONS;SUBSET]); REWRITE_TAC[SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; (* - *) TYPE_THEN `AA = {Z | ZZ Z /\ Z SUBSET A}` ABBREV_TAC ; TYPE_THEN `BB = {Z | ZZ Z /\ Z SUBSET B}` ABBREV_TAC ; TYPE_THEN `ZZ = AA UNION BB` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; TYPE_THEN `AA` UNABBREV_TAC; TYPE_THEN `BB` UNABBREV_TAC; ASM_MESON_TAC[]; PROOF_BY_CONTR_TAC; USE 11 (REWRITE_RULE[DE_MORGAN_THM;UNIONS;SUBSET;UNION]); LEFT 11 "x"; LEFT 12 "x"; TYPE_THEN `AA` UNABBREV_TAC; TYPE_THEN `BB` UNABBREV_TAC; LEFT 11 "u"; LEFT 8 "u"; LEFT 12 "u"; LEFT 9 "u"; (* - *) TYPE_THEN `ZZ u` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `ZZ u'` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `u SUBSET A` SUBAGOAL_TAC; TSPEC `u` 7; FIRST_ASSUM DISJ_CASES_TAC ; USE 13(REWRITE_RULE[SUBSET]); TSPEC `x` 13; ASM_MESON_TAC[]; TYPE_THEN `u' SUBSET B` SUBAGOAL_TAC; TSPEC `u'` 7; FIRST_ASSUM DISJ_CASES_TAC ; USE 14(REWRITE_RULE[SUBSET]); TSPEC `x'` 14; ASM_MESON_TAC[]; (* - *) UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`u`;`u'`]); USE 0 (REWRITE_RULE[EMPTY_EXISTS;INTER ]); USE 3(REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `u''` 3; ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let connect_real_open = prove_by_refinement( `!a b. connected (top_of_metric (UNIV,d_real)) {x | a < x /\ x < b}`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `{x | a < x /\ x < b} = EMPTY` ASM_CASES_TAC; REWRITE_TAC[connected_empty]; FULL_REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `ZZ = {Z | ?a' b'. a < a' /\ a' < u /\ u < b' /\ b' < b /\ (Z = {x | a' <= x /\ x <= b'})}` ABBREV_TAC ; TYPE_THEN `{x | a < x /\ x < b} = UNIONS ZZ` SUBAGOAL_TAC; TYPE_THEN `ZZ` UNABBREV_TAC; REWRITE_TAC[UNIONS]; IMATCH_MP_TAC EQ_EXT; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "x'"); TYPE_THEN `u < x` ASM_CASES_TAC; TYPE_THEN `(a + u)/ &2` EXISTS_TAC; TYPE_THEN `x` EXISTS_TAC; SUBCONJ_TAC; IMATCH_MP_TAC real_middle1_lt; SUBCONJ_TAC; IMATCH_MP_TAC real_middle2_lt; UND 6 THEN UND 4 THEN REAL_ARITH_TAC; TYPE_THEN `(a + x)/ &2` EXISTS_TAC; TYPE_THEN `(u + b)/ &2` EXISTS_TAC; SUBCONJ_TAC; IMATCH_MP_TAC real_middle1_lt; SUBCONJ_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `x` EXISTS_TAC; USE 4 (MATCH_MP (REAL_ARITH `~(u < x) ==> (x <= u)`)); IMATCH_MP_TAC real_middle2_lt; SUBCONJ_TAC; IMATCH_MP_TAC real_middle1_lt; CONJ_TAC; IMATCH_MP_TAC real_middle2_lt; CONJ_TAC; IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); IMATCH_MP_TAC real_middle2_lt; UND 4 THEN UND 7 THEN REAL_ARITH_TAC; (* -- *) TYPE_THEN `u'` UNABBREV_TAC; UND 7 THEN UND 3 THEN UND 2 THEN UND 4 THEN REAL_ARITH_TAC; (* - *) IMATCH_MP_TAC connected_unions_common; CONJ_TAC; TYPE_THEN `ZZ` UNABBREV_TAC; REWRITE_TAC[connect_real]; TYPE_THEN `ZZ` UNABBREV_TAC; TYPE_THEN `Z` UNABBREV_TAC; TYPE_THEN `Z'` UNABBREV_TAC; USE 4(REWRITE_RULE[EQ_EMPTY;INTER]); TSPEC `u` 2; KILL 3; REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; ]);; (* }}} *) let int_neg_num_th = prove_by_refinement( `!j. real_of_int (--: (&: j)) = -- (&j)`, (* {{{ proof *) [ REWRITE_TAC[int_neg_th;int_of_num_th;]; ]);; (* }}} *) let closed_ball_subset_larger_open = prove_by_refinement( `!n a r r'. (r < r') ==> closed_ball (euclid n,d_euclid) a r SUBSET open_ball (euclid n,d_euclid) a r'`, (* {{{ proof *) [ REWRITE_TAC[closed_ball;open_ball;SUBSET]; UND 3 THEN UND 0 THEN REAL_ARITH_TAC; ]);; (* }}} *) let simple_arc_end_edge_closure = prove_by_refinement( `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\ (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==> (closure top2 e (pointI m))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`e`] edge_euclid2; FULL_REWRITE_TAC[edge]; TYPE_THEN `connected top2 C` SUBAGOAL_TAC; USE 1 (MATCH_MP simple_arc_end_simple); USE 1(MATCH_MP simple_arc_connected); PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`e`] closure_open_ball; USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `(pointI m)` 6; USE 5 (REWRITE_RULE[top2]); UND 6 THEN ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; (* - *) TYPE_THEN `?r. &0 < r /\ (r < &1/ &2) /\ (e INTER closed_ball (euclid 2, d_euclid) (pointI m) r = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `?s. &0 < s /\ s <= r /\ s <= &1/ &2` SUBAGOAL_TAC; TYPE_THEN `min_real r (&1 / &2)` EXISTS_TAC; REWRITE_TAC[min_real_le]; REWRITE_TAC[min_real]; COND_CASES_TAC; TYPE_THEN `s/ &2` EXISTS_TAC; ASM_REWRITE_TAC[REAL_LT_HALF1]; CONJ_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `s` EXISTS_TAC; REWRITE_TAC[REAL_LT_HALF2]; REWRITE_TAC[EQ_EMPTY;INTER]; LEFT 7 "z"; TSPEC `x` 7; UND 7 THEN ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `s/ &2 < r` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `s` EXISTS_TAC; REWRITE_TAC[REAL_LT_HALF2]; THM_INTRO_TAC[`2`;`pointI m`;`s / &2`;`r`] closed_ball_subset_larger_open; ASM_MESON_TAC[subset_imp]; (* - *) THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct; FULL_REWRITE_TAC[connected]; TYPE_THEN `A = open_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ; TYPE_THEN `B = closed_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ; TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ; (* -A *) TYPE_THEN `top2 A /\ top2 E /\ (A INTER E = {}) /\ C SUBSET A UNION E /\ A (pointI m) /\ E (pointI n)` SUBAGOAL_TAC; CONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC open_ball_open; CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[top2]; THM_INTRO_TAC[`top2`;`B`] closed_open; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC closed_ball_closed; FULL_REWRITE_TAC[open_DEF;top2_unions ]; FULL_REWRITE_TAC[top2]; (* --// *) CONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[INTER;EQ_EMPTY;DIFF]; ASM_MESON_TAC[subset_imp;open_ball_sub_closed]; (* -- *) TYPE_THEN `A (pointI m)` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC (INR open_ball_nonempty); REWRITE_TAC[pointI]; (* -- *) TYPE_THEN `E (pointI n)` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[DIFF]; TYPE_THEN `B` UNABBREV_TAC; CONJ_TAC; REWRITE_TAC[pointI]; FULL_REWRITE_TAC[pointI_inj]; TYPE_THEN `open_ball (euclid 2,d_euclid) (pointI m) (&1 / &2) (pointI n)` SUBAGOAL_TAC; THM_INTRO_TAC[`2`;`pointI m`;`r'`;`&1 / &2`] closed_ball_subset_larger_open; ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`pointI m`;`&1 / &2`] BALL_DIST; IMATCH_MP_TAC (INR open_ball_nonempty); REWRITE_TAC[pointI]; TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC; REWR 17; USE 17 (MATCH_MP d_euclid_pointI_pos); TYPE_THEN `m` UNABBREV_TAC; (* --// *) REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC; TSPEC `x` 0; ASM_MESON_TAC[]; UND 19 THEN REP_CASES_TAC; DISJ2_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[DIFF]; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; ASM_MESON_TAC[subset_imp]; DISJ1_TAC; DISJ2_TAC; (* - *) UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`E`]); (* -B *) TYPE_THEN `C (pointI m)` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_end; UNIFY_EXISTS_TAC; TYPE_THEN `C (pointI n)` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_end2; UNIFY_EXISTS_TAC; USE 19 (REWRITE_RULE[INTER;EQ_EMPTY ]); FIRST_ASSUM DISJ_CASES_TAC; USE 24 (REWRITE_RULE[SUBSET]); (* -- *) ASM_MESON_TAC[]; USE 24 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; ]);; (* }}} *) let vc_edge_pointI = prove_by_refinement( `!m n. vc_edge m (pointI n) <=> (n = m) \/ (n = up m)`, (* {{{ proof *) [ REWRITE_TAC[vc_edge;cell_clauses;INR IN_SING;UNION]; TYPE_THEN `pointI m + e2 = pointI (up m)` SUBAGOAL_TAC; REWRITE_TAC[up;e2;point_add ;pointI]; REDUCE_TAC; REWRITE_TAC[int_of_num_th;int_add_th]; REWRITE_TAC[pointI_inj]; ]);; (* }}} *) let hc_edge_pointI = prove_by_refinement( `!m n. hc_edge m (pointI n) <=> (n = m) \/ (n = right m)`, (* {{{ proof *) [ REWRITE_TAC[hc_edge;cell_clauses;INR IN_SING;UNION]; TYPE_THEN `pointI m + e1 = pointI (right m)` SUBAGOAL_TAC; REWRITE_TAC[right;e1;point_add ;pointI]; REDUCE_TAC; REWRITE_TAC[int_of_num_th;int_add_th]; REWRITE_TAC[pointI_inj]; ]);; (* }}} *) let mk_segment_v = prove_by_refinement( `!r s b x. (r <= s) ==> (mk_segment (point(b,r)) (point(b,s)) x <=> (?t. (r <= t /\ t <= s /\ (x = point(b,t)))))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[mk_segment]; REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC; CONJ_TAC; ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`; ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`; TYPE_THEN `s = r` ASM_CASES_TAC; REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`]; TYPE_THEN `&0` EXISTS_TAC; UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC; (* - *) REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ; TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC; TYPE_THEN `v` UNABBREV_TAC; REWRITE_TAC[GSYM real_div_assoc]; REDUCE_TAC; IMATCH_MP_TAC REAL_DIV_REFL; UND 5 THEN UND 4 THEN REAL_ARITH_TAC; TYPE_THEN `v*(s - t)` EXISTS_TAC; TYPE_THEN `&0 < v` SUBAGOAL_TAC; TYPE_THEN `v` UNABBREV_TAC; IMATCH_MP_TAC REAL_LT_DIV; UND 4 THEN UND 0 THEN REAL_ARITH_TAC; (* - *) CONJ_TAC; IMATCH_MP_TAC REAL_LE_MUL; UND 7 THEN UND 2 THEN REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_LCANCEL_IMP; TYPE_THEN `(s - r)` EXISTS_TAC; CONJ_TAC; UND 4 THEN UND 0 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_ASSOC]; REDUCE_TAC; UND 3 THEN REAL_ARITH_TAC; TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC]; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ]);; (* }}} *) let mk_segment_vc = prove_by_refinement( `!m. mk_segment (pointI m) (pointI (up m)) = vc_edge m`, (* {{{ proof *) [ REWRITE_TAC[up;vc_edge;v_edge;pointI;UNION ;e2;]; IMATCH_MP_TAC EQ_EXT; THM_INTRO_TAC[`real_of_int (SND m)`;`real_of_int(SND m + &:1)`;`real_of_int (FST m)`;`x`] mk_segment_v; REWRITE_TAC[GSYM int_le]; INT_ARITH_TAC; REWRITE_TAC[point_add;]; REDUCE_TAC; (* - *) IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; REWRITE_TAC[point_inj;PAIR_SPLIT ]; TYPE_THEN `t = real_of_int (SND m)` ASM_CASES_TAC; REWRITE_TAC[INR IN_SING]; TYPE_THEN `t = real_of_int (SND m) + &1` ASM_CASES_TAC; REWRITE_TAC[INR IN_SING]; DISJ1_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); FULL_REWRITE_TAC[int_add_th;int_of_num_th;]; UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC; (* - *) UND 1 THEN REP_CASES_TAC ; TYPE_THEN `v` EXISTS_TAC; UND 2 THEN UND 3 THEN REAL_ARITH_TAC; FULL_REWRITE_TAC [INR IN_SING]; TYPE_THEN `real_of_int (SND m)` EXISTS_TAC; REWRITE_TAC[int_add_th;int_of_num_th]; REAL_ARITH_TAC; FULL_REWRITE_TAC [INR IN_SING]; TYPE_THEN `real_of_int (SND m) + &1` EXISTS_TAC; REWRITE_TAC[int_add_th;int_of_num_th]; REAL_ARITH_TAC; (* Tue Dec 21 18:22:18 EST 2004 *) ]);; (* }}} *) let mk_segment_hc = prove_by_refinement( `!m. mk_segment (pointI m) (pointI (right m)) = hc_edge m`, (* {{{ proof *) [ REWRITE_TAC[right;hc_edge;h_edge;pointI;UNION ;e1;]; IMATCH_MP_TAC EQ_EXT; THM_INTRO_TAC[`real_of_int (FST m)`;`real_of_int(FST m + &:1)`;`real_of_int (SND m)`;`x`] mk_segment_h; REWRITE_TAC[int_add_th;int_of_num_th;]; REAL_ARITH_TAC; REWRITE_TAC[point_add;]; REDUCE_TAC; FULL_REWRITE_TAC[int_add_th;int_of_num_th;]; (* - *) REWRITE_TAC[INR IN_SING]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; REWRITE_TAC[point_inj;PAIR_SPLIT ]; TYPE_THEN `t = real_of_int (FST m)` ASM_CASES_TAC; TYPE_THEN `t = real_of_int (FST m) + &1` ASM_CASES_TAC; CONV_TAC (dropq_conv "u"); CONV_TAC (dropq_conv "v"); UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC; (* - *) UND 1 THEN REP_CASES_TAC ; TYPE_THEN `u` EXISTS_TAC; UND 2 THEN UND 3 THEN REAL_ARITH_TAC; TYPE_THEN `real_of_int (FST m)` EXISTS_TAC; REAL_ARITH_TAC; TYPE_THEN `real_of_int (FST m) + &1` EXISTS_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let simple_arc_end_edge_full_closure = prove_by_refinement( `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\ (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==> (C = closure top2 e ) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`;`e`;`m`;`n`] simple_arc_end_edge_closure; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`e`;`n`;`m`] simple_arc_end_edge_closure; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) TYPE_THEN `C SUBSET closure top2 e` SUBAGOAL_TAC; REWRITE_TAC[SUBSET]; TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC; ASM_MESON_TAC[]; UND 6 THEN REP_CASES_TAC; THM_INTRO_TAC[`top2`;`e`] subset_closure; REWRITE_TAC[top2_top]; ASM_MESON_TAC[subset_imp]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `B = closure top2 e` ABBREV_TAC ; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `pointI m` EXISTS_TAC; TYPE_THEN `pointI n` EXISTS_TAC; REWRITE_TAC[SUBSET_REFL]; TYPE_THEN `simple_arc_end B (pointI m) (pointI n)` BACK_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; (* -A *) THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct; FULL_REWRITE_TAC[pointI_inj]; (* - *) TYPE_THEN `mk_segment (pointI m) (pointI n) = B` SUBAGOAL_TAC ; FULL_REWRITE_TAC[edge]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;]; TYPE_THEN `B` UNABBREV_TAC; TYPE_THEN `(m = m') /\ (n = up m') \/ (m = up m') /\ (n = m')` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[vc_edge_pointI;]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `n` UNABBREV_TAC; REWR 3; TYPE_THEN `n` UNABBREV_TAC; ASM_MESON_TAC[]; (* --- *) REWRITE_TAC[GSYM mk_segment_vc]; FIRST_ASSUM DISJ_CASES_TAC; MESON_TAC[mk_segment_sym]; (* -- *) TYPE_THEN `e` UNABBREV_TAC; FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;]; TYPE_THEN `B` UNABBREV_TAC; TYPE_THEN `(m = m') /\ (n = right m') \/ (m = right m') /\ (n = m')` SUBAGOAL_TAC; RULE_ASSUM_TAC (REWRITE_RULE[hc_edge_pointI;]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `n` UNABBREV_TAC; REWR 3; TYPE_THEN `n` UNABBREV_TAC; ASM_MESON_TAC[]; (* -- *) REWRITE_TAC[GSYM mk_segment_hc]; FIRST_ASSUM DISJ_CASES_TAC; MESON_TAC[mk_segment_sym]; KILL 6; TYPE_THEN `B` UNABBREV_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; REWRITE_TAC[pointI_inj]; REWRITE_TAC[pointI]; ]);; (* }}} *) let simple_arc_finite_lemma3 = prove_by_refinement( `!E e v v'. simple_arc_end e v v' /\ FINITE E /\ e SUBSET UNIONS E /\ E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\ E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\ (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\ (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==> (?(N:num) t f. (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\ (f (&0) = v) /\ (f (&1) = v') /\ (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\ (!i j. (i < j) /\ (i < N) /\ (j < N) ==> (t i < t j)) /\ continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (!x. &0 <= x /\ x <= &1 ==> ( (?m. f x = pointI m) = (?k. (k < N) /\ (x = t k)))) /\ (&0 = t 0) /\ (&1 = t (N - 1)) /\ (!i. (SUC i < N) ==> (?ed. (edge ed) /\ (IMAGE f { x | t i <= x /\ x <= t (SUC i) } = closure top2 ed)))) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma2; TYPE_THEN `N` EXISTS_TAC; TYPE_THEN `t` EXISTS_TAC; TYPE_THEN `f` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC; COPY 0; COPY 1; TSPEC `eps_hyper F (w 1)` 21; TSPEC `eps_hyper T (w 0)` 1; TSPEC `z` 20; TSPEC `eps` 20; TSPEC `z'` 0; TSPEC `eps'` 0; FULL_REWRITE_TAC[eps_hyper_inj]; TYPE_THEN `z` UNABBREV_TAC; TYPE_THEN `z'` UNABBREV_TAC; TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; REWRITE_TAC[pointI]; TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC; REWRITE_TAC[int_neg;int_abstr;int_of_num_th;]; TYPE_THEN `!j. (integer (-- &j))` SUBAGOAL_TAC; REWRITE_TAC[is_int]; MESON_TAC[]; USE 24 (REWRITE_RULE[int_rep]); USE 19 (MATCH_MP point_onto); REWRITE_TAC[point_inj]; TYPE_THEN `w` UNABBREV_TAC; FULL_REWRITE_TAC[coord01;PAIR_SPLIT]; (* -A *) SUBCONJ_TAC; TYPE_THEN `?m. v = pointI m` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end; USE 8 (MATCH_MP simple_arc_end_simple); USE 8 (MATCH_MP simple_arc_euclid); ASM_MESON_TAC[subset_imp]; UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&0`])); REDUCE_TAC; TYPE_THEN `(?k. k <| N /\ (&0 = t k))` SUBAGOAL_TAC; USE 9 SYM; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[]; AP_TERM_TAC; IMATCH_MP_TAC (ARITH_RULE `~(0 < k) ==> (k = 0)`); USE 16 (REWRITE_RULE[IMAGE;SUBSET ]); USE 16 (CONV_RULE NAME_CONFLICT_CONV); TSPEC `t 0` 16; LEFT 16 "x'" ; TSPEC `0` 16; TYPE_THEN `0 < N` SUBAGOAL_TAC; UND 21 THEN UND 20 THEN ARITH_TAC; REWR 16; USE 23 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`)); UND 23 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; (* -B *) SUBCONJ_TAC; TYPE_THEN `?m. v' = pointI m` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end2; USE 8 (MATCH_MP simple_arc_end_simple); USE 8 (MATCH_MP simple_arc_euclid); ASM_MESON_TAC[subset_imp]; UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&1`])); REDUCE_TAC; REWRITE_TAC[ARITH_RULE `1 <= 1`]; USE 18 SYM; REDUCE_TAC; (* -- *) TYPE_THEN `(?k. k <| N /\ (&1 = t k))` SUBAGOAL_TAC; USE 9 SYM; TYPE_THEN `m` EXISTS_TAC; ASM_REWRITE_TAC[]; AP_TERM_TAC; IMATCH_MP_TAC (ARITH_RULE `(k < N) /\ ~(k < N - 1) ==> (k = N - 1)`); USE 16 (REWRITE_RULE[IMAGE;SUBSET ]); USE 22 (CONV_RULE NAME_CONFLICT_CONV); TSPEC `t (N-1)` 22; LEFT 22 "x'" ; TSPEC `N-1` 22; UND 22 THEN DISCH_THEN (THM_INTRO_TAC[]); UND 21 THEN ARITH_TAC; REWR 22; USE 22 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`)); UND 22 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; UND 16 THEN ARITH_TAC; (* -C *) USE 20 SYM; USE 18 SYM; TYPE_THEN `&0 <= t i /\ t i <= &1` SUBAGOAL_TAC; USE 16 (REWRITE_RULE[SUBSET;IMAGE]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; UND 19 THEN ARITH_TAC; (* - *) TYPE_THEN `&0 <= t (SUC i) /\ t (SUC i) <= &1` SUBAGOAL_TAC; USE 16 (REWRITE_RULE[SUBSET;IMAGE]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `SUC i` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `connected top2 (IMAGE f {x | t i < x /\ x < t (SUC i)})` SUBAGOAL_TAC; IMATCH_MP_TAC connect_image; TYPE_THEN `top_of_metric (UNIV,d_real)` EXISTS_TAC; REWRITE_TAC[top2_unions]; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET]; USE 10 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 26 THEN UND 27 THEN UND 23 THEN UND 22 THEN REAL_ARITH_TAC; (* --D *) REWRITE_TAC[connect_real_open]; (* - *) TYPE_THEN `!x. &0 <= x /\ x <= &1 /\ ~(IMAGE t {j | j<| N} x) ==> (?e. edge e /\ (e (f x)))` SUBAGOAL_TAC; TYPE_THEN `e` UNABBREV_TAC; USE 6 (REWRITE_RULE[SUBSET;UNIONS;IMAGE ]); USE 6 (CONV_RULE NAME_CONFLICT_CONV); TSPEC `f x` 6; UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]); TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; TSPEC `u'` 1; REWRITE_TAC[]; TYPE_THEN `u'` UNABBREV_TAC; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`z`;`eps`]); TYPE_THEN `z` UNABBREV_TAC; (* --E *) TYPE_THEN `euclid 2 (f x)` SUBAGOAL_TAC; USE 8 (MATCH_MP simple_arc_end_simple); USE 0 (MATCH_MP simple_arc_euclid); USE 0 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; TYPE_THEN `?C. cell C /\ C (f x)` SUBAGOAL_TAC; USE 0 (MATCH_MP point_onto); THM_INTRO_TAC[`p`] cell_unions; USE 1 (REWRITE_RULE[UNIONS]); TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `C` EXISTS_TAC; FULL_REWRITE_TAC[cell]; UND 29 THEN REP_CASES_TAC; TYPE_THEN `C` UNABBREV_TAC; FULL_REWRITE_TAC[INR IN_SING]; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); TYPE_THEN `(?k. k <| N /\ (x = t k))` SUBAGOAL_TAC; USE 9 SYM; UNIFY_EXISTS_TAC; TYPE_THEN `x` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 26 THEN REWRITE_TAC[]; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; REWRITE_TAC[edge_h]; REWRITE_TAC[edge_v]; TYPE_THEN `C` UNABBREV_TAC; USE 1 (REWRITE_RULE[squ]); TYPE_THEN `f x` UNABBREV_TAC; USE 6 (REWRITE_RULE[eps_hyper]); UND 6 THEN COND_CASES_TAC; FULL_REWRITE_TAC[e1]; FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_F]; FULL_REWRITE_TAC[point_inj]; TYPE_THEN `p'` UNABBREV_TAC; TYPE_THEN `u` UNABBREV_TAC; (* ---F *) FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;]; UND 30 THEN UND 31 THEN INT_ARITH_TAC; (* -- *) FULL_REWRITE_TAC[e2]; FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_S]; FULL_REWRITE_TAC[point_inj]; TYPE_THEN `p'` UNABBREV_TAC; TYPE_THEN `v''` UNABBREV_TAC; FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;]; UND 1 THEN UND 29 THEN INT_ARITH_TAC; (* -G *) THM_INTRO_TAC[`(IMAGE f {x | t i < x /\ x < t (SUC i)})`] connected_in_edge; REWRITE_TAC[IMAGE;SUBSET;UNIONS]; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; UND 29 THEN UND 22 THEN REAL_ARITH_TAC; CONJ_TAC; UND 23 THEN UND 28 THEN REAL_ARITH_TAC; USE 30 (REWRITE_RULE[IMAGE]); TYPE_THEN `x'` UNABBREV_TAC; USE 28 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`)); UND 30 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC (ARITH_RULE `~(x = y) /\ ~(x <| y) ==> (y < x)`); CONJ_TAC; TYPE_THEN `x''` UNABBREV_TAC; USE 29 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`)); UND 32 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i <| N` SUBAGOAL_TAC; UND 19 THEN ARITH_TAC; IMATCH_MP_TAC (ARITH_RULE `~(x = y) /\ ~(x <| y) ==> (y < x)`); CONJ_TAC; TYPE_THEN `x''` UNABBREV_TAC; UND 33 THEN UND 30 THEN ARITH_TAC; (* - *) TYPE_THEN `e'` EXISTS_TAC; (* -H *) TYPE_THEN `C = IMAGE f {x | t i <= x /\ x <= t (SUC i)}` ABBREV_TAC ; IMATCH_MP_TAC simple_arc_end_edge_full_closure; KILL 5; KILL 4; KILL 2; KILL 3; KILL 0; KILL 17; TYPE_THEN `v` UNABBREV_TAC; TYPE_THEN `v'` UNABBREV_TAC; TYPE_THEN `!k. k <| N ==> (?m. f (t k) = pointI m)` SUBAGOAL_TAC; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`t k`]); USE 16 (REWRITE_RULE[IMAGE;SUBSET]); ASM_MESON_TAC[]; TYPE_THEN `k` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) COPY 0; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); UND 19 THEN ARITH_TAC; UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]); TYPE_THEN `m` EXISTS_TAC; TYPE_THEN `m'` EXISTS_TAC; IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); CONJ_TAC; TYPE_THEN `C` UNABBREV_TAC; USE 5 (REWRITE_RULE[IMAGE]); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `pointI m` UNABBREV_TAC; TYPE_THEN `pointI m'` UNABBREV_TAC; USE 27 (REWRITE_RULE[IMAGE;SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `~(x' = t i)` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `~(x' = t (SUC i))` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; UND 5 THEN UND 2 THEN UND 15 THEN UND 14 THEN REAL_ARITH_TAC; (* - *) REWRITE_TAC[simple_arc_end]; THM_INTRO_TAC[`&0`;`&1`;`t i`;`t (SUC i)`;`C`;`f`;`t i`;`t (SUC i)`] arc_restrict; REWRITE_TAC[REAL_ARITH `x <= x`]; USE 11 (REWRITE_RULE[top2]); CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 19 THEN ARITH_TAC; IMATCH_MP_TAC inj_subset_domain; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET]; UND 4 THEN UND 5 THEN UND 22 THEN UND 23 THEN REAL_ARITH_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[top2]; (* Tue Dec 21 19:05:25 EST 2004 *) ]);; (* }}} *) let order_lt_imp_psegment = prove_by_refinement( `!f n. INJ f {p | p <| n} edge /\ 0 <| n /\ (!i j. i <| n /\ j <| n /\ (i < j) ==> (adj (f i) (f j) = (SUC i = j) )) ==> psegment (IMAGE f {p | p <| n})`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC order_imp_psegment; REP_BASIC_TAC; TYPE_THEN `i <| j` ASM_CASES_TAC; TYPE_THEN `~(SUC j = i)` SUBAGOAL_TAC; UND 6 THEN UND 5 THEN ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i = j` ASM_CASES_TAC; REWRITE_TAC[adj]; UND 7 THEN ARITH_TAC; TYPE_THEN `j <| i` SUBAGOAL_TAC; UND 6 THEN UND 5 THEN ARITH_TAC; TYPE_THEN `~(SUC i = j)` SUBAGOAL_TAC; UND 8 THEN UND 7 THEN ARITH_TAC; ONCE_REWRITE_TAC[adj_symm]; FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let simple_arc_finite_lemma4 = prove_by_refinement( `!E e v v'. simple_arc_end e v v' /\ FINITE E /\ e SUBSET UNIONS E /\ E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\ E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\ (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\ (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==> (?S a b. segment_end S a b /\ (v = pointI a) /\ (v' = pointI b) /\ (e = closure top2 (UNIONS S))) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`;`e`;`v`;`v'`]simple_arc_finite_lemma3; ASM_REWRITE_TAC[]; (* - *) REWRITE_TAC[segment_end]; LEFT 9 "ed"; LEFT 9 "ed"; TYPE_THEN `S = IMAGE ed {p | p <| N - 1}` ABBREV_TAC ; TYPE_THEN `S` EXISTS_TAC; TYPE_THEN `!i. i <| N ==> (?m. f (t i) = pointI m)` SUBAGOAL_TAC; USE 10 SYM; USE 11 SYM; UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`t i`]); USE 19 (REWRITE_RULE[IMAGE;SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `0 <| N` SUBAGOAL_TAC; IMATCH_MP_TAC (ARITH_RULE `~(N = 0) ==> (0 <| N)`); TYPE_THEN `N` UNABBREV_TAC; FULL_REWRITE_TAC[ARITH_RULE `0 -| 1 = 0`]; UND 10 THEN UND 11 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `?a. f (t 0) = pointI a` SUBAGOAL_TAC; TYPE_THEN `?b. f (t (N - 1)) = pointI b` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 22 THEN ARITH_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; (* - *) TYPE_THEN `v = pointI a` SUBAGOAL_TAC; TYPE_THEN `v` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `v' = pointI b` SUBAGOAL_TAC; TYPE_THEN `v'` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* -A *) TYPE_THEN `(INJ ed {p | p <| N-1 } edge) /\ ( 0 <| N-1) /\ (!i j. i <| N-1 /\ j <| N-1 /\ i <| j ==> (adj (ed i) (ed j) <=> (SUC i = j)))` SUBAGOAL_TAC; TYPE_THEN `S` UNABBREV_TAC; SUBCONJ_TAC; (* // *) REWRITE_TAC[INJ]; CONJ_TAC; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); UND 20 THEN ARITH_TAC; TYPE_THEN `!x y. x < y /\ y <| N - 1 ==> ~(ed x = ed y)` SUBAGOAL_TAC; TYPE_THEN `t x' < t y'` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 31 THEN UND 30 THEN ARITH_TAC; COPY 9; UND 33 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); UND 31 THEN UND 30 THEN ARITH_TAC; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`y'`]); UND 30 THEN ARITH_TAC; TYPE_THEN `ed x'` UNABBREV_TAC; TYPE_THEN `IMAGE f {x | t x' <= x /\ x <= t (SUC x')} (f (t x'))` SUBAGOAL_TAC; USE 33 SYM; IMATCH_MP_TAC image_imp; CONJ_TAC; REAL_ARITH_TAC; IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); FIRST_ASSUM IMATCH_MP_TAC ; UND 31 THEN UND 30 THEN ARITH_TAC; TYPE_THEN `IMAGE f {x | t y' <= x /\ x <= t (SUC y')} (f (t x'))` SUBAGOAL_TAC; USE 33 SYM; ASM_REWRITE_TAC[]; USE 36 (REWRITE_RULE[IMAGE]); USE 13 (REWRITE_RULE[INJ]); TYPE_THEN `t x' = x''` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USE 11 SYM; USE 10 SYM; USE 19 (REWRITE_RULE[IMAGE;SUBSET]); CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` EXISTS_TAC; UND 31 THEN UND 30 THEN ARITH_TAC; TYPE_THEN `&0 <= t y' /\ t y' <= &1` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `y'` EXISTS_TAC; UND 30 THEN ARITH_TAC; CONJ_TAC; UND 41 THEN UND 38 THEN ARITH_TAC; TYPE_THEN `&0 <= t (SUC y') /\ t (SUC y') <= &1` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `SUC y'` EXISTS_TAC; UND 30 THEN ARITH_TAC; UND 42 THEN UND 37 THEN ARITH_TAC; TYPE_THEN `x''` UNABBREV_TAC; UND 38 THEN UND 32 THEN REAL_ARITH_TAC; IMATCH_MP_TAC (ARITH_RULE `(~(x <| y) /\ ~(y < x)) ==> (x = y)`); CONJ_TAC; UND 30 THEN UND 29 THEN UND 27 THEN UND 20 THEN MESON_TAC[]; UND 30 THEN UND 29 THEN UND 28 THEN UND 20 THEN MESON_TAC[]; (* -- *) SUBCONJ_TAC; IMATCH_MP_TAC (ARITH_RULE `~(0 = N-1) ==> (0 <| N- 1)`); TYPE_THEN `N -| 1` UNABBREV_TAC; UND 10 THEN UND 11 THEN REAL_ARITH_TAC; (* --B *) TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); UND 31 THEN ARITH_TAC; USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `u` 9; USE 9 SYM; REWRITE_TAC[IMAGE]; REWRITE_TAC[CONJ_ACI]; (* -- *) REWRITE_TAC[adj;EMPTY_EXISTS;INTER ]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `x = x'` SUBAGOAL_TAC; USE 13 (REWRITE_RULE[INJ]); USE 10 SYM; USE 11 SYM; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC; USE 19 (REWRITE_RULE[IMAGE;SUBSET]); TYPE_THEN `&0 <= t j' /\ t j' <= &1` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j'` EXISTS_TAC; UND 41 THEN ARITH_TAC; TYPE_THEN `&0 <= t (SUC j') /\ t (SUC j') <= &1` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `SUC j'` EXISTS_TAC; UND 41 THEN ARITH_TAC; UND 44 THEN UND 39 THEN UND 43 THEN UND 40 THEN REAL_ARITH_TAC; CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `j` EXISTS_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `t i < t j` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN UND 29 THEN ARITH_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `t j <= t (SUC i)` SUBAGOAL_TAC; UND 35 THEN UND 33 THEN REAL_ARITH_TAC; USE 40 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`)); UND 40 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; UND 39 THEN UND 27 THEN UND 28 THEN UND 29 THEN ARITH_TAC; (* -- *) TYPE_THEN `j` UNABBREV_TAC; CONJ_TAC; TYPE_THEN `i = SUC i` SUBAGOAL_TAC; USE 20 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UND 33 THEN ARITH_TAC; TYPE_THEN `f (t (SUC i))` EXISTS_TAC; CONJ_TAC; TYPE_THEN `t (SUC i)` EXISTS_TAC; REWRITE_TAC[REAL_ARITH `x <= x`]; IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN ARITH_TAC; TYPE_THEN `t (SUC i)` EXISTS_TAC; REWRITE_TAC[REAL_ARITH `x <= x`]; IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN ARITH_TAC; (* - *) TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC; UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); UND 30 THEN ARITH_TAC; USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `u` 9; USE 9 SYM; REWRITE_TAC[IMAGE]; REWRITE_TAC[CONJ_ACI]; (* - *) USE 11 SYM; USE 10 SYM; TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC; USE 19 (REWRITE_RULE[IMAGE;SUBSET]); TYPE_THEN `&0 <= t j /\ t j <= &1` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` EXISTS_TAC; UND 33 THEN ARITH_TAC; TYPE_THEN `&0 <= t (SUC j) /\ t (SUC j) <= &1` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `SUC j` EXISTS_TAC; UND 33 THEN ARITH_TAC; UND 36 THEN UND 31 THEN UND 35 THEN UND 32 THEN REAL_ARITH_TAC; (* -C *) ONCE_REWRITE_TAC[CONJ_ACI]; SUBCONJ_TAC; THM_INTRO_TAC[`ed`;`N-| 1`] order_lt_imp_psegment; ASM_REWRITE_TAC[]; TYPE_THEN `S` UNABBREV_TAC; (* - *) TYPE_THEN `{a, b} SUBSET endpoint S` SUBAGOAL_TAC; REWRITE_TAC[SUBSET;INR in_pair]; REWRITE_TAC[endpoint]; THM_INTRO_TAC[`S`;`pointI x`] num_closure1; USE 32 (REWRITE_RULE[psegment;segment]); FIRST_ASSUM DISJ_CASES_TAC; (* // *) TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `ed (N -2)` EXISTS_TAC; TYPE_THEN `S` UNABBREV_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `e'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `x' < N -| 2` SUBAGOAL_TAC; IMATCH_MP_TAC (ARITH_RULE `x' < N -| 1 /\ ~(x' = N-2) ==> x' < N -2`); PROOF_BY_CONTR_TAC; REWR 37; TYPE_THEN `x'` UNABBREV_TAC; (* ---- *) TYPE_THEN `pointI b` UNABBREV_TAC; UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[]; USE 10 SYM; TYPE_THEN `t (N -1) = x''` SUBAGOAL_TAC; USE 13 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; USE 10 SYM; REDUCE_TAC; REWRITE_TAC[ARITH_RULE `1 <= 1`]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `x''` UNABBREV_TAC; USE 20 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); UND 20 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; UND 37 THEN ARITH_TAC; TYPE_THEN `e'` UNABBREV_TAC; CONJ_TAC; TYPE_THEN `N-| 2` EXISTS_TAC; UND 28 THEN ARITH_TAC; TYPE_THEN `N -| 2 < N -| 1` SUBAGOAL_TAC; UND 28 THEN ARITH_TAC; TYPE_THEN `t (N - 1)` EXISTS_TAC; TYPE_THEN `SUC (N - 2) = N - 1` SUBAGOAL_TAC; UND 28 THEN ARITH_TAC; USE 10 SYM; REWRITE_TAC[REAL_ARITH `x <= x`]; IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN ARITH_TAC; (* --D *) TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `ed (0)` EXISTS_TAC; TYPE_THEN `S` UNABBREV_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `e'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `0 < x'` SUBAGOAL_TAC; IMATCH_MP_TAC (ARITH_RULE `~(x' = 0) ==> 0 < x'`); TYPE_THEN `x'` UNABBREV_TAC; (* --- *) TYPE_THEN `pointI a` UNABBREV_TAC; UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[]; USE 11 SYM; TYPE_THEN `t (0) = x''` SUBAGOAL_TAC; USE 13 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; USE 11 SYM; REDUCE_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `x''` UNABBREV_TAC; USE 25 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); UND 25 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; UND 38 THEN ARITH_TAC; TYPE_THEN `e'` UNABBREV_TAC; CONJ_TAC; TYPE_THEN `0` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `t (0)` EXISTS_TAC; REDUCE_TAC; USE 11 SYM; IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN ARITH_TAC; (* -E *) SUBCONJ_TAC; IMATCH_MP_TAC has_size2_pair; CONJ_TAC; IMATCH_MP_TAC endpoint_size2; USE 33 (REWRITE_RULE[SUBSET;INR in_pair]); CONJ_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `a` UNABBREV_TAC; TYPE_THEN `v = v'` SUBAGOAL_TAC; USE 8(MATCH_MP simple_arc_end_distinct); UND 8 THEN ASM_REWRITE_TAC[]; (* -F *) IMATCH_MP_TAC EQ_EXT ; THM_INTRO_TAC[`S`;`top2`] closure_unions; REWRITE_TAC[top2_top]; FULL_REWRITE_TAC[psegment;segment]; TYPE_THEN `S` UNABBREV_TAC; REWRITE_TAC[UNIONS]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; USE 20 (REWRITE_RULE[IMAGE]); (* -- *) TYPE_THEN `A = {i | (i <=| N -| 1) /\ (t i <= x')}` ABBREV_TAC ; TYPE_THEN `FINITE A` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{i | i <=| (N -| 1)}` EXISTS_TAC; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[SUBSET]; REWRITE_TAC[FINITE_NUMSEG_LE]; TYPE_THEN `A 0` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; ASM_REWRITE_TAC[]; UND 28 THEN ARITH_TAC; THM_INTRO_TAC[`A`] select_num_max; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `0` EXISTS_TAC; TYPE_THEN `x' = &1` ASM_CASES_TAC; TYPE_THEN `closure top2 (ed (N -| 2))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC image_imp; IMATCH_MP_TAC image_imp; UND 28 THEN ARITH_TAC; USE 24 SYM; TYPE_THEN `N - 2 <| N - 1` SUBAGOAL_TAC; UND 28 THEN ARITH_TAC; TYPE_THEN `t (N -| 1)` EXISTS_TAC; TYPE_THEN `N - 1 = SUC (N - 2)` SUBAGOAL_TAC; UND 28 THEN ARITH_TAC; USE 10 SYM; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `x <= x`]; IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); FIRST_ASSUM IMATCH_MP_TAC ; UND 28 THEN ARITH_TAC; (* -- *) TYPE_THEN `closure top2 (ed z)` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC image_imp; IMATCH_MP_TAC image_imp; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`); DISCH_TAC; TYPE_THEN `z` UNABBREV_TAC; UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC; TYPE_THEN `z <| N-1` SUBAGOAL_TAC; IMATCH_MP_TAC (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`); TYPE_THEN `A` UNABBREV_TAC; DISCH_TAC; TYPE_THEN `z` UNABBREV_TAC; UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC (REAL_ARITH `~(x <= y) ==> (y <= x)`); UND 41 THEN DISCH_THEN (THM_INTRO_TAC[`SUC z`]); UND 44 THEN ARITH_TAC; UND 41 THEN ARITH_TAC; (* -G *) USE 36 (REWRITE_RULE[IMAGE]); TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `x'` UNABBREV_TAC; UND 30 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x`]); REWR 30; IMATCH_MP_TAC image_imp; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x''` EXISTS_TAC; (* Wed Dec 22 07:47:58 EST 2004 *) ]);; (* }}} *) let psegment_cls = prove_by_refinement( `!S. psegment S ==> IMAGE pointI (cls S) SUBSET closure top2 (UNIONS S)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[cls;IMAGE;SUBSET]; THM_INTRO_TAC[`S`;`top2`] closure_unions; FULL_REWRITE_TAC[top2_top;psegment;segment]; REWRITE_TAC[UNIONS;IMAGE]; CONV_TAC (dropq_conv "u"); UNIFY_EXISTS_TAC; ]);; (* }}} *) let planar_graph_rectagonal = prove_by_refinement( `!(G:(A,B)graph_t). planar_graph G /\ FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ ~(graph_edge G = {}) /\ (!v. CARD (graph_edge_around G v) <=| 4) ==> (rectagonal_graph G)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`G`] graph_int_model; REWRITE_TAC[rectagonal_graph;rectagon_graph]; TYPE_THEN `graph H` SUBAGOAL_TAC; FULL_REWRITE_TAC[good_plane_graph;plane_graph]; TYPE_THEN `!e. graph_edge H e ==> (?S a b. segment_end S a b /\ (graph_inc H e = { (pointI a), (pointI b) }) /\ (e = closure top2 (UNIONS S)))` SUBAGOAL_TAC; FULL_REWRITE_TAC[good_plane_graph]; TSPEC `e` 10; REWR 10; THM_INTRO_TAC[`H`;`e`] graph_edge_end_select; UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`v`;`v'`]); THM_INTRO_TAC[`E`;`e`;`v`;`v'`] simple_arc_finite_lemma4; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`H`;`e`] graph_inc_subset; TYPE_THEN `graph_vertex H v` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `graph_vertex H v'` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `S` EXISTS_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; USE 18 SYM; IMATCH_MP_TAC has_size2_subset_ne; CONJ_TAC; IMATCH_MP_TAC graph_edge2; REWRITE_TAC[SUBSET;INR in_pair]; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; USE 19 SYM; ASM_REWRITE_TAC[]; USE 20 SYM; ASM_REWRITE_TAC[]; UND 15 THEN ASM_REWRITE_TAC[]; (* -A *) LEFT 13 "S"; LEFT 13 "S"; (* - *) TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC; TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; REWRITE_TAC[pointI]; TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC; REWRITE_TAC[int_neg_num_th]; USE 16 (MATCH_MP point_onto); REWRITE_TAC[point_inj]; TYPE_THEN `w` UNABBREV_TAC; FULL_REWRITE_TAC[coord01;PAIR_SPLIT]; (* -- *) TYPE_THEN `!v. graph_vertex H v ==> ?a. (v = pointI a)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[good_plane_graph;plane_graph]; ASM_MESON_TAC[subset_imp]; LEFT 15 "a"; LEFT 15 "a"; TYPE_THEN `J = mk_graph_t (IMAGE a (graph_vertex H), IMAGE S (graph_edge H),endpoint)` ABBREV_TAC ; TYPE_THEN `J` EXISTS_TAC; (* - *) TYPE_THEN `graph_isomorphic H J` SUBAGOAL_TAC; REWRITE_TAC[graph_isomorphic;graph_iso]; LEFT_TAC "u"; TYPE_THEN `a` EXISTS_TAC; LEFT_TAC "v"; TYPE_THEN `S` EXISTS_TAC; TYPE_THEN `a,S` EXISTS_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph]; CONJ_TAC; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; TYPE_THEN `x = pointI (a x)` SUBAGOAL_TAC; TYPE_THEN `y = pointI (a y)` SUBAGOAL_TAC; TYPE_THEN `a x` UNABBREV_TAC; TYPE_THEN `pointI (a y)` UNABBREV_TAC; (* -- *) CONJ_TAC; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; TYPE_THEN `x = closure top2 (UNIONS (S x))` SUBAGOAL_TAC; USE 16 SYM; ASM_MESON_TAC[]; TYPE_THEN `y = closure top2 (UNIONS (S y))` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `S x` UNABBREV_TAC; ASM_MESON_TAC[]; (* -- *) UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`e`]); THM_INTRO_TAC[`H`;`e`] graph_inc_subset; REWR 19; USE 19 (REWRITE_RULE[SUBSET;INR in_pair]); TYPE_THEN `IMAGE a {(pointI a'), (pointI b)} = {a', b}` SUBAGOAL_TAC; REWRITE_TAC[IMAGE ;INR in_pair]; IMATCH_MP_TAC EQ_EXT ; REWRITE_TAC[INR in_pair]; NAME_CONFLICT_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; DISJ1_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; TSPEC `pointI b` 15; USE 15 (REWRITE_RULE[pointI_inj]); FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; DISJ2_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; TSPEC `pointI a'` 15; USE 15 (REWRITE_RULE[pointI_inj]); FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; (* --- *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `pointI b` EXISTS_TAC; TSPEC `pointI b` 15; USE 15 (REWRITE_RULE[pointI_inj]); FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `pointI a'` EXISTS_TAC; TSPEC `pointI a'` 15; USE 15 (REWRITE_RULE[pointI_inj]); FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[segment_end]; (* -B *) REWRITE_TAC[GSYM CONJ_ASSOC]; SUBCONJ_TAC; THM_INTRO_TAC[`H`;`J`] graph_isomorphic_graph; SUBCONJ_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[SUBSET;graph_edge_mk_graph]; USE 16 (REWRITE_RULE[IMAGE]); UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); FULL_REWRITE_TAC[segment_end]; (* - *) SUBCONJ_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[graph_inc_mk_graph]; (* - *) SUBCONJ_TAC; TYPE_THEN `J` UNABBREV_TAC; FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph]; USE 22 (REWRITE_RULE[IMAGE]); USE 23 (REWRITE_RULE[IMAGE]); COPY 13; UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); UND 25 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); PROOF_BY_CONTR_TAC; (* repeat from - to here // *) USE 30 (REWRITE_RULE[INTER;EMPTY_EXISTS]); TYPE_THEN `edge u` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end;psegment;segment]; ASM_MESON_TAC[subset_imp]; TYPE_THEN `(UNIONS (S x) SUBSET closure top2 (UNIONS (S x)))` SUBAGOAL_TAC; IMATCH_MP_TAC subset_closure; REWRITE_TAC[top2_top]; TYPE_THEN `(UNIONS (S x') SUBSET closure top2 (UNIONS (S x')))` SUBAGOAL_TAC; IMATCH_MP_TAC subset_closure; REWRITE_TAC[top2_top]; TYPE_THEN `UNIONS (S x) SUBSET x` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `UNIONS (S x') SUBSET x'` SUBAGOAL_TAC; ASM_MESON_TAC[]; USE 36 (REWRITE_RULE[UNIONS;SUBSET]); USE 35 (REWRITE_RULE[UNIONS;SUBSET]); LEFT 35 "u" ; LEFT 35 "u" ; LEFT 36 "u" ; LEFT 36 "u" ; TSPEC `u` 36; TSPEC `u` 35; TYPE_THEN `u SUBSET x` SUBAGOAL_TAC; REWRITE_TAC[SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `u SUBSET x'` SUBAGOAL_TAC; REWRITE_TAC[SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[good_plane_graph;plane_graph]; UND 39 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`x'`]); DISCH_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `e'` UNABBREV_TAC; UND 21 THEN ASM_REWRITE_TAC[]; USE 39 (REWRITE_RULE[INTER;SUBSET]); TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `u` UNABBREV_TAC; USE 32 (MATCH_MP edge_cell); USE 32 (MATCH_MP cell_nonempty); UND 32 THEN (REWRITE_TAC[]); USE 44 (REWRITE_RULE[EMPTY_EXISTS]); TSPEC `u'` 39; TYPE_THEN `graph_vertex H u'` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[subset_imp]; UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`u'`]); UND 15 THEN UND 44 THEN UND 32 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); FULL_REWRITE_TAC[edge]; TYPE_THEN `c = a u'` ABBREV_TAC ; FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `u'` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses]; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `u'` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses]; (* -C *) TYPE_THEN `graph_isomorphic J G` SUBAGOAL_TAC; THM_INTRO_TAC[`G`;`H`;`J`] graph_isomorphic_trans; IMATCH_MP_TAC graph_isomorphic_symm; IMATCH_MP_TAC planar_is_graph; (* - *) TYPE_THEN `J` UNABBREV_TAC; FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph]; USE 23 (REWRITE_RULE[IMAGE]); USE 24 (REWRITE_RULE[IMAGE]); COPY 13; UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); IMATCH_MP_TAC SUBSET_ANTISYM; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; CONJ_TAC THEN (IMATCH_MP_TAC endpoint_cls); FULL_REWRITE_TAC[segment_end;psegment;segment]; FULL_REWRITE_TAC[segment_end;psegment;segment]; (* -D *) TYPE_THEN `IMAGE pointI (cls(S x') INTER cls(S x)) SUBSET (IMAGE pointI (endpoint (S x') INTER endpoint (S x)))` BACK_TAC; THM_INTRO_TAC[`pointI`] image_inj; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `UNIV:int#int ->bool` EXISTS_TAC; REWRITE_TAC[INJ]; FULL_REWRITE_TAC[pointI_inj]; (* - *) TYPE_THEN `!A B. (IMAGE pointI (A INTER B) = IMAGE pointI A INTER IMAGE pointI B)` SUBAGOAL_TAC; IMATCH_MP_TAC inj_inter; TYPE_THEN `UNIV:int#int->bool` EXISTS_TAC; TYPE_THEN `UNIV:(num->real)->bool` EXISTS_TAC; REWRITE_TAC[INJ]; FULL_REWRITE_TAC[pointI_inj]; (* - *) TYPE_THEN `IMAGE pointI (endpoint (S x')) = graph_inc H x'` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end]; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR in_pair]; MESON_TAC[]; TYPE_THEN `IMAGE pointI (endpoint (S x)) = graph_inc H x` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end]; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR in_pair]; MESON_TAC[]; USE 28 SYM; USE 30 SYM; (* -E *) TYPE_THEN `!e. graph_edge H e ==> (graph_inc H e = e INTER graph_vertex H)` SUBAGOAL_TAC; USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]); TYPE_THEN `x' INTER x SUBSET graph_vertex H` SUBAGOAL_TAC; USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]); FIRST_ASSUM IMATCH_MP_TAC ; UND 24 THEN UND 23 THEN UND 16 THEN MESON_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `x' INTER x` EXISTS_TAC; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; UND 36 THEN REWRITE_TAC[INTER;SUBSET;] THEN MESON_TAC[]; (* - *) IMATCH_MP_TAC subset_inter_pair; (* -F *) UND 31 THEN UND 13 THEN UND 29 THEN UND 27 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); FULL_REWRITE_TAC[segment_end]; ASM_MESON_TAC[psegment_cls]; (* Wed Dec 22 11:18:27 EST 2004 *) ]);; (* }}} *) let cartesian_finite = prove_by_refinement( `!(A:A->bool) (B:B->bool). FINITE A /\ FINITE B ==> FINITE (cartesian A B)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `cartesian A B = {(x,y) | (x IN A) /\ (y IN B)}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[cartesian]; IMATCH_MP_TAC FINITE_PRODUCT; ]);; (* }}} *) let three_t_finite = prove_by_refinement( `FINITE (UNIV:three_t ->bool)`, (* {{{ proof *) [ THM_INTRO_TAC[`ABS3 0`] three_delete_size; FULL_REWRITE_TAC[HAS_SIZE]; FULL_REWRITE_TAC[FINITE_DELETE]; ]);; (* }}} *) let three_t_size3 = prove_by_refinement( `(UNIV:three_t ->bool) HAS_SIZE 3`, (* {{{ proof *) [ THM_INTRO_TAC[`ABS3 0`] three_delete_size; FULL_REWRITE_TAC[HAS_SIZE]; FULL_REWRITE_TAC[FINITE_DELETE]; THM_INTRO_TAC[`ABS3 0`;`UNIV:three_t->bool`;] CARD_SUC_DELETE; ASM_REWRITE_TAC[]; USE 2 SYM; ASM_REWRITE_TAC[]; ARITH_TAC; ]);; (* }}} *) let k33_nonplanar = prove_by_refinement( `~(planar_graph k33_graph)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`k33_graph`] planar_graph_rectagonal; REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex]; ASSUME_TAC three_t_finite; ASSUME_TAC bool_size; FULL_REWRITE_TAC[HAS_SIZE]; CONJ_TAC; IMATCH_MP_TAC cartesian_finite; CONJ_TAC; IMATCH_MP_TAC cartesian_finite; (* -- *) REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; TYPE_THEN `(ABS3 0,ABS3 0)` EXISTS_TAC; REWRITE_TAC[cartesian;PAIR_SPLIT]; MESON_TAC[]; REWRITE_TAC[graph_edge_around]; REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex;cartesian_univ]; TYPE_THEN `E = {e | (v = FST e,T) \/ (v = SND e,F)}` ABBREV_TAC ; TYPE_THEN `SND v ==> (E = IMAGE (\ f. (FST v, f)) UNIV)` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE]; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `~(SND v) ==> (E = IMAGE (\ f. (f,FST v)) UNIV)` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE]; REWRITE_TAC[PAIR_SPLIT]; NAME_CONFLICT_TAC; MESON_TAC[]; TYPE_THEN `CARD E <=| CARD (UNIV:three_t ->bool)` SUBAGOAL_TAC; TYPE_THEN `SND v` ASM_CASES_TAC; IMATCH_MP_TAC CARD_IMAGE_LE; IMATCH_MP_TAC CARD_IMAGE_LE; ASSUME_TAC three_t_size3; FULL_REWRITE_TAC[HAS_SIZE]; UND 8 THEN UND 7 THEN ARITH_TAC; (* - *) ASSUME_TAC rectagon_graph_k33_false; UND 2 THEN ASM_REWRITE_TAC[]; (* Wed Dec 22 11:57:49 EST 2004 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION Z *) (* ------------------------------------------------------------------ *) (* show the complement of a simple arc is connected *) let grid33 = jordan_def `grid33 m = rectangle_grid (FST m -: &:1, SND m -: &:1) (FST m +: &:2, SND m +: &:2)`;; let grid = jordan_def `grid f N = UNIONS (IMAGE ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1))) {j | j <= N})`;; let grid33_conn2 = prove_by_refinement( `!m. conn2 (grid33 m)`, (* {{{ proof *) [ REWRITE_TAC[grid33]; TYPE_THEN `SUC 2 = 3` SUBAGOAL_TAC; ARITH_TAC; TYPE_THEN `a = FST m -: &:1` ABBREV_TAC ; TYPE_THEN `FST m +: &:2 = a +: &:(SUC 2)` SUBAGOAL_TAC; TYPE_THEN `a` UNABBREV_TAC; INT_ARITH_TAC; TYPE_THEN `b = SND m -: &:1` ABBREV_TAC ; TYPE_THEN `SND m +: &:2 = b +: &:(SUC 2)` SUBAGOAL_TAC; TYPE_THEN `b` UNABBREV_TAC; ARITH_TAC; USE 0 SYM; THM_INTRO_TAC[`2`;`2`;`(a,b)`] rectangle_grid_conn2; FULL_REWRITE_TAC[]; ]);; (* }}} *) let grid_finite = prove_by_refinement( `!f N. FINITE (grid f N)`, (* {{{ proof *) [ REWRITE_TAC[ grid]; TYPE_THEN `FINITE (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N}) ` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_IMAGE; REWRITE_TAC[FINITE_NUMSEG_LE]; ASM_SIMP_TAC[FINITE_FINITE_UNIONS]; USE 1 (REWRITE_RULE[IMAGE]); THM_INTRO_TAC[`floor (f (&x / &N) 0),floor (f (&x / &N) 1)`] grid33_conn2; FULL_REWRITE_TAC[conn2]; ]);; (* }}} *) let grid33_edge = prove_by_refinement( `!m. grid33 m SUBSET edge `, (* {{{ proof *) [ REWRITE_TAC[grid33;rectangle_grid_edge]; ]);; (* }}} *) let grid_edge = prove_by_refinement( `!f N . grid f N SUBSET edge `, (* {{{ proof *) [ REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ]; TYPE_THEN `u` UNABBREV_TAC; ASM_MESON_TAC[grid33_edge;subset_imp]; ]);; (* }}} *) let floor_add_num = prove_by_refinement( `!x m. floor (x + &m) = floor x +: &:m`, (* {{{ proof *) [ REWRITE_TAC [floor_range;int_add_th;int_of_num_th;]; THM_INTRO_TAC[`x`;`floor x`] floor_range; REWR 0; UND 0 THEN UND 1 THEN REAL_ARITH_TAC; ]);; (* }}} *) let floor_abs = prove_by_refinement( `!x y m. (abs (x -. y) <= &m) ==> (||: (floor x -: floor y) <=: &:m)`, (* {{{ proof *) [ TYPE_THEN `!x y m. (y <. x) /\ (x - y <= &m) ==> (floor x -: floor y <=: &:m)` SUBAGOAL_TAC; THM_INTRO_TAC[`x`;`y + &m`] floor_mono; UND 0 THEN REAL_ARITH_TAC; FULL_REWRITE_TAC[floor_add_num]; UND 2 THEN INT_ARITH_TAC ; TYPE_THEN `y = x` ASM_CASES_TAC; TYPE_THEN `y` UNABBREV_TAC; FULL_REWRITE_TAC[REAL_ARITH `x -. x = &0`;ABS_0;INT_SUB_REFL;INT_ABS_0;int_le ; int_of_num_th]; ASM_REWRITE_TAC[]; TYPE_THEN `y <= x` ASM_CASES_TAC; TYPE_THEN `abs (x - y) = (x - y)` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_REFL]; UND 3 THEN REAL_ARITH_TAC; REWR 0; TYPE_THEN `floor y <=: floor x` SUBAGOAL_TAC; IMATCH_MP_TAC floor_mono; TYPE_THEN `||: (floor x -: floor y) = (floor x -: floor y)` SUBAGOAL_TAC; REWRITE_TAC[INT_ABS_REFL]; UND 5 THEN INT_ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 2 THEN UND 3 THEN REAL_ARITH_TAC; TYPE_THEN `x < y` SUBAGOAL_TAC; UND 2 THEN UND 3 THEN REAL_ARITH_TAC; (* -A *) TYPE_THEN `abs (x - y) = (y - x)` SUBAGOAL_TAC; UND 4 THEN REAL_ARITH_TAC; REWR 0; TYPE_THEN `floor x <=: floor y` SUBAGOAL_TAC; IMATCH_MP_TAC floor_mono; UND 4 THEN REAL_ARITH_TAC; TYPE_THEN `||: (floor x -: floor y) = (floor y -: floor x)` SUBAGOAL_TAC; UND 6 THEN INT_ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let d_euclid_floor = prove_by_refinement( `!x y i n. (euclid n x) /\ (euclid n y) /\ (d_euclid x y < &1) ==> (||: (floor (x i) -: floor (y i)) <=: &:1)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC floor_abs; THM_INTRO_TAC[`n`;`x`;`y`;`i`] proj_contraction; UND 3 THEN UND 0 THEN REAL_ARITH_TAC; ]);; (* }}} *) extend_simp_rewrites[prove_by_refinement( `!x . x/ &0 = &0 `, (* {{{ proof *) [ REWRITE_TAC[REAL_INV_0;real_div;REAL_MUL_RZERO]; ])];; (* }}} *) extend_simp_rewrites[INR in_pair ; INR IN_SING];; extend_simp_rewrites[REAL_POS];; let real_eq_div = prove_by_refinement( `!x y z. ~(z = &0) ==> ((x / z = y) <=> (x = y * z))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `&0 < z` ASM_CASES_TAC; ASM_SIMP_TAC[REAL_EQ_LDIV_EQ]; TYPE_THEN `&0 < -- z` SUBAGOAL_TAC; UND 0 THEN UND 1 THEN REAL_ARITH_TAC; TYPE_THEN `x / z = (--x)/(--z)` SUBAGOAL_TAC; REWRITE_TAC[real_div;REAL_INV_NEG;REAL_NEG_MUL2]; ASM_SIMP_TAC[REAL_EQ_LDIV_EQ]; REAL_ARITH_TAC; ]);; (* }}} *) let grid_conn2_induct_lemma = prove_by_refinement( `!k f N. (k <= N) /\ (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\ (!i. (i < N) ==> d_euclid (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==> conn2 (UNIONS (IMAGE ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1))) {j | j <= k}))`, (* {{{ proof *) [ INDUCT_TAC; TYPE_THEN `{j | j <=| 0} = {0}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_SING]; ARITH_TAC; REWRITE_TAC[IMAGE;INR IN_SING ]; TYPE_THEN `{y | ?x. (x = 0) /\ (y = grid33 (floor (f (&x / &N) 0),floor (f (&x / &N) 1)))} = {(grid33 (floor (f (&0 / &N) 0), floor (f (&0 / &N) 1)))}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; NAME_CONFLICT_TAC; REWRITE_TAC[INR IN_SING]; CONV_TAC (dropq_conv "x'"); REWRITE_TAC[grid33_conn2]; (* - *) UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`f`;`N`]); UND 2 THEN ARITH_TAC; TYPE_THEN `{j | j <=| SUC k} = {j | j <=| k} UNION {(SUC k)}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;]; ARITH_TAC; REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1]; IMATCH_MP_TAC conn2_union_edge; ASM_REWRITE_TAC[grid33_conn2]; (* - *) CONJ_TAC; REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ]; TYPE_THEN `u` UNABBREV_TAC; ASM_MESON_TAC[grid33_edge;subset_imp]; REWRITE_TAC[EMPTY_EXISTS]; REWRITE_TAC[grid33_edge]; TYPE_THEN `{j | j <=| k} = {j | j <| k} UNION {k}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING]; ARITH_TAC; REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1]; ONCE_REWRITE_TAC[INTER_COMM]; REWRITE_TAC[UNION_OVER_INTER]; REWRITE_TAC[UNION]; RIGHT_TAC "u"; DISJ2_TAC; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]); UND 2 THEN ARITH_TAC; (* -A *) TYPE_THEN `a = floor (f (&k / &N) 0)` ABBREV_TAC ; TYPE_THEN `b = floor (f (&k / &N) 1)` ABBREV_TAC ; TYPE_THEN `a' = floor (f (&(SUC k) / &N) 0)` ABBREV_TAC ; TYPE_THEN `b' = floor (f (&(SUC k) / &N) 1)` ABBREV_TAC ; TYPE_THEN `h_edge (a,b)` EXISTS_TAC; REWRITE_TAC[INTER]; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; REWRITE_TAC[grid33]; REWRITE_TAC[rectangle_grid_h]; INT_ARITH_TAC; (* - *) TYPE_THEN `!k. (k <=| N) ==> euclid 2 (f (&k / &N))` SUBAGOAL_TAC; USE 1(REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC image_imp; CONJ_TAC; IMATCH_MP_TAC REAL_LE_DIV; TYPE_THEN `&N = &0` ASM_CASES_TAC; REWRITE_TAC[]; REAL_ARITH_TAC; TYPE_THEN `&0 < &N` SUBAGOAL_TAC; UND 11 THEN REWRITE_TAC[REAL_OF_NUM_EQ;REAL_LT] THEN ARITH_TAC; ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; UND 10 THEN REWRITE_TAC[REAL_LE;REAL_OF_NUM_MUL] THEN ARITH_TAC ; (* - *) TYPE_THEN `euclid 2 (f (&k/ &N))` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 2 THEN ARITH_TAC; TYPE_THEN `euclid 2 (f (&(SUC k)/ &N))` SUBAGOAL_TAC; (* - *) THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`0`;`2`] d_euclid_floor; THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`1`;`2`] d_euclid_floor; TYPE_THEN `||: (a - a') <=: &:1` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `||: (b - b') <=: &:1` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILL 14 THEN KILL 13; KILL 5 THEN KILL 4; KILL 3 THEN KILL 1; REWRITE_TAC[grid33]; REWRITE_TAC[rectangle_grid_h]; UND 16 THEN UND 15 THEN INT_ARITH_TAC; (* Thu Dec 23 10:46:15 EST 2004 *) ]);; (* }}} *) let grid_conn2 = prove_by_refinement( `!f N. (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\ (!i. (i < N) ==> d_euclid (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==> conn2 (grid f N)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`N`;`f`;`N`] grid_conn2_induct_lemma; ARITH_TAC; REWRITE_TAC[grid]; ]);; (* }}} *) let simple_arc_uniformly_continuous = prove_by_refinement( `!f . continuous f (top_of_metric(UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> uniformly_continuous f ({x | &0 <= x /\ x <= &1},d_real) (euclid 2,d_euclid)`, (* {{{ proof *) [ REP_BASIC_TAC; ASSUME_TAC metric_real; IMATCH_MP_TAC compact_uniformly_continuous; THM_INTRO_TAC[`&0`;`&1`] interval_compact; THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] compact_subset; REWRITE_TAC[metric_real]; REWR 4; KILL 4; KILL 3; (* - *) TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= &1} SUBSET euclid 2` SUBAGOAL_TAC; IMATCH_MP_TAC inj_image_subset; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); (* -A *) SUBCONJ_TAC; IMATCH_MP_TAC metric_subspace; TYPE_THEN `UNIV:real->bool` EXISTS_TAC ; ASM_REWRITE_TAC[]; (* -// *) THM_INTRO_TAC[`f`;`top_of_metric(UNIV,d_real)`;`top2`;`{x | &0 <= x /\ x <= &1}`] continuous_induced_domain; ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions]; (* - *) THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_induced; REWRITE_TAC[metric_real]; REWR 5; THM_INTRO_TAC[`f`;`{x | &0 <= x /\ x <= &1}`;`euclid 2`;`d_real`;`d_euclid`] metric_continuous_continuous; USE 7 SYM; FULL_REWRITE_TAC[top2]; (* Thu Dec 23 11:29:49 EST 2004 *) ]);; (* }}} *) let num_abs_of_int_mono = prove_by_refinement( `!a b. &:0 <= a /\ a <= b ==> num_abs_of_int a <= num_abs_of_int b`, (* {{{ proof *) [ REWRITE_TAC[GSYM REAL_LE;num_abs_of_int_th;GSYM int_abs_th;GSYM int_le ]; UND 0 THEN UND 1 THEN INT_ARITH_TAC; ]);; (* }}} *) let floor_num = prove_by_refinement( `!n. floor (&n) = &:n`, (* {{{ proof *) [ REWRITE_TAC[floor_range]; REWRITE_TAC[int_of_num_th;]; REAL_ARITH_TAC; ]);; (* }}} *) let floor_neg_num = prove_by_refinement( `!n. floor (-- &n) = -- (&:n)`, (* {{{ proof *) [ REWRITE_TAC[floor_range]; REWRITE_TAC[int_neg_th;int_of_num_th;]; REAL_ARITH_TAC; ]);; (* }}} *) let delta_partition_lemma = prove_by_refinement( `!delta. (&0 < delta) ==> (?N. !x. ?i. (0 < N) /\ ((&0 <= x /\ x <= &1) ==> (i <= N) /\ abs (&i/ &N - x) < delta))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE; TYPE_THEN `n` EXISTS_TAC; TYPE_THEN `num_abs_of_int (floor (&n*x))` EXISTS_TAC; TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC; TYPE_THEN `&0 < &n` SUBAGOAL_TAC; UND 1 THEN UND 2 THEN REAL_ARITH_TAC; TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC; ASM_MESON_TAC[REAL_LE_LDIV_EQ]; CONJ_TAC; FULL_REWRITE_TAC[REAL_LT]; TYPE_THEN `&:0 <= floor (&n * x)` SUBAGOAL_TAC; TYPE_THEN `floor (&0) <=: floor (&n * x)` BACK_TAC; FULL_REWRITE_TAC[floor_num]; IMATCH_MP_TAC floor_mono; IMATCH_MP_TAC REAL_LE_MUL; (* - *) CONJ_TAC; TYPE_THEN `num_abs_of_int (floor (&n * x)) <= num_abs_of_int (floor (&n))` BACK_TAC; FULL_REWRITE_TAC[floor_num;num_abs_of_int_num]; IMATCH_MP_TAC num_abs_of_int_mono; IMATCH_MP_TAC floor_mono; TYPE_THEN `&n * x <= &n * &1` BACK_TAC; UND 8 THEN REAL_ARITH_TAC; IMATCH_MP_TAC REAL_PROP_LE_LMUL; (* -A *) IMATCH_MP_TAC REAL_LT_LCANCEL_IMP; TYPE_THEN `&n` EXISTS_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN`&1` EXISTS_TAC; (* - *) REWRITE_TAC[num_abs_of_int_th;]; TYPE_THEN `abs (real_of_int (floor (&n * x))) = (real_of_int (floor (&n *x)))` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_REFL]; FULL_REWRITE_TAC [int_le; int_of_num_th;]; TYPE_THEN `!u. &n * abs (u / &n - x) = abs (u - &n*x)` SUBAGOAL_TAC; TYPE_THEN `!t. &n * abs t = abs (&n *t)` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM]; AP_TERM_TAC; REWRITE_TAC[REAL_SUB_LDISTRIB]; TYPE_THEN `&n * u/ &n = u` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; UND 10 THEN UND 3 THEN REAL_ARITH_TAC; TYPE_THEN `t = &n * x ` ABBREV_TAC ; TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC; REWRITE_TAC[floor_ineq]; TYPE_THEN `abs (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC; UND 11 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`t`] floor_ineq; UND 13 THEN REAL_ARITH_TAC; ]);; (* }}} *) let simple_arc_ball_cover = prove_by_refinement( `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> (?N. !x. ?i. (0 < N) /\ (&0 <= x /\ x <= &1 ==> (i <= N) /\ open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; FULL_REWRITE_TAC[uniformly_continuous]; TSPEC `&1` 2; UND 2 THEN DISCH_THEN (THM_INTRO_TAC[]); REWRITE_TAC[open_ball]; THM_INTRO_TAC[`delta`] delta_partition_lemma; TYPE_THEN `N` EXISTS_TAC; TSPEC `x` 4; TYPE_THEN `i` EXISTS_TAC; REP_BASIC_TAC; UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]); (* - *) TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_DIV; THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ; REWRITE_TAC[REAL_LT]; REWRITE_TAC[REAL_MUL;REAL_LE]; UND 8 THEN ARITH_TAC; (* - *) FULL_REWRITE_TAC[INJ]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[d_real]; ]);; (* }}} *) let unbounded_diff = prove_by_refinement( `!G. unbounded_set G = UNIONS(ctop G) DIFF (bounded_set G)`, (* {{{ proof *) [ REWRITE_TAC[GSYM bounded_unbounded_union]; IMATCH_MP_TAC EQ_EXT; THM_INTRO_TAC[`G`] bounded_unbounded_disj; UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[]; ]);; (* }}} *) let bounded_diff = prove_by_refinement( `!G. bounded_set G = UNIONS(ctop G) DIFF (unbounded_set G)`, (* {{{ proof *) [ REWRITE_TAC[GSYM bounded_unbounded_union]; IMATCH_MP_TAC EQ_EXT; THM_INTRO_TAC[`G`] bounded_unbounded_disj; UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[]; ]);; (* }}} *) let rectangle_grid_subset = prove_by_refinement( `!p q r s. (FST p <=: FST r) /\ (SND p <= SND r) /\ (FST s <= FST q) /\ (SND s <= SND q) ==> rectangle_grid r s SUBSET rectangle_grid p q`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;rectangle_grid]; FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[cell_clauses] THEN CONV_TAC (dropq_conv "m'"); UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; ]);; (* }}} *) let grid_image_bounded = prove_by_refinement( `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> (?N. (0 < N) /\ ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER (unbounded_set (grid f N)) = EMPTY)) `, (* {{{ proof *) [ REWRITE_TAC[EQ_EMPTY;INTER;]; THM_INTRO_TAC[`f`] simple_arc_ball_cover; TYPE_THEN `N` EXISTS_TAC; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; RIGHT 2 "i"; RIGHT 2 "x"; TYPE_THEN `x''` UNABBREV_TAC; FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ]; UND 2 THEN REWRITE_TAC[]; UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); REWR 2; FULL_REWRITE_TAC[open_ball]; (* _ *) IMATCH_MP_TAC bounded_avoidance_subset; TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ; TYPE_THEN `E` EXISTS_TAC; (* _ *) TYPE_THEN `conn2 E` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[grid33_conn2]; REWRITE_TAC[grid_edge;grid_finite]; TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC; REWRITE_TAC[grid]; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UND 6 THEN ARITH_TAC; REWRITE_TAC[IMAGE_UNION;UNIONS_UNION]; REWRITE_TAC[SUBSET;UNION]; DISJ1_TAC; REWRITE_TAC[image_sing]; (* _ *) TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC; UND 3 THEN REWRITE_TAC[]; THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset; USE 3 (MATCH_MP UNIONS_UNIONS); ASM_MESON_TAC[subset_imp]; KILL 13; KILL 3; (* _A *) TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ; THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq; FULL_REWRITE_TAC []; REWR 13; TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[grid33]; IMATCH_MP_TAC rectangle_grid_subset; (* __ *) THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor; THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor; UND 3 THEN UND 11 THEN INT_ARITH_TAC; (* _ *) IMATCH_MP_TAC bounded_avoidance_subset; TYPE_THEN `E'` EXISTS_TAC; TYPE_THEN `conn2 E'` SUBAGOAL_TAC; IMATCH_MP_TAC conn2_rectagon; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; (* _ *) TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[grid33_edge]; (* _ *) ASM_SIMP_TAC[GSYM odd_bounded]; REWRITE_TAC[UNIONS]; TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC; IMATCH_MP_TAC (TAUT ` a/\ b ==> b /\ a`); (* -B *) TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC; UND 14 THEN REWRITE_TAC[]; THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset; USE 14 (MATCH_MP UNIONS_UNIONS); ASM_MESON_TAC[subset_imp]; (* - *) TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ; TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC; UND 19 THEN REWRITE_TAC[]; REWRITE_TAC[UNIONS]; TYPE_THEN `h_edge m` EXISTS_TAC; REWRITE_TAC[curve_cell_h_ver2]; USE 20 (REWRITE_RULE[PAIR_SPLIT]); REWR 3; FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[INSERT]; (* - *) TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC; UND 19 THEN REWRITE_TAC[]; REWRITE_TAC[UNIONS]; TYPE_THEN `v_edge m` EXISTS_TAC; REWRITE_TAC[curve_cell_v_ver2]; USE 20 (REWRITE_RULE[PAIR_SPLIT]); REWR 3; FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[INSERT]; (* - *) TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC; UND 19 THEN REWRITE_TAC[]; REWRITE_TAC[UNIONS]; TYPE_THEN `{(pointI m)}` EXISTS_TAC; ASM_SIMP_TAC[rectagon_segment;curve_cell_cls]; USE 20 (REWRITE_RULE[PAIR_SPLIT]); REWR 3; FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[SUBSET;INSERT]; USE 24 (MATCH_MP cls_subset); USE 24 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[cls_h]; (* -C *) USE 9 (MATCH_MP point_onto); THM_INTRO_TAC[`p`] square_domain; UND 24 THEN LET_TAC; TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC; TYPE_THEN `m` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; REWR 24; TYPE_THEN `point p` UNABBREV_TAC; USE 24 (REWRITE_RULE[UNION;INR IN_SING;]); REWR 9; (* -D *) ASM_SIMP_TAC[rectagon_segment;par_cell_squ]; FULL_REWRITE_TAC[num_lower]; USE 20 (REWRITE_RULE[PAIR_SPLIT]); REWR 3; FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[INSERT;cell_clauses]; REWR 24; (* - *) TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[up;PAIR_SPLIT]; INT_ARITH_TAC; REWR 24; FULL_REWRITE_TAC[card_sing;EVEN2]; (* Thu Dec 23 20:25:33 EST 2004 *) ]);; (* }}} *) let conn2_sequence_lemma1 = prove_by_refinement( `!k G N . (k <= N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ (!i. (i <= N) ==> (G i SUBSET edge )) /\ (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) ==> conn2 (UNIONS (IMAGE G ({i | i <=| k})))`, (* {{{ proof *) [ INDUCT_TAC; TYPE_THEN `{i | i <=| 0} = {0}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT ; ARITH_TAC; REWRITE_TAC[image_sing]; (* - *) UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`G`;`N`]); UND 3 THEN ARITH_TAC; TYPE_THEN `{i | i <=| SUC k} = {i | i <= k} UNION {(SUC k)}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; ARITH_TAC; REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION]; IMATCH_MP_TAC conn2_union_edge; REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; REWRITE_TAC[UNIONS;IMAGE;SUBSET]; FULL_REWRITE_TAC[SUBSET]; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); UND 8 THEN UND 3 THEN ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `u` UNABBREV_TAC; REWRITE_TAC[INTER]; TYPE_THEN`{i | i <=| k} = {i | i <| k} UNION {k}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; ARITH_TAC; (* - *) REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION]; REWRITE_TAC[UNION]; FULL_REWRITE_TAC[EMPTY_EXISTS]; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]); FULL_REWRITE_TAC[INTER]; TYPE_THEN `u` EXISTS_TAC; ]);; (* }}} *) let thread_finite_union = prove_by_refinement( `!(A:(A->bool)->(B->bool)) S. (FINITE S) /\ (!a b. A (a UNION b) = A a UNION A b) /\ (A EMPTY = EMPTY) ==> (A (UNIONS S) = UNIONS (IMAGE A S))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!k S. S HAS_SIZE k ==> (A (UNIONS S) = UNIONS (IMAGE A S))` SUBAGOAL_TAC THENL [INDUCT_TAC;ALL_TAC]; FULL_REWRITE_TAC[HAS_SIZE_0]; ASM_REWRITE_TAC[IMAGE_CLAUSES;UNIONS_0;]; THM_INTRO_TAC[`S'`;`k`] HAS_SIZE_SUC; REWR 5; USE 6 (REWRITE_RULE[EMPTY_EXISTS]); TSPEC `u` 5; TSPEC `S' DELETE u` 4; TYPE_THEN `S' = (S' DELETE u) UNION {u}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; UND 6 THEN REWRITE_TAC[DELETE;UNION;INR IN_SING ] THEN MESON_TAC[]; UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); ASM_REWRITE_TAC[UNIONS_UNION;IMAGE_UNION;image_sing;]; (* - *) UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`CARD S`;`S`]); ASM_REWRITE_TAC[HAS_SIZE]; ]);; (* }}} *) let conn2_sequence_lemma2 = prove_by_refinement( `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ (!i. (i <= N) ==> (G i SUBSET edge )) /\ (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\ (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\ ~(unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==> (bounded_set (UNIONS (IMAGE G {i | i <=| N})) p)`, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC [unbounded_diff;DIFF;DE_MORGAN_THM;]; UND 6 THEN ASM_REWRITE_TAC[]; USE 0 (ONCE_REWRITE_RULE[DISJ_SYM]); FIRST_ASSUM DISJ_CASES_TAC; KILL 0; FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM;]; (* - *) COPY 1; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`]); UND 5 THEN ARITH_TAC; REWR 6; (* - *) TYPE_THEN `?j. (j <=| N) /\ UNIONS (curve_cell (G j)) p` SUBAGOAL_TAC; TYPE_THEN `!r. UNIONS (curve_cell r) = (UNIONS o curve_cell) r` SUBAGOAL_TAC; REWRITE_TAC[o_DEF]; REWR 6; TYPE_THEN `A = UNIONS o curve_cell` ABBREV_TAC ; THM_INTRO_TAC[`A`;`IMAGE G {i | i <=| N}`] thread_finite_union; CONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE; REWRITE_TAC[FINITE_NUMSEG_LE]; TYPE_THEN `A` UNABBREV_TAC; USE 9 GSYM; CONJ_TAC; REWRITE_TAC[curve_cell_union;UNIONS_UNION]; REWRITE_TAC[curve_cell_empty;]; USE 11 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `p` 11; TYPE_THEN `A` UNABBREV_TAC; KILL 9; FULL_REWRITE_TAC[IMAGE_o]; FULL_REWRITE_TAC[o_DEF]; REWR 11; FULL_REWRITE_TAC[GSYM UNIONS_IMAGE_UNIONS]; USE 9 (REWRITE_RULE[UNIONS]); USE 11 (REWRITE_RULE[IMAGE]); TYPE_THEN `u'` UNABBREV_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `x'` EXISTS_TAC; REWRITE_TAC[UNIONS]; TYPE_THEN `u` EXISTS_TAC; (* - *) FULL_REWRITE_TAC[curve_cell_union;UNIONS_UNION]; FULL_REWRITE_TAC[UNION;DE_MORGAN_THM]; TYPE_THEN `j = 0` ASM_CASES_TAC; REWR 9; (* - *) TYPE_THEN `?i. j = SUC i` SUBAGOAL_TAC ; TYPE_THEN `j - 1` EXISTS_TAC; UND 12 THEN ARITH_TAC; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); REWR 10; TYPE_THEN `j` UNABBREV_TAC; UND 14 THEN ASM_REWRITE_TAC[]; (* Fri Dec 24 07:02:02 EST 2004 *) ]);; (* }}} *) let conn2_sequence_lemma3 = prove_by_refinement( `!G N. (!i. (i <= N) ==> (G i SUBSET edge )) ==> (UNIONS (IMAGE G {i | i <=| N}) SUBSET edge)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[UNIONS;IMAGE;SUBSET ]; UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); ASM_MESON_TAC[subset_imp]; ]);; (* }}} *) let unbounded_avoidance_subset_ver2 = prove_by_refinement( `!E E' x. unbounded_set E' x /\ E SUBSET E' /\ E' SUBSET edge /\ FINITE E' /\ conn2 E ==> unbounded_set E x`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`;`E'`;`x`] unbounded_avoidance_subset; THM_INTRO_TAC[`E'`;`x`] unbounded_subset_unions; FULL_REWRITE_TAC[ctop_unions;DIFF]; UND 6 THEN ASM_REWRITE_TAC[]; ]);; (* }}} *) let conn2_sequence_lemma4 = prove_by_refinement( `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ (!i. (i <= N) ==> (G i SUBSET edge )) /\ (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\ (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\ (bounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==> (?C i j . rectagon C /\ bounded_set C p /\ (SUC i < j) /\ (j <=| N) /\ (C SUBSET (UNIONS (IMAGE G ({x | (i <=| x) /\ (x <=| j)})))) /\ (!C' i' j'. rectagon C' /\ bounded_set C' p /\ (i' < j') /\ (j' <=| N) /\ (C' SUBSET (UNIONS (IMAGE G ({x | (i' <=| x /\ x <=| j')})))) ==> (j - i <= j' - i') /\ ((j - i = j' - i') ==> (CARD (C DIFF (G (SUC i))) <= CARD (C' DIFF (G (SUC i')))))))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1; ARITH_TAC; TYPE_THEN `X = {(C,i,j) | rectagon C /\ bounded_set C p /\ (i <| j) /\ (j <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i <=| x /\ x <=| j})) }` ABBREV_TAC ; TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC; UND 8 THEN REWRITE_TAC[EMPTY_EXISTS]; THM_INTRO_TAC[`UNIONS (IMAGE G {i | i <=| N})`] rectagon_surround_conn2; IMATCH_MP_TAC conn2_sequence_lemma3; TYPE_THEN `(C,0,N)` EXISTS_TAC; TYPE_THEN `X` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `0` EXISTS_TAC; TYPE_THEN `N` EXISTS_TAC; REWRITE_TAC[ARITH_RULE `!x. 0 <=| x`]; ARITH_TAC; (* -A *) THM_INTRO_TAC[`X`;`(\ (C,i,j). j -| i):(((((num->real)->bool)->bool)#(num#num)) -> num)`] select_image_num_min; UND 8 THEN ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `?D i j. z = (D,i,j)` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `z` UNABBREV_TAC; (* - *) TYPE_THEN `Y = {(C,i',j') | rectagon C /\ bounded_set C p /\ (i' <| j') /\ (j' <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i' <=| x /\ x <=| j'})) /\ (j' - i' = j - i) }` ABBREV_TAC ; TYPE_THEN `~(Y = EMPTY)` SUBAGOAL_TAC; UND 12 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `(D,i,j)` EXISTS_TAC; TYPE_THEN `Y` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `D` EXISTS_TAC; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `j` EXISTS_TAC; TYPE_THEN `X` UNABBREV_TAC; USE 7 (REWRITE_RULE[PAIR_SPLIT]); ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`Y`;`\ (C,i',(j':num)). (CARD (C DIFF (G (SUC i'))))`] select_image_num_min; UND 12 THEN ASM_REWRITE_TAC[]; TYPE_THEN `?C i' j'. z' = (C,i',j')` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `z'` UNABBREV_TAC; TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `i'` EXISTS_TAC; TYPE_THEN `j'` EXISTS_TAC; USE 11 SYM; REWR 14; USE 11 SYM; USE 14 (REWRITE_RULE[PAIR_SPLIT]); TYPE_THEN `C'` UNABBREV_TAC; TYPE_THEN `i''` UNABBREV_TAC; TYPE_THEN `j''` UNABBREV_TAC; (* -B *) CONJ_TAC; TYPE_THEN `(SUC i' <| j') \/ (SUC i' = j')` SUBAGOAL_TAC; UND 18 THEN ARITH_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `j'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); TYPE_THEN `{x | i' <=| x /\ x <=| SUC i'} = {i'} UNION {(SUC i')}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; ARITH_TAC; REWR 16; USE 16 (REWRITE_RULE[UNIONS_UNION;image_sing;IMAGE_UNION]); (* -- *) THM_INTRO_TAC[`C`;`(G i' UNION G (SUC i'))`;`p`]unbounded_avoidance_subset_ver2; REWRITE_TAC[union_subset]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UND 17 THEN ARITH_TAC; CONJ_TAC; REWRITE_TAC[FINITE_UNION]; TYPE_THEN `i' <=| N` SUBAGOAL_TAC; UND 17 THEN ARITH_TAC; FULL_REWRITE_TAC[conn2]; IMATCH_MP_TAC conn2_rectagon; (* -- *) THM_INTRO_TAC[`C`] bounded_unbounded_disj; USE 24 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPEC `p` 24; UND 24 THEN ASM_REWRITE_TAC[]; (* -C *) TYPE_THEN `X (C'',i''',j''')` SUBAGOAL_TAC; TYPE_THEN `X` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `C''` EXISTS_TAC; TYPE_THEN `i'''` EXISTS_TAC; TYPE_THEN `j'''` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; TSPEC `(C'',i''',j''')` 9; USE 9 (GBETA_RULE); (* - *) TYPE_THEN `Y (C'',i''',j''')` SUBAGOAL_TAC; TYPE_THEN `Y` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `C''` EXISTS_TAC; TYPE_THEN `i'''` EXISTS_TAC; TYPE_THEN `j'''` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`(C'',i''',j''')`]); (*** Removed by JRH; no longer needed with paired beta in default rewrites USE 13 (GBETA_RULE); ***) (* Fri Dec 24 12:26:34 EST 2004 *) ]);; (* }}} *) let endpoint_sub_rectagon = prove_by_refinement( `!C G m. rectagon G /\ C SUBSET G /\ endpoint C m ==> (?!e. G e /\ ~(C e) /\ cls {e} m)`, (* {{{ proof *) [ REP_BASIC_TAC; FULL_REWRITE_TAC[endpoint]; THM_INTRO_TAC[`C`;`pointI m`] num_closure1; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `G` EXISTS_TAC; FULL_REWRITE_TAC[rectagon]; REWR 3; FULL_REWRITE_TAC[rectagon]; KILL 2; TSPEC `m` 4; USE 2 (REWRITE_RULE[INSERT]); USE 2 (ONCE_REWRITE_RULE[TAUT `a \/ b <=> b \/ a`]); FIRST_ASSUM DISJ_CASES_TAC; THM_INTRO_TAC[`G`;`pointI m`] num_closure0; REWR 8; TSPEC `e` 8; USE 1 (REWRITE_RULE[SUBSET]); TSPEC `e` 3; ASM_MESON_TAC[]; (* -A *) COPY 3; TSPEC `e` 8; USE 8 (REWRITE_RULE[]); THM_INTRO_TAC[`G`;`pointI m`] num_closure2; REWR 10; COPY 10; TSPEC `e` 10; TYPE_THEN `G e` SUBAGOAL_TAC; USE 1 (REWRITE_RULE[SUBSET]); TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC; ASM_MESON_TAC[]; REWRITE_TAC[cls]; REWRITE_TAC[EXISTS_UNIQUE_ALT]; (* - *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `b` EXISTS_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `e'` UNABBREV_TAC; TSPEC `y` 12; REWR 12; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `y` UNABBREV_TAC; UND 18 THEN ASM_REWRITE_TAC[]; TYPE_THEN `y` UNABBREV_TAC; TSPEC `b` 3; TSPEC `b` 12; REWR 12; REWR 3; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `a` EXISTS_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `e'` UNABBREV_TAC; TSPEC `y` 12; REWR 12; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `y` UNABBREV_TAC; UND 18 THEN ASM_REWRITE_TAC[]; TYPE_THEN `y` UNABBREV_TAC; TSPEC `a` 3; TSPEC `a` 12; REWR 12; REWR 3; TYPE_THEN `a` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Mon Dec 27 15:17:28 EST 2004 *) ]);; (* }}} *) let cut_rectagon_unique = prove_by_refinement( `!E A B C m n. rectagon E /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\ segment_end A m n /\ segment_end B m n /\ segment_end C m n /\ (E = A UNION B) /\ (A INTER B = EMPTY) ==> (C = A) \/ (C = B)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!A. A SUBSET E /\ segment_end A m n /\ ~(A INTER C = EMPTY) ==> (A SUBSET C)` SUBAGOAL_TAC; TYPE_THEN `inductive_set A' (A' INTER C)` SUBAGOAL_TAC; REWRITE_TAC[inductive_set]; CONJ_TAC; REWRITE_TAC[INTER;SUBSET]; FULL_REWRITE_TAC[INTER]; TYPE_THEN `edge C' /\ edge C''` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end;psegment;segment]; UND 16 THEN UND 15 THEN UND 13 THEN MESON_TAC[subset_imp]; THM_INTRO_TAC[`C'`;`C''`] adjv_adj; THM_INTRO_TAC[`C'`;`C''`] adjv_adj2; TYPE_THEN `q =adjv C' C''` ABBREV_TAC ; TYPE_THEN `~(C' = C'')` SUBAGOAL_TAC; FULL_REWRITE_TAC[adj]; UND 22 THEN ASM_REWRITE_TAC[]; (* --- *) TYPE_THEN `~(endpoint A' q)` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end]; USE 2 SYM; USE 22 (REWRITE_RULE[endpoint]); THM_INTRO_TAC[`A'`;`pointI q`] num_closure1; USE 3 (REWRITE_RULE[psegment;segment]); REWR 27; COPY 27; TSPEC `C'` 27; TSPEC `C''` 28; ASM_MESON_TAC[]; (* ---A *) TYPE_THEN `~(endpoint C q)` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end]; TYPE_THEN `endpoint A'` UNABBREV_TAC; TYPE_THEN `endpoint C` UNABBREV_TAC; UND 22 THEN ASM_REWRITE_TAC[]; (* --- *) PROOF_BY_CONTR_TAC; UND 23 THEN ASM_REWRITE_TAC[]; IMATCH_MP_TAC rectagon_subset_endpoint; USE 1 SYM; TYPE_THEN `E` EXISTS_TAC; CONJ_TAC THEN IMATCH_MP_TAC num_closure_pos; CONJ_TAC; USE 2 (REWRITE_RULE[segment_end;segment;psegment]); TYPE_THEN `C'` EXISTS_TAC; (* --- *) CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; FULL_REWRITE_TAC[rectagon]; TYPE_THEN `C''` EXISTS_TAC; REWRITE_TAC[DIFF]; USE 11 (REWRITE_RULE[SUBSET]); (* -- *) USE 10 (REWRITE_RULE[segment_end;psegment;segment]); FULL_REWRITE_TAC[inductive_set]; UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`A' INTER C`]); ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET_INTER_ABSORPTION]; (* -B *) TYPE_THEN `!A B. (A INTER B = EMPTY ) /\ (E = A UNION B) /\ (segment_end B m n) /\ (segment_end A m n) /\ (B SUBSET E) /\ (A SUBSET E) /\ ~(C INTER A = EMPTY) ==> (C = A)` SUBAGOAL_TAC; TYPE_THEN `A' SUBSET C` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[INTER_COMM]; UND 10 THEN ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `B' INTER C = EMPTY` ASM_CASES_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `A UNION B` UNABBREV_TAC; UND 5 THEN UND 18 THEN UND 17 THEN POP_ASSUM_LIST (fun t-> ALL_TAC); FULL_REWRITE_TAC[SUBSET;INTER;EQ_EMPTY;UNION]; IMATCH_MP_TAC EQ_EXT ; TSPEC `x` 0; TSPEC `x` 1; TSPEC `x` 2; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `B' SUBSET C` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USE 1 SYM; TYPE_THEN `E = C` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[subset_imp]; ASM_MESON_TAC[subset_imp]; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `A UNION B` UNABBREV_TAC; USE 5 (REWRITE_RULE[SUBSET;UNION]); TYPE_THEN `C` UNABBREV_TAC; USE 2 (REWRITE_RULE[segment_end;psegment]); UND 20 THEN ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~(C INTER A = EMPTY) \/ ~( C INTER B = EMPTY)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; USE 11 (REWRITE_RULE[DE_MORGAN_THM]); TYPE_THEN `E` UNABBREV_TAC; FULL_REWRITE_TAC[INTER;EQ_EMPTY]; USE 5 (REWRITE_RULE[SUBSET;UNION]); USE 2 (REWRITE_RULE[segment_end;psegment;segment]); FULL_REWRITE_TAC[EMPTY_EXISTS]; TSPEC `u` 1; TSPEC `u` 11; TSPEC `u` 12; ASM_MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; DISJ1_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `B` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET;UNION]; DISJ2_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `A` EXISTS_TAC; FULL_REWRITE_TAC[INTER_COMM;UNION_COMM]; ASM_REWRITE_TAC[SUBSET;UNION]; (* Mon Dec 27 20:34:44 EST 2004 *) ]);; (* }}} *) let conn2_sequence_lemma5 = prove_by_refinement( `!C E . ~(E SUBSET C) /\ psegment E /\ rectagon C /\ endpoint E SUBSET cls C ==> (?E'. E' SUBSET E /\ psegment E' /\ (E' INTER C = EMPTY ) /\ (cls E' INTER cls C = endpoint E'))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?e. E e /\ ~C e` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `J = segment_of (E DIFF C) e` ABBREV_TAC ; TYPE_THEN `X = { A | psegment A /\ A SUBSET E /\ (A INTER C = EMPTY) /\ (endpoint A SUBSET cls C)}` ABBREV_TAC ; TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC]; TYPE_THEN `X` UNABBREV_TAC; TYPE_THEN `J` EXISTS_TAC; TYPE_THEN `J SUBSET (E DIFF C)` SUBAGOAL_TAC; TYPE_THEN `J` UNABBREV_TAC; THM_INTRO_TAC[`(E DIFF C)`;`e`] segment_of_G; REWRITE_TAC[DIFF]; CONJ_TAC; THM_INTRO_TAC[`E`;`E DIFF C`;`e`] segment_of_segment; FULL_REWRITE_TAC[psegment]; REWRITE_TAC[DIFF;SUBSET]; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[psegment]; DISCH_TAC; THM_INTRO_TAC[`segment_of (E DIFF C) e`;`E`] rectagon_subset; USE 2 (REWRITE_RULE[psegment]); IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `E DIFF C` EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; USE 2 (REWRITE_RULE[psegment]); ASM_MESON_TAC[]; (* -- *) CONJ_TAC; UND 7 THEN REWRITE_TAC[SUBSET;DIFF]; CONJ_TAC; UND 7 THEN REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY] THEN MESON_TAC[]; REWRITE_TAC[SUBSET]; PROOF_BY_CONTR_TAC; (* --A *) THM_INTRO_TAC[`E DIFF C`;`e`] inductive_segment; REWRITE_TAC[DIFF]; FULL_REWRITE_TAC[inductive_set]; USE 8 (REWRITE_RULE[endpoint]); THM_INTRO_TAC[`J`;`pointI x`] num_closure1; TYPE_THEN `J` UNABBREV_TAC; IMATCH_MP_TAC segment_of_finite; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; USE 2 (REWRITE_RULE[psegment;segment]); REWRITE_TAC[DIFF]; REWR 13; USE 2 (REWRITE_RULE[psegment;segment]); TSPEC `x` 15; USE 15 (REWRITE_RULE[INSERT]); UND 15 THEN REP_CASES_TAC; THM_INTRO_TAC[`E`;`pointI x`] num_closure2; REWR 15; (* ---- *) TYPE_THEN `?a b. ~(a = b) /\ (!e. E e /\ closure top2 e (pointI x) <=> (e = a) \/ (e = b)) /\ (!e. J e /\ closure top2 e (pointI x) <=> (e = a))` SUBAGOAL_TAC; TYPE_THEN `(e' = a) \/ (e' = b)` SUBAGOAL_TAC; TSPEC `e'` 15; USE 15 (ONCE_REWRITE_RULE[EQ_SYM_EQ]); TSPEC `e'` 13; TYPE_THEN `J` UNABBREV_TAC; THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G; REWRITE_TAC[DIFF]; USE 21 (REWRITE_RULE[SUBSET]); TSPEC `e'` 21; USE 13 (REWRITE_RULE[DIFF]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e'` UNABBREV_TAC; TYPE_THEN `a` EXISTS_TAC ; TYPE_THEN `b` EXISTS_TAC; MESON_TAC[]; TYPE_THEN `e'` UNABBREV_TAC; TYPE_THEN `b` EXISTS_TAC; TYPE_THEN `a` EXISTS_TAC; REWRITE_TAC [EQ_SYM_EQ ]; MESON_TAC[]; (* ---- *) USE 6 SYM; TYPE_THEN `segment_of (E DIFF C) e b'` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `a'` EXISTS_TAC; CONJ_TAC; TSPEC `a'` 21; TYPE_THEN `J` UNABBREV_TAC; CONJ_TAC; REWRITE_TAC[DIFF]; CONJ_TAC; TSPEC `b'` 22; KILL 15; REWR 22; (* ------ *) USE 9 (REWRITE_RULE[cls]); LEFT 9 "e"; TSPEC `b'` 9; TSPEC `b'` 22; KILL 15; UND 22 THEN ASM_REWRITE_TAC[]; UND 9 THEN ASM_REWRITE_TAC[]; (* ----- *) REWRITE_TAC[adj]; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `pointI x` EXISTS_TAC; KILL 15; COPY 22; TSPEC `a'` 15; TSPEC `b'` 22; REWR 22; REWR 15; (* ---- *) TSPEC `b'` 21; TYPE_THEN `J` UNABBREV_TAC; TSPEC `b'` 22; KILL 15; REWR 6; KILL 13; UND 21 THEN ASM_REWRITE_TAC[]; (* --- *) USE 0 (REWRITE_RULE[SUBSET]); TSPEC `x` 0; USE 0 (REWRITE_RULE[endpoint]); UND 9 THEN ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[`J`;`E`;`pointI x`] num_closure_mono; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[SUBSET]; THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G; REWRITE_TAC[DIFF]; USE 19 (REWRITE_RULE[SUBSET]); TSPEC `x'` 19; USE 6 (REWRITE_RULE[DIFF]); UND 8 THEN UND 15 THEN UND 19 THEN ARITH_TAC; (* -B *) THM_INTRO_TAC[`X`] select_card_min; UND 8 THEN ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `z` EXISTS_TAC; TYPE_THEN `X` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; IMATCH_MP_TAC (TAUT `a /\ b==> b /\ a`); CONJ_TAC; REWRITE_TAC[SUBSET_INTER]; IMATCH_MP_TAC endpoint_cls; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; USE 2 (REWRITE_RULE[psegment;segment]); REWRITE_TAC[INTER;SUBSET]; PROOF_BY_CONTR_TAC; (* - cut along x *) THM_INTRO_TAC[`z`] endpoint_size2; FULL_REWRITE_TAC[has_size2]; TYPE_THEN `segment_end z a b` SUBAGOAL_TAC; REWRITE_TAC[segment_end]; (* - *) THM_INTRO_TAC[`z`;`a`;`b`;`x`] cut_psegment; TYPE_THEN `endpoint z` UNABBREV_TAC; USE 15 (REWRITE_RULE[INR in_pair;DE_MORGAN_THM ]); UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`A`]); CONJ_TAC; USE 20 (REWRITE_RULE[segment_end]); CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `z` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; REWRITE_TAC[EQ_EMPTY;INTER]; USE 10 (REWRITE_RULE[INTER;EQ_EMPTY ]); TSPEC `x'` 10; UND 10 THEN ASM_REWRITE_TAC[]; REWRITE_TAC[UNION]; USE 20 (REWRITE_RULE[segment_end]); REWRITE_TAC[SUBSET;INR in_pair]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `x'` UNABBREV_TAC; USE 7 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[]; USE 9 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); UND 9 THEN REWRITE_TAC[]; IMATCH_MP_TAC card_subset_lt; CONJ_TAC; REWRITE_TAC[SUBSET;UNION]; CONJ_TAC; TYPE_THEN `B = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; USE 24 (REWRITE_RULE[EMPTY_EXISTS]); USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPEC `u` 9; USE 9 (REWRITE_RULE[UNION]); UND 22 THEN ASM_REWRITE_TAC[INTER;EMPTY_EXISTS]; ASM_MESON_TAC[]; TYPE_THEN `B` UNABBREV_TAC; USE 19 (REWRITE_RULE[segment_end;psegment;segment]); (* - *) TYPE_THEN `A UNION B` UNABBREV_TAC; USE 12 (REWRITE_RULE[psegment;segment;]); (* Mon Dec 27 23:01:48 EST 2004 *) ]);; (* }}} *) let conn_splice = prove_by_refinement( `!E AE B a b a' b'. segment_end E a b /\ segment_end AE a' b' /\ segment_end B a' b' /\ AE SUBSET E ==> (?B'. segment_end B' a b /\ B' SUBSET (E DIFF AE) UNION B)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `J= (E DIFF AE) UNION B` ABBREV_TAC ; TYPE_THEN `B SUBSET J` SUBAGOAL_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; (* - *) TYPE_THEN `cls B SUBSET cls J` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; TYPE_THEN `endpoint B SUBSET cls B` SUBAGOAL_TAC; IMATCH_MP_TAC endpoint_cls; USE 1 (REWRITE_RULE[segment_end;segment;psegment]); (* - *) TYPE_THEN `cls B a' /\ cls B b'` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; USE 1 (REWRITE_RULE[segment_end]); CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[INR in_pair ]; TYPE_THEN `cls J a' /\ cls J b'` SUBAGOAL_TAC; USE 6 (REWRITE_RULE[SUBSET]); (* -// *) TYPE_THEN `conn J` SUBAGOAL_TAC ; TYPE_THEN `!x. cls J x ==> (x = a') \/ (?P. segment_end P x a' /\ P SUBSET J)` BACK_TAC; REWRITE_TAC[conn]; TYPE_THEN `a'' = a'` ASM_CASES_TAC; ONCE_REWRITE_TAC[segment_end_symm]; TYPE_THEN `a''` UNABBREV_TAC; TSPEC `b''` 12; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `b''` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `P` EXISTS_TAC; (* --- *) TYPE_THEN `b'' = a'` ASM_CASES_TAC; TYPE_THEN `b''` UNABBREV_TAC; TSPEC `a''` 12; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `a''` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `P` EXISTS_TAC; (* --- *) COPY 12; TSPEC `a''` 18; REWR 15; TSPEC `b''` 12; REWR 12; THM_INTRO_TAC[`P`;`P'`;`a''`;`a'`;`b''`] segment_end_trans; ONCE_REWRITE_TAC[segment_end_symm]; TYPE_THEN `U` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `P UNION P'` EXISTS_TAC; REWRITE_TAC[union_subset]; (* --A// *) TYPE_THEN `x = a'` ASM_CASES_TAC; TYPE_THEN `x = b'` ASM_CASES_TAC; TYPE_THEN `B` EXISTS_TAC; ONCE_REWRITE_TAC [segment_end_symm]; (* -- *) TYPE_THEN `?P. segment_end P x b' /\ P SUBSET J` ASM_CASES_TAC; THM_INTRO_TAC[`P`;`B`;`x`;`b'`;`a'`] segment_end_trans; ONCE_REWRITE_TAC[segment_end_symm]; TYPE_THEN `U` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `P UNION B` EXISTS_TAC; REWRITE_TAC[union_subset]; (* -- *) TYPE_THEN `cls B x` ASM_CASES_TAC; THM_INTRO_TAC[`B`;`a'`;`b'`;`x`] cut_psegment; TYPE_THEN `A` EXISTS_TAC; ONCE_REWRITE_TAC[segment_end_symm]; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; (* --// *) TYPE_THEN `cls E x` SUBAGOAL_TAC; TYPE_THEN `(E DIFF AE) SUBSET E` SUBAGOAL_TAC; REWRITE_TAC[DIFF;SUBSET]; USE 17 (MATCH_MP cls_subset); USE 17 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `J` UNABBREV_TAC; FULL_REWRITE_TAC[cls_union]; USE 12 (REWRITE_RULE[UNION]); REWR 4; (* -- *) TYPE_THEN `cls (E DIFF AE) x` SUBAGOAL_TAC ; TYPE_THEN `J` UNABBREV_TAC; USE 12 (REWRITE_RULE[cls_union]); USE 4 (REWRITE_RULE[UNION]); REWR 4; (* -- *) PROOF_BY_CONTR_TAC; TYPE_THEN `S = {e | E e /\ ~AE e /\ (?x. closure top2 e (pointI x) /\ ~(?P. segment_end P x a' /\ P SUBSET J) /\ ~(?P. segment_end P x b' /\ P SUBSET J) ) }` ABBREV_TAC ; TYPE_THEN `inductive_set E S` SUBAGOAL_TAC; REWRITE_TAC[inductive_set]; SUBCONJ_TAC; TYPE_THEN `S` UNABBREV_TAC; REWRITE_TAC[SUBSET]; SUBCONJ_TAC; USE 18 (REWRITE_RULE[cls]); UND 22 THEN REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `e` EXISTS_TAC; TYPE_THEN `S` UNABBREV_TAC; USE 23 (REWRITE_RULE[DIFF]); TYPE_THEN `x` EXISTS_TAC; (* --- *) TYPE_THEN `S` UNABBREV_TAC; CONJ_TAC; THM_INTRO_TAC[`E`;`AE`;`adjv C C'`] psegment_subset_endpoint; SUBCONJ_TAC; USE 3 (REWRITE_RULE[segment_end]); CONJ_TAC; IMATCH_MP_TAC num_closure_pos; CONJ_TAC; USE 2 (REWRITE_RULE[segment_end;psegment;segment]); TYPE_THEN `C'` EXISTS_TAC; IMATCH_MP_TAC adjv_adj2; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); USE 34 (REWRITE_RULE[SUBSET]); IMATCH_MP_TAC num_closure_pos; CONJ_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; USE 3 (REWRITE_RULE[segment_end;psegment;segment]); TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC [DIFF]; IMATCH_MP_TAC adjv_adj; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); USE 34 (REWRITE_RULE[SUBSET]); USE 2 (REWRITE_RULE[segment_end]); TYPE_THEN `endpoint AE` UNABBREV_TAC; USE 30 (REWRITE_RULE[INR in_pair]); (* ----B *) TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC; TYPE_THEN `adjv C C'` UNABBREV_TAC; FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN (TYPE_THEN`x'` UNABBREV_TAC); UND 24 THEN REWRITE_TAC[]; TYPE_THEN `B` EXISTS_TAC; ONCE_REWRITE_TAC [segment_end_symm]; UND 20 THEN REWRITE_TAC[]; TYPE_THEN `B` EXISTS_TAC; (* ----//B1 *) THM_INTRO_TAC[`C`;`C'`] adjv_adj; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); USE 35 (REWRITE_RULE[SUBSET]); (* ---- *) TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[SUBSET;INR IN_SING;DIFF;UNION]; (* ---- *) TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC; IMATCH_MP_TAC segment_end_sing; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); USE 37 (REWRITE_RULE[SUBSET]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `b'` UNABBREV_TAC; UND 20 THEN REWRITE_TAC[]; TYPE_THEN `{C}` EXISTS_TAC; TYPE_THEN `a'` UNABBREV_TAC; UND 24 THEN REWRITE_TAC[]; TYPE_THEN `{C}` EXISTS_TAC; (* --- *) TYPE_THEN `adjv C C'` EXISTS_TAC; TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); USE 32 (REWRITE_RULE[SUBSET]); CONJ_TAC; IMATCH_MP_TAC adjv_adj2; (* --- *) TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC; TYPE_THEN `adjv C C'` UNABBREV_TAC; (* ---C// *) TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC; IMATCH_MP_TAC segment_end_sing; IMATCH_MP_TAC adjv_adj; TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[SUBSET;DIFF;UNION;INR IN_SING ]; (* --- *) TYPE_THEN `adjv C C' = a'` ASM_CASES_TAC; TYPE_THEN `adjv C C'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 24 THEN ASM_REWRITE_TAC[]; TYPE_THEN `{C}` EXISTS_TAC; TYPE_THEN `adjv C C' = b'` ASM_CASES_TAC; TYPE_THEN `adjv C C'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 20 THEN ASM_REWRITE_TAC[]; TYPE_THEN `{C}` EXISTS_TAC; (* --- repeat from here *) TYPE_THEN `x' = a'` ASM_CASES_TAC; TYPE_THEN `x'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 20 THEN REWRITE_TAC[]; TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `x' = b'` ASM_CASES_TAC; TYPE_THEN `x'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UND 24 THEN REWRITE_TAC[]; TYPE_THEN `B` EXISTS_TAC; ONCE_REWRITE_TAC[segment_end_symm]; (* --- *) CONJ_TAC; UND 24 THEN REWRITE_TAC[]; THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`a'`] segment_end_trans; TYPE_THEN `U` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `{C} UNION P` EXISTS_TAC; REWRITE_TAC[union_subset]; (* ---// *) UND 20 THEN REWRITE_TAC[]; THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`b'`] segment_end_trans; TYPE_THEN `U` EXISTS_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `{C} UNION P` EXISTS_TAC; REWRITE_TAC[union_subset]; (* -- *) TYPE_THEN `S = E` SUBAGOAL_TAC; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[inductive_set]; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `S` UNABBREV_TAC; USE 22 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TYPE_THEN `~(AE = EMPTY)` SUBAGOAL_TAC; USE 2 (REWRITE_RULE[segment_end;segment;psegment]); UND 27 THEN ASM_REWRITE_TAC[]; USE 22 (REWRITE_RULE[EMPTY_EXISTS]); TSPEC `u` 20; UND 20 THEN ASM_REWRITE_TAC[]; USE 0 (REWRITE_RULE[SUBSET]); (* -D// *) FULL_REWRITE_TAC[conn]; TYPE_THEN `~(a = b)` SUBAGOAL_TAC; USE 3 (MATCH_MP segment_end_disj); UND 3 THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[TAUT `a /\ b <=> b /\ a`]; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) TYPE_THEN `!c. endpoint E c /\ cls AE c ==> endpoint AE c` SUBAGOAL_TAC; REWRITE_TAC[endpoint]; THM_INTRO_TAC[`AE`;`E`;`pointI c`] num_closure_mono; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); USE 15 (REWRITE_RULE[endpoint]); REWR 16; USE 16 (MATCH_MP (ARITH_RULE `x <=| 1 ==> (x = 1) \/ (x = 0)`)); FIRST_ASSUM DISJ_CASES_TAC; PROOF_BY_CONTR_TAC; USE 14 (REWRITE_RULE[cls]); THM_INTRO_TAC[`AE`;`pointI c`] num_closure0; USE 2 (REWRITE_RULE[segment_end;psegment;segment]); REWR 20; TSPEC `e` 20; UND 19 THEN ASM_REWRITE_TAC[]; (* -E *) TYPE_THEN `!c. endpoint E c ==> cls J c` SUBAGOAL_TAC; TYPE_THEN `J` UNABBREV_TAC; REWRITE_TAC[cls_union]; REWRITE_TAC[UNION]; TYPE_THEN `cls AE c` ASM_CASES_TAC; TSPEC `c` 14; TYPE_THEN `endpoint AE c` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `endpoint B c` SUBAGOAL_TAC; FULL_REWRITE_TAC[segment_end]; TYPE_THEN `{a',b'}` UNABBREV_TAC; THM_INTRO_TAC[`B`] endpoint_cls; USE 1 (REWRITE_RULE[segment_end;psegment;segment]); DISJ2_TAC; ASM_MESON_TAC[subset_imp]; DISJ1_TAC; TYPE_THEN `E = (E DIFF AE) UNION AE` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; UND 0 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; TYPE_THEN `cls E c` SUBAGOAL_TAC; THM_INTRO_TAC[`E`] endpoint_cls; USE 3 (REWRITE_RULE[segment_end;segment;psegment]); ASM_MESON_TAC[subset_imp]; UND 16 THEN DISCH_THEN (fun t -> USE 17 (ONCE_REWRITE_RULE[t])); FULL_REWRITE_TAC[cls_union]; USE 16 (REWRITE_RULE[UNION ]); REWR 16; (* - *) USE 3 (REWRITE_RULE[segment_end]); TYPE_THEN `endpoint E` UNABBREV_TAC; USE 15 (REWRITE_RULE[INR in_pair]); CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; (* Tue Dec 28 12:02:34 EST 2004 *) ]);; (* }}} *) let conn2_sequence = prove_by_refinement( `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ (!i. (i <= N) ==> (G i SUBSET edge )) /\ (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\ (!i j. (i < j) /\ (j <=| N) /\ ~(SUC i = j) ==> (curve_cell (G i) INTER (curve_cell (G j)) = EMPTY)) /\ (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) ==> (unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) `, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1; ARITH_TAC; THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma2; THM_INTRO_TAC[`G`;`N`] conn2_sequence_lemma3; THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma4; (* - *) TYPE_THEN `?ei. C ei /\ G i ei /\ (!k. i < k /\ k <=|j ==> ~G k ei)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`SUC i`;`j`]); TYPE_THEN `{x | i <=| x /\ x <=| j} = {i} UNION {x | SUC i <= x /\ x <= j}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UNDH 3810 THEN ARITH_TAC; REWRH 1849; USEH 4802 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]); USEH 5681 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]); REWRITE_TAC[SUBSET;UNIONS;IMAGE]; CONV_TAC (dropq_conv "u"); NAME_CONFLICT_TAC; TSPECH `x` 7945; LEFTH 1695 "ei"; TSPECH `x` 5608; LEFTH 1699 "u"; USEH 7623 (CONV_RULE NAME_CONFLICT_CONV); REWRH 2787; TYPE_THEN `G i x` ASM_CASES_TAC; REWRH 2360; LEFTH 4513 "k" ; TYPE_THEN `k` EXISTS_TAC; UNDH 2414 THEN MESON_TAC[ARITH_RULE `a <| b ==> SUC a <=| b`]; REWRH 7623; ASM_MESON_TAC[]; UNDH 5817 THEN UNDH 3810 THEN ARITH_TAC; (* -A *) TYPE_THEN `?ej. C ej /\ G j ej /\ (!k. i <= k /\ k <| j ==> ~G k ej)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`i`;`j -1`]); TYPE_THEN `{x | i <=| x /\ x <=| j} = {j} UNION {x | i <= x /\ x <= j- 1}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UNDH 3810 THEN ARITH_TAC; REWRH 1849; USEH 6712 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]); USEH 7737 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]); REWRITE_TAC[SUBSET;UNIONS;IMAGE]; CONJ_TAC ; UNDH 3810 THEN ARITH_TAC; CONJ_TAC; UNDH 5153 THEN ARITH_TAC; CONV_TAC (dropq_conv "u"); NAME_CONFLICT_TAC; TSPECH `x` 5663; LEFTH 6587 "ej"; TSPECH `x` 613; LEFTH 8601 "u"; USEH 2468 (CONV_RULE NAME_CONFLICT_CONV); REWRH 3770; TYPE_THEN `G j x` ASM_CASES_TAC; REWRH 7772; LEFTH 3203 "k" ; TYPE_THEN `k` EXISTS_TAC; UNDH 9304 THEN MESON_TAC[ARITH_RULE `a <| b ==> a <=| b - 1`]; REWRH 2468; ASM_MESON_TAC[]; UNDH 7805 THEN UNDH 3810 THEN ARITH_TAC; (* -B< *) TYPE_THEN `Ci = {e | C e /\ G i e /\ (!k. i <| k /\ k <=| j ==> ~G k e)}` ABBREV_TAC ; TYPE_THEN `Ci ei` SUBAGOAL_TAC; TYPE_THEN `Ci` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `CiS = segment_of Ci ei` ABBREV_TAC ; TYPE_THEN `segment CiS` SUBAGOAL_TAC; TYPE_THEN `CiS` UNABBREV_TAC; IMATCH_MP_TAC segment_of_segment; TYPE_THEN `C` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; TYPE_THEN `Ci` UNABBREV_TAC; REWRITE_TAC[SUBSET]; (* - *) TYPE_THEN `~Ci ej` SUBAGOAL_TAC THENL [TYPE_THEN `Ci` UNABBREV_TAC;ALL_TAC]; TSPECH `j` 9673; UNDH 375 THEN ASM_REWRITE_TAC[]; UNDH 3810 THEN ARITH_TAC; (* - *) TYPE_THEN `CiS SUBSET Ci` SUBAGOAL_TAC; TYPE_THEN `CiS` UNABBREV_TAC; IMATCH_MP_TAC segment_of_G; (* - *) TYPE_THEN `psegment CiS` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`CiS`;`C`] rectagon_subset; USEH 5119 (REWRITE_RULE[psegment]); REWRH 2394; CONJ_TAC; IMATCH_MP_TAC rectagon_segment; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Ci` EXISTS_TAC; TYPE_THEN `Ci` UNABBREV_TAC; REWRITE_TAC[SUBSET]; TYPE_THEN `C` UNABBREV_TAC; USEH 2712 (REWRITE_RULE[SUBSET]); UNDH 7665 THEN REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`CiS`] endpoint_size2; FULL_REWRITE_TAC[has_size2]; USEH 1801 SYM; (* -C< *) TYPE_THEN `Ci SUBSET C` SUBAGOAL_TAC; TYPE_THEN `Ci` UNABBREV_TAC; REWRITE_TAC[SUBSET]; TYPE_THEN `CiS SUBSET C` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `Ci` EXISTS_TAC; (* - *) TYPE_THEN `!m. endpoint CiS m ==> cls (G (SUC i)) m` SUBAGOAL_TAC; THM_INTRO_TAC[`CiS`;`C`;`m`] endpoint_sub_rectagon; USEH 5941 (REWRITE_RULE[EXISTS_UNIQUE_ALT]); REWRITE_TAC[cls]; TYPE_THEN `e` EXISTS_TAC; TSPECH `e` 8431; USEH 3634 (REWRITE_RULE[cls_edge]); (* -- *) KILLH 3313 THEN KILLH 5237 THEN KILLH 2072 THEN KILLH 4795 THEN KILLH 3667 THEN KILLH 8912; REWRH 142; TYPE_THEN `~Ci e` SUBAGOAL_TAC; KILLH 5989 THEN KILLH 9803 THEN KILLH 1909 THEN KILLH 8416 THEN KILLH 320 THEN KILLH 846; THM_INTRO_TAC[`Ci`;`ei`] inductive_segment; FULL_REWRITE_TAC[inductive_set]; USEH 7070 (REWRITE_RULE[endpoint]); THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1; FULL_REWRITE_TAC[segment]; REWRH 4780; UNDH 8549 THEN DISCH_THEN (THM_INTRO_TAC[`e'`;`e`]); REWRITE_TAC[adj;INTER;EMPTY_EXISTS]; TSPECH `e'` 5120; REWRH 6063; CONJ_TAC; TYPE_THEN `e'` UNABBREV_TAC; UNDH 9580 THEN ASM_REWRITE_TAC[]; TYPE_THEN `pointI m` EXISTS_TAC; TYPE_THEN `CiS` UNABBREV_TAC; UNDH 1420 THEN ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `UNIONS (IMAGE G {x | i <=| x /\ x <=| j}) e` SUBAGOAL_TAC; USEH 1849 (REWRITE_RULE[SUBSET]); USEH 9077 (REWRITE_RULE[UNIONS;IMAGE]); TYPE_THEN `u` UNABBREV_TAC; (* --// *) TYPE_THEN `!y. (SUC i < y) /\ (y <=| N) ==> ~(G y e)` SUBAGOAL_TAC; UNDH 4928 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`y`]); UNDH 8692 THEN ARITH_TAC; USEH 6879 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPECH `{(pointI m)}` 6278; TYPE_THEN `!r. (r <=| N) ==> (G r SUBSET UNIONS (IMAGE G {i | i <=| N}))` SUBAGOAL_TAC; REWRITE_TAC[UNIONS;IMAGE;SUBSET]; CONV_TAC (dropq_conv "u"); TYPE_THEN `r` EXISTS_TAC; (* --- *) TYPE_THEN `!r. (r <=| N) ==> (curve_cell (G r) {(pointI m)} <=> (?e. G r e /\ closure top2 e (pointI m)))` SUBAGOAL_TAC; IMATCH_MP_TAC curve_cell_point; USEH 2858 (REWRITE_RULE[conn2;]); IMATCH_MP_TAC FINITE_SUBSET; UNIFY_EXISTS_TAC; (* --- *) TYPE_THEN `i <=| N` SUBAGOAL_TAC; UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; UNDH 4794 THEN ASM_REWRITE_TAC[]; CONJ_TAC; USEH 7070 (REWRITE_RULE[endpoint]); THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `C` EXISTS_TAC; FULL_REWRITE_TAC[rectagon]; REWRH 4780; TYPE_THEN `e'` EXISTS_TAC; TSPECH `e'` 5120; REWRH 6063; TYPE_THEN `Ci` UNABBREV_TAC; USEH 2281 (REWRITE_RULE[SUBSET]); (* --- *) TYPE_THEN `e` EXISTS_TAC; (* --D< *) PROOF_BY_CONTR_TAC; USEH 1849 (REWRITE_RULE[UNIONS;IMAGE;SUBSET]); TSPECH `e` 5988; FULL_REWRITE_TAC[]; TYPE_THEN `u'` UNABBREV_TAC; TYPE_THEN `x' = i` ASM_CASES_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `Ci` UNABBREV_TAC; UNDH 8814 THEN ASM_REWRITE_TAC[]; TSPECH `k` 8651; TYPE_THEN `k = SUC i` ASM_CASES_TAC; UNDH 9079 THEN ASM_REWRITE_TAC[]; TYPE_THEN `k` UNABBREV_TAC; UNDH 5461 THEN ASM_REWRITE_TAC[]; UNDH 9872 THEN UNDH 5198 THEN UNDH 2528 THEN UNDH 5153 THEN ARITH_TAC; (* -- *) TYPE_THEN `x' = SUC i` ASM_CASES_TAC; TYPE_THEN `x'` UNABBREV_TAC; UNDH 9079 THEN ASM_REWRITE_TAC[]; TSPECH `x'` 8651; UNDH 7878 THEN ASM_REWRITE_TAC[]; UNDH 9481 THEN UNDH 5258 THEN UNDH 5565 THEN UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC; (* - *) COPYH 9674; UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`b`]); USEH 8662 SYM; REWRITE_TAC[]; UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`a`]); USEH 8662 SYM; REWRITE_TAC[]; (* -E *) TYPE_THEN `X = { E | E SUBSET (C UNION (G (SUC i))) /\ ~(E ei) /\ ~(E ej) /\ segment_end E a b }` ABBREV_TAC ; TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC]; TYPE_THEN `X` UNABBREV_TAC; UNDH 8912 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]); UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; THM_INTRO_TAC[`G (SUC i)`] conn2_imp_conn; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; FULL_REWRITE_TAC[conn]; UNDH 6247 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]); TYPE_THEN `S` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `G (SUC i)` EXISTS_TAC; REWRITE_TAC[SUBSET;UNION ]; TSPECH `SUC i` 320; TSPECH `SUC i` 9803; UNDH 8789 THEN DISCH_THEN (THM_INTRO_TAC[]); UNDH 3810 THEN ARITH_TAC; UNDH 5005 THEN DISCH_THEN (THM_INTRO_TAC[]); ARITH_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; USEH 1620 (REWRITE_RULE[SUBSET]); FIRST_ASSUM DISJ_CASES_TAC; UNDH 4837 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ; UNDH 683 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `f = (\ E . CARD (E DIFF C))` ABBREV_TAC ; THM_INTRO_TAC[`X`;`f`] select_image_num_min; UNDH 6007 THEN ASM_REWRITE_TAC[]; TYPE_THEN `E = z` ABBREV_TAC ; TYPE_THEN `z` UNABBREV_TAC; (* -F< *) TYPE_THEN `cls C a /\ cls C b` SUBAGOAL_TAC; TYPE_THEN `cls CiS SUBSET cls C` SUBAGOAL_TAC; IMATCH_MP_TAC cls_subset; USEH 2127 (REWRITE_RULE[SUBSET]); THM_INTRO_TAC[`CiS`] endpoint_cls; USEH 214 (REWRITE_RULE[psegment;segment]); USEH 477 (REWRITE_RULE[SUBSET]); CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (TYPE_THEN `endpoint CiS` UNABBREV_TAC) THEN REWRITE_TAC[INR in_pair]; (* -// *) THM_INTRO_TAC[`C`;`a`;`b`] cut_rectagon_cls; TYPE_THEN `segment_end CiS a b` SUBAGOAL_TAC; REWRITE_TAC[segment_end]; TYPE_THEN `?CjS. (cls (CjS) INTER cls CiS = {a,b}) /\ (CiS INTER CjS = EMPTY) /\ (C = CiS UNION CjS) /\ segment_end CjS a b ` SUBAGOAL_TAC; THM_INTRO_TAC[`C`;`A`;`B`;`CiS`;`a`;`b`] cut_rectagon_unique; REWRITE_TAC[SUBSET;UNION]; FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[INTER_COMM]; ASM_REWRITE_TAC[]; TYPE_THEN `B` UNABBREV_TAC; TYPE_THEN `A` EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[INTER_COMM;UNION_COMM;]; KILLH 7539 THEN KILLH 8335 THEN KILLH 2130 THEN KILLH 6524 THEN KILLH 3863; (* -G< *) TYPE_THEN `CjS ej` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; USEH 2238 (REWRITE_RULE[UNION ]); UNDH 3048 THEN UNDH 2712 THEN UNDH 7665 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC )); USEH 2712 (REWRITE_RULE[SUBSET]); ASM_MESON_TAC[]; (* -// *) TYPE_THEN `CiS ei` SUBAGOAL_TAC; TYPE_THEN `CiS` UNABBREV_TAC; REWRITE_TAC[segment_of_in]; TYPE_THEN `~CjS ei` SUBAGOAL_TAC; UNDH 947 THEN UNDH 1398 THEN UNDH 3558 THEN REWRITE_TAC[INTER;EQ_EMPTY] THEN MESON_TAC[]; (* -// *) TYPE_THEN `~(E SUBSET C)` SUBAGOAL_TAC; TYPE_THEN `X` UNABBREV_TAC; THM_INTRO_TAC[`C`;`CiS`;`CjS`;`E`;`a`;`b`] cut_rectagon_unique; REWRITE_TAC[SUBSET;UNION]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `E` UNABBREV_TAC; UNDH 5338 THEN ASM_REWRITE_TAC[]; TYPE_THEN `E` UNABBREV_TAC; UNDH 442 THEN ASM_REWRITE_TAC[]; (* -H< *) THM_INTRO_TAC[`C`;`E`] conn2_sequence_lemma5; USEH 4704 SYM; CONJ_TAC; TYPE_THEN `X` UNABBREV_TAC; USEH 7614 (REWRITE_RULE[segment_end]); TYPE_THEN `X` UNABBREV_TAC; USEH 7614 (REWRITE_RULE[segment_end]); REWRITE_TAC[SUBSET;INR in_pair]; FIRST_ASSUM (DISJ_CASES_TAC ) THEN (TYPE_THEN `x` UNABBREV_TAC); (* -// *) THM_INTRO_TAC[`E'`] endpoint_size2; FULL_REWRITE_TAC[has_size2]; (* -// *) TYPE_THEN `?E''. E'' SUBSET C /\ ~E'' ei /\ ~E'' ej /\ segment_end E'' a' b'` ASM_CASES_TAC; UNDH 3844 THEN UNDH 6993 THEN UNDH 1260 THEN UNDH 6943 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5435 THEN UNDH 7079 THEN UNDH 2483 THEN UNDH 1489 THEN UNDH 9777 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); (* -- *) TYPE_THEN `X` UNABBREV_TAC; TYPE_THEN `f` UNABBREV_TAC; (* --I< *) THM_INTRO_TAC[`E`;`E'`;`E''`;`a`;`b`;`a'`;`b'`] conn_splice; REWRITE_TAC[segment_end]; TSPECH `B'` 8320; UNDH 8902 THEN DISCH_THEN (THM_INTRO_TAC[]); CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `E UNION E''` EXISTS_TAC ; CONJ_TAC; UNDH 280 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; REWRITE_TAC[union_subset]; UNDH 6943 THEN REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `B' SUBSET E UNION E''` SUBAGOAL_TAC; UNDH 280 THEN REWRITE_TAC[DIFF;SUBSET;UNION] THEN MESON_TAC[]; USEH 9489 (REWRITE_RULE[SUBSET;UNION]); CONJ_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `B' DIFF C SUBSET (E DIFF E') DIFF C` SUBAGOAL_TAC; UNDH 280 THEN UND 3 THEN REWRITE_TAC[SUBSET;DIFF;UNION;] THEN MESON_TAC[]; USEH 8272 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); UNDH 200 THEN ASM_REWRITE_TAC[]; IMATCH_MP_TAC card_subset_lt; CONJ_TAC; UNDH 8308 THEN (REWRITE_TAC[DIFF;SUBSET]) THEN MESON_TAC[]; CONJ_TAC; USEH 7143 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TYPE_THEN `~(E' = EMPTY)` SUBAGOAL_TAC ; USEH 4430 (REWRITE_RULE[psegment;segment]); UNDH 5706 THEN ASM_REWRITE_TAC[]; USEH 5706 (REWRITE_RULE[EMPTY_EXISTS]); TSPECH `u` 5085; USEH 9707 (REWRITE_RULE[DIFF]); USEH 7802 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPECH `u` 6967; UNDH 366 THEN ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; REWRH 2690; USEH 8308 (REWRITE_RULE[SUBSET;DIFF;]); TSPECH `u` 5436; USEH 5435 (REWRITE_RULE[SUBSET]); TSPECH `u` 5036; ASM_MESON_TAC[]; (* -- *) IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `E` EXISTS_TAC; REWRITE_TAC[DIFF;SUBSET]; USEH 7614 (REWRITE_RULE[segment_end;segment;psegment]); (* -J< // (57 HYP here ) *) (* KILLH 846 THEN KILLH 1909 THEN KILLH 5989; ?? *) KILLH 9203 THEN KILLH 4704 THEN KILLH 3558 THEN KILLH 3114 THEN KILLH 5443 THEN KILLH 7079 THEN KILLH 1489 THEN KILLH 6007 THEN KILLH 9461 THEN KILLH 4797 THEN KILLH 8662 THEN KILLH 214; KILLH 4596 THEN KILLH 947 THEN KILLH 5282; (* - *) TYPE_THEN `E' SUBSET C UNION (G (SUC i))` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `E` EXISTS_TAC; TYPE_THEN `X` UNABBREV_TAC; (* - *) TYPE_THEN `E' SUBSET (G (SUC i))` SUBAGOAL_TAC; UNDH 7718 THEN UNDH 7802 THEN REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;UNION] THEN MESON_TAC[]; KILLH 7718; KILLH 7292 THEN KILLH 4330 THEN KILLH 4248 THEN KILLH 2712 THEN KILLH 7665 THEN KILLH 5425 THEN KILLH 5357 THEN KILLH 1285; KILLH 145 THEN KILLH 7070 THEN KILLH 2483 THEN KILLH 9777; KILLH 7420; KILLH 5435; (* -K< *) TYPE_THEN `cls C a' /\ cls C b'` SUBAGOAL_TAC; TYPE_THEN ` endpoint E' SUBSET cls C` SUBAGOAL_TAC; USEH 2907 SYM; KILLH 8660; TYPE_THEN `endpoint E'` UNABBREV_TAC; REWRITE_TAC[SUBSET;INTER]; REWRH 5756; USEH 6207 (REWRITE_RULE[SUBSET;INR in_pair]); CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; (* -// *) TYPE_THEN `?A B. segment_end A a' b' /\ segment_end B a' b' /\ (C = A UNION B) /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {a',b'}) /\ (A ei) /\ (B ej)` SUBAGOAL_TAC; THM_INTRO_TAC[`C`;`a'`;`b'`] cut_rectagon_cls; TYPE_THEN `A ei` ASM_CASES_TAC; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B` EXISTS_TAC; FULL_REWRITE_TAC[INTER_COMM]; LEFTH 4284 "E''"; TSPECH `B` 567; UNDH 469 THEN ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[DE_MORGAN_THM]; UNDH 7424 THEN REP_CASES_TAC; PROOF_BY_CONTR_TAC; UNDH 3642 THEN REWRITE_TAC[SUBSET;UNION]; USEH 8335 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPECH `ei` 554; UNDH 8511 THEN ASM_REWRITE_TAC[]; (* --// *) TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `A` EXISTS_TAC; FULL_REWRITE_TAC[INTER_COMM;UNION_COMM]; CONJ_TAC; UNDH 4532 THEN (TYPE_THEN `C` UNABBREV_TAC) THEN ASM_REWRITE_TAC[UNION]; LEFTH 4284 "E''"; TSPECH `A` 567; PROOF_BY_CONTR_TAC; UNDH 937 THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;UNION]; (* -L< *) TYPE_THEN `~(G (SUC i) ei)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; UNDH 3810 THEN ARITH_TAC; TYPE_THEN `~(G (SUC i) ej)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; ARITH_TAC; (* -// *) TYPE_THEN `psegment_triple A B E'` SUBAGOAL_TAC; UNDH 830 THEN UNDH 8335 THEN UNDH 2130 THEN UNDH 4401 THEN UNDH 3688 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5107 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); FULL_REWRITE_TAC[psegment_triple;segment_end]; CONJ_TAC; TYPE_THEN `C` UNABBREV_TAC; TYPE_THEN `(A INTER E' = EMPTY) /\ (B INTER E' = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; UNDH 7714 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION] THEN MESON_TAC[]; (* --// *) TYPE_THEN `(cls A INTER cls E' = {a',b'}) /\ (cls B INTER cls E' = {a',b'})` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; USEH 9349 (REWRITE_RULE[cls_union]); CONJ_TAC THEN (IMATCH_MP_TAC SUBSET_ANTISYM); CONJ_TAC; TYPE_THEN `endpoint E'` UNABBREV_TAC; TYPE_THEN `{a',b'}` UNABBREV_TAC; REWRITE_TAC[INTER;SUBSET;UNION]; REWRITE_TAC[SUBSET_INTER]; CONJ_TAC; KILLH 2907; TYPE_THEN `{a',b'}` UNABBREV_TAC; REWRITE_TAC[INTER;SUBSET]; TYPE_THEN `{a',b'}` UNABBREV_TAC; IMATCH_MP_TAC endpoint_cls; FULL_REWRITE_TAC[psegment;segment]; CONJ_TAC; TYPE_THEN `{a',b'}` UNABBREV_TAC; TYPE_THEN `endpoint E'` UNABBREV_TAC; REWRITE_TAC[INTER;SUBSET;UNION]; REWRITE_TAC[SUBSET_INTER]; CONJ_TAC; USEH 5640 SYM; IMATCH_MP_TAC endpoint_cls; USEH 4134 (REWRITE_RULE[psegment;segment]); USEH 2907 SYM; IMATCH_MP_TAC endpoint_cls; USEH 4430 (REWRITE_RULE[psegment;segment]); CONJ_TAC THEN IMATCH_MP_TAC segment_end_union_rectagon; FULL_REWRITE_TAC[segment_end]; MESON_TAC[]; FULL_REWRITE_TAC[segment_end]; MESON_TAC[]; (* -M< // *) USEH 2518 (MATCH_MP psegment_triple3); COPYH 7680; USEH 7680 (MATCH_MP bounded_triple_inner_union); USEH 3265 (REWRITE_RULE [SUBSET]); (* TSPEC p deferred ///// *) (* -// *) TYPE_THEN `~(bounded_set (B UNION E') p)` SUBAGOAL_TAC; UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`B UNION E'`;`i`;`j`]); CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC; UNDH 3810 THEN ARITH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `C UNION E'` EXISTS_TAC ; CONJ_TAC; REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[]; TYPE_THEN `A UNION B` UNABBREV_TAC; REWRITE_TAC[union_subset]; REWRITE_TAC[SUBSET;UNIONS;IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `SUC i` EXISTS_TAC; USEH 343 (REWRITE_RULE[SUBSET]); UNDH 3810 THEN ARITH_TAC; REWRH 9345; USEH 1598 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); UNDH 5101 THEN REWRITE_TAC[]; IMATCH_MP_TAC card_subset_lt; CONJ_TAC; UNDH 343 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; CONJ_TAC; USEH 7390 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPECH `ei` 9338; USEH 4016 (REWRITE_RULE[UNION;DIFF]); UNDH 1090 THEN ASM_REWRITE_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `ei` EXISTS_TAC; UNDH 4837 THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[subset_imp]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `A UNION B` EXISTS_TAC; CONJ_TAC; USEH 2130 SYM; USEH 5107 (REWRITE_RULE[rectagon]); REWRITE_TAC[SUBSET;DIFF]; (* -// *) TYPE_THEN `~(bounded_set (E' UNION A) p)` SUBAGOAL_TAC; UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`E' UNION A`;`i`;`j`]); CONJ_TAC; FULL_REWRITE_TAC[psegment_triple]; CONJ_TAC; UNDH 3810 THEN ARITH_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `E' UNION C` EXISTS_TAC ; CONJ_TAC; REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[]; TYPE_THEN `A UNION B` UNABBREV_TAC; REWRITE_TAC[union_subset]; REWRITE_TAC[SUBSET;UNIONS;IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `SUC i` EXISTS_TAC; USEH 343 (REWRITE_RULE[SUBSET]); UNDH 3810 THEN ARITH_TAC; REWRH 9505; USEH 4752 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); UNDH 2448 THEN REWRITE_TAC[]; IMATCH_MP_TAC card_subset_lt; CONJ_TAC; UNDH 343 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; CONJ_TAC; USEH 758 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPECH `ej` 1425; USEH 5076 (REWRITE_RULE[UNION;DIFF]); UNDH 5580 THEN ASM_REWRITE_TAC[]; USEH 3977 (MATCH_MP (TAUT `a \/ b ==> b\/ a`)); FIRST_ASSUM DISJ_CASES_TAC; UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `ej` EXISTS_TAC; UNDH 683 THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[subset_imp]; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `A UNION B` EXISTS_TAC; CONJ_TAC; USEH 2130 SYM; USEH 5107 (REWRITE_RULE[rectagon]); REWRITE_TAC[SUBSET;DIFF]; (* -N< // *) KILLH 3313 THEN KILLH 4532 THEN KILLH 846 THEN KILLH 320 THEN KILLH 8416 THEN KILLH 1909 THEN KILLH 9803 THEN KILLH 5989 THEN KILLH 4430 THEN KILLH 7802 THEN KILLH 6174 THEN KILLH 2907; KILLH 683 THEN KILLH 4837 THEN KILLH 3627 THEN KILLH 2590 THEN KILLH 830 THEN KILLH 8335 THEN KILLH 4401 THEN KILLH 3688; POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)); (* - *) TYPE_THEN `bounded_set (B UNION E' UNION A) p` SUBAGOAL_TAC; IMATCH_MP_TAC bounded_avoidance_subset; TYPE_THEN `C` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; CONJ_TAC; REWRITE_TAC[union_subset]; USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]); CONJ_TAC; REWRITE_TAC[FINITE_UNION]; USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]); CONJ_TAC; TYPE_THEN `A UNION B` UNABBREV_TAC; IMATCH_MP_TAC conn2_rectagon; (* --// *) UNDH 8721 THEN REWRITE_TAC[] THEN (IMATCH_MP_TAC bounded_set_curve_cell_empty); TYPE_THEN `UNIONS (IMAGE G {i | i <=| N})` EXISTS_TAC; TYPE_THEN `B UNION E' UNION A = E' UNION C` SUBAGOAL_TAC; REWRITE_TAC[UNION_ACI ]; REWRITE_TAC[union_subset]; CONJ_TAC; REWRITE_TAC[SUBSET;UNIONS;IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `(SUC i)` EXISTS_TAC; USEH 343 (REWRITE_RULE[SUBSET]); UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; TYPE_THEN `A UNION B` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; IMATCH_MP_TAC UNIONS_UNIONS; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `x'` EXISTS_TAC; UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC; TSPECH `p` 2110; USEH 1588 (ONCE_REWRITE_RULE[UNION]); USEH 6893 (REWRITE_RULE[]); ASM_MESON_TAC[]; (* Tue Dec 28 15:56:13 EST 2004 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION AA *) (* ------------------------------------------------------------------ *) (* finish proof of the connectedness of the complement of an arc *) let real_div_denom = prove_by_refinement( `!z x y . (&0 < z) ==> ((x/ z <= y/ z) <=> (x <= y))`, (* {{{ proof *) [ REP_BASIC_TAC; ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`]; REWRITE_TAC[GSYM real_div_assoc]; ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; FULL_REWRITE_TAC[REAL_MUL_AC]; IMATCH_MP_TAC REAL_LE_RMUL_EQ; ]);; (* }}} *) let real_div_denom_lt = prove_by_refinement( `!z x y . (&0 < z) ==> ((x/ z < y/ z) <=> (x < y))`, (* {{{ proof *) [ REP_BASIC_TAC; ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`]; REWRITE_TAC[GSYM real_div_assoc]; ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; FULL_REWRITE_TAC[REAL_MUL_AC]; IMATCH_MP_TAC REAL_LT_RMUL_EQ; ]);; (* }}} *) let simple_arc_constants = prove_by_refinement( `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ euclid 2 p /\ euclid 2 q ==> (?d N B a d'. (&0 <. d) /\ (&0 <. d') /\ (0 < N) /\ (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\ (C = UNIONS (IMAGE B {i | i <| N})) /\ (!x. C x ==> (&8 * d <= d_euclid x p) /\ (&8 * d <= d_euclid x q)) /\ (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==> (&16 * d' < d_euclid x y)) /\ (!i. (i <| N) ==> (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d)))) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`]simple_arc_compact; THM_INTRO_TAC[`2`] metric_euclid; THM_INTRO_TAC[`C`] simple_arc_nonempty; THM_INTRO_TAC[`top2`] compact_point; FULL_REWRITE_TAC[top2_unions]; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{p}`] compact_distance; FULL_REWRITE_TAC[top2]; REWRITE_TAC[EMPTY_EXISTS]; MESON_TAC[]; FULL_REWRITE_TAC[INR IN_SING]; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{q}`] compact_distance; FULL_REWRITE_TAC[top2]; REWRITE_TAC[EMPTY_EXISTS]; MESON_TAC[]; FULL_REWRITE_TAC[INR IN_SING]; (* - *) TYPE_THEN `p''''` UNABBREV_TAC; TYPE_THEN `p''` UNABBREV_TAC; TYPE_THEN `d = (min_real (d_euclid p''' q) (d_euclid p' p))/(&8)` ABBREV_TAC ; TYPE_THEN `d` EXISTS_TAC; TYPE_THEN `&0 < d` SUBAGOAL_TAC; TYPE_THEN `d` UNABBREV_TAC; IMATCH_MP_TAC REAL_LT_DIV; ASSUME_TAC (REAL_ARITH `&0 < &8`); REWRITE_TAC[min_real] ; THM_INTRO_TAC[`C`] simple_arc_euclid; COND_CASES_TAC; IMATCH_MP_TAC d_euclid_pos2; TYPE_THEN `2` EXISTS_TAC; ASM_MESON_TAC[subset_imp]; IMATCH_MP_TAC d_euclid_pos2; TYPE_THEN `2` EXISTS_TAC; ASM_MESON_TAC[subset_imp]; (* -A// *) TYPE_THEN `(!x. C x ==> &8 * d <= d_euclid x p /\ &8 * d <= d_euclid x q)` SUBAGOAL_TAC; TYPE_THEN `&8 * d = min_real (d_euclid p''' q) (d_euclid p' p)` SUBAGOAL_TAC; TYPE_THEN `d` UNABBREV_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; UND 10 THEN REAL_ARITH_TAC ; UNDH 6289 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`q`]); ASM_REWRITE_TAC[]; UNDH 4386 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`p`]); ASM_REWRITE_TAC[]; THM_INTRO_TAC[`(d_euclid p''' q)`;`d_euclid p' p `] min_real_le; UNDH 4228 THEN UNDH 5042 THEN UNDH 8570 THEN UNDH 8336 THEN REAL_ARITH_TAC; KILLH 8745 THEN KILLH 6021 THEN KILLH 6289 THEN KILLH 371; KILLH 4386 THEN KILLH 6186; (* -B// *) COPYH 3550; USEH 3550 (REWRITE_RULE[simple_arc]); FULL_REWRITE_TAC[top2_unions]; THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; FULL_REWRITE_TAC[uniformly_continuous]; TSPECH `d` 814; FULL_REWRITE_TAC[]; (* - *) TYPE_THEN `?N. &1/delta <= &N` SUBAGOAL_TAC; REWRITE_TAC[REAL_ARCH_SIMPLE]; TYPE_THEN `&0 < &N` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; UNIFY_EXISTS_TAC; TYPE_THEN `&1/ &N <= delta` SUBAGOAL_TAC; UNDH 338 THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; FULL_REWRITE_TAC[REAL_MUL_AC]; TYPE_THEN `N' = 2*N` ABBREV_TAC ; TYPE_THEN `&0 < &N'` SUBAGOAL_TAC; TYPE_THEN `N'` UNABBREV_TAC; FULL_REWRITE_TAC[REAL_OF_NUM_LT]; UNDH 7562 THEN ARITH_TAC; (* - *) TYPE_THEN `!r. (r <= &1/ (&N')) ==> (r < delta)` SUBAGOAL_TAC; TYPE_THEN `&1/ &N' < &1/ &N` SUBAGOAL_TAC; ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`]; REWRITE_TAC[GSYM real_div_assoc]; ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; TYPE_THEN `N'` UNABBREV_TAC; REDUCE_TAC; UNDH 5547 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; UNDH 5945 THEN UNDH 3160 THEN UNDH 532 THEN REAL_ARITH_TAC; (* -C// *) KILLH 1557 THEN KILLH 5945 THEN KILLH 5547 THEN KILLH 338; TYPE_THEN `N'` EXISTS_TAC; TYPE_THEN `B = (\ i. IMAGE f {x | (&i / &N') <= x /\ (x <= &(SUC i)/(&N'))} )` ABBREV_TAC ; TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `a = (\ i. f(&i / &N'))` ABBREV_TAC ; TYPE_THEN `a` EXISTS_TAC; (* - *) THM_INTRO_TAC[`&N'`] real_div_denom; REWRH 9377; (* - *) TYPE_THEN `!x. (&0 <= x/ &N') <=> (&0 <= x)` SUBAGOAL_TAC; UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`x`]); FULL_REWRITE_TAC[REAL_DIV_LZERO]; (* - *) TYPE_THEN `!x. (x/ &N' <= &1) <=> (x <= &N')` SUBAGOAL_TAC; UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`&N'`]); THM_INTRO_TAC[`&N'`] REAL_DIV_REFL; TYPE_THEN `&N'` UNABBREV_TAC; UNDH 869 THEN REAL_ARITH_TAC; REWRH 4881; (* - *) TYPE_THEN `!i x. (i <| N') /\ (&i / &N' <= x) /\ (x <= &(SUC i) / &N') ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC; TYPE_THEN `&0 <= &i / &N' /\ &(SUC i) / (&N') <= &1` BACK_TAC; UNDH 601 THEN UNDH 1707 THEN UNDH 167 THEN UNDH 1199 THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_OF_NUM_LE]; UNDH 9580 THEN ARITH_TAC; (* -D// *) TYPE_THEN `(!i. i <| N' ==> (?x. B i x /\ B i SUBSET open_ball (euclid 2,d_euclid) x d))` SUBAGOAL_TAC; TYPE_THEN `a i` EXISTS_TAC; TYPE_THEN `a` UNABBREV_TAC; SUBCONJ_TAC; TYPE_THEN `B` UNABBREV_TAC; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[REAL_OF_NUM_LE ]; ARITH_TAC; (* -- *) TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[open_ball;IMAGE;SUBSET;]; TYPE_THEN `x` UNABBREV_TAC; USEH 3550 (MATCH_MP simple_arc_euclid); TYPE_THEN `C` UNABBREV_TAC; USEH 3429 (REWRITE_RULE[SUBSET]); CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[REAL_OF_NUM_LE ]; UNDH 9580 THEN ARITH_TAC; (* -- *) CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC image_imp; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[REAL_OF_NUM_LE]; CONJ_TAC; UNDH 9580 THEN ARITH_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; REWRITE_TAC[d_real]; TYPE_THEN `x' <= &i/ &N' + &1/ &N'` SUBAGOAL_TAC; UNDH 3570 THEN REWRITE_TAC[REAL]; REWRITE_TAC[real_div;GSYM REAL_ADD_RDISTRIB]; REWRITE_TAC[GSYM real_div]; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 4551 THEN UNDH 1464 THEN REAL_ARITH_TAC; KILLH 8623 THEN KILLH 2193; KILLH 626 THEN KILLH 4538; (* -E// *) TYPE_THEN `!i. &i / &N' < &(SUC i)/ &N'` SUBAGOAL_TAC; ASM_SIMP_TAC[real_div_denom_lt]; REWRITE_TAC[REAL_OF_NUM_LT]; ARITH_TAC; (* - *) TYPE_THEN `(!i. i <| N' ==> simple_arc_end (B i) (a i) (a (SUC i)))` SUBAGOAL_TAC; TYPE_THEN `a` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[simple_arc_end]; THM_INTRO_TAC[`f`;`&0`;`&1`;`&i/ &N'`;`&(SUC i)/ &N'`] arc_reparameter_gen; IMATCH_MP_TAC inj_subset_domain; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `g` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -F// *) TYPE_THEN `(IMAGE f {x | &0 <= x /\ x <= &1} = UNIONS (IMAGE B {i | i <| N'}))` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNIONS;IMAGE]; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[IMAGE]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; CONV_TAC (dropq_conv "u"); NAME_CONFLICT_TAC; LEFT_TAC "x''"; LEFT_TAC "x''"; TYPE_THEN `x'` EXISTS_TAC; (* --- *) TYPE_THEN `x' = &1` ASM_CASES_TAC; TYPE_THEN `N' -| 1` EXISTS_TAC; FULL_REWRITE_TAC[REAL_LT;REAL_LE]; TYPE_THEN `N' -| 1 <| N'` SUBAGOAL_TAC; UNDH 8859 THEN ARITH_TAC; CONJ_TAC; UNDH 9064 THEN ARITH_TAC; FULL_REWRITE_TAC[GSYM REAL_LT]; ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; REDUCE_TAC; FULL_REWRITE_TAC[REAL_LT]; UND 25 THEN ARITH_TAC; (* --- *) TYPE_THEN `num_abs_of_int (floor (&N' * x'))` EXISTS_TAC; TYPE_THEN `t = &N' * x'` ABBREV_TAC ; TYPE_THEN `x' = t/(&N')` SUBAGOAL_TAC; TYPE_THEN `t` UNABBREV_TAC; REWRITE_TAC[real_div_assoc]; ONCE_REWRITE_TAC[EQ_SYM_EQ ]; IMATCH_MP_TAC REAL_DIV_LMUL; UNDH 3200 THEN UNDH 7688 THEN REAL_ARITH_TAC; TYPE_THEN `&0 <= t` SUBAGOAL_TAC; TYPE_THEN `t` UNABBREV_TAC; IMATCH_MP_TAC REAL_LE_MUL; TYPE_THEN `&:0 <=: (floor t)` SUBAGOAL_TAC; REWRITE_TAC[int_of_num_th;GSYM floor_le]; REWRITE_TAC[GSYM REAL_OF_NUM_LT]; ASM_REWRITE_TAC[REAL;num_abs_of_int_th;GSYM int_abs_th;]; TYPE_THEN `(||: (floor t) = (floor t))` SUBAGOAL_TAC; REWRITE_TAC[INT_ABS_REFL;]; THM_INTRO_TAC[`t`] floor_ineq; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); TYPE_THEN `t < &N' * &1` SUBAGOAL_TAC; TYPE_THEN `t` UNABBREV_TAC; ASM_SIMP_TAC[REAL_LT_LMUL_EQ]; UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC; CONJ_TAC; UNDH 5082 THEN REAL_ARITH_TAC; TYPE_THEN `real_of_int (floor (&N' )) = &N'` SUBAGOAL_TAC; REWRITE_TAC[floor_num;int_of_num_th;]; UNDH 6307 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); REWRITE_TAC[GSYM int_lt ]; IMATCH_MP_TAC (INT_ARITH `~(x = y) /\ (x <= y) ==> (x <: y)`); CONJ_TAC; FULL_REWRITE_TAC[floor_range]; FULL_REWRITE_TAC[int_of_num_th;floor_num]; UNDH 1048 THEN UNDH 6689 THEN REAL_ARITH_TAC; IMATCH_MP_TAC floor_mono; UNDH 1048 THEN REAL_ARITH_TAC; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `x''` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` EXISTS_TAC; (* -G// *) TYPE_THEN `!i. (i <| N') ==> compact top2 (B i)` SUBAGOAL_TAC; UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); USEH 9744 (MATCH_MP simple_arc_end_simple); USEH 3463 (MATCH_MP simple_arc_compact); (* - *) TYPE_THEN `!i. (i <| N') ==> ~(B i = EMPTY)` SUBAGOAL_TAC; UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); USEH 9744 (MATCH_MP simple_arc_end_simple); USEH 3463 (MATCH_MP simple_arc_nonempty); UNDH 8481 THEN ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!k. ?dij. !i j. (k = (i,j)) /\ SUC i < j /\ j < N' ==> (&0 < dij /\ (!x y. B i x /\ B j y ==> dij <= d_euclid x y))` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT]; CONV_TAC (dropq_conv "i"); CONV_TAC (dropq_conv "j"); TYPE_THEN `i = FST k` ABBREV_TAC ; TYPE_THEN `j = SND k` ABBREV_TAC ; RIGHT_TAC "y"; RIGHT_TAC "x"; RIGHT_TAC "dij"; THM_INTRO_TAC[`(euclid 2)`;`d_euclid`;`(B i)`;`(B j)`] compact_distance; CONJ_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; FULL_REWRITE_TAC[top2]; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; TYPE_THEN `d_euclid p' p''` EXISTS_TAC; (* -- *) CONJ_TAC; IMATCH_MP_TAC d_euclid_pos2; TYPE_THEN `2` EXISTS_TAC; CONJ_TAC; TYPE_THEN `p''` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; USEH 7066 (REWRITE_RULE[IMAGE]); USEH 6258 (REWRITE_RULE[IMAGE]); TYPE_THEN `p'` UNABBREV_TAC; TYPE_THEN `x = x'` SUBAGOAL_TAC; FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); UNIFY_EXISTS_TAC; UNIFY_EXISTS_TAC; UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `&j/ &N' <= &(SUC i) / (&N')` SUBAGOAL_TAC THENL[IMATCH_MP_TAC REAL_LE_TRANS;ALL_TAC]; UNIFY_EXISTS_TAC; UNDH 5902 THEN ASM_REWRITE_TAC[]; UNDH 4223 THEN UNDH 3810 THEN REWRITE_TAC[REAL_LE] THEN ARITH_TAC; (* --- *) TYPE_THEN `(i <| N')` SUBAGOAL_TAC; UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; TYPE_THEN `!i x. (i <| N') /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC; TSPECH `i'` 8913; USEH 9316 (MATCH_MP simple_arc_end_simple); USEH 5604 (MATCH_MP simple_arc_euclid); ASM_MESON_TAC[subset_imp]; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); UNIFY_EXISTS_TAC; UNIFY_EXISTS_TAC; (* -- *) FIRST_ASSUM IMATCH_MP_TAC ; (* -H// *) LEFTH 8852 "dij"; TYPE_THEN `?d''. (&0 < d'') /\ (!i j. (SUC i < j /\ j <| N') ==> (d'' <= dij (i,j)))` SUBAGOAL_TAC; TYPE_THEN `X = { r | (?i j. SUC i < j /\ j <| N' /\ (r = dij (i,j))) }` ABBREV_TAC ; TYPE_THEN `d'' = inf X` ABBREV_TAC ; TYPE_THEN `X = IMAGE dij {(i,j) | (SUC i < j /\ j < N')}` SUBAGOAL_TAC; TYPE_THEN `X` UNABBREV_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE;]; NAME_CONFLICT_TAC; POP_ASSUM_LIST (fun t->ALL_TAC); IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; CONV_TAC (dropq_conv "x'"); ASM_MESON_TAC[]; TYPE_THEN `x'` UNABBREV_TAC; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `FINITE X` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `A = {i | (i <| N')}` ABBREV_TAC ; TYPE_THEN `{(i,j) | A i /\ A j}` EXISTS_TAC; CONJ_TAC; THM_INTRO_TAC[`A`;`A`] FINITE_PRODUCT; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[FINITE_NUMSEG_LT]; REWRITE_TAC[SUBSET;]; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN`i` EXISTS_TAC; TYPE_THEN `j` EXISTS_TAC; UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; (* --// *) TYPE_THEN `X = EMPTY` ASM_CASES_TAC; TYPE_THEN `&1` EXISTS_TAC; REWRH 9106; USEH 3802 SYM; USEH 7502 (REWRITE_RULE[image_empty]); USEH 1549 (REWRITE_RULE[EQ_EMPTY]); TSPECH `(i,j)` 7313 ; LEFTH 4977 "i'"; TSPECH `i` 9356; LEFTH 6976 "j'"; TSPECH `j` 1468; UNDH 5891 THEN ASM_REWRITE_TAC[]; (* --H2// *) THM_INTRO_TAC[`X`] finite_inf_min; THM_INTRO_TAC[`X`] finite_inf; TYPE_THEN `d''` EXISTS_TAC; USEH 9106 SYM; (* TYPE_THEN `d''` UNABBREV_TAC; *) (* -- *) CONJ_TAC; TYPE_THEN `?i j. SUC i <| j /\ j <| N' /\ (d'' = dij (i,j))` SUBAGOAL_TAC; UNDH 7611 THEN ASM_REWRITE_TAC[] THEN UNDH 3235 THEN DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]); ASM_REWRITE_TAC[]; REP_BASIC_TAC; UNDH 6732 THEN DISCH_THEN (THM_INTRO_TAC[`dij (i,j)`]); UNDH 3235 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); ASM_MESON_TAC[]; USEH 7679 SYM; ASM_REWRITE_TAC[]; (* -I *) TYPE_THEN `d' = d''/ &32` ABBREV_TAC ; TYPE_THEN `&0 < &32` SUBAGOAL_TAC; REAL_ARITH_TAC; TYPE_THEN `d'` EXISTS_TAC; SUBCONJ_TAC; TYPE_THEN `d'` UNABBREV_TAC; ASM_SIMP_TAC[REAL_LT_RDIV_0]; SUBCONJ_TAC; FULL_REWRITE_TAC[REAL_LT]; (* - *) IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `d''` EXISTS_TAC; CONJ_TAC; TYPE_THEN `d'` UNABBREV_TAC; REWRITE_TAC[GSYM real_div_assoc]; ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; REWRITE_TAC[REAL_MUL_AC]; IMATCH_MP_TAC REAL_LT_LMUL; REAL_ARITH_TAC; (* -/// *) UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `dij (i,j)` EXISTS_TAC; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); (* Wed Dec 29 17:40:18 EST 2004 *) ]);; (* }}} *) let euclid_scale_rinv = prove_by_refinement( `!x r. (&0 < r) ==> ((r * &1/ r) *# x = x)`, (* {{{ proof *) [ REP_BASIC_TAC; USEH 6412 (MATCH_MP (REAL_ARITH `&0 < r ==> ~(r = &0)`)); ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one]; ]);; (* }}} *) let euclid_scale_bij = prove_by_refinement( `!r . (&0 < r) ==> BIJ (euclid_scale r) (euclid 2) (euclid 2)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[BIJ;INJ;]; TYPE_THEN `!x. (r * &1 / r) *# x = x` SUBAGOAL_TAC; USEH 6412 (MATCH_MP (REAL_ARITH `&0 < r ==> ~(r = &0)`)); ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one]; SUBCONJ_TAC; CONJ_TAC; IMATCH_MP_TAC euclid_scale_closure; TYPE_THEN `euclid_scale (&1/ r)` (fun t -> USEH 9290 (AP_TERM t)); FULL_REWRITE_TAC[euclid_scale_act]; USEH 7114 (ONCE_REWRITE_RULE[REAL_ARITH `x * y = y *x`]); REWRH 5498; REWRITE_TAC[SURJ]; REP_BASIC_TAC; TYPE_THEN`(&1/ r) *# x` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC euclid_scale_closure; REWRITE_TAC[euclid_scale_act]; ]);; (* }}} *) let euclid_scale_cont = prove_by_refinement( `!r. (&0 < r) ==> (continuous (euclid_scale r) top2 top2)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`( *# ) r`] metric_continuous_continuous_top2; REWRITE_TAC[IMAGE;SUBSET]; IMATCH_MP_TAC euclid_scale_closure; REWRITE_TAC[metric_continuous;metric_continuous_pt]; TYPE_THEN `epsilon/r` EXISTS_TAC; SUBCONJ_TAC; IMATCH_MP_TAC REAL_LT_DIV; THM_INTRO_TAC[`2`;`r`;`x`;`y`] norm_scale_vec; TYPE_THEN `abs r = r` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_REFL]; UNDH 6412 THEN REAL_ARITH_TAC; UNDH 3108 THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; FULL_REWRITE_TAC[REAL_MUL_AC]; ]);; (* }}} *) let euclid_scale_inv = prove_by_refinement( `!r x. (&0 < r) /\ (euclid 2 x) ==> (INV (( *# ) r) (euclid 2) (euclid 2) x = (( *# ) (&1 / r)) x)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`( *# ) r`;`(euclid 2)`;`(euclid 2)`;`&1 / r *# x`;`x`] INVERSE_XY; ASM_SIMP_TAC[euclid_scale_bij]; IMATCH_MP_TAC euclid_scale_closure; USEH 6412 (MATCH_MP (REAL_ARITH `&0 < r ==> ~(r = &0)`)); REWRITE_TAC[euclid_scale_act]; ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one]; ]);; (* }}} *) let euclid_scale_homeo = prove_by_refinement( `!r. (&0 < r) ==> homeomorphism (euclid_scale r) top2 top2`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC bicont_homeomorphism; REWRITE_TAC[top2_unions]; ASM_SIMP_TAC [euclid_scale_bij]; ASM_SIMP_TAC[euclid_scale_cont]; IMATCH_MP_TAC cont_domain; TYPE_THEN `( *# ) (&1 / r)` EXISTS_TAC; TYPE_THEN `&0 < &1 /r` SUBAGOAL_TAC; ASM_SIMP_TAC[euclid_scale_cont]; FULL_REWRITE_TAC[top2_unions]; ASM_SIMP_TAC[euclid_scale_inv]; (* Wed Dec 29 18:45:44 EST 2004 *) ]);; (* }}} *) let simple_arc_end_homeo = prove_by_refinement( `!f C a b. simple_arc_end C a b /\ homeomorphism f top2 top2 ==> simple_arc_end (IMAGE f C) (f a) (f b)`, (* {{{ proof *) [ REWRITE_TAC[simple_arc_end_cont]; TYPE_THEN `f o f'` EXISTS_TAC; REWRITE_TAC[IMAGE_o]; TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBAGOAL_TAC; IMATCH_MP_TAC metric_subspace; TYPE_THEN `UNIV:real->bool` EXISTS_TAC; REWRITE_TAC[metric_real]; (* - *) TYPE_THEN `UNIONS (top_of_metric (({x | &0 <= x /\ x <= &1},d_real))) = {x | &0 <= x /\ x <= &1}` SUBAGOAL_TAC; IMATCH_MP_TAC (GSYM top_of_metric_unions); (* - *) CONJ_TAC; IMATCH_MP_TAC continuous_comp; TYPE_THEN `top2` EXISTS_TAC; REWRITE_TAC[top2_unions]; FULL_REWRITE_TAC[homeomorphism]; (* -- *) IMATCH_MP_TAC inj_image_subset; (* - *) CONJ_TAC; REWRITE_TAC[comp_comp]; IMATCH_MP_TAC COMP_INJ; TYPE_THEN `(euclid 2)` EXISTS_TAC; FULL_REWRITE_TAC[homeomorphism]; FULL_REWRITE_TAC[top2_unions;BIJ]; REWRITE_TAC[o_DEF]; ]);; (* }}} *) let simple_arc_homeo = prove_by_refinement( `!f C. simple_arc top2 C /\ homeomorphism f top2 top2 ==> simple_arc top2 (IMAGE f C)`, (* {{{ proof *) [ REP_BASIC_TAC; RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]); TYPE_THEN `simple_arc_end C (f' (&0)) (f' (&1))` SUBAGOAL_TAC; REWRITE_TAC[simple_arc_end]; TYPE_THEN `f'` EXISTS_TAC; FULL_REWRITE_TAC[top2_unions]; THM_INTRO_TAC[`f`;`C`;`f' (&0)`;`f' (&1)`] simple_arc_end_homeo; USEH 6603 (MATCH_MP simple_arc_end_simple); TYPE_THEN `C` UNABBREV_TAC; ]);; (* }}} *) let euclid_scale_simple_arc_ver2 = prove_by_refinement( `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ (euclid 2 p) /\ (euclid 2 q) /\ ~(p = q) /\ (!A. simple_arc_end A p q ==> ~(C INTER A = EMPTY)) ==> (?C' p' q' d N B a d'. simple_arc top2 C' /\ ~C' p' /\ ~C' q' /\ (euclid 2 p') /\ (euclid 2 q') /\ ~(p' = q') /\ (!A. simple_arc_end A p' q' ==> ~(C' INTER A = EMPTY)) /\ (&1 <=. d) /\ (&1 <=. d') /\ (0 < N) /\ (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\ (C' = UNIONS (IMAGE B {i | i <| N})) /\ (!x. C' x ==> (&8 * d <= d_euclid x p') /\ (&8 * d <= d_euclid x q')) /\ (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==> (&16 * d' < d_euclid x y)) /\ (!i. (i <| N) ==> (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d)))) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`;`p`;`q`] simple_arc_constants; TYPE_THEN `r = min_real d d'` ABBREV_TAC ; TYPE_THEN `f = ( *# ) (&1 /r)` ABBREV_TAC ; TYPE_THEN `C' = IMAGE f C` ABBREV_TAC ; TYPE_THEN `B' = (IMAGE f) o B` ABBREV_TAC ; TYPE_THEN `p' = f p` ABBREV_TAC ; TYPE_THEN `q' = f q` ABBREV_TAC ; TYPE_THEN `dr = d/r` ABBREV_TAC ; TYPE_THEN `dr' = d'/r` ABBREV_TAC ; TYPE_THEN `a' = f o a` ABBREV_TAC ; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `p'` EXISTS_TAC; TYPE_THEN `q'` EXISTS_TAC; TYPE_THEN `dr` EXISTS_TAC; TYPE_THEN `N` EXISTS_TAC; TYPE_THEN `B'` EXISTS_TAC; TYPE_THEN `a'` EXISTS_TAC; TYPE_THEN `dr'` EXISTS_TAC; (* -A *) TYPE_THEN `&0 < r` SUBAGOAL_TAC; TYPE_THEN `r` UNABBREV_TAC; REWRITE_TAC[min_real]; COND_CASES_TAC; TYPE_THEN `&0 < &1/ r` SUBAGOAL_TAC; (* - *) TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC; TYPE_THEN `f` UNABBREV_TAC; IMATCH_MP_TAC euclid_scale_homeo; USEH 5104 SYM; SUBCONJ_TAC; TYPE_THEN `C'` UNABBREV_TAC; IMATCH_MP_TAC simple_arc_homeo; (* - *) TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC; USEH 3550 (MATCH_MP simple_arc_euclid); IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; (* - *) SUBCONJ_TAC; TYPE_THEN `C'` UNABBREV_TAC; TYPE_THEN `p'` UNABBREV_TAC; UNDH 9726 THEN ASM_REWRITE_TAC[]; USEH 7428 (REWRITE_RULE[IMAGE]); FULL_REWRITE_TAC[homeomorphism;BIJ;INJ]; TYPE_THEN `(x = p)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[top2_unions]; TYPE_THEN `p` UNABBREV_TAC; (* - *) SUBCONJ_TAC; TYPE_THEN `C'` UNABBREV_TAC; TYPE_THEN `q'` UNABBREV_TAC; UNDH 6497 THEN ASM_REWRITE_TAC[]; USEH 4199 (REWRITE_RULE[IMAGE]); FULL_REWRITE_TAC[homeomorphism;BIJ;INJ]; TYPE_THEN `(q = x)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[top2_unions]; TYPE_THEN `q` UNABBREV_TAC; (* -B *) TYPE_THEN `euclid 2 p' /\ euclid 2 q'` SUBAGOAL_TAC; TYPE_THEN `p'` UNABBREV_TAC; TYPE_THEN `q'` UNABBREV_TAC; FULL_REWRITE_TAC[homeomorphism;BIJ;SURJ;top2_unions]; (* -// *) CONJ_TAC; TYPE_THEN `p'` UNABBREV_TAC; TYPE_THEN `q'` UNABBREV_TAC; FULL_REWRITE_TAC[homeomorphism;BIJ;INJ]; UNDH 11 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[top2_unions]; (* - *) CONJ_TAC; TYPE_THEN `g = ( *# ) r` ABBREV_TAC ; TYPE_THEN `A' = IMAGE g A` ABBREV_TAC ; TYPE_THEN`homeomorphism g top2 top2` SUBAGOAL_TAC; TYPE_THEN `g` UNABBREV_TAC; ASM_SIMP_TAC[euclid_scale_homeo]; TSPECH `A'` 8219; TYPE_THEN `!x. (g (f x) = x)` SUBAGOAL_TAC; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `f` UNABBREV_TAC; REWRITE_TAC[euclid_scale_act]; ASM_SIMP_TAC [euclid_scale_rinv]; (* -- *) UNDH 5082 THEN DISCH_THEN (THM_INTRO_TAC[]); TYPE_THEN `A'` UNABBREV_TAC; TYPE_THEN `(p = g p') /\ (q = g q')` SUBAGOAL_TAC; TYPE_THEN `p'` UNABBREV_TAC; TYPE_THEN `q'` UNABBREV_TAC; IMATCH_MP_TAC simple_arc_end_homeo; USEH 7123 (REWRITE_RULE[INTER;EMPTY_EXISTS]); USEH 8329 (REWRITE_RULE[EQ_EMPTY;INTER]); TSPECH `f u` 5681; UNDH 1812 THEN REWRITE_TAC[]; TYPE_THEN `C'` UNABBREV_TAC; CONJ_TAC; IMATCH_MP_TAC image_imp; TYPE_THEN `A'` UNABBREV_TAC; USEH 1648 (REWRITE_RULE[IMAGE]); TYPE_THEN `f` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; REWRITE_TAC[euclid_scale_act]; ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`]; ASM_SIMP_TAC[euclid_scale_rinv]; (* -C *) CONJ_TAC; TYPE_THEN `dr` UNABBREV_TAC; TYPE_THEN `r` UNABBREV_TAC; ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; REDUCE_TAC; REWRITE_TAC[min_real_le]; CONJ_TAC; TYPE_THEN `dr'` UNABBREV_TAC; TYPE_THEN `r` UNABBREV_TAC; ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; REDUCE_TAC; REWRITE_TAC[min_real_le]; (* - *) CONJ_TAC; TYPE_THEN `B'` UNABBREV_TAC; TYPE_THEN `a'` UNABBREV_TAC; REWRITE_TAC[o_DEF]; IMATCH_MP_TAC simple_arc_end_homeo; (* - *) CONJ_TAC; TYPE_THEN `C'` UNABBREV_TAC; TYPE_THEN `B'` UNABBREV_TAC; REWRITE_TAC[IMAGE_o]; REWRITE_TAC[GSYM image_unions]; (* - *) TYPE_THEN `!x y. (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid (f x) (f y) = (d_euclid x y)/r)` SUBAGOAL_TAC; TYPE_THEN `f` UNABBREV_TAC; THM_INTRO_TAC[`2`;`&1 / r`;`x`;`y`] norm_scale_vec; TYPE_THEN `abs (&1/r) = &1/r` SUBAGOAL_TAC; REWRITE_TAC[ABS_REFL]; UNDH 4597 THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_ARITH `x * y = y* x`]; REWRITE_TAC[GSYM real_div_assoc]; REDUCE_TAC; (* -D *) CONJ_TAC; TYPE_THEN `C'` UNABBREV_TAC; USEH 3184 (REWRITE_RULE[IMAGE]); TYPE_THEN `p'` UNABBREV_TAC; TYPE_THEN `q'` UNABBREV_TAC; ASM_SIMP_TAC[]; TYPE_THEN `dr` UNABBREV_TAC; REWRITE_TAC[GSYM real_div_assoc]; ASM_SIMP_TAC[real_div_denom]; (* - *) TYPE_THEN `!i x. (i <| N) /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC; UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); USEH 9744 (MATCH_MP simple_arc_end_simple); USEH 3463 (MATCH_MP simple_arc_euclid); USEH 4246 (REWRITE_RULE[SUBSET]); (* - *) CONJ_TAC; TYPE_THEN `B'` UNABBREV_TAC; FULL_REWRITE_TAC[o_DEF]; USEH 407 (REWRITE_RULE[IMAGE]); USEH 3121 (REWRITE_RULE[IMAGE]); TYPE_THEN `i <| N` SUBAGOAL_TAC; UNDH 3810 THEN UNDH 1688 THEN ARITH_TAC; UNDH 2436 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x'`]); CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_MESON_TAC[]; TYPE_THEN `dr'` UNABBREV_TAC; REWRITE_TAC[GSYM real_div_assoc]; ASM_SIMP_TAC[real_div_denom_lt]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[]; (* -E *) TSPECH `i` 4673; REWRITE_TAC[]; TYPE_THEN `f x` EXISTS_TAC; TYPE_THEN `B'` UNABBREV_TAC; REWRITE_TAC[o_DEF]; SUBCONJ_TAC; IMATCH_MP_TAC image_imp; FULL_REWRITE_TAC[SUBSET;open_ball]; USEH 4418 (REWRITE_RULE[IMAGE]); TSPECH `x''` 7148; (* - *) CONJ_TAC; TYPE_THEN `f` UNABBREV_TAC; IMATCH_MP_TAC euclid_scale_closure; CONJ_TAC; TYPE_THEN `f` UNABBREV_TAC; IMATCH_MP_TAC euclid_scale_closure; ASM_SIMP_TAC[]; TYPE_THEN `dr` UNABBREV_TAC; ASM_SIMP_TAC[real_div_denom_lt]; (* Thu Dec 30 10:14:03 EST 2004 *) ]);; (* }}} *) let delta_pos_arch = prove_by_refinement( `!d. (&0 < d) ==> (?n. (0 <| n) /\ (&1/(&n) < d))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`&1/d`] REAL_ARCH_SIMPLE; TYPE_THEN `2 * n` EXISTS_TAC; SUBCONJ_TAC; REWRITE_TAC[LT_MULT]; CONJ_TAC; ARITH_TAC; REWRITE_TAC[GSYM REAL_LT]; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `&1 / d` EXISTS_TAC; (* - *) IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN `&1/ &n` EXISTS_TAC; (* - *) TYPE_THEN `&0 < &(2 *| n)` SUBAGOAL_TAC; REWRITE_TAC[REAL_LT]; TYPE_THEN `&0 < &n` SUBAGOAL_TAC; FULL_REWRITE_TAC[REAL_LT]; FULL_REWRITE_TAC[LT_MULT]; CONJ_TAC; ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`]; REWRITE_TAC[GSYM real_div_assoc]; ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; REDUCE_TAC; FULL_REWRITE_TAC[REAL_LT]; UNDH 3476 THEN ARITH_TAC; UNDH 27 THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; FULL_REWRITE_TAC[REAL_MUL_AC]; ]);; (* }}} *) let suc_div = prove_by_refinement( `!i a. &(SUC i) / a = &i/ a + &1/a`, (* {{{ proof *) [ REWRITE_TAC[REAL]; REWRITE_TAC[real_div]; REAL_ARITH_TAC; ]);; (* }}} *) let delta_partition_lemma_ver2 = prove_by_refinement( `!delta. (&0 < delta) ==> (?M. !N. !x. ?i. (0 < M) /\ ((M <= N) /\ (&0 <= x /\ x <= &1) ==> (i <= N) /\ abs (&i/ &N - x) < delta))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE; TYPE_THEN `n` EXISTS_TAC; TYPE_THEN `num_abs_of_int (floor (&N*x))` EXISTS_TAC; TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC; TYPE_THEN `&0 < &n` SUBAGOAL_TAC; UND 1 THEN UND 2 THEN REAL_ARITH_TAC; TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC; ASM_MESON_TAC[REAL_LE_LDIV_EQ]; CONJ_TAC; FULL_REWRITE_TAC[REAL_LT]; TYPE_THEN `&:0 <= floor (&N * x)` SUBAGOAL_TAC; TYPE_THEN `floor (&0) <=: floor (&N * x)` BACK_TAC; FULL_REWRITE_TAC[floor_num]; IMATCH_MP_TAC floor_mono; IMATCH_MP_TAC REAL_LE_MUL; (* - *) CONJ_TAC; TYPE_THEN `num_abs_of_int (floor (&N * x)) <= num_abs_of_int (floor (&N))` BACK_TAC; FULL_REWRITE_TAC[floor_num;num_abs_of_int_num]; IMATCH_MP_TAC num_abs_of_int_mono; IMATCH_MP_TAC floor_mono; TYPE_THEN `&N * x <= &N * &1` BACK_TAC; UND 9 THEN REAL_ARITH_TAC; IMATCH_MP_TAC REAL_PROP_LE_LMUL; (* -A *) IMATCH_MP_TAC REAL_LT_LCANCEL_IMP; TYPE_THEN `&N` EXISTS_TAC; (* - *) TYPE_THEN `&0 < &N` SUBAGOAL_TAC; FULL_REWRITE_TAC[REAL_LT]; UNDH 3476 THEN UNDH 9390 THEN ARITH_TAC; IMATCH_MP_TAC REAL_LTE_TRANS; TYPE_THEN`&1` EXISTS_TAC; (* - *) REWRITE_TAC[num_abs_of_int_th;]; TYPE_THEN `abs (real_of_int (floor (&N * x))) = (real_of_int (floor (&N *x)))` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_REFL]; FULL_REWRITE_TAC [int_le; int_of_num_th;]; TYPE_THEN `!u. &N * abs (u / &N - x) = abs (u - &N*x)` SUBAGOAL_TAC; TYPE_THEN `!t. &N * abs t = abs (&N *t)` SUBAGOAL_TAC; REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM]; AP_TERM_TAC; REWRITE_TAC[REAL_SUB_LDISTRIB]; TYPE_THEN `&N * u/ &N = u` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_DIV_LMUL; UND 12 THEN UND 9 THEN REAL_ARITH_TAC; TYPE_THEN `t = &N * x ` ABBREV_TAC ; TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC; REWRITE_TAC[floor_ineq]; TYPE_THEN `abs (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC; UND 13 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`t`] floor_ineq; CONJ_TAC; UND 15 THEN REAL_ARITH_TAC; (* - *) IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `&n * delta` EXISTS_TAC; ASM_SIMP_TAC[REAL_LE_RMUL_EQ]; FULL_REWRITE_TAC[REAL_LE]; ]);; (* }}} *) let simple_arc_ball_cover_ver2 = prove_by_refinement( `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> (?M. !N. !x. ?i. (0 < M) /\ (( M <= N) /\ (&0 <= x /\ x <= &1) ==> (i <= N) /\ open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; FULL_REWRITE_TAC[uniformly_continuous]; TSPECH `&1` 814; UNDH 4636 THEN DISCH_THEN (THM_INTRO_TAC[]); REWRITE_TAC[open_ball]; THM_INTRO_TAC[`delta`] delta_partition_lemma_ver2; TYPE_THEN `M` EXISTS_TAC; TSPECH `N` 6807; TSPECH `x` 8373; TYPE_THEN `i` EXISTS_TAC; REP_BASIC_TAC; UNDH 5594 THEN DISCH_THEN (THM_INTRO_TAC[]); (* - *) TYPE_THEN `0 <| N` SUBAGOAL_TAC; UNDH 6734 THEN UNDH 4600 THEN ARITH_TAC; (* - *) TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_DIV; THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ; REWRITE_TAC[REAL_LT]; REWRITE_TAC[REAL_MUL;REAL_LE]; UNDH 8395 THEN ARITH_TAC; (* - *) FULL_REWRITE_TAC[INJ]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[d_real]; ]);; (* }}} *) let grid_image_bounded_ver2 = prove_by_refinement( `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> (?M. !N. (0 < M) /\ ((M <= N) ==> ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER (unbounded_set (grid f N)) = EMPTY)) )`, (* {{{ proof *) [ REWRITE_TAC[EQ_EMPTY;INTER;]; THM_INTRO_TAC[`f`] simple_arc_ball_cover_ver2; TYPE_THEN `M` EXISTS_TAC; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; TSPECH `N` 8189; RIGHTH 2874 "i"; RIGHTH 3911 "x"; TYPE_THEN `x''` UNABBREV_TAC; TYPE_THEN `0 <| N` SUBAGOAL_TAC; UNDH 4600 THEN UNDH 6734 THEN ARITH_TAC; FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ]; UNDH 5619 THEN REWRITE_TAC[]; (* ~bounded *) UNDH 1431 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); REWRH 3036; FULL_REWRITE_TAC[open_ball]; (* _ *) IMATCH_MP_TAC bounded_avoidance_subset; TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ; TYPE_THEN `E` EXISTS_TAC; (* _ *) TYPE_THEN `conn2 E` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[grid33_conn2]; REWRITE_TAC[grid_edge;grid_finite]; TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC; REWRITE_TAC[grid]; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; UNDH 8395 THEN ARITH_TAC; (* i <=| N *) (* -- *) REWRITE_TAC[IMAGE_UNION;UNIONS_UNION]; REWRITE_TAC[SUBSET;UNION]; DISJ1_TAC; REWRITE_TAC[image_sing]; (* - *) TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC; UNDH 4893 THEN REWRITE_TAC[]; THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset; USEH 2367 (MATCH_MP UNIONS_UNIONS); (* CURVE_CELL SUBSET curve-cell *) ASM_MESON_TAC[subset_imp]; KILLH 3474; (* E SUBSET grid f N *) KILLH 4893; (* ~UNIONS (. grid f N) *) (* -A// *) TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ; THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq; FULL_REWRITE_TAC []; REWRH 2390; TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[grid33]; IMATCH_MP_TAC rectangle_grid_subset; (* __ *) THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor; THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor; UNDH 7979 THEN UNDH 4359 THEN INT_ARITH_TAC; (* -// *) IMATCH_MP_TAC bounded_avoidance_subset; TYPE_THEN `E'` EXISTS_TAC; TYPE_THEN `conn2 E'` SUBAGOAL_TAC; IMATCH_MP_TAC conn2_rectagon; TYPE_THEN `FINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[conn2]; (* -// *) TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[grid33_edge]; (* -// *) ASM_SIMP_TAC[GSYM odd_bounded]; REWRITE_TAC[UNIONS]; TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC; IMATCH_MP_TAC (TAUT ` a/\ b ==> b /\ a`); (* -B// *) TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC; UNDH 1109 THEN REWRITE_TAC[]; (* ~ E *) THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset; USEH 2664 (MATCH_MP UNIONS_UNIONS); (* curve-cell SUBSET *) ASM_MESON_TAC[subset_imp]; (* -// *) TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ; TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC; UNDH 8466 THEN REWRITE_TAC[]; (* ~ *) REWRITE_TAC[UNIONS]; TYPE_THEN `h_edge m` EXISTS_TAC; REWRITE_TAC[curve_cell_h_ver2]; USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); (* floor,floor = m *) REWRH 1242; (* rg flor,flor *) FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[INSERT]; (* -// *) TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC; UNDH 8466 THEN REWRITE_TAC[]; (* ~UNIONS .. E' *) REWRITE_TAC[UNIONS]; TYPE_THEN `v_edge m` EXISTS_TAC; REWRITE_TAC[curve_cell_v_ver2]; USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); REWRH 1242; FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[INSERT]; (* -// *) TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC; UNDH 8466 THEN REWRITE_TAC[]; REWRITE_TAC[UNIONS]; TYPE_THEN `{(pointI m)}` EXISTS_TAC; ASM_SIMP_TAC[rectagon_segment;curve_cell_cls]; USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); REWRH 1242; FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[SUBSET;INSERT]; USEH 9677 (MATCH_MP cls_subset); (* { hedge } SUBSET E' *) USEH 1949 (REWRITE_RULE[SUBSET]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[cls_h]; (* -C// *) USEH 2851 (MATCH_MP point_onto); (* euclid 2 (f x') *) THM_INTRO_TAC[`p`] square_domain; UNDH 4082 THEN LET_TAC; TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC; TYPE_THEN `m` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; REWRH 2288; (* big ONE *) TYPE_THEN `point p` UNABBREV_TAC; USEH 459 (REWRITE_RULE[UNION;INR IN_SING;]); (* long *) REWRH 4739; (* \/ *) (* -D// *) ASM_SIMP_TAC[rectagon_segment;par_cell_squ]; FULL_REWRITE_TAC[num_lower]; USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); REWRH 1242; (* rect-grid *) FULL_REWRITE_TAC[rectangle_grid_sq]; TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[INSERT;cell_clauses]; REWRH 5179; (* EVEN *) (* - *) TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[up;PAIR_SPLIT]; INT_ARITH_TAC; REWRH 3452; (* EVEN *) FULL_REWRITE_TAC[card_sing;EVEN2]; ]);; (* }}} *) let grid33_h = prove_by_refinement( `!m. grid33 m (h_edge m)`, (* {{{ proof *) [ REWRITE_TAC[grid33]; REWRITE_TAC[rectangle_grid]; DISJ1_TAC; TYPE_THEN `m` EXISTS_TAC; INT_ARITH_TAC; ]);; (* }}} *) let curve_cell_grid_unions = prove_by_refinement( `!f N. curve_cell (grid f N) = UNIONS (IMAGE curve_cell ((IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N})))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[grid]; TYPE_THEN `S = (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N})` ABBREV_TAC ; IMATCH_MP_TAC thread_finite_union; REWRITE_TAC[curve_cell_union;curve_cell_empty]; TYPE_THEN `S` UNABBREV_TAC; IMATCH_MP_TAC FINITE_IMAGE; REWRITE_TAC[FINITE_NUMSEG_LE]; ]);; (* }}} *) let curve_cell_finite_union = prove_by_refinement( `!E. FINITE E ==> ( curve_cell (UNIONS E) = UNIONS (IMAGE curve_cell E))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC thread_finite_union; REWRITE_TAC[curve_cell_empty;curve_cell_union]; ]);; (* }}} *) let grid33_unions = prove_by_refinement( `!p. grid33 p = (IMAGE h_edge { m | (FST p -: &:1 <=: FST m) /\ FST m <=: FST p +: &:1 /\ SND p -: &:1 <=: SND m /\ (SND m <=: SND p +: &:2) }) UNION (IMAGE v_edge { m | FST p -: &:1 <=: FST m /\ FST m <= FST p +: &:2 /\ SND p -: &:1 <=: SND m /\ SND m <= SND p +: &:1}) `, (* {{{ proof *) [ REWRITE_TAC[grid33;IMAGE;rectangle_grid]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION]; IMATCH_MP_TAC EQ_ANTISYM ; CONJ_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses]; CONV_TAC (dropq_conv "x"); TYPE_THEN `m'` UNABBREV_TAC; UNDH 3867 THEN INT_ARITH_TAC; (* -- *) TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses]; CONV_TAC (dropq_conv "x"); TYPE_THEN `m'` UNABBREV_TAC; UNDH 2244 THEN INT_ARITH_TAC; (* - *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses]; CONV_TAC (dropq_conv "m"); TYPE_THEN `x'` UNABBREV_TAC; UNDH 6786 THEN INT_ARITH_TAC; (* - *) TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[cell_clauses]; CONV_TAC (dropq_conv "m"); TYPE_THEN `x'` UNABBREV_TAC; UNDH 2096 THEN INT_ARITH_TAC; ]);; (* }}} *) let int_range_finite = prove_by_refinement( `!a b. FINITE {t | a <=: t /\ t <=: b}`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `b <: a` ASM_CASES_TAC; TYPE_THEN `{ t | a <=: t /\ t <=: b} = EMPTY ` BACK_TAC; REWRITE_TAC[FINITE_RULES]; IMATCH_MP_TAC EQ_EXT; UNDH 5826 THEN INT_ARITH_TAC; (* - *) THM_INTRO_TAC[`a`] INT_REP; THM_INTRO_TAC[`b`] INT_REP; TYPE_THEN `a` UNABBREV_TAC; TYPE_THEN `b` UNABBREV_TAC; (* - *) THM_INTRO_TAC[`{ i | i <=| (n' + m) - (n + m') }`;`{t | (&:n -: &:m) <=: t /\ t <=: &:n' -: &:m'}`;`(\ i. (&:i) + &:n -: &:m)`] SURJ_FINITE; REWRITE_TAC[FINITE_NUMSEG_LE]; REWRITE_TAC[SURJ]; CONJ_TAC; TYPE_THEN `(n +| m') <= (n' + m)` SUBAGOAL_TAC; REWRITE_TAC[GSYM INT_OF_NUM_LE]; REWRITE_TAC[GSYM INT_OF_NUM_ADD]; UNDH 6818 THEN INT_ARITH_TAC; USEH 2499 (MATCH_MP INT_OF_NUM_SUB); USEH 6968 SYM; FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE]; REWRH 3919; FULL_REWRITE_TAC[INT_OF_NUM_ADD]; CONJ_TAC; TYPE_THEN `&:0 <=: &:x` SUBAGOAL_TAC; REWRITE_TAC[INT_OF_NUM_LE]; ARITH_TAC; UNDH 163 THEN ARITH_TAC; UNDH 1710 THEN ARITH_TAC; (* -A *) THM_INTRO_TAC[`x`] INT_REP; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `(n'' + m) -| (m'' + n)` EXISTS_TAC; TYPE_THEN `&:n'' + &:m' <=: &:n' + &:m''` SUBAGOAL_TAC; UNDH 4837 THEN INT_ARITH_TAC; KILLH 4837; TYPE_THEN `&:m'' + &:n <=: &:n'' + &:m` SUBAGOAL_TAC; UNDH 9532 THEN INT_ARITH_TAC; KILLH 9532; KILLH 6818; (* - *) CONJ_TAC; FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE]; UNDH 8565 THEN UNDH 9575 THEN ARITH_TAC; (* - *) FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE]; ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB]; FULL_REWRITE_TAC[GSYM INT_OF_NUM_ADD]; FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE;GSYM INT_OF_NUM_ADD ]; UNDH 4630 THEN UNDH 1357 THEN INT_ARITH_TAC; ]);; (* }}} *) let subs_lemma = prove_by_refinement( `!y (f:A->bool). (f y) ==> (!x. (x = y) ==> f x)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `x` UNABBREV_TAC; ]);; (* }}} *) (*** JRH changed the labels here because somehow some beta-redexes get contracted that did not before, (new IN_ELIM_THM?) and this changes the set comprehensions let int2_range_finite = prove_by_refinement( `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\ c <=: SND m /\ SND m <=: d}`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT; REWRITE_TAC[int_range_finite]; USEH 3506 (MATCH_MP subs_lemma); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC EQ_EXT; KILLH 8899; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "t'"); CONV_TAC (dropq_conv "u'"); REWRITE_TAC[PAIR_SPLIT]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; ]);; (* }}} *) ****) let int2_range_finite = prove_by_refinement( `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\ c <=: SND m /\ SND m <=: d}`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT; REWRITE_TAC[int_range_finite]; USEH 4853 (MATCH_MP subs_lemma); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC EQ_EXT; KILLH 4636; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; NAME_CONFLICT_TAC; CONV_TAC (dropq_conv "t'"); CONV_TAC (dropq_conv "u'"); REWRITE_TAC[PAIR_SPLIT]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let grid33_finite = prove_by_refinement( `!p. FINITE (grid33 p)`, (* {{{ proof *) [ REWRITE_TAC[grid33_unions]; REWRITE_TAC[FINITE_UNION]; CONJ_TAC THEN (IMATCH_MP_TAC FINITE_IMAGE) THEN (REWRITE_TAC[int2_range_finite]); ]);; (* }}} *) let d_euclid_bound2 = prove_by_refinement( `!x y eps. euclid 2 x /\ euclid 2 y /\ (abs (x 0 - y 0) <= eps) /\ (abs (x 1 - y 1) <= eps) ==> (d_euclid x y <= sqrt(&2) * eps)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC D_EUCLID_BOUND; REP_BASIC_TAC; TYPE_THEN `(i=0) \/ (i = 1) \/ (2 <= i)` SUBAGOAL_TAC; ARITH_TAC; UNDH 2744 THEN REP_CASES_TAC; TYPE_THEN `i` UNABBREV_TAC; TYPE_THEN `i` UNABBREV_TAC; FULL_REWRITE_TAC[euclid]; UND 0 THEN REAL_ARITH_TAC; ]);; (* }}} *) let grid33_radius = prove_by_refinement( `!x y. (euclid 2 x) /\ (UNIONS (curve_cell (grid33 (floor (x 0),floor (x 1)))) y) ==> (d_euclid x y < &4 )`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `m = (floor (x 0),floor (x 1))` ABBREV_TAC ; THM_INTRO_TAC[`grid33 m`] (GSYM curve_closure_ver2); REWRITE_TAC[grid33_edge;grid33_finite]; REWRH 2056; KILLH 7690; TYPE_THEN `(UNIONS (grid33 m)) SUBSET closed_ball (euclid 2,d_euclid) x (&3) ` BACK_TAC; THM_INTRO_TAC[`top2`;`UNIONS(grid33 m)`;`closed_ball (euclid 2,d_euclid) x (&3)`;] closure_subset; REWRITE_TAC [top2_top;]; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`&3 `]closed_ball_closed; FULL_REWRITE_TAC[GSYM top2]; KILLH 1468; FULL_REWRITE_TAC[SUBSET;closed_ball]; TSPECH `y` 8043; FULL_REWRITE_TAC[]; UNDH 9621 THEN REAL_ARITH_TAC; (* -A *) KILLH 920; FULL_REWRITE_TAC [grid33_unions]; REWRITE_TAC[UNIONS_UNION;union_subset]; (* - *) TYPE_THEN `sqrt (&2) * (&2) <= (&3)` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_POW_2_LE; REWRITE_TAC[REAL_POW_MUL]; CONJ_TAC; IMATCH_MP_TAC REAL_LE_MUL; IMATCH_MP_TAC SQRT_POS_LE; TYPE_THEN `sqrt(&2) pow 2 = &2` SUBAGOAL_TAC; IMATCH_MP_TAC SQRT_POW_2; REWRITE_TAC[REAL_POW_2]; REAL_ARITH_TAC; (* - *) CONJ_TAC; FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball]; TYPE_THEN `u` UNABBREV_TAC; SUBCONJ_TAC; ASM_MESON_TAC[h_edge_euclid;subset_imp]; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC; IMATCH_MP_TAC d_euclid_bound2; FULL_REWRITE_TAC[h_edge]; REWRITE_TAC[coord01]; TYPE_THEN `v` UNABBREV_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `m` UNABBREV_TAC; THM_INTRO_TAC[`x 0`] floor_ineq; THM_INTRO_TAC[`x 1`] floor_ineq; FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le]; POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC; (* - *) FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball]; TYPE_THEN `u` UNABBREV_TAC; SUBCONJ_TAC; ASM_MESON_TAC[v_edge_euclid;subset_imp]; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC; IMATCH_MP_TAC d_euclid_bound2; FULL_REWRITE_TAC[v_edge]; REWRITE_TAC[coord01]; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `m` UNABBREV_TAC; THM_INTRO_TAC[`x 0`] floor_ineq; THM_INTRO_TAC[`x 1`] floor_ineq; FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le]; POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC; (* Thu Dec 30 21:22:53 EST 2004 *) ]);; (* }}} *) let simple_arc_grid_properties = prove_by_refinement( `!C a b. simple_arc_end C a b ==> (?E. E SUBSET edge /\ (C INTER (unbounded_set E) = EMPTY) /\ conn2 E /\ E (h_edge (floor (a 0),floor (a 1))) /\ E (h_edge (floor (b 0),floor (b 1))) /\ (!y. UNIONS (curve_cell E) y ==> (?x. C x /\ d_euclid x y < &4)))`, (* {{{ proof *) [ REP_BASIC_TAC; COPYH 2895; USEH 2895 (REWRITE_RULE [simple_arc_end]); THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; FULL_REWRITE_TAC[uniformly_continuous]; (* - *) TYPE_THEN `!N' x. (&0 < &N') ==> ((&0 <= x/ &N') <=> (&0 <= x))` SUBAGOAL_TAC; THM_INTRO_TAC[`&N'`;`&0`;`x`] real_div_denom; FULL_REWRITE_TAC[REAL_DIV_LZERO]; (* - *) TYPE_THEN `!N' x. (&0 < &N') ==> ((x/ &N' <= &1) <=> (x <= &N'))` SUBAGOAL_TAC; ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; REDUCE_TAC; (* - *) TYPE_THEN `?N. (!i N'. (N <= N') /\ (i <| N') ==> d_euclid (f (&i / &N')) (f (&(SUC i) / &N')) < &1)` SUBAGOAL_TAC; TSPECH `&1` 814; FULL_REWRITE_TAC[REAL_ARITH `&0 < &1`]; THM_INTRO_TAC[`delta`] delta_pos_arch; TYPE_THEN `n` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FULL_REWRITE_TAC[GSYM REAL_LT]; FULL_REWRITE_TAC[REAL_LE;REAL_LT;d_real]; (* -- *) TYPE_THEN `0 <| N'` SUBAGOAL_TAC; UNDH 800 THEN UNDH 3476 THEN ARITH_TAC; (* -- *) FULL_REWRITE_TAC[REAL_LE;REAL_LT;]; CONJ_TAC; UNDH 9580 THEN ARITH_TAC; CONJ_TAC; UNDH 9580 THEN ARITH_TAC; REWRITE_TAC[suc_div]; REWRITE_TAC[REAL_ARITH `abs (x - (x + y)) = abs y`]; REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM]; IMATCH_MP_TAC REAL_LET_TRANS; TYPE_THEN `&1/ &n`EXISTS_TAC; FULL_REWRITE_TAC[GSYM REAL_LT]; ASM_SIMP_TAC[RAT_LEMMA4]; REDUCE_TAC; (* -A *) THM_INTRO_TAC[`f`] grid_image_bounded_ver2; TYPE_THEN `n = N +| M` ABBREV_TAC ; TYPE_THEN`E = grid f n` ABBREV_TAC ; TYPE_THEN `E` EXISTS_TAC; TYPE_THEN `0 <| n /\ M <= n /\ N <= n` SUBAGOAL_TAC; RIGHTH 8917 "N"; UNDH 8208 THEN UNDH 4600 THEN ARITH_TAC; (* - *) SUBCONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC [ grid_edge]; (* - *) SUBCONJ_TAC; TSPECH `n` 8917; TYPE_THEN `E` UNABBREV_TAC; (* - *) SUBCONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; IMATCH_MP_TAC grid_conn2; CONJ_TAC; IMATCH_MP_TAC inj_image_subset; (* -- *) FIRST_ASSUM IMATCH_MP_TAC ; (* -B *) CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[grid]; TYPE_THEN `a` UNABBREV_TAC; REWRITE_TAC[IMAGE;UNIONS]; CONV_TAC (dropq_conv "u"); TYPE_THEN `0` EXISTS_TAC; CONJ_TAC; UNDH 3476 THEN ARITH_TAC; REWRITE_TAC[REAL_DIV_LZERO;grid33_h]; (* - *) CONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[grid]; TYPE_THEN `b` UNABBREV_TAC; REWRITE_TAC[IMAGE;UNIONS]; CONV_TAC (dropq_conv "u"); TYPE_THEN `n` EXISTS_TAC; CONJ_TAC; ARITH_TAC; USEH 3476 (REWRITE_RULE [GSYM REAL_LT]); USEH 1089 (MATCH_MP (REAL_ARITH `&0 < y ==> ~(y = &0)`)); ASM_SIMP_TAC[REAL_DIV_REFL]; REWRITE_TAC[grid33_h]; (* -C *) TYPE_THEN `E` UNABBREV_TAC; USEH 2127 (REWRITE_RULE[curve_cell_grid_unions]); USEH 957 (REWRITE_RULE[IMAGE;UNIONS]); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `u'` UNABBREV_TAC; TYPE_THEN `f ( &x' / &n )` EXISTS_TAC; SUBCONJ_TAC; IMATCH_MP_TAC image_imp ; FULL_REWRITE_TAC[GSYM REAL_LT]; FULL_REWRITE_TAC[REAL_LE;REAL_LT ]; ARITH_TAC; (* - *) IMATCH_MP_TAC grid33_radius; CONJ_TAC; USEH 2083 (REWRITE_RULE[IMAGE]); USEH 7215 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; (* - *) REWRITE_TAC[UNIONS]; UNIFY_EXISTS_TAC; (* Thu Dec 30 21:27:32 EST 2004 *) ]);; (* }}} *) let unbounded_set_lemma = prove_by_refinement( `!E p. (FINITE E /\ E SUBSET edge) ==> (unbounded_set E p <=> (?r. !s. (r <= s) ==> (?C. simple_arc_end C p (point(s,&0)) /\ (C INTER UNIONS (curve_cell E) = EMPTY))))`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; THM_INTRO_TAC[`E`;`p`] unbounded_euclid; USEH 7802 (MATCH_MP point_onto); TYPE_THEN `p` UNABBREV_TAC; (* -- *) FULL_REWRITE_TAC[unbounded_set;unbounded]; TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ; TYPE_THEN `r'` EXISTS_TAC; THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; TYPE_THEN `s` UNABBREV_TAC; TYPE_THEN `r'` UNABBREV_TAC; UNDH 5363 THEN UNDH 4629 THEN REAL_ARITH_TAC; USEH 3140 (ONCE_REWRITE_RULE[EQ_SYM_EQ]); FIRST_ASSUM IMATCH_MP_TAC ; THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; UNDH 1263 THEN UNDH 5669 THEN UNDH 6232 THEN REAL_ARITH_TAC; (* - *) REWRITE_TAC[unbounded_set;unbounded]; TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; TSPECH `r` 3171; FULL_REWRITE_TAC[REAL_ARITH `r <= r`]; COPYH 3604; USEH 3604 (MATCH_MP simple_arc_end_end); USEH 3604 (MATCH_MP simple_arc_end_simple); USEH 3550 (MATCH_MP simple_arc_euclid); ASM_MESON_TAC[subset_imp]; USEH 7802 (MATCH_MP point_onto); TYPE_THEN `p` UNABBREV_TAC; (* - *) TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ; TYPE_THEN `r'` EXISTS_TAC; THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; UNDH 5363 THEN UNDH 6232 THEN UNDH 5669 THEN UNDH 9420 THEN REAL_ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `r'` UNABBREV_TAC; THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; UNDH 1263 THEN UNDH 540 THEN REAL_ARITH_TAC; (* Fri Dec 31 07:35:03 EST 2004 *) ]);; (* }}} *) let simple_arc_end_subset_trans_lemma = prove_by_refinement( `!C a b c. simple_arc_end C a b /\ C c /\ ~(c = a) ==> (?C'. C' SUBSET C /\ simple_arc_end C' a c)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `b = c` ASM_CASES_TAC; TYPE_THEN `b` UNABBREV_TAC; TYPE_THEN `C` EXISTS_TAC; REWRITE_TAC[SUBSET_REFL]; THM_INTRO_TAC[`C`;`a`;`b`;`c`] simple_arc_end_cut; TYPE_THEN `C'` EXISTS_TAC; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; ]);; (* }}} *) let simple_arc_end_subset_trans = prove_by_refinement( `!C C' a b c. simple_arc_end C a b /\ simple_arc_end C' b c /\ ~(a = c) ==> (?U. simple_arc_end U a c /\ U SUBSET (C UNION C'))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `C' a` ASM_CASES_TAC; THM_INTRO_TAC[`C'`;`c`;`b`;`a`] simple_arc_end_subset_trans_lemma; IMATCH_MP_TAC simple_arc_end_symm; TYPE_THEN `C''` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; IMATCH_MP_TAC SUBSET_TRANS; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET;UNION]; (* - *) THM_INTRO_TAC[`C`;`{a}`;`C'`] simple_arc_end_restriction; CONJ_TAC; USEH 2895 (MATCH_MP simple_arc_end_simple); CONJ_TAC; USEH 2895 (MATCH_MP simple_arc_end_end_closed); CONJ_TAC; USEH 3594 (MATCH_MP simple_arc_end_closed); CONJ_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ]; TYPE_THEN `u` UNABBREV_TAC; ASM_MESON_TAC[]; CONJ_TAC THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `a` EXISTS_TAC; USEH 2895 (MATCH_MP simple_arc_end_end); TYPE_THEN `b` EXISTS_TAC; USEH 2895 (MATCH_MP simple_arc_end_end2); USEH 3594 (MATCH_MP simple_arc_end_end); (* - *) TYPE_THEN `v = a` SUBAGOAL_TAC; USEH 6975 (REWRITE_RULE[eq_sing]); USEH 8361 (REWRITE_RULE[INTER;INR IN_SING]); TYPE_THEN `v` UNABBREV_TAC; (* - *) TYPE_THEN `v' = c` ASM_CASES_TAC; TYPE_THEN `v'` UNABBREV_TAC; TYPE_THEN `C''` EXISTS_TAC; FULL_REWRITE_TAC[SUBSET;UNION]; (* - *) THM_INTRO_TAC[`C'`;`c`;`b`;`v'`] simple_arc_end_subset_trans_lemma; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; USEH 9287 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); USEH 6723 (MATCH_MP simple_arc_end_symm); THM_INTRO_TAC[`C''`;`C'''`;`a`;`v'`;`c`] simple_arc_end_trans; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER]; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; FULL_REWRITE_TAC[INTER;eq_sing;INR IN_SING;SUBSET]; ASM_MESON_TAC[]; (* -- *) CONJ_TAC; USEH 3266 (MATCH_MP simple_arc_end_end2); USEH 2088 (MATCH_MP simple_arc_end_end); TYPE_THEN `C'' UNION C'''` EXISTS_TAC; FULL_REWRITE_TAC[SUBSET;UNION]; FIRST_ASSUM DISJ_CASES_TAC; (* Fri Dec 31 08:49:20 EST 2004 *) ]);; (* }}} *) let unbounded_set_trans_lemma = prove_by_refinement( `!E p q x r. FINITE E /\ E SUBSET edge /\ (unbounded_set E p) /\ (UNIONS E SUBSET (closed_ball(euclid 2,d_euclid) x r)) /\ (?C. simple_arc_end C p q /\ (C INTER closed_ball(euclid 2,d_euclid) x r = EMPTY)) ==> (unbounded_set E q)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `closure top2 (UNIONS E) SUBSET (closed_ball (euclid 2,d_euclid) x r)` SUBAGOAL_TAC; IMATCH_MP_TAC closure_subset; REWRITE_TAC[top2_top]; REWRITE_TAC[top2]; IMATCH_MP_TAC closed_ball_closed; (* - *) THM_INTRO_TAC[`E`] curve_closure_ver2; REWRH 5238; KILLH 3085; KILLH 5161; (* - *) TYPE_THEN `C INTER UNIONS (curve_cell E) = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; FULL_REWRITE_TAC[EQ_EMPTY ]; TSPECH `u` 5342; FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* - *) UNDH 2166 THEN ASM_SIMP_TAC [unbounded_set_lemma]; TYPE_THEN `euclid 2 q` SUBAGOAL_TAC; COPYH 5276; USEH 5276 (MATCH_MP simple_arc_end_simple); USEH 5276 (MATCH_MP simple_arc_end_end2); USEH 3550 (MATCH_MP simple_arc_euclid); ASM_MESON_TAC[subset_imp]; USEH 877 (MATCH_MP point_onto); TYPE_THEN `q` UNABBREV_TAC; (* - *) TYPE_THEN `r'' = max_real r' (FST p' + &1)` ABBREV_TAC ; TYPE_THEN `r''` EXISTS_TAC; TSPECH `s` 5976; (* - *) TYPE_THEN `r' <= s` SUBAGOAL_TAC; TYPE_THEN `r''` UNABBREV_TAC; THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le; UNDH 6140 THEN UNDH 3019 THEN REAL_ARITH_TAC; REP_BASIC_TAC; USEH 9110 (MATCH_MP simple_arc_end_symm); (* - *) TYPE_THEN `~(point p' = point (s,&0))` SUBAGOAL_TAC; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `s` UNABBREV_TAC; TYPE_THEN `r''` UNABBREV_TAC; THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le; UNDH 9809 THEN UNDH 7108 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`C`;`C'`;`point p'`;`p`;`(point(s,&0))`] simple_arc_end_subset_trans; TYPE_THEN `U` EXISTS_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; FULL_REWRITE_TAC[SUBSET;UNION;EQ_EMPTY]; ASM_MESON_TAC[]; (* Fri Dec 31 09:05:35 EST 2004 *) ]);; (* }}} *) let unbounded_set_empty = prove_by_refinement( `(unbounded_set EMPTY = euclid 2)`, (* {{{ proof *) [ THM_INTRO_TAC[`EMPTY:((num->real)->bool)->bool`] unbound_set_x_axis; REWRITE_TAC[FINITE_RULES]; TSPECH `r` 9109; FULL_REWRITE_TAC[REAL_ARITH `r <= r`]; IMATCH_MP_TAC EQ_EXT; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; IMATCH_MP_TAC unbounded_euclid; UNIFY_EXISTS_TAC; (* - *) TYPE_THEN `x = (point(r,&0))` ASM_CASES_TAC; ASM_REWRITE_TAC[]; (* - *) IMATCH_MP_TAC unbounded_set_trans_lemma; REWRITE_TAC[FINITE_RULES]; TYPE_THEN `point(r,&0)` EXISTS_TAC; TYPE_THEN `point(&0,&0)` EXISTS_TAC; TYPE_THEN `-- &1` EXISTS_TAC; (* - *) THM_INTRO_TAC[`2`;`point(&0,&0)`;`-- &1`] closed_ball_empty; REAL_ARITH_TAC; TYPE_THEN `mk_segment (point (r,&0)) x` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; REWRITE_TAC[INTER_EMPTY]; (* Fri Dec 31 09:37:30 EST 2004 *) ]);; (* }}} *) let continuous_real_const = prove_by_refinement( `!r. continuous (\t. r) (top_of_metric (UNIV,d_real)) (top_of_metric (UNIV,d_real))`, (* {{{ proof *) [ REWRITE_TAC[continuous;preimage]; TYPE_THEN `v r` ASM_CASES_TAC; TYPE_THEN `{x | UNIONS (top_of_metric (UNIV,d_real)) x} = UNIONS (top_of_metric(UNIV,d_real))` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; IMATCH_MP_TAC top_univ; IMATCH_MP_TAC top_of_metric_top; REWRITE_TAC[metric_real]; (**** Modified by JRH to avoid GSPEC REWRITE_TAC[GSYM EMPTY;GSPEC;top_of_metric_empty ]; ****) (let lemma = prove(`{x | F} = {}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]) in REWRITE_TAC[lemma; top_of_metric_empty]) (* Fri Dec 31 10:30:48 EST 2004 *) ]);; (* }}} *) let continuous_real_mul = prove_by_refinement( `!r. (&0 < r) ==> continuous (( *. ) r) (top_of_metric (UNIV,d_real)) (top_of_metric (UNIV,d_real)) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`( *. ) r`;`UNIV:real->bool`;`UNIV:real->bool`;`d_real`;`d_real`;] metric_continuous_continuous; REWRITE_TAC[metric_real]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; FULL_REWRITE_TAC[d_real]; TYPE_THEN `epsilon/r` EXISTS_TAC; SUBCONJ_TAC; IMATCH_MP_TAC REAL_LT_DIV; UNDH 5576 THEN (ASM_SIMP_TAC[REAL_LT_RDIV_EQ]); ASM_SIMP_TAC[REAL_ARITH `r * x - r *y = r*. (x - y)`;ABS_MUL ]; UNDH 7175 THEN UNDH 6412 THEN REAL_ARITH_TAC; ]);; (* }}} *) let polar_curve_lemma = prove_by_refinement( `!x theta r. euclid 2 x /\ &0 < theta /\ theta < &2 * pi /\ &0 < r ==> (?C. simple_arc_end C (x + point(r,&0)) (x + r *# (cis theta)) /\ !y. C y ==> (d_euclid x y = r))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `f = (\ (t:real) . r) ` ABBREV_TAC ; TYPE_THEN `g = ( *. ) theta` ABBREV_TAC ; THM_INTRO_TAC[`x`;`f`;`g`] polar_cont; TYPE_THEN `f` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; ASM_SIMP_TAC [continuous_real_const;continuous_real_mul]; TYPE_THEN `G = (\t. euclid_plus x (f t *# cis (g t))) ` ABBREV_TAC ; TYPE_THEN `C = IMAGE G {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; TYPE_THEN `C` EXISTS_TAC; REWRITE_TAC[simple_arc_end]; SUBCONJ_TAC; TYPE_THEN `G` EXISTS_TAC; (* -- *) TYPE_THEN `G (&0) = euclid_plus x (point (r,&0)) ` SUBAGOAL_TAC; TYPE_THEN `G` UNABBREV_TAC; AP_TERM_TAC; TYPE_THEN `f` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; REDUCE_TAC; REWRITE_TAC[cis]; REWRITE_TAC[point_scale;COS_0;SIN_0]; REDUCE_TAC; (* -- *) TYPE_THEN `G (&1) = euclid_plus x (r *# cis theta)` SUBAGOAL_TAC; TYPE_THEN `G` UNABBREV_TAC; AP_TERM_TAC; TYPE_THEN `f` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; REDUCE_TAC; (* -- *) TYPE_THEN `G` UNABBREV_TAC; REWRITE_TAC[INJ]; CONJ_TAC; IMATCH_MP_TAC euclid_add_closure; REWRITE_TAC[polar_euclid]; (* -- *) FULL_REWRITE_TAC[euclid_add_cancel]; TYPE_THEN `f` UNABBREV_TAC; THM_INTRO_TAC[`g x'`;`g y`;`r`;`r`] polar_inj; TYPE_THEN `g` UNABBREV_TAC; ASSUME_TAC (REAL_ARITH `&0 < r ==> &0 <= r`); TYPE_THEN `!x. &0 <= x ==> &0 <= theta* x` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LE_MUL; UNDH 2540 THEN REAL_ARITH_TAC; TYPE_THEN `!x. (x <= &1) ==> (theta* x < &2 * pi)` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LET_TRANS; TYPE_THEN `theta* &1` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_LMUL; UNDH 2540 THEN REAL_ARITH_TAC; REDUCE_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `r` UNABBREV_TAC; UNDH 869 THEN REAL_ARITH_TAC; TYPE_THEN `g` UNABBREV_TAC; FULL_REWRITE_TAC[REAL_EQ_MUL_LCANCEL]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `theta` UNABBREV_TAC; UNDH 869 THEN REAL_ARITH_TAC; (* -A *) TYPE_THEN `C` UNABBREV_TAC; TYPE_THEN `G` UNABBREV_TAC; USEH 1547 (REWRITE_RULE[IMAGE]); TYPE_THEN `f` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `d_euclid x (euclid_plus x (r *# cis (theta * x'))) = d_euclid (x + (&0 *# (cis (theta * x')))) (euclid_plus x (r *# cis (theta * x')))` SUBAGOAL_TAC; AP_THM_TAC; AP_TERM_TAC; REWRITE_TAC[euclid_scale0;euclid_rzero]; THM_INTRO_TAC[`2`;`(&0 *# cis (theta * x'))`;`(r *# cis (theta * x'))`;`x`] metric_translate_LEFT; REWRITE_TAC[polar_euclid]; REWRITE_TAC[d_euclid_eq_arg]; UNDH 6412 THEN REAL_ARITH_TAC; (* Fri Dec 31 11:25:13 EST 2004 *) ]);; (* }}} *) let unbounded_set_ball = prove_by_refinement( `!E x r p. (&0 < r) /\ FINITE E /\ E SUBSET edge /\ (euclid 2 p) /\ UNIONS E SUBSET (closed_ball (euclid 2,d_euclid) x r) /\ ~(closed_ball (euclid 2,d_euclid) x r p) ==> unbounded_set E p`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`E`] unbound_set_x_axis; (* - *) TYPE_THEN `E = EMPTY` ASM_CASES_TAC; FULL_REWRITE_TAC[unbounded_set_empty]; TYPE_THEN `UNIONS E = EMPTY` ASM_CASES_TAC; FULL_REWRITE_TAC[UNIONS_EQ_EMPTY]; REWRH 7639; TYPE_THEN `E` UNABBREV_TAC; USEH 8908(REWRITE_RULE[SUBSET;INR IN_SING ]); TYPE_THEN `edge EMPTY` SUBAGOAL_TAC; USEH 1936 (MATCH_MP edge_cell); USEH 5731 (MATCH_MP cell_nonempty); ASM_MESON_TAC[]; FULL_REWRITE_TAC[EMPTY_EXISTS]; (* - *) TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET;closed_ball]; TSPECH `u` 9087; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; (* -A *) TYPE_THEN `!x. (FST p' + r < x) ==> unbounded_set E (point(x,&0))` SUBAGOAL_TAC; TYPE_THEN `r' <= x'` ASM_CASES_TAC; IMATCH_MP_TAC unbounded_set_trans_lemma; TYPE_THEN `point(r',&0)` EXISTS_TAC; TYPE_THEN `point p'` EXISTS_TAC; TYPE_THEN `r` EXISTS_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REAL_ARITH_TAC; TYPE_THEN `mk_segment (point (r',&0)) (point(x',&0))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `x'` UNABBREV_TAC; UNDH 7236 THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[mk_segment_sym]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; THM_INTRO_TAC[`x'`;`r'`;`&0`;`u''`]mk_segment_h; UNDH 7636 THEN REAL_ARITH_TAC; REWRH 9446; TYPE_THEN `u''` UNABBREV_TAC; USEH 7067 (REWRITE_RULE[closed_ball]); THM_INTRO_TAC[`2`;`point p'`;`point(t,&0)`;`0`]proj_contraction; FULL_REWRITE_TAC[coord01]; UNDH 9207 THEN UNDH 6790 THEN UNDH 9670 THEN UNDH 2823 THEN REAL_ARITH_TAC; (* -B *) KILLH 3473; KILLH 5938; KILLH 7857; (* - *) TYPE_THEN `?R theta. r < R /\ &0 <= theta /\ theta < &2 * pi /\ (p = (point p') + (R *# cis theta))` SUBAGOAL_TAC; FULL_REWRITE_TAC[closed_ball]; TYPE_THEN `?q. (euclid 2 q) /\ (p = point p' + q) ` SUBAGOAL_TAC; TYPE_THEN `euclid_minus p (point p')` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC euclid_sub_closure; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[euclid_plus;euclid_minus]; REAL_ARITH_TAC; TYPE_THEN `p` UNABBREV_TAC; (* -- *) USEH 877 (MATCH_MP polar_exist); TYPE_THEN `q` UNABBREV_TAC; TYPE_THEN `r'` EXISTS_TAC ; TYPE_THEN `t` EXISTS_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; UNDH 1925 THEN ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[`2`;`&0 *# cis t`;`r' *# cis t`;`point p'`] metric_translate_LEFT; REWRITE_TAC[polar_euclid]; TYPE_THEN `point p' + &0 *# cis t = point p'` SUBAGOAL_TAC; REWRITE_TAC[euclid_scale0;euclid_rzero]; REWRH 5125; REWRITE_TAC[d_euclid_eq_arg]; UNDH 3665 THEN UNDH 1444 THEN REAL_ARITH_TAC; (* -C *) TYPE_THEN `unbounded_set E (point (FST p' + R,SND p'))` SUBAGOAL_TAC; TYPE_THEN `SND p' = &0` ASM_CASES_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 8204 THEN REAL_ARITH_TAC; IMATCH_MP_TAC unbounded_set_trans_lemma; TYPE_THEN `point (FST p' +R, &0)` EXISTS_TAC; TYPE_THEN `point p'` EXISTS_TAC; TYPE_THEN `r` EXISTS_TAC; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 8204 THEN REAL_ARITH_TAC; TYPE_THEN `mk_segment (point (FST p' + R,&0)) (point(FST p' + R,SND p'))` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; REWRITE_TAC[point_inj;PAIR_SPLIT]; UNDH 5038 THEN ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `&0 <= SND p'` ASM_CASES_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; THM_INTRO_TAC[`&0`;`SND p'`;`FST p' + R`;`u`]mk_segment_v; REWRH 1093; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[closed_ball]; THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction; FULL_REWRITE_TAC[coord01]; UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC; (* -- *) ONCE_REWRITE_TAC[mk_segment_sym]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; THM_INTRO_TAC[`SND p'`;`&0`;`FST p' + R`;`u`]mk_segment_v; UNDH 2479 THEN REAL_ARITH_TAC; REWRH 2966; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[closed_ball]; THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction; FULL_REWRITE_TAC[coord01]; UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC; (* -D *) TYPE_THEN `theta= &0` ASM_CASES_TAC ; REWRITE_TAC[cis;COS_0;SIN_0;point_scale]; TYPE_THEN `point p' + point (R * &1, R* &0) = point (FST p' + R , SND p')` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_SYM; ONCE_REWRITE_TAC[euclid_add_comm]; REWRITE_TAC[euclid_cancel1]; REWRITE_TAC[euclid_minus_scale;point_scale;point_add;point_inj;PAIR_SPLIT]; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; (* - *) IMATCH_MP_TAC unbounded_set_trans_lemma; TYPE_THEN `point (FST p' + R,SND p')` EXISTS_TAC; TYPE_THEN `point p'` EXISTS_TAC; TYPE_THEN `r` EXISTS_TAC; THM_INTRO_TAC[`point p'`;`theta`;`R`] polar_curve_lemma; UNDH 6412 THEN UNDH 8204 THEN UNDH 6162 THEN UNDH 4026 THEN REAL_ARITH_TAC; TYPE_THEN `C` EXISTS_TAC; (* - *) CONJ_TAC; TYPE_THEN `?u v. (p' = (u,v))` SUBAGOAL_TAC ; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `p'` UNABBREV_TAC; FULL_REWRITE_TAC[point_add;REAL_ARITH `x + &0 = x`]; (* - *) PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; USEH 3064 (REWRITE_RULE[closed_ball]); TSPECH `u` 5780; TYPE_THEN `R` UNABBREV_TAC; UNDH 8265 THEN UNDH 4705 THEN REAL_ARITH_TAC; (* Fri Dec 31 12:28:22 EST 2004 *) ]);; (* }}} *) let unbounded_connect = prove_by_refinement( `!E p q. FINITE E /\ E SUBSET edge /\ ~(p = q) /\ unbounded_set E p /\ unbounded_set E q ==> (?C. C SUBSET unbounded_set E /\ simple_arc_end C p q)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `(?r. !s. r <= s ==> (?C. simple_arc_end C p (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC; ASM_MESON_TAC[unbounded_set_lemma]; TYPE_THEN `(?r. !s. r <= s ==> (?C. simple_arc_end C q (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC; ASM_MESON_TAC[unbounded_set_lemma]; TYPE_THEN `r'' = max_real r r'` ABBREV_TAC ; TSPECH `r''` 4812; TSPECH `r''` 3171; THM_INTRO_TAC[`r`;`r'`] max_real_le; UNDH 4459 THEN DISCH_THEN (THM_INTRO_TAC[]); UNDH 6887 THEN UNDH 2 THEN REAL_ARITH_TAC; UNDH 5611 THEN DISCH_THEN (THM_INTRO_TAC[]); UNDH 7318 THEN UNDH 2 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`C`;`C'`;`p`;`point(r'',&0)`;`q`] simple_arc_end_subset_trans; IMATCH_MP_TAC simple_arc_end_symm; TYPE_THEN `U` EXISTS_TAC; (* - *) THM_INTRO_TAC[`E`] unbounded_set_comp; THM_INTRO_TAC[`E`;`x`] unbounded_set_comp_elt; THM_INTRO_TAC[`E`;`x`;`p`] unbounded_comp_unique; REWRITE_TAC[GSYM unbounded_set]; IMATCH_MP_TAC rectagon_curve; TYPE_THEN `q` EXISTS_TAC; (* - *) PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; FULL_REWRITE_TAC[SUBSET;UNION]; FULL_REWRITE_TAC[EQ_EMPTY]; ASM_MESON_TAC[]; (* Fri Dec 31 16:38:36 EST 2004 *) ]);; (* }}} *) let simple_arc_conn_complement = prove_by_refinement( `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ (euclid 2 p) /\ ~(p = q) /\ (euclid 2 q) ==> (?A. simple_arc_end A p q /\ (C INTER A = EMPTY))`, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`C`;`p`;`q`] euclid_scale_simple_arc_ver2; REP_BASIC_TAC; ASM_MESON_TAC[]; (* - *) KILLH 907 THEN KILLH 877 THEN KILLH 7802 THEN KILLH 6497 THEN KILLH 9726 THEN KILLH 3550 THEN KILLH 11; (* - simple-arc-grid-properties *) TYPE_THEN `!i. (?E. (i <| N) ==> ( E SUBSET edge /\ (B i INTER (unbounded_set E) = EMPTY) /\ conn2 E /\ E (h_edge (floor (a i 0),floor (a i 1))) /\ E (h_edge (floor (a (SUC i) 0),floor (a (SUC i) 1))) /\ (!y. UNIONS (curve_cell E) y ==> (?x. B i x /\ d_euclid x y < &4))))` SUBAGOAL_TAC; RIGHT_TAC "E"; TSPECH `i` 4963; USEH 9744 (MATCH_MP simple_arc_grid_properties); TYPE_THEN `E` EXISTS_TAC; LEFTH 3651 "E"; (* - conn2-sequence *) THM_INTRO_TAC[`E`;`N-1`] conn2_sequence; (* -A *) TYPE_THEN `!i. (i <=| N- 1) ==> (i <| N)` SUBAGOAL_TAC; UNDH 7562 THEN UNDH 6077 THEN ARITH_TAC; TYPE_THEN `(!i. i <=| N- 1 ==> conn2 (E i))` SUBAGOAL_TAC; TSPECH `i` 2188; UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); REWRH 1437; (* - *) TYPE_THEN `!i. (i <= N-| 1) ==> (E i SUBSET edge)` SUBAGOAL_TAC; TSPECH `i` 2188; UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); REWRH 456; (* - *) TYPE_THEN `(!i. (SUC i <= N -| 1) ==> ~(E i INTER E (SUC i) = {}))` SUBAGOAL_TAC; UNDH 6943 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `h_edge (floor (a (SUC i) 0), floor (a (SUC i) 1))` EXISTS_TAC; CONJ_TAC; TSPECH `i` 2188; UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); UNDH 1989 THEN UNDH 7562 THEN ARITH_TAC; TSPECH `SUC i` 2188; UNDH 395 THEN DISCH_THEN (THM_INTRO_TAC[]); REWRH 7915 ; (* -B *) TYPE_THEN `(!i j. i <| j /\ j <=| N -| 1 /\ ~(SUC i = j) ==> (curve_cell (E i) INTER curve_cell (E j) = {}))` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; USEH 2591 (REWRITE_RULE[INTER;EMPTY_EXISTS]); TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC cell_nonempty ; ALL_TAC]; THM_INTRO_TAC[`E i`] curve_cell_cell; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC; ASM_MESON_TAC[subset_imp]; USEH 1008 (REWRITE_RULE[EMPTY_EXISTS]); (* -- *) TYPE_THEN `euclid 2 u'` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `u` EXISTS_TAC; IMATCH_MP_TAC cell_euclid; IMATCH_MP_TAC subset_imp; TYPE_THEN `curve_cell (E j)` EXISTS_TAC; IMATCH_MP_TAC curve_cell_cell; (* -- *) TYPE_THEN `(?x. B i x /\ d_euclid x u' < &4)` SUBAGOAL_TAC; TSPECH `i` 2188; UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[UNIONS]; UNIFY_EXISTS_TAC; (* -- *) TYPE_THEN `(?y. B j y /\ d_euclid y u' < &4)` SUBAGOAL_TAC; TSPECH `j` 2188; UNDH 7711 THEN DISCH_THEN (THM_INTRO_TAC[]); FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[UNIONS]; UNIFY_EXISTS_TAC; (* -- *) UNDH 1512 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`x`;`y`]); UNDH 5462 THEN UNDH 2236 THEN ARITH_TAC; (* -- *) TYPE_THEN `!k x. B k x /\ (k <| N) ==> euclid 2 x` SUBAGOAL_TAC; UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`k`]); USEH 120 (MATCH_MP simple_arc_end_simple); USEH 6892 (MATCH_MP simple_arc_euclid); IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBAGOAL_TAC; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); TYPE_THEN `i` EXISTS_TAC; UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC; TYPE_THEN `j` EXISTS_TAC; (* -- *) THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`u'`;`y`] metric_space_triangle; TYPE_THEN `d_euclid x y <= &8` SUBAGOAL_TAC; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`y`;`u'`] metric_space_symm; UNDH 8326 THEN UNDH 204 THEN UNDH 2611 THEN UNDH 2778 THEN REAL_ARITH_TAC; UNDH 6749 THEN UNDH 4559 THEN UNDH 6444 THEN REAL_ARITH_TAC; REWRH 6286; (* -C *) TYPE_THEN `E' = UNIONS (IMAGE E {i | i <=| N -| 1})` ABBREV_TAC ; TYPE_THEN `E' SUBSET edge` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[IMAGE;UNIONS;SUBSET]; TYPE_THEN `u` UNABBREV_TAC; TSPECH `x'` 2188; UNDH 1746 THEN DISCH_THEN (THM_INTRO_TAC[]); IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; (* - *) TYPE_THEN `FINITE E'` SUBAGOAL_TAC; TYPE_THEN `E'` UNABBREV_TAC; THM_INTRO_TAC[`IMAGE E {i | i <=| N -| 1}`] FINITE_FINITE_UNIONS; IMATCH_MP_TAC FINITE_IMAGE; REWRITE_TAC[FINITE_NUMSEG_LE]; USEH 3282 (REWRITE_RULE[IMAGE]); UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); FULL_REWRITE_TAC[conn2]; (* - *) TYPE_THEN `C' INTER unbounded_set E' = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; USEH 8327 (REWRITE_RULE[EMPTY_EXISTS;INTER]); USEH 3168 (REWRITE_RULE [UNIONS;IMAGE]); TYPE_THEN `u'` UNABBREV_TAC; TSPECH `x` 2188; REP_BASIC_TAC; USEH 2251 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPECH `u` 5859; UNDH 5490 THEN ASM_REWRITE_TAC[]; IMATCH_MP_TAC unbounded_avoidance_subset_ver2; TYPE_THEN `E'` EXISTS_TAC; TYPE_THEN `E'` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNIONS;IMAGE]; CONV_TAC (dropq_conv "u"); TYPE_THEN `x` EXISTS_TAC; UNDH 5971 THEN ARITH_TAC; (* -D *) TYPE_THEN `unbounded_set E' p' /\ unbounded_set E' q'` ASM_CASES_TAC; THM_INTRO_TAC[`E'`;`p'`;`q'`] unbounded_connect; TSPECH `C` 7694; USEH 8696 (REWRITE_RULE[INTER;EMPTY_EXISTS]); USEH 5828 (REWRITE_RULE[SUBSET]); USEH 6174 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPECH `u` 5341; TSPECH `u` 7291; UNDH 362 THEN ASM_REWRITE_TAC[]; (* -E *) TYPE_THEN `N = 1` ASM_CASES_TAC; TYPE_THEN `N` UNABBREV_TAC; FULL_REWRITE_TAC[ARITH_RULE `i <| 1 <=> (i = 0)`]; FULL_REWRITE_TAC[ARITH_RULE `i <= 1 -| 1 <=> (i = 0)`]; TSPECH `0` 6703; TYPE_THEN `0 = 0` SUBAGOAL_TAC; TYPE_THEN `{i | i = 0} = {0}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRH 327; REWRH 627; FULL_REWRITE_TAC[image_sing]; TYPE_THEN `E'` UNABBREV_TAC; TYPE_THEN `C'` UNABBREV_TAC; TSPECH `0` 4218; UNDH 9174 THEN DISCH_THEN (THM_INTRO_TAC[]); (* -- *) UNDH 5439 THEN REWRITE_TAC[]; TYPE_THEN `!p. (!x. B 0 x ==> &8 *d <= d_euclid x p) /\ (euclid 2 p) ==> unbounded_set (E 0) p` SUBAGOAL_TAC; IMATCH_MP_TAC unbounded_set_ball; TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `&7* d` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LT_MUL; UNDH 5147 THEN REAL_ARITH_TAC; (* --- *) CONJ_TAC; REWRITE_TAC[SUBSET;closed_ball]; SUBCONJ_TAC; TSPECH `0` 6993; UNDH 9405 THEN DISCH_THEN (THM_INTRO_TAC[]); USEH 4758 (MATCH_MP simple_arc_end_simple); USEH 6872 (MATCH_MP simple_arc_euclid); IMATCH_MP_TAC subset_imp; TYPE_THEN `B 0` EXISTS_TAC; SUBCONJ_TAC; USEH 6028 (REWRITE_RULE[UNIONS]); IMATCH_MP_TAC subset_imp; TYPE_THEN `u` EXISTS_TAC; IMATCH_MP_TAC cell_euclid; IMATCH_MP_TAC edge_cell; IMATCH_MP_TAC subset_imp; TYPE_THEN `E 0` EXISTS_TAC; (* ---- *) UNDH 7489 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); IMATCH_MP_TAC subset_imp; TYPE_THEN `UNIONS (E 0)` EXISTS_TAC; IMATCH_MP_TAC UNIONS_UNIONS; REWRITE_TAC[SUBSET]; USEH 361 (REWRITE_RULE[SUBSET]); ASM_SIMP_TAC[curve_cell_edge]; USEH 5290 (REWRITE_RULE[SUBSET;open_ball]); TSPECH `x''` 19; REP_BASIC_TAC; (* ---- *) THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`x''`;`x'`] metric_space_triangle; TYPE_THEN `d_euclid x x' <= d + &4` SUBAGOAL_TAC; UNDH 8092 THEN UNDH 8809 THEN UNDH 9378 THEN REAL_ARITH_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `d + &4` EXISTS_TAC; UNDH 5147 THEN REAL_ARITH_TAC; (* --- *) USEH 129 (REWRITE_RULE[closed_ball]); TSPECH `x` 7711; UNDH 6465 THEN UNDH 5617 THEN UNDH 5147 THEN REAL_ARITH_TAC; (* -- *) CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); (* -F *) TYPE_THEN `0 <| N -| 1` SUBAGOAL_TAC; UNDH 426 THEN UNDH 7562 THEN ARITH_TAC; REWRH 532; UNDH 7535 THEN REWRITE_TAC[]; (* - *) TYPE_THEN `!p. (euclid 2 p) /\ (!i. (SUC i <= (N-1)) ==> (&8 * d <= d_euclid (a (SUC i)) p)) ==> (unbounded_set E' p)` BACK_TAC; TYPE_THEN `!i. (SUC i <= (N-1)) ==> C' (a (SUC i))` SUBAGOAL_TAC; REWRITE_TAC[UNIONS;IMAGE]; CONV_TAC (dropq_conv ("u")); TYPE_THEN `i` EXISTS_TAC; CONJ_TAC; UNDH 1989 THEN ARITH_TAC; TSPECH `i` 4963; TYPE_THEN `i <| N` SUBAGOAL_TAC; UNDH 1989 THEN ARITH_TAC; USEH 9744 (MATCH_MP simple_arc_end_end2); CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN REP_BASIC_TAC THEN ASM_MESON_TAC[]; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; UNDH 8137 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); KILLH 6656 THEN KILLH 1512 THEN KILLH 7562 THEN KILLH 6444 THEN KILLH 7694 THEN KILLH 9229 THEN KILLH 2174 THEN KILLH 9099 THEN KILLH 3258 THEN KILLH 6487; COPYH 2188; UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); UNDH 1989 THEN ARITH_TAC; UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]); KILLH 5053 THEN KILLH 8136 THEN KILLH 5388 THEN KILLH 6737; (* -G *) IMATCH_MP_TAC unbounded_set_ball; TYPE_THEN `a(SUC i)` EXISTS_TAC; TYPE_THEN `&7 *d` EXISTS_TAC; (* - *) CONJ_TAC; IMATCH_MP_TAC REAL_LT_MUL; UNDH 5147 THEN REAL_ARITH_TAC; (* - *) CONJ_TAC; REWRITE_TAC[ FINITE_UNION]; FULL_REWRITE_TAC[conn2]; REWRITE_TAC[union_subset]; REWRITE_TAC[UNIONS_UNION;union_subset]; (* - *) IMATCH_MP_TAC (TAUT `a/\ b ==> b/\ a`); CONJ_TAC; USEH 9183 (REWRITE_RULE[closed_ball]); UNDH 6641 THEN UNDH 3603 THEN UNDH 5147 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `!i x. (i <| N) /\ (B i x) ==> euclid 2 x` SUBAGOAL_TAC; UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); USEH 9316 (MATCH_MP simple_arc_end_simple); USEH 5604 (MATCH_MP simple_arc_euclid); USEH 2996 (REWRITE_RULE[SUBSET]); COPYH 3219; TSPECH `i` 3219; TSPECH `SUC i` 3219; (* - *) TYPE_THEN `(i <| N) /\ (SUC i <| N)` SUBAGOAL_TAC; UNDH 1989 THEN ARITH_TAC; REWRH 6689; REWRH 5459; (* - *) TYPE_THEN `B i (a(SUC i))` SUBAGOAL_TAC; TSPECH `i` 4963; USEH 9744 (MATCH_MP simple_arc_end_end2); (* - *) TYPE_THEN `B (SUC i) (a (SUC i))` SUBAGOAL_TAC; TSPECH `SUC i` 4963; USEH 9147 (MATCH_MP simple_arc_end_end); (* - *) REWRITE_TAC[SUBSET;closed_ball]; TYPE_THEN `euclid 2 (a(SUC i))` SUBAGOAL_TAC; (* - *) TYPE_THEN `!i x y. (i <| N) /\ B i x /\ B i y /\ (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid x y < &2 *d)` SUBAGOAL_TAC; IMATCH_MP_TAC BALL_DIST; TYPE_THEN `euclid 2` EXISTS_TAC; UNDH 4673 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); TYPE_THEN `x'` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `B i'` EXISTS_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `B i'` EXISTS_TAC; (* - *) KILLH 3302 THEN KILLH 6317 THEN KILLH 4963 THEN KILLH 4847; KILLH 4673 THEN KILLH 3226 THEN KILLH 9755 THEN KILLH 8762 THEN KILLH 6174; KILLH 7802 THEN KILLH 3603 THEN KILLH 5957; (* - *) TYPE_THEN `(!x. (euclid 2 x) /\ (?y. (euclid 2 y) /\ (d_euclid y x < &4) /\ (d_euclid (a (SUC i)) y < &2 * d)) ==> (d_euclid (a (SUC i)) x <= &7 *d))` SUBAGOAL_TAC; THM_INTRO_TAC[`euclid 2`;`d_euclid`;`a(SUC i)`;`y`;`x`] metric_space_triangle; UNDH 8917 THEN UNDH 3588 THEN UNDH 1391 THEN UNDH 5147 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `!G x. G SUBSET edge /\ UNIONS G x ==> (euclid 2 x /\ UNIONS (curve_cell G) x)` SUBAGOAL_TAC; USEH 6599 (REWRITE_RULE[UNIONS]); TYPE_THEN `edge u` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `G` EXISTS_TAC; CONJ_TAC; USEH 9350 (MATCH_MP edge_euclid2); IMATCH_MP_TAC subset_imp; TYPE_THEN `u` EXISTS_TAC; REWRITE_TAC[UNIONS]; TYPE_THEN `u` EXISTS_TAC; ASM_SIMP_TAC[curve_cell_edge]; (* -H *) CONJ_TAC; UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E i`;`x`]); UNDH 404 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; (* - *) UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E (SUC i)`;`x`]); UNDH 9352 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `x'` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `SUC i` EXISTS_TAC; (* Sat Jan 1 19:23:34 EST 2005 *) ]);; (* }}} *) let cut_arc = jordan_def `cut_arc C v w = @B. simple_arc_end B v w /\ B SUBSET C`;; let cut_arc_symm = prove_by_refinement( `!C v w. cut_arc C v w = cut_arc C w v`, (* {{{ proof *) [ REWRITE_TAC[cut_arc]; TYPE_THEN `!B. simple_arc_end B v w = simple_arc_end B w v` SUBAGOAL_TAC; MESON_TAC[simple_arc_end_symm]; ]);; (* }}} *) let cut_arc_simple = prove_by_refinement( `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==> simple_arc_end (cut_arc C v w) v w`, (* {{{ proof *) [ REWRITE_TAC[cut_arc]; SELECT_TAC; ASM_MESON_TAC[simple_arc_end_select]; ]);; (* }}} *) let cut_arc_subset = prove_by_refinement( `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==> cut_arc C v w SUBSET C`, (* {{{ proof *) [ REWRITE_TAC[cut_arc]; SELECT_TAC; ASM_MESON_TAC[simple_arc_end_select]; ]);; (* }}} *) let cut_arc_unique = prove_by_refinement( `!C v w B. simple_arc top2 C /\ (B SUBSET C) /\ simple_arc_end B v w ==> (cut_arc C v w = B)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `w` EXISTS_TAC; TYPE_THEN `~(v = w)` SUBAGOAL_TAC THENL[ (IMATCH_MP_TAC simple_arc_end_distinct);ALL_TAC]; TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `C v` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_end; TYPE_THEN `w` EXISTS_TAC; TYPE_THEN `C w` SUBAGOAL_TAC ; IMATCH_MP_TAC subset_imp; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_end2; UNIFY_EXISTS_TAC; ASM_MESON_TAC [cut_arc_subset;cut_arc_simple]; ]);; (* }}} *) let cut_arc_inter = prove_by_refinement( `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==> (cut_arc C v u INTER cut_arc C u w = {u}) /\ (cut_arc C v u UNION cut_arc C u w = C)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`;`v`;`w`;`u`] simple_arc_end_cut; TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; USEH 8829 (MATCH_MP simple_arc_end_simple); TYPE_THEN `cut_arc C v u = C'` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_unique; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `cut_arc C u w = C''` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_unique; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; ASM_REWRITE_TAC[]; (* Sat Jan 1 19:57:51 EST 2005 *) ]);; (* }}} *) let simple_closed_curve_euclid = prove_by_refinement( `!C . simple_closed_curve top2 C ==> (C SUBSET euclid 2) `, (* {{{ proof *) [ REWRITE_TAC[simple_closed_curve]; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `!u. &0 <= u /\ u < &1 ==> euclid 2 (f u)` SUBAGOAL_TAC; FULL_REWRITE_TAC[INJ;top2_unions]; FIRST_ASSUM IMATCH_MP_TAC ; USEH 5825 SYM ; TYPE_THEN `x' = &1` ASM_CASES_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC; ]);; (* }}} *) let open_real_interval = prove_by_refinement( `!a b. top_of_metric (UNIV,d_real) {x | a < x /\ x < b}`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`b`] half_open; THM_INTRO_TAC[`a`] half_open_above; TYPE_THEN `{x | a < x /\ x < b} = {x | a < x} INTER {x | x < b}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER]; IMATCH_MP_TAC top_inter; IMATCH_MP_TAC top_of_metric_top; REWRITE_TAC[metric_real]; ]);; (* }}} *) let simple_closed_curve_cut_unique = prove_by_refinement( `!A A' A'' C v w. simple_closed_curve top2 C /\ simple_arc_end A v w /\ simple_arc_end A' v w /\ simple_arc_end A'' v w /\ ~(A' = A'') /\ (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==> (A = A') \/ (A = A'')`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC; CONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `A'` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_end; TYPE_THEN`w` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `A'` EXISTS_TAC; REWRITE_TAC[SUBSET_UNION]; IMATCH_MP_TAC simple_arc_end_end2; TYPE_THEN `v` EXISTS_TAC; USEH 4051 (MATCH_MP simple_arc_end_distinct); UNDH 1472 THEN ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`C`;`v`] simple_closed_curve_pt; TYPE_THEN `?t. (&0 < t /\ t < &1 /\ (f t = w))` SUBAGOAL_TAC ; (* KILLH 9405; *) TYPE_THEN `C` UNABBREV_TAC ; FULL_REWRITE_TAC[IMAGE]; TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `x = &0` ASM_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `x = &1` ASM_CASES_TAC; ASM_MESON_TAC[]; UNDH 3483 THEN UNDH 9557 THEN UNDH 953 THEN UNDH 8032 THEN REAL_ARITH_TAC; TYPE_THEN `w` UNABBREV_TAC; TYPE_THEN `v` UNABBREV_TAC; (* -A *) (* USEH 9405 SYM; // *) FULL_REWRITE_TAC[top2_unions]; TYPE_THEN `simple_arc_end (IMAGE f {x | &0 <= x /\ x <= t}) (f (&0)) (f t)` SUBAGOAL_TAC; USEH 5825 SYM; IMATCH_MP_TAC simple_arc_segment; UNDH 6523 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `simple_arc_end (IMAGE f {x | t <= x /\ x <= &1}) (f t) (f (&1))` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_segment; UNDH 2449 THEN REAL_ARITH_TAC; USEH 5825 SYM; REWRH 3167; (* - *) TYPE_THEN `!q. {x | q <= x /\ x <= q} = {q}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REAL_ARITH_TAC; (* - *) TYPE_THEN `!x. &0 <= x /\ x <= &1 ==> euclid 2 (f x)` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; USEH 5674 SYM; IMATCH_MP_TAC simple_closed_curve_euclid; (* - *) TYPE_THEN `! r s. &0 <= r /\ s <= &1 /\ r < s ==> (?U. top2 U /\ (IMAGE f {x | r < x /\ x < s} = U INTER C))` SUBAGOAL_TAC; TYPE_THEN `closed_ top2 (IMAGE f {x | &0 <= x /\ x <= r})` SUBAGOAL_TAC; TYPE_THEN `r = &0` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[image_sing]; IMATCH_MP_TAC closed_point; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC simple_arc_end_closed; TYPE_THEN `f( &0)` EXISTS_TAC; TYPE_THEN `f (r)` EXISTS_TAC; IMATCH_MP_TAC simple_arc_segment; UNDH 5145 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC; TYPE_THEN `closed_ top2 (IMAGE f {x | s <= x /\ x <= &1})` SUBAGOAL_TAC; TYPE_THEN `s = &1` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[image_sing]; IMATCH_MP_TAC closed_point; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC simple_arc_end_closed; TYPE_THEN `f(s)` EXISTS_TAC; USEH 1826 SYM; TYPE_THEN `f (&1)` EXISTS_TAC; IMATCH_MP_TAC simple_arc_segment; UNDH 2144 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC; TYPE_THEN `closed_ top2 ((IMAGE f {x | &0 <= x /\ x <= r}) UNION (IMAGE f {x | s <= x /\ x <= &1}))` SUBAGOAL_TAC; IMATCH_MP_TAC closed_union; REWRITE_TAC[top2_top]; USEH 9076 (MATCH_MP closed_open); FULL_REWRITE_TAC[open_DEF;top2_unions ]; TYPE_THEN `(euclid 2 DIFF (IMAGE f {x | &0 <= x /\ x <= r} UNION IMAGE f {x | s <= x /\ x <= &1}))` EXISTS_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IMAGE;DIFF;UNION;INTER]; NAME_CONFLICT_TAC; IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; TYPE_THEN `x` UNABBREV_TAC; REWRITE_TAC[DE_MORGAN_THM;CONJ_ACI]; TYPE_THEN `&0 <= x' /\ x' <= &1` SUBAGOAL_TAC; UNDH 507 THEN UNDH 3413 THEN UNDH 1908 THEN UNDH 147 THEN REAL_ARITH_TAC; CONJ_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; CONJ_TAC; USEH 2422 (REWRITE_RULE[INJ]); TYPE_THEN `x'' = &1` ASM_CASES_TAC; TYPE_THEN `x' = &0` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; UNDH 507 THEN UNDH 1908 THEN REAL_ARITH_TAC; TYPE_THEN `x'` UNABBREV_TAC; UNDH 8462 THEN UNDH 147 THEN REAL_ARITH_TAC; TYPE_THEN `x' = x''` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 5595 THEN UNDH 8732 THEN UNDH 9674 THEN UNDH 507 THEN UNDH 9329 THEN UNDH 1908 THEN REAL_ARITH_TAC ; TYPE_THEN `x''` UNABBREV_TAC; UNDH 507 THEN UNDH 1162 THEN REAL_ARITH_TAC; (* --- *) TYPE_THEN `x' = x''` SUBAGOAL_TAC; USEH 2422 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UNDH 8691 THEN UNDH 7080 THEN UNDH 1908 THEN UNDH 507 THEN REAL_ARITH_TAC; TYPE_THEN `x''` UNABBREV_TAC; UNDH 3283 THEN UNDH 3413 THEN REAL_ARITH_TAC; (* -- *) FULL_REWRITE_TAC[DE_MORGAN_THM]; TYPE_THEN `x'` EXISTS_TAC; LEFTH 7656 "x'"; TSPECH `x'` 4068; TYPE_THEN `x` UNABBREV_TAC; LEFTH 5373 "x''"; TSPECH `x'` 1785; UNDH 1589 THEN UNDH 4223 THEN REWRITE_TAC[] THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC; (* -B *) COPYH 7922; UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`t`]); UNDH 6523 THEN REAL_ARITH_TAC; UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`t`;`&1`]); UNDH 2449 THEN REAL_ARITH_TAC; (* - *) USEH 5674 SYM; TYPE_THEN `U INTER U' INTER C = EMPTY` SUBAGOAL_TAC; TYPE_THEN `U INTER U' INTER C = (U INTER C) INTER (U' INTER C)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER] THEN MESON_TAC[]; TYPE_THEN `U INTER C` UNABBREV_TAC; TYPE_THEN `U' INTER C` UNABBREV_TAC; PROOF_BY_CONTR_TAC; USEH 6182 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]); TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `x = x'` SUBAGOAL_TAC; USEH 2422 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UNDH 4410 THEN UNDH 8119 THEN UNDH 6523 THEN UNDH 5777 THEN UNDH 2449 THEN REAL_ARITH_TAC; TYPE_THEN `x'` UNABBREV_TAC; UNDH 4480 THEN UNDH 8119 THEN REAL_ARITH_TAC; (* -C *) TYPE_THEN `UNIONS (top_of_metric (UNIV,d_real)) = UNIV` SUBAGOAL_TAC; IMATCH_MP_TAC (GSYM top_of_metric_unions); REWRITE_TAC[metric_real]; THM_INTRO_TAC[`&0`;`&1`] connect_real_open; THM_INTRO_TAC[`&0`;`&1`] open_real_interval; TYPE_THEN `!B. simple_arc_end B (f (&0)) (f t) /\ B SUBSET C ==> (B = IMAGE f {x | &0 <= x /\ x <= t}) \/ (B = IMAGE f {x | t <= x /\ x <= &1})` SUBAGOAL_TAC; COPYH 3089; USEH 3089 (REWRITE_RULE[simple_arc_end]); USEH 3272 (REWRITE_RULE[continuous;preimage]); REWRH 1293; TYPE_THEN `!v. top2 v ==> top_of_metric(UNIV,d_real) {x | &0 < x /\ x < &1 /\ v (f' x)}` SUBAGOAL_TAC; TYPE_THEN `{x | &0 < x /\ x < &1 /\ v' (f' x)} = {x | &0 < x /\ x < &1 } INTER {x | v' (f' x)}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER]; MESON_TAC[]; IMATCH_MP_TAC top_inter; IMATCH_MP_TAC top_of_metric_top; REWRITE_TAC[metric_real]; COPYH 7847; TSPECH `U` 7847; TSPECH `U'`7847; FULL_REWRITE_TAC[connected]; UNDH 868 THEN DISCH_THEN (THM_INTRO_TAC[`{x | &0 < x /\ x < &1 /\ U (f' x)}`;`{x | &0 < x /\ x < &1 /\ U' (f' x)}`]); CONJ_TAC; PROOF_BY_CONTR_TAC; USEH 228 (REWRITE_RULE[EMPTY_EXISTS;INTER]); TYPE_THEN `C (f' u)` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC image_imp; UNDH 5411 THEN UNDH 7814 THEN REAL_ARITH_TAC; USEH 161 (REWRITE_RULE[INTER;EQ_EMPTY]); TSPECH `f' u` 3418; UNDH 1284 THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;UNION]; TYPE_THEN `C (f' x)` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC image_imp; UNDH 4410 THEN UNDH 2236 THEN REAL_ARITH_TAC ; USEH 3773 SYM; REWRH 5090; USEH 8548 (REWRITE_RULE[IMAGE]); TYPE_THEN `~(x' = &0)` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `f(&0)` UNABBREV_TAC; TYPE_THEN `f(&1)` UNABBREV_TAC; TYPE_THEN `x = &0` SUBAGOAL_TAC; USEH 5798 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; UNDH 869 THEN REAL_ARITH_TAC; TYPE_THEN `~(x' = &1)` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `f(&0)` UNABBREV_TAC; TYPE_THEN `f(&1)` UNABBREV_TAC; TYPE_THEN `x = &0` SUBAGOAL_TAC; USEH 5798 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; UNDH 869 THEN REAL_ARITH_TAC; TYPE_THEN `~(x' = t)` SUBAGOAL_TAC; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `f(&0)` UNABBREV_TAC; TYPE_THEN `f(&1)` UNABBREV_TAC; TYPE_THEN `f t` UNABBREV_TAC; TYPE_THEN `x = &1` SUBAGOAL_TAC; USEH 5798 (REWRITE_RULE[INJ]); FIRST_ASSUM IMATCH_MP_TAC ; UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; UNDH 6586 THEN REAL_ARITH_TAC; (* --- *) TYPE_THEN `x' < t` ASM_CASES_TAC; DISJ1_TAC; USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPECH `f x'` 4001; USEH 4175 (REWRITE_RULE[INTER]); USEH 4860 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`)); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; UNDH 2455 THEN UNDH 9329 THEN REAL_ARITH_TAC; DISJ2_TAC; USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPECH `f x'` 7907; USEH 1343 (REWRITE_RULE[INTER]); USEH 5291 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`)); FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; UNDH 9585 THEN UNDH 7068 THEN UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC; (* --D *) FIRST_ASSUM DISJ_CASES_TAC; DISJ1_TAC; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC; TYPE_THEN `f (&0)` EXISTS_TAC; TYPE_THEN `f (t)` EXISTS_TAC; CONJ_TAC; TYPE_THEN `B` UNABBREV_TAC; CONJ_TAC; USEH 4679 (MATCH_MP simple_arc_end_simple); REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET;IMAGE]; (* --- *) TYPE_THEN `x' = &0` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; UNDH 2449 THEN REAL_ARITH_TAC; TYPE_THEN `x' = &1` ASM_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `t` EXISTS_TAC; UNDH 2449 THEN REAL_ARITH_TAC; USEH 8833 (REWRITE_RULE[SUBSET]); UNDH 5386 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); UNDH 6268 THEN UNDH 2455 THEN UNDH 9329 THEN UNDH 3324 THEN REAL_ARITH_TAC; TYPE_THEN `C (f' x')` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC image_imp; (*** Removed by JRH --- not quite sure why this changed UNDH 7473 THEN UNDH 5707 THEN UNDH 6268 THEN UNDH 2455 THEN REAL_ARITH_TAC; ***) USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPECH `(f' x')` 4001; USEH 3320 (REWRITE_RULE[INTER;IMAGE]); REWRH 7476; TYPE_THEN `x''` EXISTS_TAC; UNDH 4332 THEN UNDH 4962 THEN REAL_ARITH_TAC; (* --E *) DISJ2_TAC; IMATCH_MP_TAC simple_arc_end_inj; TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC; TYPE_THEN `f t` EXISTS_TAC; TYPE_THEN `f (&1)` EXISTS_TAC; USEH 1826 SYM; CONJ_TAC; TYPE_THEN `B` UNABBREV_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_MESON_TAC[]; CONJ_TAC; USEH 9241 (MATCH_MP simple_arc_end_simple); REWRITE_TAC[SUBSET_REFL]; REWRITE_TAC[SUBSET;IMAGE]; (* --- *) TYPE_THEN `x' = &0` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `&1` EXISTS_TAC; UNDH 6523 THEN REAL_ARITH_TAC; TYPE_THEN `x' = &1` ASM_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `t` EXISTS_TAC; UNDH 6523 THEN REAL_ARITH_TAC; TYPE_THEN `&0 < x' /\ x' < &1` SUBAGOAL_TAC; UNDH 9329 THEN UNDH 2455 THEN UNDH 3324 THEN UNDH 6268 THEN REAL_ARITH_TAC; USEH 1419 (REWRITE_RULE[SUBSET]); UNDH 7111 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); TYPE_THEN `C (f' x')` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `B` EXISTS_TAC; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPECH `(f' x')` 7907; USEH 1445 (REWRITE_RULE[INTER;IMAGE]); REWRH 6223; TYPE_THEN `x''` EXISTS_TAC; UNDH 4402 THEN UNDH 8966 THEN REAL_ARITH_TAC; (* -F *) TYPE_THEN `X = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ; TYPE_THEN `Y = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ; TYPE_THEN `a = f(&0)` ABBREV_TAC ; TYPE_THEN `b = f t` ABBREV_TAC ; TYPE_THEN `f t` UNABBREV_TAC; TYPE_THEN `f (&0)` UNABBREV_TAC; TYPE_THEN `f (&1)` UNABBREV_TAC; UNDH 7556 THEN UNDH 7601 THEN UNDH 9279 THEN UNDH 3395 THEN UNDH 1702 THEN UNDH 2817 THEN UNDH 7605 THEN UNDH 1063 THEN POP_ASSUM_LIST (fun t-> ALL_TAC); TYPE_THEN `(A = X) \/ (A = Y)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `(A' = X) \/ (A' = Y)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `(A'' = X) \/ (A'' = Y)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; FIRST_ASSUM DISJ_CASES_TAC THEN FIRST_ASSUM DISJ_CASES_TAC THEN ASM_MESON_TAC[]; (* Sun Jan 2 11:55:31 EST 2005 *) ]);; (* }}} *) let infinite_closed_interval = prove_by_refinement( `!a b. a < b ==> INFINITE {x | a <= x /\ x <= b}`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?r s. a < r /\ r < s /\ s < b` SUBAGOAL_TAC; TYPE_THEN `(&2*a + b)/ &3` EXISTS_TAC; TYPE_THEN `(a + &2*b)/ &3` EXISTS_TAC; ASSUME_TAC (REAL_ARITH `&0 < &3 /\ ~(&3 = &0)`); ASM_SIMP_TAC[REAL_LT_RDIV_EQ;REAL_LT_LDIV_EQ;REAL_DIV_RMUL]; UNDH 4394 THEN REAL_ARITH_TAC; IMATCH_MP_TAC infinite_subset; TYPE_THEN `{x | r < x /\ x < s}` EXISTS_TAC ; CONJ_TAC; ASM_SIMP_TAC[infinite_interval]; REWRITE_TAC[SUBSET]; UNDH 2351 THEN UNDH 2116 THEN UNDH 5157 THEN UNDH 4011 THEN REAL_ARITH_TAC; (* Sun Jan 2 12:21:29 EST 2005 *) ]);; (* }}} *) let infinite_image = prove_by_refinement( `!(f:A->B) X. INFINITE X /\ INJ f X UNIV ==> INFINITE (IMAGE f X)`, (* {{{ proof *) [ REWRITE_TAC[INJ;INFINITE]; THM_INTRO_TAC[`f`;`IMAGE f X`;`X`] FINITE_IMAGE_INJ_GENERAL; ASM_REWRITE_TAC[]; UNDH 3229 THEN REWRITE_TAC[]; TYPE_THEN `{x | x IN X /\ f x IN IMAGE f X} = X` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; ASM_MESON_TAC[image_imp]; REWRH 2588; ]);; (* }}} *) let simple_arc_infinite = prove_by_refinement( `!C. simple_arc top2 C ==> INFINITE C`, (* {{{ proof *) [ REWRITE_TAC[simple_arc]; IMATCH_MP_TAC infinite_image; CONJ_TAC; IMATCH_MP_TAC infinite_closed_interval; FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; ]);; (* }}} *) let simple_closed_curve_cut_unique_inter = prove_by_refinement( `!A A' A'' C v w. simple_closed_curve top2 C /\ simple_arc_end A v w /\ simple_arc_end A' v w /\ simple_arc_end A'' v w /\ (A' INTER A'' = {v,w}) /\ (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==> (A = A') \/ (A = A'')`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC simple_closed_curve_cut_unique; TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `w` EXISTS_TAC; DISCH_TAC; TYPE_THEN `A''` UNABBREV_TAC; FULL_REWRITE_TAC [INTER_ACI]; TYPE_THEN `A'` UNABBREV_TAC; USEH 2648 (MATCH_MP simple_arc_end_simple); USEH 9214 (MATCH_MP simple_arc_infinite); FULL_REWRITE_TAC[INFINITE]; UNDH 8436 THEN ASM_REWRITE_TAC[]; REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; (* Sun Jan 2 12:47:35 EST 2005 *) ]);; (* }}} *) let jordan_curve_access = prove_by_refinement( `!A C v w x p. simple_closed_curve top2 C /\ simple_arc_end A v w /\ A SUBSET C /\ A x /\ ~(x = v) /\ ~(x = w) /\ (euclid 2 p) /\ ~C p /\ (?q. ~( p = q) /\ ~(C q) /\ (euclid 2 q) /\ (!B. simple_arc_end B p q ==> ~(B INTER C = EMPTY))) ==> (?E. simple_arc_end E p x /\ E INTER C SUBSET A /\ (!e. E e /\ ~C e /\ ~(p = e) ==> (cut_arc E p e INTER C = EMPTY)))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC; CONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `A` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_end; TYPE_THEN`w` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `A` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_end2; TYPE_THEN `v` EXISTS_TAC; USEH 9236 (MATCH_MP simple_arc_end_distinct); UNDH 1472 THEN ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`C`;`v`;`w`] simple_closed_cut; (* - *) TYPE_THEN `?B. (A UNION B = C) /\ (A INTER B = {v,w}) /\ (simple_arc_end B v w)` SUBAGOAL_TAC; THM_INTRO_TAC[`A`;`C'`;`C''`;`C`;`v`;`w`] simple_closed_curve_cut_unique_inter; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; (* -- *) FIRST_ASSUM DISJ_CASES_TAC ; TYPE_THEN `C'` UNABBREV_TAC; TYPE_THEN `C''` EXISTS_TAC; TYPE_THEN `C''` UNABBREV_TAC; TYPE_THEN `C'` EXISTS_TAC; FULL_REWRITE_TAC[INTER_ACI;UNION_ACI]; KILLH 6724 THEN KILLH 906 THEN KILLH 4244 THEN KILLH 3747; (* -A *) THM_INTRO_TAC[`B`;`p`;`q`] simple_arc_conn_complement; USEH 2164 (MATCH_MP simple_arc_end_simple); TYPE_THEN `B SUBSET C` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION]; ASM_MESON_TAC[subset_imp]; (* - *) THM_INTRO_TAC[`A'`;`{p}`;`A`] simple_arc_end_restriction; CONJ_TAC; USEH 384 (MATCH_MP simple_arc_end_simple); CONJ_TAC; USEH 384 (MATCH_MP simple_arc_end_end_closed); CONJ_TAC; USEH 9236 (MATCH_MP simple_arc_end_closed); CONJ_TAC; REWRITE_TAC[EQ_EMPTY]; FULL_REWRITE_TAC[INTER;INR IN_SING]; TYPE_THEN `x'` UNABBREV_TAC; ASM_MESON_TAC[subset_imp]; REWRITE_TAC[EMPTY_EXISTS;INTER]; CONJ_TAC; CONV_TAC (dropq_conv "u"); USEH 384 (MATCH_MP simple_arc_end_end); TSPECH `A'` 1640; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `u` EXISTS_TAC; TYPE_THEN `C` UNABBREV_TAC; FULL_REWRITE_TAC[UNION]; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[EQ_EMPTY]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `v' = p` SUBAGOAL_TAC; USEH 6335 (REWRITE_RULE[INR eq_sing;INTER;INR IN_SING ]); TYPE_THEN `v'` UNABBREV_TAC; (* -B *) TYPE_THEN `x = v''` ASM_CASES_TAC ; TYPE_THEN `v''` UNABBREV_TAC; TYPE_THEN `C'` EXISTS_TAC; SUBCONJ_TAC; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[INTER;UNION;SUBSET]; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[INTER;EQ_EMPTY;SUBSET ]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `~(e = x)` SUBAGOAL_TAC; TYPE_THEN `e` UNABBREV_TAC; UNDH 3668 THEN REWRITE_TAC[] ; IMATCH_MP_TAC subset_imp; TYPE_THEN `A` EXISTS_TAC; THM_INTRO_TAC[`C'`;`e`;`p`;`x`] cut_arc_inter; (* -- *) PROOF_BY_CONTR_TAC; THM_INTRO_TAC[`C'`;`p`;`e`] cut_arc_subset; CONJ_TAC; USEH 8530 (MATCH_MP simple_arc_end_simple); USEH 8530 (MATCH_MP simple_arc_end_end); FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; FULL_REWRITE_TAC[SUBSET;INR eq_sing ;INR IN_SING;]; THM_INTRO_TAC[`C'`;`e`;`x`] cut_arc_simple; USEH 8530 (MATCH_MP simple_arc_end_simple); USEH 5502 (MATCH_MP simple_arc_end_end2); ASM_MESON_TAC[]; (* -C *) TYPE_THEN `cutvx = cut_arc A v'' x` ABBREV_TAC ; TYPE_THEN `E = C' UNION cutvx` ABBREV_TAC ; TYPE_THEN `E` EXISTS_TAC; (* - *) TYPE_THEN `simple_arc top2 A` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; (* - *) TYPE_THEN `A v'' ` SUBAGOAL_TAC; FULL_REWRITE_TAC[INTER;INR eq_sing; INR IN_SING]; THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_simple; (* - *) SUBCONJ_TAC; TYPE_THEN `E` UNABBREV_TAC ; IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `v''` EXISTS_TAC; TYPE_THEN `cutvx` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; USEH 6508 SYM; REWRITE_TAC[INTER;SUBSET]; THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset; IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; REWRITE_TAC[SUBSET;INTER;INR IN_SING]; FULL_REWRITE_TAC[INTER;INR IN_SING;INR eq_sing]; USEH 4778 (MATCH_MP simple_arc_end_end); (* -D *) SUBCONJ_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `cutvx` UNABBREV_TAC; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[SUBSET;INTER;UNION]; FIRST_ASSUM DISJ_CASES_TAC; KILLH 4866; FIRST_ASSUM DISJ_CASES_TAC; FULL_REWRITE_TAC[SUBSET;EQ_EMPTY;INTER;]; ASM_MESON_TAC[]; THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset; IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; (* -E *) TYPE_THEN `simple_arc top2 E` SUBAGOAL_TAC; USEH 9538 (MATCH_MP simple_arc_end_simple); TYPE_THEN `C' p /\ C' e` SUBAGOAL_TAC; CONJ_TAC; FULL_REWRITE_TAC[INTER;INR eq_sing;INR IN_SING]; TYPE_THEN `E` UNABBREV_TAC; USEH 3684 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `cutvx SUBSET C` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `cutvx` UNABBREV_TAC; IMATCH_MP_TAC cut_arc_subset; ASM_MESON_TAC[subset_imp]; (* - *) TYPE_THEN `cut_arc E p e = cut_arc C' p e` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_unique; TYPE_THEN `E` UNABBREV_TAC; CONJ_TAC; TYPE_THEN `cut_arc C' p e SUBSET C'` BACK_TAC; UNDH 7958 THEN REWRITE_TAC[SUBSET;UNION]; IMATCH_MP_TAC cut_arc_subset; USEH 2528 (MATCH_MP simple_arc_end_simple); IMATCH_MP_TAC cut_arc_simple; USEH 2528 (MATCH_MP simple_arc_end_simple); (* - *) TYPE_THEN `~(e = v'')` SUBAGOAL_TAC; UNDH 5697 THEN ASM_REWRITE_TAC[]; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[UNION]; THM_INTRO_TAC[`C'`;`e`;`p`;`v''`] cut_arc_inter; (* - *) TYPE_THEN `C' INTER C = {v''}` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; REWRITE_TAC[eq_sing;INR IN_SING ;INTER;UNION;]; USEH 2528 (MATCH_MP simple_arc_end_end2); REP_BASIC_TAC; FIRST_ASSUM DISJ_CASES_TAC ; USEH 6508 (REWRITE_RULE[INTER;INR eq_sing;INR IN_SING]); FIRST_ASSUM IMATCH_MP_TAC ; USEH 7813 (REWRITE_RULE[SUBSET]); USEH 4523 (REWRITE_RULE[EQ_EMPTY;INTER;]); ASM_MESON_TAC[]; (* -F *) TYPE_THEN `C' v''` SUBAGOAL_TAC; USEH 2528 (MATCH_MP simple_arc_end_end2); TYPE_THEN `~cut_arc C' p e v''` SUBAGOAL_TAC; USEH 8060 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); UNDH 2267 THEN DISCH_THEN (THM_INTRO_TAC[`v''`]); THM_INTRO_TAC[`C'`;`e`;`v''`] cut_arc_simple; USEH 2528 (MATCH_MP simple_arc_end_simple); USEH 1175 (MATCH_MP simple_arc_end_end2); UNDH 1069 THEN ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USEH 7182 (REWRITE_RULE [EMPTY_EXISTS;INTER]); USEH 3774 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); TYPE_THEN `u = v''` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `cut_arc C' p e SUBSET C'` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_subset; USEH 2528 (MATCH_MP simple_arc_end_simple); IMATCH_MP_TAC subset_imp; UNIFY_EXISTS_TAC; TYPE_THEN `u` UNABBREV_TAC; UNDH 9484 THEN ASM_REWRITE_TAC[]; (* Sun Jan 2 14:55:11 EST 2005 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION BB *) (* ------------------------------------------------------------------ *) (* show that a Jordan curve has no more than 2 components *) let jordan_curve_seg3 = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?s. (!(i:three_t). (s i SUBSET C) /\ (simple_arc top2 (s i))) /\ (!i j. ~(s i INTER s j = EMPTY) ==> (i = j)))`, (* {{{ proof *) [ REWRITE_TAC[simple_closed_curve]; TYPE_THEN `s = (\ i. IMAGE f {x | ((&2 * &(REP3 i) + &1)/ &8) <= x /\ x <= ((&2 * &(REP3 i) + &2)/ &8) } )` ABBREV_TAC ; TYPE_THEN `s` EXISTS_TAC; (* - *) TYPE_THEN `&0 < &8 /\ ~(&8 = &0)` SUBAGOAL_TAC; REAL_ARITH_TAC; TYPE_THEN `!i. &0 <= (&2 * &(REP3 i) + &1) / &8` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LE_DIV; REDUCE_TAC; TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / &8 <= &1` SUBAGOAL_TAC; ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; REDUCE_TAC; THM_INTRO_TAC[`i`] rep3_lt; UNDH 1618 THEN ARITH_TAC; (* - *) CONJ_TAC; CONJ_TAC; TYPE_THEN `s` UNABBREV_TAC; REWRITE_TAC[SUBSET;IMAGE]; TYPE_THEN `x'` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_TRANS; UNIFY_EXISTS_TAC; IMATCH_MP_TAC REAL_LE_TRANS; UNIFY_EXISTS_TAC; (* -- *) TYPE_THEN `s` UNABBREV_TAC ; THM_INTRO_TAC[`f`;`(&2 * &(REP3 i) + &1) / &8 `;`(&2 * &(REP3 i) + &2) / &8`] simple_arc_segment; FULL_REWRITE_TAC[top2_unions]; CONJ_TAC; ASM_SIMP_TAC[real_div_denom_lt]; REDUCE_TAC; ARITH_TAC; DISJ1_TAC; IMATCH_MP_TAC REAL_LT_DIV; REDUCE_TAC; ARITH_TAC; USEH 6148 (MATCH_MP simple_arc_end_simple); (* -A *) TYPE_THEN `!i j. (REP3 i < REP3 j) ==> (s i INTER s j = EMPTY)` BACK_TAC ; TYPE_THEN `(REP3 i = REP3 j) \/ (REP3 j <| REP3 i) \/ (REP3 i < REP3 j)` SUBAGOAL_TAC; ARITH_TAC; UNDH 2249 THEN REP_CASES_TAC; REWRITE_TAC[three_t_eq]; UNDH 6857 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); FULL_REWRITE_TAC[INTER_COMM]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* - *) PROOF_BY_CONTR_TAC; KILLH 1348; FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `s` UNABBREV_TAC; USEH 4729 (REWRITE_RULE[IMAGE]); USEH 9244 (REWRITE_RULE[IMAGE]); TYPE_THEN `u` UNABBREV_TAC; (* - *) TYPE_THEN `x = x'` SUBAGOAL_TAC; FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / (&8) < &1`SUBAGOAL_TAC; UNDH 7394 THEN SIMP_TAC[REAL_LT_LDIV_EQ]; REDUCE_TAC; THM_INTRO_TAC[`i`] rep3_lt; UNDH 1618 THEN ARITH_TAC; TYPE_THEN `&0 <= x /\ &0 <= x'` SUBAGOAL_TAC; ASM_MESON_TAC[REAL_LE_TRANS]; CONJ_TAC THEN IMATCH_MP_TAC REAL_LET_TRANS THEN UNIFY_EXISTS_TAC; (* - *) TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `(&2 * &(REP3 j') + &1) / &8 <= (&2 * &(REP3 i') + &2)/ &8` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LE_TRANS THEN UNIFY_EXISTS_TAC; (* - *) USEH 8118 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`)); UNDH 4580 THEN REWRITE_TAC[]; ASM_SIMP_TAC[REAL_LT_RDIV]; REDUCE_TAC; UNDH 4372 THEN ARITH_TAC; (* Sun Jan 2 20:07:58 EST 2005 *) ]);; (* }}} *) let abs3_distinct = prove_by_refinement( `~(ABS3 0 = ABS3 1) /\ ~(ABS3 0 = ABS3 2) /\ ~(ABS3 1 = ABS3 2)`, (* {{{ proof *) [ TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3(ABS3 j))==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC; TYPE_THEN `ABS3 i` UNABBREV_TAC; REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[ABS3_012] THEN ARITH_TAC; ]);; (* }}} *) let three_t_enum = prove_by_refinement( `!(a:A) b c. ?(f:three_t ->A). (f(ABS3 0) = a) /\ (f(ABS3 1) = b) /\ (f(ABS3 2) = c)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `f = (\ i. (if (i = ABS3 0) then a else (if (i = ABS3 1) then b else c)))` ABBREV_TAC ; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `f` UNABBREV_TAC; REWRITE_TAC[abs3_distinct]; ]);; (* }}} *) let three_t_univ = prove_by_refinement( `!P. P (ABS3 0) /\ P(ABS3 1) /\ P(ABS3 2) ==> (!i. P i)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`i`] ABS3_onto; TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2)` SUBAGOAL_TAC; UNDH 4616 THEN ARITH_TAC; UNDH 2783 THEN REP_CASES_TAC THEN (TYPE_THEN `j` UNABBREV_TAC); ]);; (* }}} *) let simple_arc_sep_three_t = prove_by_refinement( `!C x p. (!(i:three_t). simple_arc_end (C i) x (p i)) /\ (!i j. (C i) (p j) ==> (i = j)) ==> (?C' x. (!i. simple_arc_end (C' i) x (p i)) /\ (!i j. ~(i = j) ==> (C' i INTER C' j = {x})) /\ (!A. (!i. (C i) SUBSET A) ==> (!i. (C' i) SUBSET A))) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `A = C(ABS3 0) UNION C(ABS3 1) UNION C(ABS3 2)` ABBREV_TAC ; THM_INTRO_TAC[`A`;`C(ABS3 0)`;`C(ABS3 1)`;`C(ABS3 2)`;`x`;`p(ABS3 0)`;`p(ABS3 1)`;`p(ABS3 2)`] simple_arc_sep; REWRITE_TAC[SUBSET_REFL]; TYPE_THEN `!i j. ~(i = j) ==> ~(C i (p j))` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3 (ABS3 j)) ==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC; TYPE_THEN `ABS3 i` UNABBREV_TAC; REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[ABS3_012] THEN ARITH_TAC ; THM_INTRO_TAC[`C1'`;`C2'`;`C3'`] three_t_enum; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `C1'` UNABBREV_TAC; TYPE_THEN `C2'` UNABBREV_TAC; TYPE_THEN `C3'` UNABBREV_TAC; (* - *) CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ;ALL_TAC]; CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ THEN (REPEAT CONJ_TAC) THEN IMATCH_MP_TAC three_t_univ THEN FULL_REWRITE_TAC[INTER_ACI];ALL_TAC]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `A` EXISTS_TAC; FULL_REWRITE_TAC[union_subset]; TYPE_THEN `!i. (f i SUBSET A)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC three_t_univ;ALL_TAC]; (* - *) UNDH 2066 THEN UNDH 915 THEN POP_ASSUM_LIST (fun t->ALL_TAC); TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[union_subset]; (* Sun Jan 2 21:17:07 EST 2005 *) ]);; (* }}} *) let old_every_step_tac = !EVERY_STEP_TAC;; EVERY_STEP_TAC := REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN (REWRITE_TAC[]) ;; let transpose = jordan_def `transpose (Q:A->B->C) i j = Q j i`;; let transpose2 = prove_by_refinement( `!Q . (transpose (transpose Q)) = (Q:A->B->C) `, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC EQ_EXT; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[transpose]; ]);; (* }}} *) let k33_planar_graph_data_expand = prove_by_refinement( `(!q A CA B CB. (!(i:three_t) (j:three_t) i' j'. (q i j = q i' j') ==> (i = i') /\ (j = j')) /\ (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\ (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\ (!i j i' j' u. (CB i j u /\ CA i' j' u) ==> (i = i') /\ (j = j') /\ (u = q i j)) /\ (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\ (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j')) ==> (?A' CA' B' CB'. (!i j. simple_arc_end (CA' i j) (A' i) (q i j)) /\ (!i j. simple_arc_end (CB' i j) (B' j) (q i j)) /\ (!i j i' j' u. (CB' i j u /\ CA' i' j' u) ==> (i = i') /\ (j = j') /\ (u = q i j)) /\ (!i j i' j'. ~(CA' i j INTER CA' i' j' = EMPTY) ==> (i = i')) /\ (!i j i' j'. ~(CB' i j INTER CB' i' j' = EMPTY) ==> (j = j')) /\ (!i j k. ~(j = k) ==> (CA' i j INTER CA' i k = {(A' i)})) /\ (!i j k. ~(j = k) ==> (CB' j i INTER CB' k i = {(B' i)})) )) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `!i. ?CA' A'. (!j. simple_arc_end (CA' j) (A') (q i j)) /\ (!j k. ~(j = k) ==> (CA' j INTER CA' k = {(A')})) /\ (!U. (!j. (CA i j SUBSET U)) ==> (!j. CA' j SUBSET U))` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_sep_three_t; TYPE_THEN `A i` EXISTS_TAC; ASM_REWRITE_TAC[]; UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`q i j'`]); ASM_REWRITE_TAC[]; UNDH 190 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`]); USEH 6066 (MATCH_MP simple_arc_end_end2); ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; RIGHTH 7847 "i"; RIGHTH 705 "i"; TYPE_THEN `A'` EXISTS_TAC; TYPE_THEN `CA'` EXISTS_TAC; TYPE_THEN `(!i j. simple_arc_end (CA' i j) (A' i) (q i j))` SUBAGOAL_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -A *) TYPE_THEN `!i j u. CA' i j u ==> (?j'. CA i j' u)` SUBAGOAL_TAC; TSPECH `i` 6858; TSPECH `UNIONS (IMAGE (CA i) (UNIV))` 1295; UNDH 3086 THEN DISCH_THEN (THM_INTRO_TAC[]); REWRITE_TAC[SUBSET;UNIONS;IMAGE ]; CONV_TAC (dropq_conv ("u")); UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TSPECH `j` 7352; USEH 4766 (REWRITE_RULE[SUBSET;UNIONS;IMAGE]); TSPECH `u` 9646; REP_BASIC_TAC; TYPE_THEN `u'` UNABBREV_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(!i j i' j'. ~(CA' i j INTER CA' i' j' = {}) ==> (i = i'))` SUBAGOAL_TAC; USEH 3155 (REWRITE_RULE[EMPTY_EXISTS;INTER]); COPYH 6882; UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]); ASM_REWRITE_TAC[]; UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]); ASM_REWRITE_TAC[]; KILLH 33; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `j'''` EXISTS_TAC; TYPE_THEN `j''` EXISTS_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -B *) TYPE_THEN `!i. ?CBt' B'. (!j. simple_arc_end (CBt' j) (B') (transpose q i j)) /\ (!j k. ~(j = k) ==> (CBt' j INTER CBt' k = {(B')})) /\ (!U. (!j. (transpose CB i j SUBSET U)) ==> (!j. CBt' j SUBSET U))` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_sep_three_t; TYPE_THEN `B i` EXISTS_TAC; REWRITE_TAC[transpose]; ASM_REWRITE_TAC[]; UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`;`j'`;`i`;`q j' i`]); ASM_REWRITE_TAC[]; UNDH 8461 THEN DISCH_THEN (THM_INTRO_TAC[`j'`;`i`]); USEH 6944 (MATCH_MP simple_arc_end_end2); ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; RIGHTH 2590 "i"; RIGHTH 5199 "i"; TYPE_THEN `B'` EXISTS_TAC; TYPE_THEN `CB' = transpose CBt'` ABBREV_TAC ; TYPE_THEN `CBt' = transpose CB'` SUBAGOAL_TAC; TYPE_THEN `CB'` UNABBREV_TAC; REWRITE_TAC[transpose2]; TYPE_THEN `CBt'` UNABBREV_TAC; FULL_REWRITE_TAC[transpose]; KILLH 87; TYPE_THEN `CB'` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -C *) TYPE_THEN `!i j u. CB' i j u ==> (?i'. CB i' j u)` SUBAGOAL_TAC; TSPECH `j` 4587; TSPECH `UNIONS (IMAGE (transpose CB j) (UNIV))` 6357; UNDH 3701 THEN DISCH_THEN (THM_INTRO_TAC[]); REWRITE_TAC[SUBSET;UNIONS;IMAGE;transpose ]; CONV_TAC (dropq_conv ("u")); UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TSPECH `i` 8438; USEH 4864 (REWRITE_RULE[SUBSET;UNIONS;IMAGE]); TSPECH `u` 7999; FULL_REWRITE_TAC[transpose]; TYPE_THEN `u'` UNABBREV_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(!i j i' j'. ~(CB' i j INTER CB' i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC; USEH 541 (REWRITE_RULE[EMPTY_EXISTS;INTER]); COPYH 5811; UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]); ASM_REWRITE_TAC[]; UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]); ASM_REWRITE_TAC[]; KILLH 3657; KILLH 6409; FIRST_ASSUM IMATCH_MP_TAC ; REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `i'''` EXISTS_TAC; TYPE_THEN `i''` EXISTS_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -D *) UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]); ASM_REWRITE_TAC[]; UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]); ASM_REWRITE_TAC[]; UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i''`;`j`;`i'`;`j''`;`u`]); ASM_REWRITE_TAC[]; TYPE_THEN `j''` UNABBREV_TAC; TYPE_THEN `i''` UNABBREV_TAC; TYPE_THEN `u` UNABBREV_TAC; TSPECH `i'` 6858; (* -- *) TYPE_THEN `~(j = j')` ASM_CASES_TAC; UNDH 1784 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`j'`]); UNDH 2577 THEN ASM_REWRITE_TAC[]; USEH 6310 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); TSPECH `q i' j` 3488; REWRH 4791; TSPECH `j` 1529; COPYH 3976; USEH 3976 (MATCH_MP simple_arc_end_distinct); UNDH 587 THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; FIRST_ASSUM IMATCH_MP_TAC ; USEH 3976 (MATCH_MP simple_arc_end_end2); ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[]; TYPE_THEN `j'` UNABBREV_TAC; (* -E *) TYPE_THEN `(i = i')` BACK_TAC; TYPE_THEN `i'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; TSPECH `j` 4587; UNDH 5789 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`]); UNDH 3113 THEN ASM_REWRITE_TAC[]; USEH 3441 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); TSPECH `q i' j` 7938; REWRH 5749; TSPECH `i'` 7762; COPYH 8730; USEH 8730 (MATCH_MP simple_arc_end_distinct); UNDH 586 THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; FIRST_ASSUM IMATCH_MP_TAC ; USEH 8730 (MATCH_MP simple_arc_end_end2); ASM_REWRITE_TAC[]; (* Tue Jan 4 10:50:14 EST 2005 *) ]);; (* }}} *) let three_t_size3 = prove_by_refinement( `(UNIV:three_t->bool) HAS_SIZE 3`, (* {{{ proof *) [ ASSUME_TAC (ARITH_RULE `3 = SUC 2`); ASM_REWRITE_TAC[]; REWRITE_TAC[HAS_SIZE_SUC]; REWRITE_TAC[three_delete_size]; ]);; (* }}} *) let no_k33_planar_graph_data = prove_by_refinement( `(!q A CA B CB. (!(i:three_t) (j:three_t) i' j'. (q i j = q i' j') ==> (i = i') /\ (j = j')) /\ (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\ (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\ (!i j i' j' u. (CB i j u /\ CA i' j' u) ==> (i = i') /\ (j = j') /\ (u = q i j)) /\ (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\ (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j')) ==> F)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`q`;`A`;`CA`;`B`;`CB`] k33_planar_graph_data_expand; ASM_REWRITE_TAC[]; KILLH 33 THEN KILLH 3657 THEN KILLH 8763 THEN KILLH 190 THEN KILLH 8461; TYPE_THEN `CE = ( \i j. CA' i j UNION CB' i j)` ABBREV_TAC ; TYPE_THEN `!i j. CE i j = CA' i j UNION CB' i j` SUBAGOAL_TAC; TYPE_THEN `CE` UNABBREV_TAC; TYPE_THEN `!i j. simple_arc_end (CE i j) (A' i) (B' j)` SUBAGOAL_TAC; TYPE_THEN `CE` UNABBREV_TAC; IMATCH_MP_TAC simple_arc_end_trans; TYPE_THEN `q i j` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[INTER;SUBSET;INR IN_SING]; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;INR IN_SING;INTER]; TYPE_THEN `x` UNABBREV_TAC; ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; (* - *) TYPE_THEN `A = IMAGE A' UNIV` ABBREV_TAC ; TYPE_THEN `B = IMAGE B' UNIV` ABBREV_TAC ; TYPE_THEN `E = IMAGE (\ (i,j). (CE i j)) (cartesian UNIV UNIV)` ABBREV_TAC ; (* - *) TYPE_THEN `!i j. CA' i j (q i j)` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end2]; TYPE_THEN `!i j. CB' i j (q i j)` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end2]; TYPE_THEN `!i j. CA' i j (A' i)` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; TYPE_THEN `!i j. CB' i j (B' j)` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end]; (* - *) TYPE_THEN `!i i' j. CA' i j (A' i') ==> (i = i')` SUBAGOAL_TAC; KILLH 5790; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `j` EXISTS_TAC; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `j` EXISTS_TAC; TYPE_THEN `(A' i')` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j j'. CB' i j (B' j') ==> (j = j')` SUBAGOAL_TAC; KILLH 6409; KILLH 1344; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `(B' j')` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i i' j. ~CB' i j (A' i') ` SUBAGOAL_TAC; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`A' i'`]); ASM_REWRITE_TAC[]; USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]); UNDH 6711 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`]); TYPE_THEN `A' i'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `i'` UNABBREV_TAC; ASM_MESON_TAC[simple_arc_end_distinct]; (* - *) TYPE_THEN `!i j j'. ~CA' i j (B' j') ` SUBAGOAL_TAC; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`B' j'`]); ASM_REWRITE_TAC[]; TYPE_THEN `j'` UNABBREV_TAC; ASM_MESON_TAC[simple_arc_end_distinct]; (* - *) TYPE_THEN `!i j. CE i j INTER A = {(A' i)}` SUBAGOAL_TAC; REWRITE_TAC[eq_sing;INR IN_SING;INTER]; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `CE` UNABBREV_TAC; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; NAME_CONFLICT_TAC; CONJ_TAC; MESON_TAC[]; TYPE_THEN `u'` UNABBREV_TAC ; TYPE_THEN `x' = i` SUBAGOAL_TAC; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j. CE i j INTER B = {(B' j)}` SUBAGOAL_TAC; REWRITE_TAC[eq_sing;INR IN_SING;INTER]; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[IMAGE]; TYPE_THEN `CE` UNABBREV_TAC; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; NAME_CONFLICT_TAC; CONJ_TAC; MESON_TAC[]; TYPE_THEN `u'` UNABBREV_TAC ; TYPE_THEN `x' = j` SUBAGOAL_TAC; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* -A *) TYPE_THEN `!i i'. (A' i = A' i') ==> (i = i')` SUBAGOAL_TAC; UNDH 1344 THEN DISCH_THEN IMATCH_MP_TAC ; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!j j'. (B' j = B' j') ==> (j = j')` SUBAGOAL_TAC; UNDH 6780 THEN DISCH_THEN IMATCH_MP_TAC ; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i j i' j'. ~(CE i j INTER CE i' j' = EMPTY) ==> (i = i') \/ (j = j')` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; TYPE_THEN `CE` UNABBREV_TAC; USEH 672 (REWRITE_RULE[EMPTY_EXISTS;INTER;UNION]); USEH 5790 (REWRITE_RULE[EMPTY_EXISTS;INTER]); USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]); FIRST_ASSUM DISJ_CASES_TAC THEN KILLH 7160 THEN (FIRST_ASSUM DISJ_CASES_TAC) ; UNDH 3113 THEN REWRITE_TAC[] THEN UNDH 6711 THEN DISCH_THEN IMATCH_MP_TAC ; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`u`]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`i`;`j`;`u`]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; UNDH 2577 THEN REWRITE_TAC[] THEN UNDH 6981 THEN DISCH_THEN IMATCH_MP_TAC ; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* -B *) TYPE_THEN `!i j. ~(A' i = B' j)` SUBAGOAL_TAC; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i j j'. ~(j = j') ==> (CE i j INTER CE i j' = {(A' i)})` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; TYPE_THEN `CE` UNABBREV_TAC; REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING]; FIRST_ASSUM DISJ_CASES_TAC THEN (KILLH 2709) THEN (FIRST_ASSUM DISJ_CASES_TAC ); USEH 6932 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[]; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`j'`;`x`]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`x`]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; USEH 5790 (REWRITE_RULE[INTER;EMPTY_EXISTS]); ASM_MESON_TAC[]; REWRITE_TAC[INR IN_SING;SUBSET;INTER]; TYPE_THEN `x` UNABBREV_TAC; USEH 9014 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i i' j. ~(i = i') ==> (CE i j INTER CE i' j = {(B' j)})` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; TYPE_THEN `CE` UNABBREV_TAC; REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING]; FIRST_ASSUM DISJ_CASES_TAC THEN (KILLH 3625) THEN (FIRST_ASSUM DISJ_CASES_TAC ); USEH 6409 (REWRITE_RULE[EMPTY_EXISTS;INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[]; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`x`]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`i`;`j`;`x`]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; USEH 3599 (REWRITE_RULE[INTER;eq_sing;INR IN_SING;]); ASM_MESON_TAC[]; REWRITE_TAC[INR IN_SING;SUBSET;INTER]; TYPE_THEN `x` UNABBREV_TAC; USEH 4144 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); ASM_MESON_TAC[]; (* -C *) TYPE_THEN `g = (\ (i,j). CE i j)` ABBREV_TAC ; TYPE_THEN `BIJ g (cartesian UNIV UNIV) E` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; IMATCH_MP_TAC inj_bij; REWRITE_TAC[INJ]; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `?i j. x = (i,j)` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `?i j. y = (i,j)` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `y` UNABBREV_TAC; (*** Removed by JRH; this happens automatically now USEH 8053 (GBETA_RULE); ***) REWRITE_TAC[PAIR_SPLIT]; (* -- *) TYPE_THEN `!i j. INFINITE (CE i j)` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_infinite; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `(i = i') \/ (j = j')` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `CE i' j'` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_IDEMPOT]; TSPECH `i` 6411; TSPECH `j` 2286; FULL_REWRITE_TAC[INFINITE]; TYPE_THEN `CE i j` UNABBREV_TAC; FULL_REWRITE_TAC[FINITE_RULES]; ASM_REWRITE_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; UNDH 2315 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]); ASM_MESON_TAC[]; TYPE_THEN `i'` UNABBREV_TAC; TYPE_THEN `CE i j'` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_IDEMPOT]; FULL_REWRITE_TAC[INFINITE]; UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[]; TYPE_THEN `CE i j` UNABBREV_TAC; FULL_REWRITE_TAC[FINITE_SING]; ASM_REWRITE_TAC[]; TYPE_THEN `j'` UNABBREV_TAC; PROOF_BY_CONTR_TAC; UNDH 3532 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]); ASM_MESON_TAC[]; TYPE_THEN `CE i' j` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_IDEMPOT]; FULL_REWRITE_TAC[INFINITE]; UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[]; TYPE_THEN `CE i j` UNABBREV_TAC; FULL_REWRITE_TAC[FINITE_SING]; ASM_REWRITE_TAC[]; (* -D *) COPYH 1061; USEH 1061 (MATCH_MP INVERSE_BIJ); TYPE_THEN `h = INV g (cartesian UNIV UNIV) E` ABBREV_TAC ; TYPE_THEN `hh = (\ x. (A' (FST (h x)), B' (SND (h x))))` ABBREV_TAC ; TYPE_THEN `BIJ hh E (cartesian A B)` SUBAGOAL_TAC; TYPE_THEN `hh` UNABBREV_TAC; REWRITE_TAC[BIJ]; SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC; REWRITE_TAC[cartesian]; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[IMAGE;PAIR_SPLIT ]; MESON_TAC[]; FULL_REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `h x = h y` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT]; ASM_MESON_TAC[]; FULL_REWRITE_TAC[BIJ;INJ]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[SURJ]; CONJ_TAC; FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; USEH 807 (REWRITE_RULE[cartesian;PAIR_SPLIT]); REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `FST x` UNABBREV_TAC; TYPE_THEN `SND x` UNABBREV_TAC; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; USEH 6050 (REWRITE_RULE[IMAGE]); USEH 2264 (REWRITE_RULE[IMAGE]); TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `y` UNABBREV_TAC; TYPE_THEN `g (x'',x)` EXISTS_TAC; (* -- *) TYPE_THEN `h (g (x'',x)) = (x'',x)` SUBAGOAL_TAC; TYPE_THEN `h` UNABBREV_TAC; IMATCH_MP_TAC inv_comp_left; ASM_REWRITE_TAC[]; REWRITE_TAC[cartesian_univ]; ASM_REWRITE_TAC[]; TYPE_THEN `E` UNABBREV_TAC; IMATCH_MP_TAC image_imp; REWRITE_TAC[cartesian_univ]; (* -E *) TYPE_THEN `G = mk_graph_t (A UNION B,E,(\ e . {(FST (hh e)), (SND (hh e)) }))` ABBREV_TAC ; TYPE_THEN `graph_isomorphic k33_graph G` SUBAGOAL_TAC; TYPE_THEN `G` UNABBREV_TAC; IMATCH_MP_TAC k33_iso; ASM_REWRITE_TAC[]; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; (* -- *) REWRITE_TAC[HAS_SIZE] ; TYPE_THEN `FINITE (IMAGE A' UNIV) /\ FINITE (IMAGE B' UNIV)` SUBAGOAL_TAC; ASSUME_TAC three_t_size3; FULL_REWRITE_TAC[HAS_SIZE]; CONJ_TAC THEN IMATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ASSUME_TAC three_t_size3; FULL_REWRITE_TAC[HAS_SIZE]; TYPE_THEN `(CARD (IMAGE A' UNIV) = 3) /\ (CARD (IMAGE B' UNIV) = 3)` SUBAGOAL_TAC; USEH 6784 SYM; ASM_REWRITE_TAC[]; CONJ_TAC THEN IMATCH_MP_TAC (INR CARD_IMAGE_INJ) THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USEH 9575 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]); TYPE_THEN `u` UNABBREV_TAC; ASM_MESON_TAC[]; (* -F *) THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph; ASM_REWRITE_TAC[k33_isgraph]; THM_INTRO_TAC[] k33_nonplanar; FULL_REWRITE_TAC[planar_graph]; UNDH 3419 THEN ASM_REWRITE_TAC[]; TYPE_THEN `G` EXISTS_TAC; THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_symm; ASM_REWRITE_TAC[k33_isgraph]; ASM_REWRITE_TAC[]; REWRITE_TAC[plane_graph]; ASM_REWRITE_TAC[]; (* - *) SUBCONJ_TAC; TYPE_THEN `G` UNABBREV_TAC; REWRITE_TAC[graph_vertex_mk_graph]; REWRITE_TAC[UNION;SUBSET]; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; USEH 986 (REWRITE_RULE[IMAGE]); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; UNDH 2402 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]); TYPE_THEN `x` UNABBREV_TAC; UNDH 7678 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]); (* - *) SUBCONJ_TAC; TYPE_THEN `G` UNABBREV_TAC; REWRITE_TAC[graph_edge_mk_graph]; TYPE_THEN `E` UNABBREV_TAC; REWRITE_TAC[IMAGE;SUBSET]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; TYPE_THEN `?i j. (x' = (i,j))` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT]; MESON_TAC[]; TYPE_THEN `x' ` UNABBREV_TAC; GBETA_TAC; IMATCH_MP_TAC simple_arc_end_simple; TYPE_THEN `(A' i)` EXISTS_TAC; TYPE_THEN `(B' j)` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) SUBCONJ_TAC; TYPE_THEN `G` UNABBREV_TAC; REWRITE_TAC[graph_edge_mk_graph;graph_inc_mk_graph;graph_vertex_mk_graph]; KILLH 6876 THEN KILLH 5591 THEN KILLH 6365; FULL_REWRITE_TAC[graph_edge_mk_graph]; TYPE_THEN `E` UNABBREV_TAC; USEH 1953 (REWRITE_RULE[IMAGE;cartesian_univ]); TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `hh` UNABBREV_TAC; (* -- *) TYPE_THEN `h (g (x)) = x` SUBAGOAL_TAC; TYPE_THEN `h` UNABBREV_TAC; IMATCH_MP_TAC inv_comp_left; ASM_REWRITE_TAC[cartesian_univ]; ASM_REWRITE_TAC[]; TYPE_THEN `?i j. (x = (i,j))` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; GBETA_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;UNION;INR in_pair]; TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; REWRITE_TAC[IMAGE]; FULL_REWRITE_TAC[eq_sing; INTER; INR IN_SING]; TYPE_THEN `x` UNABBREV_TAC; GBETA_TAC; ASM_MESON_TAC[]; (* -G *) KILLH 7987 THEN KILLH 6305 THEN KILLH 5812 THEN KILLH 3738 THEN KILLH 8499; TYPE_THEN `!e. E e ==> (?i j. (e = CE i j))` SUBAGOAL_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `g` UNABBREV_TAC; USEH 7673 (REWRITE_RULE[cartesian_univ;IMAGE]); TYPE_THEN `(? i j. x = (i,j))` SUBAGOAL_TAC; REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `e''` UNABBREV_TAC; GBETA_TAC; MESON_TAC[]; (* - *) TYPE_THEN `G` UNABBREV_TAC; FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph]; KILLH 4886 THEN KILLH 6107 THEN KILLH 6780 THEN KILLH 1344; COPYH 1159; TSPECH `e` 1159; TSPECH `e'` 1159; TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `e'` UNABBREV_TAC; KILLH 5790 THEN KILLH 6409 THEN KILLH 5249 THEN KILLH 5804; REWRITE_TAC[INTER;SUBSET;UNION]; TYPE_THEN `(i' = i)` ASM_CASES_TAC; DISJ1_TAC; FULL_REWRITE_TAC[eq_sing;INTER;INR IN_SING]; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[IMAGE]; NAME_CONFLICT_TAC; TYPE_THEN `i'` UNABBREV_TAC; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `~(j' = j)` SUBAGOAL_TAC; TYPE_THEN `j'` UNABBREV_TAC; ASM_REWRITE_TAC[]; UNDH 221 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]); UNDH 7790 THEN ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(i' = i) \/ (j' = j)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USEH 5273 (REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; REWRH 5596; TYPE_THEN `j'` UNABBREV_TAC; DISJ2_TAC; (* - *) TYPE_THEN `x = B' j` BACK_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `B` UNABBREV_TAC; IMATCH_MP_TAC image_imp; (* - *) USEH 3532 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); UNDH 9432 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]); UNDH 7528 THEN ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Tue Jan 4 15:3282:39 EST 2005 *) ]);; (* }}} *) let simple_arc_midpoint = prove_by_refinement( `!C v w. simple_arc_end C v w ==> (?u. (C u /\ ~(u = v) /\ ~(u = w)))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] simple_arc_infinite; IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`{v,w}`;] INFINITE_DIFF_FINITE; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`v`;`w`] pair_size_2; ASM_MESON_TAC[simple_arc_end_distinct]; FULL_REWRITE_TAC[HAS_SIZE]; ASM_REWRITE_TAC[]; USEH 3168 (MATCH_MP INFINITE_NONEMPTY); FULL_REWRITE_TAC[DIFF;EMPTY_EXISTS;INR in_pair]; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let simple_arc_choose_end = prove_by_refinement( `!C. simple_arc top2 C ==> (?v w. simple_arc_end C v w)`, (* {{{ proof *) [ REWRITE_TAC[simple_arc;simple_arc_end]; FULL_REWRITE_TAC[top2_unions]; LEFT_TAC "f"; LEFT_TAC "f"; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `f(&0)` EXISTS_TAC; TYPE_THEN `f(&1)` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let cut_arc_replace = prove_by_refinement( `!A B u v. A SUBSET B /\ simple_arc top2 A /\ simple_arc top2 B /\ A u /\ A v /\ ~(u = v) ==> (cut_arc B u v = cut_arc A u v)`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC cut_arc_unique; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `A` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC cut_arc_subset; ASM_REWRITE_TAC[]; IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; ]);; (* }}} *) let cut_arc_order = prove_by_refinement( `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==> ~(cut_arc C v u w)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`;`u`;`v`;`w`] cut_arc_inter; ASM_REWRITE_TAC[]; USEH 1187 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); TSPECH `w` 5795; COPYH 1985; UNDH 1985 THEN REWRITE_TAC []; IMATCH_MP_TAC EQ_SYM; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; TYPE_THEN `u` EXISTS_TAC; IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; ]);; (* }}} *) (* First direction of Jordan curve theorem. *) let jordan_curve_no_inj3 = prove_by_refinement( `!C p. simple_closed_curve top2 C /\ INJ p (UNIV:three_t ->bool) (euclid 2) /\ (!i. ~C (p i)) /\ (!i j A. simple_arc_end A (p i) (p j) ==> ~(A INTER C = EMPTY)) ==> F`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] jordan_curve_seg3; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i. ?v w. simple_arc_end (s i) v w` SUBAGOAL_TAC; THM_INTRO_TAC[`s i`] simple_arc_choose_end; ASM_MESON_TAC[]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; LEFTH 4671 "v"; LEFTH 2518 "w"; (* - *) TYPE_THEN `!i. ?B. s i B /\ ~(B = v i) /\ ~(B = w i)` SUBAGOAL_TAC; THM_INTRO_TAC[`s i`;`v i`;`w i`] simple_arc_midpoint; ASM_REWRITE_TAC[]; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; LEFTH 9437 "B"; (* -A *) TYPE_THEN `!i. euclid 2 (p i)` SUBAGOAL_TAC; FULL_REWRITE_TAC[INJ]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j. ?E. simple_arc_end E (p i) (B j) /\ (E INTER C SUBSET (s j)) /\ (!e. E e /\ ~C e /\ ~(p i = e) ==> (cut_arc E (p i) e INTER C = EMPTY))` SUBAGOAL_TAC; IMATCH_MP_TAC jordan_curve_access; TYPE_THEN `v j` EXISTS_TAC; TYPE_THEN `w j` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[`i`] three_t_not_sing; TYPE_THEN `p j` EXISTS_TAC; ASM_REWRITE_TAC[]; UNDH 7630 THEN FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; LEFTH 4024 "E"; LEFTH 1449 "E"; (* -B *) TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ C u ==> (j = j') /\ s j u` SUBAGOAL_TAC; COPYH 807; UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]); USEH 6239 (REWRITE_RULE[INTER;SUBSET]); USEH 4225 (REWRITE_RULE[INTER;SUBSET]); SUBCONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USEH 9012 (REWRITE_RULE[EQ_EMPTY;INTER]); ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i j. (p i = p j) ==> (i = j)` SUBAGOAL_TAC; FULL_REWRITE_TAC[INJ]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j. E i j (p i)` SUBAGOAL_TAC; UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); USEH 3415 (MATCH_MP simple_arc_end_end); ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ ~C u ==> (i = i')` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; (* -- *) TYPE_THEN `u = p i` ASM_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]); UNDH 8557 THEN DISCH_THEN (THM_INTRO_TAC[`p i`]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`i`;`cut_arc (E i' j') (p i') (p i)`]); IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; UNDH 1303 THEN ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `u = p i'` ASM_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); UNDH 3041 THEN DISCH_THEN (THM_INTRO_TAC[`p i'`]); ASM_REWRITE_TAC[]; UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`cut_arc (E i j) (p i) (p i')`]); IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; UNDH 9380 THEN ASM_REWRITE_TAC[]; (* -- *) COPYH 807; UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]); TYPE_THEN `cut_arc (E i j) (p i) u INTER C = EMPTY` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `cut_arc (E i' j') (p i') u INTER C = EMPTY` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`E i j`;`p i`;`u`] cut_arc_simple; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`E i' j'`;`p i'`;`u`] cut_arc_simple; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[`cut_arc (E i j) (p i) u`;`cut_arc (E i' j') (p i') u`;`p i`;`u`;`p i'`] simple_arc_end_subset_trans; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; UNDH 3113 THEN ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* -- *) UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`U`]); ASM_REWRITE_TAC[]; UNDH 3232 THEN UNDH 5860 THEN UNDH 4934 THEN UNDH 7573 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;SUBSET] THEN REWRITE_TAC[EQ_EMPTY;UNION] THEN MESON_TAC[]; (* -C *) TYPE_THEN `!i j. ?E'' u u''. E'' SUBSET E i j /\ simple_arc_end E'' u u'' /\ (E'' INTER (UNIONS (IMAGE (E i) {k | ~(k = j)})) = {u}) /\ (E'' INTER {(B j)} = {u''})` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_restriction; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple THEN ASM_MESON_TAC[]; (* -- *) CONJ_TAC; IMATCH_MP_TAC top_closed_unions; REWRITE_TAC[top2_top]; CONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `UNIV:three_t -> bool` EXISTS_TAC ; REWRITE_TAC[three_t_finite]; REWRITE_TAC[SUBSET;IMAGE]; TYPE_THEN `x` UNABBREV_TAC; ASM_MESON_TAC[simple_arc_end_closed]; (* -- *) CONJ_TAC; ASM_MESON_TAC[simple_arc_end_end_closed2]; (* -- *) CONJ_TAC; REWRITE_TAC[EQ_EMPTY;INTER;UNIONS;IMAGE;INR IN_SING ]; TYPE_THEN `u` UNABBREV_TAC; TYPE_THEN `x` UNABBREV_TAC; UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x'`;`B j`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `s j` EXISTS_TAC; ASM_REWRITE_TAC[]; UNDH 7917 THEN ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; TYPE_THEN `p i` EXISTS_TAC; REWRITE_TAC[INTER;UNIONS;IMAGE]; ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "u"); THM_INTRO_TAC[`j`] three_t_not_sing; TYPE_THEN `j'` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER]; TYPE_THEN `B j` EXISTS_TAC; ASM_REWRITE_TAC[INR IN_SING ]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* - *) LEFTH 4870 "E''"; LEFTH 4064 "E''"; LEFTH 544 "u''"; LEFTH 659 "u''"; LEFTH 239 "u''"; TYPE_THEN `u'' = (\ i j. B j)` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; IMATCH_MP_TAC EQ_EXT; TSPECH `x` 3583; TSPECH `x'` 7705; USEH 2213 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); IMATCH_MP_TAC EQ_SYM; FIRST_ASSUM IMATCH_MP_TAC ; USEH 3027 SYM; ASM_REWRITE_TAC[]; TYPE_THEN `u''` UNABBREV_TAC; (* - *) LEFTH 1162 "u"; LEFTH 3727 "u"; TYPE_THEN `!i j. (?E' ua u'. E' SUBSET (E'' i j) /\ simple_arc_end E' ua u' /\ (E' INTER {(u i j)} = {ua}) /\ (E' INTER (s j) = {u'}))` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_restriction; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC []; (* -- *) CONJ_TAC; ASM_MESON_TAC[simple_arc_end_end_closed]; CONJ_TAC; ASM_MESON_TAC[simple_arc_end_closed]; (* -- *) CONJ_TAC; PROOF_BY_CONTR_TAC; USEH 4139 (REWRITE_RULE[INTER;EMPTY_EXISTS;INR IN_SING]); TYPE_THEN `u'` UNABBREV_TAC; TSPECH `i` 2275; TSPECH `j` 631; USEH 9848 (REWRITE_RULE[eq_sing;INR IN_SING;INTER;UNIONS;IMAGE]); TYPE_THEN `u''` UNABBREV_TAC; UNDH 9165 THEN REWRITE_TAC[]; UNDH 3778 THEN DISCH_THEN IMATCH_MP_TAC ; UNDH 1277 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `u i j` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `C (u i j)` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `s j` EXISTS_TAC; ASM_REWRITE_TAC[]; UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x`;`u i j`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `E'' i j` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `j` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ]; CONJ_TAC; TYPE_THEN `u i j` EXISTS_TAC; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `B j` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; LEFTH 5131 "E'"; LEFTH 6920 "E'"; (* -D *) TYPE_THEN `!i j k q x. E i k x /\ E'' i j q /\ ~(q = u i j) /\ ~(q = B j) /\ cut_arc (E i j) (q) (B j) x ==> (j = k)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; (* -- *) TYPE_THEN `cut_arc (E i j) q (B j) = cut_arc (E'' i j) q (B j)` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_replace; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* -- *) REWRH 4315; TYPE_THEN `E'' i j x` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `cut_arc (E'' i j) q (B j)` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC cut_arc_subset; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* -- *) UNDH 2275 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); USEH 9848 (REWRITE_RULE[INTER;UNIONS;IMAGE;eq_sing;INR IN_SING]); TYPE_THEN `x = u i j` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONV_TAC (dropq_conv "u"); TYPE_THEN `k` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `x` UNABBREV_TAC; (* -- *) THM_INTRO_TAC[`E'' i j`;`q`;`B j`;`u i j`] cut_arc_order; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; UNDH 1152 THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[cut_arc_symm]; ASM_REWRITE_TAC[]; (* -Da *) TYPE_THEN `?u'. !i j. E' i j SUBSET E'' i j /\ simple_arc_end (E' i j) (u i j) (u' i j) /\ (E' i j INTER s j = {(u' i j)})` SUBAGOAL_TAC; LEFTH 2832 "ua"; LEFTH 6021 "ua"; LEFTH 4322 "u'"; LEFTH 1946 "u'"; TYPE_THEN `u'` EXISTS_TAC; TSPECH `i` 1323; TSPECH `j` 1285; ASM_REWRITE_TAC[]; USEH 7215 (REWRITE_RULE[INTER;INR IN_SING;eq_sing;]); TYPE_THEN `ua i j` UNABBREV_TAC; ASM_REWRITE_TAC[]; KILLH 2832; (* - *) TYPE_THEN `!i j. E' i j SUBSET E i j` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `E'' i j` EXISTS_TAC; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i j. ?q. (E' i j q) /\ (E'' i j q) /\ (E i j q) /\ ~(q = u i j) /\ ~(q = u' i j) /\ ~(s j q) /\ (!k. E i k q ==> (j = k))` SUBAGOAL_TAC; TSPECH `i` 7629; TSPECH `j` 6300; THM_INTRO_TAC[`E' i j`;`u i j`;`u' i j`] simple_arc_midpoint; ASM_REWRITE_TAC[]; TYPE_THEN `q = u''` ABBREV_TAC ; TYPE_THEN `u''` UNABBREV_TAC; TYPE_THEN `q` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `E' i j` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) SUBCONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `E' i j` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -- *) SUBCONJ_TAC; USEH 3228 (REWRITE_RULE[INR IN_SING;eq_sing;INTER]); ASM_MESON_TAC[]; TSPECH `i` 6619; TSPECH `j` 4357; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `q` EXISTS_TAC; TYPE_THEN `q` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; UNDH 9552 THEN REWRITE_TAC[]; TYPE_THEN `q` UNABBREV_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`E i j`;`q`;`B j`] cut_arc_simple; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; LEFTH 7093 "q"; LEFTH 7917 "q"; (* -E *) TYPE_THEN `CA = (\ i j. cut_arc (E i j) (p i) (q i j))` ABBREV_TAC ; TYPE_THEN `CB = (\ i j. cut_arc (E i j) (q i j) (B j))` ABBREV_TAC ; TYPE_THEN `!i j. ~(q i j = p i)` SUBAGOAL_TAC; TSPECH `i` 3615; TSPECH `j` 524; THM_INTRO_TAC[`j`] three_t_not_sing; UNDH 2577 THEN REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j. ~(q i j = B j)` SUBAGOAL_TAC; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i j. simple_arc_end (CA i j) (p i) (q i j)` SUBAGOAL_TAC; TYPE_THEN `CA` UNABBREV_TAC; IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i j. simple_arc_end (CB i j) (q i j) (B j)` SUBAGOAL_TAC; TYPE_THEN `CB` UNABBREV_TAC; IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* -F *) THM_INTRO_TAC[`q`;`p`;`CA`;`B`;`CB`] no_k33_planar_graph_data THENL [ALL_TAC;ASM_REWRITE_TAC[]]; ASM_REWRITE_TAC[]; TYPE_THEN `(!i j. simple_arc_end (CB i j) (B j) (q i j)) ` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j. CA i j INTER C = EMPTY` SUBAGOAL_TAC; UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); TYPE_THEN `CA` UNABBREV_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; USEH 6239 (REWRITE_RULE[INTER;SUBSET]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `!i j j' u. CB i j u /\ E i j' u ==> (j = j')` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `q i j` EXISTS_TAC; TYPE_THEN `u''` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `CB` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j. CB i j = cut_arc (E'' i j) (q i j) (B j)` SUBAGOAL_TAC; TYPE_THEN `CB` UNABBREV_TAC; IMATCH_MP_TAC cut_arc_replace; ASM_REWRITE_TAC[]; TYPE_THEN `simple_arc top2 (E i j)` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple]; (* - *) TYPE_THEN `!i i' j j' u. ~(i = i') /\ CB i j u /\ E i' j' u ==> (j = j') /\ s j u` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `i` EXISTS_TAC; TYPE_THEN `i'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `CB` UNABBREV_TAC; SUBCONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `cut_arc (E i j) (q i j) (B j)` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `E'' i j` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC cut_arc_subset; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple]; PROOF_BY_CONTR_TAC; UNDH 3113 THEN REWRITE_TAC[]; UNDH 6138 THEN DISCH_THEN (IMATCH_MP_TAC ); TYPE_THEN `j` EXISTS_TAC; TYPE_THEN `j'` EXISTS_TAC; TYPE_THEN `u''` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -G *) USEH 9121 GSYM; TYPE_THEN `!i j. CB i j SUBSET E i j` SUBAGOAL_TAC; TYPE_THEN `CB` UNABBREV_TAC; IMATCH_MP_TAC cut_arc_subset; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple]; (* - *) TYPE_THEN `(!i j i' j'. ~(CB i j INTER CB i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC; USEH 2001 (REWRITE_RULE [INTER;EMPTY_EXISTS]); TYPE_THEN `i = i'` ASM_CASES_TAC; UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `CB i' j'` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -- *) UNDH 3773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `CB i' j'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `j'` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!i j. CA i j SUBSET E i j` SUBAGOAL_TAC; TYPE_THEN `CA` UNABBREV_TAC; IMATCH_MP_TAC cut_arc_subset; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_simple]; (* -H *) TYPE_THEN `(!i j i' j' u. CB i j u /\ CA i' j' u ==> (i = i') /\ (j = j') /\ (u = q i j))` SUBAGOAL_TAC; TYPE_THEN `i = i'` ASM_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `i'` UNABBREV_TAC; UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `CA i j'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `j'` UNABBREV_TAC; THM_INTRO_TAC[`E i j`;`q i j`;`p i`;`B j`] cut_arc_inter; ASM_REWRITE_TAC[]; USEH 699 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `CA` UNABBREV_TAC; TYPE_THEN `CB` UNABBREV_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; UNDH 3773 THEN DISCH_THEN ( THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `CA i' j'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `j'` UNABBREV_TAC; (* -- *) USEH 682 (REWRITE_RULE[INTER;EQ_EMPTY]); UNDH 218 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`u''`]); UNDH 2186 THEN ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `s j` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -I *) CONJ_TAC; UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`q i j`]); CONJ_TAC; TYPE_THEN `CB` UNABBREV_TAC; ASM_MESON_TAC[simple_arc_end_end]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_end2]; TYPE_THEN `i'` UNABBREV_TAC; TYPE_THEN `j'` UNABBREV_TAC; (* - *) USEH 6538 (REWRITE_RULE[EMPTY_EXISTS;INTER]); UNDH 6138 THEN DISCH_THEN IMATCH_MP_TAC ; TYPE_THEN `j` EXISTS_TAC; TYPE_THEN `j'` EXISTS_TAC; TYPE_THEN `u''` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `CA i j` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `CA i' j'` EXISTS_TAC; ASM_REWRITE_TAC[]; UNDH 682 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER ]; UNDH 7281 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* Sun Jan 16 08:48:56 EST 2005 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION CC *) (* ------------------------------------------------------------------ *) (* finish off Jordan curve *) let simple_closed_curve_compact = prove_by_refinement( `!C. simple_closed_curve top2 C ==> compact top2 C`, (* {{{ proof *) [ REWRITE_TAC[simple_closed_curve]; TYPE_THEN `C` UNABBREV_TAC; IMATCH_MP_TAC image_compact; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[top2_unions]; CONJ_TAC; REWRITE_TAC[interval_compact]; REWRITE_TAC[IMAGE;SUBSET]; FULL_REWRITE_TAC[INJ]; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `x' = &1` ASM_CASES_TAC; TYPE_THEN `x'` UNABBREV_TAC; USEH 5825 SYM; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; REAL_ARITH_TAC; FIRST_ASSUM IMATCH_MP_TAC ; UNDH 6268 THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC; (* Sun Jan 16 09:13:09 EST 2005 *) ]);; (* }}} *) let ymaxQexists_lemma = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (!q. C q ==> (q 1 <=. p 1)))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`1`;`2`] continuous_euclid1; FULL_REWRITE_TAC[GSYM top2]; THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_max_real; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_closed_curve_compact; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[simple_closed_curve]; TYPE_THEN `C` UNABBREV_TAC; USEH 2198 GSYM; USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); TSPECH `f (&0)` 9716; UNDH 5422 THEN ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; TYPE_THEN `x` EXISTS_TAC; FULL_REWRITE_TAC[coord]; ASM_REWRITE_TAC[]; (* Sun Jan 16 09:16:3282 EST 2005 *) ]);; (* }}} *) let yminQexists_lemma = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (!q. C q ==> (p 1 <=. q 1)))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`1`;`2`] continuous_euclid1; FULL_REWRITE_TAC[GSYM top2]; THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_min_real; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_closed_curve_compact; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[simple_closed_curve]; TYPE_THEN `C` UNABBREV_TAC; USEH 2198 GSYM; USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); TSPECH `f (&0)` 9716; UNDH 5422 THEN ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; TYPE_THEN `x` EXISTS_TAC; FULL_REWRITE_TAC[coord]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let xmaxQexists_lemma = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (!q. C q ==> (q 0 <=. p 0)))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`0`;`2`] continuous_euclid1; FULL_REWRITE_TAC[GSYM top2]; THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_max_real; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_closed_curve_compact; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[simple_closed_curve]; TYPE_THEN `C` UNABBREV_TAC; USEH 2198 GSYM; USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); TSPECH `f (&0)` 9716; UNDH 5422 THEN ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; TYPE_THEN `x` EXISTS_TAC; FULL_REWRITE_TAC[coord]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let xminQexists_lemma = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (!q. C q ==> (p 0 <=. q 0)))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`0`;`2`] continuous_euclid1; FULL_REWRITE_TAC[GSYM top2]; THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_min_real; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_closed_curve_compact; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[simple_closed_curve]; TYPE_THEN `C` UNABBREV_TAC; USEH 2198 GSYM; USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); TSPECH `f (&0)` 9716; UNDH 5422 THEN ASM_REWRITE_TAC[]; TYPE_THEN `&0` EXISTS_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; TYPE_THEN `x` EXISTS_TAC; FULL_REWRITE_TAC[coord]; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* state pSC *) let ymaxQ = jordan_def `ymaxQ C = supm { y | ?x. (C (point(x,y))) }`;; let yminQ = jordan_def `yminQ C = inf { y | ?x. (C (point(x,y))) }`;; let xmaxQ = jordan_def `xmaxQ C = supm { x | ?y. (C (point(x,y))) }`;; let xminQ = jordan_def `xminQ C = inf { x | ?y. (C (point(x,y))) }`;; let inf_unique = prove_by_refinement( `!X s. X s /\ (!t. X t ==> (s <= t)) ==> (s = inf X)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`X`] inf_LB; REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `s` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `(s <= inf X) /\ (inf X <= s)` BACK_TAC; UNDH 9491 THEN UNDH 1818 THEN REAL_ARITH_TAC; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let supm_unique = prove_by_refinement( `!X s. X s /\ (!t. X t ==> (t <= s)) ==> (s = supm X)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`X`] supm_UB; REWRITE_TAC[EMPTY_EXISTS]; CONJ_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `s` EXISTS_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `(s <= supm X) /\ (supm X <= s)` BACK_TAC; UNDH 4025 THEN UNDH 5913 THEN REAL_ARITH_TAC; CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Sun Jan 16 09:42:06 EST 2005 *) ]);; (* }}} *) let euclid2_point = prove_by_refinement( `!p. euclid 2 p ==> (point (p 0, p 1) = p)`, (* {{{ proof *) [ REP_BASIC_TAC; USEH 7802 (MATCH_MP point_onto); TYPE_THEN `p` UNABBREV_TAC; REWRITE_TAC[point_inj]; REWRITE_TAC[coord01]; ]);; (* }}} *) let ymaxQ_exists = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = ymaxQ C))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] ymaxQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[ymaxQ]; IMATCH_MP_TAC supm_unique; CONJ_TAC; TYPE_THEN `p 0` EXISTS_TAC; TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_SIMP_TAC[simple_closed_curve_euclid]; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC; REWRITE_TAC[coord01]; UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `A = point(x,t)` ABBREV_TAC ; REWRITE_TAC[ETA_AX]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let yminQ_exists = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = yminQ C))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] yminQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[yminQ]; IMATCH_MP_TAC inf_unique; CONJ_TAC; TYPE_THEN `p 0` EXISTS_TAC; TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_SIMP_TAC[simple_closed_curve_euclid]; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC; REWRITE_TAC[coord01]; UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `A = point(x,t)` ABBREV_TAC ; REWRITE_TAC[ETA_AX]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let xmaxQ_exists = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xmaxQ C))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] xmaxQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[xmaxQ]; IMATCH_MP_TAC supm_unique; CONJ_TAC; TYPE_THEN `p 1` EXISTS_TAC; TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_SIMP_TAC[simple_closed_curve_euclid]; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC; REWRITE_TAC[coord01]; UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `A = point(t,y)` ABBREV_TAC ; REWRITE_TAC[ETA_AX]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let xminQ_exists = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xminQ C))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] xminQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[xminQ]; IMATCH_MP_TAC inf_unique; CONJ_TAC; TYPE_THEN `p 1` EXISTS_TAC; TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_SIMP_TAC[simple_closed_curve_euclid]; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC; REWRITE_TAC[coord01]; UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `A = point(t,y)` ABBREV_TAC ; REWRITE_TAC[ETA_AX]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let ymaxQ_max = prove_by_refinement( `!C p. simple_closed_curve top2 C /\ C p ==> (p 1 <= ymaxQ C)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[ymaxQ]; THM_INTRO_TAC[`C`] ymaxQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] supm_UB; REWRITE_TAC[EMPTY_EXISTS]; (* -- *) CONJ_TAC; TYPE_THEN `p 1` EXISTS_TAC; TYPE_THEN `p 0` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `p' 1` EXISTS_TAC; TSPECH `point(x',x)` 1647; FULL_REWRITE_TAC[coord01]; ASM_REWRITE_TAC[]; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `p 0` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; ]);; (* }}} *) let yminQ_min = prove_by_refinement( `!C p. simple_closed_curve top2 C /\ C p ==> (yminQ C <= p 1)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[yminQ]; THM_INTRO_TAC[`C`] yminQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] inf_LB; REWRITE_TAC[EMPTY_EXISTS]; (* -- *) CONJ_TAC; TYPE_THEN `p 1` EXISTS_TAC; TYPE_THEN `p 0` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `p' 1` EXISTS_TAC; TSPECH `point(x',x)` 2887; FULL_REWRITE_TAC[coord01]; ASM_REWRITE_TAC[]; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `p 0` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; ]);; (* }}} *) let xmaxQ_max = prove_by_refinement( `!C p. simple_closed_curve top2 C /\ C p ==> (p 0 <= xmaxQ C)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[xmaxQ]; THM_INTRO_TAC[`C`] xmaxQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] supm_UB; REWRITE_TAC[EMPTY_EXISTS]; (* -- *) CONJ_TAC; TYPE_THEN `p 0` EXISTS_TAC; TYPE_THEN `p 1` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `p' 0` EXISTS_TAC; TSPECH `point(x,y)` 3013; FULL_REWRITE_TAC[coord01]; ASM_REWRITE_TAC[]; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `p 1` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; ]);; (* }}} *) let xminQ_min = prove_by_refinement( `!C p. simple_closed_curve top2 C /\ C p ==> (xminQ C <= p 0)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[xminQ]; THM_INTRO_TAC[`C`] xminQexists_lemma; ASM_REWRITE_TAC[]; TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] inf_LB; REWRITE_TAC[EMPTY_EXISTS]; (* -- *) CONJ_TAC; TYPE_THEN `p 0` EXISTS_TAC; TYPE_THEN `p 1` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; TYPE_THEN `p' 0` EXISTS_TAC; TSPECH `point(x,y)` 4062; FULL_REWRITE_TAC[coord01]; ASM_REWRITE_TAC[]; (* - *) FIRST_ASSUM IMATCH_MP_TAC ; TYPE_THEN `p 1` EXISTS_TAC; ASM_SIMP_TAC[euclid2_point]; (* Sun Jan 16 13:15:02 EST 2005 *) ]);; (* }}} *) extend_simp_rewrites[prove_by_refinement( `!x. x <=. x`, (* {{{ proof *) [ REP_BASIC_TAC; REAL_ARITH_TAC; ])];; (* }}} *) let real012 = prove_by_refinement( `&0 < &1 /\ &0 <= &1 /\ &0 <= &1 / &2 /\ &0 < &1 / &2 /\ &1/ &2 < &1 /\ &1 / &2 <= &1 `, (* {{{ proof *) [ CONJ_TAC; REAL_ARITH_TAC; CONJ_TAC; REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LE_RDIV; REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LT_DIV; REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LT_1; REAL_ARITH_TAC; IMATCH_MP_TAC REAL_LE_LDIV; REAL_ARITH_TAC; ]);; (* }}} *) extend_simp_rewrites[real012];; let simple_closed_curve_nonempty = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?p. C p)`, (* {{{ proof *) [ REWRITE_TAC[simple_closed_curve]; KILLH 5825; TYPE_THEN `f (&0)` EXISTS_TAC; TYPE_THEN `C` UNABBREV_TAC; IMATCH_MP_TAC image_imp; ASM_RSIMP_TAC[]; ]);; (* }}} *) let simple_closed_curve_2pt = prove_by_refinement( `!C p. simple_closed_curve top2 C /\ C p ==> (?q. C q /\ ~(q = p))`, (* {{{ proof *) [ REWRITE_TAC[simple_closed_curve]; USEH 5825 GSYM; TYPE_THEN `~(f (&0) = f( &1 / &2))` SUBAGOAL_TAC; FULL_REWRITE_TAC[INJ]; TYPE_THEN `&0 = &1 / &2` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* --- *) ASM_RSIMP_TAC []; TYPE_THEN `&0 < &2` SUBAGOAL_TAC; REAL_ARITH_TAC; TYPE_THEN `&0 < &1 / &2` SUBAGOAL_TAC; ASM_RSIMP_TAC[]; UNDH 4792 THEN UNDH 3735 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `C (f (&1 / &2))` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; IMATCH_MP_TAC image_imp; ASM_RSIMP_TAC[]; (* - *) TYPE_THEN `p = f (&0)` ASM_CASES_TAC; TYPE_THEN `p` UNABBREV_TAC; TYPE_THEN `f (&1 / &2)` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `f (&0)` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC image_imp; ASM_RSIMP_TAC[]; ]);; (* }}} *) let xmin_le_xmax = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (xminQ C <= xmaxQ C)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] xminQ_exists; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`p`] xmaxQ_max; ASM_REWRITE_TAC[]; USEH 6458 GSYM; ASM_REWRITE_TAC[]; ]);; (* }}} *) let ymin_le_ymax = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (yminQ C <= ymaxQ C)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] yminQ_exists; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`p`] ymaxQ_max; ASM_REWRITE_TAC[]; USEH 4513 GSYM; ASM_REWRITE_TAC[]; ]);; (* }}} *) let simple_closed_curve_nsubset_arc = prove_by_refinement( `!C E. simple_closed_curve top2 C /\ simple_arc top2 E ==> ~(C SUBSET E)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] simple_closed_curve_nonempty; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut; ASM_REWRITE_TAC[]; TYPE_THEN `C' SUBSET E /\ C'' SUBSET E` SUBAGOAL_TAC; TYPE_THEN `C` UNABBREV_TAC; UNDH 6378 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; THM_INTRO_TAC[`E`;`p`;`q`;`C'`] cut_arc_unique; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`E`;`p`;`q`;`C''`] cut_arc_unique; ASM_REWRITE_TAC[]; TYPE_THEN `cut_arc E p q` UNABBREV_TAC; TYPE_THEN `C''` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_IDEMPOT]; TYPE_THEN `C'` UNABBREV_TAC; THM_INTRO_TAC[`{p,q}`] simple_arc_infinite; IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[INFINITE]; FULL_REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; ASM_REWRITE_TAC[]; (* Sun Jan 16 15:22:30 EST 2005 *) ]);; (* }}} *) let xmin_lt_xmax = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (xminQ C < xmaxQ C)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`]; ASM_SIMP_TAC [xmin_le_xmax]; THM_INTRO_TAC[`C`] ymin_le_ymax; ASM_REWRITE_TAC[]; TYPE_THEN `yminQ C < ymaxQ C` SUBAGOAL_TAC; REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`]; ASM_SIMP_TAC[ymin_le_ymax]; TYPE_THEN `!p. C p ==> (p = point(xminQ C,yminQ C))` SUBAGOAL_TAC; TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; USEH 7802 (MATCH_MP point_onto); (*** Modified by JRH for proper right associativity of "=" ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;REAL_ARITH `x = y = (x <= y) /\ (y <= x)`]; ***) ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_LE_ANTISYM]; TYPE_THEN `(FST p' = p 0) /\ (SND p' = p 1)` SUBAGOAL_TAC; ASM_REWRITE_TAC[coord01]; KILLH 5687; ASM_REWRITE_TAC[]; CONJ_TAC; CONJ_TAC; IMATCH_MP_TAC xmaxQ_max; ASM_REWRITE_TAC[]; USEH 5418 GSYM; ASM_REWRITE_TAC[]; IMATCH_MP_TAC xminQ_min; ASM_REWRITE_TAC[]; (* --- *) CONJ_TAC; IMATCH_MP_TAC ymaxQ_max; ASM_REWRITE_TAC[]; TYPE_THEN `ymaxQ C` UNABBREV_TAC; IMATCH_MP_TAC yminQ_min; ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[`C`] simple_closed_curve_nonempty; ASM_REWRITE_TAC[]; COPYH 9414; TSPECH `p` 9414; TYPE_THEN `point(xminQ C,yminQ C)` UNABBREV_TAC; THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* -A BACK ON *) TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!p. C p ==> (p 0 = xmaxQ C)` SUBAGOAL_TAC; REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`]; CONJ_TAC; IMATCH_MP_TAC xmaxQ_max; ASM_REWRITE_TAC[]; TYPE_THEN `xmaxQ C` UNABBREV_TAC; IMATCH_MP_TAC xminQ_min; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!p. C p ==> (yminQ C <= p 1 /\ p 1 <= ymaxQ C)` SUBAGOAL_TAC; CONJ_TAC; IMATCH_MP_TAC yminQ_min; ASM_REWRITE_TAC[]; IMATCH_MP_TAC ymaxQ_max; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC; THM_INTRO_TAC[`C`] yminQ_exists; ASM_REWRITE_TAC[]; TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ; TYPE_THEN `p` UNABBREV_TAC; ASM_REWRITE_TAC[]; TSPECH `p` 2734; USEH 7802 (MATCH_MP point_onto); TYPE_THEN `p` UNABBREV_TAC; REWRITE_TAC[point_inj]; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `yminQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; TSPECH `point p'` 111; TYPE_THEN `xmaxQ C` UNABBREV_TAC; TYPE_THEN `xminQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; (* - *) TYPE_THEN `C (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC; THM_INTRO_TAC[`C`] ymaxQ_exists; ASM_REWRITE_TAC[]; TYPE_THEN `p = point(xminQ C, ymaxQ C)` BACK_TAC ; TYPE_THEN `p` UNABBREV_TAC; ASM_REWRITE_TAC[]; TSPECH `p` 2734; USEH 7802 (MATCH_MP point_onto); TYPE_THEN `p` UNABBREV_TAC; REWRITE_TAC[point_inj]; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `ymaxQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; TSPECH `point p'` 111; TYPE_THEN `xmaxQ C` UNABBREV_TAC; TYPE_THEN `xminQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; (* - *) TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC; ASM_SIMP_TAC [SUBSET;mk_segment_v]; TYPE_THEN `x 1` EXISTS_TAC; TYPE_THEN `yminQ C <= x 1 /\ x 1 <= ymaxQ C ` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; TSPECH `x` 2734; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; REWRITE_TAC[point_inj]; REWRITE_TAC[PAIR_SPLIT;coord01]; TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC; REWRITE_TAC[coord01]; ASM_REWRITE_TAC[]; TYPE_THEN `q = point p` ABBREV_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* -B *) THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xminQ C,ymaxQ C))`] simple_closed_curve_nsubset_arc; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; TYPE_THEN `point(xmaxQ C,yminQ C)` EXISTS_TAC; TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ]; UNDH 1234 THEN UNDH 5378 THEN REAL_ARITH_TAC; ASM_MESON_TAC[]; (* Sun Jan 16 15:26:36 EST 2005 *) ]);; (* }}} *) let ymin_lt_ymax = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (yminQ C < ymaxQ C)`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`]; ASM_SIMP_TAC [ymin_le_ymax]; THM_INTRO_TAC[`C`] xmin_lt_xmax; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!p. C p ==> (p 1 = ymaxQ C)` SUBAGOAL_TAC; REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`]; CONJ_TAC; IMATCH_MP_TAC ymaxQ_max; ASM_REWRITE_TAC[]; TYPE_THEN `ymaxQ C` UNABBREV_TAC; IMATCH_MP_TAC yminQ_min; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!p. C p ==> (xminQ C <= p 0 /\ p 0 <= xmaxQ C)` SUBAGOAL_TAC; CONJ_TAC; IMATCH_MP_TAC xminQ_min; ASM_REWRITE_TAC[]; IMATCH_MP_TAC xmaxQ_max; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC; THM_INTRO_TAC[`C`] xminQ_exists; ASM_REWRITE_TAC[]; TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ; TYPE_THEN `p` UNABBREV_TAC; ASM_REWRITE_TAC[]; TSPECH `p` 2734; USEH 7802 (MATCH_MP point_onto); TYPE_THEN `p` UNABBREV_TAC; REWRITE_TAC[point_inj]; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `xminQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; TSPECH `point p'` 4874; TYPE_THEN `ymaxQ C` UNABBREV_TAC; TYPE_THEN `yminQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; (* - *) TYPE_THEN `C (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC; THM_INTRO_TAC[`C`] xmaxQ_exists; ASM_REWRITE_TAC[]; TYPE_THEN `p = point(xmaxQ C, yminQ C)` BACK_TAC ; TYPE_THEN `p` UNABBREV_TAC; ASM_REWRITE_TAC[]; TSPECH `p` 2734; USEH 7802 (MATCH_MP point_onto); TYPE_THEN `p` UNABBREV_TAC; REWRITE_TAC[point_inj]; REWRITE_TAC[PAIR_SPLIT]; TYPE_THEN `xmaxQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; TSPECH `point p'` 4874; TYPE_THEN `ymaxQ C` UNABBREV_TAC; TYPE_THEN `yminQ C` UNABBREV_TAC; REWRITE_TAC[coord01]; (* - *) TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC; TYPE_THEN `xminQ C <= xmaxQ C` SUBAGOAL_TAC; UNDH 5679 THEN REAL_ARITH_TAC; ASM_SIMP_TAC [SUBSET;mk_segment_h]; TYPE_THEN `x 0` EXISTS_TAC; TYPE_THEN `xminQ C <= x 0 /\ x 0 <= xmaxQ C ` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; TSPECH `x` 2734; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; REWRITE_TAC[point_inj]; REWRITE_TAC[PAIR_SPLIT;coord01]; TYPE_THEN `SND p = point p 1` SUBAGOAL_TAC; REWRITE_TAC[coord01]; ASM_REWRITE_TAC[]; TYPE_THEN `q = point p` ABBREV_TAC ; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* -B *) THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xmaxQ C,yminQ C))`] simple_closed_curve_nsubset_arc; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; TYPE_THEN `point(xminQ C,ymaxQ C)` EXISTS_TAC; TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ]; UNDH 5418 THEN UNDH 5679 THEN REAL_ARITH_TAC; ASM_MESON_TAC[]; (* Sun Jan 16 15:39:56 EST 2005 *) ]);; (* }}} *) let simple_closed_curve_closed = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (closed_ top2 C)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] simple_closed_curve_nonempty; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut; ASM_REWRITE_TAC[]; TYPE_THEN `C` UNABBREV_TAC; IMATCH_MP_TAC closed_union; REWRITE_TAC[top2_top]; CONJ_TAC THEN IMATCH_MP_TAC simple_arc_end_closed THEN UNIFY_EXISTS_TAC THEN ASM_REWRITE_TAC[]; (* Sun Jan 16 16:43:23 EST 2005 *) ]);; (* }}} *) let simple_closed_curve_mk_C = prove_by_refinement( `!Q. simple_closed_curve top2 Q ==> ?C v1 v2. simple_arc_end C v1 v2 /\ (C INTER Q = {v1,v2}) /\ (v2 1 = yminQ Q) /\ (v1 1 = ymaxQ Q) /\ (!x. C x ==> (x 1 = yminQ Q) \/ (x 1 = ymaxQ Q) \/ (xmaxQ Q < x 0))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `Ca = mk_segment (point(xminQ Q,yminQ Q)) (point(xmaxQ Q + &1,yminQ Q))` ABBREV_TAC ; (* - *) TYPE_THEN `xminQ Q <= xmaxQ Q + &1` SUBAGOAL_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `xmaxQ Q` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC xmin_le_xmax; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* - *) THM_INTRO_TAC[`Ca`;`Ca INTER Q`;`{(point(xmaxQ Q + &1,yminQ Q))}`] simple_arc_end_restriction; SUBCONJ_TAC; TYPE_THEN `Ca` UNABBREV_TAC; IMATCH_MP_TAC simple_arc_end_simple; THM_INTRO_TAC[`point(xminQ Q,yminQ Q)`;`point(xmaxQ Q + &1,yminQ Q)`] mk_segment_simple_arc_end; REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT]; THM_INTRO_TAC[`Q`] xmin_lt_xmax; ASM_REWRITE_TAC[]; UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC; ASM_MESON_TAC[]; (* -- *) CONJ_TAC; IMATCH_MP_TAC closed_inter2; REWRITE_TAC[top2_top]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_closed; ASM_MESON_TAC[simple_arc_choose_end]; IMATCH_MP_TAC simple_closed_curve_closed; ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[EMPTY_EXISTS;INTER;]; REWRITE_TAC[INR IN_SING;EQ_EMPTY]; CONJ_TAC; IMATCH_MP_TAC closed_point; REWRITE_TAC[euclid_point]; (* -- *) CONJ_TAC; TYPE_THEN `x` UNABBREV_TAC; THM_INTRO_TAC[`Q`] xmaxQ_max; TSPECH `(point (xmaxQ Q + &1, yminQ Q))` 9371; REWRH 3532; FULL_REWRITE_TAC[coord01]; UNDH 3234 THEN REAL_ARITH_TAC; (* -- *) CONJ_TAC; THM_INTRO_TAC[`Q`] yminQ_exists; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `Ca` UNABBREV_TAC; ASM_SIMP_TAC[mk_segment_h]; TYPE_THEN `p 0` EXISTS_TAC; TYPE_THEN `yminQ Q` UNABBREV_TAC; (* --- *) CONJ_TAC; IMATCH_MP_TAC xminQ_min; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `xmaxQ Q` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC xmaxQ_max; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; IMATCH_MP_TAC (GSYM euclid2_point); IMATCH_MP_TAC subset_imp; TYPE_THEN `Q` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* -- *) CONV_TAC (dropq_conv "u"); TYPE_THEN `Ca` UNABBREV_TAC; ASM_SIMP_TAC[mk_segment_h]; REWRITE_TAC[point_inj; PAIR_SPLIT;]; CONV_TAC (dropq_conv "t"); ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* -A *) TYPE_THEN `Cb = mk_segment(point(xminQ Q,ymaxQ Q)) (point(xmaxQ Q + &1,ymaxQ Q))` ABBREV_TAC ; THM_INTRO_TAC[`Cb`;`Cb INTER Q`;`{(point(xmaxQ Q + &1,ymaxQ Q))}`] simple_arc_end_restriction; SUBCONJ_TAC; TYPE_THEN `Cb` UNABBREV_TAC; IMATCH_MP_TAC simple_arc_end_simple; THM_INTRO_TAC[`point(xminQ Q,ymaxQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] mk_segment_simple_arc_end; REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT]; THM_INTRO_TAC[`Q`] xmin_lt_xmax; ASM_REWRITE_TAC[]; UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC; ASM_MESON_TAC[]; (* -- *) CONJ_TAC; IMATCH_MP_TAC closed_inter2; REWRITE_TAC[top2_top]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_closed; ASM_MESON_TAC[simple_arc_choose_end]; IMATCH_MP_TAC simple_closed_curve_closed; ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[EMPTY_EXISTS;INTER;]; REWRITE_TAC[INR IN_SING;EQ_EMPTY]; CONJ_TAC; IMATCH_MP_TAC closed_point; REWRITE_TAC[euclid_point]; (* -- *) CONJ_TAC; TYPE_THEN `x` UNABBREV_TAC; THM_INTRO_TAC[`Q`] xmaxQ_max; TSPECH `(point (xmaxQ Q + &1, ymaxQ Q))` 9371; REWRH 5576; FULL_REWRITE_TAC[coord01]; UNDH 3234 THEN REAL_ARITH_TAC; (* -- *) CONJ_TAC; THM_INTRO_TAC[`Q`] ymaxQ_exists; ASM_REWRITE_TAC[]; TYPE_THEN `p` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `Cb` UNABBREV_TAC; ASM_SIMP_TAC[mk_segment_h]; TYPE_THEN `p 0` EXISTS_TAC; TYPE_THEN `ymaxQ Q` UNABBREV_TAC; (* --- *) CONJ_TAC; IMATCH_MP_TAC xminQ_min; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC REAL_LE_TRANS; TYPE_THEN `xmaxQ Q` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC xmaxQ_max; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; IMATCH_MP_TAC (GSYM euclid2_point); IMATCH_MP_TAC subset_imp; TYPE_THEN `Q` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* -- *) CONV_TAC (dropq_conv "u"); TYPE_THEN `Cb` UNABBREV_TAC; ASM_SIMP_TAC[mk_segment_h]; REWRITE_TAC[point_inj; PAIR_SPLIT;]; CONV_TAC (dropq_conv "t"); ASM_REWRITE_TAC[]; REAL_ARITH_TAC; (* -B *) TYPE_THEN `Cu = mk_segment (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` ABBREV_TAC ; TYPE_THEN `simple_arc_end Cu (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` SUBAGOAL_TAC; TYPE_THEN `Cu` UNABBREV_TAC; IMATCH_MP_TAC mk_segment_simple_arc_end; REWRITE_TAC[euclid_point]; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; THM_INTRO_TAC[`Q`] ymin_lt_ymax; ASM_REWRITE_TAC[]; UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `yminQ Q <= ymaxQ Q` SUBAGOAL_TAC; IMATCH_MP_TAC ymin_le_ymax; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `v' = point (xmaxQ Q + &1,yminQ Q)` SUBAGOAL_TAC; USEH 1212 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]); ASM_REWRITE_TAC[]; TYPE_THEN `v'` UNABBREV_TAC; (* - *) TYPE_THEN `v''' = point (xmaxQ Q + &1,ymaxQ Q)` SUBAGOAL_TAC; USEH 7634 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]); ASM_REWRITE_TAC[]; TYPE_THEN `v'''` UNABBREV_TAC; (* - *) THM_INTRO_TAC[`C'`;`Cu`;`v`;`point(xmaxQ Q + &1,yminQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] simple_arc_end_trans; ASM_REWRITE_TAC[]; REWRITE_TAC[eq_sing;INR IN_SING;INTER;]; CONJ_TAC; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_end2; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `Cu` UNABBREV_TAC; REWRITE_TAC[mk_segment_end]; TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; USEH 2838 (MATCH_MP point_onto); TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; CONJ_TAC; TYPE_THEN `Cu` UNABBREV_TAC; UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_REWRITE_TAC[]; TYPE_THEN `Ca (point p)` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `Ca` UNABBREV_TAC; UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_REWRITE_TAC[]; (* -C *) TYPE_THEN `((C' UNION Cu) INTER Q = {v}) /\ ((C' UNION Cu) INTER C'' = {(point(xmaxQ Q + &1,ymaxQ Q))}) /\ (v 1 = yminQ Q) /\ (!x. (C' UNION Cu) x ==> (x 1 = yminQ Q) \/ (xmaxQ Q < x 0))` SUBAGOAL_TAC; CONJ_TAC; REWRITE_TAC[INTER;eq_sing;INR IN_SING]; CONJ_TAC; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; USEH 2123 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_REWRITE_TAC[]; USEH 579 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; USEH 2123 (REWRITE_RULE[eq_sing;INTER;INR IN_SING]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC subset_imp; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TYPE_THEN `Cu` UNABBREV_TAC; TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `Q` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; USEH 2838 (MATCH_MP point_onto); TYPE_THEN `u` UNABBREV_TAC; UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]); FULL_REWRITE_TAC[PAIR_SPLIT;point_inj]; THM_INTRO_TAC[`Q`] xmaxQ_max; TSPECH `(point p)` 9371; REWRH 375; TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC; REWRITE_TAC[coord01]; TYPE_THEN `FST p` UNABBREV_TAC; TYPE_THEN `point p 0` UNABBREV_TAC; UNDH 3234 THEN REAL_ARITH_TAC; (* -- *) CONJ_TAC; REWRITE_TAC[eq_sing;INR IN_SING;INTER]; CONJ_TAC; CONJ_TAC; REWRITE_TAC[UNION]; DISJ2_TAC; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C''` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; USEH 2838 (MATCH_MP point_onto); TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; (* --- *) USEH 311 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `Ca (point p) /\ Cb (point p)` SUBAGOAL_TAC; CONJ_TAC THEN IMATCH_MP_TAC subset_imp THEN ASM_MESON_TAC[]; TYPE_THEN `Ca` UNABBREV_TAC; TYPE_THEN `Cb` UNABBREV_TAC; UNDH 4559 THEN UNDH 3719 THEN ASM_SIMP_TAC[mk_segment_h]; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `SND p` UNABBREV_TAC; THM_INTRO_TAC[`Q`] ymin_lt_ymax; ASM_REWRITE_TAC[]; UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC; THM_INTRO_TAC[`p`] (GSYM coord01); ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `Cu` UNABBREV_TAC; UNDH 5078 THEN ASM_SIMP_TAC[mk_segment_v]; FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_MESON_TAC[]; TYPE_THEN `Cb (point p)` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C''` EXISTS_TAC; ASM_MESON_TAC[]; TYPE_THEN `Cb` UNABBREV_TAC; UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `!x. C' x ==> (x 1 = yminQ Q)` SUBAGOAL_TAC; TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C'` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `Ca (point p)` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `Ca` UNABBREV_TAC; UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_REWRITE_TAC[coord01]; CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; (* -- *) USEH 9465 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; DISJ1_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISJ2_TAC; IMATCH_MP_TAC (REAL_ARITH `(u + &1 = v) ==> (u < v)`); TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `Cu` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `Cu` UNABBREV_TAC; UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_SIMP_TAC[coord01]; (* -D *) TYPE_THEN `Cf = C' UNION Cu` ABBREV_TAC ; KILLH 7427 THEN KILLH 6091 THEN KILLH 7407 THEN KILLH 1428 THEN KILLH 2123 THEN KILLH 7904 THEN KILLH 700 THEN KILLH 3022; (* - *) TYPE_THEN `!x. C'' x ==> (x 1 = ymaxQ Q)` SUBAGOAL_TAC; TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C''` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `Cb (point p)` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `Cb` UNABBREV_TAC; UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_REWRITE_TAC[coord01]; (* - *) TYPE_THEN `C'' INTER Q = {v''}` SUBAGOAL_TAC; REWRITE_TAC[eq_sing;INR IN_SING;INTER;]; USEH 6873 (REWRITE_RULE[SUBSET]); USEH 6548 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`Cf`;`C''`;`v`;`point(xmaxQ Q + &1,ymaxQ Q)`;`v''`] simple_arc_end_trans; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; TYPE_THEN `Cf UNION C''` EXISTS_TAC; TYPE_THEN `v''` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; (* -E *) CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; REWRITE_TAC[SUBSET;INTER ;INR in_pair;]; CONJ_TAC; USEH 3594 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; DISJ1_TAC; USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; DISJ2_TAC; USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[UNION]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_REWRITE_TAC[]; TYPE_THEN `x` UNABBREV_TAC; USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; FIRST_ASSUM IMATCH_MP_TAC ; USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_REWRITE_TAC[]; USEH 3594 (REWRITE_RULE[UNION]); FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* Sun Jan 16 18:43:03 EST 2005 *) ]);; (* }}} *) let simple_arc_end_IVT = prove_by_refinement( `!C v w i y. simple_arc_end C v w /\ v i <= y /\ y <= w i ==> (?u. C u /\ (u i = y)) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] simple_arc_connected; IMATCH_MP_TAC simple_arc_end_simple; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`i`;`2`] continuous_euclid1; FULL_REWRITE_TAC[GSYM top2]; (* - *) THM_INTRO_TAC[`coord i`;`top2`;`top_of_metric(UNIV,d_real)`;`C`] connect_image; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions]; (* - *) TYPE_THEN `!u. C u ==> (IMAGE (coord i) C) (u i)` SUBAGOAL_TAC; TYPE_THEN `u i = coord i u` SUBAGOAL_TAC; REWRITE_TAC[coord]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`IMAGE (coord i) C`;`v i`;`w i`] connected_nogap; ASM_REWRITE_TAC[]; CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* - *) USEH 9674 (REWRITE_RULE[SUBSET;IMAGE;coord]); USEH 8862 GSYM; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Mon Jan 17 07:07:14 EST 2005 *) ]);; (* }}} *) let simple_closed_curve_mk_ABD = prove_by_refinement( `!Q v1 v2. simple_closed_curve top2 Q /\ Q v1 /\ Q v2 /\ (v2 1 = yminQ Q) /\ (v1 1 = ymaxQ Q) ==> (?A B D w1 w2. simple_arc_end A v1 v2 /\ simple_arc_end B v1 v2 /\ (A UNION B = Q) /\ (A INTER B = {v1,v2}) /\ ~(w1 = v1) /\ ~(w1 = v2) /\ ~(w2 = v1) /\ ~(w2 = v2) /\ A w1 /\ B w2 /\ simple_arc_end D w1 w2 /\ (D INTER Q = {w1,w2}) /\ (!x. D x ==> (yminQ Q < x 1) /\ (x 1 < ymaxQ Q) /\ (x 0 <= xmaxQ Q)) )`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `ymid = (yminQ Q + ymaxQ Q)/(&2)` ABBREV_TAC ; TYPE_THEN `yminQ Q < ymaxQ Q` SUBAGOAL_TAC; IMATCH_MP_TAC ymin_lt_ymax; ASM_REWRITE_TAC[]; TYPE_THEN `yminQ Q < ymid /\ ymid < ymaxQ Q` SUBAGOAL_TAC; TYPE_THEN `ymid` UNABBREV_TAC; CONJ_TAC THENL[IMATCH_MP_TAC real_middle1_lt;IMATCH_MP_TAC real_middle2_lt] THEN ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~(v1 = v2)` SUBAGOAL_TAC; TYPE_THEN `v2` UNABBREV_TAC; TYPE_THEN `v1 1` UNABBREV_TAC; UNDH 6716 THEN UNDH 6486 THEN REAL_ARITH_TAC; (* - *) THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_cut; ASM_REWRITE_TAC[]; TYPE_THEN `A = C'` ABBREV_TAC ; TYPE_THEN `C'` UNABBREV_TAC; TYPE_THEN `B = C''` ABBREV_TAC ; TYPE_THEN `C''` UNABBREV_TAC; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `C = mk_segment (point(xminQ Q,ymid)) (point(xmaxQ Q,ymid))` ABBREV_TAC ; TYPE_THEN `xminQ Q <= xmaxQ Q` SUBAGOAL_TAC; IMATCH_MP_TAC xmin_le_xmax; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`(point(xminQ Q,ymid))`;`point(xmaxQ Q,ymid)`] mk_segment_simple_arc_end; REWRITE_TAC[point_inj;PAIR_SPLIT;euclid_point]; TYPE_THEN `xminQ Q < xmaxQ Q` SUBAGOAL_TAC; IMATCH_MP_TAC xmin_lt_xmax; ASM_REWRITE_TAC[]; UNDH 3331 THEN UNDH 9105 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_simple; TYPE_THEN `C` UNABBREV_TAC; ASM_MESON_TAC[]; (* - *) TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `!x. C x ==> (x 1 = ymid)` SUBAGOAL_TAC; TSPECH `x` 2734; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `C` UNABBREV_TAC; UNDH 3980 THEN (ASM_SIMP_TAC[mk_segment_h]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_REWRITE_TAC[coord01]; (* -A *) TYPE_THEN `!x. C x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q` SUBAGOAL_TAC; TSPECH `x` 2734; USEH 1837 (MATCH_MP point_onto); TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `C` UNABBREV_TAC; UNDH 3980 THEN UNDH 8406 THEN (SIMP_TAC[mk_segment_h]); FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; ASM_REWRITE_TAC[coord01]; (* - *) THM_INTRO_TAC[`C`;`A INTER C`;`B INTER C`] simple_arc_end_restriction; ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[] top2_top; TYPE_THEN `!E v v'. simple_arc_end E v v' ==> closed_ top2 E` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_closed; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC closed_inter2; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC closed_inter2; ASM_MESON_TAC[]; REWRITE_TAC[INTER;EMPTY_EXISTS]; REWRITE_TAC[EQ_EMPTY]; CONJ_TAC; TYPE_THEN `(x 1 = ymid)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); TSPECH `x` 6622 ; USEH 3537 (REWRITE_RULE[INTER;INR in_pair]); REWRH 6257; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `v2 1` UNABBREV_TAC; UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `v1 1` UNABBREV_TAC; UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC; (* -- *) TYPE_THEN `!E. simple_arc_end E v1 v2 /\ (E SUBSET Q) ==> (?u. C u /\ E u)` BACK_TAC; CONJ_TAC; UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`A`]); ASM_REWRITE_TAC[]; TYPE_THEN `Q` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; ASM_MESON_TAC[]; UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`B`]); ASM_REWRITE_TAC[]; TYPE_THEN `Q` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; ASM_MESON_TAC[]; (* --B intermediate value theorem needed *) THM_INTRO_TAC[`E`;`v2`;`v1`;`1`;`ymid`] simple_arc_end_IVT; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; UNDH 3172 THEN UNDH 8976 THEN REAL_ARITH_TAC; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `C` UNABBREV_TAC; TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `E` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; USEH 2838 (MATCH_MP point_onto); TYPE_THEN `u` UNABBREV_TAC; UNDH 8406 THEN SIMP_TAC[mk_segment_h]; REWRITE_TAC[point_inj;PAIR_SPLIT]; TYPE_THEN `FST p` EXISTS_TAC; USEH 6779 GSYM; ASM_REWRITE_TAC[coord01]; (* -- *) TYPE_THEN `Q (point p)` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; THM_INTRO_TAC[`Q`;`point p`] xminQ_min; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`Q`;`point p`] xmaxQ_max; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[GSYM coord01]; (* -C *) TYPE_THEN `D = C'''` ABBREV_TAC ; TYPE_THEN `C'''` UNABBREV_TAC; TYPE_THEN `w1 = v` ABBREV_TAC ; TYPE_THEN `v` UNABBREV_TAC; TYPE_THEN `w2 = v'` ABBREV_TAC ; TYPE_THEN `v'` UNABBREV_TAC; TYPE_THEN `D` EXISTS_TAC; TYPE_THEN `w1` EXISTS_TAC; TYPE_THEN `w2` EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `A w1 /\ B w2` SUBAGOAL_TAC; USEH 5104 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); USEH 7194 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `D INTER Q = {w1,w2}` SUBAGOAL_TAC; TYPE_THEN `Q` UNABBREV_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;UNION;INR in_pair]; UNDH 5104 THEN UNDH 7194 THEN UNDH 2332 THEN (REWRITE_TAC [eq_sing;INR IN_SING;INTER;SUBSET]) THEN MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(!x. D x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q)` SUBAGOAL_TAC; TYPE_THEN `C x` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* -D *) TYPE_THEN `~(v1 1 = ymid)` SUBAGOAL_TAC; TYPE_THEN `v1 1` UNABBREV_TAC; UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC; TYPE_THEN `~(v2 1 = ymid)` SUBAGOAL_TAC; TYPE_THEN `v2 1` UNABBREV_TAC; UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC; (* - *) TYPE_THEN `!w. D w ==> (w 1 = ymid)` SUBAGOAL_TAC; FIRST_ASSUM IMATCH_MP_TAC ; ASM_MESON_TAC[subset_imp]; (* - *) TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC; USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 5003 (REWRITE_RULE[INTER;INR in_pair]); UNDH 6817 THEN MESON_TAC[]; TYPE_THEN `!w v. (D w) /\ ~(v 1 = ymid) ==> ~(w = v)` SUBAGOAL_TAC; TYPE_THEN `v''` UNABBREV_TAC; UNDH 5813 THEN ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[]; (* Mon Jan 17 07:35:06 EST 2005 *) ]);; (* }}} *) let one_sided_jordan_curve = jordan_def `one_sided_jordan_curve Q <=> (!v w. euclid 2 v /\ euclid 2 w /\ ~Q v /\ ~Q w /\ ~(v = w) ==> (?C. simple_arc_end C v w /\ (C INTER Q = EMPTY)))`;; let simple_closed_curve_mk_E = prove_by_refinement( `!Q C D . simple_closed_curve top2 Q /\ one_sided_jordan_curve Q /\ ~(C SUBSET Q) /\ ~(D SUBSET Q) /\ simple_arc top2 C /\ simple_arc top2 D /\ (C INTER D = EMPTY) ==> (?E x1 x2. simple_arc_end E x1 x2 /\ (E INTER C = {x2}) /\ (E INTER D = {x1}) /\ (E INTER Q = EMPTY))`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?c. C c /\ ~Q c` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; TYPE_THEN `?d. D d /\ ~Q d` SUBAGOAL_TAC; FULL_REWRITE_TAC[SUBSET]; ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[one_sided_jordan_curve]; (* - *) TYPE_THEN `!R x. simple_arc top2 R /\ R x ==> euclid 2 x` SUBAGOAL_TAC; IMATCH_MP_TAC subset_imp; TYPE_THEN `R` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_euclid; ASM_REWRITE_TAC[]; (* - *) UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`c`;`d`]); ASM_REWRITE_TAC[]; USEH 6641 (REWRITE_RULE[INTER;EQ_EMPTY]); ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`C'`;`C`;`D`] simple_arc_end_restriction; ASM_REWRITE_TAC[EMPTY_EXISTS; INTER_EMPTY; ]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_closed; IMATCH_MP_TAC simple_arc_choose_end; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_closed; IMATCH_MP_TAC simple_arc_choose_end; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER]; CONJ_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_end; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_end2; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* -A *) TYPE_THEN `E = C''` ABBREV_TAC ; TYPE_THEN `C''` UNABBREV_TAC; TYPE_THEN `E` EXISTS_TAC; TYPE_THEN `v'` EXISTS_TAC; TYPE_THEN `v` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; (* - *) UNDH 3420 THEN UNDH 5123 THEN (REWRITE_TAC[EQ_EMPTY;INTER;SUBSET]) THEN MESON_TAC[]; (* Mon Jan 17 08:50:35 EST 2005 *) ]);; (* }}} *) let jordan_curve_k33_data = jordan_def `jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 <=> simple_closed_curve top2 Q /\ simple_arc_end A v1 v2 /\ simple_arc_end B v1 v2 /\ simple_arc_end C v1 v2 /\ simple_arc_end D w1 w2 /\ simple_arc_end E x1 x2 /\ ~(w1 = v1) /\ ~(w1 = v2) /\ ~(w2 = v1) /\ ~(w2 = v2) /\ A w1 /\ B w2 /\ (A UNION B = Q) /\ (A INTER B = {v1,v2}) /\ (D INTER Q = {w1,w2}) /\ (C INTER D = EMPTY) /\ (C INTER Q = {v1,v2}) /\ (E INTER C = {x2}) /\ (E INTER D = {x1}) /\ (E INTER Q = EMPTY)`;; let jordan_curve_k33_data_exist = prove_by_refinement( `!Q. simple_closed_curve top2 Q /\ one_sided_jordan_curve Q ==> (?A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2)`, (* {{{ proof *) [ REWRITE_TAC[jordan_curve_k33_data]; THM_INTRO_TAC[`Q`] simple_closed_curve_mk_C; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_curve_mk_ABD; ASM_REWRITE_TAC[]; USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 7606 (REWRITE_RULE[INTER;INR in_pair]); ASM_MESON_TAC[]; (* - *) TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B` EXISTS_TAC; TYPE_THEN `C` EXISTS_TAC; TYPE_THEN `D` EXISTS_TAC; (* - *) TYPE_THEN `C INTER D = EMPTY` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; USEH 7282 (REWRITE_RULE[INTER;EMPTY_EXISTS]); TSPECH `u` 3184; TSPECH `u` 9655; UNDH 1134 THEN UNDH 2424 THEN UNDH 920 THEN UNDH 4468 THEN REAL_ARITH_TAC; (* - *) THM_INTRO_TAC[`Q`;`C`;`D`] simple_closed_curve_mk_E; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; TYPE_THEN `simple_arc top2 D` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `!R y1 y2. (R INTER Q = {y1,y2}) /\ simple_arc_end R y1 y2 ==> ~(R SUBSET Q)` SUBAGOAL_TAC; TYPE_THEN `R SUBSET {y1,y2}` SUBAGOAL_TAC; USEH 842 (ONCE_REWRITE_RULE[FUN_EQ_THM]); UNDH 4643 THEN UNDH 5847 THEN (REWRITE_TAC [SUBSET;INR in_pair;INTER]) THEN MESON_TAC[]; TYPE_THEN `FINITE R` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{y1,y2}` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[FINITE_RULES;FINITE_INSERT]; THM_INTRO_TAC[`R`] simple_arc_infinite; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; FULL_REWRITE_TAC[INFINITE]; ASM_MESON_TAC[]; CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* -A *) TYPE_THEN `E` EXISTS_TAC; TYPE_THEN `v1` EXISTS_TAC; TYPE_THEN `v2` EXISTS_TAC; TYPE_THEN `w1` EXISTS_TAC; TYPE_THEN `w2` EXISTS_TAC; TYPE_THEN `x1` EXISTS_TAC; TYPE_THEN `x2` EXISTS_TAC; ASM_REWRITE_TAC[]; (* Mon Jan 17 09:26:35 EST 2005 *) ]);; (* }}} *) let has_size_insert = prove_by_refinement( `!X (x:A) n. ~(X x) /\ X HAS_SIZE n ==> (x INSERT X HAS_SIZE SUC n)`, (* {{{ proof *) [ REWRITE_TAC[HAS_SIZE]; ASM_SIMP_TAC [FINITE_RULES]; TYPE_THEN `n` UNABBREV_TAC; IMATCH_MP_TAC (GSYM card_suc_insert); ASM_REWRITE_TAC[]; (* Mon Jan 17 09:33:11 EST 2005 *) ]);; (* }}} *) let jordan_curve_x = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> ~(Q x1) /\ ~(Q x2) /\ ~(A x1) /\ ~(A x2) /\ ~(B x1) /\ ~(B x2) /\ ~C x1 /\ C x2 /\ D x1 /\ ~D x2 /\ E x1 /\ E x2`, (* {{{ proof *) [ REWRITE_TAC[jordan_curve_k33_data]; TYPE_THEN `E x1 /\ E x2` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_end]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~Q x1 /\ ~Q x2` SUBAGOAL_TAC; USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]); ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~A x1 /\ ~A x2 /\ ~B x1 /\ ~B x2` SUBAGOAL_TAC; TYPE_THEN `Q` UNABBREV_TAC; FULL_REWRITE_TAC[UNION;DE_MORGAN_THM;]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `D x1` SUBAGOAL_TAC; USEH 4975 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); ASM_REWRITE_TAC[]; TYPE_THEN `C x2` SUBAGOAL_TAC; USEH 1536 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`E`;`x1`;`x2`] simple_arc_end_distinct; ASM_REWRITE_TAC[]; CONJ_TAC; USEH 1536 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_MESON_TAC[]; USEH 4975 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); ASM_MESON_TAC[]; (* Mon Jan 17 09:56:00 EST 2005 *) ]);; (* }}} *) let jordan_curve_v = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> Q v1 /\ Q v2 /\ A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2 /\ ~D v1 /\ ~D v2 /\ ~E v1 /\ ~E v2`, (* {{{ proof *) [ REWRITE_TAC[jordan_curve_k33_data]; TYPE_THEN `A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; ASM_REWRITE_TAC[]; TYPE_THEN `Q v1 /\ Q v2` SUBAGOAL_TAC; TYPE_THEN `Q` UNABBREV_TAC; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~E v1 /\ ~E v2` SUBAGOAL_TAC; USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]); ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 5003 (REWRITE_RULE[INTER;INR in_pair]); ASM_MESON_TAC[]; (* Mon Jan 17 10:06:12 EST 2005 *) ]);; (* }}} *) let jordan_curve_w = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> Q w1 /\ Q w2 /\ A w1 /\ ~A w2 /\ ~B w1 /\ B w2 /\ ~C w1 /\ ~C w2 /\ D w1 /\ D w2 /\ ~E w1 /\ ~E w2`, (* {{{ proof *) [ REWRITE_TAC[jordan_curve_k33_data]; ASM_REWRITE_TAC[]; TYPE_THEN `Q w1 /\ Q w2` SUBAGOAL_TAC; TYPE_THEN `Q` UNABBREV_TAC; REWRITE_TAC[UNION]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~E w1 /\ ~E w2` SUBAGOAL_TAC; USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER;]); ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~C w1 /\ ~C w2` SUBAGOAL_TAC; USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 7606 (REWRITE_RULE[INTER;INR in_pair]); ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 6622 (REWRITE_RULE[INTER;INR in_pair]); ASM_MESON_TAC[]; (* Mon Jan 17 10:14:46 EST 2005 *) ]);; (* }}} *) let jordan_curve_AP_size3 = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> ({w1,w2,x2} HAS_SIZE 3)`, (* {{{ proof *) [ REP_BASIC_TAC; COPYH 2122; USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); (* - *) TYPE_THEN `{w1,w2,x2} = x2 INSERT {w1,w2}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_INSERT]; MESON_TAC[]; TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC; ARITH_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC has_size_insert; REWRITE_TAC[INR in_pair]; REWRITE_TAC[DE_MORGAN_THM]; (* - *) CONJ_TAC; ASM_MESON_TAC[jordan_curve_w;jordan_curve_x]; (* - *) IMATCH_MP_TAC pair_size_2; ASM_MESON_TAC[jordan_curve_w]; (* Mon Jan 17 10:18:45 EST 2005 *) ]);; (* }}} *) let jordan_curve_BP_size3 = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> ({v1,v2,x1} HAS_SIZE 3)`, (* {{{ proof *) [ REP_BASIC_TAC; COPYH 2122; USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); (* - *) TYPE_THEN `{v1,v2,x1} = x1 INSERT {v1,v2}` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_INSERT]; MESON_TAC[]; TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC; ARITH_TAC ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC has_size_insert; REWRITE_TAC[INR in_pair]; REWRITE_TAC[DE_MORGAN_THM]; (* - *) CONJ_TAC; COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_v); USEH 2122 (MATCH_MP jordan_curve_x); UNDH 2724 THEN UNDH 3425 THEN UNDH 7579 THEN MESON_TAC[]; (* - *) IMATCH_MP_TAC pair_size_2; USEH 2191 (MATCH_MP simple_arc_end_distinct); ASM_MESON_TAC[]; (* Mon Jan 17 10:26:14 EST 2005 *) ]);; (* }}} *) let jordan_curve_AP_BP_empty = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> ({w1,w2,x2} INTER {v1,v2,x1} = EMPTY)`, (* {{{ proof *) [ REP_BASIC_TAC; COPYH 2122; USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `(u = x2) \/ (u = x1) \/ ({w1,w2} u /\ {v1,v2} u)` SUBAGOAL_TAC; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; FULL_REWRITE_TAC[INR IN_INSERT]; UNDH 911 THEN UNDH 96 THEN UNDH 5829 THEN UNDH 4124 THEN UNDH 8311 THEN MESON_TAC[]; (* - *) UNDH 7992 THEN REP_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[INR IN_INSERT]; COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_v); USEH 2122 (MATCH_MP jordan_curve_x); ASM_MESON_TAC[]; (* - *) TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[INR IN_INSERT]; COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_w); USEH 2122 (MATCH_MP jordan_curve_x); ASM_MESON_TAC[]; (* - *) FULL_REWRITE_TAC[INR IN_INSERT]; COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_w); USEH 2122 (MATCH_MP jordan_curve_v); ASM_MESON_TAC[]; (* Mon Jan 17 10:36:27 EST 2005 *) ]);; (* }}} *) let has_size_drop_le = prove_by_refinement( `!n X (x:A) . FINITE X /\ CARD X <=| n ==> FINITE (x INSERT X) /\ CARD (x INSERT X) <=| SUC n`, (* {{{ proof *) [ REP_BASIC_TAC; ASM_SIMP_TAC[CARD_CLAUSES]; CONJ_TAC; ASM_MESON_TAC[FINITE_RULES]; COND_CASES_TAC; UNDH 2770 THEN ARITH_TAC; UNDH 2770 THEN ARITH_TAC; (* Mon Jan 17 10:45:48 EST 2005 *) ]);; (* }}} *) let has_size_le9 = prove_by_refinement( `!(x1:A) x2 x3 x4 x5 x6 x7 x8 x9. CARD {x1,x2,x3,x4,x5,x6,x7,x8,x9} <=| 9 /\ FINITE {x1,x2,x3,x4,x5,x6,x7,x8,x9}`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`0`;`EMPTY:A->bool`;`x9`] has_size_drop_le; REWRITE_TAC[FINITE_RULES;CARD_CLAUSES]; ARITH_TAC; (* - *) THM_INTRO_TAC[`SUC 0`;`{x9}`;`x8`] has_size_drop_le; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`SUC(SUC 0)`;`{x8,x9}`;`x7`] has_size_drop_le; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`SUC(SUC(SUC 0))`;`{x7,x8,x9}`;`x6`] has_size_drop_le; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`SUC(SUC(SUC(SUC 0)))`;`{x6,x7,x8,x9}`;`x5`] has_size_drop_le; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC 0))))`;`{x5,x6,x7,x8,x9}`;`x4`] has_size_drop_le; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC 0)))))`;`{x4,x5,x6,x7,x8,x9}`;`x3`] has_size_drop_le; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC 0))))))`;`{x3,x4,x5,x6,x7,x8,x9}`;`x2`] has_size_drop_le; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC(SUC 0)))))))`;`{x2,x3,x4,x5,x6,x7,x8,x9}`;`x1`] has_size_drop_le; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; UNDH 457 THEN ARITH_TAC; (* Mon Jan 17 10:58:38 EST 2005 *) ]);; (* }}} *) let card_surj_bij = prove_by_refinement( `!(f:A->B) X Y . FINITE X /\ CARD X <=| CARD Y /\ (!y. Y y ==> ?x. X x /\ (f x = y)) ==> BIJ f X Y`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`f`;`X`] CARD_IMAGE_LE; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`f`;`X`] FINITE_IMAGE; ASM_REWRITE_TAC[]; TYPE_THEN `Y SUBSET IMAGE f X` SUBAGOAL_TAC; REWRITE_TAC[SUBSET;IMAGE]; ASM_MESON_TAC[]; TYPE_THEN `FINITE Y` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; ASM_MESON_TAC[]; (* - *) TYPE_THEN `CARD Y <=| CARD (IMAGE f X)` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET; ASM_REWRITE_TAC[]; TYPE_THEN `(CARD Y = CARD (IMAGE f X)) /\ (CARD (IMAGE f X) = CARD X)` SUBAGOAL_TAC; UNDH 5809 THEN UNDH 8940 THEN UNDH 3182 THEN ARITH_TAC; (* - *) TYPE_THEN `Y = IMAGE f X` SUBAGOAL_TAC; IMATCH_MP_TAC CARD_SUBSET_EQ; ASM_REWRITE_TAC[]; (* - *) REWRITE_TAC[BIJ]; TYPE_THEN `SURJ f X Y` SUBAGOAL_TAC; REWRITE_TAC[SURJ]; TYPE_THEN `Y` UNABBREV_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) REWRITE_TAC[INJ]; CONJ_TAC; IMATCH_MP_TAC image_imp; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; TYPE_THEN `Z = X DELETE x` ABBREV_TAC ; (* -A *) TYPE_THEN `IMAGE f Z = Y` SUBAGOAL_TAC; TYPE_THEN `Y` UNABBREV_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; IMATCH_MP_TAC IMAGE_SUBSET; TYPE_THEN `Z` UNABBREV_TAC; REWRITE_TAC[DELETE;SUBSET]; ASM_REWRITE_TAC[]; (* -- *) REWRITE_TAC[SUBSET;IMAGE]; TYPE_THEN `x'` UNABBREV_TAC; TYPE_THEN `x'' = x` ASM_CASES_TAC; TYPE_THEN `x''` UNABBREV_TAC; TYPE_THEN `y` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `Z` UNABBREV_TAC; REWRITE_TAC[DELETE]; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `x''` EXISTS_TAC; TYPE_THEN `Z` UNABBREV_TAC; REWRITE_TAC[DELETE]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `FINITE Z` SUBAGOAL_TAC; TYPE_THEN `Z` UNABBREV_TAC; REWRITE_TAC[FINITE_DELETE]; ASM_REWRITE_TAC[]; TYPE_THEN `CARD Z <| CARD X` SUBAGOAL_TAC; THM_INTRO_TAC[`x`;`X`] CARD_SUC_DELETE; ASM_REWRITE_TAC[]; TYPE_THEN `Z` UNABBREV_TAC; UNDH 481 THEN ARITH_TAC; (* - *) TYPE_THEN `CARD Y <= CARD Z` SUBAGOAL_TAC; TYPE_THEN `Y` UNABBREV_TAC; IMATCH_MP_TAC CARD_IMAGE_LE; ASM_REWRITE_TAC[]; UNDH 9361 THEN UNDH 6773 THEN UNDH 7923 THEN UNDH 193 THEN ARITH_TAC; (* Mon Jan 17 15:04:48 EST 2005 *) ]);; (* }}} *) let select_inter = jordan_def `select_inter A C = @x. A (x:A) /\ C x` ;; let k33f = jordan_def `k33f (A:A->bool) B E = (select_inter A E, select_inter B E)`;; let incf = jordan_def `incf (f:A-> (B#B)) E = { (FST (f E)) , (SND(f E)) }`;; let k33f_value = prove_by_refinement( `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==> (k33f A B E = (a,b))`, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[k33f;PAIR_SPLIT]; CONJ_TAC; REWRITE_TAC[select_inter]; USEH 5597 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 9224 (REWRITE_RULE[INTER;INR IN_SING]); ASM_REWRITE_TAC[]; REWRITE_TAC[select_inter]; USEH 6985 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 5555 (REWRITE_RULE[INTER;INR IN_SING]); ASM_REWRITE_TAC[]; (* Mon Jan 17 15:18:50 EST 2005 *) ]);; (* }}} *) let incf_value = prove_by_refinement( `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==> (incf (k33f A B) E = {a,b})`, (* {{{ proof *) [ REWRITE_TAC[incf]; THM_INTRO_TAC[`A`;`B`;`E`;`a`;`b`] k33f_value; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* Mon Jan 17 15:22:22 EST 2005 *) ]);; (* }}} *) let incf_V = prove_by_refinement( `!(A:A->bool) B E . SING(A INTER E) /\ SING(B INTER E) ==> (incf (k33f A B) E = E INTER (A UNION B))`, (* {{{ proof *) [ REWRITE_TAC[SING]; THM_INTRO_TAC[`A`;`B`;`E`;`x`;`x'`] incf_value; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REWRITE_TAC[UNION_OVER_INTER]; ONCE_REWRITE_TAC[INTER_COMM]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[UNION;INR IN_SING;INR in_pair]; MESON_TAC[]; (* Mon Jan 17 15:31:21 EST 2005 *) ]);; (* }}} *) let k33f_E = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> ({w1,w2,x2} INTER E = {x2}) /\ ({v1,v2,x1} INTER E = {x1}) `, (* {{{ proof *) [ REP_BASIC_TAC; COPYH 2122; USEH 2122(MATCH_MP jordan_curve_w); COPYH 2122; USEH 2122(MATCH_MP jordan_curve_x); USEH 2122(MATCH_MP jordan_curve_v); CONJ_TAC; REWRITE_TAC[INTER;INR IN_INSERT;eq_sing]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[INTER;INR IN_INSERT;eq_sing]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* Mon Jan 17 15:40:01 EST 2005 *) ]);; (* }}} *) let k33f_cut_lemma = prove_by_refinement( `!C v1 v2 w A B. simple_arc_end C v1 v2 /\ C w /\ ~(w = v1) /\ ~(w = v2) /\ (A INTER C = {v1,v2}) /\ (B INTER C = {w}) ==> (A INTER (cut_arc C v1 w) = {v1}) /\ (B INTER (cut_arc C v1 w) = {w}) `, (* {{{ proof *) [ REP_BASIC_TAC; USEH 8436 (ONCE_REWRITE_RULE[FUN_EQ_THM]); THM_INTRO_TAC[`C`;`w`;`v1`;`v2`] cut_arc_inter; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[eq_sing;INR IN_INSERT;INTER;]; (* - *) TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; (* - *) TYPE_THEN `C v1 /\ C v2 ` SUBAGOAL_TAC; ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; (* - *) TYPE_THEN `simple_arc_end (cut_arc C v1 w) v1 w` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `simple_arc_end (cut_arc C v2 w) v2 w` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `cut_arc C v1 w SUBSET C ` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_subset; ASM_REWRITE_TAC[]; TYPE_THEN `cut_arc C v2 w SUBSET C ` SUBAGOAL_TAC; IMATCH_MP_TAC cut_arc_subset; ASM_REWRITE_TAC[]; (* -A *) TYPE_THEN `cut_arc C w v1 = cut_arc C v1 w` SUBAGOAL_TAC; MESON_TAC [cut_arc_symm]; TYPE_THEN `cut_arc C w v1` UNABBREV_TAC; TYPE_THEN `cut_arc C w v2 = cut_arc C v2 w` SUBAGOAL_TAC; MESON_TAC [cut_arc_symm]; TYPE_THEN `cut_arc C w v2` UNABBREV_TAC; (* - *) CONJ_TAC; CONJ_TAC; CONJ_TAC; ASM_MESON_TAC[]; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; TYPE_THEN `C u` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TSPECH `u` 2825; REWRH 9519; FIRST_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `u` UNABBREV_TAC; UNDH 6835 THEN DISCH_THEN (THM_INTRO_TAC[`v2`]); ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* - *) UNDH 6153 THEN DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[subset_imp]; (* Mon Jan 17 16:10:38 EST 2005 *) ]);; (* }}} *) let k33f_cut = prove_by_refinement( `!C v1 v2 w A B. simple_arc_end C v1 v2 /\ C w /\ ~(w = v1) /\ ~(w = v2) /\ (A INTER C = {v1,v2}) /\ (B INTER C = {w}) ==> (A INTER (cut_arc C v1 w) = {v1}) /\ (B INTER (cut_arc C v1 w) = {w}) /\ (A INTER (cut_arc C v2 w) = {v2}) /\ (B INTER (cut_arc C v2 w) = {w})`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`;`v1`;`v2`;`w`;`A`;`B`] k33f_cut_lemma; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`v2`;`v1`;`w`;`A`;`B`] k33f_cut_lemma; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INR IN_INSERT]; MESON_TAC[]; ASM_REWRITE_TAC[]; (* Mon Jan 17 16:13:48 EST 2005 *) ]);; (* }}} *) let jordan_curve_k33 = jordan_def `jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2 = mk_graph_t ({w1,w2,x2} UNION {v1,v2,x1}, {E, (cut_arc A v1 w1), (cut_arc A v2 w1), (cut_arc B v1 w2), (cut_arc B v2 w2), (cut_arc C v1 x2), (cut_arc C v2 x2), (cut_arc D w1 x1),( cut_arc D w2 x1)}, (\ e. {(FST (k33f {w1,w2,x2} {v1,v2,x1} e)), (SND (k33f {w1,w2,x2} {v1,v2,x1} e)) }))`;; let jordan_curve_AP_euclid = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> {w1,w2,x2} UNION {v1,v2,x1} SUBSET euclid 2`, (* {{{ proof *) [ REP_BASIC_TAC; COPYH 2122; USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); REWRITE_TAC[UNION;SUBSET;INR IN_INSERT]; IMATCH_MP_TAC subset_imp; TYPE_THEN `simple_arc top2 A /\ simple_arc top2 D /\ simple_arc top2 E` SUBAGOAL_TAC; REPEAT CONJ_TAC THEN IMATCH_MP_TAC simple_arc_end_simple THEN ASM_MESON_TAC[]; USEH 9474 (MATCH_MP simple_arc_euclid); USEH 6512 (MATCH_MP simple_arc_euclid); USEH 7513 (MATCH_MP simple_arc_euclid); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_x); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_v); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_w); UNDH 2244 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN ASM_MESON_TAC[]; (* Mon Jan 17 17:05:26 EST 2005 *) ]);; (* }}} *) let cut_arc_simple2 = prove_by_refinement( `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==> simple_arc top2 (cut_arc C v w)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`;`v`;`w`] cut_arc_simple; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_simple; ASM_MESON_TAC[]; ]);; (* }}} *) let jordan_curve_k33_plane_criterion = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ (graph G) /\ (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\ (SING ({v1,v2,x1} INTER e))) /\ (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> e INTER e' SUBSET graph_vertex G) ==> plane_graph G `, (* {{{ proof *) [ REP_BASIC_TAC; REWRITE_TAC[plane_graph]; ASM_REWRITE_TAC[]; TYPE_THEN `G` UNABBREV_TAC; FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph]; CONJ_TAC; IMATCH_MP_TAC jordan_curve_AP_euclid; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; REWRITE_TAC[SUBSET;INR IN_INSERT]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; FULL_REWRITE_TAC[jordan_curve_k33_data]; ASM_MESON_TAC[simple_arc_end_simple]; KILLH 8072; (* -- *) TYPE_THEN `simple_arc top2 A /\ simple_arc top2 B /\ simple_arc top2 C /\ simple_arc top2 D` SUBAGOAL_TAC; FULL_REWRITE_TAC[jordan_curve_k33_data]; REPEAT CONJ_TAC THEN IMATCH_MP_TAC simple_arc_end_simple THEN ASM_MESON_TAC[]; (* -- *) COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_v); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_x); USEH 2122 (MATCH_MP jordan_curve_w); UNDH 9236 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN IMATCH_MP_TAC cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; (* -A *) TYPE_THEN `{(FST (k33f {w1, w2, x2} {v1, v2, x1} e)), (SND (k33f {w1, w2, x2} {v1, v2, x1} e))} = (incf (k33f {w1, w2,x2} {v1,v2,x1} ) e)` SUBAGOAL_TAC; REWRITE_TAC[incf]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC incf_V; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* Mon Jan 17 17:27:23 EST 2005 *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* SECTION DD *) (* ------------------------------------------------------------------ *) let cartesian_size = prove_by_refinement( `!(A:A->bool) (B:B->bool) m n. A HAS_SIZE m /\ B HAS_SIZE n ==> cartesian A B HAS_SIZE (m *| n)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`A`;`B`] CARD_PRODUCT; FULL_REWRITE_TAC[HAS_SIZE]; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[IN]; TYPE_THEN `cartesian A B = {(x,y) | A x /\ B y}` SUBAGOAL_TAC; REWRITE_TAC[cartesian]; ASM_REWRITE_TAC[]; REWRITE_TAC[HAS_SIZE]; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[HAS_SIZE]; ASM_REWRITE_TAC[]; (* - *) IMATCH_MP_TAC (INR FINITE_PRODUCT); ASM_REWRITE_TAC[]; (* Mon Jan 17 19:37:49 EST 2005 *) ]);; (* }}} *) let jordan_k33f_bij = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==> (BIJ (k33f {w1,w2,x2} {v1,v2,x1}) (graph_edge G) (cartesian {w1,w2,x2} {v1,v2,x1})) /\ (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\ (SING ({v1,v2,x1} INTER e))) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `G` UNABBREV_TAC; TYPE_THEN `L = (graph_edge (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))` ABBREV_TAC ; FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph]; (* - *) COPYH 2122; USEH 2122 (MATCH_MP k33f_E); (* - *) COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_x); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_v); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_w); COPYH 2122; USEH 2122 (REWRITE_RULE [jordan_curve_k33_data]); (* -A *) THM_INTRO_TAC[`A`;`v1`;`v2`;`w1`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[INTER;INR IN_INSERT]; CONJ_TAC THEN ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`B`;`v1`;`v2`;`w2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[INTER;INR IN_INSERT]; CONJ_TAC THEN ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`C`;`v1`;`v2`;`x2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut; ASM_REWRITE_TAC[]; TYPE_THEN `~(x2 = v1 ) /\ ~(x2 = v2)` SUBAGOAL_TAC; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[INTER;INR IN_INSERT]; CONJ_TAC THEN ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`D`;`w1`;`w2`;`x1`;`{w1,w2,x2}`;`{v1,v2,x1}`] k33f_cut; ASM_REWRITE_TAC[]; TYPE_THEN `~(x1 = w1 ) /\ ~(x1 = w2)` SUBAGOAL_TAC; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[INTER;INR IN_INSERT]; CONJ_TAC THEN ASM_MESON_TAC[]; (* -B *) IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); CONJ_TAC; TYPE_THEN `L` UNABBREV_TAC; USEH 3555 (REWRITE_RULE[INR IN_INSERT]); TYPE_THEN `!U V (x:num->real). (U INTER V = {x}) ==> (SING (U INTER V))` SUBAGOAL_TAC; REWRITE_TAC[SING]; UNIFY_EXISTS_TAC ; ASM_REWRITE_TAC[]; (* -- *) UNDH 4488 THEN DISCH_THEN (fun t-> RULE_ASSUM_TAC (fun s -> try (MATCH_MP t s) with failure -> s)); FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; ASM_REWRITE_TAC[]; KILLH 4869; UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_REWRITE_TAC[] ; (* -C *) IMATCH_MP_TAC card_surj_bij ; (* - *) SUBCONJ_TAC; TYPE_THEN `L` UNABBREV_TAC; REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; (* - *) TYPE_THEN ` (cartesian {w1, w2, x2} {v1, v2, x1}) HAS_SIZE (3 *| 3)` SUBAGOAL_TAC; IMATCH_MP_TAC cartesian_size; CONJ_TAC; IMATCH_MP_TAC jordan_curve_AP_size3; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC jordan_curve_BP_size3; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; TYPE_THEN `L` UNABBREV_TAC; FULL_REWRITE_TAC[HAS_SIZE]; ASM_REWRITE_TAC[]; TYPE_THEN `3 *| 3 = 9` SUBAGOAL_TAC; ARITH_TAC; ASM_REWRITE_TAC[]; MESON_TAC[has_size_le9]; (* -D *) TYPE_THEN `(y = (w1,v1)) \/ (y = (w1,v2)) \/ (y = (w1,x1)) \/ (y = (w2,v1)) \/ (y = (w2,v2)) \/ (y = (w2,x1)) \/ (y = (x2,v1)) \/ (y = (x2,v2)) \/ (y = (x2,x1))` SUBAGOAL_TAC; FULL_REWRITE_TAC[cartesian]; TYPE_THEN `y` UNABBREV_TAC; REWRITE_TAC[PAIR_SPLIT]; USEH 8489 (REWRITE_RULE[INR IN_INSERT]); USEH 7329 (REWRITE_RULE[INR IN_INSERT]); UNDH 1878 THEN UNDH 8866 THEN MESON_TAC[]; (* - *) TYPE_THEN `?x. L x /\ ({w1,w2,x2} INTER x = {(FST y)}) /\ ({v1,v2,x1} INTER x = {(SND y)})` BACK_TAC; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`{w1,w2,x2}`;`{v1,v2,x1}`;`x`;`FST y`;`SND y`] k33f_value; ASM_REWRITE_TAC[]; USEH 5894 (REWRITE_RULE[]); ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `L` UNABBREV_TAC; REWRITE_TAC[INR IN_INSERT]; UNDH 7966 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `y` UNABBREV_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]; (* Mon Jan 17 20:01:06 EST 2005 *) ]);; (* }}} *) let jordan_curve_k33_isk33 = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> graph_isomorphic k33_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)`, (* {{{ proof *) [ REWRITE_TAC[jordan_curve_k33]; IMATCH_MP_TAC k33_iso; (* - *) CONJ_TAC; IMATCH_MP_TAC jordan_curve_AP_size3; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; IMATCH_MP_TAC jordan_curve_BP_size3; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) CONJ_TAC; IMATCH_MP_TAC jordan_curve_AP_BP_empty; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2`] jordan_k33f_bij; ASM_REWRITE_TAC[]; KILLH 2219; FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;]; TYPE_THEN `fn = k33f {w1,w2,x2} {v1,v2,x1}` ABBREV_TAC ; TYPE_THEN `(\ e. fn e) = fn` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; ASM_REWRITE_TAC[]; (* Mon Jan 17 20:12:31 EST 2005 *) ]);; (* }}} *) let jordan_curve_k33_data_inter = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> (A INTER B = {v1,v2}) /\ (A INTER C = {v1,v2}) /\ (A INTER D = {w1}) /\ (A INTER E = EMPTY) /\ (B INTER C = {v1,v2}) /\ (B INTER D = {w2}) /\ (B INTER E = EMPTY) /\ (C INTER D = EMPTY) /\ (C INTER E = {x2}) /\ (D INTER E = {x1})`, (* {{{ proof *) [ REWRITE_TAC[jordan_curve_k33_data]; FULL_REWRITE_TAC[INTER_COMM]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(A INTER E = EMPTY ) /\ (B INTER E = EMPTY)` SUBAGOAL_TAC; TYPE_THEN `Q` UNABBREV_TAC; USEH 2576 (REWRITE_RULE[INTER;UNION;EQ_EMPTY]); REWRITE_TAC[EQ_EMPTY;INTER]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(A INTER C = {v1, v2}) /\ (B INTER C = {v1, v2})` SUBAGOAL_TAC; ONCE_REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[INTER;INR IN_INSERT]; USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 7606 (REWRITE_RULE[INTER;INR IN_INSERT]); TYPE_THEN `Q` UNABBREV_TAC; FULL_REWRITE_TAC[UNION]; USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]); CONJ_TAC THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* -A *) REWRITE_TAC[INTER;eq_sing;INR IN_INSERT]; TYPE_THEN `Q` UNABBREV_TAC; ASM_REWRITE_TAC[]; USEH 1691 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 4348 (REWRITE_RULE[INTER;UNION;INR IN_INSERT]); USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]); ASM_MESON_TAC[]; (* Mon Jan 17 20:35:28 EST 2005 *) ]);; (* }}} *) let jordan_curve_edge_inter = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> (!e e'. {A,B,C,D,E} e /\ {A,B,C,D,E} e' /\ ~(e = e') ==> (e INTER e' SUBSET ({w1,w2,x2} UNION {v1,v2,x1})))`, (* {{{ proof *) [ REWRITE_TAC[INR IN_INSERT]; TYPE_THEN `V = {w1, w2, x2} UNION {v1, v2, x1}` ABBREV_TAC ; TYPE_THEN `{v1,v2} SUBSET V /\ {w1} SUBSET V /\ EMPTY SUBSET V /\ {w2} SUBSET V /\ {x2} SUBSET V /\ {x1} SUBSET V` SUBAGOAL_TAC; TYPE_THEN `V` UNABBREV_TAC; REWRITE_TAC[SUBSET;UNION;INR IN_INSERT]; REPEAT CONJ_TAC THEN MESON_TAC[]; (* - *) JOIN 2 1 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; USEH 2122 (MATCH_MP jordan_curve_k33_data_inter); UNDH 4732 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN TYPE_THEN `e'` UNABBREV_TAC THEN FULL_REWRITE_TAC[] THEN ASM_REWRITE_TAC[INTER_COMM ] THEN ASM_MESON_TAC[]; (* Mon Jan 17 20:46:56 EST 2005 *) ]);; (* }}} *) let jordan_curve_k33_plane_criterion2 = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> e INTER e' SUBSET graph_vertex G) ==> plane_graph G`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC jordan_curve_k33_plane_criterion; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) SUBCONJ_TAC; THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph; REWRITE_TAC[k33_isgraph]; TYPE_THEN `G` UNABBREV_TAC; IMATCH_MP_TAC jordan_curve_k33_isk33; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `G` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* - *) ASM_MESON_TAC[jordan_k33f_bij]; (* Tue Jan 18 06:14:19 EST 2005 *) ]);; (* }}} *) let jordan_curve_edge_arc = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G e. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ (graph_edge G e) ==> (simple_arc top2 e)`, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `G` UNABBREV_TAC; FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33]; FULL_REWRITE_TAC[INR IN_INSERT]; COPYH 2122; USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); RULE_ASSUM_TAC (fun s-> try (MATCH_MP simple_arc_end_simple s) with failure -> s); (* - *) FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `e` UNABBREV_TAC; ASM_REWRITE_TAC[]; KILLH 4869; COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_x); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_v); COPYH 2122; USEH 2122 (MATCH_MP jordan_curve_w); UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN IMATCH_MP_TAC cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; (* Tue Jan 18 06:28:31 EST 2005 *) ]);; (* }}} *) let jordan_curve_guider_inj = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G e U V. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ (graph_edge G e) /\ {A,B,C,D,E} U /\ {A,B,C,D,E} V /\ (e SUBSET U) /\ (e SUBSET V) ==> (U = V) `, (* {{{ proof *) [ REP_BASIC_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `INFINITE e` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_infinite; IMATCH_MP_TAC jordan_curve_edge_arc; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(U INTER V) SUBSET ({w1,w2,x2} UNION {v1,v2,x1})` SUBAGOAL_TAC; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_edge_inter; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `e SUBSET {w1, w2, x2} UNION {v1, v2, x1}` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `U INTER V` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC [SUBSET;INTER]; ASM_MESON_TAC[subset_imp]; (* - *) TYPE_THEN `FINITE ({w1, w2, x2} UNION {v1, v2, x1})` SUBAGOAL_TAC; REWRITE_TAC[ FINITE_UNION]; REWRITE_TAC[FINITE_RULES;FINITE_INSERT]; TYPE_THEN `FINITE e` SUBAGOAL_TAC; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{w1, w2, x2} UNION {v1, v2, x1}` EXISTS_TAC; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[INFINITE]; ASM_MESON_TAC[]; (* Tue Jan 18 06:3282:02 EST 2005 *) ]);; (* }}} *) let jordan_curve_guider_disj = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(A = E) /\ ~(B = C) /\ ~(B = D) /\ ~(B = E) /\ ~(C = D) /\ ~(C = E) /\ ~(D = E)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_k33_data_inter; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[DE_MORGAN_THM]; (* - *) TYPE_THEN `INFINITE A /\ INFINITE B /\ INFINITE C /\ INFINITE D /\ INFINITE E` SUBAGOAL_TAC; FULL_REWRITE_TAC[jordan_curve_k33_data]; RULE_ASSUM_TAC (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s); RULE_ASSUM_TAC (fun s -> try (MATCH_MP simple_arc_infinite s) with failure -> s); ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `FINITE (A INTER B) /\ FINITE (A INTER C) /\ FINITE (A INTER D) /\ FINITE (A INTER E) /\ FINITE (B INTER C) /\ FINITE (B INTER D) /\ FINITE (B INTER E) /\ FINITE (C INTER D) /\ FINITE(C INTER E) /\ FINITE (D INTER E)` SUBAGOAL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[FINITE_RULES;FINITE_INSERT]; FULL_REWRITE_TAC[INFINITE]; (* - *) KILLH 3523 THEN KILLH 1286 THEN KILLH 6641 THEN KILLH 4962 THEN KILLH 3223 THEN KILLH 6941 THEN KILLH 9399 THEN KILLH 3259 THEN KILLH 8436 THEN KILLH 2195 THEN KILLH 2122; UNDH 5285 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TRY (TYPE_THEN `A` UNABBREV_TAC) THEN TRY (TYPE_THEN `B` UNABBREV_TAC) THEN TRY (TYPE_THEN `C` UNABBREV_TAC) THEN TRY (TYPE_THEN `D` UNABBREV_TAC) THEN FULL_REWRITE_TAC[INTER_IDEMPOT] THEN ASM_MESON_TAC[]; (* Tue Jan 18 07:01:04 EST 2005 *) ]);; (* }}} *) let jordan_curve_guider_enum = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> (E SUBSET E) /\ (cut_arc A v1 w1 SUBSET A) /\ (cut_arc A v2 w1 SUBSET A) /\ (cut_arc B v1 w2 SUBSET B) /\ (cut_arc B v2 w2 SUBSET B) /\ (cut_arc C v1 x2 SUBSET C) /\ (cut_arc C v2 x2 SUBSET C) /\ (cut_arc D w1 x1 SUBSET D) /\ (cut_arc D w2 x1 SUBSET D)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET_REFL]; COPYH 2122; USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); RULE_ASSUM_TAC (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s); COPYH 2122 ; USEH 2122 (MATCH_MP jordan_curve_x); COPYH 2122 ; USEH 2122 (MATCH_MP jordan_curve_v); COPYH 2122 ; USEH 2122 (MATCH_MP jordan_curve_w); REPEAT CONJ_TAC THEN IMATCH_MP_TAC cut_arc_subset THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; (* Tue Jan 18 07:12:33 EST 2005 *) ]);; (* }}} *) let jordan_curve_guider_exists = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G e. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ graph_edge G e ==> (?U. {A,B,C,D,E} U /\ e SUBSET U)`, (* {{{ proof *) [ REWRITE_TAC[INR IN_INSERT]; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum; ASM_REWRITE_TAC[]; TYPE_THEN `G` UNABBREV_TAC; FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33]; FULL_REWRITE_TAC[INR IN_INSERT]; UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN UNIFY_EXISTS_TAC THEN ASM_REWRITE_TAC[]; (* Tue Jan 18 07:43:50 EST 2005 *) ]);; (* }}} *) let jordan_curve_guider_sep_lemma = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G e . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ graph_edge G e ==> (((e SUBSET A) ==> (e = cut_arc A v1 w1) \/ (e = cut_arc A v2 w1)) /\ ((e SUBSET B) ==> (e = cut_arc B v1 w2) \/ (e = cut_arc B v2 w2)) /\ ((e SUBSET C) ==> (e = cut_arc C v1 x2) \/ (e = cut_arc C v2 x2)) /\ ((e SUBSET D) ==> (e = cut_arc D w1 x1) \/ (e = cut_arc D w2 x1)) /\ ((e SUBSET E) ==> (e = E))) `, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_disj; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`] jordan_curve_guider_inj; REWRH 1245; TYPE_THEN `G` UNABBREV_TAC; FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;INR IN_INSERT]; REPEAT CONJ_TAC THEN UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_MESON_TAC[]; (* Tue Jan 18 09:38:07 EST 2005 *) ]);; (* }}} *) let cut_arc_inter_lemma = prove_by_refinement( `!X R u v w. X u /\ simple_arc_end R v w /\ R u /\ ~(u = v) /\ ~(u = w) ==> (cut_arc R v u INTER cut_arc R w u SUBSET X)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`R`;`u`;`v`;`w`] cut_arc_inter; ASM_REWRITE_TAC[]; TYPE_THEN `cut_arc R u w = cut_arc R w u` SUBAGOAL_TAC; MESON_TAC[cut_arc_symm]; TYPE_THEN `cut_arc R u w` UNABBREV_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;INR IN_SING]; TYPE_THEN `x` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* Tue Jan 18 09:55:17 EST 2005 *) ]);; (* }}} *) let jordan_curve_cut_inter = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==> (cut_arc A v1 w1 INTER cut_arc A v2 w1 SUBSET graph_vertex G) /\ (cut_arc B v1 w2 INTER cut_arc B v2 w2 SUBSET graph_vertex G) /\ (cut_arc C v1 x2 INTER cut_arc C v2 x2 SUBSET graph_vertex G) /\ (cut_arc D w1 x1 INTER cut_arc D w2 x1 SUBSET graph_vertex G) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `G` UNABBREV_TAC; FULL_REWRITE_TAC[graph_vertex_mk_graph;jordan_curve_k33]; COPYH 2122 ; COPYH 2122 ; COPYH 2122 ; USEH 2122 (MATCH_MP jordan_curve_x); USEH 2122 (MATCH_MP jordan_curve_v); USEH 2122 (MATCH_MP jordan_curve_w); FULL_REWRITE_TAC[jordan_curve_k33_data]; REPEAT CONJ_TAC THEN IMATCH_MP_TAC cut_arc_inter_lemma THEN ASM_REWRITE_TAC[UNION;INR IN_INSERT ] THEN ASM_MESON_TAC[] ; (* Tue Jan 18 10:00:14 EST 2005 *) ]);; (* }}} *) let jordan_curve_guider_separate = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G U e e'. jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ {A,B,C,D,E} U /\ e SUBSET U /\ e' SUBSET U /\ graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (e INTER e' SUBSET graph_vertex G) `, (* {{{ proof *) [ REP_BASIC_TAC; TYPE_THEN `?a b. ((e = a) \/ (e = b)) /\ ((e' = a) \/ (e' = b)) /\ (a INTER b SUBSET graph_vertex G)` BACK_TAC; TYPE_THEN `((e = a) /\ (e' = b)) \/ ((e = b) /\ (e' = a))` SUBAGOAL_TAC; ASM_MESON_TAC[]; FIRST_ASSUM DISJ_CASES_TAC; ASM_MESON_TAC[]; TYPE_THEN `e` UNABBREV_TAC; TYPE_THEN `e'` UNABBREV_TAC; FULL_REWRITE_TAC[INTER_COMM]; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`] jordan_curve_cut_inter; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`] jordan_curve_guider_sep_lemma ; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e'`] jordan_curve_guider_sep_lemma ; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[INR IN_INSERT]; TYPE_THEN `U = E` ASM_CASES_TAC; TYPE_THEN `U` UNABBREV_TAC; TYPE_THEN `E` UNABBREV_TAC; TYPE_THEN `e'` UNABBREV_TAC; UNDH 4836 THEN MESON_TAC[]; REWRH 4440; TYPE_THEN `G` UNABBREV_TAC; UNDH 7811 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `U` UNABBREV_TAC THEN REP_BASIC_TAC; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; KILLH 2881; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; KILLH 2881 THEN KILLH 1255; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; KILLH 2881 THEN KILLH 1255 THEN KILLH 2514; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* Tue Jan 18 10:22:53 EST 2005 *) ]);; (* }}} *) let jordan_curve_k33_plane = prove_by_refinement( `!Q A B C D E v1 v2 w1 w2 x1 x2 G . jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==> plane_graph G`, (* {{{ proof *) [ REP_BASIC_TAC; IMATCH_MP_TAC jordan_curve_k33_plane_criterion2; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `(?U. {A,B,C,D,E} U /\ e SUBSET U)` SUBAGOAL_TAC; IMATCH_MP_TAC jordan_curve_guider_exists; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `(?U'. {A,B,C,D,E} U' /\ e' SUBSET U')` SUBAGOAL_TAC; IMATCH_MP_TAC jordan_curve_guider_exists; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `U = U'` ASM_CASES_TAC; TYPE_THEN `U'` UNABBREV_TAC; IMATCH_MP_TAC jordan_curve_guider_separate; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `U INTER U'` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC subset_inter_pair; ASM_REWRITE_TAC[]; REWRITE_TAC[jordan_curve_k33;graph_vertex_mk_graph]; ASM_MESON_TAC[jordan_curve_edge_inter]; (* Tue Jan 18 10:32:34 EST 2005 *) ]);; (* }}} *) let jordan_curve_not_one_sided = prove_by_refinement( `!Q. simple_closed_curve top2 Q ==> ~(one_sided_jordan_curve Q)`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`Q`] jordan_curve_k33_data_exist; ASM_REWRITE_TAC[]; TYPE_THEN `plane_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC; IMATCH_MP_TAC jordan_curve_k33_plane; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `graph_isomorphic k33_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC; IMATCH_MP_TAC jordan_curve_k33_isk33; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[] k33_nonplanar; FULL_REWRITE_TAC[planar_graph]; UNDH 3419 THEN ASM_REWRITE_TAC[]; UNIFY_EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC graph_isomorphic_symm; ASM_REWRITE_TAC[]; REWRITE_TAC[k33_isgraph]; (* Tue Jan 18 10:43:40 EST 2005 *) ]);; (* }}} *) (* Tue Jan 18 10:44:07 EST 2005 I'M DONE! The Jordan Curve Theorem is proved. The statements jordan_curve_not_one_sided and jordan_curve_no_inj3 give a form of the Jordan Curve Theorem. Now lets put it in a simple form. *) let component_simple_arc_ver2 = prove_by_refinement( `!G x y. (closed_ top2 G ) /\ ~(x = y) ==> (component (induced_top top2 (euclid 2 DIFF G)) x y <=> (?C. simple_arc_end C x y /\ (C INTER G = EMPTY)))`, (* {{{ proof *) [ (* string together :component-imp-connected, connected-induced2, p_conn_conn, p_conn_hv_finite; other_direction : simple_arc_connected, connected-induced, connected-component; *) REP_BASIC_TAC; ASSUME_TAC top2_top; THM_INTRO_TAC[`top2`;`(euclid 2 DIFF G)`] induced_top_top; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `top2 (euclid 2 DIFF G)` SUBAGOAL_TAC; USEH 4142 (MATCH_MP closed_open); FULL_REWRITE_TAC[top2_unions;open_DEF ]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `A = euclid 2 DIFF G` ABBREV_TAC ; TYPE_THEN `UNIONS (induced_top top2 A) = A` SUBAGOAL_TAC; THM_INTRO_TAC[`top2`;`A`] induced_top_support; ASM_REWRITE_TAC[top2_unions;]; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;DIFF]; MESON_TAC[]; (* - *) IMATCH_MP_TAC EQ_ANTISYM; CONJ_TAC; THM_INTRO_TAC[`induced_top top2 A`;`x`] component_imp_connected; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`(top2)`;`A`;`(component (induced_top top2 A) x)`] connected_induced2; ASM_REWRITE_TAC[top2_unions]; IMATCH_MP_TAC SUBSET_TRANS; TYPE_THEN `UNIONS (induced_top top2 A)` EXISTS_TAC; CONJ_TAC; KILLH 9392; REWRITE_TAC[component_unions]; UNDH 250 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DIFF;SUBSET]; ASM_REWRITE_TAC[]; REWRH 486; (* --A *) TYPE_THEN `B = component (induced_top top2 A) x` ABBREV_TAC ; TYPE_THEN `B x /\ B y` SUBAGOAL_TAC; TYPE_THEN `B` UNABBREV_TAC; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`(induced_top top2 A)`;`x`;`y`] component_replace; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC component_symm; ASM_REWRITE_TAC[]; (* -- *) ASSUME_TAC loc_path_conn_top2; TYPE_THEN `top_of_metric(A,d_euclid) = (induced_top top2 A)` SUBAGOAL_TAC; REWRITE_TAC[top2]; ONCE_REWRITE_TAC[EQ_SYM_EQ]; IMATCH_MP_TAC top_of_metric_induced; TYPE_THEN `A` UNABBREV_TAC; REWRITE_TAC[DIFF;SUBSET]; MESON_TAC[metric_euclid]; (* -- *) TYPE_THEN `loc_path_conn (induced_top top2 A)` SUBAGOAL_TAC; THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid; FULL_REWRITE_TAC[top2]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* -- *) THM_INTRO_TAC[`top2`] loc_path_conn; REWRH 6586; TSPECH `A` 7522; REWRH 4569; TSPECH `x` 6750; TYPE_THEN `A x` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `top2 B` SUBAGOAL_TAC; TYPE_THEN `B` UNABBREV_TAC; ASM_MESON_TAC[path_eq_conn]; (* --B *) THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn; ASM_REWRITE_TAC[]; (* -- *) THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite; ASM_MESON_TAC[]; REWRH 7914; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; TYPE_THEN `B u` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `A u` SUBAGOAL_TAC; ASM_MESON_TAC[subset_imp]; TYPE_THEN `A` UNABBREV_TAC; USEH 1911 (REWRITE_RULE[DIFF]); ASM_MESON_TAC[]; (* -C *) (* other_direction : simple_arc_connected, connected-induced, connected-component; *) THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`] simple_arc_connected; ASM_REWRITE_TAC[]; TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC; IMATCH_MP_TAC simple_arc_euclid; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2; ASM_REWRITE_TAC[top2_unions]; REWRH 8620; (* - *) TYPE_THEN `C SUBSET A` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; ASM_REWRITE_TAC[DIFF_SUBSET]; REWRH 9619; (* - *) THM_INTRO_TAC[`induced_top top2 A`;`C`;`x`] connected_component; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; USEH 5951(REWRITE_RULE[SUBSET]); TSPECH `y` 4625; FIRST_ASSUM IMATCH_MP_TAC ; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* Tue Jan 18 12:54:06 EST 2005 *) ]);; (* }}} *) let component_properties = prove_by_refinement( `!C A v. closed_ top2 C /\ (euclid 2 v) /\ ~C v /\ (A = component (induced_top top2 (euclid 2 DIFF C)) v) ==> top2 A /\ connected top2 A /\ ~(A = EMPTY) /\ (A INTER C = EMPTY) /\ A v /\ (A SUBSET euclid 2) /\ (!w. ~(w = v) ==> (A w = (?P. simple_arc_end P v w /\ (P INTER C = EMPTY))))`, (* {{{ proof *) [ REP_BASIC_TAC; (* - *) ASSUME_TAC top2_top; (* -A *) THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support; FULL_REWRITE_TAC[top2_unions]; (* - *) TYPE_THEN `euclid 2 INTER (euclid 2 DIFF C) = euclid 2 DIFF C` SUBAGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[INTER;DIFF]; MESON_TAC[]; REWRH 972; KILLH 105; (* - *) TYPE_THEN `top2 (euclid 2 DIFF C)` SUBAGOAL_TAC; THM_INTRO_TAC[`top2`;`C`] (REWRITE_RULE[open_DEF] closed_open); ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[top2_unions]; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`2`;`(euclid 2 DIFF C)`] loc_path_conn_euclid; REWRITE_TAC[GSYM top2]; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`2`;`euclid 2`] loc_path_conn_euclid; REWRITE_TAC[GSYM top2]; THM_INTRO_TAC[`top2`] top_univ; REWRITE_TAC[top2_top]; FULL_REWRITE_TAC[top2_unions]; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[GSYM top2]; (* - *) USEH 7343 GSYM; ASM_REWRITE_TAC[]; TYPE_THEN `A v` SUBAGOAL_TAC; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC component_refl THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[DIFF]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC THENL[ REWRITE_TAC[EMPTY_EXISTS];ALL_TAC]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; (* -B *) TYPE_THEN `A INTER C = EMPTY` SUBAGOAL_TAC; THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions; REWRH 7860; UNDH 4798 THEN REWRITE_TAC[INTER;SUBSET;DIFF;EQ_EMPTY] THEN MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `A SUBSET euclid 2` SUBAGOAL_TAC; THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions; REWRH 7860; UNDH 4798 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `top_of_metric(euclid 2 DIFF C,d_euclid) = induced_top top2 (euclid 2 DIFF C)` SUBAGOAL_TAC; REWRITE_TAC[top2]; IMATCH_MP_TAC (GSYM top_of_metric_induced); REWRITE_TAC[metric_euclid]; REWRITE_TAC[DIFF;SUBSET] THEN MESON_TAC[]; (* - *) THM_INTRO_TAC[`2`;`euclid 2 DIFF C`] loc_path_euclid_cor; REWRITE_TAC[GSYM top2]; ASM_REWRITE_TAC[]; (* - *) THM_INTRO_TAC[`top2`] loc_path_conn; REWRH 6586; SUBCONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; USEH 7626 GSYM; USEH 4421 GSYM; ASM_REWRITE_TAC[]; USEH 1238 GSYM; ASM_REWRITE_TAC[]; FIRST_ASSUM IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; REWRITE_TAC[DIFF]; ASM_REWRITE_TAC[]; (* -C *) IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); SUBCONJ_TAC; TYPE_THEN `A` UNABBREV_TAC; IMATCH_MP_TAC component_simple_arc_ver2; ASM_REWRITE_TAC[]; (* - *) TYPE_THEN `A = UNIONS ({v} INSERT {P | (?w. simple_arc_end P v w) /\ (P INTER C = {}) })` SUBAGOAL_TAC; IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[SUBSET;UNIONS]; TYPE_THEN `x = v` ASM_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; TYPE_THEN `{v}` EXISTS_TAC; REWRITE_TAC[INR IN_INSERT]; TSPECH `x` 9360; REWRH 8744; TYPE_THEN`P` EXISTS_TAC; REWRITE_TAC[INR IN_INSERT]; ASM_REWRITE_TAC[]; CONJ_TAC; DISJ2_TAC; ASM_MESON_TAC[simple_arc_end_simple]; IMATCH_MP_TAC simple_arc_end_end2; ASM_MESON_TAC[]; (* -- *) REWRITE_TAC[UNIONS;INR IN_INSERT;SUBSET]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; FULL_REWRITE_TAC[INR IN_INSERT]; TYPE_THEN `x` UNABBREV_TAC; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `x = v` ASM_CASES_TAC; ASM_MESON_TAC[]; TSPECH `x` 9360; ASM_REWRITE_TAC[]; (* -- *) TYPE_THEN `x = w` ASM_CASES_TAC; TYPE_THEN `x` UNABBREV_TAC; ASM_MESON_TAC[]; TYPE_THEN `cut_arc u v x` EXISTS_TAC; (* -- *) SUBCONJ_TAC; IMATCH_MP_TAC cut_arc_simple; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end]; (* -- *) THM_INTRO_TAC[`u`;`v`;`x`] cut_arc_subset; ASM_REWRITE_TAC[]; ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end]; ASM_REWRITE_TAC[]; UNDH 4401 THEN UNDH 2627 THEN REWRITE_TAC[SUBSET;INTER;EQ_EMPTY] THEN MESON_TAC[]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC connected_unions_common; (* -D *) CONJ_TAC; FULL_REWRITE_TAC[INR IN_INSERT]; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `Z` UNABBREV_TAC; IMATCH_MP_TAC connected_sing; ASM_REWRITE_TAC[top2_unions]; IMATCH_MP_TAC simple_arc_connected; ASM_MESON_TAC[simple_arc_end_simple]; (* - *) UNDH 281 THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; TYPE_THEN `v` EXISTS_TAC; FULL_REWRITE_TAC[INR IN_INSERT]; TYPE_THEN `!Z. (Z = {v}) \/ (?w. simple_arc_end Z v w) /\ (Z INTER C = EMPTY) ==> Z v` SUBAGOAL_TAC; FIRST_ASSUM DISJ_CASES_TAC; TYPE_THEN `Z''` UNABBREV_TAC; REWRITE_TAC[INR IN_SING]; IMATCH_MP_TAC simple_arc_end_end; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* Tue Jan 18 19:38:27 EST 2005 *) ]);; (* }}} *) let JORDAN_CURVE_THEOREM = prove_by_refinement( `!C. simple_closed_curve top2 C ==> (?A B. top2 A /\ top2 B /\ connected top2 A /\ connected top2 B /\ ~(A = EMPTY) /\ ~(B = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (A UNION B UNION C = euclid 2))`, (* {{{ proof *) [ REP_BASIC_TAC; THM_INTRO_TAC[`C`] jordan_curve_not_one_sided; ASM_REWRITE_TAC[]; FULL_REWRITE_TAC[one_sided_jordan_curve]; ASM_REWRITE_TAC[]; (* - *) LEFTH 1701 "v"; LEFTH 7038 "w"; TYPE_THEN `euclid 2 v /\ euclid 2 w /\ ~C v /\ ~C w /\ ~(v = w) /\ (!C'. simple_arc_end C' v w ==> ~(C' INTER C = EMPTY))` SUBAGOAL_TAC; ASM_MESON_TAC[]; KILLH 9332; (* - *) TYPE_THEN `A = component (induced_top top2 (euclid 2 DIFF C)) v` ABBREV_TAC ; TYPE_THEN `A` EXISTS_TAC; TYPE_THEN `B = component (induced_top top2 (euclid 2 DIFF C)) w` ABBREV_TAC ; TYPE_THEN `B` EXISTS_TAC; (* - *) ASSUME_TAC top2_top; (* -A *) THM_INTRO_TAC[`C`] simple_closed_curve_closed; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`A`;`v`] component_properties; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`C`;`B`;`w`] component_properties; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* - *) SUBCONJ_TAC; PROOF_BY_CONTR_TAC; USEH 2797 (REWRITE_RULE[INTER;EMPTY_EXISTS]); TYPE_THEN `u = v` ASM_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; TSPECH `v` 8396; REWRH 1610; TSPECH `P` 3407; UNDH 3395 THEN DISCH_THEN (THM_INTRO_TAC[]); IMATCH_MP_TAC simple_arc_end_symm; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* -- *) TYPE_THEN `u = w` ASM_CASES_TAC; TYPE_THEN `u` UNABBREV_TAC; TSPECH `w` 9360; REWRH 3625; ASM_MESON_TAC[simple_arc_end_symm]; (* -- *) TYPE_THEN `A` UNABBREV_TAC; TYPE_THEN `B` UNABBREV_TAC; USEH 9617 (MATCH_MP component_replace); USEH 8370 (MATCH_MP component_replace); TSPECH `v` 2427; TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) w` UNABBREV_TAC; TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) u` UNABBREV_TAC; TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) v v` SUBAGOAL_TAC; IMATCH_MP_TAC component_refl; ASM_REWRITE_TAC[]; THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support; FULL_REWRITE_TAC[top2_unions]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC [INTER;DIFF]; REWRH 4538; USEH 1851 (MATCH_MP simple_arc_end_symm); ASM_MESON_TAC[]; (* -B *) IMATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[union_subset]; ASM_REWRITE_TAC[]; IMATCH_MP_TAC simple_closed_curve_euclid; ASM_REWRITE_TAC[]; (* - *) PROOF_BY_CONTR_TAC; USEH 2025 (REWRITE_RULE[SUBSET;UNION]); LEFTH 2615 "x"; TYPE_THEN `euclid 2 x /\ ~A x /\ ~ B x /\ ~ C x` SUBAGOAL_TAC; ASM_MESON_TAC[]; (* - *) THM_INTRO_TAC[`v`;`w`;`x`] three_t_enum; TYPE_THEN `INJ f UNIV (euclid 2) /\ (!i. ~C (f i)) /\ (!i j A. simple_arc_end A (f i) (f j) ==> ~(A INTER C = {}))` ASM_CASES_TAC ; ASM_MESON_TAC[jordan_curve_no_inj3]; UNDH 6935 THEN ASM_REWRITE_TAC[]; (* -C *) TYPE_THEN `~(x = w) /\ ~(x = v) /\ ~(v = w)` SUBAGOAL_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; SUBCONJ_TAC; REWRITE_TAC[INJ]; CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ THEN ASM_MESON_TAC[]; IMATCH_MP_TAC three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; (* - *) TYPE_THEN `!C'. simple_arc_end C' v x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `!C'. simple_arc_end C' w x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC; ASM_MESON_TAC[]; TYPE_THEN `!x A. ~simple_arc_end A x x` SUBAGOAL_TAC; USEH 3186 (MATCH_MP simple_arc_end_distinct); ASM_MESON_TAC[]; KILLH 8396 THEN KILLH 9360 THEN KILLH 3221 THEN KILLH 4325; IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); (* - *) TYPE_THEN `!C' w v. simple_arc_end C' w v = simple_arc_end C' v w` SUBAGOAL_TAC; MESON_TAC[simple_arc_end_symm]; CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] ; ALL_TAC]; TYPE_THEN `!i. ~(C (f i))` SUBAGOAL_TAC THENL [IMATCH_MP_TAC three_t_univ THEN ASM_REWRITE_TAC[];ALL_TAC]; ASM_MESON_TAC[]; (* Tue Jan 18 20:44:12 EST 2005 *) ]);; (* }}} *) (* collect together the definitions in a single theorem. We leave out the definitions in the HOL-light distribution such as abs , sqrt, sum, IMAGE, INJ, INTER, EMPTY, UNION, SUBSET, UNIONS. *) let JORDAN_CURVE_DEFS = prove_by_refinement( `(!x. euclid 2 x = (!n. 2 <=| n ==> (x n = &0))) /\ (top2 = top_of_metric (euclid 2,d_euclid)) /\ (!(X:A->bool) d. top_of_metric (X,d) = {A | ?F. F SUBSET open_balls (X,d) /\ (A = UNIONS F) }) /\ (!(X:A->bool) d. open_balls(X,d) = {B | ?x r. (B = open_ball (X,d) x r) }) /\ (!X d (x:A) r. open_ball (X,d) x r = {y | X x /\ X y /\ d x y < r}) /\ (!U (Z:A->bool). connected U Z <=> Z SUBSET UNIONS U /\ (!A B. U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B ==> Z SUBSET A \/ Z SUBSET B)) /\ (!(C:A->bool) U. simple_closed_curve U C = (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\ continuous f (top_of_metric (UNIV,d_real)) U /\ INJ f {x | &0 <= x /\ x < &1} (UNIONS U) /\ (f (&0) = f (&1)))) /\ (!(f:A->B) U V. continuous f U V = (!v. V v ==> U { x | (UNIONS U) x /\ v (f x) })) /\ (!x y. d_real x y = abs (x - y)) /\ (!x y. euclid 2 x /\ euclid 2 y ==> (d_euclid x y = sqrt (sum (0,2) (\i. (x i - y i) * (x i - y i)))))`, (* {{{ proof *) [ REWRITE_TAC[simple_closed_curve;continuous;preimage;d_real;]; REWRITE_TAC[d_euclid_n]; REWRITE_TAC[euclid;top2;top_of_metric;open_balls;open_ball;connected;]; (* Tue Jan 18 21:10:10 EST 2005 *) ]);; (* }}} *) (* The interesting thing about these definitions is how the standard mathematical definitions are made total, as required by HOL. "continuous": There is no requirement that the IMAGE of f is a subset of UNIONS V. This is contrary to the common mathematical requirement that a function f:X->Y maps X to Y. The constraint on the IMAGE for a simple_closed_curve is contained in the definition of INJ. "simple_closed_curve": Continuity is required on the full real line, but injectivity is required only on the unit interval. "connected": Here there is a requirement that Z is a subset of UNIONS U "open_ball": If x is not in X, then the open ball is empty. *) hol-light/Jordan/lib_ext.ml000066400000000000000000000057671303454263000161610ustar00rootroot00000000000000 let rec drop i list = match (i,list) with (_,[]) -> failwith "drop null" | (0,a::b) -> b | (i,a::b) -> a::(drop (i-1) b);; let rec take i j = function [] -> [] | a::b -> match (i,j) with (0,0) -> [] | (0,j) -> a::(take 0 (j-1) b) | _ -> take (i-1) (j-1) b;; let cannot f x = try (f x; false) with Failure _ -> true;; (* ------------------------------------------------------------------ *) (* UNIT TESTS *) (* ------------------------------------------------------------------ *) let new_test_suite() = let t = ref ([]:(string*bool) list) in let add_test (s,f) = (t:= ((s,f)::!t)) in let eval (s,f) = if f then () else failwith ("test suite: "^s) in let test() = (ignore (List.map eval (!t));()) in add_test,test;; let add_test,test = new_test_suite();; (* ------------------------------------------------------------------ *) (* LOCAL DEFINITIONS *) (* ------------------------------------------------------------------ *) let local_defs = ref ([]:(string * (string * term)) list);; let add_interface (sym,tm) = if (can (assoc sym) (!the_overload_skeletons)) then (overload_interface (sym,tm)) else (override_interface(sym,tm));; let local_definition package_name tm = let list_mk_forall(vars,bod) = itlist (curry mk_forall) vars bod in let avs,bod = strip_forall tm in let l,r = try dest_eq bod with Failure _ -> failwith "new_local_definition: Not an equation" in let lv,largs = strip_comb l in let cname,ty = dest_var lv in let cname' = package_name^"'"^cname in let lv' = mk_var(cname',ty) in let l' = list_mk_comb(lv',largs) in let bod' = mk_eq(l',r) in let tm'= list_mk_forall(avs,bod') in let thm = new_definition tm' in let _ = (local_defs := (package_name,(cname,lv'))::(!local_defs)) in let _ = add_interface(cname,lv') in thm;; let reduce_local_interface(package_name) = map (reduce_interface o snd) (filter (fun x -> ((fst x) = package_name)) !local_defs);; let mk_local_interface(package_name) = map (add_interface o snd) (filter (fun x -> ((fst x) = package_name)) !local_defs);; (* ------------------------------------------------------------------ *) (* SAVING STATE *) (* ------------------------------------------------------------------ *) (****** Removed for now by JRH let (save_state,get_state) = let state_array = ref [] in let save_state (key:string) = state_array := (key,(!EVERY_STEP_TAC,!local_defs,!the_interface, !the_term_constants,!the_type_constants, !the_overload_skeletons, !the_axioms,!the_definitions))::!state_array in let get_state key = let (et,ld,i,tc,tyc,os,ax,def) = assoc key !state_array in ( EVERY_STEP_TAC := et; local_defs := ld; the_interface := i; the_term_constants:= tc; the_type_constants:= tyc; the_overload_skeletons:= os; the_axioms:= ax; the_definitions:= def) in (save_state,get_state);; save_state "lib_ext";; *****) hol-light/Jordan/make.ml000066400000000000000000000023121303454263000154270ustar00rootroot00000000000000(* ========================================================================= *) (* The Jordan Curve Theorem *) (* *) (* Proof by Tom Hales *) (* *) (* A few tweaks by John Harrison for the latest HOL Light *) (* ========================================================================= *) (*** Standard HOL Light library ***) loads "Library/analysis.ml";; loads "Library/transc.ml";; loads "Examples/polylog.ml";; (*** New stuff ***) loadt "Jordan/tactics_refine.ml";; loadt "Jordan/lib_ext.ml";; loadt "Jordan/tactics_fix.ml";; loadt "Jordan/parse_ext_override_interface.ml";; loadt "Jordan/tactics_ext.ml";; loadt "Jordan/num_ext_gcd.ml";; loadt "Jordan/num_ext_nabs.ml";; loadt "Jordan/real_ext_geom_series.ml";; loadt "Rqe/num_calc_simp.ml";; loadt "Jordan/real_ext.ml";; loadt "Jordan/float.ml";; loadt "Jordan/tactics_ext2.ml";; loadt "Jordan/misc_defs_and_lemmas.ml";; loadt "Jordan/metric_spaces.ml";; loadt "Jordan/jordan_curve_theorem.ml";; hol-light/Jordan/metric_spaces.ml000066400000000000000000007434671303454263000173620ustar00rootroot00000000000000 (* ------------------------------------------------------------------ *) (* Topological Spaces, Metric Spaces, Connectedness, Totally bounded spaces, compactness, Hausdorff property, completeness, properties of Euclidean space, Author: Thomas Hales 2004 *) (* ------------------------------------------------------------------ *) (* prioritize_real (or num) *) (* ------------------------------------------------------------------ *) (* Logical Preliminaries *) (* ------------------------------------------------------------------ *) let Q_ELIM_THM = prove_by_refinement( `!P Q R . (?(u:B). (?(x:A). (u = P x) /\ (Q x)) /\ (R u)) <=> (?x. (Q x) /\ R( P x))`, (* {{{ proof *) [ DISCH_ALL_TAC; MESON_TAC[]; ]);; (* }}} *) let Q_ELIM_THM' = prove_by_refinement( `!P Q R. (!(t:B). (?(x:A). P x /\ (t = Q x)) ==> R t) <=> (!x. P x ==> R (Q x))`, (* {{{ proof *) [ DISCH_ALL_TAC; MESON_TAC[]; ]);; (* }}} *) let Q_ELIM_THM'' = prove_by_refinement( `!P Q R. (!(t:B). (?(x:A). (t = Q x) /\ P x ) ==> R t) <=> (!x. P x ==> R (Q x))`, (* {{{ proof *) [ DISCH_ALL_TAC; MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Set Preliminaries *) (* ------------------------------------------------------------------ *) let DIFF_SUBSET = prove_by_refinement( `!X A (B:A->bool). A SUBSET (X DIFF B) <=> (A SUBSET X) /\ (A INTER B = EMPTY)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[SUBSET;DIFF;INTER;IN]; EQ_TAC; REWRITE_TAC[IN_ELIM_THM']; DISCH_TAC; CONJ_TAC; ASM_MESON_TAC[]; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM';EMPTY]; ASM_MESON_TAC[]; DISCH_ALL_TAC; GEN_TAC; DISCH_ALL_TAC; REWRITE_TAC[IN_ELIM_THM']; CONJ_TAC; ASM_MESON_TAC[]; USE 1 (fun t-> AP_THM t `x:A`); USE 1 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); ASM_MESON_TAC[]; ]);; (* }}} *) let SUBSET_INTERS = prove_by_refinement( `!X (A:A->bool). A SUBSET (INTERS X) <=> (!x. X x ==> (A SUBSET x))`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[SUBSET;INTERS]; REWRITE_TAC [IN_ELIM_THM']; MESON_TAC[IN]; ]);; (* }}} *) let EQ_EMPTY = prove_by_refinement( `!P. ({(x:A) | P x} = {}) <=> (!x. ~P x)`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_TAC; (USE 0 (fun t-> AP_THM t `x:A`)); USE 0 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); USE 0 (GEN_ALL); ASM_REWRITE_TAC[]; DISCH_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM';EMPTY]; ASM_MESON_TAC[]; ]);; (* }}} *) let DIFF_INTER = prove_by_refinement( `!A B (C:A->bool). ((A DIFF B) INTER C = EMPTY) <=> ((A INTER C) SUBSET B)`, (* {{{ proof *) [ REWRITE_TAC[DIFF;INTER;SUBSET;IN_ELIM_THM']; REWRITE_TAC[IN;EQ_EMPTY]; MESON_TAC[]; ]);; (* }}} *) let SUB_IMP_INTER = prove_by_refinement( `!A B (C:A->bool). ((A SUBSET B) ==> (A INTER C) SUBSET B) /\ ((A SUBSET B) ==> (C INTER A) SUBSET B)`, (* {{{ proof *) [ DISCH_ALL_TAC; SUBCONJ_TAC; REWRITE_TAC[INTER;SUBSET;IN;IN_ELIM_THM']; MESON_TAC[]; MESON_TAC[INTER_COMM]; ]);; (* }}} *) let SUBSET_UNIONS_INSERT = prove_by_refinement( `!(A:A->bool) B C. A SUBSET (UNIONS (B INSERT C)) <=> (A DIFF B) SUBSET (UNIONS C)`, (* {{{ proof *) [ DISCH_ALL_TAC; SET_TAC[UNIONS;SUBSET;INSERT]; ]);; (* }}} *) let UNIONS_DELETE2 = prove_by_refinement( `!(A:A->bool) B C. (A SUBSET (UNIONS B)) /\ (A INTER C = EMPTY) ==> (A SUBSET (UNIONS (B DELETE (C))))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM SET_TAC[SUBSET;UNIONS;INTER;EMPTY;DELETE]; ]);; (* }}} *) (* this generalizes to arbitrary cardinalities *) let finite_subset = prove_by_refinement( `!A (f:A->B) B. (B SUBSET (IMAGE f A)) /\ (FINITE B) ==> (?C. (C SUBSET A) /\ (FINITE C) /\ (B = IMAGE f C))`, (* {{{ proof *) [ DISCH_ALL_TAC; USE 0 (REWRITE_RULE[SUBSET;IN_IMAGE]); USE 0 (CONV_RULE NAME_CONFLICT_CONV); USE 0 (CONV_RULE (quant_left_CONV "x'")); USE 0 (CONV_RULE (quant_left_CONV "x'")); CHO 0; TYPE_THEN `IMAGE x' B` EXISTS_TAC ; SUBCONJ_TAC; REWRITE_TAC[SUBSET;IN_IMAGE]; NAME_CONFLICT_TAC; GEN_TAC; ASM_MESON_TAC[]; DISCH_ALL_TAC; CONJ_TAC; ASM_MESON_TAC[ FINITE_IMAGE]; MATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[SUBSET;IN_IMAGE]; GEN_TAC; TYPE_THEN `x` (USE 0 o SPEC); ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;IN_IMAGE]; NAME_CONFLICT_TAC; GEN_TAC; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; AND 3; CHO 3; ASM_MESON_TAC[]; ]);; (* }}} *) let inters_singleton = prove_by_refinement( `!(A:A->bool). INTERS {A} = A`, (* {{{ proof *) [ REWRITE_TAC[INSERT;INTERS]; REWRITE_TAC[IN_ELIM_THM';NOT_IN_EMPTY]; GEN_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[IN]; ]);; (* }}} *) let delete_empty = prove_by_refinement( `!(A:A->bool) x. (A DELETE x = EMPTY) <=> (~(A = EMPTY) ==> (A = {x}))`, (* {{{ proof *) [ REWRITE_TAC[DELETE]; DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; USE 1 (fun t-> AP_THM t `u:A`); USE 1 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); REWRITE_TAC[EMPTY;INSERT;IN]; USE 0 (REWRITE_RULE[EMPTY_EXISTS]); USE 1 (GEN `u:A`); MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[IN]; DISCH_ALL_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM';EMPTY]; USE 0 (REWRITE_RULE[EMPTY_EXISTS]); USE 0 (REWRITE_RULE[EMPTY;INSERT;IN]); REWRITE_TAC[IN]; USE 0 (CONV_RULE (quant_left_CONV "u")); USE 0 (SPEC `x':A`); MATCH_MP_TAC (TAUT `(a ==> b) ==> ~(a /\ ~b)`); DISCH_ALL_TAC; REWR 0; UND 1; ASM_REWRITE_TAC[]; REWRITE_TAC[IN_ELIM_THM']; ]);; (* }}} *) let inters_subset = prove_by_refinement( `!A (B:(A->bool)->bool). A SUBSET B ==> INTERS B SUBSET INTERS A`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[INTERS;SUBSET;IN_ELIM_THM']; ASM_MESON_TAC[SUBSET;IN]; ]);; (* }}} *) let delete_inters = prove_by_refinement( `!V (u:A->bool). V u ==> (INTERS V = (INTERS (V DELETE u)) INTER u)`, (* {{{ proof *) [ DISCH_ALL_TAC; MATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[SUBSET_INTER]; CONJ_TAC; MATCH_MP_TAC inters_subset; REWRITE_TAC [DELETE_SUBSET]; USE 0 (ONCE_REWRITE_RULE[GSYM IN]); USE 0 (MATCH_MP INTERS_SUBSET); ASM_REWRITE_TAC[]; TYPE_THEN `INTERS (V DELETE u) INTER u SUBSET u` SUBGOAL_TAC; REWRITE_TAC[INTER_SUBSET]; REWRITE_TAC[SUBSET_INTERS]; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `x = u` ASM_CASES_TAC; ASM_MESON_TAC[]; TYPE_THEN `INTERS (V DELETE u) INTER u SUBSET INTERS (V DELETE u) ` SUBGOAL_TAC; REWRITE_TAC[INTER_SUBSET]; TYPE_THEN `INTERS (V DELETE u) SUBSET x` SUBGOAL_TAC; MATCH_MP_TAC INTERS_SUBSET; ASM_REWRITE_TAC [IN;DELETE;IN_ELIM_THM']; ASM_MESON_TAC[SUBSET_TRANS]; ]);; (* }}} *) let EQ_EMPTY = prove_by_refinement( `!(A:A->bool) . (A = EMPTY) <=> (!x. ~(A x))`, (* {{{ proof *) [ ASM_MESON_TAC[EMPTY_EXISTS;IN]; ]);; (* }}} *) let UNIONS_EQ_EMPTY = prove_by_refinement( `!(U:(A->bool)->bool). (UNIONS U = {}) <=> ((U = EMPTY) \/ (U = {EMPTY}))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[EQ_EMPTY;UNIONS;IN_ELIM_THM';INSERT;EMPTY]; REWRITE_TAC [IN]; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `!x. ~U x` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; NAME_CONFLICT_TAC; USE 1 (CONV_RULE (quant_left_CONV "x")); CHO 1; USE 0 (CONV_RULE (quant_left_CONV "u")); USE 0 (CONV_RULE (quant_left_CONV "u")); EQ_TAC; DISCH_TAC; TYPE_THEN `x` (USE 0 o SPEC); ASM_MESON_TAC[]; DISCH_TAC; COPY 0; TYPE_THEN `x` (USE 0 o SPEC); TYPE_THEN `x'` (USE 3 o SPEC); PROOF_BY_CONTR_TAC; TYPE_THEN `x' = {}` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 5 (REWRITE_RULE[EMPTY_EXISTS]); CHO 5; USE 5 (REWRITE_RULE[IN]); ASM_MESON_TAC[]; USE 2 (CONV_RULE (quant_right_CONV "x'")); ASM_MESON_TAC[IN;EMPTY_EXISTS]; DISCH_THEN DISJ_CASES_TAC; ASM_MESON_TAC[]; ASM_REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[]; ]);; (* }}} *) let INTERS_EQ_EMPTY = prove_by_refinement( `!((A:(A->bool)->bool)). ((INTERS A) = EMPTY) <=> (!x . ?a. (A a) /\ ~(a x))`, (* {{{ proof *) [ REWRITE_TAC[INTERS;EQ_EMPTY;IN_ELIM_THM']; REWRITE_TAC[IN]; MESON_TAC[]; ]);; (* }}} *) let CARD_SING_CONV = prove_by_refinement( `!X:A->bool. (X HAS_SIZE 1) ==> (SING X)`, (* {{{ proof *) [ REWRITE_TAC[HAS_SIZE ;SING ]; DISCH_ALL_TAC; TYPE_THEN `CHOICE X` EXISTS_TAC; TYPE_THEN `~(X = {})` SUBGOAL_TAC; ASM_MESON_TAC[CARD_CLAUSES;ARITH_RULE`~(0=1)`]; DISCH_ALL_TAC; TYPE_THEN `SUC (CARD (X DELETE (CHOICE X)))=1` SUBGOAL_TAC ; ASM_SIMP_TAC[CARD_DELETE_CHOICE]; REWRITE_TAC[ARITH_RULE`(SUC a = 1) <=> (a=0)`]; ASSUME_TAC HAS_SIZE_0; USE 3 (REWRITE_RULE [HAS_SIZE ]); ASSUME_TAC FINITE_DELETE_IMP; ASM_MESON_TAC[delete_empty]; ]);; (* }}} *) let countable_prod = prove_by_refinement( `!(A:A->bool) (B:B->bool). (COUNTABLE A) /\ (COUNTABLE B) ==> (COUNTABLE {(a,b) | (A a) /\ (B b) })`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC (INST_TYPE [`:num#num`,`:A`] COUNTABLE_IMAGE); USE 0 (REWRITE_RULE [COUNTABLE;GE_C;IN_UNIV]); USE 1 (REWRITE_RULE [COUNTABLE;GE_C;IN_UNIV]); CHO 0; CHO 1; TYPE_THEN `{(m:num,n:num) | T}` EXISTS_TAC; REWRITE_TAC[NUM2_COUNTABLE;SUBSET;IN_IMAGE]; REWRITE_TAC[IN_ELIM_THM]; TYPE_THEN `(\ (u,v) . (f u,f' v))` EXISTS_TAC; DISCH_ALL_TAC; CHO 2; CHO 2; AND 2; TYPE_THEN `a` (USE 0 o SPEC); TYPE_THEN `b` (USE 1 o SPEC); IN_OUT_TAC; REWR 2; REWR 3; CHO 3; CHO 2; TYPE_THEN `(x',x'')` EXISTS_TAC; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); ASM_MESON_TAC[]; ]);; (* }}} *) let IMAGE_I = prove_by_refinement( `!(A:A->bool). IMAGE I A = A`, (* {{{ proof *) [ REWRITE_TAC[IMAGE;IN;I_DEF]; GEN_TAC; MATCH_MP_TAC EQ_EXT THEN GEN_TAC ; REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[]; ]);; (* }}} *) let EMPTY_NOT_EXISTS = prove_by_refinement( `!X. (X = {}) <=> (~(?(u:A). X u))`, (* {{{ proof *) [ MESON_TAC [IN;EMPTY_EXISTS]; ]);; (* }}} *) let DIFF_SURJ = prove_by_refinement( `!(f : A->B) X Y. (BIJ f X Y) ==> (! t. (t SUBSET X) ==> ((IMAGE f (X DIFF t)) = (Y DIFF (IMAGE f t))))`, (* {{{ proof *) [ REWRITE_TAC[BIJ;INJ;SURJ;IN ]; DISCH_ALL_TAC; DISCH_ALL_TAC; REWRITE_TAC[IMAGE;IN]; IMATCH_MP_TAC EQ_EXT ; REWRITE_TAC[IN_ELIM_THM']; NAME_CONFLICT_TAC; X_GEN_TAC `y:B`; REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF]; REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[SUBSET;IN ]; ]);; (* }}} *) let union_subset = prove_by_refinement( `!Z1 Z2 A. ((Z1 UNION Z2) SUBSET (A:A->bool)) <=> (Z1 SUBSET A) /\ (Z2 SUBSET A)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[UNION;SUBSET;IN;IN_ELIM_THM']; ASM_MESON_TAC[]; ]);; (* }}} *) let preimage_disjoint = prove_by_refinement( `!(f:A->B) A B X. (A INTER B = EMPTY) ==> (preimage X f A INTER (preimage X f B) = EMPTY )`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[preimage]; REWRITE_TAC[EQ_EMPTY]; DISCH_ALL_TAC; USE 1( REWRITE_RULE[INTER;IN;IN_ELIM_THM']); USE 0 (REWRITE_RULE[EQ_EMPTY;INTER;IN;IN_ELIM_THM']); ASM_MESON_TAC[]; ]);; (* }}} *) let preimage_union = prove_by_refinement( `!(f:A->B) A B X Z. (Z SUBSET ((preimage X f A) UNION (preimage X f B))) <=> (Z SUBSET X) /\ (IMAGE f Z SUBSET (A UNION B))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[preimage;IMAGE;UNION;SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let subset_preimage = prove_by_refinement( `!(f:A->B) A X Z. (Z SUBSET (preimage X f A)) <=> (Z SUBSET X) /\ (IMAGE f Z SUBSET A)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;preimage;IMAGE;IN;IN_ELIM_THM']; MESON_TAC[]; ]);; (* }}} *) let preimage_unions = prove_by_refinement( `!dom (f:A->B) C. preimage dom f (UNIONS C) = (UNIONS (IMAGE (preimage dom f) C))`, (* {{{ proof *) [ REWRITE_TAC[preimage;IN_UNIONS ]; REWRITE_TAC[UNIONS;IN_IMAGE ]; REWRITE_TAC[preimage;IN]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT ; DISCH_ALL_TAC; REWRITE_TAC[IN_ELIM_THM']; REWRITE_TAC[Q_ELIM_THM;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let preimage_subset = prove_by_refinement( `!(f:A->B) X A B. (A SUBSET B) ==> (preimage X f A SUBSET (preimage X f B))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;in_preimage]; REWRITE_TAC[IN]; MESON_TAC[]; ]);; (* }}} *) (* to fix two varying descriptions of ((INTER) Y): *) let INTER_THM = prove_by_refinement( `!(X:A->bool). ((\B. B INTER X) = ((INTER) X)) /\ ((\B. X INTER B) = ((INTER) X))`, (* {{{ proof *) [ REWRITE_TAC[INTER_COMM]; GEN_TAC; MATCH_MP_TAC EQ_EXT THEN BETA_TAC; REWRITE_TAC[INTER_COMM]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Real Preliminaries *) (* ------------------------------------------------------------------ *) let REAL_SUM_SQUARE_POS = prove_by_refinement( `!m n x . &.0 <=. sum(m,n) (\i. (x i)*.(x i))`, (* {{{ proof *) [ DISCH_ALL_TAC; MATCH_MP_TAC SUM_POS_GEN; DISCH_ALL_TAC; BETA_TAC; REWRITE_TAC[REAL_LE_SQUARE]; ]);; (* }}} *) (* twopow , DUPLICATE OF TWOPOW_MK_POS *) let twopow_pos = prove_by_refinement( `!n. (&.0 <. twopow(n))`, (* {{{ proof *) [ GEN_TAC; DISJ_CASES_TAC (SPEC `n:int` INT_IMAGE); CHO 0; ASM_REWRITE_TAC[TWOPOW_POS]; REDUCE_TAC; ARITH_TAC; CHO 0; ASM_REWRITE_TAC[TWOPOW_NEG]; REDUCE_TAC; ARITH_TAC; ]);; (* }}} *) let twopow_double = prove_by_refinement( `!n. &.2 * (twopow (--: (&: (n+1)))) = twopow (--: (&:n))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[TWOPOW_NEG;REAL_POW_ADD;POW_1;REAL_INV_MUL ]; REWRITE_TAC [REAL_ARITH `a*b*cc = (a*cc)*b`]; REWRITE_TAC [REAL_RINV_2 ]; REAL_ARITH_TAC ; ]);; (* }}} *) let min_finite = prove_by_refinement( `!X. (FINITE X) /\ (~(X = EMPTY )) ==> (?delta. (X delta) /\ (!x. (X x) ==> (delta <=. x)))`, (* {{{ proof *) [ TYPE_THEN `(!X k. FINITE X /\ (~(X = EMPTY )) /\ (X HAS_SIZE k) ==> (?delta. X delta /\ (!x. X x ==> delta <= x))) ==>(!X. FINITE X /\ (~(X = EMPTY )) ==> (?delta. X delta /\ (!x. X x ==> delta <= x)))` SUBGOAL_TAC ; DISCH_TAC; DISCH_ALL_TAC; TYPE_THEN `X` (USE 0 o SPEC); TYPE_THEN `CARD X` (USE 0 o SPEC); UND 0; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[HAS_SIZE ]; DISCH_THEN IMATCH_MP_TAC ; CONV_TAC (quant_left_CONV "k"); INDUCT_TAC; REWRITE_TAC[HAS_SIZE_0]; DISCH_ALL_TAC; ASM_REWRITE_TAC[EMPTY]; ASM_MESON_TAC[]; DISCH_ALL_TAC; USE 3(REWRITE_RULE[HAS_SIZE]); TYPE_THEN `X DELETE (CHOICE X)` (USE 0 o SPEC); ASM_CASES_TAC `k=0`; REWR 3; USE 3 (REWRITE_RULE [ARITH_RULE `SUC 0=1`]); TYPE_THEN `SING X` SUBGOAL_TAC ; IMATCH_MP_TAC CARD_SING_CONV; ASM_MESON_TAC [HAS_SIZE]; REWRITE_TAC[SING]; DISCH_TAC ; CHO 5; TYPE_THEN `x` EXISTS_TAC ; ASM_REWRITE_TAC[REWRITE_RULE[IN] IN_SING ]; REAL_ARITH_TAC; TYPE_THEN `FINITE (X DELETE CHOICE X) /\ ~(X DELETE CHOICE X = {}) /\ (X DELETE CHOICE X HAS_SIZE k ) ` SUBGOAL_TAC; REWRITE_TAC[FINITE_DELETE;HAS_SIZE ]; ASM_REWRITE_TAC[]; REWR 3; IMATCH_MP_TAC (TAUT `(a /\ b) ==> (b /\ a)`); SUBCONJ_TAC; IMATCH_MP_TAC (ARITH_RULE `(SUC x = SUC y) ==> (x = y)`); COPY 3; UND 3; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); IMATCH_MP_TAC CARD_DELETE_CHOICE; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (TAUT `(b ==> ~a ) ==> (a ==> ~b)`); DISCH_THEN (fun t-> ASM_REWRITE_TAC[t;CARD_CLAUSES]); DISCH_TAC; REWR 0; CHO 0; ALL_TAC; (* "ccx" *) TYPE_THEN `if (delta < (CHOICE X)) then delta else (CHOICE X)` EXISTS_TAC; (* REWRITE_TAC[min_real]; *) COND_CASES_TAC ; CONJ_TAC; UND 0; REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ]; MESON_TAC[]; GEN_TAC; UND 0; REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ]; DISCH_ALL_TAC; TYPE_THEN `x = CHOICE X` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; UND 6; REAL_ARITH_TAC; ASM_MESON_TAC[]; SUBCONJ_TAC; IMATCH_MP_TAC (REWRITE_RULE[IN ] CHOICE_DEF); ASM_REWRITE_TAC[]; DISCH_TAC; DISCH_ALL_TAC; TYPE_THEN `x = CHOICE X` ASM_CASES_TAC ; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; UND 0; REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ]; DISCH_ALL_TAC; TYPE_THEN `x` (USE 11 o SPEC); REWR 11; UND 11; UND 6; REAL_ARITH_TAC; ]);; (* }}} *) let min_finite_delta = prove_by_refinement( `!c X. (FINITE X) /\ ( !x. (X x) ==> (c <. x) ) ==> (?delta. (c <. delta) /\ (!x. (X x) ==> (delta <=. x)))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `~(X = EMPTY)` ASM_CASES_TAC; JOIN 0 2; USE 0 (MATCH_MP min_finite); CHO 0; TYPE_THEN `delta` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; REWR 2; ASM_REWRITE_TAC[EMPTY]; TYPE_THEN `c +. (&.1)` EXISTS_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let union_closed_interval = prove_by_refinement( `!a b c. (a <=. b) /\ (b <=. c) ==> ({x | a <= x /\ x < b} UNION {x | b <= x /\ x <= c} = { x | a <= x /\ x <= c})`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[UNION;IN;IN_ELIM_THM']; IMATCH_MP_TAC EQ_EXT ; REWRITE_TAC[IN_ELIM_THM']; UND 0; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let real_half_LT = prove_by_refinement( `!x y z. ((x < z/(&.2)) /\ (y < z/(&.2)) ==> (x + y < z))`, (* {{{ proof *) [ DISCH_ALL_TAC; (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; UND 0; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let real_half_LE = prove_by_refinement( `!x y z. ((x < z/(&.2)) /\ (y <= z/(&.2)) ==> (x + y < z))`, (* {{{ proof *) [ DISCH_ALL_TAC; (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; UND 0; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let real_half_EL = prove_by_refinement( `!x y z. ((x <= z/(&.2)) /\ (y < z/(&.2)) ==> (x + y < z))`, (* {{{ proof *) [ DISCH_ALL_TAC; (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; UND 0; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let real_half_LLE = prove_by_refinement( `!x y z. ((x <= z/(&.2)) /\ (y <= z/(&.2)) ==> (x + y <= z))`, (* {{{ proof *) [ DISCH_ALL_TAC; (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; UND 0; UND 1; REAL_ARITH_TAC; ]);; (* }}} *) let interval_finite = prove_by_refinement( `!N. FINITE {x | ?j. (abs x = &.j) /\ (j <=| N)}`, (* {{{ proof *) [ GEN_TAC; ABBREV_TAC `inter = {n | n <=| N}`; SUBGOAL_TAC `FINITE {y | ?x. (x IN inter /\ (y = (&. x)))}`; MATCH_MP_TAC FINITE_IMAGE_EXPAND; EXPAND_TAC "inter"; REWRITE_TAC[FINITE_NUMSEG_LE]; SUBGOAL_TAC `FINITE {y | ?x. (x IN inter /\ (y = --.(&. x)))}`; MATCH_MP_TAC FINITE_IMAGE_EXPAND; EXPAND_TAC "inter"; REWRITE_TAC[FINITE_NUMSEG_LE]; DISCH_ALL_TAC; JOIN 1 2; USE 1 (REWRITE_RULE[GSYM FINITE_UNION]); UND 1; SUBGOAL_TAC `!a b. ((a:real->bool) = b) ==> (FINITE a ==> FINITE b)`; REP_GEN_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); DISCH_THEN (fun t-> MATCH_MP_TAC t); MATCH_MP_TAC EQ_EXT; X_GEN_TAC `c:real`; REWRITE_TAC[IN_ELIM_THM';UNION]; EXPAND_TAC "inter"; REWRITE_TAC[IN_ELIM_THM']; REWRITE_TAC[real_abs]; EQ_TAC; MATCH_MP_TAC (TAUT `(a==>b) /\ (c==>b) ==> (a \/ c ==> b)`); CONJ_TAC; DISCH_THEN CHOOSE_TAC; AND 1; ASM_REWRITE_TAC[]; EXISTS_TAC `x:num`; ASM_REWRITE_TAC [REAL_LE;LE_0]; DISCH_THEN CHOOSE_TAC; AND 1; EXISTS_TAC `x:num`; ASM_REWRITE_TAC[REAL_NEG_NEG]; COND_CASES_TAC; UND 3; REDUCE_TAC; ARITH_TAC; REDUCE_TAC; DISCH_THEN CHOOSE_TAC; AND 1; UND 2; COND_CASES_TAC; ASM_MESON_TAC[]; DISCH_TAC; DISJ2_TAC; EXISTS_TAC `j:num`; ASM_REWRITE_TAC[]; UND 3; REAL_ARITH_TAC; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Euclidean Space *) (* ------------------------------------------------------------------ *) let euclid_add_closure = prove_by_refinement( `!f g n. (euclid n f) /\ (euclid n g) ==> (euclid n (f + g))`, (* {{{ *) [ REWRITE_TAC[euclid;euclid_plus]; ASM_MESON_TAC[REAL_ARITH `&0 +. (&.0) = (&.0)`]; ]);; (* }}} *) let euclid_scale_closure = prove_by_refinement( `!n t f. (euclid n f) ==> (euclid n ((t:real) *# f))`, (* {{{ *) [ REWRITE_TAC[euclid;euclid_scale]; MESON_TAC[REAL_ARITH `t *.(&.0) = (&.0)`]; ]);; (* }}} *) let euclid_neg_closure = prove_by_refinement( `!f n. (euclid n f) ==> (euclid n (-- f))`, (* {{{ *) [ REWRITE_TAC[euclid;euclid_neg]; DISCH_ALL_TAC; ASM_REWRITE_TAC[REAL_ARITH `(--x = &.0) <=> (x = &.0)`]; ]);; (* }}} *) let euclid_sub_closure = prove_by_refinement( `!f g n. (euclid n f ) /\ (euclid n g) ==> (euclid n (f - g))`, (* {{{ *) [ REWRITE_TAC[euclid;euclid_minus]; ASM_MESON_TAC[REAL_ARITH `&.0 -. (&.0) = (&.0)`]; ]);; (* }}} *) let neg_dim = prove_by_refinement( `!f n. (euclid n f) = (euclid n (--f))`, (* {{{ *) [ REPEAT GEN_TAC; EQ_TAC; REWRITE_TAC[euclid_neg_closure]; REWRITE_TAC[euclid;euclid_neg]; DISCH_ALL_TAC; ONCE_REWRITE_TAC[REAL_ARITH `(x = &.0) <=> (--x = &.0)`]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let euclid_updim = prove_by_refinement ( `!f m n. (m <=| n) /\ (euclid m f) ==> (euclid n f)`, (* {{{ *) [ REWRITE_TAC[euclid]; MESON_TAC[LE_TRANS]; ]);; (* }}} *) let euclidean_add_closure = prove_by_refinement( `!f g. (euclidean f) /\ (euclidean g) ==> (euclidean (f+g))`, (* {{{ *) [ REWRITE_TAC[euclidean]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `euclid` CHOOSE_TAC; UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; EXISTS_TAC `n+|n'`; ASSUME_TAC (ARITH_RULE `n <=| n+n'`); ASSUME_TAC (ARITH_RULE `n' <=| n+n'`); ASM_MESON_TAC[euclid_add_closure;euclid_updim]; ]);; (* }}} *) let euclidean_sub_closure = prove_by_refinement( `!f g. (euclidean f) /\ (euclidean g) ==> (euclidean (f-g))`, (* {{{ *) [ REWRITE_TAC[euclidean]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `euclid` CHOOSE_TAC; UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; EXISTS_TAC `n+|n'`; ASSUME_TAC (ARITH_RULE `n <=| n+n'`); ASSUME_TAC (ARITH_RULE `n' <=| n+n'`); ASM_MESON_TAC[euclid_sub_closure;euclid_updim]; ]);; (* }}} *) let euclidean_scale_closure = prove_by_refinement( `!s f. (euclidean f) ==> (euclidean (s *# f))`, (* {{{ *) [ REWRITE_TAC[euclidean]; REPEAT GEN_TAC; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `n:num`; ASM_MESON_TAC[euclid_scale_closure]; ]);; (* }}} *) let euclidean_neg_closure = prove_by_refinement( `!f. (euclidean f) ==> (euclidean (-- f))`, (* {{{ *) [ REWRITE_TAC[euclidean]; GEN_TAC; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `n:num`; ASM_MESON_TAC[euclid_neg_closure]; ]);; (* }}} *) let euclid_add_comm = prove_by_refinement( `!(f:num->real) g. (f + g = g + f)`, (* {{{ *) [ REWRITE_TAC[euclid_plus;REAL_ARITH `a+.b = b+.a`] ]);; (* }}} *) let euclid_add_assoc = prove_by_refinement( `!(f:num->real) g h. (f + g)+h = f + g + h`, (* {{{ *) [ REWRITE_TAC[euclid_plus;REAL_ARITH `(a+.b)+.c = a+b+c`]; ]);; (* }}} *) let euclid_lzero = prove_by_refinement( `!f. euclid0 + f = f`, (* {{{ *) [ REWRITE_TAC[euclid_plus;euclid0;REAL_ARITH `&.0+a=a`]; ACCEPT_TAC (INST_TYPE [(`:num`,`:A`);(`:real`,`:B`)] ETA_AX); ]);; (* }}} *) let euclid_rzero = prove_by_refinement( `!f. f + euclid0 = f`, (* {{{ *) [ REWRITE_TAC[euclid_plus;euclid0;REAL_ARITH `a+(&.0)=a`]; ACCEPT_TAC (INST_TYPE [(`:num`,`:A`);(`:real`,`:B`)] ETA_AX); ]);; (* }}} *) let euclid_ldistrib = prove_by_refinement( `!f g r. r *# (f + g) = (r *# f) + (r *# g)`, (* {{{ *) [ REWRITE_TAC[euclid_plus;euclid_scale;REAL_ARITH `a*(b+.c)=a*b+a*c`]; ]);; (* }}} *) let euclid_rdistrib = prove_by_refinement( `!f r s. (r+s)*# f = (r *# f) + (s *# f)`, (* {{{ *) [ REWRITE_TAC[euclid_plus;euclid_scale;REAL_ARITH `(a+b)*c= a*c+b*c`]; ]);; (* }}} *) let euclid_scale_act = prove_by_refinement( `!r s f. r *# (s *# f) = (r *s) *# f`, (* {{{ *) [ REWRITE_TAC[euclid_scale;REAL_ARITH `(a*b)*c = a*(b*c)`]; ]);; (* }}} *) let euclid_scale_one = prove_by_refinement( `!f. (&.1) *# f = f`, (* {{{ proof *) [ REWRITE_TAC[euclid_scale]; REDUCE_TAC; MESON_TAC[ETA_AX]; ]);; (* }}} *) let euclid_neg_sum = prove_by_refinement( `!x y . euclid_minus (--x) (--y) = -- (euclid_minus x y)`, (* {{{ proof *) [ REWRITE_TAC[euclid_neg;euclid_minus]; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; BETA_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let trivial_lin_combo = prove_by_refinement( `!x t. ((t *# x) + (&.1 - t) *# x = x)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[euclid_plus;euclid_scale;]; IMATCH_MP_TAC EQ_EXT THEN BETA_TAC; REAL_ARITH_TAC ; ]);; (* }}} *) (* DOT PRODUCT *) let dot_euclid = prove_by_refinement( `!p f g. (euclid p f) /\ (euclid p g) ==> (dot f g = sum (0,p) (\i. (f i)* (g i)))`, (* {{{ *) [ REWRITE_TAC[dot]; LET_TAC; REPEAT GEN_TAC; ABBREV_TAC `(P:num->bool) = \m. (euclid m f) /\ (euclid m g)`; DISCH_ALL_TAC; SUBGOAL_TAC `(P:num->bool) (p:num)`; EXPAND_TAC "P"; ASM_REWRITE_TAC[]; DISCH_TAC; SUBGOAL_TAC `min_num P <=| p`; ASM_MESON_TAC[min_least]; DISCH_TAC; SUBGOAL_TAC `euclid (min_num (P:num->bool)) f /\ (euclid (min_num (P:num->bool)) g)`; ASM_MESON_TAC[min_least]; DISCH_ALL_TAC; ABBREV_TAC `q = min_num P`; MP_TAC (SPECL [`q:num`;`p:num`] LE_EXISTS); ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[GSYM SUM_TWO]; MATCH_MP_TAC (REAL_ARITH `(u = (&.0)) ==> (x = x + u)`); SUBGOAL_THEN `!n. n>=| q ==> ((\i. f i *. g i) n = (&.0))` (fun th -> MATCH_MP_TAC (MATCH_MP SUM_ZERO th)); GEN_TAC THEN BETA_TAC; DISCH_TAC; SUBGOAL_THEN `(f:num->real) n = (&.0)` (fun th -> REWRITE_TAC[th;REAL_ARITH `(&.0)*.a =(&.0)`]); UNDISCH_TAC `euclid q f`; UNDISCH_TAC `n >=| q`; MESON_TAC[euclid;ARITH_RULE `(a<=|b) <=> (b >=| a)`]; ACCEPT_TAC (ARITH_RULE `q >=| q`); ]);; (* }}} *) let dot_updim = prove_by_refinement ( `!f g m n. (m <=|n) /\ (euclid m f) /\ (euclid m g) ==> (dot f g = sum (0,n) (\i. (f i)* (g i)))`, (* {{{ *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; SUBGOAL_TAC `(euclid n f) /\ (euclid n g)`; ASM_MESON_TAC[euclid_updim]; MATCH_ACCEPT_TAC dot_euclid] );; (* }}} *) let dot_nonneg = prove_by_refinement( `!f. (&.0 <= (dot f f))`, (* {{{ *) [ REWRITE_TAC[dot]; LET_TAC; GEN_TAC; SUBGOAL_TAC `(!n. (&.0 <=. (\(i:num). f i *. f i) n))`; BETA_TAC; REWRITE_TAC[REAL_LE_SQUARE]; ASSUME_TAC(SPEC `\i. (f:num->real) i *. f i` SUM_POS); ASM_MESON_TAC[]]);; (* }}} *) let dot_comm = prove_by_refinement( `!f g. (dot f g = dot g f)`, (* {{{ *) [ REWRITE_TAC[dot]; REWRITE_TAC[REAL_ARITH `a*.b = b*.a`;TAUT `a/\b <=> b/\a`] ]);; (* }}} *) let dot_neg = prove_by_refinement( `!f g. (dot (--f) g) = --. (dot f g)`, (* {{{ *) [ REWRITE_TAC[dot]; LET_TAC; REWRITE_TAC [GSYM neg_dim]; ONCE_REWRITE_TAC[GSYM SUM_NEG]; REWRITE_TAC[euclid_neg]; REPEAT GEN_TAC; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT; BETA_TAC; GEN_TAC; REWRITE_TAC[REAL_ARITH `(--x) * y = --. (x *y)`]; ]);; (* }}} *) let dot_neg2 = prove_by_refinement( `!f g. (dot f (--g)) = --. (dot f g)`, (* {{{ *) [ ONCE_REWRITE_TAC[dot_comm]; REWRITE_TAC[dot_neg]; ]);; (* }}} *) let dot_scale = prove_by_refinement( `!n f g s. (euclid n f) /\ (euclid n g) ==> (dot (s *# f) g = s *. (dot f g))`, (* {{{ *) [ REWRITE_TAC[euclid_scale]; REPEAT GEN_TAC; DISCH_THEN (fun th -> ASSUME_TAC th THEN ASSUME_TAC (MATCH_MP dot_euclid th)); SUBGOAL_THEN (`euclid n (\ (i:num). (s *. f i) ) /\ (euclid n g)`) ASSUME_TAC; ASM_REWRITE_TAC[]; ASSUME_TAC(REWRITE_RULE[euclid_scale](SPECL [`n:num`;`s:real`;`f:num->real`] euclid_scale_closure)); ASM_MESON_TAC[]; IMP_RES_THEN ASSUME_TAC dot_euclid; ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM SUM_CMUL]; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; BETA_TAC; REWRITE_TAC[REAL_ARITH `a*.(b*.c) = (a*b)*c`]; ]);; (* }}} *) let dot_scale_euclidean = prove_by_refinement( `!f g s. (euclidean f) /\ (euclidean g) ==> (dot (s *# f) g = s *. (dot f g))`, (* {{{ *) [ REWRITE_TAC[euclidean]; DISCH_ALL_TAC; REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC)); DISCH_ALL_TAC; ASSUME_TAC (ARITH_RULE `(n' <=| n+n')`); ASSUME_TAC (ARITH_RULE `(n <=| n+n')`); SUBGOAL_TAC `euclid (n+|n') f /\ euclid (n+n') g`; ASM_MESON_TAC[euclid_updim]; MESON_TAC[dot_scale]; ]);; (* }}} *) let dot_scale2 = prove_by_refinement( `!n f g s. (euclid n f) /\ (euclid n g) ==> (dot f (s *# g) = s *. (dot f g))`, (* {{{ *) [ ONCE_REWRITE_TAC[dot_comm]; MESON_TAC[dot_scale] ]);; (* }}} *) let dot_scale2_euclidean = prove_by_refinement( `!f g s. (euclidean f) /\ (euclidean g) ==> (dot f (s *# g) = s *. (dot f g))`, (* {{{ *) [ ONCE_REWRITE_TAC[dot_comm]; MESON_TAC[dot_scale_euclidean]; ]);; (* }}} *) let dot_linear = prove_by_refinement( `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> ((dot (f + g) h ) = (dot f h) +. (dot g h))`, (* {{{ *) [ DISCH_ALL_TAC; SUBGOAL_TAC `euclid n (f+g)`; ASM_MESON_TAC[euclid_add_closure]; DISCH_TAC; MP_TAC (SPECL [`n:num`;`f:num->real`;`h:num->real`] dot_euclid); MP_TAC (SPECL [`n:num`;`g:num->real`;`h:num->real`] dot_euclid); MP_TAC (SPECL [`n:num`;`(f+g):num->real`;`h:num->real`] dot_euclid); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM SUM_ADD]; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC; REWRITE_TAC[euclid_plus]; REWRITE_TAC[REAL_ARITH `(a+.b)*.c = a*c + b*c`]; ]);; (* }}} *) let dot_minus_linear = prove_by_refinement( `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> ((dot (f - g) h ) = (dot f h) -. (dot g h))`, (* {{{ *) [ DISCH_ALL_TAC; SUBGOAL_TAC `euclid n (f-g)`; ASM_MESON_TAC[euclid_sub_closure]; DISCH_TAC; MP_TAC (SPECL [`n:num`;`f:num->real`;`h:num->real`] dot_euclid); MP_TAC (SPECL [`n:num`;`g:num->real`;`h:num->real`] dot_euclid); MP_TAC (SPECL [`n:num`;`(f-g):num->real`;`h:num->real`] dot_euclid); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM SUM_SUB]; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC; REWRITE_TAC[euclid_minus]; REWRITE_TAC[REAL_ARITH `(a-.b)*.c = a*c - b*c`]; ]);; (* }}} *) let dot_linear_euclidean = prove_by_refinement( `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> ((dot (f + g) h ) = (dot f h) +. (dot g h))`, (* {{{ *) [ REWRITE_TAC[euclidean]; DISCH_ALL_TAC; REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC)); DISCH_ALL_TAC; SUBGOAL_TAC `(euclid (n+n'+n'') f)`; ASM_MESON_TAC[ARITH_RULE `n <=| n+n'+n''`;euclid_updim]; SUBGOAL_TAC `(euclid (n+n'+n'') g)`; ASM_MESON_TAC[ARITH_RULE `n' <=| n+n'+n''`;euclid_updim]; SUBGOAL_TAC `(euclid (n+n'+n'') h)`; ASM_MESON_TAC[ARITH_RULE `n'' <=| n+n'+n''`;euclid_updim]; MESON_TAC[dot_linear]]);; (* }}} *) let dot_minus_linear_euclidean = prove_by_refinement( `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> ((dot (f - g) h ) = (dot f h) -. (dot g h))`, (* {{{ *) [ REWRITE_TAC[euclidean]; DISCH_ALL_TAC; REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC)); DISCH_ALL_TAC; SUBGOAL_TAC `(euclid (n+n'+n'') f)`; ASM_MESON_TAC[ARITH_RULE `n <=| n+n'+n''`;euclid_updim]; SUBGOAL_TAC `(euclid (n+n'+n'') g)`; ASM_MESON_TAC[ARITH_RULE `n' <=| n+n'+n''`;euclid_updim]; SUBGOAL_TAC `(euclid (n+n'+n'') h)`; ASM_MESON_TAC[ARITH_RULE `n'' <=| n+n'+n''`;euclid_updim]; MESON_TAC[dot_minus_linear]; ]);; (* }}} *) let dot_linear2 = prove_by_refinement( `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> ((dot h (f + g)) = (dot h f) +. (dot h g))`, (* {{{ *) [ REPEAT GEN_TAC; ONCE_REWRITE_TAC[dot_comm]; MESON_TAC[dot_linear] ]);; (* }}} *) let dot_linear2_euclidean = prove_by_refinement( `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> ((dot h (f + g)) = (dot h f) +. (dot h g))`, (* {{{ *) [ REPEAT GEN_TAC; ONCE_REWRITE_TAC[dot_comm]; MESON_TAC[dot_linear_euclidean] ]);; (* }}} *) let dot_minus_linear2 = prove_by_refinement( `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> ((dot h (f - g)) = (dot h f) -. (dot h g))`, (* {{{ *) [ REPEAT GEN_TAC; ONCE_REWRITE_TAC[dot_comm]; MESON_TAC[dot_minus_linear] ]);; (* }}} *) let dot_minus_linear2_euclidean = prove_by_refinement( `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> ((dot h (f - g)) = (dot h f) -. (dot h g))`, (* {{{ *) [ REPEAT GEN_TAC; ONCE_REWRITE_TAC[dot_comm]; MESON_TAC[dot_minus_linear_euclidean] ]);; (* }}} *) let dot_rzero = prove_by_refinement( `!f. (dot f euclid0) = &.0`, (* {{{ *) [ REWRITE_TAC[dot;euclid0]; LET_TAC; GEN_TAC; SUBGOAL_THEN `(\ (i:num). (f i *. (&.0))) = (\ (r:num). (&.0))` (fun t -> REWRITE_TAC[t]); REWRITE_TAC[REAL_ARITH `a*.(&.0) = (&.0)`]; MESON_TAC[SUM_0]; ]);; (* }}} *) let dot_lzero = prove_by_refinement( `!f. (dot euclid0 f ) = &.0`, (* {{{ *) [ ONCE_REWRITE_TAC[dot_comm]; REWRITE_TAC[dot_rzero]; ]);; (* }}} *) let dot_zero = prove_by_refinement( `!f n. (euclid n f) /\ (dot f f = (&.0)) ==> (f = euclid0)`, (* {{{ *) [ DISCH_ALL_TAC; UNDISCH_TAC `dot f f = (&.0)`; MP_TAC (SPECL [`n:num`;`f:num->real`;`f:num->real`] dot_euclid); ASM_REWRITE_TAC[]; DISCH_THEN (fun th -> REWRITE_TAC[th]); REWRITE_TAC[euclid0]; DISCH_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC THEN BETA_TAC; DISJ_CASES_TAC (ARITH_RULE `x <| n \/ (n <=| x)`); CLEAN_ASSUME_TAC (ARITH_RULE `(x <|n) ==> (SUC x <=| n)`); CLEAN_THEN (SPECL [`SUC x`;`n:num`] LE_EXISTS) CHOOSE_TAC; UNDISCH_TAC `sum(0,n) (\ (i:num). f i *. f i) = (&.0)`; ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM SUM_TWO;sum;ARITH_RULE `0+| x = x`]; SUBGOAL_TAC `!a b. (&.0 <=. sum(a,b) (\ (i:num). f i *. f i))`; REPEAT GEN_TAC; MP_TAC (SPEC `\ (i:num). f i *. f i` SUM_POS); BETA_TAC; REWRITE_TAC[REAL_LE_SQUARE]; MESON_TAC[]; DISCH_ALL_TAC; IMP_RES_THEN MP_TAC (REAL_ARITH `(a+.b = &.0) ==> ((&.0 <=. b) ==> (a <=. (&.0)))`); ASM_REWRITE_TAC[]; DISCH_TAC; IMP_RES_THEN MP_TAC (REAL_ARITH `(a+b <=. &.0) ==> ((&.0 <=. a) ==> (b <=. (&.0)))`); ASM_REWRITE_TAC[]; ABBREV_TAC `a = (f:num->real) x`; MESON_TAC[REAL_LE_SQUARE;REAL_ARITH `a <=. (&.0) /\ (&.0 <=. a) ==> (a = (&.0))`;REAL_ENTIRE]; UNDISCH_TAC `euclid n f`; REWRITE_TAC[euclid]; ASM_MESON_TAC[]; ]);; (* }}} *) let dot_zero_euclidean = prove_by_refinement( `!f. (euclidean f) /\ (dot f f = (&.0)) ==> (f = euclid0)`, (* {{{ *) [ REWRITE_TAC[euclidean]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `euclid` CHOOSE_TAC; ASM_MESON_TAC[dot_zero]; ]);; (* }}} *) (* norm *) let norm_nonneg = prove_by_refinement( `!f. (&.0 <=. norm f)`, (* {{{ *) [ REWRITE_TAC[norm]; ONCE_REWRITE_TAC[GSYM SQRT_0]; GEN_TAC; MATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[dot_nonneg]; REAL_ARITH_TAC; ]);; (* }}} *) let norm_neg = prove_by_refinement( `!f. norm (--f) = norm f`, (* {{{ *) [ REWRITE_TAC[norm;dot_neg;dot_neg2]; REWRITE_TAC[REAL_ARITH `--(--. x) = x`]; ]);; (* }}} *) let cauchy_schwartz = prove_by_refinement( `!f g. (euclidean f) /\ (euclidean g) ==> ((abs(dot f g)) <=. (norm f)*. (norm g))`, (* {{{ *) [ DISCH_ALL_TAC; DISJ_CASES_TAC (TAUT `(f = euclid0 ) \/ ~(f = euclid0)`); ASM_REWRITE_TAC[dot_lzero;norm;SQRT_0;REAL_ARITH`&.0 *. x = (&.0)`]; REWRITE_TAC[ABS_0;REAL_ARITH `x <=. x`]; SUBGOAL_THEN `!a b. (dot (a *# f + b *# g) (a *# f + b *# g)) = a*a*(dot f f) + (&.2)*a*b*(dot f g) + b*b*(dot g g)` ASSUME_TAC; REPEAT GEN_TAC; ASM_SIMP_TAC[euclidean_scale_closure;euclidean_add_closure;dot_linear_euclidean;dot_linear2_euclidean;dot_scale_euclidean;dot_scale2_euclidean]; REWRITE_TAC[REAL_MUL_AC;REAL_ADD_AC;REAL_ADD_LDISTRIB]; MATCH_MP_TAC (REAL_ARITH`(b+. c=e) ==> (a+b+c+d = a+ e+d)`); REWRITE_TAC[GSYM REAL_LDISTRIB]; REPEAT AP_TERM_TAC; MATCH_MP_TAC (REAL_ARITH `(a=b)==> (a+.b = a*(&.2))`); REWRITE_TAC[dot_comm]; FIRST_ASSUM (fun th -> ASSUME_TAC (SPECL[` --. (dot f g)`;`dot f f`] th)); CLEAN_THEN (SPEC `(--.(dot f g)) *# f + (dot f f)*# g` dot_nonneg) ASSUME_TAC; REWRITE_TAC[norm]; ASSUME_TAC(SPEC `f:num->real` dot_nonneg); ASSUME_TAC(SPEC `g:num->real` dot_nonneg); ASM_SIMP_TAC[GSYM SQRT_MUL]; REWRITE_TAC[GSYM POW_2_SQRT_ABS;POW_2]; MATCH_MP_TAC SQRT_MONO_LE; REWRITE_TAC[REAL_LE_SQUARE]; SUBGOAL_TAC `&.0 <. dot f f`; MATCH_MP_TAC (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 <. x)`); ASM_REWRITE_TAC[]; ASM_MESON_TAC[dot_zero_euclidean]; REPEAT (UNDISCH_FIND_TAC `(<=.)` ); ABBREV_TAC `a = dot f f`; ABBREV_TAC `b = dot f g`; ABBREV_TAC `c = dot g g`; POP_ASSUM_LIST (fun t -> ALL_TAC); REWRITE_TAC[REAL_ARITH `(&.2 *. x = x + x)`;REAL_ADD_AC]; REWRITE_TAC[REAL_ARITH `(a *. ((--. b)*.c) = --. (a *. (b*.c)))/\ (--. ((--. a) *. b) = a *.b )`]; REWRITE_TAC[REAL_ARITH `(--. b) *. a*. b + b*.b*.a = (&.0)`]; REWRITE_TAC[REAL_ARITH `x +. (&.0) = x`]; REWRITE_TAC[REAL_ARITH `(&.0 <=. (a*.a*.c +. (--.b)*.a*.b)) <=> (a*b*b <=. a*a*c)`]; DISCH_ALL_TAC; MATCH_MP_TAC (SPEC `a:real` REAL_LE_LCANCEL_IMP); ASM_REWRITE_TAC[]; ]);; (* }}} *) let norm_dot = prove_by_refinement( `!h. norm(h) * norm(h) = (dot h h)`, (* {{{ *) [ REWRITE_TAC[norm]; ONCE_REWRITE_TAC[GSYM POW_2]; REWRITE_TAC[SQRT_POW2;dot_nonneg]; ]);; (* }}} *) let norm_triangle = prove_by_refinement( `!f g. (euclidean f) /\ (euclidean g) ==> (norm (f+g) <=. norm(f) + norm(g))`, (* {{{ *) [ DISCH_ALL_TAC; MATCH_MP_TAC square_le; REWRITE_TAC[norm_nonneg]; CONJ_TAC; MATCH_MP_TAC (REAL_ARITH `(&.0 <=. x) /\ (&.0 <=. y) ==> (&.0 <= x+y)`); REWRITE_TAC[norm_nonneg]; REWRITE_TAC[REAL_ADD_LDISTRIB;REAL_ADD_RDISTRIB;REAL_ADD_AC]; REWRITE_TAC[norm_dot]; ASM_SIMP_TAC[euclidean_add_closure;dot_linear_euclidean;dot_linear2_euclidean]; REWRITE_TAC[REAL_MUL_AC]; REWRITE_TAC[REAL_ADD_AC]; MATCH_MP_TAC (REAL_ARITH `(b<=.c)==>((a+.b) <=. (a+c))`); MATCH_MP_TAC (REAL_ARITH `(a=b)/\ (a<=. e) ==>((a+b+c) <= (c+e+e))`); CONJ_TAC; REWRITE_TAC[dot_comm]; ASM_MESON_TAC[cauchy_schwartz;REAL_LE_TRANS;REAL_ARITH `x <=. ||. x`]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Metric Space *) (* ------------------------------------------------------------------ *) let metric_space_zero = prove_by_refinement( `!(X:A->bool) d a. (metric_space(X,d) /\ (X a) ==> (d a a = (&.0)))`, (* {{{ *) [MESON_TAC[metric_space] ]);; (* }}} *) let metric_space_symm = prove_by_refinement( `!(X:A->bool) d a b. (metric_space(X,d) /\ (X a) /\ (X b) ==> (d a b = d b a))`, (* {{{ *) [ MESON_TAC[metric_space]; ]);; (* }}} *) let metric_space_triangle = prove_by_refinement( `!(X:A->bool) d a b c. (metric_space(X,d) /\ (X a) /\ (X b) /\ (X c) ==> (d a c <=. d a b +. d b c))`, (* {{{ *) [ MESON_TAC[metric_space]; ]);; (* }}} *) let metric_subspace = prove_by_refinement( `!X Y d. (Y SUBSET (X:A->bool)) /\ (metric_space (X,d)) ==> (metric_space (Y,d))`, (* {{{ *) [ REWRITE_TAC[SUBSET;metric_space;IN]; DISCH_ALL_TAC; DISCH_ALL_TAC; UNDISCH_FIND_THEN `( /\ )` (fun t -> MP_TAC (SPECL[`x:A`;`y:A`;`z:A`] t)); ASM_SIMP_TAC[]; ]);; (* }}} *) let metric_euclidean = prove_by_refinement( `metric_space (euclidean,d_euclid)`, (* {{{ *) [ REWRITE_TAC[metric_space;d_euclid]; DISCH_ALL_TAC; CONJ_TAC; REWRITE_TAC[norm_nonneg]; CONJ_TAC; EQ_TAC; REWRITE_TAC[norm]; ONCE_REWRITE_TAC[REAL_ARITH `(&.0 = x) <=> (x = (&.0))`]; ASM_SIMP_TAC[dot_nonneg;SQRT_EQ_0]; DISCH_TAC; SUBGOAL_TAC `x - y = euclid0`; ASM_MESON_TAC[dot_zero_euclidean;euclidean_sub_closure]; REWRITE_TAC[euclid_minus;euclid0]; DISCH_TAC THEN (MATCH_MP_TAC EQ_EXT); X_GEN_TAC `n:num`; FIRST_ASSUM (fun t -> ASSUME_TAC (BETA_RULE (AP_THM t `n:num`))); ASM_MESON_TAC [REAL_ARITH `(a = b) <=> (a-.b = (&.0))`]; DISCH_THEN (fun t->REWRITE_TAC[t]); SUBGOAL_THEN `(y:num->real) - y = euclid0` (fun t-> REWRITE_TAC[t]); REWRITE_TAC[euclid0;euclid_minus]; MATCH_MP_TAC EQ_EXT; GEN_TAC THEN BETA_TAC; REAL_ARITH_TAC; REWRITE_TAC[norm;dot_lzero;SQRT_0]; CONJ_TAC; SUBGOAL_THEN `x - y = (euclid_neg (y-x))` ASSUME_TAC; REWRITE_TAC[euclid_neg;euclid_minus]; MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC; REAL_ARITH_TAC; ASM_MESON_TAC[norm_neg]; SUBGOAL_THEN `(x-z) = euclid_plus(x - y) (y-z)` (fun t -> REWRITE_TAC[t]); REWRITE_TAC[euclid_plus;euclid_minus]; MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC THEN REAL_ARITH_TAC; ASM_SIMP_TAC[norm_triangle;euclidean_sub_closure;euclidean_sub_closure]; ]);; (* }}} *) let metric_euclid = prove_by_refinement( `!n. metric_space (euclid n,d_euclid)`, (* {{{ *) [ GEN_TAC; MATCH_MP_TAC (ISPEC `euclidean` metric_subspace); REWRITE_TAC[metric_euclidean;SUBSET;IN]; MESON_TAC[euclidean]; ]);; (* }}} *) let euclid1_abs = prove_by_refinement( `!x y. (euclid 1 x) /\ (euclid 1 y) ==> ((d_euclid x y) = (abs ((x 0) -. (y 0))))`, (* {{{ proof *) [ REWRITE_TAC[d_euclid;norm]; DISCH_ALL_TAC; SUBGOAL_TAC `euclid 1 (x - y)`; ASM_MESON_TAC[euclid_sub_closure]; DISCH_TAC; ASSUME_TAC (prove(`1 <= 1`,ARITH_TAC)); MP_TAC (SPECL[`(x-y):num->real`;`(x-y):num->real`;`1`;`1`] dot_updim); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); REWRITE_TAC[prove(`1 = SUC 0`,ARITH_TAC)]; REWRITE_TAC[sum]; REWRITE_TAC[REAL_ARITH `&.0 + x = x`]; REWRITE_TAC[ARITH_RULE `0 +| 0 = 0`]; REWRITE_TAC[euclid_minus]; ASM_MESON_TAC[REAL_POW_2;POW_2_SQRT_ABS]; ]);; (* }}} *) let coord_dirac = prove_by_refinement( `!i t. coord i (t *# dirac_delta i ) = t`, (* {{{ proof *) [ REWRITE_TAC[coord;dirac_delta;euclid_scale]; ARITH_TAC; ]);; (* }}} *) let dirac_0 = prove_by_refinement( `!x. (x *# dirac_delta 0) 0 = x`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[dirac_delta;euclid_scale;]; REDUCE_TAC; ]);; (* }}} *) let euclid1_dirac = prove_by_refinement( `!x. euclid 1 x <=> (x = (x 0) *# (dirac_delta 0))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[euclid; euclid_scale;dirac_delta ]; EQ_TAC; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; X_GEN_TAC `n:num`; BETA_TAC; COND_CASES_TAC; REDUCE_TAC; ASM_REWRITE_TAC[]; REDUCE_TAC; ASM_SIMP_TAC[ARITH_RULE `(~(0=m))==>(1<=| m)`]; DISCH_ALL_TAC; DISCH_ALL_TAC; USE 1 (MATCH_MP (ARITH_RULE `1<= m ==> (~(0=m))`)); ASM ONCE_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REDUCE_TAC ; ]);; (* }}} *) (* projection onto the ith coordinate, as a euclidean vector *) let proj = euclid_def `proj i x = (\j. (if (j=0) then (x (i:num)) else (&.0)))`;; let proj_euclid1 = prove_by_refinement( `!i x. euclid 1 (proj i x)`, (* {{{ proof *) [ REWRITE_TAC[proj;euclid]; REPEAT GEN_TAC; COND_CASES_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; ARITH_TAC; ]);; (* }}} *) let d_euclid_n = prove_by_refinement( `!n x y. ((euclid n x) /\ (euclid n y)) ==> ((d_euclid x y) = sqrt(sum (0,n) (\i. (x i - y i) * (x i - y i))))`, (* {{{ proof *) [ REPEAT GEN_TAC; REWRITE_TAC[d_euclid;norm]; DISCH_ALL_TAC; ASSUME_TAC (ARITH_RULE `n <=| n`); SUBGOAL_TAC `euclid n (x - y)`; ASM_SIMP_TAC[euclid_sub_closure]; DISCH_TAC; CLEAN_ASSUME_TAC (SPECL[`(x-y):num->real`;`(x-y):num->real`;`n:num`;`n:num`]dot_updim); ASM_REWRITE_TAC[euclid_minus]; ]);; (* }}} *) let norm_n = prove_by_refinement( `!n x. ((euclid n x) ) ==> ((norm x) = sqrt(sum (0,n) (\i. (x i ) * (x i ))))`, (* {{{ proof *) [ REPEAT GEN_TAC; TYPEL_THEN [`x`;`x`;`n`;`n`] (fun t-> SIMP_TAC [norm;ISPECL t dot_updim;ARITH_RULE `n <=| n`;]); ]);; (* }}} *) let proj_d_euclid = prove_by_refinement( `!i x y. d_euclid (proj i x) (proj i y) = abs (x i -. y i)`, (* {{{ proof *) [ REPEAT GEN_TAC; SIMP_TAC[SPEC `1` d_euclid_n;proj_euclid1]; REWRITE_TAC[ARITH_RULE `1 = SUC 0`;sum]; NUM_REDUCE_TAC; REWRITE_TAC[proj]; REWRITE_TAC[REAL_ARITH `&.0 + x = x`]; MESON_TAC[POW_2_SQRT_ABS;REAL_POW_2]; ]);; (* }}} *) let d_euclid_pos = prove_by_refinement( `!x y n. (euclid n x) /\ (euclid n y) ==> (&.0 <=. d_euclid x y)`, (* {{{ proof *) [ DISCH_ALL_TAC; MP_TAC metric_euclid; REWRITE_TAC[metric_space;euclidean]; ASM_MESON_TAC[]; ]);; (* }}} *) let proj_contraction = prove_by_refinement( `!n x y i. (euclid n x) /\ (euclid n y) ==> abs (x i - (y i)) <=. d_euclid x y`, (* {{{ proof *) [ DISCH_ALL_TAC; MATCH_MP_TAC REAL_POW_2_LE; REWRITE_TAC[REAL_ABS_POS]; CONJ_TAC; ASM_MESON_TAC[d_euclid_pos]; ASM_SIMP_TAC[SPEC `n:num` d_euclid_n]; REWRITE_TAC[REAL_POW2_ABS]; SUBGOAL_TAC `euclid n (x - y)`; (* why does MESON fail here??? *) MATCH_MP_TAC euclid_sub_closure; ASM_MESON_TAC[]; DISCH_TAC; SUBGOAL_TAC `&.0 <=. sum (0,n) (\i. (x i - y i)*. (x i - y i))`; MATCH_MP_TAC SUM_POS_GEN; DISCH_ALL_TAC THEN BETA_TAC; REWRITE_TAC[REAL_LE_SQUARE]; SIMP_TAC[SQRT_POW_2]; DISCH_TAC; ASM_CASES_TAC `n <=| i`; MATCH_MP_TAC (REAL_ARITH `(x = (&.0)) /\ (&.0 <=. y) ==> (x <=. y)`); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_PROP_ZERO_POW]; NUM_REDUCE_TAC; ASM_MESON_TAC[euclid;euclid_minus]; MP_TAC (ARITH_RULE `~(n <=| i) ==> (i < n) /\ (n = (SUC i) + (n-i-1))`); ASM_REWRITE_TAC[] THEN DISCH_ALL_TAC; ASM ONCE_REWRITE_TAC[]; REWRITE_TAC[GSYM SUM_TWO]; MATCH_MP_TAC (REAL_ARITH `(a <=. b) /\ (&.0 <=. c) ==> (a <=. (b +c))`); CONJ_TAC; REWRITE_TAC[sum_DEF]; REWRITE_TAC[ARITH_RULE `0 +| i = i`]; MATCH_MP_TAC (REAL_ARITH `(a = c) /\ (&.0 <=. b) ==> (a <=. b+c)`); REWRITE_TAC[REAL_POW_2]; MP_TAC (SPECL [`0:num`;`i:num`;`(x:num->real)- y`] REAL_SUM_SQUARE_POS); BETA_TAC; REWRITE_TAC[euclid_minus]; MP_TAC (SPECL [`SUC i`;`(n:num)-i-1`;`(x:num->real)- y`] REAL_SUM_SQUARE_POS); BETA_TAC; REWRITE_TAC[euclid_minus]; ]);; (* }}} *) let euclid_dirac = prove_by_refinement( `!x. (euclid 1 (x *# (dirac_delta 0)))`, (* {{{ proof *) [ REWRITE_TAC[euclid;dirac_delta ;euclid_scale]; DISCH_ALL_TAC; USE 0 (MATCH_MP (ARITH_RULE `1 <=| m ==> (~(0=m))`)); ASM_REWRITE_TAC[]; REDUCE_TAC; ]);; (* }}} *) let d_euclid_pow2 = prove_by_refinement( `!n x y. (euclid n x) /\ (euclid n y) ==> ((d_euclid x y) pow 2 = sum (0,n) (\i. (x i - y i) * (x i - y i)))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[d_euclid_n]; REWRITE_TAC[SQRT_POW2]; MATCH_MP_TAC SUM_POS_GEN; BETA_TAC; REDUCE_TAC; ]);; (* }}} *) let D_EUCLID_BOUND = prove_by_refinement( `!n x y eps. ((euclid n x) /\ (euclid n y) /\ (!i. (abs (x i -. y i) <=. eps))) ==> ( d_euclid x y <=. sqrt(&.n)*. eps )`, (* {{{ proof *) [ DISCH_ALL_TAC; SQUARE_TAC; SUBCONJ_TAC; JOIN 0 1; USE 0 (MATCH_MP d_euclid_pos); ASM_REWRITE_TAC[]; DISCH_TAC; WITH 2 (SPEC `0`); USE 4 (MATCH_MP (REAL_ARITH `abs (x) <=. eps ==> &.0 <=. eps`)); SUBCONJ_TAC; ALL_TAC; REWRITE_TAC[REAL_MUL_NN]; DISJ1_TAC; CONJ_TAC; MATCH_MP_TAC SQRT_POS_LE ; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; ASM_SIMP_TAC[d_euclid_pow2]; SUBGOAL_TAC `!i. ((x:num->real) i -. y i) *. (x i -. y i) <=. eps* eps`; GEN_TAC; ALL_TAC; USE 2 (SPEC `i:num`); ABBREV_TAC `t = x i - (y:num->real) i`; UND 2; REWRITE_TAC[ABS_SQUARE_LE]; REWRITE_TAC[REAL_POW_MUL]; ASSUME_TAC (REWRITE_RULE[] ((REDUCE_CONV `&.0 <= &.n`))); USE 6 (REWRITE_RULE[GSYM SQRT_POW2]); ASM_REWRITE_TAC[]; DISCH_TAC; ALL_TAC; MATCH_MP_TAC SUM_BOUND; GEN_TAC; DISCH_TAC; BETA_TAC; REWRITE_TAC[POW_2]; ASM_MESON_TAC[]; ]);; (* }}} *) let metric_translate = prove_by_refinement( `!n x y z . (euclid n x) /\ (euclid n y) /\ (euclid n z) ==> (d_euclid (x + z) (y + z) = d_euclid x y)`, (* {{{ proof *) [ REWRITE_TAC[d_euclid;norm]; DISCH_ALL_TAC; TYPE_THEN `euclid n (euclid_minus x y)` SUBGOAL_TAC; ASM_SIMP_TAC[euclid_sub_closure]; DISCH_TAC; TYPE_THEN `euclid n (euclid_minus (euclid_plus x z) (euclid_plus y z))` SUBGOAL_TAC; ASM_SIMP_TAC[euclid_sub_closure; euclid_add_closure]; DISCH_ALL_TAC; ASM_SIMP_TAC[SPEC `n:num` dot_euclid]; TYPE_THEN `(x + z) - (y + z) = ((x:num->real) - y)` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; X_GEN_TAC `i:num`; REWRITE_TAC[euclid_minus;euclid_plus]; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); ]);; (* }}} *) let metric_translate_LEFT = prove_by_refinement( `!n x y z . (euclid n x) /\ (euclid n y) /\ (euclid n z) ==> (d_euclid (z + x ) (z + y) = d_euclid x y)`, (* {{{ proof *) [ REWRITE_TAC[d_euclid;norm]; DISCH_ALL_TAC; TYPE_THEN `euclid n (euclid_minus x y)` SUBGOAL_TAC; ASM_SIMP_TAC[euclid_sub_closure]; DISCH_TAC; TYPE_THEN `euclid n (euclid_minus (euclid_plus z x) (euclid_plus z y))` SUBGOAL_TAC; ASM_SIMP_TAC[euclid_sub_closure; euclid_add_closure]; DISCH_ALL_TAC; ASM_SIMP_TAC[SPEC `n:num` dot_euclid]; TYPE_THEN `(z + x) - (z + y) = ((x:num->real) - y)` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; X_GEN_TAC `i:num`; REWRITE_TAC[euclid_minus;euclid_plus]; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); ]);; (* }}} *) let norm_scale = prove_by_refinement( `!t t' x . (euclidean x) ==> (d_euclid (t *# x) (t' *# x) = ||. (t - t') * norm(x))`, (* {{{ proof *) [ REWRITE_TAC[euclidean]; LEFT_TAC "n"; DISCH_ALL_TAC; ASM_SIMP_TAC[d_euclid_n;norm_n;euclid_scale_closure;euclid_scale;GSYM REAL_SUB_RDISTRIB;REAL_MUL_AC;]; REWRITE_TAC[GSYM REAL_POW_2 ]; REWRITE_TAC[REAL_ARITH `a * a * b = b * (a * a)`;SUM_CMUL;]; ASM_SIMP_TAC[SQRT_MUL;REAL_SUM_SQUARE_POS;REAL_LE_SQUARE_POW;POW_2_SQRT_ABS ]; REWRITE_TAC[REAL_POW_2]; ]);; (* }}} *) let norm_scale_vec = prove_by_refinement( `!n t x x' . (euclid n x) /\ (euclid n x') ==> (d_euclid (t *# x) (t *# x') = ||. t * d_euclid x x')`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[d_euclid_n;norm_n;euclid_scale_closure;euclid_scale;GSYM REAL_SUB_LDISTRIB;REAL_MUL_AC;]; REWRITE_TAC[REAL_ARITH `t*t*b = (t*t)*b`]; REWRITE_TAC[GSYM REAL_POW_2 ;SUM_CMUL ]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_2]; ASM_SIMP_TAC[SQRT_MUL;REAL_SUM_SQUARE_POS;REAL_LE_SQUARE_POW;POW_2_SQRT_ABS ]; REWRITE_TAC[REAL_POW_2]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Topological Spaces *) (* ------------------------------------------------------------------ *) (* Definitions *) (* underscore is necessary to avoid Harrison's global "topology" *) (* carrier of topology is UNIONS U *) let topology = euclid_def `topology_ (U:(A->bool)->bool) <=> (!A B V. (U EMPTY) /\ ((U A) /\ (U B) ==> (U (A INTER B))) /\ ((V SUBSET U) ==> (U (UNIONS V))))`;; let open_DEF = euclid_def `open_ (U:(A->bool)->bool) A = (U A)`;; let closed = euclid_def `closed_ (U:(A->bool)->bool) B <=> (B SUBSET (UNIONS U)) /\ (open_ U ((UNIONS U) DIFF B))`;; let closure = euclid_def `closure (U:(A->bool)->bool) A = INTERS { B | (closed_ U B) /\ (A SUBSET B) }`;; let induced_top = euclid_def `induced_top U (A:A->bool) = IMAGE ( \B. (B INTER A)) U`;; let open_ball = euclid_def `open_ball(X,d) (x:A) r = { y | (X x) /\ (X y) /\ (d x y <. r) }`;; let closed_ball =euclid_def `closed_ball (X,d) (x:A) r = { y | (X x) /\ (X y) /\ (d x y <=. r) }`;; let open_balls = euclid_def `open_balls (X,d) = { B | ?(x:A) r. B = open_ball (X,d) x r}`;; let top_of_metric = euclid_def `top_of_metric ((X:A->bool),d) = { A | ?F. (F SUBSET (open_balls (X,d)))/\ (A = UNIONS F) }`;; (* basic properties *) let open_EMPTY = prove_by_refinement( `!(U:(A->bool)->bool). (topology_ U ==> open_ U EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[topology;open_DEF]; MESON_TAC[]; ]);; (* }}} *) let open_closed = prove_by_refinement( `!U A. (topology_ (U:(A->bool)->bool)) /\ (open_ U A) ==> (closed_ U ((UNIONS U) DIFF A))`, (* {{{ proof *) [ REWRITE_TAC[closed;open_DEF]; DISCH_ALL_TAC; SUBGOAL_THEN `(A:A->bool) SUBSET (UNIONS U)` ASSUME_TAC; ASM_MESON_TAC[sub_union]; ASM_SIMP_TAC[DIFF_DIFF2]; REWRITE_TAC[SUBSET_DIFF]; ]);; (* }}} *) let closed_UNIV = prove_by_refinement( `!(U:(A->bool)->bool). (topology_ U ==> closed_ U (UNIONS U))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_SIMP_TAC[open_closed]; REWRITE_TAC[closed;open_DEF]; TYPE_THEN `a = UNIONS U` ABBREV_TAC; USE 0 (REWRITE_RULE[topology]); CONJ_TAC; MESON_TAC[SUBSET]; USE 0 (CONV_RULE (quant_right_CONV "V")); USE 0 (CONV_RULE (quant_right_CONV "B")); USE 0 (CONV_RULE (quant_right_CONV "A")); AND 0; UND 2; MESON_TAC[DIFF_EQ_EMPTY]; ]);; (* }}} *) let top_univ = prove_by_refinement( `!(U:(A->bool)->bool). (topology_ U) ==> (U (UNIONS U))`, (* {{{ proof *) [ REWRITE_TAC[topology]; DISCH_ALL_TAC; ASM_MESON_TAC[SUBSET_REFL]; ]);; (* }}} *) let empty_closed = prove_by_refinement( `!(U:(A->bool)->bool). (topology_ U) ==> closed_ U EMPTY`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closed;EMPTY_SUBSET;DIFF_EMPTY;open_DEF]; ASM_MESON_TAC[top_univ]; ]);; (* }}} *) let closed_open = prove_by_refinement( `!(U:(A->bool)->bool) A. (closed_ U A) ==> (open_ U ((UNIONS U) DIFF A))`, (* {{{ proof *) [ MESON_TAC[closed]; ]);; (* }}} *) let closed_inter = prove_by_refinement ( `!U V. (topology_ (U:(A->bool)->bool)) /\ (!a. (V a) ==> (closed_ U a)) /\ ~(V = EMPTY) ==> (closed_ U (INTERS V))`, (* {{{ proof *) [ REWRITE_TAC[closed]; DISCH_ALL_TAC; CONJ_TAC; MATCH_MP_TAC INTERS_SUBSET2; USE 2 (REWRITE_RULE[ EMPTY_EXISTS]); USE 2 (REWRITE_RULE[IN]); CHO 2; EXISTS_TAC `u:A->bool`; ASM_MESON_TAC[ ]; ABBREV_TAC `VCOMP = IMAGE ((DIFF) (UNIONS (U:(A->bool)->bool))) V`; UNDISCH_FIND_THEN `VCOMP` (fun t -> ASSUME_TAC (GSYM t)); SUBGOAL_THEN `(VCOMP:(A->bool)->bool) SUBSET U` ASSUME_TAC; ASM_REWRITE_TAC[SUBSET;IN_ELIM_THM;IMAGE]; REWRITE_TAC[IN]; GEN_TAC; ASM_MESON_TAC[open_DEF]; SUBGOAL_THEN `open_ U (UNIONS (VCOMP:(A->bool)->bool))` ASSUME_TAC; ASM_MESON_TAC[topology;open_DEF]; SUBGOAL_THEN ` (UNIONS U DIFF INTERS V)= (UNIONS (VCOMP:(A->bool)->bool))` (fun t-> (REWRITE_TAC[t])); ASM_REWRITE_TAC[UNIONS_INTERS]; UNDISCH_FIND_TAC `(open_)`; REWRITE_TAC[]; ]);; (* }}} *) let open_nbd = prove_by_refinement( `!U (A:A->bool). (topology_ U) ==> ((U A) = (!x. ?B. (A x ) ==> ((B SUBSET A) /\ (B x) /\ (U B))))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; GEN_TAC; EXISTS_TAC `A:A->bool`; ASM_MESON_TAC[SUBSET]; CONV_TAC (quant_left_CONV "B"); DISCH_THEN CHOOSE_TAC; USE 1 (CONV_RULE NAME_CONFLICT_CONV); TYPE_THEN `UNIONS (IMAGE B A) = A` SUBGOAL_TAC; MATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; MATCH_MP_TAC UNIONS_SUBSET; REWRITE_TAC[IN_IMAGE]; ASM_MESON_TAC[IN]; REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE]; DISCH_ALL_TAC; NAME_CONFLICT_TAC; CONV_TAC (quant_left_CONV "x'"); CONV_TAC (quant_left_CONV "x'"); EXISTS_TAC `x:A`; TYPE_THEN `B x` EXISTS_TAC ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[IN]; (* on 1*) TYPE_THEN `(IMAGE B A) SUBSET U` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN_IMAGE;]; REWRITE_TAC[IN]; NAME_CONFLICT_TAC; GEN_TAC; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; TYPE_THEN `W = IMAGE B A` ABBREV_TAC; KILL 2; ASM_MESON_TAC[topology]; ]);; (* }}} *) let open_inters = prove_by_refinement( `!U (V:(A->bool)->bool). (topology_ U) /\ (V SUBSET U) /\ (FINITE V) /\ ~(V = EMPTY) ==> (U (INTERS V))`, (* {{{ proof *) [ REP_GEN_TAC; DISCH_ALL_TAC; TYPE_THEN `(?n. V HAS_SIZE n)` SUBGOAL_TAC; REWRITE_TAC[HAS_SIZE]; ASM_MESON_TAC[]; DISCH_ALL_TAC; UND 0; UND 1; UND 2; UND 3; UND 4; CONV_TAC (quant_left_CONV "n"); TYPE_THEN `V` SPEC2_TAC ; TYPE_THEN `U` SPEC2_TAC ; CONV_TAC (quant_left_CONV "n"); CONV_TAC (quant_left_CONV "n"); INDUCT_TAC; DISCH_ALL_TAC; ASM_MESON_TAC[HAS_SIZE_0]; DISCH_ALL_TAC; TYPE_THEN `U` (USE 0 o SPEC); USE 5 (REWRITE_RULE[HAS_SIZE_SUC;EMPTY_EXISTS]); AND 5; CHO 6; TYPE_THEN `u` (USE 5 o SPEC); REWR 5; TYPE_THEN `V DELETE u` (USE 0 o SPEC); REWR 0; TYPE_THEN `V={u}` ASM_CASES_TAC; ASM_REWRITE_TAC[inters_singleton]; UND 6; UND 2; REWRITE_TAC [SUBSET;IN]; MESON_TAC[]; ALL_TAC; (* oi1 *) USE 0 (REWRITE_RULE[delete_empty]); REWR 0; USE 0 (REWRITE_RULE[FINITE_DELETE]); REWR 0; TYPE_THEN `V DELETE u SUBSET U ` SUBGOAL_TAC; ASM_MESON_TAC[DELETE_SUBSET;SUBSET_TRANS]; DISCH_ALL_TAC; REWR 0; ALL_TAC; (* oi2 *) COPY 6; USE 9 (REWRITE_RULE[IN]); USE 9 (MATCH_MP delete_inters); ASM_REWRITE_TAC[]; USE 1 (REWRITE_RULE[topology]); TYPEL_THEN [`(INTERS (V DELETE u))`;`u`;`U`] (USE 1 o ISPECL); AND 1; AND 1; UND 11; DISCH_THEN MATCH_MP_TAC ; ASM_REWRITE_TAC[]; UND 6; UND 2; REWRITE_TAC [SUBSET;IN]; ASM_MESON_TAC[]; ]);; (* }}} *) let top_unions = prove_by_refinement( `!(U:(A->bool)->bool) V. topology_ U /\ (V SUBSET U) ==> U (UNIONS V)`, (* {{{ proof *) [ MESON_TAC[topology]; ]);; (* }}} *) let top_inter = prove_by_refinement( `!(U:(A->bool)-> bool) A B. topology_ U /\ (U A) /\ (U B) ==> (U (A INTER B))`, (* {{{ proof *) [ MESON_TAC[topology]; ]);; (* }}} *) (* open and closed balls in metric spaces *) let open_ball_nonempty = prove_by_refinement( `!(X:A->bool) d a r. (metric_space (X,d)) /\ (&.0 <. r) /\ (X a) ==> (a IN (open_ball(X,d) a r))`, (* {{{ proof *) [ REWRITE_TAC[metric_space;IN_ELIM_THM;open_ball]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `( /\ )` (ASSUME_TAC o (SPECL [`a:A`;`a:A`;`a:A`])); ASM_MESON_TAC[]; ]);; (* }}} *) let open_ball_subset = prove_by_refinement( `!(X:A->bool) d a r. (open_ball (X,d) a r SUBSET X)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM]; MESON_TAC[IN]; ]);; (* }}} *) let open_ball_subspace = prove_by_refinement( `!(X:A->bool) Y d a r. (Y SUBSET X) ==> (open_ball(Y,d) a r SUBSET open_ball(X,d) a r)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM]; MESON_TAC[IN]; ]);; (* }}} *) let open_ball_empty = prove_by_refinement( `!(X:A->bool) d a r. ~(a IN X) ==> (EMPTY = open_ball (X,d) a r)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[open_ball]; MATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM;EMPTY]; ASM_MESON_TAC[IN]; ]);; (* }}} *) (*** Old proof modified by JRH to avoid GSPEC let open_ball_intersect = prove_by_refinement( `!(X:A->bool) Y d a r. (Y SUBSET X) /\ (a IN Y) ==> (open_ball(Y,d) a r = (open_ball(X,d) a r INTER Y))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;IN;INTER;open_ball]; REWRITE_TAC[GSPEC_THM]; REWRITE_TAC[IN_ELIM_THM]; REWRITE_TAC[GSPEC]; DISCH_ALL_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; BETA_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) ***) let open_ball_intersect = prove_by_refinement( `!(X:A->bool) Y d a r. (Y SUBSET X) /\ (a IN Y) ==> (open_ball(Y,d) a r = (open_ball(X,d) a r INTER Y))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;IN;INTER;open_ball]; REWRITE_TAC[EXTENSION; IN_ELIM_THM]; MESON_TAC[] ]);; (* }}} *) let open_ball_center = prove_by_refinement( `!(X:A->bool) d a b r. (metric_space (X,d)) /\ (a IN (open_ball (X,d) b r)) ==> (?r'. (&.0 <. r') /\ ((open_ball(X,d) a r') SUBSET (open_ball(X,d) b r)))`, (* {{{ proof *) [ REWRITE_TAC[metric_space;open_ball]; DISCH_ALL_TAC; EXISTS_TAC `r -. (d (a:A) (b:A))`; REWRITE_TAC[SUBSET;IN_ELIM_THM]; UNDISCH_FIND_TAC `(IN)`; REWRITE_TAC[IN_ELIM_THM]; DISCH_ALL_TAC; CONJ_TAC; REWRITE_TAC[REAL_ARITH `(&.0 < r -. s)= (s <. r)`]; ASM_MESON_TAC[]; GEN_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `(u <. v-.w) <=> (w +. u <. v)`]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UNDISCH_FIND_TAC `(!)`; DISCH_THEN (fun t-> (MP_TAC (SPECL [`b:A`;`a:A`;`x:A`] t))); ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LET_TRANS;REAL_LTE_TRANS]; ]);; (* }}} *) let open_ball_nonempty_center = prove_by_refinement( `!(X:A->bool) d a r. (metric_space(X,d)) ==> ((a IN (open_ball(X,d) a r)) = ~(open_ball(X,d) a r = EMPTY))`, (* {{{ proof *) [ REWRITE_TAC[metric_space]; DISCH_ALL_TAC; REWRITE_TAC[open_ball]; REWRITE_TAC[REWRITE_CONV[IN_ELIM_THM] `(a:A) IN { y | X a /\ X y /\ (d a y <. r)}`]; REWRITE_TAC[EXTENSION]; REWRITE_TAC[IN_ELIM_THM;NOT_IN_EMPTY;NOT_FORALL_THM]; EQ_TAC; MESON_TAC[]; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t)); UNDISCH_FIND_THEN `(+.)` (fun t -> MP_TAC (SPECL [`a:A`;`a:A`;`a:A`] t)); ASM_MESON_TAC[REAL_LET_TRANS;REAL_LTE_TRANS]; ]);; (* }}} *) (*** Old proof modified by JRH to remove apparent misnamed quantifier let open_ball_neg_radius = prove_by_refinement( `!(X:A->bool) d a r. metric_space(X,d) /\ (r <. (&.0)) ==> (EMPTY = open_ball(X,d) a r)`, (* {{{ proof *) [ REWRITE_TAC[open_ball;metric_space]; DISCH_ALL_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[EMPTY;IN_ELIM_THM]; FIRST_ASSUM (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t)); ASSUME_TAC (REAL_ARITH `!u r. ~((dd <. r) /\ (r <. (&.0)) /\ (&.0 <=. dd))`); ASM_MESON_TAC[]; ]);; (* }}} *) ***) let open_ball_neg_radius = prove_by_refinement( `!(X:A->bool) d a r. metric_space(X,d) /\ (r <. (&.0)) ==> (EMPTY = open_ball(X,d) a r)`, (* {{{ proof *) [ REWRITE_TAC[open_ball;metric_space]; DISCH_ALL_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[EMPTY;IN_ELIM_THM]; FIRST_ASSUM (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t)); ASSUME_TAC (REAL_ARITH `!d r. ~((d <. r) /\ (r <. (&.0)) /\ (&.0 <=. d))`); ASM_MESON_TAC[]; ]);; (* }}} *) let open_ball_nest = prove_by_refinement( `!(X:A->bool) d a r r'. (r <. r') ==> ((open_ball (X,d) a r) SUBSET (open_ball(X,d) a r'))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM]; MESON_TAC[REAL_ARITH `(r<. r') /\ (a <. r) ==> (a <. r')`]; ]);; (* }}} *) (* intersection of open balls contains an open ball *) let open_ball_inter = prove_by_refinement( `!(X:A->bool) d a b c r r'. (metric_space (X,d)) /\ (X a) /\ (X b) /\ (c IN (open_ball(X,d) a r INTER (open_ball(X,d) b r'))) ==> (?r''. (&.0 <. r'') /\ (open_ball(X,d) c r'') SUBSET (open_ball(X,d) a r INTER (open_ball(X,d) b r')))`, (* {{{ proof *) [ DISCH_ALL_TAC; UNDISCH_FIND_THEN `(INTER)` (fun t-> MP_TAC (REWRITE_RULE[IN_INTER] t) THEN DISCH_ALL_TAC); SUBGOAL_TAC `(X:A->bool) (c:A)`; ASM_MESON_TAC[SUBSET;open_ball_subset;IN]; DISCH_TAC; MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`;`c:A`;`b:A`;`r':real`] open_ball_center) THEN (ASM_REWRITE_TAC[]) THEN (DISCH_THEN CHOOSE_TAC); MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`;`c:A`;`a:A`;`r:real`] open_ball_center) THEN (ASM_REWRITE_TAC[]) THEN (DISCH_THEN CHOOSE_TAC); REWRITE_TAC[SUBSET_INTER]; EXISTS_TAC `(if (r'' <. r''') then (r'') else (r'''))`; COND_CASES_TAC; ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; IMP_RES_THEN DISJ_CASES_TAC (REAL_ARITH `(~(r'' <. r''')) ==> ((r''' <. r'') \/ (r'''=r''))`); ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; ASM_MESON_TAC[]; ]);; (* }}} *) let BALL_DIST = prove_by_refinement( `!X d x y (z:A) r. metric_space(X,d) /\ open_ball(X,d) z r x /\ open_ball(X,d) z r y ==> d x y <. (&.2 * r)`, (* {{{ proof *) [ REWRITE_TAC[metric_space;open_ball;IN_ELIM_THM']; DISCH_ALL_TAC; USE 0 (SPECL [`x:A`;`z:A`;`y:A`]); REWR 0; UND 0 THEN DISCH_ALL_TAC; UND 9; UND 6; ASM_REWRITE_TAC[]; UND 3; REAL_ARITH_TAC; ]);; (* }}} *) let BALL_DIST_CLOSED = prove_by_refinement( `!X d x y (z:A) r. metric_space(X,d) /\ closed_ball(X,d) z r x /\ closed_ball(X,d) z r y ==> d x y <=. (&.2 * r)`, (* {{{ proof *) [ REWRITE_TAC[metric_space;closed_ball;IN_ELIM_THM']; DISCH_ALL_TAC; USE 0 (SPECL [`x:A`;`z:A`;`y:A`]); REWR 0; UND 0 THEN DISCH_ALL_TAC; UND 9; UND 6; ASM_REWRITE_TAC[]; UND 3; REAL_ARITH_TAC; ]);; (* }}} *) let open_ball_sub_closed = prove_by_refinement( `!X d (x:A) r. (open_ball(X,d) x r SUBSET (closed_ball(X,d) x r))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[SUBSET;IN;open_ball;closed_ball;IN_ELIM_THM']; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 2; REAL_ARITH_TAC; ]);; (* }}} *) let ball_symm = prove_by_refinement( `!X d (x:A) y r. metric_space(X,d) /\ (X x) /\ (X y) ==> (open_ball(X,d) x r y = open_ball(X,d) y r x)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC [open_ball;IN_ELIM_THM']; ASM_REWRITE_TAC[]; ASM_MESON_TAC [metric_space_symm]; ]);; (* }}} *) let ball_subset_ball = prove_by_refinement( `!X d (x:A) z r. metric_space(X,d) /\ (open_ball(X,d) x r z ) ==> (open_ball(X,d) z r SUBSET (open_ball(X,d) x (&.2 * r)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[SUBSET;IN]; DISCH_ALL_TAC; REWRITE_TAC[open_ball;IN_ELIM_THM']; TYPE_THEN `X z /\ X x' /\ X x` SUBGOAL_TAC ; UND 2; UND 1; REWRITE_TAC[open_ball;IN_ELIM_THM']; MESON_TAC[]; DISCH_ALL_TAC; TYPE_THEN `open_ball(X,d) z r x` SUBGOAL_TAC; ASM_MESON_TAC[ball_symm]; ASM_MESON_TAC[BALL_DIST]; ]);; (* }}} *) (* top_of_metric *) let top_of_metric_unions = prove_by_refinement( `!(X:A->bool) d. (metric_space (X,d)) ==> (X = UNIONS (top_of_metric (X,d)))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_TAC; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC; REWRITE_TAC[SUBSET]; REWRITE_TAC[IN_UNIONS;top_of_metric]; DISCH_ALL_TAC; EXISTS_TAC `open_ball(X,d) (x:A) (&.1)`; UNDISCH_TAC `(x:A) IN X` THEN (REWRITE_TAC[IN_ELIM_THM]); DISCH_ALL_TAC; CONJ_TAC; EXISTS_TAC `{(open_ball(X,d) (x:A) (&.1))}`; REWRITE_TAC[GSYM UNIONS_1;INSERT_SUBSET;EMPTY_SUBSET]; REWRITE_TAC[open_balls;IN_ELIM_THM]; MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM;open_ball]; UNDISCH_FIND_TAC `(IN)`; ASM_REWRITE_TAC[IN]; DISCH_TAC; ASM_REWRITE_TAC[]; UNDISCH_FIND_TAC `metric_space`; REWRITE_TAC[metric_space]; DISCH_THEN (fun t -> MP_TAC (ISPECL [`x:A`;`x:A`;`x:A`] t)); ASM_MESON_TAC[REAL_ARITH `(&.0) <. (&.1)`]; MATCH_MP_TAC UNIONS_SUBSET; GEN_TAC; REWRITE_TAC[top_of_metric;IN_ELIM_THM]; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC UNIONS_SUBSET; X_GEN_TAC `B:A->bool`; DISCH_TAC; SUBGOAL_TAC `(B:A->bool) IN open_balls (X,d)`; ASM SET_TAC[]; REWRITE_TAC[open_balls;IN_ELIM_THM]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_THEN (CHOOSE_THEN ASSUME_TAC); ASM_REWRITE_TAC[]; REWRITE_TAC[open_ball;SUBSET;IN_ELIM_THM]; MESON_TAC[IN]; ]);; (* }}} *) let top_of_metric_empty = prove_by_refinement( `!(X:A->bool) d. ( (top_of_metric (X,d)) EMPTY)`, (* {{{ proof *) [ REWRITE_TAC[top_of_metric]; REPEAT GEN_TAC; REWRITE_TAC[IN_ELIM_THM]; EXISTS_TAC `EMPTY:(A->bool)->bool`; REWRITE_TAC[UNIONS_0;EMPTY_SUBSET]; ]);; (* }}} *) let top_of_metric_open = prove_by_refinement( `!(X:A->bool) d F. (F SUBSET (open_balls (X,d))) ==> ((UNIONS F) IN (top_of_metric(X,d)))`, (* {{{ proof *) [ REWRITE_TAC[top_of_metric;IN_ELIM_THM]; MESON_TAC[]; ]);; (* }}} *) let top_of_metric_open_balls = prove_by_refinement( `!(X:A->bool) d. (open_balls (X,d)) SUBSET (top_of_metric(X,d))`, (* {{{ proof *) [ REWRITE_TAC[SUBSET]; REWRITE_TAC[top_of_metric;IN_ELIM_THM]; DISCH_ALL_TAC; EXISTS_TAC `{(x:A->bool)}`; ASM SET_TAC[]; ]);; (* }}} *) let open_ball_open = prove_by_refinement( `! (X:A->bool) d x r. (metric_space(X,d)) ==> (top_of_metric (X,d) (open_ball (X,d) x r)) `, (* {{{ proof *) [ DISCH_ALL_TAC; TYPEL_THEN [`X`;`d`] (fun t-> ASSUME_TAC ( ISPECL t top_of_metric_open_balls)); USE 1 (REWRITE_RULE[open_balls;SUBSET;IN_ELIM_THM']); ASM_MESON_TAC[IN]; ]);; (* }}} *) (* a set is open then every point contains a ball *) let top_of_metric_nbd = prove_by_refinement( `!(X:A->bool) d A. (metric_space (X,d)) ==> ((top_of_metric (X,d) A) <=> ((A SUBSET X) /\ (!a. (a IN A) ==> (?r. (&.0 <. r) /\ (open_ball(X,d) a r SUBSET A)))))`, (* {{{ proof *) [ (DISCH_ALL_TAC); EQ_TAC; REWRITE_TAC[top_of_metric;IN_ELIM_THM]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; CONJ_TAC; IMP_RES_THEN ASSUME_TAC top_of_metric_unions; ASM_REWRITE_TAC[]; IMP_RES_THEN ASSUME_TAC top_of_metric_open; ASM ONCE_REWRITE_TAC[]; MATCH_MP_TAC UNIONS_UNIONS; ASM_MESON_TAC[SUBSET_TRANS;top_of_metric_open_balls]; DISCH_ALL_TAC THEN (ASM_REWRITE_TAC[]); REWRITE_TAC[IN_UNIONS;UNIONS_SUBSET]; UNDISCH_FIND_TAC `(IN)`; ASM_REWRITE_TAC[]; REWRITE_TAC[IN_UNIONS]; DISCH_THEN (CHOOSE_THEN ASSUME_TAC); SUBGOAL_TAC `(t IN open_balls (X:A->bool,d))`; ASM_MESON_TAC[SUBSET]; REWRITE_TAC[open_balls;IN_ELIM_THM]; REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)); DISCH_TAC; MP_TAC (SPECL[`(X:A->bool)`; `d:A->A->real`;`a:A`;`x:A`;`r:real`] open_ball_center); ASM_REWRITE_TAC[]; SUBGOAL_TAC `(a:A) IN open_ball(X,d) x r`; ASM_MESON_TAC[]; DISCH_TAC THEN (ASM_REWRITE_TAC[]); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `r':real`; ASM_REWRITE_TAC[]; (* to here *) SUBGOAL_TAC `!s. ((s:A->bool) IN F') ==> (s SUBSET (UNIONS F'))`; SET_TAC[]; ASM_MESON_TAC[SUBSET_TRANS] ; (*second direction: *) DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT1 t) THEN MP_TAC (CONJUNCT2 t)); DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[RIGHT_IMP_EXISTS_THM] t)); REWRITE_TAC[SKOLEM_THM]; DISCH_THEN CHOOSE_TAC; REWRITE_TAC[top_of_metric;IN_ELIM_THM]; EXISTS_TAC `IMAGE (\b. (open_ball(X,d) b (r b))) (A:A->bool)`; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET]; REWRITE_TAC[IN_ELIM_THM;open_balls]; MESON_TAC[IN]; REWRITE_TAC[IMAGE]; GEN_REWRITE_TAC I [EXTENSION]; X_GEN_TAC `a:A`; REWRITE_TAC[IN_UNIONS]; REWRITE_TAC[IN_ELIM_THM]; EQ_TAC; DISCH_TAC; EXISTS_TAC `open_ball (X,d) (a:A) (r a)`; CONJ_TAC; EXISTS_TAC `a:A`; ASM_REWRITE_TAC[]; REWRITE_TAC[IN;open_ball]; REWRITE_TAC[IN_ELIM_THM]; ASM_MESON_TAC[metric_space_zero;IN;SUBSET]; (* last: *) DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; UNDISCH_FIND_TAC `(?)` ; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; UNDISCH_FIND_TAC `(!)`; DISCH_THEN (fun t -> MP_TAC(SPEC `x:A` t)); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; ASM_MESON_TAC[SUBSET;IN]; ]);; (* }}} *) let top_of_metric_inter = prove_by_refinement( `!(X:A->bool) d. (metric_space (X,d)) ==> (!A B. (top_of_metric (X,d) A) /\ (top_of_metric (X,d) B) ==> (top_of_metric (X,d) (A INTER B)))`, (* {{{ proof *) [ DISCH_ALL_TAC; DISCH_ALL_TAC; IMP_RES_THEN ASSUME_TAC (SPECL [`X:A->bool`;`d:A->A->real`] top_of_metric_nbd); UNDISCH_TAC `(top_of_metric (X,d) (B:A->bool))`; UNDISCH_TAC `(top_of_metric (X,d) (A:A->bool))`; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; DISCH_ALL_TAC; CONJ_TAC; ASM SET_TAC[]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `(INTER)` (fun t-> (MP_TAC (REWRITE_RULE[IN_INTER]t)) THEN DISCH_ALL_TAC ); UNDISCH_FIND_THEN `(IN)` (fun t-> ANTE_RES_THEN MP_TAC t); UNDISCH_FIND_THEN `(IN)` (fun t-> ANTE_RES_THEN MP_TAC t); DISCH_THEN CHOOSE_TAC; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `if (r<. r') then r else r'`; COND_CASES_TAC; ASM_REWRITE_TAC[SUBSET_INTER]; ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; MP_TAC (ARITH_RULE `~(r<.r') ==> ((r'<. r) \/ (r'=r))`) THEN (ASM_REWRITE_TAC[]); DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[SUBSET_INTER]; ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; ASM_MESON_TAC[SUBSET_INTER]; ]);; (* }}} *) let top_of_metric_union = prove_by_refinement( `!(X:A->bool) d. (metric_space(X,d)) ==> (!V. (V SUBSET top_of_metric(X,d)) ==> (top_of_metric(X,d) (UNIONS V)))`, (* {{{ proof *) [ DISCH_ALL_TAC; MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`] top_of_metric_nbd); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); DISCH_ALL_TAC; CONJ_TAC; ASM_MESON_TAC[UNIONS_UNIONS;top_of_metric_unions]; GEN_TAC; REWRITE_TAC[IN_UNIONS]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; SUBGOAL_TAC `(top_of_metric (X,d)) (t:A->bool)`; ASM_MESON_TAC[IN;SUBSET]; MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`] top_of_metric_nbd); ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `(!)` (fun t -> MP_TAC (SPEC `a:A` t)); ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `r:real`; ASM_REWRITE_TAC[]; ASM SET_TAC[UNIONS]; ]);; (* }}} *) let top_of_metric_top = prove_by_refinement( `!(X:A->bool) d. ( (metric_space (X,d))) ==> (topology_ (top_of_metric (X,d)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[topology]; REPEAT GEN_TAC; ASM_SIMP_TAC[top_of_metric_empty;top_of_metric_inter;top_of_metric_union]; ]);; (* }}} *) let closed_ball_closed = prove_by_refinement( `!X d (x:A) r. (metric_space (X,d)) ==> (closed_ (top_of_metric(X,d)) (closed_ball(X,d) x r))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `X x` ASM_CASES_TAC ; REWRITE_TAC[closed]; ASM_SIMP_TAC [GSYM top_of_metric_unions]; SUBCONJ_TAC; REWRITE_TAC[closed_ball;SUBSET;IN;IN_ELIM_THM']; MESON_TAC[]; DISCH_ALL_TAC; REWRITE_TAC[open_DEF]; COPY 0; USE 0 (MATCH_MP top_of_metric_top); ONCE_ASM_SIMP_TAC[open_nbd]; GEN_TAC; TYPE_THEN `open_ball(X,d) x' (d x x' -. r)` EXISTS_TAC; TYPE_THEN `R = (d x x' -. r)` ABBREV_TAC; DISCH_ALL_TAC; TYPE_THEN `X x'` SUBGOAL_TAC; USE 5 (REWRITE_RULE[INR IN_DIFF]); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; SUBCONJ_TAC; REWRITE_TAC[DIFF_SUBSET;open_ball_subset;INTER;EQ_EMPTY;IN_ELIM_THM']; X_GEN_TAC `y:A`; REWRITE_TAC[IN]; ASM_REWRITE_TAC[open_ball;closed_ball]; REWRITE_TAC[IN_ELIM_THM';GSYM CONJ_ASSOC]; PROOF_BY_CONTR_TAC; USE 7 (REWRITE_RULE[]); AND 7; REWR 7; COPY 3; USE 3 (REWRITE_RULE[metric_space]); TYPEL_THEN [`x`;`y`;`x'`] (USE 3 o SPECL); REWR 3; ALL_TAC; (* "bb"; *) TYPE_THEN `d x' y = d y x'` SUBGOAL_TAC; TYPEL_THEN [`X`;`d`] (fun t-> MATCH_MP_TAC (SPECL t metric_space_symm)); ASM_REWRITE_TAC[]; DISCH_TAC; UND 7; UND 10; AND 3; AND 3; AND 3; UND 3; EXPAND_TAC "R"; ALL_TAC; (* "cb" *) REAL_ARITH_TAC; ALL_TAC; (* "cbc" *) DISCH_TAC; ASM_SIMP_TAC [open_ball_open]; MATCH_MP_TAC (INR open_ball_nonempty); ASM_REWRITE_TAC[]; EXPAND_TAC "R"; PROOF_BY_CONTR_TAC; USE 8 (MATCH_MP (REAL_ARITH `~(&.0 < d x x' - r) ==> (d x x' <=. r)`)); USE 5 (REWRITE_RULE[INR IN_DIFF;closed_ball;IN_ELIM_THM']); ASM_MESON_TAC[]; TYPE_THEN `(closed_ball (X,d) x r) = EMPTY` SUBGOAL_TAC; (**** Old step changed by JRH for modified set comprehensions ASM_REWRITE_TAC[closed_ball;EMPTY;GSPEC]; ***) ASM_REWRITE_TAC[closed_ball;IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY]; DISCH_THEN (REWRT_TAC); ALL_TAC; (* "cbc1" *) ASM_MESON_TAC[empty_closed;top_of_metric_top]; ]);; (* }}} *) let open_ball_nbd = prove_by_refinement( `!X d C x. ?e. (metric_space((X:A->bool),d)) /\ (C x) /\ (top_of_metric (X,d) C) ==> ((&.0 < e) /\ (open_ball (X,d) x e SUBSET C))`, (* {{{ proof *) [ DISCH_ALL_TAC; RIGHT_TAC "e"; DISCH_ALL_TAC; USE 2 (REWRITE_RULE[top_of_metric;open_balls;IN_ELIM_THM';SUBSET;IN ]); CHO 2; AND 2; ASM_REWRITE_TAC[]; REWR 1; USE 1 (REWRITE_RULE[UNIONS;IN;IN_ELIM_THM' ]); CHO 1; TYPE_THEN `u` (USE 3 o SPEC); REWR 3; CHO 3; CHO 3; REWR 1; TYPEL_THEN [`X`;`d`;`x`;`x'`;`r`] (fun t-> (ASSUME_TAC (ISPECL t open_ball_center))); USE 4 (REWRITE_RULE[IN ]); REWR 4; CHO 4; TYPE_THEN `r'` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;UNIONS;IN;IN_ELIM_THM']; DISCH_ALL_TAC; AND 4; USE 4 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']); ASM_MESON_TAC[]; ]);; (* }}} *) (* closure *) let closure_closed = prove_by_refinement( `!U (A:A->bool). (topology_ U) /\ (A SUBSET (UNIONS U)) ==> (closed_ U (closure U A))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closure]; MATCH_MP_TAC closed_inter; REWRITE_TAC[IN_ELIM_THM]; ASM_REWRITE_TAC[]; CONJ_TAC; MESON_TAC[]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `UNIONS U` EXISTS_TAC; ASM_REWRITE_TAC[IN_ELIM_THM']; ASM_SIMP_TAC[closed_UNIV]; ]);; (* }}} *) let subset_closure = prove_by_refinement( `!U (A:A->bool). (topology_ U) ==> (A SUBSET (closure U A))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closure;SUBSET;IN_INTERS;IN_ELIM_THM]; X_GEN_TAC `a:A`; MESON_TAC[IN]; ]);; (* }}} *) let closure_subset = prove_by_refinement( `!U (A:A->bool) B. (topology_ U) /\ (closed_ U B) /\ (A SUBSET B) ==> (closure U A SUBSET B)`, (* {{{ proof *) [ REWRITE_TAC[closure]; DISCH_ALL_TAC; MATCH_MP_TAC INTERS_SUBSET; ASM_REWRITE_TAC[IN_ELIM_THM]; ]);; (* }}} *) let closure_self = prove_by_refinement( `!U (A:A->bool). (topology_ U) /\ (closed_ U A) ==> (closure U A = A)`, (* {{{ proof *) [ DISCH_ALL_TAC; MATCH_MP_TAC SUBSET_ANTISYM; ASM_SIMP_TAC[subset_closure]; ASM_SIMP_TAC[closure_subset;SUBSET_REFL]; ]);; (* }}} *) let closure_close = prove_by_refinement( `!U Z (A:A->bool). (topology_ U) /\ (Z SUBSET (UNIONS U)) ==> ((A = closure U Z) = ((Z SUBSET A) /\ (closed_ U A) /\ (!B. (closed_ U B) /\ ((Z SUBSET B)) ==> (A SUBSET B))))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_THEN (REWRT_TAC); ASM_SIMP_TAC[subset_closure;closure_closed;closure_subset]; DISCH_ALL_TAC; REWRITE_TAC [closure]; MATCH_MP_TAC (SUBSET_ANTISYM); CONJ_TAC; REWRITE_TAC[SUBSET_INTERS]; REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[]; MATCH_MP_TAC INTERS_SUBSET; REWRITE_TAC[IN_ELIM_THM']; ASM_REWRITE_TAC[]; ]);; (* }}} *) let closure_open = prove_by_refinement( `!U Z (A:A->bool). (topology_ U) /\ (Z SUBSET (UNIONS U)) ==> ((A = closure U Z) = ((Z SUBSET A) /\ (closed_ U A) /\ (!B. (open_ U B) /\ ((B INTER Z) = EMPTY) ==> ((B INTER A) = EMPTY))))`, (* {{{ proof *) [ REP_GEN_TAC; DISCH_TAC; ASM_SIMP_TAC[closure_close]; MATCH_MP_TAC (TAUT `( A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`); DISCH_TAC; MATCH_MP_TAC (TAUT `( A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`); DISCH_TAC; EQ_TAC; DISCH_TAC; USE 2 (REWRITE_RULE[closed]); ASM_REWRITE_TAC[]; GEN_TAC; USE 3 (SPEC `(UNIONS U) DIFF (B:A->bool)`); DISCH_ALL_TAC; UND 3; ASM_SIMP_TAC[open_closed]; ASM_REWRITE_TAC[DIFF_SUBSET]; DISCH_TAC; UND 5; UND 3; REWRITE_TAC[INTER_COMM]; ALL_TAC; (* co1 *) DISCH_ALL_TAC; DISCH_ALL_TAC; USE 3 (SPEC `(UNIONS U) DIFF (B:A->bool)`); UND 3; ASM_SIMP_TAC[closed_open]; REWRITE_TAC[DIFF_INTER]; ASM_SIMP_TAC[SUB_IMP_INTER]; TYPE_THEN `A SUBSET (UNIONS U INTER A)` SUBGOAL_TAC; USE 2 (REWRITE_RULE[closed]); AND 2; UND 3; ALL_TAC; (* co2 *) SET_TAC[SUBSET;INTER]; MESON_TAC [SUBSET_TRANS]; ]);; (* }}} *) (* induced topology *) let image_top = prove_by_refinement( `!(U:(A->bool)->bool) (f:(A->bool)->(B->bool)). ((topology_ U) /\ (EMPTY = f EMPTY) /\ (!a b. (a IN U) /\ (b IN U) ==> (((f a) INTER (f b)) = f (a INTER b))) /\ (!V. (V SUBSET U) ==> (UNIONS (IMAGE f V) =f (UNIONS V) ))) ==> (topology_ (IMAGE f U))`, (* {{{ proof *) [ REWRITE_TAC[topology]; DISCH_ALL_TAC; DISCH_ALL_TAC; CONJ_TAC; REWRITE_TAC[IMAGE;IN]; REWRITE_TAC[IN_ELIM_THM]; ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC[IMAGE;IN]; REWRITE_TAC[IN_ELIM_THM]; DISCH_ALL_TAC; REPEAT (UNDISCH_FIND_THEN `(?)` CHOOSE_TAC); ASM_REWRITE_TAC[]; EXISTS_TAC `(x:A->bool) INTER x'`; ASM_SIMP_TAC[IN]; DISCH_THEN (fun t-> MP_TAC (MATCH_MP SUBSET_PREIMAGE t)); DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[]; REWRITE_TAC[IMAGE;IN_ELIM_THM]; EXISTS_TAC `UNIONS (Z:(A->bool)->bool)`; ASM_SIMP_TAC[IN]; ]);; (* }}} *) let induced_top_support = prove_by_refinement( `!U (C:A->bool). (UNIONS (induced_top U C) = ((UNIONS U) INTER C))`, (* {{{ proof *) [ REWRITE_TAC[UNIONS_INTER]; DISCH_ALL_TAC; AP_TERM_TAC; REWRITE_TAC[induced_top]; AP_THM_TAC; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT THEN BETA_TAC; SET_TAC[]; ]);; (* }}} *) let induced_top_top = prove_by_refinement( `!U (C:A->bool). (topology_ U) ==> (topology_ (induced_top U C))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_TAC; REWRITE_TAC[induced_top]; MATCH_MP_TAC image_top; ASM_REWRITE_TAC[]; CONJ_TAC; SET_TAC[]; CONJ_TAC; SET_TAC[]; REWRITE_TAC[UNIONS_INTER]; DISCH_ALL_TAC; AP_TERM_TAC; AP_THM_TAC; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT THEN BETA_TAC; SET_TAC[]; ]);; (* }}} *) let induced_top_open = prove_by_refinement( `!U (C:A->bool) A. (topology_ U) ==> (induced_top U C A = (?B. (U B) /\ ((B INTER C) = A)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[induced_top;IMAGE]; REWRITE_TAC[IN_ELIM_THM]; MESON_TAC[IN]; ]);; (* }}} *) let induced_trans = prove_by_refinement( `! U (A:A->bool) B. (topology_ U) /\ U A /\ (induced_top U A B) ==> (U B)`, (* {{{ proof *) [ REWRITE_TAC[induced_top;IMAGE;IN ;IN_ELIM_THM' ]; DISCH_ALL_TAC; CHO 2; ASM_MESON_TAC[top_inter]; ]);; (* }}} *) let induced_top_unions = prove_by_refinement( `!(U:(A->bool)->bool). (topology_ U) ==> ((induced_top U (UNIONS U)) = U)`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; GEN_TAC; ASM_SIMP_TAC[induced_top_open]; EQ_TAC; DISCH_ALL_TAC; CHO 1; USE 0 (REWRITE_RULE[topology]); TYPE_THEN `B SUBSET (UNIONS U)` SUBGOAL_TAC; ASM_MESON_TAC[sub_union ]; REWRITE_TAC[SUBSET_INTER_ABSORPTION]; DISCH_TAC ; ASM_MESON_TAC[]; DISCH_TAC ; TYPE_THEN `x` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `x SUBSET (UNIONS U)` SUBGOAL_TAC; ASM_MESON_TAC[sub_union ]; REWRITE_TAC[SUBSET_INTER_ABSORPTION]; ]);; (* }}} *) (* induced metric *) let gen = euclid_def `gen (X:(A->bool)->bool) = {A | ?Y. (Y SUBSET X) /\ (A = UNIONS Y)}`;; let top_of_metric_gen = prove_by_refinement( `!(X:(A)->bool) d. gen (open_balls(X,d))= (top_of_metric(X,d))`, (* {{{ proof *) [ REWRITE_TAC[gen;top_of_metric]; ]);; (* }}} *) let gen_subset = prove_by_refinement( `!U (V:(A->bool)->bool). (U SUBSET V) /\ (!A. (A IN V) ==> (?Y. (Y SUBSET U) /\ (A = UNIONS Y))) ==> (gen U = (gen V))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[EXTENSION]; GEN_TAC THEN EQ_TAC; REWRITE_TAC[IN_ELIM_THM;gen]; DISCH_THEN CHOOSE_TAC; ASM_MESON_TAC[SUBSET_TRANS]; REWRITE_TAC[IN_ELIM_THM;gen]; DISCH_THEN CHOOSE_TAC; UNDISCH_FIND_THEN `(?)` (fun t-> MP_TAC(REWRITE_RULE[RIGHT_IMP_EXISTS_THM;SKOLEM_THM]t)); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `UNIONS (IMAGE (Y':(A->bool)->((A->bool)->bool)) (Y:(A->bool)->bool))`; CONJ_TAC; MATCH_MP_TAC UNIONS_SUBSET; REWRITE_TAC[IN_IMAGE]; GEN_TAC; DISCH_THEN CHOOSE_TAC; ASM_MESON_TAC[IN;SUBSET]; ASM_REWRITE_TAC[]; REWRITE_TAC[UNIONS_IMAGE_UNIONS]; AP_TERM_TAC; REWRITE_TAC[GSYM IMAGE_o]; REWRITE_TAC[EXTENSION]; X_GEN_TAC `A:(A->bool)`; REWRITE_TAC[IN_IMAGE;o_THM]; ASM_MESON_TAC[SUBSET;IN]; ]);; (* }}} *) let gen_subspace = prove_by_refinement( `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space(X,d)) ==> (induced_top (top_of_metric(X,d)) Y = gen (induced_top (open_balls(X,d)) Y))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[induced_top]; REWRITE_TAC[EXTENSION]; X_GEN_TAC `B:A->bool`; REWRITE_TAC[IN_IMAGE]; EQ_TAC; DISCH_THEN (X_CHOOSE_TAC `C:A->bool`); FIRST_ASSUM MP_TAC; REWRITE_TAC[top_of_metric]; REWRITE_TAC[IN_ELIM_THM]; DISCH_ALL_TAC; UNDISCH_FIND_TAC `(?)`; DISCH_THEN (CHOOSE_TAC); UNDISCH_FIND_TAC `(INTER)`; ASM_REWRITE_TAC[UNIONS_INTER]; REWRITE_TAC[gen;IN_ELIM_THM]; EXISTS_TAC `IMAGE ((INTER) Y) (F':(A->bool)->bool)`; CONJ_TAC; REWRITE_TAC[INTER_THM]; MATCH_MP_TAC IMAGE_SUBSET; ASM_REWRITE_TAC[]; REFL_TAC; REWRITE_TAC[gen;IN_ELIM_THM]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; IMP_RES_THEN MP_TAC SUBSET_PREIMAGE; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `UNIONS (Z:(A->bool)->bool)`; CONJ_TAC; REWRITE_TAC[UNIONS_INTER]; UNDISCH_FIND_THEN `(UNIONS)` (fun t -> REWRITE_TAC[t]); AP_TERM_TAC; UNDISCH_FIND_TAC `(SUBSET)`; REWRITE_TAC[INTER_THM]; ASM_MESON_TAC[]; REWRITE_TAC[top_of_metric;IN_ELIM_THM]; ASM_MESON_TAC[]; ]);; (* }}} *) let gen_induced = prove_by_refinement( `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space (X,d)) ==> (gen (open_balls(Y,d)) = gen (induced_top (open_balls(X,d)) Y))`, (* {{{ proof *) [ DISCH_ALL_TAC; MATCH_MP_TAC gen_subset; CONJ_TAC; REWRITE_TAC[induced_top;SUBSET;open_balls]; REWRITE_TAC [IN_IMAGE]; X_GEN_TAC `A:(A->bool)`; REWRITE_TAC[IN_ELIM_THM]; REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)); DISCH_TAC; ASM_REWRITE_TAC[]; ASM_CASES_TAC `(Y:A->bool) (x:A)`; CONV_TAC (relabel_bound_conv); EXISTS_TAC `open_ball (X,d) (x:A) r`; CONJ_TAC; MATCH_MP_TAC open_ball_intersect; ASM_MESON_TAC[IN]; MESON_TAC[]; EXISTS_TAC `open_ball (X,d) (x:A) (--. (&.1))`; CONJ_TAC; ASM_MESON_TAC[IN;INTER_EMPTY;open_ball_empty;open_ball_neg_radius;REAL_ARITH `(--.(&.1) <. (&.0))`]; MESON_TAC[]; (* end of first half *) REWRITE_TAC[induced_top;IN_IMAGE]; GEN_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); NAME_CONFLICT_TAC; REWRITE_TAC[IN;open_balls]; REWRITE_TAC[IN_ELIM_THM']; NAME_CONFLICT_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (CHOOSE_THEN ASSUME_TAC); FIRST_ASSUM (CHOOSE_THEN ASSUME_TAC); SUBGOAL_TAC `!(a:A). (a IN x INTER Y) ==> (?r. ((&.0) <. r) /\ open_ball(Y,d) a r SUBSET (x INTER Y))`; DISCH_ALL_TAC; TYPEL_THEN [`X`;`d`;`a`;`x'`;`r'`] (fun t -> (CLEAN_ASSUME_TAC (ISPECL t open_ball_center))); SUBGOAL_TAC `(a:A) IN open_ball(X,d) x' r'`; ASM_MESON_TAC[IN_INTER]; DISCH_THEN (fun t -> ANTE_RES_THEN (MP_TAC) t); DISCH_THEN (CHOOSE_TAC); EXISTS_TAC `r'':real`; ASM_REWRITE_TAC[SUBSET_INTER;open_ball_subset]; ASM_MESON_TAC[open_ball_subspace;SUBSET_TRANS]; DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[RIGHT_IMP_EXISTS_THM;SKOLEM_THM] t)); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `IMAGE (\t. open_ball(Y,d) t (r t) ) ((x:A->bool) INTER Y)`; REWRITE_TAC[SUBSET_INTER]; CONJ_TAC; REWRITE_TAC[SUBSET;IN_ELIM_THM']; REWRITE_TAC[IN_IMAGE]; GEN_TAC; MESON_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[SUBSET]; GEN_TAC; REWRITE_TAC[IN_UNIONS]; DISCH_TAC; EXISTS_TAC `open_ball (Y,d) (x'':A) (r x'')`; REWRITE_TAC[IN_IMAGE]; CONJ_TAC; NAME_CONFLICT_TAC; EXISTS_TAC `x'':A`; ASM_REWRITE_TAC[]; MATCH_MP_TAC open_ball_nonempty; ASM_SIMP_TAC[metric_subspace]; ASM_MESON_TAC[IN_INTER;IN;metric_subspace]; MATCH_MP_TAC UNIONS_SUBSET; GEN_TAC; REWRITE_TAC[IN_IMAGE]; DISCH_THEN CHOOSE_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let top_of_metric_induced = prove_by_refinement( `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space(X,d)) ==> (induced_top (top_of_metric(X,d)) Y = (top_of_metric(Y,d)))`, (* {{{ proof *) [ SIMP_TAC[gen_subspace]; REPEAT GEN_TAC; REWRITE_TAC[GSYM top_of_metric_gen]; MESON_TAC[gen_induced]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Continuity *) (* ------------------------------------------------------------------ *) let continuous = euclid_def `continuous (f:A->B) U V <=> !v. (v IN V) ==> (preimage (UNIONS U) f v) IN U`;; let metric_continuous_pt = euclid_def `metric_continuous_pt (f:A->B) (X,dX) ((Y:B->bool),dY) x = !epsilon. ?delta. (((&.0) < epsilon) ==> ((&.0) <. delta) /\ (!y. ((x IN X) /\ (y IN X) /\ (dX x y) <. delta) ==> (dY (f x) (f y) <. epsilon)))`;; let metric_continuous = euclid_def `metric_continuous (f:A->B) (X,dX) (Y,dY) <=> !x. metric_continuous_pt f (X,dX) (Y,dY) x`;; let metric_continuous_pt_domain = prove_by_refinement(`!f X dX Y dY x . ~(x IN X) ==> (metric_continuous_pt (f:A->B) (X,dX) (Y,dY) x)`, (* {{{ proof *) [ REWRITE_TAC[metric_continuous_pt]; MESON_TAC[]; ]);; (* }}} *) let metric_continuous_continuous = prove_by_refinement( `!f X Y dX dY. (IMAGE f X SUBSET Y) /\ (metric_space(X,dX)) /\ (metric_space(Y,dY)) ==> (continuous (f:A->B) (top_of_metric(X,dX)) (top_of_metric(Y,dY)) <=> (metric_continuous f (X,dX) (Y,dY)))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; REWRITE_TAC[continuous;metric_continuous]; DISCH_TAC; GEN_TAC; ASM_CASES_TAC `(x:A) IN X` THENL[ALL_TAC;ASM_SIMP_TAC[metric_continuous_pt_domain]]; REWRITE_TAC[metric_continuous_pt]; GEN_TAC; SUBGOAL_TAC `(open_ball (Y,dY) ((f:A->B) x) epsilon) IN (top_of_metric(Y,dY))`; MATCH_MP_TAC (prove_by_refinement(`!(x:A) B. (?A. (x IN A /\ A SUBSET B)) ==> (x IN B)`,[SET_TAC[]])); EXISTS_TAC `open_balls((Y:B->bool),dY)`; REWRITE_TAC[top_of_metric_open_balls]; REWRITE_TAC[open_balls;IN_ELIM_THM']; MESON_TAC[]; DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]; DISCH_TAC; SUBGOAL_TAC `(x:A) IN preimage (UNIONS (top_of_metric (X,dX))) f (open_ball (Y,dY) ((f:A->B) x) epsilon)`; REWRITE_TAC[in_preimage]; SUBGOAL_TAC `(Y:B->bool) ((f:A->B) x )`; UNDISCH_FIND_TAC `IMAGE`; UNDISCH_TAC `(x:A) IN X`; REWRITE_TAC[SUBSET;IMAGE]; REWRITE_TAC[IN_ELIM_THM']; NAME_CONFLICT_TAC; REWRITE_TAC[IN]; MESON_TAC[]; ASM_MESON_TAC[top_of_metric_unions;open_ball_nonempty]; ABBREV_TAC `B = preimage (UNIONS (top_of_metric (X,dX))) (f:A->B) (open_ball (Y,dY) (f x) epsilon)`; DISCH_TAC; SUBGOAL_TAC `?r. (&.0 <. r) /\ (open_ball(X,dX) (x:A) r SUBSET B)`; ASSUME_TAC top_of_metric_nbd; ASM_MESON_TAC[IN]; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `r:real`; ASM_REWRITE_TAC[]; GEN_TAC; DISCH_ALL_TAC; SUBGOAL_TAC `y:A IN B`; MATCH_MP_TAC (prove_by_refinement(`!(x:A) B. (?A. (x IN A /\ A SUBSET B)) ==> (x IN B)`,[SET_TAC[]])); EXISTS_TAC `open_ball(X,dX) (x:A) r`; ASM_REWRITE_TAC[]; REWRITE_TAC[open_ball;IN_ELIM_THM']; ASM_MESON_TAC[IN]; UNDISCH_FIND_TAC `preimage`; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); REWRITE_TAC[in_preimage]; REWRITE_TAC[open_ball;IN_ELIM_THM']; MESON_TAC[]; (* first half done *) REWRITE_TAC[metric_continuous]; DISCH_TAC; REWRITE_TAC[continuous]; GEN_TAC; DISCH_TAC; REWRITE_TAC[IN]; ASM_SIMP_TAC[top_of_metric_nbd]; ASM_SIMP_TAC[GSYM top_of_metric_unions]; CONJ_TAC; REWRITE_TAC[SUBSET;in_preimage]; MESON_TAC[]; GEN_TAC; DISCH_THEN (fun t -> ASSUME_TAC t THEN (MP_TAC (REWRITE_RULE[in_preimage] t))); DISCH_ALL_TAC; SUBGOAL_TAC `?eps. (&.0 <. eps) /\ (open_ball(Y,dY) ((f:A->B) a) eps SUBSET v)`; UNDISCH_FIND_TAC `v IN top_of_metric (Y,dY)`; REWRITE_TAC[IN]; ASM_SIMP_TAC[top_of_metric_nbd]; DISCH_THEN CHOOSE_TAC; FIRST_ASSUM (fun t -> MP_TAC (SPEC `a:A` t)); REWRITE_TAC[metric_continuous_pt]; DISCH_THEN (fun t-> MP_TAC (SPEC `eps:real` t)); DISCH_THEN (CHOOSE_THEN MP_TAC); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; EXISTS_TAC `delta:real`; ASM_REWRITE_TAC[SUBSET]; REWRITE_TAC[in_preimage;open_ball]; REWRITE_TAC[IN_ELIM_THM']; X_GEN_TAC `y:A`; DISCH_ALL_TAC; CONJ_TAC THENL [(ASM_REWRITE_TAC[IN]);ALL_TAC]; FIRST_ASSUM (fun t -> (MP_TAC (SPEC `y:A` t))); ASM_REWRITE_TAC[IN]; UNDISCH_FIND_TAC `open_ball`; REWRITE_TAC[open_ball]; DISCH_THEN (fun t -> (MP_TAC (CONJUNCT2 t))); REWRITE_TAC[SUBSET]; DISCH_THEN (fun t-> (MP_TAC (SPEC `(f:A->B) y` t))); ASM_REWRITE_TAC[IN_ELIM_THM']; SUBGOAL_TAC `!x. (X x) ==> (Y ((f:A->B) x))`; UNDISCH_FIND_TAC `IMAGE`; REWRITE_TAC[SUBSET;IN_IMAGE]; NAME_CONFLICT_TAC; ASM_MESON_TAC[IN]; ASM_MESON_TAC[IN]; ]);; (* }}} *) let continuous_induced = prove_by_refinement( `!(f:A->B) U V A. (topology_ V) /\ (continuous f U V) /\ (V A) ==> (continuous f U (induced_top V A)) `, (* {{{ proof *) [ REWRITE_TAC[continuous;induced_top;IN_IMAGE;Q_ELIM_THM'' ]; ASM_MESON_TAC[top_inter;IN ]; ]);; (* }}} *) let metric_cont = prove_by_refinement( `!U X d f. (metric_space(X,d)) /\ (topology_ U) ==> ((continuous (f:A->B) U (top_of_metric(X,d))) = (!(x:B) r. U (preimage (UNIONS U) f (open_ball (X,d) x r))))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_ALL_TAC; DISCH_ALL_TAC; USE 2 (REWRITE_RULE[continuous;IN]); UND 2 THEN (DISCH_THEN MATCH_MP_TAC ); ASM_MESON_TAC [open_ball_open]; REWRITE_TAC[continuous;IN]; DISCH_ALL_TAC; REWRITE_TAC[top_of_metric;IN_ELIM_THM' ]; DISCH_ALL_TAC; CHO 3; AND 3; ASM_REWRITE_TAC[]; REWRITE_TAC[preimage_unions]; IMATCH_MP_TAC top_unions ; ASM_REWRITE_TAC[IMAGE;SUBSET;IN;IN_ELIM_THM' ]; NAME_CONFLICT_TAC; REWRITE_TAC[Q_ELIM_THM']; USE 4 (REWRITE_RULE[SUBSET;IN]); DISCH_ALL_TAC; TYPE_THEN `x'` (USE 4 o SPEC); REWR 4; USE 4 (REWRITE_RULE[open_balls;IN_ELIM_THM' ]); CHO 4; CHO 4; ASM_MESON_TAC[]; ]);; (* }}} *) let continuous_sum = prove_by_refinement( `!U (f:A->(num->real)) g n. (topology_ U) /\ (continuous f U (top_of_metric(euclid n,d_euclid))) /\ (continuous g U (top_of_metric(euclid n,d_euclid))) /\ (IMAGE f (UNIONS U) SUBSET (euclid n)) /\ (IMAGE g (UNIONS U) SUBSET (euclid n)) ==> (continuous (\t. (f t + g t)) U (top_of_metric(euclid n,d_euclid)))`, (* {{{ proof *) [ ASSUME_TAC metric_euclid; DISCH_ALL_TAC; ASM_SIMP_TAC[metric_cont]; DISCH_ALL_TAC; ONCE_ASM_SIMP_TAC[open_nbd]; X_GEN_TAC `t:A`; RIGHT_TAC "B"; DISCH_ALL_TAC; USE 6 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]); USE 2 (REWRITE_RULE[continuous]); USE 3 (REWRITE_RULE[continuous]); AND 6; TYPE_THEN `n` (USE 0 o SPEC); COPY 0; JOIN 8 6; USE 6 (MATCH_MP (REWRITE_RULE[IN] open_ball_center)); CHO 6; AND 6; TYPE_THEN `open_ball(euclid n,d_euclid) (f t) (r'/(&.2))` (USE 2 o SPEC); TYPE_THEN `open_ball(euclid n,d_euclid) (g t) (r'/(&.2))` (USE 3 o SPEC); UND 3; UND 2; REWRITE_TAC[IN]; ASM_SIMP_TAC[open_ball_open]; DISCH_ALL_TAC; TYPE_THEN `B = (preimage (UNIONS U) f (open_ball (euclid n,d_euclid) (f t) (r' / &2))) INTER (preimage (UNIONS U) g (open_ball (euclid n,d_euclid) (g t) (r' / &2)))` ABBREV_TAC ; TYPE_THEN `B` EXISTS_TAC; CONJ_TAC; (* cs1 *) USE 6 (MATCH_MP preimage_subset ); TYPEL_THEN [`(\t. euclid_plus (f t) (g t))`;`UNIONS U`] (USE 6 o ISPECL); UND 6; IMATCH_MP_TAC (prove_by_refinement(`!D B C. ((B:A->bool) SUBSET D) ==> ((D SUBSET C) ==> (B SUBSET C))`,[MESON_TAC [SUBSET_TRANS]])); REWRITE_TAC[subset_preimage]; CONJ_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; EXPAND_TAC "B"; REWRITE_TAC[INTER;in_preimage;IN ;IN_ELIM_THM' ]; ASM_MESON_TAC[]; REWRITE_TAC[IMAGE;SUBSET;IN;IN_ELIM_THM']; REWRITE_TAC[Q_ELIM_THM']; EXPAND_TAC "B"; REWRITE_TAC[INTER;in_preimage;IN ;IN_ELIM_THM' ]; REWRITE_TAC[open_ball;IN_ELIM_THM' ]; DISCH_ALL_TAC; ASM_SIMP_TAC[euclid_add_closure]; TYPE_THEN `d_euclid (f t + (g t)) (f x' + g x') <=. (d_euclid (f t + (g t)) (f x' + g t)) + (d_euclid (f x' + g t) (f x' + g x'))` SUBGOAL_TAC; TYPEL_THEN [`euclid n`;`d_euclid`] (fun t-> ASSUME_TAC (ISPECL t metric_space_triangle)); REWR 17; UND 17 THEN DISCH_THEN IMATCH_MP_TAC ; ASM_SIMP_TAC[euclid_add_closure]; IMATCH_MP_TAC (REAL_ARITH `b + C < d ==> (a <= b + C ==> (a < d))`); (* cs2 *) IMATCH_MP_TAC real_half_LT; CONJ_TAC; ASM_MESON_TAC [euclid_add_closure;SPEC `n:num` metric_translate]; ASM_MESON_TAC[euclid_add_closure;metric_translate_LEFT]; CONJ_TAC; EXPAND_TAC "B"; REWRITE_TAC[INTER;in_preimage ;IN_ELIM_THM]; ASM_REWRITE_TAC[IN]; UND 4; UND 5; REWRITE_TAC[SUBSET;IN;IN_IMAGE ;IN_ELIM_THM']; NAME_CONFLICT_TAC; REWRITE_TAC[Q_ELIM_THM'']; USE 8 (ONCE_REWRITE_RULE [GSYM REAL_LT_HALF1]); ASM_MESON_TAC[REWRITE_RULE[IN] open_ball_nonempty]; EXPAND_TAC "B"; IMATCH_MP_TAC top_inter; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Cauchy sequences and completeness *) (* ------------------------------------------------------------------ *) let sequence = euclid_def `sequence X (f:num->A) <=> (IMAGE f UNIV) SUBSET X`;; let converge = euclid_def `converge (X,d) (f:num -> A) <=> (?x. (x IN (X:A->bool)) /\ (!eps. ?n. (&.0 <. eps) ==> (!i. (n <=| i) ==> (d x (f i) <. eps))))`;; let cauchy_seq = euclid_def `cauchy_seq (X,d) (f:num->A) <=> (sequence X f) /\ (!eps. ?n. !i j. (&.0 <. eps) /\ (n <= i) /\ (n <= j) ==> (d (f i) (f j) <. eps))`;; let complete = euclid_def `complete (X,d) <=> !(f:num->A). cauchy_seq (X,d) f ==> converge (X,d) f`;; let converge_cauchy = prove_by_refinement( `!X d f. metric_space(X,d) /\ (sequence X f) /\ (converge((X:A->bool),d) f) ==> cauchy_seq(X,d) f`, (* {{{ proof *) [ REWRITE_TAC[converge;metric_space]; DISCH_ALL_TAC; REWRITE_TAC[cauchy_seq]; ASM_REWRITE_TAC[]; FIRST_ASSUM CHOOSE_TAC; GEN_TAC; UNDISCH_FIND_TAC `(IN)`; DISCH_ALL_TAC; FIRST_ASSUM (fun t-> MP_TAC (SPEC `eps/(&.2)` t)); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `n:num`; REPEAT GEN_TAC; DISCH_ALL_TAC; SUBGOAL_TAC ` (&.0 <. (eps/(&.2)))`; MATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); UNDISCH_TAC `n <=| i`; DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); UNDISCH_TAC `n <=| j`; DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); FIRST_ASSUM (fun t-> MP_TAC (SPECL [`(f:num->A) i`;`x:A`;`(f:num->A) j`] t)); UNDISCH_FIND_TAC `sequence`; REWRITE_TAC[sequence;SUBSET;IN_IMAGE;IN_UNIV]; NAME_CONFLICT_TAC; REWRITE_TAC[IN]; DISCH_TAC; SUBGOAL_TAC `X ((f:num->A) i) /\ X x /\ X (f j)`; ASM_MESON_TAC[IN]; DISCH_THEN (fun t->REWRITE_TAC[t]); DISCH_ALL_TAC; ASM_MESON_TAC[REAL_LET_TRANS;REAL_LT_ADD2;REAL_HALF_DOUBLE]; ]);; (* }}} *) (* relate the metric space version to the real numbers version *) let cauchy_seq_cauchy = prove_by_refinement( `!f. (cauchy_seq(euclid 1,d_euclid) f) ==> (cauchy (\x. (f x 0)))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[cauchy_seq;cauchy;sequence;SUBSET;IN_IMAGE;IN_UNIV]; REWRITE_TAC[IN]; NAME_CONFLICT_TAC; DISCH_ALL_TAC; GEN_TAC; DISCH_TAC; FIRST_ASSUM (fun t -> MP_TAC (SPEC `e':real` t)); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `n':num`; REPEAT GEN_TAC; REWRITE_TAC[ARITH_RULE `a >=| b <=> b <=| a`]; SUBGOAL_TAC `euclid 1 (f (m':num)) /\ euclid 1 (f (n'':num))`; ASM_MESON_TAC[]; ASM_MESON_TAC[euclid1_abs]; ]);; (* }}} *) (* a variant of SEQ_CAUCHY *) let complete_real = prove_by_refinement( `complete (euclid 1,d_euclid)`, (* {{{ proof *) [ REWRITE_TAC[complete;converge]; GEN_TAC; DISCH_THEN (fun t-> ASSUME_TAC t THEN MP_TAC t); DISCH_THEN (fun t -> MP_TAC (MATCH_MP cauchy_seq_cauchy t)); REWRITE_TAC[SEQ_CAUCHY;SEQ_LIM;tends_num_real;SEQ_TENDS]; ABBREV_TAC `z = lim (\x. f x 0)`; REWRITE_TAC[MR1_DEF]; DISCH_TAC; ABBREV_TAC `c = \j. (if (j=0) then (z:real) else (&.0))`; EXISTS_TAC `(c:num->real)`; SUBGOAL_TAC `c IN (euclid 1)`; REWRITE_TAC[IN;euclid]; EXPAND_TAC "c"; GEN_TAC; COND_CASES_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; ARITH_TAC; DISCH_TAC; ASM_REWRITE_TAC[]; GEN_TAC; REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]; DISCH_TAC; FIRST_ASSUM (fun t-> (MP_TAC (SPEC `eps:real` t))); FIRST_ASSUM (fun t-> REWRITE_TAC[t]); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `N:num`; GEN_TAC; SUBGOAL_TAC `euclid 1 (f (i:num))`; UNDISCH_FIND_TAC `cauchy_seq`; REWRITE_TAC[cauchy_seq;sequence;SUBSET;IN_IMAGE;IN_UNIV]; DISCH_THEN (fun t-> MP_TAC (CONJUNCT1 t)); REWRITE_TAC[IN]; MESON_TAC[]; UNDISCH_FIND_TAC `(IN)`; REWRITE_TAC[IN]; SIMP_TAC[euclid1_abs]; DISCH_ALL_TAC; EXPAND_TAC "c"; COND_CASES_TAC; ASM_MESON_TAC[ARITH_RULE `n >=| N <=> N <= n`]; ASM_MESON_TAC[]; ]);; (* }}} *) let sequence_in = prove_by_refinement( `!X (f:num->A) i. sequence X f ==> X (f i)`, (* {{{ proof *) [ REPEAT GEN_TAC; REWRITE_TAC[sequence;SUBSET;IN_IMAGE;IN_UNIV]; REWRITE_TAC[IN]; MESON_TAC[]; ]);; (* }}} *) let proj_cauchy = prove_by_refinement( `!i f n. cauchy_seq (euclid n,d_euclid) f ==> (cauchy_seq (euclid 1,d_euclid) ((proj i) o f))`, (* {{{ proof *) [ REWRITE_TAC[cauchy_seq]; DISCH_ALL_TAC; SUBGOAL_TAC `sequence (euclid 1) (proj (i:num) o f)`; REWRITE_TAC[sequence;SUBSET;IN_IMAGE;o_DEF;IN_UNIV]; NAME_CONFLICT_TAC; MESON_TAC[IN;proj_euclid1]; DISCH_TAC; ASM_REWRITE_TAC[]; GEN_TAC; FIRST_ASSUM (fun t -> CHOOSE_TAC (SPEC `eps:real` t)); EXISTS_TAC `n':num`; DISCH_ALL_TAC; FIRST_ASSUM (fun t-> MP_TAC(SPECL [`i':num`;`j:num`] t)); UNDISCH_FIND_THEN `d_euclid` (fun t-> ALL_TAC); ASM_REWRITE_TAC[]; MATCH_MP_TAC (REAL_ARITH `a <=. b ==> (b <. eps ==> a <. eps)`); REWRITE_TAC[o_DEF;proj_d_euclid]; MATCH_MP_TAC proj_contraction; EXISTS_TAC `n:num`; ASM_MESON_TAC[sequence_in]; ]);; (* }}} *) let complete_euclid = prove_by_refinement( `!n. complete (euclid n,d_euclid)`, (* {{{ proof *) [ REWRITE_TAC[complete;IN]; REPEAT GEN_TAC; DISCH_ALL_TAC; IMP_RES_THEN MP_TAC proj_cauchy; DISCH_TAC; SUBGOAL_TAC `!i. converge (euclid 1,d_euclid) (proj i o f)`; GEN_TAC; ASM_MESON_TAC[complete;complete_real]; REWRITE_TAC[converge;IN]; DISCH_THEN (fun t-> MP_TAC (ONCE_REWRITE_RULE[SKOLEM_THM] t)); DISCH_THEN (X_CHOOSE_TAC `L:num->(num->real)`); EXISTS_TAC `(\j. ((L:num->num->real) j 0))`; SUBCONJ_TAC; REWRITE_TAC[euclid]; GEN_TAC; FIRST_ASSUM (fun t->(MP_TAC (SPEC `m:num` t))); DISCH_ALL_TAC; FIRST_ASSUM (fun t-> (MP_TAC (SPEC `abs((L:num->num->real) m 0)` t))); DISCH_THEN CHOOSE_TAC; PROOF_BY_CONTR_TAC; ASSUME_TAC (REAL_ARITH `!x. ~(x=(&.0)) ==> (&.0 <. abs(x))`); UNDISCH_FIND_TAC `d_euclid`; ASM_SIMP_TAC[]; REWRITE_TAC[GSYM EXISTS_NOT_THM]; EXISTS_TAC `(n:num)+n'`; REWRITE_TAC[o_DEF]; REWRITE_TAC[ARITH_RULE `n' <=| n+| n'`]; MATCH_MP_TAC(REAL_ARITH `(x = y) ==> ~(x (abs(u - x) = abs(u))`); REWRITE_TAC[proj]; SUBGOAL_TAC `euclid n (f (n+| n'))`; ASM_MESON_TAC[cauchy_seq;sequence_in]; REWRITE_TAC[euclid]; DISCH_THEN (fun t-> ASM_SIMP_TAC[t]); ALL_TAC; (* #buffer "CE2"; *) DISCH_TAC; GEN_TAC; CONV_TAC (quant_right_CONV "n"); DISCH_TAC; USE 2 (CONV_RULE (quant_left_CONV "eps")); USE 2 (CONV_RULE (quant_left_CONV "eps")); USE 2 (SPEC `eps/(&.1 +. &. n)`); USE 2 (CONV_RULE (quant_left_CONV "n'")); USE 2 (CONV_RULE (quant_left_CONV "n'")); CHO 2; SUBGOAL_TAC `&.0 <. eps/ (&.1 +. &.n)`; MATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT]; ARITH_TAC; DISCH_THEN (fun t-> (USE 2 (REWRITE_RULE[t]))); SUBGOAL_TAC `!i j. euclid 1 ((proj i o f) (j:num))`; ASM_MESON_TAC[cauchy_seq;sequence_in]; DISCH_TAC; SUBGOAL_TAC `!i. euclid n (f (i:num))`; GEN_TAC; ASM_MESON_TAC[cauchy_seq;sequence_in]; DISCH_TAC; ASM_SIMP_TAC[d_euclid_n]; SUBGOAL_TAC `!(j:num). ?c. !i. (c <=| i) ==> ||. (L j 0 -. f i j) <. eps/(&.1 + &. n)`; CONV_TAC (quant_left_CONV "c"); EXISTS_TAC `n':num->num`; REPEAT GEN_TAC; USE 2 ((SPEC `j:num`)); UND 2; DISCH_ALL_TAC; USE 8 (SPEC `i:num`); UND 8; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[euclid1_abs]; REWRITE_TAC[proj;o_DEF]; CONV_TAC (quant_left_CONV "c"); DISCH_THEN CHOOSE_TAC; ABBREV_TAC `t = (\u. (if (u <| n) then (c u) else (0)))`; SUBGOAL_TAC `?M. (!j. (t:num->num) j <=| M)`; MATCH_MP_TAC max_num_sequence; EXISTS_TAC `n:num`; GEN_TAC; EXPAND_TAC "t"; COND_CASES_TAC; ASM_MESON_TAC[ARITH_RULE `m <| n ==> ~(n <= m)`]; REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `M:num`; GEN_TAC; ALL_TAC; (* #set "CE3"; *) DISCH_TAC; MATCH_MP_TAC REAL_POW_2_LT; CONJ_TAC; MATCH_MP_TAC SQRT_POS_LE; REWRITE_TAC[REAL_SUM_SQUARE_POS]; CONJ_TAC; UND 4; REAL_ARITH_TAC; SIMP_TAC[REAL_SUM_SQUARE_POS;SQRT_POW_2]; SUBGOAL_TAC `sum (0,n) (\i'. (L i' 0 - f (i:num) i') * (L i' 0 - f i i')) <=. sum (0,n) (\i'. (eps/(&.1 + &.n)) * (eps/(&.1 + &.n)))`; MATCH_MP_TAC SUM_LE; BETA_TAC; GEN_TAC; DISCH_ALL_TAC; SUBGOAL_TAC `c (r:num) = (t:num->num) r`; EXPAND_TAC "t"; COND_CASES_TAC; REFL_TAC; ASM_MESON_TAC[ARITH_RULE `n +| 0 = n`]; DISCH_TAC; SUBGOAL_TAC `(abs (L r 0 - f (i:num) (r:num)) < eps/(&.1 + &.n))`; USE 7 (SPECL [`r:num`;`i:num`]); UND 7; DISCH_THEN MATCH_MP_TAC; ASM_REWRITE_TAC[]; USE 9 (SPEC `r:num`); JOIN 7 10; UND 7; REWRITE_TAC[LE_TRANS]; ALL_TAC; (* "CE4" *) ABBREV_TAC `b = eps/(&1 + &n)`; ABBREV_TAC `a = (L r 0 - (f:num->num->real) i r)`; REWRITE_TAC[GSYM REAL_POW_2]; REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS]; REAL_ARITH_TAC; MATCH_MP_TAC (REAL_ARITH `(b <. c) ==> ((a <=. b) ==> (a <. c))`); REWRITE_TAC[SUM_CONST]; REWRITE_TAC[REAL_MUL_AC;real_div]; SUBGOAL_TAC `eps pow 2 = eps*eps*(&. 1)`; REWRITE_TAC[REAL_POW_2]; REAL_ARITH_TAC; DISCH_THEN (fun t->REWRITE_TAC[t]); MATCH_MP_TAC REAL_PROP_LT_LMUL; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_PROP_LT_LMUL; ASM_REWRITE_TAC[]; SUBGOAL_TAC `&.0 <. &.1 + &.n `; REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT]; ARITH_TAC; ALL_TAC; (* "CE5" *) SIMP_TAC[REAL_INV_LT]; DISCH_TAC; REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT;REAL_OF_NUM_MUL]; REWRITE_TAC[ARITH_RULE `(1+n)*(1+n)*1 = 1+n+n+n*n`]; MATCH_MP_TAC (ARITH_RULE `(0<=a)/\(0<=b) /\(0<1) ==> (a <| 1 + a + a + b)`); CONJ_TAC; ARITH_TAC; CONJ_TAC; ONCE_REWRITE_TAC [ARITH_RULE `0 = n *| 0`]; REWRITE_TAC[LE_MULT_LCANCEL]; ARITH_TAC; ARITH_TAC; ]);; (* }}} *) let subset_sequence = prove_by_refinement( `!(X:A->bool) S f. S SUBSET X /\ sequence S f ==> sequence X f`, (* {{{ proof *) [ REWRITE_TAC[sequence]; SET_TAC[]; ]);; (* }}} *) let subset_cauchy = prove_by_refinement( `!(X:A->bool) S d f. S SUBSET X /\ cauchy_seq(S,d) f ==> cauchy_seq(X,d) f`, (* {{{ proof *) [ REPEAT GEN_TAC; REWRITE_TAC[cauchy_seq]; DISCH_ALL_TAC; ASM_MESON_TAC[subset_sequence]; ]);; (* }}} *) let complete_closed = prove_by_refinement( `!n S. (closed_ (top_of_metric (euclid n,d_euclid)) S) /\ (S SUBSET (euclid n)) ==> (complete (S,d_euclid))`, (* {{{ proof *) [ REWRITE_TAC[complete]; REPEAT GEN_TAC; DISCH_ALL_TAC; GEN_TAC; DISCH_TAC; USE 0 (MATCH_MP closed_open); UND 0; SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; DISCH_TAC; SUBGOAL_TAC `cauchy_seq(euclid n,d_euclid) f`; ASM_MESON_TAC[subset_cauchy]; DISCH_TAC; SUBGOAL_TAC `converge(euclid n,d_euclid) f`; ASM_MESON_TAC[complete_euclid;complete]; REWRITE_TAC[converge]; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `(x:num->real)`; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; SUBGOAL_TAC `~(x IN S) ==> (x IN (euclid n DIFF S))`; ASM SET_TAC[]; DISCH_TAC; H_MATCH_MP (HYP "6") (HYP "5"); USE 0 (REWRITE_RULE[open_DEF]); USE 0 (REWRITE_RULE[(MATCH_MP (CONV_RULE (quant_right_CONV "A") top_of_metric_nbd) (SPEC `n:num` metric_euclid))]); USE 0 (CONV_RULE (quant_left_CONV "a")); USE 0 (SPEC `x:num->real`); UND 0; ASM_REWRITE_TAC[SUBSET_DIFF]; ALL_TAC; (* #CC1; *) PROOF_BY_CONTR_TAC; USE 0 (REWRITE_RULE[]); CHO 0; USE 0 (REWRITE_RULE[SUBSET;IN_ELIM_THM';open_ball]); AND 0; AND 4; USE 4 (SPEC `r:real`); CHO 4; H_MATCH_MP (HYP "4") (HYP "8"); USE 10 (SPEC `n':num`); USE 10 (REWRITE_RULE[ARITH_RULE `n <=| n`]); USE 0 (SPEC `(f:num->num->real) n'`); UND 0; USE 9 (REWRITE_RULE[IN]); ASM_REWRITE_TAC[]; SUBGOAL_TAC `(S:(num->real)->bool) ((f:num->num->real) n')`; ASM_MESON_TAC[cauchy_seq;sequence_in]; UND 1; ABBREV_TAC `X = euclid n`; ABBREV_TAC `a = (f:num->num->real) n'`; REWRITE_TAC[IN_DIFF]; REWRITE_TAC[IN;SUBSET]; ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Totally bounded metric spaces *) (* ------------------------------------------------------------------ *) let totally_bounded = euclid_def `totally_bounded ((X:A->bool),d) = (!eps. ?B. (&.0 <. eps) ==> (FINITE B) /\ (!b. (B b) ==> ?x. b = open_ball(X,d) x eps) /\ (X = UNIONS B))`;; let totally_bounded_subset = prove_by_refinement( `!(X:A->bool) d S. (metric_space (X,d)) /\ (totally_bounded(X,d)) /\ (S SUBSET X) ==> (totally_bounded (S,d)) `, (* {{{ proof *) [ REPEAT GEN_TAC; REWRITE_TAC[totally_bounded]; DISCH_ALL_TAC; GEN_TAC; USE 1 (SPEC `eps/(&.2)`); CHO 1; CONV_TAC (quant_right_CONV "B"); DISCH_TAC; SUBGOAL_TAC `&.0 <. eps ==> &.0 <. eps/(&.2)`; DISCH_THEN (fun t-> MP_TAC (ONCE_REWRITE_RULE[GSYM REAL_HALF_DOUBLE] t)); REWRITE_TAC[REAL_DIV_LZERO]; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; (UND 1) THEN (ASM_REWRITE_TAC[]) THEN DISCH_ALL_TAC; SUBGOAL_TAC `!b. ?s. (?t. (t IN (b:A->bool) INTER S)) ==> (s IN b INTER S)`; GEN_TAC; CONV_TAC (quant_left_CONV "t"); MESON_TAC[IN]; CONV_TAC (quant_left_CONV "s"); DISCH_THEN CHOOSE_TAC; ALL_TAC; (* #set "TB1"; *) EXISTS_TAC `IMAGE (\c. (open_ball ((S:A->bool),d) ((s) c) eps)) (B:(A->bool)->bool)`; CONJ_TAC; MATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; CONJ_TAC; GEN_TAC; REWRITE_TAC[IMAGE;IN_ELIM_THM']; NAME_CONFLICT_TAC; DISCH_THEN (X_CHOOSE_TAC `c:A->bool`); ASM_MESON_TAC[]; MATCH_MP_TAC EQ_EXT; X_GEN_TAC `u:A`; EQ_TAC; DISCH_TAC; SUBGOAL_TAC `(X:A->bool) (u:A)`; ASM_MESON_TAC[SUBSET;IN]; ASM_REWRITE_TAC[]; REWRITE_TAC[REWRITE_RULE[IN] IN_UNIONS]; DISCH_THEN (X_CHOOSE_TAC `b':A->bool`); USE 7 (SPEC `b':A->bool`); REWRITE_TAC[IMAGE]; REWRITE_TAC[IN_ELIM_THM']; CONV_TAC (quant_left_CONV "x"); CONV_TAC (quant_left_CONV "x"); EXISTS_TAC `b':A->bool`; EXISTS_TAC `open_ball((S:A->bool),d) (s (b':A->bool)) eps`; ASM_REWRITE_TAC[IN]; REWRITE_TAC[open_ball]; REWRITE_TAC[IN_ELIM_THM']; ALL_TAC; (* #set "TB2"; *) SUBGOAL_TAC `(u:A) IN (b' INTER S)`; REWRITE_TAC[IN_INTER]; ASM_MESON_TAC[IN]; UND 7; CONV_TAC (quant_left_CONV "t"); CONV_TAC (quant_left_CONV "t"); EXISTS_TAC `u:A`; DISCH_TAC; DISCH_TAC; SUBGOAL_TAC `(S:A->bool) ((s:(A->bool)->A) b')`; UND 7; ASM_REWRITE_TAC[]; REWRITE_TAC[IN_INTER]; MESON_TAC[IN]; DISCH_TAC; ASM_REWRITE_TAC[]; SUBGOAL_TAC `(b':A->bool) ((s:(A->bool)->A) b')`; UND 11; UND 7; REWRITE_TAC[IN_INTER]; ASM_MESON_TAC[IN]; ALL_TAC; (* #set "TB3"; *) DISCH_TAC; AND 9; USE 5 (SPEC `b':A->bool`); H_MATCH_MP (HYP "5") (HYP "13"); CHO 14; ABBREV_TAC `v = (s:(A->bool)->A) b'`; COPY 9; UND 9; UND 12; ASM_REWRITE_TAC[]; REWRITE_TAC[open_ball;IN_ELIM_THM']; DISCH_ALL_TAC; SUBGOAL_TAC `(X x) /\ ((X:A->bool) u) /\ (X v)`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET;IN]; DISCH_ALL_TAC; USE 0 (REWRITE_RULE[metric_space]); COPY 16; KILL 1; KILL 7; KILL 11; UND 21; KILL 6; UND 14; DISCH_THEN (fun t-> ASSUME_TAC t THEN (REWRITE_TAC[t])); REWRITE_TAC[open_ball;IN_ELIM_THM']; DISCH_ALL_TAC; USE 0 (SPECL [`v:A`;`x:A`;`u:A`]); UND 0; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 22 (MATCH_MP (REAL_ARITH `(a <=. b + c) ==> !e. (b + c <. e ==> (a <. e))`)); USE 22 (SPEC `eps:real`); UND 22 THEN (DISCH_THEN (MATCH_MP_TAC)); ASM_REWRITE_TAC[]; UND 11; UND 17; MP_TAC (SPEC `eps:real` REAL_HALF_DOUBLE); REAL_ARITH_TAC; REWRITE_TAC[IMAGE;IN_ELIM_THM']; REWRITE_TAC[UNIONS;IN_ELIM_THM']; CONV_TAC (quant_left_CONV "x"); CONV_TAC (quant_left_CONV "x"); NAME_CONFLICT_TAC; CONV_TAC (quant_left_CONV "x'"); X_GEN_TAC `c:A->bool`; CONV_TAC (quant_left_CONV "u'"); GEN_TAC; DISCH_ALL_TAC; UND 10; ASM_REWRITE_TAC[]; REWRITE_TAC[open_ball;IN_ELIM_THM']; MESON_TAC[]; ]);; (* }}} *) let integer_cube_finite = prove_by_refinement( `!n N. FINITE { f | (euclid n f) /\ (!i. (?j. (abs(f i) = &.j) /\ (j <=| N)))}`, (* {{{ proof *) [ REP_GEN_TAC; ABBREV_TAC `fs = FUN {m | m <| n} {x | ?j. (abs x = &.j) /\ (j <=| N)}`; ABBREV_TAC `gs = { f | (euclid n f) /\ (!i. (?j. (abs(f i) = &.j) /\ (j <=| N)))}`; SUBGOAL_TAC `FINITE (fs:(num->real)->bool)`; EXPAND_TAC "fs"; MP_TAC(prove(`!(a:num->bool) (b:real->bool). FINITE a /\ FINITE b ==> (FINITE (FUN a b))`,MESON_TAC[HAS_SIZE;FUN_SIZE])); DISCH_THEN MATCH_MP_TAC; REWRITE_TAC[interval_finite;FINITE_NUMSEG_LT]; DISCH_TAC; ABBREV_TAC `G = (\ u. (\ j. if (n <=| j) then (&.0) else (u j)))`; SUBGOAL_TAC `FINITE { y | ?x. x IN fs /\ (y:(num->real) = G (x:num->real))}`; MATCH_MP_TAC FINITE_IMAGE_EXPAND; ASM_REWRITE_TAC[]; SUBGOAL_TAC `!a b. ((a:(num->real)->bool) = b) ==> (FINITE a ==> FINITE b)`; REP_GEN_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); DISCH_THEN (fun t-> MATCH_MP_TAC t); MATCH_MP_TAC EQ_EXT; GEN_TAC; EXPAND_TAC "gs"; REWRITE_TAC[IN_ELIM_THM']; EXPAND_TAC "fs"; REWRITE_TAC[FUN;IN_ELIM_THM']; NAME_CONFLICT_TAC; EQ_TAC; DISCH_THEN (CHOOSE_TAC ); SUBGOAL_TAC `euclid n x`; REWRITE_TAC[euclid]; GEN_TAC; AND 4; UND 4; EXPAND_TAC "G"; DISCH_THEN (fun t->REWRITE_TAC[t]); DISCH_THEN (fun t->REWRITE_TAC[t]); DISCH_TAC THEN (ASM_REWRITE_TAC[]); GEN_TAC; AND 4; EXPAND_TAC "G"; COND_CASES_TAC; REDUCE_TAC; EXISTS_TAC `0`; REDUCE_TAC; AND 6; USE 8 (SPEC `i':num`); ASM_MESON_TAC[ARITH_RULE `~(n <=| i') ==> (i' <| n)`]; DISCH_ALL_TAC; EXISTS_TAC `\p. (if (p <| n) then ((x:num->real) p) else (CHOICE UNIV))`; CONJ_TAC; REWRITE_TAC[SUPP;SUBSET;IN_ELIM_THM']; NAME_CONFLICT_TAC; CONJ_TAC; GEN_TAC; DISCH_THEN (fun t->REWRITE_TAC[t]); UND 5; MESON_TAC[]; GEN_TAC; COND_CASES_TAC; REWRITE_TAC[]; REWRITE_TAC[]; MATCH_MP_TAC EQ_EXT; X_GEN_TAC `q:num`; EXPAND_TAC "G"; COND_CASES_TAC; ASM_MESON_TAC[euclid]; USE 6 (MATCH_MP (ARITH_RULE `~(n <=| q) ==> (q <| n)`)); ASM_REWRITE_TAC[]; ]);; (* }}} *) let FINITE_scaled_lattice = prove_by_refinement( `!n N s. (&.0 <. s) ==> FINITE {x | euclid n x /\ (!i. (?j. abs(x i) = s*(&.j)) /\ (abs(x i) <=. (&.N) ) ) }`, (* {{{ proof *) [ DISCH_ALL_TAC; ABBREV_TAC `map = ( *# ) s`; ASSUME_TAC REAL_ARCH_SIMPLE; USE 2 (SPEC `inv(s)*(&.N)`); UND 2 THEN (DISCH_THEN (X_CHOOSE_TAC `M:num`)); ASSUME_TAC integer_cube_finite; USE 3 (SPECL [`n:num`;`M:num`]); USE 3 (MATCH_MP (ISPEC `map:(num->real)->(num->real)` FINITE_IMAGE_EXPAND)); UND 3; MATCH_MP_TAC (prove_by_refinement (`!a b. ((b:A->bool) SUBSET a) ==> (FINITE a ==> FINITE b)`,[MESON_TAC[FINITE_SUBSET]])); REWRITE_TAC[SUBSET]; X_GEN_TAC `c:num->real`; REWRITE_TAC[IN_ELIM_THM']; EXPAND_TAC "map"; DISCH_ALL_TAC; EXISTS_TAC `inv(s) *# c`; REWRITE_TAC[euclid_scale_act]; ASM_SIMP_TAC[euclid_scale_closure]; WITH 0 (MATCH_MP (REAL_ARITH `&.0 < s ==> ~(s = &.0)`)); ASM_SIMP_TAC[REAL_MUL_RINV]; CONJ_TAC; GEN_TAC; USE 4 (SPEC `i:num`); AND 4; CHO 6; REWRITE_TAC[euclid_scale;REAL_ABS_MUL;REAL_ABS_INV]; SUBGOAL_TAC `abs s = s`; UND 0; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); EXISTS_TAC `j:num`; ALL_TAC; (* save_goal "C" *) SUBCONJ_TAC; ASM_REWRITE_TAC[]; UND 5; REWRITE_TAC[GSYM (CONJUNCT1 (CONJUNCT2 (REAL_MUL_AC)))]; SIMP_TAC[REAL_MUL_LINV]; REAL_ARITH_TAC; DISCH_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_LE]; USE 7 (GSYM); UND 7 THEN DISCH_THEN (fun t-> REWRITE_TAC[t]); USE 0 (MATCH_MP REAL_LT_INV); ABBREV_TAC `s' = inv(s)`; USE 0 (MATCH_MP (REAL_ARITH `&.0 < s' ==> &.0 <=. s'`)); JOIN 0 4; USE 0 (MATCH_MP REAL_LE_LMUL); JOIN 0 2; UND 0; REAL_ARITH_TAC; REWRITE_TAC[euclid_scale_one]; ]);; (* }}} *) let totally_bounded_cube = prove_by_refinement( `!n N. totally_bounded ({x | euclid n x /\ (!i. abs(x i) <=. (&.N))},d_euclid)`, (* {{{ proof *) [ REP_GEN_TAC; REWRITE_TAC[totally_bounded]; GEN_TAC; CONV_TAC (quant_right_CONV "B"); DISCH_TAC; ABBREV_TAC `cent = {x | euclid n x /\ (!i. (?j. abs(x i) = (eps/(&.n+. &.1))*(&.j)) /\ (abs(x i) <=. (&.N) ) ) }`; SUBGOAL_TAC `&.0 <. (&.n +. &.1)`; REDUCE_TAC; ARITH_TAC; DISCH_TAC; ABBREV_TAC `s = eps/(&.n +. &.1)`; SUBGOAL_TAC `&.0 < s`; EXPAND_TAC "s"; ASM_SIMP_TAC[REAL_LT_DIV]; DISCH_TAC; SUBGOAL_TAC `FINITE (cent:(num->real)->bool)`; EXPAND_TAC "cent"; ASM_SIMP_TAC[FINITE_scaled_lattice]; DISCH_TAC; ABBREV_TAC `cube = {x | euclid n x /\ (!i. abs(x i) <=. (&.N))}`; EXISTS_TAC `IMAGE (\c. open_ball(cube,d_euclid) c eps) cent`; SUBCONJ_TAC; ASM_MESON_TAC[FINITE_IMAGE]; DISCH_TAC; SUBCONJ_TAC; GEN_TAC; REWRITE_TAC[IMAGE;IN_ELIM_THM']; ASM_MESON_TAC[]; DISCH_TAC; ALL_TAC; (* # TB1; *) SUBGOAL_TAC `cent SUBSET (cube:(num->real)->bool)`; REWRITE_TAC[SUBSET]; EXPAND_TAC "cent"; EXPAND_TAC "cube"; REWRITE_TAC[IN_ELIM_THM']; MESON_TAC[]; DISCH_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; EQ_TAC; DISCH_TAC; REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; ASSUME_TAC REAL_ARCH_LEAST; USE 11 (SPEC `s:real`); UND 11 THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC; USE 11 (CONV_RULE (quant_left_CONV "n")); USE 11 (CONV_RULE (quant_left_CONV "n")); UND 11 THEN (DISCH_THEN (X_CHOOSE_TAC `cs:real->num`)); NAME_CONFLICT_TAC; CONV_TAC (quant_left_CONV "x'"); CONV_TAC (quant_left_CONV "x'"); ABBREV_TAC `cx = \ (i:num) . if (&.0 <=. (x i)) then &(cs (x i))* s else --. (&.(cs (--. (x i))) * s )`; EXISTS_TAC `cx:num->real`; EXISTS_TAC `open_ball(cube,d_euclid) cx eps`; ASM_REWRITE_TAC[]; ALL_TAC; (* # TB2; *) SUBGOAL_TAC `euclid n x`; UND 10; EXPAND_TAC "cube"; REWRITE_TAC[IN_ELIM_THM']; MESON_TAC[]; DISCH_TAC; SUBGOAL_TAC `cx IN (euclid n)`; REWRITE_TAC[IN;euclid;]; DISCH_ALL_TAC; EXPAND_TAC "cx"; UND 13; REWRITE_TAC[euclid]; DISCH_THEN (fun t-> MP_TAC(SPEC `m:num` t)); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); REDUCE_TAC; USE 11 (SPEC `&.0`); UND 11; REDUCE_TAC; ABBREV_TAC `(a:num) = (cs (&.0))`; SUBGOAL_TAC `&.0 <=. &.a *s`; REWRITE_TAC[REAL_MUL_NN]; DISJ1_TAC; REDUCE_TAC; UND 4; REAL_ARITH_TAC; ABBREV_TAC `q = (&.a)*. s`; REAL_ARITH_TAC; DISCH_TAC; ALL_TAC; (* # TB3; *) SUBCONJ_TAC; EXPAND_TAC "cent"; REWRITE_TAC[IN_ELIM_THM']; USE 14 (REWRITE_RULE[IN]); ASM_REWRITE_TAC[]; GEN_TAC; EXPAND_TAC "cx"; BETA_TAC; COND_CASES_TAC; SUBCONJ_TAC; EXISTS_TAC `((cs:real->num) (x (i:num)))`; REWRITE_TAC[REAL_ABS_MUL]; REDUCE_TAC; REWRITE_TAC[REAL_MUL_AC]; AP_THM_TAC; AP_TERM_TAC; UND 4; REAL_ARITH_TAC; DISCH_TAC; ALL_TAC; (* # TB4; *) SUBGOAL_TAC `(&.0 <=. &.(cs ((x:num->real) i)) * s)`; REWRITE_TAC[REAL_MUL_NN]; DISJ1_TAC; REDUCE_TAC; UND 4 THEN REAL_ARITH_TAC; DISCH_THEN (fun t-> MP_TAC (REWRITE_RULE[GSYM REAL_ABS_REFL] t)); DISCH_THEN (fun t-> REWRITE_TAC [t]); USE 11 (SPEC `(x:num->real) i`); UND 11; ASM_REWRITE_TAC []; UND 10; EXPAND_TAC "cube"; REWRITE_TAC [IN_ELIM_THM']; DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT2 t)); USE 10 (SPEC `i:num`); UND 10; ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL])); ASM_SIMP_TAC[]; MESON_TAC[REAL_LE_TRANS]; ALL_TAC ; (* #TB5; *) REWRITE_TAC[REAL_ABS_NEG]; SUBCONJ_TAC; EXISTS_TAC `((cs:real->num) (--. (x (i:num))))`; REWRITE_TAC [REAL_ABS_MUL]; REDUCE_TAC; ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL])); ASSUME_TAC(REAL_ARITH `&.0 < x ==> &. 0 <=. x`); ASM_SIMP_TAC[]; REWRITE_TAC [REAL_MUL_AC]; DISCH_TAC; USE 11 (SPEC `--. (x (i:num))`); UND 11; ASSUME_TAC (REAL_ARITH `!x. ~(&.0 <= x) ==> (&.0 <= --. x)`); ASM_SIMP_TAC[]; UND 10; EXPAND_TAC "cube"; REWRITE_TAC[IN_ELIM_THM']; DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT2 t)); USE 10 (SPEC `i:num`); UND 10; MP_TAC(prove(`!v. (-- v <=. abs(v))`,REAL_ARITH_TAC)); REWRITE_TAC [REAL_ABS_MUL]; REDUCE_TAC; ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL])); ASSUME_TAC(REAL_ARITH `&.0 < x ==> &. 0 <=. x`); ASM_SIMP_TAC[]; MESON_TAC[REAL_LE_TRANS]; ALL_TAC; (* #TB6; *) DISCH_TAC; REWRITE_TAC[open_ball;IN_ELIM_THM']; ASM_REWRITE_TAC[]; CONJ_TAC; UND 15; UND 9; REWRITE_TAC[SUBSET;IN]; MESON_TAC[]; SUBGOAL_TAC `d_euclid cx x <= sqrt(&.n)*s`; MATCH_MP_TAC D_EUCLID_BOUND; USE 14 (REWRITE_RULE[IN]); ASM_REWRITE_TAC[]; GEN_TAC; EXPAND_TAC "cx"; BETA_TAC; ASSUME_TAC (REAL_ARITH `!x a b. a <=. x /\ x <. b ==> abs(a - x) <= b -a`); SUBGOAL_TAC `!x. &.0 <=. x ==> abs(&.(cs x)*.s -. x) <=. s`; DISCH_ALL_TAC; USE 11 (SPEC `x':real`); H_MATCH_MP (HYP "11") (HYP "17"); H_MATCH_MP (HYP "16") (HYP "18"); USE 19 (REWRITE_RULE [GSYM REAL_SUB_RDISTRIB]); ALL_TAC; (* # TB7; *) USE 19 (CONV_RULE REDUCE_CONV); ASM_REWRITE_TAC []; DISCH_TAC; COND_CASES_TAC; ASM_MESON_TAC[]; REWRITE_TAC[REAL_ARITH `--x - y = --(x+.y)`;REAL_ABS_NEG]; REWRITE_TAC[REAL_ARITH `x+. y = (x -. (--. y))`]; ASM_MESON_TAC[REAL_ARITH `!u. ~(&.0 <=. u) ==> (&.0 <=. (--. u))`]; ALL_TAC; (* # TB8; *) MATCH_MP_TAC(REAL_ARITH `b < c ==> ((a<=b) ==> (a < c))`); EXPAND_TAC "s"; REWRITE_TAC[real_div;REAL_MUL_AC]; MATCH_MP_TAC(REAL_ARITH`(t < e *(&.1)) ==> (t <. e)`); MATCH_MP_TAC (REAL_LT_LMUL); ASM_REWRITE_TAC[]; ASSUME_TAC REAL_PROP_LT_LCANCEL ; USE 16 (SPEC `&.n +. &.1`); UND 16; DISCH_THEN (MATCH_MP_TAC); REDUCE_TAC; SUBGOAL_TAC `~(&.(n+1) = &.0)`; REDUCE_TAC; ARITH_TAC; REWRITE_TAC[REAL_ARITH`a*b*c = (a*b)*c`]; ALL_TAC; (* # TB8; *) SIMP_TAC[REAL_MUL_RINV]; REDUCE_TAC; DISCH_TAC; CONJ_TAC; ARITH_TAC; SQUARE_TAC; SUBCONJ_TAC; MATCH_MP_TAC SQRT_POS_LE; REDUCE_TAC; DISCH_TAC; SUBCONJ_TAC; REDUCE_TAC; DISCH_TAC; SUBGOAL_TAC `&.0 <=. &.n`; REDUCE_TAC; SIMP_TAC[prove(`!x. (&.0 <=. x) ==> (sqrt(x) pow 2 = x)`,MESON_TAC[SQRT_POW2])]; DISCH_TAC; REWRITE_TAC[REAL_POW_2]; REDUCE_TAC; REWRITE_TAC[LEFT_ADD_DISTRIB;RIGHT_ADD_DISTRIB]; REDUCE_TAC; ABBREV_TAC `m = n*|n +| n`; ARITH_TAC; ALL_TAC; (* # TB9; *) REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; DISCH_THEN CHOOSE_TAC; AND 10; CHO 11; AND 11; UND 10; ASM_REWRITE_TAC[]; MP_TAC (ISPEC `cube:(num->real)->bool` open_ball_subset); REWRITE_TAC[SUBSET]; REWRITE_TAC[IN]; MESON_TAC[]; ]);; (* }}} *) let center_FINITE = prove_by_refinement( `!X d . metric_space ((X:A->bool),d) /\ (totally_bounded (X,d)) ==> (!eps. (&.0 < eps) ==> (?C. (C SUBSET X) /\ (FINITE C) /\ (X = UNIONS (IMAGE (\x. open_ball(X,d) x eps) C))))`, (* {{{ proof *) [ REWRITE_TAC[totally_bounded]; DISCH_ALL_TAC; DISCH_ALL_TAC; USE 1 (SPEC `eps:real`); CHO 1; REWR 1; AND 1; AND 1; USE 4 (CONV_RULE ((quant_left_CONV "x"))); USE 4 (CONV_RULE ((quant_left_CONV "x"))); CHO 4; ABBREV_TAC `C'={z | (X (z:A)) /\ (?b. (B (b:A->bool)) /\ (z = x b))}`; EXISTS_TAC `C':A->bool`; SUBCONJ_TAC; EXPAND_TAC"C'"; REWRITE_TAC[SUBSET;IN_ELIM_THM']; REWRITE_TAC[IN]; MESON_TAC[]; DISCH_TAC; CONJ_TAC; SUBGOAL_TAC `C' SUBSET (IMAGE (x:(A->bool)->A) B)`; EXPAND_TAC"C'"; REWRITE_TAC[SUBSET;IN_IMAGE;IN_ELIM_THM']; NAME_CONFLICT_TAC; MESON_TAC[IN]; DISCH_TAC; SUBGOAL_TAC `FINITE (IMAGE (x:(A->bool)->A) B)`; ASM_MESON_TAC[FINITE_IMAGE]; ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC; (* #g1; *) (ASM (GEN_REWRITE_TAC LAND_CONV)) []; ( (GEN_REWRITE_TAC LAND_CONV)) [UNIONS_DELETE]; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[DELETE;IN_ELIM_THM';IMAGE]; EXPAND_TAC "C'"; REWRITE_TAC[IN_ELIM_THM']; NAME_CONFLICT_TAC; EQ_TAC; DISCH_ALL_TAC; USE 4 (SPEC `x':A->bool`); CONV_TAC (quant_left_CONV "b'"); CONV_TAC (quant_left_CONV "b'"); CONV_TAC (quant_left_CONV "b'"); EXISTS_TAC `x':(A->bool)`; EXISTS_TAC `(x:(A->bool)->A) x'`; REWRITE_TAC[]; USE 7 (REWRITE_RULE[IN]); H_MATCH_MP (HYP "4") (HYP"7"); ALL_TAC; (* #g2 *) ABBREV_TAC `a = (x:(A->bool)->A) x'`; KILL 1; ASM_REWRITE_TAC[]; UND 8; ASM_REWRITE_TAC[]; MESON_TAC[open_ball_empty;IN]; ALL_TAC; (* #g3 *) DISCH_THEN CHOOSE_TAC; UND 7; DISCH_ALL_TAC; CHO 8; AND 8; CONJ_TAC; KILL 1; ASM_REWRITE_TAC[]; KILL 9; USE 4 (SPEC `b':A->bool`); REWR 1; ASM_MESON_TAC[IN]; KILL 1; ASM_REWRITE_TAC[]; UND 7; ASM_REWRITE_TAC[]; ABBREV_TAC `a = (x:(A->bool)->A) b'`; DISCH_TAC; JOIN 2 7; JOIN 0 2; USE 0 (MATCH_MP open_ball_nonempty); UND 0; ABBREV_TAC `E= open_ball(X,d) (a:A) eps `; MESON_TAC[IN;EMPTY]; ]);; (* }}} *) let open_ball_dist = prove_by_refinement( `!X d x y r. (open_ball(X,d) x r y) ==> (d (x:A) y <. r)`, (* {{{ proof *) [ REWRITE_TAC[open_ball;IN_ELIM_THM']; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let totally_bounded_bounded = prove_by_refinement( `!(X:A->bool) d. metric_space(X,d) /\ totally_bounded (X,d) ==> (?a r. X SUBSET (open_ball(X,d) a r))`, (* {{{ proof *) [ DISCH_ALL_TAC; COPY 0; JOIN 0 1; USE 0 (MATCH_MP center_FINITE); USE 0 (SPEC `&.1`); USE 0 (CONV_RULE REDUCE_CONV); CHO 0; EXISTS_TAC `CHOICE (X:A->bool)`; ASM_CASES_TAC `(X:A->bool) = EMPTY`; ASM_REWRITE_TAC[EMPTY_SUBSET]; USE 1 (MATCH_MP CHOICE_DEF); UND 0 THEN DISCH_ALL_TAC; ABBREV_TAC `(dset:real->bool) = IMAGE (\c. (d (CHOICE (X:A->bool)) (c:A))) C`; SUBGOAL_TAC `FINITE (dset:real->bool)`; EXPAND_TAC"dset"; MATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; DISCH_TAC; USE 6 (MATCH_MP real_FINITE); CHO 6; EXISTS_TAC `a +. &.1`; REWRITE_TAC[SUBSET]; GEN_TAC; REWRITE_TAC[open_ball;IN_ELIM_THM']; UND 1; REWRITE_TAC[IN]; DISCH_ALL_TAC; UND 4; ASM_REWRITE_TAC[]; DISCH_TAC; (* ASM (GEN_REWRITE_TAC LAND_CONV) []; *) USE 4(REWRITE_RULE[UNIONS;IN_IMAGE;IN_ELIM_THM']); USE 4(fun t -> AP_THM t `x:A`); UND 1; DISCH_THEN (fun t-> ((MP_TAC t) THEN (ASM_REWRITE_TAC[])) THEN ASSUME_TAC t); DISCH_TAC; USE 8 (REWRITE_RULE[IN_ELIM_THM']); CHO 8; AND 8; USE 9 (CONV_RULE NAME_CONFLICT_CONV); CHO 9; ALL_TAC; (* # "tbb"; *) REWR 8; USE 8(REWRITE_RULE[IN]); USE 8 (MATCH_MP open_ball_dist); AND 9; SUBGOAL_TAC `d (CHOICE (X:A->bool)) (x':A) IN (dset:real->bool)`; EXPAND_TAC"dset"; REWRITE_TAC[IN_IMAGE]; ASM_MESON_TAC[]; DISCH_TAC; H_MATCH_MP (HYP"6") (HYP"11"); USE 2 (REWRITE_RULE[metric_space]); USE 2 (SPECL[`(CHOICE (X:A->bool))`;`(x':A)`;`x:A`]); KILL 4; REWR 2; SUBGOAL_TAC `(X:A->bool) x'`; UND 9; UND 0; SET_TAC[IN;SUBSET]; DISCH_TAC; REWR 2; UND 2 THEN DISCH_ALL_TAC; UND 8; UND 12; UND 15; ARITH_TAC; ]);; (* }}} *) let subsequence_rec = prove_by_refinement( `!(X:A->bool) d f C s n r. metric_space(X,d) /\ (totally_bounded(X,d)) /\ (sequence X f) /\ (C SUBSET X) /\ (&.0 < r) /\ (~FINITE{j| C (f j)} /\ C(f s) /\ (!x y. (C x /\ C y) ==> d x y <. r*twopow(--: (&:n)))) ==> (? C' s'. ((C' SUBSET C) /\ (s < s') /\ (~FINITE{j| C' (f j)} /\ C'(f s') /\ (!x y. (C' x /\ C' y) ==> d x y <. r*twopow(--: (&:(SUC n)))))))`, (* {{{ proof *) [ DISCH_ALL_TAC; USE 1 (REWRITE_RULE[totally_bounded]); USE 1 (SPEC `r*twopow(--: (&:(n+| 2)))`); CHO 1; ASSUME_TAC twopow_pos; USE 8 (SPEC `--: (&: (n+| 2))`); ALL_TAC; (* ## need a few lines here to match Z8 with Z1. *) COPY 4; JOIN 9 8; USE 8 (MATCH_MP REAL_LT_MUL); REWR 1; UND 1 THEN DISCH_ALL_TAC; ALL_TAC ; (* "sr1" OK TO HERE *) ASSUME_TAC (ISPECL [`UNIV:num->bool`;`f:num->A`;`B:(A->bool)->bool`;`C:A->bool`] INFINITE_PIGEONHOLE); UND 11; ASM_SIMP_TAC[UNIV]; H_REWRITE_RULE[HYP "10"] (HYP "3"); ASM_REWRITE_TAC []; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `C INTER (b:A->bool)`; CONV_TAC (quant_right_CONV "s'"); SUBCONJ_TAC; REWRITE_TAC[INTER_SUBSET]; DISCH_TAC; AND 12; ASM_REWRITE_TAC[]; SUBGOAL_TAC `~(FINITE ({i | (C INTER b) ((f:num->A) i)} INTER {i | s <| i}))`; PROOF_BY_CONTR_TAC; (USE 15) (REWRITE_RULE[]); USE 15 (MATCH_MP num_above_finite); UND 12; ASM_REWRITE_TAC[]; DISCH_TAC; ABBREV_TAC `J = ({i | (C INTER b) ((f:num->A) i)} INTER {i | s <| i})`; EXISTS_TAC `CHOICE (J:num->bool)`; (* ok to here *) SUBGOAL_TAC `J (CHOICE (J:num->bool))`; MATCH_MP_TAC (REWRITE_RULE [IN] CHOICE_DEF); PROOF_BY_CONTR_TAC; USE 17 (REWRITE_RULE[]); H_REWRITE_RULE[(HYP "17")] (HYP "15"); UND 18; REWRITE_TAC[FINITE_RULES]; ALL_TAC; (* "sr2" *) ABBREV_TAC `s' = (CHOICE (J:num->bool))`; EXPAND_TAC "J"; REWRITE_TAC[INTER;IN_ELIM_THM']; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; KILL 5 THEN (KILL 2) THEN (KILL 1) THEN (KILL 13) THEN (KILL 12); SUBGOAL_TAC `(X x) /\ (X (y:A))`; UND 21 THEN UND 23 THEN UND 3; MESON_TAC[SUBSET;IN]; USE 9 (SPEC `b:A->bool`); H_REWRITE_RULE[HYP "14"] (HYP "1"); CHO 2; ALL_TAC; (* #"gg1" *) JOIN 22 24; JOIN 0 5; H_REWRITE_RULE[(HYP "2")] (HYP "0"); USE 5 (REWRITE_RULE[IN]); USE 5 (MATCH_MP BALL_DIST); DISCH_ALL_TAC; UND 5; MATCH_MP_TAC (REAL_ARITH `(b = c) ==> ((a<. b) ==> (a ~(r = &.0)`)); ASM_REWRITE_TAC[]; REWRITE_TAC[TWOPOW_NEG]; REWRITE_TAC[ARITH_RULE `(n+|2) = 1 + (SUC n)`]; REWRITE_TAC[REAL_POW_ADD;REAL_INV_MUL]; REWRITE_TAC [REAL_MUL_ASSOC]; REWRITE_TAC[REAL_INV2;REAL_POW_1]; REDUCE_TAC; ]);; (* }}} *) let sequence_subseq = prove_by_refinement( `!(X:A->bool) f (ss:num->num). (sequence X f) ==> (sequence X (f o ss))`, (* {{{ proof *) [ REWRITE_TAC[sequence;IMAGE;IN_UNIV;SUBSET;IN_ELIM_THM';o_DEF]; REWRITE_TAC[IN]; MESON_TAC[]; ]);; (* }}} *) let cauchy_subseq = prove_by_refinement( `!(X:A->bool) d f. ((metric_space(X,d))/\(totally_bounded(X,d)) /\ (sequence X f)) ==> (?ss. (subseq ss) /\ (cauchy_seq(X,d) (f o ss)))`, (* {{{ proof *) [ DISCH_ALL_TAC; COPY 0 THEN COPY 1; JOIN 4 3; USE 3 (MATCH_MP totally_bounded_bounded); CHO 3; CHO 3; ALL_TAC; (* {{{ xxx *) ALL_TAC; (* make r pos *) ASSUME_TAC (REAL_ARITH `r <. (&.1 + abs(r))`); ASSUME_TAC (REAL_ARITH `&.0 <. (&.1 + abs(r))`); ABBREV_TAC (`r' = &.1 +. abs(r)`); SUBGOAL_TAC `open_ball(X,d) a r SUBSET open_ball(X,d) (a:A) r'`; ASM_SIMP_TAC[open_ball_nest]; DISCH_TAC; JOIN 3 7; USE 3 (MATCH_MP SUBSET_TRANS); KILL 6; KILL 4; ALL_TAC; (* "cs1" *) SUBGOAL_TAC `( !(x:A) y. (X x) /\ (X y) ==> (d x y <. &.2 *. r'))`; DISCH_ALL_TAC; USE 3 (REWRITE_RULE[SUBSET;IN]); COPY 3; USE 7 (SPEC `x:A`); USE 3 (SPEC `y:A`); H_MATCH_MP (HYP "3") (HYP "6"); H_MATCH_MP (HYP "7") (HYP "4"); JOIN 9 8; JOIN 0 8; USE 0 (MATCH_MP BALL_DIST); ASM_REWRITE_TAC[]; DISCH_TAC; ABBREV_TAC `cond = (\ ((C:A->bool),(s:num)) n. ~FINITE{j| C (f j)} /\ (C(f s)) /\ (!x y. (C x /\ C y) ==> d x y <. (&.2*.r')*. twopow(--: (&:n))))`; ABBREV_TAC `R = (&.2)*r'`; ALL_TAC ; (* 0 case of recursio *) ALL_TAC; (* cs2 *) SUBGOAL_TAC ` (X SUBSET X) /\ (cond ((X:A->bool),0) 0)`; REWRITE_TAC[SUBSET_REFL]; EXPAND_TAC "cond"; CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV); USE 2 (REWRITE_RULE[sequence;SUBSET;IN_IMAGE;IN_UNIV]); USE 2 (REWRITE_RULE[IN]); USE 2 (CONV_RULE (NAME_CONFLICT_CONV)); SUBGOAL_TAC `!x. X((f:num->A) x)`; ASM_MESON_TAC[]; REDUCE_TAC; REWRITE_TAC[TWOPOW_0] THEN REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; SUBGOAL_TAC `{ j | (X:A->bool) (f j) } = (UNIV:num->bool)`; MATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM;UNIV]; ASM_REWRITE_TAC[]; DISCH_THEN REWRT_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[num_infinite]; ALL_TAC; (* #save_goal "cs3" *) SUBGOAL_TAC `&.0 <. R`; EXPAND_TAC "R"; UND 5; REAL_ARITH_TAC; DISCH_ALL_TAC; SUBGOAL_TAC `!cs n. ?cs' . (FST cs SUBSET X) /\ (cond cs n)==>( (FST cs' SUBSET (FST cs)) /\(SND cs <| ((SND:((A->bool)#num)->num) cs') /\ (cond cs' (SUC n))) )`; DISCH_ALL_TAC; CONV_TAC (quant_right_CONV "cs'"); DISCH_TAC; AND 11; H_REWRITE_RULE[GSYM o (HYP "6")] (HYP "11"); USE 13 (CONV_RULE (SUBS_CONV[GSYM(ISPEC `cs:(A->bool)#num` PAIR)])); USE 13 (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV)); JOIN 10 13; JOIN 12 10; JOIN 2 10; JOIN 1 2; JOIN 0 1; USE 0 (MATCH_MP subsequence_rec); CHO 0; CHO 0; EXISTS_TAC `(C':A->bool,s':num)`; ASM_REWRITE_TAC[FST;SND]; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); ASM_REWRITE_TAC[]; DISCH_TAC; ALL_TAC; (* "cs4" *) USE 11 (REWRITE_RULE[SKOLEM_THM]); CHO 11; ASSUME_TAC (ISPECL[`((X:A->bool),0)`;`cs':(((A->bool)#num)->(num->(A->bool)#num))`] num_RECURSION); CHO 12; EXISTS_TAC `\i. (SND ((fn : num->(A->bool)#num) i))`; USE 11 (CONV_RULE (quant_left_CONV "n")); USE 11 (SPEC `n:num`); USE 11 (SPEC `(fn:num->(A->bool)#num) n`); AND 12; H_REWRITE_RULE[GSYM o (HYP "12")] (HYP "11"); USE 14 (GEN_ALL); ABBREV_TAC `sn = (\i. SND ((fn:num->(A->bool)#num) i))`; ABBREV_TAC `Cn = (\i. FST ((fn:num->(A->bool)#num) i))`; SUBGOAL_TAC `((sn:num->num) 0 = 0) /\ (Cn 0 = (X:A->bool))`; EXPAND_TAC "sn"; EXPAND_TAC "Cn"; UND 13; MESON_TAC[FST;SND]; DISCH_TAC; KILL 13; KILL 11; SUBGOAL_TAC `!(n:num). ((fn n):(A->bool)#num) = (Cn n,sn n)`; EXPAND_TAC "sn"; EXPAND_TAC "Cn"; REWRITE_TAC[PAIR]; DISCH_TAC; H_REWRITE_RULE[(HYP "11")] (HYP"14"); KILL 12; KILL 14; KILL 11; KILL 16; KILL 15; ALL_TAC; (* }}} *) ALL_TAC; (* KILL 10; cs4m *) KILL 8; KILL 7; KILL 3; KILL 5; ALL_TAC; (* cs5 *) TYPE_THEN `!n. (Cn n SUBSET X) /\ (cond (Cn n,sn n) n)` SUBGOAL_TAC; INDUCT_TAC; ASM_REWRITE_TAC[]; SET_TAC[SUBSET]; USE 13 (SPEC `n:num`); REWR 5; ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET_TRANS]; DISCH_TAC; REWR 13; SUBCONJ_TAC; ASM_REWRITE_TAC[SUBSEQ_SUC]; DISCH_TAC; ASM_REWRITE_TAC[cauchy_seq]; ASM_SIMP_TAC[sequence_subseq]; GEN_TAC; TYPE_THEN `!i j. (i <=| j) ==> (Cn j SUBSET (Cn i))` SUBGOAL_TAC; MATCH_MP_TAC SUBSET_SUC2; ASM_REWRITE_TAC[]; DISCH_TAC; ALL_TAC; (* cs6 *) SUBGOAL_TAC `!R e. ?n. (&.0 <. R)/\ (&.0 <. e) ==> R*(twopow(--: (&:n))) <. e`; DISCH_ALL_TAC; REWRITE_TAC[TWOPOW_NEG]; (* cs6b *) ASSUME_TAC (prove(`!n. &.0 < &.2 pow n`,REDUCE_TAC THEN ARITH_TAC)); ONCE_REWRITE_TAC[REAL_MUL_AC]; ASM_SIMP_TAC[REAL_INV_LT]; ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]; CONV_TAC (quant_right_CONV "n"); DISCH_ALL_TAC; ASSUME_TAC (SPEC `R'/e` REAL_ARCH_SIMPLE); CHO 14; EXISTS_TAC `n:num`; UND 14; MESON_TAC[POW_2_LT;REAL_LET_TRANS]; DISCH_TAC; USE 11 (SPECL [`R:real`;`eps:real`]); CHO 11; EXISTS_TAC `n:num`; DISCH_ALL_TAC; REWR 11; ALL_TAC; (* cs7 *) COPY 3; USE 3 (SPEC `n:num`); AND 3; UND 3; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); DISCH_ALL_TAC; COPY 15; USE 15 (SPEC `i:num`); AND 15; UND 15; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); DISCH_ALL_TAC; COPY 20; USE 20 (SPEC `j:num`); AND 20; UND 20; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); DISCH_ALL_TAC; ABBREV_TAC `e2 = R * twopow (--: (&:n))`; REWRITE_TAC[o_DEF]; TYPEL_THEN [`f (sn i)`;`f (sn j)`] (fun t-> (USE 19 (SPECL t))); KILL 27; KILL 23; KILL 25; KILL 21; KILL 16; KILL 9; KILL 6; KILL 28; COPY 8; USE 8 (SPECL [`n:num`;`i:num`]); USE 6 (SPECL [`n:num`;`j:num`]); UND 11; MATCH_MP_TAC (REAL_ARITH `(c < a) ==> ((a < b) ==> (c < b))`); UND 19; DISCH_THEN (MATCH_MP_TAC); UND 6; UND 8; ASM_REWRITE_TAC[]; UND 22; UND 26; MESON_TAC[IN;SUBSET]; ]);; (* }}} *) let convergent_subseq = prove_by_refinement( `!(X:A->bool) d f. metric_space(X,d) /\ (totally_bounded(X,d)) /\ (complete (X,d)) /\ (sequence X f) ==> ((?(ss:num->num). (subseq ss) /\ (converge (X,d) (f o ss))))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `?ss. (subseq ss) /\ (cauchy_seq(X,d) (f o ss))` SUBGOAL_TAC; ASM_MESON_TAC[cauchy_subseq]; DISCH_ALL_TAC; CHO 4; EXISTS_TAC `ss:num->num`; USE 2 (REWRITE_RULE[complete]); ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let dense = euclid_def `!U Z. dense U Z <=> (closure U (Z:A->bool) = UNIONS U)`;; let hausdorff = euclid_def `hausdorff U <=> (!x y. (UNIONS U (x:A) /\ UNIONS U y /\ ~(x = y)) ==> (?A B. (U A) /\ (U B) /\ (A x) /\ (B y) /\ (A INTER B = EMPTY)))`;; let dense_subset = prove_by_refinement( `!U Z. (topology_ U) /\ (dense U (Z:A->bool)) ==> (Z SUBSET (UNIONS U))`, (* {{{ proof *) [ REWRITE_TAC[dense]; MESON_TAC[subset_closure]; ]);; (* }}} *) let dense_open = prove_by_refinement( `!U Z. (topology_ U) /\ (Z SUBSET (UNIONS U)) ==> (dense U (Z:A->bool) <=> (!A. (open_ U A) /\ ( (A INTER Z) = EMPTY) ==> (A = EMPTY)))`, (* {{{ proof *) [ DISCH_ALL_TAC; EQ_TAC; DISCH_TAC; DISCH_ALL_TAC; COPY 3; COPY 0; JOIN 0 3; USE 0 (MATCH_MP (open_closed)); TYPE_THEN `Z SUBSET (UNIONS U DIFF A)` SUBGOAL_TAC; ALL_TAC ; (* do1 *) REWRITE_TAC[DIFF_SUBSET]; ONCE_REWRITE_TAC[INTER_COMM]; ASM_REWRITE_TAC[]; DISCH_TAC; JOIN 0 3; JOIN 6 0; USE 0 (MATCH_MP closure_subset); USE 0 (REWRITE_RULE[DIFF_SUBSET]); AND 0; USE 2 (REWRITE_RULE[dense]); H_REWRITE_RULE [(HYP "2")] (HYP "0"); (USE 5 (REWRITE_RULE[open_DEF])); USE 5 (MATCH_MP sub_union); USE 5 (REWRITE_RULE[ SUBSET_INTER_ABSORPTION]); USE 5 (ONCE_REWRITE_RULE[INTER_COMM]); ASM_MESON_TAC[]; REWRITE_TAC[dense]; DISCH_TAC ; MATCH_MP_TAC EQ_SYM; UND 0; UND 1; SIMP_TAC [closure_open]; DISCH_TAC ; SIMP_TAC[closed_UNIV]; DISCH_TAC ; DISCH_ALL_TAC; DISCH_ALL_TAC; USE 2 (SPEC `B:A->bool`); REWR 2; ASM_REWRITE_TAC[]; REWRITE_TAC[INTER_EMPTY]; ]);; (* }}} *) let countable_dense = prove_by_refinement( `!(X:A->bool) d. (metric_space(X,d)) /\ (totally_bounded(X,d)) ==> ?Z. (COUNTABLE Z) /\ (dense (top_of_metric(X,d)) Z)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `!r. ?z. (COUNTABLE z) /\ (z SUBSET X) /\ (X = UNIONS (IMAGE (\x. open_ball(X,d) x (twopow(--: (&:r)))) z))` SUBGOAL_TAC; GEN_TAC; COPY 0; COPY 1; JOIN 2 3; USE 2 (MATCH_MP center_FINITE); USE 2 (SPEC `twopow (--: (&:r))`); H_MATCH_MP (HYP "2") (THM (SPEC `(--: (&:r))` twopow_pos)); X_CHO 3 `z:A->bool`; EXISTS_TAC `z:A->bool`; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[FINITE_COUNTABLE]; ASM_MESON_TAC[]; CONV_TAC (quant_left_CONV "z"); DISCH_THEN CHOOSE_TAC; TYPE_THEN `UNIONS (IMAGE z (UNIV:num->bool))` EXISTS_TAC; CONJ_TAC; MATCH_MP_TAC COUNTABLE_UNIONS; CONJ_TAC; MATCH_MP_TAC (ISPEC `UNIV:num->bool` COUNTABLE_IMAGE); REWRITE_TAC[NUM_COUNTABLE]; TYPE_THEN `z` EXISTS_TAC ; SET_TAC[]; GEN_TAC; REWRITE_TAC[IN_IMAGE;IN_UNIV]; ASM_MESON_TAC[ ]; TYPE_THEN `U = top_of_metric (X,d)` ABBREV_TAC; TYPE_THEN `Z = UNIONS (IMAGE z UNIV)` ABBREV_TAC; TYPE_THEN `topology_ U /\ (Z SUBSET (UNIONS U))` SUBGOAL_TAC; EXPAND_TAC "U"; KILL 3; ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions]; EXPAND_TAC "Z"; MATCH_MP_TAC UNIONS_SUBSET; REWRITE_TAC[IN_IMAGE;IN_UNIV]; ASM_MESON_TAC[]; SIMP_TAC[dense_open]; DISCH_ALL_TAC; GEN_TAC; REWRITE_TAC[open_DEF]; MATCH_MP_TAC (TAUT `( a /\ ~b ==> ~c) ==> (a /\ c ==> b)`); EXPAND_TAC "U"; ASM_SIMP_TAC [top_of_metric_nbd]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]; DISCH_ALL_TAC; CHO 9; TYPE_THEN `x` (fun t-> (USE 8 (SPEC t))); REWR 8; X_CHO 8 `eps:real`; ALL_TAC; (*"cd5"*) SUBGOAL_TAC `?r. twopow(--: (&:r)) < eps`; ASSUME_TAC (SPECL [`&.1`;`eps:real`] twopow_eps); USE 10 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[]; DISCH_THEN CHOOSE_TAC; USE 2 (SPEC `r:num`); AND 2; AND 2; TYPE_THEN `x IN X` SUBGOAL_TAC; ASM SET_TAC[IN;SUBSET]; ASM ONCE_REWRITE_TAC[]; REWRITE_TAC[UNIONS;IN_ELIM_THM';IN_IMAGE]; DISCH_THEN CHOOSE_TAC; AND 13; X_CHO 14 `z0:A`; REWR 13; AND 14; EXISTS_TAC `z0:A`; REWRITE_TAC[IN_INTER]; USE 13 (REWRITE_RULE[IN]); USE 13 (MATCH_MP open_ball_dist); CONJ_TAC; USE 8 (REWRITE_RULE [open_ball;SUBSET]); AND 8; USE 8 (SPEC `z0:A`); USE 8 (REWRITE_RULE [IN_ELIM_THM']); UND 8; DISCH_THEN (MATCH_MP_TAC ); ALL_TAC; (* "cd6" *) SUBCONJ_TAC; ASM SET_TAC[IN;SUBSET]; DISCH_TAC; SUBCONJ_TAC; ASM SET_TAC[IN;SUBSET]; DISCH_TAC; UND 13; UND 10; USE 0 (REWRITE_RULE[metric_space]); TYPEL_THEN [`z0`;`x`;`z0`] (fun t-> USE 0 (SPECL t)); REWR 0; UND 0; REAL_ARITH_TAC; EXPAND_TAC "Z"; REWRITE_TAC[IN_UNIONS;IN_IMAGE;IN_UNIV]; UND 14; MESON_TAC[]; ]);; (* }}} *) let metric_hausdorff = prove_by_refinement( `! (X:A->bool) d. (metric_space(X,d))==> (hausdorff (top_of_metric(X,d)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[hausdorff;]; ASM_SIMP_TAC [GSYM top_of_metric_unions]; DISCH_ALL_TAC; COPY 0; USE 4 (REWRITE_RULE[metric_space]); TYPEL_THEN [`x`;`y`;`x`] (USE 4 o SPECL); REWR 4; TYPE_THEN `r = d x y` ABBREV_TAC; SUBGOAL_TAC `&.0 <. r`; UND 4; ARITH_TAC; DISCH_TAC; TYPE_THEN `open_ball(X,d) x (r/(&.2))` EXISTS_TAC; TYPE_THEN `open_ball(X,d) y (r/(&.2))` EXISTS_TAC; ALL_TAC; (* mh1 *) KILL 4; ASM_SIMP_TAC[open_ball_open]; COPY 6; USE 4 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]); ASM_SIMP_TAC[REWRITE_RULE[IN] open_ball_nonempty]; PROOF_BY_CONTR_TAC; USE 7 (REWRITE_RULE[EMPTY_EXISTS]); CHO 7; USE 7 (REWRITE_RULE[IN_INTER]); USE 7 (REWRITE_RULE[IN]); ALL_TAC; (* mh2 *) AND 7; COPY 7; COPY 8; USE 7 (MATCH_MP open_ball_dist); USE 8 (MATCH_MP open_ball_dist); USE 0 (REWRITE_RULE[metric_space]); COPY 0; TYPEL_THEN [`x`;`u`;`y`] (fun t-> (USE 0 (ISPECL t))); TYPEL_THEN [`y`;`u`;`y`] (fun t-> (USE 11 (ISPECL t))); UND 11; UND 0; ASM_REWRITE_TAC[]; TYPE_THEN `X u` SUBGOAL_TAC; ASM_MESON_TAC[ open_ball_subset;IN;SUBSET]; DISCH_THEN (REWRT_TAC); DISCH_ALL_TAC; UND 14; UND 0; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); JOIN 7 8; USE 0 (MATCH_MP (REAL_ARITH `(a <. c) /\ (b < c) ==> b+a < c + c`)); USE 0 (CONV_RULE REDUCE_CONV); ASM_MESON_TAC[real_lt]; ]);; (* }}} *) (* compactness *) let compact = euclid_def `compact U (K:A->bool) <=> (K SUBSET UNIONS U) /\ (!V. (K SUBSET UNIONS V ) /\ (V SUBSET U) ==> (?W. (W SUBSET V) /\ (FINITE W) /\ (K SUBSET UNIONS W )))`;; let closed_compact = prove_by_refinement( `!U K (S:A->bool). ((topology_ U) /\ (compact U K) /\ (closed_ U S) /\ (S SUBSET K)) ==> (compact U S)`, (* {{{ proof *) [ REWRITE_TAC[compact]; DISCH_ALL_TAC; DISCH_ALL_TAC; SUBCONJ_TAC; ASM_MESON_TAC[ SUBSET_TRANS]; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `A = UNIONS U DIFF S` ABBREV_TAC; TYPE_THEN `open_ U A` SUBGOAL_TAC ; ASM_MESON_TAC[ closed_open]; TYPE_THEN `V' = (A INSERT V)` ABBREV_TAC; DISCH_ALL_TAC; TYPE_THEN `V'` (USE 2 o SPEC); ALL_TAC; (* cc1 *) TYPE_THEN `K SUBSET UNIONS V'` SUBGOAL_TAC; EXPAND_TAC "V'"; EXPAND_TAC "A"; UND 6; UND 4; UND 1; TYPE_THEN `X = UNIONS U ` ABBREV_TAC; ALL_TAC; (* cc2 *) REWRITE_TAC[SUBSET_UNIONS_INSERT]; SET_TAC[SUBSET;UNIONS;DIFF]; DISCH_ALL_TAC; TYPE_THEN `V' SUBSET U` SUBGOAL_TAC; EXPAND_TAC "V'"; EXPAND_TAC "A"; REWRITE_TAC[INSERT_SUBSET]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[IN;open_DEF]; DISCH_ALL_TAC; REWR 2; CHO 2; TYPE_THEN `W DELETE A` EXISTS_TAC; CONJ_TAC; AND 2; UND 13; EXPAND_TAC "V'"; SET_TAC[SUBSET;INSERT;DELETE]; ASM_REWRITE_TAC[FINITE_DELETE]; AND 2; AND 2; UND 2; UND 4; UND 1; EXPAND_TAC "A"; TYPE_THEN `X = UNIONS U ` ABBREV_TAC; ALL_TAC; (* cc3 *) DISCH_ALL_TAC; MATCH_MP_TAC UNIONS_DELETE2; CONJ_TAC; ASM_MESON_TAC[SUBSET_TRANS]; SET_TAC[INTER;DIFF]; ]);; (* }}} *) let compact_closed = prove_by_refinement( `!U (K:A->bool). (topology_ U) /\ (hausdorff U) /\ (compact U K) ==> (closed_ U K)`, (* {{{ proof *) [ REWRITE_TAC[hausdorff;compact;closed]; DISCH_ALL_TAC; ASM_REWRITE_TAC[open_DEF]; ONCE_ASM_SIMP_TAC[open_nbd]; TYPE_THEN `C = UNIONS U DIFF K` ABBREV_TAC; GEN_TAC; CONV_TAC (quant_right_CONV "B"); DISCH_ALL_TAC; (* cc1 *) TYPE_THEN `!y. (K y) ==> (?A B. (U A /\ U B /\ A x /\ B y /\ (A INTER B = {})))` SUBGOAL_TAC; DISCH_ALL_TAC; UND 1; DISCH_THEN MATCH_MP_TAC; CONJ_TAC; UND 5; EXPAND_TAC "C"; REWRITE_TAC[DIFF;IN_ELIM_THM']; REWRITE_TAC [IN]; MESON_TAC[]; CONJ_TAC; UND 6; UND 2; REWRITE_TAC[SUBSET;IN]; MESON_TAC[]; PROOF_BY_CONTR_TAC; REWR 1; REWR 5; UND 5; UND 6; EXPAND_TAC "C"; REWRITE_TAC[DIFF;IN_ELIM_THM']; MESON_TAC[IN]; (* cc2 *) DISCH_ALL_TAC; USE 6 (CONV_RULE (quant_left_CONV "B")); USE 6 (CONV_RULE (quant_left_CONV "B")); USE 6 (CONV_RULE (quant_left_CONV "B")); CHO 6; TYPE_THEN `IMAGE B K` (USE 3 o SPEC); TYPE_THEN `K SUBSET UNIONS (IMAGE B K) /\ IMAGE B K SUBSET U` SUBGOAL_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;UNIONS;IN_IMAGE;IN_ELIM_THM']; X_GEN_TAC `y:A`; REWRITE_TAC[IN]; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;IN_IMAGE]; NAME_CONFLICT_TAC; CONV_TAC (quant_left_CONV "x'"); CONV_TAC (quant_left_CONV "x'"); ASM_MESON_TAC[IN]; DISCH_TAC; REWR 3; CHO 3; (* cc3 *) AND 3; AND 3; JOIN 8 9; USE 8 (MATCH_MP finite_subset); X_CHO 8 `kc:A->bool`; USE 6 (CONV_RULE (quant_left_CONV "A")); USE 6 (CONV_RULE (quant_left_CONV "A")); CHO 6; (* cc4 *) TYPE_THEN `K = EMPTY` ASM_CASES_TAC; REWR 4; USE 4 (REWRITE_RULE[DIFF_EMPTY]); EXISTS_TAC `C:A->bool`; ASM_REWRITE_TAC[SUBSET_REFL]; EXPAND_TAC "C"; USE 0 (REWRITE_RULE[topology]); UND 0; MESON_TAC[topology;IN;SUBSET_REFL]; TYPE_THEN `~(kc = EMPTY)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 10 (REWRITE_RULE[]); REWR 8; USE 8 (REWRITE_RULE[IMAGE_CLAUSES]); REWR 3; USE 3 (REWRITE_RULE[UNIONS_0;SUBSET_EMPTY]); ASM_MESON_TAC[ ]; REWRITE_TAC[EMPTY_EXISTS]; DISCH_THEN CHOOSE_TAC; ALL_TAC; (* cc5 *) TYPE_THEN `INTERS (IMAGE A kc)` EXISTS_TAC; TYPE_THEN `INTERS (IMAGE A kc) INTER (UNIONS (IMAGE B kc)) = EMPTY` SUBGOAL_TAC; REWRITE_TAC[INTER;UNIONS]; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM';EMPTY]; MATCH_MP_TAC (TAUT `(a ==> ~b )==> ~(a /\ b)`); REWRITE_TAC[IN_INTERS;IN_IMAGE]; DISCH_ALL_TAC; CHO 11; AND 11; CHO 13; IN_ELIM 13; REWR 11; USE 12 (CONV_RULE (quant_left_CONV "x")); USE 12 (CONV_RULE (quant_left_CONV "x")); TYPE_THEN `x''` (USE 12 o SPEC); TYPE_THEN `A x''` (USE 12 o SPEC); IN_ELIM 12; REWR 12; TYPE_THEN `x''` (USE 6 o SPEC); TYPE_THEN `K x''` SUBGOAL_TAC; UND 13; AND 8; UND 13; MESON_TAC[SUBSET;IN]; DISCH_TAC; REWR 6; USE 6 (REWRITE_RULE [INTER]); (AND 6); (AND 6); (AND 6); (AND 6); USE 6 (fun t-> AP_THM t `x':A`); USE 6 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); ASM_MESON_TAC[IN]; DISCH_TAC; ALL_TAC; (* cc6 *) SUBCONJ_TAC; EXPAND_TAC "C"; REWRITE_TAC[DIFF_SUBSET]; CONJ_TAC; MATCH_MP_TAC INTERS_SUBSET2; TYPE_THEN `A u` EXISTS_TAC ; REWRITE_TAC[IMAGE;IN_ELIM_THM']; CONJ_TAC; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC sub_union; TYPE_THEN `u` (USE 6 o SPEC); AND 8; USE 12 (REWRITE_RULE[SUBSET;IN]); ASM_MESON_TAC[IN]; UND 3; ASM_REWRITE_TAC[]; UND 11; TYPE_THEN `a' = INTERS (IMAGE A kc)` ABBREV_TAC; TYPE_THEN `b' = UNIONS (IMAGE B kc)` ABBREV_TAC; SET_TAC[INTER;SUBSET;EMPTY]; DISCH_TAC; ALL_TAC; (* cc7 *) CONJ_TAC; REWRITE_TAC[INTERS;IN_IMAGE;IN_ELIM_THM']; GEN_TAC; DISCH_THEN CHOOSE_TAC; TYPE_THEN `x'` (USE 6 o SPEC); ASM_REWRITE_TAC[]; USE 8 (REWRITE_RULE[SUBSET;IN]); ASM_MESON_TAC[IN]; MATCH_MP_TAC open_inters; ASM_REWRITE_TAC[]; CONJ_TAC; REWRITE_TAC[SUBSET;IN_IMAGE;]; NAME_CONFLICT_TAC; GEN_TAC; DISCH_THEN CHOOSE_TAC; USE 6 (SPEC `x':A`); USE 8 (REWRITE_RULE[SUBSET;IN]); ASM_MESON_TAC[IN]; CONJ_TAC; ASM_MESON_TAC[FINITE_IMAGE]; REWRITE_TAC[EMPTY_EXISTS]; TYPE_THEN `A u` EXISTS_TAC; REWRITE_TAC[IN_IMAGE]; ASM_MESON_TAC[]; ]);; (* }}} *) let compact_totally_bounded = prove_by_refinement( `!(X:A->bool) d.( metric_space(X,d)) /\ (compact (top_of_metric(X,d)) X) ==> (totally_bounded (X,d))`, (* {{{ proof *) [ REWRITE_TAC[totally_bounded;compact]; DISCH_ALL_TAC; DISCH_ALL_TAC; CONV_TAC (quant_right_CONV "B"); DISCH_TAC; TYPE_THEN `IMAGE (\x. open_ball(X,d) x eps) X` (USE 2 o SPEC); TYPE_THEN `X SUBSET UNIONS (IMAGE (\x. open_ball (X,d) x eps) X)` SUBGOAL_TAC; (REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE]); GEN_TAC; NAME_CONFLICT_TAC; REWRITE_TAC[IN]; DISCH_TAC; CONV_TAC (quant_left_CONV "x'"); CONV_TAC (quant_left_CONV "x'"); TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `open_ball (X,d) x eps` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[open_ball_nonempty;IN]; DISCH_TAC; REWR 2; ALL_TAC; (* ctb1 *) TYPE_THEN `IMAGE (\x. open_ball (X,d) x eps) X SUBSET top_of_metric (X,d)` SUBGOAL_TAC; TYPE_THEN `IMAGE (\x. open_ball (X,d) x eps) X SUBSET open_balls(X,d)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN_IMAGE;open_balls;IN_ELIM_THM']; MESON_TAC[IN]; MESON_TAC[SUBSET_TRANS;top_of_metric_open_balls]; DISCH_TAC; REWR 2; CHO 2; TYPE_THEN `W` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; DISCH_ALL_TAC; AND 2; USE 7 (REWRITE_RULE [SUBSET;IN_IMAGE]); ASM_MESON_TAC[IN]; MATCH_MP_TAC SUBSET_ANTISYM; ASM_REWRITE_TAC[]; TYPE_THEN `W SUBSET top_of_metric (X,d)` SUBGOAL_TAC; ASM_MESON_TAC[SUBSET_TRANS]; DISCH_ALL_TAC; USE 6 (MATCH_MP UNIONS_UNIONS); ASM_MESON_TAC[top_of_metric_unions]; ]);; (* }}} *) (* If W is empty then INTERS W = UNIV, rather than EMPTY. Thus, extra arguments must be provided for this case. *) let finite_inters = prove_by_refinement( `!U V . (topology_ U) /\ (compact U (UNIONS U)) /\ (INTERS V = EMPTY) /\ (!(u:A->bool). (V u) ==> (closed_ U u)) ==> (?W. (W SUBSET V) /\ (FINITE W) /\ (INTERS W = EMPTY))`, (* {{{ proof *) [ REWRITE_TAC[compact;SUBSET_REFL]; DISCH_ALL_TAC; (* {{{ proof *) TYPE_THEN `IMAGE (\r. ((UNIONS U) DIFF r)) V` (USE 1 o SPEC); TYPE_THEN `IMAGE (\r. UNIONS U DIFF r) V SUBSET U` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM']; GEN_TAC; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[top_univ;IN;SUBSET_DIFF]; IN_ELIM 4; TYPE_THEN `x'` (USE 3 o SPEC); REWR 3; USE 3 (REWRITE_RULE[closed;open_DEF]); ASM_REWRITE_TAC[]; DISCH_TAC; REWR 1; ALL_TAC; (* fi1 *) TYPE_THEN `UNIONS U SUBSET UNIONS (IMAGE (\r. UNIONS U DIFF r) V)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE]; GEN_TAC; DISCH_THEN CHOOSE_TAC; NAME_CONFLICT_TAC; USE 2 (REWRITE_RULE[INTERS_EQ_EMPTY]); TYPE_THEN `x` (USE 2 o SPEC); CHO 2; CONV_TAC (quant_left_CONV "x'"); CONV_TAC (quant_left_CONV "x'"); TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `UNIONS U DIFF a` EXISTS_TAC ; ASM_REWRITE_TAC[IN]; REWRITE_TAC[DIFF;IN_ELIM_THM';IN_UNIONS]; ASM_MESON_TAC[IN]; DISCH_TAC; REWR 1; CHO 1; AND 1; AND 1; JOIN 7 6; (*** Modified by JRH for changed theorem name USE 6 (MATCH_MP FINITE_SUBSET_IMAGE); ****) USE 6 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); CHO 6; ALL_TAC; (* fi2*) TYPE_THEN `s'={}` ASM_CASES_TAC ; REWR 6; USE 6 (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]); REWR 1; USE 1 (REWRITE_RULE[UNIONS_0;SUBSET_EMPTY]); USE 1 (REWRITE_RULE [UNIONS_EQ_EMPTY]); UND 1; DISCH_THEN DISJ_CASES_TAC; REWR 4; USE 4 (REWRITE_RULE[SUBSET_EMPTY;IMAGE;EQ_EMPTY;IN_ELIM_THM']); TYPE_THEN `V = {}` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 8 (REWRITE_RULE[EMPTY_EXISTS]); CHO 8; USE 4 (CONV_RULE (quant_left_CONV "x'")); USE 4 (CONV_RULE (quant_left_CONV "x'")); TYPE_THEN `u` (USE 4 o SPEC); TYPE_THEN `UNIONS {} DIFF u` (USE 4 o SPEC); ASM_MESON_TAC[]; USE 2 (REWRITE_RULE[INTERS_EQ_EMPTY]); REWRITE_TAC[EQ_EMPTY]; ASM_MESON_TAC[]; ALL_TAC; (* fi3*) TYPE_THEN `V` EXISTS_TAC; ASM_REWRITE_TAC[SUBSET_REFL]; USE 3 (REWRITE_RULE[closed;open_DEF]); REWR 3; USE 3 (REWRITE_RULE[REWRITE_RULE[IN] IN_SING]); TYPE_THEN `!u. V u ==> (u = EMPTY)` SUBGOAL_TAC; DISCH_ALL_TAC; TYPE_THEN `u` (USE 3 o SPEC); REWR 3; AND 3; ASM_MESON_TAC[ SUBSET_EMPTY;UNIONS_EQ_EMPTY]; DISCH_TAC; TYPE_THEN `V SUBSET {EMPTY}` SUBGOAL_TAC; REWRITE_TAC[INSERT_DEF]; REWRITE_TAC[IN_ELIM_THM']; REWRITE_TAC[IN;EMPTY;SUBSET]; ASM_MESON_TAC[IN;EMPTY]; (* }}} *) MESON_TAC[FINITE_SING;FINITE_SUBSET]; ALL_TAC; (* fi4*) TYPE_THEN `s'` EXISTS_TAC; ASM_REWRITE_TAC[INTERS_EQ_EMPTY]; GEN_TAC; USE 7 (REWRITE_RULE[EMPTY_EXISTS]); CHO 7; TYPE_THEN `UNIONS U x` ASM_CASES_TAC ; TYPE_THEN `UNIONS W x` SUBGOAL_TAC; USE 1 (REWRITE_RULE[SUBSET;IN]); UND 8; UND 1; MESON_TAC[]; DISCH_ALL_TAC; TYPE_THEN `UNIONS (IMAGE (\r. UNIONS U DIFF r) s') x` SUBGOAL_TAC; AND 6; AND 6; USE 6 (MATCH_MP UNIONS_UNIONS); USE 6 (REWRITE_RULE[SUBSET;IN]); ASM_MESON_TAC[]; REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; REWRITE_TAC[IN]; DISCH_ALL_TAC; LEFT 10 "x"; LEFT 10 "x"; TYPE_THEN `S:A->bool` (X_CHO 10) ; CHO 10; AND 10; REWR 10; TYPE_THEN `S` EXISTS_TAC; ASM_REWRITE_TAC[]; USE 10(REWRITE_RULE[REWRITE_RULE[IN] IN_DIFF]); ASM_REWRITE_TAC[]; TYPE_THEN `u` EXISTS_TAC; IN_ELIM 7; ASM_REWRITE_TAC[]; PROOF_BY_CONTR_TAC; USE 9 (REWRITE_RULE[]); TYPE_THEN `V u` SUBGOAL_TAC; AND 6; AND 6; USE 11 (REWRITE_RULE[SUBSET;IN]); ASM_MESON_TAC[]; DISCH_TAC; H_MATCH_MP (HYP "3") (HYP "10"); USE 11(REWRITE_RULE[closed;open_DEF]); USE 11 (REWRITE_RULE [SUBSET;IN]); ASM_MESON_TAC[]; ]);; (* }}} *) (* first part of the proof of cauchy_subseq *) let cauchy_subseq_sublemma = prove_by_refinement( `!(X:A->bool) d f. ((metric_space(X,d))/\(totally_bounded(X,d)) /\ (sequence X f)) ==> (?R Cn sn cond. (&0 < R) /\ (!x y. X x /\ X y ==> d x y < R) /\ (cond (X,0) 0) /\ (sn 0 = 0) /\ (Cn 0 = X) /\ (!n. Cn n SUBSET X /\ cond (Cn n,sn n) n) /\ (!n. Cn (SUC n) SUBSET Cn n /\ sn n <| sn (SUC n)) /\ (((\ (C,s). \n. (~FINITE {j | C (f j)}) /\ (C (f s)) /\ (!x y. (C x /\ C y) ==> d x y < R * (twopow (--: (&:n))))) = cond) ))`, (* {{{ proof *) [ DISCH_ALL_TAC; COPY 0 THEN COPY 1; JOIN 4 3; USE 3 (MATCH_MP totally_bounded_bounded); CHO 3; CHO 3; ALL_TAC; (* {{{ xxx *) ALL_TAC; (* make r pos *) ASSUME_TAC (REAL_ARITH `r <. (&.1 + abs(r))`); ASSUME_TAC (REAL_ARITH `&.0 <. (&.1 + abs(r))`); ABBREV_TAC (`r' = &.1 +. abs(r)`); SUBGOAL_TAC `open_ball(X,d) a r SUBSET open_ball(X,d) (a:A) r'`; ASM_SIMP_TAC[open_ball_nest]; DISCH_TAC; JOIN 3 7; USE 3 (MATCH_MP SUBSET_TRANS); KILL 6; KILL 4; ALL_TAC; (* "cs1" *) SUBGOAL_TAC `( !(x:A) y. (X x) /\ (X y) ==> (d x y <. &.2 *. r'))`; DISCH_ALL_TAC; USE 3 (REWRITE_RULE[SUBSET;IN]); COPY 3; USE 7 (SPEC `x:A`); USE 3 (SPEC `y:A`); H_MATCH_MP (HYP "3") (HYP "6"); H_MATCH_MP (HYP "7") (HYP "4"); JOIN 9 8; JOIN 0 8; USE 0 (MATCH_MP BALL_DIST); ASM_REWRITE_TAC[]; DISCH_TAC; ABBREV_TAC `cond = (\ ((C:A->bool),(s:num)) n. ~FINITE{j| C (f j)} /\ (C(f s)) /\ (!x y. (C x /\ C y) ==> d x y <. (&.2*.r')*. twopow(--: (&:n))))`; ABBREV_TAC `R = (&.2)*r'`; ALL_TAC ; (* 0 case of recursio *) ALL_TAC; (* cs2 *) SUBGOAL_TAC ` (X SUBSET X) /\ (cond ((X:A->bool),0) 0)`; REWRITE_TAC[SUBSET_REFL]; EXPAND_TAC "cond"; CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV); USE 2 (REWRITE_RULE[sequence;SUBSET;IN_IMAGE;IN_UNIV]); USE 2 (REWRITE_RULE[IN]); USE 2 (CONV_RULE (NAME_CONFLICT_CONV)); SUBGOAL_TAC `!x. X((f:num->A) x)`; ASM_MESON_TAC[]; REDUCE_TAC; REWRITE_TAC[TWOPOW_0] THEN REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_TAC; SUBGOAL_TAC `{ j | (X:A->bool) (f j) } = (UNIV:num->bool)`; MATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM;UNIV]; ASM_REWRITE_TAC[]; DISCH_THEN REWRT_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[num_infinite]; ALL_TAC; (* #save_goal "cs3" *) SUBGOAL_TAC `&.0 <. R`; EXPAND_TAC "R"; UND 5; REAL_ARITH_TAC; DISCH_ALL_TAC; SUBGOAL_TAC `!cs n. ?cs' . (FST cs SUBSET X) /\ (cond cs n)==>( (FST cs' SUBSET (FST cs)) /\(SND cs <| ((SND:((A->bool)#num)->num) cs') /\ (cond cs' (SUC n))) )`; DISCH_ALL_TAC; CONV_TAC (quant_right_CONV "cs'"); DISCH_TAC; AND 11; H_REWRITE_RULE[GSYM o (HYP "6")] (HYP "11"); USE 13 (CONV_RULE (SUBS_CONV[GSYM(ISPEC `cs:(A->bool)#num` PAIR)])); USE 13 (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV)); JOIN 10 13; JOIN 12 10; JOIN 2 10; JOIN 1 2; JOIN 0 1; USE 0 (MATCH_MP subsequence_rec); CHO 0; CHO 0; EXISTS_TAC `(C':A->bool,s':num)`; ASM_REWRITE_TAC[FST;SND]; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); ASM_REWRITE_TAC[]; DISCH_TAC; ALL_TAC; (* "cs4" *) USE 11 (REWRITE_RULE[SKOLEM_THM]); CHO 11; ASSUME_TAC (ISPECL[`((X:A->bool),0)`;`cs':(((A->bool)#num)->(num->(A->bool)#num))`] num_RECURSION); CHO 12; ALL_TAC;(* EXISTS_TAC `\i. (SND ((fn : num->(A->bool)#num) i))`; *) USE 11 (CONV_RULE (quant_left_CONV "n")); USE 11 (SPEC `n:num`); USE 11 (SPEC `(fn:num->(A->bool)#num) n`); AND 12; H_REWRITE_RULE[GSYM o (HYP "12")] (HYP "11"); USE 14 (GEN_ALL); ABBREV_TAC `sn = (\i. SND ((fn:num->(A->bool)#num) i))`; ABBREV_TAC `Cn = (\i. FST ((fn:num->(A->bool)#num) i))`; SUBGOAL_TAC `((sn:num->num) 0 = 0) /\ (Cn 0 = (X:A->bool))`; EXPAND_TAC "sn"; EXPAND_TAC "Cn"; UND 13; MESON_TAC[FST;SND]; DISCH_TAC; KILL 13; KILL 11; SUBGOAL_TAC `!(n:num). ((fn n):(A->bool)#num) = (Cn n,sn n)`; EXPAND_TAC "sn"; EXPAND_TAC "Cn"; REWRITE_TAC[PAIR]; DISCH_TAC; H_REWRITE_RULE[(HYP "11")] (HYP"14"); KILL 12; KILL 14; KILL 11; KILL 16; KILL 15; ALL_TAC; (* }}} *) ALL_TAC; (* KILL 10; cs4m *) KILL 8; KILL 7; KILL 3; KILL 5; ALL_TAC; (* cs5 *) TYPE_THEN `!n. (Cn n SUBSET X) /\ (cond (Cn n,sn n) n)` SUBGOAL_TAC; INDUCT_TAC; ASM_REWRITE_TAC[]; SET_TAC[SUBSET]; USE 13 (SPEC `n:num`); REWR 5; ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET_TRANS]; DISCH_TAC; REWR 13; ALL_TAC; (* TO HERE EVERYTHING WORKS GENERALLY *) TYPE_THEN `R` EXISTS_TAC; TYPE_THEN `Cn` EXISTS_TAC; TYPE_THEN `sn` EXISTS_TAC; TYPE_THEN `cond` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* more on metric spaces and topology *) let subseq_cauchy = prove_by_refinement( `!(X:A->bool) d f s. (metric_space(X,d)) /\ (cauchy_seq (X,d) f) /\ (subseq s) /\ (converge(X,d) (f o s)) ==> (converge(X,d) f)`, (* {{{ proof *) [ REWRITE_TAC[cauchy_seq;converge;sequence_in]; DISCH_ALL_TAC; CHO 4; TYPE_THEN `x` EXISTS_TAC ; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; AND 4; TYPE_THEN `eps/(&.2)` (USE 2 o SPEC); TYPE_THEN `eps/(&.2)` (USE 4 o SPEC); CHO 4; CHO 2; CONV_TAC (quant_right_CONV "n"); DISCH_ALL_TAC; USE 2 (REWRITE_RULE[REAL_LT_HALF1]); USE 4 (REWRITE_RULE[REAL_LT_HALF1]); REWR 2; REWR 4; TYPE_THEN `n'` EXISTS_TAC ; DISCH_ALL_TAC; TYPE_THEN `n +| n'` (USE 4 o SPEC); USE 4 (REWRITE_RULE[ARITH_RULE `n <=| n +| n'`]); TYPE_THEN `s(n +| n')` (USE 2 o SPEC); TYPE_THEN `i` (USE 2 o SPEC); TYPE_THEN `n' <=| s (n +| n')` SUBGOAL_TAC; USE 3 (MATCH_MP SEQ_SUBLE); TYPE_THEN `n +| n'` (USE 3 o SPEC); ASM_MESON_TAC[ LE_TRANS; ARITH_RULE `n' <=| n +| n'`]; DISCH_TAC; REWR 2; USE 4 (REWRITE_RULE[o_DEF]); (* save_goal"sc1"; *) TYPEL_THEN [`X`;`d`;`x`;`f (s(n +| n'))`;`f i`] (fun t-> ASSUME_TAC (ISPECL t metric_space_triangle)); USE 5 (REWRITE_RULE[IN]); REWR 9; USE 1 (MATCH_MP sequence_in); REWR 9; UND 9; UND 4; UND 2; MP_TAC (SPEC `eps:real` REAL_HALF_DOUBLE); TYPE_THEN `a = d (f (s (n +| n'))) (f i)` ABBREV_TAC ; TYPE_THEN `b = d x (f (s (n +| n')))` ABBREV_TAC ; TYPE_THEN `c = d x (f i)` ABBREV_TAC ; REAL_ARITH_TAC; ]);; (* }}} *) let compact_complete = prove_by_refinement( `!(X:A->bool) d. metric_space(X,d) /\ (compact (top_of_metric(X,d)) X) ==> (complete(X,d))`, (* {{{ proof *) [ REWRITE_TAC [complete]; DISCH_ALL_TAC; DISCH_ALL_TAC; COPY 0; COPY 1; JOIN 3 4; USE 3 (MATCH_MP compact_totally_bounded); COPY 2; USE 4 (REWRITE_RULE[cauchy_seq]); AND 4; COPY 0; COPY 3; COPY 5; JOIN 7 8; JOIN 6 7; USE 6 (MATCH_MP cauchy_subseq_sublemma); CHO 6; CHO 6; CHO 6; CHO 6; (AND 6); (AND 6); (AND 6); (AND 6); (AND 6); (AND 6); (AND 6); ALL_TAC ; (* cc1 *) MATCH_MP_TAC subseq_cauchy; TYPE_THEN `sn` EXISTS_TAC; ASM_REWRITE_TAC [converge]; SUBCONJ_TAC; REWRITE_TAC[SUBSEQ_SUC]; ASM_MESON_TAC[ ]; DISCH_ALL_TAC; TYPE_THEN `~(INTERS {z | ?n. z = closed_ball(X,d) (f (sn n)) (R* twopow(--: (&:n)))} =EMPTY)` SUBGOAL_TAC; PROOF_BY_CONTR_TAC ; REWR 15; TYPEL_THEN [`top_of_metric(X,d)`;`{z | ?n. z = closed_ball (X,d) (f(sn n)) (R * twopow (--: (&:n)))}`] (fun t-> ASSUME_TAC (ISPECL t finite_inters)); REWR 16; TYPE_THEN `topology_ (top_of_metric (X,d)) /\ compact (top_of_metric (X,d)) (UNIONS (top_of_metric (X,d))) /\ (!u. {z | ?n. z = closed_ball (X,d) (f(sn n)) (R * twopow (--: (&:n)))} u ==> closed_ (top_of_metric (X,d)) u)` SUBGOAL_TAC ; ASM_SIMP_TAC[GSYM top_of_metric_unions;]; ASM_SIMP_TAC[top_of_metric_top]; REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[closed_ball_closed]; DISCH_TAC; REWR 16; CHO 16; ALL_TAC ; (* cc2 *) TYPE_THEN `{z | ?n. z = closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))} = IMAGE (\n. closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))) (UNIV)` SUBGOAL_TAC ; MATCH_MP_TAC EQ_EXT; GEN_TAC ; REWRITE_TAC[IN_ELIM_THM';INR IN_IMAGE;UNIV]; DISCH_TAC; REWR 16; AND 16; AND 16; JOIN 20 19; (*** Modified by JRH for new theorem name USE 19 (MATCH_MP FINITE_SUBSET_IMAGE); ***) USE 19 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); CHO 19; AND 19; AND 19; (*** JRH --- originally for implicational num_FINITE: USE 20 (MATCH_MP num_FINITE); ***) USE 20 (CONV_RULE (REWR_CONV num_FINITE)); CHO 20; TYPE_THEN `f (sn a) IN (INTERS W)` SUBGOAL_TAC ; REWRITE_TAC[IN_INTERS]; REWRITE_TAC[IN]; DISCH_ALL_TAC; USE 19 (REWRITE_RULE [SUBSET;IN_IMAGE]); TYPE_THEN `t` (USE 19 o SPEC); USE 19 (REWRITE_RULE [IN]); REWR 19; X_CHO 19 `m:num`; USE 20 (SPEC `m:num`); USE 20 (REWRITE_RULE[IN]); REWR 20; TYPE_THEN `Cn m SUBSET closed_ball (X,d) (f (sn m)) (R * twopow (--: (&:m)))` SUBGOAL_TAC ; REWRITE_TAC[SUBSET;closed_ball;IN_ELIM_THM']; USE 12 (SPEC `m:num`); UND 12; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); REWRITE_TAC[SUBSET]; MESON_TAC[IN;REAL_ARITH `x <. y ==> x <=. y`]; REWRITE_TAC[SUBSET;IN]; DISCH_THEN (MATCH_MP_TAC ); ALL_TAC ; (* cc3 *) TYPE_THEN `Cn a SUBSET Cn m` SUBGOAL_TAC ; UND 13; UND 20; MESON_TAC [SUBSET_SUC2]; REWRITE_TAC[SUBSET;IN]; DISCH_THEN (MATCH_MP_TAC ); USE 12 (SPEC `a:num`); AND 12; UND 12; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); MESON_TAC[]; ASM_REWRITE_TAC [NOT_IN_EMPTY]; DISCH_TAC; ALL_TAC ; (* cc4 *) USE 15 (REWRITE_RULE[EMPTY_EXISTS]); CHO 15; TYPE_THEN `u` EXISTS_TAC ; REWRITE_TAC[IN]; SUBCONJ_TAC; USE 15 (REWRITE_RULE [IN_INTERS]); TYPE_THEN `closed_ball (X,d) (f (sn 0)) (R * twopow (--: (&:0)))` (USE 15 o SPEC); USE 15 (REWRITE_RULE[IN_ELIM_THM']); LEFT 15 "n"; TYPE_THEN `0` (USE 15 o SPEC); USE 15 (REWRITE_RULE[IN;closed_ball]); USE 15 (REWRITE_RULE [IN_ELIM_THM']); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; DISCH_ALL_TAC; CONV_TAC (quant_right_CONV "n"); DISCH_ALL_TAC; TYPEL_THEN [`(&.2)*R`;`eps`] (fun t-> ASSUME_TAC (ISPECL t twopow_eps)); CHO 18; REWR 18; TYPE_THEN `n` EXISTS_TAC; DISCH_ALL_TAC; TYPE_THEN `&0 < &2 * R ` SUBGOAL_TAC; MATCH_MP_TAC REAL_PROP_POS_MUL2; REDUCE_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; DISCH_ALL_TAC; REWR 18; UND 18; MATCH_MP_TAC (REAL_ARITH `x <= a ==> ((a < b) ==> (x < b))`); USE 15 (REWRITE_RULE[IN_INTERS]); TYPE_THEN `closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` (USE 15 o SPEC); USE 15 (REWRITE_RULE[IN_ELIM_THM']); LEFT 15 "n'"; USE 15 (SPEC `n:num`); REWR 15; TYPE_THEN `Cn n SUBSET closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` SUBGOAL_TAC ; REWRITE_TAC[SUBSET;closed_ball;IN_ELIM_THM']; USE 12 (SPEC `n:num`); UND 12; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); REWRITE_TAC[SUBSET]; MESON_TAC[IN;REAL_ARITH `x <. y ==> x <=. y`]; DISCH_TAC; TYPE_THEN `Cn i SUBSET Cn n` SUBGOAL_TAC ; UND 13; UND 19; MESON_TAC [SUBSET_SUC2]; ALL_TAC ; (* REWRITE_TAC[SUBSET;IN];*) DISCH_ALL_TAC; USE 12 (SPEC `i:num`); AND 12; UND 12; EXPAND_TAC "cond"; (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); DISCH_ALL_TAC; TYPE_THEN `((f o sn) i) IN closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` SUBGOAL_TAC; KILL 1; KILL 0; KILL 2; KILL 3; KILL 5; KILL 4; JOIN 21 18; USE 0 (MATCH_MP SUBSET_TRANS); ALL_TAC; (* "CC5"; *) ASM_MESON_TAC[IN;o_DEF;SUBSET]; REWRITE_TAC[GSYM REAL_MUL_ASSOC]; UND 15; TYPE_THEN `r = R * twopow (--: (&:n))` ABBREV_TAC; UND 0; REWRITE_TAC[IN]; MESON_TAC[BALL_DIST_CLOSED]; ]);; (* }}} *) let countable_cover = prove_by_refinement( `!(X:A->bool) d U. (metric_space(X,d)) /\ (totally_bounded(X,d)) /\ (X SUBSET (UNIONS U)) /\ (U SUBSET (top_of_metric(X,d))) ==> (?V. (V SUBSET U) /\ (X SUBSET (UNIONS V)) /\ (COUNTABLE V))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `(?Z. COUNTABLE Z /\ dense (top_of_metric (X,d)) Z)` SUBGOAL_TAC; ASM_MESON_TAC[countable_dense]; DISCH_ALL_TAC; CHO 4; TYPE_THEN `S = {(z,n) | ?A. (Z z) /\ (open_ball(X,d) z (twopow(--: (&:n))) SUBSET A) /\ U A}` ABBREV_TAC ; TYPE_THEN `COUNTABLE S` SUBGOAL_TAC; IMATCH_MP_TAC (INST_TYPE [`:A#num`,`:A`] COUNTABLE_IMAGE); TYPE_THEN `{(z,(n:num)) | (Z z) /\ (UNIV n)}` EXISTS_TAC ; CONJ_TAC ; IMATCH_MP_TAC countable_prod; ASM_REWRITE_TAC [NUM_COUNTABLE]; TYPE_THEN `I:(A#num) -> (A#num)` EXISTS_TAC; REWRITE_TAC[IMAGE_I;UNIV;SUBSET]; IN_OUT_TAC; EXPAND_TAC "S"; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; ASM_MESON_TAC[GSPEC]; DISCH_TAC; TYPE_THEN `!z n. (S (z,n) ==> ?A. Z z /\ open_ball (X,d) z (twopow (--: (&:n))) SUBSET A /\ U A)` SUBGOAL_TAC; EXPAND_TAC "S"; REWRITE_TAC[IN_ELIM_THM']; DISCH_ALL_TAC; CHO 7; CHO 7; AND 7; CHO 8; TYPE_THEN `A` EXISTS_TAC; ASM_MESON_TAC[PAIR_EQ]; DISCH_TAC ; LEFT 7 "A"; LEFT 7 "A"; LEFT 7 "A"; CHO 7; ALL_TAC ; (* "cc1"; *) TYPE_THEN `IMAGE (\ (z,n). A z n) S` EXISTS_TAC; SUBCONJ_TAC ; REWRITE_TAC[SUBSET;IN_IMAGE]; NAME_CONFLICT_TAC; TYPE_THEN `Azn:A->bool` X_GEN_TAC; DISCH_THEN (X_CHOOSE_TAC `zn:A#num`); USE 8 (SUBS [(ISPEC `zn:A#num` (GSYM PAIR))]); USE 8 (GBETA_RULE); TYPE_THEN `z = FST zn` ABBREV_TAC ; TYPE_THEN `n = SND zn` ABBREV_TAC ; IN_OUT_TAC; ASM_MESON_TAC[]; DISCH_TAC; CONJ_TAC ; REWRITE_TAC[SUBSET]; USE 2 (REWRITE_RULE[SUBSET;IN_UNIONS]); IN_OUT_TAC; DISCH_ALL_TAC; TYPE_THEN `x` ( USE 6 o SPEC); REWR 6; CHO 6; TYPE_THEN `top_of_metric (X,d) t` SUBGOAL_TAC; AND 6; UND 10; UND 5; REWRITE_TAC[SUBSET;IN]; MESON_TAC[]; ASM_SIMP_TAC[top_of_metric_nbd]; DISCH_ALL_TAC; TYPE_THEN `x` (USE 11 o SPEC); IN_OUT_TAC; REWR 0; CHO 0; AND 0; ASSUME_TAC (SPECL[`&.1`;`r:real`] twopow_eps); CHO 13; USE 13 (CONV_RULE REDUCE_CONV); REWR 13; TYPEL_THEN [`X`;`d`;`x`] (fun t-> USE 13 (MATCH_MP (SPECL t open_ball_nest))); JOIN 13 0; USE 0 (MATCH_MP SUBSET_TRANS); ASSUME_TAC (SPEC `(--: (&:n))` twopow_pos); WITH 3 (MATCH_MP top_of_metric_top); AND 7; COPY 7; COPY 14; JOIN 14 7; USE 7 (MATCH_MP dense_subset); UND 16; ASM_SIMP_TAC [dense_open]; DISCH_TAC ; TYPE_THEN `(open_ball(X,d) x (twopow (--: (&:(n+1)))))` (USE 14 o SPEC); ALL_TAC ; (* "cc2"; *) TYPE_THEN `open_ball (X,d) x (twopow (--: (&:(n +| 1)))) x` SUBGOAL_TAC; IMATCH_MP_TAC open_ball_nonempty; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `?z. (Z z) /\ (open_ball(X,d) x (twopow (--: (&:(n+1)))) z)` SUBGOAL_TAC; UND 14; REWRITE_TAC[open_DEF]; ASM_SIMP_TAC[open_ball_open]; UND 16; TYPE_THEN `B = open_ball (X,d) x (twopow (--: (&:(n +| 1))))` ABBREV_TAC ; REWRITE_TAC[INTER;IN]; POP_ASSUM_LIST (fun t->ALL_TAC); REWRITE_TAC[EMPTY_NOT_EXISTS]; REWRITE_TAC[IN_ELIM_THM']; MESON_TAC[]; DISCH_TAC; CHO 18; AND 18; WITH 3 (MATCH_MP top_of_metric_unions); USE 20 (SYM); REWR 7; TYPE_THEN `X z` SUBGOAL_TAC; UND 7; UND 19; MESON_TAC[SUBSET;IN]; DISCH_TAC; TYPE_THEN `open_ball (X,d) z (twopow (--: (&:(n +| 1)))) x` SUBGOAL_TAC; ASM_MESON_TAC[ball_symm]; DISCH_TAC; ALL_TAC ; (* "cc3"; *) REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; REWRITE_TAC[IN]; LEFT_TAC "x"; LEFT_TAC "x"; TYPE_THEN `(z,n+1)` EXISTS_TAC; TYPE_THEN `A z (n+1)` EXISTS_TAC; GBETA_TAC; EXPAND_TAC "S"; REWRITE_TAC[IN_ELIM_THM']; LEFT_TAC "z'"; TYPE_THEN `z` EXISTS_TAC; LEFT_TAC "n'"; TYPE_THEN `n + 1` EXISTS_TAC; REWRITE_TAC[]; LEFT_TAC "A"; TYPE_THEN `t` EXISTS_TAC; ASM_REWRITE_TAC[]; ALL_TAC ; (* "cc4"; *) SUBCONJ_TAC ; TYPE_THEN `open_ball (X,d) z (twopow (--: (&:(n +| 1)))) SUBSET (open_ball (X,d) x (twopow (--: (&:n))))` SUBGOAL_TAC ; CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [(GSYM twopow_double)])); IMATCH_MP_TAC ball_subset_ball; ASM_REWRITE_TAC[]; UND 0; MESON_TAC[SUBSET_TRANS]; DISCH_TAC ; TYPEL_THEN [`z`;`n+1`] (fun t -> USE 10 (SPECL t)); USE 10 (REWRITE_RULE [SUBSET ]); IN_OUT_TAC ; ALL_TAC ; (* "cc5" *) TYPE_THEN `S (z,n +| 1)` SUBGOAL_TAC ; EXPAND_TAC "S"; REWRITE_TAC[IN_ELIM_THM' ]; TYPE_THEN `z` EXISTS_TAC ; TYPE_THEN `n + 1` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `t` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_TAC ; REWR 13; AND 13; TYPE_THEN `x` (USE 25 o SPEC ); UND 25; ASM_REWRITE_TAC[]; TYPE_THEN `S` ( fun t-> IMATCH_MP_TAC ( ISPEC t COUNTABLE_IMAGE)) ; ASM_REWRITE_TAC[]; TYPE_THEN `\ (z,n). A z n` EXISTS_TAC; REWRITE_TAC[SUBSET_REFL ]; ]);; (* }}} *) let complete_compact = prove_by_refinement( `!(X:A->bool) d . (metric_space(X,d)) /\ (totally_bounded(X,d)) /\ (complete (X,d)) ==> (compact (top_of_metric(X,d)) X)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[compact]; CONJ_TAC ; UND 0; SIMP_TAC[GSYM top_of_metric_unions ]; REWRITE_TAC[SUBSET_REFL]; GEN_TAC; DISCH_ALL_TAC; TYPE_THEN `(?V'. (V' SUBSET V) /\ (X SUBSET (UNIONS V')) /\ (COUNTABLE V'))` SUBGOAL_TAC ; IMATCH_MP_TAC countable_cover; TYPE_THEN `d` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; ALL_TAC; (* ASM_MESON_TAC[]; *) ALL_TAC; (* DISCH_THEN (CHOOSE_THEN MP_TAC); *) ALL_TAC; (* DISCH_ALL_TAC; *) USE 7 (REWRITE_RULE[COUNTABLE;GE_C;UNIV]); IN_OUT_TAC; CHO 0; TYPE_THEN `B = \i. (IMAGE f { u | (u <=| i ) /\ V' (f u)}) ` ABBREV_TAC ; TYPE_THEN `?i . UNIONS (B i ) = X ` ASM_CASES_TAC; CHO 9; TYPE_THEN `B i ` EXISTS_TAC; EXPAND_TAC "B"; CONJ_TAC; REWRITE_TAC[IMAGE;SUBSET ;IN ]; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; NAME_CONFLICT_TAC; UND 2; REWRITE_TAC[SUBSET;IN ]; MESON_TAC[]; CONJ_TAC ; IMATCH_MP_TAC FINITE_IMAGE; IMATCH_MP_TAC FINITE_SUBSET; TYPE_THEN `{u | u <=| i }` EXISTS_TAC; REWRITE_TAC[FINITE_NUMSEG_LE;SUBSET;IN ;IN_ELIM_THM' ]; MESON_TAC[]; UND 9; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); EXPAND_TAC "B"; REWRITE_TAC[SUBSET_REFL ]; ALL_TAC ; (* "sv1" *) LEFT 9 "i"; TYPE_THEN `UNIONS V' SUBSET X` SUBGOAL_TAC; JOIN 2 3; USE 2 (MATCH_MP SUBSET_TRANS ); USE 2 (MATCH_MP UNIONS_UNIONS ); UND 2; ASM_MESON_TAC[top_of_metric_unions ]; DISCH_TAC ; TYPE_THEN `!i. UNIONS (B i) SUBSET X` SUBGOAL_TAC; GEN_TAC; UND 10; EXPAND_TAC "B"; REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE ]; REWRITE_TAC[IN;IN_ELIM_THM' ]; MESON_TAC[]; DISCH_TAC ; COPY 11; COPY 9; JOIN 12 13; LEFT 12 "i"; USE 12 (REWRITE_RULE [GSYM PSUBSET ;PSUBSET_MEMBER;IN ]); LEFT 12 "y"; LEFT 12 "y"; CHO 12; ALL_TAC ; (* "sv2" *) TYPE_THEN `(?ss. subseq ss /\ converge (X,d) (y o ss))` SUBGOAL_TAC; IMATCH_MP_TAC convergent_subseq ; ASM_REWRITE_TAC[sequence]; REWRITE_TAC[SUBSET;UNIV;IN_IMAGE ]; REWRITE_TAC[IN]; ASM_MESON_TAC[]; DISCH_TAC; CHO 13; AND 13; COPY 13; USE 13 (REWRITE_RULE[converge;IN ]); CHO 13; AND 13; USE 1 (REWRITE_RULE[SUBSET;UNIONS;IN;IN_ELIM_THM' ]); TYPE_THEN `x` (USE 1 o SPEC); REWR 1; CHO 1; TYPE_THEN `u` (USE 0 o SPEC); REWR 0; X_CHO 0 `j:num`; TYPE_THEN `(UNIONS (B j)) x` SUBGOAL_TAC; EXPAND_TAC "B"; REWRITE_TAC[UNIONS;IN_IMAGE ]; REWRITE_TAC[IN;IN_ELIM_THM' ]; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `j` EXISTS_TAC; ASM_MESON_TAC[ARITH_RULE `j <=| j`]; DISCH_TAC; TYPE_THEN `u SUBSET (UNIONS (B j))` SUBGOAL_TAC; IMATCH_MP_TAC sub_union; EXPAND_TAC "B"; REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; TYPE_THEN `j` EXISTS_TAC; ASM_MESON_TAC[ARITH_RULE `j <=| j`]; DISCH_TAC; JOIN 2 3; USE 2 (MATCH_MP SUBSET_TRANS); ALL_TAC ; (* "sv3" *) TYPE_THEN `top_of_metric(X,d) u` SUBGOAL_TAC; USE 2 (REWRITE_RULE[SUBSET;IN ]); ASM_MESON_TAC[]; ASM_SIMP_TAC[top_of_metric_nbd]; REWRITE_TAC[IN ]; DISCH_ALL_TAC; TYPE_THEN `x` (USE 19 o SPEC); REWR 1; REWR 19; CHO 19; TYPE_THEN `r` (USE 13 o SPEC); CHO 13; REWR 13; REWR 0; TYPE_THEN `n +| (j)` (USE 13 o SPEC); USE 13 (REWRITE_RULE[ARITH_RULE `n<=| (n+| a)`]); AND 19; TYPE_THEN `u ((y o ss) (n +| j) )` SUBGOAL_TAC; USE 19 (REWRITE_RULE[SUBSET;open_ball;IN ;IN_ELIM_THM' ]); TYPE_THEN `((y o ss) (n +| j))` (USE 19 o SPEC); ASM_REWRITE_TAC[]; UND 19; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPE_THEN `(ss (n +| j))` (USE 12 o SPEC); ASM_REWRITE_TAC[o_DEF ]; DISCH_TAC; TYPE_THEN `z = ((y o ss) (n +| j))` ABBREV_TAC; TYPE_THEN `UNIONS (B (ss (n+| j))) ((y o ss) (n +| j))` SUBGOAL_TAC; EXPAND_TAC "B"; ASM_REWRITE_TAC[]; REWRITE_TAC[UNIONS;IN_IMAGE]; REWRITE_TAC[IN; IN_ELIM_THM']; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `j` EXISTS_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (ARITH_RULE `j <= a /\ a <= ss(a) ==> (j <=| (ss (a)))`); ASM_SIMP_TAC[SEQ_SUBLE]; ARITH_TAC; REWRITE_TAC[o_DEF]; TYPE_THEN `ss(n +| j)` (USE 12 o SPEC); UND 12; MESON_TAC[]; ]);; (* }}} *) let uniformly_continuous = euclid_def `uniformly_continuous (f:A->B) ((X:A->bool),dX) ((Y:B->bool),dY) <=> (!epsilon. ?delta. (&.0 < epsilon) ==> (&.0 <. delta) /\ (!x y. (X x) /\ (X y) /\ (dX x y < delta) ==> (dY (f x) (f y) < epsilon)))`;; (* NB. It is not part of the hypothesis on metric_continuous that the IMAGE of f on X is contained in Y. Hence the extra hypothesis. *) let compact_uniformly_continuous = prove_by_refinement( `!f X dX Y dY. metric_continuous f (X,dX) (Y,dY) /\ (metric_space(X,dX)) /\ (metric_space(Y,dY)) /\ (compact(top_of_metric(X,dX)) X) /\ (IMAGE f X SUBSET Y) ==> uniformly_continuous (f:A->B) ((X:A->bool),dX) ((Y:B->bool),dY)`, (* {{{ proof *) [ REWRITE_TAC[uniformly_continuous;metric_continuous;metric_continuous_pt]; DISCH_ALL_TAC; GEN_TAC; LEFT 0 "epsilon"; TYPE_THEN `epsilon/(&.2)` (USE 0 o SPEC); LEFT 0 "delta"; CHO 0; TYPE_THEN `cov = IMAGE (\x. open_ball (X,dX) x ((delta x)/(&.2))) X` ABBREV_TAC; USE 3 (REWRITE_RULE[compact]); UND 3; ASM_SIMP_TAC[GSYM top_of_metric_unions;SUBSET_REFL ]; DISCH_TAC; TYPE_THEN `cov` (USE 3 o SPEC); CONV_TAC (quant_right_CONV "delta"); DISCH_TAC; WITH 6 (ONCE_REWRITE_RULE [GSYM REAL_LT_HALF1]); REWR 0; TYPE_THEN `!x. (&.0 < (delta x)/(&.2))` SUBGOAL_TAC; ASM_MESON_TAC[REAL_LT_HALF1]; DISCH_TAC; TYPE_THEN `X SUBSET UNIONS cov /\ cov SUBSET top_of_metric (X,dX)` SUBGOAL_TAC; SUBCONJ_TAC; REWRITE_TAC[SUBSET;UNIONS;IN;IN_ELIM_THM' ]; DISCH_ALL_TAC; TYPE_THEN `open_ball (X,dX) x ((delta x)/(&.2))` EXISTS_TAC; CONJ_TAC; EXPAND_TAC "cov"; REWRITE_TAC[IMAGE;IN ;IN_ELIM_THM' ]; ASM_MESON_TAC[]; IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); ASM_REWRITE_TAC[]; DISCH_TAC ; REWRITE_TAC[SUBSET;IN ]; EXPAND_TAC "cov"; REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; NAME_CONFLICT_TAC; DISCH_ALL_TAC; CHO 10; AND 10; ASM_REWRITE_TAC[]; ASM_MESON_TAC[open_ball_open]; DISCH_TAC; REWR 3; CHO 3; ALL_TAC; (* "cc1"; *) AND 3; AND 3; JOIN 11 10; UND 10; EXPAND_TAC "cov"; DISCH_TAC; (*** Modified by JRH for changed theorem name USE 10 (MATCH_MP FINITE_SUBSET_IMAGE); ***) USE 10 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); X_CHO 10 `S:A->bool`; TYPE_THEN `ds = IMAGE delta S` ABBREV_TAC ; TYPE_THEN `(FINITE ds) /\ ( !x. (ds x) ==> (&.0 <. x) )` SUBGOAL_TAC; EXPAND_TAC "ds"; CONJ_TAC; IMATCH_MP_TAC FINITE_IMAGE ; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; NAME_CONFLICT_TAC ; DISCH_ALL_TAC; CHO 12; ASM_REWRITE_TAC[]; DISCH_TAC; USE 12 (MATCH_MP min_finite_delta); CHO 12; TYPE_THEN `delta'/(&.2)` EXISTS_TAC; ASM_REWRITE_TAC[]; ALL_TAC ; (* "cc2" *) ASM_REWRITE_TAC[REAL_LT_HALF1]; DISCH_ALL_TAC; AND 10; AND 10; USE 10( MATCH_MP UNIONS_UNIONS ); JOIN 3 10; USE 3 (MATCH_MP SUBSET_TRANS); USE 3 (REWRITE_RULE [SUBSET;IN;UNIONS;IN_ELIM_THM' ]); USE 3 (REWRITE_RULE[IMAGE;IN ;IN_ELIM_THM' ]); TYPE_THEN `x` (WITH 3 o SPEC); TYPE_THEN `y` (WITH 3 o SPEC); KILL 3; (* start of yest *) H_MATCH_MP (HYP "18")(HYP "14"); H_MATCH_MP (HYP "10") (HYP "13"); CHO 19; CHO 3; AND 19; CHO 20; AND 20; USE 20 (REWRITE_RULE [open_ball]); REWR 19; USE 19 (REWRITE_RULE [IN_ELIM_THM']); AND 19; AND 19; TYPE_THEN `dX x' x < delta x'` SUBGOAL_TAC; UND 19; IMATCH_MP_TAC (REAL_ARITH `((u <. v) ==> (a< u)==>(a (dX x' y <. u + u)`); ASM_REWRITE_TAC[]; CONJ_TAC; UND 15; IMATCH_MP_TAC (REAL_ARITH `((u <=. v) ==> (a< u)==>(a (u <= v)`); REWRITE_TAC[REAL_HALF_DOUBLE]; AND 12; UND 12; DISCH_THEN (MATCH_MP_TAC); EXPAND_TAC "ds"; REWRITE_TAC[IMAGE;IN; IN_ELIM_THM' ]; UND 21; MESON_TAC[]; IMATCH_MP_TAC metric_space_triangle; TYPE_THEN `X` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [GSYM REAL_HALF_DOUBLE])); TYPE_THEN `(dY (f x) (f x') <. u0) /\ (dY (f x') (f y) <. u0) /\ (dY (f x) (f y) <= (dY (f x) (f x')) + (dY (f x') (f y))) ==> ((dY (f x) (f y)) < u0 + u0)` (fun t-> (IMATCH_MP_TAC (REAL_ARITH t))); TYPE_THEN `x'` (USE 0 o SPEC); AND 0; USE 0 (REWRITE_RULE[IN ]); TYPE_THEN `y` (WITH 0 o SPEC); TYPE_THEN `x` (USE 0 o SPEC); ALL_TAC; (* cc4 *) TYPE_THEN `Y (f x) /\ Y (f y) /\ Y (f x')` SUBGOAL_TAC; UND 4; REWRITE_TAC[SUBSET;IN_IMAGE; ]; REWRITE_TAC[IN ]; UND 13; UND 14; UND 22; MESON_TAC[]; DISCH_ALL_TAC; CONJ_TAC; TYPE_THEN `dY (f x) (f x') = dY (f x') (f x)` SUBGOAL_TAC; UND 2; UND 28; UND 30; TYPEL_THEN [`Y`;`dY`;`f x`;`f x'`] (fun t-> MP_TAC(ISPECL t metric_space_symm)); MESON_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); UND 0; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; CONJ_TAC; UND 27; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; TYPEL_THEN [`Y`;`dY`;`f x`;`f x'`;`f y`] (fun t-> MP_TAC(ISPECL t metric_space_triangle)); DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* I'm rather surprised that this lemma did not need the hypothesis that U and- V are topologies. *) let image_compact = prove_by_refinement( `!U V (f:A->B) K. (continuous f U V ) /\ (compact U K) /\ (IMAGE f K SUBSET (UNIONS V)) ==> (compact V (IMAGE f K))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[compact]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; TYPE_THEN `cov = IMAGE (\v. preimage (UNIONS U) f v ) V'` ABBREV_TAC ; TYPE_THEN `cov SUBSET U` SUBGOAL_TAC ; EXPAND_TAC "cov"; REWRITE_TAC[SUBSET;IN_IMAGE ]; NAME_CONFLICT_TAC; GEN_TAC; DISCH_ALL_TAC; CHO 6; AND 6; ASM_REWRITE_TAC[]; USE 4 (REWRITE_RULE[SUBSET]); TYPE_THEN `x'` (USE 4 o SPEC); REWR 4; UND 4; UND 0; REWRITE_TAC[continuous]; MESON_TAC[]; TYPE_THEN `K SUBSET UNIONS cov` SUBGOAL_TAC; ALL_TAC; (* ic1 *) UND 3; REWRITE_TAC[SUBSET;IN_IMAGE ]; NAME_CONFLICT_TAC; REWRITE_TAC[IN]; DISCH_ALL_TAC; LEFT 3 "x'"; DISCH_ALL_TAC; LEFT 3 "x'"; TYPE_THEN `x'` (USE 3 o SPEC); TYPE_THEN `f x'` (USE 3 o SPEC); REWR 3; UND 3; REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ]; USE 5 (REWRITE_RULE[IMAGE]); EXPAND_TAC "cov"; REWRITE_TAC[IN_ELIM_THM';IN ]; DISCH_ALL_TAC; CHO 5; CONV_TAC (quant_left_CONV "x"); CONV_TAC (quant_left_CONV "x"); TYPE_THEN `u` EXISTS_TAC; NAME_CONFLICT_TAC; TYPE_THEN `preimage (UNIONS U) f u` EXISTS_TAC; ASM_REWRITE_TAC[preimage;IN_ELIM_THM' ;IN ]; USE 1 (REWRITE_RULE[compact;SUBSET;IN ]); AND 1; UND 7; UND 6; MESON_TAC[]; DISCH_ALL_TAC; USE 1 (REWRITE_RULE[compact]); AND 1; TYPE_THEN `cov` (USE 1 o SPEC); REWR 1; CHO 1; ALL_TAC ; (* ic2 *) TYPE_THEN `(?V''. V'' SUBSET V' /\ FINITE V'' /\ (W = IMAGE (\v. preimage (UNIONS U) f v) V''))` SUBGOAL_TAC; IMATCH_MP_TAC finite_subset ; ASM_MESON_TAC[]; DISCH_ALL_TAC; CHO 9; TYPE_THEN `V''` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN_IMAGE]; REWRITE_TAC[IN;UNIONS;IN_ELIM_THM' ]; NAME_CONFLICT_TAC; CONV_TAC (quant_left_CONV "x'"); CONV_TAC (quant_left_CONV "x'"); DISCH_ALL_TAC; ASM_REWRITE_TAC[]; AND 1; AND 1; USE 1 (REWRITE_RULE[SUBSET;UNIONS;IN;IN_ELIM_THM' ]); TYPE_THEN `x'` (USE 1 o SPEC); REWR 1; CHO 1; AND 1; USE 14 (REWRITE_RULE[IMAGE;IN ;IN_ELIM_THM' ]); TYPE_THEN `u':B->bool` (X_CHO 14); TYPE_THEN `u'` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 1; ASM_REWRITE_TAC[preimage;IN;IN_ELIM_THM' ]; MESON_TAC []; ]);; (* }}} *) let metric_bounded = euclid_def `metric_bounded (X,d) <=> ?(x:A) r. X SUBSET (open_ball(X,d) x r)`;; let euclid_ball_cube = prove_by_refinement( `!n x r. ?N. (open_ball(euclid n,d_euclid) x r) SUBSET {x | euclid n x /\ (!i. abs (x i) <= &N)}`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';open_ball; ]; ASSUME_TAC REAL_ARCH_SIMPLE; TYPE_THEN ` (d_euclid x (\i. &.0) +. r)` (USE 0 o SPEC); X_CHO 0 `N:num`; TYPE_THEN `N` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; GEN_TAC ; ASSUME_TAC proj_contraction; TYPEL_THEN [`n`;`x'`;`(\(i :num). &.0)`;`i`] (USE 4 o SPECL); USE 4 BETA_RULE ; USE 4 (CONV_RULE REDUCE_CONV ); TYPE_THEN `euclid n (\i. &.0)` SUBGOAL_TAC ; REWRITE_TAC[euclid]; DISCH_TAC; REWR 4; ASSUME_TAC metric_euclid; TYPE_THEN `n` (USE 6 o SPEC); TYPE_THEN `d_euclid x' (\i. &.0) <=. d_euclid x' x + d_euclid x (\i. &0)` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_triangle; TYPE_THEN `euclid n` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `d_euclid x' x = d_euclid x x'` SUBGOAL_TAC; IMATCH_MP_TAC metric_space_symm; TYPE_THEN `euclid n` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 0; UND 3; UND 4; REAL_ARITH_TAC; ]);; (* }}} *) let totally_bounded_euclid = prove_by_refinement( `!X n. (metric_bounded (X,d_euclid) /\ (X SUBSET (euclid n))) ==> (totally_bounded (X,d_euclid))`, (* {{{ proof *) [ REWRITE_TAC[metric_bounded]; DISCH_ALL_TAC; IMATCH_MP_TAC totally_bounded_subset; CHO 0; CHO 0; ASSUME_TAC euclid_ball_cube; TYPEL_THEN [`n`;`x`;`r`] (USE 2 o SPECL); CHO 2; ASSUME_TAC open_ball_subspace; TYPEL_THEN [`euclid n`;`X`;`d_euclid`;`x`;`r`] (USE 3 o ISPECL); REWR 3; JOIN 0 3; USE 0 (MATCH_MP SUBSET_TRANS); JOIN 0 2; USE 0 (MATCH_MP SUBSET_TRANS); TYPE_THEN `{x | euclid n x /\ (!i. abs (x i) <= &N)}` EXISTS_TAC; ASM_REWRITE_TAC[totally_bounded_cube ]; IMATCH_MP_TAC metric_subspace; TYPE_THEN `euclid n` EXISTS_TAC; REWRITE_TAC[metric_euclid]; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) (* topology is not needed as an assumption here! *) let induced_compact = prove_by_refinement( `!U (K:A->bool). (K SUBSET (UNIONS U)) ==> (compact U K <=> (compact (induced_top U K) K))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_REWRITE_TAC[compact]; EQ_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[induced_top_support;SUBSET_INTER;SUBSET_REFL ]; DISCH_ALL_TAC; USE 3 (REWRITE_RULE[induced_top;SUBSET;IN_IMAGE ]); LEFT 3 "x'"; LEFT 3 "x'"; X_CHO 3 `u:(A->bool)->(A->bool)`; TYPE_THEN `IMAGE u V` (USE 1 o SPEC); TYPE_THEN `K SUBSET UNIONS (IMAGE u V) /\ IMAGE u V SUBSET U` SUBGOAL_TAC; REWRITE_TAC[IMAGE;SUBSET;IN_UNIONS;IN_ELIM_THM' ]; CONJ_TAC; REWRITE_TAC[IN]; DISCH_ALL_TAC; USE 2 (REWRITE_RULE[SUBSET;IN_UNIONS ]); USE 2 (REWRITE_RULE[IN ]); TYPE_THEN `x` (USE 2 o SPEC); REWR 2; X_CHO 2 `v:A->bool`; NAME_CONFLICT_TAC; CONV_TAC (quant_left_CONV "x'"); CONV_TAC (quant_left_CONV "x'"); TYPE_THEN `v` EXISTS_TAC; TYPE_THEN `u v` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `v` (USE 3 o SPEC); USE 3 (REWRITE_RULE[IN]); REWR 3; ASSUME_TAC INTER_SUBSET; USE 5 (CONJUNCT1); TYPEL_THEN [`u v`;`K`] (USE 5 o ISPECL); ASM_MESON_TAC[SUBSET;IN]; NAME_CONFLICT_TAC; REWRITE_TAC[IN ]; ASM_MESON_TAC[IN]; DISCH_TAC; REWR 1; CHO 1; AND 1; AND 1; JOIN 6 5; (*** Modified by JRH for changed theorem name USE 5 (MATCH_MP FINITE_SUBSET_IMAGE); ***) USE 5 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); X_CHO 5 `W':(A->bool)->bool`; TYPE_THEN `W'` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `K SUBSET UNIONS (IMAGE u W')` SUBGOAL_TAC; ASM_MESON_TAC[UNIONS_UNIONS ;SUBSET_TRANS]; REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE; ]; NAME_CONFLICT_TAC; REWRITE_TAC[IN]; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `x'` (USE 6 o SPEC); REWR 6; CHO 6; AND 6; CHO 8; AND 5; AND 5; USE 10 (REWRITE_RULE[SUBSET;IN ]); TYPE_THEN `x''` (USE 10 o SPEC); REWR 10; USE 3 (REWRITE_RULE[IN]); TYPE_THEN `x''` (USE 3 o SPEC); REWR 3; TYPE_THEN `x''` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM ONCE_REWRITE_TAC[]; REWRITE_TAC[INTER;IN;IN_ELIM_THM' ]; ASM_MESON_TAC[]; ALL_TAC ; (* dd1*) DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `VK = IMAGE (\b. (b INTER K)) V` ABBREV_TAC ; TYPE_THEN `VK` (USE 2 o SPEC); TYPE_THEN `K SUBSET UNIONS VK /\ VK SUBSET induced_top U K` SUBGOAL_TAC; CONJ_TAC; EXPAND_TAC "VK"; REWRITE_TAC[INTER_THM;GSYM UNIONS_INTER ]; ASM_REWRITE_TAC[SUBSET_INTER;SUBSET_REFL ]; (* end of branch *) REWRITE_TAC[induced_top]; EXPAND_TAC "VK"; REWRITE_TAC[INTER_THM ]; IMATCH_MP_TAC IMAGE_SUBSET; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; REWR 2; X_CHO 2 `WK:(A->bool)->bool`; TYPEL_THEN [`V`;`(INTER) K`;`WK`] (fun t-> MP_TAC (ISPECL t finite_subset )); ASM_REWRITE_TAC[]; AND 2; UND 8; EXPAND_TAC "VK"; REWRITE_TAC[INTER_THM]; DISCH_ALL_TAC; REWR 8; CHO 8; TYPE_THEN `C` EXISTS_TAC; ASM_REWRITE_TAC[]; REWR 2; AND 2; USE 2 (REWRITE_RULE[GSYM UNIONS_INTER]); UND 2; TYPE_THEN `R = UNIONS C` ABBREV_TAC; SET_TAC[]; ]);; (* }}} *) let compact_euclid = prove_by_refinement( `!X n. (X SUBSET euclid n) ==> (compact (top_of_metric(euclid n,d_euclid)) X <=> (closed_ (top_of_metric(euclid n,d_euclid)) X /\ (metric_bounded(X,d_euclid))))`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `top_of_metric (X,d_euclid) = induced_top (top_of_metric(euclid n,d_euclid)) X` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM top_of_metric_induced); ASM_REWRITE_TAC[metric_euclid]; DISCH_TAC; TYPE_THEN `metric_space (X,d_euclid)` SUBGOAL_TAC ; ASM_MESON_TAC [metric_euclid;metric_subspace]; DISCH_TAC ; EQ_TAC; DISCH_ALL_TAC; CONJ_TAC; IMATCH_MP_TAC compact_closed; SIMP_TAC [metric_euclid;metric_hausdorff;top_of_metric_top ]; ASM_REWRITE_TAC[]; REWRITE_TAC[metric_bounded]; IMATCH_MP_TAC totally_bounded_bounded; ASM_REWRITE_TAC[]; IMATCH_MP_TAC compact_totally_bounded ; ASM_REWRITE_TAC[]; ASM_MESON_TAC[induced_compact;top_of_metric_unions;metric_euclid ]; DISCH_ALL_TAC; TYPE_THEN `X SUBSET (UNIONS (top_of_metric (euclid n,d_euclid)))` SUBGOAL_TAC; ASM_MESON_TAC[top_of_metric_unions ; metric_euclid]; ASM_SIMP_TAC [induced_compact ]; ASSUME_TAC metric_euclid; DISCH_TAC; TYPE_THEN `induced_top (top_of_metric(euclid n,d_euclid)) X = top_of_metric(X,d_euclid)` SUBGOAL_TAC; IMATCH_MP_TAC top_of_metric_induced; ASM_REWRITE_TAC[]; DISCH_THEN REWRT_TAC; IMATCH_MP_TAC complete_compact; ASM_REWRITE_TAC[]; CONJ_TAC ; ASM_MESON_TAC[totally_bounded_euclid]; IMATCH_MP_TAC complete_closed; TYPE_THEN `n` EXISTS_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let neg_continuous = prove_by_refinement( `!n. metric_continuous (euclid_neg) (euclid n,d_euclid) (euclid n,d_euclid)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[metric_continuous;metric_continuous_pt]; DISCH_ALL_TAC; RIGHT_TAC "delta"; DISCH_TAC; TYPE_THEN `epsilon` EXISTS_TAC; ASM_REWRITE_TAC[IN ]; DISCH_ALL_TAC; REWRITE_TAC[d_euclid]; REWRITE_TAC[euclid_neg_sum]; REWRITE_TAC[norm_neg]; REWRITE_TAC[GSYM d_euclid]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let continuous_comp = prove_by_refinement( `!(f:A->B) (g:B->C) U V W. continuous f U V /\ continuous g V W /\ (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==> continuous (g o f) U W`, (* {{{ proof *) [ REWRITE_TAC[continuous;IN;preimage]; DISCH_ALL_TAC; X_GEN_TAC `w :C->bool`; DISCH_TAC; TYPE_THEN `w ` (USE 1 o SPEC); REWR 1; TYPE_THEN `{x | UNIONS V x /\ w (g x)}` (USE 0 o SPEC); REWR 0; USE 0 (REWRITE_RULE[IN_ELIM_THM' ]); REWRITE_TAC[o_DEF ]; TYPE_THEN `U {x | UNIONS U x /\ UNIONS V (f x) /\ w (g (f x))} = U {x | UNIONS U x /\ w (g (f x))}` SUBGOAL_TAC; AP_TERM_TAC; IMATCH_MP_TAC EQ_EXT; DISCH_ALL_TAC; REWRITE_TAC[IN_ELIM_THM']; IMATCH_MP_TAC (TAUT `(a ==> b) ==> ((a /\ b /\ c) <=> (a /\ c ))`); TYPE_THEN `UU = UNIONS U ` ABBREV_TAC; TYPE_THEN `VV = UNIONS V` ABBREV_TAC ; USE 2 (REWRITE_RULE[SUBSET;IN_IMAGE ]); ASM_MESON_TAC[IN]; DISCH_THEN (fun t-> (USE 0 ( REWRITE_RULE[t]))); ASM_REWRITE_TAC[]; ]);; (* }}} *) let compact_max = prove_by_refinement( `!(f:A->(num->real)) U K. (continuous f U (top_of_metric(euclid 1,d_euclid))) /\ (IMAGE f K SUBSET (euclid 1)) /\ (compact U K) /\ ~(K=EMPTY)==> (?x. K x /\ (!y. (K y) ==> (f y 0 <= f x 0)))`, (* {{{ proof *) [ DISCH_ALL_TAC; COPY 2; COPY 1; TYPE_THEN `euclid 1 = UNIONS (top_of_metric (euclid 1,d_euclid))` SUBGOAL_TAC; MESON_TAC[top_of_metric_unions;metric_euclid]; DISCH_THEN (fun t-> USE 5 (ONCE_REWRITE_RULE[t])); JOIN 4 5; COPY 0; JOIN 0 4; WITH 0 (MATCH_MP image_compact); UND 4; ASM_SIMP_TAC[compact_euclid]; DISCH_ALL_TAC; TYPE_THEN `P = (IMAGE (coord 0) (IMAGE f K))` ABBREV_TAC ; TYPE_THEN `(?s. !y. (?x. P x /\ y <. x) <=> y <. s)` SUBGOAL_TAC; IMATCH_MP_TAC REAL_SUP_EXISTS; CONJ_TAC; USE 3 (REWRITE_RULE[EMPTY_EXISTS;IN ]); CHO 3; TYPE_THEN `f u 0` EXISTS_TAC; EXPAND_TAC "P"; REWRITE_TAC[IMAGE;IN;IN_ELIM_THM';coord ]; NAME_CONFLICT_TAC; LEFT_TAC "x'"; LEFT_TAC "x'"; TYPE_THEN `u` EXISTS_TAC; ASM_MESON_TAC[]; USE 6 (REWRITE_RULE[metric_bounded;open_ball;SUBSET;IN_IMAGE ]); X_CHO 6 `x0:num->real`; X_CHO 6 `r:real`; USE 6 (REWRITE_RULE[IN;IN_ELIM_THM' ]); EXPAND_TAC "P"; REWRITE_TAC[IMAGE;IN;IN_ELIM_THM';coord]; NAME_CONFLICT_TAC; TYPE_THEN `x0 0 +. r` EXISTS_TAC; DISCH_ALL_TAC; X_CHO 8 `fx:num->real`; AND 8; ASM_REWRITE_TAC[]; KILL 8; X_CHO 9 `x:A`; LEFT 6 "x"; LEFT 6 "x"; TYPE_THEN `x` (USE 6 o SPEC); TYPE_THEN `fx` (USE 6 o SPEC); REWR 6; TYPE_THEN `(d_euclid x0 (f x) = abs (x0 0 - (f x 0)))` SUBGOAL_TAC; IMATCH_MP_TAC euclid1_abs; USE 1 (REWRITE_RULE[SUBSET;IN ]); ASM_MESON_TAC[]; AND 6; AND 6; DISCH_TAC; REWR 6; UND 6; REAL_ARITH_TAC; DISCH_TAC; ALL_TAC ; (* cc1 *) TYPE_THEN `(!u. (P u) ==> (u <=. sup P)) /\ (P (sup P))` SUBGOAL_TAC; REWRITE_TAC[sup]; SELECT_TAC; CHO 8; ASM_REWRITE_TAC[]; DISCH_TAC; TYPE_THEN `s = t` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; USE 10 (MATCH_MP (REAL_ARITH `~(s=t) ==> (s<. t) \/ (t <. s)`)); TYPE_THEN `s ` (WITH 9 o SPEC); TYPE_THEN `t` (WITH 9 o SPEC); ASM_MESON_TAC[REAL_ARITH `~(x <. x)`]; DISCH_TAC; REWR 8; SUBCONJ_TAC; DISCH_ALL_TAC; TYPE_THEN `t` (USE 8 o SPEC); UND 8; REWRITE_TAC[REAL_ARITH `~(x <. x)`]; LEFT_TAC "x"; LEFT_TAC "x"; TYPE_THEN `u` EXISTS_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; TYPE_THEN `~ (IMAGE f K) (t *# (dirac_delta 0))` SUBGOAL_TAC; PROOF_BY_CONTR_TAC; REWR 13; UND 12; EXPAND_TAC "P"; ONCE_REWRITE_TAC[IMAGE]; ONCE_REWRITE_TAC[IMAGE]; ONCE_REWRITE_TAC[IMAGE]; REWRITE_TAC[IN_ELIM_THM';IN]; TYPE_THEN `t *# (dirac_delta 0)` EXISTS_TAC; ASM_REWRITE_TAC[]; ALL_TAC ; (* cc2 *) REWRITE_TAC[coord_dirac]; DISCH_TAC; USE 4 (MATCH_MP closed_open); ASSUME_TAC (SPEC `1` metric_euclid); WITH 14 (MATCH_MP top_of_metric_unions); WITH 15 (GSYM); REWR 4; TYPE_THEN `z = t *# dirac_delta 0` ABBREV_TAC ; TYPE_THEN `(euclid 1 DIFF (IMAGE f K)) z` SUBGOAL_TAC ; REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF]; ASM_REWRITE_TAC[]; EXPAND_TAC "z"; REWRITE_TAC[euclid;euclid_scale;dirac_delta]; DISCH_ALL_TAC; ASSUME_TAC (ARITH_RULE `1 <=| m ==> (~(0=m))`); REWR 19; ASM_REWRITE_TAC[]; REDUCE_TAC; REWRITE_TAC[]; UND 16; DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]); UND 4; REWRITE_TAC[open_DEF]; ASM_SIMP_TAC[top_of_metric_nbd]; DISCH_ALL_TAC; IN_OUT_TAC ; TYPE_THEN `z` (USE 0 o SPEC); KILL 12; KILL 13; KILL 9; UND 14; UND 3; REWRITE_TAC[]; DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); DISCH_ALL_TAC; REWR 0; CHO 0; AND 0; USE 0 (REWRITE_RULE[SUBSET;IN; open_ball;IN_ELIM_THM' ]); COPY 0; TYPE_THEN `(t- (r/(&.2)))*# (dirac_delta 0)` (USE 0 o SPEC); TYPE_THEN `euclid 1 z /\ euclid 1 ((t - r / &2) *# dirac_delta 0) /\ d_euclid z ((t - r / &2) *# dirac_delta 0) < r` SUBGOAL_TAC; EXPAND_TAC "z"; SUBCONJ_TAC; REWRITE_TAC[euclid;dirac_delta;euclid_scale]; GEN_TAC; SIMP_TAC [ (ARITH_RULE `1 <=| m ==> (~(0=m))`)]; REWRITE_TAC[REAL_ARITH `t*(&.0) = (&.0)`]; DISCH_ALL_TAC; SUBCONJ_TAC; REWRITE_TAC[euclid;dirac_delta;euclid_scale]; GEN_TAC; SIMP_TAC [ (ARITH_RULE `1 <=| m ==> (~(0=m))`)]; REWRITE_TAC[REAL_ARITH `t*(&.0) = (&.0)`]; ALL_TAC ; (* cc3 *) UND 13 ; SIMP_TAC[euclid1_abs]; DISCH_ALL_TAC; REWRITE_TAC[euclid_minus ; euclid_scale;dirac_delta ]; REDUCE_TAC ; REWRITE_TAC[REAL_ARITH `t - (t - (r/(&.2))) = r/(&.2)`]; WITH 9 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]); WITH 19 (MATCH_MP (REAL_ARITH `&.0 < x ==> (&.0 <= x)`)); WITH 20 (REWRITE_RULE[GSYM REAL_ABS_REFL]); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_LT_HALF2]; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> (USE 0 (REWRITE_RULE[t]))); ALL_TAC ; (* cc4 *) TYPE_THEN `t - (r/(&.2)) ` (USE 10 o SPEC); TYPE_THEN `t - r / &2 < t` SUBGOAL_TAC; IMATCH_MP_TAC (REAL_ARITH `&.0 < x ==> (t - x < t)`); WITH 9 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]); ASM_REWRITE_TAC[]; DISCH_TAC ; REWR 10; X_CHO 10 `u:real`; TYPE_THEN `u` (USE 7 o SPEC); REWR 7; TYPE_THEN `(euclid 1 DIFF IMAGE f K) (u *# (dirac_delta 0))` SUBGOAL_TAC ; UND 12; DISCH_THEN (IMATCH_MP_TAC ); EXPAND_TAC "z"; SUBCONJ_TAC; REWRITE_TAC[euclid;euclid_scale;dirac_delta]; REWRITE_TAC[ (ARITH_RULE `1 <=| m <=> (~(0=m))`)]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_ALL_TAC; SUBCONJ_TAC; REWRITE_TAC[euclid;euclid_scale;dirac_delta]; REWRITE_TAC[ (ARITH_RULE `1 <=| m <=> (~(0=m))`)]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_ALL_TAC; ASM_SIMP_TAC[euclid1_abs]; EXPAND_TAC "z"; REWRITE_TAC[dirac_delta;euclid_scale;euclid_minus]; REDUCE_TAC; AND 10; REWRITE_TAC[GSYM ABS_BETWEEN]; ASM_REWRITE_TAC[]; CONJ_TAC; UND 7; UND 9; REAL_ARITH_TAC; UND 10; IMATCH_MP_TAC (REAL_ARITH `y <. x ==> ((t - y <. u) ==> (t <. u + x))`); REWRITE_TAC[REAL_LT_HALF2]; ASM_REWRITE_TAC[]; REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF]; IMATCH_MP_TAC (TAUT `B ==> (~(A /\ ~B))`); AND 10; UND 14; EXPAND_TAC "P"; TYPE_THEN `B = IMAGE f K` ABBREV_TAC ; ALL_TAC ; (* cc5 *) REWRITE_TAC[IMAGE;coord;IN;IN_ELIM_THM' ]; DISCH_TAC; CHO 19; AND 19; ASM_REWRITE_TAC[]; USE 17 (REWRITE_RULE[SUBSET;IN]); TYPE_THEN `x` (USE 17 o SPEC); REWR 17; USE 17 (REWRITE_RULE[euclid1_dirac]); ASM_MESON_TAC[]; ASM_MESON_TAC[]; TYPE_THEN `t = sup P` ABBREV_TAC; DISCH_ALL_TAC; UND 11; EXPAND_TAC "P"; REWRITE_TAC[]; ONCE_REWRITE_TAC[IMAGE]; REWRITE_TAC[IN_IMAGE;IN_ELIM_THM';IN ]; NAME_CONFLICT_TAC; DISCH_ALL_TAC; CHO 11; AND 11; CHO 12; REWR 11; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; UND 10; EXPAND_TAC "P"; REWRITE_TAC[]; ONCE_REWRITE_TAC[IMAGE]; REWRITE_TAC[IN_IMAGE;IN_ELIM_THM' ]; REWRITE_TAC[IN]; ASM_REWRITE_TAC[]; REWRITE_TAC[coord]; NAME_CONFLICT_TAC; DISCH_ALL_TAC; TYPE_THEN `f y' 0` (USE 10 o SPEC); UND 10; DISCH_THEN IMATCH_MP_TAC ; LEFT_TAC "x'"; LEFT_TAC "x'"; ASM_MESON_TAC[]; (* finish *) ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* homeomorphisms *) (* ------------------------------------------------------------------ *) let homeomorphism = euclid_def `homeomorphism (f:A->B) U V <=> (BIJ f (UNIONS U) (UNIONS V) ) /\ (continuous f U V) /\ (!A. (U A) ==> (V (IMAGE f A)))`;; let INV_homeomorphism = prove_by_refinement( `!f U V. homeomorphism (f:A-> B) U V ==> (continuous (INV f (UNIONS U) (UNIONS V)) V U)`, (* {{{ proof *) [ REWRITE_TAC[continuous;IN;preimage]; REWRITE_TAC[homeomorphism]; DISCH_ALL_TAC; X_GEN_TAC `u:A->bool`; DISCH_ALL_TAC; TYPE_THEN `{ x | UNIONS V x /\ u (INV f (UNIONS U) (UNIONS V) x)} = IMAGE f u` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT ; X_GEN_TAC `t:B`; REWRITE_TAC[IN_ELIM_THM';IMAGE ;IN ]; EQ_TAC ; DISCH_ALL_TAC; TYPE_THEN `(INV f (UNIONS U) (UNIONS V) t)` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[INVERSE_DEF;IN;BIJ ]; DISCH_ALL_TAC; CHO 4; SUBCONJ_TAC; USE 0 (REWRITE_RULE[BIJ;INJ]); IN_OUT_TAC ; ASM_REWRITE_TAC[]; AND 4; AND 5; TYPE_THEN `x` (USE 6 o SPEC); UND 6; DISCH_THEN (IMATCH_MP_TAC ); REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ]; ASM_MESON_TAC[]; DISCH_TAC ; TYPE_THEN `INV f (UNIONS U) (UNIONS V) t = x` SUBGOAL_TAC; (* stop here this is an example that ASM_MESON_TAC should catch *) (* ASM_MESON_TAC[INVERSE_XY;IN ;UNIONS ]; *) TYPE_THEN `(UNIONS U x)` SUBGOAL_TAC; REWRITE_TAC[UNIONS;IN_ELIM_THM';IN ]; ASM_MESON_TAC[]; ASM_MESON_TAC[INVERSE_XY;IN ]; DISCH_THEN (fun t-> REWRITE_TAC[t]); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); UND 2; DISCH_THEN IMATCH_MP_TAC ; ASM_REWRITE_TAC[]; ]);; (* }}} *) let bicont_homeomorphism = prove_by_refinement( `!f U V. (BIJ (f:A->B) (UNIONS U) (UNIONS V)) /\ (continuous f U V) /\ (continuous (INV f (UNIONS U) (UNIONS V)) V U) ==> (homeomorphism f U V)`, (* {{{ proof *) [ REWRITE_TAC[homeomorphism]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; UND 2; REWRITE_TAC[continuous;IN;preimage ]; DISCH_ALL_TAC; TYPE_THEN `A` (USE 2 o SPEC); REWR 2; TYPE_THEN `{x | UNIONS V x /\ A (INV f (UNIONS U) (UNIONS V) x)}= (IMAGE f A) ` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT ; X_GEN_TAC `t:B`; REWRITE_TAC[IN_ELIM_THM';IMAGE ;IN ]; EQ_TAC ; DISCH_ALL_TAC; TYPE_THEN `(INV f (UNIONS U) (UNIONS V) t)` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[INVERSE_DEF;IN;BIJ ]; DISCH_ALL_TAC; CHO 4; SUBCONJ_TAC; USE 0 (REWRITE_RULE[BIJ;INJ]); IN_OUT_TAC ; ASM_REWRITE_TAC[]; AND 4; AND 5; TYPE_THEN `x` (USE 6 o SPEC); UND 6; DISCH_THEN (IMATCH_MP_TAC ); REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ]; ASM_MESON_TAC[]; DISCH_TAC ; TYPE_THEN `INV f (UNIONS U) (UNIONS V) t = x` SUBGOAL_TAC; TYPE_THEN `(UNIONS U x)` SUBGOAL_TAC; REWRITE_TAC[UNIONS;IN_ELIM_THM';IN ]; ASM_MESON_TAC[]; ASM_MESON_TAC[INVERSE_XY;IN ]; DISCH_THEN (fun t-> REWRITE_TAC[t]); ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let open_and_closed = prove_by_refinement( `!(f:A->B) U V. (topology_ U) /\ (topology_ V) /\ (BIJ f (UNIONS U) (UNIONS V)) ==> ((!A. (U A ==> V (IMAGE f A))) <=> (!B. (closed_ U B) ==> (closed_ V (IMAGE f B))))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[closed]; EQ_TAC; DISCH_ALL_TAC; DISCH_ALL_TAC; SUBCONJ_TAC; UND 4; UND 2; (* should have worked: ASM_MESON_TAC[SUBSET;IN;BIJ;INJ;IMAGE;IN_ELIM_THM' ]; bug found? *) REWRITE_TAC[BIJ;IN;INJ;SUBSET;IMAGE;IN_ELIM_THM' ]; DISCH_ALL_TAC; NAME_CONFLICT_TAC; TYPE_THEN `y:B` X_GEN_TAC; ASM_MESON_TAC[]; DISCH_ALL_TAC; REWRITE_TAC[open_DEF]; USE 5 (REWRITE_RULE[open_DEF]); TYPE_THEN `UNIONS U DIFF B` (USE 3 o SPEC); REWR 3; TYPE_THEN `IMAGE f (UNIONS U DIFF B) = (UNIONS V DIFF IMAGE f B)` SUBGOAL_TAC; ASM_MESON_TAC[DIFF_SURJ]; ASM_MESON_TAC[]; REWRITE_TAC[open_DEF]; DISCH_ALL_TAC; DISCH_ALL_TAC; TYPE_THEN `UNIONS U DIFF A` (USE 3 o SPEC); TYPE_THEN `UNIONS U DIFF A SUBSET UNIONS U /\ U (UNIONS U DIFF (UNIONS U DIFF A))` SUBGOAL_TAC; ASM_SIMP_TAC[sub_union ; DIFF_DIFF2 ]; ASM_REWRITE_TAC[SUBSET_DIFF]; DISCH_TAC ; REWR 3; TYPE_THEN `UNIONS V DIFF IMAGE f (UNIONS U DIFF A) = IMAGE f A` SUBGOAL_TAC; ASM_MESON_TAC[DIFF_SURJ; sub_union; DIFF_DIFF2]; ASM_MESON_TAC[]; ]);; (* }}} *) let hausdorff_homeomorphsim = prove_by_refinement( `!f U V. (BIJ (f:A->B) (UNIONS U) (UNIONS V)) /\ (continuous f U V) /\ (compact U (UNIONS U)) /\ (hausdorff V) /\ (topology_ U) /\ (topology_ V) ==> (homeomorphism f U V)`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_REWRITE_TAC[homeomorphism]; ASM_SIMP_TAC[open_and_closed]; DISCH_ALL_TAC; TYPEL_THEN [`U`;`UNIONS U`;`B`] (fun t-> ASSUME_TAC (SPECL t closed_compact)); REWR 7; WITH 6 (REWRITE_RULE[closed]); REWR 7; IMATCH_MP_TAC compact_closed ; ASM_REWRITE_TAC[]; IMATCH_MP_TAC image_compact; TYPE_THEN `U` EXISTS_TAC; ASM_REWRITE_TAC[]; AND 8; USE 0 (REWRITE_RULE[BIJ;INJ;IN ]); AND 0; AND 10; REWRITE_TAC[SUBSET;IN_IMAGE]; REWRITE_TAC[IN]; USE 9 (REWRITE_RULE[SUBSET;IN]); ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* the metric and topology on the real numbers *) (* ------------------------------------------------------------------ *) let d_real = euclid_def `d_real x y = ||. (x -. y)`;; (* let real_topology = euclid_def `real_topology = top_of_metric (UNIV,d_real)`;; *) let metric_real = prove_by_refinement( `metric_space (UNIV,d_real)`, (* {{{ proof *) [ REWRITE_TAC[metric_space;UNIV;d_real ]; REAL_ARITH_TAC; ]);; (* }}} *) let continuous_euclid1 = prove_by_refinement( `!i n. continuous (coord i) (top_of_metric (euclid n,d_euclid)) (top_of_metric (UNIV,d_real))`, (* {{{ proof *) [ TYPE_THEN `!i n . IMAGE (coord i) (euclid n) SUBSET (UNIV) /\ metric_space (euclid n,d_euclid) /\ metric_space (UNIV,d_real)` SUBGOAL_TAC; REP_GEN_TAC; REWRITE_TAC[UNIV ;SUBSET;IN]; REWRITE_TAC[metric_euclid;metric_real;GSYM UNIV]; DISCH_TAC; DISCH_ALL_TAC; TYPEL_THEN [`i`;`n`] (USE 0 o SPECL); USE 0 (IMATCH_MP metric_continuous_continuous); ASM_REWRITE_TAC[]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; DISCH_ALL_TAC; RIGHT_TAC "delta"; DISCH_ALL_TAC; REWRITE_TAC[d_real;IN;coord]; TYPE_THEN `epsilon` EXISTS_TAC; ASM_REWRITE_TAC[]; GEN_TAC; DISCH_ALL_TAC; UND 4; IMATCH_MP_TAC (REAL_ARITH `(a <=. b) ==> ((b <. e) ==> (a <. e))`); ASM_MESON_TAC[proj_contraction]; ]);; (* }}} *) let interval_closed_ball = prove_by_refinement( `!a b . ? x r. (a <=. b) ==> ({x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} = (closed_ball(euclid 1,d_euclid)) x r)`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `((a +b)/(&.2)) *# (dirac_delta 0)` EXISTS_TAC; TYPE_THEN `((b -a)/(&.2))` EXISTS_TAC; DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[closed_ball;IN_ELIM_THM']; DISCH_ALL_TAC; IMATCH_MP_TAC (TAUT `(a ==> (b <=> d /\ c)) ==> (a /\ b <=> d /\ a /\ c)`); DISCH_ALL_TAC; TYPE_THEN `z = ((a + b) / &2 *# dirac_delta 0)` ABBREV_TAC; TYPE_THEN `euclid 1 z` SUBGOAL_TAC; EXPAND_TAC "z"; MESON_TAC[euclid_dirac]; DISCH_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[euclid1_abs]; EXPAND_TAC "z"; TYPE_THEN `t = x 0` ABBREV_TAC ; REWRITE_TAC[dirac_delta;euclid_scale]; REDUCE_TAC ; REWRITE_TAC[GSYM INTERVAL_ABS ]; IMATCH_MP_TAC (TAUT `((a = d) /\ (b = C)) ==> ((a /\ b) <=> (C /\ d))`); ONCE_REWRITE_TAC[REAL_ARITH `((x <=. u + v) <=> (x - v <=. u)) /\ ((x - u <= v) <=> (x <=. v + u))`]; CONJ_TAC; TYPE_THEN `(a + b) / &2 - (b - a) / &2 = a` SUBGOAL_TAC ; REWRITE_TAC[real_div]; REWRITE_TAC[REAL_ARITH `(a+b)*C - (b-a)*C = a*(&.2*C) `]; REDUCE_TAC ; DISCH_THEN (fun t-> REWRITE_TAC[t]); TYPE_THEN `(a+ b) /(&.2) + (b - a)/(&.2) = b` SUBGOAL_TAC; REWRITE_TAC[real_div]; REWRITE_TAC[REAL_ARITH `(a+b) * C + (b - a) * C = b *(&.2*C)`]; REDUCE_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); ]);; (* }}} *) let interval_euclid1_closed = prove_by_refinement( `!a b. closed_ (top_of_metric (euclid 1,d_euclid)) {x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}`, (* {{{ proof *) [ DISCH_ALL_TAC; ASM_CASES_TAC `a <=. b`; ASSUME_TAC interval_closed_ball; TYPEL_THEN [`a`;`b`] (USE 1 o SPECL); (CHO 1); CHO 1; REWR 1; ASM_REWRITE_TAC[]; IMATCH_MP_TAC closed_ball_closed; REWRITE_TAC[metric_euclid]; TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}= EMPTY ` SUBGOAL_TAC ; REWRITE_TAC[EQ_EMPTY;IN_ELIM_THM' ]; GEN_TAC; TYPE_THEN `t = x 0 ` ABBREV_TAC; KILL 1; IMATCH_MP_TAC (TAUT `~(b /\ C) ==> ~( a /\ b/\ C)`); UND 0; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); IMATCH_MP_TAC empty_closed; IMATCH_MP_TAC top_of_metric_top ; REWRITE_TAC[metric_euclid]; ]);; (* }}} *) let interval_euclid1_bounded = prove_by_refinement( `!a b. metric_bounded ({x | euclid 1 x /\ a <= x 0 /\ x 0 <= b},d_euclid)`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[metric_bounded]; ASSUME_TAC interval_closed_ball; TYPEL_THEN [`a`;`b`] (USE 0 o SPECL); CHO 0; CHO 0; ASM_CASES_TAC `a <=. b`; REWR 0; ASM_REWRITE_TAC[]; TYPE_THEN `x` EXISTS_TAC; TYPE_THEN `r + (&.1) ` EXISTS_TAC; REWRITE_TAC[open_ball;SUBSET;IN ;IN_ELIM_THM' ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 2; REWRITE_TAC[closed_ball;IN_ELIM_THM' ]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 4; ASM_SIMP_TAC[euclid1_abs ]; TYPE_THEN `t = x 0` ABBREV_TAC; TYPE_THEN `s = x' 0` ABBREV_TAC; DISCH_ALL_TAC; TYPE_THEN `&.0 <=. r` SUBGOAL_TAC; UND 6; REAL_ARITH_TAC; DISCH_ALL_TAC; REDUCE_TAC; ASM_REWRITE_TAC[]; UND 6; UND 7; REAL_ARITH_TAC ; TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} = EMPTY` SUBGOAL_TAC; REWRITE_TAC[EQ_EMPTY;IN_ELIM_THM' ]; GEN_TAC; TYPE_THEN `t = x 0 ` ABBREV_TAC; KILL 2; IMATCH_MP_TAC (TAUT `~(b /\ C) ==> ~( a /\ b/\ C)`); UND 1; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); REWRITE_TAC[EMPTY_SUBSET]; ]);; (* }}} *) let interval_euclid1_compact = prove_by_refinement( `!a b. compact (top_of_metric(euclid 1,d_euclid)) {x | (euclid 1 x) /\ (a <=. (x 0)) /\ (x 0 <= b)}`, (* {{{ proof *) [ DISCH_ALL_TAC; TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} SUBSET (euclid 1)` SUBGOAL_TAC; REWRITE_TAC [SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; DISCH_TAC; ASM_SIMP_TAC[compact_euclid]; CONJ_TAC; MATCH_ACCEPT_TAC interval_euclid1_closed; MATCH_ACCEPT_TAC interval_euclid1_bounded; ]);; (* }}} *) let interval_image = prove_by_refinement( `!a b. {x | a <=. x /\ (x <= b)} = IMAGE (coord 0) {x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}`, (* {{{ proof *) [ DISCH_ALL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM';IMAGE]; GEN_TAC; EQ_TAC; DISCH_ALL_TAC; TYPE_THEN `x *# (dirac_delta 0)` EXISTS_TAC; REWRITE_TAC[coord_dirac;euclid_dirac;dirac_0]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; CHO 0; USE 0 (REWRITE_RULE[coord]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let interval_compact = prove_by_refinement( `!a b. compact (top_of_metric (UNIV,d_real)) {x | a <=. x /\ (x <=. b)} `, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[interval_image]; IMATCH_MP_TAC image_compact; TYPE_THEN `(top_of_metric (euclid 1,d_euclid))` EXISTS_TAC; REWRITE_TAC[continuous_euclid1;interval_euclid1_compact]; SIMP_TAC[GSYM top_of_metric_unions;metric_real]; REWRITE_TAC[UNIV;SUBSET;IN]; ]);; (* }}} *) let half_open = prove_by_refinement( `!a. top_of_metric(UNIV,d_real ) { x | x <. a}`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC open_nbd ; TYPEL_THEN [`top_of_metric (UNIV,d_real)`;` {x | x < a}`] (USE 0 o ISPECL); USE 0 (SIMP_RULE[top_of_metric_top;metric_real ]); ASM_REWRITE_TAC[]; GEN_TAC; TYPE_THEN `open_ball (UNIV,d_real) x (a - x)` EXISTS_TAC; REWRITE_TAC[IN_ELIM_THM']; DISCH_ALL_TAC; CONJ_TAC; REWRITE_TAC[open_ball;d_real ;IN;IN_ELIM_THM';UNIV ;SUBSET ]; GEN_TAC ; UND 1; REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); REWRITE_TAC[metric_real; UNIV ]; UND 1; REAL_ARITH_TAC; IMATCH_MP_TAC open_ball_open; REWRITE_TAC[metric_real]; ]);; (* }}} *) let half_open_above = prove_by_refinement( `!a. top_of_metric(UNIV,d_real ) { x | a <. x}`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC open_nbd ; TYPEL_THEN [`top_of_metric (UNIV,d_real)`;` {x | a <. x}`] (USE 0 o ISPECL); USE 0 (SIMP_RULE[top_of_metric_top;metric_real ]); ASM_REWRITE_TAC[]; GEN_TAC; TYPE_THEN `open_ball (UNIV,d_real) x (x -. a)` EXISTS_TAC; REWRITE_TAC[IN_ELIM_THM']; DISCH_ALL_TAC; CONJ_TAC; REWRITE_TAC[open_ball;d_real ;IN;IN_ELIM_THM';UNIV ;SUBSET ]; GEN_TAC ; UND 1; REAL_ARITH_TAC; CONJ_TAC; IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); REWRITE_TAC[metric_real; UNIV ]; UND 1; REAL_ARITH_TAC; IMATCH_MP_TAC open_ball_open; REWRITE_TAC[metric_real]; ]);; (* }}} *) let joinf = euclid_def `joinf (f:real -> A) g a = (\ x . (if (x <. a) then (f x) else (g x)))`;; let joinf_cont = prove_by_refinement( `!U a (f:real -> A) g. (continuous f (top_of_metric(UNIV,d_real)) U) /\ (continuous g (top_of_metric(UNIV,d_real)) U) /\ (f a = (g a)) ==> ( (continuous (joinf f g a) (top_of_metric(UNIV,d_real)) U))`, (* {{{ proof *) [ REWRITE_TAC[continuous]; DISCH_ALL_TAC; DISCH_ALL_TAC; REWRITE_TAC[IN ]; ASSUME_TAC open_nbd; TYPEL_THEN [`top_of_metric (UNIV,d_real)`;`(preimage (UNIONS (top_of_metric (UNIV,d_real))) (joinf f g a) v)`] (USE 4 o ISPECL); USE 4 (SIMP_RULE [top_of_metric_top;metric_real ]); ASM_REWRITE_TAC[]; GEN_TAC; REWRITE_TAC[subset_preimage]; RIGHT_TAC "B"; DISCH_TAC; SIMP_TAC[GSYM top_of_metric_unions; metric_real]; REWRITE_TAC[SUBSET_UNIV]; MP_TAC (REAL_ARITH `(x = a) \/ (x <. a) \/ (a <. x)`); REP_CASES_TAC; TYPE_THEN `B = (preimage (UNIONS (top_of_metric (UNIV,d_real))) f v) INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) g v)` ABBREV_TAC ; TYPE_THEN `B` EXISTS_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;IN_IMAGE;IN ]; GEN_TAC; LEFT_TAC "x"; GEN_TAC ; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 9; EXPAND_TAC "B"; REWRITE_TAC[INTER;IN_ELIM_THM';IN ]; REWRITE_TAC[REWRITE_RULE[IN] in_preimage;joinf ]; COND_CASES_TAC; MESON_TAC[]; MESON_TAC[]; CONJ_TAC ; ASM_REWRITE_TAC[]; UND 5; EXPAND_TAC "B"; REWRITE_TAC[INTER;IN;IN_ELIM_THM']; REWRITE_TAC[REWRITE_RULE[IN] in_preimage]; ASM_REWRITE_TAC[]; REWRITE_TAC[joinf]; REWRITE_TAC[REAL_ARITH `~(a<. a)`]; ASSUME_TAC top_of_metric_top; TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL); USE 8 (REWRITE_RULE[metric_real ]); USE 8 (REWRITE_RULE[topology]); EXPAND_TAC "B"; KILL 7; TYPE_THEN `v` (USE 0 o SPEC); TYPE_THEN `v` (USE 1 o SPEC); ASM_MESON_TAC[IN ]; (* 2nd case x < a *) TYPE_THEN `B = { x | x <. a } INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) f v)` ABBREV_TAC ; TYPE_THEN `B` EXISTS_TAC; CONJ_TAC; ASM_REWRITE_TAC[SUBSET;IN_IMAGE ; IN;joinf ]; GEN_TAC ; LEFT_TAC "x"; GEN_TAC ; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 9; EXPAND_TAC "B"; REWRITE_TAC[INTER ;IN ;IN_ELIM_THM']; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; USE 10 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]); ASM_REWRITE_TAC[]; CONJ_TAC; UND 5; EXPAND_TAC "B"; REWRITE_TAC[INTER;IN;IN_ELIM_THM']; REWRITE_TAC[REWRITE_RULE[IN] in_preimage]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 8; REWRITE_TAC[joinf]; ASM_REWRITE_TAC[]; ASSUME_TAC top_of_metric_top; TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL); USE 8 (REWRITE_RULE[metric_real ]); USE 8 (REWRITE_RULE[topology]); TYPE_THEN `v` (USE 0 o SPEC); TYPE_THEN `v` (USE 1 o SPEC); EXPAND_TAC "B"; KILL 7; KILL 5; KILL 4; KILL 1; KILL 6; TYPEL_THEN [`{x | x < a}`;`preimage (UNIONS (top_of_metric (UNIV,d_real))) f v`] (USE 8 o ISPECL); RIGHT 1 "V"; RIGHT 1 "V"; AND 1; AND 1; REWR 0; USE 0 (REWRITE_RULE[IN]); REWR 5; USE 5 (REWRITE_RULE[half_open]); ASM_REWRITE_TAC[]; (* case 3 a < x *) TYPE_THEN `B = { x | a <. x } INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) g v)` ABBREV_TAC ; TYPE_THEN `B` EXISTS_TAC; CONJ_TAC; ASM_REWRITE_TAC[SUBSET;IN_IMAGE ; IN;joinf ]; GEN_TAC ; LEFT_TAC "x"; GEN_TAC ; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 9; EXPAND_TAC "B"; REWRITE_TAC[INTER ;IN ;IN_ELIM_THM']; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; USE 10 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]); ASM_REWRITE_TAC[]; USE 9 (MATCH_MP (REAL_ARITH `a < x'' ==> (~(x'' <. a))`)); ASM_REWRITE_TAC[]; CONJ_TAC; UND 5; EXPAND_TAC "B"; REWRITE_TAC[INTER;IN;IN_ELIM_THM']; REWRITE_TAC[REWRITE_RULE[IN] in_preimage]; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; UND 8; REWRITE_TAC[joinf]; USE 6 (MATCH_MP (REAL_ARITH `a < x'' ==> (~(x'' <. a))`)); ASM_REWRITE_TAC[]; ASSUME_TAC top_of_metric_top; TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL); USE 8 (REWRITE_RULE[metric_real ]); USE 8 (REWRITE_RULE[topology]); TYPE_THEN `v` (USE 0 o SPEC); TYPE_THEN `v` (USE 1 o SPEC); EXPAND_TAC "B"; KILL 7; KILL 5; KILL 4; KILL 0; KILL 6; TYPEL_THEN [`{x | a < x}`;`preimage (UNIONS (top_of_metric (UNIV,d_real))) g v`] (USE 8 o ISPECL); RIGHT 0 "V"; RIGHT 0 "V"; AND 0; AND 0; REWR 1; USE 1 (REWRITE_RULE[IN]); REWR 5; USE 5 (REWRITE_RULE[half_open_above]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let neg_cont = prove_by_refinement( `continuous ( --.) (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real)) `, (* {{{ proof *) [ TYPE_THEN `IMAGE ( --. ) (UNIV) SUBSET (UNIV)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN;UNION;UNIV ]; DISCH_TAC; ASM_SIMP_TAC[metric_continuous_continuous;metric_real ]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; DISCH_ALL_TAC; TYPE_THEN `epsilon` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[UNIV;IN;d_real ]; REAL_ARITH_TAC; ]);; (* }}} *) let add_cont = prove_by_refinement( `!u. (continuous ( (+.) u)) (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real)) `, (* {{{ proof *) [ GEN_TAC; TYPE_THEN `IMAGE ( (+.) u ) (UNIV) SUBSET (UNIV)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN;UNION;UNIV ]; DISCH_TAC; ASM_SIMP_TAC[metric_continuous_continuous;metric_real ]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; DISCH_ALL_TAC; TYPE_THEN `epsilon` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[UNIV;IN;d_real ]; REAL_ARITH_TAC; ]);; (* }}} *) let continuous_scale = prove_by_refinement( `!x n. (euclid n x) ==> (continuous (\t. (t *# x)) (top_of_metric(UNIV,d_real)) (top_of_metric(euclid n,d_euclid)))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASSUME_TAC metric_euclid; ASSUME_TAC metric_real ; TYPE_THEN `IMAGE (\t. (t *# x)) (UNIV) SUBSET (euclid n)` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN_IMAGE;IN_ELIM_THM']; REWRITE_TAC[Q_ELIM_THM'';IN ; UNIV ]; ASM_MESON_TAC[euclid_scale_closure]; ASM_SIMP_TAC[metric_continuous_continuous]; DISCH_TAC; REWRITE_TAC[metric_continuous;metric_continuous_pt]; DISCH_ALL_TAC; REWRITE_TAC[IN;UNIV]; TYPE_THEN `euclidean x` SUBGOAL_TAC; ASM_MESON_TAC[euclidean]; ASM_SIMP_TAC[norm_scale;d_real]; DISCH_TAC; TYPE_THEN `norm x <=. &.1` ASM_CASES_TAC ; TYPE_THEN `epsilon` EXISTS_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; MP_TAC (SPEC `x' -. y` REAL_ABS_POS); DISCH_TAC ; USE 5 (MATCH_MP (SPEC `x' -. y` REAL_PROP_LE_LABS)); USE 5 (CONV_RULE REDUCE_CONV); UND 5; UND 7; REAL_ARITH_TAC ; TYPE_THEN `epsilon / norm x` EXISTS_TAC; DISCH_ALL_TAC; CONJ_TAC; IMATCH_MP_TAC REAL_LT_DIV; ASM_REWRITE_TAC[]; UND 5; REAL_ARITH_TAC; DISCH_ALL_TAC; ASM_MESON_TAC[REAL_ARITH `~(x <= &.1) ==> (&.0 <. x)`;REAL_LT_RDIV_EQ]; ]);; (* }}} *) let continuous_lin_combo = prove_by_refinement( `! x y n. (euclid n x) /\ (euclid n y) ==> (continuous (\t. (t *# x + (&.1 - t) *# y)) (top_of_metric(UNIV,d_real)) (top_of_metric(euclid n,d_euclid)))`, (* {{{ proof *) let comp_elim_tac = ( IMATCH_MP_TAC continuous_comp THEN TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC THEN ASM_SIMP_TAC[add_cont;neg_cont;continuous_scale] THEN REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM''] THEN SIMP_TAC[GSYM top_of_metric_unions ;metric_real;IN_UNIV ] ) in [ DISCH_ALL_TAC; IMATCH_MP_TAC continuous_sum; ASM_SIMP_TAC[metric_real;metric_euclid;top_of_metric_top;continuous_scale;SUBSET ;IN_IMAGE;Q_ELIM_THM'' ]; ASM_SIMP_TAC[IN;euclid_scale_closure;continuous_scale]; TYPE_THEN `(\t . (&. 1 - t) *# y) = (\t. t *# y) o ((--.) o ((+.) (--. (&.1))))` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[o_DEF;REAL_ARITH `--.(--. u +. v) = (u -. v)`]; DISCH_THEN (fun t-> REWRITE_TAC [t]); REPEAT comp_elim_tac; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Connected Sets *) (* ------------------------------------------------------------------ *) let connected = euclid_def `connected U (Z:A->bool) <=> (Z SUBSET (UNIONS U)) /\ (!A B. (U A) /\ (U B) /\ (A INTER B = EMPTY ) /\ (Z SUBSET (A UNION B)) ==> ((Z SUBSET A) \/ (Z SUBSET B)))`;; let connected_unions = prove_by_refinement( `!U (Z1:A->bool) Z2. (connected U Z1) /\ (connected U Z2) /\ ~(Z1 INTER Z2 = EMPTY) ==> (connected U (Z1 UNION Z2))`, (* {{{ proof *) [ REWRITE_TAC[connected]; DISCH_ALL_TAC; DISCH_ALL_TAC; SUBCONJ_TAC; REWRITE_TAC[UNION;SUBSET;IN;IN_ELIM_THM' ]; ASM_MESON_TAC[SUBSET ;IN]; DISCH_TAC ; DISCH_ALL_TAC; TYPEL_THEN [`A`;`B`] (USE 1 o SPECL); REWR 1; TYPEL_THEN [`A`;`B`] (USE 3 o SPECL); REWR 3; WITH 9 (REWRITE_RULE[union_subset]); REWR 1; REWR 3; IMATCH_MP_TAC (TAUT `(~b ==> a) ==> (a \/ b)`); DISCH_ALL_TAC; USE 11 (REWRITE_RULE[union_subset]); (* start a case *) USE 4 (REWRITE_RULE[EMPTY_EXISTS]); CHO 4; USE 4 (REWRITE_RULE[IN;INTER;IN_ELIM_THM' ]); REWRITE_TAC[union_subset]; TYPE_THEN `~((Z1 SUBSET A) /\ (Z2 SUBSET B))` SUBGOAL_TAC; DISCH_ALL_TAC; USE 8 (REWRITE_RULE[EQ_EMPTY]); USE 8 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]); ASM_MESON_TAC[SUBSET;IN]; TYPE_THEN `~((Z2 SUBSET A) /\ (Z1 SUBSET B))` SUBGOAL_TAC; DISCH_ALL_TAC; USE 8 (REWRITE_RULE[EQ_EMPTY]); USE 8 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]); ASM_MESON_TAC[SUBSET;IN]; ASM_MESON_TAC[]; ]);; (* }}} *) let component_DEF = euclid_def `component U (x:A) y <=> (?Z. (connected U Z) /\ (Z x) /\ (Z y))`;; let connected_sing = prove_by_refinement( `!U (x:A). (UNIONS U x) ==> (connected U {x})`, (* {{{ proof *) [ REWRITE_TAC[connected]; DISCH_ALL_TAC; CONJ_TAC; REWRITE_TAC[SUBSET;IN_SING ]; ASM_MESON_TAC[IN]; DISCH_ALL_TAC; UND 4; SET_TAC[]; ]);; (* }}} *) let component_refl = prove_by_refinement( `!U x. (UNIONS U x) ==> (component U x (x:A))`, (* {{{ proof *) [ REWRITE_TAC[component_DEF]; ASM_MESON_TAC[IN_SING;IN;connected_sing]; ]);; (* }}} *) let component_symm = prove_by_refinement( `!U x y. (component U x y) ==> (component U (y:A) x)`, (* {{{ proof *) [ MESON_TAC[component_DEF]; ]);; (* }}} *) let component_trans = prove_by_refinement( `!U (x:A) y z. (component U x y) /\ (component U y z) ==> (component U x z)`, (* {{{ proof *) [ REWRITE_TAC[component_DEF]; DISCH_ALL_TAC; CHO 0; CHO 1; TYPE_THEN `connected U (Z UNION Z')` SUBGOAL_TAC; IMATCH_MP_TAC connected_unions; ASM_REWRITE_TAC[]; REWRITE_TAC[EMPTY_EXISTS ]; REWRITE_TAC[IN;INTER;IN_ELIM_THM' ]; TYPE_THEN `y` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; TYPE_THEN `Z UNION Z'` EXISTS_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[UNION;IN;IN_ELIM_THM' ]; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* based on the Bolzano lemma *) let connect_real = prove_by_refinement( `!a b. connected (top_of_metric (UNIV,d_real)) {x | a <=. x /\ x <=. b }`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[connected]; ASSUME_TAC metric_real; ASM_SIMP_TAC[GSYM top_of_metric_unions]; SUBCONJ_TAC; REWRITE_TAC[UNIV;SUBSET;IN ]; DISCH_TAC; DISCH_ALL_TAC; TYPE_THEN `\ (u ,v ). ( u <. a) \/ (b <. v) \/ ({x | u <=. x /\ x <=. v } SUBSET A) \/ ({x | u <=. x /\ x <=. v } SUBSET B)` (fun t-> ASSUME_TAC (SPEC t BOLZANO_LEMMA )); UND 6; GBETA_TAC ; IMATCH_MP_TAC (TAUT `((b ==> c ) /\ a ) ==> ((a ==> b) ==> c )`); CONJ_TAC; DISCH_ALL_TAC; TYPEL_THEN [`a`;`b`] ((USE 6 o SPECL)); USE 6 (REWRITE_RULE[ARITH_RULE `~(a <. a)`]); ASM_CASES_TAC `a <=. b`; REWR 6; TYPE_THEN `{x | a <=. x /\ x <=. b} = EMPTY ` SUBGOAL_TAC; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM';EMPTY]; GEN_TAC; UND 7; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); REWRITE_TAC[EMPTY_SUBSET]; CONJ_TAC; DISCH_ALL_TAC; UND 8; UND 9; (* c1 *) USE 4 (REWRITE_RULE[EQ_EMPTY;INTER;IN;IN_ELIM_THM' ]); TYPE_THEN `b'` (USE 4 o SPEC); TYPE_THEN `{x | a' <=. x /\ x <=. b' } b'` SUBGOAL_TAC; ASM_REWRITE_TAC[IN_ELIM_THM']; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `{x | b' <=. x /\ x <=. c } b'` SUBGOAL_TAC; ASM_REWRITE_TAC[IN_ELIM_THM']; REAL_ARITH_TAC; DISCH_TAC; TYPE_THEN `{x | a' <=. x /\ x <=. b' } UNION {x | b' <=. x /\ x <= c } = { x | a' <=. x /\ x <=. c }` SUBGOAL_TAC; REWRITE_TAC[UNION;IN;IN_ELIM_THM']; IMATCH_MP_TAC EQ_EXT ; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; UND 6; UND 7; REAL_ARITH_TAC; DISCH_TAC; (* cr 1*) REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ASM_REWRITE_TAC[] THEN (TRY (GEN_MESON_TAC 0 7 1[REAL_ARITH `(b < b' /\ b' <=. c ==> b <. c ) /\ (a' <=. b' /\ b' <. a ==> a' <. a)`])); IMATCH_MP_TAC (TAUT `c ==> (a \/ b \/ c \/ d)`); UND 10; DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]); ASM_REWRITE_TAC[union_subset]; (* ASM_MESON_TAC[SUBSET;IN]; should have worked *) PROOF_BY_CONTR_TAC; UND 11; UND 12; UND 9; UND 8; UND 4; REWRITE_TAC[SUBSET;IN]; TYPE_THEN `R ={x | a' <=. x /\ x <=. b'}` ABBREV_TAC; TYPE_THEN `S = {x | b' <=. x /\ x <=. c}` ABBREV_TAC; MESON_TAC[]; (* ok now it works *) PROOF_BY_CONTR_TAC; UND 11; UND 12; UND 9; UND 8; UND 4; REWRITE_TAC[SUBSET;IN]; TYPE_THEN `R ={x | a' <=. x /\ x <=. b'}` ABBREV_TAC; TYPE_THEN `S = {x | b' <=. x /\ x <=. c}` ABBREV_TAC; MESON_TAC[]; (* ok now it works *) IMATCH_MP_TAC (TAUT `d ==> (a \/ b \/ c \/ d)`); UND 10; DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]); ASM_REWRITE_TAC[union_subset]; (* cr 2*) DISCH_ALL_TAC; ASM_CASES_TAC `x <. a`; TYPE_THEN `&.1` EXISTS_TAC; REDUCE_TAC; DISCH_ALL_TAC; DISJ1_TAC ; UND 7; UND 6; REAL_ARITH_TAC; ASM_CASES_TAC `b <. x`; TYPE_THEN `&.1` EXISTS_TAC; REDUCE_TAC; DISCH_ALL_TAC; DISJ2_TAC; DISJ1_TAC; UND 9; UND 7; REAL_ARITH_TAC; TYPE_THEN ` (A UNION B) x` SUBGOAL_TAC; USE 5 (REWRITE_RULE[SUBSET;IN]); UND 5; DISCH_THEN (IMATCH_MP_TAC ); REWRITE_TAC[IN_ELIM_THM']; UND 7; UND 6; REAL_ARITH_TAC; DISCH_TAC; (* cr3 *) TYPEL_THEN [`UNIV:real -> bool`;`d_real`] (fun t-> (ASSUME_TAC (ISPECL t open_ball_nbd))); (* --//-- *) USE 8 (REWRITE_RULE[REWRITE_RULE[IN] IN_UNION]); TYPE_THEN `A x` ASM_CASES_TAC; (* *) TYPE_THEN `A` (USE 9 o SPEC); TYPE_THEN `x` (USE 9 o SPEC); (* --//-- *) CHO 9; REWR 9; USE 9 (REWRITE_RULE[open_ball;d_real;UNIV ]); TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; IMATCH_MP_TAC (TAUT `C ==> (a \/ b \/ C\/ d)`); AND 9; UND 9; TYPE_THEN `{x | a' <=. x /\ x <=. b'} SUBSET {y | abs (x - y) <. e}` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; GEN_TAC; UND 11; UND 12; UND 13; REAL_ARITH_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; REWR 8; TYPE_THEN `B` (USE 9 o SPEC); TYPE_THEN `x` (USE 9 o SPEC); (* --//-- *) CHO 9; REWR 9; USE 9 (REWRITE_RULE[open_ball;d_real;UNIV ]); TYPE_THEN `e` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; IMATCH_MP_TAC (TAUT `d ==> (a \/ b \/ C\/ d)`); AND 9; UND 9; TYPE_THEN `{x | a' <=. x /\ x <=. b'} SUBSET {y | abs (x - y) <. e}` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; GEN_TAC; UND 11; UND 12; UND 13; REAL_ARITH_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ]; MESON_TAC[]; ]);; (* }}} *) let connect_image = prove_by_refinement( `!f U V Z. (continuous (f:A->B) U V) /\ (IMAGE f Z SUBSET (UNIONS V)) /\ (connected U Z) ==> (connected V (IMAGE f Z))`, (* {{{ proof *) [ REWRITE_TAC[connected]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; USE 0 (REWRITE_RULE[continuous;IN ]); TYPE_THEN `A` (WITH 0 o SPEC); TYPE_THEN `B` (USE 0 o SPEC); TYPE_THEN `(preimage (UNIONS U) f A)` (USE 3 o SPEC); TYPE_THEN `(preimage (UNIONS U) f B)` (USE 3 o SPEC); USE 6 (MATCH_MP preimage_disjoint ); TYPE_THEN `Z SUBSET preimage (UNIONS U) f A UNION preimage (UNIONS U) f B` SUBGOAL_TAC; REWRITE_TAC[preimage_union]; ASM_REWRITE_TAC[]; USE 3 (REWRITE_RULE[subset_preimage ]); ASM_MESON_TAC[]; ]);; (* }}} *) let path = euclid_def `path U x y <=> (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ (f a = (x:A)) /\ (f b = y))`;; (**** Old proof modified by JRH to avoid use of GSPEC let const_continuous = prove_by_refinement( `!U V y. (topology_ U) ==> (continuous (\ (x:A). (y:B)) U V)`, (* {{{ proof *) [ REWRITE_TAC[continuous]; DISCH_ALL_TAC; REWRITE_TAC[IN]; DISCH_ALL_TAC; REWRITE_TAC[preimage;IN ]; TYPE_THEN `v y` ASM_CASES_TAC ; ASM_REWRITE_TAC[IN_ELIM_THM;GSPEC ]; USE 0 (MATCH_MP top_univ); TYPE_THEN`t = UNIONS U` ABBREV_TAC; UND 0; REWRITE_TAC[ETA_AX]; ASM_REWRITE_TAC[GSPEC ]; USE 0 (MATCH_MP open_EMPTY); USE 0 (REWRITE_RULE[open_DEF ;EMPTY]); ASM_REWRITE_TAC[]; ]);; (* }}} *) ****) let const_continuous = prove_by_refinement( `!U V y. (topology_ U) ==> (continuous (\ (x:A). (y:B)) U V)`, (* {{{ proof *) [ REWRITE_TAC[continuous]; DISCH_ALL_TAC; REWRITE_TAC[IN]; DISCH_ALL_TAC; REWRITE_TAC[preimage;IN ]; TYPE_THEN `v y` ASM_CASES_TAC ; ASM_REWRITE_TAC[IN_ELIM_THM]; USE 0 (MATCH_MP top_univ); TYPE_THEN`t = UNIONS U` ABBREV_TAC; UND 0; MATCH_MP_TAC(TAUT `(a <=> b) ==> a ==> b`); AP_TERM_TAC; REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN]; USE 0 (MATCH_MP open_EMPTY); USE 0 (REWRITE_RULE[open_DEF ;EMPTY]); ASM_REWRITE_TAC[]; SUBGOAL_THEN `{x:A | F} = \x. F` SUBST1_TAC; REWRITE_TAC[EXTENSION; IN; IN_ELIM_THM]; ASM_REWRITE_TAC[] ]);; (* }}} *) let path_component = euclid_def `path_component U x y <=> (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ (a <. b) /\ (f a = (x:A)) /\ (f b = y) /\ (IMAGE f { t | a <=. t /\ t <=. b } SUBSET (UNIONS U)))`;; let path_refl = prove_by_refinement( `!U x. (UNIONS U x) ==> (path_component U x (x:A))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASSUME_TAC (top_of_metric_top ); TYPEL_THEN [`UNIV:real ->bool`;`d_real`] (USE 1 o ISPECL); USE 1 (REWRITE_RULE[metric_real ]); USE 1 (MATCH_MP const_continuous); REWRITE_TAC[path_component]; TYPE_THEN `(\ (t:real). x)` EXISTS_TAC; ASM_REWRITE_TAC[IMAGE;IN;]; TYPE_THEN `&.0` EXISTS_TAC; TYPE_THEN `&.1` EXISTS_TAC; CONJ_TAC; REAL_ARITH_TAC; REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; ASM_MESON_TAC[]; ]);; (* }}} *) let path_symm = prove_by_refinement( `!U x y . (path_component U x (y:A)) ==> (path_component U y (x:A))`, (* {{{ proof *) [ REWRITE_TAC[path_component]; DISCH_ALL_TAC; (CHO 0); (CHO 0); (CHO 0); TYPE_THEN `f o (--.)` EXISTS_TAC; TYPE_THEN `--. b` EXISTS_TAC; TYPE_THEN `--. a` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC continuous_comp; TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC; REWRITE_TAC[neg_cont]; SIMP_TAC[top_of_metric_top; metric_real; metric_euclidean; metric_euclid; metric_hausdorff; GSYM top_of_metric_unions; open_ball_open;]; ASM_REWRITE_TAC[]; REWRITE_TAC[UNIV;IN;SUBSET ]; CONJ_TAC ; AND 0; AND 0; UND 2; REAL_ARITH_TAC ; REWRITE_TAC[o_DEF ;]; REDUCE_TAC ; ASM_REWRITE_TAC[]; UND 0; REWRITE_TAC[IMAGE;IN;SUBSET;IN_ELIM_THM']; DISCH_ALL_TAC; DISCH_ALL_TAC; CHO 5; USE 4 (CONV_RULE NAME_CONFLICT_CONV ); TYPE_THEN `x'` (USE 4 o SPEC); UND 4; DISCH_THEN IMATCH_MP_TAC ; NAME_CONFLICT_TAC; TYPE_THEN `--. x''` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 5; REAL_ARITH_TAC ; ]);; (* }}} *) let path_symm_eq = prove_by_refinement( `!U x y . (path_component U x (y:A)) <=> (path_component U y (x:A))`, (* {{{ proof *) [ MESON_TAC[path_symm]; ]);; (* }}} *) let path_trans = prove_by_refinement( `!U x y (z:A). (path_component U x y) /\ (path_component U y z) ==> (path_component U x z)`, (* {{{ proof *) [ REWRITE_TAC[path_component]; DISCH_ALL_TAC; CHO 0; CHO 0; CHO 0; CHO 1; CHO 1; CHO 1; TYPE_THEN `joinf f (f' o ((+.) (a' -. b))) b` EXISTS_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b' +. (b - a')` EXISTS_TAC; CONJ_TAC; (* start of continuity *) IMATCH_MP_TAC joinf_cont; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC continuous_comp; TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC; ASM_REWRITE_TAC [top_of_metric_top; metric_real; metric_euclidean; metric_euclid; metric_hausdorff; GSYM top_of_metric_unions; open_ball_open;]; REWRITE_TAC[add_cont]; ASM_SIMP_TAC [top_of_metric_top; metric_real; metric_euclidean; metric_euclid; metric_hausdorff; GSYM top_of_metric_unions; open_ball_open;]; REWRITE_TAC[SUBSET;UNIV;IN;IN_ELIM_THM']; REWRITE_TAC[o_DEF]; REDUCE_TAC; ASM_REWRITE_TAC[]; (* end of continuity *) CONJ_TAC; (* start real ineq *) AND 1; AND 1; AND 0; AND 0; UND 5; UND 3; REAL_ARITH_TAC; (* end of real ineq *) CONJ_TAC; REWRITE_TAC[joinf;o_DEF]; ASM_REWRITE_TAC[]; (* end of JOIN statement *) CONJ_TAC; (* next JOIN statement *) REWRITE_TAC[joinf;o_DEF]; TYPE_THEN `~(b' +. b -. a' <. b)` SUBGOAL_TAC; TYPE_THEN `(a' <. b') /\ (a <. b)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_THEN (fun t-> REWRITE_TAC[t]); TYPE_THEN ` a' -. b +. b' +. b -. a' = b'` SUBGOAL_TAC; REAL_ARITH_TAC ; DISCH_THEN (fun t-> REWRITE_TAC[t]); ASM_REWRITE_TAC[]; (* end of next joinf *) TYPE_THEN `(a <=. b) /\ (b <=. (b' + b - a'))` SUBGOAL_TAC; (* subreal *) TYPE_THEN `(a' <. b') /\ (a <. b)` SUBGOAL_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_TAC; (* end of subreal *) USE 2 (MATCH_MP union_closed_interval); UND 2; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); REWRITE_TAC[IMAGE_UNION;union_subset]; CONJ_TAC; (* start of FIRST interval *) TYPE_THEN `IMAGE (joinf f (f' o (+.) (a' -. b)) b) {t | a <=. t /\ t <. b} = IMAGE f {t | a <=. t /\ t <. b}` SUBGOAL_TAC; REWRITE_TAC[joinf;IMAGE;IN_IMAGE ]; IMATCH_MP_TAC EQ_EXT; X_GEN_TAC `t:A`; REWRITE_TAC[IN_ELIM_THM']; EQ_TAC; DISCH_ALL_TAC; CHO 2; UND 2; DISCH_ALL_TAC; REWR 4; ASM_MESON_TAC[]; DISCH_ALL_TAC; CHO 2; UND 2; DISCH_ALL_TAC; TYPE_THEN `x'` EXISTS_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (fun t-> REWRITE_TAC[t]); (* FIRST interval still *) TYPE_THEN `IMAGE f {t | a <=. t /\ t <. b} SUBSET IMAGE f {t | a <=. t /\ t <=. b} ` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN_IMAGE ;IN_ELIM_THM']; GEN_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); MESON_TAC[REAL_ARITH `a <. b ==> a<=. b`]; KILL 1; UND 0; DISCH_ALL_TAC; JOIN 0 5; USE 0 (MATCH_MP SUBSET_TRANS ); ASM_REWRITE_TAC[]; (* end of FIRST interval *) (* lc 1*) TYPE_THEN `IMAGE (joinf f (f' o (+.) (a' -. b)) b) {t | b <=. t /\ t <=. b' + b -. a'} = IMAGE f' {t | a' <=. t /\ t <=. b'}` SUBGOAL_TAC; REWRITE_TAC[joinf;IMAGE;IN_IMAGE ]; IMATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM']; NAME_CONFLICT_TAC ; X_GEN_TAC `t:A`; EQ_TAC; DISCH_ALL_TAC; CHO 2; UND 2; DISCH_ALL_TAC; TYPE_THEN `~(x' <. b)` SUBGOAL_TAC; UND 2; REAL_ARITH_TAC ; DISCH_TAC ; REWR 4; USE 4 (REWRITE_RULE[o_DEF]); TYPE_THEN `a' -. b +. x'` EXISTS_TAC; (* * *) ASM_REWRITE_TAC[]; TYPE_THEN `(a' <. b') /\ (a <. b) /\ (b <=. x') /\ (x' <=. b' +. b -. a')` SUBGOAL_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_ALL_TAC; CHO 2; UND 2; DISCH_ALL_TAC; TYPE_THEN `x' +. b -. a'` EXISTS_TAC; ASM_REWRITE_TAC[]; SUBCONJ_TAC; UND 2; UND 3; REAL_ARITH_TAC; DISCH_ALL_TAC; TYPE_THEN `~(x' +. b -. a' <. b)` SUBGOAL_TAC; UND 5; REAL_ARITH_TAC ; DISCH_THEN (fun t-> REWRITE_TAC[t]); REWRITE_TAC[o_DEF]; AP_TERM_TAC; REAL_ARITH_TAC ; DISCH_THEN (fun t -> REWRITE_TAC [t]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let loc_path_conn = euclid_def `loc_path_conn U <=> !A x. (U A) /\ (A (x:A)) ==> (U (path_component (induced_top U A) x))`;; let path_eq_conn = prove_by_refinement( `!U (x:A). (loc_path_conn U) /\ (topology_ U) ==> (path_component U x = component U x)`, (* {{{ proof *) [ DISCH_ALL_TAC; MATCH_MP_TAC EQ_EXT; X_GEN_TAC `y:A`; EQ_TAC ; REWRITE_TAC[path_component]; DISCH_ALL_TAC; CHO 2; CHO 2; CHO 2; UND 2 THEN DISCH_ALL_TAC; REWRITE_TAC[component_DEF]; TYPE_THEN `IMAGE f {t | a <= t /\ t <= b}` EXISTS_TAC; CONJ_TAC; IMATCH_MP_TAC connect_image ; NAME_CONFLICT_TAC; TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC ; ASM_REWRITE_TAC[connect_real ]; REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; CONJ_TAC; TYPE_THEN `a` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 3; REAL_ARITH_TAC ; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 3; REAL_ARITH_TAC; REWRITE_TAC[component_DEF]; DISCH_ALL_TAC; CHO 2; UND 2 THEN DISCH_ALL_TAC; USE 2 (REWRITE_RULE[connected]); UND 2 THEN DISCH_ALL_TAC; TYPE_THEN `path_component U x` (USE 5 o SPEC); TYPE_THEN `A = path_component U x` ABBREV_TAC; TYPE_THEN `B = UNIONS (IMAGE (\z. (path_component U z)) (Z DIFF A))` ABBREV_TAC ; TYPE_THEN `B` (USE 5 o SPEC); TYPE_THEN `U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B` SUBGOAL_TAC; WITH 0 (REWRITE_RULE[loc_path_conn]); TYPE_THEN `(UNIONS U)` (USE 8 o SPEC); TYPE_THEN `x` (USE 8 o SPEC); UND 8; ASM_SIMP_TAC[induced_top_unions]; ASM_SIMP_TAC[top_univ]; TYPE_THEN `UNIONS U x` SUBGOAL_TAC; USE 2 (REWRITE_RULE[SUBSET;IN;]); ASM_MESON_TAC[]; DISCH_ALL_TAC; REWR 8; ASM_REWRITE_TAC[]; (* dd *) CONJ_TAC; EXPAND_TAC "B"; WITH 1 (REWRITE_RULE[topology]); TYPEL_THEN [`EMPTY:A->bool`;`EMPTY:A->bool`;`(IMAGE (\z. path_component U z) (Z DIFF A))`] (USE 10 o ISPECL); UND 10 THEN DISCH_ALL_TAC; UND 12 THEN (DISCH_THEN IMATCH_MP_TAC ); REWRITE_TAC[SUBSET;IN_IMAGE]; REWRITE_TAC[IN]; NAME_CONFLICT_TAC; DISCH_ALL_TAC; CHO 12; ASM_REWRITE_TAC[]; USE 0 (REWRITE_RULE[loc_path_conn]); TYPE_THEN `(UNIONS U)` (USE 0 o SPEC); USE 0 ( CONV_RULE NAME_CONFLICT_CONV); TYPE_THEN `x'` (USE 0 o SPEC); UND 0; ASM_SIMP_TAC[induced_top_unions]; DISCH_THEN MATCH_MP_TAC; ASM_SIMP_TAC[top_univ]; AND 12; USE 2 (REWRITE_RULE[SUBSET;IN]); USE 0 (REWRITE_RULE[DIFF;IN;IN_ELIM_THM' ]); ASM_MESON_TAC[]; CONJ_TAC; REWRITE_TAC[EQ_EMPTY]; DISCH_ALL_TAC; USE 10 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]); AND 10; UND 10; EXPAND_TAC "B"; REWRITE_TAC[UNIONS;IN_IMAGE ;IN_ELIM_THM' ]; REWRITE_TAC[IN]; LEFT_TAC "u"; DISCH_ALL_TAC; AND 10; CHO 12; AND 12; REWR 10; UND 11; EXPAND_TAC "A"; USE 10 (ONCE_REWRITE_RULE [path_symm_eq]); DISCH_TAC; JOIN 11 10; USE 10 (MATCH_MP path_trans); REWR 10; UND 10; UND 12; REWRITE_TAC[DIFF;IN;IN_ELIM_THM']; MESON_TAC[]; REWRITE_TAC[SUBSET;IN;UNION;IN_ELIM_THM']; DISCH_ALL_TAC; TYPE_THEN `A x'` ASM_CASES_TAC; ASM_REWRITE_TAC[]; DISJ2_TAC ; EXPAND_TAC "B"; REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM' ]; REWRITE_TAC[IN]; LEFT_TAC "x"; LEFT_TAC "x"; TYPE_THEN `x'` EXISTS_TAC; TYPE_THEN `path_component U x'` EXISTS_TAC; ASM_REWRITE_TAC[DIFF;IN;IN_ELIM_THM' ]; IMATCH_MP_TAC path_refl; USE 2 (REWRITE_RULE[SUBSET;IN]); ASM_MESON_TAC[]; DISCH_TAC ; REWR 5; UND 5; DISCH_THEN DISJ_CASES_TAC ; USE 5 (REWRITE_RULE[SUBSET;IN ;]); ASM_MESON_TAC[]; UND 8 THEN DISCH_ALL_TAC; USE 10 (REWRITE_RULE[EQ_EMPTY]); TYPE_THEN `x` (USE 10 o SPEC); USE 10 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']); USE 5 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']); TYPE_THEN `A x` SUBGOAL_TAC; EXPAND_TAC "A"; IMATCH_MP_TAC path_refl ; USE 2 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']); ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let open_ball_star = prove_by_refinement( `!x r y t n. (open_ball(euclid n,d_euclid) x r y) /\ (&.0 <=. t) /\ (t <=. &.1) ==> (open_ball(euclid n,d_euclid) x r ((t *# x + (&.1-t)*#y)))`, (* {{{ proof *) [ REWRITE_TAC[open_ball;IN_ELIM_THM' ]; DISCH_ALL_TAC; ASM_SIMP_TAC[euclid_scale_closure;euclid_add_closure]; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM trivial_lin_combo]; ASSUME_TAC (SPEC `n:num` metric_translate_LEFT); TYPEL_THEN [`(&.1 - t) *# x`;`(&.1 - t)*# y`;`t *# x`] (USE 5 o ISPECL); UND 5; ASM_SIMP_TAC [euclid_scale_closure]; ASM_MESON_TAC[norm_scale_vec;REAL_ARITH `(&.0 <=. t) /\ (t <=. (&.1)) ==> (||. (&.1 - t) <=. &.1)`;REAL_ARITH `(b <= a) ==> ((a < C) ==> (b < C))`;GSYM REAL_MUL_LID;REAL_LE_RMUL;d_euclid_pos]; ]);; (* }}} *) let open_ball_path = prove_by_refinement( `!x r y n. (open_ball(euclid n,d_euclid) x r y) ==> (path_component (top_of_metric(open_ball(euclid n,d_euclid) x r,d_euclid)) y x)`, (* {{{ proof *) [ REWRITE_TAC[path_component ;]; DISCH_ALL_TAC; TYPE_THEN `(\t. (t *# x + (&.1 - t) *# y))` EXISTS_TAC; EXISTS_TAC `&.0`; EXISTS_TAC `&.1`; REDUCE_TAC; TYPE_THEN `top_of_metric (open_ball (euclid n,d_euclid) x r,d_euclid) = (induced_top(top_of_metric(euclid n,d_euclid)) (open_ball (euclid n,d_euclid) x r))` SUBGOAL_TAC; ASM_MESON_TAC[open_ball_subset;metric_euclid;top_of_metric_induced ]; DISCH_TAC ; TYPE_THEN `euclid n x /\ euclid n y` SUBGOAL_TAC; USE 0 (REWRITE_RULE[open_ball;IN_ELIM_THM' ]); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; CONJ_TAC; ASM_REWRITE_TAC[]; IMATCH_MP_TAC continuous_induced; ASM_SIMP_TAC [top_of_metric_top;metric_euclid;open_ball_open]; IMATCH_MP_TAC continuous_lin_combo ; ASM_REWRITE_TAC[]; CONJ_TAC; REWRITE_TAC[euclid_plus;euclid_scale]; IMATCH_MP_TAC EQ_EXT THEN BETA_TAC ; REDUCE_TAC; CONJ_TAC; REWRITE_TAC[euclid_plus;euclid_scale]; IMATCH_MP_TAC EQ_EXT THEN BETA_TAC ; REDUCE_TAC; REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM'' ]; REWRITE_TAC[IN;IN_ELIM_THM']; TYPE_THEN `(UNIONS (top_of_metric (open_ball (euclid n,d_euclid) x r,d_euclid))) = (open_ball(euclid n,d_euclid) x r)` SUBGOAL_TAC; IMATCH_MP_TAC (GSYM top_of_metric_unions); IMATCH_MP_TAC metric_subspace; ASM_MESON_TAC[metric_euclid;open_ball_subset]; DISCH_THEN (fun t->REWRITE_TAC[t]); ASM_MESON_TAC [open_ball_star]; ]);; (* }}} *) let path_domain = prove_by_refinement( `!U x (y:A). path_component U x y <=> (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ (a <. b) /\ (f a = (x:A)) /\ (f b = y) /\ (IMAGE f UNIV SUBSET (UNIONS U)))`, (* {{{ proof *) [ REWRITE_TAC[path_component]; DISCH_ALL_TAC; EQ_TAC; DISCH_TAC ; CHO 0; CHO 0; CHO 0; TYPE_THEN `joinf (\t. (f a)) (joinf f (\t. (f b)) b) a` EXISTS_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; CONJ_TAC; IMATCH_MP_TAC joinf_cont; ASM_SIMP_TAC[const_continuous;top_of_metric_top;metric_real]; CONJ_TAC; IMATCH_MP_TAC joinf_cont; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[const_continuous;top_of_metric_top;metric_real]; REWRITE_TAC[joinf]; ASM_REWRITE_TAC[]; CONJ_TAC; ASM_REWRITE_TAC[joinf;REAL_ARITH `~(a (~(b < a))`)); ASM_REWRITE_TAC [joinf;REAL_ARITH `~(b < b)`]; REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM'';joinf ]; REWRITE_TAC[IN_UNIV]; GEN_TAC; UND 0; DISCH_ALL_TAC; USE 4 (REWRITE_RULE[SUBSET;IN_IMAGE;Q_ELIM_THM'';]); USE 4 (REWRITE_RULE[IN;IN_ELIM_THM' ]); (* cc1 *) TYPE_THEN `a` (WITH 4 o SPEC); TYPE_THEN `b` (WITH 4 o SPEC); TYPE_THEN `x'` (USE 4 o SPEC); DISJ_CASES_TAC (REAL_ARITH `x' < a \/ (a <= x')`); ASM_REWRITE_TAC[IN]; ASM_MESON_TAC[REAL_ARITH `(a <=a) /\ ((a < b) ==> (a <= b))`]; DISJ_CASES_TAC (REAL_ARITH `x' < b \/ (b <= x')`); REWR 4; USE 7 (MATCH_MP (REAL_ARITH `a <= x' ==> (~(x' < a))`)); ASM_REWRITE_TAC[IN ]; ASM_MESON_TAC[REAL_ARITH `x' < b ==> x' <= b`]; USE 7 (MATCH_MP (REAL_ARITH `a <= x' ==> (~(x' < a))`)); ASM_REWRITE_TAC[]; USE 8 (MATCH_MP (REAL_ARITH `b <= x' ==> ~(x' < b)`)); ASM_REWRITE_TAC[IN]; ASM_MESON_TAC[REAL_ARITH `b <=b /\ ((a < b) ==> (a <= b))`]; DISCH_TAC ; CHO 0; CHO 0; CHO 0; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `a ` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; UND 0; REWRITE_TAC[SUBSET;IN_IMAGE ;Q_ELIM_THM'']; REWRITE_TAC[IN_UNIV]; REWRITE_TAC[IN;IN_ELIM_THM']; ASM_MESON_TAC[]; ]);; (* }}} *) let path_component_subspace = prove_by_refinement( `!X Y d (y:A). ((Y SUBSET X) /\ (metric_space(X,d) /\ (Y y))) ==> ((path_component(top_of_metric(Y,d)) y) SUBSET (path_component(top_of_metric(X,d)) y))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[SUBSET;IN;path_domain]; DISCH_ALL_TAC; CHO 3; CHO 3; CHO 3; TYPE_THEN `f` EXISTS_TAC; TYPE_THEN `a` EXISTS_TAC; TYPE_THEN `b` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `metric_space(Y,d)` SUBGOAL_TAC; ASM_MESON_TAC[metric_subspace]; DISCH_TAC; UND 3; ASM_SIMP_TAC[GSYM top_of_metric_unions]; DISCH_ALL_TAC; CONJ_TAC; UND 3; TYPE_THEN `IMAGE f UNIV SUBSET X /\ IMAGE f UNIV SUBSET Y` SUBGOAL_TAC; ASM_MESON_TAC[SUBSET;IN]; DISCH_TAC; ASM_SIMP_TAC[metric_continuous_continuous;metric_real]; REWRITE_TAC[metric_continuous;metric_continuous_pt]; ASM_MESON_TAC[SUBSET;IN]; ]);; (* }}} *) let path_component_in = prove_by_refinement( `!x (y:A) U. (path_component U x y) ==> (UNIONS U y)`, (* {{{ proof *) [ REWRITE_TAC[path_component]; DISCH_ALL_TAC; CHO 0; CHO 0; CHO 0; UND 0; DISCH_ALL_TAC; USE 4 (REWRITE_RULE[SUBSET;IN_IMAGE;Q_ELIM_THM'']); USE 4 (REWRITE_RULE[IN_ELIM_THM';IN]); TYPE_THEN `b` (USE 4 o SPEC); ASM_MESON_TAC[REAL_ARITH `(a < b) ==> ((a<=. b) /\ (b <= b))`]; ]);; (* }}} *) let loc_path_conn_euclid = prove_by_refinement( `!n A. (top_of_metric(euclid n,d_euclid)) A ==> (loc_path_conn (top_of_metric(A,d_euclid)))`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[loc_path_conn]; DISCH_ALL_TAC; TYPE_THEN `metric_space (A,d_euclid)` SUBGOAL_TAC; IMATCH_MP_TAC metric_subspace; TYPE_THEN `euclid n` EXISTS_TAC; REWRITE_TAC[metric_euclid]; USE 0 (MATCH_MP sub_union); ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; DISCH_ALL_TAC; WITH 3 (MATCH_MP top_of_metric_nbd); UND 4; DISCH_THEN (fun t-> REWRITE_TAC[t]); TYPE_THEN `A' SUBSET A` SUBGOAL_TAC; USE 1 (MATCH_MP sub_union); ASM_MESON_TAC[top_of_metric_unions]; DISCH_TAC; ASM_SIMP_TAC[top_of_metric_induced]; TYPE_THEN `metric_space(A',d_euclid)` SUBGOAL_TAC; ASM_MESON_TAC[metric_subspace]; DISCH_TAC ; SUBCONJ_TAC; REWRITE_TAC[SUBSET;IN]; REWRITE_TAC[path_component]; DISCH_ALL_TAC; CHO 6; CHO 6; CHO 6; USE 6 (REWRITE_RULE[SUBSET;IN_IMAGE ;IN_ELIM_THM';Q_ELIM_THM'']); UND 6; DISCH_ALL_TAC; TYPE_THEN `b` (USE 10 o SPEC); USE 4 (REWRITE_RULE[SUBSET;IN]); UND 4; DISCH_THEN IMATCH_MP_TAC ; USE 5 (MATCH_MP top_of_metric_unions); UND 10; UND 4; DISCH_THEN (fun t -> ONCE_REWRITE_TAC[GSYM t]); ASM_REWRITE_TAC[IN]; ASM_MESON_TAC[REAL_ARITH `b <=. b /\ ((a < b)==> (a <=. b))`]; DISCH_TAC; REWRITE_TAC[IN]; DISCH_ALL_TAC; (* c2 *) WITH 7 (MATCH_MP path_component_in); TYPE_THEN `A' a` SUBGOAL_TAC; UND 8; ASM_SIMP_TAC[GSYM top_of_metric_unions;]; DISCH_TAC; TYPE_THEN `A SUBSET (euclid n)` SUBGOAL_TAC; USE 0 (MATCH_MP sub_union); UND 0; ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; DISCH_TAC; TYPE_THEN `top_of_metric(euclid n,d_euclid) A'` SUBGOAL_TAC; IMATCH_MP_TAC induced_trans; TYPE_THEN `A` EXISTS_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[top_of_metric_top;metric_euclid;top_of_metric_induced ]; DISCH_TAC; COPY 11; UND 12; SIMP_TAC[top_of_metric_nbd;metric_euclid]; DISCH_ALL_TAC; TYPE_THEN `a` (USE 13 o SPEC); USE 13 (REWRITE_RULE[IN]); REWR 13; CHO 13; TYPE_THEN `r` EXISTS_TAC; ASM_REWRITE_TAC[]; TYPE_THEN `open_ball (A,d_euclid) a r SUBSET path_component (top_of_metric (A',d_euclid)) a` SUBGOAL_TAC ; TYPE_THEN `open_ball (euclid n,d_euclid) a r SUBSET path_component (top_of_metric (A',d_euclid)) a` SUBGOAL_TAC ; TYPE_THEN `open_ball (euclid n,d_euclid) a r SUBSET path_component (top_of_metric ((open_ball(euclid n,d_euclid) a r),d_euclid)) a` SUBGOAL_TAC; REWRITE_TAC[SUBSET;IN]; MESON_TAC[open_ball_path;SUBSET;IN;path_symm]; IMATCH_MP_TAC (prove_by_refinement(`!A B C. (B:A->bool) SUBSET C ==> (A SUBSET B ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]])); IMATCH_MP_TAC path_component_subspace; ASM_REWRITE_TAC[]; IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); ASM_SIMP_TAC[metric_euclid]; ASM_MESON_TAC[SUBSET;IN]; IMATCH_MP_TAC (prove_by_refinement (`!A B C. (A:A->bool) SUBSET B ==> (B SUBSET C ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]])); ASM_SIMP_TAC[open_ball_subspace]; IMATCH_MP_TAC (prove_by_refinement(`!A B C. (B:A->bool) SUBSET C ==> (A SUBSET B ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]])); REWRITE_TAC[SUBSET;IN]; GEN_TAC; UND 7; MESON_TAC[path_trans]; ]);; (* }}} *) let loc_path_euclid_cor = prove_by_refinement( `!n A . (top_of_metric(euclid n,d_euclid)) A ==> (path_component (top_of_metric(A,d_euclid)) = component (top_of_metric(A,d_euclid)))`, (* {{{ proof *) [ DISCH_ALL_TAC; WITH 0 (MATCH_MP loc_path_conn_euclid); IMATCH_MP_TAC EQ_EXT; GEN_TAC; IMATCH_MP_TAC path_eq_conn; ASM_REWRITE_TAC[]; IMATCH_MP_TAC top_of_metric_top; USE 0 (MATCH_MP sub_union); UND 0; ASM_SIMP_TAC[GSYM top_of_metric_unions ;metric_euclid]; ASM_MESON_TAC[metric_subspace;metric_euclid]; ]);; (* }}} *) hol-light/Jordan/misc_defs_and_lemmas.ml000066400000000000000000002006041303454263000206320ustar00rootroot00000000000000 labels_flag:= true;; let dirac_delta = new_definition `dirac_delta (i:num) = (\j. if (i=j) then (&.1) else (&.0))`;; let min_num = new_definition `min_num (X:num->bool) = @m. (m IN X) /\ (!n. (n IN X) ==> (m <= n))`;; let min_least = prove_by_refinement ( `!(X:num->bool) c. (X c) ==> (X (min_num X) /\ (min_num X <=| c))`, (* {{{ proof *) [ REWRITE_TAC[min_num;IN]; REPEAT GEN_TAC; DISCH_TAC; SUBGOAL_THEN `?n. (X:num->bool) n /\ (!m. m <| n ==> ~X m)` MP_TAC; REWRITE_TAC[(GSYM (ISPEC `X:num->bool` num_WOP))]; ASM_MESON_TAC[]; DISCH_THEN CHOOSE_TAC; ASSUME_TAC (select_thm `\m. (X:num->bool) m /\ (!n. X n ==> m <=| n)` `n:num`); ABBREV_TAC `r = @m. (X:num->bool) m /\ (!n. X n ==> m <=| n)`; ASM_MESON_TAC[ ARITH_RULE `~(n' < n) ==> (n <=| n') `] ]);; (* }}} *) let max_real = new_definition(`max_real x y = if (y <. x) then x else y`);; let min_real = new_definition(`min_real x y = if (x <. y) then x else y`);; let deriv = new_definition(`deriv f x = @d. (f diffl d)(x)`);; let deriv2 = new_definition(`deriv2 f = (deriv (deriv f))`);; let square_le = prove_by_refinement( `!x y. (&.0 <=. x) /\ (&.0 <=. y) /\ (x*.x <=. y*.y) ==> (x <=. y)`, (* {{{ proof *) [ DISCH_ALL_TAC; UNDISCH_FIND_TAC `( *. )` ; ONCE_REWRITE_TAC[REAL_ARITH `(a <=. b) <=> (&.0 <= (b - a))`]; REWRITE_TAC[GSYM REAL_DIFFSQ]; DISCH_TAC; DISJ_CASES_TAC (REAL_ARITH `&.0 < (y+x) \/ (y+x <=. (&.0))`); MATCH_MP_TAC (SPEC `(y+x):real` REAL_LE_LCANCEL_IMP); ASM_REWRITE_TAC [REAL_ARITH `x * (&.0) = (&.0)`]; CLEAN_ASSUME_TAC (REAL_ARITH `(&.0 <= y) /\ (&.0 <=. x) /\ (y+x <= (&.0)) ==> ((x= &.0) /\ (y= &.0))`); ASM_REWRITE_TAC[REAL_ARITH `&.0 <=. (&.0 -. (&.0))`]; ]);; (* }}} *) let max_num_sequence = prove_by_refinement( `!(t:num->num). (?n. !m. (n <=| m) ==> (t m = 0)) ==> (?M. !i. (t i <=| M))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[GSYM LEFT_FORALL_IMP_THM]; GEN_TAC; SPEC_TAC (`t:num->num`,`t:num->num`); SPEC_TAC (`n:num`,`n:num`); INDUCT_TAC; GEN_TAC; REWRITE_TAC[ARITH_RULE `0<=|m`]; DISCH_TAC; EXISTS_TAC `0`; ASM_MESON_TAC[ARITH_RULE`(a=0) ==> (a <=|0)`]; DISCH_ALL_TAC; ABBREV_TAC `b = \m. (if (m=n) then 0 else (t (m:num)) )`; FIRST_ASSUM (fun t-> ASSUME_TAC (SPEC `b:num->num` t)); SUBGOAL_TAC `((b:num->num) (n) = 0) /\ (!m. ~(m=n) ==> (b m = t m))`; EXPAND_TAC "b"; CONJ_TAC; COND_CASES_TAC; REWRITE_TAC[]; ASM_MESON_TAC[]; GEN_TAC; COND_CASES_TAC; REWRITE_TAC[]; REWRITE_TAC[]; DISCH_ALL_TAC; FIRST_ASSUM (fun t-> MP_TAC(SPEC `b:num->num` t)); SUBGOAL_TAC `!m. (n<=|m) ==> (b m =0)`; GEN_TAC; ASM_CASES_TAC `m = (n:num)`; ASM_REWRITE_TAC[]; SUBGOAL_TAC ( `(n <=| m) /\ (~(m = n)) ==> (SUC n <=| m)`); ARITH_TAC; ASM_REWRITE_TAC[]; DISCH_ALL_TAC; ASM_MESON_TAC[]; (* good *) DISCH_THEN (fun t-> REWRITE_TAC[t]); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `(M:num) + (t:num->num) n`; GEN_TAC; ASM_CASES_TAC `(i:num) = n`; ASM_REWRITE_TAC[]; ARITH_TAC; MATCH_MP_TAC (ARITH_RULE `x <=| M ==> (x <=| M+ u)`); ASM_MESON_TAC[]; ]);; (* }}} *) let REAL_INV_LT = prove_by_refinement( `!x y z. (&.0 <. x) ==> ((inv(x)*y < z) <=> (y <. x*z))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_TAC; REWRITE_TAC[REAL_ARITH `inv x * y = y* inv x`]; REWRITE_TAC[GSYM real_div]; ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; REAL_ARITH_TAC; ]);; (* }}} *) let REAL_MUL_NN = prove_by_refinement( `!x y. (&.0 <= x*y) <=> ((&.0 <= x /\ (&.0 <=. y)) \/ ((x <= &.0) /\ (y <= &.0) ))`, (* {{{ proof *) [ DISCH_ALL_TAC; SUBGOAL_TAC `! x y. ((&.0 < x) ==> ((&.0 <= x*y) <=> ((&.0 <= x /\ (&.0 <=. y)) \/ ((x <= &.0) /\ (y <= &.0) ))))`; DISCH_ALL_TAC; ASM_SIMP_TAC[REAL_ARITH `((&.0 <. x) ==> (&.0 <=. x))`;REAL_ARITH `(&.0 <. x) ==> ~(x <=. &.0)`]; EQ_TAC; ASM_MESON_TAC[REAL_PROP_NN_LCANCEL]; ASM_MESON_TAC[REAL_LE_MUL;REAL_LT_IMP_LE]; DISCH_TAC; DISJ_CASES_TAC (REAL_ARITH `(&.0 < x) \/ (x = &.0) \/ (x < &.0)`); ASM_MESON_TAC[]; UND 1 THEN DISCH_THEN DISJ_CASES_TAC; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_ARITH `((x <. &.0) ==> ~(&.0 <=. x))`;REAL_ARITH `(x <. &.0) ==> (x <=. &.0)`]; USE 0 (SPECL [`--. (x:real)`;`--. (y:real)`]); UND 0; REDUCE_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[REAL_ARITH `((x <. &.0) ==> ~(&.0 <=. x))`;REAL_ARITH `(x <. &.0) ==> (x <=. &.0)`]; ]);; (* }}} *) let ABS_SQUARE = prove_by_refinement( `!t u. abs(t) <. u ==> t*t <. u*u`, (* {{{ proof *) [ REP_GEN_TAC; CONV_TAC (SUBS_CONV[SPEC `t:real` (REWRITE_RULE[POW_2] (GSYM REAL_POW2_ABS))]); ASSUME_TAC REAL_ABS_POS; USE 0 (SPEC `t:real`); ABBREV_TAC `(b:real) = (abs t)`; KILL 1; DISCH_ALL_TAC; MATCH_MP_TAC REAL_PROP_LT_LRMUL; ASM_REWRITE_TAC[]; ]);; (* }}} *) let ABS_SQUARE_LE = prove_by_refinement( `!t u. abs(t) <=. u ==> t*t <=. u*u`, (* {{{ proof *) [ REP_GEN_TAC; CONV_TAC (SUBS_CONV[SPEC `t:real` (REWRITE_RULE[POW_2] (GSYM REAL_POW2_ABS))]); ASSUME_TAC REAL_ABS_POS; USE 0 (SPEC `t:real`); ABBREV_TAC `(b:real) = (abs t)`; KILL 1; DISCH_ALL_TAC; MATCH_MP_TAC REAL_PROP_LE_LRMUL; ASM_REWRITE_TAC[]; ]);; (* }}} *) let twopow_eps = prove_by_refinement( `!R e. ?n. (&.0 <. R)/\ (&.0 <. e) ==> R*(twopow(--: (&:n))) <. e`, (* {{{ proof *) [ DISCH_ALL_TAC; REWRITE_TAC[TWOPOW_NEG]; (* cs6b *) ASSUME_TAC (prove(`!n. &.0 < &.2 pow n`,REDUCE_TAC THEN ARITH_TAC)); ONCE_REWRITE_TAC[REAL_MUL_AC]; ASM_SIMP_TAC[REAL_INV_LT]; ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]; CONV_TAC (quant_right_CONV "n"); DISCH_ALL_TAC; ASSUME_TAC (SPEC `R/e` REAL_ARCH_SIMPLE); CHO 3; EXISTS_TAC `n:num`; UND 3; MESON_TAC[POW_2_LT;REAL_LET_TRANS]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* finite products, in imitation of finite sums *) (* ------------------------------------------------------------------ *) let prod_EXISTS = prove_by_refinement( `?prod. (!f n. prod(n,0) f = &1) /\ (!f m n. prod(n,SUC m) f = prod(n,m) f * f(n + m))`, (* {{{ proof *) [ (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) `(!f n. sm n 0 f = &1) /\ (!f m n. sm n (SUC m) f = sm n m f * f(n + m))` ; EXISTS_TAC `\(n,m) f. (sm:num->num->(num->real)->real) n m f`; CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[] ]);; (* }}} *) let prod_DEF = new_specification ["prod"] prod_EXISTS;; let prod = prove (`!n m. (prod(n,0) f = &1) /\ (prod(n,SUC m) f = prod(n,m) f * f(n + m))`, (* {{{ proof *) REWRITE_TAC[prod_DEF]);; (* }}} *) let PROD_TWO = prove_by_refinement( `!f n p. prod(0,n) f * prod(n,p) f = prod(0,n + p) f`, (* {{{ proof *) [ GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod; REAL_MUL_RID; MULT_CLAUSES;ADD_0]; REWRITE_TAC[ARITH_RULE `n+| (SUC p) = (SUC (n+|p))`;prod;ARITH_RULE `0+|n = n`]; ASM_REWRITE_TAC[REAL_MUL_ASSOC]; ]);; (* }}} *) let ABS_PROD = prove_by_refinement( `!f m n. abs(prod(m,n) f) = prod(m,n) (\n. abs(f n))`, (* {{{ proof *) [ GEN_TAC THEN GEN_TAC THEN INDUCT_TAC; REWRITE_TAC[prod]; REAL_ARITH_TAC; ASM_REWRITE_TAC[prod;ABS_MUL] ]);; (* }}} *) let PROD_EQ = prove_by_refinement (`!f g m n. (!r. m <= r /\ r < (n + m) ==> (f(r) = g(r))) ==> (prod(m,n) f = prod(m,n) g)`, (* {{{ proof *) [ GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod]; REWRITE_TAC[prod]; DISCH_THEN (fun th -> MP_TAC th THEN (MP_TAC (SPEC `m+|n` th))); REWRITE_TAC[ARITH_RULE `(m<=| (m+|n))/\ (m +| n <| (SUC n +| m))`]; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; AP_THM_TAC THEN AP_TERM_TAC; FIRST_X_ASSUM MATCH_MP_TAC; GEN_TAC THEN DISCH_TAC; FIRST_X_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[ARITH_RULE `r <| (n+| m) ==> (r <| (SUC n +| m))`] ]);; (* }}} *) let PROD_POS = prove_by_refinement (`!f. (!n. &0 <= f(n)) ==> !m n. &0 <= prod(m,n) f`, (* {{{ proof *) [ GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod]; REAL_ARITH_TAC; ASM_MESON_TAC[REAL_LE_MUL] ]);; (* }}} *) let PROD_POS_GEN = prove_by_refinement (`!f m n. (!n. m <= n ==> &0 <= f(n)) ==> &0 <= prod(m,n) f`, (* {{{ proof *) [ REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[prod]; REAL_ARITH_TAC; ASM_MESON_TAC[REAL_LE_MUL;ARITH_RULE `m <=| (m +| n)`] ]);; (* }}} *) let PROD_ABS = prove (`!f m n. abs(prod(m,n) (\m. abs(f m))) = prod(m,n) (\m. abs(f m))`, (* {{{ proof *) REWRITE_TAC[ABS_PROD;REAL_ARITH `||. (||. x) = (||. x)`]);; (* }}} *) let PROD_ZERO = prove_by_refinement (`!f m n. (?p. (m <= p /\ (p < (n+| m)) /\ (f p = (&.0)))) ==> (prod(m,n) f = &0)`, (* {{{ proof *) [ GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN (REWRITE_TAC[prod]); ARITH_TAC; DISCH_THEN CHOOSE_TAC; ASM_CASES_TAC `p <| (n+| m)`; MATCH_MP_TAC (prove (`(x = (&.0)) ==> (x *. y = (&.0))`,(DISCH_THEN (fun th -> (REWRITE_TAC[th]))) THEN REAL_ARITH_TAC)); FIRST_X_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[]; POP_ASSUM (fun th -> ASSUME_TAC (MATCH_MP (ARITH_RULE `(~(p <| (n+|m)) ==> ((p <| ((SUC n) +| m)) ==> (p = ((m +| n)))))`) th)); MATCH_MP_TAC (prove (`(x = (&.0)) ==> (y *. x = (&.0))`,(DISCH_THEN (fun th -> (REWRITE_TAC[th]))) THEN REAL_ARITH_TAC)); ASM_MESON_TAC[] ]);; (* }}} *) let PROD_MUL = prove_by_refinement( `!f g m n. prod(m,n) (\n. f(n) * g(n)) = prod(m,n) f * prod(m,n) g`, (* {{{ proof *) [ EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[prod]; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_AC]; ]);; (* }}} *) let PROD_CMUL = prove_by_refinement( `!f c m n. prod(m,n) (\n. c * f(n)) = (c **. n) * prod(m,n) f`, (* {{{ proof *) [ EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[prod;pow]; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_AC]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* LEMMAS ABOUT SETS *) (* ------------------------------------------------------------------ *) (* IN_ELIM_THM produces garbled results at times. I like this better: *) (*** JRH replaced this with the "new" IN_ELIM_THM; see how it works. let IN_ELIM_THM' = prove_by_refinement( `(!P. !x:A. x IN (GSPEC P) <=> P x) /\ (!P. !x:A. x IN (\x. P x) <=> P x) /\ (!P. !x:A. (GSPEC P) x <=> P x) /\ (!P (x:A) (t:A). (\t. (?y:A. P y /\ (t = y))) x <=> P x)`, (* {{{ proof *) [ REWRITE_TAC[IN; GSPEC]; MESON_TAC[]; ]);; (* }}} *) ****) let IN_ELIM_THM' = IN_ELIM_THM;; let SURJ_IMAGE = prove_by_refinement( `!(f:A->B) a b. SURJ f a b ==> (b = (IMAGE f a))`, (* {{{ proof *) [ REPEAT GEN_TAC; REWRITE_TAC[SURJ;IMAGE]; DISCH_ALL_TAC; REWRITE_TAC[EXTENSION]; GEN_TAC; REWRITE_TAC[IN_ELIM_THM]; ASM_MESON_TAC[]] (* }}} *) );; let SURJ_FINITE = prove_by_refinement( `!a b (f:A->B). FINITE a /\ (SURJ f a b) ==> FINITE b`, (* {{{ *) [ ASM_MESON_TAC[SURJ_IMAGE;FINITE_IMAGE] ]);; (* }}} *) let BIJ_INVERSE = prove_by_refinement( `!a b (f:A->B). (SURJ f a b) ==> (?(g:B->A). (INJ g b a))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; SUBGOAL_THEN `!y. ?u. ((y IN b) ==> ((u IN a) /\ ((f:A->B) u = y)))` ASSUME_TAC; ASM_MESON_TAC[SURJ]; LABEL_ALL_TAC; H_REWRITE_RULE[THM SKOLEM_THM] (HYP "1"); LABEL_ALL_TAC; H_UNDISCH_TAC (HYP"2"); DISCH_THEN CHOOSE_TAC; EXISTS_TAC `u:B->A`; REWRITE_TAC[INJ] THEN CONJ_TAC THEN (ASM_MESON_TAC[]) ] (* }}} *) );; (* complement of an intersection is a union of complements *) let UNIONS_INTERS = prove_by_refinement( `!(X:A->bool) V. (X DIFF (INTERS V) = UNIONS (IMAGE ((DIFF) X) V))`, (* {{{ proof *) [ REPEAT GEN_TAC; MATCH_MP_TAC SUBSET_ANTISYM; CONJ_TAC; REWRITE_TAC[SUBSET;IMAGE;IN_ELIM_THM]; X_GEN_TAC `c:A`; REWRITE_TAC[IN_DIFF;IN_INTERS;IN_UNIONS;NOT_FORALL_THM]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; EXISTS_TAC `(X DIFF t):A->bool`; REWRITE_TAC[IN_ELIM_THM]; CONJ_TAC; EXISTS_TAC `t:A->bool`; ASM_MESON_TAC[]; REWRITE_TAC[IN_DIFF]; ASM_MESON_TAC[]; REWRITE_TAC[SUBSET;IMAGE;IN_ELIM_THM]; X_GEN_TAC `c:A`; REWRITE_TAC[IN_DIFF;IN_UNIONS]; DISCH_THEN CHOOSE_TAC; UNDISCH_FIND_TAC `(IN)`; REWRITE_TAC[IN_INTERS;IN_ELIM_THM]; DISCH_ALL_TAC; UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; CONJ_TAC; ASM_MESON_TAC[SUBSET_DIFF;SUBSET]; REWRITE_TAC[NOT_FORALL_THM]; EXISTS_TAC `x:A->bool`; ASM_MESON_TAC[IN_DIFF]; ]);; (* }}} *) let INTERS_SUBSET = prove_by_refinement ( `!X (A:A->bool). (A IN X) ==> (INTERS X SUBSET A)`, (* {{{ *) [ REPEAT GEN_TAC; REWRITE_TAC[SUBSET;IN_INTERS]; MESON_TAC[IN]; ]);; (* }}} *) let sub_union = prove_by_refinement( `!X (U:(A->bool)->bool). (U X) ==> (X SUBSET (UNIONS U))`, (* {{{ *) [ DISCH_ALL_TAC; REWRITE_TAC[SUBSET;IN_ELIM_THM;UNIONS]; REWRITE_TAC[IN]; DISCH_ALL_TAC; EXISTS_TAC `X:A->bool`; ASM_REWRITE_TAC[]; ]);; (* }}} *) let IMAGE_SURJ = prove_by_refinement( `!(f:A->B) a. SURJ f a (IMAGE f a)`, (* {{{ *) [ REWRITE_TAC[SURJ;IMAGE;IN_ELIM_THM]; MESON_TAC[IN]; ]);; (* }}} *) let SUBSET_PREIMAGE = prove_by_refinement( `!(f:A->B) X Y. (Y SUBSET (IMAGE f X)) ==> (?Z. (Z SUBSET X) /\ (Y = IMAGE f Z))`, (* {{{ proof *) [ DISCH_ALL_TAC; EXISTS_TAC `{x | (x IN (X:A->bool))/\ (f x IN (Y:B->bool)) }`; CONJ_TAC; REWRITE_TAC[SUBSET;IN_ELIM_THM]; MESON_TAC[]; REWRITE_TAC[EXTENSION]; X_GEN_TAC `y:B`; UNDISCH_FIND_TAC `(SUBSET)`; REWRITE_TAC[SUBSET;IN_IMAGE]; REWRITE_TAC[IN_ELIM_THM]; DISCH_THEN (fun t-> MP_TAC (SPEC `y:B` t)); MESON_TAC[]; ]);; (* }}} *) let UNIONS_INTER = prove_by_refinement( `!(U:(A->bool)->bool) A. (((UNIONS U) INTER A) = (UNIONS (IMAGE ((INTER) A) U)))`, (* {{{ proof *) [ REPEAT GEN_TAC; MATCH_MP_TAC (prove(`((C SUBSET (B:A->bool)) /\ (C SUBSET A) /\ ((A INTER B) SUBSET C)) ==> ((B INTER A) = C)`,SET_TAC[])); CONJ_TAC; REWRITE_TAC[SUBSET;UNIONS;IN_ELIM_THM]; REWRITE_TAC[IN_IMAGE]; SET_TAC[]; REWRITE_TAC[SUBSET;UNIONS;IN_IMAGE]; CONJ_TAC; REWRITE_TAC[IN_ELIM_THM]; X_GEN_TAC `y:A`; DISCH_THEN CHOOSE_TAC; ASM_MESON_TAC[IN_INTER]; REWRITE_TAC[IN_INTER]; REWRITE_TAC[IN_ELIM_THM]; X_GEN_TAC `y:A`; DISCH_ALL_TAC; UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; EXISTS_TAC `A INTER (u:A->bool)`; ASM SET_TAC[]; ]);; (* }}} *) let UNIONS_SUBSET = prove_by_refinement( `!U (X:A->bool). (!A. (A IN U) ==> (A SUBSET X)) ==> (UNIONS U SUBSET X)`, (* {{{ *) [ REPEAT GEN_TAC; SET_TAC[]; ]);; (* }}} *) let SUBSET_INTER = prove_by_refinement( `!X A (B:A->bool). (X SUBSET (A INTER B)) <=> (X SUBSET A) /\ (X SUBSET B)`, (* {{{ *) [ REWRITE_TAC[SUBSET;INTER;IN_ELIM_THM]; MESON_TAC[IN]; ]);; (* }}} *) let EMPTY_EXISTS = prove_by_refinement( `!X. ~(X = {}) <=> (? (u:A). (u IN X))`, (* {{{ *) [ REWRITE_TAC[EXTENSION]; REWRITE_TAC[IN;EMPTY]; MESON_TAC[]; ]);; (* }}} *) let UNIONS_UNIONS = prove_by_refinement( `!A B. (A SUBSET B) ==>(UNIONS (A:(A->bool)->bool) SUBSET (UNIONS B))`, (* {{{ *) [ REWRITE_TAC[SUBSET;UNIONS;IN_ELIM_THM]; MESON_TAC[IN]; ]);; (* }}} *) (* nested union can flatten from outside in, or inside out *) let UNIONS_IMAGE_UNIONS = prove_by_refinement( `!(X:((A->bool)->bool)->bool). UNIONS (UNIONS X) = (UNIONS (IMAGE UNIONS X))`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[EXTENSION;IN_UNIONS]; GEN_TAC; REWRITE_TAC[EXTENSION;IN_UNIONS]; EQ_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; FIRST_ASSUM MP_TAC; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `UNIONS (t':(A->bool)->bool)`; REWRITE_TAC[IN_UNIONS;IN_IMAGE]; CONJ_TAC; EXISTS_TAC `(t':(A->bool)->bool)`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; DISCH_THEN CHOOSE_TAC; FIRST_ASSUM MP_TAC; REWRITE_TAC[IN_IMAGE]; DISCH_ALL_TAC; FIRST_ASSUM MP_TAC; DISCH_THEN CHOOSE_TAC; UNDISCH_TAC `(x:A) IN t`; FIRST_ASSUM (fun t-> REWRITE_TAC[t]); REWRITE_TAC[IN_UNIONS]; DISCH_THEN (CHOOSE_TAC); EXISTS_TAC `t':(A->bool)`; CONJ_TAC; EXISTS_TAC `x':(A->bool)->bool`; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let INTERS_SUBSET2 = prove_by_refinement( `!X A. (?(x:A->bool). (A x /\ (x SUBSET X))) ==> ((INTERS A) SUBSET X)`, (* {{{ proof *) [ REWRITE_TAC[SUBSET;INTERS;IN_ELIM_THM']; REWRITE_TAC[IN]; MESON_TAC[]; ]);; (* }}} *) (**** New proof by JRH; old one breaks because of new set comprehensions let INTERS_EMPTY = prove_by_refinement( `INTERS EMPTY = (UNIV:A->bool)`, (* {{{ proof *) [ REWRITE_TAC[INTERS;NOT_IN_EMPTY;IN_ELIM_THM';]; REWRITE_TAC[UNIV;GSPEC]; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; MESON_TAC[]; ]);; (* }}} *) ****) let INTERS_EMPTY = prove_by_refinement( `INTERS EMPTY = (UNIV:A->bool)`, [SET_TAC[]]);; let preimage = new_definition `preimage dom (f:A->B) Z = {x | (x IN dom) /\ (f x IN Z)}`;; let in_preimage = prove_by_refinement( `!f x Z dom. x IN (preimage dom (f:A->B) Z) <=> (x IN dom) /\ (f x IN Z)`, (* {{{ *) [ REWRITE_TAC[preimage]; REWRITE_TAC[IN_ELIM_THM'] ]);; (* }}} *) (* Partial functions, which we identify with functions that take the canonical choice of element outside the domain. *) let supp = new_definition `supp (f:A->B) = \ x. ~(f x = (CHOICE (UNIV:B ->bool)) )`;; let func = new_definition `func a b = (\ (f:A->B). ((!x. (x IN a) ==> (f x IN b)) /\ ((supp f) SUBSET a))) `;; (* relations *) let reflexive = new_definition `reflexive (f:A->A->bool) <=> (!x. f x x)`;; let symmetric = new_definition `symmetric (f:A->A->bool) <=> (!x y. f x y ==> f y x)`;; let transitive = new_definition `transitive (f:A->A->bool) <=> (!x y z. f x y /\ f y z ==> f x z)`;; let equivalence_relation = new_definition `equivalence_relation (f:A->A->bool) <=> (reflexive f) /\ (symmetric f) /\ (transitive f)`;; (* We do not introduce the equivalence class of f explicitly, because it is represented directly in HOL by (f a) *) let partition_DEF = new_definition `partition (A:A->bool) SA <=> (UNIONS SA = A) /\ (!a b. ((a IN SA) /\ (b IN SA) /\ (~(a = b)) ==> ({} = (a INTER b))))`;; let DIFF_DIFF2 = prove_by_refinement( `!X (A:A->bool). (A SUBSET X) ==> ((X DIFF (X DIFF A)) = A)`, [ SET_TAC[] ]);; (*** Old proof replaced by JRH: no longer UNWIND_THM[12] clause in IN_ELIM_THM let GSPEC_THM = prove_by_refinement( `!P (x:A). (?y. P y /\ (x = y)) <=> P x`, [REWRITE_TAC[IN_ELIM_THM]]);; ***) let GSPEC_THM = prove_by_refinement( `!P (x:A). (?y. P y /\ (x = y)) <=> P x`, [MESON_TAC[]]);; let CARD_GE_REFL = prove (`!s:A->bool. s >=_c s`, GEN_TAC THEN REWRITE_TAC[GE_C] THEN EXISTS_TAC `\x:A. x` THEN MESON_TAC[]);; let FINITE_HAS_SIZE_LEMMA = prove (`!s:A->bool. FINITE s ==> ?n:num. {x | x < n} >=_c s`, MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[NOT_IN_EMPTY; GE_C; IN_ELIM_THM]; REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `SUC N` THEN POP_ASSUM MP_TAC THEN PURE_REWRITE_TAC[GE_C] THEN DISCH_THEN(X_CHOOSE_TAC `f:num->A`) THEN EXISTS_TAC `\n:num. if n = N then x:A else f n` THEN X_GEN_TAC `y:A` THEN PURE_REWRITE_TAC[IN_INSERT] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC (ANTE_RES_THEN MP_TAC)) THENL [EXISTS_TAC `N:num` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `n:num < N` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LT_REFL] THEN ARITH_TAC]]);; let NUM_COUNTABLE = prove_by_refinement( `COUNTABLE (UNIV:num->bool)`, (* {{{ proof *) [ REWRITE_TAC[COUNTABLE;CARD_GE_REFL]; ]);; (* }}} *) let NUM2_COUNTABLE = prove_by_refinement( `COUNTABLE {((x:num),(y:num)) | T}`, (* {{{ proof *) [ CHOOSE_TAC (ISPECL[`(0,0)`;`(\ (a:num,b:num) (n:num) . if (b=0) then (0,a+b+1) else (a+1,b-1))`] num_RECURSION); REWRITE_TAC[COUNTABLE;GE_C;IN_ELIM_THM']; NAME_CONFLICT_TAC; EXISTS_TAC `fn:num -> (num#num)`; X_GEN_TAC `p:num#num`; REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)); DISCH_THEN (fun t->REWRITE_TAC[t]); REWRITE_TAC[IN_UNIV]; SUBGOAL_TAC `?t. t = x'+|y'`; MESON_TAC[]; SPEC_TAC (`x':num`,`a:num`); SPEC_TAC (`y':num`,`b:num`); CONV_TAC (quant_left_CONV "t"); CONV_TAC (quant_left_CONV "t"); CONV_TAC (quant_left_CONV "t"); INDUCT_TAC; REDUCE_TAC; REP_GEN_TAC; DISCH_THEN (fun t -> REWRITE_TAC[t]); EXISTS_TAC `0`; ASM_REWRITE_TAC[]; CONV_TAC (quant_left_CONV "a"); INDUCT_TAC; REDUCE_TAC; GEN_TAC; USE 1 (SPECL [`0`;`t:num`]); UND 1 THEN REDUCE_TAC; DISCH_THEN (X_CHOOSE_TAC `n:num`); AND 0; USE 0 (SPEC `n:num`); UND 0; UND 1; DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); CONV_TAC (ONCE_DEPTH_CONV GEN_BETA_CONV); BETA_TAC; REDUCE_TAC; DISCH_ALL_TAC; EXISTS_TAC `SUC n`; EXPAND_TAC "b"; KILL 0; ASM_REWRITE_TAC[]; REWRITE_TAC [ARITH_RULE `SUC t = t+|1`]; GEN_TAC; ABBREV_TAC `t' = SUC t`; USE 2 (SPEC `SUC b`); DISCH_TAC; UND 2; ASM_REWRITE_TAC[]; REWRITE_TAC[ARITH_RULE `SUC a +| b = a +| SUC b`]; DISCH_THEN (X_CHOOSE_TAC `n:num`); EXISTS_TAC `SUC n`; AND 0; USE 0 (SPEC `n:num`); UND 0; UND 2; DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); CONV_TAC (ONCE_DEPTH_CONV GEN_BETA_CONV); BETA_TAC; REDUCE_TAC; DISCH_THEN (fun t->REWRITE_TAC[t]); REWRITE_TAC[ARITH_RULE `SUC a = a+| 1`]; ]);; (* }}} *) let COUNTABLE_UNIONS = prove_by_refinement( `!A:(A->bool)->bool. (COUNTABLE A) /\ (!a. (a IN A) ==> (COUNTABLE a)) ==> (COUNTABLE (UNIONS A))`, (* {{{ proof *) [ GEN_TAC; DISCH_ALL_TAC; USE 0 (REWRITE_RULE[COUNTABLE;GE_C;IN_UNIV]); CHO 0; USE 0 (CONV_RULE (quant_left_CONV "x")); USE 0 (CONV_RULE (quant_left_CONV "x")); CHO 0; USE 1 (REWRITE_RULE[COUNTABLE;GE_C;IN_UNIV]); USE 1 (CONV_RULE (quant_left_CONV "f")); USE 1 (CONV_RULE (quant_left_CONV "f")); UND 1; DISCH_THEN (X_CHOOSE_TAC `g:(A->bool)->num->A`); SUBGOAL_TAC `!a y. (a IN (A:(A->bool)->bool)) /\ (y IN a) ==> (? (u:num) (v:num). ( a = f u) /\ (y = g a v))`; REP_GEN_TAC; DISCH_ALL_TAC; USE 1 (SPEC `a:A->bool`); USE 0 (SPEC `a:A->bool`); EXISTS_TAC `(x:(A->bool)->num) a`; ASM_SIMP_TAC[]; ASSUME_TAC NUM2_COUNTABLE; USE 2 (REWRITE_RULE[COUNTABLE;GE_C;IN_ELIM_THM';IN_UNIV]); USE 2 (CONV_RULE NAME_CONFLICT_CONV); UND 2 THEN (DISCH_THEN (X_CHOOSE_TAC `h:num->(num#num)`)); DISCH_TAC; REWRITE_TAC[COUNTABLE;GE_C;IN_ELIM_THM';IN_UNIV;IN_UNIONS]; EXISTS_TAC `(\p. (g:(A->bool)->num->A) ((f:num->(A->bool)) (FST ((h:num->(num#num)) p))) (SND (h p)))`; BETA_TAC; GEN_TAC; DISCH_THEN (CHOOSE_THEN MP_TAC); DISCH_ALL_TAC; USE 3 (SPEC `t:A->bool`); USE 3 (SPEC `y:A`); UND 3 THEN (ASM_REWRITE_TAC[]); REPEAT (DISCH_THEN(CHOOSE_THEN (MP_TAC))); DISCH_ALL_TAC; USE 2 (SPEC `(u:num,v:num)`); SUBGOAL_TAC `?x' y'. (u:num,v:num) = (x',y')`; MESON_TAC[]; DISCH_TAC; UND 2; ASM_REWRITE_TAC[]; DISCH_THEN (CHOOSE_THEN (ASSUME_TAC o GSYM)); EXISTS_TAC `x':num`; ASM_REWRITE_TAC[]; ]);; (* }}} *) let COUNTABLE_IMAGE = prove_by_refinement( `!(A:A->bool) (B:B->bool) . (COUNTABLE A) /\ (?f. (B SUBSET IMAGE f A)) ==> (COUNTABLE B)`, (* {{{ proof *) [ REWRITE_TAC[COUNTABLE;GE_C;IN_UNIV;IN_ELIM_THM';SUBSET]; DISCH_ALL_TAC; CHO 0; USE 1 (REWRITE_RULE[IMAGE;IN_ELIM_THM']); CHO 1; USE 1 (REWRITE_RULE[IN_ELIM_THM']); USE 1 (CONV_RULE NAME_CONFLICT_CONV); EXISTS_TAC `(f':A->B) o (f:num->A)`; REWRITE_TAC[o_DEF]; DISCH_ALL_TAC; USE 1 (SPEC `y:B`); UND 1; ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; USE 0 (SPEC `x':A`); UND 0 THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let COUNTABLE_CARD = prove_by_refinement( `!(A:A->bool) (B:B->bool). (COUNTABLE A) /\ (A >=_c B) ==> (COUNTABLE B)`, (* {{{ proof *) [ DISCH_ALL_TAC; MATCH_MP_TAC COUNTABLE_IMAGE; EXISTS_TAC `A:A->bool`; ASM_REWRITE_TAC[]; REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM']; USE 1 (REWRITE_RULE[GE_C]); CHO 1; EXISTS_TAC `f:A->B`; ASM_REWRITE_TAC[]; ]);; (* }}} *) let COUNTABLE_NUMSEG = prove_by_refinement( `!n. COUNTABLE {x | x <| n}`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[COUNTABLE;GE_C;IN_UNIV]; EXISTS_TAC `I:num->num`; REDUCE_TAC; REWRITE_TAC[IN_ELIM_THM']; MESON_TAC[]; ]);; (* }}} *) let FINITE_COUNTABLE = prove_by_refinement( `!(A:A->bool). (FINITE A) ==> (COUNTABLE A)`, (* {{{ proof *) [ DISCH_ALL_TAC; USE 0 (MATCH_MP FINITE_HAS_SIZE_LEMMA); CHO 0; ASSUME_TAC(SPEC `n:num` COUNTABLE_NUMSEG); JOIN 1 0; USE 0 (MATCH_MP COUNTABLE_CARD); ASM_REWRITE_TAC[]; ]);; (* }}} *) let num_infinite = prove_by_refinement( `~ (FINITE (UNIV:num->bool))`, (* {{{ proof *) [ PROOF_BY_CONTR_TAC; USE 0 (REWRITE_RULE[]); USE 0 (MATCH_MP num_FINITE_AVOID); USE 0 (REWRITE_RULE[IN_UNIV]); ASM_REWRITE_TAC[]; ]);; (* }}} *) let num_SEG_UNION = prove_by_refinement( `!i. ({u | i <| u} UNION {m | m <=| i}) = UNIV`, (* {{{ proof *) [ REP_BASIC_TAC; SUBGOAL_TAC `({u | i <| u} UNION {m | m <=| i}) = UNIV`; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[UNIV;UNION;IN_ELIM_THM']; ARITH_TAC; REWRITE_TAC[]; ]);; (* }}} *) let num_above_infinite = prove_by_refinement( `!i. ~ (FINITE {u | i <| u})`, (* {{{ proof *) [ GEN_TAC; PROOF_BY_CONTR_TAC; USE 0 (REWRITE_RULE[]); ASSUME_TAC(SPEC `i:num` FINITE_NUMSEG_LE); JOIN 0 1; USE 0 (MATCH_MP FINITE_UNION_IMP); SUBGOAL_TAC `({u | i <| u} UNION {m | m <=| i}) = UNIV`; REWRITE_TAC[num_SEG_UNION]; DISCH_TAC; UND 0; ASM_REWRITE_TAC[]; REWRITE_TAC[num_infinite]; ]);; (* }}} *) let INTER_FINITE = prove_by_refinement( `!s (t:A->bool). (FINITE s ==> FINITE(s INTER t)) /\ (FINITE t ==> FINITE (s INTER t))`, (* {{{ proof *) [ CONV_TAC (quant_right_CONV "t"); CONV_TAC (quant_right_CONV "s"); SUBCONJ_TAC; DISCH_ALL_TAC; SUBGOAL_TAC `s INTER t SUBSET (s:A->bool)`; SET_TAC[]; ASM_MESON_TAC[FINITE_SUBSET]; MESON_TAC[INTER_COMM]; ]);; (* }}} *) let num_above_finite = prove_by_refinement( `!i J. (FINITE (J INTER {u | (i <| u)})) ==> (FINITE J)`, (* {{{ proof *) [ DISCH_ALL_TAC; SUBGOAL_TAC `J = (J INTER {u | (i <| u)}) UNION (J INTER {m | m <=| i})`; REWRITE_TAC[GSYM UNION_OVER_INTER;num_SEG_UNION;INTER_UNIV]; DISCH_TAC; ASM (ONCE_REWRITE_TAC)[]; REWRITE_TAC[FINITE_UNION]; ASM_REWRITE_TAC[]; MP_TAC (SPEC `i:num` FINITE_NUMSEG_LE); REWRITE_TAC[INTER_FINITE]; ]);; (* }}} *) let SUBSET_SUC = prove_by_refinement( `!(f:num->A->bool). (!i. f i SUBSET f (SUC i)) ==> (! i j. ( i <=| j) ==> (f i SUBSET f j))`, (* {{{ proof *) [ GEN_TAC; DISCH_TAC; REP_GEN_TAC; MP_TAC (prove( `?n. n = j -| i`,MESON_TAC[])); CONV_TAC (quant_left_CONV "n"); SPEC_TAC (`i:num`,`i:num`); SPEC_TAC (`j:num`,`j:num`); REP 2( CONV_TAC (quant_left_CONV "n")); INDUCT_TAC; REP_GEN_TAC; DISCH_ALL_TAC; JOIN 1 2; USE 1 (CONV_RULE REDUCE_CONV); ASM_REWRITE_TAC[SUBSET]; REP_GEN_TAC; DISCH_TAC; SUBGOAL_TAC `?j'. j = SUC j'`; DISJ_CASES_TAC (SPEC `j:num` num_CASES); UND 2; ASM_REWRITE_TAC[]; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; USE 0 (SPEC `j':num`); USE 1(SPECL [`j':num`;`i:num`]); DISCH_TAC; SUBGOAL_TAC `(n = j'-|i)`; UND 2; ASM_REWRITE_TAC[]; ARITH_TAC; DISCH_TAC; SUBGOAL_TAC `(i<=| j')`; USE 2 (MATCH_MP(ARITH_RULE `(SUC n = j -| i) ==> (0 < j -| i)`)); UND 2; ASM_REWRITE_TAC[]; ARITH_TAC; UND 1; ASM_REWRITE_TAC []; DISCH_ALL_TAC; REWR 6; ASM_MESON_TAC[SUBSET_TRANS]; ]);; (* }}} *) let SUBSET_SUC2 = prove_by_refinement( `!(f:num->A->bool). (!i. f (SUC i) SUBSET (f i)) ==> (! i j. ( i <=| j) ==> (f j SUBSET f i))`, (* {{{ proof *) [ GEN_TAC; DISCH_TAC; REP_GEN_TAC; MP_TAC (prove( `?n. n = j -| i`,MESON_TAC[])); CONV_TAC (quant_left_CONV "n"); SPEC_TAC (`i:num`,`i:num`); SPEC_TAC (`j:num`,`j:num`); REP 2( CONV_TAC (quant_left_CONV "n")); INDUCT_TAC; REP_GEN_TAC; DISCH_ALL_TAC; JOIN 1 2; USE 1 (CONV_RULE REDUCE_CONV); ASM_REWRITE_TAC[SUBSET]; REP_GEN_TAC; DISCH_TAC; SUBGOAL_TAC `?j'. j = SUC j'`; DISJ_CASES_TAC (SPEC `j:num` num_CASES); UND 2; ASM_REWRITE_TAC[]; REDUCE_TAC; ASM_REWRITE_TAC[]; DISCH_THEN CHOOSE_TAC; ASM_REWRITE_TAC[]; USE 0 (SPEC `j':num`); USE 1(SPECL [`j':num`;`i:num`]); DISCH_TAC; SUBGOAL_TAC `(n = j'-|i)`; UND 2; ASM_REWRITE_TAC[]; ARITH_TAC; DISCH_TAC; SUBGOAL_TAC `(i<=| j')`; USE 2 (MATCH_MP(ARITH_RULE `(SUC n = j -| i) ==> (0 < j -| i)`)); UND 2; ASM_REWRITE_TAC[]; ARITH_TAC; UND 1; ASM_REWRITE_TAC []; DISCH_ALL_TAC; REWR 6; ASM_MESON_TAC[SUBSET_TRANS]; ]);; (* }}} *) let INFINITE_PIGEONHOLE = prove_by_refinement( `!I (f:A->B) B C. (~(FINITE {i | (I i) /\ (C (f i))})) /\ (FINITE B) /\ (C SUBSET (UNIONS B)) ==> (?b. (B b) /\ ~(FINITE {i | (I i) /\ (C INTER b) (f i) }))`, (* {{{ proof *) [ DISCH_ALL_TAC; PROOF_BY_CONTR_TAC; USE 3 ( CONV_RULE (quant_left_CONV "b")); UND 0; TAUT_TAC `P ==> (~P ==> F)`; SUBGOAL_TAC `{i | I' i /\ (C ((f:A->B) i))} = UNIONS (IMAGE (\b. {i | I' i /\ ((C INTER b) (f i))}) B)`; REWRITE_TAC[UNIONS;IN_IMAGE]; MATCH_MP_TAC EQ_EXT; GEN_TAC; REWRITE_TAC[IN_ELIM_THM']; ABBREV_TAC `j = (x:A)`; EQ_TAC; DISCH_ALL_TAC; USE 2 (REWRITE_RULE [SUBSET;UNIONS]); USE 2 (REWRITE_RULE[IN_ELIM_THM']); USE 2 (SPEC `(f:A->B) j`); USE 2 (REWRITE_RULE[IN]); REWR 2; CHO 2; CONV_TAC (quant_left_CONV "x"); CONV_TAC (quant_left_CONV "x"); EXISTS_TAC (`u:B->bool`); NAME_CONFLICT_TAC; EXISTS_TAC (`{i' | I' i' /\ (C INTER u) ((f:A->B) i')}`); ASM_REWRITE_TAC[]; REWRITE_TAC[IN_ELIM_THM';INTER]; REWRITE_TAC[IN]; ASM_REWRITE_TAC[]; DISCH_TAC; CHO 4; AND 4; CHO 5; REWR 4; USE 4 (REWRITE_RULE[IN_ELIM_THM';INTER]); USE 4 (REWRITE_RULE[IN]); ASM_REWRITE_TAC[]; DISCH_TAC; ASM_REWRITE_TAC[]; SUBGOAL_TAC `FINITE (IMAGE (\b. {i | I' i /\ (C INTER b) ((f:A->B) i)}) B)`; MATCH_MP_TAC FINITE_IMAGE; ASM_REWRITE_TAC[]; SIMP_TAC[FINITE_UNIONS]; DISCH_TAC; GEN_TAC; REWRITE_TAC[IN_IMAGE]; DISCH_THEN (X_CHOOSE_TAC `b:B->bool`); ASM_REWRITE_TAC[]; USE 3 (SPEC `b:B->bool`); UND 3; AND 5; UND 3; ABBREV_TAC `r = {i | I' i /\ (C INTER b) ((f:A->B) i)}`; MESON_TAC[IN]; ]);; (* }}} *) let real_FINITE = prove_by_refinement( `!(s:real->bool). FINITE s ==> (?a. !x. x IN s ==> (x <=. a))`, (* {{{ proof *) [ DISCH_ALL_TAC; ASSUME_TAC REAL_ARCH_SIMPLE; USE 1 (CONV_RULE (quant_left_CONV "n")); CHO 1; SUBGOAL_TAC `FINITE (IMAGE (n:real->num) s)`; ASM_MESON_TAC[FINITE_IMAGE]; (*** JRH -- num_FINITE is now an equivalence not an implication ASSUME_TAC (SPEC `IMAGE (n:real->num) s` num_FINITE); ***) ASSUME_TAC(fst(EQ_IMP_RULE(SPEC `IMAGE (n:real->num) s` num_FINITE))); DISCH_TAC; REWR 2; CHO 2; USE 2 (REWRITE_RULE[IN_IMAGE]); USE 2 (CONV_RULE NAME_CONFLICT_CONV); EXISTS_TAC `&.a`; GEN_TAC; USE 2 (CONV_RULE (quant_left_CONV "x'")); USE 2 (CONV_RULE (quant_left_CONV "x'")); USE 2 (SPEC `x:real`); USE 2 (SPEC `(n:real->num) x`); DISCH_TAC; REWR 2; USE 1 (SPEC `x:real`); UND 1; MATCH_MP_TAC (REAL_ARITH `a<=b ==> ((x <= a) ==> (x <=. b))`); REDUCE_TAC; ASM_REWRITE_TAC []; ]);; (* }}} *) let UNIONS_DELETE = prove_by_refinement( `!s. (UNIONS (s:(A->bool)->bool)) = (UNIONS (s DELETE (EMPTY)))`, (* {{{ proof *) [ REWRITE_TAC[UNIONS;DELETE;EMPTY]; GEN_TAC; MATCH_MP_TAC EQ_EXT; REWRITE_TAC[IN_ELIM_THM']; GEN_TAC; REWRITE_TAC[IN]; MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Partial functions, which we identify with functions that take the canonical choice of element outside the domain. *) (* ------------------------------------------------------------------ *) let SUPP = new_definition `SUPP (f:A->B) = \ x. ~(f x = (CHOICE (UNIV:B ->bool)) )`;; let FUN = new_definition `FUN a b = (\ (f:A->B). ((!x. (x IN a) ==> (f x IN b)) /\ ((SUPP f) SUBSET a))) `;; (* ------------------------------------------------------------------ *) (* compositions *) (* ------------------------------------------------------------------ *) let compose = new_definition `compose f g = \x. (f (g x))`;; let COMP_ASSOC = prove_by_refinement( `!(f:num ->num) (g:num->num) (h:num->num). (compose f (compose g h)) = (compose (compose f g) h)`, (* {{{ proof *) [ REPEAT GEN_TAC THEN REWRITE_TAC[compose]; ]);; (* }}} *) let COMP_INJ = prove (`!(f:A->B) (g:B->C) s t u. INJ f s t /\ (INJ g t u) ==> (INJ (compose g f) s u)`, (* {{{ proof *) EVERY[REPEAT GEN_TAC; REWRITE_TAC[INJ;compose]; DISCH_ALL_TAC; ASM_MESON_TAC[]]);; (* }}} *) let COMP_SURJ = prove (`!(f:A->B) (g:B->C) s t u. SURJ f s t /\ (SURJ g t u) ==> (SURJ (compose g f) s u)`, (* {{{ proof *) EVERY[REWRITE_TAC[SURJ;compose]; DISCH_ALL_TAC; ASM_MESON_TAC[]]);; (* }}} *) let COMP_BIJ = prove (`!(f:A->B) s t (g:B->C) u. BIJ f s t /\ (BIJ g t u) ==> (BIJ (compose g f) s u)`, (* {{{ proof *) EVERY[ REPEAT GEN_TAC; REWRITE_TAC[BIJ]; DISCH_ALL_TAC; ASM_MESON_TAC[COMP_INJ;COMP_SURJ]]);; (* }}} *) (* ------------------------------------------------------------------ *) (* general construction of an inverse function on a domain *) (* ------------------------------------------------------------------ *) let INVERSE_FN = prove_by_refinement( `?INV. (! (f:A->B) a b. (SURJ f a b) ==> ((INJ (INV f a b) b a) /\ (!(x:B). (x IN b) ==> (f ((INV f a b) x) = x))))`, (* {{{ proof *) [ REWRITE_TAC[GSYM SKOLEM_THM]; REPEAT GEN_TAC; MATCH_MP_TAC (prove_by_refinement( `!A B. (A ==> (?x. (B x))) ==> (?(x:B->A). (A ==> (B x)))`,[MESON_TAC[]])) ; REWRITE_TAC[SURJ;INJ]; DISCH_ALL_TAC; SUBGOAL_TAC `?u. !y. ((y IN b)==> ((u y IN a) /\ ((f:A->B) (u y) = y)))`; REWRITE_TAC[GSYM SKOLEM_THM]; GEN_TAC; ASM_MESON_TAC[]; DISCH_THEN CHOOSE_TAC; EXISTS_TAC `u:B->A`; REPEAT CONJ_TAC; ASM_MESON_TAC[]; REPEAT GEN_TAC; DISCH_ALL_TAC; FIRST_X_ASSUM (fun th -> ASSUME_TAC (AP_TERM `f:A->B` th)); ASM_MESON_TAC[]; ASM_MESON_TAC[] ]);; (* }}} *) let INVERSE_DEF = new_specification ["INV"] INVERSE_FN;; let INVERSE_BIJ = prove_by_refinement( `!(f:A->B) a b. (BIJ f a b) ==> ((BIJ (INV f a b) b a))`, (* {{{ proof *) [ REPEAT GEN_TAC; REWRITE_TAC[BIJ]; DISCH_ALL_TAC; ASM_SIMP_TAC[INVERSE_DEF]; REWRITE_TAC[SURJ]; CONJ_TAC; ASM_MESON_TAC[INVERSE_DEF;INJ]; GEN_TAC THEN DISCH_TAC; EXISTS_TAC `(f:A->B) x`; CONJ_TAC; ASM_MESON_TAC[INJ]; SUBGOAL_THEN `((f:A->B) x) IN b` ASSUME_TAC; ASM_MESON_TAC[INJ]; SUBGOAL_THEN `(f:A->B) (INV f a b (f x)) = (f x)` ASSUME_TAC; ASM_MESON_TAC[INVERSE_DEF]; H_UNDISCH_TAC (HYP "0"); REWRITE_TAC[INJ]; DISCH_ALL_TAC; FIRST_X_ASSUM (fun th -> MP_TAC (SPECL [`INV (f:A->B) a b (f x)`;`x:A`] th)); ASM_REWRITE_TAC[]; DISCH_ALL_TAC; SUBGOAL_THEN `INV (f:A->B) a b (f x) IN a` ASSUME_TAC; ASM_MESON_TAC[INVERSE_DEF;INJ]; ASM_MESON_TAC[]; ]);; (* }}} *) let INVERSE_XY = prove_by_refinement( `!(f:A->B) a b x y. (BIJ f a b) /\ (x IN a) /\ (y IN b) ==> ((INV f a b y = x) <=> (f x = y))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; EQ_TAC; FIRST_X_ASSUM (fun th -> (ASSUME_TAC th THEN (ASSUME_TAC (MATCH_MP INVERSE_DEF (CONJUNCT2 (REWRITE_RULE[BIJ] th)))))); ASM_MESON_TAC[]; POP_ASSUM (fun th -> (ASSUME_TAC th THEN (ASSUME_TAC (CONJUNCT2 (REWRITE_RULE[INJ] (CONJUNCT1 (REWRITE_RULE[BIJ] th))))))); DISCH_THEN (fun th -> ASSUME_TAC th THEN (REWRITE_TAC[GSYM th])); FIRST_X_ASSUM MATCH_MP_TAC; REPEAT CONJ_TAC; ASM_REWRITE_TAC[]; IMP_RES_THEN ASSUME_TAC INVERSE_BIJ; ASM_MESON_TAC[BIJ;INJ]; ASM_REWRITE_TAC[]; FIRST_X_ASSUM (fun th -> (ASSUME_TAC (CONJUNCT2 (REWRITE_RULE[BIJ] th)))); IMP_RES_THEN (fun th -> ASSUME_TAC (CONJUNCT2 th)) INVERSE_DEF; ASM_MESON_TAC[]; ]);; (* }}} *) let FINITE_BIJ = prove( `!a b (f:A->B). FINITE a /\ (BIJ f a b) ==> (FINITE b)`, (* {{{ proof *) MESON_TAC[SURJ_IMAGE;BIJ;INJ;FINITE_IMAGE] );; (* }}} *) let FINITE_INJ = prove_by_refinement( `!a b (f:A->B). FINITE b /\ (INJ f a b) ==> (FINITE a)`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; MP_TAC (SPECL [`f:A->B`;`b:B->bool`;`a:A->bool`] FINITE_IMAGE_INJ_GENERAL); DISCH_ALL_TAC; SUBGOAL_THEN `(a:A->bool) SUBSET ({x | (x IN a) /\ ((f:A->B) x IN b)})` ASSUME_TAC; REWRITE_TAC[SUBSET]; GEN_TAC ; REWRITE_TAC[IN_ELIM_THM]; POPL_TAC[0;1]; ASM_MESON_TAC[BIJ;INJ]; MATCH_MP_TAC FINITE_SUBSET; EXISTS_TAC `({x | (x IN a) /\ ((f:A->B) x IN b)})` ; CONJ_TAC; FIRST_X_ASSUM (fun th -> MATCH_MP_TAC th); CONJ_TAC; ASM_MESON_TAC[BIJ;INJ]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ] );; (* }}} *) let FINITE_BIJ2 = prove_by_refinement( `!a b (f:A->B). FINITE b /\ (BIJ f a b) ==> (FINITE a)`, (* {{{ proof *) [ MESON_TAC[BIJ;FINITE_INJ] ]);; (* }}} *) let BIJ_CARD = prove_by_refinement( `!a b (f:A->B). FINITE a /\ (BIJ f a b) ==> (CARD a = (CARD b))`, (* {{{ proof *) [ ASM_MESON_TAC[SURJ_IMAGE;BIJ;INJ;CARD_IMAGE_INJ]; ]);; (* }}} *) let PAIR_LEMMA = prove_by_refinement( `!(x:num#num) i j. ((FST x = i) /\ (SND x = j)) <=> (x = (i,j))` , (* {{{ proof *) [ MESON_TAC[FST;SND;PAIR]; ]);; (* }}} *) let CARD_SING = prove_by_refinement( `!(u:A->bool). (SING u ) ==> (CARD u = 1)`, (* {{{ proof *) [ REWRITE_TAC[SING]; GEN_TAC; DISCH_THEN (CHOOSE_TAC); ASM_REWRITE_TAC[]; ASSUME_TAC FINITE_RULES; ASM_SIMP_TAC[CARD_CLAUSES;NOT_IN_EMPTY]; ACCEPT_TAC (NUM_RED_CONV `SUC 0`) ]);; (* }}} *) let FINITE_SING = prove_by_refinement( `!(x:A). FINITE ({x})`, (* {{{ proof *) [ MESON_TAC[FINITE_RULES] ]);; (* }}} *) let NUM_INTRO = prove_by_refinement( `!f P.((!(n:num). !(g:A). (f g = n) ==> (P g)) ==> (!g. (P g)))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; GEN_TAC; H_VAL (SPECL [`(f:A->num) (g:A)`; `g:A`]) (HYP "0"); ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Lemmas about the support of a function *) (* ------------------------------------------------------------------ *) (* Law of cardinal exponents B^0 = 1 *) let DOMAIN_EMPTY = prove_by_refinement( `!b. FUN (EMPTY:A->bool) b = { (\ (u:A). (CHOICE (UNIV:B->bool))) }`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[EXTENSION;FUN]; X_GEN_TAC `f:A->B`; REWRITE_TAC[IN_ELIM_THM;INSERT;NOT_IN_EMPTY;SUBSET_EMPTY;SUPP]; REWRITE_TAC[EMPTY]; ONCE_REWRITE_TAC[EXTENSION]; REWRITE_TAC[IN]; EQ_TAC; DISCH_TAC THEN (MATCH_MP_TAC EQ_EXT); BETA_TAC; ASM_REWRITE_TAC[]; DISCH_TAC THEN (ASM_REWRITE_TAC[]) THEN BETA_TAC; ]);; (* }}} *) (* Law of cardinal exponents B^A * B = B^(A+1) *) let DOMAIN_INSERT = prove_by_refinement( `!a b s. (~((s:A) IN a) ==> (?F. (BIJ F (FUN (s INSERT a) b) { (u,v) | (u IN (FUN a b)) /\ ((v:B) IN b) } )))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_TAC; EXISTS_TAC `\ f. ((\ x. (if (x=(s:A)) then (CHOICE (UNIV:B->bool)) else (f x))),(f s))`; REWRITE_TAC[BIJ;INJ;SURJ]; TAUT_TAC `(A /\ (A ==> B) /\ (A ==>C)) ==> ((A/\ B) /\ (A /\ C))`; REPEAT CONJ_TAC; X_GEN_TAC `(f:A->B)`; REWRITE_TAC[FUN;IN_ELIM_THM]; REWRITE_TAC[INSERT;SUBSET]; REWRITE_TAC[IN_ELIM_THM;SUPP]; STRIP_TAC; ABBREV_TAC `g = \ x. (if (x=(s:A)) then (CHOICE (UNIV:B->bool)) else (f x)) `; EXISTS_TAC `g:A->B`; EXISTS_TAC `(f:A->B) s`; REWRITE_TAC[]; REPEAT CONJ_TAC; EXPAND_TAC "g" THEN BETA_TAC; GEN_TAC; REWRITE_TAC[IN;COND_ELIM_THM]; ASM_MESON_TAC[IN]; (* next *) ALL_TAC; EXPAND_TAC "g" THEN BETA_TAC; GEN_TAC; ASM_CASES_TAC `(x:A) = s`; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* next *) ALL_TAC; ASM_MESON_TAC[]; (* INJ *) ALL_TAC; REWRITE_TAC[FUN;SUPP]; DISCH_TAC; X_GEN_TAC `f1:A->B`; X_GEN_TAC `f2:A->B`; REWRITE_TAC[IN]; DISCH_ALL_TAC; MATCH_MP_TAC EQ_EXT; GEN_TAC; ASM_CASES_TAC `(x:A) = s`; POPL_TAC[1;2;3;4;6;7]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[PAIR;FST;SND]; POPL_TAC[1;2;3;4;6;7]; FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[FST] (AP_TERM `FST:((A->B)#B)->(A->B)` th))) ; FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[COND_ELIM_THM] (BETA_RULE (AP_THM th `x:A`)))); LABEL_ALL_TAC; H_UNDISCH_TAC (HYP "0"); COND_CASES_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[]; (* SURJ *) ALL_TAC; REWRITE_TAC[FUN;SUPP;IN_ELIM_THM]; REWRITE_TAC[IN;INSERT;SUBSET]; DISCH_ALL_TAC; X_GEN_TAC `p:(A->B)#B`; DISCH_THEN CHOOSE_TAC; FIRST_X_ASSUM (fun th -> MP_TAC th); DISCH_THEN CHOOSE_TAC; FIRST_X_ASSUM MP_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; EXISTS_TAC `\ (x:A). if (x = s) then (v:B) else (u x)`; REPEAT CONJ_TAC; X_GEN_TAC `t:A`; BETA_TAC; REWRITE_TAC[IN_ELIM_THM;COND_ELIM_THM]; POPL_TAC[1;3;4;5]; ASM_MESON_TAC[]; X_GEN_TAC `t:A`; BETA_TAC; REWRITE_TAC[IN_ELIM_THM;COND_ELIM_THM]; ASM_CASES_TAC `(t:A) = s`; POPL_TAC[1;3;4;5;6]; ASM_REWRITE_TAC[]; POPL_TAC[1;3;4;5;6]; FIRST_X_ASSUM (fun th -> ASSUME_TAC (SPEC `t:A` th)); ASM_SIMP_TAC[prove(`~((t:A)=s) ==> ((t=s)=F)`,MESON_TAC[])]; BETA_TAC; REWRITE_TAC[]; POPL_TAC[0;2;3;4]; AP_THM_TAC; AP_TERM_TAC; MATCH_MP_TAC EQ_EXT; X_GEN_TAC `t:A`; BETA_TAC; DISJ_CASES_TAC (prove(`(((t:A)=s) <=> T) \/ ((t=s) <=> F)`,MESON_TAC[])); ASM_REWRITE_TAC[]; ASM_MESON_TAC[IN]; ASM_REWRITE_TAC[] ]);; (* }}} *) let CARD_DELETE_CHOICE = prove_by_refinement( `!(a:(A->bool)). ((FINITE a) /\ (~(a=EMPTY))) ==> (SUC (CARD (a DELETE (CHOICE a))) = (CARD a))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; ASM_SIMP_TAC[CARD_DELETE]; ASM_SIMP_TAC[CHOICE_DEF]; MATCH_MP_TAC (ARITH_RULE `~(x=0) ==> (SUC (x -| 1) = x)`); ASM_MESON_TAC[HAS_SIZE_0;HAS_SIZE]; ]);; (* }}} *) (* let dets_flag = ref true;; dets_flag:= !labels_flag;; *) labels_flag:=false;; (* Law of cardinals |B^A| = |B|^|A| *) let FUN_SIZE = prove_by_refinement( `!b a. (FINITE (a:A->bool)) /\ (FINITE (b:B->bool)) ==> ((FUN a b) HAS_SIZE ((CARD b) EXP (CARD a)))`, (* {{{ proof *) [ GEN_TAC; MATCH_MP_TAC (SPEC `CARD:(A->bool)->num` ((INST_TYPE) [`:A->bool`,`:A`] NUM_INTRO)); INDUCT_TAC; GEN_TAC; DISCH_ALL_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC [EXP]; SUBGOAL_THEN `(a:A->bool) = EMPTY` ASSUME_TAC; ASM_REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE]; ASM_REWRITE_TAC[HAS_SIZE;DOMAIN_EMPTY]; CONJ_TAC; REWRITE_TAC[FINITE_SING]; MATCH_MP_TAC CARD_SING; REWRITE_TAC[SING]; MESON_TAC[]; GEN_TAC; FIRST_X_ASSUM (fun th -> ASSUME_TAC (SPEC `(a:A->bool) DELETE (CHOICE a)` th)) ; DISCH_ALL_TAC; SUBGOAL_THEN `CARD ((a:A->bool) DELETE (CHOICE a)) = n` ASSUME_TAC; ASM_SIMP_TAC[CARD_DELETE]; SUBGOAL_THEN `CHOICE (a:A->bool) IN a` ASSUME_TAC; MATCH_MP_TAC CHOICE_DEF; ASSUME_TAC( ARITH_RULE `!x. (x = (SUC n)) ==> (~(x = 0))`); REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]; MESON_TAC[ ( ARITH_RULE `!n. (SUC n -| 1) = n`)]; LABEL_ALL_TAC; H_MATCH_MP (HYP "3") (HYP "4"); SUBGOAL_THEN `FUN ((a:A->bool) DELETE CHOICE a) (b:B->bool) HAS_SIZE CARD b **| CARD (a DELETE CHOICE a)` ASSUME_TAC; ASM_MESON_TAC[FINITE_DELETE]; ASSUME_TAC (SPECL [`((a:A->bool) DELETE (CHOICE a))`;`b:B->bool`;`(CHOICE (a:A->bool))` ] DOMAIN_INSERT); LABEL_ALL_TAC; H_UNDISCH_TAC (HYP "5"); REWRITE_TAC[IN_DELETE]; SUBGOAL_THEN `~((a:A->bool) = EMPTY)` ASSUME_TAC; REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE]; ASSUME_TAC( ARITH_RULE `!x. (x = (SUC n)) ==> (~(x = 0))`); ASM_MESON_TAC[]; ASM_SIMP_TAC[INSERT_DELETE;CHOICE_DEF]; DISCH_THEN CHOOSE_TAC; REWRITE_TAC[HAS_SIZE]; SUBGOAL_THEN `FINITE (FUN (a:A->bool) (b:B->bool))` ASSUME_TAC; (* CONJ_TAC; *) ALL_TAC; MATCH_MP_TAC (SPEC `FUN (a:A->bool) (b:B->bool)` (PINST[(`:A->B`,`:A`);(`:(A->B)#B`,`:B`)] [] FINITE_BIJ2)); EXISTS_TAC `{u,v | (u:A->B) IN FUN (a DELETE CHOICE a) b /\ (v:B) IN b}`; EXISTS_TAC `F':(A->B)->((A->B)#B)`; ASM_REWRITE_TAC[]; MATCH_MP_TAC FINITE_PRODUCT; ASM_REWRITE_TAC[]; ASM_MESON_TAC[HAS_SIZE]; ASM_REWRITE_TAC[]; SUBGOAL_THEN `CARD (FUN (a:A->bool) (b:B->bool)) = (CARD {u,v | (u:A->B) IN FUN (a DELETE CHOICE a) b /\ (v:B) IN b})` ASSUME_TAC; MATCH_MP_TAC BIJ_CARD; EXISTS_TAC `F':(A->B)->((A->B)#B)`; ASM_REWRITE_TAC[]; (* *) ALL_TAC; ASM_REWRITE_TAC[]; SUBGOAL_THEN `FINITE (a DELETE CHOICE (a:A->bool))` ASSUME_TAC; ASM_MESON_TAC[FINITE_DELETE]; SUBGOAL_THEN `(FUN ((a:A->bool) DELETE CHOICE a) (b:B->bool)) HAS_SIZE (CARD b **| (CARD (a DELETE CHOICE a)))` ASSUME_TAC; POPL_TAC[1;2;3;4;5;10;11]; ASM_MESON_TAC[CARD_DELETE]; POP_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[HAS_SIZE] th) THEN (ASSUME_TAC th)); ASM_SIMP_TAC[CARD_PRODUCT]; REWRITE_TAC[EXP;MULT_AC] ]);; (* }}} *) labels_flag:= true;; (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) (* Definitions in math tend to be n-tuples of data. Let's make it easy to pick out the individual components of a definition *) (* pick out the rest of n-tuples. Indexing consistent with lib.drop *) let drop0 = new_definition(`drop0 (u:A#B) = SND u`);; let drop1 = new_definition(`drop1 (u:A#B#C) = SND (SND u)`);; let drop2 = new_definition(`drop2 (u:A#B#C#D) = SND (SND (SND u))`);; let drop3 = new_definition(`drop3 (u:A#B#C#D#E) = SND (SND (SND (SND u)))`);; (* pick out parts of n-tuples *) let part0 = new_definition(`part0 (u:A#B) = FST u`);; let part1 = new_definition(`part1 (u:A#B#C) = FST (drop0 u)`);; let part2 = new_definition(`part2 (u:A#B#C#D) = FST (drop1 u)`);; let part3 = new_definition(`part3 (u:A#B#C#D#E) = FST (drop2 u)`);; let part4 = new_definition(`part4 (u:A#B#C#D#E#F) = FST (drop3 u)`);; let part5 = new_definition(`part5 (u:A#B#C#D#E#F#G) = FST (SND (SND (SND (SND (SND u)))))`);; let part6 = new_definition(`part6 (u:A#B#C#D#E#F#G#H) = FST (SND (SND (SND (SND (SND (SND u))))))`);; let part7 = new_definition(`part7 (u:A#B#C#D#E#F#G#H#I) = FST (SND (SND (SND (SND (SND (SND (SND u)))))))`);; (* ------------------------------------------------------------------ *) (* Basic Definitions of Euclidean Space, Metric Spaces, and Topology *) (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) (* Interface *) (* ------------------------------------------------------------------ *) let euclid_def = local_definition "euclid";; mk_local_interface "euclid";; overload_interface ("+", `euclid'euclid_plus:(num->real)->(num->real)->(num->real)`);; make_overloadable "*#" `:A -> B -> B`;; let euclid_scale = euclid_def `euclid_scale t f = \ (i:num). (t*. (f i))`;; overload_interface ("*#",`euclid'euclid_scale`);; parse_as_infix("*#",(20,"right"));; let euclid_neg = euclid_def `euclid_neg f = \ (i:num). (--. (f i))`;; (* This is highly ambiguous: -- f x can be read as (-- f) x or as -- (f x). *) overload_interface ("--",`euclid'euclid_neg`);; overload_interface ("-", `euclid'euclid_minus:(num->real)->(num->real)->(num->real)`);; (* ------------------------------------------------------------------ *) (* Euclidean Space *) (* ------------------------------------------------------------------ *) let euclid_plus = euclid_def `euclid_plus f g = \ (i:num). (f i) +. (g i)`;; let euclid = euclid_def `euclid n v <=> !m. (n <=| m) ==> (v m = &.0)`;; let euclidean = euclid_def `euclidean v <=> ?n. euclid n v`;; let euclid_minus = euclid_def `euclid_minus f g = \(i:num). (f i) -. (g i)`;; let euclid0 = euclid_def `euclid0 = \(i:num). &.0`;; let coord = euclid_def `coord i (f:num->real) = f i`;; let dot = euclid_def `dot f g = let (n = (min_num (\m. (euclid m f) /\ (euclid m g)))) in sum (0,n) (\i. (f i)*(g i))`;; let norm = euclid_def `norm f = sqrt(dot f f)`;; let d_euclid = euclid_def `d_euclid f g = norm (f - g)`;; (* ------------------------------------------------------------------ *) (* Euclidean and Convex geometry *) (* ------------------------------------------------------------------ *) let sum_vector_EXISTS = prove_by_refinement( `?sum_vector. (!f n. sum_vector(n,0) f = (\n. &.0)) /\ (!f m n. sum_vector(n,SUC m) f = sum_vector(n,m) f + f(n + m))`, (* {{{ proof *) [ (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) `(!f n. sm n 0 f = (\n. &0)) /\ (!f m n. sm n (SUC m) f = sm n m f + f(n + m))`; EXISTS_TAC `\(n,m) f. (sm:num->num->(num->(num->real))->(num->real)) n m f`; CONV_TAC(DEPTH_CONV GEN_BETA_CONV); ASM_REWRITE_TAC[]; ]);; (* }}} *) let sum_vector = new_specification ["sum_vector"] sum_vector_EXISTS;; let mk_segment = euclid_def `mk_segment x y = { u | ?a. (&.0 <=. a) /\ (a <=. &.1) /\ (u = a *# x + (&.1 - a) *# y) }`;; let mk_open_segment = euclid_def `mk_open_segment x y = { u | ?a. (&.0 <. a) /\ (a <. &.1) /\ (u = a *# x + (&.1 - a) *# y) }`;; let convex = euclid_def `convex S <=> !x y. (S x) /\ (S y) ==> (mk_segment x y SUBSET S)`;; let convex_hull = euclid_def `convex_hull S = { u | ?f alpha m. (!n. (n< m) ==> (S (f n))) /\ (sum(0,m) alpha = &.1) /\ (!n. (n< m) ==> (&.0 <=. (alpha n))) /\ (u = sum_vector(0,m) (\n. (alpha n) *# (f n)))}`;; let affine_hull = euclid_def `affine_hull S = { u | ?f alpha m. (!n. (n< m) ==> (S (f n))) /\ (sum(0,m) alpha = &.1) /\ (u = sum_vector(0,m) (\n. (alpha n) *# (f n)))}`;; let mk_line = euclid_def `mk_line x y = {z| ?t. (z = (t *# x) + ((&.1 - t) *# y)) }`;; let affine = euclid_def `affine S <=> !x y. (S x ) /\ (S y) ==> (mk_line x y SUBSET S)`;; let affine_dim = euclid_def `affine_dim n S <=> (?T. (T HAS_SIZE (SUC n)) /\ (affine_hull T = affine_hull S)) /\ (!T m. (T HAS_SIZE (SUC m)) /\ (m < n) ==> ~(affine_hull T = affine_hull S))`;; let collinear = euclid_def `collinear S <=> (?n. affine_dim n S /\ (n < 2))`;; let coplanar = euclid_def `coplanar S <=> (?n. affine_dim n S /\ (n < 3))`;; let line = euclid_def `line L <=> (affine L) /\ (affine_dim 1 L)`;; let plane = euclid_def `plane P <=> (affine P) /\ (affine_dim 2 P)`;; let space = euclid_def `space R <=> (affine R) /\ (affine_dim 3 R)`;; (* General constructor of conical objects, including rays, cones, half-planes, etc. L is the edge. C is the set of generators in the positive direction. If L is a line, and C = {c}, we get the half-plane bounded by L and containing c. If L is a point, and C is general, we get the cone at L generated by C. If L and C are both singletons, we get the ray ending at L. *) let mk_open_half_set = euclid_def `mk_open_half_set L S = { u | ?t v c. (L v) /\ (S c) /\ (&.0 < t) /\ (u = (t *# (c - v) + (&.1 - t) *# v)) }`;; let mk_half_set = euclid_def `mk_half_set L S = { u | ?t v c. (L v) /\ (S c) /\ (&.0 <=. t) /\ (u = (t *# (c - v) + (&.1 - t) *# v)) }`;; let mk_angle = euclid_def `mk_angle x y z = (mk_half_set {x} {y}) UNION (mk_half_set {x} {z})`;; let mk_signed_angle = euclid_def `mk_signed_angle x y z = (mk_half_set {x} {y} , mk_half_set {x} {z})`;; let mk_convex_cone = euclid_def `mk_convex_cone v (S:(num->real)->bool) = mk_half_set {v} (convex_hull S)`;; (* we always normalize the radius of balls in a packing to 1 *) let packing = euclid_def(`packing (S:(num->real)->bool) <=> !x y. ( ((S x) /\ (S y) /\ ((d_euclid x y) < (&.2))) ==> (x = y))`);; let saturated_packing = euclid_def(`saturated_packing S <=> (( packing S) /\ (!z. (affine_hull S z) ==> (?x. ((S x) /\ ((d_euclid x z) < (&.2))))))`);; (* 3 dimensions specific: *) let cross_product3 = euclid_def(`cross_product3 v1 v2 = let (x1 = v1 0) and (x2 = v1 1) and (x3 = v1 2) in let (y1 = v2 0) and (y2 = v2 1) and (y3 = v2 2) in (\k. (if (k=0) then (x2*y3-x3*y2) else if (k=1) then (x3*y1-x1*y3) else if (k=2) then (x1*y2-x2*y1) else (&0)))`);; let triple_product = euclid_def(`triple_product v1 v2 v3 = dot v1 (cross_product3 v2 v3)`);; (* the bounding edge *) let mk_triangle = euclid_def `mk_triangle v1 v2 v3 = (mk_segment v1 v2) UNION (mk_segment v2 v3) UNION (mk_segment v3 v1)`;; (* the interior *) let mk_interior_triangle = euclid_def `mk_interior_triangle v1 v2 v3 = mk_open_half_set (mk_line v1 v2) {v3} INTER (mk_open_half_set (mk_line v2 v3) {v1}) INTER (mk_open_half_set (mk_line v3 v1) {v2})`;; let mk_triangular_region = euclid_def `mk_triangular_region v1 v2 v3 = (mk_triangle v1 v2 v3) UNION (mk_interior_triangle v1 v2 v3)`;; (* ------------------------------------------------------------------ *) (* Statements of Theorems in Euclidean Geometry (no proofs *) (* ------------------------------------------------------------------ *) let half_set_convex = `!L S. convex (mk_half_set L S)`;; let open_half_set_convex = `!L S . convex (mk_open_half_set L S )`;; let affine_dim0 = `!S. (affine_dim 0 S) = (SING S)`;; let hull_convex = `!S. (convex (convex_hull S))`;; let hull_minimal = `!S T. (convex T) /\ (S SUBSET T) ==> (convex_hull S) SUBSET T`;; let affine_hull_affine = `!S. (affine (affine_hull S))`;; let affine_hull_minimal = `!S T. (affine T) /\ (S SUBSET T) ==> (affine_hull S) SUBSET T`;; let mk_line_dim = `!x y. ~(x = y) ==> affine_dim 1 (mk_line x y)`;; let affine_convex_hull = `!S. (affine_hull S) = (affine_hull (convex_hull S))`;; let convex_hull_hull = `!S. (convex_hull S) = (convex_hull (convex_hull S))`;; let euclid_affine_dim = `!n. affine_dim n (euclid n)`;; let affine_dim_subset = `!m n T S. (affine_dim m T) /\ (affine_dim n S) /\ (T SUBSET S) ==> (m <= n)`;; (* A few of the Birkhoff postulates of Geometry (incomplete) *) let line_postulate = `!x y. ~(x = y) ==> (?!L. (L x) /\ (L y) /\ (line L))`;; let ruler_postulate = `!L. (line L) ==> (?f. (BIJ f L UNIV) /\ (!x y. (L x /\ L y ==> (d_euclid x y = abs(f x -. f y)))))`;; let affine_postulate = `!n. (affine_dim n P) ==> (?S. (S SUBSET P) /\ (S HAS_SIZE n) /\ (affine_dim n S))`;; let line_plane = `!P x y. (plane P) /\ (P x) /\ (P y) ==> (mk_line x y SUBSET P)`;; let plane_of_pt = `!S. (S HAS_SIZE 3) ==> (?P. (plane P) /\ (S SUBSET P))`;; let plane_of_pt_unique = `!S. (S HAS_SIZE 3) ==> (collinear S) \/ (?! P. (plane P) /\ (S SUBSET P))`;; let plane_inter = `!P Q. (plane P) /\ (plane Q) ==> (P INTER Q = EMPTY) \/ (line (P INTER Q)) \/ (P = Q)`;; (* each line separates a plane into two half-planes *) let plane_separation = `!P L. (plane P) /\ (line L) /\ (L SUBSET P) ==> (?A B. (A INTER B = EMPTY) /\ (A INTER L = EMPTY) /\ (B INTER L = EMPTY) /\ (L UNION A UNION B = P) /\ (!c u. (P c) /\ (u = mk_open_half_set L {c}) ==> (u = A) \/ (u = B) \/ (u = L)) /\ (!a b. (A a) /\ (B b) ==> ~(segment a b INTER L = EMPTY)))`;; let space_separation = `!R P. (space R) /\ (plane P) /\ (P SUBSET R) ==> (?A B. (A INTER B = EMRTY) /\ (A INTER P = EMRTY) /\ (B INTER P = EMRTY) /\ (P UNION A UNION B = R) /\ (!c u. (R c) /\ (u = mk_open_half_set P {c}) ==> (u = A) \/ (u = B) \/ (u = P)) /\ (!a b. (A a) /\ (B b) ==> ~(segment a b INTER L = EMPTY)))`;; (* ------------------------------------------------------------------ *) (* Metric Space *) (* ------------------------------------------------------------------ *) let metric_space = euclid_def `metric_space (X:A->bool,d:A->A->real) <=> !x y z. (X x) /\ (X y) /\ (X z) ==> (((&.0) <=. (d x y)) /\ ((&.0 = d x y) = (x = y)) /\ (d x y = d y x) /\ (d x z <=. d x y + d y z))`;; (* ------------------------------------------------------------------ *) (* Measure *) (* ------------------------------------------------------------------ *) let set_translate = euclid_def `set_translate v X = { z | ?x. (X x) /\ (z = v + x) }`;; let set_scale = euclid_def `set_scale r X = { z | ?x. (X x) /\ (z = r *# x) }`;; let mk_rectangle = euclid_def `mk_rectangle a b = { z | !(i:num). (a i <=. z i) /\ (z i <. b i) }`;; let one_vec = euclid_def `one_vec n = (\i. if (i<| n) then (&.1) else (&.0))`;; let mk_cube = euclid_def `mk_cube n k v = let (r = twopow (--: (&: k))) in let (vv = (\i. (real_of_int (v i)))) in mk_rectangle (r *# vv) (r *# (vv + (one_vec n)))`;; let inner_cube = euclid_def `inner_cube n k A = { v | (mk_cube n k v SUBSET A) /\ (!i. (n <| i) ==> (&:0 = v i)) }`;; let outer_cube = euclid_def `outer_cube n k A = { v | ~((mk_cube n k v) INTER A = EMPTY) /\ (!i. (n <| i) ==> (&:0 = v i)) }`;; let inner_vol = euclid_def `inner_vol n k A = (&. (CARD (inner_cube n k A)))*(twopow (--: (&: (n*k))))`;; let outer_vol = euclid_def `outer_vol n k A = (&. (CARD (outer_cube n k A)))*(twopow (--: (&: (n*k))))`;; let euclid_bounded = euclid_def `euclid_bounded A = (?R. !(x:num->real) i. (A x) ==> (x i <. R))`;; let vol = euclid_def `vol n A = lim (\k. outer_vol n k A)`;; (* ------------------------------------------------------------------ *) (* COMPUTING PI *) (* ------------------------------------------------------------------ *) unambiguous_interface();; prioritize_real();; (* ------------------------------------------------------------------ *) (* general series approximations *) (* ------------------------------------------------------------------ *) let SER_APPROX1 = prove_by_refinement( `!s f g. (f sums s) /\ (summable g) ==> (!k. ((!n. (||. (f (n+k)) <=. (g (n+k)))) ==> ( (s - (sum(0,k) f)) <=. (suminf (\n. (g (n +| k)))))))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; GEN_TAC; DISCH_TAC; IMP_RES_THEN ASSUME_TAC SUM_SUMMABLE; IMP_RES_THEN (fun th -> (ASSUME_TAC (SPEC `k:num` th))) SER_OFFSET; IMP_RES_THEN ASSUME_TAC SUM_UNIQ; SUBGOAL_THEN `(\n. (f (n+ k))) sums (s - (sum(0,k) f))` ASSUME_TAC; ASM_MESON_TAC[]; SUBGOAL_THEN `summable (\n. (f (n+k))) /\ (suminf (\n. (f (n+k))) <=. (suminf (\n. (g (n+k)))))` ASSUME_TAC; MATCH_MP_TAC SER_LE2; BETA_TAC; ASM_REWRITE_TAC[]; IMP_RES_THEN ASSUME_TAC SER_OFFSET; FIRST_X_ASSUM (fun th -> ACCEPT_TAC (MATCH_MP SUM_SUMMABLE (((SPEC `k:num`) th)))); ASM_MESON_TAC[SUM_UNIQ] ]);; (* }}} *) let SER_APPROX = prove_by_refinement( `!s f g. (f sums s) /\ (!n. (||. (f n) <=. (g n))) /\ (summable g) ==> (!k. (abs (s - (sum(0,k) f)) <=. (suminf (\n. (g (n +| k))))))`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; GEN_TAC; REWRITE_TAC[REAL_ABS_BOUNDS]; CONJ_TAC; SUBGOAL_THEN `(!k. ((!n. (||. ((\p. (--. (f p))) (n+k))) <=. (g (n+k)))) ==> ((--.s) - (sum(0,k) (\p. (--. (f p)))) <=. (suminf (\n. (g (n +k))))))` ASSUME_TAC; MATCH_MP_TAC SER_APPROX1; ASM_REWRITE_TAC[]; MATCH_MP_TAC SER_NEG ; ASM_REWRITE_TAC[]; MATCH_MP_TAC (REAL_ARITH (`(--. s -. (--. u) <=. x) ==> (--. x <=. (s -. u))`)); ONCE_REWRITE_TAC[GSYM SUM_NEG]; FIRST_X_ASSUM (fun th -> (MATCH_MP_TAC th)); BETA_TAC; ASM_REWRITE_TAC[REAL_ABS_NEG]; H_VAL2 CONJ (HYP "0") (HYP "2"); IMP_RES_THEN MATCH_MP_TAC SER_APPROX1 ; GEN_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* now for pi calculation stuff *) (* ------------------------------------------------------------------ *) let local_def = local_definition "trig";; let PI_EST = prove_by_refinement( `!n. (1 <=| n) ==> (abs(&4 / &(8 * n + 1) - &2 / &(8 * n + 4) - &1 / &(8 * n + 5) - &1 / &(8 * n + 6)) <= &.622/(&.819))`, (* {{{ proof *) [ GEN_TAC THEN DISCH_ALL_TAC; REWRITE_TAC[real_div]; MATCH_MP_TAC (REWRITE_RULE[real_div] (REWRITE_RULE[REAL_RAT_REDUCE_CONV `(&.4/(&.9) +(&.2/(&.12)) + (&.1/(&.13))+ (&.1/(&.14)))`] (REAL_ARITH `(abs((&.4)*.u)<=. (&.4)/(&.9)) /\ (abs((&.2)*.v)<=. (&.2)/(&.12)) /\ (abs((&.1)*w) <=. (&.1)/(&.13)) /\ (abs((&.1)*x) <=. (&.1)/(&.14)) ==> (abs((&.4)*u -(&.2)*v - (&.1)*w - (&.1)*x) <= (&.4/(&.9) +(&.2/(&.12)) + (&.1/(&.13))+ (&.1/(&.14))))`))); IMP_RES_THEN ASSUME_TAC (ARITH_RULE `1 <=| n ==> (0 < n)`); FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[GSYM REAL_OF_NUM_LT] th)); ASSUME_TAC (prove(`(a<=.b) ==> (&.n*a <=. (&.n)*b)`,MESON_TAC[REAL_PROP_LE_LMUL;REAL_POS])); REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_INV;prove(`||.(&.n) = (&.n)`,MESON_TAC[REAL_POS;REAL_ABS_REFL])]; REPEAT CONJ_TAC THEN (POP_ASSUM (fun th -> MATCH_MP_TAC th)) THEN (MATCH_MP_TAC (prove(`((&.0 <. (&.n)) /\ (&.n <=. a)) ==> (inv(a)<=. (inv(&.n)))`,MESON_TAC[REAL_ABS_REFL;REAL_ABS_INV;REAL_LE_INV2]))) THEN REWRITE_TAC[REAL_LT;REAL_LE] THEN (H_UNDISCH_TAC (HYP"0")) THEN ARITH_TAC]);; (* }}} *) let pi_fun = local_def `pi_fun n = inv (&.16 **. n) *. (&.4 / &.(8 *| n +| 1) -. &.2 / &.(8 *| n +| 4) -. &.1 / &.(8 *| n +| 5) -. &.1 / &.(8 *| n +| 6))`;; let pi_bound_fun = local_def `pi_bound_fun n = if (n=0) then (&.8) else (((&.15)/(&.16))*(inv(&.16 **. n))) `;; let PI_EST2 = prove_by_refinement( `!k. abs(pi_fun k) <=. (pi_bound_fun k)`, (* {{{ proof *) [ GEN_TAC; REWRITE_TAC[pi_fun;pi_bound_fun]; COND_CASES_TAC; ASM_REWRITE_TAC[]; CONV_TAC (NUM_REDUCE_CONV); (CONV_TAC (REAL_RAT_REDUCE_CONV)); CONV_TAC (RAND_CONV (REWR_CONV (REAL_ARITH `a*b = b*.a`))); REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_INV;REAL_ABS_POW;prove(`||.(&.n) = (&.n)`,MESON_TAC[REAL_POS;REAL_ABS_REFL])]; MATCH_MP_TAC (prove(`!x y z. (&.0 <. z /\ (y <=. x) ==> (z*y <=. (z*x)))`,MESON_TAC[REAL_LE_LMUL_EQ])); ASSUME_TAC (REWRITE_RULE[] (REAL_RAT_REDUCE_CONV `(&.622)/(&.819) <=. (&.15)/(&.16)`)); IMP_RES_THEN ASSUME_TAC (ARITH_RULE `~(k=0) ==> (1<=| k)`); IMP_RES_THEN ASSUME_TAC (PI_EST); CONJ_TAC; SIMP_TAC[REAL_POW_LT;REAL_LT_INV;ARITH_RULE `&.0 < (&.16)`]; ASM_MESON_TAC[REAL_LE_TRANS]; ]);; (* }}} *) let GP16 = prove_by_refinement( `!k. (\n. inv (&16 pow k) * inv (&16 pow n)) sums inv (&16 pow k) * &16 / &15`, (* {{{ proof *) [ GEN_TAC; ASSUME_TAC (REWRITE_RULE[] (REAL_RAT_REDUCE_CONV `abs (&.1 / (&. 16)) <. (&.1)`)); IMP_RES_THEN (fun th -> ASSUME_TAC (CONV_RULE REAL_RAT_REDUCE_CONV th)) GP; MATCH_MP_TAC SER_CMUL; ASM_REWRITE_TAC[GSYM REAL_POW_INV;REAL_INV_1OVER]; ]);; (* }}} *) let GP16a = prove_by_refinement( `!k. (0<|k) ==> (\n. (pi_bound_fun (n+k))) sums (inv(&.16 **. k))`, (* {{{ proof *) [ GEN_TAC; DISCH_TAC; SUBGOAL_THEN `(\n. pi_bound_fun (n+k)) = (\n. ((&.15/(&.16))* (inv(&.16)**. k) *. inv(&.16 **. n)))` (fun th-> REWRITE_TAC[th]); MATCH_MP_TAC EQ_EXT; X_GEN_TAC `n:num` THEN BETA_TAC; REWRITE_TAC[pi_bound_fun]; COND_CASES_TAC; ASM_MESON_TAC[ARITH_RULE `0<| k ==> (~(n+k = 0))`]; REWRITE_TAC[GSYM REAL_MUL_ASSOC]; AP_TERM_TAC; REWRITE_TAC[REAL_INV_MUL;REAL_POW_ADD;REAL_POW_INV;REAL_MUL_AC]; SUBGOAL_THEN `(\n. (&.15/(&.16)) *. ((inv(&.16)**. k)*. inv(&.16 **. n))) sums ((&.15/(&.16)) *.(inv(&.16**. k)*. ((&.16)/(&.15))))` ASSUME_TAC; MATCH_MP_TAC SER_CMUL; REWRITE_TAC[REAL_POW_INV]; ACCEPT_TAC (SPEC `k:num` GP16); FIRST_X_ASSUM MP_TAC; REWRITE_TAC[REAL_MUL_ASSOC]; MATCH_MP_TAC (prove (`(x=y) ==> ((a sums x) ==> (a sums y))`,MESON_TAC[])); MATCH_MP_TAC (REAL_ARITH `(b*(a*c) = (b*(&.1))) ==> ((a*b)*c = b)`); AP_TERM_TAC; CONV_TAC (REAL_RAT_REDUCE_CONV); ]);; (* }}} *) let PI_SER = prove_by_refinement( `!k. (0<|k) ==> (abs(pi - (sum(0,k) pi_fun)) <=. (inv(&.16 **. (k))))`, (* {{{ proof *) [ GEN_TAC THEN DISCH_TAC; ASSUME_TAC (ONCE_REWRITE_RULE[ETA_AX] (REWRITE_RULE[GSYM pi_fun] POLYLOG_THM)); ASSUME_TAC PI_EST2; IMP_RES_THEN (ASSUME_TAC) GP16a; IMP_RES_THEN (ASSUME_TAC) SUM_SUMMABLE; IMP_RES_THEN (ASSUME_TAC) SER_OFFSET_REV; IMP_RES_THEN (ASSUME_TAC) SUM_SUMMABLE; MP_TAC (SPECL [`pi`;`pi_fun`;`pi_bound_fun` ] SER_APPROX); ASM_REWRITE_TAC[]; DISCH_THEN (fun th -> MP_TAC (SPEC `k:num` th)); SUBGOAL_THEN `suminf (\n. pi_bound_fun (n + k)) = inv (&.16 **. k)` (fun th -> (MESON_TAC[th])); ASM_MESON_TAC[SUM_UNIQ]; ]);; (* }}} *) (* replace 3 by SUC (SUC (SUC 0)) *) let SUC_EXPAND_CONV tm = let count = dest_numeral tm in let rec add_suc i r = if (i <=/ (Int 0)) then r else add_suc (i -/ (Int 1)) (mk_comb (`SUC`,r)) in let tm' = add_suc count `0` in REWRITE_RULE[] (ARITH_REWRITE_CONV[] (mk_eq (tm,tm')));; let inv_twopow = prove( `!n. inv (&.16 **. n) = (twopow (--: (&:(4*n)))) `, REWRITE_TAC[TWOPOW_NEG;GSYM (NUM_RED_CONV `2 EXP 4`); REAL_OF_NUM_POW;EXP_MULT]);; let PI_SERn n = let SUM_EXPAND_CONV = (ARITH_REWRITE_CONV[]) THENC (TOP_DEPTH_CONV SUC_EXPAND_CONV) THENC (REWRITE_CONV[sum]) THENC (ARITH_REWRITE_CONV[REAL_ADD_LID;GSYM REAL_ADD_ASSOC]) in let sum_thm = SUM_EXPAND_CONV (vsubst [n,`i:num`] `sum(0,i) f`) in let gt_thm = ARITH_RULE (vsubst [n,`i:num`] `0 <| i`) in ((* CONV_RULE REAL_RAT_REDUCE_CONV *)(CONV_RULE (ARITH_REWRITE_CONV[]) (BETA_RULE (REWRITE_RULE[sum_thm;pi_fun;inv_twopow] (MATCH_MP PI_SER gt_thm)))));; (* abs(pi - u ) < e *) let recompute_pi bprec = let n = (bprec /4) in let pi_ser = PI_SERn (mk_numeral (Int n)) in let _ = remove_real_constant `pi` in (add_real_constant pi_ser; INTERVAL_OF_TERM bprec `pi`);; (* ------------------------------------------------------------------ *) (* restore defaults *) (* ------------------------------------------------------------------ *) reduce_local_interface("trig");; pop_priority();; hol-light/Jordan/num_ext_gcd.ml000066400000000000000000000172251303454263000170170ustar00rootroot00000000000000(* Author: Thomas C. Hales, 2003 GCD_CONV takes two HOL-light terms (NUMERALs) a and b and produces a theorem of the form |- GCD a b = g (In particular, the arguments cannot be negative.) *) prioritize_num();; let DIVIDE = new_definition(`DIVIDE a b = ?m. (b = m*a )`);; parse_as_infix("||",(16,"right"));; override_interface("||",`DIVIDE:num->num->bool`);; (* Now prove the lemmas *) let DIV_TAC t = EVERY[ REP_GEN_TAC; REWRITE_TAC[DIVIDE]; DISCH_ALL_TAC; REPEAT (FIRST_X_ASSUM CHOOSE_TAC); TRY (EXISTS_TAC t)];; let DIVIDE_DIVIDE = prove_by_refinement( `!a b c. (((a || b) /\ (b || c)) ==> (a || c))`, [ DIV_TAC `m'*m`; ASM_REWRITE_TAC[MULT_ASSOC] ]);; let DIVIDE_EQ = prove_by_refinement( `! a b. (((a || b) /\ (b || a)) ==> (a = b))`, [ DIV_TAC `1`; FIRST_X_ASSUM (fun th -> (POP_ASSUM MP_TAC) THEN REWRITE_TAC[th]); ASM_CASES_TAC `b=0`; ASM_REWRITE_TAC[]; ARITH_TAC; REWRITE_TAC[ARITH_RULE `(b = m*m'*b) = (1*b = m*m'*b)`]; ASM_REWRITE_TAC[MULT_ASSOC;EQ_MULT_RCANCEL]; DISCH_THEN (fun th -> MP_TAC (REWRITE_RULE[MULT_EQ_1] (GSYM th)) ); DISCH_THEN (fun th -> REWRITE_TAC[CONJUNCT2 th] THEN ARITH_TAC); ]);; let DIVIDE_SUM = prove_by_refinement( `!a b h. (((h || a) /\ (h||b)) ==> (h || (a+b)))`, [ DIV_TAC `m+m'`; ASM_REWRITE_TAC[ARITH;RIGHT_ADD_DISTRIB]; ]);; let DIVIDE_SUMMAND = prove_by_refinement( `!a b h. (((h|| b) /\ (h || (a+b))) ==> (h|| a))`, [ DIV_TAC `m'-m`; REWRITE_TAC[RIGHT_SUB_DISTRIB]; REPEAT (FIRST_X_ASSUM (fun th -> REWRITE_TAC[GSYM th])); ARITH_TAC; ]);; let DIVIDE_PROD = prove_by_refinement( `!a b h. (((h|| a) ==> (h || (b*a))))`, [ DIV_TAC `b*m`; ASM_REWRITE_TAC[MULT_ASSOC]; ]);; let DIVIDE_PROD2 = prove_by_refinement( `!a b h. (((h|| a) ==> (h || (a*b))))`, [ DIV_TAC `b*m`; ASM_REWRITE_TAC[MULT_AC] ]);; let GCD = new_definition(`GCD a b = @g. ((g || a) /\ (g || b) /\ (!h. (((h || a) /\ (h || b)) ==> (h || g))))`);; let gcd_certificate = prove(`!a b g. ((? r s r' s' a' b'. ((a = a'*g) /\ (b = b'*g) /\ (g +r'*a+s'*b= r*a + s*b))) ==> (GCD a b = g))`, let tac1 = ( (REPEAT GEN_TAC) THEN (DISCH_TAC) THEN (REPEAT (POP_ASSUM CHOOSE_TAC)) THEN (REWRITE_TAC[GCD]) THEN (MATCH_MP_TAC SELECT_UNIQUE) THEN BETA_TAC THEN GEN_TAC THEN EQ_TAC) and ygbranch = ( DISCH_TAC THEN (MATCH_MP_TAC DIVIDE_EQ) THEN CONJ_TAC) and ydivg_branch = ( (SUBGOAL_TAC (` (y || (r*a + s*b))/\ (y || (r'*a +s'*b))`)) THENL [((ASM MESON_TAC)[DIVIDE_SUM;DIVIDE_PROD]); ((ASM MESON_TAC)[DIVIDE_SUMMAND])] ) and gdivy_branch = ( (UNDISCH_TAC (`(y||a) /\ (y ||b) /\ (!h. (((h||a)/\(h||b))==> (h||y)))`)) THEN (TAUT_TAC (` (A ==> B) ==> ((C /\ D/\ A)==> B)`)) THEN (DISCH_TAC) THEN (POP_ASSUM MATCH_MP_TAC) THEN (REWRITE_TAC[DIVIDE]) THEN (CONJ_TAC) THEN ((ASM MESON_TAC)[]) ) and yghyp_branch = ( (DISCH_TAC) THEN (let x t = REWRITE_TAC[t] in (POP_ASSUM x)) THEN (CONJ_TAC) THENL [((ASM MESON_TAC)[DIVIDE]);ALL_TAC] THEN (CONJ_TAC) THENL [((ASM MESON_TAC)[DIVIDE]);ALL_TAC] THEN GEN_TAC THEN DISCH_TAC THEN (SUBGOAL_TAC (` (h || (r*a + s*b))/\ (h || (r'*a+s'*b))`)) THENL [((ASM MESON_TAC)[DIVIDE_SUM;DIVIDE_PROD]); ((ASM MESON_TAC)[DIVIDE_SUMMAND])] ) in tac1 THENL [ygbranch THENL [ydivg_branch;gdivy_branch];yghyp_branch]);; (* Now compute gcd with CAML num calculations, then check the answer in HOL-light *) let gcd_num x1 x2 = let rec gcd_data (a1,b1,x1,a2,b2,x2) = if (x1 < (Int 0)) then gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2) else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num b2,minus_num x2) else if (x1 = (Int 0)) then (a2,b2,x2) else if (x1>x2) then gcd_data (a2,b2,x2,a1,b1,x1) else ( let r = (quo_num x2 x1) in gcd_data (a1,b1,x1,a2 -/ r*/ a1,b2 -/ r*/ b1, x2 -/ r*/ x1) ) in gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);; let gcd_num x1 x2 = let rec gcd_data (a1,b1,x1,a2,b2,x2) = if (x1 < (Int 0)) then gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2) else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num b2,minus_num x2) else if (x1 = (Int 0)) then (a2,b2,x2) else if (x1>x2) then gcd_data (a2,b2,x2,a1,b1,x1) else ( let r = (quo_num x2 x1) in gcd_data (a1,b1,x1,a2 -/ r*/ a1,b2 -/ r*/ b1, x2 -/ r*/ x1) ) in gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);; (* g = gcd, (a',b') = (a,b)/g, g +r1'*a+s1'*b = r1*a+s1*b *) let gcd_numdata a b = let a = abs_num a in let b = abs_num b in let Z = Int 0 in let (r,s,g) = gcd_num a b in let a' = if (g=Z) then Z else round_num(a//g) in let b' = if (g=Z) then Z else round_num(b//g) in let _ = if not(a=a'*/g) then failwith "GCD_CONV a" else 0 in let _ = if not(b=b'*/g) then failwith "GCD_CONV b" else 0 in let _ = if not(g=r*/a+/s*/b) then failwith "GCD_CONV g" else 0 in let (r1,r1') = if (r >/ Z) then (r,Z) else (Z,minus_num r) in let (s1,s1') = if (s >/ Z) then (s,Z) else (Z,minus_num s) in (g,a,b,a',b',r1',s1',r1,s1);; (* Here is the conversion. Example: GCD_CONV (`66`) (`144`) *) let GCD_CONV at bt = let a = dest_numeral at in let b = dest_numeral bt in let (g,a,b,a',b',r1',s1',r1,s1) = gcd_numdata a b in prove(parse_term("GCD "^(string_of_num a)^" "^(string_of_num b)^" = "^ (string_of_num g)), (MATCH_MP_TAC gcd_certificate) THEN (EXISTS_TAC (mk_numeral r1)) THEN (EXISTS_TAC (mk_numeral s1)) THEN (EXISTS_TAC (mk_numeral r1')) THEN (EXISTS_TAC (mk_numeral s1')) THEN (EXISTS_TAC (mk_numeral a')) THEN (EXISTS_TAC (mk_numeral b')) THEN (ARITH_TAC));; (* Example: hol_gcd 66 144 This version can overflow on CAML integers before it reaches hol-light. Example: hol_gcd 1000000000000000000 10000000000000000000000 - : thm = |- GCD 660865024 843055104 = 262144 *) let hol_gcd a b = GCD_CONV (mk_small_numeral a) (mk_small_numeral b);; remove_interface ("||");; pop_priority();; (* test code *) exception Test_suite_num_ext_gcd of string;; (* For the tests we use integers a and b. These can overflow if a and b are too large, so that we should confine ourselves to tests that are not too large. *) let test_num_ext_gcd (a, b) = let a1 = string_of_int (abs a) in let b1 = string_of_int (abs b) in let c = gcd a b in let c1 = string_of_int (abs c) in let th = GCD_CONV (mk_small_numeral a) (mk_small_numeral b) in if (not (hyp th = ([]:term list))) then raise (failwith ("num_ext_gcd test suite failure "^a1^" "^b1)) else if (not (concl th = (parse_term ("GCD "^a1^" "^b1^"="^c1)))) then raise (failwith ("num_ext_gcd test suite failure "^a1^" "^b1)) else ();; let test_suite_num_ext_gcd = let _ = map test_num_ext_gcd [(0,0);(0,1);(1,0);(-0,-0); (2,3);(4,6); (0,2);(2,0); (10,100);(100,10);(17,100);(100,17)] in print_string "num_ext_gcd loaded\n";; let divide = DIVIDE and gcd = GCD and gcd_conv = GCD_CONV;; hol-light/Jordan/num_ext_nabs.ml000066400000000000000000000075321303454263000172050ustar00rootroot00000000000000unambiguous_interface();; let INT_NUM = prove(`!u. (integer (real_of_num u))`, (REWRITE_TAC[is_int]) THEN GEN_TAC THEN (EXISTS_TAC (`u:num`)) THEN (MESON_TAC[]));; let INT_NUM_REAL = prove(`!u. (real_of_int (int_of_num u) = real_of_num u)`, (REWRITE_TAC[int_of_num]) THEN GEN_TAC THEN (MESON_TAC[INT_NUM;int_rep]));; let INT_IS_INT = prove(`!(a:int). (integer (real_of_int a))`, REWRITE_TAC[int_rep;int_abstr]);; let INT_OF_NUM_DEST = prove(`!a n. ((real_of_int a = (real_of_num n)) = (a = int_of_num n))`, (REWRITE_TAC[int_eq]) THEN (REPEAT GEN_TAC) THEN (REWRITE_TAC[int_of_num]) THEN (ASSUME_TAC (SPEC (`n:num`) INT_NUM)) THEN (UNDISCH_EL_TAC 0) THEN (SIMP_TAC[int_rep]));; let INT_REP = prove(`!a. ?n m. (a = (int_of_num n) - (int_of_num m))`, GEN_TAC THEN (let tt =(REWRITE_RULE[is_int] (SPEC (`a:int`) INT_IS_INT)) in (CHOOSE_TAC tt)) THEN (POP_ASSUM DISJ_CASES_TAC) THENL [ (EXISTS_TAC (`n:num`)) THEN (EXISTS_TAC (`0`)) THEN (ASM_REWRITE_TAC[INT_SUB_RZERO;GSYM INT_OF_NUM_DEST]); (EXISTS_TAC (`0`)) THEN (EXISTS_TAC (`n:num`)) THEN (REWRITE_TAC[INT_SUB_LZERO]) THEN (UNDISCH_EL_TAC 0) THEN (REWRITE_TAC[GSYM REAL_NEG_EQ;GSYM INT_NEG_EQ;GSYM int_neg_th;GSYM INT_OF_NUM_DEST])]);; let INT_REP2 = prove( `!a. ?n. ((a = (&: n)) \/ (a = (--: (&: n))))`, (GEN_TAC) THEN ((let tt =(REWRITE_RULE[is_int] (SPEC (`a:int`) INT_IS_INT)) in (CHOOSE_TAC tt))) THEN ((POP_ASSUM DISJ_CASES_TAC)) THENL [ ((EXISTS_TAC (`n:num`))) THEN ((ASM_REWRITE_TAC[GSYM INT_OF_NUM_DEST])); ((EXISTS_TAC (`n:num`))) (* THEN ((RULE_EL 0 (REWRITE_RULE[GSYM REAL_NEG_EQ;GSYM int_neg_th]))) *) THEN (H_REWRITE_RULE[THM (GSYM REAL_NEG_EQ);THM (GSYM int_neg_th)] (HYP_INT 0)) THEN ((ASM_REWRITE_TAC[GSYM INT_NEG_EQ;GSYM INT_OF_NUM_DEST]))]);; (* ------------------------------------------------------------------ *) (* nabs : int -> num gives the natural number abs. value of an int *) (* ------------------------------------------------------------------ *) let nabs = new_definition(`nabs n = @u. ((n = int_of_num u) \/ (n = int_neg (int_of_num u)))`);; let NABS_POS = prove(`!u. (nabs (int_of_num u)) = u`, GEN_TAC THEN (REWRITE_TAC [nabs]) THEN (MATCH_MP_TAC SELECT_UNIQUE) THEN (GEN_TAC THEN BETA_TAC) THEN (EQ_TAC) THENL [(TAUT_TAC (` ((A==>C)/\ (B==>C)) ==> (A\/B ==>C) `)); MESON_TAC[]] THEN CONJ_TAC THENL (let branch2 = (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL]) THEN (REWRITE_TAC[prove (`! u y.(((real_of_num u) = --(real_of_num y))= ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)]) THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ]) THEN (MESON_TAC[ADD_EQ_0]) in [(REWRITE_TAC[int_eq;INT_NUM_REAL]);branch2]) THEN (REWRITE_TAC[INT_NUM_REAL]) THEN (MESON_TAC[REAL_OF_NUM_EQ]));; let NABS_NEG = prove(`!n. (nabs (-- (int_of_num n))) = n`, GEN_TAC THEN (REWRITE_TAC [nabs]) THEN (MATCH_MP_TAC SELECT_UNIQUE) THEN (GEN_TAC THEN BETA_TAC) THEN (EQ_TAC) THENL [(TAUT_TAC (` ((A==>C)/\ (B==>C)) ==> (A\/B ==>C) `)); MESON_TAC[]] THEN CONJ_TAC THENL (let branch1 = (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL]) THEN (REWRITE_TAC[prove (`! u y.((--(real_of_num u) = (real_of_num y))= ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)]) THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ]) THEN (MESON_TAC[ADD_EQ_0]) in [branch1;(REWRITE_TAC[int_eq;INT_NUM_REAL])]) THEN (REWRITE_TAC[INT_NUM_REAL;int_neg_th;REAL_NEG_EQ;REAL_NEGNEG]) THEN (MESON_TAC[REAL_OF_NUM_EQ]));; hol-light/Jordan/parse_ext_override_interface.ml000066400000000000000000000201371303454263000224300ustar00rootroot00000000000000(* Author: Thomas C. Hales As a new user of HOL-light, I have had a difficult time distinguishing between the different uses of overloaded operators such as (+), ( * ), (abs) (&), and so forth. Their interpretation is context dependent, according to which of prioritize_num, prioritize_int, and prioritize_real was most recently called. This file removes all ambiguities in notation. Following the usage of CAML, we append a dot to operations on real numbers so that addition is (+.), etc. In the same way, we remove ambiguities between natural numbers and integers by appending a character. We have chosen to use the character `|` for natural number operations and the character `:` for integer operations. The character `&` continues to denote the embedding of natural numbers into the integers or reals. HOL-light parsing does not permit an operator mixing alphanumeric characters with symbols. Thus, we were not able to use (abs.) and (abs:) for the absolute value. Instead we adapt the usual notation |x| for absolute value and write it in prefix notation ||: and ||. for the integer and real absolute value functions respectively. In deference to HOL-light notation, we use ** for the exponential function. There are three versions: ( **| ), ( **: ), and ( **. ). *) (* natural number operations *) let unambiguous_interface() = parse_as_infix("+|",(16,"right")); parse_as_infix("-|",(18,"left")); parse_as_infix("*|",(20,"right")); parse_as_infix("**|",(24,"left")); (* EXP *) parse_as_infix("/|",(22,"right")); (* DIV *) parse_as_infix("%|",(22,"left")); (* MOD *) parse_as_infix("<|",(12,"right")); parse_as_infix("<=|",(12,"right")); parse_as_infix(">|",(12,"right")); parse_as_infix(">=|",(12,"right")); override_interface("+|",`(+):num->(num->num)`); override_interface("-|",`(-):num->(num->num)`); override_interface("*|",`( * ):num->(num->num)`); override_interface("**|",`(EXP):num->(num->num)`); override_interface("/|",`(DIV):num->(num->num)`); override_interface("%|",`(MOD):num->(num->num)`); override_interface("<|",`(<):num->(num->bool)`); override_interface("<=|",`(<=):num->(num->bool)`); override_interface(">|",`(>):num->(num->bool)`); override_interface(">=|",`(>=):num->(num->bool)`); (* integer operations *) parse_as_infix("+:",(16,"right")); parse_as_infix("-:",(18,"left")); parse_as_infix("*:",(20,"right")); parse_as_infix("**:",(24,"left")); parse_as_infix("<:",(12,"right")); parse_as_infix("<=:",(12,"right")); parse_as_infix(">:",(12,"right")); parse_as_infix(">=:",(12,"right")); override_interface("+:",`int_add:int->int->int`); override_interface("-:",`int_sub:int->int->int`); override_interface("*:",`int_mul:int->int->int`); override_interface("**:",`int_pow:int->num->int`); (* boolean *) override_interface("<:",`int_lt:int->int->bool`); override_interface("<=:",`int_le:int->int->bool`); override_interface(">:",`int_gt:int->int->bool`); override_interface(">=:",`int_ge:int->int->bool`); (* unary *) override_interface("--:",`int_neg:int->int`); override_interface("&:",`int_of_num:num->int`); override_interface("||:",`int_abs:int->int`); (* real number operations *) parse_as_infix("+.",(16,"right")); parse_as_infix("-.",(18,"left")); parse_as_infix("*.",(20,"right")); parse_as_infix("**.",(24,"left")); parse_as_infix("<.",(12,"right")); parse_as_infix("<=.",(12,"right")); parse_as_infix(">.",(12,"right")); parse_as_infix(">=.",(12,"right")); override_interface("+.",`real_add:real->real->real`); override_interface("-.",`real_sub:real->real->real`); override_interface("*.",`real_mul:real->real->real`); override_interface("**.",`real_pow:real->num->real`); (* boolean *) override_interface("<.",`real_lt:real->real->bool`); override_interface("<=.",`real_le:real->real->bool`); override_interface(">.",`real_gt:real->real->bool`); override_interface(">=.",`real_ge:real->real->bool`); (* unary *) override_interface("--.",`real_neg:real->real`); override_interface("&.",`real_of_num:num->real`); override_interface("||.",`real_abs:real->real`);; let ambiguous_interface() = reduce_interface("+|",`(+):num->(num->num)`); reduce_interface("-|",`(-):num->(num->num)`); reduce_interface("*|",`( * ):num->(num->num)`); reduce_interface("**|",`(EXP):num->(num->num)`); reduce_interface("/|",`(DIV):num->(num->num)`); reduce_interface("%|",`(MOD):num->(num->num)`); reduce_interface("<|",`(<):num->(num->bool)`); reduce_interface("<=|",`(<=):num->(num->bool)`); reduce_interface(">|",`(>):num->(num->bool)`); reduce_interface(">=|",`(>=):num->(num->bool)`); (* integer operations *) reduce_interface("+:",`int_add:int->int->int`); reduce_interface("-:",`int_sub:int->int->int`); reduce_interface("*:",`int_mul:int->int->int`); reduce_interface("**:",`int_pow:int->num->int`); (* boolean *) reduce_interface("<:",`int_lt:int->int->bool`); reduce_interface("<=:",`int_le:int->int->bool`); reduce_interface(">:",`int_gt:int->int->bool`); reduce_interface(">=:",`int_ge:int->int->bool`); (* unary *) reduce_interface("--:",`int_neg:int->int`); reduce_interface("&:",`int_of_num:num->int`); reduce_interface("||:",`int_abs:int->int`); (* real *) reduce_interface("+.",`real_add:real->real->real`); reduce_interface("-.",`real_sub:real->real->real`); reduce_interface("*.",`real_mul:real->real->real`); reduce_interface("**.",`real_pow:real->num->real`); (* boolean *) reduce_interface("<.",`real_lt:real->real->bool`); reduce_interface("<=.",`real_le:real->real->bool`); reduce_interface(">.",`real_gt:real->real->bool`); reduce_interface(">=.",`real_ge:real->real->bool`); (* unary *) reduce_interface("--.",`real_neg:real->real`); reduce_interface("&.",`real_of_num:num->real`); reduce_interface("||.",`real_abs:real->real`);; (* add to Harrison's priorities the functions pop_priority and get_priority *) let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = let v = ref ([]:string list) in let prioritize_int() = v:= "int"::!v; overload_interface ("+",`int_add:int->int->int`); overload_interface ("-",`int_sub:int->int->int`); overload_interface ("*",`int_mul:int->int->int`); overload_interface ("<",`int_lt:int->int->bool`); overload_interface ("<=",`int_le:int->int->bool`); overload_interface (">",`int_gt:int->int->bool`); overload_interface (">=",`int_ge:int->int->bool`); overload_interface ("--",`int_neg:int->int`); overload_interface ("pow",`int_pow:int->num->int`); overload_interface ("abs",`int_abs:int->int`); override_interface ("&",`int_of_num:num->int`) and prioritize_num() = v:= "num"::!v; overload_interface ("+",`(+):num->num->num`); overload_interface ("-",`(-):num->num->num`); overload_interface ("*",`(*):num->num->num`); overload_interface ("<",`(<):num->num->bool`); overload_interface ("<=",`(<=):num->num->bool`); overload_interface (">",`(>):num->num->bool`); overload_interface (">=",`(>=):num->num->bool`) and prioritize_real() = v:= "real"::!v; overload_interface ("+",`real_add:real->real->real`); overload_interface ("-",`real_sub:real->real->real`); overload_interface ("*",`real_mul:real->real->real`); overload_interface ("/",`real_div:real->real->real`); overload_interface ("<",`real_lt:real->real->bool`); overload_interface ("<=",`real_le:real->real->bool`); overload_interface (">",`real_gt:real->real->bool`); overload_interface (">=",`real_ge:real->real->bool`); overload_interface ("--",`real_neg:real->real`); overload_interface ("pow",`real_pow:real->num->real`); overload_interface ("inv",`real_inv:real->real`); overload_interface ("abs",`real_abs:real->real`); override_interface ("&",`real_of_num:num->real`) and pop_priority() = if (length !v <= 1) then (print_string "priority unchanged\n") else let (a::b::c) = !v in v:= (b::c); print_string ("priority is now "^b^"\n"); match a with "num" -> prioritize_num() | "int" -> prioritize_int() | "real"-> prioritize_real()| _ -> () and get_priority() = if (!v=[]) then "unknown" else let (a::b) = !v in a in prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority;; hol-light/Jordan/real_ext.ml000066400000000000000000000241371303454263000163260ustar00rootroot00000000000000 (* ------------------------------------------------------------------ *) (* Theorems that construct and propagate equality and inequality *) (* ------------------------------------------------------------------ *) (* ------------------------------------------------------------------ *) (* Propagation of =EQUAL= *) (* ------------------------------------------------------------------ *) unambiguous_interface();; prioritize_num();; let REAL_MUL_LTIMES = prove (`!x a b. (x*.a = x*.b) ==> (~(x=(&.0))) ==> (a =b)`, MESON_TAC[REAL_EQ_MUL_LCANCEL]);; let REAL_MUL_RTIMES = prove (`!x a b. (a*.x = b*.x) ==> (~(x=(&.0))) ==> (a =b)`, MESON_TAC[REAL_EQ_MUL_RCANCEL]);; let REAL_PROP_EQ_LMUL = REAL_MUL_LTIMES;; let REAL_PROP_EQ_RMUL = REAL_MUL_RTIMES;; let REAL_PROP_EQ_LMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * y = x * z) = (x = &0) \/ (y = z) *);; let REAL_PROP_EQ_RMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * z = y * z) = (x = y) \/ (z = &0) *);; (* see also minor variations REAL_LT_LMUL_EQ, REAL_LT_RMUL_EQ *) let REAL_PROP_EQ_SQRT = SQRT_INJ;; (* |- !x y. &0 <= x /\ &0 <= y ==> ((sqrt x = sqrt y) = x = y) *) (* ------------------------------------------------------------------ *) (* Construction of <=. *) (* ------------------------------------------------------------------ *) let REAL_MK_LE_SQUARE = REAL_LE_SQUARE_POW ;; (* |- !x. &0 <= x pow 2 *) (* ------------------------------------------------------------------ *) (* Propagation of <=. *) (* ------------------------------------------------------------------ *) let REAL_MUL_LTIMES_LE = prove (`!x a b. (x*.a <=. x*.b) ==> (&.0 < x) ==> (a <=. b)`, MESON_TAC[REAL_LE_LMUL_EQ]);; (* virtually identical to REAL_LE_LCANCEL_IMP, REAL_LE_LMUL_EQ *) let REAL_MUL_RTIMES_LE = prove (`!x a b. (a*.x <=. b*.x) ==> (&.0 < x) ==> (a <=. b)`, MESON_TAC[REAL_LE_RMUL_EQ]);; (* virtually identical to REAL_LE_RCANCEL_IMP, REAL_LE_RMUL_EQ *) let REAL_PROP_LE_LCANCEL = REAL_MUL_LTIMES_LE;; let REAL_PROP_LE_RCANCEL = REAL_MUL_RTIMES_LE;; let REAL_PROP_LE_LMUL = REAL_LE_LMUL (* |- !x y z. &0 <= x /\ y <= z ==> x * y <= x * z *);; let REAL_PROP_LE_RMUL = REAL_LE_RMUL (* |- !x y z. x <= y /\ &0 <= z ==> x * z <= y * z *);; let REAL_PROP_LE_LRMUL = REAL_LE_MUL2;; (* |- !w x y z. &0 <= w /\ w <= x /\ &0 <= y /\ y <= z ==> w * y <= x * z *) let REAL_PROP_LE_POW = POW_LE;; (* |- !n x y. &0 <= x /\ x <= y ==> x pow n <= y pow n *) let REAL_PROP_LE_SQRT = SQRT_MONO_LE_EQ;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x <= sqrt y = x <= y) *) (* ------------------------------------------------------------------ *) (* Construction of LT *) (* ------------------------------------------------------------------ *) let REAL_MK_LT_SQUARE = REAL_LT_SQUARE;; (* |- !x. &0 < x * x = ~(x = &0) *) (* ------------------------------------------------------------------ *) (* Propagation of LT *) (* ------------------------------------------------------------------ *) let REAL_PROP_LT_LCANCEL = REAL_LT_LCANCEL_IMP (* |- !x y z. &0 < x /\ x * y < x * z ==> y < z *);; let REAL_PROP_LT_RCANCEL = REAL_LT_RCANCEL_IMP (* |- !x y z. &0 < z /\ x * z < y * z ==> x < y *);; let REAL_PROP_LT_LMUL = REAL_LT_LMUL (* |- !x y z. &0 < x /\ y < z ==> x * y < x * z *);; let REAL_PROP_LT_RMUL = REAL_LT_RMUL (* |- !x y z. x < y /\ &0 < z ==> x * z < y * z *);; (* minor variation REAL_LT_LMUL_IMP, REAL_LT_RMUL_IMP *) let REAL_PROP_LT_LRMUL= REAL_LT_MUL2;; (* |- !w x y z. &0 <= w /\ w < x /\ &0 <= y /\ y < z ==> w * y < x * z *) let REAL_PROP_LT_SQRT = SQRT_MONO_LT_EQ;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x < sqrt y = x < y) *) (* ------------------------------------------------------------------ *) (* Constructors of Non-negative *) (* ------------------------------------------------------------------ *) let REAL_MK_NN_SQUARE = REAL_LE_SQUARE;; (* |- !x. &0 <= x * x *) let REAL_MK_NN_ABS = ABS_POS;; (* |- !x. &0 <= abs x *) (* ------------------------------------------------------------------ *) (* Propagation of Non-negative *) (* ------------------------------------------------------------------ *) let REAL_PROP_NN_POS = prove(`! x y. x<. y ==> x <= y`,MESON_TAC[REAL_LT_LE]);; let REAL_PROP_NN_ADD2 = REAL_LE_ADD (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x + y *);; let REAL_PROP_NN_DOUBLE = REAL_LE_DOUBLE (* |- !x. &0 <= x + x <=> &0 <= x *);; let REAL_PROP_NN_RCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. y*.x ==> ((&.0) <=. y)`, MESON_TAC[REAL_PROP_LE_RCANCEL;REAL_MUL_LZERO]);; let REAL_PROP_NN_LCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. x*.y ==> ((&.0) <=. y)`, MESON_TAC[REAL_PROP_LE_LCANCEL;REAL_MUL_RZERO]);; let REAL_PROP_NN_MUL2 = REAL_LE_MUL (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x * y *);; let REAL_PROP_NN_POW = REAL_POW_LE (* |- !x n. &0 <= x ==> &0 <= x pow n *);; let REAL_PROP_NN_SQUARE = REAL_LE_POW_2;; (* |- !x. &0 <= x pow 2 *) let REAL_PROP_NN_SQRT = SQRT_POS_LE;; (* |- !x. &0 <= x ==> &0 <= sqrt x *) let REAL_PROP_NN_INV = REAL_LE_INV_EQ (* |- !x. &0 <= inv x = &0 <= x *);; let REAL_PROP_NN_SIN = SIN_POS_PI_LE;; (* |- !x. &0 <= x /\ x <= pi ==> &0 <= sin x *) let REAL_PROP_NN_ATN = ATN_POS_LE;; (* |- &0 <= atn x = &0 <= x *) (* ------------------------------------------------------------------ *) (* Constructor of POS *) (* ------------------------------------------------------------------ *) let REAL_MK_POS_ABS = REAL_ABS_NZ (* |- !x. ~(x = &0) = &0 < abs x *);; let REAL_MK_POS_EXP = REAL_EXP_POS_LT;; (* |- !x. &0 < exp x *) let REAL_MK_POS_LN = LN_POS_LT;; (* |- !x. &1 < x ==> &0 < ln x *) let REAL_MK_POS_PI = PI_POS;; (* |- &0 < pi *) (* ------------------------------------------------------------------ *) (* Propagation of POS *) (* ------------------------------------------------------------------ *) let REAL_PROP_POS_ADD2 = REAL_LT_ADD (* |- !x y. &0 < x /\ &0 < y ==> &0 < x + y *);; let REAL_PROP_POS_LADD = REAL_LET_ADD (* |- !x y. &0 <= x /\ &0 < y ==> &0 < x + y *);; let REAL_PROP_POS_RADD = REAL_LTE_ADD (* |- !x y. &0 < x /\ &0 <= y ==> &0 < x + y *);; let REAL_PROP_POS_LMUL = REAL_LT_LMUL_0;; (* |- !x y. &0 < x ==> (&0 < x * y = &0 < y) *) let REAL_PROP_POS_RMUL = REAL_LT_RMUL_0;; (* |- !x y. &0 < y ==> (&0 < x * y = &0 < x) *) let REAL_PROP_POS_MUL2 = REAL_LT_MUL (* |- !x y. &0 < x /\ &0 < y ==> &0 < x * y *);; let REAL_PROP_POS_SQRT = SQRT_POS_LT;; (* |- !x. &0 < x ==> &0 < sqrt x *) let REAL_PROP_POS_POW = REAL_POW_LT (* |- !x n. &0 < x ==> &0 < x pow n *);; let REAL_PROP_POS_INV = REAL_LT_INV (* |- !x. &0 < x ==> &0 < inv x *);; let REAL_PROP_POS_SIN = SIN_POS_PI;; (* |- !x. &0 < x /\ x < pi ==> &0 < sin x *) let REAL_PROP_POS_TAN = TAN_POS_PI2;; (* |- !x. &0 < x /\ x < pi / &2 ==> &0 < tan x *) let REAL_PROP_POS_ATN = ATN_POS_LT;; (* |- &0 < atn x = &0 < x *) (* ------------------------------------------------------------------ *) (* Construction of NZ *) (* ------------------------------------------------------------------ *) (* renamed from REAL_MK_NZ_OF_POS *) let REAL_MK_NZ_POS = REAL_POS_NZ (* |- !x. &0 < x ==> ~(x = &0) *);; let REAL_MK_NZ_EXP = REAL_EXP_NZ;; (* |- !x. ~(exp x = &0) *) (* ------------------------------------------------------------------ *) (* Propagation of NZ *) (* ------------------------------------------------------------------ *) (* renamed from REAL_ABS_NZ, moved from float.ml *) let REAL_PROP_NZ_ABS = prove(`!x. (~(x = (&.0))) ==> (~(abs(x) = (&.0)))`, REWRITE_TAC[ABS_ZERO]);; let REAL_PROP_NZ_POW = REAL_POW_NZ (* |- !x n. ~(x = &0) ==> ~(x pow n = &0) *);; let REAL_PROP_NZ_INV = REAL_INV_NZ;; (* |- !x. ~(x = &0) ==> ~(inv x = &0) *) (* ------------------------------------------------------------------ *) (* Propagation of ZERO *) (* ------------------------------------------------------------------ *) let REAL_PROP_ZERO_ABS = REAL_ABS_ZERO (* |- !x. (abs x = &0) = x = &0); *);; let REAL_PROP_ZERO_NEG = REAL_NEG_EQ_0 ;; (* |- !x. (--x = &0) = x = &0 *) let REAL_PROP_ZERO_INV = REAL_INV_EQ_0 (* |- !x. (inv x = &0) = x = &0 *);; let REAL_PROP_ZERO_NEG = REAL_NEG_EQ0;; (* |- !x. (--x = &0) = x = &0 *) let REAL_PROP_ZERO_SUMSQ = REAL_SUMSQ;; (* |- !x y. (x * x + y * y = &0) = (x = &0) /\ (y = &0) *) let REAL_PROP_ZERO_POW = REAL_POW_EQ_0;; (* |- !x n. (x pow n = &0) = (x = &0) /\ ~(n = 0) *) let REAL_PROP_ZERO_SQRT = SQRT_EQ_0;; (* |- !x. &0 <= x ==> (x / sqrt x = sqrt x) *) (* ------------------------------------------------------------------ *) (* Special values of functions *) (* ------------------------------------------------------------------ *) let REAL_SV_LADD_0 = REAL_ADD_LID (* |- !x. &0 + x = x); *);; let REAL_SV_INV_0 = REAL_INV_0 (* |- inv (&0) = &0 *);; let REAL_SV_RMUL_0 = REAL_MUL_RZERO (* |- !x. x * &0 = &0 *);; let REAL_SV_LMUL_0 = REAL_MUL_LZERO (* |- !x. &0 * x = &0 *);; let REAL_SV_NEG_0 = REAL_NEG_0 (* |- -- &0 = &0 *);; let REAL_SV_ABS_0 = REAL_ABS_0 (* |- abs (&0) = &0 *);; let REAL_SV_EXP_0 = REAL_EXP_0;; (* |- exp (&0) = &1 *) let REAL_SV_LN_1 = LN_1;; (* |- ln (&1) = &0 *) let REAL_SV_SQRT_0 = SQRT_0;; (* |- sqrt (&0) = &0 *) let REAL_SV_TAN_0 = TAN_0;; (* |- tan (&0) = &0 *) let REAL_SV_TAN_PI = TAN_PI;; (* |- tan pi = &0 *) (* ------------------------------------------------------------------ *) (* A tactic that multiplies a real on the left *) (* ------------------------------------------------------------------ *) (** #g `a:real = b:real`;; #e (REAL_LMUL_TAC `c:real`);; it : goalstack = 2 subgoals (2 total) `~(c = &0)` `c * a = c * b` 0 [`~(c = &0)`] # **) (* ------------------------------------------------------------------ *) let REAL_LMUL_TAC t = let REAL_MUL_LTIMES = prove ((`!x a b. (((~(x=(&0)) ==> (x*a = x*b)) /\ ~(x=(&0))) ==> (a = b))`), MESON_TAC[REAL_EQ_MUL_LCANCEL]) in (MATCH_MP_TAC (SPEC t REAL_MUL_LTIMES)) THEN CONJ_TAC THENL [DISCH_TAC; ALL_TAC];; (* ------------------------------------------------------------------ *) (* Right multiply by a real *) (* ------------------------------------------------------------------ *) let REAL_RMUL_TAC t = let REAL_MUL_RTIMES = prove (`!x a b. ((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==> (a = b)`, MESON_TAC[REAL_EQ_MUL_RCANCEL]) in (MATCH_MP_TAC (SPEC t REAL_MUL_RTIMES)) THEN CONJ_TAC THENL [DISCH_TAC; ALL_TAC];; pop_priority();; hol-light/Jordan/real_ext_geom_series.ml000066400000000000000000000031761303454263000207070ustar00rootroot00000000000000 prioritize_real();; let (TRY_RULE:(thm->thm) -> (thm->thm)) = fun rl t -> try (rl t) with _ -> t;; let REAL_MUL_RTIMES = prove ((`!x a b. (((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==> (a = b))`), MESON_TAC[REAL_EQ_MUL_RCANCEL]);; let GEOMETRIC_SUM = prove( `!m n x.(~(x=(&1)) ==> (sum(m,n) (\k.(x pow k)) = ((x pow m) - (x pow (m+n)))/((&1)-x)))`, let tac1 = GEN_TAC THEN INDUCT_TAC THEN GEN_TAC THEN DISCH_TAC THEN (REWRITE_TAC [sum_DEF;real_pow;ADD_CLAUSES;real_div;REAL_SUB_RDISTRIB; REAL_SUB_REFL]) in let tac2 = (RULE_ASSUM_TAC (TRY_RULE (SPEC (`x:real`)))) THEN (UNDISCH_EL_TAC 1) THEN (UNDISCH_EL_TAC 0) THEN (TAUT_TAC (`(A==>(B==>C)) ==> (A ==> ((A==>B) ==>C))`)) THEN (REPEAT DISCH_TAC) THEN (ASM_REWRITE_TAC[real_div]) THEN (ABBREV_TAC (`a:real = x pow m`)) THEN (ABBREV_TAC (`b:real = x pow (m+n)`)) in let tac3 = (MATCH_MP_TAC (SPEC (`&1 - x`) REAL_MUL_RTIMES)) THEN CONJ_TAC THENL [ALL_TAC; (UNDISCH_TAC (`~(x = (&1))`)) THEN (ACCEPT_TAC (REAL_ARITH (`~(x=(&1)) ==> ~((&1 - x = (&0)))`)))] THEN (REWRITE_TAC [GSYM REAL_MUL_ASSOC;REAL_ADD_RDISTRIB;REAL_SUB_RDISTRIB]) THEN (SIMP_TAC[REAL_MUL_LINV]) THEN DISCH_TAC THEN (REWRITE_TAC [REAL_SUB_LDISTRIB;REAL_MUL_LID;REAL_MUL_RID;REAL_MUL_ASSOC]) THEN (ACCEPT_TAC (REAL_ARITH (`a - b + b - b*x = a - x*b`))) in (tac1 THEN tac2 THEN tac3));; pop_priority();; hol-light/Jordan/tactics_ext.ml000066400000000000000000000144761303454263000170420ustar00rootroot00000000000000(* This file is in severe need of a rewrite! *) unambiguous_interface();; prioritize_real();; (* ------------------------------------------------------------------------- *) (* A printer that reverses the assumption list *) (* ------------------------------------------------------------------------- *) (* Objective version of HOL-light uses (rev asl) in the method print_goal. This means that the numbers printed next to the assumptions are the reverse of the numbering in the list. I want it the opposite way. This reverses the numbering on the assumption list, so that the printed numbers match the list order. To use, type #install_printer print_rev_goal;; #install_printer print_rev_goalstack;; To restore HOL-light defaults, type #install_printer print_goal;; #install_printer print_goalstack;; *) let (print_rev_goal:goal->unit) = fun (asl,w) -> print_newline(); if asl <> [] then (print_hyps 0 (asl); print_newline()) else (); print_qterm w; print_newline();; let (print_rev_goalstate:int->goalstate->unit) = fun k gs -> let (_,gl,_) = gs in let n = length gl in let s = if n = 0 then "No subgoals" else (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") ^" ("^(string_of_int n)^" total)" in print_string s; print_newline(); if gl = [] then () else do_list (print_rev_goal o C el gl) (rev(0--(k-1)));; let (print_rev_goalstack:goalstack->unit) = fun l -> if l = [] then print_string "Empty goalstack" else if tl l = [] then let (_,gl,_ as gs) = hd l in print_rev_goalstate 1 gs else let (_,gl,_ as gs) = hd l and (_,gl0,_) = hd(tl l) in let p = length gl - length gl0 in let p' = if p < 1 then 1 else p + 1 in print_rev_goalstate p' gs;; #install_printer print_rev_goal;; #install_printer print_rev_goalstack;; (* ------------------------------------------------------------------ *) (* SOME EASY TACTICS *) (* ------------------------------------------------------------------ *) let TAUT_TAC t = (MATCH_MP_TAC (TAUT t));; let REP_GEN_TAC = REPEAT GEN_TAC;; let SUBGOAL_TAC t = SUBGOAL_THEN t MP_TAC;; let DISCH_ALL_TAC = REP_GEN_TAC THEN let tac = TAUT_TAC `(b ==> a==> c) ==> (a /\ b ==> c)` in (REPEAT ((REPEAT tac) THEN DISCH_TAC)) THEN LABEL_ALL_TAC;; (* ------------------------------------------------------------------ *) (* TACTICS BY NUMBER. These are probably best avoided. NB: The numbering is that in the asm list -- not the printed numbers! *) (* ------------------------------------------------------------------ *) let (UNDISCH_EL_TAC:int -> tactic) = fun i (asl,w) -> try let sthm,asl' = (el i asl),(drop i asl) in let tm = concl (snd (el i asl)) in let thm = snd sthm in null_meta,[asl',mk_imp(tm,w)], fun i [th] -> MP th (INSTANTIATE_ALL i thm) with Failure _ -> failwith "UNDISCH_EL_TAC";; (* remove hypotheses by number *) let rec (POPL_TAC:int list ->tactic) = let (POP_TAC:int->tactic) = fun i -> (UNDISCH_EL_TAC i) THEN (TAUT_TAC `B ==> (A==>B)`) in let renumber i = map(fun j -> if j<=i then j else (j-1)) in function [] -> ALL_TAC | (i::b) -> (POP_TAC i) THEN (POPL_TAC (renumber i b));; let rec (UNDISCH_LIST:int list -> tactic) = let renumber i = map(fun j -> if j<=i then j else (j-1)) in function [] -> ALL_TAC | (i::b) -> (UNDISCH_EL_TAC i) THEN (UNDISCH_LIST (renumber i b));; (* ------------------------------------------------------------------ *) (* Transformations of Hypothesis List by LABELS *) (* ------------------------------------------------------------------ *) type goalthm = goal -> thm;; let (HYP_INT:int->goalthm) = fun i-> fun ((asl,_):goal) -> snd (el i asl);; let (HYP:string->goalthm) = fun s (asl,w) -> try assoc s asl with Failure _ -> assoc ("Z-"^s) asl;; let (THM:thm->goalthm) = fun thm -> fun (_:goal) -> thm;; let (H_RULER: (thm list->thm->thm)->(goalthm list)-> goalthm -> tactic) = fun rule gthl gthm -> fun ((asl,w) as g:goal) -> let thl = map (fun x-> (x g)) gthl in let th = rule thl (gthm g) in ASSUME_TAC th g;; (* The next few term rules into goal_rules *) (* H_type (x:type) should return an object similar to x but with thms made into goalthms *) let (H_RULE_LIST: (thm list->thm->thm)->(goalthm list)-> goalthm -> goalthm) = fun rule gthl gthm g -> let thl = map (fun x-> (x g)) gthl in rule thl (gthm g);; let H_RULE2 (rule:thm->thm->thm) = fun gthm1 gthm2 -> H_RULE_LIST (fun thl th -> rule (hd thl) th) [gthm1] gthm2;; let H_RULE (rule:thm->thm) = fun gthm -> H_RULE_LIST (fun _ th -> rule th) [] gthm;; let (H_TTAC : thm_tactic -> goalthm -> tactic ) = fun ttac gthm g -> (ttac (gthm g) g);; let H_ASSUME_TAC = H_TTAC ASSUME_TAC;; let INPUT = fun gth -> (H_ASSUME_TAC gth) THEN LABEL_ALL_TAC;; let H_VAL2 (rule:thm->thm->thm) = fun gthm1 gthm2 -> H_RULER (fun thl th -> rule (hd thl) th) [gthm1] gthm2;; let H_CONJ = H_VAL2(CONJ);; let H_MATCH_MP = H_VAL2(MATCH_MP);; let H_REWRITE_RULE gthml gth = H_RULER REWRITE_RULE gthml gth;; let H_ONCE_REWRITE_RULE gthml gth = H_RULER ONCE_REWRITE_RULE gthml gth;; let H_SIMP_RULE = H_RULER SIMP_RULE;; let H_VAL (rule:thm->thm) = fun gthm -> H_RULER (fun _ th -> rule th) [] gthm;; let H = H_VAL;; let H_CONJUNCT1 = H_VAL CONJUNCT1;; let H_CONJUNCT2 = H_VAL CONJUNCT2;; let H_EQT_INTRO = H_VAL EQT_INTRO;; let H_EQT_ELIM = H_VAL EQT_ELIM;; let H_SPEC = fun t -> H_VAL(SPEC t);; let H_GEN = fun t -> H_VAL(GEN t);; let H_DISJ1 = C (fun t -> H_VAL ((C DISJ1) t));; let H_DISJ2 = (fun t -> H_VAL (( DISJ2) t));; (* beware! One is inverted here. *) let H_NOT_ELIM = H_VAL (NOT_ELIM);; let H_NOT_INTRO = H_VAL (NOT_INTRO);; let H_EQF_ELIM = H_VAL (EQF_ELIM);; let H_EQF_INTRO = H_VAL (EQF_INTRO);; let (&&&) = H_RULE2 CONJ;; let (H_UNDISCH_TAC:goalthm -> tactic) = fun gthm g -> let tm = concl(gthm g) in UNDISCH_TAC tm g;; (* let upgs tac gs = by tac gs;; *) let (thm_op:goalthm->goalthm->goalthm) = fun gt1 gt2 g -> if (is_eq (snd (strip_forall (concl (gt1 g))))) then REWRITE_RULE[gt1 g] (gt2 g) else MATCH_MP (gt1 g) (gt2 g);; let (COMBO:goalthm list-> goalthm) = fun gthl -> end_itlist thm_op gthl;; let INPUT_COMBO = INPUT o COMBO;; hol-light/Jordan/tactics_ext2.ml000066400000000000000000001372061303454263000171210ustar00rootroot00000000000000(* ------------------------------------------------------------------ *) (* MORE RECENT ADDITIONS *) (* ------------------------------------------------------------------ *) (* abbrev_type copied from definitions_group.ml *) let pthm = prove_by_refinement( `(\ (x:A) .T) (@(x:A). T)`, [BETA_TAC]);; let abbrev_type ty s = let (a,b) = new_basic_type_definition s ("mk_"^s,"dest_"^s) (INST_TYPE [ty,`:A`] pthm) in let abst t = list_mk_forall ((frees t), t) in let a' = abst (concl a) in let b' = abst (rhs (concl b)) in ( prove_by_refinement(a',[REWRITE_TAC[a]]), prove_by_refinement(b',[REWRITE_TAC[GSYM b]]));; (* ------------------------------------------------------------------ *) (* KILL IN *) (* ------------------------------------------------------------------ *) let un = REWRITE_RULE[IN];; (* ------------------------------------------------------------------ *) let SUBCONJ_TAC = MATCH_MP_TAC (TAUT `A /\ (A ==>B) ==> (A /\ B)`) THEN CONJ_TAC;; let PROOF_BY_CONTR_TAC = MATCH_MP_TAC (TAUT `(~A ==> F) ==> A`) THEN DISCH_TAC;; (* ------------------------------------------------------------------ *) (* some general tactics *) (* ------------------------------------------------------------------ *) (* before adding assumption to hypothesis list, cleanse it of unnecessary conditions *) let CLEAN_ASSUME_TAC th = MP_TAC th THEN ASM_REWRITE_TAC[] THEN DISCH_TAC;; let CLEAN_THEN th ttac = MP_TAC th THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ttac;; (* looks for a hypothesis by matching a subterm *) let (UNDISCH_FIND_TAC: term -> tactic) = fun tm (asl,w) -> let p = can (term_match[] tm) in try let sthm,_ = remove (fun (_,asm) -> can (find_term p) (concl ( asm))) asl in UNDISCH_TAC (concl (snd sthm)) (asl,w) with Failure _ -> failwith "UNDISCH_FIND_TAC";; let (UNDISCH_FIND_THEN: term -> thm_tactic -> tactic) = fun tm ttac (asl,w) -> let p = can (term_match[] tm) in try let sthm,_ = remove (fun (_,asm) -> can (find_term p) (concl ( asm))) asl in UNDISCH_THEN (concl (snd sthm)) ttac (asl,w) with Failure _ -> failwith "UNDISCH_FIND_TAC";; (* ------------------------------------------------------------------ *) (* NAME_CONFLICT_TAC : eliminate name conflicts in a term *) (* ------------------------------------------------------------------ *) let relabel_bound_conv tm = let rec vars_and_constants tm acc = match tm with | Var _ -> tm::acc | Const _ -> tm::acc | Comb(a,b) -> vars_and_constants b (vars_and_constants a acc) | Abs(a,b) -> a::(vars_and_constants b acc) in let relabel_bound tm = match tm with | Abs(x,t) -> let avoids = filter ((!=) x) (vars_and_constants tm []) in let x' = mk_primed_var avoids x in if (x=x') then failwith "relabel_bound" else (alpha x' tm) | _ -> failwith "relabel_bound" in DEPTH_CONV (fun t -> ALPHA t (relabel_bound t)) tm;; (* example *) let _ = let bad_term = mk_abs (`x:bool`,`(x:num)+1=2`) in relabel_bound_conv bad_term;; let NAME_CONFLICT_CONV = relabel_bound_conv;; let NAME_CONFLICT_TAC = CONV_TAC (relabel_bound_conv);; (* renames given bound variables *) let alpha_conv env tm = ALPHA tm (deep_alpha env tm);; (* replaces given alpha-equivalent terms with- the term itself *) let unify_alpha_tac = SUBST_ALL_TAC o REFL;; let rec get_abs tm acc = match tm with Abs(u,v) -> get_abs v (tm::acc) |Comb(u,v) -> get_abs u (get_abs v acc) |_ -> acc;; (* for purposes such as sorting, it helps if ALL ALPHA-equiv abstractions are replaced by equal abstractions *) let (alpha_tac:tactic) = fun (asl,w' ) -> EVERY (map unify_alpha_tac (get_abs w' [])) (asl,w');; (* ------------------------------------------------------------------ *) (* SELECT ELIMINATION. SELECT_TAC should work whenever there is a single predicate selected. Something more sophisticated might be needed when there is (@)A and (@)B in the same formula. Useful for proving statements such as `1 + (@x. (x=3)) = 4` *) (* ------------------------------------------------------------------ *) (* spec form of SELECT_AX *) let select_thm select_fn select_exist = BETA_RULE (ISPECL [select_fn;select_exist] SELECT_AX);; (* example *) select_thm `\m. (X:num->bool) m /\ (!n. X n ==> m <=| n)` `n:num`;; let SELECT_EXIST = prove_by_refinement( `!(P:A->bool) Q. (?y. P y) /\ (!t. (P t ==> Q t)) ==> Q ((@) P)`, (* {{{ proof *) [ REPEAT GEN_TAC; DISCH_ALL_TAC; UNDISCH_FIND_TAC `(?)`; DISCH_THEN CHOOSE_TAC; ASSUME_TAC (ISPECL[`P:(A->bool)`;`y:A`] SELECT_AX); ASM_MESON_TAC[]; ]);; (* }}} *) let SELECT_THM = prove_by_refinement( `!(P:A->bool) Q. (((?y. P y) ==> (!t. (P t ==> Q t))) /\ ((~(?y. P y)) ==> (!t. Q t))) ==> Q ((@) P)`, (* {{{ proof *) [ MESON_TAC[SELECT_EXIST]; ]);; (* }}} *) let SELECT_TAC = (* explicitly pull apart the clause Q((@) P), because MATCH_MP_TAC isn't powerful enough to do this by itself. *) let unbeta = prove( `!(P:A->bool) (Q:A->bool). (Q ((@) P)) <=> (\t. Q t) ((@) P)`,MESON_TAC[]) in let unbeta_tac = CONV_TAC (HIGHER_REWRITE_CONV[unbeta] true) in unbeta_tac THEN (MATCH_MP_TAC SELECT_THM) THEN BETA_TAC THEN CONJ_TAC THENL[ (DISCH_THEN (fun t-> ALL_TAC)) THEN GEN_TAC; DISCH_TAC THEN GEN_TAC];; (* EXAMPLE: # g `(R:A->bool) ((@) S)`;; val it : Core.goalstack = 1 subgoal (1 total) `R ((@) S)` # e SELECT_TAC ;; val it : Core.goalstack = 2 subgoals (2 total) 0 [`~(?y. S y)`] `R t` `S t ==> R t` *) (* ------------------------------------------------------------------ *) (* TYPE_THEN and TYPEL_THEN calculate the types of the terms supplied in a proof, avoiding the hassle of working them out by hand. It locates the terms among the free variables in the goal. Ambiguious if a free variables have name conflicts. Now TYPE_THEN handles general terms. *) (* ------------------------------------------------------------------ *) let rec type_set: (string*term) list -> (term list*term) -> (term list*term)= fun typinfo (acclist,utm) -> match acclist with | [] -> (acclist,utm) | (Var(s,_) as a)::rest -> let a' = (assocd s typinfo a) in if (a = a') then type_set typinfo (rest,utm) else let inst = instantiate (term_match [] a a') in type_set typinfo ((map inst rest),inst utm) | _ -> failwith "type_set: variable expected" ;; let has_stv t = let typ = (type_vars_in_term t) in can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;; let TYPE_THEN: term -> (term -> tactic) -> tactic = fun t (tac:term->tactic) (asl,w) -> let avoids = itlist (union o frees o concl o snd) asl (frees w) in let strip = fun t-> (match t with |Var(s,_) -> (s,t) | _ -> failwith "TYPE_THEN" ) in let typinfo = map strip avoids in let t' = (snd (type_set typinfo ((frees t),t))) in (warn ((has_stv t')) "TYPE_THEN: unresolved type variables"); tac t' (asl,w);; (* this version must take variables *) let TYPEL_THEN: term list -> (term list -> tactic) -> tactic = fun t (tac:term list->tactic) (asl,w) -> let avoids = itlist (union o frees o concl o snd) asl (frees w) in let strip = fun t-> (match t with |Var(s,_) -> (s,t) | _ -> failwith "TYPE_THEN" ) in let typinfo = map strip avoids in let t' = map (fun u -> snd (type_set typinfo ((frees u),u))) t in (warn ((can (find has_stv) t')) "TYPEL_THEN: unresolved type vars"); tac t' (asl,w);; (* trivial example *) let _ = prove_by_refinement(`!y. y:num = y`, [ GEN_TAC; TYPE_THEN `y:A` (fun t -> ASSUME_TAC(ISPEC t (TAUT `!x:B. x=x`))); UNDISCH_TAC `y:num = y`; (* evidence that `y:A` was retyped as `y:num` *) MESON_TAC[]; ]);; (* ------------------------------------------------------------------ *) (* SAVE the goalstate, and retrieve later *) (* ------------------------------------------------------------------ *) let (save_goal,get_goal) = let goal_buffer = ref [] in let save_goal s = goal_buffer := (s,!current_goalstack )::!goal_buffer in let get_goal (s:string) = (current_goalstack:= assoc s !goal_buffer) in (save_goal,get_goal);; (* ------------------------------------------------------------------ *) (* ordered rewrites with general ord function . This allows rewrites with an arbitrary condition -- adapted from simp.ml *) (* ------------------------------------------------------------------ *) let net_of_thm_ord ord rep force th = let t = concl th in let lconsts = freesl (hyp th) in let matchable = can o term_match lconsts in try let l,r = dest_eq t in if rep && free_in l r then let th' = EQT_INTRO th in enter lconsts (l,(1,REWR_CONV th')) else if rep && matchable l r && matchable r l then enter lconsts (l,(1,ORDERED_REWR_CONV ord th)) else if force then enter lconsts (l,(1,ORDERED_REWR_CONV ord th)) else enter lconsts (l,(1,REWR_CONV th)) with Failure _ -> let l,r = dest_eq(rand t) in if rep && free_in l r then let tm = lhand t in let th' = DISCH tm (EQT_INTRO(UNDISCH th)) in enter lconsts (l,(3,IMP_REWR_CONV th')) else if rep && matchable l r && matchable r l then enter lconsts (l,(3,ORDERED_IMP_REWR_CONV ord th)) else enter lconsts(l,(3,IMP_REWR_CONV th));; let GENERAL_REWRITE_ORD_CONV ord rep force (cnvl:conv->conv) (builtin_net:gconv net) thl = let thl_canon = itlist (mk_rewrites false) thl [] in let final_net = itlist (net_of_thm_ord ord rep force ) thl_canon builtin_net in cnvl (REWRITES_CONV final_net);; let GEN_REWRITE_ORD_CONV ord force (cnvl:conv->conv) thl = GENERAL_REWRITE_ORD_CONV ord false force cnvl empty_net thl;; let PURE_REWRITE_ORD_CONV ord force thl = GENERAL_REWRITE_ORD_CONV ord true force TOP_DEPTH_CONV empty_net thl;; let REWRITE_ORD_CONV ord force thl = GENERAL_REWRITE_ORD_CONV ord true force TOP_DEPTH_CONV (basic_net()) thl;; let PURE_ONCE_REWRITE_ORD_CONV ord force thl = GENERAL_REWRITE_ORD_CONV ord false force ONCE_DEPTH_CONV empty_net thl;; let ONCE_REWRITE_ORD_CONV ord force thl = GENERAL_REWRITE_ORD_CONV ord false force ONCE_DEPTH_CONV (basic_net()) thl;; let REWRITE_ORD_TAC ord force thl = CONV_TAC(REWRITE_ORD_CONV ord force thl);; (* ------------------------------------------------------------------ *) (* poly reduction *) (* ------------------------------------------------------------------ *) (* move vars leftward *) (* if ord old_lhs new_rhs THEN swap *) let new_factor_order t1 t2 = try let t1v = fst(dest_binop `( *. )` t1) in let t2v = fst(dest_binop `( *. )` t2) in if (is_var t1v) && (is_var t2v) then term_order t1v t2v else if (is_var t2v) then true else false with Failure _ -> false ;; (* false if it contains a variable or abstraction. *) let rec is_arith_const tm = if is_var tm then false else if is_abs tm then false else if is_comb tm then let (a,b) = (dest_comb tm) in is_arith_const (a) && is_arith_const (b) else true;; (* const leftward *) let new_factor_order2 t1 t2 = try let t1v = fst(dest_binop `( *. )` t1) in let t2v = fst(dest_binop `( *. )` t2) in if (is_var t1v) && (is_var t2v) then term_order t1v t2v else if (is_arith_const t2v) then true else false with Failure _ -> false ;; let rec mon_sz tm = if is_var tm then Int (Hashtbl.hash tm) else try let (a,b) = dest_binop `( *. )` tm in (mon_sz a) */ (mon_sz b) with Failure _ -> Int 1;; let rec new_summand_order t1 t2 = try let t1v = fst(dest_binop `( +. )` t1) in let t2v = fst(dest_binop `( +. )` t2) in (mon_sz t2v >/ mon_sz t1v) with Failure _ -> false ;; let rec new_distrib_order t1 t2 = try let t2v = fst(dest_binop `( *. )` t2) in if (is_arith_const t2v) then true else false with Failure _ -> try let t2' = fst(dest_binop `( +. )` t2) in new_distrib_order t1 t2' with Failure _ -> false ;; let real_poly_conv = (* same side *) ONCE_REWRITE_CONV [GSYM REAL_SUB_0] THENC (* expand ALL *) REWRITE_CONV[real_div;REAL_RDISTRIB;REAL_SUB_RDISTRIB; pow; GSYM REAL_MUL_ASSOC;GSYM REAL_ADD_ASSOC; REAL_ARITH `(x -. (--y) = x + y) /\ (x - y = x + (-- y)) /\ (--(x + y) = --x + (--y)) /\ (--(x - y) = --x + y)`; REAL_ARITH `(x*.(-- y) = -- (x*. y)) /\ (--. (--. x) = x) /\ ((--. x)*.y = --.(x*.y))`; REAL_SUB_LDISTRIB;REAL_LDISTRIB] THENC (* move constants rightward on monomials *) REWRITE_ORD_CONV new_factor_order false [REAL_MUL_AC;] THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [REAL_ARITH `-- x = (x*(-- &.1))`] THENC REWRITE_CONV[GSYM REAL_MUL_ASSOC] THENC REAL_RAT_REDUCE_CONV THENC (* collect like monomials *) REWRITE_ORD_CONV new_summand_order false [REAL_ADD_AC;] THENC (* move constants leftward AND collect them together *) REWRITE_ORD_CONV new_factor_order2 false [REAL_MUL_AC;] THENC REWRITE_ORD_CONV new_distrib_order true [ REAL_ARITH `(a*b +. d*b = (a+d)*b) /\ (a*b + b = (a+ &.1)*b ) /\ ( b + a*b = (a+ &.1)*b) /\ (a*b +. d*b +e = (a+d)*b + e) /\ (a*b + b + e= (a+. &.1)* b +e ) /\ ( b + a*b + e = (a + &.1)*b +e) `;] THENC REAL_RAT_REDUCE_CONV THENC REWRITE_CONV[REAL_ARITH `(&.0 * x = &.0) /\ (x + &.0 = x) /\ (&.0 + x = x)`];; let real_poly_tac = CONV_TAC real_poly_conv;; let test_real_poly_tac = prove_by_refinement( `!x y . (x + (&.2)*y)*(x- (&.2)*y) = (x*x -. (&.4)*y*y)`, (* {{{ proof *) [ DISCH_ALL_TAC; real_poly_tac; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* REAL INEQUALITIES *) (* Take inequality certificate A + B1 + B2 +.... + P = C as a term. Prove it as an inequality. Reduce to an ineq (A < C) WITH side conditions 0 <= Bi, 0 < P. If (not strict), write as an ineq (A <= C) WITH side conditions 0 <= Bi. Expand each Bi (or P) that is a product U*V as 0 <= U /\ 0 <= V. To prevent expansion of Bi write (U*V) as (&0 + (U*V)). CALL as ineq_le_tac `A + B1 + B2 = C`; *) (* ------------------------------------------------------------------ *) let strict_lemma = prove_by_refinement( `!A B C. (A+B = C) ==> ((&.0 <. B) ==> (A <. C) )`, (* {{{ proof *) [ REAL_ARITH_TAC; ]);; (* }}} *) let weak_lemma = prove_by_refinement( `!A B C. (A+B = C) ==> ((&.0 <=. B) ==> (A <=. C))`, (* {{{ proof *) [ REAL_ARITH_TAC; ]);; (* }}} *) let strip_lt_lemma = prove_by_refinement( `!B1 B2 C. ((&.0 <. (B1+B2)) ==> C) ==> ((&.0 <. B2) ==> ((&.0 <=. B1) ==> C))`, (* {{{ proof *) [ ASM_MESON_TAC[REAL_LET_ADD]; ]);; (* }}} *) let strip_le_lemma = prove_by_refinement( `!B1 B2 C. ((&.0 <=. (B1+B2)) ==> C) ==> ((&.0 <=. B2) ==> ((&.0 <=. B1) ==> C))`, (* {{{ proof *) [ ASM_MESON_TAC[REAL_LE_ADD]; ]);; (* }}} *) let is_x_prod_le tm = try let hyp = fst(dest_binop `( ==> )` tm) in let arg = snd(dest_binop `( <=. ) ` hyp) in let fac = dest_binop `( *. )` arg in true with Failure _ -> false;; let switch_lemma_le_order t1 t2 = if (is_x_prod_le t1) && (is_x_prod_le t2) then term_order t1 t2 else if (is_x_prod_le t2) then true else false;; let is_x_prod_lt tm = try let hyp = fst(dest_binop `( ==> )` tm) in let arg = snd(dest_binop `( <. ) ` hyp) in let fac = dest_binop `( *. )` arg in true with Failure _ -> false;; let switch_lemma_lt_order t1 t2 = if (is_x_prod_lt t1) && (is_x_prod_lt t2) then term_order t1 t2 else if (is_x_prod_lt t2) then true else false;; let switch_lemma_le = prove_by_refinement( `!A B C. ((&.0 <= A) ==> (&.0 <= B) ==> C) = ((&.0 <=. B) ==> (&.0 <= A) ==> C)`, (* {{{ proof *) [ ASM_MESON_TAC[]; ]);; (* }}} *) let switch_lemma_let = prove_by_refinement( `!A B C. ((&.0 < A) ==> (&.0 <= B) ==> C) = ((&.0 <=. B) ==> (&.0 < A) ==> C)`, (* {{{ proof *) [ ASM_MESON_TAC[]; ]);; (* }}} *) let switch_lemma_lt = prove_by_refinement( `!A B C. ((&.0 < A) ==> (&.0 < B) ==> C) = ((&.0 <. B) ==> (&.0 < A) ==> C)`, (* {{{ proof *) [ ASM_MESON_TAC[]; ]);; (* }}} *) let expand_prod_lt = prove_by_refinement( `!B1 B2 C. (&.0 < B1*B2 ==> C) ==> ((&.0 <. B1) ==> (&.0 <. B2) ==> C)`, (* {{{ proof *) [ ASM_MESON_TAC[REAL_LT_MUL ]; ]);; (* }}} *) let expand_prod_le = prove_by_refinement( `!B1 B2 C. (&.0 <= B1*B2 ==> C) ==> ((&.0 <=. B1) ==> (&.0 <=. B2) ==> C)`, (* {{{ proof *) [ ASM_MESON_TAC[REAL_LE_MUL ]; ]);; (* }}} *) let ineq_cert_gen_tac v cert = let DISCH_RULE f = DISCH_THEN (fun t-> MP_TAC (f t)) in TYPE_THEN cert (MP_TAC o (REWRITE_CONV[REAL_POW_2] THENC real_poly_conv)) THEN REWRITE_TAC[] THEN DISCH_RULE (MATCH_MP v) THEN DISCH_RULE (repeat (MATCH_MP strip_lt_lemma)) THEN DISCH_RULE (repeat (MATCH_MP strip_le_lemma)) THEN DISCH_RULE (repeat (MATCH_MP expand_prod_lt o (CONV_RULE (REWRITE_ORD_CONV switch_lemma_lt_order true[switch_lemma_lt])))) THEN DISCH_RULE (repeat (MATCH_MP expand_prod_le o (CONV_RULE (REWRITE_ORD_CONV switch_lemma_le_order true [switch_lemma_le])) o (REWRITE_RULE[switch_lemma_let]))) THEN DISCH_RULE (repeat (MATCH_MP (TAUT `(A ==> B==>C) ==> (A /\ B ==> C)`))) THEN REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LE_POW_2; REAL_ARITH `(&.0 < x ==> &.0 <= x) /\ (&.0 + x = x) /\ (a <= b ==> &.0 <= b - a) /\ (a < b ==> &.0 <= b - a) /\ (~(b < a) ==> &.0 <= b - a) /\ (~(b <= a) ==> &.0 <= b - a) /\ (a < b ==> &.0 < b - a) /\ (~(b <= a) ==> &.0 < b - a)`];; let ineq_lt_tac = ineq_cert_gen_tac strict_lemma;; let ineq_le_tac = ineq_cert_gen_tac weak_lemma;; (* test *) let test_ineq_tac = prove_by_refinement( `!x y z. (&.0 <= x*y) /\ (&.0 <. z) ==> (x*y) <. x*x + (&.3)*x*y + &.4 `, (* {{{ proof *) [ DISCH_ALL_TAC; ineq_lt_tac `x * y + x pow 2 + &2 * (&.0 + x * y) + &2 * &2 = x * x + &3 * x * y + &4`; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* Move quantifier left. Use class.ml and theorems.ml to bubble quantifiers towards the head of an expression. It should move quantifiers past other quantifiers, past conjunctions, disjunctions, implications, etc. val quant_left_CONV : string -> term -> thm = Arguments: var_name:string -- The name of the variable that is to be shifted. It tends to return `T` when the conversion fails. Example: quant_left_CONV "a" `!b. ?a. a = b*4`;; val it : thm = |- (!b. ?a. a = b *| 4) <=> (?a. !b. a b = b *| 4) *) (* ------------------------------------------------------------------ *) let tagb = new_definition `TAGB (x:bool) = x`;; let is_quant tm = (is_forall tm) || (is_exists tm);; (*** JRH replaced Comb and Abs with abstract type constructors ***) let rec tag_quant var_name tm = if (is_forall tm && (fst (dest_var (fst (dest_forall tm))) = var_name)) then mk_comb (`TAGB`,tm) else if (is_exists tm && (fst (dest_var (fst (dest_exists tm))) = var_name)) then mk_comb (`TAGB`,tm) else match tm with | Comb (x,y) -> mk_comb(tag_quant var_name x,tag_quant var_name y) | Abs (x,y) -> mk_abs(x,tag_quant var_name y) | _ -> tm;; let quant_left_CONV = (* ~! -> ?~ *) let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let NOT_FORALL_TAG = prove(`!P. ~(TAGB(!x. P x)) <=> (?x:A. ~(P x))`, REWRITE_TAC[tagb;NOT_FORALL_THM]) in let SKOLEM_TAG = prove(`!P. (?y. TAGB (!(x:A). P x ((y:A->B) x))) <=> ( (!(x:A). ?y. P x ((y:B))))`,REWRITE_TAC[tagb;SKOLEM_THM]) in let SKOLEM_TAG2 = prove(`!P. (!x:A. TAGB(?y:B. P x y)) <=> (?y. !x. P x (y x))`, REWRITE_TAC[tagb;SKOLEM_THM]) in (* !1 !2 -> !2 !1 *) let SWAP_FORALL_TAG = prove(`!P:A->B->bool. (!x. TAGB(! y. P x y)) <=> (!y x. P x y)`, REWRITE_TAC[SWAP_FORALL_THM;tagb]) in let SWAP_EXISTS_THM = iprove `!P:A->B->bool. (?x. TAGB (?y. P x y)) <=> (?y x. P x y)` in (* ! /\ ! -> ! /\ *) let AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ TAGB (!x. Q x) <=> (!x. P x /\ Q x))`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let LEFT_AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ Q) <=> (!x. P x /\ Q )`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let RIGHT_AND_FORALL_TAG = prove(`!P Q. P /\ TAGB (!x. Q x) <=> (!x. P /\ Q x)`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let TRIV_OR_FORALL_TAG = prove (`!P Q. TAGB (!x:A. P) \/ TAGB (!x:A. Q) <=> (!x:A. P \/ Q)`, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let RIGHT_IMP_FORALL_TAG = prove (`!P Q. (P ==> TAGB (!x:A. Q x)) <=> (!x. P ==> Q x)`, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let OR_EXISTS_THM = iprove `!P Q. TAGB (?x. P x) \/ TAGB (?x. Q x) <=> (?x:A. P x \/ Q x)` in let LEFT_OR_EXISTS_THM = iprove `!P Q. TAGB (?x. P x) \/ Q <=> (?x:A. P x \/ Q)` in let RIGHT_OR_EXISTS_THM = iprove `!P Q. P \/ TAGB (?x. Q x) <=> (?x:A. P \/ Q x)` in let LEFT_AND_EXISTS_THM = iprove `!P Q. TAGB (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)` in let RIGHT_AND_EXISTS_THM = iprove `!P Q. P /\ TAGB (?x:A. Q x) <=> (?x:A. P /\ Q x)` in let TRIV_AND_EXISTS_THM = iprove `!P Q. TAGB (?x:A. P) /\ TAGB (?x:A. Q) <=> (?x:A. P /\ Q)` in let LEFT_IMP_EXISTS_THM = iprove `!P Q. (TAGB (?x:A. P x) ==> Q) <=> (!x. P x ==> Q)` in let TRIV_FORALL_IMP_THM = iprove `!P Q. (TAGB (?x:A. P) ==> TAGB (!x:A. Q)) <=> (!x:A. P ==> Q) ` in let TRIV_EXISTS_IMP_THM = iprove `!P Q. (TAGB(!x:A. P) ==> TAGB (?x:A. Q)) <=> (?x:A. P ==> Q) ` in let NOT_EXISTS_TAG = prove( `!P. ~(TAGB(?x:A. P x)) <=> (!x. ~(P x))`, REWRITE_TAC[tagb;NOT_EXISTS_THM]) in let LEFT_OR_FORALL_TAG = prove (`!P Q. TAGB(!x:A. P x) \/ Q <=> (!x. P x \/ Q)`, REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in let RIGHT_OR_FORALL_TAG = prove (`!P Q. P \/ TAGB(!x:A. Q x) <=> (!x. P \/ Q x)`, REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in let LEFT_IMP_FORALL_TAG = prove (`!P Q. (TAGB(!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`, REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in let RIGHT_IMP_EXISTS_TAG = prove (`!P Q. (P ==> TAGB(?x:A. Q x)) <=> (?x:A. P ==> Q x)`, REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in fun var_name tm -> REWRITE_RULE [tagb] (TOP_SWEEP_CONV (GEN_REWRITE_CONV I [NOT_FORALL_TAG;SKOLEM_TAG;SKOLEM_TAG2; SWAP_FORALL_TAG;SWAP_EXISTS_THM; SWAP_EXISTS_THM; AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG; TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG; OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM; TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG; LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG; RIGHT_IMP_EXISTS_TAG; ]) (tag_quant var_name tm));; (* same, but never pass a quantifier past another. No Skolem, etc. *) let quant_left_noswap_CONV = (* ~! -> ?~ *) let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let NOT_FORALL_TAG = prove(`!P. ~(TAGB(!x. P x)) <=> (?x:A. ~(P x))`, REWRITE_TAC[tagb;NOT_FORALL_THM]) in let SKOLEM_TAG = prove(`!P. (?y. TAGB (!(x:A). P x ((y:A->B) x))) <=> ( (!(x:A). ?y. P x ((y:B))))`,REWRITE_TAC[tagb;SKOLEM_THM]) in let SKOLEM_TAG2 = prove(`!P. (!x:A. TAGB(?y:B. P x y)) <=> (?y. !x. P x (y x))`, REWRITE_TAC[tagb;SKOLEM_THM]) in (* !1 !2 -> !2 !1 *) let SWAP_FORALL_TAG = prove(`!P:A->B->bool. (!x. TAGB(! y. P x y)) <=> (!y x. P x y)`, REWRITE_TAC[SWAP_FORALL_THM;tagb]) in let SWAP_EXISTS_THM = iprove `!P:A->B->bool. (?x. TAGB (?y. P x y)) <=> (?y x. P x y)` in (* ! /\ ! -> ! /\ *) let AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ TAGB (!x. Q x) <=> (!x. P x /\ Q x))`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let LEFT_AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ Q) <=> (!x. P x /\ Q )`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let RIGHT_AND_FORALL_TAG = prove(`!P Q. P /\ TAGB (!x. Q x) <=> (!x. P /\ Q x)`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let TRIV_OR_FORALL_TAG = prove (`!P Q. TAGB (!x:A. P) \/ TAGB (!x:A. Q) <=> (!x:A. P \/ Q)`, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let RIGHT_IMP_FORALL_TAG = prove (`!P Q. (P ==> TAGB (!x:A. Q x)) <=> (!x. P ==> Q x)`, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let OR_EXISTS_THM = iprove `!P Q. TAGB (?x. P x) \/ TAGB (?x. Q x) <=> (?x:A. P x \/ Q x)` in let LEFT_OR_EXISTS_THM = iprove `!P Q. TAGB (?x. P x) \/ Q <=> (?x:A. P x \/ Q)` in let RIGHT_OR_EXISTS_THM = iprove `!P Q. P \/ TAGB (?x. Q x) <=> (?x:A. P \/ Q x)` in let LEFT_AND_EXISTS_THM = iprove `!P Q. TAGB (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)` in let RIGHT_AND_EXISTS_THM = iprove `!P Q. P /\ TAGB (?x:A. Q x) <=> (?x:A. P /\ Q x)` in let TRIV_AND_EXISTS_THM = iprove `!P Q. TAGB (?x:A. P) /\ TAGB (?x:A. Q) <=> (?x:A. P /\ Q)` in let LEFT_IMP_EXISTS_THM = iprove `!P Q. (TAGB (?x:A. P x) ==> Q) <=> (!x. P x ==> Q)` in let TRIV_FORALL_IMP_THM = iprove `!P Q. (TAGB (?x:A. P) ==> TAGB (!x:A. Q)) <=> (!x:A. P ==> Q) ` in let TRIV_EXISTS_IMP_THM = iprove `!P Q. (TAGB(!x:A. P) ==> TAGB (?x:A. Q)) <=> (?x:A. P ==> Q) ` in let NOT_EXISTS_TAG = prove( `!P. ~(TAGB(?x:A. P x)) <=> (!x. ~(P x))`, REWRITE_TAC[tagb;NOT_EXISTS_THM]) in let LEFT_OR_FORALL_TAG = prove (`!P Q. TAGB(!x:A. P x) \/ Q <=> (!x. P x \/ Q)`, REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in let RIGHT_OR_FORALL_TAG = prove (`!P Q. P \/ TAGB(!x:A. Q x) <=> (!x. P \/ Q x)`, REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in let LEFT_IMP_FORALL_TAG = prove (`!P Q. (TAGB(!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`, REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in let RIGHT_IMP_EXISTS_TAG = prove (`!P Q. (P ==> TAGB(?x:A. Q x)) <=> (?x:A. P ==> Q x)`, REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in fun var_name tm -> REWRITE_RULE [tagb] (TOP_SWEEP_CONV (GEN_REWRITE_CONV I [NOT_FORALL_TAG; (* SKOLEM_TAG;SKOLEM_TAG2; *) (* SWAP_FORALL_TAG;SWAP_EXISTS_THM; SWAP_EXISTS_THM; *) AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG; TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG; OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM; TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG; LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG; RIGHT_IMP_EXISTS_TAG; ]) (tag_quant var_name tm));; let quant_right_CONV = (* ~! -> ?~ *) let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in let NOT_FORALL_TAG = prove(`!P. TAGB(?x:A. ~(P x)) <=> ~((!x. P x))`, REWRITE_TAC[tagb;GSYM NOT_FORALL_THM]) in let SKOLEM_TAG = prove(`!P. ( TAGB(!(x:A). ?y. P x ((y:B)))) <=> (?y. (!(x:A). P x ((y:A->B) x)))`, REWRITE_TAC[tagb;GSYM SKOLEM_THM]) in let SKOLEM_TAG2 = prove(`!P. TAGB(?y. !x. P x (y x)) <=> (!x:A. (?y:B. P x y))`, REWRITE_TAC[tagb;GSYM SKOLEM_THM]) in (* !1 !2 -> !2 !1.. *) let SWAP_FORALL_TAG = prove(`!P:A->B->bool. TAGB(!y x. P x y) <=> (!x. (! y. P x y))`, REWRITE_TAC[GSYM SWAP_FORALL_THM;tagb]) in let SWAP_EXISTS_THM = iprove `!P:A->B->bool. TAGB (?y x. P x y) <=> (?x. (?y. P x y))` in (* ! /\ ! -> ! /\ *) let AND_FORALL_TAG = iprove`!P Q. TAGB(!x. P x /\ Q x) <=> ((!x. P x) /\ (!x. Q x))` in let LEFT_AND_FORALL_TAG = prove(`!P Q. TAGB(!x. P x /\ Q ) <=> ((!x. P x) /\ Q)`, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let RIGHT_AND_FORALL_TAG = prove(`!P Q. TAGB(!x. P /\ Q x) <=> P /\ (!x. Q x)`, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let TRIV_OR_FORALL_TAG = prove (`!P Q. TAGB(!x:A. P \/ Q) <=>(!x:A. P) \/ (!x:A. Q)`, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let RIGHT_IMP_FORALL_TAG = prove (`!P Q. TAGB (!x. P ==> Q x) <=> (P ==> (!x:A. Q x)) `, REWRITE_TAC[tagb] THEN ITAUT_TAC) in let OR_EXISTS_THM = iprove `!P Q. TAGB(?x:A. P x \/ Q x) <=> (?x. P x) \/ (?x. Q x) ` in let LEFT_OR_EXISTS_THM = iprove `!P Q. TAGB (?x:A. P x \/ Q) <=> (?x. P x) \/ Q ` in let RIGHT_OR_EXISTS_THM = iprove `!P Q.TAGB (?x:A. P \/ Q x) <=> P \/ (?x. Q x)` in let LEFT_AND_EXISTS_THM = iprove `!P Q.TAGB (?x:A. P x /\ Q) <=> (?x:A. P x) /\ Q` in let RIGHT_AND_EXISTS_THM = iprove `!P Q. TAGB (?x:A. P /\ Q x) <=> P /\ (?x:A. Q x) ` in let TRIV_AND_EXISTS_THM = iprove `!P Q. TAGB(?x:A. P /\ Q) <=> (?x:A. P) /\ (?x:A. Q) ` in (* *) let LEFT_IMP_EXISTS_THM = iprove `!P Q. TAGB(!x. P x ==> Q) <=> ( (?x:A. P x) ==> Q) ` in (* *) let TRIV_FORALL_IMP_THM = iprove `!P Q. TAGB(!x:A. P ==> Q) <=> ( (?x:A. P) ==> (!x:A. Q)) ` in let TRIV_EXISTS_IMP_THM = iprove `!P Q. TAGB(?x:A. P ==> Q) <=> ((!x:A. P) ==> (?x:A. Q)) ` in let NOT_EXISTS_TAG = prove( `!P. TAGB(!x. ~(P x)) <=> ~((?x:A. P x)) `, REWRITE_TAC[tagb;NOT_EXISTS_THM]) in let LEFT_OR_FORALL_TAG = prove (`!P Q. TAGB(!x. P x \/ Q) <=> (!x:A. P x) \/ Q `, REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in let RIGHT_OR_FORALL_TAG = prove (`!P Q. TAGB(!x. P \/ Q x) <=> P \/ (!x:A. Q x) `, REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in let LEFT_IMP_FORALL_TAG = prove (`!P Q. TAGB(?x. P x ==> Q) <=> ((!x:A. P x) ==> Q) `, REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in let RIGHT_IMP_EXISTS_TAG = prove (`!P Q. TAGB(?x:A. P ==> Q x) <=> (P ==> (?x:A. Q x)) `, REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in fun var_name tm -> REWRITE_RULE [tagb] (TOP_SWEEP_CONV (GEN_REWRITE_CONV I [NOT_FORALL_TAG;SKOLEM_TAG;SKOLEM_TAG2; SWAP_FORALL_TAG;SWAP_EXISTS_THM; SWAP_EXISTS_THM; AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG; TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG; OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM; TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG; LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG; RIGHT_IMP_EXISTS_TAG; ]) (tag_quant var_name tm));; (* ------------------------------------------------------------------ *) (* Dropping Superfluous Quantifiers . Example: ?u. (u = t) /\ ... We can eliminate the u. *) (* ------------------------------------------------------------------ *) let mark_term = new_definition `mark_term (u:A) = u`;; (*** JRH replaced Comb and Abs with explicit constructors ***) let rec markq qname tm = match tm with Var (a,b) -> if (a=qname) then mk_icomb (`mark_term:A->A`,tm) else tm |Const(_,_) -> tm |Comb(s,b) -> mk_comb(markq qname s,markq qname b) |Abs (x,t) -> mk_abs(x,markq qname t);; let rec getquants tm = if (is_forall tm) then (fst (dest_var (fst (dest_forall tm)))):: (getquants (snd (dest_forall tm))) else if (is_exists tm) then (fst (dest_var (fst (dest_exists tm)))):: (getquants (snd (dest_exists tm))) else match tm with Comb(s,b) -> (getquants s) @ (getquants b) | Abs (x,t) -> (getquants t) | _ -> [];; (* can loop if there are TWO *) let rewrite_conjs = [ prove_by_refinement (`!A B C. (A /\ B) /\ C <=> A /\ B /\ C`,[REWRITE_TAC[CONJ_ACI]]); prove_by_refinement (`!u. (mark_term (u:A) = mark_term u) <=> T`,[MESON_TAC[]]); prove_by_refinement (`!u t. (t = mark_term (u:A)) <=> (mark_term u = t)`,[MESON_TAC[]]); prove_by_refinement (`!u a b. (mark_term (u:A) = a) /\ (mark_term u = b) <=> (mark_term u = a) /\ (a = b)`,[MESON_TAC[]]); prove_by_refinement (`!u a b B. (mark_term (u:A) = a) /\ (mark_term u = b) /\ B <=> (mark_term u = a) /\ (a = b) /\ B`,[MESON_TAC[]]); prove_by_refinement (`!u t A C. A /\ (mark_term (u:A) = t) /\ C <=> (mark_term u = t) /\ A /\ C`,[MESON_TAC[]]); prove_by_refinement (`!A u t. A /\ (mark_term (u:A) = t) <=> (mark_term u = t) /\ A `,[MESON_TAC[]]); prove_by_refinement (`!u t C D. (((mark_term (u:A) = t) /\ C) ==> D) <=> ((mark_term (u:A) = t) ==> C ==> D)`,[MESON_TAC[]]); prove_by_refinement (`!A u t B. (A ==> (mark_term (u:A) = t) ==> B) <=> ((mark_term (u:A) = t) ==> A ==> B)`,[MESON_TAC[]]); ];; let higher_conjs = [ prove_by_refinement (`!C u t. ((mark_term u = t) ==> C (mark_term u)) <=> ((mark_term u = t) ==> C (t:A))`,[MESON_TAC[mark_term]]); prove_by_refinement (`!C u t. ((mark_term u = t) /\ C (mark_term u)) <=> ((mark_term u = t) /\ C (t:A))`,[MESON_TAC[mark_term]]); ];; let dropq_conv = let drop_exist = REWRITE_CONV [prove_by_refinement (`!t. ?(u:A). (u = t)`,[MESON_TAC[]])] in fun qname tm -> let quanlist = getquants tm in let quantleft_CONV = EVERY_CONV (map (REPEATC o quant_left_noswap_CONV) quanlist) in let qname_conv tm = prove(mk_eq(tm,markq qname tm), REWRITE_TAC[mark_term]) in let conj_conv = REWRITE_CONV rewrite_conjs in let quantright_CONV = (REPEATC (quant_right_CONV qname)) in let drop_mark_CONV = REWRITE_CONV [mark_term] in (quantleft_CONV THENC qname_conv THENC conj_conv THENC (ONCE_REWRITE_CONV higher_conjs) THENC drop_mark_CONV THENC quantright_CONV THENC drop_exist ) tm ;; (* Examples : *) dropq_conv "u" `!P Q R . (?(u:B). (?(x:A). (u = P x) /\ (Q x)) /\ (R u))`;; dropq_conv "t" `!P Q R. (!(t:B). (?(x:A). P x /\ (t = Q x)) ==> R t)`;; dropq_conv "u" `?u v. ((t * (a + &1) + (&1 - t) *a = u) /\ (t * (b + &0) + (&1 - t) * b = v)) /\ a < u /\ u < r /\ (v = b)`;; (* ------------------------------------------------------------------ *) (* SOME GENERAL TACTICS FOR THE ASSUMPTION LIST *) (* ------------------------------------------------------------------ *) let (%) i = HYP (string_of_int i);; let WITH i rule = (H_VAL (rule) (HYP (string_of_int i))) ;; let (UND:int -> tactic) = fun i (asl,w) -> let name = "Z-"^(string_of_int i) in try let thm= assoc name asl in let tm = concl (thm) in let (_,asl') = partition (fun t-> ((=) name (fst t))) asl in null_meta,[asl',mk_imp(tm,w)], fun i [th] -> MP th (INSTANTIATE_ALL i thm) with Failure _ -> failwith "UND";; let KILL i = (UND i) THEN (DISCH_THEN (fun t -> ALL_TAC));; let USE i rule = (WITH i rule) THEN (KILL i);; let CHO i = (UND i) THEN (DISCH_THEN CHOOSE_TAC);; let X_CHO i t = (UND i) THEN (DISCH_THEN (X_CHOOSE_TAC t));; let AND i = (UND i) THEN (DISCH_THEN (fun t-> (ASSUME_TAC (CONJUNCT1 t) THEN (ASSUME_TAC (CONJUNCT2 t)))));; let JOIN i j = (H_VAL2 CONJ ((%)i) ((%)j)) THEN (KILL i) THEN (KILL j);; let COPY i = WITH i I;; let REP n tac = EVERY (replicate tac n);; let REWR i = (UND i) THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC;; let LEFT i t = (USE i (CONV_RULE (quant_left_CONV t)));; let RIGHT i t = (USE i (CONV_RULE (quant_right_CONV t)));; let LEFT_TAC t = ((CONV_TAC (quant_left_CONV t)));; let RIGHT_TAC t = ( (CONV_TAC (quant_right_CONV t)));; let INR = REWRITE_RULE[IN];; (* let rec REP n tac = if (n<=0) then ALL_TAC else (tac THEN (REP (n-1) tac));; (* doesn't seem to work? *) let COPY i = (UNDISCH_WITH i) THEN (DISCH_THEN (fun t->ALL_TAC));; MANIPULATING ASSUMPTIONS. (MAKE 0= GOAL) COPY: int -> tactic Make a copy in adjacent slot. EXPAND: int -> tactic. conjunction -> two separate. exists/goal-forall -> choose. goal-if-then -> discharge EXPAND_TERM: int -> term -> tactic. constant -> expand definition || other rewrites associated. ADD: term -> tactic. SIMPLIFY: int -> tactic. Apply simplification rules. *) let CONTRAPOSITIVE_TAC = MATCH_MP_TAC (TAUT `(~q ==> ~p) ==> (p ==> q)`) THEN REWRITE_TAC[];; let REWRT_TAC = (fun t-> REWRITE_TAC[t]);; let (REDUCE_CONV,REDUCE_TAC) = let list = [ (* reals *) REAL_NEG_GE0; REAL_HALF_DOUBLE; REAL_SUB_REFL ; REAL_NEG_NEG; REAL_LE; LE_0; REAL_ADD_LINV;REAL_ADD_RINV; REAL_NEG_0; REAL_NEG_LE0; REAL_NEG_GE0; REAL_LE_NEGL; REAL_LE_NEGR; REAL_LE_NEG; REAL_NEG_EQ_0; REAL_SUB_RNEG; REAL_ARITH `!(x:real). (--x = x) <=> (x = &.0)`; REAL_ARITH `!(a:real) b. (a - b + b) = a`; REAL_ADD_LID; REAL_ADD_RID ; REAL_INV_0; REAL_OF_NUM_EQ; REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_POS; REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_LE_01; REAL_SUB_RZERO; REAL_LE_SQUARE; REAL_MUL_RID; REAL_MUL_LID; REAL_ABS_ZERO; REAL_ABS_NUM; REAL_ABS_1; REAL_ABS_NEG; REAL_ABS_POS; ABS_ZERO; ABS_ABS; REAL_NEG_LT0; REAL_NEG_GT0; REAL_LT_NEG; REAL_NEG_MUL2; REAL_OF_NUM_POW; REAL_LT_INV_EQ; REAL_POW_1; REAL_INV2; prove (`(--. (&.n) < (&.m)) <=> (&.0 < (&.n) + (&.m))`,REAL_ARITH_TAC); prove (`(--. (&.n) <= (&.m)) <=> (&.0 <= (&.n) + (&.m))`,REAL_ARITH_TAC); prove (`(--. (&.n) = (&.m)) <=> ((&.n) + (&.m) = (&.0))`,REAL_ARITH_TAC); prove (`((&.n) < --.(&.m)) <=> ((&.n) + (&.m) <. (&.0))`,REAL_ARITH_TAC); prove (`((&.n) <= --.(&.m)) <=> ((&.n) + (&.m) <=. (&.0))`,REAL_ARITH_TAC); prove (`((&.n) = --.(&.m)) <=> ((&.n) + (&.m) = (&.0))`,REAL_ARITH_TAC); prove (`((&.n) < --.(&.m) + &.r) <=> ((&.n) + (&.m) < (&.r))`,REAL_ARITH_TAC); prove (`(--. x = --. y) <=> (x = y)`,REAL_ARITH_TAC); prove (`(--(&.n) < --.(&.m) + &.r) <=> ( (&.m) < &.n + (&.r))`,REAL_ARITH_TAC); prove (`(--. x = --. y) <=> (x = y)`,REAL_ARITH_TAC); prove (`((--. (&.1))* x < --. y <=> y < x)`,REAL_ARITH_TAC ); prove (`((--. (&.1))* x <= --. y <=> y <= x)`,REAL_ARITH_TAC ); (* num *) EXP_1; EXP_LT_0; ADD_0; ARITH_RULE `0+| m = m`; ADD_EQ_0; prove (`(0 = m +|n) <=> (m = 0)/\ (n=0)`,MESON_TAC[ADD_EQ_0]); EQ_ADD_LCANCEL_0; EQ_ADD_RCANCEL_0; LT_ADD; LT_ADDR; ARITH_RULE `(0 = j -| i) <=> (j <=| i)`; ARITH_RULE `(j -| i = 0) <=> (j <=| i)`; ARITH_RULE `0 -| i = 0`; ARITH_RULE `(i<=| j) /\ (j <=| i) <=> (i = j)`; ARITH_RULE `0 <| 1`; (* SUC *) NOT_SUC; SUC_INJ; PRE; ADD_CLAUSES; MULT; MULT_CLAUSES; LE; LT; ARITH_RULE `SUC b -| 1 = b`; ARITH_RULE `SUC b -| b = 1`; prove(`&.(SUC x) - &.x = &.1`, REWRITE_TAC [REAL_ARITH `(a -. b=c) <=> (a = b+.c)`; REAL_OF_NUM_ADD;REAL_OF_NUM_EQ] THEN ARITH_TAC); (* (o) *) o_DEF; (* I *) I_THM; I_O_ID; (* pow *) REAL_POW_1; REAL_POW_ONE; (* INT *) INT_ADD_LINV; INT_ADD_RINV; INT_ADD_SUB2; INT_EQ_NEG2; INT_LE_NEG; INT_LE_NEGL; INT_LE_NEGR; INT_LT_NEG; INT_LT_NEG2; INT_NEGNEG; INT_NEG_0; INT_NEG_EQ_0; INT_NEG_GE0; INT_NEG_GT0; INT_NEG_LE0; INT_NEG_LT0; GSYM INT_NEG_MINUS1; INT_NEG_MUL2; INT_NEG_NEG; (* sets *) ] in (REWRITE_CONV list,REWRITE_TAC list);; (* prove by squaring *) let REAL_POW_2_LE = prove_by_refinement( `!x y. (&.0 <= x) /\ (&.0 <= y) /\ (x pow 2 <=. y pow 2) ==> (x <=. y)`, (* {{{ proof *) [ DISCH_ALL_TAC; MP_TAC (SPECL[` (x:real) pow 2`;`(y:real)pow 2`] SQRT_MONO_LE); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[REAL_POW_LE]; ASM_SIMP_TAC[POW_2_SQRT]; ]);; (* }}} *) (* prove by squaring *) let REAL_POW_2_LT = prove_by_refinement( `!x y. (&.0 <= x) /\ (&.0 <= y) /\ (x pow 2 <. y pow 2) ==> (x <. y)`, (* {{{ proof *) [ DISCH_ALL_TAC; MP_TAC (SPECL[` (x:real) pow 2`;`(y:real)pow 2`] SQRT_MONO_LT); ASM_REWRITE_TAC[]; ASM_SIMP_TAC[REAL_POW_LE]; ASM_SIMP_TAC[POW_2_SQRT]; ]);; (* }}} *) let SQUARE_TAC = FIRST[ MATCH_MP_TAC REAL_LE_LSQRT; MATCH_MP_TAC REAL_POW_2_LT; MATCH_MP_TAC REAL_POW_2_LE ] THEN REWRITE_TAC[];; (****) let SPEC2_TAC t = SPEC_TAC (t,t);; let IN_ELIM i = (USE i (REWRITE_RULE[IN]));; let rec range i n = if (n>0) then (i::(range (i+1) (n-1))) else [];; (* in elimination *) let (IN_OUT_TAC: tactic) = fun (asl,g) -> (REWRITE_TAC [IN] THEN (EVERY (map (IN_ELIM) (range 0 (length asl))))) (asl,g);; let (IWRITE_TAC : thm list -> tactic) = fun thlist -> REWRITE_TAC (map INR thlist);; let (IWRITE_RULE : thm list -> thm -> thm) = fun thlist -> REWRITE_RULE (map INR thlist);; let IMATCH_MP imp ant = MATCH_MP (INR imp) (INR ant);; let IMATCH_MP_TAC imp = MATCH_MP_TAC (INR imp);; let GBETA_TAC = (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));; let GBETA_RULE = (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV));; (* breaks antecedent into multiple cases *) let REP_CASES_TAC = REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC));; let TSPEC t i = TYPE_THEN t (USE i o SPEC);; let IMP_REAL t i = (USE i (MATCH_MP (REAL_ARITH t)));; (* goes from f = g to fz = gz *) let TAPP z i = TYPE_THEN z (fun u -> (USE i(fun t -> AP_THM t u)));; (* ONE NEW TACTIC -- DOESN'T WORK!! DON'T USE.... let CONCL_TAC t = let co = snd (dest_imp (concl t)) in SUBGOAL_TAC co THEN (TRY (IMATCH_MP_TAC t));; *) (* subgoal the antecedent of a THM, in order to USE the conclusion *) let ANT_TAC t = let (ant,co) = (dest_imp (concl t)) in SUBGOAL_TAC ant THENL [ALL_TAC;DISCH_THEN (fun u-> MP_TAC (MATCH_MP t u))];; let TH_INTRO_TAC tl th = TYPEL_THEN tl (fun t-> ANT_TAC (ISPECL t th));; let THM_INTRO_TAC tl th = TYPEL_THEN tl (fun t-> let s = ISPECL t th in if is_imp (concl s) then ANT_TAC s else ASSUME_TAC s);; let (DISCH_THEN_FULL_REWRITE:tactic) = DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));; let FULL_REWRITE_TAC t = (REWRITE_TAC t THEN (RULE_ASSUM_TAC (REWRITE_RULE t)));; (* ------------------------------------------------------------------ *) let BASIC_TAC = [ GEN_TAC; IMATCH_MP_TAC (TAUT ` (a ==> b ==> C) ==> ( a /\ b ==> C)`); DISCH_THEN (CHOOSE_THEN MP_TAC); FIRST_ASSUM (fun t-> UNDISCH_TAC (concl t) THEN (DISCH_THEN CHOOSE_TAC)); FIRST_ASSUM (fun t -> (if (length (CONJUNCTS t) < 2) then failwith "BASIC_TAC" else UNDISCH_TAC (concl t))); DISCH_TAC; ];; let REP_BASIC_TAC = REPEAT (CHANGED_TAC (FIRST BASIC_TAC));; (* ------------------------------------------------------------------ *) let USE_FIRST rule = FIRST_ASSUM (fun t -> (UNDISCH_TAC (concl t) THEN (DISCH_THEN (ASSUME_TAC o rule))));; let WITH_FIRST rule = FIRST_ASSUM (fun t -> ASSUME_TAC (rule t));; let UNDF t = (TYPE_THEN t UNDISCH_FIND_TAC );; let GRABF t ttac = (UNDF t THEN (DISCH_THEN ttac));; let USEF t rule = (TYPE_THEN t (fun t' -> UNDISCH_FIND_THEN t' (fun u -> ASSUME_TAC (rule u))));; (* ------------------------------------------------------------------ *) (* UNIFY_EXISTS_TAC *) (* ------------------------------------------------------------------ *) let rec EXISTSL_TAC tml = match tml with a::tml' -> EXISTS_TAC a THEN EXISTSL_TAC tml' | [] -> ALL_TAC;; (* Goal: ?x1....xn. P1 /\ ... /\ Pm Try to pick ALL of x1...xn to unify ONE or more Pi with terms appearing in the assumption list, trying term_unify on each Pi with each assumption. *) let (UNIFY_EXISTS_TAC:tactic) = let run_one wc assum (varl,sofar) = if varl = [] then (varl,sofar) else try ( let wc' = instantiate ([],sofar,[]) wc in let (_,ins,_) = term_unify varl wc' assum in let insv = map snd ins in ( subtract varl insv , union sofar ins ) ) with failure -> (varl,sofar) in let run_onel asl wc (varl,sofar) = itlist (run_one wc) asl (varl,sofar) in let run_all varl sofar wcl asl = itlist (run_onel asl) wcl (varl,sofar) in let full_unify (asl,w) = let (varl,ws) = strip_exists w in let vargl = map genvar (map type_of varl) in let wg = instantiate ([],zip vargl varl,[]) ws in let wcg = conjuncts wg in let (vargl',sofar) = run_all vargl [] wcg ( asl) in if (vargl' = []) then map (C rev_assoc sofar) (map (C rev_assoc (zip vargl varl)) varl) else failwith "full_unify: unification not found " in fun (asl,w) -> try( let asl' = map (concl o snd) asl in let asl'' = flat (map (conjuncts ) asl') in let varsub = full_unify (asl'',w) in EXISTSL_TAC varsub (asl,w) ) with failure -> failwith "UNIFY_EXIST_TAC: unification not found.";; (* partial example *) let unify_exists_tac_example = try(prove_by_refinement( `!C a b v A R TX U SS. (A v /\ (a = v) /\ (C:num->num->bool) a b /\ R a ==> ?v v'. TX v' /\ U v v' /\ C v' v /\ SS v)`, (* {{{ proof *) [ REP_BASIC_TAC; UNIFY_EXISTS_TAC; (* v' -> a and v -> b *) (* not finished. Here is a variant approach. *) REP_GEN_TAC; DISCH_TAC; UNIFY_EXISTS_TAC; ])) with failure -> (REFL `T`);; (* }}} *) (* ------------------------------------------------------------------ *) (* UNIFY_EXISTS conversion *) (* ------------------------------------------------------------------ *) (* FIRST argument is the "certificate" second arg is the goal. Example: UNIFY_EXISTS `(f:num->bool) x` `?t. (f:num->bool) t` *) let (UNIFY_EXISTS:thm -> term -> thm) = let run_one wc assum (varl,sofar) = if varl = [] then (varl,sofar) else try ( let wc' = instantiate ([],sofar,[]) wc in let (_,ins,_) = term_unify varl wc' assum in let insv = map snd ins in ( subtract varl insv , union sofar ins ) ) with failure -> (varl,sofar) in let run_onel asl wc (varl,sofar) = itlist (run_one wc) asl (varl,sofar) in let run_all varl sofar wcl asl = itlist (run_onel asl) wcl (varl,sofar) in let full_unify (t,w) = let (varl,ws) = strip_exists w in let vargl = map genvar (map type_of varl) in let wg = instantiate ([],zip vargl varl,[]) ws in let wcg = conjuncts wg in let (vargl',sofar) = run_all vargl [] wcg ( [concl t]) in if (vargl' = []) then map (C rev_assoc sofar) (map (C rev_assoc (zip vargl varl)) varl) else failwith "full_unify: unification not found " in fun t w -> try( if not(is_exists w) then failwith "UNIFY_EXISTS: not EXISTS" else let varl' = (full_unify (t,w)) in let (varl,ws) = strip_exists w in let varsub = zip varl' varl in let varlb = map (fun s-> chop_list s (rev varl)) (range 1 (length varl)) in let targets = map (fun s-> (instantiate ([],varsub,[]) (list_mk_exists( rev (fst s), ws)) )) varlb in let target_zip = zip (rev targets) varl' in itlist (fun s th -> EXISTS s th) target_zip t ) with failure -> failwith "UNIFY_EXISTS: unification not found.";; let unify_exists_example= UNIFY_EXISTS (ARITH_RULE `2 = 0+2`) `(?x y. ((x:num) = y))`;; (* now make a prover for it *) (* ------------------------------------------------------------------ *) (* drop_ant_tac replaces 0 A ==>B 1 A with 0 B 1 A in hypothesis list *) let DROP_ANT_TAC pq = UNDISCH_TAC pq THEN (UNDISCH_TAC (fst (dest_imp pq))) THEN DISCH_THEN (fun pthm -> ASSUME_TAC pthm THEN DISCH_THEN (fun pqthm -> ASSUME_TAC (MATCH_MP pqthm pthm )));; let (DROP_ALL_ANT_TAC:tactic) = fun (asl,w) -> let imps = filter (is_imp) (map (concl o snd) asl) in MAP_EVERY (TRY o DROP_ANT_TAC) imps (asl,w);; let drop_ant_tac_example = prove_by_refinement( `!A B C D E. (A /\ (A ==> B) /\ (C ==>D) /\ C) ==> (E \/ C \/ B)`, (* {{{ proof *) [ REP_BASIC_TAC; DROP_ALL_ANT_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) (* ------------------------------------------------------------------ *) (* ASSUME tm, then prove it later. almost the same as asm-cases-tac *) let (BACK_TAC : term -> tactic) = fun tm (asl,w) -> let ng = mk_imp (tm,w) in (SUBGOAL_TAC ng THENL [ALL_TAC;DISCH_THEN IMATCH_MP_TAC ]) (asl,w);; (* --- *) (* Using hash numbers for tactics *) (* --- *) let label_of_hash ((asl,g):goal) (h:int) = let one_label h (s,tm) = if (h = hash_of_term (concl tm)) then let s1 = String.sub s 2 (String.length s - 2) in int_of_string s1 else failwith "label_of_hash" in tryfind (one_label h) asl;; let HASHIFY m h w = m (label_of_hash w h) w;; let UNDH = HASHIFY UND;; let REWRH = HASHIFY REWR;; let KILLH = HASHIFY KILL;; let COPYH = HASHIFY COPY;; let HASHIFY1 m h tm w = m (label_of_hash w h) tm w;; let USEH = HASHIFY1 USE;; let LEFTH = HASHIFY1 LEFT;; let RIGHTH = HASHIFY1 RIGHT;; let TSPECH tm h w = TSPEC tm (label_of_hash w h) w ;; hol-light/Jordan/tactics_fix.ml000066400000000000000000000103651303454263000170210ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* A printer for goals etc. *) (* ------------------------------------------------------------------------- *) (* had (rev asl) in this method. I don't want to reverse the list *) let hash_of_string = let prime200 = 1223 in let prime = 8831 in let rec hashll v = match v with | [] -> 0 | h::t -> (int_of_char (String.get h 0) + prime200*( hashll t)) mod prime in fun s -> let slt = explode s in hashll slt;; let saved_hashstring = ref ((Hashtbl.create 300):(string,int) Hashtbl.t);; let save_hashstring string = Hashtbl.add !saved_hashstring (string) (hash_of_string string);; let mem_hashstring s = Hashtbl.mem !saved_hashstring s;; let remove_hashstring s = Hashtbl.remove !saved_hashstring s;; let find_hashstring s = Hashtbl.find !saved_hashstring s;; let memhash_of_string s = if not(mem_hashstring s) then (save_hashstring s) ; find_hashstring s;; let hash_of_type = let prime150 = 863 in let prime160 = 941 in let prime180 = 1069 in let prime190 = 1151 in let prime1200 = 9733 in let rec hashl u = match u with | [] -> 0 | h::t -> ((hasht h) + prime190*(hashl t)) mod prime1200 and hasht v = match v with | Tyvar s -> (prime150*memhash_of_string s + prime160) mod prime1200 | Tyapp (s,tlt) -> let h = memhash_of_string s in let h2 = (h*h) mod prime1200 in (prime180*h2 + hashl tlt ) mod prime1200 in hasht;; (* make hash_of_term constant on alpha-equivalence classes of terms *) let rename_var n = fun v -> mk_var ("??_"^(string_of_int n),type_of v);; let paform = let rec raform n env tm = match tm with | Var(_,_) -> assocd tm env tm | Const(_,_) -> tm | Comb (s,t) -> mk_comb(raform n env s, raform n env t) | Abs (x,t) -> let x1 = rename_var n x in mk_abs(x1, raform (n+1) ((x,x1)::env) t) in raform 0 [];; let hash_of_term = let prime1220 = 9887 in let prime210 = 1291 in let prime220 = 1373 in let prime230 = 1451 in let prime240 = 1511 in let prime250 = 1583 in let prime260 = 1657 in let prime270 = 1733 in let prime280 = 1811 in let rec hasht u = match u with | Var (s,t) -> (prime210*(memhash_of_string s) + hash_of_type t) mod prime1220 | Const (s,t) -> (prime220*(memhash_of_string s) + hash_of_type t) mod prime1220 | Comb (s,t) -> let h = hasht s in let h2 = (h*h) mod prime1220 in (prime230*h2 + prime240*hasht t + prime250) mod prime1220 | Abs (s,t) -> let h = hasht s in let h2 = (h*h) mod prime1220 in (prime260*h2 + prime270*hasht t + prime280) mod prime1220 in hasht o paform;; let print_hyp n (s,th) = open_hbox(); print_string " "; print_as 4 (string_of_int (hash_of_term (concl th))); print_string " ["; print_qterm (concl th); print_string "]"; (if not (s = "") then (print_string (" ("^s^")")) else ()); close_box(); print_newline();; let rec print_hyps n asl = if asl = [] then () else (print_hyp n (hd asl); print_hyps (n + 1) (tl asl));; let (print_goal_hashed:goal->unit) = fun (asl,w) -> print_newline(); if asl <> [] then (print_hyps 0 (asl); print_newline()) else (); print_qterm w; print_newline();; let (print_goalstate_hashed:int->goalstate->unit) = fun k gs -> let (_,gl,_) = gs in let n = length gl in let s = if n = 0 then "No subgoals" else (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") ^" ("^(string_of_int n)^" total)" in print_string s; print_newline(); if gl = [] then () else do_list (print_goal_hashed o C el gl) (rev(0--(k-1)));; let (print_goalstack_hashed:goalstack->unit) = fun l -> if l = [] then print_string "Empty goalstack" else if tl l = [] then let (_,gl,_ as gs) = hd l in print_goalstate_hashed 1 gs else let (_,gl,_ as gs) = hd l and (_,gl0,_) = hd(tl l) in let p = length gl - length gl0 in let p' = if p < 1 then 1 else p + 1 in print_goalstate_hashed p' gs;; #install_printer print_goal_hashed;; #install_printer print_goalstack_hashed;; hol-light/Jordan/tactics_refine.ml000066400000000000000000000066431303454263000175070ustar00rootroot00000000000000 (* ------------------------------------------------------------------ *) (* This bundles an interactive session into a proof. *) (* ------------------------------------------------------------------ *) let labels_flag = ref false;; let LABEL_ALL_TAC:tactic = let mk_label avoid = let rec mk_one_label i avoid = let label = "Z-"^(string_of_int i) in if not(mem label avoid) then label else mk_one_label (i+1) avoid in mk_one_label 0 avoid in let update_label i asl = let rec f_at_i f j = function [] -> [] | a::b -> if (j=0) then (f a)::b else a::(f_at_i f (j-1) b) in let avoid = map fst asl in let current = el i avoid in let new_label = mk_label avoid in if (String.length current > 0) then asl else f_at_i (fun (_,y) -> (new_label,y) ) i asl in fun (asl,w) -> let aslp = ref asl in (for i=0 to ((length asl)-1) do (aslp := update_label i !aslp) done; (ALL_TAC (!aslp,w)));; (* global_var *) let (EVERY_STEP_TAC:tactic ref) = ref ALL_TAC;; let (e:tactic ->goalstack) = fun tac -> refine(by(VALID (if !labels_flag then (tac THEN (!EVERY_STEP_TAC)) THEN LABEL_ALL_TAC else tac)));; let has_stv t = let typ = (type_vars_in_term t) in can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;; let prove_by_refinement(t,(tacl:tactic list)) = if (length (frees t) > 0) then failwith "prove_by_refinement: free vars" else if (has_stv t) then failwith "prove_by_refinement: has stv" else let gstate = mk_goalstate ([],t) in let _,sgs,just = rev_itlist (fun tac gs -> by (if !labels_flag then (tac THEN (!EVERY_STEP_TAC) THEN LABEL_ALL_TAC ) else tac) gs) tacl gstate in let th = if sgs = [] then just null_inst [] else failwith "BY_REFINEMENT_PROOF: Unsolved goals" in let t' = concl th in if t' = t then th else try EQ_MP (ALPHA t' t) th with Failure _ -> failwith "prove_by_refinement: generated wrong theorem";; (* ------------------------------------------------------------------ *) (* DUMPING AND PRELOADED THEOREMS *) (* ------------------------------------------------------------------ *) let saved_thm = ref ((Hashtbl.create 300):(term,thm) Hashtbl.t);; let save_thm thm = Hashtbl.add !saved_thm (concl thm) thm;; let mem_thm tm = Hashtbl.mem !saved_thm tm;; let remove_thm tm = Hashtbl.remove !saved_thm tm;; let find_thm tm = Hashtbl.find !saved_thm tm;; let dump_thm file_name = let ch = open_out_bin file_name in (output_value ch !saved_thm; close_out ch);; let load_thm file_name = let ch = open_in_bin file_name in (saved_thm := input_value ch; close_in ch);; (* ------------------------------------------------------------------ *) (* PROOFS STORED. *) (* ------------------------------------------------------------------ *) let old_prove = prove;; let old_prove_by_refinement = prove_by_refinement;; let fast_load = ref true;; let set_fast_load file_name = (fast_load := true; load_thm file_name);; let set_slow_load () = (fast_load := false;);; let prove (x, tac) = if (!fast_load) then (try(find_thm x) with failure -> old_prove(x,tac)) else (let t = old_prove(x,tac) in (save_thm t; t));; let prove_by_refinement (x, tacl) = if (!fast_load) then (try(find_thm x) with failure -> old_prove_by_refinement(x,tacl)) else (let t = old_prove_by_refinement(x,tacl) in (save_thm t; t));; if (false) then (set_fast_load "thm.dump") else (fast_load:=false);; hol-light/LICENSE000066400000000000000000000031371303454263000137560ustar00rootroot00000000000000 HOL Light copyright notice, licence and disclaimer (c) University of Cambridge 1998 (c) Copyright, John Harrison and others 1998-2012 Some files in this package are distributed under other licenses; please check individual files or subdirectories for such cases. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: o Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. o Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hol-light/LP_arith/000077500000000000000000000000001303454263000144475ustar00rootroot00000000000000hol-light/LP_arith/Makefile000066400000000000000000000006301303454263000161060ustar00rootroot00000000000000 CDDLIBPATH=/usr/local/lib GXX = g++ CC = $(GXX) CCLD = $(CC) .SUFFIXES: .c .o COMPILE = $(CC) -O2 -DHAVE_LIBGMP=1 -DGMPRATIONAL -I. -I$(CDDLIBPATH) LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ .c.o: $(COMPILE) -c `test -f '$<' || echo ''`$< all: cdd_cert cdd_cert: cdd_cert.o $(LINK) cdd_cert.o $(CDDLIBPATH)/libcddgmp.a -l gmp clean: rm -f *~ *.o cdd_cert cdd_cert.exe hol-light/LP_arith/README000066400000000000000000000004331303454263000153270ustar00rootroot00000000000000HOL interface to cddlib to provide a faster linear prover. http://www.ifor.math.ethz.ch/~fukuda/cdd_home/ Once cddlib is installed, just do "make" in this directory, and then load "LP_arith/lp_arith.ml" into HOL Light. (c) Lars Schewe (schewe@mathematik.tu-darmstadt.de), 2007 hol-light/LP_arith/cdd_cert.c000066400000000000000000000031051303454263000163610ustar00rootroot00000000000000/* This is my first try to write a certificate generator, borrows from examples in the cddlib-distribution LS */ #include "setoper.h" #include "cdd.h" void nocontra() { printf("No Contradiction\n"); return; } void printsol(dd_LPSolutionPtr lps) { dd_colrange j; for (j=1; jd; j++) { dd_WriteNumber(stdout,lps->sol[j]); } printf("\n"); return; } int main(int argc, char *argv[]) { dd_ErrorType err=dd_NoError; dd_LPSolverType solver=dd_DualSimplex; dd_LPPtr lp; dd_LPSolutionPtr lps; dd_MatrixPtr M; int found_contradiction=0; dd_set_global_constants(); /* Input an LP using the cdd library */ if (err!=dd_NoError) goto _Err; M=dd_PolyFile2Matrix(stdin, &err); if (err!=dd_NoError) goto _Err; lp=dd_Matrix2LP(M, &err); if (err!=dd_NoError) goto _Err; /* Solve the LP */ dd_LPSolve(lp, solver, &err); /* Solve the LP */ if (err!=dd_NoError) goto _Err; /* process solution */ lps=dd_CopyLPSolution(lp); switch (lps->LPS) { case dd_Optimal: found_contradiction=dd_EqualToZero(lps->optvalue)?1:0; break; case dd_DualInconsistent: case dd_StrucDualInconsistent: found_contradiction=1; break; case dd_Inconsistent: case dd_StrucInconsistent: default: nocontra(); } if (found_contradiction) { printsol(lps); } else { nocontra(); } /* free allocated space */ dd_FreeLPSolution(lps); dd_FreeLPData(lp); dd_FreeMatrix(M); return 0; _Err:; if (err!=dd_NoError) dd_WriteErrorMessages(stdout, err); return 1; } hol-light/LP_arith/lp_arith.ml000066400000000000000000000122541303454263000166070ustar00rootroot00000000000000 (* small LP-based prover, to convert the HOL-terms to a coefficient matrix and back it uses the code of REAL_LINEAR_PROVER in the HOL Light distribution *) let cddwrapper = "cdd_cert";; (* in lin_of_hol one can replace the call to linear_add to a call to lin_add *) let lin_of_hol = let one_tm = `&1:real` and zero_tm = `&0:real` and add_tm = `(+):real->real->real` and mul_tm = `(*):real->real->real` and lin_add = combine (+/) (fun x -> x =/ num_0) in let rec lin_of_hol tm = if tm = zero_tm then undefined else if not (is_comb tm) then (tm |=> Int 1) else if is_ratconst tm then (one_tm |=> rat_of_term tm) else let lop,r = dest_comb tm in if not (is_comb lop) then (tm |=> Int 1) else let op,l = dest_comb lop in if op = add_tm then lin_add (lin_of_hol l) (lin_of_hol r) else if op = mul_tm && is_ratconst l then (r |=> rat_of_term l) else (tm |=> Int 1) in lin_of_hol;; let words s = let stre = Stream.of_string s in let is_empty st = match Stream.peek st with None -> true | Some _ -> false in let rec sb acc st = if is_empty st then [acc] else let t = Stream.next st in if t = ' ' then acc :: (sb "" st) else sb (acc ^ Char.escaped t) st in filter (fun x -> x <> "") (sb "" stre);; let cdd ins = let outfn = Filename.temp_file "cdd" ".res" and infn = Filename.temp_file "cdd" ".ine" in let s = "cat " ^ infn ^ "| " ^ cddwrapper ^ " 2> /dev/null > " ^ outfn in let inch = open_out infn in output_string inch ins; close_out inch; if Sys.command s <> 0 then failwith "cdd" else let fd = Pervasives.open_in outfn in let data = input_line fd in close_in fd; Sys.remove infn; Sys.remove outfn; data;; let rec take n l = match l with x :: xs -> if n = 0 then [] else x :: (take (n-1) xs) | [] -> [];; let rec drop n l = match l with x :: xs -> if n = 0 then l else (drop (n-1) xs) | [] -> [];; let lp_prover (eq,le,lt) = let one_tm = `&1:real` in let vars = (subtract (itlist (union o dom) (eq@le@lt) []) [one_tm]) in let neq = length eq and nle = length le and nlt = length lt and nr = length (eq@le@lt) in let get_row v = map (fun x -> applyd x (fun _ -> num_0) v) (eq@le@lt) in let rec rep n e = if n = 0 then [] else e :: (rep (n-1) e) in let one_at n = map (fun i -> (rep i (num_0))@[num_1]@(rep (n-i-1) (num_0))) (0--(n-1)) in let main_rows = map ((fun l -> num_0::l) o get_row) vars and lt_row = [minus_num num_1] @ (rep (length eq) num_0) @ (rep (length le) num_0) @ (rep (length lt) num_1) and pos_rows = map (fun l -> (rep (length eq + 1 ) num_0) @ l) (one_at (length (le@lt))) and bvec = (num_0 :: (get_row one_tm)) in let mat = main_rows@[lt_row]@pos_rows in let string_of_row = (String.concat " ") o (map string_of_num) in let cddlp = (String.concat "\n" ["H-representation"; "linearity "^(string_of_int (length main_rows))^" "^ (String.concat " " (map string_of_int (1--(length main_rows)))); "begin"; String.concat " " [string_of_int (length mat);string_of_int (nr+1);"rational"]; String.concat "\n" (map string_of_row mat); "end"; String.concat " " ["minimize";string_of_row bvec]]) in let outp = (cdd cddlp) in let res = (* print_string cddlp; print_newline(); *)(* print_string outp; print_newline(); *) if outp = "No Contradiction" then failwith "No contradiction" else map Num.num_of_string (words outp) in let (req,rle,rlt) = (take neq res, take nle (drop neq res), take nlt (drop (nle+neq) res)) in let peq = map2 (fun r e -> if (r =/ num_0) then [] else [Eqmul (term_of_rat r, Axiom_eq e)]) req (0--(neq-1)) and ple = map2 (fun r e -> if (r =/ num_0) then [] else [Product (Rational_lt r,Axiom_le e)]) rle (0--(nle-1)) and plt = map2 (fun r e -> if (r =/ num_0) then [] else [Product (Rational_lt r,Axiom_lt e)]) rlt (0--(nlt-1)) in let pp = List.flatten (peq@ple@plt) in let refu = itlist (fun acc x -> Sum (acc,x)) (tl pp) (hd pp) in (* print_string outp; *) (* print_newline(); *) refu;; let LP_PROVER = let is_alien tm = match tm with Comb(Const("real_of_num",_),n) when not(is_numeral n) -> true | _ -> false in let n_tm = `n:num` in let pth = REWRITE_RULE[GSYM real_ge] (SPEC n_tm REAL_POS) in fun translator (eq,le,lt) -> let eq_pols = map (lin_of_hol o lhand o concl) eq and le_pols = map (lin_of_hol o lhand o concl) le and lt_pols = map (lin_of_hol o lhand o concl) lt in let aliens = filter is_alien (itlist (union o dom) (eq_pols @ le_pols @ lt_pols) []) in let le_pols' = le_pols @ map (fun v -> (v |=> Int 1)) aliens in let proof = lp_prover(eq_pols,le_pols',lt_pols) in let le' = le @ map (fun a -> INST [rand a,n_tm] pth) aliens in translator (eq,le',lt) proof;; let LP_ARITH = let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] and pure = GEN_REAL_ARITH LP_PROVER in fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; let LP_ARITH_TAC = CONV_TAC LP_ARITH;; hol-light/LP_arith/lp_tests.ml000066400000000000000000000045071303454263000166440ustar00rootroot00000000000000let rec_seq = ` !x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11:real. x3 = abs(x2) - x1 /\ x4 = abs(x3) - x2 /\ x5 = abs(x4) - x3 /\ x6 = abs(x5) - x4 /\ x7 = abs(x6) - x5 /\ x8 = abs(x7) - x6 /\ x9 = abs(x8) - x7 /\ x10 = abs(x9) - x8 /\ x11 = abs(x10) - x9 ==> x1 = x10 /\ x2 = x11`;; let test_std = `!a b c d. ((&0 + &1 * a + &0 * b + &0 * c + &0 * d >= &0) /\ (&0 + &0 * a + &1 * b + &0 * c + &0 * d >= &0) /\ (&0 + &0 * a + &0 * b + &1 * c + &0 * d >= &0) /\ (&0 + &0 * a + &0 * b + &0 * c + &1 * d >= &0) /\ (&0 + &3008 * a + &20980 * b + (-- &97775) * c + (-- &101225) * d >= &0) /\ (&0 + &3985 * a + &25643 * b + (-- &135871) * c + (-- &130580) * d >= &0) /\ (&0 + &4324 * a + &26978 * b + (-- &133655) * c + (-- &168473) * d >= &0) /\ (&0 + &3534 * a + &25361 * b + (-- &46243) * c + (-- &100407) * d >= &0) /\ (&0 + &8836 * a + &40796 * b + (-- &176661) * c + (-- &215616) * d >= &0) /\ (&0 + &5376 * a + &37562 * b + (-- &182576) * c + (-- &217615) * d >= &0) /\ (&0 + &4982 * a + &33088 * b + (-- &98880) * c + (-- &167278) * d >= &0) /\ (&0 + &4775 * a + &39122 * b + (-- &136701) * c + (-- &193393) * d >= &0) /\ (&0 + &8046 * a + &42958 * b + (-- &225138) * c + (-- &256575) * d >= &0) /\ (&0 + &8554 * a + &48955 * b + (-- &257370) * c + (-- &312877) * d >= &0) /\ (&0 + &6147 * a + &45514 * b + (-- &165274) * c + (-- &227099) * d >= &0) /\ (&0 + &8366 * a + &55140 * b + (-- &203989) * c + (-- &321623) * d >= &0) /\ (&0 + &13479 * a + &68037 * b + (-- &174270) * c + (-- &341743) * d >= &0) /\ (&0 + &21808 * a + &78302 * b + (-- &322990) * c + (-- &487539) * d >= &0) /\ (&1 + (-- &8554 / &10000) * a + (-- &48955 / &10000) * b + &0 * c + &0 * d >= &0) /\ (&1 + &0 * a + &0 * b + (-- &257370 / &10000) * c + (-- &312877 / &10000) * d >= &0)) ==> &1 * a + &1 / &2 * b + &1 / &3 * c + &1 / &4 * d <= &2057990000 / &1743360801`;; let gale = `~(?T14 T24 T25 T35 T46 T47 T57 T58. T14 < &20 /\ T24 + T25 < &20 /\ T35 < &20 /\ T14 + T24 - T46 - T47 = &0 /\ T25 + T35 - T57 - T58 = &0 /\ T46 > &10 /\ T47 + T57 > &20 /\ T58 > &30 /\ T14 < &30 /\ T24 < &20 /\ T25 < &10 /\ T35 < &10 /\ T46 < &10 /\ T47 < &2 /\ T57 < &20 /\ T58 < &30)`;; hol-light/LP_arith/make.ml000066400000000000000000000002461303454263000157200ustar00rootroot00000000000000loadt "LP_arith/lp_arith.ml";; loadt "LP_arith/lp_tests.ml";; time LP_ARITH rec_seq;; time LP_ARITH test_std;; time REAL_ARITH rec_seq;; time REAL_ARITH test_std;; hol-light/Library/000077500000000000000000000000001303454263000143515ustar00rootroot00000000000000hol-light/Library/agm.ml000066400000000000000000000146561303454263000154630ustar00rootroot00000000000000(* ========================================================================= *) (* Arithmetic-geometric mean inequality. *) (* ========================================================================= *) needs "Library/products.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Various trivial lemmas. *) (* ------------------------------------------------------------------------- *) let FORALL_2 = prove (`!P. (!i. 1 <= i /\ i <= 2 ==> P i) <=> P 1 /\ P 2`, MESON_TAC[ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`]);; let NUMSEG_2 = prove (`1..2 = {1,2}`, REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC);; let AGM_2 = prove (`!x y. x * y <= ((x + y) / &2) pow 2`, REWRITE_TAC[REAL_LE_SQUARE; REAL_ARITH `x * y <= ((x + y) / &2) pow 2 <=> &0 <= (x - y) * (x - y)`]);; let SUM_SPLIT_2 = prove (`sum(1..2*n) f = sum(1..n) f + sum(n+1..2*n) f`, SIMP_TAC[MULT_2; ARITH_RULE `1 <= n + 1`; SUM_ADD_SPLIT]);; let PRODUCT_SPLIT_2 = prove (`product(1..2*n) f = product(1..n) f * product(n+1..2*n) f`, SIMP_TAC[MULT_2; ARITH_RULE `1 <= n + 1`; PRODUCT_ADD_SPLIT]);; (* ------------------------------------------------------------------------- *) (* Specialized induction principle. *) (* ------------------------------------------------------------------------- *) let CAUCHY_INDUCT = prove (`!P. P 2 /\ (!n. P n ==> P(2 * n)) /\ (!n. P(n + 1) ==> P n) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `P(0) /\ P(1)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[ARITH_RULE `1 = 0 + 1 /\ 2 = 1 + 1`]; ALL_TAC] THEN ASM_CASES_TAC `EVEN n` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN ASM_MESON_TAC[ARITH_RULE `2 * n = 0 \/ n < 2 * n`]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN ASM_MESON_TAC[ARITH_RULE `SUC(2 * m) = 1 \/ m + 1 < SUC(2 * m)`; ARITH_RULE `SUC(2 * m) + 1 = 2 * (m + 1)`]);; (* ------------------------------------------------------------------------- *) (* The main result. *) (* ------------------------------------------------------------------------- *) let AGM = prove (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) ==> product(1..n) a <= (sum(1..n) a / &n) pow n`, MATCH_MP_TAC CAUCHY_INDUCT THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[FORALL_2; NUMSEG_2] THEN SIMP_TAC[SUM_CLAUSES; PRODUCT_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY; ARITH; REAL_MUL_RID; REAL_ADD_RID] THEN REWRITE_TAC[AGM_2]; X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN STRIP_TAC THEN REWRITE_TAC[SUM_SPLIT_2; PRODUCT_SPLIT_2] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(sum(1..n) a / &n) pow n * (sum(n+1..2*n) a / &n) pow n` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PRODUCT_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ASM_MESON_TAC[ARITH_RULE `i <= n ==> i <= 2 * n`]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[ARITH_RULE `i <= n ==> i <= 2 * n`; ARITH_RULE `1 <= 2 * n ==> 1 <= n`]; MATCH_MP_TAC PRODUCT_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ASM_MESON_TAC[ARITH_RULE `n + 1 <= i ==> 1 <= i`]; ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[MULT_2] THEN REWRITE_TAC[PRODUCT_OFFSET; SUM_OFFSET] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[ARITH_RULE `1 <= i /\ i <= n ==> 1 <= i + n /\ i + n <= 2 * n`; ARITH_RULE `1 <= 2 * n ==> 1 <= n`]]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_POW_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN SUBST1_TAC(REAL_ARITH `&2 * &n = &n * &2`) THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `(x + y) * (a * b) = (x * a + y * a) * b`] THEN REWRITE_TAC[GSYM real_div; AGM_2] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\i. if i <= n then a(i) else sum(1..n) a / &n`) THEN REWRITE_TAC[ARITH_RULE `1 <= n + 1`] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; IN_NUMSEG]; ALL_TAC] THEN ABBREV_TAC `A = sum(1..n) a / &n` THEN SIMP_TAC[GSYM ADD1; PRODUCT_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG] THEN SIMP_TAC[ARITH_RULE `1 <= SUC n /\ ~(SUC n <= n)`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN EXPAND_TAC "A" THEN SIMP_TAC[REAL_OF_NUM_LE; ASSUME `1 <= n`; REAL_FIELD `&1 <= &n ==> (s + s / &n) / (&n + &1) = s / &n`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[real_pow] THEN ASM_CASES_TAC `&0 < A` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN SUBGOAL_THEN `A = &0` MP_TAC THENL [ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM; GSYM REAL_NOT_LT] THEN REWRITE_TAC[REAL_NOT_LT] THEN EXPAND_TAC "A" THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; IN_NUMSEG]; ALL_TAC] THEN EXPAND_TAC "A" THEN REWRITE_TAC[real_div; REAL_ENTIRE; REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= n ==> ~(n = 0)`] THEN DISCH_TAC THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(SPECL [`a:num->real`; `1`; `n:num`] SUM_POS_EQ_0_NUMSEG) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LZERO; PRODUCT_CLAUSES_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n`; REAL_MUL_RZERO; REAL_LE_REFL]]);; hol-light/Library/analysis.ml000066400000000000000000011335161303454263000165400ustar00rootroot00000000000000(* ========================================================================= *) (* Elementary real analysis, with some supporting HOL88 compatibility stuff. *) (* ========================================================================= *) let dest_neg_imp tm = try dest_imp tm with Failure _ -> try (dest_neg tm,mk_const("F",[])) with Failure _ -> failwith "dest_neg_imp";; (* ------------------------------------------------------------------------- *) (* The quantifier movement conversions. *) (* ------------------------------------------------------------------------- *) let (CONV_OF_RCONV: conv -> conv) = let rec get_bv tm = if is_abs tm then bndvar tm else if is_comb tm then try get_bv (rand tm) with Failure _ -> get_bv (rator tm) else failwith "" in fun conv tm -> let v = get_bv tm in let th1 = conv tm in let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in TRANS th1 th2;; let (CONV_OF_THM: thm -> conv) = CONV_OF_RCONV o REWR_CONV;; let (X_FUN_EQ_CONV:term->conv) = fun v -> (REWR_CONV FUN_EQ_THM) THENC GEN_ALPHA_CONV v;; let (FUN_EQ_CONV:conv) = fun tm -> let vars = frees tm in let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in if op = "fun" then let varnm = if (is_vartype ty1) then "x" else hd(explode(fst(dest_type ty1))) in let x = variant vars (mk_var(varnm,ty1)) in X_FUN_EQ_CONV x tm else failwith "FUN_EQ_CONV";; let (SINGLE_DEPTH_CONV:conv->conv) = let rec SINGLE_DEPTH_CONV conv tm = try conv tm with Failure _ -> (SUB_CONV (SINGLE_DEPTH_CONV conv) THENC (TRY_CONV conv)) tm in SINGLE_DEPTH_CONV;; let (OLD_SKOLEM_CONV:conv) = SINGLE_DEPTH_CONV (REWR_CONV SKOLEM_THM);; let (X_SKOLEM_CONV:term->conv) = fun v -> OLD_SKOLEM_CONV THENC GEN_ALPHA_CONV v;; let EXISTS_UNIQUE_CONV tm = let v = bndvar(rand tm) in let th1 = REWR_CONV EXISTS_UNIQUE_THM tm in let tm1 = rhs(concl th1) in let vars = frees tm1 in let v = variant vars v in let v' = variant (v::vars) v in let th2 = (LAND_CONV(GEN_ALPHA_CONV v) THENC RAND_CONV(BINDER_CONV(GEN_ALPHA_CONV v') THENC GEN_ALPHA_CONV v)) tm1 in TRANS th1 th2;; let NOT_FORALL_CONV = CONV_OF_THM NOT_FORALL_THM;; let NOT_EXISTS_CONV = CONV_OF_THM NOT_EXISTS_THM;; let RIGHT_IMP_EXISTS_CONV = CONV_OF_THM RIGHT_IMP_EXISTS_THM;; let FORALL_IMP_CONV = CONV_OF_RCONV (REWR_CONV TRIV_FORALL_IMP_THM ORELSEC REWR_CONV RIGHT_FORALL_IMP_THM ORELSEC REWR_CONV LEFT_FORALL_IMP_THM);; let EXISTS_AND_CONV = CONV_OF_RCONV (REWR_CONV TRIV_EXISTS_AND_THM ORELSEC REWR_CONV LEFT_EXISTS_AND_THM ORELSEC REWR_CONV RIGHT_EXISTS_AND_THM);; let LEFT_IMP_EXISTS_CONV = CONV_OF_THM LEFT_IMP_EXISTS_THM;; let LEFT_AND_EXISTS_CONV tm = let v = bndvar(rand(rand(rator tm))) in (REWR_CONV LEFT_AND_EXISTS_THM THENC TRY_CONV (GEN_ALPHA_CONV v)) tm;; let RIGHT_AND_EXISTS_CONV = CONV_OF_THM RIGHT_AND_EXISTS_THM;; let AND_FORALL_CONV = CONV_OF_THM AND_FORALL_THM;; (* ------------------------------------------------------------------------- *) (* The slew of named tautologies. *) (* ------------------------------------------------------------------------- *) let F_IMP = TAUT `!t. ~t ==> t ==> F`;; let LEFT_AND_OVER_OR = TAUT `!t1 t2 t3. t1 /\ (t2 \/ t3) <=> t1 /\ t2 \/ t1 /\ t3`;; let RIGHT_AND_OVER_OR = TAUT `!t1 t2 t3. (t2 \/ t3) /\ t1 <=> t2 /\ t1 \/ t3 /\ t1`;; (* ------------------------------------------------------------------------- *) (* Something trivial and useless. *) (* ------------------------------------------------------------------------- *) let INST_TY_TERM(substl,insttyl) th = INST substl (INST_TYPE insttyl th);; (* ------------------------------------------------------------------------- *) (* Derived rules. *) (* ------------------------------------------------------------------------- *) let NOT_MP thi th = try MP thi th with Failure _ -> try let t = dest_neg (concl thi) in MP(MP (SPEC t F_IMP) thi) th with Failure _ -> failwith "NOT_MP";; (* ------------------------------------------------------------------------- *) (* Creating half abstractions. *) (* ------------------------------------------------------------------------- *) let MK_ABS qth = try let ov = bndvar(rand(concl qth)) in let bv,rth = SPEC_VAR qth in let sth = ABS bv rth in let cnv = ALPHA_CONV ov in CONV_RULE(BINOP_CONV cnv) sth with Failure _ -> failwith "MK_ABS";; let HALF_MK_ABS th = try let th1 = MK_ABS th in CONV_RULE(LAND_CONV ETA_CONV) th1 with Failure _ -> failwith "HALF_MK_ABS";; (* ------------------------------------------------------------------------- *) (* Old substitution primitive, now a (not very efficient) derived rule. *) (* ------------------------------------------------------------------------- *) let SUBST thl pat th = let eqs,vs = unzip thl in let gvs = map (genvar o type_of) vs in let gpat = subst (zip gvs vs) pat in let ls,rs = unzip (map (dest_eq o concl) eqs) in let ths = map (ASSUME o mk_eq) (zip gvs rs) in let th1 = ASSUME gpat in let th2 = SUBS ths th1 in let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in let th4 = INST (zip ls gvs) th3 in MP (rev_itlist (C MP) eqs th4) th;; (* ------------------------------------------------------------------------- *) (* Various theorems have different names. *) (* ------------------------------------------------------------------------- *) prioritize_num();; let LESS_EQUAL_ANTISYM = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ANTISYM)));; let NOT_LESS_0 = GEN_ALL(EQF_ELIM(SPEC_ALL(CONJUNCT1 LT)));; let LESS_LEMMA1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL(CONJUNCT2 LT))));; let LESS_SUC_REFL = ARITH_RULE `!n. n < SUC n`;; let LESS_EQ_SUC_REFL = ARITH_RULE `!n. n <= SUC n`;; let LESS_EQUAL_ADD = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_EXISTS)));; let LESS_EQ_IMP_LESS_SUC = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_SUC_LE)));; let LESS_MONO_ADD = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_ADD_RCANCEL)));; let LESS_SUC = ARITH_RULE `!m n. m < n ==> m < (SUC n)`;; let LESS_ADD_1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL (REWRITE_RULE[ADD1] LT_EXISTS))));; let SUC_SUB1 = ARITH_RULE `!m. SUC m - 1 = m`;; let LESS_ADD_SUC = ARITH_RULE `!m n. m < m + SUC n`;; let OR_LESS = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_SUC_LT)));; let NOT_SUC_LESS_EQ = ARITH_RULE `!n m. ~(SUC n <= m) <=> m <= n`;; let LESS_LESS_CASES = ARITH_RULE `!m n. (m = n) \/ m < n \/ n < m`;; let SUB_SUB = prove (`!b c. c <= b ==> (!a. a - (b - c) = (a + c) - b)`, REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN ARITH_TAC);; let LESS_CASES_IMP = ARITH_RULE `!m n. ~(m < n) /\ ~(m = n) ==> n < m`;; let SUB_LESS_EQ = ARITH_RULE `!n m. (n - m) <= n`;; let SUB_EQ_EQ_0 = ARITH_RULE `!m n. (m - n = m) <=> (m = 0) \/ (n = 0)`;; let SUB_LEFT_LESS_EQ = ARITH_RULE `!m n p. m <= (n - p) <=> (m + p) <= n \/ m <= 0`;; let SUB_LEFT_GREATER_EQ = ARITH_RULE `!m n p. m >= (n - p) <=> (m + p) >= n`;; let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; let LESS_OR = ARITH_RULE `!m n. m < n ==> (SUC m) <= n`;; let SUB_OLD = prove(`(!m. 0 - m = 0) /\ (!m n. (SUC m) - n = (if m < n then 0 else SUC(m - n)))`, REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN TRY (POP_ASSUM MP_TAC) THEN ARITH_TAC);; (*============================================================================*) (* Various useful tactics, conversions etc. *) (*============================================================================*) (*----------------------------------------------------------------------------*) (* SYM_CANON_CONV - Canonicalizes single application of symmetric operator *) (* Rewrites `so as to make fn true`, e.g. fn = $<< or fn = curry$= `1` o fst *) (*----------------------------------------------------------------------------*) let SYM_CANON_CONV sym fn = REWR_CONV sym o check (not o fn o ((snd o dest_comb) F_F I) o dest_comb);; (*----------------------------------------------------------------------------*) (* IMP_SUBST_TAC - Implicational substitution for deepest matchable term *) (*----------------------------------------------------------------------------*) let (IMP_SUBST_TAC:thm_tactic) = fun th (asl,w) -> let tms = find_terms (can (PART_MATCH (lhs o snd o dest_imp) th)) w in let tm1 = hd (sort free_in tms) in let th1 = PART_MATCH (lhs o snd o dest_imp) th tm1 in let (a,(l,r)) = (I F_F dest_eq) (dest_imp (concl th1)) in let gv = genvar (type_of l) in let pat = subst[gv,l] w in null_meta, [(asl,a); (asl,subst[(r,gv)] pat)], fun i [t1;t2] -> SUBST[(SYM(MP th1 t1),gv)] pat t2;; (*---------------------------------------------------------------*) (* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) = (f = g) *) (*---------------------------------------------------------------*) let EXT_CONV = SYM o uncurry X_FUN_EQ_CONV o (I F_F (mk_eq o (rator F_F rator) o dest_eq)) o dest_forall;; (*----------------------------------------------------------------------------*) (* EQUAL_TAC - Strip down to unequal core (usually too enthusiastic) *) (*----------------------------------------------------------------------------*) let EQUAL_TAC = REPEAT(FIRST [AP_TERM_TAC; AP_THM_TAC; ABS_TAC]);; (*----------------------------------------------------------------------------*) (* X_BETA_CONV `v` `tm[v]` = |- tm[v] = (\v. tm[v]) v *) (*----------------------------------------------------------------------------*) let X_BETA_CONV v tm = SYM(BETA_CONV(mk_comb(mk_abs(v,tm),v)));; (*----------------------------------------------------------------------------*) (* EXACT_CONV - Rewrite with theorem matching exactly one in a list *) (*----------------------------------------------------------------------------*) let EXACT_CONV = ONCE_DEPTH_CONV o FIRST_CONV o map (fun t -> K t o check((=)(lhs(concl t))));; (*----------------------------------------------------------------------------*) (* Rather ad-hoc higher-order fiddling conversion *) (* |- (\x. f t1[x] ... tn[x]) = (\x. f ((\x. t1[x]) x) ... ((\x. tn[x]) x)) *) (*----------------------------------------------------------------------------*) let HABS_CONV tm = let v,bod = dest_abs tm in let hop,pl = strip_comb bod in let eql = rev(map (X_BETA_CONV v) pl) in ABS v (itlist (C(curry MK_COMB)) eql (REFL hop));; (*----------------------------------------------------------------------------*) (* Expand an abbreviation *) (*----------------------------------------------------------------------------*) let EXPAND_TAC s = FIRST_ASSUM(SUBST1_TAC o SYM o check((=) s o fst o dest_var o rhs o concl)) THEN BETA_TAC;; (* ------------------------------------------------------------------------- *) (* Set up the reals. *) (* ------------------------------------------------------------------------- *) prioritize_real();; let real_le = prove (`!x y. x <= y <=> ~(y < x)`, REWRITE_TAC[REAL_NOT_LT]);; (* ------------------------------------------------------------------------- *) (* Link a few theorems. *) (* ------------------------------------------------------------------------- *) let REAL_10 = REAL_ARITH `~(&1 = &0)`;; let REAL_LDISTRIB = REAL_ADD_LDISTRIB;; let REAL_LT_IADD = REAL_ARITH `!x y z. y < z ==> x + y < x + z`;; (*----------------------------------------------------------------------------*) (* Prove lots of boring field theorems *) (*----------------------------------------------------------------------------*) let REAL_MUL_RID = prove( `!x. x * &1 = x`, GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_MUL_LID);; let REAL_MUL_RINV = prove( `!x. ~(x = &0) ==> (x * (inv x) = &1)`, GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_MUL_LINV);; let REAL_RDISTRIB = prove( `!x y z. (x + y) * z = (x * z) + (y * z)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LDISTRIB);; let REAL_EQ_LADD = prove( `!x y z. (x + y = x + z) <=> (y = z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `(+) (-- x)`) THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]; DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; let REAL_EQ_RADD = prove( `!x y z. (x + z = y + z) <=> (x = y)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_LADD);; let REAL_ADD_LID_UNIQ = prove( `!x y. (x + y = y) <=> (x = &0)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ADD_LID] THEN MATCH_ACCEPT_TAC REAL_EQ_RADD);; let REAL_ADD_RID_UNIQ = prove( `!x y. (x + y = x) <=> (y = &0)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC REAL_ADD_LID_UNIQ);; let REAL_LNEG_UNIQ = prove( `!x y. (x + y = &0) <=> (x = --y)`, REPEAT GEN_TAC THEN SUBST1_TAC (SYM(SPEC `y:real` REAL_ADD_LINV)) THEN MATCH_ACCEPT_TAC REAL_EQ_RADD);; let REAL_RNEG_UNIQ = prove( `!x y. (x + y = &0) <=> (y = --x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC REAL_LNEG_UNIQ);; let REAL_NEG_ADD = prove( `!x y. --(x + y) = (--x) + (--y)`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM REAL_LNEG_UNIQ] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (a + c) + (b + d)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; let REAL_MUL_LZERO = prove( `!x. &0 * x = &0`, GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`&0 * x`; `&0 * x`] REAL_ADD_LID_UNIQ)) THEN REWRITE_TAC[GSYM REAL_RDISTRIB; REAL_ADD_LID]);; let REAL_MUL_RZERO = prove( `!x. x * &0 = &0`, GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_MUL_LZERO);; let REAL_NEG_LMUL = prove( `!x y. --(x * y) = (--x) * y`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM REAL_LNEG_UNIQ; GSYM REAL_RDISTRIB; REAL_ADD_LINV; REAL_MUL_LZERO]);; let REAL_NEG_RMUL = prove( `!x y. --(x * y) = x * (--y)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_NEG_LMUL);; let REAL_NEGNEG = prove( `!x. --(--x) = x`, GEN_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM REAL_LNEG_UNIQ; REAL_ADD_RINV]);; let REAL_NEG_MUL2 = prove( `!x y. (--x) * (--y) = x * y`, REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL; REAL_NEGNEG]);; let REAL_LT_LADD = prove( `!x y z. (x + y) < (x + z) <=> y < z`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `--x` o MATCH_MP REAL_LT_IADD) THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]; MATCH_ACCEPT_TAC REAL_LT_IADD]);; let REAL_LT_RADD = prove( `!x y z. (x + z) < (y + z) <=> x < y`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC REAL_LT_LADD);; let REAL_NOT_LT = prove( `!x y. ~(x < y) <=> y <= x`, REPEAT GEN_TAC THEN REWRITE_TAC[real_le]);; let REAL_LT_ANTISYM = prove( `!x y. ~(x < y /\ y < x)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_TRANS) THEN REWRITE_TAC[REAL_LT_REFL]);; let REAL_LT_GT = prove( `!x y. x < y ==> ~(y < x)`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o CONJ th)) THEN REWRITE_TAC[REAL_LT_ANTISYM]);; let REAL_NOT_LE = prove( `!x y. ~(x <= y) <=> y < x`, REPEAT GEN_TAC THEN REWRITE_TAC[real_le]);; let REAL_LE_TOTAL = prove( `!x y. x <= y \/ y <= x`, REPEAT GEN_TAC THEN REWRITE_TAC[real_le; GSYM DE_MORGAN_THM; REAL_LT_ANTISYM]);; let REAL_LE_REFL = prove( `!x. x <= x`, GEN_TAC THEN REWRITE_TAC[real_le; REAL_LT_REFL]);; let REAL_LE_LT = prove( `!x y. x <= y <=> x < y \/ (x = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN EQ_TAC THENL [REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[]; DISCH_THEN(DISJ_CASES_THEN2 ((then_) (MATCH_MP_TAC REAL_LT_GT) o ACCEPT_TAC) SUBST1_TAC) THEN MATCH_ACCEPT_TAC REAL_LT_REFL]);; let REAL_LT_LE = prove( `!x y. x < y <=> x <= y /\ ~(x = y)`, let lemma = TAUT `~(a /\ ~a)` in REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; RIGHT_AND_OVER_OR; lemma] THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]);; let REAL_LT_IMP_LE = prove( `!x y. x < y ==> x <= y`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LE_LT]);; let REAL_LTE_TRANS = prove( `!x y z. x < y /\ y <= z ==> x < z`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; LEFT_AND_OVER_OR] THEN DISCH_THEN(DISJ_CASES_THEN2 (ACCEPT_TAC o MATCH_MP REAL_LT_TRANS) (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN REWRITE_TAC[]);; let REAL_LE_TRANS = prove( `!x y z. x <= y /\ y <= z ==> x <= z`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_LE_LT] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o C CONJ (ASSUME `y < z`)) THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP REAL_LT_IMP_LE o MATCH_MP REAL_LET_TRANS));; let REAL_NEG_LT0 = prove( `!x. (--x) < &0 <=> &0 < x`, GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`--x`; `&0`; `x:real`] REAL_LT_RADD)) THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; let REAL_NEG_GT0 = prove( `!x. &0 < (--x) <=> x < &0`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEGNEG]);; let REAL_NEG_LE0 = prove( `!x. (--x) <= &0 <=> &0 <= x`, GEN_TAC THEN REWRITE_TAC[real_le] THEN REWRITE_TAC[REAL_NEG_GT0]);; let REAL_NEG_GE0 = prove( `!x. &0 <= (--x) <=> x <= &0`, GEN_TAC THEN REWRITE_TAC[real_le] THEN REWRITE_TAC[REAL_NEG_LT0]);; let REAL_LT_NEGTOTAL = prove( `!x. (x = &0) \/ (&0 < x) \/ (&0 < --x)`, GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[SYM(REWRITE_RULE[REAL_NEGNEG] (SPEC `--x` REAL_NEG_LT0))]);; let REAL_LE_NEGTOTAL = prove( `!x. &0 <= x \/ &0 <= --x`, GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN ASM_REWRITE_TAC[]);; let REAL_LE_MUL = prove( `!x y. &0 <= x /\ &0 <= y ==> &0 <= (x * y)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN MAP_EVERY ASM_CASES_TAC [`&0 = x`; `&0 = y`] THEN ASM_REWRITE_TAC[] THEN TRY(FIRST_ASSUM(SUBST1_TAC o SYM)) THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN DISCH_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]);; let REAL_LE_SQUARE = prove( `!x. &0 <= x * x`, GEN_TAC THEN DISJ_CASES_TAC (SPEC `x:real` REAL_LE_NEGTOTAL) THEN POP_ASSUM(MP_TAC o MATCH_MP REAL_LE_MUL o W CONJ) THEN REWRITE_TAC[GSYM REAL_NEG_RMUL; GSYM REAL_NEG_LMUL; REAL_NEGNEG]);; let REAL_LT_01 = prove( `&0 < &1`, REWRITE_TAC[REAL_LT_LE; REAL_LE_01] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN REWRITE_TAC[REAL_10]);; let REAL_LE_LADD = prove( `!x y z. (x + y) <= (x + z) <=> y <= z`, REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_LT_LADD);; let REAL_LE_RADD = prove( `!x y z. (x + z) <= (y + z) <=> x <= y`, REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_LT_RADD);; let REAL_LT_ADD2 = prove( `!w x y z. w < x /\ y < z ==> (w + y) < (x + z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `w + z` THEN ASM_REWRITE_TAC[REAL_LT_LADD; REAL_LT_RADD]);; let REAL_LT_ADD = prove( `!x y. &0 < x /\ &0 < y ==> &0 < (x + y)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2) THEN REWRITE_TAC[REAL_ADD_LID]);; let REAL_LT_ADDNEG = prove( `!x y z. y < (x + (--z)) <=> (y + z) < x`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`y:real`; `x + (--z)`; `z:real`] REAL_LT_RADD)) THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);; let REAL_LT_ADDNEG2 = prove( `!x y z. (x + (--y)) < z <=> x < (z + y)`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`x + (-- y)`; `z:real`; `y:real`] REAL_LT_RADD)) THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);; let REAL_LT_ADD1 = prove( `!x y. x <= y ==> x < (y + &1)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN DISJ_CASES_TAC THENL [POP_ASSUM(MP_TAC o MATCH_MP REAL_LT_ADD2 o C CONJ REAL_LT_01) THEN REWRITE_TAC[REAL_ADD_RID]; POP_ASSUM SUBST1_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN REWRITE_TAC[REAL_LT_LADD; REAL_LT_01]]);; let REAL_SUB_ADD = prove( `!x y. (x - y) + y = x`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);; let REAL_SUB_ADD2 = prove( `!x y. y + (x - y) = x`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC REAL_SUB_ADD);; let REAL_SUB_REFL = prove( `!x. x - x = &0`, GEN_TAC THEN REWRITE_TAC[real_sub; REAL_ADD_RINV]);; let REAL_SUB_0 = prove( `!x y. (x - y = &0) <=> (x = y)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o C AP_THM `y:real` o AP_TERM `(+)`) THEN REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]; DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_SUB_REFL]);; let REAL_LE_DOUBLE = prove( `!x. &0 <= x + x <=> &0 <= x`, GEN_TAC THEN EQ_TAC THENL [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2 o W CONJ); DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2 o W CONJ)] THEN REWRITE_TAC[REAL_ADD_LID]);; let REAL_LE_NEGL = prove( `!x. (--x <= x) <=> (&0 <= x)`, GEN_TAC THEN SUBST1_TAC (SYM(SPECL [`x:real`; `--x`; `x:real`] REAL_LE_LADD)) THEN REWRITE_TAC[REAL_ADD_RINV; REAL_LE_DOUBLE]);; let REAL_LE_NEGR = prove( `!x. (x <= --x) <=> (x <= &0)`, GEN_TAC THEN SUBST1_TAC(SYM(SPEC `x:real` REAL_NEGNEG)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_NEGNEG] THEN REWRITE_TAC[REAL_LE_NEGL] THEN REWRITE_TAC[REAL_NEG_GE0] THEN REWRITE_TAC[REAL_NEGNEG]);; let REAL_NEG_EQ0 = prove( `!x. (--x = &0) <=> (x = &0)`, GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `(+) x`); DISCH_THEN(MP_TAC o AP_TERM `(+) (--x)`)] THEN REWRITE_TAC[REAL_ADD_RINV; REAL_ADD_LINV; REAL_ADD_RID] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; let REAL_NEG_0 = prove( `--(&0) = &0`, REWRITE_TAC[REAL_NEG_EQ0]);; let REAL_NEG_SUB = prove( `!x y. --(x - y) = y - x`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN MATCH_ACCEPT_TAC REAL_ADD_SYM);; let REAL_SUB_LT = prove( `!x y. &0 < x - y <=> y < x`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`&0`; `x - y`; `y:real`] REAL_LT_RADD)) THEN REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]);; let REAL_SUB_LE = prove( `!x y. &0 <= (x - y) <=> y <= x`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`&0`; `x - y`; `y:real`] REAL_LE_RADD)) THEN REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]);; let REAL_EQ_LMUL = prove( `!x y z. (x * y = x * z) <=> (x = &0) \/ (y = z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `(*) (inv x)`) THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(fun th -> REWRITE_TAC [REAL_MUL_ASSOC; MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_MUL_LID]; DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[REAL_MUL_LZERO]]);; let REAL_EQ_RMUL = prove( `!x y z. (x * z = y * z) <=> (z = &0) \/ (x = y)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_LMUL);; let REAL_SUB_LDISTRIB = prove( `!x y z. x * (y - z) = (x * y) - (x * z)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_NEG_RMUL]);; let REAL_SUB_RDISTRIB = prove( `!x y z. (x - y) * z = (x * z) - (y * z)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_SUB_LDISTRIB);; let REAL_NEG_EQ = prove( `!x y. (--x = y) <=> (x = --y)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM); DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[REAL_NEGNEG]);; let REAL_NEG_MINUS1 = prove( `!x. --x = (--(&1)) * x`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN REWRITE_TAC[REAL_MUL_LID]);; let REAL_INV_NZ = prove( `!x. ~(x = &0) ==> ~(inv x = &0)`, GEN_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o C AP_THM `x:real` o AP_TERM `(*)`) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_10]);; let REAL_INVINV = prove( `!x. ~(x = &0) ==> (inv (inv x) = x)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_MUL_RINV) THEN ASM_CASES_TAC `inv x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; GSYM REAL_10] THEN MP_TAC(SPECL [`inv(inv x)`; `x:real`; `inv x`] REAL_EQ_RMUL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN FIRST_ASSUM ACCEPT_TAC);; let REAL_LT_IMP_NE = prove( `!x y. x < y ==> ~(x = y)`, REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]);; let REAL_INV_POS = prove( `!x. &0 < x ==> &0 < inv x`, GEN_TAC THEN DISCH_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC (SPECL [`inv x`; `&0`] REAL_LT_TOTAL) THENL [POP_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_NZ o GSYM o MATCH_MP REAL_LT_IMP_NE) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM REAL_NEG_GT0] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL o C CONJ (ASSUME `&0 < x`)) THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN POP_ASSUM(fun th -> REWRITE_TAC [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN REWRITE_TAC[REAL_NEG_GT0] THEN DISCH_THEN(MP_TAC o CONJ REAL_LT_01) THEN REWRITE_TAC[REAL_LT_ANTISYM]; REWRITE_TAC[]]);; let REAL_LT_LMUL_0 = prove( `!x y. &0 < x ==> (&0 < (x * y) <=> &0 < y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL [FIRST_ASSUM(fun th -> DISCH_THEN(MP_TAC o CONJ (MATCH_MP REAL_INV_POS th))) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN REWRITE_TAC[REAL_MUL_LID]; DISCH_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]]);; let REAL_LT_RMUL_0 = prove( `!x y. &0 < y ==> (&0 < (x * y) <=> &0 < x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LT_LMUL_0);; let REAL_LT_LMUL_EQ = prove( `!x y z. &0 < x ==> ((x * y) < (x * z) <=> y < z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_LT_LMUL_0);; let REAL_LT_RMUL_EQ = prove( `!x y z. &0 < z ==> ((x * z) < (y * z) <=> x < y)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LT_LMUL_EQ);; let REAL_LT_RMUL_IMP = prove( `!x y z. x < y /\ &0 < z ==> (x * z) < (y * z)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN POP_ASSUM(fun th -> REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_RMUL_EQ th)]));; let REAL_LT_LMUL_IMP = prove( `!x y z. y < z /\ &0 < x ==> (x * y) < (x * z)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN POP_ASSUM(fun th -> REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_LMUL_EQ th)]));; let REAL_LINV_UNIQ = prove( `!x y. (x * y = &1) ==> (x = inv y)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; GSYM REAL_10] THEN DISCH_THEN(MP_TAC o AP_TERM `(*) (inv x)`) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_INVINV);; let REAL_RINV_UNIQ = prove( `!x y. (x * y = &1) ==> (y = inv x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LINV_UNIQ);; let REAL_NEG_INV = prove( `!x. ~(x = &0) ==> (--(inv x) = inv(--x))`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_NEGNEG]);; let REAL_INV_1OVER = prove( `!x. inv x = &1 / x`, GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID]);; (*----------------------------------------------------------------------------*) (* Prove homomorphisms for the inclusion map *) (*----------------------------------------------------------------------------*) let REAL = prove( `!n. &(SUC n) = &n + &1`, REWRITE_TAC[ADD1; REAL_OF_NUM_ADD]);; let REAL_POS = prove( `!n. &0 <= &n`, INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[REAL] THEN REWRITE_TAC[REAL_LE_ADDR; REAL_LE_01]);; let REAL_LE = prove( `!m n. &m <= &n <=> m <= n`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC [REAL; REAL_LE_RADD; LE_0; LE_SUC; REAL_LE_REFL] THEN REWRITE_TAC[GSYM NOT_LT; LT_0] THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[LE_0; REAL_LE_ADDR; REAL_LE_01]; DISCH_THEN(MP_TAC o C CONJ (SPEC `m:num` REAL_POS)) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN REWRITE_TAC[REAL_NOT_LE; REAL_LT_ADDR; REAL_LT_01]]);; let REAL_LT = prove( `!m n. &m < &n <=> m < n`, REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC ((REWRITE_RULE[] o AP_TERM `(~)` o REWRITE_RULE[GSYM NOT_LT; GSYM REAL_NOT_LT]) (SPEC_ALL REAL_LE)));; let REAL_INJ = prove( `!m n. (&m = &n) <=> (m = n)`, let th = prove(`(m = n) <=> m:num <= n /\ n <= m`, EQ_TAC THENL [DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LE_REFL]; MATCH_ACCEPT_TAC LESS_EQUAL_ANTISYM]) in REPEAT GEN_TAC THEN REWRITE_TAC[th; GSYM REAL_LE_ANTISYM; REAL_LE]);; let REAL_ADD = prove( `!m n. &m + &n = &(m + n)`, INDUCT_TAC THEN REWRITE_TAC[REAL; ADD; REAL_ADD_LID] THEN RULE_ASSUM_TAC GSYM THEN GEN_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ADD_AC]);; let REAL_MUL = prove( `!m n. &m * &n = &(m * n)`, INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; MULT_CLAUSES; REAL; GSYM REAL_ADD; REAL_RDISTRIB] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[REAL_MUL_LID]);; (*----------------------------------------------------------------------------*) (* Now more theorems *) (*----------------------------------------------------------------------------*) let REAL_INV1 = prove( `inv(&1) = &1`, CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN REWRITE_TAC[REAL_MUL_LID]);; let REAL_DIV_LZERO = prove( `!x. &0 / x = &0`, REPEAT GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO]);; let REAL_LT_NZ = prove( `!n. ~(&n = &0) <=> (&0 < &n)`, GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_CASES_TAC `&n = &0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_POS]);; let REAL_NZ_IMP_LT = prove( `!n. ~(n = 0) ==> &0 < &n`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_INJ; REAL_LT_NZ]);; let REAL_LT_RDIV_0 = prove( `!y z. &0 < z ==> (&0 < (y / z) <=> &0 < y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_0 THEN MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC);; let REAL_LT_RDIV = prove( `!x y z. &0 < z ==> ((x / z) < (y / z) <=> x < y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC);; let REAL_LT_FRACTION_0 = prove( `!n d. ~(n = 0) ==> (&0 < (d / &n) <=> &0 < d)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_RDIV_0 THEN ASM_REWRITE_TAC[GSYM REAL_LT_NZ; REAL_INJ]);; let REAL_LT_MULTIPLE = prove( `!n d. 1 < n ==> (d < (&n * d) <=> &0 < d)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN INDUCT_TAC THENL [REWRITE_TAC[num_CONV `1`; NOT_LESS_0]; POP_ASSUM MP_TAC THEN ASM_CASES_TAC `1 < n` THEN ASM_REWRITE_TAC[] THENL [DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL; REAL_LDISTRIB; REAL_MUL_RID; REAL_LT_ADDL] THEN MATCH_MP_TAC REAL_LT_RMUL_0 THEN REWRITE_TAC[REAL_LT] THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[num_CONV `1`; LT_0]; GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LESS_LEMMA1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL; REAL_LDISTRIB; REAL_MUL_RID] THEN REWRITE_TAC[REAL_LT_ADDL]]]);; let REAL_LT_FRACTION = prove( `!n d. (1 < n) ==> ((d / &n) < d <=> &0 < d)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NOT_LESS_0] THEN DISCH_TAC THEN UNDISCH_TAC `1 < n` THEN FIRST_ASSUM(fun th -> let th1 = REWRITE_RULE[GSYM REAL_INJ] th in MAP_EVERY ASSUME_TAC [th1; REWRITE_RULE[REAL_LT_NZ] th1]) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LT_MULTIPLE);; let REAL_LT_HALF1 = prove( `!d. &0 < (d / &2) <=> &0 < d`, GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION_0 THEN REWRITE_TAC[num_CONV `2`; NOT_SUC]);; let REAL_LT_HALF2 = prove( `!d. (d / &2) < d <=> &0 < d`, GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION THEN CONV_TAC(RAND_CONV num_CONV) THEN REWRITE_TAC[LESS_SUC_REFL]);; let REAL_DOUBLE = prove( `!x. x + x = &2 * x`, GEN_TAC THEN REWRITE_TAC[num_CONV `2`; REAL] THEN REWRITE_TAC[REAL_RDISTRIB; REAL_MUL_LID]);; let REAL_HALF_DOUBLE = prove( `!x. (x / &2) + (x / &2) = x`, GEN_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_INJ] THEN REWRITE_TAC[num_CONV `2`; NOT_SUC]);; let REAL_SUB_SUB = prove( `!x y. (x - y) - x = --y`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + c = (c + a) + b`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; let REAL_LT_ADD_SUB = prove( `!x y z. (x + y) < z <=> x < (z - y)`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`x:real`; `z - y`; `y:real`] REAL_LT_RADD)) THEN REWRITE_TAC[REAL_SUB_ADD]);; let REAL_LT_SUB_RADD = prove( `!x y z. (x - y) < z <=> x < z + y`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`x - y`; `z:real`; `y:real`] REAL_LT_RADD)) THEN REWRITE_TAC[REAL_SUB_ADD]);; let REAL_LT_SUB_LADD = prove( `!x y z. x < (y - z) <=> (x + z) < y`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`x + z`; `y:real`; `--z`] REAL_LT_RADD)) THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_RINV; REAL_ADD_RID]);; let REAL_LE_SUB_LADD = prove( `!x y z. x <= (y - z) <=> (x + z) <= y`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_SUB_RADD]);; let REAL_LE_SUB_RADD = prove( `!x y z. (x - y) <= z <=> x <= z + y`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_SUB_LADD]);; let REAL_LT_NEG = prove( `!x y. --x < --y <=> y < x`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL[`--x`; `--y`; `x + y`] REAL_LT_RADD)) THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_RINV; REAL_ADD_LID]);; let REAL_LE_NEG = prove( `!x y. --x <= --y <=> y <= x`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[REAL_LT_NEG]);; let REAL_SUB_LZERO = prove( `!x. &0 - x = --x`, GEN_TAC THEN REWRITE_TAC[real_sub; REAL_ADD_LID]);; let REAL_SUB_RZERO = prove( `!x. x - &0 = x`, GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_0; REAL_ADD_RID]);; let REAL_LTE_ADD2 = prove( `!w x y z. w < x /\ y <= z ==> (w + y) < (x + z)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC REAL_LET_ADD2);; let REAL_LTE_ADD = prove( `!x y. &0 < x /\ &0 <= y ==> &0 < (x + y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN SUBST1_TAC(SYM(SPEC `&0` REAL_ADD_LID)) THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[]);; let REAL_LT_MUL2_ALT = prove( `!x1 x2 y1 y2. &0 <= x1 /\ &0 <= y1 /\ x1 < x2 /\ y1 < y2 ==> (x1 * y1) < (x2 * y2)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN SUBGOAL_THEN `!a b c d. (a * b) - (c * d) = ((a * b) - (a * d)) + ((a * d) - (c * d))` MP_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (b + c) + (a + d)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN DISCH_THEN STRIP_ASSUME_TAC THEN MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);; let REAL_SUB_LNEG = prove( `!x y. (--x) - y = --(x + y)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD]);; let REAL_SUB_RNEG = prove( `!x y. x - (--y) = x + y`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEGNEG]);; let REAL_SUB_NEG2 = prove( `!x y. (--x) - (--y) = y - x`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUB_LNEG] THEN REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN MATCH_ACCEPT_TAC REAL_ADD_SYM);; let REAL_SUB_TRIANGLE = prove( `!a b c. (a - b) + (b - c) = a - c`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (b + c) + (a + d)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; let REAL_INV_MUL_WEAK = prove( `!x y. ~(x = &0) /\ ~(y = &0) ==> (inv(x * y) = inv(x) * inv(y))`, REWRITE_TAC[REAL_INV_MUL]);; let REAL_LE_LMUL_LOCAL = prove( `!x y z. &0 < x ==> ((x * y) <= (x * z) <=> y <= z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_LT_LMUL_EQ THEN ASM_REWRITE_TAC[]);; let REAL_LE_RMUL_EQ = prove( `!x y z. &0 < z ==> ((x * z) <= (y * z) <=> x <= y)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LE_LMUL_LOCAL);; let REAL_SUB_INV2 = prove( `!x y. ~(x = &0) /\ ~(y = &0) ==> (inv(x) - inv(y) = (y - x) / (x * y))`, REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN `inv(x * y) = inv(x) * inv(y)` SUBST1_TAC THENL [MATCH_MP_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN REWRITE_TAC[REAL_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_MUL_LID]);; let REAL_SUB_SUB2 = prove( `!x y. x - (x - y) = y`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NEGNEG] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_SUB]);; let REAL_MEAN = prove( `!x y. x < y ==> ?z. x < z /\ z < y`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_DOWN o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `x + d` THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[GSYM REAL_LT_SUB_LADD]);; let REAL_EQ_LMUL2 = prove( `!x y z. ~(x = &0) ==> ((y = z) <=> (x * y = x * z))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`; `z:real`] REAL_EQ_LMUL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN REFL_TAC);; let REAL_LE_MUL2V = prove( `!x1 x2 y1 y2. (& 0) <= x1 /\ (& 0) <= y1 /\ x1 <= x2 /\ y1 <= y2 ==> (x1 * y1) <= (x2 * y2)`, REPEAT GEN_TAC THEN SUBST1_TAC(SPECL [`x1:real`; `x2:real`] REAL_LE_LT) THEN ASM_CASES_TAC `x1:real = x2` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [UNDISCH_TAC `&0 <= x2` THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]); SUBST1_TAC(SYM(ASSUME `&0 = x2`)) THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL]]; ALL_TAC] THEN UNDISCH_TAC `y1 <= y2` THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN UNDISCH_TAC `&0 <= y1` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; SUBST1_TAC(SYM(ASSUME `&0 = y2`)) THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]);; let REAL_LE_LDIV = prove( `!x y z. &0 < x /\ y <= (z * x) ==> (y / x) <= z`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN SUBGOAL_THEN `y = (y / x) * x` MP_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC; DISCH_THEN(fun t -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [t]) THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN POP_ASSUM ACCEPT_TAC]);; let REAL_LE_RDIV = prove( `!x y z. &0 < x /\ (y * x) <= z ==> y <= (z / x)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC EQ_IMP THEN SUBGOAL_THEN `z = (z / x) * x` MP_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC; DISCH_THEN(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN POP_ASSUM ACCEPT_TAC]);; let REAL_LT_1 = prove( `!x y. &0 <= x /\ x < y ==> (x / y) < &1`, REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `(x / y) < &1 <=> ((x / y) * y) < (&1 * y)` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `(x / y) * y = x` SUBST1_TAC THENL [MATCH_MP_TAC REAL_DIV_RMUL THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[REAL_MUL_LID]]]);; let REAL_LE_LMUL_IMP = prove( `!x y z. &0 <= x /\ y <= z ==> (x * y) <= (x * z)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]); FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_ACCEPT_TAC REAL_LE_REFL]);; let REAL_LE_RMUL_IMP = prove( `!x y z. &0 <= x /\ y <= z ==> (y * x) <= (z * x)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LE_LMUL_IMP);; let REAL_INV_LT1 = prove( `!x. &0 < x /\ x < &1 ==> &1 < inv(x)`, GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_POS) THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_TAC THEN MP_TAC(SPECL [`inv(x)`; `&1`; `x:real`; `&1`] REAL_LT_MUL2_ALT) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NE) THEN REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_LINV THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&0 < &0` THEN REWRITE_TAC[REAL_LT_REFL]]; DISCH_THEN(MP_TAC o AP_TERM `inv`) THEN REWRITE_TAC[REAL_INV1] THEN SUBGOAL_THEN `inv(inv x) = x` SUBST1_TAC THENL [MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC; DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&1 < &1` THEN REWRITE_TAC[REAL_LT_REFL]]]);; let REAL_POS_NZ = prove( `!x. &0 < x ==> ~(x = &0)`, GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_LT_IMP_NE) THEN CONV_TAC(RAND_CONV SYM_CONV) THEN POP_ASSUM ACCEPT_TAC);; let REAL_EQ_RMUL_IMP = prove( `!x y z. ~(z = &0) /\ (x * z = y * z) ==> (x = y)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[REAL_EQ_RMUL]);; let REAL_EQ_LMUL_IMP = prove( `!x y z. ~(x = &0) /\ (x * y = x * z) ==> (y = z)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_RMUL_IMP);; let REAL_FACT_NZ = prove( `!n. ~(&(FACT n) = &0)`, GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT; FACT_LT]);; let REAL_POSSQ = prove( `!x. &0 < (x * x) <=> ~(x = &0)`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN AP_TERM_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o C CONJ (SPEC `x:real` REAL_LE_SQUARE)) THEN REWRITE_TAC[REAL_LE_ANTISYM; REAL_ENTIRE]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL]]);; let REAL_SUMSQ = prove( `!x y. ((x * x) + (y * y) = &0) <=> (x = &0) /\ (y = &0)`, REPEAT GEN_TAC THEN EQ_TAC THENL [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISCH_THEN DISJ_CASES_TAC THEN MATCH_MP_TAC REAL_POS_NZ THENL [MATCH_MP_TAC REAL_LTE_ADD; MATCH_MP_TAC REAL_LET_ADD] THEN ASM_REWRITE_TAC[REAL_POSSQ; REAL_LE_SQUARE]; DISCH_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID]]);; let REAL_EQ_NEG = prove( `!x y. (--x = --y) <=> (x = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_NEG] THEN MATCH_ACCEPT_TAC CONJ_SYM);; let REAL_DIV_MUL2 = prove( `!x z. ~(x = &0) /\ ~(z = &0) ==> !y. y / z = (x * y) / (x * z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (c * a) * (b * d)`] THEN IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_LID]);; let REAL_MIDDLE1 = prove( `!a b. a <= b ==> a <= (a + b) / &2`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_RDIV THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_DOUBLE] THEN ASM_REWRITE_TAC[GSYM REAL_DOUBLE; REAL_LE_LADD] THEN REWRITE_TAC[num_CONV `2`; REAL_LT; LT_0]);; let REAL_MIDDLE2 = prove( `!a b. a <= b ==> ((a + b) / &2) <= b`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_LDIV THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_DOUBLE] THEN ASM_REWRITE_TAC[GSYM REAL_DOUBLE; REAL_LE_RADD] THEN REWRITE_TAC[num_CONV `2`; REAL_LT; LT_0]);; (*----------------------------------------------------------------------------*) (* Define usual norm (absolute distance) on the real line *) (*----------------------------------------------------------------------------*) let ABS_ZERO = prove( `!x. (abs(x) = &0) <=> (x = &0)`, GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_NEG_EQ0]);; let ABS_0 = prove( `abs(&0) = &0`, REWRITE_TAC[ABS_ZERO]);; let ABS_1 = prove( `abs(&1) = &1`, REWRITE_TAC[real_abs; REAL_LE; LE_0]);; let ABS_NEG = prove( `!x. abs(--x) = abs(x)`, GEN_TAC THEN REWRITE_TAC[real_abs; REAL_NEGNEG; REAL_NEG_GE0] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[] THENL [MP_TAC(CONJ (ASSUME `&0 <= x`) (ASSUME `x <= &0`)) THEN REWRITE_TAC[REAL_LE_ANTISYM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_NEG_0]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN W(MP_TAC o end_itlist CONJ o map snd o fst) THEN REWRITE_TAC[REAL_LT_ANTISYM]]);; let ABS_TRIANGLE = prove( `!x y. abs(x + y) <= abs(x) + abs(y)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_NEG_ADD; REAL_LE_REFL; REAL_LE_LADD; REAL_LE_RADD] THEN ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_LE_NEGL; REAL_LE_NEGR] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN TRY(UNDISCH_TAC `(x + y) < &0`) THEN SUBST1_TAC(SYM(SPEC `&0` REAL_ADD_LID)) THEN REWRITE_TAC[REAL_NOT_LT] THEN MAP_FIRST MATCH_MP_TAC [REAL_LT_ADD2; REAL_LE_ADD2] THEN ASM_REWRITE_TAC[]);; let ABS_POS = prove( `!x. &0 <= abs(x)`, GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL [ALL_TAC; MP_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN ASM_REWRITE_TAC[real_abs]);; let ABS_MUL = prove( `!x y. abs(x * y) = abs(x) * abs(y)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL [ALL_TAC; MP_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ABS_NEG] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM ABS_NEG] THEN REWRITE_TAC[REAL_NEG_LMUL]] THEN (ASM_CASES_TAC `&0 <= y` THENL [ALL_TAC; MP_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ABS_NEG] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ABS_NEG] THEN REWRITE_TAC[REAL_NEG_RMUL]]) THEN ASSUM_LIST(ASSUME_TAC o MATCH_MP REAL_LE_MUL o end_itlist CONJ o rev) THEN ASM_REWRITE_TAC[real_abs]);; let ABS_LT_MUL2 = prove( `!w x y z. abs(w) < y /\ abs(x) < z ==> abs(w * x) < (y * z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN ASM_REWRITE_TAC[ABS_POS]);; let ABS_SUB = prove( `!x y. abs(x - y) = abs(y - x)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_NEG_SUB] THEN REWRITE_TAC[ABS_NEG]);; let ABS_NZ = prove( `!x. ~(x = &0) <=> &0 < abs(x)`, GEN_TAC THEN EQ_TAC THENL [ONCE_REWRITE_TAC[GSYM ABS_ZERO] THEN REWRITE_TAC[TAUT `~a ==> b <=> b \/ a`] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[GSYM REAL_LE_LT; ABS_POS]; CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[real_abs; REAL_LT_REFL; REAL_LE_REFL]]);; let ABS_INV = prove( `!x. ~(x = &0) ==> (abs(inv x) = inv(abs(x)))`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN REWRITE_TAC[GSYM ABS_MUL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[real_abs; REAL_LE] THEN REWRITE_TAC[num_CONV `1`; GSYM NOT_LT; NOT_LESS_0]);; let ABS_ABS = prove( `!x. abs(abs(x)) = abs(x)`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [real_abs] THEN REWRITE_TAC[ABS_POS]);; let ABS_LE = prove( `!x. x <= abs(x)`, GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN REWRITE_TAC[REAL_LE_NEGR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_NOT_LE]);; let ABS_REFL = prove( `!x. (abs(x) = x) <=> &0 <= x`, GEN_TAC THEN REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `&0 <= x` THEN ASM_REWRITE_TAC[] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN REWRITE_TAC[REAL_DOUBLE; REAL_ENTIRE; REAL_INJ] THEN REWRITE_TAC[num_CONV `2`; NOT_SUC] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_LE_REFL]);; let ABS_N = prove( `!n. abs(&n) = &n`, GEN_TAC THEN REWRITE_TAC[ABS_REFL; REAL_LE; LE_0]);; let ABS_BETWEEN = prove( `!x y d. &0 < d /\ ((x - d) < y) /\ (y < (x + d)) <=> abs(y - x) < d`, REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_NEG_SUB] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [REAL_ADD_SYM] THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `x < (x + d)` MP_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[REAL_LT_ADDR]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN SUBGOAL_THEN `y < (y + d)` MP_TAC THENL [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_ADDR]]);; let ABS_BOUND = prove( `!x y d. abs(x - y) < d ==> y < (x + d)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN ONCE_REWRITE_TAC[GSYM ABS_BETWEEN] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; let ABS_STILLNZ = prove( `!x y. abs(x - y) < abs(y) ==> ~(x = &0)`, REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG; REAL_LT_REFL]);; let ABS_CASES = prove( `!x. (x = &0) \/ &0 < abs(x)`, GEN_TAC THEN REWRITE_TAC[GSYM ABS_NZ] THEN BOOL_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[]);; let ABS_BETWEEN1 = prove( `!x y z. x < z /\ (abs(y - x)) < (z - x) ==> y < z`, REPEAT GEN_TAC THEN DISJ_CASES_TAC (SPECL [`x:real`; `y:real`] REAL_LET_TOTAL) THENL [ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_sub; REAL_LT_RADD] THEN DISCH_THEN(ACCEPT_TAC o CONJUNCT2); DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]);; let ABS_SIGN = prove( `!x y. abs(x - y) < y ==> &0 < x`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ABS_BOUND) THEN REWRITE_TAC[REAL_LT_ADDL]);; let ABS_SIGN2 = prove( `!x y. abs(x - y) < --y ==> x < &0`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`--x`; `--y`] ABS_SIGN) THEN REWRITE_TAC[REAL_SUB_NEG2] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEGNEG]);; let ABS_DIV = prove( `!y. ~(y = &0) ==> !x. abs(x / y) = abs(x) / abs(y)`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[ABS_MUL] THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]));; let ABS_CIRCLE = prove( `!x y h. abs(h) < (abs(y) - abs(x)) ==> abs(x + h) < abs(y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) + abs(h)` THEN REWRITE_TAC[ABS_TRIANGLE] THEN POP_ASSUM(MP_TAC o CONJ (SPEC `abs(x)` REAL_LE_REFL)) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD2) THEN REWRITE_TAC[REAL_SUB_ADD2]);; let REAL_SUB_ABS = prove( `!x y. (abs(x) - abs(y)) <= abs(x - y)`, REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(abs(x - y) + abs(y)) - abs(y)` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[real_sub] THEN REWRITE_TAC[REAL_LE_RADD] THEN SUBST1_TAC(SYM(SPECL [`x:real`; `y:real`] REAL_SUB_ADD)) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_SUB_ADD] THEN MATCH_ACCEPT_TAC ABS_TRIANGLE; ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_ADD_SUB; REAL_LE_REFL]]);; let ABS_SUB_ABS = prove( `!x y. abs(abs(x) - abs(y)) <= abs(x - y)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [real_abs] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_SUB_ABS] THEN REWRITE_TAC[REAL_NEG_SUB] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN REWRITE_TAC[REAL_SUB_ABS]);; let ABS_BETWEEN2 = prove( `!x0 x y0 y. x0 < y0 /\ abs(x - x0) < (y0 - x0) / &2 /\ abs(y - y0) < (y0 - x0) / &2 ==> x < y`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `x < y0 /\ x0 < y` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [MP_TAC(SPECL [`x0:real`; `x:real`; `y0 - x0`] ABS_BOUND) THEN REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `(y0 - x0) / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2] THEN ASM_REWRITE_TAC[REAL_SUB_LT]; GEN_REWRITE_TAC I [TAUT `a = ~ ~a`] THEN PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(AC REAL_ADD_AC `(y0 + --x0) + (x0 + --y) = (--x0 + x0) + (y0 + --y)`) THEN REWRITE_TAC[GSYM real_sub; REAL_ADD_LINV; REAL_ADD_LID] THEN DISCH_TAC THEN MP_TAC(SPECL [`y0 - x0`; `x0 - y`] REAL_LE_ADDR) THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `~(y0 <= y)` ASSUME_TAC THENL [REWRITE_TAC[REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `y0 - x0` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[REAL_SUB_LT]; ALL_TAC] THEN UNDISCH_TAC `abs(y - y0) < (y0 - x0) / &2` THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[REAL_NEG_SUB] THEN DISCH_TAC THEN SUBGOAL_THEN `(y0 - x0) < (y0 - x0) / &2` MP_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y0 - y` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_HALF2] THEN ASM_REWRITE_TAC[REAL_SUB_LT]]; ALL_TAC] THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `abs(x0 - y) < (y0 - x0) / &2` ASSUME_TAC THENL [REWRITE_TAC[real_abs; REAL_SUB_LE] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[REAL_NEG_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x - x0` THEN REWRITE_TAC[real_sub; REAL_LE_RADD] THEN ASM_REWRITE_TAC[GSYM real_sub] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x - x0)` THEN ASM_REWRITE_TAC[ABS_LE]; ALL_TAC] THEN SUBGOAL_THEN `abs(y0 - x0) < ((y0 - x0) / &2) + ((y0 - x0) / &2)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_HALF_DOUBLE; REAL_NOT_LT; ABS_LE]] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(y0 - y) + abs(y - x0)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LT_ADD2 THEN ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `y0 - x0 = (y0 - y) + (y - x0)` SUBST1_TAC THEN REWRITE_TAC[ABS_TRIANGLE] THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (b + c) + (a + d)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; let ABS_BOUNDS = prove( `!x k. abs(x) <= k <=> --k <= x /\ x <= k`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_LE_NEG] THEN REWRITE_TAC[REAL_NEGNEG] THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THENL [REWRITE_TAC[TAUT `(a <=> b /\ a) <=> a ==> b`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LE_NEGL]; REWRITE_TAC[TAUT `(a <=> a /\ b) <=> a ==> b`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_NEGR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE]]);; (*----------------------------------------------------------------------------*) (* Define integer powers *) (*----------------------------------------------------------------------------*) let pow = real_pow;; let POW_0 = prove( `!n. &0 pow (SUC n) = &0`, INDUCT_TAC THEN REWRITE_TAC[pow; REAL_MUL_LZERO]);; let POW_NZ = prove( `!c n. ~(c = &0) ==> ~(c pow n = &0)`, REPEAT GEN_TAC THEN DISCH_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[pow; REAL_10; REAL_ENTIRE]);; let POW_INV = prove( `!c n. ~(c = &0) ==> (inv(c pow n) = (inv c) pow n)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[pow; REAL_INV1] THEN MP_TAC(SPECL [`c:real`; `c pow n`] REAL_INV_MUL_WEAK) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(c pow n = &0)` ASSUME_TAC THENL [MATCH_MP_TAC POW_NZ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]);; let POW_ABS = prove( `!c n. abs(c) pow n = abs(c pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[pow; ABS_1; ABS_MUL]);; let POW_PLUS1 = prove( `!e n. &0 < e ==> (&1 + (&n * e)) <= (&1 + e) pow n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + e) * (&1 + (&n * e))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_RDISTRIB; REAL; REAL_MUL_LID] THEN REWRITE_TAC[REAL_LDISTRIB;REAL_MUL_RID; REAL_ADD_ASSOC; REAL_LE_ADDR] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_SQUARE; REAL_LE; LE_0]; SUBGOAL_THEN `&0 < (&1 + e)` (fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]) THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LT] THEN REWRITE_TAC[num_CONV `1`; LT_0]]);; let POW_ADD = prove( `!c m n. c pow (m + n) = (c pow m) * (c pow n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[pow; ADD_CLAUSES; REAL_MUL_RID] THEN REWRITE_TAC[REAL_MUL_AC]);; let POW_1 = prove( `!x. x pow 1 = x`, GEN_TAC THEN REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[pow; REAL_MUL_RID]);; let POW_2 = prove( `!x. x pow 2 = x * x`, GEN_TAC THEN REWRITE_TAC[num_CONV `2`] THEN REWRITE_TAC[pow; POW_1]);; let POW_POS = prove( `!x n. &0 <= x ==> &0 <= (x pow n)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LE_01] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]);; let POW_LE = prove( `!n x y. &0 <= x /\ x <= y ==> (x pow n) <= (y pow n)`, INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LE_REFL] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[POW_POS]);; let POW_M1 = prove( `!n. abs((--(&1)) pow n) = &1`, INDUCT_TAC THEN REWRITE_TAC[pow; ABS_NEG; ABS_1] THEN ASM_REWRITE_TAC[ABS_MUL; ABS_NEG; ABS_1; REAL_MUL_LID]);; let POW_MUL = prove( `!n x y. (x * y) pow n = (x pow n) * (y pow n)`, INDUCT_TAC THEN REWRITE_TAC[pow; REAL_MUL_LID] THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_AC]);; let REAL_LE_SQUARE_POW = prove( `!x. &0 <= x pow 2`, GEN_TAC THEN REWRITE_TAC[POW_2; REAL_LE_SQUARE]);; let ABS_POW2 = prove( `!x. abs(x pow 2) = x pow 2`, GEN_TAC THEN REWRITE_TAC[ABS_REFL; REAL_LE_SQUARE_POW]);; let REAL_LE1_POW2 = prove( `!x. &1 <= x ==> &1 <= (x pow 2)`, GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[REAL_LE_01]);; let REAL_LT1_POW2 = prove( `!x. &1 < x ==> &1 < (x pow 2)`, GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN ASM_REWRITE_TAC[REAL_LE_01]);; let POW_POS_LT = prove( `!x n. &0 < x ==> &0 < (x pow (SUC n))`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[]; CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC POW_NZ THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[]]);; let POW_2_LE1 = prove( `!n. &1 <= &2 pow n`, INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LE_REFL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[REAL_LE] THEN REWRITE_TAC[LE_0; num_CONV `2`; LESS_EQ_SUC_REFL]);; let POW_2_LT = prove( `!n. &n < &2 pow n`, INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LT_01] THEN REWRITE_TAC[ADD1; GSYM REAL_ADD; GSYM REAL_DOUBLE] THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[POW_2_LE1]);; let POW_MINUS1 = prove( `!n. (--(&1)) pow (2 * n) = &1`, INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; pow] THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; ADD_CLAUSES] THEN REWRITE_TAC[pow] THEN REWRITE_TAC[SYM(num_CONV `2`); SYM(num_CONV `1`)] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[REAL_MUL_LID; REAL_NEGNEG]);; (*----------------------------------------------------------------------------*) (* Derive the supremum property for an arbitrary bounded nonempty set *) (*----------------------------------------------------------------------------*) let REAL_SUP_EXISTS = prove( `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==> (?s. !y. (?x. P x /\ y < x) <=> y < s)`, GEN_TAC THEN MP_TAC(SPEC `P:real->bool` REAL_COMPLETE) THEN MESON_TAC[REAL_LT_IMP_LE; REAL_LTE_TRANS; REAL_NOT_LT]);; let sup_def = new_definition `sup s = @a. (!x. x IN s ==> x <= a) /\ (!b. (!x. x IN s ==> x <= b) ==> a <= b)`;; let sup = prove (`sup P = @s. !y. (?x. P x /\ y < x) <=> y < s`, REWRITE_TAC[sup_def; IN] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[REAL_LTE_TRANS; REAL_NOT_LT; REAL_LE_REFL]);; let REAL_SUP = prove( `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==> (!y. (?x. P x /\ y < x) <=> y < sup P)`, GEN_TAC THEN DISCH_THEN(MP_TAC o SELECT_RULE o MATCH_MP REAL_SUP_EXISTS) THEN REWRITE_TAC[GSYM sup]);; let REAL_SUP_UBOUND = prove( `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==> (!y. P y ==> y <= sup P)`, GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `sup P` o MATCH_MP REAL_SUP) THEN REWRITE_TAC[REAL_LT_REFL] THEN DISCH_THEN(ASSUME_TAC o CONV_RULE NOT_EXISTS_CONV) THEN X_GEN_TAC `x:real` THEN RULE_ASSUM_TAC(SPEC `x:real`) THEN DISCH_THEN (SUBST_ALL_TAC o EQT_INTRO) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_NOT_LT]);; let SETOK_LE_LT = prove( `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) <=> (?x. P x) /\ (?z. !x. P x ==> x < z)`, GEN_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `z:real`) THENL (map EXISTS_TAC [`z + &1`; `z:real`]) THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN REWRITE_TAC[REAL_LT_ADD1; REAL_LT_IMP_LE]);; let REAL_SUP_LE = prove( `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==> (!y. (?x. P x /\ y < x) <=> y < sup P)`, GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT; REAL_SUP]);; let REAL_SUP_UBOUND_LE = prove( `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==> (!y. P y ==> y <= sup P)`, GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT; REAL_SUP_UBOUND]);; (*----------------------------------------------------------------------------*) (* Prove the Archimedean property *) (*----------------------------------------------------------------------------*) let REAL_ARCH_SIMPLE = prove (`!x. ?n. x <= &n`, let lemma = prove(`(!x. (?n. x = &n) ==> P x) <=> !n. P(&n)`,MESON_TAC[]) in MP_TAC(SPEC `\y. ?n. y = &n` REAL_COMPLETE) THEN REWRITE_TAC[lemma] THEN MESON_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_LE_TOTAL; REAL_ARITH `~(M <= M - &1)`]);; let REAL_ARCH = prove( `!x. &0 < x ==> !y. ?n. y < &n * x`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a <=> ~(~a)`] THEN CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(SPEC `\z. ?n. z = &n * x` REAL_SUP_LE) THEN BETA_TAC THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`&n * x`; `n:num`] THEN REFL_TAC; EXISTS_TAC `y:real` THEN GEN_TAC THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `sup(\z. ?n. z = &n * x) - x`) THEN REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `n:num`) MP_TAC) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_RDISTRIB] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `sup(\z. ?n. z = &n * x)`) THEN REWRITE_TAC[REAL_LT_REFL] THEN EXISTS_TAC `(&n + &1) * x` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `n + 1` THEN REWRITE_TAC[REAL_ADD]);; let REAL_ARCH_LEAST = prove( `!y. &0 < y ==> !x. &0 <= x ==> ?n. (&n * y) <= x /\ x < (&(SUC n) * y)`, GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_ARCH) THEN GEN_TAC THEN POP_ASSUM(ASSUME_TAC o SPEC `x:real`) THEN POP_ASSUM(X_CHOOSE_THEN `n:num` MP_TAC o ONCE_REWRITE_RULE[num_WOP]) THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SPEC `PRE n`)) THEN DISCH_TAC THEN EXISTS_TAC `PRE n` THEN SUBGOAL_THEN `SUC(PRE n) = n` ASSUME_TAC THENL [DISJ_CASES_THEN2 SUBST_ALL_TAC (CHOOSE_THEN SUBST_ALL_TAC) (SPEC `n:num` num_CASES) THENL [UNDISCH_TAC `x < &0 * y` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; GSYM REAL_NOT_LE]; REWRITE_TAC[PRE]]; ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[PRE; LESS_SUC_REFL]]);; let REAL_POW_LBOUND = prove (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; let REAL_ARCH_POW = prove (`!x y. &1 < x ==> ?n. y < x pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 + &n * (x - &1)` THEN ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH `&1 < x ==> &0 <= x - &1`]);; let REAL_ARCH_POW2 = prove (`!x. ?n. x < &2 pow n`, SIMP_TAC[REAL_ARCH_POW; REAL_OF_NUM_LT; ARITH]);; (* ========================================================================= *) (* Finite sums. NB: sum(m,n) f = f(m) + f(m+1) + ... + f(m+n-1) *) (* ========================================================================= *) prioritize_real();; make_overloadable "sum" `:A->(B->real)->real`;; overload_interface("sum",`sum:(A->bool)->(A->real)->real`);; overload_interface("sum",`psum:(num#num)->(num->real)->real`);; let sum_EXISTS = prove (`?sum. (!f n. sum(n,0) f = &0) /\ (!f m n. sum(n,SUC m) f = sum(n,m) f + f(n + m))`, (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) `(!f n. sm n 0 f = &0) /\ (!f m n. sm n (SUC m) f = sm n m f + f(n + m))` THEN EXISTS_TAC `\(n,m) f. (sm:num->num->(num->real)->real) n m f` THEN CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[]);; let sum_DEF = new_specification ["psum"] sum_EXISTS;; let sum = prove (`(sum(n,0) f = &0) /\ (sum(n,SUC m) f = sum(n,m) f + f(n + m))`, REWRITE_TAC[sum_DEF]);; (* ------------------------------------------------------------------------- *) (* Relation to the standard notion. *) (* ------------------------------------------------------------------------- *) let PSUM_SUM = prove (`!f m n. sum(m,n) f = sum {i | m <= i /\ i < m + n} f`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THENL [SUBGOAL_THEN `{i | m <= i /\ i < m + 0} = {}` (fun th -> SIMP_TAC[th; SUM_CLAUSES]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `FINITE {i | m <= i /\ i < m + n} /\ {i | m <= i /\ i < m + SUC n} = (m + n) INSERT {i | m <= i /\ i < m + n}` (fun th -> ASM_SIMP_TAC[th; SUM_CLAUSES; IN_ELIM_THM; LT_REFL; REAL_ADD_AC]) THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `m..m+n` THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM]; REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT]] THEN ARITH_TAC);; let PSUM_SUM_NUMSEG = prove (`!f m n. ~(m = 0 /\ n = 0) ==> sum(m,n) f = sum(m..(m+n)-1) f`, REPEAT STRIP_TAC THEN REWRITE_TAC[PSUM_SUM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Stuff about sums. *) (* ------------------------------------------------------------------------- *) let SUM_TWO = prove (`!f n p. sum(0,n) f + sum(n,p) f = sum(0,n + p) f`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum; REAL_ADD_RID; ADD_CLAUSES] THEN ASM_REWRITE_TAC[REAL_ADD_ASSOC]);; let SUM_DIFF = prove (`!f m n. sum(m,n) f = sum(0,m + n) f - sum(0,m) f`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC SUM_TWO);; let ABS_SUM = prove (`!f m n. abs(sum(m,n) f) <= sum(m,n) (\n. abs(f n))`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum; REAL_ABS_0; REAL_LE_REFL] THEN BETA_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(sum(m,n) f) + abs(f(m + n))` THEN ASM_REWRITE_TAC[REAL_ABS_TRIANGLE; REAL_LE_RADD]);; let SUM_LE = prove (`!f g m n. (!r. m <= r /\ r < n + m ==> f(r) <= g(r)) ==> (sum(m,n) f <= sum(m,n) g)`, EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum; REAL_LE_REFL] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `(n:num) + m`; GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ADD_SYM]] THEN ASM_REWRITE_TAC[ADD_CLAUSES; LE_ADD; LT]);; let SUM_EQ = prove (`!f g m n. (!r. m <= r /\ r < (n + m) ==> (f(r) = g(r))) ==> (sum(m,n) f = sum(m,n) g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN GEN_TAC THEN DISCH_THEN(fun th -> MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM(SUBST1_TAC o C MATCH_MP th)) THEN REFL_TAC);; let SUM_POS = prove (`!f. (!n. &0 <= f(n)) ==> !m n. &0 <= sum(m,n) f`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[]);; let SUM_POS_GEN = prove (`!f m n. (!n. m <= n ==> &0 <= f(n)) ==> &0 <= sum(m,n) f`, REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_ACCEPT_TAC LE_ADD);; let SUM_ABS = prove (`!f m n. abs(sum(m,n) (\m. abs(f m))) = sum(m,n) (\m. abs(f m))`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[REAL_ABS_REFL] THEN SPEC_TAC(`m:num`,`m:num`) THEN MATCH_MP_TAC SUM_POS THEN BETA_TAC THEN REWRITE_TAC[REAL_ABS_POS]);; let SUM_ABS_LE = prove (`!f m n. abs(sum(m,n) f) <= sum(m,n)(\n. abs(f n))`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum; REAL_ABS_0; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(sum(m,n) f) + abs(f(m + n))` THEN REWRITE_TAC[REAL_ABS_TRIANGLE] THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_LE_RADD]);; let SUM_ZERO = prove (`!f N. (!n. n >= N ==> (f(n) = &0)) ==> (!m n. m >= N ==> (sum(m,n) f = &0))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN ASM_REWRITE_TAC[REAL_ADD_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; GSYM ADD_ASSOC; LE_ADD]);; let SUM_ADD = prove (`!f g m n. sum(m,n) (\n. f(n) + g(n)) = sum(m,n) f + sum(m,n) g`, EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[sum; REAL_ADD_LID; REAL_ADD_AC]);; let SUM_CMUL = prove (`!f c m n. sum(m,n) (\n. c * f(n)) = c * sum(m,n) f`, EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[sum; REAL_MUL_RZERO] THEN BETA_TAC THEN REWRITE_TAC[REAL_ADD_LDISTRIB]);; let SUM_NEG = prove (`!f n d. sum(n,d) (\n. --(f n)) = --(sum(n,d) f)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[sum; REAL_NEG_0] THEN BETA_TAC THEN REWRITE_TAC[REAL_NEG_ADD]);; let SUM_SUB = prove (`!f g m n. sum(m,n)(\n. (f n) - (g n)) = sum(m,n) f - sum(m,n) g`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM SUM_NEG; GSYM SUM_ADD]);; let SUM_SUBST = prove (`!f g m n. (!p. m <= p /\ p < (m + n) ==> (f p = g p)) ==> (sum(m,n) f = sum(m,n) g)`, EVERY (replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN BINOP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE] THEN MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LT_SUC_LE; LE_REFL; ADD_CLAUSES]]);; let SUM_NSUB = prove (`!n f c. sum(0,n) f - (&n * c) = sum(0,n)(\p. f(p) - c)`, INDUCT_TAC THEN REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_SUB_REFL] THEN REWRITE_TAC[ADD_CLAUSES; GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN REPEAT GEN_TAC THEN POP_ASSUM(fun th -> REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_MUL_LID; REAL_ADD_AC]);; let SUM_BOUND = prove (`!f K m n. (!p. m <= p /\ p < (m + n) ==> (f(p) <= K)) ==> (sum(m,n) f <= (&n * K))`, EVERY (replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_LE_REFL] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE; LE_REFL] THEN MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_ADD; LT_SUC_LE; LE_REFL]]);; let SUM_GROUP = prove (`!n k f. sum(0,n)(\m. sum(m * k,k) f) = sum(0,n * k) f`, INDUCT_TAC THEN REWRITE_TAC[sum; MULT_CLAUSES] THEN REPEAT GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ADD_CLAUSES; SUM_TWO]);; let SUM_1 = prove (`!f n. sum(n,1) f = f(n)`, REPEAT GEN_TAC THEN REWRITE_TAC[num_CONV `1`; sum; ADD_CLAUSES; REAL_ADD_LID]);; let SUM_2 = prove (`!f n. sum(n,2) f = f(n) + f(n + 1)`, REPEAT GEN_TAC THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN REWRITE_TAC[sum; ADD_CLAUSES; REAL_ADD_LID]);; let SUM_OFFSET = prove (`!f n k. sum(0,n)(\m. f(m + k)) = sum(0,n + k) f - sum(0,k) f`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN REWRITE_TAC[GSYM SUM_TWO; REAL_ADD_SUB] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN BETA_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC ADD_SYM);; let SUM_REINDEX = prove (`!f m k n. sum(m + k,n) f = sum(m,n)(\r. f(r + k))`, EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[ADD_AC]);; let SUM_0 = prove (`!m n. sum(m,n)(\r. &0) = &0`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID]);; let SUM_CANCEL = prove (`!f n d. sum(n,d) (\n. f(SUC n) - f(n)) = f(n + d) - f(n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN BETA_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_ADD_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);; let SUM_HORNER = prove (`!f n x. sum(0,SUC n)(\i. f(i) * x pow i) = f(0) + x * sum(0,n)(\i. f(SUC i) * x pow i)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c = b * (a * c)`] THEN REWRITE_TAC[GSYM real_pow] THEN MP_TAC(GEN `f:num->real` (SPECL [`f:num->real`; `n:num`; `1`] SUM_OFFSET)) THEN REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[SUM_1] THEN REWRITE_TAC[real_pow; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD]);; let SUM_CONST = prove (`!c n. sum(0,n) (\m. c) = &n * c`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[sum; GSYM REAL_OF_NUM_SUC; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_MUL_LID]);; let SUM_SPLIT = prove (`!f n p. sum(m,n) f + sum(m + n,p) f = sum(m,n + p) f`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SUM_DIFF] THEN GEN_REWRITE_TAC RAND_CONV [SUM_DIFF] THEN REWRITE_TAC[ADD_ASSOC] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM SUM_TWO] THEN REAL_ARITH_TAC);; let SUM_SWAP = prove (`!f m1 n1 m2 n2. sum(m1,n1) (\a. sum(m2,n2) (\b. f a b)) = sum(m2,n2) (\b. sum(m1,n1) (\a. f a b))`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum; SUM_0] THEN ASM_REWRITE_TAC[SUM_ADD]);; let SUM_EQ_0 = prove (`(!r. m <= r /\ r < m + n ==> (f(r) = &0)) ==> (sum(m,n) f = &0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(m,n) (\r. &0)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]);; let SUM_MORETERMS_EQ = prove (`!m n p. n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f(r) = &0)) ==> (sum(m,p) f = sum(m,n) f)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o GSYM o MATCH_MP SUB_ADD) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN SUBGOAL_THEN `sum (m + n,p - n) f = &0` (fun th -> REWRITE_TAC[REAL_ADD_RID; th]) THEN MATCH_MP_TAC SUM_EQ_0 THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `(m + n) + p - n:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM ADD_ASSOC; LE_ADD_LCANCEL] THEN MATCH_MP_TAC EQ_IMP_LE THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[SUB_ADD]);; let SUM_DIFFERENCES_EQ = prove (`!m n p. n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f(r) = g(r))) ==> (sum(m,p) f - sum(m,n) f = sum(m,p) g - sum(m,n) g)`, ONCE_REWRITE_TAC[REAL_ARITH `(a - b = c - d) <=> (a - c = b - d)`] THEN SIMP_TAC[GSYM SUM_SUB; SUM_MORETERMS_EQ; REAL_SUB_0]);; (* ------------------------------------------------------------------------- *) (* A conversion to evaluate summations (not clear it belongs here...) *) (* ------------------------------------------------------------------------- *) let REAL_SUM_CONV = let sum_tm = `sum` in let pth = prove (`sum(0,1) f = f 0`, REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES]) in let conv0 = GEN_REWRITE_CONV I [CONJUNCT1 sum; pth] and conv1 = REWR_CONV(CONJUNCT2 sum) in let rec sum_conv tm = try conv0 tm with Failure _ -> (LAND_CONV(RAND_CONV num_CONV) THENC conv1 THENC LAND_CONV sum_conv) tm in fun tm -> let sn,bod = dest_comb tm in let s,ntm = dest_comb sn in let _,htm = dest_pair ntm in if s = sum_tm && is_numeral htm then sum_conv tm else failwith "REAL_SUM_CONV";; let REAL_HORNER_SUM_CONV = let sum_tm = `sum` in let pth = prove (`sum(0,1) f = f 0`, REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES]) in let conv0 = GEN_REWRITE_CONV I [CONJUNCT1 sum; pth] and conv1 = REWR_CONV SUM_HORNER in let rec sum_conv tm = try conv0 tm with Failure _ -> (LAND_CONV(RAND_CONV num_CONV) THENC conv1 THENC RAND_CONV (RAND_CONV sum_conv)) tm in fun tm -> let sn,bod = dest_comb tm in let s,ntm = dest_comb sn in let _,htm = dest_pair ntm in if s = sum_tm && is_numeral htm then sum_conv tm else failwith "REAL_HORNER_SUM_CONV";; (*============================================================================*) (* Topologies and metric spaces, including metric on real line *) (*============================================================================*) parse_as_infix("re_union",(15,"right"));; parse_as_infix("re_intersect",(17,"right"));; parse_as_infix("re_subset",(12,"right"));; (*----------------------------------------------------------------------------*) (* Minimal amount of set notation is convenient *) (*----------------------------------------------------------------------------*) let re_Union = new_definition( `re_Union S = \x:A. ?s. S s /\ s x`);; let re_union = new_definition( `P re_union Q = \x:A. P x \/ Q x`);; let re_intersect = new_definition `P re_intersect Q = \x:A. P x /\ Q x`;; let re_null = new_definition( `re_null = \x:A. F`);; let re_universe = new_definition( `re_universe = \x:A. T`);; let re_subset = new_definition( `P re_subset Q <=> !x:A. P x ==> Q x`);; let re_compl = new_definition( `re_compl S = \x:A. ~(S x)`);; let SUBSETA_REFL = prove( `!S:A->bool. S re_subset S`, GEN_TAC THEN REWRITE_TAC[re_subset]);; let COMPL_MEM = prove( `!S:A->bool. !x. S x <=> ~(re_compl S x)`, REPEAT GEN_TAC THEN REWRITE_TAC[re_compl] THEN BETA_TAC THEN REWRITE_TAC[]);; let SUBSETA_ANTISYM = prove( `!P:A->bool. !Q. P re_subset Q /\ Q re_subset P <=> (P = Q)`, REPEAT GEN_TAC THEN REWRITE_TAC[re_subset] THEN CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN REWRITE_TAC[TAUT `(a ==> b) /\ (b ==> a) <=> (a <=> b)`] THEN CONV_TAC(RAND_CONV FUN_EQ_CONV) THEN REFL_TAC);; let SUBSETA_TRANS = prove( `!P:A->bool. !Q R. P re_subset Q /\ Q re_subset R ==> P re_subset R`, REPEAT GEN_TAC THEN REWRITE_TAC[re_subset] THEN CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN DISCH_THEN(MATCH_ACCEPT_TAC o GEN `x:A` o end_itlist IMP_TRANS o CONJUNCTS o SPEC `x:A`));; (*----------------------------------------------------------------------------*) (* Characterize an (A)topology *) (*----------------------------------------------------------------------------*) let istopology = new_definition( `!L:(A->bool)->bool. istopology L <=> L re_null /\ L re_universe /\ (!a b. L a /\ L b ==> L (a re_intersect b)) /\ (!P. P re_subset L ==> L (re_Union P))`);; let topology_tybij = new_type_definition "topology" ("topology","open") (prove(`?t:(A->bool)->bool. istopology t`, EXISTS_TAC `re_universe:(A->bool)->bool` THEN REWRITE_TAC[istopology; re_universe]));; let TOPOLOGY = prove( `!L:(A)topology. open(L) re_null /\ open(L) re_universe /\ (!x y. open(L) x /\ open(L) y ==> open(L) (x re_intersect y)) /\ (!P. P re_subset (open L) ==> open(L) (re_Union P))`, GEN_TAC THEN REWRITE_TAC[GSYM istopology] THEN REWRITE_TAC[topology_tybij]);; let TOPOLOGY_UNION = prove( `!L:(A)topology. !P. P re_subset (open L) ==> open(L) (re_Union P)`, REWRITE_TAC[TOPOLOGY]);; (*----------------------------------------------------------------------------*) (* Characterize a neighbourhood of a point relative to a topology *) (*----------------------------------------------------------------------------*) let neigh = new_definition( `neigh(top)(N,(x:A)) = ?P. open(top) P /\ P re_subset N /\ P x`);; (*----------------------------------------------------------------------------*) (* Prove various properties / characterizations of open sets *) (*----------------------------------------------------------------------------*) let OPEN_OWN_NEIGH = prove( `!S top. !x:A. open(top) S /\ S x ==> neigh(top)(S,x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[neigh] THEN EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL]);; let OPEN_UNOPEN = prove( `!S top. open(top) S <=> (re_Union (\P:A->bool. open(top) P /\ P re_subset S) = S)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SUBSETA_ANTISYM] THEN REWRITE_TAC[re_Union; re_subset] THEN BETA_TAC THEN CONJ_TAC THEN GEN_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `s:A->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_TAC THEN EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[]]; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC TOPOLOGY_UNION THEN REWRITE_TAC[re_subset] THEN BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]);; let OPEN_SUBOPEN = prove( `!S top. open(top) S <=> !x:A. S x ==> ?P. P x /\ open(top) P /\ P re_subset S`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL]; DISCH_TAC THEN C SUBGOAL_THEN SUBST1_TAC `S = re_Union (\P:A->bool. open(top) P /\ P re_subset S)` THENL [ONCE_REWRITE_TAC[GSYM SUBSETA_ANTISYM] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[re_subset] THEN REWRITE_TAC [re_Union] THEN BETA_TAC THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(X_CHOOSE_TAC `P:A->bool`) THEN EXISTS_TAC `P:A->bool` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[re_subset; re_Union] THEN BETA_TAC THEN GEN_TAC THEN DISCH_THEN(CHOOSE_THEN STRIP_ASSUME_TAC) THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]; MATCH_MP_TAC TOPOLOGY_UNION THEN ONCE_REWRITE_TAC[re_subset] THEN GEN_TAC THEN BETA_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);; let OPEN_NEIGH = prove( `!S top. open(top) S = !x:A. S x ==> ?N. neigh(top)(N,x) /\ N re_subset S`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `S:A->bool` THEN REWRITE_TAC[SUBSETA_REFL; neigh] THEN EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL]; DISCH_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(X_CHOOSE_THEN `N:A->bool` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[neigh] THEN DISCH_THEN(X_CHOOSE_THEN `P:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `P:A->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSETA_TRANS THEN EXISTS_TAC `N:A->bool` THEN ASM_REWRITE_TAC[]]);; (*----------------------------------------------------------------------------*) (* Characterize closed sets in a topological space *) (*----------------------------------------------------------------------------*) let closed = new_definition( `closed(L:(A)topology) S = open(L)(re_compl S)`);; (*----------------------------------------------------------------------------*) (* Define limit point in topological space *) (*----------------------------------------------------------------------------*) let limpt = new_definition( `limpt(top) x S <=> !N:A->bool. neigh(top)(N,x) ==> ?y. ~(x = y) /\ S y /\ N y`);; (*----------------------------------------------------------------------------*) (* Prove that a set is closed iff it contains all its limit points *) (*----------------------------------------------------------------------------*) let CLOSED_LIMPT = prove( `!top S. closed(top) S <=> (!x:A. limpt(top) x S ==> S x)`, REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN REWRITE_TAC[closed; limpt] THEN CONV_TAC(ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN FREEZE_THEN (fun th -> ONCE_REWRITE_TAC[th]) (SPEC `S:A->bool` COMPL_MEM) THEN REWRITE_TAC[] THEN SPEC_TAC(`re_compl(S:A->bool)`,`S:A->bool`) THEN GEN_TAC THEN REWRITE_TAC[NOT_IMP] THEN CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REWRITE_TAC[DE_MORGAN_THM] THEN REWRITE_TAC[OPEN_NEIGH; re_subset] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `(S:A->bool) x` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[TAUT `a \/ b \/ ~c <=> c ==> a \/ b`] THEN EQUAL_TAC THEN REWRITE_TAC[TAUT `(a <=> b \/ a) <=> b ==> a`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN POP_ASSUM ACCEPT_TAC);; (*----------------------------------------------------------------------------*) (* Characterize an (A)metric *) (*----------------------------------------------------------------------------*) let ismet = new_definition( `ismet (m:A#A->real) <=> (!x y. (m(x,y) = &0) <=> (x = y)) /\ (!x y z. m(y,z) <= m(x,y) + m(x,z))`);; let metric_tybij = new_type_definition "metric" ("metric","mdist") (prove(`?m:(A#A->real). ismet m`, EXISTS_TAC `\((x:A),(y:A)). if x = y then &0 else &1` THEN REWRITE_TAC[ismet] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [BOOL_CASES_TAC `x:A = y` THEN REWRITE_TAC[REAL_10]; REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_LE_REFL; REAL_LE_01] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN TRY(MATCH_MP_TAC REAL_LE_ADD2) THEN REWRITE_TAC[REAL_LE_01; REAL_LE_REFL] THEN FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN EVERY_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[]]));; (*----------------------------------------------------------------------------*) (* Derive the metric properties *) (*----------------------------------------------------------------------------*) let METRIC_ISMET = prove( `!m:(A)metric. ismet (mdist m)`, GEN_TAC THEN REWRITE_TAC[metric_tybij]);; let METRIC_ZERO = prove( `!m:(A)metric. !x y. ((mdist m)(x,y) = &0) <=> (x = y)`, REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN ASM_REWRITE_TAC[]);; let METRIC_SAME = prove( `!m:(A)metric. !x. (mdist m)(x,x) = &0`, REPEAT GEN_TAC THEN REWRITE_TAC[METRIC_ZERO]);; let METRIC_POS = prove( `!m:(A)metric. !x y. &0 <= (mdist m)(x,y)`, REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN FIRST_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`; `y:A`] o CONJUNCT2) THEN REWRITE_TAC[REWRITE_RULE[] (SPECL [`m:(A)metric`; `y:A`; `y:A`] METRIC_ZERO)] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2 o W CONJ) THEN REWRITE_TAC[REAL_ADD_LID]);; let METRIC_SYM = prove( `!m:(A)metric. !x y. (mdist m)(x,y) = (mdist m)(y,x)`, REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN FIRST_ASSUM (MP_TAC o GENL [`y:A`; `z:A`] o SPECL [`z:A`; `y:A`; `z:A`] o CONJUNCT2) THEN REWRITE_TAC[METRIC_SAME; REAL_ADD_RID] THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM]);; let METRIC_TRIANGLE = prove( `!m:(A)metric. !x y z. (mdist m)(x,z) <= (mdist m)(x,y) + (mdist m)(y,z)`, REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [METRIC_SYM] THEN ASM_REWRITE_TAC[]);; let METRIC_NZ = prove( `!m:(A)metric. !x y. ~(x = y) ==> &0 < (mdist m)(x,y)`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`m:(A)metric`; `x:A`; `y:A`] METRIC_ZERO)) THEN ONCE_REWRITE_TAC[TAUT `~a ==> b <=> b \/ a`] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM REAL_LE_LT; METRIC_POS]);; (*----------------------------------------------------------------------------*) (* Now define metric topology and prove equivalent definition of `open` *) (*----------------------------------------------------------------------------*) let mtop = new_definition( `!m:(A)metric. mtop m = topology(\S. !x. S x ==> ?e. &0 < e /\ (!y. (mdist m)(x,y) < e ==> S y))`);; let mtop_istopology = prove( `!m:(A)metric. istopology (\S. !x. S x ==> ?e. &0 < e /\ (!y. (mdist m)(x,y) < e ==> S y))`, GEN_TAC THEN REWRITE_TAC[istopology; re_null; re_universe; re_Union; re_intersect; re_subset] THEN CONV_TAC(REDEPTH_CONV BETA_CONV) THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC REAL_LT_01; REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(fun th -> POP_ASSUM(CONJUNCTS_THEN(MP_TAC o SPEC `x:A`)) THEN REWRITE_TAC[th]) THEN DISCH_THEN(X_CHOOSE_TAC `e1:real`) THEN DISCH_THEN(X_CHOOSE_TAC `e2:real`) THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC (SPECL [`e1:real`; `e2:real`] REAL_LT_TOTAL) THENL [DISCH_THEN SUBST_ALL_TAC THEN EXISTS_TAC `e2:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(fun th -> EVERY_ASSUM(ASSUME_TAC o C MATCH_MP th o CONJUNCT2)) THEN ASM_REWRITE_TAC[]; DISCH_THEN((then_) (EXISTS_TAC `e1:real`) o MP_TAC); DISCH_THEN((then_) (EXISTS_TAC `e2:real`) o MP_TAC)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th2 -> GEN_TAC THEN DISCH_THEN(fun th1 -> ASSUME_TAC th1 THEN ASSUME_TAC (MATCH_MP REAL_LT_TRANS (CONJ th1 th2)))) THEN CONJ_TAC THEN FIRST_ASSUM (MATCH_MP_TAC o CONJUNCT2) THEN FIRST_ASSUM ACCEPT_TAC; GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `y:A->bool` (fun th -> POP_ASSUM(X_CHOOSE_TAC `e:real` o C MATCH_MP (CONJUNCT2 th) o C MATCH_MP (CONJUNCT1 th)) THEN ASSUME_TAC th)) THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:A` THEN DISCH_THEN (fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th o CONJUNCT2)) THEN EXISTS_TAC `y:A->bool` THEN ASM_REWRITE_TAC[]]);; let MTOP_OPEN = prove( `!m:(A)metric. open(mtop m) S <=> (!x. S x ==> ?e. &0 < e /\ (!y. (mdist m(x,y)) < e ==> S y))`, GEN_TAC THEN REWRITE_TAC[mtop] THEN REWRITE_TAC[REWRITE_RULE[topology_tybij] mtop_istopology] THEN BETA_TAC THEN REFL_TAC);; (*----------------------------------------------------------------------------*) (* Define open ball in metric space + prove basic properties *) (*----------------------------------------------------------------------------*) let ball = new_definition( `!m:(A)metric. !x e. ball(m)(x,e) = \y. (mdist m)(x,y) < e`);; let BALL_OPEN = prove( `!m:(A)metric. !x e. &0 < e ==> open(mtop(m))(ball(m)(x,e))`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[MTOP_OPEN] THEN X_GEN_TAC `z:A` THEN REWRITE_TAC[ball] THEN BETA_TAC THEN DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN EXISTS_TAC `e - mdist(m:(A)metric)(x,z)` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:A` THEN REWRITE_TAC[REAL_LT_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `mdist(m)((x:A),z) + mdist(m)(z,y)` THEN ASM_REWRITE_TAC[METRIC_TRIANGLE]);; let BALL_NEIGH = prove( `!m:(A)metric. !x e. &0 < e ==> neigh(mtop(m))(ball(m)(x,e),x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[neigh] THEN EXISTS_TAC `ball(m)((x:A),e)` THEN REWRITE_TAC[SUBSETA_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC BALL_OPEN; REWRITE_TAC[ball] THEN BETA_TAC THEN REWRITE_TAC[METRIC_SAME]] THEN POP_ASSUM ACCEPT_TAC);; (*----------------------------------------------------------------------------*) (* Characterize limit point in a metric topology *) (*----------------------------------------------------------------------------*) let MTOP_LIMPT = prove( `!m:(A)metric. !x S. limpt(mtop m) x S <=> !e. &0 < e ==> ?y. ~(x = y) /\ S y /\ (mdist m)(x,y) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[limpt] THEN EQ_TAC THENL [DISCH_THEN((then_) (GEN_TAC THEN DISCH_TAC) o MP_TAC o SPEC `ball(m)((x:A),e)`) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BALL_NEIGH th]) THEN REWRITE_TAC[ball] THEN BETA_TAC THEN DISCH_THEN ACCEPT_TAC; DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[neigh] THEN DISCH_THEN(X_CHOOSE_THEN `P:A->bool` (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN REWRITE_TAC[MTOP_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `y:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(P:A->bool) re_subset N` THEN REWRITE_TAC[re_subset] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; (*----------------------------------------------------------------------------*) (* Define the usual metric on the real line *) (*----------------------------------------------------------------------------*) let ISMET_R1 = prove( `ismet (\(x,y). abs(y - x))`, REWRITE_TAC[ismet] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN REFL_TAC; SUBST1_TAC(SYM(SPECL [`x:real`; `y:real`] REAL_NEG_SUB)) THEN REWRITE_TAC[ABS_NEG] THEN SUBGOAL_THEN `z - y = (x - y) + (z - x)` (fun th -> SUBST1_TAC th THEN MATCH_ACCEPT_TAC ABS_TRIANGLE) THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (d + a) + (c + b)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]]);; let mr1 = new_definition( `mr1 = metric(\(x,y). abs(y - x))`);; let MR1_DEF = prove( `!x y. (mdist mr1)(x,y) = abs(y - x)`, REPEAT GEN_TAC THEN REWRITE_TAC[mr1; REWRITE_RULE[metric_tybij] ISMET_R1] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REFL_TAC);; let MR1_ADD = prove( `!x d. (mdist mr1)(x,x+d) = abs(d)`, REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; REAL_ADD_SUB]);; let MR1_SUB = prove( `!x d. (mdist mr1)(x,x-d) = abs(d)`, REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; REAL_SUB_SUB; ABS_NEG]);; let MR1_ADD_LE = prove( `!x d. &0 <= d ==> ((mdist mr1)(x,x+d) = d)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[MR1_ADD; real_abs]);; let MR1_SUB_LE = prove( `!x d. &0 <= d ==> ((mdist mr1)(x,x-d) = d)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[MR1_SUB; real_abs]);; let MR1_ADD_LT = prove( `!x d. &0 < d ==> ((mdist mr1)(x,x+d) = d)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN MATCH_ACCEPT_TAC MR1_ADD_LE);; let MR1_SUB_LT = prove( `!x d. &0 < d ==> ((mdist mr1)(x,x-d) = d)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN MATCH_ACCEPT_TAC MR1_SUB_LE);; let MR1_BETWEEN1 = prove( `!x y z. x < z /\ (mdist mr1)(x,y) < (z - x) ==> y < z`, REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; ABS_BETWEEN1]);; (*----------------------------------------------------------------------------*) (* Every real is a limit point of the real line *) (*----------------------------------------------------------------------------*) let MR1_LIMPT = prove( `!x. limpt(mtop mr1) x re_universe`, GEN_TAC THEN REWRITE_TAC[MTOP_LIMPT; re_universe] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `x + (e / &2)` THEN REWRITE_TAC[MR1_ADD] THEN SUBGOAL_THEN `&0 <= (e / &2)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[REAL_LT_HALF1]; ALL_TAC] THEN ASM_REWRITE_TAC[real_abs; REAL_LT_HALF2] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN REWRITE_TAC[REAL_ADD_RID_UNIQ] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[REAL_LT_HALF1]);; (*============================================================================*) (* Theory of Moore-Smith covergence nets, and special cases like sequences *) (*============================================================================*) parse_as_infix ("tends",(12,"right"));; (*----------------------------------------------------------------------------*) (* Basic definitions: directed set, net, bounded net, pointwise limit *) (*----------------------------------------------------------------------------*) let dorder = new_definition( `dorder (g:A->A->bool) <=> !x y. g x x /\ g y y ==> ?z. g z z /\ (!w. g w z ==> g w x /\ g w y)`);; let tends = new_definition `(s tends l)(top,g) <=> !N:A->bool. neigh(top)(N,l) ==> ?n:B. g n n /\ !m:B. g m n ==> N(s m)`;; let bounded = new_definition( `bounded((m:(A)metric),(g:B->B->bool)) f <=> ?k x N. g N N /\ (!n. g n N ==> (mdist m)(f(n),x) < k)`);; let tendsto = new_definition( `tendsto((m:(A)metric),x) y z <=> &0 < (mdist m)(x,y) /\ (mdist m)(x,y) <= (mdist m)(x,z)`);; parse_as_infix("-->",(12,"right"));; override_interface ("-->",`(tends)`);; let DORDER_LEMMA = prove( `!g:A->A->bool. dorder g ==> !P Q. (?n. g n n /\ (!m. g m n ==> P m)) /\ (?n. g n n /\ (!m. g m n ==> Q m)) ==> (?n. g n n /\ (!m. g m n ==> P m /\ Q m))`, GEN_TAC THEN REWRITE_TAC[dorder] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `N1:A` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `N2:A` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o SPECL [`N1:A`; `N2:A`]) THEN REWRITE_TAC[ASSUME `(g:A->A->bool) N1 N1`;ASSUME `(g:A->A->bool) N2 N2`] THEN DISCH_THEN(X_CHOOSE_THEN `n:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `n:A` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `m:A` THEN DISCH_TAC THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check(is_conj o snd o dest_imp o snd o dest_forall) o concl) THEN DISCH_THEN(MP_TAC o SPEC `m:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Following tactic is useful in the following proofs *) (*----------------------------------------------------------------------------*) let DORDER_THEN tac th = let [t1;t2] = map (rand o rand o body o rand) (conjuncts(concl th)) in let dog = (rator o rator o rand o rator o body) t1 in let thl = map ((uncurry X_BETA_CONV) o (I F_F rand) o dest_abs) [t1;t2] in let th1 = CONV_RULE(EXACT_CONV thl) th in let th2 = MATCH_MP DORDER_LEMMA (ASSUME (list_mk_icomb "dorder" [dog])) in let th3 = MATCH_MP th2 th1 in let th4 = CONV_RULE(EXACT_CONV(map SYM thl)) th3 in tac th4;; (*----------------------------------------------------------------------------*) (* Show that sequences and pointwise limits in a metric space are directed *) (*----------------------------------------------------------------------------*) let DORDER_NGE = prove( `dorder ((>=) :num->num->bool)`, REWRITE_TAC[dorder; GE; LE_REFL] THEN REPEAT GEN_TAC THEN DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THENL [EXISTS_TAC `y:num`; EXISTS_TAC `x:num`] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THENL [EXISTS_TAC `y:num`; EXISTS_TAC `x:num`] THEN ASM_REWRITE_TAC[]);; let DORDER_TENDSTO = prove( `!m:(A)metric. !x. dorder(tendsto(m,x))`, REPEAT GEN_TAC THEN REWRITE_TAC[dorder; tendsto] THEN MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN REWRITE_TAC[REAL_LE_REFL] THEN DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN DISJ_CASES_TAC(SPECL [`(mdist m)((x:A),v)`; `(mdist m)((x:A),u)`] REAL_LE_TOTAL) THENL [EXISTS_TAC `v:A`; EXISTS_TAC `u:A`] THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN FIRST_ASSUM (fun th -> (EXISTS_TAC o rand o concl) th THEN ASM_REWRITE_TAC[] THEN NO_TAC));; (*----------------------------------------------------------------------------*) (* Simpler characterization of limit in a metric topology *) (*----------------------------------------------------------------------------*) let MTOP_TENDS = prove( `!d g. !x:B->A. !x0. (x --> x0)(mtop(d),g) <=> !e. &0 < e ==> ?n. g n n /\ !m. g m n ==> mdist(d)(x(m),x0) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[tends] THEN EQ_TAC THEN DISCH_TAC THENL [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `ball(d)((x0:A),e)`) THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (rand o rator) o snd) THENL [MATCH_MP_TAC BALL_NEIGH THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[ball] THEN BETA_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [METRIC_SYM] THEN REWRITE_TAC[]; GEN_TAC THEN REWRITE_TAC[neigh] THEN DISCH_THEN(X_CHOOSE_THEN `P:A->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `open(mtop(d)) (P:A->bool)` THEN REWRITE_TAC[MTOP_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `x0:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `d:real`) THEN REWRITE_TAC[ASSUME `&0 < d`] THEN DISCH_THEN(X_CHOOSE_THEN `n:B` STRIP_ASSUME_TAC) THEN EXISTS_TAC `n:B` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN UNDISCH_TAC `(P:A->bool) re_subset N` THEN REWRITE_TAC[re_subset] THEN DISCH_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN ONCE_REWRITE_TAC[METRIC_SYM] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; (*----------------------------------------------------------------------------*) (* Prove that a net in a metric topology cannot converge to different limits *) (*----------------------------------------------------------------------------*) let MTOP_TENDS_UNIQ = prove( `!g d. dorder (g:B->B->bool) ==> (x --> x0)(mtop(d),g) /\ (x --> x1)(mtop(d),g) ==> (x0:A = x1)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[MTOP_TENDS] THEN CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC `mdist(d:(A)metric)(x0,x1) / &2` THEN W(C SUBGOAL_THEN ASSUME_TAC o rand o rator o rand o snd) THENL [REWRITE_TAC[REAL_LT_HALF1] THEN MATCH_MP_TAC METRIC_NZ THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N:B` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `N:B`) THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2) THEN REWRITE_TAC[REAL_HALF_DOUBLE; REAL_NOT_LT] THEN GEN_REWRITE_TAC(RAND_CONV o LAND_CONV) [METRIC_SYM] THEN MATCH_ACCEPT_TAC METRIC_TRIANGLE);; (*----------------------------------------------------------------------------*) (* Simpler characterization of limit of a sequence in a metric topology *) (*----------------------------------------------------------------------------*) let SEQ_TENDS = prove( `!d:(A)metric. !x x0. (x --> x0)(mtop(d), (>=) :num->num->bool) <=> !e. &0 < e ==> ?N. !n. n >= N ==> mdist(d)(x(n),x0) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; GE; LE_REFL]);; (*----------------------------------------------------------------------------*) (* And of limit of function between metric spaces *) (*----------------------------------------------------------------------------*) let LIM_TENDS = prove( `!m1:(A)metric. !m2:(B)metric. !f x0 y0. limpt(mtop m1) x0 re_universe ==> ((f --> y0)(mtop(m2),tendsto(m1,x0)) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < (mdist m1)(x,x0) /\ (mdist m1)(x,x0) <= d ==> (mdist m2)(f(x),y0) < e)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[MTOP_TENDS; tendsto] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_REFL] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `z:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(mdist m1)((x0:A),z)` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(ISPECL [`m1:(A)metric`; `x0:A`; `x:A`] METRIC_SYM) THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `limpt(mtop m1) (x0:A) re_universe` THEN REWRITE_TAC[MTOP_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[re_universe] THEN DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `y:A` THEN CONJ_TAC THENL [MATCH_MP_TAC METRIC_NZ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[METRIC_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(mdist m1)((x0:A),y)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC]);; (*----------------------------------------------------------------------------*) (* Similar, more conventional version, is also true at a limit point *) (*----------------------------------------------------------------------------*) let LIM_TENDS2 = prove( `!m1:(A)metric. !m2:(B)metric. !f x0 y0. limpt(mtop m1) x0 re_universe ==> ((f --> y0)(mtop(m2),tendsto(m1,x0)) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < (mdist m1)(x,x0) /\ (mdist m1)(x,x0) < d ==> (mdist m2)(f(x),y0) < e)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LIM_TENDS th]) THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2]]);; (*----------------------------------------------------------------------------*) (* Simpler characterization of boundedness for the real line *) (*----------------------------------------------------------------------------*) let MR1_BOUNDED = prove( `!(g:A->A->bool) f. bounded(mr1,g) f <=> ?k N. g N N /\ (!n. g n N ==> abs(f n) < k)`, REPEAT GEN_TAC THEN REWRITE_TAC[bounded; MR1_DEF] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ABS_CONV) [SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN CONV_TAC(REDEPTH_CONV EXISTS_AND_CONV) THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THENL [DISCH_THEN(X_CHOOSE_TAC `x:real`) THEN EXISTS_TAC `abs(x) + k` THEN GEN_TAC THEN DISCH_TAC THEN SUBST1_TAC(SYM(SPECL [`(f:A->real) n`; `x:real`] REAL_SUB_ADD)) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs((f:A->real) n - x) + abs(x)` THEN REWRITE_TAC[ABS_TRIANGLE] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN REWRITE_TAC[REAL_LT_RADD] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`k:real`; `&0`] THEN ASM_REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG]]);; (*----------------------------------------------------------------------------*) (* Firstly, prove useful forms of null and bounded nets *) (*----------------------------------------------------------------------------*) let NET_NULL = prove( `!g:A->A->bool. !x x0. (x --> x0)(mtop(mr1),g) <=> ((\n. x(n) - x0) --> &0)(mtop(mr1),g)`, REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS] THEN BETA_TAC THEN REWRITE_TAC[MR1_DEF; REAL_SUB_LZERO] THEN EQUAL_TAC THEN REWRITE_TAC[REAL_NEG_SUB]);; let NET_CONV_BOUNDED = prove( `!g:A->A->bool. !x x0. (x --> x0)(mtop(mr1),g) ==> bounded(mr1,g) x`, REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; bounded] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0] THEN REWRITE_TAC[GSYM(num_CONV `1`)] THEN DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`&1`; `x0:real`; `N:A`] THEN ASM_REWRITE_TAC[]);; let NET_CONV_NZ = prove( `!g:A->A->bool. !x x0. (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) ==> ?N. g N N /\ (!n. g n N ==> ~(x n = &0))`, REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; bounded] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `abs(x0)`) ASSUME_TAC) THEN ASM_REWRITE_TAC[GSYM ABS_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_TAC THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[MR1_DEF; REAL_SUB_RZERO; REAL_LT_REFL]);; let NET_CONV_IBOUNDED = prove( `!g:A->A->bool. !x x0. (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) ==> bounded(mr1,g) (\n. inv(x n))`, REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_BOUNDED; MR1_DEF] THEN BETA_TAC THEN REWRITE_TAC[ABS_NZ] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `abs(x0) / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`&2 / abs(x0)`; `N:A`] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:A` THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN SUBGOAL_THEN `(abs(x0) / &2) < abs(x(n:A))` ASSUME_TAC THENL [SUBST1_TAC(SYM(SPECL [`abs(x0) / &2`; `abs(x0) / &2`; `abs(x(n:A))`] REAL_LT_LADD)) THEN REWRITE_TAC[REAL_HALF_DOUBLE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x0 - x(n:A)) + abs(x(n))` THEN ASM_REWRITE_TAC[REAL_LT_RADD] THEN SUBST1_TAC(SYM(AP_TERM `abs` (SPECL [`x0:real`; `x(n:A):real`] REAL_SUB_ADD))) THEN MATCH_ACCEPT_TAC ABS_TRIANGLE; ALL_TAC] THEN SUBGOAL_THEN `&0 < abs(x(n:A))` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `abs(x0) / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF1]; ALL_TAC] THEN SUBGOAL_THEN `&2 / abs(x0) = inv(abs(x0) / &2)` SUBST1_TAC THENL [MATCH_MP_TAC REAL_RINV_UNIQ THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (d * a) * (b * c)`] THEN SUBGOAL_THEN `~(abs(x0) = &0) /\ ~(&2 = &0)` (fun th -> CONJUNCTS_THEN(SUBST1_TAC o MATCH_MP REAL_MUL_LINV) th THEN REWRITE_TAC[REAL_MUL_LID]) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[ABS_NZ; ABS_ABS]; REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]]; ALL_TAC] THEN SUBGOAL_THEN `~(x(n:A) = &0)` (SUBST1_TAC o MATCH_MP ABS_INV) THENL [ASM_REWRITE_TAC[ABS_NZ]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_HALF1]);; (*----------------------------------------------------------------------------*) (* Now combining theorems for null nets *) (*----------------------------------------------------------------------------*) let NET_NULL_ADD = prove( `!g:A->A->bool. dorder g ==> !x y. (x --> &0)(mtop(mr1),g) /\ (y --> &0)(mtop(mr1),g) ==> ((\n. x(n) + y(n)) --> &0)(mtop(mr1),g)`, GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC o end_itlist CONJ o map (SPEC `e / &2`) o CONJUNCTS) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(DORDER_THEN (X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN BETA_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x(m:A)) + abs(y(m:A))` THEN REWRITE_TAC[ABS_TRIANGLE] THEN RULE_ASSUM_TAC BETA_RULE THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]);; let NET_NULL_MUL = prove( `!g:A->A->bool. dorder g ==> !x y. bounded(mr1,g) x /\ (y --> &0)(mtop(mr1),g) ==> ((\n. x(n) * y(n)) --> &0)(mtop(mr1),g)`, GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[MR1_BOUNDED] THEN REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN CONV_TAC(LAND_CONV LEFT_AND_EXISTS_CONV) THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN DISCH_THEN(ASSUME_TAC o uncurry CONJ o (I F_F SPEC `e / k`) o CONJ_PAIR) THEN SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL [FIRST_ASSUM(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) o CONJUNCT1) THEN DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x(N:A))` THEN ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN SUBGOAL_THEN `&0 < e / k` ASSUME_TAC THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LT_RDIV_0 th] THEN ASM_REWRITE_TAC[] THEN NO_TAC); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DORDER_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN (ASSUME_TAC o BETA_RULE)) THEN SUBGOAL_THEN `e = k * (e / k)` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&0 < &0` THEN REWRITE_TAC[REAL_LT_REFL]; ALL_TAC] THEN BETA_TAC THEN REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN ASM_REWRITE_TAC[ABS_POS]);; let NET_NULL_CMUL = prove( `!g:A->A->bool. !k x. (x --> &0)(mtop(mr1),g) ==> ((\n. k * x(n)) --> &0)(mtop(mr1),g)`, REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_DEF] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG] THEN DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN ASM_CASES_TAC `k = &0` THENL [DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT; num_CONV `1`; LESS_SUC_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; real_abs; REAL_LE_REFL]; DISCH_THEN(MP_TAC o SPEC `e / abs(k)`) THEN SUBGOAL_THEN `&0 < e / abs(k)` ASSUME_TAC THENL [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[GSYM ABS_NZ]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN SUBGOAL_THEN `e = abs(k) * (e / abs(k))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_REWRITE_TAC[ABS_ZERO]; ALL_TAC] THEN REWRITE_TAC[ABS_MUL] THEN SUBGOAL_THEN `&0 < abs k` (fun th -> REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ th]) THEN ASM_REWRITE_TAC[GSYM ABS_NZ]]);; (*----------------------------------------------------------------------------*) (* Now real arithmetic theorems for convergent nets *) (*----------------------------------------------------------------------------*) let NET_ADD = prove( `!g:A->A->bool x x0 y y0. dorder g ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) ==> ((\n. x(n) + y(n)) --> (x0 + y0))(mtop(mr1),g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[NET_NULL] THEN DISCH_THEN(fun th -> FIRST_ASSUM (MP_TAC o C MATCH_MP th o MATCH_MP NET_NULL_ADD)) THEN MATCH_MP_TAC EQ_IMP THEN EQUAL_TAC THEN BETA_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD] THEN REWRITE_TAC[REAL_ADD_AC]);; let NET_NEG = prove( `!g:A->A->bool x x0. dorder g ==> ((x --> x0)(mtop(mr1),g) <=> ((\n. --(x n)) --> --x0)(mtop(mr1),g))`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_DEF] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_NEG2] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN REFL_TAC);; let NET_SUB = prove( `!g:A->A->bool x x0 y y0. dorder g ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) ==> ((\n. x(n) - y(n)) --> (x0 - y0))(mtop(mr1),g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_sub] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `--(y(n:A))`]) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_ADD) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP NET_NEG th)]) THEN ASM_REWRITE_TAC[]);; let NET_MUL = prove( `!g:A->A->bool x y x0 y0. dorder g ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) ==> ((\n. x(n) * y(n)) --> (x0 * y0))(mtop(mr1),g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[NET_NULL] THEN DISCH_TAC THEN BETA_TAC THEN SUBGOAL_THEN `!a b c d. (a * b) - (c * d) = (a * (b - d)) + ((a - c) * d)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_RDISTRIB; GSYM REAL_ADD_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `x(n:A) * (y(n) - y0)`]) THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `(x(n:A) - x0) * y0`]) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_NULL_ADD) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN (CONV_TAC o EXACT_CONV o map (X_BETA_CONV `n:A`)) [`y(n:A) - y0`; `x(n:A) - x0`] THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_NULL_MUL) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NET_CONV_BOUNDED THEN EXISTS_TAC `x0:real` THEN ONCE_REWRITE_TAC[NET_NULL] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC NET_NULL_CMUL THEN ASM_REWRITE_TAC[]]);; let NET_INV = prove( `!g:A->A->bool x x0. dorder g ==> (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) ==> ((\n. inv(x(n))) --> inv x0)(mtop(mr1),g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC(CONJ (MATCH_MP NET_CONV_IBOUNDED th) (MATCH_MP NET_CONV_NZ th))) THEN REWRITE_TAC[MR1_BOUNDED] THEN CONV_TAC(ONCE_DEPTH_CONV LEFT_AND_EXISTS_CONV) THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN BETA_TAC THEN DISCH_THEN(MP_TAC o C CONJ (ASSUME `(x --> x0)(mtop mr1,(g:A->A->bool))`)) THEN ONCE_REWRITE_TAC[NET_NULL] THEN REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN BETA_TAC THEN DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN ONCE_REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN DISCH_THEN(ASSUME_TAC o SPEC `e * abs(x0) * (inv k)`) THEN SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(inv(x(N:A)))` THEN ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN SUBGOAL_THEN `&0 < e * abs(x0) * inv k` ASSUME_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN ASM_REWRITE_TAC[GSYM ABS_NZ] THEN MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN ASSUME_TAC)) THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:A` THEN DISCH_THEN(ANTE_RES_THEN STRIP_ASSUME_TAC) THEN RULE_ASSUM_TAC BETA_RULE THEN POP_ASSUM_LIST(MAP_EVERY STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `inv(x n) - inv x0 = inv(x n) * inv x0 * (x0 - x(n:A))` SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x0 = &0)`)] THEN REWRITE_TAC[REAL_MUL_RID] THEN REPEAT AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[MATCH_MP REAL_MUL_RINV (ASSUME `~(x(n:A) = &0)`)] THEN REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN REWRITE_TAC[ABS_MUL] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN SUBGOAL_THEN `e = e * (abs(inv x0) * abs(x0)) * (inv k * k)` SUBST1_TAC THENL [REWRITE_TAC[GSYM ABS_MUL] THEN REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x0 = &0)`)] THEN REWRITE_TAC[MATCH_MP REAL_MUL_LINV (GSYM(MATCH_MP REAL_LT_IMP_NE (ASSUME `&0 < k`)))] THEN REWRITE_TAC[REAL_MUL_RID] THEN REWRITE_TAC[real_abs; REAL_LE; LE_LT; num_CONV `1`; LESS_SUC_REFL] THEN REWRITE_TAC[SYM(num_CONV `1`); REAL_MUL_RID]; ALL_TAC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * (b * c) * (d * e) = e * b * (a * c * d)`] THEN REWRITE_TAC[GSYM ABS_MUL] THEN MATCH_MP_TAC ABS_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_MUL] THEN SUBGOAL_THEN `&0 < abs(inv x0)` (fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ th]) THEN REWRITE_TAC[GSYM ABS_NZ] THEN MATCH_MP_TAC REAL_INV_NZ THEN ASM_REWRITE_TAC[]);; let NET_DIV = prove( `!g:A->A->bool x x0 y y0. dorder g ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) /\ ~(y0 = &0) ==> ((\n. x(n) / y(n)) --> (x0 / y0))(mtop(mr1),g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `inv(y(n:A))`]) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_MUL) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_INV) THEN ASM_REWRITE_TAC[]);; let NET_ABS = prove( `!x x0. (x --> x0)(mtop(mr1),g) ==> ((\n:A. abs(x n)) --> abs(x0))(mtop(mr1),g)`, REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_THEN(fun th -> POP_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:A` THEN DISCH_TAC THEN BETA_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `mdist(mr1)(x(n:A),x0)` THEN CONJ_TAC THENL [REWRITE_TAC[MR1_DEF; ABS_SUB_ABS]; FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; let NET_SUM = prove (`!g. dorder g /\ ((\x. &0) --> &0)(mtop(mr1),g) ==> !m n. (!r. m <= r /\ r < m + n ==> (f r --> l r)(mtop(mr1),g)) ==> ((\x. sum(m,n) (\r. f r x)) --> sum(m,n) l) (mtop(mr1),g)`, GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN ASM_SIMP_TAC[sum] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_ADD) THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `r:num` THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `a < b + c ==> a < b + SUC c`]; CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM MATCH_MP_TAC THEN ARITH_TAC]);; (*----------------------------------------------------------------------------*) (* Comparison between limits *) (*----------------------------------------------------------------------------*) let NET_LE = prove( `!g:A->A->bool x x0 y y0. dorder g ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) /\ (?N. g N N /\ !n. g n N ==> x(n) <= y(n)) ==> x0 <= y0`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[MTOP_TENDS] THEN DISCH_THEN(MP_TAC o end_itlist CONJ o map (SPEC `(x0 - y0) / &2`) o CONJUNCTS) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN FIRST_ASSUM(UNDISCH_TAC o check is_exists o concl) THEN DISCH_THEN(fun th1 -> DISCH_THEN (fun th2 -> MP_TAC(CONJ th1 th2))) THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN BETA_TAC THEN DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MR1_DEF] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC ABS_BETWEEN2 THEN MAP_EVERY EXISTS_TAC [`y0:real`; `x0:real`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN FIRST_ASSUM ACCEPT_TAC);; (*============================================================================*) (* Theory of sequences and series of real numbers *) (*============================================================================*) parse_as_infix ("tends_num_real",(12,"right"));; parse_as_infix ("sums",(12,"right"));; (*----------------------------------------------------------------------------*) (* Specialize net theorems to sequences:num->real *) (*----------------------------------------------------------------------------*) let tends_num_real = new_definition( `x tends_num_real x0 <=> (x tends x0)(mtop(mr1), (>=) :num->num->bool)`);; override_interface ("-->",`(tends_num_real)`);; let SEQ = prove( `!x x0. (x --> x0) <=> !e. &0 < e ==> ?N. !n. n >= N ==> abs(x(n) - x0) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real; SEQ_TENDS; MR1_DEF] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN REFL_TAC);; let SEQ_CONST = prove( `!k. (\x. k) --> k`, REPEAT GEN_TAC THEN REWRITE_TAC[SEQ; REAL_SUB_REFL; ABS_0] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; let SEQ_ADD = prove( `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) + y(n)) --> (x0 + y0)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC NET_ADD THEN MATCH_ACCEPT_TAC DORDER_NGE);; let SEQ_MUL = prove( `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) * y(n)) --> (x0 * y0)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC NET_MUL THEN MATCH_ACCEPT_TAC DORDER_NGE);; let SEQ_NEG = prove( `!x x0. x --> x0 <=> (\n. --(x n)) --> --x0`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC NET_NEG THEN MATCH_ACCEPT_TAC DORDER_NGE);; let SEQ_INV = prove( `!x x0. x --> x0 /\ ~(x0 = &0) ==> (\n. inv(x n)) --> inv x0`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC NET_INV THEN MATCH_ACCEPT_TAC DORDER_NGE);; let SEQ_SUB = prove( `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) - y(n)) --> (x0 - y0)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC NET_SUB THEN MATCH_ACCEPT_TAC DORDER_NGE);; let SEQ_DIV = prove( `!x x0 y y0. x --> x0 /\ y --> y0 /\ ~(y0 = &0) ==> (\n. x(n) / y(n)) --> (x0 / y0)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC NET_DIV THEN MATCH_ACCEPT_TAC DORDER_NGE);; let SEQ_UNIQ = prove( `!x x1 x2. x --> x1 /\ x --> x2 ==> (x1 = x2)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC MTOP_TENDS_UNIQ THEN MATCH_ACCEPT_TAC DORDER_NGE);; let SEQ_NULL = prove( `!s l. s --> l <=> (\n. s(n) - l) --> &0`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_ACCEPT_TAC NET_NULL);; let SEQ_SUM = prove (`!f l m n. (!r. m <= r /\ r < m + n ==> f r --> l r) ==> (\k. sum(m,n) (\r. f r k)) --> sum(m,n) l`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] NET_SUM) THEN REWRITE_TAC[SEQ_CONST; DORDER_NGE; GSYM tends_num_real]);; let SEQ_TRANSFORM = prove (`!s t l N. (!n. N <= n ==> (s n = t n)) /\ s --> l ==> t --> l`, REWRITE_TAC[SEQ; GE] THEN MESON_TAC[ARITH_RULE `M + N <= n:num ==> M <= n /\ N <= n`]);; (*----------------------------------------------------------------------------*) (* Define convergence and Cauchy-ness *) (*----------------------------------------------------------------------------*) let convergent = new_definition( `convergent f <=> ?l. f --> l`);; let cauchy = new_definition( `cauchy f <=> !e. &0 < e ==> ?N:num. !m n. m >= N /\ n >= N ==> abs(f(m) - f(n)) < e`);; let lim = new_definition( `lim f = @l. f --> l`);; let SEQ_LIM = prove( `!f. convergent f <=> (f --> lim f)`, GEN_TAC THEN REWRITE_TAC[convergent] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[lim]; DISCH_TAC THEN EXISTS_TAC `lim f` THEN POP_ASSUM ACCEPT_TAC]);; (*----------------------------------------------------------------------------*) (* Define a subsequence *) (*----------------------------------------------------------------------------*) let subseq = new_definition( `subseq (f:num->num) <=> !m n. m < n ==> (f m) < (f n)`);; let SUBSEQ_SUC = prove( `!f. subseq f <=> !n. f(n) < f(SUC n)`, GEN_TAC THEN REWRITE_TAC[subseq] THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `n:num` THEN POP_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LESS_SUC_REFL]; REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THENL [ALL_TAC; MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `f(m + (SUC p)):num`] THEN ASM_REWRITE_TAC[ADD_CLAUSES]]);; (*----------------------------------------------------------------------------*) (* Define monotonicity *) (*----------------------------------------------------------------------------*) let mono = new_definition( `mono (f:num->real) <=> (!m n. m <= n ==> f(m) <= f(n)) \/ (!m n. m <= n ==> f(m) >= f(n))`);; let MONO_SUC = prove( `!f. mono f <=> (!n. f(SUC n) >= f(n)) \/ (!n. f(SUC n) <= f(n))`, GEN_TAC THEN REWRITE_TAC[mono; real_ge] THEN MATCH_MP_TAC(TAUT `(a <=> c) /\ (b <=> d) ==> (a \/ b <=> c \/ d)`) THEN CONJ_TAC THEN (EQ_TAC THENL [DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`n:num`; `SUC n`]) THEN REWRITE_TAC[LESS_EQ_SUC_REFL]; DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(m + p:num):real` THEN ASM_REWRITE_TAC[]]));; (*----------------------------------------------------------------------------*) (* Simpler characterization of bounded sequence *) (*----------------------------------------------------------------------------*) let MAX_LEMMA = prove( `!s N. ?k. !n:num. n < N ==> abs(s n) < k`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0] THEN POP_ASSUM(X_CHOOSE_TAC `k:real`) THEN DISJ_CASES_TAC (SPECL [`k:real`; `abs(s(N:num))`] REAL_LET_TOTAL) THENL [EXISTS_TAC `abs(s(N:num)) + &1`; EXISTS_TAC `k:real`] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[CONJUNCT2 LT] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN TRY(MATCH_MP_TAC REAL_LT_ADD1) THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN MATCH_MP_TAC REAL_LT_ADD1 THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);; let SEQ_BOUNDED = prove( `!s. bounded(mr1, (>=)) s <=> ?k. !n:num. abs(s n) < k`, GEN_TAC THEN REWRITE_TAC[MR1_BOUNDED] THEN REWRITE_TAC[GE; LE_REFL] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `k:real` (X_CHOOSE_TAC `N:num`)) THEN MP_TAC(SPECL [`s:num->real`; `N:num`] MAX_LEMMA) THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN DISJ_CASES_TAC (SPECL [`k:real`; `l:real`] REAL_LE_TOTAL) THENL [EXISTS_TAC `l:real`; EXISTS_TAC `k:real`] THEN X_GEN_TAC `n:num` THEN MP_TAC(SPECL [`n:num`; `N:num`] LTE_CASES) THEN DISCH_THEN(DISJ_CASES_THEN(ANTE_RES_THEN ASSUME_TAC)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN ASM_REWRITE_TAC[] THEN NO_TAC); DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN MAP_EVERY EXISTS_TAC [`k:real`; `0`] THEN GEN_TAC THEN ASM_REWRITE_TAC[]]);; let SEQ_BOUNDED_2 = prove( `!f k K. (!n:num. k <= f(n) /\ f(n) <= K) ==> bounded(mr1, (>=)) f`, REPEAT STRIP_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN EXISTS_TAC `(abs(k) + abs(K)) + &1` THEN GEN_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(k) + abs(K)` THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN GEN_REWRITE_TAC LAND_CONV [real_abs] THEN COND_CASES_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(K)` THEN REWRITE_TAC[REAL_LE_ADDL; ABS_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[ABS_LE]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(k)` THEN REWRITE_TAC[REAL_LE_ADDR; ABS_POS] THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN SUBGOAL_THEN `&0 <= f(n:num)` MP_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]]);; (*----------------------------------------------------------------------------*) (* Show that every Cauchy sequence is bounded *) (*----------------------------------------------------------------------------*) let SEQ_CBOUNDED = prove( `!f. cauchy f ==> bounded(mr1, (>=)) f`, GEN_TAC THEN REWRITE_TAC[bounded; cauchy] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MAP_EVERY EXISTS_TAC [`&1`; `(f:num->real) N`; `N:num`] THEN REWRITE_TAC[GE; LE_REFL] THEN POP_ASSUM(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[GE; LE_REFL; MR1_DEF]);; (*----------------------------------------------------------------------------*) (* Show that a bounded and monotonic sequence converges *) (*----------------------------------------------------------------------------*) let SEQ_ICONV = prove( `!f. bounded(mr1, (>=)) f /\ (!m n. m >= n ==> f(m) >= f(n)) ==> convergent f`, GEN_TAC THEN DISCH_TAC THEN MP_TAC (SPEC `\x:real. ?n:num. x = f(n)` REAL_SUP) THEN BETA_TAC THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`f(0):real`; `0`] THEN REFL_TAC; POP_ASSUM(MP_TAC o REWRITE_RULE[SEQ_BOUNDED] o CONJUNCT1) THEN DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN EXISTS_TAC `k:real` THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(f(n:num))` THEN ASM_REWRITE_TAC[ABS_LE]]; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN REWRITE_TAC[convergent] THEN EXISTS_TAC `sup(\x. ?n:num. x = f(n))` THEN REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o check(is_forall o concl)) THEN DISCH_THEN(MP_TAC o SPEC `sup(\x. ?n:num. x = f(n)) - e`) THEN REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_THEN `n:num` SUBST1_TAC)) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_LT_SUB_RADD] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. f(n) <= sup(\x. ?n:num. x = f(n))` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `sup(\x. ?n:num. x = f(n))`) THEN REWRITE_TAC[REAL_LT_REFL] THEN CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN REWRITE_TAC[REAL_NOT_LT] THEN CONV_TAC(ONCE_DEPTH_CONV LEFT_IMP_EXISTS_CONV) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`(f:num->real) n`; `n:num`]) THEN REWRITE_TAC[]; ALL_TAC] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_SUB_RADD]) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_LT_SUB_RADD]) THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN SUBGOAL_THEN `(sup(\x. ?m:num. x = f(m)) - e) < f(m)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_NEG_SUB] THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub] THEN (SUBST1_TAC o REWRITE_RULE[REAL_ADD_RINV] o C SPECL REAL_LE_RADD) [`(f:num->real) m`; `(sup(\x. ?n:num. x = f(n)))`; `--(sup(\x. ?n:num. x = f(n)))`] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_LT_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_LT_SUB_RADD] THEN ASM_REWRITE_TAC[]]);; let SEQ_NEG_CONV = prove( `!f. convergent f <=> convergent (\n. --(f n))`, GEN_TAC THEN REWRITE_TAC[convergent] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN EXISTS_TAC `--l` THEN POP_ASSUM MP_TAC THEN SUBST1_TAC(SYM(SPEC `l:real` REAL_NEGNEG)) THEN REWRITE_TAC[GSYM SEQ_NEG] THEN REWRITE_TAC[REAL_NEGNEG]);; let SEQ_NEG_BOUNDED = prove( `!f. bounded(mr1, (>=))(\n:num. --(f n)) <=> bounded(mr1, (>=)) f`, GEN_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN BETA_TAC THEN REWRITE_TAC[ABS_NEG]);; let SEQ_BCONV = prove( `!f. bounded(mr1, (>=)) f /\ mono f ==> convergent f`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[mono] THEN DISCH_THEN DISJ_CASES_TAC THENL [MATCH_MP_TAC SEQ_ICONV THEN ASM_REWRITE_TAC[GE; real_ge]; ONCE_REWRITE_TAC[SEQ_NEG_CONV] THEN MATCH_MP_TAC SEQ_ICONV THEN ASM_REWRITE_TAC[SEQ_NEG_BOUNDED] THEN BETA_TAC THEN REWRITE_TAC[GE; real_ge; REAL_LE_NEG] THEN ONCE_REWRITE_TAC[GSYM real_ge] THEN ASM_REWRITE_TAC[]]);; (*----------------------------------------------------------------------------*) (* Show that every sequence contains a monotonic subsequence *) (*----------------------------------------------------------------------------*) let SEQ_MONOSUB = prove( `!s:num->real. ?f. subseq f /\ mono(\n.s(f n))`, GEN_TAC THEN ASM_CASES_TAC `!n:num. ?p. p > n /\ !m. m >= p ==> s(m) <= s(p)` THENL [(X_CHOOSE_THEN `f:num->num` MP_TAC o EXISTENCE o C ISPECL num_Axiom) [`@p. p > 0 /\ (!m. m >= p ==> (s m) <= (s p))`; `\x. \n:num. @p:num. p > x /\ (!m. m >= p ==> (s m) <= (s p))`] THEN BETA_TAC THEN RULE_ASSUM_TAC(GEN `n:num` o SELECT_RULE o SPEC `n:num`) THEN POP_ASSUM(fun th -> DISCH_THEN(ASSUME_TAC o GSYM) THEN MP_TAC(SPEC `0` th) THEN MP_TAC(GEN `n:num` (SPEC `(f:num->num) n` th))) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN REPEAT STRIP_TAC THEN EXISTS_TAC `f:num->num` THEN ASM_REWRITE_TAC[SUBSEQ_SUC; GSYM GT] THEN SUBGOAL_THEN `!p q. p:num >= (f q) ==> s(p) <= s(f(q:num))` MP_TAC THENL [REPEAT GEN_TAC THEN STRUCT_CASES_TAC(SPEC `q:num` num_CASES) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN `q:num` o SPECL [`f(SUC q):num`; `q:num`]) THEN SUBGOAL_THEN `!q. f(SUC q):num >= f(q)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[GSYM GT]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[MONO_SUC] THEN DISJ2_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[]; POP_ASSUM(X_CHOOSE_TAC `N:num` o CONV_RULE NOT_FORALL_CONV) THEN POP_ASSUM(MP_TAC o CONV_RULE NOT_EXISTS_CONV) THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN CONV_TAC(ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `!p. p >= SUC N ==> (?m. m > p /\ s(p) < s(m))` MP_TAC THENL [GEN_TAC THEN REWRITE_TAC[GE; LE_SUC_LT] THEN REWRITE_TAC[GSYM GT] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[GE; LE_LT; RIGHT_AND_OVER_OR; GT] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` DISJ_CASES_TAC) THENL [EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]; FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[REAL_LT_REFL]]; ALL_TAC] THEN POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN (X_CHOOSE_THEN `f:num->num` MP_TAC o EXISTENCE o C ISPECL num_Axiom) [`@m. m > (SUC N) /\ s(SUC N) < s(m)`; `\x. \n:num. @m:num. m > x /\ s(x) < s(m)`] THEN BETA_TAC THEN DISCH_THEN ASSUME_TAC THEN SUBGOAL_THEN `!n. f(n) >= (SUC N) /\ f(SUC n) > f(n) /\ s(f n) < s(f(SUC n):num)` MP_TAC THENL [INDUCT_TAC THENL [SUBGOAL_THEN `f(0) >= (SUC N)` MP_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `SUC N`) THEN REWRITE_TAC[GE; LE_REFL] THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[GSYM GT]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN REWRITE_TAC[th]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[CONJUNCT2 th]) THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM(UNDISCH_TAC o check((=)3 o length o conjuncts) o concl) THEN DISCH_THEN STRIP_ASSUME_TAC THEN CONJ_TAC THENL [REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(f:num->num) n` THEN REWRITE_TAC[GSYM GE] THEN CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC LT_IMP_LE THEN REWRITE_TAC[GSYM GT] THEN FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM(SUBST1_TAC o SPEC `SUC n` o CONJUNCT2) THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(f:num->num) n` THEN REWRITE_TAC[GSYM GE] THEN CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC LT_IMP_LE THEN REWRITE_TAC[GSYM GT] THEN FIRST_ASSUM ACCEPT_TAC]]; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN EXISTS_TAC `f:num->num` THEN REWRITE_TAC[SUBSEQ_SUC; MONO_SUC] THEN ASM_REWRITE_TAC[GSYM GT] THEN DISJ1_TAC THEN BETA_TAC THEN GEN_TAC THEN REWRITE_TAC[real_ge] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]);; (*----------------------------------------------------------------------------*) (* Show that a subsequence of a bounded sequence is bounded *) (*----------------------------------------------------------------------------*) let SEQ_SBOUNDED = prove( `!s (f:num->num). bounded(mr1, (>=)) s ==> bounded(mr1, (>=)) (\n. s(f n))`, REPEAT GEN_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN EXISTS_TAC `k:real` THEN GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Show we can take subsequential terms arbitrarily far up a sequence *) (*----------------------------------------------------------------------------*) let SEQ_SUBLE = prove( `!f n. subseq f ==> n <= f(n)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[GSYM NOT_LT; NOT_LESS_0]; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC(f(n:num))` THEN ASM_REWRITE_TAC[LE_SUC] THEN REWRITE_TAC[LE_SUC_LT] THEN UNDISCH_TAC `subseq f` THEN REWRITE_TAC[SUBSEQ_SUC] THEN DISCH_THEN MATCH_ACCEPT_TAC]);; let SEQ_DIRECT = prove( `!f. subseq f ==> !N1 N2. ?n. n >= N1 /\ f(n) >= N2`, GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISJ_CASES_TAC (SPECL [`N1:num`; `N2:num`] LE_CASES) THENL [EXISTS_TAC `N2:num` THEN ASM_REWRITE_TAC[GE] THEN MATCH_MP_TAC SEQ_SUBLE THEN FIRST_ASSUM ACCEPT_TAC; EXISTS_TAC `N1:num` THEN REWRITE_TAC[GE; LE_REFL] THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SEQ_SUBLE THEN FIRST_ASSUM ACCEPT_TAC]);; (*----------------------------------------------------------------------------*) (* Now show that every Cauchy sequence converges *) (*----------------------------------------------------------------------------*) let SEQ_CAUCHY = prove( `!f. cauchy f <=> convergent f`, GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SEQ_CBOUNDED) THEN MP_TAC(SPEC `f:num->real` SEQ_MONOSUB) THEN DISCH_THEN(X_CHOOSE_THEN `g:num->num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `bounded(mr1, (>=) :num->num->bool)(\n. f(g(n):num))` ASSUME_TAC THENL [MATCH_MP_TAC SEQ_SBOUNDED THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `convergent (\n. f(g(n):num))` MP_TAC THENL [MATCH_MP_TAC SEQ_BCONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[convergent] THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN EXISTS_TAC `l:real` THEN REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `(\n. f(g(n):num)) --> l` THEN REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN UNDISCH_TAC `cauchy f` THEN REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP SEQ_DIRECT) THEN DISCH_THEN(MP_TAC o SPECL [`N1:num`; `N2:num`]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N2:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN UNDISCH_TAC `!n:num. n >= N1 ==> abs(f(g n:num) - l) < (e / &2)` THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPECL [`g(n:num):num`; `m:num`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN SUBGOAL_THEN `f(m:num) - l = (f(m) - f(g(n:num))) + (f(g n) - l)` SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_TRIANGLE]; ALL_TAC] THEN EXISTS_TAC `abs(f(m:num) - f(g(n:num))) + abs(f(g n) - l)` THEN REWRITE_TAC[ABS_TRIANGLE] THEN SUBST1_TAC(SYM(SPEC `e:real` REAL_HALF_DOUBLE)) THEN MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[convergent] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN REWRITE_TAC[SEQ; cauchy] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN (ANTE_RES_THEN ASSUME_TAC)) THEN MATCH_MP_TAC REAL_LET_TRANS THEN SUBGOAL_THEN `f(m:num) - f(n) = (f(m) - l) + (l - f(n))` SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_TRIANGLE]; ALL_TAC] THEN EXISTS_TAC `abs(f(m:num) - l) + abs(l - f(n))` THEN REWRITE_TAC[ABS_TRIANGLE] THEN SUBST1_TAC(SYM(SPEC `e:real` REAL_HALF_DOUBLE)) THEN MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[]]);; (*----------------------------------------------------------------------------*) (* The limit comparison property for sequences *) (*----------------------------------------------------------------------------*) let SEQ_LE = prove( `!f g l m. f --> l /\ g --> m /\ (?N. !n. n >= N ==> f(n) <= g(n)) ==> l <= m`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `(>=) :num->num->bool` NET_LE) THEN REWRITE_TAC[DORDER_NGE; tends_num_real; GE; LE_REFL] THEN DISCH_THEN MATCH_ACCEPT_TAC);; (* ------------------------------------------------------------------------- *) (* When a sequence tends to zero. *) (* ------------------------------------------------------------------------- *) let SEQ_LE_0 = prove (`!f g. f --> &0 /\ (?N. !n. n >= N ==> abs(g n) <= abs(f n)) ==> g --> &0`, REWRITE_TAC[SEQ; REAL_SUB_RZERO; GE] THEN MESON_TAC[LE_CASES; LE_TRANS; REAL_LET_TRANS]);; (*----------------------------------------------------------------------------*) (* We can displace a convergent series by 1 *) (*----------------------------------------------------------------------------*) let SEQ_SUC = prove( `!f l. f --> l <=> (\n. f(SUC n)) --> l`, REPEAT GEN_TAC THEN REWRITE_TAC[SEQ; GE] THEN EQ_TAC THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_THEN(MP_TAC o MATCH_MP th)) THEN BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL [EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC N` THEN ASM_REWRITE_TAC[LE_SUC; LESS_EQ_SUC_REFL]; EXISTS_TAC `SUC N` THEN X_GEN_TAC `n:num` THEN STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THENL [REWRITE_TAC[GSYM NOT_LT; LT_0]; REWRITE_TAC[LE_SUC] THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);; (*----------------------------------------------------------------------------*) (* Prove a sequence tends to zero iff its abs does *) (*----------------------------------------------------------------------------*) let SEQ_ABS = prove( `!f. (\n. abs(f n)) --> &0 <=> f --> &0`, GEN_TAC THEN REWRITE_TAC[SEQ] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO; ABS_ABS]);; (*----------------------------------------------------------------------------*) (* Half this is true for a general limit *) (*----------------------------------------------------------------------------*) let SEQ_ABS_IMP = prove( `!f l. f --> l ==> (\n. abs(f n)) --> abs(l)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN MATCH_ACCEPT_TAC NET_ABS);; (*----------------------------------------------------------------------------*) (* Prove that an unbounded sequence's inverse tends to 0 *) (*----------------------------------------------------------------------------*) let SEQ_INV0 = prove( `!f. (!y. ?N. !n. n >= N ==> f(n) > y) ==> (\n. inv(f n)) --> &0`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ; REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `N:num` o SPEC `inv e`) THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN ANTE_RES_THEN MP_TAC th) THEN REWRITE_TAC[real_gt] THEN BETA_TAC THEN IMP_RES_THEN ASSUME_TAC REAL_INV_POS THEN SUBGOAL_THEN `&0 < f(n:num)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM real_gt] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < inv(f(n:num))` ASSUME_TAC THENL [MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(f(n:num) = &0)` ASSUME_TAC THENL [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN SUBGOAL_THEN `e = inv(inv e)` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN ASM_REWRITE_TAC[ABS_LE]);; (*----------------------------------------------------------------------------*) (* Important limit of c^n for |c| < 1 *) (*----------------------------------------------------------------------------*) let SEQ_POWER_ABS = prove( `!c. abs(c) < &1 ==> (\n. abs(c) pow n) --> &0`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `c:real` ABS_POS) THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN DISJ_CASES_TAC THENL [SUBGOAL_THEN `!n. abs(c) pow n = inv(inv(abs(c) pow n))` (fun th -> ONCE_REWRITE_TAC[th]) THENL [GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC POW_NZ THEN ASM_REWRITE_TAC[ABS_NZ; ABS_ABS]; ALL_TAC] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `n:num` `inv(abs(c) pow n)`]) THEN MATCH_MP_TAC SEQ_INV0 THEN BETA_TAC THEN X_GEN_TAC `y:real` THEN SUBGOAL_THEN `~(abs(c) = &0)` (fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THENL [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[real_gt] THEN SUBGOAL_THEN `&0 < inv(abs c) - &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_LT_SUB_LADD] THEN REWRITE_TAC[REAL_ADD_LID] THEN ONCE_REWRITE_TAC[GSYM REAL_INV1] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `inv(abs c) - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N:num` o SPEC `y:real`) THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN SUBGOAL_THEN `y < (&n * (inv(abs c) - &1))` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N * (inv(abs c) - &1)` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_LE_RMUL_EQ th]) THEN ASM_REWRITE_TAC[REAL_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&n * (inv(abs c) - &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 + (&n * (inv(abs c) - &1))` THEN REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + (inv(abs c) - &1)) pow n` THEN CONJ_TAC THENL [MATCH_MP_TAC POW_PLUS1 THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN REWRITE_TAC[REAL_LE_REFL]]; FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SEQ] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN BETA_TAC THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THENL [REWRITE_TAC[GSYM NOT_LT; num_CONV `1`; LT_0]; REWRITE_TAC[POW_0; REAL_SUB_RZERO; ABS_0] THEN REWRITE_TAC[ASSUME `&0 < e`]]]);; (*----------------------------------------------------------------------------*) (* Similar version without the abs *) (*----------------------------------------------------------------------------*) let SEQ_POWER = prove( `!c. abs(c) < &1 ==> (\n. c pow n) --> &0`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SEQ_ABS] THEN BETA_TAC THEN REWRITE_TAC[GSYM POW_ABS] THEN POP_ASSUM(ACCEPT_TAC o MATCH_MP SEQ_POWER_ABS));; (* ------------------------------------------------------------------------- *) (* Convergence to 0 of harmonic sequence (not series of course). *) (* ------------------------------------------------------------------------- *) let SEQ_HARMONIC = prove (`!a. (\n. a / &n) --> &0`, GEN_TAC THEN REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `abs a` o MATCH_MP REAL_ARCH) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_NUM] THEN SUBGOAL_THEN `&0 < &n` (fun th -> SIMP_TAC[REAL_LT_LDIV_EQ; th]) THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `N + 1 <= n` THEN ARITH_TAC; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N * e`] THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_OF_NUM_LE] THEN UNDISCH_TAC `N + 1 <= n` THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Other basic lemmas about sequences. *) (* ------------------------------------------------------------------------- *) let SEQ_SUBSEQ = prove (`!f l. f --> l ==> !a b. ~(a = 0) ==> (\n. f(a * n + b)) --> l`, REWRITE_TAC[RIGHT_IMP_FORALL_THM; SEQ; GE] THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `!a b n. ~(a = 0) ==> n <= a * n + b` (fun th -> MESON_TAC[th; LE_TRANS]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE `1 * n <= a * n ==> n <= a * n + b`) THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let SEQ_POW = prove (`!f l. (f --> l) ==> !n. (\i. f(i) pow n) --> l pow n`, REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; SEQ_CONST] THEN MATCH_MP_TAC SEQ_MUL THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Useful lemmas about nested intervals and proof by bisection *) (*----------------------------------------------------------------------------*) let NEST_LEMMA = prove( `!f g. (!n. f(SUC n) >= f(n)) /\ (!n. g(SUC n) <= g(n)) /\ (!n. f(n) <= g(n)) ==> ?l m. l <= m /\ ((!n. f(n) <= l) /\ f --> l) /\ ((!n. m <= g(n)) /\ g --> m)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `f:num->real` MONO_SUC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(SPEC `g:num->real` MONO_SUC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `bounded((mr1), (>=) :num->num->bool) f` ASSUME_TAC THENL [MATCH_MP_TAC SEQ_BOUNDED_2 THEN MAP_EVERY EXISTS_TAC [`(f:num->real) 0`; `(g:num->real) 0`] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(SUC n):real` THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`SUC n`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(m:num):real` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `bounded((mr1), (>=) :num->num->bool) g` ASSUME_TAC THENL [MATCH_MP_TAC SEQ_BOUNDED_2 THEN MAP_EVERY EXISTS_TAC [`(f:num->real) 0`; `(g:num->real) 0`] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) (SUC n)` THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`SUC n`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) m` THEN RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(g:num->real) n` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN MP_TAC(SPEC `f:num->real` SEQ_BCONV) THEN ASM_REWRITE_TAC[SEQ_LIM] THEN DISCH_TAC THEN MP_TAC(SPEC `g:num->real` SEQ_BCONV) THEN ASM_REWRITE_TAC[SEQ_LIM] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`lim f`; `lim g`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC [`f:num->real`; `g:num->real`] THEN ASM_REWRITE_TAC[]; X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN UNDISCH_TAC `f --> lim f` THEN REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `f(m) - lim f`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `p + m:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN REWRITE_TAC[real_abs] THEN SUBGOAL_THEN `!p. lim f <= f(p + m:num)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(p + m:num):real` THEN RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]]; ASM_REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_NOT_LT; real_sub; REAL_LE_RADD] THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL; ADD_CLAUSES] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(p + m:num):real` THEN RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]]; X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN UNDISCH_TAC `g --> lim g` THEN REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `lim g - g(m)`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `p + m:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN REWRITE_TAC[real_abs] THEN SUBGOAL_THEN `!p. g(p + m:num) < lim g` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `g(p + m:num):real` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_SUB_LE] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[REAL_NOT_LT; REAL_NEG_SUB] THEN REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG] THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL; ADD_CLAUSES] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(p + m:num):real` THEN ASM_REWRITE_TAC[]]]);; let NEST_LEMMA_UNIQ = prove( `!f g. (!n. f(SUC n) >= f(n)) /\ (!n. g(SUC n) <= g(n)) /\ (!n. f(n) <= g(n)) /\ (\n. f(n) - g(n)) --> &0 ==> ?l. ((!n. f(n) <= l) /\ f --> l) /\ ((!n. l <= g(n)) /\ g --> l)`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP NEST_LEMMA) THEN DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `l:real` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `l:real = m` (fun th -> ASM_REWRITE_TAC[th]) THEN MP_TAC(SPECL [`f:num->real`; `l:real`; `g:num->real`; `m:real`] SEQ_SUB) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJ(ASSUME `(\n. f(n) - g(n)) --> &0`)) THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_UNIQ) THEN CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[REAL_SUB_0]);; let BOLZANO_LEMMA = prove( `!P. (!a b c. a <= b /\ b <= c /\ P(a,b) /\ P(b,c) ==> P(a,c)) /\ (!x. ?d. &0 < d /\ !a b. a <= x /\ x <= b /\ (b - a) < d ==> P(a,b)) ==> !a b. a <= b ==> P(a,b)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN DISCH_TAC THEN (X_CHOOSE_THEN `f:num->real#real` STRIP_ASSUME_TAC o EXISTENCE o BETA_RULE o C ISPECL num_Axiom) [`(a:real,(b:real))`; `\fn (n:num). if P(FST fn,(FST fn + SND fn)/ &2) then ((FST fn + SND fn)/ &2,SND fn) else (FST fn,(FST fn + SND fn)/ &2)`] THEN MP_TAC(SPECL [`\n:num. FST(f(n) :real#real)`; `\n:num. SND(f(n) :real#real)`] NEST_LEMMA_UNIQ) THEN BETA_TAC THEN SUBGOAL_THEN `!n:num. FST(f n) <= SND(f n)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THENL [MATCH_MP_TAC REAL_MIDDLE2; MATCH_MP_TAC REAL_MIDDLE1] THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN REWRITE_TAC[real_ge] THEN SUBGOAL_THEN `!n. FST(f n :real#real) <= FST(f(SUC n))` ASSUME_TAC THENL [REWRITE_TAC[real_ge] THEN INDUCT_TAC THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [th]) THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_MIDDLE1 THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. ~P(FST((f:num->real#real) n),SND(f n))` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `~P(FST((f:num->real#real) n),SND(f n))` THEN PURE_REWRITE_TAC[IMP_CLAUSES; NOT_CLAUSES] THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(FST(f(n:num)) + SND(f(n))) / &2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MIDDLE1; MATCH_MP_TAC REAL_MIDDLE2] THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. SND(f(SUC n) :real#real) <= SND(f n)` ASSUME_TAC THENL [BETA_TAC THEN INDUCT_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_MIDDLE2 THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. SND(f n) - FST(f n) = (b - a) / (&2 pow n)` ASSUME_TAC THENL [INDUCT_TAC THENL [ASM_REWRITE_TAC[pow; real_div; REAL_INV1; REAL_MUL_RID]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC `&2` THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN (SUBGOAL_THEN `~(&2 = &0)` (fun th -> REWRITE_TAC[th] THEN REWRITE_TAC[MATCH_MP REAL_DIV_LMUL th]) THENL [REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]; ALL_TAC]) THEN REWRITE_TAC[GSYM REAL_DOUBLE] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_ADD_SYM] THEN (SUBGOAL_THEN `!x y z. (x + y) - (x + z) = y - z` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_RID] THEN SUBST1_TAC(SYM(SPEC `x:real` REAL_ADD_LINV)) THEN REWRITE_TAC[REAL_ADD_AC]; ALL_TAC]) THEN ASM_REWRITE_TAC[REAL_DOUBLE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[pow] THEN (SUBGOAL_THEN `~(&2 = &0) /\ ~(&2 pow n = &0)` (fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THENL [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC POW_NZ] THEN REWRITE_TAC[REAL_INJ] THEN REWRITE_TAC[num_CONV `2`; NOT_SUC]; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[REAL_INJ] THEN REWRITE_TAC[num_CONV `2`; NOT_SUC]]); ALL_TAC] THEN FIRST_ASSUM(UNDISCH_TAC o check (can (find_term is_cond)) o concl) THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o fst o dest_imp o rand o snd) THENL [ONCE_REWRITE_TAC[SEQ_NEG] THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_NEG_0] THEN REWRITE_TAC[real_div] THEN SUBGOAL_THEN `~(&2 = &0)` ASSUME_TAC THENL [REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]; ALL_TAC] THEN (MP_TAC o C SPECL SEQ_MUL) [`\n:num. b - a`; `b - a`; `\n. (inv (&2 pow n))`; `&0`] THEN REWRITE_TAC[SEQ_CONST; REAL_MUL_RZERO] THEN BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THEN ONCE_REWRITE_TAC[GSYM SEQ_ABS] THEN BETA_TAC THEN REWRITE_TAC[GSYM POW_ABS] THEN MATCH_MP_TAC SEQ_POWER_ABS THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN REWRITE_TAC[ABS_N] THEN SUBGOAL_THEN `&0 < &2` (fun th -> ONCE_REWRITE_TAC [GSYM (MATCH_MP REAL_LT_RMUL_EQ th)]) THENL [REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]; ALL_TAC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[REAL_LT] THEN REWRITE_TAC[num_CONV `2`; LESS_SUC_REFL]; DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o SPEC `l:real`) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN UNDISCH_TAC `(\n:num. SND(f n :real#real)) --> l` THEN UNDISCH_TAC `(\n:num. FST(f n :real#real)) --> l` THEN REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (ASSUME_TAC o BETA_RULE)) THEN DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (ASSUME_TAC o BETA_RULE)) THEN DISCH_THEN(MP_TAC o SPECL [`FST((f:num->real#real) (N1 + N2))`; `SND((f:num->real#real) (N1 + N2))`]) THEN UNDISCH_TAC `!n. (SND(f n)) - (FST(f n)) = (b - a) / ((& 2) pow n)` THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(FST(f(N1 + N2:num)) - l) + abs(SND(f(N1 + N2:num)) - l)` THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [ABS_SUB] THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN REWRITE_TAC[AC REAL_ADD_AC `a + b + c + d = (d + a) + (c + b)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID; REAL_LE_REFL]; MATCH_MP_TAC REAL_LT_ADD2 THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]]]);; (* ------------------------------------------------------------------------- *) (* This one is better for higher-order matching. *) (* ------------------------------------------------------------------------- *) let BOLZANO_LEMMA_ALT = prove (`!P. (!a b c. a <= b /\ b <= c /\ P a b /\ P b c ==> P a c) /\ (!x. ?d. &0 < d /\ (!a b. a <= x /\ x <= b /\ b - a < d ==> P a b)) ==> !a b. a <= b ==> P a b`, GEN_TAC THEN MP_TAC(SPEC `\(x:real,y:real). P x y :bool` BOLZANO_LEMMA) THEN REWRITE_TAC[] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Define infinite sums *) (*----------------------------------------------------------------------------*) let sums = new_definition `f sums s <=> (\n. sum(0,n) f) --> s`;; let summable = new_definition( `summable f <=> ?s. f sums s`);; let suminf = new_definition( `suminf f = @s. f sums s`);; (*----------------------------------------------------------------------------*) (* If summable then it sums to the sum (!) *) (*----------------------------------------------------------------------------*) let SUM_SUMMABLE = prove( `!f l. f sums l ==> summable f`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `l:real` THEN POP_ASSUM ACCEPT_TAC);; let SUMMABLE_SUM = prove( `!f. summable f ==> f sums (suminf f)`, GEN_TAC THEN REWRITE_TAC[summable; suminf] THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MATCH_ACCEPT_TAC SELECT_AX);; (*----------------------------------------------------------------------------*) (* And the sum is unique *) (*----------------------------------------------------------------------------*) let SUM_UNIQ = prove( `!f x. f sums x ==> (x = suminf f)`, REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `summable f` MP_TAC THENL [REWRITE_TAC[summable] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; DISCH_THEN(ASSUME_TAC o MATCH_MP SUMMABLE_SUM) THEN MATCH_MP_TAC SEQ_UNIQ THEN EXISTS_TAC `\n. sum(0,n) f` THEN ASM_REWRITE_TAC[GSYM sums]]);; let SER_UNIQ = prove (`!f x y. f sums x /\ f sums y ==> (x = y)`, MESON_TAC[SUM_UNIQ]);; (*----------------------------------------------------------------------------*) (* Series which is zero beyond a certain point *) (*----------------------------------------------------------------------------*) let SER_0 = prove( `!f n. (!m. n <= m ==> (f(m) = &0)) ==> f sums (sum(0,n) f)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[sums; SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN W(C SUBGOAL_THEN SUBST1_TAC o C (curry mk_eq) `&0` o rand o rator o snd) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN BETA_TAC THEN REWRITE_TAC[GSYM SUM_TWO; REAL_ADD_RID_UNIQ] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[GE] SUM_ZERO)) THEN MATCH_ACCEPT_TAC LE_REFL);; (*----------------------------------------------------------------------------*) (* summable series of positive terms has limit >(=) any partial sum *) (*----------------------------------------------------------------------------*) let SER_POS_LE = prove( `!f n. summable f /\ (!m. n <= m ==> &0 <= f(m)) ==> sum(0,n) f <= suminf f`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums] THEN MP_TAC(SPEC `sum(0,n) f` SEQ_CONST) THEN GEN_REWRITE_TAC I [IMP_IMP] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] SEQ_LE) THEN BETA_TAC THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN REWRITE_TAC[GSYM SUM_TWO; REAL_LE_ADDR] THEN MATCH_MP_TAC SUM_POS_GEN THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let SER_POS_LT = prove( `!f n. summable f /\ (!m. n <= m ==> &0 < f(m)) ==> sum(0,n) f < suminf f`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `sum(0,n + 1) f` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_TWO; REAL_LT_ADDR] THEN REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES] THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_ACCEPT_TAC LE_REFL; MATCH_MP_TAC SER_POS_LE THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC n` THEN REWRITE_TAC[LESS_EQ_SUC_REFL] THEN ASM_REWRITE_TAC[ADD1]]);; (*----------------------------------------------------------------------------*) (* Theorems about grouping and offsetting, *not* permuting, terms *) (*----------------------------------------------------------------------------*) let SER_GROUP = prove( `!f k. summable f /\ 0 < k ==> (\n. sum(n * k,k) f) sums (suminf f)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums; SEQ] THEN BETA_TAC THEN DISCH_THEN(fun t -> X_GEN_TAC `e:real` THEN DISCH_THEN(MP_TAC o MATCH_MP t)) THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN REWRITE_TAC[SUM_GROUP] THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `0 < k` THEN STRUCT_CASES_TAC(SPEC `k:num` num_CASES) THEN REWRITE_TAC[MULT_CLAUSES; LE_ADD; CONJUNCT1 LE] THEN REWRITE_TAC[LT_REFL]);; let SER_PAIR = prove( `!f. summable f ==> (\n. sum(2 * n,2) f) sums (suminf f)`, GEN_TAC THEN DISCH_THEN(MP_TAC o C CONJ (SPEC `1:num` LT_0)) THEN REWRITE_TAC[SYM(num_CONV `2`)] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN MATCH_ACCEPT_TAC SER_GROUP);; let SER_OFFSET = prove( `!f. summable f ==> !k. (\n. f(n + k)) sums (suminf f - sum(0,k) f)`, GEN_TAC THEN DISCH_THEN((then_) GEN_TAC o MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums; SEQ] THEN DISCH_THEN(fun th -> GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP th)) THEN BETA_TAC THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[SUM_OFFSET] THEN REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (b + d) + (a + c)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID] THEN REWRITE_TAC[GSYM real_sub] THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[LE_ADD]);; let SER_OFFSET_REV = prove (`!f k. summable(\n. f(n + k)) ==> f sums (sum(0,k) f) + suminf (\n. f(n + k))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums; SEQ] THEN REWRITE_TAC[SUM_OFFSET] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN DISCH_TAC THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[ADD_SYM] SUM_DIFF)] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N + k:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN ONCE_REWRITE_TAC[ARITH_RULE `(N + k) + d = k + N + d:num`] THEN REWRITE_TAC[REAL_ARITH `a - (b + c) = a - b - c`] THEN REWRITE_TAC[GSYM SUM_DIFF] THEN FIRST_ASSUM MATCH_MP_TAC THEN ARITH_TAC);; (*----------------------------------------------------------------------------*) (* Similar version for pairing up terms *) (*----------------------------------------------------------------------------*) let SER_POS_LT_PAIR = prove( `!f n. summable f /\ (!d. &0 < (f(n + (2 * d))) + f(n + ((2 * d) + 1))) ==> sum(0,n) f < suminf f`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums; SEQ] THEN BETA_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `f(n) + f(n + 1)`) THEN FIRST_ASSUM(MP_TAC o SPEC `0`) THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN SUBGOAL_THEN `sum(0,n + 2) f <= sum(0,(2 * (SUC N)) + n) f` ASSUME_TAC THENL [SPEC_TAC(`N:num`,`N:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN MATCH_ACCEPT_TAC REAL_LE_REFL; ABBREV_TAC `M = SUC N` THEN REWRITE_TAC[MULT_CLAUSES] THEN REWRITE_TAC[num_CONV `2`; ADD_CLAUSES] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[ADD_SYM] ADD1)] THEN REWRITE_TAC[SYM(num_CONV `2`)] THEN REWRITE_TAC[ADD_CLAUSES] THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ADD1] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[GSYM ADD1; SYM(num_CONV `2`)] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,(2 * M) + n) f` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[sum] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_LE_ADDR] THEN REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[ADD1] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[SPEC `1` ADD_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; DISCH_THEN(MP_TAC o SPEC `(2 * (SUC N)) + n`) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2(fst o dest_imp) o snd) THENL [REWRITE_TAC[num_CONV `2`; MULT_CLAUSES] THEN ONCE_REWRITE_TAC[AC ADD_AC `(a + (b + c)) + d:num = b + (a + (c + d))`] THEN REWRITE_TAC[GE; LE_ADD]; ALL_TAC] THEN SUBGOAL_THEN `(suminf f + (f(n) + f(n + 1))) <= sum(0,(2 * (SUC N)) + n) f` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,n + 2) f` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,n) f + (f(n) + f(n + 1))` THEN ASM_REWRITE_TAC[REAL_LE_RADD] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN REWRITE_TAC[ADD_CLAUSES; sum; REAL_ADD_ASSOC]; ALL_TAC] THEN SUBGOAL_THEN `suminf f <= sum(0,(2 * (SUC N)) + n) f` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `suminf f + (f(n) + f(n + 1))` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [REAL_ADD_SYM] THEN ASM_REWRITE_TAC[REAL_NOT_LT]]);; (*----------------------------------------------------------------------------*) (* Prove a few composition formulas for series *) (*----------------------------------------------------------------------------*) let SER_ADD = prove( `!x x0 y y0. x sums x0 /\ y sums y0 ==> (\n. x(n) + y(n)) sums (x0 + y0)`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; SUM_ADD] THEN CONV_TAC((RAND_CONV o EXACT_CONV)[X_BETA_CONV `n:num` `sum(0,n) x`]) THEN CONV_TAC((RAND_CONV o EXACT_CONV)[X_BETA_CONV `n:num` `sum(0,n) y`]) THEN MATCH_ACCEPT_TAC SEQ_ADD);; let SER_CMUL = prove( `!x x0 c. x sums x0 ==> (\n. c * x(n)) sums (c * x0)`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; SUM_CMUL] THEN DISCH_TAC THEN SUBGOAL_THEN `(\n. (\n. c) n * (\n. sum(0,n) x) n) --> c * x0` MP_TAC THENL [MATCH_MP_TAC SEQ_MUL THEN ASM_REWRITE_TAC[SEQ_CONST]; REWRITE_TAC[BETA_THM]]);; let SER_NEG = prove( `!x x0. x sums x0 ==> (\n. --(x n)) sums --x0`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN MATCH_ACCEPT_TAC SER_CMUL);; let SER_SUB = prove( `!x x0 y y0. x sums x0 /\ y sums y0 ==> (\n. x(n) - y(n)) sums (x0 - y0)`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC (MATCH_MP SER_ADD (CONJ (CONJUNCT1 th) (MATCH_MP SER_NEG (CONJUNCT2 th))))) THEN BETA_TAC THEN REWRITE_TAC[real_sub]);; let SER_CDIV = prove( `!x x0 c. x sums x0 ==> (\n. x(n) / c) sums (x0 / c)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC SER_CMUL);; (*----------------------------------------------------------------------------*) (* Prove Cauchy-type criterion for convergence of series *) (*----------------------------------------------------------------------------*) let SER_CAUCHY = prove( `!f. summable f <=> !e. &0 < e ==> ?N. !m n. m >= N ==> abs(sum(m,n) f) < e`, GEN_TAC THEN REWRITE_TAC[summable; sums] THEN REWRITE_TAC[GSYM convergent] THEN REWRITE_TAC[GSYM SEQ_CAUCHY] THEN REWRITE_TAC[cauchy] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[GE] THEN BETA_TAC THEN REWRITE_TAC[TAUT `((a ==> b) <=> (a ==> c)) <=> a ==> (b <=> c)`] THEN DISCH_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN DISCH_TAC THENL [ONCE_REWRITE_TAC[SUM_DIFF] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[LE_ADD]; DISJ_CASES_THEN MP_TAC (SPECL [`m:num`; `n:num`] LE_CASES) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THENL [ONCE_REWRITE_TAC[ABS_SUB]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_DIFF] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; (*----------------------------------------------------------------------------*) (* Show that if a series converges, the terms tend to 0 *) (*----------------------------------------------------------------------------*) let SER_ZERO = prove( `!f. summable f ==> f --> &0`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `summable f` THEN REWRITE_TAC[SER_CAUCHY] THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN DISCH_THEN((then_) (EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC) o MP_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `SUC 0`]) THEN ASM_REWRITE_TAC[sum; REAL_SUB_RZERO; REAL_ADD_LID; ADD_CLAUSES]);; (*----------------------------------------------------------------------------*) (* Now prove the comparison test *) (*----------------------------------------------------------------------------*) let SER_COMPAR = prove( `!f g. (?N. !n. n >= N ==> abs(f(n)) <= g(n)) /\ summable g ==> summable f`, REPEAT GEN_TAC THEN REWRITE_TAC[SER_CAUCHY; GE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `N1:num`) MP_TAC) THEN REWRITE_TAC[SER_CAUCHY; GE] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(m,n)(\k. abs(f k))` THEN REWRITE_TAC[ABS_SUM] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(m,n) g` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN BETA_TAC THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2:num` THEN ASM_REWRITE_TAC[LE_ADD]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(sum(m,n) g)` THEN REWRITE_TAC[ABS_LE] THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2:num` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]);; (*----------------------------------------------------------------------------*) (* And a similar version for absolute convergence *) (*----------------------------------------------------------------------------*) let SER_COMPARA = prove( `!f g. (?N. !n. n >= N ==> abs(f(n)) <= g(n)) /\ summable g ==> summable (\k. abs(f k))`, REPEAT GEN_TAC THEN SUBGOAL_THEN `!n. abs(f(n)) = abs((\k:num. abs(f k)) n)` (fun th -> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [th]) THENL [GEN_TAC THEN BETA_TAC THEN REWRITE_TAC[ABS_ABS]; MATCH_ACCEPT_TAC SER_COMPAR]);; (*----------------------------------------------------------------------------*) (* Limit comparison property for series *) (*----------------------------------------------------------------------------*) let SER_LE = prove( `!f g. (!n. f(n) <= g(n)) /\ summable f /\ summable g ==> suminf f <= suminf g`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN (fun th -> ASSUME_TAC th THEN ASSUME_TAC (REWRITE_RULE[sums] (MATCH_MP SUMMABLE_SUM th)))) THEN MATCH_MP_TAC SEQ_LE THEN REWRITE_TAC[CONJ_ASSOC] THEN MAP_EVERY EXISTS_TAC [`\n. sum(0,n) f`; `\n. sum(0,n) g`] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM sums] THEN CONJ_TAC THEN MATCH_MP_TAC SUMMABLE_SUM THEN FIRST_ASSUM ACCEPT_TAC; EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0] THEN GEN_TAC THEN BETA_TAC THEN MATCH_MP_TAC SUM_LE THEN GEN_TAC THEN ASM_REWRITE_TAC[LE_0]]);; let SER_LE2 = prove( `!f g. (!n. abs(f n) <= g(n)) /\ summable g ==> summable f /\ suminf f <= suminf g`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `summable f` ASSUME_TAC THENL [MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `g:num->real` THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(n:num))` THEN ASM_REWRITE_TAC[ABS_LE]);; (*----------------------------------------------------------------------------*) (* Show that absolute convergence implies normal convergence *) (*----------------------------------------------------------------------------*) let SER_ACONV = prove( `!f. summable (\n. abs(f n)) ==> summable f`, GEN_TAC THEN REWRITE_TAC[SER_CAUCHY] THEN REWRITE_TAC[SUM_ABS] THEN DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN DISCH_THEN(IMP_RES_THEN (X_CHOOSE_TAC `N:num`)) THEN EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(m,n)(\m. abs(f m))` THEN ASM_REWRITE_TAC[ABS_SUM]);; (*----------------------------------------------------------------------------*) (* Absolute value of series *) (*----------------------------------------------------------------------------*) let SER_ABS = prove( `!f. summable(\n. abs(f n)) ==> abs(suminf f) <= suminf(\n. abs(f n))`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM o MATCH_MP SER_ACONV) THEN POP_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums] THEN DISCH_TAC THEN DISCH_THEN(ASSUME_TAC o BETA_RULE o MATCH_MP SEQ_ABS_IMP) THEN MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC [`\n. abs(sum(0,n)f)`; `\n. sum(0,n)(\n. abs(f n))`] THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN MATCH_ACCEPT_TAC SUM_ABS_LE);; (*----------------------------------------------------------------------------*) (* Prove sum of geometric progression (useful for comparison) *) (*----------------------------------------------------------------------------*) let GP_FINITE = prove( `!x. ~(x = &1) ==> !n. (sum(0,n) (\n. x pow n) = ((x pow n) - &1) / (x - &1))`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[sum; pow; REAL_SUB_REFL; REAL_DIV_LZERO]; REWRITE_TAC[sum; pow] THEN BETA_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN SUBGOAL_THEN `~(x - &1 = &0)` ASSUME_TAC THEN ASM_REWRITE_TAC[REAL_SUB_0] THEN MP_TAC(GENL [`p:real`; `q:real`] (SPECL [`p:real`; `q:real`; `x - &1`] REAL_EQ_RMUL)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[REAL_RDISTRIB] THEN SUBGOAL_THEN `!p. (p / (x - &1)) * (x - &1) = p` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (c + b) + (d + a)`] THEN REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LINV; REAL_ADD_RID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);; let GP = prove( `!x. abs(x) < &1 ==> (\n. x pow n) sums inv(&1 - x)`, GEN_TAC THEN ASM_CASES_TAC `x = &1` THEN ASM_REWRITE_TAC[ABS_1; REAL_LT_REFL] THEN DISCH_TAC THEN REWRITE_TAC[sums] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP GP_FINITE th]) THEN REWRITE_TAC[REAL_INV_1OVER] THEN REWRITE_TAC[real_div] THEN GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_NEG_MUL2] THEN SUBGOAL_THEN `~(x - &1 = &0)` (fun t -> REWRITE_TAC[MATCH_MP REAL_NEG_INV t]) THENL [ASM_REWRITE_TAC[REAL_SUB_0]; ALL_TAC] THEN REWRITE_TAC[REAL_NEG_SUB; GSYM real_div] THEN SUBGOAL_THEN `(\n. (\n. &1 - x pow n) n / (\n. &1 - x) n) --> &1 / (&1 - x)` MP_TAC THENL [ALL_TAC; REWRITE_TAC[BETA_THM]] THEN MATCH_MP_TAC SEQ_DIV THEN BETA_TAC THEN REWRITE_TAC[SEQ_CONST] THEN REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN SUBGOAL_THEN `(\n. (\n. &1) n - (\n. x pow n) n) --> &1 - &0` MP_TAC THENL [ALL_TAC; REWRITE_TAC[BETA_THM]] THEN MATCH_MP_TAC SEQ_SUB THEN BETA_TAC THEN REWRITE_TAC[SEQ_CONST] THEN MATCH_MP_TAC SEQ_POWER THEN FIRST_ASSUM ACCEPT_TAC);; (*----------------------------------------------------------------------------*) (* Now prove the ratio test *) (*----------------------------------------------------------------------------*) let ABS_NEG_LEMMA = prove( `!c x y. c <= &0 ==> abs(x) <= c * abs(y) ==> (x = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_GE0] THEN DISCH_TAC THEN MP_TAC(SPECL [`--c`; `abs(y)`] REAL_LE_MUL) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_POS; GSYM REAL_NEG_LMUL; REAL_NEG_GE0] THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C CONJ th)) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[ABS_NZ; REAL_NOT_LE]);; let SER_RATIO = prove( `!f c N. c < &1 /\ (!n. n >= N ==> abs(f(SUC n)) <= c * abs(f(n))) ==> summable f`, REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN DISJ_CASES_TAC (SPECL [`c:real`; `&0`] REAL_LET_TOTAL) THENL [REWRITE_TAC[SER_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `!n. n >= N ==> (f(SUC n) = &0)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC ABS_NEG_LEMMA THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n. n >= (SUC N) ==> (f(n) = &0)` ASSUME_TAC THENL [GEN_TAC THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THENL [REWRITE_TAC[GE] THEN DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN REWRITE_TAC[NOT_LESS_0]; REWRITE_TAC[GE; LE_SUC] THEN ASM_REWRITE_TAC[GSYM GE]]; ALL_TAC] THEN EXISTS_TAC `SUC N` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUM_ZERO) THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN (fun th -> REWRITE_TAC[th])) THEN ASM_REWRITE_TAC[ABS_0]; MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. (abs(f N) / c pow N) * (c pow n)` THEN CONJ_TAC THENL [EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN BETA_TAC THEN REWRITE_TAC[POW_ADD] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (a * d) * (b * c)`] THEN SUBGOAL_THEN `~(c pow N = &0)` (fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th; REAL_MUL_RID]) THENL [MATCH_MP_TAC POW_NZ THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[pow; ADD_CLAUSES; REAL_MUL_RID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * abs(f(N + d:num))` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; LE_ADD]; ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * (b * c) = b * (a * c)`] THEN FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th])]; REWRITE_TAC[summable] THEN EXISTS_TAC `(abs(f(N:num)) / (c pow N)) * inv(&1 - c)` THEN MATCH_MP_TAC SER_CMUL THEN MATCH_MP_TAC GP THEN ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`)) THEN ASM_REWRITE_TAC[real_abs]]]);; (* ------------------------------------------------------------------------- *) (* The error in truncating a convergent series is bounded by partial sums. *) (* ------------------------------------------------------------------------- *) let SEQ_TRUNCATION = prove (`!f l n b. f sums l /\ (!m. abs(sum(n,m) f) <= b) ==> abs(l - sum(0,n) f) <= b`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP SER_OFFSET) THEN REWRITE_TAC[sums] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP SEQ_ABS_IMP) THEN MATCH_MP_TAC SEQ_LE THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN FIRST_ASSUM(fun th -> EXISTS_TAC (lhand(concl th)) THEN CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN EXISTS_TAC `\r:num. b:real` THEN REWRITE_TAC[SEQ_CONST] THEN ASM_REWRITE_TAC[GSYM SUM_REINDEX; ADD_CLAUSES]);; (*============================================================================*) (* Theory of limits, continuity and differentiation of real->real functions *) (*============================================================================*) parse_as_infix ("tends_real_real",(12,"right"));; parse_as_infix ("diffl",(12,"right"));; parse_as_infix ("contl",(12,"right"));; parse_as_infix ("differentiable",(12,"right"));; (*----------------------------------------------------------------------------*) (* Specialize nets theorems to the pointwise limit of real->real functions *) (*----------------------------------------------------------------------------*) let tends_real_real = new_definition `(f tends_real_real l)(x0) <=> (f tends l)(mtop(mr1),tendsto(mr1,x0))`;; override_interface ("-->",`(tends_real_real)`);; let LIM = prove( `!f y0 x0. (f --> y0)(x0) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < abs(x - x0) /\ abs(x - x0) < d ==> abs(f(x) - y0) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real; MATCH_MP LIM_TENDS2 (SPEC `x0:real` MR1_LIMPT)] THEN REWRITE_TAC[MR1_DEF] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN REFL_TAC);; let LIM_CONST = prove( `!k x. ((\x. k) --> k)(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real; MTOP_TENDS] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[METRIC_SAME] THEN REWRITE_TAC[tendsto; REAL_LE_REFL] THEN MP_TAC(REWRITE_RULE[MTOP_LIMPT] (SPEC `x:real` MR1_LIMPT)) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` (ASSUME_TAC o CONJUNCT1)) THEN EXISTS_TAC `z:real` THEN REWRITE_TAC[MR1_DEF; GSYM ABS_NZ] THEN REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[]);; let LIM_ADD = prove( `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==> ((\x. f(x) + g(x)) --> (l + m))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC NET_ADD THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; let LIM_MUL = prove( `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==> ((\x. f(x) * g(x)) --> (l * m))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC NET_MUL THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; let LIM_NEG = prove( `!f l. (f --> l)(x) <=> ((\x. --(f(x))) --> --l)(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC NET_NEG THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; let LIM_INV = prove( `!f l. (f --> l)(x) /\ ~(l = &0) ==> ((\x. inv(f(x))) --> inv l)(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC NET_INV THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; let LIM_SUB = prove( `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==> ((\x. f(x) - g(x)) --> (l - m))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC NET_SUB THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; let LIM_DIV = prove( `!f g l m. (f --> l)(x) /\ (g --> m)(x) /\ ~(m = &0) ==> ((\x. f(x) / g(x)) --> (l / m))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC NET_DIV THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; let LIM_NULL = prove( `!f l x. (f --> l)(x) <=> ((\x. f(x) - l) --> &0)(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_ACCEPT_TAC NET_NULL);; let LIM_SUM = prove (`!f l m n x. (!r. m <= r /\ r < m + n ==> (f r --> l r)(x)) ==> ((\x. sum(m,n) (\r. f r x)) --> sum(m,n) l)(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] NET_SUM) THEN REWRITE_TAC[LIM_CONST; DORDER_TENDSTO; GSYM tends_real_real]);; (*----------------------------------------------------------------------------*) (* One extra theorem is handy *) (*----------------------------------------------------------------------------*) let LIM_X = prove( `!x0. ((\x. x) --> x0)(x0)`, GEN_TAC THEN REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Uniqueness of limit *) (*----------------------------------------------------------------------------*) let LIM_UNIQ = prove( `!f l m x. (f --> l)(x) /\ (f --> m)(x) ==> (l = m)`, REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN MATCH_MP_TAC MTOP_TENDS_UNIQ THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; (*----------------------------------------------------------------------------*) (* Show that limits are equal when functions are equal except at limit point *) (*----------------------------------------------------------------------------*) let LIM_EQUAL = prove( `!f g l x0. (!x. ~(x = x0) ==> (f x = g x)) ==> ((f --> l)(x0) <=> (g --> l)(x0))`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN DISCH_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ONCE_REWRITE_TAC[TAUT `(a ==> b <=> a ==> c) <=> a ==> (b <=> c)`] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN ASM_REWRITE_TAC[ABS_NZ]);; (*----------------------------------------------------------------------------*) (* A more general theorem about rearranging the body of a limit *) (*----------------------------------------------------------------------------*) let LIM_TRANSFORM = prove( `!f g x0 l. ((\x. f(x) - g(x)) --> &0)(x0) /\ (g --> l)(x0) ==> (f --> l)(x0)`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`c:real`; `d:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN DISCH_THEN STRIP_ASSUME_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(e / &2) + (e / &2)` THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_HALF_DOUBLE] THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(f(x:real) - g(x)) + abs(g(x) - l)` THEN SUBST1_TAC(SYM(SPECL [`(f:real->real) x`; `(g:real->real) x`; `l:real`] REAL_SUB_TRIANGLE)) THEN REWRITE_TAC[ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Define differentiation and continuity *) (*----------------------------------------------------------------------------*) let diffl = new_definition `(f diffl l)(x) <=> ((\h. (f(x+h) - f(x)) / h) --> l)(&0)`;; let contl = new_definition `f contl x <=> ((\h. f(x + h)) --> f(x))(&0)`;; let differentiable = new_definition `f differentiable x <=> ?l. (f diffl l)(x)`;; (*----------------------------------------------------------------------------*) (* Derivative is unique *) (*----------------------------------------------------------------------------*) let DIFF_UNIQ = prove( `!f l m x. (f diffl l)(x) /\ (f diffl m)(x) ==> (l = m)`, REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN MATCH_ACCEPT_TAC LIM_UNIQ);; (*----------------------------------------------------------------------------*) (* Differentiability implies continuity *) (*----------------------------------------------------------------------------*) let DIFF_CONT = prove( `!f l x. (f diffl l)(x) ==> f contl x`, REPEAT GEN_TAC THEN REWRITE_TAC[diffl; contl] THEN DISCH_TAC THEN REWRITE_TAC[tends_real_real] THEN ONCE_REWRITE_TAC[NET_NULL] THEN REWRITE_TAC[GSYM tends_real_real] THEN BETA_TAC THEN SUBGOAL_THEN `((\h. f(x + h) - f(x)) --> &0)(&0) <=> ((\h. ((f(x + h) - f(x)) / h) * h) --> &0)(&0)` SUBST1_TAC THENL [MATCH_MP_TAC LIM_EQUAL THEN X_GEN_TAC `z:real` THEN BETA_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_RMUL th]); ALL_TAC] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV o RAND_CONV) [SYM(BETA_CONV `(\h:real. h) h`)] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(f(x + h) - f(x)) / h`]) THEN SUBST1_TAC(SYM(SPEC `l:real` REAL_MUL_RZERO)) THEN MATCH_MP_TAC LIM_MUL THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_RZERO] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Alternative definition of continuity *) (*----------------------------------------------------------------------------*) let CONTL_LIM = prove( `!f x. f contl x <=> (f --> f(x))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[contl; LIM] THEN AP_TERM_TAC THEN ABS_TAC THEN ONCE_REWRITE_TAC[TAUT `(a ==> b <=> a ==> c) <=> a ==> (b <=> c)`] THEN DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:real` THENL [DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[REAL_SUB_ADD2]; DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_ADD_SUB]]);; (*----------------------------------------------------------------------------*) (* Simple combining theorems for continuity *) (*----------------------------------------------------------------------------*) let CONT_X = prove (`!x. (\x. x) contl x`, REWRITE_TAC[CONTL_LIM; LIM_X]);; let CONT_CONST = prove( `!x. (\x. k) contl x`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN MATCH_ACCEPT_TAC LIM_CONST);; let CONT_ADD = prove( `!x. f contl x /\ g contl x ==> (\x. f(x) + g(x)) contl x`, GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN MATCH_ACCEPT_TAC LIM_ADD);; let CONT_MUL = prove( `!x. f contl x /\ g contl x ==> (\x. f(x) * g(x)) contl x`, GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN MATCH_ACCEPT_TAC LIM_MUL);; let CONT_NEG = prove( `!x. f contl x ==> (\x. --(f(x))) contl x`, GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN REWRITE_TAC[GSYM LIM_NEG]);; let CONT_INV = prove( `!x. f contl x /\ ~(f x = &0) ==> (\x. inv(f(x))) contl x`, GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN MATCH_ACCEPT_TAC LIM_INV);; let CONT_SUB = prove( `!x. f contl x /\ g contl x ==> (\x. f(x) - g(x)) contl x`, GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN MATCH_ACCEPT_TAC LIM_SUB);; let CONT_DIV = prove( `!x. f contl x /\ g contl x /\ ~(g x = &0) ==> (\x. f(x) / g(x)) contl x`, GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN MATCH_ACCEPT_TAC LIM_DIV);; let CONT_ABS = prove (`!f x. f contl x ==> (\x. abs(f x)) contl x`, REWRITE_TAC[CONTL_LIM; LIM] THEN MESON_TAC[REAL_ARITH `abs(a - b) < e ==> abs(abs a - abs b) < e`]);; (* ------------------------------------------------------------------------- *) (* Composition of continuous functions is continuous. *) (* ------------------------------------------------------------------------- *) let CONT_COMPOSE = prove( `!f g x. f contl x /\ g contl (f x) ==> (\x. g(f x)) contl x`, REPEAT GEN_TAC THEN REWRITE_TAC[contl; LIM; REAL_SUB_RZERO] THEN BETA_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_CASES_TAC `&0 < abs(f(x + h) - f(x))` THENL [UNDISCH_TAC `&0 < abs(f(x + h) - f(x))` THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o CONJ th)) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[REAL_SUB_ADD2]; UNDISCH_TAC `~(&0 < abs(f(x + h) - f(x)))` THEN REWRITE_TAC[GSYM ABS_NZ; REAL_SUB_0] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]]);; (*----------------------------------------------------------------------------*) (* Intermediate Value Theorem (we prove contrapositive by bisection) *) (*----------------------------------------------------------------------------*) let IVT = prove( `!f a b y. a <= b /\ (f(a) <= y /\ y <= f(b)) /\ (!x. a <= x /\ x <= b ==> f contl x) ==> (?x. a <= x /\ x <= b /\ (f(x) = y))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(ASSUME_TAC o CONV_RULE NOT_EXISTS_CONV) THEN (MP_TAC o C SPEC BOLZANO_LEMMA) `\(u,v). a <= u /\ u <= v /\ v <= b ==> ~(f(u) <= y /\ y <= f(v))` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN ASM_REWRITE_TAC[REAL_LE_REFL]] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM; NOT_IMP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY ASM_CASES_TAC [`u <= v`; `v <= w`] THEN ASM_REWRITE_TAC[] THEN DISJ_CASES_TAC(SPECL [`y:real`; `(f:real->real) v`] REAL_LE_TOTAL) THEN ASM_REWRITE_TAC[] THENL [DISJ1_TAC; DISJ2_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `w:real`; EXISTS_TAC `u:real`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL [ALL_TAC; EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a <= x /\ x <= b)` THEN REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN ASM_REWRITE_TAC[]] THEN UNDISCH_TAC `!x. ~(a <= x /\ x <= b /\ (f(x) = (y:real)))` THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN REWRITE_TAC[contl; LIM] THEN DISCH_THEN(MP_TAC o SPEC `abs(y - f(x:real))`) THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM ABS_NZ] THEN REWRITE_TAC[REAL_SUB_0; REAL_SUB_RZERO] THEN BETA_TAC THEN ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(f:real->real) x`; `y:real`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THENL [DISCH_THEN(MP_TAC o SPEC `v - x`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_SUB_LT] THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `f(v:real) < y` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE]; ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN ASM_REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG; REAL_LE_RADD]; ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN REWRITE_TAC[REAL_NOT_LT; real_abs; REAL_SUB_LE] THEN SUBGOAL_THEN `f(x:real) <= y` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN SUBGOAL_THEN `f(x:real) <= f(v)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `y:real`; ALL_TAC] THEN ASM_REWRITE_TAC[real_sub; REAL_LE_RADD]]; DISCH_THEN(MP_TAC o SPEC `u - x`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_SUB_LT] THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `y < f(x:real)` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE]; ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN ASM_REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG; REAL_LE_RADD]; ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN REWRITE_TAC[REAL_NOT_LT; real_abs; REAL_SUB_LE] THEN SUBGOAL_THEN `f(u:real) < f(x)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_REWRITE_TAC[REAL_NOT_LT; REAL_LE_NEG; real_sub; REAL_LE_RADD]]]);; (*----------------------------------------------------------------------------*) (* Intermediate value theorem where value at the left end is bigger *) (*----------------------------------------------------------------------------*) let IVT2 = prove( `!f a b y. (a <= b) /\ (f(b) <= y /\ y <= f(a)) /\ (!x. a <= x /\ x <= b ==> f contl x) ==> ?x. a <= x /\ x <= b /\ (f(x) = y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`\x:real. --(f x)`; `a:real`; `b:real`; `--y`] IVT) THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG; REAL_NEG_EQ; REAL_NEGNEG] THEN DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONT_NEG THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Prove the simple combining theorems for differentiation *) (*----------------------------------------------------------------------------*) let DIFF_CONST = prove( `!k x. ((\x. k) diffl &0)(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN REWRITE_TAC[REAL_SUB_REFL; real_div; REAL_MUL_LZERO] THEN MATCH_ACCEPT_TAC LIM_CONST);; let DIFF_ADD = prove( `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==> ((\x. f(x) + g(x)) diffl (l + m))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_ADD2_SUB2] THEN REWRITE_TAC[real_div; REAL_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(f(x + h) - f(x)) / h`]) THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(g(x + h) - g(x)) / h`]) THEN MATCH_MP_TAC LIM_ADD THEN ASM_REWRITE_TAC[]);; let DIFF_MUL = prove( `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==> ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN DISCH_TAC THEN BETA_TAC THEN SUBGOAL_THEN `!a b c d. (a * b) - (c * d) = ((a * b) - (a * d)) + ((a * d) - (c * d))` (fun th -> ONCE_REWRITE_TAC[GEN_ALL th]) THENL [REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (b + c) + (a + d)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN `!a b c d e. ((a * b) + (c * d)) / e = ((b / e) * a) + ((c / e) * d)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_RDISTRIB] THEN BINOP_TAC THEN REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ADD_SYM] THEN CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`((g(x + h) - g(x)) / h) * f(x + h)`; `((f(x + h) - f(x)) / h) * g(x)`])) THEN MATCH_MP_TAC LIM_ADD THEN CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`(g(x + h) - g(x)) / h`; `f(x + h):real`; `(f(x + h) - f(x)) / h`; `g(x:real):real`])) THEN CONJ_TAC THEN MATCH_MP_TAC LIM_MUL THEN BETA_TAC THEN ASM_REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[GSYM contl] THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `l:real` THEN ASM_REWRITE_TAC[diffl]);; let DIFF_CMUL = prove( `!f c l x. (f diffl l)(x) ==> ((\x. c * f(x)) diffl (c * l))(x)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o CONJ (SPECL [`c:real`; `x:real`] DIFF_CONST)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN MATCH_MP_TAC(TAUT(`(a <=> b) ==> a ==> b`)) THEN AP_THM_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[]);; let DIFF_NEG = prove( `!f l x. (f diffl l)(x) ==> ((\x. --(f x)) diffl --l)(x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN MATCH_ACCEPT_TAC DIFF_CMUL);; let DIFF_SUB = prove( `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==> ((\x. f(x) - g(x)) diffl (l - m))(x)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD o (uncurry CONJ) o (I F_F MATCH_MP DIFF_NEG) o CONJ_PAIR) THEN BETA_TAC THEN REWRITE_TAC[real_sub]);; (* ------------------------------------------------------------------------- *) (* Carathe'odory definition makes the chain rule proof much easier. *) (* ------------------------------------------------------------------------- *) let DIFF_CARAT = prove( `!f l x. (f diffl l)(x) <=> ?g. (!z. f(z) - f(x) = g(z) * (z - x)) /\ g contl x /\ (g(x) = l)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [EXISTS_TAC `\z. if z = x then l else (f(z) - f(x)) / (z - x)` THEN BETA_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `z:real` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[REAL_SUB_0]; POP_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[diffl; contl] THEN BETA_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EQUAL THEN GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID_UNIQ; REAL_ADD_SUB]]; POP_ASSUM(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN UNDISCH_TAC `g contl x` THEN ASM_REWRITE_TAC[contl; diffl; REAL_ADD_SUB] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_EQUAL THEN GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN REWRITE_TAC[REAL_MUL_RID]]);; (*----------------------------------------------------------------------------*) (* Now the chain rule *) (*----------------------------------------------------------------------------*) let DIFF_CHAIN = prove( `!f g l m x. (f diffl l)(g x) /\ (g diffl m)(x) ==> ((\x. f(g x)) diffl (l * m))(x)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP DIFF_CONT th)) THEN REWRITE_TAC[DIFF_CARAT] THEN DISCH_THEN(X_CHOOSE_THEN `g':real->real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `f':real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z. if z = x then l * m else (f(g(z):real) - f(g(x))) / (z - x)` THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[REAL_SUB_0]; MP_TAC(CONJ (ASSUME `g contl x`) (ASSUME `f' contl (g(x:real))`)) THEN DISCH_THEN(MP_TAC o MATCH_MP CONT_COMPOSE) THEN DISCH_THEN(MP_TAC o C CONJ (ASSUME `g' contl x`)) THEN DISCH_THEN(MP_TAC o MATCH_MP CONT_MUL) THEN BETA_TAC THEN ASM_REWRITE_TAC[contl] THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_EQUAL THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID_UNIQ] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_ADD_SUB] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN REWRITE_TAC[REAL_MUL_RID]]);; (*----------------------------------------------------------------------------*) (* Differentiation of natural number powers *) (*----------------------------------------------------------------------------*) let DIFF_X = prove( `!x. ((\x. x) diffl &1)(x)`, GEN_TAC THEN REWRITE_TAC[diffl] THEN BETA_TAC THEN REWRITE_TAC[REAL_ADD_SUB] THEN REWRITE_TAC[LIM; REAL_SUB_RZERO] THEN BETA_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[GSYM ABS_NZ] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_REFL th]) THEN ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]);; let DIFF_POW = prove( `!n x. ((\x. x pow n) diffl (&n * (x pow (n - 1))))(x)`, INDUCT_TAC THEN REWRITE_TAC[pow; DIFF_CONST; REAL_MUL_LZERO] THEN X_GEN_TAC `x:real` THEN POP_ASSUM(MP_TAC o CONJ(SPEC `x:real` DIFF_X) o SPEC `x:real`) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[REAL; REAL_RDISTRIB; REAL_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN BINOP_TAC THENL [REWRITE_TAC[ADD1; ADD_SUB]; STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[ADD1; ADD_SUB; POW_ADD] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[num_CONV `1`; pow] THEN REWRITE_TAC[SYM(num_CONV `1`); REAL_MUL_RID]]);; (*----------------------------------------------------------------------------*) (* Now power of -1 (then differentiation of inverses follows from chain rule) *) (*----------------------------------------------------------------------------*) let DIFF_XM1 = prove( `!x. ~(x = &0) ==> ((\x. inv(x)) diffl (--(inv(x) pow 2)))(x)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[diffl] THEN BETA_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\h. --(inv(x + h) * inv(x))` THEN BETA_TAC THEN CONJ_TAC THENL [REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `abs(x)` THEN EVERY_ASSUM(fun th -> REWRITE_TAC[REWRITE_RULE[ABS_NZ] th]) THEN X_GEN_TAC `h:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN STRIP_ASSUME_TAC THEN BETA_TAC THEN W(C SUBGOAL_THEN SUBST1_TAC o C (curry mk_eq) `&0` o rand o rator o snd) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN SUBGOAL_THEN `~(x + h = &0)` ASSUME_TAC THENL [REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `abs(h) < abs(--h)` THEN REWRITE_TAC[ABS_NEG; REAL_LT_REFL]; ALL_TAC] THEN W(fun (asl,w) -> MP_TAC (SPECL [`x * (x + h)`; lhs w; rhs w] REAL_EQ_LMUL)) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[real_div; REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (c * b) * (d * a)`] THEN REWRITE_TAC(map (MATCH_MP REAL_MUL_LINV o ASSUME) [`~(x = &0)`; `~(x + h = &0)`]) THEN REWRITE_TAC[REAL_MUL_LID] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (a * d) * (c * b)`] THEN REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x = &0)`)] THEN REWRITE_TAC[REAL_MUL_LID; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[REWRITE_RULE[REAL_NEG_SUB] (AP_TERM `(--)` (SPEC_ALL REAL_ADD_SUB))] THEN REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[ABS_NZ]; REWRITE_TAC[POW_2] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `inv(x + h) * inv(x)`]) THEN REWRITE_TAC[GSYM LIM_NEG] THEN CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`inv(x + h)`; `inv(x)`])) THEN MATCH_MP_TAC LIM_MUL THEN BETA_TAC THEN REWRITE_TAC[LIM_CONST] THEN CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `x + h`]) THEN MATCH_MP_TAC LIM_INV THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`x:real`; `h:real`])) THEN MATCH_MP_TAC LIM_ADD THEN BETA_TAC THEN REWRITE_TAC[LIM_CONST] THEN MATCH_ACCEPT_TAC LIM_X]);; (*----------------------------------------------------------------------------*) (* Now differentiation of inverse and quotient *) (*----------------------------------------------------------------------------*) let DIFF_INV = prove( `!f l x. (f diffl l)(x) /\ ~(f(x) = &0) ==> ((\x. inv(f x)) diffl --(l / (f(x) pow 2)))(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_div; REAL_NEG_RMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CHAIN THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV (CONJUNCT2 th)]) THEN MATCH_MP_TAC(CONV_RULE(ONCE_DEPTH_CONV ETA_CONV) DIFF_XM1) THEN ASM_REWRITE_TAC[]);; let DIFF_DIV = prove( `!f g l m. (f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==> ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x))) / (g(x) pow 2)))(x)`, REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN REWRITE_TAC[real_div] THEN MP_TAC(SPECL [`g:real->real`; `m:real`; `x:real`] DIFF_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJ(ASSUME `(f diffl l)(x)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN W(C SUBGOAL_THEN SUBST1_TAC o mk_eq o ((rand o rator) F_F (rand o rator)) o dest_imp o snd) THEN REWRITE_TAC[] THEN REWRITE_TAC[real_sub] THEN REWRITE_TAC[REAL_LDISTRIB; REAL_RDISTRIB] THEN BINOP_TAC THENL [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[POW_2] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK (W CONJ th)]) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN REWRITE_TAC[REAL_MUL_LID]; REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_AC]]);; (*----------------------------------------------------------------------------*) (* Differentiation of finite sum *) (*----------------------------------------------------------------------------*) let DIFF_SUM = prove( `!f f' m n x. (!r. m <= r /\ r < (m + n) ==> ((\x. f r x) diffl (f' r x))(x)) ==> ((\x. sum(m,n)(\n. f n x)) diffl (sum(m,n) (\r. f' r x)))(x)`, REPEAT GEN_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum; DIFF_CONST] THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC DIFF_ADD THEN BETA_TAC THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `m + n:num` THEN ASM_REWRITE_TAC[ADD_CLAUSES; LESS_SUC_REFL]; REWRITE_TAC[LE_ADD; ADD_CLAUSES; LESS_SUC_REFL]]);; (*----------------------------------------------------------------------------*) (* By bisection, function continuous on closed interval is bounded above *) (*----------------------------------------------------------------------------*) let CONT_BOUNDED = prove( `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) ==> ?M. !x. a <= x /\ x <= b ==> f(x) <= M`, REPEAT STRIP_TAC THEN (MP_TAC o C SPEC BOLZANO_LEMMA) `\(u,v). a <= u /\ u <= v /\ v <= b ==> ?M. !x. u <= x /\ x <= v ==> f x <= M` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2(fst o dest_imp) o snd) THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN ASM_REWRITE_TAC[REAL_LE_REFL]] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN DISCH_TAC THEN REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `v <= b` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `w:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `a <= v` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `u:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `M1:real`) THEN DISCH_THEN(X_CHOOSE_TAC `M2:real`) THEN DISJ_CASES_TAC(SPECL [`M1:real`; `M2:real`] REAL_LE_TOTAL) THENL [EXISTS_TAC `M2:real` THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN DISJ_CASES_TAC(SPECL [`x:real`; `v:real`] REAL_LE_TOTAL) THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `M1:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; EXISTS_TAC `M1:real` THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN DISJ_CASES_TAC(SPECL [`x:real`; `v:real`] REAL_LE_TOTAL) THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `M2:real` THEN ASM_REWRITE_TAC[]] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL [ALL_TAC; EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a <= x /\ x <= b)` THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN ASM_REWRITE_TAC[]] THEN UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[contl; LIM] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN BETA_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `abs(f(x:real)) + &1` THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `z - x`) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN DISCH_TAC THEN MP_TAC(SPECL [`f(z:real) - f(x)`; `(f:real->real) x`] ABS_TRIANGLE) THEN REWRITE_TAC[REAL_SUB_ADD] THEN DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(z:real))` THEN REWRITE_TAC[ABS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(x:real)) + (abs(f(z) - f(x)))` THEN ASM_REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_CASES_TAC `z:real = x` THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0; REAL_LT_01]; FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM ABS_NZ] THEN ASM_REWRITE_TAC[REAL_SUB_0; real_abs; REAL_SUB_LE] THEN REWRITE_TAC[REAL_NEG_SUB] THEN COND_CASES_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `v - x`; EXISTS_TAC `v - z`] THEN ASM_REWRITE_TAC[real_sub; REAL_LE_RADD; REAL_LE_LADD; REAL_LE_NEG]]);; let CONT_BOUNDED_ABS = prove (`!f a b. (!x. a <= x /\ x <= b ==> f contl x) ==> ?M. !x. a <= x /\ x <= b ==> abs(f(x)) <= M`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL [ALL_TAC; ASM_SIMP_TAC[REAL_ARITH `~(a <= b) ==> ~(a <= x /\ x <= b)`]] THEN MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_BOUNDED) THEN MP_TAC(SPECL [`\x:real. --(f x)`; `a:real`; `b:real`] CONT_BOUNDED) THEN ASM_SIMP_TAC[CONT_NEG] THEN DISCH_THEN(X_CHOOSE_TAC `M1:real`) THEN DISCH_THEN(X_CHOOSE_TAC `M2:real`) THEN EXISTS_TAC `abs(M1) + abs(M2)` THEN ASM_SIMP_TAC[REAL_ARITH `x <= m1 /\ --x <= m2 ==> abs(x) <= abs(m2) + abs(m1)`]);; (*----------------------------------------------------------------------------*) (* Refine the above to existence of least upper bound *) (*----------------------------------------------------------------------------*) let CONT_HASSUP = prove( `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) ==> ?M. (!x. a <= x /\ x <= b ==> f(x) <= M) /\ (!N. N < M ==> ?x. a <= x /\ x <= b /\ N < f(x))`, let tm = `\y:real. ?x. a <= x /\ x <= b /\ (y = f(x))` in REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC tm REAL_SUP_LE) THEN BETA_TAC THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`(f:real->real) a`; `a:real`] THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_LT]; POP_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP CONT_BOUNDED) THEN EXISTS_TAC `M:real` THEN X_GEN_TAC `y:real` THEN DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THEN POP_ASSUM MATCH_ACCEPT_TAC]; DISCH_TAC THEN EXISTS_TAC (mk_comb(`sup`,tm)) THEN CONJ_TAC THENL [X_GEN_TAC `x:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC (mk_comb(`sup`,tm))) THEN REWRITE_TAC[REAL_LT_REFL] THEN CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN DISCH_THEN(MP_TAC o SPEC `(f:real->real) x`) THEN REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT] THEN CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[]; GEN_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `N:real`) THEN DISCH_THEN(X_CHOOSE_THEN `y:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST_ALL_TAC) THEN DISCH_TAC THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]]);; (*----------------------------------------------------------------------------*) (* Now show that it attains its upper bound *) (*----------------------------------------------------------------------------*) let CONT_ATTAINS = prove( `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) ==> ?M. (!x. a <= x /\ x <= b ==> f(x) <= M) /\ (?x. a <= x /\ x <= b /\ (f(x) = M))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `M:real` STRIP_ASSUME_TAC o MATCH_MP CONT_HASSUP) THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN CONV_TAC(RAND_CONV NOT_EXISTS_CONV) THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN DISCH_TAC THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> f(x) < M` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN PURE_ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. inv(M - f(x))) contl x` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC CONT_INV THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LT_IMP_NE THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC CONT_SUB THEN BETA_TAC THEN REWRITE_TAC[CONT_CONST] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?k. !x. a <= x /\ x <= b ==> (\x. inv(M - (f x))) x <= k` MP_TAC THENL [MATCH_MP_TAC CONT_BOUNDED THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> &0 < inv(M - f(x))` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_INV_POS THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. inv(M - (f x))) x < (k + &1)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `k:real` THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN BETA_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> inv(k + &1) < inv((\x. inv(M - (f x))) x)` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_INV2 THEN CONJ_TAC THENL [BETA_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN BETA_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> inv(k + &1) < (M - (f x))` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `~(M - f(x:real) = &0)` (SUBST1_TAC o SYM o MATCH_MP REAL_INVINV) THENL [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[REAL_LT_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN DISCH_TAC THEN UNDISCH_TAC `!N. N < M ==> (?x. a <= x /\ x <= b /\ N < (f x))` THEN DISCH_THEN(MP_TAC o SPEC `M - inv(k + &1)`) THEN REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `k:real` THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(M - f(a:real))` THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]; DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ONCE_REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; (*----------------------------------------------------------------------------*) (* Same theorem for lower bound *) (*----------------------------------------------------------------------------*) let CONT_ATTAINS2 = prove( `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) ==> ?M. (!x. a <= x /\ x <= b ==> M <= f(x)) /\ (?x. a <= x /\ x <= b /\ (f(x) = M))`, REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. --(f x)) contl x` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONT_NEG THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o CONJ (ASSUME `a <= b`)) THEN DISCH_THEN(X_CHOOSE_THEN `M:real` MP_TAC o MATCH_MP CONT_ATTAINS) THEN BETA_TAC THEN DISCH_TAC THEN EXISTS_TAC `--M` THEN CONJ_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG]; ASM_REWRITE_TAC[GSYM REAL_NEG_EQ]]);; (* ------------------------------------------------------------------------- *) (* Another version. *) (* ------------------------------------------------------------------------- *) let CONT_ATTAINS_ALL = prove( `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) ==> ?L M. (!x. a <= x /\ x <= b ==> L <= f(x) /\ f(x) <= M) /\ !y. L <= y /\ y <= M ==> ?x. a <= x /\ x <= b /\ (f(x) = y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `L:real` MP_TAC o MATCH_MP CONT_ATTAINS2) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x1:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(X_CHOOSE_THEN `M:real` MP_TAC o MATCH_MP CONT_ATTAINS) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x2:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`L:real`; `M:real`] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISJ_CASES_TAC(SPECL [`x1:real`; `x2:real`] REAL_LE_TOTAL) THEN REPEAT STRIP_TAC THENL [MP_TAC(SPECL [`f:real->real`; `x1:real`; `x2:real`; `y:real`] IVT) THEN ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2); DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN (CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `x1:real`; EXISTS_TAC `x2:real`] THEN ASM_REWRITE_TAC[]); MP_TAC(SPECL [`f:real->real`; `x2:real`; `x1:real`; `y:real`] IVT2) THEN ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2); DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN (CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `x2:real`; EXISTS_TAC `x1:real`] THEN ASM_REWRITE_TAC[])]);; (*----------------------------------------------------------------------------*) (* If f'(x) > 0 then x is locally strictly increasing at the right *) (*----------------------------------------------------------------------------*) let DIFF_LINC = prove( `!f x l. (f diffl l)(x) /\ &0 < l ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> f(x) < f(x + h)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[diffl; LIM; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `l:real`) THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INV_POS o CONJUNCT1) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC ABS_SIGN THEN EXISTS_TAC `l:real` THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE o CONJUNCT1) THEN ASM_REWRITE_TAC[real_abs]);; (*----------------------------------------------------------------------------*) (* If f'(x) < 0 then x is locally strictly increasing at the left *) (*----------------------------------------------------------------------------*) let DIFF_LDEC = prove( `!f x l. (f diffl l)(x) /\ l < &0 ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> f(x) < f(x - h)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[diffl; LIM; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `--l`) THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN REWRITE_TAC[REAL_NEG_LT0] THEN BETA_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INV_POS o CONJUNCT1) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEG_RMUL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_NEG_INV (GSYM (MATCH_MP REAL_LT_IMP_NE (CONJUNCT1 th)))]) THEN MATCH_MP_TAC ABS_SIGN2 THEN EXISTS_TAC `l:real` THEN REWRITE_TAC[GSYM real_div] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o funpow 3 LAND_CONV o RAND_CONV) [real_sub] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE o CONJUNCT1) THEN REWRITE_TAC[real_abs; GSYM REAL_NEG_LE0; REAL_NEGNEG] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT]);; (*----------------------------------------------------------------------------*) (* If f is differentiable at a local maximum x, f'(x) = 0 *) (*----------------------------------------------------------------------------*) let DIFF_LMAX = prove( `!f x l. (f diffl l)(x) /\ (?d. &0 < d /\ (!y. abs(x - y) < d ==> f(y) <= f(x))) ==> (l = &0)`, REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC)) THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`l:real`; `&0`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(MP_TAC o C CONJ(ASSUME `l < &0`)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_LDEC) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(SPECL [`k:real`; `e:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `x - d`) THEN REWRITE_TAC[REAL_SUB_SUB2] THEN SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT]; DISCH_THEN(MP_TAC o C CONJ(ASSUME `&0 < l`)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_LINC) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(SPECL [`k:real`; `e:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `x + d`) THEN REWRITE_TAC[REAL_ADD_SUB2] THEN SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[ABS_NEG] THEN ASM_REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT]]);; (*----------------------------------------------------------------------------*) (* Similar theorem for a local minimum *) (*----------------------------------------------------------------------------*) let DIFF_LMIN = prove( `!f x l. (f diffl l)(x) /\ (?d. &0 < d /\ (!y. abs(x - y) < d ==> f(x) <= f(y))) ==> (l = &0)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`\x:real. --(f x)`; `x:real`; `--l`] DIFF_LMAX) THEN BETA_TAC THEN REWRITE_TAC[REAL_LE_NEG; REAL_NEG_EQ0] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_NEG THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* In particular if a function is locally flat *) (*----------------------------------------------------------------------------*) let DIFF_LCONST = prove( `!f x l. (f diffl l)(x) /\ (?d. &0 < d /\ (!y. abs(x - y) < d ==> (f(y) = f(x)))) ==> (l = &0)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC DIFF_LMAX THEN MAP_EVERY EXISTS_TAC [`f:real->real`; `x:real`] THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(SUBST1_TAC o C MATCH_MP th)) THEN MATCH_ACCEPT_TAC REAL_LE_REFL);; (*----------------------------------------------------------------------------*) (* Lemma about introducing open ball in open interval *) (*----------------------------------------------------------------------------*) let INTERVAL_LEMMA_LT = prove( `!a b x. a < x /\ x < b ==> ?d. &0 < d /\ !y. abs(x - y) < d ==> a < y /\ y < b`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ABS_BETWEEN] THEN DISJ_CASES_TAC(SPECL [`x - a`; `b - x`] REAL_LE_TOTAL) THENL [EXISTS_TAC `x - a`; EXISTS_TAC `b - x`] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN GEN_TAC THEN REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN REWRITE_TAC[real_sub; REAL_ADD_ASSOC] THEN REWRITE_TAC[GSYM real_sub; REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN FREEZE_THEN(fun th -> ONCE_REWRITE_TAC[th]) (SPEC `x:real` REAL_ADD_SYM) THEN REWRITE_TAC[REAL_LT_RADD] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN (MATCH_MP_TAC o GEN_ALL o fst o EQ_IMP_RULE o SPEC_ALL) REAL_LT_RADD THENL [EXISTS_TAC `a:real` THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x + x` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(x - a) <= (b - x)`; EXISTS_TAC `b:real` THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x + x` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(b - x) <= (x - a)`] THEN REWRITE_TAC[REAL_LE_SUB_LADD; GSYM REAL_LE_SUB_RADD] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_sub] THEN REWRITE_TAC[REAL_ADD_AC]);; let INTERVAL_LEMMA = prove( `!a b x. a < x /\ x < b ==> ?d. &0 < d /\ !y. abs(x - y) < d ==> a <= y /\ y <= b`, REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `d:real` o MATCH_MP INTERVAL_LEMMA_LT) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th o CONJUNCT2)) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);; (*----------------------------------------------------------------------------*) (* Now Rolle's theorem *) (*----------------------------------------------------------------------------*) let ROLLE = prove( `!f a b. a < b /\ (f(a) = f(b)) /\ (!x. a <= x /\ x <= b ==> f contl x) /\ (!x. a < x /\ x < b ==> f differentiable x) ==> ?z. a < z /\ z < b /\ (f diffl &0)(z)`, REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_ATTAINS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `M:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x1:real`)) THEN MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_ATTAINS2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x2:real`)) THEN ASM_CASES_TAC `a < x1 /\ x1 < b` THENL [FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN DISCH_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC `x1:real` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?l. (f diffl l)(x1) /\ ?d. &0 < d /\ (!y. abs(x1 - y) < d ==> f(y) <= f(x1))` MP_TAC THENL [CONV_TAC EXISTS_AND_CONV THEN CONJ_TAC THENL [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN SUBST_ALL_TAC(MATCH_MP DIFF_LMAX th)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `a < x2 /\ x2 < b` THENL [FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN DISCH_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC `x2:real` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?l. (f diffl l)(x2) /\ ?d. &0 < d /\ (!y. abs(x2 - y) < d ==> f(x2) <= f(y))` MP_TAC THENL [CONV_TAC EXISTS_AND_CONV THEN CONJ_TAC THENL [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN SUBST_ALL_TAC(MATCH_MP DIFF_LMIN th)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (f(x):real = f(b))` MP_TAC THENL [REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl)) THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT (DISCH_THEN(DISJ_CASES_THEN2 (MP_TAC o SYM) MP_TAC) THEN DISCH_THEN(SUBST_ALL_TAC o AP_TERM `f:real->real`)) THEN UNDISCH_TAC `(f:real->real) a = f b` THEN DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN (CONJ_TAC THENL [SUBGOAL_THEN `(f:real->real) b = M` SUBST1_TAC THENL [FIRST_ASSUM(ACCEPT_TAC o el 2 o CONJUNCTS); FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; SUBGOAL_THEN `(f:real->real) b = m` SUBST1_TAC THENL [FIRST_ASSUM(ACCEPT_TAC o el 2 o CONJUNCTS); FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]); X_CHOOSE_TAC `x:real` (MATCH_MP REAL_MEAN (ASSUME `a < b`)) THEN DISCH_TAC THEN EXISTS_TAC `x:real` THEN REWRITE_TAC[ASSUME `a < x /\ x < b`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?l. (f diffl l)(x) /\ (?d. &0 < d /\ (!y. abs(x - y) < d ==> (f(y) = f(x))))` MP_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV EXISTS_AND_CONV) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `l:real` (fun th -> ASSUME_TAC th THEN SUBST_ALL_TAC(MATCH_MP DIFF_LCONST th))) THEN ASM_REWRITE_TAC[]]]);; (*----------------------------------------------------------------------------*) (* Mean value theorem *) (*----------------------------------------------------------------------------*) let MVT_LEMMA = prove( `!(f:real->real) a b. (\x. f(x) - (((f(b) - f(a)) / (b - a)) * x))(a) = (\x. f(x) - (((f(b) - f(a)) / (b - a)) * x))(b)`, REPEAT GEN_TAC THEN BETA_TAC THEN ASM_CASES_TAC `b:real = a` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_0]) THEN MP_TAC(GENL [`x:real`; `y:real`] (SPECL [`x:real`; `y:real`; `b - a`] REAL_EQ_RMUL)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN REWRITE_TAC[REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_RMUL th]) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_RDISTRIB] THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL; REAL_NEG_ADD; REAL_NEGNEG] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN REWRITE_TAC[AC REAL_ADD_AC `w + x + y + z = (y + w) + (x + z)`; REAL_ADD_LINV; REAL_ADD_LID] THEN REWRITE_TAC[REAL_ADD_RID]);; let MVT = prove( `!f a b. a < b /\ (!x. a <= x /\ x <= b ==> f contl x) /\ (!x. a < x /\ x < b ==> f differentiable x) ==> ?l z. a < z /\ z < b /\ (f diffl l)(z) /\ (f(b) - f(a) = (b - a) * l)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`\x. f(x) - (((f(b) - f(a)) / (b - a)) * x)`; `a:real`; `b:real`] ROLLE) THEN W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [ASM_REWRITE_TAC[MVT_LEMMA] THEN BETA_TAC THEN CONJ_TAC THEN X_GEN_TAC `x:real` THENL [DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC CONT_SUB THEN CONJ_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC CONT_MUL THEN REWRITE_TAC[CONT_CONST] THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC DIFF_X]; DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN REWRITE_TAC[differentiable] THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN EXISTS_TAC `l - ((f(b) - f(a)) / (b - a))` THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM ACCEPT_TAC; CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC DIFF_CMUL THEN MATCH_ACCEPT_TAC DIFF_X]]; ALL_TAC] THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN((then_) (MAP_EVERY EXISTS_TAC [`((f(b) - f(a)) / (b - a))`; `z:real`]) o MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN((then_) CONJ_TAC o MP_TAC) THENL [ALL_TAC; DISCH_THEN(K ALL_TAC) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `a < a` THEN REWRITE_TAC[REAL_LT_REFL]] THEN SUBGOAL_THEN `((\x. ((f(b) - f(a)) / (b - a)) * x ) diffl ((f(b) - f(a)) / (b - a)))(z)` (fun th -> DISCH_THEN(MP_TAC o C CONJ th)) THENL [CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC DIFF_CMUL THEN REWRITE_TAC[DIFF_X]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_ADD] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[REAL_ADD_LID]);; (* ------------------------------------------------------------------------- *) (* Simple version with pure differentiability assumption. *) (* ------------------------------------------------------------------------- *) let MVT_ALT = prove (`!f f' a b. a < b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) ==> ?z. a < z /\ z < b /\ (f b - f a = (b - a) * f'(z))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?l z. a < z /\ z < b /\ (f diffl l) z /\ (f b - f a = (b - a) * l)` MP_TAC THENL [MATCH_MP_TAC MVT THEN REWRITE_TAC[differentiable] THEN ASM_MESON_TAC[DIFF_CONT; REAL_LT_IMP_LE]; ASM_MESON_TAC[DIFF_UNIQ; REAL_LT_IMP_LE]]);; (*----------------------------------------------------------------------------*) (* Theorem that function is constant if its derivative is 0 over an interval. *) (* *) (* We could have proved this directly by bisection; consider instantiating *) (* BOLZANO_LEMMA with *) (* *) (* \(x,y). f(y) - f(x) <= C * (y - x) *) (* *) (* However the Rolle and Mean Value theorems are useful to have anyway *) (*----------------------------------------------------------------------------*) let DIFF_ISCONST_END = prove( `!f a b. a < b /\ (!x. a <= x /\ x <= b ==> f contl x) /\ (!x. a < x /\ x < b ==> (f diffl &0)(x)) ==> (f b = f a)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] MVT) THEN ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [GEN_TAC THEN REWRITE_TAC[differentiable] THEN DISCH_THEN((then_) (EXISTS_TAC `&0`) o MP_TAC) THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` (X_CHOOSE_THEN `x:real` MP_TAC)) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ b) /\ (c /\ d)`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(MP_TAC o CONJ (ASSUME `(f diffl l)(x)`)) THEN DISCH_THEN(SUBST_ALL_TAC o MATCH_MP DIFF_UNIQ) THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_MUL_RZERO; REAL_SUB_0]) THEN FIRST_ASSUM ACCEPT_TAC);; let DIFF_ISCONST = prove( `!f a b. a < b /\ (!x. a <= x /\ x <= b ==> f contl x) /\ (!x. a < x /\ x < b ==> (f diffl &0)(x)) ==> !x. a <= x /\ x <= b ==> (f x = f a)`, REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`f:real->real`; `a:real`; `x:real`] DIFF_ISCONST_END) THEN DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `a <= x`)) THENL [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real`; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x:real`] THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]]);; let DIFF_ISCONST_END_SIMPLE = prove (`!f a b. a < b /\ (!x. a <= x /\ x <= b ==> (f diffl &0)(x)) ==> (f b = f a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_ISCONST_END THEN ASM_MESON_TAC[DIFF_CONT; REAL_LT_IMP_LE]);; let DIFF_ISCONST_ALL = prove( `!f x y. (!x. (f diffl &0)(x)) ==> (f(x) = f(y))`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!x. f contl x` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THENL [DISCH_THEN SUBST1_TAC THEN REFL_TAC; CONV_TAC(RAND_CONV SYM_CONV); ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_ISCONST_END THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------ *) (* Boring lemma about distances *) (* ------------------------------------------------------------------------ *) let INTERVAL_ABS = REAL_ARITH `!x z d. (x - d) <= z /\ z <= (x + d) <=> abs(z - x) <= d`;; (* ------------------------------------------------------------------------ *) (* Dull lemma that an continuous injection on an interval must have a strict*) (* maximum at an end point, not in the middle. *) (* ------------------------------------------------------------------------ *) let CONT_INJ_LEMMA = prove( `!f g x d. &0 < d /\ (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ (!z. abs(z - x) <= d ==> f contl z) ==> ~(!z. abs(z - x) <= d ==> f(z) <= f(x))`, REPEAT GEN_TAC THEN STRIP_TAC THEN IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN DISCH_THEN(fun th -> MAP_EVERY (MP_TAC o C SPEC th) [`x - d`; `x + d`]) THEN REWRITE_TAC[REAL_ADD_SUB; REAL_SUB_SUB; ABS_NEG] THEN ASM_REWRITE_TAC[real_abs; REAL_LE_REFL] THEN DISCH_TAC THEN DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`f(x - d):real`; `f(x + d):real`] REAL_LE_TOTAL) THENL [MP_TAC(SPECL [`f:real->real`; `x - d`; `x:real`; `f(x + d):real`] IVT) THEN ASM_REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_ADDR] THEN W(C SUBGOAL_THEN MP_TAC o fst o dest_imp o dest_neg o snd) THENL [X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN REWRITE_TAC[real_abs; REAL_SUB_LE] THEN ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o AP_TERM `g:real->real`) THEN SUBGOAL_THEN `g((f:real->real) z) = z` SUBST1_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN REWRITE_TAC[real_abs; REAL_SUB_LE] THEN ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `g(f(x + d):real) = x + d` SUBST1_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_ADD_SUB] THEN ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_ADDR]]; MP_TAC(SPECL [`f:real->real`; `x:real`; `x + d`; `f(x - d):real`] IVT2) THEN ASM_REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_ADDR] THEN W(C SUBGOAL_THEN MP_TAC o fst o dest_imp o dest_neg o snd) THENL [X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o AP_TERM `g:real->real`) THEN SUBGOAL_THEN `g((f:real->real) z) = z` SUBST1_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `g(f(x - d):real) = x - d` SUBST1_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_SUB_SUB; ABS_NEG] THEN ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR]]]);; (* ------------------------------------------------------------------------ *) (* Similar version for lower bound *) (* ------------------------------------------------------------------------ *) let CONT_INJ_LEMMA2 = prove( `!f g x d. &0 < d /\ (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ (!z. abs(z - x) <= d ==> f contl z) ==> ~(!z. abs(z - x) <= d ==> f(x) <= f(z))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`\x:real. --(f x)`; `\y. (g(--y):real)`; `x:real`; `d:real`] CONT_INJ_LEMMA) THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEGNEG; REAL_LE_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONT_NEG THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; (* ------------------------------------------------------------------------ *) (* Show there's an interval surrounding f(x) in f[[x - d, x + d]] *) (* ------------------------------------------------------------------------ *) let CONT_INJ_RANGE = prove( `!f g x d. &0 < d /\ (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ (!z. abs(z - x) <= d ==> f contl z) ==> ?e. &0 < e /\ (!y. abs(y - f(x)) <= e ==> ?z. abs(z - x) <= d /\ (f z = y))`, REPEAT GEN_TAC THEN STRIP_TAC THEN IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN MP_TAC(SPECL [`f:real->real`; `x - d`; `x + d`] CONT_ATTAINS_ALL) THEN ASM_REWRITE_TAC[INTERVAL_ABS; REAL_LE_SUB_RADD] THEN ASM_REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_LE_ADDR; REAL_LE_DOUBLE] THEN DISCH_THEN(X_CHOOSE_THEN `L:real` (X_CHOOSE_THEN `M:real` MP_TAC)) THEN STRIP_TAC THEN SUBGOAL_THEN `L <= f(x:real) /\ f(x) <= M` STRIP_ASSUME_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]; ALL_TAC] THEN SUBGOAL_THEN `L < f(x:real) /\ f(x:real) < M` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THENL [DISCH_THEN SUBST_ALL_TAC THEN (MP_TAC o C SPECL CONT_INJ_LEMMA2) [`f:real->real`; `g:real->real`; `x:real`; `d:real`]; DISCH_THEN(SUBST_ALL_TAC o SYM) THEN (MP_TAC o C SPECL CONT_INJ_LEMMA) [`f:real->real`; `g:real->real`; `x:real`; `d:real`]] THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(fun t -> FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP th t] THEN NO_TAC)); MP_TAC(SPECL [`f(x:real) - L`; `M - f(x:real)`] REAL_DOWN2) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM INTERVAL_ABS] THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `abs(y - f(x:real)) <= e` THEN REWRITE_TAC[GSYM INTERVAL_ABS] THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(x:real) - e` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_LE_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_LE_SUB_LADD]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(x:real) + (M - f(x))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(x:real) + e` THEN ASM_REWRITE_TAC[REAL_LE_LADD]; REWRITE_TAC[REAL_SUB_ADD2; REAL_LE_REFL]]] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------ *) (* Continuity of inverse function *) (* ------------------------------------------------------------------------ *) let CONT_INVERSE = prove( `!f g x d. &0 < d /\ (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ (!z. abs(z - x) <= d ==> f contl z) ==> g contl (f x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[contl; LIM] THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN MP_TAC(SPECL [`a:real`; `d:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN SUBGOAL_THEN `!z. abs(z - x) <= e ==> (g(f z :real) = z)` ASSUME_TAC THENL [X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!z. abs(z - x) <= e ==> (f contl z)` ASSUME_TAC THENL [X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN UNDISCH_TAC `!z. abs(z - x) <= d ==> (g(f z :real) = z)` THEN UNDISCH_TAC `!z. abs(z - x) <= d ==> (f contl z)` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(K ALL_TAC) THEN (MP_TAC o C SPECL CONT_INJ_RANGE) [`f:real->real`; `g:real->real`; `x:real`; `e:real`] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN REWRITE_TAC[GSYM ABS_NZ] THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> MP_TAC(SPEC `f(x:real) + h` th) THEN REWRITE_TAC[REAL_ADD_SUB; ASSUME `abs(h) <= k`] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e:real` THEN SUBGOAL_THEN `(g((f:real->real)(z)) = z) /\ (g(f(x)) = x)` (fun t -> ASM_REWRITE_TAC[t]) THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]);; (* ------------------------------------------------------------------------ *) (* Differentiability of inverse function *) (* ------------------------------------------------------------------------ *) let DIFF_INVERSE = prove( `!f g l x d. &0 < d /\ (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ (!z. abs(z - x) <= d ==> f contl z) /\ (f diffl l)(x) /\ ~(l = &0) ==> (g diffl (inv l))(f x)`, REPEAT STRIP_TAC THEN UNDISCH_TAC `(f diffl l)(x)` THEN DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP DIFF_CONT th) THEN MP_TAC th) THEN REWRITE_TAC[DIFF_CARAT] THEN DISCH_THEN(X_CHOOSE_THEN `h:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\y. if y = f(x) then inv(h(g y)) else (g(y) - g(f(x:real))) / (y - f(x))` THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `z:real` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[REAL_SUB_0]; ALL_TAC; FIRST_ASSUM(SUBST1_TAC o SYM) THEN REPEAT AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_SUB_REFL; ABS_0] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `g((f:real->real)(x)) = x` ASSUME_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_SUB_REFL; ABS_0] THEN MATCH_MP_TAC REAL_LT_IMP_LE; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\y:real. inv(h(g(y):real))` THEN BETA_TAC THEN CONJ_TAC THENL [ALL_TAC; (SUBST1_TAC o SYM o ONCE_DEPTH_CONV BETA_CONV) `\y. inv((\y:real. h(g(y):real)) y)` THEN MATCH_MP_TAC LIM_INV THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\y:real. h(g(y):real)) contl (f(x:real))` MP_TAC THENL [MATCH_MP_TAC CONT_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONT_INVERSE THEN EXISTS_TAC `d:real`; REWRITE_TAC[CONTL_LIM] THEN BETA_TAC] THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `?e. &0 < e /\ !y. &0 < abs(y - f(x:real)) /\ abs(y - f(x:real)) < e ==> (f(g(y)) = y) /\ ~(h(g(y)) = &0)` STRIP_ASSUME_TAC THENL [ALL_TAC; REWRITE_TAC[LIM] THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN DISCH_THEN(fun th -> FIRST_ASSUM(STRIP_ASSUME_TAC o C MATCH_MP th) THEN ASSUME_TAC(REWRITE_RULE[GSYM ABS_NZ; REAL_SUB_0] (CONJUNCT1 th))) THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN SUBGOAL_THEN `y - f(x) = h(g(y)) * (g(y) - x)` SUBST1_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN REWRITE_TAC[ASSUME `f((g:real->real)(y)) = y`]; UNDISCH_TAC `&0 < k` THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[ABS_ZERO; REAL_SUB_0]] THEN SUBGOAL_THEN `~(g(y:real) - x = &0)` ASSUME_TAC THENL [REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN(MP_TAC o AP_TERM `f:real->real`) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[real_div]] THEN SUBGOAL_THEN `inv((h(g(y))) * (g(y:real) - x)) = inv(h(g(y))) * inv(g(y) - x)` SUBST1_TAC THENL [MATCH_MP_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]]] THEN SUBGOAL_THEN `?e. &0 < e /\ !y. &0 < abs(y - f(x:real)) /\ abs(y - f(x)) < e ==> (f(g(y)) = y)` (X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THENL [MP_TAC(SPECL [`f:real->real`; `g:real->real`; `x:real`; `d:real`] CONT_INJ_RANGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(f:real->real)(z) = y` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?e. &0 < e /\ !y. &0 < abs(y - f(x:real)) /\ abs(y - f(x)) < e ==> ~((h:real->real)(g(y)) = &0)` (X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THENL [ALL_TAC; MP_TAC(SPECL [`b:real`; `c:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `(\y. h(g(y:real):real)) contl (f(x:real))` MP_TAC THENL [MATCH_MP_TAC CONT_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONT_INVERSE THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONTL_LIM; LIM] THEN DISCH_THEN(MP_TAC o SPEC `abs(l)`) THEN ASM_REWRITE_TAC[GSYM ABS_NZ] THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[ABS_NZ] THEN X_GEN_TAC `y:real` THEN RULE_ASSUM_TAC(REWRITE_RULE[ABS_NZ]) THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN REWRITE_TAC[GSYM ABS_NZ] THEN CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG; REAL_LT_REFL]);; let DIFF_INVERSE_LT = prove( `!f g l x d. &0 < d /\ (!z. abs(z - x) < d ==> (g(f(z)) = z)) /\ (!z. abs(z - x) < d ==> f contl z) /\ (f diffl l)(x) /\ ~(l = &0) ==> (g diffl (inv l))(f x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_INVERSE THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2]);; (* ------------------------------------------------------------------------- *) (* Every derivative is Darboux continuous. *) (* ------------------------------------------------------------------------- *) let IVT_DERIVATIVE_0 = prove (`!f f' a b. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ f'(a) > &0 /\ f'(b) < &0 ==> ?z. a < z /\ z < b /\ (f'(z) = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_gt] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_LE_LT] THEN STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_ANTISYM]] THEN SUBGOAL_THEN `?w. (!x. a <= x /\ x <= b ==> f x <= w) /\ (?x. a <= x /\ x <= b /\ (f x = w))` MP_TAC THENL [MATCH_MP_TAC CONT_ATTAINS THEN ASM_MESON_TAC[REAL_LT_IMP_LE; DIFF_CONT]; ALL_TAC] THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `z:real` THEN ASM_CASES_TAC `z:real = a` THENL [UNDISCH_THEN `z:real = a` SUBST_ALL_TAC THEN MP_TAC(SPECL[`f:real->real`; `a:real`; `(f':real->real) a`] DIFF_LINC) THEN ASM_SIMP_TAC[REAL_LE_REFL; REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d:real`; `b - a`] REAL_DOWN2) THEN ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `!h. &0 < h /\ h < d ==> w < f (a + h)` THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_NOT_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_SIMP_TAC[REAL_LE_ADDL; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_CASES_TAC `z:real = b` THENL [UNDISCH_THEN `z:real = b` SUBST_ALL_TAC THEN MP_TAC(SPECL[`f:real->real`; `b:real`; `(f':real->real) b`] DIFF_LDEC) THEN ASM_SIMP_TAC[REAL_LE_REFL; REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d:real`; `b - a`] REAL_DOWN2) THEN ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `!h. &0 < h /\ h < d ==> w < f (b - h)` THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_NOT_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_SIMP_TAC[REAL_LE_ADDL; REAL_LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `a < z /\ z < b` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LMAX THEN MP_TAC(SPECL [`z - a`; `b - z`] REAL_DOWN2) THEN ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`f:real->real`; `z:real`] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN MAP_EVERY UNDISCH_TAC [`e + z < b`; `e + a < z`] THEN REAL_ARITH_TAC);; let IVT_DERIVATIVE_POS = prove (`!f f' a b y. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ f'(a) > y /\ f'(b) < y ==> ?z. a < z /\ z < b /\ (f'(z) = y)`, REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. f(x) - y * x`; `\x:real. f'(x) - y`; `a:real`; `b:real`] IVT_DERIVATIVE_0) THEN ASM_REWRITE_TAC[real_gt] THEN ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN ASM_REWRITE_TAC[REAL_EQ_SUB_RADD; REAL_ADD_LID] THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN ASM_SIMP_TAC[DIFF_SUB; DIFF_X; DIFF_CMUL]);; let IVT_DERIVATIVE_NEG = prove (`!f f' a b y. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ f'(a) < y /\ f'(b) > y ==> ?z. a < z /\ z < b /\ (f'(z) = y)`, REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x:real. --(f x)`; `\x:real. --(f' x)`; `a:real`; `b:real`; `--y`] IVT_DERIVATIVE_POS) THEN ASM_REWRITE_TAC[real_gt; REAL_LT_NEG2; REAL_EQ_NEG2] THEN ASM_SIMP_TAC[DIFF_NEG]);; (* ------------------------------------------------------------------------- *) (* Uniformly convergent sequence of continuous functions is continuous. *) (* (Continuity at a point; uniformity in some neighbourhood of that point.) *) (* ------------------------------------------------------------------------- *) let SEQ_CONT_UNIFORM = prove (`!s f x0. (!e. &0 < e ==> ?N d. &0 < d /\ !x n. abs(x - x0) < d /\ n >= N ==> abs(s n x - f(x)) < e) /\ (?N:num. !n. n >= N ==> (s n) contl x0) ==> f contl x0`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `M:num`)) THEN REWRITE_TAC[CONTL_LIM; LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`N:num`; `d1:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN REWRITE_TAC[CONTL_LIM; LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!fx sx fx0 sx0 e3. abs(sx - fx) < e3 /\ abs(sx0 - fx0) < e3 /\ abs(sx - sx0) < e3 /\ (&3 * e3 = e) ==> abs(fx - fx0) < e`) THEN MAP_EVERY EXISTS_TAC [`(s:num->real->real) (M + N) x`; `(s:num->real->real) (M + N) x0`; `e / &3`] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN ASM_MESON_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_TRANS; ARITH_RULE `M + N >= N:num`]);; (* ------------------------------------------------------------------------- *) (* Comparison test gives uniform convergence of sum in a neighbourhood. *) (* ------------------------------------------------------------------------- *) let SER_COMPARA_UNIFORM = prove (`!s x0 g. (?N d. &0 < d /\ !n x. abs(x - x0) < d /\ n >= N ==> abs(s x n) <= g n) /\ summable g ==> ?f d. &0 < d /\ !e. &0 < e ==> ?N. !x n. abs(x - x0) < d /\ n >= N ==> abs(sum(0,n) (s x) - f(x)) < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. abs(x - x0) < d ==> ?y. (s x) sums y` MP_TAC THENL [ASM_MESON_TAC[summable; SER_COMPAR]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real->real` THEN DISCH_TAC THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SER_CAUCHY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `M + N:num` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real`; `n:num`] THEN STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE `n >= M + N ==> n >= M /\ n >= N:num`)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[sums; SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m + n:num`)) THEN REWRITE_TAC[GE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ONCE_REWRITE_TAC[GSYM SUM_TWO] THEN MATCH_MP_TAC(REAL_ARITH `abs(snm) < e2 /\ (&2 * e2 = e) ==> abs((sn + snm) - fx) < e2 ==> abs(sn - fx) < e`) THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(n,m) (\n. abs(s (x:real) n))` THEN REWRITE_TAC[SUM_ABS_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(n,m) g` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[GE; LE_TRANS]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) < a ==> x < a`) THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* A weaker variant matching the requirement for continuity of limit. *) (* ------------------------------------------------------------------------- *) let SER_COMPARA_UNIFORM_WEAK = prove (`!s x0 g. (?N d. &0 < d /\ !n x. abs(x - x0) < d /\ n >= N ==> abs(s x n) <= g n) /\ summable g ==> ?f. !e. &0 < e ==> ?N d. &0 < d /\ !x n. abs(x - x0) < d /\ n >= N ==> abs(sum(0,n) (s x) - f(x)) < e`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SER_COMPARA_UNIFORM) THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* More convenient formulation of continuity. *) (* ------------------------------------------------------------------------- *) let CONTL = prove (`!f x. f contl x <=> !e. &0 < e ==> ?d. &0 < d /\ !x'. abs(x' - x) < d ==> abs(f(x') - f(x)) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTL_LIM; LIM] THEN REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> ((a ==> b) <=> (a ==> c))`) THEN DISCH_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; (* ------------------------------------------------------------------------- *) (* Of course we also have this and similar results for sequences. *) (* ------------------------------------------------------------------------- *) let CONTL_SEQ = prove (`!f x l. f contl l /\ x tends_num_real l ==> (\n. f(x n)) tends_num_real f(l)`, REWRITE_TAC[CONTL; SEQ] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Uniformity of continuity over closed interval. *) (* ------------------------------------------------------------------------- *) let SUP_INTERVAL = prove (`!P a b. (?x. a <= x /\ x <= b /\ P x) ==> ?s. a <= s /\ s <= b /\ !y. y < s <=> (?x. a <= x /\ x <= b /\ P x /\ y < x)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. a <= x /\ x <= b /\ P x` REAL_SUP) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `x <= b ==> x < b + &1`]; ALL_TAC] THEN ABBREV_TAC `s = sup (\x. a <= x /\ x <= b /\ P x)` THEN REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LTE_TRANS; REAL_NOT_LE; REAL_LT_ANTISYM]);; let CONT_UNIFORM = prove (`!f a b. a <= b /\ (!x. a <= x /\ x <= b ==> f contl x) ==> !e. &0 < e ==> ?d. &0 < d /\ !x y. a <= x /\ x <= b /\ a <= y /\ y <= b /\ abs(x - y) < d ==> abs(f(x) - f(y)) < e`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\c. ?d. &0 < d /\ !x y. a <= x /\ x <= c /\ a <= y /\ y <= c /\ abs(x - y) < d ==> abs(f(x) - f(y)) < e` SUP_INTERVAL) THEN DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN ANTS_TAC THENL [EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_ARITH `abs(x - x) = &0`]; ALL_TAC] THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?t. s < t /\ ?d. &0 < d /\ !x y. a <= x /\ x <= t /\ a <= y /\ y <= t /\ abs(x - y) < d ==> abs(f(x) - f(y)) < e` MP_TAC THENL [UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN DISCH_THEN(MP_TAC o SPEC `s:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONTL_LIM; LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `&0 < d1 / &2 /\ d1 / &2 < d1` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_LT_LDIV_EQ; REAL_ARITH `d < d * &2 <=> &0 < d`]; ALL_TAC] THEN SUBGOAL_THEN `!x y. abs(x - s) < d1 /\ abs(y - s) < d1 ==> abs(f(x) - f(y)) < e` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e) ==> abs(x - y) < e`) THEN EXISTS_TAC `(f:real->real) s` THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN SUBGOAL_THEN `!x. abs(x - s) < d1 ==> abs(f x - f s) < e / &2` (fun th -> ASM_MESON_TAC[th]) THEN X_GEN_TAC `u:real` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:real = s` THENL [ASM_SIMP_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN ASM_MESON_TAC[REAL_ARITH `&0 < abs(x - s) <=> ~(x = s)`]; ALL_TAC] THEN SUBGOAL_THEN `s - d1 / &2 < s` MP_TAC THENL [ASM_REWRITE_TAC[REAL_ARITH `x - y < x <=> &0 < y`]; ALL_TAC] THEN DISCH_THEN(fun th -> FIRST_ASSUM(fun th' -> MP_TAC(GEN_REWRITE_RULE I [th'] th))) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d2:real`; `d1 / &2`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s + d / &2` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_ARITH `s < s + d <=> &0 < d`] THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN ASM_CASES_TAC `x <= r /\ y <= r` THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN MATCH_MP_TAC(ASSUME `!x y. abs(x - s) < d1 /\ abs(y - s) < d1 ==> abs(f x - f y) < e`) THEN MATCH_MP_TAC(REAL_ARITH `!r t d d12. ~(x <= r /\ y <= r) /\ abs(x - y) < d /\ s - d12 < r /\ t <= s + d /\ x <= t /\ y <= t /\ &2 * d12 <= e /\ &2 * d < e ==> abs(x - s) < e /\ abs(y - s) < e`) THEN MAP_EVERY EXISTS_TAC [`r:real`; `s + d / &2`; `d:real`; `d1 / &2`] THEN ASM_REWRITE_TAC[REAL_LE_LADD] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> d <= d * &2`; REAL_LE_REFL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN ASSUME_TAC)) THEN SUBGOAL_THEN `b <= t` (fun th -> ASM_MESON_TAC[REAL_LE_TRANS; th]) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN UNDISCH_THEN `!x. a <= x /\ x <= b ==> f contl x` (K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o check(is_eq o concl) o SPEC `s:real`) THEN REWRITE_TAC[REAL_LT_REFL] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN EXISTS_TAC `t:real` THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]);; (* ------------------------------------------------------------------------- *) (* Slightly stronger version exploiting 2-sided continuity at ends. *) (* ------------------------------------------------------------------------- *) let CONT_UNIFORM_STRONG = prove (`!f a b. (!x. a <= x /\ x <= b ==> f contl x) ==> !e. &0 < e ==> ?d. &0 < d /\ !x y. (a <= x /\ x <= b \/ a <= y /\ y <= b) /\ abs(x - y) < d ==> abs(f(x) - f(y)) < e`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_01]] THEN FIRST_ASSUM(fun th -> MP_TAC(SPEC `a:real` th) THEN MP_TAC(SPEC `b:real` th)) THEN REWRITE_TAC[CONTL; REAL_LE_REFL] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_UNIFORM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d3:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d0:real`; `d3:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [ASM_CASES_TAC `y <= b` THENL [ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e) ==> abs(x - y) < e`) THEN EXISTS_TAC `(f:real->real) b` THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH `x <= b /\ ~(y <= b) /\ abs(x - y) < d /\ d < d1 ==> abs(x - b) < d1 /\ abs(y - b) < d1`]; ASM_CASES_TAC `a <= x` THENL [ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e) ==> abs(x - y) < e`) THEN EXISTS_TAC `(f:real->real) a` THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH `~(a <= x) /\ a <= y /\ abs(x - y) < d /\ d < d1 ==> abs(x - a) < d1 /\ abs(y - a) < d1`]]);; (* ------------------------------------------------------------------------- *) (* Get rid of special syntax status of '-->'. *) (* ------------------------------------------------------------------------- *) remove_interface "-->";; hol-light/Library/binary.ml000066400000000000000000000203101303454263000161630ustar00rootroot00000000000000(* ========================================================================= *) (* Binary expansions as a bijection between numbers and finite sets. *) (* ========================================================================= *) let BINARY_INDUCT = prove (`!P. P 0 /\ (!n. P n ==> P(2 * n) /\ P(2 * n + 1)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN GEN_TAC THEN STRIP_ASSUME_TAC(ARITH_RULE `n = 0 \/ n DIV 2 < n /\ (n = 2 * n DIV 2 \/ n = 2 * n DIV 2 + 1)`) THEN ASM_MESON_TAC[]);; let BOUNDED_FINITE = prove (`!s. (!x:num. x IN s ==> x <= n) ==> FINITE s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN ASM_SIMP_TAC[SUBSET; IN_NUMSEG; FINITE_NUMSEG; LE_0]);; let EVEN_NSUM = prove (`!s. FINITE s /\ (!i. i IN s ==> EVEN(f i)) ==> EVEN(nsum s f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[NSUM_CLAUSES; ARITH; EVEN_ADD; IN_INSERT]);; (* ------------------------------------------------------------------------- *) (* The basic bijections. *) (* ------------------------------------------------------------------------- *) let bitset = new_definition `bitset n = {i | ODD(n DIV (2 EXP i))}`;; let binarysum = new_definition `binarysum s = nsum s (\i. 2 EXP i)`;; (* ------------------------------------------------------------------------- *) (* Inverse property in one direction. *) (* ------------------------------------------------------------------------- *) let BITSET_BOUND_LEMMA = prove (`!n i. i IN (bitset n) ==> 2 EXP i <= n`, REWRITE_TAC[bitset; IN_ELIM_THM] THEN MESON_TAC[DIV_LT; ODD; NOT_LE]);; let BITSET_BOUND_WEAK = prove (`!n i. i IN (bitset n) ==> i < n`, MESON_TAC[BITSET_BOUND_LEMMA; LT_POW2_REFL; LTE_TRANS]);; let FINITE_BITSET = prove (`!n. FINITE(bitset n)`, GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; SUBSET] THEN MESON_TAC[LT_IMP_LE; BITSET_BOUND_WEAK]);; let BITSET_0 = prove (`bitset 0 = {}`, REWRITE_TAC[bitset; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN SIMP_TAC[DIV_0; EXP_EQ_0; ARITH]);; let BITSET_STEP = prove (`(!n. bitset(2 * n) = IMAGE SUC (bitset n)) /\ (!n. bitset(2 * n + 1) = 0 INSERT (IMAGE SUC (bitset n)))`, MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ALL_TAC; DISCH_THEN(fun th -> REWRITE_TAC[GSYM th])] THEN REWRITE_TAC[bitset; EXTENSION; IN_INSERT; IN_ELIM_THM; IN_IMAGE] THEN GEN_TAC THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH; ODD_MULT; DIV_1; NOT_SUC; ODD_ADD] THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[SUC_INJ; UNWIND_THM1; EXP] THEN SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL DIV_DIV); MULT_EQ_0; EXP_EQ_0; ARITH] THEN REWRITE_TAC[ARITH_RULE `(2 * n + 1) DIV 2 = n /\ (2 * n) DIV 2 = n`]);; let BINARYSUM_BITSET = prove (`!n. binarysum (bitset n) = n`, CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[binarysum] THEN MATCH_MP_TAC BINARY_INDUCT THEN REWRITE_TAC[BITSET_0; NSUM_CLAUSES] THEN SIMP_TAC[BITSET_STEP; NSUM_IMAGE; SUC_INJ; ADD1; FINITE_BITSET; ARITH; NSUM_CLAUSES; FINITE_IMAGE; IN_IMAGE; ARITH_RULE `~(0 = x + 1)`] THEN REWRITE_TAC[o_DEF; EXP; NSUM_LMUL] THEN ASM_MESON_TAC[ADD_SYM; ARITH_RULE `~(2 * m = 0) ==> m < 2 * m`; ARITH_RULE `m < SUC(2 * m)`]);; let BITSET_EQ = prove (`!m n. bitset m = bitset n <=> m = n`, MESON_TAC[BINARYSUM_BITSET]);; let BITSET_EQ_EMPTY = prove (`!n. bitset n = {} <=> n = 0`, MESON_TAC[BITSET_EQ; BITSET_0]);; (* ------------------------------------------------------------------------- *) (* Inverse property in the other direction. *) (* ------------------------------------------------------------------------- *) let BINARYSUM_BOUND_LEMMA = prove (`!k s. (!i. i IN s ==> i < k) ==> nsum s (\i. 2 EXP i) < 2 EXP k`, INDUCT_TAC THEN SIMP_TAC[LT; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY; NSUM_CLAUSES; ARITH] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `FINITE(s:num->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[BOUNDED_FINITE; LE_LT]; ALL_TAC] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `nsum (k INSERT (s DELETE k)) (\i. 2 EXP i)` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_SUBSET THEN SIMP_TAC[FINITE_INSERT; FINITE_DELETE]; ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN REWRITE_TAC[EXP; ARITH_RULE `a + b < 2 * a <=> b < a `] THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN ASM SET_TAC[]);; let BINARYSUM_DIV_DIVISIBLE = prove (`!s k. FINITE s /\ (!i. i IN s ==> k <= i) ==> nsum s (\i. 2 EXP i) = 2 EXP k * nsum s (\i. 2 EXP (i - k))`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES; DIV_0; EXP_EQ_0; ARITH_EQ; MULT_CLAUSES] THEN SIMP_TAC[IN_INSERT; ADD_ASSOC; EQ_ADD_RCANCEL; LEFT_ADD_DISTRIB] THEN SIMP_TAC[GSYM EXP_ADD; ARITH_RULE `i <= k:num ==> i + k - i = k`]);; let BINARYSUM_DIV = prove (`!k s. FINITE s ==> (nsum s (\j. 2 EXP j)) DIV (2 EXP k) = nsum s (\j. if j < k then 0 else 2 EXP (j - k))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(nsum {i | i < k /\ i IN s} (\j. 2 EXP j) + nsum {i | k <= i /\ i IN s} (\j. 2 EXP j)) DIV (2 EXP k)` THEN CONJ_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC NSUM_UNION_EQ THEN ASM_SIMP_TAC[EXTENSION; IN_INTER; IN_UNION; IN_ELIM_THM; NOT_IN_EMPTY] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `nsum {i | i < k /\ i IN s} (\j. 2 EXP j)` THEN SIMP_TAC[BINARYSUM_BOUND_LEMMA; IN_ELIM_THM] THEN REWRITE_TAC[ARITH_RULE `a + x:num = y + a <=> x = y`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `2 EXP k * nsum {i | k <= i /\ i IN s} (\i. 2 EXP (i - k))` THEN CONJ_TAC THENL [MATCH_MP_TAC BINARYSUM_DIV_DIVISIBLE THEN SIMP_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:num->bool` THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; ARITH_EQ] THEN ONCE_REWRITE_TAC[GSYM NSUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_ADD; EXP_EQ_0; ARITH; IN_ELIM_THM] THEN REWRITE_TAC[ARITH_RULE `(if p then 0 else q) = 0 <=> ~p ==> q = 0`] THEN REWRITE_TAC[EXP_EQ_0; ARITH; NOT_LT; CONJ_ACI] THEN MATCH_MP_TAC NSUM_EQ THEN SIMP_TAC[IN_ELIM_THM; ARITH_RULE `k <= j:num ==> ~(j < k)`]);; let BITSET_BINARYSUM = prove (`!s. FINITE s ==> bitset (binarysum s) = s`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[bitset; binarysum; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `i:num` THEN ASM_SIMP_TAC[BINARYSUM_DIV] THEN ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[] THENL [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `i IN s ==> s = i INSERT (s DELETE i)`)) THEN ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN REWRITE_TAC[LT_REFL; SUB_REFL; ARITH; ODD_ADD]; ALL_TAC] THEN REWRITE_TAC[NOT_ODD] THEN MATCH_MP_TAC EVEN_NSUM THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[ARITH; EVEN_EXP; SUB_EQ_0] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[LE_LT]);; (* ------------------------------------------------------------------------- *) (* Also, bijections between restricted segments. *) (* ------------------------------------------------------------------------- *) let BINARYSUM_BOUND = prove (`!k s. (!i. i IN s ==> i < k) ==> binarysum s < 2 EXP k`, REWRITE_TAC[BINARYSUM_BOUND_LEMMA; binarysum]);; let BITSET_BOUND = prove (`!n i k. n < 2 EXP k /\ i IN bitset n ==> i < k`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `2 EXP i < 2 EXP k` MP_TAC THENL [ASM_MESON_TAC[BITSET_BOUND_LEMMA; LET_TRANS]; REWRITE_TAC[LT_EXP; ARITH]]);; let BITSET_BOUND_EQ = prove (`!n k. n < 2 EXP k <=> (!i. i IN bitset n ==> i < k)`, MESON_TAC[BINARYSUM_BOUND; BITSET_BOUND; BINARYSUM_BITSET]);; let BINARYSUM_BOUND_EQ = prove (`!s k. FINITE s ==> (binarysum s < 2 EXP k <=> (!i. i IN s ==> i < k))`, MESON_TAC[BINARYSUM_BOUND; BITSET_BOUND; BITSET_BINARYSUM]);; hol-light/Library/binomial.ml000066400000000000000000000354361303454263000165100ustar00rootroot00000000000000(* ========================================================================= *) (* Binomial coefficients and the binomial theorem. *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* Binomial coefficients. *) (* ------------------------------------------------------------------------- *) let binom = define `(!n. binom(n,0) = 1) /\ (!k. binom(0,SUC(k)) = 0) /\ (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; let BINOM_0 = prove (`!n. binom(0,n) = if n = 0 then 1 else 0`, INDUCT_TAC THEN REWRITE_TAC[binom; NOT_SUC]);; let BINOM_LT = prove (`!n k. n < k ==> (binom(n,k) = 0)`, INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; let BINOM_REFL = prove (`!n. binom(n,n) = 1`, INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; let BINOM_1 = prove (`!n. binom(n,1) = n`, REWRITE_TAC[num_CONV `1`] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[binom] THEN ARITH_TAC);; let BINOM_FACT = prove (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; let BINOM_EQ_0 = prove (`!n k. binom(n,k) = 0 <=> n < k`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[BINOM_LT]] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT; LE_EXISTS] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN DISCH_TAC THEN MP_TAC(SYM(SPECL [`d:num`; `k:num`] BINOM_FACT)) THEN ASM_REWRITE_TAC[GSYM LT_NZ; MULT_CLAUSES; FACT_LT]);; let BINOM_PENULT = prove (`!n. binom(SUC n,n) = SUC n`, INDUCT_TAC THEN ASM_REWRITE_TAC [binom; ONE; BINOM_REFL] THEN SUBGOAL_THEN `binom(n,SUC n)=0` SUBST1_TAC THENL [REWRITE_TAC [BINOM_EQ_0; LT]; REWRITE_TAC [ADD; ADD_0; ADD_SUC; SUC_INJ]]);; let BINOM_GE_TOP = prove (`!m n. 1 <= m /\ m < n ==> n <= binom(n,m)`, INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom] THEN CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN ASM_CASES_TAC `m = 0` THEN ASM_SIMP_TAC[BINOM_1; ARITH_SUC; binom] THEN REWRITE_TAC[ADD1; LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `~(c = 0) ==> n <= b ==> n + 1 <= c + b`) THEN REWRITE_TAC[BINOM_EQ_0] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* More potentially useful lemmas. *) (* ------------------------------------------------------------------------- *) let BINOM_TOP_STEP = prove (`!n k. ((n + 1) - k) * binom(n + 1,k) = (n + 1) * binom(n,k)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n < k:num` THENL [FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `n < k ==> n + 1 = k \/ n + 1 < k`)) THEN ASM_SIMP_TAC[BINOM_LT; SUB_REFL; MULT_CLAUSES]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_LT; LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM ADD_ASSOC; ADD_SUB; ADD_SUB2] THEN MP_TAC(SPECL [`d + 1`; `k:num`] BINOM_FACT) THEN MP_TAC(SPECL [`d:num`; `k:num`] BINOM_FACT) THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; FACT; ADD_AC] THEN MAP_EVERY (fun t -> MP_TAC(SPEC t FACT_LT)) [`d:num`; `k:num`] THEN REWRITE_TAC[LT_NZ] THEN CONV_TAC NUM_RING);; let BINOM_BOTTOM_STEP = prove (`!n k. (k + 1) * binom(n,k + 1) = (n - k) * binom(n,k)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n < k + 1` THENL [FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `n < k + 1 ==> n = k \/ n < k`)) THEN ASM_SIMP_TAC[BINOM_LT; SUB_REFL; MULT_CLAUSES]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_LT; LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM ADD_ASSOC; ADD_SUB; ADD_SUB2] THEN MP_TAC(SPECL [`d + 1`; `k:num`] BINOM_FACT) THEN MP_TAC(SPECL [`d:num`; `k + 1`] BINOM_FACT) THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; FACT; ADD_AC] THEN MAP_EVERY (fun t -> MP_TAC(SPEC t FACT_LT)) [`d:num`; `k:num`] THEN REWRITE_TAC[LT_NZ] THEN CONV_TAC NUM_RING);; (* ------------------------------------------------------------------------- *) (* Binomial expansion. *) (* ------------------------------------------------------------------------- *) let BINOMIAL_THEOREM = prove (`!n x y. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k))`, INDUCT_TAC THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[EXP] THEN REWRITE_TAC[NSUM_SING_NUMSEG; binom; SUB_REFL; EXP; MULT_CLAUSES] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; NSUM_OFFSET] THEN ASM_REWRITE_TAC[EXP; binom; GSYM ADD1; GSYM NSUM_LMUL] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; NSUM_ADD_NUMSEG; MULT_CLAUSES; SUB_0] THEN MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN CONJ_TAC THENL [REWRITE_TAC[MULT_AC; SUB_SUC]; REWRITE_TAC[GSYM EXP]] THEN SIMP_TAC[ADD1; SYM(REWRITE_CONV[NSUM_OFFSET]`nsum(m+1..n+1) (\i. f i)`)] THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0] THEN SIMP_TAC[BINOM_LT; LT; MULT_CLAUSES; ADD_CLAUSES; SUB_0; EXP; binom] THEN SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; EXP] THEN REWRITE_TAC[MULT_AC]);; (* ------------------------------------------------------------------------- *) (* Same thing for the reals. *) (* ------------------------------------------------------------------------- *) prioritize_real();; let REAL_BINOMIAL_THEOREM = prove (`!n x y. (x + y) pow n = sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k))`, INDUCT_TAC THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[real_pow] THEN REWRITE_TAC[SUM_SING_NUMSEG; binom; SUB_REFL; real_pow; REAL_MUL_LID] THEN SIMP_TAC[SUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; SUM_OFFSET] THEN ASM_REWRITE_TAC[real_pow; binom; GSYM ADD1; GSYM SUM_LMUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG; REAL_MUL_LID; SUB_0] THEN MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN CONJ_TAC THENL [SIMP_TAC[REAL_MUL_AC; SUB_SUC]; SIMP_TAC[GSYM real_pow]] THEN SIMP_TAC[ADD1; SYM(REWRITE_CONV[SUM_OFFSET]`sum(m+1..n+1) (\i. f i)`)] THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; BINOM_LT; LT; REAL_MUL_LID; SUB_0; real_pow; binom; REAL_MUL_LZERO; REAL_ADD_RID] THEN SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; real_pow] THEN REWRITE_TAC[REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* More direct stepping theorems over the reals. *) (* ------------------------------------------------------------------------- *) let BINOM_TOP_STEP_REAL = prove (`!n k. &(binom(n + 1,k)) = if k = n + 1 then &1 else (&n + &1) / (&n + &1 - &k) * &(binom(n,k))`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[BINOM_REFL] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE `~(k = n + 1) ==> n < k /\ n + 1 < k \/ k <= n /\ k <= n + 1`)) THEN ASM_SIMP_TAC[BINOM_LT; REAL_MUL_RZERO] THEN MP_TAC(SPECL [`n:num`; `k:num`] BINOM_TOP_STEP) THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUB] THEN UNDISCH_TAC `k <= n:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD);; let BINOM_BOTTOM_STEP_REAL = prove (`!n k. &(binom(n,k+1)) = (&n - &k) / (&k + &1) * &(binom(n,k))`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n:num < k \/ k <= n`) THENL [ASM_SIMP_TAC[BINOM_LT; ARITH_RULE `n < k ==> n < k + 1`; REAL_MUL_RZERO]; MP_TAC(SPECL [`n:num`; `k:num`] BINOM_BOTTOM_STEP) THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUB] THEN CONV_TAC REAL_FIELD]);; let REAL_OF_NUM_BINOM = prove (`!n k. &(binom(n,k)) = if k <= n then &(FACT n) / (&(FACT(n - k)) * &(FACT k)) else &0`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[BINOM_LT; GSYM NOT_LE] THEN SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; FACT_LT] THEN FIRST_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[ADD_SUB2] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM BINOM_FACT] THEN REWRITE_TAC[REAL_OF_NUM_MUL; MULT_AC]);; (* ------------------------------------------------------------------------- *) (* Some additional theorems for stepping both arguments together. *) (* ------------------------------------------------------------------------- *) let BINOM_BOTH_STEP_REAL = prove (`!p k. &(binom(p + 1,k + 1)) = (&p + &1) / (&k + &1) * &(binom(p,k))`, REWRITE_TAC[BINOM_TOP_STEP_REAL; BINOM_BOTTOM_STEP_REAL] THEN REPEAT GEN_TAC THEN REWRITE_TAC[EQ_ADD_RCANCEL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[BINOM_REFL] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD);; let BINOM_BOTH_STEP = prove (`!p k. (k + 1) * binom(p + 1,k + 1) = (p + 1) * binom(p,k)`, REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[BINOM_BOTH_STEP_REAL; GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD);; let BINOM_BOTH_STEP_DOWN = prove (`!p k. (k = 0 ==> p = 0) ==> k * binom(p,k) = p * binom(p - 1,k - 1)`, REPEAT INDUCT_TAC THEN SIMP_TAC[BINOM_LT; LT_0; LT_REFL; ARITH] THEN REWRITE_TAC[SUC_SUB1; ADD1; BINOM_BOTH_STEP] THEN REWRITE_TAC[MULT_CLAUSES]);; let BINOM = prove (`!n k. binom(n,k) = if k <= n then FACT(n) DIV (FACT(n - k) * FACT(k)) else 0`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[BINOM_EQ_0; GSYM NOT_LE] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN SIMP_TAC[LT_MULT; FACT_LT; ADD_CLAUSES] THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM BINOM_FACT; ADD_SUB] THEN REWRITE_TAC[MULT_AC]);; (* ------------------------------------------------------------------------- *) (* Additional lemmas. *) (* ------------------------------------------------------------------------- *) let BINOM_SYM = prove (`!n k. binom(n,n-k) = if k <= n then binom(n,k) else 1`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[binom; ARITH_RULE `~(k <= n) ==> n - k = 0`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ; REAL_OF_NUM_BINOM] THEN ASM_REWRITE_TAC[ARITH_RULE `n - k:num <= n`] THEN ASM_SIMP_TAC[ARITH_RULE `k:num <= n ==> n - (n - k) = k`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; MULT_SYM]);; let BINOM_MUL_SHIFT = prove (`!m n k. k <= m ==> binom(n,m) * binom(m,k) = binom(n,k) * binom(n - k,m - k)`, REPEAT STRIP_TAC THEN SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; REAL_OF_NUM_BINOM] THEN ASM_CASES_TAC `n:num < m` THENL [REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]) THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC; REPEAT(COND_CASES_TAC THENL [ALL_TAC; MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN ASM_SIMP_TAC[ARITH_RULE `k:num <= m /\ m <= n ==> n - k - (m - k) = n - m`] THEN MAP_EVERY (MP_TAC o C SPEC FACT_NZ) [`n:num`; `m:num`; `n - m:num`; `n - k:num`; `m - k:num`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD]);; let APPELL_SEQUENCE = prove (`!c n x y. sum (0..n) (\k. &(binom(n,k)) * sum(0..k) (\l. &(binom(k,l)) * c l * x pow (k - l)) * y pow (n - k)) = sum (0..n) (\k. &(binom(n,k)) * c k * (x + y) pow (n - k))`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_BINOMIAL_THEOREM] THEN REWRITE_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL] THEN SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN EXISTS_TAC `(\(x,y). y,x - y):num#num->num#num` THEN EXISTS_TAC `(\(x,y). x + y,x):num#num->num#num` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ; IN_NUMSEG] THEN CONJ_TAC THENL [ARITH_TAC; REPEAT GEN_TAC THEN STRIP_TAC] THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[ARITH_RULE `j:num <= k /\ k <= n ==> (n - j) - (k - j) = n - k`] THEN MATCH_MP_TAC(REAL_RING `c * d:real = a * b ==> a * z * b * x * y = c * (d * z * x) * y`) THEN ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; BINOM_MUL_SHIFT]);; (* ------------------------------------------------------------------------- *) (* Numerical computation of binom. *) (* ------------------------------------------------------------------------- *) let NUM_BINOM_CONV = let pth_step = prove (`binom(n,k) = y ==> k <= n ==> (SUC n) * y = ((n + 1) - k) * x ==> binom(SUC n,k) = x`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD1; GSYM BINOM_TOP_STEP; EQ_MULT_LCANCEL; SUB_EQ_0] THEN ARITH_TAC) and pth_0 = prove (`n < k ==> binom(n,k) = 0`, REWRITE_TAC[BINOM_LT]) and pth_1 = prove (`binom(n,n) = 1`, REWRITE_TAC[BINOM_REFL]) and pth_swap = prove (`k <= n ==> binom(n,k) = binom(n,n - k)`, MESON_TAC[BINOM_SYM]) and k_tm = `k:num` and n_tm = `n:num` and x_tm = `x:num` and y_tm = `y:num` and binom_tm = `binom` in let rec BINOM_RULE(n,k) = if n let bop,nkp = dest_comb tm in if bop <> binom_tm then failwith "NUM_BINOM_CONV" else let nt,kt = dest_pair nkp in BINOM_RULE(dest_numeral nt,dest_numeral kt);; hol-light/Library/calc_real.ml000066400000000000000000003171571303454263000166260ustar00rootroot00000000000000(* ========================================================================= *) (* Calculation with real numbers (Boehm-style but by inference). *) (* ========================================================================= *) needs "Library/transc.ml";; let REAL_SUB_SUM0 = prove (`!x y m. sum(0,m) x - sum(0,m) y = sum(0,m) (\i. x i - y i)`, CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[sum] THEN REAL_ARITH_TAC);; let REAL_MUL_RSUM0 = prove (`!m c x. c * sum(0,m) x = sum(0,m) (\i. c * x(i))`, INDUCT_TAC THEN ASM_REWRITE_TAC[sum; REAL_MUL_RZERO; REAL_ADD_LDISTRIB]);; let REAL_ABS_LEMMA = prove (`!a b n. (&a pow n) * abs b = abs((&a pow n) * b)`, REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM]);; let REAL_ABS_LEMMA1 = prove (`!a b. &a * abs b = abs(&a * b)`, REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM]);; let REAL_ABS_TRIANGLE_LEMMA = prove (`!u x y z. abs(x - y) + abs(z - x) < u ==> abs(z - y) < u`, REAL_ARITH_TAC);; let REAL_MONO_POW2 = prove (`!m n. m <= n ==> &2 pow m <= &2 pow n`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_LE_REFL] THEN POP_ASSUM MP_TAC THEN MP_TAC(SPEC `m:num` REAL_LT_POW2) THEN REAL_ARITH_TAC);; let REAL_LE_SUC_POW2 = prove (`!m. &2 pow m + &1 <= &2 pow (SUC m)`, GEN_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_2; REAL_LE_LADD; REAL_LE_POW2]);; let REAL_OPPSIGN_LEMMA = prove (`!x y. (x * y < &0) <=> (x < &0 /\ &0 < y) \/ (&0 < x /\ y < &0)`, REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `y:real` REAL_LT_NEGTOTAL) THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP REAL_LT_MUL th) THEN MP_TAC th) THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN REAL_ARITH_TAC);; let REAL_OPPSIGN = prove (`(&0 < x ==> &0 <= y) /\ (x < &0 ==> y <= &0) <=> &0 <= x * y`, REWRITE_TAC[GSYM REAL_NOT_LT; REAL_OPPSIGN_LEMMA] THEN REAL_ARITH_TAC);; let REAL_NDIV_LEMMA1a = prove (`!a m n. &2 * abs(&2 pow m * &a - &2 pow (m + n)) <= &2 pow m ==> (&a = &2 pow n)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_POW_ADD; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_OF_NUM_POW] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`a:num`; `2 EXP n`] LT_CASES) THEN ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN POP_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LT_EXISTS]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ARITH `((a + b) - a = b) /\ (a - (a + b) = --b)`] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_NOT_LE; REAL_ABS_NUM] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_MUL_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_RID; REAL_ADD_ASSOC; REAL_LT_ADDL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&(2 EXP m)` THEN REWRITE_TAC[REAL_LT_POW2; GSYM REAL_OF_NUM_POW] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + c = b + (a + c)`] THEN REWRITE_TAC[GSYM REAL_MUL_2; REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]);; let REAL_NDIV_LEMMA1b = prove (`!a m n. ~(&2 * abs(-- (&2 pow m * &a) - &2 pow (m + n)) <= &2 pow m)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM REAL_NEG_ADD] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_POW_ADD] THEN REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ADD_LDISTRIB] THEN SUBGOAL_THEN `&0 <= &a + &2 pow n` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_POS]; REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN ASM_REWRITE_TAC[real_abs; REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(&2 * &2 pow m) * &1` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_RID; REAL_MUL_2] THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_POW2]; REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_POS]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow n` THEN REWRITE_TAC[REAL_LE_POW2; REAL_LE_ADDL; REAL_POS]]]]);; let REAL_NDIV_LEMMA2 = prove (`!a b m n. (?k. (b = &k) \/ (b = --(&k))) /\ (abs(a) = &2 pow m) /\ &2 * abs(a * b - &2 pow (m + n)) <= abs(a) ==> (a * b = &2 pow (m + n))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISJ_CASES_THEN SUBST1_TAC (REAL_ARITH `(a = abs a) \/ (a = --(abs a))`) THEN ASM_REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW; REAL_ABS_NUM; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_NDIV_LEMMA1b] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_NDIV_LEMMA1a) THEN REWRITE_TAC[REAL_POW_ADD]);; let REAL_NDIV_LEMMA3 = prove (`!a b m n. m <= n /\ (?k. (b = &k) \/ (b = --(&k))) /\ (abs(a) = &2 pow m) /\ &2 * abs(a * b - &2 pow n) <= abs(a) ==> (a * b = &2 pow n)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[REAL_NDIV_LEMMA2]);; (* ------------------------------------------------------------------------- *) (* Surely there is already an efficient way to do this... *) (* ------------------------------------------------------------------------- *) let log2 = (*** least p >= 0 with x <= 2^p ***) let rec log2 x y = if x log2 (x -/ Int 1) (Int 0);; (* ------------------------------------------------------------------------- *) (* Theorems justifying the steps. *) (* ------------------------------------------------------------------------- *) let REALCALC_DOWNGRADE = prove (`(SUC d0 = d) ==> (n + d = n0) ==> abs(a - &2 pow n0 * x) < &1 ==> abs((&2 pow d) * b - a) <= &2 pow d0 ==> abs(b - &2 pow n * x) < &1`, DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow (SUC d0)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ABS_LEMMA; REAL_MUL_RID; REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow d0 + &2 pow d0` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_ABS_TRIANGLE_LEMMA THEN EXISTS_TAC `a:real` THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`d0:num`,`d0:num`) THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 + &1` THEN REWRITE_TAC[REAL_MUL_2] THEN CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[real_pow; GSYM REAL_MUL_2; REAL_LE_REFL]]]);; let REALCALC_INT = prove (`abs((&2 pow n) * a - (&2 pow n) * a) < &1`, REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0; REAL_LT_01]);; let REALCALC_NEG = prove (`abs(a - (&2 pow n) * x) < &1 ==> abs(--a - (&2 pow n) * --x) < &1`, REWRITE_TAC[real_sub; GSYM REAL_NEG_ADD] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_MUL_RNEG]);; let REALCALC_ABS = prove (`abs(a - &2 pow n * x) < &1 ==> abs(abs(a) - &2 pow n * abs(x)) < &1`, DISCH_TAC THEN REWRITE_TAC[REAL_ABS_LEMMA] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(a - (&2 pow n) * x)` THEN ASM_REWRITE_TAC[REAL_ABS_SUB_ABS]);; let REALCALC_INV_LEMMA = prove (`(?m. (b = &m) \/ (b = --(&m))) /\ (?m. (a = &m) \/ (a = --(&m))) /\ SUC(n + k) <= (2 * e) /\ &2 pow e <= abs(a) /\ abs(a - &2 pow k * x) < &1 /\ &2 * abs(a * b - &2 pow (n + k)) <= abs(a) ==> abs(b - &2 pow n * inv(x)) < &1`, let lemma1 = REAL_ARITH `!x y z b. &2 * abs(x - y) <= b /\ &2 * abs(y - z) < b ==> &2 * abs(x - z) < &2 * b` in let lemma2 = REAL_ARITH `!x y z. x + &1 <= abs(z) /\ abs(z - y) < &1 ==> x <= abs(y)` in let lemma3 = REAL_ARITH `(abs(x) <= &1 /\ &0 < abs(y) /\ abs(y) < &1) /\ (&0 < x ==> &0 <= y) /\ (x < &0 ==> y <= &0) ==> abs(x - y) < &1` in let lemma4 = REAL_ARITH `!a b c. c <= abs(a) + abs(b) /\ abs(a - b) < c ==> (&0 < a ==> &0 <= b) /\ (a < &0 ==> b <= &0)` in DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN SUBGOAL_THEN `~(a = &0)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&2 pow e <= abs(&0)` THEN REWRITE_TAC[REAL_ABS_0; GSYM REAL_NOT_LT; REAL_LT_POW2]; ALL_TAC] THEN SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `abs(a - &2 pow k * &0) < &1` THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow e` THEN ASM_REWRITE_TAC[REAL_LE_POW2]; ALL_TAC] THEN SUBGOAL_THEN `(&2 pow e + &1 <= abs(a)) \/ (&2 pow e = abs(a))` MP_TAC THENL [REWRITE_TAC[REAL_OF_NUM_POW] THEN FIRST_ASSUM(CHOOSE_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_ABS_NEG; REAL_ABS_NUM]) THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_EQ] THEN REWRITE_TAC[GSYM ADD1; LE_SUC_LT; GSYM LE_LT] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW]; UNDISCH_TAC `&2 pow e <= abs(a)` THEN DISCH_THEN(K ALL_TAC)] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 * abs(a)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN MATCH_MP_TAC lemma1 THEN EXISTS_TAC `&2 pow (n + k)` THEN ASM_REWRITE_TAC[]] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * abs(&2 pow n) * &1` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_POW_EQ_0] THEN CONV_TAC(RAND_CONV(LAND_CONV REAL_INT_EQ_CONV)) THEN REWRITE_TAC[]; REWRITE_TAC[REAL_SUB_RDISTRIB] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN ASM_REWRITE_TAC[REAL_MUL_LID]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2 pow k` THEN REWRITE_TAC[REAL_LT_POW2; REAL_MUL_RID; REAL_ABS_LEMMA] THEN ONCE_REWRITE_TAC [AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow e * &2 pow e` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC [AC REAL_MUL_AC `(a * b) * c = c * b * a`] THEN REWRITE_TAC[GSYM REAL_POW_ADD; GSYM(CONJUNCT2 real_pow)] THEN MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[GSYM MULT_2]; MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; REWRITE_TAC[REAL_ABS_LEMMA] THEN MATCH_MP_TAC lemma2 THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow e + &1` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]; DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`e:num`; `n + k:num`] LET_CASES) THENL [SUBGOAL_THEN `a * b = &2 pow (n + k)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_NDIV_LEMMA3 THEN EXISTS_TAC `e:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(a)` THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; GSYM REAL_ABS_MUL] THEN ASM_REWRITE_TAC[REAL_SUB_LDISTRIB] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * a * c`] THEN REWRITE_TAC[REAL_POW_ADD; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x = &0)`)] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow n * &1` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[REAL_LT_POW2; REAL_MUL_RID]; MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `&2 pow (SUC k)` THEN REWRITE_TAC[REAL_MUL_RID; REAL_LT_POW2]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow (2 * e)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_POW_ADD; ADD_CLAUSES] THEN MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[]; SUBST1_TAC(SYM(ASSUME `&2 pow e = abs(a)`)) THEN REWRITE_TAC[MULT_2; REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE (SPEC_ALL REAL_LT_POW2)]] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_pow] THEN SUBGOAL_THEN `?d. e = SUC d` (CHOOSE_THEN SUBST_ALL_TAC) THENL [UNDISCH_TAC `SUC (n + k) <= (2 * e)` THEN SPEC_TAC(`e:num`,`e:num`) THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LE; NOT_SUC] THEN REWRITE_TAC[SUC_INJ; GSYM EXISTS_REFL]; REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow (SUC d) - &1` THEN REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_SUB_LADD] THEN REWRITE_TAC[REAL_LE_SUC_POW2] THEN SUBGOAL_THEN `abs(abs a - &2 pow k * abs(x)) < &1` MP_TAC THENL [REWRITE_TAC[REAL_ABS_LEMMA] THEN MATCH_MP_TAC(REAL_LET_IMP REAL_ABS_SUB_ABS) THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]; SUBGOAL_THEN `abs(b) <= &1 /\ &0 <= a * b` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[REAL_ABS_0; REAL_MUL_RZERO; REAL_POS] THEN SUBGOAL_THEN `abs(a) <= abs(a * b)` ASSUME_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN SUBGOAL_THEN `?q. abs(b) = &q` CHOOSE_TAC THENL [UNDISCH_TAC `?m. (b = &m) \/ (b = --(&m))` THEN DISCH_THEN(X_CHOOSE_THEN `p:num` DISJ_CASES_TAC) THEN EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM]; UNDISCH_TAC `~(b = &0)` THEN ASM_REWRITE_TAC[REAL_ABS_NZ] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN REWRITE_TAC[SYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN REWRITE_TAC[LE_SUC_LT]]; ALL_TAC] THEN SUBGOAL_THEN `abs(a * b) <= abs(a) /\ &0 <= a * b` ASSUME_TAC THENL [MP_TAC(SPEC `(n:num) + k` REAL_LT_POW2) THEN UNDISCH_TAC `&2 * abs(a * b - &2 pow (n + k)) <= abs a` THEN UNDISCH_TAC `abs(a) <= abs(a * b)` THEN SUBGOAL_THEN `~(a * b = &0)` MP_TAC THENL [ASM_REWRITE_TAC[REAL_ENTIRE]; ALL_TAC] THEN SUBGOAL_THEN `&2 * &2 pow (n + k) <= abs(a)` MP_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[LE_SUC_LT]; REAL_ARITH_TAC]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(a)` THEN ASM_REWRITE_TAC [GSYM REAL_ABS_NZ; GSYM REAL_ABS_MUL; REAL_MUL_RID]]; ALL_TAC] THEN MATCH_MP_TAC lemma3 THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_ENTIRE; REAL_INV_EQ_0] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN REWRITE_TAC[REAL_LT_POW2]; MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; GSYM REAL_ABS_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * c * a`] THEN SUBGOAL_THEN `inv(x) * x = &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow k` THEN REWRITE_TAC[REAL_LT_POW2; REAL_ABS_LEMMA] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 pow (SUC(n + k)) - &1` THEN REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LE_SUB_LADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_LE_SUC_POW2; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 pow e` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[LE_SUC_LT]; UNDISCH_TAC `abs(a - &2 pow k * x) < &1` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]]; SUBGOAL_THEN `&0 <= b * (&2 pow n * inv x)` MP_TAC THENL [MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `a * a` THEN ASM_REWRITE_TAC[REAL_LT_SQUARE] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c * d = (a * c) * (b * d)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `x * x` THEN ASM_REWRITE_TAC[REAL_LT_SQUARE] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c * d * e = d * (e * a) * c * b`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE (SPEC_ALL REAL_LT_POW2)] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [MATCH_MP REAL_MUL_LINV th]) THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2 pow k` THEN REWRITE_TAC[REAL_LT_POW2; REAL_MUL_RZERO; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * (a * c)`] THEN ONCE_REWRITE_TAC[GSYM REAL_OPPSIGN] THEN MATCH_MP_TAC lemma4 THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(a)` THEN CONJ_TAC THENL [UNDISCH_TAC `?m. (a = &m) \/ (a = -- (&m))` THEN DISCH_THEN(CHOOSE_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN ASM_REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN REWRITE_TAC[SYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN REWRITE_TAC[LE_SUC_LT] THEN RULE_ASSUM_TAC (REWRITE_RULE[REAL_ARITH `(--x = &0) = (x = &0)`]) THEN UNDISCH_TAC `~(&m = &0)` THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LT; LE]; REWRITE_TAC[REAL_LE_ADDR; REAL_ABS_POS]]; REWRITE_TAC[REAL_OPPSIGN]]]]]);; let REALCALC_INV = prove (`abs(a - &2 pow k * x) < &1 ==> (?m. (a = &m) \/ (a = --(&m))) ==> (?m. (b = &m) \/ (b = --(&m))) ==> SUC(n + k) <= (2 * e) ==> &2 pow e <= abs(a) ==> &2 * abs(a * b - &2 pow (n + k)) <= abs(a) ==> abs(b - &2 pow n * inv(x)) < &1`, REPEAT DISCH_TAC THEN MATCH_MP_TAC REALCALC_INV_LEMMA THEN ASM_REWRITE_TAC[]);; let REALCALC_ADD = prove (`(n + 2 = n') ==> abs(a - &2 pow n' * x) < &1 ==> abs(b - &2 pow n' * y) < &1 ==> abs(&4 * c - (a + b)) <= &2 ==> abs(c - &2 pow n * (x + y)) < &1`, DISCH_THEN(SUBST_ALL_TAC o SYM) THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow 2` THEN CONV_TAC(LAND_CONV REAL_INT_REDUCE_CONV) THEN REWRITE_TAC[REAL_ABS_LEMMA; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN SUBST1_TAC(REAL_INT_REDUCE_CONV `&2 pow 2`) THEN MATCH_MP_TAC REAL_ABS_TRIANGLE_LEMMA THEN EXISTS_TAC `a + b` THEN GEN_REWRITE_TAC RAND_CONV [SYM(REAL_INT_REDUCE_CONV `&2 + &2`)] THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC [REAL_ARITH `(x + y) - a * (u + v) = (x - a * u) + (y - a * v)`] THEN GEN_REWRITE_TAC RAND_CONV [SYM(REAL_INT_REDUCE_CONV `&1 + &1`)] THEN MATCH_MP_TAC(REAL_LET_IMP REAL_ABS_TRIANGLE) THEN MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]);; let REALCALC_MUL = prove (`abs(a - &2 pow k * x) < &1 ==> abs(b - &2 pow l * y) < &1 ==> (n + m = k + l) ==> &2 * (abs(a) + abs(b) + &1) <= &2 pow m ==> &2 * abs(&2 pow m * c - a * b) <= &2 pow m ==> abs(c - &2 pow n * (x * y)) < &1`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow m` THEN REWRITE_TAC[REAL_LT_POW2; REAL_ABS_LEMMA; REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2` THEN CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[REAL_MUL_RID] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_2] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 * abs(&2 pow m * c - a * b) + &2 * abs(a * b - &2 pow m * &2 pow n * x * y)` THEN CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_ADD2 THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_POW_ADD] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `((a * b) * c) * d = (a * c) * (b * d)`] THEN SUBGOAL_THEN `?d. abs(d) < &1 /\ (&2 pow k * x = a + d)` MP_TAC THENL [EXISTS_TAC `&2 pow k * x - a` THEN UNDISCH_TAC `abs(a - &2 pow k * x) < &1` THEN REAL_ARITH_TAC; DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))] THEN SUBGOAL_THEN `?e. abs(e) < &1 /\ (&2 pow l * y = b + e)` MP_TAC THENL [EXISTS_TAC `&2 pow l * y - b` THEN UNDISCH_TAC `abs(b - &2 pow l * y) < &1` THEN REAL_ARITH_TAC; DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * (abs(a) * &1 + abs(b) * &1 + &1 * &1)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_LMUL THEN CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(a) * abs(e) + abs(b) * abs(d) + abs(d) * abs(e)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]]]]; ASM_REWRITE_TAC[REAL_MUL_RID]]);; (* ------------------------------------------------------------------------- *) (* Square root. *) (* ------------------------------------------------------------------------- *) let REALCALC_SQRT = prove (`abs(a - &2 pow n * x) < &1 ==> &1 <= x ==> abs(b pow 2 - &2 pow n * a) <= b ==> abs(b - &2 pow n * sqrt(x)) < &1`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(b + &2 pow n * sqrt(x))` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `!z. abs(z) <= b /\ &0 < c ==> &0 < abs(b + c)`) THEN EXISTS_TAC `b pow 2 - &2 pow n * a` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_LT_MUL; SQRT_POS_LT; REAL_ARITH `&1 <= x ==> &0 < x`]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a + b) * (a - b) = a * a - b * b`] THEN MATCH_MP_TAC(REAL_ARITH `!c d. abs(b - c) <= d /\ abs(c - a) < e - d ==> abs(b - a) < e`) THEN MAP_EVERY EXISTS_TAC [`&2 pow n * a`; `b:real`] THEN ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN REWRITE_TAC[REAL_POW_2; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH `a < c ==> a < abs(b + c) - b`) THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LT_LMUL THEN SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; GSYM POW_2; SQRT_POW_2; REAL_ARITH `&1 <= x ==> &0 <= x`] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `&1 <= x ==> &0 <= x`)) THEN UNDISCH_TAC `&1 <= x` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `x = sqrt(x) pow 2` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[SQRT_POW2]; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[POW_2] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_SIMP_TAC[SQRT_POS_LE]]);; (* ------------------------------------------------------------------------- *) (* Lemmas common to all the Taylor series error analyses. *) (* ------------------------------------------------------------------------- *) let STEP_LEMMA1 = prove (`!a b c d x y. abs(a - c) <= x /\ abs(b - d) <= y ==> abs(a * b - c * d) <= abs(c) * y + abs(d) * x + x * y`, REPEAT GEN_TAC THEN ABBREV_TAC `u = a - c` THEN ABBREV_TAC `v = b - d` THEN SUBGOAL_THEN `a = c + u` SUBST1_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `b = d + v` SUBST1_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN SUBST1_TAC (REAL_ARITH `(c + u) * (d + v) - c * d = c * v + d * u + u * v`) THEN REPEAT(MATCH_MP_TAC (REAL_LE_IMP REAL_ABS_TRIANGLE) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THEN REWRITE_TAC[REAL_ABS_MUL] THENL [MATCH_MP_TAC REAL_LE_LMUL; MATCH_MP_TAC REAL_LE_LMUL; MATCH_MP_TAC REAL_LE_MUL2] THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; let STEP_LEMMA2 = prove (`!n s t u x y k l a d. &0 < a /\ &0 < d /\ abs(s - &2 pow n * x) <= k /\ abs(t - &2 pow n * y) <= l /\ &2 * abs(u * &2 pow n * d - a * s * t) <= &2 pow n * d ==> abs(u - &2 pow n * (a / d) * (x * y)) <= (a / d) * (abs(x) + k / (&2 pow n)) * l + ((a / d) * k * abs(y) + &1 / &2)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP STEP_LEMMA1) ASSUME_TAC) THEN SUBGOAL_THEN `&0 < &2 * &2 pow n * d` ASSUME_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN ASM_REWRITE_TAC[REAL_LT_POW2] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2 * &2 pow n * d` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN SUBGOAL_THEN `!z. (&2 * &2 pow n * d) * abs(z) = abs((&2 * &2 pow n * d) * z)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < &2 * &2 pow n * d` THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN (MATCH_MP_TAC o GEN_ALL o REAL_ARITH) `abs(a - b) + abs(b - c) <= d ==> abs(a - c) <= d` THEN EXISTS_TAC `&2 * a * s * t` THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_ADD_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN SUBGOAL_THEN `(inv(&2) * &2 = &1) /\ (inv(&2 pow n) * &2 pow n = &1) /\ (inv(d) * d = &1)` STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_POW_EQ_0] THEN UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ABS_LEMMA1] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC]; REWRITE_TAC(map (GSYM o SPEC `&2`) [REAL_SUB_LDISTRIB; REAL_ADD_LDISTRIB]) THEN REWRITE_TAC[GSYM REAL_ABS_LEMMA1] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [AC REAL_MUL_AC `a * b * c * d * e * f * g = d * (a * f) * (c * g) * (e * b)`] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [AC REAL_MUL_AC `a * b * c * d * e * f = c * (a * e) * f * (d * b)`] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [AC REAL_MUL_AC `a * b * c * d * e * f * g = c * (e * g) * (f * a) * (d * b)`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [AC REAL_MUL_AC `a * b * c * d * e * f = c * (a * f) * e * (d * b)`] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_ADD_AC `(a + b) + c = a + c + b`] THEN ASM_REWRITE_TAC[REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[REAL_ABS_MUL] THEN SUBGOAL_THEN `abs(a) = a` SUBST1_TAC THENL [UNDISCH_TAC `&0 < a` THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_ABS_LEMMA] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Now specific instances. *) (* ------------------------------------------------------------------------- *) let STEP_EXP = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) <= &1 /\ abs(t - &2 pow n * (x pow i / &(FACT i))) <= k /\ &2 * abs(u * &2 pow n * &(SUC i) - s * t) <= &2 pow n * &(SUC i) ==> abs(u - &2 pow n * (x pow (SUC i)) / &(FACT(SUC i))) <= (&2 / &(SUC i)) * k + &1 / &(FACT(SUC i)) + &1 / &2`, STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; `x:real`; `x pow i / &(FACT i)`; `&1`; `k:real`; `&1`; `&(SUC i)`] STEP_LEMMA2) THEN ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN REWRITE_TAC[REAL_OF_NUM_LT; LT_0] THEN REWRITE_TAC[FACT; real_div; GSYM REAL_OF_NUM_MUL; real_pow] THEN REWRITE_TAC[REAL_MUL_LID; REAL_INV_MUL] THEN MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_AC]; REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_OF_NUM_LE; LE_0]; MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &1 + &1`] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_LE_POW2]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(t - &2 pow n * (x pow i / &(FACT i)))` THEN ASM_REWRITE_TAC[REAL_ABS_POS]]; REWRITE_TAC[REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]; MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(a) <= a`) THEN MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_OF_NUM_LE; LE_0]]]]]);; let STEP_SIN = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * --(x pow 2)) <= &1 /\ abs(t - &2 pow n * x pow (2 * i + 1) / &(FACT (2 * i + 1))) <= &1 /\ &2 * abs(u * &2 pow n * &(2 * i + 2) * &(2 * i + 3) - s * t) <= &2 pow n * &(2 * i + 2) * &(2 * i + 3) ==> abs(u - &2 pow n * --(x pow (2 * (SUC i) + 1)) / &(FACT (2 * (SUC i) + 1))) <= &1`, STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; `--(x pow 2)`; `x pow (2 * i + 1) / &(FACT(2 * i + 1))`; `&1`; `&1`; `&1`; `&(2 * i + 2) * &(2 * i + 3)`] STEP_LEMMA2) THEN ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 (fst o dest_imp) o snd) THENL [REWRITE_TAC(map num_CONV [`3`; `2`; `1`]) THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; LT_0]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `2 * (SUC i) + 1 = SUC(SUC(2 * i + 1))` SUBST1_TAC THENL [GEN_REWRITE_TAC I [GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; REWRITE_TAC[real_pow; FACT] THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC] THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_AC]]; GEN_REWRITE_TAC RAND_CONV [SYM(REAL_RAT_REDUCE_CONV `&1 / &3 + &1 / &6 + &1 / &2`)] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN SUBGOAL_THEN `&1 / (&(2 * i + 2) * &(2 * i + 3)) <= &1 / &6` ASSUME_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `&6 = &2 * &3`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MATCH_MP_TAC LE_MULT2 THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]; ALL_TAC] THEN REWRITE_TAC[SYM(REAL_RAT_REDUCE_CONV `&1 / &6 * &2`)] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_POS]; MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_MUL_RID; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; REWRITE_TAC[REAL_MUL_RID]] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &1 + &1`] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]; REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_LE_POW2]]; REWRITE_TAC[real_div; REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]; REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE; FACT_LE]]]]);; let STEP_COS = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * --(x pow 2)) <= &1 /\ abs(t - &2 pow n * x pow (2 * i) / &(FACT (2 * i))) <= k /\ &2 * abs(u * &2 pow n * &(2 * i + 1) * &(2 * i + 2) - s * t) <= &2 pow n * &(2 * i + 1) * &(2 * i + 2) ==> abs(u - &2 pow n * --(x pow (2 * (SUC i))) / &(FACT (2 * (SUC i)))) <= (&2 * inv(&(2 * i + 1) * &(2 * i + 2))) * k + inv(&(FACT(2 * i + 2))) + &1 / &2`, STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; `--(x pow 2)`; `x pow (2 * i) / &(FACT(2 * i))`; `&1`; `k:real`; `&1`; `&(2 * i + 1) * &(2 * i + 2)`] STEP_LEMMA2) THEN ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 (fst o dest_imp) o snd) THENL [REWRITE_TAC(map num_CONV [`3`; `2`; `1`]) THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; LT_0]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `2 * (SUC i) = SUC(SUC(2 * i))` SUBST1_TAC THENL [GEN_REWRITE_TAC I [GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; REWRITE_TAC[real_pow; FACT] THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC] THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_AC]]; REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_POS]; GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &1 + &1`] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]; MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_LE_POW2]]]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(t - &2 pow n * x pow (2 * i) / &(FACT (2 * i)))` THEN ASM_REWRITE_TAC[REAL_ABS_POS]]; REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_MUL; REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c * d = (d * a * b) * c`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN REWRITE_TAC[REAL_POS; REAL_ABS_POS; REAL_LE_INV_EQ]; REWRITE_TAC[REAL_ABS_INV] THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; ADD_CLAUSES] THEN REWRITE_TAC[SYM(num_CONV `2`); SYM(num_CONV `1`)] THEN REWRITE_TAC[FACT; REAL_OF_NUM_MUL] THEN REWRITE_TAC[MULT_AC]; REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]]]]);; let STEP_LN = prove (`2 <= n /\ abs(x) <= &1 / &2 /\ abs(s - &2 pow n * --x) <= &1 /\ abs(t - &2 pow n * -- ((--x) pow (SUC i) / &(SUC i))) <= &3 /\ &2 * abs(u * &2 pow n * &(SUC(SUC i)) - &(SUC i) * s * t) <= &2 pow n * &(SUC(SUC i)) ==> abs(u - &2 pow n * -- ((--x) pow (SUC(SUC i)) / &(SUC(SUC i)))) <= &3`, STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; `--x`; `-- (--x pow (SUC i) / &(SUC i))`; `&1`; `&3`; `&(SUC i)`; `&(SUC(SUC i))`] STEP_LEMMA2) THEN ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN REWRITE_TAC[REAL_OF_NUM_LT; LT_0] THEN MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SUBGOAL_THEN `inv(&(SUC i)) * &(SUC i) = &1` ASSUME_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_AC]]; GEN_REWRITE_TAC RAND_CONV [SYM(REAL_RAT_REDUCE_CONV `(&1 / &2 + &1 / &4) * &3 + &1 / &4 + &1 / &2`)] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN CONV_TAC(RAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `&(SUC(SUC i))` THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_OF_NUM_LT; LT_0] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC(REAL_ARITH `(x = &1) ==> &0 <= x`) THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `&(SUC(SUC i))` THEN REWRITE_TAC[REAL_OF_NUM_LT; LT_0] THEN REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[REAL_OF_NUM_LE; LE] THEN MATCH_MP_TAC(REAL_ARITH `(x = &1) ==> &0 <= x /\ x <= &1`) THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[REAL_ABS_NEG] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN SUBST1_TAC(SYM(REAL_INT_REDUCE_CONV `&2 pow 2`)) THEN MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_NEG; REAL_ABS_INV] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_NUM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN SUBGOAL_THEN `inv(&(SUC i)) * &(SUC i) = &1` ASSUME_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; GEN_REWRITE_TAC RAND_CONV [EQT_ELIM(REAL_RAT_REDUCE_CONV `inv(&4) = inv(&2) * inv(&2)`)] THEN ASM_REWRITE_TAC[REAL_MUL_RID; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC [REAL_POS; REAL_ABS_POS; REAL_LE_INV_EQ; GSYM REAL_ABS_POW] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_POS] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN MP_TAC(SPEC `i:num` REAL_POS) THEN REAL_ARITH_TAC; REWRITE_TAC[real_pow; REAL_ABS_POW] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS] THEN REPEAT CONJ_TAC THENL [CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_ABS_POS]; MATCH_MP_TAC REAL_POW_1_LE THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &2` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]]]]]);; (* ------------------------------------------------------------------------- *) (* Expand the "!k. SUC k < r ==> P k" term for given numeral r. *) (* ------------------------------------------------------------------------- *) let EXPAND_RANGE_CONV = let pth0 = prove (`(!k. SUC k < 0 ==> P k) <=> T`, REWRITE_TAC[LT]) and pth1 = prove (`(!k. k < (SUC m) ==> P k) <=> (!k. k < m ==> P k) /\ P m`, REWRITE_TAC[LT] THEN MESON_TAC[]) and pth2 = prove (`(!k. k < 0 ==> P k) <=> T`, REWRITE_TAC[LT]) in let triv_conv = GEN_REWRITE_CONV I [pth0] and trivial_conv = GEN_REWRITE_CONV I [pth2] and nontrivial_conv = GEN_REWRITE_CONV I [pth1] in let s_tm = `s:real` and m_tm = `m:num` and n_tm = `n:num` in let rec expand_conv tm = try trivial_conv tm with Failure _ -> let mth = num_CONV(rand(lhand(body(rand tm)))) in let th1 = BINDER_CONV(LAND_CONV(RAND_CONV(K mth))) tm in let th2 = TRANS th1 (nontrivial_conv (rand(concl th1))) in let th3 = COMB2_CONV (RAND_CONV expand_conv) (SUBS_CONV[SYM mth]) (rand(concl th2)) in TRANS th2 th3 in let hack_conv = triv_conv ORELSEC (BINDER_CONV (LAND_CONV ((RAND_CONV num_CONV) THENC REWR_CONV LT_SUC)) THENC expand_conv) in hack_conv;; (* ------------------------------------------------------------------------- *) (* Lemmas leading to iterative versions. *) (* ------------------------------------------------------------------------- *) let STEP_EXP_THM = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ abs(t(i) - &2 pow n * (x pow i / &(FACT i))) <= k ==> &2 * abs(t(SUC i) * &2 pow n * &(SUC i) - s * t(i)) <= &2 pow n * &(SUC i) ==> abs(t(SUC i) - &2 pow n * (x pow (SUC i)) / &(FACT(SUC i))) <= (&2 / &(SUC i)) * k + &1 / &(FACT(SUC i)) + &1 / &2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(GEN_ALL STEP_EXP) THEN MAP_EVERY EXISTS_TAC [`s:real`; `t(i:num):real`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);; let STEP_EXP_RULE th = let th1 = MATCH_MP STEP_EXP_THM th in let th2 = UNDISCH(PURE_REWRITE_RULE[ARITH_SUC] th1) in let th3 = CONV_RULE(RAND_CONV(ONCE_DEPTH_CONV NUM_FACT_CONV)) th2 in let th4 = CONV_RULE(RAND_CONV REAL_RAT_REDUCE_CONV) th3 in let th5 = ASSUME(find is_conj (hyp th)) in let th6a,th6b = (I F_F CONJUNCT1) (CONJ_PAIR th5) in CONJ th6a (CONJ th6b th4);; let STEP_EXP_0 = (UNDISCH o prove) (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) ==> abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ abs(t(0) - &2 pow n * (x pow 0 / &(FACT 0))) <= &0`, STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_pow; FACT; real_div; REAL_INV_1; REAL_MUL_RID] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0; REAL_LE_REFL]);; let STEP_EXP_1 = STEP_EXP_RULE STEP_EXP_0;; (* e(1) = 3/2 *) let STEP_EXP_2 = STEP_EXP_RULE STEP_EXP_1;; (* e(2) = 5/2 *) let STEP_EXP_3 = STEP_EXP_RULE STEP_EXP_2;; (* e(3) = 7/3 *) let STEP_EXP_4 = STEP_EXP_RULE STEP_EXP_3;; (* e(4) = 41/24 *) let STEP_EXP_5 = STEP_EXP_RULE STEP_EXP_4;; (* e(5) = 143/120 *) let STEP_EXP_4_PLUS = prove (`4 <= m /\ abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) /\ (!k. SUC k < SUC m ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) ==> abs(t m - &2 pow n * x pow m / &(FACT m)) <= &2`, let lemma = prove (`(!k. k < (SUC m) ==> P k) <=> (!k. k < m ==> P k) /\ P m`, REWRITE_TAC[LT] THEN MESON_TAC[]) in DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[LT_SUC] THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[ADD_CLAUSES] THEN SUBST1_TAC(TOP_DEPTH_CONV num_CONV `4`) THEN REWRITE_TAC[lemma] THEN REWRITE_TAC[ARITH_SUC] THEN REWRITE_TAC[LT] THEN STRIP_TAC THEN MP_TAC (DISCH_ALL STEP_EXP_4) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `b <= c ==> a <= b ==> a <= c`) THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[ADD_CLAUSES; lemma] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &(SUC(4 + d)) * &2 + &1 / &(FACT(SUC(4 + d))) + &1 / &2` THEN CONJ_TAC THENL [MATCH_MP_TAC(GEN_ALL STEP_EXP) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `s:real` THEN EXISTS_TAC `t(4 + d):real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; GEN_REWRITE_TAC RAND_CONV [SYM(REAL_RAT_REDUCE_CONV `&3 / &2 + &1 / &2`)] THEN REWRITE_TAC[REAL_LE_RADD; REAL_ADD_ASSOC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 / &5 + &1 / &120` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `&2 * &2 = &4`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ARITH `&0 <= &4`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN MP_TAC(SPEC `d':num` REAL_POS) THEN REAL_ARITH_TAC; REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN SUBST1_TAC(SYM(NUM_FACT_CONV `FACT 5`)) THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC FACT_MONO THEN REWRITE_TAC[num_CONV `5`; LE_SUC; LE_ADD]]]]);; let STEPS_EXP_0 = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) /\ (!k. SUC k < 0 ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) ==> abs(sum(0,0) t - &2 pow n * sum(0,0) (\i. x pow i / &(FACT i))) <= &2 * &0`, STRIP_TAC THEN ASM_REWRITE_TAC[sum] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ABS_0; REAL_SUB_REFL; REAL_LE_REFL]);; let STEPS_EXP_1 = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) /\ (!k. SUC k < 1 ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) ==> abs(sum(0,1) t - &2 pow n * sum(0,1)(\i. x pow i / &(FACT i))) <= &2 * &1`, CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]);; let STEPS_EXP_2 = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) /\ (!k. SUC k < 2 ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) ==> abs(sum(0,2) t - &2 pow n * sum(0,2) (\i. x pow i / &(FACT i))) <= &2 * &2`, CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_ARITH `(a + b) - (c + d) = (a - c) + (b - d)`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0 + &3 / &2` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]; MP_TAC (DISCH_ALL STEP_EXP_1) THEN ASM_REWRITE_TAC[ADD_CLAUSES]]);; let STEPS_EXP_3 = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) /\ (!k. SUC k < 3 ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) ==> abs(sum(0,3) t - &2 pow n * sum(0,3) (\i. x pow i / &(FACT i))) <= &2 * &3`, CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_ARITH `(a + b) - (c + d) = (a - c) + (b - d)`] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0 + &3 / &2 + &5 / &2` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN REPEAT (MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THENL [MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]; MP_TAC (DISCH_ALL STEP_EXP_1) THEN ASM_REWRITE_TAC[ADD_CLAUSES]; MP_TAC (DISCH_ALL STEP_EXP_2) THEN ASM_REWRITE_TAC[ADD_CLAUSES]]);; let STEPS_EXP_4 = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) /\ (!k. SUC k < 4 ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) ==> abs(sum(0,4) t - &2 pow n * sum(0,4) (\i. x pow i / &(FACT i))) <= &2 * &4`, CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_ARITH `(a + b) - (c + d) = (a - c) + (b - d)`] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0 + &3 / &2 + &5 / &2 + &7 / &3` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN REPEAT (MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THENL [MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]; MP_TAC (DISCH_ALL STEP_EXP_1) THEN ASM_REWRITE_TAC[ADD_CLAUSES]; MP_TAC (DISCH_ALL STEP_EXP_2) THEN ASM_REWRITE_TAC[ADD_CLAUSES]; MP_TAC (DISCH_ALL STEP_EXP_3) THEN ASM_REWRITE_TAC[ADD_CLAUSES]]);; (* ------------------------------------------------------------------------- *) (* Iterated versions. *) (* ------------------------------------------------------------------------- *) let STEPS_EXP_LEMMA = prove (`(!k. P(SUC k) ==> P(k)) /\ (P(0) ==> (abs(sum(0,0) z) <= &2 * &0)) /\ (P(1) ==> (abs(sum(0,1) z) <= &2 * &1)) /\ (P(2) ==> (abs(sum(0,2) z) <= &2 * &2)) /\ (P(3) ==> (abs(sum(0,3) z) <= &2 * &3)) /\ (P(4) ==> (abs(sum(0,4) z) <= &2 * &4)) /\ (!m. 4 <= m /\ P(SUC m) ==> (abs(z m) <= &2)) ==> !m. P(m) ==> (abs(sum(0,m) z) <= &2 * &m)`, STRIP_TAC THEN SUBGOAL_THEN `!d. P(d + 4) ==> abs(sum(0,d + 4) z) <= &2 * &(d + 4)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN REWRITE_TAC[sum; ADD1] THEN ONCE_REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_RID] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]]; GEN_TAC THEN DISJ_CASES_THEN MP_TAC (SPECL [`4`; `m:num`] LE_CASES) THENL [DISCH_THEN(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]; SUBST1_TAC(TOP_DEPTH_CONV num_CONV `4`) THEN REWRITE_TAC[LE] THEN REWRITE_TAC[ARITH_SUC] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC[]]]);; let STEPS_EXP = prove (`abs(x) <= &1 /\ abs(s - &2 pow n * x) < &1 /\ (t(0) = &2 pow n) /\ (!k. SUC k < m ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) <= &2 pow n * &(SUC k)) ==> abs(sum(0,m) t - &2 pow n * sum(0,m) (\i. x pow i / &(FACT i))) <= &2 * &m`, REWRITE_TAC[REAL_MUL_RSUM0; REAL_SUB_SUM0] THEN SPEC_TAC(`m:num`,`m:num`) THEN MATCH_MP_TAC STEPS_EXP_LEMMA THEN REWRITE_TAC[GSYM REAL_SUB_SUM0; GSYM REAL_MUL_RSUM0] THEN REWRITE_TAC[STEPS_EXP_0; STEPS_EXP_1; STEPS_EXP_2; STEPS_EXP_3] THEN REWRITE_TAC[STEPS_EXP_4; STEP_EXP_4_PLUS] THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LT]);; let STEPS_LN = prove (`2 <= n /\ abs(x) <= &1 / &2 /\ abs(s - &2 pow n * --x) < &1 /\ (t(0) = --s) /\ (!k. SUC k < m ==> &2 * abs(t(SUC k) * &2 pow n * &(SUC(SUC k)) - &(SUC k) * s * t(k)) <= &2 pow n * &(SUC(SUC k))) ==> abs(sum(0,m) t - &2 pow n * sum(0,m) (\i. (--(&1)) pow i * x pow (SUC i) / &(SUC i))) <= &3 * &m`, REWRITE_TAC[REAL_MUL_RSUM0; REAL_SUB_SUM0] THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC (REAL_LE_IMP SUM_ABS_LE) THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN INDUCT_TAC THENL [REWRITE_TAC[real_pow; ARITH; REAL_DIV_1; REAL_MUL_LID; REAL_MUL_RID] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `-- a - b * c = --(a - b * --c)`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN ASM_SIMP_TAC[REAL_ABS_NEG; REAL_LT_IMP_LE; REAL_OF_NUM_LE; ARITH]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN SUBGOAL_THEN `p:num < m` (ANTE_RES_THEN MP_TAC) THENL [UNDISCH_TAC `SUC p < m` THEN ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `!y. abs(x - y) + abs(y - z) <= e ==> abs(x - z) <= e`) THEN EXISTS_TAC `&(SUC p) * s * t p / (&2 pow n * &(SUC(SUC p)))` THEN ONCE_REWRITE_TAC [SYM(REAL_RAT_REDUCE_CONV `&1 / &2 + &5 / &2`)] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `&2 pow n * &(SUC(SUC p))` THEN SUBGOAL_THEN `&0 < &2 pow n * &(SUC(SUC p))` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; LT_0; ARITH]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!x y. &0 < y ==> (abs(x) * y = abs(x * y))` (fun th -> ASM_SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2` THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LID] THEN REWRITE_TAC[REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN `!a b c d. &0 < a ==> ((b * c * d / a) * a = b * c * d)` (fun th -> ASM_SIMP_TAC[th]) THEN SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID; REAL_LT_IMP_NZ]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!y. abs(x - y) + abs(y - z) <= e ==> abs(x - z) <= e`) THEN EXISTS_TAC `--(&1) pow p * s * x pow (SUC p) / &(SUC(SUC p))` THEN ONCE_REWRITE_TAC [SYM(REAL_RAT_REDUCE_CONV `&9 / &4 + &1 / &4`)] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [SUBGOAL_THEN `--(&1) pow p * s * x pow (SUC p) / &(SUC(SUC p)) = &(SUC p) * s * (&2 pow n * --(&1) pow p * x pow SUC p / &(SUC p)) / (&2 pow n * &(SUC (SUC p)))` SUBST1_TAC THENL [REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e * f * g * h = d * b * e * h * (g * c) * (f * a)`] THEN SIMP_TAC[REAL_MUL_LINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH; NOT_SUC] THEN REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (a * b * d) * c`] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o REDEPTH_CONV) [GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs (&(SUC p) * s * inv (&2 pow n * &(SUC (SUC p)))) * &3` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_INV; REAL_ABS_POW] THEN REWRITE_TAC[REAL_INV_MUL] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e = (d * a) * (b * c) * e`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1) * &3 / &4 * &3` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; REAL_POW_LE; REAL_ABS_POS] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&(SUC(SUC p))` THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_OF_NUM_EQ; NOT_SUC] THEN REWRITE_TAC[REAL_INV_1; REAL_MUL_LID; REAL_MUL_RID] THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `&2 pow n` THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_MUL_LINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_MUL_RID] THEN MATCH_MP_TAC(REAL_ARITH `!y. abs(x - y) < &1 /\ abs(y) <= d - &1 ==> abs(x) <= d`) THEN EXISTS_TAC `&2 pow n * --x` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `inv(&2 pow n)` THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NEG; REAL_ABS_POW; REAL_ABS_NUM] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &2` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_MUL_RINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID] THEN REWRITE_TAC[REAL_LE_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_LE_SUB_LADD] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN SUBST1_TAC(SYM(REAL_INT_REDUCE_CONV `&2 pow 2`)) THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; ARITH]]; ALL_TAC] THEN SUBGOAL_THEN `--(&1) pow p * s * x pow (SUC p) / &(SUC(SUC p)) - &2 pow n * --(&1) pow (SUC p) * x pow (SUC(SUC p)) / &(SUC(SUC p)) = (--(&1) pow p * x pow (SUC p) / &(SUC(SUC p))) * (s - &2 pow n * --x)` SUBST1_TAC THENL [REWRITE_TAC[real_pow; real_div; GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_MUL_LID] THEN REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_AC]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs (-- (&1) pow p * x pow SUC p / &(SUC (SUC p))) * &1` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_MUL_RID; real_div; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NEG; REAL_ABS_NUM; REAL_ABS_INV] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2) pow 1 * inv(&2)` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; REAL_POW_LE; REAL_LE_INV_EQ; LE_0; REAL_OF_NUM_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2) pow (SUC p)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_ABS_POS]; REWRITE_TAC[REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN ARITH_TAC]; MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH; REAL_OF_NUM_LE] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Special version of Taylor series for exponential in limited range. *) (* ------------------------------------------------------------------------- *) let MCLAURIN_EXP_LE1 = prove (`!x n. abs(x) <= &1 ==> ?t. abs(t) <= &1 /\ (exp(x) = sum(0,n) (\m. x pow m / &(FACT m)) + (exp(t) / &(FACT n)) * x pow n)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `n:num`] MCLAURIN_EXP_LE) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[]);; let REAL_EXP_15 = prove (`exp(&1) < &5`, SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2) + inv(&2)`)) THEN REWRITE_TAC[REAL_EXP_ADD] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(&1 + &2 * inv(&2)) * (&1 + &2 * inv(&2))` THEN CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN MATCH_MP_TAC REAL_EXP_BOUND_LEMMA THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let TAYLOR_EXP_WEAK = prove (`abs(x) <= &1 ==> abs(exp(x) - sum(0,m) (\i. x pow i / &(FACT i))) < &5 * inv(&(FACT m))`, DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `m:num` o MATCH_MP MCLAURIN_EXP_LE1) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `abs((x + y) - x) = abs(y)`] THEN REWRITE_TAC[real_div; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[] THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[real_pow; FACT; ABS_N; REAL_INV_1; REAL_MUL_RID] THEN ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `exp(&1)` THEN REWRITE_TAC[REAL_EXP_15] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; REWRITE_TAC[POW_0; REAL_ABS_0; REAL_MUL_RZERO] THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_OF_NUM_LT; FACT_LT]]; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&5 * abs(inv(&(FACT m))) * abs(x pow m)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(exp(&1))` THEN ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE; REAL_EXP_MONO_LE; REAL_EXP_15] THEN UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM ABS_NZ; REAL_POW_EQ_0] THEN REWRITE_TAC[REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN MP_TAC(SPEC `m:num` FACT_LT) THEN ARITH_TAC]; MATCH_MP_TAC REAL_LE_LMUL_IMP THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_INV; ABS_N; REAL_LE_REFL] THEN REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]]]);; let REAL_EXP_13 = prove (`exp(&1) < &3`, MP_TAC(INST [`&1`,`x:real`; `5`,`m:num`] TAYLOR_EXP_WEAK) THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[ADD_CLAUSES] THEN CONV_TAC(ONCE_DEPTH_CONV NUM_FACT_CONV) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `b + e <= c ==> abs(a - b) < e ==> a < c`) THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let TAYLOR_EXP = prove (`abs(x) <= &1 ==> abs(exp(x) - sum(0,m) (\i. x pow i / &(FACT i))) < &3 * inv(&(FACT m))`, DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `m:num` o MATCH_MP MCLAURIN_EXP_LE1) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `abs((x + y) - x) = abs(y)`] THEN REWRITE_TAC[real_div; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[] THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[real_pow; FACT; ABS_N; REAL_INV_1; REAL_MUL_RID] THEN ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `exp(&1)` THEN REWRITE_TAC[REAL_EXP_13] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; REWRITE_TAC[POW_0; REAL_ABS_0; REAL_MUL_RZERO] THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_OF_NUM_LT; FACT_LT]]; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&3 * abs(inv(&(FACT m))) * abs(x pow m)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(exp(&1))` THEN ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE; REAL_EXP_MONO_LE; REAL_EXP_13] THEN UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM ABS_NZ; REAL_POW_EQ_0] THEN REWRITE_TAC[REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN MP_TAC(SPEC `m:num` FACT_LT) THEN ARITH_TAC]; MATCH_MP_TAC REAL_LE_LMUL_IMP THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_INV; ABS_N; REAL_LE_REFL] THEN REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]]]);; let TAYLOR_LN = prove (`&0 <= x /\ x <= inv(&2 pow k) ==> abs(ln(&1 + x) - sum(0,m) (\i. --(&1) pow i * x pow SUC i / &(SUC i))) < inv(&2 pow (k * SUC m) * &(SUC m))`, let lemma = INST [`1`,`k:num`] (SYM(SPEC_ALL SUM_REINDEX)) in STRIP_TAC THEN UNDISCH_TAC `&0 <= x` THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THENL [ALL_TAC; REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; real_div] THEN REWRITE_TAC[SUM_0; REAL_ADD_RID; REAL_SUB_LZERO; LN_1] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_0] THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; LT_0; ARITH]] THEN SUBGOAL_THEN `!i. --(&1) pow i = --(&1) pow (SUC(SUC i))` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REWRITE_TAC[real_pow; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_MUL_LID]; ALL_TAC] THEN REWRITE_TAC[ADD1; lemma] THEN REWRITE_TAC[ADD_CLAUSES] THEN ONCE_REWRITE_TAC[SUM_DIFF] THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO] THEN REWRITE_TAC[GSYM ADD1] THEN MP_TAC(SPECL [`x:real`; `SUC m`] MCLAURIN_LN_POS) THEN ASM_REWRITE_TAC[LT_0] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ADD1] THEN REWRITE_TAC[GSYM real_div] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_ARITH `(a + b) - a = b`] THEN REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_POW] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_POW_ONE] THEN REWRITE_TAC[REAL_MUL_LID; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv (&2 pow (k * SUC m)) * inv (&(SUC m)) * inv(abs(&1 + t) pow SUC m)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; REAL_ABS_POS; REAL_POW_LE] THEN REWRITE_TAC[GSYM REAL_POW_INV] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[REAL_POW_INV; real_abs; REAL_LT_IMP_LE]; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0; REAL_POW_LT; ARITH] THEN REWRITE_TAC[GSYM REAL_POW_INV; GSYM REAL_ABS_INV] THEN SUBGOAL_THEN `abs(inv(&1 + t)) < &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_ABS_INV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LT_INV2 THEN UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC; SUBST1_TAC(SYM(SPEC `SUC m` REAL_POW_ONE)) THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[REAL_POW_ONE; NOT_SUC; REAL_ABS_POS]]]);; (* ------------------------------------------------------------------------- *) (* Leading from the summation to the actual function. *) (* ------------------------------------------------------------------------- *) let APPROX_LEMMA1 = prove (`abs(f(x:real) - sum(0,m) (\i. P i x)) < inv(&2 pow (n + 2)) /\ abs(u - &2 pow (n + e + 2) * sum(0,m) (\i. P i x)) <= &k * &m /\ &k * &m <= &2 pow e /\ abs(s * &2 pow (e + 2) - u) <= &2 pow (e + 1) ==> abs(s - &2 pow n * f(x)) < &1`, STRIP_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow (n + e + 2)` THEN REWRITE_TAC[REAL_LT_POW2] THEN REWRITE_TAC[REAL_ABS_LEMMA; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN (MATCH_MP_TAC o GEN_ALL) (REAL_ARITH `abs(a - b) + abs(b - c) < d ==> abs(a - c) < d`) THEN EXISTS_TAC `&2 pow n * u` THEN CONV_TAC(funpow 4 RAND_CONV num_CONV) THEN REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_2] THEN MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_POW_ADD] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[GSYM REAL_ABS_LEMMA] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_SUB_LDISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [REAL_POW_ADD] THEN REWRITE_TAC[GSYM REAL_ABS_LEMMA] THEN MATCH_MP_TAC REAL_LT_LMUL THEN REWRITE_TAC[REAL_LT_POW2] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN (MATCH_MP_TAC o GEN_ALL) (REAL_ARITH `abs(a - b) + abs(b - c) < d ==> abs(a - c) < d`) THEN EXISTS_TAC `&2 pow (n + e + 2) * sum(0,m) (\i. P i (x:real))` THEN GEN_REWRITE_TAC RAND_CONV [REAL_POW_ADD] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_POW_1; REAL_MUL_2] THEN MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&k * &m` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ABS_LEMMA] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_LMUL THEN REWRITE_TAC[REAL_LT_POW2] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `inv(&2 pow (n + 2))` THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN SUBGOAL_THEN `inv(&2 pow (n + 2)) * &2 pow (n + 2) = &1` (fun th -> ASM_REWRITE_TAC[th; REAL_MUL_LID]) THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_POW_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Approximation theorems. *) (* ------------------------------------------------------------------------- *) let APPROX_EXP = prove (`(n + e + 2 = p) /\ &3 * &2 pow (n + 2) <= &(FACT m) /\ &2 * &m <= &2 pow e /\ abs(x) <= &1 /\ abs(s - &2 pow p * x) < &1 /\ (t(0) = &2 pow p) /\ (!k. SUC k < m ==> &2 * abs(t(SUC k) * &2 pow p * &(SUC k) - s * t(k)) <= &2 pow p * &(SUC k)) /\ abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) ==> abs(u - &2 pow n * exp(x)) < &1`, STRIP_TAC THEN MATCH_MP_TAC(GEN_ALL APPROX_LEMMA1) THEN MAP_EVERY EXISTS_TAC [`\i x. x pow i / &(FACT i)`; `2`; `m:num`; `sum(0,m) t`; `e:num`] THEN ASM_REWRITE_TAC[BETA_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&3 * inv(&(FACT m))` THEN CONJ_TAC THENL [MATCH_MP_TAC TAYLOR_EXP THEN ASM_REWRITE_TAC[]; SUBST1_TAC(SYM(SPEC `&3` REAL_INV_INV)) THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&3` THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[MATCH_MP REAL_MUL_RINV (REAL_ARITH `~(&3 = &0)`)] THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN REAL_ARITH_TAC]; MATCH_MP_TAC STEPS_EXP THEN ASM_REWRITE_TAC[]]);; let APPROX_LN = prove (`~(k = 0) /\ (n + e + 2 = p) /\ &2 pow (n + 2) <= &2 pow (k * SUC m) * &(SUC m) /\ &3 * &m <= &2 pow e /\ (&0 <= x /\ x <= inv(&2 pow k)) /\ abs(s - &2 pow p * --x) < &1 /\ (t(0) = --s) /\ (!k. SUC k < m ==> &2 * abs(t(SUC k) * &2 pow p * &(SUC(SUC k)) - &(SUC k) * s * t(k)) <= &2 pow p * &(SUC(SUC k))) /\ abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) ==> abs(u - &2 pow n * ln(&1 + x)) < &1`, STRIP_TAC THEN (MATCH_MP_TAC o GEN_ALL o BETA_RULE) (INST [`\x. ln(&1 + x):real`,`f:real->real`] APPROX_LEMMA1) THEN MAP_EVERY EXISTS_TAC [`\i x. (--(&1)) pow i * x pow (SUC i) / &(SUC i)`; `3`; `m:num`; `sum(0,m) t`; `e:num`] THEN ASM_REWRITE_TAC[BETA_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&2 pow (k * SUC m) * &(SUC m))` THEN CONJ_TAC THENL [MATCH_MP_TAC TAYLOR_LN THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_POW2]]; MATCH_MP_TAC STEPS_LN THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `2 <= (n + e + 2)` MP_TAC THENL [REWRITE_TAC[ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]; SUBGOAL_THEN `abs(x) <= &1 / &2` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_POW_1] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Eliminate trivial definitions. *) (* ------------------------------------------------------------------------- *) let ELIMINATE_DEF = let x_tm = `x:num` and a_tm = `&0` and sconv = REWRITE_CONV[ARITH] in fun tdefs th -> if tdefs = [] then th else let ctm = itlist (fun tm acc -> let l,r = (rand F_F I) (dest_eq tm) in mk_cond(mk_eq(x_tm,l),r,acc)) tdefs a_tm in let atm = mk_abs(x_tm,ctm) in let ttm = rator(lhs(hd tdefs)) in let tth = ASSUME(mk_eq(ttm,atm)) in let ths = map (EQT_ELIM o CONV_RULE(RAND_CONV sconv) o SUBS_CONV[tth]) tdefs in let dth = PROVE_HYP (end_itlist CONJ ths) th in MP (INST [atm,ttm] (DISCH_ALL dth)) (REFL atm);; (* ------------------------------------------------------------------------- *) (* Overall conversion. *) (* ------------------------------------------------------------------------- *) let realcalc_cache = ref [];; let REALCALC_CONV,thm_eval,raw_eval,thm_wrap = let a_tm = `a:real` and n_tm = `n:num` and n'_tm = `n':num` and m_tm = `m:num` and b_tm = `b:real` and e_tm = `e:num` and c_tm = `c:real` and neg_tm = `(--)` and abs_tm = `abs` and inv_tm = `inv` and sqrt_tm = `sqrt` and add_tm = `(+)` and mul_tm = `(*)` and sub_tm = `(-)` and exp_tm = `exp:real->real` and ln_tm = `ln:real->real` and add1_tm = `(+) (&1)` and pow2_tm = `(pow) (&2)` and one_tm = `&1` and lt_tm = `(<)` in let INTEGER_PROVE = EQT_ELIM o REWRITE_CONV[REAL_EQ_NEG2; GSYM EXISTS_REFL; EXISTS_OR_THM; REAL_OF_NUM_EQ] in let ndiv x y = let q = quo_num x y in let r = x -/ (q */ y) in if le_num (abs_num(Int 2 */ r)) (abs_num y) then q else if le_num (abs_num(Int 2 */ (r -/ y))) (abs_num y) then q +/ Int 1 else if le_num (abs_num(Int 2 */ (r +/ y))) (abs_num y) then q -/ Int 1 else let s = (string_of_num x)^" and "^(string_of_num y) in failwith ("ndiv: "^s) in let raw_wrap (f:num->num) = (ref(Int(-1),Int 0),f) in let raw_eval(r,(f:num->num)) n = let (n0,y0) = !r in if le_num n n0 then ndiv y0 (power_num (Int 2) (n0 -/ n)) else let y = f n in (r := (n,y); y) in let thm_eval = let SUC_tm = `SUC` and mk_add = mk_binop `(+):num->num->num` in fun (r,(f:num->thm)) n -> let (n0,y0th) = !r in if le_num n n0 then if n =/ n0 then y0th else let th1 = NUM_SUC_CONV (mk_comb(SUC_tm,mk_numeral(n0 -/ (n +/ Int 1)))) in let th2 = MATCH_MP REALCALC_DOWNGRADE th1 in let th3 = NUM_ADD_CONV(mk_add(mk_numeral(n)) (mk_numeral(n0 -/ n))) in let th4 = MATCH_MP th2 th3 in let th5 = MATCH_MP th4 y0th in let tm5 = fst(dest_imp(concl th5)) in let tm5a,tm5b = dest_comb tm5 in let th6 = REAL_INT_POW_CONV tm5b in let tm5c = rand(rand tm5a) in let tm5d,tm5e = dest_comb tm5c in let tm5f,tm5g = dest_comb(rand tm5d) in let tm5h = rand(rand tm5f) in let bin = mk_realintconst (ndiv (dest_realintconst tm5e) (power_num (Int 2) (dest_numeral tm5h))) in let th7 = AP_TERM (rator(rand tm5f)) th1 in let th8 = GEN_REWRITE_RULE LAND_CONV [CONJUNCT2 real_pow] th7 in let th9 = SYM(GEN_REWRITE_RULE (LAND_CONV o RAND_CONV) [th6] th8) in let th10 = TRANS th9 (REAL_INT_MUL_CONV (rand(concl th9))) in let th11 = AP_THM (AP_TERM (rator tm5f) th10) bin in let th12 = TRANS th11 (REAL_INT_MUL_CONV (rand(concl th11))) in let th13 = AP_THM (AP_TERM (rator tm5d) th12) tm5e in let th14 = TRANS th13 (REAL_INT_SUB_CONV (rand(concl th13))) in let th15 = AP_TERM (rator(rand tm5a)) th14 in let th16 = TRANS th15 (REAL_INT_ABS_CONV (rand(concl th15))) in let th17 = MK_COMB(AP_TERM (rator tm5a) th16,th6) in let th18 = TRANS th17 (REAL_INT_LE_CONV (rand(concl th17))) in MATCH_MP th5 (EQT_ELIM th18) else let yth = f n in (r := (n,yth); yth) in let thm_wrap (f:num->thm) = (ref(Int(-1),TRUTH),f) in let find_msd = let rec find_msd n f = if Int 1 real` and n_tm = `n:num` and m_tm = `m:num` and e_tm = `e:num` and p_tm = `p:num` and s_tm = `s:real` and u_tm = `u:real` and x_tm = `x:real` in let rec calculate_m acc i r = if acc >=/ r then i else let i' = i +/ Int 1 in calculate_m (i' */ acc) i' r in let calculate_exp_sequence = let rec calculate_exp_sequence p2 s i = if i let p2 = power_num (Int 2) p in rev(calculate_exp_sequence p2 s (m -/ Int 1)) in let pth = prove (`abs(x) <= &1 ==> abs(s - &2 pow p * x) < &1 ==> (n + e + 2 = p) /\ &3 * &2 pow (n + 2) <= &(FACT m) /\ &2 * &m <= &2 pow e /\ (t(0) = &2 pow p) /\ (!k. SUC k < m ==> &2 * abs(t(SUC k) * &2 pow p * &(SUC k) - s * t(k)) <= &2 pow p * &(SUC k)) /\ abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) ==> abs(u - &2 pow n * exp(x)) < &1`, REPEAT STRIP_TAC THEN MATCH_MP_TAC APPROX_EXP THEN ASM_REWRITE_TAC[]) in let LEFT_ZERO_RULE = ONCE_REWRITE_RULE[prove(`0 + n = n`,REWRITE_TAC[ADD_CLAUSES])] in fun (fn1,fn2) -> let raw_fn n = let m = calculate_m (Int 1) (Int 0) (Int 3 */ (power_num (Int 2) (n +/ Int 2))) in let e = log2 (Int 2 */ m) in let p = n +/ e +/ Int 2 in let s = raw_eval fn1 p in let seq = calculate_exp_sequence p s m in let u0 = itlist (+/) seq (Int 0) in ndiv u0 (power_num (Int 2) (e +/ Int 2)) and thm_fn n = let m = calculate_m (Int 1) (Int 0) (Int 3 */ (power_num (Int 2) (n +/ Int 2))) in let e = log2 (Int 2 */ m) in let p = n +/ e +/ Int 2 in let sth = thm_eval fn2 p in let tm1 = rand(lhand(concl sth)) in let s_num = lhand tm1 in let x_num = rand(rand tm1) in let s = dest_realintconst s_num in let seq = calculate_exp_sequence p s m in let u0 = itlist (+/) seq (Int 0) in let u = ndiv u0 (power_num (Int 2) (e +/ Int 2)) in let m_num = mk_numeral m and n_num = mk_numeral n and e_num = mk_numeral e and p_num = mk_numeral p and u_num = mk_realintconst u in let tdefs = map2 (fun a b -> mk_eq(mk_comb(t_tm,mk_small_numeral a), mk_realintconst b)) (0--(length seq - 1)) seq in let p2th = REAL_INT_POW_CONV (mk_comb(pow2_tm,p_num)) in let th0 = INST [m_num,m_tm; n_num,n_tm; e_num,e_tm; x_num,x_tm; p_num,p_tm; s_num,s_tm; u_num,u_tm] pth in let th0' = MP th0 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th0)))) in let th1 = MP th0' sth in let th2 = CONV_RULE (ONCE_DEPTH_CONV EXPAND_RANGE_CONV) th1 in let th3 = LEFT_ZERO_RULE (CONV_RULE (ONCE_DEPTH_CONV REAL_SUM_CONV) th2) in let ths = try CONJUNCTS(ASSUME(list_mk_conj tdefs)) with Failure _ -> [] in let th4 = SUBS (p2th::ths) th3 in let th5 = CONV_RULE (LAND_CONV (DEPTH_CONV NUM_ADD_CONV THENC ONCE_DEPTH_CONV NUM_FACT_CONV THENC REAL_INT_REDUCE_CONV)) th4 in MP (ELIMINATE_DEF tdefs th5) TRUTH in raw_wrap raw_fn,thm_wrap thm_fn in let REALCALC_LN_CONV = let t_tm = `t:num->real` and n_tm = `n:num` and m_tm = `m:num` and e_tm = `e:num` and p_tm = `p:num` and s_tm = `s:real` and u_tm = `u:real` and k_tm = `k:num` and x_tm = `x:real` in let rec calculate_m acc k2 m r = if acc */ (m +/ Int 1) >=/ r then m else calculate_m (k2 */ acc) k2 (m +/ Int 1) r in let calculate_ln_sequence = let rec calculate_ln_sequence p2 s i = if i let p2 = power_num (Int 2) p in rev(calculate_ln_sequence p2 s (m -/ Int 1)) in let pth = prove (`&0 <= x /\ x <= inv(&2 pow k) ==> abs(s - &2 pow p * x) < &1 ==> ~(k = 0) /\ (n + e + 2 = p) /\ &2 pow (n + 2) <= &2 pow (k * SUC m) * &(SUC m) /\ &3 * &m <= &2 pow e /\ (t(0) = s) /\ (!k. SUC k < m ==> &2 * abs(t(SUC k) * &2 pow p * &(SUC(SUC k)) - &(SUC k) * --s * t(k)) <= &2 pow p * &(SUC(SUC k))) /\ abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) ==> abs(u - &2 pow n * ln(&1 + x)) < &1`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST [`--s`,`s:real`] APPROX_LN) THEN ASM_REWRITE_TAC[REAL_NEG_NEG] THEN REWRITE_TAC[REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_ARITH `abs(--a - --b) = abs(a - b)`] THEN ASM_REWRITE_TAC[]) in let LEFT_ZERO_RULE = ONCE_REWRITE_RULE[prove(`0 + n = n`,REWRITE_TAC[ADD_CLAUSES])] in let pow2_tm = `(pow) (&2)` in let default_tdefs = [`t 0 = &0`] in fun (fn1,fn2) -> let raw_fn n = let k = find_ubound fn1 in if k mk_eq(mk_comb(t_tm,mk_small_numeral a), mk_realintconst b)) (0--(length seq - 1)) seq in let tdefs = if tdefs0 = [] then default_tdefs else tdefs0 in let p2th = REAL_INT_POW_CONV (mk_comb(pow2_tm,p_num)) in let th0 = INST [m_num,m_tm; n_num,n_tm; e_num,e_tm; k_num,k_tm; x_num,x_tm; p_num,p_tm; s_num,s_tm; u_num,u_tm] pth in let th0' = MP th0 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th0)))) in let th1 = MP th0' sth in let th2 = CONV_RULE (ONCE_DEPTH_CONV EXPAND_RANGE_CONV) th1 in let th3 = LEFT_ZERO_RULE (CONV_RULE (ONCE_DEPTH_CONV REAL_SUM_CONV) th2) in let ths = try CONJUNCTS(ASSUME(list_mk_conj tdefs)) with Failure _ -> [] in let th4 = SUBS (p2th::ths) th3 in let th5 = CONV_RULE (LAND_CONV (NUM_REDUCE_CONV THENC REAL_INT_REDUCE_CONV)) th4 in MP (ELIMINATE_DEF tdefs th5) TRUTH in raw_wrap raw_fn,thm_wrap thm_fn in let REALCALC_SQRT_CONV = let num_sqrt = let rec isolate_sqrt (a,b) y = if abs_num(a -/ b) <=/ Int 1 then if abs_num(a */ a -/ y) <=/ a then a else b else let c = quo_num (a +/ b) (Int 2) in if c */ c <=/ y then isolate_sqrt (c,b) y else isolate_sqrt (a,c) y in fun n -> isolate_sqrt (Int 0,n) n in let MATCH_pth = MATCH_MP REALCALC_SQRT in let b_tm = `b:real` in let PROVE_1_LE_SQRT = let pth = prove (`&1 <= x ==> &1 <= sqrt(x)`, DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP (REAL_ARITH `&1 <= x ==> &0 <= x`) th) THEN MP_TAC th) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `x = sqrt(x) pow 2` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[SQRT_POW2]; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[POW_2] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_SIMP_TAC[SQRT_POS_LE]]) in let tac = REPEAT(MATCH_MP_TAC pth) THEN CONV_TAC REAL_RAT_LE_CONV in fun tm -> try prove(tm,tac) with Failure _ -> failwith "Need root body >= &1" in fun (fn1,fn2) -> let raw_fn n = num_sqrt(power_num (Int 2) n */ raw_eval fn1 n) and thm_fn n = let th1 = MATCH_pth(thm_eval fn2 n) in let th2 = MP th1 (PROVE_1_LE_SQRT(lhand(concl th1))) in let th3 = CONV_RULE(funpow 2 LAND_CONV (funpow 2 RAND_CONV REAL_RAT_REDUCE_CONV)) th2 in let k = dest_realintconst(rand(rand(lhand(lhand(concl th3))))) in let th4 = INST [mk_realintconst(num_sqrt k),b_tm] th3 in MP th4 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th4)))) in raw_wrap raw_fn,thm_wrap thm_fn in let rec REALCALC_CONV tm = try assoc tm (!realcalc_cache) with Failure _ -> if is_ratconst tm then let x = rat_of_term tm in let raw_fn acc = floor_num ((power_num (Int 2) acc) */ x) and thm_fn acc = let a = floor_num ((power_num (Int 2) acc) */ x) in let atm = mk_realintconst a in let rtm = mk_comb(mk_comb(mul_tm,mk_comb(pow2_tm,mk_numeral acc)),tm) in let btm = mk_comb(abs_tm,mk_comb(mk_comb(sub_tm,atm),rtm)) in let ftm = mk_comb(mk_comb(lt_tm,btm),one_tm) in EQT_ELIM(REAL_RAT_REDUCE_CONV ftm) in raw_wrap raw_fn,thm_wrap thm_fn else let lop,r = dest_comb tm in if lop = neg_tm then let rfn,tfn = REALCALC_CONV r in let raw_fn acc = minus_num (raw_eval rfn acc) and thm_fn acc = let th1 = thm_eval tfn acc in let th2 = MATCH_MP REALCALC_NEG th1 in try EQ_MP (LAND_CONV(RAND_CONV(LAND_CONV REAL_INT_NEG_CONV)) (concl th2)) th2 with Failure _ -> th2 in raw_wrap raw_fn,thm_wrap thm_fn else if lop = abs_tm then let rfn,tfn = REALCALC_CONV r in let raw_fn acc = abs_num (raw_eval rfn acc) and thm_fn acc = let th1 = thm_eval tfn acc in let th2 = MATCH_MP REALCALC_ABS th1 in CONV_RULE (LAND_CONV(RAND_CONV(LAND_CONV REAL_INT_ABS_CONV))) th2 in raw_wrap raw_fn,thm_wrap thm_fn else if lop = sqrt_tm then REALCALC_SQRT_CONV(REALCALC_CONV r) else if lop = inv_tm then let rfn,tfn = REALCALC_CONV r in let x0 = raw_eval rfn (Int 0) in let ax0 = abs_num x0 in let r = log2(ax0) -/ Int 1 in let get_ek(acc) = if r < Int 0 then let p = find_msd rfn in let e = acc +/ p +/ Int 1 in let k = e +/ p in e,k else let k = let k0 = acc +/ Int 1 -/ (Int 2 */ r) in if k0 let th1 = thm_eval tfn n in GEN_REWRITE_RULE (LAND_CONV o funpow 3 RAND_CONV) [SYM th] th1);; (* ------------------------------------------------------------------------- *) (* Calculate ordering relation between two expressions. *) (* ------------------------------------------------------------------------- *) let REALCALC_LT = prove (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 ==> &2 <= abs(a - b) ==> (x < y <=> a < b)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&2 pow n * x < &2 pow n * y` THEN CONJ_TAC THENL [SIMP_TAC[REAL_LT_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC]);; let REALCALC_LE = prove (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 ==> &2 <= abs(a - b) ==> (x <= y <=> a <= b)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&2 pow n * x <= &2 pow n * y` THEN CONJ_TAC THENL [SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC]);; let REALCALC_GT = prove (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 ==> &2 <= abs(a - b) ==> (x > y <=> a > b)`, ONCE_REWRITE_TAC[CONJ_SYM; REAL_ABS_SUB] THEN REWRITE_TAC[real_gt; REALCALC_LT]);; let REALCALC_GE = prove (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 ==> &2 <= abs(a - b) ==> (x >= y <=> a >= b)`, ONCE_REWRITE_TAC[CONJ_SYM; REAL_ABS_SUB] THEN REWRITE_TAC[real_ge; REALCALC_LE]);; let REALCALC_EQ = prove (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 ==> &2 <= abs(a - b) ==> ((x = y) <=> F)`, ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let realcalc_rel_conv = let pops = [`(<)`,()`,(>/); `(>=)`,(>=/); `(=):real->real->bool`,(=/)] in let rec find_n rfn1 rfn2 n = if n >/ Int 1000 then failwith "realcalc_rel_conv: too close to discriminate" else if abs_num(raw_eval rfn1 n -/ raw_eval rfn2 n) >=/ Int 4 then n else find_n rfn1 rfn2 (n +/ Int 1) in fun tm -> let lop,r = dest_comb tm in let op,l = dest_comb lop in let pop = try assoc op pops with Failure _ -> failwith "realcalc_rel_conv: unknown operator" in let rfn1,tfn1 = REALCALC_CONV l and rfn2,tfn2 = REALCALC_CONV r in let n = find_n rfn1 rfn2 (Int 1) in pop (raw_eval rfn1 n) (raw_eval rfn2 n);; let REALCALC_REL_CONV = let pths = [`(<)`,REALCALC_LT; `(<=)`,REALCALC_LE; `(>)`,REALCALC_GT; `(>=)`,REALCALC_GE; `(=):real->real->bool`,REALCALC_EQ] in let rec find_n rfn1 rfn2 n = if n >/ Int 1000 then failwith "realcalc_rel_conv: too close to discriminate" else if abs_num(raw_eval rfn1 n -/ raw_eval rfn2 n) >=/ Int 4 then n else find_n rfn1 rfn2 (n +/ Int 1) in fun tm -> let lop,r = dest_comb tm in let op,l = dest_comb lop in let pth = try assoc op pths with Failure _ -> failwith "realcalc_rel_conv: unknown operator" in let rfn1,tfn1 = REALCALC_CONV l and rfn2,tfn2 = REALCALC_CONV r in let n = find_n rfn1 rfn2 (Int 1) in let th1 = thm_eval tfn1 n and th2 = thm_eval tfn2 n in let th3 = MATCH_MP pth (CONJ th1 th2) in let th4 = MP th3 (EQT_ELIM(REAL_INT_REDUCE_CONV(lhand(concl th3)))) in CONV_RULE(RAND_CONV REAL_RAT_REDUCE_CONV) th4;; hol-light/Library/card.ml000066400000000000000000003466531303454263000156350ustar00rootroot00000000000000(* ========================================================================= *) (* Basic notions of cardinal arithmetic. *) (* ========================================================================= *) needs "Library/wo.ml";; let TRANS_CHAIN_TAC th = MAP_EVERY (fun t -> TRANS_TAC th t THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* We need these a few times, so give them names. *) (* ------------------------------------------------------------------------- *) let sum_DISTINCT = distinctness "sum";; let sum_INJECTIVE = injectivity "sum";; let sum_CASES = prove_cases_thm sum_INDUCT;; let FORALL_SUM_THM = prove (`(!z. P z) <=> (!x. P(INL x)) /\ (!x. P(INR x))`, MESON_TAC[sum_CASES]);; let EXISTS_SUM_THM = prove (`(?z. P z) <=> (?x. P(INL x)) \/ (?x. P(INR x))`, MESON_TAC[sum_CASES]);; (* ------------------------------------------------------------------------- *) (* Useful lemma to reduce some higher order stuff to first order. *) (* ------------------------------------------------------------------------- *) let FLATTEN_LEMMA = prove (`(!x. x IN s ==> (g(f(x)) = x)) <=> !y x. x IN s /\ (y = f x) ==> (g y = x)`, MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Knaster-Tarski fixpoint theorem (used in Schroeder-Bernstein below). *) (* ------------------------------------------------------------------------- *) let TARSKI_SET = prove (`!f. (!s t. s SUBSET t ==> f(s) SUBSET f(t)) ==> ?s:A->bool. f(s) = s`, REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`Y = {b:A->bool | f(b) SUBSET b}`; `a:A->bool = INTERS Y`] THEN SUBGOAL_THEN `!b:A->bool. b IN Y <=> f(b) SUBSET b` ASSUME_TAC THENL [EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN SUBGOAL_THEN `!b:A->bool. b IN Y ==> f(a:A->bool) SUBSET b` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; IN_INTERS; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `f(a:A->bool) SUBSET a` (fun th -> ASM_MESON_TAC[SUBSET_ANTISYM; IN_INTERS; th]) THEN ASM_MESON_TAC[IN_INTERS; SUBSET]);; (* ------------------------------------------------------------------------- *) (* We need a nonemptiness hypothesis for the nicest total function form. *) (* ------------------------------------------------------------------------- *) let INJECTIVE_LEFT_INVERSE_NONEMPTY = prove (`(?x. x IN s) ==> ((!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) <=> ?g. (!y. y IN t ==> g(y) IN s) /\ (!x. x IN s ==> (g(f(x)) = x)))`, REWRITE_TAC[FLATTEN_LEMMA; GSYM SKOLEM_THM; AND_FORALL_THM] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Now bijectivity. *) (* ------------------------------------------------------------------------- *) let BIJECTIVE_INJECTIVE_SURJECTIVE = prove (`(!x. x IN s ==> f(x) IN t) /\ (!y. y IN t ==> ?!x. x IN s /\ (f x = y)) <=> (!x. x IN s ==> f(x) IN t) /\ (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\ (!y. y IN t ==> ?x. x IN s /\ (f x = y))`, MESON_TAC[]);; let BIJECTIVE_INVERSES = prove (`(!x. x IN s ==> f(x) IN t) /\ (!y. y IN t ==> ?!x. x IN s /\ (f x = y)) <=> (!x. x IN s ==> f(x) IN t) /\ ?g. (!y. y IN t ==> g(y) IN s) /\ (!y. y IN t ==> (f(g(y)) = y)) /\ (!x. x IN s ==> (g(f(x)) = x))`, REWRITE_TAC[BIJECTIVE_INJECTIVE_SURJECTIVE; INJECTIVE_ON_LEFT_INVERSE; SURJECTIVE_ON_RIGHT_INVERSE] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN DISCH_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Other variants of cardinal equality. *) (* ------------------------------------------------------------------------- *) let EQ_C_BIJECTIONS = prove (`!s:A->bool t:B->bool. s =_c t <=> ?f g. (!x. x IN s ==> f x IN t /\ g(f x) = x) /\ (!y. y IN t ==> g y IN s /\ f(g y) = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `f:A->B` THEN REWRITE_TAC[] THEN EQ_TAC THENL [STRIP_TAC; MESON_TAC[]] THEN EXISTS_TAC `(\y. @x. x IN s /\ f x = y):B->A` THEN ASM_MESON_TAC[]);; let EQ_C = prove (`s =_c t <=> ?R:A#B->bool. (!x y. R(x,y) ==> x IN s /\ y IN t) /\ (!x. x IN s ==> ?!y. y IN t /\ R(x,y)) /\ (!y. y IN t ==> ?!x. x IN s /\ R(x,y))`, REWRITE_TAC[eq_c] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\(x:A,y:B). x IN s /\ y IN t /\ (y = f x)` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_MESON_TAC[]; DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [EXISTS_UNIQUE_ALT; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The "easy" ordering properties. *) (* ------------------------------------------------------------------------- *) let CARD_LE_REFL = prove (`!s:A->bool. s <=_c s`, GEN_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:A. x` THEN SIMP_TAC[]);; let CARD_EMPTY_LE = prove (`!s:B->bool. ({}:A->bool) <=_c s`, REWRITE_TAC[LE_C; NOT_IN_EMPTY]);; let CARD_LE_TRANS = prove (`!s:A->bool t:B->bool u:C->bool. s <=_c t /\ t <=_c u ==> s <=_c u`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f:A->B`) (X_CHOOSE_TAC `g:B->C`)) THEN EXISTS_TAC `(g:B->C) o (f:A->B)` THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; let CARD_LT_REFL = prove (`!s:A->bool. ~(s <_c s)`, MESON_TAC[lt_c; CARD_LE_REFL]);; let CARD_LET_TRANS = prove (`!s:A->bool t:B->bool u:C->bool. s <=_c t /\ t <_c u ==> s <_c u`, REPEAT GEN_TAC THEN REWRITE_TAC[lt_c] THEN MATCH_MP_TAC(TAUT `(a /\ b ==> c) /\ (c' /\ a ==> b') ==> a /\ b /\ ~b' ==> c /\ ~c'`) THEN REWRITE_TAC[CARD_LE_TRANS]);; let CARD_LTE_TRANS = prove (`!s:A->bool t:B->bool u:C->bool. s <_c t /\ t <=_c u ==> s <_c u`, REPEAT GEN_TAC THEN REWRITE_TAC[lt_c] THEN MATCH_MP_TAC(TAUT `(a /\ b ==> c) /\ (b /\ c' ==> a') ==> (a /\ ~a') /\ b ==> c /\ ~c'`) THEN REWRITE_TAC[CARD_LE_TRANS]);; let CARD_LT_TRANS = prove (`!s:A->bool t:B->bool u:C->bool. s <_c t /\ t <_c u ==> s <_c u`, MESON_TAC[lt_c; CARD_LTE_TRANS]);; let CARD_EQ_REFL = prove (`!s:A->bool. s =_c s`, GEN_TAC THEN REWRITE_TAC[eq_c] THEN EXISTS_TAC `\x:A. x` THEN SIMP_TAC[] THEN MESON_TAC[]);; let CARD_EQ_REFL_IMP = prove (`!s t:A->bool. s = t ==> s =_c t`, SIMP_TAC[CARD_EQ_REFL]);; let CARD_EQ_SYM = prove (`!s t. s =_c t <=> t =_c s`, REPEAT GEN_TAC THEN REWRITE_TAC[eq_c; BIJECTIVE_INVERSES] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN REWRITE_TAC[CONJ_ACI]);; let CARD_EQ_IMP_LE = prove (`!s t. s =_c t ==> s <=_c t`, REWRITE_TAC[le_c; eq_c] THEN MESON_TAC[]);; let CARD_LT_IMP_LE = prove (`!s t. s <_c t ==> s <=_c t`, SIMP_TAC[lt_c]);; let CARD_LE_RELATIONAL = prove (`!R:A->B->bool. (!x y y'. x IN s /\ R x y /\ R x y' ==> y = y') ==> {y | ?x. x IN s /\ R x y} <=_c s`, REPEAT STRIP_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\y:B. @x:A. x IN s /\ R x y` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let CARD_LE_RELATIONAL_FULL = prove (`!R:A->B->bool s t. (!y. y IN t ==> ?x. x IN s /\ R x y) /\ (!x y y'. x IN s /\ y IN t /\ y' IN t /\ R x y /\ R x y' ==> y = y') ==> t <=_c s`, REPEAT STRIP_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\y:B. @x:A. x IN s /\ R x y` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let CARD_LE_EMPTY = prove (`!s. s <=_c {} <=> s = {}`, REWRITE_TAC[le_c; EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[]);; let CARD_EQ_EMPTY = prove (`!s. s =_c {} <=> s = {}`, REWRITE_TAC[eq_c; EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[]);; let CARD_SING_LE = prove (`!a:A s:B->bool. {a} <=_c s <=> ~(s = {})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:B->bool = {}` THEN ASM_REWRITE_TAC[CARD_LE_EMPTY; NOT_INSERT_EMPTY] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `b:B` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `(\x. b):A->B` THEN ASM_SIMP_TAC[IN_SING]);; (* ------------------------------------------------------------------------- *) (* Antisymmetry (the Schroeder-Bernstein theorem). *) (* ------------------------------------------------------------------------- *) let CARD_LE_ANTISYM = prove (`!s:A->bool t:B->bool. s <=_c t /\ t <=_c s <=> (s =_c t)`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; SIMP_TAC[CARD_EQ_IMP_LE] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN SIMP_TAC[CARD_EQ_IMP_LE]] THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_CASES_TAC `t:B->bool = {}` THEN ASM_SIMP_TAC[CARD_LE_EMPTY; CARD_EQ_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[EXTENSION; NOT_IN_EMPTY; NOT_FORALL_THM]) THEN ASM_SIMP_TAC[le_c; eq_c; INJECTIVE_LEFT_INVERSE_NONEMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `i:A->B` (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `i':B->A` STRIP_ASSUME_TAC))) (X_CHOOSE_THEN `j:B->A` (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `j':A->B` STRIP_ASSUME_TAC)))) THEN MP_TAC(ISPEC `\a. s DIFF (IMAGE (j:B->A) (t DIFF (IMAGE (i:A->B) a)))` TARSKI_SET) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_DIFF; IN_IMAGE] THEN MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `a:A->bool` ASSUME_TAC) THEN REWRITE_TAC[BIJECTIVE_INVERSES] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `\x. if x IN a then (i:A->B)(x) else j'(x)` THEN EXISTS_TAC `\y. if y IN (IMAGE (i:A->B) a) then i'(y) else (j:B->A)(y)` THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_DEF] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN CONJ_TAC THENL [X_GEN_TAC `x:A` THEN ASM_CASES_TAC `x:A IN a`; X_GEN_TAC `y:B` THEN ASM_CASES_TAC `y IN IMAGE (i:A->B) a`] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[EXTENSION; IN_UNIV; IN_DIFF; IN_IMAGE]) THEN TRY(FIRST_X_ASSUM(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC)) THEN TRY(FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:A` th) THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC th)) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Totality (cardinal comparability). *) (* ------------------------------------------------------------------------- *) let CARD_LE_TOTAL = prove (`!s:A->bool t:B->bool. s <=_c t \/ t <=_c s`, REPEAT GEN_TAC THEN ABBREV_TAC `P = \R. (!x:A y:B. R(x,y) ==> x IN s /\ y IN t) /\ (!x y y'. R(x,y) /\ R(x,y') ==> (y = y')) /\ (!x x' y. R(x,y) /\ R(x',y) ==> (x = x'))` THEN MP_TAC(ISPEC `P:((A#B)->bool)->bool` ZL_SUBSETS_UNIONS) THEN ANTS_TAC THENL [GEN_TAC THEN EXPAND_TAC "P" THEN REWRITE_TAC[UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `R:A#B->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `(!x:A. x IN s ==> ?y:B. y IN t /\ R(x,y)) \/ (!y:B. y IN t ==> ?x:A. x IN s /\ R(x,y))` THENL [FIRST_X_ASSUM(K ALL_TAC o SPEC `\(x:A,y:B). T`) THEN FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; le_c] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:A`) (X_CHOOSE_TAC `b:B`)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `\(x:A,y:B). (x = a) /\ (y = b) \/ R(x,y)`) THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN; EXTENSION] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Other variants like "trichotomy of cardinals" now follow easily. *) (* ------------------------------------------------------------------------- *) let CARD_LET_TOTAL = prove (`!s:A->bool t:B->bool. s <=_c t \/ t <_c s`, REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; let CARD_LTE_TOTAL = prove (`!s:A->bool t:B->bool. s <_c t \/ t <=_c s`, REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; let CARD_LT_TOTAL = prove (`!s:A->bool t:B->bool. s =_c t \/ s <_c t \/ t <_c s`, REWRITE_TAC[lt_c; GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_TOTAL]);; let CARD_NOT_LE = prove (`!s:A->bool t:B->bool. ~(s <=_c t) <=> t <_c s`, REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; let CARD_NOT_LT = prove (`!s:A->bool t:B->bool. ~(s <_c t) <=> t <=_c s`, REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; let CARD_LT_LE = prove (`!s t. s <_c t <=> s <=_c t /\ ~(s =_c t)`, REWRITE_TAC[lt_c; GSYM CARD_LE_ANTISYM] THEN CONV_TAC TAUT);; let CARD_LE_LT = prove (`!s t. s <=_c t <=> s <_c t \/ s =_c t`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_NOT_LT] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CARD_LT_LE] THEN REWRITE_TAC[DE_MORGAN_THM; CARD_NOT_LE; CARD_EQ_SYM]);; let CARD_LE_CONG = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s =_c s' /\ t =_c t' ==> (s <=_c t <=> s' <=_c t')`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN MATCH_MP_TAC(TAUT `!x y. (b /\ e ==> x) /\ (x /\ c ==> f) /\ (a /\ f ==> y) /\ (y /\ d ==> e) ==> (a /\ b) /\ (c /\ d) ==> (e <=> f)`) THEN MAP_EVERY EXISTS_TAC [`(s':B->bool) <=_c (t:C->bool)`; `(s:A->bool) <=_c (t':D->bool)`] THEN REWRITE_TAC[CARD_LE_TRANS]);; let CARD_LT_CONG = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s =_c s' /\ t =_c t' ==> (s <_c t <=> s' <_c t')`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_NOT_LE] THEN AP_TERM_TAC THEN MATCH_MP_TAC CARD_LE_CONG THEN ASM_REWRITE_TAC[]);; let CARD_EQ_TRANS = prove (`!s:A->bool t:B->bool u:C->bool. s =_c t /\ t =_c u ==> s =_c u`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[CARD_LE_TRANS]);; let CARD_EQ_CONG = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s =_c s' /\ t =_c t' ==> (s =_c t <=> s' =_c t')`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [TRANS_CHAIN_TAC CARD_EQ_TRANS [`t:C->bool`; `s:A->bool`]; TRANS_CHAIN_TAC CARD_EQ_TRANS [`s':B->bool`; `t':D->bool`]] THEN ASM_MESON_TAC[CARD_EQ_SYM]);; (* ------------------------------------------------------------------------- *) (* Finiteness and infiniteness in terms of cardinality of N. *) (* ------------------------------------------------------------------------- *) let INFINITE_CARD_LE = prove (`!s:A->bool. INFINITE s <=> (UNIV:num->bool) <=_c s`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[INFINITE; le_c; IN_UNIV] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_IMAGE_INJ) THEN DISCH_THEN(MP_TAC o C MATCH_MP num_INFINITE) THEN REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN ASM_SIMP_TAC[SUBSET; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM]] THEN DISCH_TAC THEN SUBGOAL_THEN `?f:num->A. !n. f(n) = @x. x IN (s DIFF IMAGE f {m | m < n})` MP_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[le_c] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->A` THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. (f:num->A)(n) IN (s DIFF IMAGE f {m | m < n})` MP_TAC THENL [GEN_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV THEN REWRITE_TAC[MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC INFINITE_NONEMPTY THEN MATCH_MP_TAC INFINITE_DIFF_FINITE THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF] THEN MESON_TAC[LT_CASES]);; let FINITE_CARD_LT = prove (`!s:A->bool. FINITE s <=> s <_c (UNIV:num->bool)`, ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN REWRITE_TAC[GSYM INFINITE; CARD_NOT_LT; INFINITE_CARD_LE]);; let CARD_LE_SUBSET = prove (`!s:A->bool t. s SUBSET t ==> s <=_c t`, REWRITE_TAC[SUBSET; le_c] THEN METIS_TAC[I_THM]);; let CARD_LE_UNIV = prove (`!s:A->bool. s <=_c (:A)`, GEN_TAC THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; let CARD_LE_EQ_SUBSET = prove (`!s:A->bool t:B->bool. s <=_c t <=> ?u. u SUBSET t /\ (s =_c u)`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN MATCH_MP_TAC(TAUT `(a <=> b) ==> b ==> a`) THEN MATCH_MP_TAC CARD_LE_CONG THEN ASM_REWRITE_TAC[CARD_LE_CONG; CARD_EQ_REFL]] THEN REWRITE_TAC[le_c; eq_c] THEN DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `IMAGE (f:A->B) s` THEN EXISTS_TAC `f:A->B` THEN REWRITE_TAC[IN_IMAGE; SUBSET] THEN ASM_MESON_TAC[]);; let CARD_INFINITE_CONG = prove (`!s:A->bool t:B->bool. s =_c t ==> (INFINITE s <=> INFINITE t)`, REWRITE_TAC[INFINITE_CARD_LE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_CONG THEN ASM_REWRITE_TAC[CARD_EQ_REFL]);; let CARD_FINITE_CONG = prove (`!s:A->bool t:B->bool. s =_c t ==> (FINITE s <=> FINITE t)`, ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN REWRITE_TAC[GSYM INFINITE; CARD_INFINITE_CONG]);; let CARD_LE_FINITE = prove (`!s:A->bool t:B->bool. FINITE t /\ s <=_c t ==> FINITE s`, ASM_MESON_TAC[CARD_LE_EQ_SUBSET; FINITE_SUBSET; CARD_FINITE_CONG]);; let CARD_EQ_FINITE = prove (`!s t:A->bool. FINITE t /\ s =_c t ==> FINITE s`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_FINITE]);; let CARD_LE_INFINITE = prove (`!s:A->bool t:B->bool. INFINITE s /\ s <=_c t ==> INFINITE t`, MESON_TAC[CARD_LE_FINITE; INFINITE]);; let CARD_LT_FINITE_INFINITE = prove (`!s:A->bool t:B->bool. FINITE s /\ INFINITE t ==> s <_c t`, REWRITE_TAC[GSYM CARD_NOT_LE; INFINITE] THEN MESON_TAC[CARD_LE_FINITE]);; let CARD_LE_FINITE_INFINITE = prove (`!s:A->bool t:B->bool. FINITE s /\ INFINITE t ==> s <=_c t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LT_IMP_LE THEN ASM_SIMP_TAC[CARD_LT_FINITE_INFINITE]);; let CARD_LE_CARD_IMP = prove (`!s:A->bool t:B->bool. FINITE t /\ s <=_c t ==> CARD s <= CARD t`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `FINITE(s:A->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CARD_LE_FINITE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [le_c]) THEN DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (f:A->B) s)` THEN CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `(m = n:num) ==> n <= m`) THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET; IN_IMAGE]]);; let CARD_EQ_CARD_IMP = prove (`!s:A->bool t:B->bool. FINITE t /\ s =_c t ==> (CARD s = CARD t)`, MESON_TAC[CARD_FINITE_CONG; LE_ANTISYM; CARD_LE_ANTISYM; CARD_LE_CARD_IMP]);; let CARD_LE_CARD = prove (`!s:A->bool t:B->bool. FINITE s /\ FINITE t ==> (s <=_c t <=> CARD s <= CARD t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (~a ==> ~b) ==> (a <=> b)`) THEN ASM_SIMP_TAC[CARD_LE_CARD_IMP] THEN REWRITE_TAC[CARD_NOT_LE; NOT_LE] THEN REWRITE_TAC[lt_c; LT_LE] THEN ASM_SIMP_TAC[CARD_LE_CARD_IMP] THEN MATCH_MP_TAC(TAUT `(c ==> a ==> b) ==> a /\ ~b ==> ~c`) THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [CARD_LE_EQ_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `u:A->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN SUBGOAL_THEN `u:A->bool = s` (fun th -> ASM_MESON_TAC[th; CARD_EQ_SYM]) THEN ASM_MESON_TAC[CARD_SUBSET_EQ; CARD_EQ_CARD_IMP; CARD_EQ_SYM]);; let CARD_EQ_CARD = prove (`!s:A->bool t:B->bool. FINITE s /\ FINITE t ==> (s =_c t <=> (CARD s = CARD t))`, MESON_TAC[CARD_FINITE_CONG; LE_ANTISYM; CARD_LE_ANTISYM; CARD_LE_CARD]);; let CARD_LT_CARD = prove (`!s:A->bool t:B->bool. FINITE s /\ FINITE t ==> (s <_c t <=> CARD s < CARD t)`, SIMP_TAC[CARD_LE_CARD; GSYM NOT_LE; GSYM CARD_NOT_LE]);; let CARD_HAS_SIZE_CONG = prove (`!s:A->bool t:B->bool n. s HAS_SIZE n /\ s =_c t ==> t HAS_SIZE n`, REWRITE_TAC[HAS_SIZE] THEN MESON_TAC[CARD_EQ_CARD; CARD_FINITE_CONG]);; let CARD_LE_IMAGE = prove (`!f s. IMAGE f s <=_c s`, REWRITE_TAC[LE_C; FORALL_IN_IMAGE] THEN MESON_TAC[]);; let CARD_LE_IMAGE_GEN = prove (`!f:A->B s t. t SUBSET IMAGE f s ==> t <=_c s`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `IMAGE (f:A->B) s` THEN ASM_SIMP_TAC[CARD_LE_IMAGE; CARD_LE_SUBSET]);; let CARD_EQ_IMAGE = prove (`!f:A->B s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f s =_c s`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[eq_c] THEN EXISTS_TAC `f:A->B` THEN ASM SET_TAC[]);; let LE_C_IMAGE = prove (`!s:A->bool t:B->bool. s <=_c t <=> s = {} \/ ?f. IMAGE f t = s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[CARD_EMPTY_LE] THEN EQ_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[LE_C] THEN DISCH_THEN(X_CHOOSE_TAC `f:B->A`) THEN EXISTS_TAC `\x. if (f:B->A) x IN s then f x else a` THEN ASM SET_TAC[]; DISCH_THEN(CHOOSE_THEN(SUBST1_TAC o SYM)) THEN REWRITE_TAC[CARD_LE_IMAGE]]);; let LE_C_IMAGE_SUBSET = prove (`!s:A->bool t:B->bool. s <=_c t <=> ?f. s SUBSET IMAGE f t`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[LE_C_IMAGE] THEN MESON_TAC[EMPTY_SUBSET; SUBSET_REFL]; DISCH_THEN(CHOOSE_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN REWRITE_TAC[CARD_LE_IMAGE]]);; (* ------------------------------------------------------------------------- *) (* Strict cardinal comparability on a given type is a wellfounded relation. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_ORDINAL_EXISTS = prove (`!s:A->bool. ?l:A#A->bool. ordinal l /\ fl l =_c s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?l:A#A->bool. ordinal l /\ !x. fl l x` STRIP_ASSUME_TAC THENL [REWRITE_TAC[WO_ORDINAL]; MP_TAC(ISPECL [`l:A#A->bool`; `s:A->bool`] SUBWOSET_ISO_INSEG)] THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[ordinal]) THEN ASM_REWRITE_TAC[SET_RULE `s = UNIV <=> !x. s x`] THEN DISCH_THEN(X_CHOOSE_THEN `f:A->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\(x,y). x IN IMAGE (f:A->A) s /\ y IN IMAGE f s /\ l(x,y)` THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] INSEG_ORDINAL)) THEN ASM_SIMP_TAC[inseg; FL_RESTRICT]; GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN ASM_SIMP_TAC[FL_RESTRICT; SET_RULE `(\x. x IN s) = s`] THEN MATCH_MP_TAC CARD_EQ_IMAGE] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]);; let WF_CARD_LT = prove (`WF((<_c):(A->bool)->(A->bool)->bool)`, SUBGOAL_THEN `?w:(A->bool)->A#A->bool. (!s. ordinal(w s)) /\ (!s. fl(w s) =_c s)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM; GSYM SKOLEM_THM; CARD_EQ_ORDINAL_EXISTS]; ALL_TAC] THEN MP_TAC(ISPEC `w:(A->bool)->A#A->bool` (MATCH_MP WF_MEASURE_GEN (INST_TYPE [`:B`,`:A`] WF_INSEG_WOSET))) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] WF_SUBSET) THEN REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`s:A->bool`; `t:A->bool`] THEN DISCH_TAC THEN ASM_SIMP_TAC[ORDINAL_IMP_WOSET] THEN MP_TAC(ISPECL [`(w:(A->bool)->A#A->bool) s`; `(w:(A->bool)->A#A->bool) t`] ORDINAL_CHAINED) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `~p /\ (~p /\ q ==> r) ==> p \/ q ==> r`) THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[INSEG_REFL]] THEN DISCH_THEN(MP_TAC o MATCH_MP INSEG_SUBSET_FL) THEN REWRITE_TAC[SET_RULE `(!x. s x ==> t x) <=> s SUBSET t`; ETA_AX] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LET_TRANS `s:A->bool` THEN ASM_SIMP_TAC[CARD_EQ_IMP_LE] THEN TRANS_TAC CARD_LTE_TRANS `t:A->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cardinal arithmetic operations. *) (* ------------------------------------------------------------------------- *) parse_as_infix("+_c",(16,"right"));; parse_as_infix("*_c",(20,"right"));; let add_c = new_definition `s +_c t = {INL x | x IN s} UNION {INR y | y IN t}`;; let mul_c = new_definition `s *_c t = {(x,y) | x IN s /\ y IN t}`;; (* ------------------------------------------------------------------------- *) (* Congruence properties for the arithmetic operators. *) (* ------------------------------------------------------------------------- *) let CARD_LE_ADD = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s <=_c s' /\ t <=_c t' ==> s +_c t <=_c s' +_c t'`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c; add_c] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `g:C->D` STRIP_ASSUME_TAC)) THEN MP_TAC(prove_recursive_functions_exist sum_RECURSION `(!x. h(INL x) = INL((f:A->B) x)) /\ (!y. h(INR y) = INR((g:C->D) y))`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:(A+C)->(B+D)` THEN STRIP_TAC THEN REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[]) THEN ASM_REWRITE_TAC[sum_DISTINCT; sum_INJECTIVE] THEN ASM_MESON_TAC[]);; let CARD_LE_MUL = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s <=_c s' /\ t <=_c t' ==> s *_c t <=_c s' *_c t'`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c; mul_c] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `g:C->D` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\(x,y). (f:A->B) x,(g:C->D) y` THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[]);; let CARD_FUNSPACE_LE = prove (`(:A) <=_c (:A') /\ (:B) <=_c (:B') ==> (:A->B) <=_c (:A'->B')`, REWRITE_TAC[le_c; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f:A->A'`) (X_CHOOSE_TAC `g:B->B'`)) THEN SUBGOAL_THEN `?f':A'->A. !x. f'(f x) = x` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM INJECTIVE_LEFT_INVERSE]; ALL_TAC] THEN EXISTS_TAC `\h. (g:B->B') o (h:A->B) o (f':A'->A)` THEN ASM_REWRITE_TAC[o_DEF; FUN_EQ_THM] THEN ASM_MESON_TAC[]);; let CARD_ADD_CONG = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s =_c s' /\ t =_c t' ==> s +_c t =_c s' +_c t'`, SIMP_TAC[CARD_LE_ADD; GSYM CARD_LE_ANTISYM]);; let CARD_MUL_CONG = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s =_c s' /\ t =_c t' ==> s *_c t =_c s' *_c t'`, SIMP_TAC[CARD_LE_MUL; GSYM CARD_LE_ANTISYM]);; let CARD_FUNSPACE_CONG = prove (`(:A) =_c (:A') /\ (:B) =_c (:B') ==> (:A->B) =_c (:A'->B')`, SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_FUNSPACE_LE]);; (* ------------------------------------------------------------------------- *) (* Misc lemmas. *) (* ------------------------------------------------------------------------- *) let MUL_C_UNIV = prove (`(:A) *_c (:B) = (:A#B)`, REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; mul_c; IN_ELIM_PAIR_THM; IN_UNIV]);; let CARD_FUNSPACE_CURRY = prove (`(:A->B->C) =_c (:A#B->C)`, REWRITE_TAC[EQ_C_BIJECTIONS] THEN EXISTS_TAC `\(f:A->B->C) (x,y). f x y` THEN EXISTS_TAC `\(g:A#B->C) x y. g(x,y)` THEN REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; let IN_CARD_ADD = prove (`(!x. INL(x) IN (s +_c t) <=> x IN s) /\ (!y. INR(y) IN (s +_c t) <=> y IN t)`, REWRITE_TAC[add_c; IN_UNION; IN_ELIM_THM] THEN REWRITE_TAC[sum_DISTINCT; sum_INJECTIVE] THEN MESON_TAC[]);; let IN_CARD_MUL = prove (`!s t x y. (x,y) IN (s *_c t) <=> x IN s /\ y IN t`, REWRITE_TAC[mul_c; IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[]);; let CARD_LE_SQUARE = prove (`!s:A->bool. s <=_c s *_c s`, GEN_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:A. x,(@z:A. z IN s)` THEN SIMP_TAC[IN_CARD_MUL; PAIR_EQ] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN MESON_TAC[]);; let CARD_SQUARE_NUM = prove (`(UNIV:num->bool) *_c (UNIV:num->bool) =_c (UNIV:num->bool)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_SQUARE] THEN REWRITE_TAC[le_c; IN_UNIV; mul_c; IN_ELIM_THM] THEN EXISTS_TAC `\(x,y). NUMPAIR x y` THEN REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[NUMPAIR_INJ]);; let UNION_LE_ADD_C = prove (`!s t:A->bool. (s UNION t) <=_c s +_c t`, REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_LE_IMAGE_GEN THEN EXISTS_TAC `function INL x -> (x:A) | INR x -> x` THEN REWRITE_TAC[add_c; IMAGE_UNION] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN SET_TAC[]);; let CARD_ADD_C = prove (`!s t. FINITE s /\ FINITE t ==> CARD(s +_c t) = CARD s + CARD t`, REPEAT STRIP_TAC THEN REWRITE_TAC[add_c] THEN W(MP_TAC o PART_MATCH (lhs o rand) CARD_UNION o lhand o snd) THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE] THEN REWRITE_TAC[SET_RULE `IMAGE f s INTER IMAGE g t = {} <=> !x y. x IN s /\ y IN t ==> ~(f x = g y)`] THEN REWRITE_TAC[sum_DISTINCT] THEN DISCH_THEN SUBST1_TAC THEN BINOP_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_SIMP_TAC[sum_INJECTIVE]);; let CARD_MUL_C = prove (`!s t. FINITE s /\ FINITE t ==> CARD(s *_c t) = CARD s * CARD t`, SIMP_TAC[mul_c; GSYM CROSS; CARD_CROSS]);; (* ------------------------------------------------------------------------- *) (* Various "arithmetical" lemmas. *) (* ------------------------------------------------------------------------- *) let CARD_ADD_SYM = prove (`!s:A->bool t:B->bool. s +_c t =_c t +_c s`, REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN MP_TAC(prove_recursive_functions_exist sum_RECURSION `(!x. (h:A+B->B+A) (INL x) = INR x) /\ (!y. h(INR y) = INL y)`) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FORALL_SUM_THM; EXISTS_SUM_THM; EXISTS_UNIQUE_THM] THEN REWRITE_TAC[sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN MESON_TAC[]);; let CARD_ADD_ASSOC = prove (`!s:A->bool t:B->bool u:C->bool. s +_c (t +_c u) =_c (s +_c t) +_c u`, REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN CHOOSE_TAC(prove_recursive_functions_exist sum_RECURSION `(!u. (i:B+C->(A+B)+C) (INL u) = INL(INR u)) /\ (!v. i(INR v) = INR v)`) THEN MP_TAC(prove_recursive_functions_exist sum_RECURSION `(!x. (h:A+B+C->(A+B)+C) (INL x) = INL(INL x)) /\ (!z. h(INR z) = i(z))`) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_SUM_THM; EXISTS_SUM_THM; EXISTS_UNIQUE_THM; sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN MESON_TAC[]);; let CARD_MUL_SYM = prove (`!s:A->bool t:B->bool. s *_c t =_c t *_c s`, REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN MP_TAC(prove_recursive_functions_exist pair_RECURSION `(!x:A y:B. h(x,y) = (y,x))`) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; IN_CARD_MUL; PAIR_EQ] THEN MESON_TAC[]);; let CARD_MUL_ASSOC = prove (`!s:A->bool t:B->bool u:C->bool. s *_c (t *_c u) =_c (s *_c t) *_c u`, REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN CHOOSE_TAC(prove_recursive_functions_exist pair_RECURSION `(!x y z. (i:A->B#C->(A#B)#C) x (y,z) = (x,y),z)`) THEN MP_TAC(prove_recursive_functions_exist pair_RECURSION `(!x p. (h:A#B#C->(A#B)#C) (x,p) = i x p)`) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; IN_CARD_MUL; PAIR_EQ] THEN MESON_TAC[]);; let CARD_LDISTRIB = prove (`!s:A->bool t:B->bool u:C->bool. s *_c (t +_c u) =_c (s *_c t) +_c (s *_c u)`, REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN CHOOSE_TAC(prove_recursive_functions_exist sum_RECURSION `(!x y. (i:A->(B+C)->A#B+A#C) x (INL y) = INL(x,y)) /\ (!x z. (i:A->(B+C)->A#B+A#C) x (INR z) = INR(x,z))`) THEN MP_TAC(prove_recursive_functions_exist pair_RECURSION `(!x s. (h:A#(B+C)->(A#B)+(A#C)) (x,s) = i x s)`) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM; FORALL_SUM_THM; EXISTS_SUM_THM; PAIR_EQ; IN_CARD_MUL; sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN MESON_TAC[]);; let CARD_RDISTRIB = prove (`!s:A->bool t:B->bool u:C->bool. (s +_c t) *_c u =_c (s *_c u) +_c (t *_c u)`, REPEAT GEN_TAC THEN TRANS_TAC CARD_EQ_TRANS `(u:C->bool) *_c ((s:A->bool) +_c (t:B->bool))` THEN REWRITE_TAC[CARD_MUL_SYM] THEN TRANS_TAC CARD_EQ_TRANS `(u:C->bool) *_c (s:A->bool) +_c (u:C->bool) *_c (t:B->bool)` THEN REWRITE_TAC[CARD_LDISTRIB] THEN MATCH_MP_TAC CARD_ADD_CONG THEN REWRITE_TAC[CARD_MUL_SYM]);; let CARD_LE_ADDR = prove (`!s:A->bool t:B->bool. s <=_c s +_c t`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `INL:A->A+B` THEN SIMP_TAC[IN_CARD_ADD; sum_INJECTIVE]);; let CARD_LE_ADDL = prove (`!s:A->bool t:B->bool. t <=_c s +_c t`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `INR:B->A+B` THEN SIMP_TAC[IN_CARD_ADD; sum_INJECTIVE]);; (* ------------------------------------------------------------------------- *) (* A rather special lemma but temporarily useful. *) (* ------------------------------------------------------------------------- *) let CARD_ADD_LE_MUL_INFINITE = prove (`!s:A->bool. INFINITE s ==> s +_c s <=_c s *_c s`, GEN_TAC THEN REWRITE_TAC[INFINITE_CARD_LE; le_c; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN MP_TAC(prove_recursive_functions_exist sum_RECURSION `(!x. h(INL x) = (f(0),x):A#A) /\ (!x. h(INR x) = (f(1),x))`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:A+A->A#A` THEN STRIP_TAC THEN REPEAT((MATCH_MP_TAC sum_INDUCT THEN ASM_REWRITE_TAC[IN_CARD_ADD; IN_CARD_MUL; PAIR_EQ]) ORELSE STRIP_TAC) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[NUM_REDUCE_CONV `1 = 0`]);; (* ------------------------------------------------------------------------- *) (* Relate cardinal addition to the simple union operation. *) (* ------------------------------------------------------------------------- *) let CARD_DISJOINT_UNION = prove (`!s:A->bool t. (s INTER t = {}) ==> (s UNION t =_c s +_c t)`, REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN STRIP_TAC THEN REWRITE_TAC[eq_c; IN_UNION] THEN EXISTS_TAC `\x:A. if x IN s then INL x else INR x` THEN REWRITE_TAC[FORALL_SUM_THM; IN_CARD_ADD] THEN REWRITE_TAC[COND_RAND; COND_RATOR] THEN REWRITE_TAC[TAUT `(if b then x else y) <=> b /\ x \/ ~b /\ y`] THEN REWRITE_TAC[sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN ASM_MESON_TAC[]);; let CARD_LE_EXISTS = prove (`!s:A->bool t:B->bool. s <=_c t <=> ?u:B->bool. t =_c s +_c u`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [le_c]) THEN REWRITE_TAC[INJECTIVE_ON_ALT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:A->B` THEN STRIP_TAC THEN EXISTS_TAC `t DIFF IMAGE (f:A->B) s` THEN TRANS_TAC CARD_EQ_TRANS `(IMAGE (f:A->B) s) UNION (t DIFF IMAGE f s)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_REFL_IMP THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH (lhand o rand) CARD_DISJOINT_UNION o lhand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN MATCH_MP_TAC CARD_ADD_CONG THEN REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN ASM SET_TAC[]]; TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c (u:B->bool)` THEN REWRITE_TAC[CARD_LE_ADDR] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_REWRITE_TAC[]]);; let CARD_LT_IMP_SUC_LE = prove (`!s:A->bool t:B->bool a:C. s <_c t ==> s +_c {a} <=_c t`, REWRITE_TAC[CARD_LT_LE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [le_c]) THEN DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?b. b IN t DIFF IMAGE (f:A->B) s` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [eq_c]) THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_FORALL_THM] THEN EXISTS_TAC `f:A->B` THEN ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:B` THEN SIMP_TAC[SET_RULE `~(b IN IMAGE f s) <=> !x. x IN s ==> ~(f x = b)`] THEN STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `IMAGE (f:A->B) s +_c {b:B}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_ADD THEN SIMP_TAC[CARD_LE_CARD; FINITE_SING; CARD_SING; LE_REFL] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH (rand o rand) CARD_DISJOINT_UNION o lhand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[CARD_EQ_SYM]] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_IMP_LE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_LE_SUBSET THEN ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* The key to arithmetic on infinite cardinals: k^2 = k. *) (* ------------------------------------------------------------------------- *) let CARD_SQUARE_INFINITE = prove (`!k:A->bool. INFINITE k ==> (k *_c k =_c k)`, let lemma = prove (`INFINITE(s:A->bool) /\ s SUBSET k /\ (!x y. R(x,y) ==> x IN (s *_c s) /\ y IN s) /\ (!x. x IN (s *_c s) ==> ?!y. y IN s /\ R(x,y)) /\ (!y:A. y IN s ==> ?!x. x IN (s *_c s) /\ R(x,y)) ==> (s = {z | ?p. R(p,z)})`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]) in REPEAT STRIP_TAC THEN ABBREV_TAC `P = \R. ?s. INFINITE(s:A->bool) /\ s SUBSET k /\ (!x y. R(x,y) ==> x IN (s *_c s) /\ y IN s) /\ (!x. x IN (s *_c s) ==> ?!y. y IN s /\ R(x,y)) /\ (!y. y IN s ==> ?!x. x IN (s *_c s) /\ R(x,y))` THEN MP_TAC(ISPEC `P:((A#A)#A->bool)->bool` ZL_SUBSETS_UNIONS_NONEMPTY) THEN ANTS_TAC THENL [CONJ_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EQ_C] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INFINITE_CARD_LE]) THEN REWRITE_TAC[CARD_LE_EQ_SUBSET] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:A->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[num_INFINITE; CARD_INFINITE_CONG]; ALL_TAC] THEN FIRST_ASSUM(fun th -> MP_TAC(MATCH_MP CARD_MUL_CONG (CONJ th th))) THEN GEN_REWRITE_TAC LAND_CONV [CARD_EQ_SYM] THEN DISCH_THEN(MP_TAC o C CONJ CARD_SQUARE_NUM) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_TRANS) THEN FIRST_ASSUM(fun th -> DISCH_THEN(ACCEPT_TAC o MATCH_MP CARD_EQ_TRANS o C CONJ th)); ALL_TAC] THEN SUBGOAL_THEN `P = \R. INFINITE {z | ?x y. R((x,y),z)} /\ (!x:A y z. R((x,y),z) ==> x IN k /\ y IN k /\ z IN k) /\ (!x y. (?u v. R((u,v),x)) /\ (?u v. R((u,v),y)) ==> ?z. R((x,y),z)) /\ (!x y. (?z. R((x,y),z)) ==> (?u v. R((u,v),x)) /\ (?u v. R((u,v),y))) /\ (!x y z1 z2. R((x,y),z1) /\ R((x,y),z2) ==> (z1 = z2)) /\ (!x1 y1 x2 y2 z. R((x1,y1),z) /\ R((x2,y2),z) ==> (x1 = x2) /\ (y1 = y2))` SUBST1_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MATCH_MP(TAUT `(a ==> b) ==> (a <=> b /\ a)`) lemma] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[IN_CARD_MUL; EXISTS_PAIR_THM; SUBSET; FUN_EQ_THM; IN_ELIM_THM; FORALL_PAIR_THM; EXISTS_UNIQUE_THM; UNIONS; PAIR_EQ] THEN GEN_TAC THEN AP_TERM_TAC THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REWRITE_TAC[] THEN GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [FORALL_AND_THM] THEN MATCH_MP_TAC(TAUT `(c /\ d ==> f) /\ (a /\ b ==> e) ==> (a /\ (b /\ c) /\ d ==> e /\ f)`) THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `s:(A#A)#A->bool`) MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `s:(A#A)#A->bool`) THEN ASM_REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; UNIONS] THEN ASM_MESON_TAC[IN]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `R:(A#A)#A->bool` (CONJUNCTS_THEN2 (X_CHOOSE_TAC `s:A->bool`) ASSUME_TAC)) THEN SUBGOAL_THEN `(s:A->bool) *_c s =_c s` ASSUME_TAC THENL [REWRITE_TAC[EQ_C] THEN EXISTS_TAC `R:(A#A)#A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s +_c s <=_c (s:A->bool)` ASSUME_TAC THENL [TRANS_TAC CARD_LE_TRANS `(s:A->bool) *_c s` THEN ASM_SIMP_TAC[CARD_EQ_IMP_LE; CARD_ADD_LE_MUL_INFINITE]; ALL_TAC] THEN SUBGOAL_THEN `(s:A->bool) INTER (k DIFF s) = {}` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_DIFF; NOT_IN_EMPTY] THEN MESON_TAC[]; ALL_TAC] THEN DISJ_CASES_TAC(ISPECL [`k DIFF (s:A->bool)`; `s:A->bool`] CARD_LE_TOTAL) THENL [SUBGOAL_THEN `k = (s:A->bool) UNION (k DIFF s)` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN REWRITE_TAC[SUBSET; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_UNION; IN_DIFF] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_SQUARE] THEN TRANS_TAC CARD_LE_TRANS `((s:A->bool) +_c (k DIFF s:A->bool)) *_c (s +_c k DIFF s)` THEN ASM_SIMP_TAC[CARD_DISJOINT_UNION; CARD_EQ_IMP_LE; CARD_MUL_CONG] THEN TRANS_TAC CARD_LE_TRANS `((s:A->bool) +_c s) *_c (s +_c s)` THEN ASM_SIMP_TAC[CARD_LE_ADD; CARD_LE_MUL; CARD_LE_REFL] THEN TRANS_TAC CARD_LE_TRANS `(s:A->bool) *_c s` THEN ASM_SIMP_TAC[CARD_LE_MUL] THEN TRANS_TAC CARD_LE_TRANS `s:A->bool` THEN ASM_SIMP_TAC[CARD_EQ_IMP_LE] THEN REWRITE_TAC[CARD_LE_EQ_SUBSET] THEN EXISTS_TAC `s:A->bool` THEN SIMP_TAC[CARD_EQ_REFL; SUBSET; IN_UNION]; ALL_TAC] THEN UNDISCH_TAC `s:A->bool <=_c k DIFF s` THEN REWRITE_TAC[CARD_LE_EQ_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `d:A->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(s:A->bool *_c d) UNION (d *_c s) UNION (d *_c d) =_c d` MP_TAC THENL [TRANS_TAC CARD_EQ_TRANS `((s:A->bool) *_c (d:A->bool)) +_c ((d *_c s) +_c (d *_c d))` THEN CONJ_TAC THENL [TRANS_TAC CARD_EQ_TRANS `((s:A->bool) *_c d) +_c ((d *_c s) UNION (d *_c d))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_ADD_CONG THEN REWRITE_TAC[CARD_EQ_REFL]] THEN MATCH_MP_TAC CARD_DISJOINT_UNION THEN UNDISCH_TAC `s INTER (k DIFF s:A->bool) = {}` THEN UNDISCH_TAC `d SUBSET (k DIFF s:A->bool)` THEN REWRITE_TAC[EXTENSION; SUBSET; FORALL_PAIR_THM; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_CARD_MUL; IN_DIFF] THEN MESON_TAC[]; ALL_TAC] THEN TRANS_TAC CARD_EQ_TRANS `s:A->bool` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC CARD_EQ_TRANS `(s:A->bool *_c s) +_c (s *_c s) +_c (s *_c s)` THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CARD_ADD_CONG THEN CONJ_TAC) THEN MATCH_MP_TAC CARD_MUL_CONG THEN ASM_REWRITE_TAC[CARD_EQ_REFL] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN TRANS_TAC CARD_EQ_TRANS `(s:A->bool) +_c s +_c s` THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CARD_ADD_CONG THEN ASM_REWRITE_TAC[]); ALL_TAC] THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_ADDR] THEN TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c s` THEN ASM_SIMP_TAC[CARD_LE_ADD; CARD_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[EQ_C; IN_UNION] THEN DISCH_THEN(X_CHOOSE_TAC `S:(A#A)#A->bool`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:(A#A)#A. R(x) \/ S(x)`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `(s:A->bool) UNION d`; SIMP_TAC[SUBSET; IN]; SUBGOAL_THEN `~(d:A->bool = {})` MP_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `FINITE:(A->bool)->bool`) THEN REWRITE_TAC[FINITE_RULES; GSYM INFINITE] THEN ASM_MESON_TAC[CARD_INFINITE_CONG]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME `a:A IN d`) o last o CONJUNCTS) THEN DISCH_THEN(MP_TAC o EXISTENCE) THEN DISCH_THEN(X_CHOOSE_THEN `b:A#A` (CONJUNCTS_THEN ASSUME_TAC)) THEN REWRITE_TAC[EXTENSION; NOT_FORALL_THM] THEN EXISTS_TAC `(b:A#A,a:A)` THEN ASM_REWRITE_TAC[IN] THEN DISCH_THEN(fun th -> FIRST_ASSUM (MP_TAC o CONJUNCT2 o C MATCH_MP th o CONJUNCT1)) THEN MAP_EVERY UNDISCH_TAC [`a:A IN d`; `(d:A->bool) SUBSET (k DIFF s)`] THEN REWRITE_TAC[SUBSET; IN_DIFF] THEN MESON_TAC[]] THEN REWRITE_TAC[INFINITE; FINITE_UNION; DE_MORGAN_THM] THEN ASM_REWRITE_TAC[GSYM INFINITE] THEN CONJ_TAC THENL [MAP_EVERY UNDISCH_TAC [`(d:A->bool) SUBSET (k DIFF s)`; `(s:A->bool) SUBSET k`] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF] THEN MESON_TAC[]; ALL_TAC] THEN REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl)) THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_UNIQUE_THM; EXISTS_PAIR_THM; IN_CARD_MUL; IN_UNION; PAIR_EQ] THEN MAP_EVERY UNDISCH_TAC [`(s:A->bool) SUBSET k`; `(d:A->bool) SUBSET (k DIFF s)`] THEN REWRITE_TAC[SUBSET; EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_DIFF] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT DISCH_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; ASM_MESON_TAC[]; ALL_TAC] THEN GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [ALL_TAC; ASM_MESON_TAC[]] THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th o last o CONJUNCTS)) THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Preservation of finiteness. *) (* ------------------------------------------------------------------------- *) let CARD_ADD_FINITE = prove (`!s t. FINITE s /\ FINITE t ==> FINITE(s +_c t)`, SIMP_TAC[add_c; FINITE_UNION; SIMPLE_IMAGE; FINITE_IMAGE]);; let CARD_ADD_FINITE_EQ = prove (`!s:A->bool t:B->bool. FINITE(s +_c t) <=> FINITE s /\ FINITE t`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CARD_ADD_FINITE] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE) THEN REWRITE_TAC[CARD_LE_ADDL; CARD_LE_ADDR]);; let CARD_MUL_FINITE = prove (`!s t. FINITE s /\ FINITE t ==> FINITE(s *_c t)`, SIMP_TAC[mul_c; FINITE_PRODUCT]);; let CARD_MUL_FINITE_EQ = prove (`!s:A->bool t:B->bool. FINITE(s *_c t) <=> s = {} \/ t = {} \/ FINITE s /\ FINITE t`, REWRITE_TAC[mul_c; GSYM CROSS; FINITE_CROSS_EQ]);; (* ------------------------------------------------------------------------- *) (* Hence the "absorption laws" for arithmetic with an infinite cardinal. *) (* ------------------------------------------------------------------------- *) let CARD_MUL_ABSORB_LE = prove (`!s:A->bool t:B->bool. INFINITE(t) /\ s <=_c t ==> s *_c t <=_c t`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `(t:B->bool) *_c t` THEN ASM_SIMP_TAC[CARD_LE_MUL; CARD_LE_REFL; CARD_SQUARE_INFINITE; CARD_EQ_IMP_LE]);; let CARD_MUL2_ABSORB_LE = prove (`!s:A->bool t:B->bool u:C->bool. INFINITE(u) /\ s <=_c u /\ t <=_c u ==> s *_c t <=_c u`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `(s:A->bool) *_c (u:C->bool)` THEN ASM_SIMP_TAC[CARD_MUL_ABSORB_LE] THEN MATCH_MP_TAC CARD_LE_MUL THEN ASM_REWRITE_TAC[CARD_LE_REFL]);; let CARD_ADD_ABSORB_LE = prove (`!s:A->bool t:B->bool. INFINITE(t) /\ s <=_c t ==> s +_c t <=_c t`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `(t:B->bool) *_c t` THEN ASM_SIMP_TAC[CARD_SQUARE_INFINITE; CARD_EQ_IMP_LE] THEN TRANS_TAC CARD_LE_TRANS `(t:B->bool) +_c t` THEN ASM_SIMP_TAC[CARD_ADD_LE_MUL_INFINITE; CARD_LE_ADD; CARD_LE_REFL]);; let CARD_ADD2_ABSORB_LE = prove (`!s:A->bool t:B->bool u:C->bool. INFINITE(u) /\ s <=_c u /\ t <=_c u ==> s +_c t <=_c u`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c (u:C->bool)` THEN ASM_SIMP_TAC[CARD_ADD_ABSORB_LE] THEN MATCH_MP_TAC CARD_LE_ADD THEN ASM_REWRITE_TAC[CARD_LE_REFL]);; let CARD_MUL_ABSORB = prove (`!s:A->bool t:B->bool. INFINITE(t) /\ ~(s = {}) /\ s <=_c t ==> s *_c t =_c t`, SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_MUL_ABSORB_LE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:B. (a:A,x)` THEN ASM_SIMP_TAC[IN_CARD_MUL; PAIR_EQ]);; let CARD_ADD_ABSORB_LEFT = prove (`!s:A->bool t:B->bool. INFINITE(t) /\ s <=_c t ==> s +_c t =_c t`, SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_ADDL; CARD_ADD_ABSORB_LE]);; let CARD_ADD_ABSORB_RIGHT = prove (`!s:A->bool t:B->bool. INFINITE(s) /\ t <=_c s ==> s +_c t =_c s`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_EQ_TRANS `(t:B->bool) +_c (s:A->bool)` THEN ASM_SIMP_TAC[CARD_ADD_ABSORB_LEFT; CARD_ADD_SYM]);; let CARD_UNION_ABSORB_LEFT = prove (`!s t:A->bool. INFINITE(t) /\ s <=_c t ==> s UNION t =_c t`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN SIMP_TAC[CARD_LE_SUBSET; SUBSET_UNION] THEN TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c (t:A->bool)` THEN REWRITE_TAC[UNION_LE_ADD_C] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ASM_SIMP_TAC[CARD_ADD_ABSORB_LEFT]);; let CARD_UNION_ABSORB_RIGHT = prove (`!s t:A->bool. INFINITE(s) /\ t <=_c s ==> s UNION t =_c s`, ONCE_REWRITE_TAC[UNION_COMM] THEN REWRITE_TAC[CARD_UNION_ABSORB_LEFT]);; let CARD_ADD2_ABSORB_LT = prove (`!s:A->bool t:B->bool u:C->bool. INFINITE u /\ s <_c u /\ t <_c u ==> s +_c t <_c u`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE((s:A->bool) +_c (t:B->bool))` THEN ASM_SIMP_TAC[CARD_LT_FINITE_INFINITE] THEN DISJ_CASES_TAC(ISPECL [`s:A->bool`; `t:B->bool`] CARD_LE_TOTAL) THENL [ASM_CASES_TAC `FINITE(t:B->bool)` THENL [ASM_MESON_TAC[CARD_LE_FINITE; CARD_ADD_FINITE]; TRANS_TAC CARD_LET_TRANS `t:B->bool`]; ASM_CASES_TAC `FINITE(s:A->bool)` THENL [ASM_MESON_TAC[CARD_LE_FINITE; CARD_ADD_FINITE]; TRANS_TAC CARD_LET_TRANS `s:A->bool`]] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_ADD2_ABSORB_LE THEN ASM_REWRITE_TAC[INFINITE; CARD_LE_REFL]);; let CARD_DIFF_ABSORB = prove (`!s t:A->bool. INFINITE s /\ t <_c s ==> s DIFF t =_c s`, SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_SUBSET; SUBSET_DIFF] THEN REWRITE_TAC[GSYM CARD_NOT_LT] THEN REPEAT STRIP_TAC THEN MP_TAC(SET_RULE `s SUBSET (s DIFF t) UNION t:A->bool`) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LET_TRANS `(s DIFF t:A->bool) +_c t` THEN ASM_SIMP_TAC[UNION_LE_ADD_C; CARD_ADD2_ABSORB_LT]);; let CARD_LT_ADD = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s <_c s' /\ t <_c t' ==> s +_c t <_c s' +_c t'`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE((s':B->bool) +_c (t':D->bool))` THENL [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [CARD_ADD_FINITE_EQ]) THEN SUBGOAL_THEN `FINITE(s:A->bool) /\ FINITE(t:C->bool)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE) o MATCH_MP CARD_LT_IMP_LE) THEN ASM_REWRITE_TAC[]; MAP_EVERY UNDISCH_TAC [`(s:A->bool) <_c (s':B->bool)`; `(t:C->bool) <_c (t':D->bool)`] THEN ASM_SIMP_TAC[CARD_LT_CARD; CARD_ADD_FINITE; CARD_ADD_C] THEN ARITH_TAC]; MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN ASM_REWRITE_TAC[INFINITE] THEN CONJ_TAC THENL [TRANS_TAC CARD_LTE_TRANS `s':B->bool` THEN ASM_REWRITE_TAC[CARD_LE_ADDR]; TRANS_TAC CARD_LTE_TRANS `t':D->bool` THEN ASM_REWRITE_TAC[CARD_LE_ADDL]]]);; let CARD_LE_UNIONS2 = prove (`!u:((A->bool)->bool) k:B->bool l:C->bool. u <=_c k /\ (!s. s IN u ==> s <=_c l) ==> UNIONS u <=_c k *_c l`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LE_C_IMAGE_SUBSET] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:B->A->bool`; `g:(A->bool)->C->A`] THEN STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `IMAGE (\(x,y). (g:(A->bool)->C->A) (f x) y) ((k:B->bool) *_c (l:C->bool))` THEN REWRITE_TAC[CARD_LE_IMAGE] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_IMAGE; mul_c; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN ASM SET_TAC[]);; let CARD_LE_UNIONS = prove (`!k:B->bool u:(A->bool)->bool. INFINITE k /\ u <=_c k /\ (!s. s IN u ==> s <=_c k) ==> UNIONS u <=_c k`, REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o MATCH_MP CARD_LE_UNIONS2)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_SQUARE_INFINITE THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some more ad-hoc but useful theorems. *) (* ------------------------------------------------------------------------- *) let CARD_MUL_LT_LEMMA = prove (`!s t:B->bool u. s <=_c t /\ t <_c u /\ INFINITE u ==> s *_c t <_c u`, REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(t:B->bool)` THENL [REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[CARD_NOT_LT; INFINITE] THEN ASM_MESON_TAC[CARD_LE_FINITE; CARD_MUL_FINITE]; ASM_MESON_TAC[INFINITE; CARD_MUL_ABSORB_LE; CARD_LET_TRANS]]);; let CARD_MUL_LT_INFINITE = prove (`!s:A->bool t:B->bool u. s <_c u /\ t <_c u /\ INFINITE u ==> s *_c t <_c u`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(ISPECL [`s:A->bool`; `t:B->bool`] CARD_LE_TOTAL) THENL [ASM_MESON_TAC[CARD_MUL_SYM; CARD_MUL_LT_LEMMA]; STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `t:B->bool *_c s:A->bool` THEN ASM_MESON_TAC[CARD_EQ_IMP_LE; CARD_MUL_SYM; CARD_MUL_LT_LEMMA]]);; (* ------------------------------------------------------------------------- *) (* Cantor's theorem. *) (* ------------------------------------------------------------------------- *) let CANTOR_THM = prove (`!s:A->bool. s <_c {t | t SUBSET s}`, GEN_TAC THEN REWRITE_TAC[lt_c] THEN CONJ_TAC THENL [REWRITE_TAC[le_c] THEN EXISTS_TAC `(=):A->A->bool` THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; SUBSET; IN] THEN MESON_TAC[]; REWRITE_TAC[LE_C; IN_ELIM_THM; SURJECTIVE_RIGHT_INVERSE] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `g:A->(A->bool)` THEN DISCH_THEN(MP_TAC o SPEC `\x:A. s(x) /\ ~(g x x)`) THEN REWRITE_TAC[SUBSET; IN; FUN_EQ_THM] THEN MESON_TAC[]]);; let CANTOR_THM_UNIV = prove (`(UNIV:A->bool) <_c (UNIV:(A->bool)->bool)`, MP_TAC(ISPEC `UNIV:A->bool` CANTOR_THM) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; SUBSET; IN_UNIV; IN_ELIM_THM]);; (* ------------------------------------------------------------------------- *) (* Lemmas about countability. *) (* ------------------------------------------------------------------------- *) let NUM_COUNTABLE = prove (`COUNTABLE(:num)`, REWRITE_TAC[COUNTABLE; ge_c; CARD_LE_REFL]);; let COUNTABLE_ALT = prove (`!s. COUNTABLE s <=> s <=_c (:num)`, REWRITE_TAC[COUNTABLE; ge_c]);; let COUNTABLE_CASES = prove (`!s. COUNTABLE s <=> FINITE s \/ s =_c (:num)`, REWRITE_TAC[COUNTABLE_ALT; FINITE_CARD_LT; CARD_LE_LT]);; let CARD_LE_COUNTABLE = prove (`!s t:A->bool. COUNTABLE t /\ s <=_c t ==> COUNTABLE s`, REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `t:A->bool` THEN ASM_REWRITE_TAC[]);; let CARD_EQ_COUNTABLE = prove (`!s t:A->bool. COUNTABLE t /\ s =_c t ==> COUNTABLE s`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_COUNTABLE]);; let CARD_COUNTABLE_CONG = prove (`!s t. s =_c t ==> (COUNTABLE s <=> COUNTABLE t)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_COUNTABLE]);; let COUNTABLE_SUBSET = prove (`!s t:A->bool. COUNTABLE t /\ s SUBSET t ==> COUNTABLE s`, REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `t:A->bool` THEN ASM_SIMP_TAC[CARD_LE_SUBSET]);; let COUNTABLE_RESTRICT = prove (`!s P. COUNTABLE s ==> COUNTABLE {x | x IN s /\ P x}`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[]);; let COUNTABLE_SUBSET_NUM = prove (`!s:num->bool. COUNTABLE s`, MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV]);; let FINITE_IMP_COUNTABLE = prove (`!s. FINITE s ==> COUNTABLE s`, SIMP_TAC[FINITE_CARD_LT; lt_c; COUNTABLE; ge_c]);; let COUNTABLE_IMAGE = prove (`!f:A->B s. COUNTABLE s ==> COUNTABLE (IMAGE f s)`, REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `s:A->bool` THEN ASM_SIMP_TAC[CARD_LE_IMAGE]);; let COUNTABLE_IMAGE_INJ_GENERAL = prove (`!(f:A->B) A s. (!x y. x IN s /\ y IN s /\ f(x) = f(y) ==> x = y) /\ COUNTABLE A ==> COUNTABLE {x | x IN s /\ f(x) IN A}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (g:B->A) A` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);; let COUNTABLE_IMAGE_INJ_EQ = prove (`!(f:A->B) s. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) ==> (COUNTABLE(IMAGE f s) <=> COUNTABLE s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP COUNTABLE_IMAGE_INJ_GENERAL) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; let COUNTABLE_IMAGE_INJ = prove (`!(f:A->B) A. (!x y. (f(x) = f(y)) ==> (x = y)) /\ COUNTABLE A ==> COUNTABLE {x | f(x) IN A}`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`f:A->B`; `A:B->bool`; `UNIV:A->bool`] COUNTABLE_IMAGE_INJ_GENERAL) THEN REWRITE_TAC[IN_UNIV]);; let COUNTABLE_EMPTY = prove (`COUNTABLE {}`, SIMP_TAC[FINITE_IMP_COUNTABLE; FINITE_RULES]);; let COUNTABLE_INTER = prove (`!s t. COUNTABLE s \/ COUNTABLE t ==> COUNTABLE (s INTER t)`, REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN REPEAT GEN_TAC THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[]);; let COUNTABLE_UNION_IMP = prove (`!s t:A->bool. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s UNION t)`, REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c (t:A->bool)` THEN ASM_SIMP_TAC[CARD_ADD2_ABSORB_LE; num_INFINITE; UNION_LE_ADD_C]);; let COUNTABLE_UNION = prove (`!s t:A->bool. COUNTABLE(s UNION t) <=> COUNTABLE s /\ COUNTABLE t`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COUNTABLE_UNION_IMP] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[]);; let COUNTABLE_SING = prove (`!x. COUNTABLE {x}`, SIMP_TAC[FINITE_IMP_COUNTABLE; FINITE_SING]);; let COUNTABLE_INSERT = prove (`!x s. COUNTABLE(x INSERT s) <=> COUNTABLE s`, ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN REWRITE_TAC[COUNTABLE_UNION; COUNTABLE_SING]);; let COUNTABLE_DELETE = prove (`!x:A s. COUNTABLE(s DELETE x) <=> COUNTABLE s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:A) IN s` THEN ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `COUNTABLE((x:A) INSERT (s DELETE x))` THEN CONJ_TAC THENL [REWRITE_TAC[COUNTABLE_INSERT]; AP_TERM_TAC THEN ASM SET_TAC[]]);; let COUNTABLE_DIFF_FINITE = prove (`!s t. FINITE s ==> (COUNTABLE(t DIFF s) <=> COUNTABLE t)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[DIFF_EMPTY; SET_RULE `s DIFF (x INSERT t) = (s DIFF t) DELETE x`; COUNTABLE_DELETE]);; let COUNTABLE_CROSS = prove (`!s t. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s CROSS t)`, REWRITE_TAC[COUNTABLE; ge_c; CROSS; GSYM mul_c] THEN SIMP_TAC[CARD_MUL2_ABSORB_LE; num_INFINITE]);; let COUNTABLE_AS_IMAGE_SUBSET = prove (`!s. COUNTABLE s ==> ?f. s SUBSET (IMAGE f (:num))`, REWRITE_TAC[COUNTABLE; ge_c; LE_C; SUBSET; IN_IMAGE] THEN MESON_TAC[]);; let COUNTABLE_AS_IMAGE_SUBSET_EQ = prove (`!s:A->bool. COUNTABLE s <=> ?f. s SUBSET (IMAGE f (:num))`, REWRITE_TAC[COUNTABLE; ge_c; LE_C; SUBSET; IN_IMAGE] THEN MESON_TAC[]);; let COUNTABLE_AS_IMAGE = prove (`!s:A->bool. COUNTABLE s /\ ~(s = {}) ==> ?f. s = IMAGE f (:num)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP COUNTABLE_AS_IMAGE_SUBSET) THEN DISCH_THEN(X_CHOOSE_TAC `f:num->A`) THEN EXISTS_TAC `\n. if (f:num->A) n IN s then f n else a` THEN ASM SET_TAC[]);; let FORALL_COUNTABLE_AS_IMAGE = prove (`(!d. COUNTABLE d ==> P d) <=> P {} /\ (!f. P(IMAGE f (:num)))`, MESON_TAC[COUNTABLE_AS_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; COUNTABLE_EMPTY]);; let COUNTABLE_AS_INJECTIVE_IMAGE = prove (`!s. COUNTABLE s /\ INFINITE s ==> ?f. s = IMAGE f (:num) /\ (!m n. f(m) = f(n) ==> m = n)`, GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[INFINITE_CARD_LE; COUNTABLE; ge_c] THEN REWRITE_TAC[CARD_LE_ANTISYM; eq_c] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; let COUNTABLE_AS_IMAGE_NUM_SUBSET,COUNTABLE_AS_INJECTIVE_IMAGE_SUBSET = (CONJ_PAIR o prove) (`(!s. COUNTABLE s <=> ?(f:num->A) k. s = IMAGE f k) /\ (!s. COUNTABLE s <=> ?(f:num->A) k. s = IMAGE f k /\ (!m n. m IN k /\ n IN k /\ f m = f n ==> m = n))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:A->bool` THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (q ==> p) /\ (p ==> r) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM; COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM]; DISCH_TAC THEN ASM_CASES_TAC `FINITE(s:A->bool)` THENL [ASM_MESON_TAC[FINITE_INDEX_NUMBERS]; ASM_MESON_TAC[COUNTABLE_AS_INJECTIVE_IMAGE; INFINITE]]]);; let COUNTABLE_UNIONS = prove (`!A:(A->bool)->bool. COUNTABLE A /\ (!s. s IN A ==> COUNTABLE s) ==> COUNTABLE (UNIONS A)`, REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_UNIONS THEN ASM_REWRITE_TAC[num_INFINITE]);; let COUNTABLE_PRODUCT_DEPENDENT = prove (`!f:A->B->C s t. COUNTABLE s /\ (!x. x IN s ==> COUNTABLE(t x)) ==> COUNTABLE {f x y | x IN s /\ y IN (t x)}`, REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `{(f:A->B->C) x y | x IN s /\ y IN (t x)} = IMAGE (\(x,y). f x y) {(x,y) | x IN s /\ y IN (t x)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN SET_TAC[]; MATCH_MP_TAC COUNTABLE_IMAGE THEN POP_ASSUM MP_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COUNTABLE_AS_IMAGE_SUBSET_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f:num->A`) MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `g:A->num->B`) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\(m,n). (f:num->A) m,(g:A->num->B)(f m) n) ((:num) CROSS (:num))` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; NUM_COUNTABLE] THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN REWRITE_TAC[IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM; IN_CROSS; IN_UNIV] THEN ASM SET_TAC[]);; let COUNTABLE_CARD_ADD = prove (`!s:A->bool t:B->bool. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s +_c t)`, REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `(:num) +_c (:num)` THEN ASM_SIMP_TAC[CARD_LE_ADD] THEN MATCH_MP_TAC CARD_ADD_ABSORB_LE THEN REWRITE_TAC[num_INFINITE; CARD_LE_REFL]);; let COUNTABLE_CARD_ADD_EQ = prove (`!s:A->bool t:B->bool. COUNTABLE(s +_c t) <=> COUNTABLE s /\ COUNTABLE t`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COUNTABLE_CARD_ADD] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_COUNTABLE) THEN REWRITE_TAC[CARD_LE_ADDL; CARD_LE_ADDR]);; let COUNTABLE_CARD_MUL = prove (`!s:A->bool t:B->bool. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s *_c t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[mul_c] THEN ASM_SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT]);; let COUNTABLE_CARD_MUL_EQ = prove (`!s:A->bool t:B->bool. COUNTABLE(s *_c t) <=> s = {} \/ t = {} \/ COUNTABLE s /\ COUNTABLE t`, REPEAT GEN_TAC THEN REWRITE_TAC[mul_c] THEN MAP_EVERY ASM_CASES_TAC [`s:A->bool = {}`; `t:B->bool = {}`] THEN ASM_REWRITE_TAC[COUNTABLE_EMPTY; EMPTY_GSPEC; NOT_IN_EMPTY; SET_RULE `{x,y | F} = {}`] THEN EQ_TAC THEN SIMP_TAC[REWRITE_RULE[mul_c] COUNTABLE_CARD_MUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THENL [EXISTS_TAC `IMAGE FST ((s:A->bool) *_c (t:B->bool))`; EXISTS_TAC `IMAGE SND ((s:A->bool) *_c (t:B->bool))`] THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; mul_c; SUBSET; IN_IMAGE; EXISTS_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN ASM SET_TAC[]);; let CARD_EQ_PCROSS = prove (`!s:A^M->bool t:A^N->bool. s PCROSS t =_c s *_c t`, REPEAT GEN_TAC THEN REWRITE_TAC[EQ_C_BIJECTIONS; mul_c] THEN EXISTS_TAC `\z:A^(M,N)finite_sum. fstcart z,sndcart z` THEN EXISTS_TAC `\(x:A^M,y:A^N). pastecart x y` THEN REWRITE_TAC[FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_ELIM_PAIR_THM; PASTECART_FST_SND] THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);; let COUNTABLE_PCROSS_EQ = prove (`!s:A^M->bool t:A^N->bool. COUNTABLE(s PCROSS t) <=> s = {} \/ t = {} \/ COUNTABLE s /\ COUNTABLE t`, REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `COUNTABLE((s:A^M->bool) *_c (t:A^N->bool))` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_COUNTABLE_CONG THEN REWRITE_TAC[CARD_EQ_PCROSS]; REWRITE_TAC[COUNTABLE_CARD_MUL_EQ]]);; let COUNTABLE_PCROSS = prove (`!s:A^M->bool t:A^N->bool. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s PCROSS t)`, SIMP_TAC[COUNTABLE_PCROSS_EQ]);; let COUNTABLE_CART = prove (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> COUNTABLE {x | P i x}) ==> COUNTABLE {v:A^N | !i. 1 <= i /\ i <= dimindex(:N) ==> P i (v$i)}`, GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!n. n <= dimindex(:N) ==> COUNTABLE {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n ==> P i (v$i)) /\ (!i. 1 <= i /\ i <= dimindex(:N) /\ n < i ==> v$i = @x. F)}` (MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL; LET_ANTISYM] THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= n /\ i <= 0 <=> F`] THEN SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n /\ 0 < i <=> 1 <= i /\ i <= n`] THEN SUBGOAL_THEN `{v | !i. 1 <= i /\ i <= dimindex (:N) ==> v$i = (@x. F)} = {(lambda i. @x. F):A^N}` (fun th -> SIMP_TAC[COUNTABLE_SING;th]) THEN SIMP_TAC[EXTENSION; IN_SING; IN_ELIM_THM; CART_EQ; LAMBDA_BETA]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\(x:A,v:A^N). (lambda i. if i = SUC n then x else v$i):A^N) {x,v | x IN {x:A | P (SUC n) x} /\ v IN {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n ==> P i (v$i)) /\ (!i. 1 <= i /\ i <= dimindex (:N) /\ n < i ==> v$i = (@x. F))}}` THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_IMAGE THEN ASM_SIMP_TAC[REWRITE_RULE[CROSS] COUNTABLE_CROSS; ARITH_RULE `1 <= SUC n`; ARITH_RULE `SUC n <= m ==> n <= m`]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN X_GEN_TAC `v:A^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `(v:A^N)$(SUC n)` THEN EXISTS_TAC `(lambda i. if i = SUC n then @x. F else (v:A^N)$i):A^N` THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; ARITH_RULE `i <= n ==> ~(i = SUC n)`] THEN ASM_MESON_TAC[LE; ARITH_RULE `1 <= SUC n`; ARITH_RULE `n < i /\ ~(i = SUC n) ==> SUC n < i`]);; let EXISTS_COUNTABLE_SUBSET_IMAGE_INJ = prove (`!P f s. (?t. COUNTABLE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. COUNTABLE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) /\ P (IMAGE f t))`, ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[EXISTS_SUBSET_IMAGE_INJ] THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[COUNTABLE_IMAGE_INJ_EQ]);; let FORALL_COUNTABLE_SUBSET_IMAGE_INJ = prove (`!P f s. (!t. COUNTABLE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. COUNTABLE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) ==> P(IMAGE f t))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MESON[] `(!t. p t) <=> ~(?t. ~p t)`] THEN REWRITE_TAC[NOT_IMP; EXISTS_COUNTABLE_SUBSET_IMAGE_INJ; GSYM CONJ_ASSOC]);; let EXISTS_COUNTABLE_SUBSET_IMAGE = prove (`!P f s. (?t. COUNTABLE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. COUNTABLE t /\ t SUBSET s /\ P (IMAGE f t))`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE_INJ] THEN MESON_TAC[]; MESON_TAC[COUNTABLE_IMAGE; IMAGE_SUBSET]]);; let FORALL_COUNTABLE_SUBSET_IMAGE = prove (`!P f s. (!t. COUNTABLE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. COUNTABLE t /\ t SUBSET s ==> P(IMAGE f t))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MESON[] `(!x. P x) <=> ~(?x. ~P x)`] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; EXISTS_COUNTABLE_SUBSET_IMAGE]);; let COUNTABLE_SUBSET_IMAGE = prove (`!f:A->B s t. COUNTABLE(t) /\ t SUBSET (IMAGE f s) <=> ?s'. COUNTABLE s' /\ s' SUBSET s /\ (t = IMAGE f s')`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[COUNTABLE_IMAGE; IMAGE_SUBSET]] THEN SPEC_TAC(`t:B->bool`,`t:B->bool`) THEN REWRITE_TAC[FORALL_COUNTABLE_SUBSET_IMAGE] THEN MESON_TAC[]);; let COUNTABLE_FL = prove (`!l:A#A->bool. COUNTABLE(fl l) <=> COUNTABLE l`, GEN_TAC THEN REWRITE_TAC[FL] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP COUNTABLE_CROSS o W CONJ) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_CROSS] THEN SET_TAC[]; DISCH_THEN((fun th -> MP_TAC(ISPEC `FST:A#A->A` th) THEN MP_TAC(ISPEC `SND:A#A->A` th)) o MATCH_MP COUNTABLE_IMAGE) THEN REWRITE_TAC[IMP_IMP; GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_CROSS; IN_UNION; IN_IMAGE] THEN REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_THM] THEN REWRITE_TAC[IN] THEN SET_TAC[]]);; let COUNTABLE_UNION_OF_INC = prove (`!P s:A->bool. P s ==> (COUNTABLE UNION_OF P) s`, SIMP_TAC[UNION_OF_INC; COUNTABLE_SING]);; let COUNTABLE_INTERSECTION_OF_INC = prove (`!P s:A->bool. P s ==> (COUNTABLE INTERSECTION_OF P) s`, SIMP_TAC[INTERSECTION_OF_INC; COUNTABLE_SING]);; let COUNTABLE_UNION_OF_COMPLEMENT = prove (`!P s. (COUNTABLE UNION_OF P) s <=> (COUNTABLE INTERSECTION_OF (\s. P((:A) DIFF s))) ((:A) DIFF s)`, REPEAT GEN_TAC THEN REWRITE_TAC[UNION_OF; INTERSECTION_OF] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:(A->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\c. (:A) DIFF c) u` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; COMPL_COMPL] THEN ONCE_REWRITE_TAC[UNIONS_INTERS; INTERS_UNIONS] THEN REWRITE_TAC[SET_RULE `{f y | y IN IMAGE g s} = IMAGE (\x. f(g x)) s`] THEN ASM_REWRITE_TAC[IMAGE_ID; COMPL_COMPL]);; let COUNTABLE_INTERSECTION_OF_COMPLEMENT = prove (`!P s. (COUNTABLE INTERSECTION_OF P) s <=> (COUNTABLE UNION_OF (\s. P((:A) DIFF s))) ((:A) DIFF s)`, REWRITE_TAC[COUNTABLE_UNION_OF_COMPLEMENT] THEN REWRITE_TAC[ETA_AX; COMPL_COMPL]);; let COUNTABLE_UNION_OF_EXPLICIT = prove (`!P s:A->bool. P {} ==> ((COUNTABLE UNION_OF P) s <=> ?t. (!n. P(t n)) /\ UNIONS {t n | n IN (:num)} = s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[UNION_OF; LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `u:(A->bool)->bool` THEN ASM_CASES_TAC `u:(A->bool)->bool = {}` THENL [ASM_REWRITE_TAC[UNIONS_0] THEN DISCH_THEN(SUBST1_TAC o SYM o last o CONJUNCTS) THEN EXISTS_TAC `(\n. {}):num->A->bool` THEN ASM_REWRITE_TAC[UNIONS_GSPEC; NOT_IN_EMPTY; EMPTY_GSPEC]; STRIP_TAC THEN MP_TAC(ISPEC `u:(A->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]; X_GEN_TAC `t:num->A->bool` THEN STRIP_TAC THEN EXISTS_TAC `{t n:A->bool | n IN (:num)}` THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM]]);; let COUNTABLE_UNION_OF_ASCENDING = prove (`!P s:A->bool. P {} /\ (!t u. P t /\ P u ==> P(t UNION u)) ==> ((COUNTABLE UNION_OF P) s <=> ?t. (!n. P(t n)) /\ (!n. t n SUBSET t(SUC n)) /\ UNIONS {t n | n IN (:num)} = s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COUNTABLE_UNION_OF_EXPLICIT] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `t:num->A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\n. UNIONS {t m | m <= n}):num->A->bool` THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[LE] THEN REWRITE_TAC[SET_RULE `{f x | P x \/ Q x} = {f x | P x} UNION {f x | Q x}`; SET_RULE `{f x | x = a} = {f a}`; UNIONS_UNION] THEN ASM_SIMP_TAC[UNIONS_1]; REWRITE_TAC[UNIONS_GSPEC; LE] THEN SET_TAC[]; FIRST_X_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS) THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[LE_REFL]]);; let COUNTABLE_UNION_OF_IDEMPOT = prove (`!P:(A->bool)->bool. COUNTABLE UNION_OF COUNTABLE UNION_OF P = COUNTABLE UNION_OF P`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `s:A->bool` THEN EQ_TAC THEN REWRITE_TAC[COUNTABLE_UNION_OF_INC] THEN REWRITE_TAC[UNION_OF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:(A->bool)->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:(A->bool)->(A->bool)->bool` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE SND {s,t | s IN u /\ t IN (f:(A->bool)->(A->bool)->bool) s}` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_PRODUCT_DEPENDENT] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[UNIONS_IMAGE]] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]);; let COUNTABLE_INTERSECTION_OF_IDEMPOT = prove (`!P:(A->bool)->bool. COUNTABLE INTERSECTION_OF COUNTABLE INTERSECTION_OF P = COUNTABLE INTERSECTION_OF P`, REWRITE_TAC[COMPL_COMPL; ETA_AX; REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN REWRITE_TAC[COUNTABLE_UNION_OF_IDEMPOT]);; let COUNTABLE_UNION_OF_UNIONS = prove (`!P u:(A->bool)->bool. COUNTABLE u /\ (!s. s IN u ==> (COUNTABLE UNION_OF P) s) ==> (COUNTABLE UNION_OF P) (UNIONS u)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM COUNTABLE_UNION_OF_IDEMPOT] THEN ONCE_REWRITE_TAC[UNION_OF] THEN REWRITE_TAC[] THEN EXISTS_TAC `u:(A->bool)->bool` THEN ASM_REWRITE_TAC[]);; let COUNTABLE_UNION_OF_UNION = prove (`!P s t. (COUNTABLE UNION_OF P) s /\ (COUNTABLE UNION_OF P) t ==> (COUNTABLE UNION_OF P) (s UNION t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN ASM_REWRITE_TAC[COUNTABLE_INSERT; FORALL_IN_INSERT] THEN REWRITE_TAC[COUNTABLE_EMPTY; NOT_IN_EMPTY]);; let COUNTABLE_INTERSECTION_OF_INTERS = prove (`!P u:(A->bool)->bool. COUNTABLE u /\ (!s. s IN u ==> (COUNTABLE INTERSECTION_OF P) s) ==> (COUNTABLE INTERSECTION_OF P) (INTERS u)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM COUNTABLE_INTERSECTION_OF_IDEMPOT] THEN ONCE_REWRITE_TAC[INTERSECTION_OF] THEN REWRITE_TAC[] THEN EXISTS_TAC `u:(A->bool)->bool` THEN ASM_REWRITE_TAC[]);; let COUNTABLE_INTERSECTION_OF_INTER = prove (`!P s t. (COUNTABLE INTERSECTION_OF P) s /\ (COUNTABLE INTERSECTION_OF P) t ==> (COUNTABLE INTERSECTION_OF P) (s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN ASM_REWRITE_TAC[COUNTABLE_INSERT; FORALL_IN_INSERT] THEN REWRITE_TAC[COUNTABLE_EMPTY; NOT_IN_EMPTY]);; let COUNTABLE_UNION_OF_INTER = prove (`!P:(A->bool)->bool. (!s t. P s /\ P t ==> P(s INTER t)) ==> (!s t. (COUNTABLE UNION_OF P) s /\ (COUNTABLE UNION_OF P) t ==> (COUNTABLE UNION_OF P) (s INTER t))`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [UNION_OF] THEN REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[INTER_UNIONS] THEN REPLICATE_TAC 2 (MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC) THEN MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN ASM_SIMP_TAC[]);; let COUNTABLE_INTERSECTION_OF_UNION = prove (`!P:(A->bool)->bool. (!s t. P s /\ P t ==> P(s UNION t)) ==> (!s t. (COUNTABLE INTERSECTION_OF P) s /\ (COUNTABLE INTERSECTION_OF P) t ==> (COUNTABLE INTERSECTION_OF P) (s UNION t))`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`] THEN REWRITE_TAC[MESON[COMPL_COMPL] `(!s. P(UNIV DIFF s)) <=> (!s. P s)`] THEN MATCH_MP_TAC COUNTABLE_UNION_OF_INTER THEN ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (s INTER t) = (UNIV DIFF s) UNION (UNIV DIFF t)`]);; (* ------------------------------------------------------------------------- *) (* A countable chain has an "equivalent" omega-chain. *) (* ------------------------------------------------------------------------- *) let COUNTABLE_ASCENDING_CHAIN = prove (`!f:(A->bool)->bool. COUNTABLE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(n) SUBSET u(SUC n)) /\ UNIONS {u n | n IN (:num)} = UNIONS f`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:(A->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->A->bool` THEN DISCH_THEN(ASSUME_TAC o SYM) THEN EXISTS_TAC `\n. UNIONS(IMAGE (b:num->A->bool) (0..n))` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[NUMSEG_CLAUSES; LE_0; IMAGE_CLAUSES] THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; UNION_EMPTY] THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `a IN f /\ b IN f /\ (a UNION b = a \/ a UNION b = b) ==> (a UNION b) IN f`) THEN ASM_REWRITE_TAC[SET_RULE `a UNION b = a <=> b SUBSET a`; SET_RULE `a UNION b = b <=> a SUBSET b`] THEN ASM SET_TAC[]; GEN_TAC THEN REWRITE_TAC[NUMSEG_CLAUSES; LE_0] THEN SET_TAC[]; EXPAND_TAC "f" THEN REWRITE_TAC[UNIONS_GSPEC; UNIONS_IMAGE] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV; IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]]);; let COUNTABLE_DESCENDING_CHAIN = prove (`!f:(A->bool)->bool. COUNTABLE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(SUC n) SUBSET u(n)) /\ INTERS {u n | n IN (:num)} = INTERS f`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:(A->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->A->bool` THEN DISCH_THEN(ASSUME_TAC o SYM) THEN EXISTS_TAC `\n. INTERS(IMAGE (b:num->A->bool) (0..n))` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[NUMSEG_CLAUSES; LE_0; IMAGE_CLAUSES] THEN REWRITE_TAC[INTERS_0; INTERS_INSERT; INTER_UNIV] THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `a IN f /\ b IN f /\ (a INTER b = a \/ a INTER b = b) ==> (a INTER b) IN f`) THEN ASM_REWRITE_TAC[SET_RULE `a INTER b = a <=> a SUBSET b`; SET_RULE `a INTER b = b <=> b SUBSET a`] THEN ASM SET_TAC[]; GEN_TAC THEN REWRITE_TAC[NUMSEG_CLAUSES; LE_0] THEN SET_TAC[]; EXPAND_TAC "f" THEN REWRITE_TAC[INTERS_GSPEC; INTERS_IMAGE] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV; IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Cardinality of infinite list and cartesian product types. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_LIST_GEN = prove (`!s:A->bool. INFINITE(s) ==> {l | !x. MEM x l ==> x IN s} =_c s`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[le_c; IN_UNIV] THEN EXISTS_TAC `\x:A. [x]` THEN SIMP_TAC[CONS_11; IN_ELIM_THM; MEM]] THEN TRANS_TAC CARD_LE_TRANS `(:num) *_c (s:A->bool)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_MUL2_ABSORB_LE THEN ASM_REWRITE_TAC[GSYM INFINITE_CARD_LE; CARD_LE_REFL]] THEN SUBGOAL_THEN `s *_c s <=_c (s:A->bool)` MP_TAC THENL [MATCH_MP_TAC CARD_MUL2_ABSORB_LE THEN ASM_REWRITE_TAC[CARD_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[le_c; mul_c; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; PAIR_EQ] THEN REWRITE_TAC[IN_UNIV; LEFT_IMP_EXISTS_THM] THEN GEN_REWRITE_TAC I [FORALL_CURRY] THEN X_GEN_TAC `pair:A->A->A` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `?b:A. b IN s` CHOOSE_TAC THENL [ASM_MESON_TAC[INFINITE; FINITE_EMPTY; MEMBER_NOT_EMPTY]; ALL_TAC] THEN EXISTS_TAC `\l. LENGTH l,ITLIST (pair:A->A->A) l b` THEN REWRITE_TAC[PAIR_EQ; RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN SUBGOAL_THEN `!l:A list. (!x. MEM x l ==> x IN s) ==> (ITLIST pair l b) IN s` ASSUME_TAC THENL [LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; ITLIST] THEN ASM_MESON_TAC[]; CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN LIST_INDUCT_TAC THEN SIMP_TAC[LENGTH_EQ_NIL; LENGTH] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_SUC] THEN REWRITE_TAC[ITLIST; SUC_INJ; MEM; CONS_11] THEN REPEAT STRIP_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN ASM_MESON_TAC[]);; let CARD_EQ_LIST = prove (`INFINITE(:A) ==> (:A list) =_c (:A)`, DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_LIST_GEN) THEN REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`]);; let CARD_EQ_CART = prove (`INFINITE(:A) ==> (:A^N) =_c (:A)`, DISCH_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[le_c; IN_UNIV] THEN EXISTS_TAC `(\x. lambda i. x):A->A^N` THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[LE_REFL; DIMINDEX_GE_1]] THEN TRANS_TAC CARD_LE_TRANS `(:A list)` THEN ASM_SIMP_TAC[CARD_EQ_LIST; CARD_EQ_IMP_LE] THEN REWRITE_TAC[LE_C] THEN EXISTS_TAC `(\l. lambda i. EL i l):(A)list->A^N` THEN ASM_SIMP_TAC[CART_EQ; IN_UNIV; LAMBDA_BETA] THEN X_GEN_TAC `x:A^N` THEN SUBGOAL_THEN `!n f. ?l. !i. i < n ==> EL i l:A = f i` MP_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN X_GEN_TAC `f:num->A` THEN FIRST_X_ASSUM(MP_TAC o SPEC `\i. (f:num->A)(SUC i)`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l:A list` THEN DISCH_TAC THEN EXISTS_TAC `CONS ((f:num->A) 0) l` THEN INDUCT_TAC THEN ASM_SIMP_TAC[EL; HD; TL; LT_SUC]; DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)+1`; `\i. (x:A^N)$i`]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; ARITH_RULE `i < n + 1 <=> i <= n`] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Cardinality of the reals. This is done in a rather laborious way to avoid *) (* any dependence on the theories of analysis. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_REAL = prove (`(:real) =_c (:num->bool)`, let lemma = prove (`!s m n. sum (s INTER (m..n)) (\i. inv(&3 pow i)) < &3 / &2 / &3 pow m`, REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (m..n) (\i. inv(&3 pow i))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[FINITE_NUMSEG; INTER_SUBSET; REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS]; WF_INDUCT_TAC `n - m:num` THEN ASM_CASES_TAC `m:num <= n` THENL [ASM_SIMP_TAC[SUM_CLAUSES_LEFT] THEN ASM_CASES_TAC `m + 1 <= n` THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `SUC m`]) THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ADD1; REAL_POW_ADD]] THEN MATCH_MP_TAC(REAL_ARITH `a + j:real <= k ==> x < j ==> a + x < k`) THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_1] THEN REAL_ARITH_TAC; ALL_TAC]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE; GSYM NUMSEG_EMPTY]) THEN ASM_REWRITE_TAC[SUM_CLAUSES; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `inv x < &3 / &2 / x <=> &0 < inv x`] THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]]) in REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:num) *_c (:num->bool)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_MUL2_ABSORB_LE THEN REWRITE_TAC[INFINITE_CARD_LE] THEN SIMP_TAC[CANTOR_THM_UNIV; CARD_LT_IMP_LE; CARD_LE_REFL]] THEN TRANS_TAC CARD_LE_TRANS `(:num) *_c {x:real | &0 <= x}` THEN CONJ_TAC THENL [REWRITE_TAC[LE_C; mul_c; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM; IN_UNIV] THEN EXISTS_TAC `\(n,x:real). --(&1) pow n * x` THEN X_GEN_TAC `x:real` THEN MATCH_MP_TAC(MESON[] `P 0 \/ P 1 ==> ?n. P n`) THEN REWRITE_TAC[OR_EXISTS_THM] THEN EXISTS_TAC `abs x` THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CARD_LE_MUL THEN REWRITE_TAC[CARD_LE_REFL] THEN MP_TAC(ISPECL [`(:num)`; `(:num)`] CARD_MUL_ABSORB_LE) THEN REWRITE_TAC[CARD_LE_REFL; num_INFINITE] THEN REWRITE_TAC[le_c; mul_c; IN_UNIV; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[GSYM FORALL_PAIR_THM; INJECTIVE_LEFT_INVERSE] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`pair:num#num->num`; `unpair:num->num#num`] THEN DISCH_TAC THEN EXISTS_TAC `\x:real n:num. &(FST(unpair n)) * x <= &(SND(unpair n))` THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[IN_ELIM_THM; FUN_EQ_THM] THEN CONJ_TAC THENL [REWRITE_TAC[EQ_SYM_EQ; CONJ_ACI]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GENL [`p:num`; `q:num`] o SPEC `(pair:num#num->num) (p,q)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN MP_TAC(SPEC `y - x:real` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT; NOT_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `&2`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN MP_TAC(ISPEC `&p * x:real` REAL_ARCH_LT) THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH `x:real < &0 <=> ~(&0 <= x)`] THEN X_GEN_TAC `q:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN DISCH_THEN(K ALL_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN REWRITE_TAC[LT] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[le_c; IN_UNIV] THEN EXISTS_TAC `\s:num->bool. sup { sum (s INTER (0..n)) (\i. inv(&3 pow i)) | n IN (:num) }` THEN MAP_EVERY X_GEN_TAC [`x:num->bool`; `y:num->bool`] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[EXTENSION; NOT_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MAP_EVERY (fun w -> SPEC_TAC(w,w)) [`y:num->bool`; `x:num->bool`] THEN MATCH_MP_TAC(MESON[IN] `((!P Q n. R P Q n <=> R Q P n) /\ (!P Q. S P Q <=> S Q P)) /\ (!P Q. (?n. n IN P /\ ~(n IN Q) /\ R P Q n) ==> S P Q) ==> !P Q. (?n:num. ~(n IN P <=> n IN Q) /\ R P Q n) ==> S P Q`) THEN CONJ_TAC THENL [REWRITE_TAC[EQ_SYM_EQ]; REWRITE_TAC[]] THEN MAP_EVERY X_GEN_TAC [`x:num->bool`; `y:num->bool`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(REAL_ARITH `!z:real. y < z /\ z <= x ==> ~(x = y)`) THEN EXISTS_TAC `sum (x INTER (0..n)) (\i. inv(&3 pow i))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (y INTER (0..n)) (\i. inv(&3 pow i)) + &3 / &2 / &3 pow (SUC n)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]] THEN X_GEN_TAC `p:num` THEN ASM_CASES_TAC `n:num <= p` THENL [MATCH_MP_TAC(REAL_ARITH `!d. s:real = t + d /\ d <= e ==> s <= t + e`) THEN EXISTS_TAC `sum(y INTER (n+1..p)) (\i. inv (&3 pow i))` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[INTER; SUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SUM_COMBINE_R; LE_0]; SIMP_TAC[ADD1; lemma; REAL_LT_IMP_LE]]; MATCH_MP_TAC(REAL_ARITH `y:real <= x /\ &0 <= d ==> y <= x + d`) THEN SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_POW_LE] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC (SET_RULE `s SUBSET t ==> u INTER s SUBSET u INTER t`) THEN REWRITE_TAC[SUBSET_NUMSEG] THEN ASM_ARITH_TAC]; ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[INTER; SUM_RESTRICT_SET] THEN ASM_CASES_TAC `n = 0` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REWRITE_TAC[SUM_SING; NUMSEG_SING; real_pow] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_1; LE_0; REAL_ADD_RID] THEN MATCH_MP_TAC(REAL_ARITH `s:real = t /\ d < e ==> s + d < t + e`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ m <= n - 1 ==> m < n`]; REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 / &2 * x < x <=> &0 < x`] THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]]]]; MP_TAC(ISPEC `{ sum (x INTER (0..n)) (\i. inv(&3 pow i)) | n IN (:num) }` SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `&3 / &2 / &3 pow 0` THEN SIMP_TAC[lemma; REAL_LT_IMP_LE]]]);; let UNCOUNTABLE_REAL = prove (`~COUNTABLE(:real)`, REWRITE_TAC[COUNTABLE; CARD_NOT_LE; ge_c] THEN TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN REWRITE_TAC[CANTOR_THM_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_REAL]);; let CARD_EQ_REAL_IMP_UNCOUNTABLE = prove (`!s. s =_c (:real) ==> ~COUNTABLE s`, GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o ISPEC `(:real)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_EQ_COUNTABLE)) THEN REWRITE_TAC[UNCOUNTABLE_REAL] THEN ASM_MESON_TAC[CARD_EQ_SYM]);; let COUNTABLE_IMP_CARD_LT_REAL = prove (`!s:A->bool. COUNTABLE s ==> s <_c (:real)`, REWRITE_TAC[GSYM CARD_NOT_LE] THEN ASM_MESON_TAC[CARD_LE_COUNTABLE; UNCOUNTABLE_REAL]);; (* ------------------------------------------------------------------------- *) (* Cardinal exponentiation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("^_c",(24,"left"));; let exp_c = new_definition `s ^_c t = {f:B->A | (!x. x IN t ==> f x IN s) /\ (!x. ~(x IN t) ==> f x = @y. F)}`;; let CARD_EXP_UNIV = prove (`(:A) ^_c (:B) = (:B->A)`, REWRITE_TAC[exp_c; IN_UNIV] THEN SET_TAC[]);; let CARD_EXP_GRAPH = prove (`!s:A->bool t:B->bool. (s ^_c t) =_c {R:B->A->bool | (!x y. R x y ==> x IN t /\ y IN s) /\ (!x. x IN t ==> ?!y. R x y)}`, REPEAT GEN_TAC THEN REWRITE_TAC[EQ_C_BIJECTIONS; exp_c; FORALL_IN_GSPEC] THEN MAP_EVERY EXISTS_TAC [`\f:B->A x y. x IN t /\ f x = y`; `\(R:B->A->bool) x. if x IN t then @y. R x y else @y. F`] THEN SIMP_TAC[IN_ELIM_THM; FUN_EQ_THM] THEN MESON_TAC[]);; let CARD_EXP_GRAPH_PAIRED = prove (`!s:A->bool t:B->bool. (s ^_c t) =_c {R:B#A->bool | (!x y. R(x,y) ==> x IN t /\ y IN s) /\ (!x. x IN t ==> ?!y. R(x,y))}`, MP_TAC CARD_EXP_GRAPH THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN REWRITE_TAC[EQ_C_BIJECTIONS; FORALL_IN_GSPEC] THEN MAP_EVERY EXISTS_TAC [`\(R:B->A->bool) (x,y). R x y`; `\(R:B#A->bool) x y. R(x,y)`] THEN REWRITE_TAC[IN_ELIM_THM; FORALL_PAIR_THM; FUN_EQ_THM]);; let CARD_EXP_0 = prove (`!s c:C. (s:A->bool) ^_c ({}:B->bool) =_c {c}`, REPEAT GEN_TAC THEN REWRITE_TAC[exp_c; NOT_IN_EMPTY] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[CARD_EQ_CARD; FINITE_SING; CARD_SING]);; let CARD_EXP_ZERO = prove (`!s:B->bool c:C. ({}:A->bool) ^_c s =_c if s = {} then {c} else {}`, REPEAT GEN_TAC THEN REWRITE_TAC[exp_c] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> ~(!x. ~(x IN s))`] THEN REWRITE_TAC[CARD_EQ_EMPTY; EMPTY_GSPEC] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[CARD_EQ_CARD; FINITE_SING; CARD_SING]);; let CARD_EXP_ADD = prove (`!s:A->bool t:B->bool u:C->bool. s ^_c (t +_c u) =_c (s ^_c t) *_c (s ^_c u)`, REPEAT GEN_TAC THEN REWRITE_TAC[add_c; mul_c; exp_c; EQ_C_BIJECTIONS] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN MAP_EVERY EXISTS_TAC [`\f:B+C->A. (\x. if x IN t then f(INL x) else @x. F), (\x. if x IN u then f(INR x) else @x. F)`; `\(g:B->A,h:C->A) z. if ?x. x IN t /\ INL x = z then g(@x. x IN t /\ INL x = z) else if ?y. y IN u /\ INR y = z then h(@y. y IN u /\ INR y = z) else @y. F`] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN REWRITE_TAC[injectivity "sum"; distinctness "sum"; PAIR_EQ] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1; CONJ_ASSOC] THEN REWRITE_TAC[FUN_EQ_THM] THEN CONJ_TAC THENL [SIMP_TAC[]; MESON_TAC[]] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC sum_INDUCT THEN REWRITE_TAC[injectivity "sum"; distinctness "sum"; PAIR_EQ] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_MESON_TAC[injectivity "sum"; distinctness "sum"]);; let CARD_EXP_MUL = prove (`!s:A->bool t:B->bool u:C->bool. s ^_c (t *_c u) =_c (s ^_c t) ^_c u`, REPEAT GEN_TAC THEN REWRITE_TAC[mul_c; exp_c; EQ_C_BIJECTIONS] THEN MAP_EVERY EXISTS_TAC [`\f:B#C->A y. if y IN u then \x. f(x,y) else @x. F`; `\f:C->B->A (x,y). if x IN t /\ y IN u then f y x else @x. F`] THEN REWRITE_TAC[FORALL_IN_GSPEC; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; FORALL_PAIR_THM; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]);; let CARD_MUL_EXP = prove (`!s:A->bool t:B->bool u:C->bool. (s *_c t) ^_c u =_c (s ^_c u) *_c (t ^_c u)`, REPEAT GEN_TAC THEN REWRITE_TAC[mul_c; exp_c; EQ_C_BIJECTIONS] THEN MAP_EVERY EXISTS_TAC [`\f:C->A#B. (\x. if x IN u then FST(f x) else @x. F), (\x. if x IN u then SND(f x) else @x. F)`; `\(g:C->A,h:C->B) x. if x IN u then (g x,h x) else @x. F`] THEN REWRITE_TAC[FUN_EQ_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; FORALL_PAIR_THM; PAIR_EQ] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1; CONJ_ASSOC] THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[PAIR; PAIR_EQ]);; let CARD_EXP_SING = prove (`!s:A->bool b:B. (s ^_c {b}) =_c s`, REPEAT GEN_TAC THEN REWRITE_TAC[exp_c; EQ_C_BIJECTIONS] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_ELIM_THM; IN_SING] THEN MAP_EVERY EXISTS_TAC [`\f:(B->A). f b`; `\x:A y:B. if y = b then x else @y. F`] THEN SIMP_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; let CARD_LE_EXP_LEFT = prove (`!s:A->bool s':B->bool t:C->bool. s <=_c s' ==> s ^_c t <=_c s' ^_c t`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c; exp_c] THEN DISCH_THEN(X_CHOOSE_TAC `f:A->B`) THEN EXISTS_TAC `\(g:C->A) z:C. if z IN t then f(g z):B else @x. F` THEN SIMP_TAC[IN_ELIM_THM; FUN_EQ_THM] THEN ASM_MESON_TAC[]);; let CARD_LE_EXP_RIGHT = prove (`!s:A->bool t:B->bool t':C->bool. ~(s = {}) /\ t <=_c t' ==> s ^_c t <=_c s ^_c t'`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c; exp_c; GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:A`) (X_CHOOSE_THEN `f:B->C` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `h:C->B`) THEN EXISTS_TAC `\g:(B->A) c:C. if c IN t' then if h c IN t then g(h c) else a else @x:A. F` THEN SIMP_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:B->A`; `l:B->A`] THEN REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC THEN X_GEN_TAC `b:B` THEN ASM_CASES_TAC `(b:B) IN t` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:B->C) b`) THEN ASM_MESON_TAC[]);; let CARD_LE_EXP = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. ~(s = {}) /\ s <=_c s' /\ t <=_c t' ==> s ^_c t <=_c s' ^_c t'`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `(s:A->bool) ^_c (t':D->bool)` THEN ASM_SIMP_TAC[CARD_LE_EXP_RIGHT; CARD_LE_EXP_LEFT]);; let CARD_EXP_CONG = prove (`!s:A->bool s':B->bool t:C->bool t':D->bool. s =_c s' /\ t =_c t' ==> s ^_c t =_c s' ^_c t'`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t':D->bool = {}` THEN ASM_SIMP_TAC[CARD_EQ_EMPTY] THENL [REPEAT STRIP_TAC THEN TRANS_TAC CARD_EQ_TRANS `{0}` THEN REWRITE_TAC[CARD_EXP_0; ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EXP_0]; ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_CASES_TAC `t:C->bool = {}` THEN ASM_REWRITE_TAC[CARD_EQ_EMPTY]] THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_SIMP_TAC[CARD_EQ_EMPTY] THENL [STRIP_TAC THEN MP_TAC(ISPECL [`t:C->bool`; `0`] CARD_EXP_ZERO) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [CARD_EQ_SYM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_EQ_TRANS) THEN MP_TAC(INST_TYPE [`:B`,`:A`] (ISPECL [`t':D->bool`; `0`] CARD_EXP_ZERO)) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_CASES_TAC `s':B->bool = {}` THEN ASM_REWRITE_TAC[CARD_EQ_EMPTY] THEN ASM_SIMP_TAC[CARD_LE_EXP; GSYM CARD_LE_ANTISYM]]);; let CARD_EXP_FINITE = prove (`!s:A->bool t:B->bool. FINITE s /\ FINITE t ==> FINITE(s ^_c t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP FINITE_POWERSET o MATCH_MP FINITE_CROSS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE) THEN MP_TAC(ISPECL [`s:A->bool`; `t:B->bool`] CARD_EXP_GRAPH_PAIRED) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_IMP_LE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_CROSS] THEN SET_TAC[]);; let CARD_EXP_C = prove (`!s:A->bool t:B->bool. FINITE s /\ FINITE t ==> CARD(s ^_c t) = (CARD s) EXP (CARD t)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[CARD_CLAUSES; EXP] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM(ISPEC `0` CARD_SING)] THEN MATCH_MP_TAC CARD_EQ_CARD_IMP THEN SIMP_TAC[CARD_EXP_0; FINITE_SING]; MAP_EVERY X_GEN_TAC [`b:B`; `t:B->bool`] THEN STRIP_TAC] THEN TRANS_TAC EQ_TRANS `CARD((s:A->bool) ^_c ({b:B} +_c (t:B->bool)))` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_CARD_IMP THEN ASM_SIMP_TAC[CARD_EXP_FINITE; CARD_ADD_FINITE; FINITE_SING] THEN MATCH_MP_TAC CARD_EXP_CONG THEN REWRITE_TAC[CARD_EQ_REFL] THEN ASM_SIMP_TAC[CARD_EQ_CARD; FINITE_INSERT; CARD_ADD_FINITE; FINITE_EMPTY; CARD_ADD_C; CARD_SING; CARD_CLAUSES] THEN ARITH_TAC; ALL_TAC] THEN TRANS_TAC EQ_TRANS `CARD(((s:A->bool) ^_c {b:B}) *_c (s ^_c (t:B->bool)))` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_CARD_IMP THEN REWRITE_TAC[CARD_EXP_ADD] THEN ASM_SIMP_TAC[CARD_EXP_FINITE; CARD_MUL_FINITE; FINITE_SING]; ASM_SIMP_TAC[CARD_MUL_C; CARD_EXP_FINITE; FINITE_SING]] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CARD_EQ_CARD_IMP THEN ASM_SIMP_TAC[CARD_EXP_SING]);; let CARD_EXP_POWERSET = prove (`!s:A->bool. (:bool) ^_c s =_c {t | t SUBSET s}`, GEN_TAC THEN REWRITE_TAC[exp_c; EQ_C_BIJECTIONS; IN_UNIV] THEN MAP_EVERY EXISTS_TAC [`\P:A->bool. {x | x IN s /\ P x}`; `\t x:A. if x IN s then x IN t else @b. F`] THEN SIMP_TAC[IN_ELIM_THM] THEN SET_TAC[]);; let CARD_EXP_CANTOR = prove (`!s:A->bool. s <_c (:bool) ^_c s`, GEN_TAC THEN TRANS_TAC CARD_LTE_TRANS `{t:A->bool | t SUBSET s}` THEN REWRITE_TAC[CANTOR_THM] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EXP_POWERSET]);; let CARD_EXP_ABSORB = prove (`!s:A->bool t:B->bool. INFINITE t /\ (:bool) <=_c s /\ s <=_c (:bool) ^_c t ==> s ^_c t =_c (:bool) ^_c t`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN ASM_SIMP_TAC[CARD_LE_EXP_LEFT; CARD_LE_REFL] THEN TRANS_TAC CARD_LE_TRANS `((:bool) ^_c t) ^_c (t:B->bool)` THEN ASM_SIMP_TAC[CARD_LE_EXP_LEFT] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN TRANS_TAC CARD_EQ_TRANS `(:bool) ^_c ((t:B->bool) *_c t)` THEN SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EXP_MUL] THEN MATCH_MP_TAC CARD_EXP_CONG THEN ASM_SIMP_TAC[CARD_SQUARE_INFINITE; CARD_EQ_REFL]);; let CARD_EXP_LE_REAL = prove (`!s:A->bool t:B->bool. s <=_c (:real) /\ COUNTABLE t ==> s ^_c t <=_c (:real)`, REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[] THENL [W(MP_TAC o PART_MATCH lhand CARD_EXP_ZERO o lhand o snd) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_IMP_LE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN COND_CASES_TAC THEN REWRITE_TAC[CARD_EMPTY_LE; CARD_SING_LE; UNIV_NOT_EMPTY]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `(:num->num->bool)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CARD_EXP_UNIV] THEN MATCH_MP_TAC CARD_LE_EXP THEN ASM_REWRITE_TAC[] THEN TRANS_TAC CARD_LE_TRANS `(:real)` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[CARD_EXP_UNIV; CARD_EQ_IMP_LE; CARD_EQ_REAL]; TRANS_TAC CARD_LE_TRANS `(:num#num->bool)` THEN SIMP_TAC[CARD_FUNSPACE_CURRY; CARD_EQ_IMP_LE] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN TRANS_TAC CARD_EQ_TRANS `(:num->bool)` THEN REWRITE_TAC[CARD_EQ_REAL] THEN MATCH_MP_TAC CARD_FUNSPACE_CONG THEN REWRITE_TAC[CARD_EQ_REFL] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[GSYM MUL_C_UNIV; CARD_SQUARE_NUM]]);; let CARD_EXP_EQ_REAL = prove (`!s:A->bool. COUNTABLE s /\ ~(s = {}) ==> (:real) ^_c s =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN ASM_SIMP_TAC[CARD_EXP_LE_REAL; CARD_LE_REFL] THEN TRANS_TAC CARD_LE_TRANS `(:real) ^_c {a:A}` THEN SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EXP_SING; CARD_EQ_IMP_LE] THEN MATCH_MP_TAC CARD_LE_EXP THEN ASM_REWRITE_TAC[UNIV_NOT_EMPTY; CARD_LE_REFL; CARD_SING_LE]);; let CARD_EQ_RESTRICTED_POWERSET,CARD_EQ_LIMITED_POWERSET = (CONJ_PAIR o prove) (`(!s:A->bool t:B->bool. INFINITE s ==> { k | k SUBSET s /\ k =_c t} =_c (if t <=_c s then s ^_c t else {})) /\ (!s:A->bool t:B->bool. INFINITE s ==> if t <=_c s then { k | k SUBSET s /\ k <=_c t} =_c s ^_c t else { k | k SUBSET s /\ k <=_c t} =_c (:bool) ^_c s)`, let lemma = prove (`!s:A->bool t:B->bool u:C->bool. s <=_c t /\ t <=_c u /\ u <=_c s ==> s =_c u /\ t =_c u`, SIMP_TAC[GSYM CARD_LE_ANTISYM] THEN REPEAT STRIP_TAC THENL [TRANS_TAC CARD_LE_TRANS `t:B->bool`; TRANS_TAC CARD_LE_TRANS `s:A->bool`] THEN ASM_SIMP_TAC[]) in REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `INFINITE(s:A->bool)` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; CONJ_TAC THENL [REWRITE_TAC[CARD_EQ_EMPTY; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN X_GEN_TAC `k:A->bool` THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `k:A->bool` THEN ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN FIRST_ASSUM ACCEPT_TAC; TRANS_TAC CARD_EQ_TRANS `{k:A->bool | k SUBSET s}` THEN REWRITE_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EXP_POWERSET] THEN MATCH_MP_TAC CARD_EQ_REFL_IMP THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} <=> !x. P x ==> Q x`] THEN X_GEN_TAC `k:A->bool` THEN DISCH_TAC THEN TRANS_TAC CARD_LE_TRANS `s:A->bool` THEN ASM_SIMP_TAC[CARD_LE_SUBSET] THEN ASM_MESON_TAC[CARD_LE_TOTAL]]] THEN MATCH_MP_TAC lemma THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_SUBSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM; CARD_EQ_IMP_LE]; ASM_CASES_TAC `t:B->bool = {}` THENL [ASM_REWRITE_TAC[CARD_LE_EMPTY; SING_GSPEC; SET_RULE `k SUBSET s /\ k = {} <=> k = {}`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN REWRITE_TAC[CARD_EXP_0]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `{k:A->bool | k SUBSET s /\ ~(k = {}) /\ k <=_c (t:B->bool)}` THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC I [LE_C] THEN SIMP_TAC[FORALL_IN_GSPEC; IMP_CONJ; LE_C_IMAGE] THEN EXISTS_TAC `\f:B->A. IMAGE f t` THEN X_GEN_TAC `k:A->bool` THEN STRIP_TAC THEN STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `f:B->A` (SUBST_ALL_TAC o SYM)) THEN EXISTS_TAC `\y. if y IN t then (f:B->A) y else @y. F` THEN ASM_SIMP_TAC[exp_c; IN_ELIM_THM] THEN ASM SET_TAC[]] THEN TRANS_TAC CARD_LE_TRANS `{{}} UNION {k:A->bool | k SUBSET s /\ ~(k = {}) /\ k <=_c (t:B->bool)}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_SUBSET THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION; IN_SING] THEN X_GEN_TAC `k:A->bool` THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[CARD_EMPTY_LE]; ALL_TAC] THEN W(MP_TAC o PART_MATCH lhand UNION_LE_ADD_C o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_ADD_ABSORB_LEFT THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC CARD_LE_FINITE_INFINITE THEN ASM_REWRITE_TAC[FINITE_SING]; ALL_TAC] THEN UNDISCH_TAC `INFINITE(s:A->bool)` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_INFINITE) THEN ONCE_REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:A. {x}` THEN SIMP_TAC[SET_RULE `{a} = {b} <=> a = b`; IN_ELIM_THM] THEN ASM_SIMP_TAC[SING_SUBSET; NOT_INSERT_EMPTY; CARD_SING_LE]; TRANS_TAC CARD_LE_TRANS `{k | k SUBSET ((t:B->bool) *_c (s:A->bool)) /\ k =_c t}` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:A->bool`; `t:B->bool`] CARD_EXP_GRAPH_PAIRED) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_IMP_LE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; mul_c; IN_ELIM_THM] THEN X_GEN_TAC `R:B#A->bool` THEN REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN REWRITE_TAC[eq_c] THEN EXISTS_TAC `FST:B#A->B` THEN REWRITE_TAC[EXISTS_UNIQUE_DEF; FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN ASM_MESON_TAC[PAIR_EQ; IN]; SUBGOAL_THEN `(t:B->bool) *_c (s:A->bool) <=_c s` MP_TAC THENL [ASM_SIMP_TAC[CARD_MUL_ABSORB_LE]; ALL_TAC] THEN REWRITE_TAC[le_c] THEN DISCH_THEN(X_CHOOSE_THEN `p:B#A->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (p:B#A->A)` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `u:B#A->bool`; ASM SET_TAC[]] THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC CARD_EQ_TRANS `u:B#A->bool` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN ASM SET_TAC[]]]);; let CARD_EQ_FULLSIZE_POWERSET = prove (`!s:A->bool. INFINITE s ==> {t | t SUBSET s /\ t =_c s} =_c {t | t SUBSET s}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `s:A->bool` o MATCH_MP CARD_EQ_RESTRICTED_POWERSET) THEN REWRITE_TAC[CARD_LE_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN TRANS_TAC CARD_EQ_TRANS `(:bool) ^_c (s:A->bool)` THEN ASM_REWRITE_TAC[CARD_EXP_POWERSET] THEN MATCH_MP_TAC CARD_EXP_ABSORB THEN ASM_SIMP_TAC[CARD_LT_IMP_LE; CARD_EXP_CANTOR] THEN MATCH_MP_TAC CARD_LE_FINITE_INFINITE THEN ASM_REWRITE_TAC[FINITE_BOOL]);; (* ------------------------------------------------------------------------- *) (* More about cardinality of lists and restricted powersets etc. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_FINITE_SUBSETS = prove (`!s:A->bool. INFINITE(s) ==> {t | t SUBSET s /\ FINITE t} =_c s`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `{l:A list | !x. MEM x l ==> x IN s}` THEN CONJ_TAC THENL [REWRITE_TAC[LE_C; IN_ELIM_THM] THEN EXISTS_TAC `set_of_list:A list->(A->bool)` THEN X_GEN_TAC `t:A->bool` THEN STRIP_TAC THEN EXISTS_TAC `list_of_set(t:A->bool)` THEN ASM_SIMP_TAC[MEM_LIST_OF_SET; GSYM SUBSET; SET_OF_LIST_OF_SET]; MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_EQ_LIST_GEN THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:A. {x}` THEN REWRITE_TAC[IN_ELIM_THM; FINITE_SING] THEN SET_TAC[]]);; let CARD_LE_LIST = prove (`!s:A->bool t:B->bool. s <=_c t ==> {l | !x. MEM x l ==> x IN s} <=_c {l | !x. MEM x l ==> x IN t}`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[le_c; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN EXISTS_TAC `MAP (f:A->B)` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[MEM_MAP] THEN ASM_MESON_TAC[]; DISCH_TAC] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN LIST_INDUCT_TAC THEN SIMP_TAC[MAP_EQ_NIL; MAP] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; NOT_CONS_NIL; MEM; CONS_11] THEN ASM_MESON_TAC[]);; let CARD_LE_SUBPOWERSET = prove (`!s:A->bool t:B->bool. s <=_c t /\ (!f s. P s ==> Q(IMAGE f s)) ==> {u | u SUBSET s /\ P u} <=_c {v | v SUBSET t /\ Q v}`, REPEAT GEN_TAC THEN REWRITE_TAC[le_c; IN_ELIM_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) ASSUME_TAC) THEN EXISTS_TAC `IMAGE (f:A->B)` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; let CARD_LE_FINITE_SUBSETS = prove (`!s:A->bool t:B->bool. s <=_c t ==> {u | u SUBSET s /\ FINITE u} <=_c {v | v SUBSET t /\ FINITE v}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_SUBPOWERSET THEN ASM_SIMP_TAC[FINITE_IMAGE]);; let CARD_LE_COUNTABLE_SUBSETS = prove (`!s:A->bool t:B->bool. s <=_c t ==> {u | u SUBSET s /\ COUNTABLE u} <=_c {v | v SUBSET t /\ COUNTABLE v}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_SUBPOWERSET THEN ASM_SIMP_TAC[COUNTABLE_IMAGE]);; let CARD_LE_POWERSET = prove (`!s:A->bool t:B->bool. s <=_c t ==> {u | u SUBSET s} <=_c {v | v SUBSET t}`, REPEAT STRIP_TAC THEN PURE_ONCE_REWRITE_TAC[SET_RULE `{x | x SUBSET y} = {x | x SUBSET y /\ T}`] THEN MATCH_MP_TAC CARD_LE_SUBPOWERSET THEN ASM_SIMP_TAC[]);; let CARD_POWERSET_CONG = prove (`!s:A->bool t:B->bool. s =_c t ==> {u | u SUBSET s} =_c {v | v SUBSET t}`, SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_POWERSET]);; let COUNTABLE_LIST_GEN = prove (`!s:A->bool. COUNTABLE s ==> COUNTABLE {l | !x. MEM x l ==> x IN s}`, GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_LIST) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`] THEN SIMP_TAC[CARD_EQ_LIST; num_INFINITE]);; let COUNTABLE_LIST = prove (`COUNTABLE(:A) ==> COUNTABLE(:A list)`, MP_TAC(ISPEC `(:A)` COUNTABLE_LIST_GEN) THEN REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`]);; let COUNTABLE_FINITE_SUBSETS = prove (`!s:A->bool. COUNTABLE(s) ==> COUNTABLE {t | t SUBSET s /\ FINITE t}`, GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_FINITE_SUBSETS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`] THEN SIMP_TAC[CARD_EQ_FINITE_SUBSETS; num_INFINITE]);; let CARD_EQ_REAL_SEQUENCES = prove (`(:num->real) =_c (:real)`, TRANS_TAC CARD_EQ_TRANS `(:num->num->bool)` THEN ASM_SIMP_TAC[CARD_FUNSPACE_CONG; CARD_EQ_REFL; CARD_EQ_REAL] THEN TRANS_TAC CARD_EQ_TRANS `(:num#num->bool)` THEN ASM_SIMP_TAC[CARD_FUNSPACE_CURRY] THEN TRANS_TAC CARD_EQ_TRANS `(:num->bool)` THEN ASM_SIMP_TAC[CARD_FUNSPACE_CONG; CARD_EQ_REFL; ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_REAL; REWRITE_RULE[MUL_C_UNIV] CARD_SQUARE_NUM]);; let CARD_EQ_COUNTABLE_SUBSETS_SUBREAL = prove (`!s:A->bool. INFINITE s /\ s <=_c (:real) ==> {t | t SUBSET s /\ COUNTABLE t} =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN FIRST_ASSUM(MP_TAC o ISPEC `(:num)` o MATCH_MP CARD_EQ_LIMITED_POWERSET) THEN ASM_REWRITE_TAC[GSYM INFINITE_CARD_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN TRANS_TAC CARD_EQ_TRANS `(:num->bool)` THEN REWRITE_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_REAL] THEN REWRITE_TAC[GSYM CARD_EXP_UNIV] THEN MATCH_MP_TAC CARD_EXP_ABSORB THEN REWRITE_TAC[num_INFINITE] THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_FINITE_INFINITE THEN ASM_REWRITE_TAC[FINITE_BOOL]; TRANS_TAC CARD_LE_TRANS `(:real)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN TRANS_TAC CARD_EQ_TRANS `(:num->bool)` THEN REWRITE_TAC[CARD_EQ_REAL; CARD_EXP_UNIV; CARD_EQ_REFL]]);; let CARD_EQ_COUNTABLE_SUBSETS_REAL = prove (`{s:real->bool | COUNTABLE s} =_c (:real)`, MP_TAC(ISPEC `(:real)` CARD_EQ_COUNTABLE_SUBSETS_SUBREAL) THEN REWRITE_TAC[SUBSET_UNIV; CARD_LE_REFL; real_INFINITE]);; hol-light/Library/floor.ml000066400000000000000000000766171303454263000160450ustar00rootroot00000000000000(* ========================================================================= *) (* The integer/rational-valued reals, and the "floor" and "frac" functions. *) (* ========================================================================= *) prioritize_real();; (* ------------------------------------------------------------------------- *) (* Closure theorems and other lemmas for the integer-valued reals. *) (* ------------------------------------------------------------------------- *) let INTEGER_CASES = prove (`integer x <=> (?n. x = &n) \/ (?n. x = -- &n)`, REWRITE_TAC[is_int; OR_EXISTS_THM]);; let REAL_ABS_INTEGER_LEMMA = prove (`!x. integer(x) /\ ~(x = &0) ==> &1 <= abs(x)`, GEN_TAC THEN REWRITE_TAC[integer] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[REAL_ARITH `(x = &0) <=> (abs(x) = &0)`] THEN POP_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_LE] THEN ARITH_TAC);; let INTEGER_CLOSED = prove (`(!n. integer(&n)) /\ (!x y. integer(x) /\ integer(y) ==> integer(x + y)) /\ (!x y. integer(x) /\ integer(y) ==> integer(x - y)) /\ (!x y. integer(x) /\ integer(y) ==> integer(x * y)) /\ (!x r. integer(x) ==> integer(x pow r)) /\ (!x. integer(x) ==> integer(--x)) /\ (!x. integer(x) ==> integer(abs x)) /\ (!x y. integer(x) /\ integer(y) ==> integer(max x y)) /\ (!x y. integer(x) /\ integer(y) ==> integer(min x y))`, REWRITE_TAC[integer] THEN MATCH_MP_TAC(TAUT `g /\ h /\ x /\ c /\ d /\ e /\ f /\ (a /\ e ==> b) /\ a ==> x /\ a /\ b /\ c /\ d /\ e /\ f /\ g /\ h`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[real_max] THEN MESON_TAC[]; REWRITE_TAC[real_min] THEN MESON_TAC[]; REWRITE_TAC[REAL_ABS_NUM] THEN MESON_TAC[]; REWRITE_TAC[REAL_ABS_MUL] THEN MESON_TAC[REAL_OF_NUM_MUL]; REWRITE_TAC[REAL_ABS_POW] THEN MESON_TAC[REAL_OF_NUM_POW]; REWRITE_TAC[REAL_ABS_NEG]; REWRITE_TAC[REAL_ABS_ABS]; REWRITE_TAC[real_sub] THEN MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[REAL_ARITH `&0 <= a ==> ((abs(x) = a) <=> (x = a) \/ (x = --a))`; REAL_POS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_OF_NUM_ADD] THENL [MESON_TAC[]; ALL_TAC; ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[REAL_ARITH `(--a + b = c) <=> (a + c = b)`; REAL_ARITH `(a + --b = c) <=> (b + c = a)`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN MESON_TAC[LE_EXISTS; ADD_SYM; LE_CASES]);; let INTEGER_ADD = prove (`!x y. integer(x) /\ integer(y) ==> integer(x + y)`, REWRITE_TAC[INTEGER_CLOSED]);; let INTEGER_SUB = prove (`!x y. integer(x) /\ integer(y) ==> integer(x - y)`, REWRITE_TAC[INTEGER_CLOSED]);; let INTEGER_MUL = prove (`!x y. integer(x) /\ integer(y) ==> integer(x * y)`, REWRITE_TAC[INTEGER_CLOSED]);; let INTEGER_POW = prove (`!x n. integer(x) ==> integer(x pow n)`, REWRITE_TAC[INTEGER_CLOSED]);; let REAL_LE_INTEGERS = prove (`!x y. integer(x) /\ integer(y) ==> (x <= y <=> (x = y) \/ x + &1 <= y)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `y - x` REAL_ABS_INTEGER_LEMMA) THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let REAL_LE_CASES_INTEGERS = prove (`!x y. integer(x) /\ integer(y) ==> x <= y \/ y + &1 <= x`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `y - x` REAL_ABS_INTEGER_LEMMA) THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let REAL_LE_REVERSE_INTEGERS = prove (`!x y. integer(x) /\ integer(y) /\ ~(y + &1 <= x) ==> x <= y`, MESON_TAC[REAL_LE_CASES_INTEGERS]);; let REAL_LT_INTEGERS = prove (`!x y. integer(x) /\ integer(y) ==> (x < y <=> x + &1 <= y)`, MESON_TAC[REAL_NOT_LT; REAL_LE_CASES_INTEGERS; REAL_ARITH `x + &1 <= y ==> x < y`]);; let REAL_EQ_INTEGERS = prove (`!x y. integer x /\ integer y ==> (x = y <=> abs(x - y) < &1)`, REWRITE_TAC[REAL_ARITH `x = y <=> ~(x < y \/ y < x)`] THEN SIMP_TAC[REAL_LT_INTEGERS] THEN REAL_ARITH_TAC);; let REAL_EQ_INTEGERS_IMP = prove (`!x y. integer x /\ integer y /\ abs(x - y) < &1 ==> x = y`, SIMP_TAC[REAL_EQ_INTEGERS]);; let INTEGER_NEG = prove (`!x. integer(--x) <=> integer(x)`, MESON_TAC[INTEGER_CLOSED; REAL_NEG_NEG]);; let INTEGER_ABS = prove (`!x. integer(abs x) <=> integer(x)`, GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN REWRITE_TAC[INTEGER_NEG]);; let INTEGER_POS = prove (`!x. &0 <= x ==> (integer(x) <=> ?n. x = &n)`, SIMP_TAC[integer; real_abs]);; let NONNEGATIVE_INTEGER = prove (`!x. integer x /\ &0 <= x <=> ?n. x = &n`, MESON_TAC[INTEGER_POS; INTEGER_CLOSED; REAL_POS]);; let NONPOSITIVE_INTEGER = prove (`!x. integer x /\ x <= &0 <=> ?n. x = -- &n`, GEN_TAC THEN REWRITE_TAC[is_int] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; REAL_ARITH `a + b = &0 <=> a = --b`] THEN AP_TERM_TAC THEN ABS_TAC THEN REAL_ARITH_TAC);; let NONPOSITIVE_INTEGER_ALT = prove (`!x. integer x /\ x <= &0 <=> ?n. x + &n = &0`, GEN_TAC THEN REWRITE_TAC[NONPOSITIVE_INTEGER] THEN AP_TERM_TAC THEN ABS_TAC THEN REAL_ARITH_TAC);; let INTEGER_ADD_EQ = prove (`(!x y. integer(x) ==> (integer(x + y) <=> integer(y))) /\ (!x y. integer(y) ==> (integer(x + y) <=> integer(x)))`, MESON_TAC[REAL_ADD_SUB; REAL_ADD_SYM; INTEGER_CLOSED]);; let INTEGER_SUB_EQ = prove (`(!x y. integer(x) ==> (integer(x - y) <=> integer(y))) /\ (!x y. integer(y) ==> (integer(x - y) <=> integer(x)))`, MESON_TAC[REAL_SUB_ADD; REAL_NEG_SUB; INTEGER_CLOSED]);; let FORALL_INTEGER = prove (`!P. (!n. P(&n)) /\ (!x. P x ==> P(--x)) ==> !x. integer x ==> P x`, MESON_TAC[INTEGER_CASES]);; let INTEGER_SUM = prove (`!f:A->real s. (!x. x IN s ==> integer(f x)) ==> integer(sum s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_CLOSED THEN ASM_REWRITE_TAC[INTEGER_CLOSED]);; let INTEGER_ABS_MUL_EQ_1 = prove (`!x y. integer x /\ integer y ==> (abs(x * y) = &1 <=> abs x = &1 /\ abs y = &1)`, REWRITE_TAC[integer] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_MUL; MULT_EQ_1]);; let INTEGER_DIV = prove (`!m n. integer(&m / &n) <=> n = 0 \/ n divides m`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; INTEGER_CLOSED]; ASM_SIMP_TAC[INTEGER_POS; REAL_POS; REAL_LE_DIV; divides] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `~(n = &0) ==> (x / n = y <=> x = n * y)`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ]]);; (* ------------------------------------------------------------------------- *) (* Similar theorems for rational-valued reals. *) (* ------------------------------------------------------------------------- *) let rational = new_definition `rational x <=> ?m n. integer m /\ integer n /\ ~(n = &0) /\ x = m / n`;; let RATIONAL_INTEGER = prove (`!x. integer x ==> rational x`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[rational] THEN MAP_EVERY EXISTS_TAC [`x:real`; `&1`] THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN CONV_TAC REAL_FIELD);; let RATIONAL_NUM = prove (`!n. rational(&n)`, SIMP_TAC[RATIONAL_INTEGER; INTEGER_CLOSED]);; let RATIONAL_NEG = prove (`!x. rational(x) ==> rational(--x)`, REWRITE_TAC[rational; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real`; `m:real`; `n:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`--m:real`; `n:real`] THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN CONV_TAC REAL_FIELD);; let RATIONAL_ABS = prove (`!x. rational(x) ==> rational(abs x)`, REWRITE_TAC[real_abs] THEN MESON_TAC[RATIONAL_NEG]);; let RATIONAL_INV = prove (`!x. rational(x) ==> rational(inv x)`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[REAL_INV_0; RATIONAL_NUM] THEN REWRITE_TAC[rational; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`m:real`; `n:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`n:real`; `m:real`] THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; let RATIONAL_ADD = prove (`!x y. rational(x) /\ rational(y) ==> rational(x + y)`, REPEAT GEN_TAC THEN REWRITE_TAC[rational; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`m1:real`; `n1:real`; `m2:real`; `n2:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`m1 * n2 + m2 * n1:real`; `n1 * n2:real`] THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; let RATIONAL_SUB = prove (`!x y. rational(x) /\ rational(y) ==> rational(x - y)`, SIMP_TAC[real_sub; RATIONAL_NEG; RATIONAL_ADD]);; let RATIONAL_MUL = prove (`!x y. rational(x) /\ rational(y) ==> rational(x * y)`, REPEAT GEN_TAC THEN REWRITE_TAC[rational; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`m1:real`; `n1:real`; `m2:real`; `n2:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`m1 * m2:real`; `n1 * n2:real`] THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; let RATIONAL_DIV = prove (`!x y. rational(x) /\ rational(y) ==> rational(x / y)`, SIMP_TAC[real_div; RATIONAL_INV; RATIONAL_MUL]);; let RATIONAL_POW = prove (`!x n. rational(x) ==> rational(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_pow; RATIONAL_NUM; RATIONAL_MUL]);; let RATIONAL_CLOSED = prove (`(!n. rational(&n)) /\ (!x. integer x ==> rational x) /\ (!x y. rational(x) /\ rational(y) ==> rational(x + y)) /\ (!x y. rational(x) /\ rational(y) ==> rational(x - y)) /\ (!x y. rational(x) /\ rational(y) ==> rational(x * y)) /\ (!x y. rational(x) /\ rational(y) ==> rational(x / y)) /\ (!x r. rational(x) ==> rational(x pow r)) /\ (!x. rational(x) ==> rational(--x)) /\ (!x. rational(x) ==> rational(inv x)) /\ (!x. rational(x) ==> rational(abs x))`, SIMP_TAC[RATIONAL_NUM; RATIONAL_NEG; RATIONAL_ABS; RATIONAL_INV; RATIONAL_ADD; RATIONAL_SUB; RATIONAL_MUL; RATIONAL_DIV; RATIONAL_POW; RATIONAL_INTEGER]);; let RATIONAL_NEG_EQ = prove (`!x. rational(--x) <=> rational x`, MESON_TAC[REAL_NEG_NEG; RATIONAL_NEG]);; let RATIONAL_INV_EQ = prove (`!x. rational(inv x) <=> rational x`, MESON_TAC[REAL_INV_INV; RATIONAL_INV]);; let RATIONAL_SUM = prove (`!s x. (!i. i IN s ==> rational(x i)) ==> rational(sum s x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_CLOSED THEN ASM_SIMP_TAC[RATIONAL_CLOSED]);; let RATIONAL_ALT = prove (`!x. rational(x) <=> ?p q. ~(q = 0) /\ abs x = &p / &q`, GEN_TAC THEN REWRITE_TAC[rational] THEN EQ_TAC THENL [REWRITE_TAC[integer] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_DIV] THEN ASM_MESON_TAC[REAL_OF_NUM_EQ; REAL_ABS_ZERO]; STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `abs(x:real) = a ==> x = a \/ x = --a`)) THEN ASM_REWRITE_TAC[real_div; GSYM REAL_MUL_LNEG] THEN REWRITE_TAC[GSYM real_div] THEN ASM_MESON_TAC[INTEGER_CLOSED; REAL_OF_NUM_EQ]]);; (* ------------------------------------------------------------------------- *) (* The floor and frac functions. *) (* ------------------------------------------------------------------------- *) let REAL_ARCH_SIMPLE = prove (`!x. ?n. x <= &n`, let lemma = prove(`(!x. (?n. x = &n) ==> P x) <=> !n. P(&n)`,MESON_TAC[]) in MP_TAC(SPEC `\y. ?n. y = &n` REAL_COMPLETE) THEN REWRITE_TAC[lemma] THEN MESON_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_LE_TOTAL; REAL_ARITH `~(M <= M - &1)`]);; let REAL_TRUNCATE_POS = prove (`!x. &0 <= x ==> ?n r. &0 <= r /\ r < &1 /\ (x = &n + r)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THEN REWRITE_TAC[LT_SUC_LE; CONJUNCT1 LT] THENL [DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`0`; `&0`] THEN ASM_REAL_ARITH_TAC; POP_ASSUM_LIST(K ALL_TAC)] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; REAL_NOT_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [MAP_EVERY EXISTS_TAC [`n:num`; `x - &n`] THEN ASM_REAL_ARITH_TAC; MAP_EVERY EXISTS_TAC [`SUC n`; `x - &(SUC n)`] THEN REWRITE_TAC[REAL_ADD_SUB; GSYM REAL_OF_NUM_SUC] THEN ASM_REAL_ARITH_TAC]);; let REAL_TRUNCATE = prove (`!x. ?n r. integer(n) /\ &0 <= r /\ r < &1 /\ (x = n + r)`, GEN_TAC THEN DISJ_CASES_TAC(SPECL [`x:real`; `&0`] REAL_LE_TOTAL) THENL [MP_TAC(SPEC `--x` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[REAL_ARITH `--a <= b <=> &0 <= a + b`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o MATCH_MP REAL_TRUNCATE_POS)) THEN REWRITE_TAC[REAL_ARITH `(a + b = c + d) <=> (a = (c - b) + d)`]; ALL_TAC] THEN ASM_MESON_TAC[integer; INTEGER_CLOSED; REAL_TRUNCATE_POS]);; let FLOOR_FRAC = new_specification ["floor"; "frac"] (REWRITE_RULE[SKOLEM_THM] REAL_TRUNCATE);; (* ------------------------------------------------------------------------- *) (* Useful lemmas about floor and frac. *) (* ------------------------------------------------------------------------- *) let FLOOR_UNIQUE = prove (`!x a. integer(a) /\ a <= x /\ x < a + &1 <=> (floor x = a)`, REPEAT GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN STRIP_ASSUME_TAC(SPEC `x:real` FLOOR_FRAC) THEN SUBGOAL_THEN `abs(floor x - a) < &1` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN CONJ_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED]; ASM_REAL_ARITH_TAC]; DISCH_THEN(SUBST1_TAC o SYM) THEN MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN SIMP_TAC[] THEN REAL_ARITH_TAC]);; let FLOOR_EQ_0 = prove (`!x. (floor x = &0) <=> &0 <= x /\ x < &1`, GEN_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN REWRITE_TAC[INTEGER_CLOSED; REAL_ADD_LID]);; let FLOOR = prove (`!x. integer(floor x) /\ floor(x) <= x /\ x < floor(x) + &1`, GEN_TAC THEN MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let FLOOR_DOUBLE = prove (`!u. &2 * floor(u) <= floor(&2 * u) /\ floor(&2 * u) <= &2 * floor(u) + &1`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN SIMP_TAC[INTEGER_CLOSED; FLOOR] THEN MP_TAC(SPEC `u:real` FLOOR) THEN MP_TAC(SPEC `&2 * u` FLOOR) THEN REAL_ARITH_TAC);; let FRAC_FLOOR = prove (`!x. frac(x) = x - floor(x)`, MP_TAC FLOOR_FRAC THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let FLOOR_NUM = prove (`!n. floor(&n) = &n`, REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let REAL_LE_FLOOR = prove (`!x n. integer(n) ==> (n <= floor x <=> n <= x)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[FLOOR; REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_SIMP_TAC[REAL_LT_INTEGERS; FLOOR] THEN MP_TAC(SPEC `x:real` FLOOR) THEN REAL_ARITH_TAC);; let REAL_FLOOR_LE = prove (`!x n. integer n ==> (floor x <= n <=> x - &1 < n)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x + &1 <= y + &1`] THEN ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; FLOOR; INTEGER_CLOSED] THEN ONCE_REWRITE_TAC[TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN ASM_SIMP_TAC[REAL_NOT_LT; REAL_LE_FLOOR; INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let REAL_FLOOR_LT = prove (`!x n. integer n ==> (floor x < n <=> x < n)`, SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR]);; let REAL_LT_FLOOR = prove (`!x n. integer n ==> (n < floor x <=> n <= x - &1)`, SIMP_TAC[GSYM REAL_NOT_LE; REAL_FLOOR_LE]);; let FLOOR_POS = prove (`!x. &0 <= x ==> ?n. floor(x) = &n`, REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT1(SPEC `x:real` FLOOR)) THEN REWRITE_TAC[integer] THEN ASM_SIMP_TAC[real_abs; REAL_LE_FLOOR; FLOOR; INTEGER_CLOSED]);; let FLOOR_DIV_DIV = prove (`!m n. ~(m = 0) ==> floor(&n / &m) = &(n DIV m)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; LT_NZ] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN ARITH_TAC);; let FLOOR_MONO = prove (`!x y. x <= y ==> floor x <= floor y`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN SIMP_TAC[FLOOR; REAL_LT_INTEGERS] THEN MAP_EVERY (MP_TAC o C SPEC FLOOR) [`x:real`; `y:real`] THEN REAL_ARITH_TAC);; let REAL_FLOOR_EQ = prove (`!x. floor x = x <=> integer x`, REWRITE_TAC[GSYM FLOOR_UNIQUE; REAL_LE_REFL; REAL_ARITH `x < x + &1`]);; let REAL_FLOOR_LT_REFL = prove (`!x. floor x < x <=> ~(integer x)`, MESON_TAC[REAL_LT_LE; REAL_FLOOR_EQ; FLOOR]);; let REAL_FRAC_EQ_0 = prove (`!x. frac x = &0 <=> integer x`, REWRITE_TAC[FRAC_FLOOR; REAL_SUB_0] THEN MESON_TAC[REAL_FLOOR_EQ]);; let REAL_FRAC_POS_LT = prove (`!x. &0 < frac x <=> ~(integer x)`, REWRITE_TAC[FRAC_FLOOR; REAL_SUB_LT; REAL_FLOOR_LT_REFL]);; let FRAC_NUM = prove (`!n. frac(&n) = &0`, REWRITE_TAC[REAL_FRAC_EQ_0; INTEGER_CLOSED]);; let REAL_FLOOR_REFL = prove (`!x. integer x ==> floor x = x`, REWRITE_TAC[REAL_FLOOR_EQ]);; let REAL_FRAC_ZERO = prove (`!x. integer x ==> frac x = &0`, REWRITE_TAC[REAL_FRAC_EQ_0]);; let REAL_FLOOR_ADD = prove (`!x y. floor(x + y) = if frac x + frac y < &1 then floor(x) + floor(y) else (floor(x) + floor(y)) + &1`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN CONJ_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED; FLOOR]; ALL_TAC] THEN MAP_EVERY (MP_TAC o C SPEC FLOOR_FRAC)[`x:real`; `y:real`; `x + y:real`] THEN REAL_ARITH_TAC);; let REAL_FLOOR_TRIANGLE = prove (`!x y. floor(x) + floor(y) <= floor(x + y) /\ floor(x + y) <= (floor x + floor y) + &1`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_FLOOR_ADD] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_FLOOR_NEG = prove (`!x. floor(--x) = if integer x then --x else --(floor x + &1)`, GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN MP_TAC(SPEC `x:real` FLOOR) THEN MP_TAC(SPEC `x:real` REAL_FLOOR_EQ) THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let REAL_FRAC_ADD = prove (`!x y. frac(x + y) = if frac x + frac y < &1 then frac(x) + frac(y) else (frac(x) + frac(y)) - &1`, REWRITE_TAC[FRAC_FLOOR; REAL_FLOOR_ADD] THEN REAL_ARITH_TAC);; let FLOOR_POS_LE = prove (`!x. &0 <= floor x <=> &0 <= x`, SIMP_TAC[REAL_LE_FLOOR; INTEGER_CLOSED]);; let FRAC_UNIQUE = prove (`!x a. integer(x - a) /\ &0 <= a /\ a < &1 <=> frac x = a`, REWRITE_TAC[FRAC_FLOOR; REAL_ARITH `x - f:real = a <=> f = x - a`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let REAL_FRAC_EQ = prove (`!x. frac x = x <=> &0 <= x /\ x < &1`, REWRITE_TAC[GSYM FRAC_UNIQUE; REAL_SUB_REFL; INTEGER_CLOSED]);; let INTEGER_ROUND = prove (`!x. ?n. integer n /\ abs(x - n) <= &1 / &2`, GEN_TAC THEN MATCH_MP_TAC(MESON[] `!a. P a \/ P(a + &1) ==> ?x. P x`) THEN EXISTS_TAC `floor x` THEN MP_TAC(ISPEC `x:real` FLOOR) THEN SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let FRAC_DIV_MOD = prove (`!m n. ~(n = 0) ==> frac(&m / &n) = &(m MOD n) / &n`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FRAC_UNIQUE] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_ARITH `x / a - y / a:real = (x - y) / a`] THEN MP_TAC(SPECL [`m:num`; `n:num`] DIVISION) THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_MUL_LID] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV o RAND_CONV) [CONJUNCT1 th]) THEN SIMP_TAC[REAL_OF_NUM_SUB; ONCE_REWRITE_RULE[ADD_SYM] LE_ADD; ADD_SUB] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; INTEGER_CLOSED; REAL_FIELD `~(n:real = &0) ==> (x * n) / n = x`]);; let FRAC_NEG = prove (`!x. frac(--x) = if integer x then &0 else &1 - frac x`, GEN_TAC THEN REWRITE_TAC[FRAC_FLOOR; REAL_FLOOR_NEG] THEN COND_CASES_TAC THEN REAL_ARITH_TAC);; let REAL_FLOOR_FLOOR_DIV = prove (`!x n. floor(floor x / &n) = floor(x / &n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO] THEN REWRITE_TAC[GSYM real_div; GSYM FLOOR_UNIQUE; FLOOR] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN SIMP_TAC[REAL_FLOOR_LT; REAL_LE_FLOOR; FLOOR; INTEGER_CLOSED] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; FLOOR]);; (* ------------------------------------------------------------------------- *) (* Assertions that there are integers between well-spaced reals. *) (* ------------------------------------------------------------------------- *) let INTEGER_EXISTS_BETWEEN_ALT = prove (`!x y. x + &1 <= y ==> ?n. integer n /\ x < n /\ n <= y`, REPEAT STRIP_TAC THEN EXISTS_TAC `floor y` THEN MP_TAC(SPEC `y:real` FLOOR) THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; let INTEGER_EXISTS_BETWEEN_LT = prove (`!x y. x + &1 < y ==> ?n. integer n /\ x < n /\ n < y`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `integer y` THENL [EXISTS_TAC `y - &1:real` THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(MP_TAC o MATCH_MP INTEGER_EXISTS_BETWEEN_ALT o MATCH_MP REAL_LT_IMP_LE) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM_MESON_TAC[]]);; let INTEGER_EXISTS_BETWEEN = prove (`!x y. x + &1 <= y ==> ?n. integer n /\ x <= n /\ n < y`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `integer y` THENL [EXISTS_TAC `y - &1:real` THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(MP_TAC o MATCH_MP INTEGER_EXISTS_BETWEEN_ALT) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]]);; let INTEGER_EXISTS_BETWEEN_ABS = prove (`!x y. &1 <= abs(x - y) ==> ?n. integer n /\ (x <= n /\ n < y \/ y <= n /\ n < x)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THENL [MP_TAC(ISPECL [`y:real`; `x:real`] INTEGER_EXISTS_BETWEEN); MP_TAC(ISPECL [`x:real`; `y:real`] INTEGER_EXISTS_BETWEEN)] THEN (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS]) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; let INTEGER_EXISTS_BETWEEN_ABS_LT = prove (`!x y. &1 < abs(x - y) ==> ?n. integer n /\ (x < n /\ n < y \/ y < n /\ n < x)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THENL [MP_TAC(ISPECL [`y:real`; `x:real`] INTEGER_EXISTS_BETWEEN_LT); MP_TAC(ISPECL [`x:real`; `y:real`] INTEGER_EXISTS_BETWEEN_LT)] THEN (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS]) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* A couple more theorems about real_of_int. *) (* ------------------------------------------------------------------------- *) let INT_OF_REAL_OF_INT = prove (`!i. int_of_real(real_of_int i) = i`, REWRITE_TAC[int_abstr]);; let REAL_OF_INT_OF_REAL = prove (`!x. integer(x) ==> real_of_int(int_of_real x) = x`, SIMP_TAC[int_rep]);; (* ------------------------------------------------------------------------- *) (* Finiteness of bounded set of integers. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_INTSEG_NUM = prove (`!m n. {x | integer(x) /\ &m <= x /\ x <= &n} HAS_SIZE ((n + 1) - m)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x | integer(x) /\ &m <= x /\ x <= &n} = IMAGE real_of_num (m..n)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN ASM_CASES_TAC `?k. x = &k` THENL [FIRST_X_ASSUM(CHOOSE_THEN SUBST_ALL_TAC) THEN REWRITE_TAC[REAL_OF_NUM_LE; INTEGER_CLOSED; REAL_OF_NUM_EQ] THEN REWRITE_TAC[UNWIND_THM1; IN_NUMSEG]; ASM_MESON_TAC[INTEGER_POS; REAL_ARITH `&n <= x ==> &0 <= x`]]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG] THEN SIMP_TAC[REAL_OF_NUM_EQ]]);; let FINITE_INTSEG = prove (`!a b. FINITE {x | integer(x) /\ a <= x /\ x <= b}`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `max (abs a) (abs b)` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[REAL_MAX_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x | integer(x) /\ abs(x) <= &n}` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\x. &x) (0..n) UNION IMAGE (\x. --(&x)) (0..n)` THEN ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[INTEGER_CASES; SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[IN_UNION; IN_IMAGE; REAL_OF_NUM_EQ; REAL_EQ_NEG2] THEN REWRITE_TAC[UNWIND_THM1; IN_NUMSEG] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN ASM_REAL_ARITH_TAC);; let HAS_SIZE_INTSEG_INT = prove (`!a b. integer a /\ integer b ==> {x | integer(x) /\ a <= x /\ x <= b} HAS_SIZE if b < a then 0 else num_of_int(int_of_real(b - a + &1))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x | integer(x) /\ a <= x /\ x <= b} = IMAGE (\n. a + &n) {n | &n <= b - a}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; INTEGER_CLOSED] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN X_GEN_TAC `c:real` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a + x:real = y <=> y - a = x`] THEN ASM_SIMP_TAC[GSYM INTEGER_POS; REAL_SUB_LE; INTEGER_CLOSED]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN SIMP_TAC[REAL_EQ_ADD_LCANCEL; REAL_OF_NUM_EQ] THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[REAL_ARITH `b < a ==> ~(&n <= b - a)`] THEN REWRITE_TAC[HAS_SIZE_0; EMPTY_GSPEC]; SUBGOAL_THEN `?m. b - a = &m` (CHOOSE_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[INTEGER_POS; INTEGER_CLOSED; REAL_NOT_LT; REAL_SUB_LE]; REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; GSYM int_of_num; NUM_OF_INT_OF_NUM; HAS_SIZE_NUMSEG_LE]]]]);; let CARD_INTSEG_INT = prove (`!a b. integer a /\ integer b ==> CARD {x | integer(x) /\ a <= x /\ x <= b} = if b < a then 0 else num_of_int(int_of_real(b - a + &1))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_INTSEG_INT) THEN SIMP_TAC[HAS_SIZE]);; let REAL_CARD_INTSEG_INT = prove (`!a b. integer a /\ integer b ==> &(CARD {x | integer(x) /\ a <= x /\ x <= b}) = if b < a then &0 else b - a + &1`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CARD_INTSEG_INT] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_OF_INT_OF_REAL] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM int_of_num_th] THEN W(MP_TAC o PART_MATCH (lhs o rand) INT_OF_NUM_OF_INT o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[int_le; int_of_num_th; REAL_OF_INT_OF_REAL; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_OF_INT_OF_REAL THEN ASM_SIMP_TAC[INTEGER_CLOSED]]);; (* ------------------------------------------------------------------------- *) (* Yet set of all integers or rationals is infinite. *) (* ------------------------------------------------------------------------- *) let INFINITE_INTEGER = prove (`INFINITE integer`, SUBGOAL_THEN `INFINITE(IMAGE real_of_num (:num))` MP_TAC THENL [SIMP_TAC[INFINITE_IMAGE_INJ; REAL_OF_NUM_EQ; num_INFINITE]; ALL_TAC] THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[IN; INTEGER_CLOSED]);; let INFINITE_RATIONAL = prove (`INFINITE rational`, MP_TAC INFINITE_INTEGER THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN; RATIONAL_INTEGER]);; (* ------------------------------------------------------------------------- *) (* Arbitrarily good rational approximations. *) (* ------------------------------------------------------------------------- *) let RATIONAL_APPROXIMATION = prove (`!x e. &0 < e ==> ?r. rational r /\ abs(r - x) < e`, REPEAT STRIP_TAC THEN ABBREV_TAC `n = floor(inv e) + &1` THEN EXISTS_TAC `floor(n * x) / n` THEN EXPAND_TAC "n" THEN ASM_SIMP_TAC[RATIONAL_CLOSED; INTEGER_CLOSED; FLOOR] THEN SUBGOAL_THEN `&0 < n` ASSUME_TAC THENL [EXPAND_TAC "n" THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN ASM_SIMP_TAC[FLOOR_POS_LE; REAL_LE_INV_EQ; REAL_LT_IMP_LE]; ASM_SIMP_TAC[REAL_FIELD `&0 < n ==> a / n - b = (a - n * b) / n`] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ; REAL_LT_IMP_NZ] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1` THEN CONJ_TAC THENL [MP_TAC(SPEC `n * x:real` FLOOR) THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `inv e < n ==> &1 / e < abs n`) THEN EXPAND_TAC "n" THEN MP_TAC(SPEC `inv e` FLOOR) THEN REAL_ARITH_TAC]]);; let RATIONAL_BETWEEN = prove (`!a b. a < b ==> ?q. rational q /\ a < q /\ q < b`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(a + b) / &2`; `(b - a) / &4`] RATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]] THEN ASM_REAL_ARITH_TAC);; let RATIONAL_BETWEEN_EQ = prove (`!a b. (?q. rational q /\ a < q /\ q < b) <=> a < b`, MESON_TAC[RATIONAL_BETWEEN; REAL_LT_TRANS]);; let RATIONAL_APPROXIMATION_STRADDLE = prove (`!x e. &0 < e ==> ?a b. rational a /\ rational b /\ a < x /\ x < b /\ abs(b - a) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`x - e / &4`; `e / &4`] RATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC] THEN MP_TAC(ISPECL [`x + e / &4`; `e / &4`] RATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let RATIONAL_APPROXIMATION_ABOVE = prove (`!x e. &0 < e ==> ?q. rational q /\ x < q /\ q < x + e`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `e:real`] RATIONAL_APPROXIMATION_STRADDLE) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let RATIONAL_APPROXIMATION_BELOW = prove (`!x e. &0 < e ==> ?q. rational q /\ x - e < q /\ q < x`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `e:real`] RATIONAL_APPROXIMATION_STRADDLE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let INFINITE_RATIONAL_IN_RANGE = prove (`!a b. a < b ==> INFINITE {q | rational q /\ a < q /\ q < b}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?q. (!n. rational(q n) /\ a < q n /\ q n < b) /\ (!n. q(SUC n) < q n)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[GSYM CONJ_ASSOC; GSYM REAL_LT_MIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_BETWEEN THEN ASM_REWRITE_TAC[REAL_LT_MIN]; MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `IMAGE (q:num->real) (:num)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC INFINITE_IMAGE THEN REWRITE_TAC[num_INFINITE; IN_UNIV] THEN SUBGOAL_THEN `!m n. m < n ==> (q:num->real) n < q m` (fun th -> MESON_TAC[LT_CASES; th; REAL_LT_REFL]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_MESON_TAC[REAL_LT_TRANS]]);; hol-light/Library/integer.ml000066400000000000000000001141771303454263000163530ustar00rootroot00000000000000(* ========================================================================= *) (* Basic divisibility notions over the integers. *) (* *) (* This is similar to stuff in Library/prime.ml etc. for natural numbers. *) (* ========================================================================= *) prioritize_int();; (* ------------------------------------------------------------------------- *) (* Basic properties of divisibility. *) (* ------------------------------------------------------------------------- *) let INT_DIVIDES_REFL = INTEGER_RULE `!d. d divides d`;; let INT_DIVIDES_TRANS = INTEGER_RULE `!x y z. x divides y /\ y divides z ==> x divides z`;; let INT_DIVIDES_ADD = INTEGER_RULE `!d a b. d divides a /\ d divides b ==> d divides (a + b)`;; let INT_DIVIDES_SUB = INTEGER_RULE `!d a b. d divides a /\ d divides b ==> d divides (a - b)`;; let INT_DIVIDES_0 = INTEGER_RULE `!d. d divides &0`;; let INT_DIVIDES_ZERO = INTEGER_RULE `!x. &0 divides x <=> x = &0`;; let INT_DIVIDES_LNEG = INTEGER_RULE `!d x. (--d) divides x <=> d divides x`;; let INT_DIVIDES_RNEG = INTEGER_RULE `!d x. d divides (--x) <=> d divides x`;; let INT_DIVIDES_RMUL = INTEGER_RULE `!d x y. d divides x ==> d divides (x * y)`;; let INT_DIVIDES_LMUL = INTEGER_RULE `!d x y. d divides y ==> d divides (x * y)`;; let INT_DIVIDES_1 = INTEGER_RULE `!x. &1 divides x`;; let INT_DIVIDES_ADD_REVR = INTEGER_RULE `!d a b. d divides a /\ d divides (a + b) ==> d divides b`;; let INT_DIVIDES_ADD_REVL = INTEGER_RULE `!d a b. d divides b /\ d divides (a + b) ==> d divides a`;; let INT_DIVIDES_MUL_L = INTEGER_RULE `!a b c. a divides b ==> (c * a) divides (c * b)`;; let INT_DIVIDES_MUL_R = INTEGER_RULE `!a b c. a divides b ==> (a * c) divides (b * c)`;; let INT_DIVIDES_LMUL2 = INTEGER_RULE `!d a x. (x * d) divides a ==> d divides a`;; let INT_DIVIDES_RMUL2 = INTEGER_RULE `!d a x. (d * x) divides a ==> d divides a`;; let INT_DIVIDES_CMUL2 = INTEGER_RULE `!a b c. (c * a) divides (c * b) /\ ~(c = &0) ==> a divides b`;; let INT_DIVIDES_LMUL2_EQ = INTEGER_RULE `!a b c. ~(c = &0) ==> ((c * a) divides (c * b) <=> a divides b)`;; let INT_DIVIDES_RMUL2_EQ = INTEGER_RULE `!a b c. ~(c = &0) ==> ((a * c) divides (b * c) <=> a divides b)`;; let INT_DIVIDES_MUL2 = INTEGER_RULE `!a b c d. a divides b /\ c divides d ==> (a * c) divides (b * d)`;; let INT_DIVIDES_LABS = prove (`!d n. abs(d) divides n <=> d divides n`, REPEAT GEN_TAC THEN SIMP_TAC[INT_ABS] THEN COND_CASES_TAC THEN INTEGER_TAC);; let INT_DIVIDES_RABS = prove (`!d n. d divides (abs n) <=> d divides n`, REPEAT GEN_TAC THEN SIMP_TAC[INT_ABS] THEN COND_CASES_TAC THEN INTEGER_TAC);; let INT_DIVIDES_ABS = prove (`(!d n. abs(d) divides n <=> d divides n) /\ (!d n. d divides (abs n) <=> d divides n)`, REWRITE_TAC[INT_DIVIDES_LABS; INT_DIVIDES_RABS]);; let INT_DIVIDES_POW = prove (`!x y n. x divides y ==> (x pow n) divides (y pow n)`, REWRITE_TAC[int_divides] THEN MESON_TAC[INT_POW_MUL]);; let INT_DIVIDES_POW2 = prove (`!n x y. ~(n = 0) /\ (x pow n) divides y ==> x divides y`, INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; INT_POW] THEN INTEGER_TAC);; let INT_DIVIDES_RPOW = prove (`!x y n. x divides y /\ ~(n = 0) ==> x divides (y pow n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[INT_DIVIDES_RMUL; INT_POW]);; let INT_DIVIDES_RPOW_SUC = prove (`!x y n. x divides y ==> x divides (y pow (SUC n))`, SIMP_TAC[INT_DIVIDES_RPOW; NOT_SUC]);; let INT_DIVIDES_ANTISYM_DIVISORS = prove (`!a b:int. a divides b /\ b divides a <=> !d. d divides a <=> d divides b`, MESON_TAC[INT_DIVIDES_REFL; INT_DIVIDES_TRANS]);; (* ------------------------------------------------------------------------- *) (* Now carefully distinguish signs. *) (* ------------------------------------------------------------------------- *) let INT_DIVIDES_ONE_POS = prove (`!x. &0 <= x ==> (x divides &1 <=> x = &1)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[int_divides]; INTEGER_TAC] THEN DISCH_THEN(CHOOSE_THEN(MP_TAC o AP_TERM `abs` o SYM)) THEN SIMP_TAC[INT_ABS_NUM; INT_ABS_MUL_1] THEN ASM_SIMP_TAC[INT_ABS]);; let INT_DIVIDES_ONE_ABS = prove (`!d. d divides &1 <=> abs(d) = &1`, MESON_TAC[INT_DIVIDES_LABS; INT_DIVIDES_ONE_POS; INT_ABS_POS]);; let INT_DIVIDES_ONE = prove (`!d. d divides &1 <=> d = &1 \/ d = -- &1`, REWRITE_TAC[INT_DIVIDES_ONE_ABS] THEN INT_ARITH_TAC);; let INT_DIVIDES_ANTISYM_ASSOCIATED = prove (`!x y. x divides y /\ y divides x <=> ?u. u divides &1 /\ x = y * u`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; INTEGER_TAC] THEN ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[INT_DIVIDES_ZERO; INT_MUL_LZERO] THEN ASM_MESON_TAC[int_divides; INT_DIVIDES_REFL; INTEGER_RULE `y = x * d /\ x = y * e /\ ~(y = &0) ==> d divides &1`]);; let INT_DIVIDES_ANTISYM = prove (`!x y. x divides y /\ y divides x <=> x = y \/ x = --y`, REWRITE_TAC[INT_DIVIDES_ANTISYM_ASSOCIATED; INT_DIVIDES_ONE] THEN REWRITE_TAC[RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2] THEN INT_ARITH_TAC);; let INT_DIVIDES_ANTISYM_ABS = prove (`!x y. x divides y /\ y divides x <=> abs(x) = abs(y)`, REWRITE_TAC[INT_DIVIDES_ANTISYM] THEN INT_ARITH_TAC);; let INT_DIVIDES_ANTISYM_POS = prove (`!x y. &0 <= x /\ &0 <= y ==> (x divides y /\ y divides x <=> x = y)`, REWRITE_TAC[INT_DIVIDES_ANTISYM_ABS] THEN INT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Lemmas about GCDs. *) (* ------------------------------------------------------------------------- *) let INT_GCD_POS = prove (`!a b. &0 <= gcd(a,b)`, REWRITE_TAC[int_gcd]);; let INT_GCD_DIVIDES = prove (`!a b. gcd(a,b) divides a /\ gcd(a,b) divides b`, INTEGER_TAC);; let INT_GCD_BEZOUT = prove (`!a b. ?x y. gcd(a,b) = a * x + b * y`, INTEGER_TAC);; let INT_DIVIDES_GCD = prove (`!a b d. d divides gcd(a,b) <=> d divides a /\ d divides b`, INTEGER_TAC);; let INT_DIVIDES_GCD = prove (`!a b d. d divides gcd(a,b) <=> d divides a /\ d divides b`, INTEGER_TAC);; let INT_GCD = INTEGER_RULE `!a b. (gcd(a,b) divides a /\ gcd(a,b) divides b) /\ (!e. e divides a /\ e divides b ==> e divides gcd(a,b))`;; let INT_GCD_UNIQUE = prove (`!a b d. gcd(a,b) = d <=> &0 <= d /\ d divides a /\ d divides b /\ !e. e divides a /\ e divides b ==> e divides d`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[INT_GCD; INT_GCD_POS]; ALL_TAC] THEN ASM_SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS; INT_DIVIDES_GCD] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN INTEGER_TAC);; let INT_GCD_UNIQUE_ABS = prove (`!a b d. gcd(a,b) = abs(d) <=> d divides a /\ d divides b /\ !e. e divides a /\ e divides b ==> e divides d`, REWRITE_TAC[INT_GCD_UNIQUE; INT_ABS_POS; INT_DIVIDES_ABS]);; let INT_GCD_REFL = prove (`!a. gcd(a,a) = abs(a)`, REWRITE_TAC[INT_GCD_UNIQUE_ABS] THEN INTEGER_TAC);; let INT_GCD_SYM = prove (`!a b. gcd(a,b) = gcd(b,a)`, SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS] THEN INTEGER_TAC);; let INT_GCD_ASSOC = prove (`!a b c. gcd(a,gcd(b,c)) = gcd(gcd(a,b),c)`, SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS] THEN INTEGER_TAC);; let INT_GCD_1 = prove (`!a. gcd(a,&1) = &1 /\ gcd(&1,a) = &1`, SIMP_TAC[INT_GCD_UNIQUE; INT_POS; INT_DIVIDES_1]);; let INT_GCD_0 = prove (`!a. gcd(a,&0) = abs(a) /\ gcd(&0,a) = abs(a)`, SIMP_TAC[INT_GCD_UNIQUE_ABS] THEN INTEGER_TAC);; let INT_GCD_ABS = prove (`!a b. gcd(abs(a),b) = gcd(a,b) /\ gcd(a,abs(b)) = gcd(a,b)`, REWRITE_TAC[INT_GCD_UNIQUE; INT_DIVIDES_ABS; INT_GCD_POS; INT_GCD]);; let INT_GCD_MULTIPLE = (`!a b. gcd(a,a * b) = abs(a) /\ gcd(b,a * b) = abs(b)`, REWRITE_TAC[INT_GCD_UNIQUE_ABS] THEN INTEGER_TAC);; let INT_GCD_ADD = prove (`(!a b. gcd(a + b,b) = gcd(a,b)) /\ (!a b. gcd(b + a,b) = gcd(a,b)) /\ (!a b. gcd(a,a + b) = gcd(a,b)) /\ (!a b. gcd(a,b + a) = gcd(a,b))`, SIMP_TAC[INT_GCD_UNIQUE; INT_GCD_POS] THEN INTEGER_TAC);; let INT_GCD_SUB = prove (`(!a b. gcd(a - b,b) = gcd(a,b)) /\ (!a b. gcd(b - a,b) = gcd(a,b)) /\ (!a b. gcd(a,a - b) = gcd(a,b)) /\ (!a b. gcd(a,b - a) = gcd(a,b))`, SIMP_TAC[INT_GCD_UNIQUE; INT_GCD_POS] THEN INTEGER_TAC);; let INT_DIVIDES_GCD_LEFT = prove (`!m n:int. m divides n <=> gcd(m,n) = abs m`, SIMP_TAC[INT_GCD_UNIQUE; INT_ABS_POS; INT_DIVIDES_ABS; INT_DIVIDES_REFL] THEN MESON_TAC[INT_DIVIDES_REFL; INT_DIVIDES_TRANS]);; let INT_DIVIDES_GCD_RIGHT = prove (`!m n:int. n divides m <=> gcd(m,n) = abs n`, SIMP_TAC[INT_GCD_UNIQUE; INT_ABS_POS; INT_DIVIDES_ABS; INT_DIVIDES_REFL] THEN MESON_TAC[INT_DIVIDES_REFL; INT_DIVIDES_TRANS]);; (* ------------------------------------------------------------------------- *) (* More lemmas about coprimality. *) (* ------------------------------------------------------------------------- *) let INT_COPRIME_GCD = prove (`!a b. coprime(a,b) <=> gcd(a,b) = &1`, SIMP_TAC[GSYM INT_DIVIDES_ONE_POS; INT_GCD_POS] THEN INTEGER_TAC);; let int_coprime = prove (`!a b. coprime(a,b) <=> !d. d divides a /\ d divides b ==> d divides &1`, REWRITE_TAC[INT_COPRIME_GCD; INT_GCD_UNIQUE; INT_POS; INT_DIVIDES_1]);; let COPRIME = prove (`!a b. coprime(a,b) <=> !d. d divides a /\ d divides b <=> d divides &1`, MESON_TAC[INT_DIVIDES_1; INT_DIVIDES_TRANS; int_coprime]);; let INT_COPRIME_SYM = prove (`!a b. coprime(a,b) <=> coprime(b,a)`, INTEGER_TAC);; let INT_COPRIME_DIVPROD = prove (`!d a b. d divides (a * b) /\ coprime(d,a) ==> d divides b`, INTEGER_TAC);; let INT_COPRIME_1 = prove (`!a. coprime(a,&1) /\ coprime(&1,a)`, INTEGER_TAC);; let INT_GCD_COPRIME = prove (`!a b a' b'. ~(gcd(a,b) = &0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b) ==> coprime(a',b')`, INTEGER_TAC);; let INT_GCD_COPRIME_EXISTS = prove (`!a b. ~(gcd(a,b) = &0) ==> ?a' b'. (a = a' * gcd(a,b)) /\ (b = b' * gcd(a,b)) /\ coprime(a',b')`, INTEGER_TAC);; let INT_COPRIME_0 = prove (`(!a. coprime(a,&0) <=> a divides &1) /\ (!a. coprime(&0,a) <=> a divides &1)`, INTEGER_TAC);; let INT_COPRIME_MUL = prove (`!d a b. coprime(d,a) /\ coprime(d,b) ==> coprime(d,a * b)`, INTEGER_TAC);; let INT_COPRIME_LMUL2 = prove (`!d a b. coprime(d,a * b) ==> coprime(d,b)`, INTEGER_TAC);; let INT_COPRIME_RMUL2 = prove (`!d a b. coprime(d,a * b) ==> coprime(d,a)`, INTEGER_TAC);; let INT_COPRIME_LMUL = prove (`!d a b. coprime(a * b,d) <=> coprime(a,d) /\ coprime(b,d)`, INTEGER_TAC);; let INT_COPRIME_RMUL = prove (`!d a b. coprime(d,a * b) <=> coprime(d,a) /\ coprime(d,b)`, INTEGER_TAC);; let INT_COPRIME_REFL = prove (`!n. coprime(n,n) <=> n divides &1`, INTEGER_TAC);; let INT_COPRIME_PLUS1 = prove (`!n. coprime(n + &1,n) /\ coprime(n,n + &1)`, INTEGER_TAC);; let INT_COPRIME_MINUS1 = prove (`!n. coprime(n - &1,n) /\ coprime(n,n - &1)`, INTEGER_TAC);; let INT_COPRIME_RPOW = prove (`!m n k. coprime(m,n pow k) <=> coprime(m,n) \/ k = 0`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[INT_POW; INT_COPRIME_1; INT_COPRIME_RMUL; NOT_SUC] THEN CONV_TAC TAUT);; let INT_COPRIME_LPOW = prove (`!m n k. coprime(m pow k,n) <=> coprime(m,n) \/ k = 0`, ONCE_REWRITE_TAC[INT_COPRIME_SYM] THEN REWRITE_TAC[INT_COPRIME_RPOW]);; let INT_COPRIME_POW2 = prove (`!m n k. coprime(m pow k,n pow k) <=> coprime(m,n) \/ k = 0`, REWRITE_TAC[INT_COPRIME_RPOW; INT_COPRIME_LPOW; DISJ_ACI]);; let INT_COPRIME_POW = prove (`!n a d. coprime(d,a) ==> coprime(d,a pow n)`, SIMP_TAC[INT_COPRIME_RPOW]);; let INT_COPRIME_POW_IMP = prove (`!n a b. coprime(a,b) ==> coprime(a pow n,b pow n)`, MESON_TAC[INT_COPRIME_POW; INT_COPRIME_SYM]);; let INT_GCD_EQ_0 = prove (`!a b. gcd(a,b) = &0 <=> a = &0 /\ b = &0`, INTEGER_TAC);; let INT_DIVISION_DECOMP = prove (`!a b c. a divides (b * c) ==> ?b' c'. (a = b' * c') /\ b' divides b /\ c' divides c`, REPEAT STRIP_TAC THEN EXISTS_TAC `gcd(a,b)` THEN ASM_CASES_TAC `gcd(a,b) = &0` THEN REPEAT(POP_ASSUM MP_TAC) THENL [SIMP_TAC[INT_GCD_EQ_0; INT_GCD_0; INT_ABS_NUM]; INTEGER_TAC] THEN REWRITE_TAC[INT_MUL_LZERO] THEN MESON_TAC[INT_DIVIDES_REFL]);; let INT_DIVIDES_MUL = prove (`!m n r. m divides r /\ n divides r /\ coprime(m,n) ==> (m * n) divides r`, INTEGER_TAC);; let INT_CHINESE_REMAINDER = prove (`!a b u v. coprime(a,b) /\ ~(a = &0) /\ ~(b = &0) ==> ?x q1 q2. (x = u + q1 * a) /\ (x = v + q2 * b)`, INTEGER_TAC);; let INT_CHINESE_REMAINDER_USUAL = prove (`!a b u v. coprime(a,b) ==> ?x. (x == u) (mod a) /\ (x == v) (mod b)`, INTEGER_TAC);; let INT_COPRIME_DIVISORS = prove (`!a b d e. d divides a /\ e divides b /\ coprime(a,b) ==> coprime(d,e)`, INTEGER_TAC);; let INT_COPRIME_LNEG = prove (`!a b. coprime(--a,b) <=> coprime(a,b)`, INTEGER_TAC);; let INT_COPRIME_RNEG = prove (`!a b. coprime(a,--b) <=> coprime(a,b)`, INTEGER_TAC);; let INT_COPRIME_NEG = prove (`(!a b. coprime(--a,b) <=> coprime(a,b)) /\ (!a b. coprime(a,--b) <=> coprime(a,b))`, INTEGER_TAC);; let INT_COPRIME_LABS = prove (`!a b. coprime(abs a,b) <=> coprime(a,b)`, REWRITE_TAC[INT_ABS] THEN MESON_TAC[INT_COPRIME_LNEG]);; let INT_COPRIME_RABS = prove (`!a b. coprime(a,abs b) <=> coprime(a,b)`, REWRITE_TAC[INT_ABS] THEN MESON_TAC[INT_COPRIME_RNEG]);; let INT_COPRIME_ABS = prove (`(!a b. coprime(abs a,b) <=> coprime(a,b)) /\ (!a b. coprime(a,abs b) <=> coprime(a,b))`, REWRITE_TAC[INT_COPRIME_LABS; INT_COPRIME_RABS]);; (* ------------------------------------------------------------------------- *) (* More lemmas about congruences. *) (* ------------------------------------------------------------------------- *) let INT_CONG_MOD_0 = prove (`!x y. (x == y) (mod &0) <=> (x = y)`, INTEGER_TAC);; let INT_CONG_MOD_1 = prove (`!x y. (x == y) (mod &1)`, INTEGER_TAC);; let INT_CONG = prove (`!x y n. (x == y) (mod n) <=> n divides (x - y)`, INTEGER_TAC);; let INT_CONG_MUL_LCANCEL = prove (`!a n x y. coprime(a,n) /\ (a * x == a * y) (mod n) ==> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_MUL_RCANCEL = prove (`!a n x y. coprime(a,n) /\ (x * a == y * a) (mod n) ==> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_REFL = prove (`!x n. (x == x) (mod n)`, INTEGER_TAC);; let INT_EQ_IMP_CONG = prove (`!a b n. a = b ==> (a == b) (mod n)`, INTEGER_TAC);; let INT_CONG_SYM = prove (`!x y n. (x == y) (mod n) <=> (y == x) (mod n)`, INTEGER_TAC);; let INT_CONG_TRANS = prove (`!x y z n. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, INTEGER_TAC);; let INT_CONG_ADD = prove (`!x x' y y'. (x == x') (mod n) /\ (y == y') (mod n) ==> (x + y == x' + y') (mod n)`, INTEGER_TAC);; let INT_CONG_SUB = prove (`!x x' y y'. (x == x') (mod n) /\ (y == y') (mod n) ==> (x - y == x' - y') (mod n)`, INTEGER_TAC);; let INT_CONG_MUL = prove (`!x x' y y'. (x == x') (mod n) /\ (y == y') (mod n) ==> (x * y == x' * y') (mod n)`, INTEGER_TAC);; let INT_CONG_POW = prove (`!n k x y. (x == y) (mod n) ==> (x pow k == y pow k) (mod n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[INT_CONG_MUL; INT_POW; INT_CONG_REFL]);; let INT_CONG_MUL_LCANCEL_EQ = prove (`!a n x y. coprime(a,n) ==> ((a * x == a * y) (mod n) <=> (x == y) (mod n))`, INTEGER_TAC);; let INT_CONG_MUL_RCANCEL_EQ = prove (`!a n x y. coprime(a,n) ==> ((x * a == y * a) (mod n) <=> (x == y) (mod n))`, INTEGER_TAC);; let INT_CONG_ADD_LCANCEL_EQ = prove (`!a n x y. (a + x == a + y) (mod n) <=> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_ADD_RCANCEL_EQ = prove (`!a n x y. (x + a == y + a) (mod n) <=> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_ADD_RCANCEL = prove (`!a n x y. (x + a == y + a) (mod n) ==> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_ADD_LCANCEL = prove (`!a n x y. (a + x == a + y) (mod n) ==> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_ADD_LCANCEL_EQ_0 = prove (`!a n x y. (a + x == a) (mod n) <=> (x == &0) (mod n)`, INTEGER_TAC);; let INT_CONG_ADD_RCANCEL_EQ_0 = prove (`!a n x y. (x + a == a) (mod n) <=> (x == &0) (mod n)`, INTEGER_TAC);; let INT_CONG_INT_DIVIDES_MODULUS = prove (`!x y m n. (x == y) (mod m) /\ n divides m ==> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_0_DIVIDES = prove (`!n x. (x == &0) (mod n) <=> n divides x`, INTEGER_TAC);; let INT_CONG_1_DIVIDES = prove (`!n x. (x == &1) (mod n) ==> n divides (x - &1)`, INTEGER_TAC);; let INT_CONG_DIVIDES = prove (`!x y n. (x == y) (mod n) ==> (n divides x <=> n divides y)`, INTEGER_TAC);; let INT_CONG_COPRIME = prove (`!x y n. (x == y) (mod n) ==> (coprime(n,x) <=> coprime(n,y))`, INTEGER_TAC);; let INT_CONG_MOD_MULT = prove (`!x y m n. (x == y) (mod n) /\ m divides n ==> (x == y) (mod m)`, INTEGER_TAC);; let INT_CONG_TO_1 = prove (`!a n. (a == &1) (mod n) <=> ?m. a = &1 + m * n`, INTEGER_TAC);; let INT_CONG_SOLVE = prove (`!a b n. coprime(a,n) ==> ?x. (a * x == b) (mod n)`, INTEGER_TAC);; let INT_CONG_SOLVE_UNIQUE = prove (`!a b n. coprime(a,n) ==> !x y. (a * x == b) (mod n) /\ (a * y == b) (mod n) ==> (x == y) (mod n)`, INTEGER_TAC);; let INT_CONG_CHINESE = prove (`coprime(a,b) /\ (x == y) (mod a) /\ (x == y) (mod b) ==> (x == y) (mod (a * b))`, INTEGER_TAC);; let INT_CHINESE_REMAINDER_COPRIME = prove (`!a b m n. coprime(a,b) /\ ~(a = &0) /\ ~(b = &0) /\ coprime(m,a) /\ coprime(n,b) ==> ?x. coprime(x,a * b) /\ (x == m) (mod a) /\ (x == n) (mod b)`, INTEGER_TAC);; let INT_CHINESE_REMAINDER_COPRIME_UNIQUE = prove (`!a b m n x y. coprime(a,b) /\ (x == m) (mod a) /\ (x == n) (mod b) /\ (y == m) (mod a) /\ (y == n) (mod b) ==> (x == y) (mod (a * b))`, INTEGER_TAC);; let SOLVABLE_GCD = prove (`!a b n. gcd(a,n) divides b ==> ?x. (a * x == b) (mod n)`, INTEGER_TAC);; let INT_LINEAR_CONG_POS = prove (`!n a x:int. ~(n = &0) ==> ?y. &0 <= y /\ (a * x == a * y) (mod n)`, REPEAT STRIP_TAC THEN EXISTS_TAC `x + abs(x * n):int` THEN CONJ_TAC THENL [MATCH_MP_TAC(INT_ARITH `abs(x:int) * &1 <= y ==> &0 <= x + y`) THEN REWRITE_TAC[INT_ABS_MUL] THEN MATCH_MP_TAC INT_LE_LMUL THEN ASM_INT_ARITH_TAC; MATCH_MP_TAC(INTEGER_RULE `n divides y ==> (a * x:int == a * (x + y)) (mod n)`) THEN REWRITE_TAC[INT_DIVIDES_RABS] THEN INTEGER_TAC]);; let INT_CONG_SOLVE_POS = prove (`!a b n:int. coprime(a,n) /\ ~(n = &0 /\ abs a = &1) ==> ?x. &0 <= x /\ (a * x == b) (mod n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n:int = &0` THEN ASM_REWRITE_TAC[INT_COPRIME_0; INT_DIVIDES_ONE] THENL [INT_ARITH_TAC; ASM_MESON_TAC[INT_LINEAR_CONG_POS; INT_CONG_SOLVE; INT_CONG_TRANS; INT_CONG_SYM]]);; let INT_CONG_IMP_EQ = prove (`!x y n:int. abs(x - y) < n /\ (x == y) (mod n) ==> x = y`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[int_congruent; GSYM INT_SUB_0] THEN DISCH_THEN(X_CHOOSE_THEN `q:int` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `abs(n * q) < n ==> abs(n * q) < abs n * &1`)) THEN REWRITE_TAC[INT_ABS_MUL; INT_ENTIRE] THEN REWRITE_TAC[INT_ARITH `abs n * (q:int) < abs n * &1 <=> ~(&0 <= abs n * (q - &1))`] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A stronger form of the CRT. *) (* ------------------------------------------------------------------------- *) let INT_CRT_STRONG = prove (`!a1 a2 n1 n2:int. (a1 == a2) (mod (gcd(n1,n2))) ==> ?x. (x == a1) (mod n1) /\ (x == a2) (mod n2)`, INTEGER_TAC);; let INT_CRT_STRONG_IFF = prove (`!a1 a2 n1 n2:int. (?x. (x == a1) (mod n1) /\ (x == a2) (mod n2)) <=> (a1 == a2) (mod (gcd(n1,n2)))`, INTEGER_TAC);; (* ------------------------------------------------------------------------- *) (* Other miscellaneous lemmas. *) (* ------------------------------------------------------------------------- *) let EVEN_SQUARE_MOD4 = prove (`((&2 * n) pow 2 == &0) (mod &4)`, INTEGER_TAC);; let ODD_SQUARE_MOD4 = prove (`((&2 * n + &1) pow 2 == &1) (mod &4)`, INTEGER_TAC);; let INT_DIVIDES_LE = prove (`!x y. x divides y ==> abs(x) <= abs(y) \/ y = &0`, REWRITE_TAC[int_divides; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:int`; `y:int`; `z:int`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INT_ABS_MUL; INT_ENTIRE] THEN REWRITE_TAC[INT_ARITH `x <= x * z <=> &0 <= x * (z - &1)`] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `z = &0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC);; let INT_DIVIDES_POW_LE = prove (`!p m n. &2 <= abs p ==> ((p pow m) divides (p pow n) <=> m <= n)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_SIMP_TAC[INT_POW_EQ_0; INT_ARITH `&2 <= abs p ==> ~(p = &0)`] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[INT_NOT_LE; NOT_LE; INT_ABS_POW] THEN ASM_MESON_TAC[INT_POW_MONO_LT; ARITH_RULE `&2 <= x ==> &1 < x`]; SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; INT_POW_ADD] THEN INTEGER_TAC]);; (* ------------------------------------------------------------------------- *) (* Integer primality / irreducibility. *) (* ------------------------------------------------------------------------- *) let int_prime = new_definition `int_prime p <=> abs(p) > &1 /\ !x. x divides p ==> abs(x) = &1 \/ abs(x) = abs(p)`;; let INT_PRIME_NEG = prove (`!p. int_prime(--p) <=> int_prime p`, REWRITE_TAC[int_prime; INT_DIVIDES_RNEG; INT_ABS_NEG]);; let INT_PRIME_ABS = prove (`!p. int_prime(abs p) <=> int_prime p`, GEN_TAC THEN REWRITE_TAC[INT_ABS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_PRIME_NEG]);; let INT_PRIME_GE_2 = prove (`!p. int_prime p ==> &2 <= abs(p)`, REWRITE_TAC[int_prime] THEN INT_ARITH_TAC);; let INT_PRIME_0 = prove (`~(int_prime(&0))`, REWRITE_TAC[int_prime] THEN INT_ARITH_TAC);; let INT_PRIME_1 = prove (`~(int_prime(&1))`, REWRITE_TAC[int_prime] THEN INT_ARITH_TAC);; let INT_PRIME_2 = prove (`int_prime(&2)`, REWRITE_TAC[int_prime] THEN CONV_TAC INT_REDUCE_CONV THEN X_GEN_TAC `x:int` THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[INT_DIVIDES_ZERO] THEN CONV_TAC INT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC);; let INT_PRIME_FACTOR = prove (`!x. ~(abs x = &1) ==> ?p. int_prime p /\ p divides x`, MATCH_MP_TAC WF_INT_MEASURE THEN EXISTS_TAC `abs` THEN REWRITE_TAC[INT_ABS_POS] THEN X_GEN_TAC `x:int` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `int_prime x` THENL [EXISTS_TAC `x:int` THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC; ALL_TAC] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `&2` THEN ASM_REWRITE_TAC[INT_PRIME_2; INT_DIVIDES_0]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [int_prime]) THEN ASM_SIMP_TAC[INT_ARITH `~(x = &0) /\ ~(abs x = &1) ==> abs x > &1`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN DISCH_THEN(X_CHOOSE_THEN `y:int` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:int`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN UNDISCH_TAC `y divides x` THEN INTEGER_TAC]);; let INT_PRIME_FACTOR_LT = prove (`!n m p. int_prime(p) /\ ~(n = &0) /\ n = p * m ==> abs m < abs n`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INT_ABS_MUL] THEN MATCH_MP_TAC(INT_ARITH `&0 < m * (p - &1) ==> m < p * m`) THEN MATCH_MP_TAC INT_LT_MUL THEN UNDISCH_TAC `~(n = &0)` THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[INT_MUL_RZERO] THEN DISCH_THEN(K ALL_TAC) THEN CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INT_PRIME_GE_2) THEN INT_ARITH_TAC);; let INT_PRIME_FACTOR_INDUCT = prove (`!P. P(&0) /\ P(&1) /\ P(-- &1) /\ (!p n. int_prime p /\ ~(n = &0) /\ P n ==> P(p * n)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC WF_INT_MEASURE THEN EXISTS_TAC `abs` THEN REWRITE_TAC[INT_ABS_POS] THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `abs n = &1` THENL [ASM_MESON_TAC[INT_ARITH `abs x = &a <=> x = &a \/ x = -- &a`]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `p:int` STRIP_ASSUME_TAC o MATCH_MP INT_PRIME_FACTOR) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d:int` SUBST_ALL_TAC o GEN_REWRITE_RULE I [int_divides]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:int`; `d:int`]) THEN RULE_ASSUM_TAC(REWRITE_RULE[INT_ENTIRE; DE_MORGAN_THM]) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[INT_PRIME_FACTOR_LT; INT_ENTIRE]);; (* ------------------------------------------------------------------------- *) (* Infinitude. *) (* ------------------------------------------------------------------------- *) let INT_DIVIDES_FACT = prove (`!n x. &1 <= abs(x) /\ abs(x) <= &n ==> x divides &(FACT n)`, INDUCT_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FACT; INT_ARITH `x <= &n <=> x = &n \/ x < &n`] THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `x < &m + &1 <=> x <= &m`] THEN REWRITE_TAC[INT_OF_NUM_SUC; GSYM INT_OF_NUM_MUL] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INT_DIVIDES_LMUL] THEN MATCH_MP_TAC INT_DIVIDES_RMUL THEN ASM_MESON_TAC[INT_DIVIDES_LABS; INT_DIVIDES_REFL]);; let INT_EUCLID_BOUND = prove (`!n. ?p. int_prime(p) /\ &n < p /\ p <= &(FACT n) + &1`, GEN_TAC THEN MP_TAC(SPEC `&(FACT n) + &1` INT_PRIME_FACTOR) THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_ABS_NUM; INT_OF_NUM_EQ] THEN REWRITE_TAC[EQ_ADD_RCANCEL_0; FACT_NZ; GSYM INT_OF_NUM_ADD] THEN DISCH_THEN(X_CHOOSE_THEN `p:int` STRIP_ASSUME_TAC) THEN EXISTS_TAC `abs p` THEN ASM_REWRITE_TAC[INT_PRIME_ABS] THEN CONJ_TAC THENL [ALL_TAC; FIRST_ASSUM(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_SUC] THEN INT_ARITH_TAC] THEN REWRITE_TAC[GSYM INT_NOT_LE] THEN DISCH_TAC THEN MP_TAC(SPECL [`n:num`; `p:int`] INT_DIVIDES_FACT) THEN ASM_SIMP_TAC[INT_PRIME_GE_2; INT_ARITH `&2 <= p ==> &1 <= p`] THEN DISCH_TAC THEN SUBGOAL_THEN `p divides &1` MP_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC; REWRITE_TAC[INT_DIVIDES_ONE] THEN ASM_MESON_TAC[INT_PRIME_NEG; INT_PRIME_1]]);; let INT_EUCLID = prove (`!n. ?p. int_prime(p) /\ p > n`, MP_TAC INT_IMAGE THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:int` THEN REWRITE_TAC[INT_GT] THEN ASM_REWRITE_TAC[OR_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MP_TAC INT_EUCLID_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN INT_ARITH_TAC);; let INT_PRIMES_INFINITE = prove (`INFINITE {p | int_prime p}`, SUBGOAL_THEN `INFINITE {n | int_prime(&n)}` MP_TAC THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THENL [REWRITE_TAC[num_FINITE; IN_ELIM_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; NOT_IMP; NOT_LE] THEN REWRITE_TAC[GSYM INT_OF_NUM_LT; INT_EXISTS_POS] THEN MP_TAC INT_EUCLID_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN INT_ARITH_TAC; MP_TAC(ISPECL [`&`; `{p | int_prime p}`] FINITE_IMAGE_INJ) THEN REWRITE_TAC[INT_OF_NUM_EQ; IN_ELIM_THM]]);; let INT_COPRIME_PRIME = prove (`!p a b. coprime(a,b) ==> ~(int_prime(p) /\ p divides a /\ p divides b)`, REWRITE_TAC[int_coprime] THEN MESON_TAC[INT_DIVIDES_ONE; INT_PRIME_NEG; INT_PRIME_1]);; let INT_COPRIME_PRIME_EQ = prove (`!a b. coprime(a,b) <=> !p. ~(int_prime(p) /\ p divides a /\ p divides b)`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[INT_COPRIME_PRIME]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[int_coprime; INT_DIVIDES_ONE_ABS] THEN ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `d:int` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(X_CHOOSE_TAC `p:int` o MATCH_MP INT_PRIME_FACTOR) THEN EXISTS_TAC `p:int` THEN ASM_MESON_TAC[INT_DIVIDES_TRANS]);; let INT_PRIME_COPRIME = prove (`!x p. int_prime(p) ==> p divides x \/ coprime(p,x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[int_coprime] THEN MATCH_MP_TAC(TAUT `(~b ==> a) ==> a \/ b`) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; INT_DIVIDES_ONE_ABS] THEN DISCH_THEN(X_CHOOSE_THEN `d:int` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [int_prime]) THEN DISCH_THEN(MP_TAC o SPEC `d:int` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[INT_DIVIDES_TRANS; INT_DIVIDES_LABS; INT_DIVIDES_RABS]);; let INT_PRIME_COPRIME_EQ = prove (`!p n. int_prime p ==> (coprime(p,n) <=> ~(p divides n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(b \/ a) /\ ~(a /\ b) ==> (a <=> ~b)`) THEN ASM_SIMP_TAC[INT_PRIME_COPRIME; int_coprime; INT_DIVIDES_ONE_ABS] THEN ASM_MESON_TAC[INT_DIVIDES_REFL; INT_PRIME_1; INT_PRIME_ABS]);; let INT_COPRIME_PRIMEPOW = prove (`!p k m. int_prime p /\ ~(k = 0) ==> (coprime(m,p pow k) <=> ~(p divides m))`, SIMP_TAC[INT_COPRIME_RPOW] THEN ONCE_REWRITE_TAC[INT_COPRIME_SYM] THEN SIMP_TAC[INT_PRIME_COPRIME_EQ]);; let INT_COPRIME_BEZOUT = prove (`!a b. coprime(a,b) <=> ?x y. a * x + b * y = &1`, INTEGER_TAC);; let INT_COPRIME_BEZOUT_ALT = prove (`!a b. coprime(a,b) ==> ?x y. a * x = b * y + &1`, INTEGER_TAC);; let INT_BEZOUT_PRIME = prove (`!a p. int_prime p /\ ~(p divides a) ==> ?x y. a * x = p * y + &1`, MESON_TAC[INT_COPRIME_BEZOUT_ALT; INT_COPRIME_SYM; INT_PRIME_COPRIME_EQ]);; let INT_PRIME_DIVPROD = prove (`!p a b. int_prime(p) /\ p divides (a * b) ==> p divides a \/ p divides b`, ONCE_REWRITE_TAC[TAUT `a /\ b ==> c \/ d <=> a ==> (~c /\ ~d ==> ~b)`] THEN SIMP_TAC[GSYM INT_PRIME_COPRIME_EQ] THEN INTEGER_TAC);; let INT_PRIME_DIVPROD_EQ = prove (`!p a b. int_prime(p) ==> (p divides (a * b) <=> p divides a \/ p divides b)`, MESON_TAC[INT_PRIME_DIVPROD; INT_DIVIDES_LMUL; INT_DIVIDES_RMUL]);; let INT_PRIME_DIVPOW = prove (`!n p x. int_prime(p) /\ p divides (x pow n) ==> p divides x`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_SIMP_TAC[GSYM INT_PRIME_COPRIME_EQ; INT_COPRIME_POW]);; let INT_PRIME_DIVPOW_N = prove (`!n p x. int_prime p /\ p divides (x pow n) ==> (p pow n) divides (x pow n)`, MESON_TAC[INT_PRIME_DIVPOW; INT_DIVIDES_POW]);; let INT_COPRIME_SOS = prove (`!x y. coprime(x,y) ==> coprime(x * y,x pow 2 + y pow 2)`, INTEGER_TAC);; let INT_PRIME_IMP_NZ = prove (`!p. int_prime p ==> ~(p = &0)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INT_PRIME_GE_2) THEN INT_ARITH_TAC);; let INT_DISTINCT_PRIME_COPRIME = prove (`!p q. int_prime p /\ int_prime q /\ ~(abs p = abs q) ==> coprime(p,q)`, REWRITE_TAC[GSYM INT_DIVIDES_ANTISYM_ABS] THEN MESON_TAC[INT_COPRIME_SYM; INT_PRIME_COPRIME_EQ]);; let INT_PRIME_COPRIME_LT = prove (`!x p. int_prime p /\ &0 < abs x /\ abs x < abs p ==> coprime(x,p)`, ONCE_REWRITE_TAC[INT_COPRIME_SYM] THEN SIMP_TAC[INT_PRIME_COPRIME_EQ] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC);; let INT_DIVIDES_PRIME_PRIME = prove (`!p q. int_prime p /\ int_prime q ==> (p divides q <=> abs p = abs q)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_SIMP_TAC[GSYM INT_PRIME_COPRIME_EQ; INT_DISTINCT_PRIME_COPRIME]; SIMP_TAC[GSYM INT_DIVIDES_ANTISYM_ABS]]);; let INT_COPRIME_POW_DIVPROD = prove (`!d a b. (d pow n) divides (a * b) /\ coprime(d,a) ==> (d pow n) divides b`, MESON_TAC[INT_COPRIME_DIVPROD; INT_COPRIME_POW; INT_COPRIME_SYM]);; let INT_PRIME_COPRIME_CASES = prove (`!p a b. int_prime p /\ coprime(a,b) ==> coprime(p,a) \/ coprime(p,b)`, MESON_TAC[INT_COPRIME_PRIME; INT_PRIME_COPRIME_EQ]);; let INT_PRIME_DIVPROD_POW = prove (`!n p a b. int_prime(p) /\ coprime(a,b) /\ (p pow n) divides (a * b) ==> (p pow n) divides a \/ (p pow n) divides b`, MESON_TAC[INT_COPRIME_POW_DIVPROD; INT_PRIME_COPRIME_CASES; INT_MUL_SYM]);; let INT_DIVIDES_POW2_REV = prove (`!n a b. (a pow n) divides (b pow n) /\ ~(n = 0) ==> a divides b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = &0` THENL [ASM_MESON_TAC[INT_GCD_EQ_0; INT_DIVIDES_REFL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INT_GCD_COPRIME_EXISTS) THEN STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_POW_MUL] THEN ASM_SIMP_TAC[INT_POW_EQ_0; INT_DIVIDES_RMUL2_EQ] THEN DISCH_THEN(MP_TAC o MATCH_MP (INTEGER_RULE `a divides b ==> coprime(a,b) ==> a divides &1`)) THEN ASM_SIMP_TAC[INT_COPRIME_POW2] THEN ASM_MESON_TAC[INT_DIVIDES_POW2; INT_DIVIDES_TRANS; INT_DIVIDES_1]);; let INT_DIVIDES_POW2_EQ = prove (`!n a b. ~(n = 0) ==> ((a pow n) divides (b pow n) <=> a divides b)`, MESON_TAC[INT_DIVIDES_POW2_REV; INT_DIVIDES_POW]);; let INT_POW_MUL_EXISTS = prove (`!m n p k. ~(m = &0) /\ m pow k * n = p pow k ==> ?q. n = q pow k`, REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 0` THEN ASM_SIMP_TAC[INT_POW; INT_MUL_LID] THEN STRIP_TAC THEN MP_TAC(SPECL [`k:num`; `m:int`; `p:int`] INT_DIVIDES_POW2_REV) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[int_divides; INT_MUL_SYM]; ALL_TAC] THEN REWRITE_TAC[int_divides] THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN ASM_SIMP_TAC[INT_POW_MUL; INT_EQ_MUL_LCANCEL; INT_POW_EQ_0] THEN MESON_TAC[]);; let INT_COPRIME_POW_ABS = prove (`!n a b c. coprime(a,b) /\ a * b = c pow n ==> ?r s. abs a = r pow n /\ abs b = s pow n`, GEN_TAC THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[INT_POW] THEN MESON_TAC[INT_ABS_MUL_1; INT_ABS_NUM]; ALL_TAC] THEN MATCH_MP_TAC INT_PRIME_FACTOR_INDUCT THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN ASM_REWRITE_TAC[INT_POW_ZERO; INT_ENTIRE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC DISJ_CASES_TAC) THEN ASM_SIMP_TAC[INT_COPRIME_0; INT_DIVIDES_ONE_ABS; INT_ABS_NUM] THEN ASM_MESON_TAC[INT_POW_ONE; INT_POW_ZERO]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `abs:int->int`) THEN SIMP_TAC[INT_POW_ONE; INT_ABS_NUM; INT_ABS_MUL_1] THEN MESON_TAC[INT_POW_ONE]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `abs:int->int`) THEN SIMP_TAC[INT_POW_ONE; INT_ABS_POW; INT_ABS_NEG; INT_ABS_NUM; INT_ABS_MUL_1] THEN MESON_TAC[INT_POW_ONE]; REWRITE_TAC[INT_POW_MUL] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `p pow n divides a \/ p pow n divides b` MP_TAC THENL [ASM_MESON_TAC[INT_PRIME_DIVPROD_POW; int_divides]; ALL_TAC] THEN REWRITE_TAC[int_divides] THEN DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `d:int` SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_COPRIME_SYM]) THEN ASM_SIMP_TAC[INT_COPRIME_RMUL; INT_COPRIME_LMUL; INT_COPRIME_LPOW; INT_COPRIME_RPOW] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`b:int`; `d:int`]); FIRST_X_ASSUM(MP_TAC o SPECL [`d:int`; `a:int`])] THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [MATCH_MP_TAC(INT_RING `!p. ~(p = &0) /\ a * p = b * p ==> a = b`) THEN EXISTS_TAC `p pow n` THEN ASM_SIMP_TAC[INT_POW_EQ_0; INT_PRIME_IMP_NZ] THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC INT_RING; STRIP_TAC THEN ASM_REWRITE_TAC[INT_ABS_POW; GSYM INT_POW_MUL; INT_ABS_MUL] THEN MESON_TAC[]])]);; let INT_COPRIME_POW_ODD = prove (`!n a b c. ODD n /\ coprime(a,b) /\ a * b = c pow n ==> ?r s. a = r pow n /\ b = s pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `a:int`; `b:int`; `c:int`] INT_COPRIME_POW_ABS) THEN ASM_REWRITE_TAC[INT_ABS] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[INT_ABS] THEN ASM_MESON_TAC[INT_POW_NEG; INT_NEG_NEG; NOT_ODD]);; let INT_DIVIDES_PRIME_POW_LE = prove (`!p q m n. int_prime p /\ int_prime q ==> ((p pow m) divides (q pow n) <=> m = 0 \/ abs p = abs q /\ m <= n)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[INT_POW; INT_DIVIDES_1] THEN GEN_REWRITE_TAC LAND_CONV [GSYM INT_DIVIDES_LABS] THEN GEN_REWRITE_TAC LAND_CONV [GSYM INT_DIVIDES_RABS] THEN REWRITE_TAC[INT_ABS_POW] THEN EQ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`); ALL_TAC] THEN ASM_MESON_TAC[INT_DIVIDES_POW_LE; INT_PRIME_GE_2; INT_PRIME_DIVPOW; INT_ABS_ABS; INT_PRIME_ABS; INT_DIVIDES_POW2; INT_DIVIDES_PRIME_PRIME]);; let INT_EQ_PRIME_POW_ABS = prove (`!p q m n. int_prime p /\ int_prime q ==> (abs p pow m = abs q pow n <=> m = 0 /\ n = 0 \/ abs p = abs q /\ m = n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_ABS_POW] THEN GEN_REWRITE_TAC LAND_CONV [GSYM INT_DIVIDES_ANTISYM_ABS] THEN ASM_SIMP_TAC[INT_DIVIDES_PRIME_POW_LE; INT_PRIME_ABS] THEN ASM_CASES_TAC `abs p = abs q` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; let INT_EQ_PRIME_POW_POS = prove (`!p q m n. int_prime p /\ int_prime q /\ &0 <= p /\ &0 <= q ==> (p pow m = q pow n <=> m = 0 /\ n = 0 \/ p = q /\ m = n)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:int`; `q:int`; `m:num`; `n:num`] INT_EQ_PRIME_POW_ABS) THEN ASM_SIMP_TAC[INT_ABS]);; let INT_DIVIDES_FACT_PRIME = prove (`!p. int_prime p ==> !n. p divides &(FACT n) <=> abs p <= &n`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT] THENL [REWRITE_TAC[INT_ARITH `abs x <= &0 <=> x = &0`] THEN ASM_MESON_TAC[INT_DIVIDES_ONE; INT_PRIME_NEG; INT_PRIME_0; INT_PRIME_1]; ASM_SIMP_TAC[INT_PRIME_DIVPROD_EQ; GSYM INT_OF_NUM_MUL] THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN ASM_MESON_TAC[INT_DIVIDES_LE; INT_ARITH `x <= n ==> x <= n + &1`; INT_DIVIDES_REFL; INT_DIVIDES_LABS; INT_ARITH `p <= n + &1 ==> p <= n \/ p = n + &1`; INT_ARITH `~(&n + &1 = &0)`; INT_ARITH `abs(&n + &1) = &n + &1`]]);; hol-light/Library/isum.ml000066400000000000000000000253211303454263000156630ustar00rootroot00000000000000(* ========================================================================= *) (* Define integer sums, with most theorems derived automatically. *) (* ========================================================================= *) let isum = new_definition `isum = iterate((+):int->int->int)`;; let NEUTRAL_INT_ADD = prove (`neutral((+):int->int->int) = &0`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[INT_ADD_LID; INT_ADD_RID]);; let MONOIDAL_INT_ADD = prove (`monoidal((+):int->int->int)`, REWRITE_TAC[monoidal; NEUTRAL_INT_ADD] THEN INT_ARITH_TAC);; let ISUM_SUPPORT = prove (`!f s. isum (support (+) f s) f = isum s f`, REWRITE_TAC[isum; ITERATE_SUPPORT]);; let int_isum = prove (`!f:A->int s. real_of_int(isum s f) = sum s (\x. real_of_int(f x))`, REPEAT GEN_TAC THEN REWRITE_TAC[sum; isum] THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN SUBGOAL_THEN `support(+) (\x:A. real_of_int(f x)) s = support(+) f s` SUBST1_TAC THENL [REWRITE_TAC[support; NEUTRAL_REAL_ADD; NEUTRAL_INT_ADD] THEN REWRITE_TAC[GSYM int_of_num_th; GSYM int_eq]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NEUTRAL_REAL_ADD; NEUTRAL_INT_ADD; int_of_num_th] THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`support(+) (f:A->int) s`,`s:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_INT_ADD; MONOIDAL_REAL_ADD] THEN SIMP_TAC[NEUTRAL_INT_ADD; NEUTRAL_REAL_ADD; int_of_num_th; int_add_th]);; (* ------------------------------------------------------------------------- *) (* Generalize INT_OF_REAL_THM for most common sum patterns. *) (* ------------------------------------------------------------------------- *) let INT_OF_REAL_THM = let dest = `real_of_int` and real_ty = `:real` and int_ty = `:int` and cond_th = prove (`real_of_int(if b then x else y) = if b then real_of_int x else real_of_int y`, COND_CASES_TAC THEN REWRITE_TAC[]) and compose_th = prove (`(\x. real_of_int((f o g) x)) = (\x. real_of_int(f x)) o g`, REWRITE_TAC[o_DEF]) in let thlist = map GSYM [int_eq; int_le; int_lt; int_ge; int_gt; int_of_num_th; int_neg_th; int_add_th; int_mul_th; int_sub_th; int_abs_th; int_max_th; int_min_th; int_pow_th; int_isum; GSYM BETA_THM; GSYM ETA_AX; compose_th; cond_th] in let REW_RULE = GEN_REWRITE_RULE REDEPTH_CONV thlist in let is_fun_into_real ty = try match dest_type ty with "fun",[s;t] when t = real_ty -> mk_fun_ty s int_ty | "real",[] -> int_ty | _ -> failwith "" with Failure _ -> ty in let int_of_real_ty ty = try match dest_type ty with "real",[] -> int_ty | "fun",[s;t] when t = real_ty -> mk_fun_ty s int_ty | _ -> ty with Failure _ -> ty in let int_tm_of_real_var v = let s,ty = dest_var v in let tys,rty = splitlist dest_fun_ty ty in if rty <> real_ty then v else let ity = itlist mk_fun_ty tys int_ty in let vs = map genvar tys in list_mk_abs(vs,mk_comb(dest,list_mk_comb(mk_var(s,ity),vs))) in let int_of_real_var v = let s,ty = dest_var v in let tys,rty = splitlist dest_fun_ty ty in if rty <> real_ty then v else let ity = itlist mk_fun_ty tys int_ty in mk_var(s,ity) in let INT_OF_REAL_THM1 th = let newavs = subtract (frees (concl th)) (freesl (hyp th)) in let avs,bod = strip_forall(concl th) in let allavs = newavs@avs in let avs' = map int_tm_of_real_var allavs in let avs'' = map int_of_real_var avs in GENL avs'' (REW_RULE(SPECL avs' (GENL newavs th))) in let rec INT_OF_REAL_THM th = if is_conj(concl th) then CONJ (INT_OF_REAL_THM1 (CONJUNCT1 th)) (INT_OF_REAL_THM1 (CONJUNCT2 th)) else INT_OF_REAL_THM1 th in INT_OF_REAL_THM;; (* ------------------------------------------------------------------------- *) (* Apply it in all the cases where it works. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_ISUM = INT_OF_REAL_THM CARD_EQ_SUM;; let INT_SUB_POW = INT_OF_REAL_THM REAL_SUB_POW;; let ISUM_0 = INT_OF_REAL_THM SUM_0;; let ISUM_ABS = INT_OF_REAL_THM SUM_ABS;; let ISUM_ABS_BOUND = INT_OF_REAL_THM SUM_ABS_BOUND;; let ISUM_ABS_LE = INT_OF_REAL_THM SUM_ABS_LE;; let ISUM_ABS_NUMSEG = INT_OF_REAL_THM SUM_ABS_NUMSEG;; let ISUM_ADD = INT_OF_REAL_THM SUM_ADD;; let ISUM_ADD_NUMSEG = INT_OF_REAL_THM SUM_ADD_NUMSEG;; let ISUM_ADD_SPLIT = INT_OF_REAL_THM SUM_ADD_SPLIT;; let ISUM_BIJECTION = INT_OF_REAL_THM SUM_BIJECTION;; let ISUM_BOUND = INT_OF_REAL_THM SUM_BOUND;; let ISUM_BOUND_LT = INT_OF_REAL_THM SUM_BOUND_LT;; let ISUM_BOUND_LT_ALL = INT_OF_REAL_THM SUM_BOUND_LT_ALL;; let ISUM_CASES = INT_OF_REAL_THM SUM_CASES;; let ISUM_CLAUSES = INT_OF_REAL_THM SUM_CLAUSES;; let ISUM_CLAUSES_LEFT = INT_OF_REAL_THM SUM_CLAUSES_LEFT;; let ISUM_CLAUSES_NUMSEG = INT_OF_REAL_THM SUM_CLAUSES_NUMSEG;; let ISUM_CLAUSES_RIGHT = INT_OF_REAL_THM SUM_CLAUSES_RIGHT;; let ISUM_COMBINE_L = INT_OF_REAL_THM SUM_COMBINE_L;; let ISUM_COMBINE_R = INT_OF_REAL_THM SUM_COMBINE_R;; let ISUM_CONST = INT_OF_REAL_THM SUM_CONST;; let ISUM_CONST_NUMSEG = INT_OF_REAL_THM SUM_CONST_NUMSEG;; let ISUM_DELETE = INT_OF_REAL_THM SUM_DELETE;; let ISUM_DELETE_CASES = INT_OF_REAL_THM SUM_DELETE_CASES;; let ISUM_DELTA = INT_OF_REAL_THM SUM_DELTA;; let ISUM_DIFF = INT_OF_REAL_THM SUM_DIFF;; let ISUM_DIFFS = INT_OF_REAL_THM SUM_DIFFS;; let ISUM_EQ = INT_OF_REAL_THM SUM_EQ;; let ISUM_EQ_0 = INT_OF_REAL_THM SUM_EQ_0;; let ISUM_EQ_0_NUMSEG = INT_OF_REAL_THM SUM_EQ_0_NUMSEG;; let ISUM_EQ_GENERAL = INT_OF_REAL_THM SUM_EQ_GENERAL;; let ISUM_EQ_GENERAL_INVERSES = INT_OF_REAL_THM SUM_EQ_GENERAL_INVERSES;; let ISUM_EQ_NUMSEG = INT_OF_REAL_THM SUM_EQ_NUMSEG;; let ISUM_EQ_SUPERSET = INT_OF_REAL_THM SUM_EQ_SUPERSET;; let ISUM_GROUP = INT_OF_REAL_THM SUM_GROUP;; let ISUM_IMAGE = INT_OF_REAL_THM SUM_IMAGE;; let ISUM_IMAGE_GEN = INT_OF_REAL_THM SUM_IMAGE_GEN;; let ISUM_IMAGE_LE = INT_OF_REAL_THM SUM_IMAGE_LE;; let ISUM_IMAGE_NONZERO = INT_OF_REAL_THM SUM_IMAGE_NONZERO;; let ISUM_INCL_EXCL = INT_OF_REAL_THM SUM_INCL_EXCL;; let ISUM_INJECTION = INT_OF_REAL_THM SUM_INJECTION;; let ISUM_LE = INT_OF_REAL_THM SUM_LE;; let ISUM_LE_INCLUDED = INT_OF_REAL_THM SUM_LE_INCLUDED;; let ISUM_LE_NUMSEG = INT_OF_REAL_THM SUM_LE_NUMSEG;; let ISUM_LMUL = INT_OF_REAL_THM SUM_LMUL;; let ISUM_LT = INT_OF_REAL_THM SUM_LT;; let ISUM_LT_ALL = INT_OF_REAL_THM SUM_LT_ALL;; let ISUM_MULTICOUNT = INT_OF_REAL_THM SUM_MULTICOUNT;; let ISUM_MULTICOUNT_GEN = INT_OF_REAL_THM SUM_MULTICOUNT_GEN;; let ISUM_NEG = INT_OF_REAL_THM SUM_NEG;; let ISUM_OFFSET = INT_OF_REAL_THM SUM_OFFSET;; let ISUM_OFFSET_0 = INT_OF_REAL_THM SUM_OFFSET_0;; let ISUM_PARTIAL_PRE = INT_OF_REAL_THM SUM_PARTIAL_PRE;; let ISUM_PARTIAL_SUC = INT_OF_REAL_THM SUM_PARTIAL_SUC;; let ISUM_POS_BOUND = INT_OF_REAL_THM SUM_POS_BOUND;; let ISUM_POS_EQ_0 = INT_OF_REAL_THM SUM_POS_EQ_0;; let ISUM_POS_EQ_0_NUMSEG = INT_OF_REAL_THM SUM_POS_EQ_0_NUMSEG;; let ISUM_POS_LE = INT_OF_REAL_THM SUM_POS_LE;; let ISUM_POS_LE_NUMSEG = INT_OF_REAL_THM SUM_POS_LE_NUMSEG;; let ISUM_RESTRICT = INT_OF_REAL_THM SUM_RESTRICT;; let ISUM_RESTRICT_SET = INT_OF_REAL_THM SUM_RESTRICT_SET;; let ISUM_RMUL = INT_OF_REAL_THM SUM_RMUL;; let ISUM_SING = INT_OF_REAL_THM SUM_SING;; let ISUM_SING_NUMSEG = INT_OF_REAL_THM SUM_SING_NUMSEG;; let ISUM_SUB = INT_OF_REAL_THM SUM_SUB;; let ISUM_SUBSET = INT_OF_REAL_THM SUM_SUBSET;; let ISUM_SUBSET_SIMPLE = INT_OF_REAL_THM SUM_SUBSET_SIMPLE;; let ISUM_SUB_NUMSEG = INT_OF_REAL_THM SUM_SUB_NUMSEG;; let ISUM_ISUM_RESTRICT = INT_OF_REAL_THM SUM_SUM_RESTRICT;; let ISUM_SUPERSET = INT_OF_REAL_THM SUM_SUPERSET;; let ISUM_SWAP = INT_OF_REAL_THM SUM_SWAP;; let ISUM_SWAP_NUMSEG = INT_OF_REAL_THM SUM_SWAP_NUMSEG;; let ISUM_TRIV_NUMSEG = INT_OF_REAL_THM SUM_TRIV_NUMSEG;; let ISUM_UNION = INT_OF_REAL_THM SUM_UNION;; let ISUM_UNIONS_NONZERO = INT_OF_REAL_THM SUM_UNIONS_NONZERO;; let ISUM_UNION_EQ = INT_OF_REAL_THM SUM_UNION_EQ;; let ISUM_UNION_LZERO = INT_OF_REAL_THM SUM_UNION_LZERO;; let ISUM_UNION_NONZERO = INT_OF_REAL_THM SUM_UNION_NONZERO;; let ISUM_UNION_RZERO = INT_OF_REAL_THM SUM_UNION_RZERO;; let ISUM_ZERO_EXISTS = INT_OF_REAL_THM SUM_ZERO_EXISTS;; let REAL_OF_NUM_ISUM = INT_OF_REAL_THM REAL_OF_NUM_SUM;; let REAL_OF_NUM_ISUM_NUMSEG = INT_OF_REAL_THM REAL_OF_NUM_SUM_NUMSEG;; (* ------------------------------------------------------------------------- *) (* Manually derive the few cases where it doesn't. *) (* *) (* Note that SUM_BOUND_GEN and SUM_BOUND_LT_GEN don't seem to have immediate *) (* analogs over the integers since they involve division. *) (* *) (* Should really roll ADMISSIBLE_ISUM into "define" as well. *) (* ------------------------------------------------------------------------- *) let ISUM_ISUM_PRODUCT = prove (`!s:A->bool t:A->B->bool x. FINITE s /\ (!i. i IN s ==> FINITE(t i)) ==> isum s (\i. isum (t i) (x i)) = isum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, REWRITE_TAC[isum] THEN MATCH_MP_TAC ITERATE_ITERATE_PRODUCT THEN REWRITE_TAC[MONOIDAL_INT_ADD]);; let ADMISSIBLE_ISUM = prove (`!(<<) p:(B->C)->P->bool s:P->A h a b. admissible(<<) (\f (k,x). a(x) <= k /\ k <= b(x) /\ p f x) (\(k,x). s x) (\f (k,x). h f x k) ==> admissible(<<) p s (\f x. isum(a(x)..b(x)) (h f x))`, REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ISUM_EQ_NUMSEG THEN ASM_MESON_TAC[]);; let INT_SUB_POW_L1 = prove (`!x n. 1 <= n ==> &1 - x pow n = (&1 - x) * isum (0..n - 1) (\i. x pow i)`, SIMP_TAC[INT_OF_REAL_THM REAL_SUB_POW_L1; ETA_AX]);; let INT_SUB_POW_R1 = prove (`!x n. 1 <= n ==> x pow n - &1 = (x - &1) * isum (0..n - 1) (\i. x pow i)`, SIMP_TAC[INT_OF_REAL_THM REAL_SUB_POW_R1; ETA_AX]);; let ISUM_UNIV = prove (`!f:A->int s. support (+) f (:A) SUBSET s ==> isum s f = isum (:A) f`, REWRITE_TAC[isum] THEN MATCH_MP_TAC ITERATE_UNIV THEN REWRITE_TAC[MONOIDAL_INT_ADD]);; (* ------------------------------------------------------------------------- *) (* Extend the congruences. *) (* ------------------------------------------------------------------------- *) let th = prove (`(!f g s. (!x. x IN s ==> f(x) = g(x)) ==> isum s (\i. f(i)) = isum s g) /\ (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) ==> isum(a..b) (\i. f(i)) = isum(a..b) g) /\ (!f g p. (!x. p x ==> f x = g x) ==> isum {y | p y} (\i. f(i)) = isum {y | p y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ISUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; hol-light/Library/iter.ml000066400000000000000000000150761303454263000156570ustar00rootroot00000000000000(* ========================================================================= *) (* Iterated application of a function, ITER n f x = f^n(x). *) (* *) (* (c) Marco Maggesi, Graziano Gentili and Gianni Ciolli, 2008. *) (* ========================================================================= *) let ITER = define `(!f. ITER 0 f x = x) /\ (!f n. ITER (SUC n) f x = f (ITER n f x))`;; let ITER_POINTLESS = prove (`(!f. ITER 0 f = I) /\ (!f n. ITER (SUC n) f = f o ITER n f)`, REWRITE_TAC [FUN_EQ_THM; I_THM; o_THM; ITER]);; let ITER_ALT = prove (`(!f x. ITER 0 f x = x) /\ (!f n x. ITER (SUC n) f x = ITER n f (f x))`, REWRITE_TAC [ITER] THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC [ITER]);; let ITER_ALT_POINTLESS = prove (`(!f. ITER 0 f = I) /\ (!f n. ITER (SUC n) f = ITER n f o f)`, REWRITE_TAC [FUN_EQ_THM; I_THM; o_THM; ITER_ALT]);; let ITER_1 = prove (`!f x. ITER 1 f x = f x`, REWRITE_TAC[num_CONV `1`; ITER]);; let ITER_ADD = prove (`!f n m x. ITER n f (ITER m f x) = ITER (n + m) f x`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; ADD]);; let ITER_ADD_POINTLESS = prove (`!m n. ITER (m + n) f = ITER m f o ITER n f`, REWRITE_TAC[FUN_EQ_THM; o_THM; ITER_ADD]);; let ITER_MUL = prove (`!f n m x. ITER n (ITER m f) x = ITER (n * m) f x`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; MULT; ITER_ADD; ADD_AC]);; let ITER_FIXPOINT = prove (`!f n x. f x = x ==> ITER n f x = x`, GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC [ITER_ALT]);; (* ------------------------------------------------------------------------- *) (* Existence of "order" or "characteristic" in a general setting. *) (* ------------------------------------------------------------------------- *) let ORDER_EXISTENCE_GEN = prove (`!P f:num->A. P(f 0) /\ (!m n. P(f m) /\ ~(m = 0) ==> (P(f(m + n)) <=> P(f n))) ==> ?d. !n. P(f n) <=> d divides n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!n. ~(n = 0) ==> ~P(f n:A)` THENL [EXISTS_TAC `0` THEN REWRITE_TAC[NUMBER_RULE `0 divides n <=> n = 0`] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM])] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[NUMBER_RULE `n divides 0`]; ALL_TAC] THEN ASM_CASES_TAC `d <= n:num` THENL [ALL_TAC; ASM_MESON_TAC[NOT_LT; DIVIDES_LE]] THEN SUBGOAL_THEN `n:num = (n - d) + d` SUBST1_TAC THENL [ASM_ARITH_TAC; ABBREV_TAC `m:num = n - d`] THEN REWRITE_TAC[NUMBER_RULE `d divides m + d <=> d divides m`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ASM_MESON_TAC[ADD_SYM]]);; let ORDER_EXISTENCE_ITER = prove (`!R f z:A. R z z /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R x y ==> R (f x) (f y)) ==> ?d. !n. R (ITER n f z) z <=> d divides n`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. (R:A->A->bool) x z`; `\n. ITER n f (z:A)`] ORDER_EXISTENCE_GEN) THEN ASM_REWRITE_TAC[ITER] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ITER_ADD] THEN MP_TAC(MESON[] `!a b:num->A. (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!n. R (a n) (b n)) ==> (!n. R (a n) z <=> R (b n) z)`) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER] THEN ASM_MESON_TAC[]);; let ORDER_EXISTENCE_CARD = prove (`!R f z:A k. FINITE { R(ITER n f z) | n IN (:num)} /\ CARD { R(ITER n f z) | n IN (:num)} <= k /\ R z z /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R (f x) (f y) <=> R x y) ==> ?d. 0 < d /\ d <= k /\ !n. R (ITER n f z) z <=> d divides n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?m. 0 < m /\ m <= k /\ (R:A->A->bool) (ITER m f z) z` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`\n. (R:A->A->bool) (ITER n f z)`; `0..k`] CARD_IMAGE_EQ_INJ) THEN REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG; SUB_0] THEN MATCH_MP_TAC(TAUT `~p /\ (~q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `c <= k ==> s <= c ==> ~(s = k + 1)`)) THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`p:num`; `q:num`] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `q - p:num` THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN SUBGOAL_THEN `!d. d <= p ==> (R:A->A->bool) (ITER (p - d) f z) (ITER (q - d) f z)` MP_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_0] THENL [SPEC_TAC(`q:num`,`q:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `q - d = SUC(q - SUC d) /\ p - d = SUC(p - SUC d)` (fun th -> REWRITE_TAC[th]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[ITER]]; DISCH_THEN(MP_TAC o SPEC `p:num`) THEN REWRITE_TAC[LE_REFL; SUB_REFL; ITER] THEN ASM_MESON_TAC[]]]; MP_TAC(ISPECL [`R:A->A->bool`; `f:A->A`; `z:A`] ORDER_EXISTENCE_ITER) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN ASM_CASES_TAC `d = 0` THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `m:num`) THEN ASM_SIMP_TAC[LE_1; NUMBER_RULE `!n. 0 divides n <=> n = 0`] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_ARITH_TAC]);; let ORDER_EXISTENCE_FINITE = prove (`!R f z:A. FINITE { R(ITER n f z) | n IN (:num)} /\ R z z /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R (f x) (f y) <=> R x y) ==> ?d. 0 < d /\ !n. R (ITER n f z) z <=> d divides n`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`R:A->A->bool`; `f:A->A`; `z:A`; `CARD {(R:A->A->bool)(ITER n f z) | n IN (:num)}`] ORDER_EXISTENCE_CARD) THEN ASM_REWRITE_TAC[LE_REFL] THEN MESON_TAC[]);; hol-light/Library/multiplicative.ml000066400000000000000000000467471303454263000177600ustar00rootroot00000000000000(* ========================================================================= *) (* Multiplicative functions into N or R (could add Z, C etc.) *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/pocklington.ml";; (* ------------------------------------------------------------------------- *) (* Definition of multiplicativity of functions into N. *) (* ------------------------------------------------------------------------- *) let multiplicative = new_definition `multiplicative f <=> f(1) = 1 /\ !m n. coprime(m,n) ==> f(m * n) = f(m) * f(n)`;; let MULTIPLICATIVE_1 = prove (`!f. multiplicative f ==> f(1) = 1`, SIMP_TAC[multiplicative]);; (* ------------------------------------------------------------------------- *) (* We can really ignore the value at zero. *) (* ------------------------------------------------------------------------- *) let MULTIPLICATIVE = prove (`multiplicative f <=> f(1) = 1 /\ !m n. ~(m = 0) /\ ~(n = 0) /\ coprime(m,n) ==> f(m * n) = f(m) * f(n)`, REWRITE_TAC[multiplicative] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_CASES_TAC `m = 0` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN ASM_MESON_TAC[COPRIME_SYM; COPRIME_0; DIVIDES_ONE; MULT_CLAUSES]);; let MULTIPLICATIVE_IGNOREZERO = prove (`!f g. (!n. ~(n = 0) ==> g(n) = f(n)) /\ multiplicative f ==> multiplicative g`, REPEAT GEN_TAC THEN SIMP_TAC[MULTIPLICATIVE; ARITH_EQ] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MULT_EQ_0]);; (* ------------------------------------------------------------------------- *) (* A key "building block" theorem. *) (* ------------------------------------------------------------------------- *) let MULTIPLICATIVE_CONVOLUTION = prove (`!f g. multiplicative f /\ multiplicative g ==> multiplicative (\n. nsum {d | d divides n} (\d. f(d) * g(n DIV d)))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [multiplicative] THEN REWRITE_TAC[MULTIPLICATIVE; GSYM NSUM_LMUL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[DIVIDES_ONE; DIV_1; SING_GSPEC; NSUM_SING; MULT_CLAUSES] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN ASM_SIMP_TAC[GSYM NSUM_LMUL; NSUM_NSUM_PRODUCT; FINITE_DIVISORS] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC NSUM_EQ_GENERAL THEN EXISTS_TAC `\(a:num,b). a * b` THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[PAIR_EQ] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_DECOMP) THEN CONJ_TAC THENL [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a1:num`; `b1:num`; `a2:num`; `b2:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THENL (map EXISTS_TAC [`b2:num`; `b1:num`; `a2:num`; `a1:num`]) THEN ASM_MESON_TAC[COPRIME_DIVISORS; DIVIDES_REFL; DIVIDES_RMUL; COPRIME_SYM; MULT_SYM]; MAP_EVERY X_GEN_TAC [`d:num`; `e:num`] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_MUL2; MULT_SYM]; ALL_TAC] THEN MP_TAC(REWRITE_RULE[divides] (ASSUME `(d:num) divides n`)) THEN DISCH_THEN(X_CHOOSE_THEN `d':num` SUBST_ALL_TAC) THEN MP_TAC(REWRITE_RULE[divides] (ASSUME `(e:num) divides m`)) THEN DISCH_THEN(X_CHOOSE_THEN `e':num` SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN ONCE_REWRITE_TAC[AC MULT_AC `(e * e') * d * d':num = (d * e) * (d' * e')`] THEN ASM_SIMP_TAC[DIV_MULT; MULT_EQ_0] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (NUMBER_RULE `coprime(a * b,c * d) ==> coprime(c,a) /\ coprime(d,b)`)) THEN ASM_SIMP_TAC[] THEN ARITH_TAC]);; let MULTIPLICATIVE_CONST = prove (`!c. multiplicative(\n. c) <=> c = 1`, GEN_TAC THEN REWRITE_TAC[multiplicative] THEN ASM_CASES_TAC `c = 1` THEN ASM_REWRITE_TAC[MULT_CLAUSES]);; let MULTIPLICATIVE_DELTA = prove (`multiplicative(\n. if n = 1 then 1 else 0)`, REWRITE_TAC[MULTIPLICATIVE; MULT_EQ_1] THEN ARITH_TAC);; let MULTIPLICATIVE_DIVISORSUM = prove (`!f. multiplicative f ==> multiplicative (\n. nsum {d | d divides n} f)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->num`; `\n:num. 1`] MULTIPLICATIVE_CONVOLUTION) THEN ASM_REWRITE_TAC[MULT_CLAUSES; MULTIPLICATIVE_CONST; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Some particular multiplicative functions. *) (* ------------------------------------------------------------------------- *) let MULTIPLICATIVE_ID = prove (`multiplicative(\n. n)`, REWRITE_TAC[multiplicative]);; let MULTIPLICATIVE_POWERSUM = prove (`!k. multiplicative(\n. nsum {d | d divides n} (\d. d EXP k))`, GEN_TAC THEN MATCH_MP_TAC MULTIPLICATIVE_DIVISORSUM THEN REWRITE_TAC[MULTIPLICATIVE; EXP_ONE; MULT_EXP]);; let sigma = new_definition `sigma(n) = if n = 0 then 0 else nsum {d | d divides n} (\i. i)`;; let tau = new_definition `tau(n) = if n = 0 then 0 else CARD {d | d divides n}`;; let MULTIPLICATIVE_SIGMA = prove (`multiplicative(sigma)`, MP_TAC(SPEC `1` MULTIPLICATIVE_POWERSUM) THEN MATCH_MP_TAC(REWRITE_RULE[GSYM IMP_IMP] MULTIPLICATIVE_IGNOREZERO) THEN SIMP_TAC[sigma; EXP_1]);; let MULTIPLICATIVE_TAU = prove (`multiplicative(tau)`, MP_TAC(SPEC `0` MULTIPLICATIVE_POWERSUM) THEN MATCH_MP_TAC(REWRITE_RULE[GSYM IMP_IMP] MULTIPLICATIVE_IGNOREZERO) THEN SIMP_TAC[tau; EXP; NSUM_CONST; MULT_CLAUSES; FINITE_DIVISORS]);; let MULTIPLICATIVE_PHI = prove (`multiplicative(phi)`, REWRITE_TAC[multiplicative; PHI_MULTIPLICATIVE; PHI_1]);; let MULTIPLICATIVE_GCD = prove (`!n. multiplicative(\m. gcd(n,m))`, REWRITE_TAC[multiplicative; ONCE_REWRITE_RULE[GCD_SYM] GCD_1] THEN ONCE_REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN NUMBER_TAC);; (* ------------------------------------------------------------------------- *) (* Uniqueness of multiplicative functions if equal on prime powers. *) (* ------------------------------------------------------------------------- *) let MULTIPLICATIVE_UNIQUE = prove (`!f g. multiplicative f /\ multiplicative g /\ (!p k. prime p ==> f(p EXP k) = g(p EXP k)) ==> !n. ~(n = 0) ==> f n = g n`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = 1 \/ 1 < n`)) THENL [ASM_MESON_TAC[multiplicative]; ALL_TAC] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN ASM_MESON_TAC[multiplicative]);; (* ------------------------------------------------------------------------- *) (* Derive the divisor-sum identity for phi from this. *) (* ------------------------------------------------------------------------- *) let PHI_DIVISORSUM = prove (`!n. ~(n = 0) ==> nsum {d | d divides n} (\d. phi(d)) = n`, MATCH_MP_TAC MULTIPLICATIVE_UNIQUE THEN REWRITE_TAC[MULTIPLICATIVE_ID] THEN SIMP_TAC[MULTIPLICATIVE_DIVISORSUM; ETA_AX; MULTIPLICATIVE_PHI] THEN SIMP_TAC[DIVIDES_PRIMEPOW; SET_RULE `{d | ?i. i <= k /\ d = p EXP i} = IMAGE (\i. p EXP i) {i | i <= k}`] THEN SIMP_TAC[NSUM_IMAGE; EQ_PRIMEPOW; o_DEF; PHI_PRIMEPOW] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LE; NOT_SUC] THEN REWRITE_TAC[CONJUNCT1 EXP; SET_RULE `{x | x = 0} = {0}`; NSUM_SING] THEN REWRITE_TAC[SET_RULE `{i | i = a \/ i <= b} = a INSERT {i | i <= b}`] THEN ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_NUMSEG_LE; NOT_SUC] THEN REWRITE_TAC[IN_ELIM_THM; SUC_SUB1; ARITH_RULE `~(SUC k <= k)`] THEN MATCH_MP_TAC(ARITH_RULE `a:num <= b ==> b - a + a = b`) THEN ASM_SIMP_TAC[LE_EXP; PRIME_IMP_NZ] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Now the real analog. *) (* ------------------------------------------------------------------------- *) let real_multiplicative = new_definition `real_multiplicative (f:num->real) <=> f(1) = &1 /\ !m n. coprime(m,n) ==> f(m * n) = f(m) * f(n)`;; let REAL_MULTIPLICATIVE = prove (`real_multiplicative f <=> f(1) = &1 /\ !m n. ~(m = 0) /\ ~(n = 0) /\ coprime(m,n) ==> f(m * n) = f(m) * f(n)`, REWRITE_TAC[real_multiplicative] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[COPRIME_0; MULT_CLAUSES; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_CASES_TAC `m = 0` THEN ASM_SIMP_TAC[COPRIME_0; MULT_CLAUSES; REAL_MUL_RID] THEN ASM_MESON_TAC[COPRIME_SYM; COPRIME_0; DIVIDES_ONE; MULT_CLAUSES]);; let REAL_MULTIPLICATIVE_CONST = prove (`!c. real_multiplicative(\n. c) <=> c = &1`, GEN_TAC THEN REWRITE_TAC[real_multiplicative] THEN ASM_CASES_TAC `c:real = &1` THEN ASM_REWRITE_TAC[REAL_MUL_LID]);; let REAL_MULTIPLICATIVE_DELTA = prove (`real_multiplicative(\n. if n = 1 then &1 else &0)`, REWRITE_TAC[REAL_MULTIPLICATIVE; MULT_EQ_1] THEN REAL_ARITH_TAC);; let REAL_MULTIPLICATIVE_IGNOREZERO = prove (`!f g. (!n. ~(n = 0) ==> g(n) = f(n)) /\ real_multiplicative f ==> real_multiplicative g`, REPEAT GEN_TAC THEN SIMP_TAC[REAL_MULTIPLICATIVE; ARITH_EQ] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MULT_EQ_0]);; let REAL_MULTIPLICATIVE_CONVOLUTION = prove (`!f g. real_multiplicative f /\ real_multiplicative g ==> real_multiplicative (\n. sum {d | d divides n} (\d. f(d) * g(n DIV d)))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [real_multiplicative] THEN REWRITE_TAC[REAL_MULTIPLICATIVE; GSYM SUM_LMUL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[DIVIDES_ONE; DIV_1; SING_GSPEC; SUM_SING; REAL_MUL_LID] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM SUM_LMUL; SUM_SUM_PRODUCT; FINITE_DIVISORS] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN EXISTS_TAC `\(a:num,b). a * b` THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_DECOMP) THEN CONJ_TAC THENL [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a1:num`; `b1:num`; `a2:num`; `b2:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THENL (map EXISTS_TAC [`b2:num`; `b1:num`; `a2:num`; `a1:num`]) THEN ASM_MESON_TAC[COPRIME_DIVISORS; DIVIDES_REFL; DIVIDES_RMUL; COPRIME_SYM; MULT_SYM]; MAP_EVERY X_GEN_TAC [`d:num`; `e:num`] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_MUL2; MULT_SYM]; ALL_TAC] THEN MP_TAC(REWRITE_RULE[divides] (ASSUME `(d:num) divides n`)) THEN DISCH_THEN(X_CHOOSE_THEN `d':num` SUBST_ALL_TAC) THEN MP_TAC(REWRITE_RULE[divides] (ASSUME `(e:num) divides m`)) THEN DISCH_THEN(X_CHOOSE_THEN `e':num` SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN ONCE_REWRITE_TAC[AC MULT_AC `(e * e') * d * d':num = (d * e) * (d' * e')`] THEN ASM_SIMP_TAC[DIV_MULT; MULT_EQ_0] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (NUMBER_RULE `coprime(a * b,c * d) ==> coprime(c,a) /\ coprime(d,b)`)) THEN ASM_SIMP_TAC[] THEN REAL_ARITH_TAC]);; let REAL_MULTIPLICATIVE_DIVISORSUM = prove (`!f. real_multiplicative f ==> real_multiplicative (\n. sum {d | d divides n} f)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real`; `(\n. &1):num->real`] REAL_MULTIPLICATIVE_CONVOLUTION) THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MULTIPLICATIVE_CONST; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* The Mobius function (into the reals). *) (* ------------------------------------------------------------------------- *) prioritize_real();; let mobius = new_definition `mobius(n) = if ?p. prime p /\ (p EXP 2) divides n then &0 else --(&1) pow CARD {p | prime p /\ p divides n}`;; let MOBIUS_0 = prove (`mobius 0 = &0`, REWRITE_TAC[mobius] THEN MP_TAC(SPEC `2 EXP 2` DIVIDES_0) THEN MESON_TAC[PRIME_2]);; let MOBIUS_1 = prove (`mobius 1 = &1`, REWRITE_TAC[mobius; DIVIDES_ONE; EXP_EQ_1; ARITH] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN SUBGOAL_THEN `{p | prime p /\ p = 1} = {}` (fun th -> SIMP_TAC[th; CARD_CLAUSES; real_pow]) THEN SET_TAC[PRIME_1]);; let REAL_ABS_MOBIUS = prove (`!n. abs(mobius n) <= &1`, GEN_TAC THEN REWRITE_TAC[mobius] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_ABS_NUM] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let MOBIUS_MULT = prove (`!a b. coprime(a,b) ==> mobius(a * b) = mobius a * mobius b`, REPEAT STRIP_TAC THEN REWRITE_TAC[mobius] THEN ASM_CASES_TAC `?p. prime p /\ (p EXP 2) divides a` THENL [ASM_CASES_TAC `?p. prime p /\ p EXP 2 divides (a * b)` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN ASM_MESON_TAC[DIVIDES_RMUL]; ALL_TAC] THEN ASM_CASES_TAC `?p. prime p /\ (p EXP 2) divides b` THENL [ASM_CASES_TAC `?p. prime p /\ p EXP 2 divides (a * b)` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN ASM_MESON_TAC[DIVIDES_LMUL]; ALL_TAC] THEN ASM_CASES_TAC `?p. prime p /\ p EXP 2 divides (a * b)` THENL [ASM_MESON_TAC[PRIME_DIVPROD_POW]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM REAL_POW_ADD] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_CASES_TAC `a = 0` THENL [ASM_MESON_TAC[PRIME_2; DIVIDES_0]; ALL_TAC] THEN ASM_CASES_TAC `b = 0` THENL [ASM_MESON_TAC[PRIME_2; DIVIDES_0]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p | p divides a * b}` THEN ASM_SIMP_TAC[FINITE_DIVISORS; MULT_EQ_0] THEN SET_TAC[]; SIMP_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_UNION; AND_FORALL_THM] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN UNDISCH_TAC `~(?p. prime p /\ p EXP 2 divides a * b)` THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_CASES_TAC `prime p` THEN ASM_SIMP_TAC[PRIME_DIVPROD_EQ] THEN REWRITE_TAC[CONTRAPOS_THM; EXP_2] THEN CONV_TAC NUMBER_RULE]);; let REAL_MULTIPLICATIVE_MOBIUS = prove (`real_multiplicative mobius`, SIMP_TAC[real_multiplicative; MOBIUS_1; MOBIUS_MULT]);; let MOBIUS_PRIME = prove (`!p. prime p ==> mobius(p) = -- &1`, REPEAT STRIP_TAC THEN REWRITE_TAC[mobius] THEN COND_CASES_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC (MATCH_MP(NUMBER_RULE `q EXP 2 divides p ==> q divides p`) th)) THEN SUBGOAL_THEN `q:num = p` SUBST_ALL_TAC THENL [ASM_MESON_TAC[DIVIDES_PRIME_PRIME]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN REWRITE_TAC[ARITH_RULE `p EXP 2 <= p <=> p * p <= 1 * p`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; SUBGOAL_THEN `{q | prime q /\ q divides p} = {p}` SUBST1_TAC THENL [ASM SET_TAC[DIVIDES_PRIME_PRIME]; ALL_TAC] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH; REAL_POW_1]]);; let MOBIUS_PRIMEPOW = prove (`!p k. prime p ==> mobius(p EXP k) = if k = 0 then &1 else if k = 1 then -- &1 else &0`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[EXP; MOBIUS_1] THEN ASM_CASES_TAC `k = 1` THEN ASM_SIMP_TAC[EXP_1; MOBIUS_PRIME] THEN REWRITE_TAC[mobius] THEN SUBGOAL_THEN `?q. prime q /\ q EXP 2 divides p EXP k` (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `p:num` THEN ASM_SIMP_TAC[DIVIDES_PRIME_EXP_LE] THEN ASM_ARITH_TAC);; let DIVISORSUM_MOBIUS = prove (`!n. 1 <= n ==> sum {d | d divides n} (\d. mobius d) = if n = 1 then &1 else &0`, REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 1 < n`] THEN REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[DIVIDES_ONE; SET_RULE `{x | x = a} = {a}`; SUM_SING; MOBIUS_1] THEN SIMP_TAC[ARITH_RULE `1 < n ==> ~(n = 1)`] THEN MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN CONJ_TAC THENL [MP_TAC(MATCH_MP REAL_MULTIPLICATIVE_DIVISORSUM REAL_MULTIPLICATIVE_MOBIUS) THEN SIMP_TAC[real_multiplicative; ETA_AX; REAL_MUL_LZERO]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {1,p} (\d. mobius d)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; IN_SING; MOBIUS_PRIME; MOBIUS_1; REAL_ADD_RID; REAL_ADD_RINV] THEN ASM_MESON_TAC[PRIME_1]] THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[EXP; LE_0]; ASM_MESON_TAC[EXP_1; LE_1]; ASM_SIMP_TAC[MOBIUS_PRIMEPOW] THEN ASM_MESON_TAC[EXP; EXP_1]]);; let MOBIUS_INVERSION = prove (`!f g. (!n. 1 <= n ==> g(n) = sum {d | d divides n} f) ==> !n. 1 <= n ==> f(n) = sum {d | d divides n} (\d. mobius(d) * g(n DIV d))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!d. d divides n ==> ~(n DIV d = 0)` ASSUME_TAC THENL [GEN_TAC THEN ASM_CASES_TAC `d = 0` THEN ASM_SIMP_TAC[DIVIDES_ZERO; LE_1] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_SIMP_TAC[LE_1; NOT_LT; DIV_EQ_0]; ALL_TAC] THEN ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {d | d divides n} (\d. f(d) * (if n DIV d = 1 then &1 else &0))` THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {n} (\d. f(d) * (if n DIV d = 1 then &1 else &0))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_SING; DIV_REFL; LE_1; REAL_MUL_RID]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_SING; IN_ELIM_THM; DIVIDES_REFL] THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[DIVIDES_DIV_MULT] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; REAL_MUL_RZERO]; ASM_SIMP_TAC[GSYM DIVISORSUM_MOBIUS; LE_1] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN ASM_SIMP_TAC[SUM_SUM_PRODUCT; FINITE_DIVISORS; LE_1; IN_ELIM_THM] THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN REPEAT(EXISTS_TAC `\(m:num,n:num). (n,m)`) THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[REAL_MUL_SYM] THEN ASM_MESON_TAC[DIVIDES_DIVIDES_DIV; MULT_SYM; NUMBER_RULE `(a * b) divides c ==> b divides c`]]);; hol-light/Library/permutations.ml000066400000000000000000001207401303454263000174410ustar00rootroot00000000000000(* ========================================================================= *) (* Permutations, both general and specifically on finite sets. *) (* ========================================================================= *) parse_as_infix("permutes",(12,"right"));; let permutes = new_definition `p permutes s <=> (!x. ~(x IN s) ==> p(x) = x) /\ (!y. ?!x. p x = y)`;; (* ------------------------------------------------------------------------- *) (* Inverse function (on whole universe). *) (* ------------------------------------------------------------------------- *) let inverse = new_definition `inverse(f) = \y. @x. f x = y`;; let SURJECTIVE_INVERSE = prove (`!f. (!y. ?x. f x = y) <=> !y. f(inverse f y) = y`, REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE; inverse] THEN MESON_TAC[]);; let SURJECTIVE_INVERSE_o = prove (`!f. (!y. ?x. f x = y) <=> (f o inverse f = I)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; SURJECTIVE_INVERSE]);; let INJECTIVE_INVERSE = prove (`!f. (!x x'. f x = f x' ==> x = x') <=> !x. inverse f (f x) = x`, MESON_TAC[inverse]);; let INJECTIVE_INVERSE_o = prove (`!f. (!x x'. f x = f x' ==> x = x') <=> (inverse f o f = I)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; INJECTIVE_INVERSE]);; let INVERSE_UNIQUE_o = prove (`!f g. f o g = I /\ g o f = I ==> inverse f = g`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[INJECTIVE_INVERSE; SURJECTIVE_INVERSE]);; let INVERSE_I = prove (`inverse I = I`, MATCH_MP_TAC INVERSE_UNIQUE_o THEN REWRITE_TAC[I_O_ID]);; (* ------------------------------------------------------------------------- *) (* Transpositions. *) (* ------------------------------------------------------------------------- *) let swap = new_definition `swap(i,j) k = if k = i then j else if k = j then i else k`;; let SWAP_REFL = prove (`!a. swap(a,a) = I`, REWRITE_TAC[FUN_EQ_THM; swap; I_THM] THEN MESON_TAC[]);; let SWAP_SYM = prove (`!a b. swap(a,b) = swap(b,a)`, REWRITE_TAC[FUN_EQ_THM; swap; I_THM] THEN MESON_TAC[]);; let SWAP_IDEMPOTENT = prove (`!a b. swap(a,b) o swap(a,b) = I`, REWRITE_TAC[FUN_EQ_THM; swap; o_THM; I_THM] THEN MESON_TAC[]);; let INVERSE_SWAP = prove (`!a b. inverse(swap(a,b)) = swap(a,b)`, REPEAT GEN_TAC THEN MATCH_MP_TAC INVERSE_UNIQUE_o THEN REWRITE_TAC[SWAP_SYM; SWAP_IDEMPOTENT]);; let SWAP_GALOIS = prove (`!a b x y. x = swap(a,b) y <=> y = swap(a,b) x`, REWRITE_TAC[swap] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Basic consequences of the definition. *) (* ------------------------------------------------------------------------- *) let PERMUTES_IN_IMAGE = prove (`!p s x. p permutes s ==> (p(x) IN s <=> x IN s)`, REWRITE_TAC[permutes] THEN MESON_TAC[]);; let PERMUTES_IMAGE = prove (`!p s. p permutes s ==> IMAGE p s = s`, REWRITE_TAC[permutes; EXTENSION; IN_IMAGE] THEN MESON_TAC[]);; let PERMUTES_INJECTIVE = prove (`!p s. p permutes s ==> !x y. p(x) = p(y) <=> x = y`, REWRITE_TAC[permutes] THEN MESON_TAC[]);; let PERMUTES_SURJECTIVE = prove (`!p s. p permutes s ==> !y. ?x. p(x) = y`, REWRITE_TAC[permutes] THEN MESON_TAC[]);; let PERMUTES_INVERSES_o = prove (`!p s. p permutes s ==> p o inverse(p) = I /\ inverse(p) o p = I`, REWRITE_TAC[GSYM INJECTIVE_INVERSE_o; GSYM SURJECTIVE_INVERSE_o] THEN REWRITE_TAC[permutes] THEN MESON_TAC[]);; let PERMUTES_INVERSES = prove (`!p s. p permutes s ==> (!x. p(inverse p x) = x) /\ (!x. inverse p (p x) = x)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; let PERMUTES_SUBSET = prove (`!p s t. p permutes s /\ s SUBSET t ==> p permutes t`, REWRITE_TAC[permutes; SUBSET] THEN MESON_TAC[]);; let PERMUTES_EMPTY = prove (`!p. p permutes {} <=> p = I`, REWRITE_TAC[FUN_EQ_THM; I_THM; permutes; NOT_IN_EMPTY] THEN MESON_TAC[]);; let PERMUTES_SING = prove (`!p a. p permutes {a} <=> p = I`, REWRITE_TAC[FUN_EQ_THM; I_THM; permutes; IN_SING] THEN MESON_TAC[]);; let PERMUTES_UNIV = prove (`!p. p permutes UNIV <=> !y:A. ?!x. p x = y`, REWRITE_TAC[permutes; IN_UNIV] THEN MESON_TAC[]);; let PERMUTES_INVERSE_EQ = prove (`!p s. p permutes s ==> !x y. inverse p y = x <=> p x = y`, REWRITE_TAC[permutes; inverse] THEN MESON_TAC[]);; let PERMUTES_SWAP = prove (`!a b s. a IN s /\ b IN s ==> swap(a,b) permutes s`, REWRITE_TAC[permutes; swap] THEN MESON_TAC[]);; let PERMUTES_SUPERSET = prove (`!p s t. p permutes s /\ (!x. x IN (s DIFF t) ==> p(x) = x) ==> p permutes t`, REWRITE_TAC[permutes; IN_DIFF] THEN MESON_TAC[]);; let PERMUTES_BIJECTIONS = prove (`!p q. (!x. x IN s ==> p x IN s) /\ (!x. ~(x IN s) ==> p x = x) /\ (!x. x IN s ==> q x IN s) /\ (!x. ~(x IN s) ==> q x = x) /\ (!x. p(q x) = x) /\ (!x. q(p x) = x) ==> p permutes s`, REWRITE_TAC[permutes] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Group properties. *) (* ------------------------------------------------------------------------- *) let PERMUTES_ID = prove (`!s:A->bool. (\x. x) permutes s`, REWRITE_TAC[permutes] THEN MESON_TAC[]);; let PERMUTES_I = prove (`!s. I permutes s`, REWRITE_TAC[permutes; I_THM] THEN MESON_TAC[]);; let PERMUTES_COMPOSE = prove (`!p q s. p permutes s /\ q permutes s ==> (q o p) permutes s`, REWRITE_TAC[permutes; o_THM] THEN METIS_TAC[]);; let PERMUTES_INVERSE = prove (`!p s. p permutes s ==> inverse(p) permutes s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_INVERSE_EQ) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[permutes] THEN MESON_TAC[]);; let PERMUTES_INVERSE_INVERSE = prove (`!p. p permutes s ==> inverse(inverse p) = p`, SIMP_TAC[FUN_EQ_THM] THEN MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE]);; (* ------------------------------------------------------------------------- *) (* The number of permutations on a finite set. *) (* ------------------------------------------------------------------------- *) let PERMUTES_INSERT_LEMMA = prove (`!p a:A s. p permutes (a INSERT s) ==> (swap(a,p(a)) o p) permutes s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PERMUTES_SUPERSET THEN EXISTS_TAC `(a:A) INSERT s` THEN CONJ_TAC THENL [ASM_MESON_TAC[PERMUTES_SWAP; PERMUTES_IN_IMAGE; IN_INSERT; PERMUTES_COMPOSE]; REWRITE_TAC[o_THM; swap; IN_INSERT; IN_DIFF] THEN ASM_MESON_TAC[]]);; let PERMUTES_INSERT = prove (`{p:A->A | p permutes (a INSERT s)} = IMAGE (\(b,p). swap(a,b) o p) {(b,p) | b IN a INSERT s /\ p IN {p | p permutes s}}`, REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN X_GEN_TAC `p:A->A` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN EQ_TAC THENL [DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`(p:A->A) a`; `swap(a,p a) o (p:A->A)`] THEN ASM_SIMP_TAC[SWAP_IDEMPOTENT; o_ASSOC; I_O_ID; PERMUTES_INSERT_LEMMA] THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_INSERT]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:A`; `q:A->A`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PERMUTES_COMPOSE THEN CONJ_TAC THENL [ASM_MESON_TAC[PERMUTES_SUBSET; SUBSET; IN_INSERT]; MATCH_MP_TAC PERMUTES_SWAP THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_INSERT]]]);; let HAS_SIZE_PERMUTATIONS = prove (`!s:A->bool n. s HAS_SIZE n ==> {p | p permutes s} HAS_SIZE (FACT n)`, REWRITE_TAC[HAS_SIZE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PERMUTES_EMPTY; CARD_CLAUSES; SET_RULE `{x | x = a} = {a}`] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[NOT_IN_EMPTY] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN REWRITE_TAC[GSYM HAS_SIZE] THEN STRIP_TAC THEN X_GEN_TAC `k:num` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[FACT; PERMUTES_INSERT] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_SIMP_TAC[HAS_SIZE_PRODUCT; HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM; PAIR_EQ] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MAP_EVERY X_GEN_TAC [`b:A`; `q:A->A`; `c:A`; `r:A->A`] THEN STRIP_TAC THEN SUBGOAL_THEN `c:A = b` SUBST_ALL_TAC THENL [FIRST_X_ASSUM(MP_TAC o C AP_THM `a:A`) THEN REWRITE_TAC[o_THM; swap] THEN SUBGOAL_THEN `(q:A->A) a = a /\ (r:A->A) a = a` (fun t -> SIMP_TAC[t]) THEN ASM_MESON_TAC[permutes]; FIRST_X_ASSUM(MP_TAC o AP_TERM `(\q:A->A. swap(a:A,b) o q)`) THEN ASM_SIMP_TAC[SWAP_IDEMPOTENT; o_ASSOC; I_O_ID]]);; let FINITE_PERMUTATIONS = prove (`!s. FINITE s ==> FINITE {p | p permutes s}`, MESON_TAC[HAS_SIZE_PERMUTATIONS; HAS_SIZE]);; let CARD_PERMUTATIONS = prove (`!s. FINITE s ==> CARD {p | p permutes s} = FACT(CARD s)`, MESON_TAC[HAS_SIZE; HAS_SIZE_PERMUTATIONS]);; (* ------------------------------------------------------------------------- *) (* Alternative characterizations of permutation of finite set. *) (* ------------------------------------------------------------------------- *) let PERMUTES_FINITE_INJECTIVE = prove (`!s:A->bool p. FINITE s ==> (p permutes s <=> (!x. ~(x IN s) ==> p x = x) /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y))`, REWRITE_TAC[permutes] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN DISCH_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `p:A->A` o MATCH_MP (REWRITE_RULE[IMP_CONJ] SURJECTIVE_IFF_INJECTIVE)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN X_GEN_TAC `y:A` THEN ASM_CASES_TAC `(y:A) IN s` THEN ASM_MESON_TAC[]);; let PERMUTES_FINITE_SURJECTIVE = prove (`!s:A->bool p. FINITE s ==> (p permutes s <=> (!x. ~(x IN s) ==> p x = x) /\ (!x. x IN s ==> p x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ p x = y))`, REWRITE_TAC[permutes] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN DISCH_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `p:A->A` o MATCH_MP (REWRITE_RULE[IMP_CONJ] SURJECTIVE_IFF_INJECTIVE)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN X_GEN_TAC `y:A` THEN ASM_CASES_TAC `(y:A) IN s` THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Permutations of index set for iterated operations. *) (* ------------------------------------------------------------------------- *) let ITERATE_PERMUTE = prove (`!op. monoidal op ==> !f p s. p permutes s ==> iterate op s f = iterate op s (f o p)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_BIJECTION) THEN ASM_MESON_TAC[permutes]);; let NSUM_PERMUTE = prove (`!f p s. p permutes s ==> nsum s f = nsum s (f o p)`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_PERMUTE THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_PERMUTE_NUMSEG = prove (`!f p m n. p permutes m..n ==> nsum(m..n) f = nsum(m..n) (f o p)`, MESON_TAC[NSUM_PERMUTE; FINITE_NUMSEG]);; let SUM_PERMUTE = prove (`!f p s. p permutes s ==> sum s f = sum s (f o p)`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_PERMUTE THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_PERMUTE_NUMSEG = prove (`!f p m n. p permutes m..n ==> sum(m..n) f = sum(m..n) (f o p)`, MESON_TAC[SUM_PERMUTE; FINITE_NUMSEG]);; (* ------------------------------------------------------------------------- *) (* Various combinations of transpositions with 2, 1 and 0 common elements. *) (* ------------------------------------------------------------------------- *) let SWAP_COMMON = prove (`!a b c:A. ~(a = c) /\ ~(b = c) ==> swap(a,b) o swap(a,c) = swap(b,c) o swap(a,b)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; swap; o_THM; I_THM] THEN DISCH_TAC THEN X_GEN_TAC `x:A` THEN MAP_EVERY ASM_CASES_TAC [`x:A = a`; `x:A = b`; `x:A = c`] THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let SWAP_COMMON' = prove (`!a b c:A. ~(a = b) /\ ~(a = c) ==> swap(a,c) o swap(b,c) = swap(b,c) o swap(a,b)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SWAP_SYM] THEN ASM_SIMP_TAC[GSYM SWAP_COMMON] THEN REWRITE_TAC[SWAP_SYM]);; let SWAP_INDEPENDENT = prove (`!a b c d:A. ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d) ==> swap(a,b) o swap(c,d) = swap(c,d) o swap(a,b)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; swap; o_THM; I_THM] THEN DISCH_TAC THEN X_GEN_TAC `x:A` THEN MAP_EVERY ASM_CASES_TAC [`x:A = a`; `x:A = b`; `x:A = c`] THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Permutations as transposition sequences. *) (* ------------------------------------------------------------------------- *) let swapseq_RULES,swapseq_INDUCT,swapseq_CASES = new_inductive_definition `(swapseq 0 I) /\ (!a b p n. swapseq n p /\ ~(a = b) ==> swapseq (SUC n) (swap(a,b) o p))`;; let permutation = new_definition `permutation p <=> ?n. swapseq n p`;; (* ------------------------------------------------------------------------- *) (* Some closure properties of the set of permutations, with lengths. *) (* ------------------------------------------------------------------------- *) let SWAPSEQ_I = CONJUNCT1 swapseq_RULES;; let PERMUTATION_I = prove (`permutation I`, REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_I]);; let SWAPSEQ_SWAP = prove (`!a b. swapseq (if a = b then 0 else 1) (swap(a,b))`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[num_CONV `1`] THEN ASM_MESON_TAC[swapseq_RULES; I_O_ID; SWAPSEQ_I; SWAP_REFL]);; let PERMUTATION_SWAP = prove (`!a b. permutation(swap(a,b))`, REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_SWAP]);; let SWAPSEQ_COMPOSE = prove (`!n p m q. swapseq n p /\ swapseq m q ==> swapseq (n + m) (p o q)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC swapseq_INDUCT THEN REWRITE_TAC[ADD_CLAUSES; I_O_ID; GSYM o_ASSOC] THEN MESON_TAC[swapseq_RULES]);; let PERMUTATION_COMPOSE = prove (`!p q. permutation p /\ permutation q ==> permutation(p o q)`, REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_COMPOSE]);; let SWAPSEQ_ENDSWAP = prove (`!n p a b:A. swapseq n p /\ ~(a = b) ==> swapseq (SUC n) (p o swap(a,b))`, REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC swapseq_INDUCT THEN REWRITE_TAC[I_O_ID; GSYM o_ASSOC] THEN MESON_TAC[o_ASSOC; swapseq_RULES; I_O_ID]);; let SWAPSEQ_INVERSE_EXISTS = prove (`!n p:A->A. swapseq n p ==> ?q. swapseq n q /\ p o q = I /\ q o p = I`, MATCH_MP_TAC swapseq_INDUCT THEN CONJ_TAC THENL [MESON_TAC[I_O_ID; swapseq_RULES]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `q:A->A`; `a:A`; `b:A`] SWAPSEQ_ENDSWAP) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `(q:A->A) o swap (a,b)` THEN ASM_REWRITE_TAC[GSYM o_ASSOC] THEN GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV o RAND_CONV) [o_ASSOC] THEN ASM_REWRITE_TAC[SWAP_IDEMPOTENT; I_O_ID]);; let SWAPSEQ_INVERSE = prove (`!n p. swapseq n p ==> swapseq n (inverse p)`, MESON_TAC[SWAPSEQ_INVERSE_EXISTS; INVERSE_UNIQUE_o]);; let PERMUTATION_INVERSE = prove (`!p. permutation p ==> permutation(inverse p)`, REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_INVERSE]);; (* ------------------------------------------------------------------------- *) (* The identity map only has even transposition sequences. *) (* ------------------------------------------------------------------------- *) let SYMMETRY_LEMMA = prove (`(!a b c d. P a b c d ==> P a b d c) /\ (!a b c d. ~(a = b) /\ ~(c = d) /\ (a = c /\ b = d \/ a = c /\ ~(b = d) \/ ~(a = c) /\ b = d \/ ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d)) ==> P a b c d) ==> (!a b c d:A. ~(a = b) /\ ~(c = d) ==> P a b c d)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`a:A = c`; `a:A = d`; `b:A = c`; `b:A = d`] THEN ASM_MESON_TAC[]);; let SWAP_GENERAL = prove (`!a b c d:A. ~(a = b) /\ ~(c = d) ==> swap(a,b) o swap(c,d) = I \/ ?x y z. ~(x = a) /\ ~(y = a) /\ ~(z = a) /\ ~(x = y) /\ swap(a,b) o swap(c,d) = swap(x,y) o swap(a,z)`, MATCH_MP_TAC SYMMETRY_LEMMA THEN CONJ_TAC THENL [REWRITE_TAC[SWAP_SYM] THEN SIMP_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THENL [MESON_TAC[SWAP_IDEMPOTENT]; DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`b:A`; `d:A`; `b:A`] THEN ASM_MESON_TAC[SWAP_COMMON]; DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:A`; `d:A`; `c:A`] THEN ASM_MESON_TAC[SWAP_COMMON']; DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:A`; `d:A`; `b:A`] THEN ASM_MESON_TAC[SWAP_INDEPENDENT]]);; let FIXING_SWAPSEQ_DECREASE = prove (`!n p a b:A. swapseq n p /\ ~(a = b) /\ (swap(a,b) o p) a = a ==> ~(n = 0) /\ swapseq (n - 1) (swap(a,b) o p)`, INDUCT_TAC THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [swapseq_CASES] THEN REWRITE_TAC[NOT_SUC] THENL [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[I_THM; o_THM; swap] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:A`; `d:A`; `q:A->A`; `m:num`] THEN REWRITE_TAC[SUC_INJ; GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[o_ASSOC] THEN STRIP_TAC THEN MP_TAC(SPECL [`a:A`; `b:A`; `c:A`; `d:A`] SWAP_GENERAL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THEN ASM_REWRITE_TAC[I_O_ID; SUC_SUB1; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`; `z:A`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`q:A->A`; `a:A`; `z:A`]) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check(is_eq o concl)) THEN REWRITE_TAC[GSYM o_ASSOC] THEN ABBREV_TAC `r:A->A = swap(a:A,z) o q` THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; swap] THEN ASM_MESON_TAC[]; SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_SUB1; GSYM o_ASSOC] THEN ASM_MESON_TAC[swapseq_RULES]]);; let SWAPSEQ_IDENTITY_EVEN = prove (`!n. swapseq n (I:A->A) ==> EVEN n`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [swapseq_CASES] THEN DISCH_THEN(DISJ_CASES_THEN2 (SUBST_ALL_TAC o CONJUNCT1) MP_TAC) THEN REWRITE_TAC[EVEN; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:A`; `b:A`; `p:A->A`; `m:num`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MP_TAC(SPECL [`m:num`; `p:A->A`; `a:A`; `b:A`] FIXING_SWAPSEQ_DECREASE) THEN ASM_REWRITE_TAC[I_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `m - 1`) THEN UNDISCH_THEN `SUC m = n` (SUBST_ALL_TAC o SYM) THEN ASM_REWRITE_TAC[ARITH_RULE `m - 1 < SUC m`] THEN UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[SUC_SUB1; EVEN]);; (* ------------------------------------------------------------------------- *) (* Therefore we have a welldefined notion of parity. *) (* ------------------------------------------------------------------------- *) let evenperm = new_definition `evenperm(p) = EVEN(@n. swapseq n p)`;; let SWAPSEQ_EVEN_EVEN = prove (`!m n p:A->A. swapseq m p /\ swapseq n p ==> (EVEN m <=> EVEN n)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP SWAPSEQ_INVERSE_EXISTS) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `swapseq (n + m) :(A->A)->bool`) THEN ASM_SIMP_TAC[SWAPSEQ_COMPOSE] THEN DISCH_THEN(MP_TAC o MATCH_MP SWAPSEQ_IDENTITY_EVEN) THEN SIMP_TAC[EVEN_ADD]);; let EVENPERM_UNIQUE = prove (`!n p b. swapseq n p /\ EVEN n = b ==> evenperm p = b`, REWRITE_TAC[evenperm] THEN MESON_TAC[SWAPSEQ_EVEN_EVEN]);; (* ------------------------------------------------------------------------- *) (* And it has the expected composition properties. *) (* ------------------------------------------------------------------------- *) let EVENPERM_I = prove (`evenperm I = T`, MATCH_MP_TAC EVENPERM_UNIQUE THEN MESON_TAC[swapseq_RULES; EVEN]);; let EVENPERM_SWAP = prove (`!a b:A. evenperm(swap(a,b)) = (a = b)`, REPEAT GEN_TAC THEN MATCH_MP_TAC EVENPERM_UNIQUE THEN MESON_TAC[SWAPSEQ_SWAP; NUM_RED_CONV `EVEN 0`; NUM_RED_CONV `EVEN 1`]);; let EVENPERM_COMPOSE = prove (`!p q. permutation p /\ permutation q ==> evenperm (p o q) = (evenperm p = evenperm q)`, REWRITE_TAC[permutation; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN ASSUME_TAC(MATCH_MP SWAPSEQ_COMPOSE th)) THEN ASM_MESON_TAC[EVENPERM_UNIQUE; SWAPSEQ_COMPOSE; EVEN_ADD]);; let EVENPERM_INVERSE = prove (`!p. permutation p ==> evenperm(inverse p) = evenperm p`, REWRITE_TAC[permutation] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EVENPERM_UNIQUE THEN ASM_MESON_TAC[SWAPSEQ_INVERSE; EVENPERM_UNIQUE]);; (* ------------------------------------------------------------------------- *) (* A more abstract characterization of permutations. *) (* ------------------------------------------------------------------------- *) let PERMUTATION_BIJECTIVE = prove (`!p. permutation p ==> !y. ?!x. p(x) = y`, REWRITE_TAC[permutation] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP SWAPSEQ_INVERSE_EXISTS) THEN REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM; LEFT_IMP_EXISTS_THM] THEN MESON_TAC[]);; let PERMUTATION_FINITE_SUPPORT = prove (`!p. permutation p ==> FINITE {x:A | ~(p x = x)}`, REWRITE_TAC[permutation; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC swapseq_INDUCT THEN REWRITE_TAC[I_THM; FINITE_RULES; SET_RULE `{x | F} = {}`] THEN MAP_EVERY X_GEN_TAC [`a:A`; `b:A`; `p:A->A`] THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `(a:A) INSERT b INSERT {x | ~(p x = x)}` THEN ASM_REWRITE_TAC[FINITE_INSERT; SUBSET; IN_INSERT; IN_ELIM_THM] THEN REWRITE_TAC[o_THM; swap] THEN MESON_TAC[]);; let PERMUTATION_LEMMA = prove (`!s p:A->A. FINITE s /\ (!y. ?!x. p(x) = y) /\ (!x. ~(x IN s) ==> p x = x) ==> permutation p`, ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [REWRITE_TAC[NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `p:A->A = I` (fun th -> REWRITE_TAC[th; PERMUTATION_I]) THEN ASM_REWRITE_TAC[FUN_EQ_THM; I_THM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN STRIP_TAC THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `permutation((swap(a,p(a)) o swap(a,p(a))) o (p:A->A))` MP_TAC THENL [ALL_TAC; REWRITE_TAC[SWAP_IDEMPOTENT; I_O_ID]] THEN REWRITE_TAC[GSYM o_ASSOC] THEN MATCH_MP_TAC PERMUTATION_COMPOSE THEN REWRITE_TAC[PERMUTATION_SWAP] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [UNDISCH_TAC `!y. ?!x. (p:A->A) x = y` THEN REWRITE_TAC[EXISTS_UNIQUE_THM; swap; o_THM] THEN ASM_CASES_TAC `(p:A->A) a = a` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[TAUT `(if p then x else y) = a <=> if p then x = a else y = a`] THEN REWRITE_TAC[TAUT `(if p then x else y) <=> p /\ x \/ ~p /\ y`] THEN ASM_MESON_TAC[]; REWRITE_TAC[swap; o_THM] THEN ASM_CASES_TAC `(p:A->A) a = a` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; let PERMUTATION = prove (`!p. permutation p <=> (!y. ?!x. p(x) = y) /\ FINITE {x:A | ~(p(x) = x)}`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[PERMUTATION_BIJECTIVE; PERMUTATION_FINITE_SUPPORT] THEN STRIP_TAC THEN MATCH_MP_TAC PERMUTATION_LEMMA THEN EXISTS_TAC `{x:A | ~(p x = x)}` THEN ASM_SIMP_TAC[IN_ELIM_THM]);; let PERMUTATION_INVERSE_WORKS = prove (`!p. permutation p ==> inverse p o p = I /\ p o inverse p = I`, MESON_TAC[PERMUTATION_BIJECTIVE; SURJECTIVE_INVERSE_o; INJECTIVE_INVERSE_o]);; let PERMUTATION_INVERSE_COMPOSE = prove (`!p q. permutation p /\ permutation q ==> inverse(p o q) = inverse q o inverse p`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INVERSE_UNIQUE_o THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP PERMUTATION_INVERSE_WORKS)) THEN REWRITE_TAC[GSYM o_ASSOC] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_ASSOC] THEN ASM_REWRITE_TAC[I_O_ID]);; let PERMUTATION_COMPOSE_EQ = prove (`(!p q:A->A. permutation(p) ==> (permutation(p o q) <=> permutation q)) /\ (!p q:A->A. permutation(q) ==> (permutation(p o q) <=> permutation p))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PERMUTATION_INVERSE) THEN EQ_TAC THEN ASM_SIMP_TAC[PERMUTATION_COMPOSE] THENL [DISCH_THEN(MP_TAC o SPEC `inverse(p:A->A)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] PERMUTATION_COMPOSE)); DISCH_THEN(MP_TAC o SPEC `inverse(q:A->A)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] PERMUTATION_COMPOSE))] THEN ASM_SIMP_TAC[GSYM o_ASSOC; PERMUTATION_INVERSE_WORKS] THEN ASM_SIMP_TAC[o_ASSOC; PERMUTATION_INVERSE_WORKS] THEN REWRITE_TAC[I_O_ID]);; let PERMUTATION_COMPOSE_SWAP = prove (`(!p a b:A. permutation(swap(a,b) o p) <=> permutation p) /\ (!p a b:A. permutation(p o swap(a,b)) <=> permutation p)`, SIMP_TAC[PERMUTATION_COMPOSE_EQ; PERMUTATION_SWAP]);; (* ------------------------------------------------------------------------- *) (* Relation to "permutes". *) (* ------------------------------------------------------------------------- *) let PERMUTATION_PERMUTES = prove (`!p:A->A. permutation p <=> ?s. FINITE s /\ p permutes s`, GEN_TAC THEN REWRITE_TAC[PERMUTATION; permutes] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `{x:A | ~(p x = x)}` THEN ASM_SIMP_TAC[IN_ELIM_THM]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN ASM_SIMP_TAC[IN_ELIM_THM; SUBSET] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Hence a sort of induction principle composing by swaps. *) (* ------------------------------------------------------------------------- *) let PERMUTES_INDUCT = prove (`!P s. FINITE s /\ P I /\ (!a b:A p. a IN s /\ b IN s /\ P p /\ permutation p ==> P (swap(a,b) o p)) ==> (!p. p permutes s ==> P p)`, ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b ==> a ==> c ==> d`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_REWRITE_TAC[PERMUTES_EMPTY; IN_INSERT] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `p = swap(x,p x) o swap(x,p x) o (p:A->A)` SUBST1_TAC THENL [REWRITE_TAC[o_ASSOC; SWAP_IDEMPOTENT; I_O_ID]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN ASSUME_TAC th) THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_INSERT; PERMUTES_INSERT_LEMMA; PERMUTATION_PERMUTES; FINITE_INSERT; PERMUTATION_COMPOSE; PERMUTATION_SWAP]);; (* ------------------------------------------------------------------------- *) (* Sign of a permutation as a real number. *) (* ------------------------------------------------------------------------- *) let sign = new_definition `(sign p):real = if evenperm p then &1 else -- &1`;; let SIGN_NZ = prove (`!p. ~(sign p = &0)`, REWRITE_TAC[sign] THEN REAL_ARITH_TAC);; let SIGN_I = prove (`sign I = &1`, REWRITE_TAC[sign; EVENPERM_I]);; let SIGN_INVERSE = prove (`!p. permutation p ==> sign(inverse p) = sign p`, SIMP_TAC[sign; EVENPERM_INVERSE] THEN REAL_ARITH_TAC);; let SIGN_COMPOSE = prove (`!p q. permutation p /\ permutation q ==> sign(p o q) = sign(p) * sign(q)`, SIMP_TAC[sign; EVENPERM_COMPOSE] THEN REAL_ARITH_TAC);; let SIGN_SWAP = prove (`!a b. sign(swap(a,b)) = if a = b then &1 else -- &1`, REWRITE_TAC[sign; EVENPERM_SWAP]);; let SIGN_IDEMPOTENT = prove (`!p. sign(p) * sign(p) = &1`, GEN_TAC THEN REWRITE_TAC[sign] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let REAL_ABS_SIGN = prove (`!p. abs(sign p) = &1`, REWRITE_TAC[sign] THEN REAL_ARITH_TAC);; let REAL_SGN_SIGN = prove (`!p:A->A. real_sgn(sign p) = sign p`, GEN_TAC THEN REWRITE_TAC[sign] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SGN_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* More lemmas about permutations. *) (* ------------------------------------------------------------------------- *) let PERMUTES_NUMSET_LE = prove (`!p s:num->bool. p permutes s /\ (!i. i IN s ==> p(i) <= i) ==> p = I`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; I_THM] THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_CASES_TAC `(n:num) IN s` THENL [ALL_TAC; ASM_MESON_TAC[permutes]] THEN ASM_SIMP_TAC[GSYM LE_ANTISYM] THEN REWRITE_TAC[GSYM NOT_LT] THEN ASM_MESON_TAC[PERMUTES_INJECTIVE; LT_REFL]);; let PERMUTES_NUMSET_GE = prove (`!p s:num->bool. p permutes s /\ (!i. i IN s ==> i <= p(i)) ==> p = I`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`inverse(p:num->num)`; `s:num->bool`] PERMUTES_NUMSET_LE) THEN ANTS_TAC THENL [ASM_MESON_TAC[PERMUTES_INVERSE; PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; ASM_MESON_TAC[PERMUTES_INVERSE_INVERSE; INVERSE_I]]);; let IMAGE_INVERSE_PERMUTATIONS = prove (`!s:A->bool. {inverse p | p permutes s} = {p | p permutes s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[PERMUTES_INVERSE_INVERSE; PERMUTES_INVERSE]);; let IMAGE_COMPOSE_PERMUTATIONS_L = prove (`!s q:A->A. q permutes s ==> {q o p | p permutes s} = {p | p permutes s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:A->A` THEN EQ_TAC THENL [ASM_MESON_TAC[PERMUTES_COMPOSE]; DISCH_TAC THEN EXISTS_TAC `inverse(q:A->A) o (p:A->A)` THEN ASM_SIMP_TAC[o_ASSOC; PERMUTES_INVERSE; PERMUTES_COMPOSE] THEN ASM_MESON_TAC[PERMUTES_INVERSES_o; I_O_ID]]);; let IMAGE_COMPOSE_PERMUTATIONS_R = prove (`!s q:A->A. q permutes s ==> {p o q | p permutes s} = {p | p permutes s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:A->A` THEN EQ_TAC THENL [ASM_MESON_TAC[PERMUTES_COMPOSE]; DISCH_TAC THEN EXISTS_TAC `(p:A->A) o inverse(q:A->A)` THEN ASM_SIMP_TAC[GSYM o_ASSOC; PERMUTES_INVERSE; PERMUTES_COMPOSE] THEN ASM_MESON_TAC[PERMUTES_INVERSES_o; I_O_ID]]);; let PERMUTES_IN_NUMSEG = prove (`!p n i. p permutes 1..n /\ i IN 1..n ==> 1 <= p(i) /\ p(i) <= n`, REWRITE_TAC[permutes; IN_NUMSEG] THEN MESON_TAC[]);; let SUM_PERMUTATIONS_INVERSE = prove (`!f m n. sum {p | p permutes m..n} f = sum {p | p permutes m..n} (\p. f(inverse p))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM IMAGE_INVERSE_PERMUTATIONS] THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [SET_RULE `{f x | p x} = IMAGE f {x | p x}`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC SUM_IMAGE THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; IN_ELIM_THM] THEN MESON_TAC[PERMUTES_INVERSE_INVERSE]);; let SUM_PERMUTATIONS_COMPOSE_L = prove (`!f m n q. q permutes m..n ==> sum {p | p permutes m..n} f = sum {p | p permutes m..n} (\p. f(q o p))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM(MATCH_MP IMAGE_COMPOSE_PERMUTATIONS_L th)]) THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [SET_RULE `{f x | p x} = IMAGE f {x | p x}`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC SUM_IMAGE THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `\p:num->num. inverse(q:num->num) o p`) THEN REWRITE_TAC[o_ASSOC] THEN EVERY_ASSUM(CONJUNCTS_THEN SUBST1_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN REWRITE_TAC[I_O_ID]);; let SUM_PERMUTATIONS_COMPOSE_R = prove (`!f m n q. q permutes m..n ==> sum {p | p permutes m..n} f = sum {p | p permutes m..n} (\p. f(p o q))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM(MATCH_MP IMAGE_COMPOSE_PERMUTATIONS_R th)]) THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [SET_RULE `{f x | p x} = IMAGE f {x | p x}`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC SUM_IMAGE THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `\p:num->num. p o inverse(q:num->num)`) THEN REWRITE_TAC[GSYM o_ASSOC] THEN EVERY_ASSUM(CONJUNCTS_THEN SUBST1_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN REWRITE_TAC[I_O_ID]);; let CARD_EVEN_PERMUTATIONS = prove (`!s:A->bool. FINITE s /\ 2 <= CARD s ==> 2 * CARD {p | p permutes s /\ evenperm p} = FACT(CARD s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?a b:A. a IN s /\ b IN s /\ ~(a = b)` STRIP_ASSUME_TAC THENL [MP_TAC(SPECL [`2`; `s:A->bool`] CHOOSE_SUBSET_STRONG) THEN ASM_REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!p:A->A. p permutes s ==> permutation p` ASSUME_TAC THENL [ASM_MESON_TAC[PERMUTATION_PERMUTES]; ALL_TAC] THEN SUBGOAL_THEN `!Q. FINITE {p:A->A | p permutes s /\ Q p}` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `{p | p permutes s /\ Q p} = {p | p IN {p | p permutes s} /\ Q p}`] THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_PERMUTATIONS]; ALL_TAC] THEN SUBGOAL_THEN `FACT(CARD s) = CARD ({p | p permutes s /\ evenperm p} UNION IMAGE (\p. swap(a:A,b) o p) {p | p permutes s /\ evenperm p})` SUBST1_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CARD_PERMUTATIONS) THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> P(f x)) /\ (!x. f(f x) = x) /\ (!x. P x ==> Q x \/ Q(f x)) ==> {x | P x} = {x | P x /\ Q x} UNION IMAGE f {x | P x /\ Q x}`) THEN ASM_SIMP_TAC[PERMUTES_COMPOSE; PERMUTES_SWAP; SWAP_IDEMPOTENT; o_ASSOC; I_O_ID; EVENPERM_COMPOSE; PERMUTATION_SWAP; EVENPERM_SWAP] THEN CONV_TAC TAUT; W(MP_TAC o PART_MATCH (lhs o rand) CARD_UNION o rand o snd) THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ANTS_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. P x ==> ~P(f x)) ==> {x | P x} INTER IMAGE f {x | P x} = {}`) THEN ASM_SIMP_TAC[IN_ELIM_THM; EVENPERM_COMPOSE; PERMUTATION_SWAP] THEN ASM_REWRITE_TAC[EVENPERM_SWAP]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(ARITH_RULE `b = a ==> 2 * a = a + b`) THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(MESON[] `(!x. f(f x) = x) ==> (!x y. P x /\ P y /\ f x = f y ==> x = y)`) THEN ASM_SIMP_TAC[SWAP_IDEMPOTENT; o_ASSOC; I_O_ID]]);; (* ------------------------------------------------------------------------- *) (* The special case of involutions. *) (* ------------------------------------------------------------------------- *) let PERMUTES_INVOLUTION = prove (`!p s:A->bool. (!x. p(p x) = x) /\ (!x. ~(x IN s) ==> p x = x) ==> p permutes s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PERMUTES_BIJECTIONS THEN EXISTS_TAC `p:A->A` THEN ASM_MESON_TAC[]);; let SIGN_INVOLUTION = prove (`!p:A->A s. FINITE s /\ (!x. p(p x) = x) /\ (!x. ~(x IN s) ==> p x = x) ==> sign p = --(&1) pow (CARD {x | ~(p x = x)} DIV 2)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN WF_INDUCT_TAC `CARD(s:A->bool)` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `p:A->A = I` THEN ASM_SIMP_TAC[I_THM; EMPTY_GSPEC; CARD_CLAUSES; SIGN_I; DIV_0; real_pow; ARITH_EQ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FUN_EQ_THM]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; I_THM; NOT_FORALL_THM] THEN X_GEN_TAC `a:A` THEN DISCH_TAC THEN SUBGOAL_THEN `(a:A) IN s /\ p a IN s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A) DELETE (p a)`) THEN ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE; IN_DELETE] THEN ASM_SIMP_TAC[CARD_EQ_0; ARITH_RULE `n - 1 - 1 < n <=> ~(n = 0)`] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `permutation(p:A->A)` ASSUME_TAC THENL [ASM_MESON_TAC[PERMUTATION_PERMUTES; PERMUTES_INVOLUTION]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `p o swap(a:A,p a)`) THEN ASM_SIMP_TAC[SIGN_COMPOSE; PERMUTATION_SWAP; SIGN_SWAP] THEN REWRITE_TAC[o_THM; swap] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REAL_RING `-- &1 * a:real = b ==> s * -- &1 = a ==> s = b`) THEN SUBGOAL_THEN `{x | ~(p (if x = a then p a else if x = p a then a else x) = x)} = {x:A | ~(p x = x)} DELETE a DELETE (p a)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `FINITE {x:A | ~(p x = x)}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN ASM SET_TAC[]; ASM_SIMP_TAC[CARD_DELETE; IN_ELIM_THM; FINITE_DELETE; IN_DELETE]] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN MATCH_MP_TAC(ARITH_RULE `m + 2 = n ==> SUC(m DIV 2) = n DIV 2`) THEN MATCH_MP_TAC(ARITH_RULE `2 <= n ==> n - 1 - 1 + 2 = n`) THEN TRANS_TAC LE_TRANS `CARD {a:A,p a}` THEN CONJ_TAC THENL [ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV; MATCH_MP_TAC CARD_SUBSET THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Conversion for `{p | p permutes s}` where s is a set enumeration. *) (* ------------------------------------------------------------------------- *) let PERMSET_CONV = let pth_empty = prove (`{p | p permutes {}} = {I}`, REWRITE_TAC[PERMUTES_EMPTY] THEN SET_TAC[]) and pth_cross = SET_RULE `IMAGE f {x,y | x IN {} /\ y IN t} = {} /\ IMAGE f {x,y | x IN (a INSERT s) /\ y IN t} = (IMAGE (\y. f(a,y)) t) UNION (IMAGE f {x,y | x IN s /\ y IN t})` and pth_union = SET_RULE `{} UNION t = t /\ (x INSERT s) UNION t = x INSERT (s UNION t)` in let rec PERMSET_CONV tm = (GEN_REWRITE_CONV I [pth_empty] ORELSEC (GEN_REWRITE_CONV I [PERMUTES_INSERT] THENC ONCE_DEPTH_CONV PERMSET_CONV THENC REWRITE_CONV[pth_cross] THENC REWRITE_CONV[IMAGE_CLAUSES] THENC REWRITE_CONV[pth_union] THENC REWRITE_CONV[SWAP_REFL; I_O_ID])) tm in PERMSET_CONV;; (* ------------------------------------------------------------------------- *) (* Sum over a set of permutations (could generalize to iteration). *) (* ------------------------------------------------------------------------- *) let SUM_OVER_PERMUTATIONS_INSERT = prove (`!f a s. FINITE s /\ ~(a IN s) ==> sum {p:A->A | p permutes (a INSERT s)} f = sum (a INSERT s) (\b. sum {p | p permutes s} (\q. f(swap(a,b) o q)))`, let lemma = prove (`(\(b,p). f (swap (a,b) o p)) = f o (\(b,p). swap(a,b) o p)`, REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM; o_THM]) in REPEAT STRIP_TAC THEN REWRITE_TAC[PERMUTES_INSERT] THEN ASM_SIMP_TAC[FINITE_PERMUTATIONS; FINITE_INSERT; SUM_SUM_PRODUCT] THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`b:A`; `p:A->A`; `c:A`; `q:A->A`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o C AP_THM `a:A`) THEN REWRITE_TAC[o_THM; swap] THEN ASM_MESON_TAC[permutes]; DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(\p:A->A. swap(a:A,c) o p)`) THEN REWRITE_TAC[o_ASSOC; SWAP_IDEMPOTENT; I_O_ID]]);; let SUM_OVER_PERMUTATIONS_NUMSEG = prove (`!f m n. m <= n ==> sum {p | p permutes (m..n)} f = sum(m..n) (\i. sum {p | p permutes (m+1..n)} (\q. f(swap(m,i) o q)))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM NUMSEG_LREC] THEN MATCH_MP_TAC SUM_OVER_PERMUTATIONS_INSERT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; hol-light/Library/pocklington.ml000066400000000000000000002244171303454263000172440ustar00rootroot00000000000000(* ========================================================================= *) (* HOL primality proving via Pocklington-optimized Pratt certificates. *) (* ========================================================================= *) needs "Library/iter.ml";; needs "Library/prime.ml";; prioritize_num();; let num_0 = Int 0;; let num_1 = Int 1;; let num_2 = Int 2;; (* ------------------------------------------------------------------------- *) (* Mostly for compatibility. Should eliminate this eventually. *) (* ------------------------------------------------------------------------- *) let nat_mod_lemma = prove (`!x y n:num. (x == y) (mod n) /\ y <= x ==> ?q. x = y + n * q`, REPEAT GEN_TAC THEN REWRITE_TAC[num_congruent] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_REWRITE_TAC [INTEGER_RULE `(x == y) (mod &n) <=> &n divides (x - y)`] THEN ASM_SIMP_TAC[INT_OF_NUM_SUB; ARITH_RULE `x <= y ==> (y:num = x + d <=> y - x = d)`] THEN REWRITE_TAC[GSYM num_divides; divides]);; let nat_mod = prove (`!x y n:num. (mod n) x y <=> ?q1 q2. x + n * q1 = y + n * q2`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM cong] THEN EQ_TAC THENL [ALL_TAC; NUMBER_TAC] THEN MP_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THEN REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (c /\ b) \/ (c /\ a) ==> d`] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ALL_TAC; ONCE_REWRITE_TAC[NUMBER_RULE `(x:num == y) (mod n) <=> (y == x) (mod n)`]] THEN MESON_TAC[nat_mod_lemma; ARITH_RULE `x + y * 0 = x`]);; (* ------------------------------------------------------------------------- *) (* Lemmas about previously defined terms. *) (* ------------------------------------------------------------------------- *) let PRIME = prove (`!p. prime p <=> ~(p = 0) /\ ~(p = 1) /\ !m. 0 < m /\ m < p ==> coprime(p,m)`, GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP PRIME_COPRIME) THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN STRIP_TAC THEN ASM_REWRITE_TAC[COPRIME_1] THEN ASM_MESON_TAC[NOT_LT; LT_REFL; DIVIDES_LE]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC o MATCH_MP PRIME_FACTOR) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN SUBGOAL_THEN `~(coprime(p,q))` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[coprime; NOT_FORALL_THM] THEN EXISTS_TAC `q:num` THEN ASM_REWRITE_TAC[DIVIDES_REFL] THEN ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[LT_LE; LE_0] THEN ASM_CASES_TAC `p:num = q` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[DIVIDES_ZERO]);; let FINITE_NUMBER_SEGMENT = prove (`!n. { m | 0 < m /\ m < n } HAS_SIZE (n - 1)`, INDUCT_TAC THENL [SUBGOAL_THEN `{m | 0 < m /\ m < 0} = EMPTY` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV; ASM_CASES_TAC `n = 0` THENL [SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = EMPTY` SUBST1_TAC THENL [ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[HAS_SIZE_0]; SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = n INSERT {m | 0 < m /\ m < n}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `~(n = 0)` THEN POP_ASSUM MP_TAC THEN SIMP_TAC[FINITE_RULES; HAS_SIZE; CARD_CLAUSES] THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; LT_REFL] THEN ARITH_TAC]]);; let COPRIME_MOD = prove (`!a n. ~(n = 0) ==> (coprime(a MOD n,n) <=> coprime(a,n))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [MATCH_MP DIVISION th]) THEN REWRITE_TAC[coprime] THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MESON_TAC[DIVIDES_ADD; DIVIDES_ADD_REVR; DIVIDES_ADD_REVL; DIVIDES_LMUL; DIVIDES_RMUL]);; (* ------------------------------------------------------------------------- *) (* Congruences. *) (* ------------------------------------------------------------------------- *) let CONG = prove (`!x y n. ~(n = 0) ==> ((x == y) (mod n) <=> (x MOD n = y MOD n))`, REWRITE_TAC[cong; nat_mod] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_CASES_TAC `x <= y` THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q1 - q2`; MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q2 - q1`] THEN REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; MAP_EVERY EXISTS_TAC [`y DIV n`; `x DIV n`] THEN UNDISCH_TAC `x MOD n = y MOD n` THEN MATCH_MP_TAC(ARITH_RULE `(y = dy + my) /\ (x = dx + mx) ==> (mx = my) ==> (x + dy = y + dx)`) THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[DIVISION]]);; let CONG_MOD_0 = prove (`!x y. (x == y) (mod 0) <=> (x = y)`, NUMBER_TAC);; let CONG_MOD_1 = prove (`!x y. (x == y) (mod 1)`, NUMBER_TAC);; let CONG_0 = prove (`!x n. ((x == 0) (mod n) <=> n divides x)`, NUMBER_TAC);; let CONG_SUB_CASES = prove (`!x y n. (x == y) (mod n) <=> if x <= y then (y - x == 0) (mod n) else (x - y == 0) (mod n)`, REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN COND_CASES_TAC THENL [GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]; ALL_TAC] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let CONG_CASES = prove (`!x y n. (x == y) (mod n) <=> (?q. x = q * n + y) \/ (?q. y = q * n + x)`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN NUMBER_TAC] THEN REWRITE_TAC[cong; nat_mod; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q1:num`; `q2:num`] THEN DISCH_THEN(MP_TAC o MATCH_MP(ARITH_RULE `x + a = y + b ==> x = (b - a) + y \/ y = (a - b) + x`)) THEN REWRITE_TAC[GSYM LEFT_SUB_DISTRIB] THEN MESON_TAC[MULT_SYM]);; let CONG_MULT_LCANCEL = prove (`!a n x y. coprime(a,n) /\ (a * x == a * y) (mod n) ==> (x == y) (mod n)`, NUMBER_TAC);; let CONG_MULT_RCANCEL = prove (`!a n x y. coprime(a,n) /\ (x * a == y * a) (mod n) ==> (x == y) (mod n)`, NUMBER_TAC);; let CONG_REFL = prove (`!x n. (x == x) (mod n)`, NUMBER_TAC);; let EQ_IMP_CONG = prove (`!a b n. a = b ==> (a == b) (mod n)`, SIMP_TAC[CONG_REFL]);; let CONG_SYM = prove (`!x y n. (x == y) (mod n) <=> (y == x) (mod n)`, NUMBER_TAC);; let CONG_TRANS = prove (`!x y z n. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, NUMBER_TAC);; let CONG_ADD = prove (`!x x' y y'. (x == x') (mod n) /\ (y == y') (mod n) ==> (x + y == x' + y') (mod n)`, NUMBER_TAC);; let CONG_MULT = prove (`!x x' y y'. (x == x') (mod n) /\ (y == y') (mod n) ==> (x * y == x' * y') (mod n)`, NUMBER_TAC);; let CONG_EXP = prove (`!n k x y. (x == y) (mod n) ==> (x EXP k == y EXP k) (mod n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[CONG_MULT; EXP; CONG_REFL]);; let CONG_SUB = prove (`!x x' y y'. (x == x') (mod n) /\ (y == y') (mod n) /\ y <= x /\ y' <= x' ==> (x - y == x' - y') (mod n)`, REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + a = x' + a') /\ (y + b = y' + b') /\ y <= x /\ y' <= x' ==> ((x - y) + (a + b') = (x' - y') + (a' + b))`)) THEN REWRITE_TAC[GSYM LEFT_ADD_DISTRIB] THEN MESON_TAC[]);; let CONG_MULT_LCANCEL_EQ = prove (`!a n x y. coprime(a,n) ==> ((a * x == a * y) (mod n) <=> (x == y) (mod n))`, NUMBER_TAC);; let CONG_MULT_RCANCEL_EQ = prove (`!a n x y. coprime(a,n) ==> ((x * a == y * a) (mod n) <=> (x == y) (mod n))`, NUMBER_TAC);; let CONG_ADD_LCANCEL_EQ = prove (`!a n x y. (a + x == a + y) (mod n) <=> (x == y) (mod n)`, NUMBER_TAC);; let CONG_ADD_RCANCEL_EQ = prove (`!a n x y. (x + a == y + a) (mod n) <=> (x == y) (mod n)`, NUMBER_TAC);; let CONG_ADD_RCANCEL = prove (`!a n x y. (x + a == y + a) (mod n) ==> (x == y) (mod n)`, NUMBER_TAC);; let CONG_ADD_LCANCEL = prove (`!a n x y. (a + x == a + y) (mod n) ==> (x == y) (mod n)`, NUMBER_TAC);; let CONG_ADD_LCANCEL_EQ_0 = prove (`!a n x y. (a + x == a) (mod n) <=> (x == 0) (mod n)`, NUMBER_TAC);; let CONG_ADD_RCANCEL_EQ_0 = prove (`!a n x y. (x + a == a) (mod n) <=> (x == 0) (mod n)`, NUMBER_TAC);; let CONG_IMP_EQ = prove (`!x y n. x < n /\ y < n /\ (x == y) (mod n) ==> x = y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LT] THEN ASM_MESON_TAC[CONG; MOD_LT]);; let CONG_DIVIDES_MODULUS = prove (`!x y m n. (x == y) (mod m) /\ n divides m ==> (x == y) (mod n)`, NUMBER_TAC);; let CONG_0_DIVIDES = prove (`!n x. (x == 0) (mod n) <=> n divides x`, NUMBER_TAC);; let CONG_1_DIVIDES = prove (`!n x. (x == 1) (mod n) ==> n divides (x - 1)`, REPEAT GEN_TAC THEN REWRITE_TAC[divides; cong; nat_mod] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(x + q1 = 1 + q2) ==> ~(x = 0) ==> (x - 1 = q2 - q1)`)) THEN ASM_CASES_TAC `x = 0` THEN ASM_REWRITE_TAC[ARITH; GSYM LEFT_SUB_DISTRIB] THEN ASM_MESON_TAC[MULT_CLAUSES]);; let CONG_DIVIDES = prove (`!x y n. (x == y) (mod n) ==> (n divides x <=> n divides y)`, NUMBER_TAC);; let CONG_COPRIME = prove (`!x y n. (x == y) (mod n) ==> (coprime(n,x) <=> coprime(n,y))`, NUMBER_TAC);; let CONG_MOD = prove (`!a n. ~(n = 0) ==> (a MOD n == a) (mod n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN DISCH_THEN(MP_TAC o SPEC `a:num`) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[cong; nat_mod] THEN MAP_EVERY EXISTS_TAC [`a DIV n`; `0`] THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; ADD_AC; MULT_AC]);; let MOD_MULT_CONG = prove (`!a b x y. ~(a = 0) /\ ~(b = 0) ==> ((x MOD (a * b) == y) (mod a) <=> (x == y) (mod a))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(x MOD (a * b) == x) (mod a)` (fun th -> MESON_TAC[th; CONG_TRANS; CONG_SYM]) THEN MATCH_MP_TAC CONG_DIVIDES_MODULUS THEN EXISTS_TAC `a * b` THEN ASM_SIMP_TAC[CONG_MOD; MULT_EQ_0; DIVIDES_RMUL; DIVIDES_REFL]);; let CONG_MOD_MULT = prove (`!x y m n. (x == y) (mod n) /\ m divides n ==> (x == y) (mod m)`, NUMBER_TAC);; let CONG_LMOD = prove (`!x y n. ~(n = 0) ==> ((x MOD n == y) (mod n) <=> (x == y) (mod n))`, MESON_TAC[CONG_MOD; CONG_TRANS; CONG_SYM]);; let CONG_RMOD = prove (`!x y n. ~(n = 0) ==> ((x == y MOD n) (mod n) <=> (x == y) (mod n))`, MESON_TAC[CONG_MOD; CONG_TRANS; CONG_SYM]);; let CONG_MOD_LT = prove (`!y. y < n ==> (x MOD n = y <=> (x == y) (mod n))`, MESON_TAC[MOD_LT; CONG; LT]);; (* ------------------------------------------------------------------------- *) (* Some things when we know more about the order. *) (* ------------------------------------------------------------------------- *) let CONG_LT = prove (`!x y n. y < n ==> ((x == y) (mod n) <=> ?d. x = d * n + y)`, REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN REWRITE_TAC[num_congruent; int_congruent] THEN REWRITE_TAC[INT_ARITH `x = m * n + y <=> x - y:int = n * m`] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN DISJ_CASES_TAC(SPEC `d:int` INT_IMAGE) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (INT_ARITH `x - y:int = n * --m ==> y = x + n * m`)) THEN POP_ASSUM MP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `m = 0 \/ 1 <= m`) THEN ASM_REWRITE_TAC[INT_MUL_RZERO; INT_ARITH `x - (x + a):int = --a`] THENL [STRIP_TAC THEN EXISTS_TAC `0` THEN INT_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_LT] THEN ARITH_TAC]);; let CONG_LE = prove (`!x y n. y <= x ==> ((x == y) (mod n) <=> ?q. x = q * n + y)`, ONCE_REWRITE_TAC[CONG_SYM] THEN ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN SIMP_TAC[ARITH_RULE `y <= x ==> (x = a + y <=> x - y = a)`] THEN REWRITE_TAC[CONG_0; divides] THEN MESON_TAC[MULT_SYM]);; let CONG_TO_1 = prove (`!a n. (a == 1) (mod n) <=> a = 0 /\ n = 1 \/ ?m. a = 1 + m * n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[CONG_MOD_1] THENL [MESON_TAC[ARITH_RULE `n = 0 \/ n = 1 + (n - 1) * 1`]; ALL_TAC] THEN DISJ_CASES_TAC(ARITH_RULE `a = 0 \/ ~(a = 0) /\ 1 <= a`) THEN ASM_SIMP_TAC[CONG_LE] THENL [ALL_TAC; MESON_TAC[ADD_SYM; MULT_SYM]] THEN ASM_MESON_TAC[CONG_SYM; CONG_0; DIVIDES_ONE; ARITH_RULE `~(0 = 1 + a)`]);; (* ------------------------------------------------------------------------- *) (* In particular two common cases. *) (* ------------------------------------------------------------------------- *) let EVEN_MOD_2 = prove (`EVEN n <=> (n == 0) (mod 2)`, SIMP_TAC[EVEN_EXISTS; CONG_LT; ARITH; ADD_CLAUSES; MULT_AC]);; let ODD_MOD_2 = prove (`ODD n <=> (n == 1) (mod 2)`, SIMP_TAC[ODD_EXISTS; CONG_LT; ARITH; ADD_CLAUSES; ADD1; MULT_AC]);; (* ------------------------------------------------------------------------- *) (* Conversion to evaluate congruences. *) (* ------------------------------------------------------------------------- *) let CONG_CONV = let pth = prove (`(x == y) (mod n) <=> if x <= y then n divides (y - x) else n divides (x - y)`, ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN REWRITE_TAC[CONG_0_DIVIDES]) in GEN_REWRITE_CONV I [pth] THENC RATOR_CONV(LAND_CONV NUM_LE_CONV) THENC GEN_REWRITE_CONV I [COND_CLAUSES] THENC RAND_CONV NUM_SUB_CONV THENC DIVIDES_CONV;; (* ------------------------------------------------------------------------- *) (* Some basic theorems about solving congruences. *) (* ------------------------------------------------------------------------- *) let CONG_SOLVE = prove (`!a b n. coprime(a,n) ==> ?x. (a * x == b) (mod n)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `n:num`] BEZOUT_ADD_STRONG) THEN ASM_CASES_TAC `a = 0` THENL [ASM_MESON_TAC[COPRIME_0; COPRIME_SYM; CONG_MOD_1]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `d:num`; `y:num`] THEN ASM_CASES_TAC `d = 1` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[COPRIME]] THEN STRIP_TAC THEN EXISTS_TAC `x * b:num` THEN ASM_REWRITE_TAC[MULT_ASSOC] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `b = 0 + b`] THEN MATCH_MP_TAC CONG_ADD THEN REWRITE_TAC[CONG_REFL] THEN REWRITE_TAC[CONG_0; GSYM MULT_ASSOC] THEN MESON_TAC[divides]);; let CONG_SOLVE_UNIQUE = prove (`!a b n. coprime(a,n) /\ ~(n = 0) ==> ?!x. x < n /\ (a * x == b) (mod n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN MP_TAC(SPECL [`a:num`; `b:num`; `n:num`] CONG_SOLVE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN EXISTS_TAC `x MOD n` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[DIVISION] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `a * x:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL] THEN ASM_SIMP_TAC[CONG; MOD_MOD_REFL]; ALL_TAC] THEN STRIP_TAC THEN X_GEN_TAC `y:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `y MOD n` THEN CONJ_TAC THENL [ASM_SIMP_TAC[MOD_LT]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CONG] THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a:num` THEN ASM_MESON_TAC[CONG_TRANS; CONG_SYM]);; let CONG_SOLVE_UNIQUE_NONTRIVIAL = prove (`!a p x. prime p /\ coprime(p,a) /\ 0 < x /\ x < p ==> ?!y. 0 < y /\ y < p /\ (x * y == a) (mod p)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 < p` ASSUME_TAC THENL [REWRITE_TAC[ARITH_RULE `1 < p <=> ~(p = 0) /\ ~(p = 1)`] THEN ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN MP_TAC(SPECL [`x:num`; `a:num`; `p:num`] CONG_SOLVE_UNIQUE) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PRIME_0]] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MP_TAC(SPECL [`x:num`; `p:num`] PRIME_COPRIME) THEN ASM_CASES_TAC `x = 1` THEN ASM_REWRITE_TAC[COPRIME_1] THEN ASM_MESON_TAC[COPRIME_SYM; NOT_LT; DIVIDES_LE; LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `0 < r <=> ~(r = 0)`] THEN ASM_CASES_TAC `r = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN ASM_SIMP_TAC[ARITH_RULE `~(p = 0) ==> 0 < p`] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN REWRITE_TAC[CONG_0] THEN ASM_MESON_TAC[DIVIDES_REFL; PRIME_1; coprime]);; let CONG_UNIQUE_INVERSE_PRIME = prove (`!p x. prime p /\ 0 < x /\ x < p ==> ?!y. 0 < y /\ y < p /\ (x * y == 1) (mod p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_SOLVE_UNIQUE_NONTRIVIAL THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[COPRIME_1; COPRIME_SYM]);; (* ------------------------------------------------------------------------- *) (* Forms of the Chinese remainder theorem. *) (* ------------------------------------------------------------------------- *) let CONG_CHINESE = prove (`coprime(a,b) /\ (x == y) (mod a) /\ (x == y) (mod b) ==> (x == y) (mod (a * b))`, ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN MESON_TAC[CONG_0; DIVIDES_MUL]);; let CHINESE_REMAINDER_UNIQUE = prove (`!a b m n. coprime(a,b) /\ ~(a = 0) /\ ~(b = 0) ==> ?!x. x < a * b /\ (x == m) (mod a) /\ (x == n) (mod b)`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL [MP_TAC(SPECL [`a:num`; `b:num`; `m:num`; `n:num`] CHINESE_REMAINDER) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `q1:num`; `q2:num`] THEN DISCH_TAC THEN EXISTS_TAC `x MOD (a * b)` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION; MULT_EQ_0]; ALL_TAC] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN CONJ_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o CONJUNCT1); FIRST_X_ASSUM(SUBST1_TAC o CONJUNCT2)] THEN ASM_SIMP_TAC[MOD_MULT_CONG] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[cong; nat_mod; GSYM ADD_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN MESON_TAC[]; REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_IMP_EQ THEN EXISTS_TAC `a * b` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONG_CHINESE; CONG_SYM; CONG_TRANS]]);; let CHINESE_REMAINDER_COPRIME_UNIQUE = prove (`!a b m n. coprime(a,b) /\ ~(a = 0) /\ ~(b = 0) /\ coprime(m,a) /\ coprime(n,b) ==> ?!x. coprime(x,a * b) /\ x < a * b /\ (x == m) (mod a) /\ (x == n) (mod b)`, REPEAT STRIP_TAC THEN MP_TAC (SPECL [`a:num`; `b:num`; `m:num`; `n:num`] CHINESE_REMAINDER_UNIQUE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `(!x. P(x) ==> Q(x)) ==> (?!x. P x) ==> ?!x. Q(x) /\ P(x)`) THEN ASM_SIMP_TAC[CHINESE_REMAINDER_UNIQUE] THEN ASM_MESON_TAC[CONG_COPRIME; COPRIME_SYM; COPRIME_MUL]);; let CONG_CHINESE_EQ = prove (`!a b x y. coprime(a,b) ==> ((x == y) (mod (a * b)) <=> (x == y) (mod a) /\ (x == y) (mod b))`, NUMBER_TAC);; (* ------------------------------------------------------------------------- *) (* Euler totient function. *) (* ------------------------------------------------------------------------- *) let phi = new_definition `phi(n) = CARD { m | 0 < m /\ m <= n /\ coprime(m,n) }`;; let PHI_ALT = prove (`phi(n) = CARD { m | coprime(m,n) /\ m < n}`, REWRITE_TAC[phi] THEN ASM_CASES_TAC `n = 0` THENL [AP_TERM_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[LT; NOT_LT]; ALL_TAC] THEN ASM_CASES_TAC `n = 1` THENL [SUBGOAL_THEN `({m | 0 < m /\ m <= n /\ coprime (m,n)} = {1}) /\ ({m | coprime (m,n) /\ m < n} = {0})` (CONJUNCTS_THEN SUBST1_TAC) THENL [ALL_TAC; SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY]] THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[COPRIME_1] THEN REPEAT STRIP_TAC THEN ARITH_TAC; ALL_TAC] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[LT] THENL [ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]; ASM_MESON_TAC[LE_LT; COPRIME_REFL; LT_NZ]]);; let PHI_FINITE_LEMMA = prove (`!P n. FINITE {m | coprime(m,n) /\ m < n}`, REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC);; let PHI_ANOTHER = prove (`!n. ~(n = 1) ==> (phi(n) = CARD {m | 0 < m /\ m < n /\ coprime(m,n)})`, REPEAT STRIP_TAC THEN REWRITE_TAC[phi] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[LE_LT; COPRIME_REFL; COPRIME_1; LT_NZ]);; let PHI_LIMIT = prove (`!n. phi(n) <= n`, GEN_TAC THEN REWRITE_TAC[PHI_ALT] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_LT] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[FINITE_NUMSEG_LT] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]);; let PHI_LIMIT_STRONG = prove (`!n. ~(n = 1) ==> phi(n) <= n - 1`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]);; let PHI_0 = prove (`phi 0 = 0`, MP_TAC(SPEC `0` PHI_LIMIT) THEN REWRITE_TAC[ARITH] THEN ARITH_TAC);; let PHI_1 = prove (`phi 1 = 1`, REWRITE_TAC[PHI_ALT; COPRIME_1; CARD_NUMSEG_LT]);; let PHI_LOWERBOUND_1_STRONG = prove (`!n. 1 <= n ==> 1 <= phi(n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 = CARD {1}` SUBST1_TAC THENL [SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY; FINITE_RULES; ARITH]; ALL_TAC] THEN REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]]);; let PHI_LOWERBOUND_1 = prove (`!n. 2 <= n ==> 1 <= phi(n)`, MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_TRANS; ARITH_RULE `1 <= 2`]);; let PHI_LOWERBOUND_2 = prove (`!n. 3 <= n ==> 2 <= phi(n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `2 = CARD {1,(n-1)}` SUBST1_TAC THENL [SIMP_TAC[CARD_CLAUSES; IN_INSERT; NOT_IN_EMPTY; FINITE_RULES; ARITH] THEN ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> ~(1 = n - 1)`]; ALL_TAC] THEN REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN ASM_SIMP_TAC[ARITH; ARITH_RULE `3 <= n ==> 0 < n - 1 /\ n - 1 <= n /\ 1 <= n`] THEN REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN MP_TAC(SPEC `n:num` COPRIME_1) THEN REWRITE_TAC[coprime] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `1 = n - (n - 1)` SUBST1_TAC THENL [UNDISCH_TAC `3 <= n` THEN ARITH_TAC; ASM_SIMP_TAC[DIVIDES_SUB]]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]]);; let PHI_EQ_0 = prove (`!n. phi n = 0 <=> n = 0`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[PHI_0] THEN MP_TAC(SPEC `n:num` PHI_LOWERBOUND_1_STRONG) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Value on primes and prime powers. *) (* ------------------------------------------------------------------------- *) let PHI_PRIME_EQ = prove (`!n. (phi n = n - 1) /\ ~(n = 0) /\ ~(n = 1) <=> prime n`, GEN_TAC THEN REWRITE_TAC[PRIME] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[PHI_1; ARITH] THEN MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `{m | 0 < m /\ m < n /\ coprime (m,n)} = {m | 0 < m /\ m < n}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[COPRIME_SYM] THEN CONV_TAC TAUT] THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC CARD_SUBSET_EQ THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]);; let PHI_PRIME = prove (`!p. prime p ==> phi p = p - 1`, MESON_TAC[PHI_PRIME_EQ]);; let PHI_PRIMEPOW_SUC = prove (`!p k. prime(p) ==> phi(p EXP (k + 1)) = p EXP (k + 1) - p EXP k`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[PHI_ALT; COPRIME_PRIMEPOW; ADD_EQ_0; ARITH] THEN REWRITE_TAC[SET_RULE `{n | ~(P n) /\ Q n} = {n | Q n} DIFF {n | P n /\ Q n}`] THEN SIMP_TAC[FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM; CARD_DIFF] THEN REWRITE_TAC[CARD_NUMSEG_LT] THEN AP_TERM_TAC THEN SUBGOAL_THEN `{m | p divides m /\ m < p EXP (k + 1)} = IMAGE (\x. p * x) {m | m < p EXP k}` (fun th -> ASM_SIMP_TAC[th; CARD_IMAGE_INJ; EQ_MULT_LCANCEL; PRIME_IMP_NZ; FINITE_NUMSEG_LT; CARD_NUMSEG_LT]) THEN REWRITE_TAC[EXTENSION; TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`; FORALL_AND_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[IN_ELIM_THM; GSYM ADD1; EXP; LT_MULT_LCANCEL; PRIME_IMP_NZ] THEN CONJ_TAC THENL [ALL_TAC; NUMBER_TAC] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN UNDISCH_TAC `p * n < p * p EXP k` THEN ASM_SIMP_TAC[LT_MULT_LCANCEL; PRIME_IMP_NZ]);; let PHI_PRIMEPOW = prove (`!p k. prime p ==> phi(p EXP k) = if k = 0 then 1 else p EXP k - p EXP (k - 1)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; CONJUNCT1 EXP; PHI_1] THEN ASM_SIMP_TAC[ADD1; PHI_PRIMEPOW_SUC; ADD_SUB]);; let PHI_2 = prove (`phi 2 = 1`, SIMP_TAC[PHI_PRIME; PRIME_2] THEN CONV_TAC NUM_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Multiplicativity property. *) (* ------------------------------------------------------------------------- *) let PHI_MULTIPLICATIVE = prove (`!a b. coprime(a,b) ==> phi(a * b) = phi(a) * phi(b)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`a = 0`; `b = 0`] THEN ASM_REWRITE_TAC[PHI_0; MULT_CLAUSES] THEN SIMP_TAC[PHI_ALT; GSYM CARD_PRODUCT; PHI_FINITE_LEMMA] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN EXISTS_TAC `\p. p MOD a,p MOD b` THEN REWRITE_TAC[PHI_FINITE_LEMMA; IN_ELIM_PAIR_THM] THEN ASM_SIMP_TAC[IN_ELIM_THM; COPRIME_MOD; DIVISION] THEN CONJ_TAC THENL [MESON_TAC[COPRIME_LMUL2; COPRIME_RMUL2]; ALL_TAC] THEN X_GEN_TAC `pp:num#num` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[PAIR_EQ; GSYM CONJ_ASSOC] THEN MP_TAC(SPECL [`a:num`; `b:num`; `m:num`; `n:num`] CHINESE_REMAINDER_COPRIME_UNIQUE) THEN ASM_SIMP_TAC[CONG; MOD_LT]);; (* ------------------------------------------------------------------------- *) (* Even-ness of phi for most arguments. *) (* ------------------------------------------------------------------------- *) let EVEN_PHI = prove (`!n. 3 <= n ==> EVEN(phi n)`, REWRITE_TAC[ARITH_RULE `3 <= n <=> 1 < n /\ ~(n = 2)`; IMP_CONJ] THEN MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN SIMP_TAC[PHI_PRIMEPOW; PHI_MULTIPLICATIVE; EVEN_MULT; EVEN_SUB] THEN CONJ_TAC THENL [MESON_TAC[COPRIME_REFL; ARITH_RULE `~(2 = 1)`]; ALL_TAC] THEN REWRITE_TAC[EVEN_EXP] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP PRIME_ODD) THEN ASM_REWRITE_TAC[] THENL [ASM_CASES_TAC `k = 1` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[GSYM NOT_ODD]]);; let EVEN_PHI_EQ = prove (`!n. EVEN(phi n) <=> n = 0 \/ 3 <= n`, GEN_TAC THEN EQ_TAC THENL [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[ARITH_RULE `~(n = 0 \/ 3 <= n) <=> n = 1 \/ n = 2`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[PHI_1; PHI_2] THEN CONV_TAC NUM_REDUCE_CONV; STRIP_TAC THEN ASM_SIMP_TAC[PHI_0; EVEN_PHI; EVEN]]);; let ODD_PHI_EQ = prove (`!n. ODD(phi n) <=> n = 1 \/ n = 2`, REWRITE_TAC[GSYM NOT_EVEN; EVEN_PHI_EQ] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some iteration theorems. *) (* ------------------------------------------------------------------------- *) let NPRODUCT_MOD = prove (`!s a:A->num n. FINITE s /\ ~(n = 0) ==> (iterate (*) s (\m. a(m) MOD n) == iterate (*) s a) (mod n)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x y. (x == y) (mod n)` (MATCH_MP ITERATE_RELATED MONOIDAL_MUL)) THEN SIMP_TAC[NEUTRAL_MUL; CONG_MULT; CONG_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[CONG_MOD]);; let NPRODUCT_CMUL = prove (`!s a c n. FINITE s ==> iterate (*) s (\m. c * a(m)) = c EXP (CARD s) * iterate (*) s a`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_MUL; NEUTRAL_MUL; CARD_CLAUSES; EXP; MULT_CLAUSES] THEN REWRITE_TAC[MULT_AC]);; let COPRIME_NPRODUCT = prove (`!s n. FINITE s /\ (!x. x IN s ==> coprime(n,a(x))) ==> coprime(n,iterate (*) s a)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_MUL; NEUTRAL_MUL; IN_INSERT; COPRIME_MUL; COPRIME_1]);; let ITERATE_OVER_COPRIME = prove (`!op f n k. monoidal(op) /\ coprime(k,n) /\ (!x y. (x == y) (mod n) ==> f x = f y) ==> iterate op {d | coprime(d,n) /\ d < n} (\m. f(k * m)) = iterate op {d | coprime(d,n) /\ d < n} f`, let lemma = prove (`~(n = 0) ==> ((a * x MOD n == b) (mod n) <=> (a * x == b) (mod n))`, MESON_TAC[CONG_REFL; CONG_SYM; CONG_TRANS; CONG_MULT; CONG_MOD]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_SIMP_TAC[LT; SET_RULE `{x | F} = {}`; ITERATE_CLAUSES]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `?m. (k * m == 1) (mod n)` CHOOSE_TAC THENL [ASM_MESON_TAC[CONG_SOLVE; MULT_SYM; CONG_SYM]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ_GENERAL_INVERSES) THEN MAP_EVERY EXISTS_TAC [`\x. (k * x) MOD n`; `\x. (m * x) MOD n`] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[COPRIME_MOD; CONG_MOD_LT; CONG_LMOD; DIVISION; lemma; COPRIME_LMUL] THEN REPEAT STRIP_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CONG_LMOD]) THEN UNDISCH_TAC `(k * m == 1) (mod n)` THEN CONV_TAC NUMBER_RULE);; let ITERATE_ITERATE_DIVISORS = prove (`!op:A->A->A f x. monoidal op ==> iterate op (1..x) (\n. iterate op {d | d divides n} (f n)) = iterate op (1..x) (\n. iterate op (1..(x DIV n)) (\k. f (k * n) n))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ITERATE_ITERATE_PRODUCT; FINITE_NUMSEG; FINITE_DIVISORS; IN_NUMSEG; LE_1] THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] ITERATE_EQ_GENERAL_INVERSES) THEN MAP_EVERY EXISTS_TAC [`\(n,d). d,n DIV d`; `\(n:num,k). n * k,n`] THEN ASM_SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; PAIR_EQ] THEN CONJ_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `n:num` THENL [X_GEN_TAC `k:num` THEN SIMP_TAC[DIV_MULT; LE_1; GSYM LE_RDIV_EQ] THEN SIMP_TAC[MULT_EQ_0; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN DISCH_THEN(K ALL_TAC) THEN NUMBER_TAC; X_GEN_TAC `d:num` THEN ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[DIVIDES_ZERO] THENL [ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN ASM_SIMP_TAC[DIV_MONO] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVIDES_DIV_MULT; MULT_SYM]] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_SIMP_TAC[DIV_EQ_0; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Fermat's Little theorem / Fermat-Euler theorem. *) (* ------------------------------------------------------------------------- *) let FERMAT_LITTLE = prove (`!a n. coprime(a,n) ==> (a EXP (phi n) == 1) (mod n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[COPRIME_0; PHI_0; CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `iterate (*) {m | coprime (m,n) /\ m < n} (\m. m)` THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[PHI_ALT; MULT_CLAUSES] THEN SIMP_TAC[IN_ELIM_THM; ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_NPRODUCT; PHI_FINITE_LEMMA; GSYM NPRODUCT_CMUL] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `iterate (*) {m | coprime(m,n) /\ m < n} (\m. (a * m) MOD n)` THEN ASM_SIMP_TAC[NPRODUCT_MOD; PHI_FINITE_LEMMA] THEN MP_TAC(ISPECL [`( * ):num->num->num`; `\x. x MOD n`; `n:num`; `a:num`] ITERATE_OVER_COPRIME) THEN ASM_SIMP_TAC[MONOIDAL_MUL; GSYM CONG] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[CONG_SYM] THEN MATCH_MP_TAC NPRODUCT_MOD THEN ASM_SIMP_TAC[PHI_FINITE_LEMMA]);; let FERMAT_LITTLE_PRIME = prove (`!a p. prime p /\ coprime(a,p) ==> (a EXP (p - 1) == 1) (mod p)`, MESON_TAC[FERMAT_LITTLE; PHI_PRIME_EQ]);; (* ------------------------------------------------------------------------- *) (* Lucas's theorem. *) (* ------------------------------------------------------------------------- *) let LUCAS_COPRIME_LEMMA = prove (`!m n a. ~(m = 0) /\ (a EXP m == 1) (mod n) ==> coprime(a,n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[CONG_MOD_0; EXP_EQ_1] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN SIMP_TAC[COPRIME_1]; ALL_TAC] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[COPRIME_1] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN ASM_SIMP_TAC[CONG] THEN SUBGOAL_THEN `1 MOD n = 1` SUBST1_TAC THENL [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `d divides (a EXP m) MOD n` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[DIVIDES_ONE]] THEN MATCH_MP_TAC DIVIDES_ADD_REVR THEN EXISTS_TAC `a EXP m DIV n * n` THEN ASM_SIMP_TAC[GSYM DIVISION; DIVIDES_LMUL] THEN SUBGOAL_THEN `m = SUC(m - 1)` SUBST1_TAC THENL [UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; ASM_SIMP_TAC[EXP; DIVIDES_RMUL]]);; let LUCAS_WEAK = prove (`!a n. 2 <= n /\ (a EXP (n - 1) == 1) (mod n) /\ (!m. 0 < m /\ m < n - 1 ==> ~(a EXP m == 1) (mod n)) ==> prime(n)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM PHI_PRIME_EQ; PHI_LIMIT_STRONG; GSYM LE_ANTISYM; ARITH_RULE `2 <= n ==> ~(n = 0) /\ ~(n = 1)`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `phi n`) THEN SUBGOAL_THEN `coprime(a,n)` (fun th -> SIMP_TAC[FERMAT_LITTLE; th]) THENL [MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n - 1 = 0)`]; ALL_TAC] THEN REWRITE_TAC[GSYM NOT_LT] THEN MATCH_MP_TAC(TAUT `a ==> ~(a /\ b) ==> ~b`) THEN ASM_SIMP_TAC[PHI_LOWERBOUND_1; ARITH_RULE `1 <= n ==> 0 < n`]);; let LUCAS = prove (`!a n. 2 <= n /\ (a EXP (n - 1) == 1) (mod n) /\ (!p. prime(p) /\ p divides (n - 1) ==> ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ==> prime(n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `2 <= n ==> ~(n = 0)`)) THEN MATCH_MP_TAC LUCAS_WEAK THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`; GSYM NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `0 < n ==> ~(n = 0)`)) THEN SUBGOAL_THEN `m divides (n - 1)` MP_TAC THENL [REWRITE_TAC[divides] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[GSYM MOD_EQ_0] THEN MATCH_MP_TAC(ARITH_RULE `~(0 < n) ==> (n = 0)`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(n - 1) MOD m`) THEN ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `m:num` THEN ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a EXP ((n - 1) DIV m * m)` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN EXISTS_TAC `m:num` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM EXP_ADD] THEN ASM_SIMP_TAC[GSYM DIVISION] THEN REWRITE_TAC[MULT_CLAUSES] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EXP_EXP] THEN UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN ASM_SIMP_TAC[CONG] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `((a EXP m) MOD n) EXP ((n - 1) DIV m) MOD n` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[MOD_EXP_MOD]] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MOD_EXP_MOD] THEN REWRITE_TAC[EXP_ONE]; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN SUBGOAL_THEN `~(r = 1)` MP_TAC THENL [UNDISCH_TAC `m < m * r` THEN CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[MULT_CLAUSES; LT_REFL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN STRIP_TAC THEN UNDISCH_TAC `!p. prime p /\ p divides m * r ==> ~(a EXP ((m * r) DIV p) == 1) (mod n)` THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_SIMP_TAC[DIVIDES_LMUL] THEN SUBGOAL_THEN `(m * r) DIV p = m * (r DIV p)` SUBST1_TAC THENL [MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN UNDISCH_TAC `prime p` THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN ASM_SIMP_TAC[ARITH_RULE `~(p = 0) ==> 0 < p`] THEN DISCH_TAC THEN REWRITE_TAC[ADD_CLAUSES; GSYM MULT_ASSOC] THEN AP_TERM_TAC THEN UNDISCH_TAC `p divides r` THEN REWRITE_TAC[divides] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DIV_MULT] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN ASM_SIMP_TAC[CONG] THEN DISCH_THEN(MP_TAC o C AP_THM `r DIV p` o AP_TERM `(EXP)`) THEN DISCH_THEN(MP_TAC o C AP_THM `n:num` o AP_TERM `(MOD)`) THEN ASM_SIMP_TAC[MOD_EXP_MOD] THEN REWRITE_TAC[EXP_EXP; EXP_ONE]);; (* ------------------------------------------------------------------------- *) (* Definition of the order of a number mod n (always 0 in non-coprime case). *) (* ------------------------------------------------------------------------- *) let order = new_definition `order n a = @d. !k. (a EXP k == 1) (mod n) <=> d divides k`;; let EXP_ITER = prove (`!x n. x EXP n = ITER n (\y. x * y) (1)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; EXP]);; let ORDER_DIVIDES = prove (`!n a d. (a EXP d == 1) (mod n) <=> order(n) a divides d`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[order] THEN CONV_TAC SELECT_CONV THEN MP_TAC(ISPECL [`\x y:num. (x == y) (mod n)`; `\x:num. a * x`; `1`] ORDER_EXISTENCE_ITER) THEN REWRITE_TAC[GSYM EXP_ITER] THEN DISCH_THEN MATCH_MP_TAC THEN NUMBER_TAC);; let ORDER = prove (`!n a. (a EXP (order(n) a) == 1) (mod n)`, REWRITE_TAC[ORDER_DIVIDES; DIVIDES_REFL]);; let ORDER_MINIMAL = prove (`!n a m. 0 < m /\ m < order(n) a ==> ~((a EXP m == 1) (mod n))`, REWRITE_TAC[ORDER_DIVIDES] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_ARITH_TAC);; let ORDER_WORKS = prove (`!n a. (a EXP (order(n) a) == 1) (mod n) /\ !m. 0 < m /\ m < order(n) a ==> ~((a EXP m == 1) (mod n))`, MESON_TAC[ORDER; ORDER_MINIMAL]);; let ORDER_1 = prove (`!n. order n 1 = 1`, REWRITE_TAC[GSYM DIVIDES_ONE; GSYM ORDER_DIVIDES; EXP_1; CONG_REFL]);; let ORDER_EQ_0 = prove (`!n a. order(n) a = 0 <=> ~coprime(n,a)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [ONCE_REWRITE_TAC[COPRIME_SYM] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FERMAT_LITTLE) THEN ASM_REWRITE_TAC[ORDER_DIVIDES; DIVIDES_ZERO; PHI_EQ_0] THEN ASM_MESON_TAC[COPRIME_0; ORDER_1; ARITH_RULE `~(1 = 0)`]; MP_TAC(SPECL [`n:num`; `a:num`] ORDER) THEN SPEC_TAC(`order n a`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `~p ==> (q ==> p) ==> q ==> r`)) THEN REWRITE_TAC[EXP] THEN CONV_TAC NUMBER_RULE]);; let ORDER_CONG = prove (`!n a b. (a == b) (mod n) ==> order n a = order n b`, REPEAT STRIP_TAC THEN REWRITE_TAC[order] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[CONG_EXP; CONG_REFL; CONG_SYM; CONG_TRANS]);; let COPRIME_ORDER = prove (`!n a. coprime(n,a) ==> order(n) a > 0 /\ (a EXP (order(n) a) == 1) (mod n) /\ !m. 0 < m /\ m < order(n) a ==> ~((a EXP m == 1) (mod n))`, SIMP_TAC[ARITH_RULE `n > 0 <=> ~(n = 0)`; ORDER_EQ_0] THEN MESON_TAC[ORDER; ORDER_MINIMAL]);; let ORDER_DIVIDES_PHI = prove (`!a n. coprime(n,a) ==> (order n a) divides (phi n)`, MESON_TAC[ORDER_DIVIDES; FERMAT_LITTLE; COPRIME_SYM]);; let ORDER_DIVIDES_EXPDIFF = prove (`!a n d e. coprime(n,a) ==> ((a EXP d == a EXP e) (mod n) <=> (d == e) (mod (order n a)))`, SUBGOAL_THEN `!a n d e. coprime(n,a) /\ e <= d ==> ((a EXP d == a EXP e) (mod n) <=> (d == e) (mod (order n a)))` (fun th -> MESON_TAC[th; LE_CASES; CONG_SYM]) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST1_TAC) THEN SUBST1_TAC(ARITH_RULE `e = e + 0`) THEN REWRITE_TAC[ARITH_RULE `(e + 0) + c = e + c`] THEN REWRITE_TAC[EXP_ADD] THEN ASM_SIMP_TAC[CONG_ADD_LCANCEL_EQ; COPRIME_EXP; ONCE_REWRITE_RULE[COPRIME_SYM] CONG_MULT_LCANCEL_EQ] THEN REWRITE_TAC[EXP; CONG_0_DIVIDES; ORDER_DIVIDES]);; let ORDER_UNIQUE = prove (`!n a k. 0 < k /\ (a EXP k == 1) (mod n) /\ (!m. 0 < m /\ m < k ==> ~(a EXP m == 1) (mod n)) ==> order n a = k`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `order n a`) THEN MP_TAC(ISPECL [`n:num`; `a:num`] ORDER_WORKS) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `order n a = 0` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_ARITH_TAC] THEN FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [ORDER_EQ_0]) THEN MP_TAC(ISPECL [`n:num`; `a:num`; `k:num`] COPRIME_REXP) THEN ASM_SIMP_TAC[LE_1; LT] THEN UNDISCH_TAC `(a EXP k == 1) (mod n)` THEN CONV_TAC NUMBER_RULE);; (* ------------------------------------------------------------------------- *) (* Another trivial primality characterization. *) (* ------------------------------------------------------------------------- *) let PRIME_PRIME_FACTOR = prove (`!n. prime n <=> ~(n = 1) /\ !p. prime p /\ p divides n ==> (p = n)`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [prime] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [MESON_TAC[PRIME_1]; ALL_TAC] THEN STRIP_TAC THEN X_GEN_TAC `d:num` THEN ASM_CASES_TAC `d = 1` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o MATCH_MP PRIME_FACTOR) THEN ASM_MESON_TAC[DIVIDES_TRANS; DIVIDES_ANTISYM]);; let PRIME_DIVISOR_SQRT = prove (`!n. prime(n) <=> ~(n = 1) /\ !d. d divides n /\ d EXP 2 <= n ==> (d = 1)`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [prime] THEN ASM_CASES_TAC `n = 1` THEN ASM_SIMP_TAC[DIVIDES_ONE] THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[DIVIDES_0; LE; EXP_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a <=> b)`) THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `2`) THEN REWRITE_TAC[ARITH]; DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[ARITH]]; ALL_TAC] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `d:num` THEN STRIP_TAC THENL [ASM_CASES_TAC `d = n:num` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN UNDISCH_TAC `d EXP 2 <= n` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXP_2; ARITH_RULE `~(n * n <= n) <=> n * 1 < n * n`] THEN ASM_REWRITE_TAC[LT_MULT_LCANCEL] THEN MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `d divides n` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST_ALL_TAC) THEN SUBGOAL_THEN `d EXP 2 <= d * e \/ e EXP 2 <= d * e` MP_TAC THENL [REWRITE_TAC[EXP_2; LE_MULT_LCANCEL; LE_MULT_RCANCEL] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN DISJ_CASES_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `d:num`); FIRST_X_ASSUM(MP_TAC o SPEC `e:num`)] THEN ASM_SIMP_TAC[DIVIDES_RMUL; DIVIDES_LMUL; DIVIDES_REFL; MULT_CLAUSES]);; let PRIME_PRIME_FACTOR_SQRT = prove (`!n. prime n <=> ~(n = 0) /\ ~(n = 1) /\ ~(?p. prime p /\ p divides n /\ p EXP 2 <= n)`, GEN_TAC THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[PRIME_1] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN GEN_REWRITE_TAC LAND_CONV [PRIME_DIVISOR_SQRT] THEN EQ_TAC THENL [MESON_TAC[PRIME_1]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN ASM_CASES_TAC `d = 1` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_TRANS]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `d EXP 2` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[num_CONV `2`; EXP_MONO_LE_SUC] THEN ASM_MESON_TAC[DIVIDES_LE; DIVIDES_ZERO]);; (* ------------------------------------------------------------------------- *) (* Pocklington theorem. *) (* ------------------------------------------------------------------------- *) let POCKLINGTON_LEMMA = prove (`!a n q r. 2 <= n /\ (n - 1 = q * r) /\ (a EXP (n - 1) == 1) (mod n) /\ (!p. prime(p) /\ p divides q ==> coprime(a EXP ((n - 1) DIV p) - 1,n)) ==> !p. prime p /\ p divides n ==> (p == 1) (mod q)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `order p (a EXP r) = q` ASSUME_TAC THENL [ALL_TAC; SUBGOAL_THEN `coprime(a EXP r,p)` (MP_TAC o MATCH_MP FERMAT_LITTLE) THENL [ALL_TAC; ASM_REWRITE_TAC[ORDER_DIVIDES] THEN SUBGOAL_THEN `phi p = p - 1` SUBST1_TAC THENL [ASM_MESON_TAC[PHI_PRIME_EQ]; ALL_TAC] THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(p - 1 = q * d) ==> ~(p = 0) ==> (p + q * 0 = 1 + q * d)`)) THEN REWRITE_TAC[nat_mod; cong] THEN ASM_MESON_TAC[PRIME_0]] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[coprime; NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `d = p:num` SUBST_ALL_TAC THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN SUBGOAL_THEN `p divides (a EXP (n - 1))` ASSUME_TAC THENL [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `2 <= n ==> (n - 1 = SUC(n - 2))`)) THEN REWRITE_TAC[EXP] THEN ASM_SIMP_TAC[DIVIDES_RMUL]; ALL_TAC] THEN REWRITE_TAC[cong; nat_mod] THEN SUBGOAL_THEN `~(p divides 1)` MP_TAC THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN ASM_MESON_TAC[DIVIDES_RMUL; DIVIDES_ADD; DIVIDES_ADD_REVL]] THEN SUBGOAL_THEN `(order p (a EXP r)) divides q` MP_TAC THENL [REWRITE_TAC[GSYM ORDER_DIVIDES; EXP_EXP] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `b:num` SUBST_ALL_TAC) THEN REWRITE_TAC[cong; nat_mod] THEN MESON_TAC[MULT_AC]; ALL_TAC] THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN ASM_CASES_TAC `d = 1` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `P:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `P divides q` ASSUME_TAC THENL [ASM_MESON_TAC[DIVIDES_LMUL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `P:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN UNDISCH_TAC `P divides q` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `s:num` SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN SUBGOAL_THEN `~(P = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN ASM_SIMP_TAC[DIV_MULT] THEN UNDISCH_TAC `P divides d` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `t:num` SUBST_ALL_TAC) THEN UNDISCH_TAC `order p (a EXP r) * P * t = P * s` THEN ONCE_REWRITE_TAC[ARITH_RULE `(a * p * b = p * c) <=> (p * a * b = p * c)`] THEN REWRITE_TAC[EQ_MULT_LCANCEL] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PRIME_1]] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[AC MULT_AC `(d * t) * r = r * d * t`] THEN REWRITE_TAC[EXP_MULT] THEN MATCH_MP_TAC CONG_1_DIVIDES THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `1 EXP t` THEN SIMP_TAC[CONG_EXP; ORDER] THEN REWRITE_TAC[EXP_ONE; CONG_REFL]);; let POCKLINGTON = prove (`!a n q r. 2 <= n /\ (n - 1 = q * r) /\ n <= q EXP 2 /\ (a EXP (n - 1) == 1) (mod n) /\ (!p. prime(p) /\ p divides q ==> coprime(a EXP ((n - 1) DIV p) - 1,n)) ==> prime(n)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[PRIME_PRIME_FACTOR_SQRT] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 0) /\ ~(n = 1)`] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`a:num`; `n:num`; `q:num`; `r:num`] POCKLINGTON_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `p EXP 2 <= q EXP 2` MP_TAC THENL [ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[num_CONV `2`; EXP_MONO_LE_SUC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_1_DIVIDES) THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Variant for application, to separate the exponentiation. *) (* ------------------------------------------------------------------------- *) let POCKLINGTON_ALT = prove (`!a n q r. 2 <= n /\ (n - 1 = q * r) /\ n <= q EXP 2 /\ (a EXP (n - 1) == 1) (mod n) /\ (!p. prime(p) /\ p divides q ==> ?b. (a EXP ((n - 1) DIV p) == b) (mod n) /\ coprime(b - 1,n)) ==> prime(n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC POCKLINGTON THEN MAP_EVERY EXISTS_TAC [`a:num`; `q:num`; `r:num`] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(a EXP ((q * r) DIV p) - 1 == b - 1) (mod n)` (fun th -> ASM_MESON_TAC[CONG_COPRIME; COPRIME_SYM; th]) THEN MATCH_MP_TAC CONG_SUB THEN ASM_REWRITE_TAC[CONG_REFL] THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; EXP_EQ_0] THEN SUBGOAL_THEN `~(a = 0)` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN SIMP_TAC[ARITH_RULE `2 <= n ==> (n - 1 = SUC(n - 2))`; ASSUME `a = 0`; ASSUME `2 <= n`] THEN REWRITE_TAC[MULT_CLAUSES; EXP] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN REWRITE_TAC[CONG_0_DIVIDES; DIVIDES_ONE] THEN UNDISCH_TAC `2 <= n` THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(a EXP ((q * r) DIV p) == b) (mod n)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CONG_0_DIVIDES] THEN SUBGOAL_THEN `~(n divides (a EXP (n - 1)))` MP_TAC THENL [ASM_MESON_TAC[CONG_DIVIDES; DIVIDES_ONE; ARITH_RULE `~(2 <= 1)`]; ALL_TAC] THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN UNDISCH_TAC `p divides q` THEN GEN_REWRITE_TAC LAND_CONV [divides] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN ASM_SIMP_TAC[DIV_MULT] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EXP_MULT] THEN SUBGOAL_THEN `p = SUC(p - 1)` SUBST1_TAC THENL [UNDISCH_TAC `~(p = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXP; DIVIDES_RMUL]);; (* ------------------------------------------------------------------------- *) (* Prime factorizations. *) (* ------------------------------------------------------------------------- *) let primefact = new_definition `primefact ps n <=> (ITLIST (*) ps 1 = n) /\ !p. MEM p ps ==> prime(p)`;; let PRIMEFACT = prove (`!n. ~(n = 0) ==> ?ps. primefact ps n`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THENL [REPEAT DISCH_TAC THEN EXISTS_TAC `[]:num list` THEN REWRITE_TAC[primefact; ITLIST; MEM]; ALL_TAC] THEN DISCH_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o MATCH_MP PRIME_FACTOR) THEN UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN UNDISCH_TAC `~(p * m = 0)` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [ARITH_RULE `n = 1 * n`] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN SUBGOAL_THEN `1 < p` (fun th -> REWRITE_TAC[th]) THENL [MATCH_MP_TAC(ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 1 < p`) THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `prime p` THEN ASM_REWRITE_TAC[PRIME_0; PRIME_1]; ALL_TAC] THEN REWRITE_TAC[primefact] THEN DISCH_THEN(X_CHOOSE_THEN `ps:num list` ASSUME_TAC) THEN EXISTS_TAC `CONS (p:num) ps` THEN ASM_REWRITE_TAC[MEM; ITLIST] THEN ASM_MESON_TAC[]);; let PRIMAFACT_CONTAINS = prove (`!ps n. primefact ps n ==> !p. prime p /\ p divides n ==> MEM p ps`, REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM(SUBST1_TAC o SYM) THEN SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ITLIST; MEM] THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN STRIP_TAC THEN GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN DISCH_THEN(DISJ_CASES_TAC o MATCH_MP PRIME_DIVPROD) THEN ASM_MESON_TAC[prime; PRIME_1]);; let PRIMEFACT_VARIANT = prove (`!ps n. primefact ps n <=> (ITLIST (*) ps 1 = n) /\ ALL prime ps`, REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN AP_TERM_TAC THEN SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; ALL] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Variant of Lucas theorem. *) (* ------------------------------------------------------------------------- *) let LUCAS_PRIMEFACT = prove (`2 <= n /\ (a EXP (n - 1) == 1) (mod n) /\ (ITLIST (*) ps 1 = n - 1) /\ ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps ==> prime n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LUCAS THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `primefact ps (n - 1)` MP_TAC THENL [ASM_REWRITE_TAC[PRIMEFACT_VARIANT] THEN MATCH_MP_TAC ALL_IMP THEN EXISTS_TAC `\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP PRIMAFACT_CONTAINS) THEN X_GEN_TAC `p:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN UNDISCH_TAC `ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps` THEN SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN SIMP_TAC[ALL; MEM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Variant of Pocklington theorem. *) (* ------------------------------------------------------------------------- *) let POCKLINGTON_PRIMEFACT = prove (`2 <= n /\ (q * r = n - 1) /\ n <= q * q ==> ((a EXP r) MOD n = b) ==> (ITLIST (*) ps 1 = q) ==> ((b EXP q) MOD n = 1) ==> ALL (\p. prime p /\ coprime((b EXP (q DIV p)) MOD n - 1,n)) ps ==> prime n`, DISCH_THEN(fun th -> DISCH_THEN(SUBST1_TAC o SYM) THEN MP_TAC th) THEN SIMP_TAC[MOD_EXP_MOD; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] EXP_EXP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC POCKLINGTON THEN MAP_EVERY EXISTS_TAC [`a:num`; `q:num`; `r:num`] THEN ASM_REWRITE_TAC[EXP_2] THEN CONJ_TAC THENL [MP_TAC(SPECL [`a EXP (n - 1)`; `n:num`] DIVISION) THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN STRIP_TAC THEN ABBREV_TAC `Q = a EXP (n - 1) DIV n` THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[cong; nat_mod] THEN MAP_EVERY EXISTS_TAC [`0`; `Q:num`] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `primefact ps q` MP_TAC THENL [ASM_REWRITE_TAC[PRIMEFACT_VARIANT] THEN MATCH_MP_TAC ALL_IMP THEN EXISTS_TAC `\p. prime p /\ coprime(a EXP (q DIV p * r) MOD n - 1,n)` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP PRIMAFACT_CONTAINS) THEN X_GEN_TAC `p:num` THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM ALL_MEM]) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> a /\ b ==> c`) THEN DISCH_TAC THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN SUBGOAL_THEN `q DIV p * r = (n - 1) DIV p` SUBST1_TAC THENL [UNDISCH_TAC `p divides q` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN UNDISCH_THEN `(p * d) * r = n - 1` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[DIV_MULT; GSYM MULT_ASSOC]; ALL_TAC] THEN MATCH_MP_TAC CONG_COPRIME THEN MATCH_MP_TAC CONG_SUB THEN ASM_SIMP_TAC[CONG_MOD; ARITH_RULE `2 <= n ==> ~(n = 0)`; CONG_REFL] THEN MATCH_MP_TAC(ARITH_RULE `a <= b /\ ~(a = 0) ==> 1 <= a /\ 1 <= b`) THEN ASM_SIMP_TAC[MOD_LE; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN ASM_SIMP_TAC[MOD_EQ_0; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN DISCH_THEN(X_CHOOSE_THEN `s:num` MP_TAC) THEN DISCH_THEN(MP_TAC o C AP_THM `p:num` o AP_TERM `(EXP)`) THEN REWRITE_TAC[EXP_EXP] THEN SUBGOAL_THEN `(n - 1) DIV p * p = n - 1` SUBST1_TAC THENL [SUBST1_TAC(SYM(ASSUME `q * r = n - 1`)) THEN UNDISCH_TAC `p divides q` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN ASM_MESON_TAC[DIV_MULT; MULT_AC; PRIME_0]; ALL_TAC] THEN DISCH_THEN(MP_TAC o C AP_THM `n:num` o AP_TERM `(MOD)`) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(p = 0) ==> (p = SUC(p - 1))`)) THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP; GSYM MULT_ASSOC] THEN ASM_SIMP_TAC[MOD_MULT; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN REWRITE_TAC[ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* Utility functions. *) (* ------------------------------------------------------------------------- *) let even_num n = mod_num n num_2 =/ num_0;; let odd_num = not o even_num;; (* ------------------------------------------------------------------------- *) (* Least p >= 0 with x <= 2^p. *) (* ------------------------------------------------------------------------- *) let log2 = let rec log2 x y = if x log2 (x -/ num_1) num_0;; (* ------------------------------------------------------------------------- *) (* Raise number to power (x^m) modulo n. *) (* ------------------------------------------------------------------------- *) let rec powermod x m n = if m =/ num_0 then num_1 else let y = powermod x (quo_num m num_2) n in let z = mod_num (y */ y) n in if even_num m then z else mod_num (x */ z) n;; (* ------------------------------------------------------------------------- *) (* Make a call to PARI/GP to factor a number into (probable) primes. *) (* ------------------------------------------------------------------------- *) let factor = let suck_file s = let data = string_of_file s in Sys.remove s; data in let extract_output s = let l0 = explode s in let l0' = rev l0 in let l1 = snd(chop_list(index "]" l0') l0') in let l2 = "["::rev(fst(chop_list(index "[" l1) l1)) in let tm = parse_term (implode l2) in map ((dest_numeral F_F dest_numeral) o dest_pair) (dest_list tm) in fun n -> if n =/ num_1 then [] else let filename = Filename.temp_file "pocklington" ".out" in let s = "echo 'print(factorint(" ^ (string_of_num n) ^ ")) \n quit' | gp >" ^ filename ^ " 2>/dev/null" in if Sys.command s = 0 then let output = suck_file filename in extract_output output else failwith "factor: Call to GP/PARI failed";; (* ------------------------------------------------------------------------- *) (* Alternative giving multiset instead of set plus indices. *) (* Also just use a stupid algorithm for small enough numbers or if PARI/GP *) (* is not installed. I should really write a better factoring algorithm. *) (* ------------------------------------------------------------------------- *) let PARI_THRESHOLD = pow2 25;; let multifactor = let rec findfactor m n = if mod_num n m =/ num_0 then m else if m */ m >/ n then n else findfactor (m +/ num_1) n in let rec stupidfactor n = let p = findfactor num_2 n in if p =/ n then [n] else p::(stupidfactor(quo_num n p)) in let rec multilist l = if l = [] then [] else let (x,n) = hd l in replicate x (Num.int_of_num n) @ multilist (tl l) in fun n -> try if n sort ( powermod a k n <>/ num_1) ms then a else find_primitive_root (a +/ num_1) m ms n in let find_primitive_root_from_2 = find_primitive_root num_2 in fun m ms n -> if n raise Unchanged | (h::t) -> if x =/ h then try uniq x t with Unchanged -> l else x::(uniq h t) in fun l -> if l = [] then [] else uniq (hd l) (tl l);; let setify_num s = let s' = sort (<=/) s in try uniq_num s' with Unchanged -> s';; let certify_prime = let rec cert_prime n = if n <=/ num_2 then if n =/ num_2 then Prime_2 else failwith "certify_prime: not a prime!" else let m = n -/ num_1 in let pfact = multifactor m in let primes = setify_num pfact in let ms = map (fun d -> div_num m d) primes in let a = find_primitive_root m ms n in Primroot_and_factors((n,pfact),a,map (fun n -> n,cert_prime n) primes) in fun n -> if length(multifactor n) = 1 then cert_prime n else failwith "certify_prime: input is not a prime";; (* ------------------------------------------------------------------------- *) (* Relatively efficient evaluation of "(a EXP k) MOD n". *) (* ------------------------------------------------------------------------- *) let EXP_MOD_CONV = let pth = prove (`~(n = 0) ==> ((a EXP 0) MOD n = 1 MOD n) /\ ((a EXP (NUMERAL (BIT0 m))) MOD n = let b = (a EXP (NUMERAL m)) MOD n in (b * b) MOD n) /\ ((a EXP (NUMERAL (BIT1 m))) MOD n = let b = (a EXP (NUMERAL m)) MOD n in (a * ((b * b) MOD n)) MOD n)`, DISCH_TAC THEN REWRITE_TAC[EXP] THEN REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN REWRITE_TAC[EXP; EXP_ADD] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN REWRITE_TAC[MULT_ASSOC] THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[MULT_ASSOC] THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD]) and pth_cong = SPEC_ALL CONG and n_tm = `n:num` in fun tm -> let ntm = rand tm in let th1 = INST [ntm,n_tm] pth in let th2 = EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th1)))) in let th_base,th_steps = CONJ_PAIR(MP th1 th2) in let conv_base = GEN_REWRITE_CONV I [th_base] and conv_step = GEN_REWRITE_CONV I [th_steps] in let rec conv tm = try conv_base tm with Failure _ -> (conv_step THENC RAND_CONV conv THENC let_CONV THENC NUM_REDUCE_CONV) tm in conv tm;; (* ------------------------------------------------------------------------- *) (* HOL checking of primality certificate, using Pocklington shortcut. *) (* ------------------------------------------------------------------------- *) let prime_theorem_cache = ref [];; let rec lookup_under_num n l = if l = [] then failwith "lookup_under_num" else let h = hd l in if fst h =/ n then snd h else lookup_under_num n (tl l);; let rec split_factors q qs ps n = if q */ q >=/ n then rev qs,ps else split_factors (q */ hd ps) (hd ps :: qs) (tl ps) n;; let check_certificate = let n_tm = `n:num` and a_tm = `a:num` and q_tm = `q:num` and r_tm = `r:num` and b_tm = `b:num` and ps_tm = `ps:num list` and conv_itlist = GEN_REWRITE_CONV TOP_DEPTH_CONV [ITLIST] THENC NUM_REDUCE_CONV and conv_all = GEN_REWRITE_CONV TOP_DEPTH_CONV [ALL; BETA_THM; TAUT `a /\ T <=> a`] THENC GEN_REWRITE_CONV DEPTH_CONV [TAUT `(a /\ a /\ b <=> a /\ b) /\ (a /\ a <=> a)`] and subarith_conv = let gconv_net = itlist (uncurry net_of_conv) [`a - b`,NUM_SUB_CONV; `a DIV b`,NUM_DIV_CONV; `(a EXP b) MOD c`,EXP_MOD_CONV; `coprime(a,b)`,COPRIME_CONV; `p /\ T`,REWR_CONV(TAUT `p /\ T <=> p`); `T /\ p`,REWR_CONV(TAUT `T /\ p <=> p`)] empty_net in DEPTH_CONV(REWRITES_CONV gconv_net) in let rec check_certificate cert = match cert with Prime_2 -> PRIME_2 | Primroot_and_factors((n,ps),a,ncerts) -> try lookup_under_num n (!prime_theorem_cache) with Failure _ -> let qs,rs = split_factors num_1 [] (rev ps) n in let q = itlist ( */ ) qs num_1 and r = itlist ( */ ) rs num_1 in let th1 = INST [mk_numeral n,n_tm; mk_flist (map mk_numeral qs),ps_tm; mk_numeral q,q_tm; mk_numeral r,r_tm; mk_numeral a,a_tm] POCKLINGTON_PRIMEFACT in let th2 = MP th1 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th1)))) in let tha = EXP_MOD_CONV(lhand(lhand(concl th2))) in let thb = MP (INST [rand(concl tha),b_tm] th2) tha in let th3 = MP thb (EQT_ELIM(conv_itlist (lhand(concl thb)))) in let th4 = MP th3 (EXP_MOD_CONV (lhand(lhand(concl th3)))) in let th5 = conv_all(lhand(concl th4)) in let th6 = TRANS th5 (subarith_conv(rand(concl th5))) in let th7 = IMP_TRANS (snd(EQ_IMP_RULE th6)) th4 in let ants = conjuncts(lhand(concl th7)) in let certs = map (fun t -> lookup_under_num (dest_numeral(rand t)) ncerts) ants in let ths = map check_certificate certs in let fth = MP th7 (end_itlist CONJ ths) in prime_theorem_cache := (n,fth)::(!prime_theorem_cache); fth in check_certificate;; (* ------------------------------------------------------------------------- *) (* Hence a primality-proving rule. *) (* ------------------------------------------------------------------------- *) let PROVE_PRIME = check_certificate o certify_prime;; (* ------------------------------------------------------------------------- *) (* Rule to generate prime factorization theorems. *) (* ------------------------------------------------------------------------- *) let PROVE_PRIMEFACT = let pth = SPEC_ALL PRIMEFACT_VARIANT and start_CONV = PURE_REWRITE_CONV[ITLIST; ALL] THENC NUM_REDUCE_CONV and ps_tm = `ps:num list` and n_tm = `n:num` in fun n -> let pfact = multifactor n in let th1 = INST [mk_flist(map mk_numeral pfact),ps_tm; mk_numeral n,n_tm] pth in let th2 = TRANS th1 (start_CONV(rand(concl th1))) in let ths = map PROVE_PRIME pfact in EQ_MP (SYM th2) (end_itlist CONJ ths);; (* ------------------------------------------------------------------------- *) (* Conversion for truth or falsity of primality assertion. *) (* ------------------------------------------------------------------------- *) let PRIME_TEST = let NOT_PRIME_THM = prove (`((m = 1) <=> F) ==> ((m = p) <=> F) ==> (m * n = p) ==> (prime(p) <=> F)`, MESON_TAC[prime; divides]) and m_tm = `m:num` and n_tm = `n:num` and p_tm = `p:num` in fun tm -> let p = dest_numeral tm in if p =/ num_0 then EQF_INTRO PRIME_0 else if p =/ num_1 then EQF_INTRO PRIME_1 else let pfact = multifactor p in if length pfact = 1 then (remark ("proving that " ^ string_of_num p ^ " is prime"); EQT_INTRO(PROVE_PRIME p)) else (remark ("proving that " ^ string_of_num p ^ " is composite"); let m = hd pfact and n = end_itlist ( */ ) (tl pfact) in let th0 = INST [mk_numeral m,m_tm; mk_numeral n,n_tm; mk_numeral p,p_tm] NOT_PRIME_THM in let th1 = MP th0 (NUM_EQ_CONV (lhand(lhand(concl th0)))) in let th2 = MP th1 (NUM_EQ_CONV (lhand(lhand(concl th1)))) in MP th2 (NUM_MULT_CONV(lhand(lhand(concl th2)))));; let PRIME_CONV = let prime_tm = `prime` in fun tm0 -> let ptm,tm = dest_comb tm0 in if ptm <> prime_tm then failwith "expected term of form prime(n)" else PRIME_TEST tm;; (* ------------------------------------------------------------------------- *) (* Another lemma. *) (* ------------------------------------------------------------------------- *) let PRIME_POWER_EXISTS = prove (`!q. prime q ==> ((?i. n = q EXP i) <=> (!p. prime p /\ p divides n ==> p = q))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[IMP_CONJ; PRIME_DIVEXP_EQ; DIVIDES_PRIME_PRIME] THEN ASM_CASES_TAC `n = 0` THENL [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `2` th) THEN MP_TAC(SPEC `3` th)) THEN ASM_REWRITE_TAC[PRIME_2; PRIME_CONV `prime 3`; DIVIDES_0] THEN ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `n = 1` THENL [EXISTS_TAC `0` THEN ASM_REWRITE_TAC[EXP]; ALL_TAC] THEN MP_TAC(ISPEC `n:num` PRIMEPOW_FACTOR) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN ASM_CASES_TAC `p:num = q` THENL [FIRST_X_ASSUM(SUBST_ALL_TAC o SYM); ASM_MESON_TAC[DIVIDES_REXP; LE_1; DIVIDES_RMUL; DIVIDES_REFL]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(NUM_RING `m = 1 ==> x * m = x`) THEN MATCH_MP_TAC(ARITH_RULE `~(m = 0) /\ ~(2 <= m) ==> m = 1`) THEN CONJ_TAC THENL [ASM_MESON_TAC[COPRIME_0; PRIME_1]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP PRIMEPOW_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `r:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:num`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REXP; LE_1; DIVIDES_REFL]; DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_RMUL]) THEN ASM_SIMP_TAC[COPRIME_REXP; LE_1; COPRIME_REFL] THEN ASM_MESON_TAC[PRIME_1]]);; (* ------------------------------------------------------------------------- *) (* Example. *) (* ------------------------------------------------------------------------- *) map (time PRIME_TEST o mk_small_numeral) (0--50);; time PRIME_TEST `65535`;; time PRIME_TEST `65536`;; time PRIME_TEST `65537`;; time PROVE_PRIMEFACT (Int 222);; time PROVE_PRIMEFACT (Int 151);; (* ------------------------------------------------------------------------- *) (* The "Landau trick" in Erdos's proof of Chebyshev-Bertrand theorem. *) (* ------------------------------------------------------------------------- *) map (time PRIME_TEST o mk_small_numeral) [3; 5; 7; 13; 23; 43; 83; 163; 317; 631; 1259; 2503; 4001];; hol-light/Library/poly.ml000066400000000000000000002170011303454263000156670ustar00rootroot00000000000000(* ========================================================================= *) (* Properties of real polynomials (not canonically represented). *) (* ========================================================================= *) needs "Library/analysis.ml";; prioritize_real();; parse_as_infix("++",(16,"right"));; parse_as_infix("**",(20,"right"));; parse_as_infix("##",(20,"right"));; parse_as_infix("divides",(14,"right"));; parse_as_infix("exp",(22,"right"));; do_list override_interface ["++",`poly_add:real list->real list->real list`; "**",`poly_mul:real list->real list->real list`; "##",`poly_cmul:real->real list->real list`; "neg",`poly_neg:real list->real list`; "exp",`poly_exp:real list -> num -> real list`; "diff",`poly_diff:real list->real list`];; overload_interface ("divides",`poly_divides:real list->real list->bool`);; (* ------------------------------------------------------------------------- *) (* Application of polynomial as a real function. *) (* ------------------------------------------------------------------------- *) let poly = new_recursive_definition list_RECURSION `(poly [] x = &0) /\ (poly (CONS h t) x = h + x * poly t x)`;; let POLY_CONST = prove (`!c x. poly [c] x = c`, REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; let POLY_X = prove (`!c x. poly [&0; &1] x = x`, REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Arithmetic operations on polynomials. *) (* ------------------------------------------------------------------------- *) let poly_add = new_recursive_definition list_RECURSION `([] ++ l2 = l2) /\ ((CONS h t) ++ l2 = (if l2 = [] then CONS h t else CONS (h + HD l2) (t ++ TL l2)))`;; let poly_cmul = new_recursive_definition list_RECURSION `(c ## [] = []) /\ (c ## (CONS h t) = CONS (c * h) (c ## t))`;; let poly_neg = new_definition `neg = (##) (--(&1))`;; let poly_mul = new_recursive_definition list_RECURSION `([] ** l2 = []) /\ ((CONS h t) ** l2 = (if t = [] then h ## l2 else (h ## l2) ++ CONS (&0) (t ** l2)))`;; let poly_exp = new_recursive_definition num_RECURSION `(p exp 0 = [&1]) /\ (p exp (SUC n) = p ** p exp n)`;; (* ------------------------------------------------------------------------- *) (* Differentiation of polynomials (needs an auxiliary function). *) (* ------------------------------------------------------------------------- *) let poly_diff_aux = new_recursive_definition list_RECURSION `(poly_diff_aux n [] = []) /\ (poly_diff_aux n (CONS h t) = CONS (&n * h) (poly_diff_aux (SUC n) t))`;; let poly_diff = new_definition `diff l = (if l = [] then [] else (poly_diff_aux 1 (TL l)))`;; (* ------------------------------------------------------------------------- *) (* Lengths. *) (* ------------------------------------------------------------------------- *) let LENGTH_POLY_DIFF_AUX = prove (`!l n. LENGTH(poly_diff_aux n l) = LENGTH l`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH; poly_diff_aux]);; let LENGTH_POLY_DIFF = prove (`!l. LENGTH(poly_diff l) = PRE(LENGTH l)`, LIST_INDUCT_TAC THEN SIMP_TAC[poly_diff; LENGTH; LENGTH_POLY_DIFF_AUX; NOT_CONS_NIL; TL; PRE]);; (* ------------------------------------------------------------------------- *) (* Useful clausifications. *) (* ------------------------------------------------------------------------- *) let POLY_ADD_CLAUSES = prove (`([] ++ p2 = p2) /\ (p1 ++ [] = p1) /\ ((CONS h1 t1) ++ (CONS h2 t2) = CONS (h1 + h2) (t1 ++ t2))`, REWRITE_TAC[poly_add; NOT_CONS_NIL; HD; TL] THEN SPEC_TAC(`p1:real list`,`p1:real list`) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly_add]);; let POLY_CMUL_CLAUSES = prove (`(c ## [] = []) /\ (c ## (CONS h t) = CONS (c * h) (c ## t))`, REWRITE_TAC[poly_cmul]);; let POLY_NEG_CLAUSES = prove (`(neg [] = []) /\ (neg (CONS h t) = CONS (--h) (neg t))`, REWRITE_TAC[poly_neg; POLY_CMUL_CLAUSES; REAL_MUL_LNEG; REAL_MUL_LID]);; let POLY_MUL_CLAUSES = prove (`([] ** p2 = []) /\ ([h1] ** p2 = h1 ## p2) /\ ((CONS h1 (CONS k1 t1)) ** p2 = h1 ## p2 ++ CONS (&0) (CONS k1 t1 ** p2))`, REWRITE_TAC[poly_mul; NOT_CONS_NIL]);; let POLY_DIFF_CLAUSES = prove (`(diff [] = []) /\ (diff [c] = []) /\ (diff (CONS h t) = poly_diff_aux 1 t)`, REWRITE_TAC[poly_diff; NOT_CONS_NIL; HD; TL; poly_diff_aux]);; (* ------------------------------------------------------------------------- *) (* Various natural consequences of syntactic definitions. *) (* ------------------------------------------------------------------------- *) let POLY_ADD = prove (`!p1 p2 x. poly (p1 ++ p2) x = poly p1 x + poly p2 x`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly_add; poly; REAL_ADD_LID] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL; HD; TL; poly; REAL_ADD_RID] THEN REAL_ARITH_TAC);; let POLY_CMUL = prove (`!p c x. poly (c ## p) x = c * poly p x`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly; poly_cmul] THEN REAL_ARITH_TAC);; let POLY_NEG = prove (`!p x. poly (neg p) x = --(poly p x)`, REWRITE_TAC[poly_neg; POLY_CMUL] THEN REAL_ARITH_TAC);; let POLY_MUL = prove (`!x p1 p2. poly (p1 ** p2) x = poly p1 x * poly p2 x`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly_mul; poly; REAL_MUL_LZERO; POLY_CMUL; POLY_ADD] THEN SPEC_TAC(`h:real`,`h:real`) THEN SPEC_TAC(`t:real list`,`t:real list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly_mul; POLY_CMUL; POLY_ADD; poly; POLY_CMUL; REAL_MUL_RZERO; REAL_ADD_RID; NOT_CONS_NIL] THEN ASM_REWRITE_TAC[POLY_ADD; POLY_CMUL; poly] THEN REAL_ARITH_TAC);; let POLY_EXP = prove (`!p n x. poly (p exp n) x = (poly p x) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; real_pow; POLY_MUL] THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The derivative is a bit more complicated. *) (* ------------------------------------------------------------------------- *) let POLY_DIFF_LEMMA = prove (`!l n x. ((\x. (x pow (SUC n)) * poly l x) diffl ((x pow n) * poly (poly_diff_aux (SUC n) l) x))(x)`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly; poly_diff_aux; REAL_MUL_RZERO; DIFF_CONST] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN REWRITE_TAC[REAL_LDISTRIB; REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 pow))] THEN POP_ASSUM(MP_TAC o SPECL [`SUC n`; `x:real`]) THEN SUBGOAL_THEN `(((\x. (x pow (SUC n)) * h)) diffl ((x pow n) * &(SUC n) * h))(x)` (fun th -> DISCH_THEN(MP_TAC o CONJ th)) THENL [REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MP_TAC(SPEC `\x. x pow (SUC n)` DIFF_CMUL) THEN BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN MP_TAC(SPEC `SUC n` DIFF_POW) THEN REWRITE_TAC[SUC_SUB1] THEN DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[REAL_MUL_SYM]); DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC]]);; let POLY_DIFF = prove (`!l x. ((\x. poly l x) diffl (poly (diff l) x))(x)`, LIST_INDUCT_TAC THEN REWRITE_TAC[POLY_DIFF_CLAUSES] THEN ONCE_REWRITE_TAC[SYM(ETA_CONV `\x. poly l x`)] THEN REWRITE_TAC[poly; DIFF_CONST] THEN MAP_EVERY X_GEN_TAC [`x:real`] THEN MP_TAC(SPECL [`t:(real)list`; `0`; `x:real`] POLY_DIFF_LEMMA) THEN REWRITE_TAC[SYM(num_CONV `1`)] THEN REWRITE_TAC[pow; REAL_MUL_LID] THEN REWRITE_TAC[POW_1] THEN DISCH_THEN(MP_TAC o CONJ (SPECL [`h:real`; `x:real`] DIFF_CONST)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID]);; (* ------------------------------------------------------------------------- *) (* Trivial consequences. *) (* ------------------------------------------------------------------------- *) let POLY_DIFFERENTIABLE = prove (`!l x. (\x. poly l x) differentiable x`, REPEAT GEN_TAC THEN REWRITE_TAC[differentiable] THEN EXISTS_TAC `poly (diff l) x` THEN REWRITE_TAC[POLY_DIFF]);; let POLY_CONT = prove (`!l x. (\x. poly l x) contl x`, REPEAT GEN_TAC THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `poly (diff l) x` THEN MATCH_ACCEPT_TAC POLY_DIFF);; let POLY_IVT_POS = prove (`!p a b. a < b /\ poly p a < &0 /\ poly p b > &0 ==> ?x. a < x /\ x < b /\ (poly p x = &0)`, REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. poly p x`; `a:real`; `b:real`; `&0`] IVT) THEN REWRITE_TAC[POLY_CONT] THEN EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE th]) THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_REFL]) THEN FIRST_ASSUM CONTR_TAC);; let POLY_IVT_NEG = prove (`!p a b. a < b /\ poly p a > &0 /\ poly p b < &0 ==> ?x. a < x /\ x < b /\ (poly p x = &0)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `poly_neg p` POLY_IVT_POS) THEN REWRITE_TAC[POLY_NEG; REAL_ARITH `(--x < &0 <=> x > &0) /\ (--x > &0 <=> x < &0)`] THEN DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN ASM_REWRITE_TAC[REAL_ARITH `(--x = &0) <=> (x = &0)`]);; let POLY_MVT = prove (`!p a b. a < b ==> ?x. a < x /\ x < b /\ (poly p b - poly p a = (b - a) * poly (diff p) x)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`poly p`; `a:real`; `b:real`] MVT) THEN ASM_REWRITE_TAC[CONV_RULE(DEPTH_CONV ETA_CONV) (SPEC_ALL POLY_CONT); CONV_RULE(DEPTH_CONV ETA_CONV) (SPEC_ALL POLY_DIFFERENTIABLE)] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `poly p` THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[CONV_RULE(DEPTH_CONV ETA_CONV) (SPEC_ALL POLY_DIFF)]);; let POLY_MVT_ADD = prove (`!p a x. ?y. abs(y) <= abs(x) /\ (poly p (a + x) = poly p a + x * poly (diff p) (a + y))`, REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THENL [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_RID; REAL_MUL_LZERO]; MP_TAC(SPECL [`p:real list`; `a:real`; `a + x`] POLY_MVT) THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN REWRITE_TAC[REAL_ARITH `(x - y = ((a + b) - a) * z) <=> (x = y + b * z)`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN EXISTS_TAC `z - a` THEN REWRITE_TAC[REAL_ARITH `x + (y - x) = y`] THEN MAP_EVERY UNDISCH_TAC [`&0 < x`; `a < z`; `z < a + x`] THEN REAL_ARITH_TAC; MP_TAC(SPECL [`p:real list`; `a + x`; `a:real`] POLY_MVT) THEN ASM_REWRITE_TAC[REAL_ARITH `a + x < a <=> &0 < --x`] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN REWRITE_TAC[REAL_ARITH `(x - y = (a - (a + b)) * z) <=> (x = y + b * --z)`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN EXISTS_TAC `z - a` THEN REWRITE_TAC[REAL_ARITH `x + (y - x) = y`] THEN MAP_EVERY UNDISCH_TAC [`&0 < --x`; `a + x < z`; `z < a`] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Lemmas. *) (* ------------------------------------------------------------------------- *) let POLY_ADD_RZERO = prove (`!p. poly (p ++ []) = poly p`, REWRITE_TAC[FUN_EQ_THM; POLY_ADD; poly; REAL_ADD_RID]);; let POLY_MUL_ASSOC = prove (`!p q r. poly (p ** (q ** r)) = poly ((p ** q) ** r)`, REWRITE_TAC[FUN_EQ_THM; POLY_MUL; REAL_MUL_ASSOC]);; let POLY_EXP_ADD = prove (`!d n p. poly(p exp (n + d)) = poly(p exp n ** p exp d)`, REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_MUL; ADD_CLAUSES; poly_exp; poly] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Lemmas for derivatives. *) (* ------------------------------------------------------------------------- *) let POLY_DIFF_AUX_ADD = prove (`!p1 p2 n. poly (poly_diff_aux n (p1 ++ p2)) = poly (poly_diff_aux n p1 ++ poly_diff_aux n p2)`, REPEAT(LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff_aux; poly_add]) THEN ASM_REWRITE_TAC[poly_diff_aux; FUN_EQ_THM; poly; NOT_CONS_NIL; HD; TL] THEN REAL_ARITH_TAC);; let POLY_DIFF_AUX_CMUL = prove (`!p c n. poly (poly_diff_aux n (c ## p)) = poly (c ## poly_diff_aux n p)`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FUN_EQ_THM; poly; poly_diff_aux; poly_cmul; REAL_MUL_AC]);; let POLY_DIFF_AUX_NEG = prove (`!p n. poly (poly_diff_aux n (neg p)) = poly (neg (poly_diff_aux n p))`, REWRITE_TAC[poly_neg; POLY_DIFF_AUX_CMUL]);; let POLY_DIFF_AUX_MUL_LEMMA = prove (`!p n. poly (poly_diff_aux (SUC n) p) = poly (poly_diff_aux n p ++ p)`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff_aux; poly_add; NOT_CONS_NIL] THEN ASM_REWRITE_TAC[HD; TL; poly; FUN_EQ_THM] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Final results for derivatives. *) (* ------------------------------------------------------------------------- *) let POLY_DIFF_ADD = prove (`!p1 p2. poly (diff (p1 ++ p2)) = poly (diff p1 ++ diff p2)`, REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[poly_add; poly_diff; NOT_CONS_NIL; POLY_ADD_RZERO] THEN ASM_REWRITE_TAC[HD; TL; POLY_DIFF_AUX_ADD]);; let POLY_DIFF_CMUL = prove (`!p c. poly (diff (c ## p)) = poly (c ## diff p)`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff; poly_cmul] THEN REWRITE_TAC[NOT_CONS_NIL; HD; TL; POLY_DIFF_AUX_CMUL]);; let POLY_DIFF_NEG = prove (`!p. poly (diff (neg p)) = poly (neg (diff p))`, REWRITE_TAC[poly_neg; POLY_DIFF_CMUL]);; let POLY_DIFF_MUL_LEMMA = prove (`!t h. poly (diff (CONS h t)) = poly (CONS (&0) (diff t) ++ t)`, REWRITE_TAC[poly_diff; NOT_CONS_NIL] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff_aux; NOT_CONS_NIL; HD; TL] THENL [REWRITE_TAC[FUN_EQ_THM; poly; poly_add; REAL_MUL_RZERO; REAL_ADD_LID]; REWRITE_TAC[FUN_EQ_THM; poly; POLY_DIFF_AUX_MUL_LEMMA; POLY_ADD] THEN REAL_ARITH_TAC]);; let POLY_DIFF_MUL = prove (`!p1 p2. poly (diff (p1 ** p2)) = poly (p1 ** diff p2 ++ diff p1 ** p2)`, LIST_INDUCT_TAC THEN REWRITE_TAC[poly_mul] THENL [REWRITE_TAC[poly_diff; poly_add; poly_mul]; ALL_TAC] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[POLY_DIFF_CLAUSES] THEN REWRITE_TAC[poly_add; poly_mul; POLY_ADD_RZERO; POLY_DIFF_CMUL]; ALL_TAC] THEN REWRITE_TAC[FUN_EQ_THM; POLY_DIFF_ADD; POLY_ADD] THEN REWRITE_TAC[poly; POLY_ADD; POLY_DIFF_MUL_LEMMA; POLY_MUL] THEN ASM_REWRITE_TAC[POLY_DIFF_CMUL; POLY_ADD; POLY_MUL] THEN REAL_ARITH_TAC);; let POLY_DIFF_EXP = prove (`!p n. poly (diff (p exp (SUC n))) = poly ((&(SUC n) ## (p exp n)) ** diff p)`, GEN_TAC THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[poly_exp] THENL [REWRITE_TAC[poly_exp; POLY_DIFF_MUL] THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD; POLY_CMUL] THEN REWRITE_TAC[poly; POLY_DIFF_CLAUSES; ADD1; ADD_CLAUSES] THEN REAL_ARITH_TAC; REWRITE_TAC[POLY_DIFF_MUL] THEN ASM_REWRITE_TAC[POLY_MUL; POLY_ADD; FUN_EQ_THM; POLY_CMUL] THEN REWRITE_TAC[poly_exp; POLY_MUL] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC]);; let POLY_DIFF_EXP_PRIME = prove (`!n a. poly (diff ([--a; &1] exp (SUC n))) = poly (&(SUC n) ## ([--a; &1] exp n))`, REPEAT GEN_TAC THEN REWRITE_TAC[POLY_DIFF_EXP] THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN REWRITE_TAC[poly_diff; poly_diff_aux; TL; NOT_CONS_NIL] THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Key property that f(a) = 0 ==> (x - a) divides p(x). Very delicate! *) (* ------------------------------------------------------------------------- *) let POLY_LINEAR_REM = prove (`!t h. ?q r. CONS h t = [r] ++ [--a; &1] ** q`, LIST_INDUCT_TAC THEN REWRITE_TAC[] THENL [GEN_TAC THEN EXISTS_TAC `[]:real list` THEN EXISTS_TAC `h:real` THEN REWRITE_TAC[poly_add; poly_mul; poly_cmul; NOT_CONS_NIL] THEN REWRITE_TAC[HD; TL; REAL_ADD_RID]; X_GEN_TAC `k:real` THEN POP_ASSUM(STRIP_ASSUME_TAC o SPEC `h:real`) THEN EXISTS_TAC `CONS (r:real) q` THEN EXISTS_TAC `r * a + k` THEN ASM_REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN REWRITE_TAC[CONS_11] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`q:real list`,`q:real list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN REWRITE_TAC[REAL_ADD_RID; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ADD_AC]]);; let POLY_LINEAR_DIVIDES = prove (`!a p. (poly p a = &0) <=> (p = []) \/ ?q. p = [--a; &1] ** q`, GEN_TAC THEN LIST_INDUCT_TAC THENL [REWRITE_TAC[poly]; ALL_TAC] THEN EQ_TAC THEN STRIP_TAC THENL [DISJ2_TAC THEN STRIP_ASSUME_TAC(SPEC_ALL POLY_LINEAR_REM) THEN EXISTS_TAC `q:real list` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `r = &0` SUBST_ALL_TAC THENL [UNDISCH_TAC `poly (CONS h t) a = &0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[POLY_ADD; POLY_MUL] THEN REWRITE_TAC[poly; REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `--a + a = &0`] THEN REAL_ARITH_TAC; REWRITE_TAC[poly_mul] THEN REWRITE_TAC[NOT_CONS_NIL] THEN SPEC_TAC(`q:real list`,`q:real list`) THEN LIST_INDUCT_TAC THENL [REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; HD; TL; REAL_ADD_LID]; REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; HD; TL; REAL_ADD_LID]]]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly] THEN REWRITE_TAC[POLY_MUL] THEN REWRITE_TAC[poly] THEN REWRITE_TAC[poly; REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `--a + a = &0`] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Thanks to the finesse of the above, we can use length rather than degree. *) (* ------------------------------------------------------------------------- *) let POLY_LENGTH_MUL = prove (`!q. LENGTH([--a; &1] ** q) = SUC(LENGTH q)`, let lemma = prove (`!p h k a. LENGTH (k ## p ++ CONS h (a ## p)) = SUC(LENGTH p)`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly_cmul; POLY_ADD_CLAUSES; LENGTH]) in REWRITE_TAC[poly_mul; NOT_CONS_NIL; lemma]);; (* ------------------------------------------------------------------------- *) (* Thus a nontrivial polynomial of degree n has no more than n roots. *) (* ------------------------------------------------------------------------- *) let POLY_ROOTS_INDEX_LEMMA = prove (`!n. !p. ~(poly p = poly []) /\ (LENGTH p = n) ==> ?i. !x. (poly p (x) = &0) ==> ?m. m <= n /\ (x = i m)`, INDUCT_TAC THENL [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a. poly p a = &0` THENL [UNDISCH_TAC `?a. poly p a = &0` THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real list` SUBST_ALL_TAC) THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN UNDISCH_TAC `~(poly ([-- a; &1] ** q) = poly [])` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[POLY_LENGTH_MUL; SUC_INJ] THEN DISCH_TAC THEN ASM_CASES_TAC `poly q = poly []` THENL [ASM_REWRITE_TAC[POLY_MUL; poly; REAL_MUL_RZERO; FUN_EQ_THM]; DISCH_THEN(K ALL_TAC)] THEN DISCH_THEN(MP_TAC o SPEC `q:real list`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `i:num->real`) THEN EXISTS_TAC `\m. if m = SUC n then (a:real) else i m` THEN REWRITE_TAC[POLY_MUL; LE; REAL_ENTIRE] THEN X_GEN_TAC `x:real` THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_THEN(fun th -> EXISTS_TAC `SUC n` THEN MP_TAC th) THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC; DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `m:num <= n` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC]; UNDISCH_TAC `~(?a. poly p a = &0)` THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);; let POLY_ROOTS_INDEX_LENGTH = prove (`!p. ~(poly p = poly []) ==> ?i. !x. (poly p(x) = &0) ==> ?n. n <= LENGTH p /\ (x = i n)`, MESON_TAC[POLY_ROOTS_INDEX_LEMMA]);; let POLY_ROOTS_FINITE_LEMMA = prove (`!p. ~(poly p = poly []) ==> ?N i. !x. (poly p(x) = &0) ==> ?n:num. n < N /\ (x = i n)`, MESON_TAC[POLY_ROOTS_INDEX_LENGTH; LT_SUC_LE]);; let FINITE_LEMMA = prove (`!i N P. (!x. P x ==> ?n:num. n < N /\ (x = i n)) ==> ?a. !x. P x ==> x < a`, GEN_TAC THEN ONCE_REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN INDUCT_TAC THENL [REWRITE_TAC[LT] THEN MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `P:real->bool` THEN POP_ASSUM(MP_TAC o SPEC `\z. P z /\ ~(z = (i:num->real) N)`) THEN DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN EXISTS_TAC `abs(a) + abs(i(N:num)) + &1` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[LT] THEN MP_TAC(REAL_ARITH `!x v. x < abs(v) + abs(x) + &1`) THEN MP_TAC(REAL_ARITH `!u v x. x < v ==> x < abs(v) + abs(u) + &1`) THEN MESON_TAC[]);; let POLY_ROOTS_FINITE = prove (`!p. ~(poly p = poly []) <=> ?N i. !x. (poly p(x) = &0) ==> ?n:num. n < N /\ (x = i n)`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE_LEMMA] THEN REWRITE_TAC[FUN_EQ_THM; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM; poly] THEN MP_TAC(GENL [`i:num->real`; `N:num`] (SPECL [`i:num->real`; `N:num`; `\x. poly p x = &0`] FINITE_LEMMA)) THEN REWRITE_TAC[] THEN MESON_TAC[REAL_LT_REFL]);; (* ------------------------------------------------------------------------- *) (* Hence get entirety and cancellation for polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_ENTIRE_LEMMA = prove (`!p q. ~(poly p = poly []) /\ ~(poly q = poly []) ==> ~(poly (p ** q) = poly [])`, REPEAT GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (X_CHOOSE_TAC `i2:num->real`)) THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (X_CHOOSE_TAC `i1:num->real`)) THEN EXISTS_TAC `N1 + N2:num` THEN EXISTS_TAC `\n:num. if n < N1 then i1(n):real else i2(n - N1)` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_ENTIRE; POLY_MUL] THEN DISCH_THEN(DISJ_CASES_THEN (ANTE_RES_THEN (X_CHOOSE_TAC `n:num`))) THENL [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN ARITH_TAC; EXISTS_TAC `N1 + n:num` THEN ASM_REWRITE_TAC[LT_ADD_LCANCEL] THEN REWRITE_TAC[ARITH_RULE `~(m + n < m:num)`] THEN AP_TERM_TAC THEN ARITH_TAC]);; let POLY_ENTIRE = prove (`!p q. (poly (p ** q) = poly []) <=> (poly p = poly []) \/ (poly q = poly [])`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[POLY_ENTIRE_LEMMA]; REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_LZERO; poly]]);; let POLY_MUL_LCANCEL = prove (`!p q r. (poly (p ** q) = poly (p ** r)) <=> (poly p = poly []) \/ (poly q = poly r)`, let lemma1 = prove (`!p q. (poly (p ++ neg q) = poly []) <=> (poly p = poly q)`, REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; poly] THEN REWRITE_TAC[REAL_ARITH `(p + --q = &0) <=> (p = q)`]) in let lemma2 = prove (`!p q r. poly (p ** q ++ neg(p ** r)) = poly (p ** (q ++ neg(r)))`, REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; POLY_MUL] THEN REAL_ARITH_TAC) in ONCE_REWRITE_TAC[GSYM lemma1] THEN REWRITE_TAC[lemma2; POLY_ENTIRE] THEN REWRITE_TAC[lemma1]);; let POLY_EXP_EQ_0 = prove (`!p n. (poly (p exp n) = poly []) <=> (poly p = poly []) /\ ~(n = 0)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN REWRITE_TAC[LEFT_AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[poly_exp; poly; REAL_MUL_RZERO; REAL_ADD_RID; REAL_OF_NUM_EQ; ARITH; NOT_SUC] THEN ASM_REWRITE_TAC[POLY_MUL; poly; REAL_ENTIRE] THEN CONV_TAC TAUT);; let POLY_PRIME_EQ_0 = prove (`!a. ~(poly [a ; &1] = poly [])`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN DISCH_THEN(MP_TAC o SPEC `&1 - a`) THEN REAL_ARITH_TAC);; let POLY_EXP_PRIME_EQ_0 = prove (`!a n. ~(poly ([a ; &1] exp n) = poly [])`, MESON_TAC[POLY_EXP_EQ_0; POLY_PRIME_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Can also prove a more "constructive" notion of polynomial being trivial. *) (* ------------------------------------------------------------------------- *) let POLY_ZERO_LEMMA = prove (`!h t. (poly (CONS h t) = poly []) ==> (h = &0) /\ (poly t = poly [])`, let lemma = REWRITE_RULE[FUN_EQ_THM; poly] POLY_ROOTS_FINITE in REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN ASM_CASES_TAC `h = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[REAL_ADD_LID]; DISCH_THEN(MP_TAC o SPEC `&0`) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(MP_TAC o REWRITE_RULE[lemma]) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (X_CHOOSE_TAC `i:num->real`)) THEN MP_TAC(SPECL [`i:num->real`; `N:num`; `\x. poly t x = &0`] FINITE_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN DISCH_THEN(MP_TAC o SPEC `abs(a) + &1`) THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(MP_TAC o MATCH_MP (ASSUME `!x. (poly t x = &0) ==> x < a`)) THEN REAL_ARITH_TAC]);; let POLY_ZERO = prove (`!p. (poly p = poly []) <=> ALL (\c. c = &0) p`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN ASM_REWRITE_TAC[]; POP_ASSUM(SUBST1_TAC o SYM) THEN STRIP_TAC THEN ASM_REWRITE_TAC[FUN_EQ_THM; poly] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Useful triviality. *) (* ------------------------------------------------------------------------- *) let POLY_DIFF_AUX_ISZERO = prove (`!p n. ALL (\c. c = &0) (poly_diff_aux (SUC n) p) <=> ALL (\c. c = &0) p`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [ALL; poly_diff_aux; REAL_ENTIRE; REAL_OF_NUM_EQ; NOT_SUC]);; let POLY_DIFF_ISZERO = prove (`!p. (poly (diff p) = poly []) ==> ?h. poly p = poly [h]`, REWRITE_TAC[POLY_ZERO] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_DIFF_CLAUSES; ALL] THENL [EXISTS_TAC `&0` THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN REAL_ARITH_TAC; REWRITE_TAC[num_CONV `1`; POLY_DIFF_AUX_ISZERO] THEN REWRITE_TAC[GSYM POLY_ZERO] THEN DISCH_TAC THEN EXISTS_TAC `h:real` THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM]]);; let POLY_DIFF_ZERO = prove (`!p. (poly p = poly []) ==> (poly (diff p) = poly [])`, REWRITE_TAC[POLY_ZERO] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff; NOT_CONS_NIL] THEN REWRITE_TAC[ALL; TL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SPEC_TAC(`1`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`t:real list`,`t:real list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; poly_diff_aux] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let POLY_DIFF_WELLDEF = prove (`!p q. (poly p = poly q) ==> (poly (diff p) = poly (diff q))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `p ++ neg(q)` POLY_DIFF_ZERO) THEN REWRITE_TAC[FUN_EQ_THM; POLY_DIFF_ADD; POLY_DIFF_NEG; POLY_ADD] THEN ASM_REWRITE_TAC[POLY_NEG; poly; REAL_ARITH `a + --a = &0`] THEN REWRITE_TAC[REAL_ARITH `(a + --b = &0) <=> (a = b)`]);; (* ------------------------------------------------------------------------- *) (* Basics of divisibility. *) (* ------------------------------------------------------------------------- *) let divides = new_definition `p1 divides p2 <=> ?q. poly p2 = poly (p1 ** q)`;; let POLY_PRIMES = prove (`!a p q. [a; &1] divides (p ** q) <=> [a; &1] divides p \/ [a; &1] divides q`, REPEAT GEN_TAC THEN REWRITE_TAC[divides; POLY_MUL; FUN_EQ_THM; poly] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `r:real list` (MP_TAC o SPEC `--a`)) THEN REWRITE_TAC[REAL_ENTIRE; GSYM real_sub; REAL_SUB_REFL; REAL_MUL_LZERO] THEN DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN (POP_ASSUM(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN `s:real list` SUBST_ALL_TAC)) THENL [EXISTS_TAC `[]:real list` THEN REWRITE_TAC[poly; REAL_MUL_RZERO]; EXISTS_TAC `s:real list` THEN GEN_TAC THEN REWRITE_TAC[POLY_MUL; poly] THEN REAL_ARITH_TAC]); DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_TAC `s:real list`)) THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `s ** q`; EXISTS_TAC `p ** s`] THEN GEN_TAC THEN REWRITE_TAC[POLY_MUL] THEN REAL_ARITH_TAC]);; let POLY_DIVIDES_REFL = prove (`!p. p divides p`, GEN_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[&1]` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN REAL_ARITH_TAC);; let POLY_DIVIDES_TRANS = prove (`!p q r. p divides q /\ q divides r ==> p divides r`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real list` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:real list` ASSUME_TAC) THEN EXISTS_TAC `t ** s` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; REAL_MUL_ASSOC]);; let POLY_DIVIDES_EXP = prove (`!p m n. m <= n ==> (p exp m) divides (p exp n)`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; POLY_DIVIDES_REFL] THEN MATCH_MP_TAC POLY_DIVIDES_TRANS THEN EXISTS_TAC `p exp (m + d)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN EXISTS_TAC `p:real list` THEN REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL] THEN REAL_ARITH_TAC);; let POLY_EXP_DIVIDES = prove (`!p q m n. (p exp n) divides q /\ m <= n ==> (p exp m) divides q`, MESON_TAC[POLY_DIVIDES_TRANS; POLY_DIVIDES_EXP]);; let POLY_DIVIDES_ADD = prove (`!p q r. p divides q /\ p divides r ==> p divides (q ++ r)`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real list` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:real list` ASSUME_TAC) THEN EXISTS_TAC `t ++ s` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL] THEN REAL_ARITH_TAC);; let POLY_DIVIDES_SUB = prove (`!p q r. p divides q /\ p divides (q ++ r) ==> p divides r`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real list` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t:real list` ASSUME_TAC) THEN EXISTS_TAC `s ++ neg(t)` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL; POLY_NEG] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_MUL_RNEG] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let POLY_DIVIDES_SUB2 = prove (`!p q r. p divides r /\ p divides (q ++ r) ==> p divides q`, REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_DIVIDES_SUB THEN EXISTS_TAC `r:real list` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `p divides (q ++ r)` THEN REWRITE_TAC[divides; POLY_ADD; FUN_EQ_THM; POLY_MUL] THEN DISCH_THEN(X_CHOOSE_TAC `s:real list`) THEN EXISTS_TAC `s:real list` THEN X_GEN_TAC `x:real` THEN POP_ASSUM(MP_TAC o SPEC `x:real`) THEN REAL_ARITH_TAC);; let POLY_DIVIDES_ZERO = prove (`!p q. (poly p = poly []) ==> q divides p`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[]:real list` THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; REAL_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* At last, we can consider the order of a root. *) (* ------------------------------------------------------------------------- *) let POLY_ORDER_EXISTS = prove (`!a d. !p. (LENGTH p = d) /\ ~(poly p = poly []) ==> ?n. ([--a; &1] exp n) divides p /\ ~(([--a; &1] exp (SUC n)) divides p)`, GEN_TAC THEN (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) `(!p q. mulexp 0 p q = q) /\ (!p q n. mulexp (SUC n) p q = p ** (mulexp n p q))` THEN SUBGOAL_THEN `!d. !p. (LENGTH p = d) /\ ~(poly p = poly []) ==> ?n q. (p = mulexp (n:num) [--a; &1] q) /\ ~(poly q a = &0)` MP_TAC THENL [INDUCT_TAC THENL [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `p:real list` THEN ASM_CASES_TAC `poly p a = &0` THENL [STRIP_TAC THEN UNDISCH_TAC `poly p a = &0` THEN DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real list` SUBST_ALL_TAC) THEN UNDISCH_TAC `!p. (LENGTH p = d) /\ ~(poly p = poly []) ==> ?n q. (p = mulexp (n:num) [--a; &1] q) /\ ~(poly q a = &0)` THEN DISCH_THEN(MP_TAC o SPEC `q:real list`) THEN RULE_ASSUM_TAC(REWRITE_RULE[POLY_LENGTH_MUL; POLY_ENTIRE; DE_MORGAN_THM; SUC_INJ]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `s:real list` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `SUC n` THEN EXISTS_TAC `s:real list` THEN ASM_REWRITE_TAC[]; STRIP_TAC THEN EXISTS_TAC `0` THEN EXISTS_TAC `p:real list` THEN ASM_REWRITE_TAC[]]; DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `s:real list` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN CONJ_TAC THENL [EXISTS_TAC `s:real list` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL; poly] THEN REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `r:real list` MP_TAC) THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THENL [UNDISCH_TAC `~(poly s a = &0)` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[poly; poly_exp; POLY_MUL] THEN REAL_ARITH_TAC; REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[poly_exp] THEN REWRITE_TAC[GSYM POLY_MUL_ASSOC; POLY_MUL_LCANCEL] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `a + &1`) THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC; DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]]]);; let POLY_ORDER = prove (`!p a. ~(poly p = poly []) ==> ?!n. ([--a; &1] exp n) divides p /\ ~(([--a; &1] exp (SUC n)) divides p)`, MESON_TAC[POLY_ORDER_EXISTS; POLY_EXP_DIVIDES; LE_SUC_LT; LT_CASES]);; (* ------------------------------------------------------------------------- *) (* Definition of order. *) (* ------------------------------------------------------------------------- *) let order = new_definition `order a p = @n. ([--a; &1] exp n) divides p /\ ~(([--a; &1] exp (SUC n)) divides p)`;; let ORDER = prove (`!p a n. ([--a; &1] exp n) divides p /\ ~(([--a; &1] exp (SUC n)) divides p) <=> (n = order a p) /\ ~(poly p = poly [])`, REPEAT GEN_TAC THEN REWRITE_TAC[order] THEN EQ_TAC THEN STRIP_TAC THENL [SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL [FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[divides] THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `[]:real list` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; REAL_MUL_RZERO]; ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[]]; ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV] THEN ASM_MESON_TAC[POLY_ORDER]);; let ORDER_THM = prove (`!p a. ~(poly p = poly []) ==> ([--a; &1] exp (order a p)) divides p /\ ~(([--a; &1] exp (SUC(order a p))) divides p)`, MESON_TAC[ORDER]);; let ORDER_UNIQUE = prove (`!p a n. ~(poly p = poly []) /\ ([--a; &1] exp n) divides p /\ ~(([--a; &1] exp (SUC n)) divides p) ==> (n = order a p)`, MESON_TAC[ORDER]);; let ORDER_POLY = prove (`!p q a. (poly p = poly q) ==> (order a p = order a q)`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[order; divides; FUN_EQ_THM; POLY_MUL]);; let ORDER_ROOT = prove (`!p a. (poly p a = &0) <=> (poly p = poly []) \/ ~(order a p = 0)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[poly] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN ASM_CASES_TAC `p:real list = []` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:real list` SUBST_ALL_TAC) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:real` o MATCH_MP ORDER_THM) THEN ASM_REWRITE_TAC[poly_exp; DE_MORGAN_THM] THEN DISJ2_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `q:real list` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN REAL_ARITH_TAC; DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:real` o MATCH_MP ORDER_THM) THEN UNDISCH_TAC `~(order a p = 0)` THEN SPEC_TAC(`order a p`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; NOT_SUC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `s:real list` SUBST1_TAC) THEN REWRITE_TAC[POLY_MUL; poly] THEN REAL_ARITH_TAC]);; let ORDER_DIVIDES = prove (`!p a n. ([--a; &1] exp n) divides p <=> (poly p = poly []) \/ n <= order a p`, REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[divides] THEN EXISTS_TAC `[]:real list` THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; REAL_MUL_RZERO]; ASM_MESON_TAC[ORDER_THM; POLY_EXP_DIVIDES; NOT_LE; LE_SUC_LT]]);; let ORDER_DECOMP = prove (`!p a. ~(poly p = poly []) ==> ?q. (poly p = poly (([--a; &1] exp (order a p)) ** q)) /\ ~([--a; &1] divides q)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORDER_THM) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o SPEC `a:real`) THEN DISCH_THEN(X_CHOOSE_TAC `q:real list` o REWRITE_RULE[divides]) THEN EXISTS_TAC `q:real list` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `r: real list` o REWRITE_RULE[divides]) THEN UNDISCH_TAC `~([-- a; &1] exp SUC (order a p) divides p)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN EXISTS_TAC `r:real list` THEN ASM_REWRITE_TAC[POLY_MUL; FUN_EQ_THM; poly_exp] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Important composition properties of orders. *) (* ------------------------------------------------------------------------- *) let ORDER_MUL = prove (`!a p q. ~(poly (p ** q) = poly []) ==> (order a (p ** q) = order a p + order a q)`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[POLY_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `(order a p + order a q = order a (p ** q)) /\ ~(poly (p ** q) = poly [])` MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[GSYM ORDER] THEN CONJ_TAC THENL [MP_TAC(CONJUNCT1 (SPEC `a:real` (MATCH_MP ORDER_THM (ASSUME `~(poly p = poly [])`)))) THEN DISCH_THEN(X_CHOOSE_TAC `r: real list` o REWRITE_RULE[divides]) THEN MP_TAC(CONJUNCT1 (SPEC `a:real` (MATCH_MP ORDER_THM (ASSUME `~(poly q = poly [])`)))) THEN DISCH_THEN(X_CHOOSE_TAC `s: real list` o REWRITE_RULE[divides]) THEN REWRITE_TAC[divides; FUN_EQ_THM] THEN EXISTS_TAC `s ** r` THEN ASM_REWRITE_TAC[POLY_MUL; POLY_EXP_ADD] THEN REAL_ARITH_TAC; X_CHOOSE_THEN `r: real list` STRIP_ASSUME_TAC (SPEC `a:real` (MATCH_MP ORDER_DECOMP (ASSUME `~(poly p = poly [])`))) THEN X_CHOOSE_THEN `s: real list` STRIP_ASSUME_TAC (SPEC `a:real` (MATCH_MP ORDER_DECOMP (ASSUME `~(poly q = poly [])`))) THEN ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_EXP_ADD; POLY_MUL; poly_exp] THEN DISCH_THEN(X_CHOOSE_THEN `t:real list` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `[--a; &1] divides (r ** s)` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[POLY_PRIMES]] THEN REWRITE_TAC[divides] THEN EXISTS_TAC `t:real list` THEN SUBGOAL_THEN `poly ([-- a; &1] exp (order a p) ** r ** s) = poly ([-- a; &1] exp (order a p) ** ([-- a; &1] ** t))` MP_TAC THENL [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN SUBGOAL_THEN `poly ([-- a; &1] exp (order a q) ** [-- a; &1] exp (order a p) ** r ** s) = poly ([-- a; &1] exp (order a q) ** [-- a; &1] exp (order a p) ** [-- a; &1] ** t)` MP_TAC THENL [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD] THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN REWRITE_TAC[REAL_MUL_AC]]);; let ORDER_DIFF = prove (`!p a. ~(poly (diff p) = poly []) /\ ~(order a p = 0) ==> (order a p = SUC (order a (diff p)))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `~(poly p = poly [])` MP_TAC THENL [ASM_MESON_TAC[POLY_DIFF_ZERO]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real list` MP_TAC o SPEC `a:real` o MATCH_MP ORDER_DECOMP) THEN SPEC_TAC(`order a p`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_INJ] THEN STRIP_TAC THEN MATCH_MP_TAC ORDER_UNIQUE THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!r. r divides (diff p) <=> r divides (diff ([-- a; &1] exp SUC n ** q))` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[divides] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POLY_DIFF_WELLDEF th]); ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[divides; FUN_EQ_THM] THEN EXISTS_TAC `[--a; &1] ** (diff q) ++ &(SUC n) ## q` THEN REWRITE_TAC[POLY_DIFF_MUL; POLY_DIFF_EXP_PRIME; POLY_ADD; POLY_MUL; POLY_CMUL] THEN REWRITE_TAC[poly_exp; POLY_MUL] THEN REAL_ARITH_TAC; REWRITE_TAC[FUN_EQ_THM; divides; POLY_DIFF_MUL; POLY_DIFF_EXP_PRIME; POLY_ADD; POLY_MUL; POLY_CMUL] THEN DISCH_THEN(X_CHOOSE_THEN `r:real list` ASSUME_TAC) THEN UNDISCH_TAC `~([-- a; &1] divides q)` THEN REWRITE_TAC[divides] THEN EXISTS_TAC `inv(&(SUC n)) ## (r ++ neg(diff q))` THEN SUBGOAL_THEN `poly ([--a; &1] exp n ** q) = poly ([--a; &1] exp n ** ([-- a; &1] ** (inv (&(SUC n)) ## (r ++ neg (diff q)))))` MP_TAC THENL [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN SUBGOAL_THEN `!a b. (&(SUC n) * a = &(SUC n) * b) ==> (a = b)` MATCH_MP_TAC THENL [REWRITE_TAC[REAL_EQ_MUL_LCANCEL; REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN REWRITE_TAC[POLY_MUL; POLY_CMUL] THEN SUBGOAL_THEN `!a b c. &(SUC n) * a * b * inv(&(SUC n)) * c = a * b * c` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `x:real`) THEN REWRITE_TAC[poly_exp; POLY_MUL; POLY_ADD; POLY_NEG] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Now justify the standard squarefree decomposition, i.e. f / gcd(f,f'). *) (* ------------------------------------------------------------------------- *) let POLY_SQUAREFREE_DECOMP_ORDER = prove (`!p q d e r s. ~(poly (diff p) = poly []) /\ (poly p = poly (q ** d)) /\ (poly (diff p) = poly (e ** d)) /\ (poly d = poly (r ** p ++ s ** diff p)) ==> !a. order a q = (if order a p = 0 then 0 else 1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `order a p = order a q + order a d` MP_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `order a (q ** d)` THEN CONJ_TAC THENL [MATCH_MP_TAC ORDER_POLY THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC ORDER_MUL THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th]) THEN ASM_MESON_TAC[POLY_DIFF_ZERO]]; ALL_TAC] THEN ASM_CASES_TAC `order a p = 0` THEN ASM_REWRITE_TAC[] THENL [ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `order a (diff p) = order a e + order a d` MP_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `order a (e ** d)` THEN CONJ_TAC THENL [ASM_MESON_TAC[ORDER_POLY]; ASM_MESON_TAC[ORDER_MUL]]; ALL_TAC] THEN SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL [ASM_MESON_TAC[POLY_DIFF_ZERO]; ALL_TAC] THEN MP_TAC(SPECL [`p:real list`; `a:real`] ORDER_DIFF) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(AP_TERM `PRE` th)) THEN REWRITE_TAC[PRE] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN SUBGOAL_THEN `order a (diff p) <= order a d` MP_TAC THENL [SUBGOAL_THEN `([--a; &1] exp (order a (diff p))) divides d` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[POLY_ENTIRE; ORDER_DIVIDES]] THEN SUBGOAL_THEN `([--a; &1] exp (order a (diff p))) divides p /\ ([--a; &1] exp (order a (diff p))) divides (diff p)` MP_TAC THENL [REWRITE_TAC[ORDER_DIVIDES; LE_REFL] THEN DISJ2_TAC THEN REWRITE_TAC[ASSUME `order a (diff p) = PRE (order a p)`] THEN ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[divides] THEN REWRITE_TAC[ASSUME `poly d = poly (r ** p ++ s ** diff p)`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `f:real list` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g:real list` ASSUME_TAC) THEN EXISTS_TAC `r ** g ++ s ** f` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD] THEN ARITH_TAC]; ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Define being "squarefree" --- NB with respect to real roots only. *) (* ------------------------------------------------------------------------- *) let rsquarefree = new_definition `rsquarefree p <=> ~(poly p = poly []) /\ !a. (order a p = 0) \/ (order a p = 1)`;; (* ------------------------------------------------------------------------- *) (* Standard squarefree criterion and rephasing of squarefree decomposition. *) (* ------------------------------------------------------------------------- *) let RSQUAREFREE_ROOTS = prove (`!p. rsquarefree p <=> !a. ~((poly p a = &0) /\ (poly (diff p) a = &0))`, GEN_TAC THEN REWRITE_TAC[rsquarefree] THEN ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THENL [FIRST_ASSUM(SUBST1_TAC o MATCH_MP POLY_DIFF_ZERO) THEN ASM_REWRITE_TAC[poly; NOT_FORALL_THM]; ASM_CASES_TAC `poly(diff p) = poly []` THEN ASM_REWRITE_TAC[] THENL [FIRST_ASSUM(X_CHOOSE_THEN `h:real` MP_TAC o MATCH_MP POLY_DIFF_ISZERO) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ORDER_POLY th]) THEN UNDISCH_TAC `~(poly p = poly [])` THEN ASM_REWRITE_TAC[poly] THEN REWRITE_TAC[FUN_EQ_THM; poly; REAL_MUL_RZERO; REAL_ADD_RID] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real` THEN DISJ1_TAC THEN MP_TAC(SPECL [`[h:real]`; `a:real`] ORDER_ROOT) THEN ASM_REWRITE_TAC[FUN_EQ_THM; poly; REAL_MUL_RZERO; REAL_ADD_RID]; ASM_REWRITE_TAC[ORDER_ROOT; DE_MORGAN_THM; num_CONV `1`] THEN ASM_MESON_TAC[ORDER_DIFF; SUC_INJ]]]);; let RSQUAREFREE_DECOMP = prove (`!p a. rsquarefree p /\ (poly p a = &0) ==> ?q. (poly p = poly ([--a; &1] ** q)) /\ ~(poly q a = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[rsquarefree] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORDER_DECOMP) THEN DISCH_THEN(X_CHOOSE_THEN `q:real list` MP_TAC o SPEC `a:real`) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ORDER_ROOT]) THEN FIRST_ASSUM(DISJ_CASES_TAC o SPEC `a:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN EXISTS_TAC `q:real list` THEN CONJ_TAC THENL [REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN GEN_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [num_CONV `1`] THEN REWRITE_TAC[poly_exp; POLY_MUL] THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC; DISCH_TAC THEN UNDISCH_TAC `~([-- a; &1] divides q)` THEN REWRITE_TAC[divides] THEN UNDISCH_TAC `poly q a = &0` THEN GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN ASM_CASES_TAC `q:real list = []` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `[] : real list` THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[POLY_MUL; poly; REAL_MUL_RZERO]; MESON_TAC[]]]);; let POLY_SQUAREFREE_DECOMP = prove (`!p q d e r s. ~(poly (diff p) = poly []) /\ (poly p = poly (q ** d)) /\ (poly (diff p) = poly (e ** d)) /\ (poly d = poly (r ** p ++ s ** diff p)) ==> rsquarefree q /\ (!a. (poly q a = &0) <=> (poly p a = &0))`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP POLY_SQUAREFREE_DECOMP_ORDER th)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL [ASM_MESON_TAC[POLY_DIFF_ZERO]; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN UNDISCH_TAC `~(poly p = poly [])` THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN DISCH_THEN(fun th -> ASM_REWRITE_TAC[] THEN ASSUME_TAC th) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[POLY_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN UNDISCH_TAC `poly p = poly (q ** d)` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_REWRITE_TAC[rsquarefree; ORDER_ROOT] THEN CONJ_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[ARITH]);; (* ------------------------------------------------------------------------- *) (* Normalization of a polynomial. *) (* ------------------------------------------------------------------------- *) let normalize = new_recursive_definition list_RECURSION `(normalize [] = []) /\ (normalize (CONS h t) = if normalize t = [] then if h = &0 then [] else [h] else CONS h (normalize t))`;; let POLY_NORMALIZE = prove (`!p. poly (normalize p) = poly p`, LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; poly] THEN ASM_CASES_TAC `h = &0` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM] THEN UNDISCH_TAC `poly (normalize t) = poly t` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[poly] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID]);; (* ------------------------------------------------------------------------- *) (* The degree of a polynomial. *) (* ------------------------------------------------------------------------- *) let degree = new_definition `degree p = PRE(LENGTH(normalize p))`;; let DEGREE_ZERO = prove (`!p. (poly p = poly []) ==> (degree p = 0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[degree] THEN SUBGOAL_THEN `normalize p = []` SUBST1_TAC THENL [POP_ASSUM MP_TAC THEN SPEC_TAC(`p:real list`,`p:real list`) THEN REWRITE_TAC[POLY_ZERO] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; ALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `normalize t = []` (fun th -> REWRITE_TAC[th]) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LENGTH; PRE]]);; (* ------------------------------------------------------------------------- *) (* Tidier versions of finiteness of roots. *) (* ------------------------------------------------------------------------- *) let POLY_ROOTS_FINITE_SET = prove (`!p. ~(poly p = poly []) ==> FINITE { x | poly p x = &0}`, GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `i:num->real` ASSUME_TAC) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:real | ?n:num. n < N /\ (x = i n)}` THEN CONJ_TAC THENL [SPEC_TAC(`N:num`,`N:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THENL [SUBGOAL_THEN `{x:real | ?n. n < 0 /\ (x = i n)} = {}` (fun th -> REWRITE_TAC[th; FINITE_RULES]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; SUBGOAL_THEN `{x:real | ?n. n < SUC N /\ (x = i n)} = (i N) INSERT {x:real | ?n. n < N /\ (x = i n)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; LT] THEN MESON_TAC[]; MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN ASM_REWRITE_TAC[]]]; ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM]]);; (* ------------------------------------------------------------------------- *) (* Crude bound for polynomial. *) (* ------------------------------------------------------------------------- *) let POLY_MONO = prove (`!x k p. abs(x) <= k ==> abs(poly p x) <= poly (MAP abs p) k`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_LE_REFL; MAP; REAL_ABS_0] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(h) + abs(x * poly t x)` THEN REWRITE_TAC[REAL_ABS_TRIANGLE; REAL_LE_LADD] THEN REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; (* ------------------------------------------------------------------------- *) (* Conversions to perform operations if coefficients are rational constants. *) (* ------------------------------------------------------------------------- *) let POLY_DIFF_CONV = let aux_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_diff_aux] and aux_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_diff_aux] and diff_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_DIFF_CLAUSES)) and diff_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_DIFF_CLAUSES)] in let rec POLY_DIFF_AUX_CONV tm = (aux_conv0 ORELSEC (aux_conv1 THENC LAND_CONV REAL_RAT_MUL_CONV THENC RAND_CONV (LAND_CONV NUM_SUC_CONV THENC POLY_DIFF_AUX_CONV))) tm in diff_conv0 ORELSEC (diff_conv1 THENC POLY_DIFF_AUX_CONV);; let POLY_CMUL_CONV = let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul] and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul] in let rec POLY_CMUL_CONV tm = (cmul_conv0 ORELSEC (cmul_conv1 THENC LAND_CONV REAL_RAT_MUL_CONV THENC RAND_CONV POLY_CMUL_CONV)) tm in POLY_CMUL_CONV;; let POLY_ADD_CONV = let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES)) and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)] in let rec POLY_ADD_CONV tm = (add_conv0 ORELSEC (add_conv1 THENC LAND_CONV REAL_RAT_ADD_CONV THENC RAND_CONV POLY_ADD_CONV)) tm in POLY_ADD_CONV;; let POLY_MUL_CONV = let mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES] and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)] and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)] in let rec POLY_MUL_CONV tm = (mul_conv0 ORELSEC (mul_conv1 THENC POLY_CMUL_CONV) ORELSEC (mul_conv2 THENC LAND_CONV POLY_CMUL_CONV THENC RAND_CONV(RAND_CONV POLY_MUL_CONV) THENC POLY_ADD_CONV)) tm in POLY_MUL_CONV;; let POLY_NORMALIZE_CONV = let pth = prove (`normalize (CONS h t) = (\n. if n = [] then if h = &0 then [] else [h] else CONS h n) (normalize t)`, REWRITE_TAC[normalize]) in let norm_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 normalize] and norm_conv1 = GEN_REWRITE_CONV I [pth] and norm_conv2 = GEN_REWRITE_CONV DEPTH_CONV [COND_CLAUSES; NOT_CONS_NIL; EQT_INTRO(SPEC_ALL EQ_REFL)] in let rec POLY_NORMALIZE_CONV tm = (norm_conv0 ORELSEC (norm_conv1 THENC RAND_CONV POLY_NORMALIZE_CONV THENC BETA_CONV THENC RATOR_CONV(RAND_CONV(RATOR_CONV(LAND_CONV REAL_RAT_EQ_CONV))) THENC norm_conv2)) tm in POLY_NORMALIZE_CONV;; (* ------------------------------------------------------------------------- *) (* Some theorems asserting that operations give non-nil results. *) (* ------------------------------------------------------------------------- *) let NOT_POLY_CMUL_NIL = prove (`!h p. ~(p = []) ==> ~((h ## p) = [])`, STRIP_TAC THEN LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[poly_cmul; NOT_CONS_NIL]]);; let NOT_POLY_MUL_NIL = prove (`!p1 p2. ~(p1 = []) /\ ~(p2 = []) ==> ~((p1 ** p2) = [])`, LIST_INDUCT_TAC THENL [SIMP_TAC[]; LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[poly_mul;NOT_CONS_NIL] THEN SPEC_TAC (`t:(real)list`,`t:(real)list`) THEN LIST_INDUCT_TAC THENL [SIMP_TAC[poly_cmul;NOT_CONS_NIL]; SIMP_TAC[poly_cmul;poly_add;NOT_CONS_NIL]] ] ]);; let NOT_POLY_EXP_NIL = prove (`!n p . ~(p = []) ==> ~((poly_exp p n) = [])`, let lem001 = ASSUME `!p . ~(p = []) ==> ~(poly_exp p n = [])` in let lem002 = SIMP_RULE[NOT_CONS_NIL] (SPEC `CONS (h:real) t` lem001) in INDUCT_TAC THENL [SIMP_TAC[poly_exp;NOT_CONS_NIL]; LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[lem002;NOT_POLY_MUL_NIL;poly_exp;NOT_CONS_NIL] ] ]);; let NOT_POLY_EXP_X_NIL = prove (`!n. ~((poly_exp [&0;&1] n) = [])`, let lem01 = prove(`~([&0;&1] = [])`,SIMP_TAC[NOT_CONS_NIL]) in INDUCT_TAC THENL [SIMP_TAC[poly_exp;NOT_CONS_NIL]; ASM_SIMP_TAC[poly_exp;NOT_POLY_MUL_NIL;lem01]]);; (* ------------------------------------------------------------------------- *) (* Some general lemmas. *) (* ------------------------------------------------------------------------- *) let POLY_CMUL_LID = prove (`!p. &1 ## p = p`, LIST_INDUCT_TAC THENL [SIMP_TAC[poly_cmul]; ASM_SIMP_TAC[poly_cmul] THEN SIMP_TAC[REAL_ARITH `&1 * h = h`]]);; let POLY_MUL_LID = prove (`!p. [&1] ** p = p`, LIST_INDUCT_TAC THENL [SIMP_TAC[poly_mul;poly_cmul]; ONCE_REWRITE_TAC[poly_mul] THEN SIMP_TAC[POLY_CMUL_LID]]);; let POLY_MUL_RID = prove (`!p. p ** [&1] = p`, LIST_INDUCT_TAC THENL [SIMP_TAC[poly_mul]; ASM_CASES_TAC `t:(real)list = []` THEN ASM_SIMP_TAC[poly_mul;poly_cmul;poly_add;NOT_CONS_NIL;HD;TL; REAL_ARITH `h + (real_of_num 0) = h`;REAL_ARITH `h * (real_of_num 1) = h`] ]);; let POLY_ADD_SYM = prove (`!x y . x ++ y = y ++ x`, let lem1 = ASSUME `!y . t ++ y = y ++ t` in let lem2 = SPEC `t':(real)list` lem1 in LIST_INDUCT_TAC THENL [LIST_INDUCT_TAC THENL [SIMP_TAC[poly_add]; SIMP_TAC[poly_add]]; LIST_INDUCT_TAC THENL [SIMP_TAC[poly_add]; SIMP_TAC[POLY_ADD_CLAUSES] THEN ONCE_REWRITE_TAC[lem2] THEN SIMP_TAC[SPECL [`h:real`;`h':real`] REAL_ADD_SYM] ] ]);; let POLY_ADD_ASSOC = prove (`!x y z . x ++ (y ++ z) = (x ++ y) ++ z`, let lem1 = ASSUME `!y z. t ++ y ++ z = (t ++ y) ++ z` in let lem2 = SPECL [`t':(real)list`;`t'':(real)list`] lem1 in LIST_INDUCT_TAC THENL [SIMP_TAC[POLY_ADD_CLAUSES]; LIST_INDUCT_TAC THENL [SIMP_TAC[POLY_ADD_CLAUSES]; LIST_INDUCT_TAC THENL [SIMP_TAC[POLY_ADD_CLAUSES]; SIMP_TAC[POLY_ADD_CLAUSES] THEN SIMP_TAC[REAL_ADD_ASSOC] THEN SIMP_TAC[lem2] ] ] ]);; (* ------------------------------------------------------------------------- *) (* Heads and tails resulting from operations. *) (* ------------------------------------------------------------------------- *) let TL_POLY_MUL_X = prove (`!p. TL ([&0;&1] ** p) = p`, LIST_INDUCT_TAC THENL [ONCE_REWRITE_TAC[poly_mul] THEN SIMP_TAC[NOT_CONS_NIL;poly_cmul;poly_add;TL;poly_mul]; ONCE_REWRITE_TAC[poly_mul] THEN SIMP_TAC[NOT_CONS_NIL] THEN ONCE_REWRITE_TAC[poly_cmul] THEN ONCE_REWRITE_TAC[poly_add] THEN SIMP_TAC[NOT_CONS_NIL] THEN SIMP_TAC[TL;POLY_MUL_LID] THEN SPEC_TAC (`h:real`,`h:real`) THEN SPEC_TAC (`t:(real)list`,`t:(real)list`) THEN LIST_INDUCT_TAC THENL [SIMP_TAC[poly_cmul;poly_add]; ASM_SIMP_TAC[poly_cmul;poly_add;NOT_CONS_NIL;HD;TL; REAL_ARITH `(&0) * h + h' = h'`] ] ]);; let HD_POLY_MUL_X = prove (`!p. HD ([&0;&1] ** p) = &0`, LIST_INDUCT_TAC THEN SIMP_TAC[poly_mul;NOT_CONS_NIL;poly_cmul;poly_add;HD; REAL_ARITH `&0 * h + &0 = &0`]);; let TL_POLY_EXP_X_SUC = prove (`!n . TL (poly_exp [&0;&1] (SUC n)) = poly_exp [&0;&1] n`, SIMP_TAC[poly_exp;TL_POLY_MUL_X]);; let HD_POLY_EXP_X_SUC = prove (`!n . HD (poly_exp [&0;&1] (SUC n)) = &0`, INDUCT_TAC THENL [SIMP_TAC[poly_exp;poly_add;HD;TL;poly_cmul;poly_mul;NOT_CONS_NIL; REAL_ARITH `&0 * &1 + &0 = &0`]; SIMP_TAC[poly_exp;HD_POLY_MUL_X]]);; let HD_POLY_ADD = prove (`!p1 p2. ~(p1 = []) /\ ~(p2 = []) ==> HD (p1 ++ p2) = (HD p1) + (HD p2)`, LIST_INDUCT_TAC THENL [SIMP_TAC[]; LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[NOT_CONS_NIL;poly_add] THEN ONCE_REWRITE_TAC[ISPECL [`h':real`;`t':(real)list`] NOT_CONS_NIL] THEN SIMP_TAC[HD] ] ]);; let HD_POLY_CMUL = prove (`!x p . ~(p = []) ==> HD (x ## p) = x * (HD p)`, STRIP_TAC THEN LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[NOT_CONS_NIL;poly_cmul;HD]]);; let TL_POLY_CMUL = prove (`!x p . ~(p = []) ==> TL (x ## p) = x ## (TL p)`, STRIP_TAC THEN LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[NOT_CONS_NIL;poly_cmul;TL]]);; let HD_POLY_MUL = prove (`!p1 p2 . ~(p1 = []) /\ ~(p2 = []) ==> HD (p1 ** p2) = (HD p1) * (HD p2)`, LIST_INDUCT_TAC THENL [SIMP_TAC[]; LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[NOT_CONS_NIL;poly_mul] THEN ASM_CASES_TAC `(t:(real)list) = []` THENL [ASM_SIMP_TAC[poly_cmul;HD]; ASM_SIMP_TAC[poly_cmul;poly_add;NOT_CONS_NIL;HD] THEN REAL_ARITH_TAC ] ] ]);; let HD_POLY_EXP = prove (`!n p . ~(p = []) ==> HD (poly_exp p n) = (HD p) pow n`, INDUCT_TAC THENL [SIMP_TAC[poly_exp] THEN LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[HD;pow]]; SIMP_TAC[poly_exp] THEN LIST_INDUCT_TAC THENL [SIMP_TAC[]; SIMP_TAC[HD;GSYM pow;NOT_CONS_NIL;poly_mul] THEN ASM_CASES_TAC `(t:(real)list) = []` THENL [ASM_SIMP_TAC[HD_POLY_CMUL;NOT_POLY_CMUL_NIL;NOT_POLY_EXP_NIL; NOT_CONS_NIL;HD;GSYM pow]; ASM_SIMP_TAC[NOT_POLY_CMUL_NIL;NOT_POLY_EXP_NIL;NOT_CONS_NIL; HD_POLY_ADD;HD;HD_POLY_CMUL;GSYM pow] THEN REAL_ARITH_TAC] ] ]);; (* ------------------------------------------------------------------------- *) (* Additional general lemmas. *) (* ------------------------------------------------------------------------- *) let POLY_ADD_IDENT = prove (`neutral (++) = []`, let l1 = ASSUME `!x. (!y. x ++ y = y /\ y ++ x = y) ==> (!y. (CONS h t) ++ y = y /\ y ++ (CONS h t) = y)` in let l2 = SPEC `[]:(real)list` l1 in let l3 = SIMP_RULE[POLY_ADD_CLAUSES] l2 in let l4 = SPEC `[]:(real)list` l3 in let l5 = CONJUNCT1 l4 in let l6 = SIMP_RULE[POLY_ADD_CLAUSES;NOT_CONS_NIL] l5 in let l7 = NOT_INTRO (DISCH_ALL l6) in ONCE_REWRITE_TAC[neutral] THEN SELECT_ELIM_TAC THEN LIST_INDUCT_TAC THENL [SIMP_TAC[];SIMP_TAC[l7]]);; let POLY_ADD_NEUTRAL = prove (`!x. neutral (++) ++ x = x`, SIMP_TAC[POLY_ADD_IDENT;POLY_ADD_CLAUSES]);; let MONOIDAL_POLY_ADD = prove (`monoidal poly_add`, let lem1 = CONJ POLY_ADD_SYM (CONJ POLY_ADD_ASSOC POLY_ADD_NEUTRAL) in ONCE_REWRITE_TAC[monoidal] THEN ACCEPT_TAC lem1);; let POLY_DIFF_AUX_ADD_LEMMA = prove (`!t1 t2 n. poly_diff_aux n (t1 ++ t2) = (poly_diff_aux n t1) ++ (poly_diff_aux n t2)`, let lem = REAL_ARITH `!n h h'. (&n * h) + (&n * h') = &n * (h + h')` in LIST_INDUCT_TAC THEN SIMP_TAC[POLY_ADD_CLAUSES;poly_diff_aux] THEN LIST_INDUCT_TAC THEN SIMP_TAC[POLY_ADD_CLAUSES;poly_diff_aux] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[POLY_ADD_CLAUSES] THEN ONCE_REWRITE_TAC[poly_diff_aux] THEN ONCE_REWRITE_TAC[POLY_ADD_CLAUSES] THEN ONCE_REWRITE_TAC[lem] THEN ASM_SIMP_TAC[]);; let POLYDIFF_ADD = prove (`!p1 p2. (poly_diff (p1 ++ p2)) = (poly_diff p1 ++ poly_diff p2)`, let lem1 = prove (`!h0 t0 h1 t1. ~(((CONS h0 t0) ++ (CONS h1 t1)) = [])`, SIMP_TAC[POLY_ADD_CLAUSES;NOT_CONS_NIL]) in let lem2 = prove (`!h0 t0 h1 t1. (TL ((CONS h0 t0) ++ (CONS h1 t1)) = (TL (CONS h0 t0)) ++ (TL (CONS h1 t1)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[poly_add] THEN ONCE_REWRITE_TAC[NOT_CONS_NIL] THEN REWRITE_TAC[TL] THEN SIMP_TAC[]) in REPEAT LIST_INDUCT_TAC THENL [SIMP_TAC[poly_add;poly_diff]; SIMP_TAC[poly_add;poly_diff]; SIMP_TAC[poly_add;poly_diff;POLY_ADD_CLAUSES]; SIMP_TAC[poly_diff] THEN ONCE_REWRITE_TAC[lem1;NOT_CONS_NIL] THEN SIMP_TAC[lem2;POLY_DIFF_AUX_ADD_LEMMA] ]);; let POLY_DIFF_AUX_POLY_CMUL = prove (`!p c n. poly_diff_aux n (c ## p) = c ## (poly_diff_aux n p)`, let lem01 = ASSUME `!c n. poly_diff_aux n (c ## t) = c ## poly_diff_aux n t` in let lem02 = SPECL [`c:real`;`SUC n`] lem01 in LIST_INDUCT_TAC THEN STRIP_TAC THEN STRIP_TAC THEN SIMP_TAC[poly_cmul;poly_diff_aux;lem02; REAL_ARITH `(a:real) * b * c = b * a * c`]);; let POLY_CMUL_POLY_DIFF = prove (`!p c. poly_diff (c ## p) = c ## (poly_diff p)`, LIST_INDUCT_TAC THEN SIMP_TAC[poly_diff;POLY_DIFF_AUX_POLY_CMUL;TL_POLY_CMUL; poly_cmul;NOT_CONS_NIL]);; (* ------------------------------------------------------------------------- *) (* Theorems about the lengths of lists from the polynomial operations. *) (* ------------------------------------------------------------------------- *) let POLY_CMUL_LENGTH = prove (`!c p. LENGTH (c ## p) = LENGTH p`, STRIP_TAC THEN LIST_INDUCT_TAC THENL [SIMP_TAC[poly_cmul]; SIMP_TAC[poly_cmul] THEN ASM_SIMP_TAC[LENGTH] ]);; let POLY_ADD_LENGTH = prove (`!p q. LENGTH (p ++ q) = MAX (LENGTH p) (LENGTH q)`, LIST_INDUCT_TAC THENL [SIMP_TAC[poly_add;LENGTH] THEN ARITH_TAC; LIST_INDUCT_TAC THENL [SIMP_TAC[poly_add;LENGTH] THEN ARITH_TAC; SIMP_TAC[poly_add;LENGTH] THEN ONCE_REWRITE_TAC[NOT_CONS_NIL] THEN SIMP_TAC[HD;TL;LENGTH] THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE `MAX x y = if (x > y) then x else y`] THEN ASM_CASES_TAC `LENGTH (t:(real)list) > LENGTH (t':(real)list)` THENL [ASM_SIMP_TAC[ARITH_RULE `x > y ==> (SUC x) > (SUC y)`]; ASM_SIMP_TAC[ARITH_RULE `~(x > y) ==> ~((SUC x) > (SUC y))`]] ] ]);; let POLY_MUL_LENGTH = prove (`!p h t. LENGTH (p ** (CONS h t)) >= LENGTH p`, let lemma01 = ASSUME `!h t'. LENGTH (t ** CONS h t') >= LENGTH t` in let lemma02 = SPECL [`h':real`;`t':(real)list`] lemma01 in let lemma03 = ONCE_REWRITE_RULE[ARITH_RULE `(x:num) >= y <=> SUC x >= SUC y`] lemma02 in let lemma05 = ARITH_RULE `(y:num) >= z ==> (x + (y - x) >= z) ` in let lemma06 = SPECL [`SUC (LENGTH (t ** (CONS (h':real) t')))`; `LENGTH (h ## (CONS h' t'))`; `SUC (LENGTH (t:(real)list))`] (GEN_ALL lemma05) in let lemma07 = MATCH_MP (lemma06) (lemma03) in LIST_INDUCT_TAC THENL [SIMP_TAC[POLY_MUL_CLAUSES] THEN ARITH_TAC; SIMP_TAC[poly_mul] THEN ASM_CASES_TAC `(t:(real)list) = []` THENL [ASM_SIMP_TAC[POLY_CMUL_LENGTH;LENGTH] THEN ARITH_TAC; ASM_SIMP_TAC[POLY_ADD_LENGTH;LENGTH;lemma07; ARITH_RULE `!x y. (MAX x y) = x + (y - x)`] ] ]);; let POLY_EXP_X_REC = prove (`!n. poly_exp [&0;&1] (SUC n) = CONS (&0) (poly_exp [&0;&1] n)`, let lem01 = MATCH_MP CONS_HD_TL (SPEC `(SUC n)` NOT_POLY_EXP_X_NIL) in let lem02 = ONCE_REWRITE_RULE[HD_POLY_EXP_X_SUC; TL_POLY_EXP_X_SUC] lem01 in ACCEPT_TAC (GEN_ALL lem02));; let POLY_MUL_LENGTH2 = prove (`!q p. ~(q = []) ==> LENGTH (p ** q) >= LENGTH p`, LIST_INDUCT_TAC THEN SIMP_TAC[NOT_CONS_NIL; POLY_MUL_LENGTH]);; let POLY_EXP_X_LENGTH = prove (`!n. LENGTH (poly_exp [&0;&1] n) = SUC n`, INDUCT_TAC THEN ASM_SIMP_TAC[poly_exp;LENGTH; POLY_EXP_X_REC; ARITH_RULE `(SUC x) = (SUC y) <=> x = y`]);; (* ------------------------------------------------------------------------- *) (* Expansion of a polynomial as a power sum. *) (* ------------------------------------------------------------------------- *) let POLY_SUM_EQUIV = prove (`!p x. ~(p = []) ==> poly p x = sum (0..(PRE (LENGTH p))) (\i. (EL i p)*(x pow i))`, let lem000 = ARITH_RULE `0 <= 0 + 1 /\ 0 <= (LENGTH (t:(real)list))` in let lem001 = SPECL [`f:num->real`;`0`;`0`;`LENGTH (t:(real)list)`] SUM_COMBINE_R in let lem002 = MP lem001 lem000 in let lem003 = SPECL [`f:num->real`;`1`;`LENGTH (t:(real)list)`] SUM_OFFSET_0 in let lem004 = ASSUME `~((t:(real)list) = [])` in let lem005 = ONCE_REWRITE_RULE[GSYM LENGTH_EQ_NIL] lem004 in let lem006 = ONCE_REWRITE_RULE[ARITH_RULE `~(x = 0) <=> (1 <= x)`] lem005 in let lem007 = MP lem003 lem006 in let lem017 = ARITH_RULE `1 <= (LENGTH (t:(real)list)) ==> ((LENGTH t) - 1 = PRE (LENGTH t))` in let lem018 = MP lem017 lem006 in LIST_INDUCT_TAC THENL [ SIMP_TAC[NOT_CONS_NIL] ; ASM_CASES_TAC `(t:(real)list) = []` THENL [ ASM_SIMP_TAC[POLY_CONST;LENGTH;PRE] THEN ONCE_REWRITE_TAC[NUMSEG_CONV `0..0`] THEN ONCE_REWRITE_TAC[SUM_SING] THEN BETA_TAC THEN ONCE_REWRITE_TAC[EL] THEN ONCE_REWRITE_TAC[HD] THEN REAL_ARITH_TAC ; ASM_SIMP_TAC[POLY_CONST;LENGTH;PRE] THEN ONCE_REWRITE_TAC[poly] THEN ONCE_REWRITE_TAC[GSYM lem002] THEN ONCE_REWRITE_TAC[ARITH_RULE `0 + 1 = 1`] THEN ONCE_REWRITE_TAC[NUMSEG_CONV `0..0`] THEN ONCE_REWRITE_TAC[SUM_SING] THEN BETA_TAC THEN SIMP_TAC[EL;HD] THEN ONCE_REWRITE_TAC[lem007] THEN BETA_TAC THEN ONCE_REWRITE_TAC[GSYM ADD1] THEN SIMP_TAC[EL;TL] THEN ONCE_REWRITE_TAC[real_pow] THEN ONCE_REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_ARITH `(A:real) * B * C = B * (A * C)`] THEN ONCE_REWRITE_TAC[NSUM_LMUL] THEN ONCE_REWRITE_TAC[SUM_LMUL] THEN ASM_SIMP_TAC[] THEN SIMP_TAC[NOT_CONS_NIL] THEN ONCE_REWRITE_TAC[lem018] THEN SIMP_TAC[] ]]);; let ITERATE_RADD_POLYADD = prove (`!n x f. iterate (+) (0..n) (\i.poly (f i) x) = poly (iterate (++) (0..n) f) x`, INDUCT_TAC THEN ASM_SIMP_TAC[ITERATE_CLAUSES_NUMSEG; MONOIDAL_REAL_ADD; MONOIDAL_POLY_ADD; LE_0; POLY_ADD]);; (* ------------------------------------------------------------------------- *) (* Now we're finished with polynomials... *) (* ------------------------------------------------------------------------- *) do_list reduce_interface ["divides",`poly_divides:real list->real list->bool`; "exp",`poly_exp:real list -> num -> real list`; "diff",`poly_diff:real list->real list`];; unparse_as_infix "exp";; hol-light/Library/pratt.ml000066400000000000000000001277761303454263000160610ustar00rootroot00000000000000(* ========================================================================= *) (* HOL primality proving procedure, based on Pratt certificates. *) (* ========================================================================= *) needs "Library/prime.ml";; prioritize_num();; let num_0 = Int 0;; let num_1 = Int 1;; let num_2 = Int 2;; (* ------------------------------------------------------------------------- *) (* Mostly for compatibility. Should eliminate this eventually. *) (* ------------------------------------------------------------------------- *) let nat_mod_lemma = prove (`!x y n:num. (x == y) (mod n) /\ y <= x ==> ?q. x = y + n * q`, REPEAT GEN_TAC THEN REWRITE_TAC[num_congruent] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_REWRITE_TAC [INTEGER_RULE `(x == y) (mod &n) <=> &n divides (x - y)`] THEN ASM_SIMP_TAC[INT_OF_NUM_SUB; ARITH_RULE `x <= y ==> (y:num = x + d <=> y - x = d)`] THEN REWRITE_TAC[GSYM num_divides; divides]);; let nat_mod = prove (`!x y n:num. (mod n) x y <=> ?q1 q2. x + n * q1 = y + n * q2`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM cong] THEN EQ_TAC THENL [ALL_TAC; NUMBER_TAC] THEN MP_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THEN REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (c /\ b) \/ (c /\ a) ==> d`] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ALL_TAC; ONCE_REWRITE_TAC[NUMBER_RULE `(x:num == y) (mod n) <=> (y == x) (mod n)`]] THEN MESON_TAC[nat_mod_lemma; ARITH_RULE `x + y * 0 = x`]);; (* ------------------------------------------------------------------------- *) (* Lemmas about previously defined terms. *) (* ------------------------------------------------------------------------- *) let PRIME = prove (`!p. prime p <=> ~(p = 0) /\ ~(p = 1) /\ !m. 0 < m /\ m < p ==> coprime(p,m)`, GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP PRIME_COPRIME) THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN STRIP_TAC THEN ASM_REWRITE_TAC[COPRIME_1] THEN ASM_MESON_TAC[NOT_LT; LT_REFL; DIVIDES_LE]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC o MATCH_MP PRIME_FACTOR) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN SUBGOAL_THEN `~(coprime(p,q))` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[coprime; NOT_FORALL_THM] THEN EXISTS_TAC `q:num` THEN ASM_REWRITE_TAC[DIVIDES_REFL] THEN ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[LT_LE; LE_0] THEN ASM_CASES_TAC `p:num = q` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[DIVIDES_ZERO]);; let FINITE_NUMBER_SEGMENT = prove (`!n. { m | 0 < m /\ m < n } HAS_SIZE (n - 1)`, INDUCT_TAC THENL [SUBGOAL_THEN `{m | 0 < m /\ m < 0} = EMPTY` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV; ASM_CASES_TAC `n = 0` THENL [SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = EMPTY` SUBST1_TAC THENL [ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[HAS_SIZE_0]; SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = n INSERT {m | 0 < m /\ m < n}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `~(n = 0)` THEN POP_ASSUM MP_TAC THEN SIMP_TAC[FINITE_RULES; HAS_SIZE; CARD_CLAUSES] THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; LT_REFL] THEN ARITH_TAC]]);; let COPRIME_MOD = prove (`!a n. ~(n = 0) ==> (coprime(a MOD n,n) <=> coprime(a,n))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [MATCH_MP DIVISION th]) THEN REWRITE_TAC[coprime] THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MESON_TAC[DIVIDES_ADD; DIVIDES_ADD_REVR; DIVIDES_ADD_REVL; DIVIDES_LMUL; DIVIDES_RMUL]);; (* ------------------------------------------------------------------------- *) (* Congruences. *) (* ------------------------------------------------------------------------- *) let CONG = prove (`!x y n. ~(n = 0) ==> ((x == y) (mod n) <=> (x MOD n = y MOD n))`, REWRITE_TAC[cong; nat_mod] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_CASES_TAC `x <= y` THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q1 - q2`; MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q2 - q1`] THEN REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; MAP_EVERY EXISTS_TAC [`y DIV n`; `x DIV n`] THEN UNDISCH_TAC `x MOD n = y MOD n` THEN MATCH_MP_TAC(ARITH_RULE `(y = dy + my) /\ (x = dx + mx) ==> (mx = my) ==> (x + dy = y + dx)`) THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[DIVISION]]);; let CONG_MOD_0 = prove (`!x y. (x == y) (mod 0) <=> (x = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod; MULT_CLAUSES; ADD_CLAUSES]);; let CONG_MOD_1 = prove (`!x y. (x == y) (mod 1)`, REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN MAP_EVERY EXISTS_TAC [`y:num`; `x:num`] THEN REWRITE_TAC[MULT_CLAUSES; ADD_AC]);; let CONG_0 = prove (`!x n. ((x == 0) (mod n) <=> n divides x)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[DIVIDES_ZERO; CONG_MOD_0] THEN ASM_SIMP_TAC[CONG; MOD_0; MOD_EQ_0] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[divides]);; let CONG_SUB_CASES = prove (`!x y n. (x == y) (mod n) <=> if x <= y then (y - x == 0) (mod n) else (x - y == 0) (mod n)`, REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN COND_CASES_TAC THENL [GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]; ALL_TAC] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let CONG_MULT_LCANCEL = prove (`!a n x y. coprime(a,n) /\ (a * x == a * y) (mod n) ==> (x == y) (mod n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a = 0` THENL [ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[COPRIME_0] THEN SIMP_TAC[CONG_MOD_1]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN REWRITE_TAC[GSYM LEFT_SUB_DISTRIB; CONG_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[COPRIME_DIVPROD; COPRIME_SYM]);; let CONG_REFL = prove (`!x n. (x == x) (mod n)`, MESON_TAC[cong; nat_mod; ADD_CLAUSES; MULT_CLAUSES]);; let CONG_SYM = prove (`!x y n. (x == y) (mod n) <=> (y == x) (mod n)`, REWRITE_TAC[cong; nat_mod] THEN MESON_TAC[]);; let CONG_TRANS = prove (`!x y z n. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, REWRITE_TAC[cong; nat_mod] THEN MESON_TAC[ARITH_RULE `(x + n * q1 = y + n * q2) /\ (y + n * q3 = z + n * q4) ==> (x + n * (q1 + q3) = z + n * (q2 + q4))`]);; (* ------------------------------------------------------------------------- *) (* Euler totient function. *) (* ------------------------------------------------------------------------- *) let phi = new_definition `phi(n) = CARD { m | 0 < m /\ m <= n /\ coprime(m,n) }`;; let PHI_ALT = prove (`phi(n) = CARD { m | coprime(m,n) /\ m < n}`, REWRITE_TAC[phi] THEN ASM_CASES_TAC `n = 0` THENL [AP_TERM_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[LT; NOT_LT]; ALL_TAC] THEN ASM_CASES_TAC `n = 1` THENL [SUBGOAL_THEN `({m | 0 < m /\ m <= n /\ coprime (m,n)} = {1}) /\ ({m | coprime (m,n) /\ m < n} = {0})` (CONJUNCTS_THEN SUBST1_TAC) THENL [ALL_TAC; SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY]] THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[COPRIME_1] THEN REPEAT STRIP_TAC THEN ARITH_TAC; ALL_TAC] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[LT] THENL [ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]; ASM_MESON_TAC[LE_LT; COPRIME_REFL; LT_NZ]]);; let PHI_ANOTHER = prove (`!n. ~(n = 1) ==> (phi(n) = CARD {m | 0 < m /\ m < n /\ coprime(m,n)})`, REPEAT STRIP_TAC THEN REWRITE_TAC[phi] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[LE_LT; COPRIME_REFL; COPRIME_1; LT_NZ]);; let PHI_LIMIT = prove (`!n. phi(n) <= n`, GEN_TAC THEN REWRITE_TAC[PHI_ALT] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_LT] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[FINITE_NUMSEG_LT] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]);; let PHI_LIMIT_STRONG = prove (`!n. ~(n = 1) ==> phi(n) <= n - 1`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]);; let PHI_0 = prove (`phi 0 = 0`, MP_TAC(SPEC `0` PHI_LIMIT) THEN REWRITE_TAC[ARITH] THEN ARITH_TAC);; let PHI_1 = prove (`phi 1 = 1`, REWRITE_TAC[PHI_ALT; COPRIME_1; CARD_NUMSEG_LT]);; let PHI_LOWERBOUND_1_STRONG = prove (`!n. 1 <= n ==> 1 <= phi(n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 = CARD {1}` SUBST1_TAC THENL [SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY; FINITE_RULES; ARITH]; ALL_TAC] THEN REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]]);; let PHI_LOWERBOUND_1 = prove (`!n. 2 <= n ==> 1 <= phi(n)`, MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_TRANS; ARITH_RULE `1 <= 2`]);; let PHI_LOWERBOUND_2 = prove (`!n. 3 <= n ==> 2 <= phi(n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `2 = CARD {1,(n-1)}` SUBST1_TAC THENL [SIMP_TAC[CARD_CLAUSES; IN_INSERT; NOT_IN_EMPTY; FINITE_RULES; ARITH] THEN ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> ~(1 = n - 1)`]; ALL_TAC] THEN REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN ASM_SIMP_TAC[ARITH; ARITH_RULE `3 <= n ==> 0 < n - 1 /\ n - 1 <= n /\ 1 <= n`] THEN REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN MP_TAC(SPEC `n:num` COPRIME_1) THEN REWRITE_TAC[coprime] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `1 = n - (n - 1)` SUBST1_TAC THENL [UNDISCH_TAC `3 <= n` THEN ARITH_TAC; ASM_SIMP_TAC[DIVIDES_SUB]]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]]);; let PHI_PRIME_EQ = prove (`!n. (phi n = n - 1) /\ ~(n = 0) /\ ~(n = 1) <=> prime n`, GEN_TAC THEN REWRITE_TAC[PRIME] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[PHI_1; ARITH] THEN MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `{m | 0 < m /\ m < n /\ coprime (m,n)} = {m | 0 < m /\ m < n}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[COPRIME_SYM] THEN CONV_TAC TAUT] THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC CARD_SUBSET_EQ THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]);; let PHI_PRIME = prove (`!p. prime p ==> phi p = p - 1`, MESON_TAC[PHI_PRIME_EQ]);; (* ------------------------------------------------------------------------- *) (* Fermat's Little theorem. *) (* ------------------------------------------------------------------------- *) let DIFFERENCE_POS_LEMMA = prove (`b <= a /\ (?x1 x2. x1 * n + a = x2 * n + b) ==> ?x. a = x * n + b`, STRIP_TAC THEN EXISTS_TAC `x2 - x1` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN ARITH_TAC);; let ITSET_MODMULT = prove (`!n s. FINITE s /\ ~(n = 0) /\ ~(n = 1) /\ coprime(a,n) ==> (!b. b IN s ==> b < n) ==> (ITSET (\x y. (x * y) MOD n) (IMAGE (\b. (a * b) MOD n) s) 1 = (a EXP (CARD s) * ITSET (\x y. (x * y) MOD n) s 1) MOD n)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `coprime(a,n)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN MP_TAC(ISPECL [`\x y. (x * y) MOD n`; `1`] FINITE_RECURSION) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_SIMP_TAC[MOD_MULT_RMOD] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN STRIP_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES; CARD_CLAUSES; FINITE_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `b:num` THEN X_GEN_TAC `s:num->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_INSERT] THEN REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN ASM_CASES_TAC `!b. b IN s ==> b < n` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `b:num`) THEN REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `~((a * b) MOD n IN IMAGE (\b. (a * b) MOD n) s)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `c:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[GSYM CONG] THEN DISCH_TAC THEN UNDISCH_TAC `~(b:num IN s)` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `b:num = c` (fun th -> ASM_REWRITE_TAC[th]) THEN SUBGOAL_THEN `b MOD n = c MOD n` MP_TAC THENL [ASM_SIMP_TAC[GSYM CONG] THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[MOD_LT]; ALL_TAC] THEN REWRITE_TAC[EXP] THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN REWRITE_TAC[MULT_AC]);; let ITSET_MODMULT_COPRIME = prove (`!n s. FINITE s /\ (!b. b IN s ==> coprime(b,n)) /\ ~(n = 0) ==> coprime(ITSET (\x y. (x * y) MOD n) s 1,n)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN MP_TAC(ISPECL [`\x y. (x * y) MOD n`; `1`] FINITE_RECURSION) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_SIMP_TAC[MOD_MULT_RMOD] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN STRIP_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES; CARD_CLAUSES; FINITE_IMAGE] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN REWRITE_TAC[IN_INSERT] THEN REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `s:num->bool`] THEN ASM_CASES_TAC `!b. b IN s ==> coprime(b,n)` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `x:num`) THEN ASM_SIMP_TAC[COPRIME_MOD; ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_MUL]);; let FERMAT_LITTLE = prove (`!a n. coprime(a,n) ==> (a EXP (phi n) == 1) (mod n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[COPRIME_0; PHI_0; CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[CONG_MOD_1] THEN DISCH_TAC THEN SUBGOAL_THEN `{ c | ?b. 0 < b /\ b < n /\ coprime(b,n) /\ (c = (a * b) MOD n) } = { b | 0 < b /\ b < n /\ coprime(b,n) }` MP_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `c:num` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `b:num` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[DIVISION] THEN MATCH_MP_TAC(TAUT `b /\ (~a ==> ~b) ==> a /\ b`) THEN SIMP_TAC[ARITH_RULE `~(0 < n) <=> (n = 0)`] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[COPRIME_0] THEN SUBGOAL_THEN `coprime(n,a * b)` MP_TAC THENL [MATCH_MP_TAC COPRIME_MUL THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `a * b = (a * b) DIV n * n + (a * b) MOD n` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `n:num`] BEZOUT) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` (X_CHOOSE_THEN `x:num` (X_CHOOSE_THEN `y:num` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)))) THEN SUBGOAL_THEN `d = 1` SUBST_ALL_TAC THENL [ASM_MESON_TAC[coprime]; ALL_TAC] THEN STRIP_TAC THENL [EXISTS_TAC `(c * x) MOD n` THEN MATCH_MP_TAC(TAUT `(~a ==> ~c) /\ b /\ c /\ d ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [SIMP_TAC[ARITH_RULE `~(0 < n) <=> (n = 0)`] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[COPRIME_0]; ALL_TAC] THEN ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL [SUBGOAL_THEN `coprime(n,c * x)` MP_TAC THENL [MATCH_MP_TAC COPRIME_MUL THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[coprime; GSYM DIVIDES_ONE] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[DIVIDES_SUB; DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL]; ALL_TAC] THEN SUBGOAL_THEN `c * x = (c * x) DIV n * n + (c * x) MOD n` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[MOD_MULT_RMOD] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `c * y:num` THEN ASM_REWRITE_TAC[GSYM MULT_ASSOC] THEN ONCE_REWRITE_TAC[ARITH_RULE `(a * c * x = b:num) <=> (c * a * x = b)`] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `(a - b = 1) ==> (a = b + 1)`)) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_CLAUSES; MULT_AC]; EXISTS_TAC `(c * (n - y MOD n)) MOD n` THEN MATCH_MP_TAC(TAUT `(~a ==> ~c) /\ b /\ c /\ d ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [SIMP_TAC[ARITH_RULE `~(0 < n) <=> (n = 0)`] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[COPRIME_0]; ALL_TAC] THEN ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL [SUBGOAL_THEN `coprime(n,c * (n - y MOD n))` MP_TAC THENL [MATCH_MP_TAC COPRIME_MUL THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[coprime; GSYM DIVIDES_ONE] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN X_GEN_TAC `e:num` THEN STRIP_TAC THEN MATCH_MP_TAC DIVIDES_SUB THEN ASM_SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN MATCH_MP_TAC DIVIDES_LMUL THEN SUBGOAL_THEN `y = (y DIV n) * n + y MOD n` SUBST1_TAC THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN MATCH_MP_TAC DIVIDES_ADD THEN ASM_SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN MATCH_MP_TAC DIVIDES_ADD_REVR THEN EXISTS_TAC `n - y MOD n` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ARITH_RULE `m < n ==> ((n - m) + m = n:num)`; DIVISION]; ALL_TAC] THEN SUBGOAL_THEN `!x. c * x = (c * x) DIV n * n + (c * x) MOD n` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[MOD_MULT_RMOD] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_UNIQ THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFFERENCE_POS_LEMMA THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[ARITH_RULE `c <= a * c * x <=> c * 1 <= c * a * x`] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; MULT_EQ_0; SUB_EQ_0; DE_MORGAN_THM] THEN UNDISCH_TAC `coprime(a,n)` THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[COPRIME_0] THEN DISCH_TAC THEN ASM_SIMP_TAC[DIVISION; NOT_LE]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`c * x`; `c * a * (1 + y DIV n)`] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; LEFT_SUB_DISTRIB] THEN MATCH_MP_TAC(ARITH_RULE `y <= n /\ (a + n = x + y) ==> (a + (n - y) = x)`) THEN CONJ_TAC THENL [REWRITE_TAC[MULT_ASSOC] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN ASM_SIMP_TAC[LT_IMP_LE; DIVISION]; ALL_TAC] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[GSYM ADD_ASSOC; GSYM MULT_ASSOC] THEN REWRITE_TAC[ARITH_RULE `(x + a * c * n = c * a * n + y) <=> (x = y)`] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `(n * x - a * y = 1) ==> (x * n = a * y + 1)`)) THEN SUBGOAL_THEN `y = (y DIV n) * n + y MOD n` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[MULT_AC; ADD_AC]]; ALL_TAC] THEN SUBGOAL_THEN `{c | ?b. 0 < b /\ b < n /\ coprime (b,n) /\ (c = (a * b) MOD n)} = IMAGE (\b. (a * b) MOD n) {b | 0 < b /\ b < n /\ coprime (b,n)}` SUBST1_TAC THENL [REWRITE_TAC[IMAGE; EXTENSION; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `ITSET (\x y. (x * y) MOD n)`) THEN DISCH_THEN(MP_TAC o C AP_THM `1`) THEN SUBGOAL_THEN `FINITE {b | 0 < b /\ b < n /\ coprime (b,n)} /\ !b. b IN {b | 0 < b /\ b < n /\ coprime (b,n)} ==> b < n` ASSUME_TAC THENL [CONJ_TAC THENL [ALL_TAC; SIMP_TAC[IN_ELIM_THM]] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | 0 < b /\ b < n}` THEN REWRITE_TAC[REWRITE_RULE[HAS_SIZE] FINITE_NUMBER_SEGMENT] THEN SIMP_TAC[SUBSET; IN_ELIM_THM]; ALL_TAC] THEN ASM_SIMP_TAC[REWRITE_RULE[IMP_IMP] ITSET_MODMULT] THEN ASM_SIMP_TAC[GSYM PHI_ANOTHER] THEN DISCH_THEN(MP_TAC o AP_TERM `(MOD)`) THEN DISCH_THEN(MP_TAC o C AP_THM `n:num`) THEN ASM_SIMP_TAC[MOD_MOD_REFL] THEN ASM_SIMP_TAC[GSYM CONG] THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o RAND_CONV) [ARITH_RULE `x = x * 1`] THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [MULT_SYM] THEN DISCH_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `ITSET (\x y. (x * y) MOD n) {b | 0 < b /\ b < n /\ coprime (b,n)} 1` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ITSET_MODMULT_COPRIME; IN_ELIM_THM]);; let FERMAT_LITTLE_PRIME = prove (`!p a. prime p ==> (a EXP p == a) (mod p)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME) THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN STRIP_TAC THENL [ASM_REWRITE_TAC[EXP_ONE; CONG_REFL]; MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `0` THEN GEN_REWRITE_TAC RAND_CONV [CONG_SYM] THEN ASM_REWRITE_TAC[CONG_0] THEN ASM_MESON_TAC[DIVIDES_EXP; DIVIDES_EXP2; PRIME_0]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FERMAT_LITTLE) THEN ASM_SIMP_TAC[snd(EQ_IMP_RULE (SPEC_ALL PHI_PRIME_EQ))] THEN REWRITE_TAC[cong; nat_mod] THEN DISCH_THEN(X_CHOOSE_THEN `q1:num` (X_CHOOSE_THEN `q2:num` MP_TAC)) THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) a`) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; GSYM(CONJUNCT2 EXP)] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN REWRITE_TAC[MULT_CLAUSES; GSYM MULT_ASSOC] THEN ASM_MESON_TAC[ARITH_RULE `~(p = 0) ==> (SUC(p - 1) = p)`; PRIME_0]);; (* ------------------------------------------------------------------------- *) (* Lucas's theorem. *) (* ------------------------------------------------------------------------- *) let LUCAS_COPRIME_LEMMA = prove (`!m n a. ~(m = 0) /\ (a EXP m == 1) (mod n) ==> coprime(a,n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[CONG_MOD_0; EXP_EQ_1] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN SIMP_TAC[COPRIME_1]; ALL_TAC] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[COPRIME_1] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN ASM_SIMP_TAC[CONG] THEN SUBGOAL_THEN `1 MOD n = 1` SUBST1_TAC THENL [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `d divides (a EXP m) MOD n` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[DIVIDES_ONE]] THEN MATCH_MP_TAC DIVIDES_ADD_REVR THEN EXISTS_TAC `a EXP m DIV n * n` THEN ASM_SIMP_TAC[GSYM DIVISION; DIVIDES_LMUL] THEN SUBGOAL_THEN `m = SUC(m - 1)` SUBST1_TAC THENL [UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; ASM_SIMP_TAC[EXP; DIVIDES_RMUL]]);; let LUCAS_WEAK = prove (`!a n. 2 <= n /\ (a EXP (n - 1) == 1) (mod n) /\ (!m. 0 < m /\ m < n - 1 ==> ~(a EXP m == 1) (mod n)) ==> prime(n)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM PHI_PRIME_EQ; PHI_LIMIT_STRONG; GSYM LE_ANTISYM; ARITH_RULE `2 <= n ==> ~(n = 0) /\ ~(n = 1)`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `phi n`) THEN SUBGOAL_THEN `coprime(a,n)` (fun th -> SIMP_TAC[FERMAT_LITTLE; th]) THENL [MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n - 1 = 0)`]; ALL_TAC] THEN REWRITE_TAC[GSYM NOT_LT] THEN MATCH_MP_TAC(TAUT `a ==> ~(a /\ b) ==> ~b`) THEN ASM_SIMP_TAC[PHI_LOWERBOUND_1; ARITH_RULE `1 <= n ==> 0 < n`]);; let LUCAS = prove (`!a n. 2 <= n /\ (a EXP (n - 1) == 1) (mod n) /\ (!p. prime(p) /\ p divides (n - 1) ==> ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ==> prime(n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `2 <= n ==> ~(n = 0)`)) THEN MATCH_MP_TAC LUCAS_WEAK THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`; GSYM NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `0 < n ==> ~(n = 0)`)) THEN SUBGOAL_THEN `m divides (n - 1)` MP_TAC THENL [REWRITE_TAC[divides] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[GSYM MOD_EQ_0] THEN MATCH_MP_TAC(ARITH_RULE `~(0 < n) ==> (n = 0)`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(n - 1) MOD m`) THEN ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `m:num` THEN ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a EXP ((n - 1) DIV m * m)` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN EXISTS_TAC `m:num` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM EXP_ADD] THEN ASM_SIMP_TAC[GSYM DIVISION] THEN REWRITE_TAC[MULT_CLAUSES] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EXP_EXP] THEN UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN ASM_SIMP_TAC[CONG] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `((a EXP m) MOD n) EXP ((n - 1) DIV m) MOD n` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[MOD_EXP_MOD]] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MOD_EXP_MOD] THEN REWRITE_TAC[EXP_ONE]; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN SUBGOAL_THEN `~(r = 1)` MP_TAC THENL [UNDISCH_TAC `m < m * r` THEN CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[MULT_CLAUSES; LT_REFL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP PRIME_FACTOR) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN STRIP_TAC THEN UNDISCH_TAC `!p. prime p /\ p divides m * r ==> ~(a EXP ((m * r) DIV p) == 1) (mod n)` THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_SIMP_TAC[DIVIDES_LMUL] THEN SUBGOAL_THEN `(m * r) DIV p = m * (r DIV p)` SUBST1_TAC THENL [MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN UNDISCH_TAC `prime p` THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN ASM_SIMP_TAC[ARITH_RULE `~(p = 0) ==> 0 < p`] THEN DISCH_TAC THEN REWRITE_TAC[ADD_CLAUSES; GSYM MULT_ASSOC] THEN AP_TERM_TAC THEN UNDISCH_TAC `p divides r` THEN REWRITE_TAC[divides] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DIV_MULT] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN ASM_SIMP_TAC[CONG] THEN DISCH_THEN(MP_TAC o C AP_THM `r DIV p` o AP_TERM `(EXP)`) THEN DISCH_THEN(MP_TAC o C AP_THM `n:num` o AP_TERM `(MOD)`) THEN ASM_SIMP_TAC[MOD_EXP_MOD] THEN REWRITE_TAC[EXP_EXP; EXP_ONE]);; (* ------------------------------------------------------------------------- *) (* Prime factorizations. *) (* ------------------------------------------------------------------------- *) let primefact = new_definition `primefact ps n <=> (ITLIST (*) ps 1 = n) /\ !p. MEM p ps ==> prime(p)`;; let PRIMEFACT = prove (`!n. ~(n = 0) ==> ?ps. primefact ps n`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THENL [REPEAT DISCH_TAC THEN EXISTS_TAC `[]:num list` THEN REWRITE_TAC[primefact; ITLIST; MEM]; ALL_TAC] THEN DISCH_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o MATCH_MP PRIME_FACTOR) THEN UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN UNDISCH_TAC `~(p * m = 0)` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [ARITH_RULE `n = 1 * n`] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN SUBGOAL_THEN `1 < p` (fun th -> REWRITE_TAC[th]) THENL [MATCH_MP_TAC(ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 1 < p`) THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `prime p` THEN ASM_REWRITE_TAC[PRIME_0; PRIME_1]; ALL_TAC] THEN REWRITE_TAC[primefact] THEN DISCH_THEN(X_CHOOSE_THEN `ps:num list` ASSUME_TAC) THEN EXISTS_TAC `CONS (p:num) ps` THEN ASM_REWRITE_TAC[MEM; ITLIST] THEN ASM_MESON_TAC[]);; let PRIMAFACT_CONTAINS = prove (`!ps n. primefact ps n ==> !p. prime p /\ p divides n ==> MEM p ps`, REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM(SUBST1_TAC o SYM) THEN SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ITLIST; MEM] THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN STRIP_TAC THEN GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN DISCH_THEN(DISJ_CASES_TAC o MATCH_MP PRIME_DIVPROD) THEN ASM_MESON_TAC[prime; PRIME_1]);; let PRIMEFACT_VARIANT = prove (`!ps n. primefact ps n <=> (ITLIST (*) ps 1 = n) /\ ALL prime ps`, REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN AP_TERM_TAC THEN SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; ALL] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Variant of Lucas theorem. *) (* ------------------------------------------------------------------------- *) let LUCAS_PRIMEFACT = prove (`2 <= n /\ (a EXP (n - 1) == 1) (mod n) /\ (ITLIST (*) ps 1 = n - 1) /\ ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps ==> prime n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LUCAS THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `primefact ps (n - 1)` MP_TAC THENL [ASM_REWRITE_TAC[PRIMEFACT_VARIANT] THEN MATCH_MP_TAC ALL_IMP THEN EXISTS_TAC `\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP PRIMAFACT_CONTAINS) THEN X_GEN_TAC `p:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN UNDISCH_TAC `ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps` THEN SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN SIMP_TAC[ALL; MEM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Utility functions. *) (* ------------------------------------------------------------------------- *) let even_num n = mod_num n num_2 =/ num_0;; let odd_num = not o even_num;; (* ------------------------------------------------------------------------- *) (* Least p >= 0 with x <= 2^p. *) (* ------------------------------------------------------------------------- *) let log2 = let rec log2 x y = if x log2 (x -/ num_1) num_0;; (* ------------------------------------------------------------------------- *) (* Raise number to power (x^m) modulo n. *) (* ------------------------------------------------------------------------- *) let rec powermod x m n = if m =/ num_0 then num_1 else let y = powermod x (quo_num m num_2) n in let z = mod_num (y */ y) n in if even_num m then z else mod_num (x */ z) n;; (* ------------------------------------------------------------------------- *) (* Make a call to PARI/GP to factor a number into (probable) primes. *) (* ------------------------------------------------------------------------- *) let factor = let suck_file s = let data = string_of_file s in Sys.remove s; data in let extract_output s = let l0 = explode s in let l0' = rev l0 in let l1 = snd(chop_list(index "]" l0') l0') in let l2 = "["::rev(fst(chop_list(index "[" l1) l1)) in let tm = parse_term (implode l2) in map ((dest_numeral F_F dest_numeral) o dest_pair) (dest_list tm) in fun n -> if n =/ num_1 then [] else let filename = Filename.temp_file "pocklington" ".out" in let s = "echo 'print(factorint(" ^ (string_of_num n) ^ ")) \n quit' | gp >" ^ filename ^ " 2>/dev/null" in if Sys.command s = 0 then let output = suck_file filename in extract_output output else failwith "factor: Call to GP/PARI failed";; (* ------------------------------------------------------------------------- *) (* Alternative giving multiset instead of set plus indices. *) (* ------------------------------------------------------------------------- *) let multifactor = let rec multilist l = if l = [] then [] else let (x,n) = hd l in replicate x (Num.int_of_num n) @ multilist (tl l) in fun n -> multilist (factor n);; (* ------------------------------------------------------------------------- *) (* Recursive creation of Pratt primality certificates. *) (* ------------------------------------------------------------------------- *) type certificate = Prime_2 | Primroot_and_factors of ((num * num list) * num * (num * certificate) list);; let find_primitive_root = let rec find_primitive_root a m ms n = if gcd_num a n =/ num_1 & powermod a m n =/ num_1 & forall (fun k -> powermod a k n <>/ num_1) ms then a else find_primitive_root (a +/ num_1) m ms n in let find_primitive_root_from_2 = find_primitive_root num_2 in fun m ms n -> if n raise Unchanged | (h::t) -> if x =/ h then try uniq x t with Unchanged -> l else x::(uniq h t) in fun l -> if l = [] then [] else uniq (hd l) (tl l);; let setify_num s = let s' = sort (<=/) s in try uniq_num s' with Unchanged -> s';; let certify_prime = let rec cert_prime n = if n <=/ num_2 then if n =/ num_2 then Prime_2 else failwith "certify_prime: not a prime!" else let m = n -/ num_1 in let pfact = multifactor m in let primes = setify_num pfact in let ms = map (fun d -> div_num m d) primes in let a = find_primitive_root m ms n in Primroot_and_factors((n,pfact),a,map (fun n -> n,cert_prime n) primes) in fun n -> if length(multifactor n) = 1 then cert_prime n else failwith "certify_prime: input is not a prime";; (* ------------------------------------------------------------------------- *) (* Relatively efficient evaluation of "(a EXP m == 1) (mod n)". *) (* ------------------------------------------------------------------------- *) let EXP_EQ_MOD_CONV = let pth = prove (`~(n = 0) ==> ((a EXP 0) MOD n = 1 MOD n) /\ ((a EXP (NUMERAL (BIT0 m))) MOD n = let b = (a EXP (NUMERAL m)) MOD n in (b * b) MOD n) /\ ((a EXP (NUMERAL (BIT1 m))) MOD n = let b = (a EXP (NUMERAL m)) MOD n in (a * ((b * b) MOD n)) MOD n)`, DISCH_TAC THEN REWRITE_TAC[EXP] THEN REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN REWRITE_TAC[EXP; EXP_ADD] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN REWRITE_TAC[MULT_ASSOC] THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[MULT_ASSOC] THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD]) and pth_cong = SPEC_ALL CONG and n_tm = `n:num` in let raw_conv tm = let ntm = rand(rand tm) in let th1 = INST [ntm,n_tm] pth_cong in let th2 = EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th1)))) in let th3 = REWR_CONV (MP th1 th2) tm in let th4 = MP (INST [ntm,n_tm] pth) th2 in let th4a,th4b = CONJ_PAIR th4 in let conv_base = GEN_REWRITE_CONV I [th4a] and conv_step = GEN_REWRITE_CONV I [th4b] in let rec conv tm = try conv_base tm with Failure _ -> (conv_step THENC RAND_CONV conv THENC let_CONV THENC NUM_REDUCE_CONV) tm in let th5 = (LAND_CONV conv THENC NUM_REDUCE_CONV) (rand(concl th3)) in TRANS th3 th5 in let gconv_net = itlist (uncurry net_of_conv) [`(a EXP m == 1) (mod n)`,raw_conv] empty_net in REWRITES_CONV gconv_net;; (* ------------------------------------------------------------------------- *) (* HOL checking of such a certificate. We retain a cache for efficiency. *) (* ------------------------------------------------------------------------- *) let prime_theorem_cache = ref [];; let rec lookup_under_num n l = if l = [] then failwith "lookup_under_num" else let h = hd l in if fst h =/ n then snd h else lookup_under_num n (tl l);; let check_certificate = let n_tm = `n:num` and a_tm = `a:num` and ps_tm = `ps:num list` and SIMPLE_REWRITE_CONV = REWRITE_CONV[] and CONJ_AC_SORTED = TAUT `(a /\ a /\ b <=> a /\ b) /\ (a /\ a <=> a)` in let CLEAN_RULE = CONV_RULE (REWRITE_CONV[ITLIST; ALL; CONJ_AC_SORTED] THENC ONCE_DEPTH_CONV NUM_SUB_CONV THENC DEPTH_CONV NUM_MULT_CONV THENC ONCE_DEPTH_CONV NUM_DIV_CONV THENC ONCE_DEPTH_CONV(NUM_EQ_CONV ORELSEC NUM_LE_CONV) THENC SIMPLE_REWRITE_CONV) in let rec check_certificate cert = match cert with Prime_2 -> PRIME_2 | Primroot_and_factors((n,ps),a,ncerts) -> try lookup_under_num n (!prime_theorem_cache) with Failure _ -> let th1 = INST [mk_numeral n,n_tm; mk_flist (map mk_numeral ps),ps_tm; mk_numeral a,a_tm] LUCAS_PRIMEFACT in let th2 = CLEAN_RULE th1 in let th3 = ONCE_DEPTH_CONV EXP_EQ_MOD_CONV (concl th2) in let th4 = CONV_RULE SIMPLE_REWRITE_CONV (EQ_MP th3 th2) in let ants = conjuncts(lhand(concl th4)) in let certs = map (fun t -> lookup_under_num (dest_numeral(rand t)) ncerts) ants in let ths = map check_certificate certs in let fth = MP th4 (end_itlist CONJ ths) in prime_theorem_cache := (n,fth)::(!prime_theorem_cache); fth in check_certificate;; (* ------------------------------------------------------------------------- *) (* Hence a primality-proving rule. *) (* ------------------------------------------------------------------------- *) let PROVE_PRIME = check_certificate o certify_prime;; (* ------------------------------------------------------------------------- *) (* Rule to generate prime factorization theorems. *) (* ------------------------------------------------------------------------- *) let PROVE_PRIMEFACT = let pth = SPEC_ALL PRIMEFACT_VARIANT and start_CONV = PURE_REWRITE_CONV[ITLIST; ALL] THENC NUM_REDUCE_CONV and ps_tm = `ps:num list` and n_tm = `n:num` in fun n -> let pfact = multifactor n in let th1 = INST [mk_flist(map mk_numeral pfact),ps_tm; mk_numeral n,n_tm] pth in let th2 = TRANS th1 (start_CONV(rand(concl th1))) in let ths = map PROVE_PRIME pfact in EQ_MP (SYM th2) (end_itlist CONJ ths);; (* ------------------------------------------------------------------------- *) (* Conversion for truth or falsity of primality assertion. *) (* ------------------------------------------------------------------------- *) let PRIME_TEST = let NOT_PRIME_THM = prove (`((m = 1) <=> F) ==> ((m = p) <=> F) ==> (m * n = p) ==> (prime(p) <=> F)`, MESON_TAC[prime; divides]) and m_tm = `m:num` and n_tm = `n:num` and p_tm = `p:num` in fun tm -> let p = dest_numeral tm in if p =/ Int 0 then EQF_INTRO PRIME_0 else if p =/ Int 1 then EQF_INTRO PRIME_1 else let pfact = multifactor p in if length pfact = 1 then (remark ("proving that " ^ string_of_num p ^ " is prime"); EQT_INTRO(PROVE_PRIME p)) else (remark ("proving that " ^ string_of_num p ^ " is composite"); let m = hd pfact and n = end_itlist ( */ ) (tl pfact) in let th0 = INST [mk_numeral m,m_tm; mk_numeral n,n_tm; mk_numeral p,p_tm] NOT_PRIME_THM in let th1 = MP th0 (NUM_EQ_CONV (lhand(lhand(concl th0)))) in let th2 = MP th1 (NUM_EQ_CONV (lhand(lhand(concl th1)))) in MP th2 (NUM_MULT_CONV(lhand(lhand(concl th2)))));; let PRIME_CONV = let prime_tm = `prime` in fun tm0 -> let ptm,tm = dest_comb tm0 in if ptm <> prime_tm then failwith "expected term of form prime(n)" else PRIME_TEST tm;; (* ------------------------------------------------------------------------- *) (* Example. *) (* ------------------------------------------------------------------------- *) map (time PRIME_TEST o mk_small_numeral) (0--50);; time PRIME_TEST `65535`;; time PRIME_TEST `65536`;; time PRIME_TEST `65537`;; time PROVE_PRIMEFACT (Int 222);; time PROVE_PRIMEFACT (Int 151);; (* ------------------------------------------------------------------------- *) (* The "Landau trick" in Erdos's proof of Chebyshev-Bertrand theorem. *) (* ------------------------------------------------------------------------- *) map (time PRIME_TEST o mk_small_numeral) [3; 5; 7; 13; 23; 43; 83; 163; 317; 631; 1259; 2503; 4001];; hol-light/Library/prime.ml000066400000000000000000002525031303454263000160260ustar00rootroot00000000000000(* ========================================================================= *) (* Basic theory of divisibility, gcd, coprimality and primality (over N). *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* HOL88 compatibility (since all this is a port of old HOL88 stuff). *) (* ------------------------------------------------------------------------- *) let MULT_MONO_EQ = prove (`!m i n. ((SUC n) * m = (SUC n) * i) <=> (m = i)`, REWRITE_TAC[EQ_MULT_LCANCEL; NOT_SUC]);; let LESS_ADD_1 = prove (`!m n. n < m ==> (?p. m = n + (p + 1))`, REWRITE_TAC[LT_EXISTS; ADD1; ADD_ASSOC]);; let LESS_ADD_SUC = ARITH_RULE `!m n. m < (m + (SUC n))`;; let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; let LESS_MONO_ADD = ARITH_RULE `!m n p. m < n ==> (m + p) < (n + p)`;; let LESS_EQ_0 = prove (`!n. n <= 0 <=> (n = 0)`, REWRITE_TAC[LE]);; let LESS_LESS_CASES = ARITH_RULE `!m n. (m = n) \/ m < n \/ n < m`;; let LESS_ADD_NONZERO = ARITH_RULE `!m n. ~(n = 0) ==> m < (m + n)`;; let NOT_EXP_0 = prove (`!m n. ~((SUC n) EXP m = 0)`, REWRITE_TAC[EXP_EQ_0; NOT_SUC]);; let LESS_THM = ARITH_RULE `!m n. m < (SUC n) <=> (m = n) \/ m < n`;; let NOT_LESS_0 = ARITH_RULE `!n. ~(n < 0)`;; let ZERO_LESS_EXP = prove (`!m n. 0 < ((SUC n) EXP m)`, REWRITE_TAC[LT_NZ; NOT_EXP_0]);; (* ------------------------------------------------------------------------- *) (* General arithmetic lemmas. *) (* ------------------------------------------------------------------------- *) let MULT_FIX = prove( `!x y. (x * y = x) <=> (x = 0) \/ (y = 1)`, REPEAT GEN_TAC THEN STRUCT_CASES_TAC(SPEC `x:num` num_CASES) THEN REWRITE_TAC[MULT_CLAUSES; NOT_SUC] THEN REWRITE_TAC[GSYM(el 4 (CONJUNCTS (SPEC_ALL MULT_CLAUSES)))] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM(el 3 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))] THEN MATCH_ACCEPT_TAC MULT_MONO_EQ);; let LESS_EQ_MULT = prove( `!m n p q. m <= n /\ p <= q ==> (m * p) <= (n * q)`, REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o REWRITE_RULE[LE_EXISTS]) THEN ASM_REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]);; let LESS_MULT = prove( `!m n p q. m < n /\ p < q ==> (m * p) < (n * q)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ((CHOOSE_THEN SUBST_ALL_TAC) o MATCH_MP LESS_ADD_1)) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[GSYM ADD1; MULT_CLAUSES; ADD_CLAUSES; GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM (el 3 (CONJUNCTS ADD_CLAUSES))] THEN MATCH_ACCEPT_TAC LESS_ADD_SUC);; let MULT_LCANCEL = prove( `!a b c. ~(a = 0) /\ (a * b = a * c) ==> (b = c)`, REPEAT GEN_TAC THEN STRUCT_CASES_TAC(SPEC `a:num` num_CASES) THEN REWRITE_TAC[NOT_SUC; MULT_MONO_EQ]);; (* ------------------------------------------------------------------------- *) (* Properties of the exponential function. *) (* ------------------------------------------------------------------------- *) let EXP_0 = prove (`!n. 0 EXP (SUC n) = 0`, REWRITE_TAC[EXP; MULT_CLAUSES]);; let EXP_MONO_LT_SUC = prove (`!n x y. (x EXP (SUC n)) < (y EXP (SUC n)) <=> (x < y)`, REWRITE_TAC[EXP_MONO_LT; NOT_SUC]);; let EXP_MONO_LE_SUC = prove (`!x y n. (x EXP (SUC n)) <= (y EXP (SUC n)) <=> x <= y`, REWRITE_TAC[EXP_MONO_LE; NOT_SUC]);; let EXP_MONO_EQ_SUC = prove (`!x y n. (x EXP (SUC n) = y EXP (SUC n)) <=> (x = y)`, REWRITE_TAC[EXP_MONO_EQ; NOT_SUC]);; let EXP_EXP = prove (`!x m n. (x EXP m) EXP n = x EXP (m * n)`, REWRITE_TAC[EXP_MULT]);; (* ------------------------------------------------------------------------- *) (* More ad-hoc arithmetic lemmas unlikely to be useful elsewhere. *) (* ------------------------------------------------------------------------- *) let DIFF_LEMMA = prove( `!a b. a < b ==> (a = 0) \/ (a + (b - a)) < (a + b)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(SPEC `a:num` LESS_0_CASES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN DISJ2_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM (CONJUNCT1 ADD_CLAUSES)] THEN REWRITE_TAC[ADD_ASSOC] THEN REPEAT(MATCH_MP_TAC LESS_MONO_ADD) THEN POP_ASSUM ACCEPT_TAC);; let NOT_EVEN_EQ_ODD = prove( `!m n. ~(2 * m = SUC(2 * n))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN; EVEN_MULT; ARITH]);; let CANCEL_TIMES2 = prove( `!x y. (2 * x = 2 * y) <=> (x = y)`, REWRITE_TAC[num_CONV `2`; MULT_MONO_EQ]);; let EVEN_SQUARE = prove( `!n. EVEN(n) ==> ?x. n EXP 2 = 4 * x`, GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN EXISTS_TAC `m * m` THEN REWRITE_TAC[EXP_2] THEN REWRITE_TAC[SYM(REWRITE_CONV[ARITH] `2 * 2`)] THEN REWRITE_TAC[MULT_AC]);; let ODD_SQUARE = prove( `!n. ODD(n) ==> ?x. n EXP 2 = (4 * x) + 1`, GEN_TAC THEN REWRITE_TAC[ODD_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[GSYM ADD1; SUC_INJ] THEN EXISTS_TAC `(m * m) + m` THEN REWRITE_TAC(map num_CONV [`4`; `3`; `2`; `1`]) THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[ADD_AC]);; let DIFF_SQUARE = prove( `!x y. (x EXP 2) - (y EXP 2) = (x + y) * (x - y)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THENL [SUBGOAL_THEN `(x * x) <= (y * y)` MP_TAC THENL [MATCH_MP_TAC LESS_EQ_MULT THEN ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM SUB_EQ_0] THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES]]; POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN REWRITE_TAC[EXP_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[GSYM ADD_ASSOC; ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [ADD_SYM] THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC MULT_SYM]);; let ADD_IMP_SUB = prove( `!x y z. (x + y = z) ==> (x = z - y)`, REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD_SUB]);; let ADD_SUM_DIFF = prove( `!v w. v <= w ==> ((w + v) - (w - v) = 2 * v) /\ ((w + v) + (w - v) = 2 * w)`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN REWRITE_TAC[MULT_2; GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB; GSYM ADD_ASSOC]);; let EXP_4 = prove( `!n. n EXP 4 = (n EXP 2) EXP 2`, GEN_TAC THEN REWRITE_TAC[EXP_EXP] THEN REWRITE_TAC[ARITH]);; (* ------------------------------------------------------------------------- *) (* Elementary theory of divisibility *) (* ------------------------------------------------------------------------- *) let DIVIDES_0 = prove (`!x. x divides 0`, NUMBER_TAC);; let DIVIDES_ZERO = prove (`!x. 0 divides x <=> (x = 0)`, NUMBER_TAC);; let DIVIDES_1 = prove (`!x. 1 divides x`, NUMBER_TAC);; let DIVIDES_ONE = prove( `!x. (x divides 1) <=> (x = 1)`, GEN_TAC THEN REWRITE_TAC[divides] THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN REWRITE_TAC[MULT_EQ_1] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `1` THEN REFL_TAC);; let DIVIDES_REFL = prove (`!x. x divides x`, NUMBER_TAC);; let DIVIDES_TRANS = prove (`!a b c. a divides b /\ b divides c ==> a divides c`, NUMBER_TAC);; let DIVIDES_ANTISYM = prove (`!x y. x divides y /\ y divides x <=> (x = y)`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (CHOOSE_THEN SUBST1_TAC)) THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM MULT_ASSOC; MULT_FIX; MULT_EQ_1] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[DIVIDES_REFL]]);; let DIVIDES_ADD = prove (`!d a b. d divides a /\ d divides b ==> d divides (a + b)`, NUMBER_TAC);; let DIVIDES_SUB = prove (`!d a b. d divides a /\ d divides b ==> d divides (a - b)`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN (CHOOSE_THEN SUBST1_TAC)) THEN REWRITE_TAC[GSYM LEFT_SUB_DISTRIB] THEN W(EXISTS_TAC o rand o lhs o snd o dest_exists o snd) THEN REFL_TAC);; let DIVIDES_LMUL = prove (`!d a x. d divides a ==> d divides (x * a)`, NUMBER_TAC);; let DIVIDES_RMUL = prove (`!d a x. d divides a ==> d divides (a * x)`, NUMBER_TAC);; let DIVIDES_ADD_REVR = prove (`!d a b. d divides a /\ d divides (a + b) ==> d divides b`, NUMBER_TAC);; let DIVIDES_ADD_REVL = prove (`!d a b. d divides b /\ d divides (a + b) ==> d divides a`, NUMBER_TAC);; let DIVIDES_DIV = prove (`!n x. 0 < n /\ (x MOD n = 0) ==> n divides x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:num` o MATCH_MP DIVISION o MATCH_MP (ARITH_RULE `0 < n ==> ~(n = 0)`)) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `x DIV n` THEN ONCE_REWRITE_TAC[MULT_SYM] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let DIVIDES_MUL_L = prove (`!a b c. a divides b ==> (c * a) divides (c * b)`, NUMBER_TAC);; let DIVIDES_MUL_R = prove (`!a b c. a divides b ==> (a * c) divides (b * c)`, NUMBER_TAC);; let DIVIDES_LMUL2 = prove (`!d a x. (x * d) divides a ==> d divides a`, NUMBER_TAC);; let DIVIDES_RMUL2 = prove (`!d a x. (d * x) divides a ==> d divides a`, NUMBER_TAC);; let DIVIDES_CMUL2 = prove (`!a b c. (c * a) divides (c * b) /\ ~(c = 0) ==> a divides b`, NUMBER_TAC);; let DIVIDES_LMUL2_EQ = prove (`!a b c. ~(c = 0) ==> ((c * a) divides (c * b) <=> a divides b)`, NUMBER_TAC);; let DIVIDES_RMUL2_EQ = prove (`!a b c. ~(c = 0) ==> ((a * c) divides (b * c) <=> a divides b)`, NUMBER_TAC);; let DIVIDES_CASES = prove (`!m n. n divides m ==> m = 0 \/ m = n \/ 2 * n <= m`, SIMP_TAC[ARITH_RULE `m = n \/ 2 * n <= m <=> m = n * 1 \/ n * 2 <= m`] THEN SIMP_TAC[divides; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[MULT_EQ_0; EQ_MULT_LCANCEL; LE_MULT_LCANCEL] THEN ARITH_TAC);; let DIVIDES_LE_STRONG = prove (`!m n. m divides n ==> 1 <= m /\ m <= n \/ n = 0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[DIVIDES_ZERO; ARITH] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let DIVIDES_DIV_NOT = prove( `!n x q r. (x = (q * n) + r) /\ 0 < r /\ r < n ==> ~(n divides x)`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `n:num` DIVIDES_REFL) THEN DISCH_THEN(MP_TAC o SPEC `q:num` o MATCH_MP DIVIDES_LMUL) THEN PURE_REWRITE_TAC[TAUT `a ==> ~b <=> a /\ b ==> F`] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_ADD_REVR) THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[DE_MORGAN_THM; NOT_LE; GSYM LESS_EQ_0]);; let DIVIDES_MUL2 = prove (`!a b c d. a divides b /\ c divides d ==> (a * c) divides (b * d)`, NUMBER_TAC);; let DIVIDES_EXP = prove( `!x y n. x divides y ==> (x EXP n) divides (y EXP n)`, REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN EXISTS_TAC `d EXP n` THEN MATCH_ACCEPT_TAC MULT_EXP);; let DIVIDES_EXP2 = prove( `!n x y. ~(n = 0) /\ (x EXP n) divides y ==> x divides y`, INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; EXP] THEN NUMBER_TAC);; let DIVIDES_EXP_LE = prove (`!p m n. 2 <= p ==> ((p EXP m) divides (p EXP n) <=> m <= n)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[LE_EXP; EXP_EQ_0] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; EXP_ADD] THEN NUMBER_TAC]);; let DIVIDES_TRIVIAL_UPPERBOUND = prove (`!p n. ~(n = 0) /\ 2 <= p ==> ~((p EXP n) divides n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `2 EXP n` THEN REWRITE_TAC[LT_POW2_REFL] THEN UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EXP_MONO_LE_SUC]);; let FACTORIZATION_INDEX = prove (`!n p. ~(n = 0) /\ 2 <= p ==> ?k. (p EXP k) divides n /\ !l. k < l ==> ~((p EXP l) divides n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM NOT_LE; CONTRAPOS_THM] THEN REWRITE_TAC[GSYM num_MAX] THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[EXP; DIVIDES_1]; EXISTS_TAC `n:num` THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP l` THEN SIMP_TAC[LT_POW2_REFL; LT_IMP_LE] THEN SPEC_TAC(`l:num`,`l:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ARITH; CONJUNCT1 EXP; EXP_MONO_LE_SUC]]);; let DIVIDES_FACT = prove (`!n p. 1 <= p /\ p <= n ==> p divides (FACT n)`, INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL [ARITH_TAC; ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL]]);; let DIVIDES_2 = prove( `!n. 2 divides n <=> EVEN(n)`, REWRITE_TAC[divides; EVEN_EXISTS]);; let DIVIDES_REXP_SUC = prove (`!x y n. x divides y ==> x divides (y EXP (SUC n))`, REWRITE_TAC[EXP; DIVIDES_RMUL]);; let DIVIDES_REXP = prove (`!x y n. x divides y /\ ~(n = 0) ==> x divides (y EXP n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[DIVIDES_REXP_SUC]);; let DIVIDES_MOD = prove (`!m n. ~(m = 0) ==> (m divides n <=> (n MOD m = 0))`, REWRITE_TAC[divides] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[MOD_MULT]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN MESON_TAC[MULT_AC]);; let DIVIDES_DIV_MULT = prove (`!m n. m divides n <=> ((n DIV m) * m = n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THENL [ASM_REWRITE_TAC[DIVIDES_ZERO; MULT_CLAUSES; EQ_SYM_EQ]; ALL_TAC] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DIVIDES_LMUL; DIVIDES_REFL]] THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `n DIV m * m + n MOD m` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_MOD; ADD_CLAUSES]; ASM_MESON_TAC[DIVISION]]);; let FINITE_DIVISORS = prove (`!n. ~(n = 0) ==> FINITE {d | d divides n}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{d:num | d <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[DIVIDES_LE]);; let FINITE_SPECIAL_DIVISORS = prove (`!n. ~(n = 0) ==> FINITE {d | P d /\ d divides n}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{d | d divides n}` THEN ASM_SIMP_TAC[FINITE_DIVISORS] THEN SET_TAC[]);; let DIVIDES_DIVIDES_DIV = prove (`!n d. 1 <= n /\ d divides n ==> (e divides (n DIV d) <=> (d * e) divides n)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [DIVIDES_DIV_MULT] THEN ABBREV_TAC `q = n DIV d` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `d = 0` THENL [ASM_SIMP_TAC[MULT_CLAUSES; LE_1]; ASM_MESON_TAC[DIVIDES_LMUL2_EQ; MULT_SYM]]);; let DIVISORS_EQ = prove (`!m n. m = n <=> !d. d divides m <=> d divides n`, REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; let MULTIPLES_EQ = prove (`!m n. m = n <=> !d. m divides d <=> n divides d`, REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; let DIVIDES_NSUM = prove (`!n f s. FINITE s /\ (!i. i IN s ==> n divides (f i)) ==> n divides nsum s f`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[DIVIDES_0; NSUM_CLAUSES; FORALL_IN_INSERT; DIVIDES_ADD]);; (* ------------------------------------------------------------------------- *) (* The Bezout theorem is a bit ugly for N; it'd be easier for Z *) (* ------------------------------------------------------------------------- *) let IND_EUCLID = prove( `!P. (!a b. P a b <=> P b a) /\ (!a. P a 0) /\ (!a b. P a b ==> P a (a + b)) ==> !a b. P a b`, REPEAT STRIP_TAC THEN W(fun (asl,w) -> SUBGOAL_THEN `!n a b. (a + b = n) ==> P a b` MATCH_MP_TAC) THENL [ALL_TAC; EXISTS_TAC `a + b` THEN REFL_TAC] THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC (SPECL [`a:num`; `b:num`] LESS_LESS_CASES) THENL [DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ADD_0] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> SUBST1_TAC(SYM(MATCH_MP SUB_ADD (MATCH_MP LT_IMP_LE th))) THEN DISJ_CASES_THEN MP_TAC (MATCH_MP DIFF_LEMMA th)) THENL [DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM (CONV_TAC o REWR_CONV) THEN FIRST_ASSUM MATCH_ACCEPT_TAC; REWRITE_TAC[ASSUME `a + b = n`] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `a + b - a < n` THEN DISCH_THEN(ANTE_RES_THEN MATCH_MP_TAC); DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (ASSUME `a + b = n`)] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN FIRST_ASSUM (CONV_TAC o REWR_CONV) THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `b + a - b < n` THEN DISCH_THEN(ANTE_RES_THEN MATCH_MP_TAC)] THEN REWRITE_TAC[]);; let BEZOUT_LEMMA = prove( `!a b. (?d x y. (d divides a /\ d divides b) /\ ((a * x = (b * y) + d) \/ (b * x = (a * y) + d))) ==> (?d x y. (d divides a /\ d divides (a + b)) /\ ((a * x = ((a + b) * y) + d) \/ ((a + b) * x = (a * y) + d)))`, REPEAT STRIP_TAC THEN EXISTS_TAC `d:num` THENL [MAP_EVERY EXISTS_TAC [`x + y`; `y:num`]; MAP_EVERY EXISTS_TAC [`x:num`; `x + y`]] THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [MATCH_MP_TAC DIVIDES_ADD; ALL_TAC]) THEN ASM_REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[ADD_ASSOC] THEN DISJ1_TAC THEN REWRITE_TAC[ADD_AC]);; let BEZOUT_ADD = prove( `!a b. ?d x y. (d divides a /\ d divides b) /\ ((a * x = (b * y) + d) \/ (b * x = (a * y) + d))`, W(fun (asl,w) -> MP_TAC(SPEC (list_mk_abs([`a:num`; `b:num`], snd(strip_forall w))) IND_EUCLID)) THEN BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REPEAT (AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN GEN_TAC THEN BETA_TAC) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [DISJ_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [CONJ_SYM] THEN REFL_TAC; GEN_TAC THEN MAP_EVERY EXISTS_TAC [`a:num`; `1`; `0`] THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; DIVIDES_0; DIVIDES_REFL]; MATCH_ACCEPT_TAC BEZOUT_LEMMA]);; let BEZOUT = prove( `!a b. ?d x y. (d divides a /\ d divides b) /\ (((a * x) - (b * y) = d) \/ ((b * x) - (a * y) = d))`, REPEAT GEN_TAC THEN REPEAT_TCL STRIP_THM_THEN ASSUME_TAC (SPECL [`a:num`; `b:num`] BEZOUT_ADD) THEN REPEAT(W(EXISTS_TAC o fst o dest_exists o snd)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]);; (* ------------------------------------------------------------------------- *) (* We can get a stronger version with a nonzeroness assumption. *) (* ------------------------------------------------------------------------- *) let BEZOUT_ADD_STRONG = prove (`!a b. ~(a = 0) ==> ?d x y. d divides a /\ d divides b /\ (a * x = b * y + d)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT_ADD) THEN REWRITE_TAC[TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`] THEN REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `(b ==> a) ==> a \/ b ==> a`) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` (X_CHOOSE_THEN `x:num` (X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC))) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN ASM_CASES_TAC `b = 0` THENL [ASM_SIMP_TAC[MULT_CLAUSES; ADD_EQ_0; MULT_EQ_0; ADD_CLAUSES] THEN STRIP_TAC THEN UNDISCH_TAC `d divides a` THEN ASM_REWRITE_TAC[DIVIDES_ZERO]; ALL_TAC] THEN MP_TAC(SPECL [`d:num`; `b:num`] DIVIDES_LE) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LE_LT] THEN STRIP_TAC THENL [ALL_TAC; DISCH_TAC THEN EXISTS_TAC `b:num` THEN EXISTS_TAC `b:num` THEN EXISTS_TAC `a - 1` THEN UNDISCH_TAC `d divides a` THEN ASM_SIMP_TAC[DIVIDES_REFL] THEN REWRITE_TAC[ARITH_RULE `b * x + b = (x + 1) * b`] THEN ASM_SIMP_TAC[ARITH_RULE `~(a = 0) ==> ((a - 1) + 1 = a)`]] THEN ASM_CASES_TAC `x = 0` THENL [ASM_SIMP_TAC[MULT_CLAUSES; ADD_EQ_0; MULT_EQ_0] THEN STRIP_TAC THEN UNDISCH_TAC `d divides a` THEN ASM_REWRITE_TAC[DIVIDES_ZERO]; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) (b - 1)`) THEN DISCH_THEN(MP_TAC o AP_TERM `(+) (d:num)`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [LEFT_ADD_DISTRIB] THEN REWRITE_TAC[ARITH_RULE `d + bay + b1 * d = (1 + b1) * d + bay`] THEN ASM_SIMP_TAC[ARITH_RULE `~(b = 0) ==> (1 + (b - 1) = b)`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `(a + b = c + d) ==> a <= d ==> (b = (d - a) + c:num)`)) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[AC MULT_AC `(b - 1) * b * x = b * (b - 1) * x`] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `d = d * 1`] THEN MATCH_MP_TAC LE_MULT2 THEN MAP_EVERY UNDISCH_TAC [`d < b:num`; `~(x = 0)`] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> MAP_EVERY EXISTS_TAC [`d:num`; `y * (b - 1)`; `(b - 1) * x - d`] THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [LEFT_SUB_DISTRIB] THEN REWRITE_TAC[MULT_AC]);; (* ------------------------------------------------------------------------- *) (* Greatest common divisor. *) (* ------------------------------------------------------------------------- *) let GCD = prove (`!a b. (gcd(a,b) divides a /\ gcd(a,b) divides b) /\ (!e. e divides a /\ e divides b ==> e divides gcd(a,b))`, NUMBER_TAC);; let DIVIDES_GCD = prove (`!a b d. d divides gcd(a,b) <=> d divides a /\ d divides b`, NUMBER_TAC);; let GCD_UNIQUE = prove( `!d a b. (d divides a /\ d divides b) /\ (!e. e divides a /\ e divides b ==> e divides d) <=> (d = gcd(a,b))`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[GCD] THEN ONCE_REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN ASM_REWRITE_TAC[DIVIDES_GCD] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GCD]);; let GCD_EQ = prove (`(!d. d divides x /\ d divides y <=> d divides u /\ d divides v) ==> gcd(x,y) = gcd(u,v)`, REWRITE_TAC[DIVIDES_GCD; GSYM DIVIDES_ANTISYM] THEN MESON_TAC[GCD]);; let GCD_SYM = prove (`!a b. gcd(a,b) = gcd(b,a)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM GCD_UNIQUE] THEN NUMBER_TAC);; let GCD_ASSOC = prove( `!a b c. gcd(a,gcd(b,c)) = gcd(gcd(a,b),c)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN REWRITE_TAC[DIVIDES_GCD; CONJ_ASSOC; GCD] THEN CONJ_TAC THEN MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `gcd(b,c)` THEN ASM_REWRITE_TAC[GCD]);; let BEZOUT_GCD = prove( `!a b. ?x y. ((a * x) - (b * y) = gcd(a,b)) \/ ((b * x) - (a * y) = gcd(a,b))`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT) THEN DISCH_THEN(EVERY_TCL (map X_CHOOSE_THEN [`d:num`; `x:num`; `y:num`]) (CONJUNCTS_THEN ASSUME_TAC)) THEN SUBGOAL_THEN `d divides gcd(a,b)` MP_TAC THENL [MATCH_MP_TAC(last(CONJUNCTS(SPEC_ALL GCD))) THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN ASM_REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; MULT_ASSOC] THEN FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[]]);; let BEZOUT_GCD_STRONG = prove (`!a b. ~(a = 0) ==> ?x y. a * x = b * y + gcd(a,b)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `b:num` o MATCH_MP BEZOUT_ADD_STRONG) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:num`; `x:num`; `y:num`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `d divides gcd(a,b)` MP_TAC THENL [ASM_MESON_TAC[GCD]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN ASM_REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB; MULT_ASSOC]);; let GCD_LMUL = prove( `!a b c. gcd(c * a, c * b) = c * gcd(a,b)`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC DIVIDES_MUL_L) THEN REWRITE_TAC[GCD] THEN REPEAT STRIP_TAC THEN REPEAT_TCL STRIP_THM_THEN (SUBST1_TAC o SYM) (SPECL [`a:num`; `b:num`] BEZOUT_GCD) THEN REWRITE_TAC[LEFT_SUB_DISTRIB; MULT_ASSOC] THEN MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN MATCH_MP_TAC DIVIDES_RMUL THEN ASM_REWRITE_TAC[]);; let GCD_RMUL = prove( `!a b c. gcd(a * c, b * c) = c * gcd(a,b)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN MATCH_ACCEPT_TAC GCD_LMUL);; let GCD_BEZOUT = prove( `!a b d. (?x y. ((a * x) - (b * y) = d) \/ ((b * x) - (a * y) = d)) <=> gcd(a,b) divides d`, REPEAT GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN POP_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[GCD]; DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN STRIP_ASSUME_TAC(SPECL [`a:num`; `b:num`] BEZOUT_GCD) THEN MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN ASM_REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; MULT_ASSOC] THEN FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[]]);; let GCD_BEZOUT_SUM = prove( `!a b d x y. ((a * x) + (b * y) = d) ==> gcd(a,b) divides d`, REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DIVIDES_ADD THEN CONJ_TAC THEN MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[GCD]);; let GCD_0 = prove (`(!a. gcd(0,a) = a) /\ (!a. gcd(a,0) = a)`, MESON_TAC[GCD_UNIQUE; DIVIDES_0; DIVIDES_REFL]);; let GCD_ZERO = prove( `!a b. (gcd(a,b) = 0) <=> (a = 0) /\ (b = 0)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[GCD_0] THEN MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN ASM_REWRITE_TAC[DIVIDES_ZERO] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; let GCD_REFL = prove( `!a. gcd(a,a) = a`, GEN_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN REWRITE_TAC[DIVIDES_REFL]);; let GCD_1 = prove (`(!a. gcd(1,a) = 1) /\ (!a. gcd(a,1) = 1)`, MESON_TAC[GCD_UNIQUE; DIVIDES_1]);; let GCD_MULTIPLE = prove( `!a b. gcd(b,a * b) = b`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM(el 2 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))] THEN REWRITE_TAC[GCD_RMUL; GCD_1] THEN REWRITE_TAC[MULT_CLAUSES]);; let GCD_ADD = prove (`(!a b. gcd(a + b,b) = gcd(a,b)) /\ (!a b. gcd(b + a,b) = gcd(a,b)) /\ (!a b. gcd(a,a + b) = gcd(a,b)) /\ (!a b. gcd(a,b + a) = gcd(a,b))`, REWRITE_TAC[GSYM GCD_UNIQUE] THEN NUMBER_TAC);; let GCD_SUB = prove (`(!a b. b <= a ==> gcd(a - b,b) = gcd(a,b)) /\ (!a b. a <= b ==> gcd(a,b - a) = gcd(a,b))`, MESON_TAC[SUB_ADD; GCD_ADD]);; let DIVIDES_GCD_LEFT = prove (`!m n:num. m divides n <=> gcd(m,n) = m`, REWRITE_TAC[DIVISORS_EQ; DIVIDES_GCD] THEN MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; let DIVIDES_GCD_RIGHT = prove (`!m n:num. n divides m <=> gcd(m,n) = n`, REWRITE_TAC[DIVISORS_EQ; DIVIDES_GCD] THEN MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; (* ------------------------------------------------------------------------- *) (* Coprimality *) (* ------------------------------------------------------------------------- *) let coprime = prove (`coprime(a,b) <=> !d. d divides a /\ d divides b ==> (d = 1)`, EQ_TAC THENL [REWRITE_TAC[GSYM DIVIDES_ONE]; DISCH_THEN(MP_TAC o SPEC `gcd(a,b)`) THEN REWRITE_TAC[GCD]] THEN NUMBER_TAC);; let COPRIME = prove( `!a b. coprime(a,b) <=> !d. d divides a /\ d divides b <=> (d = 1)`, REPEAT GEN_TAC THEN REWRITE_TAC[coprime] THEN REPEAT(EQ_TAC ORELSE STRIP_TAC) THEN ASM_REWRITE_TAC[DIVIDES_1] THENL [FIRST_ASSUM MATCH_MP_TAC; FIRST_ASSUM(CONV_TAC o REWR_CONV o GSYM) THEN CONJ_TAC] THEN ASM_REWRITE_TAC[]);; let COPRIME_GCD = prove (`!a b. coprime(a,b) <=> (gcd(a,b) = 1)`, REWRITE_TAC[GSYM DIVIDES_ONE] THEN NUMBER_TAC);; let COPRIME_SYM = prove (`!a b. coprime(a,b) <=> coprime(b,a)`, NUMBER_TAC);; let COPRIME_BEZOUT = prove( `!a b. coprime(a,b) <=> ?x y. ((a * x) - (b * y) = 1) \/ ((b * x) - (a * y) = 1)`, REWRITE_TAC[GCD_BEZOUT; DIVIDES_ONE; COPRIME_GCD]);; let COPRIME_DIVPROD = prove (`!d a b. d divides (a * b) /\ coprime(d,a) ==> d divides b`, NUMBER_TAC);; let COPRIME_1 = prove (`!a. coprime(a,1)`, NUMBER_TAC);; let GCD_COPRIME = prove (`!a b a' b'. ~(gcd(a,b) = 0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b) ==> coprime(a',b')`, NUMBER_TAC);; let GCD_COPRIME_EXISTS = prove( `!a b. ~(gcd(a,b) = 0) ==> ?a' b'. (a = a' * gcd(a,b)) /\ (b = b' * gcd(a,b)) /\ coprime(a',b')`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a':num` o GSYM) (X_CHOOSE_TAC `b':num` o GSYM)) THEN MAP_EVERY EXISTS_TAC [`a':num`; `b':num`] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GCD_COPRIME THEN MAP_EVERY EXISTS_TAC [`a:num`; `b:num`] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[]);; let COPRIME_0 = prove (`(!d. coprime(d,0) <=> d = 1) /\ (!d. coprime(0,d) <=> d = 1)`, REWRITE_TAC[GSYM DIVIDES_ONE] THEN NUMBER_TAC);; let COPRIME_MUL = prove (`!d a b. coprime(d,a) /\ coprime(d,b) ==> coprime(d,a * b)`, NUMBER_TAC);; let COPRIME_LMUL2 = prove (`!d a b. coprime(d,a * b) ==> coprime(d,b)`, NUMBER_TAC);; let COPRIME_RMUL2 = prove (`!d a b. coprime(d,a * b) ==> coprime(d,a)`, NUMBER_TAC);; let COPRIME_LMUL = prove (`!d a b. coprime(a * b,d) <=> coprime(a,d) /\ coprime(b,d)`, NUMBER_TAC);; let COPRIME_RMUL = prove (`!d a b. coprime(d,a * b) <=> coprime(d,a) /\ coprime(d,b)`, NUMBER_TAC);; let COPRIME_EXP = prove (`!n a d. coprime(d,a) ==> coprime(d,a EXP n)`, INDUCT_TAC THEN REWRITE_TAC[EXP; COPRIME_1] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC COPRIME_MUL THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let COPRIME_EXP_IMP = prove (`!n a b. coprime(a,b) ==> coprime(a EXP n,b EXP n)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC COPRIME_EXP THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]);; let COPRIME_REXP = prove (`!m n k. coprime(m,n EXP k) <=> coprime(m,n) \/ k = 0`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 EXP; COPRIME_1] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[COPRIME_EXP; NOT_SUC] THEN REWRITE_TAC[EXP] THEN CONV_TAC NUMBER_RULE);; let COPRIME_LEXP = prove (`!m n k. coprime(m EXP k,n) <=> coprime(m,n) \/ k = 0`, ONCE_REWRITE_TAC[COPRIME_SYM] THEN REWRITE_TAC[COPRIME_REXP]);; let COPRIME_EXP2 = prove (`!m n k. coprime(m EXP k,n EXP k) <=> coprime(m,n) \/ k = 0`, REWRITE_TAC[COPRIME_REXP; COPRIME_LEXP; DISJ_ACI]);; let COPRIME_EXP2_SUC = prove (`!n a b. coprime(a EXP (SUC n),b EXP (SUC n)) <=> coprime(a,b)`, REWRITE_TAC[COPRIME_EXP2; NOT_SUC]);; let COPRIME_REFL = prove (`!n. coprime(n,n) <=> (n = 1)`, REWRITE_TAC[COPRIME_GCD; GCD_REFL]);; let COPRIME_PLUS1 = prove (`!n. coprime(n + 1,n)`, NUMBER_TAC);; let COPRIME_MINUS1 = prove (`!n. ~(n = 0) ==> coprime(n - 1,n)`, REPEAT STRIP_TAC THEN SIMP_TAC[coprime] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_SUB) THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - (n - 1) = 1`; DIVIDES_ONE]);; let BEZOUT_GCD_POW = prove( `!n a b. ?x y. (((a EXP n) * x) - ((b EXP n) * y) = gcd(a,b) EXP n) \/ (((b EXP n) * x) - ((a EXP n) * y) = gcd(a,b) EXP n)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = 0` THENL [STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THENL [MAP_EVERY EXISTS_TAC [`1`; `0`] THEN REWRITE_TAC[SUB_0]; REPEAT(EXISTS_TAC `0`) THEN REWRITE_TAC[MULT_CLAUSES; SUB_0]]; MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `b':num` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `a':num` ASSUME_TAC) THEN MP_TAC(SPECL [`a:num`; `b:num`; `a':num`; `b':num`] GCD_COPRIME) THEN RULE_ASSUM_TAC GSYM THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP COPRIME_EXP_IMP) THEN REWRITE_TAC[COPRIME_BEZOUT] THEN DISCH_THEN(X_CHOOSE_THEN `x:num` (X_CHOOSE_THEN `y:num` MP_TAC)) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN DISCH_THEN (MP_TAC o AP_TERM `(*) (gcd(a,b) EXP n)`) THEN REWRITE_TAC[MULT_CLAUSES; LEFT_SUB_DISTRIB] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MAP_EVERY EXISTS_TAC [`x:num`; `y:num`] THEN REWRITE_TAC[MULT_ASSOC; GSYM MULT_EXP] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN ASM_REWRITE_TAC[]]);; let GCD_EXP = prove( `!n a b. gcd(a EXP n,b EXP n) = gcd(a,b) EXP n`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC DIVIDES_EXP THEN REWRITE_TAC[GCD]; MATCH_MP_TAC DIVIDES_EXP THEN REWRITE_TAC[GCD]; X_GEN_TAC `d:num` THEN STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `a:num`; `b:num`] BEZOUT_GCD_POW) THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN (DISJ_CASES_THEN (SUBST1_TAC o SYM))) THEN MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN MATCH_MP_TAC DIVIDES_RMUL THEN ASM_REWRITE_TAC[]]);; let DIVISION_DECOMP = prove( `!a b c. a divides (b * c) ==> ?b' c'. (a = b' * c') /\ b' divides b /\ c' divides c`, REPEAT GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `gcd(a,b)` THEN REWRITE_TAC[GCD] THEN MP_TAC(SPECL [`a:num`; `b:num`] GCD_COPRIME_EXISTS) THEN ASM_CASES_TAC `gcd(a,b) = 0` THENL [ASM_REWRITE_TAC[] THEN EXISTS_TAC `1` THEN RULE_ASSUM_TAC(REWRITE_RULE[GCD_ZERO]) THEN ASM_REWRITE_TAC[MULT_CLAUSES; DIVIDES_1]; ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a':num` (X_CHOOSE_THEN `b':num` (STRIP_ASSUME_TAC o GSYM o ONCE_REWRITE_RULE[MULT_SYM]))) THEN EXISTS_TAC `a':num` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `a divides (b * c)` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM th]) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM th]) THEN REWRITE_TAC[MULT_ASSOC] THEN DISCH_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THEN EXISTS_TAC `b':num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVIDES_CMUL2 THEN EXISTS_TAC `gcd(a,b)` THEN REWRITE_TAC[MULT_ASSOC] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let DIVIDES_EXP2_REV = prove (`!n a b. (a EXP n) divides (b EXP n) /\ ~(n = 0) ==> a divides b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = 0` THENL [ASM_MESON_TAC[GCD_ZERO; DIVIDES_REFL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP GCD_COPRIME_EXISTS) THEN STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[MULT_EXP] THEN ASM_SIMP_TAC[EXP_EQ_0; DIVIDES_RMUL2_EQ] THEN DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE `a divides b ==> coprime(a,b) ==> a divides 1`)) THEN ASM_SIMP_TAC[COPRIME_EXP2; DIVIDES_ONE; DIVIDES_1; EXP_EQ_1]);; let DIVIDES_EXP2_EQ = prove (`!n a b. ~(n = 0) ==> ((a EXP n) divides (b EXP n) <=> a divides b)`, MESON_TAC[DIVIDES_EXP2_REV; DIVIDES_EXP]);; let DIVIDES_MUL = prove (`!m n r. m divides r /\ n divides r /\ coprime(m,n) ==> (m * n) divides r`, NUMBER_TAC);; (* ------------------------------------------------------------------------- *) (* A binary form of the Chinese Remainder Theorem. *) (* ------------------------------------------------------------------------- *) let CHINESE_REMAINDER = prove (`!a b u v. coprime(a,b) /\ ~(a = 0) /\ ~(b = 0) ==> ?x q1 q2. (x = u + q1 * a) /\ (x = v + q2 * b)`, let lemma = prove (`(?d x y. (d = 1) /\ P x y d) <=> (?x y. P x y 1)`, MESON_TAC[]) in REPEAT STRIP_TAC THEN MP_TAC(SPECL [`b:num`; `a:num`] BEZOUT_ADD_STRONG) THEN MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT_ADD_STRONG) THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN SUBGOAL_THEN `!d. d divides a /\ d divides b <=> (d = 1)` (fun th -> REWRITE_TAC[th; ONCE_REWRITE_RULE[CONJ_SYM] th]) THENL [UNDISCH_TAC `coprime(a,b)` THEN SIMP_TAC[GSYM DIVIDES_GCD; COPRIME_GCD; DIVIDES_ONE]; ALL_TAC] THEN REWRITE_TAC[lemma] THEN DISCH_THEN(X_CHOOSE_THEN `x1:num` (X_CHOOSE_TAC `y1:num`)) THEN DISCH_THEN(X_CHOOSE_THEN `x2:num` (X_CHOOSE_TAC `y2:num`)) THEN EXISTS_TAC `v * a * x1 + u * b * x2:num` THEN EXISTS_TAC `v * x1 + u * y2:num` THEN EXISTS_TAC `v * y1 + u * x2:num` THEN CONJ_TAC THENL [SUBST1_TAC(ASSUME `b * x2 = a * y2 + 1`); SUBST1_TAC(ASSUME `a * x1 = b * y1 + 1`)] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]);; (* ------------------------------------------------------------------------- *) (* Primality *) (* ------------------------------------------------------------------------- *) let prime = new_definition `prime(p) <=> ~(p = 1) /\ !x. x divides p ==> (x = 1) \/ (x = p)`;; (* ------------------------------------------------------------------------- *) (* A few useful theorems about primes *) (* ------------------------------------------------------------------------- *) let PRIME_0 = prove( `~prime(0)`, REWRITE_TAC[prime] THEN DISCH_THEN(MP_TAC o SPEC `2` o CONJUNCT2) THEN REWRITE_TAC[DIVIDES_0; ARITH]);; let PRIME_1 = prove( `~prime(1)`, REWRITE_TAC[prime]);; let PRIME_2 = prove( `prime(2)`, REWRITE_TAC[prime; ARITH] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[LE_LT] THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; LESS_THM; NOT_LESS_0] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DIVIDES_ZERO] THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[]);; let PRIME_GE_2 = prove( `!p. prime(p) ==> 2 <= p`, GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; LESS_THM; NOT_LESS_0] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[SYM(num_CONV `1`); PRIME_0; PRIME_1]);; let PRIME_FACTOR = prove( `!n. ~(n = 1) ==> ?p. prime(p) /\ p divides n`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `prime(n)` THENL [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[DIVIDES_REFL]; UNDISCH_TAC `~prime(n)` THEN DISCH_THEN(MP_TAC o REWRITE_RULE[prime]) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN MP_TAC o MATCH_MP DIVIDES_LE) THENL [ASM_REWRITE_TAC[LE_LT] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `2` THEN REWRITE_TAC[PRIME_2; DIVIDES_0]]]);; let PRIME_FACTOR_LT = prove( `!n m p. prime(p) /\ ~(n = 0) /\ (n = p * m) ==> m < n`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ASM_REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN REWRITE_TAC[num_CONV `2`; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN MATCH_MP_TAC LESS_ADD_NONZERO THEN REWRITE_TAC[ADD_EQ_0] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN ASM_REWRITE_TAC[MULT_CLAUSES]);; let PRIME_FACTOR_INDUCT = prove (`!P. P 0 /\ P 1 /\ (!p n. prime p /\ ~(n = 0) /\ P n ==> P(p * n)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY ASM_CASES_TAC [`n = 0`; `n = 1`] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o MATCH_MP PRIME_FACTOR) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o GEN_REWRITE_RULE I [divides]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:num`; `d:num`]) THEN RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[PRIME_FACTOR_LT; MULT_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Infinitude of primes. *) (* ------------------------------------------------------------------------- *) let EUCLID_BOUND = prove (`!n. ?p. prime(p) /\ n < p /\ p <= SUC(FACT n)`, GEN_TAC THEN MP_TAC(SPEC `FACT n + 1` PRIME_FACTOR) THEN SIMP_TAC[ARITH_RULE `0 < n ==> ~(n + 1 = 1)`; ADD1; FACT_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[DIVIDES_ADD_REVR; DIVIDES_ONE; PRIME_1; NOT_LT; PRIME_0; ARITH_RULE `(p = 0) \/ 1 <= p`; DIVIDES_FACT]; ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `~(x + 1 = 0)`]]);; let EUCLID = prove (`!n. ?p. prime(p) /\ p > n`, REWRITE_TAC[GT] THEN MESON_TAC[EUCLID_BOUND]);; let PRIMES_INFINITE = prove (`INFINITE {p | prime p}`, REWRITE_TAC[INFINITE; num_FINITE; IN_ELIM_THM] THEN MESON_TAC[EUCLID; NOT_LE; GT]);; let COPRIME_PRIME = prove( `!p a b. coprime(a,b) ==> ~(prime(p) /\ p divides a /\ p divides b)`, REPEAT GEN_TAC THEN REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `p = 1` SUBST_ALL_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; UNDISCH_TAC `prime 1` THEN REWRITE_TAC[PRIME_1]]);; let COPRIME_PRIME_EQ = prove( `!a b. coprime(a,b) <=> !p. ~(prime(p) /\ p divides a /\ p divides b)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP COPRIME_PRIME th]); CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[coprime] THEN ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(X_CHOOSE_TAC `p:num` o MATCH_MP PRIME_FACTOR) THEN EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `d:num` THEN ASM_REWRITE_TAC[]]);; let PRIME_COPRIME_STRONG = prove (`!n p. prime(p) ==> p divides n \/ coprime(p,n)`, REWRITE_TAC[prime; coprime] THEN MESON_TAC[]);; let PRIME_COPRIME = prove (`!n p. prime(p) ==> (n = 1) \/ p divides n \/ coprime(p,n)`, MESON_TAC[PRIME_COPRIME_STRONG]);; let PRIME_COPRIME_EQ = prove (`!p n. prime p ==> (coprime(p,n) <=> ~(p divides n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(b \/ a) /\ ~(a /\ b) ==> (a <=> ~b)`) THEN ASM_SIMP_TAC[PRIME_COPRIME_STRONG] THEN ASM_MESON_TAC[COPRIME_REFL; PRIME_1; NUMBER_RULE `coprime(p,n) /\ p divides n ==> coprime(p,p)`]);; let COPRIME_PRIMEPOW = prove (`!p k m. prime p /\ ~(k = 0) ==> (coprime(m,p EXP k) <=> ~(p divides m))`, SIMP_TAC[COPRIME_REXP] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN SIMP_TAC[PRIME_COPRIME_EQ]);; let COPRIME_BEZOUT_STRONG = prove (`!a b. coprime(a,b) /\ ~(b = 1) ==> ?x y. a * x = b * y + 1`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_GCD]) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC BEZOUT_GCD_STRONG THEN ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]);; let COPRIME_BEZOUT_ALT = prove (`!a b. coprime(a,b) /\ ~(a = 0) ==> ?x y. a * x = b * y + 1`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_GCD]) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC BEZOUT_GCD_STRONG THEN ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]);; let BEZOUT_PRIME = prove (`!a p. prime p /\ ~(p divides a) ==> ?x y. a * x = p * y + 1`, MESON_TAC[PRIME_COPRIME_STRONG; COPRIME_SYM; COPRIME_BEZOUT_STRONG; PRIME_1]);; let PRIME_DIVPROD = prove (`!p a b. prime(p) /\ p divides (a * b) ==> p divides a \/ p divides b`, MESON_TAC[PRIME_COPRIME_STRONG; COPRIME_DIVPROD]);; let PRIME_DIVPROD_EQ = prove (`!p a b. prime(p) ==> (p divides (a * b) <=> p divides a \/ p divides b)`, MESON_TAC[PRIME_DIVPROD; DIVIDES_LMUL; DIVIDES_RMUL]);; let PRIME_DIVEXP = prove( `!n p x. prime(p) /\ p divides (x EXP n) ==> p divides x`, INDUCT_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[EXP; DIVIDES_ONE] THENL [DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[DIVIDES_1]; DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN DISCH_THEN(DISJ_CASES_TAC o MATCH_MP PRIME_DIVPROD) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; let PRIME_DIVEXP_N = prove( `!n p x. prime(p) /\ p divides (x EXP n) ==> (p EXP n) divides (x EXP n)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PRIME_DIVEXP) THEN MATCH_ACCEPT_TAC DIVIDES_EXP);; let PRIME_DIVEXP_EQ = prove (`!n p x. prime p ==> (p divides x EXP n <=> p divides x /\ ~(n = 0))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[EXP; DIVIDES_ONE] THEN ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_REXP; PRIME_1]);; let PARITY_EXP = prove( `!n x. EVEN(x EXP (SUC n)) = EVEN(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM DIVIDES_2] THEN EQ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[PRIME_2]; REWRITE_TAC[EXP] THEN MATCH_ACCEPT_TAC DIVIDES_RMUL]);; let COPRIME_SOS = prove (`!x y. coprime(x,y) ==> coprime(x * y,(x EXP 2) + (y EXP 2))`, NUMBER_TAC);; let PRIME_IMP_NZ = prove (`!p. prime(p) ==> ~(p = 0)`, MESON_TAC[PRIME_0]);; let DISTINCT_PRIME_COPRIME = prove (`!p q. prime p /\ prime q /\ ~(p = q) ==> coprime(p,q)`, MESON_TAC[prime; coprime; PRIME_1]);; let PRIME_COPRIME_LT = prove (`!x p. prime p /\ 0 < x /\ x < p ==> coprime(x,p)`, REWRITE_TAC[coprime; prime] THEN MESON_TAC[LT_REFL; DIVIDES_LE; NOT_LT; PRIME_0]);; let DIVIDES_PRIME_PRIME = prove (`!p q. prime p /\ prime q ==> (p divides q <=> p = q)`, MESON_TAC[DIVIDES_REFL; DISTINCT_PRIME_COPRIME; PRIME_COPRIME_EQ]);; let DIVIDES_PRIME_EXP_LE = prove (`!p q m n. prime p /\ prime q ==> ((p EXP m) divides (q EXP n) <=> m = 0 \/ p = q /\ m <= n)`, GEN_TAC THEN GEN_TAC THEN REPEAT INDUCT_TAC THEN ASM_SIMP_TAC[EXP; DIVIDES_1; DIVIDES_ONE; MULT_EQ_1; NOT_SUC] THENL [MESON_TAC[PRIME_1; ARITH_RULE `~(SUC m <= 0)`]; ALL_TAC] THEN ASM_CASES_TAC `p:num = q` THEN ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2; GSYM(CONJUNCT2 EXP)] THEN ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_PRIME_PRIME; EXP; DIVIDES_RMUL2]);; let EQ_PRIME_EXP = prove (`!p q m n. prime p /\ prime q ==> (p EXP m = q EXP n <=> m = 0 /\ n = 0 \/ p = q /\ m = n)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM DIVIDES_ANTISYM] THEN ASM_SIMP_TAC[DIVIDES_PRIME_EXP_LE] THEN ARITH_TAC);; let PRIME_ODD = prove (`!p. prime p ==> p = 2 \/ ODD p`, GEN_TAC THEN REWRITE_TAC[prime; GSYM NOT_EVEN; EVEN_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `2`)) THEN REWRITE_TAC[divides; ARITH] THEN MESON_TAC[]);; let DIVIDES_FACT_PRIME = prove (`!p. prime p ==> !n. p divides (FACT n) <=> p <= n`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_0; PRIME_1]; ASM_MESON_TAC[PRIME_DIVPROD_EQ; DIVIDES_LE; NOT_SUC; DIVIDES_REFL; ARITH_RULE `~(p <= n) /\ p <= SUC n ==> p = SUC n`]]);; let EQ_PRIMEPOW = prove (`!p m n. prime p ==> (p EXP m = p EXP n <=> m = n)`, ONCE_REWRITE_TAC[GSYM LE_ANTISYM] THEN SIMP_TAC[LE_EXP; PRIME_IMP_NZ] THEN MESON_TAC[PRIME_1]);; let COPRIME_2 = prove (`(!n. coprime(2,n) <=> ODD n) /\ (!n. coprime(n,2) <=> ODD n)`, GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [COPRIME_SYM] THEN SIMP_TAC[PRIME_COPRIME_EQ; PRIME_2; DIVIDES_2; NOT_EVEN]);; let DIVIDES_EXP_PLUS1 = prove (`!n k. ODD k ==> (n + 1) divides (n EXP k + 1)`, GEN_TAC THEN REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN INDUCT_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[EXP_1; DIVIDES_REFL] THEN REWRITE_TAC[ARITH_RULE `SUC(2 * SUC n) = SUC(2 * n) + 2`] THEN REWRITE_TAC[EXP_ADD; EXP_2] THEN POP_ASSUM MP_TAC THEN NUMBER_TAC);; let DIVIDES_EXP_MINUS1 = prove (`!k n. (n - 1) divides (n EXP k - 1)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [STRUCT_CASES_TAC(SPEC `k:num` num_CASES) THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[DIVIDES_REFL]; REWRITE_TAC[num_divides] THEN ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; LE_1; EXP_EQ_0; ARITH] THEN POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[GSYM INT_OF_NUM_POW] THEN SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[INT_POW] THEN REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC]);; let PRIME_IRREDUCIBLE = prove (`!p. prime p <=> p > 1 /\ !a b. p divides (a * b) ==> p divides a \/ p divides b`, GEN_TAC THEN REWRITE_TAC[ARITH_RULE `p > 1 <=> ~(p = 0) /\ ~(p = 1)`] THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1] THEN EQ_TAC THENL [MESON_TAC[PRIME_DIVPROD]; ASM_REWRITE_TAC[prime]] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [divides] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[DIVIDES_REFL] THEN DISCH_THEN(DISJ_CASES_THEN (MP_TAC o MATCH_MP (MESON[DIVIDES_ANTISYM] `a divides b ==> b divides a ==> a = b`))) THEN SIMP_TAC[DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NUM_RING);; (* ------------------------------------------------------------------------- *) (* One property of coprimality is easier to prove via prime factors. *) (* ------------------------------------------------------------------------- *) let COPRIME_EXP_DIVPROD = prove (`!d n a b. (d EXP n) divides (a * b) /\ coprime(d,a) ==> (d EXP n) divides b`, MESON_TAC[COPRIME_DIVPROD; COPRIME_EXP; COPRIME_SYM]);; let PRIME_COPRIME_CASES = prove (`!p a b. prime p /\ coprime(a,b) ==> coprime(p,a) \/ coprime(p,b)`, MESON_TAC[COPRIME_PRIME; PRIME_COPRIME_EQ]);; let PRIME_DIVPROD_POW = prove (`!n p a b. prime(p) /\ coprime(a,b) /\ (p EXP n) divides (a * b) ==> (p EXP n) divides a \/ (p EXP n) divides b`, MESON_TAC[COPRIME_EXP_DIVPROD; PRIME_COPRIME_CASES; MULT_SYM]);; let EXP_MULT_EXISTS = prove (`!m n p k. ~(m = 0) /\ m EXP k * n = p EXP k ==> ?q. n = q EXP k`, REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN MP_TAC(SPECL [`k:num`; `m:num`; `p:num`] DIVIDES_EXP2_REV) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[divides; MULT_SYM]; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN ASM_REWRITE_TAC[MULT_EXP; GSYM MULT_ASSOC; EQ_MULT_LCANCEL; EXP_EQ_0] THEN MESON_TAC[]);; let COPRIME_POW = prove (`!n a b c. coprime(a,b) /\ a * b = c EXP n ==> ?r s. a = r EXP n /\ b = s EXP n`, GEN_TAC THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[EXP; MULT_EQ_1] THEN MATCH_MP_TAC PRIME_FACTOR_INDUCT THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[EXP_ZERO; MULT_EQ_0] THEN ASM_MESON_TAC[COPRIME_0; EXP_ZERO; COPRIME_0; EXP_ONE]; SIMP_TAC[EXP_ONE; MULT_EQ_1] THEN MESON_TAC[EXP_ONE]; REWRITE_TAC[MULT_EXP] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `p EXP n divides a \/ p EXP n divides b` MP_TAC THENL [ASM_MESON_TAC[PRIME_DIVPROD_POW; divides]; ALL_TAC] THEN REWRITE_TAC[divides] THEN DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_SYM]) THEN ASM_SIMP_TAC[COPRIME_RMUL; COPRIME_LMUL; COPRIME_LEXP; COPRIME_REXP] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`b:num`; `d:num`]); FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `a:num`])] THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [MATCH_MP_TAC(NUM_RING `!p. ~(p = 0) /\ a * p = b * p ==> a = b`) THEN EXISTS_TAC `p EXP n` THEN ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ] THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC NUM_RING; STRIP_TAC THEN ASM_REWRITE_TAC[GSYM MULT_EXP] THEN MESON_TAC[]])]);; (* ------------------------------------------------------------------------- *) (* More useful lemmas. *) (* ------------------------------------------------------------------------- *) let PRIME_EXP = prove (`!p n. prime(p EXP n) <=> prime(p) /\ (n = 1)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; PRIME_1; ARITH_EQ] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`n:num`,`n:num`) THEN ASM_CASES_TAC `p = 0` THENL [ASM_REWRITE_TAC[PRIME_0; EXP; MULT_CLAUSES]; ALL_TAC] THEN INDUCT_TAC THEN REWRITE_TAC[ARITH; EXP_1; EXP; MULT_CLAUSES] THEN REWRITE_TAC[ARITH_RULE `~(SUC(SUC n) = 1)`] THEN REWRITE_TAC[prime; DE_MORGAN_THM] THEN ASM_REWRITE_TAC[MULT_EQ_1; EXP_EQ_1] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MESON_TAC[EXP; divides]; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `p < pn:num ==> ~(p = pn)`) THEN GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN ASM_REWRITE_TAC[LT_EXP; ARITH_EQ] THEN MAP_EVERY UNDISCH_TAC [`~(p = 0)`; `~(p = 1)`] THEN ARITH_TAC);; let PRIME_POWER_MULT = prove (`!k x y p. prime p /\ (x * y = p EXP k) ==> ?i j. (x = p EXP i) /\ (y = p EXP j)`, INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_EQ_1] THENL [MESON_TAC[EXP]; ALL_TAC] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `p divides x \/ p divides y` MP_TAC THENL [ASM_MESON_TAC[PRIME_DIVPROD; divides; MULT_AC]; ALL_TAC] THEN REWRITE_TAC[divides] THEN SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)) THENL [UNDISCH_TAC `(p * d) * y = p * p EXP k`; UNDISCH_TAC `x * p * d = p * p EXP k` THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [MULT_SYM]] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN ASM_REWRITE_TAC[EQ_MULT_LCANCEL] THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `y:num`; `p:num`]); FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `x:num`; `p:num`])] THEN ASM_REWRITE_TAC[] THEN MESON_TAC[EXP]);; let PRIME_POWER_EXP = prove (`!n x p k. prime p /\ ~(n = 0) /\ (x EXP n = p EXP k) ==> ?i. x = p EXP i`, INDUCT_TAC THEN REWRITE_TAC[EXP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[NOT_SUC] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[EXP] THEN ASM_MESON_TAC[PRIME_POWER_MULT]);; let DIVIDES_PRIMEPOW = prove (`!p. prime p ==> !d. d divides (p EXP k) <=> ?i. i <= k /\ d = p EXP i`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:num` THEN DISCH_TAC THEN MP_TAC(SPECL [`k:num`; `d:num`; `e:num`; `p:num`] PRIME_POWER_MULT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN REWRITE_TAC[GSYM EXP_ADD] THEN REWRITE_TAC[GSYM LE_ANTISYM; LE_EXP] THEN REWRITE_TAC[LE_ANTISYM] THEN POP_ASSUM MP_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_SIMP_TAC[PRIME_0] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1; LE_ANTISYM] THEN MESON_TAC[LE_ADD]; REWRITE_TAC[LE_EXISTS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[EXP_ADD] THEN MESON_TAC[DIVIDES_RMUL; DIVIDES_REFL]]);; let PRIMEPOW_DIVIDES_PROD = prove (`!p k m n. prime p /\ (p EXP k) divides (m * n) ==> ?i j. (p EXP i) divides m /\ (p EXP j) divides n /\ k = i + j`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_DECOMP) THEN REWRITE_TAC[NUMBER_RULE `a = b * c <=> b divides a /\ c divides a /\ b * c = a`] THEN ASM_MESON_TAC[EXP_ADD; EQ_PRIMEPOW; DIVIDES_PRIMEPOW]);; let COPRIME_DIVISORS = prove (`!a b d e. d divides a /\ e divides b /\ coprime(a,b) ==> coprime(d,e)`, NUMBER_TAC);; let PRIMEPOW_FACTOR = prove (`!n. 2 <= n ==> ?p k m. prime p /\ 1 <= k /\ coprime(p,m) /\ n = p EXP k * m`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `n:num` PRIME_FACTOR) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[divides; LEFT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k + 1`)) THEN ASM_REWRITE_TAC[ARITH_RULE `k < k + 1`; EXP_ADD; GSYM MULT_ASSOC] THEN ASM_SIMP_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; PRIME_IMP_NZ] THEN REWRITE_TAC[EXP_1; GSYM divides] THEN UNDISCH_TAC `(p:num) divides n` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `k = 0` THEN ASM_SIMP_TAC[EXP; MULT_CLAUSES; LE_1] THEN ASM_MESON_TAC[PRIME_COPRIME_STRONG]);; let PRIMEPOW_DIVISORS_DIVIDES = prove (`!m n. m divides n <=> !p k. prime p /\ p EXP k divides m ==> p EXP k divides n`, REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL [MESON_TAC[DIVIDES_TRANS]; ALL_TAC] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THENL [MP_TAC(SPEC `n:num` EUCLID) THEN REWRITE_TAC[GT] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`p:num`; `1`]) THEN ASM_REWRITE_TAC[EXP_1] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_SIMP_TAC[GSYM NOT_LT; DIVIDES_REFL]; ALL_TAC] THEN ASM_CASES_TAC `m = 1` THEN ASM_REWRITE_TAC[DIVIDES_1] THEN MP_TAC(SPEC `m:num` PRIMEPOW_FACTOR) THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`p:num`; `k:num`; `r:num`] THEN STRIP_TAC THEN DISCH_THEN(fun th -> MP_TAC(SPECL[`p:num`; `k:num`] th) THEN ASM_REWRITE_TAC[NUMBER_RULE `a divides (a * b)`] THEN ASSUME_TAC th) THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `s:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM divides] THEN MATCH_MP_TAC DIVIDES_MUL_L THEN REMOVE_THEN "*" (MP_TAC o SPEC `r:num`) THEN ASM_CASES_TAC `r = 0` THENL [ASM_MESON_TAC[MULT_CLAUSES]; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `q < p * q <=> 1 * q < p * q`] THEN ASM_SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `1 < p <=> ~(p = 0 \/ p = 1)`] THEN REWRITE_TAC[EXP_EQ_0; EXP_EQ_1] THEN ANTS_TAC THENL [ASM_MESON_TAC[PRIME_0; PRIME_1; LE_1]; ALL_TAC] THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY X_GEN_TAC [`q:num`; `l:num`] THEN ASM_CASES_TAC `l = 0` THEN ASM_REWRITE_TAC[EXP; DIVIDES_1] THEN STRIP_TAC THEN ASM_CASES_TAC `q:num = p` THENL [UNDISCH_TAC `coprime(p,r)` THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_SIMP_TAC[DIVIDES_REFL; PRIME_GE_2; ARITH_RULE `2 <= p ==> ~(p = 1)`] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN TRANS_TAC DIVIDES_TRANS `p EXP l` THEN ASM_MESON_TAC[DIVIDES_REXP; DIVIDES_REFL]; FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `l:num`]) THEN ASM_SIMP_TAC[DIVIDES_LMUL] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COPRIME_EXP_DIVPROD)) THEN MATCH_MP_TAC COPRIME_EXP THEN ASM_MESON_TAC[DISTINCT_PRIME_COPRIME]]);; let PRIMEPOW_DIVISORS_EQ = prove (`!m n. m = n <=> !p k. prime p ==> (p EXP k divides m <=> p EXP k divides n)`, MESON_TAC[DIVIDES_ANTISYM; PRIMEPOW_DIVISORS_DIVIDES]);; (* ------------------------------------------------------------------------- *) (* Index of a (usually prime) divisor of a number. *) (* ------------------------------------------------------------------------- *) let FINITE_EXP_LE = prove (`!P p n. 2 <= p ==> FINITE {j | P j /\ p EXP j <= n}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_ELIM_THM; LE_0; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN TRANS_TAC LE_TRANS `p EXP i` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC LE_TRANS `2 EXP i` THEN ASM_SIMP_TAC[EXP_MONO_LE_IMP; LT_POW2_REFL; LT_IMP_LE]);; let FINITE_INDICES = prove (`!P p n. 2 <= p /\ ~(n = 0) ==> FINITE {j | P j /\ p EXP j divides n}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j | P j /\ p EXP j <= n}` THEN ASM_SIMP_TAC[FINITE_EXP_LE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[DIVIDES_LE]);; let index_def = new_definition `index p n = if p <= 1 \/ n = 0 then 0 else CARD {j | 1 <= j /\ p EXP j divides n}`;; let INDEX_0 = prove (`!p. index p 0 = 0`, REWRITE_TAC[index_def]);; let PRIMEPOW_DIVIDES_INDEX = prove (`!n p k. p EXP k divides n <=> n = 0 \/ p = 1 \/ k <= index p n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[INDEX_0; DIVIDES_0; EXP_EQ_0] THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[EXP_ZERO; COND_RAND; COND_RATOR] THEN ASM_SIMP_TAC[LE_0; DIVIDES_1; ARITH; index_def; DIVIDES_ZERO] THEN SIMP_TAC[CONJUNCT1 LE; COND_ID] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[EXP_ONE; DIVIDES_1] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `2 <= p` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:num` THEN STRIP_TAC THEN SUBGOAL_THEN `!k. p EXP k divides n <=> k <= a` ASSUME_TAC THENL [GEN_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[NOT_LE]; ALL_TAC] THEN DISCH_TAC THEN TRANS_TAC DIVIDES_TRANS `p EXP a` THEN ASM_SIMP_TAC[DIVIDES_EXP_LE]; ASM_REWRITE_TAC[GSYM numseg; CARD_NUMSEG_1]]);; let LE_INDEX = prove (`!n p k. k <= index p n <=> (n = 0 \/ p = 1 ==> k = 0) /\ p EXP k divides n`, REPEAT GEN_TAC THEN REWRITE_TAC[PRIMEPOW_DIVIDES_INDEX] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[INDEX_0; CONJUNCT1 LE] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[index_def; ARITH; CONJUNCT1 LE]);; let INDEX_1 = prove (`!p. index p 1 = 0`, GEN_TAC THEN REWRITE_TAC[index_def; ARITH] THEN COND_CASES_TAC THEN REWRITE_TAC[DIVIDES_ONE; EXP_EQ_1] THEN ASM_SIMP_TAC[ARITH_RULE `~(p <= 1) ==> ~(p = 1)`; ARITH_RULE `~(1 <= j /\ j = 0)`; EMPTY_GSPEC; CARD_CLAUSES]);; let INDEX_MUL = prove (`!m n. prime p /\ ~(m = 0) /\ ~(n = 0) ==> index p (m * n) = index p m + index p n`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN SUBGOAL_THEN `~(p = 1)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[LE_REFL] `(!k:num. k <= m ==> k <= n) ==> m <= n`) THEN MP_TAC(SPEC `p:num` PRIMEPOW_DIVIDES_PROD) THEN ASM_REWRITE_TAC[LE_INDEX; MULT_EQ_0] THEN ASM_MESON_TAC[LE_ADD2; LE_INDEX]; ASM_REWRITE_TAC[LE_INDEX; MULT_EQ_0; EXP_ADD] THEN MATCH_MP_TAC DIVIDES_MUL2 THEN ASM_MESON_TAC[LE_INDEX; LE_REFL]]);; let INDEX_EXP = prove (`!p n k. prime p ==> index p (n EXP k) = k * index p n`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[EXP_ZERO; INDEX_0; COND_RAND; COND_RATOR; INDEX_1; MULT_CLAUSES; COND_ID] THEN INDUCT_TAC THEN ASM_SIMP_TAC[INDEX_MUL; EXP_EQ_0; EXP; INDEX_1; MULT_CLAUSES] THEN ARITH_TAC);; let INDEX_FACT = prove (`!p n. prime p ==> index p (FACT n) = nsum(1..n) (\m. index p m)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; NSUM_CLAUSES_NUMSEG; INDEX_1; ARITH] THEN ASM_SIMP_TAC[INDEX_MUL; NOT_SUC; FACT_NZ] THEN ARITH_TAC);; let INDEX_FACT_ALT = prove (`!p n. prime p ==> index p (FACT n) = nsum {j | 1 <= j /\ p EXP j <= n} (\j. n DIV (p EXP j))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INDEX_FACT] THEN SUBGOAL_THEN `~(p = 0) /\ ~(p = 1) /\ 2 <= p /\ ~(p <= 1)` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[index_def; LE_1] THEN TRANS_TAC EQ_TRANS `nsum(1..n) (\m. nsum {j | 1 <= j /\ p EXP j <= n} (\j. if p EXP j divides m then 1 else 0))` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_EQ_NUMSEG THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM NSUM_RESTRICT_SET; IN_ELIM_THM] THEN ASM_SIMP_TAC[NSUM_CONST; FINITE_INDICES; LE_1; MULT_CLAUSES] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[DIVIDES_LE; LE_1; LE_TRANS]; W(MP_TAC o PART_MATCH (lhs o rand) NSUM_SWAP o lhand o snd) THEN ASM_SIMP_TAC[FINITE_NUMSEG; FINITE_EXP_LE] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC NSUM_EQ THEN X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_ELIM_THM; GSYM NSUM_RESTRICT_SET] THEN STRIP_TAC THEN ASM_SIMP_TAC[NSUM_CONST; FINITE_NUMSEG; FINITE_RESTRICT; MULT_CLAUSES] THEN SUBGOAL_THEN `{m | m IN 1..n /\ p EXP j divides m} = IMAGE (\q. p EXP j * q) (1..(n DIV p EXP j))` (fun th -> ASM_SIMP_TAC[CARD_IMAGE_INJ; FINITE_NUMSEG; EQ_MULT_LCANCEL; th; EXP_EQ_0; PRIME_IMP_NZ; CARD_NUMSEG_1]) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG; IN_ELIM_THM; divides] THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `q:num` THEN ASM_CASES_TAC `d = p EXP j * q` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[LE_RDIV_EQ; EXP_EQ_0; PRIME_IMP_NZ; MULT_EQ_0; ARITH_RULE `1 <= x <=> ~(x = 0)`]]);; let INDEX_FACT_UNBOUNDED = prove (`!p n. prime p ==> index p (FACT n) = nsum {j | 1 <= j} (\j. n DIV (p EXP j))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INDEX_FACT_ALT] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC NSUM_SUPERSET THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IMP_CONJ; DIV_EQ_0; EXP_EQ_0; PRIME_IMP_NZ; NOT_LE]);; let PRIMEPOW_DIVIDES_FACT = prove (`!p n k. prime p ==> (p EXP k divides FACT n <=> k <= nsum {j | 1 <= j /\ p EXP j <= n} (\j. n DIV (p EXP j)))`, SIMP_TAC[PRIMEPOW_DIVIDES_INDEX; INDEX_FACT_ALT; FACT_NZ] THEN MESON_TAC[PRIME_1]);; let INDEX_REFL = prove (`!n. index n n = if n <= 1 then 0 else 1`, GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[index_def] THEN ASM_CASES_TAC `n = 0` THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN ONCE_REWRITE_TAC[MESON[EXP_1] `a divides b <=> a divides b EXP 1`] THEN ASM_CASES_TAC `2 <= n` THENL [ALL_TAC; ASM_ARITH_TAC] THEN ASM_SIMP_TAC[DIVIDES_EXP_LE; GSYM numseg; CARD_NUMSEG_1]);; let INDEX_EQ_0 = prove (`!p n. index p n = 0 <=> n = 0 \/ p = 1 \/ ~(p divides n)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 0 <=> ~(1 <= n)`] THEN REWRITE_TAC[LE_INDEX; EXP_1; ARITH] THEN MESON_TAC[]);; let INDEX_TRIVIAL_BOUND = prove (`!n p. index p n <= n`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`n:num`; `p:num`; `n:num`] PRIMEPOW_DIVIDES_INDEX) THEN REWRITE_TAC[index_def] THEN COND_CASES_TAC THEN REWRITE_TAC[LE_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM; NOT_LE]) THEN ASM_SIMP_TAC[ARITH_RULE `1 < p ==> ~(p = 1)`] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN MATCH_MP_TAC(ARITH_RULE `~(m:num <= n) ==> n <= m`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `2 EXP n` THEN REWRITE_TAC[LT_POW2_REFL] THEN MATCH_MP_TAC EXP_MONO_LE_IMP THEN ASM_ARITH_TAC);; let INDEX_DECOMPOSITION = prove (`!n p. ?m. p EXP (index p n) * m = n /\ (n = 0 \/ p = 1 \/ ~(p divides m))`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`n:num`; `p:num`; `index p n`] LE_INDEX) THEN REWRITE_TAC[LE_REFL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [divides]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_THEN(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPECL [`n:num`; `p:num`; `index p n + 1`] LE_INDEX) THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `~(n + 1 <= n)`] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXP_ADD; EXP_1; CONTRAPOS_THM] THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN POP_ASSUM_LIST(K ALL_TAC) THEN NUMBER_TAC);; let INDEX_DECOMPOSITION_PRIME = prove (`!n p. prime p ==> ?m. p EXP (index p n) * m = n /\ (n = 0 \/ coprime(p,m))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `p:num`] INDEX_DECOMPOSITION) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `p = 1` THENL [ASM_MESON_TAC[PRIME_1]; ASM_REWRITE_TAC[]] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PRIME_COPRIME_STRONG]);; (* ------------------------------------------------------------------------- *) (* Least common multiples. *) (* ------------------------------------------------------------------------- *) let lcm = new_definition `lcm(m,n) = if m * n = 0 then 0 else (m * n) DIV gcd(m,n)`;; let LCM_DIVIDES = prove (`!m n d. lcm(m,n) divides d <=> m divides d /\ n divides d`, REPEAT GEN_TAC THEN REWRITE_TAC[lcm] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN REWRITE_TAC[DIVIDES_ZERO] THENL [MESON_TAC[DIVIDES_0]; ALL_TAC] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN REWRITE_TAC[DIVIDES_ZERO] THENL [MESON_TAC[DIVIDES_0]; ALL_TAC] THEN ASM_REWRITE_TAC[MULT_EQ_0] THEN TRANS_TAC EQ_TRANS `(m * n) divides (gcd(m,n) * d)` THEN CONJ_TAC THENL [REWRITE_TAC[divides] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `r:num` THEN TRANS_TAC EQ_TRANS `gcd(m,n) * d = gcd(m,n) * ((m * n) DIV gcd (m,n) * r)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[EQ_MULT_LCANCEL; GCD_ZERO]; AP_TERM_TAC THEN REWRITE_TAC[MULT_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN REWRITE_TAC[GSYM DIVIDES_DIV_MULT]]; ALL_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN NUMBER_TAC);; let LCM = prove (`!m n. m divides lcm(m,n) /\ n divides lcm(m,n) /\ (!d. m divides d /\ n divides d ==> lcm(m,n) divides d)`, REPEAT GEN_TAC THEN SIMP_TAC[LCM_DIVIDES] THEN REWRITE_TAC[lcm] THEN MAP_EVERY ASM_CASES_TAC [`m = 0`; `n = 0`] THEN ASM_REWRITE_TAC[DIVIDES_0; MULT_CLAUSES] THEN ASM_REWRITE_TAC[DIVIDES_ZERO; DIVIDES_REFL; MULT_EQ_0] THEN CONJ_TAC THEN REWRITE_TAC[divides] THENL [EXISTS_TAC `n DIV gcd(m,n)`; EXISTS_TAC `m DIV gcd(m,n)`] THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN ASM_SIMP_TAC[GCD_ZERO; LE_1; ADD_CLAUSES] THEN CONV_TAC SYM_CONV THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [MULT_SYM]] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DIVIDES_DIV_MULT] THEN REPEAT(POP_ASSUM MP_TAC) THEN NUMBER_TAC);; let DIVIDES_LCM = prove (`!m n r. r divides m \/ r divides n ==> r divides lcm(m,n)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] DIVIDES_TRANS)) THEN ASM_MESON_TAC[LCM]);; let LCM_0 = prove (`(!n. lcm(0,n) = 0) /\ (!n. lcm(n,0) = 0)`, REWRITE_TAC[lcm; MULT_CLAUSES] THEN ARITH_TAC);; let LCM_1 = prove (`(!n. lcm(1,n) = n) /\ (!n. lcm(n,1) = n)`, SIMP_TAC[lcm; MULT_CLAUSES; GCD_1; DIV_1] THEN MESON_TAC[]);; let LCM_SYM = prove (`!m n. lcm(m,n) = lcm(n,m)`, REWRITE_TAC[lcm; MULT_SYM; GCD_SYM; ARITH_RULE `MAX m n = MAX n m`]);; let DIVIDES_LCM_GCD = prove (`!m n d. d divides lcm(m,n) <=> d * gcd(m,n) divides m * n`, REPEAT GEN_TAC THEN REWRITE_TAC[lcm] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIVIDES_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN MP_TAC(NUMBER_RULE `gcd(m,n) divides m * n`) THEN SIMP_TAC[divides; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[GSYM divides] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`m:num`; `n:num`] GCD_ZERO) THEN ASM_SIMP_TAC[DIV_MULT] THEN CONV_TAC NUMBER_RULE);; let PRIMEPOW_DIVIDES_LCM = prove (`!m n p k. prime p ==> (p EXP k divides lcm(m,n) <=> p EXP k divides m \/ p EXP k divides n)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [STRIP_TAC; MESON_TAC[DIVIDES_LCM]] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[LCM_0; DIVIDES_0] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LCM_0; DIVIDES_0] THEN MP_TAC(SPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN MP_TAC(SPECL [`m:num`; `p:num`] FACTORIZATION_INDEX) THEN ASM_SIMP_TAC[PRIME_GE_2; LEFT_IMP_EXISTS_THM; divides; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num`; `q:num`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`b:num`; `r:num`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM divides] THEN UNDISCH_TAC `p EXP k divides lcm (m,n)` THEN ASM_REWRITE_TAC[DIVIDES_LCM_GCD] THEN SUBGOAL_THEN `gcd(p EXP a * q,p EXP b * r) = p EXP (MIN a b) * gcd(p EXP (a - MIN a b) * q,p EXP (b - MIN a b) * r)` SUBST1_TAC THENL [REWRITE_TAC[GSYM GCD_LMUL; MULT_ASSOC; GSYM EXP_ADD] THEN AP_TERM_TAC THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ARITH_TAC; REWRITE_TAC[MULT_ASSOC; GSYM EXP_ADD]] THEN DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE `a * b divides c ==> a divides c`)) THEN REWRITE_TAC[ARITH_RULE `((a * b) * c) * d:num = (a * c) * b * d`] THEN REWRITE_TAC[GSYM EXP_ADD] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] (ONCE_REWRITE_RULE[MULT_SYM] COPRIME_EXP_DIVPROD))) THEN ANTS_TAC THENL [MATCH_MP_TAC COPRIME_MUL THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[PRIME_COPRIME_STRONG] `prime p /\ ~(p divides n) ==> coprime(p,n)`) THEN ASM_REWRITE_TAC[divides] THEN STRIP_TAC THENL [UNDISCH_TAC `!l. a < l ==> ~(?x. m = p EXP l * x)` THEN DISCH_THEN(MP_TAC o SPEC `a + 1`); UNDISCH_TAC `!l. b < l ==> ~(?x. n = p EXP l * x)` THEN DISCH_THEN(MP_TAC o SPEC `b + 1`)] THEN ASM_REWRITE_TAC[ARITH_RULE `a < a + 1`; EXP_ADD; EXP_1] THEN MESON_TAC[MULT_AC]; ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `k + MIN a b <= a + b ==> k <= a \/ k <= b`)) THEN MATCH_MP_TAC MONO_OR THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVIDES_RMUL THEN ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2]]);; let LCM_ZERO = prove (`!m n. lcm(m,n) = 0 <=> m = 0 \/ n = 0`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [MULTIPLES_EQ] THEN REWRITE_TAC[LCM_DIVIDES; DIVIDES_ZERO] THEN MAP_EVERY ASM_CASES_TAC [`m = 0`; `n = 0`] THEN ASM_REWRITE_TAC[DIVIDES_ZERO] THEN ASM_MESON_TAC[DIVIDES_REFL; MULT_EQ_0; DIVIDES_LMUL; DIVIDES_RMUL]);; let LCM_ASSOC = prove (`!m n p. lcm(m,lcm(n,p)) = lcm(lcm(m,n),p)`, REPEAT GEN_TAC THEN REWRITE_TAC[MULTIPLES_EQ] THEN REWRITE_TAC[LCM_DIVIDES] THEN X_GEN_TAC `q:num` THEN REWRITE_TAC[LCM_ZERO] THEN CONV_TAC TAUT);; let LCM_REFL = prove (`!n. lcm(n,n) = n`, REWRITE_TAC[lcm; GCD_REFL; MULT_EQ_0; ARITH_RULE `MAX n n = n`] THEN SIMP_TAC[DIV_MULT] THEN MESON_TAC[]);; let LCM_MULTIPLE = prove (`!a b. lcm(b,a * b) = a * b`, REWRITE_TAC[MULTIPLES_EQ; LCM_DIVIDES] THEN NUMBER_TAC);; let LCM_GCD_DISTRIB = prove (`!a b c. lcm(a,gcd(b,c)) = gcd(lcm(a,b),lcm(a,c))`, REWRITE_TAC[PRIMEPOW_DIVISORS_EQ] THEN SIMP_TAC[PRIMEPOW_DIVIDES_LCM; DIVIDES_GCD] THEN CONV_TAC TAUT);; let GCD_LCM_DISTRIB = prove (`!a b c. gcd(a,lcm(b,c)) = lcm(gcd(a,b),gcd(a,c))`, REWRITE_TAC[PRIMEPOW_DIVISORS_EQ] THEN SIMP_TAC[PRIMEPOW_DIVIDES_LCM; DIVIDES_GCD] THEN CONV_TAC TAUT);; let LCM_UNIQUE = prove (`!d m n. m divides d /\ n divides d /\ (!e. m divides e /\ n divides e ==> d divides e) <=> d = lcm(m,n)`, REWRITE_TAC[MULTIPLES_EQ; LCM_DIVIDES] THEN MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; let LCM_EQ = prove (`!x y u v. (!d. x divides d /\ y divides d <=> u divides d /\ v divides d) ==> lcm(x,y) = lcm(u,v)`, SIMP_TAC[MULTIPLES_EQ; LCM_DIVIDES]);; let LCM_LMUL = prove (`!a b c. lcm(c * a,c * b) = c * lcm(a,b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LCM_0] THEN ASM_REWRITE_TAC[lcm; GCD_LMUL; MULT_EQ_0; DISJ_ACI] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN ASM_SIMP_TAC[GSYM MULT_ASSOC; DIV_MULT2; MULT_EQ_0; GCD_ZERO] THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN ASM_SIMP_TAC[ADD_CLAUSES; LE_1; GCD_ZERO] THEN ONCE_REWRITE_TAC[ARITH_RULE `a * c * b:num = (c * d) * g <=> c * d * g = c * a * b`] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DIVIDES_DIV_MULT] THEN CONV_TAC NUMBER_RULE);; let LCM_RMUL = prove (`!a b c. lcm(a * c,b * c) = c * lcm(a,b)`, MESON_TAC[LCM_LMUL; MULT_SYM]);; let LCM_EXP = prove (`!n a b. lcm(a EXP n,b EXP n) = lcm(a,b) EXP n`, REPEAT GEN_TAC THEN REWRITE_TAC[lcm] THEN REWRITE_TAC[MULT_EQ_0; EXP_EQ_0] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[EXP; GCD_REFL; DIV_1; MULT_CLAUSES] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[num_CASES; EXP_0]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN REWRITE_TAC[GCD_EXP; GSYM MULT_EXP] THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN ASM_SIMP_TAC[ADD_CLAUSES; LE_1; GCD_ZERO; EXP_EQ_0] THEN REWRITE_TAC[GSYM MULT_EXP] THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM DIVIDES_DIV_MULT] THEN CONV_TAC NUMBER_RULE);; (* ------------------------------------------------------------------------- *) (* Induction principle for multiplicative functions etc. *) (* ------------------------------------------------------------------------- *) let INDUCT_COPRIME = prove (`!P. (!a b. 1 < a /\ 1 < b /\ coprime(a,b) /\ P a /\ P b ==> P(a * b)) /\ (!p k. prime p ==> P(p EXP k)) ==> !n. 1 < n ==> P n`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 1)`)) THEN DISCH_THEN(X_CHOOSE_TAC `p:num` o MATCH_MP PRIME_FACTOR) THEN MP_TAC(SPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE `1 < n ==> ~(n = 0)`] THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_CASES_TAC `m = 1` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 MATCH_MP_TAC MP_TAC) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(TAUT `!p. (a /\ b /\ ~p) /\ c /\ (a /\ ~p ==> b ==> d) ==> a /\ b /\ c /\ d`) THEN EXISTS_TAC `m = 0` THEN SUBGOAL_THEN `~(k = 0)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `0 < 1`)) THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[EXP; EXP_1; MULT_CLAUSES; divides]; ALL_TAC] THEN CONJ_TAC THENL [UNDISCH_TAC `1 < p EXP k * m` THEN ASM_REWRITE_TAC[ARITH_RULE `1 < x <=> ~(x = 0) /\ ~(x = 1)`] THEN ASM_REWRITE_TAC[EXP_EQ_0; EXP_EQ_1; MULT_EQ_0; MULT_EQ_1] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2 o CONJUNCT1) THEN ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `k < k + 1`)) THEN REWRITE_TAC[EXP_ADD; EXP_1; GSYM MULT_ASSOC; EQ_MULT_LCANCEL] THEN ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ; GSYM divides] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN ASM_MESON_TAC[PRIME_COPRIME; COPRIME_SYM]; DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `m = 1 * m`] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL]]);; let INDUCT_COPRIME_STRONG = prove (`!P. (!a b. 1 < a /\ 1 < b /\ coprime(a,b) /\ P a /\ P b ==> P(a * b)) /\ (!p k. prime p /\ ~(k = 0) ==> P(p EXP k)) ==> !n. 1 < n ==> P n`, GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `a ==> b <=> a ==> a ==> b`] THEN MATCH_MP_TAC INDUCT_COPRIME THEN CONJ_TAC THENL [ASM_MESON_TAC[]; MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[LT_REFL; EXP] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A conversion for divisibility. *) (* ------------------------------------------------------------------------- *) let DIVIDES_CONV = let pth_0 = SPEC `b:num` DIVIDES_ZERO and pth_1 = prove (`~(a = 0) ==> (a divides b <=> (b MOD a = 0))`, REWRITE_TAC[DIVIDES_MOD]) and a_tm = `a:num` and b_tm = `b:num` and zero_tm = `0` and dest_divides = dest_binop `(divides)` in fun tm -> let a,b = dest_divides tm in if a = zero_tm then CONV_RULE (RAND_CONV NUM_EQ_CONV) (INST [b,b_tm] pth_0) else let th1 = INST [a,a_tm; b,b_tm] pth_1 in let th2 = MP th1 (EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th1))))) in CONV_RULE (RAND_CONV (LAND_CONV NUM_MOD_CONV THENC NUM_EQ_CONV)) th2;; (* ------------------------------------------------------------------------- *) (* A conversion for coprimality. *) (* ------------------------------------------------------------------------- *) let COPRIME_CONV = let pth_yes_l = prove (`(m * x = n * y + 1) ==> (coprime(m,n) <=> T)`, MESON_TAC[coprime; DIVIDES_RMUL; DIVIDES_ADD_REVR; DIVIDES_ONE]) and pth_yes_r = prove (`(m * x = n * y + 1) ==> (coprime(n,m) <=> T)`, MESON_TAC[coprime; DIVIDES_RMUL; DIVIDES_ADD_REVR; DIVIDES_ONE]) and pth_no = prove (`(m = x * d) /\ (n = y * d) /\ ~(d = 1) ==> (coprime(m,n) <=> F)`, REWRITE_TAC[coprime; divides] THEN MESON_TAC[MULT_AC]) and pth_oo = prove (`coprime(0,0) <=> F`, MESON_TAC[coprime; DIVIDES_REFL; NUM_REDUCE_CONV `1 = 0`]) and m_tm = `m:num` and n_tm = `n:num` and x_tm = `x:num` and y_tm = `y:num` and d_tm = `d:num` and coprime_tm = `coprime` in let rec bezout (m,n) = if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0) else if m <=/ n then let q = quo_num n m and r = mod_num n m in let (x,y) = bezout(m,r) in (x -/ q */ y,y) else let (x,y) = bezout(n,m) in (y,x) in fun tm -> let pop,ptm = dest_comb tm in if pop <> coprime_tm then failwith "COPRIME_CONV" else let l,r = dest_pair ptm in let m = dest_numeral l and n = dest_numeral r in if m =/ Int 0 && n =/ Int 0 then pth_oo else let (x,y) = bezout(m,n) in let d = x */ m +/ y */ n in let th = if d =/ Int 1 then if x >/ Int 0 then INST [l,m_tm; r,n_tm; mk_numeral x,x_tm; mk_numeral(minus_num y),y_tm] pth_yes_l else INST [r,m_tm; l,n_tm; mk_numeral(minus_num x),y_tm; mk_numeral y,x_tm] pth_yes_r else INST [l,m_tm; r,n_tm; mk_numeral d,d_tm; mk_numeral(m // d),x_tm; mk_numeral(n // d),y_tm] pth_no in MP th (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th))));; (* ------------------------------------------------------------------------- *) (* More general (slightly less efficiently coded) GCD_CONV, and LCM_CONV. *) (* ------------------------------------------------------------------------- *) let GCD_CONV = let pth0 = prove(`gcd(0,0) = 0`,REWRITE_TAC[GCD_0]) in let pth1 = prove (`!m n x y d m' n'. (m * x = n * y + d) /\ (m = m' * d) /\ (n = n' * d) ==> (gcd(m,n) = d)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[GSYM GCD_UNIQUE] THEN ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_ADD_REVR; DIVIDES_REFL]) in let pth2 = prove (`!m n x y d m' n'. (n * y = m * x + d) /\ (m = m' * d) /\ (n = n' * d) ==> (gcd(m,n) = d)`, MESON_TAC[pth1; GCD_SYM]) in let gcd_tm = `gcd` in let rec bezout (m,n) = if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0) else if m <=/ n then let q = quo_num n m and r = mod_num n m in let (x,y) = bezout(m,r) in (x -/ q */ y,y) else let (x,y) = bezout(n,m) in (y,x) in fun tm -> let gt,lr = dest_comb tm in if gt <> gcd_tm then failwith "GCD_CONV" else let mtm,ntm = dest_pair lr in let m = dest_numeral mtm and n = dest_numeral ntm in if m =/ Int 0 && n =/ Int 0 then pth0 else let x0,y0 = bezout(m,n) in let x = abs_num x0 and y = abs_num y0 in let xtm = mk_numeral x and ytm = mk_numeral y in let d = abs_num(x */ m -/ y */ n) in let dtm = mk_numeral d in let m' = m // d and n' = n // d in let mtm' = mk_numeral m' and ntm' = mk_numeral n' in let th = SPECL [mtm;ntm;xtm;ytm;dtm;mtm';ntm'] (if m */ x =/ n */ y +/ d then pth1 else pth2) in MP th (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th))));; let LCM_CONV = GEN_REWRITE_CONV I [lcm] THENC RATOR_CONV(LAND_CONV(LAND_CONV NUM_MULT_CONV THENC NUM_EQ_CONV)) THENC (GEN_REWRITE_CONV I [CONJUNCT1(SPEC_ALL COND_CLAUSES)] ORELSEC (GEN_REWRITE_CONV I [CONJUNCT2(SPEC_ALL COND_CLAUSES)] THENC COMB2_CONV (RAND_CONV NUM_MULT_CONV) GCD_CONV THENC NUM_DIV_CONV));; hol-light/Library/primitive.ml000066400000000000000000001142471303454263000167240ustar00rootroot00000000000000(* ========================================================================= *) (* Existence of primitive roots modulo certain numbers. *) (* ========================================================================= *) needs "Library/integer.ml";; needs "Library/isum.ml";; needs "Library/binomial.ml";; needs "Library/pocklington.ml";; needs "Library/multiplicative.ml";; (* ------------------------------------------------------------------------- *) (* Some lemmas connecting concepts in the various background theories. *) (* ------------------------------------------------------------------------- *) let DIVIDES_BINOM_PRIME = prove (`!n p. prime p /\ 0 < n /\ n < p ==> p divides binom(p,n)`, REPEAT STRIP_TAC THEN MP_TAC(AP_TERM `(divides) p` (SPECL [`p - n:num`; `n:num`] BINOM_FACT)) THEN ASM_SIMP_TAC[DIVIDES_FACT_PRIME; PRIME_DIVPROD_EQ; SUB_ADD; LT_IMP_LE] THEN ASM_REWRITE_TAC[GSYM NOT_LT; LT_REFL] THEN ASM_SIMP_TAC[ARITH_RULE `0 < n /\ n < p ==> p - n < p`]);; let INT_PRIME = prove (`!p. int_prime(&p) <=> prime p`, GEN_TAC THEN REWRITE_TAC[prime; int_prime] THEN ONCE_REWRITE_TAC[GSYM INT_DIVIDES_LABS] THEN REWRITE_TAC[GSYM INT_FORALL_ABS; GSYM num_divides; INT_ABS_NUM] THEN REWRITE_TAC[INT_OF_NUM_GT; INT_OF_NUM_EQ] THEN ASM_CASES_TAC `p = 0` THENL [ASM_REWRITE_TAC[ARITH; DIVIDES_0] THEN DISCH_THEN(MP_TAC o SPEC `2`); AP_THM_TAC THEN AP_TERM_TAC] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Explicit formula for difference of real/integer polynomials. *) (* ------------------------------------------------------------------------- *) let REAL_POLY_DIFF_EXPLICIT = prove (`!n a x y. sum(0..n) (\i. a(i) * x pow i) - sum(0..n) (\i. a(i) * y pow i) = (x - y) * sum(0..n-1) (\i. sum(i+1..n) (\j. a j * y pow (j - 1 - i)) * x pow i)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG; GSYM REAL_SUB_LDISTRIB] THEN MP_TAC(ISPEC `n:num` LE_0) THEN SIMP_TAC[SUM_CLAUSES_LEFT; ADD_CLAUSES] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_LID; real_pow] THEN SIMP_TAC[REAL_SUB_POW] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = b * a * c`] THEN REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL; SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN REPEAT(EXISTS_TAC `\(a:num,b:num). (b,a)`) THEN REWRITE_TAC[IN_ELIM_PAIR_THM; FORALL_PAIR_THM; REAL_MUL_AC] THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; let INT_POLY_DIFF_EXPLICIT = INT_OF_REAL_THM REAL_POLY_DIFF_EXPLICIT;; (* ------------------------------------------------------------------------- *) (* Lagrange's theorem on number of roots modulo a prime. *) (* ------------------------------------------------------------------------- *) let FINITE_INTSEG_RESTRICT = prove (`!P a b. FINITE {x:int | a <= x /\ x <= b /\ P x}`, SIMP_TAC[FINITE_RESTRICT; FINITE_INTSEG; SET_RULE `{x | P x /\ Q x /\ R x} = {x | x IN {x | P x /\ Q x} /\ R x}`]);; let INT_POLY_LAGRANGE = prove (`!p l r. int_prime p /\ r - l < p ==> !n a. ~(!i. i <= n ==> (a i == &0) (mod p)) ==> CARD {x | l <= x /\ x <= r /\ (isum(0..n) (\i. a(i) * x pow i) == &0) (mod p)} <= n`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[INT_CONG_0_DIVIDES] THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `!a. (~(s = a) ==> CARD s <= n) /\ CARD a <= n ==> CARD s <= n`) THEN EXISTS_TAC `{}:int->bool` THEN REWRITE_TAC[LE_0; CARD_CLAUSES] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `c:int` THEN STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [MAP_EVERY UNDISCH_TAC [`~(!i:num. i <= n ==> (p:int) divides (a i))`; `p divides (isum (0..n) (\i. a i * c pow i))`] THEN ASM_SIMP_TAC[CONJUNCT1 LE; ISUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[INT_POW; LEFT_FORALL_IMP_THM; EXISTS_REFL; INT_MUL_RID] THEN CONV_TAC TAUT; ALL_TAC] THEN ASM_CASES_TAC `p divides ((a:num->int) n)` THENL [ASM_SIMP_TAC[ISUM_CLAUSES_RIGHT; LE_0; LE_1] THEN ASM_SIMP_TAC[INTEGER_RULE `(p:int) divides y ==> (p divides (x + y * z) <=> p divides x)`] THEN MATCH_MP_TAC(ARITH_RULE `x <= n - 1 ==> x <= n`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ASM_REWRITE_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[ARITH_RULE `i <= n <=> i <= n - 1 \/ i = n`]; ALL_TAC] THEN MP_TAC(GEN `x:int` (MATCH_MP (INTEGER_RULE `a - b:int = c ==> p divides b ==> (p divides a <=> p divides c)`) (ISPECL [`n:num`; `a:num->int`; `x:int`; `c:int`] INT_POLY_DIFF_EXPLICIT))) THEN ASM_SIMP_TAC[INT_PRIME_DIVPROD_EQ] THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[LEFT_OR_DISTRIB; SET_RULE `{x | q x \/ r x} = {x | q x} UNION {x | r x}`] THEN SUBGOAL_THEN `{x:int | l <= x /\ x <= r /\ p divides (x - c)} = {c}` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `P c /\ (!x y. P x /\ P y ==> x = y) ==> {x | P x} = {c}`) THEN ASM_REWRITE_TAC[INT_SUB_REFL; INT_DIVIDES_0] THEN MAP_EVERY X_GEN_TAC [`u:int`; `v:int`] THEN STRIP_TAC THEN SUBGOAL_THEN `p divides (u - v:int)` MP_TAC THENL [ASM_MESON_TAC[INT_CONG; INT_CONG_SYM; INT_CONG_TRANS]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{a} UNION s = a INSERT s`] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INTSEG_RESTRICT] THEN MATCH_MP_TAC(ARITH_RULE `~(n = 0) /\ x <= n - 1 ==> (if p then x else SUC x) <= n`) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN DISCH_THEN(MP_TAC o SPEC `n - 1`) THEN ASM_SIMP_TAC[LE_REFL; SUB_ADD; LE_1; ISUM_SING_NUMSEG; SUB_REFL] THEN ASM_REWRITE_TAC[INT_POW; INT_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Laborious instantiation to (x^d == 1) (mod p) over natural numbers. *) (* ------------------------------------------------------------------------- *) let NUM_LAGRANGE_LEMMA = prove (`!p d. prime p /\ 1 <= d ==> CARD {x | x IN 1..p-1 /\ (x EXP d == 1) (mod p)} <= d`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`&p:int`; `&1:int`; `&(p-1):int`] INT_POLY_LAGRANGE) THEN ANTS_TAC THENL [ASM_SIMP_TAC[INT_PRIME; INT_LT_SUB_RADD; INT_OF_NUM_ADD; INT_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`d:num`; `\i. if i = d then &1 else if i = 0 then -- &1 else &0:int`]) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [DISCH_THEN(MP_TAC o SPEC `d:num`) THEN REWRITE_TAC[LE_REFL] THEN REWRITE_TAC[INT_CONG_0_DIVIDES; GSYM num_divides; DIVIDES_ONE] THEN ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN REWRITE_TAC[MESON[] `(if p then x else y) * z:int = if p then x * z else y * z`] THEN SIMP_TAC[ISUM_CASES; FINITE_NUMSEG; FINITE_RESTRICT] THEN REWRITE_TAC[INT_POW; INT_MUL_LZERO; ISUM_0; INT_ADD_RID] THEN MATCH_MP_TAC(ARITH_RULE `x:num <= y ==> y <= d ==> x <= d`) THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `(0 <= i /\ i <= d) /\ i = d <=> i = d`; ARITH_RULE `1 <= d ==> (((0 <= i /\ i <= d) /\ ~(i = d)) /\ i = 0 <=> i = 0)`] THEN REWRITE_TAC[SING_GSPEC; ISUM_SING] THEN REWRITE_TAC[INT_ARITH `&1 * x + -- &1 * &1:int = x - &1`] THEN REWRITE_TAC[INTEGER_RULE `(x - a:int == &0) (mod p) <=> (x == a) (mod p)`] THEN MATCH_MP_TAC CARD_SUBSET_IMAGE THEN EXISTS_TAC `num_of_int` THEN REWRITE_TAC[FINITE_INTSEG_RESTRICT; SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN EXISTS_TAC `&n:int` THEN ASM_REWRITE_TAC[NUM_OF_INT_OF_NUM; INT_OF_NUM_LE; INT_OF_NUM_POW] THEN ASM_REWRITE_TAC[GSYM num_congruent]);; (* ------------------------------------------------------------------------- *) (* Count of elements with a given order modulo a prime. *) (* ------------------------------------------------------------------------- *) let COUNT_ORDERS_MODULO_PRIME = prove (`!p d. prime p /\ d divides (p - 1) ==> CARD {x | x IN 1..p-1 /\ order p x = d} = phi(d)`, let lemma = prove (`!s f g:A->num. FINITE s /\ (!x. x IN s ==> f(x) <= g(x)) /\ nsum s f = nsum s g ==> !x. x IN s ==> f x = g x`, REWRITE_TAC[GSYM LE_ANTISYM] THEN MESON_TAC[NSUM_LE; NSUM_LT; NOT_LE]) in REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `(!x. p x ==> q x) <=> (!x. x IN {x | p x} ==> q x)`] THEN MATCH_MP_TAC lemma THEN SUBGOAL_THEN `~(p - 1 = 0)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REWRITE_RULE[ETA_AX] PHI_DIVISORSUM; FINITE_DIVISORS] THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[CARD_EQ_NSUM; FINITE_RESTRICT; FINITE_NUMSEG] THEN W(MP_TAC o PART_MATCH (lhs o rand) NSUM_GROUP o lhs o snd) THEN REWRITE_TAC[NSUM_CONST_NUMSEG; FINITE_NUMSEG; ADD_SUB; MULT_CLAUSES] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN X_GEN_TAC `x:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM PHI_PRIME] THEN MATCH_MP_TAC ORDER_DIVIDES_PHI THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC] THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN ASM_CASES_TAC `{x | x IN 1..p-1 /\ order p x = d} = {}` THEN ASM_REWRITE_TAC[CARD_CLAUSES; LE_0] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[PHI_ALT] THEN MATCH_MP_TAC CARD_SUBSET_IMAGE THEN EXISTS_TAC `\m. (a EXP m) MOD p` THEN REWRITE_TAC[PHI_FINITE_LEMMA] THEN SUBGOAL_THEN `1 <= d` ASSUME_TAC THENL [ASM_MESON_TAC[LE_1; DIVIDES_ZERO]; ALL_TAC] THEN SUBGOAL_THEN `coprime(p,a)` ASSUME_TAC THENL [ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `{x | x IN 1..p-1 /\ (x EXP d == 1) (mod p)} = IMAGE (\m. (a EXP m) MOD p) {m | m < d}` MP_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBSET_LE THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `~(p - 1 = 0) ==> (x <= p - 1 <=> x < p)`] THEN ASM_SIMP_TAC[DIVISION; PRIME_IMP_NZ] THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN ASM_SIMP_TAC[GSYM DIVIDES_MOD; PRIME_IMP_NZ] THEN ASM_MESON_TAC[PRIME_DIVEXP; PRIME_COPRIME_EQ]; ASM_SIMP_TAC[CONG; PRIME_IMP_NZ; MOD_EXP_MOD] THEN REWRITE_TAC[EXP_EXP] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EXP_EXP] THEN SUBST1_TAC(SYM(SPEC `m:num` EXP_ONE)) THEN ASM_SIMP_TAC[GSYM CONG; PRIME_IMP_NZ] THEN MATCH_MP_TAC CONG_EXP THEN ASM_MESON_TAC[ORDER]]; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `d:num` THEN ASM_SIMP_TAC[NUM_LAGRANGE_LEMMA] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CARD_NUMSEG_LT] THEN MATCH_MP_TAC EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_SIMP_TAC[GSYM CONG; PRIME_IMP_NZ; FINITE_NUMSEG_LT; IN_ELIM_THM] THEN ASM_SIMP_TAC[ORDER_DIVIDES_EXPDIFF] THEN REWRITE_TAC[CONG_IMP_EQ]]; MATCH_MP_TAC(SET_RULE `s' SUBSET s /\ (!x. x IN t /\ f x IN s' ==> x IN t') ==> s = IMAGE f t ==> s' SUBSET IMAGE f t'`) THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_NUMSEG] THEN CONJ_TAC THENL [MESON_TAC[ORDER]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN ABBREV_TAC `b = (a EXP m) MOD p` THEN STRIP_TAC THEN REWRITE_TAC[coprime; divides] THEN X_GEN_TAC `e:num` THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `m':num` (ASSUME_TAC o SYM)) (X_CHOOSE_THEN `d':num` (ASSUME_TAC o SYM))) THEN MP_TAC(ISPECL [`p:num`; `b:num`] ORDER_WORKS) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `d':num`)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> (a /\ b ==> ~c) ==> d`) THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `1 <= d` THEN EXPAND_TAC "d" THEN REWRITE_TAC[ARITH_RULE `1 <= d <=> ~(d = 0)`; MULT_EQ_0] THEN SIMP_TAC[DE_MORGAN_THM; ARITH_RULE `0 < d <=> ~(d = 0)`]; EXPAND_TAC "b" THEN ASM_SIMP_TAC[CONG; PRIME_IMP_NZ; MOD_EXP_MOD] THEN EXPAND_TAC "m" THEN REWRITE_TAC[EXP_EXP] THEN ONCE_REWRITE_TAC[ARITH_RULE `(e * m') * d':num = (e * d') * m'`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM EXP_EXP] THEN SUBST1_TAC(SYM(SPEC `m':num` EXP_ONE)) THEN ASM_SIMP_TAC[GSYM CONG; PRIME_IMP_NZ] THEN MATCH_MP_TAC CONG_EXP THEN ASM_MESON_TAC[ORDER]; EXPAND_TAC "d" THEN REWRITE_TAC[ARITH_RULE `~(d < e * d) <=> e * d <= 1 * d`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN REWRITE_TAC[ARITH_RULE `e <= 1 <=> e = 0 \/ e = 1`] THEN STRIP_TAC THEN UNDISCH_TAC `e * d':num = d` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* In particular, primitive roots modulo a prime. *) (* ------------------------------------------------------------------------- *) let PRIMITIVE_ROOTS_MODULO_PRIME = prove (`!p. prime p ==> CARD {x | x IN 1..p-1 /\ order p x = p - 1} = phi(p - 1)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:num`; `p - 1`] COUNT_ORDERS_MODULO_PRIME) THEN ASM_REWRITE_TAC[DIVIDES_REFL]);; let PRIMITIVE_ROOT_MODULO_PRIME = prove (`!p. prime p ==> ?x. x IN 1..p-1 /\ order p x = p - 1`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIMITIVE_ROOTS_MODULO_PRIME) THEN ASM_CASES_TAC `{x | x IN 1..p-1 /\ order p x = p - 1} = {}` THENL [ASM_REWRITE_TAC[CARD_CLAUSES]; ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(ARITH_RULE `1 <= p ==> ~(0 = p)`) THEN MATCH_MP_TAC PHI_LOWERBOUND_1_STRONG THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Now primitive roots modulo odd prime powers. *) (* ------------------------------------------------------------------------- *) let COPRIME_1_PLUS_POWER_STEP = prove (`!p z k. prime p /\ coprime(z,p) /\ 3 <= p /\ 1 <= k ==> ?w. coprime(w,p) /\ (1 + z * p EXP k) EXP p = 1 + w * p EXP (k + 1)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ARITH_RULE `1 + a * b = a * b + 1`] THEN REWRITE_TAC[BINOMIAL_THEOREM; EXP_ONE; MULT_CLAUSES] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0; EXP; binom; MULT_CLAUSES; ADD_CLAUSES] THEN SUBGOAL_THEN `1 <= p` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; BINOM_1; EXP_1; ARITH] THEN DISCH_TAC THEN SUBGOAL_THEN `(p EXP (k + 2)) divides (nsum(2..p) (\i. binom(p,i) * (z * p EXP k) EXP i))` MP_TAC THENL [ALL_TAC; REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `z + p * d:num` THEN ASM_REWRITE_TAC[NUMBER_RULE `coprime(z + p * d:num,p) <=> coprime(z,p)`] THEN REWRITE_TAC[EXP_ADD] THEN ARITH_TAC] THEN MATCH_MP_TAC NSUM_CLOSED THEN REWRITE_TAC[DIVIDES_0; DIVIDES_ADD; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[MULT_EXP] THEN ONCE_REWRITE_TAC[ARITH_RULE `a * b * c:num = b * c * a`] THEN REWRITE_TAC[EXP_EXP] THEN MATCH_MP_TAC DIVIDES_LMUL THEN ASM_CASES_TAC `j:num = p` THENL [MATCH_MP_TAC DIVIDES_RMUL THEN ASM_SIMP_TAC[DIVIDES_EXP_LE; ARITH_RULE `3 <= p ==> 2 <= p`] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `k * 3` THEN CONJ_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[LE_MULT_LCANCEL]]; ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP; ARITH_RULE `k + 2 = SUC(k + 1)`] THEN MATCH_MP_TAC DIVIDES_MUL2 THEN CONJ_TAC THENL [MATCH_MP_TAC DIVIDES_BINOM_PRIME THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[DIVIDES_EXP_LE; ARITH_RULE `3 <= p ==> 2 <= p`] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `k * 2` THEN CONJ_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[LE_MULT_LCANCEL]]]]);; let COPRIME_1_PLUS_POWER = prove (`!p z k. prime p /\ coprime(z,p) /\ 3 <= p ==> ?w. coprime(w,p) /\ (1 + z * p) EXP (p EXP k) = 1 + w * p EXP (k + 1)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP_1; EXP] THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[MULT_SYM] EXP_EXP)] THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN STRIP_ASSUME_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `w:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`p:num`; `w:num`; `k + 1`] COPRIME_1_PLUS_POWER_STEP) THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 1`] THEN REWRITE_TAC[EXP_ADD; EXP_1; MULT_AC]);; let PRIMITIVE_ROOT_MODULO_PRIMEPOWS = prove (`!p. prime p /\ 3 <= p ==> ?g. !j. 1 <= j ==> order(p EXP j) g = phi(p EXP j)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIMITIVE_ROOT_MODULO_PRIME) THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `g:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`p:num`; `g:num`] ORDER) THEN ASM_SIMP_TAC[CONG_TO_1; EXP_EQ_0; LE_1] THEN DISCH_THEN(X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?x. coprime(p,y + (p - 1) * g EXP (p - 2) * x)` CHOOSE_TAC THENL [MP_TAC(ISPECL [`(&p - &1:int) * &g pow (p - 2)`; `&1 - &y:int`; `&p:int`] INT_CONG_SOLVE_POS) THEN ANTS_TAC THENL [REWRITE_TAC[INT_COPRIME_LMUL; INT_COPRIME_LPOW] THEN REWRITE_TAC[INTEGER_RULE `coprime(p - &1,p)`; GSYM num_coprime] THEN ASM_SIMP_TAC[INT_OF_NUM_EQ; ARITH_RULE `3 <= p ==> ~(p = 0)`] THEN DISJ1_TAC THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM INT_EXISTS_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (INTEGER_RULE `(x:int == &1 - y) (mod n) ==> coprime(n,y + x)`)) THEN ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_POW; INT_OF_NUM_MUL; INT_OF_NUM_ADD; GSYM num_coprime; ARITH_RULE `3 <= p ==> 1 <= p`] THEN REWRITE_TAC[MULT_ASSOC]]; ALL_TAC] THEN EXISTS_TAC `g + p * x:num` THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN STRIP_ASSUME_TAC(ISPECL [`p EXP j`; `g + p * x:num`] ORDER_WORKS) THEN MP_TAC(SPECL [`p:num`; `g + p * x:num`; `order (p EXP j) (g + p * x)`] ORDER_DIVIDES) THEN SUBGOAL_THEN `order p (g + p * x) = p - 1` SUBST1_TAC THENL [ASM_MESON_TAC[ORDER_CONG; NUMBER_RULE `(g:num == g + p * x) (mod p)`]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (b ==> c) ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL [MATCH_MP_TAC(NUMBER_RULE `!y. (a == 1) (mod y) /\ x divides y ==> (a == 1) (mod x)`) THEN EXISTS_TAC `p EXP j` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DIVIDES_REFL; DIVIDES_REXP; LE_1]; REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)] THEN MP_TAC(ISPECL [`g + p * x:num`; `p EXP j`] ORDER_DIVIDES_PHI) THEN ASM_SIMP_TAC[PHI_PRIMEPOW; LE_1; COPRIME_LEXP] THEN ANTS_TAC THENL [REWRITE_TAC[NUMBER_RULE `coprime(p,g + p * x) <=> coprime(g,p)`] THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `p EXP j - p EXP (j - 1) = (p - 1) * p EXP (j - 1)` SUBST1_TAC THENL [UNDISCH_TAC `1 <= j` THEN SPEC_TAC(`j:num`,`j:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH; SUC_SUB1] THEN REWRITE_TAC[EXP; RIGHT_SUB_DISTRIB] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE `(a * x:num) divides (a * y) ==> ~(a = 0) ==> x divides y`)) THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW; ARITH_RULE `3 <= p ==> ~(p - 1 = 0)`] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `?z. (g + p * x) EXP (p - 1) = 1 + z * p /\ coprime(z,p)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[BINOMIAL_THEOREM] THEN ASM_SIMP_TAC[NSUM_CLAUSES_RIGHT; LE_0; ARITH_RULE `3 <= p ==> 0 < p - 1`] THEN REWRITE_TAC[BINOM_REFL; SUB_REFL; EXP; MULT_CLAUSES] THEN EXISTS_TAC `y + nsum(0..p-2) (\k. binom(p - 1,k) * g EXP k * p EXP (p - 2 - k) * x EXP (p - 1 - k))` THEN REWRITE_TAC[ARITH_RULE `n - 1 - 1 = n - 2`] THEN SIMP_TAC[ARITH_RULE `s + 1 + y * p = 1 + (y + t) * p <=> s = p * t`] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM NSUM_LMUL] THEN MATCH_MP_TAC NSUM_EQ THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN SIMP_TAC[ARITH_RULE `p * b * g * pp * x:num = b * g * (p * pp) * x`] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[MULT_EXP] THEN REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[NSUM_CLAUSES_RIGHT; LE_0; ARITH_RULE `3 <= p ==> 0 < p - 2`] THEN REWRITE_TAC[BINOM_REFL; SUB_REFL; EXP; MULT_CLAUSES] THEN ASM_SIMP_TAC[EXP_1; ARITH_RULE `3 <= p ==> p - 1 - (p - 2) = 1`] THEN SUBGOAL_THEN `binom(p - 1,p - 2) = p - 1` SUBST1_TAC THENL [SUBGOAL_THEN `p - 1 = SUC(p - 2)` SUBST1_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[BINOM_PENULT]]; ALL_TAC] THEN MATCH_MP_TAC(NUMBER_RULE `coprime(p:num,y + x) /\ p divides z ==> coprime(y + z + x,p)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NSUM_CLOSED THEN REWRITE_TAC[DIVIDES_0; DIVIDES_ADD; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPLICATE_TAC 2 (MATCH_MP_TAC DIVIDES_LMUL) THEN MATCH_MP_TAC DIVIDES_RMUL THEN MATCH_MP_TAC DIVIDES_REXP THEN REWRITE_TAC[DIVIDES_REFL] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?w. (g + p * x) EXP ((p - 1) * p EXP k) = 1 + p EXP (k + 1) * w /\ coprime(w,p)` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM EXP_EXP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN GEN_REWRITE_TAC (BINDER_CONV o funpow 3 RAND_CONV) [MULT_SYM] THEN MATCH_MP_TAC COPRIME_1_PLUS_POWER THEN ASM_REWRITE_TAC[]; UNDISCH_TAC `((g + p * x) EXP ((p - 1) * p EXP k) == 1) (mod (p EXP j))` THEN ASM_REWRITE_TAC[NUMBER_RULE `(1 + x == 1) (mod n) <=> n divides x`] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN DISCH_TAC THEN MP_TAC(SPECL [`p:num`; `j:num`; `w:num`; `p EXP (k + 1)`] COPRIME_EXP_DIVPROD) THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DIVIDES_EXP_LE; ARITH_RULE `3 <= p ==> 2 <= p`] THEN UNDISCH_TAC `k <= j - 1` THEN ARITH_TAC]);; let PRIMITIVE_ROOT_MODULO_PRIMEPOW = prove (`!p k. prime p /\ 3 <= p /\ 1 <= k ==> ?x. x IN 1..(p EXP k - 1) /\ order (p EXP k) x = phi(p EXP k)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `p:num` PRIMITIVE_ROOT_MODULO_PRIMEPOWS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:num` THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `x MOD (p EXP k)` THEN CONJ_TAC THENL [REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`p EXP k`; `x:num`] DIVIDES_MOD) THEN ASM_SIMP_TAC[EXP_EQ_0; ARITH_RULE `3 <= p ==> ~(p = 0)`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_TAC THEN MP_TAC(ISPECL [`p EXP k`; `x:num`] ORDER) THEN DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE `(x == 1) (mod p) ==> p divides x ==> p divides 1`)) THEN ASM_SIMP_TAC[EXP_EQ_1; DIVIDES_ONE; LE_1] THEN ASM_SIMP_TAC[ARITH_RULE `3 <= p ==> ~(p = 1)`] THEN MATCH_MP_TAC DIVIDES_REXP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE `1 <= p ==> ~(p = 0)`) THEN MATCH_MP_TAC PHI_LOWERBOUND_1_STRONG THEN MATCH_MP_TAC(ARITH_RULE `~(p = 0) ==> 1 <= p`) THEN ASM_SIMP_TAC[EXP_EQ_0] THEN ASM_ARITH_TAC; MATCH_MP_TAC(ARITH_RULE `a < b ==> a <= b - 1`) THEN MP_TAC(ISPECL [`x:num`; `p EXP k`] DIVISION) THEN ASM_SIMP_TAC[EXP_EQ_0; ARITH_RULE `3 <= p ==> ~(p = 0)`]]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `order (p EXP k) x` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC ORDER_CONG THEN MATCH_MP_TAC CONG_MOD THEN ASM_SIMP_TAC[EXP_EQ_0; ARITH_RULE `3 <= p ==> ~(p = 0)`]]);; (* ------------------------------------------------------------------------- *) (* Double prime powers and the other remaining positive cases 2 and 4. *) (* ------------------------------------------------------------------------- *) let PRIMITIVE_ROOT_MODULO_2 = prove (`?x. x IN 1..1 /\ order 2 x = phi(2)`, EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG; ARITH] THEN SIMP_TAC[PHI_PRIME; PRIME_2] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC ORDER_UNIQUE THEN REWRITE_TAC[ARITH_RULE `~(0 < m /\ m < 1)`] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV CONG_CONV) THEN REWRITE_TAC[]);; let PRIMITIVE_ROOT_MODULO_4 = prove (`?x. x IN 1..3 /\ order 4 x = phi(4)`, EXISTS_TAC `3` THEN REWRITE_TAC[IN_NUMSEG; ARITH] THEN SUBST1_TAC(ARITH_RULE `4 = 2 EXP 2`) THEN SIMP_TAC[PHI_PRIMEPOW; PRIME_2] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC ORDER_UNIQUE THEN REWRITE_TAC[FORALL_UNWIND_THM2; ARITH_RULE `0 < m /\ m < 2 <=> m = 1`] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV CONG_CONV) THEN REWRITE_TAC[]);; let PRIMITIVE_ROOT_DOUBLE_LEMMA = prove (`!n a. ODD n /\ ODD a /\ order n a = phi n ==> order (2 * n) a = phi(2 * n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ORDER_UNIQUE THEN ASM_SIMP_TAC[CONG_CHINESE_EQ; COPRIME_2; PHI_MULTIPLICATIVE] THEN REWRITE_TAC[PHI_2; MULT_CLAUSES] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[ODD; LE_1; PHI_LOWERBOUND_1_STRONG]; ASM_REWRITE_TAC[GSYM ODD_MOD_2; ODD_EXP]; ASM_MESON_TAC[ORDER_WORKS]; ASM_MESON_TAC[ORDER_WORKS]]);; let PRIMITIVE_ROOT_MODULO_DOUBLE_PRIMEPOW = prove (`!p k. prime p /\ 3 <= p /\ 1 <= k ==> ?x. x IN 1..(2 * p EXP k - 1) /\ order (2 * p EXP k) x = phi(2 * p EXP k)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `p:num` PRIME_ODD) THEN ASM_SIMP_TAC[ARITH_RULE `3 <= p ==> ~(p = 2)`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIMITIVE_ROOT_MODULO_PRIMEPOW) THEN DISCH_THEN(X_CHOOSE_THEN `g:num` MP_TAC) THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN DISJ_CASES_TAC (SPEC `g:num` EVEN_OR_ODD) THENL [EXISTS_TAC `g + p EXP k` THEN CONJ_TAC THENL [CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `g <= x - 1 /\ p EXP 1 <= x ==> g + p <= 2 * x - 1`) THEN ASM_REWRITE_TAC[LE_EXP] THEN ASM_ARITH_TAC; ALL_TAC]; EXISTS_TAC `g:num` THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN MATCH_MP_TAC PRIMITIVE_ROOT_DOUBLE_LEMMA THEN ASM_REWRITE_TAC[ODD_ADD; ODD_EXP; NOT_ODD] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC ORDER_CONG THEN CONV_TAC NUMBER_RULE);; (* ------------------------------------------------------------------------- *) (* A couple of degenerate case not usually considered. *) (* ------------------------------------------------------------------------- *) let PRIMITIVE_ROOT_MODULO_0 = prove (`(?x. order 0 x = phi(0))`, EXISTS_TAC `2` THEN REWRITE_TAC[PHI_0; ORDER_EQ_0; COPRIME_2; ODD]);; let PRIMITIVE_ROOT_MODULO_1 = prove (`?x. order 1 x = phi(1)`, EXISTS_TAC `1` THEN REWRITE_TAC[PHI_1] THEN MATCH_MP_TAC ORDER_UNIQUE THEN REWRITE_TAC[ARITH_RULE `0 < m /\ m < 1 <=> F`; EXP_1; CONG_REFL] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The negative results. *) (* ------------------------------------------------------------------------- *) let CONG_TO_1_POW2 = prove (`!k x. ODD x /\ 1 <= k ==> (x EXP (2 EXP k) == 1) (mod (2 EXP (k + 2)))`, INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP] THEN CONV_TAC NUM_REDUCE_CONV THEN GEN_TAC THEN ASM_CASES_TAC `k = 0` THENL [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CONG_TO_1] THEN DISJ2_TAC THEN REWRITE_TAC[GSYM EVEN_EXISTS; ARITH_RULE `SUC(2 * m) EXP 2 = 1 + q * 8 <=> m * (m + 1) = 2 * q`] THEN REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH] THEN CONV_TAC TAUT; STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num`) THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] EXP_MULT; LE_1] THEN REWRITE_TAC[CONG_TO_1; EXP_EQ_1; ADD_EQ_0; MULT_EQ_1] THEN CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; ARITH; GSYM EVEN_EXISTS; ARITH_RULE `(1 + m * n) EXP 2 = 1 + q * 2 * n <=> n * m * (2 + m * n) = n * 2 * q`] THEN REWRITE_TAC[EVEN_MULT; EVEN_ADD; EVEN_EXP; ARITH] THEN ARITH_TAC]);; let NO_PRIMITIVE_ROOT_MODULO_POW2 = prove (`!k. 3 <= k ==> ~(?x. order (2 EXP k) x = phi(2 EXP k))`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPEC `x:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a = b ==> 1 <= b /\ a = 0 ==> F`)) THEN ASM_SIMP_TAC[ORDER_EQ_0; PHI_LOWERBOUND_1_STRONG; LE_1; EXP_EQ_0; ARITH; COPRIME_LEXP; COPRIME_2; DE_MORGAN_THM; NOT_ODD] THEN ASM_ARITH_TAC; MP_TAC(CONJUNCT2(ISPECL [`2 EXP k`; `x:num`] ORDER_WORKS)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `2 EXP (k - 2)`) THEN ASM_SIMP_TAC[PHI_PRIMEPOW; PRIME_2; ARITH_RULE `3 <= k ==> ~(k = 0)`] THEN ABBREV_TAC `j = k - 2` THEN SUBGOAL_THEN `k - 1 = j + 1` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `k = j + 2` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `1 <= j` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CONG_TO_1_POW2; ARITH_RULE `0 < x <=> ~(x = 0)`] THEN REWRITE_TAC[EXP_EQ_0; ARITH] THEN MATCH_MP_TAC(ARITH_RULE `a + b:num < c ==> a < c - b`) THEN REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[ARITH_RULE `x + x * 2 < x * 4 <=> ~(x = 0)`] THEN REWRITE_TAC[EXP_EQ_0; ARITH]]);; let NO_PRIMITIVE_ROOT_MODULO_COMPOSITE = prove (`!a b. 3 <= a /\ 3 <= b /\ coprime(a,b) ==> ~(?x. order (a * b) x = phi(a * b))`, SIMP_TAC[PHI_MULTIPLICATIVE] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a * b:num`; `x:num`] ORDER_WORKS) THEN ASM_SIMP_TAC[CONG_CHINESE_EQ] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(phi a * phi b) DIV 2`) THEN REWRITE_TAC[ARITH_RULE `0 < a DIV 2 /\ a DIV 2 < a <=> 2 <= a`; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `2 * 2 <= x ==> 2 <= x`) THEN MATCH_MP_TAC LE_MULT2 THEN ASM_SIMP_TAC[PHI_LOWERBOUND_2]; SUBGOAL_THEN `EVEN(phi b)` MP_TAC THENL [ASM_SIMP_TAC[EVEN_PHI]; SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM]] THEN REWRITE_TAC[ARITH_RULE `(a * 2 * b) DIV 2 = a * b`]; SUBGOAL_THEN `EVEN(phi a)` MP_TAC THENL [ASM_SIMP_TAC[EVEN_PHI]; SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM]] THEN REWRITE_TAC[ARITH_RULE `((2 * a) * b) DIV 2 = b * a`]] THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[GSYM EXP_EXP] THEN SUBST1_TAC(SYM(SPEC `m:num` EXP_ONE)) THEN MATCH_MP_TAC CONG_EXP THEN MATCH_MP_TAC FERMAT_LITTLE THEN MP_TAC(ISPECL [`a * b:num`; `x:num`] ORDER_EQ_0) THEN ASM_SIMP_TAC[MULT_EQ_0; LE_1; PHI_LOWERBOUND_1_STRONG; ARITH_RULE `3 <= p ==> 1 <= p`] THEN CONV_TAC NUMBER_RULE);; (* ------------------------------------------------------------------------- *) (* Equivalences, one with some degenerate cases, one more conventional. *) (* ------------------------------------------------------------------------- *) let PRIMITIVE_ROOT_EXISTS = prove (`!n. (?x. order n x = phi n) <=> n = 0 \/ n = 2 \/ n = 4 \/ ?p k. prime p /\ 3 <= p /\ (n = p EXP k \/ n = 2 * p EXP k)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[PRIMITIVE_ROOT_MODULO_0] THEN ASM_CASES_TAC `n = 2` THENL [ASM_MESON_TAC[PRIMITIVE_ROOT_MODULO_2]; ALL_TAC] THEN ASM_CASES_TAC `n = 4` THENL [ASM_MESON_TAC[PRIMITIVE_ROOT_MODULO_4]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 1` THENL [ASM_REWRITE_TAC[PRIMITIVE_ROOT_MODULO_1] THEN MAP_EVERY EXISTS_TAC [`3`; `0`] THEN CONV_TAC(ONCE_DEPTH_CONV PRIME_CONV) THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN EQ_TAC THENL [ALL_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LE_1; PRIMITIVE_ROOT_MODULO_PRIMEPOW; PRIMITIVE_ROOT_MODULO_DOUBLE_PRIMEPOW]] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN MP_TAC(ISPEC `n:num` PRIMEPOW_FACTOR) THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`p:num`; `k:num`; `m:num`] THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN ASM_CASES_TAC `m = 1` THENL [ASM_REWRITE_TAC[MULT_CLAUSES] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:num`; `k:num`]) THEN ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE `2 <= p ==> (~(3 <= p) <=> p = 2)`] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_CASES_TAC `3 <= k` THENL [ASM_MESON_TAC[NO_PRIMITIVE_ROOT_MODULO_POW2]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(3 <= k) ==> 1 <= k ==> k = 1 \/ k = 2`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN ASM_CASES_TAC `m = 2` THENL [ASM_REWRITE_TAC[COPRIME_2] THEN ASM_CASES_TAC `p = 2` THEN ASM_REWRITE_TAC[ARITH] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_GE_2) THEN SUBGOAL_THEN `3 <= p` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `k = 1` THENL [UNDISCH_THEN `k = 1` SUBST_ALL_TAC; MP_TAC(SPECL [`p EXP k`; `m:num`] NO_PRIMITIVE_ROOT_MODULO_COMPOSITE) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[COPRIME_LEXP] THEN CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC(ARITH_RULE `2 EXP 2 <= x ==> 3 <= x`) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP 2` THEN ASM_REWRITE_TAC[EXP_MONO_LE; LE_EXP] THEN ASM_SIMP_TAC[PRIME_GE_2; PRIME_IMP_NZ] THEN ASM_ARITH_TAC] THEN ASM_CASES_TAC `p = 2` THENL [UNDISCH_THEN `p = 2` SUBST_ALL_TAC; MP_TAC(SPECL [`p EXP 1`; `m:num`] NO_PRIMITIVE_ROOT_MODULO_COMPOSITE) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[COPRIME_LEXP] THEN REWRITE_TAC[EXP_1] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ASM_ARITH_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[EXP_1]) THEN REWRITE_TAC[EXP_1] THEN MP_TAC(ISPEC `m:num` PRIMEPOW_FACTOR) THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`q:num`; `j:num`; `r:num`] THEN ASM_CASES_TAC `r = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN STRIP_TAC THEN UNDISCH_TAC `coprime(2,m)` THEN ASM_SIMP_TAC[COPRIME_RMUL; COPRIME_REXP; LE_1] THEN REWRITE_TAC[COPRIME_2] THEN STRIP_TAC THEN SUBGOAL_THEN `3 <= q` ASSUME_TAC THENL [MATCH_MP_TAC(ARITH_RULE `~(p = 2) /\ 2 <= p ==> 3 <= p`) THEN ASM_SIMP_TAC[PRIME_GE_2] THEN DISCH_TAC THEN UNDISCH_TAC `ODD q` THEN ASM_REWRITE_TAC[ARITH]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `j:num`]) THEN ASM_CASES_TAC `r = 1` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN STRIP_TAC THEN MP_TAC(SPECL [`2 * r`; `q EXP j`] NO_PRIMITIVE_ROOT_MODULO_COMPOSITE) THEN REWRITE_TAC[COPRIME_LMUL; COPRIME_REXP] THEN ASM_REWRITE_TAC[COPRIME_2] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MULT_AC; NOT_EXISTS_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `3 <= r * 2 <=> ~(r = 0 \/ r = 1)`] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `q EXP 1` THEN ASM_REWRITE_TAC[LE_EXP; ARITH; COND_ID] THEN ASM_REWRITE_TAC[EXP_1]);; let PRIMITIVE_ROOT_EXISTS_NONTRIVIAL = prove (`!n. (?x. x IN 1..n-1 /\ order n x = phi n) <=> n = 2 \/ n = 4 \/ ?p k. prime p /\ 3 <= p /\ 1 <= k /\ (n = p EXP k \/ n = 2 * p EXP k)`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[IN_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a <=> b)`) THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[MULT_EQ_0; EXP_EQ_0] THEN ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `n = 1` THENL [ASM_REWRITE_TAC[IN_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a <=> b)`) THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[MULT_EQ_1; EXP_EQ_1] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `?x. order n x = phi n` THEN CONJ_TAC THENL [EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN EXISTS_TAC `x MOD n` THEN ASM_SIMP_TAC[IN_NUMSEG; DIVISION; ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> (x <= n - 1 <=> x < n)`] THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN ASM_SIMP_TAC[GSYM DIVIDES_MOD] THEN DISCH_TAC THEN MP_TAC(SPECL [`n:num`; `x:num`] ORDER_EQ_0) THEN ASM_SIMP_TAC[LE_1; PHI_LOWERBOUND_1_STRONG] THEN REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[DIVIDES_REFL]; FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC ORDER_CONG THEN ASM_SIMP_TAC[CONG_MOD]]; ASM_REWRITE_TAC[PRIMITIVE_ROOT_EXISTS] THEN ASM_CASES_TAC `n = 2` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 4` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `p:num` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN CONV_TAC(BINOP_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_CASES_TAC `k = 0` THEN ASM_SIMP_TAC[LE_1] THEN AP_TERM_TAC THEN ASM_ARITH_TAC]);; hol-light/Library/products.ml000066400000000000000000000566321303454263000165620ustar00rootroot00000000000000(* ========================================================================= *) (* Products of natural numbers and real numbers. *) (* ========================================================================= *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* Products over natural numbers. *) (* ------------------------------------------------------------------------- *) let nproduct = new_definition `nproduct = iterate(( * ):num->num->num)`;; let NPRODUCT_CLAUSES = prove (`(!f. nproduct {} f = 1) /\ (!x f s. FINITE(s) ==> (nproduct (x INSERT s) f = if x IN s then nproduct s f else f(x) * nproduct s f))`, REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; let NPRODUCT_SUPPORT = prove (`!f s. nproduct (support ( * ) f s) f = nproduct s f`, REWRITE_TAC[nproduct; ITERATE_SUPPORT]);; let NPRODUCT_UNION = prove (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> (nproduct (s UNION t) f = nproduct s f * nproduct t f)`, SIMP_TAC[nproduct; ITERATE_UNION; MONOIDAL_MUL]);; let NPRODUCT_IMAGE = prove (`!f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (nproduct (IMAGE f s) g = nproduct s (g o f))`, REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_MUL]);; let NPRODUCT_ADD_SPLIT = prove (`!f m n p. m <= n + 1 ==> (nproduct (m..(n+p)) f = nproduct(m..n) f * nproduct(n+1..n+p) f)`, SIMP_TAC[NUMSEG_ADD_SPLIT; NPRODUCT_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; ARITH_RULE `x < x + 1`]);; let NPRODUCT_POS_LT = prove (`!f s. FINITE s /\ (!x. x IN s ==> 0 < f x) ==> 0 < nproduct s f`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; ARITH; IN_INSERT; LT_MULT]);; let NPRODUCT_POS_LT_NUMSEG = prove (`!f m n. (!x. m <= x /\ x <= n ==> 0 < f x) ==> 0 < nproduct(m..n) f`, SIMP_TAC[NPRODUCT_POS_LT; FINITE_NUMSEG; IN_NUMSEG]);; let NPRODUCT_OFFSET = prove (`!f m p. nproduct(m+p..n+p) f = nproduct(m..n) (\i. f(i + p))`, SIMP_TAC[NUMSEG_OFFSET_IMAGE; NPRODUCT_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[o_DEF]);; let NPRODUCT_SING = prove (`!f x. nproduct {x} f = f(x)`, SIMP_TAC[NPRODUCT_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; MULT_CLAUSES]);; let NPRODUCT_SING_NUMSEG = prove (`!f n. nproduct(n..n) f = f(n)`, REWRITE_TAC[NUMSEG_SING; NPRODUCT_SING]);; let NPRODUCT_CLAUSES_NUMSEG = prove (`(!m. nproduct(m..0) f = if m = 0 then f(0) else 1) /\ (!m n. nproduct(m..SUC n) f = if m <= SUC n then nproduct(m..n) f * f(SUC n) else nproduct(m..n) f)`, REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NPRODUCT_SING; NPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; MULT_AC]);; let NPRODUCT_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> nproduct s f = nproduct s g`, REWRITE_TAC[nproduct] THEN MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_MUL]);; let NPRODUCT_EQ_NUMSEG = prove (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) ==> (nproduct(m..n) f = nproduct(m..n) g)`, MESON_TAC[NPRODUCT_EQ; FINITE_NUMSEG; IN_NUMSEG]);; let NPRODUCT_EQ_0 = prove (`!f s. FINITE s ==> (nproduct s f = 0 <=> ?x. x IN s /\ f(x) = 0)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; MULT_EQ_0; IN_INSERT; ARITH; NOT_IN_EMPTY] THEN MESON_TAC[]);; let NPRODUCT_EQ_0_NUMSEG = prove (`!f m n. nproduct(m..n) f = 0 <=> ?x. m <= x /\ x <= n /\ f(x) = 0`, SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; GSYM CONJ_ASSOC]);; let NPRODUCT_LE = prove (`!f s. FINITE s /\ (!x. x IN s ==> 0 <= f(x) /\ f(x) <= g(x)) ==> nproduct s f <= nproduct s g`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[IN_INSERT; NPRODUCT_CLAUSES; NOT_IN_EMPTY; LE_REFL] THEN MESON_TAC[LE_MULT2; LE_0]);; let NPRODUCT_LE_NUMSEG = prove (`!f m n. (!i. m <= i /\ i <= n ==> 0 <= f(i) /\ f(i) <= g(i)) ==> nproduct(m..n) f <= nproduct(m..n) g`, SIMP_TAC[NPRODUCT_LE; FINITE_NUMSEG; IN_NUMSEG]);; let NPRODUCT_EQ_1 = prove (`!f s. (!x:A. x IN s ==> (f(x) = 1)) ==> (nproduct s f = 1)`, REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_MUL]);; let NPRODUCT_EQ_1_NUMSEG = prove (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = 1)) ==> (nproduct(m..n) f = 1)`, SIMP_TAC[NPRODUCT_EQ_1; IN_NUMSEG]);; let NPRODUCT_MUL_GEN = prove (`!f g s. FINITE {x | x IN s /\ ~(f x = 1)} /\ FINITE {x | x IN s /\ ~(g x = 1)} ==> nproduct s (\x. f x * g x) = nproduct s f * nproduct s g`, REWRITE_TAC[GSYM NEUTRAL_MUL; GSYM support; nproduct] THEN MATCH_MP_TAC ITERATE_OP_GEN THEN ACCEPT_TAC MONOIDAL_MUL);; let NPRODUCT_MUL = prove (`!f g s. FINITE s ==> nproduct s (\x. f x * g x) = nproduct s f * nproduct s g`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; MULT_AC; MULT_CLAUSES]);; let NPRODUCT_MUL_NUMSEG = prove (`!f g m n. nproduct(m..n) (\x. f x * g x) = nproduct(m..n) f * nproduct(m..n) g`, SIMP_TAC[NPRODUCT_MUL; FINITE_NUMSEG]);; let NPRODUCT_CONST = prove (`!c s. FINITE s ==> nproduct s (\x. c) = c EXP (CARD s)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NPRODUCT_CLAUSES; CARD_CLAUSES; EXP]);; let NPRODUCT_CONST_NUMSEG = prove (`!c m n. nproduct (m..n) (\x. c) = c EXP ((n + 1) - m)`, SIMP_TAC[NPRODUCT_CONST; CARD_NUMSEG; FINITE_NUMSEG]);; let NPRODUCT_CONST_NUMSEG_1 = prove (`!c n. nproduct(1..n) (\x. c) = c EXP n`, SIMP_TAC[NPRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG]);; let NPRODUCT_ONE = prove (`!s. nproduct s (\n. 1) = 1`, SIMP_TAC[NPRODUCT_EQ_1]);; let NPRODUCT_CLOSED = prove (`!P f:A->num s. P(1) /\ (!x y. P x /\ P y ==> P(x * y)) /\ (!a. a IN s ==> P(f a)) ==> P(nproduct s f)`, REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_MUL) THEN DISCH_THEN(MP_TAC o SPEC `P:num->bool`) THEN ASM_SIMP_TAC[NEUTRAL_MUL; GSYM nproduct]);; let NPRODUCT_CLAUSES_LEFT = prove (`!f m n. m <= n ==> nproduct(m..n) f = f(m) * nproduct(m+1..n) f`, SIMP_TAC[GSYM NUMSEG_LREC; NPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; let NPRODUCT_CLAUSES_RIGHT = prove (`!f m n. 0 < n /\ m <= n ==> nproduct(m..n) f = nproduct(m..n-1) f * f(n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[LT_REFL; NPRODUCT_CLAUSES_NUMSEG; SUC_SUB1]);; let NPRODUCT_SUPERSET = prove (`!f:A->num u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f(x) = 1) ==> nproduct v f = nproduct u f`, SIMP_TAC[nproduct; GSYM NEUTRAL_MUL; ITERATE_SUPERSET; MONOIDAL_MUL]);; let NPRODUCT_UNIV = prove (`!f:A->num s. support ( * ) f (:A) SUBSET s ==> nproduct s f = nproduct (:A) f`, REWRITE_TAC[nproduct] THEN MATCH_MP_TAC ITERATE_UNIV THEN REWRITE_TAC[MONOIDAL_MUL]);; let NPRODUCT_PAIR = prove (`!f m n. nproduct(2*m..2*n+1) f = nproduct(m..n) (\i. f(2*i) * f(2*i+1))`, MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_MUL) THEN REWRITE_TAC[nproduct; NEUTRAL_MUL]);; let NPRODUCT_REFLECT = prove (`!x m n. nproduct(m..n) x = if n < m then 1 else nproduct(0..n-m) (\i. x(n - i))`, REPEAT GEN_TAC THEN REWRITE_TAC[nproduct] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP ITERATE_REFLECT MONOIDAL_MUL] THEN REWRITE_TAC[NEUTRAL_MUL]);; let NPRODUCT_DELETE = prove (`!f s a. FINITE s /\ a IN s ==> f(a) * nproduct(s DELETE a) f = nproduct s f`, SIMP_TAC[nproduct; ITERATE_DELETE; MONOIDAL_MUL]);; let NPRODUCT_FACT = prove (`!n. nproduct(1..n) (\m. m) = FACT n`, INDUCT_TAC THEN REWRITE_TAC[NPRODUCT_CLAUSES_NUMSEG; FACT; ARITH] THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; MULT_SYM]);; let NPRODUCT_DELTA = prove (`!s a. nproduct s (\x. if x = a then b else 1) = (if a IN s then b else 1)`, REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN SIMP_TAC[ITERATE_DELTA; MONOIDAL_MUL]);; let HAS_SIZE_CART = prove (`!P m. (!i. 1 <= i /\ i <= dimindex(:N) ==> {x | P i x} HAS_SIZE m i) ==> {v:A^N | !i. 1 <= i /\ i <= dimindex(:N) ==> P i (v$i)} HAS_SIZE nproduct (1..dimindex(:N)) m`, REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!n. n <= dimindex(:N) ==> {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n ==> P i (v$i)) /\ (!i. 1 <= i /\ i <= dimindex(:N) /\ n < i ==> v$i = @x. F)} HAS_SIZE nproduct(1..n) m` (MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL; LET_ANTISYM] THEN INDUCT_TAC THEN REWRITE_TAC[NPRODUCT_CLAUSES_NUMSEG; ARITH_EQ] THENL [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= n /\ i <= 0 <=> F`] THEN SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n /\ 0 < i <=> 1 <= i /\ i <= n`] THEN SUBGOAL_THEN `{v | !i. 1 <= i /\ i <= dimindex (:N) ==> v$i = (@x. F)} = {(lambda i. @x. F):A^N}` (fun th -> SIMP_TAC[th; HAS_SIZE; FINITE_SING; CARD_SING]) THEN SIMP_TAC[EXTENSION; IN_SING; IN_ELIM_THM; CART_EQ; LAMBDA_BETA]; DISCH_TAC] THEN MATCH_MP_TAC(MESON[] `!t. t = s /\ t HAS_SIZE n ==> s HAS_SIZE n`) THEN EXISTS_TAC `IMAGE (\(x:A,v:A^N). (lambda i. if i = SUC n then x else v$i):A^N) {x,v | x IN {x:A | P (SUC n) x} /\ v IN {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n ==> P i (v$i)) /\ (!i. 1 <= i /\ i <= dimindex (:N) /\ n < i ==> v$i = (@x. F))}}` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LT_REFL] THEN TRY ASM_ARITH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN X_GEN_TAC `v:A^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `(v:A^N)$(SUC n)` THEN EXISTS_TAC `(lambda i. if i = SUC n then @x. F else (v:A^N)$i):A^N` THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; ARITH_RULE `i <= n ==> ~(i = SUC n)`] THEN ASM_MESON_TAC[LE; ARITH_RULE `1 <= SUC n`; ARITH_RULE `n < i /\ ~(i = SUC n) ==> SUC n < i`]]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IMP_IMP; PAIR_EQ; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `a:A` THEN DISCH_TAC THEN X_GEN_TAC `v:A^N` THEN STRIP_TAC THEN X_GEN_TAC `b:A` THEN DISCH_TAC THEN X_GEN_TAC `w:A^N` THEN STRIP_TAC THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`)) THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`]; X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(n:num) < i` THEN ASM_REWRITE_TAC[GSYM NOT_LT] THEN TRY ASM_ARITH_TAC THEN ASM_MESON_TAC[]]; REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN MATCH_MP_TAC HAS_SIZE_PRODUCT THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]);; let CARD_CART = prove (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> FINITE {x | P i x}) ==> CARD {v:A^N | !i. 1 <= i /\ i <= dimindex(:N) ==> P i (v$i)} = nproduct (1..dimindex(:N)) (\i. CARD {x | P i x})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[HAS_SIZE] `s HAS_SIZE n ==> CARD s = n`) THEN MATCH_MP_TAC HAS_SIZE_CART THEN ASM_REWRITE_TAC[GSYM FINITE_HAS_SIZE]);; let th = prove (`(!f g s. (!x. x IN s ==> f(x) = g(x)) ==> nproduct s (\i. f(i)) = nproduct s g) /\ (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) ==> nproduct(a..b) (\i. f(i)) = nproduct(a..b) g) /\ (!f g p. (!x. p x ==> f x = g x) ==> nproduct {y | p y} (\i. f(i)) = nproduct {y | p y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NPRODUCT_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; (* ------------------------------------------------------------------------- *) (* Now products over real numbers. *) (* ------------------------------------------------------------------------- *) prioritize_real();; let product = new_definition `product = iterate (( * ):real->real->real)`;; let PRODUCT_CLAUSES = prove (`(!f. product {} f = &1) /\ (!x f s. FINITE(s) ==> (product (x INSERT s) f = if x IN s then product s f else f(x) * product s f))`, REWRITE_TAC[product; GSYM NEUTRAL_REAL_MUL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_REAL_MUL]);; let PRODUCT_SUPPORT = prove (`!f s. product (support ( * ) f s) f = product s f`, REWRITE_TAC[product; ITERATE_SUPPORT]);; let PRODUCT_UNION = prove (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> (product (s UNION t) f = product s f * product t f)`, SIMP_TAC[product; ITERATE_UNION; MONOIDAL_REAL_MUL]);; let PRODUCT_IMAGE = prove (`!f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (product (IMAGE f s) g = product s (g o f))`, REWRITE_TAC[product; GSYM NEUTRAL_REAL_MUL] THEN MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_REAL_MUL]);; let PRODUCT_ADD_SPLIT = prove (`!f m n p. m <= n + 1 ==> (product (m..(n+p)) f = product(m..n) f * product(n+1..n+p) f)`, SIMP_TAC[NUMSEG_ADD_SPLIT; PRODUCT_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; ARITH_RULE `x < x + 1`]);; let PRODUCT_POS_LE = prove (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f x) ==> &0 <= product s f`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_POS; IN_INSERT; REAL_LE_MUL]);; let PRODUCT_POS_LE_NUMSEG = prove (`!f m n. (!x. m <= x /\ x <= n ==> &0 <= f x) ==> &0 <= product(m..n) f`, SIMP_TAC[PRODUCT_POS_LE; FINITE_NUMSEG; IN_NUMSEG]);; let PRODUCT_POS_LT = prove (`!f s. FINITE s /\ (!x. x IN s ==> &0 < f x) ==> &0 < product s f`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_LT_01; IN_INSERT; REAL_LT_MUL]);; let PRODUCT_POS_LT_NUMSEG = prove (`!f m n. (!x. m <= x /\ x <= n ==> &0 < f x) ==> &0 < product(m..n) f`, SIMP_TAC[PRODUCT_POS_LT; FINITE_NUMSEG; IN_NUMSEG]);; let PRODUCT_OFFSET = prove (`!f m p. product(m+p..n+p) f = product(m..n) (\i. f(i + p))`, SIMP_TAC[NUMSEG_OFFSET_IMAGE; PRODUCT_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[o_DEF]);; let PRODUCT_SING = prove (`!f x. product {x} f = f(x)`, SIMP_TAC[PRODUCT_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; REAL_MUL_RID]);; let PRODUCT_SING_NUMSEG = prove (`!f n. product(n..n) f = f(n)`, REWRITE_TAC[NUMSEG_SING; PRODUCT_SING]);; let PRODUCT_CLAUSES_NUMSEG = prove (`(!m. product(m..0) f = if m = 0 then f(0) else &1) /\ (!m n. product(m..SUC n) f = if m <= SUC n then product(m..n) f * f(SUC n) else product(m..n) f)`, REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[PRODUCT_SING; PRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; REAL_MUL_AC]);; let PRODUCT_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> product s f = product s g`, REWRITE_TAC[product] THEN MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_REAL_MUL]);; let PRODUCT_EQ_NUMSEG = prove (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) ==> (product(m..n) f = product(m..n) g)`, MESON_TAC[PRODUCT_EQ; FINITE_NUMSEG; IN_NUMSEG]);; let PRODUCT_EQ_0 = prove (`!f s. FINITE s ==> (product s f = &0 <=> ?x. x IN s /\ f(x) = &0)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_ENTIRE; IN_INSERT; REAL_OF_NUM_EQ; ARITH; NOT_IN_EMPTY] THEN MESON_TAC[]);; let PRODUCT_EQ_0_NUMSEG = prove (`!f m n. product(m..n) f = &0 <=> ?x. m <= x /\ x <= n /\ f(x) = &0`, SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; GSYM CONJ_ASSOC]);; let PRODUCT_LE = prove (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f(x) /\ f(x) <= g(x)) ==> product s f <= product s g`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[IN_INSERT; PRODUCT_CLAUSES; NOT_IN_EMPTY; REAL_LE_REFL] THEN MESON_TAC[REAL_LE_MUL2; PRODUCT_POS_LE]);; let PRODUCT_LE_NUMSEG = prove (`!f m n. (!i. m <= i /\ i <= n ==> &0 <= f(i) /\ f(i) <= g(i)) ==> product(m..n) f <= product(m..n) g`, SIMP_TAC[PRODUCT_LE; FINITE_NUMSEG; IN_NUMSEG]);; let PRODUCT_EQ_1 = prove (`!f s. (!x:A. x IN s ==> (f(x) = &1)) ==> (product s f = &1)`, REWRITE_TAC[product; GSYM NEUTRAL_REAL_MUL] THEN SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_REAL_MUL]);; let PRODUCT_EQ_1_NUMSEG = prove (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = &1)) ==> (product(m..n) f = &1)`, SIMP_TAC[PRODUCT_EQ_1; IN_NUMSEG]);; let PRODUCT_MUL_GEN = prove (`!f g s. FINITE {x | x IN s /\ ~(f x = &1)} /\ FINITE {x | x IN s /\ ~(g x = &1)} ==> product s (\x. f x * g x) = product s f * product s g`, REWRITE_TAC[GSYM NEUTRAL_REAL_MUL; GSYM support; product] THEN MATCH_MP_TAC ITERATE_OP_GEN THEN ACCEPT_TAC MONOIDAL_REAL_MUL);; let PRODUCT_MUL = prove (`!f g s. FINITE s ==> product s (\x. f x * g x) = product s f * product s g`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_MUL_AC; REAL_MUL_LID]);; let PRODUCT_MUL_NUMSEG = prove (`!f g m n. product(m..n) (\x. f x * g x) = product(m..n) f * product(m..n) g`, SIMP_TAC[PRODUCT_MUL; FINITE_NUMSEG]);; let PRODUCT_CONST = prove (`!c s. FINITE s ==> product s (\x. c) = c pow (CARD s)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; CARD_CLAUSES; real_pow]);; let PRODUCT_CONST_NUMSEG = prove (`!c m n. product (m..n) (\x. c) = c pow ((n + 1) - m)`, SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG; FINITE_NUMSEG]);; let PRODUCT_CONST_NUMSEG_1 = prove (`!c n. product(1..n) (\x. c) = c pow n`, SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG]);; let PRODUCT_NEG = prove (`!f s:A->bool. FINITE s ==> product s (\i. --(f i)) = --(&1) pow (CARD s) * product s f`, SIMP_TAC[GSYM PRODUCT_CONST; GSYM PRODUCT_MUL] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID]);; let PRODUCT_NEG_NUMSEG = prove (`!f m n. product(m..n) (\i. --(f i)) = --(&1) pow ((n + 1) - m) * product(m..n) f`, SIMP_TAC[PRODUCT_NEG; CARD_NUMSEG; FINITE_NUMSEG]);; let PRODUCT_NEG_NUMSEG_1 = prove (`!f n. product(1..n) (\i. --(f i)) = --(&1) pow n * product(1..n) f`, REWRITE_TAC[PRODUCT_NEG_NUMSEG; ADD_SUB]);; let PRODUCT_INV = prove (`!f s. FINITE s ==> product s (\x. inv(f x)) = inv(product s f)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_INV_1; REAL_INV_MUL]);; let PRODUCT_DIV = prove (`!f g s. FINITE s ==> product s (\x. f x / g x) = product s f / product s g`, SIMP_TAC[real_div; PRODUCT_MUL; PRODUCT_INV]);; let PRODUCT_DIV_NUMSEG = prove (`!f g m n. product(m..n) (\x. f x / g x) = product(m..n) f / product(m..n) g`, SIMP_TAC[PRODUCT_DIV; FINITE_NUMSEG]);; let PRODUCT_ONE = prove (`!s. product s (\n. &1) = &1`, SIMP_TAC[PRODUCT_EQ_1]);; let PRODUCT_LE_1 = prove (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f x /\ f x <= &1) ==> product s f <= &1`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_LE_REFL; IN_INSERT] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[PRODUCT_POS_LE]);; let PRODUCT_ABS = prove (`!f s. FINITE s ==> product s (\x. abs(f x)) = abs(product s f)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_ABS_MUL; REAL_ABS_NUM]);; let PRODUCT_CLOSED = prove (`!P f:A->real s. P(&1) /\ (!x y. P x /\ P y ==> P(x * y)) /\ (!a. a IN s ==> P(f a)) ==> P(product s f)`, REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_REAL_MUL) THEN DISCH_THEN(MP_TAC o SPEC `P:real->bool`) THEN ASM_SIMP_TAC[NEUTRAL_REAL_MUL; GSYM product]);; let PRODUCT_CLAUSES_LEFT = prove (`!f m n. m <= n ==> product(m..n) f = f(m) * product(m+1..n) f`, SIMP_TAC[GSYM NUMSEG_LREC; PRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; let PRODUCT_CLAUSES_RIGHT = prove (`!f m n. 0 < n /\ m <= n ==> product(m..n) f = product(m..n-1) f * f(n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[LT_REFL; PRODUCT_CLAUSES_NUMSEG; SUC_SUB1]);; let REAL_OF_NUM_NPRODUCT = prove (`!f:A->num s. FINITE s ==> &(nproduct s f) = product s (\x. &(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; NPRODUCT_CLAUSES; GSYM REAL_OF_NUM_MUL]);; let PRODUCT_SUPERSET = prove (`!f:A->real u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f(x) = &1) ==> product v f = product u f`, SIMP_TAC[product; GSYM NEUTRAL_REAL_MUL; ITERATE_SUPERSET; MONOIDAL_REAL_MUL]);; let PRODUCT_UNIV = prove (`!f:A->real s. support ( * ) f (:A) SUBSET s ==> product s f = product (:A) f`, REWRITE_TAC[product] THEN MATCH_MP_TAC ITERATE_UNIV THEN REWRITE_TAC[MONOIDAL_REAL_MUL]);; let PRODUCT_PAIR = prove (`!f m n. product(2*m..2*n+1) f = product(m..n) (\i. f(2*i) * f(2*i+1))`, MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_REAL_MUL) THEN REWRITE_TAC[product; NEUTRAL_REAL_MUL]);; let PRODUCT_REFLECT = prove (`!x m n. product(m..n) x = if n < m then &1 else product(0..n-m) (\i. x(n - i))`, REPEAT GEN_TAC THEN REWRITE_TAC[product] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP ITERATE_REFLECT MONOIDAL_REAL_MUL] THEN REWRITE_TAC[NEUTRAL_REAL_MUL]);; let PRODUCT_DELETE = prove (`!f s a. FINITE s /\ a IN s ==> f(a) * product(s DELETE a) f = product s f`, SIMP_TAC[product; ITERATE_DELETE; MONOIDAL_REAL_MUL]);; let PRODUCT_DELTA = prove (`!s a. product s (\x. if x = a then b else &1) = (if a IN s then b else &1)`, REWRITE_TAC[product; GSYM NEUTRAL_REAL_MUL] THEN SIMP_TAC[ITERATE_DELTA; MONOIDAL_REAL_MUL]);; let POLYNOMIAL_FUNCTION_PRODUCT = prove (`!s:A->bool p. FINITE s /\ (!i. i IN s ==> polynomial_function(\x. p x i)) ==> polynomial_function (\x. product s (p x))`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; POLYNOMIAL_FUNCTION_CONST] THEN SIMP_TAC[FORALL_IN_INSERT; POLYNOMIAL_FUNCTION_MUL]);; (* ------------------------------------------------------------------------- *) (* Extend congruences. *) (* ------------------------------------------------------------------------- *) let th = prove (`(!f g s. (!x. x IN s ==> f(x) = g(x)) ==> product s (\i. f(i)) = product s g) /\ (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) ==> product(a..b) (\i. f(i)) = product(a..b) g) /\ (!f g p. (!x. p x ==> f x = g x) ==> product {y | p y} (\i. f(i)) = product {y | p y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; hol-light/Library/q.ml000066400000000000000000000136061303454263000151510ustar00rootroot00000000000000(* ========================================================================= *) (* A library whose purpose is to remove type annotations from tactics when *) (* types can be found from the context. *) (* Similar to the Q module of HOL4 (). *) (* *) (* (c) Copyright, Vincent Aravantinos 2012-2013, *) (* Hardware Verification Group, *) (* Concordia University *) (* *) (* Contact: *) (* *) (* Distributed under the same license as HOL Light. *) (* ========================================================================= *) (* As can be seen in the below signature, all the functions have the same * signature as their standard HOL-Light counterpart, except the type "term" * is replaced by "string". We do not provide any documentation since their * functionality is exactly the same. * * Note: string arguments should be filled in using the usual term syntax * except that backslahses shall be doubled, e.g. `A /\ B` must be * written "A /\\ B". Most of the times, this should not be needed anyway. * * Functions like REAL_ARITH, ARITH_RULE, etc. are also overloaded here, again * with the goal of not having to write inferrable annotations: often, when one * wants to prove a theorem about reals using REAL_ARITH, (s)he has to annotate * his/her goal with `:real` whereas it should be obvious that REAL_ARITH is * only called for facts dealing with reals. * * Ex: * The goal: * * # g `!x:real. P x ==> ?y. P y` * * can be reduced equivalently by the two following tactics: * * # e (REPEAT STRIP_TAC THEN EXISTS_TAC `x:real`) * * # e (REPEAT STRIP_TAC THEN Pa.EXISTS_TAC "x") * * Note: * The module cannot be called "Q" because HOL Light does not allow * modules with a single letter. I choose "Pa", short for "Parse". * *) module Pa : sig val CONTEXT_TAC : ((string * pretype) list -> tactic) -> tactic val PARSE_IN_CONTEXT : (term -> tactic) -> (string -> tactic) val PARSES_IN_CONTEXT : (term list -> tactic) -> (string list -> tactic) val EXISTS_TAC : string -> tactic val SUBGOAL_THEN : string -> thm_tactic -> tactic val SUBGOAL_TAC : string -> string -> tactic list -> tactic val ASM_CASES_TAC : string -> tactic val BOOL_CASES_TAC : string -> tactic val SPEC_TAC : string * string -> tactic val SPEC : string -> thm -> thm val SPECL : string list -> thm -> thm val GEN : string -> thm -> thm val GENL : string list -> thm -> thm val X_GEN_TAC : string -> tactic val REAL_ARITH : string -> thm val REAL_FIELD : string -> thm val REAL_RING : string -> thm val ARITH_RULE : string -> thm val NUM_RING : string -> thm val INT_ARITH : string -> thm val ABBREV_TAC : string -> tactic val call_with_interface : (unit -> 'a) -> (term -> 'b) -> string -> 'b end = struct let parse_preterm = fst o parse_preterm o lex o explode let CONTEXT_common f hs c x = let vs = freesl (c::hs) in f (map (fun x -> name_of x, pretype_of_type(type_of x)) vs) x let CONTEXT_TAC ttac (asms,c as g) = CONTEXT_common ttac (map (concl o snd) asms) c g let CONTEXT_RULE r th = CONTEXT_common r (hyp th) (concl th) th let PARSES_IN_CONTEXT ttac ss = CONTEXT_TAC (fun env -> ttac (map (term_of_preterm o retypecheck env o parse_preterm) ss)) let PARSE_IN_CONTEXT tac s = PARSES_IN_CONTEXT (function [t] -> tac t) [s] let type_of_forall = type_of o fst o dest_forall let force_type ?(env=[]) s ty = let pty = pretype_of_type ty in term_of_preterm (retypecheck env (Typing(parse_preterm s,pty))) let BOOL_CONTEXT_TAC ttac s = CONTEXT_TAC (fun env -> ttac (force_type ~env s bool_ty)) let SUBGOAL_THEN s ttac = BOOL_CONTEXT_TAC (C SUBGOAL_THEN ttac) s let SUBGOAL_TAC l s tacs = BOOL_CONTEXT_TAC (C (SUBGOAL_TAC l) tacs) s let ABBREV_TAC = BOOL_CONTEXT_TAC ABBREV_TAC let ASM_CASES_TAC = BOOL_CONTEXT_TAC ASM_CASES_TAC let BOOL_CASES_TAC = BOOL_CONTEXT_TAC BOOL_CASES_TAC let EXISTS_TAC s (_,c as g) = CONTEXT_TAC (fun env -> EXISTS_TAC (force_type ~env s (type_of (fst (dest_exists c))))) g let SPEC_TAC (u,x) = PARSE_IN_CONTEXT (fun u' -> SPEC_TAC (u',force_type x (type_of u'))) u let SPEC s th = CONTEXT_RULE (fun env -> SPEC (force_type ~env s (type_of_forall (concl th)))) th let SPECL tms th = try rev_itlist SPEC tms th with Failure _ -> failwith "SPECL" let GEN s th = GEN (try find ((=) s o name_of) (frees (concl th)) with _ -> parse_term s) th let GENL = itlist GEN let X_GEN_TAC s (_,c as g) = X_GEN_TAC (force_type s (type_of_forall c)) g let call_with_interface p f s = let i = !the_interface in p (); let res = f (parse_term s) in the_interface := i; res let [REAL_ARITH;REAL_FIELD;REAL_RING] = map (call_with_interface prioritize_real) [REAL_ARITH;REAL_FIELD;REAL_RING] let [ARITH_RULE;NUM_RING] = map (call_with_interface prioritize_num) [ARITH_RULE;NUM_RING] let INT_ARITH = call_with_interface prioritize_int INT_ARITH end;; (* You can add the following if complex theories are loaded: module Pa = struct include Pa let COMPLEX_FIELD = call_with_interface prioritize_complex COMPLEX_FIELD;; let SIMPLE_COMPLEX_ARITH = call_with_interface prioritize_complex SIMPLE_COMPLEX_ARITH; end;; *) hol-light/Library/rstc.ml000066400000000000000000000610371303454263000156650ustar00rootroot00000000000000(* ========================================================================= *) (* All you wanted to know about reflexive symmetric and transitive closures. *) (* ========================================================================= *) prioritize_num();; let RULE_INDUCT_TAC = MATCH_MP_TAC o DISCH_ALL o SPEC_ALL o UNDISCH o SPEC_ALL;; (* ------------------------------------------------------------------------- *) (* Little lemmas about equivalent forms of symmetry and transitivity. *) (* ------------------------------------------------------------------------- *) let SYM_ALT = prove (`!R:A->A->bool. (!x y. R x y ==> R y x) <=> (!x y. R x y <=> R y x)`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [EQ_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC; FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [th])] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let TRANS_ALT = prove (`!(R:A->A->bool) (S:A->A->bool) U. (!x z. (?y. R x y /\ S y z) ==> U x z) <=> (!x y z. R x y /\ S y z ==> U x z)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Reflexive closure *) (* ------------------------------------------------------------------------- *) let RC_RULES,RC_INDUCT,RC_CASES = new_inductive_definition `(!x y. R x y ==> RC R x y) /\ (!x:A. RC R x x)`;; let RC_INC = prove (`!(R:A->A->bool) x y. R x y ==> RC R x y`, REWRITE_TAC[RC_RULES]);; let RC_REFL = prove (`!(R:A->A->bool) x. RC R x x`, REWRITE_TAC[RC_RULES]);; let RC_EXPLICIT = prove (`!(R:A->A->bool) x y. RC R x y <=> R x y \/ (x = y)`, REWRITE_TAC[RC_CASES; EQ_SYM_EQ]);; let RC_MONO = prove (`!(R:A->A->bool) S. (!x y. R x y ==> S x y) ==> (!x y. RC R x y ==> RC S x y)`, MESON_TAC[RC_CASES]);; let RC_CLOSED = prove (`!R:A->A->bool. (RC R = R) <=> !x. R x x`, REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT] THEN MESON_TAC[]);; let RC_IDEMP = prove (`!R:A->A->bool. RC(RC R) = RC R`, REWRITE_TAC[RC_CLOSED; RC_REFL]);; let RC_SYM = prove (`!R:A->A->bool. (!x y. R x y ==> R y x) ==> (!x y. RC R x y ==> RC R y x)`, MESON_TAC[RC_CASES]);; let RC_TRANS = prove (`!R:A->A->bool. (!x y z. R x y /\ R y z ==> R x z) ==> (!x y z. RC R x y /\ RC R y z ==> RC R x z)`, REWRITE_TAC[RC_CASES] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Symmetric closure *) (* ------------------------------------------------------------------------- *) let SC_RULES,SC_INDUCT,SC_CASES = new_inductive_definition `(!x y. R x y ==> SC R x y) /\ (!x:A y. SC R x y ==> SC R y x)`;; let SC_INC = prove (`!(R:A->A->bool) x y. R x y ==> SC R x y`, REWRITE_TAC[SC_RULES]);; let SC_SYM = prove (`!(R:A->A->bool) x y. SC R x y ==> SC R y x`, REWRITE_TAC[SC_RULES]);; let SC_EXPLICIT = prove (`!R:A->A->bool. SC(R) x y <=> R x y \/ R y x`, GEN_TAC THEN EQ_TAC THENL [RULE_INDUCT_TAC SC_INDUCT THEN MESON_TAC[]; MESON_TAC[SC_CASES]]);; let SC_MONO = prove (`!(R:A->A->bool) S. (!x y. R x y ==> S x y) ==> (!x y. SC R x y ==> SC S x y)`, MESON_TAC[SC_EXPLICIT]);; let SC_CLOSED = prove (`!R:A->A->bool. (SC R = R) <=> !x y. R x y ==> R y x`, REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT] THEN MESON_TAC[]);; let SC_IDEMP = prove (`!R:A->A->bool. SC(SC R) = SC R`, REWRITE_TAC[SC_CLOSED; SC_SYM]);; let SC_REFL = prove (`!R:A->A->bool. (!x. R x x) ==> (!x. SC R x x)`, MESON_TAC[SC_EXPLICIT]);; (* ------------------------------------------------------------------------- *) (* Transitive closure *) (* ------------------------------------------------------------------------- *) let TC_RULES,TC_INDUCT,TC_CASES = new_inductive_definition `(!x y. R x y ==> TC R x y) /\ (!(x:A) y z. TC R x y /\ TC R y z ==> TC R x z)`;; let TC_INC = prove (`!(R:A->A->bool) x y. R x y ==> TC R x y`, REWRITE_TAC[TC_RULES]);; let TC_TRANS = prove (`!(R:A->A->bool) x y z. TC R x y /\ TC R y z ==> TC R x z`, REWRITE_TAC[TC_RULES]);; let TC_MONO = prove (`!(R:A->A->bool) S. (!x y. R x y ==> S x y) ==> (!x y. TC R x y ==> TC S x y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[TC_RULES]);; let TC_CLOSED = prove (`!R:A->A->bool. (TC R = R) <=> !x y z. R x y /\ R y z ==> R x z`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL [MESON_TAC[TC_RULES]; REPEAT STRIP_TAC] THEN EQ_TAC THENL [RULE_INDUCT_TAC TC_INDUCT; ALL_TAC] THEN ASM_MESON_TAC[TC_RULES]);; let TC_IDEMP = prove (`!R:A->A->bool. TC(TC R) = TC R`, REWRITE_TAC[TC_CLOSED; TC_TRANS]);; let TC_REFL = prove (`!R:A->A->bool. (!x. R x x) ==> (!x. TC R x x)`, MESON_TAC[TC_INC]);; let TC_SYM = prove (`!R:A->A->bool. (!x y. R x y ==> R y x) ==> (!x y. TC R x y ==> TC R y x)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[TC_RULES]);; (* ------------------------------------------------------------------------- *) (* Commutativity properties of the three basic closure operations *) (* ------------------------------------------------------------------------- *) let RC_SC = prove (`!R:A->A->bool. RC(SC R) = SC(RC R)`, REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);; let SC_RC = prove (`!R:A->A->bool. SC(RC R) = RC(SC R)`, REWRITE_TAC[RC_SC]);; let RC_TC = prove (`!R:A->A->bool. RC(TC R) = TC(RC R)`, REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [RULE_INDUCT_TAC RC_INDUCT THEN MESON_TAC[TC_RULES; RC_RULES; TC_MONO]; RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[RC_TRANS; TC_RULES; RC_MONO]]);; let TC_RC = prove (`!R:A->A->bool. TC(RC R) = RC(TC R)`, REWRITE_TAC[RC_TC]);; let TC_SC = prove (`!(R:A->A->bool) x y. SC(TC R) x y ==> TC(SC R) x y`, GEN_TAC THEN MATCH_MP_TAC SC_INDUCT THEN MESON_TAC[TC_MONO; TC_SYM; SC_RULES]);; let SC_TC = prove (`!(R:A->A->bool) x y. SC(TC R) x y ==> TC(SC R) x y`, REWRITE_TAC[TC_SC]);; (* ------------------------------------------------------------------------- *) (* Left and right variants of TC. *) (* ------------------------------------------------------------------------- *) let TC_TRANS_L = prove (`!(R:A->A->bool) x y z. TC R x y /\ R y z ==> TC R x z`, MESON_TAC[TC_RULES]);; let TC_TRANS_R = prove (`!(R:A->A->bool) x y z. R x y /\ TC R y z ==> TC R x z`, MESON_TAC[TC_RULES]);; let TC_CASES_L = prove (`!(R:A->A->bool) x z. TC R x z <=> R x z \/ (?y. TC R x y /\ R y z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[TC_RULES]; MESON_TAC[TC_RULES]]);; let TC_CASES_R = prove (`!(R:A->A->bool) x z. TC R x z <=> R x z \/ (?y. R x y /\ TC R y z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[TC_RULES]; MESON_TAC[TC_RULES]]);; let TC_INDUCT_L = prove (`!(R:A->A->bool) P. (!x y. R x y ==> P x y) /\ (!x y z. P x y /\ R y z ==> P x z) ==> (!x y. TC R x y ==> P x y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!y:A z. TC(R) y z ==> !x:A. P x y ==> P x z` MP_TAC THENL [MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[]; ASM_MESON_TAC[TC_CASES_R]]);; let TC_INDUCT_R = prove (`!(R:A->A->bool) P. (!x y. R x y ==> P x y) /\ (!x z. (?y. R x y /\ P y z) ==> P x z) ==> (!x y. TC R x y ==> P x y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!x:A y. TC(R) x y ==> !z:A. P y z ==> P x z` MP_TAC THENL [MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[]; ASM_MESON_TAC[TC_CASES_L]]);; (* ------------------------------------------------------------------------- *) (* Reflexive symmetric closure *) (* ------------------------------------------------------------------------- *) let RSC = new_definition `RSC(R:A->A->bool) = RC(SC R)`;; let RSC_INC = prove (`!(R:A->A->bool) x y. R x y ==> RSC R x y`, REWRITE_TAC[RSC] THEN MESON_TAC[RC_INC; SC_INC]);; let RSC_REFL = prove (`!(R:A->A->bool) x. RSC R x x`, REWRITE_TAC[RSC; RC_REFL]);; let RSC_SYM = prove (`!(R:A->A->bool) x y. RSC R x y ==> RSC R y x`, REWRITE_TAC[RSC; RC_SC; SC_SYM]);; let RSC_CASES = prove (`!(R:A->A->bool) x y. RSC R x y <=> (x = y) \/ R x y \/ R y x`, REWRITE_TAC[RSC; RC_EXPLICIT; SC_EXPLICIT; DISJ_ACI]);; let RSC_INDUCT = prove (`!(R:A->A->bool) P. (!x y. R x y ==> P x y) /\ (!x. P x x) /\ (!x y. P x y ==> P y x) ==> !x y. RSC R x y ==> P x y`, REWRITE_TAC[RSC; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);; let RSC_MONO = prove (`!(R:A->A->bool) S. (!x y. R x y ==> S x y) ==> (!x y. RSC R x y ==> RSC S x y)`, REWRITE_TAC[RSC] THEN MESON_TAC[SC_MONO; RC_MONO]);; let RSC_CLOSED = prove (`!R:A->A->bool. (RSC R = R) <=> (!x. R x x) /\ (!x y. R x y ==> R y x)`, REWRITE_TAC[FUN_EQ_THM; RSC; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);; let RSC_IDEMP = prove (`!R:A->A->bool. RSC(RSC R) = RSC R`, REWRITE_TAC[RSC_CLOSED; RSC_REFL; RSC_SYM]);; (* ------------------------------------------------------------------------- *) (* Reflexive transitive closure *) (* ------------------------------------------------------------------------- *) let RTC = new_definition `RTC(R:A->A->bool) = RC(TC R)`;; let RTC_INC = prove (`!(R:A->A->bool) x y. R x y ==> RTC R x y`, REWRITE_TAC[RTC] THEN MESON_TAC[RC_INC; TC_INC]);; let RTC_REFL = prove (`!(R:A->A->bool) x. RTC R x x`, REWRITE_TAC[RTC; RC_REFL]);; let RTC_TRANS = prove (`!(R:A->A->bool) x y z. RTC R x y /\ RTC R y z ==> RTC R x z`, REWRITE_TAC[RTC; RC_TC; TC_TRANS]);; let RTC_RULES = prove (`!(R:A->A->bool). (!x y. R x y ==> RTC R x y) /\ (!x. RTC R x x) /\ (!x y z. RTC R x y /\ RTC R y z ==> RTC R x z)`, REWRITE_TAC[RTC_INC; RTC_REFL; RTC_TRANS]);; let RTC_TRANS_L = prove (`!(R:A->A->bool) x y z. RTC R x y /\ R y z ==> RTC R x z`, REWRITE_TAC[RTC; RC_TC] THEN MESON_TAC[TC_TRANS_L; RC_INC]);; let RTC_TRANS_R = prove (`!(R:A->A->bool) x y z. R x y /\ RTC R y z ==> RTC R x z`, REWRITE_TAC[RTC; RC_TC] THEN MESON_TAC[TC_TRANS_R; RC_INC]);; let RTC_CASES = prove (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. RTC R x y /\ RTC R y z`, REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_TRANS]);; let RTC_CASES_L = prove (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. RTC R x y /\ R y z`, REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_CASES_L; TC_TRANS_L]);; let RTC_CASES_R = prove (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. R x y /\ RTC R y z`, REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_CASES_R; TC_TRANS_R]);; let RTC_INDUCT = prove (`!(R:A->A->bool) P. (!x y. R x y ==> P x y) /\ (!x. P x x) /\ (!x y z. P x y /\ P y z ==> P x z) ==> !x y. RTC R x y ==> P x y`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN MATCH_MP_TAC TC_INDUCT THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);; let RTC_INDUCT_L = prove (`!(R:A->A->bool) P. (!x. P x x) /\ (!x y z. P x y /\ R y z ==> P x z) ==> !x y. RTC R x y ==> P x y`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN MATCH_MP_TAC TC_INDUCT_L THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);; let RTC_INDUCT_R = prove (`!(R:A->A->bool) P. (!x. P x x) /\ (!x y z. R x y /\ P y z ==> P x z) ==> !x y. RTC R x y ==> P x y`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN MATCH_MP_TAC TC_INDUCT_R THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);; let RTC_MONO = prove (`!(R:A->A->bool) S. (!x y. R x y ==> S x y) ==> (!x y. RTC R x y ==> RTC S x y)`, REWRITE_TAC[RTC] THEN MESON_TAC[RC_MONO; TC_MONO]);; let RTC_CLOSED = prove (`!R:A->A->bool. (RTC R = R) <=> (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z)`, REWRITE_TAC[FUN_EQ_THM; RTC; RC_EXPLICIT] THEN MESON_TAC[TC_CLOSED; TC_RULES]);; let RTC_IDEMP = prove (`!R:A->A->bool. RTC(RTC R) = RTC R`, REWRITE_TAC[RTC_CLOSED; RTC_REFL; RTC_TRANS]);; let RTC_SYM = prove (`!R:A->A->bool. (!x y. R x y ==> R y x) ==> (!x y. RTC R x y ==> RTC R y x)`, REWRITE_TAC[RTC] THEN MESON_TAC[RC_SYM; TC_SYM]);; let RTC_STUTTER = prove (`RTC R = RTC (\x y. R x y /\ ~(x = y))`, REWRITE_TAC[RC_TC; RTC] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[RC_CASES] THEN MESON_TAC[]);; let TC_RTC_CASES_L = prove (`TC R x z <=> ?y. RTC R x y /\ R y z`, REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_CASES_L; TC_INC]);; let TC_RTC_CASES_R = prove (`!R x z. TC R x z <=> ?y. R x y /\ RTC R y z`, REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_CASES_R; TC_INC]);; let TC_TC_RTC_CASES = prove (`!R x z. TC R x z <=> ?y. TC R x y /\ RTC R y z`, REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_TRANS]);; let TC_RTC_TC_CASES = prove (`!R x z. TC R x z <=> ?y. RTC R x y /\ TC R y z`, REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_TRANS]);; let RTC_NE_IMP_TC = prove (`!R x y. RTC R x y /\ ~(x = y) ==> TC R x y`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM IMP_IMP] THEN MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[] THEN MESON_TAC[TC_INC; TC_CASES]);; (* ------------------------------------------------------------------------- *) (* Symmetric transitive closure *) (* ------------------------------------------------------------------------- *) let STC = new_definition `STC(R:A->A->bool) = TC(SC R)`;; let STC_INC = prove (`!(R:A->A->bool) x y. R x y ==> STC R x y`, REWRITE_TAC[STC] THEN MESON_TAC[SC_INC; TC_INC]);; let STC_SYM = prove (`!(R:A->A->bool) x y. STC R x y ==> STC R y x`, REWRITE_TAC[STC] THEN MESON_TAC[TC_SYM; SC_SYM]);; let STC_TRANS = prove (`!(R:A->A->bool) x y z. STC R x y /\ STC R y z ==> STC R x z`, REWRITE_TAC[STC; TC_TRANS]);; let STC_TRANS_L = prove (`!(R:A->A->bool) x y z. STC R x y /\ R y z ==> STC R x z`, REWRITE_TAC[STC] THEN MESON_TAC[TC_TRANS_L; SC_INC]);; let STC_TRANS_R = prove (`!(R:A->A->bool) x y z. R x y /\ STC R y z ==> STC R x z`, REWRITE_TAC[STC] THEN MESON_TAC[TC_TRANS_R; SC_INC]);; let STC_CASES = prove (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/ ?y. STC R x y /\ STC R y z`, REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);; let STC_CASES_L = prove (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/ ?y. STC R x y /\ R y z`, REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);; let STC_CASES_R = prove (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/ ?y. R x y /\ STC R y z`, REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);; let STC_INDUCT = prove (`!(R:A->A->bool) P. (!x y. R x y ==> P x y) /\ (!x y. P x y ==> P y x) /\ (!x y z. P x y /\ P y z ==> P x z) ==> !x y. STC R x y ==> P x y`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[STC] THEN MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[SC_EXPLICIT]);; let STC_MONO = prove (`!(R:A->A->bool) S. (!x y. R x y ==> S x y) ==> (!x y. STC R x y ==> STC S x y)`, REWRITE_TAC[STC] THEN MESON_TAC[SC_MONO; TC_MONO]);; let STC_CLOSED = prove (`!R:A->A->bool. (STC R = R) <=> (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z)`, GEN_TAC THEN REWRITE_TAC[STC; SC_EXPLICIT] THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN MESON_TAC[TC_TRANS; TC_SYM; SC_SYM]; REWRITE_TAC[GSYM SC_CLOSED; GSYM TC_CLOSED] THEN MESON_TAC[]]);; let STC_IDEMP = prove (`!R:A->A->bool. STC(STC R) = STC R`, REWRITE_TAC[STC_CLOSED; STC_SYM; STC_TRANS]);; let STC_REFL = prove (`!R:A->A->bool. (!x. R x x) ==> !x. STC R x x`, MESON_TAC[STC_INC]);; (* ------------------------------------------------------------------------- *) (* Reflexive symmetric transitive closure (smallest equivalence relation) *) (* ------------------------------------------------------------------------- *) let RSTC = new_definition `RSTC(R:A->A->bool) = RC(TC(SC R))`;; let RSTC_INC = prove (`!(R:A->A->bool) x y. R x y ==> RSTC R x y`, REWRITE_TAC[RSTC] THEN MESON_TAC[RC_INC; TC_INC; SC_INC]);; let RSTC_REFL = prove (`!(R:A->A->bool) x. RSTC R x x`, REWRITE_TAC[RSTC; RC_REFL]);; let RSTC_SYM = prove (`!(R:A->A->bool) x y. RSTC R x y ==> RSTC R y x`, REWRITE_TAC[RSTC] THEN MESON_TAC[SC_SYM; TC_SYM; RC_SYM]);; let RSTC_TRANS = prove (`!(R:A->A->bool) x y z. RSTC R x y /\ RSTC R y z ==> RSTC R x z`, REWRITE_TAC[RSTC; RC_TC; TC_TRANS]);; let RSTC_RULES = prove (`!(R:A->A->bool). (!x y. R x y ==> RSTC R x y) /\ (!x. RSTC R x x) /\ (!x y. RSTC R x y ==> RSTC R y x) /\ (!x y z. RSTC R x y /\ RSTC R y z ==> RSTC R x z)`, REWRITE_TAC[RSTC_INC; RSTC_REFL; RSTC_SYM; RSTC_TRANS]);; let RSTC_TRANS_L = prove (`!(R:A->A->bool) x y z. RSTC R x y /\ R y z ==> RSTC R x z`, REWRITE_TAC[RSTC; RC_TC] THEN MESON_TAC[TC_TRANS_L; RC_INC; SC_INC]);; let RSTC_TRANS_R = prove (`!(R:A->A->bool) x y z. R x y /\ RSTC R y z ==> RSTC R x z`, REWRITE_TAC[RSTC; RC_TC] THEN MESON_TAC[TC_TRANS_R; RC_INC; SC_INC]);; let RSTC_CASES = prove (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/ ?y. RSTC R x y /\ RSTC R y z`, REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN MESON_TAC[STC_CASES; RC_CASES]);; let RSTC_CASES_L = prove (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/ ?y. RSTC R x y /\ R y z`, REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN MESON_TAC[STC_CASES_L; RC_CASES]);; let RSTC_CASES_R = prove (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/ ?y. R x y /\ RSTC R y z`, REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN MESON_TAC[STC_CASES_R; RC_CASES]);; let RSTC_INDUCT = prove (`!(R:A->A->bool) P. (!x y. R x y ==> P x y) /\ (!x. P x x) /\ (!x y. P x y ==> P y x) /\ (!x y z. P x y /\ P y z ==> P x z) ==> !x y. RSTC R x y ==> P x y`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN MATCH_MP_TAC STC_INDUCT THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);; let RSTC_MONO = prove (`!(R:A->A->bool) S. (!x y. R x y ==> S x y) ==> (!x y. RSTC R x y ==> RSTC S x y)`, REWRITE_TAC[RSTC] THEN MESON_TAC[RC_MONO; SC_MONO; TC_MONO]);; let RSTC_CLOSED = prove (`!R:A->A->bool. (RSTC R = R) <=> (!x. R x x) /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z)`, REWRITE_TAC[RSTC] THEN REWRITE_TAC[GSYM STC; GSYM STC_CLOSED] THEN REWRITE_TAC[RC_EXPLICIT; FUN_EQ_THM] THEN MESON_TAC[STC_INC]);; let RSTC_IDEMP = prove (`!R:A->A->bool. RSTC(RSTC R) = RSTC R`, REWRITE_TAC[RSTC_CLOSED; RSTC_REFL; RSTC_SYM; RSTC_TRANS]);; (* ------------------------------------------------------------------------- *) (* Finally, we prove the inclusion properties for composite closures *) (* ------------------------------------------------------------------------- *) let RSC_INC_RC = prove (`!R:A->A->bool. !x y. RC R x y ==> RSC R x y`, REWRITE_TAC[RSC; RC_SC; SC_INC]);; let RSC_INC_SC = prove (`!R:A->A->bool. !x y. SC R x y ==> RSC R x y`, REWRITE_TAC[RSC; RC_INC]);; let RTC_INC_RC = prove (`!R:A->A->bool. !x y. RC R x y ==> RTC R x y`, REWRITE_TAC[RTC; RC_TC; TC_INC]);; let RTC_INC_TC = prove (`!R:A->A->bool. !x y. TC R x y ==> RTC R x y`, REWRITE_TAC[RTC; RC_INC]);; let STC_INC_SC = prove (`!R:A->A->bool. !x y. SC R x y ==> STC R x y`, REWRITE_TAC[STC; TC_INC]);; let STC_INC_TC = prove (`!R:A->A->bool. !x y. TC R x y ==> STC R x y`, REWRITE_TAC[STC] THEN MESON_TAC[TC_MONO; SC_INC]);; let RSTC_INC_RC = prove (`!R:A->A->bool. !x y. RC R x y ==> RSTC R x y`, REWRITE_TAC[RSTC; RC_TC; RC_SC; GSYM STC; STC_INC]);; let RSTC_INC_SC = prove (`!R:A->A->bool. !x y. SC R x y ==> RSTC R x y`, REWRITE_TAC[RSTC; GSYM RTC; RTC_INC]);; let RSTC_INC_TC = prove (`!R:A->A->bool. !x y. TC R x y ==> RSTC R x y`, REWRITE_TAC[RSTC; RC_TC; GSYM RSC] THEN MESON_TAC[TC_MONO; RSC_INC]);; let RSTC_INC_RSC = prove (`!R:A->A->bool. !x y. RSC R x y ==> RSTC R x y`, REWRITE_TAC[RSC; RSTC; RC_TC; TC_INC]);; let RSTC_INC_RTC = prove (`!R:A->A->bool. !x y. RTC R x y ==> RSTC R x y`, REWRITE_TAC[GSYM RTC; RSTC] THEN MESON_TAC[RTC_MONO; SC_INC]);; let RSTC_INC_STC = prove (`!R:A->A->bool. !x y. STC R x y ==> RSTC R x y`, REWRITE_TAC[GSYM STC; RSTC; RC_INC]);; (* ------------------------------------------------------------------------- *) (* Handy things about reverse relations. *) (* ------------------------------------------------------------------------- *) let INV = new_definition `INV R (x:A) (y:B) <=> R y x`;; let RC_INV = prove (`RC(INV R) = INV(RC R)`, REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT; INV; EQ_SYM_EQ]);; let SC_INV = prove (`SC(INV R) = INV(SC R)`, REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT; INV; DISJ_SYM]);; let SC_INV_STRONG = prove (`SC(INV R) = SC R`, REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT; INV; DISJ_SYM]);; let TC_INV = prove (`TC(INV R) = INV(TC R)`, REWRITE_TAC[FUN_EQ_THM; INV] THEN REPEAT GEN_TAC THEN EQ_TAC THEN RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[INV; TC_RULES]);; let RSC_INV = prove (`RSC(INV R) = INV(RSC R)`, REWRITE_TAC[RSC; RC_INV; SC_INV]);; let RTC_INV = prove (`RTC(INV R) = INV(RTC R)`, REWRITE_TAC[RTC; RC_INV; TC_INV]);; let STC_INV = prove (`STC(INV R) = INV(STC R)`, REWRITE_TAC[STC; SC_INV; TC_INV]);; let RSTC_INV = prove (`RSTC(INV R) = INV(RSTC R)`, REWRITE_TAC[RSTC; RC_INV; SC_INV; TC_INV]);; (* ------------------------------------------------------------------------- *) (* An iterative version of (R)TC. *) (* ------------------------------------------------------------------------- *) let RELPOW = new_recursive_definition num_RECURSION `(RELPOW 0 (R:A->A->bool) x y <=> (x = y)) /\ (RELPOW (SUC n) R x y <=> ?z. RELPOW n R x z /\ R z y)`;; let RELPOW_R = prove (`(RELPOW 0 (R:A->A->bool) x y <=> (x = y)) /\ (RELPOW (SUC n) R x y <=> ?z. R x z /\ RELPOW n R z y)`, CONJ_TAC THENL [REWRITE_TAC[RELPOW]; ALL_TAC] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`x:A`; `y:A`; `n:num`] THEN INDUCT_TAC THEN ASM_MESON_TAC[RELPOW]);; let RELPOW_M = prove (`!m n x:A y. RELPOW (m + n) R x y <=> ?z. RELPOW m R x z /\ RELPOW n R z y`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; RELPOW_R; UNWIND_THM1] THEN MESON_TAC[]);; let RTC_RELPOW = prove (`!R (x:A) y. RTC R x y <=> ?n. RELPOW n R x y`, REPEAT GEN_TAC THEN EQ_TAC THENL [RULE_INDUCT_TAC RTC_INDUCT_L THEN MESON_TAC[RELPOW]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`y:A`,`y:A`) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN REWRITE_TAC[RELPOW] THEN ASM_MESON_TAC[RTC_REFL; RTC_TRANS_L]]);; let TC_RELPOW = prove (`!R (x:A) y. TC R x y <=> ?n. RELPOW (SUC n) R x y`, REWRITE_TAC[RELPOW] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; GSYM RTC_RELPOW] THEN ONCE_REWRITE_TAC[TC_CASES_L] THEN REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[]);; let RELPOW_SEQUENCE = prove (`!R n x y. RELPOW n R x y <=> ?f. (f(0) = x:A) /\ (f(n) = y) /\ !i. i < n ==> R (f i) (f(SUC i))`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; RELPOW] THENL [REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `\n:num. y:A` THEN REWRITE_TAC[]; MESON_TAC[]]; REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [DISJ_CASES_TAC(ARITH_RULE `(n = 0) \/ 0 < n`) THENL [EXISTS_TAC `\i. if i = 0 then x else y:A` THEN ASM_REWRITE_TAC[ARITH; LT] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_SUC] THEN ASM_MESON_TAC[]; EXISTS_TAC `\i. if i <= n then f(i) else (y:A)` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC n <= n)`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC n <= n)`] THEN ASM_REWRITE_TAC[LE_SUC_LT] THEN ASM_REWRITE_TAC[LE_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; EXISTS_TAC `(f:num->A) n` THEN CONJ_TAC THENL [EXISTS_TAC `f:num->A` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[]]]]);; hol-light/Library/transc.ml000066400000000000000000011413471303454263000162100ustar00rootroot00000000000000(* ======================================================================== *) (* Properties of power series. *) (* ======================================================================== *) needs "Library/analysis.ml";; (* ------------------------------------------------------------------------ *) (* More theorems about rearranging finite sums *) (* ------------------------------------------------------------------------ *) let POWDIFF_LEMMA = prove( `!n x y. sum(0,SUC n)(\p. (x pow p) * y pow ((SUC n) - p)) = y * sum(0,SUC n)(\p. (x pow p) * (y pow (n - p)))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN BETA_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN SUBGOAL_THEN `~(n < p:num)` ASSUME_TAC THENL [POP_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[NOT_LT; CONJUNCT2 LT] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN REWRITE_TAC[LE_REFL; LT_IMP_LE]; ASM_REWRITE_TAC[SUB_OLD] THEN REWRITE_TAC[pow] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);; let POWDIFF = prove( `!n x y. (x pow (SUC n)) - (y pow (SUC n)) = (x - y) * sum(0,SUC n)(\p. (x pow p) * (y pow (n - p)))`, INDUCT_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[sum] THEN REWRITE_TAC[REAL_ADD_LID; ADD_CLAUSES; SUB_0] THEN BETA_TAC THEN REWRITE_TAC[pow] THEN REWRITE_TAC[REAL_MUL_RID]; REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[sum] THEN REWRITE_TAC[ADD_CLAUSES] THEN BETA_TAC THEN REWRITE_TAC[POWDIFF_LEMMA] THEN REWRITE_TAC[REAL_LDISTRIB] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * (b * c) = b * (a * c)`] THEN POP_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[SUB_REFL] THEN SPEC_TAC(`SUC n`,`n:num`) THEN GEN_TAC THEN REWRITE_TAC[pow; REAL_MUL_RID] THEN REWRITE_TAC[REAL_LDISTRIB; REAL_SUB_LDISTRIB] THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (d + a) + (c + b)`] THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [REAL_MUL_SYM] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ADD_LINV]]);; let POWREV = prove( `!n x y. sum(0,SUC n)(\p. (x pow p) * (y pow (n - p))) = sum(0,SUC n)(\p. (x pow (n - p)) * (y pow p))`, let REAL_EQ_LMUL2' = CONV_RULE(REDEPTH_CONV FORALL_IMP_CONV) REAL_EQ_LMUL2 in REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real = y` THENL [ASM_REWRITE_TAC[GSYM POW_ADD] THEN MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN BETA_TAC THEN DISCH_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC ADD_SYM; GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_0]) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_EQ_LMUL2' th]) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_NEGNEG] THEN ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN ONCE_REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[GSYM POWDIFF] THEN REWRITE_TAC[REAL_NEG_SUB]]);; (* ------------------------------------------------------------------------ *) (* Show (essentially) that a power series has a "circle" of convergence, *) (* i.e. if it sums for x, then it sums absolutely for z with |z| < |x|. *) (* ------------------------------------------------------------------------ *) let POWSER_INSIDEA = prove( `!f x z. summable (\n. f(n) * (x pow n)) /\ abs(z) < abs(x) ==> summable (\n. abs(f(n)) * (z pow n))`, let th = (GEN_ALL o CONV_RULE LEFT_IMP_EXISTS_CONV o snd o EQ_IMP_RULE o SPEC_ALL) convergent in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_ZERO) THEN DISCH_THEN(MP_TAC o MATCH_MP th) THEN REWRITE_TAC[GSYM SEQ_CAUCHY] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_CBOUNDED) THEN REWRITE_TAC[SEQ_BOUNDED] THEN BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `K:real`) THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. (K * abs(z pow n)) / abs(x pow n)` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN MATCH_MP_TAC REAL_LE_RDIV THEN CONJ_TAC THENL [REWRITE_TAC[GSYM ABS_NZ] THEN MATCH_MP_TAC POW_NZ THEN REWRITE_TAC[ABS_NZ] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(z)` THEN ASM_REWRITE_TAC[ABS_POS]; REWRITE_TAC[ABS_MUL; ABS_ABS; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN DISJ_CASES_TAC(SPEC `z pow n` ABS_CASES) THEN ASM_REWRITE_TAC[ABS_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[GSYM ABS_MUL]]; REWRITE_TAC[summable] THEN EXISTS_TAC `K * inv(&1 - (abs(z) / abs(x)))` THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN MATCH_MP_TAC SER_CMUL THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM real_div] THEN SUBGOAL_THEN `!n. abs(z pow n) / abs(x pow n) = (abs(z) / abs(x)) pow n` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ALL_TAC; REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC GP THEN REWRITE_TAC[real_div; ABS_MUL] THEN SUBGOAL_THEN `~(abs(x) = &0)` (SUBST1_TAC o MATCH_MP ABS_INV) THENL [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `abs(z) < &0` THEN REWRITE_TAC[REAL_NOT_LT; ABS_POS]; REWRITE_TAC[ABS_ABS; GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN ASM_REWRITE_TAC[ABS_POS]]] THEN REWRITE_TAC[GSYM POW_ABS] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[real_div; POW_MUL] THEN AP_TERM_TAC THEN MATCH_MP_TAC POW_INV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(z)` THEN ASM_REWRITE_TAC[ABS_POS]]);; (* ------------------------------------------------------------------------ *) (* Weaker but more commonly useful form for non-absolute convergence *) (* ------------------------------------------------------------------------ *) let POWSER_INSIDE = prove( `!f x z. summable (\n. f(n) * (x pow n)) /\ abs(z) < abs(x) ==> summable (\n. f(n) * (z pow n))`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(SPEC `z:real` ABS_ABS)) THEN DISCH_THEN(MP_TAC o MATCH_MP POWSER_INSIDEA) THEN REWRITE_TAC[POW_ABS; GSYM ABS_MUL] THEN DISCH_THEN((then_) (MATCH_MP_TAC SER_ACONV) o MP_TAC) THEN BETA_TAC THEN DISCH_THEN ACCEPT_TAC);; (* ------------------------------------------------------------------------ *) (* Define formal differentiation of power series *) (* ------------------------------------------------------------------------ *) let diffs = new_definition `diffs c = (\n. &(SUC n) * c(SUC n))`;; (* ------------------------------------------------------------------------ *) (* Lemma about distributing negation over it *) (* ------------------------------------------------------------------------ *) let DIFFS_NEG = prove( `!c. diffs(\n. --(c n)) = \n. --((diffs c) n)`, GEN_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[REAL_NEG_RMUL]);; (* ------------------------------------------------------------------------ *) (* Show that we can shift the terms down one *) (* ------------------------------------------------------------------------ *) let DIFFS_LEMMA = prove( `!n c x. sum(0,n) (\n. (diffs c)(n) * (x pow n)) = sum(0,n) (\n. &n * c(n) * (x pow (n - 1))) + (&n * c(n) * x pow (n - 1))`, INDUCT_TAC THEN ASM_REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_ADD_LID] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN AP_TERM_TAC THEN BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN AP_TERM_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[SUC_SUB1; REAL_MUL_ASSOC]);; let DIFFS_LEMMA2 = prove( `!n c x. sum(0,n) (\n. &n * c(n) * (x pow (n - 1))) = sum(0,n) (\n. (diffs c)(n) * (x pow n)) - (&n * c(n) * x pow (n - 1))`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD; DIFFS_LEMMA]);; let DIFFS_EQUIV = prove( `!c x. summable(\n. (diffs c)(n) * (x pow n)) ==> (\n. &n * c(n) * (x pow (n - 1))) sums (suminf(\n. (diffs c)(n) * (x pow n)))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o REWRITE_RULE[diffs] o MATCH_MP SER_ZERO) THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN DISCH_TAC THEN SUBGOAL_THEN `(\n. &n * c(n) * (x pow (n - 1))) tends_num_real &0` MP_TAC THENL [ONCE_REWRITE_TAC[SEQ_SUC] THEN BETA_TAC THEN ASM_REWRITE_TAC[SUC_SUB1]; ALL_TAC] THEN DISCH_THEN(MP_TAC o CONJ (MATCH_MP SUMMABLE_SUM (ASSUME `summable(\n. (diffs c)(n) * (x pow n))`))) THEN REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUB) THEN BETA_TAC THEN REWRITE_TAC[GSYM DIFFS_LEMMA2] THEN REWRITE_TAC[REAL_SUB_RZERO]);; (* ======================================================================== *) (* Show term-by-term differentiability of power series *) (* (NB we hypothesize convergence of first two derivatives; we could prove *) (* they all have the same radius of convergence, but we don't need to.) *) (* ======================================================================== *) let TERMDIFF_LEMMA1 = prove( `!m z h. sum(0,m)(\p. (((z + h) pow (m - p)) * (z pow p)) - (z pow m)) = sum(0,m)(\p. (z pow p) * (((z + h) pow (m - p)) - (z pow (m - p))))`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_LDISTRIB; GSYM POW_ADD] THEN BINOP_TAC THENL [MATCH_ACCEPT_TAC REAL_MUL_SYM; AP_TERM_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUB_ADD THEN MATCH_MP_TAC LT_IMP_LE THEN POP_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ADD_CLAUSES]]);; let TERMDIFF_LEMMA2 = prove( `!z h. ~(h = &0) ==> (((((z + h) pow n) - (z pow n)) / h) - (&n * (z pow (n - 1))) = h * sum(0,n - 1)(\p. (z pow p) * sum(0,(n - 1) - p) (\q. ((z + h) pow q) * (z pow (((n - 2) - p) - q)))))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_EQ_LMUL2 th]) THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_LMUL th]) THEN DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `m:num` SUBST1_TAC) (SPEC `n:num` num_CASES) THENL [REWRITE_TAC[pow; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL] THEN REWRITE_TAC[SUB_0; sum; REAL_MUL_RZERO]; ALL_TAC] THEN REWRITE_TAC[POWDIFF; REAL_ADD_SUB] THEN ASM_REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_EQ_LMUL] THEN REWRITE_TAC[SUC_SUB1] THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [POWREV] THEN REWRITE_TAC[sum] THEN REWRITE_TAC[ADD_CLAUSES] THEN BETA_TAC THEN REWRITE_TAC[SUB_REFL] THEN REWRITE_TAC[REAL; pow] THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID; REAL_RDISTRIB] THEN REWRITE_TAC[REAL_ADD2_SUB2; REAL_SUB_REFL; REAL_ADD_RID] THEN REWRITE_TAC[SUM_NSUB] THEN BETA_TAC THEN REWRITE_TAC[TERMDIFF_LEMMA1] THEN ONCE_REWRITE_TAC[GSYM SUM_CMUL] THEN BETA_TAC THEN MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN BETA_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[POWDIFF; REAL_ADD_SUB] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `q:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[SUB_SUC; SUB_0; ADD_SUB]);; let TERMDIFF_LEMMA3 = prove( `!z h n K. ~(h = &0) /\ abs(z) <= K /\ abs(z + h) <= K ==> abs(((((z + h) pow n) - (z pow n)) / h) - (&n * (z pow (n - 1)))) <= &n * &(n - 1) * (K pow (n - 2)) * abs(h)`, let tac = W((then_) (MATCH_MP_TAC REAL_LE_TRANS) o EXISTS_TAC o rand o concl o PART_MATCH (rand o rator) ABS_SUM o rand o rator o snd) THEN REWRITE_TAC[ABS_SUM] in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP TERMDIFF_LEMMA2 th]) THEN REWRITE_TAC[ABS_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN FIRST_ASSUM(ASSUME_TAC o CONV_RULE(REWR_CONV ABS_NZ)) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_LE_LMUL_LOCAL th]) THEN tac THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC SUM_BOUND THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN STRIP_ASSUME_TAC THEN BETA_TAC THEN REWRITE_TAC[ABS_MUL] THEN DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) (SPEC `n:num` num_CASES) THENL [REWRITE_TAC[SUB_0; sum; ABS_0; REAL_MUL_RZERO; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[SUC_SUB1; num_CONV `2`; SUB_SUC] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUC_SUB1]) THEN SUBGOAL_THEN `p < r:num` MP_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[ADD_CLAUSES; SUC_SUB1; ADD_SUB] THEN REWRITE_TAC[POW_ADD] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `(a * b) * c = b * (c * a)`] THEN MATCH_MP_TAC REAL_LE_MUL2V THEN REWRITE_TAC[ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM POW_ABS] THEN MATCH_MP_TAC POW_LE THEN ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC d) * (K pow d)` THEN CONJ_TAC THENL [ALL_TAC; SUBGOAL_THEN `&0 <= K` MP_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs z` THEN ASM_REWRITE_TAC[ABS_POS]; DISCH_THEN(MP_TAC o SPEC `d:num` o MATCH_MP POW_POS) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN REWRITE_TAC[REAL_LE; LE_SUC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC d` THEN REWRITE_TAC[LE_SUC; LE_ADD] THEN MATCH_MP_TAC LT_IMP_LE THEN REWRITE_TAC[LESS_SUC_REFL]; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]]] THEN tac THEN MATCH_MP_TAC SUM_BOUND THEN X_GEN_TAC `q:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN UNDISCH_TAC `q < (SUC d)` THEN DISCH_THEN(X_CHOOSE_THEN `e:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; SUC_INJ] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[POW_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2V THEN REWRITE_TAC[ABS_POS; GSYM POW_ABS] THEN CONJ_TAC THEN MATCH_MP_TAC POW_LE THEN ASM_REWRITE_TAC[ABS_POS]);; let TERMDIFF_LEMMA4 = prove( `!f K k. &0 < k /\ (!h. &0 < abs(h) /\ abs(h) < k ==> abs(f h) <= K * abs(h)) ==> (f tends_real_real &0)(&0)`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[LIM; REAL_SUB_RZERO] THEN SUBGOAL_THEN `&0 <= K` MP_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `k / &2`) THEN MP_TAC(ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1] (ASSUME `&0 < k`)) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN DISCH_THEN(fun th -> REWRITE_TAC[th; real_abs]) THEN REWRITE_TAC[GSYM real_abs] THEN ASM_REWRITE_TAC[REAL_LT_HALF1; REAL_LT_HALF2] THEN DISCH_TAC THEN MP_TAC(GEN_ALL(MATCH_MP REAL_LE_RMUL_EQ (ASSUME `&0 < k / &2`))) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(k / &2))` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; ABS_POS]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [ALL_TAC; EXISTS_TAC `k:real` THEN REWRITE_TAC[ASSUME `&0 < k`] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN DISCH_THEN(MP_TAC o C CONJ(SPEC `(f:real->real) x` ABS_POS)) THEN REWRITE_TAC[REAL_LE_ANTISYM] THEN DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM ACCEPT_TAC] THEN SUBGOAL_THEN `&0 < (e / K) / &2` ASSUME_TAC THENL [REWRITE_TAC[real_div] THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]; ALL_TAC] THEN MP_TAC(SPECL [`(e / K) / &2`; `k:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `K * abs(h)` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `K * d` THEN ASM_REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ (ASSUME `&0 < K`)] THEN ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RDIV (ASSUME `&0 < K`))] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (c * a) * b`] THEN ASSUME_TAC(GSYM(MATCH_MP REAL_LT_IMP_NE (ASSUME `&0 < K`))) THEN REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(K = &0)`)] THEN REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `(e / K) / &2` THEN ASM_REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_LT_HALF2] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_HALF1] THEN ASM_REWRITE_TAC[]]);; let TERMDIFF_LEMMA5 = prove( `!f g k. &0 < k /\ summable(f) /\ (!h. &0 < abs(h) /\ abs(h) < k ==> !n. abs(g(h) n) <= (f(n) * abs(h))) ==> ((\h. suminf(g h)) tends_real_real &0)(&0)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP SUMMABLE_SUM) MP_TAC) THEN ASSUME_TAC((GEN `h:real` o SPEC `abs(h)` o MATCH_MP SER_CMUL) (ASSUME `f sums (suminf f)`)) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_MUL_SYM]) THEN FIRST_ASSUM(ASSUME_TAC o GEN `h:real` o MATCH_MP SUM_UNIQ o SPEC `h:real`) THEN DISCH_TAC THEN C SUBGOAL_THEN ASSUME_TAC `!h. &0 < abs(h) /\ abs(h) < k ==> abs(suminf(g h)) <= (suminf(f) * abs(h))` THENL [GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_TAC THEN SUBGOAL_THEN `summable(\n. f(n) * abs(h))` ASSUME_TAC THENL [MATCH_MP_TAC SUM_SUMMABLE THEN EXISTS_TAC `suminf(f) * abs(h)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `summable(\n. abs(g(h:real)(n:num)))` ASSUME_TAC THENL [MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n:num. f(n) * abs(h)` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN REWRITE_TAC[ABS_ABS] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `suminf(\n. abs(g(h:real)(n:num)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SER_ABS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SER_LE THEN REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN GEN_TAC THEN BETA_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC TERMDIFF_LEMMA4 THEN MAP_EVERY EXISTS_TAC [`suminf(f)`; `k:real`] THEN BETA_TAC THEN ASM_REWRITE_TAC[]);; let TERMDIFF = prove( `!c K. summable(\n. c(n) * (K pow n)) /\ summable(\n. (diffs c)(n) * (K pow n)) /\ summable(\n. (diffs(diffs c))(n) * (K pow n)) /\ abs(x) < abs(K) ==> ((\x. suminf (\n. c(n) * (x pow n))) diffl (suminf (\n. (diffs c)(n) * (x pow n))))(x)`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[diffl] THEN BETA_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\h. suminf(\n. ((c(n) * ((x + h) pow n)) - (c(n) * (x pow n))) / h)` THEN CONJ_TAC THENL [BETA_TAC THEN REWRITE_TAC[LIM] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `abs(K) - abs(x)` THEN REWRITE_TAC[REAL_SUB_LT] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP ABS_CIRCLE) THEN W(fun (asl,w) -> SUBGOAL_THEN (mk_eq(rand(rator w),`&0`)) SUBST1_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_ZERO] THEN REWRITE_TAC[REAL_SUB_0] THEN C SUBGOAL_THEN MP_TAC `(\n. (c n) * (x pow n)) sums (suminf(\n. (c n) * (x pow n))) /\ (\n. (c n) * ((x + h) pow n)) sums (suminf(\n. (c n) * ((x + h) pow n)))` THENL [CONJ_TAC THEN MATCH_MP_TAC SUMMABLE_SUM THEN MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN DISCH_THEN(MP_TAC o SPEC `h:real` o MATCH_MP SER_CDIV) THEN BETA_TAC THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP SUM_UNIQ); ALL_TAC] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN BETA_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\h. suminf (\n. c(n) * (((((x + h) pow n) - (x pow n)) / h) - (&n * (x pow (n - 1)))))` THEN BETA_TAC THEN CONJ_TAC THENL [REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `abs(K) - abs(x)` THEN REWRITE_TAC[REAL_SUB_LT] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP ABS_CIRCLE) THEN W(fun (asl,w) -> SUBGOAL_THEN (mk_eq(rand(rator w),`&0`)) SUBST1_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO; ABS_ZERO] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN SUBGOAL_THEN `summable(\n. (diffs c)(n) * (x pow n))` MP_TAC THENL [MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC (MATCH_MP DIFFS_EQUIV th)) THEN DISCH_THEN(fun th -> SUBST1_TAC (MATCH_MP SUM_UNIQ th) THEN MP_TAC th) THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_SUB_RZERO]) THEN C SUBGOAL_THEN MP_TAC `(\n. (c n) * (x pow n)) sums (suminf(\n. (c n) * (x pow n))) /\ (\n. (c n) * ((x + h) pow n)) sums (suminf(\n. (c n) * ((x + h) pow n)))` THENL [CONJ_TAC THEN MATCH_MP_TAC SUMMABLE_SUM THEN MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN DISCH_THEN(MP_TAC o SPEC `h:real` o MATCH_MP SER_CDIV) THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN DISCH_THEN(fun th -> DISCH_THEN (MP_TAC o MATCH_MP SUMMABLE_SUM o MATCH_MP SUM_SUMMABLE) THEN MP_TAC th) THEN DISCH_THEN(fun th1 -> DISCH_THEN(fun th2 -> MP_TAC(CONJ th1 th2))) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM; ALL_TAC] THEN MP_TAC(SPECL [`abs(x)`; `abs(K)`] REAL_MEAN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`\n. abs(c n) * &n * &(n - 1) * (R pow (n - 2))`; `\h n. c(n) * (((((x + h) pow n) - (x pow n)) / h) - (&n * (x pow (n - 1))))`; `R - abs(x)`] TERMDIFF_LEMMA5) THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_SUB_LT]; SUBGOAL_THEN `summable(\n. abs(diffs(diffs c) n) * (R pow n))` MP_TAC THENL [MATCH_MP_TAC POWSER_INSIDEA THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(R) = R` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x)` THEN REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[ABS_MUL] THEN REWRITE_TAC[ABS_N] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN C SUBGOAL_THEN (fun th -> ONCE_REWRITE_TAC[GSYM th]) `!n. diffs(diffs (\n. abs(c n))) n * (R pow n) = &(SUC n) * &(SUC(SUC n)) * abs(c(SUC(SUC n))) * (R pow n)` THENL [GEN_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFFS_EQUIV) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN SUBGOAL_THEN `(\n. &n * &(SUC n) * abs(c(SUC n)) * (R pow (n - 1))) = \n. diffs(\m. &(m - 1) * abs(c m) / R) n * (R pow n)` SUBST1_TAC THENL [REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[SUC_SUB1] THEN ABS_TAC THEN DISJ_CASES_THEN2 (SUBST1_TAC) (X_CHOOSE_THEN `m:num` SUBST1_TAC) (SPEC `n:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; SUC_SUB1] THEN REWRITE_TAC[ADD1; POW_ADD] THEN REWRITE_TAC[GSYM ADD1; POW_1] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e * f = b * a * c * e * d * f`] THEN REPEAT AP_TERM_TAC THEN SUBGOAL_THEN `inv(R) * R = &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[ABS_NZ] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `R:real` THEN ASM_REWRITE_TAC[ABS_LE]; REWRITE_TAC[REAL_MUL_RID]]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFFS_EQUIV) THEN BETA_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN BETA_TAC THEN GEN_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `a * b * c * d = b * c * a * d`] THEN DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `m:num` SUBST1_TAC) (SPEC `n:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[num_CONV `2`; SUC_SUB1; SUB_SUC] THEN AP_TERM_TAC THEN DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `n:num` SUBST1_TAC) (SPEC `m:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN REPEAT AP_TERM_TAC THEN REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ADD1; POW_ADD; POW_1] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN SUBGOAL_THEN `R * inv(R) = &1` (fun th -> REWRITE_TAC[th; REAL_MUL_RID]) THEN MATCH_MP_TAC REAL_MUL_RINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[ABS_POS]; X_GEN_TAC `h:real` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC TERMDIFF_LEMMA3 THEN ASM_REWRITE_TAC[ABS_NZ] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x) + abs(h)` THEN REWRITE_TAC[ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[GSYM REAL_LT_SUB_LADD]]]);; (* ------------------------------------------------------------------------- *) (* I eventually decided to get rid of the pointless side-conditions. *) (* ------------------------------------------------------------------------- *) let SEQ_NPOW = prove (`!x. abs(x) < &1 ==> (\n. &n * x pow n) tends_num_real &0`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. abs(x) / (&1 - abs(x)) < &n <=> &(SUC n) * abs(x) < &n` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `abs(x) / (&1 - abs(x))` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC SER_ZERO THEN MATCH_MP_TAC SER_RATIO THEN EXISTS_TAC `&(SUC(SUC N)) * abs(x) / &(SUC N)` THEN EXISTS_TAC `SUC N` THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_MUL_LID;REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LT_0] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; LT]; ALL_TAC] THEN ABBREV_TAC `m = SUC N` THEN GEN_TAC THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN REWRITE_TAC[real_div; real_pow; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `a * b * c * d * e = ((a * d) * c) * (b * e)`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_ABS_POS; REAL_LE_MUL] THEN SUBGOAL_THEN `&0 < &m` ASSUME_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `m:num <= n` THEN EXPAND_TAC "m" THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN UNDISCH_TAC `m:num <= n` THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN ARITH_TAC);; let TERMDIFF_CONVERGES = prove (`!K. (!x. abs(x) < K ==> summable(\n. c(n) * x pow n)) ==> !x. abs(x) < K ==> summable (\n. diffs c n * x pow n)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL [REWRITE_TAC[summable] THEN EXISTS_TAC `sum(0,1) (\n. diffs c n * x pow n)` THEN MATCH_MP_TAC SER_0 THEN ASM_REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN SIMP_TAC[ARITH_RULE `1 <= m <=> ~(m = 0)`]; ALL_TAC] THEN SUBGOAL_THEN `?y. abs(x) < abs(y) /\ abs(y) < K` STRIP_ASSUME_TAC THENL [EXISTS_TAC `(abs(x) + K) / &2` THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < K` THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[diffs] THEN SUBGOAL_THEN `summable (\n. (&n * c(n)) * x pow n)` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN DISCH_THEN(MP_TAC o SPEC `inv(x)` o MATCH_MP SER_CMUL) THEN REWRITE_TAC[GSYM ADD1; real_pow] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * (b * c) * d * e = (a * d) * (b * c) * e`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN REWRITE_TAC[SUM_SUMMABLE]] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n:num. abs(c n * y pow n)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN MATCH_MP_TAC POWSER_INSIDEA THEN EXISTS_TAC `(abs(y) + K) / &2` THEN SUBGOAL_THEN `abs(abs y) < abs((abs y + K) / &2) /\ abs((abs y + K) / &2) < K` (fun th -> ASM_SIMP_TAC[th]) THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs y < K` THEN REAL_ARITH_TAC] THEN SUBGOAL_THEN `&0 < abs(y)` ASSUME_TAC THENL [MAP_EVERY UNDISCH_TAC [`abs x < abs y`; `~(x = &0)`] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `x / y` SEQ_NPOW) THEN ASM_SIMP_TAC[REAL_MUL_LID; REAL_LT_LDIV_EQ; REAL_ABS_DIV] THEN REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_SUB_RZERO; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_POW_DIV] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC; REAL_POW_INV] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT] THEN REWRITE_TAC[REAL_MUL_LID] THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE]);; let TERMDIFF_STRONG = prove (`!c K x. summable(\n. c(n) * (K pow n)) /\ abs(x) < abs(K) ==> ((\x. suminf (\n. c(n) * (x pow n))) diffl (suminf (\n. (diffs c)(n) * (x pow n))))(x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `(abs(x) + abs(K)) / &2` THEN SUBGOAL_THEN `abs(x) < abs((abs(x) + abs(K)) / &2) /\ abs((abs(x) + abs(K)) / &2) < abs(K)` STRIP_ASSUME_TAC THENL [SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < abs(K)` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_ABS_ABS] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SER_ACONV THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN MATCH_MP_TAC POWSER_INSIDEA THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[REAL_ABS_ABS]; SUBGOAL_THEN `!x. abs(x) < abs(K) ==> summable (\n. diffs c n * x pow n)` (fun th -> ASM_SIMP_TAC[th]); SUBGOAL_THEN `!x. abs(x) < abs(K) ==> summable (\n. diffs(diffs c) n * x pow n)` (fun th -> ASM_SIMP_TAC[th]) THEN MATCH_MP_TAC TERMDIFF_CONVERGES] THEN MATCH_MP_TAC TERMDIFF_CONVERGES THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_ACONV THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN MATCH_MP_TAC POWSER_INSIDEA THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; (* ------------------------------------------------------------------------- *) (* Term-by-term comparison of power series. *) (* ------------------------------------------------------------------------- *) let POWSER_0 = prove (`!a. (\n. a n * (&0) pow n) sums a(0)`, GEN_TAC THEN SUBGOAL_THEN `a(0) = sum(0,1) (\n. a n * (&0) pow n)` SUBST1_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[real_pow; REAL_MUL_RID]; ALL_TAC] THEN MATCH_MP_TAC SER_0 THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; ARITH]);; let POWSER_LIMIT_0 = prove (`!f a s. &0 < s /\ (!x. abs(x) < s ==> (\n. a n * x pow n) sums (f x)) ==> (f tends_real_real a(0))(&0)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:num->real`; `s / &2`; `&0`] TERMDIFF_STRONG) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_SIMP_TAC[REAL_ABS_NUM; REAL_ABS_DIV; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_ARITH `&0 < x ==> &0 < abs(x)`] THEN MATCH_MP_TAC SUM_SUMMABLE THEN EXISTS_TAC `(f:real->real) (s / &2)` THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < s` THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CONT) THEN REWRITE_TAC[contl] THEN SUBGOAL_THEN `suminf (\n. a n * &0 pow n) = a(0)` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN REWRITE_TAC[POWSER_0]; ALL_TAC] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[REAL_ADD_LID; LIM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `(a = b) /\ &0 < e ==> abs(a - b) < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]);; let POWSER_LIMIT_0_STRONG = prove (`!f a s. &0 < s /\ (!x. &0 < abs(x) /\ abs(x) < s ==> (\n. a n * x pow n) sums (f x)) ==> (f tends_real_real a(0))(&0)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `((\x. if x = &0 then a(0):real else f x) tends_real_real a(0))(&0)` MP_TAC THENL [MATCH_MP_TAC POWSER_LIMIT_0 THEN EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN REWRITE_TAC[sums; SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `1` THEN INDUCT_TAC THEN REWRITE_TAC[ARITH; ADD1] THEN DISCH_TAC THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RZERO; SUM_CONST] THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN REWRITE_TAC[real_pow; REAL_MUL_RID] THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_SUB_REFL; REAL_ABS_NUM]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_EQUAL THEN SIMP_TAC[]);; let POWSER_EQUAL_0 = prove (`!f a b P. (!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs(x) < e) /\ (!x. &0 < abs(x) /\ P x ==> (\n. a n * x pow n) sums (f x) /\ (\n. b n * x pow n) sums (f x)) ==> (a(0) = b(0))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?s. &0 < s /\ !x. abs(x) < s ==> summable (\n. a n * x pow n) /\ summable (\n. b n * x pow n)` MP_TAC THENL [FIRST_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `abs(k)` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[summable] THEN EXISTS_TAC `(f:real->real) k` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[summable; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; RIGHT_IMP_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `s:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `h:real->real` MP_TAC) THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(x - y)) ==> (x = y)`) THEN ABBREV_TAC `e = abs(a 0 - b 0)` THEN DISCH_TAC THEN MP_TAC(SPECL [`g:real->real`; `a:num->real`; `s:real`] POWSER_LIMIT_0_STRONG) THEN ASM_SIMP_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`h:real->real`; `b:num->real`; `s:real`] POWSER_LIMIT_0_STRONG) THEN ASM_SIMP_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d0:real`; `s:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs x < e` THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `abs(a 0 - b 0) < e` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LT_REFL]] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e / &2 + e / &2` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[GSYM REAL_MUL_2; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_LE_REFL]] THEN MATCH_MP_TAC(REAL_ARITH `!f g h. abs(g - a) < e2 /\ abs(h - b) < e2 /\ (g = f) /\ (h = f) ==> abs(a - b) < e2 + e2`) THEN MAP_EVERY EXISTS_TAC [`(f:real->real) x`; `(g:real->real) x`; `(h:real->real) x`] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `suminf(\n. a n * x pow n)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_UNIQ; MATCH_MP_TAC(GSYM SUM_UNIQ)] THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `abs(x) < s` (fun th -> ASM_SIMP_TAC[th]) THEN ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `suminf(\n. b n * x pow n)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_UNIQ; MATCH_MP_TAC(GSYM SUM_UNIQ)] THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `abs(x) < s` (fun th -> ASM_SIMP_TAC[th]) THEN ASM_MESON_TAC[REAL_LT_TRANS]]);; let POWSER_EQUAL = prove (`!f a b P. (!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs(x) < e) /\ (!x. P x ==> (\n. a n * x pow n) sums (f x) /\ (\n. b n * x pow n) sums (f x)) ==> (a = b)`, REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN REWRITE_TAC[] THEN REWRITE_TAC[TAUT `~(~a /\ b) <=> b ==> a`] THEN DISCH_TAC THEN SUBGOAL_THEN `(\m. a(m + n):real) 0 = (\m. b(m + n)) 0` MP_TAC THENL [ALL_TAC; REWRITE_TAC[ADD_CLAUSES]] THEN MATCH_MP_TAC POWSER_EQUAL_0 THEN EXISTS_TAC `\x. inv(x pow n) * (f(x) - sum(0,n) (\n. b n * x pow n))` THEN EXISTS_TAC `P:real->bool` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN SUBGOAL_THEN `!a m. a(m + n) * x pow m = inv(x pow n) * a(m + n) * x pow (m + n)` (fun th -> GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[REAL_POW_ADD] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `x' * a * b * x = (x * x') * a * b`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_POW_EQ_0; REAL_ARITH `(x = &0) <=> ~(&0 < abs x)`] THEN REWRITE_TAC[REAL_MUL_LID]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC SER_CMUL THENL [SUBGOAL_THEN `sum(0,n) (\n. b n * x pow n) = sum(0,n) (\n. a n * x pow n)` SUBST1_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[ADD_CLAUSES]; ALL_TAC] THEN SUBGOAL_THEN `f x = suminf (\n. a n * x pow n)` SUBST1_TAC THENL [MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `\n. a n * x pow n` SER_OFFSET); SUBGOAL_THEN `f x = suminf (\n. b n * x pow n)` SUBST1_TAC THENL [MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `\n. b n * x pow n` SER_OFFSET)] THEN REWRITE_TAC[] THEN W(C SUBGOAL_THEN (fun th -> SIMP_TAC[th]) o funpow 2 lhand o snd) THEN MATCH_MP_TAC SUM_SUMMABLE THEN EXISTS_TAC `(f:real->real) x` THEN ASM_SIMP_TAC[]);; (* ======================================================================== *) (* Definitions of the transcendental functions etc. *) (* ======================================================================== *) prioritize_num();; (* ------------------------------------------------------------------------- *) (* To avoid all those beta redexes vanishing without trace... *) (* ------------------------------------------------------------------------- *) set_basic_rewrites (subtract' equals_thm (basic_rewrites()) [SPEC_ALL BETA_THM]);; (* ------------------------------------------------------------------------ *) (* Some miscellaneous lemmas *) (* ------------------------------------------------------------------------ *) let MULT_DIV_2 = prove (`!n. (2 * n) DIV 2 = n`, GEN_TAC THEN MATCH_MP_TAC DIV_MULT THEN REWRITE_TAC[ARITH]);; let EVEN_DIV2 = prove (`!n. ~(EVEN n) ==> ((SUC n) DIV 2 = SUC((n - 1) DIV 2))`, GEN_TAC THEN REWRITE_TAC[GSYM NOT_ODD; ODD_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC] THEN SUBST1_TAC(EQT_ELIM(NUM_REDUCE_CONV `1 + 1 = 2 * 1`)) THEN REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; MULT_DIV_2]);; (* ------------------------------------------------------------------------ *) (* Now set up real numbers interface *) (* ------------------------------------------------------------------------ *) prioritize_real();; (* ------------------------------------------------------------------------- *) (* Another lost lemma. *) (* ------------------------------------------------------------------------- *) let POW_ZERO = prove( `!n x. (x pow n = &0) ==> (x = &0)`, INDUCT_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[pow] THEN REWRITE_TAC[REAL_10; REAL_ENTIRE] THEN DISCH_THEN(DISJ_CASES_THEN2 ACCEPT_TAC ASSUME_TAC) THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; let POW_ZERO_EQ = prove( `!n x. (x pow (SUC n) = &0) <=> (x = &0)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POW_ZERO] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POW_0]);; let POW_LT = prove( `!n x y. &0 <= x /\ x < y ==> (x pow (SUC n)) < (y pow (SUC n))`, REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL [ASM_REWRITE_TAC[pow; REAL_MUL_RID]; ONCE_REWRITE_TAC[pow] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[]]);; let POW_EQ = prove( `!n x y. &0 <= x /\ &0 <= y /\ (x pow (SUC n) = y pow (SUC n)) ==> (x = y)`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `x pow (SUC n) = y pow (SUC n)` THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THENL [ALL_TAC; CONV_TAC(RAND_CONV SYM_CONV)] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC POW_LT THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Basic differentiation theorems --- none yet. *) (* ------------------------------------------------------------------------- *) let diff_net = ref empty_net;; let add_to_diff_net th = let t = lhand(rator(rand(concl th))) in let net = !diff_net in let net' = enter [] (t,PART_MATCH (lhand o rator o rand) th) net in diff_net := net';; (* ------------------------------------------------------------------------ *) (* The three functions we define by series are exp, sin, cos *) (* ------------------------------------------------------------------------ *) let exp = new_definition `exp(x) = suminf(\n. ((\n. inv(&(FACT n)))) n * (x pow n))`;; let sin = new_definition `sin(x) = suminf(\n. ((\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n))`;; let cos = new_definition `cos(x) = suminf(\n. ((\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0)) n * (x pow n))`;; (* ------------------------------------------------------------------------ *) (* Show the series for exp converges, using the ratio test *) (* ------------------------------------------------------------------------ *) let REAL_EXP_CONVERGES = prove( `!x. (\n. ((\n. inv(&(FACT n)))) n * (x pow n)) sums exp(x)`, let fnz tm = (GSYM o MATCH_MP REAL_LT_IMP_NE o REWRITE_RULE[GSYM REAL_LT] o C SPEC FACT_LT) tm in GEN_TAC THEN REWRITE_TAC[exp] THEN MATCH_MP_TAC SUMMABLE_SUM THEN MATCH_MP_TAC SER_RATIO THEN MP_TAC (SPEC `&1` REAL_DOWN) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `c:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `abs(x)`) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[ADD1; POW_ADD; ABS_MUL; REAL_MUL_ASSOC; POW_1] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN REWRITE_TAC[GSYM REAL_MUL; MATCH_MP REAL_INV_MUL_WEAK (CONJ (REWRITE_RULE[GSYM REAL_INJ] (SPEC `n:num` NOT_SUC)) (fnz `n:num`))] THEN REWRITE_TAC[ABS_MUL; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN MP_TAC(SPEC `n:num` LT_0) THEN REWRITE_TAC[GSYM REAL_LT] THEN DISCH_THEN(ASSUME_TAC o GSYM o MATCH_MP REAL_LT_IMP_NE) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_LDIV THEN ASM_REWRITE_TAC[GSYM ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REWRITE_RULE[GSYM ABS_REFL; GSYM REAL_LE] LE_0] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N * c` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN REWRITE_TAC[REAL_LE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL]]);; (* ------------------------------------------------------------------------ *) (* Show by the comparison test that sin and cos converge *) (* ------------------------------------------------------------------------ *) let SIN_CONVERGES = prove( `!x. (\n. ((\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n)) sums sin(x)`, GEN_TAC THEN REWRITE_TAC[sin] THEN MATCH_MP_TAC SUMMABLE_SUM THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. ((\n. inv(&(FACT n)))) n * (abs(x) pow n)` THEN REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[ABS_MUL; POW_ABS] THENL [REWRITE_TAC[ABS_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[ABS_POS]; REWRITE_TAC[real_div; ABS_MUL; POW_M1; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]] THEN MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE; REAL_INV_POS] THEN REWRITE_TAC[REAL_LT; FACT_LT]);; let COS_CONVERGES = prove( `!x. (\n. ((\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0)) n * (x pow n)) sums cos(x)`, GEN_TAC THEN REWRITE_TAC[cos] THEN MATCH_MP_TAC SUMMABLE_SUM THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. ((\n. inv(&(FACT n)))) n * (abs(x) pow n)` THEN REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[ABS_MUL; POW_ABS] THENL [REWRITE_TAC[real_div; ABS_MUL; POW_M1; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]; REWRITE_TAC[ABS_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[ABS_POS]] THEN MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE; REAL_INV_POS] THEN REWRITE_TAC[REAL_LT; FACT_LT]);; (* ------------------------------------------------------------------------ *) (* Show what the formal derivatives of these series are *) (* ------------------------------------------------------------------------ *) let REAL_EXP_FDIFF = prove( `diffs (\n. inv(&(FACT n))) = (\n. inv(&(FACT n)))`, REWRITE_TAC[diffs] THEN BETA_TAC THEN CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN REWRITE_TAC[FACT; GSYM REAL_MUL] THEN SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN REWRITE_TAC[REAL_LT; LT_0; FACT_LT]; FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);; let SIN_FDIFF = prove( `diffs (\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n)) = (\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0)`, REWRITE_TAC[diffs] THEN BETA_TAC THEN CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[SUC_SUB1] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[FACT; GSYM REAL_MUL] THEN SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN REWRITE_TAC[REAL_LT; LT_0; FACT_LT]; FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);; let COS_FDIFF = prove( `diffs (\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0) = (\n. --(((\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n))`, REWRITE_TAC[diffs] THEN BETA_TAC THEN CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; REAL_NEG_LMUL] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN BINOP_TAC THENL [POP_ASSUM(SUBST1_TAC o MATCH_MP EVEN_DIV2) THEN REWRITE_TAC[pow] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1]; REWRITE_TAC[FACT; GSYM REAL_MUL] THEN SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN REWRITE_TAC[REAL_LT; LT_0; FACT_LT]; FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]]);; (* ------------------------------------------------------------------------ *) (* Now at last we can get the derivatives of exp, sin and cos *) (* ------------------------------------------------------------------------ *) let SIN_NEGLEMMA = prove( `!x. --(sin x) = suminf (\n. --(((\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n)))`, GEN_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN MP_TAC(MATCH_MP SER_NEG (SPEC `x:real` SIN_CONVERGES)) THEN BETA_TAC THEN DISCH_THEN ACCEPT_TAC);; let DIFF_EXP = prove( `!x. (exp diffl exp(x))(x)`, GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS exp] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_EXP_FDIFF] THEN CONV_TAC(LAND_CONV BETA_CONV) THEN MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN REWRITE_TAC[REAL_EXP_FDIFF; MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]);; let DIFF_SIN = prove( `!x. (sin diffl cos(x))(x)`, GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS sin; cos] THEN ONCE_REWRITE_TAC[GSYM SIN_FDIFF] THEN MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL SIN_CONVERGES)]; REWRITE_TAC[SIN_FDIFF; MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)]; REWRITE_TAC[SIN_FDIFF; COS_FDIFF] THEN BETA_TAC THEN MP_TAC(SPEC `abs(x) + &1` SIN_CONVERGES) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL]; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]]);; let DIFF_COS = prove( `!x. (cos diffl --(sin(x)))(x)`, GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS cos; SIN_NEGLEMMA] THEN ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN REWRITE_TAC[GSYM(CONV_RULE(RAND_CONV BETA_CONV) (AP_THM COS_FDIFF `n:num`))] THEN MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)]; REWRITE_TAC[COS_FDIFF] THEN MP_TAC(SPEC `abs(x) + &1` SIN_CONVERGES) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL]; REWRITE_TAC[COS_FDIFF; DIFFS_NEG] THEN MP_TAC SIN_FDIFF THEN BETA_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MP_TAC(SPEC `abs(x) + &1` COS_CONVERGES) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL]; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]]);; (* ------------------------------------------------------------------------- *) (* Differentiation conversion. *) (* ------------------------------------------------------------------------- *) let DIFF_CONV = let lookup_expr tm = tryfind (fun f -> f tm) (lookup tm (!diff_net)) in let v = `x:real` and k = `k:real` and diffl_tm = `(diffl)` in let DIFF_var = SPEC v DIFF_X and DIFF_const = SPECL [k;v] DIFF_CONST in let uneta_CONV = REWR_CONV (GSYM ETA_AX) in let rec DIFF_CONV tm = if not (is_abs tm) then let th0 = uneta_CONV tm in let th1 = DIFF_CONV (rand(concl th0)) in CONV_RULE (RATOR_CONV(LAND_CONV(K(SYM th0)))) th1 else let x,bod = dest_abs tm in if bod = x then INST [x,v] DIFF_var else if not(free_in x bod) then INST [bod,k; x,v] DIFF_const else let th = lookup_expr tm in let hyp = fst(dest_imp(concl th)) in let hyps = conjuncts hyp in let dhyps,sides = partition (fun t -> try funpow 3 rator t = diffl_tm with Failure _ -> false) hyps in let tha = CONJ_ACI_RULE(mk_eq(hyp,list_mk_conj(dhyps@sides))) in let thb = CONV_RULE (LAND_CONV (K tha)) th in let dths = map (DIFF_CONV o lhand o rator) dhyps in MATCH_MP thb (end_itlist CONJ (dths @ map ASSUME sides)) in fun tm -> let xv = try bndvar tm with Failure _ -> v in GEN xv (DISCH_ALL(DIFF_CONV tm));; (* ------------------------------------------------------------------------- *) (* Processed versions of composition theorems. *) (* ------------------------------------------------------------------------- *) let DIFF_COMPOSITE = prove (`((f diffl l)(x) /\ ~(f(x) = &0) ==> ((\x. inv(f x)) diffl --(l / (f(x) pow 2)))(x)) /\ ((f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==> ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x))) / (g(x) pow 2)))(x)) /\ ((f diffl l)(x) /\ (g diffl m)(x) ==> ((\x. f(x) + g(x)) diffl (l + m))(x)) /\ ((f diffl l)(x) /\ (g diffl m)(x) ==> ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)) /\ ((f diffl l)(x) /\ (g diffl m)(x) ==> ((\x. f(x) - g(x)) diffl (l - m))(x)) /\ ((f diffl l)(x) ==> ((\x. --(f x)) diffl --l)(x)) /\ ((g diffl m)(x) ==> ((\x. (g x) pow n) diffl ((&n * (g x) pow (n - 1)) * m))(x)) /\ ((g diffl m)(x) ==> ((\x. exp(g x)) diffl (exp(g x) * m))(x)) /\ ((g diffl m)(x) ==> ((\x. sin(g x)) diffl (cos(g x) * m))(x)) /\ ((g diffl m)(x) ==> ((\x. cos(g x)) diffl (--(sin(g x)) * m))(x))`, REWRITE_TAC[DIFF_INV; DIFF_DIV; DIFF_ADD; DIFF_SUB; DIFF_MUL; DIFF_NEG] THEN REPEAT CONJ_TAC THEN DISCH_TAC THEN TRY(MATCH_MP_TAC DIFF_CHAIN THEN ASM_REWRITE_TAC[DIFF_SIN; DIFF_COS; DIFF_EXP]) THEN MATCH_MP_TAC(BETA_RULE (SPEC `\x. x pow n` DIFF_CHAIN)) THEN ASM_REWRITE_TAC[DIFF_POW]);; do_list add_to_diff_net (CONJUNCTS DIFF_COMPOSITE);; (* ------------------------------------------------------------------------- *) (* Tactic for goals "(f diffl l) x" *) (* ------------------------------------------------------------------------- *) let DIFF_TAC = W(fun (asl,w) -> MP_TAC(SPEC(rand w) (DIFF_CONV(lhand(rator w)))) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC);; (* ------------------------------------------------------------------------- *) (* Prove differentiability terms. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_RULE = let pth = prove (`(f diffl l) x ==> f differentiable x`, MESON_TAC[differentiable]) in let match_pth = MATCH_MP pth in fun tm -> let tb,y = dest_comb tm in let tm' = rand tb in match_pth (SPEC y (DIFF_CONV tm'));; let DIFFERENTIABLE_CONV = EQT_INTRO o DIFFERENTIABLE_RULE;; (* ------------------------------------------------------------------------- *) (* Prove continuity via differentiability (weak but useful). *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_RULE = let pth = prove (`!f x. f differentiable x ==> f contl x`, MESON_TAC[differentiable; DIFF_CONT]) in let match_pth = PART_MATCH rand pth in fun tm -> let th1 = match_pth tm in MP th1 (DIFFERENTIABLE_RULE(lhand(concl th1)));; let CONTINUOUS_CONV = EQT_INTRO o CONTINUOUS_RULE;; (* ------------------------------------------------------------------------ *) (* Properties of the exponential function *) (* ------------------------------------------------------------------------ *) let REAL_EXP_0 = prove( `exp(&0) = &1`, REWRITE_TAC[exp] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[num_CONV `1`; sum] THEN REWRITE_TAC[ADD_CLAUSES; REAL_ADD_LID] THEN BETA_TAC THEN REWRITE_TAC[FACT; pow; REAL_MUL_RID; REAL_INV1] THEN REWRITE_TAC[SYM(num_CONV `1`)] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[num_CONV `1`; LE_SUC_LT] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; ADD_CLAUSES]);; let REAL_EXP_LE_X = prove( `!x. &0 <= x ==> (&1 + x) <= exp(x)`, GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [MP_TAC(SPECL [`\n. ((\n. inv(&(FACT n)))) n * (x pow n)`; `2`] SER_POS_LE) THEN REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN REWRITE_TAC[GSYM exp] THEN BETA_TAC THEN W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT; FACT_LT]; MATCH_MP_TAC POW_POS THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC]; CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[sum] THEN BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; pow; REAL_ADD_LID] THEN REWRITE_TAC[MULT_CLAUSES; REAL_INV1; REAL_MUL_LID; ADD_CLAUSES] THEN REWRITE_TAC[REAL_MUL_RID; SYM(num_CONV `1`)]]; POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_EXP_0; REAL_ADD_RID; REAL_LE_REFL]]);; let REAL_EXP_LT_1 = prove( `!x. &0 < x ==> &1 < exp(x)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 + x` THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN MATCH_MP_TAC REAL_EXP_LE_X THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN POP_ASSUM ACCEPT_TAC);; let REAL_EXP_ADD_MUL = prove( `!x y. exp(x + y) * exp(--x) = exp(y)`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN SUBGOAL_THEN `exp(y) = (\x. exp(x + y) * exp(--x))(&0)` SUBST1_TAC THENL [BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID; REAL_NEG_0] THEN REWRITE_TAC[REAL_EXP_0; REAL_MUL_RID]; MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC `x:real` THEN W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[GSYM real_sub; REAL_SUB_0; REAL_MUL_RID; REAL_ADD_RID] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);; let REAL_EXP_NEG_MUL = prove( `!x. exp(x) * exp(--x) = &1`, GEN_TAC THEN MP_TAC(SPECL [`x:real`; `&0`] REAL_EXP_ADD_MUL) THEN REWRITE_TAC[REAL_ADD_RID; REAL_EXP_0]);; let REAL_EXP_NEG_MUL2 = prove( `!x. exp(--x) * exp(x) = &1`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EXP_NEG_MUL);; let REAL_EXP_NEG = prove( `!x. exp(--x) = inv(exp(x))`, GEN_TAC THEN MATCH_MP_TAC REAL_RINV_UNIQ THEN MATCH_ACCEPT_TAC REAL_EXP_NEG_MUL);; let REAL_EXP_ADD = prove( `!x y. exp(x + y) = exp(x) * exp(y)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`] REAL_EXP_ADD_MUL) THEN DISCH_THEN(MP_TAC o C AP_THM `exp(x)` o AP_TERM `(*)`) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_EXP_NEG_MUL; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; let REAL_EXP_POS_LE = prove( `!x. &0 <= exp(x)`, GEN_TAC THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN REWRITE_TAC[REAL_EXP_ADD] THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE);; let REAL_EXP_NZ = prove( `!x. ~(exp(x) = &0)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `x:real` REAL_EXP_NEG_MUL) THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_ACCEPT_TAC REAL_10);; let REAL_EXP_POS_LT = prove( `!x. &0 < exp(x)`, GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[REAL_EXP_POS_LE; REAL_EXP_NZ]);; let REAL_EXP_N = prove( `!n x. exp(&n * x) = exp(x) pow n`, INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_EXP_0; pow] THEN REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_ADD; REAL_EXP_ADD; REAL_RDISTRIB] THEN GEN_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID]);; let REAL_EXP_SUB = prove( `!x y. exp(x - y) = exp(x) / exp(y)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; real_div; REAL_EXP_ADD; REAL_EXP_NEG]);; let REAL_EXP_MONO_IMP = prove( `!x y. x < y ==> exp(x) < exp(y)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_EXP_LT_1 o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN REWRITE_TAC[REAL_EXP_SUB] THEN SUBGOAL_THEN `&1 < exp(y) / exp(x) <=> (&1 * exp(x)) < ((exp(y) / exp(x)) * exp(x))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN MATCH_ACCEPT_TAC REAL_EXP_POS_LT; REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_EXP_NEG_MUL2; GSYM REAL_EXP_NEG] THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID]]);; let REAL_EXP_MONO_LT = prove( `!x y. exp(x) < exp(y) <=> x < y`, REPEAT GEN_TAC THEN EQ_TAC THENL [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THEN REWRITE_TAC[] THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_EXP_MONO_IMP THEN POP_ASSUM ACCEPT_TAC; MATCH_ACCEPT_TAC REAL_EXP_MONO_IMP]);; let REAL_EXP_MONO_LE = prove( `!x y. exp(x) <= exp(y) <=> x <= y`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[REAL_EXP_MONO_LT]);; let REAL_EXP_INJ = prove( `!x y. (exp(x) = exp(y)) <=> (x = y)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REWRITE_TAC[REAL_EXP_MONO_LE]);; let REAL_EXP_TOTAL_LEMMA = prove( `!y. &1 <= y ==> ?x. &0 <= x /\ x <= y - &1 /\ (exp(x) = y)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC IVT THEN ASM_REWRITE_TAC[REAL_EXP_0; REAL_LE_SUB_LADD; REAL_ADD_LID] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_LE]) THEN POP_ASSUM(MP_TAC o MATCH_MP REAL_EXP_LE_X) THEN REWRITE_TAC[REAL_SUB_ADD2]; X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `exp(x)` THEN MATCH_ACCEPT_TAC DIFF_EXP]);; let REAL_EXP_TOTAL = prove( `!y. &0 < y ==> ?x. exp(x) = y`, GEN_TAC THEN DISCH_TAC THEN DISJ_CASES_TAC(SPECL [`&1`; `y:real`] REAL_LET_TOTAL) THENL [FIRST_ASSUM(X_CHOOSE_TAC `x:real` o MATCH_MP REAL_EXP_TOTAL_LEMMA) THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; MP_TAC(SPEC `y:real` REAL_INV_LT1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN DISCH_THEN(X_CHOOSE_TAC `x:real` o MATCH_MP REAL_EXP_TOTAL_LEMMA) THEN EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[REAL_EXP_NEG] THEN MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]]);; let REAL_EXP_BOUND_LEMMA = prove (`!x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `suminf (\n. x pow n)` THEN CONJ_TAC THENL [REWRITE_TAC[exp; BETA_THM] THEN MATCH_MP_TAC SER_LE THEN REWRITE_TAC[summable; BETA_THM] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE; num_CONV `1`; LE_SUC_LT] THEN REWRITE_TAC[FACT_LT]]; EXISTS_TAC `exp x` THEN REWRITE_TAC[BETA_RULE REAL_EXP_CONVERGES]; EXISTS_TAC `inv(&1 - x)` THEN MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; SUBGOAL_THEN `suminf (\n. x pow n) = inv (&1 - x)` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&1 - x` THEN SUBGOAL_THEN `(&1 - x) * inv (&1 - x) = &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[REAL_ARITH `(&1 - x = &0) <=> (x = &1)`] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV; CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) - x` THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= x - y <=> y <= x`] THEN ASM_REWRITE_TAC[REAL_ARITH `a - x < b - x <=> a < b`] THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `&1 <= (&1 + &2 * x) - (x + x * &2 * x) <=> x * (&2 * x) <= x * &1`] THEN MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `inv(&2)` THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_MUL_LID; real_div]]]]]);; (* ------------------------------------------------------------------------ *) (* Properties of the logarithmic function *) (* ------------------------------------------------------------------------ *) let ln = new_definition `ln x = @u. exp(u) = x`;; let LN_EXP = prove( `!x. ln(exp x) = x`, GEN_TAC THEN REWRITE_TAC[ln; REAL_EXP_INJ] THEN CONV_TAC SYM_CONV THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MATCH_MP_TAC SELECT_AX THEN EXISTS_TAC `x:real` THEN REFL_TAC);; let REAL_EXP_LN = prove( `!x. (exp(ln x) = x) <=> &0 < x`, GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_EXP_POS_LT; DISCH_THEN(X_CHOOSE_THEN `y:real` MP_TAC o MATCH_MP REAL_EXP_TOTAL) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_EXP_INJ; LN_EXP]]);; let EXP_LN = prove (`!x. &0 < x ==> exp(ln x) = x`, REWRITE_TAC[REAL_EXP_LN]);; let LN_MUL = prove( `!x y. &0 < x /\ &0 < y ==> (ln(x * y) = ln(x) + ln(y))`, REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN REWRITE_TAC[REAL_EXP_ADD] THEN SUBGOAL_THEN `&0 < x * y` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; EVERY_ASSUM(fun th -> REWRITE_TAC[ONCE_REWRITE_RULE[GSYM REAL_EXP_LN] th])]);; let LN_INJ = prove( `!x y. &0 < x /\ &0 < y ==> ((ln(x) = ln(y)) <=> (x = y))`, REPEAT GEN_TAC THEN STRIP_TAC THEN EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_INJ);; let LN_1 = prove( `ln(&1) = &0`, ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN REWRITE_TAC[REAL_EXP_0; REAL_EXP_LN; REAL_LT_01]);; let LN_INV = prove( `!x. &0 < x ==> (ln(inv x) = --(ln x))`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN SUBGOAL_THEN `&0 < x /\ &0 < inv(x)` MP_TAC THENL [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP LN_MUL th)]) THEN SUBGOAL_THEN `x * (inv x) = &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_RINV THEN POP_ASSUM(ACCEPT_TAC o MATCH_MP REAL_POS_NZ); REWRITE_TAC[LN_1]]]);; let LN_DIV = prove( `!x. &0 < x /\ &0 < y ==> (ln(x / y) = ln(x) - ln(y))`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < x /\ &0 < inv(y)` MP_TAC THENL [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[real_div] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP LN_MUL th]) THEN REWRITE_TAC[MATCH_MP LN_INV (ASSUME `&0 < y`)] THEN REWRITE_TAC[real_sub]]);; let LN_MONO_LT = prove( `!x y. &0 < x /\ &0 < y ==> (ln(x) < ln(y) <=> x < y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_MONO_LT);; let LN_MONO_LE = prove( `!x y. &0 < x /\ &0 < y ==> (ln(x) <= ln(y) <=> x <= y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_MONO_LE);; let LN_POW = prove( `!n x. &0 < x ==> (ln(x pow n) = &n * ln(x))`, REPEAT GEN_TAC THEN DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o SYM) o MATCH_MP REAL_EXP_TOTAL) THEN REWRITE_TAC[GSYM REAL_EXP_N; LN_EXP]);; let LN_LE = prove( `!x. &0 <= x ==> ln(&1 + x) <= x`, GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM LN_EXP] THEN MP_TAC(SPECL [`&1 + x`; `exp(x)`] LN_MONO_LE) THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [REWRITE_TAC[REAL_EXP_POS_LT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EXP_LE_X THEN ASM_REWRITE_TAC[]]);; let LN_LT_X = prove( `!x. &0 < x ==> ln(x) < x`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `ln(&1 + x)` THEN CONJ_TAC THENL [IMP_SUBST_TAC LN_MONO_LT THEN ASM_REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01] THEN MATCH_MP_TAC REAL_LT_ADD THEN ASM_REWRITE_TAC[REAL_LT_01]; MATCH_MP_TAC LN_LE THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]);; let LN_POS = prove (`!x. &1 <= x ==> &0 <= ln(x)`, REWRITE_TAC[GSYM LN_1] THEN SIMP_TAC[LN_MONO_LE; ARITH_RULE `&1 <= x ==> &0 < x`; REAL_LT_01]);; let LN_POS_LT = prove (`!x. &1 < x ==> &0 < ln(x)`, REWRITE_TAC[GSYM LN_1] THEN SIMP_TAC[LN_MONO_LT; ARITH_RULE `&1 < x ==> &0 < x`; REAL_LT_01]);; let DIFF_LN = prove( `!x. &0 < x ==> (ln diffl (inv x))(x)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[GSYM REAL_EXP_LN]) THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC DIFF_INVERSE_LT THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_POS_NZ) THEN ASM_REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN MP_TAC(SPEC `ln(x)` DIFF_EXP) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[LN_EXP] THEN EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC REAL_LT_01);; (* ------------------------------------------------------------------------ *) (* Some properties of roots (easier via logarithms) *) (* ------------------------------------------------------------------------ *) let root = new_definition `root(n) x = @u. (&0 < x ==> &0 < u) /\ (u pow n = x)`;; let sqrt_def = new_definition `sqrt(x) = @y. &0 <= y /\ (y pow 2 = x)`;; let sqrt = prove (`sqrt(x) = root(2) x`, REWRITE_TAC[root; sqrt_def] THEN AP_TERM_TAC THEN REWRITE_TAC[BETA_THM; FUN_EQ_THM] THEN X_GEN_TAC `y:real` THEN ASM_CASES_TAC `x = y pow 2` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_POW_2; REAL_LT_SQUARE] THEN REAL_ARITH_TAC);; let ROOT_LT_LEMMA = prove( `!n x. &0 < x ==> (exp(ln(x) / &(SUC n)) pow (SUC n) = x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_EXP_N] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN SUBGOAL_THEN `inv(&(SUC n)) * &(SUC n) = &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ASM_REWRITE_TAC[REAL_MUL_RID; REAL_EXP_LN]]);; let ROOT_LN = prove( `!x. &0 < x ==> !n. root(SUC n) x = exp(ln(x) / &(SUC n))`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `y:real` THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN SUBGOAL_THEN `!z. &0 < y /\ &0 < exp(z)` MP_TAC THENL [ASM_REWRITE_TAC[REAL_EXP_POS_LT]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN_ALL o SYM o MATCH_MP LN_INJ o SPEC_ALL) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC I [th]) THEN REWRITE_TAC[LN_EXP] THEN SUBGOAL_THEN `ln(y) * &(SUC n) = (ln(y pow(SUC n)) / &(SUC n)) * &(SUC n)` MP_TAC THENL [REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN SUBGOAL_THEN `inv(&(SUC n)) * &(SUC n) = &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC LN_POW THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[REAL_EQ_RMUL; REAL_INJ; NOT_SUC]]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN MATCH_MP_TAC ROOT_LT_LEMMA THEN ASM_REWRITE_TAC[]]);; let ROOT_0 = prove( `!n. root(SUC n) (&0) = &0`, GEN_TAC THEN REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `y:real` THEN BETA_TAC THEN REWRITE_TAC[REAL_LT_REFL] THEN EQ_TAC THENL [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[pow] THENL [REWRITE_TAC[pow; REAL_MUL_RID]; REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[pow; REAL_MUL_LZERO]]);; let ROOT_1 = prove( `!n. root(SUC n) (&1) = &1`, GEN_TAC THEN REWRITE_TAC[MATCH_MP ROOT_LN REAL_LT_01] THEN REWRITE_TAC[LN_1; REAL_DIV_LZERO; REAL_EXP_0]);; let ROOT_POW_POS = prove( `!n x. &0 <= x ==> ((root(SUC n) x) pow (SUC n) = x)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN DISJ_CASES_TAC THENL [FIRST_ASSUM(fun th -> REWRITE_TAC [MATCH_MP ROOT_LN th; MATCH_MP ROOT_LT_LEMMA th]); FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN MATCH_ACCEPT_TAC POW_0]);; let POW_ROOT_POS = prove( `!n x. &0 <= x ==> (root(SUC n)(x pow (SUC n)) = x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `y:real` THEN BETA_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL [DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `&0 <= x`)) THENL [DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_POS_LT th]) THEN DISCH_TAC THEN MATCH_MP_TAC POW_EQ THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN REWRITE_TAC[POW_0; REAL_LT_REFL; POW_ZERO]]; ASM_REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[POW_0]]);; let ROOT_POS_POSITIVE = prove (`!x n. &0 <= x ==> &0 <= root(SUC n) x`, REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ROOT_LN th]) THEN REWRITE_TAC[REAL_EXP_POS_LE]; POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN REWRITE_TAC[REAL_LE_REFL]]);; let ROOT_POS_UNIQ = prove (`!n x y. &0 <= x /\ &0 <= y /\ (y pow (SUC n) = x) ==> (root (SUC n) x = y)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN ASM_SIMP_TAC[POW_ROOT_POS]);; let ROOT_MUL = prove (`!n x y. &0 <= x /\ &0 <= y ==> (root(SUC n) (x * y) = root(SUC n) x * root(SUC n) y)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN ASM_SIMP_TAC[REAL_POW_MUL; ROOT_POW_POS; REAL_LE_MUL; ROOT_POS_POSITIVE]);; let ROOT_INV = prove (`!n x. &0 <= x ==> (root(SUC n) (inv x) = inv(root(SUC n) x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN ASM_SIMP_TAC[REAL_LE_INV; ROOT_POS_POSITIVE; REAL_POW_INV; ROOT_POW_POS]);; let ROOT_DIV = prove (`!n x y. &0 <= x /\ &0 <= y ==> (root(SUC n) (x / y) = root(SUC n) x / root(SUC n) y)`, SIMP_TAC[real_div; ROOT_MUL; ROOT_INV; REAL_LE_INV]);; let ROOT_MONO_LT = prove (`!x y. &0 <= x /\ x < y ==> root(SUC n) x < root(SUC n) y`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= y` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN UNDISCH_TAC `x < y` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `(x = (root(SUC n) x) pow (SUC n)) /\ (y = (root(SUC n) y) pow (SUC n))` (CONJUNCTS_THEN SUBST1_TAC) THENL [ASM_SIMP_TAC[GSYM ROOT_POW_POS]; ALL_TAC] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[NOT_SUC; ROOT_POS_POSITIVE]);; let ROOT_MONO_LE = prove (`!x y. &0 <= x /\ x <= y ==> root(SUC n) x <= root(SUC n) y`, MESON_TAC[ROOT_MONO_LT; REAL_LE_LT]);; let ROOT_MONO_LT_EQ = prove (`!x y. &0 <= x /\ &0 <= y ==> (root(SUC n) x < root(SUC n) y <=> x < y)`, MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; let ROOT_MONO_LE_EQ = prove (`!x y. &0 <= x /\ &0 <= y ==> (root(SUC n) x <= root(SUC n) y <=> x <= y)`, MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; let ROOT_INJ = prove (`!x y. &0 <= x /\ &0 <= y ==> ((root(SUC n) x = root(SUC n) y) <=> (x = y))`, SIMP_TAC[GSYM REAL_LE_ANTISYM; ROOT_MONO_LE_EQ]);; (* ------------------------------------------------------------------------- *) (* Special case of square roots. *) (* ------------------------------------------------------------------------- *) let SQRT_0 = prove( `sqrt(&0) = &0`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_0]);; let SQRT_1 = prove( `sqrt(&1) = &1`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_1]);; let SQRT_POS_LT = prove (`!x. &0 < x ==> &0 < sqrt(x)`, SIMP_TAC[sqrt; num_CONV `2`; ROOT_LN; REAL_EXP_POS_LT]);; let SQRT_POS_LE = prove (`!x. &0 <= x ==> &0 <= sqrt(x)`, REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SQRT_POS_LT; SQRT_0]);; let SQRT_POW2 = prove( `!x. (sqrt(x) pow 2 = x) <=> &0 <= x`, GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE_POW; REWRITE_TAC[sqrt; num_CONV `2`; ROOT_POW_POS]]);; let SQRT_POW_2 = prove (`!x. &0 <= x ==> (sqrt(x) pow 2 = x)`, REWRITE_TAC[SQRT_POW2]);; let POW_2_SQRT = prove (`&0 <= x ==> (sqrt(x pow 2) = x)`, SIMP_TAC[sqrt; num_CONV `2`; POW_ROOT_POS]);; let SQRT_POS_UNIQ = prove (`!x y. &0 <= x /\ &0 <= y /\ (y pow 2 = x) ==> (sqrt x = y)`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_POS_UNIQ]);; let SQRT_MUL = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x * y) = sqrt x * sqrt y)`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MUL]);; let SQRT_INV = prove (`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_INV]);; let SQRT_DIV = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt (x / y) = sqrt x / sqrt y)`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_DIV]);; let SQRT_MONO_LT = prove (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LT]);; let SQRT_MONO_LE = prove (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LE]);; let SQRT_MONO_LT_EQ = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LT_EQ]);; let SQRT_MONO_LE_EQ = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LE_EQ]);; let SQRT_INJ = prove (`!x y. &0 <= x /\ &0 <= y ==> ((sqrt(x) = sqrt(y)) <=> (x = y))`, REWRITE_TAC[sqrt; num_CONV `2`; ROOT_INJ]);; let SQRT_EVEN_POW2 = prove (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`, GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN DISCH_TAC THEN MATCH_MP_TAC SQRT_POS_UNIQ THEN SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_POW_POW] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [MATCH_MP DIVISION (ARITH_RULE `~(2 = 0)`)] THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; let REAL_DIV_SQRT = prove (`!x. &0 <= x ==> (x / sqrt(x) = sqrt(x))`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[SQRT_0; real_div; REAL_MUL_LZERO]; ALL_TAC] THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_POS_UNIQ THEN ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_DIV] THEN REWRITE_TAC[real_div; REAL_POW_MUL; REAL_POW_INV] THEN ASM_SIMP_TAC[SQRT_POW_2] THEN REWRITE_TAC[REAL_POW_2; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID]);; let POW_2_SQRT_ABS = prove (`!x. sqrt(x pow 2) = abs(x)`, GEN_TAC THEN DISJ_CASES_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THENL [ASM_SIMP_TAC[real_abs; POW_2_SQRT]; SUBST1_TAC(SYM(SPEC `x:real` REAL_NEG_NEG)) THEN ONCE_REWRITE_TAC[REAL_ABS_NEG; REAL_POW_NEG] THEN ASM_SIMP_TAC[POW_2_SQRT; real_abs; ARITH_EVEN]]);; let SQRT_EQ_0 = prove (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`, MESON_TAC[SQRT_INJ; SQRT_0; REAL_LE_REFL]);; let REAL_LE_LSQRT = prove (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`, MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);; let REAL_LE_POW_2 = prove (`!x. &0 <= x pow 2`, REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; let REAL_LE_RSQRT = prove (`!x y. x pow 2 <= y ==> x <= sqrt(y)`, MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE; REAL_LE_POW_2; REAL_LE_TRANS; POW_2_SQRT]);; (* ------------------------------------------------------------------------- *) (* Derivative of sqrt (could do the other roots with a bit more care). *) (* ------------------------------------------------------------------------- *) let DIFF_SQRT = prove (`!x. &0 < x ==> (sqrt diffl inv(&2 * sqrt(x))) x`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. x pow 2`; `sqrt`; `&2 * sqrt(x)`; `sqrt(x)`; `sqrt(x)`] DIFF_INVERSE_LT) THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE; BETA_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SQRT_POS_LT; REAL_LT_IMP_NZ; REAL_ENTIRE] THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[POW_2_SQRT; REAL_ARITH `abs(x - y) < y ==> &0 <= x`]; REPEAT STRIP_TAC THEN CONV_TAC CONTINUOUS_CONV; DIFF_TAC THEN REWRITE_TAC[ARITH; REAL_POW_1; REAL_MUL_RID]]);; let DIFF_SQRT_COMPOSITE = prove (`!g m x. (g diffl m)(x) /\ &0 < g x ==> ((\x. sqrt(g x)) diffl (inv(&2 * sqrt(g x)) * m))(x)`, SIMP_TAC[DIFF_CHAIN; DIFF_SQRT]) in add_to_diff_net (SPEC_ALL DIFF_SQRT_COMPOSITE);; (* ------------------------------------------------------------------------ *) (* Basic properties of the trig functions *) (* ------------------------------------------------------------------------ *) let SIN_0 = prove( `sin(&0) = &0`, REWRITE_TAC[sin] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[LE_0] THEN BETA_TAC THEN REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `n:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN MP_TAC(SPEC `n:num` ODD_EXISTS) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO]);; let COS_0 = prove( `cos(&0) = &1`, REWRITE_TAC[cos] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[num_CONV `1`; sum; ADD_CLAUSES] THEN BETA_TAC THEN REWRITE_TAC[EVEN; pow; FACT] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID] THEN SUBGOAL_THEN `0 DIV 2 = 0` SUBST1_TAC THENL [MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[num_CONV `2`; LT_0]; REWRITE_TAC[pow]] THEN SUBGOAL_THEN `&1 / &1 = &(SUC 0)` SUBST1_TAC THENL [REWRITE_TAC[SYM(num_CONV `1`)] THEN MATCH_MP_TAC REAL_DIV_REFL THEN MATCH_ACCEPT_TAC REAL_10; DISCH_THEN MATCH_MP_TAC] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[LE_SUC_LT] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; ADD_CLAUSES]);; let SIN_CIRCLE = prove( `!x. (sin(x) pow 2) + (cos(x) pow 2) = &1`, GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN SUBGOAL_THEN `&1 = (\x.(sin(x) pow 2) + (cos(x) pow 2))(&0)` SUBST1_TAC THENL [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0] THEN REWRITE_TAC[num_CONV `2`; POW_0] THEN REWRITE_TAC[pow; POW_1] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID]; MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC `x:real` THEN W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[GSYM real_sub; REAL_SUB_0] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN AP_TERM_TAC THEN REWRITE_TAC[num_CONV `2`; SUC_SUB1] THEN REWRITE_TAC[POW_1] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);; let SIN_BOUND = prove( `!x. abs(sin x) <= &1`, GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN REWRITE_TAC[REAL_POW2_ABS] THEN DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN DISCH_THEN(MP_TAC o C CONJ(SPEC `cos(x)` REAL_LE_SQUARE)) THEN REWRITE_TAC[GSYM POW_2] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LTE_ADD) THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `a + b + c = (a + c) + b`] THEN REWRITE_TAC[SIN_CIRCLE; REAL_ADD_RINV; REAL_LT_REFL]);; let SIN_BOUNDS = prove( `!x. --(&1) <= sin(x) /\ sin(x) <= &1`, GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS; SIN_BOUND]);; let COS_BOUND = prove( `!x. abs(cos x) <= &1`, GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN REWRITE_TAC[REAL_POW2_ABS] THEN DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN DISCH_THEN(MP_TAC o CONJ(SPEC `sin(x)` REAL_LE_SQUARE)) THEN REWRITE_TAC[GSYM POW_2] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD) THEN REWRITE_TAC[real_sub; REAL_ADD_ASSOC; SIN_CIRCLE; REAL_ADD_ASSOC; SIN_CIRCLE; REAL_ADD_RINV; REAL_LT_REFL]);; let COS_BOUNDS = prove( `!x. --(&1) <= cos(x) /\ cos(x) <= &1`, GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS; COS_BOUND]);; let SIN_COS_ADD = prove( `!x y. ((sin(x + y) - ((sin(x) * cos(y)) + (cos(x) * sin(y)))) pow 2) + ((cos(x + y) - ((cos(x) * cos(y)) - (sin(x) * sin(y)))) pow 2) = &0`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[`&0`,`x:real`] o snd) THENL [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LZERO; REAL_MUL_LID] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_SUB_REFL] THEN REWRITE_TAC[num_CONV `2`; POW_0; REAL_ADD_LID]; MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN NUM_REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; REAL_MUL_RID] THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN REWRITE_TAC[REAL_SUB_LZERO; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_NEG_RMUL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN BINOP_TAC THENL [REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG; REAL_NEG_RMUL]; REWRITE_TAC[GSYM REAL_NEG_RMUL; GSYM real_sub]]]);; let SIN_COS_NEG = prove( `!x. ((sin(--x) + (sin x)) pow 2) + ((cos(--x) - (cos x)) pow 2) = &0`, GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[`&0`,`x:real`] o snd) THENL [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN REWRITE_TAC[REAL_ADD_LID; REAL_SUB_REFL] THEN REWRITE_TAC[num_CONV `2`; POW_0; REAL_ADD_LID]; MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN NUM_REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[REAL_MUL_RID; real_sub; REAL_NEGNEG; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN REWRITE_TAC[REAL_SUB_LZERO; REAL_NEG_RMUL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; REAL_NEG_RMUL] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_NEG_ADD; REAL_NEGNEG]]);; let SIN_ADD = prove( `!x y. sin(x + y) = (sin(x) * cos(y)) + (cos(x) * sin(y))`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`] SIN_COS_ADD) THEN REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; let COS_ADD = prove( `!x y. cos(x + y) = (cos(x) * cos(y)) - (sin(x) * sin(y))`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`] SIN_COS_ADD) THEN REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; let SIN_NEG = prove( `!x. sin(--x) = --(sin(x))`, GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_COS_NEG) THEN REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; let COS_NEG = prove( `!x. cos(--x) = cos(x)`, GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_COS_NEG) THEN REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; let SIN_DOUBLE = prove( `!x. sin(&2 * x) = &2 * sin(x) * cos(x)`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; SIN_ADD] THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; let COS_DOUBLE = prove( `!x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; COS_ADD; POW_2]);; let COS_ABS = prove (`!x. cos(abs x) = cos(x)`, GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN REWRITE_TAC[COS_NEG]);; (* ------------------------------------------------------------------------ *) (* Show that there's a least positive x with cos(x) = 0; hence define pi *) (* ------------------------------------------------------------------------ *) let SIN_PAIRED = prove( `!x. (\n. (((--(&1)) pow n) / &(FACT((2 * n) + 1))) * (x pow ((2 * n) + 1))) sums (sin x)`, GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_CONVERGES) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM sin] THEN BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1; EVEN_DOUBLE; REWRITE_RULE[GSYM NOT_EVEN] ODD_DOUBLE] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; SUC_SUB1; MULT_DIV_2]);; let SIN_POS = prove( `!x. &0 < x /\ x < &2 ==> &0 < sin(x)`, GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `x:real` SIN_PAIRED) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[SYM(MATCH_MP SUM_UNIQ (SPEC `x:real` SIN_PAIRED))] THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1] THEN REWRITE_TAC[pow; GSYM REAL_NEG_MINUS1; POW_MINUS1] THEN REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM real_sub] THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[ADD1] THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN W(C SUBGOAL_THEN SUBST1_TAC o curry mk_eq `&0` o curry mk_comb `sum(0,0)` o funpow 2 rand o snd) THENL [REWRITE_TAC[sum]; ALL_TAC] THEN MATCH_MP_TAC SER_POS_LT THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1; MULT_CLAUSES] THEN REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; pow; FACT; GSYM REAL_MUL] THEN REWRITE_TAC[SYM(num_CONV `2`)] THEN REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; pow; FACT; GSYM REAL_MUL] THEN REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[GSYM pow] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC POW_POS_LT THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM POW_2] THEN SUBGOAL_THEN `!n. &0 < &(SUC n)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN SUBGOAL_THEN `!n. &0 < &(FACT n)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~(&(SUC n) = &0)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~(&(FACT n) = &0)` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e = (a * b * e) * (c * d)`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL_WEAK) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[POW_2] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC; MATCH_MP_TAC REAL_LT_MUL2_ALT THEN REPEAT CONJ_TAC] THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN NO_TAC) THENL [W((then_) (MATCH_MP_TAC REAL_LT_TRANS) o EXISTS_TAC o curry mk_comb `&` o funpow 3 rand o snd) THEN REWRITE_TAC[REAL_LT; LESS_SUC_REFL]; ALL_TAC] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2` THEN ASM_REWRITE_TAC[] THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN REWRITE_TAC[REAL_LE; LE_SUC; LE_0]);; let COS_PAIRED = prove( `!x. (\n. (((--(&1)) pow n) / &(FACT(2 * n))) * (x pow (2 * n))) sums (cos x)`, GEN_TAC THEN MP_TAC(SPEC `x:real` COS_CONVERGES) THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM cos] THEN BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1; EVEN_DOUBLE; REWRITE_RULE[GSYM NOT_EVEN] ODD_DOUBLE] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; MULT_DIV_2]);; let COS_2 = prove( `cos(&2) < &0`, GEN_REWRITE_TAC LAND_CONV [GSYM REAL_NEGNEG] THEN REWRITE_TAC[REAL_NEG_LT0] THEN MP_TAC(SPEC `&2` COS_PAIRED) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN BETA_TAC THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `sum(0,3) (\n. --((((--(&1)) pow n) / &(FACT(2 * n))) * (&2 pow (2 * n))))` THEN CONJ_TAC THENL [REWRITE_TAC[num_CONV `3`; sum; SUM_2] THEN BETA_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; pow; FACT] THEN REWRITE_TAC[REAL_MUL_RID; POW_1; POW_2; GSYM REAL_NEG_RMUL] THEN IMP_SUBST_TAC REAL_DIV_REFL THEN REWRITE_TAC[REAL_NEGNEG; REAL_10] THEN NUM_REDUCE_TAC THEN REWRITE_TAC[num_CONV `4`; num_CONV `3`; FACT; pow] THEN REWRITE_TAC[SYM(num_CONV `4`); SYM(num_CONV `3`)] THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; FACT; pow] THEN REWRITE_TAC[SYM(num_CONV `1`); SYM(num_CONV `2`)] THEN REWRITE_TAC[REAL_MUL] THEN NUM_REDUCE_TAC THEN REWRITE_TAC[real_div; REAL_NEG_LMUL; REAL_NEGNEG; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; REAL_ADD_ASSOC] THEN REWRITE_TAC[GSYM real_sub; REAL_SUB_LT] THEN SUBGOAL_THEN `inv(&2) * &4 = &1 + &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC `&2` THEN REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC THEN REWRITE_TAC[REAL_ADD; REAL_MUL] THEN NUM_REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN SUBGOAL_THEN `&2 * inv(&2) = &1` SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC; REWRITE_TAC[REAL_MUL_LID; REAL_ADD_ASSOC] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[REAL_LE; REAL_LT] THEN NUM_REDUCE_TAC]; ALL_TAC] THEN MATCH_MP_TAC SER_POS_LT_PAIR THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN X_GEN_TAC `d:num` THEN BETA_TAC THEN REWRITE_TAC[POW_ADD; POW_MINUS1; REAL_MUL_RID] THEN REWRITE_TAC[num_CONV `3`; pow] THEN REWRITE_TAC[SYM(num_CONV `3`)] THEN REWRITE_TAC[POW_2; POW_1] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1; REAL_NEGNEG] THEN REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[REAL_MUL_LID; REAL_NEGNEG] THEN REWRITE_TAC[GSYM real_sub; REAL_SUB_LT] THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; MULT_CLAUSES] THEN REWRITE_TAC[POW_ADD; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[num_CONV `2`; MULT_CLAUSES] THEN REWRITE_TAC[num_CONV `3`; ADD_CLAUSES] THEN MATCH_MP_TAC POW_POS_LT THEN REWRITE_TAC[REAL_LT] THEN NUM_REDUCE_TAC] THEN REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; FACT] THEN REWRITE_TAC[SYM(num_CONV `2`)] THEN REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; FACT] THEN REWRITE_TAC[SYM(num_CONV `1`)] THEN SUBGOAL_THEN `!n. &0 < &(SUC n)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN SUBGOAL_THEN `!n. &0 < &(FACT n)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~(&(SUC n) = &0)` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~(&(FACT n) = &0)` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_MUL] THEN REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (a * b * d) * c`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT; FACT_LT]] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL_WEAK) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[POW_2; REAL_MUL; REAL_LE; REAL_LT] THEN NUM_REDUCE_TAC THEN REWRITE_TAC[num_CONV `4`; num_CONV `3`; MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; MULT_CLAUSES] THEN REWRITE_TAC[num_CONV `1`; LT_SUC; LT_0]);; let COS_ISZERO = prove( `?!x. &0 <= x /\ x <= &2 /\ (cos x = &0)`, REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN BETA_TAC THEN W(C SUBGOAL_THEN ASSUME_TAC o hd o conjuncts o snd) THENL [MATCH_MP_TAC IVT2 THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[REAL_LE; LE_0]; MATCH_MP_TAC REAL_LT_IMP_LE THEN ACCEPT_TAC COS_2; REWRITE_TAC[COS_0; REAL_LE_01]; X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]]; ASM_REWRITE_TAC[] THEN BETA_TAC THEN MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THEN SUBGOAL_THEN `(!x. cos differentiable x) /\ (!x. cos contl x)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN GEN_TAC THENL [REWRITE_TAC[differentiable]; MATCH_MP_TAC DIFF_CONT] THEN EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL [MP_TAC(SPECL [`cos`; `x1:real`; `x2:real`] ROLLE); MP_TAC(SPECL [`cos`; `x2:real`; `x1:real`] ROLLE)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o CONJ(SPEC `x:real` DIFF_COS)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[REAL_NEG_EQ0] THEN MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC SIN_POS THENL [CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x2:real` THEN ASM_REWRITE_TAC[]]; CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real` THEN ASM_REWRITE_TAC[]]]]);; let pi = new_definition `pi = &2 * @x. &0 <= x /\ x <= &2 /\ (cos x = &0)`;; (* ------------------------------------------------------------------------ *) (* Periodicity and related properties of the trig functions *) (* ------------------------------------------------------------------------ *) let PI2 = prove( `pi / &2 = @x. &0 <= x /\ x <= &2 /\ (cos(x) = &0)`, REWRITE_TAC[pi; real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (c * a) * b`] THEN IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_LID]);; let COS_PI2 = prove( `cos(pi / &2) = &0`, MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN REWRITE_TAC[GSYM PI2] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; let PI2_BOUNDS = prove( `&0 < (pi / &2) /\ (pi / &2) < &2`, MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN REWRITE_TAC[GSYM PI2] THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL [DISCH_TAC THEN MP_TAC COS_0 THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM REAL_10]; DISCH_TAC THEN MP_TAC COS_PI2 THEN FIRST_ASSUM SUBST1_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_ACCEPT_TAC COS_2]);; let PI_POS = prove( `&0 < pi`, GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN MATCH_MP_TAC REAL_LT_ADD THEN REWRITE_TAC[PI2_BOUNDS]);; let SIN_PI2 = prove( `sin(pi / &2) = &1`, MP_TAC(SPEC `pi / &2` SIN_CIRCLE) THEN REWRITE_TAC[COS_PI2; POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM REAL_DIFFSQ; REAL_ENTIRE] THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN(MP_TAC o AP_TERM `(--)`) THEN REWRITE_TAC[REAL_NEGNEG] THEN DISCH_TAC THEN MP_TAC REAL_LT_01 THEN POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_GT THEN REWRITE_TAC[REAL_NEG_LT0] THEN MATCH_MP_TAC SIN_POS THEN REWRITE_TAC[PI2_BOUNDS]);; let COS_PI = prove( `cos(pi) = --(&1)`, MP_TAC(SPECL [`pi / &2`; `pi / &2`] COS_ADD) THEN REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO; REAL_MUL_LID] THEN REWRITE_TAC[REAL_SUB_LZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC);; let SIN_PI = prove( `sin(pi) = &0`, MP_TAC(SPECL [`pi / &2`; `pi / &2`] SIN_ADD) THEN REWRITE_TAC[COS_PI2; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC);; let SIN_COS = prove( `!x. sin(x) = cos((pi / &2) - x)`, GEN_TAC THEN REWRITE_TAC[real_sub; COS_ADD] THEN REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID] THEN REWRITE_TAC[SIN_NEG; REAL_NEGNEG]);; let COS_SIN = prove( `!x. cos(x) = sin((pi / &2) - x)`, GEN_TAC THEN REWRITE_TAC[real_sub; SIN_ADD] THEN REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_MUL_LID; REAL_ADD_RID] THEN REWRITE_TAC[COS_NEG]);; let SIN_PERIODIC_PI = prove( `!x. sin(x + pi) = --(sin(x))`, GEN_TAC THEN REWRITE_TAC[SIN_ADD; SIN_PI; COS_PI] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[REAL_MUL_RID]);; let COS_PERIODIC_PI = prove( `!x. cos(x + pi) = --(cos(x))`, GEN_TAC THEN REWRITE_TAC[COS_ADD; SIN_PI; COS_PI] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; GSYM REAL_NEG_RMUL] THEN REWRITE_TAC[REAL_MUL_RID]);; let SIN_PERIODIC = prove( `!x. sin(x + (&2 * pi)) = sin(x)`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_ADD_ASSOC] THEN REWRITE_TAC[SIN_PERIODIC_PI; REAL_NEGNEG]);; let COS_PERIODIC = prove( `!x. cos(x + (&2 * pi)) = cos(x)`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_ADD_ASSOC] THEN REWRITE_TAC[COS_PERIODIC_PI; REAL_NEGNEG]);; let COS_NPI = prove( `!n. cos(&n * pi) = --(&1) pow n`, INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; COS_0; pow] THEN REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; COS_ADD] THEN REWRITE_TAC[REAL_MUL_LID; SIN_PI; REAL_MUL_RZERO; REAL_SUB_RZERO] THEN ASM_REWRITE_TAC[COS_PI] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; let SIN_NPI = prove( `!n. sin(&n * pi) = &0`, INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; SIN_0; pow] THEN REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; SIN_ADD] THEN REWRITE_TAC[REAL_MUL_LID; SIN_PI; REAL_MUL_RZERO; REAL_ADD_RID] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO]);; let SIN_POS_PI2 = prove( `!x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SIN_POS THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `pi / &2` THEN ASM_REWRITE_TAC[PI2_BOUNDS]);; let COS_POS_PI2 = prove( `!x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)`, GEN_TAC THEN STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(SPECL [`cos`; `&0`; `x:real`; `&0`] IVT2) THEN ASM_REWRITE_TAC[COS_0; REAL_LE_01; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; X_GEN_TAC `z:real` THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin z)` THEN REWRITE_TAC[DIFF_COS]; DISCH_THEN(X_CHOOSE_TAC `z:real`) THEN MP_TAC(CONJUNCT2 (CONV_RULE EXISTS_UNIQUE_CONV COS_ISZERO)) THEN DISCH_THEN(MP_TAC o SPECL [`z:real`; `pi / &2`]) THEN ASM_REWRITE_TAC[COS_PI2] THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `pi / &2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC; ALL_TAC; ALL_TAC; DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `x < pi / &2` THEN ASM_REWRITE_TAC[REAL_NOT_LT]] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[PI2_BOUNDS]]);; let COS_POS_PI = prove( `!x. --(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)`, GEN_TAC THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THENL [ASM_REWRITE_TAC[COS_0; REAL_LT_01]; ONCE_REWRITE_TAC[GSYM COS_NEG] THEN MATCH_MP_TAC COS_POS_PI2 THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG]; MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[]]);; let SIN_POS_PI = prove( `!x. &0 < x /\ x < pi ==> &0 < sin(x)`, GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[SIN_COS] THEN ONCE_REWRITE_TAC[GSYM COS_NEG] THEN REWRITE_TAC[REAL_NEG_SUB] THEN MATCH_MP_TAC COS_POS_PI THEN REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN ASM_REWRITE_TAC[REAL_HALF_DOUBLE; REAL_ADD_LINV]);; let SIN_POS_PI_LE = prove (`!x. &0 <= x /\ x <= pi ==> &0 <= sin(x)`, REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SIN_POS_PI; SIN_PI; SIN_0; REAL_LE_REFL]);; let COS_TOTAL = prove( `!y. --(&1) <= y /\ y <= &1 ==> ?!x. &0 <= x /\ x <= pi /\ (cos(x) = y)`, GEN_TAC THEN STRIP_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL [MATCH_MP_TAC IVT2 THEN ASM_REWRITE_TAC[COS_0; COS_PI] THEN REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE PI_POS] THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THENL [FIRST_ASSUM ACCEPT_TAC; MP_TAC(SPECL [`cos`; `x1:real`; `x2:real`] ROLLE); MP_TAC(SPECL [`cos`; `x2:real`; `x1:real`] ROLLE)]] THEN ASM_REWRITE_TAC[] THEN (W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THEN X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN TRY(MATCH_MP_TAC DIFF_CONT) THEN REWRITE_TAC[differentiable] THEN EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; ALL_TAC]) THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(cos diffl &0)(x)` THEN DISCH_THEN(MP_TAC o CONJ (SPEC `x:real` DIFF_COS)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[REAL_NEG_EQ0] THEN DISCH_TAC THEN MP_TAC(SPEC `x:real` SIN_POS_PI) THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real`; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x2:real`; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real`; MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real`] THEN ASM_REWRITE_TAC[]);; let SIN_TOTAL = prove( `!y. --(&1) <= y /\ y <= &1 ==> ?!x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)`, GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y) <=> &0 <= (x + pi / &2) /\ (x + pi / &2) <= pi /\ (cos(x + pi / &2) = --y)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[COS_ADD; SIN_PI2; COS_PI2] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RZERO; REAL_MUL_RID] THEN REWRITE_TAC[REAL_SUB_LZERO] THEN REWRITE_TAC[GSYM REAL_LE_SUB_RADD; GSYM REAL_LE_SUB_LADD] THEN REWRITE_TAC[REAL_SUB_LZERO] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_EQ_NEG] THEN AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN REWRITE_TAC[REAL_ADD_SUB]; ALL_TAC] THEN MP_TAC(SPEC `--y` COS_TOTAL) THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN REWRITE_TAC[REAL_LE_NEG] THEN CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN DISCH_THEN((then_) CONJ_TAC o MP_TAC) THENL [DISCH_THEN(X_CHOOSE_TAC `x:real` o CONJUNCT1) THEN EXISTS_TAC `x - pi / &2` THEN ASM_REWRITE_TAC[REAL_SUB_ADD]; POP_ASSUM(K ALL_TAC) THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN REWRITE_TAC[REAL_EQ_RADD]]);; let COS_ZERO_LEMMA = prove( `!x. &0 <= x /\ (cos(x) = &0) ==> ?n. ~EVEN n /\ (x = &n * (pi / &2))`, GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `x:real` (MATCH_MP REAL_ARCH_LEAST PI_POS)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `&0 <= x - &n * pi /\ (x - &n * pi) <= pi /\ (cos(x - &n * pi) = &0)` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN REWRITE_TAC[real_sub; COS_ADD; SIN_NEG; COS_NEG; SIN_NPI; COS_NPI] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN REWRITE_TAC[REAL_NEG_RMUL; REAL_NEGNEG; REAL_MUL_RZERO] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN UNDISCH_TAC `x < &(SUC n) * pi` THEN REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID]; MP_TAC(SPEC `&0` COS_TOTAL) THEN REWRITE_TAC[REAL_LE_01; REAL_NEG_LE0] THEN DISCH_THEN(MP_TAC o CONV_RULE EXISTS_UNIQUE_CONV) THEN DISCH_THEN(MP_TAC o SPECL [`x - &n * pi`; `pi / &2`] o CONJUNCT2) THEN ASM_REWRITE_TAC[COS_PI2] THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MP_TAC PI2_BOUNDS THEN REWRITE_TAC[REAL_LT_HALF1; REAL_LT_HALF2] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN REWRITE_TAC[REAL_EQ_SUB_RADD] THEN DISCH_TAC THEN EXISTS_TAC `SUC(2 * n)` THEN REWRITE_TAC[GSYM NOT_ODD; ODD_DOUBLE] THEN REWRITE_TAC[ADD1; GSYM REAL_ADD; GSYM REAL_MUL] THEN REWRITE_TAC[REAL_RDISTRIB; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC]);; let SIN_ZERO_LEMMA = prove( `!x. &0 <= x /\ (sin(x) = &0) ==> ?n. EVEN n /\ (x = &n * (pi / &2))`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `x + pi / &2` COS_ZERO_LEMMA) THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]; ASM_REWRITE_TAC[COS_ADD; COS_PI2; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN MATCH_ACCEPT_TAC REAL_SUB_REFL]; DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `n:num` ODD_EXISTS) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN EXISTS_TAC `2 * m` THEN REWRITE_TAC[EVEN_DOUBLE] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_EQ_SUB_LADD]) THEN FIRST_ASSUM SUBST1_TAC THEN REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_SUB]);; let COS_ZERO = prove( `!x. (cos(x) = &0) <=> (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/ (?n. ~EVEN n /\ (x = --(&n * (pi / &2))))`, GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL [DISJ1_TAC THEN MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[]; DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[COS_NEG] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0]]; DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `n:num`)) THEN ASM_REWRITE_TAC[COS_NEG] THEN MP_TAC(SPEC `n:num` ODD_EXISTS) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN REWRITE_TAC[ADD1] THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID; COS_PI2] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_ADD] THEN REWRITE_TAC[REAL_RDISTRIB] THEN REWRITE_TAC[COS_ADD] THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_HALF_DOUBLE] THEN ASM_REWRITE_TAC[COS_PI; SIN_PI; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_SUB_RZERO]]);; let SIN_ZERO = prove( `!x. (sin(x) = &0) <=> (?n. EVEN n /\ (x = &n * (pi / &2))) \/ (?n. EVEN n /\ (x = --(&n * (pi / &2))))`, GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL [DISJ1_TAC THEN MATCH_MP_TAC SIN_ZERO_LEMMA THEN ASM_REWRITE_TAC[]; DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN MATCH_MP_TAC SIN_ZERO_LEMMA THEN ASM_REWRITE_TAC[SIN_NEG; REAL_NEG_0; REAL_NEG_GE0]]; DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `n:num`)) THEN ASM_REWRITE_TAC[SIN_NEG; REAL_NEG_EQ0] THEN MP_TAC(SPEC `n:num` EVEN_EXISTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM REAL_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = b * (a * c)`] THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_HALF_DOUBLE; SIN_NPI]]);; let SIN_ZERO_PI = prove (`!x. (sin(x) = &0) <=> (?n. x = &n * pi) \/ (?n. x = --(&n * pi))`, GEN_TAC THEN REWRITE_TAC[SIN_ZERO; EVEN_EXISTS] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH]);; let COS_ONE_2PI = prove (`!x. (cos(x) = &1) <=> (?n. x = &n * &2 * pi) \/ (?n. x = --(&n * &2 * pi))`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[COS_NEG] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_OF_NUM_MUL; COS_NPI] THEN REWRITE_TAC[REAL_POW_NEG; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]] THEN DISCH_TAC THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN ASM_REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ARITH `(x + &1 * &1 = &1) <=> (x = &0)`] THEN REWRITE_TAC[REAL_ENTIRE] THEN REWRITE_TAC[SIN_ZERO_PI] THEN MATCH_MP_TAC(TAUT `(a ==> a') /\ (b ==> b') ==> (a \/ b ==> a' \/ b')`) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN CONJ_TAC THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_EQ_NEG2; COS_NEG] THEN REWRITE_TAC[COS_NPI; REAL_POW_NEG; REAL_POW_ONE] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_MUL_RCANCEL] THEN SIMP_TAC[PI_POS; REAL_LT_IMP_NZ] THEN REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EVEN_EXISTS] THEN COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------ *) (* Tangent *) (* ------------------------------------------------------------------------ *) let tan = new_definition `tan(x) = sin(x) / cos(x)`;; let TAN_0 = prove( `tan(&0) = &0`, REWRITE_TAC[tan; SIN_0; REAL_DIV_LZERO]);; let TAN_PI = prove( `tan(pi) = &0`, REWRITE_TAC[tan; SIN_PI; REAL_DIV_LZERO]);; let TAN_NPI = prove( `!n. tan(&n * pi) = &0`, GEN_TAC THEN REWRITE_TAC[tan; SIN_NPI; REAL_DIV_LZERO]);; let TAN_NEG = prove( `!x. tan(--x) = --(tan x)`, GEN_TAC THEN REWRITE_TAC[tan; SIN_NEG; COS_NEG] THEN REWRITE_TAC[real_div; REAL_NEG_LMUL]);; let TAN_PERIODIC = prove( `!x. tan(x + &2 * pi) = tan(x)`, GEN_TAC THEN REWRITE_TAC[tan; SIN_PERIODIC; COS_PERIODIC]);; let TAN_PERIODIC_PI = prove (`!x. tan(x + pi) = tan(x)`, REWRITE_TAC[tan; SIN_PERIODIC_PI; COS_PERIODIC_PI; real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let TAN_PERIODIC_NPI = prove (`!x n. tan(x + &n * pi) = tan(x)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN ASM_REWRITE_TAC[REAL_ADD_ASSOC; TAN_PERIODIC_PI]);; let TAN_ADD = prove( `!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) ==> (tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[tan] THEN MP_TAC(SPECL [`cos(x) * cos(y)`; `&1 - (sin(x) / cos(x)) * (sin(y) / cos(y))`] REAL_DIV_MUL2) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [DISCH_THEN(MP_TAC o AP_TERM `(*) (cos(x) * cos(y))`) THEN REWRITE_TAC[real_div; REAL_SUB_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN UNDISCH_TAC `~(cos(x + y) = &0)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[COS_ADD] THEN AP_TERM_TAC; DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN BINOP_TAC THENL [REWRITE_TAC[real_div; REAL_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[SIN_ADD] THEN BINOP_TAC THENL [ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (d * a) * (c * b)`] THEN IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]; ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (d * b) * (a * c)`] THEN IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]]; REWRITE_TAC[COS_ADD; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN AP_TERM_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC]]] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e * f = (f * b) * (d * a) * (c * e)`] THEN REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[REAL_MUL_LID]);; let TAN_DOUBLE = prove( `!x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) ==> (tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2)))`, GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `x:real`] TAN_ADD) THEN ASM_REWRITE_TAC[REAL_DOUBLE; POW_2]);; let TAN_POS_PI2 = prove( `!x. &0 < x /\ x < pi / &2 ==> &0 < tan(x)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan; real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC SIN_POS_PI2; MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC COS_POS_PI2] THEN ASM_REWRITE_TAC[]);; let DIFF_TAN = prove( `!x. ~(cos(x) = &0) ==> (tan diffl inv(cos(x) pow 2))(x)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(DIFF_CONV `\x. sin(x) / cos(x)`) THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[REAL_MUL_RID] THEN REWRITE_TAC[GSYM tan; GSYM REAL_NEG_LMUL; REAL_NEGNEG; real_sub] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM POW_2; SIN_CIRCLE; GSYM REAL_INV_1OVER]);; let DIFF_TAN_COMPOSITE = prove (`(g diffl m)(x) /\ ~(cos(g x) = &0) ==> ((\x. tan(g x)) diffl (inv(cos(g x) pow 2) * m))(x)`, ASM_SIMP_TAC[DIFF_CHAIN; DIFF_TAN]) in add_to_diff_net DIFF_TAN_COMPOSITE;; let TAN_TOTAL_LEMMA = prove( `!y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)`, GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `((\x. cos(x) / sin(x)) tends_real_real &0)(pi / &2)` MP_TAC THENL [SUBST1_TAC(SYM(SPEC `&1` REAL_DIV_LZERO)) THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC LIM_DIV THEN REWRITE_TAC[REAL_10] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN SUBST1_TAC(SYM COS_PI2) THEN SUBST1_TAC(SYM SIN_PI2) THEN REWRITE_TAC[GSYM CONTL_LIM] THEN CONJ_TAC THEN MATCH_MP_TAC DIFF_CONT THENL [EXISTS_TAC `--(sin(pi / &2))`; EXISTS_TAC `cos(pi / &2)`] THEN REWRITE_TAC[DIFF_SIN; DIFF_COS]; ALL_TAC] THEN REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `inv(y)`) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_POS th]) THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d:real`; `pi / &2`] REAL_DOWN2) THEN ASM_REWRITE_TAC[PI2_BOUNDS] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(pi / &2) - e` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN CONJ_TAC THENL [REWRITE_TAC[real_sub; GSYM REAL_NOT_LE; REAL_LE_ADDR; REAL_NEG_GE0] THEN ASM_REWRITE_TAC[REAL_NOT_LE]; ALL_TAC] THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `(pi / &2) - e`) THEN REWRITE_TAC[REAL_SUB_SUB; ABS_NEG] THEN SUBGOAL_THEN `abs(e) = e` (fun th -> ASM_REWRITE_TAC[th]) THENL [REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < cos((pi / &2) - e) / sin((pi / &2) - e)` MP_TAC THENL [ONCE_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC COS_POS_PI2; MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC SIN_POS_PI2] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[GSYM REAL_NOT_LE; real_sub; REAL_LE_ADDR; REAL_NEG_GE0] THEN ASM_REWRITE_TAC[REAL_NOT_LE]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_POS_NZ th)) THEN REWRITE_TAC[ABS_NZ; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_INV2) THEN REWRITE_TAC[tan] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN MP_TAC(ASSUME `&0 < cos((pi / &2) - e) / sin((pi / &2) - e)`) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN REWRITE_TAC[GSYM ABS_REFL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL_WEAK THENL [REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM REAL_ENTIRE; GSYM real_div] THEN MATCH_MP_TAC REAL_POS_NZ THEN FIRST_ASSUM ACCEPT_TAC; GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC SIN_POS_PI2 THEN REWRITE_TAC[REAL_SUB_LT; GSYM real_div] THEN REWRITE_TAC[GSYM REAL_NOT_LE; real_sub; REAL_LE_ADDR; REAL_NEG_GE0] THEN ASM_REWRITE_TAC[REAL_NOT_LE]]);; let TAN_TOTAL_POS = prove( `!y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ (tan(x) = y)`, GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP TAN_TOTAL_LEMMA) THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`tan`; `&0`; `x:real`; `y:real`] IVT) THEN W(C SUBGOAL_THEN (fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) o funpow 2 (fst o dest_imp) o snd) THENL [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN ASM_REWRITE_TAC[TAN_0] THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(cos(z) pow 2)` THEN MATCH_MP_TAC DIFF_TAN THEN UNDISCH_TAC `&0 <= z` THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COS_0; REAL_10]]; DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `z:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]; POP_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC `&0` THEN REWRITE_TAC[TAN_0; REAL_LE_REFL; PI2_BOUNDS]]);; let TAN_TOTAL = prove( `!y. ?!x. --(pi / &2) < x /\ x < (pi / &2) /\ (tan(x) = y)`, GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL [DISJ_CASES_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THEN POP_ASSUM(X_CHOOSE_TAC `x:real` o MATCH_MP TAN_TOTAL_POS) THENL [EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0; PI2_BOUNDS]; EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[REAL_LT_NEG] THEN ASM_REWRITE_TAC[TAN_NEG; REAL_NEG_EQ; REAL_NEGNEG] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN REWRITE_TAC[REAL_LT_NEG] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LE_NEGL]]; MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THENL [DISCH_THEN(K ALL_TAC) THEN POP_ASSUM ACCEPT_TAC; ALL_TAC; POP_ASSUM MP_TAC THEN SPEC_TAC(`x1:real`,`z1:real`) THEN SPEC_TAC(`x2:real`,`z2:real`) THEN MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN DISCH_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[CONJ_SYM]] THEN (STRIP_TAC THEN MP_TAC(SPECL [`tan`; `x1:real`; `x2:real`] ROLLE) THEN ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(cos(x) pow 2)` THEN MATCH_MP_TAC DIFF_TAN; X_GEN_TAC `x:real` THEN DISCH_THEN(CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN REWRITE_TAC[differentiable] THEN EXISTS_TAC `inv(cos(x) pow 2)` THEN MATCH_MP_TAC DIFF_TAN; REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` (CONJUNCTS_THEN2 (CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) ASSUME_TAC)) THEN MP_TAC(SPEC `x:real` DIFF_TAN) THEN SUBGOAL_THEN `~(cos(x) = &0)` ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o C CONJ (ASSUME `(tan diffl &0)(x)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_NZ THEN MATCH_MP_TAC POW_NZ THEN ASM_REWRITE_TAC[]]] THEN (MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real`; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real`] THEN ASM_REWRITE_TAC[]))]);; let PI2_PI4 = prove (`pi / &2 = &2 * pi / &4`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let TAN_PI4 = prove (`tan(pi / &4) = &1`, REWRITE_TAC[tan; COS_SIN; real_div; GSYM REAL_SUB_LDISTRIB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[SIN_ZERO] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_LNEG] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * a * c`] THEN SIMP_TAC[REAL_MUL_LID; REAL_EQ_MUL_LCANCEL; PI_POS; REAL_LT_IMP_NZ] THEN SIMP_TAC[GSYM real_div; REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN SIMP_TAC[REAL_ARITH `&0 <= x ==> ~(&1 = --x)`; REAL_POS] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; ARITH_EVEN]);; let TAN_COT = prove (`!x. tan(pi / &2 - x) = inv(tan x)`, REWRITE_TAC[tan; GSYM SIN_COS; GSYM COS_SIN; REAL_INV_DIV]);; let TAN_BOUND_PI2 = prove (`!x. abs(x) < pi / &4 ==> abs(tan x) < &1`, REPEAT GEN_TAC THEN SUBGOAL_THEN `!x. &0 < x /\ x < pi / &4 ==> &0 < tan(x) /\ tan(x) < &1` ASSUME_TAC THENL [REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[tan; REAL_LT_DIV; SIN_POS_PI2; COS_POS_PI2; PI2_PI4; REAL_ARITH `&0 < x /\ x < a ==> x < &2 * a`]; ALL_TAC] THEN MP_TAC(SPECL [`tan`; `\x. inv(cos(x) pow 2)`; `x:real`; `pi / &4`] MVT_ALT) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [ASM_REWRITE_TAC[BETA_THM] THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_TAN THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI2 THEN REWRITE_TAC[PI2_PI4] THEN MAP_EVERY UNDISCH_TAC [`x <= z`; `z <= pi / &4`; `&0 < x`] THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[TAN_PI4; REAL_ARITH `x < &1 <=> &0 < &1 - x`; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[REAL_LT_INV_EQ; BETA_THM] THEN MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC COS_POS_PI2 THEN REWRITE_TAC[PI2_PI4] THEN MAP_EVERY UNDISCH_TAC [`x < z`; `z < pi / &4`; `&0 < x`] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [real_abs] THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[TAN_0; REAL_ABS_NUM; REAL_LT_01] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) < &1`] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN REWRITE_TAC[GSYM TAN_NEG] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) < &1`; REAL_ARITH `~(x = &0) /\ ~(&0 < x) ==> &0 < --x`]);; let TAN_ABS_GE_X = prove (`!x. abs(x) < pi / &2 ==> abs(x) <= abs(tan x)`, SUBGOAL_THEN `!y. &0 < y /\ y < pi / &2 ==> y <= tan(y)` ASSUME_TAC THENL [ALL_TAC; GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN ASM_REWRITE_TAC[TAN_0; REAL_ABS_0; REAL_LE_REFL] THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN REWRITE_TAC[GSYM TAN_NEG]] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ (x < p ==> x <= tx) ==> abs(x) < p ==> abs(x) <= abs(tx)`) THEN ASM_SIMP_TAC[]] THEN GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`tan`; `\x. inv(cos(x) pow 2)`; `&0`; `y:real`] MVT_ALT) THEN ASM_REWRITE_TAC[TAN_0; REAL_SUB_RZERO] THEN MATCH_MP_TAC(TAUT `a /\ (b ==> c) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN BETA_TAC THEN MATCH_MP_TAC DIFF_TAN THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[BETA_THM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_INV_1_LE THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LT; MATCH_MP_TAC REAL_POW_1_LE THEN REWRITE_TAC[COS_BOUNDS] THEN MATCH_MP_TAC REAL_LT_IMP_LE] THEN MATCH_MP_TAC COS_POS_PI THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------ *) (* Inverse trig functions *) (* ------------------------------------------------------------------------ *) let asn = new_definition `asn(y) = @x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin x = y)`;; let acs = new_definition `acs(y) = @x. &0 <= x /\ x <= pi /\ (cos x = y)`;; let atn = new_definition `atn(y) = @x. --(pi / &2) < x /\ x < pi / &2 /\ (tan x = y)`;; let ASN = prove( `!y. --(&1) <= y /\ y <= &1 ==> --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2 /\ (sin(asn y) = y)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SIN_TOTAL) THEN DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM asn]);; let ASN_SIN = prove( `!y. --(&1) <= y /\ y <= &1 ==> (sin(asn(y)) = y)`, GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ASN th]));; let ASN_BOUNDS = prove( `!y. --(&1) <= y /\ y <= &1 ==> --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2`, GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ASN th]));; let ASN_BOUNDS_LT = prove( `!y. --(&1) < y /\ y < &1 ==> --(pi / &2) < asn(y) /\ asn(y) < pi / &2`, GEN_TAC THEN STRIP_TAC THEN EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN MP_TAC(SPEC `y:real` ASN_BOUNDS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `sin`) THEN IMP_SUBST_TAC ASN_SIN THEN ASM_REWRITE_TAC[SIN_NEG; SIN_PI2] THEN DISCH_THEN((then_) (POP_ASSUM_LIST (MP_TAC o end_itlist CONJ)) o ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_LT_REFL]);; let SIN_ASN = prove( `!x. --(pi / &2) <= x /\ x <= pi / &2 ==> (asn(sin(x)) = x)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(MATCH_MP SIN_TOTAL (SPEC `x:real` SIN_BOUNDS)) THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ASN THEN MATCH_ACCEPT_TAC SIN_BOUNDS);; let ACS = prove( `!y. --(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi /\ (cos(acs y) = y)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COS_TOTAL) THEN DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM acs]);; let ACS_COS = prove( `!y. --(&1) <= y /\ y <= &1 ==> (cos(acs(y)) = y)`, GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ACS th]));; let ACS_BOUNDS = prove( `!y. --(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi`, GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ACS th]));; let ACS_BOUNDS_LT = prove( `!y. --(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi`, GEN_TAC THEN STRIP_TAC THEN EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN MP_TAC(SPEC `y:real` ACS_BOUNDS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN IMP_SUBST_TAC ACS_COS THEN ASM_REWRITE_TAC[COS_0; COS_PI] THEN DISCH_THEN((then_) (POP_ASSUM_LIST (MP_TAC o end_itlist CONJ)) o ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_LT_REFL]);; let COS_ACS = prove( `!x. &0 <= x /\ x <= pi ==> (acs(cos(x)) = x)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(MATCH_MP COS_TOTAL (SPEC `x:real` COS_BOUNDS)) THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ACS THEN MATCH_ACCEPT_TAC COS_BOUNDS);; let ATN = prove( `!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2) /\ (tan(atn y) = y)`, GEN_TAC THEN MP_TAC(SPEC `y:real` TAN_TOTAL) THEN DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM atn]);; let ATN_TAN = prove( `!y. tan(atn y) = y`, REWRITE_TAC[ATN]);; let ATN_BOUNDS = prove( `!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2)`, REWRITE_TAC[ATN]);; let TAN_ATN = prove( `!x. --(pi / &2) < x /\ x < (pi / &2) ==> (atn(tan(x)) = x)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `tan(x)` TAN_TOTAL) THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN ASM_REWRITE_TAC[ATN]);; let ATN_0 = prove (`atn(&0) = &0`, GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM TAN_0] THEN MATCH_MP_TAC TAN_ATN THEN MATCH_MP_TAC(REAL_ARITH `&0 < a ==> --a < &0 /\ &0 < a`) THEN SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT; ARITH]);; let ATN_1 = prove (`atn(&1) = pi / &4`, MP_TAC(AP_TERM `atn` TAN_PI4) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC TAN_ATN THEN MATCH_MP_TAC(REAL_ARITH `&0 < a /\ a < b ==> --b < a /\ a < b`) THEN SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN SIMP_TAC[real_div; REAL_LT_LMUL_EQ; PI_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ATN_NEG = prove (`!x. atn(--x) = --(atn x)`, GEN_TAC THEN MP_TAC(SPEC `atn(x)` TAN_NEG) THEN REWRITE_TAC[ATN_TAN] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC TAN_ATN THEN MATCH_MP_TAC(REAL_ARITH `--a < x /\ x < a ==> --a < --x /\ --x < a`) THEN REWRITE_TAC[ATN_BOUNDS]);; (* ------------------------------------------------------------------------- *) (* Differentiation of arctan. *) (* ------------------------------------------------------------------------- *) let COS_ATN_NZ = prove( `!x. ~(cos(atn(x)) = &0)`, GEN_TAC THEN REWRITE_TAC[COS_ZERO; DE_MORGAN_THM] THEN CONJ_TAC THEN CONV_TAC NOT_EXISTS_CONV THEN X_GEN_TAC `n:num` THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN REWRITE_TAC[EVEN; DE_MORGAN_THM] THEN DISJ2_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `x:real` ATN_BOUNDS) THEN ASM_REWRITE_TAC[DE_MORGAN_THM] THENL [DISJ2_TAC; DISJ1_TAC THEN REWRITE_TAC[REAL_LT_NEG]] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN REWRITE_TAC[MATCH_MP REAL_LT_RMUL_EQ (CONJUNCT1 PI2_BOUNDS)] THEN REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_NOT_LT] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_LE_ADDR; REAL_LE; LE_0]);; let TAN_SEC = prove( `!x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM (MATCH_MP REAL_DIV_REFL (SPEC `2` (MATCH_MP POW_NZ th)))]) THEN REWRITE_TAC[real_div; POW_MUL] THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_RDISTRIB; SIN_CIRCLE; REAL_MUL_LID]);; let DIFF_ATN = prove( `!x. (atn diffl (inv(&1 + (x pow 2))))(x)`, GEN_TAC THEN SUBGOAL_THEN `(atn diffl (inv(&1 + (x pow 2))))(tan(atn x))` MP_TAC THENL [MATCH_MP_TAC DIFF_INVERSE_LT; REWRITE_TAC[ATN_TAN]] THEN SUBGOAL_THEN `?d. &0 < d /\ !z. abs(z - atn(x)) < d ==> (--(pi / (& 2))) < z /\ z < (pi / (& 2))` (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THENL [ONCE_REWRITE_TAC[ABS_SUB] THEN MATCH_MP_TAC INTERVAL_LEMMA_LT THEN MATCH_ACCEPT_TAC ATN_BOUNDS; EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC TAN_ATN THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(cos(z) pow 2)` THEN MATCH_MP_TAC DIFF_TAN THEN MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ASSUME_TAC(SPEC `x:real` COS_ATN_NZ) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_TAN) THEN FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP TAN_SEC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP POW_INV) THEN ASM_REWRITE_TAC[ATN_TAN]; UNDISCH_TAC `&1 + (x pow 2) = &0` THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC REAL_LTE_ADD THEN REWRITE_TAC[REAL_LT_01; REAL_LE_SQUARE; POW_2]]]);; let DIFF_ATN_COMPOSITE = prove (`(g diffl m)(x) ==> ((\x. atn(g x)) diffl (inv(&1 + (g x) pow 2) * m))(x)`, ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ATN]) in add_to_diff_net DIFF_ATN_COMPOSITE;; (* ------------------------------------------------------------------------- *) (* A few more lemmas about arctan. *) (* ------------------------------------------------------------------------- *) let ATN_MONO_LT = prove (`!x y. x < y ==> atn(x) < atn(y)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`atn`; `\x. inv(&1 + x pow 2)`; `x:real`; `y:real`] MVT_ALT) THEN BETA_TAC THEN ASM_REWRITE_TAC[DIFF_ATN] THEN STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `(l - r = d) ==> l < d + e ==> r < e`)) THEN REWRITE_TAC[REAL_ARITH `a < b + a <=> &0 < b`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; let ATN_MONO_LT_EQ = prove (`!x y. atn(x) < atn(y) <=> x < y`, MESON_TAC[REAL_NOT_LE; REAL_LE_LT; ATN_MONO_LT]);; let ATN_MONO_LE_EQ = prove (`!x y. atn(x) <= atn(y) <=> x <= y`, REWRITE_TAC[GSYM REAL_NOT_LT; ATN_MONO_LT_EQ]);; let ATN_INJ = prove (`!x y. (atn x = atn y) <=> (x = y)`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; ATN_MONO_LE_EQ]);; let ATN_POS_LT = prove (`&0 < atn(x) <=> &0 < x`, MESON_TAC[ATN_0; ATN_MONO_LT_EQ]);; let ATN_POS_LE = prove (`&0 <= atn(x) <=> &0 <= x`, MESON_TAC[ATN_0; ATN_MONO_LE_EQ]);; let ATN_LT_PI4_POS = prove (`!x. x < &1 ==> atn(x) < pi / &4`, SIMP_TAC[GSYM ATN_1; ATN_MONO_LT]);; let ATN_LT_PI4_NEG = prove (`!x. --(&1) < x ==> --(pi / &4) < atn(x)`, SIMP_TAC[GSYM ATN_1; GSYM ATN_NEG; ATN_MONO_LT]);; let ATN_LT_PI4 = prove (`!x. abs(x) < &1 ==> abs(atn x) < pi / &4`, GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `(&0 < x ==> &0 < y) /\ (x < &0 ==> y < &0) /\ ((x = &0) ==> (y = &0)) /\ (x < a ==> y < b) /\ (--a < x ==> --b < y) ==> abs(x) < a ==> abs(y) < b`) THEN SIMP_TAC[ATN_LT_PI4_POS; ATN_LT_PI4_NEG; ATN_0] THEN CONJ_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ATN_0] THEN SIMP_TAC[ATN_MONO_LT]);; let ATN_LE_PI4 = prove (`!x. abs(x) <= &1 ==> abs(atn x) <= pi / &4`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ATN_LT_PI4] THEN DISJ2_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `(abs(x) = a) ==> (x = a) \/ (x = --a)`)) THEN ASM_REWRITE_TAC[ATN_1; ATN_NEG] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NEG] THEN SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS]);; (* ------------------------------------------------------------------------- *) (* Differentiation of arcsin. *) (* ------------------------------------------------------------------------- *) let COS_SIN_SQRT = prove( `!x. &0 <= cos(x) ==> (cos(x) = sqrt(&1 - (sin(x) pow 2)))`, GEN_TAC THEN DISCH_TAC THEN MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC `x:real` SIN_CIRCLE)) THEN REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[sqrt; num_CONV `2`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN ASM_REWRITE_TAC[]);; let COS_ASN_NZ = prove( `!x. --(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ASN_BOUNDS_LT) THEN REWRITE_TAC[COS_ZERO; DE_MORGAN_THM] THEN CONJ_TAC THEN CONV_TAC NOT_EXISTS_CONV THEN X_GEN_TAC `n:num` THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN REWRITE_TAC[EVEN] THEN STRIP_TAC THENL [UNDISCH_TAC `asn(x) < (pi / &2)` THEN ASM_REWRITE_TAC[]; UNDISCH_TAC `--(pi / &2) < asn(x)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LT_NEG]] THEN REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_ADDL] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE; LE_0] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]);; let DIFF_ASN_COS = prove( `!x. --(&1) < x /\ x < &1 ==> (asn diffl (inv(cos(asn x))))(x)`, REPEAT STRIP_TAC THEN EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN MP_TAC(SPEC `x:real` ASN_SIN) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC DIFF_INVERSE_LT THEN MP_TAC(SPEC `x:real` ASN_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP INTERVAL_LEMMA_LT th)) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[ABS_SUB]) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC SIN_ASN THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `cos(z)` THEN REWRITE_TAC[DIFF_SIN]; REWRITE_TAC[DIFF_SIN]; POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC COS_ASN_NZ THEN ASM_REWRITE_TAC[]]);; let DIFF_ASN = prove( `!x. --(&1) < x /\ x < &1 ==> (asn diffl (inv(sqrt(&1 - (x pow 2)))))(x)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ASN_COS) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `sin(asn x) = x` MP_TAC THENL [MATCH_MP_TAC ASN_SIN THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN MATCH_MP_TAC COS_SIN_SQRT THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ASN_BOUNDS_LT) THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC COS_POS_PI THEN ASM_REWRITE_TAC[]]);; let DIFF_ASN_COMPOSITE = prove (`(g diffl m)(x) /\ -- &1 < g(x) /\ g(x) < &1 ==> ((\x. asn(g x)) diffl (inv(sqrt (&1 - g(x) pow 2)) * m))(x)`, ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ASN]) in add_to_diff_net DIFF_ASN_COMPOSITE;; (* ------------------------------------------------------------------------- *) (* Differentiation of arccos. *) (* ------------------------------------------------------------------------- *) let SIN_COS_SQRT = prove( `!x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))`, GEN_TAC THEN DISCH_TAC THEN MP_TAC (SPEC `x:real` SIN_CIRCLE) THEN REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[sqrt; num_CONV `2`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN ASM_REWRITE_TAC[]);; let SIN_ACS_NZ = prove( `!x. --(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ACS_BOUNDS_LT) THEN REWRITE_TAC[SIN_ZERO; REAL_NEG_EQ0] THEN REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THEN CONV_TAC NOT_EXISTS_CONV THEN (INDUCT_TAC THENL [REWRITE_TAC[REAL_MUL_LZERO; EVEN; REAL_NEG_0] THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_REFL]) THEN CONTR_TAC(ASSUME `F`); ALL_TAC] THEN SPEC_TAC(`n:num`,`n:num`) THEN REWRITE_TAC[EVEN] THEN INDUCT_TAC THEN REWRITE_TAC[EVEN] THEN STRIP_TAC) THENL [UNDISCH_TAC `acs(x) < pi` THEN ASM_REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_LID; GSYM REAL_ADD_ASSOC] THEN REWRITE_TAC[REAL_HALF_DOUBLE] THEN REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_ADDL] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE; LE_0] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]; UNDISCH_TAC `&0 < acs(x)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN REWRITE_TAC[REAL_NEGNEG; REAL_NEG_LMUL; REAL_NEG_0] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE; LE_0] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]]);; let DIFF_ACS_SIN = prove( `!x. --(&1) < x /\ x < &1 ==> (acs diffl (inv(--(sin(acs x)))))(x)`, REPEAT STRIP_TAC THEN EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN MP_TAC(SPEC `x:real` ACS_COS) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC DIFF_INVERSE_LT THEN MP_TAC(SPEC `x:real` ACS_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP INTERVAL_LEMMA_LT th)) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[ABS_SUB]) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC COS_ACS THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin(z))` THEN REWRITE_TAC[DIFF_COS]; REWRITE_TAC[DIFF_COS]; POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG] THEN REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]]);; let DIFF_ACS = prove( `!x. --(&1) < x /\ x < &1 ==> (acs diffl --(inv(sqrt(&1 - (x pow 2)))))(x)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ACS_SIN) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN IMP_SUBST_TAC (GSYM REAL_NEG_INV) THENL [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]; REPEAT AP_TERM_TAC] THEN SUBGOAL_THEN `cos(acs x) = x` MP_TAC THENL [MATCH_MP_TAC ACS_COS THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN MATCH_MP_TAC SIN_COS_SQRT THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ACS_BOUNDS_LT) THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REWRITE_TAC[]]);; let DIFF_ACS_COMPOSITE = prove (`(g diffl m)(x) /\ -- &1 < g(x) /\ g(x) < &1 ==> ((\x. acs(g x)) diffl (--inv(sqrt(&1 - g(x) pow 2)) * m))(x)`, ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ACS]) in add_to_diff_net DIFF_ACS_COMPOSITE;; (* ------------------------------------------------------------------------- *) (* Back to normal service! *) (* ------------------------------------------------------------------------- *) extend_basic_rewrites [BETA_THM];; (* ------------------------------------------------------------------------- *) (* A kind of inverse to SIN_CIRCLE *) (* ------------------------------------------------------------------------- *) let CIRCLE_SINCOS = prove (`!x y. (x pow 2 + y pow 2 = &1) ==> ?t. (x = cos(t)) /\ (y = sin(t))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(x) <= &1 /\ abs(y) <= &1` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `(&1 < x ==> &1 < x pow 2) /\ (&1 < y ==> &1 < y pow 2) /\ &0 <= x pow 2 /\ &0 <= y pow 2 /\ x pow 2 + y pow 2 <= &1 ==> x <= &1 /\ y <= &1`) THEN ASM_REWRITE_TAC[REAL_POW2_ABS; REAL_LE_REFL] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2] THEN CONJ_TAC THEN DISCH_TAC THEN SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&1 * &1`)) THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_POS]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= sin(acs x)` MP_TAC THENL [MATCH_MP_TAC SIN_POS_PI_LE THEN MATCH_MP_TAC ACS_BOUNDS THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP SIN_COS_SQRT) THEN SUBGOAL_THEN `abs(y) = sqrt(&1 - x pow 2)` ASSUME_TAC THENL [REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN AP_TERM_TAC THEN UNDISCH_TAC `x pow 2 + y pow 2 = &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `&0 <= y` THENL [EXISTS_TAC `acs x`; EXISTS_TAC `--(acs x)`] THEN ASM_SIMP_TAC[COS_NEG; SIN_NEG; ACS_COS; REAL_ARITH `abs(x) <= &1 ==> --(&1) <= x /\ x <= &1`] THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ (abs(y) = x) ==> (y = x)`); MATCH_MP_TAC(REAL_ARITH `~(&0 <= y) /\ (abs(y) = x) ==> (y = --x)`)] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* More lemmas. *) (* ------------------------------------------------------------------------- *) let ACS_MONO_LT = prove (`!x y. --(&1) < x /\ x < y /\ y < &1 ==> acs(y) < acs(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`acs`; `\x. --inv(sqrt(&1 - x pow 2))`; `x:real`; `y:real`] MVT_ALT) THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC DIFF_ACS THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]; REWRITE_TAC[REAL_EQ_SUB_RADD]] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `a * --c + x < x <=> &0 < a * c`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LT_INV THEN MATCH_MP_TAC SQRT_POS_LT THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2] THEN REWRITE_TAC[REAL_ARITH `&0 < &1 - z * z <=> z * z < &1 * &1`] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC);; (* ======================================================================== *) (* Formalization of Kurzweil-Henstock gauge integral *) (* ======================================================================== *) let LE_MATCH_TAC th (asl,w) = let thi = PART_MATCH (rand o rator) th (rand(rator w)) in let tm = rand(concl thi) in (MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC THENL [MATCH_ACCEPT_TAC th; ALL_TAC]) (asl,w);; (* ------------------------------------------------------------------------ *) (* Some miscellaneous lemmas *) (* ------------------------------------------------------------------------ *) let LESS_SUC_EQ = prove( `!m n. m < SUC n <=> m <= n`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LT; LE_LT] THEN EQ_TAC THEN DISCH_THEN(DISJ_CASES_THEN(fun th -> REWRITE_TAC[th])));; let LESS_1 = prove( `!n. n < 1 <=> (n = 0)`, REWRITE_TAC[num_CONV `1`; LESS_SUC_EQ; CONJUNCT1 LE]);; (* ------------------------------------------------------------------------ *) (* Divisions and tagged divisions etc. *) (* ------------------------------------------------------------------------ *) let division = new_definition `division(a,b) D <=> (D 0 = a) /\ (?N. (!n. n < N ==> D(n) < D(SUC n)) /\ (!n. n >= N ==> (D(n) = b)))`;; let dsize = new_definition `dsize D = @N. (!n. n < N ==> D(n) < D(SUC n)) /\ (!n. n >= N ==> (D(n) = D(N)))`;; let tdiv = new_definition `tdiv(a,b) (D,p) <=> division(a,b) D /\ (!n. D(n) <= p(n) /\ p(n) <= D(SUC n))`;; (* ------------------------------------------------------------------------ *) (* Gauges and gauge-fine divisions *) (* ------------------------------------------------------------------------ *) let gauge = new_definition `gauge(E) (g:real->real) <=> !x. E x ==> &0 < g(x)`;; let fine = new_definition `fine(g:real->real) (D,p) <=> !n. n < (dsize D) ==> (D(SUC n) - D(n)) < g(p(n))`;; (* ------------------------------------------------------------------------ *) (* Riemann sum *) (* ------------------------------------------------------------------------ *) let rsum = new_definition `rsum (D,(p:num->real)) f = sum(0,dsize(D))(\n. f(p n) * (D(SUC n) - D(n)))`;; (* ------------------------------------------------------------------------ *) (* Gauge integrability (definite) *) (* ------------------------------------------------------------------------ *) let defint = new_definition `defint(a,b) f k <=> !e. &0 < e ==> ?g. gauge(\x. a <= x /\ x <= b) g /\ !D p. tdiv(a,b) (D,p) /\ fine(g)(D,p) ==> abs(rsum(D,p) f - k) < e`;; (* ------------------------------------------------------------------------ *) (* Useful lemmas about the size of `trivial` divisions etc. *) (* ------------------------------------------------------------------------ *) let DIVISION_0 = prove( `!a b. (a = b) ==> (dsize(\n. if (n = 0) then a else b) = 0)`, REPEAT GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[COND_ID] THEN REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `n:num` THEN BETA_TAC THEN REWRITE_TAC[REAL_LT_REFL; NOT_LT] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[CONJUNCT1 LE]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LE_0]]);; let DIVISION_1 = prove( `!a b. a < b ==> (dsize(\n. if (n = 0) then a else b) = 1)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `n:num` THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN EQ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN CONJ_TAC THENL [POP_ASSUM(MP_TAC o SPEC `1` o CONJUNCT1) THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[REAL_LT_REFL; NOT_LT]; POP_ASSUM(MP_TAC o SPEC `2` o CONJUNCT2) THEN REWRITE_TAC[num_CONV `2`; GE] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[num_CONV `1`; NOT_SUC_LESS_EQ; CONJUNCT1 LE] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_SUC; NOT_IMP] THEN REWRITE_TAC[LE_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC]; DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL [GEN_TAC THEN REWRITE_TAC[num_CONV `1`; CONJUNCT2 LT; NOT_LESS_0] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; num_CONV `1`] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[CONJUNCT1 LE; GSYM NOT_SUC; NOT_SUC]]]);; let DIVISION_SINGLE = prove( `!a b. a <= b ==> division(a,b)(\n. if (n = 0) then a else b)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[division] THEN BETA_TAC THEN REWRITE_TAC[] THEN POP_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [EXISTS_TAC `1` THEN CONJ_TAC THEN X_GEN_TAC `n:num` THENL [REWRITE_TAC[LESS_1] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[NOT_SUC]; REWRITE_TAC[GE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[GSYM NOT_LT; LESS_SUC_REFL]]; EXISTS_TAC `0` THEN REWRITE_TAC[NOT_LESS_0] THEN ASM_REWRITE_TAC[COND_ID]]);; let DIVISION_LHS = prove( `!D a b. division(a,b) D ==> (D(0) = a)`, REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; let DIVISION_THM = prove( `!D a b. division(a,b) D <=> (D(0) = a) /\ (!n. n < (dsize D) ==> D(n) < D(SUC n)) /\ (!n. n >= (dsize D) ==> (D(n) = b))`, REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; EXISTS_TAC `dsize D` THEN ASM_REWRITE_TAC[]] THEN POP_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o CONJUNCT2) THEN SUBGOAL_THEN `dsize D = N` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `M:num` THEN BETA_TAC THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `N:num` (ASSUME `!n:num. n >= N ==> (D n :real = b)`)) THEN DISCH_THEN(MP_TAC o REWRITE_RULE[GE; LE_REFL]) THEN DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`M:num`; `N:num`] LESS_LESS_CASES) THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(MP_TAC o SPEC `SUC M` o CONJUNCT2) THEN REWRITE_TAC[GE; LESS_EQ_SUC_REFL] THEN DISCH_TAC THEN UNDISCH_TAC `!n. n < N ==> (D n) < (D(SUC n))` THEN DISCH_THEN(MP_TAC o SPEC `M:num`) THEN ASM_REWRITE_TAC[REAL_LT_REFL]; DISCH_THEN(MP_TAC o SPEC `N:num` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `!n:num. n >= N ==> (D n :real = b)` THEN DISCH_THEN(fun th -> MP_TAC(SPEC `N:num` th) THEN MP_TAC(SPEC `SUC N` th)) THEN REWRITE_TAC[GE; LESS_EQ_SUC_REFL; LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]);; let DIVISION_RHS = prove( `!D a b. division(a,b) D ==> (D(dsize D) = b)`, REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN DISCH_THEN(MP_TAC o SPEC `dsize D` o last o CONJUNCTS) THEN REWRITE_TAC[GE; LE_REFL]);; let DIVISION_LT_GEN = prove( `!D a b m n. division(a,b) D /\ m < n /\ n <= (dsize D) ==> D(m) < D(n)`, REPEAT STRIP_TAC THEN UNDISCH_TAC `m:num < n` THEN DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `(m + (SUC d)) <= (dsize D)` THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN RULE_ASSUM_TAC(REWRITE_RULE[DIVISION_THM]) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `D(m + (SUC d)):real` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[ADD_CLAUSES] THEN FIRST_ASSUM(MATCH_MP_TAC o el 1 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN ASM_REWRITE_TAC[]]]);; let DIVISION_LT = prove( `!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(0) < D(SUC n)`, REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN INDUCT_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `D(SUC n):real` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `D(0):real = a` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]);; let DIVISION_LE = prove( `!D a b. division(a,b) D ==> a <= b`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN UNDISCH_TAC `D(0):real = a` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN UNDISCH_TAC `!n. n >= (dsize D) ==> (D n = b)` THEN DISCH_THEN(MP_TAC o SPEC `dsize D`) THEN REWRITE_TAC[GE; LE_REFL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(MP_TAC o SPEC `PRE(dsize D)`) THEN STRUCT_CASES_TAC(SPEC `dsize D` num_CASES) THEN ASM_REWRITE_TAC[PRE; REAL_LE_REFL; LESS_SUC_REFL; REAL_LT_IMP_LE]);; let DIVISION_GT = prove( `!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(n) < D(dsize D)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_LT_GEN THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[LE_REFL]);; let DIVISION_EQ = prove( `!D a b. division(a,b) D ==> ((a = b) <=> (dsize D = 0))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN UNDISCH_TAC `D(0):real = a` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN UNDISCH_TAC `!n. n >= (dsize D) ==> (D n = b)` THEN DISCH_THEN(MP_TAC o SPEC `dsize D`) THEN REWRITE_TAC[GE; LE_REFL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(MP_TAC o SPEC `PRE(dsize D)`) THEN STRUCT_CASES_TAC(SPEC `dsize D` num_CASES) THEN ASM_REWRITE_TAC[PRE; NOT_SUC; LESS_SUC_REFL; REAL_LT_IMP_NE]);; let DIVISION_LBOUND = prove( `!D a b r. division(a,b) D ==> a <= D(r)`, REWRITE_TAC[DIVISION_THM; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN DISJ_CASES_TAC(SPECL [`SUC r`; `dsize D`] LTE_CASES) THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(D:num->real) r` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC r` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b:real` THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_LE THEN EXISTS_TAC `D:num->real` THEN ASM_REWRITE_TAC[DIVISION_THM]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE]]]);; let DIVISION_LBOUND_LT = prove( `!D a b n. division(a,b) D /\ ~(dsize D = 0) ==> a < D(SUC n)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_LHS) THEN DISJ_CASES_TAC(SPECL [`dsize D`; `SUC n`] LTE_CASES) THENL [FIRST_ASSUM(MP_TAC o el 2 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[GE] THEN IMP_RES_THEN ASSUME_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN ASM_REWRITE_TAC[GSYM NOT_LE; CONJUNCT1 LE]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_LT) THEN MATCH_MP_TAC OR_LESS THEN ASM_REWRITE_TAC[]]);; let DIVISION_UBOUND = prove( `!D a b r. division(a,b) D ==> D(r) <= b`, REWRITE_TAC[DIVISION_THM] THEN REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPECL [`r:num`; `dsize D`] LTE_CASES) THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE]] THEN SUBGOAL_THEN `!r. D((dsize D) - r) <= b` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `(dsize D) - r`) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUB_SUB (MATCH_MP LT_IMP_LE th)]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]] THEN UNDISCH_TAC `r < (dsize D)` THEN DISCH_THEN(K ALL_TAC) THEN INDUCT_TAC THENL [REWRITE_TAC[SUB_0] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; LE_REFL]; ALL_TAC] THEN DISJ_CASES_TAC(SPECL [`r:num`; `dsize D`] LTE_CASES) THENL [ALL_TAC; SUBGOAL_THEN `(dsize D) - (SUC r) = 0` SUBST1_TAC THENL [REWRITE_TAC[SUB_EQ_0] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LE THEN EXISTS_TAC `D:num->real` THEN ASM_REWRITE_TAC[DIVISION_THM]]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `D((dsize D) - r):real` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(dsize D) - r = SUC((dsize D) - (SUC r))` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LESS_CASES_IMP THEN REWRITE_TAC[NOT_LT; LE_LT; SUB_LESS_EQ] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN REWRITE_TAC[SUB_EQ_EQ_0; NOT_SUC] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `r < 0` THEN REWRITE_TAC[NOT_LESS_0]] THEN MP_TAC(SPECL [`dsize D`; `SUC r`] (CONJUNCT2 SUB_OLD)) THEN COND_CASES_TAC THENL [REWRITE_TAC[SUB_EQ_0; LE_SUC] THEN ASM_REWRITE_TAC[GSYM NOT_LT]; DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[SUB_SUC]]);; let DIVISION_UBOUND_LT = prove( `!D a b n. division(a,b) D /\ n < dsize D ==> D(n) < b`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------ *) (* Divisions of adjacent intervals can be combined into one *) (* ------------------------------------------------------------------------ *) let DIVISION_APPEND_LEMMA1 = prove( `!a b c D1 D2. division(a,b) D1 /\ division(b,c) D2 ==> (!n. n < ((dsize D1) + (dsize D2)) ==> (\n. if (n < (dsize D1)) then D1(n) else D2(n - (dsize D1)))(n) < (\n. if (n < (dsize D1)) then D1(n) else D2(n - (dsize D1)))(SUC n)) /\ (!n. n >= ((dsize D1) + (dsize D2)) ==> ((\n. if (n < (dsize D1)) then D1(n) else D2(n - (dsize D1)))(n) = (\n. if (n < (dsize D1)) then D1(n) else D2(n - (dsize D1)))((dsize D1) + (dsize D2))))`, REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THENL [ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; UNDISCH_TAC `division(a,b) D1` THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]; ASM_CASES_TAC `n < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL [RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC DIVISION_LBOUND THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]]; UNDISCH_TAC `~(n < (dsize D1))` THEN REWRITE_TAC[NOT_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[SUB_OLD; GSYM NOT_LE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN FIRST_ASSUM(MATCH_MP_TAC o el 1 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN UNDISCH_TAC `((dsize D1) + d) < ((dsize D1) + (dsize D2))` THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LT_ADD_RCANCEL]]]; REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[NOT_LE] THEN COND_CASES_TAC THEN UNDISCH_TAC `n >= ((dsize D1) + (dsize D2))` THENL [CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN REWRITE_TAC[GE; NOT_LE] THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `dsize D1` THEN ASM_REWRITE_TAC[LE_ADD]; REWRITE_TAC[GE; LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN FIRST_ASSUM(CHANGED_TAC o (SUBST1_TAC o MATCH_MP DIVISION_RHS)) THEN FIRST_ASSUM(MATCH_MP_TAC o el 2 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN REWRITE_TAC[GE; LE_ADD]]]);; let DIVISION_APPEND_LEMMA2 = prove( `!a b c D1 D2. division(a,b) D1 /\ division(b,c) D2 ==> (dsize(\n. if (n < (dsize D1)) then D1(n) else D2(n - (dsize D1))) = dsize(D1) + dsize(D2))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `N:num` THEN BETA_TAC THEN EQ_TAC THENL [DISCH_THEN((then_) (MATCH_MP_TAC LESS_EQUAL_ANTISYM) o MP_TAC) THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM; NOT_LE] THEN DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC THEN DISCH_THEN(MP_TAC o SPEC `dsize(D1) + dsize(D2)`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN SUBGOAL_THEN `!x y. x <= SUC(x + y)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `x + y:num` THEN REWRITE_TAC[LE_ADD; LESS_EQ_SUC_REFL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUB_OLD; GSYM NOT_LE] THEN REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN MP_TAC(ASSUME `division(b,c) D2`) THEN REWRITE_TAC[DIVISION_THM] THEN DISCH_THEN(MP_TAC o SPEC `SUC(dsize D2)` o el 2 o CONJUNCTS) THEN REWRITE_TAC[GE; LESS_EQ_SUC_REFL] THEN DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN REWRITE_TAC[REAL_LT_REFL]; DISJ2_TAC THEN DISCH_THEN(MP_TAC o SPEC `dsize(D1) + dsize(D2)`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LT_IMP_LE) THEN ASM_REWRITE_TAC[GE] THEN REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN COND_CASES_TAC THENL [SUBGOAL_THEN `D1(N:num) < D2(dsize D2)` MP_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[GSYM NOT_LE]; MATCH_MP_TAC DIVISION_LBOUND THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]]; CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]; RULE_ASSUM_TAC(REWRITE_RULE[]) THEN SUBGOAL_THEN `D2(N - (dsize D1)) < D2(dsize D2)` MP_TAC THENL [MATCH_MP_TAC DIVISION_LT_GEN THEN MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN ASM_REWRITE_TAC[LE_REFL] THEN REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[SUB_LEFT_LESS_EQ; DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[NOT_LE] THEN UNDISCH_TAC `dsize(D1) <= N` THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN RULE_ASSUM_TAC(REWRITE_RULE[LT_ADD_RCANCEL]) THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `d:num` THEN ASM_REWRITE_TAC[LE_0]; CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]]]; DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_CASES_TAC `(SUC n) < (dsize(D1))` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `n < (dsize(D1))` ASSUME_TAC THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LT_GEN THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[LESS_SUC_REFL] THEN MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; COND_CASES_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; FIRST_ASSUM(MATCH_ACCEPT_TAC o MATCH_MP DIVISION_LBOUND)]; MATCH_MP_TAC DIVISION_LT_GEN THEN MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUB_OLD; LESS_SUC_REFL]; ALL_TAC] THEN REWRITE_TAC[REWRITE_RULE[GE] SUB_LEFT_GREATER_EQ] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[LE_SUC_LT]]]; X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN SUBGOAL_THEN `(dsize D1) <= n` ASSUME_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dsize D1 + dsize D2` THEN ASM_REWRITE_TAC[LE_ADD]; ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN FIRST_ASSUM(MATCH_MP_TAC o el 2 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN REWRITE_TAC[GE; SUB_LEFT_LESS_EQ] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]]]]);; let DIVISION_APPEND_EXPLICIT = prove (`!a b c g d1 p1 d2 p2. tdiv(a,b) (d1,p1) /\ fine g (d1,p1) /\ tdiv(b,c) (d2,p2) /\ fine g (d2,p2) ==> tdiv(a,c) ((\n. if n < dsize d1 then d1(n) else d2(n - (dsize d1))), (\n. if n < dsize d1 then p1(n) else p2(n - (dsize d1)))) /\ fine g ((\n. if n < dsize d1 then d1(n) else d2(n - (dsize d1))), (\n. if n < dsize d1 then p1(n) else p2(n - (dsize d1)))) /\ !f. rsum((\n. if n < dsize d1 then d1(n) else d2(n - (dsize d1))), (\n. if n < dsize d1 then p1(n) else p2(n - (dsize d1)))) f = rsum(d1,p1) f + rsum(d2,p2) f`, MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`; `g:real->real`; `D1:num->real`; `p1:num->real`; `D2:num->real`; `p2:num->real`] THEN STRIP_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN REWRITE_TAC[rsum] THEN MP_TAC(SPECL [`a:real`; `b:real`; `c:real`; `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN ANTS_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN REWRITE_TAC[SUM_REINDEX] THEN BINOP_TAC THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[ADD_CLAUSES; ARITH_RULE `~(r + d < d:num)`; ARITH_RULE `~(SUC(r + d) < d)`; ADD_SUB; ARITH_RULE `SUC(r + d) - d = SUC r`] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[ARITH_RULE `k < n ==> (SUC k < n <=> ~(n = SUC k))`] THEN ASM_CASES_TAC `dsize D1 = SUC k` THEN ASM_REWRITE_TAC[SUB_REFL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[tdiv; DIVISION_LHS; DIVISION_RHS]] THEN DISJ_CASES_TAC(GSYM (SPEC `dsize(D1)` LESS_0_CASES)) THENL [ASM_REWRITE_TAC[NOT_LESS_0; SUB_0] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN SUBGOAL_THEN `a:real = b` (fun th -> ASM_REWRITE_TAC[th]) THEN MP_TAC(SPECL [`D1:num->real`; `a:real`; `b:real`] DIVISION_EQ) THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[fine] THEN X_GEN_TAC `n:num` THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN MP_TAC(SPECL [`a:real`; `b:real`; `c:real`; `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `n < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `SUC n = dsize D1` ASSUME_TAC THENL [MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN ASM_REWRITE_TAC[GSYM NOT_LT] THEN REWRITE_TAC[NOT_LT] THEN MATCH_MP_TAC LESS_OR THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[SUB_REFL] THEN FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o CONJUNCT1) THEN FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS o CONJUNCT1) THEN SUBST1_TAC(SYM(ASSUME `SUC n = dsize D1`)) THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN ASM_REWRITE_TAC[]]; ASM_REWRITE_TAC[SUB_OLD] THEN UNDISCH_TAC `~(n < (dsize D1))` THEN REWRITE_TAC[LE_EXISTS; NOT_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN RULE_ASSUM_TAC(REWRITE_RULE[LT_ADD_RCANCEL]) THEN FIRST_ASSUM ACCEPT_TAC]] THEN REWRITE_TAC[tdiv] THEN BETA_TAC THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN REWRITE_TAC[DIVISION_THM] THEN CONJ_TAC THENL [BETA_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LHS THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `c = (\n. if (n < (dsize D1)) then D1(n) else D2(n - (dsize D1))) (dsize(D1) + dsize(D2))` SUBST1_TAC THENL [BETA_TAC THEN REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIVISION_RHS THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(SPECL [`a:real`; `b:real`; `c:real`; `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC (BETA_RULE DIVISION_APPEND_LEMMA1) THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`; `c:real`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[SUB_OLD] THEN FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o CONJUNCT1) THEN FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS o CONJUNCT1) THEN SUBGOAL_THEN `dsize D1 = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN ASM_REWRITE_TAC[GSYM NOT_LT] THEN REWRITE_TAC[NOT_LT] THEN MATCH_MP_TAC LESS_OR THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[SUB_OLD]]);; let DIVISION_APPEND_STRONG = prove (`!a b c D1 p1 D2 p2. tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1) /\ tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2) ==> ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p) /\ !f. rsum(D,p) f = rsum(D1,p1) f + rsum(D2,p2) f`, REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`\n. if n < dsize D1 then D1(n):real else D2(n - (dsize D1))`; `\n. if n < dsize D1 then p1(n):real else p2(n - (dsize D1))`] THEN MATCH_MP_TAC DIVISION_APPEND_EXPLICIT THEN ASM_MESON_TAC[]);; let DIVISION_APPEND = prove( `!a b c. (?D1 p1. tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1)) /\ (?D2 p2. tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2)) ==> ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p)`, MESON_TAC[DIVISION_APPEND_STRONG]);; (* ------------------------------------------------------------------------ *) (* We can always find a division which is fine wrt any gauge *) (* ------------------------------------------------------------------------ *) let DIVISION_EXISTS = prove( `!a b g. a <= b /\ gauge(\x. a <= x /\ x <= b) g ==> ?D p. tdiv(a,b) (D,p) /\ fine(g) (D,p)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN (MP_TAC o C SPEC BOLZANO_LEMMA) `\(u,v). a <= u /\ v <= b ==> ?D p. tdiv(u,v) (D,p) /\ fine(g) (D,p)` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC; DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN REWRITE_TAC[REAL_LE_REFL]] THENL [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_APPEND THEN EXISTS_TAC `v:real` THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `w:real`; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `u:real`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL [ALL_TAC; EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN MAP_EVERY X_GEN_TAC [`w:real`; `y:real`] THEN STRIP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC THEN MATCH_MP_TAC REAL_LET_TRANS; DISJ2_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN UNDISCH_TAC `gauge(\x. a <= x /\ x <= b) g` THEN REWRITE_TAC[gauge] THEN BETA_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o MATCH_MP th)) THEN EXISTS_TAC `(g:real->real) x` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`w:real`; `y:real`] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `\n. if (n = 0) then (w:real) else y` THEN EXISTS_TAC `\n. if (n = 0) then (x:real) else y` THEN SUBGOAL_THEN `w <= y` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[tdiv] THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_SINGLE THEN FIRST_ASSUM ACCEPT_TAC; X_GEN_TAC `n:num` THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]]; REWRITE_TAC[fine] THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN X_GEN_TAC `n:num` THEN DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `w <= y`)) THENL [DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_1) THEN ASM_REWRITE_TAC[num_CONV `1`; CONJUNCT2 LT; NOT_LESS_0] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(SUBST1_TAC o MATCH_MP DIVISION_0) THEN REWRITE_TAC[NOT_LESS_0]]]);; (* ------------------------------------------------------------------------ *) (* Lemmas about combining gauges *) (* ------------------------------------------------------------------------ *) let GAUGE_MIN = prove( `!E g1 g2. gauge(E) g1 /\ gauge(E) g2 ==> gauge(E) (\x. if g1(x) < g2(x) then g1(x) else g2(x))`, REPEAT GEN_TAC THEN REWRITE_TAC[gauge] THEN STRIP_TAC THEN X_GEN_TAC `x:real` THEN BETA_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; let FINE_MIN = prove( `!g1 g2 D p. fine (\x. if g1(x) < g2(x) then g1(x) else g2(x)) (D,p) ==> fine(g1) (D,p) /\ fine(g2) (D,p)`, REPEAT GEN_TAC THEN REWRITE_TAC[fine] THEN BETA_TAC THEN DISCH_TAC THEN CONJ_TAC THEN X_GEN_TAC `n:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN MATCH_MP_TAC REAL_LTE_TRANS; MATCH_MP_TAC REAL_LT_TRANS] THEN FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN ASM_REWRITE_TAC[] THEN NO_TAC));; (* ------------------------------------------------------------------------ *) (* The integral is unique if it exists *) (* ------------------------------------------------------------------------ *) let DINT_UNIQ = prove( `!a b f k1 k2. a <= b /\ defint(a,b) f k1 /\ defint(a,b) f k2 ==> (k1 = k2)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_0] THEN CONV_TAC CONTRAPOS_CONV THEN ONCE_REWRITE_TAC[ABS_NZ] THEN DISCH_TAC THEN REWRITE_TAC[defint] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `abs(k1 - k2) / &2`)) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`\x. a <= x /\ x <= b`; `g1:real->real`; `g2:real->real`] GAUGE_MIN) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(SPECL [`a:real`; `b:real`; `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`] DIVISION_EXISTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `D:num->real` (X_CHOOSE_THEN `p:num->real` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FINE_MIN) THEN REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPECL [`D:num->real`; `p:num->real`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN SUBGOAL_THEN `abs((rsum(D,p) f - k2) - (rsum(D,p) f - k1)) < abs(k1 - k2)` MP_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(rsum(D,p) f - k2) + abs(rsum(D,p) f - k1)` THEN CONJ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_sub] THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM ABS_NEG] THEN MATCH_ACCEPT_TAC ABS_TRIANGLE; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEG_SUB] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (d + a) + (c + b)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID; REAL_LT_REFL]]);; (* ------------------------------------------------------------------------ *) (* Integral over a null interval is 0 *) (* ------------------------------------------------------------------------ *) let INTEGRAL_NULL = prove( `!f a. defint(a,a) f (&0)`, REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `\x:real. &1` THEN REWRITE_TAC[gauge; REAL_LT_01] THEN REPEAT GEN_TAC THEN REWRITE_TAC[tdiv] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_EQ) THEN REWRITE_TAC[rsum] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[sum; REAL_SUB_REFL; ABS_0]);; (* ------------------------------------------------------------------------ *) (* Fundamental theorem of calculus (Part I) *) (* ------------------------------------------------------------------------ *) let STRADDLE_LEMMA = prove( `!f f' a b e. (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ &0 < e ==> ?g. gauge(\x. a <= x /\ x <= b) g /\ !x u v. a <= u /\ u <= x /\ x <= v /\ v <= b /\ (v - u) < g(x) ==> abs((f(v) - f(u)) - (f'(x) * (v - u))) <= e * (v - u)`, REPEAT STRIP_TAC THEN REWRITE_TAC[gauge] THEN BETA_TAC THEN SUBGOAL_THEN `!x. a <= x /\ x <= b ==> ?d. &0 < d /\ !u v. u <= x /\ x <= v /\ (v - u) < d ==> abs((f(v) - f(u)) - (f'(x) * (v - u))) <= e * (v - u)` MP_TAC THENL [ALL_TAC; FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o CONV_RULE ((ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) THENC OLD_SKOLEM_CONV)) THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `g:real->real` THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]); REPEAT STRIP_TAC THEN C SUBGOAL_THEN (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) `a <= x /\ x <= b` THENL [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN ASM_REWRITE_TAC[]; DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[]]]] THEN X_GEN_TAC `x:real` THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN REWRITE_TAC[diffl; LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!z. abs(z - x) < d ==> abs((f(z) - f(x)) - (f'(x) * (z - x))) <= (e / &2) * abs(z - x)` ASSUME_TAC THENL [GEN_TAC THEN ASM_CASES_TAC `&0 < abs(z - x)` THENL [ALL_TAC; UNDISCH_TAC `~(&0 < abs(z - x))` THEN REWRITE_TAC[GSYM ABS_NZ; REAL_SUB_0] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; ABS_0; REAL_LE_REFL]] THEN DISCH_THEN(MP_TAC o CONJ (ASSUME `&0 < abs(z - x)`)) THEN DISCH_THEN((then_) (MATCH_MP_TAC REAL_LT_IMP_LE) o MP_TAC) THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM ABS_MUL] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_SUB_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_SUB_ADD2] THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[ABS_NZ]; ALL_TAC] THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `u <= v` (DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; ALL_TAC; ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; ABS_0; REAL_LE_REFL]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((f(v) - f(x)) - (f'(x) * (v - x))) + abs((f(x) - f(u)) - (f'(x) * (x - u)))` THEN CONJ_TAC THENL [MP_TAC(SPECL[`(f(v) - f(x)) - (f'(x) * (v - x))`; `(f(x) - f(u)) - (f'(x) * (x - u))`] ABS_TRIANGLE) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_ADD2_SUB2] THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN SUBGOAL_THEN `!a b c. (a - b) + (b - c) = (a - c)` (fun th -> REWRITE_TAC[th]) THEN REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (b + c) + (a + d)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(e / &2) * abs(v - x)` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub; REAL_LE_LADD] THEN ASM_REWRITE_TAC[REAL_LE_NEG]; ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; MATCH_MP REAL_LE_LMUL_LOCAL (ASSUME `&0 < e`)] THEN SUBGOAL_THEN `!x y. (x * inv(&2)) <= (y * inv(&2)) <=> x <= y` (fun th -> ASM_REWRITE_TAC[th; real_sub; REAL_LE_LADD; REAL_LE_NEG]) THEN REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(e / &2) * abs(x - u)` THEN CONJ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_sub] THEN ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_NEG_SUB] THEN ONCE_REWRITE_TAC[REAL_NEG_RMUL] THEN REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[GSYM real_sub] THEN FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[real_sub; REAL_LE_RADD]; ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; MATCH_MP REAL_LE_LMUL_LOCAL (ASSUME `&0 < e`)] THEN SUBGOAL_THEN `!x y. (x * inv(&2)) <= (y * inv(&2)) <=> x <= y` (fun th -> ASM_REWRITE_TAC[th; real_sub; REAL_LE_RADD; REAL_LE_NEG]) THEN REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]]]);; let FTC1 = prove( `!f f' a b. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) ==> defint(a,b) f' (f(b) - f(a))`, REPEAT STRIP_TAC THEN UNDISCH_TAC `a <= b` THEN REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN DISJ_CASES_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_SUB_REFL; INTEGRAL_NULL]] THEN REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `!e. &0 < e ==> ?g. gauge(\x. a <= x /\ x <= b)g /\ (!D p. tdiv(a,b)(D,p) /\ fine g(D,p) ==> (abs((rsum(D,p)f') - ((f b) - (f a)))) <= e)` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `g:real->real` THEN ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2]] THEN UNDISCH_TAC `&0 < e` THEN DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPECL [`f:real->real`; `f':real->real`; `a:real`; `b:real`; `e / (b - a)`] STRADDLE_LEMMA) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 < e / (b - a)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[REAL_SUB_LT]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `g:real->real` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`D:num->real`; `p:num->real`] THEN REWRITE_TAC[tdiv] THEN STRIP_TAC THEN REWRITE_TAC[rsum] THEN SUBGOAL_THEN `f(b) - f(a) = sum(0,dsize D)(\n. f(D(SUC n)) - f(D(n)))` SUBST1_TAC THENL [MP_TAC(SPECL [`\n:num. (f:real->real)(D(n))`; `0`; `dsize D`] SUM_CANCEL) THEN BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS; DIVISION_RHS] THEN REFL_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN REWRITE_TAC[GSYM SUM_SUB] THEN BETA_TAC THEN LE_MATCH_TAC ABS_SUM THEN BETA_TAC THEN SUBGOAL_THEN `e = sum(0,dsize D)(\n. (e / (b - a)) * (D(SUC n) - D(n)))` SUBST1_TAC THENL [ONCE_REWRITE_TAC[SYM(BETA_CONV `(\n. (D(SUC n) - D(n))) n`)] THEN ASM_REWRITE_TAC[SUM_CMUL; SUM_CANCEL; ADD_CLAUSES] THEN MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS; DIVISION_RHS] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [IMP_RES_THEN (fun th -> REWRITE_TAC[th]) DIVISION_LBOUND; IMP_RES_THEN (fun th -> REWRITE_TAC[th]) DIVISION_UBOUND; UNDISCH_TAC `fine(g)(D,p)` THEN REWRITE_TAC[fine] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; (* ------------------------------------------------------------------------- *) (* Definition of integral and integrability. *) (* ------------------------------------------------------------------------- *) let integrable = new_definition `integrable(a,b) f = ?i. defint(a,b) f i`;; let integral = new_definition `integral(a,b) f = @i. defint(a,b) f i`;; let INTEGRABLE_DEFINT = prove (`!f a b. integrable(a,b) f ==> defint(a,b) f (integral(a,b) f)`, REPEAT GEN_TAC THEN REWRITE_TAC[integrable; integral] THEN CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Other more or less trivial lemmas. *) (* ------------------------------------------------------------------------- *) let DIVISION_BOUNDS = prove (`!d a b. division(a,b) d ==> !n. a <= d(n) /\ d(n) <= b`, MESON_TAC[DIVISION_UBOUND; DIVISION_LBOUND]);; let TDIV_BOUNDS = prove (`!d p a b. tdiv(a,b) (d,p) ==> !n. a <= d(n) /\ d(n) <= b /\ a <= p(n) /\ p(n) <= b`, REWRITE_TAC[tdiv] THEN ASM_MESON_TAC[DIVISION_BOUNDS; REAL_LE_TRANS]);; let TDIV_LE = prove (`!d p a b. tdiv(a,b) (d,p) ==> a <= b`, MESON_TAC[tdiv; DIVISION_LE]);; let DEFINT_WRONG = prove (`!a b f i. b < a ==> defint(a,b) f i`, REWRITE_TAC[defint; gauge] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real. &0` THEN ASM_SIMP_TAC[REAL_ARITH `b < a ==> (a <= x /\ x <= b <=> F)`] THEN ASM_MESON_TAC[REAL_NOT_LE; TDIV_LE]);; let DEFINT_INTEGRAL = prove (`!f a b i. a <= b /\ defint(a,b) f i ==> integral(a,b) f = i`, REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[DINT_UNIQ]);; (* ------------------------------------------------------------------------- *) (* Linearity. *) (* ------------------------------------------------------------------------- *) let DEFINT_CONST = prove (`!a b c. defint(a,b) (\x. c) (c * (b - a))`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`\x. c * x`; `\x:real. c:real`; `a:real`; `b:real`] FTC1) THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN ASM_SIMP_TAC[DEFINT_WRONG; REAL_SUB_LDISTRIB] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` (DIFF_CONV `\x. c * x`)) THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; REAL_ADD_LID]);; let DEFINT_0 = prove (`!a b. defint(a,b) (\x. &0) (&0)`, MP_TAC DEFINT_CONST THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[REAL_MUL_LZERO]);; let DEFINT_NEG = prove (`!f a b i. defint(a,b) f i ==> defint(a,b) (\x. --f x) (--i)`, REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN REWRITE_TAC[rsum; REAL_MUL_LNEG; SUM_NEG] THEN REWRITE_TAC[REAL_ARITH `abs(--x - --y) = abs(x - y)`]);; let DEFINT_CMUL = prove (`!f a b c i. defint(a,b) f i ==> defint(a,b) (\x. c * f x) (c * i)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] DEFINT_CONST) THEN ASM_SIMP_TAC[REAL_MUL_LZERO]; ALL_TAC] THEN REWRITE_TAC[defint] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / abs c`) THEN ASM_SIMP_TAC[REAL_LT_DIV; GSYM REAL_ABS_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[rsum; SUM_CMUL; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_SYM]);; let DEFINT_ADD = prove (`!f g a b i j. defint(a,b) f i /\ defint(a,b) g j ==> defint(a,b) (\x. f x + g x) (i + j)`, REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`)) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)` THEN ASM_SIMP_TAC[GAUGE_MIN; rsum] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD] THEN REWRITE_TAC[GSYM rsum] THEN MATCH_MP_TAC(REAL_ARITH `abs(x - i) < e / &2 /\ abs(y - j) < e / &2 ==> abs((x + y) - (i + j)) < e`) THEN ASM_MESON_TAC[FINE_MIN]);; let DEFINT_SUB = prove (`!f g a b i j. defint(a,b) f i /\ defint(a,b) g j ==> defint(a,b) (\x. f x - g x) (i - j)`, SIMP_TAC[real_sub; DEFINT_ADD; DEFINT_NEG]);; (* ------------------------------------------------------------------------- *) (* Ordering properties of integral. *) (* ------------------------------------------------------------------------- *) let INTEGRAL_LE = prove (`!f g a b i j. a <= b /\ integrable(a,b) f /\ integrable(a,b) g /\ (!x. a <= x /\ x <= b ==> f(x) <= g(x)) ==> integral(a,b) f <= integral(a,b) g`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP INTEGRABLE_DEFINT)) THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < x - y) ==> x <= y`) THEN ABBREV_TAC `e = integral(a,b) f - integral(a,b) g` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `e / &2` o GEN_REWRITE_RULE I [defint])) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &2 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`a:real`; `b:real`; `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`] DIVISION_EXISTS) THEN ASM_SIMP_TAC[GAUGE_MIN; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`D:num->real`; `p:num->real`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`D:num->real`; `p:num->real`])) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`D:num->real`; `p:num->real`])) THEN FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FINE_MIN th]) THEN MATCH_MP_TAC(REAL_ARITH `ih - ig = e /\ &0 < e /\ sh <= sg ==> abs(sg - ig) < e / &2 ==> ~(abs(sh - ih) < e / &2)`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[rsum] THEN MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_SUB_LE] THEN ASM_MESON_TAC[TDIV_BOUNDS; REAL_LT_IMP_LE; DIVISION_THM; tdiv]);; let DEFINT_LE = prove (`!f g a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) g j /\ (!x. a <= x /\ x <= b ==> f(x) <= g(x)) ==> i <= j`, REPEAT GEN_TAC THEN MP_TAC(SPEC_ALL INTEGRAL_LE) THEN MESON_TAC[integrable; DEFINT_INTEGRAL]);; let DEFINT_TRIANGLE = prove (`!f a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) (\x. abs(f x)) j ==> abs(i) <= j`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `--a <= b /\ b <= a ==> abs(b) <= a`) THEN CONJ_TAC THEN MATCH_MP_TAC DEFINT_LE THENL [MAP_EVERY EXISTS_TAC [`\x:real. --abs(f x)`; `f:real->real`]; MAP_EVERY EXISTS_TAC [`f:real->real`; `\x:real. abs(f x)`]] THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_SIMP_TAC[DEFINT_NEG] THEN REAL_ARITH_TAC);; let DEFINT_EQ = prove (`!f g a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) g j /\ (!x. a <= x /\ x <= b ==> f(x) = g(x)) ==> i = j`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[DEFINT_LE]);; let INTEGRAL_EQ = prove (`!f g a b i. defint(a,b) f i /\ (!x. a <= x /\ x <= b ==> f(x) = g(x)) ==> defint(a,b) g i`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [defint]) THEN REWRITE_TAC[defint] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real->real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `D:num->real` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:num->real` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN REWRITE_TAC[rsum] THEN MATCH_MP_TAC SUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[tdiv; DIVISION_LBOUND; DIVISION_UBOUND; DIVISION_THM; REAL_LE_TRANS]);; (* ------------------------------------------------------------------------- *) (* Integration by parts. *) (* ------------------------------------------------------------------------- *) let INTEGRATION_BY_PARTS = prove (`!f g f' g' a b. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ (!x. a <= x /\ x <= b ==> (g diffl g'(x))(x)) ==> defint(a,b) (\x. f'(x) * g(x) + f(x) * g'(x)) (f(b) * g(b) - f(a) * g(a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FTC1 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `a + b * c = a + c * b`] THEN ASM_SIMP_TAC[DIFF_MUL]);; (* ------------------------------------------------------------------------- *) (* Various simple lemmas about divisions. *) (* ------------------------------------------------------------------------- *) let DIVISION_LE_SUC = prove (`!d a b. division(a,b) d ==> !n. d(n) <= d(SUC n)`, REWRITE_TAC[DIVISION_THM; GE] THEN MESON_TAC[LET_CASES; LE; REAL_LE_REFL; REAL_LT_IMP_LE]);; let DIVISION_MONO_LE = prove (`!d a b. division(a,b) d ==> !m n. m <= n ==> d(m) <= d(n)`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_LE_SUC) THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN ASM_MESON_TAC[REAL_LE_TRANS]);; let DIVISION_MONO_LE_SUC = prove (`!d a b. division(a,b) d ==> !n. d(n) <= d(SUC n)`, MESON_TAC[DIVISION_MONO_LE; LE; LE_REFL]);; let DIVISION_INTERMEDIATE = prove (`!d a b c. division(a,b) d /\ a <= c /\ c <= b ==> ?n. n <= dsize d /\ d(n) <= c /\ c <= d(SUC n)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\n. n <= dsize d /\ (d:num->real)(n) <= c` num_MAX) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[LE_0; DIVISION_THM]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN SIMP_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; LE_SUC_LT; LT_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN DISCH_THEN(MP_TAC o SPEC `SUC(dsize d)` o repeat CONJUNCT2) THEN REWRITE_TAC[GE; LE; LE_REFL] THEN ASM_REAL_ARITH_TAC);; let DIVISION_DSIZE_LE = prove (`!a b d n. division(a,b) d /\ d(SUC n) = d(n) ==> dsize d <= n`, REWRITE_TAC[DIVISION_THM] THEN MESON_TAC[REAL_LT_REFL; NOT_LT]);; let DIVISION_DSIZE_GE = prove (`!a b d n. division(a,b) d /\ d(n) < d(SUC n) ==> SUC n <= dsize d`, REWRITE_TAC[DIVISION_THM; LE_SUC_LT; GE] THEN MESON_TAC[REAL_LT_REFL; LE; NOT_LT]);; let DIVISION_DSIZE_EQ = prove (`!a b d n. division(a,b) d /\ d(n) < d(SUC n) /\ d(SUC(SUC n)) = d(SUC n) ==> dsize d = SUC n`, REWRITE_TAC[GSYM LE_ANTISYM] THEN MESON_TAC[DIVISION_DSIZE_LE; DIVISION_DSIZE_GE]);; let DIVISION_DSIZE_EQ_ALT = prove (`!a b d n. division(a,b) d /\ d(SUC n) = d(n) /\ (!i. i < n ==> d(i) < d(SUC i)) ==> dsize d = n`, REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL [MESON_TAC[ARITH_RULE `d <= 0 ==> d = 0`; DIVISION_DSIZE_LE]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN ASM_MESON_TAC[DIVISION_DSIZE_LE; DIVISION_DSIZE_GE; LT]);; (* ------------------------------------------------------------------------- *) (* Combination of adjacent intervals (quite painful in the details). *) (* ------------------------------------------------------------------------- *) let DEFINT_COMBINE = prove (`!f a b c i j. a <= b /\ b <= c /\ defint(a,b) f i /\ defint(b,c) f j ==> defint(a,c) f (i + j)`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ASSUME `a <= b`) THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `a:real = b` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[INTEGRAL_NULL; DINT_UNIQ; REAL_LE_TRANS; REAL_ADD_LID]; DISCH_TAC] THEN MP_TAC(ASSUME `b <= c`) THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `b:real = c` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[INTEGRAL_NULL; DINT_UNIQ; REAL_LE_TRANS; REAL_ADD_RID]; DISCH_TAC] THEN REWRITE_TAC[defint; AND_FORALL_THM] THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\x. if x < b then min (g1 x) (b - x) else if b < x then min (g2 x) (x - b) else min (g1 x) (g2 x)` THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge])) THEN REWRITE_TAC[gauge] THEN REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN TRY CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN REWRITE_TAC[tdiv; rsum] THEN STRIP_TAC THEN MP_TAC(SPECL [`d:num->real`; `a:real`; `c:real`; `b:real`] DIVISION_INTERMEDIATE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 0` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[ADD_CLAUSES]) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[DIVISION_THM; GE; LE_REFL; REAL_NOT_LT]; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_SPLIT; ADD_CLAUSES] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = 1 + PRE n`)) THEN REWRITE_TAC[GSYM SUM_SPLIT; SUM_1] THEN SUBGOAL_THEN `(p:num->real) m = b` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `m:num` o GEN_REWRITE_RULE I [fine]) THEN ASM_REWRITE_TAC[ARITH_RULE `m < m + n <=> ~(n = 0)`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN MAP_EVERY UNDISCH_TAC [`(d:num->real) m <= b`; `b:real <= d(SUC m)`] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!b. abs((s1 + x * (b - a)) - i) < e / &2 /\ abs((s2 + x * (c - b)) - j) < e / &2 ==> abs((s1 + x * (c - a) + s2) - (i + j)) < e`) THEN EXISTS_TAC `b:real` THEN CONJ_TAC THENL [UNDISCH_TAC `!D p. tdiv(a,b) (D,p) /\ fine g1 (D,p) ==> abs(rsum(D,p) f - i) < e / &2` THEN DISCH_THEN(MP_TAC o SPEC `\i. if i <= m then (d:num->real)(i) else b`) THEN DISCH_THEN(MP_TAC o SPEC `\i. if i <= m then (p:num->real)(i) else b`) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) /\ (a /\ c ==> d) ==> (a /\ b ==> c) ==> d`) THEN CONJ_TAC THENL [REWRITE_TAC[tdiv; division] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[division; LE_0]; ALL_TAC; X_GEN_TAC `k:num` THEN REWRITE_TAC[ARITH_RULE `SUC n <= m <=> n <= m /\ ~(m = n)`] THEN ASM_CASES_TAC `k:num = m` THEN ASM_REWRITE_TAC[LE_REFL; REAL_LE_REFL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]] THEN ASM_CASES_TAC `(d:num->real) m = b` THENL [EXISTS_TAC `m:num` THEN SIMP_TAC[ARITH_RULE `n < m ==> n <= m /\ SUC n <= m`] THEN SIMP_TAC[ARITH_RULE `n >= m ==> (n <= m <=> m = n:num)`] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[ARITH_RULE `i:num < m ==> i < m + n`]; ALL_TAC] THEN EXISTS_TAC `SUC m` THEN SIMP_TAC[ARITH_RULE `n >= SUC m ==> ~(n <= m)`] THEN SIMP_TAC[ARITH_RULE `n < SUC m ==> n <= m`] THEN SIMP_TAC[ARITH_RULE `n < SUC m ==> (SUC n <= m <=> ~(m = n))`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `k < SUC m /\ ~(n = 0) ==> k < m + n`; REAL_LT_LE]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[tdiv; fine] THEN STRIP_TAC THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[ARITH_RULE `SUC n <= m <=> n <= m /\ ~(m = n)`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o GEN_REWRITE_RULE I [fine]) THEN MATCH_MP_TAC MONO_IMP THEN ASM_CASES_TAC `k:num = m` THENL [ASM_REWRITE_TAC[LE_REFL; REAL_LT_REFL] THEN ASM_REWRITE_TAC[ARITH_RULE `m < m + n <=> ~(n = 0)`] THEN MAP_EVERY UNDISCH_TAC [`d(m:num) <= b`; `b <= d(SUC m)`] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k:num <= m` THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[ARITH_RULE `k <= m /\ ~(n = 0) ==> k < m + n`] THEN SUBGOAL_THEN `(p:num->real) k <= b` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d:num->real) m` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d:num->real) (SUC k)` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIVISION_MONO_LE; ARITH_RULE `k <= m /\ ~(k = m) ==> SUC k <= m`]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `d:num <= SUC m /\ ~(n = 0) ==> k < d ==> k < m + n`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_DSIZE_LE THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `gauge (\x. a <= x /\ x <= b) g1` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; gauge; REAL_LE_REFL] THEN DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC th) THEN ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN REWRITE_TAC[rsum] THEN ASM_CASES_TAC `(d:num->real) m = b` THENL [SUBGOAL_THEN `dsize (\i. if i <= m then d i else b) = m` ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[ADD_CLAUSES; LT_IMP_LE; LE_SUC_LT]] THEN MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC m <= m)`] THEN SIMP_TAC[LT_IMP_LE; LE_SUC_LT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[ARITH_RULE `i < m:num ==> i < m + n`]; ALL_TAC] THEN SUBGOAL_THEN `dsize (\i. if i <= m then d i else b) = SUC m` ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[sum; ADD_CLAUSES; LE_REFL; ARITH_RULE `~(SUC m <= m)`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[ADD_CLAUSES; LT_IMP_LE; LE_SUC_LT]] THEN MATCH_MP_TAC DIVISION_DSIZE_EQ THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC m <= m)`] THEN REWRITE_TAC[ARITH_RULE `~(SUC(SUC m) <= m)`] THEN ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN ASM_CASES_TAC `d(SUC m):real = b` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN UNDISCH_TAC `!D p. tdiv(b,c) (D,p) /\ fine g2 (D,p) ==> abs(rsum(D,p) f - j) < e / &2` THEN DISCH_THEN(MP_TAC o SPEC `\i. (d:num->real) (i + SUC m)`) THEN DISCH_THEN(MP_TAC o SPEC `\i. (p:num->real) (i + SUC m)`) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b /\ (b /\ c ==> d)) ==> (a /\ b ==> c) ==> d`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[tdiv; division; ADD_CLAUSES] THEN EXISTS_TAC `PRE n` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN ASM_MESON_TAC[ARITH_RULE `~(n = 0) /\ k < PRE n ==> SUC(k + m) < m + n`; ARITH_RULE `~(n = 0) /\ k >= PRE n ==> SUC(k + m) >= m + n`]; DISCH_TAC] THEN SUBGOAL_THEN `dsize(\i. d (i + SUC m)) = PRE n` ASSUME_TAC THENL [MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN GEN_REWRITE_TAC RAND_CONV [CONJ_SYM] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `SUC(PRE n + m) >= m + n /\ SUC(SUC(PRE n + m)) >= m + n`]] THEN DISCH_THEN(fun th -> X_GEN_TAC `k:num` THEN DISCH_TAC THEN MATCH_MP_TAC th) THEN UNDISCH_TAC `k < PRE n` THEN ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[fine] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN DISCH_THEN(MP_TAC o SPEC `k + SUC m`) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN ANTS_TAC THENL [UNDISCH_TAC `k < PRE n` THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `b <= a ==> x < b ==> x < a`) THEN SUBGOAL_THEN `~(p(SUC (k + m)) < b)` (fun th -> REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN REWRITE_TAC[REAL_NOT_LT] THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o SPEC `SUC(k + m)`) THEN UNDISCH_TAC `b <= d (SUC m)` THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVISION_MONO_LE) THEN DISCH_THEN(MP_TAC o SPECL [`SUC m`; `k + SUC m`]) THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ADD_CLAUSES] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[rsum] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBST1_TAC(ARITH_RULE `m + 1 = 0 + SUC m`) THEN REWRITE_TAC[SUM_REINDEX] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[ADD_CLAUSES]; ALL_TAC] THEN UNDISCH_TAC `!D p. tdiv(b,c) (D,p) /\ fine g2 (D,p) ==> abs(rsum(D,p) f - j) < e / &2` THEN DISCH_THEN(MP_TAC o SPEC `\i. if i = 0 then b:real else d(i + m)`) THEN DISCH_THEN(MP_TAC o SPEC `\i. if i = 0 then b:real else p(i + m)`) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b /\ (b /\ c ==> d)) ==> (a /\ b ==> c) ==> d`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[tdiv; division; ADD_CLAUSES] THEN CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN REWRITE_TAC[NOT_SUC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `m:num`) THEN ASM_REWRITE_TAC[ADD_CLAUSES]] THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[NOT_SUC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_AND THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN(fun th -> X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k + m:num` th)) THENL [ALL_TAC; UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC] THEN ASM_CASES_TAC `k:num < n` THEN ASM_REWRITE_TAC[ARITH_RULE `k + m:num < m + n <=> k < n`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_REWRITE_TAC[REAL_LT_LE]; DISCH_TAC] THEN SUBGOAL_THEN `dsize(\i. if i = 0 then b else d (i + m)) = n` ASSUME_TAC THENL [MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN GEN_REWRITE_TAC RAND_CONV [CONJ_SYM] THEN REWRITE_TAC[NOT_SUC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[GE; ADD_SYM; LE_REFL; LE]] THEN DISCH_THEN(fun th -> X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k + m:num` th)) THEN ASM_CASES_TAC `k:num < n` THEN ASM_REWRITE_TAC[ARITH_RULE `k + m:num < m + n <=> k < n`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[fine] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN DISCH_THEN(MP_TAC o SPEC `k + m:num`) THEN ASM_REWRITE_TAC[ADD_CLAUSES; NOT_SUC; ARITH_RULE `k + m < m + n <=> k:num < n`] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[ADD_CLAUSES; REAL_LT_REFL] THEN MAP_EVERY UNDISCH_TAC [`(d:num->real) m <= b`; `b <= d (SUC m)`] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `b <= a ==> x < b ==> x < a`) THEN SUBGOAL_THEN `~((p:num->real) (k + m) < b)` (fun th -> REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `d(SUC m):real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d:num->real)(k + m)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVISION_MONO_LE) THEN DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[rsum] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN SUBGOAL_THEN `n = 1 + PRE n` (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [th]) THENL [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; NOT_SUC; ADD_CLAUSES] THEN MATCH_MP_TAC(REAL_ARITH `a = b ==> x + a = b + x`) THEN SUBST1_TAC(ARITH_RULE `1 = 0 + 1`) THEN SUBST1_TAC(ARITH_RULE `m + 0 + 1 = 0 + m + 1`) THEN ONCE_REWRITE_TAC[SUM_REINDEX] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[ADD_CLAUSES; ADD_EQ_0; ARITH] THEN REWRITE_TAC[ADD_AC]);; (* ------------------------------------------------------------------------- *) (* Pointwise perturbation and spike functions. *) (* ------------------------------------------------------------------------- *) let DEFINT_DELTA_LEFT = prove (`!a b. defint(a,b) (\x. if x = a then &1 else &0) (&0)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN ASM_SIMP_TAC[DEFINT_WRONG] THEN REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. e):real->real` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; gauge; fine; rsum; tdiv; REAL_SUB_RZERO] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN ASM_CASES_TAC `dsize d = 0` THEN ASM_REWRITE_TAC[sum; REAL_ABS_NUM] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = 1 + PRE n`)) THEN REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN MATCH_MP_TAC(REAL_ARITH `(&0 <= x /\ x < e) /\ y = &0 ==> abs(x + y) < e`) THEN CONJ_TAC THENL [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN REWRITE_TAC[REAL_MUL_LID; REAL_SUB_LE] THEN ASM_MESON_TAC[DIVISION_THM; LE_0; LT_NZ]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN FIRST_ASSUM(MP_TAC o SPECL [`1`; `r:num`] o MATCH_MP DIVISION_MONO_LE) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN DISCH_THEN(MP_TAC o SPEC `0`) THEN ASM_REWRITE_TAC[ARITH; LT_NZ] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPEC `r:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let DEFINT_DELTA_RIGHT = prove (`!a b. defint(a,b) (\x. if x = b then &1 else &0) (&0)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN ASM_SIMP_TAC[DEFINT_WRONG] THEN REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. e):real->real` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; gauge; fine; rsum; tdiv; REAL_SUB_RZERO] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN ASM_CASES_TAC `dsize d = 0` THEN ASM_REWRITE_TAC[sum; REAL_ABS_NUM] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `~(n = 0) ==> n = PRE n + 1`)) THEN ABBREV_TAC `m = PRE(dsize d)` THEN ASM_REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN MATCH_MP_TAC(REAL_ARITH `(&0 <= x /\ x < e) /\ y = &0 ==> abs(y + x) < e`) THEN CONJ_TAC THENL [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN REWRITE_TAC[REAL_MUL_LID; REAL_SUB_LE] THEN ASM_MESON_TAC[DIVISION_THM; ARITH_RULE `m < m + 1`; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `r:num`) THEN FIRST_ASSUM(MP_TAC o SPECL [`SUC r`; `m:num`] o MATCH_MP DIVISION_MONO_LE) THEN ASM_REWRITE_TAC[LE_SUC_LT] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [DIVISION_THM]) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `m:num`) (MP_TAC o SPEC `m + 1`)) THEN ASM_REWRITE_TAC[GE; LE_REFL; ARITH_RULE `x < x + 1`] THEN REWRITE_TAC[ADD1] THEN REAL_ARITH_TAC);; let DEFINT_DELTA = prove (`!a b c. defint(a,b) (\x. if x = c then &1 else &0) (&0)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a <= b` THENL [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN ASM_CASES_TAC `a <= c /\ c <= b` THENL [ALL_TAC; MATCH_MP_TAC INTEGRAL_EQ THEN EXISTS_TAC `\x:real. &0` THEN ASM_REWRITE_TAC[DEFINT_0] THEN ASM_MESON_TAC[]] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_LID] THEN MATCH_MP_TAC DEFINT_COMBINE THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[DEFINT_DELTA_LEFT; DEFINT_DELTA_RIGHT]);; let DEFINT_POINT_SPIKE = prove (`!f g a b c i. (!x. a <= x /\ x <= b /\ ~(x = c) ==> (f x = g x)) /\ defint(a,b) f i ==> defint(a,b) g i`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN MATCH_MP_TAC INTEGRAL_EQ THEN EXISTS_TAC `\x:real. f(x) + (g c - f c) * (if x = c then &1 else &0)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SUBST1_TAC(REAL_ARITH `i = i + ((g:real->real) c - f c) * &0`) THEN MATCH_MP_TAC DEFINT_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DEFINT_CMUL THEN REWRITE_TAC[DEFINT_DELTA]; REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN REAL_ARITH_TAC]);; let DEFINT_FINITE_SPIKE = prove (`!f g a b s i. FINITE s /\ (!x. a <= x /\ x <= b /\ ~(x IN s) ==> (f x = g x)) /\ defint(a,b) f i ==> defint(a,b) g i`, REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a ==> b ==> d`] THEN DISCH_TAC THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`g:real->real`; `s:real->bool`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY] THEN CONJ_TAC THENL [ASM_MESON_TAC[INTEGRAL_EQ]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `s:real->bool`] THEN STRIP_TAC THEN X_GEN_TAC `g:real->real` THEN REWRITE_TAC[IN_INSERT; DE_MORGAN_THM] THEN DISCH_TAC THEN MATCH_MP_TAC DEFINT_POINT_SPIKE THEN EXISTS_TAC `\x. if x = c then (f:real->real) x else g x` THEN EXISTS_TAC `c:real` THEN SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cauchy-type integrability criterion. *) (* ------------------------------------------------------------------------- *) let GAUGE_MIN_FINITE = prove (`!s gs n. (!m:num. m <= n ==> gauge s (gs m)) ==> ?g. gauge s g /\ !d p. fine g (d,p) ==> !m. m <= n ==> fine (gs m) (d,p)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LE] THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `gm:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real. if gm x < gs(SUC n) x then gm x else gs(SUC n) x` THEN ASM_SIMP_TAC[GAUGE_MIN; ETA_AX] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FINE_MIN) THEN ASM_SIMP_TAC[ETA_AX]);; let INTEGRABLE_CAUCHY = prove (`!f a b. integrable(a,b) f <=> !e. &0 < e ==> ?g. gauge (\x. a <= x /\ x <= b) g /\ !d1 p1 d2 p2. tdiv (a,b) (d1,p1) /\ fine g (d1,p1) /\ tdiv (a,b) (d2,p2) /\ fine g (d2,p2) ==> abs (rsum(d1,p1) f - rsum(d2,p2) f) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[integrable] THEN EQ_TAC THENL [REWRITE_TAC[defint] THEN DISCH_THEN(X_CHOOSE_TAC `i:real`) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`d1:num->real`; `p1:num->real`; `d2:num->real`; `p2:num->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THENL [ASM_MESON_TAC[DEFINT_WRONG]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `&1 / &2 pow n`) THEN SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` STRIP_ASSUME_TAC) THEN MP_TAC(GEN `n:num` (SPECL [`\x. a <= x /\ x <= b`; `g:num->real->real`; `n:num`] GAUGE_MIN_FINITE)) THEN ASM_REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `G:num->real->real` STRIP_ASSUME_TAC) THEN MP_TAC(GEN `n:num` (SPECL [`a:real`; `b:real`; `(G:num->real->real) n`] DIVISION_EXISTS)) THEN ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->num->real`; `p:num->num->real`] THEN STRIP_TAC THEN SUBGOAL_THEN `cauchy (\n. rsum(d n,p n) f)` MP_TAC THENL [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `&1 / e` REAL_ARCH_POW2) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN DISCH_TAC THEN REWRITE_TAC[GE] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `(d:num->num->real) m`; `(p:num->num->real) m`; `(d:num->num->real) n`; `(p:num->num->real) n`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `d < e ==> x < d ==> x < e`) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN ASM_MESON_TAC[REAL_MUL_SYM]; ALL_TAC] THEN REWRITE_TAC[SEQ_CAUCHY; convergent; SEQ; defint] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` MP_TAC) THEN X_CHOOSE_TAC `N2:num` (SPEC `&2 / e` REAL_ARCH_POW2) THEN DISCH_THEN(MP_TAC o SPEC `N1 + N2:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN DISCH_TAC THEN EXISTS_TAC `(G:num->real->real)(N1 + N2)` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`dx:num->real`; `px:num->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`N1 + N2:num`; `dx:num->real`; `px:num->real`; `(d:num->num->real)(N1 + N2)`; `(p:num->num->real)(N1 + N2)`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(s1 - i) < e / &2 ==> d < e / &2 ==> abs(s2 - s1) < d ==> abs(s2 - i) < e`)) THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow N2` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Limit theorem. *) (* ------------------------------------------------------------------------- *) let SUM_DIFFS = prove (`!m n. sum(m,n) (\i. d(SUC i) - d(i)) = d(m + n) - d m`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN REAL_ARITH_TAC);; let RSUM_BOUND = prove (`!a b d p e f. tdiv(a,b) (d,p) /\ (!x. a <= x /\ x <= b ==> abs(f x) <= e) ==> abs(rsum(d,p) f) <= e * (b - a)`, REPEAT STRIP_TAC THEN REWRITE_TAC[rsum] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,dsize d) (\i. abs(f(p i :real) * (d(SUC i) - d i)))` THEN REWRITE_TAC[SUM_ABS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,dsize d) (\i. e * abs(d(SUC i) - d(i)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[ADD_CLAUSES; REAL_ABS_MUL] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[tdiv; DIVISION_UBOUND; DIVISION_LBOUND; REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[SUM_CMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_ABS_POS; REAL_LE_TRANS; DIVISION_LE; tdiv]; ALL_TAC] THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[tdiv]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_MONO_LE_SUC) THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; SUM_DIFFS; ADD_CLAUSES] THEN MATCH_MP_TAC(REAL_ARITH `a <= d0 /\ d1 <= b ==> d1 - d0 <= b - a`) THEN ASM_MESON_TAC[DIVISION_LBOUND; DIVISION_UBOUND]);; let RSUM_DIFF_BOUND = prove (`!a b d p e f g. tdiv(a,b) (d,p) /\ (!x. a <= x /\ x <= b ==> abs(f x - g x) <= e) ==> abs(rsum (d,p) f - rsum (d,p) g) <= e * (b - a)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP RSUM_BOUND) THEN REWRITE_TAC[rsum; SUM_SUB; REAL_SUB_RDISTRIB]);; let INTEGRABLE_LIMIT = prove (`!f a b. (!e. &0 < e ==> ?g. (!x. a <= x /\ x <= b ==> abs(f x - g x) <= e) /\ integrable(a,b) g) ==> integrable(a,b) f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG; integrable]] THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `&1 / &2 pow n`) THEN SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM; integrable] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `i:num->real`))) THEN SUBGOAL_THEN `cauchy i` MP_TAC THENL [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `(&4 * (b - a)) / e` REAL_ARCH_POW2) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [defint]) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `m:num` th) THEN MP_TAC(SPEC `n:num` th)) THEN DISCH_THEN(X_CHOOSE_THEN `gn:real->real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `gm:real->real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`a:real`; `b:real`; `\x:real. if gm x < gn x then gm x else gn x`] DIVISION_EXISTS) THEN ASM_SIMP_TAC[GAUGE_MIN; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o MATCH_MP FINE_MIN) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`])) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `abs(rsum(d,p) (g(m:num)) - rsum(d,p) (g n)) <= e / &2` (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &2 pow N * (b - a)` THEN CONJ_TAC THENL [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!f. abs(f - gm) <= inv(k) /\ abs(f - gn) <= inv(k) ==> abs(gm - gn) <= &2 / k`) THEN EXISTS_TAC `(f:real->real) x` THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `&1 / &2 pow m`; EXISTS_TAC `&1 / &2 pow n`] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_MONO; REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&2 / n * x <= e / &2 <=> (&4 * x) / n <= e`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[SEQ_CAUCHY; convergent] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real` THEN DISCH_TAC THEN REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3` o GEN_REWRITE_RULE I [SEQ]) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; GE] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN MP_TAC(SPEC `(&3 * (b - a)) / e` REAL_ARCH_POW2) THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [defint]) THEN DISCH_THEN(MP_TAC o SPECL [`N1 + N2:num`; `e / &3`]) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `N1:num <= N1 + N2`)) THEN MATCH_MP_TAC(REAL_ARITH `abs(sf - sg) <= e / &3 ==> abs(i - s) < e / &3 ==> abs(sg - i) < e / &3 ==> abs(sf - s) < e`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &2 pow (N1 + N2) * (b - a)` THEN CONJ_TAC THENL [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&1 / n * x <= e / &3 <=> (&3 * x) / n <= e`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow N2` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; ARITH_RULE `N2 <= N1 + N2:num`]);; (* ------------------------------------------------------------------------- *) (* Hence continuous functions are integrable. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_CONST = prove (`!a b c. integrable(a,b) (\x. c)`, REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_CONST]);; let INTEGRABLE_COMBINE = prove (`!f a b c. a <= b /\ b <= c /\ integrable(a,b) f /\ integrable(b,c) f ==> integrable(a,c) f`, REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_COMBINE]);; let INTEGRABLE_POINT_SPIKE = prove (`!f g a b c. (!x. a <= x /\ x <= b /\ ~(x = c) ==> f x = g x) /\ integrable(a,b) f ==> integrable(a,b) g`, REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_POINT_SPIKE]);; let INTEGRABLE_CONTINUOUS = prove (`!f a b. (!x. a <= x /\ x <= b ==> f contl x) ==> integrable(a,b) f`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THENL [ASM_MESON_TAC[integrable; DEFINT_WRONG]; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_LIMIT THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_UNIFORM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN UNDISCH_TAC `a <= b` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`b:real`; `a:real`] THEN MATCH_MP_TAC BOLZANO_LEMMA_ALT THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(TAUT `(a /\ b) /\ (c /\ d ==> e) ==> (a ==> c) /\ (b ==> d) ==> e`) THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `g:real->real`) (X_CHOOSE_TAC `h:real->real`)) THEN EXISTS_TAC `\x. if x <= v then g(x):real else h(x)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TOTAL]; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_COMBINE THEN EXISTS_TAC `v:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_POINT_SPIKE THENL [EXISTS_TAC `g:real->real`; EXISTS_TAC `h:real->real`] THEN EXISTS_TAC `v:real` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= c /\ ~(x = b) ==> ~(x <= b)`]; ALL_TAC] THEN X_GEN_TAC `x:real` THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real. (f:real->real) u` THEN ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Integrability on a subinterval. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_SPLIT_SIDES = prove (`!f a b c. a <= c /\ c <= b /\ integrable(a,b) f ==> ?i. !e. &0 < e ==> ?g. gauge(\x. a <= x /\ x <= b) g /\ !d1 p1 d2 p2. tdiv(a,c) (d1,p1) /\ fine g (d1,p1) /\ tdiv(c,b) (d2,p2) /\ fine g (d2,p2) ==> abs((rsum(d1,p1) f + rsum(d2,p2) f) - i) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[integrable; defint] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN ASM_MESON_TAC[DIVISION_APPEND_STRONG]);; let INTEGRABLE_SUBINTERVAL_LEFT = prove (`!f a b c. a <= c /\ c <= b /\ integrable(a,b) f ==> integrable(a,c) f`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `i:real` o MATCH_MP INTEGRABLE_SPLIT_SIDES) THEN REWRITE_TAC[INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN SIMP_TAC[ASSUME `&0 < e`; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`c:real`; `b:real`; `g:real->real`] DIVISION_EXISTS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let INTEGRABLE_SUBINTERVAL_RIGHT = prove (`!f a b c. a <= c /\ c <= b /\ integrable(a,b) f ==> integrable(c,b) f`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `i:real` o MATCH_MP INTEGRABLE_SPLIT_SIDES) THEN REWRITE_TAC[INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN SIMP_TAC[ASSUME `&0 < e`; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:real`; `c:real`; `g:real->real`] DIVISION_EXISTS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let INTEGRABLE_SUBINTERVAL = prove (`!f a b c d. a <= c /\ c <= d /\ d <= b /\ integrable(a,b) f ==> integrable(c,d) f`, MESON_TAC[INTEGRABLE_SUBINTERVAL_LEFT; INTEGRABLE_SUBINTERVAL_RIGHT; REAL_LE_TRANS]);; (* ------------------------------------------------------------------------- *) (* Basic integrability rule for everywhere-differentiable function. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_RULE = let pth = prove (`(!x. f contl x) ==> integrable(a,b) f`, MESON_TAC[INTEGRABLE_CONTINUOUS]) in let match_pth = PART_MATCH rand pth and forsimp = GEN_REWRITE_RULE LAND_CONV [FORALL_SIMP] in fun tm -> let th1 = match_pth tm in let th2 = CONV_RULE (LAND_CONV(BINDER_CONV CONTINUOUS_CONV)) th1 in MP (forsimp th2) TRUTH;; let INTEGRABLE_CONV = EQT_INTRO o INTEGRABLE_RULE;; (* ------------------------------------------------------------------------- *) (* More basic lemmas about integration. *) (* ------------------------------------------------------------------------- *) let INTEGRAL_CONST = prove (`!a b c. a <= b ==> integral(a,b) (\x. c) = c * (b - a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN ASM_SIMP_TAC[DEFINT_CONST]);; let INTEGRAL_CMUL = prove (`!f c a b. a <= b /\ integrable(a,b) f ==> integral(a,b) (\x. c * f(x)) = c * integral(a,b) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN ASM_SIMP_TAC[DEFINT_CMUL; INTEGRABLE_DEFINT]);; let INTEGRAL_ADD = prove (`!f g a b. a <= b /\ integrable(a,b) f /\ integrable(a,b) g ==> integral(a,b) (\x. f(x) + g(x)) = integral(a,b) f + integral(a,b) g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN ASM_SIMP_TAC[DEFINT_ADD; INTEGRABLE_DEFINT]);; let INTEGRAL_SUB = prove (`!f g a b. a <= b /\ integrable(a,b) f /\ integrable(a,b) g ==> integral(a,b) (\x. f(x) - g(x)) = integral(a,b) f - integral(a,b) g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN ASM_SIMP_TAC[DEFINT_SUB; INTEGRABLE_DEFINT]);; let INTEGRAL_BY_PARTS = prove (`!f g f' g' a b. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f' x) x) /\ (!x. a <= x /\ x <= b ==> (g diffl g' x) x) /\ integrable(a,b) (\x. f' x * g x) /\ integrable(a,b) (\x. f x * g' x) ==> integral(a,b) (\x. f x * g' x) = (f b * g b - f a * g a) - integral(a,b) (\x. f' x * g x)`, MP_TAC INTEGRATION_BY_PARTS THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJ (ASSUME `a <= b`)) THEN DISCH_THEN(SUBST1_TAC o SYM o MATCH_MP DEFINT_INTEGRAL) THEN ASM_SIMP_TAC[INTEGRAL_ADD] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------ *) (* SYM_CANON_CONV - Canonicalizes single application of symmetric operator *) (* Rewrites `so as to make fn true`, e.g. fn = (<<) or fn = (=) `1` o fst *) (* ------------------------------------------------------------------------ *) let SYM_CANON_CONV sym fn = REWR_CONV sym o check (not o fn o ((snd o dest_comb) F_F I) o dest_comb);; (* ----------------------------------------------------------- *) (* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) <=> (f = g) *) (* ----------------------------------------------------------- *) let EXT_CONV = SYM o uncurry X_FUN_EQ_CONV o (I F_F (mk_eq o (rator F_F rator) o dest_eq)) o dest_forall;; (* ------------------------------------------------------------------------ *) (* Mclaurin's theorem with Lagrange form of remainder *) (* We could weaken the hypotheses slightly, but it's not worth it *) (* ------------------------------------------------------------------------ *) let MCLAURIN = prove( `!f diff h n. &0 < h /\ 0 < n /\ (diff(0) = f) /\ (!m t. m < n /\ &0 <= t /\ t <= h ==> (diff(m) diffl diff(SUC m)(t))(t)) ==> (?t. &0 < t /\ t < h /\ (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) + ((diff(n)(t) / &(FACT n)) * (h pow n))))`, REPEAT GEN_TAC THEN STRIP_TAC THEN UNDISCH_TAC `0 < n` THEN DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN `r:num` MP_TAC) (SPEC `n:num` num_CASES) THEN REWRITE_TAC[LT_REFL] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `?B. f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) + (B * ((h pow n) / &(FACT n)))` MP_TAC THENL [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN EXISTS_TAC `(f(h) - sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m))) * &(FACT n) / (h pow n)` THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (d * a) * (b * c)`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN BINOP_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THENL [MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT; FACT_LT]; MATCH_MP_TAC POW_NZ THEN MATCH_MP_TAC REAL_POS_NZ THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (ASSUME_TAC o SYM)) THEN ABBREV_TAC `g = \t. f(t) - (sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (t pow m)) + (B * ((t pow n) / &(FACT n))))` THEN SUBGOAL_THEN `(g(&0) = &0) /\ (g(h) = &0)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN EXPAND_TAC "n" THEN REWRITE_TAC[POW_0; REAL_DIV_LZERO] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_SUB_0] THEN MP_TAC(GEN `j:num->real` (SPECL [`j:num->real`; `r:num`; `1`] SUM_OFFSET)) THEN REWRITE_TAC[ADD1; REAL_EQ_SUB_LADD] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN REWRITE_TAC[pow; FACT] THEN ASM_REWRITE_TAC[real_div; REAL_INV1; REAL_MUL_RID] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; SUM_0]; ALL_TAC] THEN ABBREV_TAC `difg = \m t. diff(m) t - (sum(0,n - m)(\p. (diff(m + p)(&0) / &(FACT p)) * (t pow p)) + (B * ((t pow (n - m)) / &(FACT(n - m)))))` THEN SUBGOAL_THEN `difg(0):real->real = g` ASSUME_TAC THENL [EXPAND_TAC "difg" THEN BETA_TAC THEN EXPAND_TAC "g" THEN CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUB_0]; ALL_TAC] THEN SUBGOAL_THEN `(!m t. m < n /\ (& 0) <= t /\ t <= h ==> (difg(m) diffl difg(SUC m)(t))(t))` ASSUME_TAC THENL [REPEAT GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "difg" THEN BETA_TAC THEN CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN MATCH_MP_TAC DIFF_ADD THEN CONJ_TAC THENL [ALL_TAC; W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RID; REAL_ADD_LID] THEN REWRITE_TAC[REAL_FACT_NZ; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `t:real`) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `t:real`)) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; POW_2] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = b * (a * (d * c))`] THEN FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN REWRITE_TAC[ADD_SUB] THEN AP_TERM_TAC THEN IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN REWRITE_TAC[REAL_FACT_NZ] THEN REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_MUL] THEN REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN REWRITE_TAC[REAL_FACT_NZ; REAL_INJ; NOT_SUC]) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e * f * g = (b * a) * (d * f) * (c * g) * e`] THEN REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_FACT_NZ] THEN REWRITE_TAC[REAL_INJ; NOT_SUC]) THEN REWRITE_TAC[REAL_MUL_LID]] THEN FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN CONV_TAC (funpow 2 RATOR_CONV (RAND_CONV HABS_CONV)) THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[pow; DIFF_CONST] THEN (MP_TAC o C SPECL DIFF_SUM) [`\p x. (diff((p + 1) + m)(&0) / &(FACT(p + 1))) * (x pow (p + 1))`; `\p x. (diff(p + (SUC m))(&0) / &(FACT p)) * (x pow p)`; `0`; `d:num`; `t:real`] THEN BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN DISCH_THEN(MP_TAC o SPEC `t:real`) THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `z:real`)) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_MUL_RID] THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; real_div; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[SUC_SUB1] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = c * (a * d) * b`] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `&(SUC k) = inv(inv(&(SUC k)))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN IMP_SUBST_TAC(GSYM REAL_INV_MUL_WEAK) THENL [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[REAL_FACT_NZ] THEN MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN AP_TERM_TAC THEN REWRITE_TAC[FACT; GSYM REAL_MUL; REAL_MUL_ASSOC] THEN IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN SUBGOAL_THEN `!m. m < n ==> ?t. &0 < t /\ t < h /\ (difg(SUC m)(t) = &0)` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `r:num`) THEN EXPAND_TAC "n" THEN REWRITE_TAC[LESS_SUC_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `difg(SUC r)(t:real) = &0` THEN EXPAND_TAC "difg" THEN ASM_REWRITE_TAC[SUB_REFL; sum; pow; FACT] THEN REWRITE_TAC[REAL_SUB_0; REAL_ADD_LID; real_div] THEN REWRITE_TAC[REAL_INV1; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [AC REAL_MUL_AC `(a * b) * c = a * (c * b)`] THEN ASM_REWRITE_TAC[GSYM real_div]] THEN SUBGOAL_THEN `!m:num. m < n ==> (difg(m)(&0) = &0)` ASSUME_TAC THENL [X_GEN_TAC `m:num` THEN EXPAND_TAC "difg" THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN MP_TAC(GEN `j:num->real` (SPECL [`j:num->real`; `d:num`; `1`] SUM_OFFSET)) THEN REWRITE_TAC[ADD1; REAL_EQ_SUB_LADD] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN REWRITE_TAC[FACT; pow; REAL_INV1; ADD_CLAUSES; real_div; REAL_MUL_RID] THEN REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; SUM_0; REAL_ADD_LID] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_SUB_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!m:num. m < n ==> ?t. &0 < t /\ t < h /\ (difg(m) diffl &0)(t)` MP_TAC THENL [ALL_TAC; DISCH_THEN(fun th -> GEN_TAC THEN DISCH_THEN(fun t -> ASSUME_TAC t THEN MP_TAC(MATCH_MP th t))) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `difg(m:num):real->real` THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC] THEN INDUCT_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!t. &0 <= t /\ t <= h ==> g differentiable t` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN EXISTS_TAC `difg(SUC 0)(t:real):real` THEN SUBST1_TAC(SYM(ASSUME `difg(0):real->real = g`)) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; DISCH_TAC THEN SUBGOAL_THEN `m < n:num` (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC m` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t0:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?t. (& 0) < t /\ t < t0 /\ ((difg(SUC m)) diffl (& 0))t` MP_TAC THENL [MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SUBGOAL_THEN `difg(SUC m)(&0) = &0` SUBST1_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `difg(m:num):real->real` THEN EXISTS_TAC `t0:real` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC m` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `!t. &0 <= t /\ t <= t0 ==> difg(SUC m) differentiable t` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN EXISTS_TAC `difg(SUC(SUC m))(t:real):real` THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `t0:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `t0:real` THEN ASM_REWRITE_TAC[]]]);; let MCLAURIN_NEG = prove (`!f diff h n. h < &0 /\ 0 < n /\ (diff(0) = f) /\ (!m t. m < n /\ h <= t /\ t <= &0 ==> (diff(m) diffl diff(SUC m)(t))(t)) ==> (?t. h < t /\ t < &0 /\ (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) + ((diff(n)(t) / &(FACT n)) * (h pow n))))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`\x. (f(--x):real)`; `\n x. ((--(&1)) pow n) * (diff:num->real->real)(n)(--x)`; `--h`; `n:num`] MCLAURIN) THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEG_GT0; pow; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN ONCE_REWRITE_TAC[AC CONJ_ACI `a /\ b /\ c <=> a /\ c /\ b`] THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [REPEAT GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_THEN(MP_TAC o C CONJ (SPEC `t:real` (DIFF_CONV `\x. --x`))) THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP DIFF_CMUL) THEN DISCH_THEN(MP_TAC o SPEC `(--(&1)) pow m`) THEN BETA_TAC THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `z:real`)) THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC(AC REAL_MUL_AC); DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `--t` THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN BINOP_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN BETA_TAC; ALL_TAC] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (b * c) * (a * d)`] THEN REWRITE_TAC[GSYM POW_MUL; GSYM REAL_NEG_MINUS1; REAL_NEGNEG] THEN REWRITE_TAC[REAL_MUL_ASSOC]);; (* ------------------------------------------------------------------------- *) (* More convenient "bidirectional" version. *) (* ------------------------------------------------------------------------- *) let MCLAURIN_BI_LE = prove (`!f diff x n. (diff 0 = f) /\ (!m t. m < n /\ abs(t) <= abs(x) ==> (diff m diffl diff (SUC m) t) t) ==> ?t. abs(t) <= abs(x) /\ (f x = sum (0,n) (\m. diff m (&0) / &(FACT m) * x pow m) + diff n t / &(FACT n) * x pow n)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[sum; real_pow; FACT; REAL_DIV_1; REAL_MUL_RID; REAL_ADD_LID] THEN EXISTS_TAC `x:real` THEN REWRITE_TAC[REAL_LE_REFL]; ALL_TAC] THEN ASM_CASES_TAC `x = &0` THENL [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[ADD1] THEN REWRITE_TAC[REWRITE_RULE[REAL_EQ_SUB_RADD] (GSYM SUM_OFFSET)] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RZERO; SUM_0] THEN REWRITE_TAC[REAL_ADD_RID; REAL_ADD_LID] THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN ASM_REWRITE_TAC[real_pow; FACT; REAL_MUL_RID; REAL_DIV_1]; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ x < &0`)) THENL [MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`] MCLAURIN) THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= t /\ t <= x ==> abs(t) <= abs(x)`] THEN ASM_REWRITE_TAC[LT_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REAL_ARITH `&0 < t /\ t < x ==> abs(t) <= abs(x)`]; MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`] MCLAURIN_NEG) THEN ASM_SIMP_TAC[REAL_ARITH `x <= t /\ t <= &0 ==> abs(t) <= abs(x)`] THEN ASM_REWRITE_TAC[LT_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REAL_ARITH `x < t /\ t < &0 ==> abs(t) <= abs(x)`]]);; (* ------------------------------------------------------------------------- *) (* Simple strong form if a function is differentiable everywhere. *) (* ------------------------------------------------------------------------- *) let MCLAURIN_ALL_LT = prove (`!f diff. (diff 0 = f) /\ (!m x. ((diff m) diffl (diff(SUC m) x)) x) ==> !x n. ~(x = &0) /\ 0 < n ==> ?t. &0 < abs(t) /\ abs(t) < abs(x) /\ (f(x) = sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) + (diff n t / &(FACT n)) * x pow n)`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THENL [MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`] MCLAURIN_NEG) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `t < &0` THEN UNDISCH_TAC `x < t` THEN REAL_ARITH_TAC; MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`] MCLAURIN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `&0 < t` THEN UNDISCH_TAC `t < x` THEN REAL_ARITH_TAC]);; let MCLAURIN_ZERO = prove (`!diff n x. (x = &0) /\ 0 < n ==> (sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) = diff 0 (&0))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN REWRITE_TAC[LT] THEN DISCH_THEN(DISJ_CASES_THEN2 (SUBST1_TAC o SYM) MP_TAC) THENL [REWRITE_TAC[sum; ADD_CLAUSES; FACT; real_pow; real_div; REAL_INV_1] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID]; REWRITE_TAC[sum] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN ANTE_RES_THEN SUBST1_TAC th) THEN UNDISCH_TAC `0 < n` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_ADD_RID]]);; let MCLAURIN_ALL_LE = prove (`!f diff. (diff 0 = f) /\ (!m x. ((diff m) diffl (diff(SUC m) x)) x) ==> !x n. ?t. abs(t) <= abs(x) /\ (f(x) = sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) + (diff n t / &(FACT n)) * x pow n)`, REPEAT STRIP_TAC THEN DISJ_CASES_THEN MP_TAC(SPECL [`n:num`; `0`] LET_CASES) THENL [REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[sum; REAL_ADD_LID; FACT] THEN EXISTS_TAC `x:real` THEN REWRITE_TAC[REAL_LE_REFL; real_pow; REAL_MUL_RID; REAL_DIV_1]; DISCH_TAC THEN ASM_CASES_TAC `x = &0` THENL [MP_TAC(SPEC_ALL MCLAURIN_ZERO) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `&0` THEN REWRITE_TAC[REAL_LE_REFL] THEN SUBGOAL_THEN `&0 pow n = &0` SUBST1_TAC THENL [ASM_REWRITE_TAC[REAL_POW_EQ_0; GSYM (CONJUNCT1 LE); NOT_LE]; REWRITE_TAC[REAL_ADD_RID; REAL_MUL_RZERO]]; MP_TAC(SPEC_ALL MCLAURIN_ALL_LT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC_ALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Version for exp. *) (* ------------------------------------------------------------------------- *) let MCLAURIN_EXP_LEMMA = prove (`((\n:num. exp) 0 = exp) /\ (!m x. (((\n:num. exp) m) diffl ((\n:num. exp) (SUC m) x)) x)`, REWRITE_TAC[DIFF_EXP]);; let MCLAURIN_EXP_LT = prove (`!x n. ~(x = &0) /\ 0 < n ==> ?t. &0 < abs(t) /\ abs(t) < abs(x) /\ (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) + (exp(t) / &(FACT n)) * x pow n)`, MP_TAC (MATCH_MP MCLAURIN_ALL_LT MCLAURIN_EXP_LEMMA) THEN REWRITE_TAC[REAL_EXP_0; real_div; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_RID]);; let MCLAURIN_EXP_LE = prove (`!x n. ?t. abs(t) <= abs(x) /\ (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) + (exp(t) / &(FACT n)) * x pow n)`, MP_TAC (MATCH_MP MCLAURIN_ALL_LE MCLAURIN_EXP_LEMMA) THEN REWRITE_TAC[REAL_EXP_0; real_div; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Version for ln(1 +/- x). *) (* ------------------------------------------------------------------------- *) let DIFF_LN_COMPOSITE = prove (`!g m x. (g diffl m)(x) /\ &0 < g x ==> ((\x. ln(g x)) diffl (inv(g x) * m))(x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_CHAIN THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LN THEN ASM_REWRITE_TAC[]) in add_to_diff_net (SPEC_ALL DIFF_LN_COMPOSITE);; let MCLAURIN_LN_POS = prove (`!x n. &0 < x /\ 0 < n ==> ?t. &0 < t /\ t < x /\ (ln(&1 + x) = sum(0,n) (\m. --(&1) pow (SUC m) * (x pow m) / &m) + --(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. ln(&1 + x)` MCLAURIN) THEN DISCH_THEN(MP_TAC o SPEC `\n x. if n = 0 then ln(&1 + x) else --(&1) pow (SUC n) * &(FACT(PRE n)) * inv((&1 + x) pow n)`) THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_SUC; REAL_ADD_RID; REAL_POW_ONE] THEN REWRITE_TAC[LN_1; REAL_INV_1; REAL_MUL_RID] THEN SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL [UNDISCH_TAC `0 < n` THEN ARITH_TAC; ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; PRE] THEN REWRITE_TAC[real_div; FACT; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_INV_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!p. (if p = 0 then &0 else --(&1) pow (SUC p) * &(FACT (PRE p))) / &(FACT p) = --(&1) pow (SUC p) * inv(&p)` (fun th -> REWRITE_TAC[th]) THENL [INDUCT_TAC THENL [REWRITE_TAC[REAL_INV_0; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]; REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM real_div] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NOT_SUC]]; ALL_TAC] THEN SUBGOAL_THEN `!t. (--(&1) pow (SUC n) * &(FACT(PRE n)) * inv ((&1 + t) pow n)) / &(FACT n) * x pow n = --(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_INV_MUL] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[real_div; REAL_MUL_AC] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN REWRITE_TAC[PRE; real_pow; REAL_ADD_LID; REAL_MUL_RID] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_MUL_RID] THEN REWRITE_TAC[FACT; REAL_MUL_RID; REAL_NEG_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC; W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN SUBGOAL_THEN `~((&1 + u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID] THEN REWRITE_TAC[real_div; real_pow; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_RID; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[SUC_SUB1; PRE] THEN REWRITE_TAC[FACT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[real_pow; REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC]]);; let MCLAURIN_LN_NEG = prove (`!x n. &0 < x /\ x < &1 /\ 0 < n ==> ?t. &0 < t /\ t < x /\ (--(ln(&1 - x)) = sum(0,n) (\m. (x pow m) / &m) + x pow n / (&n * (&1 - t) pow n))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. --(ln(&1 - x))` MCLAURIN) THEN DISCH_THEN(MP_TAC o SPEC `\n x. if n = 0 then --(ln(&1 - x)) else &(FACT(PRE n)) * inv((&1 - x) pow n)`) THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN REWRITE_TAC[NOT_SUC; LN_1; REAL_POW_ONE] THEN SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL [UNDISCH_TAC `0 < n` THEN ARITH_TAC; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[REAL_INV_1; REAL_MUL_RID; REAL_MUL_LID] THEN SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; PRE] THEN REWRITE_TAC[real_div; FACT; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_INV_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_NEG_0] THEN SUBGOAL_THEN `!p. (if p = 0 then &0 else &(FACT (PRE p))) / &(FACT p) = inv(&p)` (fun th -> REWRITE_TAC[th]) THENL [INDUCT_TAC THENL [REWRITE_TAC[REAL_INV_0; real_div; REAL_MUL_LZERO]; REWRITE_TAC[NOT_SUC] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NOT_SUC]]; ALL_TAC] THEN SUBGOAL_THEN `!t. (&(FACT(PRE n)) * inv ((&1 - t) pow n)) / &(FACT n) * x pow n = x pow n / (&n * (&1 - t) pow n)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_INV_MUL] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[real_div; REAL_MUL_AC] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN REWRITE_TAC[PRE; pow; FACT; REAL_SUB_LZERO] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN REAL_ARITH_TAC; W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN SUBGOAL_THEN `~((&1 - u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN REAL_ARITH_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_SUB_LZERO; real_div; PRE] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC [REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[SUC_SUB1; PRE] THEN REWRITE_TAC[FACT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[real_pow; REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Versions for sin and cos. *) (* ------------------------------------------------------------------------- *) let MCLAURIN_SIN = prove (`!x n. abs(sin x - sum(0,n) (\m. (if EVEN m then &0 else -- &1 pow ((m - 1) DIV 2) / &(FACT m)) * x pow m)) <= inv(&(FACT n)) * abs(x) pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`sin`; `\n x. if n MOD 4 = 0 then sin(x) else if n MOD 4 = 1 then cos(x) else if n MOD 4 = 2 then --sin(x) else --cos(x)`] MCLAURIN_ALL_LE) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [CONJ_TAC THENL [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN MP_TAC(SYM th)) THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN UNDISCH_TAC `r MOD 4 < 4` THEN SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN SIMP_TAC[ARITH_RULE `(x + 1) - 1 = x`; ARITH_RULE `(x + 3) - 1 = x + 2`; ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`; ARITH_RULE `x * 4 = 2 * 2 * x`] THEN SIMP_TAC[DIV_MULT; ARITH_EQ] THEN REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_ABS_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POS] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_POW; REAL_LE_REFL]);; let MCLAURIN_COS = prove (`!x n. abs(cos x - sum(0,n) (\m. (if EVEN m then -- &1 pow (m DIV 2) / &(FACT m) else &0) * x pow m)) <= inv(&(FACT n)) * abs(x) pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`cos`; `\n x. if n MOD 4 = 0 then cos(x) else if n MOD 4 = 1 then --sin(x) else if n MOD 4 = 2 then --cos(x) else sin(x)`] MCLAURIN_ALL_LE) THEN W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL [CONJ_TAC THENL [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN MP_TAC(SYM th)) THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN UNDISCH_TAC `r MOD 4 < 4` THEN SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`; ARITH_RULE `x * 4 + 0 = 2 * 2 * x`] THEN SIMP_TAC[DIV_MULT; ARITH_EQ] THEN REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_MUL_ASSOC; REAL_ABS_POW] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN REWRITE_TAC[real_div; REAL_ABS_NUM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND]);; (* ------------------------------------------------------------------------- *) (* Taylor series for atan; needs a bit more preparation. *) (* ------------------------------------------------------------------------- *) let REAL_ATN_POWSER_SUMMABLE = prove (`!x. abs(x) < &1 ==> summable (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_LDIV THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_OF_NUM_LT; EVEN; LT_NZ]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN ASM_MESON_TAC[REAL_OF_NUM_LE; EVEN; ARITH_RULE `1 <= n <=> ~(n = 0)`]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; let REAL_ATN_POWSER_DIFFS_SUMMABLE = prove (`!x. abs(x) < &1 ==> summable (\n. diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; let REAL_ATN_POWSER_DIFFS_SUM = prove (`!x. abs(x) < &1 ==> (\n. diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n) sums (inv(&1 + x pow 2))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUMMABLE) THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP SUMMABLE_SUM th) THEN MP_TAC(MATCH_MP SER_PAIR th)) THEN SUBGOAL_THEN `(\n. sum (2 * n,2) (\n. diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)) = (\n. --(x pow 2) pow n)` SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC(LAND_CONV(LAND_CONV(RAND_CONV(TOP_DEPTH_CONV num_CONV)))) THEN REWRITE_TAC[sum; diffs; ADD_CLAUSES; EVEN_MULT; ARITH_EVEN; EVEN] THEN REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN SIMP_TAC[ARITH_RULE `SUC n - 1 = n`; DIV_MULT; ARITH_EQ] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN ONCE_REWRITE_TAC[GSYM REAL_POW_POW] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `(\n. --(x pow 2) pow n) sums inv (&1 + x pow 2)` MP_TAC THENL [ONCE_REWRITE_TAC[REAL_ARITH `&1 + x = &1 - (--x)`] THEN MATCH_MP_TAC GP THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_POW_2; REAL_LT_MUL2; REAL_ABS_POS]; ALL_TAC] THEN MESON_TAC[SUM_UNIQ]);; let REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE = prove (`!x. abs(x) < &1 ==> summable (\n. diffs (diffs (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n))) n * x pow n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n. &(SUC n) * abs(x) pow n` THEN CONJ_TAC THENL [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_MUL_LID; REAL_ABS_NUM; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC SER_RATIO THEN SUBGOAL_THEN `?c. abs(x) < c /\ c < &1` STRIP_ASSUME_TAC THENL [EXISTS_TAC `(&1 + abs(x)) / &2` THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?N. !n. n >= N ==> &(SUC(SUC n)) * abs(x) <= &(SUC n) * c` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_pow; REAL_ABS_MUL; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_ABS] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[]] THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN UNDISCH_TAC `abs(x) < c` THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN ONCE_REWRITE_TAC[REAL_ARITH `x + &1 <= y <=> &1 <= y - x * &1`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN SUBGOAL_THEN `?N. &1 <= &N * (c / abs x - &1)` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `N:num` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&1 <= x ==> x <= y ==> &1 <= y`)) THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_ARITH `a <= b ==> a <= b + &1`; REAL_OF_NUM_LE; REAL_LE_RADD] THEN REWRITE_TAC[REAL_LE_SUB_LADD; REAL_ADD_LID] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; REAL_LT_IMP_LE]] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_SUB_LADD; REAL_ADD_LID; REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; REAL_ARCH_SIMPLE]);; let REAL_ATN_POWSER_DIFFL = prove (`!x. abs(x) < &1 ==> ((\x. suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)) diffl (inv(&1 + x pow 2))) x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUM) THEN DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN MATCH_MP_TAC TERMDIFF THEN SUBGOAL_THEN `?K. abs(x) < abs(K) /\ abs(K) < &1` STRIP_ASSUME_TAC THENL [EXISTS_TAC `(&1 + abs(x)) / &2` THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_ATN_POWSER_SUMMABLE; REAL_ATN_POWSER_DIFFS_SUMMABLE; REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE]);; let REAL_ATN_POWSER = prove (`!x. abs(x) < &1 ==> (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) sums (atn x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_SUMMABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN SUBGOAL_THEN `suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) = atn(x)` (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a = b) <=> (a - b = &0)`] THEN SUBGOAL_THEN `suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * &0 pow n) - atn(&0) = &0` MP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `(a = &0) /\ (b = &0) ==> (a - b = &0)`) THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN MP_TAC(SPEC `&0` GP) THEN REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP SER_CMUL) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN ASM_MESON_TAC[EVEN]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM TAN_0] THEN MATCH_MP_TAC TAN_ATN THEN SIMP_TAC[PI2_BOUNDS; REAL_ARITH `&0 < x ==> --x < &0`]]; ALL_TAC] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MP_TAC(SPEC `\x. suminf (\n. (if EVEN n then &0 else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) - atn x` DIFF_ISCONST_END_SIMPLE) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ x < &0`)) THENL [DISCH_THEN(MP_TAC o SPECL [`&0`; `x:real`]); CONV_TAC(RAND_CONV SYM_CONV) THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `&0`])] THEN (REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:real` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(u) < &1` (MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFL) THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o C CONJ (SPEC `u:real` DIFF_ATN)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN REWRITE_TAC[REAL_SUB_REFL]));; let MCLAURIN_ATN = prove (`!x n. abs(x) < &1 ==> abs(atn x - sum(0,n) (\m. (if EVEN m then &0 else --(&1) pow ((m - 1) DIV 2) / &m) * x pow m)) <= abs(x) pow n / (&1 - abs x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER) THEN DISCH_THEN(fun th -> ASSUME_TAC(SYM(MATCH_MP SUM_UNIQ th)) THEN MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN DISCH_THEN(MP_TAC o MATCH_MP SER_OFFSET) THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN MATCH_MP_TAC(REAL_ARITH `abs(r) <= e ==> (f - s = r) ==> abs(f - s) <= e`) THEN SUBGOAL_THEN `(\m. abs(x) pow (m + n)) sums (abs(x) pow n) * inv(&1 - abs(x))` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP GP o MATCH_MP (REAL_ARITH `abs(x) < &1 ==> abs(abs x) < &1`)) THEN DISCH_THEN(MP_TAC o SPEC `abs(x) pow n` o MATCH_MP SER_CMUL) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_POW_ADD]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ o REWRITE_RULE[GSYM real_div]) THEN SUBGOAL_THEN `!m. abs((if EVEN (m + n) then &0 else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * x pow (m + n)) <= abs(x) pow (m + n)` ASSUME_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN SIMP_TAC[REAL_MUL_LZERO; REAL_ABS_NUM; REAL_POW_LE; REAL_ABS_POS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ASM_MESON_TAC[EVEN]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `suminf (\m. abs((if EVEN (m + n) then &0 else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * x pow (m + n)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SER_ABS THEN MATCH_MP_TAC SER_COMPARA THEN EXISTS_TAC `\m. abs(x) pow (m + n)` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUM_SUMMABLE]; ALL_TAC] THEN MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SER_COMPARA THEN EXISTS_TAC `\m. abs(x) pow (m + n)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[SUM_SUMMABLE]);; hol-light/Library/wo.ml000066400000000000000000001705651303454263000153460ustar00rootroot00000000000000(* ========================================================================= *) (* Proof of some useful AC equivalents like wellordering and Zorn's Lemma. *) (* *) (* This is a straight port of the old HOL88 wellorder library. I started to *) (* clean up the proofs to exploit first order automation, but didn't have *) (* the patience to persist till the end. Anyway, the proofs work! *) (* ========================================================================= *) let PBETA_TAC = CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV);; let EXPAND_TAC s = FIRST_ASSUM(SUBST1_TAC o SYM o check((=) s o fst o dest_var o rhs o concl)) THEN BETA_TAC;; let SUBSET_PRED = prove (`!P Q. P SUBSET Q <=> !x. P x ==> Q x`, REWRITE_TAC[SUBSET; IN]);; let UNIONS_PRED = prove (`UNIONS P = \x. ?p. P p /\ p x`, REWRITE_TAC[UNIONS; FUN_EQ_THM; IN_ELIM_THM; IN]);; (* ======================================================================== *) (* (1) Definitions and general lemmas. *) (* ======================================================================== *) (* ------------------------------------------------------------------------ *) (* Irreflexive version of an ordering. *) (* ------------------------------------------------------------------------ *) let less = new_definition `(less l)(x,y) <=> (l:A#A->bool)(x,y) /\ ~(x = y)`;; (* ------------------------------------------------------------------------ *) (* Field of an uncurried binary relation *) (* ------------------------------------------------------------------------ *) let fl = new_definition `fl(l:A#A->bool) x <=> ?y:A. l(x,y) \/ l(y,x)`;; (* ------------------------------------------------------------------------ *) (* Partial order (we infer the domain from the field of the relation) *) (* ------------------------------------------------------------------------ *) let poset = new_definition `poset (l:A#A->bool) <=> (!x. fl(l) x ==> l(x,x)) /\ (!x y z. l(x,y) /\ l(y,z) ==> l(x,z)) /\ (!x y. l(x,y) /\ l(y,x) ==> (x = y))`;; (* ------------------------------------------------------------------------ *) (* Chain in a poset (Defined as a subset of the field, not the ordering) *) (* ------------------------------------------------------------------------ *) let chain = new_definition `chain(l:A#A->bool) P <=> (!x y. P x /\ P y ==> l(x,y) \/ l(y,x))`;; (* ------------------------------------------------------------------------- *) (* Total order. *) (* ------------------------------------------------------------------------- *) let toset = new_definition `toset (l:A#A->bool) <=> poset l /\ !x y. x IN fl(l) /\ y IN fl(l) ==> l(x,y) \/ l(y,x)`;; (* ------------------------------------------------------------------------ *) (* Wellorder *) (* ------------------------------------------------------------------------ *) let woset = new_definition `woset (l:A#A->bool) <=> (!x. fl(l) x ==> l(x,x)) /\ (!x y z. l(x,y) /\ l(y,z) ==> l(x,z)) /\ (!x y. l(x,y) /\ l(y,x) ==> (x = y)) /\ (!x y. fl(l) x /\ fl(l) y ==> l(x,y) \/ l(y,x)) /\ (!P. (!x. P x ==> fl(l) x) /\ (?x. P x) ==> (?y. P y /\ (!z. P z ==> l(y,z))))`;; (* ------------------------------------------------------------------------ *) (* General (reflexive) notion of initial segment. *) (* ------------------------------------------------------------------------ *) parse_as_infix("inseg",(12,"right"));; let inseg = new_definition `(l:A#A->bool) inseg m <=> !x y. l(x,y) <=> m(x,y) /\ fl(l) y`;; let INSEG_ANTISYM = prove (`!l m:A#A->bool. l inseg m /\ m inseg l ==> l = m`, REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM] THEN REWRITE_TAC[inseg] THEN MESON_TAC[]);; let INSEG_REFL = prove (`!l:A#A->bool. l inseg l`, REWRITE_TAC[inseg; fl] THEN MESON_TAC[]);; let INSEG_TRANS = prove (`!l m n:A#A->bool. l inseg m /\ m inseg n ==> l inseg n`, REWRITE_TAC[inseg; fl] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------ *) (* Specific form of initial segment: `all elements in fl(l) less than a`. *) (* ------------------------------------------------------------------------ *) let linseg = new_definition `linseg (l:A#A->bool) a = \(x,y). l(x,y) /\ (less l)(y,a)`;; (* ------------------------------------------------------------------------ *) (* `Ordinals`, i.e. canonical wosets using choice operator. *) (* ------------------------------------------------------------------------ *) let ordinal = new_definition `ordinal(l:A#A->bool) <=> woset(l) /\ (!x. fl(l) x ==> (x = (@) (\y. ~(less l)(y,x))))`;; (* ------------------------------------------------------------------------ *) (* Now useful things about the orderings *) (* ------------------------------------------------------------------------ *) let [POSET_REFL; POSET_TRANS; POSET_ANTISYM] = map (GEN `l:A#A->bool` o DISCH_ALL) (CONJUNCTS(PURE_ONCE_REWRITE_RULE[poset] (ASSUME `poset (l:A#A->bool)`)));; let POSET_FLEQ = prove (`!l:A#A->bool. poset l ==> (!x. fl(l) x <=> l(x,x))`, MESON_TAC[POSET_REFL; fl]);; let CHAIN_SUBSET = prove (`!(l:A#A->bool) P Q. chain(l) P /\ Q SUBSET P ==> chain(l) Q`, REWRITE_TAC[chain; SUBSET_PRED] THEN MESON_TAC[]);; let [WOSET_REFL; WOSET_TRANS; WOSET_ANTISYM; WOSET_TOTAL; WOSET_WELL] = map (GEN `l:A#A->bool` o DISCH_ALL) (CONJUNCTS(PURE_ONCE_REWRITE_RULE[woset] (ASSUME `woset (l:A#A->bool)`)));; let WOSET_POSET = prove (`!l:A#A->bool. woset l ==> poset l`, GEN_TAC THEN REWRITE_TAC[woset; poset] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; let WOSET_FLEQ = prove (`!l:A#A->bool. woset l ==> (!x. fl(l) x <=> l(x,x))`, MESON_TAC[WOSET_POSET; POSET_FLEQ]);; let WOSET_TRANS_LESS = prove (`!l:A#A->bool. woset l ==> !x y z. (less l)(x,y) /\ l(y,z) ==> (less l)(x,z)`, REWRITE_TAC[woset; less] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------ *) (* Wellfoundedness (in two slightly different senses) and either totality *) (* or antisymmetry are sufficient for a wellorder. *) (* ------------------------------------------------------------------------ *) let WOSET = prove (`!l:A#A->bool. woset l <=> (!x y. l(x,y) /\ l(y,x) ==> (x = y)) /\ (!P. (!x. P x ==> fl(l) x) /\ (?x. P x) ==> (?y. P y /\ (!z. P z ==> l(y,z))))`, GEN_TAC THEN REWRITE_TAC[woset] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(!x y z. l(x,y) /\ l(y,z) ==> l(x,z)) /\ (!x:A y. fl(l) x /\ fl(l) y ==> l(x,y) \/ l(y,x))` MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `\w:A. (w = x) \/ (w = y) \/ (w = z)`) THEN REWRITE_TAC[fl]; FIRST_ASSUM(MP_TAC o SPEC `\w:A. (w = x) \/ (w = y)`)] THEN ASM_MESON_TAC[]);; let WOSET_WF = prove (`!l:A#A->bool. woset l <=> WF(\x y. l(x,y) /\ ~(x = y)) /\ (!x y. fl l x /\ fl l y ==> l(x,y) \/ l(y,x))`, GEN_TAC THEN ASM_CASES_TAC `!x y:A. fl l x /\ fl l y ==> l(x,y) \/ l(y,x)` THENL [ASM_REWRITE_TAC[WOSET]; ASM_REWRITE_TAC[woset]] THEN ASM_CASES_TAC `!x y:A. l(x,y) /\ l(y,x) ==> x = y` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[WF]; DISCH_THEN(MP_TAC o MATCH_MP WF_ANTISYM) THEN ASM_MESON_TAC[]] THEN EQ_TAC THENL [DISCH_TAC; MATCH_MP_TAC MONO_FORALL THEN ASM_MESON_TAC[]] THEN X_GEN_TAC `P:A->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:A. P x /\ fl l x`) THEN REWRITE_TAC[fl] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------ *) (* Misc lemmas. *) (* ------------------------------------------------------------------------ *) let PAIRED_EXT = prove (`!(l:A#B->C) m. (!x y. l(x,y) = m(x,y)) <=> (l = m)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `p:A#B` THEN SUBST1_TAC(SYM(SPEC `p:A#B` PAIR)) THEN POP_ASSUM MATCH_ACCEPT_TAC);; let WOSET_TRANS_LE = prove (`!l:A#A->bool. woset l ==> !x y z. l(x,y) /\ (less l)(y,z) ==> (less l)(x,z)`, REWRITE_TAC[less] THEN MESON_TAC[WOSET_TRANS; WOSET_ANTISYM]);; let WOSET_WELL_CONTRAPOS = prove (`!l:A#A->bool. woset l ==> (!P. (!x. P x ==> fl(l) x) /\ (?x. P x) ==> (?y. P y /\ (!z. (less l)(z,y) ==> ~P z)))`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `P:A->bool` o MATCH_MP WOSET_WELL) THEN ASM_MESON_TAC[WOSET_TRANS_LE; less]);; let WOSET_TOTAL_LE = prove (`!l:A#A->bool. woset l ==> !x y. fl(l) x /\ fl(l) y ==> l(x,y) \/ (less l)(y,x)`, REWRITE_TAC[less] THEN MESON_TAC[WOSET_REFL; WOSET_TOTAL]);; let WOSET_TOTAL_LT = prove (`!l:A#A->bool. woset l ==> !x y. fl(l) x /\ fl(l) y ==> (x = y) \/ (less l)(x,y) \/ (less l)(y,x)`, REWRITE_TAC[less] THEN MESON_TAC[WOSET_TOTAL]);; let ORDINAL_IMP_WOSET = prove (`!l:A#A->bool. ordinal l ==> woset l`, SIMP_TAC[ordinal]);; let FL = prove (`!l:A#A->bool. fl l = {x:A | ?y. l(x,y) \/ l(y,x)}`, REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; fl]);; let FL_SUBSET = prove (`!l r. l SUBSET r ==> fl l SUBSET fl r`, REWRITE_TAC[SUBSET; IN; fl] THEN MESON_TAC[]);; let FINITE_FL = prove (`!l:A#A->bool. FINITE(fl l) <=> FINITE l`, GEN_TAC THEN REWRITE_TAC[FL] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP FINITE_CROSS o W CONJ) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_CROSS] THEN SET_TAC[]; DISCH_THEN((fun th -> MP_TAC(ISPEC `FST:A#A->A` th) THEN MP_TAC(ISPEC `SND:A#A->A` th)) o MATCH_MP FINITE_IMAGE) THEN REWRITE_TAC[IMP_IMP; GSYM FINITE_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_CROSS; IN_UNION; IN_IMAGE] THEN REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_THM] THEN REWRITE_TAC[IN] THEN SET_TAC[]]);; let WOSET_FINITE_TOSET = prove (`!l:A#A->bool. toset l /\ FINITE l ==> woset l`, ONCE_REWRITE_TAC[GSYM FINITE_FL] THEN SIMP_TAC[toset; WOSET_WF; poset; IN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC WF_FINITE THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; X_GEN_TAC `a:A`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[fl; IN] THEN ASM_MESON_TAC[]);; (* ======================================================================== *) (* (2) AXIOM OF CHOICE ==> CANTOR-ZERMELO WELLORDERING THEOREM *) (* ======================================================================== *) (* ------------------------------------------------------------------------ *) (* UNIONS of initial segments is an initial segment. *) (* ------------------------------------------------------------------------ *) let UNION_FL = prove (`!P (l:A#A->bool). fl(UNIONS P) x <=> ?l. P l /\ fl(l) x`, REPEAT GEN_TAC THEN REWRITE_TAC[UNIONS_PRED; fl] THEN MESON_TAC[]);; let UNION_INSEG = prove (`!P (l:A#A->bool). (!m. P m ==> m inseg l) ==> (UNIONS P) inseg l`, REWRITE_TAC[inseg; UNION_FL; UNIONS_PRED] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------ *) (* Initial segment of a woset is a woset. *) (* ------------------------------------------------------------------------ *) let INSEG_SUBSET = prove (`!(l:A#A->bool) m. m inseg l ==> !x y. m(x,y) ==> l(x,y)`, REPEAT GEN_TAC THEN REWRITE_TAC[inseg] THEN MESON_TAC[]);; let INSEG_SUBSET_FL = prove (`!(l:A#A->bool) m. m inseg l ==> !x. fl(m) x ==> fl(l) x`, REWRITE_TAC[fl] THEN MESON_TAC[INSEG_SUBSET]);; let INSEG_FL_SUBSET = prove (`!l m:A#A->bool. l inseg m ==> fl l SUBSET fl m`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INSEG_SUBSET_FL) THEN SET_TAC[]);; let INSEG_WOSET = prove (`!(l:A#A->bool) m. m inseg l /\ woset l ==> woset m`, REWRITE_TAC[inseg] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[WOSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[WOSET_ANTISYM]; GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC_ALL o MATCH_MP WOSET_WELL) THEN ASM_MESON_TAC[fl]]);; let INSEG_ORDINAL = prove (`!l m:A#A->bool. m inseg l /\ ordinal l ==> ordinal m`, REPEAT GEN_TAC THEN REWRITE_TAC[ordinal] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[INSEG_WOSET]; ALL_TAC] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP INSEG_SUBSET_FL) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[inseg]) THEN ASM_REWRITE_TAC[less]);; (* ------------------------------------------------------------------------ *) (* Properties of segments of the `linseg` form. *) (* ------------------------------------------------------------------------ *) let LINSEG_INSEG = prove (`!(l:A#A->bool) a. woset l ==> (linseg l a) inseg l`, REPEAT STRIP_TAC THEN REWRITE_TAC[inseg; linseg; fl] THEN PBETA_TAC THEN ASM_MESON_TAC[WOSET_TRANS_LE]);; let LINSEG_WOSET = prove (`!(l:A#A->bool) a. woset l ==> woset(linseg l a)`, MESON_TAC[INSEG_WOSET; LINSEG_INSEG]);; let LINSEG_FL = prove (`!(l:A#A->bool) a x. woset l ==> (fl (linseg l a) x <=> (less l)(x,a))`, REWRITE_TAC[fl; linseg; less] THEN PBETA_TAC THEN MESON_TAC[WOSET_REFL; WOSET_TRANS; WOSET_ANTISYM; fl]);; (* ------------------------------------------------------------------------ *) (* Key fact: a proper initial segment is of the special form. *) (* ------------------------------------------------------------------------ *) let INSEG_PROPER_SUBSET = prove (`!(l:A#A->bool) m. m inseg l /\ ~(l = m) ==> ?x y. l(x,y) /\ ~m(x,y)`, REWRITE_TAC[GSYM PAIRED_EXT] THEN MESON_TAC[INSEG_SUBSET]);; let INSEG_PROPER_SUBSET_FL = prove (`!(l:A#A->bool) m. m inseg l /\ ~(l = m) ==> ?a. fl(l) a /\ ~fl(m) a`, MESON_TAC[INSEG_PROPER_SUBSET; fl; inseg]);; let INSEG_LINSEG = prove (`!(l:A#A->bool) m. woset l ==> (m inseg l <=> (m = l) \/ (?a. fl(l) a /\ (m = linseg l a)))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m:A#A->bool = l` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[inseg; fl] THEN MESON_TAC[]; ALL_TAC] THEN EQ_TAC THEN STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINSEG_INSEG]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP WOSET_WELL_CONTRAPOS) THEN DISCH_THEN(MP_TAC o SPEC `\x:A. fl(l) x /\ ~fl(m) x`) THEN REWRITE_TAC[] THEN REWRITE_TAC[linseg; GSYM PAIRED_EXT] THEN PBETA_TAC THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) THENL [ASM_MESON_TAC[INSEG_PROPER_SUBSET_FL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[INSEG_SUBSET; INSEG_SUBSET_FL; fl; WOSET_TOTAL_LE; less; inseg]);; (* ------------------------------------------------------------------------ *) (* A proper initial segment can be extended by its bounding element. *) (* ------------------------------------------------------------------------ *) let EXTEND_FL = prove (`!(l:A#A->bool) x. woset l ==> (fl (\(x,y). l(x,y) /\ l(y,a)) x <=> l(x,a))`, REPEAT STRIP_TAC THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN ASM_MESON_TAC[WOSET_TRANS; WOSET_REFL; fl]);; let EXTEND_INSEG = prove (`!(l:A#A->bool) a. woset l /\ fl(l) a ==> (\(x,y). l(x,y) /\ l(y,a)) inseg l`, REPEAT STRIP_TAC THEN REWRITE_TAC[inseg] THEN PBETA_TAC THEN REPEAT GEN_TAC THEN IMP_RES_THEN (fun t ->REWRITE_TAC[t]) EXTEND_FL);; let EXTEND_LINSEG = prove (`!(l:A#A->bool) a. woset l /\ fl(l) a ==> (\(x,y). linseg l a (x,y) \/ (y = a) /\ (fl(linseg l a) x \/ (x = a))) inseg l`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC (MATCH_MP EXTEND_INSEG th)) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM PAIRED_EXT] THEN PBETA_TAC THEN REPEAT GEN_TAC THEN IMP_RES_THEN (fun th -> REWRITE_TAC[th]) LINSEG_FL THEN REWRITE_TAC[linseg; less] THEN PBETA_TAC THEN ASM_MESON_TAC[WOSET_REFL]);; (* ------------------------------------------------------------------------ *) (* Key canonicality property of ordinals. *) (* ------------------------------------------------------------------------ *) let ORDINAL_CHAINED_LEMMA = prove (`!(k:A#A->bool) l m. ordinal(l) /\ ordinal(m) ==> k inseg l /\ k inseg m ==> (k = l) \/ (k = m) \/ ?a. fl(l) a /\ fl(m) a /\ (k = linseg l a) /\ (k = linseg m a)`, REPEAT GEN_TAC THEN REWRITE_TAC[ordinal] THEN STRIP_TAC THEN EVERY_ASSUM(fun th -> TRY (fun g -> REWRITE_TAC[MATCH_MP INSEG_LINSEG th] g)) THEN ASM_CASES_TAC `k:A#A->bool = l` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `k:A#A->bool = m` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `a:A = b` (fun th -> ASM_MESON_TAC[th]) THEN FIRST_ASSUM(fun th -> SUBST1_TAC(MATCH_MP th (ASSUME `fl(l) (a:A)`))) THEN FIRST_ASSUM(fun th -> SUBST1_TAC(MATCH_MP th (ASSUME `fl(m) (b:A)`))) THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `k = linseg m (b:A)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[linseg; GSYM PAIRED_EXT] THEN PBETA_TAC THEN ASM_MESON_TAC[WOSET_REFL; less; fl]);; let ORDINAL_CHAINED = prove (`!(l:A#A->bool) m. ordinal(l) /\ ordinal(m) ==> m inseg l \/ l inseg m`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[ordinal] th) THEN ASSUME_TAC (MATCH_MP ORDINAL_CHAINED_LEMMA th)) THEN MP_TAC(SPEC `\k:A#A->bool. k inseg l /\ k inseg m` UNION_INSEG) THEN DISCH_THEN(fun th -> MP_TAC(CONJ (SPEC `l:A#A->bool` th) (SPEC `m:A#A->bool` th))) THEN REWRITE_TAC[TAUT `(a /\ b ==> a) /\ (a /\ b ==> b)`] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN FIRST_ASSUM(REPEAT_TCL DISJ_CASES_THEN MP_TAC o C MATCH_MP th)) THENL [ASM_MESON_TAC[]; ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN MP_TAC(ASSUME `UNIONS (\k. k inseg l /\ k inseg m) = linseg l (a:A)`) THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `(a:A,a)`) THEN REWRITE_TAC[linseg] THEN PBETA_TAC THEN REWRITE_TAC[less] THEN REWRITE_TAC[UNIONS_PRED] THEN EXISTS_TAC `\(x,y). linseg l a (x,y) \/ (y = a) /\ (fl(linseg l a) x \/ (x = a:A))` THEN PBETA_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; UNDISCH_TAC `UNIONS (\k. k inseg l /\ k inseg m) = linseg l (a:A)` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC EXTEND_LINSEG THEN ASM_REWRITE_TAC[]);; let ORDINAL_FL_UNIQUE = prove (`!l m:A#A->bool. ordinal l /\ ordinal m /\ fl l = fl m ==> l = m`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`l:A#A->bool`; `m:A#A->bool`] ORDINAL_CHAINED) THEN REWRITE_TAC[inseg; FUN_EQ_THM; FORALL_PAIR_THM] THEN ASM_MESON_TAC[fl]);; let ORDINAL_FL_SUBSET = prove (`!l m:A#A->bool. ordinal l /\ ordinal m /\ fl l SUBSET fl m ==> l inseg m`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`l:A#A->bool`; `m:A#A->bool`] ORDINAL_CHAINED) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[INSEG_REFL] `x = y ==> x inseg y`) THEN MATCH_MP_TAC ORDINAL_FL_UNIQUE THEN FIRST_ASSUM(MP_TAC o MATCH_MP INSEG_SUBSET_FL) THEN ASM SET_TAC[]);; let ORDINAL_FL_SUBSET_EQ = prove (`!l m:A#A->bool. ordinal l /\ ordinal m ==> (fl l SUBSET fl m <=> l inseg m)`, MESON_TAC[ORDINAL_FL_SUBSET; INSEG_FL_SUBSET]);; (* ------------------------------------------------------------------------ *) (* Proof that any none-universe ordinal can be extended to its "successor". *) (* ------------------------------------------------------------------------ *) let FL_SUC = prove (`!(l:A#A->bool) a. fl(\(x,y). l(x,y) \/ (y = a) /\ (fl(l) x \/ (x = a))) x <=> fl(l) x \/ (x = a)`, REPEAT GEN_TAC THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRY DISJ1_TAC THEN ASM_MESON_TAC[]);; let ORDINAL_SUC = prove (`!l:A#A->bool. ordinal(l) /\ (?x. ~(fl(l) x)) ==> ordinal(\(x,y). l(x,y) \/ (y = @y. ~fl(l) y) /\ (fl(l) x \/ (x = @y. ~fl(l) y)))`, REPEAT GEN_TAC THEN REWRITE_TAC[ordinal] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN ABBREV_TAC `a:A = @y. ~fl(l) y` THEN SUBGOAL_THEN `~fl(l:A#A->bool) a` ASSUME_TAC THENL [EXPAND_TAC "a" THEN CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN PBETA_TAC THEN CONJ_TAC THENL [REWRITE_TAC[WOSET] THEN PBETA_TAC THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[WOSET_ANTISYM]; ALL_TAC; ALL_TAC] THEN UNDISCH_TAC `~fl(l:A#A->bool) a` THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[fl] THENL [EXISTS_TAC `y:A`; EXISTS_TAC `x:A`] THEN ASM_REWRITE_TAC[]; X_GEN_TAC `P:A->bool` THEN REWRITE_TAC[FL_SUC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `w:A`)) THEN IMP_RES_THEN (MP_TAC o SPEC `\x:A. P x /\ fl(l) x`) WOSET_WELL THEN BETA_TAC THEN REWRITE_TAC[TAUT `a /\ b ==> b`] THEN ASM_CASES_TAC `?x:A. P x /\ fl(l) x` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; FIRST_ASSUM(MP_TAC o SPEC `w:A` o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_MESON_TAC[]]]; X_GEN_TAC `z:A` THEN REWRITE_TAC[FL_SUC; less] THEN PBETA_TAC THEN DISCH_THEN DISJ_CASES_TAC THENL [UNDISCH_TAC `!x:A. fl l x ==> (x = (@y. ~less l (y,x)))` THEN DISCH_THEN(IMP_RES_THEN MP_TAC) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:A` THEN BETA_TAC THEN REWRITE_TAC[less] THEN AP_TERM_TAC THEN ASM_CASES_TAC `y:A = z` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `fl(l:A#A->bool) z` THEN ASM_REWRITE_TAC[]; UNDISCH_TAC `z:A = a` THEN DISCH_THEN SUBST_ALL_TAC THEN GEN_REWRITE_TAC LAND_CONV [SYM(ASSUME `(@y:A. ~fl(l) y) = a`)] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:A` THEN BETA_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[] THEN ASM_CASES_TAC `y:A = a` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[fl] THEN EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[]]]);; (* ------------------------------------------------------------------------ *) (* The union of a set of ordinals is an ordinal. *) (* ------------------------------------------------------------------------ *) let ORDINAL_UNION = prove (`!P. (!l:A#A->bool. P l ==> ordinal(l)) ==> ordinal(UNIONS P)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ordinal; WOSET] THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN REWRITE_TAC[UNIONS_PRED] THEN BETA_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `l:A#A->bool` (CONJUNCTS_THEN2 (ANTE_RES_THEN ASSUME_TAC) ASSUME_TAC)) (X_CHOOSE_THEN `m:A#A->bool` (CONJUNCTS_THEN2 (ANTE_RES_THEN ASSUME_TAC) ASSUME_TAC))) THEN MP_TAC(SPECL [`l:A#A->bool`; `m:A#A->bool`] ORDINAL_CHAINED) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL [MP_TAC(SPEC `l:A#A->bool` WOSET_ANTISYM); MP_TAC(SPEC `m:A#A->bool` WOSET_ANTISYM)] THEN RULE_ASSUM_TAC(REWRITE_RULE[ordinal]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET THEN ASM_REWRITE_TAC[]; X_GEN_TAC `Q:A->bool` THEN REWRITE_TAC[UNION_FL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:A`)) THEN MP_TAC(ASSUME `!x:A. Q x ==> (?l. P l /\ fl l x)`) THEN DISCH_THEN(IMP_RES_THEN (X_CHOOSE_THEN `l:A#A->bool` STRIP_ASSUME_TAC)) THEN IMP_RES_THEN ASSUME_TAC (ASSUME `!l:A#A->bool. P l ==> ordinal l`) THEN ASSUME_TAC(CONJUNCT1 (REWRITE_RULE[ordinal] (ASSUME `ordinal(l:A#A->bool)`))) THEN IMP_RES_THEN(MP_TAC o SPEC `\x:A. fl(l) x /\ Q x`) WOSET_WELL THEN BETA_TAC THEN REWRITE_TAC[TAUT `a /\ b ==> a`] THEN SUBGOAL_THEN `?x:A. fl(l) x /\ Q x` (fun th -> REWRITE_TAC[th]) THENL [EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `b:A` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN ANTE_RES_THEN MP_TAC (ASSUME `(Q:A->bool) x`) THEN DISCH_THEN(X_CHOOSE_THEN `m:A#A->bool` STRIP_ASSUME_TAC) THEN ANTE_RES_THEN ASSUME_TAC (ASSUME `(P:(A#A->bool)->bool) m`) THEN MP_TAC(SPECL [`l:A#A->bool`; `m:A#A->bool`] ORDINAL_CHAINED) THEN ASM_REWRITE_TAC[UNIONS_PRED] THEN BETA_TAC THEN DISCH_THEN DISJ_CASES_TAC THENL [EXISTS_TAC `l:A#A->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET_FL THEN ASM_REWRITE_TAC[]; EXISTS_TAC `m:A#A->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPECL [`x:A`; `b:A`] o REWRITE_RULE[inseg]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN IMP_RES_THEN (MP_TAC o SPEC `b:A`) INSEG_SUBSET_FL THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(CONJUNCT1(REWRITE_RULE[ordinal] (ASSUME `ordinal(m:A#A->bool)`))) THEN DISCH_THEN(MP_TAC o SPECL [`b:A`; `x:A`] o MATCH_MP WOSET_TOTAL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (DISJ_CASES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[fl] THEN EXISTS_TAC `b:A` THEN ASM_REWRITE_TAC[]]; X_GEN_TAC `x:A` THEN REWRITE_TAC[UNION_FL] THEN DISCH_THEN(X_CHOOSE_THEN `l:A#A->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ASSUME `!l:A#A->bool. P l ==> ordinal l`) THEN DISCH_THEN(IMP_RES_THEN MP_TAC) THEN REWRITE_TAC[ordinal] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:A`)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN REPEAT AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:A` THEN BETA_TAC THEN AP_TERM_TAC THEN ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[less; UNIONS_PRED] THEN BETA_TAC THEN EQ_TAC THEN DISCH_TAC THENL [EXISTS_TAC `l:A#A->bool` THEN ASM_REWRITE_TAC[]; FIRST_ASSUM(X_CHOOSE_THEN `m:A#A->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `ordinal(l:A#A->bool) /\ ordinal(m:A#A->bool)` MP_TAC THENL [CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(DISJ_CASES_TAC o MATCH_MP ORDINAL_CHAINED)] THENL [IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET THEN ASM_REWRITE_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[inseg]) THEN ASM_REWRITE_TAC[]]]]);; (* ------------------------------------------------------------------------ *) (* Consequently, every type can be wellordered (and by an ordinal). *) (* ------------------------------------------------------------------------ *) let ORDINAL_UNION_LEMMA = prove (`!(l:A#A->bool) x. ordinal l ==> fl(l) x ==> fl(UNIONS(ordinal)) x`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_FL] THEN EXISTS_TAC `l:A#A->bool` THEN ASM_REWRITE_TAC[]);; let ORDINAL_UP = prove (`!l:A#A->bool. ordinal(l) ==> (!x. fl(l) x) \/ (?m x. ordinal(m) /\ fl(m) x /\ ~fl(l) x)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[TAUT `a \/ b <=> ~a ==> b`] THEN GEN_REWRITE_TAC LAND_CONV [NOT_FORALL_THM] THEN DISCH_TAC THEN MP_TAC(SPEC `l:A#A->bool` ORDINAL_SUC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`\(x,y). l(x,y) \/ (y = @y:A. ~fl l y) /\ (fl(l) x \/ (x = @y. ~fl l y))`; `@y. ~fl(l:A#A->bool) y`] THEN ASM_REWRITE_TAC[FL_SUC] THEN CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[]);; let WO_ORDINAL = prove (`?l:A#A->bool. ordinal(l) /\ !x. fl(l) x`, EXISTS_TAC `UNIONS (ordinal:(A#A->bool)->bool)` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC ORDINAL_UNION THEN REWRITE_TAC[]; DISCH_THEN(DISJ_CASES_TAC o MATCH_MP ORDINAL_UP) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(X_CHOOSE_THEN `m:A#A->bool` (X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC)) THEN IMP_RES_THEN (IMP_RES_THEN MP_TAC) ORDINAL_UNION_LEMMA THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------ *) (* At least -- every set can be wellordered. *) (* ------------------------------------------------------------------------ *) let FL_RESTRICT = prove (`!l. woset l ==> !P. fl(\(x:A,y). P x /\ P y /\ l(x,y)) x <=> P x /\ fl(l) x`, REPEAT STRIP_TAC THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRY(EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN NO_TAC) THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] THEN IMP_RES_THEN MATCH_MP_TAC WOSET_REFL THEN REWRITE_TAC[fl] THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]);; let WO = prove (`!P. ?l:A#A->bool. woset l /\ (fl(l) = P)`, GEN_TAC THEN X_CHOOSE_THEN `l:A#A->bool` STRIP_ASSUME_TAC (REWRITE_RULE[ordinal] WO_ORDINAL) THEN EXISTS_TAC `\(x:A,y). P x /\ P y /\ l(x,y)` THEN REWRITE_TAC[WOSET] THEN PBETA_TAC THEN GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FL_RESTRICT th]) THEN PBETA_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP WOSET_ANTISYM) THEN ASM_REWRITE_TAC[]; X_GEN_TAC `Q:A->bool` THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP WOSET_WELL) THEN DISCH_THEN(MP_TAC o SPEC `Q:A->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN REPEAT CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; (* ------------------------------------------------------------------------- *) (* Moreover, the ordinals themselves are wellordered by "inseg". *) (* ------------------------------------------------------------------------- *) let WF_INSEG_WOSET = prove (`WF(\(x:A#A->bool) y. woset x /\ woset y /\ x inseg y /\ ~(x = y))`, REWRITE_TAC[WF] THEN X_GEN_TAC `P:(A#A->bool)->bool` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP] THEN DISCH_TAC THEN SUBGOAL_THEN `!x:A#A->bool. P x ==> woset x` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!y. ?(a:A) z. P y ==> P z /\ fl y a /\ linseg y a = z` MP_TAC THENL [X_GEN_TAC `y:A#A->bool` THEN ASM_CASES_TAC `(P:(A#A->bool)->bool) y` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `y:A#A->bool`)) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[INSEG_LINSEG]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:(A#A->bool)->A`; `l:(A#A->bool)->(A#A->bool)`] THEN DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `z:A#A->bool`) THEN SUBGOAL_THEN `woset(z:A#A->bool)` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[woset]] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `{(a:(A#A->bool)->A) x | P x /\ x inseg z}`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[TAUT `P /\ x = y <=> x = y /\ P`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM; SWAP_FORALL_THM] THEN REWRITE_TAC[UNWIND_THM2; FORALL_UNWIND_THM2; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM; SWAP_FORALL_THM] THEN REWRITE_TAC[UNWIND_THM2; FORALL_UNWIND_THM2; IMP_CONJ; RIGHT_FORALL_IMP_THM; NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[INSEG_SUBSET_FL]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[INSEG_REFL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `w:A#A->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `(l:(A#A->bool)->(A#A->bool)) w`) THEN ASM_SIMP_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[LINSEG_INSEG; INSEG_TRANS]; DISCH_TAC] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `(l:(A#A->bool)->(A#A->bool)) w` th) THEN MP_TAC(SPEC `w:A#A->bool` th)) THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `fl ((l:(A#A->bool)->(A#A->bool)) w) (a (l w))` THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SYM th]) THEN ASM_SIMP_TAC[LINSEG_FL; less] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[inseg]) THEN ASM_MESON_TAC[]);; let WOSET_INSEG_ORDINAL = prove (`woset (\(x:A#A->bool,y). ordinal x /\ ordinal y /\ x inseg y)`, REWRITE_TAC[WOSET_WF; fl] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[ORDINAL_CHAINED]] THEN MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] WF_SUBSET) WF_INSEG_WOSET) THEN SIMP_TAC[ordinal]);; let SUBWOSET_ISO_INSEG = prove (`!l s. woset l /\ fl l = (:A) ==> ?f. (!x y. x IN s /\ y IN s ==> (l(f x,f y) <=> l(x,y))) /\ (!x y. y IN IMAGE f s /\ l(x,y) ==> x IN IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o last o CONJUNCTS o GEN_REWRITE_RULE I [woset]) THEN DISCH_THEN(MP_TAC o GEN `s:A->bool` o SPEC `\x:A. x IN s`) THEN ASM_REWRITE_TAC[UNIV; MEMBER_NOT_EMPTY] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:(A->bool)->A` THEN DISCH_TAC THEN SUBGOAL_THEN `?f:A->A. !x. f(x) = m (UNIV DIFF IMAGE f {u | u IN s /\ less l (u,x)})` MP_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE[WOSET_WF]) THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP WF_REC) THEN REWRITE_TAC[less] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `f:A->A` THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `!x. x IN s ==> (l:A#A->bool)(f x,x)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE[WOSET_WF]) THEN REWRITE_TAC[WF_IND] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(:A) DIFF IMAGE (f:A->A) {u | u IN s /\ less l (u,x)}`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MATCH_MP_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP MONO_FORALL o GEN `x:A` o SPEC `(:A) DIFF IMAGE (f:A->A) {u | u IN s /\ less l (u,x)}`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]; FIRST_X_ASSUM(K ALL_TAC o CONV_RULE (BINDER_CONV SYM_CONV))] THEN REWRITE_TAC[IN_UNIV; IN_IMAGE; IN_DIFF; IN_ELIM_THM; FORALL_AND_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!x z:A. x IN s /\ less l (z,f x) ==> ?u. u IN s /\ less l (u,x) /\ f u = z` ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x z:A. x IN s /\ l(z,f x) ==> ?u. u IN s /\ l(u,x) /\ f u = z` ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [SUBGOAL_THEN `!x y:A. x IN s /\ y IN s /\ less l (x,y) ==> less l (f x,f y)` MP_TAC THENL [REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `(f:A->A) y`])) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]; MATCH_MP_TAC(MESON[] `(!x y. P x y /\ P y x ==> Q x y) ==> (!x y. P x y) ==> (!x y. Q x y)`) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]]; REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[less; woset] THEN SET_TAC[]]);; (* ======================================================================== *) (* (3) CANTOR-ZERMELO WELL-ORDERING THEOREM ==> HAUSDORFF MAXIMAL PRINCIPLE *) (* ======================================================================== *) let HP = prove (`!l:A#A->bool. poset l ==> ?P. chain(l) P /\ !Q. chain(l) Q /\ P SUBSET Q ==> (Q = P)`, GEN_TAC THEN DISCH_TAC THEN X_CHOOSE_THEN `w:A#A->bool` MP_TAC (SPEC `\x:A. T` WO) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [FUN_EQ_THM] THEN BETA_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN IMP_RES_THEN (MP_TAC o SPEC `\x:A. fl(l) x`) WOSET_WELL THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `?x:A. fl(l) x` THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC); FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN EXISTS_TAC `\x:A. F` THEN REWRITE_TAC[chain; SUBSET_PRED] THEN GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:A` MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPECL [`u:A`; `u:A`]) THEN IMP_RES_THEN(ASSUME_TAC o GSYM) POSET_FLEQ THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `?f. !x. f x = if fl(l) x /\ (!y. less w (y,x) ==> l (x,f y) \/ l (f y,x)) then (x:A) else b` (CHOOSE_TAC o GSYM) THENL [SUBGOAL_THEN `WF(\x:A y. (less w)(x,y))` MP_TAC THENL [REWRITE_TAC[WF] THEN GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC_ALL o MATCH_MP WOSET_WELL) THEN ASM_REWRITE_TAC[less] THEN ASM_MESON_TAC[WOSET_ANTISYM]; DISCH_THEN(MATCH_MP_TAC o MATCH_MP WF_REC) THEN REWRITE_TAC[] THEN REPEAT GEN_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN IMP_RES_THEN(IMP_RES_THEN ASSUME_TAC) POSET_REFL THEN SUBGOAL_THEN `(f:A->A) b = b` ASSUME_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `b:A`) THEN REWRITE_TAC[COND_ID] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:A. fl(l:A#A->bool) (f x)` ASSUME_TAC THENL [GEN_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `x:A`) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ANTE_RES_THEN (ASSUME_TAC o GEN_ALL) o SPEC_ALL) THEN SUBGOAL_THEN `!x:A. (l:A#A->bool)(b,f x) \/ l(f x,b)` ASSUME_TAC THENL [GEN_TAC THEN MP_TAC(SPEC `x:A` (ASSUME `!x:A. (w:A#A->bool)(b,f x)`)) THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `x:A`) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `x:A = b` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `(less w)(b:A,x)` MP_TAC THENL [ASM_REWRITE_TAC[less] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th o CONJUNCT2)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x y. l((f:A->A) x,f y) \/ l(f y,f x)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN IMP_RES_THEN(MP_TAC o SPECL [`x:A`; `y:A`]) WOSET_TOTAL_LT THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL [ASM_REWRITE_TAC[] THEN IMP_RES_THEN MATCH_MP_TAC POSET_REFL; ONCE_REWRITE_TAC[DISJ_SYM] THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `y:A`); FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `x:A`)] THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(IMP_RES_THEN ACCEPT_TAC o CONJUNCT2); ALL_TAC] THEN EXISTS_TAC `\y:A. ?x:A. y = f(x)` THEN SUBGOAL_THEN `chain(l:A#A->bool)(\y. ?x:A. y = f x)` ASSUME_TAC THENL [REWRITE_TAC[chain] THEN BETA_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(CHOOSE_THEN SUBST1_TAC)); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `Q:A->bool` THEN STRIP_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `z:A` THEN EQ_TAC THENL [DISCH_TAC THEN BETA_TAC THEN EXISTS_TAC `z:A` THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `z:A`) THEN SUBGOAL_THEN `fl(l:A#A->bool) z /\ !y. (less w)(y,z) ==> l(z,f y) \/ l(f y,z)` (fun th -> REWRITE_TAC[th]) THEN CONJ_TAC THENL [UNDISCH_TAC `chain(l:A#A->bool) Q` THEN REWRITE_TAC[chain] THEN DISCH_THEN(MP_TAC o SPECL [`z:A`; `z:A`]) THEN ASM_REWRITE_TAC[fl] THEN DISCH_TAC THEN EXISTS_TAC `z:A` THEN ASM_REWRITE_TAC[]; X_GEN_TAC `y:A` THEN DISCH_TAC THEN UNDISCH_TAC `chain(l:A#A->bool) Q` THEN REWRITE_TAC[chain] THEN DISCH_THEN(MP_TAC o SPECL [`z:A`; `(f:A->A) y`]) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET_PRED]) THEN BETA_TAC THEN EXISTS_TAC `y:A` THEN REFL_TAC]; SPEC_TAC(`z:A`,`z:A`) THEN ASM_REWRITE_TAC[GSYM SUBSET_PRED]]);; (* ======================================================================== *) (* (4) HAUSDORFF MAXIMAL PRINCIPLE ==> ZORN'S LEMMA *) (* ======================================================================== *) let ZL = prove (`!l:A#A->bool. poset l /\ (!P. chain(l) P ==> (?y. fl(l) y /\ !x. P x ==> l(x,y))) ==> ?y. fl(l) y /\ !x. l(y,x) ==> (y = x)`, GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `M:A->bool` STRIP_ASSUME_TAC o MATCH_MP HP) THEN UNDISCH_TAC `!P. chain(l:A#A->bool) P ==> (?y. fl(l) y /\ !x. P x ==> l(x,y))` THEN DISCH_THEN(MP_TAC o SPEC `M:A->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:A` THEN DISCH_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN DISCH_TAC THEN SUBGOAL_THEN `chain(l) (\x:A. M x \/ (x = z))` MP_TAC THENL [REWRITE_TAC[chain] THEN BETA_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN ASM_REWRITE_TAC[] THENL [UNDISCH_TAC `chain(l:A#A->bool) M` THEN REWRITE_TAC[chain] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; DISJ1_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP POSET_TRANS) THEN EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISJ2_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP POSET_TRANS) THEN EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP POSET_REFL) THEN REWRITE_TAC[fl] THEN EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `M SUBSET (\x:A. M x \/ (x = z))` MP_TAC THENL [REWRITE_TAC[SUBSET_PRED] THEN GEN_TAC THEN BETA_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN GEN_REWRITE_TAC I [TAUT `(a ==> b ==> c) <=> (b /\ a ==> c)`] THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `z:A`) THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN FIRST_ASSUM(MP_TAC o SPECL [`m:A`; `z:A`] o MATCH_MP POSET_ANTISYM) THEN ASM_REWRITE_TAC[]);; (* ======================================================================== *) (* (5) ZORN'S LEMMA ==> KURATOWSKI'S LEMMA *) (* ======================================================================== *) let KL_POSET_LEMMA = prove (`poset (\(c1,c2). C SUBSET c1 /\ c1 SUBSET c2 /\ chain(l:A#A->bool) c2)`, REWRITE_TAC[poset] THEN PBETA_TAC THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `P:A->bool` THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN DISCH_THEN(X_CHOOSE_THEN `Q:A->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[SUBSET_REFL] THENL [MATCH_MP_TAC CHAIN_SUBSET; MATCH_MP_TAC SUBSET_TRANS]; GEN_TAC THEN X_GEN_TAC `Q:A->bool` THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS; REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM] THEN TRY(EXISTS_TAC `Q:A->bool`) THEN ASM_REWRITE_TAC[]);; let KL = prove (`!l:A#A->bool. poset l ==> !C. chain(l) C ==> ?P. (chain(l) P /\ C SUBSET P) /\ (!R. chain(l) R /\ P SUBSET R ==> (R = P))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\(c1,c2). C SUBSET c1 /\ c1 SUBSET c2 /\ chain(l:A#A->bool) c2` ZL) THEN PBETA_TAC THEN REWRITE_TAC[KL_POSET_LEMMA; MATCH_MP POSET_FLEQ KL_POSET_LEMMA] THEN PBETA_TAC THEN W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL [X_GEN_TAC `P:(A->bool)->bool` THEN GEN_REWRITE_TAC LAND_CONV [chain] THEN PBETA_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `?D:A->bool. P D` THENL [EXISTS_TAC `UNIONS(P) :A->bool` THEN REWRITE_TAC[SUBSET_REFL] THEN FIRST_ASSUM(X_CHOOSE_TAC `D:A->bool`) THEN FIRST_ASSUM(MP_TAC o SPECL [`D:A->bool`; `D:A->bool`]) THEN REWRITE_TAC[ASSUME `(P:(A->bool)->bool) D`; SUBSET_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> (a /\ b) /\ c`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_PRED; SUBSET_PRED] THEN REPEAT STRIP_TAC THEN BETA_TAC THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET_PRED]) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[chain; UNIONS_PRED] THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN BETA_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `A:A->bool`) (X_CHOOSE_TAC `B:A->bool`)) THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN DISCH_THEN(MP_TAC o SPECL [`A:A->bool`; `B:A->bool`]) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [UNDISCH_TAC `chain(l:A#A->bool) B`; UNDISCH_TAC `chain(l:A#A->bool) A`] THEN REWRITE_TAC[chain] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET_PRED]) THEN ASM_REWRITE_TAC[]; STRIP_TAC THEN X_GEN_TAC `X:A->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`X:A->bool`; `X:A->bool`]) THEN REWRITE_TAC[] THEN DISCH_THEN(IMP_RES_THEN STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[UNIONS_PRED; SUBSET_PRED] THEN REPEAT STRIP_TAC THEN BETA_TAC THEN EXISTS_TAC `X:A->bool` THEN ASM_REWRITE_TAC[]]; EXISTS_TAC `C:A->bool` THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN ASM_REWRITE_TAC[SUBSET_REFL]]; DISCH_THEN(X_CHOOSE_THEN `D:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Special case of Zorn's Lemma for restriction of subset lattice. *) (* ------------------------------------------------------------------------- *) let POSET_RESTRICTED_SUBSET = prove (`!P. poset(\(x,y). P(x) /\ P(y) /\ x SUBSET y)`, GEN_TAC THEN REWRITE_TAC[poset; fl] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[SUBSET; EXTENSION] THEN MESON_TAC[]);; let FL_RESTRICTED_SUBSET = prove (`!P. fl(\(x,y). P(x) /\ P(y) /\ x SUBSET y) = P`, REWRITE_TAC[fl; FORALL_PAIR_THM; FUN_EQ_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[SUBSET_REFL]);; let ZL_SUBSETS = prove (`!P. (!c. (!x. x IN c ==> P x) /\ (!x y. x IN c /\ y IN c ==> x SUBSET y \/ y SUBSET x) ==> ?z. P z /\ (!x. x IN c ==> x SUBSET z)) ==> ?a:A->bool. P a /\ (!x. P x /\ a SUBSET x ==> (a = x))`, GEN_TAC THEN MP_TAC(ISPEC `\(x,y). P(x:A->bool) /\ P(y) /\ x SUBSET y` ZL) THEN REWRITE_TAC[POSET_RESTRICTED_SUBSET; FL_RESTRICTED_SUBSET] THEN REWRITE_TAC[chain] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [MATCH_MP_TAC MONO_FORALL; ALL_TAC] THEN MESON_TAC[]);; let ZL_SUBSETS_UNIONS = prove (`!P. (!c. (!x. x IN c ==> P x) /\ (!x y. x IN c /\ y IN c ==> x SUBSET y \/ y SUBSET x) ==> P(UNIONS c)) ==> ?a:A->bool. P a /\ (!x. P x /\ a SUBSET x ==> (a = x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ZL_SUBSETS THEN REPEAT STRIP_TAC THEN EXISTS_TAC `UNIONS(c:(A->bool)->bool)` THEN ASM_MESON_TAC[SUBSET; IN_UNIONS]);; let ZL_SUBSETS_UNIONS_NONEMPTY = prove (`!P. (?x. P x) /\ (!c. (?x. x IN c) /\ (!x. x IN c ==> P x) /\ (!x y. x IN c /\ y IN c ==> x SUBSET y \/ y SUBSET x) ==> P(UNIONS c)) ==> ?a:A->bool. P a /\ (!x. P x /\ a SUBSET x ==> (a = x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ZL_SUBSETS THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `?x:A->bool. x IN c` THENL [EXISTS_TAC `UNIONS(c:(A->bool)->bool)` THEN ASM_SIMP_TAC[] THEN MESON_TAC[SUBSET; IN_UNIONS]; ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A form of Tukey's lemma. *) (* ------------------------------------------------------------------------- *) let TUKEY = prove (`!s:(A->bool)->bool. ~(s = {}) /\ (!t. (!c. FINITE c /\ c SUBSET t ==> c IN s) <=> t IN s) ==> ?u. u IN s /\ !v. v IN s /\ u SUBSET v ==> u = v`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ZL_SUBSETS_UNIONS_NONEMPTY THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:(A->bool)->bool` THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN SUBGOAL_THEN `!d. FINITE d ==> d SUBSET UNIONS c ==> ?e:A->bool. e IN c /\ d SUBSET e` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_FORALL THEN ASM SET_TAC[]] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INSERT_SUBSET] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Also the order extension theorem, using Abian's proof. *) (* ------------------------------------------------------------------------- *) let OEP = prove (`!p:A#A->bool. poset p ==> ?t. toset t /\ fl(t) = fl(p) /\ p SUBSET t`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `fl(p:A#A->bool)` WO) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `w:A#A->bool` STRIP_ASSUME_TAC) THEN ABBREV_TAC `t = \(x:A,y:A). fl p x /\ fl p y /\ (x = y \/ ?i. fl p i /\ (!j. w(j,i) /\ ~(j = i) ==> (p(j,x) <=> p(j,y))) /\ ~p(i,x) /\ p(i,y))` THEN EXISTS_TAC `t:A#A->bool` THEN SUBGOAL_THEN `!x:A y:A. fl p x /\ fl p y /\ ~(x = y) ==> ?i. fl p i /\ (!j:A. w(j,i) /\ ~(j = i) ==> (p(j,x) <=> p(j,y))) /\ ~(p(i,x) <=> p(i,y))` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [woset]) THEN ASM_SIMP_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `\i:A. fl p i /\ ~(p(i,x) <=> p(i,y))`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [poset]) THEN ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:A` THEN ASM_MESON_TAC[fl]]; ALL_TAC] THEN SUBGOAL_THEN `!x:A y:A. p(x,y) ==> t(x,y)` ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[fl]; ALL_TAC]) THEN ASM_CASES_TAC `x:A = y` THENL [ASM_MESON_TAC[fl]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPECL [`x:A`; `y:A`]) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[fl]; MATCH_MP_TAC MONO_EXISTS] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [poset]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN] THEN EXPAND_TAC "t" THEN REWRITE_TAC[fl] THEN ASM_MESON_TAC[]; DISCH_TAC THEN ASM_REWRITE_TAC[toset; poset]] THEN EXPAND_TAC "t" THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [poset]) THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:A`; `y:A`; `z:A`] THEN ASM_CASES_TAC `x:A = z` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN ASM_CASES_TAC `y:A = z` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN ASM_CASES_TAC `fl p (x:A)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `fl p (y:A)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `fl p (z:A)` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `n:A` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [woset]) THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPECL [`m:A`; `n:A`] o CONJUNCT1) THEN ANTS_TAC THENL [ASM_MESON_TAC[fl]; ALL_TAC] THEN STRIP_TAC THENL [EXISTS_TAC `m:A`; EXISTS_TAC `n:A`] THEN ASM_MESON_TAC[]; MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `fl p (x:A)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `fl p (y:A)` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `n:A` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [woset]) THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPECL [`m:A`; `n:A`] o CONJUNCT1) THEN ASM_MESON_TAC[]; MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[IN] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPECL [`x:A`; `y:A`]) THEN ASM_REWRITE_TAC[OR_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Every toset contains a cofinal woset. *) (* ------------------------------------------------------------------------- *) let TOSET_COFINAL_WOSET = prove (`!l. toset l ==> ?w. w SUBSET l /\ woset w /\ !x:A. x IN fl l ==> ?y. y IN fl w /\ l(x,y)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `fl l:A->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN EXISTS_TAC `(\(x,y). F):A#A->bool` THEN ASM_REWRITE_TAC[woset; FORALL_PAIR_THM; fl; SUBSET] THEN REWRITE_TAC[IN] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?r. ordinal r /\ fl r = (:A->bool)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNIV] THEN REWRITE_TAC[IN; WO_ORDINAL]; ALL_TAC] THEN SUBGOAL_THEN `?f. !w. f w = if ?x:A. x IN fl l /\ !v:A->bool. r(v,w) /\ ~(v = w) ==> ~l(x,f v) then @x:A. x IN fl l /\ !v. r(v,w) /\ ~(v = w) ==> ~l(x,f v) else @x:A. x IN fl l` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP ORDINAL_IMP_WOSET) THEN REWRITE_TAC[WOSET_WF] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP WF_REC o CONJUNCT1) THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(p <=> p') /\ x' = x ==> (if p then x else a) = (if p' then x' else a)`) THEN CONJ_TAC THENL [ALL_TAC; AP_TERM_TAC THEN ABS_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!w. (f:(A->bool)->A) w IN fl l` ASSUME_TAC THENL [GEN_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `?w:A->bool. (!x. x IN fl l ==> ?v. r(v,w) /\ ~(v = w) /\ l(x:A,f v)) /\ !z. (!x. x IN fl l ==> ?v. r(v,z) /\ ~(v = z) /\ l(x,f v)) ==> r(w,z)` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o last o CONJUNCTS o REWRITE_RULE[woset] o MATCH_MP ORDINAL_IMP_WOSET) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[MESON[] `(?w. P w) <=> ~(!w. ~P w)`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM; TAUT `~(p /\ q /\ r) <=> (p /\ q ==> ~r)`] THEN DISCH_TAC THEN SUBGOAL_THEN `!v w:A->bool. f v:A = f w ==> v = w` MP_TAC THENL [FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS o REWRITE_RULE[woset] o MATCH_MP ORDINAL_IMP_WOSET) THEN FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[UNIV] THEN MATCH_MP_TAC(MESON[] `(!x y. P x y ==> P y x) /\ (!x y. R x y ==> P x y) ==> (!x y. R x y \/ R y x) ==> (!x y. P x y)`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM(fun t -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [t]) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(y = @x. P x) ==> (?x. P x) ==> P y`)) THEN ASM_SIMP_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[toset]) THEN ASM_MESON_TAC[]; REWRITE_TAC[INJECTIVE_LEFT_INVERSE; NOT_EXISTS_THM] THEN X_GEN_TAC `g:A->(A->bool)` THEN DISCH_THEN(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!x y. r(x,y) /\ r(y,w) /\ ~(y = w) ==> l((f:(A->bool)->A) x,f y)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(l(a,b) \/ l(b,a)) /\ (~(b = a) ==> ~l(b,a)) ==> l(a,b)`) THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[toset]) THEN ASM SET_TAC[]; DISCH_THEN(ASSUME_TAC o MATCH_MP (MESON[] `~(f x = f y) ==> ~(x = y)`))] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [th]) THEN COND_CASES_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o SELECT_RULE) THEN ASM_REWRITE_TAC[]; FIRST_ASSUM(MP_TAC o REWRITE_RULE[woset] o MATCH_MP ORDINAL_IMP_WOSET) THEN ASM_MESON_TAC[]]; ALL_TAC] THEN EXISTS_TAC `\(x,y). x IN IMAGE (f:(A->bool)->A) {v | r(v,w) /\ ~(v = w)} /\ y IN IMAGE (f:(A->bool)->A) {v | r(v,w) /\ ~(v = w)} /\ l(x,y)` THEN SUBGOAL_THEN `fl(\(x,y). x IN IMAGE (f:(A->bool)->A) {v | r(v,w) /\ ~(v = w)} /\ y IN IMAGE (f:(A->bool)->A) {v | r(v,w) /\ ~(v = w)} /\ l(x,y)) = IMAGE f {v | r(v,w) /\ ~(v = w)}` ASSUME_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN REWRITE_TAC[IN; fl] THEN RULE_ASSUM_TAC(REWRITE_RULE[toset]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN]; ASM_REWRITE_TAC[REWRITE_RULE[SET_RULE `fl l x <=> x IN fl l`] woset]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN ASM SET_TAC[]] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [toset]) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [poset]) THEN RULE_ASSUM_TAC(REWRITE_RULE[SET_RULE `fl l x <=> x IN fl l`]) THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ASM SET_TAC[]; SIMP_TAC[]] THEN X_GEN_TAC `P:A->bool` THEN REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORDINAL_IMP_WOSET) THEN REWRITE_TAC[woset] THEN DISCH_THEN(MP_TAC o SPEC `\x:A->bool. (P:A->bool) (f x)` o last o CONJUNCTS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:(A->bool)->A) z` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!z. P z ==> z IN IMAGE f s) ==> (!x. x IN s /\ P(f x) ==> Q(f x)) ==> !y. P y ==> Q y`)) THEN X_GEN_TAC `y:A->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; ASM SET_TAC[]]);; hol-light/Makefile000066400000000000000000000201461303454263000144100ustar00rootroot00000000000000############################################################################### # Makefile for HOL Light # # # # Simple "make" just builds the camlp4 syntax extension "pa_j.cmo", which is # # necessary to load the HOL Light core into the OCaml toplevel. # # # # The later options such as "make hol" create standalone images, but only # # work under Linux when the "ckpt" checkpointing program is installed. # # # # See the README file for more detailed information about the build process. # # # # Thanks to Carl Witty for 3.07 and 3.08 ports of pa_j.ml and this process. # ############################################################################### # Installation directory for standalone binaries. Set here to the user's # binary directory. You may want to change it to something like /usr/local/bin BINDIR=${HOME}/bin # This is the list of source files in the HOL Light core HOLSRC=system.ml lib.ml fusion.ml basics.ml nets.ml preterm.ml \ parser.ml printer.ml equal.ml bool.ml drule.ml tactics.ml \ itab.ml simp.ml theorems.ml ind_defs.ml class.ml trivia.ml \ canon.ml meson.ml metis.ml quot.ml recursion.ml pair.ml \ nums.ml arith.ml wf.ml calc_num.ml normalizer.ml grobner.ml \ ind_types.ml lists.ml realax.ml calc_int.ml realarith.ml \ real.ml calc_rat.ml int.ml sets.ml iterate.ml cart.ml define.ml \ help.ml database.ml update_database.ml # Some parameters to help decide how to build things OCAML_VERSION=`ocamlc -version | cut -c1-4` OCAML_BINARY_VERSION=`ocamlc -version | cut -c1-3` CAMLP5_BINARY_VERSION=`camlp5 -v 2>&1 | cut -f3 -d' ' | cut -c1` CAMLP5_VERSION=`camlp5 -v 2>&1 | cut -f3 -d' ' | cut -f1-3 -d'.' | cut -c1-6` # Build the camlp4 syntax extension file (camlp5 for OCaml >= 3.10) pa_j.cmo: pa_j.ml; if test ${OCAML_BINARY_VERSION} = "3.0" ; \ then ocamlc -c -pp "camlp4r pa_extend.cmo q_MLast.cmo" -I `camlp4 -where` pa_j.ml ; \ else if test ${OCAML_BINARY_VERSION} = "3.1" -o ${OCAML_VERSION} = "4.00" -o ${OCAML_VERSION} = "4.01" -o ${OCAML_VERSION} = "4.02" -o ${OCAML_VERSION} = "4.03" ; \ then ocamlc -c -pp "camlp5r pa_lexer.cmo pa_extend.cmo q_MLast.cmo" -I `camlp5 -where` pa_j.ml ; \ else ocamlc -safe-string -c -pp "camlp5r pa_lexer.cmo pa_extend.cmo q_MLast.cmo" -I `camlp5 -where` pa_j.ml ; \ fi \ fi # Choose an appropriate camlp4 or camlp5 syntax extension. # # For OCaml < 3.10 (OCAML_BINARY_VERSION = "3.0"), this uses the built-in # camlp4, and in general there are different versions for each OCaml version # # For OCaml >= 3.10 (OCAML_BINARY_VERSION = "3.1" or "4.x"), this uses the # separate program camlp5. Now the appropriate syntax extensions is determined # based on the camlp5 version. The main distinction is < 6.00 and >= 6.00, but # there are some other incompatibilities, unfortunately. pa_j.ml: pa_j_3.07.ml pa_j_3.08.ml pa_j_3.09.ml pa_j_3.1x_5.xx.ml pa_j_3.1x_6.xx.ml; \ if test ${OCAML_BINARY_VERSION} = "3.0" ; \ then cp pa_j_${OCAML_VERSION}.ml pa_j.ml ; \ else if test ${CAMLP5_VERSION} = "6.02.1" ; \ then cp pa_j_3.1x_6.02.1.ml pa_j.ml; \ else if test ${CAMLP5_VERSION} = "6.02.2" -o ${CAMLP5_VERSION} = "6.02.3" -o ${CAMLP5_VERSION} = "6.03" -o ${CAMLP5_VERSION} = "6.04" -o ${CAMLP5_VERSION} = "6.05" -o ${CAMLP5_VERSION} = "6.06" ; \ then cp pa_j_3.1x_6.02.2.ml pa_j.ml; \ else if test ${CAMLP5_VERSION} = "6.06" -o ${CAMLP5_VERSION} = "6.07" -o ${CAMLP5_VERSION} = "6.08" -o ${CAMLP5_VERSION} = "6.09" -o ${CAMLP5_VERSION} = "6.10" -o ${CAMLP5_VERSION} = "6.11" -o ${CAMLP5_VERSION} = "6.12" -o ${CAMLP5_VERSION} = "6.13" -o ${CAMLP5_VERSION} = "6.14" -o ${CAMLP5_VERSION} = "6.15" -o ${CAMLP5_VERSION} = "6.16" ; \ then cp pa_j_3.1x_6.11.ml pa_j.ml; \ else cp pa_j_3.1x_${CAMLP5_BINARY_VERSION}.xx.ml pa_j.ml; \ fi \ fi \ fi \ fi # Build a standalone hol image called "hol" (needs Linux and ckpt program) hol: pa_j.cmo ${HOLSRC} update_database.ml; \ if test `uname` = Linux; then \ echo -e '#use "make.ml";;\nloadt "update_database.ml";;\nself_destruct "";;' | ckpt -a SIGUSR1 -n hol.snapshot ocaml;\ mv hol.snapshot hol; \ else \ echo '******************************************************'; \ echo 'FAILURE: Image build assumes Linux and ckpt program'; \ echo '******************************************************'; \ fi # Build an image with multivariate calculus preloaded. hol.multivariate: ./hol \ Library/card.ml Library/permutations.ml Library/products.ml \ Library/floor.ml Multivariate/misc.ml Library/iter.ml \ Multivariate/metric.ml Multivariate/vectors.ml \ Multivariate/determinants.ml Multivariate/topology.ml \ Multivariate/convex.ml Multivariate/paths.ml \ Multivariate/polytope.ml Multivariate/degree.ml \ Multivariate/derivatives.ml Multivariate/clifford.ml \ Multivariate/integration.ml Multivariate/measure.ml \ Multivariate/multivariate_database.ml update_database.ml; \ echo -e 'loadt "Multivariate/make.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with multivariate analysis";;' | ./hol; mv hol.snapshot hol.multivariate; # Build an image with analysis and SOS procedure preloaded hol.sosa: ./hol \ Library/analysis.ml Library/transc.ml \ Examples/sos.ml update_database.ml; \ echo -e 'loadt "Library/analysis.ml";;\nloadt "Library/transc.ml";;\nloadt "Examples/sos.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with analysis and SOS";;' | ./hol; mv hol.snapshot hol.sosa; # Build an image with cardinal arithmetic preloaded hol.card: ./hol Library/card.ml; update_database.ml; \ echo -e 'loadt "Library/card.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with cardinal arithmetic";;' | ./hol; mv hol.snapshot hol.card; # Build an image with multivariate-based complex analysis preloaded hol.complex: ./hol.multivariate \ Library/binomial.ml Multivariate/complexes.ml \ Multivariate/canal.ml Multivariate/transcendentals.ml \ Multivariate/realanalysis.ml Multivariate/moretop.ml \ Multivariate/cauchy.ml Multivariate/complex_database.ml \ update_database.ml; \ echo -e 'loadt "Multivariate/complexes.ml";;\nloadt "Multivariate/canal.ml";;\nloadt "Multivariate/transcendentals.ml";;\nloadt "Multivariate/realanalysis.ml";;\nloadt "Multivariate/cauchy.ml";;\nloadt "Multivariate/complex_database.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with multivariate-based complex analysis";;' | ./hol.multivariate; mv hol.snapshot hol.complex; # Build all those all: hol hol.multivariate hol.sosa hol.card hol.complex; # Build binaries and copy them to binary directory install: hol hol.multivariate hol.sosa hol.card hol.complex; cp hol hol.multivariate hol.sosa hol.card hol.complex ${BINDIR} # Clean up all compiled files clean:; rm -f pa_j.ml pa_j.cmi pa_j.cmo hol hol.multivariate hol.sosa hol.card hol.complex; hol-light/Minisat/000077500000000000000000000000001303454263000143515ustar00rootroot00000000000000hol-light/Minisat/CREDITS000066400000000000000000000005431303454263000153730ustar00rootroot00000000000000(* * Original HOL4 code for satisfiability testing by Mike Gordon (2004) * DIMACS cnf parsing code improved by Ken Friis Larsen (2004?) * MiniSat proof reconstruction and HOL Light port by Hasan Amjad (2005-6) * Implicit definitional CNF and minor improvements by John Harrison (2006-7) * zChaff to MiniSat proof translator by Hasan Amjad (2007) *) hol-light/Minisat/README000066400000000000000000000035261303454263000152370ustar00rootroot00000000000000This code interfaces HOL Light to the MiniSat propositional prover, so that the proof logs produced by MiniSat can be turned into HOL Light derivations. The code also supports zChaff by using a translator from zChaff to MiniSat proof format. See the subdirectory "zc2mso" and the README file there for more information about the use of zChaff. Most of this code was written by Hasan Amjad (see CREDITS for more detail). To use this code, you need to have a copy of MiniSat, specifically its proof-logging version "MiniSat-p" installed. For downloads, see: http://minisat.se/MiniSat.html By default, the code will look for MiniSat on your PATH. If it doesn't find it, you can explicitly indicate the directory that contains the MiniSat binary by changing the assignment of the variable "satdir" defined on line 63, e.g. let satdir = "/home/johnh/bin/" (The expected name for the binary within this directory is "minisat" or "minsat.exe" according to platform. You can change this if desired by modifying "SatSolvers.ml".) Then you can load the code from this directory #use "Minisat/make.ml";; and a new tautology-proving function SAT_PROVE is made available. This can be used either to prove tautologies: # SAT_PROVE `p ==> p`;; val it : thm = |- p ==> p or to provide, via an exception, a counterexample for non-tautologies: # SAT_PROVE `p==> q`;; Exception: Sat_counterexample |- ~q /\ p ==> ~(p ==> q). There is a file here called "taut.ml" containing some larger examples. Note that the code uses OCaml's string [Str] library. This is normally loaded dynamically, but on some platforms such as Cygwin you may need to construct a new OCaml toplevel explicitly including it before loading HOL Light, using for example: ocamlmktop -o ocamlnumunixstr unix.cma nums.cma str.cma since HOL Light already needs the "Unix" and "num" libraries anyway. hol-light/Minisat/dimacs_tools.ml000066400000000000000000000210141303454263000173610ustar00rootroot00000000000000 (*open satCommonTools;;*) (* translation from terms to DIMACS cnf and back *) (* mapping from HOL variable names to DIMACS variable numbers is stored in a global assignable (i.e. reference) variable sat_var_map. The type of sat_var_map is (int * (term * int) map) ref and the integer first component is the next available number (i.e. it is one plus the number of elements in the map) in th second component (t,n), if n<0 then the literal represented is ~t (the stored t is never negated) *) (* initialise sat_var_map to integer 1 paired with the empty map (in DIMACS variable numbering starts from 1 because 0 is the clause separator) *) let sat_var_map = ref(1, Termmap.empty) let sat_var_arr = ref(Array.make 0 t_tm) (* varnum->+ve lit. *) (* Reinitialise sat_var_map. Needs to be done for each translation of a term to DIMACS as numbers must be an initial segment of 1,2,3,... (otherwise grasp, zchaff etc may crash) *) (*+1 'cos var numbers start at 1*) let initSatVarMap var_count = (sat_var_map := (1, Termmap.empty); sat_var_arr := Array.make (var_count+1) t_tm) (* Lookup the var number corresponding to a +ve literal s, possibly extending sat_var_map *) let lookup_sat_var s = let (c,svm) = !sat_var_map in snd (try Termmap.find s svm with Not_found -> let svm' = Termmap.add s (s,c) svm in let _ = (sat_var_map := (c+1,svm')) in let _ = try (Array.set (!sat_var_arr) c s) with Invalid_argument _ -> failwith ("lookup_sat_varError: "^(string_of_term s)^"::"^(string_of_int c)^"\n") in (t_tm,c)) (* Lookup the +ve lit corresponding to a var number *) let lookup_sat_num n = try (Array.get (!sat_var_arr) n) with Invalid_argument _ -> failwith ("lookup_sat_numError: "^(string_of_int n)^"\n") (* Show sat_var_map as a list of its elements *) let showSatVarMap () = let (c,st) = !sat_var_map in (c, List.map snd (tm_listItems st)) (* Print a term showing types *) let all_string_of_term t = ((string_of_term) t^" : "^(string_of_type (type_of t))) let print_all_term t = print_string (all_string_of_term t);; (* Convert a literal to a (bool * integer) pair, where the boolean is true iff the literal is negated, if necessary extend sat_var_map *) exception Lit_to_int_err of string let literalToInt t = let (sign,v) = if is_neg t then let t1 = dest_neg t in if type_of t1 = bool_ty then (true, t1) else raise (Lit_to_int_err (all_string_of_term t)) else if type_of t = bool_ty then (false, t) else raise (Lit_to_int_err (all_string_of_term t)) in let v_num = lookup_sat_var v in (sign, v_num) (* Convert an integer (a possibly negated var number) to a literal, raising lookup_sat_numError if the absolute value of the integer isn't in sat_var_map *) let intToLiteral n = let t = lookup_sat_num (abs n) in if n>=0 then t else mk_neg t (* termToDimacs t checks t is CNF of the form ``(v11 \/ ... \/ v1p) /\ (v21 \/ ... \/ v2q) /\ ... /\ (vr1 \/ ... \/vrt)`` where vij is a literal, i.e. a boolean variable or a negated boolean variable. If t is such a CNF then termToDimacs t returns a list of lists of integers [[n11,...,n1p],[n21,...,n2q], ... , [nr1,...,nrt]] If vij is a boolean variable ``v`` then nij is the entry for v in sat_var_map. If vij is ``~v``, then nij is the negation of the entry for v in sat_var_map N.B. Definition of termToDimacs processes last clause first, so variables are not numbered in the left-to-right order. Not clear if this matters. *) let termToDimacs t = List.fold_right (fun c d -> (List.map literalToInt (disjuncts c)) :: d) (conjuncts t) [] (* Test data val t1 = ``x:bool``; val t2 = ``~x``; val t3 = ``x \/ y \/ ~z \/ w``; val t4 = ``(x \/ y \/ ~z \/ w) /\ (~w \/ ~x \/ y)``; val t5 = ``(x \/ y \/ ~z \/ w) /\ !x. (~w \/ ~x \/ y)``; val t6 = ``(x \/ y \/ ~z \/ w) /\ (~w)``; val t7 = ``(x \/ y \/ ~z \/ w) /\ (~w) /\ (w \/ x) /\ (p /\ q /\ r)``; *) (* reference containing prefix used to make variables from numbers when reading DIMACS *) let prefix = ref "v" (* intToPrefixedLiteral n = ``(!prefix)n`` intToPrefixedLiteral (~n) = ``~(!prefix)n`` *) let intToPrefixedLiteral n = if n >= 0 then mk_var(((!prefix) ^ (string_of_int n)), bool_ty) else mk_neg(mk_var((!prefix) ^ (string_of_int(abs n)), bool_ty)) (* buildClause [n1,...,np] builds ``(!prefix)np /\ ... /\ (!prefix)n1`` Raises exception Empty on the empty list *) let buildClause l = List.fold_left (fun t n -> mk_disj(intToPrefixedLiteral n, t)) (intToPrefixedLiteral (hd l)) (tl l) (* dimacsToTerm l converts a list of integers [n11,...,n1p,0,n21,...,n2q,0, ... , 0,nr1,...,nrt,0] into a term in CNF of the form ``(v11 \/ ... \/ v1p) /\ (v21 \/ ... \/ v2q) /\ ... /\ (vr1 \/ ... \/vrt)`` where vij is a literal, i.e. a boolean variable or a negated boolena variable. If nij is non-negative then vij is ``(!prefix)nij``; If nij is negative ~mij then vij is ``~(!prefix)mij``; *) (* dimacsToTerm_aux splits off one clause, dimacsToTerm iterates it *) let rec dimacsToTerm_aux acc = function [] -> (buildClause acc,[]) | (0::l) -> (buildClause acc,l) | (x::l) -> dimacsToTerm_aux (x::acc) l let rec dimacsToTerm l = let (t,l1) = dimacsToTerm_aux [] l in if List.length l1 = 0 then t else mk_conj(t, dimacsToTerm l1) (* Convert (true,n) to "-n" and (false,n) to "n" *) let literalToString b n = if b then ("-" ^ (string_of_int n)) else string_of_int n (* termToDimacsFile t converts t to DIMACS and then writes out a file into the temporary directory. the name of the temporary file (without extension ".cnf") is returned. *) (* Refererence containing name of temporary file used for last invocation of a SAT solver *) let tmp_name = ref "undefined" let termToDimacsFile fname t var_count = let clause_count = List.length(conjuncts t) in let _ = initSatVarMap var_count in let dlist = termToDimacs t in let tmp = Filename.temp_file "sat" "" in let tmpname = match fname with (Some fname) -> fname^".cnf" | None -> tmp^".cnf" in let outstr = open_out tmpname in let out s = output_string outstr s in let res = (out "c File "; out tmpname; out " generated by HolSatLib\n"; out "c\n"; out "p cnf "; out (string_of_int var_count); out " "; out (string_of_int clause_count); out "\n"; List.iter (fun l -> (List.iter (fun (x,y) -> (out(literalToString x y); out " ")) l; out "\n0\n")) dlist; close_out outstr; tmp_name := tmp; match fname with (Some _) -> tmpname | None -> tmp) in res;; (* readDimacs filename reads a DIMACS file called filename and returns a term in CNF in which each number n in the DIMACS file is a boolean variable (!prefix)n Code below by Ken Larsen (replaces earlier implementation by MJCG) *) exception Read_dimacs_error;; let rec dropLine ins = match Stream.peek ins with Some '\n' -> Stream.junk ins | Some _ -> (Stream.junk ins; dropLine ins) | None -> raise Read_dimacs_error let rec stripPreamble ins = match Stream.peek ins with Some 'c' -> (dropLine ins; stripPreamble ins) | Some 'p' -> (dropLine ins; stripPreamble ins) | Some _ -> Some () | None -> None let rec getIntClause lex acc = match (try Stream.next lex with Stream.Failure -> Genlex.Kwd "EOF" (* EOF *)) with (Genlex.Int 0) -> Some acc | (Genlex.Int i) -> getIntClause lex (i::acc) | (Genlex.Kwd "EOF") -> if List.length acc = 0 then None else Some acc | _ -> raise Read_dimacs_error (* This implementation is inspired by (and hopefully faithful to) dimacsToTerm. *) let getTerms lex = let rec loop acc = match getIntClause lex [] with Some ns -> loop (mk_conj(buildClause ns, acc)) | None -> Some acc in match getIntClause lex [] with Some ns -> loop (buildClause ns) | None -> None let readTerms ins = match stripPreamble ins with Some _ -> let lex = (Genlex.make_lexer ["EOF"] ins) in getTerms lex | None -> None let readDimacs filename = (*let val fullfilename = Path.mkAbsolute(filename, FileSys.getDir())*) let inf = Pervasives.open_in filename in let ins = Stream.of_channel inf in let term = readTerms ins in (close_in inf; match term with Some t -> t | None -> raise Read_dimacs_error) hol-light/Minisat/make.ml000066400000000000000000000004451303454263000156230ustar00rootroot00000000000000#load "str.cma";; loads "Minisat/sat_common_tools.ml";; loads "Minisat/dimacs_tools.ml";; loads "Minisat/sat_solvers.ml";; loads "Minisat/sat_script.ml";; loads "Minisat/sat_tools.ml";; loads "Minisat/minisat_parse.ml";; loads "Minisat/minisat_resolve.ml";; loads "Minisat/minisat_prove.ml";; hol-light/Minisat/minisat_parse.ml000066400000000000000000000161251303454263000175460ustar00rootroot00000000000000(*open satCommonTools dimacsTools;; *) (* parse minisat proof log into array cl. array elements are either root clauses or resolution chains for deriving the learnt clauses. Last chain derives empty clause *) type rootc = Rthm of thm * Litset.t * term * thm | Ll of term * Litset.t type clause = Blank | Chain of (int * int) list * int (* var, cl index list and the length of that list *) | Root of rootc | Learnt of thm * Litset.t (* clause thm, lits as nums set *) let sat_fileopen s = open_in_bin s let sat_fileclose is = close_in is let sat_getChar is = Int32.of_int(input_byte is) (* copied from Minisat-p_v1.14::File::getUInt*) (* this is technically able to parse int32's but no *) (* point since we return int's always *) (* FIXME: no idea what will happen on a 64-bit arch *) let sat_getint is = let (land) = Int32.logand in let (lor) = Int32.logor in let (lsl) = Int32.shift_left in let (lsr) = Int32.shift_right in let byte0 = sat_getChar is in if ((byte0 land (0x80l))=(0x0l)) (* 8 *) then Int32.to_int(byte0) else match Int32.to_int((byte0 land (0x60l)) lsr 5) with 0 -> let byte1 = sat_getChar is in Int32.to_int(((byte0 land (0x1Fl)) lsl 8) lor byte1) (* 16 *) | 1 -> let byte1 = sat_getChar is in let byte2 = sat_getChar is in Int32.to_int( (((byte0 land (0x1Fl)) lsl 16) lor (byte1 lsl 8)) lor byte2) | 2 -> let byte1 = sat_getChar is in let byte2 = sat_getChar is in let byte3 = sat_getChar is in Int32.to_int(((((byte0 land (0x1Fl)) lsl 24) lor (byte1 lsl 16)) lor (byte2 lsl 8)) lor byte3) (* default case is only where int64 is needed since we do a lsl 32*) | _ -> let byte0 = sat_getChar is in let byte1 = sat_getChar is in let byte2 = sat_getChar is in let byte3 = sat_getChar is in let byte4 = sat_getChar is in let byte5 = sat_getChar is in let byte6 = sat_getChar is in let byte7 = sat_getChar is in Int32.to_int((((byte0 lsl 24) lor (byte1 lsl 16) lor (byte2 lsl 8) lor byte3) lsl 32) lor ((byte4 lsl 24) lor (byte5 lsl 16) lor (byte6 lsl 8) lor byte7)) let isRootClauseIdx cl ci = match Array.get cl ci with Root _ -> true | _ -> false (* p is a literal *) (* this mapping allows shadow ac-normalisation which keeps the lits for a given var together *) (* the -1 is because literalToInt returns HolSatLib var numbers (base 1) *) let literalToInt2 p = let (sign,vnum) = literalToInt p in 2*(vnum-1)+(if sign then 1 else 0) let literalToInt3 p = let (sign,vnum) = literalToInt p in (sign,vnum-1) (* parse a root clause *) let getIntRoot fin idx = let rec loop idx' acc = let v = sat_getint fin in if v=0 then idx::(List.rev acc) else loop (idx'+v) ((idx'+v)::acc) in let res = loop idx [] in res (*l1 and l2 are number reps of lits. Are they complements? *) let is_compl l1 l2 = (abs(l2-l1)=1) && (l1 mod 2 = 0) (*il is clause input from minisat proof trace, sl is internal clause sorted and unduped, with diff in var numbering account for *) (* thus if il and sl are not exactly the same, then the clause represented by sl was skipped *) let isSameClause (il,sl) = (Pervasives.compare il sl = 0) let rec getNextRootClause scl vc cc lr il rcv = let rc = Array.get rcv lr in let rcl = disjuncts rc in let lnl = List.map literalToInt3 rcl in let lns = List.fold_left (fun s e -> Litset.add e s) Litset.empty lnl in let slnl = (* FIXME: speed this up*) List.sort Pervasives.compare (setify (List.map (fun (isn,vi) -> if isn then 2*vi+1 else 2*vi) lnl)) in if isSameClause(il,slnl) then (Array.set scl lr cc;(lr,(rc,lns))) else getNextRootClause scl vc cc (lr+1) il rcv (* this advances the file read pointer but we pick up the actual clause from the list of clauses we already have this is because minisatp removes duplicate literals and sorts the literals so I can't efficiently find the corresponding clause term in HOL. assert: minisatp logs the root clauses in order of input*) let addClause scl vc cc lr rcv fin sr lit1 = let l = getIntRoot fin (lit1 lsr 1) in let res = match l with [] -> failwith ("addClause:Failed parsing clause "^(string_of_int (cc))^"\n") | _ -> let (lr,(t,lns)) = getNextRootClause scl vc cc lr l rcv in (cc+1,lr+1,(Root (Ll (t,lns)))::sr) in res (* parse resolve chain *) let getIntBranch fin id h = let rec loop acc len = (*-1 is purely a decoding step *) (* (i.e. not translating b/w HolSat and ms)*) let v = (sat_getint fin)-1 in if v=(-1) then ((v,h)::(List.rev acc),len+1) else let ci = id-(sat_getint fin) in loop ((v,ci)::acc) (len+1) in let res = loop [] 0 in res let addBranch fin sr cc id tc = let (br,brl) = getIntBranch fin id (id-(tc lsr 1)) in let res = if brl=1 (*(tl br = []) *) then (cc,false,sr) (* delete *) else (cc+1,true,(Chain (br,brl))::sr) (* resolve *) in res (*this is modelled on MiniSat::Proof::traverse, except we first read in everything then resolve backwards *) (*sr is stack for originally reading in the clauses *) (*lr is unskipped root clause count. *) (*cc is clause count (inc learnt) *) let rec readTrace_aux scl vc cc lr rcv fin sr id = let tmp,eof = try sat_getint fin,false with End_of_file -> 42,true in if eof then (cc,sr) else if (tmp land 1)=0 then let (cc,lr,sr) = addClause scl vc cc lr rcv fin sr tmp in readTrace_aux scl vc cc lr rcv fin sr (id+1) else let (cc,isch,sr') = addBranch fin sr cc id tmp in if isch then readTrace_aux scl vc cc lr rcv fin sr' (id+1) (* chain *) else readTrace_aux scl vc cc lr rcv fin sr' id (* deletion *) ;; (*fill in the root clause and chain array*) let parseTrace nr fname vc rcv = try let fin = sat_fileopen fname in let scl = Array.make nr (-1) in (*cl[scl[i]]=rcv[i] or scl[i]=~1 if rcv[i] was trivial *) let (cc,sr) = readTrace_aux scl vc 0 0 rcv fin [] 0 in let _ = sat_fileclose fin in Some (cc,sr,scl) with Sys_error _ -> None let getChain = function Chain (vcl,vcll) -> vcl | _ -> failwith("getChain: not a Chain") (*make backwards pass through cl, returning only the chains actually used in deriving F*) let rec mk_sk cl ca ci = let ch = List.fold_left (fun ch (v,cci) -> if (Array.get ca cci) || (isRootClauseIdx cl cci) then ch else (mk_sk cl ca cci)::ch) [] (getChain (Array.get cl ci)) in (Array.set ca ci true;ci::(List.concat ch)) let parseMinisatProof nr fname vc rcv = match parseTrace nr fname vc rcv with Some (cc,sr,scl) -> let srl = List.length sr in (*stores clauses as root clauses, learnt clauses or unresolved chains *) let cl = Array.make srl Blank in let _ = List.fold_left (fun i c -> (Array.set cl (i-1) c;i-1)) cc sr in let sk = mk_sk cl (Array.make srl false) (cc-1) in Some (cl,sk,scl,srl,cc) | None -> None hol-light/Minisat/minisat_prove.ml000066400000000000000000000256661303454263000176010ustar00rootroot00000000000000(* open satTools dimacsTools SatSolvers minisatResolve satCommonTools minisatParse satScript def_cnf *) (* for interactive use: #load "str.cma";; #use "def_cnf.ml";; #use "satCommonTools.ml";; #use "dimacsTools.ml";; #use "SatSolvers.ml";; #use "satScript.ml";; #use "satTools.ml";; #use "minisatParse.ml";; #use "minisatResolve.ml";; #use "minisatProve.ml";; #use "taut.ml";; *) (* ------------------------------------------------------------------------- *) (* Flag to (de-)activate debugging facilities. *) (* ------------------------------------------------------------------------- *) let sat_debugging = ref false;; (* ------------------------------------------------------------------------- *) (* Split up a theorem according to conjuncts, in a general sense. *) (* ------------------------------------------------------------------------- *) let GCONJUNCTS = let [pth_ni1; pth_ni2; pth_no1; pth_no2; pth_an1; pth_an2; pth_nn] = (map UNDISCH_ALL o CONJUNCTS o TAUT) `(~(p ==> q) ==> p) /\ (~(p ==> q) ==> ~q) /\ (~(p \/ q) ==> ~p) /\ (~(p \/ q) ==> ~q) /\ (p /\ q ==> p) /\ (p /\ q ==> q) /\ (~ ~p ==> p)` in let p_tm = concl pth_an1 and q_tm = concl pth_an2 in let rec GCONJUNCTS th acc = match (concl th) with Comb(Const("~",_),Comb(Comb(Const("==>",_),p),q)) -> GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_ni1)) (GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_ni2)) acc) | Comb(Const("~",_),Comb(Comb(Const("\\/",_),p),q)) -> GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_no1)) (GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_no2)) acc) | Comb(Comb(Const("/\\",_),p),q) -> GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_an1)) (GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_an2)) acc) | Comb(Const("~",_),Comb(Const("~",_),p)) -> GCONJUNCTS (PROVE_HYP th (INST [p,p_tm] pth_nn)) acc | _ -> th::acc in fun th -> GCONJUNCTS th [];; (* ------------------------------------------------------------------------- *) (* Generate fresh variable names (could just use genvars). *) (* ------------------------------------------------------------------------- *) let propvar i = mk_var("x"^string_of_int i,bool_ty);; (* ------------------------------------------------------------------------- *) (* Set up the basic definitional arrangement. *) (* ------------------------------------------------------------------------- *) let rec localdefs tm (n,defs,lfn) = if is_neg tm then let n1,v1,defs1,lfn1 = localdefs (rand tm) (n,defs,lfn) in let tm' = mk_neg v1 in try (n1,apply defs1 tm',defs1,lfn1) with Failure _ -> let n2 = n1 + 1 in let v2 = propvar n2 in n2,v2,(tm' |-> v2) defs1,(v2 |-> tm) lfn1 else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then let n1,v1,defs1,lfn1 = localdefs (lhand tm) (n,defs,lfn) in let n2,v2,defs2,lfn2 = localdefs (rand tm) (n1,defs1,lfn1) in let tm' = mk_comb(mk_comb(rator(rator tm),v1),v2) in try (n2,apply defs2 tm',defs2,lfn2) with Failure _ -> let n3 = n2 + 1 in let v3 = propvar n3 in n3,v3,(tm' |-> v3) defs2,(v3 |-> tm) lfn2 else try (n,apply defs tm,defs,lfn) with Failure _ -> let n1 = n + 1 in let v1 = propvar n1 in n1,v1,(tm |-> v1) defs,(v1 |-> tm) lfn;; (* ------------------------------------------------------------------------- *) (* Just translate to fresh variables, but otherwise leave unchanged. *) (* ------------------------------------------------------------------------- *) let rec transvar (n,tm,vdefs,lfn) = if is_neg tm then let n1,tm1,vdefs1,lfn1 = transvar (n,rand tm,vdefs,lfn) in n1,mk_comb(rator tm,tm1),vdefs1,lfn1 else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then let n1,tm1,vdefs1,lfn1 = transvar (n,lhand tm,vdefs,lfn) in let n2,tm2,vdefs2,lfn2 = transvar (n1,rand tm,vdefs1,lfn1) in n2,mk_comb(mk_comb(rator(rator tm),tm1),tm2),vdefs2,lfn2 else try n,apply vdefs tm,vdefs,lfn with Failure _ -> let n1 = n + 1 in let v1 = propvar n1 in n1,v1,(tm |-> v1) vdefs,(v1 |-> tm) lfn;; (* ------------------------------------------------------------------------- *) (* Flag to choose whether to exploit existing conjunctive structure. *) (* ------------------------------------------------------------------------- *) let exploit_conjunctive_structure = ref true;; (* ------------------------------------------------------------------------- *) (* Check if something is clausal (slightly stupid). *) (* ------------------------------------------------------------------------- *) let is_literal tm = is_var tm || is_neg tm && is_var(rand tm);; let is_clausal tm = let djs = disjuncts tm in forall is_literal djs && list_mk_disj djs = tm;; (* ------------------------------------------------------------------------- *) (* Now do the definitional arrangement but not wastefully at the top. *) (* ------------------------------------------------------------------------- *) let definitionalize = let transform_imp = let pth = TAUT `(p ==> q) <=> ~p \/ q` in let ptm = rand(concl pth) in let p_tm = rand(lhand ptm) and q_tm = rand ptm in fun th -> let ip,q = dest_comb(concl th) in let p = rand ip in EQ_MP (INST [p,p_tm; q,q_tm] pth) th and transform_iff_1 = let pth = UNDISCH(TAUT `(p <=> q) ==> (p \/ ~q)`) in let ptm = concl pth in let p_tm = lhand ptm and q_tm = rand(rand ptm) in fun th -> let ip,q = dest_comb(concl th) in let p = rand ip in PROVE_HYP th (INST [p,p_tm; q,q_tm] pth) and transform_iff_2 = let pth = UNDISCH(TAUT `(p <=> q) ==> (~p \/ q)`) in let ptm = concl pth in let p_tm = rand(lhand ptm) and q_tm = rand ptm in fun th -> let ip,q = dest_comb(concl th) in let p = rand ip in PROVE_HYP th (INST [p,p_tm; q,q_tm] pth) in let definitionalize th (n,tops,defs,lfn) = let t = concl th in if is_clausal t then let n',v,defs',lfn' = transvar (n,t,defs,lfn) in (n',(v,th)::tops,defs',lfn') else if is_neg t then let n1,v1,defs1,lfn1 = localdefs (rand t) (n,defs,lfn) in (n1,(mk_neg v1,th)::tops,defs1,lfn1) else if is_disj t then let n1,v1,defs1,lfn1 = localdefs (lhand t) (n,defs,lfn) in let n2,v2,defs2,lfn2 = localdefs (rand t) (n1,defs1,lfn1) in (n2,(mk_disj(v1,v2),th)::tops,defs2,lfn2) else if is_imp t then let n1,v1,defs1,lfn1 = localdefs (lhand t) (n,defs,lfn) in let n2,v2,defs2,lfn2 = localdefs (rand t) (n1,defs1,lfn1) in (n2,(mk_disj(mk_neg v1,v2),transform_imp th)::tops,defs2,lfn2) else if is_iff t then let n1,v1,defs1,lfn1 = localdefs (lhand t) (n,defs,lfn) in let n2,v2,defs2,lfn2 = localdefs (rand t) (n1,defs1,lfn1) in (n2,(mk_disj(v1,mk_neg v2),transform_iff_1 th):: (mk_disj(mk_neg v1,v2),transform_iff_2 th)::tops,defs2,lfn2) else let n',v,defs',lfn' = localdefs t (n,defs,lfn) in (n',(v,th)::tops,defs',lfn') in definitionalize;; (* SAT_PROVE is the main interface function. Takes in a term t and returns thm or exception if not a taut *) (* invokes minisatp, returns |- t or |- model ==> ~t *) (* if minisatp proof log does not exist after minisatp call returns, we will assume that minisatp discovered UNSAT during the read-in phase and did not bother with a proof log. In that case the problem is simple and can be delegated to TAUT *) (* FIXME: I do not like the TAUT solution; what is trivial for Minisat may not be so for TAUT *) exception Sat_counterexample of thm;; (* delete temporary files *) (* if zChaff was used, also delete hard-wired trace filenames*) let CLEANUP fname solvername = let delete fname = try Sys.remove fname with Sys_error _ -> () in (delete fname; delete (fname^".cnf"); delete (fname^"."^solvername); delete (fname^"."^solvername^".proof"); delete (fname^"."^solvername^".stats"); if solvername="zchaff" then (delete(Filename.concat (!temp_path) "resolve_trace"); delete(Filename.concat (!temp_path) "zc2mso_trace")) else ());; let GEN_SAT_PROVE solver solvername = let false_tm = `F` and presimp_conv = GEN_REWRITE_CONV DEPTH_CONV [NOT_CLAUSES; AND_CLAUSES; OR_CLAUSES; IMP_CLAUSES; EQ_CLAUSES] and p_tm = `p:bool` and q_tm = `q:bool` and pth_triv = TAUT `(~p <=> F) <=> p` and pth_main = UNDISCH_ALL(TAUT `(~p <=> q) ==> (q ==> F) ==> p`) in let triv_rule p th = EQ_MP(INST [p,p_tm] pth_triv) th and main_rule p q sth th = itlist PROVE_HYP [sth; DISCH_ALL th] (INST [p,p_tm; q,q_tm] pth_main) in let invoke_minisat lfn mcth stm t rcv vc = let nr = Array.length rcv in let res = match invokeSat solver None t (Some vc) with Some model -> let model2 = mapfilter (fun l -> let x = hd(frees l) in let y = apply lfn x in if is_var y then vsubst [y,x] l else fail()) model in satCheck model2 stm | None -> (match parseMinisatProof nr ((!tmp_name)^"."^solvername^".proof") vc rcv with Some (cl,sk,scl,srl,cc) -> unsatProveResolve lfn mcth (cl,sk,srl) (* returns p |- F *) | None -> UNDISCH(TAUT(mk_imp(stm,false_tm)))) in res in fun tm -> let sth = presimp_conv (mk_neg tm) in let stm = rand(concl sth) in if stm = false_tm then triv_rule tm sth else let th = ASSUME stm in let ths = if !exploit_conjunctive_structure then GCONJUNCTS th else [th] in let n,tops,defs,lfn = itlist definitionalize ths (-1,[],undefined,undefined) in let defg = foldl (fun a t nv -> (t,nv)::a) [] defs in let mdefs = filter (fun (r,_) -> not (is_var r)) defg in let eqs = map (fun (r,l) -> mk_iff(l,r)) mdefs in let clausify eq cls = let fvs = frees eq and eth = (NNFC_CONV THENC CNF_CONV) eq in let tth = INST (map (fun v -> apply lfn v,v) fvs) eth in let xth = ADD_ASSUM stm (EQ_MP tth (REFL(apply lfn (lhand eq)))) in zip (conjuncts(rand(concl eth))) (CONJUNCTS xth) @ cls in let all_clauses = itlist clausify eqs tops in let mcth = itlist (fun (c,th) m -> Termmap.add c th m) all_clauses Termmap.empty in let vc = n + 1 in let rcv = Array.of_list (map fst all_clauses) in let ntdcnf = list_mk_conj (map fst all_clauses) in let th = invoke_minisat lfn mcth stm ntdcnf rcv vc in (if not (!sat_debugging) then CLEANUP (!tmp_name) solvername else (); if is_imp(concl th) then raise (Sat_counterexample (EQ_MP (AP_TERM (rator(concl th)) (SYM sth)) th)) else main_rule tm stm sth th);; let SAT_PROVE = GEN_SAT_PROVE minisatp "minisatp";; let ZSAT_PROVE = GEN_SAT_PROVE zchaff "zchaff";; hol-light/Minisat/minisat_resolve.ml000066400000000000000000000104511303454263000201070ustar00rootroot00000000000000(*open satCommonTools dimacsTools minisatParse satScript*) (* functions for replaying minisat proof LCF-style. Called from minisatProve.ml after proof log has been parsed. *) (* p is a literal *) let toVar p = if is_neg p then rand p else p;; let (NOT_NOT_ELIM,NOT_NOT_CONV) = let t = mk_var("t",bool_ty) in let NOT_NOT2 = SPEC_ALL NOT_NOT in ((fun th -> EQ_MP (INST [rand(rand(concl th)),t] NOT_NOT2) th), (fun tm -> INST [rand(rand tm),t] NOT_NOT2));; let l2hh = function h0::h1::t -> (h0,h1,t) | _ -> failwith("Match failure in l2hh");; (*+1 because minisat var numbers start at 0, dimacsTools at 1*) let mk_sat_var lfn n = let rv = lookup_sat_num (n+1) in tryapplyd lfn rv rv;; let get_var_num lfn v = lookup_sat_var v - 1;; (* mcth maps clause term t to thm of the form cnf |- t, *) (* where t is a clause of the cnf term *) let dualise = let pth_and = TAUT `F \/ F <=> F` and pth_not = TAUT `~T <=> F` in let rec REFUTE_DISJ tm = match tm with Comb(Comb(Const("\\/",_) as op,l),r) -> TRANS (MK_COMB(AP_TERM op (REFUTE_DISJ l),REFUTE_DISJ r)) pth_and | Comb(Const("~",_) as l,r) -> TRANS (AP_TERM l (EQT_INTRO(ASSUME r))) pth_not | _ -> ASSUME(mk_iff(tm,f_tm)) in fun lfn -> let INSTANTIATE_ALL_UNDERLYING th = let fvs = thm_frees th in let tms = map (fun v -> tryapplyd lfn v v) fvs in INST (zip tms fvs) th in fun mcth t -> EQ_MP (INSTANTIATE_ALL_UNDERLYING(REFUTE_DISJ t)) (Termmap.find t mcth),t_tm,TRUTH;; (* convert clause term to dualised thm form on first use *) let prepareRootClause lfn mcth cl (t,lns) ci = let (th,dl,cdef) = dualise lfn mcth t in let _ = Array.set cl ci (Root (Rthm (th,lns,dl,cdef))) in (th,lns);; (* will return clause info at index ci *) exception Fn_get_clause__match;; exception Fn_get_root_clause__match;; (* will return clause info at index ci *) let getRootClause cl ci = let res = match (Array.get cl ci) with Root (Rthm (t,lns,dl,cdef)) -> (t,lns,dl,cdef) | _ -> raise Fn_get_root_clause__match in res;; (* will return clause thm at index ci *) let getClause lfn mcth cl ci = let res = match (Array.get cl ci) with Root (Ll (t,lns)) -> prepareRootClause lfn mcth cl (t,lns) ci | Root (Rthm (t,lns,dl,cdef)) -> (t,lns) | Chain _ -> raise Fn_get_clause__match | Learnt (th,lns) -> (th,lns) | Blank -> raise Fn_get_clause__match in res;; (* ground resolve clauses c0 and c1 on v, where v is the only var that occurs with opposite signs in c0 and c1 *) (* if n0 then v negated in c0 *) (* (but remember we are working with dualised clauses) *) let resolve = let pth = UNDISCH(TAUT `F ==> p`) in let p = concl pth and f_tm = hd(hyp pth) in fun v n0 rth0 rth1 -> let th0 = DEDUCT_ANTISYM_RULE (INST [v,p] pth) (if n0 then rth0 else rth1) and th1 = DEDUCT_ANTISYM_RULE (INST [mk_iff(v,f_tm),p] pth) (if n0 then rth1 else rth0) in EQ_MP th1 th0;; (* resolve c0 against c1 wrt v *) let resolveClause lfn mcth cl vi rci (c0i,c1i) = let ((rth0,lns0),(rth1,lns1)) = pair_map (getClause lfn mcth cl) (c0i,c1i) in let piv = mk_sat_var lfn vi in let n0 = mem piv (hyp rth0) in let rth = resolve piv n0 rth0 rth1 in let _ = Array.set cl rci (Learnt (rth,lns0)) in ();; let resolveChain lfn mcth cl rci = let (nl,lnl) = match (Array.get cl rci) with Chain (l,ll) -> (l,ll) | _ -> failwith("resolveChain") in let (vil,cil) = unzip nl in let vil = tl vil in (* first pivot var is actually dummy value -1 *) let (c0i,c1i,cilt) = l2hh cil in let _ = resolveClause lfn mcth cl (List.hd vil) rci (c0i,c1i) in let _ = List.iter (fun (vi,ci) -> resolveClause lfn mcth cl vi rci (ci,rci)) (tl (tl nl)) in ();; (* rth should be A |- F, where A contains all and only *) (* the root clauses used in the proof *) let unsatProveResolve lfn mcth (cl,sk,srl) = let _ = List.iter (resolveChain lfn mcth cl) (List.rev sk) in let rth = match (Array.get cl (srl-1)) with Learnt (th,_) -> th | _ -> failwith("unsatProveTrace") in rth;; hol-light/Minisat/sat_common_tools.ml000066400000000000000000000070261303454263000202670ustar00rootroot00000000000000 (* miscellaneous useful stuff that doesn't fit in anywhere else *) let pair_map f (x,y) = (f x,f y) (* module for maps keyed on terms *) module Termmap = Map.Make (struct type t = term let compare = Pervasives.compare end) module Litset = Set.Make (struct type t = bool * int let compare = Pervasives.compare end) let tm_listItems m = List.rev (Termmap.fold (fun k v l -> (k,v)::l) m []) let print_term t = print_string (string_of_term t) let print_type ty = print_string (string_of_type ty) (*FIXME: inefficient to read chars one by one; 1024 can be improved upon*) let input_all in_ch = let rec loop b = match (try Some (input_char in_ch) with End_of_file -> None) with Some c -> (Buffer.add_char b c; loop b) | None -> () in let b = Buffer.create 1024 in let _ = loop b in Buffer.contents b let QUANT_CONV conv = RAND_CONV(ABS_CONV conv) let BINDER_CONV conv = ABS_CONV conv ORELSEC QUANT_CONV conv let rec LAST_FORALL_CONV c tm = if is_forall (snd (dest_forall tm)) then BINDER_CONV (LAST_FORALL_CONV c) tm else c tm let FORALL_IMP_CONV tm = let (bvar,bbody) = dest_forall tm in let (ant,conseq) = dest_imp bbody in let fant = free_in bvar ant in let fconseq = free_in bvar conseq in let ant_thm = ASSUME ant in let tm_thm = ASSUME tm in if (fant && fconseq) then failwith("FORALL_IMP_CONV"^ ("`"^(fst(dest_var bvar))^"` free on both sides of `==>`")) else if fant then let asm = mk_exists(bvar,ant) in let th1 = CHOOSE(bvar,ASSUME asm) (UNDISCH(SPEC bvar tm_thm)) in let imp1 = DISCH tm (DISCH asm th1) in let cncl = rand(concl imp1) in let th2 = MP (ASSUME cncl) (EXISTS (asm,bvar) ant_thm) in let imp2 = DISCH cncl (GEN bvar (DISCH ant th2)) in IMP_ANTISYM_RULE imp1 imp2 else if fconseq then let imp1 = DISCH ant(GEN bvar(UNDISCH(SPEC bvar tm_thm))) in let cncl = concl imp1 in let imp2 = GEN bvar(DISCH ant(SPEC bvar(UNDISCH(ASSUME cncl)))) in IMP_ANTISYM_RULE (DISCH tm imp1) (DISCH cncl imp2) else let asm = mk_exists(bvar,ant) in let tmp = UNDISCH (SPEC bvar tm_thm) in let th1 = GEN bvar (CHOOSE(bvar,ASSUME asm) tmp) in let imp1 = DISCH tm (DISCH asm th1) in let cncl = rand(concl imp1) in let th2 = SPEC bvar (MP(ASSUME cncl) (EXISTS (asm,bvar) ant_thm)) in let imp2 = DISCH cncl (GEN bvar (DISCH ant th2)) in IMP_ANTISYM_RULE imp1 imp2 let LEFT_IMP_EXISTS_CONV tm = let ant, _ = dest_imp tm in let bvar,bdy = dest_exists ant in let x' = variant (frees tm) bvar in let t' = subst [x',bvar] bdy in let th1 = GEN x' (DISCH t'(MP(ASSUME tm)(EXISTS(ant,x')(ASSUME t')))) in let rtm = concl th1 in let th2 = CHOOSE (x',ASSUME ant) (UNDISCH(SPEC x'(ASSUME rtm))) in IMP_ANTISYM_RULE (DISCH tm th1) (DISCH rtm (DISCH ant th2)) (*********** terms **************) let lrand x = rand (rator x) let t_tm = `T`;; let f_tm = `F`;; let is_T tm = (tm = t_tm) let is_F tm = (tm = f_tm) (************ HOL **************) let rec ERC lt tm = if is_comb lt then let ((ltl,ltr),(tml,tmr)) = pair_map dest_comb (lt,tm) in (ERC ltl tml)@(ERC ltr tmr) else if is_var lt then [(tm,lt)] else [] (* easier REWR_CONV which assumes that the supplied theorem is ground and quantifier free, so type instantiation and var capture checks are not needed *) (* no restrictions on the term argument *) let EREWR_CONV th tm = let lt = lhs(concl th) in let il = ERC lt tm in INST il th hol-light/Minisat/sat_script.ml000066400000000000000000000016171303454263000170630ustar00rootroot00000000000000 let AND_IMP = prove (`!a b c. a /\ b ==> c <=> a ==> b ==> c`,CONV_TAC TAUT);; let AND_IMP2 = prove (`!a b c. a /\ b ==> c <=> (a<=>T) ==> b ==> c`,CONV_TAC TAUT);; let AND_IMP3 = prove (`!a b c. ~a /\ b ==> c <=> (a<=>F) ==> b ==> c`,CONV_TAC TAUT);; let NOT_NOT = GEN_ALL (hd (CONJUNCTS (SPEC_ALL NOT_CLAUSES)));; let AND_INV = prove (`!a. (~a /\ a) <=> F`,CONV_TAC TAUT);; let AND_INV_IMP = prove (`!a. a ==> ~a ==> F`,CONV_TAC TAUT);; let OR_DUAL = prove (`(~(a \/ b) ==> F) = (~a ==> ~b ==> F)`,CONV_TAC TAUT);; let OR_DUAL2 = prove (`(~(a \/ b) ==> F) = ((a==>F) ==> ~b ==> F)`,CONV_TAC TAUT);; let OR_DUAL3 = prove (`(~(~a \/ b) ==> F) = (a ==> ~b ==> F)`,CONV_TAC TAUT);; let AND_INV2 = prove (`(~a ==> F) ==> (a==>F) ==> F`,CONV_TAC TAUT) let NOT_ELIM2 = prove (`(~a ==> F) <=> a`,CONV_TAC TAUT) let IMP_F_EQ_F = prove (`!t. (t ==> F) <=> (t <=> F)`,CONV_TAC TAUT);; hol-light/Minisat/sat_solvers.ml000066400000000000000000000066211303454263000172540ustar00rootroot00000000000000(* This file contains specifications of the SAT tools that can be invoked from HOL. Details of format in the comments following each field name. {name (* solver name *) url, (* source for downloading *) executable, (* path to executable *) good_exit, (* code return upon normal termination *) notime_run, (* command to invoke solver on a file *) time_run, (* command to invoke on a file and time *) only_true (* true if only the true atoms are listed in models *) failure_string, (* string whose presence indicates unsatisfiability *) start_string, (* string signalling start of variable assignment *) end_string} (* string signalling end of variable assignment *) *) type sat_solver = {name : string; url : string; executable : string; good_exit : int; notime_run : string -> string * string -> string; time_run : string -> (string * string) * int -> string; only_true : bool; failure_string : string; start_string : string; end_string : string} let zchaff = {name = "zchaff"; url = "http://www.ee.princeton.edu/~chaff/zchaff/zchaff.2001.2.17.linux.gz"; executable = "zchaff"; good_exit = 0; notime_run = (fun ex -> fun (infile,outfile) -> (ex ^ " " ^ infile ^ " > " ^ outfile ^ "; zc2mso " ^ infile ^ " -m " ^ outfile ^ ".proof -z "^ (Filename.concat (!temp_path) "resolve_trace")^ "> "^ (Filename.concat (!temp_path) "zc2mso_trace"))); time_run = (fun ex -> fun ((infile,outfile),time) -> (ex ^ " " ^ infile ^ " " ^ (string_of_int time) ^ " > " ^ outfile)); only_true = false; failure_string = "UNSAT"; start_string = "Instance Satisfiable"; end_string = "Random Seed Used"} let minisat = {name = "minisat"; url = "http://www.cs.chalmers.se/Cs/Research/FormalMethods/MiniSat/cgi/MiniSat_v1.13_linux.cgi"; executable = "minisat"; good_exit = 10; notime_run = (fun ex -> fun (infile,outfile) -> (ex ^ " -r " ^ outfile ^" "^ infile ^ " > " ^ outfile ^".stats")); time_run = (fun ex -> fun ((infile,outfile),time) -> (ex ^ " " ^ infile ^ " " ^ (string_of_int time) ^ " > " ^ outfile)); only_true = false; failure_string = "UNSAT"; start_string = "v"; end_string = "0"} let minisatp = {name = "minisatp"; url = "http://www.cs.chalmers.se/Cs/Research/FormalMethods/MiniSat/cgi/MiniSat_v1.13_linux.cgi"; executable = (match (Sys.os_type) with "Win32" | "Cygwin" -> "minisat.exe" | _ -> "minisat"); good_exit = 10; notime_run = (fun ex -> fun (infile,outfile) -> (ex ^ " -r " ^ outfile ^ " -p " ^ outfile ^ ".proof " ^ infile ^ " > " ^ outfile ^".stats")); time_run = (fun ex -> fun ((infile,outfile),time) -> (ex ^ " " ^ infile ^ " " ^ (string_of_int time) ^ " > " ^ outfile)); only_true = false; failure_string = "UNSAT"; start_string = "SAT"; end_string = "0"} hol-light/Minisat/sat_tools.ml000066400000000000000000000121741303454263000167170ustar00rootroot00000000000000 (*open dimacsTools;;*) (* Functions for parsing the DIMACS-compliant output of SAT solvers, This is generic. Parser for minisat proof log is in minisatParse.ml *) (* ** Use Binaryset to encode mapping between HOL variable names ** and DIMACS variable numbers as a set of string*int pairs. *) (* ** substringContains s ss ** tests whether substring ss contains string s *) let substringContains s ss = let re = Str.regexp_string s in match (try Str.search_forward re ss 0 with Not_found -> -1) with -1 -> false | _ -> true (* ** parseSat (s1,s2) ss ** returns a list of numbers corresponding to the tokenised ** substring of ss (tokenised wrt Char.isSpace) that starts immediately ** after the first occurrence of s1 and ends just before the first ** occurrence of s2 that is after the first occurrence of s1 *) let parseSat (s1,s2) ss = let p1 = Str.search_forward (Str.regexp s1) ss 0 in let p2 = Str.search_backward (Str.regexp s2) ss (String.length ss) in let ss1 = Str.string_before ss p2 in let ss2 = Str.string_after ss1 (p1+String.length s1) in let ssl = Str.split (Str.regexp "[ \n\t\r]") ss2 in List.map int_of_string ssl (* ** invokeSat solver t ** invokes solver on t and returns SOME s (where s is the satisfying instance ** as a string of integers) or NONE, if unsatisfiable *) (* ** Reference containing last command used to invoke a SAT solver *) let sat_command = ref "undef" (* ** Test for success of the result of Process.system ** N.B. isSuccess expected to primitive in next release of ** Moscow ML, and Process.status will lose eqtype status *) let satdir = "";; (* if fname is NONE, then use a temp file, otherwise assume fname.cnf alredy exists*) let invokeSat sat_solver fname t vc = let {name=name; url=url; executable=executable; good_exit=good_exit; notime_run=notime_run; time_run=time_run; only_true=only_true; failure_string=failure_string; start_string=start_string; end_string=end_string} = sat_solver in let var_count = match vc with Some n -> n | None -> List.length(variables t) in let tmp = match fname with Some fnm -> (initSatVarMap var_count; ignore (termToDimacs t); (*FIXME: this regenerates sat_var_map: better to save/load it*) fnm) | None -> termToDimacsFile None t var_count in let infile = tmp ^ ".cnf" in let outfile = tmp ^ "." ^ name in let ex = Filename.concat satdir executable in let run_cmd = notime_run ex (infile,outfile) in let _ = (sat_command := run_cmd) in let code = Sys.command run_cmd in let _ = if ((name = "minisat") || (name = "minisatp") || (code = good_exit)) then () else print_string("Warning:\n Failure signalled by\n " ^ run_cmd ^ "\n") in let ins = Pervasives.open_in outfile in let sat_res = input_all ins in let _ = close_in ins in let result = substringContains failure_string sat_res in if result then None else let model1 = parseSat(start_string,end_string) sat_res in let model2 = if only_true then model1 @ (List.map (fun n -> 0-n) (subtract (List.map snd (snd(showSatVarMap()))) model1)) else model1 in Some (List.map intToLiteral model2) (* ** satOracle sat_solver t ** invokes sat_solver on t and returns a theorem tagged by the solver name ** of the form |- (l1 /\ ... ln) ==> t (satisfied with literals l1,...,ln) ** or |- ~t (failure) *) let satOracle sat_solver t = let res = invokeSat sat_solver None t None in match res with Some l -> mk_thm ([], mk_imp(list_mk_conj l, t)) | None -> mk_thm ([], mk_neg t) (* ** satProve sat_solver t ** invokes sat_solver on t and if a model is found then ** then it is verified using proof in HOL and a theorem ** |- (l1 /\ ... /\ ln) ==> t is returned ** (where l1,...,ln are the literals making up the model); ** Raises satProveError if no model is found. ** Raises satCheckError if the found model is bogus *) (* ** satCheck [l1,...,ln] t ** attempts to prove (l1 /\ ... /\ ln) ==> t ** if it succeeds then the theorem is returned, else ** exception satCheckError is raised *) let EQT_Imp1 = TAUT `!b. b ==> (b<=>T)` let EQF_Imp1 = TAUT `!b. (~b) ==> (b<=>F)` let EQT_Imp2 = TAUT `!b. (b<=>T) ==> b`;; exception Sat_check_error let satCheck model t = try let mtm = list_mk_conj model in let th1 = ASSUME mtm in let thl = List.map (fun th -> if is_neg(concl th) then MP (SPEC (dest_neg(concl th)) EQF_Imp1) th else MP (SPEC (concl th) EQT_Imp1) th) (CONJUNCTS th1) in let th3 = SUBS_CONV thl t in let th4 = CONV_RULE(RAND_CONV(REWRITE_CONV[])) th3 in let th5 = MP (SPEC t EQT_Imp2) th4 in DISCH mtm th5 with Sys.Break -> raise Sys.Break | _ -> raise Sat_check_error;; exception Sat_prove_error (* old interface by MJCG. assumes t is in cnf; only for finding SAT *) let satProve sat_solver t = match invokeSat sat_solver None t None with Some model -> satCheck model t | None -> raise Sat_prove_error hol-light/Minisat/taut.ml000066400000000000000000006627171303454263000157030ustar00rootroot00000000000000(*--------------------------------------------------------------------------- Tautologies. The examples were originally collected by John Harrison to exercise his implementation of Stalmarck's algorithm. Some of these can take a great deal of time and memory to complete. Modified by HA for testing on HolSatLib.SAT_PROVE ---------------------------------------------------------------------------*) let syn323_1 = `~((v0 \/ v1) /\ (~v0 \/ v1) /\ (~v1 \/ v0) /\ (~v0 \/ ~v1))`;; let syn029_1 = `~((~v2 \/ ~v1) /\ v0 /\ (~v0 \/ ~v1 \/ v2) /\ (~v2 \/ v1) /\ (v1 \/ v2))`;; let syn052_1 = `~((~v1 \/ v0) /\ (~v0 \/ v1) /\ (v1 \/ v0) /\ (~v1 \/ v1) /\ (~v0 \/ ~v1))`;; let syn051_1 = `~((v1 \/ v0) /\ (v1 \/ v2) /\ (~v0 \/ ~v1) /\ (~v2 \/ ~v1) /\ (~v0 \/ v1) /\ (~v1 \/ v2))`;; let syn044_1 = `~((v0 \/ v1) /\ (~v0 \/ ~v1) /\ (~v0 \/ v1 \/ v2) /\ (~v2 \/ v1) /\ (~v2 \/ v0) /\ (~v1 \/ v2))`;; let syn011_1 = `~(v6 /\ (~v0 \/ ~v2) /\ (v0 \/ v1 \/ v5) /\ (~v2 \/ ~v1) /\ (~v4 \/ v2) /\ (~v3 \/ v2) /\ (v3 \/ v4 \/ v5) /\ (~v5 \/ ~v6))`;; let syn032_1 = `~((~v5 \/ ~v1) /\ (~v4 \/ ~v0) /\ (~v4 \/ v0) /\ (~v5 \/ v1) /\ (~v2 \/ v4 \/ v3) /\ (v4 \/ v2 \/ v3) /\ (~v3 \/ v4 \/ v5))`;; let ex2_be = `~((a /\ b /\ ~c) \/ (~a /\ b /\ c /\ ~d)) ==> (s1 <=> (~a \/ d)) /\ (oh <=> (b /\ s1)) /\ (s2 <=> (~c \/ d)) ==> (oh <=> (b /\ s2))`;; let syn030_1 = `~((~v4 \/ ~v0 \/ ~v1) /\ (~v3 \/ ~v4 \/ v0) /\ (~v1 \/ v0) /\ (v0 \/ v1) /\ (~v0 \/ v1) /\ (~v1 \/ ~v0 \/ v2) /\ (~v2 \/ v1) /\ (~v1 \/ v3) /\ (~v2 \/ ~v3 \/ v4))`;; let transp_be = `(sub1x <=> ~(a \/ b)) /\ (sub1y <=> ~(c \/ d)) /\ (o2 <=> ~(sub1x \/ sub1y)) /\ (o1 <=> (sub1x /\ sub1y)) ==> (o1 <=> (~a /\ ~b /\ ~c /\ ~d)) /\ (o2 <=> ((a \/ b) /\ (c \/ d)))`;; let syn054_1 = `~((~v1 \/ ~v7) /\ (~v2 \/ ~v0) /\ (~v3 \/ v7 \/ v4) /\ (~v6 \/ v0 \/ v5) /\ (~v7 \/ v1) /\ (~v0 \/ v2) /\ (~v4 \/ v1) /\ (~v5 \/ v2) /\ (~v3 \/ ~v4) /\ (~v6 \/ ~v5) /\ (v6 \/ v7))`;; let gra001_1 = `~((~v1 \/ v0) /\ (~v0 \/ v1) /\ (~v4 \/ ~v2 \/ ~v0) /\ (~v4 \/ v2 \/ v0) /\ (~v2 \/ v4 \/ v0) /\ (~v0 \/ v4 \/ v2) /\ (~v3 \/ ~v2 \/ ~v1) /\ (~v3 \/ v2 \/ v1) /\ (~v2 \/ v3 \/ v1) /\ (~v1 \/ v3 \/ v2) /\ (~v3 \/ ~v4) /\ (v3 \/ v4))` ;; let syn321_1 = `~((~v0 \/ v9) /\ (~v0 \/ v6) /\ (~v0 \/ v7) /\ (~v8 \/ v9) /\ (~v8 \/ v6) /\ (~v8 \/ v7) /\ (~v1 \/ v9) /\ (~v1 \/ v6) /\ (~v1 \/ v7) /\ (~v2 \/ v3) /\ (~v4 \/ v5) /\ (~v7 \/ v8) /\ (v8 \/ v9) /\ (v8 \/ v6) /\ (v8 \/ v7) /\ (~v8 \/ ~v9))` ;; let rip02_be = `(car1 <=> (a1 /\ b1)) /\ (cout <=> ((a2 \/ b2) /\ car1 \/ a2 /\ b2)) /\ (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ (som1 <=> ~(a1 <=> b1)) /\ (cout1 <=> (b1 /\ a1)) ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ (som2 <=> ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ (cout <=> (a2 /\ cout1 \/ b2 /\ cout1 \/ a2 /\ b2))`;; let puz014_1 = `~(v3 /\ v0 /\ v10 /\ (v4 \/ v5) /\ (v9 \/ v2) /\ (v8 \/ v1) /\ (v7 \/ v0) /\ (v3 \/ v12) /\ (v11 \/ v10) /\ (~v12 \/ ~v6 \/ v7) /\ (~v10 \/ ~v3 \/ v1) /\ (~v10 \/ ~v0 \/ ~v4 \/ v11) /\ (~v5 \/ ~v2 \/ ~v8) /\ (~v12 \/ ~v9 \/ ~v7) /\ (~v0 \/ ~v1 \/ v4) /\ (~v4 \/ v7 \/ v2) /\ (~v12 \/ ~v3 \/ v8) /\ (~v4 \/ v5 \/ v6) /\ (~v7 \/ ~v8 \/ v9) /\ (~v10 \/ ~v11 \/ v12))` ;; let mjcg_yes = `((adder1____carry__1__1 <=> ~a__0 /\ b__0) /\ (adder1____carry__1__2 <=> b__1 /\ adder1____carry__1__1 \/ ~a__1 /\ ~(b__1 <=> adder1____carry__1__1)) /\ (adder1____carry__2__1 <=> a__0 /\ b__0) /\ (adder1____carry__2__2 <=> b__1 /\ adder1____carry__2__1 \/ a__1 /\ ~(b__1 <=> adder1____carry__2__1))) /\ (adder2____carry__1__1 <=> cnt__0 /\ a__0) /\ (adder2____carry__1__2 <=> a__1 /\ adder2____carry__1__1) /\ (adder2____carry__1__3 <=> a__2 /\ adder2____carry__1__2) /\ (adder2____carry__2__1 <=> ~(cnt__0 <=> a__0) /\ ~(cnt__0 <=> b__0)) /\ (adder2____carry__2__2 <=> ~(cnt__0 <=> b__1) /\ adder2____carry__2__1 \/ ~(a__1 <=> adder2____carry__1__1) /\ ~(~(cnt__0 <=> b__1) <=> adder2____carry__2__1)) /\ (adder2____carry__2__3 <=> ~(cnt__0 <=> b__2) /\ adder2____carry__2__2 \/ ~(a__2 <=> adder2____carry__1__2) /\ ~(~(cnt__0 <=> b__2) <=> adder2____carry__2__2)) ==> ((out__2 <=> ~(~(a__2 <=> b__2) <=> adder1____carry__1__2) /\ cnt__0 \/ ~(~(a__2 <=> b__2) <=> adder1____carry__2__2) /\ ~cnt__0) /\ (out__1 <=> ~(~(a__1 <=> b__1) <=> adder1____carry__1__1) /\ cnt__0 \/ ~(~(a__1 <=> b__1) <=> adder1____carry__2__1) /\ ~cnt__0) /\ (out__0 <=> ~(a__0 <=> b__0) /\ cnt__0 \/ ~(a__0 <=> b__0) /\ ~cnt__0) <=> (out__2 <=> ~(~(~(a__2 <=> adder2____carry__1__2) <=> ~(cnt__0 <=> b__2)) <=> adder2____carry__2__2)) /\ (out__1 <=> ~(~(~(a__1 <=> adder2____carry__1__1) <=> ~(cnt__0 <=> b__1)) <=> adder2____carry__2__1)) /\ (out__0 <=> ~(~(cnt__0 <=> a__0) <=> ~(cnt__0 <=> b__0))))`;; let mul03_be = `(p_00_00 <=> (x1 /\ y1)) /\ (p_00_01 <=> (x1 /\ y2)) /\ (p_00_02 <=> (x1 /\ y3)) /\ (p_01_00 <=> (x2 /\ y1)) /\ (p_01_01 <=> (x2 /\ y2)) /\ (p_01_02 <=> (x2 /\ y3)) /\ (p_02_00 <=> (x3 /\ y1)) /\ (p_02_01 <=> (x3 /\ y2)) /\ (p_02_02 <=> (x3 /\ y3)) /\ (s_01_01 <=> ~(p_01_02 <=> p_02_01)) /\ (c_01_01 <=> (p_01_02 /\ p_02_01)) /\ (s_01_02 <=> ~(p_00_02 <=> p_02_00)) /\ (c_01_02 <=> (p_00_02 /\ p_02_00)) /\ (s_02_01 <=> ~(c_01_01 <=> ~(s_01_02 <=> p_01_01))) /\ (s_02_02 <=> ~(c_01_02 <=> ~(p_01_00 <=> p_00_01))) /\ (c_02_01 <=> (c_01_01 /\ s_01_02 \/ c_01_01 /\ p_01_01 \/ s_01_02 /\ p_01_01)) /\ (c_02_02 <=> (c_01_02 /\ p_01_00 \/ c_01_02 /\ p_00_01 \/ p_01_00 /\ p_00_01)) /\ (s_03_01 <=> ~(c_02_01 <=> s_02_02)) /\ (c_03_01 <=> c_02_01 /\ s_02_02) /\ (s_03_02 <=> ~(c_02_02 <=> ~(p_00_00 <=> c_03_01))) /\ (c_03_02 <=> c_02_02 /\ p_00_00 \/ c_02_02 /\ c_03_01 \/ p_00_00 /\ c_03_01) /\ (z05 <=> p_02_02) /\ (z04 <=> s_01_01) /\ (z03 <=> s_02_01) /\ (z02 <=> s_03_01) /\ (z01 <=> s_03_02) /\ (z00 <=> c_03_02) /\ (p_00_00' <=> y1 /\ x1) /\ (p_00_01' <=> y1 /\ x2) /\ (p_00_02' <=> y1 /\ x3) /\ (p_01_00' <=> y2 /\ x1) /\ (p_01_01' <=> y2 /\ x2) /\ (p_01_02' <=> y2 /\ x3) /\ (p_02_00' <=> y3 /\ x1) /\ (p_02_01' <=> y3 /\ x2) /\ (p_02_02' <=> y3 /\ x3) /\ (s_01_01' <=> ~(p_01_02' <=> p_02_01')) /\ (c_01_01' <=> p_01_02' /\ p_02_01') /\ (s_01_02' <=> ~(p_00_02' <=> p_02_00')) /\ (c_01_02' <=> p_00_02' /\ p_02_00') /\ (s_02_01' <=> ~(c_01_01' <=> ~(s_01_02' <=> p_01_01'))) /\ (s_02_02' <=> ~(c_01_02' <=> ~(p_01_00' <=> p_00_01'))) /\ (c_02_01' <=> c_01_01' /\ s_01_02' \/ c_01_01' /\ p_01_01' \/ s_01_02' /\ p_01_01') /\ (c_02_02' <=> c_01_02' /\ p_01_00' \/ c_01_02' /\ p_00_01' \/ p_01_00' /\ p_00_01') /\ (s_03_01' <=> ~(c_02_01' <=> s_02_02')) /\ (c_03_01' <=> c_02_01' /\ s_02_02') /\ (s_03_02' <=> ~(c_02_02' <=> ~(p_00_00' <=> c_03_01'))) /\ (c_03_02' <=> c_02_02' /\ p_00_00' \/ c_02_02' /\ c_03_01' \/ p_00_00' /\ c_03_01') ==> (z00 <=> c_03_02') /\ (z01 <=> s_03_02') /\ (z02 <=> s_03_01') /\ (z03 <=> s_02_01') /\ (z04 <=> s_01_01') /\ (z05 <=> p_02_02')` ;; let puz030_2 = `~((~v8 \/ ~v5 \/ ~v7 \/ ~v9 \/ v6 \/ v2 \/ v3 \/ v0 \/ v1 \/ v4) /\ (v0 \/ v1 \/ v8) /\ (v7 \/ v4 \/ v2) /\ (v5 \/ v8 \/ v0) /\ (v6 \/ v9 \/ v1) /\ (v7 \/ v4 \/ v1) /\ (v2 \/ v3 \/ v9) /\ (v7 \/ v4 \/ v9) /\ (~v5 \/ ~v3 \/ ~v2 \/ v6 \/ v9) /\ (~v5 \/ ~v3 \/ ~v2 \/ ~v9 \/ ~v6) /\ (~v6 \/ ~v1 \/ ~v0 \/ v5 \/ v8) /\ (~v6 \/ ~v8 \/ ~v5 \/ v0 \/ v1) /\ (~v6 \/ ~v8 \/ ~v5 \/ ~v1 \/ ~v0) /\ (~v4 \/ v2 \/ v3 \/ v0 \/ v1) /\ (~v4 \/ ~v3 \/ ~v2 \/ ~v1 \/ ~v0) /\ (~v2 \/ ~v7 \/ v5 \/ v8) /\ (~v2 \/ ~v4 \/ v5 \/ v8) /\ (~v2 \/ ~v8 \/ ~v5 \/ ~v7) /\ (~v2 \/ ~v8 \/ ~v5 \/ ~v4) /\ (~v2 \/ v3 \/ v5) /\ (~v3 \/ v2 \/ v5) /\ (~v6 \/ v9 \/ v5) /\ (~v9 \/ v6 \/ v5) /\ (~v7 \/ ~v4 \/ v8) /\ (~v5 \/ v8 \/ v2) /\ (~v8 \/ v5 \/ v2) /\ (~v0 \/ ~v1 \/ v3) /\ (~v6 \/ ~v9 \/ v3) /\ (~v2 \/ ~v3 \/ v0) /\ (~v5 \/ v8 \/ v6) /\ (~v8 \/ v5 \/ v6) /\ (~v0 \/ v1 \/ v6) /\ (~v1 \/ v0 \/ v6) /\ (~v5 \/ ~v8 \/ v7) /\ (~v6 \/ ~v9 \/ v7) /\ (~v2 \/ v3 \/ v4) /\ (~v3 \/ v2 \/ v4) /\ (~v0 \/ v1 \/ v4) /\ (~v1 \/ v0 \/ v4) /\ (~v8 \/ ~v0 \/ v7) /\ (~v8 \/ ~v0 \/ v4) /\ (~v8 \/ ~v1 \/ v7) /\ (~v8 \/ ~v1 \/ v4) /\ (~v3 \/ v0 \/ v6) /\ (~v3 \/ v0 \/ v9) /\ (~v3 \/ v1 \/ v6) /\ (~v3 \/ v1 \/ v9) /\ (~v0 \/ ~v5 \/ v2) /\ (~v0 \/ ~v5 \/ v3) /\ (~v0 \/ ~v8 \/ v2) /\ (~v0 \/ ~v8 \/ v3) /\ (~v1 \/ ~v6 \/ ~v7) /\ (~v1 \/ ~v6 \/ ~v4) /\ (~v1 \/ ~v9 \/ ~v7) /\ (~v1 \/ ~v9 \/ ~v4) /\ (~v9 \/ ~v2 \/ ~v7) /\ (~v9 \/ ~v2 \/ ~v4) /\ (~v9 \/ ~v3 \/ ~v7) /\ (~v9 \/ ~v3 \/ ~v4) /\ (~v7 \/ v5 \/ v6) /\ (~v7 \/ v5 \/ v9) /\ (~v7 \/ v8 \/ v6) /\ (~v7 \/ v8 \/ v9))` ;; let puz030_1 = `~((~v21 \/ v2) /\ (~v14 \/ v10) /\ (~v15 \/ v6) /\ (~v12 \/ v16) /\ (~v3 \/ v22) /\ (~v21 \/ v1) /\ (~v14 \/ v8) /\ (~v15 \/ v4) /\ (~v12 \/ v13) /\ (~v3 \/ v19) /\ (~v2 \/ ~v1 \/ v21) /\ (~v10 \/ ~v8 \/ v14) /\ (~v6 \/ ~v4 \/ v15) /\ (~v16 \/ ~v13 \/ v12) /\ (~v22 \/ ~v19 \/ v3) /\ (~v0 \/ v2 \/ v1) /\ (~v7 \/ v10 \/ v8) /\ (~v24 \/ v6 \/ v4) /\ (~v23 \/ v16 \/ v13) /\ (~v17 \/ v22 \/ v19) /\ (~v0 \/ ~v21) /\ (~v7 \/ ~v14) /\ (~v24 \/ ~v15) /\ (~v23 \/ ~v12) /\ (~v17 \/ ~v3) /\ (~v0 \/ ~v18) /\ (~v7 \/ ~v20) /\ (~v24 \/ ~v9) /\ (~v23 \/ ~v5) /\ (~v17 \/ ~v11) /\ (v21 \/ v18 \/ v0) /\ (v14 \/ v20 \/ v7) /\ (v15 \/ v9 \/ v24) /\ (v12 \/ v5 \/ v23) /\ (v3 \/ v11 \/ v17) /\ (~v0 \/ ~v2 \/ ~v1) /\ (~v7 \/ ~v10 \/ ~v8) /\ (~v24 \/ ~v6 \/ ~v4) /\ (~v23 \/ ~v16 \/ ~v13) /\ (~v17 \/ ~v22 \/ ~v19) /\ (~v21 \/ ~v18) /\ (~v14 \/ ~v20) /\ (~v15 \/ ~v9) /\ (~v12 \/ ~v5) /\ (~v3 \/ ~v11) /\ (~v18 \/ ~v2) /\ (~v20 \/ ~v10) /\ (~v9 \/ ~v6) /\ (~v5 \/ ~v16) /\ (~v11 \/ ~v22) /\ (~v18 \/ ~v1) /\ (~v20 \/ ~v8) /\ (~v9 \/ ~v4) /\ (~v5 \/ ~v13) /\ (~v11 \/ ~v19) /\ (v2 \/ v1 \/ v18) /\ (v10 \/ v8 \/ v20) /\ (v6 \/ v4 \/ v9) /\ (v16 \/ v13 \/ v5) /\ (v22 \/ v19 \/ v11) /\ (~v5 \/ ~v20 \/ ~v3 \/ ~v24 \/ ~v2 \/ ~v4 \/ ~v0) /\ (~v7 \/ v1) /\ (~v23 \/ v1) /\ (~v1 \/ v23 \/ v7) /\ (~v15 \/ v1) /\ (~v3 \/ v2) /\ (~v2 \/ v3 \/ v15) /\ (~v18 \/ v4) /\ (~v5 \/ v4) /\ (~v4 \/ v5 \/ v18) /\ (~v7 \/ v6) /\ (~v17 \/ v6) /\ (~v6 \/ v17 \/ v7) /\ (~v18 \/ v8) /\ (~v9 \/ v8) /\ (~v8 \/ v9 \/ v18) /\ (~v12 \/ v10) /\ (~v11 \/ v10) /\ (~v10 \/ v11 \/ v12) /\ (~v15 \/ v13) /\ (~v14 \/ v13) /\ (~v13 \/ v14 \/ v15) /\ (~v18 \/ v16) /\ (~v17 \/ v16) /\ (~v16 \/ v17 \/ v18) /\ (~v21 \/ v19) /\ (~v20 \/ v19) /\ (~v19 \/ v20 \/ v21) /\ (~v24 \/ v22) /\ (~v23 \/ v22) /\ (~v22 \/ v23 \/ v24))` ;; let dk27_be = `(ge2 <=> ~in4 /\ ~in3 /\ ~in2 /\ ~in0) /\ (ge7 <=> ge2 /\ ~in1) /\ (ge0 <=> ~in6 /\ ~in5 /\ ~in1 /\ ~in0) /\ (ge4 <=> in8 /\ ~in7 /\ ~in5) /\ (ge11 <=> ge7 /\ in6) /\ (ge20 <=> ~in3 /\ ~in2 /\ ~in1 /\ in0) /\ (ge21 <=> ~in6 /\ ~in4) /\ (ge1 <=> ~in8 /\ in7 \/ in8 /\ ~in7) /\ (ge8 <=> ge0 /\ ~in3) /\ (ge9 <=> ge0 /\ ~in4 /\ in3 /\ ~in2) /\ (ge10 <=> in8 /\ ~in7) /\ (ge16 <=> ge11 /\ ge4) /\ (ge5 <=> ge21 /\ ge20) /\ (ge6 <=> ~in8 /\ in7 /\ ~in5) /\ (ge14 <=> ge8 /\ ge1) /\ (ge19 <=> ge10 /\ ge9 \/ ge16) /\ (ge12 <=> ge7 /\ ~in6 /\ in5) /\ (ge13 <=> ge2 /\ ~in6 /\ in1) /\ (ge17 <=> ~in8 /\ in7) /\ (ge18 <=> ge16 \/ ge6 /\ ge5) /\ (ge15 <=> ge8 /\ in4 /\ ~in2 \/ ge8 /\ ~in4 /\ in2) /\ (out0 <=> ge17 /\ ge15) /\ (out1 <=> ge15 /\ ge10) /\ (out2 <=> ge9 /\ ge1 \/ ge18) /\ (out3 <=> ge5 /\ ge4) /\ (out4 <=> ge11 /\ ge6 \/ ge13 /\ ge6 \/ ge17 /\ ge12) /\ (out5 <=> ge13 /\ ge4) /\ (out6 <=> ge12 /\ ge10) /\ (out7 <=> ge14 /\ in4 /\ ~in2 \/ ge19) /\ (out8 <=> ge14 /\ ~in4 /\ in2) /\ (wres2 <=> ~in4 /\ ~in3 /\ ~in2 /\ ~in0) /\ (wres0 <=> ~in6 /\ ~in5 /\ ~in1 /\ ~in0) /\ (wres7 <=> wres2 /\ ~in1) /\ (wres1 <=> ~in8 /\ in7 \/ in8 /\ ~in7) /\ (wres8 <=> wres0 /\ ~in3) /\ (wres4 <=> in8 /\ ~in7 /\ ~in5) /\ (wres11 <=> wres7 /\ in6) /\ (wres14 <=> wres8 /\ wres1) /\ (wres9 <=> wres0 /\ ~in4 /\ in3 /\ ~in2) /\ (wres10 <=> in8 /\ ~in7) /\ (wres16 <=> wres11 /\ wres4) /\ (wres12 <=> wres7 /\ ~in6 /\ in5) /\ (wres13 <=> wres2 /\ ~in6 /\ in1) /\ (wres6 <=> ~in8 /\ in7 /\ ~in5) /\ (wres17 <=> ~in8 /\ in7) /\ (wres5 <=> ~in6 /\ ~in4 /\ ~in3 /\ ~in2 /\ ~in1 /\ in0) /\ (wres15 <=> wres8 /\ in4 /\ ~in2 \/ wres8 /\ ~in4 /\ in2) ==> (out8 <=> wres14 /\ ~in4 /\ in2) /\ (out7 <=> wres10 /\ wres9 \/ wres14 /\ in4 /\ ~in2 \/ wres16) /\ (out6 <=> wres12 /\ wres10) /\ (out5 <=> wres13 /\ wres4) /\ (out4 <=> wres11 /\ wres6 \/ wres13 /\ wres6 \/ wres17 /\ wres12) /\ (out3 <=> wres5 /\ wres4) /\ (out2 <=> wres9 /\ wres1 \/ wres6 /\ wres5 \/ wres16) /\ (out1 <=> wres15 /\ wres10) /\ (out0 <=> wres17 /\ wres15)` ;; let syn071_1 = `~(v8 /\ v3 /\ v1 /\ v0 /\ (~v9 \/ v11) /\ (~v5 \/ v12) /\ (~v2 \/ v14) /\ (~v0 \/ v0) /\ (~v7 \/ v13) /\ (~v4 \/ v10) /\ (~v1 \/ v1) /\ (~v14 \/ v2) /\ (~v6 \/ v15) /\ (~v3 \/ v3) /\ (~v10 \/ v4) /\ (~v12 \/ v5) /\ (~v8 \/ v8) /\ (~v15 \/ v6) /\ (~v13 \/ v7) /\ (~v11 \/ v9) /\ (~v0 \/ ~v11 \/ v11) /\ (~v0 \/ ~v12 \/ v12) /\ (~v0 \/ ~v14 \/ v14) /\ (~v0 \/ ~v0 \/ v0) /\ (~v2 \/ ~v11 \/ v13) /\ (~v2 \/ ~v12 \/ v10) /\ (~v2 \/ ~v14 \/ v1) /\ (~v2 \/ ~v0 \/ v2) /\ (~v5 \/ ~v11 \/ v15) /\ (~v5 \/ ~v12 \/ v3) /\ (~v5 \/ ~v14 \/ v4) /\ (~v5 \/ ~v0 \/ v5) /\ (~v9 \/ ~v11 \/ v8) /\ (~v9 \/ ~v12 \/ v6) /\ (~v9 \/ ~v14 \/ v7) /\ (~v9 \/ ~v0 \/ v9) /\ (~v14 \/ ~v13 \/ v11) /\ (~v14 \/ ~v10 \/ v12) /\ (~v14 \/ ~v1 \/ v14) /\ (~v14 \/ ~v2 \/ v0) /\ (~v1 \/ ~v13 \/ v13) /\ (~v1 \/ ~v10 \/ v10) /\ (~v1 \/ ~v1 \/ v1) /\ (~v1 \/ ~v2 \/ v2) /\ (~v4 \/ ~v13 \/ v15) /\ (~v4 \/ ~v10 \/ v3) /\ (~v4 \/ ~v1 \/ v4) /\ (~v4 \/ ~v2 \/ v5) /\ (~v7 \/ ~v13 \/ v8) /\ (~v7 \/ ~v10 \/ v6) /\ (~v7 \/ ~v1 \/ v7) /\ (~v7 \/ ~v2 \/ v9) /\ (~v12 \/ ~v15 \/ v11) /\ (~v12 \/ ~v3 \/ v12) /\ (~v12 \/ ~v4 \/ v14) /\ (~v12 \/ ~v5 \/ v0) /\ (~v10 \/ ~v15 \/ v13) /\ (~v10 \/ ~v3 \/ v10) /\ (~v10 \/ ~v4 \/ v1) /\ (~v10 \/ ~v5 \/ v2) /\ (~v3 \/ ~v15 \/ v15) /\ (~v3 \/ ~v3 \/ v3) /\ (~v3 \/ ~v4 \/ v4) /\ (~v3 \/ ~v5 \/ v5) /\ (~v6 \/ ~v15 \/ v8) /\ (~v6 \/ ~v3 \/ v6) /\ (~v6 \/ ~v4 \/ v7) /\ (~v6 \/ ~v5 \/ v9) /\ (~v11 \/ ~v8 \/ v11) /\ (~v11 \/ ~v6 \/ v12) /\ (~v11 \/ ~v7 \/ v14) /\ (~v11 \/ ~v9 \/ v0) /\ (~v13 \/ ~v8 \/ v13) /\ (~v13 \/ ~v6 \/ v10) /\ (~v13 \/ ~v7 \/ v1) /\ (~v13 \/ ~v9 \/ v2) /\ (~v15 \/ ~v8 \/ v15) /\ (~v15 \/ ~v6 \/ v3) /\ (~v15 \/ ~v7 \/ v4) /\ (~v15 \/ ~v9 \/ v5) /\ (~v8 \/ ~v8 \/ v8) /\ (~v8 \/ ~v6 \/ v6) /\ (~v8 \/ ~v7 \/ v7) /\ (~v8 \/ ~v9 \/ v9) /\ ~v10 /\ ~v11 /\ (v12 \/ v13) /\ (v14 \/ v15))` ;; (* Hard : takes buddy17 73 secs. on sole *) let aim_50_1_6_no_3 = `~ ((v15 \/ v20 \/ v41) /\ (~v15 \/ v20 \/ v41) /\ (v7 \/ v8 \/ ~v41) /\ (v7 \/ ~v8 \/ ~v41) /\ (~v7 \/ v42 \/ v50) /\ (~v7 \/ ~v42 \/ v50) /\ (v22 \/ v35 \/ ~v50) /\ (v22 \/ ~v35 \/ v45) /\ (v18 \/ ~v22 \/ v45) /\ (~v18 \/ ~v22 \/ v45) /\ (v33 \/ ~v45 \/ ~v50) /\ (~v7 \/ ~v33 \/ ~v50) /\ (v19 \/ ~v20 \/ v21) /\ (~v20 \/ v21 \/ ~v41) /\ (v19 \/ ~v20 \/ ~v21) /\ (v1 \/ v14 \/ v36) /\ (~v1 \/ v14 \/ v36) /\ (v13 \/ ~v14 \/ v36) /\ (v3 \/ v13 \/ ~v36) /\ (~v3 \/ v5 \/ ~v36) /\ (~v3 \/ ~v5 \/ v13) /\ (v4 \/ v44 \/ v49) /\ (~v4 \/ v17 \/ v49) /\ (~v4 \/ ~v17 \/ v44) /\ (~v13 \/ v31 \/ ~v44) /\ (~v13 \/ ~v31 \/ ~v44) /\ (v23 \/ v33 \/ ~v49) /\ (v23 \/ ~v33 \/ ~v49) /\ (~v19 \/ v37 \/ v42) /\ (~v19 \/ v37 \/ ~v42) /\ (~v23 \/ v29 \/ ~v37) /\ (~v23 \/ ~v29 \/ ~v37) /\ (~v24 \/ ~v26 \/ v32) /\ (v2 \/ ~v12 \/ ~v31) /\ (v17 \/ v28 \/ v40) /\ (~v15 \/ ~v17 \/ v40) /\ (v2 \/ v28 \/ v47) /\ (v26 \/ ~v28 \/ ~v39) /\ (v21 \/ ~v26 \/ ~v28) /\ (v16 \/ v24 \/ v29) /\ (v12 \/ ~v34 \/ ~v39) /\ (v10 \/ v31 \/ v40) /\ (~v6 \/ ~v32 \/ v35) /\ (v16 \/ ~v24 \/ v34) /\ (~v24 \/ ~v31 \/ v38) /\ (~v16 \/ ~v24 \/ ~v38) /\ (~v2 \/ ~v10 \/ ~v47) /\ (v4 \/ ~v16 \/ v27) /\ (~v1 \/ v24 \/ ~v30) /\ (~v18 \/ v26 \/ ~v46) /\ (v27 \/ v30 \/ ~v45) /\ (v4 \/ ~v14 \/ ~v44) /\ (~v29 \/ v43 \/ v47) /\ (~v8 \/ ~v10 \/ ~v46) /\ (~v11 \/ v39 \/ ~v43) /\ (~v11 \/ ~v40 \/ ~v43) /\ (v6 \/ ~v21 \/ v26) /\ (v8 \/ ~v25 \/ v46) /\ (~v25 \/ ~v38 \/ v46) /\ (v10 \/ ~v46 \/ ~v47) /\ (v25 \/ ~v32 \/ ~v40) /\ (v5 \/ v6 \/ ~v40) /\ (v11 \/ v15 \/ v16) /\ (v12 \/ v39 \/ v43) /\ (v5 \/ v11 \/ v32) /\ (~v5 \/ v17 \/ v32) /\ (~v12 \/ ~v40 \/ ~v48) /\ (~v2 \/ v18 \/ ~v30) /\ (v3 \/ v10 \/ ~v34) /\ (~v2 \/ ~v9 \/ v30) /\ (~v3 \/ ~v5 \/ ~v28) /\ (~v9 \/ v26 \/ v48) /\ (v22 \/ ~v27 \/ ~v48) /\ (v1 \/ v9 \/ v38) /\ (v3 \/ ~v6 \/ v48) /\ (v1 \/ ~v6 \/ v34) /\ (v15 \/ ~v35 \/ v48) /\ (v15 \/ v26 \/ ~v27) /\ (~v9 \/ ~v9 \/ ~v27) /\ (v1 \/ v9 \/ v25))` ;; (* Harder: runtime: 526.970s, gctime: 21.640s, systime: 0.650s. *) let aim_50_1_6_no_4 = `~ ((v1 \/ v32 \/ v34) /\ (v4 \/ v5 \/ v32) /\ (~v4 \/ v5 \/ ~v34) /\ (~v5 \/ v32 \/ ~v34) /\ (v29 \/ ~v32 \/ v43) /\ (v29 \/ v36 \/ ~v43) /\ (v29 \/ ~v32 \/ ~v36) /\ (v1 \/ v3 \/ ~v29) /\ (~v3 \/ ~v29 \/ ~v32) /\ (~v1 \/ v24 \/ v39) /\ (~v1 \/ v24 \/ ~v39) /\ (v7 \/ v18 \/ ~v24) /\ (~v7 \/ v18 \/ v28) /\ (~v7 \/ ~v21 \/ v28) /\ (~v7 \/ v17 \/ ~v28) /\ (v18 \/ ~v24 \/ ~v28) /\ (v2 \/ v17 \/ v40) /\ (~v17 \/ ~v18 \/ v40) /\ (v2 \/ v39 \/ ~v40) /\ (v2 \/ ~v39 \/ ~v40) /\ (~v2 \/ ~v18 \/ v35) /\ (~v2 \/ ~v18 \/ ~v35) /\ (v9 \/ ~v32 \/ v41) /\ (~v9 \/ v41 \/ v45) /\ (~v1 \/ ~v9 \/ ~v45) /\ (~v5 \/ v27 \/ v43) /\ (v14 \/ v16 \/ v26) /\ (v14 \/ ~v16 \/ v49) /\ (v12 \/ ~v14 \/ v26) /\ (~v12 \/ v26 \/ v35) /\ (v26 \/ v30 \/ ~v35) /\ (~v26 \/ v30 \/ v49) /\ (v9 \/ v13 \/ v25) /\ (v5 \/ ~v17 \/ v25) /\ (v15 \/ v30 \/ v47) /\ (~v20 \/ v27 \/ ~v49) /\ (v13 \/ ~v20 \/ ~v27) /\ (~v13 \/ ~v30 \/ ~v49) /\ (v3 \/ v8 \/ v37) /\ (v8 \/ v23 \/ ~v43) /\ (v10 \/ v19 \/ v22) /\ (v10 \/ ~v19 \/ v22) /\ (~v10 \/ ~v19 \/ v36) /\ (v4 \/ v21 \/ v38) /\ (~v4 \/ v38 \/ v46) /\ (v21 \/ ~v38 \/ ~v47) /\ (~v21 \/ v45 \/ v46) /\ (~v14 \/ ~v33 \/ ~v38) /\ (~v10 \/ v11 \/ ~v26) /\ (~v14 \/ v16 \/ ~v50) /\ (~v14 \/ ~v16 \/ ~v23) /\ (~v2 \/ ~v23 \/ ~v50) /\ (v12 \/ ~v47 \/ v50) /\ (v7 \/ v10 \/ v48) /\ (~v6 \/ ~v13 \/ ~v41) /\ (v11 \/ ~v41 \/ ~v48) /\ (v23 \/ ~v41 \/ ~v48) /\ (~v15 \/ v42 \/ v48) /\ (~v15 \/ ~v21 \/ ~v42) /\ (v11 \/ v34 \/ v44) /\ (~v27 \/ ~v34 \/ ~v46) /\ (v19 \/ v28 \/ v50) /\ (~v3 \/ v6 \/ ~v35) /\ (~v22 \/ ~v40 \/ ~v44) /\ (~v25 \/ ~v37 \/ ~v42) /\ (~v26 \/ ~v30 \/ ~v37) /\ (v6 \/ ~v31 \/ v42) /\ (v6 \/ ~v31 \/ ~v33) /\ (~v44 \/ ~v45 \/ v47) /\ (v4 \/ v20 \/ v47) /\ (~v6 \/ v44 \/ ~v46) /\ (~v11 \/ v12 \/ v20) /\ (~v8 \/ v10 \/ v28) /\ (~v22 \/ v31 \/ ~v36) /\ (v7 \/ ~v25 \/ v37) /\ (~v11 \/ v31 \/ v47) /\ (~v4 \/ v10 \/ ~v12) /\ (~v30 \/ ~v31 \/ v44) /\ (v7 \/ v15 \/ v33) /\ (~v8 \/ ~v11 \/ v33))` ;; let hostint1_be = `(wnpls <=> ~eos /\ ~s1 /\ ~s2 \/ eof /\ eos /\ s1 /\ ~s2 \/ eof /\ eos /\ ~mof /\ s1 /\ s2 \/ eos /\ ~s1 /\ s2 \/ ~eos /\ s1 /\ s2 \/ eof /\ eos /\ mof /\ s1 /\ s2 \/ ~eof /\ eos /\ ~mof /\ s1 /\ s2) /\ (rnp <=> ~eos /\ s1 /\ ~s2 \/ ~eof /\ eos /\ s1 /\ ~s2 \/ ~eof /\ eos /\ mof /\ s1 /\ s2) /\ (wnp <=> eos /\ ~s1 /\ s2 \/ ~eos /\ s1 /\ s2 \/ eof /\ eos /\ mof /\ s1 /\ s2 \/ ~eof /\ eos /\ ~mof /\ s1 /\ s2) /\ (fs <=> ~eos /\ ~s1 /\ s2 \/ eos /\ ~s1 /\ ~s2) /\ (ls <=> ~eos /\ ~s1 /\ ~s2 \/ eof /\ eos /\ s1 /\ ~s2 \/ eof /\ eos /\ ~mof /\ s1 /\ s2) /\ (s1 <=> ~eof /\ eos /\ mof /\ s1 /\ s2 \/ ~eos /\ s1 /\ ~s2 \/ ~eof /\ eos /\ s1 /\ ~s2 \/ ~eos /\ s1 /\ s2 \/ eof /\ eos /\ mof /\ s1 /\ s2 \/ ~eof /\ eos /\ ~mof /\ s1 /\ s2 \/ eos /\ ~s1 /\ s2) /\ (s2 <=> ~eos /\ s1 /\ s2 \/ eof /\ eos /\ mof /\ s1 /\ s2 \/ ~eof /\ eos /\ ~mof /\ s1 /\ s2 \/ eos /\ ~s1 /\ s2 \/ ~eos /\ ~s1 /\ s2 \/ eos /\ ~s1 /\ ~s2) ==> (s2 <=> eof /\ mof /\ s1 /\ s2 \/ ~eof /\ ~mof /\ s1 /\ s2 \/ ~eos /\ s1 /\ s2 \/ eos /\ ~s1 /\ s2 \/ ~eos /\ ~s1 /\ s2 \/ eos /\ ~s1 /\ ~s2) /\ (s1 <=> eof /\ mof /\ s1 /\ s2 \/ ~eof /\ eos /\ mof /\ s1 \/ ~eof /\ ~mof /\ s1 /\ s2 \/ ~eos /\ s1 /\ s2 \/ eos /\ ~s1 /\ s2 \/ ~eof /\ s1 /\ ~s2 \/ ~eos /\ s1 /\ ~s2) /\ (ls <=> eof /\ eos /\ ~mof /\ s1 \/ eof /\ eos /\ s1 /\ ~s2 \/ ~eos /\ ~s1 /\ ~s2) /\ (fs <=> ~eos /\ ~s1 /\ s2 \/ eos /\ ~s1 /\ ~s2) /\ (wnp <=> eof /\ mof /\ s1 /\ s2 \/ ~eof /\ ~mof /\ s1 /\ s2 \/ ~eos /\ s1 /\ s2 \/ eos /\ ~s1 /\ s2) /\ (rnp <=> ~eof /\ eos /\ mof /\ s1 \/ ~eof /\ s1 /\ ~s2 \/ ~eos /\ s1 /\ ~s2) /\ (wnpls <=> eof /\ mof /\ s1 /\ s2 \/ eof /\ eos /\ ~mof /\ s1 \/ ~eof /\ ~mof /\ s1 /\ s2 \/ ~eos /\ s1 /\ s2 \/ eos /\ ~s1 /\ s2 \/ eof /\ eos /\ s1 /\ ~s2 \/ ~eos /\ ~s1 /\ ~s2)` ;; (* Hard : runtime: 73.140s, gctime: 0.640s, systime: 0.020s. *) let aim_50_2_0_no_4 = `~ ((v2 \/ v26 \/ v32) /\ (v2 \/ ~v21 \/ v32) /\ (v2 \/ v3 \/ ~v26) /\ (~v2 \/ v22 \/ v44) /\ (~v2 \/ ~v22 \/ v44) /\ (~v2 \/ v23 \/ ~v44) /\ (v3 \/ ~v23 \/ v41) /\ (v3 \/ ~v41 \/ ~v44) /\ (~v3 \/ v9 \/ v20) /\ (~v3 \/ ~v20 \/ v32) /\ (v7 \/ v9 \/ ~v32) /\ (~v7 \/ v16 \/ ~v32) /\ (v9 \/ ~v16 \/ ~v32) /\ (v1 \/ v16 \/ v37) /\ (~v1 \/ v16 \/ v26) /\ (~v16 \/ v26 \/ v37) /\ (~v9 \/ ~v26 \/ v37) /\ (v5 \/ ~v9 \/ v46) /\ (v11 \/ v21 \/ ~v46) /\ (v5 \/ v21 \/ ~v46) /\ (~v5 \/ v21 \/ v39) /\ (~v5 \/ ~v37 \/ ~v39) /\ (~v9 \/ ~v21 \/ ~v37) /\ (v10 \/ ~v19 \/ ~v48) /\ (v10 \/ ~v13 \/ ~v19) /\ (v5 \/ ~v36 \/ v47) /\ (~v5 \/ ~v36 \/ v47) /\ (~v16 \/ v42 \/ ~v43) /\ (~v1 \/ v13 \/ ~v39) /\ (v8 \/ ~v27 \/ v30) /\ (v13 \/ v18 \/ ~v30) /\ (v8 \/ v13 \/ ~v18) /\ (~v13 \/ v15 \/ ~v17) /\ (~v13 \/ ~v15 \/ ~v30) /\ (~v17 \/ ~v27 \/ ~v45) /\ (~v12 \/ ~v27 \/ ~v45) /\ (~v18 \/ v25 \/ v40) /\ (~v18 \/ v34 \/ ~v40) /\ (v25 \/ ~v34 \/ v48) /\ (~v19 \/ ~v25 \/ v48) /\ (~v1 \/ ~v12 \/ ~v34) /\ (v20 \/ ~v25 \/ ~v43) /\ (v8 \/ v19 \/ ~v45) /\ (v17 \/ v29 \/ v34) /\ (~v17 \/ v29 \/ v41) /\ (v15 \/ ~v31 \/ ~v35) /\ (~v15 \/ ~v31 \/ ~v35) /\ (v34 \/ v39 \/ ~v43) /\ (~v11 \/ ~v14 \/ v45) /\ (~v11 \/ ~v12 \/ ~v14) /\ (~v24 \/ v28 \/ ~v39) /\ (~v8 \/ ~v24 \/ ~v30) /\ (v7 \/ ~v25 \/ v45) /\ (~v7 \/ ~v44 \/ v45) /\ (~v20 \/ v36 \/ v50) /\ (~v8 \/ v36 \/ v50) /\ (~v8 \/ ~v20 \/ ~v50) /\ (v20 \/ ~v41 \/ v44) /\ (v28 \/ ~v33 \/ v39) /\ (v28 \/ ~v33 \/ v47) /\ (v10 \/ v27 \/ v38) /\ (~v10 \/ v27 \/ v30) /\ (v4 \/ ~v10 \/ v38) /\ (~v6 \/ ~v35 \/ v41) /\ (v12 \/ v18 \/ v22) /\ (v17 \/ v22 \/ v30) /\ (v12 \/ v29 \/ v42) /\ (~v4 \/ v23 \/ v31) /\ (v1 \/ ~v4 \/ ~v31) /\ (~v4 \/ ~v6 \/ ~v22) /\ (~v22 \/ v40 \/ v50) /\ (v4 \/ ~v33 \/ v43) /\ (~v6 \/ ~v21 \/ v42) /\ (v7 \/ ~v24 \/ ~v47) /\ (~v3 \/ v31 \/ ~v46) /\ (v4 \/ v12 \/ ~v36) /\ (~v11 \/ ~v29 \/ v36) /\ (~v14 \/ ~v23 \/ ~v48) /\ (~v23 \/ ~v37 \/ ~v48) /\ (v15 \/ ~v42 \/ v43) /\ (~v7 \/ v24 \/ ~v50) /\ (~v10 \/ v33 \/ v46) /\ (v40 \/ ~v42 \/ v46) /\ (v14 \/ v24 \/ ~v49) /\ (v11 \/ v17 \/ ~v38) /\ (v19 \/ ~v28 \/ ~v47) /\ (v14 \/ v24 \/ v27) /\ (v6 \/ ~v15 \/ v43) /\ (v11 \/ v18 \/ ~v41) /\ (v1 \/ v6 \/ v49) /\ (~v29 \/ ~v47 \/ ~v50) /\ (v25 \/ ~v34 \/ ~v38) /\ (v6 \/ v31 \/ ~v49) /\ (v33 \/ v35 \/ v35) /\ (v33 \/ v35 \/ v48) /\ (v49 \/ v49 \/ ~v49) /\ (v23 \/ ~v29 \/ ~v40) /\ (v19 \/ ~v26 \/ ~v42) /\ (v14 \/ v38 \/ ~v38) /\ (~v28 \/ ~v28 \/ ~v40))` ;; (* Hard runtime: 170.440s, gctime: 1.940s, systime: 0.050s. *) let aim_50_2_0_no_1 = `~ ((v7 \/ v11 \/ v19) /\ (v7 \/ ~v11 \/ v27) /\ (v7 \/ v16 \/ ~v27) /\ (~v11 \/ v25 \/ v48) /\ (~v16 \/ v17 \/ ~v48) /\ (~v17 \/ v25 \/ ~v48) /\ (~v16 \/ ~v25 \/ ~v27) /\ (v19 \/ v36 \/ v49) /\ (~v7 \/ ~v36 \/ v49) /\ (~v7 \/ v19 \/ ~v49) /\ (v4 \/ v12 \/ v44) /\ (v4 \/ ~v12 \/ v44) /\ (v1 \/ ~v44 \/ v47) /\ (~v1 \/ v4 \/ v47) /\ (v20 \/ v34 \/ v48) /\ (~v19 \/ v20 \/ v34) /\ (v24 \/ ~v34 \/ ~v44) /\ (~v24 \/ ~v34 \/ ~v44) /\ (~v24 \/ ~v32 \/ v41) /\ (~v34 \/ ~v41 \/ ~v47) /\ (~v4 \/ ~v19 \/ v20) /\ (v30 \/ v39 \/ v41) /\ (~v30 \/ v39 \/ v50) /\ (~v20 \/ ~v30 \/ ~v50) /\ (~v20 \/ ~v39 \/ v41) /\ (~v19 \/ v32 \/ ~v41) /\ (~v20 \/ ~v32 \/ ~v41) /\ (v1 \/ v18 \/ ~v35) /\ (~v14 \/ v18 \/ ~v35) /\ (~v14 \/ ~v18 \/ v27) /\ (~v1 \/ v25 \/ ~v46) /\ (~v4 \/ v16 \/ ~v47) /\ (v11 \/ v16 \/ ~v25) /\ (~v4 \/ v11 \/ ~v25) /\ (~v27 \/ ~v35 \/ ~v47) /\ (v15 \/ v31 \/ v40) /\ (v10 \/ v39 \/ ~v49) /\ (~v8 \/ ~v10 \/ v21) /\ (~v21 \/ ~v26 \/ v30) /\ (v6 \/ ~v11 \/ v29) /\ (v6 \/ v31 \/ v50) /\ (v45 \/ v49 \/ ~v50) /\ (v31 \/ ~v45 \/ ~v50) /\ (v21 \/ v30 \/ v33) /\ (v2 \/ v37 \/ ~v49) /\ (~v2 \/ v17 \/ v37) /\ (~v8 \/ v14 \/ v32) /\ (~v14 \/ ~v15 \/ v32) /\ (~v1 \/ v37 \/ v47) /\ (v6 \/ ~v38 \/ v45) /\ (~v21 \/ ~v38 \/ v45) /\ (~v13 \/ ~v18 \/ ~v42) /\ (v2 \/ ~v6 \/ v22) /\ (~v2 \/ ~v6 \/ v22) /\ (v9 \/ ~v28 \/ ~v36) /\ (v8 \/ v29 \/ ~v39) /\ (~v8 \/ ~v38 \/ ~v39) /\ (~v12 \/ v17 \/ v38) /\ (v1 \/ ~v15 \/ ~v26) /\ (~v7 \/ ~v15 \/ ~v26) /\ (~v9 \/ v36 \/ v42) /\ (v12 \/ ~v16 \/ v21) /\ (~v10 \/ ~v23 \/ ~v46) /\ (~v9 \/ ~v29 \/ v34) /\ (~v9 \/ ~v21 \/ v42) /\ (~v12 \/ ~v23 \/ v38) /\ (~v30 \/ v38 \/ v40) /\ (v18 \/ v23 \/ v33) /\ (~v6 \/ v15 \/ v33) /\ (v9 \/ v27 \/ ~v43) /\ (v22 \/ v40 \/ ~v48) /\ (v8 \/ ~v22 \/ v26) /\ (~v5 \/ ~v33 \/ ~v36) /\ (v2 \/ ~v33 \/ v46) /\ (v5 \/ v10 \/ ~v42) /\ (v14 \/ ~v29 \/ ~v31) /\ (v12 \/ ~v23 \/ v26) /\ (v8 \/ v35 \/ v36) /\ (~v10 \/ ~v17 \/ ~v18) /\ (v10 \/ ~v22 \/ ~v28) /\ (v15 \/ ~v17 \/ ~v43) /\ (v23 \/ ~v29 \/ ~v37) /\ (v13 \/ ~v33 \/ v35) /\ (~v2 \/ v23 \/ v42) /\ (v9 \/ v43 \/ v46) /\ (v5 \/ ~v24 \/ ~v45) /\ (~v5 \/ v43 \/ v46) /\ (~v3 \/ ~v13 \/ ~v40) /\ (v3 \/ ~v28 \/ ~v42) /\ (v24 \/ ~v31 \/ v43) /\ (v14 \/ ~v22 \/ ~v32) /\ (v3 \/ v24 \/ v26) /\ (~v13 \/ ~v43 \/ v44) /\ (~v3 \/ ~v31 \/ ~v40) /\ (~v5 \/ ~v40 \/ v50) /\ (v35 \/ ~v37 \/ ~v45) /\ (~v3 \/ v5 \/ v28) /\ (v13 \/ v28 \/ ~v46) /\ (v3 \/ v28 \/ ~v37) /\ (v13 \/ v29 \/ v48))` ;; (* Hard *) let aim_50_2_0_no_2 = `~ ((v4 \/ v21 \/ v34) /\ (v21 \/ ~v34 \/ v40) /\ (v1 \/ ~v21 \/ v40) /\ (~v21 \/ v39 \/ v40) /\ (v20 \/ v29 \/ v41) /\ (~v20 \/ v39 \/ v41) /\ (v39 \/ ~v40 \/ v41) /\ (~v40 \/ ~v41 \/ v42) /\ (~v40 \/ ~v41 \/ ~v42) /\ (v1 \/ v25 \/ ~v39) /\ (v2 \/ ~v25 \/ ~v39) /\ (~v2 \/ v5 \/ ~v39) /\ (~v1 \/ v4 \/ v5) /\ (v15 \/ v26 \/ v33) /\ (v15 \/ v26 \/ ~v33) /\ (~v5 \/ ~v15 \/ v26) /\ (~v5 \/ ~v26 \/ v31) /\ (~v5 \/ ~v26 \/ ~v31) /\ (v6 \/ v9 \/ v47) /\ (v9 \/ v37 \/ v38) /\ (v9 \/ v14 \/ ~v38) /\ (~v14 \/ ~v38 \/ ~v47) /\ (~v9 \/ v11 \/ v37) /\ (~v9 \/ ~v11 \/ v37) /\ (v24 \/ ~v37 \/ v48) /\ (v24 \/ v46 \/ ~v48) /\ (~v24 \/ ~v37 \/ v46) /\ (v16 \/ v18 \/ ~v46) /\ (~v16 \/ v18 \/ ~v46) /\ (~v18 \/ ~v37 \/ ~v46) /\ (~v4 \/ ~v6 \/ v15) /\ (~v4 \/ v13 \/ ~v15) /\ (~v4 \/ ~v13 \/ ~v15) /\ (~v1 \/ ~v6 \/ v38) /\ (v3 \/ ~v9 \/ v35) /\ (v7 \/ v43 \/ v44) /\ (v7 \/ v29 \/ v43) /\ (~v8 \/ ~v29 \/ v44) /\ (~v29 \/ ~v32 \/ v48) /\ (~v14 \/ v30 \/ v46) /\ (~v1 \/ ~v14 \/ ~v30) /\ (~v11 \/ v20 \/ v49) /\ (v20 \/ ~v44 \/ ~v49) /\ (v16 \/ v22 \/ ~v27) /\ (v13 \/ ~v19 \/ ~v35) /\ (v2 \/ v19 \/ ~v33) /\ (v2 \/ v19 \/ ~v28) /\ (v33 \/ ~v34 \/ ~v44) /\ (~v33 \/ ~v44 \/ v50) /\ (v5 \/ v30 \/ ~v48) /\ (v10 \/ v22 \/ ~v50) /\ (~v10 \/ v22 \/ ~v34) /\ (v1 \/ v10 \/ ~v47) /\ (~v10 \/ ~v25 \/ ~v47) /\ (~v25 \/ ~v27 \/ v50) /\ (v11 \/ v21 \/ v23) /\ (~v3 \/ v11 \/ v23) /\ (~v3 \/ v6 \/ ~v50) /\ (~v6 \/ v23 \/ ~v50) /\ (~v31 \/ ~v43 \/ v44) /\ (~v7 \/ v16 \/ ~v26) /\ (~v23 \/ v28 \/ ~v38) /\ (v19 \/ v28 \/ v50) /\ (~v18 \/ v45 \/ v49) /\ (~v2 \/ ~v16 \/ ~v48) /\ (v7 \/ v14 \/ ~v42) /\ (v12 \/ v25 \/ ~v36) /\ (v10 \/ ~v24 \/ ~v45) /\ (~v21 \/ v32 \/ ~v42) /\ (v12 \/ ~v18 \/ ~v27) /\ (~v13 \/ ~v23 \/ ~v24) /\ (v25 \/ v29 \/ v38) /\ (~v8 \/ v43 \/ ~v45) /\ (~v2 \/ ~v12 \/ v13) /\ (~v7 \/ v14 \/ v30) /\ (~v8 \/ ~v17 \/ ~v19) /\ (v8 \/ ~v22 \/ v49) /\ (~v12 \/ ~v17 \/ v33) /\ (v27 \/ ~v29 \/ v32) /\ (v8 \/ ~v12 \/ ~v13) /\ (v24 \/ ~v31 \/ v47) /\ (~v3 \/ v36 \/ v47) /\ (v3 \/ v12 \/ v34) /\ (~v7 \/ ~v16 \/ v36) /\ (~v22 \/ v31 \/ v48) /\ (v17 \/ ~v22 \/ ~v49) /\ (~v17 \/ ~v19 \/ v32) /\ (~v20 \/ v27 \/ v36) /\ (v18 \/ ~v32 \/ ~v35) /\ (v3 \/ ~v28 \/ ~v30) /\ (v17 \/ v34 \/ v42) /\ (~v32 \/ ~v43 \/ ~v49) /\ (v17 \/ ~v28 \/ ~v43) /\ (~v23 \/ v35 \/ ~v45) /\ (~v10 \/ v31 \/ ~v36) /\ (v27 \/ ~v41 \/ v42) /\ (v35 \/ ~v36 \/ v45) /\ (v8 \/ ~v30 \/ v45) /\ (v4 \/ v28 \/ ~v35) /\ (v6 \/ ~v11 \/ ~v20))` ;; (* Hard *) let aim_50_2_0_no_3 = `~ ((v33 \/ v37 \/ v43) /\ (v21 \/ ~v37 \/ v43) /\ (~v21 \/ ~v37 \/ v39) /\ (v23 \/ v39 \/ ~v43) /\ (v13 \/ ~v23 \/ v31) /\ (~v13 \/ ~v23 \/ v31) /\ (~v23 \/ ~v31 \/ ~v43) /\ (v6 \/ v9 \/ v25) /\ (~v6 \/ v9 \/ v25) /\ (v9 \/ v33 \/ ~v38) /\ (~v9 \/ v25 \/ ~v39) /\ (v24 \/ ~v25 \/ ~v39) /\ (~v24 \/ ~v25 \/ v33) /\ (v6 \/ v27 \/ v41) /\ (~v6 \/ v14 \/ v41) /\ (v14 \/ ~v41 \/ v43) /\ (v14 \/ ~v41 \/ ~v43) /\ (v1 \/ v20 \/ v27) /\ (v1 \/ v12 \/ ~v20) /\ (v1 \/ ~v12 \/ ~v14) /\ (~v1 \/ v27 \/ v28) /\ (~v1 \/ ~v14 \/ ~v28) /\ (~v1 \/ ~v11 \/ ~v14) /\ (~v27 \/ ~v33 \/ v39) /\ (v5 \/ v20 \/ v28) /\ (v19 \/ v29 \/ ~v33) /\ (~v19 \/ ~v20 \/ v29) /\ (~v20 \/ v28 \/ ~v29) /\ (v5 \/ ~v28 \/ v37) /\ (v5 \/ ~v28 \/ ~v37) /\ (~v5 \/ ~v33 \/ ~v39) /\ (v7 \/ v17 \/ v22) /\ (~v5 \/ v7 \/ v17) /\ (~v7 \/ v18 \/ v22) /\ (v22 \/ ~v24 \/ v41) /\ (~v7 \/ v12 \/ v18) /\ (~v12 \/ v18 \/ v34) /\ (~v12 \/ v34 \/ ~v42) /\ (~v7 \/ ~v34 \/ ~v41) /\ (~v16 \/ ~v29 \/ v35) /\ (~v3 \/ v13 \/ ~v29) /\ (~v21 \/ ~v30 \/ v37) /\ (~v15 \/ ~v21 \/ v47) /\ (~v8 \/ v24 \/ v40) /\ (~v3 \/ ~v8 \/ v42) /\ (~v3 \/ ~v8 \/ ~v42) /\ (~v2 \/ v30 \/ v36) /\ (~v2 \/ ~v30 \/ v36) /\ (~v4 \/ ~v35 \/ v44) /\ (v42 \/ ~v45 \/ ~v50) /\ (~v42 \/ ~v45 \/ ~v50) /\ (~v11 \/ v15 \/ ~v40) /\ (v3 \/ v46 \/ v48) /\ (v3 \/ ~v46 \/ v48) /\ (~v11 \/ v30 \/ v50) /\ (~v16 \/ v30 \/ v50) /\ (v4 \/ ~v36 \/ ~v40) /\ (v8 \/ v46 \/ v47) /\ (v24 \/ ~v40 \/ v44) /\ (v12 \/ v16 \/ ~v46) /\ (v2 \/ v6 \/ ~v36) /\ (~v6 \/ ~v44 \/ v46) /\ (~v22 \/ v32 \/ ~v36) /\ (v3 \/ v32 \/ v38) /\ (~v27 \/ ~v35 \/ v38) /\ (v11 \/ v16 \/ ~v47) /\ (v31 \/ ~v45 \/ ~v46) /\ (v19 \/ ~v24 \/ v32) /\ (~v15 \/ v23 \/ ~v31) /\ (v4 \/ ~v34 \/ ~v49) /\ (v11 \/ ~v22 \/ ~v49) /\ (v23 \/ ~v26 \/ v50) /\ (~v9 \/ ~v31 \/ ~v32) /\ (~v2 \/ ~v27 \/ v35) /\ (v26 \/ v34 \/ v45) /\ (v7 \/ v36 \/ v47) /\ (~v4 \/ ~v30 \/ v49) /\ (~v26 \/ ~v44 \/ ~v50) /\ (v2 \/ v40 \/ v48) /\ (v26 \/ ~v44 \/ ~v47) /\ (~v18 \/ v19 \/ ~v25) /\ (~v38 \/ v42 \/ v49) /\ (v13 \/ ~v22 \/ v49) /\ (~v10 \/ ~v32 \/ ~v48) /\ (v2 \/ ~v19 \/ v29) /\ (~v13 \/ ~v15 \/ v26) /\ (~v10 \/ ~v17 \/ v20) /\ (~v17 \/ v21 \/ v45) /\ (~v4 \/ ~v13 \/ ~v26) /\ (~v9 \/ v21 \/ ~v48) /\ (~v10 \/ v35 \/ v44) /\ (~v32 \/ ~v48 \/ ~v49) /\ (v4 \/ ~v16 \/ ~v19) /\ (~v5 \/ v8 \/ v40) /\ (v15 \/ ~v18 \/ ~v35) /\ (v8 \/ v10 \/ ~v47) /\ (v10 \/ v15 \/ v45) /\ (v10 \/ ~v18 \/ ~v34) /\ (v16 \/ v17 \/ v38) /\ (v11 \/ ~v17 \/ ~v38))` ;; let mul_be = `(ba0 <=> ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl) /\ (ba1 <=> ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~c17 /\ ~repl) /\ (ba2 <=> ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~c17 /\ ~repl) /\ (by0 <=> ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl) /\ (by1 <=> ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ c1 \/ c0 \/ repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ ~c17) /\ (bx0 <=> ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl) /\ (bx1 <=> ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ ~c0 /\ c1 \/ c0 \/ repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ ~c17) ==> (bx1 <=> repl \/ ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ ~c14 /\ ~c15 /\ ~c16 /\ ~c17 \/ c1 \/ c0) /\ (bx0 <=> ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~repl) /\ (by1 <=> repl \/ ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c14 /\ ~c15 /\ ~c16 /\ ~c17 \/ c1 \/ c0) /\ (by0 <=> ~c0 /\ ~c1 /\ ~c14 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~repl) /\ (ba2 <=> ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~repl) /\ (ba1 <=> ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~repl) /\ (ba0 <=> ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ ~c16 /\ c17 /\ ~repl \/ ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ c16 /\ ~c17 /\ ~repl \/ ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl)` ;; let dk17_be = `(ge17 <=> ~in4 /\ ~in3 /\ ~in2 /\ ~in1) /\ (ge0 <=> ge17 /\ ~in5) /\ (ge22 <=> ~in9 /\ ~in7 /\ ~in6 /\ in0) /\ (ge19 <=> ~in5 /\ ~in4 /\ ~in3 /\ ~in0) /\ (ge20 <=> ~in7 /\ ~in6) /\ (ge18 <=> ~in6 /\ ~in2 /\ ~in1 /\ ~in0) /\ (ge21 <=> in9 /\ ~in7 /\ in6 /\ ~in0) /\ (ge23 <=> ge22 /\ ge0) /\ (ge25 <=> ~in9 /\ ~in7 /\ in6 /\ ~in0) /\ (ge26 <=> in9 /\ ~in7 /\ ~in6 /\ in0) /\ (ge2 <=> ge20 /\ ge19) /\ (ge1 <=> ge18 /\ ~in7) /\ (ge24 <=> ge23 \/ ge21 /\ ge0) /\ (ge5 <=> ~in5 /\ in4 \/ in5 /\ ~in4) /\ (ge6 <=> ge0 /\ in7 /\ ~in6 /\ ~in0) /\ (ge12 <=> ge26 /\ ge0 \/ ge25 /\ ge0) /\ (ge14 <=> ge2 /\ in8 /\ ~in2 /\ in1) /\ (ge27 <=> ~in8 /\ in5 /\ ~in4 /\ ~in3) /\ (ge9 <=> ge1 /\ ~in5 /\ ~in4 /\ in3) /\ (ge7 <=> ge24 \/ ge2 /\ in2 /\ ~in1) /\ (ge10 <=> ge6 \/ ge5 /\ ge1 /\ ~in3) /\ (ge15 <=> ~in8 \/ in9) /\ (ge16 <=> ge12 \/ ge14 /\ ~in9) /\ (ge4 <=> ge5 /\ ge1 /\ in8 /\ ~in3 \/ ge0 /\ ~in7 /\ in6 /\ ~in0 \/ ge2 /\ in2 /\ ~in1) /\ (ge13 <=> ge27 /\ ge1) /\ (ge11 <=> ge9 \/ ge6 /\ ~in8) /\ (ge8 <=> ge1 /\ ~in5 /\ in4 /\ ~in3 \/ ge2 /\ ~in2 /\ in1) /\ (out0 <=> ge7 /\ ~in8) /\ (out1 <=> ge7 /\ in8) /\ (out2 <=> ge8 /\ ~in9 \/ ge10 /\ in8) /\ (out3 <=> ge8 /\ in9 /\ ~in8 \/ ge11 /\ ~in9 \/ ge12 /\ ~in8) /\ (out4 <=> ge11 /\ in9 \/ ge12 /\ in8) /\ (out5 <=> ge14 /\ in9) /\ (out6 <=> ge13 /\ ~in9) /\ (out7 <=> ge13 /\ in9) /\ (out8 <=> ge9 /\ ~in8 \/ ge15 /\ ge6 \/ ge4 /\ in9) /\ (out9 <=> ge9 /\ in8 \/ ~ge15 /\ ge10 \/ ge16) /\ (out10 <=> ge7) /\ (wres0 <=> ~in5 /\ ~in4 /\ ~in3 /\ ~in2 /\ ~in1) /\ (wres1 <=> ~in7 /\ ~in6 /\ ~in2 /\ ~in1 /\ ~in0) /\ (wres2 <=> ~in7 /\ ~in6 /\ ~in5 /\ ~in4 /\ ~in3 /\ ~in0) /\ (wres5 <=> ~in5 /\ in4 \/ in5 /\ ~in4) /\ (wres6 <=> wres0 /\ in7 /\ ~in6 /\ ~in0) /\ (wres9 <=> wres1 /\ ~in5 /\ ~in4 /\ in3) /\ (wres7 <=> wres0 /\ ~in9 /\ ~in7 /\ ~in6 /\ in0 \/ wres0 /\ in9 /\ ~in7 /\ in6 /\ ~in0 \/ wres2 /\ in2 /\ ~in1) /\ (wres10 <=> wres6 \/ wres5 /\ wres1 /\ ~in3) /\ (wres12 <=> wres0 /\ in9 /\ ~in7 /\ ~in6 /\ in0 \/ wres0 /\ ~in9 /\ ~in7 /\ in6 /\ ~in0) /\ (wres14 <=> wres2 /\ in8 /\ ~in2 /\ in1) /\ (wres15 <=> ~in8 \/ in9) /\ (wres4 <=> wres5 /\ wres1 /\ in8 /\ ~in3 \/ wres2 /\ in2 /\ ~in1 \/ wres0 /\ ~in7 /\ in6 /\ ~in0) /\ (wres13 <=> wres1 /\ ~in8 /\ in5 /\ ~in4 /\ ~in3) /\ (wres11 <=> wres9 \/ wres6 /\ ~in8) /\ (wres8 <=> wres1 /\ ~in5 /\ in4 /\ ~in3 \/ wres2 /\ ~in2 /\ in1) ==> (out10 <=> wres7) /\ (out9 <=> wres9 /\ in8 \/ wres12 \/ wres14 /\ ~in9 \/ ~wres15 /\ wres10) /\ (out8 <=> wres9 /\ ~in8 \/ wres15 /\ wres6 \/ wres4 /\ in9) /\ (out7 <=> wres13 /\ in9) /\ (out6 <=> wres13 /\ ~in9) /\ (out5 <=> wres14 /\ in9) /\ (out4 <=> wres11 /\ in9 \/ wres12 /\ in8) /\ (out3 <=> wres8 /\ in9 /\ ~in8 \/ wres11 /\ ~in9 \/ wres12 /\ ~in8) /\ (out2 <=> wres8 /\ ~in9 \/ wres10 /\ in8) /\ (out1 <=> wres7 /\ in8) /\ (out0 <=> wres7 /\ ~in8)` ;; (* Hard *) let risc_be = `(ge1 <=> ~in4 /\ ~in2 /\ ~in1 /\ in0) /\ (ge2 <=> in2 /\ ~in1 /\ ~in0) /\ (ge3 <=> in2 /\ ~in1 /\ in0) /\ (ge8 <=> in2 /\ in1) /\ (ge16 <=> ~in2 /\ in1) /\ (ge5 <=> ~in3 /\ ~in2 /\ in1 /\ in0) /\ (ge11 <=> ge1 /\ in3) /\ (ge0 <=> ~in3 /\ ~in2 /\ in1 /\ ~in0) /\ (ge9 <=> ge2 /\ in3) /\ (ge10 <=> ge3 /\ ~in3) /\ (ge17 <=> ~in4 /\ in3) /\ (ge20 <=> ge2 /\ ~in3) /\ (ge15 <=> ge8 /\ in0) /\ (ge19 <=> ge1 /\ in5) /\ (ge6 <=> ge16 \/ in4 /\ ~in2) /\ (ge13 <=> ge11 \/ ge5) /\ (ge4 <=> in2 \/ in1 \/ in0) /\ (ge7 <=> ~in6 /\ in5 \/ in4) /\ (ge12 <=> ge0 /\ ~in6 /\ ~in4 \/ ge0 /\ ~in5 /\ ~in4) /\ (ge14 <=> ge8 /\ ~in0) /\ (ge18 <=> ge9 /\ in4) /\ (out0 <=> ge12 \/ ge18) /\ (out1 <=> ge9 /\ in5 /\ ~in4) /\ (out2 <=> ge17 /\ in5 /\ in2 /\ ~in0 \/ ge5 \/ ge14) /\ (out3 <=> ge1 /\ in7 \/ ge13) /\ (out4 <=> ge3 \/ ~ge4) /\ (out5 <=> ge9) /\ (out6 <=> ge20) /\ (out7 <=> ge2 /\ ~in5 \/ ge18) /\ (out8 <=> ge14) /\ (out9 <=> ge12) /\ (out10 <=> ge0) /\ (out11 <=> ~ge7 /\ ge0) /\ (out12 <=> ge7 /\ ge0) /\ (out13 <=> ge16 /\ ~in0) /\ (out14 <=> ~ge4) /\ (out15 <=> ge4) /\ (out16 <=> ge10 /\ in5) /\ (out17 <=> ge10 /\ ~in5) /\ (out18 <=> ~ge4 /\ ~in4 /\ ~in3) /\ (out19 <=> ~ge4 /\ in3) /\ (out20 <=> ge15) /\ (out21 <=> ge13) /\ (out22 <=> ge11) /\ (out23 <=> ge1 /\ ~in3) /\ (out24 <=> ge19) /\ (out25 <=> ge6 /\ in3 /\ in0) /\ (out26 <=> ge19 \/ ge15) /\ (out27 <=> in1 /\ ~in0) /\ (out28 <=> ge20 /\ in5) /\ (out29 <=> ge17 /\ ge3) /\ (out30 <=> ge10 /\ ~in4) /\ (wres1 <=> ~in4 /\ ~in2 /\ ~in1 /\ in0) /\ (wres2 <=> in2 /\ ~in1 /\ ~in0) /\ (wres3 <=> in2 /\ ~in1 /\ in0) /\ (wres8 <=> in2 /\ in1) /\ (wres16 <=> ~in2 /\ in1) /\ (wres5 <=> ~in3 /\ ~in2 /\ in1 /\ in0) /\ (wres11 <=> wres1 /\ in3) /\ (wres0 <=> ~in3 /\ ~in2 /\ in1 /\ ~in0) /\ (wres9 <=> wres2 /\ in3) /\ (wres10 <=> wres3 /\ ~in3) /\ (wres17 <=> ~in4 /\ in3) /\ (wres20 <=> wres2 /\ ~in3) /\ (wres15 <=> wres8 /\ in0) /\ (wres19 <=> wres1 /\ in5) /\ (wres6 <=> wres16 \/ in4 /\ ~in2) /\ (wres13 <=> wres11 \/ wres5) /\ (wres4 <=> in2 \/ in1 \/ in0) /\ (wres7 <=> ~in6 /\ in5 \/ in4) /\ (wres12 <=> wres0 /\ ~in6 /\ ~in4 \/ wres0 /\ ~in5 /\ ~in4) /\ (wres14 <=> wres8 /\ ~in0) /\ (wres18 <=> wres9 /\ in4) ==> (out30 <=> wres10 /\ ~in4) /\ (out29 <=> wres17 /\ wres3) /\ (out28 <=> wres20 /\ in5) /\ (out27 <=> in1 /\ ~in0) /\ (out26 <=> wres19 \/ wres15) /\ (out25 <=> wres6 /\ in3 /\ in0) /\ (out24 <=> wres19) /\ (out23 <=> wres1 /\ ~in3) /\ (out22 <=> wres11) /\ (out21 <=> wres13) /\ (out20 <=> wres15) /\ (out19 <=> ~wres4 /\ in3) /\ (out18 <=> ~wres4 /\ ~in4 /\ ~in3) /\ (out17 <=> wres10 /\ ~in5) /\ (out16 <=> wres10 /\ in5) /\ (out15 <=> wres4) /\ (out14 <=> ~wres4) /\ (out13 <=> wres16 /\ ~in0) /\ (out12 <=> wres7 /\ wres0) /\ (out11 <=> ~wres7 /\ wres0) /\ (out10 <=> wres0) /\ (out9 <=> wres12) /\ (out8 <=> wres14) /\ (out7 <=> wres2 /\ ~in5 \/ wres18) /\ (out6 <=> wres20) /\ (out5 <=> wres9) /\ (out4 <=> wres3 \/ ~wres4) /\ (out3 <=> wres1 /\ in7 \/ wres13) /\ (out2 <=> wres5 \/ wres14 \/ wres17 /\ in5 /\ in2 /\ ~in0) /\ (out1 <=> wres9 /\ in5 /\ ~in4) /\ (out0 <=> wres12 \/ wres18)` ;; let msc006_1 = `~((~v5 \/ ~v0 \/ v0) /\ (~v5 \/ ~v2 \/ v2) /\ (~v5 \/ ~v31 \/ v31) /\ (~v5 \/ ~v5 \/ v5) /\ (~v13 \/ ~v0 \/ v7) /\ (~v13 \/ ~v2 \/ v9) /\ (~v13 \/ ~v31 \/ v11) /\ (~v13 \/ ~v5 \/ v13) /\ (~v20 \/ ~v0 \/ v15) /\ (~v20 \/ ~v2 \/ v16) /\ (~v20 \/ ~v31 \/ v18) /\ (~v20 \/ ~v5 \/ v20) /\ (~v28 \/ ~v0 \/ v22) /\ (~v28 \/ ~v2 \/ v24) /\ (~v28 \/ ~v31 \/ v26) /\ (~v28 \/ ~v5 \/ v28) /\ (~v31 \/ ~v7 \/ v0) /\ (~v31 \/ ~v9 \/ v2) /\ (~v31 \/ ~v11 \/ v31) /\ (~v31 \/ ~v13 \/ v5) /\ (~v11 \/ ~v7 \/ v7) /\ (~v11 \/ ~v9 \/ v9) /\ (~v11 \/ ~v11 \/ v11) /\ (~v11 \/ ~v13 \/ v13) /\ (~v18 \/ ~v7 \/ v15) /\ (~v18 \/ ~v9 \/ v16) /\ (~v18 \/ ~v11 \/ v18) /\ (~v18 \/ ~v13 \/ v20) /\ (~v26 \/ ~v7 \/ v22) /\ (~v26 \/ ~v9 \/ v24) /\ (~v26 \/ ~v11 \/ v26) /\ (~v26 \/ ~v13 \/ v28) /\ (~v2 \/ ~v15 \/ v0) /\ (~v2 \/ ~v16 \/ v2) /\ (~v2 \/ ~v18 \/ v31) /\ (~v2 \/ ~v20 \/ v5) /\ (~v9 \/ ~v15 \/ v7) /\ (~v9 \/ ~v16 \/ v9) /\ (~v9 \/ ~v18 \/ v11) /\ (~v9 \/ ~v20 \/ v13) /\ (~v16 \/ ~v15 \/ v15) /\ (~v16 \/ ~v16 \/ v16) /\ (~v16 \/ ~v18 \/ v18) /\ (~v16 \/ ~v20 \/ v20) /\ (~v24 \/ ~v15 \/ v22) /\ (~v24 \/ ~v16 \/ v24) /\ (~v24 \/ ~v18 \/ v26) /\ (~v24 \/ ~v20 \/ v28) /\ (~v0 \/ ~v22 \/ v0) /\ (~v0 \/ ~v24 \/ v2) /\ (~v0 \/ ~v26 \/ v31) /\ (~v0 \/ ~v28 \/ v5) /\ (~v7 \/ ~v22 \/ v7) /\ (~v7 \/ ~v24 \/ v9) /\ (~v7 \/ ~v26 \/ v11) /\ (~v7 \/ ~v28 \/ v13) /\ (~v15 \/ ~v22 \/ v15) /\ (~v15 \/ ~v24 \/ v16) /\ (~v15 \/ ~v26 \/ v18) /\ (~v15 \/ ~v28 \/ v20) /\ (~v22 \/ ~v22 \/ v22) /\ (~v22 \/ ~v24 \/ v24) /\ (~v22 \/ ~v26 \/ v26) /\ (~v22 \/ ~v28 \/ v28) /\ (~v6 \/ ~v1 \/ v1) /\ (~v6 \/ ~v3 \/ v3) /\ (~v6 \/ ~v4 \/ v4) /\ (~v6 \/ ~v6 \/ v6) /\ (~v14 \/ ~v1 \/ v8) /\ (~v14 \/ ~v3 \/ v10) /\ (~v14 \/ ~v4 \/ v12) /\ (~v14 \/ ~v6 \/ v14) /\ (~v21 \/ ~v1 \/ v30) /\ (~v21 \/ ~v3 \/ v17) /\ (~v21 \/ ~v4 \/ v19) /\ (~v21 \/ ~v6 \/ v21) /\ (~v29 \/ ~v1 \/ v23) /\ (~v29 \/ ~v3 \/ v25) /\ (~v29 \/ ~v4 \/ v27) /\ (~v29 \/ ~v6 \/ v29) /\ (~v4 \/ ~v8 \/ v1) /\ (~v4 \/ ~v10 \/ v3) /\ (~v4 \/ ~v12 \/ v4) /\ (~v4 \/ ~v14 \/ v6) /\ (~v12 \/ ~v8 \/ v8) /\ (~v12 \/ ~v10 \/ v10) /\ (~v12 \/ ~v12 \/ v12) /\ (~v12 \/ ~v14 \/ v14) /\ (~v19 \/ ~v8 \/ v30) /\ (~v19 \/ ~v10 \/ v17) /\ (~v19 \/ ~v12 \/ v19) /\ (~v19 \/ ~v14 \/ v21) /\ (~v27 \/ ~v8 \/ v23) /\ (~v27 \/ ~v10 \/ v25) /\ (~v27 \/ ~v12 \/ v27) /\ (~v27 \/ ~v14 \/ v29) /\ (~v3 \/ ~v30 \/ v1) /\ (~v3 \/ ~v17 \/ v3) /\ (~v3 \/ ~v19 \/ v4) /\ (~v3 \/ ~v21 \/ v6) /\ (~v10 \/ ~v30 \/ v8) /\ (~v10 \/ ~v17 \/ v10) /\ (~v10 \/ ~v19 \/ v12) /\ (~v10 \/ ~v21 \/ v14) /\ (~v17 \/ ~v30 \/ v30) /\ (~v17 \/ ~v17 \/ v17) /\ (~v17 \/ ~v19 \/ v19) /\ (~v17 \/ ~v21 \/ v21) /\ (~v25 \/ ~v30 \/ v23) /\ (~v25 \/ ~v17 \/ v25) /\ (~v25 \/ ~v19 \/ v27) /\ (~v25 \/ ~v21 \/ v29) /\ (~v1 \/ ~v23 \/ v1) /\ (~v1 \/ ~v25 \/ v3) /\ (~v1 \/ ~v27 \/ v4) /\ (~v1 \/ ~v29 \/ v6) /\ (~v8 \/ ~v23 \/ v8) /\ (~v8 \/ ~v25 \/ v10) /\ (~v8 \/ ~v27 \/ v12) /\ (~v8 \/ ~v29 \/ v14) /\ (~v30 \/ ~v23 \/ v30) /\ (~v30 \/ ~v25 \/ v17) /\ (~v30 \/ ~v27 \/ v19) /\ (~v30 \/ ~v29 \/ v21) /\ (~v23 \/ ~v23 \/ v23) /\ (~v23 \/ ~v25 \/ v25) /\ (~v23 \/ ~v27 \/ v27) /\ (~v23 \/ ~v29 \/ v29) /\ (~v29 \/ v1) /\ (~v21 \/ v3) /\ (~v14 \/ v4) /\ (~v6 \/ v6) /\ (~v27 \/ v8) /\ (~v19 \/ v10) /\ (~v12 \/ v12) /\ (~v4 \/ v14) /\ (~v25 \/ v30) /\ (~v17 \/ v17) /\ (~v10 \/ v19) /\ (~v3 \/ v21) /\ (~v23 \/ v23) /\ (~v30 \/ v25) /\ (~v8 \/ v27) /\ (~v1 \/ v29) /\ (v0 \/ v1) /\ (v2 \/ v3) /\ (v31 \/ v4) /\ (v5 \/ v6) /\ (v7 \/ v8) /\ (v9 \/ v10) /\ (v11 \/ v12) /\ (v13 \/ v14) /\ (v15 \/ v30) /\ (v16 \/ v17) /\ (v18 \/ v19) /\ (v20 \/ v21) /\ (v22 \/ v23) /\ (v24 \/ v25) /\ (v26 \/ v27) /\ (v28 \/ v29) /\ ~v30 /\ ~v31)` ;; let syn072_1 = `~(v11 /\ v9 /\ v7 /\ v23 /\ v24 /\ (~v16 \/ v0) /\ (~v18 \/ v1) /\ (~v20 \/ v2) /\ (~v22 \/ v25) /\ (~v24 \/ v24) /\ (~v17 \/ v3) /\ (~v19 \/ v4) /\ (~v21 \/ v5) /\ (~v23 \/ v23) /\ (~v25 \/ v22) /\ (~v13 \/ v6) /\ (~v10 \/ v27) /\ (~v7 \/ v7) /\ (~v5 \/ v21) /\ (~v2 \/ v20) /\ (~v12 \/ v8) /\ (~v9 \/ v9) /\ (~v27 \/ v10) /\ (~v4 \/ v19) /\ (~v1 \/ v18) /\ (~v11 \/ v11) /\ (~v8 \/ v12) /\ (~v6 \/ v13) /\ (~v3 \/ v17) /\ (~v0 \/ v16) /\ (~v24 \/ ~v0 \/ v0) /\ (~v24 \/ ~v1 \/ v1) /\ (~v24 \/ ~v2 \/ v2) /\ (~v24 \/ ~v25 \/ v25) /\ (~v24 \/ ~v24 \/ v24) /\ (~v22 \/ ~v0 \/ v3) /\ (~v22 \/ ~v1 \/ v4) /\ (~v22 \/ ~v2 \/ v5) /\ (~v22 \/ ~v25 \/ v23) /\ (~v22 \/ ~v24 \/ v22) /\ (~v20 \/ ~v0 \/ v6) /\ (~v20 \/ ~v1 \/ v27) /\ (~v20 \/ ~v2 \/ v7) /\ (~v20 \/ ~v25 \/ v21) /\ (~v20 \/ ~v24 \/ v20) /\ (~v18 \/ ~v0 \/ v8) /\ (~v18 \/ ~v1 \/ v9) /\ (~v18 \/ ~v2 \/ v10) /\ (~v18 \/ ~v25 \/ v19) /\ (~v18 \/ ~v24 \/ v18) /\ (~v16 \/ ~v0 \/ v11) /\ (~v16 \/ ~v1 \/ v12) /\ (~v16 \/ ~v2 \/ v13) /\ (~v16 \/ ~v25 \/ v17) /\ (~v16 \/ ~v24 \/ v16) /\ (~v25 \/ ~v3 \/ v0) /\ (~v25 \/ ~v4 \/ v1) /\ (~v25 \/ ~v5 \/ v2) /\ (~v25 \/ ~v23 \/ v25) /\ (~v25 \/ ~v22 \/ v24) /\ (~v23 \/ ~v3 \/ v3) /\ (~v23 \/ ~v4 \/ v4) /\ (~v23 \/ ~v5 \/ v5) /\ (~v23 \/ ~v23 \/ v23) /\ (~v23 \/ ~v22 \/ v22) /\ (~v21 \/ ~v3 \/ v6) /\ (~v21 \/ ~v4 \/ v27) /\ (~v21 \/ ~v5 \/ v7) /\ (~v21 \/ ~v23 \/ v21) /\ (~v21 \/ ~v22 \/ v20) /\ (~v19 \/ ~v3 \/ v8) /\ (~v19 \/ ~v4 \/ v9) /\ (~v19 \/ ~v5 \/ v10) /\ (~v19 \/ ~v23 \/ v19) /\ (~v19 \/ ~v22 \/ v18) /\ (~v17 \/ ~v3 \/ v11) /\ (~v17 \/ ~v4 \/ v12) /\ (~v17 \/ ~v5 \/ v13) /\ (~v17 \/ ~v23 \/ v17) /\ (~v17 \/ ~v22 \/ v16) /\ (~v2 \/ ~v6 \/ v0) /\ (~v2 \/ ~v27 \/ v1) /\ (~v2 \/ ~v7 \/ v2) /\ (~v2 \/ ~v21 \/ v25) /\ (~v2 \/ ~v20 \/ v24) /\ (~v5 \/ ~v6 \/ v3) /\ (~v5 \/ ~v27 \/ v4) /\ (~v5 \/ ~v7 \/ v5) /\ (~v5 \/ ~v21 \/ v23) /\ (~v5 \/ ~v20 \/ v22) /\ (~v7 \/ ~v6 \/ v6) /\ (~v7 \/ ~v27 \/ v27) /\ (~v7 \/ ~v7 \/ v7) /\ (~v7 \/ ~v21 \/ v21) /\ (~v7 \/ ~v20 \/ v20) /\ (~v10 \/ ~v6 \/ v8) /\ (~v10 \/ ~v27 \/ v9) /\ (~v10 \/ ~v7 \/ v10) /\ (~v10 \/ ~v21 \/ v19) /\ (~v10 \/ ~v20 \/ v18) /\ (~v13 \/ ~v6 \/ v11) /\ (~v13 \/ ~v27 \/ v12) /\ (~v13 \/ ~v7 \/ v13) /\ (~v13 \/ ~v21 \/ v17) /\ (~v13 \/ ~v20 \/ v16) /\ (~v1 \/ ~v8 \/ v0) /\ (~v1 \/ ~v9 \/ v1) /\ (~v1 \/ ~v10 \/ v2) /\ (~v1 \/ ~v19 \/ v25) /\ (~v1 \/ ~v18 \/ v24) /\ (~v4 \/ ~v8 \/ v3) /\ (~v4 \/ ~v9 \/ v4) /\ (~v4 \/ ~v10 \/ v5) /\ (~v4 \/ ~v19 \/ v23) /\ (~v4 \/ ~v18 \/ v22) /\ (~v27 \/ ~v8 \/ v6) /\ (~v27 \/ ~v9 \/ v27) /\ (~v27 \/ ~v10 \/ v7) /\ (~v27 \/ ~v19 \/ v21) /\ (~v27 \/ ~v18 \/ v20) /\ (~v9 \/ ~v8 \/ v8) /\ (~v9 \/ ~v9 \/ v9) /\ (~v9 \/ ~v10 \/ v10) /\ (~v9 \/ ~v19 \/ v19) /\ (~v9 \/ ~v18 \/ v18) /\ (~v12 \/ ~v8 \/ v11) /\ (~v12 \/ ~v9 \/ v12) /\ (~v12 \/ ~v10 \/ v13) /\ (~v12 \/ ~v19 \/ v17) /\ (~v12 \/ ~v18 \/ v16) /\ (~v0 \/ ~v11 \/ v0) /\ (~v0 \/ ~v12 \/ v1) /\ (~v0 \/ ~v13 \/ v2) /\ (~v0 \/ ~v17 \/ v25) /\ (~v0 \/ ~v16 \/ v24) /\ (~v3 \/ ~v11 \/ v3) /\ (~v3 \/ ~v12 \/ v4) /\ (~v3 \/ ~v13 \/ v5) /\ (~v3 \/ ~v17 \/ v23) /\ (~v3 \/ ~v16 \/ v22) /\ (~v6 \/ ~v11 \/ v6) /\ (~v6 \/ ~v12 \/ v27) /\ (~v6 \/ ~v13 \/ v7) /\ (~v6 \/ ~v17 \/ v21) /\ (~v6 \/ ~v16 \/ v20) /\ (~v8 \/ ~v11 \/ v8) /\ (~v8 \/ ~v12 \/ v9) /\ (~v8 \/ ~v13 \/ v10) /\ (~v8 \/ ~v17 \/ v19) /\ (~v8 \/ ~v16 \/ v18) /\ (~v11 \/ ~v11 \/ v11) /\ (~v11 \/ ~v12 \/ v12) /\ (~v11 \/ ~v13 \/ v13) /\ (~v11 \/ ~v17 \/ v17) /\ (~v11 \/ ~v16 \/ v16) /\ (~v0 \/ ~v15 \/ v26) /\ (~v1 \/ ~v15 \/ v28) /\ (~v2 \/ ~v15 \/ v29) /\ (~v25 \/ ~v15 \/ v14) /\ (~v24 \/ ~v15 \/ v15) /\ (~v3 \/ ~v14 \/ v26) /\ (~v4 \/ ~v14 \/ v28) /\ (~v5 \/ ~v14 \/ v29) /\ (~v23 \/ ~v14 \/ v14) /\ (~v22 \/ ~v14 \/ v15) /\ (~v6 \/ ~v29 \/ v26) /\ (~v27 \/ ~v29 \/ v28) /\ (~v7 \/ ~v29 \/ v29) /\ (~v21 \/ ~v29 \/ v14) /\ (~v20 \/ ~v29 \/ v15) /\ (~v8 \/ ~v28 \/ v26) /\ (~v9 \/ ~v28 \/ v28) /\ (~v10 \/ ~v28 \/ v29) /\ (~v19 \/ ~v28 \/ v14) /\ (~v18 \/ ~v28 \/ v15) /\ (~v11 \/ ~v26 \/ v26) /\ (~v12 \/ ~v26 \/ v28) /\ (~v13 \/ ~v26 \/ v29) /\ (~v17 \/ ~v26 \/ v14) /\ (~v16 \/ ~v26 \/ v15) /\ (v16 \/ v17) /\ (v18 \/ v19) /\ (v20 \/ v21) /\ (v22 \/ v23) /\ (v24 \/ v25) /\ ~v26 /\ ~v27 /\ v28 /\ v29)` ;; (* Hard *) let aim_100_2_0_no_1 = `~ ((v6 \/ v55 \/ v66) /\ (v6 \/ v62 \/ ~v66) /\ (~v62 \/ ~v66 \/ v68) /\ (v6 \/ v8 \/ ~v55) /\ (v8 \/ v58 \/ v70) /\ (~v6 \/ v58 \/ ~v70) /\ (~v6 \/ v33 \/ ~v58) /\ (~v6 \/ v8 \/ ~v33) /\ (~v8 \/ v61 \/ v68) /\ (~v8 \/ ~v61 \/ v68) /\ (v35 \/ v42 \/ v51) /\ (v30 \/ ~v42 \/ v51) /\ (v30 \/ ~v51 \/ v75) /\ (v20 \/ ~v51 \/ ~v75) /\ (~v20 \/ ~v51 \/ ~v75) /\ (~v30 \/ v35 \/ ~v68) /\ (v34 \/ ~v35 \/ v46) /\ (~v35 \/ v46 \/ v86) /\ (~v34 \/ v46 \/ ~v68) /\ (~v35 \/ ~v46 \/ ~v68) /\ (~v31 \/ v42 \/ v91) /\ (~v7 \/ v20 \/ v85) /\ (~v20 \/ ~v24 \/ ~v42) /\ (v18 \/ ~v85 \/ v91) /\ (~v18 \/ ~v24 \/ ~v31) /\ (~v24 \/ ~v31 \/ ~v91) /\ (~v17 \/ v32 \/ v60) /\ (~v17 \/ v39 \/ ~v60) /\ (v36 \/ v50 \/ v56) /\ (~v50 \/ v56 \/ v91) /\ (~v44 \/ v52 \/ ~v54) /\ (~v52 \/ v53 \/ ~v54) /\ (v71 \/ v79 \/ ~v97) /\ (v9 \/ v71 \/ ~v79) /\ (~v8 \/ v34 \/ ~v71) /\ (v34 \/ ~v71 \/ v95) /\ (~v56 \/ v85 \/ ~v95) /\ (~v71 \/ ~v85 \/ ~v95) /\ (~v18 \/ ~v56 \/ v87) /\ (~v52 \/ ~v56 \/ v87) /\ (~v7 \/ ~v76 \/ ~v93) /\ (v3 \/ v9 \/ v86) /\ (v3 \/ ~v86 \/ ~v96) /\ (v3 \/ v12 \/ v67) /\ (~v9 \/ ~v40 \/ v67) /\ (~v9 \/ v13 \/ ~v67) /\ (~v9 \/ ~v67 \/ ~v88) /\ (~v3 \/ v13 \/ ~v96) /\ (v2 \/ v12 \/ v27) /\ (~v33 \/ v36 \/ ~v74) /\ (~v13 \/ ~v29 \/ ~v41) /\ (v11 \/ v52 \/ ~v98) /\ (~v50 \/ v90 \/ v92) /\ (~v26 \/ ~v47 \/ ~v77) /\ (v5 \/ v42 \/ ~v93) /\ (v28 \/ v36 \/ ~v42) /\ (v5 \/ v28 \/ ~v36) /\ (~v28 \/ v45 \/ ~v73) /\ (v5 \/ ~v45 \/ ~v73) /\ (v7 \/ v25 \/ ~v86) /\ (~v25 \/ v37 \/ ~v86) /\ (v19 \/ ~v25 \/ ~v37) /\ (v7 \/ ~v19 \/ v41) /\ (v12 \/ ~v34 \/ ~v47) /\ (~v12 \/ ~v34 \/ ~v47) /\ (~v13 \/ ~v60 \/ v93) /\ (v19 \/ ~v94 \/ v98) /\ (v92 \/ ~v94 \/ ~v98) /\ (v67 \/ ~v92 \/ ~v98) /\ (v1 \/ v26 \/ v55) /\ (v26 \/ ~v53 \/ v55) /\ (v18 \/ ~v29 \/ v31) /\ (~v1 \/ v69 \/ v94) /\ (v23 \/ v69 \/ ~v93) /\ (~v1 \/ ~v23 \/ v69) /\ (~v19 \/ v29 \/ v43) /\ (v33 \/ v37 \/ v62) /\ (~v20 \/ ~v33 \/ v62) /\ (~v18 \/ v39 \/ v65) /\ (v45 \/ v51 \/ ~v53) /\ (~v1 \/ v11 \/ ~v28) /\ (v18 \/ v33 \/ v84) /\ (~v14 \/ ~v52 \/ v84) /\ (v7 \/ ~v40 \/ ~v53) /\ (~v7 \/ ~v17 \/ ~v40) /\ (~v19 \/ v65 \/ v72) /\ (~v63 \/ v77 \/ ~v85) /\ (v27 \/ ~v63 \/ ~v77) /\ (~v4 \/ v64 \/ v94) /\ (v22 \/ ~v82 \/ v99) /\ (~v11 \/ v41 \/ ~v99) /\ (~v11 \/ v85 \/ ~v99) /\ (v4 \/ ~v65 \/ ~v87) /\ (v17 \/ v37 \/ v100) /\ (v25 \/ ~v37 \/ v100) /\ (v17 \/ ~v25 \/ ~v37) /\ (v83 \/ ~v89 \/ ~v100) /\ (v15 \/ v17 \/ ~v89) /\ (~v15 \/ ~v83 \/ ~v100) /\ (~v39 \/ ~v74 \/ ~v90) /\ (v19 \/ ~v26 \/ v40) /\ (v41 \/ ~v70 \/ ~v99) /\ (~v26 \/ ~v41 \/ ~v70) /\ (~v28 \/ v59 \/ ~v62) /\ (v4 \/ v78 \/ v90) /\ (v4 \/ v21 \/ v78) /\ (v39 \/ ~v49 \/ v63) /\ (~v39 \/ ~v49 \/ ~v95) /\ (v48 \/ ~v54 \/ v65) /\ (v60 \/ v82 \/ v98) /\ (v49 \/ ~v74 \/ v97) /\ (~v21 \/ v49 \/ ~v97) /\ (~v79 \/ v87 \/ ~v88) /\ (v21 \/ v45 \/ ~v75) /\ (v16 \/ ~v84 \/ ~v89) /\ (~v21 \/ ~v46 \/ v63) /\ (v14 \/ v16 \/ ~v81) /\ (~v14 \/ ~v81 \/ ~v87) /\ (~v66 \/ ~v67 \/ ~v83) /\ (~v80 \/ v81 \/ v100) /\ (v2 \/ ~v29 \/ v99) /\ (~v2 \/ ~v39 \/ v99) /\ (~v44 \/ ~v64 \/ ~v90) /\ (~v13 \/ v14 \/ v23) /\ (~v10 \/ ~v45 \/ ~v91) /\ (v10 \/ v40 \/ v73) /\ (v40 \/ ~v73 \/ ~v76) /\ (v22 \/ ~v76 \/ v78) /\ (v21 \/ ~v32 \/ ~v57) /\ (~v38 \/ ~v64 \/ v86) /\ (~v12 \/ ~v15 \/ v54) /\ (~v12 \/ v47 \/ ~v69) /\ (v47 \/ ~v69 \/ ~v82) /\ (~v22 \/ ~v23 \/ v32) /\ (~v22 \/ ~v23 \/ ~v78) /\ (~v10 \/ v20 \/ ~v50) /\ (~v5 \/ v10 \/ v84) /\ (v23 \/ ~v92 \/ v97) /\ (~v69 \/ v72 \/ ~v78) /\ (v1 \/ v11 \/ ~v80) /\ (~v2 \/ v27 \/ v50) /\ (~v57 \/ ~v61 \/ ~v79) /\ (v43 \/ v76 \/ ~v90) /\ (~v22 \/ ~v49 \/ ~v92) /\ (v26 \/ v43 \/ ~v60) /\ (~v10 \/ v50 \/ v98) /\ (v10 \/ ~v30 \/ v59) /\ (~v55 \/ ~v72 \/ ~v100) /\ (~v41 \/ v53 \/ ~v78) /\ (v38 \/ ~v65 \/ v94) /\ (v38 \/ ~v65 \/ ~v94) /\ (v29 \/ ~v55 \/ v61) /\ (~v46 \/ ~v48 \/ v59) /\ (v53 \/ v73 \/ v90) /\ (v1 \/ ~v11 \/ v74) /\ (v15 \/ v76 \/ v82) /\ (~v27 \/ ~v82 \/ ~v97) /\ (~v3 \/ ~v36 \/ ~v48) /\ (v28 \/ ~v32 \/ v80) /\ (v9 \/ ~v63 \/ v80) /\ (v70 \/ v73 \/ v89) /\ (~v80 \/ ~v91 \/ v93) /\ (v22 \/ ~v64 \/ v77) /\ (v66 \/ v72 \/ ~v87) /\ (~v36 \/ v83 \/ v88) /\ (v24 \/ ~v38 \/ v52) /\ (~v43 \/ v81 \/ ~v96) /\ (~v59 \/ ~v62 \/ v81) /\ (v48 \/ v66 \/ v71) /\ (~v2 \/ v48 \/ v63) /\ (v29 \/ ~v83 \/ v93) /\ (~v16 \/ v25 \/ ~v72) /\ (~v27 \/ v57 \/ ~v84) /\ (~v5 \/ v77 \/ v88) /\ (~v5 \/ ~v59 \/ v88) /\ (v15 \/ v44 \/ ~v45) /\ (v13 \/ ~v84 \/ v89) /\ (v47 \/ ~v48 \/ v83) /\ (~v14 \/ ~v44 \/ v54) /\ (~v30 \/ v31 \/ v64) /\ (v24 \/ v70 \/ v75) /\ (~v15 \/ ~v32 \/ v92) /\ (~v16 \/ ~v58 \/ v74) /\ (~v4 \/ v54 \/ ~v77) /\ (~v43 \/ v57 \/ v60) /\ (~v16 \/ v61 \/ v64) /\ (~v59 \/ v79 \/ v95) /\ (~v4 \/ ~v61 \/ ~v88) /\ (v58 \/ v74 \/ v80) /\ (v49 \/ ~v58 \/ v82) /\ (v16 \/ v44 \/ ~v57) /\ (v2 \/ v89 \/ v95) /\ (~v3 \/ ~v27 \/ ~v81) /\ (v24 \/ v75 \/ v79) /\ (v44 \/ v96 \/ v97) /\ (v31 \/ ~v38 \/ v57) /\ (v14 \/ ~v43 \/ ~v72) /\ (v38 \/ v76 \/ v96) /\ (v30 \/ v32 \/ v96) /\ (~v21 \/ v35 \/ v56))` ;; let aim_100_2_0_no_2 = `~ ((v40 \/ v54 \/ v75) /\ (~v40 \/ v54 \/ v58) /\ (~v40 \/ ~v58 \/ v69) /\ (~v40 \/ ~v69 \/ v95) /\ (~v51 \/ ~v69 \/ v95) /\ (v64 \/ v75 \/ v89) /\ (v26 \/ ~v64 \/ v89) /\ (v26 \/ ~v69 \/ ~v95) /\ (~v26 \/ v75 \/ ~v95) /\ (v11 \/ v28 \/ v82) /\ (~v11 \/ v23 \/ v82) /\ (v14 \/ ~v23 \/ v28) /\ (~v11 \/ ~v14 \/ v28) /\ (~v28 \/ ~v75 \/ v88) /\ (~v28 \/ v84 \/ ~v88) /\ (v62 \/ ~v75 \/ ~v84) /\ (v12 \/ v51 \/ ~v62) /\ (v12 \/ ~v51 \/ ~v62) /\ (~v12 \/ v43 \/ v65) /\ (~v12 \/ ~v65 \/ v82) /\ (~v12 \/ ~v28 \/ ~v43) /\ (v54 \/ ~v75 \/ ~v82) /\ (~v54 \/ v77 \/ v86) /\ (v8 \/ ~v86 \/ v94) /\ (~v8 \/ v36 \/ ~v86) /\ (~v8 \/ ~v36 \/ ~v86) /\ (v24 \/ v77 \/ ~v94) /\ (v4 \/ v7 \/ v78) /\ (v4 \/ ~v78 \/ v84) /\ (v4 \/ v7 \/ ~v84) /\ (~v4 \/ v7 \/ ~v77) /\ (~v7 \/ v63 \/ v76) /\ (~v7 \/ v24 \/ ~v63) /\ (~v7 \/ ~v55 \/ ~v63) /\ (v24 \/ ~v76 \/ v93) /\ (~v76 \/ ~v77 \/ ~v93) /\ (v6 \/ ~v24 \/ v98) /\ (v6 \/ v94 \/ ~v98) /\ (~v6 \/ ~v54 \/ v94) /\ (v62 \/ ~v94 \/ v96) /\ (~v62 \/ ~v94 \/ v96) /\ (~v54 \/ ~v88 \/ v96) /\ (v20 \/ ~v24 \/ ~v96) /\ (~v20 \/ ~v24 \/ ~v96) /\ (v20 \/ v27 \/ v32) /\ (~v20 \/ v27 \/ v32) /\ (~v15 \/ ~v53 \/ v78) /\ (v26 \/ v44 \/ ~v46) /\ (~v26 \/ v44 \/ ~v89) /\ (v12 \/ v35 \/ ~v39) /\ (v1 \/ ~v51 \/ ~v80) /\ (~v3 \/ v21 \/ v60) /\ (~v3 \/ ~v48 \/ v60) /\ (~v48 \/ ~v60 \/ v100) /\ (~v48 \/ ~v60 \/ v61) /\ (~v60 \/ ~v61 \/ ~v100) /\ (v9 \/ ~v22 \/ ~v93) /\ (~v21 \/ v44 \/ v93) /\ (~v44 \/ v46 \/ v69) /\ (~v46 \/ v69 \/ v93) /\ (v13 \/ ~v46 \/ ~v85) /\ (~v13 \/ ~v44 \/ ~v85) /\ (v41 \/ v43 \/ v84) /\ (~v41 \/ v43 \/ v87) /\ (~v37 \/ v49 \/ v74) /\ (~v29 \/ ~v37 \/ ~v70) /\ (~v37 \/ v49 \/ ~v74) /\ (v33 \/ v35 \/ v41) /\ (~v15 \/ v33 \/ v41) /\ (~v5 \/ ~v43 \/ ~v85) /\ (~v92 \/ ~v93 \/ ~v98) /\ (v15 \/ v50 \/ v63) /\ (~v21 \/ ~v58 \/ v87) /\ (v25 \/ ~v39 \/ ~v97) /\ (~v25 \/ v51 \/ ~v97) /\ (~v25 \/ ~v39 \/ ~v97) /\ (~v4 \/ ~v38 \/ ~v52) /\ (v59 \/ v79 \/ v95) /\ (v14 \/ v59 \/ ~v79) /\ (v76 \/ ~v89 \/ v99) /\ (v40 \/ v76 \/ ~v99) /\ (v40 \/ ~v76 \/ ~v89) /\ (~v5 \/ ~v22 \/ v46) /\ (~v31 \/ v86 \/ v100) /\ (v10 \/ v31 \/ v62) /\ (v14 \/ v31 \/ v58) /\ (v10 \/ v31 \/ ~v58) /\ (~v30 \/ v42 \/ ~v67) /\ (~v21 \/ ~v30 \/ v42) /\ (~v30 \/ v42 \/ ~v77) /\ (v5 \/ ~v11 \/ v13) /\ (v11 \/ ~v26 \/ v92) /\ (v15 \/ v38 \/ v83) /\ (~v13 \/ v56 \/ ~v100) /\ (~v16 \/ v47 \/ v87) /\ (v47 \/ v83 \/ ~v87) /\ (v6 \/ ~v35 \/ v92) /\ (~v6 \/ ~v65 \/ v92) /\ (v61 \/ v66 \/ ~v82) /\ (~v1 \/ ~v18 \/ v68) /\ (~v18 \/ v52 \/ ~v68) /\ (v32 \/ v64 \/ ~v96) /\ (~v8 \/ v35 \/ ~v67) /\ (v10 \/ ~v83 \/ ~v90) /\ (~v10 \/ ~v32 \/ ~v91) /\ (v20 \/ v68 \/ v72) /\ (v16 \/ v85 \/ ~v95) /\ (v9 \/ v29 \/ v30) /\ (~v1 \/ ~v29 \/ v30) /\ (v39 \/ v45 \/ v51) /\ (v39 \/ v45 \/ ~v82) /\ (v19 \/ v70 \/ v88) /\ (~v19 \/ ~v45 \/ v88) /\ (~v36 \/ ~v45 \/ ~v70) /\ (~v59 \/ ~v70 \/ ~v81) /\ (~v1 \/ ~v52 \/ v81) /\ (v15 \/ ~v35 \/ v55) /\ (~v18 \/ ~v45 \/ v48) /\ (~v35 \/ ~v53 \/ ~v68) /\ (v16 \/ ~v38 \/ ~v64) /\ (v27 \/ v46 \/ v57) /\ (v9 \/ ~v27 \/ v57) /\ (~v32 \/ ~v43 \/ v70) /\ (~v23 \/ v34 \/ ~v67) /\ (v55 \/ v85 \/ ~v92) /\ (v18 \/ ~v25 \/ v48) /\ (~v36 \/ v67 \/ ~v78) /\ (~v59 \/ v66 \/ v86) /\ (~v4 \/ ~v44 \/ v60) /\ (~v20 \/ ~v31 \/ ~v78) /\ (~v61 \/ ~v80 \/ v97) /\ (v21 \/ ~v84 \/ v91) /\ (v22 \/ v52 \/ ~v90) /\ (v73 \/ ~v83 \/ ~v98) /\ (v13 \/ v80 \/ ~v91) /\ (v1 \/ ~v15 \/ v19) /\ (v64 \/ v83 \/ v90) /\ (v16 \/ v33 \/ v99) /\ (~v16 \/ ~v65 \/ v99) /\ (~v16 \/ v53 \/ ~v74) /\ (v53 \/ ~v63 \/ v85) /\ (v17 \/ v61 \/ ~v80) /\ (v3 \/ v17 \/ ~v61) /\ (~v41 \/ v74 \/ ~v83) /\ (v47 \/ ~v72 \/ ~v73) /\ (v8 \/ v30 \/ v72) /\ (~v27 \/ ~v34 \/ v53) /\ (v1 \/ v56 \/ v97) /\ (v29 \/ ~v68 \/ v79) /\ (v67 \/ ~v73 \/ ~v92) /\ (v18 \/ ~v57 \/ v89) /\ (v22 \/ v36 \/ v91) /\ (~v14 \/ ~v23 \/ v56) /\ (~v52 \/ v68 \/ v100) /\ (v37 \/ ~v38 \/ ~v50) /\ (~v13 \/ ~v33 \/ v57) /\ (v55 \/ v58 \/ v59) /\ (v19 \/ v36 \/ v37) /\ (~v19 \/ v78 \/ v97) /\ (v3 \/ ~v14 \/ v37) /\ (~v5 \/ ~v57 \/ v98) /\ (~v9 \/ v72 \/ ~v87) /\ (v48 \/ ~v90 \/ ~v99) /\ (v23 \/ ~v55 \/ ~v99) /\ (v39 \/ ~v64 \/ ~v81) /\ (v66 \/ v81 \/ ~v87) /\ (~v17 \/ ~v41 \/ v90) /\ (~v17 \/ ~v53 \/ ~v57) /\ (~v47 \/ ~v79 \/ v80) /\ (~v3 \/ ~v42 \/ ~v56) /\ (v3 \/ ~v27 \/ ~v33) /\ (~v6 \/ v22 \/ ~v34) /\ (~v22 \/ ~v34 \/ v81) /\ (~v2 \/ v23 \/ v73) /\ (v29 \/ ~v55 \/ ~v59) /\ (~v10 \/ v65 \/ ~v79) /\ (v34 \/ v63 \/ v79) /\ (v67 \/ ~v71 \/ ~v88) /\ (v38 \/ ~v50 \/ v90) /\ (~v10 \/ v25 \/ v98) /\ (v52 \/ v73 \/ ~v91) /\ (v45 \/ ~v73 \/ v91) /\ (v25 \/ v34 \/ v38) /\ (~v9 \/ ~v47 \/ ~v72) /\ (v5 \/ v8 \/ ~v17) /\ (v2 \/ ~v32 \/ v71) /\ (~v9 \/ v65 \/ v80) /\ (~v47 \/ ~v49 \/ ~v66) /\ (~v19 \/ ~v33 \/ ~v50) /\ (~v42 \/ ~v56 \/ ~v66) /\ (v17 \/ ~v56 \/ ~v74) /\ (v5 \/ ~v31 \/ v77) /\ (v2 \/ v11 \/ ~v100) /\ (v18 \/ ~v49 \/ v71) /\ (v2 \/ ~v2 \/ v49) /\ (v50 \/ v70 \/ ~v72) /\ (v21 \/ ~v42 \/ v74) /\ (~v49 \/ ~v71 \/ ~v81) /\ (~v29 \/ ~v66 \/ v71) /\ (~v2 \/ v50 \/ ~v71))` ;; let prv001_1 = `~((~v0 \/ ~v111 \/ v47) /\ (~v1 \/ ~v111 \/ v37) /\ (~v2 \/ ~v111 \/ v28) /\ (~v114 \/ ~v113 \/ v46) /\ (~v3 \/ ~v113 \/ v36) /\ (~v4 \/ ~v113 \/ v27) /\ (~v5 \/ ~v105 \/ v44) /\ (~v6 \/ ~v105 \/ v35) /\ (~v7 \/ ~v105 \/ v26) /\ (~v8 \/ ~v112 \/ v51) /\ (~v9 \/ ~v112 \/ v40) /\ (~v10 \/ ~v112 \/ v31) /\ (~v11 \/ ~v109 \/ v50) /\ (~v12 \/ ~v109 \/ v39) /\ (~v13 \/ ~v109 \/ v30) /\ (~v14 \/ ~v106 \/ v48) /\ (~v15 \/ ~v106 \/ v38) /\ (~v16 \/ ~v106 \/ v29) /\ (~v17 \/ ~v103 \/ v56) /\ (~v18 \/ ~v103 \/ v43) /\ (~v19 \/ ~v103 \/ v34) /\ (~v20 \/ ~v107 \/ v54) /\ (~v21 \/ ~v107 \/ v42) /\ (~v22 \/ ~v107 \/ v33) /\ (~v23 \/ ~v102 \/ v53) /\ (~v24 \/ ~v102 \/ v41) /\ (~v25 \/ ~v102 \/ v32) /\ (~v0 \/ v111 \/ v80) /\ (~v1 \/ v111 \/ v69) /\ (~v2 \/ v111 \/ v60) /\ (~v114 \/ v113 \/ v86) /\ (~v3 \/ v113 \/ v72) /\ (~v4 \/ v113 \/ v63) /\ (~v5 \/ v105 \/ v91) /\ (~v6 \/ v105 \/ v75) /\ (~v7 \/ v105 \/ v66) /\ (~v8 \/ v112 \/ v78) /\ (~v9 \/ v112 \/ v68) /\ (~v10 \/ v112 \/ v59) /\ (~v11 \/ v109 \/ v84) /\ (~v12 \/ v109 \/ v71) /\ (~v13 \/ v109 \/ v62) /\ (~v14 \/ v106 \/ v89) /\ (~v15 \/ v106 \/ v74) /\ (~v16 \/ v106 \/ v65) /\ (~v17 \/ v103 \/ v76) /\ (~v18 \/ v103 \/ v67) /\ (~v19 \/ v103 \/ v58) /\ (~v20 \/ v107 \/ v82) /\ (~v21 \/ v107 \/ v70) /\ (~v22 \/ v107 \/ v61) /\ (~v23 \/ v102 \/ v87) /\ (~v24 \/ v102 \/ v73) /\ (~v25 \/ v102 \/ v64) /\ (~v26 \/ v45) /\ (~v27 \/ v108) /\ (~v28 \/ v81) /\ (~v29 \/ v49) /\ (~v30 \/ v85) /\ (~v31 \/ v52) /\ (~v32 \/ v88) /\ (~v33 \/ v55) /\ (~v34 \/ v57) /\ (~v35 \/ v45) /\ (~v36 \/ v108) /\ (~v37 \/ v81) /\ (~v38 \/ v49) /\ (~v39 \/ v85) /\ (~v40 \/ v52) /\ (~v41 \/ v88) /\ (~v42 \/ v55) /\ (~v43 \/ v57) /\ (~v44 \/ v45) /\ (~v46 \/ v108) /\ (~v47 \/ v81) /\ (~v48 \/ v49) /\ (~v50 \/ v85) /\ (~v51 \/ v52) /\ (~v53 \/ v88) /\ (~v54 \/ v55) /\ (~v56 \/ v57) /\ (~v58 \/ v77) /\ (~v59 \/ v79) /\ (~v60 \/ v81) /\ (~v61 \/ v83) /\ (~v62 \/ v85) /\ (~v63 \/ v110) /\ (~v64 \/ v88) /\ (~v65 \/ v90) /\ (~v66 \/ v92) /\ (~v67 \/ v77) /\ (~v68 \/ v79) /\ (~v69 \/ v81) /\ (~v70 \/ v83) /\ (~v71 \/ v85) /\ (~v72 \/ v110) /\ (~v73 \/ v88) /\ (~v74 \/ v90) /\ (~v75 \/ v92) /\ (~v76 \/ v77) /\ (~v78 \/ v79) /\ (~v80 \/ v81) /\ (~v82 \/ v83) /\ (~v84 \/ v85) /\ (~v86 \/ v110) /\ (~v87 \/ v88) /\ (~v89 \/ v90) /\ (~v91 \/ v92) /\ v102 /\ v109 /\ v111 /\ (~v105 \/ ~v103 \/ v93) /\ (~v113 \/ ~v112 \/ v94) /\ (~v111 \/ ~v111 \/ v95) /\ (~v106 \/ ~v107 \/ v96) /\ (~v109 \/ ~v109 \/ v97) /\ (~v112 \/ ~v113 \/ v98) /\ (~v102 \/ ~v102 \/ v99) /\ (~v107 \/ ~v106 \/ v100) /\ (~v103 \/ ~v105 \/ v101) /\ (~v111 \/ ~v105 \/ v105) /\ (~v111 \/ ~v113 \/ v113) /\ (~v111 \/ ~v111 \/ v111) /\ (~v112 \/ ~v105 \/ v106) /\ (~v112 \/ ~v113 \/ v109) /\ (~v112 \/ ~v111 \/ v112) /\ (~v103 \/ ~v105 \/ v102) /\ (~v103 \/ ~v113 \/ v107) /\ (~v103 \/ ~v111 \/ v103) /\ (~v113 \/ ~v106 \/ v105) /\ (~v113 \/ ~v109 \/ v113) /\ (~v113 \/ ~v112 \/ v111) /\ (~v109 \/ ~v106 \/ v106) /\ (~v109 \/ ~v109 \/ v109) /\ (~v109 \/ ~v112 \/ v112) /\ (~v107 \/ ~v106 \/ v102) /\ (~v107 \/ ~v109 \/ v107) /\ (~v107 \/ ~v112 \/ v103) /\ (~v105 \/ ~v102 \/ v105) /\ (~v105 \/ ~v107 \/ v113) /\ (~v105 \/ ~v103 \/ v111) /\ (~v106 \/ ~v102 \/ v106) /\ (~v106 \/ ~v107 \/ v109) /\ (~v106 \/ ~v103 \/ v112) /\ (~v102 \/ ~v102 \/ v102) /\ (~v102 \/ ~v107 \/ v107) /\ (~v102 \/ ~v103 \/ v103) /\ (v103 \/ v105) /\ (v112 \/ v113) /\ (v111 \/ v111) /\ (v107 \/ v106) /\ (v109 \/ v109) /\ (v113 \/ v112) /\ (v102 \/ v102) /\ (v106 \/ v107) /\ (v105 \/ v103) /\ (~v93 \/ v105) /\ (~v94 \/ v113) /\ (~v95 \/ v111) /\ (~v96 \/ v106) /\ (~v97 \/ v109) /\ (~v98 \/ v112) /\ (~v99 \/ v102) /\ (~v100 \/ v107) /\ (~v101 \/ v103) /\ (~v95 \/ ~v105 \/ v105) /\ (~v95 \/ ~v113 \/ v113) /\ (~v95 \/ ~v111 \/ v111) /\ (~v94 \/ ~v105 \/ v106) /\ (~v94 \/ ~v113 \/ v109) /\ (~v94 \/ ~v111 \/ v112) /\ (~v93 \/ ~v105 \/ v102) /\ (~v93 \/ ~v113 \/ v107) /\ (~v93 \/ ~v111 \/ v103) /\ (~v98 \/ ~v106 \/ v105) /\ (~v98 \/ ~v109 \/ v113) /\ (~v98 \/ ~v112 \/ v111) /\ (~v97 \/ ~v106 \/ v106) /\ (~v97 \/ ~v109 \/ v109) /\ (~v97 \/ ~v112 \/ v112) /\ (~v96 \/ ~v106 \/ v102) /\ (~v96 \/ ~v109 \/ v107) /\ (~v96 \/ ~v112 \/ v103) /\ (~v101 \/ ~v102 \/ v105) /\ (~v101 \/ ~v107 \/ v113) /\ (~v101 \/ ~v103 \/ v111) /\ (~v100 \/ ~v102 \/ v106) /\ (~v100 \/ ~v107 \/ v109) /\ (~v100 \/ ~v103 \/ v112) /\ (~v99 \/ ~v102 \/ v102) /\ (~v99 \/ ~v107 \/ v107) /\ (~v99 \/ ~v103 \/ v103) /\ (~v93 \/ ~v111 \/ v105) /\ (~v94 \/ ~v111 \/ v113) /\ (~v95 \/ ~v111 \/ v111) /\ (~v93 \/ ~v112 \/ v106) /\ (~v94 \/ ~v112 \/ v109) /\ (~v95 \/ ~v112 \/ v112) /\ (~v93 \/ ~v103 \/ v102) /\ (~v94 \/ ~v103 \/ v107) /\ (~v95 \/ ~v103 \/ v103) /\ (~v96 \/ ~v113 \/ v105) /\ (~v97 \/ ~v113 \/ v113) /\ (~v98 \/ ~v113 \/ v111) /\ (~v96 \/ ~v109 \/ v106) /\ (~v97 \/ ~v109 \/ v109) /\ (~v98 \/ ~v109 \/ v112) /\ (~v96 \/ ~v107 \/ v102) /\ (~v97 \/ ~v107 \/ v107) /\ (~v98 \/ ~v107 \/ v103) /\ (~v99 \/ ~v105 \/ v105) /\ (~v100 \/ ~v105 \/ v113) /\ (~v101 \/ ~v105 \/ v111) /\ (~v99 \/ ~v106 \/ v106) /\ (~v100 \/ ~v106 \/ v109) /\ (~v101 \/ ~v106 \/ v112) /\ (~v99 \/ ~v102 \/ v102) /\ (~v100 \/ ~v102 \/ v107) /\ (~v101 \/ ~v102 \/ v103) /\ (~v104 \/ ~v105 \/ ~v106 \/ ~v103) /\ (~v108 \/ ~v113 \/ ~v109 \/ ~v112) /\ (~v110 \/ ~v111 \/ ~v112 \/ ~v111) /\ (~v104 \/ ~v105 \/ ~v106 \/ ~v107) /\ (~v108 \/ ~v113 \/ ~v109 \/ ~v109) /\ (~v110 \/ ~v111 \/ ~v112 \/ ~v113) /\ v114)` ;; let ssa0432_003 = `~ ((v435) /\ (v174) /\ (~v175) /\ (v173) /\ (~v39 \/ ~v433) /\ (v37 \/ ~v433) /\ (v39 \/ ~v434) /\ (~v37 \/ ~v434) /\ (~v434 \/ v432) /\ (~v433 \/ v432) /\ (~v79 \/ ~v37) /\ (~v67 \/ ~v37) /\ (~v68 \/ v38) /\ (~v68 \/ ~v79) /\ (~v79 \/ ~v39) /\ (~v69 \/ ~v39) /\ (~v76 \/ ~v67) /\ (~v71 \/ ~v67) /\ (~v74 \/ ~v67) /\ (~v138 \/ ~v67) /\ (~v72 \/ v68) /\ (~v72 \/ ~v138) /\ (~v72 \/ ~v74) /\ (~v72 \/ ~v76) /\ (~v76 \/ ~v69) /\ (~v73 \/ ~v69) /\ (~v74 \/ ~v69) /\ (~v138 \/ ~v69) /\ (v75 \/ ~v138) /\ (~v75 \/ v138) /\ (v75 \/ ~v139) /\ (~v75 \/ v139) /\ (v75 \/ ~v147) /\ (~v75 \/ v147) /\ (~v311 \/ ~v75) /\ (~v307 \/ ~v75) /\ (v312 \/ v307) /\ (~v312 \/ ~v307) /\ (v15 \/ ~v315) /\ (~v15 \/ v315) /\ (v15 \/ ~v316) /\ (~v15 \/ v316) /\ (v53 \/ ~v93) /\ (~v53 \/ v93) /\ (v53 \/ ~v94) /\ (~v53 \/ v94) /\ (v53 \/ ~v98) /\ (~v53 \/ v98) /\ (v53 \/ ~v102) /\ (~v53 \/ v102) /\ (v53 \/ ~v105) /\ (~v53 \/ v105) /\ (v53 \/ ~v119) /\ (~v53 \/ v119) /\ (v53 \/ ~v121) /\ (~v53 \/ v121) /\ (v53 \/ ~v124) /\ (~v53 \/ v124) /\ (v53 \/ ~v129) /\ (~v53 \/ v129) /\ (v53 \/ ~v169) /\ (~v53 \/ v169) /\ (v53 \/ ~v207) /\ (~v53 \/ v207) /\ (v53 \/ ~v221) /\ (~v53 \/ v221) /\ (v53 \/ ~v244) /\ (~v53 \/ v244) /\ (v53 \/ ~v250) /\ (~v53 \/ v250) /\ (v53 \/ ~v304) /\ (~v53 \/ v304) /\ (v53 \/ ~v314) /\ (~v53 \/ v314) /\ (v53 \/ ~v330) /\ (~v53 \/ v330) /\ (v53 \/ ~v343) /\ (~v53 \/ v343) /\ (v53 \/ ~v345) /\ (~v53 \/ v345) /\ (v53 \/ ~v360) /\ (~v53 \/ v360) /\ (v53 \/ ~v378) /\ (~v53 \/ v378) /\ (v60 \/ v53) /\ (v263 \/ v53) /\ (v176 \/ v53) /\ (v182 \/ v53) /\ (v188 \/ v182) /\ (~v188 \/ ~v182) /\ (v104 \/ ~v187) /\ (~v104 \/ v187) /\ (v104 \/ ~v188) /\ (~v104 \/ v188) /\ (~v196 \/ ~v104) /\ (~v191 \/ ~v104) /\ (~v193 \/ ~v104) /\ (v184 \/ ~v192) /\ (~v184 \/ v192) /\ (v184 \/ ~v193) /\ (~v184 \/ v193) /\ (v184 \/ ~v200) /\ (~v184 \/ v200) /\ (v184 \/ ~v203) /\ (~v184 \/ v203) /\ (v34 \/ v184) /\ (~v34 \/ ~v184) /\ (v12 \/ ~v190) /\ (~v12 \/ v190) /\ (v12 \/ ~v191) /\ (~v12 \/ v191) /\ (v189 \/ ~v196) /\ (~v189 \/ v196) /\ (v189 \/ ~v197) /\ (~v189 \/ v197) /\ (~v271 \/ ~v422) /\ (v195 \/ ~v422) /\ (v271 \/ ~v423) /\ (~v195 \/ ~v423) /\ (~v423 \/ v189) /\ (~v422 \/ v189) /\ (v42 \/ ~v80) /\ (~v42 \/ v80) /\ (v42 \/ ~v81) /\ (~v42 \/ v81) /\ (v42 \/ ~v84) /\ (~v42 \/ v84) /\ (v42 \/ ~v101) /\ (~v42 \/ v101) /\ (v42 \/ ~v112) /\ (~v42 \/ v112) /\ (v42 \/ ~v166) /\ (~v42 \/ v166) /\ (v42 \/ ~v195) /\ (~v42 \/ v195) /\ (v42 \/ ~v218) /\ (~v42 \/ v218) /\ (v42 \/ ~v241) /\ (~v42 \/ v241) /\ (v42 \/ ~v259) /\ (~v42 \/ v259) /\ (v42 \/ ~v291) /\ (~v42 \/ v291) /\ (v42 \/ ~v303) /\ (~v42 \/ v303) /\ (v42 \/ ~v313) /\ (~v42 \/ v313) /\ (v42 \/ ~v323) /\ (~v42 \/ v323) /\ (v42 \/ ~v344) /\ (~v42 \/ v344) /\ (v42 \/ ~v349) /\ (~v42 \/ v349) /\ (v42 \/ ~v357) /\ (~v42 \/ v357) /\ (v42 \/ ~v385) /\ (~v42 \/ v385) /\ (v42 \/ ~v404) /\ (~v42 \/ v404) /\ (v286 \/ v42) /\ (v267 \/ v42) /\ (v43 \/ v42) /\ (v278 \/ v42) /\ (v347 \/ v278) /\ (~v347 \/ ~v278) /\ (v279 \/ ~v347) /\ (~v279 \/ v347) /\ (v279 \/ ~v348) /\ (~v279 \/ v348) /\ (~v369 \/ ~v279) /\ (~v370 \/ ~v279) /\ (v281 \/ ~v284) /\ (~v281 \/ v284) /\ (v281 \/ ~v285) /\ (~v281 \/ v285) /\ (v281 \/ ~v301) /\ (~v281 \/ v301) /\ (v281 \/ ~v370) /\ (~v281 \/ v370) /\ (v26 \/ v281) /\ (~v26 \/ ~v281) /\ (v7 \/ ~v368) /\ (~v7 \/ v368) /\ (v7 \/ ~v369) /\ (~v7 \/ v369) /\ (~v110 \/ ~v43) /\ (~v46 \/ ~v43) /\ (v41 \/ ~v45) /\ (~v41 \/ v45) /\ (v41 \/ ~v46) /\ (~v41 \/ v46) /\ (~v219 \/ ~v41) /\ (~v211 \/ ~v41) /\ (v204 \/ ~v211) /\ (~v204 \/ v211) /\ (v204 \/ ~v212) /\ (~v204 \/ v212) /\ (v214 \/ v204) /\ (~v214 \/ ~v204) /\ (v32 \/ ~v214) /\ (~v32 \/ v214) /\ (v32 \/ ~v215) /\ (~v32 \/ v215) /\ (v32 \/ ~v228) /\ (~v32 \/ v228) /\ (v5 \/ ~v219) /\ (~v5 \/ v219) /\ (v5 \/ ~v220) /\ (~v5 \/ v220) /\ (v44 \/ ~v110) /\ (~v44 \/ v110) /\ (v44 \/ ~v111) /\ (~v44 \/ v111) /\ (~v358 \/ ~v44) /\ (~v355 \/ ~v44) /\ (v350 \/ ~v353) /\ (~v350 \/ v353) /\ (v350 \/ ~v354) /\ (~v350 \/ v354) /\ (v350 \/ ~v355) /\ (~v350 \/ v355) /\ (v350 \/ ~v367) /\ (~v350 \/ v367) /\ (v9 \/ v350) /\ (~v9 \/ ~v350) /\ (v21 \/ ~v358) /\ (~v21 \/ v358) /\ (v21 \/ ~v359) /\ (~v21 \/ v359) /\ (~v270 \/ ~v267) /\ (~v268 \/ ~v267) /\ (~v272 \/ ~v267) /\ (v194 \/ ~v271) /\ (~v194 \/ v271) /\ (v194 \/ ~v272) /\ (~v194 \/ v272) /\ (~v202 \/ ~v194) /\ (~v203 \/ ~v194) /\ (v25 \/ ~v201) /\ (~v25 \/ v201) /\ (v25 \/ ~v202) /\ (~v25 \/ v202) /\ (v331 \/ v268) /\ (v324 \/ v268) /\ (v332 \/ v268) /\ (v402 \/ v332) /\ (~v402 \/ ~v332) /\ (v391 \/ ~v402) /\ (~v391 \/ v402) /\ (v391 \/ ~v403) /\ (~v391 \/ v403) /\ (~v400 \/ ~v391) /\ (~v401 \/ ~v391) /\ (v392 \/ ~v397) /\ (~v392 \/ v397) /\ (v392 \/ ~v398) /\ (~v392 \/ v398) /\ (v392 \/ ~v401) /\ (~v392 \/ v401) /\ (v392 \/ ~v409) /\ (~v392 \/ v409) /\ (v19 \/ v392) /\ (~v19 \/ ~v392) /\ (v17 \/ ~v399) /\ (~v17 \/ v399) /\ (v17 \/ ~v400) /\ (~v17 \/ v400) /\ (v326 \/ v324) /\ (~v326 \/ ~v324) /\ (v322 \/ ~v325) /\ (~v322 \/ v325) /\ (v322 \/ ~v326) /\ (~v322 \/ v326) /\ (~v389 \/ ~v322) /\ (~v390 \/ ~v322) /\ (v235 \/ ~v386) /\ (~v235 \/ v386) /\ (v235 \/ ~v387) /\ (~v235 \/ v387) /\ (v235 \/ ~v390) /\ (~v235 \/ v390) /\ (v383 \/ v235) /\ (~v383 \/ ~v235) /\ (v35 \/ ~v382) /\ (~v35 \/ v382) /\ (v35 \/ ~v383) /\ (~v35 \/ v383) /\ (v30 \/ ~v388) /\ (~v30 \/ v388) /\ (v30 \/ ~v389) /\ (~v30 \/ v389) /\ (v334 \/ v331) /\ (~v334 \/ ~v331) /\ (v83 \/ ~v333) /\ (~v83 \/ v333) /\ (v83 \/ ~v334) /\ (~v83 \/ v334) /\ (~v320 \/ ~v83) /\ (~v321 \/ ~v83) /\ (v86 \/ ~v91) /\ (~v86 \/ v91) /\ (v86 \/ ~v92) /\ (~v86 \/ v92) /\ (v86 \/ ~v158) /\ (~v86 \/ v158) /\ (v86 \/ ~v321) /\ (~v86 \/ v321) /\ (v28 \/ v86) /\ (~v28 \/ ~v86) /\ (v4 \/ ~v317) /\ (~v4 \/ v317) /\ (v4 \/ ~v320) /\ (~v4 \/ v320) /\ (v237 \/ ~v269) /\ (~v237 \/ v269) /\ (v237 \/ ~v270) /\ (~v237 \/ v270) /\ (~v242 \/ ~v237) /\ (~v239 \/ ~v237) /\ (v232 \/ ~v238) /\ (~v232 \/ v238) /\ (v232 \/ ~v239) /\ (~v232 \/ v239) /\ (v253 \/ v232) /\ (~v253 \/ ~v232) /\ (v6 \/ ~v253) /\ (~v6 \/ v253) /\ (v6 \/ ~v254) /\ (~v6 \/ v254) /\ (v6 \/ ~v258) /\ (~v6 \/ v258) /\ (v10 \/ ~v242) /\ (~v10 \/ v242) /\ (v10 \/ ~v243) /\ (~v10 \/ v243) /\ (v289 \/ v286) /\ (~v289 \/ ~v286) /\ (v287 \/ ~v289) /\ (~v287 \/ v289) /\ (v287 \/ ~v290) /\ (~v287 \/ v290) /\ (~v372 \/ ~v287) /\ (~v373 \/ ~v287) /\ (v292 \/ ~v295) /\ (~v292 \/ v295) /\ (v292 \/ ~v296) /\ (~v292 \/ v296) /\ (v292 \/ ~v311) /\ (~v292 \/ v311) /\ (v292 \/ ~v373) /\ (~v292 \/ v373) /\ (v27 \/ v292) /\ (~v27 \/ ~v292) /\ (v11 \/ ~v371) /\ (~v11 \/ v371) /\ (v11 \/ ~v372) /\ (~v11 \/ v372) /\ (~v180 \/ ~v176) /\ (~v328 \/ ~v176) /\ (~v276 \/ ~v176) /\ (v178 \/ ~v276) /\ (~v178 \/ v276) /\ (v178 \/ ~v277) /\ (~v178 \/ v277) /\ (v178 \/ ~v342) /\ (~v178 \/ v342) /\ (~v405 \/ ~v178) /\ (~v396 \/ ~v178) /\ (~v398 \/ ~v178) /\ (v18 \/ ~v395) /\ (~v18 \/ v395) /\ (v18 \/ ~v396) /\ (~v18 \/ v396) /\ (v394 \/ ~v405) /\ (~v394 \/ v405) /\ (v394 \/ ~v406) /\ (~v394 \/ v406) /\ (~v403 \/ ~v410) /\ (v404 \/ ~v410) /\ (v403 \/ ~v411) /\ (~v404 \/ ~v411) /\ (~v411 \/ v394) /\ (~v410 \/ v394) /\ (v177 \/ ~v328) /\ (~v177 \/ v328) /\ (v177 \/ ~v329) /\ (~v177 \/ v329) /\ (~v337 \/ ~v177) /\ (~v376 \/ ~v177) /\ (~v386 \/ ~v177) /\ (v22 \/ ~v376) /\ (~v22 \/ v376) /\ (v22 \/ ~v377) /\ (~v22 \/ v377) /\ (v234 \/ ~v337) /\ (~v234 \/ v337) /\ (v234 \/ ~v338) /\ (~v234 \/ v338) /\ (~v325 \/ ~v416) /\ (v323 \/ ~v416) /\ (v325 \/ ~v417) /\ (~v323 \/ ~v417) /\ (~v417 \/ v234) /\ (~v416 \/ v234) /\ (v85 \/ ~v179) /\ (~v85 \/ v179) /\ (v85 \/ ~v180) /\ (~v85 \/ v180) /\ (~v89 \/ ~v85) /\ (~v172 \/ ~v85) /\ (~v91 \/ ~v85) /\ (v23 \/ ~v172) /\ (~v23 \/ v172) /\ (v23 \/ ~v173) /\ (~v23 \/ v173) /\ (v82 \/ ~v89) /\ (~v82 \/ v89) /\ (v82 \/ ~v90) /\ (~v82 \/ v90) /\ (~v333 \/ ~v428) /\ (v84 \/ ~v428) /\ (v333 \/ ~v429) /\ (~v84 \/ ~v429) /\ (~v429 \/ v82) /\ (~v428 \/ v82) /\ (v181 \/ ~v263) /\ (~v181 \/ v263) /\ (v181 \/ ~v264) /\ (~v181 \/ v264) /\ (v248 \/ v181) /\ (~v248 \/ ~v181) /\ (v233 \/ ~v248) /\ (~v233 \/ v248) /\ (v233 \/ ~v249) /\ (~v233 \/ v249) /\ (~v261 \/ ~v233) /\ (~v245 \/ ~v233) /\ (~v238 \/ ~v233) /\ (v33 \/ ~v245) /\ (~v33 \/ v245) /\ (v33 \/ ~v246) /\ (~v33 \/ v246) /\ (v236 \/ ~v261) /\ (~v236 \/ v261) /\ (v236 \/ ~v262) /\ (~v236 \/ v262) /\ (~v269 \/ ~v420) /\ (v259 \/ ~v420) /\ (v269 \/ ~v421) /\ (~v259 \/ ~v421) /\ (~v421 \/ v236) /\ (~v420 \/ v236) /\ (~v65 \/ ~v60) /\ (~v122 \/ ~v60) /\ (~v117 \/ ~v60) /\ (~v127 \/ ~v60) /\ (v63 \/ ~v127) /\ (~v63 \/ v127) /\ (v63 \/ ~v128) /\ (~v63 \/ v128) /\ (v63 \/ ~v206) /\ (~v63 \/ v206) /\ (~v210 \/ ~v63) /\ (~v222 \/ ~v63) /\ (~v212 \/ ~v63) /\ (v29 \/ ~v222) /\ (~v29 \/ v222) /\ (v29 \/ ~v223) /\ (~v29 \/ v223) /\ (v40 \/ ~v209) /\ (~v40 \/ v209) /\ (v40 \/ ~v210) /\ (~v40 \/ v210) /\ (~v45 \/ ~v430) /\ (v80 \/ ~v430) /\ (v45 \/ ~v431) /\ (~v80 \/ ~v431) /\ (~v431 \/ v40) /\ (~v430 \/ v40) /\ (v62 \/ ~v117) /\ (~v62 \/ v117) /\ (v62 \/ ~v118) /\ (~v62 \/ v118) /\ (v62 \/ ~v120) /\ (~v62 \/ v120) /\ (~v283 \/ ~v62) /\ (~v305 \/ ~v62) /\ (~v285 \/ ~v62) /\ (v31 \/ ~v305) /\ (~v31 \/ v305) /\ (v31 \/ ~v306) /\ (~v31 \/ v306) /\ (v280 \/ ~v282) /\ (~v280 \/ v282) /\ (v280 \/ ~v283) /\ (~v280 \/ v283) /\ (~v348 \/ ~v412) /\ (v349 \/ ~v412) /\ (v348 \/ ~v413) /\ (~v349 \/ ~v413) /\ (~v413 \/ v280) /\ (~v412 \/ v280) /\ (v61 \/ ~v122) /\ (~v61 \/ v122) /\ (v61 \/ ~v123) /\ (~v61 \/ v123) /\ (~v351 \/ ~v61) /\ (~v361 \/ ~v61) /\ (~v353 \/ ~v61) /\ (v20 \/ ~v361) /\ (~v20 \/ v361) /\ (v20 \/ ~v362) /\ (~v20 \/ v362) /\ (v109 \/ ~v351) /\ (~v109 \/ v351) /\ (v109 \/ ~v352) /\ (~v109 \/ v352) /\ (~v111 \/ ~v424) /\ (v112 \/ ~v424) /\ (v111 \/ ~v425) /\ (~v112 \/ ~v425) /\ (~v425 \/ v109) /\ (~v424 \/ v109) /\ (v52 \/ ~v64) /\ (~v52 \/ v64) /\ (v52 \/ ~v65) /\ (~v52 \/ v65) /\ (~v293 \/ ~v52) /\ (~v315 \/ ~v52) /\ (~v295 \/ ~v52) /\ (v288 \/ ~v293) /\ (~v288 \/ v293) /\ (v288 \/ ~v294) /\ (~v288 \/ v294) /\ (~v290 \/ ~v418) /\ (v291 \/ ~v418) /\ (v290 \/ ~v419) /\ (~v291 \/ ~v419) /\ (~v419 \/ v288) /\ (~v418 \/ v288) /\ (v2 \/ ~v309) /\ (~v2 \/ v309) /\ (v2 \/ ~v310) /\ (~v2 \/ v310) /\ (v58 \/ ~v185) /\ (~v58 \/ v185) /\ (v58 \/ ~v186) /\ (~v58 \/ v186) /\ (v58 \/ ~v231) /\ (~v58 \/ v231) /\ (v58 \/ ~v298) /\ (~v58 \/ v298) /\ (v58 \/ ~v308) /\ (~v58 \/ v308) /\ (v58 \/ ~v364) /\ (~v58 \/ v364) /\ (v58 \/ ~v375) /\ (~v58 \/ v375) /\ (v58 \/ ~v393) /\ (~v58 \/ v393) /\ (v49 \/ v58) /\ (v59 \/ v58) /\ (v54 \/ v58) /\ (~v57 \/ ~v54) /\ (~v209 \/ ~v57) /\ (~v208 \/ ~v57) /\ (v226 \/ v208) /\ (v215 \/ v208) /\ (v213 \/ ~v226) /\ (~v213 \/ v226) /\ (v213 \/ ~v227) /\ (~v213 \/ v227) /\ (v14 \/ v213) /\ (~v14 \/ ~v213) /\ (v126 \/ v125) /\ (~v126 \/ ~v125) /\ (~v128 \/ ~v126) /\ (~v129 \/ ~v126) /\ (v206 \/ v205) /\ (v207 \/ v205) /\ (~v352 \/ ~v56) /\ (~v365 \/ ~v56) /\ (~v354 \/ ~v56) /\ (v8 \/ ~v365) /\ (~v8 \/ v365) /\ (v8 \/ ~v366) /\ (~v8 \/ v366) /\ (~v95 \/ ~v59) /\ (~v87 \/ ~v59) /\ (~v96 \/ ~v59) /\ (v336 \/ v96) /\ (v346 \/ v336) /\ (~v406 \/ ~v346) /\ (~v408 \/ ~v346) /\ (~v409 \/ ~v346) /\ (v3 \/ ~v407) /\ (~v3 \/ v407) /\ (v3 \/ ~v408) /\ (~v3 \/ v408) /\ (~v342 \/ ~v341) /\ (~v343 \/ ~v341) /\ (~v274 \/ ~v273) /\ (~v275 \/ ~v273) /\ (v78 \/ ~v265) /\ (~v78 \/ v265) /\ (v78 \/ ~v266) /\ (~v78 \/ v266) /\ (v78 \/ ~v275) /\ (~v78 \/ v275) /\ (v98 \/ v78) /\ (~v98 \/ ~v78) /\ (v277 \/ v274) /\ (~v277 \/ ~v274) /\ (v379 \/ v335) /\ (v382 \/ v335) /\ (v381 \/ v379) /\ (~v381 \/ ~v379) /\ (v1 \/ ~v380) /\ (~v1 \/ v380) /\ (v1 \/ ~v381) /\ (~v1 \/ v381) /\ (~v329 \/ ~v414) /\ (v330 \/ ~v414) /\ (v329 \/ ~v415) /\ (~v330 \/ ~v415) /\ (~v415 \/ v327) /\ (~v414 \/ v327) /\ (~v88 \/ ~v87) /\ (~v90 \/ ~v87) /\ (~v156 \/ ~v87) /\ (~v92 \/ ~v87) /\ (v16 \/ ~v156) /\ (~v16 \/ v156) /\ (v16 \/ ~v157) /\ (~v16 \/ v157) /\ (~v179 \/ ~v426) /\ (v94 \/ ~v426) /\ (v179 \/ ~v427) /\ (~v94 \/ ~v427) /\ (~v427 \/ v88) /\ (~v426 \/ v88) /\ (v106 \/ v95) /\ (~v106 \/ ~v95) /\ (~v108 \/ ~v106) /\ (~v262 \/ ~v108) /\ (~v255 \/ ~v108) /\ (v257 \/ v255) /\ (v258 \/ v255) /\ (v251 \/ ~v256) /\ (~v251 \/ v256) /\ (v251 \/ ~v257) /\ (~v251 \/ v257) /\ (v13 \/ v251) /\ (~v13 \/ ~v251) /\ (v264 \/ v260) /\ (v266 \/ v260) /\ (v249 \/ v247) /\ (v250 \/ v247) /\ (~v197 \/ ~v107) /\ (~v199 \/ ~v107) /\ (~v200 \/ ~v107) /\ (v36 \/ ~v198) /\ (~v36 \/ v198) /\ (v36 \/ ~v199) /\ (~v36 \/ v199) /\ (~v47 \/ ~v49) /\ (v48 \/ v47) /\ (~v48 \/ ~v47) /\ (v115 \/ v48) /\ (~v282 \/ ~v115) /\ (~v299 \/ ~v115) /\ (~v284 \/ ~v115) /\ (v24 \/ ~v299) /\ (~v24 \/ v299) /\ (v24 \/ ~v300) /\ (~v24 \/ v300) /\ (~v120 \/ ~v114) /\ (~v121 \/ ~v114) /\ (v116 \/ v113) /\ (~v116 \/ ~v113) /\ (v118 \/ v116) /\ (v119 \/ v116) /\ (~v294 \/ ~v51) /\ (~v309 \/ ~v51) /\ (~v296 \/ ~v51) /\ (v229 \/ v74) /\ (v230 \/ v74) /\ (v66 \/ ~v132) /\ (~v66 \/ v132) /\ (v66 \/ ~v133) /\ (~v66 \/ v133) /\ (v66 \/ ~v135) /\ (~v66 \/ v135) /\ (v66 \/ ~v230) /\ (~v66 \/ v230) /\ (v216 \/ v66) /\ (~v216 \/ ~v66) /\ (~v356 \/ ~v216) /\ (v363 \/ v356) /\ (~v363 \/ ~v356) /\ (~v367 \/ ~v363) /\ (v131 \/ ~v136) /\ (~v131 \/ v136) /\ (v131 \/ ~v137) /\ (~v131 \/ v137) /\ (v131 \/ ~v140) /\ (~v131 \/ v140) /\ (v131 \/ ~v148) /\ (~v131 \/ v148) /\ (v131 \/ ~v229) /\ (~v131 \/ v229) /\ (v302 \/ v131) /\ (v297 \/ v131) /\ (~v301 \/ ~v297) /\ (v146 \/ v71) /\ (v141 \/ v71) /\ (v149 \/ v71) /\ (~v142 \/ v72) /\ (~v142 \/ v149) /\ (~v142 \/ v146) /\ (v146 \/ v73) /\ (v143 \/ v73) /\ (v149 \/ v73) /\ (v144 \/ ~v149) /\ (~v144 \/ v149) /\ (v144 \/ ~v150) /\ (~v144 \/ v150) /\ (v152 \/ v144) /\ (~v152 \/ ~v144) /\ (v134 \/ ~v151) /\ (~v134 \/ v151) /\ (v134 \/ ~v152) /\ (~v134 \/ v152) /\ (~v240 \/ ~v134) /\ (v254 \/ v240) /\ (v97 \/ ~v224) /\ (~v97 \/ v224) /\ (v97 \/ ~v225) /\ (~v97 \/ v225) /\ (v97 \/ ~v252) /\ (~v97 \/ v252) /\ (v231 \/ v97) /\ (~v231 \/ ~v97) /\ (~v163 \/ ~v141) /\ (~v160 \/ v142) /\ (~v160 \/ v153) /\ (~v154 \/ ~v163) /\ (~v160 \/ ~v163) /\ (~v163 \/ ~v143) /\ (v99 \/ ~v162) /\ (~v99 \/ v162) /\ (v99 \/ ~v163) /\ (~v99 \/ v163) /\ (~v100 \/ ~v99) /\ (v183 \/ v100) /\ (~v183 \/ ~v100) /\ (~v192 \/ ~v183) /\ (~v158 \/ ~v153) /\ (~v174 \/ v160) /\ (~v174 \/ v169) /\ (~v318 \/ v166) /\ (~v167 \/ v317) /\ (v130 \/ ~v145) /\ (~v130 \/ v145) /\ (v130 \/ ~v146) /\ (~v130 \/ v146) /\ (v228 \/ v130) /\ (v217 \/ v130) /\ (v70 \/ ~v76) /\ (~v70 \/ v76) /\ (v70 \/ ~v77) /\ (~v70 \/ v77) /\ (~v339 \/ ~v70) /\ (v340 \/ v339) /\ (~v340 \/ ~v339) /\ (~v397 \/ ~v340) /\ (~v384 \/ ~v79) /\ (~v387 \/ ~v79) /\ (v374 \/ v384) /\ (~v374 \/ ~v384) /\ (~v432 \/ v435) /\ (~v435 \/ v432) /\ (v433 \/ v39 \/ ~v37) /\ (v434 \/ ~v39 \/ v37) /\ (~v432 \/ v434 \/ v433) /\ (v37 \/ v79 \/ v67) /\ (~v38 \/ v37 \/ v39) /\ (~v38 \/ ~v37 \/ ~v39) /\ (v39 \/ v79 \/ v69) /\ (~v68 \/ v67 \/ v69) /\ (~v68 \/ ~v67 \/ ~v69) /\ (~v310 \/ ~v308 \/ ~v75) /\ (~v371 \/ ~v313 \/ ~v312) /\ (~v316 \/ ~v314 \/ ~v312) /\ (v314 \/ v313 \/ v312) /\ (v316 \/ v313 \/ v312) /\ (v314 \/ v371 \/ v312) /\ (v316 \/ v371 \/ v312) /\ (v422 \/ v271 \/ ~v195) /\ (v423 \/ ~v271 \/ v195) /\ (~v189 \/ v423 \/ v422) /\ (v279 \/ v369 \/ v370) /\ (v43 \/ v110 \/ v46) /\ (v41 \/ v219 \/ v211) /\ (v44 \/ v358 \/ v355) /\ (v194 \/ v202 \/ v203) /\ (v391 \/ v400 \/ v401) /\ (v322 \/ v389 \/ v390) /\ (v83 \/ v320 \/ v321) /\ (v237 \/ v242 \/ v239) /\ (v287 \/ v372 \/ v373) /\ (v410 \/ v403 \/ ~v404) /\ (v411 \/ ~v403 \/ v404) /\ (~v394 \/ v411 \/ v410) /\ (v416 \/ v325 \/ ~v323) /\ (v417 \/ ~v325 \/ v323) /\ (~v234 \/ v417 \/ v416) /\ (v428 \/ v333 \/ ~v84) /\ (v429 \/ ~v333 \/ v84) /\ (~v82 \/ v429 \/ v428) /\ (v420 \/ v269 \/ ~v259) /\ (v421 \/ ~v269 \/ v259) /\ (~v236 \/ v421 \/ v420) /\ (v430 \/ v45 \/ ~v80) /\ (v431 \/ ~v45 \/ v80) /\ (~v40 \/ v431 \/ v430) /\ (v412 \/ v348 \/ ~v349) /\ (v413 \/ ~v348 \/ v349) /\ (~v280 \/ v413 \/ v412) /\ (v424 \/ v111 \/ ~v112) /\ (v425 \/ ~v111 \/ v112) /\ (~v109 \/ v425 \/ v424) /\ (v418 \/ v290 \/ ~v291) /\ (v419 \/ ~v290 \/ v291) /\ (~v288 \/ v419 \/ v418) /\ (~v56 \/ ~v55 \/ ~v54) /\ (v57 \/ v55 \/ v54) /\ (v57 \/ v56 \/ v54) /\ (~v125 \/ ~v205 \/ ~v57) /\ (~v208 \/ ~v226 \/ ~v215) /\ (v126 \/ v128 \/ v129) /\ (~v205 \/ ~v206 \/ ~v207) /\ (v124 \/ v123 \/ v55) /\ (~v124 \/ ~v123 \/ v55) /\ (~v124 \/ v123 \/ ~v55) /\ (v124 \/ ~v123 \/ ~v55) /\ (~v336 \/ ~v327 \/ ~v96) /\ (~v336 \/ ~v338 \/ ~v96) /\ (~v336 \/ ~v335 \/ ~v96) /\ (v341 \/ v273 \/ v336) /\ (~v346 \/ ~v273 \/ ~v336) /\ (~v346 \/ ~v341 \/ ~v336) /\ (v341 \/ v342 \/ v343) /\ (v273 \/ v274 \/ v275) /\ (~v335 \/ ~v379 \/ ~v382) /\ (v414 \/ v329 \/ ~v330) /\ (v415 \/ ~v329 \/ v330) /\ (~v327 \/ v415 \/ v414) /\ (v426 \/ v179 \/ ~v94) /\ (v427 \/ ~v179 \/ v94) /\ (~v88 \/ v427 \/ v426) /\ (~v107 \/ ~v103 \/ ~v106) /\ (v108 \/ v103 \/ v106) /\ (v108 \/ v107 \/ v106) /\ (~v260 \/ ~v247 \/ ~v108) /\ (~v255 \/ ~v257 \/ ~v258) /\ (~v260 \/ ~v264 \/ ~v266) /\ (~v247 \/ ~v249 \/ ~v250) /\ (v105 \/ v187 \/ v103) /\ (~v105 \/ ~v187 \/ v103) /\ (~v105 \/ v187 \/ ~v103) /\ (v105 \/ ~v187 \/ ~v103) /\ (~v51 \/ ~v50 \/ ~v49) /\ (v47 \/ v50 \/ v49) /\ (v47 \/ v51 \/ v49) /\ (v114 \/ v113 \/ v48) /\ (~v115 \/ ~v113 \/ ~v48) /\ (~v115 \/ ~v114 \/ ~v48) /\ (v114 \/ v120 \/ v121) /\ (~v116 \/ ~v118 \/ ~v119) /\ (v93 \/ v64 \/ v50) /\ (~v93 \/ ~v64 \/ v50) /\ (~v93 \/ v64 \/ ~v50) /\ (v93 \/ ~v64 \/ ~v50) /\ (~v74 \/ ~v229 \/ ~v230) /\ (~v359 \/ ~v357 \/ ~v216) /\ (~v362 \/ ~v360 \/ ~v216) /\ (~v366 \/ ~v364 \/ ~v363) /\ (v367 \/ v364 \/ v363) /\ (v367 \/ v366 \/ v363) /\ (~v131 \/ ~v302 \/ ~v297) /\ (~v300 \/ ~v298 \/ ~v297) /\ (v301 \/ v298 \/ v297) /\ (v301 \/ v300 \/ v297) /\ (~v368 \/ ~v303 \/ ~v302) /\ (~v306 \/ ~v304 \/ ~v302) /\ (v304 \/ v303 \/ v302) /\ (v306 \/ v303 \/ v302) /\ (v304 \/ v368 \/ v302) /\ (v306 \/ v368 \/ v302) /\ (~v72 \/ v71 \/ v73) /\ (~v72 \/ ~v71 \/ ~v73) /\ (~v243 \/ ~v241 \/ ~v134) /\ (~v246 \/ ~v244 \/ ~v134) /\ (v256 \/ v252 \/ v240) /\ (~v254 \/ ~v252 \/ ~v240) /\ (~v254 \/ ~v256 \/ ~v240) /\ (~v153 \/ ~v159 \/ ~v141) /\ (v163 \/ v159 \/ v141) /\ (v163 \/ v153 \/ v141) /\ (~v154 \/ ~v155 \/ v161) /\ (~v154 \/ ~v153 \/ v159) /\ (~v154 \/ v159 \/ v161) /\ (~v142 \/ v141 \/ v143) /\ (~v142 \/ ~v141 \/ ~v143) /\ (~v153 \/ ~v161 \/ ~v143) /\ (v163 \/ v161 \/ v143) /\ (v163 \/ v153 \/ v143) /\ (~v201 \/ ~v101 \/ ~v99) /\ (~v190 \/ ~v102 \/ ~v99) /\ (~v198 \/ ~v186 \/ ~v183) /\ (v192 \/ v186 \/ v183) /\ (v192 \/ v198 \/ v183) /\ (~v157 \/ ~v185 \/ ~v153) /\ (v158 \/ v185 \/ v153) /\ (v158 \/ v157 \/ v153) /\ (~v317 \/ ~v166 \/ ~v159) /\ (~v173 \/ ~v169 \/ ~v159) /\ (v169 \/ v166 \/ v159) /\ (v173 \/ v166 \/ v159) /\ (v169 \/ v317 \/ v159) /\ (v173 \/ v317 \/ v159) /\ (~v170 \/ ~v171 \/ v175) /\ (~v170 \/ ~v169 \/ v173) /\ (~v170 \/ v173 \/ v175) /\ (~v174 \/ ~v317 \/ ~v166) /\ (~v170 \/ ~v317 \/ ~v166) /\ (~v160 \/ v159 \/ v161) /\ (~v160 \/ ~v159 \/ ~v161) /\ (~v317 \/ ~v166 \/ ~v161) /\ (~v175 \/ ~v169 \/ ~v161) /\ (v169 \/ v166 \/ v161) /\ (v175 \/ v166 \/ v161) /\ (v169 \/ v317 \/ v161) /\ (v175 \/ v317 \/ v161) /\ (v227 \/ v225 \/ v130) /\ (~v220 \/ ~v218 \/ ~v217) /\ (~v223 \/ ~v221 \/ ~v217) /\ (v221 \/ v218 \/ v217) /\ (v223 \/ v218 \/ v217) /\ (v221 \/ v220 \/ v217) /\ (v223 \/ v220 \/ v217) /\ (~v399 \/ ~v344 \/ ~v70) /\ (~v395 \/ ~v345 \/ ~v70) /\ (~v407 \/ ~v393 \/ ~v340) /\ (v397 \/ v393 \/ v340) /\ (v397 \/ v407 \/ v340) /\ (~v385 \/ ~v388 \/ ~v79) /\ (~v375 \/ ~v380 \/ ~v374) /\ (~v378 \/ ~v377 \/ ~v374) /\ (v377 \/ v380 \/ v374) /\ (v378 \/ v380 \/ v374) /\ (v377 \/ v375 \/ v374) /\ (v378 \/ v375 \/ v374) /\ (v307 \/ v311 \/ v308 \/ v75) /\ (v307 \/ v311 \/ v310 \/ v75) /\ (v104 \/ v196 \/ v191 \/ v193) /\ (v267 \/ v270 \/ v268 \/ v272) /\ (~v268 \/ ~v331 \/ ~v324 \/ ~v332) /\ (v176 \/ v180 \/ v328 \/ v276) /\ (v178 \/ v405 \/ v396 \/ v398) /\ (v177 \/ v337 \/ v376 \/ v386) /\ (v85 \/ v89 \/ v172 \/ v91) /\ (v233 \/ v261 \/ v245 \/ v238) /\ (v63 \/ v210 \/ v222 \/ v212) /\ (v62 \/ v283 \/ v305 \/ v285) /\ (v61 \/ v351 \/ v361 \/ v353) /\ (v52 \/ v293 \/ v315 \/ v295) /\ (~v58 \/ ~v49 \/ ~v59 \/ ~v54) /\ (v208 \/ v209 \/ v205 \/ v57) /\ (v208 \/ v209 \/ v125 \/ v57) /\ (v56 \/ v352 \/ v365 \/ v354) /\ (v59 \/ v95 \/ v87 \/ v96) /\ (v335 \/ v338 \/ v327 \/ v96) /\ (v346 \/ v406 \/ v408 \/ v409) /\ (v255 \/ v262 \/ v247 \/ v108) /\ (v255 \/ v262 \/ v260 \/ v108) /\ (v107 \/ v197 \/ v199 \/ v200) /\ (v115 \/ v282 \/ v299 \/ v284) /\ (v51 \/ v294 \/ v309 \/ v296) /\ (v356 \/ v360 \/ v357 \/ v216) /\ (v356 \/ v362 \/ v357 \/ v216) /\ (v356 \/ v360 \/ v359 \/ v216) /\ (v356 \/ v362 \/ v359 \/ v216) /\ (~v71 \/ ~v146 \/ ~v141 \/ ~v149) /\ (~v73 \/ ~v146 \/ ~v143 \/ ~v149) /\ (v240 \/ v244 \/ v241 \/ v134) /\ (v240 \/ v246 \/ v241 \/ v134) /\ (v240 \/ v244 \/ v243 \/ v134) /\ (v240 \/ v246 \/ v243 \/ v134) /\ (~v164 \/ ~v153 \/ ~v165 \/ ~v159) /\ (~v164 \/ ~v153 \/ ~v163 \/ ~v161) /\ (~v164 \/ ~v153 \/ ~v159 \/ ~v161) /\ (v100 \/ v102 \/ v101 \/ v99) /\ (v100 \/ v190 \/ v101 \/ v99) /\ (v100 \/ v102 \/ v201 \/ v99) /\ (v100 \/ v190 \/ v201 \/ v99) /\ (~v318 \/ ~v169 \/ ~v319 \/ ~v173) /\ (~v318 \/ ~v169 \/ ~v317 \/ ~v175) /\ (~v318 \/ ~v169 \/ ~v173 \/ ~v175) /\ (~v167 \/ ~v169 \/ ~v168 \/ ~v173) /\ (~v167 \/ ~v169 \/ ~v166 \/ ~v175) /\ (~v167 \/ ~v169 \/ ~v173 \/ ~v175) /\ (~v217 \/ ~v228 \/ ~v225 \/ ~v130) /\ (~v217 \/ ~v228 \/ ~v227 \/ ~v130) /\ (v339 \/ v345 \/ v344 \/ v70) /\ (v339 \/ v395 \/ v344 \/ v70) /\ (v339 \/ v345 \/ v399 \/ v70) /\ (v339 \/ v395 \/ v399 \/ v70) /\ (v387 \/ v384 \/ v388 \/ v79) /\ (v387 \/ v384 \/ v385 \/ v79) /\ (v67 \/ v76 \/ v71 \/ v74 \/ v138) /\ (v69 \/ v76 \/ v73 \/ v74 \/ v138) /\ (~v53 \/ ~v60 \/ ~v263 \/ ~v176 \/ ~v182) /\ (~v42 \/ ~v286 \/ ~v267 \/ ~v43 \/ ~v278) /\ (v60 \/ v65 \/ v122 \/ v117 \/ v127) /\ (v87 \/ v88 \/ v90 \/ v156 \/ v92))` ;; let jnh211 = `~ ((v7 \/ ~v9 \/ ~v29) /\ (v13 \/ ~v35 \/ v44 \/ ~v45 \/ ~v48) /\ (~v50 \/ v60) /\ (v1 \/ v2 \/ v13 \/ v21 \/ ~v29 \/ ~v36 \/ ~v75) /\ (v1 \/ ~v9 \/ v12 \/ ~v13 \/ v47 \/ v59 \/ v83 \/ ~v84) /\ (~v13 \/ v29 \/ v47 \/ ~v53 \/ ~v97) /\ (v32 \/ ~v54 \/ ~v58 \/ ~v70) /\ (~v7 \/ v24 \/ v48) /\ (v31 \/ v94) /\ (~v3 \/ ~v5 \/ v11 \/ v59 \/ ~v90 \/ ~v99) /\ (~v6 \/ v41) /\ (~v2 \/ v17 \/ ~v28 \/ v67 \/ v68 \/ ~v77 \/ ~v100) /\ (v37 \/ v61 \/ v78 \/ v88 \/ v89 \/ ~v92) /\ (v31 \/ ~v70 \/ v73 \/ ~v79 \/ v82) /\ (~v4 \/ v28 \/ v37 \/ ~v75 \/ v91) /\ (v81 \/ ~v88 \/ v97) /\ (~v2 \/ v23 \/ ~v31 \/ ~v48 \/ v66) /\ (~v20 \/ v57 \/ ~v61 \/ ~v83 \/ v86 \/ v92 \/ ~v99) /\ (~v35 \/ v38 \/ ~v50 \/ v63 \/ ~v68 \/ ~v84 \/ v87 \/ ~v90) /\ (v22 \/ v34 \/ ~v56 \/ ~v65 \/ v76 \/ ~v77 \/ ~v95) /\ (v14 \/ ~v42 \/ v44 \/ v83) /\ (v32 \/ v87) /\ (~v22 \/ ~v51 \/ ~v77) /\ (~v70 \/ v85) /\ (~v3 \/ ~v15 \/ v44 \/ ~v50 \/ ~v92) /\ (v3 \/ v10 \/ v37 \/ ~v41 \/ ~v60 \/ ~v69 \/ v89) /\ (~v37 \/ v45 \/ ~v83 \/ ~v97) /\ (~v31 \/ v44 \/ v69) /\ (v13 \/ ~v19 \/ ~v29 \/ v36) /\ (v8 \/ v44 \/ v54 \/ ~v82 \/ v98) /\ (v61 \/ ~v62 \/ ~v84) /\ (~v23 \/ ~v74 \/ ~v85 \/ ~v90) /\ (v12 \/ v64 \/ ~v77 \/ ~v92) /\ (v17 \/ v22 \/ v38 \/ v40 \/ ~v48 \/ ~v66 \/ v69 \/ ~v79 \/ v94) /\ (v19 \/ v24 \/ v39 \/ ~v76 \/ ~v88 \/ ~v94) /\ (v37 \/ ~v57 \/ v71 \/ ~v73 \/ ~v93) /\ (v79 \/ ~v80 \/ v92) /\ (v1 \/ v12 \/ ~v14 \/ ~v18 \/ v45 \/ v61 \/ v63 \/ ~v85 \/ v88 \/ v90) /\ (~v6 \/ v19 \/ v68 \/ ~v73) /\ (~v11 \/ ~v46 \/ ~v85 \/ v89) /\ (~v31 \/ ~v43 \/ v63 \/ ~v73) /\ (v26 \/ ~v62 \/ ~v71 \/ v77) /\ (~v14 \/ ~v23 \/ ~v30 \/ v34 \/ ~v47 \/ v71 \/ v73) /\ (~v13 \/ v16 \/ ~v31 \/ v81 \/ v94) /\ (~v6 \/ ~v56 \/ ~v85 \/ ~v96) /\ (~v7 \/ v27 \/ ~v32 \/ v35 \/ ~v74) /\ (v3 \/ v6 \/ ~v8 \/ ~v17 \/ ~v43 \/ ~v54 \/ v65) /\ (v4 \/ ~v53 \/ v58 \/ ~v71 \/ v89 \/ ~v99) /\ (v36 \/ v92 \/ v97) /\ (~v1 \/ v11 \/ v29 \/ v36 \/ v37 \/ v98) /\ (~v31 \/ v34 \/ ~v47 \/ ~v64) /\ (~v26 \/ v80 \/ v88 \/ v91 \/ v98) /\ (v10 \/ ~v21 \/ v43 \/ v62 \/ ~v68 \/ ~v85 \/ ~v87) /\ (v71 \/ ~v88 \/ ~v93 \/ v96) /\ (~v4 \/ ~v63) /\ (~v21 \/ v36 \/ ~v61 \/ v79 \/ v82 \/ v88) /\ (v21 \/ v32 \/ ~v66 \/ ~v95) /\ (v37 \/ ~v51 \/ v86 \/ ~v88) /\ (v3 \/ v25 \/ v34 \/ v74 \/ v95 \/ v96) /\ (v35 \/ v76 \/ v91) /\ (~v24 \/ v90 \/ ~v93) /\ (~v19 \/ ~v23) /\ (v27 \/ v58 \/ ~v75) /\ (~v9 \/ v31 \/ ~v54 \/ ~v58 \/ ~v70) /\ (v2 \/ ~v5 \/ ~v49 \/ v51 \/ ~v52 \/ v62 \/ ~v66 \/ ~v69 \/ v73) /\ (v11 \/ ~v22 \/ ~v33 \/ v72 \/ v96 \/ v99) /\ (v12 \/ v30 \/ ~v35) /\ (~v39 \/ v44 \/ v48 \/ ~v60 \/ v62 \/ v66) /\ (~v3 \/ v20 \/ ~v45 \/ v67 \/ v71 \/ v83 \/ ~v100) /\ (v13 \/ v23 \/ ~v32 \/ ~v84) /\ (v9 \/ v13 \/ ~v16 \/ ~v64) /\ (v13 \/ ~v28 \/ v39 \/ v45 \/ v48 \/ v50 \/ ~v64 \/ ~v80) /\ (~v18 \/ ~v42 \/ ~v47 \/ ~v60) /\ (v24 \/ v29 \/ ~v32 \/ ~v45 \/ ~v87 \/ ~v92 \/ ~v99) /\ (v13 \/ ~v15 \/ ~v18 \/ ~v39 \/ ~v62) /\ (~v4 \/ v51) /\ (v6 \/ v70 \/ v94) /\ (v44 \/ v45 \/ ~v60 \/ v98) /\ (v12 \/ ~v21 \/ v42 \/ v58) /\ (v3 \/ ~v15 \/ v19 \/ v21 \/ ~v24 \/ v32) /\ (v13 \/ v19 \/ ~v56) /\ (~v4 \/ ~v78) /\ (v3 \/ v4 \/ ~v45 \/ ~v49 \/ ~v53 \/ v80) /\ (~v4 \/ v17 \/ ~v82 \/ ~v92) /\ (v34 \/ ~v39 \/ ~v56 \/ v63 \/ v68 \/ ~v73 \/ v83) /\ (v20 \/ ~v22 \/ ~v27 \/ v31 \/ v37 \/ v48 \/ v57 \/ v100) /\ (~v9 \/ ~v22 \/ v26 \/ v38 \/ ~v41 \/ v47 \/ ~v53 \/ v73) /\ (v74 \/ v91) /\ (~v5 \/ ~v59 \/ ~v79 \/ ~v82 \/ ~v98) /\ (~v2 \/ ~v46 \/ ~v76 \/ ~v85) /\ (~v19 \/ ~v23 \/ v64 \/ v75 \/ ~v76 \/ ~v86 \/ ~v89 \/ v92 \/ ~v100) /\ (~v12 \/ v25 \/ ~v59 \/ v74 \/ v96) /\ (~v3 \/ ~v5 \/ v29 \/ v57 \/ ~v67 \/ ~v75 \/ ~v80) /\ (~v14 \/ ~v17 \/ ~v42 \/ v55) /\ (v18 \/ ~v58 \/ v62) /\ (~v6 \/ v31 \/ v54 \/ v59) /\ (v12 \/ ~v66) /\ (v12 \/ ~v26 \/ ~v41 \/ v46) /\ (v36 \/ v78) /\ (~v1 \/ ~v13 \/ v30) /\ (v30 \/ ~v36 \/ v58 \/ v59 \/ ~v71) /\ (v2 \/ ~v22 \/ v26 \/ ~v41 \/ v55 \/ v58 \/ v60 \/ v92) /\ (~v24 \/ v44 \/ v64 \/ v67 \/ v68 \/ ~v100) /\ (v18 \/ ~v32 \/ v54) /\ (~v9 \/ v41 \/ v52 \/ ~v98) /\ (~v25 \/ ~v57 \/ v60) /\ (v20 \/ v21 \/ v73) /\ (v30 \/ v49 \/ v51 \/ v53 \/ v88 \/ ~v97 \/ v100) /\ (v47 \/ v52 \/ ~v94) /\ (~v25 \/ ~v38 \/ ~v48) /\ (v8 \/ v19 \/ v76 \/ ~v85 \/ ~v97) /\ (~v7 \/ v13 \/ ~v49) /\ (v3 \/ v22 \/ v23 \/ ~v58 \/ v67 \/ v77) /\ (v10 \/ ~v15 \/ ~v34 \/ v36 \/ v41 \/ ~v47) /\ (v44 \/ ~v46 \/ ~v79 \/ ~v99) /\ (v26 \/ v28 \/ ~v43 \/ v45 \/ v81) /\ (~v51 \/ ~v73 \/ ~v83) /\ (v2 \/ ~v46 \/ ~v69 \/ ~v84) /\ (~v28 \/ ~v41 \/ v63) /\ (v4 \/ ~v5 \/ ~v19 \/ v29 \/ ~v60 \/ ~v62 \/ ~v85 \/ v87 \/ ~v88) /\ (v5 \/ v14 \/ ~v26 \/ ~v30 \/ v66) /\ (~v2 \/ ~v47 \/ v78) /\ (v11 \/ v14 \/ v43 \/ v99) /\ (~v2 \/ v89 \/ v100) /\ (v68 \/ ~v82 \/ v86 \/ ~v97) /\ (v7 \/ v8 \/ ~v24 \/ v28 \/ v30 \/ v51 \/ ~v58 \/ ~v67 \/ ~v84 \/ ~v89) /\ (v36 \/ v51) /\ (~v17 \/ ~v42 \/ v53 \/ v54 \/ ~v69 \/ ~v72 \/ v99) /\ (v31 \/ v34 \/ v56 \/ ~v71 \/ ~v80) /\ (v31 \/ ~v52 \/ v64 \/ ~v65) /\ (v17 \/ ~v23 \/ ~v35 \/ ~v56 \/ v58 \/ v59 \/ ~v61 \/ v63 \/ v64 \/ ~v66 \/ ~v71) /\ (~v9 \/ v30 \/ ~v51) /\ (v2 \/ v3 \/ v22 \/ v37 \/ ~v60 \/ ~v69 \/ v81 \/ v92) /\ (v8 \/ ~v44 \/ ~v94) /\ (v9 \/ ~v37 \/ v55 \/ ~v73) /\ (v30 \/ v47 \/ ~v87 \/ v92) /\ (v12 \/ v26 \/ ~v41 \/ ~v57 \/ ~v65 \/ v93) /\ (v41 \/ ~v45 \/ ~v84 \/ v90) /\ (~v6 \/ ~v13) /\ (v31 \/ v45 \/ ~v56 \/ v67) /\ (v1 \/ v33 \/ ~v79 \/ ~v84) /\ (v14 \/ v21 \/ v30 \/ v32 \/ v37 \/ v48 \/ ~v62 \/ ~v65 \/ v75) /\ (~v6 \/ ~v33 \/ v41 \/ v50) /\ (~v12 \/ v17 \/ ~v37 \/ ~v68 \/ ~v77 \/ v88 \/ v89 \/ v96) /\ (~v28 \/ ~v60 \/ v79 \/ ~v84 \/ v95) /\ (~v12 \/ v37 \/ ~v54 \/ v95 \/ v99) /\ (v2 \/ v35 \/ ~v68 \/ ~v81 \/ v100) /\ (v4 \/ ~v10 \/ v13 \/ v31 \/ ~v33 \/ ~v83) /\ (v18 \/ v80 \/ v90) /\ (~v31 \/ ~v69 \/ v89) /\ (v51 \/ v52 \/ ~v57 \/ ~v71 \/ v79 \/ ~v81) /\ (v35 \/ v63) /\ (~v13 \/ v17 \/ ~v39 \/ v43 \/ ~v75 \/ v86) /\ (~v35 \/ v58 \/ ~v73 \/ ~v78 \/ ~v82 \/ v95 \/ v100) /\ (~v36 \/ v60 \/ ~v67) /\ (v33 \/ ~v36 \/ v43 \/ v78 \/ ~v88 \/ ~v99) /\ (v77 \/ v79 \/ v97) /\ (v2 \/ v5 \/ ~v32 \/ v38 \/ v63 \/ ~v94) /\ (~v1 \/ v52) /\ (v7 \/ ~v88 \/ v91) /\ (v10 \/ v17 \/ ~v22 \/ v75 \/ v76) /\ (~v34 \/ v74 \/ v80 \/ v95) /\ (~v33 \/ v36 \/ ~v57 \/ ~v74) /\ (~v47 \/ v66 \/ v71 \/ v80 \/ ~v92) /\ (v2 \/ ~v17 \/ ~v43 \/ v54 \/ v56 \/ ~v77 \/ ~v79 \/ v88 \/ ~v94 \/ ~v98) /\ (~v17 \/ ~v46 \/ v97) /\ (v27 \/ v55 \/ v82) /\ (~v4 \/ ~v27 \/ v34 \/ ~v40 \/ v71) /\ (v28 \/ ~v32 \/ ~v94) /\ (~v29 \/ v60 \/ v63 \/ ~v70 \/ v76) /\ (v1 \/ v2 \/ ~v9 \/ ~v14 \/ ~v20 \/ v79 \/ v93 \/ v94) /\ (~v33 \/ v42 \/ ~v45 \/ ~v69 \/ ~v73) /\ (~v10 \/ ~v16 \/ ~v29 \/ v56 \/ v58 \/ v75 \/ ~v88 \/ v95 \/ ~v96) /\ (v2 \/ ~v3 \/ v41 \/ ~v51 \/ v67 \/ ~v78) /\ (~v11 \/ ~v15 \/ ~v20 \/ ~v50 \/ v95) /\ (~v13 \/ ~v27 \/ ~v31 \/ ~v35 \/ v45 \/ ~v64 \/ ~v84 \/ v89 \/ ~v96) /\ (v5 \/ ~v16 \/ ~v45 \/ v47 \/ v87) /\ (~v15 \/ ~v18 \/ v31 \/ v98) /\ (v27 \/ ~v32 \/ v39 \/ v40 \/ v75 \/ ~v88) /\ (v14 \/ v16 \/ v29 \/ v30 \/ v46 \/ v50 \/ ~v56 \/ ~v80) /\ (v9 \/ v22 \/ v25 \/ v27 \/ ~v41 \/ ~v58 \/ v84 \/ ~v94) /\ (~v21 \/ ~v27) /\ (v10 \/ v11 \/ ~v17 \/ v38 \/ ~v57 \/ ~v98) /\ (v7 \/ v33 \/ ~v46 \/ ~v56 \/ ~v67) /\ (v20 \/ v26 \/ v69) /\ (~v35 \/ ~v42 \/ v69 \/ ~v90 \/ v98) /\ (v26 \/ ~v39 \/ ~v62 \/ ~v81 \/ v94) /\ (v24 \/ v25 \/ ~v36) /\ (~v3 \/ v10 \/ v37 \/ ~v38 \/ ~v49 \/ ~v64 \/ ~v67 \/ ~v88 \/ ~v100) /\ (~v26 \/ ~v31 \/ v37 \/ v38 \/ v66 \/ v98) /\ (v46 \/ ~v75 \/ v78 \/ ~v87 \/ ~v90) /\ (~v35 \/ v40 \/ v69 \/ ~v84 \/ v88) /\ (v22 \/ ~v44 \/ v53 \/ ~v54 \/ ~v57) /\ (~v59 \/ v69) /\ (v10 \/ v11 \/ v22 \/ v30 \/ ~v38 \/ ~v45 \/ ~v84) /\ (~v6 \/ v10 \/ ~v18 \/ v21 \/ ~v22 \/ v56 \/ v68 \/ v92 \/ ~v93) /\ (~v22 \/ v38 \/ v56 \/ ~v62) /\ (v41 \/ ~v63 \/ ~v67 \/ ~v79) /\ (v3 \/ ~v16 \/ v33 \/ v57) /\ (~v8 \/ v40) /\ (~v12 \/ ~v14 \/ v20 \/ v68 \/ ~v99) /\ (~v9 \/ ~v15 \/ v50) /\ (~v1 \/ ~v11 \/ v26 \/ ~v37 \/ v76 \/ v77 \/ ~v86) /\ (v46 \/ v70 \/ v87 \/ v97 \/ v98) /\ (v40 \/ ~v79 \/ v82 \/ ~v88 \/ v91) /\ (v6 \/ ~v13 \/ v37 \/ v46 \/ ~v84 \/ v100) /\ (v90 \/ ~v97) /\ (v1 \/ ~v8 \/ ~v11 \/ v32 \/ ~v40 \/ ~v57 \/ v75) /\ (~v29 \/ v66 \/ ~v70 \/ ~v92 \/ v95) /\ (~v4 \/ ~v44 \/ v47 \/ ~v59 \/ v72 \/ ~v77 \/ ~v93 \/ v96 \/ ~v99) /\ (v31 \/ v43 \/ ~v65 \/ ~v74 \/ v85 \/ ~v86) /\ (v23 \/ ~v51 \/ v53 \/ v92) /\ (v41 \/ v96) /\ (~v31 \/ ~v60 \/ ~v86) /\ (~v1 \/ ~v79 \/ v94) /\ (~v12 \/ ~v24 \/ v53 \/ ~v59) /\ (~v6 \/ v12 \/ v19 \/ v46 \/ ~v50 \/ ~v69 \/ ~v78 \/ v98) /\ (~v46 \/ v54 \/ ~v92) /\ (~v40 \/ v53 \/ v78) /\ (v7 \/ v22 \/ ~v28 \/ ~v38 \/ v45) /\ (v17 \/ v53 \/ v63 \/ ~v91) /\ (v70 \/ ~v71 \/ ~v93) /\ (~v32 \/ ~v83 \/ ~v94 \/ ~v99) /\ (~v1 \/ ~v77) /\ (v3 \/ v21 \/ v73 \/ ~v86) /\ (~v3 \/ v26 \/ v31 \/ v47 \/ v49 \/ ~v57 \/ ~v75 \/ v78 \/ ~v88) /\ (v28 \/ v33 \/ v48 \/ ~v85 \/ ~v97) /\ (~v2 \/ v88) /\ (v1 \/ v46 \/ ~v66 \/ v80 \/ ~v82) /\ (v88 \/ ~v89) /\ (v10 \/ v21 \/ ~v23 \/ ~v27 \/ v54 \/ v70 \/ v72 \/ ~v94 \/ v97 \/ v99) /\ (~v15 \/ v28 \/ v77 \/ ~v82) /\ (~v20 \/ ~v55 \/ ~v94 \/ v98) /\ (~v40 \/ ~v52 \/ v72 \/ ~v82) /\ (v35 \/ ~v71 \/ ~v80 \/ v86) /\ (v3 \/ ~v23 \/ ~v32 \/ ~v39 \/ v43 \/ ~v56 \/ v80 \/ v82) /\ (~v5 \/ ~v22 \/ v25 \/ ~v40 \/ v90) /\ (~v15 \/ ~v65 \/ ~v94) /\ (~v16 \/ v36 \/ ~v41 \/ v44 \/ ~v83) /\ (~v8 \/ v12 \/ v15 \/ ~v17 \/ ~v26 \/ ~v52 \/ ~v63 \/ v74) /\ (v1 \/ v6 \/ v13 \/ ~v62 \/ v67 \/ ~v80 \/ v98) /\ (v7 \/ v45) /\ (~v10 \/ v20 \/ v38 \/ v45 \/ v46) /\ (v7 \/ ~v40 \/ v43 \/ ~v56 \/ ~v73) /\ (~v35 \/ v89 \/ v97 \/ v100) /\ (~v2 \/ v5 \/ v19 \/ ~v30 \/ v52 \/ v71 \/ ~v77 \/ ~v94 \/ ~v96) /\ (v80 \/ ~v97) /\ (~v13 \/ ~v72) /\ (~v4 \/ ~v30 \/ v45 \/ ~v70 \/ v88 \/ v91 \/ v97) /\ (v30 \/ v41 \/ ~v75) /\ (v4 \/ v5 \/ v46 \/ ~v60 \/ v95 \/ ~v97) /\ (v12 \/ v34 \/ v43 \/ v83) /\ (~v2 \/ v44 \/ v85 \/ v100) /\ (~v33 \/ v99) /\ (~v28 \/ ~v32) /\ (v36 \/ v67 \/ ~v84) /\ (~v18 \/ v40 \/ ~v63 \/ ~v67 \/ ~v79) /\ (v5 \/ v8 \/ v11 \/ ~v14 \/ ~v58 \/ v60 \/ ~v61 \/ v71 \/ ~v75 \/ ~v78 \/ v82) /\ (v20 \/ ~v31 \/ ~v42 \/ v81) /\ (v21 \/ v39 \/ ~v44) /\ (~v9 \/ ~v48 \/ v53 \/ v57 \/ ~v69 \/ v71 \/ v75) /\ (~v12 \/ v29 \/ ~v54 \/ v76 \/ v80 \/ v92) /\ (v22 \/ v32 \/ ~v41 \/ ~v93) /\ (v18 \/ v22 \/ ~v25 \/ ~v73) /\ (v22 \/ ~v37 \/ v48 \/ v54 \/ v57 \/ v59 \/ ~v73 \/ ~v89) /\ (~v1 \/ ~v8 \/ ~v27 \/ ~v51 \/ ~v56 \/ ~v69) /\ (v33 \/ v38 \/ ~v41 \/ ~v54 \/ ~v96) /\ (v22 \/ ~v24 \/ ~v27 \/ ~v48 \/ ~v71) /\ (v3 \/ ~v13 \/ v60) /\ (v7 \/ v15 \/ v79) /\ (v53 \/ v54 \/ ~v69) /\ (v21 \/ ~v30 \/ v51 \/ v67) /\ (v12 \/ ~v24 \/ v28 \/ v30 \/ ~v33 \/ v41) /\ (v22 \/ v28 \/ ~v65) /\ (~v13 \/ ~v87) /\ (~v1 \/ v12 \/ v13 \/ ~v54 \/ ~v58 \/ ~v62 \/ v89) /\ (~v13 \/ v26 \/ ~v91) /\ (v9 \/ v43 \/ ~v48 \/ ~v65 \/ v72 \/ v77 \/ ~v82 \/ v92) /\ (v29 \/ ~v31 \/ ~v36 \/ v40 \/ v46 \/ v57 \/ v66) /\ (~v18 \/ ~v31 \/ v35 \/ v47 \/ ~v50 \/ v56 \/ ~v62 \/ v82) /\ (~v7 \/ v83 \/ v100) /\ (~v14 \/ ~v68 \/ ~v88 \/ ~v91) /\ (v1 \/ ~v9 \/ ~v11 \/ ~v55 \/ ~v85 \/ ~v94) /\ (v5 \/ ~v28 \/ ~v32 \/ v73 \/ v84 \/ ~v85 \/ ~v95 \/ ~v98) /\ (~v21 \/ v34 \/ ~v68 \/ v83) /\ (~v12 \/ ~v14 \/ v38 \/ v66 \/ ~v76 \/ ~v84 \/ ~v89) /\ (~v23 \/ ~v26 \/ ~v51 \/ v64) /\ (v27 \/ ~v67 \/ v71) /\ (~v15 \/ v40 \/ v63 \/ v68) /\ (v21 \/ ~v75) /\ (v21 \/ ~v35 \/ ~v50 \/ v55) /\ (v45 \/ v87) /\ (~v10 \/ ~v22 \/ v39) /\ (v1 \/ v39 \/ ~v45 \/ v67 \/ v68 \/ ~v80) /\ (~v9 \/ v11 \/ ~v31 \/ v35 \/ ~v50 \/ v64 \/ v67 \/ v69) /\ (~v33 \/ v53 \/ v73 \/ v76 \/ v77) /\ (~v7 \/ v27 \/ ~v41 \/ v63) /\ (~v18 \/ v50 \/ v61) /\ (~v34 \/ ~v66 \/ v69) /\ (~v6 \/ v9 \/ v29 \/ v30 \/ v82) /\ (~v3 \/ v39 \/ v58 \/ v60 \/ v62 \/ v97) /\ (v56 \/ v61) /\ (~v6 \/ ~v34 \/ ~v47 \/ ~v57) /\ (v17 \/ v28 \/ v85 \/ ~v94) /\ (~v16 \/ v22 \/ ~v58) /\ (v12 \/ v31 \/ v32 \/ ~v67 \/ v76 \/ v86) /\ (~v8 \/ v19 \/ ~v24 \/ ~v43 \/ v45 \/ v50 \/ ~v56) /\ (v53 \/ ~v55 \/ ~v88) /\ (v35 \/ v37 \/ ~v52 \/ v54 \/ v90) /\ (~v60 \/ ~v82 \/ ~v92) /\ (v11 \/ ~v55 \/ ~v78 \/ ~v93) /\ (~v37 \/ ~v50 \/ v72) /\ (v13 \/ ~v14 \/ ~v28 \/ v38 \/ ~v69 \/ ~v71 \/ ~v94 \/ v96 \/ ~v97) /\ (v14 \/ v23 \/ ~v35 \/ ~v39 \/ v75) /\ (v8 \/ ~v11 \/ ~v56 \/ v87) /\ (v9 \/ v20 \/ v23 \/ v52) /\ (~v6 \/ ~v11 \/ v98) /\ (v77 \/ ~v91 \/ v95) /\ (v16 \/ v17 \/ ~v33 \/ v37 \/ v39 \/ v60 \/ ~v67 \/ ~v76 \/ ~v93 \/ ~v98) /\ (v8 \/ v45 \/ v60) /\ (~v26 \/ ~v51 \/ v62 \/ v63 \/ ~v78 \/ ~v81) /\ (v40 \/ v43 \/ v65 \/ ~v80 \/ ~v89) /\ (v40 \/ ~v61 \/ v73 \/ ~v74) /\ (v26 \/ ~v32 \/ ~v44 \/ ~v65 \/ v67 \/ v68 \/ ~v70 \/ v72 \/ v73 \/ ~v75 \/ ~v80) /\ (~v18 \/ v39 \/ ~v60) /\ (v1 \/ ~v19) /\ (~v3 \/ v11 \/ v12 \/ v31 \/ v46 \/ ~v69 \/ ~v78 \/ v90) /\ (v17 \/ ~v53) /\ (v1 \/ v18 \/ ~v46 \/ v64 \/ ~v82) /\ (v2 \/ v39 \/ v56 \/ ~v96) /\ (v21 \/ v35 \/ ~v50 \/ ~v66 \/ ~v74) /\ (v50 \/ ~v54 \/ ~v93 \/ v99) /\ (~v15 \/ ~v22) /\ (v40 \/ v54 \/ ~v65 \/ v76) /\ (v10 \/ v42 \/ ~v88 \/ ~v93) /\ (v23 \/ v30 \/ v39 \/ v41 \/ v46 \/ v57 \/ ~v71 \/ ~v74 \/ v84) /\ (v5 \/ ~v15 \/ ~v42 \/ v50 \/ v59) /\ (v4 \/ ~v21 \/ v26 \/ ~v46 \/ ~v77 \/ ~v86 \/ v97 \/ v98) /\ (v4 \/ v8 \/ ~v37 \/ ~v69 \/ v88 \/ ~v93) /\ (v9 \/ ~v21 \/ v46 \/ ~v63) /\ (v11 \/ v44 \/ ~v77 \/ ~v90) /\ (v13 \/ ~v19 \/ v22 \/ v40 \/ ~v42 \/ ~v92) /\ (v27 \/ v89 \/ v99) /\ (~v40 \/ ~v78 \/ v98) /\ (v60 \/ v61 \/ ~v66 \/ ~v80 \/ v88 \/ ~v90) /\ (v2 \/ v44 \/ v72) /\ (v4 \/ v9 \/ ~v22 \/ v26 \/ ~v48 \/ v52 \/ ~v84 \/ v95) /\ (~v44 \/ v67 \/ ~v82 \/ ~v87 \/ ~v91) /\ (~v8 \/ ~v45 \/ v69 \/ ~v76) /\ (v6 \/ v42 \/ ~v45 \/ v52 \/ v87 \/ ~v97) /\ (~v3 \/ v86 \/ v88) /\ (v11 \/ v14 \/ ~v41 \/ v47 \/ v72) /\ (~v10 \/ v61) /\ (v16 \/ ~v97 \/ v100) /\ (v4 \/ v19 \/ v26 \/ ~v31 \/ v84 \/ v85) /\ (~v43 \/ v83 \/ v89) /\ (~v1 \/ ~v42 \/ v45 \/ ~v66 \/ ~v83) /\ (~v3 \/ ~v7 \/ ~v56 \/ v75 \/ v80 \/ v89) /\ (v6 \/ v11 \/ ~v26 \/ ~v52 \/ v63 \/ v65 \/ ~v86 \/ ~v88 \/ v97) /\ (~v26 \/ ~v55) /\ (v36 \/ v64 \/ v91) /\ (~v3 \/ ~v13 \/ ~v36 \/ v43 \/ ~v49 \/ v80) /\ (v37 \/ ~v41) /\ (v2 \/ v3 \/ ~v38 \/ v69 \/ v72 \/ ~v79 \/ v85) /\ (v10 \/ v11 \/ ~v18 \/ ~v23 \/ ~v29 \/ v88) /\ (v4 \/ ~v5 \/ ~v42 \/ v51 \/ ~v54 \/ ~v78 \/ ~v82) /\ (~v19 \/ ~v25 \/ ~v38 \/ v65 \/ v67 \/ v84 \/ ~v97) /\ (v4 \/ v11 \/ ~v12 \/ v50 \/ ~v60 \/ v76 \/ ~v87) /\ (~v5 \/ ~v20 \/ ~v24 \/ ~v29 \/ ~v59) /\ (~v22 \/ ~v36 \/ ~v40 \/ ~v44 \/ v54 \/ ~v73 \/ ~v93 \/ v98) /\ (v7 \/ v14 \/ ~v25 \/ ~v54 \/ v56 \/ v96) /\ (~v24 \/ ~v27 \/ v40) /\ (v36 \/ ~v41 \/ v48 \/ v49 \/ v84 \/ ~v97) /\ (~v3 \/ v23 \/ v25 \/ v38 \/ v39 \/ v55 \/ v59 \/ ~v65 \/ ~v89) /\ (v18 \/ v31 \/ v34 \/ v36 \/ ~v50 \/ ~v67 \/ v93) /\ (~v7 \/ ~v30 \/ ~v36) /\ (v19 \/ v20 \/ ~v26 \/ v47 \/ ~v66) /\ (v16 \/ v42 \/ ~v55 \/ ~v65 \/ ~v76) /\ (v7 \/ v29 \/ v35 \/ v78) /\ (v3 \/ ~v44 \/ ~v51 \/ v78 \/ ~v99) /\ (v35 \/ ~v48 \/ ~v71 \/ ~v90) /\ (~v9 \/ v33 \/ v34 \/ ~v45) /\ (v7 \/ ~v12 \/ v19 \/ v46 \/ ~v47 \/ ~v58 \/ ~v73 \/ ~v76 \/ ~v97) /\ (~v35 \/ ~v40 \/ v46 \/ v47 \/ v75) /\ (v55 \/ ~v84 \/ v87 \/ ~v96 \/ ~v99) /\ (~v44 \/ v49 \/ v78 \/ ~v93 \/ v97) /\ (v31 \/ ~v53 \/ v62 \/ ~v63 \/ ~v66) /\ (~v68 \/ v78) /\ (v1 \/ ~v2 \/ v19 \/ v20 \/ v31 \/ v39 \/ ~v47 \/ ~v54 \/ ~v93) /\ (~v15 \/ v19 \/ ~v27 \/ v30 \/ ~v31 \/ v65 \/ v77) /\ (~v31 \/ v47 \/ v65 \/ ~v71) /\ (v50 \/ ~v72 \/ ~v76 \/ ~v88) /\ (v12 \/ ~v25 \/ v42 \/ v66) /\ (~v8 \/ ~v17 \/ v49) /\ (~v21 \/ ~v23 \/ v29 \/ v77) /\ (~v18 \/ ~v24 \/ v59) /\ (v6 \/ v7 \/ ~v10 \/ ~v20 \/ v35 \/ ~v46 \/ v85 \/ v86 \/ ~v95) /\ (v55 \/ v79 \/ v96) /\ (v9 \/ v49 \/ ~v88 \/ v91 \/ ~v97 \/ v100) /\ (~v6 \/ v15 \/ ~v22 \/ v46 \/ v55 \/ ~v93) /\ (~v1 \/ v4 \/ v10 \/ ~v17 \/ ~v20 \/ v41 \/ ~v49 \/ ~v66 \/ v84) /\ (~v2 \/ v5 \/ ~v8 \/ ~v38 \/ v75 \/ ~v79) /\ (~v13 \/ ~v53 \/ v56 \/ ~v68 \/ v81 \/ ~v86) /\ (v1 \/ v40 \/ v52 \/ ~v74 \/ ~v83 \/ v94 \/ ~v95) /\ (v5 \/ v32 \/ ~v60 \/ v62) /\ (v3 \/ ~v40 \/ ~v69 \/ ~v95) /\ (~v10 \/ ~v88) /\ (v7 \/ ~v21 \/ ~v33 \/ v62 \/ ~v68) /\ (~v1 \/ ~v15 \/ v21 \/ v28 \/ v55 \/ ~v59 \/ ~v78 \/ ~v87) /\ (~v55 \/ v63) /\ (~v49 \/ v62 \/ v87) /\ (v16 \/ v31 \/ ~v37 \/ ~v47 \/ v54) /\ (~v2 \/ v26 \/ v62 \/ v72 \/ ~v100) /\ (~v3 \/ ~v8 \/ v79 \/ ~v80) /\ (~v41 \/ ~v92) /\ (~v10 \/ ~v86) /\ (v12 \/ v30 \/ v82 \/ ~v95) /\ (~v6 \/ ~v12 \/ v35 \/ v40 \/ v56 \/ v58 \/ ~v66 \/ ~v84 \/ v87 \/ ~v97) /\ (v37 \/ v42 \/ v57 \/ ~v94) /\ (~v11 \/ v97) /\ (v10 \/ v55 \/ ~v75 \/ v89 \/ ~v91) /\ (v97 \/ ~v98) /\ (~v3 \/ v6 \/ v8 \/ ~v29) /\ (v19 \/ v30 \/ ~v32 \/ ~v36 \/ v63 \/ v79 \/ v81) /\ (~v3 \/ v7 \/ ~v24 \/ v37 \/ v86 \/ ~v91) /\ (~v29 \/ ~v64) /\ (~v49 \/ ~v61 \/ v81 \/ ~v91) /\ (v44 \/ ~v80 \/ ~v89 \/ v95) /\ (v12 \/ ~v32 \/ ~v41 \/ ~v48 \/ v52 \/ ~v65 \/ v89 \/ v91) /\ (~v3 \/ ~v14 \/ ~v31 \/ v34 \/ ~v49 \/ v99) /\ (~v24 \/ ~v74) /\ (~v25 \/ v45 \/ ~v50 \/ v53 \/ ~v92) /\ (v7 \/ ~v17 \/ v21 \/ v24 \/ ~v26 \/ ~v35 \/ ~v61 \/ ~v72 \/ v83) /\ (v10 \/ v15 \/ v22 \/ ~v71 \/ v76 \/ ~v89) /\ (v16 \/ v54) /\ (~v19 \/ v29 \/ v47 \/ v54 \/ v55) /\ (v6 \/ v9 \/ v16 \/ ~v49 \/ v52 \/ ~v65 \/ ~v82) /\ (~v3 \/ ~v5 \/ ~v44 \/ v98) /\ (~v6 \/ ~v11 \/ v14 \/ v28 \/ ~v39 \/ v61 \/ v80 \/ ~v86) /\ (v6 \/ ~v22 \/ ~v81) /\ (~v13 \/ ~v39 \/ v54 \/ ~v79 \/ v97 \/ v100) /\ (v4 \/ ~v6 \/ v39 \/ v50 \/ ~v84) /\ (v13 \/ v14 \/ v55 \/ ~v69) /\ (v9 \/ v21 \/ v43 \/ v52 \/ v92) /\ (v8 \/ ~v11 \/ v53 \/ v94) /\ (~v37 \/ ~v41) /\ (v45 \/ v76 \/ ~v93) /\ (~v27 \/ v49 \/ ~v72 \/ ~v76 \/ ~v88) /\ (v14 \/ v17 \/ v20 \/ ~v23 \/ ~v67 \/ v69 \/ ~v70 \/ v80 \/ ~v84 \/ ~v87 \/ v91) /\ (v29 \/ ~v40 \/ ~v51 \/ v90) /\ (v30 \/ v48 \/ ~v53) /\ (v1 \/ ~v18 \/ ~v57 \/ v62 \/ v66 \/ ~v78 \/ v80 \/ v84) /\ (~v2 \/ ~v21 \/ v38 \/ ~v63 \/ v85 \/ v89) /\ (v31 \/ v41 \/ ~v50) /\ (v27 \/ v31 \/ ~v34 \/ ~v82) /\ (v31 \/ ~v46 \/ v57 \/ v63 \/ v66 \/ v68 \/ ~v82 \/ ~v98) /\ (~v5 \/ ~v10 \/ ~v17 \/ ~v36 \/ ~v60 \/ ~v65 \/ ~v78) /\ (v42 \/ v47 \/ ~v50 \/ ~v63) /\ (v31 \/ ~v33 \/ ~v36 \/ ~v57 \/ ~v80) /\ (v12 \/ ~v22 \/ v69) /\ (v16 \/ v24 \/ v88) /\ (v62 \/ v63 \/ ~v78) /\ (v30 \/ ~v39 \/ v60 \/ v76) /\ (v21 \/ ~v33 \/ v37 \/ v39 \/ ~v42 \/ v50) /\ (v31 \/ v37 \/ ~v74) /\ (~v22 \/ ~v96) /\ (~v10 \/ v21 \/ v22 \/ ~v63 \/ ~v67 \/ ~v71 \/ v98) /\ (v1 \/ ~v22 \/ v35 \/ ~v100) /\ (v18 \/ v52 \/ ~v57 \/ ~v74 \/ v81 \/ v86 \/ ~v91) /\ (v38 \/ ~v40 \/ ~v45 \/ v49 \/ v55 \/ v66 \/ v75) /\ (v9 \/ ~v27 \/ ~v40 \/ v44 \/ v56 \/ ~v59 \/ v65 \/ ~v71 \/ v91) /\ (~v16 \/ v92) /\ (~v3 \/ ~v23 \/ ~v77 \/ ~v97 \/ ~v100) /\ (~v4 \/ ~v7 \/ v10 \/ ~v18 \/ ~v20 \/ ~v64 \/ ~v94) /\ (v14 \/ ~v37 \/ ~v41 \/ v82 \/ v93 \/ ~v94) /\ (~v30 \/ v43 \/ ~v77 \/ v92) /\ (~v21 \/ ~v23 \/ v47 \/ v75 \/ ~v85 \/ ~v93 \/ ~v98) /\ (~v32 \/ ~v35 \/ ~v60 \/ v73) /\ (v36 \/ ~v76 \/ v80) /\ (~v24 \/ v49 \/ v72 \/ v77) /\ (v30 \/ ~v84) /\ (v30 \/ ~v44 \/ ~v59 \/ v64) /\ (v54 \/ v96) /\ (~v19 \/ ~v31 \/ v48) /\ (v10 \/ v48 \/ ~v54 \/ v76 \/ v77 \/ ~v89) /\ (~v18 \/ v20 \/ ~v40 \/ v44 \/ ~v59 \/ v73 \/ v76 \/ v78) /\ (~v42 \/ v62 \/ v82 \/ v85 \/ v86) /\ (~v16 \/ v36 \/ ~v50 \/ v72) /\ (~v27 \/ v59 \/ v70) /\ (~v43 \/ ~v75 \/ v78) /\ (v6 \/ ~v15 \/ v18 \/ v38 \/ v39 \/ v91) /\ (~v12 \/ v48 \/ v67 \/ v69 \/ v71) /\ (v65 \/ v70) /\ (~v3 \/ ~v15 \/ ~v43 \/ ~v56 \/ ~v66) /\ (v26 \/ v37 \/ v94) /\ (~v25 \/ v31 \/ ~v67) /\ (v21 \/ v40 \/ v41 \/ ~v76 \/ v85 \/ v95) /\ (~v17 \/ v28 \/ ~v33 \/ ~v52 \/ v54 \/ v59 \/ ~v65) /\ (v62 \/ ~v64 \/ ~v97) /\ (~v1 \/ v44 \/ v46 \/ ~v61 \/ v63 \/ v99) /\ (~v2 \/ ~v69 \/ ~v91) /\ (v20 \/ ~v64 \/ ~v87) /\ (~v46 \/ ~v59 \/ v81) /\ (~v3 \/ v5 \/ ~v6) /\ (v22 \/ ~v23 \/ ~v37 \/ v47 \/ ~v78 \/ ~v80) /\ (v23 \/ v32 \/ ~v44 \/ ~v48 \/ v84) /\ (v17 \/ ~v20 \/ ~v65 \/ v96) /\ (v7 \/ v18 \/ v29 \/ v32 \/ v61) /\ (v4 \/ ~v15 \/ ~v20) /\ (~v2 \/ ~v7 \/ v86 \/ ~v100) /\ (v25 \/ v26 \/ ~v42 \/ v46 \/ v48 \/ v69 \/ ~v76 \/ ~v85) /\ (v17 \/ v54 \/ v69) /\ (~v35 \/ ~v60 \/ v71 \/ v72 \/ ~v87 \/ ~v90) /\ (v49 \/ v52 \/ v74 \/ ~v89 \/ ~v98) /\ (v49 \/ ~v70 \/ v82 \/ ~v83) /\ (v35 \/ ~v41 \/ ~v53 \/ ~v74 \/ v76 \/ v77 \/ ~v79 \/ v81 \/ v82 \/ ~v84 \/ ~v89) /\ (~v27 \/ v48 \/ ~v69) /\ (v10 \/ ~v28) /\ (~v12 \/ v20 \/ v21 \/ v40 \/ v55 \/ ~v78 \/ ~v87 \/ v99) /\ (v26 \/ ~v62) /\ (~v5 \/ v10 \/ v27 \/ ~v55 \/ v73 \/ ~v91) /\ (v11 \/ v48 \/ v65) /\ (~v2 \/ v8 \/ v30 \/ v44 \/ ~v59 \/ ~v75 \/ ~v83) /\ (v59 \/ ~v63) /\ (~v24 \/ ~v31) /\ (~v2 \/ v49 \/ v63 \/ ~v74 \/ v85) /\ (v19 \/ v51 \/ ~v97) /\ (v32 \/ v39 \/ v48 \/ v50 \/ v55 \/ v66 \/ ~v80 \/ ~v83 \/ v93) /\ (v6 \/ v7 \/ v14 \/ ~v24 \/ ~v51 \/ v59 \/ v68) /\ (~v2 \/ v13 \/ ~v30 \/ v35 \/ ~v55 \/ ~v86 \/ ~v95) /\ (v13 \/ v17 \/ ~v46 \/ ~v78 \/ v97) /\ (v18 \/ ~v30 \/ v55 \/ ~v72) /\ (~v1 \/ v20 \/ v53 \/ ~v86 \/ ~v99) /\ (v8 \/ v22 \/ ~v28 \/ v31 \/ v49 \/ ~v51) /\ (v7 \/ v36 \/ v98) /\ (~v49 \/ ~v87) /\ (v69 \/ v70 \/ ~v75 \/ ~v89 \/ v97 \/ ~v99) /\ (v11 \/ v53 \/ v81) /\ (v13 \/ v18 \/ ~v31 \/ v35 \/ ~v57 \/ v61 \/ ~v93) /\ (~v53 \/ v76 \/ ~v91 \/ ~v96 \/ ~v100) /\ (~v6 \/ ~v17 \/ ~v54 \/ v78 \/ ~v85) /\ (v15 \/ v51 \/ ~v54 \/ v61 \/ v96) /\ (~v12 \/ v95 \/ v97) /\ (v20 \/ v23 \/ ~v50 \/ v56 \/ v81) /\ (~v6 \/ v9 \/ ~v19 \/ v70) /\ (v13 \/ v28 \/ v35 \/ ~v40 \/ v93 \/ v94) /\ (~v52 \/ v92 \/ v98) /\ (~v10 \/ ~v51 \/ v54 \/ ~v75 \/ ~v92) /\ (v6 \/ ~v12 \/ ~v16 \/ ~v65 \/ v84 \/ v89 \/ v98) /\ (v15 \/ v20 \/ ~v35 \/ ~v61 \/ v72 \/ v74 \/ ~v95 \/ ~v97) /\ (~v35 \/ ~v64) /\ (v45 \/ v73 \/ v100) /\ (~v12 \/ ~v22 \/ ~v45 \/ v52 \/ ~v58 \/ v89) /\ (v46 \/ ~v50) /\ (v11 \/ v12 \/ ~v47 \/ v78 \/ v81 \/ ~v88 \/ v94) /\ (v19 \/ v20 \/ ~v27 \/ ~v32 \/ ~v38 \/ v97) /\ (~v6 \/ v13 \/ ~v14 \/ ~v51 \/ v60 \/ ~v63 \/ ~v87 \/ ~v91) /\ (~v28 \/ ~v34 \/ ~v47 \/ v74 \/ v76 \/ v93) /\ (v13 \/ v20 \/ ~v21 \/ v59 \/ ~v69 \/ v85 \/ ~v96) /\ (~v2 \/ v7 \/ ~v14 \/ ~v29 \/ ~v33 \/ ~v38 \/ ~v68) /\ (v5 \/ ~v31 \/ ~v45 \/ ~v49 \/ ~v53 \/ v63 \/ ~v82) /\ (v16 \/ v23 \/ ~v34 \/ ~v63 \/ v65) /\ (~v6 \/ ~v33 \/ ~v36 \/ v49) /\ (v45 \/ ~v50 \/ v57 \/ v58 \/ v93) /\ (v2 \/ ~v12 \/ v32 \/ v34 \/ v47 \/ v48 \/ v64 \/ v68 \/ ~v74 \/ ~v98) /\ (v27 \/ v40 \/ v43 \/ v45 \/ ~v59 \/ ~v76) /\ (~v16 \/ ~v39 \/ ~v45) /\ (v28 \/ v29 \/ ~v35 \/ v56 \/ ~v75) /\ (v25 \/ v51 \/ ~v64 \/ ~v74 \/ ~v85) /\ (~v8 \/ v16 \/ v38 \/ v44 \/ v87) /\ (v12 \/ ~v53 \/ ~v60 \/ v87) /\ (v44 \/ ~v57 \/ ~v80 \/ ~v99) /\ (~v6 \/ ~v18 \/ v42 \/ v43 \/ ~v54) /\ (v16 \/ ~v21 \/ v28 \/ v55 \/ ~v56 \/ ~v67 \/ ~v82 \/ ~v85) /\ (~v5 \/ ~v8 \/ ~v44 \/ ~v49 \/ v55 \/ v56 \/ v84) /\ (~v2 \/ v6 \/ v64 \/ ~v93 \/ v96) /\ (~v53 \/ v58 \/ v87) /\ (v40 \/ ~v62 \/ v71 \/ ~v72 \/ ~v75) /\ (~v2 \/ ~v77 \/ v87) /\ (v10 \/ ~v11 \/ v28 \/ v29 \/ v40 \/ v48 \/ ~v56 \/ ~v63) /\ (~v24 \/ v28 \/ ~v36 \/ v39 \/ ~v40 \/ v74 \/ v86) /\ (~v40 \/ v56 \/ v74 \/ ~v80) /\ (v59 \/ ~v81 \/ ~v85 \/ ~v97) /\ (v21 \/ ~v34 \/ v51 \/ v75) /\ (~v17 \/ ~v26 \/ v58) /\ (~v30 \/ ~v32 \/ v38 \/ v86) /\ (~v4 \/ ~v27 \/ ~v33 \/ v68) /\ (v5 \/ v15 \/ v16 \/ ~v19 \/ ~v29 \/ v44 \/ ~v55 \/ v94 \/ v95) /\ (~v6 \/ v9 \/ v64 \/ v88) /\ (~v2 \/ v18 \/ v58 \/ ~v97 \/ v100) /\ (v8 \/ ~v15 \/ v24 \/ ~v31 \/ v55 \/ v64) /\ (~v10 \/ v13 \/ v19 \/ ~v26 \/ ~v29 \/ v50 \/ ~v58 \/ ~v75 \/ v93) /\ (~v11 \/ v14 \/ ~v17 \/ ~v47 \/ v84 \/ ~v88) /\ (v3 \/ ~v4 \/ ~v22 \/ ~v62 \/ v65 \/ ~v77 \/ v90 \/ ~v95) /\ (v10 \/ v49 \/ v61 \/ ~v83 \/ ~v92) /\ (v14 \/ v41 \/ ~v69 \/ v71) /\ (~v4 \/ v59) /\ (v12 \/ ~v49 \/ ~v78) /\ (~v19 \/ ~v97) /\ (v16 \/ ~v30 \/ ~v42 \/ v71 \/ ~v77) /\ (~v10 \/ ~v24 \/ v30 \/ v37 \/ v64 \/ ~v68 \/ ~v87 \/ ~v96) /\ (~v64 \/ v72) /\ (~v58 \/ v71 \/ v96) /\ (~v9 \/ v25 \/ v40 \/ ~v46 \/ ~v56 \/ v63) /\ (~v11 \/ v35 \/ v71 \/ v81) /\ (~v1 \/ ~v12 \/ ~v17 \/ v88 \/ ~v89) /\ (~v4 \/ ~v19 \/ ~v95) /\ (~v6 \/ v21 \/ v39 \/ v91) /\ (~v3 \/ ~v15 \/ ~v21 \/ v44 \/ v49 \/ v65 \/ v67 \/ ~v75 \/ ~v93 \/ v96) /\ (v6 \/ v46 \/ v51 \/ v66) /\ (v6 \/ ~v7 \/ v19 \/ v64 \/ ~v84 \/ v98 \/ ~v100) /\ (~v12 \/ v15 \/ v17 \/ ~v38) /\ (v28 \/ v39 \/ ~v41 \/ ~v45 \/ v72 \/ v88 \/ v90) /\ (~v12 \/ v16 \/ ~v33 \/ v46 \/ v95 \/ ~v100) /\ (~v38 \/ ~v73) /\ (v4 \/ ~v58 \/ ~v70 \/ v90 \/ ~v100) /\ (v53 \/ ~v89 \/ ~v98) /\ (v8 \/ v21 \/ ~v41 \/ ~v50 \/ ~v57 \/ v61 \/ ~v74 \/ v98 \/ v100) /\ (~v12 \/ ~v23 \/ ~v40 \/ v43 \/ ~v58) /\ (~v1 \/ ~v33 \/ ~v83) /\ (~v34 \/ v54 \/ ~v59 \/ v62) /\ (v16 \/ ~v26 \/ v30 \/ v33 \/ ~v35 \/ ~v44 \/ ~v70 \/ ~v81 \/ v92) /\ (v19 \/ v24 \/ v31 \/ ~v80 \/ v85 \/ ~v98) /\ (v25 \/ v63) /\ (~v28 \/ v38 \/ v56 \/ v63 \/ v64) /\ (v7 \/ v15 \/ v18 \/ v25 \/ ~v58 \/ v61 \/ ~v74 \/ ~v91) /\ (~v12 \/ ~v14 \/ ~v53) /\ (~v15 \/ ~v20 \/ v23 \/ v37 \/ ~v48 \/ v70 \/ v89 \/ ~v95) /\ (v6 \/ v9 \/ v15 \/ ~v31 \/ ~v90) /\ (~v22 \/ ~v48 \/ v63 \/ ~v88) /\ (v13 \/ ~v15 \/ v48 \/ v59 \/ ~v93) /\ (v1 \/ v22 \/ v23 \/ v64 \/ ~v78) /\ (v3 \/ v18 \/ v30 \/ v52 \/ v61) /\ (v17 \/ ~v20 \/ v62) /\ (~v2 \/ ~v46 \/ ~v50) /\ (v54 \/ v85) /\ (~v36 \/ v58 \/ ~v81 \/ ~v85 \/ ~v97) /\ (v23 \/ v26 \/ v29 \/ ~v32 \/ ~v76 \/ v78 \/ ~v79 \/ v89 \/ ~v93 \/ ~v96 \/ v100) /\ (v38 \/ ~v49 \/ ~v60 \/ v99) /\ (v39 \/ v57 \/ ~v62) /\ (v10 \/ ~v27 \/ ~v66 \/ v71 \/ v75 \/ ~v87 \/ v89 \/ v93) /\ (~v11 \/ ~v30 \/ v47 \/ ~v72 \/ v94 \/ v98) /\ (v40 \/ v50 \/ ~v59) /\ (v36 \/ v40 \/ ~v43 \/ ~v91) /\ (~v7 \/ v75) /\ (v40 \/ ~v55 \/ v66 \/ v72 \/ v75 \/ v77 \/ ~v91) /\ (~v14 \/ ~v19 \/ ~v26 \/ ~v45 \/ ~v69 \/ ~v74 \/ ~v87) /\ (v51 \/ v56 \/ ~v59 \/ ~v72) /\ (v40 \/ ~v42 \/ ~v45 \/ ~v66 \/ ~v89) /\ (v21 \/ ~v31 \/ v78) /\ (v25 \/ v33 \/ v97) /\ (v71 \/ v72 \/ ~v87) /\ (v39 \/ ~v48 \/ v69 \/ v85) /\ (v30 \/ ~v42 \/ v46 \/ v48 \/ ~v51 \/ v59) /\ (~v5 \/ v40 \/ v46 \/ ~v83) /\ (v7 \/ ~v31) /\ (~v9 \/ ~v19 \/ v30 \/ v31 \/ ~v72 \/ ~v76 \/ ~v80) /\ (v10 \/ ~v31 \/ v44) /\ (v27 \/ v61 \/ ~v66 \/ ~v83 \/ v90 \/ v95 \/ ~v100) /\ (v47 \/ ~v49 \/ ~v54 \/ v58 \/ v64 \/ v75 \/ v84) /\ (v1 \/ v18 \/ ~v36 \/ ~v49 \/ v53 \/ v65 \/ ~v68 \/ v74 \/ ~v80 \/ v100) /\ (~v6 \/ ~v9 \/ ~v25) /\ (~v3 \/ ~v12 \/ ~v32 \/ ~v86) /\ (v2 \/ ~v3 \/ ~v13 \/ ~v16 \/ v19 \/ ~v27 \/ ~v29 \/ ~v73) /\ (v1 \/ v23 \/ ~v46 \/ ~v50 \/ v91) /\ (~v2 \/ ~v7 \/ ~v39 \/ v52 \/ ~v86) /\ (~v30 \/ ~v32 \/ v56 \/ v84 \/ ~v94) /\ (~v41 \/ ~v44 \/ ~v69 \/ v82) /\ (v45 \/ ~v85 \/ v89) /\ (~v33 \/ v58 \/ v81 \/ v86) /\ (v39 \/ ~v93) /\ (v5 \/ v39 \/ ~v53 \/ ~v68 \/ v73) /\ (~v28 \/ ~v40 \/ v57) /\ (v19 \/ v57 \/ ~v63 \/ v85 \/ v86 \/ ~v98) /\ (~v27 \/ v29 \/ ~v49 \/ v53 \/ ~v68 \/ v82 \/ v85 \/ v87) /\ (~v51 \/ v71 \/ v91 \/ v94 \/ v95) /\ (~v25 \/ v45 \/ ~v59 \/ v81) /\ (~v36 \/ v68 \/ v79) /\ (~v52 \/ ~v84 \/ v87) /\ (v15 \/ ~v24 \/ v27 \/ v47 \/ v48 \/ v100) /\ (~v21 \/ v57 \/ v76 \/ v78 \/ v80) /\ (v74 \/ v79) /\ (v3 \/ ~v12 \/ ~v24 \/ ~v52 \/ ~v65 \/ ~v75) /\ (v35 \/ v46) /\ (v4 \/ ~v34 \/ v40 \/ ~v76) /\ (v30 \/ v49 \/ v50 \/ ~v85 \/ v94) /\ (~v6 \/ ~v26 \/ v37 \/ ~v42 \/ ~v61 \/ v63 \/ v68 \/ ~v74) /\ (v8 \/ v71 \/ ~v73) /\ (~v10 \/ v53 \/ v55 \/ ~v70 \/ v72) /\ (~v11 \/ ~v78 \/ ~v100) /\ (v29 \/ ~v73 \/ ~v96) /\ (~v55 \/ ~v68 \/ v90) /\ (~v12 \/ v14 \/ ~v15) /\ (v31 \/ ~v32 \/ ~v46 \/ v56 \/ ~v87 \/ ~v89) /\ (v5 \/ v32 \/ v41 \/ ~v53 \/ ~v57 \/ v93) /\ (v26 \/ ~v29 \/ ~v74) /\ (v16 \/ v27 \/ v38 \/ v41 \/ v70) /\ (~v9 \/ v13 \/ ~v24 \/ ~v29) /\ (~v11 \/ ~v16 \/ v95) /\ (v34 \/ v35 \/ ~v51 \/ v55 \/ v57 \/ v78 \/ ~v85 \/ ~v94) /\ (v26 \/ v63 \/ v78) /\ (~v7 \/ ~v44 \/ ~v69 \/ v80 \/ v81 \/ ~v96 \/ ~v99) /\ (v58 \/ v61 \/ v83 \/ ~v98) /\ (v58 \/ ~v79 \/ v91 \/ ~v92) /\ (v44 \/ ~v50 \/ ~v62 \/ ~v83 \/ v85 \/ v86 \/ ~v88 \/ v90 \/ v91 \/ ~v93 \/ ~v98) /\ (~v36 \/ v57 \/ ~v78) /\ (v8 \/ v19 \/ ~v37) /\ (~v21 \/ v29 \/ v30 \/ v49 \/ v64 \/ ~v87 \/ ~v96) /\ (v35 \/ ~v71) /\ (~v14 \/ v19 \/ v36 \/ ~v64 \/ v82 \/ ~v100) /\ (v20 \/ v57 \/ v74) /\ (~v11 \/ v17 \/ v39 \/ v53 \/ ~v68 \/ ~v84 \/ ~v92) /\ (v68 \/ ~v72) /\ (~v33 \/ ~v40) /\ (~v6 \/ ~v11 \/ v58 \/ v72 \/ ~v83 \/ v94) /\ (v2 \/ v28 \/ v60) /\ (v41 \/ v48 \/ v57 \/ v59 \/ v64 \/ v75 \/ ~v89 \/ ~v92) /\ (~v4 \/ v15 \/ v16 \/ v23 \/ ~v33 \/ ~v60 \/ v68 \/ v77) /\ (v6 \/ ~v11 \/ v22 \/ ~v39 \/ v44 \/ ~v64 \/ ~v95) /\ (v22 \/ v26 \/ ~v55 \/ ~v87) /\ (~v8 \/ v27 \/ ~v39 \/ v64 \/ ~v81) /\ (~v10 \/ v29 \/ v62 \/ ~v95) /\ (v7 \/ v17 \/ v31 \/ ~v37 \/ v40 \/ v58 \/ ~v60) /\ (v16 \/ v45) /\ (v6 \/ ~v8 \/ ~v58 \/ ~v96) /\ (v78 \/ v79 \/ ~v84 \/ ~v98) /\ (v20 \/ v62 \/ v90) /\ (~v2 \/ v13) /\ (~v5 \/ ~v9 \/ v22 \/ v27 \/ ~v40 \/ v44 \/ ~v66 \/ v70) /\ (~v62 \/ v85 \/ ~v100) /\ (v5 \/ ~v15 \/ ~v26 \/ ~v63 \/ v87 \/ ~v94) /\ (v4 \/ v6 \/ v24 \/ v60 \/ ~v63 \/ v70) /\ (v29 \/ v32 \/ ~v59 \/ v65 \/ v90) /\ (~v15 \/ v18 \/ ~v28 \/ v79) /\ (v2 \/ v3 \/ v34) /\ (v1 \/ v7 \/ v22 \/ v37 \/ v44 \/ ~v49) /\ (~v1 \/ ~v61) /\ (v7 \/ ~v19 \/ ~v60 \/ v63 \/ ~v84) /\ (~v4 \/ ~v6 \/ v15 \/ ~v21 \/ ~v25 \/ ~v74 \/ v93 \/ v98) /\ (v24 \/ v29 \/ ~v44 \/ ~v70 \/ v81 \/ v83) /\ (v9 \/ ~v44 \/ ~v73) /\ (v54 \/ v82) /\ (~v21 \/ ~v31 \/ ~v54 \/ v61 \/ ~v67 \/ v98) /\ (v3 \/ v55 \/ ~v59) /\ (v6 \/ v20 \/ v21 \/ ~v56 \/ v87 \/ v90 \/ ~v97) /\ (v28 \/ v29 \/ ~v36 \/ ~v41 \/ ~v47) /\ (v2 \/ ~v15 \/ v22 \/ ~v23 \/ ~v60 \/ v69 \/ ~v72 \/ ~v96 \/ ~v100) /\ (~v5 \/ ~v37 \/ ~v43 \/ ~v56 \/ v83 \/ v85) /\ (v22 \/ v29 \/ ~v30 \/ v68 \/ ~v78 \/ v94) /\ (~v11 \/ v16 \/ ~v23 \/ ~v38 \/ ~v42 \/ ~v47 \/ ~v77) /\ (v14 \/ ~v40 \/ ~v54 \/ ~v58 \/ ~v62 \/ v72 \/ ~v91) /\ (v25 \/ v32 \/ ~v43 \/ ~v72 \/ v74) /\ (v2 \/ ~v15 \/ ~v42 \/ ~v45 \/ v58) /\ (~v7 \/ v54 \/ ~v59 \/ v66 \/ v67) /\ (v11 \/ ~v21 \/ v41 \/ v43 \/ v56 \/ v57 \/ v73 \/ v77 \/ ~v83) /\ (v36 \/ v49 \/ v52 \/ v54 \/ ~v68 \/ ~v85) /\ (~v25 \/ ~v48 \/ ~v54) /\ (v37 \/ v38 \/ ~v44 \/ v65 \/ ~v84) /\ (v34 \/ v60 \/ ~v73 \/ ~v83 \/ ~v94) /\ (~v17 \/ v25 \/ v47 \/ v53 \/ v96) /\ (~v8 \/ v21 \/ ~v62 \/ ~v69 \/ v96) /\ (v53 \/ ~v66 \/ ~v89) /\ (~v15 \/ ~v27 \/ v51 \/ v52 \/ ~v63) /\ (v25 \/ ~v30 \/ v37 \/ v64 \/ ~v65 \/ ~v76 \/ ~v91 \/ ~v94) /\ (~v2 \/ v5 \/ ~v14 \/ ~v17 \/ ~v53 \/ ~v58 \/ v64 \/ v65 \/ v93) /\ (~v11 \/ v15 \/ v73) /\ (~v62 \/ v67 \/ v96) /\ (v49 \/ ~v71 \/ v80 \/ ~v81 \/ ~v84) /\ (~v11 \/ ~v86 \/ v96) /\ (v19 \/ ~v20 \/ v37 \/ v38 \/ v49 \/ v57 \/ ~v65 \/ ~v72) /\ (~v33 \/ v37 \/ ~v45 \/ v48 \/ ~v49 \/ v83 \/ v95) /\ (~v6 \/ ~v49 \/ v65 \/ v83 \/ ~v89) /\ (v68 \/ ~v90 \/ ~v94) /\ (v30 \/ ~v43 \/ v60 \/ v84) /\ (~v26 \/ ~v35 \/ v67) /\ (~v39 \/ ~v41 \/ v47 \/ v95) /\ (v3 \/ v4 \/ ~v13 \/ ~v36 \/ ~v42 \/ v77) /\ (v14 \/ v24 \/ v25 \/ ~v28 \/ ~v38 \/ v53 \/ ~v64) /\ (~v6 \/ v9 \/ ~v15 \/ v18 \/ v73 \/ v97) /\ (~v11 \/ v27 \/ v67) /\ (v17 \/ ~v24 \/ v33 \/ ~v40 \/ v64 \/ v73) /\ (~v19 \/ v22 \/ v28 \/ ~v35 \/ ~v38 \/ v59 \/ ~v67 \/ ~v84) /\ (~v4 \/ ~v20 \/ v23 \/ ~v26 \/ ~v56 \/ v93 \/ ~v97) /\ (~v1 \/ v12 \/ ~v13 \/ ~v31 \/ ~v71 \/ v74 \/ ~v86 \/ v99) /\ (v19 \/ v58 \/ v70 \/ ~v92) /\ (v23 \/ v50 \/ ~v78 \/ v80) /\ (~v13 \/ v68) /\ (~v6 \/ v21 \/ ~v58 \/ ~v87) /\ (~v5 \/ v25 \/ ~v39 \/ ~v51 \/ v80 \/ ~v86) /\ (~v19 \/ ~v33 \/ v39 \/ v46 \/ v73 \/ ~v77 \/ ~v96) /\ (v5 \/ ~v73 \/ v81) /\ (~v67 \/ v80) /\ (~v18 \/ v34 \/ v49 \/ ~v55 \/ ~v65 \/ v72) /\ (~v20 \/ v44 \/ v80 \/ v90) /\ (~v10 \/ ~v21 \/ ~v26 \/ v97 \/ ~v98) /\ (~v4 \/ ~v59) /\ (~v13 \/ ~v28) /\ (~v2 \/ v5 \/ ~v15 \/ v30 \/ v48 \/ v100) /\ (~v12 \/ ~v24 \/ ~v30 \/ v53 \/ v58 \/ v74 \/ v76 \/ ~v84) /\ (v15 \/ v55 \/ v60 \/ v75))` ;; let rip04_be = `(car1 <=> a1 /\ b1) /\ (car2 <=> (a2 \/ b2) /\ car1 \/ a2 /\ b2) /\ (car3 <=> (a3 \/ b3) /\ car2 \/ a3 /\ b3) /\ (cout <=> (a4 \/ b4) /\ car3 \/ a4 /\ b4) /\ (som4 <=> ~(a4 <=> ~(b4 <=> car3))) /\ (som3 <=> ~(a3 <=> ~(b3 <=> car2))) /\ (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ (som1 <=> ~(a1 <=> b1)) /\ (cout1 <=> b1 /\ a1) /\ (cout2 <=> cout1 /\ b2 \/ cout1 /\ a2 \/ b2 /\ a2) /\ (cout3 <=> cout2 /\ b3 \/ cout2 /\ a3 \/ b3 /\ a3) ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ (som2 <=> ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ (som3 <=> ~((~a3 /\ ~b3 \/ a3 /\ b3) /\ ~cout2 \/ cout2 /\ ~(~a3 /\ ~b3 \/ a3 /\ b3))) /\ (som4 <=> ~((~a4 /\ ~b4 \/ a4 /\ b4) /\ ~cout3 \/ cout3 /\ ~(~a4 /\ ~b4 \/ a4 /\ b4))) /\ (cout <=> a4 /\ cout3 \/ b4 /\ cout3 \/ a4 /\ b4)` ;; let ztwaalf2_be = `(out <=> ~(a1 /\ a2 \/ ~a3 /\ (a4 <=> a5) <=> a6 /\ b6) \/ (b1 /\ (b2 \/ b3 /\ (b4 <=> b5)) <=> b6 /\ a1)) ==> (out <=> a1 /\ a2 /\ ~a6 \/ ~a3 /\ ~a4 /\ ~a5 /\ ~a6 \/ ~a3 /\ a4 /\ a5 /\ ~a6 \/ ~a1 /\ ~b1 \/ ~a1 /\ ~b2 /\ ~b3 \/ ~a1 /\ ~b2 /\ b4 /\ ~b5 \/ ~a1 /\ ~b2 /\ ~b4 /\ b5 \/ a1 /\ a2 /\ ~b6 \/ ~a3 /\ ~a4 /\ ~a5 /\ ~b6 \/ ~a3 /\ a4 /\ a5 /\ ~b6 \/ ~b1 /\ ~b6 \/ ~b2 /\ ~b3 /\ ~b6 \/ ~b2 /\ b4 /\ ~b5 /\ ~b6 \/ ~b2 /\ ~b4 /\ b5 /\ ~b6 \/ ~a1 /\ a3 /\ a6 /\ b6 \/ ~a2 /\ a3 /\ a6 /\ b6 \/ ~a1 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ ~a2 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ ~a1 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ ~a2 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ a1 /\ b1 /\ b2 /\ b6 \/ a1 /\ b1 /\ b3 /\ ~b4 /\ ~b5 /\ b6 \/ a1 /\ b1 /\ b3 /\ b4 /\ b5 /\ b6)` ;; let ztwaalf1_be = `(out <=> a1 /\ a2 /\ ~a6 \/ ~a3 /\ ~a4 /\ ~a5 /\ ~a6 \/ ~a3 /\ a4 /\ a5 /\ ~a6 \/ ~a1 /\ ~b1 \/ ~a1 /\ ~b2 /\ ~b3 \/ ~a1 /\ ~b2 /\ b4 /\ ~b5 \/ ~a1 /\ ~b2 /\ ~b4 /\ b5 \/ a1 /\ a2 /\ ~b6 \/ ~a3 /\ ~a4 /\ ~a5 /\ ~b6 \/ ~a3 /\ a4 /\ a5 /\ ~b6 \/ ~b1 /\ ~b6 \/ ~b2 /\ ~b3 /\ ~b6 \/ ~b2 /\ b4 /\ ~b5 /\ ~b6 \/ ~b2 /\ ~b4 /\ b5 /\ ~b6 \/ ~a1 /\ a3 /\ a6 /\ b6 \/ ~a2 /\ a3 /\ a6 /\ b6 \/ ~a1 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ ~a2 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ ~a1 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ ~a2 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ a1 /\ b1 /\ b2 /\ b6 \/ a1 /\ b1 /\ b3 /\ ~b4 /\ ~b5 /\ b6 \/ a1 /\ b1 /\ b3 /\ b4 /\ b5 /\ b6) /\ (s1 <=> ~(a1 /\ a2 \/ ~a3 /\ (a4 <=> a5) <=> a6 /\ b6)) /\ (s2 <=> ~(b1 /\ (b2 \/ b3 /\ (b4 <=> b5)) <=> b6 /\ a1)) ==> (out <=> s1 \/ ~s2)` ;; let z4_be = `(ge2 <=> in3 \/ in0) /\ (ge4 <=> ~in3 \/ ~in0) /\ (ge1 <=> in5 \/ in2) /\ (ge3 <=> ge2 /\ in6 \/ in3 /\ in0) /\ (ge5 <=> ~ge2 \/ ge4 /\ ~in6) /\ (ge7 <=> ~in5 \/ ~in2) /\ (ge0 <=> in4 \/ in1) /\ (ge6 <=> ge3 /\ ge1 \/ in5 /\ in2) /\ (ge8 <=> in4 /\ in1) /\ (ge9 <=> ~in4 /\ in1 \/ in4 /\ ~in1) /\ (out0 <=> ge6 /\ ge0 \/ ge8) /\ (out1 <=> ge9 /\ ge7 /\ ge5 \/ ge6 /\ ~ge0 \/ ge9 /\ ~ge1 \/ ge8 /\ ge6) /\ (out2 <=> ge5 /\ in5 /\ ~in2 \/ ge5 /\ ~in5 /\ in2 \/ ge3 /\ ~ge1 \/ ~ge7 /\ ge3) /\ (out3 <=> ~in6 /\ in3 /\ ~in0 \/ ~in6 /\ ~in3 /\ in0 \/ ~ge2 /\ in6 \/ ~ge4 /\ in6) /\ (wres2 <=> in3 \/ in0) /\ (wres4 <=> ~in3 \/ ~in0) /\ (wres1 <=> in5 \/ in2) /\ (wres3 <=> wres2 /\ in6 \/ in3 /\ in0) /\ (wres5 <=> ~wres2 \/ wres4 /\ ~in6) /\ (wres7 <=> ~in5 \/ ~in2) /\ (wres0 <=> in4 \/ in1) /\ (wres6 <=> wres3 /\ wres1 \/ in5 /\ in2) /\ (wres8 <=> in4 /\ in1) /\ (wres9 <=> ~in4 /\ in1 \/ in4 /\ ~in1) ==> (out3 <=> ~in6 /\ in3 /\ ~in0 \/ ~in6 /\ ~in3 /\ in0 \/ ~wres2 /\ in6 \/ ~wres4 /\ in6) /\ (out2 <=> wres3 /\ ~wres1 \/ wres5 /\ ~in5 /\ in2 \/ wres5 /\ in5 /\ ~in2 \/ ~wres7 /\ wres3) /\ (out1 <=> wres6 /\ ~wres0 \/ wres8 /\ wres6 \/ wres9 /\ ~wres1 \/ wres9 /\ wres7 /\ wres5) /\ (out0 <=> wres6 /\ wres0 \/ wres8)` ;; let rip06_be = `(car1 <=> a1 /\ b1) /\ (car2 <=> (a2 \/ b2) /\ car1 \/ a2 /\ b2) /\ (car3 <=> (a3 \/ b3) /\ car2 \/ a3 /\ b3) /\ (car4 <=> (a4 \/ b4) /\ car3 \/ a4 /\ b4) /\ (car5 <=> (a5 \/ b5) /\ car4 \/ a5 /\ b5) /\ (cout <=> (a6 \/ b6) /\ car5 \/ a6 /\ b6) /\ (som6 <=> ~(a6 <=> ~(b6 <=> car5))) /\ (som5 <=> ~(a5 <=> ~(b5 <=> car4))) /\ (som4 <=> ~(a4 <=> ~(b4 <=> car3))) /\ (som3 <=> ~(a3 <=> ~(b3 <=> car2))) /\ (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ (som1 <=> ~(a1 <=> b1)) /\ (cout1 <=> b1 /\ a1) /\ (cout2 <=> cout1 /\ b2 \/ cout1 /\ a2 \/ b2 /\ a2) /\ (cout3 <=> cout2 /\ b3 \/ cout2 /\ a3 \/ b3 /\ a3) /\ (cout4 <=> cout3 /\ b4 \/ cout3 /\ a4 \/ b4 /\ a4) /\ (cout5 <=> cout4 /\ b5 \/ cout4 /\ a5 \/ b5 /\ a5) ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ (som2 <=> ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ (som3 <=> ~((~a3 /\ ~b3 \/ a3 /\ b3) /\ ~cout2 \/ cout2 /\ ~(~a3 /\ ~b3 \/ a3 /\ b3))) /\ (som4 <=> ~((~a4 /\ ~b4 \/ a4 /\ b4) /\ ~cout3 \/ cout3 /\ ~(~a4 /\ ~b4 \/ a4 /\ b4))) /\ (som5 <=> ~((~a5 /\ ~b5 \/ a5 /\ b5) /\ ~cout4 \/ cout4 /\ ~(~a5 /\ ~b5 \/ a5 /\ b5))) /\ (som6 <=> ~((~a6 /\ ~b6 \/ a6 /\ b6) /\ ~cout5 \/ cout5 /\ ~(~a6 /\ ~b6 \/ a6 /\ b6))) /\ (cout <=> a6 /\ cout5 \/ b6 /\ cout5 \/ a6 /\ b6)` ;; let add1_be = `(n3 <=> a_1_) /\ (n4 <=> a_3_) /\ (n5 <=> a_2_) /\ (n6 <=> a_4_) /\ (n7 <=> ~carryin) /\ (n8 <=> b_3_) /\ (n9 <=> b_1_) /\ (n10 <=> b_2_) /\ (n11 <=> b_4_) /\ (n17 <=> ~n3) /\ (n31 <=> ~n4) /\ (n29 <=> ~n5) /\ (n19 <=> ~n7) /\ (n43 <=> ~n6) /\ (n20 <=> ~n19) /\ (n18 <=> ~(n9 /\ ~n3 \/ ~n9 /\ n3)) /\ (n28 <=> ~(n10 /\ ~n5 \/ ~n10 /\ n5)) /\ (n32 <=> ~(n8 /\ ~n4 \/ ~n8 /\ n4)) /\ (n16 <=> ~n18) /\ (n24 <=> ~n28) /\ (n22 <=> ~n16) /\ (n42 <=> ~(n11 /\ ~n6 \/ ~n11 /\ n6)) /\ (n38 <=> ~n42) /\ (n27 <=> ~n24) /\ (n21 <=> ~(n20 /\ n16 \/ ~n20 /\ ~n16)) /\ (n23 <=> ~n16 /\ ~n3 \/ ~n22 /\ ~n19) /\ (n25 <=> ~n23) /\ (n26 <=> ~(n25 /\ ~n24 \/ ~n25 /\ n24)) /\ (n13 <=> ~n26) /\ (n30 <=> ~n32) /\ (n33 <=> ~n27 /\ ~n23 \/ ~n29 /\ ~n24) /\ (n36 <=> ~n30) /\ (n15 <=> ~n21) /\ (n34 <=> ~n33) /\ (n41 <=> ~n38) /\ (n37 <=> ~n30 /\ ~n4 \/ ~n36 /\ ~n33) /\ (n39 <=> ~n37) /\ (n40 <=> ~(n39 /\ ~n38 \/ ~n39 /\ n38)) /\ (n12 <=> ~n40) /\ (n35 <=> ~(n34 /\ n30 \/ ~n34 /\ ~n30)) /\ (n14 <=> ~n35) /\ (n44 <=> ~n41 /\ ~n37 \/ ~n43 /\ ~n38) /\ (cout <=> n44) /\ (o_4_ <=> n12) /\ (o_3_ <=> n14) /\ (o_2_ <=> n13) /\ (o_1_ <=> n15) /\ (cout1 <=> carryin /\ b_1_ \/ carryin /\ a_1_ \/ b_1_ /\ a_1_) /\ (cout2 <=> cout1 /\ b_2_ \/ cout1 /\ a_2_ \/ b_2_ /\ a_2_) /\ (cout3 <=> cout2 /\ b_3_ \/ cout2 /\ a_3_ \/ b_3_ /\ a_3_) ==> (o_1_ <=> ~(a_1_ <=> ~(b_1_ <=> carryin))) /\ (o_2_ <=> ~(a_2_ <=> ~(b_2_ <=> cout1))) /\ (o_3_ <=> ~(a_3_ <=> ~(b_3_ <=> cout2))) /\ (o_4_ <=> ~(a_4_ <=> ~(b_4_ <=> cout3))) /\ (cout <=> cout3 /\ b_4_ \/ cout3 /\ a_4_ \/ b_4_ /\ a_4_)` ;; let rip08_be = `(car1 <=> a1 /\ b1) /\ (car2 <=> (a2 \/ b2) /\ car1 \/ a2 /\ b2) /\ (car3 <=> (a3 \/ b3) /\ car2 \/ a3 /\ b3) /\ (car4 <=> (a4 \/ b4) /\ car3 \/ a4 /\ b4) /\ (car5 <=> (a5 \/ b5) /\ car4 \/ a5 /\ b5) /\ (car6 <=> (a6 \/ b6) /\ car5 \/ a6 /\ b6) /\ (car7 <=> (a7 \/ b7) /\ car6 \/ a7 /\ b7) /\ (cout <=> (a8 \/ b8) /\ car7 \/ a8 /\ b8) /\ (som8 <=> ~(a8 <=> ~(b8 <=> car7))) /\ (som7 <=> ~(a7 <=> ~(b7 <=> car6))) /\ (som6 <=> ~(a6 <=> ~(b6 <=> car5))) /\ (som5 <=> ~(a5 <=> ~(b5 <=> car4))) /\ (som4 <=> ~(a4 <=> ~(b4 <=> car3))) /\ (som3 <=> ~(a3 <=> ~(b3 <=> car2))) /\ (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ (som1 <=> ~(a1 <=> b1)) /\ (cout1 <=> b1 /\ a1) /\ (cout2 <=> cout1 /\ b2 \/ cout1 /\ a2 \/ b2 /\ a2) /\ (cout3 <=> cout2 /\ b3 \/ cout2 /\ a3 \/ b3 /\ a3) /\ (cout4 <=> cout3 /\ b4 \/ cout3 /\ a4 \/ b4 /\ a4) /\ (cout5 <=> cout4 /\ b5 \/ cout4 /\ a5 \/ b5 /\ a5) /\ (cout6 <=> cout5 /\ b6 \/ cout5 /\ a6 \/ b6 /\ a6) /\ (cout7 <=> cout6 /\ b7 \/ cout6 /\ a7 \/ b7 /\ a7) ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ (som2 <=> ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ (som3 <=> ~((~a3 /\ ~b3 \/ a3 /\ b3) /\ ~cout2 \/ cout2 /\ ~(~a3 /\ ~b3 \/ a3 /\ b3))) /\ (som4 <=> ~((~a4 /\ ~b4 \/ a4 /\ b4) /\ ~cout3 \/ cout3 /\ ~(~a4 /\ ~b4 \/ a4 /\ b4))) /\ (som5 <=> ~((~a5 /\ ~b5 \/ a5 /\ b5) /\ ~cout4 \/ cout4 /\ ~(~a5 /\ ~b5 \/ a5 /\ b5))) /\ (som6 <=> ~((~a6 /\ ~b6 \/ a6 /\ b6) /\ ~cout5 \/ cout5 /\ ~(~a6 /\ ~b6 \/ a6 /\ b6))) /\ (som7 <=> ~((~a7 /\ ~b7 \/ a7 /\ b7) /\ ~cout6 \/ cout6 /\ ~(~a7 /\ ~b7 \/ a7 /\ b7))) /\ (som8 <=> ~((~a8 /\ ~b8 \/ a8 /\ b8) /\ ~cout7 \/ cout7 /\ ~(~a8 /\ ~b8 \/ a8 /\ b8))) /\ (cout <=> a8 /\ cout7 \/ b8 /\ cout7 \/ a8 /\ b8)` ;; let aim_50_1_6_no_1 = `~ ((v16 \/ v23 \/ v42) /\ (~v16 \/ v23 \/ v42) /\ (v26 \/ v41 \/ ~v42) /\ (~v26 \/ v41 \/ ~v42) /\ (v32 \/ ~v41 \/ ~v42) /\ (v6 \/ v15 \/ ~v41) /\ (~v6 \/ v15 \/ ~v32) /\ (v1 \/ ~v32 \/ v46) /\ (~v1 \/ ~v32 \/ v46) /\ (~v15 \/ ~v41 \/ ~v46) /\ (~v15 \/ ~v21 \/ ~v46) /\ (~v23 \/ v33 \/ v38) /\ (~v23 \/ ~v33 \/ v38) /\ (v8 \/ v22 \/ v33) /\ (v8 \/ v22 \/ ~v33) /\ (~v22 \/ v37 \/ ~v38) /\ (v13 \/ v36 \/ ~v37) /\ (v13 \/ ~v22 \/ ~v36) /\ (~v13 \/ ~v22 \/ ~v37) /\ (v11 \/ ~v23 \/ v47) /\ (~v8 \/ v11 \/ ~v47) /\ (~v8 \/ ~v11 \/ v39) /\ (~v11 \/ v27 \/ ~v39) /\ (~v8 \/ ~v11 \/ ~v39) /\ (~v7 \/ v26 \/ v29) /\ (~v7 \/ ~v26 \/ v29) /\ (~v13 \/ v20 \/ v36) /\ (~v13 \/ v17 \/ v20) /\ (v5 \/ ~v17 \/ v20) /\ (v5 \/ ~v19 \/ ~v45) /\ (~v5 \/ ~v10 \/ ~v45) /\ (v6 \/ v25 \/ v47) /\ (~v6 \/ ~v10 \/ v25) /\ (~v2 \/ ~v27 \/ v37) /\ (~v27 \/ ~v36 \/ v40) /\ (v18 \/ v39 \/ ~v40) /\ (~v2 \/ ~v19 \/ v31) /\ (v5 \/ v18 \/ ~v30) /\ (~v31 \/ ~v43 \/ ~v50) /\ (v10 \/ ~v30 \/ v43) /\ (v10 \/ ~v41 \/ v43) /\ (v19 \/ v21 \/ v29) /\ (v37 \/ v42 \/ v45) /\ (~v20 \/ v27 \/ v40) /\ (~v21 \/ ~v36 \/ v48) /\ (v31 \/ ~v36 \/ ~v48) /\ (v3 \/ ~v9 \/ ~v18) /\ (v16 \/ ~v40 \/ ~v47) /\ (v1 \/ ~v18 \/ v21) /\ (v2 \/ v28 \/ v32) /\ (~v1 \/ ~v24 \/ ~v50) /\ (~v12 \/ v35 \/ v49) /\ (~v6 \/ ~v36 \/ v45) /\ (v7 \/ v12 \/ ~v43) /\ (v7 \/ v30 \/ ~v43) /\ (~v5 \/ v9 \/ ~v17) /\ (v3 \/ v14 \/ v50) /\ (~v12 \/ v17 \/ ~v49) /\ (v24 \/ v34 \/ v49) /\ (v14 \/ ~v20 \/ v24) /\ (~v9 \/ v35 \/ ~v49) /\ (~v4 \/ ~v47 \/ v50) /\ (v4 \/ v44 \/ ~v44) /\ (v28 \/ ~v28 \/ ~v38) /\ (v2 \/ v4 \/ ~v48) /\ (~v20 \/ v35 \/ ~v44) /\ (v30 \/ ~v31 \/ ~v43) /\ (~v14 \/ ~v29 \/ v35) /\ (~v20 \/ v35 \/ ~v35) /\ (v19 \/ ~v22 \/ ~v24) /\ (~v25 \/ ~v28 \/ v48) /\ (~v14 \/ ~v34 \/ v44) /\ (v9 \/ v20 \/ v44) /\ (~v3 \/ v9 \/ ~v29) /\ (v17 \/ v34 \/ ~v34) /\ (v12 \/ v48 \/ v48) /\ (~v12 \/ ~v25 \/ ~v43) /\ (~v25 \/ ~v31 \/ v48) /\ (v14 \/ ~v16 \/ v49) /\ (~v3 \/ ~v4 \/ ~v35))` ;; let aim_50_1_6_no_2 = `~ ((v5 \/ v17 \/ v37) /\ (v24 \/ v28 \/ v37) /\ (v24 \/ ~v28 \/ v40) /\ (v4 \/ ~v28 \/ ~v40) /\ (v4 \/ ~v24 \/ v29) /\ (v13 \/ ~v24 \/ ~v29) /\ (~v13 \/ ~v24 \/ ~v29) /\ (~v4 \/ v10 \/ ~v17) /\ (~v4 \/ ~v10 \/ ~v17) /\ (v26 \/ v33 \/ ~v37) /\ (v5 \/ ~v26 \/ v34) /\ (v33 \/ ~v34 \/ v48) /\ (v33 \/ ~v37 \/ ~v48) /\ (v5 \/ ~v33 \/ ~v37) /\ (v2 \/ ~v5 \/ v10) /\ (v2 \/ ~v5 \/ ~v10) /\ (~v2 \/ v15 \/ v47) /\ (v15 \/ v30 \/ ~v47) /\ (~v2 \/ ~v15 \/ v30) /\ (v20 \/ ~v30 \/ v42) /\ (~v2 \/ v20 \/ ~v30) /\ (v13 \/ ~v20 \/ v29) /\ (v13 \/ v16 \/ ~v20) /\ (~v13 \/ ~v20 \/ v31) /\ (~v13 \/ v16 \/ ~v31) /\ (~v16 \/ v23 \/ v38) /\ (~v16 \/ v19 \/ ~v38) /\ (~v19 \/ v23 \/ ~v38) /\ (v14 \/ ~v23 \/ v34) /\ (v1 \/ v14 \/ ~v34) /\ (~v1 \/ v9 \/ v14) /\ (~v1 \/ ~v9 \/ ~v23) /\ (~v14 \/ v21 \/ ~v23) /\ (~v14 \/ ~v16 \/ ~v21) /\ (v25 \/ ~v35 \/ v41) /\ (~v25 \/ v41 \/ v50) /\ (~v35 \/ v49 \/ ~v50) /\ (~v25 \/ ~v49 \/ ~v50) /\ (~v19 \/ ~v48 \/ ~v49) /\ (v3 \/ ~v39 \/ v44) /\ (v1 \/ v3 \/ ~v44) /\ (v9 \/ v35 \/ v44) /\ (~v9 \/ ~v31 \/ v44) /\ (v22 \/ v25 \/ ~v44) /\ (~v12 \/ ~v43 \/ v46) /\ (~v12 \/ ~v28 \/ ~v46) /\ (v6 \/ v35 \/ v48) /\ (v11 \/ v18 \/ ~v48) /\ (v22 \/ v38 \/ ~v42) /\ (v22 \/ ~v35 \/ ~v42) /\ (~v3 \/ v11 \/ v41) /\ (v27 \/ v28 \/ ~v43) /\ (~v15 \/ ~v21 \/ v31) /\ (~v33 \/ v39 \/ v50) /\ (~v8 \/ ~v22 \/ ~v47) /\ (~v22 \/ ~v40 \/ ~v47) /\ (v39 \/ v44 \/ ~v46) /\ (~v25 \/ ~v26 \/ v47) /\ (v38 \/ v43 \/ v45) /\ (~v6 \/ ~v14 \/ ~v45) /\ (~v7 \/ v12 \/ v36) /\ (v8 \/ ~v11 \/ v45) /\ (v27 \/ ~v38 \/ ~v50) /\ (v7 \/ ~v11 \/ ~v36) /\ (~v7 \/ ~v41 \/ v42) /\ (v7 \/ v21 \/ v23) /\ (~v18 \/ v32 \/ v46) /\ (v8 \/ v19 \/ ~v36) /\ (~v32 \/ ~v45 \/ ~v50) /\ (v7 \/ v17 \/ v21) /\ (v6 \/ v18 \/ v43) /\ (~v6 \/ v24 \/ ~v27) /\ (v40 \/ ~v41 \/ v49) /\ (~v11 \/ v12 \/ v26) /\ (~v3 \/ v32 \/ ~v36) /\ (~v6 \/ v36 \/ ~v44) /\ (~v3 \/ v36 \/ v42) /\ (~v8 \/ ~v11 \/ ~v32) /\ (~v18 \/ ~v27 \/ ~v38) /\ (~v18 \/ ~v27 \/ ~v39))` ;; let vg2_be = `(ge0 <=> ~in2 /\ in1 /\ in0 \/ ~in1 /\ ~in0) /\ (ge1 <=> in1 \/ in0) /\ (ge3 <=> in6 /\ ~in5 /\ ~in4 /\ ~in2 \/ ge1 /\ in3 /\ in2 \/ ge0 /\ in7) /\ (ge2 <=> in9 /\ ~in5 /\ ~in4 /\ ~in2 \/ ge1 /\ in8 /\ in2 \/ ge0 /\ in10) /\ (ge23 <=> in17 /\ in16 /\ in12 /\ in11) /\ (ge24 <=> ge3 /\ in19 /\ in18) /\ (ge21 <=> ~in17 /\ ~in16 /\ ~in12 /\ ~in11) /\ (ge22 <=> ge2 /\ ~in19 /\ ~in18) /\ (ge25 <=> ge24 /\ ge23) /\ (ge6 <=> ~in14 /\ ~in13) /\ (ge14 <=> ~in24 \/ ~in23 /\ in13) /\ (ge4 <=> ge22 /\ ge21) /\ (ge5 <=> ge25) /\ (ge9 <=> ge6 /\ ~in22) /\ (ge26 <=> in15 \/ in24 /\ ~in14) /\ (ge7 <=> in22 /\ in14 /\ in13) /\ (ge27 <=> ~in15 \/ ge14 /\ in14) /\ (ge10 <=> ge4 /\ ~in15) /\ (ge8 <=> ge5 /\ in15) /\ (ge13 <=> ge6 /\ in23 \/ ge9 /\ in21 \/ ge26) /\ (ge15 <=> ge7 /\ ~in21 \/ ge27) /\ (ge11 <=> ~in19 \/ in18 /\ ~in17) /\ (ge12 <=> in19 \/ ~in18 /\ in17) /\ (ge20 <=> ge2 /\ in12 \/ ge3 /\ ~in12) /\ (ge16 <=> ~in24 /\ ~in23 /\ ~in21 /\ ~in20) /\ (ge17 <=> ge10 /\ ge9) /\ (ge18 <=> in24 /\ in23 /\ in21 /\ in20) /\ (ge19 <=> ge8 /\ ge7) /\ (out0 <=> ge3) /\ (out1 <=> ge2) /\ (out2 <=> ge8 \/ ge10) /\ (out3 <=> ge19 /\ ge18 \/ ge17 /\ ge16) /\ (out4 <=> ge11 /\ ge3 /\ in11 \/ ge12 /\ ge2 /\ ~in11 \/ ge20) /\ (out5 <=> ge13 /\ ge2 \/ ge15 /\ ge3) /\ (out6 <=> ge5) /\ (out7 <=> ge4) /\ (wres0 <=> ~in2 /\ in1 /\ in0 \/ ~in1 /\ ~in0) /\ (wres1 <=> in1 \/ in0) /\ (wres6 <=> ~in14 /\ ~in13) /\ (wres3 <=> wres0 /\ in7 \/ wres1 /\ in3 /\ in2 \/ in6 /\ ~in5 /\ ~in4 /\ ~in2) /\ (wres2 <=> wres0 /\ in10 \/ wres1 /\ in8 /\ in2 \/ in9 /\ ~in5 /\ ~in4 /\ ~in2) /\ (wres9 <=> wres6 /\ ~in22) /\ (wres7 <=> in22 /\ in14 /\ in13) /\ (wres14 <=> ~in24 \/ ~in23 /\ in13) /\ (wres5 <=> wres3 /\ in19 /\ in18 /\ in17 /\ in16 /\ in12 /\ in11) /\ (wres4 <=> wres2 /\ ~in19 /\ ~in18 /\ ~in17 /\ ~in16 /\ ~in12 /\ ~in11) /\ (wres13 <=> wres6 /\ in23 \/ wres9 /\ in21 \/ in15 \/ in24 /\ ~in14) /\ (wres15 <=> wres7 /\ ~in21 \/ ~in15 \/ wres14 /\ in14) /\ (wres11 <=> ~in19 \/ in18 /\ ~in17) /\ (wres12 <=> in19 \/ ~in18 /\ in17) /\ (wres8 <=> wres5 /\ in15) /\ (wres10 <=> wres4 /\ ~in15) ==> (out7 <=> wres4) /\ (out6 <=> wres5) /\ (out5 <=> wres13 /\ wres2 \/ wres15 /\ wres3) /\ (out4 <=> wres2 /\ in12 \/ wres3 /\ ~in12 \/ wres11 /\ wres3 /\ in11 \/ wres12 /\ wres2 /\ ~in11) /\ (out3 <=> wres8 /\ wres7 /\ in24 /\ in23 /\ in21 /\ in20 \/ wres10 /\ wres9 /\ ~in24 /\ ~in23 /\ ~in21 /\ ~in20) /\ (out2 <=> wres8 \/ wres10) /\ (out1 <=> wres2) /\ (out0 <=> wres3)` ;; let misg_be = `(ge1 <=> ~in45 \/ ~in40) /\ (ge10 <=> ~in45 /\ ~in36 \/ ge1 /\ ~in43) /\ (ge6 <=> ~in43 \/ ~in36) /\ (ge16 <=> ge10 /\ ~in38 \/ ~in53) /\ (ge3 <=> ~in54 \/ ~in34) /\ (ge11 <=> ge6 /\ ge1 /\ ~in44 \/ ge16) /\ (ge4 <=> ~in39 \/ ~in40) /\ (ge2 <=> ~in45 /\ ~in39 \/ ~in40) /\ (ge5 <=> ~in38 \/ ~in44 /\ ~in37) /\ (ge8 <=> ~in43 /\ ~in35 \/ ~in36) /\ (ge14 <=> ~in49 \/ ge11 /\ ge3) /\ (ge0 <=> in54 /\ in33 /\ in20) /\ (ge7 <=> ~in37 \/ ~in38) /\ (ge9 <=> ge4 /\ ~in37 \/ ~in39 /\ ~in38) /\ (ge15 <=> ge14 \/ ~in47 \/ ~in32 \/ ge8 /\ ge5 /\ ge2) /\ (ge13 <=> ~in49 \/ in10 \/ ~in22) /\ (ge12 <=> in10 \/ in13 /\ in11) /\ (out0 <=> in7 /\ in6 \/ in5 /\ in4 \/ in3 /\ in2 \/ in1 /\ in0) /\ (out1 <=> ~in48) /\ (out2 <=> ~in9 \/ ge12) /\ (out3 <=> ~in8 \/ ~in14) /\ (out4 <=> ~in15) /\ (out5 <=> ~in16) /\ (out6 <=> ~in17) /\ (out7 <=> ~in12) /\ (out8 <=> ge13 \/ ~in21) /\ (out9 <=> ~in23 \/ ~in24) /\ (out10 <=> in20 /\ in19 /\ in18) /\ (out11 <=> ~in26 \/ ~in25) /\ (out12 <=> ~in28 \/ in27 \/ in17) /\ (out13 <=> ~in29 \/ in27) /\ (out14 <=> ~in50 /\ in49 \/ in27) /\ (out15 <=> in30 \/ in31) /\ (out16 <=> ~in51) /\ (out17 <=> ~in52) /\ (out18 <=> ~in41 \/ ~in42) /\ (out19 <=> ~in46 \/ ge0) /\ (out20 <=> ge15 \/ ge7 /\ ge4 /\ ~in53 /\ ~in35 \/ ge9 /\ ~in53 /\ ~in36) /\ (out21 <=> ~in55) /\ (out22 <=> ~in32 \/ ge0) /\ (wres1 <=> ~in45 \/ ~in40) /\ (wres4 <=> ~in39 \/ ~in40) /\ (wres6 <=> ~in43 \/ ~in36) /\ (wres10 <=> ~in45 /\ ~in36 \/ wres1 /\ ~in43) /\ (wres0 <=> in54 /\ in33 /\ in20) /\ (wres2 <=> ~in45 /\ ~in39 \/ ~in40) /\ (wres3 <=> ~in54 \/ ~in34) /\ (wres5 <=> ~in38 \/ ~in44 /\ ~in37) /\ (wres7 <=> ~in37 \/ ~in38) /\ (wres8 <=> ~in36 \/ ~in43 /\ ~in35) /\ (wres9 <=> wres4 /\ ~in37 \/ ~in39 /\ ~in38) /\ (wres11 <=> wres10 /\ ~in38 \/ wres6 /\ wres1 /\ ~in44 \/ ~in53) ==> (out22 <=> ~in32 \/ wres0) /\ (out21 <=> ~in55) /\ (out20 <=> ~in47 \/ wres7 /\ wres4 /\ ~in53 /\ ~in35 \/ wres8 /\ wres5 /\ wres2 \/ wres9 /\ ~in53 /\ ~in36 \/ ~in32 \/ wres11 /\ wres3 \/ ~in49) /\ (out19 <=> ~in46 \/ wres0) /\ (out18 <=> ~in41 \/ ~in42) /\ (out17 <=> ~in52) /\ (out16 <=> ~in51) /\ (out15 <=> in30 \/ in31) /\ (out14 <=> ~in50 /\ in49 \/ in27) /\ (out13 <=> ~in29 \/ in27) /\ (out12 <=> ~in28 \/ in27 \/ in17) /\ (out11 <=> ~in26 \/ ~in25) /\ (out10 <=> in20 /\ in19 /\ in18) /\ (out9 <=> ~in23 \/ ~in24) /\ (out8 <=> ~in21 \/ ~in22 \/ ~in49 \/ in10) /\ (out7 <=> ~in12) /\ (out6 <=> ~in17) /\ (out5 <=> ~in16) /\ (out4 <=> ~in15) /\ (out3 <=> ~in8 \/ ~in14) /\ (out2 <=> in13 /\ in11 \/ ~in9 \/ in10) /\ (out1 <=> ~in48) /\ (out0 <=> in7 /\ in6 \/ in5 /\ in4 \/ in3 /\ in2 \/ in1 /\ in0)` ;; let x1dn_be = `(ge0 <=> ~in8 /\ ~in7 \/ in8 /\ in7 /\ ~in6) /\ (ge1 <=> in8 \/ in7) /\ (ge3 <=> in14 /\ ~in11 /\ ~in10 /\ ~in6 \/ ge1 /\ in15 /\ in6 \/ ge0 /\ in13) /\ (ge2 <=> ~in11 /\ ~in10 /\ in9 /\ ~in6 \/ ge1 /\ in12 /\ in6 \/ ge0 /\ in5) /\ (ge20 <=> in3 /\ in2 /\ in1 /\ in0) /\ (ge21 <=> ge3 /\ in23 /\ in4) /\ (ge18 <=> ~in3 /\ ~in2 /\ ~in1 /\ ~in0) /\ (ge19 <=> ge2 /\ ~in23 /\ ~in4) /\ (ge22 <=> ge21 /\ ge20) /\ (ge4 <=> ge19 /\ ge18) /\ (ge5 <=> ge22) /\ (ge6 <=> ~in22 /\ ~in20 /\ ~in18) /\ (ge9 <=> ge4 /\ ~in16) /\ (ge7 <=> in22 /\ in20 /\ in18) /\ (ge8 <=> ge5 /\ in16) /\ (ge12 <=> in20 /\ ~in19 \/ ~in17) /\ (ge14 <=> ~in20 /\ in19 \/ in17) /\ (ge25 <=> ~in26 /\ ~in21 /\ ~in19 /\ ~in17) /\ (ge26 <=> ge9 /\ ge6) /\ (ge27 <=> in26 /\ in21 /\ in19 /\ in17) /\ (ge28 <=> ge8 /\ ge7) /\ (ge23 <=> ~in16 \/ ge12 /\ in18) /\ (ge24 <=> in16 \/ ge14 /\ ~in18) /\ (ge16 <=> ge28 /\ ge27 \/ ge26 /\ ge25) /\ (ge13 <=> ge7 /\ ~in21 \/ ge23) /\ (ge15 <=> ge6 /\ in21 \/ ge24) /\ (ge10 <=> ~in4 \/ in3 /\ ~in2) /\ (ge11 <=> in4 \/ ~in3 /\ in2) /\ (ge17 <=> ge2 /\ in0 \/ ge3 /\ ~in0) /\ (out0 <=> ge10 /\ ge3 /\ in1 \/ ge11 /\ ge2 /\ ~in1 \/ ge17) /\ (out1 <=> ge13 /\ ge3 \/ ge15 /\ ge2) /\ (out2 <=> ge8 \/ ge9) /\ (out3 <=> ge5) /\ (out4 <=> ge4) /\ (out5 <=> ge16 /\ ~in25 \/ ge16 /\ ~in24) /\ (wres0 <=> ~in8 /\ ~in7 \/ in8 /\ in7 /\ ~in6) /\ (wres1 <=> in8 \/ in7) /\ (wres3 <=> wres0 /\ in13 \/ wres1 /\ in15 /\ in6 \/ in14 /\ ~in11 /\ ~in10 /\ ~in6) /\ (wres2 <=> wres1 /\ in12 /\ in6 \/ ~in11 /\ ~in10 /\ in9 /\ ~in6 \/ wres0 /\ in5) /\ (wres5 <=> wres3 /\ in23 /\ in4 /\ in3 /\ in2 /\ in1 /\ in0) /\ (wres4 <=> wres2 /\ ~in23 /\ ~in4 /\ ~in3 /\ ~in2 /\ ~in1 /\ ~in0) /\ (wres6 <=> ~in22 /\ ~in20 /\ ~in18) /\ (wres7 <=> in22 /\ in20 /\ in18) /\ (wres8 <=> wres5 /\ in16) /\ (wres9 <=> wres4 /\ ~in16) /\ (wres12 <=> in20 /\ ~in19 \/ ~in17) /\ (wres14 <=> ~in20 /\ in19 \/ in17) /\ (wres16 <=> wres8 /\ wres7 /\ in26 /\ in21 /\ in19 /\ in17 \/ wres9 /\ wres6 /\ ~in26 /\ ~in21 /\ ~in19 /\ ~in17) /\ (wres13 <=> wres7 /\ ~in21 \/ wres12 /\ in18 \/ ~in16) /\ (wres15 <=> wres6 /\ in21 \/ wres14 /\ ~in18 \/ in16) /\ (wres10 <=> ~in4 \/ in3 /\ ~in2) /\ (wres11 <=> in4 \/ ~in3 /\ in2) ==> (out5 <=> wres16 /\ ~in25 \/ wres16 /\ ~in24) /\ (out4 <=> wres4) /\ (out3 <=> wres5) /\ (out2 <=> wres8 \/ wres9) /\ (out1 <=> wres13 /\ wres3 \/ wres15 /\ wres2) /\ (out0 <=> wres2 /\ in0 \/ wres3 /\ ~in0 \/ wres10 /\ wres3 /\ in1 \/ wres11 /\ wres2 /\ ~in1)` ;; let counter_be = `(b6 <=> a1 /\ ~a2 \/ ~a1 /\ a2 \/ ~a0 /\ a1 \/ a3) /\ (b5 <=> a0 /\ ~a1 /\ a2 \/ ~a0 /\ a1 \/ a1 /\ ~a2 \/ ~a0 /\ ~a2 \/ a3) /\ (b4 <=> a0 \/ a2 \/ ~a1) /\ (b3 <=> ~a2 /\ ~a3 \/ a0 /\ a1 \/ ~a0 /\ ~a1 \/ a3) /\ (b2 <=> ~a0 /\ ~a2 \/ a0 /\ a2 \/ a1 \/ a3) /\ (b1 <=> ~a0 /\ a2 \/ a3 \/ ~a1 /\ a2 \/ ~a0 /\ ~a1) /\ (b0 <=> ~a0 /\ a1 \/ ~a0 /\ ~a2) /\ (ta3 <=> cb /\ a3 \/ ~ca /\ a3 \/ ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ ca /\ ~cb /\ ~a0 /\ a3) /\ (ta2 <=> cb /\ a2 \/ ~ca /\ a2 \/ ca /\ ~cb /\ a0 /\ a1 /\ ~a2 \/ ca /\ ~cb /\ ~a0 /\ a1 /\ a2 \/ ca /\ ~cb /\ ~a1 /\ a2) /\ (ta1 <=> cb /\ a1 \/ ~ca /\ a1 \/ ca /\ ~cb /\ ~a0 /\ a1 /\ ~a3 \/ ca /\ ~cb /\ a0 /\ ~a1 /\ ~a3) /\ (ta0 <=> cb /\ a0 \/ ~ca /\ a0 \/ ca /\ ~cb /\ ~a0) /\ (tcb <=> ca) ==> (tcb <=> ca) /\ (ta0 <=> cb /\ a0 \/ ~ca /\ a0 \/ ca /\ ~cb /\ ~a0) /\ (ta1 <=> ~a0 /\ a1 /\ ~a3 \/ ca /\ ~cb /\ a0 /\ ~a1 /\ ~a3 \/ cb /\ a1 \/ ~ca /\ a1) /\ (ta2 <=> ~a0 /\ a2 \/ a0 /\ ~a1 /\ a2 \/ cb /\ a0 /\ a1 /\ a2 \/ ~ca /\ a0 /\ a1 /\ a2 \/ ca /\ ~cb /\ a0 /\ a1 /\ ~a2) /\ (ta3 <=> ~a0 /\ a3 \/ cb /\ a0 /\ a3 \/ ~ca /\ a3 \/ ca /\ ~cb /\ a0 /\ a1 /\ a2) /\ (b0 <=> ~a0 /\ ~a1 /\ ~a2 \/ ~a0 /\ a1) /\ (b1 <=> ~a0 /\ a3 \/ a0 /\ a3 \/ ~a0 /\ a2 \/ a0 /\ ~a1 /\ a2 \/ ~a0 /\ ~a1 /\ ~a2) /\ (b2 <=> ~a0 /\ a3 \/ a0 /\ a3 \/ ~a0 /\ a1 /\ ~a3 \/ ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ a0 /\ ~a1 /\ a2 \/ cb /\ a0 /\ a1 /\ a2 \/ ~ca /\ a0 /\ a1 /\ a2 \/ a1 /\ ~a2 \/ ~a0 /\ ~a1 /\ ~a2) /\ (b3 <=> ~a0 /\ a3 \/ a0 /\ a3 \/ ~a2 \/ ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ ~a0 /\ ~a1 /\ a2 \/ cb /\ a0 /\ a1 /\ a2 \/ ~ca /\ a0 /\ a1 /\ a2) /\ (b4 <=> a0 /\ a3 \/ ca /\ ~cb /\ a0 /\ ~a1 /\ ~a3 \/ ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ ~a0 /\ a2 \/ ca /\ ~cb /\ a0 /\ a1 /\ ~a2 \/ ~a0 /\ ~a1 /\ ~a2 \/ cb /\ a0 \/ ~ca /\ a0) /\ (b5 <=> ~a0 /\ a3 \/ a0 /\ a3 \/ a0 /\ ~a1 /\ a2 \/ a1 /\ ~a2 \/ ~a0 /\ ~a1 /\ ~a2 \/ ~a0 /\ a1) /\ (b6 <=> ~a0 /\ a3 \/ a0 /\ a3 \/ a0 /\ ~a1 /\ a2 \/ ~a0 /\ ~a1 /\ a2 \/ a1 /\ ~a2 \/ ~a0 /\ a1)` ;; let sqn_be = `(ge0 <=> in6 /\ in1 \/ ~in6 /\ ~in1) /\ (ge8 <=> ~in3 /\ ~in1) /\ (ge5 <=> in6 \/ in5) /\ (ge9 <=> ~ge0 \/ in2 \/ ~in5) /\ (ge1 <=> in3 \/ ~in0) /\ (ge11 <=> ge8 /\ in4) /\ (ge3 <=> ~in4 \/ ~in2) /\ (ge34 <=> ~ge5 /\ in4 \/ ~ge9) /\ (ge2 <=> ~in4 /\ in1) /\ (ge14 <=> ~ge1 /\ ~in4) /\ (ge19 <=> ge11 /\ ~ge5) /\ (ge13 <=> ge8 /\ ~ge3 /\ ~in0) /\ (ge20 <=> ~in5 /\ in2 \/ ge34) /\ (ge12 <=> ge2 /\ ~in3) /\ (ge27 <=> ge14 /\ in6 \/ ge19) /\ (ge10 <=> ~in6 \/ in5) /\ (ge28 <=> ge13 \/ ge20 /\ ~ge1) /\ (ge6 <=> ~in5 \/ in6) /\ (ge15 <=> ge2 /\ in2) /\ (ge29 <=> ge27 \/ ge12 /\ ge5) /\ (ge4 <=> in3 /\ ~in0) /\ (ge21 <=> ~ge10 /\ ~in1 \/ ~in5 /\ ~in2) /\ (ge30 <=> ge28 \/ ge14 /\ in2) /\ (ge31 <=> ge29 \/ ge15 /\ ~ge6) /\ (ge7 <=> ~in6 \/ ~in5) /\ (ge17 <=> ~ge3 /\ ~in1) /\ (ge18 <=> ge4 /\ in2) /\ (ge16 <=> ge2 /\ in0) /\ (ge23 <=> ge19 \/ ge9 /\ ~ge1) /\ (ge32 <=> ge15 /\ ~in6 /\ ~in0 \/ ge21 /\ ge4 /\ ~in4 \/ ge30 \/ ge31) /\ (ge33 <=> ge18 /\ ~ge6 /\ ~in4 \/ ge17 /\ ~ge7 /\ in3 \/ ~ge7 /\ ge4 /\ ~ge3 \/ ge11 /\ in5 /\ ~in0) /\ (ge25 <=> ge14 /\ ~ge6 \/ ge13 /\ ~ge5 \/ ge16 /\ ~in5 \/ ge15 /\ ge1) /\ (ge26 <=> ge12 /\ in5 /\ ~in2 \/ ge10 /\ ge4 /\ in1 \/ ge17 /\ ~ge6 /\ in0 \/ ge2 /\ ~in6) /\ (ge24 <=> ge23 \/ ge16 /\ ge7) /\ (out0 <=> ge6 /\ in4 /\ ~in1 /\ in0 \/ ge18 /\ ge0 /\ ~in5 \/ ge12 /\ ~ge10 \/ ge24) /\ (out1 <=> ge26 \/ ge25 \/ ~ge5 /\ ge4 /\ ge3 \/ ge7 /\ ~ge1 /\ in1) /\ (out2 <=> ge33 \/ ge32) /\ (wres8 <=> ~in3 /\ ~in1) /\ (wres0 <=> in6 /\ in1 \/ ~in6 /\ ~in1) /\ (wres2 <=> ~in4 /\ in1) /\ (wres3 <=> ~in4 \/ ~in2) /\ (wres1 <=> in3 \/ ~in0) /\ (wres4 <=> in3 /\ ~in0) /\ (wres5 <=> in6 \/ in5) /\ (wres11 <=> wres8 /\ in4) /\ (wres9 <=> ~wres0 \/ in2 \/ ~in5) /\ (wres10 <=> ~in6 \/ in5) /\ (wres6 <=> ~in5 \/ in6) /\ (wres7 <=> ~in6 \/ ~in5) /\ (wres12 <=> wres2 /\ ~in3) /\ (wres13 <=> wres8 /\ ~wres3 /\ ~in0) /\ (wres14 <=> ~wres1 /\ ~in4) /\ (wres15 <=> wres2 /\ in2) /\ (wres17 <=> ~wres3 /\ ~in1) /\ (wres18 <=> wres4 /\ in2) /\ (wres19 <=> wres11 /\ ~wres5) /\ (wres20 <=> ~in5 /\ in2 \/ ~wres5 /\ in4 \/ ~wres9) /\ (wres21 <=> ~wres10 /\ ~in1 \/ ~in5 /\ ~in2) /\ (wres16 <=> wres2 /\ in0) ==> (out2 <=> wres11 /\ in5 /\ ~in0 \/ ~wres7 /\ wres4 /\ ~wres3 \/ wres12 /\ wres5 \/ wres13 \/ wres14 /\ in2 \/ wres14 /\ in6 \/ wres15 /\ ~wres6 \/ wres15 /\ ~in6 /\ ~in0 \/ wres17 /\ ~wres7 /\ in3 \/ wres18 /\ ~wres6 /\ ~in4 \/ wres20 /\ ~wres1 \/ wres21 /\ wres4 /\ ~in4 \/ wres19) /\ (out1 <=> ~wres5 /\ wres4 /\ wres3 \/ wres7 /\ ~wres1 /\ in1 \/ wres2 /\ ~in6 \/ wres10 /\ wres4 /\ in1 \/ wres12 /\ in5 /\ ~in2 \/ wres13 /\ ~wres5 \/ wres14 /\ ~wres6 \/ wres15 /\ wres1 \/ wres16 /\ ~in5 \/ wres17 /\ ~wres6 /\ in0) /\ (out0 <=> wres6 /\ in4 /\ ~in1 /\ in0 \/ wres9 /\ ~wres1 \/ wres12 /\ ~wres10 \/ wres16 /\ wres7 \/ wres18 /\ wres0 /\ ~in5 \/ wres19)` ;; let add2_be = `(n3 <=> a_0_) /\ (n4 <=> a_3_) /\ (n5 <=> a_1_) /\ (n6 <=> a_2_) /\ (n7 <=> anda) /\ (n8 <=> exora) /\ (n9 <=> b_3_) /\ (n10 <=> b_1_) /\ (n11 <=> b_0_) /\ (n12 <=> b_2_) /\ (n13 <=> andb) /\ (n14 <=> exorb) /\ (n15 <=> carryin) /\ (n42 <=> ~n13) /\ (n48 <=> ~n14) /\ (n41 <=> ~n7) /\ (n47 <=> ~n8) /\ (n46 <=> ~n15) /\ (n49 <=> ~n46) /\ (n86 <=> ~n9 \/ ~n42) /\ (n94 <=> ~n48) /\ (n85 <=> ~n4 \/ ~n41) /\ (n93 <=> ~n47) /\ (n60 <=> ~n10 \/ ~n42) /\ (n68 <=> ~n48) /\ (n59 <=> ~n5 \/ ~n41) /\ (n67 <=> ~n47) /\ (n54 <=> ~n11 \/ ~n42) /\ (n44 <=> ~n48) /\ (n53 <=> ~n3 \/ ~n41) /\ (n43 <=> ~n47) /\ (n80 <=> ~n12 \/ ~n42) /\ (n72 <=> ~n48) /\ (n79 <=> ~n6 \/ ~n41) /\ (n71 <=> ~n47) /\ (n35 <=> ~n86) /\ (n37 <=> ~n85) /\ (n27 <=> ~n60) /\ (n29 <=> ~n59) /\ (n25 <=> ~n54) /\ (n23 <=> ~n53) /\ (n33 <=> ~n80) /\ (n31 <=> ~n79) /\ (n89 <=> n35 /\ n48 \/ ~n35 /\ ~n48) /\ (n88 <=> n37 /\ n47 \/ ~n37 /\ ~n47) /\ (n63 <=> n27 /\ n48 \/ ~n27 /\ ~n48) /\ (n62 <=> n29 /\ n47 \/ ~n29 /\ ~n47) /\ (n52 <=> n25 /\ n48 \/ ~n25 /\ ~n48) /\ (n51 <=> n23 /\ n47 \/ ~n23 /\ ~n47) /\ (n78 <=> n33 /\ n48 \/ ~n33 /\ ~n48) /\ (n77 <=> n31 /\ n47 \/ ~n31 /\ ~n47) /\ (n36 <=> ~n89) /\ (n38 <=> ~n88) /\ (n28 <=> ~n63) /\ (n30 <=> ~n62) /\ (n26 <=> ~n52) /\ (n24 <=> ~n51) /\ (n34 <=> ~n78) /\ (n32 <=> ~n77) /\ (n92 <=> ~n38) /\ (n66 <=> ~n30) /\ (n40 <=> ~n24) /\ (n70 <=> ~n32) /\ (n91 <=> n36 /\ n38 \/ ~n36 /\ ~n38) /\ (n65 <=> n28 /\ n30 \/ ~n28 /\ ~n30) /\ (n45 <=> n26 /\ n24 \/ ~n26 /\ ~n24) /\ (n73 <=> n34 /\ n32 \/ ~n34 /\ ~n32) /\ (n83 <=> ~n91) /\ (n57 <=> ~n65) /\ (n39 <=> ~n45) /\ (n69 <=> ~n73) /\ (n90 <=> ~n83) /\ (n64 <=> ~n57) /\ (n55 <=> ~n39) /\ (n81 <=> ~n69) /\ (n50 <=> n49 /\ ~n39 \/ ~n49 /\ n39) /\ (n56 <=> ~n39 /\ ~n24 \/ ~n55 /\ ~n46) /\ (n58 <=> ~n56) /\ (n17 <=> ~n50) /\ (n74 <=> ~n64 /\ ~n56 \/ ~n66 /\ ~n57) /\ (n61 <=> n58 /\ n57 \/ ~n58 /\ ~n57) /\ (n82 <=> ~n69 /\ ~n32 \/ ~n81 /\ ~n74) /\ (n75 <=> ~n74) /\ (n95 <=> ~n82) /\ (n96 <=> ~n90 /\ ~n82 \/ ~n92 /\ ~n83) /\ (n16 <=> ~n61) /\ (n84 <=> ~n82) /\ (n76 <=> n75 /\ ~n69 \/ ~n75 /\ n69) /\ (n97 <=> n96 /\ n82 \/ ~n96 /\ ~n82) /\ (n19 <=> ~n96) /\ (n87 <=> n84 /\ n83 \/ ~n84 /\ ~n83) /\ (n18 <=> ~n76) /\ (n20 <=> ~n97) /\ (n22 <=> ~n87) /\ (n21 <=> ~n22) /\ (sign <=> n21) /\ (overflow <=> n20) /\ (carryout <=> n19) /\ (o_3_ <=> n22) /\ (o_2_ <=> n18) /\ (o_1_ <=> n16) /\ (o_0_ <=> n17) /\ (buf1 <=> ~anda) /\ (buf2 <=> ~andb) /\ (buf3 <=> ~exora) /\ (buf4 <=> ~exorb) /\ (buf5 <=> ~carryin) /\ (n1_0_ <=> buf1 /\ a_0_) /\ (n1_1_ <=> buf1 /\ a_1_) /\ (n1_2_ <=> buf1 /\ a_2_) /\ (n1_3_ <=> buf1 /\ a_3_) /\ (n3_0_ <=> buf2 /\ b_0_) /\ (n3_1_ <=> buf2 /\ b_1_) /\ (n3_2_ <=> buf2 /\ b_2_) /\ (n3_3_ <=> buf2 /\ b_3_) /\ (n2_0_ <=> buf3 /\ ~n1_0_ \/ ~buf3 /\ n1_0_) /\ (n2_1_ <=> buf3 /\ ~n1_1_ \/ ~buf3 /\ n1_1_) /\ (n2_2_ <=> buf3 /\ ~n1_2_ \/ ~buf3 /\ n1_2_) /\ (n2_3_ <=> buf3 /\ ~n1_3_ \/ ~buf3 /\ n1_3_) /\ (n4_0_ <=> buf4 /\ ~n3_0_ \/ ~buf4 /\ n3_0_) /\ (n4_1_ <=> buf4 /\ ~n3_1_ \/ ~buf4 /\ n3_1_) /\ (n4_2_ <=> buf4 /\ ~n3_2_ \/ ~buf4 /\ n3_2_) /\ (n4_3_ <=> buf4 /\ ~n3_3_ \/ ~buf4 /\ n3_3_) /\ (cout1 <=> buf5 /\ n4_0_ \/ buf5 /\ n2_0_ \/ n4_0_ /\ n2_0_) /\ (cout2 <=> cout1 /\ n4_1_ \/ cout1 /\ n2_1_ \/ n4_1_ /\ n2_1_) /\ (cout3 <=> cout2 /\ n4_2_ \/ cout2 /\ n2_2_ \/ n4_2_ /\ n2_2_) /\ (hulp0 <=> ~(n2_0_ <=> ~(n4_0_ <=> buf5))) /\ (hulp1 <=> ~(n2_1_ <=> ~(n4_1_ <=> cout1))) /\ (hulp2 <=> ~(n2_2_ <=> ~(n4_2_ <=> cout2))) /\ (hulp3 <=> ~(n2_3_ <=> ~(n4_3_ <=> cout3))) /\ (hulp4 <=> cout3 /\ n4_3_ \/ cout3 /\ n2_3_ \/ n4_3_ /\ n2_3_) ==> (o_0_ <=> hulp0) /\ (o_1_ <=> hulp1) /\ (o_2_ <=> hulp2) /\ (o_3_ <=> hulp3) /\ (carryout <=> ~hulp4) /\ (overflow <=> (cout3 <=> hulp4)) /\ (sign <=> ~hulp3)` ;; let dc2_be = `(ge0 <=> ~in4 /\ ~in0) /\ (ge10 <=> ge0 /\ in5 /\ ~in2) /\ (ge2 <=> ~in6 /\ ~in5 /\ in4 /\ ~in0) /\ (ge4 <=> ge0 /\ in5 /\ in2) /\ (ge22 <=> ge0 /\ ~in5) /\ (ge23 <=> ge10 /\ ~in6) /\ (ge6 <=> ge0 /\ ~in3) /\ (ge21 <=> ge4 /\ in3 \/ ge2 /\ in3 /\ in2) /\ (ge44 <=> ge22 /\ in6 \/ ge23) /\ (ge11 <=> ge6 /\ ~in5) /\ (ge1 <=> ~in4 /\ ~in2 /\ ~in1) /\ (ge8 <=> ge21 \/ ge44) /\ (ge24 <=> ge11 /\ in1) /\ (ge3 <=> ~in6 /\ ~in5 /\ ~in1) /\ (ge18 <=> ge0 /\ in2) /\ (ge19 <=> ge11 /\ in2) /\ (ge20 <=> ge1 /\ in3) /\ (ge45 <=> ge1 /\ ~in5 \/ ge4) /\ (ge16 <=> ~in2 /\ in1) /\ (ge33 <=> ge8 /\ in1 \/ ge24) /\ (ge5 <=> ge2 \/ in3 /\ ~in0) /\ (ge29 <=> ge19 \/ ge18 /\ ge3) /\ (ge14 <=> ge3 /\ in3) /\ (ge41 <=> ge6 /\ in6 \/ ge20 /\ ~in6) /\ (ge7 <=> in6 /\ in3) /\ (ge25 <=> ge22 /\ ~in2 \/ ge45) /\ (ge13 <=> ~in6 /\ ~in5 /\ ~in0) /\ (ge12 <=> ~in3 /\ ~in1) /\ (ge34 <=> ge33 \/ ge16 /\ ge6) /\ (ge15 <=> ~in2 /\ in0) /\ (ge30 <=> ge29 \/ ge16 /\ ge5) /\ (ge42 <=> ge41 \/ ge14 /\ ~in2) /\ (ge17 <=> ge1 /\ in5) /\ (ge37 <=> ge25 /\ ge7 \/ ge19) /\ (ge38 <=> ge23 \/ ge13 /\ in2) /\ (ge35 <=> ge34 \/ ge12 /\ ge4) /\ (ge31 <=> ge30 \/ ge15 /\ ge12) /\ (ge27 <=> ge24 \/ ge21 /\ ~in1) /\ (ge43 <=> ge0 /\ ~in6 /\ in3 \/ ge13 /\ in3 \/ ge42) /\ (ge39 <=> ge37 \/ ge17 /\ ~in3) /\ (ge40 <=> ge38 \/ ge17 /\ ~in6) /\ (ge9 <=> ~in6 \/ ~in5) /\ (ge36 <=> ge35 \/ ge12 /\ ge2) /\ (ge32 <=> ge31 \/ ge10 /\ ge7) /\ (ge28 <=> ge27 \/ ge16 /\ ~in0) /\ (ge26 <=> ge4 /\ in1 \/ ge15 /\ ~in1) /\ (out0 <=> ge5 /\ in2 /\ in1 \/ ge26) /\ (out1 <=> ge15 /\ ge14 /\ in4 \/ ge17 /\ ge7 /\ in0 \/ ge18 /\ ge7 /\ ~in1 \/ ge28) /\ (out2 <=> ge12 /\ in2 /\ ~in0 \/ ge9 /\ ge1 /\ in0 \/ ge2 /\ in3 /\ ~in2 \/ ge32) /\ (out3 <=> ge3 /\ in4 /\ ~in3 /\ ~in2 \/ ge14 /\ ge0 \/ ge20 /\ ge9 \/ ge36) /\ (out4 <=> ge6 /\ in5 /\ ~in2 \/ ge40 \/ ge39) /\ (out5 <=> ge43 \/ ge1 /\ in6 /\ ~in3) /\ (out6 <=> in7) /\ (wres0 <=> ~in4 /\ ~in0) /\ (wres6 <=> wres0 /\ ~in3) /\ (wres2 <=> ~in6 /\ ~in5 /\ in4 /\ ~in0) /\ (wres4 <=> wres0 /\ in5 /\ in2) /\ (wres10 <=> wres0 /\ in5 /\ ~in2) /\ (wres3 <=> ~in6 /\ ~in5 /\ ~in1) /\ (wres1 <=> ~in4 /\ ~in2 /\ ~in1) /\ (wres11 <=> wres6 /\ ~in5) /\ (wres22 <=> wres0 /\ ~in5) /\ (wres21 <=> wres4 /\ in3 \/ wres2 /\ in3 /\ in2) /\ (wres23 <=> wres10 /\ ~in6) /\ (wres13 <=> ~in6 /\ ~in5 /\ ~in0) /\ (wres14 <=> wres3 /\ in3) /\ (wres20 <=> wres1 /\ in3) /\ (wres7 <=> in6 /\ in3) /\ (wres17 <=> wres1 /\ in5) /\ (wres19 <=> wres11 /\ in2) /\ (wres25 <=> wres22 /\ ~in2 \/ wres1 /\ ~in5 \/ wres4) /\ (wres8 <=> wres21 \/ wres22 /\ in6 \/ wres23) /\ (wres9 <=> ~in6 \/ ~in5) /\ (wres12 <=> ~in3 /\ ~in1) /\ (wres16 <=> ~in2 /\ in1) /\ (wres24 <=> wres11 /\ in1) /\ (wres5 <=> wres2 \/ in3 /\ ~in0) /\ (wres15 <=> ~in2 /\ in0) /\ (wres18 <=> wres0 /\ in2) ==> (out6:bool <=> in7) /\ (out5 <=> wres1 /\ in6 /\ ~in3 \/ wres0 /\ ~in6 /\ in3 \/ wres6 /\ in6 \/ wres13 /\ in3 \/ wres14 /\ ~in2 \/ wres20 /\ ~in6) /\ (out4 <=> wres13 /\ in2 \/ wres17 /\ ~in6 \/ wres17 /\ ~in3 \/ wres6 /\ in5 /\ ~in2 \/ wres23 \/ wres25 /\ wres7 \/ wres19) /\ (out3 <=> wres14 /\ wres0 \/ wres16 /\ wres6 \/ wres20 /\ wres9 \/ wres12 /\ wres2 \/ wres12 /\ wres4 \/ wres3 /\ in4 /\ ~in3 /\ ~in2 \/ wres8 /\ in1 \/ wres24) /\ (out2 <=> wres10 /\ wres7 \/ wres9 /\ wres1 /\ in0 \/ wres12 /\ in2 /\ ~in0 \/ wres2 /\ in3 /\ ~in2 \/ wres15 /\ wres12 \/ wres16 /\ wres5 \/ wres18 /\ wres3 \/ wres19) /\ (out1 <=> wres15 /\ wres14 /\ in4 \/ wres16 /\ ~in0 \/ wres17 /\ wres7 /\ in0 \/ wres18 /\ wres7 /\ ~in1 \/ wres21 /\ ~in1 \/ wres24) /\ (out0 <=> wres4 /\ in1 \/ wres5 /\ in2 /\ in1 \/ wres15 /\ ~in1)`;; let f51m_be = `(ge10 <=> in6 \/ ~in7) /\ (ge5 <=> ~in5 /\ ~in4 /\ in2) /\ (ge11 <=> ~in3 /\ in2) /\ (ge21 <=> ~ge10 /\ in5) /\ (ge23 <=> ge5 /\ ~in3) /\ (ge7 <=> in7 /\ in6) /\ (ge20 <=> ~in7 /\ ~in4) /\ (ge35 <=> ge21 /\ ge11 \/ ge23) /\ (ge8 <=> ~in6 /\ ~in5) /\ (ge12 <=> ~in4 /\ ~in2) /\ (ge19 <=> ge7 /\ in3) /\ (ge36 <=> ge35 \/ ge20 /\ ge11) /\ (ge44 <=> in4 \/ in7 /\ in6) /\ (ge1 <=> in7 /\ in6 \/ in3) /\ (ge18 <=> ge8 /\ ~in2) /\ (ge37 <=> ge36 \/ ge19 /\ ge12) /\ (ge43 <=> ~in3 \/ ~in6 /\ ~in5) /\ (ge3 <=> in5 \/ in1 \/ ge44) /\ (ge14 <=> ~ge1 /\ ~in4) /\ (ge38 <=> ge37 \/ ge18 /\ in4) /\ (ge9 <=> in4 \/ in5) /\ (ge17 <=> in2 /\ in1) /\ (ge0 <=> ~in7 /\ ~in6 \/ ~in5) /\ (ge2 <=> ~in4 \/ ge43) /\ (ge26 <=> ge14 \/ ~ge3) /\ (ge22 <=> ~in7 /\ ~in6) /\ (ge39 <=> ge38 \/ ge5 /\ ~in6) /\ (ge47 <=> ge14 \/ ge7 /\ ge5) /\ (ge29 <=> ge12 \/ ge18) /\ (ge48 <=> ~ge3 \/ ge17 /\ ge9) /\ (ge6 <=> ~ge0 /\ in4 \/ in3) /\ (ge16 <=> ~in2 /\ in1) /\ (ge45 <=> ~ge2 /\ ~in2 \/ ge26 /\ in2) /\ (ge33 <=> ge8 \/ ge7 \/ ge22) /\ (ge49 <=> ge8 \/ ~ge0 /\ in4) /\ (ge50 <=> ge22 /\ ~in3 \/ ge19) /\ (ge40 <=> ge39 \/ ge5 /\ ~in7) /\ (ge4 <=> in7 /\ in6 /\ in5 \/ in4) /\ (ge15 <=> ge11 /\ ~in1) /\ (ge28 <=> ~ge2 \/ ge47) /\ (ge30 <=> ge29 /\ ~in1 \/ ge48) /\ (ge24 <=> ~ge6 \/ ge2 /\ ~in1) /\ (ge46 <=> ge16 /\ ge6 \/ ge45) /\ (ge42 <=> ge21 /\ ~in4 \/ ge33 /\ in4) /\ (ge13 <=> in4 /\ ~in3) /\ (ge31 <=> ~ge9 /\ ~in7 \/ ge49) /\ (ge32 <=> ge50 \/ ge14) /\ (ge41 <=> ge40 \/ ~ge2 /\ in2) /\ (ge34 <=> ge16 /\ ~ge6 \/ ge28 /\ in1 \/ ge15 /\ ge4 \/ ge30 /\ in3) /\ (ge25 <=> ge3 /\ in3 /\ in2 \/ ge17 /\ ge4 \/ ge24 /\ ~in2) /\ (ge27 <=> ge15 \/ ge23 \/ ge46) /\ (out0 <=> ge25 /\ in0 \/ ge27 /\ ~in0) /\ (out1 <=> ge34 \/ ge13 /\ ~ge0 /\ ~in1) /\ (out2 <=> in6 /\ in5 /\ in4 /\ in2 \/ ge12 /\ ge1 /\ in5 \/ ge13 /\ ge0 /\ ~in2 \/ ge41) /\ (out3 <=> ge13 /\ in6 /\ ~in5 \/ ge7 /\ ~in5 /\ ~in3 \/ ge31 /\ in3 \/ ge32 /\ in5) /\ (out4 <=> ge20 /\ in6 \/ ge42) /\ (out5 <=> ge8 /\ in7 \/ ge10 /\ in5) /\ (out6 <=> ~in7 /\ in6 \/ ~ge10) /\ (out7 <=> ~in7) /\ (wres8 <=> ~in6 /\ ~in5) /\ (wres0 <=> ~in7 /\ ~in6 \/ ~in5) /\ (wres1 <=> in7 /\ in6 \/ in3) /\ (wres7 <=> in7 /\ in6) /\ (wres12 <=> ~in4 /\ ~in2) /\ (wres18 <=> wres8 /\ ~in2) /\ (wres2 <=> ~in6 /\ ~in5 \/ ~in4 \/ ~in3) /\ (wres6 <=> ~wres0 /\ in4 \/ in3) /\ (wres11 <=> ~in3 /\ in2) /\ (wres5 <=> ~in5 /\ ~in4 /\ in2) /\ (wres3 <=> in5 \/ in4 \/ in1 \/ in7 /\ in6) /\ (wres14 <=> ~wres1 /\ ~in4) /\ (wres10 <=> in6 \/ ~in7) /\ (wres22 <=> ~in7 /\ ~in6) /\ (wres9 <=> in5 \/ in4) /\ (wres19 <=> wres7 /\ in3) /\ (wres17 <=> in2 /\ in1) /\ (wres29 <=> wres12 \/ wres18) /\ (wres4 <=> in7 /\ in6 /\ in5 \/ in4) /\ (wres24 <=> ~wres6 \/ wres2 /\ ~in1) /\ (wres15 <=> wres11 /\ ~in1) /\ (wres16 <=> ~in2 /\ in1) /\ (wres23 <=> wres5 /\ ~in3) /\ (wres26 <=> wres14 \/ ~wres3) /\ (wres20 <=> ~in7 /\ ~in4) /\ (wres21 <=> ~wres10 /\ in5) /\ (wres33 <=> wres8 \/ wres7 \/ wres22) /\ (wres13 <=> in4 /\ ~in3) /\ (wres31 <=> ~wres9 /\ ~in7 \/ wres8 \/ ~wres0 /\ in4) /\ (wres32 <=> wres14 \/ wres22 /\ ~in3 \/ wres19) /\ (wres28 <=> wres7 /\ wres5 \/ ~wres2 \/ wres14) /\ (wres30 <=> ~wres3 \/ wres29 /\ ~in1 \/ wres17 /\ wres9) /\ (wres25 <=> wres17 /\ wres4 \/ wres3 /\ in3 /\ in2 \/ wres24 /\ ~in2) /\ (wres27 <=> wres15 \/ wres16 /\ wres6 \/ wres26 /\ in2 \/ ~wres2 /\ ~in2 \/ wres23) ==> (out7 <=> ~in7) /\ (out6 <=> ~in7 /\ in6 \/ ~wres10) /\ (out5 <=> wres8 /\ in7 \/ wres10 /\ in5) /\ (out4 <=> wres21 /\ ~in4 \/ wres20 /\ in6 \/ wres33 /\ in4) /\ (out3 <=> wres13 /\ in6 /\ ~in5 \/ wres7 /\ ~in5 /\ ~in3 \/ wres31 /\ in3 \/ wres32 /\ in5) /\ (out2 <=> in6 /\ in5 /\ in4 /\ in2 \/ wres5 /\ ~in6 \/ ~wres2 /\ in2 \/ wres12 /\ wres1 /\ in5 \/ wres5 /\ ~in7 \/ wres13 /\ wres0 /\ ~in2 \/ wres18 /\ in4 \/ wres19 /\ wres12 \/ wres20 /\ wres11 \/ wres21 /\ wres11 \/ wres23) /\ (out1 <=> wres16 /\ ~wres6 \/ wres13 /\ ~wres0 /\ ~in1 \/ wres28 /\ in1 \/ wres15 /\ wres4 \/ wres30 /\ in3) /\ (out0 <=> wres25 /\ in0 \/ wres27 /\ ~in0)` ;; let aim_100_1_6_no_3 = `~ ((v5 \/ v31 \/ v91) /\ (v31 \/ v38 \/ v40) /\ (~v38 \/ v40 \/ ~v91) /\ (v31 \/ ~v40 \/ ~v91) /\ (v30 \/ ~v31 \/ v39) /\ (~v30 \/ v39 \/ v88) /\ (~v31 \/ v39 \/ ~v88) /\ (~v39 \/ v69 \/ v82) /\ (~v39 \/ v69 \/ ~v82) /\ (v10 \/ v60 \/ v94) /\ (~v10 \/ v24 \/ v74) /\ (~v10 \/ v60 \/ ~v74) /\ (v20 \/ v26 \/ ~v60) /\ (~v20 \/ v52 \/ v87) /\ (v52 \/ ~v60 \/ ~v87) /\ (v26 \/ ~v52 \/ v94) /\ (~v26 \/ v45 \/ v57) /\ (~v26 \/ ~v45 \/ v57) /\ (~v26 \/ ~v57 \/ v100) /\ (v24 \/ ~v60 \/ ~v100) /\ (v11 \/ ~v24 \/ v38) /\ (v5 \/ v11 \/ ~v38) /\ (v5 \/ ~v11 \/ ~v24) /\ (v4 \/ v42 \/ ~v69) /\ (v4 \/ ~v42 \/ v100) /\ (~v42 \/ ~v69 \/ ~v100) /\ (v71 \/ v83 \/ ~v94) /\ (~v4 \/ ~v71 \/ v83) /\ (~v4 \/ ~v83 \/ ~v94) /\ (~v5 \/ v59 \/ v73) /\ (~v5 \/ v59 \/ ~v73) /\ (v13 \/ ~v59 \/ v78) /\ (v15 \/ v77 \/ v92) /\ (v53 \/ ~v77 \/ v92) /\ (v28 \/ ~v53 \/ v98) /\ (~v28 \/ ~v53 \/ v98) /\ (v22 \/ v89 \/ ~v98) /\ (v22 \/ ~v53 \/ ~v89) /\ (v12 \/ ~v22 \/ v58) /\ (v12 \/ ~v58 \/ ~v98) /\ (~v12 \/ ~v22 \/ ~v53) /\ (v15 \/ v18 \/ v36) /\ (v21 \/ ~v36 \/ ~v92) /\ (v18 \/ ~v21 \/ ~v36) /\ (~v18 \/ ~v92 \/ v96) /\ (~v18 \/ ~v78 \/ ~v96) /\ (v13 \/ ~v15 \/ ~v78) /\ (v1 \/ v8 \/ v42) /\ (v56 \/ v61 \/ v91) /\ (v2 \/ ~v56 \/ v61) /\ (v2 \/ v8 \/ v61) /\ (~v2 \/ ~v42 \/ v61) /\ (v1 \/ ~v42 \/ ~v61) /\ (~v8 \/ ~v13 \/ v64) /\ (v32 \/ ~v64 \/ v88) /\ (~v8 \/ ~v32 \/ ~v64) /\ (~v8 \/ v28 \/ ~v88) /\ (~v28 \/ ~v64 \/ ~v88) /\ (~v1 \/ ~v13 \/ ~v59) /\ (~v35 \/ ~v40 \/ v65) /\ (~v40 \/ ~v65 \/ v77) /\ (~v35 \/ ~v77 \/ ~v83) /\ (v33 \/ v62 \/ v78) /\ (v47 \/ v53 \/ ~v65) /\ (v30 \/ v37 \/ v58) /\ (~v37 \/ v58 \/ v71) /\ (~v12 \/ ~v37 \/ v71) /\ (v20 \/ v30 \/ v51) /\ (v20 \/ ~v51 \/ ~v71) /\ (~v32 \/ ~v61 \/ v89) /\ (v27 \/ ~v63 \/ v65) /\ (~v22 \/ ~v48 \/ v50) /\ (~v89 \/ ~v97 \/ v98) /\ (v49 \/ ~v50 \/ ~v82) /\ (~v16 \/ ~v46 \/ v95) /\ (~v16 \/ ~v46 \/ ~v95) /\ (~v17 \/ ~v37 \/ ~v76) /\ (v51 \/ ~v93 \/ ~v99) /\ (v27 \/ v76 \/ v79) /\ (~v52 \/ v76 \/ v79) /\ (~v1 \/ ~v25 \/ v68) /\ (v34 \/ ~v58 \/ ~v75) /\ (~v15 \/ ~v20 \/ ~v90) /\ (v33 \/ v64 \/ v85) /\ (~v11 \/ v64 \/ ~v85) /\ (~v18 \/ ~v33 \/ ~v48) /\ (v54 \/ ~v63 \/ v75) /\ (v3 \/ ~v49 \/ ~v95) /\ (~v3 \/ v74 \/ ~v95) /\ (~v33 \/ v44 \/ ~v54) /\ (~v44 \/ ~v50 \/ ~v54) /\ (~v2 \/ v82 \/ v96) /\ (v16 \/ v49 \/ v82) /\ (~v19 \/ ~v41 \/ ~v44) /\ (v46 \/ ~v49 \/ v81) /\ (~v3 \/ ~v23 \/ v25) /\ (v29 \/ v34 \/ v63) /\ (~v25 \/ ~v34 \/ ~v75) /\ (~v23 \/ v44 \/ ~v70) /\ (~v29 \/ ~v38 \/ ~v82) /\ (~v7 \/ ~v49 \/ ~v77) /\ (v6 \/ v44 \/ v81) /\ (v17 \/ ~v19 \/ ~v86) /\ (~v29 \/ ~v73 \/ v93) /\ (v11 \/ ~v52 \/ ~v85) /\ (~v44 \/ v46 \/ v64) /\ (~v17 \/ ~v34 \/ v95) /\ (v17 \/ v47 \/ ~v57) /\ (~v81 \/ ~v96 \/ v97) /\ (v3 \/ ~v34 \/ v99) /\ (v43 \/ ~v56 \/ ~v76) /\ (~v27 \/ v72 \/ ~v79) /\ (~v6 \/ ~v27 \/ v70) /\ (v55 \/ v67 \/ v73) /\ (v16 \/ ~v74 \/ ~v84) /\ (~v43 \/ v90 \/ v97) /\ (v50 \/ v56 \/ ~v93) /\ (~v47 \/ ~v70 \/ ~v90) /\ (v14 \/ v16 \/ ~v79) /\ (v45 \/ ~v66 \/ v80) /\ (v66 \/ ~v66 \/ ~v68) /\ (v10 \/ ~v80 \/ v87) /\ (~v55 \/ ~v81 \/ v93) /\ (v37 \/ ~v45 \/ v72) /\ (v19 \/ v68 \/ ~v97) /\ (~v9 \/ ~v70 \/ ~v93) /\ (v7 \/ v35 \/ v54) /\ (~v41 \/ ~v41 \/ ~v55) /\ (v14 \/ ~v14 \/ v70) /\ (v23 \/ ~v23 \/ ~v62) /\ (v23 \/ ~v67 \/ ~v80) /\ (v10 \/ v36 \/ ~v51) /\ (v21 \/ ~v68 \/ v85) /\ (~v6 \/ v43 \/ ~v55) /\ (v32 \/ v48 \/ v86) /\ (v21 \/ ~v41 \/ v99) /\ (v14 \/ v81 \/ v97) /\ (~v9 \/ ~v43 \/ ~v72) /\ (v7 \/ ~v9 \/ ~v79) /\ (~v41 \/ v84 \/ ~v90) /\ (v25 \/ ~v72 \/ v86) /\ (~v9 \/ ~v46 \/ v63) /\ (v6 \/ ~v14 \/ v38) /\ (v7 \/ ~v21 \/ v35) /\ (v9 \/ ~v87 \/ v99) /\ (~v20 \/ ~v58 \/ v80) /\ (~v3 \/ v75 \/ ~v86) /\ (v19 \/ ~v62 \/ v84) /\ (~v14 \/ ~v67 \/ v82) /\ (~v27 \/ v48 \/ ~v68) /\ (~v25 \/ v45 \/ ~v84) /\ (~v7 \/ v41 \/ v67) /\ (~v30 \/ ~v47 \/ v48) /\ (v66 \/ v97 \/ ~v99) /\ (v9 \/ v41 \/ v55) /\ (~v29 \/ v36 \/ ~v86) /\ (v50 \/ v62 \/ ~v81) /\ (v29 \/ ~v86 \/ v90) /\ (~v48 \/ v54 \/ ~v55) /\ (v19 \/ ~v34 \/ v89))` ;; let dubois20 = `~ ((v39 \/ v40 \/ v1) /\ (~v39 \/ ~v40 \/ v1) /\ (v39 \/ ~v40 \/ ~v1) /\ (~v39 \/ v40 \/ ~v1) /\ (v1 \/ v41 \/ v2) /\ (~v1 \/ ~v41 \/ v2) /\ (v1 \/ ~v41 \/ ~v2) /\ (~v1 \/ v41 \/ ~v2) /\ (v2 \/ v42 \/ v3) /\ (~v2 \/ ~v42 \/ v3) /\ (v2 \/ ~v42 \/ ~v3) /\ (~v2 \/ v42 \/ ~v3) /\ (v3 \/ v43 \/ v4) /\ (~v3 \/ ~v43 \/ v4) /\ (v3 \/ ~v43 \/ ~v4) /\ (~v3 \/ v43 \/ ~v4) /\ (v4 \/ v44 \/ v5) /\ (~v4 \/ ~v44 \/ v5) /\ (v4 \/ ~v44 \/ ~v5) /\ (~v4 \/ v44 \/ ~v5) /\ (v5 \/ v45 \/ v6) /\ (~v5 \/ ~v45 \/ v6) /\ (v5 \/ ~v45 \/ ~v6) /\ (~v5 \/ v45 \/ ~v6) /\ (v6 \/ v46 \/ v7) /\ (~v6 \/ ~v46 \/ v7) /\ (v6 \/ ~v46 \/ ~v7) /\ (~v6 \/ v46 \/ ~v7) /\ (v7 \/ v47 \/ v8) /\ (~v7 \/ ~v47 \/ v8) /\ (v7 \/ ~v47 \/ ~v8) /\ (~v7 \/ v47 \/ ~v8) /\ (v8 \/ v48 \/ v9) /\ (~v8 \/ ~v48 \/ v9) /\ (v8 \/ ~v48 \/ ~v9) /\ (~v8 \/ v48 \/ ~v9) /\ (v9 \/ v49 \/ v10) /\ (~v9 \/ ~v49 \/ v10) /\ (v9 \/ ~v49 \/ ~v10) /\ (~v9 \/ v49 \/ ~v10) /\ (v10 \/ v50 \/ v11) /\ (~v10 \/ ~v50 \/ v11) /\ (v10 \/ ~v50 \/ ~v11) /\ (~v10 \/ v50 \/ ~v11) /\ (v11 \/ v51 \/ v12) /\ (~v11 \/ ~v51 \/ v12) /\ (v11 \/ ~v51 \/ ~v12) /\ (~v11 \/ v51 \/ ~v12) /\ (v12 \/ v52 \/ v13) /\ (~v12 \/ ~v52 \/ v13) /\ (v12 \/ ~v52 \/ ~v13) /\ (~v12 \/ v52 \/ ~v13) /\ (v13 \/ v53 \/ v14) /\ (~v13 \/ ~v53 \/ v14) /\ (v13 \/ ~v53 \/ ~v14) /\ (~v13 \/ v53 \/ ~v14) /\ (v14 \/ v54 \/ v15) /\ (~v14 \/ ~v54 \/ v15) /\ (v14 \/ ~v54 \/ ~v15) /\ (~v14 \/ v54 \/ ~v15) /\ (v15 \/ v55 \/ v16) /\ (~v15 \/ ~v55 \/ v16) /\ (v15 \/ ~v55 \/ ~v16) /\ (~v15 \/ v55 \/ ~v16) /\ (v16 \/ v56 \/ v17) /\ (~v16 \/ ~v56 \/ v17) /\ (v16 \/ ~v56 \/ ~v17) /\ (~v16 \/ v56 \/ ~v17) /\ (v17 \/ v57 \/ v18) /\ (~v17 \/ ~v57 \/ v18) /\ (v17 \/ ~v57 \/ ~v18) /\ (~v17 \/ v57 \/ ~v18) /\ (v18 \/ v58 \/ v19) /\ (~v18 \/ ~v58 \/ v19) /\ (v18 \/ ~v58 \/ ~v19) /\ (~v18 \/ v58 \/ ~v19) /\ (v19 \/ v59 \/ v60) /\ (~v19 \/ ~v59 \/ v60) /\ (v19 \/ ~v59 \/ ~v60) /\ (~v19 \/ v59 \/ ~v60) /\ (v20 \/ v59 \/ v60) /\ (~v20 \/ ~v59 \/ v60) /\ (v20 \/ ~v59 \/ ~v60) /\ (~v20 \/ v59 \/ ~v60) /\ (v21 \/ v58 \/ v20) /\ (~v21 \/ ~v58 \/ v20) /\ (v21 \/ ~v58 \/ ~v20) /\ (~v21 \/ v58 \/ ~v20) /\ (v22 \/ v57 \/ v21) /\ (~v22 \/ ~v57 \/ v21) /\ (v22 \/ ~v57 \/ ~v21) /\ (~v22 \/ v57 \/ ~v21) /\ (v23 \/ v56 \/ v22) /\ (~v23 \/ ~v56 \/ v22) /\ (v23 \/ ~v56 \/ ~v22) /\ (~v23 \/ v56 \/ ~v22) /\ (v24 \/ v55 \/ v23) /\ (~v24 \/ ~v55 \/ v23) /\ (v24 \/ ~v55 \/ ~v23) /\ (~v24 \/ v55 \/ ~v23) /\ (v25 \/ v54 \/ v24) /\ (~v25 \/ ~v54 \/ v24) /\ (v25 \/ ~v54 \/ ~v24) /\ (~v25 \/ v54 \/ ~v24) /\ (v26 \/ v53 \/ v25) /\ (~v26 \/ ~v53 \/ v25) /\ (v26 \/ ~v53 \/ ~v25) /\ (~v26 \/ v53 \/ ~v25) /\ (v27 \/ v52 \/ v26) /\ (~v27 \/ ~v52 \/ v26) /\ (v27 \/ ~v52 \/ ~v26) /\ (~v27 \/ v52 \/ ~v26) /\ (v28 \/ v51 \/ v27) /\ (~v28 \/ ~v51 \/ v27) /\ (v28 \/ ~v51 \/ ~v27) /\ (~v28 \/ v51 \/ ~v27) /\ (v29 \/ v50 \/ v28) /\ (~v29 \/ ~v50 \/ v28) /\ (v29 \/ ~v50 \/ ~v28) /\ (~v29 \/ v50 \/ ~v28) /\ (v30 \/ v49 \/ v29) /\ (~v30 \/ ~v49 \/ v29) /\ (v30 \/ ~v49 \/ ~v29) /\ (~v30 \/ v49 \/ ~v29) /\ (v31 \/ v48 \/ v30) /\ (~v31 \/ ~v48 \/ v30) /\ (v31 \/ ~v48 \/ ~v30) /\ (~v31 \/ v48 \/ ~v30) /\ (v32 \/ v47 \/ v31) /\ (~v32 \/ ~v47 \/ v31) /\ (v32 \/ ~v47 \/ ~v31) /\ (~v32 \/ v47 \/ ~v31) /\ (v33 \/ v46 \/ v32) /\ (~v33 \/ ~v46 \/ v32) /\ (v33 \/ ~v46 \/ ~v32) /\ (~v33 \/ v46 \/ ~v32) /\ (v34 \/ v45 \/ v33) /\ (~v34 \/ ~v45 \/ v33) /\ (v34 \/ ~v45 \/ ~v33) /\ (~v34 \/ v45 \/ ~v33) /\ (v35 \/ v44 \/ v34) /\ (~v35 \/ ~v44 \/ v34) /\ (v35 \/ ~v44 \/ ~v34) /\ (~v35 \/ v44 \/ ~v34) /\ (v36 \/ v43 \/ v35) /\ (~v36 \/ ~v43 \/ v35) /\ (v36 \/ ~v43 \/ ~v35) /\ (~v36 \/ v43 \/ ~v35) /\ (v37 \/ v42 \/ v36) /\ (~v37 \/ ~v42 \/ v36) /\ (v37 \/ ~v42 \/ ~v36) /\ (~v37 \/ v42 \/ ~v36) /\ (v38 \/ v41 \/ v37) /\ (~v38 \/ ~v41 \/ v37) /\ (v38 \/ ~v41 \/ ~v37) /\ (~v38 \/ v41 \/ ~v37) /\ (v39 \/ v40 \/ ~v38) /\ (~v39 \/ ~v40 \/ ~v38) /\ (v39 \/ ~v40 \/ v38) /\ (~v39 \/ v40 \/ v38))` ;; let add3_be = `(aftbuf1 <=> ~anda) /\ (aftbuf2 <=> ~andb) /\ (aftbuf3 <=> ~exora) /\ (aftbuf4 <=> ~exorb) /\ (aftbuf5 <=> ~carryin) /\ (n1_0_ <=> aftbuf1 /\ a_0_) /\ (n1_1_ <=> aftbuf1 /\ a_1_) /\ (n1_2_ <=> aftbuf1 /\ a_2_) /\ (n1_3_ <=> aftbuf1 /\ a_3_) /\ (n1_4_ <=> aftbuf1 /\ a_4_) /\ (n1_5_ <=> aftbuf1 /\ a_5_) /\ (n1_6_ <=> aftbuf1 /\ a_6_) /\ (n1_7_ <=> aftbuf1 /\ a_7_) /\ (n3_0_ <=> aftbuf2 /\ b_0_) /\ (n3_1_ <=> aftbuf2 /\ b_1_) /\ (n3_2_ <=> aftbuf2 /\ b_2_) /\ (n3_3_ <=> aftbuf2 /\ b_3_) /\ (n3_4_ <=> aftbuf2 /\ b_4_) /\ (n3_5_ <=> aftbuf2 /\ b_5_) /\ (n3_6_ <=> aftbuf2 /\ b_6_) /\ (n3_7_ <=> aftbuf2 /\ b_7_) /\ (n2_0_ <=> aftbuf3 /\ ~n1_0_ \/ ~aftbuf3 /\ n1_0_) /\ (n2_1_ <=> aftbuf3 /\ ~n1_1_ \/ ~aftbuf3 /\ n1_1_) /\ (n2_2_ <=> aftbuf3 /\ ~n1_2_ \/ ~aftbuf3 /\ n1_2_) /\ (n2_3_ <=> aftbuf3 /\ ~n1_3_ \/ ~aftbuf3 /\ n1_3_) /\ (n2_4_ <=> aftbuf3 /\ ~n1_4_ \/ ~aftbuf3 /\ n1_4_) /\ (n2_5_ <=> aftbuf3 /\ ~n1_5_ \/ ~aftbuf3 /\ n1_5_) /\ (n2_6_ <=> aftbuf3 /\ ~n1_6_ \/ ~aftbuf3 /\ n1_6_) /\ (n2_7_ <=> aftbuf3 /\ ~n1_7_ \/ ~aftbuf3 /\ n1_7_) /\ (n4_0_ <=> aftbuf4 /\ ~n3_0_ \/ ~aftbuf4 /\ n3_0_) /\ (n4_1_ <=> aftbuf4 /\ ~n3_1_ \/ ~aftbuf4 /\ n3_1_) /\ (n4_2_ <=> aftbuf4 /\ ~n3_2_ \/ ~aftbuf4 /\ n3_2_) /\ (n4_3_ <=> aftbuf4 /\ ~n3_3_ \/ ~aftbuf4 /\ n3_3_) /\ (n4_4_ <=> aftbuf4 /\ ~n3_4_ \/ ~aftbuf4 /\ n3_4_) /\ (n4_5_ <=> aftbuf4 /\ ~n3_5_ \/ ~aftbuf4 /\ n3_5_) /\ (n4_6_ <=> aftbuf4 /\ ~n3_6_ \/ ~aftbuf4 /\ n3_6_) /\ (n4_7_ <=> aftbuf4 /\ ~n3_7_ \/ ~aftbuf4 /\ n3_7_) /\ (cout1 <=> aftbuf5 /\ n4_0_ \/ aftbuf5 /\ n2_0_ \/ n4_0_ /\ n2_0_) /\ (cout2 <=> cout1 /\ n4_1_ \/ cout1 /\ n2_1_ \/ n4_1_ /\ n2_1_) /\ (cout3 <=> cout2 /\ n4_2_ \/ cout2 /\ n2_2_ \/ n4_2_ /\ n2_2_) /\ (cout4 <=> cout3 /\ n4_3_ \/ cout3 /\ n2_3_ \/ n4_3_ /\ n2_3_) /\ (cout5 <=> cout4 /\ n4_4_ \/ cout4 /\ n2_4_ \/ n4_4_ /\ n2_4_) /\ (cout6 <=> cout5 /\ n4_5_ \/ cout5 /\ n2_5_ \/ n4_5_ /\ n2_5_) /\ (cout7 <=> cout6 /\ n4_6_ \/ cout6 /\ n2_6_ \/ n4_6_ /\ n2_6_) /\ (hulp0 <=> ~(n2_0_ <=> ~(n4_0_ <=> aftbuf5))) /\ (hulp1 <=> ~(n2_1_ <=> ~(n4_1_ <=> cout1))) /\ (hulp2 <=> ~(n2_2_ <=> ~(n4_2_ <=> cout2))) /\ (hulp3 <=> ~(n2_3_ <=> ~(n4_3_ <=> cout3))) /\ (hulp4 <=> ~(n2_4_ <=> ~(n4_4_ <=> cout4))) /\ (hulp5 <=> ~(n2_5_ <=> ~(n4_5_ <=> cout5))) /\ (hulp6 <=> ~(n2_6_ <=> ~(n4_6_ <=> cout6))) /\ (hulp7 <=> ~(n2_7_ <=> ~(n4_7_ <=> cout7))) /\ (hulp8 <=> cout7 /\ n4_7_ \/ cout7 /\ n2_7_ \/ n4_7_ /\ n2_7_) /\ (sign <=> ~hulp7) /\ (overflow <=> (cout7 <=> hulp8)) /\ (carryout <=> ~hulp8) /\ (o_7_ <=> hulp7) /\ (o_6_ <=> hulp6) /\ (o_5_ <=> hulp5) /\ (o_4_ <=> hulp4) /\ (o_3_ <=> hulp3) /\ (o_2_ <=> hulp2) /\ (o_1_ <=> hulp1) /\ (o_0_ <=> hulp0) /\ (n3 <=> a_1_) /\ (n4 <=> a_4_) /\ (n5 <=> a_6_) /\ (n6 <=> a_5_) /\ (n7 <=> a_0_) /\ (n8 <=> a_2_) /\ (n9 <=> a_7_) /\ (n10 <=> a_3_) /\ (n11 <=> anda) /\ (n12 <=> exora) /\ (n13 <=> b_4_) /\ (n14 <=> b_6_) /\ (n15 <=> b_3_) /\ (n16 <=> b_0_) /\ (n17 <=> b_1_) /\ (n18 <=> b_7_) /\ (n19 <=> b_5_) /\ (n20 <=> b_2_) /\ (n21 <=> andb) /\ (n22 <=> exorb) /\ (n23 <=> carryin) /\ (n74 <=> ~n23) /\ (n70 <=> ~n21) /\ (n76 <=> ~n22) /\ (n69 <=> ~n11) /\ (n75 <=> ~n12) /\ (n165 <=> ~n9 \/ ~n69) /\ (n173 <=> ~n75) /\ (n166 <=> ~n18 \/ ~n70) /\ (n174 <=> ~n76) /\ (n160 <=> ~n14 \/ ~n70) /\ (n152 <=> ~n76) /\ (n159 <=> ~n5 \/ ~n69) /\ (n151 <=> ~n75) /\ (n134 <=> ~n13 \/ ~n70) /\ (n126 <=> ~n76) /\ (n133 <=> ~n4 \/ ~n69) /\ (n125 <=> ~n75) /\ (n113 <=> ~n10 \/ ~n69) /\ (n121 <=> ~n75) /\ (n114 <=> ~n15 \/ ~n70) /\ (n122 <=> ~n76) /\ (n140 <=> ~n19 \/ ~n70) /\ (n148 <=> ~n76) /\ (n139 <=> ~n6 \/ ~n69) /\ (n147 <=> ~n75) /\ (n87 <=> ~n3 \/ ~n69) /\ (n95 <=> ~n75) /\ (n88 <=> ~n17 \/ ~n70) /\ (n96 <=> ~n76) /\ (n108 <=> ~n20 \/ ~n70) /\ (n100 <=> ~n76) /\ (n107 <=> ~n8 \/ ~n69) /\ (n99 <=> ~n75) /\ (n77 <=> ~n74) /\ (n82 <=> ~n16 \/ ~n70) /\ (n72 <=> ~n76) /\ (n81 <=> ~n7 \/ ~n69) /\ (n71 <=> ~n75) /\ (n65 <=> ~n165) /\ (n63 <=> ~n166) /\ (n61 <=> ~n160) /\ (n59 <=> ~n159) /\ (n53 <=> ~n134) /\ (n51 <=> ~n133) /\ (n49 <=> ~n113) /\ (n47 <=> ~n114) /\ (n55 <=> ~n140) /\ (n57 <=> ~n139) /\ (n41 <=> ~n87) /\ (n39 <=> ~n88) /\ (n45 <=> ~n108) /\ (n43 <=> ~n107) /\ (n37 <=> ~n82) /\ (n35 <=> ~n81) /\ (n168 <=> (n65 <=> n75)) /\ (n169 <=> (n63 <=> n76)) /\ (n158 <=> (n61 <=> n76)) /\ (n157 <=> (n59 <=> n75)) /\ (n132 <=> (n53 <=> n76)) /\ (n131 <=> (n51 <=> n75)) /\ (n116 <=> (n49 <=> n75)) /\ (n117 <=> (n47 <=> n76)) /\ (n143 <=> (n55 <=> n76)) /\ (n142 <=> (n57 <=> n75)) /\ (n90 <=> (n41 <=> n75)) /\ (n91 <=> (n39 <=> n76)) /\ (n106 <=> (n45 <=> n76)) /\ (n105 <=> (n43 <=> n75)) /\ (n80 <=> (n37 <=> n76)) /\ (n79 <=> (n35 <=> n75)) /\ (n66 <=> ~n168) /\ (n64 <=> ~n169) /\ (n62 <=> ~n158) /\ (n60 <=> ~n157) /\ (n54 <=> ~n132) /\ (n52 <=> ~n131) /\ (n50 <=> ~n116) /\ (n48 <=> ~n117) /\ (n56 <=> ~n143) /\ (n58 <=> ~n142) /\ (n42 <=> ~n90) /\ (n40 <=> ~n91) /\ (n46 <=> ~n106) /\ (n44 <=> ~n105) /\ (n38 <=> ~n80) /\ (n36 <=> ~n79) /\ (n172 <=> ~n66) /\ (n150 <=> ~n60) /\ (n124 <=> ~n52) /\ (n120 <=> ~n50) /\ (n146 <=> ~n58) /\ (n94 <=> ~n42) /\ (n98 <=> ~n44) /\ (n68 <=> ~n36) /\ (n171 <=> (n64 <=> n66)) /\ (n153 <=> (n62 <=> n60)) /\ (n127 <=> (n54 <=> n52)) /\ (n119 <=> (n48 <=> n50)) /\ (n145 <=> (n56 <=> n58)) /\ (n93 <=> (n40 <=> n42)) /\ (n101 <=> (n46 <=> n44)) /\ (n73 <=> (n38 <=> n36)) /\ (n163 <=> ~n171) /\ (n149 <=> ~n153) /\ (n123 <=> ~n127) /\ (n111 <=> ~n119) /\ (n137 <=> ~n145) /\ (n85 <=> ~n93) /\ (n97 <=> ~n101) /\ (n67 <=> ~n73) /\ (n170 <=> ~n163) /\ (n161 <=> ~n149) /\ (n135 <=> ~n123) /\ (n118 <=> ~n111) /\ (n144 <=> ~n137) /\ (n92 <=> ~n85) /\ (n109 <=> ~n97) /\ (n83 <=> ~n67) /\ (n84 <=> ~n67 /\ ~n36 \/ ~n83 /\ ~n74) /\ (n78 <=> ~(n77 <=> n67)) /\ (n86 <=> ~n84) /\ (n102 <=> ~n92 /\ ~n84 \/ ~n94 /\ ~n85) /\ (n28 <=> ~n78) /\ (n110 <=> ~n97 /\ ~n44 \/ ~n109 /\ ~n102) /\ (n89 <=> (n86 <=> n85)) /\ (n103 <=> ~n102) /\ (n112 <=> ~n110) /\ (n128 <=> ~n118 /\ ~n110 \/ ~n120 /\ ~n111) /\ (n24 <=> ~n89) /\ (n104 <=> ~(n103 <=> n97)) /\ (n115 <=> (n112 <=> n111)) /\ (n129 <=> ~n128) /\ (n136 <=> ~n123 /\ ~n52 \/ ~n135 /\ ~n128) /\ (n26 <=> ~n104) /\ (n25 <=> ~n115) /\ (n130 <=> ~(n129 <=> n123)) /\ (n154 <=> ~n144 /\ ~n136 \/ ~n146 /\ ~n137) /\ (n138 <=> ~n136) /\ (n27 <=> ~n130) /\ (n162 <=> ~n149 /\ ~n60 \/ ~n161 /\ ~n154) /\ (n155 <=> ~n154) /\ (n141 <=> (n138 <=> n137)) /\ (n164 <=> ~n162) /\ (n175 <=> ~n162) /\ (n176 <=> ~n170 /\ ~n162 \/ ~n172 /\ ~n163) /\ (n156 <=> ~(n155 <=> n149)) /\ (n30 <=> ~n141) /\ (n167 <=> (n164 <=> n163)) /\ (n177 <=> (n176 <=> n162)) /\ (n31 <=> ~n176) /\ (n29 <=> ~n156) /\ (n34 <=> ~n167) /\ (n32 <=> ~n177) /\ (n33 <=> ~n34) ==> (o_1_ <=> n24) /\ (o_3_ <=> n25) /\ (o_2_ <=> n26) /\ (o_4_ <=> n27) /\ (o_0_ <=> n28) /\ (o_6_ <=> n29) /\ (o_5_ <=> n30) /\ (carryout <=> n31) /\ (overflow <=> n32) /\ (sign <=> n33) /\ (o_7_ <=> n34)` ;; let add4_be = `(n3 <=> a_0_) /\ (n4 <=> a_2_) /\ (n5 <=> a_4_) /\ (n6 <=> a_5_) /\ (n7 <=> a_6_) /\ (n8 <=> a_8_) /\ (n9 <=> a_3_) /\ (n10 <=> a_7_) /\ (n11 <=> a_9_) /\ (n12 <=> a_11_) /\ (n13 <=> a_1_) /\ (n14 <=> a_10_) /\ (n15 <=> anda) /\ (n16 <=> exora) /\ (n17 <=> b_3_) /\ (n18 <=> b_4_) /\ (n19 <=> b_6_) /\ (n20 <=> b_1_) /\ (n21 <=> b_7_) /\ (n22 <=> b_9_) /\ (n23 <=> b_2_) /\ (n24 <=> b_5_) /\ (n25 <=> b_8_) /\ (n26 <=> b_10_) /\ (n27 <=> b_11_) /\ (n28 <=> b_0_) /\ (n29 <=> andb) /\ (n30 <=> exorb) /\ (n31 <=> carryin) /\ (n98 <=> ~n29) /\ (n104 <=> ~n30) /\ (n97 <=> ~n15) /\ (n103 <=> ~n16) /\ (n102 <=> ~n31) /\ (n105 <=> ~n102) /\ (n243 <=> ~n14 \/ ~n97) /\ (n235 <=> ~n103) /\ (n244 <=> ~n26 \/ ~n98) /\ (n236 <=> ~n104) /\ (n224 <=> ~n22 \/ ~n98) /\ (n232 <=> ~n104) /\ (n223 <=> ~n11 \/ ~n97) /\ (n231 <=> ~n103) /\ (n217 <=> ~n8 \/ ~n97) /\ (n209 <=> ~n103) /\ (n218 <=> ~n25 \/ ~n98) /\ (n210 <=> ~n104) /\ (n197 <=> ~n21 \/ ~n98) /\ (n206 <=> ~n104) /\ (n196 <=> ~n10 \/ ~n97) /\ (n205 <=> ~n103) /\ (n190 <=> ~n19 \/ ~n98) /\ (n182 <=> ~n104) /\ (n189 <=> ~n7 \/ ~n97) /\ (n181 <=> ~n103) /\ (n251 <=> ~n27 \/ ~n98) /\ (n259 <=> ~n104) /\ (n250 <=> ~n12 \/ ~n97) /\ (n258 <=> ~n103) /\ (n163 <=> ~n18 \/ ~n98) /\ (n155 <=> ~n104) /\ (n162 <=> ~n5 \/ ~n97) /\ (n154 <=> ~n103) /\ (n170 <=> ~n24 \/ ~n98) /\ (n178 <=> ~n104) /\ (n169 <=> ~n6 \/ ~n97) /\ (n177 <=> ~n103) /\ (n136 <=> ~n23 \/ ~n98) /\ (n128 <=> ~n104) /\ (n135 <=> ~n4 \/ ~n97) /\ (n127 <=> ~n103) /\ (n116 <=> ~n20 \/ ~n98) /\ (n124 <=> ~n104) /\ (n115 <=> ~n13 \/ ~n97) /\ (n123 <=> ~n103) /\ (n110 <=> ~n28 \/ ~n98) /\ (n100 <=> ~n104) /\ (n109 <=> ~n3 \/ ~n97) /\ (n99 <=> ~n103) /\ (n142 <=> ~n17 \/ ~n98) /\ (n150 <=> ~n104) /\ (n141 <=> ~n9 \/ ~n97) /\ (n149 <=> ~n103) /\ (n87 <=> ~n243) /\ (n89 <=> ~n244) /\ (n83 <=> ~n224) /\ (n85 <=> ~n223) /\ (n79 <=> ~n217) /\ (n81 <=> ~n218) /\ (n75 <=> ~n197) /\ (n77 <=> ~n196) /\ (n73 <=> ~n190) /\ (n71 <=> ~n189) /\ (n91 <=> ~n251) /\ (n93 <=> ~n250) /\ (n65 <=> ~n163) /\ (n63 <=> ~n162) /\ (n67 <=> ~n170) /\ (n69 <=> ~n169) /\ (n57 <=> ~n136) /\ (n55 <=> ~n135) /\ (n51 <=> ~n116) /\ (n53 <=> ~n115) /\ (n49 <=> ~n110) /\ (n47 <=> ~n109) /\ (n59 <=> ~n142) /\ (n61 <=> ~n141) /\ (n241 <=> n87 /\ n103 \/ ~n87 /\ ~n103) /\ (n242 <=> n89 /\ n104 \/ ~n89 /\ ~n104) /\ (n227 <=> n83 /\ n104 \/ ~n83 /\ ~n104) /\ (n226 <=> n85 /\ n103 \/ ~n85 /\ ~n103) /\ (n215 <=> n79 /\ n103 \/ ~n79 /\ ~n103) /\ (n216 <=> n81 /\ n104 \/ ~n81 /\ ~n104) /\ (n200 <=> n75 /\ n104 \/ ~n75 /\ ~n104) /\ (n199 <=> n77 /\ n103 \/ ~n77 /\ ~n103) /\ (n188 <=> n73 /\ n104 \/ ~n73 /\ ~n104) /\ (n187 <=> n71 /\ n103 \/ ~n71 /\ ~n103) /\ (n254 <=> n91 /\ n104 \/ ~n91 /\ ~n104) /\ (n253 <=> n93 /\ n103 \/ ~n93 /\ ~n103) /\ (n160 <=> n65 /\ n104 \/ ~n65 /\ ~n104) /\ (n159 <=> n63 /\ n103 \/ ~n63 /\ ~n103) /\ (n173 <=> n67 /\ n104 \/ ~n67 /\ ~n104) /\ (n172 <=> n69 /\ n103 \/ ~n69 /\ ~n103) /\ (n134 <=> n57 /\ n104 \/ ~n57 /\ ~n104) /\ (n133 <=> n55 /\ n103 \/ ~n55 /\ ~n103) /\ (n119 <=> n51 /\ n104 \/ ~n51 /\ ~n104) /\ (n118 <=> n53 /\ n103 \/ ~n53 /\ ~n103) /\ (n108 <=> n49 /\ n104 \/ ~n49 /\ ~n104) /\ (n107 <=> n47 /\ n103 \/ ~n47 /\ ~n103) /\ (n145 <=> n59 /\ n104 \/ ~n59 /\ ~n104) /\ (n144 <=> n61 /\ n103 \/ ~n61 /\ ~n103) /\ (n88 <=> ~n241) /\ (n90 <=> ~n242) /\ (n84 <=> ~n227) /\ (n86 <=> ~n226) /\ (n80 <=> ~n215) /\ (n82 <=> ~n216) /\ (n76 <=> ~n200) /\ (n78 <=> ~n199) /\ (n74 <=> ~n188) /\ (n72 <=> ~n187) /\ (n92 <=> ~n254) /\ (n94 <=> ~n253) /\ (n66 <=> ~n160) /\ (n64 <=> ~n159) /\ (n68 <=> ~n173) /\ (n70 <=> ~n172) /\ (n58 <=> ~n134) /\ (n56 <=> ~n133) /\ (n52 <=> ~n119) /\ (n54 <=> ~n118) /\ (n50 <=> ~n108) /\ (n48 <=> ~n107) /\ (n60 <=> ~n145) /\ (n62 <=> ~n144) /\ (n234 <=> ~n88) /\ (n230 <=> ~n86) /\ (n208 <=> ~n80) /\ (n204 <=> ~n78) /\ (n180 <=> ~n72) /\ (n257 <=> ~n94) /\ (n152 <=> ~n64) /\ (n176 <=> ~n70) /\ (n126 <=> ~n56) /\ (n122 <=> ~n54) /\ (n96 <=> ~n48) /\ (n148 <=> ~n62) /\ (n237 <=> n90 /\ n88 \/ ~n90 /\ ~n88) /\ (n229 <=> n84 /\ n86 \/ ~n84 /\ ~n86) /\ (n211 <=> n82 /\ n80 \/ ~n82 /\ ~n80) /\ (n203 <=> n76 /\ n78 \/ ~n76 /\ ~n78) /\ (n183 <=> n74 /\ n72 \/ ~n74 /\ ~n72) /\ (n256 <=> n92 /\ n94 \/ ~n92 /\ ~n94) /\ (n156 <=> n66 /\ n64 \/ ~n66 /\ ~n64) /\ (n175 <=> n68 /\ n70 \/ ~n68 /\ ~n70) /\ (n129 <=> n58 /\ n56 \/ ~n58 /\ ~n56) /\ (n121 <=> n52 /\ n54 \/ ~n52 /\ ~n54) /\ (n101 <=> n50 /\ n48 \/ ~n50 /\ ~n48) /\ (n147 <=> n60 /\ n62 \/ ~n60 /\ ~n62) /\ (n233 <=> ~n237) /\ (n221 <=> ~n229) /\ (n207 <=> ~n211) /\ (n193 <=> ~n203) /\ (n179 <=> ~n183) /\ (n248 <=> ~n256) /\ (n151 <=> ~n156) /\ (n166 <=> ~n175) /\ (n125 <=> ~n129) /\ (n113 <=> ~n121) /\ (n95 <=> ~n101) /\ (n139 <=> ~n147) /\ (n245 <=> ~n233) /\ (n228 <=> ~n221) /\ (n219 <=> ~n207) /\ (n167 <=> ~n166 \/ ~n151 \/ ~n179 \/ ~n193) /\ (n202 <=> ~n193) /\ (n191 <=> ~n179) /\ (n255 <=> ~n248) /\ (n164 <=> ~n151) /\ (n174 <=> ~n166) /\ (n137 <=> ~n125) /\ (n120 <=> ~n113) /\ (n111 <=> ~n95) /\ (n146 <=> ~n139) /\ (n106 <=> n105 /\ ~n95 \/ ~n105 /\ n95) /\ (n161 <=> ~n167) /\ (n112 <=> ~n95 /\ ~n48 \/ ~n111 /\ ~n102) /\ (n114 <=> ~n112) /\ (n39 <=> ~n106) /\ (n130 <=> ~n120 /\ ~n112 \/ ~n122 /\ ~n113) /\ (n117 <=> n114 /\ n113 \/ ~n114 /\ ~n113) /\ (n131 <=> ~n130) /\ (n138 <=> ~n125 /\ ~n56 \/ ~n137 /\ ~n130) /\ (n32 <=> ~n117) /\ (n132 <=> n131 /\ ~n125 \/ ~n131 /\ n125) /\ (n153 <=> ~n146 /\ ~n138 \/ ~n148 /\ ~n139) /\ (n140 <=> ~n138) /\ (n37 <=> ~n132) /\ (n157 <=> ~n153) /\ (n165 <=> ~n151 /\ ~n64 \/ ~n164 /\ ~n153) /\ (n143 <=> n140 /\ n139 \/ ~n140 /\ ~n139) /\ (n158 <=> n157 /\ ~n151 \/ ~n157 /\ n151) /\ (n184 <=> ~n174 /\ ~n165 \/ ~n176 /\ ~n166) /\ (n168 <=> ~n165) /\ (n33 <=> ~n143) /\ (n43 <=> ~n158) /\ (n185 <=> ~n184) /\ (n192 <=> ~n179 /\ ~n72 \/ ~n191 /\ ~n184) /\ (n171 <=> n168 /\ n166 \/ ~n168 /\ ~n166) /\ (n195 <=> ~n192) /\ (n186 <=> n185 /\ ~n179 \/ ~n185 /\ n179) /\ (n201 <=> ~n202 /\ ~n192 \/ ~n204 /\ ~n193) /\ (n34 <=> ~n171) /\ (n198 <=> n195 /\ n193 \/ ~n195 /\ ~n193) /\ (n35 <=> ~n186) /\ (n194 <=> ~n167 /\ ~n153 \/ ~n161 /\ ~n201) /\ (n36 <=> ~n198) /\ (n212 <=> ~n194) /\ (n213 <=> ~n212) /\ (n220 <=> ~n207 /\ ~n80 \/ ~n219 /\ ~n212) /\ (n214 <=> n213 /\ ~n207 \/ ~n213 /\ n207) /\ (n222 <=> ~n220) /\ (n238 <=> ~n228 /\ ~n220 \/ ~n230 /\ ~n221) /\ (n38 <=> ~n214) /\ (n225 <=> n222 /\ n221 \/ ~n222 /\ ~n221) /\ (n239 <=> ~n238) /\ (n246 <=> ~n233 /\ ~n88 \/ ~n245 /\ ~n238) /\ (n40 <=> ~n225) /\ (n240 <=> n239 /\ ~n233 \/ ~n239 /\ n233) /\ (n261 <=> ~n255 /\ ~n246 \/ ~n257 /\ ~n248) /\ (n249 <=> ~n246) /\ (n262 <=> n261 /\ n246 \/ ~n261 /\ ~n246) /\ (n41 <=> ~n240) /\ (n44 <=> ~n261) /\ (n252 <=> n249 /\ n248 \/ ~n249 /\ ~n248) /\ (n45 <=> ~n262) /\ (n42 <=> ~n252) /\ (n46 <=> ~n42) /\ (o_4_ <=> n43) /\ (o_11_ <=> n42) /\ (o_10_ <=> n41) /\ (o_9_ <=> n40) /\ (o_0_ <=> n39) /\ (o_8_ <=> n38) /\ (o_2_ <=> n37) /\ (o_7_ <=> n36) /\ (o_6_ <=> n35) /\ (o_5_ <=> n34) /\ (o_3_ <=> n33) /\ (o_1_ <=> n32) /\ (aftbuf1 <=> ~anda) /\ (aftbuf2 <=> ~andb) /\ (aftbuf3 <=> ~exora) /\ (aftbuf4 <=> ~exorb) /\ (aftbuf5 <=> ~carryin) /\ (n1_0_ <=> aftbuf1 /\ a_0_) /\ (n1_1_ <=> aftbuf1 /\ a_1_) /\ (n1_2_ <=> aftbuf1 /\ a_2_) /\ (n1_3_ <=> aftbuf1 /\ a_3_) /\ (n1_4_ <=> aftbuf1 /\ a_4_) /\ (n1_5_ <=> aftbuf1 /\ a_5_) /\ (n1_6_ <=> aftbuf1 /\ a_6_) /\ (n1_7_ <=> aftbuf1 /\ a_7_) /\ (n1_8_ <=> aftbuf1 /\ a_8_) /\ (n1_9_ <=> aftbuf1 /\ a_9_) /\ (n1_10_ <=> aftbuf1 /\ a_10_) /\ (n1_11_ <=> aftbuf1 /\ a_11_) /\ (n3_0_ <=> aftbuf2 /\ b_0_) /\ (n3_1_ <=> aftbuf2 /\ b_1_) /\ (n3_2_ <=> aftbuf2 /\ b_2_) /\ (n3_3_ <=> aftbuf2 /\ b_3_) /\ (n3_4_ <=> aftbuf2 /\ b_4_) /\ (n3_5_ <=> aftbuf2 /\ b_5_) /\ (n3_6_ <=> aftbuf2 /\ b_6_) /\ (n3_7_ <=> aftbuf2 /\ b_7_) /\ (n3_8_ <=> aftbuf2 /\ b_8_) /\ (n3_9_ <=> aftbuf2 /\ b_9_) /\ (n3_10_ <=> aftbuf2 /\ b_10_) /\ (n3_11_ <=> aftbuf2 /\ b_11_) /\ (n2_0_ <=> aftbuf3 /\ ~n1_0_ \/ ~aftbuf3 /\ n1_0_) /\ (n2_1_ <=> aftbuf3 /\ ~n1_1_ \/ ~aftbuf3 /\ n1_1_) /\ (n2_2_ <=> aftbuf3 /\ ~n1_2_ \/ ~aftbuf3 /\ n1_2_) /\ (n2_3_ <=> aftbuf3 /\ ~n1_3_ \/ ~aftbuf3 /\ n1_3_) /\ (n2_4_ <=> aftbuf3 /\ ~n1_4_ \/ ~aftbuf3 /\ n1_4_) /\ (n2_5_ <=> aftbuf3 /\ ~n1_5_ \/ ~aftbuf3 /\ n1_5_) /\ (n2_6_ <=> aftbuf3 /\ ~n1_6_ \/ ~aftbuf3 /\ n1_6_) /\ (n2_7_ <=> aftbuf3 /\ ~n1_7_ \/ ~aftbuf3 /\ n1_7_) /\ (n2_8_ <=> aftbuf3 /\ ~n1_8_ \/ ~aftbuf3 /\ n1_8_) /\ (n2_9_ <=> aftbuf3 /\ ~n1_9_ \/ ~aftbuf3 /\ n1_9_) /\ (n2_10_ <=> aftbuf3 /\ ~n1_10_ \/ ~aftbuf3 /\ n1_10_) /\ (n2_11_ <=> aftbuf3 /\ ~n1_11_ \/ ~aftbuf3 /\ n1_11_) /\ (n4_0_ <=> aftbuf4 /\ ~n3_0_ \/ ~aftbuf4 /\ n3_0_) /\ (n4_1_ <=> aftbuf4 /\ ~n3_1_ \/ ~aftbuf4 /\ n3_1_) /\ (n4_2_ <=> aftbuf4 /\ ~n3_2_ \/ ~aftbuf4 /\ n3_2_) /\ (n4_3_ <=> aftbuf4 /\ ~n3_3_ \/ ~aftbuf4 /\ n3_3_) /\ (n4_4_ <=> aftbuf4 /\ ~n3_4_ \/ ~aftbuf4 /\ n3_4_) /\ (n4_5_ <=> aftbuf4 /\ ~n3_5_ \/ ~aftbuf4 /\ n3_5_) /\ (n4_6_ <=> aftbuf4 /\ ~n3_6_ \/ ~aftbuf4 /\ n3_6_) /\ (n4_7_ <=> aftbuf4 /\ ~n3_7_ \/ ~aftbuf4 /\ n3_7_) /\ (n4_8_ <=> aftbuf4 /\ ~n3_8_ \/ ~aftbuf4 /\ n3_8_) /\ (n4_9_ <=> aftbuf4 /\ ~n3_9_ \/ ~aftbuf4 /\ n3_9_) /\ (n4_10_ <=> aftbuf4 /\ ~n3_10_ \/ ~aftbuf4 /\ n3_10_) /\ (n4_11_ <=> aftbuf4 /\ ~n3_11_ \/ ~aftbuf4 /\ n3_11_) /\ (cout1 <=> aftbuf5 /\ n4_0_ \/ aftbuf5 /\ n2_0_ \/ n4_0_ /\ n2_0_) /\ (cout2 <=> cout1 /\ n4_1_ \/ cout1 /\ n2_1_ \/ n4_1_ /\ n2_1_) /\ (cout3 <=> cout2 /\ n4_2_ \/ cout2 /\ n2_2_ \/ n4_2_ /\ n2_2_) /\ (cout4 <=> cout3 /\ n4_3_ \/ cout3 /\ n2_3_ \/ n4_3_ /\ n2_3_) /\ (cout5 <=> cout4 /\ n4_4_ \/ cout4 /\ n2_4_ \/ n4_4_ /\ n2_4_) /\ (cout6 <=> cout5 /\ n4_5_ \/ cout5 /\ n2_5_ \/ n4_5_ /\ n2_5_) /\ (cout7 <=> cout6 /\ n4_6_ \/ cout6 /\ n2_6_ \/ n4_6_ /\ n2_6_) /\ (cout8 <=> cout7 /\ n4_7_ \/ cout7 /\ n2_7_ \/ n4_7_ /\ n2_7_) /\ (cout9 <=> cout8 /\ n4_8_ \/ cout8 /\ n2_8_ \/ n4_8_ /\ n2_8_) /\ (cout10 <=> cout9 /\ n4_9_ \/ cout9 /\ n2_9_ \/ n4_9_ /\ n2_9_) /\ (cout11 <=> cout10 /\ n4_10_ \/ cout10 /\ n2_10_ \/ n4_10_ /\ n2_10_) /\ (hulp0 <=> ~(n2_0_ <=> ~(n4_0_ <=> aftbuf5))) /\ (hulp1 <=> ~(n2_1_ <=> ~(n4_1_ <=> cout1))) /\ (hulp2 <=> ~(n2_2_ <=> ~(n4_2_ <=> cout2))) /\ (hulp3 <=> ~(n2_3_ <=> ~(n4_3_ <=> cout3))) /\ (hulp4 <=> ~(n2_4_ <=> ~(n4_4_ <=> cout4))) /\ (hulp5 <=> ~(n2_5_ <=> ~(n4_5_ <=> cout5))) /\ (hulp6 <=> ~(n2_6_ <=> ~(n4_6_ <=> cout6))) /\ (hulp7 <=> ~(n2_7_ <=> ~(n4_7_ <=> cout7))) /\ (hulp8 <=> ~(n2_8_ <=> ~(n4_8_ <=> cout8))) /\ (hulp9 <=> ~(n2_9_ <=> ~(n4_9_ <=> cout9))) /\ (hulp10 <=> ~(n2_10_ <=> ~(n4_10_ <=> cout10))) /\ (hulp11 <=> ~(n2_11_ <=> ~(n4_11_ <=> cout11))) /\ (hulp12 <=> cout11 /\ n4_11_ \/ cout11 /\ n2_11_ \/ n4_11_ /\ n2_11_) ==> (o_0_ <=> hulp0) /\ (o_1_ <=> hulp1) /\ (o_2_ <=> hulp2) /\ (o_3_ <=> hulp3) /\ (o_4_ <=> hulp4) /\ (o_5_ <=> hulp5) /\ (o_6_ <=> hulp6) /\ (o_7_ <=> hulp7) /\ (o_8_ <=> hulp8) /\ (o_9_ <=> hulp9) /\ (o_10_ <=> hulp10) /\ (o_11_ <=> hulp11)` ;; let u5 = `(s0_0 <=> (x_0 <=> ~y_0)) /\ (c0_1 <=> x_0 /\ y_0) /\ (s0_1 <=> ((x_1 <=> ~y_1) <=> ~c0_1)) /\ (c0_2 <=> x_1 /\ y_1 \/ (x_1 \/ y_1) /\ c0_1) /\ (s0_2 <=> ((x_2 <=> ~y_2) <=> ~c0_2)) /\ (c0_3 <=> x_2 /\ y_2 \/ (x_2 \/ y_2) /\ c0_2) /\ (s1_0 <=> ~(x_0 <=> ~y_0)) /\ (c1_1 <=> x_0 /\ y_0 \/ x_0 \/ y_0) /\ (s1_1 <=> ((x_1 <=> ~y_1) <=> ~c1_1)) /\ (c1_2 <=> x_1 /\ y_1 \/ (x_1 \/ y_1) /\ c1_1) /\ (s1_2 <=> ((x_2 <=> ~y_2) <=> ~c1_2)) /\ (c1_3 <=> x_2 /\ y_2 \/ (x_2 \/ y_2) /\ c1_2) /\ (c_3 <=> ~c_0 /\ c0_3 \/ c_0 /\ c1_3) /\ (s_0 <=> ~c_0 /\ s0_0 \/ c_0 /\ s1_0) /\ (s_1 <=> ~c_0 /\ s0_1 \/ c_0 /\ s1_1) /\ (s_2 <=> ~c_0 /\ s0_2 \/ c_0 /\ s1_2) /\ ~c_0 /\ (s2_0 <=> (x_0 <=> ~y_0)) /\ (c2_1 <=> x_0 /\ y_0) /\ (s2_1 <=> ((x_1 <=> ~y_1) <=> ~c2_1)) /\ (c2_2 <=> x_1 /\ y_1 \/ (x_1 \/ y_1) /\ c2_1) /\ (s2_2 <=> ((x_2 <=> ~y_2) <=> ~c2_2)) /\ (c2_3 <=> x_2 /\ y_2 \/ (x_2 \/ y_2) /\ c2_2) ==> (c_3 <=> c2_3) /\ (s_0 <=> s2_0) /\ (s_1 <=> s2_1) /\ (s_2 <=> s2_2)`;; let msc007_1_008 = `~((~hslv49 \/ ~hslv56) /\ (~hslv42 \/ ~hslv56) /\ (~hslv42 \/ ~hslv49) /\ (~hslv35 \/ ~hslv56) /\ (~hslv35 \/ ~hslv49) /\ (~hslv35 \/ ~hslv42) /\ (~hslv28 \/ ~hslv56) /\ (~hslv28 \/ ~hslv49) /\ (~hslv28 \/ ~hslv42) /\ (~hslv28 \/ ~hslv35) /\ (~hslv21 \/ ~hslv56) /\ (~hslv21 \/ ~hslv49) /\ (~hslv21 \/ ~hslv42) /\ (~hslv21 \/ ~hslv35) /\ (~hslv21 \/ ~hslv28) /\ (~hslv14 \/ ~hslv56) /\ (~hslv14 \/ ~hslv49) /\ (~hslv14 \/ ~hslv42) /\ (~hslv14 \/ ~hslv35) /\ (~hslv14 \/ ~hslv28) /\ (~hslv14 \/ ~hslv21) /\ (~hslv7 \/ ~hslv56) /\ (~hslv7 \/ ~hslv49) /\ (~hslv7 \/ ~hslv42) /\ (~hslv7 \/ ~hslv35) /\ (~hslv7 \/ ~hslv28) /\ (~hslv7 \/ ~hslv21) /\ (~hslv7 \/ ~hslv14) /\ (~hslv48 \/ ~hslv55) /\ (~hslv41 \/ ~hslv55) /\ (~hslv41 \/ ~hslv48) /\ (~hslv34 \/ ~hslv55) /\ (~hslv34 \/ ~hslv48) /\ (~hslv34 \/ ~hslv41) /\ (~hslv27 \/ ~hslv55) /\ (~hslv27 \/ ~hslv48) /\ (~hslv27 \/ ~hslv41) /\ (~hslv27 \/ ~hslv34) /\ (~hslv20 \/ ~hslv55) /\ (~hslv20 \/ ~hslv48) /\ (~hslv20 \/ ~hslv41) /\ (~hslv20 \/ ~hslv34) /\ (~hslv20 \/ ~hslv27) /\ (~hslv13 \/ ~hslv55) /\ (~hslv13 \/ ~hslv48) /\ (~hslv13 \/ ~hslv41) /\ (~hslv13 \/ ~hslv34) /\ (~hslv13 \/ ~hslv27) /\ (~hslv13 \/ ~hslv20) /\ (~hslv6 \/ ~hslv55) /\ (~hslv6 \/ ~hslv48) /\ (~hslv6 \/ ~hslv41) /\ (~hslv6 \/ ~hslv34) /\ (~hslv6 \/ ~hslv27) /\ (~hslv6 \/ ~hslv20) /\ (~hslv6 \/ ~hslv13) /\ (~hslv47 \/ ~hslv54) /\ (~hslv40 \/ ~hslv54) /\ (~hslv40 \/ ~hslv47) /\ (~hslv33 \/ ~hslv54) /\ (~hslv33 \/ ~hslv47) /\ (~hslv33 \/ ~hslv40) /\ (~hslv26 \/ ~hslv54) /\ (~hslv26 \/ ~hslv47) /\ (~hslv26 \/ ~hslv40) /\ (~hslv26 \/ ~hslv33) /\ (~hslv19 \/ ~hslv54) /\ (~hslv19 \/ ~hslv47) /\ (~hslv19 \/ ~hslv40) /\ (~hslv19 \/ ~hslv33) /\ (~hslv19 \/ ~hslv26) /\ (~hslv12 \/ ~hslv54) /\ (~hslv12 \/ ~hslv47) /\ (~hslv12 \/ ~hslv40) /\ (~hslv12 \/ ~hslv33) /\ (~hslv12 \/ ~hslv26) /\ (~hslv12 \/ ~hslv19) /\ (~hslv5 \/ ~hslv54) /\ (~hslv5 \/ ~hslv47) /\ (~hslv5 \/ ~hslv40) /\ (~hslv5 \/ ~hslv33) /\ (~hslv5 \/ ~hslv26) /\ (~hslv5 \/ ~hslv19) /\ (~hslv5 \/ ~hslv12) /\ (~hslv46 \/ ~hslv53) /\ (~hslv39 \/ ~hslv53) /\ (~hslv39 \/ ~hslv46) /\ (~hslv32 \/ ~hslv53) /\ (~hslv32 \/ ~hslv46) /\ (~hslv32 \/ ~hslv39) /\ (~hslv25 \/ ~hslv53) /\ (~hslv25 \/ ~hslv46) /\ (~hslv25 \/ ~hslv39) /\ (~hslv25 \/ ~hslv32) /\ (~hslv18 \/ ~hslv53) /\ (~hslv18 \/ ~hslv46) /\ (~hslv18 \/ ~hslv39) /\ (~hslv18 \/ ~hslv32) /\ (~hslv18 \/ ~hslv25) /\ (~hslv11 \/ ~hslv53) /\ (~hslv11 \/ ~hslv46) /\ (~hslv11 \/ ~hslv39) /\ (~hslv11 \/ ~hslv32) /\ (~hslv11 \/ ~hslv25) /\ (~hslv11 \/ ~hslv18) /\ (~hslv4 \/ ~hslv53) /\ (~hslv4 \/ ~hslv46) /\ (~hslv4 \/ ~hslv39) /\ (~hslv4 \/ ~hslv32) /\ (~hslv4 \/ ~hslv25) /\ (~hslv4 \/ ~hslv18) /\ (~hslv4 \/ ~hslv11) /\ (~hslv45 \/ ~hslv52) /\ (~hslv38 \/ ~hslv52) /\ (~hslv38 \/ ~hslv45) /\ (~hslv31 \/ ~hslv52) /\ (~hslv31 \/ ~hslv45) /\ (~hslv31 \/ ~hslv38) /\ (~hslv24 \/ ~hslv52) /\ (~hslv24 \/ ~hslv45) /\ (~hslv24 \/ ~hslv38) /\ (~hslv24 \/ ~hslv31) /\ (~hslv17 \/ ~hslv52) /\ (~hslv17 \/ ~hslv45) /\ (~hslv17 \/ ~hslv38) /\ (~hslv17 \/ ~hslv31) /\ (~hslv17 \/ ~hslv24) /\ (~hslv10 \/ ~hslv52) /\ (~hslv10 \/ ~hslv45) /\ (~hslv10 \/ ~hslv38) /\ (~hslv10 \/ ~hslv31) /\ (~hslv10 \/ ~hslv24) /\ (~hslv10 \/ ~hslv17) /\ (~hslv3 \/ ~hslv52) /\ (~hslv3 \/ ~hslv45) /\ (~hslv3 \/ ~hslv38) /\ (~hslv3 \/ ~hslv31) /\ (~hslv3 \/ ~hslv24) /\ (~hslv3 \/ ~hslv17) /\ (~hslv3 \/ ~hslv10) /\ (~hslv44 \/ ~hslv51) /\ (~hslv37 \/ ~hslv51) /\ (~hslv37 \/ ~hslv44) /\ (~hslv30 \/ ~hslv51) /\ (~hslv30 \/ ~hslv44) /\ (~hslv30 \/ ~hslv37) /\ (~hslv23 \/ ~hslv51) /\ (~hslv23 \/ ~hslv44) /\ (~hslv23 \/ ~hslv37) /\ (~hslv23 \/ ~hslv30) /\ (~hslv16 \/ ~hslv51) /\ (~hslv16 \/ ~hslv44) /\ (~hslv16 \/ ~hslv37) /\ (~hslv16 \/ ~hslv30) /\ (~hslv16 \/ ~hslv23) /\ (~hslv9 \/ ~hslv51) /\ (~hslv9 \/ ~hslv44) /\ (~hslv9 \/ ~hslv37) /\ (~hslv9 \/ ~hslv30) /\ (~hslv9 \/ ~hslv23) /\ (~hslv9 \/ ~hslv16) /\ (~hslv2 \/ ~hslv51) /\ (~hslv2 \/ ~hslv44) /\ (~hslv2 \/ ~hslv37) /\ (~hslv2 \/ ~hslv30) /\ (~hslv2 \/ ~hslv23) /\ (~hslv2 \/ ~hslv16) /\ (~hslv2 \/ ~hslv9) /\ (~hslv43 \/ ~hslv50) /\ (~hslv36 \/ ~hslv50) /\ (~hslv36 \/ ~hslv43) /\ (~hslv29 \/ ~hslv50) /\ (~hslv29 \/ ~hslv43) /\ (~hslv29 \/ ~hslv36) /\ (~hslv22 \/ ~hslv50) /\ (~hslv22 \/ ~hslv43) /\ (~hslv22 \/ ~hslv36) /\ (~hslv22 \/ ~hslv29) /\ (~hslv15 \/ ~hslv50) /\ (~hslv15 \/ ~hslv43) /\ (~hslv15 \/ ~hslv36) /\ (~hslv15 \/ ~hslv29) /\ (~hslv15 \/ ~hslv22) /\ (~hslv8 \/ ~hslv50) /\ (~hslv8 \/ ~hslv43) /\ (~hslv8 \/ ~hslv36) /\ (~hslv8 \/ ~hslv29) /\ (~hslv8 \/ ~hslv22) /\ (~hslv8 \/ ~hslv15) /\ (~hslv1 \/ ~hslv50) /\ (~hslv1 \/ ~hslv43) /\ (~hslv1 \/ ~hslv36) /\ (~hslv1 \/ ~hslv29) /\ (~hslv1 \/ ~hslv22) /\ (~hslv1 \/ ~hslv15) /\ (~hslv1 \/ ~hslv8) /\ (hslv50 \/ hslv51 \/ hslv52 \/ hslv53 \/ hslv54 \/ hslv55 \/ hslv56) /\ (hslv43 \/ hslv44 \/ hslv45 \/ hslv46 \/ hslv47 \/ hslv48 \/ hslv49) /\ (hslv36 \/ hslv37 \/ hslv38 \/ hslv39 \/ hslv40 \/ hslv41 \/ hslv42) /\ (hslv29 \/ hslv30 \/ hslv31 \/ hslv32 \/ hslv33 \/ hslv34 \/ hslv35) /\ (hslv22 \/ hslv23 \/ hslv24 \/ hslv25 \/ hslv26 \/ hslv27 \/ hslv28) /\ (hslv15 \/ hslv16 \/ hslv17 \/ hslv18 \/ hslv19 \/ hslv20 \/ hslv21) /\ (hslv8 \/ hslv9 \/ hslv10 \/ hslv11 \/ hslv12 \/ hslv13 \/ hslv14) /\ (hslv1 \/ hslv2 \/ hslv3 \/ hslv4 \/ hslv5 \/ hslv6 \/ hslv7))` let ahb_arb_8 = `(if ~hmask_7 /\ hbusreq_7 /\ ~htrans_0 /\ ~htrans_1 then ~hgrant_3' /\ hgrant_2' /\ hgrant_1' /\ hgrant_0' else (if ~hmask_6 /\ hbusreq_6 /\ ~htrans_0 /\ ~htrans_1 then ~hgrant_3' /\ hgrant_2' /\ hgrant_1' /\ ~hgrant_0' else (if ~hmask_5 /\ hbusreq_5 /\ ~htrans_0 /\ ~htrans_1 then ~hgrant_3' /\ hgrant_2' /\ ~hgrant_1' /\ hgrant_0' else (if ~hmask_4 /\ hbusreq_4 /\ ~htrans_0 /\ ~htrans_1 then ~hgrant_3' /\ hgrant_2' /\ ~hgrant_1' /\ ~hgrant_0' else (if ~hmask_3 /\ hbusreq_3 /\ ~htrans_0 /\ ~htrans_1 then ~hgrant_3' /\ ~hgrant_2' /\ hgrant_1' /\ hgrant_0' else (if ~hmask_2 /\ hbusreq_2 /\ ~htrans_0 /\ ~htrans_1 then ~hgrant_3' /\ ~hgrant_2' /\ hgrant_1' /\ ~hgrant_0' else (if ~hmask_1 /\ hbusreq_1 /\ ~htrans_0 /\ ~htrans_1 then ~hgrant_3' /\ ~hgrant_2' /\ ~hgrant_1' /\ hgrant_0' else hgrant_0' /\ ((hmaster_3':bool) <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ ((hmaster_2':bool) <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ ((hmaster_1':bool) <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ ((hmaster_0':bool) <=> (if ~hreadyout then hmaster_0 else hgrant_0))) /\ (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0))) /\ (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0))) /\ (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0))) /\ (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0))) /\ (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0))) /\ (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0)))` let ssa = `~ ((v435) /\ (v174) /\ (~v175) /\ (v173) /\ (~v39 \/ ~v433) /\ (v37 \/ ~v433) /\ (v39 \/ ~v434) /\ (~v37 \/ ~v434) /\ (~v434 \/ v432) /\ (~v433 \/ v432) /\ (~v79 \/ ~v37) /\ (~v67 \/ ~v37) /\ (~v68 \/ v38) /\ (~v68 \/ ~v79) /\ (~v79 \/ ~v39) /\ (~v69 \/ ~v39) /\ (~v76 \/ ~v67) /\ (~v71 \/ ~v67) /\ (~v74 \/ ~v67) /\ (~v138 \/ ~v67) /\ (~v72 \/ v68) /\ (~v72 \/ ~v138) /\ (~v72 \/ ~v74) /\ (~v72 \/ ~v76) /\ (~v76 \/ ~v69) /\ (~v73 \/ ~v69) /\ (~v74 \/ ~v69) /\ (~v138 \/ ~v69) /\ (v75 \/ ~v138) /\ (~v75 \/ v138) /\ (v75 \/ ~v139) /\ (~v75 \/ v139) /\ (v75 \/ ~v147) /\ (~v75 \/ v147) /\ (~v311 \/ ~v75) /\ (~v307 \/ ~v75) /\ (v312 \/ v307) /\ (~v312 \/ ~v307) /\ (v15 \/ ~v315) /\ (~v15 \/ v315) /\ (v15 \/ ~v316) /\ (~v15 \/ v316) /\ (v53 \/ ~v93) /\ (~v53 \/ v93) /\ (v53 \/ ~v94) /\ (~v53 \/ v94) /\ (v53 \/ ~v98) /\ (~v53 \/ v98) /\ (v53 \/ ~v102) /\ (~v53 \/ v102) /\ (v53 \/ ~v105) /\ (~v53 \/ v105) /\ (v53 \/ ~v119) /\ (~v53 \/ v119) /\ (v53 \/ ~v121) /\ (~v53 \/ v121) /\ (v53 \/ ~v124) /\ (~v53 \/ v124) /\ (v53 \/ ~v129) /\ (~v53 \/ v129) /\ (v53 \/ ~v169) /\ (~v53 \/ v169) /\ (v53 \/ ~v207) /\ (~v53 \/ v207) /\ (v53 \/ ~v221) /\ (~v53 \/ v221) /\ (v53 \/ ~v244) /\ (~v53 \/ v244) /\ (v53 \/ ~v250) /\ (~v53 \/ v250) /\ (v53 \/ ~v304) /\ (~v53 \/ v304) /\ (v53 \/ ~v314) /\ (~v53 \/ v314) /\ (v53 \/ ~v330) /\ (~v53 \/ v330) /\ (v53 \/ ~v343) /\ (~v53 \/ v343) /\ (v53 \/ ~v345) /\ (~v53 \/ v345) /\ (v53 \/ ~v360) /\ (~v53 \/ v360) /\ (v53 \/ ~v378) /\ (~v53 \/ v378) /\ (v60 \/ v53) /\ (v263 \/ v53) /\ (v176 \/ v53) /\ (v182 \/ v53) /\ (v188 \/ v182) /\ (~v188 \/ ~v182) /\ (v104 \/ ~v187) /\ (~v104 \/ v187) /\ (v104 \/ ~v188) /\ (~v104 \/ v188) /\ (~v196 \/ ~v104) /\ (~v191 \/ ~v104) /\ (~v193 \/ ~v104) /\ (v184 \/ ~v192) /\ (~v184 \/ v192) /\ (v184 \/ ~v193) /\ (~v184 \/ v193) /\ (v184 \/ ~v200) /\ (~v184 \/ v200) /\ (v184 \/ ~v203) /\ (~v184 \/ v203) /\ (v34 \/ v184) /\ (~v34 \/ ~v184) /\ (v12 \/ ~v190) /\ (~v12 \/ v190) /\ (v12 \/ ~v191) /\ (~v12 \/ v191) /\ (v189 \/ ~v196) /\ (~v189 \/ v196) /\ (v189 \/ ~v197) /\ (~v189 \/ v197) /\ (~v271 \/ ~v422) /\ (v195 \/ ~v422) /\ (v271 \/ ~v423) /\ (~v195 \/ ~v423) /\ (~v423 \/ v189) /\ (~v422 \/ v189) /\ (v42 \/ ~v80) /\ (~v42 \/ v80) /\ (v42 \/ ~v81) /\ (~v42 \/ v81) /\ (v42 \/ ~v84) /\ (~v42 \/ v84) /\ (v42 \/ ~v101) /\ (~v42 \/ v101) /\ (v42 \/ ~v112) /\ (~v42 \/ v112) /\ (v42 \/ ~v166) /\ (~v42 \/ v166) /\ (v42 \/ ~v195) /\ (~v42 \/ v195) /\ (v42 \/ ~v218) /\ (~v42 \/ v218) /\ (v42 \/ ~v241) /\ (~v42 \/ v241) /\ (v42 \/ ~v259) /\ (~v42 \/ v259) /\ (v42 \/ ~v291) /\ (~v42 \/ v291) /\ (v42 \/ ~v303) /\ (~v42 \/ v303) /\ (v42 \/ ~v313) /\ (~v42 \/ v313) /\ (v42 \/ ~v323) /\ (~v42 \/ v323) /\ (v42 \/ ~v344) /\ (~v42 \/ v344) /\ (v42 \/ ~v349) /\ (~v42 \/ v349) /\ (v42 \/ ~v357) /\ (~v42 \/ v357) /\ (v42 \/ ~v385) /\ (~v42 \/ v385) /\ (v42 \/ ~v404) /\ (~v42 \/ v404) /\ (v286 \/ v42) /\ (v267 \/ v42) /\ (v43 \/ v42) /\ (v278 \/ v42) /\ (v347 \/ v278) /\ (~v347 \/ ~v278) /\ (v279 \/ ~v347) /\ (~v279 \/ v347) /\ (v279 \/ ~v348) /\ (~v279 \/ v348) /\ (~v369 \/ ~v279) /\ (~v370 \/ ~v279) /\ (v281 \/ ~v284) /\ (~v281 \/ v284) /\ (v281 \/ ~v285) /\ (~v281 \/ v285) /\ (v281 \/ ~v301) /\ (~v281 \/ v301) /\ (v281 \/ ~v370) /\ (~v281 \/ v370) /\ (v26 \/ v281) /\ (~v26 \/ ~v281) /\ (v7 \/ ~v368) /\ (~v7 \/ v368) /\ (v7 \/ ~v369) /\ (~v7 \/ v369) /\ (~v110 \/ ~v43) /\ (~v46 \/ ~v43) /\ (v41 \/ ~v45) /\ (~v41 \/ v45) /\ (v41 \/ ~v46) /\ (~v41 \/ v46) /\ (~v219 \/ ~v41) /\ (~v211 \/ ~v41) /\ (v204 \/ ~v211) /\ (~v204 \/ v211) /\ (v204 \/ ~v212) /\ (~v204 \/ v212) /\ (v214 \/ v204) /\ (~v214 \/ ~v204) /\ (v32 \/ ~v214) /\ (~v32 \/ v214) /\ (v32 \/ ~v215) /\ (~v32 \/ v215) /\ (v32 \/ ~v228) /\ (~v32 \/ v228) /\ (v5 \/ ~v219) /\ (~v5 \/ v219) /\ (v5 \/ ~v220) /\ (~v5 \/ v220) /\ (v44 \/ ~v110) /\ (~v44 \/ v110) /\ (v44 \/ ~v111) /\ (~v44 \/ v111) /\ (~v358 \/ ~v44) /\ (~v355 \/ ~v44) /\ (v350 \/ ~v353) /\ (~v350 \/ v353) /\ (v350 \/ ~v354) /\ (~v350 \/ v354) /\ (v350 \/ ~v355) /\ (~v350 \/ v355) /\ (v350 \/ ~v367) /\ (~v350 \/ v367) /\ (v9 \/ v350) /\ (~v9 \/ ~v350) /\ (v21 \/ ~v358) /\ (~v21 \/ v358) /\ (v21 \/ ~v359) /\ (~v21 \/ v359) /\ (~v270 \/ ~v267) /\ (~v268 \/ ~v267) /\ (~v272 \/ ~v267) /\ (v194 \/ ~v271) /\ (~v194 \/ v271) /\ (v194 \/ ~v272) /\ (~v194 \/ v272) /\ (~v202 \/ ~v194) /\ (~v203 \/ ~v194) /\ (v25 \/ ~v201) /\ (~v25 \/ v201) /\ (v25 \/ ~v202) /\ (~v25 \/ v202) /\ (v331 \/ v268) /\ (v324 \/ v268) /\ (v332 \/ v268) /\ (v402 \/ v332) /\ (~v402 \/ ~v332) /\ (v391 \/ ~v402) /\ (~v391 \/ v402) /\ (v391 \/ ~v403) /\ (~v391 \/ v403) /\ (~v400 \/ ~v391) /\ (~v401 \/ ~v391) /\ (v392 \/ ~v397) /\ (~v392 \/ v397) /\ (v392 \/ ~v398) /\ (~v392 \/ v398) /\ (v392 \/ ~v401) /\ (~v392 \/ v401) /\ (v392 \/ ~v409) /\ (~v392 \/ v409) /\ (v19 \/ v392) /\ (~v19 \/ ~v392) /\ (v17 \/ ~v399) /\ (~v17 \/ v399) /\ (v17 \/ ~v400) /\ (~v17 \/ v400) /\ (v326 \/ v324) /\ (~v326 \/ ~v324) /\ (v322 \/ ~v325) /\ (~v322 \/ v325) /\ (v322 \/ ~v326) /\ (~v322 \/ v326) /\ (~v389 \/ ~v322) /\ (~v390 \/ ~v322) /\ (v235 \/ ~v386) /\ (~v235 \/ v386) /\ (v235 \/ ~v387) /\ (~v235 \/ v387) /\ (v235 \/ ~v390) /\ (~v235 \/ v390) /\ (v383 \/ v235) /\ (~v383 \/ ~v235) /\ (v35 \/ ~v382) /\ (~v35 \/ v382) /\ (v35 \/ ~v383) /\ (~v35 \/ v383) /\ (v30 \/ ~v388) /\ (~v30 \/ v388) /\ (v30 \/ ~v389) /\ (~v30 \/ v389) /\ (v334 \/ v331) /\ (~v334 \/ ~v331) /\ (v83 \/ ~v333) /\ (~v83 \/ v333) /\ (v83 \/ ~v334) /\ (~v83 \/ v334) /\ (~v320 \/ ~v83) /\ (~v321 \/ ~v83) /\ (v86 \/ ~v91) /\ (~v86 \/ v91) /\ (v86 \/ ~v92) /\ (~v86 \/ v92) /\ (v86 \/ ~v158) /\ (~v86 \/ v158) /\ (v86 \/ ~v321) /\ (~v86 \/ v321) /\ (v28 \/ v86) /\ (~v28 \/ ~v86) /\ (v4 \/ ~v317) /\ (~v4 \/ v317) /\ (v4 \/ ~v320) /\ (~v4 \/ v320) /\ (v237 \/ ~v269) /\ (~v237 \/ v269) /\ (v237 \/ ~v270) /\ (~v237 \/ v270) /\ (~v242 \/ ~v237) /\ (~v239 \/ ~v237) /\ (v232 \/ ~v238) /\ (~v232 \/ v238) /\ (v232 \/ ~v239) /\ (~v232 \/ v239) /\ (v253 \/ v232) /\ (~v253 \/ ~v232) /\ (v6 \/ ~v253) /\ (~v6 \/ v253) /\ (v6 \/ ~v254) /\ (~v6 \/ v254) /\ (v6 \/ ~v258) /\ (~v6 \/ v258) /\ (v10 \/ ~v242) /\ (~v10 \/ v242) /\ (v10 \/ ~v243) /\ (~v10 \/ v243) /\ (v289 \/ v286) /\ (~v289 \/ ~v286) /\ (v287 \/ ~v289) /\ (~v287 \/ v289) /\ (v287 \/ ~v290) /\ (~v287 \/ v290) /\ (~v372 \/ ~v287) /\ (~v373 \/ ~v287) /\ (v292 \/ ~v295) /\ (~v292 \/ v295) /\ (v292 \/ ~v296) /\ (~v292 \/ v296) /\ (v292 \/ ~v311) /\ (~v292 \/ v311) /\ (v292 \/ ~v373) /\ (~v292 \/ v373) /\ (v27 \/ v292) /\ (~v27 \/ ~v292) /\ (v11 \/ ~v371) /\ (~v11 \/ v371) /\ (v11 \/ ~v372) /\ (~v11 \/ v372) /\ (~v180 \/ ~v176) /\ (~v328 \/ ~v176) /\ (~v276 \/ ~v176) /\ (v178 \/ ~v276) /\ (~v178 \/ v276) /\ (v178 \/ ~v277) /\ (~v178 \/ v277) /\ (v178 \/ ~v342) /\ (~v178 \/ v342) /\ (~v405 \/ ~v178) /\ (~v396 \/ ~v178) /\ (~v398 \/ ~v178) /\ (v18 \/ ~v395) /\ (~v18 \/ v395) /\ (v18 \/ ~v396) /\ (~v18 \/ v396) /\ (v394 \/ ~v405) /\ (~v394 \/ v405) /\ (v394 \/ ~v406) /\ (~v394 \/ v406) /\ (~v403 \/ ~v410) /\ (v404 \/ ~v410) /\ (v403 \/ ~v411) /\ (~v404 \/ ~v411) /\ (~v411 \/ v394) /\ (~v410 \/ v394) /\ (v177 \/ ~v328) /\ (~v177 \/ v328) /\ (v177 \/ ~v329) /\ (~v177 \/ v329) /\ (~v337 \/ ~v177) /\ (~v376 \/ ~v177) /\ (~v386 \/ ~v177) /\ (v22 \/ ~v376) /\ (~v22 \/ v376) /\ (v22 \/ ~v377) /\ (~v22 \/ v377) /\ (v234 \/ ~v337) /\ (~v234 \/ v337) /\ (v234 \/ ~v338) /\ (~v234 \/ v338) /\ (~v325 \/ ~v416) /\ (v323 \/ ~v416) /\ (v325 \/ ~v417) /\ (~v323 \/ ~v417) /\ (~v417 \/ v234) /\ (~v416 \/ v234) /\ (v85 \/ ~v179) /\ (~v85 \/ v179) /\ (v85 \/ ~v180) /\ (~v85 \/ v180) /\ (~v89 \/ ~v85) /\ (~v172 \/ ~v85) /\ (~v91 \/ ~v85) /\ (v23 \/ ~v172) /\ (~v23 \/ v172) /\ (v23 \/ ~v173) /\ (~v23 \/ v173) /\ (v82 \/ ~v89) /\ (~v82 \/ v89) /\ (v82 \/ ~v90) /\ (~v82 \/ v90) /\ (~v333 \/ ~v428) /\ (v84 \/ ~v428) /\ (v333 \/ ~v429) /\ (~v84 \/ ~v429) /\ (~v429 \/ v82) /\ (~v428 \/ v82) /\ (v181 \/ ~v263) /\ (~v181 \/ v263) /\ (v181 \/ ~v264) /\ (~v181 \/ v264) /\ (v248 \/ v181) /\ (~v248 \/ ~v181) /\ (v233 \/ ~v248) /\ (~v233 \/ v248) /\ (v233 \/ ~v249) /\ (~v233 \/ v249) /\ (~v261 \/ ~v233) /\ (~v245 \/ ~v233) /\ (~v238 \/ ~v233) /\ (v33 \/ ~v245) /\ (~v33 \/ v245) /\ (v33 \/ ~v246) /\ (~v33 \/ v246) /\ (v236 \/ ~v261) /\ (~v236 \/ v261) /\ (v236 \/ ~v262) /\ (~v236 \/ v262) /\ (~v269 \/ ~v420) /\ (v259 \/ ~v420) /\ (v269 \/ ~v421) /\ (~v259 \/ ~v421) /\ (~v421 \/ v236) /\ (~v420 \/ v236) /\ (~v65 \/ ~v60) /\ (~v122 \/ ~v60) /\ (~v117 \/ ~v60) /\ (~v127 \/ ~v60) /\ (v63 \/ ~v127) /\ (~v63 \/ v127) /\ (v63 \/ ~v128) /\ (~v63 \/ v128) /\ (v63 \/ ~v206) /\ (~v63 \/ v206) /\ (~v210 \/ ~v63) /\ (~v222 \/ ~v63) /\ (~v212 \/ ~v63) /\ (v29 \/ ~v222) /\ (~v29 \/ v222) /\ (v29 \/ ~v223) /\ (~v29 \/ v223) /\ (v40 \/ ~v209) /\ (~v40 \/ v209) /\ (v40 \/ ~v210) /\ (~v40 \/ v210) /\ (~v45 \/ ~v430) /\ (v80 \/ ~v430) /\ (v45 \/ ~v431) /\ (~v80 \/ ~v431) /\ (~v431 \/ v40) /\ (~v430 \/ v40) /\ (v62 \/ ~v117) /\ (~v62 \/ v117) /\ (v62 \/ ~v118) /\ (~v62 \/ v118) /\ (v62 \/ ~v120) /\ (~v62 \/ v120) /\ (~v283 \/ ~v62) /\ (~v305 \/ ~v62) /\ (~v285 \/ ~v62) /\ (v31 \/ ~v305) /\ (~v31 \/ v305) /\ (v31 \/ ~v306) /\ (~v31 \/ v306) /\ (v280 \/ ~v282) /\ (~v280 \/ v282) /\ (v280 \/ ~v283) /\ (~v280 \/ v283) /\ (~v348 \/ ~v412) /\ (v349 \/ ~v412) /\ (v348 \/ ~v413) /\ (~v349 \/ ~v413) /\ (~v413 \/ v280) /\ (~v412 \/ v280) /\ (v61 \/ ~v122) /\ (~v61 \/ v122) /\ (v61 \/ ~v123) /\ (~v61 \/ v123) /\ (~v351 \/ ~v61) /\ (~v361 \/ ~v61) /\ (~v353 \/ ~v61) /\ (v20 \/ ~v361) /\ (~v20 \/ v361) /\ (v20 \/ ~v362) /\ (~v20 \/ v362) /\ (v109 \/ ~v351) /\ (~v109 \/ v351) /\ (v109 \/ ~v352) /\ (~v109 \/ v352) /\ (~v111 \/ ~v424) /\ (v112 \/ ~v424) /\ (v111 \/ ~v425) /\ (~v112 \/ ~v425) /\ (~v425 \/ v109) /\ (~v424 \/ v109) /\ (v52 \/ ~v64) /\ (~v52 \/ v64) /\ (v52 \/ ~v65) /\ (~v52 \/ v65) /\ (~v293 \/ ~v52) /\ (~v315 \/ ~v52) /\ (~v295 \/ ~v52) /\ (v288 \/ ~v293) /\ (~v288 \/ v293) /\ (v288 \/ ~v294) /\ (~v288 \/ v294) /\ (~v290 \/ ~v418) /\ (v291 \/ ~v418) /\ (v290 \/ ~v419) /\ (~v291 \/ ~v419) /\ (~v419 \/ v288) /\ (~v418 \/ v288) /\ (v2 \/ ~v309) /\ (~v2 \/ v309) /\ (v2 \/ ~v310) /\ (~v2 \/ v310) /\ (v58 \/ ~v185) /\ (~v58 \/ v185) /\ (v58 \/ ~v186) /\ (~v58 \/ v186) /\ (v58 \/ ~v231) /\ (~v58 \/ v231) /\ (v58 \/ ~v298) /\ (~v58 \/ v298) /\ (v58 \/ ~v308) /\ (~v58 \/ v308) /\ (v58 \/ ~v364) /\ (~v58 \/ v364) /\ (v58 \/ ~v375) /\ (~v58 \/ v375) /\ (v58 \/ ~v393) /\ (~v58 \/ v393) /\ (v49 \/ v58) /\ (v59 \/ v58) /\ (v54 \/ v58) /\ (~v57 \/ ~v54) /\ (~v209 \/ ~v57) /\ (~v208 \/ ~v57) /\ (v226 \/ v208) /\ (v215 \/ v208) /\ (v213 \/ ~v226) /\ (~v213 \/ v226) /\ (v213 \/ ~v227) /\ (~v213 \/ v227) /\ (v14 \/ v213) /\ (~v14 \/ ~v213) /\ (v126 \/ v125) /\ (~v126 \/ ~v125) /\ (~v128 \/ ~v126) /\ (~v129 \/ ~v126) /\ (v206 \/ v205) /\ (v207 \/ v205) /\ (~v352 \/ ~v56) /\ (~v365 \/ ~v56) /\ (~v354 \/ ~v56) /\ (v8 \/ ~v365) /\ (~v8 \/ v365) /\ (v8 \/ ~v366) /\ (~v8 \/ v366) /\ (~v95 \/ ~v59) /\ (~v87 \/ ~v59) /\ (~v96 \/ ~v59) /\ (v336 \/ v96) /\ (v346 \/ v336) /\ (~v406 \/ ~v346) /\ (~v408 \/ ~v346) /\ (~v409 \/ ~v346) /\ (v3 \/ ~v407) /\ (~v3 \/ v407) /\ (v3 \/ ~v408) /\ (~v3 \/ v408) /\ (~v342 \/ ~v341) /\ (~v343 \/ ~v341) /\ (~v274 \/ ~v273) /\ (~v275 \/ ~v273) /\ (v78 \/ ~v265) /\ (~v78 \/ v265) /\ (v78 \/ ~v266) /\ (~v78 \/ v266) /\ (v78 \/ ~v275) /\ (~v78 \/ v275) /\ (v98 \/ v78) /\ (~v98 \/ ~v78) /\ (v277 \/ v274) /\ (~v277 \/ ~v274) /\ (v379 \/ v335) /\ (v382 \/ v335) /\ (v381 \/ v379) /\ (~v381 \/ ~v379) /\ (v1 \/ ~v380) /\ (~v1 \/ v380) /\ (v1 \/ ~v381) /\ (~v1 \/ v381) /\ (~v329 \/ ~v414) /\ (v330 \/ ~v414) /\ (v329 \/ ~v415) /\ (~v330 \/ ~v415) /\ (~v415 \/ v327) /\ (~v414 \/ v327) /\ (~v88 \/ ~v87) /\ (~v90 \/ ~v87) /\ (~v156 \/ ~v87) /\ (~v92 \/ ~v87) /\ (v16 \/ ~v156) /\ (~v16 \/ v156) /\ (v16 \/ ~v157) /\ (~v16 \/ v157) /\ (~v179 \/ ~v426) /\ (v94 \/ ~v426) /\ (v179 \/ ~v427) /\ (~v94 \/ ~v427) /\ (~v427 \/ v88) /\ (~v426 \/ v88) /\ (v106 \/ v95) /\ (~v106 \/ ~v95) /\ (~v108 \/ ~v106) /\ (~v262 \/ ~v108) /\ (~v255 \/ ~v108) /\ (v257 \/ v255) /\ (v258 \/ v255) /\ (v251 \/ ~v256) /\ (~v251 \/ v256) /\ (v251 \/ ~v257) /\ (~v251 \/ v257) /\ (v13 \/ v251) /\ (~v13 \/ ~v251) /\ (v264 \/ v260) /\ (v266 \/ v260) /\ (v249 \/ v247) /\ (v250 \/ v247) /\ (~v197 \/ ~v107) /\ (~v199 \/ ~v107) /\ (~v200 \/ ~v107) /\ (v36 \/ ~v198) /\ (~v36 \/ v198) /\ (v36 \/ ~v199) /\ (~v36 \/ v199) /\ (~v47 \/ ~v49) /\ (v48 \/ v47) /\ (~v48 \/ ~v47) /\ (v115 \/ v48) /\ (~v282 \/ ~v115) /\ (~v299 \/ ~v115) /\ (~v284 \/ ~v115) /\ (v24 \/ ~v299) /\ (~v24 \/ v299) /\ (v24 \/ ~v300) /\ (~v24 \/ v300) /\ (~v120 \/ ~v114) /\ (~v121 \/ ~v114) /\ (v116 \/ v113) /\ (~v116 \/ ~v113) /\ (v118 \/ v116) /\ (v119 \/ v116) /\ (~v294 \/ ~v51) /\ (~v309 \/ ~v51) /\ (~v296 \/ ~v51) /\ (v229 \/ v74) /\ (v230 \/ v74) /\ (v66 \/ ~v132) /\ (~v66 \/ v132) /\ (v66 \/ ~v133) /\ (~v66 \/ v133) /\ (v66 \/ ~v135) /\ (~v66 \/ v135) /\ (v66 \/ ~v230) /\ (~v66 \/ v230) /\ (v216 \/ v66) /\ (~v216 \/ ~v66) /\ (~v356 \/ ~v216) /\ (v363 \/ v356) /\ (~v363 \/ ~v356) /\ (~v367 \/ ~v363) /\ (v131 \/ ~v136) /\ (~v131 \/ v136) /\ (v131 \/ ~v137) /\ (~v131 \/ v137) /\ (v131 \/ ~v140) /\ (~v131 \/ v140) /\ (v131 \/ ~v148) /\ (~v131 \/ v148) /\ (v131 \/ ~v229) /\ (~v131 \/ v229) /\ (v302 \/ v131) /\ (v297 \/ v131) /\ (~v301 \/ ~v297) /\ (v146 \/ v71) /\ (v141 \/ v71) /\ (v149 \/ v71) /\ (~v142 \/ v72) /\ (~v142 \/ v149) /\ (~v142 \/ v146) /\ (v146 \/ v73) /\ (v143 \/ v73) /\ (v149 \/ v73) /\ (v144 \/ ~v149) /\ (~v144 \/ v149) /\ (v144 \/ ~v150) /\ (~v144 \/ v150) /\ (v152 \/ v144) /\ (~v152 \/ ~v144) /\ (v134 \/ ~v151) /\ (~v134 \/ v151) /\ (v134 \/ ~v152) /\ (~v134 \/ v152) /\ (~v240 \/ ~v134) /\ (v254 \/ v240) /\ (v97 \/ ~v224) /\ (~v97 \/ v224) /\ (v97 \/ ~v225) /\ (~v97 \/ v225) /\ (v97 \/ ~v252) /\ (~v97 \/ v252) /\ (v231 \/ v97) /\ (~v231 \/ ~v97) /\ (~v163 \/ ~v141) /\ (~v160 \/ v142) /\ (~v160 \/ v153) /\ (~v154 \/ ~v163) /\ (~v160 \/ ~v163) /\ (~v163 \/ ~v143) /\ (v99 \/ ~v162) /\ (~v99 \/ v162) /\ (v99 \/ ~v163) /\ (~v99 \/ v163) /\ (~v100 \/ ~v99) /\ (v183 \/ v100) /\ (~v183 \/ ~v100) /\ (~v192 \/ ~v183) /\ (~v158 \/ ~v153) /\ (~v174 \/ v160) /\ (~v174 \/ v169) /\ (~v318 \/ v166) /\ (~v167 \/ v317) /\ (v130 \/ ~v145) /\ (~v130 \/ v145) /\ (v130 \/ ~v146) /\ (~v130 \/ v146) /\ (v228 \/ v130) /\ (v217 \/ v130) /\ (v70 \/ ~v76) /\ (~v70 \/ v76) /\ (v70 \/ ~v77) /\ (~v70 \/ v77) /\ (~v339 \/ ~v70) /\ (v340 \/ v339) /\ (~v340 \/ ~v339) /\ (~v397 \/ ~v340) /\ (~v384 \/ ~v79) /\ (~v387 \/ ~v79) /\ (v374 \/ v384) /\ (~v374 \/ ~v384) /\ (~v432 \/ v435) /\ (~v435 \/ v432) /\ (v433 \/ v39 \/ ~v37) /\ (v434 \/ ~v39 \/ v37) /\ (~v432 \/ v434 \/ v433) /\ (v37 \/ v79 \/ v67) /\ (~v38 \/ v37 \/ v39) /\ (~v38 \/ ~v37 \/ ~v39) /\ (v39 \/ v79 \/ v69) /\ (~v68 \/ v67 \/ v69) /\ (~v68 \/ ~v67 \/ ~v69) /\ (~v310 \/ ~v308 \/ ~v75) /\ (~v371 \/ ~v313 \/ ~v312) /\ (~v316 \/ ~v314 \/ ~v312) /\ (v314 \/ v313 \/ v312) /\ (v316 \/ v313 \/ v312) /\ (v314 \/ v371 \/ v312) /\ (v316 \/ v371 \/ v312) /\ (v422 \/ v271 \/ ~v195) /\ (v423 \/ ~v271 \/ v195) /\ (~v189 \/ v423 \/ v422) /\ (v279 \/ v369 \/ v370) /\ (v43 \/ v110 \/ v46) /\ (v41 \/ v219 \/ v211) /\ (v44 \/ v358 \/ v355) /\ (v194 \/ v202 \/ v203) /\ (v391 \/ v400 \/ v401) /\ (v322 \/ v389 \/ v390) /\ (v83 \/ v320 \/ v321) /\ (v237 \/ v242 \/ v239) /\ (v287 \/ v372 \/ v373) /\ (v410 \/ v403 \/ ~v404) /\ (v411 \/ ~v403 \/ v404) /\ (~v394 \/ v411 \/ v410) /\ (v416 \/ v325 \/ ~v323) /\ (v417 \/ ~v325 \/ v323) /\ (~v234 \/ v417 \/ v416) /\ (v428 \/ v333 \/ ~v84) /\ (v429 \/ ~v333 \/ v84) /\ (~v82 \/ v429 \/ v428) /\ (v420 \/ v269 \/ ~v259) /\ (v421 \/ ~v269 \/ v259) /\ (~v236 \/ v421 \/ v420) /\ (v430 \/ v45 \/ ~v80) /\ (v431 \/ ~v45 \/ v80) /\ (~v40 \/ v431 \/ v430) /\ (v412 \/ v348 \/ ~v349) /\ (v413 \/ ~v348 \/ v349) /\ (~v280 \/ v413 \/ v412) /\ (v424 \/ v111 \/ ~v112) /\ (v425 \/ ~v111 \/ v112) /\ (~v109 \/ v425 \/ v424) /\ (v418 \/ v290 \/ ~v291) /\ (v419 \/ ~v290 \/ v291) /\ (~v288 \/ v419 \/ v418) /\ (~v56 \/ ~v55 \/ ~v54) /\ (v57 \/ v55 \/ v54) /\ (v57 \/ v56 \/ v54) /\ (~v125 \/ ~v205 \/ ~v57) /\ (~v208 \/ ~v226 \/ ~v215) /\ (v126 \/ v128 \/ v129) /\ (~v205 \/ ~v206 \/ ~v207) /\ (v124 \/ v123 \/ v55) /\ (~v124 \/ ~v123 \/ v55) /\ (~v124 \/ v123 \/ ~v55) /\ (v124 \/ ~v123 \/ ~v55) /\ (~v336 \/ ~v327 \/ ~v96) /\ (~v336 \/ ~v338 \/ ~v96) /\ (~v336 \/ ~v335 \/ ~v96) /\ (v341 \/ v273 \/ v336) /\ (~v346 \/ ~v273 \/ ~v336) /\ (~v346 \/ ~v341 \/ ~v336) /\ (v341 \/ v342 \/ v343) /\ (v273 \/ v274 \/ v275) /\ (~v335 \/ ~v379 \/ ~v382) /\ (v414 \/ v329 \/ ~v330) /\ (v415 \/ ~v329 \/ v330) /\ (~v327 \/ v415 \/ v414) /\ (v426 \/ v179 \/ ~v94) /\ (v427 \/ ~v179 \/ v94) /\ (~v88 \/ v427 \/ v426) /\ (~v107 \/ ~v103 \/ ~v106) /\ (v108 \/ v103 \/ v106) /\ (v108 \/ v107 \/ v106) /\ (~v260 \/ ~v247 \/ ~v108) /\ (~v255 \/ ~v257 \/ ~v258) /\ (~v260 \/ ~v264 \/ ~v266) /\ (~v247 \/ ~v249 \/ ~v250) /\ (v105 \/ v187 \/ v103) /\ (~v105 \/ ~v187 \/ v103) /\ (~v105 \/ v187 \/ ~v103) /\ (v105 \/ ~v187 \/ ~v103) /\ (~v51 \/ ~v50 \/ ~v49) /\ (v47 \/ v50 \/ v49) /\ (v47 \/ v51 \/ v49) /\ (v114 \/ v113 \/ v48) /\ (~v115 \/ ~v113 \/ ~v48) /\ (~v115 \/ ~v114 \/ ~v48) /\ (v114 \/ v120 \/ v121) /\ (~v116 \/ ~v118 \/ ~v119) /\ (v93 \/ v64 \/ v50) /\ (~v93 \/ ~v64 \/ v50) /\ (~v93 \/ v64 \/ ~v50) /\ (v93 \/ ~v64 \/ ~v50) /\ (~v74 \/ ~v229 \/ ~v230) /\ (~v359 \/ ~v357 \/ ~v216) /\ (~v362 \/ ~v360 \/ ~v216) /\ (~v366 \/ ~v364 \/ ~v363) /\ (v367 \/ v364 \/ v363) /\ (v367 \/ v366 \/ v363) /\ (~v131 \/ ~v302 \/ ~v297) /\ (~v300 \/ ~v298 \/ ~v297) /\ (v301 \/ v298 \/ v297) /\ (v301 \/ v300 \/ v297) /\ (~v368 \/ ~v303 \/ ~v302) /\ (~v306 \/ ~v304 \/ ~v302) /\ (v304 \/ v303 \/ v302) /\ (v306 \/ v303 \/ v302) /\ (v304 \/ v368 \/ v302) /\ (v306 \/ v368 \/ v302) /\ (~v72 \/ v71 \/ v73) /\ (~v72 \/ ~v71 \/ ~v73) /\ (~v243 \/ ~v241 \/ ~v134) /\ (~v246 \/ ~v244 \/ ~v134) /\ (v256 \/ v252 \/ v240) /\ (~v254 \/ ~v252 \/ ~v240) /\ (~v254 \/ ~v256 \/ ~v240) /\ (~v153 \/ ~v159 \/ ~v141) /\ (v163 \/ v159 \/ v141) /\ (v163 \/ v153 \/ v141) /\ (~v154 \/ ~v155 \/ v161) /\ (~v154 \/ ~v153 \/ v159) /\ (~v154 \/ v159 \/ v161) /\ (~v142 \/ v141 \/ v143) /\ (~v142 \/ ~v141 \/ ~v143) /\ (~v153 \/ ~v161 \/ ~v143) /\ (v163 \/ v161 \/ v143) /\ (v163 \/ v153 \/ v143) /\ (~v201 \/ ~v101 \/ ~v99) /\ (~v190 \/ ~v102 \/ ~v99) /\ (~v198 \/ ~v186 \/ ~v183) /\ (v192 \/ v186 \/ v183) /\ (v192 \/ v198 \/ v183) /\ (~v157 \/ ~v185 \/ ~v153) /\ (v158 \/ v185 \/ v153) /\ (v158 \/ v157 \/ v153) /\ (~v317 \/ ~v166 \/ ~v159) /\ (~v173 \/ ~v169 \/ ~v159) /\ (v169 \/ v166 \/ v159) /\ (v173 \/ v166 \/ v159) /\ (v169 \/ v317 \/ v159) /\ (v173 \/ v317 \/ v159) /\ (~v170 \/ ~v171 \/ v175) /\ (~v170 \/ ~v169 \/ v173) /\ (~v170 \/ v173 \/ v175) /\ (~v174 \/ ~v317 \/ ~v166) /\ (~v170 \/ ~v317 \/ ~v166) /\ (~v160 \/ v159 \/ v161) /\ (~v160 \/ ~v159 \/ ~v161) /\ (~v317 \/ ~v166 \/ ~v161) /\ (~v175 \/ ~v169 \/ ~v161) /\ (v169 \/ v166 \/ v161) /\ (v175 \/ v166 \/ v161) /\ (v169 \/ v317 \/ v161) /\ (v175 \/ v317 \/ v161) /\ (v227 \/ v225 \/ v130) /\ (~v220 \/ ~v218 \/ ~v217) /\ (~v223 \/ ~v221 \/ ~v217) /\ (v221 \/ v218 \/ v217) /\ (v223 \/ v218 \/ v217) /\ (v221 \/ v220 \/ v217) /\ (v223 \/ v220 \/ v217) /\ (~v399 \/ ~v344 \/ ~v70) /\ (~v395 \/ ~v345 \/ ~v70) /\ (~v407 \/ ~v393 \/ ~v340) /\ (v397 \/ v393 \/ v340) /\ (v397 \/ v407 \/ v340) /\ (~v385 \/ ~v388 \/ ~v79) /\ (~v375 \/ ~v380 \/ ~v374) /\ (~v378 \/ ~v377 \/ ~v374) /\ (v377 \/ v380 \/ v374) /\ (v378 \/ v380 \/ v374) /\ (v377 \/ v375 \/ v374) /\ (v378 \/ v375 \/ v374) /\ (v307 \/ v311 \/ v308 \/ v75) /\ (v307 \/ v311 \/ v310 \/ v75) /\ (v104 \/ v196 \/ v191 \/ v193) /\ (v267 \/ v270 \/ v268 \/ v272) /\ (~v268 \/ ~v331 \/ ~v324 \/ ~v332) /\ (v176 \/ v180 \/ v328 \/ v276) /\ (v178 \/ v405 \/ v396 \/ v398) /\ (v177 \/ v337 \/ v376 \/ v386) /\ (v85 \/ v89 \/ v172 \/ v91) /\ (v233 \/ v261 \/ v245 \/ v238) /\ (v63 \/ v210 \/ v222 \/ v212) /\ (v62 \/ v283 \/ v305 \/ v285) /\ (v61 \/ v351 \/ v361 \/ v353) /\ (v52 \/ v293 \/ v315 \/ v295) /\ (~v58 \/ ~v49 \/ ~v59 \/ ~v54) /\ (v208 \/ v209 \/ v205 \/ v57) /\ (v208 \/ v209 \/ v125 \/ v57) /\ (v56 \/ v352 \/ v365 \/ v354) /\ (v59 \/ v95 \/ v87 \/ v96) /\ (v335 \/ v338 \/ v327 \/ v96) /\ (v346 \/ v406 \/ v408 \/ v409) /\ (v255 \/ v262 \/ v247 \/ v108) /\ (v255 \/ v262 \/ v260 \/ v108) /\ (v107 \/ v197 \/ v199 \/ v200) /\ (v115 \/ v282 \/ v299 \/ v284) /\ (v51 \/ v294 \/ v309 \/ v296) /\ (v356 \/ v360 \/ v357 \/ v216) /\ (v356 \/ v362 \/ v357 \/ v216) /\ (v356 \/ v360 \/ v359 \/ v216) /\ (v356 \/ v362 \/ v359 \/ v216) /\ (~v71 \/ ~v146 \/ ~v141 \/ ~v149) /\ (~v73 \/ ~v146 \/ ~v143 \/ ~v149) /\ (v240 \/ v244 \/ v241 \/ v134) /\ (v240 \/ v246 \/ v241 \/ v134) /\ (v240 \/ v244 \/ v243 \/ v134) /\ (v240 \/ v246 \/ v243 \/ v134) /\ (~v164 \/ ~v153 \/ ~v165 \/ ~v159) /\ (~v164 \/ ~v153 \/ ~v163 \/ ~v161) /\ (~v164 \/ ~v153 \/ ~v159 \/ ~v161) /\ (v100 \/ v102 \/ v101 \/ v99) /\ (v100 \/ v190 \/ v101 \/ v99) /\ (v100 \/ v102 \/ v201 \/ v99) /\ (v100 \/ v190 \/ v201 \/ v99) /\ (~v318 \/ ~v169 \/ ~v319 \/ ~v173) /\ (~v318 \/ ~v169 \/ ~v317 \/ ~v175) /\ (~v318 \/ ~v169 \/ ~v173 \/ ~v175) /\ (~v167 \/ ~v169 \/ ~v168 \/ ~v173) /\ (~v167 \/ ~v169 \/ ~v166 \/ ~v175) /\ (~v167 \/ ~v169 \/ ~v173 \/ ~v175) /\ (~v217 \/ ~v228 \/ ~v225 \/ ~v130) /\ (~v217 \/ ~v228 \/ ~v227 \/ ~v130) /\ (v339 \/ v345 \/ v344 \/ v70) /\ (v339 \/ v395 \/ v344 \/ v70) /\ (v339 \/ v345 \/ v399 \/ v70) /\ (v339 \/ v395 \/ v399 \/ v70) /\ (v387 \/ v384 \/ v388 \/ v79) /\ (v387 \/ v384 \/ v385 \/ v79) /\ (v67 \/ v76 \/ v71 \/ v74 \/ v138) /\ (v69 \/ v76 \/ v73 \/ v74 \/ v138) /\ (~v53 \/ ~v60 \/ ~v263 \/ ~v176 \/ ~v182) /\ (~v42 \/ ~v286 \/ ~v267 \/ ~v43 \/ ~v278) /\ (v60 \/ v65 \/ v122 \/ v117 \/ v127) /\ (v87 \/ v88 \/ v90 \/ v156 \/ v92))`;; let all_taut = [ (syn323_1, "syn323_1" ); (syn029_1, "syn029_1" ); (syn052_1 , "syn052_1" ); (syn051_1 , "syn051_1" ); (syn044_1 , "syn044_1" ); (syn011_1 , "syn011_1" ); (syn032_1 , "syn032_1" ); (ex2_be , "ex2_be" ); (syn030_1 , "syn030_1" ); (transp_be , "transp_be" ); (syn054_1 , "syn054_1" ); (gra001_1 , "gra001_1" ); (syn321_1 , "syn321_1" ); (rip02_be , "rip02_be" ); (puz014_1 , "puz014_1" ); (mjcg_yes , "mjcg_yes" ); (mul03_be , "mul03_be" ); (puz030_2 , "puz030_2" ); (puz030_1 , "puz030_1" ); (dk27_be , "dk27_be" ); (syn071_1 , "syn071_1" ); (aim_50_1_6_no_3 , "aim_50_1_6_no_3" ); (aim_50_1_6_no_4 , "aim_50_1_6_no_4" ); (hostint1_be , "hostint1_be" ); (aim_50_2_0_no_4 , "aim_50_2_0_no_4" ); (aim_50_2_0_no_1 , "aim_50_2_0_no_1" ); (aim_50_2_0_no_2 , "aim_50_2_0_no_2" ); (aim_50_2_0_no_3 , "aim_50_2_0_no_3" ); (mul_be , "mul_be" ); (dk17_be , "dk17_be" ); (risc_be , "risc_be" ); (msc006_1 , "msc006_1" ); (syn072_1 , "syn072_1" ); (aim_100_2_0_no_1 , "aim_100_2_0_no_1" ); (aim_100_2_0_no_2 , "aim_100_2_0_no_2" ); (prv001_1 , "prv001_1" ); (ssa0432_003 , "ssa0432_003" ); (jnh211 , "jnh211" ); (rip04_be , "rip04_be" ); (ztwaalf2_be , "ztwaalf2_be" ); (ztwaalf1_be , "ztwaalf1_be" ); (z4_be , "z4_be" ); (rip06_be , "rip06_be" ); (add1_be , "add1_be" ); (rip08_be , "rip08_be" ); (aim_50_1_6_no_1 , "aim_50_1_6_no_1" ); (aim_50_1_6_no_2 , "aim_50_1_6_no_2" ); (vg2_be , "vg2_be" ); (misg_be , "misg_be" ); (x1dn_be , "x1dn_be" ); (counter_be , "counter_be" ); (sqn_be , "sqn_be" ); (add2_be , "add2_be" ); (dc2_be , "dc2_be" ); (f51m_be , "f51m_be" ); (aim_100_1_6_no_3 , "aim_100_1_6_no_3 " ); (dubois20 , "dubois20 " ); (msc007_1_008, "msc007_1_008" ); (add3_be , "add3_be" ); (add4_be, "add4_be" ); (u5, "u5" )];; let TEST_TAUT TAUTCHECKER p = try let th = time TAUTCHECKER p in if hyp th = [] && concl th = p then true else failwith "Wrong theorem" with Sat_counterexample th -> if rand(rand(concl th)) = p then false else failwith "Wrong counterexample";; map (fun (p,s) -> print_string("Attempting "^s); print_newline(); s,TEST_TAUT SAT_PROVE p,TEST_TAUT ZSAT_PROVE p) all_taut;; hol-light/Minisat/zc2mso/000077500000000000000000000000001303454263000155665ustar00rootroot00000000000000hol-light/Minisat/zc2mso/README000066400000000000000000000042141303454263000164470ustar00rootroot00000000000000zc2mso.C contains code to translate proofs produced by zChaff to the proof format used by MiniSat 1.14p. To compile zChaff: ================== You need to make two changes to the zChaff source file "zchaff_solver.cpp" before the usual "make". (This is based on zchaff.2004.11.15, but will probably be the same or very similar in other versions.) 1. Uncomment (remove "//" from) the following line (about line 48) #define VERIFY_ON 2. Change the filename around line 51 from "resolve_trace" to "/tmp/resolve_trace", so it becomes: ofstream verify_out("/tmp/resolve_trace"); These will, respectively, make zChaff record a proof, and make it leave this proof in /tmp/resolve_trace instead of whatever the current directory is. To compile zc2mso: ================== Put zc2mso.C in some dir. Put symbolic links to (or copy) the following files from the Minisat 1.14p sources in the same dir: File.C File.h Global.h Proof.C Proof.h SolverTypes.h Sort.h Make sure zlib is installed on your system. Do: g++ -O3 File.C Proof.C zc2mso.C -lz -o zc2mso To use: ======= ./zc2mso input_DIMACS_problem.cnf -z input_zChaff_trace -m output_minisat_proof [-c] The -c option will invoke a (slow) proof checker after translating. This also reports the total number of resolutions in the output proof. To use from within HOL Light: ============================= First read ../README. Use the function ZSAT_TAUT_PROVE, which has exactly the same semantics as SAT_TAUT_PROVE, except that zChaff is invoked instead of Minisat, and an automatic zc2mso invocation is added on. The dir containing the zc2mso binary needs to be in the current path. The zchaff binary or a link to it (with zChaff compiled with proof production enabled) should be in the dir pointed to by the satdir variable defined on line 63 of ../Minisat/satTools.ml. Notes: ====== 1) The output proof contains all the initial causes but only the participating chains. 2) If "output_minisat_proof" already exists then the translator runs but in the end silently refuses to overwrite it. 3) The DIMACS parser and proof checker are copied from the Minisat 1.14p sources. Copyright notice included in zc2mso.C. hol-light/Minisat/zc2mso/zc2mso.C000066400000000000000000000432621303454263000171160ustar00rootroot00000000000000// version of zc2ms that works with original unmodified MiniSat 1.14p #include #include #include #include #include #include #include #include #include #include #include #include "Global.h" #include "Proof.h" #include #include "Sort.h" #include #include #include // Redfine if you want output to go somewhere else: #define reportf(format, args...) ( printf(format , ## args), fflush(stdout) ) using namespace std; enum enum_ty { ROOT, CL, VAR, CONF, DONE }; typedef vector > > parsed_clauses; // if first=0,1,2,3 then root,CL,VAR,CONF //================================================================================================= // DIMACS Parser: // DIMACS Parser and proof checker are from MiniSat 1.14p sources (MIT license reproduced below) /*****************************************************************************************[Proof.C] MiniSat -- Copyright (c) 2003-2005, Niklas Een, Niklas Sorensson Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. **************************************************************************************************/ #define CHUNK_LIMIT 1048576 const int WORD_LEN = 64000; class StreamBuffer { gzFile in; char buf[CHUNK_LIMIT]; int pos; int size; void assureLookahead() { if (pos >= size) { pos = 0; size = gzread(in, buf, sizeof(buf)); } } public: StreamBuffer(gzFile i) : in(i), pos(0), size(0) { assureLookahead(); } int operator * () { return (pos >= size) ? EOF : buf[pos]; } void operator ++ () { pos++; assureLookahead(); } }; template static void skipWhitespace(B& in) { while ((*in >= 9 && *in <= 13) || *in == 32) ++in; } template static void skipLine(B& in) { for (;;){ if (*in == EOF) return; if (*in == '\n') { ++in; return; } ++in; } } template static int parseInt(B& in) { int val = 0; bool neg = false; skipWhitespace(in); if (*in == '-') neg = true, ++in; else if (*in == '+') ++in; if (*in < '0' || *in > '9') fprintf(stderr, "PARSE ERROR! Unexpected char: %c\n", *in), exit(3); while (*in >= '0' && *in <= '9') val = val*10 + (*in - '0'), ++in; return neg ? -val : val; } template static void readClause(B& in, vector& lits, int& numvars) { int parsed_lit, var; lits.clear(); for (;;){ parsed_lit = parseInt(in); if (parsed_lit == 0) break; var = abs(parsed_lit)-1; while (var >= numvars) numvars++; lits.push_back( (parsed_lit > 0) ? var+var : var+var+1 ); } } void vi2vl(const vector& vi, vec& vl) { int vsz = vi.size(); for (int ii=0;ii>1,vi[ii]&1)); } template static void parse_DIMACS_main(Proof& P, vec >& clauses, B& in, parsed_clauses* pclauses, map& units, int& numvars, int& numclauses) { vector lits; bool skip; for (;;){ skip = false; skipWhitespace(in); if (*in == EOF) break; else if (*in == 'c' || *in == 'p') skipLine(in); else { readClause(in, lits, numvars); sort(lits.begin(),lits.end()); lits.erase(unique(lits.begin(),lits.end()),lits.end()); //sortUnique(lits); for (int i = 0; i < lits.size()-1; i++) // skip trivial clause if (lits[i] == ((lits[i+1])^1)) { skip=true; break; } if (!skip) { if (lits.size()==1) units.insert(make_pair(Lit(lits[0]>>1,lits[0]&1),numclauses)); pclauses->push_back(make_pair(ROOT,lits)); vec Lits; vi2vl(lits,Lits); clauses.push(); Lits.copyTo(clauses.last()); P.addRoot(Lits); numclauses++; } } } } // Inserts problem into solver. // static void parse_DIMACS(Proof& P, vec >& clauses, gzFile input_stream, parsed_clauses* pclauses, map& units, int& numvars, int& numclauses) { StreamBuffer in(input_stream); parse_DIMACS_main(P, clauses, in, pclauses, units, numvars, numclauses); } // Simplistic proof-checker -- just to illustrate the use of 'ProofTraverser': //#include "Sort.h" static void resolve(vec& main, vec& other, Var x) { Lit p; bool ok1 = false, ok2 = false; for (int i = 0; i < main.size(); i++){ if (var(main[i]) == x){ ok1 = true, p = main[i]; main[i] = main.last(); main.pop(); break; } } for (int i = 0; i < other.size(); i++){ if (var(other[i]) != x) main.push(other[i]); else{ if (p != ~other[i]) printf("PROOF ERROR! Resolved on variable with SAME polarity in both clauses: %d\n", x+1); ok2 = true; } } if (!ok1 || !ok2) printf("PROOF ERROR! Resolved on missing variable: %d\n", x+1); sortUnique(main); } struct Checker : public ProofTraverser { vec > clauses; int res_count; Checker() { res_count = 0; } void root (const vec& c) { /*printf("%d: ROOT", clauses.size()); for (int i = 0; i < c.size(); i++) printf(" %s%d", sign(c[i])?"-":"", var(c[i])+1); printf("\n");*/ clauses.push(); c.copyTo(clauses.last()); } void chain (const vec& cs, const vec& xs) { /*printf("%d: CHAIN %d", clauses.size(), cs[0]); for (int i = 0; i < xs.size(); i++) printf(" [%d] %d", xs[i]+1, cs[i+1]);*/ clauses.push(); vec& c = clauses.last(); clauses[cs[0]].copyTo(c); res_count+=xs.size(); for (int i = 0; i < xs.size(); i++) resolve(c, clauses[cs[i+1]], xs[i]); /*printf(" =>"); for (int i = 0; i < c.size(); i++) printf(" %s%d", sign(c[i])?"-":"", var(c[i])+1); printf("\n");*/ } void deleted(ClauseId c) { clauses[c].clear(); } }; void checkProof(Proof* proof, ClauseId goal = ClauseId_NULL) { Checker trav; proof->traverse(trav, goal); vec& c = trav.clauses.last(); printf("Final clause:"); if (c.size() == 0) printf(" \n"); else{ for (int i = 0; i < c.size(); i++) printf(" %s%d", sign(c[i])?"-":"", var(c[i])+1); printf("\n"); } printf("Inferences: %d\n",trav.res_count); } //MIT license ends here //================================================================================================= //========================================================================================== // zChaff trace parsing // Follows Tjark Weber's documentation of the zChaff proof format (TPHOLs2005, track B) void parse_zChaff(char * filename, int& numclauses, parsed_clauses* pclauses, vector& vars) { ifstream fin(filename); if (!fin) { cerr << "Error opening zChaff trace file " << filename << endl; exit(1); } istringstream iss; string line,stok; int itok; while (!fin.eof()) { getline(fin,line); iss.clear(); iss.str(line); iss >> stok; if (stok=="CL:") { iss >> itok; //clause id set by zChaff is ignored iss >> stok; assert(stok=="<="); vector resolvents; while (!iss.eof()) { iss >> itok; resolvents.push_back(itok); } pclauses->push_back(make_pair(CL,resolvents)); numclauses++; } else if (stok=="VAR:") { int vid; iss >> vid; iss >> stok; assert(stok=="L:"); int level; iss >> level; iss >> stok; assert(stok=="V:"); int value; iss >> value; assert((value ==0) || (value==1)); iss >> stok; assert(stok=="A:"); int ante; iss >> ante; // we don't parse the rest of the line vars[vid-1] = pclauses->size(); vector varv; varv.push_back(((vid-1)<<1)|(value?0:1)); varv.push_back(ante); varv.push_back(level); pclauses->push_back(make_pair(VAR,varv)); numclauses++; } else if (stok=="CONF:") { int conf_id; iss >> conf_id; // we don't parse the rest of the line vector confv; confv.push_back(conf_id); pclauses->push_back(make_pair(CONF,confv)); numclauses++; } else { cerr << "Unrecognized token\n"; exit(1); } } } //========================================================================================== void printProofStats() { double cpu_time = cpuTime(); int64 mem_used = memUsed(); if (mem_used!= 0) reportf("Memory used : %.2f MB\n", (mem_used)/1048576.0); reportf("CPU time : %g s\n", (cpu_time)); } //========================================================================================== // zChaff to MiniSat translation functions // Follows Tjark Weber's documentation of the zChaff proof format (TPHOLs2005, track B) class Z2M { vector vartmp; vector lu; vector c2c; Proof& P; vec >& clauses; map& units; vector& vars; const int numclauses; const int numvars; parsed_clauses& pclauses; void update(vector& ps, int lit, vector& r1) { int flag = vartmp[lit>>1]; if (flag==-1) { // lit not seen yet r1.push_back(lit); vartmp[lit>>1] = lit; lu.push_back(lit>>1); } else if (flag==(lit^1)) { // seen and now seen with opp sign: piv "second" occ vartmp[lit>>1]=lit; // switch vartmp to "second" occurrence ps.push_back(flag>>1); // record pivot in ps } } // calculate learnt clause, and fill in list of pivot vars void get_res(const vector& resolvents, vec& res, vector& ps) { vector r1; int rsz = resolvents.size(); for (int ii=0;ii& cc = clauses[c2c[resolvents[ii]]]; int csz = cc.size(); for (int jj=0;jj>1]^1)==lit) continue; // a "first" occ of pivot res.push(Lit(lit>>1,lit&1)); } int lsz = lu.size(); for (int ii=0;ii& resolvents, int ci) { vec res; vector ps; // pivots get_res(resolvents,res,ps); assert(ps.size()==resolvents.size()-1); P.beginChain(c2c[resolvents[0]]); for (int ii=1; ii& lits = clauses[c2c[ante]]; Lit p(vid,sgn); P.beginChain(c2c[ante]); for (int i=0; i::iterator iter = units.find(~lits[i]); assert(iter!=units.end()); P.resolve(c2c[iter->second], var(lits[i])); } int idx = P.endChain(); assert(idx==clauses.size()); units.insert(make_pair(p,ci)); clauses.push(); clauses.last().push(p); return idx; } // create minisat chain for "CONF" line of zChaff proof trace // this is more or less the same as writeVChain, except // that instead of deriving a unit clause we derive empty void addCChain(int conf_id) { vec& lits = clauses[c2c[conf_id]]; P.beginChain(c2c[conf_id]); for (int i=0; i::iterator iter = units.find(~lits[i]); assert(iter!=units.end()); P.resolve(c2c[iter->second], var(lits[i])); } P.endChain(); } void addRoot(int ci) { c2c[ci] = ci; pclauses[ci].first=DONE; } void build_clause(int ci) { pair >& clause_info = pclauses[ci]; vector& resolvents = clause_info.second; int rsz = resolvents.size(); for (int ii=0;ii >& clause_info = pclauses[ci]; int lit = clause_info.second[0]; int ante = clause_info.second[1]; build(ante); if (clauses[c2c[ante]].size()==1) { pclauses[ci].first=DONE; return; }; vec cc; clauses[c2c[ante]].copyTo(cc); vector > levels; for (int ii=0;ii>1, (bool)(lit&1), ante, ci); pclauses[ci].first=DONE; } // ci is index in pclauses void build(int ci) { switch (pclauses[ci].first) { case ROOT: addRoot(ci); break; case CL: build_clause(ci); break; case VAR: build_var(ci); break; case DONE: break; default: cerr << "build default\n"; exit(1); } } public: Z2M(Proof& P_,vec >& clauses_,map& units_, vector& vars_, int numclauses_, int numvars_, parsed_clauses& pclauses_) : P(P_), clauses(clauses_), units(units_), vars(vars_),numclauses(numclauses_),numvars(numvars_), pclauses(pclauses_), vartmp(numvars_,-1), c2c(pclauses_.size(),-1) {} void build_clauses() { pair >& clause_info = pclauses.back(); int conf_id = clause_info.second[0]; build(conf_id); vec cc; clauses[c2c[conf_id]].copyTo(cc); vector > levels; for (int ii=0;ii= argc) fprintf(stderr, "ERROR! Missing filename after '-m' option.\n"); proof = argv[i]; break; case 'z': i++; if (i >= argc) fprintf(stderr, "ERROR! Missing filename after '-z' option.\n"); zchaff = argv[i]; break; } } } Proof P; // minisat proof ADT vec > clauses; // clause database map units; // map literal to corresponding unit clause id, if any int numvars = 0, numclauses = 0, conf_id; parsed_clauses* pclauses = new parsed_clauses(); // first read CNF from original file and add to proof gzFile in = (input == NULL) ? gzdopen(0, "rb") : gzopen(input, "rb"); parse_DIMACS(P, clauses, in, pclauses, units, numvars, numclauses); gzclose(in); // then read resolvents from zchaff trace vector vars(numvars); // vars[i] is pclauses idx for variable i parse_zChaff(zchaff, numclauses, pclauses, vars); // finally translate to minisat format Z2M translator(P,clauses,units,vars,numclauses,numvars,*pclauses); translator.build_clauses(); // (check) and save proof delete pclauses; Proof* current = &P; if (check) { // quick check reportf("Checking proof...\n"); checkProof(current); } if (proof != NULL) current->save(proof); // save it printProofStats(); return 0; } hol-light/Mizarlight/000077500000000000000000000000001303454263000150575ustar00rootroot00000000000000hol-light/Mizarlight/Makefile000066400000000000000000000006701303454263000165220ustar00rootroot00000000000000# # Syntax extensions to support Mizar Light: new infix operators # # Build the camlp4 syntax extension file pa_f.cmo: pa_f.ml; if test `ocamlc -version | cut -c1-3` = "3.0" ; \ then ocamlc -c -pp "camlp4r pa_extend.cmo q_MLast.cmo" -I +camlp4 pa_f.ml; \ else ocamlc -c -pp "camlp5r pa_lexer.cmo pa_extend.cmo q_MLast.cmo" -I +camlp5 pa_f.ml; \ fi clean:; rm -f pa_f.cmi pa_f.cmo hol-light/Mizarlight/duality.ml000066400000000000000000000240461303454263000170720ustar00rootroot00000000000000(* ========================================================================= *) (* Mizar Light proof of duality in projective geometry. *) (* ========================================================================= *) current_prover := standard_prover;; (* ------------------------------------------------------------------------- *) (* Axioms for projective geometry. *) (* ------------------------------------------------------------------------- *) parse_as_infix("ON",(11,"right"));; let projective = new_definition `projective((ON):Point->Line->bool) <=> (!p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l) /\ (!l l'. ?p. p ON l /\ p ON l') /\ (?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l)) /\ (!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON l /\ p' ON l /\ p'' ON l)`;; (* ------------------------------------------------------------------------- *) (* To get round extreme slowness of MESON for one situation. *) (* ------------------------------------------------------------------------- *) let USE_PROJ_TAC [prth; proj_def] = REWRITE_TAC[REWRITE_RULE[proj_def] prth];; (* ------------------------------------------------------------------------- *) (* The main result, via two lemmas. *) (* ------------------------------------------------------------------------- *) let LEMMA_1 = theorem "!(ON):Point->Line->bool. projective(ON) ==> !p. ?l. p ON l" [fix ["(ON):Point->Line->bool"]; assume "projective(ON)" at 0; have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" at 1 from [0] by [projective] using USE_PROJ_TAC; have "?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" at 3 from [0] by [projective] using USE_PROJ_TAC; fix ["p:Point"]; consider ["q:Point"; "q':Point"] st "~(q = q')" from [3]; so have "~(p = q) \/ ~(p = q')"; so consider ["l:Line"] st "p ON l" from [1]; take ["l"]; qed];; let LEMMA_2 = theorem "!(ON):Point->Line->bool. projective(ON) ==> !p1 p2 q l l1 l2. p1 ON l /\\ p2 ON l /\\ p1 ON l1 /\\ p2 ON l2 /\\ q ON l2 /\\ ~(q ON l) /\\ ~(p1 = p2) ==> ~(l1 = l2)" [fix ["(ON):Point->Line->bool"]; assume "projective(ON)" at 0; have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" at 1 from [0] by [projective] using USE_PROJ_TAC; fix ["p1:Point"; "p2:Point"; "q:Point"; "l:Line"; "l1:Line"; "l2:Line"]; assume "p1 ON l" at 5; assume "p2 ON l" at 6; assume "p1 ON l1" at 7; assume "p2 ON l2" at 9; assume "q ON l2" at 10; assume "~(q ON l)" at 11; assume "~(p1 = p2)" at 12; assume "l1 = l2" at 13; so have "p1 ON l2" from [7]; so have "l = l2" from [1;5;6;9;12]; hence contradiction from [10;11]];; let PROJECTIVE_DUALITY = theorem "!(ON):Point->Line->bool. projective(ON) ==> projective (\l p. p ON l)" [fix ["(ON):Point->Line->bool"]; assume "projective(ON)" at 0; have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" at 1 from [0] by [projective] using USE_PROJ_TAC; have "!l l'. ?p. p ON l /\\ p ON l'" at 2 from [0] by [projective] using USE_PROJ_TAC; have "?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" at 3 from [0] by [projective] using USE_PROJ_TAC; have "!l. ?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ p ON l /\\ p' ON l /\\ p'' ON l" at 4 from [0] by [projective] using USE_PROJ_TAC; (* dual of axiom 1 *) have "!l1 l2. ~(l1 = l2) ==> ?!p. p ON l1 /\\ p ON l2" at 5 proof [fix ["l1:Line"; "l2:Line"]; assume "~(l1 = l2)" at 6; consider ["p:Point"] st "p ON l1 /\\ p ON l2" at 7 from [2]; have "!p'. p' ON l1 /\\ p' ON l2 ==> (p' = p)" proof [fix ["p':Point"]; assume "p' ON l1 /\\ p' ON l2" at 8; assume "~(p' = p)"; so have "l1 = l2" from [1;7;8]; hence contradiction from [6]]; qed from [7]]; (* dual of axiom 2 *) have "!p1 p2. ?l. p1 ON l /\\ p2 ON l" at 9 proof [fix ["p1:Point"; "p2:Point"]; per cases [[suppose "p1 = p2"; qed from [0] by [LEMMA_1]]; [suppose "~(p1 = p2)"; qed from [1]]]]; (* dual of axiom 3 *) have "?l1 l2 l3. ~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3) /\\ ~(?p. p ON l1 /\\ p ON l2 /\\ p ON l3)" at 10 proof [consider ["p1:Point"; "p2:Point"; "p3:Point"] st "~(p1 = p2) /\\ ~(p2 = p3) /\\ ~(p1 = p3) /\\ ~(?l. p1 ON l /\\ p2 ON l /\\ p3 ON l)" from [3] at 11; have "~(p1 = p3)" from [11]; so consider ["l1:Line"] st "p1 ON l1 /\\ p3 ON l1 /\\ !l'. p1 ON l' /\\ p3 ON l' ==> (l1 = l')" from [1] at 12; have "~(p2 = p3)" from [11]; so consider ["l2:Line"] st "p2 ON l2 /\\ p3 ON l2 /\\ !l'. p2 ON l' /\\ p3 ON l' ==> (l2 = l')" from [1] at 13; have "~(p1 = p2)" from [11]; so consider ["l3:Line"] st "p1 ON l3 /\\ p2 ON l3 /\\ !l'. p1 ON l' /\\ p2 ON l' ==> (l3 = l')" from [1] at 14; take ["l1"; "l2"; "l3"]; thus "~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3)" from [11;12;13;14] at 15; assume "?q. q ON l1 /\\ q ON l2 /\\ q ON l3"; so consider ["q:Point"] st "q ON l1 /\\ q ON l2 /\\ q ON l3"; so have "(p1 = q) /\\ (p2 = q) /\\ (p3 = q)" from [5;12;13;14;15]; hence contradiction from [11]]; (* dual of axiom 4 *) have "!p0. ?l0 L1 L2. ~(l0 = L1) /\\ ~(L1 = L2) /\\ ~(l0 = L2) /\\ p0 ON l0 /\\ p0 ON L1 /\\ p0 ON L2" proof [fix ["p0:Point"]; consider ["l0:Line"] st "p0 ON l0" from [0] by [LEMMA_1] at 16; consider ["p:Point"] st "~(p = p0) /\\ p ON l0" from [4] at 17; consider ["q:Point"] st "~(q ON l0)" from [3] at 18; so consider ["l1:Line"] st "p ON l1 /\\ q ON l1" from [1;16] at 19; consider ["r:Point"] st "r ON l1 /\\ ~(r = p) /\\ ~(r = q)" at 20 proof [consider ["r1:Point"; "r2:Point"; "r3:Point"] st "~(r1 = r2) /\\ ~(r2 = r3) /\\ ~(r1 = r3) /\\ r1 ON l1 /\\ r2 ON l1 /\\ r3 ON l1" from [4] at 21; so have "~(r1 = p) /\\ ~(r1 = q) \/ ~(r2 = p) /\\ ~(r2 = q) \/ ~(r3 = p) /\\ ~(r3 = q)"; qed from [21]]; have "~(p0 ON l1)" at 22 proof [assume "p0 ON l1"; so have "l1 = l0" from [1;16;17;19]; qed from [18;19]]; so have "~(p0 = r)" from [20]; so consider ["L1:Line"] st "r ON L1 /\\ p0 ON L1" from [1] at 23; consider ["L2:Line"] st "q ON L2 /\\ p0 ON L2" from [1;16;18] at 24; take ["l0"; "L1"; "L2"]; thus "~(l0 = L1)" from [0;17;19;20;22;23] by [LEMMA_2]; thus "~(L1 = L2)" from [0;19;20;22;23;24] by [LEMMA_2]; thus "~(l0 = L2)" from [18;24]; thus "p0 ON l0 /\\ p0 ON L2 /\\ p0 ON L1" from [16;24;23]]; qed from [5;9;10] by [projective]];; current_prover := sketch_prover;; let PROJECTIVE_DUALITY = theorem "!(ON):Point->Line->bool. projective(ON) = projective (\l p. p ON l)" [have "!(ON):Point->Line->bool. projective(ON) ==> projective (\l p. p ON l)" proof [fix ["(ON):Point->Line->bool"]; assume "projective(ON)"; have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" at 1; have "!l l'. ?p. p ON l /\\ p ON l'" at 2; have "?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" at 3; have "!l. ?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ p ON l /\\ p' ON l /\\ p'' ON l" at 4; (* dual of axiom 1 *) have "!l1 l2. ~(l1 = l2) ==> ?!p. p ON l1 /\\ p ON l2" proof [fix ["l1:Line"; "l2:Line"]; otherwise have "?p p'. ~(l1 = l2) /\\ ~(p = p') /\\ p ON l1 /\\ p' ON l1 /\\ p ON l2 /\\ p' ON l2"; so have "l1 = l2" from [1]; hence contradiction]; (* dual of axiom 2 *) have "!p1 p2. ?l. p1 ON l /\\ p2 ON l" proof [fix ["p1:Point"; "p2:Point"]; qed from [1]]; (* dual of axiom 3 *) have "?l1 l2 l3. ~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3) /\\ ~(?p. p ON l1 /\\ p ON l2 /\\ p ON l3)" proof [consider ["p1:Point"; "p2:Point"; "p3:Point"] st "~(p1 = p2) /\\ ~(p2 = p3) /\\ ~(p1 = p3) /\\ ~(?l. p1 ON l /\\ p2 ON l /\\ p3 ON l)" from [3]; consider ["l1:Line"] st "p1 ON l1 /\\ p3 ON l1 /\\ !l'. p1 ON l' /\\ p3 ON l' ==> (l1 = l')" from [1]; consider ["l2:Line"] st "p2 ON l2 /\\ p3 ON l2 /\\ !l'. p2 ON l' /\\ p3 ON l' ==> (l2 = l')" from [1]; consider ["l3:Line"] st "p1 ON l3 /\\ p2 ON l3 /\\ !l'. p1 ON l' /\\ p2 ON l' ==> (l3 = l')" from [1]; take ["l1"; "l2"; "l3"]; thus "~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3)"; assume "?q. q ON l1 /\\ q ON l2 /\\ q ON l3"; so consider ["q:Point"] st "q ON l1 /\\ q ON l2 /\\ q ON l3"; have "(q = p1) \/ (q = p2) \/ (q = p3)"; so have "p1 ON l2 \/ p2 ON l1 \/ p3 ON l3"; hence contradiction]; (* dual of axiom 4 *) have "!O. ?OP OQ OR. ~(OP = OQ) /\\ ~(OQ = OR) /\\ ~(OP = OR) /\\ O ON OP /\\ O ON OQ /\\ O ON OR" proof [fix ["O:Point"]; consider ["OP:Line"] st "O ON OP"; consider ["P:Point"] st "~(P = O) /\\ P ON OP"; have "?Q:Point. ~(Q ON OP)" proof [otherwise have "!Q:Point. Q ON OP"; so have "~(?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ ~(?l. p ON l /\\ p' ON l /\\ p'' ON l))"; hence contradiction from [3]]; so consider ["Q:Point"] st "~(Q ON OP)"; consider ["l:Line"] st "P ON l /\\ Q ON l" from [1]; consider ["R:Point"] st "R ON l /\\ ~(R = P) /\\ ~(R = Q)" from [4]; have "~(P = Q) /\\ ~(R = P) /\\ ~(R = Q)"; consider ["OQ:Line"] st "O ON OQ /\\ Q ON OQ"; consider ["OR:Line"] st "O ON OR /\\ R ON OR"; take ["OP"; "OQ"; "OR"]; thus "~(OP = OQ)" proof [otherwise have "OP = OQ"; hence contradiction]; thus "~(OQ = OR)"; thus "~(OP = OR)"; thus "O ON OP /\\ O ON OQ /\\ O ON OR"]; qed]; have "!(ON):Point->Line->bool. projective (\l p. p ON l) ==> projective(ON)"; qed];; hol-light/Mizarlight/duality_holby.ml000066400000000000000000000247131303454263000202700ustar00rootroot00000000000000(* ========================================================================= *) (* Mizar Light proof of duality in projective geometry. *) (* ========================================================================= *) let holby_prover = fun ths (asl,w as gl) -> ACCEPT_TAC(HOL_BY ths w) gl;; current_prover := holby_prover;; (* ------------------------------------------------------------------------- *) (* To avoid adding any axioms, pick a simple model: the Fano plane. *) (* ------------------------------------------------------------------------- *) let Line_INDUCT,Line_RECURSION = define_type "Line = Line_1 | Line_2 | Line_3 | Line_4 | Line_5 | Line_6 | Line_7";; let Point_INDUCT,Point_RECURSION = define_type "Point = Point_1 | Point_2 | Point_3 | Point_4 | Point_5 | Point_6 | Point_7";; let Point_DISTINCT = distinctness "Point";; let Line_DISTINCT = distinctness "Line";; let fano_incidence = [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; let fano_point i = mk_const("Point_"^string_of_int i,[]) and fano_line i = mk_const("Line_"^string_of_int i,[]);; let p = `p:Point` and l = `l:Line` ;; let fano_clause (i,j) = mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; (* ------------------------------------------------------------------------- *) (* Define the incidence relation "ON" from "fano_incidence" *) (* ------------------------------------------------------------------------- *) parse_as_infix("ON",(11,"right"));; let ON = new_definition `(p:Point) ON (l:Line) <=> (p = Point_1 /\ l = Line_1) \/ (p = Point_1 /\ l = Line_2) \/ (p = Point_1 /\ l = Line_3) \/ (p = Point_2 /\ l = Line_1) \/ (p = Point_2 /\ l = Line_4) \/ (p = Point_2 /\ l = Line_5) \/ (p = Point_3 /\ l = Line_1) \/ (p = Point_3 /\ l = Line_6) \/ (p = Point_3 /\ l = Line_7) \/ (p = Point_4 /\ l = Line_2) \/ (p = Point_4 /\ l = Line_4) \/ (p = Point_4 /\ l = Line_6) \/ (p = Point_5 /\ l = Line_2) \/ (p = Point_5 /\ l = Line_5) \/ (p = Point_5 /\ l = Line_7) \/ (p = Point_6 /\ l = Line_3) \/ (p = Point_6 /\ l = Line_4) \/ (p = Point_6 /\ l = Line_7) \/ (p = Point_7 /\ l = Line_3) \/ (p = Point_7 /\ l = Line_5) \/ (p = Point_7 /\ l = Line_6)`;; (* ------------------------------------------------------------------------- *) (* Also produce a more convenient case-by-case rewrite. *) (* ------------------------------------------------------------------------- *) let ON_CLAUSES = prove (`(Point_1 ON Line_1 <=> T) /\ (Point_1 ON Line_2 <=> T) /\ (Point_1 ON Line_3 <=> T) /\ (Point_1 ON Line_4 <=> F) /\ (Point_1 ON Line_5 <=> F) /\ (Point_1 ON Line_6 <=> F) /\ (Point_1 ON Line_7 <=> F) /\ (Point_2 ON Line_1 <=> T) /\ (Point_2 ON Line_2 <=> F) /\ (Point_2 ON Line_3 <=> F) /\ (Point_2 ON Line_4 <=> T) /\ (Point_2 ON Line_5 <=> T) /\ (Point_2 ON Line_6 <=> F) /\ (Point_2 ON Line_7 <=> F) /\ (Point_3 ON Line_1 <=> T) /\ (Point_3 ON Line_2 <=> F) /\ (Point_3 ON Line_3 <=> F) /\ (Point_3 ON Line_4 <=> F) /\ (Point_3 ON Line_5 <=> F) /\ (Point_3 ON Line_6 <=> T) /\ (Point_3 ON Line_7 <=> T) /\ (Point_4 ON Line_1 <=> F) /\ (Point_4 ON Line_2 <=> T) /\ (Point_4 ON Line_3 <=> F) /\ (Point_4 ON Line_4 <=> T) /\ (Point_4 ON Line_5 <=> F) /\ (Point_4 ON Line_6 <=> T) /\ (Point_4 ON Line_7 <=> F) /\ (Point_5 ON Line_1 <=> F) /\ (Point_5 ON Line_2 <=> T) /\ (Point_5 ON Line_3 <=> F) /\ (Point_5 ON Line_4 <=> F) /\ (Point_5 ON Line_5 <=> T) /\ (Point_5 ON Line_6 <=> F) /\ (Point_5 ON Line_7 <=> T) /\ (Point_6 ON Line_1 <=> F) /\ (Point_6 ON Line_2 <=> F) /\ (Point_6 ON Line_3 <=> T) /\ (Point_6 ON Line_4 <=> T) /\ (Point_6 ON Line_5 <=> F) /\ (Point_6 ON Line_6 <=> F) /\ (Point_6 ON Line_7 <=> T) /\ (Point_7 ON Line_1 <=> F) /\ (Point_7 ON Line_2 <=> F) /\ (Point_7 ON Line_3 <=> T) /\ (Point_7 ON Line_4 <=> F) /\ (Point_7 ON Line_5 <=> T) /\ (Point_7 ON Line_6 <=> T) /\ (Point_7 ON Line_7 <=> F)`, REWRITE_TAC[ON; Line_DISTINCT; Point_DISTINCT]);; (* ------------------------------------------------------------------------- *) (* Case analysis theorems. *) (* ------------------------------------------------------------------------- *) let FORALL_POINT = prove (`(!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ P Point_5 /\ P Point_6 /\ P Point_7`, EQ_TAC THEN REWRITE_TAC[Point_INDUCT] THEN SIMP_TAC[]);; let EXISTS_POINT = prove (`(?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ P Point_5 \/ P Point_6 \/ P Point_7`, MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_POINT]);; let FORALL_LINE = prove (`(!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ P Line_5 /\ P Line_6 /\ P Line_7`, EQ_TAC THEN REWRITE_TAC[Line_INDUCT] THEN SIMP_TAC[]);; let EXISTS_LINE = prove (`(?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ P Line_5 \/ P Line_6 \/ P Line_7`, MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_LINE]);; (* ------------------------------------------------------------------------- *) (* Hence prove the axioms by a naive case split (a bit slow but easy). *) (* ------------------------------------------------------------------------- *) let FANO_TAC = GEN_REWRITE_TAC DEPTH_CONV [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN GEN_REWRITE_TAC DEPTH_CONV (basic_rewrites() @ [ON_CLAUSES; Point_DISTINCT; Line_DISTINCT]);; let AXIOM_1 = time prove (`!p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ !l'. p ON l' /\ p' ON l' ==> (l' = l)`, FANO_TAC);; let AXIOM_2 = time prove (`!l l'. ?p. p ON l /\ p ON l'`, FANO_TAC);; let AXIOM_3 = time prove (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l)`, FANO_TAC);; let AXIOM_4 = time prove (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON l /\ p' ON l /\ p'' ON l`, FANO_TAC);; (* ------------------------------------------------------------------------- *) (* Now the interesting bit. *) (* ------------------------------------------------------------------------- *) let AXIOM_1' = theorem "!p p' l l'. ~(p = p') /\\ p ON l /\\ p' ON l /\\ p ON l' /\\ p' ON l' ==> (l' = l)" [fix ["p:Point"; "p':Point"; "l:Line"; "l':Line"]; assume "~(p = p') /\\ p ON l /\\ p' ON l /\\ p ON l' /\\ p' ON l'" at 1; consider ["l1:Line"] st "p ON l1 /\\ p' ON l1 /\\ !l'. p ON l' /\\ p' ON l' ==> (l' = l1)" from [1] by [AXIOM_1] at 2; have "l = l1" from [1;2]; so have "... = l'" from [1;2]; qed];; let LEMMA_1 = theorem "!O. ?l. O ON l" [consider ["p:Point"; "p':Point"; "p'':Point"] st "~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" by [AXIOM_3] at 1; fix ["O:Point"]; have "~(p = O) \/ ~(p' = O)" from [1]; so consider ["P:Point"] st "~(P = O)" at 2; consider ["l:Line"] st "O ON l /\\ P ON l /\\ !l'. O ON l' /\\ P ON l' ==> (l' = l)" from [2] by [AXIOM_1] at 3; thus "?l. O ON l" from [3]];; let DUAL_1 = theorem "!l l'. ~(l = l') ==> ?p. p ON l /\\ p ON l' /\\ !p'. p' ON l /\\ p' ON l' ==> (p' = p)" [otherwise consider ["l:Line"; "l':Line"] st "~(l = l') /\\ !p. p ON l /\\ p ON l' ==> ?p'. p' ON l /\\ p' ON l' /\\ ~(p' = p)" at 1; consider ["p:Point"] st "p ON l /\\ p ON l'" by [AXIOM_2] at 2; consider ["p':Point"] st "p' ON l /\\ p' ON l' /\\ ~(p' = p)" from [1;2] at 3; hence contradiction from [1;2] by [AXIOM_1']];; let DUAL_2 = theorem "!p p'. ?l. p ON l /\\ p' ON l" [fix ["p:Point"; "p':Point"]; have "?l. p ON l" by [LEMMA_1] at 1; have "(p = p') \/ ?l. p ON l /\\ p' ON l /\\ !l'. p ON l' /\\ p' ON l' ==> (l' = l)" by [AXIOM_1]; hence thesis from [1]];; let DUAL_3 = theorem "?l1 l2 l3. ~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3) /\\ ~(?p. p ON l1 /\\ p ON l2 /\\ p ON l3)" [consider ["p1:Point"; "p2:Point"; "p3:Point"] st "~(p1 = p2) /\\ ~(p2 = p3) /\\ ~(p1 = p3) /\\ ~(?l. p1 ON l /\\ p2 ON l /\\ p3 ON l)" by [AXIOM_3] at 1; consider ["l1:Line"] st "p1 ON l1 /\\ p3 ON l1" by [DUAL_2] at 2; consider ["l2:Line"] st "p2 ON l2 /\\ p3 ON l2" by [DUAL_2] at 3; consider ["l3:Line"] st "p1 ON l3 /\\ p2 ON l3" by [DUAL_2] at 4; take ["l1"; "l2"; "l3"]; thus "~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3)" from [1;2;3;4] at 5; otherwise consider ["q:Point"] st "q ON l1 /\\ q ON l2 /\\ q ON l3" at 6; consider ["q':Point"] st "q' ON l1 /\\ q' ON l3 /\\ !p'. p' ON l1 /\\ p' ON l3 ==> (p' = q')" from [5] by [DUAL_1] at 7; have "q = q'" from [6;7]; so have "... = p1" from [2;4;7]; hence contradiction from [1;3;6]];; let DUAL_4 = theorem "!O. ?OP OQ OR. ~(OP = OQ) /\\ ~(OQ = OR) /\\ ~(OP = OR) /\\ O ON OP /\\ O ON OQ /\\ O ON OR" [fix ["O:Point"]; consider ["OP:Line"] st "O ON OP" by [LEMMA_1] at 1; consider ["p:Point"; "p':Point"; "p'':Point"] st "~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ p ON OP /\\ p' ON OP /\\ p'' ON OP" by [AXIOM_4] at 2; have "~(p = O) \/ ~(p' = O)" from [2]; so consider ["P:Point"] st "~(P = O) /\\ P ON OP" from [2] at 3; consider ["q:Point"; "q':Point"; "q'':Point"] st "~(q = q') /\\ ~(q' = q'') /\\ ~(q = q'') /\\ ~(?l. q ON l /\\ q' ON l /\\ q'' ON l)" by [AXIOM_3] at 4; have "~(q ON OP) \/ ~(q' ON OP) \/ ~(q'' ON OP)" from [4]; so consider ["Q:Point"] st "~(Q ON OP)" at 5; consider ["l:Line"] st "P ON l /\\ Q ON l" by [DUAL_2] at 6; consider ["r:Point"; "r':Point"; "r'':Point"] st "~(r = r') /\\ ~(r' = r'') /\\ ~(r = r'') /\\ r ON l /\\ r' ON l /\\ r'' ON l" by [AXIOM_4] at 7; have "((r = P) \/ (r = Q) \/ ~(r = P) /\\ ~(r = Q)) /\\ ((r' = P) \/ (r' = Q) \/ ~(r' = P) /\\ ~(r' = Q))"; so consider ["R:Point"] st "R ON l /\\ ~(R = P) /\\ ~(R = Q)" from [7] at 8; consider ["OQ:Line"] st "O ON OQ /\\ Q ON OQ" by [DUAL_2] at 9; consider ["OR:Line"] st "O ON OR /\\ R ON OR" by [DUAL_2] at 10; take ["OP"; "OQ"; "OR"]; have "~(O ON l)" from [1;3;5;6] by [AXIOM_1']; hence "~(OP = OQ) /\\ ~(OQ = OR) /\\ ~(OP = OR) /\\ O ON OP /\\ O ON OQ /\\ O ON OR" from [1;3;5;6;8;9;10] by [AXIOM_1']];; hol-light/Mizarlight/make.ml000066400000000000000000000043311303454263000163270ustar00rootroot00000000000000(* ========================================================================= *) (* "Mizar Light" by Freek Wiedijk. *) (* *) (* http://www.cs.ru.nl/~freek/mizar/miz.pdf *) (* ========================================================================= *) exception Innergoal of goal;; let (GOAL_TAC:tactic) = fun gl -> raise(Innergoal gl);; let e tac = try refine(by(VALID tac)) with Innergoal gl -> let oldgoalstack = !current_goalstack in current_goalstack := (mk_goalstate gl)::oldgoalstack; !current_goalstack;; (* ------------------------------------------------------------------------- *) (* Set up more infix operators. *) (* ------------------------------------------------------------------------- *) Topdirs.dir_directory (!hol_dir);; Topdirs.load_file Format.std_formatter (Filename.concat (!hol_dir) "Mizarlight/pa_f.cmo");; List.iter (fun s -> Hashtbl.add (Pa_j.ht) s true) ["st'";"st";"at";"from";"by";"using";"proof"; "THEN'"];; (* ------------------------------------------------------------------------- *) (* Mizar Light. *) (* ------------------------------------------------------------------------- *) loadt "Mizarlight/miz2a.ml";; (* ------------------------------------------------------------------------- *) (* Projective duality proof in Mizar Light. *) (* ------------------------------------------------------------------------- *) loadt "Mizarlight/duality.ml";; (* ------------------------------------------------------------------------- *) (* A prover more closely approximating Mizar's own. *) (* ------------------------------------------------------------------------- *) loadt "Examples/holby.ml";; (* ------------------------------------------------------------------------- *) (* A version of the duality proof based on that. *) (* ------------------------------------------------------------------------- *) loadt "Mizarlight/duality_holby.ml";; hol-light/Mizarlight/miz2a.ml000066400000000000000000000173671303454263000164510ustar00rootroot00000000000000(* ========================================================================= *) (* Mizar Light II *) (* *) (* Freek Wiedijk, University of Nijmegen *) (* ========================================================================= *) type mterm = string;; let parse_context_term s env = let ptm,l = (parse_preterm o lex o explode) s in if l = [] then (term_of_preterm o retypecheck (map ((fun (s,ty) -> s,pretype_of_type ty) o dest_var) env)) ptm else failwith "Unexpected junk after term";; let goal_frees (asl,w as g) = frees (itlist (curry mk_imp) (map (concl o snd) asl) w);; let (parse_mterm: mterm -> goal -> term) = let ttm = mk_var("thesis",bool_ty) in let atm = mk_var("antecedent",bool_ty) in let otm = mk_var("opposite",bool_ty) in fun s (asl,w as g) -> let ant = try fst (dest_imp w) with Failure _ -> atm in let opp = try dest_neg w with Failure _ -> mk_neg w in let t = (subst [w,ttm; ant,atm; opp,otm] (parse_context_term s ((goal_frees g) @ [ttm; atm; otm]))) in try let lhs = lhand (concl (snd (hd asl))) in let itm = mk_var("...",type_of lhs) in subst [lhs,itm] t with Failure _ -> t;; type stepinfo = (goal -> term) option * int option * (goal -> thm list) * (thm list -> tactic);; type step = (stepinfo -> tactic) * stepinfo;; let TRY' tac thl = TRY (tac thl);; let (then'_) = fun tac1 tac2 thl -> tac1 thl THEN tac2 thl;; let standard_prover = TRY' (REWRITE_TAC THEN' MESON_TAC);; let sketch_prover = K CHEAT_TAC;; let current_prover = ref standard_prover;; let (default_stepinfo: (goal -> term) option -> stepinfo) = fun t -> t,None, (map snd o filter ((=) "=" o fst) o fst), (fun thl -> !current_prover thl);; let ((st'): step -> (goal -> term) -> step) = fun (tac,(t,l,thl,just)) t' -> (tac,(Some t',l,thl,just));; let (st) = fun stp -> (st') stp o parse_mterm;; let (((at)): step -> int -> step) = fun (tac,(t,l,thl,just)) l' -> (tac,(t,Some l',thl,just));; let (((from)): step -> int list -> step) = fun (tac,(t,l,thl,just)) ll -> (tac,(t,l, (fun (asl,_ as g) -> thl g @ let n = length asl in map (fun l -> if l < 0 then snd (el ((n - l - 1) mod n) asl) else assoc (string_of_int l) asl) ll), just));; let so x = fun y -> x y from [-1];; let (((by)): step -> thm list -> step) = fun (tac,(t,l,thl,just)) thl' -> (tac,(t,l,(fun g -> thl g @ thl'),just));; let (((using)): step -> (thm list -> tactic) -> step) = fun (tac,(t,l,thl,just)) just' -> (tac,(t,l,thl,just' THEN' just));; let (step: step -> tactic) = fun (f,x) -> f x;; let (steps: step list -> tactic) = fun stpl -> itlist (fun tac1 tac2 -> tac1 THENL [tac2]) (map step stpl) ALL_TAC;; let (tactics: tactic list -> step) = fun tacl -> ((K (itlist ((THEN)) tacl ALL_TAC)), default_stepinfo None);; let (theorem': (goal -> term) -> step list -> thm) = let g = ([],`T`) in fun t stpl -> prove(t g,steps stpl);; let (((proof)): step -> step list -> step) = fun (tac,(t,l,thl,just)) prf -> (tac,(t,l,thl,K (steps prf)));; let (N_ASSUME_TAC: int option -> thm_tactic) = fun l th (asl,_ as g) -> match l with None -> ASSUME_TAC th g | Some n -> warn (n >= 0 && length asl <> n) "*** out of sequence label ***"; LABEL_TAC (if n < 0 then "=" else string_of_int n) th g;; let (per: step -> step list list -> step) = let F = `F` in fun (_,(_,_,thl,just)) cases -> (fun (_,_,thl',just') g -> let tx (t',_,_,_) = match t' with None -> failwith "per" | Some t -> t g in let dj = itlist (curry mk_disj) (map (tx o snd o hd) cases) F in (SUBGOAL_THEN dj (EVERY_TCL (map (fun case -> let _,l,_,_ = snd (hd case) in (DISJ_CASES_THEN2 (N_ASSUME_TAC l))) cases) CONTR_TAC) THENL ([(just' THEN' just) ((thl' g) @ (thl g))] @ map (steps o tl) cases)) g), (None,None,(K []),(K ALL_TAC));; let (cases: step) = (fun _ -> failwith "cases"),default_stepinfo None;; let (suppose': (goal -> term) -> step) = fun t -> (fun _ -> failwith "suppose"),default_stepinfo (Some t);; let (consider': (goal -> term) list -> step) = let T = `T` in fun tl' -> (fun (t',l,thl,just) (asl,w as g) -> let tl = map (fun t' -> t' g) tl' in let g' = ((asl @ (map (fun t -> ("",REFL t)) tl)),w) in let ex = itlist (curry mk_exists) tl (match t' with None -> failwith "consider" | Some t -> t g') in (SUBGOAL_THEN ex ((EVERY_TCL (map X_CHOOSE_THEN tl)) (N_ASSUME_TAC l)) THENL [just (thl g); ALL_TAC]) g), default_stepinfo (Some (fun g -> end_itlist (curry mk_conj) (map (fun t' -> let t = t' g in mk_eq(t,t)) tl')));; let (take': (goal -> term) list -> step) = fun tl -> (fun _ g -> (MAP_EVERY EXISTS_TAC o map (fun t -> t g)) tl g), default_stepinfo None;; let (assume': (goal -> term) -> step) = fun t -> (fun (t',l,thl,just) g -> match t' with None -> failwith "assume" | Some t -> (DISJ_CASES_THEN2 (fun th -> REWRITE_TAC[th] THEN N_ASSUME_TAC l th) (fun th -> just ((REWRITE_RULE[] th)::(thl g))) (SPEC (t g) EXCLUDED_MIDDLE)) g), default_stepinfo (Some t);; let (have': (goal -> term) -> step) = fun t -> (fun (t',l,thl,just) g -> match t' with None -> failwith "have" | Some t -> (SUBGOAL_THEN (t g) (N_ASSUME_TAC l) THENL [just (thl g); ALL_TAC]) g), default_stepinfo (Some t);; let (thus': (goal -> term) -> step) = fun t -> (fun (t',l,thl,just) g -> match t' with None -> failwith "thus" | Some t -> (SUBGOAL_THEN (t g) ASSUME_TAC THENL [just (thl g); POP_ASSUM (fun th -> N_ASSUME_TAC l th THEN EVERY (map (fun th -> REWRITE_TAC[EQT_INTRO th]) (CONJUNCTS th)))]) g), default_stepinfo (Some t);; let (fix': (goal -> term) list -> step) = fun tl -> (fun _ g -> (MAP_EVERY X_GEN_TAC o (map (fun t -> t g))) tl g), default_stepinfo None;; let (set': (goal -> term) -> step) = fun t -> let stp = (fun (t',l,_,_) g -> match t' with None -> failwith "set" | Some t -> let eq = t g in let lhs,rhs = dest_eq eq in let lv,largs = strip_comb lhs in let rtm = list_mk_abs(largs,rhs) in let ex = mk_exists(lv,mk_eq(lv,rtm)) in (SUBGOAL_THEN ex (X_CHOOSE_THEN lv (fun th -> (N_ASSUME_TAC l) (prove(eq,REWRITE_TAC[th])))) THENL [REWRITE_TAC[EXISTS_REFL]; ALL_TAC]) g), default_stepinfo (Some t) in stp at -1;; let theorem = theorem' o parse_mterm;; let suppose = suppose' o parse_mterm;; let consider = consider' o map parse_mterm;; let take = take' o map parse_mterm;; let assume = assume' o parse_mterm;; let have = have' o parse_mterm;; let thus = thus' o parse_mterm;; let fix = fix' o map parse_mterm;; let set = set' o parse_mterm;; let iff prfs = tactics [EQ_TAC THENL map steps prfs];; let (otherwise: ('a -> step) -> ('a -> step)) = fun stp x -> let tac,si = stp x in ((fun (t,l,thl,just) g -> REFUTE_THEN (fun th -> tac (t,l,K ([REWRITE_RULE[] th] @ thl g),just)) g), si);; let (thesis:mterm) = "thesis";; let (antecedent:mterm) = "antecedent";; let (opposite:mterm) = "opposite";; let (contradiction:mterm) = "F";; let hence = so thus;; let qed = hence thesis;; let h = g o parse_term;; let f = e o step;; let ff = e o steps;; let ee = e o EVERY;; let fp = f o (fun x -> x proof []);; let GOAL_HERE = tactics [GOAL_TAC];; hol-light/Mizarlight/pa_f.ml000066400000000000000000000016041303454263000163170ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Some additional infixes to support Freek's "Mizar Light". *) (* ------------------------------------------------------------------------- *) open Pcaml; Pcaml.syntax_name.val := "Freek"; Format.print_string "New infixes set up"; Format.print_newline(); EXTEND expr: AFTER "<" [[ f = expr; "by"; g = expr -> <:expr< ((by $f$) $g$) >> | f = expr; "st'"; g = expr -> <:expr< ((st' $f$) $g$) >> | f = expr; "st"; g = expr -> <:expr< ((st $f$) $g$) >> | f = expr; "at"; g = expr -> <:expr< ((at $f$) $g$) >> | f = expr; "from"; g = expr -> <:expr< ((from $f$) $g$) >> | f = expr; "using"; g = expr -> <:expr< ((using $f$) $g$) >> | f = expr; "proof"; g = expr -> <:expr< ((proof $f$) $g$) >> | f = expr; "THEN'"; g = expr -> <:expr< ((then'_ $f$) $g$) >> ]]; END; hol-light/Model/000077500000000000000000000000001303454263000140055ustar00rootroot00000000000000hol-light/Model/make.ml000066400000000000000000000020641303454263000152560ustar00rootroot00000000000000(* ========================================================================= *) (* Consistency proof of "pure HOL" (no axioms or definitions) in itself. *) (* ========================================================================= *) loadt "Library/card.ml";; (* ------------------------------------------------------------------------- *) (* Syntactic definitions (terms, types, theorems etc.) *) (* ------------------------------------------------------------------------- *) loadt "Model/syntax.ml";; (* ------------------------------------------------------------------------- *) (* Set-theoretic hierarchy to support semantics. *) (* ------------------------------------------------------------------------- *) loadt "Model/modelset.ml";; (* ------------------------------------------------------------------------- *) (* Semantics. *) (* ------------------------------------------------------------------------- *) loadt "Model/semantics.ml";; hol-light/Model/modelset.ml000066400000000000000000001013041303454263000161520ustar00rootroot00000000000000(* ========================================================================= *) (* Set-theoretic hierarchy for modelling HOL inside itself. *) (* ========================================================================= *) let INJ_LEMMA = prove (`(!x y. (f x = f y) ==> (x = y)) <=> (!x y. (f x = f y) <=> (x = y))`, MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Useful to have a niceish "function update" notation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("|->",(12,"right"));; let valmod = new_definition `(x |-> a) (v:A->B) = \y. if y = x then a else v(y)`;; let VALMOD = prove (`!v x y a. ((x |-> y) v) a = if a = x then y else v(a)`, REWRITE_TAC[valmod]);; let VALMOD_BASIC = prove (`!v x y. (x |-> y) v x = y`, REWRITE_TAC[valmod]);; let VALMOD_VALMOD_BASIC = prove (`!v a b x. (x |-> a) ((x |-> b) v) = (x |-> a) v`, REWRITE_TAC[valmod; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; let VALMOD_REPEAT = prove (`!v x. (x |-> v(x)) v = v`, REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; let FORALL_VALMOD = prove (`!x. (!v a. P((x |-> a) v)) = (!v. P v)`, MESON_TAC[VALMOD_REPEAT]);; let VALMOD_SWAP = prove (`!v x y a b. ~(x = y) ==> ((x |-> a) ((y |-> b) v) = (y |-> b) ((x |-> a) v))`, REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A dummy finite type inadequately modelling ":ind". *) (* ------------------------------------------------------------------------- *) let ind_model_tybij_th = prove(`?x. x IN @s:num->bool. ~(s = {}) /\ FINITE s`, MESON_TAC[MEMBER_NOT_EMPTY; IN_SING; FINITE_RULES]);; let ind_model_tybij = new_type_definition "ind_model" ("mk_ind","dest_ind") ind_model_tybij_th;; (* ------------------------------------------------------------------------- *) (* Introduce a type whose universe is "inaccessible" starting from *) (* "ind_model". Since "ind_model" is finite, we can just use any *) (* infinite set. In order to make "ind_model" infinite, we would need *) (* a new axiom. In order to keep things generic we try to deduce *) (* everything from this one uniform "axiom". Note that even in the *) (* infinite case, this can still be a small set in ZF terms, not a real *) (* inaccessible cardinal. *) (* ------------------------------------------------------------------------- *) (****** Here's what we'd do in the infinite case new_type("I",0);; let I_AXIOM = new_axiom `UNIV:ind_model->bool <_c UNIV:I->bool /\ (!s:A->bool. s <_c UNIV:I->bool ==> {t | t SUBSET s} <_c UNIV:I->bool)`;; *******) let inacc_tybij_th = prove (`?x:num. x IN UNIV`,REWRITE_TAC[IN_UNIV]);; let inacc_tybij = new_type_definition "I" ("mk_I","dest_I") inacc_tybij_th;; let I_AXIOM = prove (`UNIV:ind_model->bool <_c UNIV:I->bool /\ (!s:A->bool. s <_c UNIV:I->bool ==> {t | t SUBSET s} <_c UNIV:I->bool)`, let lemma = prove (`!s. s <_c UNIV:I->bool <=> FINITE s`, GEN_TAC THEN REWRITE_TAC[FINITE_CARD_LT] THEN MATCH_MP_TAC CARD_LT_CONG THEN REWRITE_TAC[CARD_EQ_REFL] THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM; le_c; IN_UNIV] THEN MESON_TAC[inacc_tybij; IN_UNIV]) in REWRITE_TAC[lemma; FINITE_POWERSET] THEN SUBGOAL_THEN `UNIV = IMAGE mk_ind (@s. ~(s = {}) /\ FINITE s)` SUBST1_TAC THENL [MESON_TAC[EXTENSION; IN_IMAGE; IN_UNIV; ind_model_tybij]; MESON_TAC[FINITE_IMAGE; NOT_INSERT_EMPTY; FINITE_RULES]]);; (* ------------------------------------------------------------------------- *) (* I is infinite and therefore admits an injective pairing. *) (* ------------------------------------------------------------------------- *) let I_INFINITE = prove (`INFINITE(UNIV:I->bool)`, REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN MP_TAC(ISPEC `{n | n < CARD(UNIV:I->bool) - 1}` (CONJUNCT2 I_AXIOM)) THEN ASM_SIMP_TAC[CARD_LT_CARD; FINITE_NUMSEG_LT; FINITE_POWERSET] THEN SIMP_TAC[CARD_NUMSEG_LT; CARD_POWERSET; FINITE_NUMSEG_LT] THEN SUBGOAL_THEN `~(CARD(UNIV:I->bool) = 0)` MP_TAC THENL [ASM_SIMP_TAC[CARD_EQ_0; GSYM MEMBER_NOT_EMPTY; IN_UNIV]; ALL_TAC] THEN SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 < n`; NOT_LT] THEN MATCH_MP_TAC(ARITH_RULE `a - 1 < b ==> ~(a = 0) ==> a <= b`) THEN SPEC_TAC(`CARD(UNIV:I->bool) - 1`,`n:num`) THEN POP_ASSUM(K ALL_TAC) THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let I_PAIR_EXISTS = prove (`?f:I#I->I. !x y. (f x = f y) ==> (x = y)`, SUBGOAL_THEN `UNIV:I#I->bool <=_c UNIV:I->bool` MP_TAC THENL [ALL_TAC; REWRITE_TAC[le_c; IN_UNIV]] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN MP_TAC(MATCH_MP CARD_SQUARE_INFINITE I_INFINITE) THEN MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; mul_c; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[PAIR]);; let I_PAIR = REWRITE_RULE[INJ_LEMMA] (new_specification ["I_PAIR"] I_PAIR_EXISTS);; (* ------------------------------------------------------------------------- *) (* It also admits injections from "bool" and "ind_model". *) (* ------------------------------------------------------------------------- *) let CARD_BOOL_LT_I = prove (`UNIV:bool->bool <_c UNIV:I->bool`, REWRITE_TAC[GSYM CARD_NOT_LE] THEN DISCH_TAC THEN MP_TAC I_INFINITE THEN REWRITE_TAC[INFINITE] THEN SUBGOAL_THEN `FINITE(UNIV:bool->bool)` (fun th -> ASM_MESON_TAC[th; CARD_LE_FINITE]) THEN SUBGOAL_THEN `UNIV:bool->bool = {F,T}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT] THEN MESON_TAC[]; SIMP_TAC[FINITE_RULES]]);; let I_BOOL_EXISTS = prove (`?f:bool->I. !x y. (f x = f y) ==> (x = y)`, MP_TAC(MATCH_MP CARD_LT_IMP_LE CARD_BOOL_LT_I) THEN SIMP_TAC[lt_c; le_c; IN_UNIV]);; let I_BOOL = REWRITE_RULE[INJ_LEMMA] (new_specification ["I_BOOL"] I_BOOL_EXISTS);; let I_IND_EXISTS = prove (`?f:ind_model->I. !x y. (f x = f y) ==> (x = y)`, MP_TAC(CONJUNCT1 I_AXIOM) THEN SIMP_TAC[lt_c; le_c; IN_UNIV]);; let I_IND = REWRITE_RULE[INJ_LEMMA] (new_specification ["I_IND"] I_IND_EXISTS);; (* ------------------------------------------------------------------------- *) (* And the injection from powerset of any accessible set. *) (* ------------------------------------------------------------------------- *) let I_SET_EXISTS = prove (`!s:I->bool. s <_c UNIV:I->bool ==> ?f:(I->bool)->I. !t u. t SUBSET s /\ u SUBSET s /\ (f t = f u) ==> (t = u)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP(CONJUNCT2 I_AXIOM)) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LT_IMP_LE) THEN REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM]);; let I_SET = new_specification ["I_SET"] (REWRITE_RULE[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] I_SET_EXISTS);; (* ------------------------------------------------------------------------- *) (* Define a type for "levels" of our set theory. *) (* ------------------------------------------------------------------------- *) let setlevel_INDUCT,setlevel_RECURSION = define_type "setlevel = Ur_bool | Ur_ind | Powerset setlevel | Cartprod setlevel setlevel";; let setlevel_DISTINCT = distinctness "setlevel";; let setlevel_INJ = injectivity "setlevel";; (* ------------------------------------------------------------------------- *) (* Now define a subset of I corresponding to each. *) (* ------------------------------------------------------------------------- *) let setlevel = new_recursive_definition setlevel_RECURSION `(setlevel Ur_bool = IMAGE I_BOOL UNIV) /\ (setlevel Ur_ind = IMAGE I_IND UNIV) /\ (setlevel (Cartprod l1 l2) = IMAGE I_PAIR {x,y | x IN setlevel l1 /\ y IN setlevel l2}) /\ (setlevel (Powerset l) = IMAGE (I_SET (setlevel l)) {s | s SUBSET (setlevel l)})`;; (* ------------------------------------------------------------------------- *) (* Show they all satisfy the cardinal limits. *) (* ------------------------------------------------------------------------- *) let SETLEVEL_CARD = prove (`!l. setlevel l <_c UNIV:I->bool`, MATCH_MP_TAC setlevel_INDUCT THEN REWRITE_TAC[setlevel] THEN REPEAT CONJ_TAC THENL [TRANS_TAC CARD_LET_TRANS `UNIV:bool->bool` THEN REWRITE_TAC[CARD_LE_IMAGE; CARD_BOOL_LT_I]; TRANS_TAC CARD_LET_TRANS `UNIV:ind_model->bool` THEN REWRITE_TAC[CARD_LE_IMAGE; I_AXIOM]; X_GEN_TAC `l:setlevel` THEN DISCH_TAC THEN TRANS_TAC CARD_LET_TRANS `{s | s SUBSET (setlevel l)}` THEN ASM_SIMP_TAC[I_AXIOM; CARD_LE_IMAGE]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`l1:setlevel`; `l2:setlevel`] THEN STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `setlevel l1 *_c setlevel l2` THEN ASM_SIMP_TAC[CARD_MUL_LT_INFINITE; I_INFINITE; GSYM mul_c; CARD_LE_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Hence the injectivity of the mapping from powerset. *) (* ------------------------------------------------------------------------- *) let I_SET_SETLEVEL = prove (`!l s t. s SUBSET setlevel l /\ t SUBSET setlevel l /\ (I_SET (setlevel l) s = I_SET (setlevel l) t) ==> (s = t)`, MESON_TAC[SETLEVEL_CARD; I_SET]);; (* ------------------------------------------------------------------------- *) (* Now our universe of sets and (ur)elements. *) (* ------------------------------------------------------------------------- *) let universe = new_definition `universe = {(t,x) | x IN setlevel t}`;; (* ------------------------------------------------------------------------- *) (* Define an actual type V. *) (* *) (* This satisfies a suitable number of the ZF axioms. It isn't extensional *) (* but we could then construct a quotient structure if desired. Anyway it's *) (* only empty sets that aren't. A more significant difference is that we *) (* have urelements and the hierarchy levels are all distinct rather than *) (* being cumulative. *) (* ------------------------------------------------------------------------- *) let v_tybij_th = prove (`?a. a IN universe`, EXISTS_TAC `Ur_bool,I_BOOL T` THEN REWRITE_TAC[universe; IN_ELIM_THM; PAIR_EQ; CONJ_ASSOC; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1; setlevel; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);; let v_tybij = new_type_definition "V" ("mk_V","dest_V") v_tybij_th;; let V_TYBIJ = prove (`!l e. e IN setlevel l <=> (dest_V(mk_V(l,e)) = (l,e))`, REWRITE_TAC[GSYM(CONJUNCT2 v_tybij)] THEN REWRITE_TAC[IN_ELIM_THM; universe; FORALL_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Drop a level; test if something is a set. *) (* ------------------------------------------------------------------------- *) let droplevel = new_recursive_definition setlevel_RECURSION `droplevel(Powerset l) = l`;; let isasetlevel = new_recursive_definition setlevel_RECURSION `(isasetlevel Ur_bool = F) /\ (isasetlevel Ur_ind = F) /\ (isasetlevel (Cartprod l1 l2) = F) /\ (isasetlevel (Powerset l) = T)`;; (* ------------------------------------------------------------------------- *) (* Define some useful inversions. *) (* ------------------------------------------------------------------------- *) let level = new_definition `level x = FST(dest_V x)`;; let element = new_definition `element x = SND(dest_V x)`;; let ELEMENT_IN_LEVEL = prove (`!x. (element x) IN setlevel(level x)`, REWRITE_TAC[V_TYBIJ; v_tybij; level; element; PAIR]);; let SET = prove (`!x. mk_V(level x,element x) = x`, REWRITE_TAC[level; element; PAIR; v_tybij]);; let set = new_definition `set x = @s. s SUBSET (setlevel(droplevel(level x))) /\ (I_SET (setlevel(droplevel(level x))) s = element x)`;; let isaset = new_definition `isaset x <=> ?l. level x = Powerset l`;; (* ------------------------------------------------------------------------- *) (* Now all the critical relations. *) (* ------------------------------------------------------------------------- *) parse_as_infix("<:",(11,"right"));; let inset = new_definition `x <: s <=> (level s = Powerset(level x)) /\ (element x) IN (set s)`;; parse_as_infix("<=:",(12,"right"));; let subset_def = new_definition `s <=: t <=> (level s = level t) /\ !x. x <: s ==> x <: t`;; (* ------------------------------------------------------------------------- *) (* If something has members, it's a set. *) (* ------------------------------------------------------------------------- *) let MEMBERS_ISASET = prove (`!x s. x <: s ==> isaset s`, REWRITE_TAC[inset; isaset] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Each level is nonempty. *) (* ------------------------------------------------------------------------- *) let LEVEL_NONEMPTY = prove (`!l. ?x. x IN setlevel l`, REWRITE_TAC[MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC setlevel_INDUCT THEN REWRITE_TAC[setlevel; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIV] THEN REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_THM] THEN MESON_TAC[EMPTY_SUBSET]);; let LEVEL_SET_EXISTS = prove (`!l. ?s. level s = l`, MP_TAC LEVEL_NONEMPTY THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[level] THEN MESON_TAC[FST; PAIR; V_TYBIJ]);; (* ------------------------------------------------------------------------- *) (* Empty sets (or non-sets, of course) exist at all set levels. *) (* ------------------------------------------------------------------------- *) let MK_V_CLAUSES = prove (`e IN setlevel l ==> (level(mk_V(l,e)) = l) /\ (element(mk_V(l,e)) = e)`, REWRITE_TAC[level; element; PAIR; GSYM PAIR_EQ; V_TYBIJ]);; let MK_V_SET = prove (`s SUBSET setlevel l ==> (set(mk_V(Powerset l,I_SET (setlevel l) s)) = s) /\ (level(mk_V(Powerset l,I_SET (setlevel l) s)) = Powerset l) /\ (element(mk_V(Powerset l,I_SET (setlevel l) s)) = I_SET (setlevel l) s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `I_SET (setlevel l) s IN setlevel(Powerset l)` ASSUME_TAC THENL [REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[MK_V_CLAUSES; set] THEN SUBGOAL_THEN `I_SET (setlevel l) s IN setlevel(Powerset l)` ASSUME_TAC THENL [REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[MK_V_CLAUSES; droplevel] THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN ASM_MESON_TAC[I_SET_SETLEVEL]);; let EMPTY_EXISTS = prove (`!l. ?s. (level s = l) /\ !x. ~(x <: s)`, MATCH_MP_TAC setlevel_INDUCT THEN REPEAT CONJ_TAC THENL [ALL_TAC; ALL_TAC; X_GEN_TAC `l:setlevel` THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `mk_V(Powerset l,I_SET (setlevel l) {})` THEN SIMP_TAC[inset; MK_V_CLAUSES; MK_V_SET; EMPTY_SUBSET; NOT_IN_EMPTY]; ALL_TAC] THEN MESON_TAC[LEVEL_SET_EXISTS; MEMBERS_ISASET; isaset; setlevel_DISTINCT]);; let EMPTY_SET = new_specification ["emptyset"] (REWRITE_RULE[SKOLEM_THM] EMPTY_EXISTS);; (* ------------------------------------------------------------------------- *) (* Comprehension principle, with no change of levels. *) (* ------------------------------------------------------------------------- *) let COMPREHENSION_EXISTS = prove (`!s p. ?t. (level t = level s) /\ !x. x <: t <=> x <: s /\ p x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `isaset s` THENL [ALL_TAC; ASM_MESON_TAC[MEMBERS_ISASET]] THEN POP_ASSUM(X_CHOOSE_TAC `l:setlevel` o REWRITE_RULE[isaset]) THEN MP_TAC(SPEC `s:V` ELEMENT_IN_LEVEL) THEN ASM_REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `u:I->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `mk_V(Powerset l, I_SET(setlevel l) {i | i IN u /\ p(mk_V(l,i))})` THEN SUBGOAL_THEN `{i | i IN u /\ p (mk_V (l,i))} SUBSET (setlevel l)` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[MK_V_SET; inset] THEN X_GEN_TAC `x:V` THEN REWRITE_TAC[setlevel_INJ] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[SET; MK_V_SET]);; parse_as_infix("suchthat",(21,"left"));; let SUCHTHAT = new_specification ["suchthat"] (REWRITE_RULE[SKOLEM_THM] COMPREHENSION_EXISTS);; (* ------------------------------------------------------------------------- *) (* Each setlevel exists as a set. *) (* ------------------------------------------------------------------------- *) let SETLEVEL_EXISTS = prove (`!l. ?s. (level s = Powerset l) /\ !x. x <: s <=> (level x = l) /\ element(x) IN setlevel l`, GEN_TAC THEN EXISTS_TAC `mk_V(Powerset l,I_SET (setlevel l) (setlevel l))` THEN SIMP_TAC[MK_V_SET; SUBSET_REFL; inset; setlevel_INJ] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Conversely, set(s) belongs in the appropriate level. *) (* ------------------------------------------------------------------------- *) let SET_DECOMP = prove (`!s. isaset s ==> (set s) SUBSET (setlevel(droplevel(level s))) /\ (I_SET (setlevel(droplevel(level s))) (set s) = element s)`, REPEAT GEN_TAC THEN REWRITE_TAC[isaset] THEN DISCH_THEN(X_CHOOSE_TAC `l:setlevel`) THEN REWRITE_TAC[set] THEN CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[setlevel; droplevel] THEN MP_TAC(SPEC `s:V` ELEMENT_IN_LEVEL) THEN ASM_REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; let SET_SUBSET_SETLEVEL = prove (`!s. isaset s ==> set(s) SUBSET setlevel(droplevel(level s))`, MESON_TAC[SET_DECOMP]);; (* ------------------------------------------------------------------------- *) (* Power set exists. *) (* ------------------------------------------------------------------------- *) let POWERSET_EXISTS = prove (`!s. ?t. (level t = Powerset(level s)) /\ !x. x <: t <=> x <=: s`, GEN_TAC THEN ASM_CASES_TAC `isaset s` THENL [FIRST_ASSUM(MP_TAC o GSYM o MATCH_MP SET_DECOMP) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [isaset]) THEN DISCH_THEN(X_CHOOSE_THEN `l:setlevel` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[droplevel] THEN STRIP_TAC THEN X_CHOOSE_THEN `t:V` STRIP_ASSUME_TAC (SPEC `Powerset l` SETLEVEL_EXISTS) THEN MP_TAC(SPECL [`t:V`; `\v. !x. x <: v ==> x <: s`] COMPREHENSION_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:V` THEN STRIP_TAC THEN ASM_REWRITE_TAC[subset_def] THEN ASM_MESON_TAC[ELEMENT_IN_LEVEL]; MP_TAC(SPEC `level s` SETLEVEL_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:V` THEN STRIP_TAC THEN ASM_REWRITE_TAC[subset_def] THEN ASM_MESON_TAC[ELEMENT_IN_LEVEL; MEMBERS_ISASET; isaset]]);; let POWERSET = new_specification ["powerset"] (REWRITE_RULE[SKOLEM_THM] POWERSET_EXISTS);; (* ------------------------------------------------------------------------- *) (* Pairing operation. *) (* ------------------------------------------------------------------------- *) let pair = new_definition `pair x y = mk_V(Cartprod (level x) (level y),I_PAIR(element x,element y))`;; let PAIR_IN_LEVEL = prove (`!x y l m. x IN setlevel l /\ y IN setlevel m ==> I_PAIR(x,y) IN setlevel (Cartprod l m)`, REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; let DEST_MK_PAIR = prove (`dest_V(mk_V(Cartprod (level x) (level y),I_PAIR(element x,element y))) = Cartprod (level x) (level y),I_PAIR(element x,element y)`, REWRITE_TAC[GSYM V_TYBIJ] THEN SIMP_TAC[PAIR_IN_LEVEL; ELEMENT_IN_LEVEL]);; let PAIR_INJ = prove (`!x1 y1 x2 y2. (pair x1 y1 = pair x2 y2) <=> (x1 = x2) /\ (y1 = y2)`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN REWRITE_TAC[pair] THEN DISCH_THEN(MP_TAC o AP_TERM `dest_V`) THEN REWRITE_TAC[DEST_MK_PAIR] THEN REWRITE_TAC[setlevel_INJ; PAIR_EQ; I_PAIR] THEN REWRITE_TAC[level; element] THEN MESON_TAC[PAIR; CONJUNCT1 v_tybij]);; let LEVEL_PAIR = prove (`!x y. level(pair x y) = Cartprod (level x) (level y)`, REWRITE_TAC[level; REWRITE_RULE[DEST_MK_PAIR] (AP_TERM `dest_V` (SPEC_ALL pair))]);; (* ------------------------------------------------------------------------- *) (* Decomposition functions. *) (* ------------------------------------------------------------------------- *) let fst_def = new_definition `fst p = @x. ?y. p = pair x y`;; let snd_def = new_definition `snd p = @y. ?x. p = pair x y`;; let PAIR_CLAUSES = prove (`!x y. (fst(pair x y) = x) /\ (snd(pair x y) = y)`, REWRITE_TAC[fst_def; snd_def] THEN MESON_TAC[PAIR_INJ]);; (* ------------------------------------------------------------------------- *) (* And the Cartesian product space. *) (* ------------------------------------------------------------------------- *) let CARTESIAN_EXISTS = prove (`!s t. ?u. (level u = Powerset(Cartprod (droplevel(level s)) (droplevel(level t)))) /\ !z. z <: u <=> ?x y. (z = pair x y) /\ x <: s /\ y <: t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `isaset s` THENL [ALL_TAC; ASM_MESON_TAC[EMPTY_EXISTS; MEMBERS_ISASET]] THEN SUBGOAL_THEN `?l. (level s = Powerset l)` CHOOSE_TAC THENL [ASM_MESON_TAC[isaset]; ALL_TAC] THEN ASM_CASES_TAC `isaset t` THENL [ALL_TAC; ASM_MESON_TAC[EMPTY_EXISTS; MEMBERS_ISASET]] THEN SUBGOAL_THEN `?m. (level t = Powerset m)` CHOOSE_TAC THENL [ASM_MESON_TAC[isaset]; ALL_TAC] THEN MP_TAC(SPEC `Cartprod l m` SETLEVEL_EXISTS) THEN ASM_REWRITE_TAC[droplevel] THEN DISCH_THEN(X_CHOOSE_THEN `u:V` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`u:V`; `\z. ?x y. (z = pair x y) /\ x <: s /\ y <: t`] COMPREHENSION_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:V` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:V` THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (c ==> a) ==> ((a /\ b) /\ c <=> c)`) THEN CONJ_TAC THENL [MESON_TAC[ELEMENT_IN_LEVEL]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[LEVEL_PAIR] THEN BINOP_TAC THEN ASM_MESON_TAC[inset; setlevel_INJ]);; let PRODUCT = new_specification ["product"] (REWRITE_RULE[SKOLEM_THM] CARTESIAN_EXISTS);; (* ------------------------------------------------------------------------- *) (* Extensionality for sets at the same level. *) (* ------------------------------------------------------------------------- *) let IN_SET_ELEMENT = prove (`!s. isaset s /\ e IN set(s) ==> ?x. (e = element x) /\ (level s = Powerset(level x)) /\ x <: s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `l:setlevel` o REWRITE_RULE[isaset]) THEN EXISTS_TAC `mk_V(l,e)` THEN REWRITE_TAC[inset] THEN SUBGOAL_THEN `e IN setlevel l` (fun t -> ASM_SIMP_TAC[t; MK_V_CLAUSES]) THEN ASM_MESON_TAC[SET_SUBSET_SETLEVEL; SUBSET; droplevel]);; let SUBSET_ALT = prove (`isaset s /\ isaset t ==> (s <=: t <=> (level s = level t) /\ set(s) SUBSET set(t))`, REPEAT GEN_TAC THEN REWRITE_TAC[subset_def; inset] THEN ASM_CASES_TAC `level s = level t` THEN ASM_REWRITE_TAC[SUBSET] THEN STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_MESON_TAC[IN_SET_ELEMENT]);; let SUBSET_ANTISYM_LEVEL = prove (`!s t. isaset s /\ isaset t /\ s <=: t /\ t <=: s ==> (s = t)`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[SUBSET_ALT] THEN EVERY_ASSUM(MP_TAC o GSYM o MATCH_MP SET_DECOMP) THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `s:V` SET) THEN MP_TAC(SPEC `t:V` SET) THEN REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN AP_TERM_TAC THEN BINOP_TAC THEN ASM_MESON_TAC[SUBSET_ANTISYM]);; let EXTENSIONALITY_LEVEL = prove (`!s t. isaset s /\ isaset t /\ (level s = level t) /\ (!x. x <: s <=> x <: t) ==> (s = t)`, MESON_TAC[SUBSET_ANTISYM_LEVEL; subset_def]);; (* ------------------------------------------------------------------------- *) (* And hence for any nonempty sets. *) (* ------------------------------------------------------------------------- *) let EXTENSIONALITY_NONEMPTY = prove (`!s t. (?x. x <: s) /\ (?x. x <: t) /\ (!x. x <: s <=> x <: t) ==> (s = t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EXTENSIONALITY_LEVEL THEN ASM_MESON_TAC[MEMBERS_ISASET; inset]);; (* ------------------------------------------------------------------------- *) (* Union set exists. I don't need this but if might be a sanity check. *) (* ------------------------------------------------------------------------- *) let UNION_EXISTS = prove (`!s. ?t. (level t = droplevel(level s)) /\ !x. x <: t <=> ?u. x <: u /\ u <: s`, GEN_TAC THEN ASM_CASES_TAC `isaset s` THENL [ALL_TAC; MP_TAC(SPEC `droplevel(level s)` EMPTY_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[MEMBERS_ISASET]] THEN FIRST_ASSUM(X_CHOOSE_TAC `l:setlevel` o REWRITE_RULE[isaset]) THEN ASM_REWRITE_TAC[droplevel] THEN ASM_CASES_TAC `?m. l = Powerset m` THENL [ALL_TAC; MP_TAC(SPEC `l:setlevel` EMPTY_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[inset] THEN ASM_MESON_TAC[setlevel_INJ]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `m:setlevel` SUBST_ALL_TAC) THEN MP_TAC(SPEC `m:setlevel` SETLEVEL_EXISTS) THEN ASM_REWRITE_TAC[droplevel] THEN DISCH_THEN(X_CHOOSE_THEN `t:V` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`t:V`; `\x. ?u. x <: u /\ u <: s`] COMPREHENSION_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[inset; ELEMENT_IN_LEVEL; setlevel_INJ]);; let SETUNION = new_specification ["setunion"] (REWRITE_RULE[SKOLEM_THM] UNION_EXISTS);; (* ------------------------------------------------------------------------- *) (* Boolean stuff. *) (* ------------------------------------------------------------------------- *) let true_def = new_definition `true = mk_V(Ur_bool,I_BOOL T)`;; let false_def = new_definition `false = mk_V(Ur_bool,I_BOOL F)`;; let boolset = new_definition `boolset = mk_V(Powerset Ur_bool,I_SET (setlevel Ur_bool) (setlevel Ur_bool))`;; let IN_BOOL = prove (`!x. x <: boolset <=> (x = true) \/ (x = false)`, REWRITE_TAC[inset; boolset; true_def; false_def] THEN SIMP_TAC[MK_V_SET; SUBSET_REFL] THEN REWRITE_TAC[setlevel_INJ; setlevel] THEN SUBGOAL_THEN `IMAGE I_BOOL UNIV = {I_BOOL F,I_BOOL T}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[I_BOOL]; ALL_TAC] THEN GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o BINOP_CONV o LAND_CONV) [GSYM SET] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN SUBGOAL_THEN `!b. (I_BOOL b) IN setlevel Ur_bool` ASSUME_TAC THENL [REWRITE_TAC[setlevel; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; ASM_MESON_TAC[V_TYBIJ; ELEMENT_IN_LEVEL; PAIR_EQ]]);; let TRUE_NE_FALSE = prove (`~(true = false)`, REWRITE_TAC[true_def; false_def] THEN DISCH_THEN(MP_TAC o AP_TERM `dest_V`) THEN SUBGOAL_THEN `!b. (I_BOOL b) IN setlevel Ur_bool` ASSUME_TAC THENL [REWRITE_TAC[setlevel; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; ASM_MESON_TAC[V_TYBIJ; I_BOOL; PAIR_EQ]]);; let BOOLEAN_EQ = prove (`!x y. x <: boolset /\ y <: boolset /\ ((x = true) <=> (y = true)) ==> (x = y)`, MESON_TAC[TRUE_NE_FALSE; IN_BOOL]);; (* ------------------------------------------------------------------------- *) (* Ind stuff. *) (* ------------------------------------------------------------------------- *) let indset = new_definition `indset = mk_V(Powerset Ur_ind,I_SET (setlevel Ur_ind) (setlevel Ur_ind))`;; let INDSET_IND_MODEL = prove (`?f. (!i:ind_model. f(i) <: indset) /\ (!i j. (f i = f j) ==> (i = j))`, EXISTS_TAC `\i. mk_V(Ur_ind,I_IND i)` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!i. (I_IND i) IN setlevel Ur_ind` ASSUME_TAC THENL [REWRITE_TAC[setlevel; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[MK_V_SET; SUBSET_REFL; inset; indset; MK_V_CLAUSES] THEN ASM_MESON_TAC[V_TYBIJ; I_IND; ELEMENT_IN_LEVEL; PAIR_EQ]);; let INDSET_INHABITED = prove (`?x. x <: indset`, MESON_TAC[INDSET_IND_MODEL]);; (* ------------------------------------------------------------------------- *) (* Axiom of choice (this is trivially so in HOL anyway, but...) *) (* ------------------------------------------------------------------------- *) let ch = let th = prove (`?ch. !s. (?x. x <: s) ==> ch(s) <: s`, REWRITE_TAC[GSYM SKOLEM_THM] THEN MESON_TAC[]) in new_specification ["ch"] th;; (* ------------------------------------------------------------------------- *) (* Sanity check lemmas. *) (* ------------------------------------------------------------------------- *) let IN_POWERSET = prove (`!x s. x <: powerset s <=> x <=: s`, MESON_TAC[POWERSET]);; let IN_PRODUCT = prove (`!z s t. z <: product s t <=> ?x y. (z = pair x y) /\ x <: s /\ y <: t`, MESON_TAC[PRODUCT]);; let IN_COMPREHENSION = prove (`!p s x. x <: s suchthat p <=> x <: s /\ p x`, MESON_TAC[SUCHTHAT]);; let PRODUCT_INHABITED = prove (`(?x. x <: s) /\ (?y. y <: t) ==> ?z. z <: product s t`, MESON_TAC[IN_PRODUCT]);; (* ------------------------------------------------------------------------- *) (* Definition of function space. *) (* ------------------------------------------------------------------------- *) let funspace = new_definition `funspace s t = powerset(product s t) suchthat (\u. !x. x <: s ==> ?!y. pair x y <: u)`;; let apply_def = new_definition `apply f x = @y. pair x y <: f`;; let abstract = new_definition `abstract s t f = (product s t) suchthat (\z. !x y. (pair x y = z) ==> (y = f x))`;; let APPLY_ABSTRACT = prove (`!x s t. x <: s /\ f(x) <: t ==> (apply(abstract s t f) x = f(x))`, REPEAT STRIP_TAC THEN REWRITE_TAC[apply_def; abstract; IN_PRODUCT; SUCHTHAT] THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[PAIR_INJ] THEN ASM_MESON_TAC[]);; let APPLY_IN_RANSPACE = prove (`!f x s t. x <: s /\ f <: funspace s t ==> apply f x <: t`, REWRITE_TAC[funspace; SUCHTHAT; IN_POWERSET; IN_PRODUCT; subset_def] THEN REWRITE_TAC[apply_def] THEN MESON_TAC[PAIR_INJ]);; let ABSTRACT_IN_FUNSPACE = prove (`!f x s t. (!x. x <: s ==> f(x) <: t) ==> abstract s t f <: funspace s t`, REWRITE_TAC[funspace; abstract; SUCHTHAT; IN_POWERSET; IN_PRODUCT; subset_def; PAIR_INJ] THEN SIMP_TAC[LEFT_FORALL_IMP_THM; GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[UNWIND_THM1; EXISTS_REFL] THEN MESON_TAC[]);; let FUNSPACE_INHABITED = prove (`!s t. ((?x. x <: s) ==> (?y. y <: t)) ==> ?f. f <: funspace s t`, REPEAT STRIP_TAC THEN EXISTS_TAC `abstract s t (\x. @y. y <: t)` THEN MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN ASM_MESON_TAC[]);; let ABSTRACT_EQ = prove (`!s t1 t2 f g. (?x. x <: s) /\ (!x. x <: s ==> f(x) <: t1 /\ g(x) <: t2 /\ (f x = g x)) ==> (abstract s t1 f = abstract s t2 g)`, REWRITE_TAC[abstract] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EXTENSIONALITY_NONEMPTY THEN REWRITE_TAC[SUCHTHAT; IN_PRODUCT] THEN REPEAT CONJ_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN SIMP_TAC[TAUT `(a /\ b /\ c) /\ d <=> ~(a ==> b /\ c ==> ~d)`] THEN REWRITE_TAC[PAIR_INJ] THEN SIMP_TAC[LEFT_FORALL_IMP_THM] THENL [ASM_MESON_TAC[]; ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[PAIR_INJ] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN REWRITE_TAC[NOT_IMP] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[PAIR_INJ] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Special case of treating a Boolean function as a set. *) (* ------------------------------------------------------------------------- *) let boolean = new_definition `boolean b = if b then true else false`;; let holds = new_definition `holds s x <=> (apply s x = true)`;; let BOOLEAN_IN_BOOLSET = prove (`!b. boolean b <: boolset`, REWRITE_TAC[boolean] THEN MESON_TAC[IN_BOOL]);; let BOOLEAN_EQ_TRUE = prove (`!b. (boolean b = true) <=> b`, REWRITE_TAC[boolean] THEN MESON_TAC[TRUE_NE_FALSE]);; hol-light/Model/semantics.ml000066400000000000000000001521711303454263000163340ustar00rootroot00000000000000(* ========================================================================= *) (* Formal semantics of HOL inside itself. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Semantics of types. *) (* ------------------------------------------------------------------------- *) let typeset = new_recursive_definition type_RECURSION `(typeset tau (Tyvar s) = tau(s)) /\ (typeset tau Bool = boolset) /\ (typeset tau Ind = indset) /\ (typeset tau (Fun a b) = funspace (typeset tau a) (typeset tau b))`;; (* ------------------------------------------------------------------------- *) (* Semantics of terms. *) (* ------------------------------------------------------------------------- *) let semantics = new_recursive_definition term_RECURSION `(semantics sigma tau (Var n ty) = sigma(n,ty)) /\ (semantics sigma tau (Equal ty) = abstract (typeset tau ty) (typeset tau (Fun ty Bool)) (\x. abstract (typeset tau ty) (typeset tau Bool) (\y. boolean(x = y)))) /\ (semantics sigma tau (Select ty) = abstract (typeset tau (Fun ty Bool)) (typeset tau ty) (\s. if ?x. x <: ((typeset tau ty) suchthat (holds s)) then ch ((typeset tau ty) suchthat (holds s)) else ch (typeset tau ty))) /\ (semantics sigma tau (Comb s t) = apply (semantics sigma tau s) (semantics sigma tau t)) /\ (semantics sigma tau (Abs n ty t) = abstract (typeset tau ty) (typeset tau (typeof t)) (\x. semantics (((n,ty) |-> x) sigma) tau t))`;; (* ------------------------------------------------------------------------- *) (* Valid type and term valuations. *) (* ------------------------------------------------------------------------- *) let type_valuation = new_definition `type_valuation tau <=> !x. (?y. y <: tau x)`;; let term_valuation = new_definition `term_valuation tau sigma <=> !n ty. sigma(n,ty) <: typeset tau ty`;; let TERM_VALUATION_VALMOD = prove (`!sigma taut n ty x. term_valuation tau sigma /\ x <: typeset tau ty ==> term_valuation tau (((n,ty) |-> x) sigma)`, REWRITE_TAC[term_valuation; valmod; PAIR_EQ] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* All the typesets are nonempty. *) (* ------------------------------------------------------------------------- *) let TYPESET_INHABITED = prove (`!tau ty. type_valuation tau ==> ?x. x <: typeset tau ty`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC type_INDUCT THEN REWRITE_TAC[typeset] THEN CONJ_TAC THENL [ASM_MESON_TAC[type_valuation]; ASM_MESON_TAC[BOOLEAN_IN_BOOLSET; INDSET_INHABITED; FUNSPACE_INHABITED]]);; (* ------------------------------------------------------------------------- *) (* Semantics maps into the right place. *) (* ------------------------------------------------------------------------- *) let SEMANTICS_TYPESET_INDUCT = prove (`!tm ty. tm has_type ty ==> tm has_type ty /\ !sigma tau. type_valuation tau /\ term_valuation tau sigma ==> (semantics sigma tau tm) <: (typeset tau ty)`, MATCH_MP_TAC has_type_INDUCT THEN ASM_SIMP_TAC[semantics; typeset; has_type_RULES] THEN CONJ_TAC THENL [MESON_TAC[term_valuation]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN REWRITE_TAC[BOOLEAN_IN_BOOLSET]; MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN ASM_MESON_TAC[ch; SUCHTHAT; TYPESET_INHABITED]; ASM_MESON_TAC[has_type_RULES]; MATCH_MP_TAC APPLY_IN_RANSPACE THEN ASM_MESON_TAC[]; FIRST_ASSUM(SUBST1_TAC o MATCH_MP WELLTYPED_LEMMA) THEN MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD]]);; let SEMANTICS_TYPESET = prove (`!sigma tau tm ty. type_valuation tau /\ term_valuation tau sigma /\ tm has_type ty ==> (semantics sigma tau tm) <: (typeset tau ty)`, MESON_TAC[SEMANTICS_TYPESET_INDUCT]);; (* ------------------------------------------------------------------------- *) (* Semantics of equations. *) (* ------------------------------------------------------------------------- *) let SEMANTICS_EQUATION = prove (`!sigma tau s t. s has_type (typeof s) /\ t has_type (typeof s) /\ type_valuation tau /\ term_valuation tau sigma ==> (semantics sigma tau (s === t) = boolean(semantics sigma tau s = semantics sigma tau t))`, REPEAT STRIP_TAC THEN REWRITE_TAC[equation; semantics] THEN ASM_SIMP_TAC[APPLY_ABSTRACT; typeset; SEMANTICS_TYPESET; ABSTRACT_IN_FUNSPACE; BOOLEAN_IN_BOOLSET]);; let SEMANTICS_EQUATION_ALT = prove (`!sigma tau s t. (s === t) has_type Bool /\ type_valuation tau /\ term_valuation tau sigma ==> (semantics sigma tau (s === t) = boolean(semantics sigma tau s = semantics sigma tau t))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SEMANTICS_EQUATION THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `welltyped(s === t)` MP_TAC THENL [ASM_MESON_TAC[welltyped]; ALL_TAC] THEN REWRITE_TAC[equation; WELLTYPED_CLAUSES; typeof; codomain] THEN MESON_TAC[welltyped; type_INJ; WELLTYPED; WELLTYPED_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Quick sanity check. *) (* ------------------------------------------------------------------------- *) let SEMANTICS_SELECT = prove (`p has_type (Fun ty Bool) /\ type_valuation tau /\ term_valuation tau sigma ==> (semantics sigma tau (Comb (Select ty) p) = if ?x. x <: (typeset tau ty) suchthat (holds (semantics sigma tau p)) then ch((typeset tau ty) suchthat (holds (semantics sigma tau p))) else ch(typeset tau ty))`, REPEAT STRIP_TAC THEN REWRITE_TAC[semantics] THEN W(fun (asl,w) -> let t = find_term (fun t -> can (PART_MATCH (lhs o rand) APPLY_ABSTRACT) t) w in MP_TAC(PART_MATCH (lhs o rand) APPLY_ABSTRACT t)) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[SEMANTICS_TYPESET; typeset]; REWRITE_TAC[SUCHTHAT] THEN ASM_MESON_TAC[ch; SUCHTHAT; TYPESET_INHABITED]]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Semantics of a sequent. *) (* ------------------------------------------------------------------------- *) parse_as_infix("|=",(11,"right"));; let sequent = new_definition `asms |= p <=> ALL (\a. a has_type Bool) (CONS p asms) /\ !sigma tau. type_valuation tau /\ term_valuation tau sigma /\ ALL (\a. semantics sigma tau a = true) asms ==> (semantics sigma tau p = true)`;; (* ------------------------------------------------------------------------- *) (* Invariance of semantics under alpha-conversion. *) (* ------------------------------------------------------------------------- *) let SEMANTICS_RACONV = prove (`!env tp. RACONV env tp ==> !sigma1 sigma2 tau. type_valuation tau /\ term_valuation tau sigma1 /\ term_valuation tau sigma2 /\ (!x1 ty1 x2 ty2. ALPHAVARS env (Var x1 ty1,Var x2 ty2) ==> (semantics sigma1 tau (Var x1 ty1) = semantics sigma2 tau (Var x2 ty2))) ==> welltyped(FST tp) /\ welltyped(SND tp) ==> (semantics sigma1 tau (FST tp) = semantics sigma2 tau (SND tp))`, MATCH_MP_TAC RACONV_INDUCT THEN REWRITE_TAC[FORALL_PAIR_THM] THEN REWRITE_TAC[semantics; WELLTYPED_CLAUSES] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[]; BINOP_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC ABSTRACT_EQ THEN ASM_SIMP_TAC[TYPESET_INHABITED] THEN X_GEN_TAC `x:V` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SEMANTICS_TYPESET THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD; GSYM WELLTYPED]; MATCH_MP_TAC SEMANTICS_TYPESET THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD; GSYM WELLTYPED]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP]) THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN CONJ_TAC) THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN REWRITE_TAC[ALPHAVARS; PAIR_EQ; term_INJ] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VALMOD; PAIR_EQ] THEN ASM_MESON_TAC[]);; let SEMANTICS_ACONV = prove (`!sigma tau s t. type_valuation tau /\ term_valuation tau sigma /\ welltyped s /\ welltyped t /\ ACONV s t ==> (semantics sigma tau s = semantics sigma tau t)`, REWRITE_TAC[ACONV] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM; FORALL_PAIR_THM] SEMANTICS_RACONV) THEN EXISTS_TAC `[]:(term#term)list` THEN ASM_SIMP_TAC[ALPHAVARS; term_INJ; PAIR_EQ]);; (* ------------------------------------------------------------------------- *) (* General semantic lemma about binary inference rules. *) (* ------------------------------------------------------------------------- *) let BINARY_INFERENCE_RULE = prove (`(p1 has_type Bool /\ p2 has_type Bool ==> q has_type Bool /\ !sigma tau. type_valuation tau /\ term_valuation tau sigma /\ (semantics sigma tau p1 = true) /\ (semantics sigma tau p2 = true) ==> (semantics sigma tau q = true)) ==> (asl1 |= p1 /\ asl2 |= p2 ==> TERM_UNION asl1 asl2 |= q)`, REWRITE_TAC[sequent; ALL] THEN STRIP_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[ALL_BOOL_TERM_UNION] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MATCH_MP_TAC) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `ALL (\a. semantics sigma tau a = true) (TERM_UNION asl1 asl2)` THEN REWRITE_TAC[GSYM ALL_MEM] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ALL_MEM])) THEN REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN DISCH_THEN(fun th -> X_GEN_TAC `r:term` THEN DISCH_TAC THEN MP_TAC th) THEN MP_TAC(SPECL [`asl1:term list`; `asl2:term list`; `r:term`] TERM_UNION_THM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `s:term`) THEN DISCH_THEN(MP_TAC o SPEC `s:term`) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SEMANTICS_ACONV; welltyped; TERM_UNION_NONEW]);; (* ------------------------------------------------------------------------- *) (* Semantics only depends on valuations of free variables. *) (* ------------------------------------------------------------------------- *) let TERM_VALUATION_VFREE_IN = prove (`!tau sigma1 sigma2 t. type_valuation tau /\ term_valuation tau sigma1 /\ term_valuation tau sigma2 /\ welltyped t /\ (!x ty. VFREE_IN (Var x ty) t ==> (sigma1(x,ty) = sigma2(x,ty))) ==> (semantics sigma1 tau t = semantics sigma2 tau t)`, GEN_TAC THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[semantics; VFREE_IN; term_DISTINCT; term_INJ] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[]; BINOP_TAC THEN ASM_MESON_TAC[WELLTYPED_CLAUSES]; ALL_TAC] THEN MATCH_MP_TAC ABSTRACT_EQ THEN ASM_SIMP_TAC[TYPESET_INHABITED] THEN X_GEN_TAC `x:V` THEN DISCH_TAC THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[TERM_VALUATION_VALMOD; WELLTYPED; WELLTYPED_CLAUSES; SEMANTICS_TYPESET]; ALL_TAC]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN CONJ_TAC THENL [ASM_MESON_TAC[WELLTYPED_CLAUSES]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`] THEN DISCH_TAC THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Prove some inference rules correct. *) (* ------------------------------------------------------------------------- *) let ASSUME_correct = prove (`!p. p has_type Bool ==> [p] |= p`, SIMP_TAC[sequent; ALL]);; let REFL_correct = prove (`!t. welltyped t ==> [] |= t === t`, SIMP_TAC[sequent; SEMANTICS_EQUATION; ALL; WELLTYPED] THEN REWRITE_TAC[boolean; equation] THEN MESON_TAC[has_type_RULES]);; let TRANS_correct = prove (`!asl1 asl2 l m1 m2 r. asl1 |= l === m1 /\ asl2 |= m2 === r /\ ACONV m1 m2 ==> TERM_UNION asl1 asl2 |= l === r`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC BINARY_INFERENCE_RULE THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL; ACONV_TYPE]; ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; IMP_CONJ; boolean] THEN ASM_MESON_TAC[SEMANTICS_ACONV; TRUE_NE_FALSE; EQUATION_HAS_TYPE_BOOL]]);; let MK_COMB_correct = prove (`!asl1 l1 r1 asl2 l2 r2. asl1 |= l1 === r1 /\ asl2 |= l2 === r2 /\ (?rty. typeof l1 = Fun (typeof l2) rty) ==> TERM_UNION asl1 asl2 |= Comb l1 l2 === Comb r1 r2`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC BINARY_INFERENCE_RULE THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_CLAUSES; typeof] THEN MESON_TAC[codomain]; ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; IMP_CONJ; boolean] THEN REWRITE_TAC[semantics] THEN ASM_MESON_TAC[SEMANTICS_ACONV; TRUE_NE_FALSE; EQUATION_HAS_TYPE_BOOL]]);; let EQ_MP_correct = prove (`!asl1 asl2 p q p'. asl1 |= p === q /\ asl2 |= p' /\ ACONV p p' ==> TERM_UNION asl1 asl2 |= q`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC BINARY_INFERENCE_RULE THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_LEMMA; WELLTYPED; ACONV_TYPE]; ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; IMP_CONJ; boolean] THEN ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL; TRUE_NE_FALSE; SEMANTICS_ACONV; welltyped]]);; let BETA_correct = prove (`!x ty t. welltyped t ==> [] |= Comb (Abs x ty t) (Var x ty) === t`, REPEAT STRIP_TAC THEN REWRITE_TAC[sequent; ALL] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[EQUATION_HAS_TYPE_BOOL; typeof; WELLTYPED_CLAUSES] THEN REWRITE_TAC[codomain; type_INJ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[SEMANTICS_EQUATION_ALT] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[BOOLEAN_EQ_TRUE; semantics] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `semantics (((x,ty) |-> sigma(x,ty)) sigma) tau t` THEN CONJ_TAC THENL [MATCH_MP_TAC APPLY_ABSTRACT; ALL_TAC] THEN REWRITE_TAC[VALMOD_REPEAT] THEN ASM_MESON_TAC[term_valuation; SEMANTICS_TYPESET; WELLTYPED]);; let ABS_correct = prove (`!asl x ty l r. ~(EX (VFREE_IN (Var x ty)) asl) /\ asl |= l === r ==> asl |= (Abs x ty l) === (Abs x ty r)`, REPEAT GEN_TAC THEN REWRITE_TAC[sequent; ALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [UNDISCH_TAC `(l === r) has_type Bool` THEN SIMP_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_CLAUSES; typeof]; ALL_TAC] THEN DISCH_TAC THEN ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; BOOLEAN_EQ_TRUE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[semantics] THEN SUBGOAL_THEN `typeof r = typeof l` SUBST1_TAC THENL [ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL]; ALL_TAC] THEN MATCH_MP_TAC ABSTRACT_EQ THEN ASM_SIMP_TAC[TYPESET_INHABITED] THEN X_GEN_TAC `x:V` THEN DISCH_TAC THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[SEMANTICS_TYPESET; TERM_VALUATION_VALMOD; WELLTYPED; EQUATION_HAS_TYPE_BOOL]; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; BOOLEAN_EQ_TRUE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN SUBGOAL_THEN `ALL (\a. a has_type Bool) asl /\ ALL (\a. ~(VFREE_IN (Var x ty) a)) asl /\ ALL (\a. semantics sigma tau a = true) asl` MP_TAC THENL [ASM_REWRITE_TAC[GSYM NOT_EX; ETA_AX]; ALL_TAC] THEN REWRITE_TAC[AND_ALL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN X_GEN_TAC `p:term` THEN DISCH_TAC THEN REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN CONJ_TAC THENL [ASM_MESON_TAC[welltyped]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN ASM_MESON_TAC[]);; let DEDUCT_ANTISYM_RULE_correct = prove (`!asl1 asl2 p q. asl1 |= c1 /\ asl2 |= c2 ==> let asl1' = FILTER((~) o ACONV c2) asl1 and asl2' = FILTER((~) o ACONV c1) asl2 in (TERM_UNION asl1' asl2') |= c1 === c2`, REPEAT GEN_TAC THEN REWRITE_TAC[sequent; o_DEF; LET_DEF; LET_END_DEF; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT ` (a1 /\ b1 ==> c1) /\ (a1 /\ b1 /\ c1 ==> a2 /\ b2 ==> c2) ==> a1 /\ a2 /\ b1 /\ b2 ==> c1 /\ c2`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM ALL_MEM; MEM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[EQUATION_HAS_TYPE_BOOL] THEN ASM_MESON_TAC[MEM_FILTER; TERM_UNION_NONEW; welltyped; WELLTYPED_LEMMA]; ALL_TAC] THEN REWRITE_TAC[ALL; AND_FORALL_THM] THEN REWRITE_TAC[GSYM ALL_MEM] THEN STRIP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; BOOLEAN_EQ_TRUE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOOLEAN_EQ THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[typeset; SEMANTICS_TYPESET]; ALL_TAC]) THEN EQ_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `a:term` THEN DISCH_TAC THENL [ASM_CASES_TAC `ACONV c1 a` THENL [ASM_MESON_TAC[SEMANTICS_ACONV; welltyped]; ALL_TAC]; ASM_CASES_TAC `ACONV c2 a` THENL [ASM_MESON_TAC[SEMANTICS_ACONV; welltyped]; ALL_TAC]] THEN (SUBGOAL_THEN `MEM a (FILTER (\x. ~ACONV c2 x) asl1) \/ MEM a (FILTER (\x. ~ACONV c1 x) asl2)` MP_TAC THENL [REWRITE_TAC[MEM_FILTER] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP TERM_UNION_THM) THEN ASM_MESON_TAC[SEMANTICS_ACONV; welltyped]));; (* ------------------------------------------------------------------------- *) (* Correct semantics for term substitution. *) (* ------------------------------------------------------------------------- *) let DEST_VAR = new_recursive_definition term_RECURSION `DEST_VAR (Var x ty) = (x,ty)`;; let TERM_VALUATION_ITLIST = prove (`!ilist sigma tau. type_valuation tau /\ term_valuation tau sigma /\ (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) ==> term_valuation tau (ITLIST (\(t,x). DEST_VAR x |-> semantics sigma tau t) ilist sigma)`, MATCH_MP_TAC list_INDUCT THEN SIMP_TAC[ITLIST] THEN REWRITE_TAC[FORALL_PAIR_THM; MEM; PAIR_EQ] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[LEFT_FORALL_IMP_THM; FORALL_AND_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[DEST_VAR] THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD; SEMANTICS_TYPESET]);; let ITLIST_VALMOD_FILTER = prove (`!ilist sigma sem x ty y yty. (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) ==> (ITLIST (\(t,x). DEST_VAR x |-> sem x t) (FILTER (\(s',s). ~(s = Var x ty)) ilist) sigma (y,yty) = if (y = x) /\ (yty = ty) then sigma(y,yty) else ITLIST (\(t,x). DEST_VAR x |-> sem x t) ilist sigma (y,yty))`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[FILTER; ITLIST; COND_ID] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[MEM; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN REWRITE_TAC[WELLTYPED_CLAUSES; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN MAP_EVERY X_GEN_TAC [`t:term`; `pp:term`; `ilist:(term#term)list`] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:string` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `sty:type` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RAND] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RATOR] THEN ASM_REWRITE_TAC[ITLIST] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[DEST_VAR] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RATOR] THEN REWRITE_TAC[VALMOD] THEN REWRITE_TAC[term_INJ] THEN ASM_CASES_TAC `(s:string = x) /\ (sty:type = ty)` THEN ASM_SIMP_TAC[PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; let ITLIST_VALMOD_EQ = prove (`!l. (!t x. MEM (t,x) l /\ (f x = a) ==> (g x t = h x t)) /\ (i a = j a) ==> (ITLIST (\(t,x). f(x) |-> g x t) l i a = ITLIST (\(t,x). f(x) |-> h x t) l j a)`, MATCH_MP_TAC list_INDUCT THEN SIMP_TAC[MEM; ITLIST; FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[PAIR_EQ; VALMOD] THEN MESON_TAC[]);; let SEMANTICS_VSUBST = prove (`!tm sigma tau ilist. welltyped tm /\ (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) ==> !sigma tau. type_valuation tau /\ term_valuation tau sigma ==> (semantics sigma tau (VSUBST ilist tm) = semantics (ITLIST (\(t,x). DEST_VAR x |-> semantics sigma tau t) ilist sigma) tau tm)`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VSUBST; semantics] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[MEM; REV_ASSOCD; ITLIST; semantics; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`t:term`; `s:term`; `ilist:(term#term)list`] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN REWRITE_TAC[WELLTYPED_CLAUSES; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `y:string` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `tty:type` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[DEST_VAR; VALMOD; term_INJ; PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[WELLTYPED_CLAUSES] THEN REPEAT STRIP_TAC THEN BINOP_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN REWRITE_TAC[WELLTYPED_CLAUSES] THEN ASM_CASES_TAC `welltyped t` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN LET_TAC THEN LET_TAC THEN SUBGOAL_THEN `!s s'. MEM (s',s) ilist' ==> (?x ty. (s = Var x ty) /\ s' has_type ty)` ASSUME_TAC THENL [EXPAND_TAC "ilist'" THEN ASM_SIMP_TAC[MEM_FILTER]; ALL_TAC] THEN COND_CASES_TAC THENL [REPEAT LET_TAC THEN SUBGOAL_THEN `!s s'. MEM (s',s) ilist'' ==> (?x ty. (s = Var x ty) /\ s' has_type ty)` ASSUME_TAC THENL [EXPAND_TAC "ilist''" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[has_type_RULES]; ALL_TAC]; ALL_TAC] THEN REWRITE_TAC[semantics] THEN MATCH_MP_TAC ABSTRACT_EQ THEN ASM_SIMP_TAC[TYPESET_INHABITED] THEN X_GEN_TAC `a:V` THEN DISCH_TAC THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC SEMANTICS_TYPESET) THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD; TERM_VALUATION_ITLIST] THEN EXPAND_TAC "t'" THEN ASM_SIMP_TAC[VSUBST_WELLTYPED; GSYM WELLTYPED; TERM_VALUATION_VALMOD] THEN MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD; TERM_VALUATION_ITLIST] THEN MAP_EVERY X_GEN_TAC [`u:string`; `uty:type`] THEN DISCH_TAC THENL [EXPAND_TAC "ilist''" THEN REWRITE_TAC[ITLIST] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[DEST_VAR; VALMOD; PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[semantics; VALMOD]; ALL_TAC] THEN EXPAND_TAC "ilist'" THEN ASM_SIMP_TAC[ITLIST_VALMOD_FILTER] THEN REWRITE_TAC[VALMOD] THENL [ALL_TAC; REWRITE_TAC[PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ITLIST_VALMOD_EQ THEN ASM_REWRITE_TAC[VALMOD; PAIR_EQ] THEN MAP_EVERY X_GEN_TAC [`s':term`; `s:term`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `MEM (s':term,s:term) ilist`)) THEN DISCH_THEN(X_CHOOSE_THEN `w:string` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `wty:type` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN UNDISCH_TAC `DEST_VAR (Var w wty) = u,uty` THEN REWRITE_TAC[DEST_VAR; PAIR_EQ] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN CONJ_TAC THENL [ASM_MESON_TAC[welltyped]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`v:string`; `vty:type`] THEN DISCH_TAC THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(CONJUNCTS_THEN SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EX]) THEN REWRITE_TAC[GSYM ALL_MEM] THEN DISCH_THEN(MP_TAC o SPEC `(s':term,Var u uty)`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "ilist'" THEN REWRITE_TAC[MEM_FILTER] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[term_INJ]] THEN MP_TAC(ISPECL [`t':term`; `x:string`; `ty:type`] VARIANT) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "t'" THEN REWRITE_TAC[VFREE_IN_VSUBST] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) = b ==> ~a`] THEN DISCH_THEN(MP_TAC o SPECL [`u:string`; `uty:type`]) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `REV_ASSOCD (Var u uty) ilist' (Var u uty) = REV_ASSOCD (Var u uty) ilist (Var u uty)` SUBST1_TAC THENL [EXPAND_TAC "ilist'" THEN REWRITE_TAC[REV_ASSOCD_FILTER] THEN ASM_REWRITE_TAC[term_INJ]; ALL_TAC] THEN UNDISCH_TAC `!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty` THEN SPEC_TAC(`ilist:(term#term)list`,`l:(term#term)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[REV_ASSOCD; ITLIST; VFREE_IN; VALMOD; term_INJ] THEN SIMP_TAC[PAIR_EQ] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[VALMOD; REV_ASSOCD; MEM] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN REWRITE_TAC[WELLTYPED_CLAUSES; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN MAP_EVERY X_GEN_TAC [`t1:term`; `t2:term`; `i:(term#term)list`] THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC th) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `v:string` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `vty:type` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[DEST_VAR; term_INJ; PAIR_EQ] THEN SUBGOAL_THEN `(v:string = u) /\ (vty:type = uty) <=> (u = v) /\ (uty = vty)` SUBST1_TAC THENL [MESON_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD; VALMOD] THEN REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[welltyped; term_INJ]);; (* ------------------------------------------------------------------------- *) (* Hence correctness of INST. *) (* ------------------------------------------------------------------------- *) let INST_correct = prove (`!ilist asl p. (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) ==> asl |= p ==> MAP (VSUBST ilist) asl |= VSUBST ilist p`, REWRITE_TAC[sequent] THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `ALL (\a. a has_type Bool) (CONS p asl)` THEN REWRITE_TAC[ALL; ALL_MAP] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_THM]] THEN DISCH_TAC THEN MATCH_MP_TAC VSUBST_HAS_TYPE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `welltyped p` ASSUME_TAC THENL [ASM_MESON_TAC[welltyped; ALL]; ALL_TAC] THEN ASM_SIMP_TAC[SEMANTICS_VSUBST] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[TERM_VALUATION_ITLIST] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ALL_MAP]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN X_GEN_TAC `a:term` THEN DISCH_TAC THEN SUBGOAL_THEN `welltyped a` MP_TAC THENL [ASM_MESON_TAC[ALL_MEM; MEM; welltyped]; ALL_TAC] THEN ASM_SIMP_TAC[SEMANTICS_VSUBST; o_THM]);; (* ------------------------------------------------------------------------- *) (* Lemma about typesets to simplify some later goals. *) (* ------------------------------------------------------------------------- *) let TYPESET_LEMMA = prove (`!ty tau tyin. typeset (\s. typeset tau (REV_ASSOCD (Tyvar s) tyin (Tyvar s))) ty = typeset tau (TYPE_SUBST tyin ty)`, MATCH_MP_TAC type_INDUCT THEN SIMP_TAC[typeset; TYPE_SUBST]);; (* ------------------------------------------------------------------------- *) (* Semantics of type instantiation core. *) (* ------------------------------------------------------------------------- *) let SEMANTICS_INST_CORE = prove (`!n tm env tyin. welltyped tm /\ (sizeof tm = n) /\ (!s s'. MEM (s,s') env ==> ?x ty. (s = Var x ty) /\ (s' = Var x (TYPE_SUBST tyin ty))) ==> (?x ty. (INST_CORE env tyin tm = Clash(Var x (TYPE_SUBST tyin ty))) /\ VFREE_IN (Var x ty) tm /\ ~(REV_ASSOCD (Var x (TYPE_SUBST tyin ty)) env (Var x ty) = Var x ty)) \/ (!x ty. VFREE_IN (Var x ty) tm ==> (REV_ASSOCD (Var x (TYPE_SUBST tyin ty)) env (Var x ty) = Var x ty)) /\ (?tm'. (INST_CORE env tyin tm = Result tm') /\ tm' has_type (TYPE_SUBST tyin (typeof tm)) /\ (!u uty. VFREE_IN (Var u uty) tm' <=> ?oty. VFREE_IN (Var u oty) tm /\ (uty = TYPE_SUBST tyin oty)) /\ !sigma tau. type_valuation tau /\ term_valuation tau sigma ==> (semantics sigma tau tm' = semantics (\(x,ty). sigma(x,TYPE_SUBST tyin ty)) (\s. typeset tau (TYPE_SUBST tyin (Tyvar s))) tm))`, MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC term_INDUCT THEN ONCE_REWRITE_TAC[INST_CORE] THEN REWRITE_TAC[semantics] THEN REPEAT CONJ_TAC THENL [POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[REV_ASSOCD; LET_DEF; LET_END_DEF] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[result_DISTINCT; result_INJ; UNWIND_THM1] THEN REWRITE_TAC[typeof; has_type_RULES] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[RESULT; semantics; VFREE_IN; term_INJ] THEN ASM_MESON_TAC[]; POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[TYPE_SUBST; RESULT; VFREE_IN; term_DISTINCT] THEN ASM_REWRITE_TAC[result_DISTINCT; result_INJ; UNWIND_THM1] THEN REWRITE_TAC[typeof; has_type_RULES; TYPE_SUBST; VFREE_IN] THEN REWRITE_TAC[semantics; typeset; TYPESET_LEMMA; TYPE_SUBST; term_DISTINCT]; POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[TYPE_SUBST; RESULT; VFREE_IN; term_DISTINCT] THEN ASM_REWRITE_TAC[result_DISTINCT; result_INJ; UNWIND_THM1] THEN REWRITE_TAC[typeof; has_type_RULES; TYPE_SUBST; VFREE_IN] THEN REWRITE_TAC[semantics; typeset; TYPESET_LEMMA; TYPE_SUBST; term_DISTINCT]; MAP_EVERY X_GEN_TAC [`s:term`; `t:term`] THEN DISCH_THEN(K ALL_TAC) THEN POP_ASSUM MP_TAC THEN ASM_CASES_TAC `n = sizeof(Comb s t)` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `sizeof t` th) THEN MP_TAC(SPEC `sizeof s` th)) THEN REWRITE_TAC[sizeof; ARITH_RULE `s < 1 + s + t /\ t < 1 + s + t`] THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o SPEC `t:term`) THEN MP_TAC(SPEC `s:term` th)) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM; WELLTYPED_CLAUSES] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC I [IMP_CONJ] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC th) THEN DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; IS_CLASH; VFREE_IN]; ALL_TAC] THEN REWRITE_TAC[TYPE_SUBST] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s':term` STRIP_ASSUME_TAC) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; IS_CLASH; VFREE_IN]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t':term` STRIP_ASSUME_TAC) THEN DISJ2_TAC THEN CONJ_TAC THENL [REWRITE_TAC[VFREE_IN] THEN ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `Comb s' t'` THEN ASM_SIMP_TAC[LET_DEF; LET_END_DEF; IS_CLASH; semantics; RESULT] THEN ASM_REWRITE_TAC[VFREE_IN] THEN ASM_REWRITE_TAC[typeof] THEN ONCE_REWRITE_TAC[has_type_CASES] THEN REWRITE_TAC[term_DISTINCT; term_INJ; codomain] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN DISCH_THEN(K ALL_TAC) THEN POP_ASSUM MP_TAC THEN ASM_CASES_TAC `n = sizeof (Abs x ty t)` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[WELLTYPED_CLAUSES] THEN STRIP_TAC THEN REPEAT LET_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `sizeof t`) THEN REWRITE_TAC[sizeof; ARITH_RULE `t < 2 + t`] THEN DISCH_THEN(MP_TAC o SPECL [`t:term`; `env':(term#term)list`; `tyin:(type#type)list`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [EXPAND_TAC "env'" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ALL_TAC; FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t':term` STRIP_ASSUME_TAC) THEN DISJ2_TAC THEN ASM_REWRITE_TAC[IS_RESULT] THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(MP_TAC o check (is_imp o concl))) THEN EXPAND_TAC "env'" THEN REWRITE_TAC[VFREE_IN; REV_ASSOCD; term_INJ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[term_INJ] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[result_INJ; UNWIND_THM1; RESULT] THEN MATCH_MP_TAC(TAUT `a /\ b /\ (b ==> c) ==> b /\ a /\ c`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[VFREE_IN; term_INJ] THEN MAP_EVERY X_GEN_TAC [`u:string`; `uty:type`] THEN ASM_CASES_TAC `u:string = x` THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `u:string = x` SUBST_ALL_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `oty:type` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `uty = TYPE_SUBST tyin oty` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `VFREE_IN (Var x oty) t` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`x:string`; `oty:type`] th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN NO_TAC; ALL_TAC]) THEN EXPAND_TAC "env'" THEN REWRITE_TAC[REV_ASSOCD] THEN ASM_MESON_TAC[term_INJ]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[typeof; TYPE_SUBST] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[has_type_RULES]; ALL_TAC] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[semantics] THEN ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN MATCH_MP_TAC ABSTRACT_EQ THEN CONJ_TAC THENL [ASM_SIMP_TAC[TYPESET_INHABITED]; ALL_TAC] THEN X_GEN_TAC `a:V` THEN REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC SEMANTICS_TYPESET THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN ASM_MESON_TAC[welltyped; WELLTYPED]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN CONJ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SEMANTICS_TYPESET THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(x,ty' |-> a) (sigma:(string#type)->V)`; `tau:string->V`]) THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN DISCH_TAC THEN REWRITE_TAC[GSYM(CONJUNCT1 TYPE_SUBST)] THEN MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN CONJ_TAC THENL [REWRITE_TAC[type_valuation] THEN ASM_SIMP_TAC[TYPESET_INHABITED]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[term_valuation] THEN MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN ASM_MESON_TAC[term_valuation]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[term_valuation] THEN MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN REWRITE_TAC[VALMOD] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN ASM_MESON_TAC[term_valuation]; ALL_TAC] THEN UNDISCH_THEN `!u uty. VFREE_IN (Var u uty) t' <=> (?oty. VFREE_IN (Var u oty) t /\ (uty = TYPE_SUBST tyin oty))` (K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[VALMOD] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_CASES_TAC `y:string = x` THEN ASM_REWRITE_TAC[PAIR_EQ] THEN ASM_CASES_TAC `yty:type = ty` THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `y:string = x` SUBST_ALL_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:string`; `yty:type`]) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "env'" THEN ASM_REWRITE_TAC[REV_ASSOCD; term_INJ]] THEN DISCH_THEN(X_CHOOSE_THEN `z:string` (X_CHOOSE_THEN `zty:type` (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC))) THEN EXPAND_TAC "w" THEN REWRITE_TAC[CLASH; IS_RESULT; term_INJ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN DISCH_THEN(fun th -> DISJ1_TAC THEN REWRITE_TAC[result_INJ] THEN MAP_EVERY EXISTS_TAC [`z:string`; `zty:type`] THEN MP_TAC th) THEN ASM_REWRITE_TAC[VFREE_IN; term_INJ] THEN EXPAND_TAC "env'" THEN ASM_REWRITE_TAC[REV_ASSOCD; term_INJ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN STRIP_TAC THEN ONCE_REWRITE_TAC[INST_CORE] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[letlemma] THEN ABBREV_TAC `env'' = CONS (Var x' ty,Var x' ty') env` THEN ONCE_REWRITE_TAC[letlemma] THEN ABBREV_TAC `ures = INST_CORE env'' tyin (VSUBST[Var x' ty,Var x ty] t)` THEN ONCE_REWRITE_TAC[letlemma] THEN FIRST_X_ASSUM(MP_TAC o SPEC `sizeof t`) THEN REWRITE_TAC[sizeof; ARITH_RULE `t < 2 + t`] THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`VSUBST [Var x' ty,Var x ty] t`; `env'':(term#term)list`; `tyin:(type#type)list`] th) THEN MP_TAC(SPECL [`t:term`; `[]:(term#term)list`; `tyin:(type#type)list`] th)) THEN REWRITE_TAC[MEM; REV_ASSOCD] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t':term` MP_TAC) THEN STRIP_TAC THEN UNDISCH_TAC `VARIANT (RESULT (INST_CORE [] tyin t)) x ty' = x'` THEN ASM_REWRITE_TAC[RESULT] THEN DISCH_TAC THEN MP_TAC(SPECL [`t':term`; `x:string`; `ty':type`] VARIANT) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC VSUBST_WELLTYPED THEN ASM_REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[has_type_RULES]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC SIZEOF_VSUBST THEN ASM_REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[has_type_RULES]; ALL_TAC] THEN EXPAND_TAC "env''" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:string` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `vty:type` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN ASM_REWRITE_TAC[IS_RESULT; CLASH] THEN ONCE_REWRITE_TAC[letlemma] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[VFREE_IN_VSUBST] THEN EXPAND_TAC "env''" THEN REWRITE_TAC[REV_ASSOCD] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[term_INJ] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN MP_TAC) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VFREE_IN; term_INJ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [term_INJ]) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN EXPAND_TAC "env''" THEN REWRITE_TAC[REV_ASSOCD] THEN ASM_CASES_TAC `vty:type = ty` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[VFREE_IN_VSUBST; NOT_EXISTS_THM; REV_ASSOCD] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN; term_INJ] THEN MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN MP_TAC(SPECL [`t':term`; `x:string`; `ty':type`] VARIANT) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `t'':term` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IS_RESULT; result_INJ; UNWIND_THM1; result_DISTINCT] THEN REWRITE_TAC[RESULT] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> c /\ a /\ d) ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[typeof; TYPE_SUBST] THEN MATCH_MP_TAC(last(CONJUNCTS has_type_RULES)) THEN SUBGOAL_THEN `(VSUBST [Var x' ty,Var x ty] t) has_type (typeof t)` (fun th -> ASM_MESON_TAC[th; WELLTYPED_LEMMA]) THEN MATCH_MP_TAC VSUBST_HAS_TYPE THEN ASM_REWRITE_TAC[GSYM WELLTYPED] THEN REWRITE_TAC[MEM; PAIR_EQ] THEN MESON_TAC[has_type_RULES]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[VFREE_IN] THEN MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN ASM_REWRITE_TAC[VFREE_IN_VSUBST; REV_ASSOCD] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN; term_INJ] THEN SIMP_TAC[] THEN REWRITE_TAC[TAUT `x /\ (if p then a /\ b else c /\ b) <=> b /\ x /\ (if p then a else c)`] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[TAUT `x /\ (if p /\ q then a else b) <=> p /\ q /\ a /\ x \/ b /\ ~(p /\ q) /\ x`] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM1; UNWIND_THM2] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN REWRITE_TAC[VFREE_IN] THEN STRIP_TAC THEN UNDISCH_TAC `!x'' ty'. VFREE_IN (Var x'' ty') (VSUBST [Var x' ty,Var x ty] t) ==> (REV_ASSOCD (Var x'' (TYPE_SUBST tyin ty')) env'' (Var x'' ty') = Var x'' ty')` THEN DISCH_THEN(MP_TAC o SPECL [`k:string`; `kty:type`]) THEN REWRITE_TAC[VFREE_IN_VSUBST; REV_ASSOCD] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN] THEN REWRITE_TAC[VFREE_IN; term_INJ] THEN SIMP_TAC[] THEN REWRITE_TAC[TAUT `x /\ (if p then a /\ b else c /\ b) <=> b /\ x /\ (if p then a else c)`] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[TAUT `x /\ (if p /\ q then a else b) <=> p /\ q /\ a /\ x \/ b /\ ~(p /\ q) /\ x`] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM1; UNWIND_THM2] THEN UNDISCH_TAC `~(Var x ty = Var k kty)` THEN REWRITE_TAC[term_INJ] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "env''" THEN REWRITE_TAC[REV_ASSOCD] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[semantics] THEN REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSTRACT_EQ THEN CONJ_TAC THENL [ASM_SIMP_TAC[TYPESET_INHABITED]; ALL_TAC] THEN X_GEN_TAC `a:V` THEN REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC SEMANTICS_TYPESET THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN ASM_MESON_TAC[welltyped; WELLTYPED]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN CONJ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SEMANTICS_TYPESET THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN SUBGOAL_THEN `(VSUBST [Var x' ty,Var x ty] t) has_type (typeof t)` (fun th -> ASM_MESON_TAC[th; WELLTYPED_LEMMA]) THEN MATCH_MP_TAC VSUBST_HAS_TYPE THEN ASM_REWRITE_TAC[GSYM WELLTYPED] THEN REWRITE_TAC[MEM; PAIR_EQ] THEN MESON_TAC[has_type_RULES]; ALL_TAC] THEN W(fun (asl,w) -> FIRST_X_ASSUM(fun th -> MP_TAC(PART_MATCH (lhand o rand) th (lhand w)))) THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN DISCH_TAC THEN REWRITE_TAC[GSYM(CONJUNCT1 TYPE_SUBST)] THEN MP_TAC SEMANTICS_VSUBST THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_THEN(fun th -> W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) th (lhand w)))) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[MEM; PAIR_EQ] THEN CONJ_TAC THENL [MESON_TAC[has_type_RULES]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[type_valuation] THEN ASM_SIMP_TAC[TYPESET_INHABITED]; ALL_TAC] THEN REWRITE_TAC[term_valuation] THEN MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN REWRITE_TAC[VALMOD] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN ASM_MESON_TAC[term_valuation]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM(CONJUNCT1 TYPE_SUBST)] THEN MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN CONJ_TAC THENL [REWRITE_TAC[type_valuation] THEN ASM_SIMP_TAC[TYPESET_INHABITED]; ALL_TAC] THEN REWRITE_TAC[ITLIST] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[DEST_VAR] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THEN REWRITE_TAC[term_valuation; semantics] THEN MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN REWRITE_TAC[VALMOD] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[TYPESET_LEMMA; TYPE_SUBST] THEN SIMP_TAC[PAIR_EQ] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[term_valuation]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN DISCH_TAC THEN REWRITE_TAC[VALMOD; semantics] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN SIMP_TAC[PAIR_EQ] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* So in particular, we get key properties of INST itself. *) (* ------------------------------------------------------------------------- *) let SEMANTICS_INST = prove (`!tyin tm. welltyped tm ==> (INST tyin tm) has_type (TYPE_SUBST tyin (typeof tm)) /\ (!u uty. VFREE_IN (Var u uty) (INST tyin tm) <=> ?oty. VFREE_IN (Var u oty) tm /\ (uty = TYPE_SUBST tyin oty)) /\ !sigma tau. type_valuation tau /\ term_valuation tau sigma ==> (semantics sigma tau (INST tyin tm) = semantics (\(x,ty). sigma(x,TYPE_SUBST tyin ty)) (\s. typeset tau (TYPE_SUBST tyin (Tyvar s))) tm)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`sizeof tm`; `tm:term`; `[]:(term#term)list`; `tyin:(type#type)list`] SEMANTICS_INST_CORE) THEN ASM_REWRITE_TAC[MEM; INST_DEF; REV_ASSOCD] THEN MESON_TAC[RESULT]);; (* ------------------------------------------------------------------------- *) (* Hence soundness of the INST_TYPE rule. *) (* ------------------------------------------------------------------------- *) let INST_TYPE_correct = prove (`!tyin asl p. asl |= p ==> MAP (INST tyin) asl |= INST tyin p`, REWRITE_TAC[sequent] THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `ALL (\a. a has_type Bool) (CONS p asl)` THEN REWRITE_TAC[ALL; ALL_MAP] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_THM]] THEN ASM_MESON_TAC[SEMANTICS_INST; TYPE_SUBST; welltyped; WELLTYPED; WELLTYPED_LEMMA]; ALL_TAC] THEN SUBGOAL_THEN `welltyped p` ASSUME_TAC THENL [ASM_MESON_TAC[welltyped; ALL]; ALL_TAC] THEN ASM_SIMP_TAC[SEMANTICS_INST] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[type_valuation] THEN ASM_MESON_TAC[TYPESET_INHABITED]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[term_valuation] THEN REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN ASM_MESON_TAC[term_valuation]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ALL_MAP]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN X_GEN_TAC `a:term` THEN DISCH_TAC THEN SUBGOAL_THEN `welltyped a` MP_TAC THENL [ASM_MESON_TAC[ALL_MEM; MEM; welltyped]; ALL_TAC] THEN ASM_SIMP_TAC[SEMANTICS_INST; o_THM]);; (* ------------------------------------------------------------------------- *) (* Soundness. *) (* ------------------------------------------------------------------------- *) let HOL_IS_SOUND = prove (`!asl p. asl |- p ==> asl |= p`, MATCH_MP_TAC proves_INDUCT THEN REWRITE_TAC[REFL_correct; TRANS_correct; ABS_correct; BETA_correct; ASSUME_correct; EQ_MP_correct; INST_TYPE_correct; REWRITE_RULE[LET_DEF; LET_END_DEF] DEDUCT_ANTISYM_RULE_correct; REWRITE_RULE[IMP_IMP] INST_correct] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MK_COMB_correct THEN ASM_MESON_TAC[WELLTYPED_CLAUSES; MK_COMB_correct]);; (* ------------------------------------------------------------------------- *) (* Consistency. *) (* ------------------------------------------------------------------------- *) let HOL_IS_CONSISTENT = prove (`?p. p has_type Bool /\ ~([] |- p)`, SUBGOAL_THEN `?p. p has_type Bool /\ ~([] |= p)` (fun th -> MESON_TAC[th; HOL_IS_SOUND]) THEN EXISTS_TAC `Var x Bool === Var (VARIANT (Var x Bool) x Bool) Bool` THEN SIMP_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_CLAUSES; typeof; sequent; ALL; SEMANTICS_EQUATION; has_type_RULES; semantics; BOOLEAN_EQ_TRUE] THEN MP_TAC(SPECL [`Var x Bool`; `x:string`; `Bool`] VARIANT) THEN ABBREV_TAC `y = VARIANT (Var x Bool) x Bool` THEN REWRITE_TAC[VFREE_IN; term_INJ; NOT_FORALL_THM] THEN DISCH_TAC THEN EXISTS_TAC `((x:string,Bool) |-> false) (((y,Bool) |-> true) (\(x,ty). @a. a <: typeset (\x. boolset) ty))` THEN EXISTS_TAC `\x:string. boolset` THEN ASM_REWRITE_TAC[type_valuation; VALMOD; PAIR_EQ; TRUE_NE_FALSE] THEN CONJ_TAC THENL [MESON_TAC[IN_BOOL]; ALL_TAC] THEN REWRITE_TAC[term_valuation] THEN REPEAT GEN_TAC THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[typeset; IN_BOOL]) THEN CONV_TAC SELECT_CONV THEN MATCH_MP_TAC TYPESET_INHABITED THEN REWRITE_TAC[type_valuation] THEN MESON_TAC[IN_BOOL]);; hol-light/Model/syntax.ml000066400000000000000000000702571303454263000157000ustar00rootroot00000000000000(* ========================================================================= *) (* Syntactic definitions for "core HOL", including provability. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* HOL types. Just do the primitive ones for now. *) (* ------------------------------------------------------------------------- *) let type_INDUCT,type_RECURSION = define_type "type = Tyvar string | Bool | Ind | Fun type type";; let type_DISTINCT = distinctness "type";; let type_INJ = injectivity "type";; let domain = define `domain (Fun s t) = s`;; let codomain = define `codomain (Fun s t) = t`;; (* ------------------------------------------------------------------------- *) (* HOL terms. To avoid messing round with specification of the language, *) (* we just put "=" and "@" in as the only constants. For now... *) (* ------------------------------------------------------------------------- *) let term_INDUCT,term_RECURSION = define_type "term = Var string type | Equal type | Select type | Comb term term | Abs string type term";; let term_DISTINCT = distinctness "term";; let term_INJ = injectivity "term";; (* ------------------------------------------------------------------------- *) (* Typing judgements. *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_type",(12,"right"));; let has_type_RULES,has_type_INDUCT,has_type_CASES = new_inductive_definition `(!n ty. (Var n ty) has_type ty) /\ (!ty. (Equal ty) has_type (Fun ty (Fun ty Bool))) /\ (!ty. (Select ty) has_type (Fun (Fun ty Bool) ty)) /\ (!s t dty rty. s has_type (Fun dty rty) /\ t has_type dty ==> (Comb s t) has_type rty) /\ (!n dty t rty. t has_type rty ==> (Abs n dty t) has_type (Fun dty rty))`;; let welltyped = new_definition `welltyped tm <=> ?ty. tm has_type ty`;; let typeof = define `(typeof (Var n ty) = ty) /\ (typeof (Equal ty) = Fun ty (Fun ty Bool)) /\ (typeof (Select ty) = Fun (Fun ty Bool) ty) /\ (typeof (Comb s t) = codomain (typeof s)) /\ (typeof (Abs n ty t) = Fun ty (typeof t))`;; let WELLTYPED_LEMMA = prove (`!tm ty. tm has_type ty ==> (typeof tm = ty)`, MATCH_MP_TAC has_type_INDUCT THEN SIMP_TAC[typeof; has_type_RULES; codomain]);; let WELLTYPED = prove (`!tm. welltyped tm <=> tm has_type (typeof tm)`, REWRITE_TAC[welltyped] THEN MESON_TAC[WELLTYPED_LEMMA]);; let WELLTYPED_CLAUSES = prove (`(!n ty. welltyped(Var n ty)) /\ (!ty. welltyped(Equal ty)) /\ (!ty. welltyped(Select ty)) /\ (!s t. welltyped (Comb s t) <=> welltyped s /\ welltyped t /\ ?rty. typeof s = Fun (typeof t) rty) /\ (!n ty t. welltyped (Abs n ty t) = welltyped t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[welltyped] THEN (GEN_REWRITE_TAC BINDER_CONV [has_type_CASES] ORELSE GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [has_type_CASES]) THEN REWRITE_TAC[term_INJ; term_DISTINCT] THEN MESON_TAC[WELLTYPED; WELLTYPED_LEMMA]);; (* ------------------------------------------------------------------------- *) (* Since equations are important, a bit of derived syntax. *) (* ------------------------------------------------------------------------- *) parse_as_infix("===",(18,"right"));; let equation = new_definition `(s === t) = Comb (Comb (Equal(typeof s)) s) t`;; let EQUATION_HAS_TYPE_BOOL = prove (`!s t. (s === t) has_type Bool <=> welltyped s /\ welltyped t /\ (typeof s = typeof t)`, REWRITE_TAC[equation] THEN ONCE_REWRITE_TAC[has_type_CASES] THEN REWRITE_TAC[term_DISTINCT; term_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[UNWIND_THM1] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV) [has_type_CASES] THEN REWRITE_TAC[term_DISTINCT; term_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[UNWIND_THM1] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2(BINDER_CONV o LAND_CONV)) [has_type_CASES] THEN REWRITE_TAC[term_DISTINCT; term_INJ; type_INJ] THEN MESON_TAC[WELLTYPED; WELLTYPED_LEMMA]);; (* ------------------------------------------------------------------------- *) (* Alpha-conversion. *) (* ------------------------------------------------------------------------- *) let ALPHAVARS = define `(ALPHAVARS [] tmp <=> (FST tmp = SND tmp)) /\ (ALPHAVARS (CONS tp oenv) tmp <=> (tmp = tp) \/ ~(FST tp = FST tmp) /\ ~(SND tp = SND tmp) /\ ALPHAVARS oenv tmp)`;; let RACONV_RULES,RACONV_INDUCT,RACONV_CASES = new_inductive_definition `(!env x1 ty1 x2 ty2. ALPHAVARS env (Var x1 ty1,Var x2 ty2) ==> RACONV env (Var x1 ty1,Var x2 ty2)) /\ (!env ty. RACONV env (Equal ty,Equal ty)) /\ (!env ty. RACONV env (Select ty,Select ty)) /\ (!env s1 t1 s2 t2. RACONV env (s1,s2) /\ RACONV env (t1,t2) ==> RACONV env (Comb s1 t1,Comb s2 t2)) /\ (!env x1 ty1 t1 x2 ty2 t2. (ty1 = ty2) /\ RACONV (CONS ((Var x1 ty1),(Var x2 ty2)) env) (t1,t2) ==> RACONV env (Abs x1 ty1 t1,Abs x2 ty2 t2))`;; let RACONV = prove (`(RACONV env (Var x1 ty1,Var x2 ty2) <=> ALPHAVARS env (Var x1 ty1,Var x2 ty2)) /\ (RACONV env (Var x1 ty1,Equal ty2) <=> F) /\ (RACONV env (Var x1 ty1,Select ty2) <=> F) /\ (RACONV env (Var x1 ty1,Comb l2 r2) <=> F) /\ (RACONV env (Var x1 ty1,Abs x2 ty2 t2) <=> F) /\ (RACONV env (Equal ty1,Var x2 ty2) <=> F) /\ (RACONV env (Equal ty1,Equal ty2) <=> (ty1 = ty2)) /\ (RACONV env (Equal ty1,Select ty2) <=> F) /\ (RACONV env (Equal ty1,Comb l2 r2) <=> F) /\ (RACONV env (Equal ty1,Abs x2 ty2 t2) <=> F) /\ (RACONV env (Select ty1,Var x2 ty2) <=> F) /\ (RACONV env (Select ty1,Equal ty2) <=> F) /\ (RACONV env (Select ty1,Select ty2) <=> (ty1 = ty2)) /\ (RACONV env (Select ty1,Comb l2 r2) <=> F) /\ (RACONV env (Select ty1,Abs x2 ty2 t2) <=> F) /\ (RACONV env (Comb l1 r1,Var x2 ty2) <=> F) /\ (RACONV env (Comb l1 r1,Equal ty2) <=> F) /\ (RACONV env (Comb l1 r1,Select ty2) <=> F) /\ (RACONV env (Comb l1 r1,Comb l2 r2) <=> RACONV env (l1,l2) /\ RACONV env (r1,r2)) /\ (RACONV env (Comb l1 r1,Abs x2 ty2 t2) <=> F) /\ (RACONV env (Abs x1 ty1 t1,Var x2 ty2) <=> F) /\ (RACONV env (Abs x1 ty1 t1,Equal ty2) <=> F) /\ (RACONV env (Abs x1 ty1 t1,Select ty2) <=> F) /\ (RACONV env (Abs x1 ty1 t1,Comb l2 r2) <=> F) /\ (RACONV env (Abs x1 ty1 t1,Abs x2 ty2 t2) <=> (ty1 = ty2) /\ RACONV (CONS (Var x1 ty1,Var x2 ty2) env) (t1,t2))`, REPEAT CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [RACONV_CASES] THEN REWRITE_TAC[term_INJ; term_DISTINCT; PAIR_EQ] THEN MESON_TAC[]);; let ACONV = new_definition `ACONV t1 t2 <=> RACONV [] (t1,t2)`;; (* ------------------------------------------------------------------------- *) (* Reflexivity. *) (* ------------------------------------------------------------------------- *) let ALPHAVARS_REFL = prove (`!env t. ALL (\(s,t). s = t) env ==> ALPHAVARS env (t,t)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALL; ALPHAVARS] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[PAIR_EQ]);; let RACONV_REFL = prove (`!t env. ALL (\(s,t). s = t) env ==> RACONV env (t,t)`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[RACONV] THEN REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[ALPHAVARS_REFL]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ALL] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[]]);; let ACONV_REFL = prove (`!t. ACONV t t`, REWRITE_TAC[ACONV] THEN SIMP_TAC[RACONV_REFL; ALL]);; (* ------------------------------------------------------------------------- *) (* Alpha-convertible terms have the same type (if welltyped). *) (* ------------------------------------------------------------------------- *) let ALPHAVARS_TYPE = prove (`!env s t. ALPHAVARS env (s,t) /\ ALL (\(x,y). welltyped x /\ welltyped y /\ (typeof x = typeof y)) env /\ welltyped s /\ welltyped t ==> (typeof s = typeof t)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[FORALL_PAIR_THM; ALPHAVARS; ALL; PAIR_EQ] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN CONJ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[]);; let RACONV_TYPE = prove (`!env p. RACONV env p ==> ALL (\(x,y). welltyped x /\ welltyped y /\ (typeof x = typeof y)) env /\ welltyped (FST p) /\ welltyped (SND p) ==> (typeof (FST p) = typeof (SND p))`, MATCH_MP_TAC RACONV_INDUCT THEN REWRITE_TAC[FORALL_PAIR_THM; typeof] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[typeof; ALPHAVARS_TYPE]; AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[WELLTYPED_CLAUSES]; ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ALL] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[typeof] THEN ASM_MESON_TAC[WELLTYPED_CLAUSES]]);; let ACONV_TYPE = prove (`!s t. ACONV s t ==> welltyped s /\ welltyped t ==> (typeof s = typeof t)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`[]:(term#term)list`; `(s:term,t:term)`] RACONV_TYPE) THEN REWRITE_TAC[ACONV; ALL] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* HOL version of "term_union". *) (* ------------------------------------------------------------------------- *) let TERM_UNION = define `(TERM_UNION [] l2 = l2) /\ (TERM_UNION (CONS h t) l2 = let subun = TERM_UNION t l2 in if EX (ACONV h) subun then subun else CONS h subun)`;; let TERM_UNION_NONEW = prove (`!l1 l2 x. MEM x (TERM_UNION l1 l2) ==> MEM x l1 \/ MEM x l2`, LIST_INDUCT_TAC THEN REWRITE_TAC[TERM_UNION; MEM] THEN LET_TAC THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[MEM] THEN ASM_MESON_TAC[ACONV_REFL]);; let TERM_UNION_THM = prove (`!l1 l2 x. MEM x l1 \/ MEM x l2 ==> ?y. MEM y (TERM_UNION l1 l2) /\ ACONV x y`, LIST_INDUCT_TAC THEN REWRITE_TAC[TERM_UNION; MEM; GSYM EX_MEM] THENL [MESON_TAC[ACONV_REFL]; ALL_TAC] THEN REPEAT GEN_TAC THEN LET_TAC THEN COND_CASES_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[MEM] THEN ASM_MESON_TAC[ACONV_REFL]);; (* ------------------------------------------------------------------------- *) (* Handy lemma for using it in a sequent. *) (* ------------------------------------------------------------------------- *) let ALL_BOOL_TERM_UNION = prove (`ALL (\a. a has_type Bool) l1 /\ ALL (\a. a has_type Bool) l2 ==> ALL (\a. a has_type Bool) (TERM_UNION l1 l2)`, REWRITE_TAC[GSYM ALL_MEM] THEN MESON_TAC[TERM_UNION_NONEW]);; (* ------------------------------------------------------------------------- *) (* Whether a variable/constant is free in a term. *) (* ------------------------------------------------------------------------- *) let VFREE_IN = define `(VFREE_IN v (Var x ty) <=> (Var x ty = v)) /\ (VFREE_IN v (Equal ty) <=> (Equal ty = v)) /\ (VFREE_IN v (Select ty) <=> (Select ty = v)) /\ (VFREE_IN v (Comb s t) <=> VFREE_IN v s \/ VFREE_IN v t) /\ (VFREE_IN v (Abs x ty t) <=> ~(Var x ty = v) /\ VFREE_IN v t)`;; let VFREE_IN_RACONV = prove (`!env p. RACONV env p ==> !x ty. VFREE_IN (Var x ty) (FST p) /\ ~(?y. MEM (Var x ty,y) env) <=> VFREE_IN (Var x ty) (SND p) /\ ~(?y. MEM (y,Var x ty) env)`, MATCH_MP_TAC RACONV_INDUCT THEN REWRITE_TAC[VFREE_IN; term_DISTINCT] THEN REWRITE_TAC[PAIR_EQ; term_INJ; MEM] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALPHAVARS] THEN REWRITE_TAC[MEM; FORALL_PAIR_THM; term_INJ; PAIR_EQ] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);; let VFREE_IN_ACONV = prove (`!s t x t. ACONV s t ==> (VFREE_IN (Var x ty) s <=> VFREE_IN (Var x ty) t)`, REPEAT GEN_TAC THEN REWRITE_TAC[ACONV] THEN DISCH_THEN(MP_TAC o MATCH_MP VFREE_IN_RACONV) THEN SIMP_TAC[MEM; FST; SND]);; (* ------------------------------------------------------------------------- *) (* Auxiliary association list function. *) (* ------------------------------------------------------------------------- *) let REV_ASSOCD = define `(REV_ASSOCD a [] d = d) /\ (REV_ASSOCD a (CONS (x,y) t) d = if y = a then x else REV_ASSOCD a t d)`;; (* ------------------------------------------------------------------------- *) (* Substition of types in types. *) (* ------------------------------------------------------------------------- *) let TYPE_SUBST = define `(TYPE_SUBST i (Tyvar v) = REV_ASSOCD (Tyvar v) i (Tyvar v)) /\ (TYPE_SUBST i Bool = Bool) /\ (TYPE_SUBST i Ind = Ind) /\ (TYPE_SUBST i (Fun ty1 ty2) = Fun (TYPE_SUBST i ty1) (TYPE_SUBST i ty2))`;; (* ------------------------------------------------------------------------- *) (* Variant function. Deliberately underspecified at the moment. In a bid to *) (* expunge use of sets, just pick it distinct from what's free in a term. *) (* ------------------------------------------------------------------------- *) let VFREE_IN_FINITE = prove (`!t. FINITE {x | VFREE_IN x t}`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VFREE_IN] THEN REWRITE_TAC[SET_RULE `{x | a = x} = {a}`; SET_RULE `{x | P x \/ Q x} = {x | P x} UNION {x | Q x}`; SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[FINITE_INSERT; FINITE_RULES; FINITE_UNION; FINITE_INTER]);; let VFREE_IN_FINITE_ALT = prove (`!t ty. FINITE {x | VFREE_IN (Var x ty) t}`, REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\(Var x ty). x) {x | VFREE_IN x t}` THEN SIMP_TAC[VFREE_IN_FINITE; FINITE_IMAGE] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:string` THEN DISCH_TAC THEN EXISTS_TAC `Var x ty` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[]);; let VARIANT_EXISTS = prove (`!t x:string ty. ?x'. ~(VFREE_IN (Var x' ty) t)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`t:term`; `ty:type`] VFREE_IN_FINITE_ALT) THEN DISCH_THEN(MP_TAC o CONJ string_INFINITE) THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_DIFF_FINITE) THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF; IN_ELIM_THM; IN_UNIV]);; let VARIANT = new_specification ["VARIANT"] (PURE_REWRITE_RULE[SKOLEM_THM] VARIANT_EXISTS);; (* ------------------------------------------------------------------------- *) (* Term substitution. *) (* ------------------------------------------------------------------------- *) let VSUBST = define `(VSUBST ilist (Var x ty) = REV_ASSOCD (Var x ty) ilist (Var x ty)) /\ (VSUBST ilist (Equal ty) = Equal ty) /\ (VSUBST ilist (Select ty) = Select ty) /\ (VSUBST ilist (Comb s t) = Comb (VSUBST ilist s) (VSUBST ilist t)) /\ (VSUBST ilist (Abs x ty t) = let ilist' = FILTER (\(s',s). ~(s = Var x ty)) ilist in let t' = VSUBST ilist' t in if EX (\(s',s). VFREE_IN (Var x ty) s' /\ VFREE_IN s t) ilist' then let z = VARIANT t' x ty in let ilist'' = CONS (Var z ty,Var x ty) ilist' in Abs z ty (VSUBST ilist'' t) else Abs x ty t')`;; (* ------------------------------------------------------------------------- *) (* Preservation of type. *) (* ------------------------------------------------------------------------- *) let VSUBST_HAS_TYPE = prove (`!tm ty ilist. tm has_type ty /\ (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) ==> (VSUBST ilist tm) has_type ty`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VSUBST] THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `tty:type`] THEN MATCH_MP_TAC list_INDUCT THEN SIMP_TAC[REV_ASSOCD; MEM; FORALL_PAIR_THM] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN REWRITE_TAC[ LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN ASM_CASES_TAC `(Var x ty) has_type tty` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_type_CASES]) THEN REWRITE_TAC[term_DISTINCT; term_INJ; LEFT_EXISTS_AND_THM] THEN REWRITE_TAC[GSYM EXISTS_REFL] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN MAP_EVERY X_GEN_TAC [`s:term`; `u:term`; `ilist:(term#term)list`] THEN DISCH_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `y:string` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `aty:type` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_MESON_TAC[term_INJ]; SIMP_TAC[]; SIMP_TAC[]; MAP_EVERY X_GEN_TAC [`s:term`; `t:term`] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_type_CASES]) THEN REWRITE_TAC[term_DISTINCT; term_INJ; GSYM CONJ_ASSOC] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN DISCH_THEN(X_CHOOSE_THEN `dty:type` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(el 3 (CONJUNCTS has_type_RULES)) THEN EXISTS_TAC `dty:type` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`fty:type`; `ilist:(term#term)list`] THEN STRIP_TAC THEN LET_TAC THEN LET_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_type_CASES]) THEN REWRITE_TAC[term_DISTINCT; term_INJ; GSYM CONJ_ASSOC] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN DISCH_THEN(X_CHOOSE_THEN `rty:type` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN DISCH_TAC THEN COND_CASES_TAC THEN REPEAT LET_TAC THEN MATCH_MP_TAC(el 4 (CONJUNCTS has_type_RULES)) THEN EXPAND_TAC "t'" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY EXPAND_TAC ["ilist''"; "ilist'"]; EXPAND_TAC "ilist'"] THEN REWRITE_TAC[MEM; MEM_FILTER] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[has_type_RULES]);; let VSUBST_WELLTYPED = prove (`!tm ty ilist. welltyped tm /\ (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) ==> welltyped (VSUBST ilist tm)`, MESON_TAC[VSUBST_HAS_TYPE; welltyped]);; (* ------------------------------------------------------------------------- *) (* Right set of free variables. *) (* ------------------------------------------------------------------------- *) let REV_ASSOCD_FILTER = prove (`!l:(B#A)list a b d. REV_ASSOCD a (FILTER (\(y,x). P x) l) b = if P a then REV_ASSOCD a l b else b`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[REV_ASSOCD; FILTER; COND_ID] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MAP_EVERY X_GEN_TAC [`y:B`; `x:A`; `l:(B#A)list`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REV_ASSOCD] THEN ASM_CASES_TAC `(P:A->bool) x` THEN ASM_REWRITE_TAC[REV_ASSOCD] THEN ASM_MESON_TAC[]);; let VFREE_IN_VSUBST = prove (`!tm u uty ilist. VFREE_IN (Var u uty) (VSUBST ilist tm) <=> ?y ty. VFREE_IN (Var y ty) tm /\ VFREE_IN (Var u uty) (REV_ASSOCD (Var y ty) ilist (Var y ty))`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VFREE_IN; VSUBST; term_DISTINCT] THEN REPEAT CONJ_TAC THENL [MESON_TAC[term_INJ]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN LET_TAC THEN LET_TAC THEN COND_CASES_TAC THEN REPEAT LET_TAC THEN ASM_REWRITE_TAC[VFREE_IN] THENL [MAP_EVERY EXPAND_TAC ["ilist''"; "ilist'"]; EXPAND_TAC "t'" THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "ilist'"] THEN SIMP_TAC[REV_ASSOCD; REV_ASSOCD_FILTER] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN] THEN REWRITE_TAC[TAUT `(if ~b then x:bool else y) <=> (if b then y else x)`] THEN ONCE_REWRITE_TAC[TAUT `~a /\ b <=> ~(~a ==> ~b)`] THEN SIMP_TAC[TAUT `(if b then F else c) <=> ~b /\ c`] THEN MATCH_MP_TAC(TAUT `(a ==> ~c) /\ (~a ==> (b <=> c)) ==> (~(~a ==> ~b) <=> c)`) THEN (CONJ_TAC THENL [ALL_TAC; MESON_TAC[]]) THEN GEN_REWRITE_TAC LAND_CONV [term_INJ] THEN DISCH_THEN(CONJUNCTS_THEN(SUBST_ALL_TAC o SYM)) THEN REWRITE_TAC[NOT_IMP] THENL [MP_TAC(ISPECL [`VSUBST ilist' t`; `x:string`; `ty:type`] VARIANT) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "ilist'" THEN ASM_REWRITE_TAC[REV_ASSOCD_FILTER] THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EX]) THEN EXPAND_TAC "ilist'" THEN SPEC_TAC(`ilist:(term#term)list`,`l:(term#term)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALL; REV_ASSOCD; VFREE_IN] THEN REWRITE_TAC[REV_ASSOCD; FILTER; FORALL_PAIR_THM] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[ALL] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Sum type to model exception-raising. *) (* ------------------------------------------------------------------------- *) let result_INDUCT,result_RECURSION = define_type "result = Clash term | Result term";; let result_INJ = injectivity "result";; let result_DISTINCT = distinctness "result";; (* ------------------------------------------------------------------------- *) (* Discriminators and extractors. (Nicer to pattern-match...) *) (* ------------------------------------------------------------------------- *) let IS_RESULT = define `(IS_RESULT(Clash t) = F) /\ (IS_RESULT(Result t) = T)`;; let IS_CLASH = define `(IS_CLASH(Clash t) = T) /\ (IS_CLASH(Result t) = F)`;; let RESULT = define `RESULT(Result t) = t`;; let CLASH = define `CLASH(Clash t) = t`;; (* ------------------------------------------------------------------------- *) (* We want induction/recursion on term size next. *) (* ------------------------------------------------------------------------- *) let rec sizeof = define `(sizeof (Var x ty) = 1) /\ (sizeof (Equal ty) = 1) /\ (sizeof (Select ty) = 1) /\ (sizeof (Comb s t) = 1 + sizeof s + sizeof t) /\ (sizeof (Abs x ty t) = 2 + sizeof t)`;; let SIZEOF_VSUBST = prove (`!t ilist. (!s' s. MEM (s',s) ilist ==> ?x ty. s' = Var x ty) ==> (sizeof (VSUBST ilist t) = sizeof t)`, MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VSUBST; sizeof] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`] THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[MEM; REV_ASSOCD; sizeof; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`s':term`; `s:term`; `l:(term#term)list`] THEN REWRITE_TAC[PAIR_EQ] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[sizeof]; ALL_TAC] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN DISCH_TAC THEN X_GEN_TAC `ilist:(term#term)list` THEN DISCH_TAC THEN LET_TAC THEN LET_TAC THEN COND_CASES_TAC THEN REPEAT LET_TAC THEN REWRITE_TAC[sizeof; EQ_ADD_LCANCEL] THENL [ALL_TAC; ASM_MESON_TAC[MEM_FILTER]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "ilist''" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[MEM_FILTER]);; (* ------------------------------------------------------------------------- *) (* Prove existence of INST_CORE. *) (* ------------------------------------------------------------------------- *) let INST_CORE_EXISTS = prove (`?INST_CORE. (!env tyin x ty. INST_CORE env tyin (Var x ty) = let tm = Var x ty and tm' = Var x (TYPE_SUBST tyin ty) in if REV_ASSOCD tm' env tm = tm then Result tm' else Clash tm') /\ (!env tyin ty. INST_CORE env tyin (Equal ty) = Result(Equal(TYPE_SUBST tyin ty))) /\ (!env tyin ty. INST_CORE env tyin (Select ty) = Result(Select(TYPE_SUBST tyin ty))) /\ (!env tyin s t. INST_CORE env tyin (Comb s t) = let sres = INST_CORE env tyin s in if IS_CLASH sres then sres else let tres = INST_CORE env tyin t in if IS_CLASH tres then tres else let s' = RESULT sres and t' = RESULT tres in Result (Comb s' t')) /\ (!env tyin x ty t. INST_CORE env tyin (Abs x ty t) = let ty' = TYPE_SUBST tyin ty in let env' = CONS (Var x ty,Var x ty') env in let tres = INST_CORE env' tyin t in if IS_RESULT tres then Result(Abs x ty' (RESULT tres)) else let w = CLASH tres in if ~(w = Var x ty') then tres else let x' = VARIANT (RESULT(INST_CORE [] tyin t)) x ty' in INST_CORE env tyin (Abs x' ty (VSUBST [Var x' ty,Var x ty] t)))`, W(fun (asl,w) -> MATCH_MP_TAC(DISCH_ALL (pure_prove_recursive_function_exists w))) THEN EXISTS_TAC `MEASURE(\(env:(term#term)list,tyin:(type#type)list,t). sizeof t)` THEN REWRITE_TAC[WF_MEASURE; MEASURE_LE; MEASURE] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN SIMP_TAC[MEM; PAIR_EQ; term_INJ; RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM; GSYM EXISTS_REFL; SIZEOF_VSUBST; LE_REFL; sizeof] THEN REPEAT STRIP_TAC THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* So define it. *) (* ------------------------------------------------------------------------- *) let INST_CORE = new_specification ["INST_CORE"] INST_CORE_EXISTS;; (* ------------------------------------------------------------------------- *) (* And the overall function. *) (* ------------------------------------------------------------------------- *) let INST_DEF = new_definition `INST tyin tm = RESULT(INST_CORE [] tyin tm)`;; (* ------------------------------------------------------------------------- *) (* Various misc lemmas. *) (* ------------------------------------------------------------------------- *) let NOT_IS_RESULT = prove (`!r. ~(IS_RESULT r) <=> IS_CLASH r`, MATCH_MP_TAC result_INDUCT THEN REWRITE_TAC[IS_RESULT; IS_CLASH]);; let letlemma = prove (`(let x = t in P x) = P t`, REWRITE_TAC[LET_DEF; LET_END_DEF]);; (* ------------------------------------------------------------------------- *) (* Put everything together into a deductive system. *) (* ------------------------------------------------------------------------- *) parse_as_infix("|-",(11,"right"));; let prove_RULES,proves_INDUCT,proves_CASES = new_inductive_definition `(!t. welltyped t ==> [] |- t === t) /\ (!asl1 asl2 l m1 m2 r. asl1 |- l === m1 /\ asl2 |- m2 === r /\ ACONV m1 m2 ==> TERM_UNION asl1 asl2 |- l === r) /\ (!asl1 l1 r1 asl2 l2 r2. asl1 |- l1 === r1 /\ asl2 |- l2 === r2 /\ welltyped(Comb l1 l2) ==> TERM_UNION asl1 asl2 |- Comb l1 l2 === Comb r1 r2) /\ (!asl x ty l r. ~(EX (VFREE_IN (Var x ty)) asl) /\ asl |- l === r ==> asl |- (Abs x ty l) === (Abs x ty r)) /\ (!x ty t. welltyped t ==> [] |- Comb (Abs x ty t) (Var x ty) === t) /\ (!p. p has_type Bool ==> [p] |- p) /\ (!asl1 asl2 p q p'. asl1 |- p === q /\ asl2 |- p' /\ ACONV p p' ==> TERM_UNION asl1 asl2 |- q) /\ (!asl1 asl2 c1 c2. asl1 |- c1 /\ asl2 |- c2 ==> TERM_UNION (FILTER((~) o ACONV c2) asl1) (FILTER((~) o ACONV c1) asl2) |- c1 === c2) /\ (!tyin asl p. asl |- p ==> MAP (INST tyin) asl |- INST tyin p) /\ (!ilist asl p. (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) /\ asl |- p ==> MAP (VSUBST ilist) asl |- VSUBST ilist p)`;; hol-light/Multivariate/000077500000000000000000000000001303454263000154135ustar00rootroot00000000000000hol-light/Multivariate/canal.ml000066400000000000000000005346311303454263000170370ustar00rootroot00000000000000(* ========================================================================= *) (* Complex analysis. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Marco Maggesi, Graziano Gentili and Gianni Ciolli, 2008. *) (* (c) Copyright, Valentina Bruno 2010 *) (* ========================================================================= *) needs "Library/floor.ml";; needs "Library/iter.ml";; needs "Multivariate/integration.ml";; needs "Multivariate/complexes.ml";; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* Some toplogical facts formulated for the complex numbers. *) (* ------------------------------------------------------------------------- *) let CLOSED_HALFSPACE_RE_GE = prove (`!b. closed {z | Re(z) >= b}`, GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CLOSED_HALFSPACE_GE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[RE_CX; IM_CX; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CLOSED_HALFSPACE_RE_LE = prove (`!b. closed {z | Re(z) <= b}`, GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CLOSED_HALFSPACE_LE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[RE_CX; IM_CX; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CLOSED_HALFSPACE_RE_EQ = prove (`!b. closed {z | Re(z) = b}`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x = y <=> x >= y /\ x <= y`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_RE_GE; CLOSED_HALFSPACE_RE_LE]);; let OPEN_HALFSPACE_RE_GT = prove (`!b. open {z | Re(z) > b}`, REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_RE_LE; REAL_ARITH `x > y <=> ~(x <= y)`; SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; let OPEN_HALFSPACE_RE_LT = prove (`!b. open {z | Re(z) < b}`, REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_RE_GE; REAL_ARITH `x < y <=> ~(x >= y)`; SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; let CLOSED_HALFSPACE_IM_GE = prove (`!b. closed {z | Im(z) >= b}`, GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CLOSED_HALFSPACE_GE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CLOSED_HALFSPACE_IM_LE = prove (`!b. closed {z | Im(z) <= b}`, GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CLOSED_HALFSPACE_LE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CLOSED_HALFSPACE_IM_EQ = prove (`!b. closed {z | Im(z) = b}`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x = y <=> x >= y /\ x <= y`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_IM_GE; CLOSED_HALFSPACE_IM_LE]);; let OPEN_HALFSPACE_IM_GT = prove (`!b. open {z | Im(z) > b}`, REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_IM_LE; REAL_ARITH `x > y <=> ~(x <= y)`; SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; let OPEN_HALFSPACE_IM_LT = prove (`!b. open {z | Im(z) < b}`, REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_IM_GE; REAL_ARITH `x < y <=> ~(x >= y)`; SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; let CONVEX_HALFSPACE_RE_GE = prove (`!b. convex {z | Re(z) >= b}`, GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_GE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_RE_GT = prove (`!b. convex {z | Re(z) > b}`, GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_GT) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_RE_LE = prove (`!b. convex {z | Re(z) <= b}`, GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_LE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_RE_LT = prove (`!b. convex {z | Re(z) < b}`, GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_LT) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_IM_GE = prove (`!b. convex {z | Im(z) >= b}`, GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_GE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_IM_GT = prove (`!b. convex {z | Im(z) > b}`, GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_GT) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_IM_LE = prove (`!b. convex {z | Im(z) <= b}`, GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_LE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_IM_LT = prove (`!b. convex {z | Im(z) < b}`, GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_LT) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_RE_SGN = prove (`!b. convex {z | real_sgn(Re z) = b}`, REWRITE_TAC[RE_DEF; CONVEX_HALFSPACE_COMPONENT_SGN]);; let CONVEX_HALFSPACE_IM_SGN = prove (`!b. convex {z | real_sgn(Im z) = b}`, REWRITE_TAC[IM_DEF; CONVEX_HALFSPACE_COMPONENT_SGN]);; let COMPLEX_IN_BALL_0 = prove (`!v r. v IN ball(Cx(&0),r) <=> norm v < r`, REWRITE_TAC [GSYM COMPLEX_VEC_0; IN_BALL_0]);; let COMPLEX_IN_CBALL_0 = prove (`!v r. v IN cball(Cx(&0),r) <=> norm v <= r`, REWRITE_TAC [GSYM COMPLEX_VEC_0; IN_CBALL_0]);; let COMPLEX_IN_SPHERE_0 = prove (`!v r. v IN sphere(Cx(&0),r) <=> norm v = r`, REWRITE_TAC [GSYM COMPLEX_VEC_0; IN_SPHERE_0]);; let IN_BALL_RE = prove (`!x z e. x IN ball(z,e) ==> abs(Re(x) - Re(z)) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_BALL; dist] THEN MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN REAL_ARITH_TAC);; let IN_BALL_IM = prove (`!x z e. x IN ball(z,e) ==> abs(Im(x) - Im(z)) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_BALL; dist] THEN MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[IM_SUB] THEN REAL_ARITH_TAC);; let IN_CBALL_RE = prove (`!x z e. x IN cball(z,e) ==> abs(Re(x) - Re(z)) <= e`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_SUB] THEN REAL_ARITH_TAC);; let IN_CBALL_IM = prove (`!x z e. x IN cball(z,e) ==> abs(Im(x) - Im(z)) <= e`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[IM_SUB] THEN REAL_ARITH_TAC);; let CLOSED_REAL_SET = prove (`closed {z | real z}`, REWRITE_TAC[CLOSED_HALFSPACE_IM_EQ; real]);; let CLOSED_REAL = prove (`closed real`, GEN_REWRITE_TAC RAND_CONV [SET_RULE `s = {x | s x}`] THEN REWRITE_TAC[CLOSED_REAL_SET]);; let UNBOUNDED_REAL = prove (`~(bounded real)`, REWRITE_TAC[bounded; IN; REAL_EXISTS; LEFT_IMP_EXISTS_THM] THEN MESON_TAC[COMPLEX_NORM_CX; REAL_ARITH `~(abs(abs B + &1) <= B)`]);; let CONNECTED_REAL = prove (`connected real`, SIMP_TAC[CONVEX_REAL; CONVEX_CONNECTED]);; let PATH_CONNECTED_REAL = prove (`path_connected real`, SIMP_TAC[CONVEX_REAL; CONVEX_IMP_PATH_CONNECTED]);; let TRIVIAL_LIMIT_WITHIN_REAL = prove (`!z. trivial_limit (at z within real) <=> ~(real z)`, GEN_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM IN] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_CLOSED THEN REWRITE_TAC[CONNECTED_REAL; CLOSED_REAL] THEN MESON_TAC[UNBOUNDED_REAL; BOUNDED_SING]);; (* ------------------------------------------------------------------------- *) (* Complex-specific uniform limit composition theorems. *) (* ------------------------------------------------------------------------- *) let UNIFORM_LIM_COMPLEX_MUL = prove (`!net:(A)net P f g l m b1 b2. eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ eventually (\x. !n. P n ==> norm(m n) <= b2) net /\ (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm(f n x * g n x - l n * m n) < e) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o CONJ BILINEAR_COMPLEX_MUL) THEN REWRITE_TAC[UNIFORM_LIM_BILINEAR]);; let UNIFORM_LIM_COMPLEX_INV = prove (`!net:(A)net P f l b. (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ &0 < b /\ eventually (\x. !n. P n ==> b <= norm(l n)) net ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm(inv(f n x) - inv(l n)) < e) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\x. !n. P n ==> b <= norm(l n) /\ b / &2 <= norm((f:B->A->complex) n x) /\ norm(f n x - l n) < e * b pow 2 / &2` THEN REWRITE_TAC[TAUT `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL [X_GEN_TAC `x:A` THEN STRIP_TAC THEN X_GEN_TAC `n:B` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:B`) THEN ASM_REWRITE_TAC[]) THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `~((f:B->A->complex) n x = Cx(&0)) /\ ~(l n = Cx(&0))` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_NORM_CX]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> inv x - inv y = (y - x) / (x * y)`] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; COMPLEX_ENTIRE] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `b pow 2 / &2 = b / &2 * b`] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `b / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[NORM_ARITH `b <= norm l /\ norm(f - l) < b / &2 ==> b / &2 <= norm f`]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_HALF; REAL_POW_LT; REAL_LT_MUL]]]);; let UNIFORM_LIM_COMPLEX_DIV = prove (`!net:(A)net P f g l m b1 b2. eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ &0 < b2 /\ eventually (\x. !n. P n ==> b2 <= norm(m n)) net /\ (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm(f n x / g n x - l n / m n) < e) net`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC UNIFORM_LIM_COMPLEX_MUL THEN MAP_EVERY EXISTS_TAC [`b1:real`; `inv(b2):real`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1) o CONJUNCT2) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[]; MATCH_MP_TAC UNIFORM_LIM_COMPLEX_INV THEN EXISTS_TAC `b2:real` THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The usual non-uniform versions. *) (* ------------------------------------------------------------------------- *) let LIM_COMPLEX_MUL = prove (`!net:(A)net f g l m. (f --> l) net /\ (g --> m) net ==> ((\x. f x * g x) --> l * m) net`, SIMP_TAC[LIM_BILINEAR; BILINEAR_COMPLEX_MUL]);; let LIM_COMPLEX_INV = prove (`!net:(A)net f g l m. (f --> l) net /\ ~(l = Cx(&0)) ==> ((\x. inv(f x)) --> inv(l)) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `\x:one. T`; `\n:one. (f:A->complex)`; `\n:one. (l:complex)`; `norm(l:complex)`] UNIFORM_LIM_COMPLEX_INV) THEN ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN ASM_REWRITE_TAC[GSYM dist; GSYM tendsto; COMPLEX_NORM_NZ]);; let LIM_COMPLEX_DIV = prove (`!net:(A)net f g l m. (f --> l) net /\ (g --> m) net /\ ~(m = Cx(&0)) ==> ((\x. f x / g x) --> l / m) net`, REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN ASM_SIMP_TAC[LIM_COMPLEX_INV]);; let LIM_COMPLEX_POW = prove (`!net:(A)net f l n. (f --> l) net ==> ((\x. f(x) pow n) --> l pow n) net`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[LIM_COMPLEX_MUL; complex_pow; LIM_CONST]);; let LIM_COMPLEX_LMUL = prove (`!f l c. (f --> l) net ==> ((\x. c * f x) --> c * l) net`, SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; let LIM_COMPLEX_RMUL = prove (`!f l c. (f --> l) net ==> ((\x. f x * c) --> l * c) net`, SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; (* ------------------------------------------------------------------------- *) (* Mapping real limits between C and R^1. *) (* ------------------------------------------------------------------------- *) let LIM_CX_LIFT = prove (`!net f l. ((\x. Cx(f x)) --> Cx l) net <=> ((\x. lift(f x)) --> lift l) net`, REWRITE_TAC[LIM; DIST_LIFT; DIST_CX]);; let SERIES_CX_LIFT = prove (`!f s x. ((\x. Cx(f x)) sums (Cx x)) s <=> ((\x. lift(f x)) sums (lift x)) s`, SIMP_TAC[sums; LIM_CX_LIFT; VSUM_CX; FINITE_INTER; FINITE_NUMSEG] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM LIFT_SUM)]);; let LIM_INFINITY_POSINFINITY_CX = prove (`!f l:real^N. (f --> l) at_infinity ==> ((f o Cx) --> l) at_posinfinity`, REWRITE_TAC[LIM_AT_INFINITY; LIM_AT_POSINFINITY; o_THM] THEN MESON_TAC[COMPLEX_NORM_CX; REAL_ARITH `x >= b ==> abs(x) >= b`]);; (* ------------------------------------------------------------------------- *) (* Special cases of null limits. *) (* ------------------------------------------------------------------------- *) let LIM_NULL_COMPLEX = prove (`!net f. (f --> l) net <=> ((\x. f x - l) --> Cx(&0)) net`, REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM LIM_NULL]);; let LIM_NULL_COMPLEX_NORM = prove (`!net f. (f --> Cx(&0)) net <=> ((\x. Cx(norm(f x))) --> Cx(&0)) net`, REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NORM]);; let LIM_NULL_COMPLEX_NEG = prove (`!net f. (f --> Cx(&0)) net ==> ((\x. --(f x)) --> Cx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN REWRITE_TAC[COMPLEX_NEG_0]);; let LIM_NULL_COMPLEX_ADD = prove (`!net f g. (f --> Cx(&0)) net /\ (g --> Cx(&0)) net ==> ((\x. f x + g x) --> Cx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN REWRITE_TAC[COMPLEX_ADD_LID]);; let LIM_NULL_COMPLEX_SUB = prove (`!net f g. (f --> Cx(&0)) net /\ (g --> Cx(&0)) net ==> ((\x. f x - g x) --> Cx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REWRITE_TAC[COMPLEX_SUB_REFL]);; let LIM_NULL_COMPLEX_MUL = prove (`!net f g. (f --> Cx(&0)) net /\ (g --> Cx(&0)) net ==> ((\x. f x * g x) --> Cx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL) THEN REWRITE_TAC[COMPLEX_MUL_LZERO]);; let LIM_NULL_COMPLEX_LMUL = prove (`!net f c. (f --> Cx(&0)) net ==> ((\x. c * f x) --> Cx(&0)) net`, REPEAT STRIP_TAC THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = c * Cx(&0)`) THEN ASM_SIMP_TAC[LIM_COMPLEX_LMUL]);; let LIM_NULL_COMPLEX_RMUL = prove (`!net f c. (f --> Cx(&0)) net ==> ((\x. f x * c) --> Cx(&0)) net`, REPEAT STRIP_TAC THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = Cx(&0) * c`) THEN ASM_SIMP_TAC[LIM_COMPLEX_RMUL]);; let LIM_NULL_COMPLEX_POW = prove (`!net f n. (f --> Cx(&0)) net /\ ~(n = 0) ==> ((\x. (f x) pow n) --> Cx(&0)) net`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP LIM_COMPLEX_POW) THEN ASM_REWRITE_TAC[COMPLEX_POW_ZERO]);; let LIM_NULL_COMPLEX_BOUND = prove (`!f g. eventually (\n. norm (f n) <= norm (g n)) net /\ (g --> Cx(&0)) net ==> (f --> Cx(&0)) net`, REWRITE_TAC[GSYM COMPLEX_VEC_0; LIM_TRANSFORM_BOUND]);; let SUMS_COMPLEX_0 = prove (`!f s. (!n. n IN s ==> f n = Cx(&0)) ==> (f sums Cx(&0)) s`, REWRITE_TAC[GSYM COMPLEX_VEC_0; SUMS_0]);; let LIM_NULL_COMPLEX_RMUL_BOUNDED = prove (`!net f g B. (f --> Cx(&0)) net /\ eventually (\a. f a = Cx(&0) \/ norm(g a) <= B) net ==> ((\z. f(z) * g(z)) --> Cx(&0)) net`, REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[LIFT_CMUL; COMPLEX_NORM_MUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[o_DEF; NORM_LIFT; REAL_ABS_NORM; NORM_EQ_0]);; let LIM_NULL_COMPLEX_LMUL_BOUNDED = prove (`!net f g B. eventually (\a. norm(f a) <= B \/ g a = Cx(&0)) net /\ (g --> Cx(&0)) net ==> ((\z. f(z) * g(z)) --> Cx(&0)) net`, ONCE_REWRITE_TAC[DISJ_SYM; COMPLEX_MUL_SYM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Bound results for real and imaginary components of limits. *) (* ------------------------------------------------------------------------- *) let LIM_RE_UBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. Re(f x) <= b) net ==> Re(l) <= b`, REWRITE_TAC[RE_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `1`] LIM_COMPONENT_UBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; let LIM_RE_LBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= Re(f x)) net ==> b <= Re(l)`, REWRITE_TAC[RE_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `1`] LIM_COMPONENT_LBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; let LIM_IM_UBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. Im(f x) <= b) net ==> Im(l) <= b`, REWRITE_TAC[IM_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `2`] LIM_COMPONENT_UBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; let LIM_IM_LBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= Im(f x)) net ==> b <= Im(l)`, REWRITE_TAC[IM_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `2`] LIM_COMPONENT_LBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; (* ------------------------------------------------------------------------- *) (* Case analysis for limit of reciprocal of a function. This can be true *) (* degenerately, and it's a bit tiresome to show otherwise that it means *) (* what you expect. *) (* ------------------------------------------------------------------------- *) let LIM_COMPLEX_INV_NONDEGENERATE = prove (`!f:real^N->complex s a l. 2 <= dimindex(:N) /\ a IN s /\ open s /\ f continuous_on (s DELETE a) /\ ((inv o f) --> l) (at a) ==> ?t. open t /\ t SUBSET s /\ ((!x. x IN t DELETE a ==> f x = Cx(&0)) /\ l = Cx(&0) \/ (!x. x IN t DELETE a ==> ~(f x = Cx(&0))))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!e. &0 < e ==> ?z:real^N. norm(z - a) < e /\ ~(z = a) /\ f(z) = Cx(&0)` THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `s INTER ball(a:real^N,e)` THEN ASM_SIMP_TAC[INTER_SUBSET; OPEN_INTER; OPEN_BALL] THEN DISJ2_TAC THEN REWRITE_TAC[IN_DELETE; IN_INTER; IN_BALL; dist] THEN ASM_MESON_TAC[NORM_SUB]] THEN SUBGOAL_THEN `l = Cx(&0)` SUBST_ALL_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `norm(l:complex)`) THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[NORM_POS_LT; o_THM; VECTOR_SUB_EQ; COMPLEX_INV_0] THEN REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; REAL_LT_REFL]; REWRITE_TAC[]] THEN SUBGOAL_THEN `?e. &0 < e /\ !z:real^N. norm(z - a) < e /\ ~(z = a) ==> z IN s /\ (f z = Cx(&0) \/ norm(f z) >= &1)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT]) THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[o_THM; VECTOR_SUB_EQ; dist; COMPLEX_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[dist] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d e:real` THEN ASM_SIMP_TAC[REAL_LT_MIN] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[TAUT `p \/ q <=> ~p ==> q`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`)) THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN REPEAT DISCH_TAC THEN SUBST1_TAC(REAL_ARITH `&1 = inv(&1)`) THEN REWRITE_TAC[real_ge] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[GSYM COMPLEX_NORM_INV; REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[NORM_POS_LT; COMPLEX_INV_EQ_0; COMPLEX_VEC_0]; ALL_TAC] THEN EXISTS_TAC `ball(a:real^N,e)` THEN ASM_REWRITE_TAC[OPEN_BALL; SUBSET; IN_DELETE; IN_BALL; dist] THEN CONJ_TAC THENL [ASM_MESON_TAC[NORM_SUB]; DISJ1_TAC] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `f(z:real^N) = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `connected (IMAGE (lift o norm o (f:real^N->complex)) (ball(a,e) DELETE a))` MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONNECTED_PUNCTURED_BALL; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_DELETE; IN_BALL; dist] THEN ASM_MESON_TAC[NORM_SUB]; REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1]] THEN REWRITE_TAC[IS_INTERVAL_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_DELETE; IN_BALL; dist] THEN DISCH_THEN(MP_TAC o SPEC `w:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP; COMPLEX_NORM_0] THEN DISCH_THEN(MP_TAC o SPEC `lift(&1 / &2)`) THEN ASM_REWRITE_TAC[LIFT_DROP; NOT_IMP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x >= &1 ==> &1 / &2 <= x`) THEN ASM_MESON_TAC[NORM_SUB]; REWRITE_TAC[IN_IMAGE; o_THM; LIFT_EQ; IN_BALL; IN_DELETE; dist] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST_ALL_TAC o CONJUNCT2) THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_NORM_0]) THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Multiplication of complex series. *) (* ------------------------------------------------------------------------- *) let SERIES_COMPLEX_LMUL = prove (`!f l c s. (f sums l) s ==> ((\x. c * f x) sums c * l) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[LINEAR_COMPLEX_MUL]);; let SERIES_COMPLEX_RMUL = prove (`!f l c s. (f sums l) s ==> ((\x. f x * c) sums l * c) s`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[SERIES_COMPLEX_LMUL]);; let SERIES_COMPLEX_DIV = prove (`!f l c s. (f sums l) s ==> ((\x. f x / c) sums (l / c)) s`, REWRITE_TAC[complex_div; SERIES_COMPLEX_RMUL]);; let SUMMABLE_COMPLEX_LMUL = prove (`!f c s. summable s f ==> summable s (\x. c * f x)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_COMPLEX_LMUL]);; let SUMMABLE_COMPLEX_RMUL = prove (`!f c s. summable s f ==> summable s (\x. f x * c)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_COMPLEX_RMUL]);; let SUMMABLE_COMPLEX_DIV = prove (`!f c s. summable s f ==> summable s (\x. f x / c)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_COMPLEX_DIV]);; let SERIES_COMPLEX_MUL = prove (`!x y a b. (x sums a) (from 0) /\ (y sums b) (from 0) /\ (summable (from 0) (\n. lift(norm(x n))) \/ summable (from 0) (\n. lift(norm(y n)))) ==> ((\n. vsum(0..n) (\i. x i * y(n - i))) sums (a * b)) (from 0)`, MP_TAC(ISPEC `( * ):complex->complex->complex` SERIES_BILINEAR) THEN REWRITE_TAC[BILINEAR_COMPLEX_MUL]);; let SERIES_COMPLEX_MUL_UNIQUE = prove (`!x y a b c. (x sums a) (from 0) /\ (y sums b) (from 0) /\ ((\n. vsum (0..n) (\i. x i * y(n - i))) sums c) (from 0) ==> a * b = c`, MP_TAC(ISPEC `( * ):complex->complex->complex` SERIES_BILINEAR_UNIQUE) THEN REWRITE_TAC[BILINEAR_COMPLEX_MUL]);; let SUMMABLE_COMPLEX_MUL_LEFT = prove (`!x y m n p. summable (from m) (\n. lift(norm(x n))) /\ summable (from n) y ==> summable (from p) (\n. vsum(0..n) (\i. x i * y(n - i)))`, MP_TAC(ISPEC `( * ):complex->complex->complex` SUMMABLE_BILINEAR_LEFT) THEN REWRITE_TAC[BILINEAR_COMPLEX_MUL]);; let SUMMABLE_COMPLEX_MUL_RIGHT = prove (`!x y m n p. summable (from m) x /\ summable (from n) (\n. lift(norm(y n))) ==> summable (from p) (\n. vsum(0..n) (\i. x i * y(n - i)))`, MP_TAC(ISPEC `( * ):complex->complex->complex` SUMMABLE_BILINEAR_RIGHT) THEN REWRITE_TAC[BILINEAR_COMPLEX_MUL]);; (* ------------------------------------------------------------------------- *) (* Complex-specific continuity closures. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_COMPLEX_MUL = prove (`!net f g. f continuous net /\ g continuous net ==> (\x. f(x) * g(x)) continuous net`, SIMP_TAC[continuous; LIM_COMPLEX_MUL]);; let CONTINUOUS_COMPLEX_LMUL = prove (`!c f net. f continuous net ==> (\x. c * f x) continuous net`, SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST]);; let CONTINUOUS_COMPLEX_RMUL = prove (`!c f net. f continuous net ==> (\x. f x * c) continuous net`, SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST]);; let CONTINUOUS_COMPLEX_INV = prove (`!net f. f continuous net /\ ~(f(netlimit net) = Cx(&0)) ==> (\x. inv(f x)) continuous net`, SIMP_TAC[continuous; LIM_COMPLEX_INV]);; let CONTINUOUS_COMPLEX_DIV = prove (`!net f g. f continuous net /\ g continuous net /\ ~(g(netlimit net) = Cx(&0)) ==> (\x. f(x) / g(x)) continuous net`, SIMP_TAC[continuous; LIM_COMPLEX_DIV]);; let CONTINUOUS_COMPLEX_POW = prove (`!net f n. f continuous net ==> (\x. f(x) pow n) continuous net`, SIMP_TAC[continuous; LIM_COMPLEX_POW]);; let CONTINUOUS_CPRODUCT = prove (`!(net:B net) f k:A->bool. FINITE k /\ (!i. i IN k ==> f i continuous net) ==> (\z. cproduct k (\i. f i z)) continuous net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; CONTINUOUS_CONST; FORALL_IN_INSERT; ETA_AX; CONTINUOUS_COMPLEX_MUL]);; (* ------------------------------------------------------------------------- *) (* Write away the netlimit, which is otherwise a bit tedious. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_COMPLEX_INV_WITHIN = prove (`!f s a. f continuous (at a within s) /\ ~(f a = Cx(&0)) ==> (\x. inv(f x)) continuous (at a within s)`, MESON_TAC[CONTINUOUS_COMPLEX_INV; CONTINUOUS_TRIVIAL_LIMIT; NETLIMIT_WITHIN]);; let CONTINUOUS_COMPLEX_INV_AT = prove (`!f a. f continuous (at a) /\ ~(f a = Cx(&0)) ==> (\x. inv(f x)) continuous (at a)`, SIMP_TAC[CONTINUOUS_COMPLEX_INV; NETLIMIT_AT]);; let CONTINUOUS_COMPLEX_DIV_WITHIN = prove (`!f g s a. f continuous (at a within s) /\ g continuous (at a within s) /\ ~(g a = Cx(&0)) ==> (\x. f x / g x) continuous (at a within s)`, MESON_TAC[CONTINUOUS_COMPLEX_DIV; CONTINUOUS_TRIVIAL_LIMIT; NETLIMIT_WITHIN]);; let CONTINUOUS_COMPLEX_DIV_AT = prove (`!f g a. f continuous at a /\ g continuous at a /\ ~(g a = Cx(&0)) ==> (\x. f x / g x) continuous at a`, SIMP_TAC[CONTINUOUS_COMPLEX_DIV; NETLIMIT_AT]);; (* ------------------------------------------------------------------------- *) (* Also prove "on" variants as needed. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_COMPLEX_MUL = prove (`!f g s. f continuous_on s /\ g continuous_on s ==> (\x. f(x) * g(x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_COMPLEX_MUL]);; let CONTINUOUS_ON_COMPLEX_LMUL = prove (`!f:real^N->complex s. f continuous_on s ==> (\x. c * f(x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON] THEN SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; let CONTINUOUS_ON_COMPLEX_RMUL = prove (`!f:real^N->complex s. f continuous_on s ==> (\x. f(x) * c) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON] THEN SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; let CONTINUOUS_ON_COMPLEX_INV = prove (`!f:real^N->complex. f continuous_on s /\ (!x. x IN s ==> ~(f x = Cx(&0))) ==> (\x. inv(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_COMPLEX_INV_WITHIN]);; let CONTINUOUS_ON_COMPLEX_DIV = prove (`!f g s. f continuous_on s /\ g continuous_on s /\ (!x. x IN s ==> ~(g x = Cx(&0))) ==> (\x. f(x) / g(x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_COMPLEX_DIV_WITHIN]);; let CONTINUOUS_ON_COMPLEX_POW = prove (`!f n s. f continuous_on s ==> (\x. f(x) pow n) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_COMPLEX_POW]);; let CONTINUOUS_ON_CPRODUCT = prove (`!f k:A->bool s. FINITE k /\ (!i. i IN k ==> f i continuous_on s) ==> (\z. cproduct k (\i. f i z)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CPRODUCT]);; (* ------------------------------------------------------------------------- *) (* And also uniform versions. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_ON_COMPLEX_MUL = prove (`!f g s:real^N->bool. f uniformly_continuous_on s /\ g uniformly_continuous_on s /\ bounded(IMAGE f s) /\ bounded(IMAGE g s) ==> (\x. f(x) * g(x)) uniformly_continuous_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->complex`; `g:real^N->complex`; `( * ):complex->complex->complex`; `s:real^N->bool`] BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL]);; let UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL = prove (`!f c s:real^N->bool. f uniformly_continuous_on s ==> (\x. c * f x) uniformly_continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o ISPEC `\x:complex. c * x` o MATCH_MP (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN ASM_SIMP_TAC[o_DEF; LINEAR_COMPLEX_MUL; LINEAR_UNIFORMLY_CONTINUOUS_ON]);; let UNIFORMLY_CONTINUOUS_ON_COMPLEX_RMUL = prove (`!f c s:real^N->bool. f uniformly_continuous_on s ==> (\x. f x * c) uniformly_continuous_on s`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL]);; (* ------------------------------------------------------------------------- *) (* Continuity prover (not just for complex numbers but with more for them). *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_TAC = let ETA_THM = prove (`f continuous net <=> (\x. f x) continuous net`, REWRITE_TAC[ETA_AX]) in let ETA_TWEAK = GEN_REWRITE_RULE (LAND_CONV o ONCE_DEPTH_CONV) [ETA_THM] o SPEC_ALL in let tac_base = MATCH_ACCEPT_TAC CONTINUOUS_CONST ORELSE MATCH_ACCEPT_TAC CONTINUOUS_AT_ID ORELSE MATCH_ACCEPT_TAC CONTINUOUS_WITHIN_ID and tac_1 = MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_CMUL) ORELSE MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_NEG) ORELSE MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_COMPLEX_POW) and tac_2 = MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_ADD) ORELSE MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_SUB) ORELSE MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_COMPLEX_MUL) and tac_1' = MATCH_MP_TAC (ETA_TWEAK CONTINUOUS_COMPLEX_INV) and tac_2' = MATCH_MP_TAC (ETA_TWEAK CONTINUOUS_COMPLEX_DIV) in let rec CONTINUOUS_TAC gl = (tac_base ORELSE (tac_1 THEN CONTINUOUS_TAC) ORELSE (tac_2 THEN CONJ_TAC THEN CONTINUOUS_TAC) ORELSE (tac_1' THEN CONJ_TAC THENL [CONTINUOUS_TAC; REWRITE_TAC[NETLIMIT_AT; NETLIMIT_WITHIN]]) ORELSE (tac_2' THEN REPEAT CONJ_TAC THENL [CONTINUOUS_TAC; CONTINUOUS_TAC; REWRITE_TAC[NETLIMIT_AT; NETLIMIT_WITHIN]]) ORELSE ALL_TAC) gl in CONTINUOUS_TAC;; (* ------------------------------------------------------------------------- *) (* Hence a limit calculator *) (* ------------------------------------------------------------------------- *) let LIM_TAC = MATCH_MP_TAC LIM_CONTINUOUS THEN CONJ_TAC THENL [CONTINUOUS_TAC; REWRITE_TAC[NETLIMIT_AT; NETLIMIT_WITHIN]];; (* ------------------------------------------------------------------------- *) (* Continuity of the norm. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_AT_CX_NORM = prove (`!z:real^N. (\z. Cx(norm z)) continuous at z`, REWRITE_TAC[continuous_at; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN MESON_TAC[NORM_ARITH `norm(a - b:real^N) < d ==> abs(norm a - norm b) < d`]);; let CONTINUOUS_WITHIN_CX_NORM = prove (`!z:real^N s. (\z. Cx(norm z)) continuous (at z within s)`, SIMP_TAC[CONTINUOUS_AT_CX_NORM; CONTINUOUS_AT_WITHIN]);; let CONTINUOUS_ON_CX_NORM = prove (`!s. (\z. Cx(norm z)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_CX_NORM]);; let CONTINUOUS_AT_CX_DOT = prove (`!c z:real^N. (\z. Cx(c dot z)) continuous at z`, REPEAT GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear; DOT_RADD; DOT_RMUL; CX_ADD; COMPLEX_CMUL; CX_MUL]);; let CONTINUOUS_WITHIN_CX_DOT = prove (`!c z:real^N s. (\z. Cx(c dot z)) continuous (at z within s)`, SIMP_TAC[CONTINUOUS_AT_CX_DOT; CONTINUOUS_AT_WITHIN]);; let CONTINUOUS_ON_CX_DOT = prove (`!s c:real^N. (\z. Cx(c dot z)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_CX_DOT]);; (* ------------------------------------------------------------------------- *) (* Continuity switching range between complex and real^1 *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_CX_DROP = prove (`!net f. f continuous net ==> (\x. Cx(drop(f x))) continuous net`, REWRITE_TAC[continuous; tendsto] THEN REWRITE_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX; GSYM DROP_SUB] THEN REWRITE_TAC[GSYM ABS_DROP]);; let CONTINUOUS_ON_CX_DROP = prove (`!f s. f continuous_on s ==> (\x. Cx(drop(f x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CX_DROP]);; let CONTINUOUS_CX_LIFT = prove (`!f. (\x. Cx(f x)) continuous net <=> (\x. lift(f x)) continuous net`, REWRITE_TAC[continuous; LIM; dist; GSYM CX_SUB; GSYM LIFT_SUB] THEN REWRITE_TAC[COMPLEX_NORM_CX; NORM_LIFT]);; let CONTINUOUS_ON_CX_LIFT = prove (`!f s. (\x. Cx(f x)) continuous_on s <=> (\x. lift(f x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CX_LIFT]);; (* ------------------------------------------------------------------------- *) (* Linearity and continuity of the components. *) (* ------------------------------------------------------------------------- *) let LINEAR_CX_RE = prove (`linear(Cx o Re)`, SIMP_TAC[linear; o_THM; COMPLEX_CMUL; RE_ADD; RE_MUL_CX; CX_MUL; CX_ADD]);; let CONTINUOUS_AT_CX_RE = prove (`!z. (Cx o Re) continuous at z`, SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_CX_RE]);; let CONTINUOUS_ON_CX_RE = prove (`!s. (Cx o Re) continuous_on s`, SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_CX_RE]);; let LINEAR_CX_IM = prove (`linear(Cx o Im)`, SIMP_TAC[linear; o_THM; COMPLEX_CMUL; IM_ADD; IM_MUL_CX; CX_MUL; CX_ADD]);; let CONTINUOUS_AT_CX_IM = prove (`!z. (Cx o Im) continuous at z`, SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_CX_IM]);; let CONTINUOUS_ON_CX_IM = prove (`!s. (Cx o Im) continuous_on s`, SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_CX_IM]);; (* ------------------------------------------------------------------------- *) (* Complex differentiability. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("has_complex_derivative",(12,"right"));; parse_as_infix ("complex_differentiable",(12,"right"));; parse_as_infix ("holomorphic_on",(12,"right"));; let has_complex_derivative = new_definition `(f has_complex_derivative f') net <=> (f has_derivative (\x. f' * x)) net`;; let complex_differentiable = new_definition `f complex_differentiable net <=> ?f'. (f has_complex_derivative f') net`;; let complex_derivative = new_definition `complex_derivative f x = @f'. (f has_complex_derivative f') (at x)`;; let higher_complex_derivative = define `higher_complex_derivative 0 f = f /\ (!n. higher_complex_derivative (SUC n) f = complex_derivative (higher_complex_derivative n f))`;; let holomorphic_on = new_definition `f holomorphic_on s <=> !x. x IN s ==> ?f'. (f has_complex_derivative f') (at x within s)`;; let HOLOMORPHIC_ON_EMPTY = prove (`!f. f holomorphic_on {}`, REWRITE_TAC[holomorphic_on; NOT_IN_EMPTY]);; let HOLOMORPHIC_ON_DIFFERENTIABLE = prove (`!f s. f holomorphic_on s <=> !x. x IN s ==> f complex_differentiable (at x within s)`, REWRITE_TAC[holomorphic_on; complex_differentiable]);; let HOLOMORPHIC_ON_OPEN = prove (`!f s. open s ==> (f holomorphic_on s <=> !x. x IN s ==> ?f'. (f has_complex_derivative f') (at x))`, REWRITE_TAC[holomorphic_on; has_complex_derivative] THEN REWRITE_TAC[has_derivative_at; has_derivative_within] THEN SIMP_TAC[LIM_WITHIN_OPEN]);; let HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN = prove (`!f s x. f holomorphic_on s /\ x IN s ==> f complex_differentiable (at x within s)`, MESON_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE]);; let HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT = prove (`!f s x. f holomorphic_on s /\ open s /\ x IN s ==> f complex_differentiable (at x)`, MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable]);; let HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT = prove (`!f f' x. (f has_complex_derivative f') (at x) ==> f continuous at x`, REWRITE_TAC[has_complex_derivative] THEN MESON_TAC[differentiable; DIFFERENTIABLE_IMP_CONTINUOUS_AT]);; let HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN = prove (`!f f' x s. (f has_complex_derivative f') (at x within s) ==> f continuous (at x within s)`, REWRITE_TAC[has_complex_derivative] THEN MESON_TAC[differentiable; DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; let COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE = prove (`!net f. f complex_differentiable net ==> f differentiable net`, SIMP_TAC[complex_differentiable; differentiable; has_complex_derivative] THEN MESON_TAC[]);; let COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT = prove (`!f x. f complex_differentiable at x ==> f continuous at x`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; complex_differentiable]);; let COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN = prove (`!f x s. f complex_differentiable (at x within s) ==> f continuous (at x within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE; DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; let HOLOMORPHIC_ON_IMP_CONTINUOUS_ON = prove (`!f s. f holomorphic_on s ==> f continuous_on s`, REWRITE_TAC[holomorphic_on; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[has_complex_derivative] THEN MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; differentiable]);; let HOLOMORPHIC_ON_SUBSET = prove (`!f s t. f holomorphic_on s /\ t SUBSET s ==> f holomorphic_on t`, REWRITE_TAC[holomorphic_on; has_complex_derivative] THEN MESON_TAC[SUBSET; HAS_DERIVATIVE_WITHIN_SUBSET]);; let HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET = prove (`!f s t x. (f has_complex_derivative f') (at x within s) /\ t SUBSET s ==> (f has_complex_derivative f') (at x within t)`, REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_WITHIN_SUBSET]);; let COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET = prove (`!f s t. f complex_differentiable (at x within s) /\ t SUBSET s ==> f complex_differentiable (at x within t)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET]);; let HAS_COMPLEX_DERIVATIVE_AT_WITHIN = prove (`!f f' x s. (f has_complex_derivative f') (at x) ==> (f has_complex_derivative f') (at x within s)`, REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_AT_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN = prove (`!f f' a s. a IN s /\ open s ==> ((f has_complex_derivative f') (at a within s) <=> (f has_complex_derivative f') (at a))`, REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_WITHIN_OPEN]);; let COMPLEX_DIFFERENTIABLE_AT_WITHIN = prove (`!f s z. f complex_differentiable (at z) ==> f complex_differentiable (at z within s)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN = prove (`!f f' g x s d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ (f has_complex_derivative f') (at x within s) ==> (g has_complex_derivative f') (at x within s)`, REWRITE_TAC[has_complex_derivative] THEN MESON_TAC[HAS_DERIVATIVE_TRANSFORM_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove (`!f g f' s z. open s /\ z IN s /\ (!w. w IN s ==> f w = g w) /\ (f has_complex_derivative f') (at z) ==> (g has_complex_derivative f') (at z)`, REWRITE_TAC [has_complex_derivative] THEN ASM_MESON_TAC [HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN]);; let HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT = prove (`!f f' g x d. &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ (f has_complex_derivative f') (at x) ==> (g has_complex_derivative f') (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN; IN_UNIV]);; let HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT = prove (`!f s. convex s /\ (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x within s)) ==> ?c. !x. x IN s ==> f(x) = c`, REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_CONSTANT]);; let HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE = prove (`!f s c a. convex s /\ a IN s /\ f a = c /\ (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x within s)) ==> !x. x IN s ==> f(x) = c`, REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_UNIQUE]);; let HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT = prove (`!f s. open s /\ connected s /\ (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x)) ==> ?c. !x. x IN s ==> f(x) = c`, REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT]);; let HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_UNIQUE = prove (`!f s c a. open s /\ connected s /\ a IN s /\ f a = c /\ (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x)) ==> !x. x IN s ==> f(x) = c`, REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE]);; let COMPLEX_DIFF_CHAIN_WITHIN = prove (`!f g f' g' x s. (f has_complex_derivative f') (at x within s) /\ (g has_complex_derivative g') (at (f x) within (IMAGE f s)) ==> ((g o f) has_complex_derivative (g' * f'))(at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_WITHIN) THEN REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]);; let COMPLEX_DIFF_CHAIN_AT = prove (`!f g f' g' x. (f has_complex_derivative f') (at x) /\ (g has_complex_derivative g') (at (f x)) ==> ((g o f) has_complex_derivative (g' * f')) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN ASM_MESON_TAC[COMPLEX_DIFF_CHAIN_WITHIN; SUBSET_UNIV; HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET]);; let HAS_COMPLEX_DERIVATIVE_CHAIN = prove (`!P f g. (!x. P x ==> (g has_complex_derivative g'(x)) (at x)) ==> (!x s. (f has_complex_derivative f') (at x within s) /\ P(f x) ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) (at x within s)) /\ (!x. (f has_complex_derivative f') (at x) /\ P(f x) ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) (at x))`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN ASM_MESON_TAC[COMPLEX_DIFF_CHAIN_WITHIN; COMPLEX_DIFF_CHAIN_AT; HAS_COMPLEX_DERIVATIVE_AT_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV = prove (`!f g. (!x. (g has_complex_derivative g'(x)) (at x)) ==> (!x s. (f has_complex_derivative f') (at x within s) ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) (at x within s)) /\ (!x. (f has_complex_derivative f') (at x) ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) (at x))`, MP_TAC(SPEC `\x:complex. T` HAS_COMPLEX_DERIVATIVE_CHAIN) THEN SIMP_TAC[]);; let COMPLEX_DERIVATIVE_UNIQUE_AT = prove (`!f z f' f''. (f has_complex_derivative f') (at z) /\ (f has_complex_derivative f'') (at z) ==> f' = f''`, REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP FRECHET_DERIVATIVE_UNIQUE_AT) THEN DISCH_THEN(MP_TAC o C AP_THM `Cx(&1)`) THEN REWRITE_TAC[COMPLEX_MUL_RID]);; let HIGHER_COMPLEX_DERIVATIVE_1 = prove (`!f z. higher_complex_derivative 1 f z = complex_derivative f z`, REWRITE_TAC[num_CONV `1`; higher_complex_derivative]);; (* ------------------------------------------------------------------------- *) (* A more direct characterization. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_WITHIN = prove (`!f s a. (f has_complex_derivative f') (at a within s) <=> ((\x. (f(x) - f(a)) / (x - a)) --> f') (at a within s)`, REWRITE_TAC[has_complex_derivative; has_derivative_within] THEN REPEAT GEN_TAC THEN REWRITE_TAC[LINEAR_COMPLEX_MUL] THEN GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN REWRITE_TAC[LIM_WITHIN; dist; VECTOR_SUB_RZERO; NORM_MUL] THEN REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN SIMP_TAC[COMPLEX_FIELD `~(x:complex = a) ==> y / (x - a) - z = inv(x - a) * (y - z * (x - a))`] THEN REWRITE_TAC[REAL_ABS_INV; COMPLEX_NORM_MUL; REAL_ABS_NORM; COMPLEX_NORM_INV; VECTOR_ARITH `a:complex - (b + c) = a - b - c`]);; let HAS_COMPLEX_DERIVATIVE_AT = prove (`!f a. (f has_complex_derivative f') (at a) <=> ((\x. (f(x) - f(a)) / (x - a)) --> f') (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Arithmetical combining theorems. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_COMPLEX_CMUL = prove (`!net c. ((\x. c * x) has_derivative (\x. c * x)) net`, REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[LINEAR_COMPLEX_MUL]);; let HAS_COMPLEX_DERIVATIVE_LINEAR = prove (`!net c. ((\x. c * x) has_complex_derivative c) net`, REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; let HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN = prove (`!f f' c x s. (f has_complex_derivative f') (at x within s) ==> ((\x. c * f(x)) has_complex_derivative (c * f')) (at x within s)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`at ((f:complex->complex) x) within (IMAGE f s)`; `c:complex`] HAS_COMPLEX_DERIVATIVE_LINEAR) THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP COMPLEX_DIFF_CHAIN_WITHIN) THEN REWRITE_TAC[o_DEF]);; let HAS_COMPLEX_DERIVATIVE_LMUL_AT = prove (`!f f' c x. (f has_complex_derivative f') (at x) ==> ((\x. c * f(x)) has_complex_derivative (c * f')) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN = prove (`!f f' c x s. (f has_complex_derivative f') (at x within s) ==> ((\x. f(x) * c) has_complex_derivative (f' * c)) (at x within s)`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_RMUL_AT = prove (`!f f' c x. (f has_complex_derivative f') (at x) ==> ((\x. f(x) * c) has_complex_derivative (f' * c)) (at x)`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_AT]);; let HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN = prove (`!f f' c x s. (f has_complex_derivative f') (at x within s) ==> ((\x. f(x) / c) has_complex_derivative (f' / c)) (at x within s)`, SIMP_TAC[complex_div; HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_CDIV_AT = prove (`!f f' c x s. (f has_complex_derivative f') (at x) ==> ((\x. f(x) / c) has_complex_derivative (f' / c)) (at x)`, SIMP_TAC[complex_div; HAS_COMPLEX_DERIVATIVE_RMUL_AT]);; let HAS_COMPLEX_DERIVATIVE_ID = prove (`!net. ((\x. x) has_complex_derivative Cx(&1)) net`, REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_ID; COMPLEX_MUL_LID]);; let HAS_COMPLEX_DERIVATIVE_CONST = prove (`!c net. ((\x. c) has_complex_derivative Cx(&0)) net`, REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_CONST]);; let HAS_COMPLEX_DERIVATIVE_NEG = prove (`!f f' net. (f has_complex_derivative f') net ==> ((\x. --(f(x))) has_complex_derivative (--f')) net`, SIMP_TAC[has_complex_derivative; COMPLEX_MUL_LNEG; HAS_DERIVATIVE_NEG]);; let HAS_COMPLEX_DERIVATIVE_ADD = prove (`!f f' g g' net. (f has_complex_derivative f') net /\ (g has_complex_derivative g') net ==> ((\x. f(x) + g(x)) has_complex_derivative (f' + g')) net`, SIMP_TAC[has_complex_derivative; COMPLEX_ADD_RDISTRIB; HAS_DERIVATIVE_ADD]);; let HAS_COMPLEX_DERIVATIVE_SUB = prove (`!f f' g g' net. (f has_complex_derivative f') net /\ (g has_complex_derivative g') net ==> ((\x. f(x) - g(x)) has_complex_derivative (f' - g')) net`, SIMP_TAC[has_complex_derivative; COMPLEX_SUB_RDISTRIB; HAS_DERIVATIVE_SUB]);; let HAS_COMPLEX_DERIVATIVE_MUL_WITHIN = prove (`!f f' g g' x s. (f has_complex_derivative f') (at x within s) /\ (g has_complex_derivative g') (at x within s) ==> ((\x. f(x) * g(x)) has_complex_derivative (f(x) * g' + f' * g(x))) (at x within s)`, REPEAT GEN_TAC THEN SIMP_TAC[has_complex_derivative] THEN DISCH_THEN(MP_TAC o C CONJ BILINEAR_COMPLEX_MUL) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_WITHIN) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING);; let HAS_COMPLEX_DERIVATIVE_MUL_AT = prove (`!f f' g g' x. (f has_complex_derivative f') (at x) /\ (g has_complex_derivative g') (at x) ==> ((\x. f(x) * g(x)) has_complex_derivative (f(x) * g' + f' * g(x))) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_MUL_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_POW_WITHIN = prove (`!f f' x s n. (f has_complex_derivative f') (at x within s) ==> ((\x. f(x) pow n) has_complex_derivative (Cx(&n) * f(x) pow (n - 1) * f')) (at x within s)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[complex_pow] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST; COMPLEX_MUL_LZERO] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_MUL_WITHIN) THEN REWRITE_TAC[SUC_SUB1] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[COMPLEX_MUL_AC; GSYM REAL_OF_NUM_SUC] THEN SPEC_TAC(`n:num`,`n:num`) THEN REWRITE_TAC[CX_ADD] THEN INDUCT_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[SUC_SUB1; complex_pow] THEN CONV_TAC COMPLEX_FIELD);; let HAS_COMPLEX_DERIVATIVE_POW_AT = prove (`!f f' x n. (f has_complex_derivative f') (at x) ==> ((\x. f(x) pow n) has_complex_derivative (Cx(&n) * f(x) pow (n - 1) * f')) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_POW_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_INV_BASIC = prove (`!x. ~(x = Cx(&0)) ==> ((inv) has_complex_derivative (--inv(x pow 2))) (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_complex_derivative; has_derivative_at] THEN REWRITE_TAC[LINEAR_COMPLEX_MUL; COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_TRANSFORM_AWAY_AT THEN MAP_EVERY EXISTS_TAC [`\y. inv(norm(y - x)) % inv(x pow 2 * y) * (y - x) pow 2`; `Cx(&0)`] THEN ASM_REWRITE_TAC[COMPLEX_CMUL] THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN SUBGOAL_THEN `((\y. inv(x pow 2 * y) * (y - x)) --> Cx(&0)) (at x)` MP_TAC THENL [LIM_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[LIM_AT] THEN REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_INV; COMPLEX_NORM_POW] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_INV; REAL_ABS_NORM] THEN REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC) THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC(MESON[] `(p ==> x = y) ==> ((p ==> x < e) <=> (p ==> y < e))`) THEN MAP_EVERY ABBREV_TAC [`n = norm(x' - x:complex)`; `m = inv (norm(x:complex) pow 2 * norm(x':complex))`] THEN CONV_TAC REAL_FIELD);; let HAS_COMPLEX_DERIVATIVE_INV_WITHIN = prove (`!f f' x s. (f has_complex_derivative f') (at x within s) /\ ~(f x = Cx(&0)) ==> ((\x. inv(f(x))) has_complex_derivative (--f' / f(x) pow 2)) (at x within s)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(g = Cx(&0)) ==> --f / g pow 2 = --inv(g pow 2) * f`] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_WITHIN THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_INV_BASIC]);; let HAS_COMPLEX_DERIVATIVE_INV_AT = prove (`!f f' x. (f has_complex_derivative f') (at x) /\ ~(f x = Cx(&0)) ==> ((\x. inv(f(x))) has_complex_derivative (--f' / f(x) pow 2)) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_INV_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_DIV_WITHIN = prove (`!f f' g g' x s. (f has_complex_derivative f') (at x within s) /\ (g has_complex_derivative g') (at x within s) /\ ~(g(x) = Cx(&0)) ==> ((\x. f(x) / g(x)) has_complex_derivative (f' * g(x) - f(x) * g') / g(x) pow 2) (at x within s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_INV_WITHIN) THEN UNDISCH_TAC `(f has_complex_derivative f') (at x within s)` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_MUL_WITHIN) THEN REWRITE_TAC[GSYM complex_div] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; let HAS_COMPLEX_DERIVATIVE_DIV_AT = prove (`!f f' g g' x. (f has_complex_derivative f') (at x) /\ (g has_complex_derivative g') (at x) /\ ~(g(x) = Cx(&0)) ==> ((\x. f(x) / g(x)) has_complex_derivative (f' * g(x) - f(x) * g') / g(x) pow 2) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIV_WITHIN]);; let HAS_COMPLEX_DERIVATIVE_VSUM = prove (`!f net s. FINITE s /\ (!a. a IN s ==> (f a has_complex_derivative f' a) net) ==> ((\x. vsum s (\a. f a x)) has_complex_derivative (vsum s f')) net`, SIMP_TAC[GSYM VSUM_COMPLEX_RMUL; has_complex_derivative] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_VSUM) THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Same thing just for complex differentiability. *) (* ------------------------------------------------------------------------- *) let COMPLEX_DIFFERENTIABLE_LINEAR = prove (`(\z. c * z) complex_differentiable p`, REWRITE_TAC [complex_differentiable] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_LINEAR]);; let COMPLEX_DIFFERENTIABLE_CONST = prove (`!c net. (\z. c) complex_differentiable net`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CONST]);; let COMPLEX_DIFFERENTIABLE_ID = prove (`!net. (\z. z) complex_differentiable net`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_ID]);; let COMPLEX_DIFFERENTIABLE_NEG = prove (`!f net. f complex_differentiable net ==> (\z. --(f z)) complex_differentiable net`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_NEG]);; let COMPLEX_DIFFERENTIABLE_ADD = prove (`!f g net. f complex_differentiable net /\ g complex_differentiable net ==> (\z. f z + g z) complex_differentiable net`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_ADD]);; let COMPLEX_DIFFERENTIABLE_SUB = prove (`!f g net. f complex_differentiable net /\ g complex_differentiable net ==> (\z. f z - g z) complex_differentiable net`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_SUB]);; let COMPLEX_DIFFERENTIABLE_INV_WITHIN = prove (`!f z s. f complex_differentiable (at z within s) /\ ~(f z = Cx(&0)) ==> (\z. inv(f z)) complex_differentiable (at z within s)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_INV_WITHIN]);; let COMPLEX_DIFFERENTIABLE_MUL_WITHIN = prove (`!f g z s. f complex_differentiable (at z within s) /\ g complex_differentiable (at z within s) ==> (\z. f z * g z) complex_differentiable (at z within s)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_MUL_WITHIN]);; let COMPLEX_DIFFERENTIABLE_DIV_WITHIN = prove (`!f g z s. f complex_differentiable (at z within s) /\ g complex_differentiable (at z within s) /\ ~(g z = Cx(&0)) ==> (\z. f z / g z) complex_differentiable (at z within s)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIV_WITHIN]);; let COMPLEX_DIFFERENTIABLE_POW_WITHIN = prove (`!f n z s. f complex_differentiable (at z within s) ==> (\z. f z pow n) complex_differentiable (at z within s)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_POW_WITHIN]);; let COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN = prove (`!f k:A->bool z s. FINITE k /\ (!i. i IN k ==> f i complex_differentiable (at z within s)) ==> (\z. cproduct k (\i. f i z)) complex_differentiable (at z within s)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_DIFFERENTIABLE_CONST; FORALL_IN_INSERT; ETA_AX; COMPLEX_DIFFERENTIABLE_MUL_WITHIN]);; let COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN = prove (`!f g x s d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ f complex_differentiable (at x within s) ==> g complex_differentiable (at x within s)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN]);; let HOLOMORPHIC_TRANSFORM = prove (`!f g s. (!x. x IN s ==> f x = g x) /\ f holomorphic_on s ==> g holomorphic_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `&1`] THEN ASM_SIMP_TAC[REAL_LT_01]);; let HOLOMORPHIC_EQ = prove (`!f g s. (!x. x IN s ==> f x = g x) ==> (f holomorphic_on s <=> g holomorphic_on s)`, MESON_TAC[HOLOMORPHIC_TRANSFORM]);; let COMPLEX_DIFFERENTIABLE_INV_AT = prove (`!f z. f complex_differentiable at z /\ ~(f z = Cx(&0)) ==> (\z. inv(f z)) complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_INV_AT]);; let COMPLEX_DIFFERENTIABLE_MUL_AT = prove (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z ==> (\z. f z * g z) complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_MUL_AT]);; let COMPLEX_DIFFERENTIABLE_DIV_AT = prove (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z /\ ~(g z = Cx(&0)) ==> (\z. f z / g z) complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIV_AT]);; let COMPLEX_DIFFERENTIABLE_POW_AT = prove (`!f n z. f complex_differentiable at z ==> (\z. f z pow n) complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_POW_AT]);; let COMPLEX_DIFFERENTIABLE_CPRODUCT_AT = prove (`!f k:A->bool z. FINITE k /\ (!i. i IN k ==> f i complex_differentiable (at z)) ==> (\z. cproduct k (\i. f i z)) complex_differentiable (at z)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_DIFFERENTIABLE_CONST; FORALL_IN_INSERT; ETA_AX; COMPLEX_DIFFERENTIABLE_MUL_AT]);; let COMPLEX_DIFFERENTIABLE_TRANSFORM_AT = prove (`!f g x d. &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ f complex_differentiable at x ==> g complex_differentiable at x`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT]);; let COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN = prove (`!f g x s. f complex_differentiable (at x within s) /\ g complex_differentiable (at (f x) within IMAGE f s) ==> (g o f) complex_differentiable (at x within s)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[COMPLEX_DIFF_CHAIN_WITHIN]);; let COMPLEX_DIFFERENTIABLE_COMPOSE_AT = prove (`!f g x s. f complex_differentiable (at x) /\ g complex_differentiable (at (f x)) ==> (g o f) complex_differentiable (at x)`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[COMPLEX_DIFF_CHAIN_AT]);; let COMPLEX_DIFFERENTIABLE_WITHIN_OPEN = prove (`!f a s. a IN s /\ open s ==> (f complex_differentiable at a within s <=> f complex_differentiable at a)`, SIMP_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN]);; (* ------------------------------------------------------------------------- *) (* Same again for being holomorphic on a set. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_ON_LINEAR = prove (`!s c. (\w. c * w) holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_LINEAR]);; let HOLOMORPHIC_ON_CONST = prove (`!c s. (\z. c) holomorphic_on s`, REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_CONST]);; let HOLOMORPHIC_ON_ID = prove (`!s. (\z. z) holomorphic_on s`, REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_ID]);; let HOLOMORPHIC_ON_COMPOSE = prove (`!f g s. f holomorphic_on s /\ g holomorphic_on (IMAGE f s) ==> (g o f) holomorphic_on s`, SIMP_TAC[holomorphic_on; GSYM complex_differentiable; FORALL_IN_IMAGE] THEN MESON_TAC[COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN]);; let HOLOMORPHIC_ON_NEG = prove (`!f s. f holomorphic_on s ==> (\z. --(f z)) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_NEG]);; let HOLOMORPHIC_ON_ADD = prove (`!f g s. f holomorphic_on s /\ g holomorphic_on s ==> (\z. f z + g z) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_ADD]);; let HOLOMORPHIC_ON_SUB = prove (`!f g s. f holomorphic_on s /\ g holomorphic_on s ==> (\z. f z - g z) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_SUB]);; let HOLOMORPHIC_ON_MUL = prove (`!f g s. f holomorphic_on s /\ g holomorphic_on s ==> (\z. f z * g z) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_MUL_WITHIN]);; let HOLOMORPHIC_ON_LMUL = prove (`!f c s. f holomorphic_on s ==> (\x. c * f x) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST]);; let HOLOMORPHIC_ON_RMUL = prove (`!f c s. f holomorphic_on s ==> (\x. f x * c) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST]);; let HOLOMORPHIC_ON_INV = prove (`!f s. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> (\z. inv(f z)) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_INV_WITHIN]);; let HOLOMORPHIC_ON_DIV = prove (`!f g s. f holomorphic_on s /\ g holomorphic_on s /\ (!z. z IN s ==> ~(g z = Cx(&0))) ==> (\z. f z / g z) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_DIV_WITHIN]);; let HOLOMORPHIC_ON_POW = prove (`!f s n. f holomorphic_on s ==> (\z. (f z) pow n) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_POW_WITHIN]);; let HOLOMORPHIC_ON_VSUM = prove (`!f s k. FINITE k /\ (!a. a IN k ==> (f a) holomorphic_on s) ==> (\x. vsum k (\a. f a x)) holomorphic_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES] THEN SIMP_TAC[HOLOMORPHIC_ON_CONST; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN ASM_SIMP_TAC[ETA_AX]);; let HOLOMORPHIC_ON_CPRODUCT = prove (`!f k:A->bool s. FINITE k /\ (!i. i IN k ==> f i holomorphic_on s) ==> (\z. cproduct k (\i. f i z)) holomorphic_on s`, SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN]);; let HOLOMORPHIC_ON_COMPOSE_GEN = prove (`!f g s t. f holomorphic_on s /\ g holomorphic_on t /\ (!z. z IN s ==> f z IN t) ==> g o f holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:complex->complex) s SUBSET t` MP_TAC THENL [ASM SET_TAC []; ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET; COMPLEX_DIFF_CHAIN_WITHIN]]);; (* ------------------------------------------------------------------------- *) (* Same again for the actual derivative function. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_DERIVATIVE = prove (`!f f' x. (f has_complex_derivative f') (at x) ==> complex_derivative f x = f'`, REWRITE_TAC[complex_derivative] THEN MESON_TAC[COMPLEX_DERIVATIVE_UNIQUE_AT]);; let HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE = prove (`!f x. (f has_complex_derivative (complex_derivative f x)) (at x) <=> f complex_differentiable at x`, REWRITE_TAC[complex_differentiable; complex_derivative] THEN MESON_TAC[]);; let COMPLEX_DIFFERENTIABLE_COMPOSE = prove (`!f g z. f complex_differentiable at z /\ g complex_differentiable at (f z) ==> (g o f) complex_differentiable at z`, REWRITE_TAC [complex_differentiable] THEN MESON_TAC [COMPLEX_DIFF_CHAIN_AT]);; let COMPLEX_DERIVATIVE_CHAIN = prove (`!f g z. f complex_differentiable at z /\ g complex_differentiable at (f z) ==> complex_derivative (g o f) z = complex_derivative g (f z) * complex_derivative f z`, MESON_TAC [HAS_COMPLEX_DERIVATIVE_DERIVATIVE; COMPLEX_DIFF_CHAIN_AT; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DERIVATIVE_LINEAR = prove (`!c. complex_derivative (\w. c * w) = \z. c`, REWRITE_TAC [FUN_EQ_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN REWRITE_TAC [HAS_COMPLEX_DERIVATIVE_LINEAR]);; let COMPLEX_DERIVATIVE_ID = prove (`complex_derivative (\w.w) = \z. Cx(&1)`, REWRITE_TAC [FUN_EQ_THM] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_DERIVATIVE; HAS_COMPLEX_DERIVATIVE_ID]);; let COMPLEX_DERIVATIVE_CONST = prove (`!c. complex_derivative (\w.c) = \z. Cx(&0)`, REWRITE_TAC [FUN_EQ_THM] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_DERIVATIVE; HAS_COMPLEX_DERIVATIVE_CONST]);; let COMPLEX_DERIVATIVE_ADD = prove (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z ==> complex_derivative (\w. f w + g w) z = complex_derivative f z + complex_derivative g z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_ADD; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DERIVATIVE_SUB = prove (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z ==> complex_derivative (\w. f w - g w) z = complex_derivative f z - complex_derivative g z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_SUB; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DERIVATIVE_MUL = prove (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z ==> complex_derivative (\w. f w * g w) z = f z * complex_derivative g z + complex_derivative f z * g z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_MUL_AT; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DERIVATIVE_LMUL = prove (`!f c z. f complex_differentiable at z ==> complex_derivative (\w. c * f w) z = c * complex_derivative f z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_LMUL_AT; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DERIVATIVE_RMUL = prove (`!f c z. f complex_differentiable at z ==> complex_derivative (\w. f w * c) z = complex_derivative f z * c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_RMUL_AT; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove (`!f g s z. open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s /\ (!w. w IN s ==> f w = g w) ==> complex_derivative f z = complex_derivative g z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; let COMPLEX_DERIVATIVE_COMPOSE_LINEAR = prove (`!f c z. f complex_differentiable at (c * z) ==> complex_derivative (\w. f (c * w)) z = c * complex_derivative f (c * z)`, SIMP_TAC [COMPLEX_MUL_SYM; REWRITE_RULE [o_DEF; COMPLEX_DIFFERENTIABLE_ID; COMPLEX_DIFFERENTIABLE_LINEAR; COMPLEX_DERIVATIVE_LINEAR] (SPECL [`\w:complex. c * w`] COMPLEX_DERIVATIVE_CHAIN)]);; (* ------------------------------------------------------------------------- *) (* Caratheodory characterization. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT = prove (`!f f' z. (f has_complex_derivative f') (at z) <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g continuous at z /\ g(z) = f'`, REPEAT GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `w' - z':complex = a <=> w' = z' + a`] THEN SIMP_TAC[GSYM FUN_EQ_THM; HAS_COMPLEX_DERIVATIVE_AT; CONTINUOUS_AT] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `\w. if w = z then f':complex else (f(w) - f(z)) / (w - z)` THEN ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; COMPLEX_SUB_REFL] THEN CONV_TAC COMPLEX_FIELD; FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN ASM_SIMP_TAC[COMPLEX_RING `(z + a) - (z + b * (w - w)):complex = a`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN SIMP_TAC[LIM_CONST; COMPLEX_VEC_0; COMPLEX_FIELD `~(w = z) ==> x - (x * (w - z)) / (w - z) = Cx(&0)`]]);; let HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN = prove (`!f f' z s. (f has_complex_derivative f') (at z within s) <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g continuous (at z within s) /\ g(z) = f'`, REPEAT GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `w' - z':complex = a <=> w' = z' + a`] THEN SIMP_TAC[GSYM FUN_EQ_THM; HAS_COMPLEX_DERIVATIVE_WITHIN; CONTINUOUS_WITHIN] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `\w. if w = z then f':complex else (f(w) - f(z)) / (w - z)` THEN ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; COMPLEX_SUB_REFL] THEN CONV_TAC COMPLEX_FIELD; FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN ASM_SIMP_TAC[COMPLEX_RING `(z + a) - (z + b * (w - w)):complex = a`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN SIMP_TAC[LIM_CONST; COMPLEX_VEC_0; COMPLEX_FIELD `~(w = z) ==> x - (x * (w - z)) / (w - z) = Cx(&0)`]]);; let COMPLEX_DIFFERENTIABLE_CARATHEODORY_AT = prove (`!f z. f complex_differentiable at z <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g continuous at z`, SIMP_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT] THEN MESON_TAC[]);; let COMPLEX_DIFFERENTIABLE_CARATHEODORY_WITHIN = prove (`!f z s. f complex_differentiable (at z within s) <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g continuous (at z within s)`, SIMP_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A slightly stronger, more traditional notion of analyticity on a set. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("analytic_on",(12,"right"));; let analytic_on = new_definition `f analytic_on s <=> !x. x IN s ==> ?e. &0 < e /\ f holomorphic_on ball(x,e)`;; let ANALYTIC_IMP_HOLOMORPHIC = prove (`!f s. f analytic_on s ==> f holomorphic_on s`, REWRITE_TAC[analytic_on; holomorphic_on] THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; CENTRE_IN_BALL]);; let ANALYTIC_ON_OPEN = prove (`!f s. open s ==> (f analytic_on s <=> f holomorphic_on s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[ANALYTIC_IMP_HOLOMORPHIC] THEN REWRITE_TAC[analytic_on; holomorphic_on] THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[CENTRE_IN_BALL]);; let ANALYTIC_ON_IMP_DIFFERENTIABLE_AT = prove (`!f s x. f analytic_on s /\ x IN s ==> f complex_differentiable (at x)`, SIMP_TAC[analytic_on; HOLOMORPHIC_ON_OPEN; OPEN_BALL; complex_differentiable] THEN MESON_TAC[CENTRE_IN_BALL]);; let ANALYTIC_ON_SUBSET = prove (`!f s t. f analytic_on s /\ t SUBSET s ==> f analytic_on t`, REWRITE_TAC[analytic_on; SUBSET] THEN MESON_TAC[]);; let ANALYTIC_ON_UNION = prove (`!f s t. f analytic_on (s UNION t) <=> f analytic_on s /\ f analytic_on t`, REWRITE_TAC [analytic_on; IN_UNION] THEN MESON_TAC[]);; let ANALYTIC_ON_UNIONS = prove (`!f s. f analytic_on (UNIONS s) <=> (!t. t IN s ==> f analytic_on t)`, REWRITE_TAC [analytic_on; IN_UNIONS] THEN MESON_TAC[]);; let ANALYTIC_ON_HOLOMORPHIC = prove (`!f s. f analytic_on s <=> ?t. open t /\ s SUBSET t /\ f holomorphic_on t`, REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `?t. open t /\ s SUBSET t /\ f analytic_on t` THEN CONJ_TAC THENL [EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `UNIONS {u | open u /\ f analytic_on u}` THEN SIMP_TAC [IN_ELIM_THM; OPEN_UNIONS; ANALYTIC_ON_UNIONS] THEN REWRITE_TAC [SUBSET; IN_UNIONS; IN_ELIM_THM] THEN ASM_MESON_TAC [analytic_on; ANALYTIC_ON_OPEN; OPEN_BALL; CENTRE_IN_BALL]; MESON_TAC [ANALYTIC_ON_SUBSET]]; MESON_TAC [ANALYTIC_ON_OPEN]]);; let ANALYTIC_ON_LINEAR = prove (`!s c. (\w. c * w) analytic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC [ANALYTIC_ON_HOLOMORPHIC; HOLOMORPHIC_ON_LINEAR] THEN EXISTS_TAC `(:complex)` THEN REWRITE_TAC [OPEN_UNIV; SUBSET_UNIV]);; let ANALYTIC_ON_CONST = prove (`!c s. (\z. c) analytic_on s`, REWRITE_TAC[analytic_on; HOLOMORPHIC_ON_CONST] THEN MESON_TAC[REAL_LT_01]);; let ANALYTIC_ON_ID = prove (`!s. (\z. z) analytic_on s`, REWRITE_TAC[analytic_on; HOLOMORPHIC_ON_ID] THEN MESON_TAC[REAL_LT_01]);; let ANALYTIC_ON_COMPOSE = prove (`!f g s. f analytic_on s /\ g analytic_on (IMAGE f s) ==> (g o f) analytic_on s`, REWRITE_TAC[analytic_on; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "f") (LABEL_TAC "g")) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REMOVE_THEN "f" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; CONTINUOUS_AT_BALL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min (d:real) k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THENL [EXISTS_TAC `ball(z:complex,d)`; EXISTS_TAC `ball((f:complex->complex) z,e)`] THEN ASM_REWRITE_TAC[BALL_MIN_INTER; INTER_SUBSET] THEN ASM SET_TAC[]);; let ANALYTIC_ON_COMPOSE_GEN = prove (`!f g s t. f analytic_on s /\ g analytic_on t /\ (!z. z IN s ==> f z IN t) ==> g o f analytic_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ANALYTIC_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN ASM SET_TAC[]);; let ANALYTIC_ON_NEG = prove (`!f s. f analytic_on s ==> (\z. --(f z)) analytic_on s`, SIMP_TAC[analytic_on] THEN MESON_TAC[HOLOMORPHIC_ON_NEG]);; let ANALYTIC_ON_ADD = prove (`!f g s. f analytic_on s /\ g analytic_on s ==> (\z. f z + g z) analytic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `e:real`)) THEN EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN; BALL_MIN_INTER; IN_INTER] THEN MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; let ANALYTIC_ON_SUB = prove (`!f g s. f analytic_on s /\ g analytic_on s ==> (\z. f z - g z) analytic_on s`, SIMP_TAC[complex_sub; ANALYTIC_ON_ADD; ANALYTIC_ON_NEG]);; let ANALYTIC_ON_MUL = prove (`!f g s. f analytic_on s /\ g analytic_on s ==> (\z. f z * g z) analytic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `e:real`)) THEN EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN; BALL_MIN_INTER; IN_INTER] THEN MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; let ANALYTIC_ON_INV = prove (`!f s. f analytic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> (\z. inv(f z)) analytic_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[analytic_on] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [analytic_on]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?e. &0 < e /\ !y:complex. dist(z,y) < e ==> ~(f y = Cx(&0))` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_OPEN_AVOID THEN EXISTS_TAC `ball(z:complex,d)` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CENTRE_IN_BALL; OPEN_BALL]; REWRITE_TAC[GSYM IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN ASM_SIMP_TAC[BALL_MIN_INTER; IN_INTER] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]]);; let ANALYTIC_ON_DIV = prove (`!f g s. f analytic_on s /\ g analytic_on s /\ (!z. z IN s ==> ~(g z = Cx(&0))) ==> (\z. f z / g z) analytic_on s`, SIMP_TAC[complex_div; ANALYTIC_ON_MUL; ANALYTIC_ON_INV]);; let ANALYTIC_ON_POW = prove (`!f s n. f analytic_on s ==> (\z. (f z) pow n) analytic_on s`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[complex_pow] THEN ASM_SIMP_TAC[ANALYTIC_ON_CONST; ANALYTIC_ON_MUL]);; let ANALYTIC_ON_VSUM = prove (`!f s k. FINITE k /\ (!a. a IN k ==> (f a) analytic_on s) ==> (\x. vsum k (\a. f a x)) analytic_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES] THEN SIMP_TAC[ANALYTIC_ON_CONST; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ANALYTIC_ON_ADD THEN ASM_SIMP_TAC[ETA_AX]);; (* ------------------------------------------------------------------------- *) (* The case of analyticity at a point. *) (* ------------------------------------------------------------------------- *) let ANALYTIC_AT_BALL = prove (`!f z. f analytic_on {z} <=> ?e. &0 ?s. open s /\ z IN s /\ f holomorphic_on s`, REWRITE_TAC [ANALYTIC_ON_HOLOMORPHIC; SING_SUBSET]);; let ANALYTIC_ON_ANALYTIC_AT = prove (`!f s. f analytic_on s <=> !z. z IN s ==> f analytic_on {z}`, REWRITE_TAC [ANALYTIC_AT_BALL; analytic_on]);; let ANALYTIC_AT_TWO = prove (`!f g z. f analytic_on {z} /\ g analytic_on {z} <=> ?s. open s /\ z IN s /\ f holomorphic_on s /\ g holomorphic_on s`, REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_SUBSET; OPEN_INTER; INTER_SUBSET; IN_INTER]);; let ANALYTIC_AT_ADD = prove (`!f g z. f analytic_on {z} /\ g analytic_on {z} ==> (\w. f w + g w) analytic_on {z}`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_ADD]);; let ANALYTIC_AT_SUB = prove (`!f g z. f analytic_on {z} /\ g analytic_on {z} ==> (\w. f w - g w) analytic_on {z}`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_SUB]);; let ANALYTIC_AT_MUL = prove (`!f g z. f analytic_on {z} /\ g analytic_on {z} ==> (\w. f w * g w) analytic_on {z}`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_MUL]);; let ANALYTIC_AT_POW = prove (`!f n z. f analytic_on {z} ==> (\w. f w pow n) analytic_on {z}`, REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_POW]);; (* ------------------------------------------------------------------------- *) (* Combining theorems for derivative with analytic_at {z} hypotheses. *) (* ------------------------------------------------------------------------- *) let COMPLEX_DERIVATIVE_ADD_AT = prove (`!f g z. f analytic_on {z} /\ g analytic_on {z} ==> complex_derivative (\w. f w + g w) z = complex_derivative f z + complex_derivative g z`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_ADD THEN ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]);; let COMPLEX_DERIVATIVE_SUB_AT = prove (`!f g z. f analytic_on {z} /\ g analytic_on {z} ==> complex_derivative (\w. f w - g w) z = complex_derivative f z - complex_derivative g z`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_SUB THEN ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]);; let COMPLEX_DERIVATIVE_MUL_AT = prove (`!f g z. f analytic_on {z} /\ g analytic_on {z} ==> complex_derivative (\w. f w * g w) z = f z * complex_derivative g z + complex_derivative f z * g z`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_MUL THEN ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]);; let COMPLEX_DERIVATIVE_LMUL_AT = prove (`!f c z. f analytic_on {z} ==> complex_derivative (\w. c * f w) z = c * complex_derivative f z`, REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; COMPLEX_DERIVATIVE_LMUL]);; let COMPLEX_DERIVATIVE_RMUL_AT = prove (`!f c z. f analytic_on {z} ==> complex_derivative (\w. f w * c) z = complex_derivative f z * c`, REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; COMPLEX_DERIVATIVE_RMUL]);; (* ------------------------------------------------------------------------- *) (* A composition lemma for functions of mixed type. *) (* ------------------------------------------------------------------------- *) let HAS_VECTOR_DERIVATIVE_REAL_COMPLEX = prove (`(f has_complex_derivative f') (at(Cx(drop a))) ==> ((\x. f(Cx(drop x))) has_vector_derivative f') (at a)`, REWRITE_TAC[has_complex_derivative; has_vector_derivative] THEN REWRITE_TAC[COMPLEX_CMUL] THEN MP_TAC(ISPECL [`\x. Cx(drop x)`; `f:complex->complex`; `\x. Cx(drop x)`; `\x:complex. f' * x`; `a:real^1`] DIFF_CHAIN_AT) THEN REWRITE_TAC[o_DEF; COMPLEX_MUL_SYM; IMP_CONJ] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; CX_MUL; COMPLEX_CMUL]);; let DIFFERENTIABLE_REAL_COMPLEX = prove (`!f a. f complex_differentiable at (Cx(drop a)) ==> (\x. f(Cx(drop x))) differentiable at a`, REWRITE_TAC[complex_differentiable; VECTOR_DERIVATIVE_WORKS] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[vector_derivative] THEN ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_REAL_COMPLEX]);; (* ------------------------------------------------------------------------- *) (* Complex differentiation of sequences and series. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_SEQUENCE = prove (`!s f f' g'. convex s /\ (!n x. x IN s ==> (f n has_complex_derivative f' n x) (at x within s)) /\ (!e. &0 < e ==> ?N. !n x. n >= N /\ x IN s ==> norm (f' n x - g' x) <= e) /\ (?x l. x IN s /\ ((\n. f n x) --> l) sequentially) ==> ?g. !x. x IN s ==> ((\n. f n x) --> g x) sequentially /\ (g has_complex_derivative g' x) (at x within s)`, REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_SEQUENCE THEN EXISTS_TAC `\n x h:complex. (f':num->complex->complex) n x * h` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL] THEN ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]);; let HAS_COMPLEX_DERIVATIVE_SERIES = prove (`!s f f' g' k. convex s /\ (!n x. x IN s ==> (f n has_complex_derivative f' n x) (at x within s)) /\ (!e. &0 < e ==> ?N. !n x. n >= N /\ x IN s ==> norm(vsum (k INTER (0..n)) (\i. f' i x) - g' x) <= e) /\ (?x l. x IN s /\ ((\n. f n x) sums l) k) ==> ?g. !x. x IN s ==> ((\n. f n x) sums g x) k /\ (g has_complex_derivative g' x) (at x within s)`, REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_SERIES THEN EXISTS_TAC `\n x h:complex. (f':num->complex->complex) n x * h` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SIMP_TAC[GSYM COMPLEX_SUB_RDISTRIB; VSUM_COMPLEX_RMUL; FINITE_NUMSEG; FINITE_INTER; COMPLEX_NORM_MUL] THEN ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]);; (* ------------------------------------------------------------------------- *) (* Bound theorem. *) (* ------------------------------------------------------------------------- *) let COMPLEX_DIFFERENTIABLE_BOUND = prove (`!f f' s B. convex s /\ (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s) /\ norm(f' x) <= B) ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_BOUND THEN EXISTS_TAC `\x:complex h. f' x * h` THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\h. (f':complex->complex) x * h` ONORM) THEN REWRITE_TAC[LINEAR_COMPLEX_MUL] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]);; (* ------------------------------------------------------------------------- *) (* Inverse function theorem for complex derivatives. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC = prove (`!f g f' t y. (f has_complex_derivative f') (at (g y)) /\ ~(f' = Cx(&0)) /\ g continuous at y /\ open t /\ y IN t /\ (!z. z IN t ==> f (g z) = z) ==> (g has_complex_derivative inv(f')) (at y)`, REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `\x:complex. f' * x`; `t:complex->bool`] THEN ASM_REWRITE_TAC[LINEAR_COMPLEX_MUL; FUN_EQ_THM; o_THM; I_THM] THEN UNDISCH_TAC `~(f' = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD);; let HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG = prove (`!f g f' s x. open s /\ x IN s /\ f continuous_on s /\ (!x. x IN s ==> g (f x) = x) /\ (f has_complex_derivative f') (at x) /\ ~(f' = Cx(&0)) ==> (g has_complex_derivative inv(f')) (at (f x))`, REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN MAP_EVERY EXISTS_TAC [`\x:complex. f' * x`; `s:complex->bool`] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[FUN_EQ_THM; o_THM; I_THM] THEN UNDISCH_TAC `~(f' = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD);; let HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X = prove (`!f g f' s y. open s /\ (g y) IN s /\ f continuous_on s /\ (!x. x IN s ==> (g(f(x)) = x)) /\ (f has_complex_derivative f') (at (g y)) /\ ~(f' = Cx(&0)) /\ f(g y) = y ==> (g has_complex_derivative inv(f')) (at y)`, REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG_X THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `\x:complex. f' * x`; `s:complex->bool`] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[FUN_EQ_THM; o_THM; I_THM] THEN UNDISCH_TAC `~(f' = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD);; (* ------------------------------------------------------------------------- *) (* Cauchy-Riemann condition and relation to conformal. *) (* ------------------------------------------------------------------------- *) let CAUCHY_RIEMANN = prove (`!f z. f complex_differentiable at z <=> f differentiable at z /\ (jacobian f (at z))$1$1 = (jacobian f (at z))$2$2 /\ (jacobian f (at z))$1$2 = --((jacobian f (at z))$2$1)`, REPEAT GEN_TAC THEN SIMP_TAC[complex_differentiable; differentiable; has_complex_derivative] THEN MATCH_MP_TAC(MESON[] `(!y. (f has_derivative y) (at z) ==> ((?x. y = h x) <=> P f)) ==> ((?x. (f has_derivative (h x)) (at z)) <=> (?y. (f has_derivative y) (at z)) /\ P f)`) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[jacobian] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP FRECHET_DERIVATIVE_AT) THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_REWRITE_TAC[COMPLEX_LINEAR]);; let COMPLEX_DERIVATIVE_JACOBIAN = prove (`!f z. f complex_differentiable (at z) ==> complex_derivative f z = complex(jacobian f (at z)$1$1,jacobian f (at z)$2$1)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `z:complex`] THEN ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN REWRITE_TAC[has_complex_derivative] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [CAUCHY_RIEMANN]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [JACOBIAN_WORKS]) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; DIMINDEX_2; SUM_2; ARITH; FORALL_2; FUN_EQ_THM; LAMBDA_BETA] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; IM; RE; complex_mul] THEN REAL_ARITH_TAC);; let JACOBIAN_COMPLEX_DERIVATIVE = prove (`!f f' z. (f has_complex_derivative f') (at z) ==> det(jacobian f (at z)) = norm(f') pow 2`, REPEAT STRIP_TAC THEN MP_TAC(fst(EQ_IMP_RULE(ISPECL [`f:complex->complex`; `z:complex`] CAUCHY_RIEMANN))) THEN ANTS_TAC THENL [ASM_MESON_TAC[complex_differentiable]; STRIP_TAC] THEN ASM_REWRITE_TAC[DET_2; GSYM DOT_2; GSYM NORM_POW_2; REAL_ARITH `y * y - --x * x:real = x * x + y * y`] THEN REWRITE_TAC[jacobian] THEN RULE_ASSUM_TAC(REWRITE_RULE[has_complex_derivative]) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP HAS_FRECHET_DERIVATIVE_UNIQUE_AT) THEN SIMP_TAC[NORM_POW_2; DOT_2; matrix; LAMBDA_BETA; DIMINDEX_2; ARITH; complex; complex_mul; VECTOR_2; IM_DEF; RE_DEF; BASIS_COMPONENT] THEN REAL_ARITH_TAC);; let COMPLEX_DIFFERENTIABLE_EQ_CONFORMAL = prove (`!f z. f complex_differentiable at z /\ ~(complex_derivative f z = Cx(&0)) <=> f differentiable at z /\ ?a. ~(a = &0) /\ rotation_matrix (a %% jacobian f (at z))`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE; COMPLEX_DERIVATIVE_JACOBIAN] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM DOT_EQ_0] THEN REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF; RE; IM; GSYM REAL_POW_2] THEN REWRITE_TAC[RE_DEF; IM_DEF; ROTATION_MATRIX_2] THEN RULE_ASSUM_TAC(REWRITE_RULE[CAUCHY_RIEMANN]) THEN ASM_REWRITE_TAC[MATRIX_CMUL_COMPONENT] THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_RNEG; GSYM REAL_ADD_LDISTRIB; REAL_ARITH `(a * x:real) pow 2 = a pow 2 * x pow 2`] THEN EXISTS_TAC `inv(sqrt(jacobian (f:complex->complex) (at z)$2$2 pow 2 + jacobian f (at z)$2$1 pow 2))` THEN MATCH_MP_TAC(REAL_FIELD `x pow 2 = y /\ ~(y = &0) ==> ~(inv x = &0) /\ inv(x) pow 2 * y = &1`) THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_LE_ADD; REAL_LE_POW_2]; REWRITE_TAC[ROTATION_MATRIX_2; MATRIX_CMUL_COMPONENT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `a:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[GSYM REAL_MUL_RNEG; REAL_EQ_MUL_LCANCEL] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[CAUCHY_RIEMANN]; DISCH_TAC] THEN ASM_SIMP_TAC[COMPLEX_DERIVATIVE_JACOBIAN] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM DOT_EQ_0] THEN REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF; RE; IM; GSYM REAL_POW_2] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_RING `(a * x) pow 2 + (a * y) pow 2 = &1 ==> ~(x pow 2 + y pow 2 = &0)`)) THEN ASM_REWRITE_TAC[RE_DEF; IM_DEF]]);; let HOLOMORPHIC_CONSTANT_RE = prove (`!f s. open s /\ connected s /\ f holomorphic_on s /\ (?c. !z. z IN s ==> Re(f z) = c) ==> (?a. !z. z IN s ==> f z = a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!z. z IN s ==> f complex_differentiable at z` MP_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN REWRITE_TAC[CAUCHY_RIEMANN; JACOBIAN_WORKS] THEN STRIP_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `(\h. jacobian (f:complex->complex) (at z) ** h) = (\h. vec 0)` (fun th -> ASM_SIMP_TAC[GSYM th]) THEN SUBGOAL_THEN `(Cx o Re) o (\h. jacobian (f:complex->complex) (at z) ** h) = (\h. vec 0)` MP_TAC THENL [MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`(Cx o Re) o (f:complex->complex)`; `z:complex`] THEN CONJ_TAC THENL [MATCH_MP_TAC DIFF_CHAIN_AT THEN ASM_SIMP_TAC[HAS_DERIVATIVE_LINEAR; LINEAR_CX_RE]; MATCH_MP_TAC HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`(\z. Cx c):complex->complex`; `s:complex->bool`] THEN ASM_SIMP_TAC[HAS_DERIVATIVE_CONST; o_THM]]; REWRITE_TAC[COMPLEX_VEC_0] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; RE_DEF; CX_INJ] THEN SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[FORALL_DOT_EQ_0] THEN REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; VEC_COMPONENT] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN SIMP_TAC[DOT_2; VEC_COMPONENT] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RING]);; let HOLOMORPHIC_CONSTANT_IM = prove (`!f s. open s /\ connected s /\ f holomorphic_on s /\ (?c. !z. z IN s ==> Im(f z) = c) ==> (?a. !z. z IN s ==> f z = a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!z. z IN s ==> f complex_differentiable at z` MP_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN REWRITE_TAC[CAUCHY_RIEMANN; JACOBIAN_WORKS] THEN STRIP_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `(\h. jacobian (f:complex->complex) (at z) ** h) = (\h. vec 0)` (fun th -> ASM_SIMP_TAC[GSYM th]) THEN SUBGOAL_THEN `(Cx o Im) o (\h. jacobian (f:complex->complex) (at z) ** h) = (\h. vec 0)` MP_TAC THENL [MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`(Cx o Im) o (f:complex->complex)`; `z:complex`] THEN CONJ_TAC THENL [MATCH_MP_TAC DIFF_CHAIN_AT THEN ASM_SIMP_TAC[HAS_DERIVATIVE_LINEAR; LINEAR_CX_IM]; MATCH_MP_TAC HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`(\z. Cx c):complex->complex`; `s:complex->bool`] THEN ASM_SIMP_TAC[HAS_DERIVATIVE_CONST; o_THM]]; REWRITE_TAC[COMPLEX_VEC_0] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; IM_DEF; CX_INJ] THEN SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[FORALL_DOT_EQ_0] THEN REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; VEC_COMPONENT] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN SIMP_TAC[DOT_2; VEC_COMPONENT] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RING]);; (* ------------------------------------------------------------------------- *) (* Differentiation conversion. *) (* ------------------------------------------------------------------------- *) let complex_differentiation_theorems = ref [];; let add_complex_differentiation_theorems = let ETA_THM = prove (`(f has_complex_derivative f') net <=> ((\x. f x) has_complex_derivative f') net`, REWRITE_TAC[ETA_AX]) in let ETA_TWEAK = PURE_REWRITE_RULE [IMP_CONJ] o GEN_REWRITE_RULE (LAND_CONV o ONCE_DEPTH_CONV) [ETA_THM] o SPEC_ALL in fun l -> complex_differentiation_theorems := !complex_differentiation_theorems @ map ETA_TWEAK l;; add_complex_differentiation_theorems [HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN; HAS_COMPLEX_DERIVATIVE_LMUL_AT; HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN; HAS_COMPLEX_DERIVATIVE_RMUL_AT; HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN; HAS_COMPLEX_DERIVATIVE_CDIV_AT; HAS_COMPLEX_DERIVATIVE_ID; HAS_COMPLEX_DERIVATIVE_CONST; HAS_COMPLEX_DERIVATIVE_NEG; HAS_COMPLEX_DERIVATIVE_ADD; HAS_COMPLEX_DERIVATIVE_SUB; HAS_COMPLEX_DERIVATIVE_MUL_WITHIN; HAS_COMPLEX_DERIVATIVE_MUL_AT; HAS_COMPLEX_DERIVATIVE_DIV_WITHIN; HAS_COMPLEX_DERIVATIVE_DIV_AT; HAS_COMPLEX_DERIVATIVE_POW_WITHIN; HAS_COMPLEX_DERIVATIVE_POW_AT; HAS_COMPLEX_DERIVATIVE_INV_WITHIN; HAS_COMPLEX_DERIVATIVE_INV_AT];; let GEN_COMPLEX_DIFF_CONV ths = let partfn tm = let l,r = dest_comb tm in mk_pair(lhand l,r) and is_deriv = can (term_match [] `(f has_complex_derivative f') net`) and ths' = unions(mapfilter (CONJUNCTS o REWRITE_RULE[FORALL_AND_THM] o MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV) ths) in let rec COMPLEX_DIFF_CONV tm = try tryfind (fun th -> PART_MATCH partfn th (partfn tm)) (!complex_differentiation_theorems @ ths') with Failure _ -> let ith = tryfind (fun th -> PART_MATCH (partfn o repeat (snd o dest_imp)) th (partfn tm)) (!complex_differentiation_theorems @ ths') in COMPLEX_DIFF_ELIM ith and COMPLEX_DIFF_ELIM th = let tm = concl th in if not(is_imp tm) then th else let t = lhand tm in if not(is_deriv t) then UNDISCH th else COMPLEX_DIFF_ELIM (MATCH_MP th (COMPLEX_DIFF_CONV t)) in COMPLEX_DIFF_CONV;; let COMPLEX_DIFF_CONV = GEN_COMPLEX_DIFF_CONV [];; (* ------------------------------------------------------------------------- *) (* Hence a tactic. *) (* ------------------------------------------------------------------------- *) let GEN_COMPLEX_DIFF_TAC ths = let pth = MESON[] `(f has_complex_derivative f') net ==> f' = g' ==> (f has_complex_derivative g') net` in W(fun (asl,w) -> let th = MATCH_MP pth (GEN_COMPLEX_DIFF_CONV ths w) in MATCH_MP_TAC(repeat (GEN_REWRITE_RULE I [IMP_IMP]) (DISCH_ALL th)));; let COMPLEX_DIFF_TAC = GEN_COMPLEX_DIFF_TAC [];; let COMPLEX_DIFFERENTIABLE_TAC = let DISCH_FIRST th = DISCH (hd(hyp th)) th in GEN_REWRITE_TAC I [complex_differentiable] THEN W(fun (asl,w) -> let th = COMPLEX_DIFF_CONV(snd(dest_exists w)) in let f' = rand(rator(concl th)) in EXISTS_TAC f' THEN (if hyp th = [] then MATCH_ACCEPT_TAC th else let th' = repeat (GEN_REWRITE_RULE I [IMP_IMP] o DISCH_FIRST) (DISCH_FIRST th) in MATCH_MP_TAC th'));; (* ------------------------------------------------------------------------- *) (* A kind of complex Taylor theorem. *) (* ------------------------------------------------------------------------- *) let COMPLEX_TAYLOR = prove (`!f n s B. convex s /\ (!i x. x IN s /\ i <= n ==> ((f i) has_complex_derivative f (i + 1) x) (at x within s)) /\ (!x. x IN s ==> norm(f (n + 1) x) <= B) ==> !w z. w IN s /\ z IN s ==> norm(f 0 z - vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i)))) <= B * norm(z - w) pow (n + 1) / &(FACT n)`, let lemma = prove (`!f:num->real^N. vsum (0..n) f = f 0 - f (n + 1) + vsum (0..n) (\i. f (i + 1))`, REWRITE_TAC[GSYM(REWRITE_CONV[o_DEF] `(f:num->real^N) o (\i. i + 1)`)] THEN ASM_SIMP_TAC[GSYM VSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM NUMSEG_OFFSET_IMAGE] THEN SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0] THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM ADD1] THEN REWRITE_TAC[ARITH; ARITH_RULE `1 <= SUC n`] THEN VECTOR_ARITH_TAC) in REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(\w. vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i))))`; `\w. (f:num->complex->complex) (n + 1) w * (z - w) pow n / Cx(&(FACT n))`; `segment[w:complex,z]`; `B * norm(z - w:complex) pow n / &(FACT n)`] COMPLEX_DIFFERENTIABLE_BOUND) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[CONVEX_SEGMENT] THEN X_GEN_TAC `u:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `(u:complex) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX; COMPLEX_NORM_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_POS; REAL_POW_LE] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; FACT_LT] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_MESON_TAC[SEGMENT_BOUND; NORM_SUB]] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT]] THEN SUBGOAL_THEN `((\u. vsum (0..n) (\i. f i u * (z - u) pow i / Cx (&(FACT i)))) has_complex_derivative vsum (0..n) (\i. f i u * (-- Cx(&i) * (z - u) pow (i - 1)) / Cx(&(FACT i)) + f (i + 1) u * (z - u) pow i / Cx (&(FACT i)))) (at u within s)` MP_TAC THENL [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_WITHIN THEN ASM_SIMP_TAC[ETA_AX] THEN W(MP_TAC o COMPLEX_DIFF_CONV o snd) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VSUM_ADD_NUMSEG] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [lemma] THEN REWRITE_TAC[GSYM VSUM_ADD_NUMSEG; GSYM COMPLEX_ADD_ASSOC] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL; CX_MUL] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `--a * b * inv a * c:complex = --(a * inv a) * b * c`] THEN SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_ARITH `~(&n + &1 = &0)`] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_MUL_LID] THEN REWRITE_TAC[COMPLEX_ADD_LINV; GSYM COMPLEX_VEC_0; VSUM_0] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_NEG_0] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`z:complex`; `w:complex`]) THEN ANTS_TAC THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_POW_ADD; real_div; REAL_POW_1] THEN REAL_ARITH_TAC] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; complex_pow; FACT; COMPLEX_DIV_1] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x * Cx(&1) + y = x <=> y = Cx(&0)`] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC VSUM_EQ_0 THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; complex_div; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_SUB_REFL; COMPLEX_VEC_0] THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The simplest special case. *) (* ------------------------------------------------------------------------- *) let COMPLEX_MVT = prove (`!f f' s B. convex s /\ (!z. z IN s ==> (f has_complex_derivative f' z) (at z within s)) /\ (!z. z IN s ==> norm (f' z) <= B) ==> !w z. w IN s /\ z IN s ==> norm (f z - f w) <= B * norm (z - w)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(\n. if n = 0 then f else f'):num->complex->complex`; `0`; `s:complex->bool`; `B:real`] COMPLEX_TAYLOR) THEN SIMP_TAC[NUMSEG_SING; VSUM_SING; LE; ARITH] THEN REWRITE_TAC[complex_pow; REAL_POW_1; FACT; REAL_DIV_1] THEN ASM_SIMP_TAC[COMPLEX_DIV_1; COMPLEX_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Something more like the traditional MVT for real components. *) (* Could, perhaps should, sharpen this to derivatives inside the segment. *) (* ------------------------------------------------------------------------- *) let COMPLEX_MVT_LINE = prove (`!f f' w z. (!u. u IN segment[w,z] ==> (f has_complex_derivative f'(u)) (at u)) ==> ?u. u IN segment[w,z] /\ Re(f z) - Re(f w) = Re(f'(u) * (z - w))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(lift o Re) o (f:complex->complex) o (\t. (&1 - drop t) % w + drop t % z)`; `\u. (lift o Re) o (\h. (f':complex->complex)((&1 - drop u) % w + drop u % z) * h) o (\t. drop t % (z - w))`; `vec 0:real^1`; `vec 1:real^1`] MVT_VERY_SIMPLE) THEN ANTS_TAC THENL [REWRITE_TAC[DROP_VEC; REAL_POS] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_AT_WITHIN THEN MATCH_MP_TAC DIFF_CHAIN_AT THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[linear; LIFT_ADD; RE_ADD; LIFT_CMUL; RE_CMUL; o_DEF]] THEN MATCH_MP_TAC DIFF_CHAIN_AT THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `(&1 - t) % w + t % z = w + t % (z - w)`] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ABS_CONV) [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN CONJ_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM has_complex_derivative] THEN FIRST_X_ASSUM MATCH_MP_TAC; REWRITE_TAC[o_THM; GSYM LIFT_SUB; LIFT_EQ; DROP_VEC; VECTOR_SUB_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(&1 - drop t) % w + drop t % z:complex`] THEN ASM_REWRITE_TAC[segment; IN_ELIM_THM] THEN EXISTS_TAC `drop t` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[DROP_VEC]);; let COMPLEX_TAYLOR_MVT = prove (`!f w z n. (!i x. x IN segment[w,z] /\ i <= n ==> ((f i) has_complex_derivative f (i + 1) x) (at x)) ==> ?u. u IN segment[w,z] /\ Re(f 0 z) = Re(vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i))) + (f (n + 1) u * (z - u) pow n / Cx (&(FACT n))) * (z - w))`, let lemma = prove (`!f:num->real^N. vsum (0..n) f = f 0 - f (n + 1) + vsum (0..n) (\i. f (i + 1))`, REWRITE_TAC[GSYM(REWRITE_CONV[o_DEF] `(f:num->real^N) o (\i. i + 1)`)] THEN ASM_SIMP_TAC[GSYM VSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM NUMSEG_OFFSET_IMAGE] THEN SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0] THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM ADD1] THEN REWRITE_TAC[ARITH; ARITH_RULE `1 <= SUC n`] THEN VECTOR_ARITH_TAC) in REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(\w. vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i))))`; `\w. (f:num->complex->complex) (n + 1) w * (z - w) pow n / Cx(&(FACT n))`; `w:complex`; `z:complex`] COMPLEX_MVT_LINE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[CONVEX_SEGMENT] THEN X_GEN_TAC `u:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `((\u. vsum (0..n) (\i. f i u * (z - u) pow i / Cx (&(FACT i)))) has_complex_derivative vsum (0..n) (\i. f i u * (-- Cx(&i) * (z - u) pow (i - 1)) / Cx(&(FACT i)) + f (i + 1) u * (z - u) pow i / Cx (&(FACT i)))) (at u)` MP_TAC THENL [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN ASM_SIMP_TAC[ETA_AX] THEN W(MP_TAC o COMPLEX_DIFF_CONV o snd) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VSUM_ADD_NUMSEG] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [lemma] THEN REWRITE_TAC[GSYM VSUM_ADD_NUMSEG; GSYM COMPLEX_ADD_ASSOC] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL; CX_MUL] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `--a * b * inv a * c:complex = --(a * inv a) * b * c`] THEN SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_ARITH `~(&n + &1 = &0)`] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_MUL_LID] THEN REWRITE_TAC[COMPLEX_ADD_LINV; GSYM COMPLEX_VEC_0; VSUM_0] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_NEG_0] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:complex` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[RE_ADD] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_EQ_SUB_RADD] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; complex_pow; FACT; COMPLEX_DIV_1] THEN REWRITE_TAC[COMPLEX_MUL_RID; RE_ADD] THEN MATCH_MP_TAC(REAL_ARITH `Re x = &0 ==> y = y + Re x`) THEN SIMP_TAC[RE_VSUM; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[COMPLEX_SUB_REFL; complex_pow; complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; RE_CX]);; (* ------------------------------------------------------------------------- *) (* Further useful properties of complex conjugation. *) (* ------------------------------------------------------------------------- *) let LIM_CNJ = prove (`!net f l. ((\x. cnj(f x)) --> cnj l) net <=> (f --> l) net`, REWRITE_TAC[LIM; dist; GSYM CNJ_SUB; COMPLEX_NORM_CNJ]);; let SUMS_CNJ = prove (`!net f l. ((\x. cnj(f x)) sums cnj l) net <=> (f sums l) net`, SIMP_TAC[sums; LIM_CNJ; GSYM CNJ_VSUM; FINITE_INTER_NUMSEG]);; let CONTINUOUS_WITHIN_CNJ = prove (`!s z. cnj continuous (at z within s)`, SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_CNJ]);; let CONTINUOUS_AT_CNJ = prove (`!z. cnj continuous (at z)`, SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_CNJ]);; let CONTINUOUS_ON_CNJ = prove (`!s. cnj continuous_on s`, SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_CNJ]);; (* ------------------------------------------------------------------------- *) (* Some limit theorems about real part of real series etc. *) (* ------------------------------------------------------------------------- *) let REAL_LIM = prove (`!net:(A)net f l. (f --> l) net /\ ~(trivial_limit net) /\ (?b. (?a. netord net a b) /\ !a. netord net a b ==> real(f a)) ==> real l`, REWRITE_TAC[IM_DEF; real] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_COMPONENT_EQ THEN REWRITE_TAC[eventually; DIMINDEX_2; ARITH] THEN ASM_MESON_TAC[]);; let REAL_LIM_SEQUENTIALLY = prove (`!f l. (f --> l) sequentially /\ (?N. !n. n >= N ==> real(f n)) ==> real l`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_MESON_TAC[GE_REFL]);; let REAL_SERIES = prove (`!f l s. (f sums l) s /\ (!n. real(f n)) ==> real l`, REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LIM_SEQUENTIALLY THEN EXISTS_TAC `\n. vsum(s INTER (0..n)) f :complex` THEN ASM_SIMP_TAC[REAL_VSUM; FINITE_INTER; FINITE_NUMSEG]);; (* ------------------------------------------------------------------------- *) (* Often convenient to use comparison with real limit of complex type. *) (* ------------------------------------------------------------------------- *) let LIM_NULL_COMPARISON_COMPLEX = prove (`!net:(A)net f g. eventually (\x. norm(f x) <= norm(g x)) net /\ (g --> Cx(&0)) net ==> (f --> Cx(&0)) net`, REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `net:(A)net` LIM_NULL_COMPARISON) THEN EXISTS_TAC `norm o (g:A->complex)` THEN ASM_REWRITE_TAC[o_THM; GSYM LIM_NULL_NORM]);; let LIM_NULL_COMPARISON_COMPLEX_RE = prove (`!net:(A)net f g. eventually (\x. norm(f x) <= Re(g x)) net /\ (g --> Cx(&0)) net ==> (f --> Cx(&0)) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `net:(A)net` LIM_NULL_COMPARISON_COMPLEX) THEN EXISTS_TAC `g:A->complex` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN REWRITE_TAC[] THEN MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_ABS_LE; REAL_LE_TRANS]);; let SERIES_COMPARISON_COMPLEX = prove (`!f:num->real^N g s. summable s g /\ (!n. n IN s ==> real(g n) /\ &0 <= Re(g n)) /\ (?N. !n. n >= N /\ n IN s ==> norm(f n) <= norm(g n)) ==> summable s f`, REPEAT GEN_TAC THEN REWRITE_TAC[summable] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `\n. norm((g:num->complex) n)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `lift(Re l)` THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\i:num. lift(Re(g i))` THEN ASM_SIMP_TAC[REAL_NORM_POS; o_DEF] THEN REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC SERIES_COMPONENT THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; let SERIES_COMPARISON_UNIFORM_COMPLEX = prove (`!f:A->num->real^N g P s. summable s g /\ (!n. n IN s ==> real(g n) /\ &0 <= Re(g n)) /\ (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= norm(g n)) ==> ?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(vsum(s INTER (0..n)) (f x),l x) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[summable] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC SERIES_COMPARISON_UNIFORM THEN EXISTS_TAC `\n. norm((g:num->complex) n)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `lift(Re l)` THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\i:num. lift(Re(g i))` THEN ASM_SIMP_TAC[REAL_NORM_POS; o_DEF] THEN REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC SERIES_COMPONENT THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; let SUMMABLE_SUBSET_COMPLEX = prove (`!x s t. (!n. n IN s ==> real(x n) /\ &0 <= Re(x n)) /\ summable s x /\ t SUBSET s ==> summable t x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN EXISTS_TAC `x:num->complex` THEN ASM_REWRITE_TAC[] THEN MESON_TAC[REAL_LE_REFL; NORM_0; NORM_POS_LE]);; let SERIES_ABSCONV_IMP_CONV = prove (`!x:num->real^N k. summable k (\n. Cx(norm(x n))) ==> summable k x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN EXISTS_TAC `\n:num. Cx(norm(x n:real^N))` THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; NORM_POS_LE; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_NORM; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Complex-valued geometric series. *) (* ------------------------------------------------------------------------- *) let SUMS_GP = prove (`!n z. norm(z) < &1 ==> ((\k. z pow k) sums (z pow n / (Cx(&1) - z))) (from n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SERIES_FROM; VSUM_GP] THEN ASM_CASES_TAC `z = Cx(&1)` THENL [ASM_MESON_TAC[COMPLEX_NORM_NUM; REAL_LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\m. (z pow n - z pow SUC m) / (Cx (&1) - z)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN SIMP_TAC[GSYM NOT_LE]; MATCH_MP_TAC LIM_COMPLEX_DIV THEN ASM_REWRITE_TAC[COMPLEX_SUB_0; LIM_CONST] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[LIM_SEQUENTIALLY; GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPECL [`norm(z:complex)`; `e:real`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> y <= x ==> y < e`)) THEN REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN UNDISCH_TAC `n:num <= m` THEN ARITH_TAC]);; let SUMMABLE_GP = prove (`!z k. norm(z) < &1 ==> summable k (\n. z pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_RATIO THEN MAP_EVERY EXISTS_TAC [`norm(z:complex)`; `0`] THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_NORM_MUL; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Complex version (the usual one) of Dirichlet convergence test. *) (* ------------------------------------------------------------------------- *) let SERIES_DIRICHLET_COMPLEX_GEN = prove (`!f g N k m p l. bounded {vsum (m..n) f | n IN (:num)} /\ summable (from p) (\n. Cx(norm(g(n + 1) - g(n)))) /\ ((\n. vsum(1..n) f * g(n + 1)) --> l) sequentially ==> summable (from k) (\n. f(n) * g(n))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN MATCH_MP_TAC SERIES_DIRICHLET_BILINEAR THEN MAP_EVERY EXISTS_TAC [`m:num`; `p:num`; `l:complex`] THEN ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [summable]) THEN REWRITE_TAC[summable; SERIES_CAUCHY] THEN SIMP_TAC[GSYM(REWRITE_RULE[o_DEF] LIFT_SUM); FINITE_NUMSEG; FINITE_INTER; VSUM_CX; NORM_LIFT; COMPLEX_NORM_CX]);; let SERIES_DIRICHLET_COMPLEX = prove (`!f g N k m. bounded {vsum (m..n) f | n IN (:num)} /\ (!n. real(g n)) /\ (!n. N <= n ==> Re(g(n + 1)) <= Re(g n)) /\ (g --> Cx(&0)) sequentially ==> summable (from k) (\n. f(n) * g(n))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->complex`; `\n:num. Re(g n)`; `N:num`; `k:num`; `m:num`] SERIES_DIRICHLET) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; dist; VECTOR_SUB_RZERO] THEN REWRITE_TAC[COMPLEX_SUB_RZERO; NORM_LIFT] THEN MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_CMUL; FUN_EQ_THM] THEN ASM_MESON_TAC[REAL; COMPLEX_MUL_SYM]]);; (* ------------------------------------------------------------------------- *) (* Versions with explicit bounds are sometimes useful. *) (* ------------------------------------------------------------------------- *) let SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT = prove (`!f g B p. &0 < B /\ 1 <= p /\ (!m n. p <= m ==> norm(vsum(m..n) f) <= B) /\ (!n. p <= n ==> real(g n) /\ &0 <= Re(g n)) /\ (!n. p <= n ==> Re(g(n + 1)) <= Re(g n)) ==> !m n. p <= m ==> norm(vsum(m..n) (\k. f k * g k)) <= &2 * B * norm(g m)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum(m..n) (\k. (vsum(p..k) f - vsum(p..(k-1)) f) * g k))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `p:num <= k` (fun th -> SIMP_TAC[GSYM(MATCH_MP NUMSEG_RREC th)]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]; ALL_TAC] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE BILINEAR_COMPLEX_MUL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; NORM_POS_LE] THEN MATCH_MP_TAC(NORM_ARITH `norm(c) <= e - norm(a) - norm(b) ==> norm(a - b - c) <= e`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (m..n) (\k. norm(g(k + 1) - g(k)) * B)` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_REFL; LE_REFL; NORM_POS_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m..n) (\k. Re(g(k)) - Re(g(k + 1))) * B` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_RMUL; REAL_LE_RMUL_EQ] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `p <= i /\ p <= i + 1` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_NORM; REAL_SUB; RE_SUB] THEN ASM_SIMP_TAC[REAL_ARITH `abs(x - y) = y - x <=> x <= y`]; ALL_TAC] THEN ASM_REWRITE_TAC[SUM_DIFFS; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `w * n1 <= w * B /\ z * n2 <= z * B /\ &0 <= B * (&2 * y - (x + w + z)) ==> x * B <= &2 * B * y - w * n1 - z * n2`) THEN REPEAT(CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[NORM_POS_LE; LE_REFL]; ALL_TAC]) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN SUBGOAL_THEN `p <= m /\ p <= m + 1 /\ p <= n /\ p <= n + 1` STRIP_ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_NORM; real_abs] THEN REAL_ARITH_TAC);; let SERIES_DIRICHLET_COMPLEX_EXPLICIT = prove (`!f g p q. 1 <= p /\ bounded {vsum (q..n) f | n IN (:num)} /\ (!n. p <= n ==> real(g n) /\ &0 <= Re(g n)) /\ (!n. p <= n ==> Re(g(n + 1)) <= Re(g n)) ==> ?B. &0 < B /\ !m n. p <= m ==> norm(vsum(m..n) (\k. f k * g k)) <= B * norm(g m)`, REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN SIMP_TAC[BOUNDED_POS; IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `&2 * B` THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Integrals and complex multiplication. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_COMPLEX_LMUL = prove (`!f y i c. (f has_integral y) i ==> ((\x. c * f(x)) has_integral (c * y)) i`, REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[o_DEF] HAS_INTEGRAL_LINEAR) THEN ASM_REWRITE_TAC[linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; let HAS_INTEGRAL_COMPLEX_RMUL = prove (`!f y i c. (f has_integral y) i ==> ((\x. f(x) * c) has_integral (y * c)) i`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[HAS_INTEGRAL_COMPLEX_LMUL]);; let HAS_INTEGRAL_COMPLEX_0 = prove (`!s. ((\x. Cx(&0)) has_integral Cx(&0)) s`, REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; let INTEGRABLE_COMPLEX_LMUL = prove (`!f:real^N->complex s c. f integrable_on s ==> (\x. c * f x) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMPLEX_LMUL]);; let INTEGRABLE_COMPLEX_RMUL = prove (`!f:real^N->complex s c. f integrable_on s ==> (\x. f x * c) integrable_on s`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[INTEGRABLE_COMPLEX_LMUL]);; let INTEGRABLE_COMPLEX_0 = prove (`!s. (\x. Cx(&0)) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMPLEX_0]);; let INTEGRABLE_COMPLEX_LMUL_EQ = prove (`!f:real^N->complex s c. (\x. c * f x) integrable_on s <=> c = Cx(&0) \/ f integrable_on s`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[INTEGRABLE_COMPLEX_LMUL; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[INTEGRABLE_COMPLEX_0] THEN ASM_CASES_TAC `c = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv c:complex` o MATCH_MP INTEGRABLE_COMPLEX_LMUL) THEN ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_LID; COMPLEX_MUL_LINV; ETA_AX]);; let INTEGRABLE_COMPLEX_RMUL_EQ = prove (`!f:real^N->complex s c. (\x. f x * c) integrable_on s <=> c = Cx(&0) \/ f integrable_on s`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[INTEGRABLE_COMPLEX_LMUL_EQ]);; let INTEGRAL_COMPLEX_LMUL = prove (`!f:real^N->complex s c. f integrable_on s ==> integral s (\x. c * f x) = c * integral s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMPLEX_LMUL THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; let INTEGRAL_COMPLEX_RMUL = prove (`!f:real^N->complex s c. f integrable_on s ==> integral s (\x. f x * c) = integral s f * c`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[INTEGRAL_COMPLEX_LMUL]);; let REAL_COMPLEX_INTEGRAL = prove (`!f:real^N->complex s. f integrable_on s /\ (!x. x IN s ==> real(f x)) ==> real(integral s f)`, REWRITE_TAC[real; IM_DEF] THEN SIMP_TAC[INTEGRAL_COMPONENT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN MATCH_MP_TAC INTEGRAL_EQ_0 THEN ASM_REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]);; let INTEGRABLE_BOUNDED_VARIATION_COMPLEX_LMUL = prove (`!f g a b. f integrable_on interval[a,b] /\ g has_bounded_variation_on interval[a,b] ==> (\x. g x * f x) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL THEN ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL]);; let INTEGRABLE_BOUNDED_VARIATION_COMPLEX_RMUL = prove (`!f g a b. f integrable_on interval[a,b] /\ g has_bounded_variation_on interval[a,b] ==> (\x. f x * g x) integrable_on interval[a,b]`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[INTEGRABLE_BOUNDED_VARIATION_COMPLEX_LMUL]);; let HAS_BOUNDED_VARIATION_ON_COMPLEX_MUL = prove (`!f g:real^1->complex s. f has_bounded_variation_on s /\ g has_bounded_variation_on s /\ is_interval s ==> (\x. f x * g x) has_bounded_variation_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN REWRITE_TAC[complex_mul; DIMINDEX_2; FORALL_2; GSYM IM_DEF; GSYM RE_DEF] THEN SIMP_TAC[RE; IM; LIFT_ADD; LIFT_SUB; LIFT_CMUL] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD] THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV) [GSYM LIFT_DROP] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_MUL THEN ASM_REWRITE_TAC[]);; let HAS_BOUNDED_VARIATION_ON_COMPLEX_INV = prove (`!f s e. f has_bounded_variation_on s /\ &0 < e /\ (!x. x IN s ==> e <= norm(f x)) ==> (\x. inv(f x)) has_bounded_variation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[has_bounded_variation_on; HAS_BOUNDED_SETVARIATION_ON] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(B / e pow 2):real` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d:(real^1->bool)->bool`; `t:real^1->bool`]) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT; GSYM SUM_RMUL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `~(f(a:real^1) = Cx(&0)) /\ ~(f(b:real^1) = Cx(&0))` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[division_of; GSYM REAL_NOT_LT]) THEN ASM_MESON_TAC[SUBSET; COMPLEX_NORM_0; ENDS_IN_INTERVAL]; ASM_SIMP_TAC[COMPLEX_FIELD `~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> inv w - inv z = --(w - z) / (z * w)`]] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; COMPLEX_NORM_DIV] THEN REWRITE_TAC[NORM_NEG; real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[COMPLEX_NORM_MUL; REAL_POW_2; REAL_LT_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of; GSYM REAL_NOT_LT]) THEN ASM_MESON_TAC[SUBSET; COMPLEX_NORM_0; ENDS_IN_INTERVAL]);; (* ------------------------------------------------------------------------- *) (* Relations among convergence and absolute convergence for power series. *) (* ------------------------------------------------------------------------- *) let ABEL_LEMMA = prove (`!a M r r0. &0 <= r /\ r < r0 /\ (!n. n IN k ==> norm(a n) * r0 pow n <= M) ==> summable k (\n. Cx(norm(a(n)) * r pow n))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < r0` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k:num->bool = {}` THEN ASM_REWRITE_TAC[SUMMABLE_TRIVIAL] THEN SUBGOAL_THEN `&0 <= M` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> x <= y ==> &0 <= y`) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN EXISTS_TAC `\n. Cx(M * (r / r0) pow n)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[CX_MUL; CX_POW] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN MATCH_MP_TAC SUMMABLE_GP THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_ABS_DIV; real_abs; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID]; REWRITE_TAC[REAL_CX; RE_CX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE]; EXISTS_TAC `0` THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NORM; REAL_ABS_DIV] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_POW_DIV] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN ASM_SIMP_TAC[REAL_LE_RMUL; REAL_POW_LE; REAL_LT_IMP_LE]]);; let POWER_SERIES_CONV_IMP_ABSCONV = prove (`!a k w z. summable k (\n. a(n) * z pow n) /\ norm(w) < norm(z) ==> summable k (\n. Cx(norm(a(n) * w pow n)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN MATCH_MP_TAC ABEL_LEMMA THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `norm(z:complex)` THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REWRITE_TAC[GSYM COMPLEX_NORM_POW; GSYM COMPLEX_NORM_MUL]);; let POWER_SERIES_CONV_IMP_ABSCONV_WEAK = prove (`!a k w z. summable k (\n. a(n) * z pow n) /\ norm(w) < norm(z) ==> summable k (\n. Cx(norm(a(n))) * w pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN EXISTS_TAC `\n. Cx(norm(a(n) * w pow n))` THEN CONJ_TAC THENL [MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_CX; RE_CX; NORM_POS_LE] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NORM; REAL_ABS_MUL; REAL_LE_REFL]);; let POWER_SERIES_RADIUS_OF_CONVERGENCE = prove (`!a k w z. summable k (\n. a n * z pow n) /\ norm w < norm z ==> summable k (\n. a n * w pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_ABSCONV_IMP_CONV THEN REWRITE_TAC[] THEN ASM_MESON_TAC[POWER_SERIES_CONV_IMP_ABSCONV]);; (* ------------------------------------------------------------------------- *) (* Comparing sums and "integrals" via complex antiderivatives. *) (* ------------------------------------------------------------------------- *) let SUM_INTEGRAL_UBOUND_INCREASING = prove (`!f g m n. m <= n /\ (!x. x IN segment[Cx(&m),Cx(&n + &1)] ==> (g has_complex_derivative f(x)) (at x)) /\ (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> Re(f(Cx x)) <= Re(f(Cx y))) ==> sum(m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n + &1)) - g(Cx(&m)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--sum(m..n) (\k. Re(g(Cx(&k))) - Re(g(Cx(&(k + 1)))))` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[SUM_DIFFS; RE_SUB; REAL_NEG_SUB; REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_LE_REFL]] THEN REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[REAL_NEG_SUB] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:complex->complex`; `f:complex->complex`; `Cx(&r)`; `Cx(&r + &1)`] COMPLEX_MVT_LINE) THEN ANTS_TAC THENL [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `u IN segment[Cx(&r),Cx(&r + &1)]` THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN SPEC_TAC(`u:complex`,`u:complex`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN REWRITE_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; GSYM SEGMENT_CONVEX_HULL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_SEGMENT_CX] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN DISCH_THEN(X_CHOOSE_THEN `u:complex` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[CX_ADD; COMPLEX_RING `y * ((x + Cx(&1)) - x) = y`] THEN SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN REPEAT(FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN REAL_ARITH_TAC]);; let SUM_INTEGRAL_UBOUND_DECREASING = prove (`!f g m n. m <= n /\ (!x. x IN segment[Cx(&m - &1),Cx(&n)] ==> (g has_complex_derivative f(x)) (at x)) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> Re(f(Cx y)) <= Re(f(Cx x))) ==> sum(m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n)) - g(Cx(&m - &1)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `--sum(m..n) (\k. Re(g(Cx(&(k) - &1))) - Re(g(Cx(&(k+1) - &1))))` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[SUM_DIFFS; REAL_NEG_SUB] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[RE_SUB; REAL_ARITH `(x + &1) - &1 = x`; REAL_LE_REFL]] THEN REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[REAL_NEG_SUB] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN MP_TAC(ISPECL [`g:complex->complex`; `f:complex->complex`; `Cx(&r - &1)`; `Cx(&r)`] COMPLEX_MVT_LINE) THEN ANTS_TAC THENL [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `u IN segment[Cx(&r - &1),Cx(&r)]` THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN SPEC_TAC(`u:complex`,`u:complex`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN REWRITE_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; GSYM SEGMENT_CONVEX_HULL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_SEGMENT_CX] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN DISCH_THEN(X_CHOOSE_THEN `u:complex` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[CX_SUB; COMPLEX_RING `y * (x - (x - Cx(&1))) = y`] THEN SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN REPEAT(FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN REAL_ARITH_TAC]);; let SUM_INTEGRAL_LBOUND_INCREASING = prove (`!f g m n. m <= n /\ (!x. x IN segment[Cx(&m - &1),Cx(&n)] ==> (g has_complex_derivative f(x)) (at x)) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> Re(f(Cx x)) <= Re(f(Cx y))) ==> Re(g(Cx(&n)) - g(Cx(&m - &1))) <= sum(m..n) (\k. Re(f(Cx(&k))))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. --((f:complex->complex) z)`; `\z. --((g:complex->complex) z)`; `m:num`; `n:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; REAL_ARITH `--x - --y:real = --(x - y)`] THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_NEG]);; let SUM_INTEGRAL_LBOUND_DECREASING = prove (`!f g m n. m <= n /\ (!x. x IN segment[Cx(&m),Cx(&n + &1)] ==> (g has_complex_derivative f(x)) (at x)) /\ (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> Re(f(Cx y)) <= Re(f(Cx x))) ==> Re(g(Cx(&n + &1)) - g(Cx(&m))) <= sum(m..n) (\k. Re(f(Cx(&k))))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. --((f:complex->complex) z)`; `\z. --((g:complex->complex) z)`; `m:num`; `n:num`] SUM_INTEGRAL_UBOUND_INCREASING) THEN REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; REAL_ARITH `--x - --y:real = --(x - y)`] THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_NEG]);; let SUM_INTEGRAL_BOUNDS_INCREASING = prove (`!f g m n. m <= n /\ (!x. x IN segment[Cx(&m - &1),Cx (&n + &1)] ==> (g has_complex_derivative f x) (at x)) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> Re(f(Cx x)) <= Re(f(Cx y))) ==> Re(g(Cx(&n)) - g(Cx(&m - &1))) <= sum(m..n) (\k. Re(f(Cx(&k)))) /\ sum (m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n + &1)) - g(Cx(&m)))`, REPEAT STRIP_TAC THENL [MATCH_MP_TAC SUM_INTEGRAL_LBOUND_INCREASING; MATCH_MP_TAC SUM_INTEGRAL_UBOUND_INCREASING] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_SEGMENT_CX_GEN; GSYM REAL_OF_NUM_LE]) THEN REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN ASM_REAL_ARITH_TAC);; let SUM_INTEGRAL_BOUNDS_DECREASING = prove (`!f g m n. m <= n /\ (!x. x IN segment[Cx(&m - &1),Cx(&n + &1)] ==> (g has_complex_derivative f(x)) (at x)) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> Re(f(Cx y)) <= Re(f(Cx x))) ==> Re(g(Cx(&n + &1)) - g(Cx(&m))) <= sum(m..n) (\k. Re(f(Cx(&k)))) /\ sum(m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n)) - g(Cx(&m - &1)))`, REPEAT STRIP_TAC THENL [MATCH_MP_TAC SUM_INTEGRAL_LBOUND_DECREASING; MATCH_MP_TAC SUM_INTEGRAL_UBOUND_DECREASING] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_SEGMENT_CX_GEN; GSYM REAL_OF_NUM_LE]) THEN REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Relating different kinds of complex limits. *) (* ------------------------------------------------------------------------- *) let LIM_INFINITY_SEQUENTIALLY_COMPLEX = prove (`!f l. (f --> l) at_infinity ==> ((\n. f(Cx(&n))) --> l) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN MP_TAC(ISPEC `B:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; let LIM_AT_INFINITY_COMPLEX_0 = prove (`!f l:real^N. (f --> l) at_infinity <=> ((f o inv) --> l) (at(Cx(&0)))`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_LE; LIM_AT_INFINITY_POS; o_DEF] THEN REWRITE_TAC[GSYM DIST_NZ; real_ge] THEN REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[real_ge] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(b:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THENL [ALL_TAC; SUBST1_TAC(SYM(SPEC `z:complex` COMPLEX_INV_INV))] THEN FIRST_X_ASSUM MATCH_MP_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ]; ASM_REWRITE_TAC[COMPLEX_INV_EQ_0] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM COMPLEX_NORM_NZ] THEN TRANS_TAC REAL_LTE_TRANS `inv(b:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ]; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ]]]);; let LIM_ZERO_INFINITY_COMPLEX = prove (`!f l:real^N. ((\x. f(Cx(&1) / x)) --> l) (at (Cx(&0))) ==> (f --> l) at_infinity`, REWRITE_TAC[LIM_AT_INFINITY_COMPLEX_0; o_DEF; complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Transforming complex limits to real ones. *) (* ------------------------------------------------------------------------- *) let LIM_COMPLEX_REAL = prove (`!f g l m. eventually (\n. Re(g n) = f n) sequentially /\ Re m = l /\ (g --> m) sequentially ==> !e. &0 < e ==> ?N. !n. N <= n ==> abs(f n - l) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; LIM_SEQUENTIALLY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `N1:num`) (CONJUNCTS_THEN2 (SUBST1_TAC o SYM) ASSUME_TAC)) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN EXISTS_TAC `N0 + N1:num` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE `N0 + N1:num <= n ==> N0 <= n /\ N1 <= n`)) THEN UNDISCH_THEN `!n. N0 <= n ==> norm ((g:num->complex) n - m) < e` (MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM RE_SUB] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM]);; let LIM_COMPLEX_REAL_0 = prove (`!f g. eventually (\n. Re(g n) = f n) sequentially /\ (g --> Cx(&0)) sequentially ==> !e. &0 < e ==> ?N. !n. N <= n ==> abs(f n) < e`, MP_TAC LIM_COMPLEX_REAL THEN REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`&0`; `Cx(&0)`]) THEN REWRITE_TAC[RE_CX; REAL_SUB_RZERO]);; (* ------------------------------------------------------------------------- *) (* Uniform convergence of power series in a "Stolz angle". *) (* ------------------------------------------------------------------------- *) let POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1 = prove (`!M a s e. summable s a /\ &0 < M /\ &0 < e ==> eventually (\n. !z. norm(Cx(&1) - z) <= M * (&1 - norm z) ==> norm(vsum (s INTER (0..n)) (\i. a i * z pow i) - infsum s (\i. a i * z pow i)) < e) sequentially`, let lemma = prove (`!M w z. &0 < M /\ norm(w - z) <= M * (norm w - norm z) /\ ~(z = w) ==> norm(z) < norm(w)`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_MUL_EQ; REAL_SUB_LE; NORM_POS_LE; REAL_LE_TRANS]; DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_SUB_REFL; REAL_MUL_RZERO;NORM_LE_0; VECTOR_SUB_EQ]]) and lemma1 = prove (`!m n. m < n ==> vsum (m..n) (\i. a i * z pow i) = (Cx(&1) - z) * vsum(m..n-1) (\i. vsum (m..i) a * z pow i) + vsum(m..n) a * z pow n`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_SUB1] THEN SIMP_TAC[VSUM_CLAUSES_NUMSEG; LT; LT_IMP_LE] THEN STRIP_TAC THENL [ASM_REWRITE_TAC[VSUM_SING_NUMSEG; complex_pow] THEN CONV_TAC COMPLEX_RING; ASM_SIMP_TAC[] THEN UNDISCH_TAC `m:num < n` THEN POP_ASSUM(K ALL_TAC)] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN POP_ASSUM(K ALL_TAC) THEN SIMP_TAC[SUC_SUB1; VSUM_CLAUSES_NUMSEG; LT_IMP_LE] THEN ASM_REWRITE_TAC[VSUM_SING_NUMSEG; complex_pow] THEN CONV_TAC COMPLEX_RING) in SUBGOAL_THEN `!M a e. summable (:num) a /\ &0 < M /\ &0 < e ==> eventually (\n. !z. norm(Cx(&1) - z) <= M * (&1 - norm z) ==> norm(vsum (0..n) (\i. a i * z pow i) - infsum (:num) (\i. a i * z pow i)) < e) sequentially` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`M:real`; `\i:num. if i IN s then a i else Cx(&0)`; `e:real`]) THEN REWRITE_TAC[COND_RAND; COND_RATOR; COMPLEX_MUL_LZERO] THEN ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM VSUM_RESTRICT_SET; INFSUM_RESTRICT; SUMMABLE_RESTRICT] THEN REWRITE_TAC[SET_RULE `{i | i IN t /\ i IN s} = s INTER t`]] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(!z. P z) <=> P (Cx(&1)) /\ (!z. ~(z = Cx(&1)) ==> P z)`] THEN REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_SUB_REFL; REAL_SUB_REFL; REAL_MUL_RZERO; REAL_LE_REFL] THEN UNDISCH_TAC `&0 < e` THEN SPEC_TAC(`e:real`,`e:real`) THEN REWRITE_TAC[GSYM tendsto; COMPLEX_POW_ONE; COMPLEX_MUL_RID; GSYM dist; ETA_AX] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM SUMS_INFSUM]) THEN REWRITE_TAC[sums; INTER_UNIV]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP; EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM dist] THEN UNDISCH_TAC `&0 < e` THEN SPEC_TAC(`e:real`,`e:real`) THEN MATCH_MP_TAC UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT THEN REWRITE_TAC[GSYM LIM_SEQUENTIALLY] THEN CONJ_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[MESON[] `(!m n z. P m /\ P n /\ Q z ==> R m n z) <=> (!z. Q z ==> !m n. P m /\ P n ==> R m n z)`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM SUMS_INFSUM]) THEN REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN REWRITE_TAC[cauchy; GSYM dist] THEN DISCH_THEN(MP_TAC o SPEC `min (e / &2) (e / &2 / M)`) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_HALF; GE; INTER_UNIV] THEN REWRITE_TAC[GSYM REAL_LT_MIN] THEN ONCE_REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN SUBGOAL_THEN `!f:num->complex m n. m <= n ==> dist(vsum (0..m) f,vsum (0..n) f) = norm(vsum (m+1..n) f)` (fun th -> SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `a + c = b ==> dist(a,b) = norm c`) THEN MATCH_MP_TAC VSUM_COMBINE_R THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_LT_MIN] THEN STRIP_TAC THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN SUBGOAL_THEN `norm(z:complex) < &1` ASSUME_TAC THENL [UNDISCH_TAC `~(z = Cx(&1))` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `norm(a - b) <= M ==> &0 <= --M ==> b = a`)) THEN REWRITE_TAC[GSYM REAL_MUL_RNEG; REAL_NEG_SUB] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `m + 1 < n` THENL [ASM_SIMP_TAC[lemma1] THEN MATCH_MP_TAC(NORM_ARITH `norm(a) < e / &2 /\ norm(b) < e / &2 ==> norm(a + b) < e`) THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(M * (&1 - norm(z:complex))) * sum (m+1..n-1) (\i. e / &2 / M * norm(z) pow i)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ x < e / &2 / M ==> x <= e / &2 / M`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[SUM_LMUL] THEN REWRITE_TAC[REAL_ARITH `(M * z1) * e / &2 / M * s < e / &2 <=> e * (M / M) * s * z1 < e * &1`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN REWRITE_TAC[SUM_GP] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THENL [UNDISCH_TAC `norm(Cx(&1) - z) <= M * (&1 - norm z)` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN ASM_REWRITE_TAC[NORM_ARITH `norm(x - y:complex) <= &0 <=> x = y`]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_SUB_LT] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x < &1 ==> x - y < &1`) THEN ASM_SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN MATCH_MP_TAC REAL_POW_1_LT THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN ARITH_TAC]; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN SIMP_TAC[NORM_POS_LE; REAL_POW_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ x < e / &2 / M ==> x < e / &2`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC REAL_POW_1_LT THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_ARITH_TAC]]; ASM_CASES_TAC `(m+1)..n = {}` THENL [ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[NUMSEG_EMPTY]) THEN SUBGOAL_THEN `m + 1 = n` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN SIMP_TAC[NORM_POS_LE; REAL_POW_LE] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN SUBGOAL_THEN `m + 1 = n` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[VSUM_SING_NUMSEG]] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_1_LT THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_ARITH_TAC]]; X_GEN_TAC `z:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN MP_TAC(ISPECL [`M:real`; `Cx(&1)`; `z:complex`] lemma) THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN DISCH_TAC THEN SUBGOAL_THEN `summable (:num) (\i. a i * z pow i)` MP_TAC THENL [MATCH_MP_TAC SERIES_ABSCONV_IMP_CONV THEN REWRITE_TAC[] THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN EXISTS_TAC `Cx(&1)` THEN REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_NORM_CX] THEN ASM_REWRITE_TAC[REAL_ABS_NUM; COMPLEX_MUL_RID; ETA_AX]; REWRITE_TAC[GSYM SUMS_INFSUM] THEN REWRITE_TAC[sums; INTER_UNIV]]]);; let POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ = prove (`!M a w s e. summable s (\i. a i * w pow i) /\ &0 < M /\ &0 < e ==> eventually (\n. !z. norm(w - z) <= M * (norm w - norm z) ==> norm(vsum (s INTER (0..n)) (\i. a i * z pow i) - infsum s (\i. a i * z pow i)) < e) sequentially`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `w = Cx(&0)` THENL [ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; REAL_SUB_LZERO; COMPLEX_NORM_0] THEN REWRITE_TAC[NORM_NEG; REAL_ARITH `n <= M * --n <=> &0 <= --n * (&1 + M)`] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_ARITH `&0 < M ==> &0 < &1 + M`] THEN REWRITE_TAC[NORM_ARITH `&0 <= --norm z <=> z = vec 0`] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; FORALL_UNWIND_THM2] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_POW_ZERO] THEN REWRITE_TAC[COND_RATOR; COND_RAND; COMPLEX_MUL_RZERO; COMPLEX_MUL_RID] THEN MATCH_MP_TAC(NORM_ARITH `x = y /\ &0 < e ==> norm(y - x) < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[sums] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SIMP_TAC[GSYM COMPLEX_VEC_0; VSUM_DELTA] THEN REWRITE_TAC[IN_INTER; LE_0; IN_NUMSEG]; FIRST_ASSUM(MP_TAC o MATCH_MP POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z / w:complex`) THEN ASM_SIMP_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_POW_MUL] THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `norm(w:complex)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ; GSYM COMPLEX_NORM_MUL] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(w = Cx(&0)) ==> (Cx(&1) - z / w) * w = w - z`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM COMPLEX_NORM_MUL; REAL_MUL_LID] THEN ASM_SIMP_TAC[COMPLEX_DIV_RMUL]]);; (* ------------------------------------------------------------------------- *) (* Hence continuity and the Abel limit theorem. *) (* ------------------------------------------------------------------------- *) let ABEL_POWER_SERIES_CONTINUOUS = prove (`!M s a w. summable s (\i. a i * w pow i) /\ &0 < M ==> (\z. infsum s (\i. a i * z pow i)) continuous_on {z | norm(w - z) <= M * (norm w - norm z)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN EXISTS_TAC `\n z. vsum (s INTER (0..n)) (\i. a i * z pow i)` THEN ASM_SIMP_TAC[POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ; IN_ELIM_THM; TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_VSUM THEN SIMP_TAC[CONTINUOUS_ON_COMPLEX_MUL; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; FINITE_INTER; FINITE_NUMSEG]);; let ABEL_POWER_SERIES_CONTINUOUS_1 = prove (`!M s a. summable s a /\ &0 < M ==> (\z. infsum s (\i. a i * z pow i)) continuous_on {z | norm(Cx(&1) - z) <= M * (&1 - norm z)}`, MP_TAC ABEL_POWER_SERIES_CONTINUOUS THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1)`) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_POW_ONE] THEN REWRITE_TAC[COMPLEX_MUL_RID; ETA_AX]);; let ABEL_LIMIT_THEOREM = prove (`!M s a w. summable s (\i. a i * w pow i) /\ &0 < M ==> (!z. norm(z) < norm(w) ==> summable s (\i. a i * z pow i)) /\ ((\z. infsum s (\i. a i * z pow i)) --> infsum s (\i. a i * w pow i)) (at w within {z | norm(w - z) <= M * (norm w - norm z)})`, MP_TAC ABEL_POWER_SERIES_CONTINUOUS THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[POWER_SERIES_RADIUS_OF_CONVERGENCE]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON]) THEN REWRITE_TAC[IN_ELIM_THM; COMPLEX_SUB_REFL; REAL_SUB_REFL] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC);; let ABEL_LIMIT_THEOREM_1 = prove (`!M s a. summable s a /\ &0 < M ==> (!z. norm(z) < &1 ==> summable s (\i. a i * z pow i)) /\ ((\z. infsum s (\i. a i * z pow i)) --> infsum s a) (at (Cx(&1)) within {z | norm(Cx(&1) - z) <= M * (&1 - norm z)})`, MP_TAC ABEL_LIMIT_THEOREM THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1)`) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_POW_ONE] THEN REWRITE_TAC[COMPLEX_MUL_RID; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Continuity and uniqueness of power series. These would drop easily out *) (* of later developments, but it seems nice to prove them without all the *) (* machinery of Cauchy's theorem etc. *) (* ------------------------------------------------------------------------- *) let POWER_SERIES_CONTINUOUS = prove (`!a k f z r. (!w. w IN ball(z,r) ==> ((\n. a n * (w - z) pow n) sums f w) k) ==> f continuous_on ball(z,r)`, REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN ABBREV_TAC `R = (r + dist(z,w:complex)) / &2` THEN MATCH_MP_TAC CONTINUOUS_ON_INTERIOR THEN EXISTS_TAC `cball(z:complex,R)` THEN REWRITE_TAC[INTERIOR_CBALL; IN_BALL] THEN CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "R" THEN UNDISCH_TAC `dist(z:complex,w) < r` THEN CONV_TAC NORM_ARITH] THEN MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN EXISTS_TAC `\n w. vsum(k INTER (0..n)) (\i. (a:num->complex) i * (w - z) pow i)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_VSUM THEN SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_POW THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; ALL_TAC] THEN MP_TAC(ISPECL [`\w n. (a:num->complex) n * (w - z) pow n`; `\n. Cx (norm (a n * Cx R pow n))`; `\x:complex. x IN cball(z,R)`; `k:num->bool`] SERIES_COMPARISON_UNIFORM_COMPLEX) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; dist] THEN ANTS_TAC THENL [REWRITE_TAC[RE_CX; NORM_POS_LE; REAL_CX] THEN CONJ_TAC THENL [MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN EXISTS_TAC `Cx((r + R) / &2)` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `z + Cx((r + R) / &2)`) THEN ANTS_TAC THENL [REWRITE_TAC[NORM_ARITH `dist(z,z + r) = norm r`]; REWRITE_TAC[summable; COMPLEX_RING `(z + r) - z:complex = r`] THEN MESON_TAC[]]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN EXPAND_TAC "R" THEN UNDISCH_TAC `dist(z:complex,w) < r` THEN CONV_TAC NORM_ARITH; EXISTS_TAC `1` THEN REWRITE_TAC[IN_CBALL; dist] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_MUL; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_CX] THEN UNDISCH_TAC `norm(z - x:complex) <= R` THEN CONV_TAC NORM_ARITH]; DISCH_THEN(X_CHOOSE_TAC `g:complex->complex`) THEN SUBGOAL_THEN `!x. x IN cball(z,R) ==> (f:complex->complex) x = g x` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN X_GEN_TAC `y:complex` THEN REWRITE_TAC[IN_CBALL] THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `\n. (a:num->complex) n * (y - z) pow n` THEN EXISTS_TAC `k:num->bool` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `&0`) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH; REWRITE_TAC[sums; LIM_SEQUENTIALLY; dist] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL]) THEN ASM_MESON_TAC[]]]);; let POWER_SERIES_LIMIT_POINT_OF_ZEROS = prove (`!f c z k r s. &0 < r /\ (!w. dist(w,z) < r ==> ((\i. c i * (w - z) pow i) sums f(w)) k) /\ (!w. w IN s ==> f(w) = Cx(&0)) /\ z limit_point_of s ==> !i. i IN k ==> c(i) = Cx(&0)`, REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(!x. P x ==> Q x) <=> ~(?x. P x /\ ~Q x)`] THEN GEN_REWRITE_TAC RAND_CONV [num_WOP] THEN REWRITE_TAC[TAUT `(p ==> ~(q /\ ~r)) <=> q /\ p ==> r`] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!w. w IN ball(z,r) /\ ~(w = z) ==> ((\i. c(m + i) * (w - z) pow i) sums f(w) / (w - z) pow m) {i | m + i IN k}` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\i. (c(m + i) * (w - z) pow (m + i)) / (w - z) pow m` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[COMPLEX_DIV_POW2; COMPLEX_SUB_0; LE_ADD] THEN AP_TERM_TAC THEN ARITH_TAC; REWRITE_TAC[complex_div] THEN MATCH_MP_TAC SERIES_COMPLEX_RMUL THEN MP_TAC(ISPECL [`m:num`; `\i. (c:num->complex) i * (w - z) pow i`; `(f:complex->complex) w`; `{i:num | m + i IN k}`] (ONCE_REWRITE_RULE[ADD_SYM] SUMS_REINDEX_GEN)) THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN SUBGOAL_THEN `((\i. c i * (w - z) pow i) sums (f:complex->complex) w) k` MP_TAC THENL [ASM_MESON_TAC[IN_BALL; DIST_SYM]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMS_EQ) THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[GSYM LE_EXISTS; MESON[] `(?x. f x IN k /\ y = f x) <=> y IN k /\ (?x. y = f x)`] THEN ASM_CASES_TAC `(i:num) IN k` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN ASM_MESON_TAC[NOT_LE]]; ALL_TAC] THEN SUBGOAL_THEN `((\i. c(m + i) * (z - z) pow i) sums vsum {0} (\i. c(m + i) * (z - z) pow i)) {i | m + i IN k}` MP_TAC THENL [MATCH_MP_TAC SERIES_VSUM THEN EXISTS_TAC `{0}` THEN REWRITE_TAC[FINITE_SING; SING_SUBSET; IN_ELIM_THM; IN_SING] THEN ASM_REWRITE_TAC[ADD_CLAUSES; COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_POW_EQ_0]; REWRITE_TAC[VSUM_SING; complex_pow; ADD_CLAUSES; COMPLEX_MUL_RID] THEN DISCH_TAC] THEN SUBGOAL_THEN `!w. w IN ball(z,r) ==> summable {i | m + i IN k} (\i. c(m + i) * (w - z) pow i)` MP_TAC THENL [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN REWRITE_TAC[summable] THEN ASM_CASES_TAC `w:complex = z` THEN ASM_MESON_TAC[]; REWRITE_TAC[summable; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `g:complex->complex`)] THEN SUBGOAL_THEN `(g:complex->complex) continuous_on ball(z,r)` ASSUME_TAC THENL [MATCH_MP_TAC POWER_SERIES_CONTINUOUS THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN closure((s INTER cball(z,r / &2)) DELETE z) ==> (g:complex->complex) x IN {Cx(&0)}` MP_TAC THENL [MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_SING; IN_SING] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN TRANS_TAC SUBSET_TRANS `closure(cball(z:complex,r / &2))` THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET; SET_RULE `s SUBSET t ==> (s DELETE z) SUBSET t`] THEN SIMP_TAC[CLOSURE_CLOSED; CLOSED_CBALL; SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_INTER; IN_DELETE] THEN STRIP_TAC THEN SUBGOAL_THEN `(g:complex->complex) w = f w / (w - z) pow m` (fun th -> ASM_SIMP_TAC[COMPLEX_DIV_EQ_0; th]) THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `\i. (c:num->complex) (m + i) * (w - z) pow i` THEN EXISTS_TAC `{i:num | m + i IN k}` THEN REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `w IN cball(z:complex,r / &2)` THEN REWRITE_TAC[IN_CBALL; IN_BALL] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN REWRITE_TAC[IN_CLOSURE_DELETE; NOT_IMP; IN_SING] THEN CONJ_TAC THENL [UNDISCH_TAC `(z:complex) limit_point_of s` THEN REWRITE_TAC[LIMPT_INFINITE_CBALL; INTER_ASSOC] THEN REWRITE_TAC[GSYM CBALL_MIN_INTER] THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN MP_TAC(SPEC `min (r / &2) e` th)) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN]; SUBGOAL_THEN `(g:complex->complex) z = c(m:num)` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `\i. (c:num->complex) (m + i) * (z - z) pow i` THEN EXISTS_TAC `{i:num | m + i IN k}` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]]]);; let POWER_SERIES_UNIQUE = prove (`!f g c d k r s t z. &0 < r /\ &0 < s /\ (!w. w IN ball(z,r) ==> ((\i. c i * (w - z) pow i) sums f w) k) /\ (!w. w IN ball(z,s) ==> ((\i. d i * (w - z) pow i) sums g w) k) /\ (!w. w IN t ==> f w = g w) /\ z limit_point_of t ==> (!i. i IN k ==> c i = d i)`, REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN MATCH_MP_TAC POWER_SERIES_LIMIT_POINT_OF_ZEROS THEN MAP_EVERY EXISTS_TAC [`\z. (f:complex->complex) z - g z`; `z:complex`; `min r s:real`; `t:complex->bool`] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[GSYM IN_BALL; BALL_MIN_INTER; IN_INTER] THEN ASM_REWRITE_TAC[REAL_LT_MIN; COMPLEX_SUB_0] THEN REWRITE_TAC[COMPLEX_SUB_RDISTRIB] THEN ASM_SIMP_TAC[SERIES_SUB]);; hol-light/Multivariate/cauchy.ml000066400000000000000000044733131303454263000172400ustar00rootroot00000000000000(* ========================================================================= *) (* Complex path integrals and Cauchy's theorem. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Gianni Ciolli, Graziano Gentili, Marco Maggesi 2008-2009. *) (* (c) Copyright, Valentina Bruno 2010 *) (* ========================================================================= *) needs "Library/binomial.ml";; needs "Library/iter.ml";; needs "Multivariate/moretop.ml";; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* Piecewise differentiability on a 1-D interval. The definition doesn't *) (* tie it to real^1 but it's not obviously that useful elsewhere. *) (* ------------------------------------------------------------------------- *) parse_as_infix("piecewise_differentiable_on",(12,"right"));; let piecewise_differentiable_on = new_definition `f piecewise_differentiable_on i <=> f continuous_on i /\ (?s. FINITE s /\ !x. x IN (i DIFF s) ==> f differentiable at x)`;; let PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON = prove (`!f s. f piecewise_differentiable_on s ==> f continuous_on s`, SIMP_TAC[piecewise_differentiable_on]);; let PIECEWISE_DIFFERENTIABLE_ON_SUBSET = prove (`!f s t. f piecewise_differentiable_on s /\ t SUBSET s ==> f piecewise_differentiable_on t`, REWRITE_TAC[piecewise_differentiable_on] THEN MESON_TAC[SUBSET; IN_DIFF; CONTINUOUS_ON_SUBSET]);; let DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE = prove (`!f:real^1->real^N a b. f differentiable_on interval[a,b] ==> f piecewise_differentiable_on interval[a,b]`, SIMP_TAC[piecewise_differentiable_on; DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `{a,b}:real^1->bool` THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN SIMP_TAC[GSYM DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; OPEN_INTERVAL] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]);; let DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE = prove (`!f s. (!x. x IN s ==> f differentiable (at x)) ==> f piecewise_differentiable_on s`, SIMP_TAC[piecewise_differentiable_on; DIFFERENTIABLE_IMP_CONTINUOUS_AT; CONTINUOUS_AT_IMP_CONTINUOUS_ON; IN_DIFF] THEN MESON_TAC[FINITE_RULES]);; let PIECEWISE_DIFFERENTIABLE_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s. f piecewise_differentiable_on s /\ g piecewise_differentiable_on (IMAGE f s) /\ (!b. FINITE {x | x IN s /\ f(x) = b}) ==> (g o f) piecewise_differentiable_on s`, REPEAT GEN_TAC THEN SIMP_TAC[piecewise_differentiable_on; CONTINUOUS_ON_COMPOSE] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `ks:real^M->bool` STRIP_ASSUME_TAC)) (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `kt:real^N->bool` STRIP_ASSUME_TAC)) ASSUME_TAC)) THEN EXISTS_TAC `ks UNION UNIONS(IMAGE (\b. {x | x IN s /\ (f:real^M->real^N) x = b}) kt)` THEN ASM_SIMP_TAC[FINITE_UNION; FINITE_UNIONS; FINITE_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE; FORALL_IN_IMAGE; IN_DIFF; IN_UNION] THEN ASM_REWRITE_TAC[IN_ELIM_THM; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; let DIFFERENTIABLE_PIECEWISE_DIFFERENTIABLE_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s. f piecewise_differentiable_on s /\ g differentiable_on (:real^N) ==> (g o f) piecewise_differentiable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET; SUBSET_UNIV; DIFFERENTIABLE_IMP_CONTINUOUS_ON]; FIRST_X_ASSUM(MP_TAC o check (is_exists o concl)) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN ASM_MESON_TAC[DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; OPEN_UNIV; IN_UNIV]]);; let PIECEWISE_DIFFERENTIABLE_AFFINE = prove (`!f:real^M->real^N s m c. f piecewise_differentiable_on (IMAGE (\x. m % x + c) s) ==> (f o (\x. m % x + c)) piecewise_differentiable_on s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THENL [ASM_REWRITE_TAC[o_DEF; VECTOR_MUL_LZERO] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE THEN SIMP_TAC[DIFFERENTIABLE_CONST]; MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_COMPOSE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE THEN SIMP_TAC[DIFFERENTIABLE_ADD; DIFFERENTIABLE_CMUL; DIFFERENTIABLE_CONST; DIFFERENTIABLE_ID]; X_GEN_TAC `b:real^M` THEN ASM_SIMP_TAC[VECTOR_AFFINITY_EQ] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{inv m % b + --(inv m % c):real^M}` THEN SIMP_TAC[FINITE_RULES] THEN SET_TAC[]]]);; let PIECEWISE_DIFFERENTIABLE_CASES = prove (`!f g:real^1->real^N a b c. drop a <= drop c /\ drop c <= drop b /\ f c = g c /\ f piecewise_differentiable_on interval[a,c] /\ g piecewise_differentiable_on interval[c,b] ==> (\x. if drop x <= drop c then f(x) else g(x)) piecewise_differentiable_on interval[a,b]`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC)) (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC))) THEN CONJ_TAC THENL [SUBGOAL_THEN `interval[a:real^1,b] = interval[a,c] UNION interval[c,b]` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_REWRITE_TAC[CLOSED_INTERVAL; IN_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]; ALL_TAC] THEN EXISTS_TAC `(c:real^1) INSERT s UNION t` THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_UNION] THEN REWRITE_TAC[DE_MORGAN_THM; IN_DIFF; IN_INTERVAL_1; IN_INSERT; IN_UNION] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `drop x <= drop c \/ drop c <= drop x`) THEN MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THENL [EXISTS_TAC `f:real^1->real^N`; EXISTS_TAC `g:real^1->real^N`] THEN EXISTS_TAC `dist(x:real^1,c)` THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN (CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DIFF]]));; let PIECEWISE_DIFFERENTIABLE_NEG = prove (`!f:real^M->real^N s. f piecewise_differentiable_on s ==> (\x. --(f x)) piecewise_differentiable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[piecewise_differentiable_on] THEN MATCH_MP_TAC MONO_AND THEN SIMP_TAC[CONTINUOUS_ON_NEG] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[DIFFERENTIABLE_NEG]);; let PIECEWISE_DIFFERENTIABLE_ADD = prove (`!f g:real^M->real^N s. f piecewise_differentiable_on s /\ g piecewise_differentiable_on s ==> (\x. f x + g x) piecewise_differentiable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t UNION u :real^M->bool` THEN ASM_SIMP_TAC[FINITE_UNION; DIFFERENTIABLE_ADD; IN_INTER; SET_RULE `s DIFF (t UNION u) = (s DIFF t) INTER (s DIFF u)`]);; let PIECEWISE_DIFFERENTIABLE_SUB = prove (`!f g:real^M->real^N s. f piecewise_differentiable_on s /\ g piecewise_differentiable_on s ==> (\x. f x - g x) piecewise_differentiable_on s`, SIMP_TAC[VECTOR_SUB; PIECEWISE_DIFFERENTIABLE_ADD; PIECEWISE_DIFFERENTIABLE_NEG]);; (* ------------------------------------------------------------------------- *) (* Valid paths, and their start and finish. *) (* ------------------------------------------------------------------------- *) let valid_path = new_definition `valid_path (f:real^1->complex) <=> f piecewise_differentiable_on interval[vec 0,vec 1]`;; let closed_path = new_definition `closed_path g <=> pathstart g = pathfinish g`;; let VALID_PATH_EQ = prove (`!p q. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ valid_path p ==> valid_path q`, REPEAT GEN_TAC THEN REWRITE_TAC[valid_path; piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{vec 0:real^1,vec 1} UNION k` THEN ASM_REWRITE_TAC[FINITE_UNION; FINITE_INSERT; FINITE_EMPTY] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `p:real^1->real^2` THEN SUBGOAL_THEN `open(interval[vec 0:real^1,vec 1] DIFF ({vec 0:real^1,vec 1} UNION k))` MP_TAC THENL [REWRITE_TAC[SET_RULE `a DIFF (b UNION c) = (a DIFF b) DIFF c`] THEN REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN MATCH_MP_TAC OPEN_DIFF THEN ASM_SIMP_TAC[OPEN_INTERVAL; FINITE_IMP_CLOSED]; REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`)] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let VALID_PATH_COMPOSE = prove (`!f g. valid_path g /\ f differentiable_on (path_image g) ==> valid_path (f o g)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[valid_path; piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC)) THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; path_image]; EXISTS_TAC `{vec 0:real^1,vec 1} UNION s` THEN ASM_REWRITE_TAC[FINITE_UNION; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = (s DIFF t) DIFF u`] THEN REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `((f:complex->complex) o (g:real^1->complex)) differentiable (at t within (interval(vec 0,vec 1) DIFF s))` MP_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN DISCH_THEN(MP_TAC o SPEC `(g:real^1->complex) t`) THEN ANTS_TAC THENL [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `t:real^1`; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] DIFFERENTIABLE_WITHIN_SUBSET) THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET]] THEN MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM SET_TAC[]; ASM_SIMP_TAC[DIFFERENTIABLE_WITHIN_OPEN; OPEN_DIFF; OPEN_INTERVAL; FINITE_IMP_CLOSED]]]);; let VALID_PATH_TRANSLATION_EQ = prove (`!a g. valid_path((\x. a + x) o g) <=> valid_path g`, REPEAT GEN_TAC THEN REWRITE_TAC[valid_path] THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `(g:real^1->complex) = (\x. --a + x) o (\x. a + x) o g` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC]; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_PIECEWISE_DIFFERENTIABLE_COMPOSE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[DIFFERENTIABLE_ON_ADD; DIFFERENTIABLE_ON_CONST; DIFFERENTIABLE_ON_ID]);; add_translation_invariants [VALID_PATH_TRANSLATION_EQ];; let VALID_PATH_LINEAR_IMAGE_EQ = prove (`!f g. linear f /\ (!x y. f x = f y ==> x = y) ==> (valid_path(f o g) <=> valid_path g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN REWRITE_TAC[valid_path] THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `g:real^1->complex = h o (f:complex->complex) o g` SUBST1_TAC THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC]; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_PIECEWISE_DIFFERENTIABLE_COMPOSE THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]);; add_linear_invariants [VALID_PATH_LINEAR_IMAGE_EQ];; (* ------------------------------------------------------------------------- *) (* In particular, all results for paths apply. *) (* ------------------------------------------------------------------------- *) let VALID_PATH_IMP_PATH = prove (`!g. valid_path g ==> path g`, SIMP_TAC[valid_path; path; piecewise_differentiable_on]);; let CONNECTED_VALID_PATH_IMAGE = prove (`!g. valid_path g ==> connected(path_image g)`, MESON_TAC[CONNECTED_PATH_IMAGE; VALID_PATH_IMP_PATH]);; let COMPACT_VALID_PATH_IMAGE = prove (`!g. valid_path g ==> compact(path_image g)`, MESON_TAC[COMPACT_PATH_IMAGE; VALID_PATH_IMP_PATH]);; let BOUNDED_VALID_PATH_IMAGE = prove (`!g. valid_path g ==> bounded(path_image g)`, MESON_TAC[BOUNDED_PATH_IMAGE; VALID_PATH_IMP_PATH]);; let CLOSED_VALID_PATH_IMAGE = prove (`!g. valid_path g ==> closed(path_image g)`, MESON_TAC[CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH]);; (* ------------------------------------------------------------------------- *) (* Theorems about rectifiable valid paths. *) (* ------------------------------------------------------------------------- *) let RECTIFIABLE_VALID_PATH = prove (`!g. valid_path g ==> (rectifiable_path g <=> (\t. vector_derivative g (at t)) absolutely_integrable_on interval [vec 0,vec 1])`, REWRITE_TAC[valid_path; piecewise_differentiable_on; GSYM path] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC RECTIFIABLE_PATH_DIFFERENTIABLE THEN ASM_MESON_TAC[FINITE_IMP_COUNTABLE]);; let PATH_LENGTH_VALID_PATH = prove (`!g. valid_path g /\ rectifiable_path g ==> path_length g = drop(integral (interval[vec 0,vec 1]) (\t. lift(norm(vector_derivative g (at t)))))`, REWRITE_TAC[valid_path; piecewise_differentiable_on; GSYM path] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_LENGTH_DIFFERENTIABLE THEN ASM_MESON_TAC[FINITE_IMP_COUNTABLE]);; let ABSOLUTELY_CONTINUOUS_RECTIFIABLE_VALID_PATH = prove (`!g:real^1->complex. valid_path g /\ rectifiable_path g ==> g absolutely_continuous_on interval[vec 0,vec 1]`, GEN_TAC THEN REWRITE_TAC[valid_path; rectifiable_path; piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC)) THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV_GEN THEN EXISTS_TAC `c:real^1->bool` THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE] THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL; BOUNDED_INTERVAL] THEN ASM_MESON_TAC[DIFFERENTIABLE_AT_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Negligibility of valid_path image *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_VALID_PATH_IMAGE = prove (`!g. valid_path g ==> negligible(path_image g)`, REWRITE_TAC[piecewise_differentiable_on; piecewise_differentiable_on; valid_path; path_image] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^1->real^2) (k UNION (interval [vec 0,vec 1] DIFF k))` THEN CONJ_TAC THENL [REWRITE_TAC[IMAGE_UNION]; SET_TAC[]] THEN ASM_SIMP_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_FINITE; FINITE_IMAGE] THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM THEN REWRITE_TAC[DIMINDEX_1; DIMINDEX_2; ARITH] THEN ASM_SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON]);; (* ------------------------------------------------------------------------- *) (* Integrals along a path (= piecewise differentiable function on [0,1]). *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_path_integral",(12,"right"));; parse_as_infix("path_integrable_on",(12,"right"));; let has_path_integral = define `(f has_path_integral i) (g) <=> ((\x. f(g(x)) * vector_derivative g (at x within interval[vec 0,vec 1])) has_integral i) (interval[vec 0,vec 1])`;; let path_integral = new_definition `path_integral g f = @i. (f has_path_integral i) (g)`;; let path_integrable_on = new_definition `f path_integrable_on g <=> ?i. (f has_path_integral i) g`;; let PATH_INTEGRAL_UNIQUE = prove (`!f g i. (f has_path_integral i) (g) ==> path_integral(g) f = i`, REWRITE_TAC[path_integral; has_path_integral; GSYM integral] THEN MESON_TAC[INTEGRAL_UNIQUE]);; let HAS_PATH_INTEGRAL_INTEGRAL = prove (`!f i. f path_integrable_on i ==> (f has_path_integral (path_integral i f)) i`, REWRITE_TAC[path_integral; path_integrable_on] THEN MESON_TAC[PATH_INTEGRAL_UNIQUE]);; let HAS_PATH_INTEGRAL_UNIQUE = prove (`!f i j g. (f has_path_integral i) g /\ (f has_path_integral j) g ==> i = j`, REWRITE_TAC[has_path_integral] THEN MESON_TAC[HAS_INTEGRAL_UNIQUE]);; let HAS_PATH_INTEGRAL_INTEGRABLE = prove (`!f g i. (f has_path_integral i) g ==> f path_integrable_on g`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[]);; let HAS_PATH_INTEGRAL_INTEGRABLE_INTEGRAL = prove (`!f y g. (f has_path_integral y) g <=> f path_integrable_on g /\ path_integral g f = y`, MESON_TAC[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_INTEGRAL; path_integrable_on]);; (* ------------------------------------------------------------------------- *) (* Show that we can forget about the localized derivative. *) (* ------------------------------------------------------------------------- *) let VECTOR_DERIVATIVE_WITHIN_INTERIOR = prove (`!a b x. x IN interior(interval[a,b]) ==> vector_derivative f (at x within interval[a,b]) = vector_derivative f (at x)`, SIMP_TAC[vector_derivative; has_vector_derivative; has_derivative; LIM_WITHIN_INTERIOR; NETLIMIT_WITHIN_INTERIOR; NETLIMIT_AT]);; let HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE = prove (`((\x. f' (g x) * vector_derivative g (at x within interval [a,b])) has_integral i) (interval [a,b]) <=> ((\x. f' (g x) * vector_derivative g (at x)) has_integral i) (interval [a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN EXISTS_TAC `{a:real^1,b}` THEN REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN SUBGOAL_THEN `interval[a:real^1,b] DIFF {a,b} = interior(interval[a,b])` (fun th -> SIMP_TAC[th; VECTOR_DERIVATIVE_WITHIN_INTERIOR]) THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; GSYM DROP_EQ] THEN REAL_ARITH_TAC);; let HAS_PATH_INTEGRAL = prove (`(f has_path_integral i) g <=> ((\x. f (g x) * vector_derivative g (at x)) has_integral i) (interval[vec 0,vec 1])`, SIMP_TAC[HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE; has_path_integral]);; let PATH_INTEGRABLE_ON = prove (`f path_integrable_on g <=> (\t. f(g t) * vector_derivative g (at t)) integrable_on interval[vec 0,vec 1]`, REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL; GSYM integrable_on]);; (* ------------------------------------------------------------------------- *) (* Reversing a path. *) (* ------------------------------------------------------------------------- *) let VALID_PATH_REVERSEPATH = prove (`!g. valid_path(reversepath g) <=> valid_path g`, SUBGOAL_THEN `!g. valid_path g ==> valid_path(reversepath g)` (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN GEN_TAC THEN SIMP_TAC[valid_path; piecewise_differentiable_on; GSYM path; PATH_REVERSEPATH] THEN DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) MP_TAC) THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\x:real^1. vec 1 - x) s` THEN ASM_SIMP_TAC[FINITE_IMAGE; reversepath] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN SIMP_TAC[DIFFERENTIABLE_SUB; DIFFERENTIABLE_CONST; DIFFERENTIABLE_ID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [UNDISCH_TAC `(x:real^1) IN interval[vec 0,vec 1]` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o ISPEC `\x:real^1. vec 1 - x` o MATCH_MP FUN_IN_IMAGE) THEN UNDISCH_TAC `~((x:real^1) IN IMAGE (\x. vec 1 - x) s)` THEN REWRITE_TAC[VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]]);; let HAS_PATH_INTEGRAL_REVERSEPATH = prove (`!f g i. valid_path g /\ (f has_path_integral i) g ==> (f has_path_integral (--i)) (reversepath g)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(-- &1 = &0)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_ARITH `x + --x:real^1 = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_LNEG] THEN REWRITE_TAC[VECTOR_MUL_LID; VECTOR_NEG_NEG; REAL_POW_ONE] THEN REWRITE_TAC[reversepath; VECTOR_ARITH `-- x + a:real^N = a - x`] THEN REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_NEG) THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN MATCH_MP_TAC(REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_INTEGRAL_SPIKE_FINITE) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC o CONJUNCT2) THEN EXISTS_TAC `IMAGE (\x:real^1. vec 1 - x) s` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM COMPLEX_MUL_RNEG] THEN AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN REWRITE_TAC[GSYM DROP_VEC; GSYM DROP_NEG] THEN MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `--x:real^N = vec 0 - x`] THEN SIMP_TAC[HAS_VECTOR_DERIVATIVE_SUB; HAS_VECTOR_DERIVATIVE_CONST; HAS_VECTOR_DERIVATIVE_ID] THEN REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DIFF]) THEN REWRITE_TAC[IN_DIFF] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[CONTRAPOS_THM; IN_DIFF; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);; let PATH_INTEGRABLE_REVERSEPATH = prove (`!f g. valid_path g /\ f path_integrable_on g ==> f path_integrable_on (reversepath g)`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_REVERSEPATH]);; let PATH_INTEGRABLE_REVERSEPATH_EQ = prove (`!f g. valid_path g ==> (f path_integrable_on (reversepath g) <=> f path_integrable_on g)`, MESON_TAC[PATH_INTEGRABLE_REVERSEPATH; VALID_PATH_REVERSEPATH; REVERSEPATH_REVERSEPATH]);; let PATH_INTEGRAL_REVERSEPATH = prove (`!f g. valid_path g /\ f path_integrable_on g ==> path_integral (reversepath g) f = --(path_integral g f)`, MESON_TAC[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_REVERSEPATH; HAS_PATH_INTEGRAL_INTEGRAL]);; (* ------------------------------------------------------------------------- *) (* Joining two paths together. *) (* ------------------------------------------------------------------------- *) let VALID_PATH_JOIN_EQ = prove (`!g1 g2. pathfinish g1 = pathstart g2 ==> (valid_path(g1 ++ g2) <=> valid_path g1 /\ valid_path g2)`, REWRITE_TAC[valid_path; piecewise_differentiable_on; GSYM path] THEN ASM_SIMP_TAC[PATH_JOIN] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `path(g1:real^1->complex)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `path(g2:real^1->complex)` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [EXISTS_TAC `(vec 0) INSERT (vec 1) INSERT {x:real^1 | ((&1 / &2) % x) IN s}` THEN CONJ_TAC THENL [REWRITE_TAC[FINITE_INSERT] THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / &2) % x:real^1`) THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_INTERVAL_1; DROP_CMUL; DROP_VEC; IN_INSERT; DE_MORGAN_THM; GSYM DROP_EQ; NOT_EXISTS_THM] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `(g1:real^1->complex) = (\x. g1 (&2 % x)) o (\x. &1 / &2 % x)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN SIMP_TAC[DIFFERENTIABLE_CMUL; DIFFERENTIABLE_ID] THEN MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `(g1 ++ g2):real^1->complex` THEN EXISTS_TAC `dist(&1 / &2 % x:real^1,lift(&1 / &2))` THEN ASM_REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; LIFT_DROP] THEN REWRITE_TAC[joinpaths] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `(vec 0) INSERT (vec 1) INSERT {x:real^1 | ((&1 / &2) % (x + vec 1)) IN s}` THEN CONJ_TAC THENL [REWRITE_TAC[FINITE_INSERT] THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / &2) % (x + vec 1):real^1`) THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; IN_INSERT; DE_MORGAN_THM; GSYM DROP_EQ; NOT_EXISTS_THM] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `(g2:real^1->complex) = (\x. g2 (&2 % x - vec 1)) o (\x. &1 / &2 % (x + vec 1))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN SIMP_TAC[DIFFERENTIABLE_CMUL; DIFFERENTIABLE_ADD; DIFFERENTIABLE_CONST; DIFFERENTIABLE_ID] THEN MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `(g1 ++ g2):real^1->complex` THEN EXISTS_TAC `dist(&1 / &2 % (x + vec 1):real^1,lift(&1 / &2))` THEN ASM_REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; DROP_ADD; DROP_VEC; LIFT_DROP] THEN REWRITE_TAC[joinpaths] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s1:real^1->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `s2:real^1->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(&1 / &2 % vec 1:real^1) INSERT {x:real^1 | (&2 % x) IN s1} UNION {x:real^1 | (&2 % x - vec 1) IN s2}` THEN CONJ_TAC THENL [REWRITE_TAC[FINITE_INSERT; FINITE_UNION] THEN CONJ_TAC THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; IN_DIFF; DROP_VEC; IN_INSERT; IN_ELIM_THM; DE_MORGAN_THM; IN_UNION; GSYM DROP_EQ; DROP_CMUL] THEN STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN ASM_CASES_TAC `drop x <= &1 / &2` THENL [MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\x. (g1:real^1->complex)(&2 % x)` THEN EXISTS_TAC `abs(&1 / &2 - drop x)` THEN REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; DROP_ADD; DROP_VEC; LIFT_DROP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC]; MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\x. (g2:real^1->complex)(&2 % x - vec 1)` THEN EXISTS_TAC `abs(&1 / &2 - drop x)` THEN REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; DROP_ADD; DROP_VEC; LIFT_DROP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC]] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN SIMP_TAC[DIFFERENTIABLE_CMUL; DIFFERENTIABLE_SUB; DIFFERENTIABLE_CONST; DIFFERENTIABLE_ID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; IN_DIFF; DROP_VEC; DROP_CMUL] THEN ASM_REAL_ARITH_TAC);; let VALID_PATH_JOIN = prove (`!g1 g2. valid_path g1 /\ valid_path g2 /\ pathfinish g1 = pathstart g2 ==> valid_path(g1 ++ g2)`, MESON_TAC[VALID_PATH_JOIN_EQ]);; let VALID_PATH_SYM = prove (`!p q:real^1->complex. pathfinish p = pathstart q /\ pathfinish q = pathstart p ==> (valid_path(p ++ q) <=> valid_path(q ++ p))`, SIMP_TAC[VALID_PATH_JOIN_EQ] THEN CONV_TAC TAUT);; let HAS_PATH_INTEGRAL_JOIN = prove (`!f g1 g2 i1 i2. (f has_path_integral i1) g1 /\ (f has_path_integral i2) g2 /\ valid_path g1 /\ valid_path g2 ==> (f has_path_integral (i1 + i2)) (g1 ++ g2)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL; CONJ_ASSOC] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY))) THEN DISCH_THEN(ASSUME_TAC o SPECL [`&2`; `--(vec 1):real^1`]) THEN DISCH_THEN(MP_TAC o SPECL [`&2`; `vec 0:real^1`]) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DIMINDEX_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_RNEG; VECTOR_NEG_NEG; VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_NEG_0; VECTOR_ADD_RID; VECTOR_ARITH `&1 / &2 % x + &1 / &2 % x = x:real^N`] THEN REWRITE_TAC[DROP_CMUL; DROP_ADD; DROP_NEG; DROP_VEC; VECTOR_MUL_ASSOC] THEN REWRITE_TAC[VECTOR_ARITH `x % (a + b) + y % b = x % a + (x + y) % b`; VECTOR_ARITH `x % a + y % (a + b) = (x + y) % a + y % b`] THEN REWRITE_TAC[REAL_ARITH `(&1 - (&2 * x + --(&1))) * inv(&2) = &1 - x`; REAL_ARITH `&1 - x + &2 * x + --(&1) = x`; REAL_ARITH `&1 - &2 * x + (&2 * x) * inv(&2) = &1 - x`; REAL_ARITH `(&2 * x) * inv(&2) = x`] THEN REWRITE_TAC[VECTOR_ARITH `b - inv(&2) % (a + b) = inv(&2) % (b - a)`; VECTOR_ARITH `inv(&2) % (a + b) - a = inv(&2) % (b - a)`] THEN REPEAT(DISCH_THEN(MP_TAC o SPEC `&2` o MATCH_MP HAS_INTEGRAL_CMUL) THEN REWRITE_TAC[COMPLEX_CMUL; SIMPLE_COMPLEX_ARITH `Cx(&2) * Cx(&1 / &2) * j = j /\ Cx(&2) * (a * Cx(inv(&2)) * b) = a * b`] THEN DISCH_TAC) THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `&1 / &2 % vec 1:real^1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [TAUT `a1 /\ a2 /\ b ==> c <=> b ==> a1 /\ a2 ==> c`] HAS_INTEGRAL_SPIKE_FINITE)) THENL [MP_TAC(REWRITE_RULE[valid_path] (ASSUME `valid_path g1`)); MP_TAC(REWRITE_RULE[valid_path] (ASSUME `valid_path g2`))] THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `((&1 / &2) % vec 1) INSERT {x:real^1 | (&2 % x) IN s}`; EXISTS_TAC `((&1 / &2) % vec 1) INSERT {x:real^1 | (&2 % x - vec 1) IN s}`] THEN (CONJ_TAC THENL [REWRITE_TAC[FINITE_INSERT] THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INSERT; IN_DIFF; IN_INSERT; DE_MORGAN_THM; joinpaths; IN_INTERVAL_1; DROP_VEC; DROP_CMUL; GSYM DROP_EQ] THEN SIMP_TAC[REAL_LT_IMP_LE; REAL_MUL_RID; IN_ELIM_THM; REAL_ARITH `&1 / &2 <= x /\ ~(x = &1 / &2) ==> ~(x <= &1 / &2)`] THEN REWRITE_TAC[LIFT_CMUL; LIFT_SUB; LIFT_DROP; LIFT_NUM; GSYM VECTOR_SUB] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC(COMPLEX_RING `x = Cx(&2) * y ==> g * x = Cx(&2) * g * y`) THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THENL [EXISTS_TAC `(\x. g1(&2 % x)):real^1->complex`; EXISTS_TAC `(\x. g2(&2 % x - vec 1)):real^1->complex`] THEN EXISTS_TAC `abs(drop x - &1 / &2)` THEN REWRITE_TAC[DIST_REAL; GSYM drop; GSYM REAL_ABS_NZ] THEN ASM_SIMP_TAC[REAL_LT_IMP_NE; REAL_SUB_0] THEN (CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[GSYM COMPLEX_CMUL] THEN SUBST1_TAC(SYM(SPEC `2` DROP_VEC)) THEN MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN (CONJ_TAC THENL [TRY(GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_SUB THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]) THEN REWRITE_TAC[has_vector_derivative] THEN MATCH_MP_TAC(MESON[HAS_DERIVATIVE_LINEAR] `f = g /\ linear f ==> (f has_derivative g) net`) THEN REWRITE_TAC[linear; FUN_EQ_THM; DROP_VEC] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_DIFF; IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC] THEN ASM_REAL_ARITH_TAC]));; let PATH_INTEGRABLE_JOIN = prove (`!f g1 g2. valid_path g1 /\ valid_path g2 ==> (f path_integrable_on (g1 ++ g2) <=> f path_integrable_on g1 /\ f path_integrable_on g2)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; REWRITE_TAC[path_integrable_on] THEN ASM_MESON_TAC[HAS_PATH_INTEGRAL_JOIN]] THEN RULE_ASSUM_TAC(REWRITE_RULE[valid_path]) THEN REWRITE_TAC[PATH_INTEGRABLE_ON; joinpaths] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THENL [DISCH_THEN(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]); DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&1)`])] THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_AFFINITY)) THENL [DISCH_THEN(MP_TAC o SPECL [`&1 / &2`; `vec 0:real^1`]); DISCH_THEN(MP_TAC o SPECL [`&1 / &2`; `lift(&1 / &2)`])] THEN REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN REWRITE_TAC[LIFT_DROP; LIFT_NUM; VECTOR_MUL_RZERO; VECTOR_NEG_0; GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RNEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN REWRITE_TAC[VECTOR_ARITH `vec 2 + --vec 1:real^1 = vec 1`; VECTOR_ARITH `vec 1 + --vec 1:real^1 = vec 0`] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &2` o MATCH_MP INTEGRABLE_CMUL) THEN REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SPIKE_FINITE THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_ADD; LIFT_DROP; COMPLEX_CMUL] THEN REWRITE_TAC[COMPLEX_RING `a * b = Cx(&1 / &2) * x * y <=> x * y = a * Cx(&2) * b`] THENL [UNDISCH_TAC `(g1:real^1->complex) piecewise_differentiable_on interval[vec 0,vec 1]`; UNDISCH_TAC `(g2:real^1->complex) piecewise_differentiable_on interval[vec 0,vec 1]`] THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(vec 0:real^1) INSERT (vec 1) INSERT s` THEN ASM_REWRITE_TAC[FINITE_INSERT; IN_INSERT; DE_MORGAN_THM] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN BINOP_TAC THENL [AP_TERM_TAC THEN ASM_SIMP_TAC[REAL_ARITH `x <= &1 ==> &1 / &2 * x <= &1 / &2`] THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC; AP_TERM_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= t /\ ~(t = &0) ==> ~(&1 / &2 * t + &1 / &2 <= &1 / &2)`] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THENL [EXISTS_TAC `(\x. g1(&2 % x)):real^1->complex` THEN EXISTS_TAC `abs(drop t - &1) / &2` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < abs x / &2 <=> ~(x = &0)`; REAL_SUB_0] THEN REWRITE_TAC[DIST_REAL; GSYM drop; DROP_CMUL] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_ARITH `t <= &1 /\ ~(t = &1) /\ abs(x - &1 / &2 * t) < abs(t - &1) / &2 ==> x <= &1 / &2`]; ALL_TAC]; EXISTS_TAC `(\x. g2(&2 % x - vec 1)):real^1->complex` THEN EXISTS_TAC `abs(drop t) / &2` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < abs x / &2 <=> ~(x = &0)`; REAL_SUB_0] THEN REWRITE_TAC[DIST_REAL; GSYM drop; DROP_CMUL; DROP_ADD; LIFT_DROP] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_ARITH `&0 <= t /\ abs(x - (&1 / &2 * t + &1 / &2)) < abs(t) / &2 ==> ~(x <= &1 / &2)`]; ALL_TAC]] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[GSYM COMPLEX_CMUL] THEN SUBST1_TAC(SYM(SPEC `2` DROP_VEC)) THEN MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN (CONJ_TAC THENL [TRY(GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_SUB THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]) THEN REWRITE_TAC[has_vector_derivative] THEN MATCH_MP_TAC(MESON[HAS_DERIVATIVE_LINEAR] `f = g /\ linear f ==> (f has_derivative g) net`) THEN REWRITE_TAC[linear; FUN_EQ_THM; DROP_VEC] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN REAL_ARITH_TAC; MATCH_MP_TAC(MESON[VECTOR_DERIVATIVE_WORKS] `f differentiable (at t) /\ t' = t ==> (f has_vector_derivative (vector_derivative f (at t))) (at t')`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; DROP_VEC]; ALL_TAC] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC]));; let PATH_INTEGRAL_JOIN = prove (`!f g1 g2:real^1->complex. valid_path g1 /\ valid_path g2 /\ f path_integrable_on g1 /\ f path_integrable_on g2 ==> path_integral (g1 ++ g2) f = path_integral g1 f + path_integral g2 f`, MESON_TAC[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_INTEGRAL; HAS_PATH_INTEGRAL_JOIN]);; (* ------------------------------------------------------------------------- *) (* Reparametrizing to shift the starting point of a (closed) path. *) (* ------------------------------------------------------------------------- *) let VALID_PATH_SHIFTPATH = prove (`!g a. valid_path g /\ pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> valid_path(shiftpath a g)`, REWRITE_TAC[valid_path; shiftpath; DROP_ADD; GSYM DROP_VEC] THEN REWRITE_TAC[REAL_ARITH `a + x <= y <=> x <= y - a`; GSYM DROP_SUB] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_CASES THEN REPLICATE_TAC 2 (CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a - vec 1:real^1 = vec 0`; VECTOR_ARITH `a + vec 1 - a:real^1 = vec 1`] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[VECTOR_ARITH `a + x:real^1 = &1 % x + a`]; ONCE_REWRITE_TAC[VECTOR_ARITH `a + x - vec 1:real^1 = &1 % x + (a - vec 1)`]] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_AFFINE THEN MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS; INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[EMPTY_SUBSET; SUBSET_INTERVAL_1; DROP_ADD; DROP_CMUL; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; let HAS_PATH_INTEGRAL_SHIFTPATH = prove (`!f g i a. (f has_path_integral i) g /\ valid_path g /\ a IN interval[vec 0,vec 1] ==> (f has_path_integral i) (shiftpath a g)`, REWRITE_TAC[HAS_PATH_INTEGRAL; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `i = integral (interval[a,vec 1]) (\x. f ((g:real^1->real^2) x) * vector_derivative g (at x)) + integral (interval[vec 0,a]) (\x. f (g x) * vector_derivative g (at x))` SUBST1_TAC THENL [MATCH_MP_TAC(INST_TYPE [`:1`,`:M`; `:2`,`:N`] HAS_INTEGRAL_UNIQUE) THEN MAP_EVERY EXISTS_TAC [`\x. f ((g:real^1->real^2) x) * vector_derivative g (at x)`; `interval[vec 0:real^1,vec 1]`] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[DROP_VEC] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`vec 0:real^1`; `vec 1:real^1`] THEN (CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC]) THEN REWRITE_TAC[DROP_SUB; DROP_VEC; SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `vec 1 - a:real^1` THEN ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[shiftpath] THEN CONJ_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_FINITE THENL [EXISTS_TAC `\x. f(g(a + x)) * vector_derivative g (at(a + x))` THEN EXISTS_TAC `(vec 1 - a) INSERT IMAGE (\x:real^1. x - a) s` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INSERT] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; IN_INSERT; IN_IMAGE; UNWIND_THM2; DROP_SUB; DROP_ADD; DROP_VEC; DE_MORGAN_THM; VECTOR_ARITH `x:real^1 = y - a <=> y = a + x`] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_VEC] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `x <= &1 - a ==> a + x <= &1`] THEN AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\x. (g:real^1->complex)(a + x)`; `dist(vec 1 - a:real^1,x)`] THEN SIMP_TAC[CONJ_ASSOC; dist; NORM_REAL; GSYM drop; DROP_VEC; DROP_SUB] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[GSYM DROP_VEC] THEN MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN SUBST1_TAC(VECTOR_ARITH `vec 1:real^1 = vec 0 + vec 1`) THEN SIMP_TAC[HAS_VECTOR_DERIVATIVE_ADD; HAS_VECTOR_DERIVATIVE_CONST; HAS_VECTOR_DERIVATIVE_ID] THEN REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; DROP_VEC; DROP_ADD] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(\x. f (g x) * vector_derivative g (at x)) integrable_on (interval [a,vec 1])` MP_TAC THENL [MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`vec 0:real^1`; `vec 1:real^1`] THEN CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; SUBSET_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(&1 = &0)`) o MATCH_MP INTEGRABLE_INTEGRAL) THEN DISCH_THEN(MP_TAC o SPEC `a:real^1` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[VECTOR_ARITH `&1 % x + a:real^1 = a + x`] THEN REWRITE_TAC[REAL_INV_1; REAL_POS; REAL_ABS_NUM; REAL_POW_ONE] THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE] THEN REWRITE_TAC[VECTOR_MUL_LID; GSYM VECTOR_SUB; VECTOR_SUB_REFL]; EXISTS_TAC `\x. f(g(a + x - vec 1)) * vector_derivative g (at(a + x - vec 1))` THEN EXISTS_TAC `(vec 1 - a) INSERT IMAGE (\x:real^1. x - a + vec 1) s` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INSERT] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; IN_INSERT; IN_IMAGE; UNWIND_THM2; DROP_SUB; DROP_ADD; DROP_VEC; DE_MORGAN_THM; VECTOR_ARITH `x:real^1 = y - a + z <=> y = a + (x - z)`] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_VEC; DROP_SUB] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&1 - a <= x /\ ~(x = &1 - a) ==> ~(a + x <= &1)`] THEN AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\x. (g:real^1->complex)(a + x - vec 1)`; `dist(vec 1 - a:real^1,x)`] THEN SIMP_TAC[CONJ_ASSOC; dist; NORM_REAL; GSYM drop; DROP_VEC; DROP_SUB] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[GSYM DROP_VEC] THEN MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a + x - vec 1:real^1 = (a - vec 1) + x`] THEN SIMP_TAC[HAS_VECTOR_DERIVATIVE_ADD; HAS_VECTOR_DERIVATIVE_CONST; HAS_VECTOR_DERIVATIVE_ID]; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_DIFF; DROP_SUB; IN_INTERVAL_1; DROP_VEC; DROP_ADD] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(\x. f (g x) * vector_derivative g (at x)) integrable_on (interval [vec 0,a])` MP_TAC THENL [MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`vec 0:real^1`; `vec 1:real^1`] THEN CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; SUBSET_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(&1 = &0)`) o MATCH_MP INTEGRABLE_INTEGRAL) THEN DISCH_THEN(MP_TAC o SPEC `a - vec 1:real^1` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[VECTOR_ARITH `&1 % x + a - vec 1:real^1 = a + x - vec 1`] THEN REWRITE_TAC[REAL_INV_1; REAL_POS; REAL_ABS_NUM; REAL_POW_ONE] THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE] THEN REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `vec 0 + --(a - vec 1):real^1 = vec 1 - a`; VECTOR_ARITH `a + --(a - vec 1):real^1 = vec 1`]]);; let HAS_PATH_INTEGRAL_SHIFTPATH_EQ = prove (`!f g i a. valid_path g /\ pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> ((f has_path_integral i) (shiftpath a g) <=> (f has_path_integral i) g)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_SHIFTPATH] THEN SUBGOAL_THEN `(f has_path_integral i) (shiftpath (vec 1 - a) (shiftpath a g))` MP_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_SHIFTPATH THEN ASM_SIMP_TAC[VALID_PATH_SHIFTPATH] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_PATH_INTEGRAL] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_FINITE_EQ THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN REWRITE_TAC[piecewise_differentiable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(s:real^1->bool) UNION {vec 0,vec 1}` THEN ASM_SIMP_TAC[FINITE_UNION; FINITE_RULES] THEN REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = (s DIFF u) DIFF t`] THEN REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN BINOP_TAC THEN CONV_TAC SYM_CONV THENL [AP_TERM_TAC THEN MATCH_MP_TAC SHIFTPATH_SHIFTPATH THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]; ALL_TAC] THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`g:real^1->real^2`; `interval(vec 0,vec 1) DIFF s:real^1->bool`] THEN ASM_SIMP_TAC[GSYM VECTOR_DERIVATIVE_WORKS; OPEN_DIFF; FINITE_IMP_CLOSED; OPEN_INTERVAL] THEN REPEAT STRIP_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SHIFTPATH_SHIFTPATH; FIRST_X_ASSUM MATCH_MP_TAC] THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]);; let PATH_INTEGRAL_SHIFTPATH = prove (`!f g a. valid_path g /\ pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> path_integral (shiftpath a g) f = path_integral g f`, SIMP_TAC[path_integral; HAS_PATH_INTEGRAL_SHIFTPATH_EQ]);; (* ------------------------------------------------------------------------- *) (* More about straight-line paths. *) (* ------------------------------------------------------------------------- *) let HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN = prove (`!a b:complex x s. (linepath(a,b) has_vector_derivative (b - a)) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[linepath; has_vector_derivative] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `u % (b - a) = vec 0 + u % (b - a)`] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % b = a + u % (b - a)`] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN MATCH_MP_TAC HAS_DERIVATIVE_VMUL_DROP THEN REWRITE_TAC[HAS_DERIVATIVE_ID]);; let HAS_VECTOR_DERIVATIVE_LINEPATH_AT = prove (`!a b:complex x. (linepath(a,b) has_vector_derivative (b - a)) (at x)`, MESON_TAC[WITHIN_UNIV; HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN]);; let VALID_PATH_LINEPATH = prove (`!a b. valid_path(linepath(a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[valid_path] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN REWRITE_TAC[differentiable_on; differentiable] THEN MESON_TAC[HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN; has_vector_derivative]);; let VECTOR_DERIVATIVE_LINEPATH_WITHIN = prove (`!a b x. x IN interval[vec 0,vec 1] ==> vector_derivative (linepath(a,b)) (at x within interval[vec 0,vec 1]) = b - a`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN] THEN REWRITE_TAC[DROP_VEC; REAL_LT_01]);; let VECTOR_DERIVATIVE_LINEPATH_AT = prove (`!a b x. vector_derivative (linepath(a,b)) (at x) = b - a`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN ASM_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_LINEPATH_AT]);; let HAS_PATH_INTEGRAL_LINEPATH = prove (`!f i a b. (f has_path_integral i) (linepath(a,b)) <=> ((\x. f(linepath(a,b) x) * (b - a)) has_integral i) (interval[vec 0,vec 1])`, REPEAT GEN_TAC THEN REWRITE_TAC[has_path_integral] THEN MATCH_MP_TAC HAS_INTEGRAL_EQ_EQ THEN SIMP_TAC[VECTOR_DERIVATIVE_LINEPATH_WITHIN]);; let LINEPATH_IN_PATH = prove (`!x. x IN interval[vec 0,vec 1] ==> linepath(a,b) x IN segment[a,b]`, REWRITE_TAC[segment; linepath; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN MESON_TAC[]);; let RE_LINEPATH_CX = prove (`!a b x. Re(linepath(Cx a,Cx b) x) = (&1 - drop x) * a + drop x * b`, REWRITE_TAC[linepath; RE_ADD; COMPLEX_CMUL; RE_MUL_CX; RE_CX]);; let IM_LINEPATH_CX = prove (`!a b x. Im(linepath(Cx a,Cx b) x) = &0`, REWRITE_TAC[linepath; IM_ADD; COMPLEX_CMUL; IM_MUL_CX; IM_CX] THEN REAL_ARITH_TAC);; let LINEPATH_CX = prove (`!a b x. linepath(Cx a,Cx b) x = Cx((&1 - drop x) * a + drop x * b)`, REWRITE_TAC[COMPLEX_EQ; RE_LINEPATH_CX; IM_LINEPATH_CX; RE_CX; IM_CX]);; let HAS_PATH_INTEGRAL_TRIVIAL = prove (`!f a. (f has_path_integral (Cx(&0))) (linepath(a,a))`, REWRITE_TAC[HAS_PATH_INTEGRAL_LINEPATH; COMPLEX_SUB_REFL; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; let PATH_INTEGRAL_TRIVIAL = prove (`!f a. path_integral (linepath(a,a)) f = Cx(&0)`, MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_UNIQUE]);; (* ------------------------------------------------------------------------- *) (* Relation to subpath construction. *) (* ------------------------------------------------------------------------- *) let VALID_PATH_SUBPATH = prove (`!g u v. valid_path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] ==> valid_path(subpath u v g)`, SIMP_TAC[valid_path; PATH_SUBPATH] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[subpath] THEN ASM_CASES_TAC `v:real^1 = u` THENL [MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_LZERO; DROP_VEC] THEN REWRITE_TAC[DIFFERENTIABLE_ON_CONST]; MATCH_MP_TAC(REWRITE_RULE[o_DEF] PIECEWISE_DIFFERENTIABLE_COMPOSE) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_ADD THEN REWRITE_TAC[DIFFERENTIABLE_CONST] THEN MATCH_MP_TAC DIFFERENTIABLE_CMUL THEN REWRITE_TAC[DIFFERENTIABLE_ID]; MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REPEAT(COND_CASES_TAC THEN REWRITE_TAC[EMPTY_SUBSET]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN SIMP_TAC[SUBSET_INTERVAL_1; DROP_ADD; DROP_CMUL; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB] THEN ASM_SIMP_TAC[DROP_EQ; REAL_FIELD `~(u:real = v) ==> (u + (v - u) * x = b <=> x = (b - u) / (v - u))`] THEN X_GEN_TAC `b:real^1` THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{lift((drop b - drop u) / (drop v - drop u))}` THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; SUBSET; IN_ELIM_THM] THEN SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; IN_SING]]]);; let HAS_PATH_INTEGRAL_SUBPATH_REFL = prove (`!f g u. (f has_path_integral (Cx(&0))) (subpath u u g)`, REWRITE_TAC[HAS_PATH_INTEGRAL; subpath; VECTOR_SUB_REFL] THEN REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_DERIVATIVE_CONST_AT] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; let PATH_INTEGRABLE_SUBPATH_REFL = prove (`!f g u. f path_integrable_on (subpath u u g)`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_SUBPATH_REFL]);; let PATH_INTEGRAL_SUBPATH_REFL = prove (`!f g u. path_integral (subpath u u g) f = Cx(&0)`, MESON_TAC[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_SUBPATH_REFL]);; let HAS_PATH_INTEGRAL_SUBPATH = prove (`!f g u v. valid_path g /\ f path_integrable_on g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ drop u <= drop v ==> (f has_path_integral integral (interval[u,v]) (\x. f(g x) * vector_derivative g (at x))) (subpath u v g)`, REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL; subpath] THEN REWRITE_TAC[GSYM integrable_on] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `v:real^1 = u` THENL [ASM_REWRITE_TAC[INTEGRAL_REFL; VECTOR_SUB_REFL; DROP_VEC] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_DERIVATIVE_CONST_AT] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]; SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ]; ALL_TAC]] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; REAL_LT_IMP_LE]; REWRITE_TAC[HAS_INTEGRAL_INTEGRAL]] THEN DISCH_THEN(MP_TAC o SPECL [`drop(v - u)`; `u:real^1`] o MATCH_MP(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY)) THEN ASM_SIMP_TAC[DROP_SUB; REAL_ARITH `u < v ==> ~(v - u = &0)`] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_SUB] THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_ARITH `u < v ==> ~(v < u) /\ &0 <= v - u`; VECTOR_ARITH `a % u + --(a % v):real^N = a % (u - v)`] THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_RZERO] THEN SUBGOAL_THEN `inv(drop v - drop u) % (v - u) = vec 1` SUBST1_TAC THENL [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_CMUL; DROP_SUB] THEN UNDISCH_TAC `drop u < drop v` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `drop(v - u)` o MATCH_MP HAS_INTEGRAL_CMUL) THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_SUB_LE] THEN REWRITE_TAC[DIMINDEX_1; REAL_POW_1; VECTOR_MUL_ASSOC; DROP_SUB] THEN ASM_SIMP_TAC[REAL_FIELD `u < v ==> (v - u) * inv(v - u) = &1`] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_INTEGRAL_SPIKE_FINITE) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN REWRITE_TAC[piecewise_differentiable_on; IN_DIFF] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC o CONJUNCT2) THEN EXISTS_TAC `{t | ((drop v - drop u) % t + u) IN k}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_SUB; DROP_ADD] THEN UNDISCH_TAC `drop u < drop v` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_CMUL] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = b * a * c`] THEN REWRITE_TAC[VECTOR_ARITH `x + a % y:real^N = a % y + x`] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_CMUL; GSYM DROP_SUB] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_UNIQUE_AT THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] VECTOR_DIFF_CHAIN_AT) THEN REWRITE_TAC[DROP_SUB] THEN CONJ_TAC THENL [SUBST1_TAC(VECTOR_ARITH `v - u:real^1 = (v - u) + vec 0`) THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN SUBST1_TAC(MESON[LIFT_DROP; LIFT_EQ_CMUL] `v - u = drop(v - u) % vec 1`) THEN REWRITE_TAC[GSYM DROP_SUB] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_CMUL THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_ID]; REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_CMUL; DROP_VEC] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(drop v - drop u) * &1 + drop u` THEN ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN ASM_REAL_ARITH_TAC]]);; let PATH_INTEGRABLE_SUBPATH = prove (`!f g u v. valid_path g /\ f path_integrable_on g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] ==> f path_integrable_on (subpath u v g)`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `drop u <= drop v \/ drop v <= drop u`) THENL [ASM_MESON_TAC[path_integrable_on; HAS_PATH_INTEGRAL_SUBPATH]; ONCE_REWRITE_TAC[GSYM REVERSEPATH_SUBPATH] THEN MATCH_MP_TAC PATH_INTEGRABLE_REVERSEPATH THEN ASM_SIMP_TAC[VALID_PATH_SUBPATH] THEN ASM_MESON_TAC[path_integrable_on; HAS_PATH_INTEGRAL_SUBPATH]]);; let HAS_INTEGRAL_PATH_INTEGRAL_SUBPATH = prove (`!f g u v. valid_path g /\ f path_integrable_on g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ drop u <= drop v ==> (((\x. f(g x) * vector_derivative g (at x))) has_integral path_integral (subpath u v g) f) (interval[u,v])`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[GSYM PATH_INTEGRABLE_ON; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[IN_INTERVAL_1]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_SUBPATH]]);; let PATH_INTEGRAL_SUBPATH_INTEGRAL = prove (`!f g u v. valid_path g /\ f path_integrable_on g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ drop u <= drop v ==> path_integral (subpath u v g) f = integral (interval[u,v]) (\x. f(g x) * vector_derivative g (at x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_SUBPATH]);; let PATH_INTEGRAL_SUBPATH_COMBINE = prove (`!f g u v w. valid_path g /\ f path_integrable_on g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ w IN interval[vec 0,vec 1] ==> path_integral (subpath u v g) f + path_integral (subpath v w g) f = path_integral (subpath u w g) f`, REPLICATE_TAC 3 GEN_TAC THEN SUBGOAL_THEN `!u v w. drop u <= drop v /\ drop v <= drop w ==> valid_path g /\ f path_integrable_on g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ w IN interval[vec 0,vec 1] ==> path_integral (subpath u v g) f + path_integral (subpath v w g) f = path_integral (subpath u w g) f` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `drop u <= drop v /\ drop v <= drop w \/ drop u <= drop w /\ drop w <= drop v \/ drop v <= drop u /\ drop u <= drop w \/ drop v <= drop w /\ drop w <= drop u \/ drop w <= drop u /\ drop u <= drop v \/ drop w <= drop v /\ drop v <= drop u`) THEN FIRST_ASSUM(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC (MESON[REVERSEPATH_SUBPATH] `subpath v u (g:real^1->complex) = reversepath(subpath u v g) /\ subpath w u g = reversepath(subpath u w g) /\ subpath w v g = reversepath(subpath v w g)`) THEN ASM_SIMP_TAC[PATH_INTEGRAL_REVERSEPATH; PATH_INTEGRABLE_SUBPATH; VALID_PATH_REVERSEPATH; VALID_PATH_SUBPATH] THEN CONV_TAC COMPLEX_RING] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `drop u <= drop w` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN ASM_SIMP_TAC[PATH_INTEGRAL_SUBPATH_INTEGRAL] THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[GSYM PATH_INTEGRABLE_ON; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[IN_INTERVAL_1]);; let PATH_INTEGRAL_INTEGRAL = prove (`!f g. path_integral g f = integral (interval [vec 0,vec 1]) (\x. f (g x) * vector_derivative g (at x))`, REWRITE_TAC[path_integral; integral; HAS_PATH_INTEGRAL]);; (* ------------------------------------------------------------------------- *) (* Easier to reason about segments via convex hulls. *) (* ------------------------------------------------------------------------- *) let SEGMENTS_SUBSET_CONVEX_HULL = prove (`!a b c. segment[a,b] SUBSET (convex hull {a,b,c}) /\ segment[a,c] SUBSET (convex hull {a,b,c}) /\ segment[b,c] SUBSET (convex hull {a,b,c}) /\ segment[b,a] SUBSET (convex hull {a,b,c}) /\ segment[c,a] SUBSET (convex hull {a,b,c}) /\ segment[c,b] SUBSET (convex hull {a,b,c})`, REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; let POINTS_IN_CONVEX_HULL = prove (`!x s. x IN s ==> x IN convex hull s`, MESON_TAC[SUBSET; HULL_SUBSET]);; let CONVEX_HULL_SUBSET = prove (`(!x. x IN s ==> x IN convex hull t) ==> (convex hull s) SUBSET (convex hull t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET]);; let NOT_IN_INTERIOR_CONVEX_HULL_3 = prove (`!a b c:complex. ~(a IN interior(convex hull {a,b,c})) /\ ~(b IN interior(convex hull {a,b,c})) /\ ~(c IN interior(convex hull {a,b,c}))`, REPEAT GEN_TAC THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC NOT_IN_INTERIOR_CONVEX_HULL THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN REWRITE_TAC[DIMINDEX_2] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Cauchy's theorem where there's a primitive. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRAL_PRIMITIVE_LEMMA = prove (`!f f' g a b s. ~(interval[a,b] = {}) /\ (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s)) /\ g piecewise_differentiable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> g(x) IN s) ==> ((\x. f'(g x) * vector_derivative g (at x within interval[a,b])) has_integral (f(g b) - f(g a))) (interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[valid_path; piecewise_differentiable_on] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN EXISTS_TAC `k:real^1->bool` THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS] THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; GSYM o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN ASM_MESON_TAC[holomorphic_on]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[has_vector_derivative; COMPLEX_CMUL] THEN SUBGOAL_THEN `(f has_complex_derivative f'(g x)) (at (g x) within (IMAGE g (interval[a:real^1,b])))` MP_TAC THENL [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]; ALL_TAC] THEN SUBGOAL_THEN `(g:real^1->complex) differentiable (at x within interval[a,b])` MP_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [VECTOR_DERIVATIVE_WORKS] THEN REWRITE_TAC[has_vector_derivative; IMP_IMP; has_complex_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_WITHIN) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_DERIVATIVE_WITHIN_SUBSET)) THEN DISCH_THEN(MP_TAC o SPEC `interval(a:real^1,b)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN ASM_SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL; HAS_DERIVATIVE_WITHIN_OPEN] THEN REWRITE_TAC[o_DEF; COMPLEX_CMUL] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; let PATH_INTEGRAL_PRIMITIVE = prove (`!f f' g s. (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s)) /\ valid_path g /\ (path_image g) SUBSET s ==> (f' has_path_integral (f(pathfinish g) - f(pathstart g))) (g)`, REWRITE_TAC[valid_path; path_image; pathfinish; pathstart] THEN REWRITE_TAC[has_path_integral] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_PRIMITIVE_LEMMA THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; REAL_POS; REAL_NOT_LT] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_MESON_TAC[]);; let CAUCHY_THEOREM_PRIMITIVE = prove (`!f f' g s. (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s)) /\ valid_path g /\ (path_image g) SUBSET s /\ pathfinish g = pathstart g ==> (f' has_path_integral Cx(&0)) (g)`, MESON_TAC[PATH_INTEGRAL_PRIMITIVE; COMPLEX_SUB_REFL]);; (* ------------------------------------------------------------------------- *) (* Existence of path integral for continuous function. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRABLE_CONTINUOUS_LINEPATH = prove (`!f a b. f continuous_on segment[a,b] ==> f path_integrable_on (linepath(a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[path_integrable_on; has_path_integral] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[GSYM integrable_on] THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\x. f(linepath(a,b) x) * (b - a)` THEN SIMP_TAC[VECTOR_DERIVATIVE_LINEPATH_WITHIN] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[GSYM path_image; ETA_AX; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[CONTINUOUS_ON_LINEPATH]);; (* ------------------------------------------------------------------------- *) (* Arithmetical combining theorems. *) (* ------------------------------------------------------------------------- *) let HAS_PATH_INTEGRAL_CONST_LINEPATH = prove (`!a b c. ((\x. c) has_path_integral (c * (b - a))) (linepath(a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL_LINEPATH] THEN MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`; `c * (b - a):complex`] HAS_INTEGRAL_CONST) THEN REWRITE_TAC[CONTENT_UNIT; VECTOR_MUL_LID]);; let HAS_PATH_INTEGRAL_NEG = prove (`!f i g. (f has_path_integral i) g ==> ((\x. --(f x)) has_path_integral (--i)) g`, REWRITE_TAC[has_path_integral; COMPLEX_MUL_LNEG; HAS_INTEGRAL_NEG]);; let HAS_PATH_INTEGRAL_ADD = prove (`!f1 i1 f2 i2 g. (f1 has_path_integral i1) g /\ (f2 has_path_integral i2) g ==> ((\x. f1(x) + f2(x)) has_path_integral (i1 + i2)) g`, REWRITE_TAC[has_path_integral; COMPLEX_ADD_RDISTRIB] THEN SIMP_TAC[HAS_INTEGRAL_ADD]);; let HAS_PATH_INTEGRAL_SUB = prove (`!f1 i1 f2 i2 g. (f1 has_path_integral i1) g /\ (f2 has_path_integral i2) g ==> ((\x. f1(x) - f2(x)) has_path_integral (i1 - i2)) g`, REWRITE_TAC[has_path_integral; COMPLEX_SUB_RDISTRIB] THEN SIMP_TAC[HAS_INTEGRAL_SUB]);; let HAS_PATH_INTEGRAL_COMPLEX_LMUL = prove (`!f g i c. (f has_path_integral i) g ==> ((\x. c * f x) has_path_integral (c * i)) g`, REWRITE_TAC[has_path_integral; HAS_INTEGRAL_COMPLEX_LMUL; GSYM COMPLEX_MUL_ASSOC]);; let HAS_PATH_INTEGRAL_COMPLEX_RMUL = prove (`!f g i c. (f has_path_integral i) g ==> ((\x. f x * c) has_path_integral (i * c)) g`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[HAS_PATH_INTEGRAL_COMPLEX_LMUL]);; let HAS_PATH_INTEGRAL_COMPLEX_DIV = prove (`!f g i c. (f has_path_integral i) g ==> ((\x. f x / c) has_path_integral (i / c)) g`, REWRITE_TAC[complex_div; HAS_PATH_INTEGRAL_COMPLEX_RMUL]);; let HAS_PATH_INTEGRAL_EQ = prove (`!f g p y. (!x. x IN path_image p ==> f x = g x) /\ (f has_path_integral y) p ==> (g has_path_integral y) p`, REPEAT GEN_TAC THEN REWRITE_TAC[path_image; IN_IMAGE; has_path_integral; IMP_CONJ] THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]);; let HAS_PATH_INTEGRAL_BOUND_LINEPATH = prove (`!f i a b B. (f has_path_integral i) (linepath(a,b)) /\ &0 <= B /\ (!x. x IN segment[a,b] ==> norm(f x) <= B) ==> norm(i) <= B * norm(b - a)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_path_integral] THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[GSYM CONTENT_UNIT_1] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN EXISTS_TAC `\x. f (linepath (a,b) x) * vector_derivative (linepath (a,b)) (at x within interval [vec 0,vec 1])` THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; VECTOR_DERIVATIVE_LINEPATH_WITHIN] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH; path_image] THEN ASM SET_TAC[]);; let HAS_PATH_INTEGRAL_BOUND_LINEPATH_STRONG = prove (`!f i a b B k. FINITE k /\ (f has_path_integral i) (linepath(a,b)) /\ &0 <= B /\ (!x. x IN segment[a,b] DIFF k ==> norm(f x) <= B) ==> norm(i) <= B * norm(b - a)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:complex = a` THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO] THEN STRIP_TAC THEN SUBGOAL_THEN `i = Cx(&0)` (fun th -> REWRITE_TAC[th; COMPLEX_NORM_0; REAL_LE_REFL]) THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN ASM_MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL]; STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `\x. if x IN k then Cx(&0) else (f:complex->complex) x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[COMPLEX_NORM_0]] THEN UNDISCH_TAC `(f has_path_integral i) (linepath (a,b))` THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[has_path_integral] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN EXISTS_TAC `{t | t IN interval[vec 0,vec 1] /\ linepath(a:complex,b) t IN k}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_FINITE; SET_TAC[]] THEN MATCH_MP_TAC FINITE_FINITE_PREIMAGE_GENERAL THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:complex` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET] `(?a. s SUBSET {a}) ==> FINITE s`) THEN MATCH_MP_TAC(SET_RULE `(!a b. a IN s /\ b IN s ==> a = b) ==> (?a. s SUBSET {a})`) THEN MAP_EVERY X_GEN_TAC [`s:real^1`; `t:real^1`] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - s) % a + s % b:real^N = (&1 - t) % a + t % b <=> (s - t) % (b - a) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0] THEN REWRITE_TAC[DROP_EQ]]);; let HAS_PATH_INTEGRAL_0 = prove (`!g. ((\x. Cx(&0)) has_path_integral Cx(&0)) g`, REWRITE_TAC[has_path_integral; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; let HAS_PATH_INTEGRAL_IS_0 = prove (`!f g. (!z. z IN path_image g ==> f(z) = Cx(&0)) ==> (f has_path_integral Cx(&0)) g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_EQ THEN EXISTS_TAC `\z:complex. Cx(&0)` THEN ASM_REWRITE_TAC[HAS_PATH_INTEGRAL_0] THEN ASM_MESON_TAC[]);; let HAS_PATH_INTEGRAL_VSUM = prove (`!f p s. FINITE s /\ (!a. a IN s ==> (f a has_path_integral i a) p) ==> ((\x. vsum s (\a. f a x)) has_path_integral vsum s i) p`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; HAS_PATH_INTEGRAL_0; COMPLEX_VEC_0; IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Same thing non-relationally. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRAL_CONST_LINEPATH = prove (`!a b c. path_integral (linepath(a,b)) (\x. c) = c * (b - a)`, REPEAT GEN_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_PATH_INTEGRAL_CONST_LINEPATH]);; let PATH_INTEGRAL_NEG = prove (`!f g. f path_integrable_on g ==> path_integral g (\x. --(f x)) = --(path_integral g f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_NEG THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; let PATH_INTEGRAL_ADD = prove (`!f1 f2 g. f1 path_integrable_on g /\ f2 path_integrable_on g ==> path_integral g (\x. f1(x) + f2(x)) = path_integral g f1 + path_integral g f2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; let PATH_INTEGRAL_SUB = prove (`!f1 f2 g. f1 path_integrable_on g /\ f2 path_integrable_on g ==> path_integral g (\x. f1(x) - f2(x)) = path_integral g f1 - path_integral g f2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; let PATH_INTEGRAL_COMPLEX_LMUL = prove (`!f g c. f path_integrable_on g ==> path_integral g (\x. c * f x) = c * path_integral g f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_LMUL THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; let PATH_INTEGRAL_COMPLEX_RMUL = prove (`!f g c. f path_integrable_on g ==> path_integral g (\x. f x * c) = path_integral g f * c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_RMUL THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; let PATH_INTEGRAL_COMPLEX_DIV = prove (`!f g c. f path_integrable_on g ==> path_integral g (\x. f x / c) = path_integral g f / c`, REWRITE_TAC[complex_div; PATH_INTEGRAL_COMPLEX_RMUL]);; let PATH_INTEGRAL_EQ = prove (`!f g p. (!x. x IN path_image p ==> f x = g x) ==> path_integral p f = path_integral p g`, REPEAT STRIP_TAC THEN REWRITE_TAC[path_integral] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[HAS_PATH_INTEGRAL_EQ]);; let PATH_INTEGRAL_EQ_0 = prove (`!f g. (!z. z IN path_image g ==> f(z) = Cx(&0)) ==> path_integral g f = Cx(&0)`, MESON_TAC[HAS_PATH_INTEGRAL_IS_0; PATH_INTEGRAL_UNIQUE]);; let PATH_INTEGRAL_BOUND_LINEPATH = prove (`!f a b. f path_integrable_on (linepath(a,b)) /\ &0 <= B /\ (!x. x IN segment[a,b] ==> norm(f x) <= B) ==> norm(path_integral (linepath(a,b)) f) <= B * norm(b - a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `f:complex->complex` THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; let PATH_INTEGRAL_0 = prove (`!g. path_integral g (\x. Cx(&0)) = Cx(&0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_PATH_INTEGRAL_0]);; let PATH_INTEGRAL_VSUM = prove (`!f p s. FINITE s /\ (!a. a IN s ==> (f a) path_integrable_on p) ==> path_integral p (\x. vsum s (\a. f a x)) = vsum s (\a. path_integral p (f a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_VSUM THEN ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; let PATH_INTEGRABLE_EQ = prove (`!f g p. (!x. x IN path_image p ==> f x = g x) /\ f path_integrable_on p ==> g path_integrable_on p`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_EQ]);; (* ------------------------------------------------------------------------- *) (* Arithmetic theorems for path integrability. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRABLE_NEG = prove (`!f g. f path_integrable_on g ==> (\x. --(f x)) path_integrable_on g`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_NEG]);; let PATH_INTEGRABLE_ADD = prove (`!f1 f2 g. f1 path_integrable_on g /\ f2 path_integrable_on g ==> (\x. f1(x) + f2(x)) path_integrable_on g`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_ADD]);; let PATH_INTEGRABLE_SUB = prove (`!f1 f2 g. f1 path_integrable_on g /\ f2 path_integrable_on g ==> (\x. f1(x) - f2(x)) path_integrable_on g`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_SUB]);; let PATH_INTEGRABLE_COMPLEX_LMUL = prove (`!f g c. f path_integrable_on g ==> (\x. c * f x) path_integrable_on g`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_COMPLEX_LMUL]);; let PATH_INTEGRABLE_COMPLEX_RMUL = prove (`!f g c. f path_integrable_on g ==> (\x. f x * c) path_integrable_on g`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[PATH_INTEGRABLE_COMPLEX_LMUL]);; let PATH_INTEGRABLE_COMPLEX_DIV = prove (`!f g c. f path_integrable_on g ==> (\x. f x / c) path_integrable_on g`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_COMPLEX_DIV]);; let PATH_INTEGRABLE_VSUM = prove (`!f g s. FINITE s /\ (!a. a IN s ==> f a path_integrable_on g) ==> (\x. vsum s (\a. f a x)) path_integrable_on g`, REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_VSUM]);; (* ------------------------------------------------------------------------- *) (* Considering a path integral "backwards". *) (* ------------------------------------------------------------------------- *) let HAS_PATH_INTEGRAL_REVERSE_LINEPATH = prove (`!f a b i. (f has_path_integral i) (linepath(a,b)) ==> (f has_path_integral (--i)) (linepath(b,a))`, MESON_TAC[REVERSEPATH_LINEPATH; VALID_PATH_LINEPATH; HAS_PATH_INTEGRAL_REVERSEPATH]);; let PATH_INTEGRAL_REVERSE_LINEPATH = prove (`!f a b. f continuous_on (segment[a,b]) ==> path_integral(linepath(a,b)) f = --(path_integral(linepath(b,a)) f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_REVERSE_LINEPATH THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN ASM_MESON_TAC[SEGMENT_SYM]);; (* ------------------------------------------------------------------------- *) (* Splitting a path integral in a flat way. *) (* ------------------------------------------------------------------------- *) let HAS_PATH_INTEGRAL_SPLIT = prove (`!f a b c i j k. &0 <= k /\ k <= &1 /\ c - a = k % (b - a) /\ (f has_path_integral i) (linepath(a,c)) /\ (f has_path_integral j) (linepath(c,b)) ==> (f has_path_integral (i + j)) (linepath(a,b))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `k = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_UNIQUE; COMPLEX_ADD_LID]; ALL_TAC] THEN ASM_CASES_TAC `k = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THENL [REWRITE_TAC[VECTOR_ARITH `c - a = b - a <=> c = b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_UNIQUE; COMPLEX_ADD_RID]; ALL_TAC] THEN REWRITE_TAC[HAS_PATH_INTEGRAL_LINEPATH] THEN REWRITE_TAC[linepath] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY))) THEN DISCH_THEN(ASSUME_TAC o SPECL [`inv(&1 - k):real`; `--(k / (&1 - k)) % vec 1:real^1`]) THEN DISCH_THEN(MP_TAC o SPECL [`inv(k):real`; `vec 0:real^1`]) THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[REAL_INV_EQ_0; REAL_SUB_0] THEN REWRITE_TAC[REAL_INV_INV; DIMINDEX_1; REAL_POW_1; REAL_ABS_INV] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN ASM_REWRITE_TAC[REAL_SUB_LE; REAL_ARITH `~(&1 < &0)`] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_NEG_0; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LNEG] THEN ASM_SIMP_TAC[REAL_FIELD `~(k = &1) ==> (&1 - k) * --(k / (&1 - k)) = --k`] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LNEG; VECTOR_NEG_NEG; VECTOR_ARITH `(&1 - k) % x + k % x:real^1 = x`] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; REAL_MUL_RID] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH `c - a = x ==> c = x + a`)) THEN REWRITE_TAC[VECTOR_ARITH `b - (k % (b - a) + a) = (&1 - k) % (b - a)`] THEN SUBGOAL_THEN `!x. (&1 - (inv (&1 - k) * drop x + --(k / (&1 - k)))) % (k % (b - a) + a) + (inv (&1 - k) * drop x + --(k / (&1 - k))) % b = (&1 - drop x) % a + drop x % b` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[VECTOR_ARITH `x % (k % (b - a) + a) + y % b = (x * (&1 - k)) % a + (y + x * k) % b`] THEN GEN_TAC THEN BINOP_TAC THEN BINOP_TAC THEN REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN SUBGOAL_THEN `!x. (&1 - inv k * drop x) % a + (inv k * drop x) % (k % (b - a) + a) = (&1 - drop x) % a + drop x % b` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[VECTOR_ARITH `x % a + y % (k % (b - a) + a) = (x + y * (&1 - k)) % a + (y * k) % b`] THEN GEN_TAC THEN BINOP_TAC THEN BINOP_TAC THEN REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `inv(k:real)` o MATCH_MP HAS_INTEGRAL_CMUL) THEN FIRST_ASSUM(MP_TAC o SPEC `inv(&1 - k)` o MATCH_MP HAS_INTEGRAL_CMUL) THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= k ==> abs k = k`; REAL_ARITH `k <= &1 ==> abs(&1 - k) = &1 - k`] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_SUB_0] THEN REWRITE_TAC[IMP_IMP; VECTOR_MUL_LID] THEN REWRITE_TAC[COMPLEX_CMUL] THEN ONCE_REWRITE_TAC[COMPLEX_RING `Cx(inv a) * b * Cx(a) * c = (Cx(inv a) * Cx a) * b * c`] THEN ASM_SIMP_TAC[GSYM CX_MUL; REAL_MUL_LINV; REAL_SUB_0; COMPLEX_MUL_LID] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `k % vec 1:real^1` THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID]);; let PATH_INTEGRAL_SPLIT = prove (`!f a b c k. &0 <= k /\ k <= &1 /\ c - a = k % (b - a) /\ f continuous_on (segment[a,b]) ==> path_integral(linepath(a,b)) f = path_integral(linepath(a,c)) f + path_integral(linepath(c,b)) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SPLIT THEN MAP_EVERY EXISTS_TAC [`c:complex`; `k:real`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `segment[a:complex,b]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[POINTS_IN_CONVEX_HULL; IN_INSERT] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH `c - a = k % (b - a) ==> c = (&1 - k) % a + k % b`)) THEN MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[CONVEX_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]);; let PATH_INTEGRAL_SPLIT_LINEPATH = prove (`!f a b c. f continuous_on segment[a,b] /\ c IN segment[a,b] ==> path_integral(linepath (a,b)) f = path_integral(linepath (a,c)) f + path_integral(linepath (c,b)) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_SPLIT THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The special case of midpoints used in the main quadrisection. *) (* ------------------------------------------------------------------------- *) let HAS_PATH_INTEGRAL_MIDPOINT = prove (`!f a b i j. (f has_path_integral i) (linepath(a,midpoint(a,b))) /\ (f has_path_integral j) (linepath(midpoint(a,b),b)) ==> (f has_path_integral (i + j)) (linepath(a,b))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SPLIT THEN MAP_EVERY EXISTS_TAC [`midpoint(a:complex,b)`; `&1 / &2`] THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);; let PATH_INTEGRAL_MIDPOINT = prove (`!f a b. f continuous_on (segment[a,b]) ==> path_integral(linepath(a,b)) f = path_integral(linepath(a,midpoint(a,b))) f + path_integral(linepath(midpoint(a,b),b)) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_SPLIT THEN EXISTS_TAC `&1 / &2` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A couple of special case lemmas that are useful below. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL = prove (`!a b c m d. ((\x. m * x + d) has_path_integral Cx(&0)) (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))`, REPEAT GEN_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_PRIMITIVE THEN MAP_EVERY EXISTS_TAC [`\x. m / Cx(&2) * x pow 2 + d * x`; `(:complex)`] THEN SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; SUBSET_UNIV; PATHFINISH_LINEPATH; VALID_PATH_JOIN; VALID_PATH_LINEPATH] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC COMPLEX_RING);; let HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL = prove (`!f i a b c d. (f has_path_integral i) (linepath(a,b) ++ linepath(b,c) ++ linepath(c,d)) ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,d)) f = i`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE) THEN SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_LINEPATH; VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN REPEAT(MATCH_MP_TAC HAS_PATH_INTEGRAL_JOIN THEN SIMP_TAC[VALID_PATH_LINEPATH; VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN CONJ_TAC) THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Reversing the order in a double path integral. The condition is *) (* stronger than needed but it's often true in typical situations. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRAL_SWAP = prove (`!f g h. (\y. f (fstcart y) (sndcart y)) continuous_on (path_image g PCROSS path_image h) /\ valid_path g /\ valid_path h /\ (\t. vector_derivative g (at t)) continuous_on interval[vec 0,vec 1] /\ (\t. vector_derivative h (at t)) continuous_on interval[vec 0,vec 1] ==> path_integral g (\w. path_integral h (f w)) = path_integral h (\z. path_integral g (\w. f w z))`, REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[PATH_INTEGRAL_INTEGRAL] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `integral (interval[vec 0,vec 1]) (\x. path_integral h (\y. f (g x) y * vector_derivative g (at x)))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_COMPLEX_RMUL THEN REWRITE_TAC[PATH_INTEGRABLE_ON] THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\t:real^1. (f:complex->complex->complex) (g x) (h t)) = (\y. f (fstcart y) (sndcart y)) o (\t. pastecart (g(x:real^1)) (h t))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST; GSYM path; VALID_PATH_IMP_PATH]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN ASM_SIMP_TAC[path_image; FUN_IN_IMAGE]]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `integral (interval[vec 0,vec 1]) (\y. path_integral g (\x. f x (h y) * vector_derivative h (at y)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC PATH_INTEGRAL_COMPLEX_RMUL THEN REWRITE_TAC[PATH_INTEGRABLE_ON] THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\t:real^1. (f:complex->complex->complex) (g t) (h y)) = (\z. f (fstcart z) (sndcart z)) o (\t. pastecart (g t) (h(y:real^1)))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST; GSYM path; VALID_PATH_IMP_PATH]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN ASM_SIMP_TAC[path_image; FUN_IN_IMAGE]]] THEN REWRITE_TAC[PATH_INTEGRAL_INTEGRAL] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_SWAP_CONTINUOUS o lhs o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN REPEAT(MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC) THEN REWRITE_TAC[COMPLEX_MUL_AC]] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC) THENL [ALL_TAC; SUBGOAL_THEN `(\z:real^(1,1)finite_sum. vector_derivative g (at (fstcart z))) = (\t. vector_derivative (g:real^1->complex) (at t)) o fstcart` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; PCROSS; FORALL_PASTECART; GSYM PCROSS_INTERVAL; FSTCART_PASTECART]; SUBGOAL_THEN `(\z:real^(1,1)finite_sum. vector_derivative h (at (sndcart z))) = (\t. vector_derivative (h:real^1->complex) (at t)) o sndcart` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; PCROSS; FORALL_PASTECART; GSYM PCROSS_INTERVAL; SNDCART_PASTECART]] THEN SUBGOAL_THEN `(\z. f (g (fstcart z)) (h (sndcart z))) = (\y. (f:complex->complex->complex) (fstcart y) (sndcart y)) o (\p. pastecart (g(fstcart p:real^1)) (h(sndcart p:real^1)))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN REWRITE_TAC[GSYM PCROSS_INTERVAL; PCROSS; GSYM SIMPLE_IMAGE] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SET_RULE `{f x | x IN {g a b | P a /\ Q b}} = {f(g a b) | P a /\ Q b}`] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o REWRITE_RULE[path] o MATCH_MP VALID_PATH_IMP_PATH)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_GSPEC]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; FORALL_PASTECART; GSYM PCROSS_INTERVAL; PCROSS; path_image; FSTCART_PASTECART; SNDCART_PASTECART] THEN SIMP_TAC[FUN_IN_IMAGE]]);; (* ------------------------------------------------------------------------- *) (* The key quadrisection step. *) (* ------------------------------------------------------------------------- *) let NORM_SUM_LEMMA = prove (`norm(a + b + c + d:complex) >= e ==> norm(a) >= e / &4 \/ norm(b) >= e / &4 \/ norm(c) >= e / &4 \/ norm(d) >= e / &4`, NORM_ARITH_TAC);; let CAUCHY_THEOREM_QUADRISECTION = prove (`!f a b c e K. f continuous_on (convex hull {a,b,c}) /\ dist (a,b) <= K /\ dist (b,c) <= K /\ dist (c,a) <= K /\ norm(path_integral(linepath(a,b)) f + path_integral(linepath(b,c)) f + path_integral(linepath(c,a)) f) >= e * K pow 2 ==> ?a' b' c'. a' IN convex hull {a,b,c} /\ b' IN convex hull {a,b,c} /\ c' IN convex hull {a,b,c} /\ dist(a',b') <= K / &2 /\ dist(b',c') <= K / &2 /\ dist(c',a') <= K / &2 /\ norm(path_integral(linepath(a',b')) f + path_integral(linepath(b',c')) f + path_integral(linepath(c',a')) f) >= e * (K / &2) pow 2`, REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`a':complex = midpoint(b,c)`; `b':complex = midpoint(c,a)`; `c':complex = midpoint(a,b)`] THEN SUBGOAL_THEN `path_integral(linepath(a,b)) f + path_integral(linepath(b,c)) f + path_integral(linepath(c,a)) f = (path_integral(linepath(a,c')) f + path_integral(linepath(c',b')) f + path_integral(linepath(b',a)) f) + (path_integral(linepath(a',c')) f + path_integral(linepath(c',b)) f + path_integral(linepath(b,a')) f) + (path_integral(linepath(a',c)) f + path_integral(linepath(c,b')) f + path_integral(linepath(b',a')) f) + (path_integral(linepath(a',b')) f + path_integral(linepath(b',c')) f + path_integral(linepath(c',a')) f)` SUBST_ALL_TAC THENL [MP_TAC(SPEC `f:complex->complex` PATH_INTEGRAL_MIDPOINT) THEN DISCH_THEN (fun th -> MP_TAC(SPECL [`a:complex`; `b:complex`] th) THEN MP_TAC(SPECL [`b:complex`; `c:complex`] th) THEN MP_TAC(SPECL [`c:complex`; `a:complex`] th)) THEN MP_TAC(SPEC `f:complex->complex` PATH_INTEGRAL_REVERSE_LINEPATH) THEN DISCH_THEN (fun th -> MP_TAC(SPECL [`a':complex`; `b':complex`] th) THEN MP_TAC(SPECL [`b':complex`; `c':complex`] th) THEN MP_TAC(SPECL [`c':complex`; `a':complex`] th)) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC(TAUT `((a /\ c ==> b /\ d) ==> e) ==> (a ==> b) ==> (c ==> d) ==> e`)) THEN ANTS_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN SIMP_TAC[IN_INSERT; NOT_IN_EMPTY; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN MAP_EVERY EXPAND_TAC ["a'"; "b'"; "c'"] THEN SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `e * (K / &2) pow 2 = (e * K pow 2) / &4`] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP NORM_SUM_LEMMA) THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`a:complex`; `c':complex`; `b':complex`]; MAP_EVERY EXISTS_TAC [`a':complex`; `c':complex`; `b:complex`]; MAP_EVERY EXISTS_TAC [`a':complex`; `c:complex`; `b':complex`]; MAP_EVERY EXISTS_TAC [`a':complex`; `b':complex`; `c':complex`]] THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXPAND_TAC ["a'"; "b'"; "c'"] THEN SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT] THEN REWRITE_TAC[midpoint; dist; GSYM VECTOR_SUB_LDISTRIB; VECTOR_ARITH `a - inv(&2) % (a + b) = inv(&2) % (a - b)`; VECTOR_ARITH `inv(&2) % (c + a) - a = inv(&2) % (c - a)`; VECTOR_ARITH `(a + b) - (c + a) = b - c`; VECTOR_ARITH `(b + c) - (c + a) = b - a`] THEN SIMP_TAC[NORM_MUL; REAL_ARITH `abs(inv(&2)) * x <= k / &2 <=> x <= k`] THEN ASM_REWRITE_TAC[GSYM dist] THEN ASM_MESON_TAC[DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Yet at small enough scales this cannot be the case. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_POINTS_CLOSER = prove (`!a b c x y:real^N. x IN convex hull {a,b,c} /\ y IN convex hull {a,b,c} ==> norm(x - y) <= norm(a - b) \/ norm(x - y) <= norm(b - c) \/ norm(x - y) <= norm(c - a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{a:real^N,b,c}` SIMPLEX_EXTREMAL_LE) THEN REWRITE_TAC[FINITE_INSERT; FINITE_RULES; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN ASM_MESON_TAC[NORM_POS_LE; REAL_LE_TRANS; NORM_SUB]);; let HOLOMORPHIC_POINT_SMALL_TRIANGLE = prove (`!f s x e. x IN s /\ f continuous_on s /\ f complex_differentiable (at x within s) /\ &0 < e ==> ?k. &0 < k /\ !a b c. dist(a,b) <= k /\ dist(b,c) <= k /\ dist(c,a) <= k /\ x IN convex hull {a,b,c} /\ convex hull {a,b,c} SUBSET s ==> norm(path_integral(linepath(a,b)) f + path_integral(linepath(b,c)) f + path_integral(linepath(c,a)) f) <= e * (dist(a,b) + dist(b,c) + dist(c,a)) pow 2`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [complex_differentiable]) THEN DISCH_THEN(X_CHOOSE_THEN `f':complex` MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [has_complex_derivative] THEN REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `a /\ b ==> c <=> b ==> a ==> c`] THEN REWRITE_TAC[APPROACHABLE_LT_LE] THEN ONCE_REWRITE_TAC[TAUT `b ==> a ==> c <=> a /\ b ==> c`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`; `c:complex`] THEN STRIP_TAC THEN SUBGOAL_THEN `path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = path_integral (linepath(a,b)) (\y. f y - f x - f' * (y - x)) + path_integral (linepath(b,c)) (\y. f y - f x - f' * (y - x)) + path_integral (linepath(c,a)) (\y. f y - f x - f' * (y - x))` SUBST1_TAC THENL [SUBGOAL_THEN `path_integral (linepath(a,b)) (\y. f y - f x - f' * (y - x)) = path_integral (linepath(a,b)) f - path_integral (linepath(a,b)) (\y. f x + f' * (y - x)) /\ path_integral (linepath(b,c)) (\y. f y - f x - f' * (y - x)) = path_integral (linepath(b,c)) f - path_integral (linepath(b,c)) (\y. f x + f' * (y - x)) /\ path_integral (linepath(c,a)) (\y. f y - f x - f' * (y - x)) = path_integral (linepath(c,a)) f - path_integral (linepath(c,a)) (\y. f x + f' * (y - x))` (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL [REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a - b - c = a - (b + c)`] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN CONJ_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_COMPLEX_MUL; CONTINUOUS_ON_SUB] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_RING `x + y + z = (x - x') + (y - y') + (z - z') <=> x' + y' + z' = Cx(&0)`] THEN MP_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`; `f':complex`; `f x - f' * x`] TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL) THEN REWRITE_TAC[COMPLEX_RING `f' * x' + f x - f' * x = f x + f' * (x' - x)`] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN REWRITE_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x * y /\ &0 <= x * z /\ &0 <= y * z /\ a <= (e * (x + y + z)) * x + (e * (x + y + z)) * y + (e * (x + y + z)) * z ==> a <= e * (x + y + z) pow 2`) THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE] THEN REPEAT(MATCH_MP_TAC NORM_TRIANGLE_LE THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THEN (MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `\y:complex. f y - f x - f' * (y - x)` THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_LT_IMP_LE; NORM_POS_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; ETA_AX; CONTINUOUS_ON_COMPLEX_MUL; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]; ALL_TAC] THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e * norm(y - x:complex)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. y IN t /\ t SUBSET s ==> y IN s`) THEN EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(REAL_ARITH `!n1 n2 n3. n1 <= d /\ n2 <= d /\ n3 <= d /\ (n <= n1 \/ n <= n2 \/ n <= n3) ==> n <= d`) THEN MAP_EVERY EXISTS_TAC [`norm(a - b:complex)`; `norm(b - c:complex)`; `norm(c - a:complex)`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TRIANGLE_POINTS_CLOSER]; ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `(x <= a \/ x <= b \/ x <= c) /\ (&0 <= a /\ &0 <= b /\ &0 <= c) ==> x <= a + b + c`) THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC TRIANGLE_POINTS_CLOSER THEN ASM_REWRITE_TAC[]] THEN REPEAT CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]));; (* ------------------------------------------------------------------------- *) (* Hence the most basic theorem for a triangle. *) (* ------------------------------------------------------------------------- *) let CAUCHY_THEOREM_TRIANGLE = prove (`!f a b c. f holomorphic_on (convex hull {a,b,c}) ==> (f has_path_integral Cx(&0)) (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))`, let lemma1 = prove (`!P Q abc. P abc 0 /\ (!abc:A n. P abc n ==> ?abc'. P abc' (SUC n) /\ Q abc' abc) ==> ?ABC. ABC 0 = abc /\ !n. P (ABC n) n /\ Q (ABC(SUC n)) (ABC n)`, REPEAT STRIP_TAC THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `ABC 0 = abc:A /\ !n. ABC(SUC n) = @abc. P abc (SUC n) /\ Q abc (ABC n)` THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_AND_THM] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]) in let lemma3 = prove (`!P Q a:A b:A c:A. P a b c 0 /\ (!a b c n. P a b c n ==> ?a' b' c'. P a' b' c' (SUC n) /\ Q a' b' c' a b c) ==> ?A B C. A 0 = a /\ B 0 = b /\ C 0 = c /\ !n. P (A n) (B n) (C n) n /\ Q (A(SUC n)) (B(SUC n)) (C(SUC n)) (A n) (B n) (C n)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\(a,b,c). (P:A->A->A->num->bool) a b c`; `\(a,b,c) (a',b',c'). (Q:A->A->A->A->A->A->bool) a b c a' b' c'`; `(a:A,b:A,c:A)`] lemma1) THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `ABC:num->A#A#A` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`(\(a,b,c). a) o (ABC:num->A#A#A)`; `(\(a,b,c). b) o (ABC:num->A#A#A)`; `(\(a,b,c). c) o (ABC:num->A#A#A)`] THEN REWRITE_TAC[o_THM] THEN REPEAT(CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC]) THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN SPEC_TAC(`(ABC:num->A#A#A) (SUC n)`,`y:A#A#A`) THEN SPEC_TAC(`(ABC:num->A#A#A) n`,`x:A#A#A`) THEN REWRITE_TAC[FORALL_PAIR_THM]) in REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] SEGMENTS_SUBSET_CONVEX_HULL) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN SUBGOAL_THEN `f path_integrable_on (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))` MP_TAC THENL [SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; VALID_PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_MESON_TAC[PATH_INTEGRABLE_CONTINUOUS_LINEPATH; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN SIMP_TAC[path_integrable_on] THEN DISCH_THEN(X_CHOOSE_TAC `y:complex`) THEN ASM_CASES_TAC `y = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `K = &1 + max (dist(a:complex,b)) (max (dist(b,c)) (dist(c,a)))` THEN SUBGOAL_THEN `&0 < K` ASSUME_TAC THENL [EXPAND_TAC "K" THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN REWRITE_TAC[REAL_LE_MAX; DIST_POS_LE]; ALL_TAC] THEN ABBREV_TAC `e = norm(y:complex) / K pow 2` THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [EXPAND_TAC "e" THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; COMPLEX_NORM_NZ]; ALL_TAC] THEN SUBGOAL_THEN `?A B C. A 0 = a /\ B 0 = b /\ C 0 = c /\ !n. (convex hull {A n,B n,C n} SUBSET convex hull {a,b,c} /\ dist(A n,B n) <= K / &2 pow n /\ dist(B n,C n) <= K / &2 pow n /\ dist(C n,A n) <= K / &2 pow n /\ norm(path_integral(linepath (A n,B n)) f + path_integral(linepath (B n,C n)) f + path_integral(linepath (C n,A n)) f) >= e * (K / &2 pow n) pow 2) /\ convex hull {A(SUC n),B(SUC n),C(SUC n)} SUBSET convex hull {A n,B n,C n}` MP_TAC THENL [MATCH_MP_TAC lemma3 THEN CONJ_TAC THENL [ASM_REWRITE_TAC[real_pow; REAL_DIV_1; CONJ_ASSOC; SUBSET_REFL] THEN CONJ_TAC THENL [EXPAND_TAC "K" THEN REAL_ARITH_TAC; ALL_TAC] THEN EXPAND_TAC "e" THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_POW_LT] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x >= y`) THEN AP_TERM_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN REWRITE_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a':complex`; `b':complex`; `c':complex`; `n:num`] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `a':complex`; `b':complex`; `c':complex`; `e:real`; `K / &2 pow n`] CAUCHY_THEOREM_QUADRISECTION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_FIELD `x / (&2 * y) = x / y / &2`] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ t SUBSET u ==> s SUBSET u /\ s SUBSET t`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `?x:complex. !n:num. x IN convex hull {A n,B n,C n}` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSED_NEST THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC COMPACT_IMP_CLOSED; REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY]; MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; MATCH_MP_TAC COMPACT_IMP_BOUNDED] THEN MATCH_MP_TAC FINITE_IMP_COMPACT_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_RULES]; ALL_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `convex hull {a:complex,b,c}`; `x:complex`; `e / &10`] HOLOMORPHIC_POINT_SMALL_TRIANGLE) THEN ANTS_TAC THENL [ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; complex_differentiable] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN ASM_MESON_TAC[holomorphic_on; SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `K:real / k` REAL_ARCH_POW2) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(A:num->complex) n`; `(B:num->complex) n`; `(C:num->complex) n`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e * (K / &2 pow n) pow 2` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[GSYM real_ge]] THEN ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ y <= &9 * x ==> inv(&10) * y < x`) THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[REAL_ARITH `&9 * x pow 2 = (&3 * x) pow 2`] THEN MATCH_MP_TAC REAL_POW_LE2 THEN SIMP_TAC[REAL_LE_ADD; DIST_POS_LE; GSYM real_div] THEN MATCH_MP_TAC(REAL_ARITH `x <= a /\ y <= a /\ z <= a ==> x + y + z <= &3 * a`) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Version needing function holomorphic in interior only. *) (* ------------------------------------------------------------------------- *) let CAUCHY_THEOREM_FLAT_LEMMA = prove (`!f a b c k. f continuous_on convex hull {a,b,c} /\ c - a = k % (b - a) /\ &0 <= k ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = Cx(&0)`, REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] SEGMENTS_SUBSET_CONVEX_HULL) THEN ASM_CASES_TAC `k <= &1` THENL [MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `b:complex`; `c:complex`; `k:real`] PATH_INTEGRAL_SPLIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(COMPLEX_RING `x = --b /\ y = --a ==> (x + y) + (a + b) = Cx(&0)`) THEN CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_REVERSE_LINEPATH THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `c:complex`; `b:complex`; `inv k:real`] PATH_INTEGRAL_SPLIT) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LE_INV_EQ; REAL_MUL_LINV; REAL_INV_LE_1; VECTOR_MUL_LID; REAL_ARITH `~(k <= &1) ==> ~(k = &0) /\ &1 <= k`] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(COMPLEX_RING `ac = --ca ==> ac = ab + bc ==> ab + bc + ca = Cx(&0)`) THEN MATCH_MP_TAC PATH_INTEGRAL_REVERSE_LINEPATH THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; let CAUCHY_THEOREM_FLAT = prove (`!f a b c k. f continuous_on convex hull {a,b,c} /\ c - a = k % (b - a) ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = Cx(&0)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= k` THENL [ASM_MESON_TAC[CAUCHY_THEOREM_FLAT_LEMMA]; ALL_TAC] THEN STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] SEGMENTS_SUBSET_CONVEX_HULL) THEN MP_TAC(ISPECL [`f:complex->complex`; `b:complex`; `a:complex`; `c:complex`; `&1 - k`] CAUCHY_THEOREM_FLAT_LEMMA) THEN ANTS_TAC THENL [ASM_MESON_TAC[INSERT_AC; REAL_ARITH `~(&0 <= k) ==> &0 <= &1 - k`; VECTOR_ARITH `b - a = k % (c - a) ==> (b - c) = (&1 - k) % (a - c)`]; ALL_TAC] THEN MATCH_MP_TAC(COMPLEX_RING `ab = --ba /\ ac = --ca /\ bc = --cb ==> ba + ac + cb = Cx(&0) ==> ab + bc + ca = Cx(&0)`) THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_REVERSE_LINEPATH THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]);; let CAUCHY_THEOREM_TRIANGLE_INTERIOR = prove (`!f a b c. f continuous_on (convex hull {a,b,c}) /\ f holomorphic_on interior (convex hull {a,b,c}) ==> (f has_path_integral Cx(&0)) (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))`, REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] SEGMENTS_SUBSET_CONVEX_HULL) THEN SUBGOAL_THEN `?B. &0 < B /\ !y. y IN IMAGE (f:complex->complex) (convex hull {a,b,c}) ==> norm(y) <= B` MP_TAC THENL [REWRITE_TAC[GSYM BOUNDED_POS] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL; FINITE_INSERT; FINITE_RULES]; REWRITE_TAC[FORALL_IN_IMAGE] THEN STRIP_TAC] THEN SUBGOAL_THEN `?C. &0 < C /\ !x:complex. x IN convex hull {a,b,c} ==> norm(x) <= C` MP_TAC THENL [REWRITE_TAC[GSYM BOUNDED_POS] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL; FINITE_INSERT; FINITE_RULES]; STRIP_TAC] THEN SUBGOAL_THEN `(f:complex->complex) uniformly_continuous_on (convex hull {a,b,c})` MP_TAC THENL [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL; FINITE_RULES; FINITE_INSERT]; ALL_TAC] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_TAC THEN SUBGOAL_THEN `f path_integrable_on (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))` MP_TAC THENL [SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; VALID_PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_MESON_TAC[PATH_INTEGRABLE_CONTINUOUS_LINEPATH; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN SIMP_TAC[path_integrable_on] THEN DISCH_THEN(X_CHOOSE_TAC `y:complex`) THEN ASM_CASES_TAC `y = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN UNDISCH_TAC `~(y = Cx(&0))` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `c:complex = a` THENL [MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ]; ALL_TAC] THEN ASM_CASES_TAC `b:complex = c` THENL [ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = c + a + b`] THEN MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[INSERT_AC]; ALL_TAC] THEN ASM_CASES_TAC `a:complex = b` THENL [ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = b + c + a`] THEN MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[INSERT_AC]; ALL_TAC] THEN ASM_CASES_TAC `interior(convex hull {a:complex,b,c}) = {}` THENL [MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN SUBGOAL_THEN `{a:complex,b,c} HAS_SIZE (dimindex(:2) + 1)` MP_TAC THENL [ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH; IN_INSERT; NOT_IN_EMPTY]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP INTERIOR_CONVEX_HULL_EQ_EMPTY) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `collinear{a:complex,b,c}` MP_TAC THENL [ASM_REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `d:complex`) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `y = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `norm(y:complex) / &24 / C`) THEN SUBGOAL_THEN `&0 < norm(y:complex) / &24 / C` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NORM_POS_LE; REAL_LTE_ADD; COMPLEX_NORM_NZ; COMPLEX_SUB_0]; ASM_REWRITE_TAC[dist]] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `e = min (&1) (min (d1 / (&4 * C)) ((norm(y:complex) / &24 / C) / B))` THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [EXPAND_TAC "e" THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_MIN; REAL_LT_DIV; COMPLEX_NORM_NZ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN ABBREV_TAC `shrink = \x:complex. x - e % (x - d)` THEN SUBGOAL_THEN `shrink (a:complex) IN interior(convex hull {a,b,c}) /\ shrink b IN interior(convex hull {a,b,c}) /\ shrink c IN interior(convex hull {a,b,c})` STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THEN EXPAND_TAC "shrink" THEN MATCH_MP_TAC IN_INTERIOR_CONVEX_SHRINK THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL] THEN (CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "e" THEN REAL_ARITH_TAC]) THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]; ALL_TAC] THEN SUBGOAL_THEN `norm((path_integral(linepath(shrink a,shrink b)) f - path_integral(linepath(a,b)) f) + (path_integral(linepath(shrink b,shrink c)) f - path_integral(linepath(b,c)) f) + (path_integral(linepath(shrink c,shrink a)) f - path_integral(linepath(c,a)) f)) <= norm(y:complex) / &2` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[COMPLEX_RING `(ab' - ab) + (bc' - bc) + (ca' - ca) = (ab' + bc' + ca') - (ab + bc + ca)`] THEN SUBGOAL_THEN `(f has_path_integral (Cx(&0))) (linepath (shrink a,shrink b) ++ linepath (shrink b,shrink c) ++ linepath (shrink c,shrink (a:complex)))` MP_TAC THENL [MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `interior(convex hull {a:complex,b,c})` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[CONVEX_INTERIOR; CONVEX_CONVEX_HULL] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ ~(y = &0) ==> ~(y <= y / &2)`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; NORM_POS_LE]] THEN SUBGOAL_THEN `!x y. x IN convex hull {a,b,c} /\ y IN convex hull {a,b,c} ==> norm(x - y) <= &2 * C` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MUL_2; VECTOR_SUB] THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `x / &2 = x / &6 + x / &6 + x / &6`] THEN REPEAT(MATCH_MP_TAC NORM_TRIANGLE_LE THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM CONTENT_UNIT_1] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THENL [EXISTS_TAC `\x. f(linepath(shrink a,shrink b) x) * (shrink b - shrink a) - f(linepath(a,b) x) * (b - a)`; EXISTS_TAC `\x. f(linepath(shrink b,shrink c) x) * (shrink c - shrink b) - f(linepath(b,c) x) * (c - b)`; EXISTS_TAC `\x. f(linepath(shrink c,shrink a) x) * (shrink a - shrink c) - f(linepath(c,a) x) * (a - c)`] THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; REAL_ARITH `&0 < x ==> &0 <= x / &6`] THEN (CONJ_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_SUB THEN REWRITE_TAC[GSYM HAS_PATH_INTEGRAL_LINEPATH] THEN CONJ_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[COMPLEX_RING `f' * x' - f * x = f' * (x' - x) + x * (f' - f):complex`] THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B * (norm(y:complex) / &24 / C / B) * &2 * C + (&2 * C) * (norm y / &24 / C)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MAP_EVERY UNDISCH_TAC [`&0 < B`; `&0 < C`] THEN CONV_TAC REAL_FIELD] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THENL [CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) LINEPATH_IN_PATH (lhand w))) THEN ASM_REWRITE_TAC[] THEN W(fun (asl,w) -> SPEC_TAC(lhand(rand w),`x:complex`)) THEN REWRITE_TAC[GSYM SUBSET; SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN EXPAND_TAC "shrink" THEN REWRITE_TAC[VECTOR_ARITH `(b - e % (b - d)) - (a - e % (a - d)) - (b - a) = e % (a - b)`] THEN REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 < x ==> abs x = x`; REAL_ABS_POS] THEN CONJ_TAC THENL [EXPAND_TAC "e" THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) LINEPATH_IN_PATH (lhand w))) THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) LINEPATH_IN_PATH (lhand w))) THEN ASM_REWRITE_TAC[] THEN W(fun (asl,w) -> SPEC_TAC(lhand(rand w),`x:complex`)) THEN REWRITE_TAC[GSYM SUBSET; SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN REWRITE_TAC[linepath] THEN REWRITE_TAC[VECTOR_ARITH `((&1 - x) % a' + x % b') - ((&1 - x) % a + x % b) = (&1 - x) % (a' - a) + x % (b' - b)`] THEN EXPAND_TAC "shrink" THEN REWRITE_TAC[VECTOR_ARITH `a - b - a = --b`] THEN MATCH_MP_TAC NORM_TRIANGLE_LT THEN REWRITE_TAC[NORM_MUL; NORM_NEG] THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> (c /\ d /\ e) /\ a /\ b`] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e * &2 * C` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < x ==> abs x = x`] THEN (CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET; HULL_SUBSET; IN_INSERT]; ALL_TAC]) THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN EXPAND_TAC "e" THEN REWRITE_TAC[REAL_MIN_LT] THEN DISJ2_TAC THEN DISJ1_TAC THEN REWRITE_TAC[REAL_FIELD `d / (a * b) = inv(a:real) * d / b`] THEN REWRITE_TAC[REAL_ARITH `inv(&4) * x < inv(&2) * x <=> &0 < x`] THEN ASM_SIMP_TAC[REAL_LT_DIV]));; (* ------------------------------------------------------------------------- *) (* Version allowing finite number of exceptional points. *) (* ------------------------------------------------------------------------- *) let CAUCHY_THEOREM_TRIANGLE_COFINITE = prove (`!f s a b c. f continuous_on (convex hull {a,b,c}) /\ FINITE s /\ (!x. x IN interior(convex hull {a,b,c}) DIFF s ==> f complex_differentiable (at x)) ==> (f has_path_integral Cx(&0)) (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))`, GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `CARD(s:complex->bool)` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THENL [MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_INTERIOR THEN ASM_REWRITE_TAC[holomorphic_on] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[complex_differentiable; IN_DIFF; NOT_IN_EMPTY] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `d:complex`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (d:complex)`) THEN ASM_SIMP_TAC[CARD_DELETE; CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN ASM_CASES_TAC `(d:complex) IN convex hull {a,b,c}` THENL [ALL_TAC; DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DIFF; IN_DELETE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]] THEN DISCH_TAC THEN SUBGOAL_THEN `(f has_path_integral Cx(&0)) (linepath(a,b) ++ linepath(b,d) ++ linepath(d,a)) /\ (f has_path_integral Cx(&0)) (linepath(b,c) ++ linepath(c,d) ++ linepath(d,b)) /\ (f has_path_integral Cx(&0)) (linepath(c,a) ++ linepath(a,d) ++ linepath(d,c))` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]; ALL_TAC]) THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DIFF; IN_DELETE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN (ASM_CASES_TAC `x:complex = d` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[NOT_IN_INTERIOR_CONVEX_HULL_3]; ALL_TAC]) THEN DISCH_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN interior s ==> interior s SUBSET interior t ==> x IN interior t`)) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN SIMP_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]; ALL_TAC] THEN SUBGOAL_THEN `f path_integrable_on (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))` MP_TAC THENL [SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; VALID_PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] SEGMENTS_SUBSET_CONVEX_HULL) THEN ASM_MESON_TAC[PATH_INTEGRABLE_CONTINUOUS_LINEPATH; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:complex` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (MP_TAC o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL)) THEN ASM_CASES_TAC `y = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; UNDISCH_TAC `~(y = Cx(&0))`] THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(f:complex->complex) continuous_on segment[a,d] /\ f continuous_on segment[b,d] /\ f continuous_on segment[c,d]` MP_TAC THENL [ALL_TAC; DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (MP_TAC o MATCH_MP PATH_INTEGRAL_REVERSE_LINEPATH)) THEN CONV_TAC COMPLEX_RING] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN SIMP_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]);; (* ------------------------------------------------------------------------- *) (* Existence of a primitive. *) (* ------------------------------------------------------------------------- *) let STARLIKE_CONVEX_SUBSET = prove (`!s a b c:real^N. a IN s /\ segment[b,c] SUBSET s /\ (!x. x IN s ==> segment[a,x] SUBSET s) ==> convex hull {a,b,c} SUBSET s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{b:real^N,c}`; `a:real^N`] CONVEX_HULL_INSERT) THEN REWRITE_TAC[NOT_INSERT_EMPTY] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real`; `v:real`; `d:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; SEGMENT_CONVEX_HULL]; ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_2; IN_ELIM_THM] THEN ASM_MESON_TAC[]]);; let TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE = prove (`!f s a. a IN s /\ open s /\ f continuous_on s /\ (!z. z IN s ==> segment[a,z] SUBSET s) /\ (!b c. segment[b,c] SUBSET s ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = Cx(&0)) ==> ?g. !z. z IN s ==> (g has_complex_derivative f(z)) (at z)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. path_integral (linepath(a,x)) f` THEN X_GEN_TAC `x:complex` THEN STRIP_TAC THEN REWRITE_TAC[has_complex_derivative] THEN REWRITE_TAC[has_derivative_at; LINEAR_COMPLEX_MUL] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\y. inv(norm(y - x)) % (path_integral(linepath(x,y)) f - f x * (y - x))` THEN REWRITE_TAC[VECTOR_ARITH `i % (x - a) - i % (y - (z + a)) = i % (x + z - y)`] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `y:complex`] PATH_INTEGRAL_REVERSE_LINEPATH) THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[NORM_SUB] dist]; REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC(COMPLEX_RING `ax + xy + ya = Cx(&0) ==> ay = --ya ==> xy + ax - ay = Cx(&0)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dist; NORM_0; VECTOR_SUB_REFL] THEN ASM_MESON_TAC[NORM_SUB]]; REWRITE_TAC[LIM_AT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `(f:complex->complex) continuous at x` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_INTERIOR THEN ASM_MESON_TAC[INTERIOR_OPEN]; ALL_TAC] THEN REWRITE_TAC[continuous_at; dist; VECTOR_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `f path_integrable_on linepath(x,y)` MP_TAC THENL [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:complex,d2)` THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dist; NORM_0; VECTOR_SUB_REFL] THEN ASM_MESON_TAC[NORM_SUB]; ASM_REWRITE_TAC[SUBSET; IN_BALL; dist]]; ALL_TAC] THEN REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:complex` THEN MP_TAC(SPECL [`x:complex`; `y:complex`; `(f:complex->complex) x`] HAS_PATH_INTEGRAL_CONST_LINEPATH) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_NEG) THEN REWRITE_TAC[COMPLEX_NEG_SUB] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `\w. (f:complex->complex) w - f x` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 <= e / &2`] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[REAL_LET_TRANS; SEGMENT_BOUND]]);; let HOLOMORPHIC_STARLIKE_PRIMITIVE = prove (`!f s k. open s /\ starlike s /\ FINITE k /\ f continuous_on s /\ (!x. x IN s DIFF k ==> f complex_differentiable at x) ==> ?g. !x. x IN s ==> (g has_complex_derivative f(x)) (at x)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [starlike]) THEN MATCH_MP_TAC TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE THEN EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:complex`; `y:complex`] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL THEN MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_COFINITE THEN EXISTS_TAC `k:complex->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `convex hull {a:complex,x,y} SUBSET s` ASSUME_TAC THENL [MATCH_MP_TAC STARLIKE_CONVEX_SUBSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Cauchy's theorem for an open starlike set. *) (* ------------------------------------------------------------------------- *) let CAUCHY_THEOREM_STARLIKE = prove (`!f s k g. open s /\ starlike s /\ FINITE k /\ f continuous_on s /\ (!x. x IN s DIFF k ==> f complex_differentiable at x) /\ valid_path g /\ (path_image g) SUBSET s /\ pathfinish g = pathstart g ==> (f has_path_integral Cx(&0)) (g)`, MESON_TAC[HOLOMORPHIC_STARLIKE_PRIMITIVE; CAUCHY_THEOREM_PRIMITIVE; HAS_COMPLEX_DERIVATIVE_AT_WITHIN]);; let CAUCHY_THEOREM_STARLIKE_SIMPLE = prove (`!f s g. open s /\ starlike s /\ f holomorphic_on s /\ valid_path g /\ (path_image g) SUBSET s /\ pathfinish g = pathstart g ==> (f has_path_integral Cx(&0)) (g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_STARLIKE THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; FINITE_RULES] THEN REWRITE_TAC[IN_DIFF; NOT_IN_EMPTY; complex_differentiable] THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; holomorphic_on]);; (* ------------------------------------------------------------------------- *) (* For a convex set we can avoid assuming openness and boundary analyticity. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE = prove (`!f s a. a IN s /\ convex s /\ f continuous_on s /\ (!b c. b IN s /\ c IN s ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = Cx(&0)) ==> ?g. !z. z IN s ==> (g has_complex_derivative f(z)) (at z within s)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. path_integral (linepath(a,x)) f` THEN X_GEN_TAC `x:complex` THEN STRIP_TAC THEN REWRITE_TAC[has_complex_derivative] THEN REWRITE_TAC[has_derivative_within; LINEAR_COMPLEX_MUL] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\y. inv(norm(y - x)) % (path_integral(linepath(x,y)) f - f x * (y - x))` THEN REWRITE_TAC[VECTOR_ARITH `i % (x - a) - i % (y - (z + a)) = i % (x + z - y)`] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `y:complex`] PATH_INTEGRAL_REVERSE_LINEPATH) THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC(COMPLEX_RING `ax + xy + ya = Cx(&0) ==> ay = --ya ==> xy + ax - ay = Cx(&0)`) THEN ASM_SIMP_TAC[]]; REWRITE_TAC[LIM_WITHIN] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `(f:complex->complex) continuous (at x within s)` MP_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; ALL_TAC] THEN REWRITE_TAC[continuous_within; dist; VECTOR_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d1:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `f path_integrable_on linepath(x,y)` MP_TAC THENL [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:complex` THEN MP_TAC(SPECL [`x:complex`; `y:complex`; `(f:complex->complex) x`] HAS_PATH_INTEGRAL_CONST_LINEPATH) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_NEG) THEN REWRITE_TAC[COMPLEX_NEG_SUB] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `\w. (f:complex->complex) w - f x` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 <= e / &2`] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `w IN t ==> t SUBSET s ==> w IN s`)) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; ASM_MESON_TAC[REAL_LET_TRANS; SEGMENT_BOUND]]]);; let PATHINTEGRAL_CONVEX_PRIMITIVE = prove (`!f s. convex s /\ f continuous_on s /\ (!a b c. a IN s /\ b IN s /\ c IN s ==> (f has_path_integral Cx(&0)) (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))) ==> ?g. !x. x IN s ==> (g has_complex_derivative f(x)) (at x within s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE THEN EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL THEN ASM_SIMP_TAC[]);; let HOLOMORPHIC_CONVEX_PRIMITIVE = prove (`!f s k. convex s /\ FINITE k /\ f continuous_on s /\ (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) ==> ?g. !x. x IN s ==> (g has_complex_derivative f(x)) (at x within s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATHINTEGRAL_CONVEX_PRIMITIVE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_COFINITE THEN EXISTS_TAC `k:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[]; X_GEN_TAC `w:complex` THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN SPEC_TAC(`w:complex`,`w:complex`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (s DIFF k) SUBSET (t DIFF k)`) THEN MATCH_MP_TAC SUBSET_INTERIOR] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let CAUCHY_THEOREM_CONVEX = prove (`!f s k g. convex s /\ FINITE k /\ f continuous_on s /\ (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) /\ valid_path g /\ (path_image g) SUBSET s /\ pathfinish g = pathstart g ==> (f has_path_integral Cx(&0)) (g)`, MESON_TAC[HOLOMORPHIC_CONVEX_PRIMITIVE; CAUCHY_THEOREM_PRIMITIVE]);; let CAUCHY_THEOREM_CONVEX_SIMPLE = prove (`!f s g. convex s /\ f holomorphic_on s /\ valid_path g /\ (path_image g) SUBSET s /\ pathfinish g = pathstart g ==> (f has_path_integral Cx(&0)) (g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; FINITE_RULES] THEN REWRITE_TAC[IN_DIFF; NOT_IN_EMPTY; complex_differentiable] THEN SUBGOAL_THEN `f holomorphic_on (interior s)` MP_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN MESON_TAC[holomorphic_on; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_INTERIOR]);; (* ------------------------------------------------------------------------- *) (* In particular for a disc. *) (* ------------------------------------------------------------------------- *) let CAUCHY_THEOREM_DISC = prove (`!f g k a e. FINITE k /\ f continuous_on cball(a,e) /\ (!x. x IN ball(a,e) DIFF k ==> f complex_differentiable at x) /\ valid_path g /\ (path_image g) SUBSET cball(a,e) /\ pathfinish g = pathstart g ==> (f has_path_integral Cx(&0)) (g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX THEN MAP_EVERY EXISTS_TAC [`cball(a:complex,e)`; `k:complex->bool`] THEN ASM_REWRITE_TAC[INTERIOR_CBALL; CONVEX_CBALL]);; let CAUCHY_THEOREM_DISC_SIMPLE = prove (`!f g a e. f holomorphic_on ball(a,e) /\ valid_path g /\ (path_image g) SUBSET ball(a,e) /\ pathfinish g = pathstart g ==> (f has_path_integral Cx(&0)) (g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX_SIMPLE THEN EXISTS_TAC `ball(a:complex,e)` THEN ASM_REWRITE_TAC[CONVEX_BALL; OPEN_BALL]);; (* ------------------------------------------------------------------------- *) (* Generalize integrability to local primitives. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA = prove (`!f f' g s a b. (!x. x IN s ==> (f has_complex_derivative f' x) (at x within s)) /\ g piecewise_differentiable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> g(x) IN s) ==> (\x. f' (g x) * vector_derivative g (at x within interval[a,b])) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL [ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY]; REWRITE_TAC[integrable_on] THEN EXISTS_TAC `(f:complex->complex) (g(b:real^1)) - f(g a)` THEN MATCH_MP_TAC PATH_INTEGRAL_PRIMITIVE_LEMMA THEN ASM_MESON_TAC[]]);; let PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY = prove (`!f g s a b. (!x. x IN s ==> ?d h. &0 < d /\ !y. norm(y - x) < d ==> (h has_complex_derivative f(y)) (at y within s)) /\ g piecewise_differentiable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> g(x) IN s) ==> (\x. f(g x) * vector_derivative g (at x)) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_LITTLE_SUBINTERVALS THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^1->complex) x`) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:real`; `h:complex->complex`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON) THEN REWRITE_TAC[continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SIMP_TAC[integrable_on; GSYM HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN REWRITE_TAC[GSYM integrable_on] THEN MATCH_MP_TAC PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA THEN MAP_EVERY EXISTS_TAC [`h:complex->complex`; `IMAGE (g:real^1->complex) (interval[u,v])`] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; IN_BALL; DIST_SYM]; ASM_MESON_TAC[PIECEWISE_DIFFERENTIABLE_ON_SUBSET]; ASM SET_TAC[]]);; let PATH_INTEGRAL_LOCAL_PRIMITIVE = prove (`!f g s. (!x. x IN s ==> ?d h. &0 < d /\ !y. norm(y - x) < d ==> (h has_complex_derivative f(y)) (at y within s)) /\ valid_path g /\ (path_image g) SUBSET s ==> f path_integrable_on g`, REWRITE_TAC[valid_path; path_image; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[path_integrable_on; has_path_integral] THEN REWRITE_TAC[HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN REWRITE_TAC[GSYM integrable_on; PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY]);; (* ------------------------------------------------------------------------- *) (* In particular if a function is holomorphic. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRABLE_HOLOMORPHIC = prove (`!f g s k. open s /\ FINITE k /\ f continuous_on s /\ (!x. x IN s DIFF k ==> f complex_differentiable at x) /\ valid_path g /\ path_image g SUBSET s ==> f path_integrable_on g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_LOCAL_PRIMITIVE THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(z:complex,d)`; `k:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[CONVEX_BALL; DIFF_EMPTY] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN SIMP_TAC[IN_DIFF] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[IN_BALL; dist] THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]]);; let PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE = prove (`!f g s. open s /\ f holomorphic_on s /\ valid_path g /\ path_image g SUBSET s ==> f path_integrable_on g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; FINITE_RULES; DIFF_EMPTY] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable]);; (* ------------------------------------------------------------------------- *) (* Key fact that path integral is the same for a "nearby" path. This is the *) (* main lemma for the homotopy form of Cauchy's theorem and is also useful *) (* if we want "without loss of generality" to assume some niceness of our *) (* path (e.g. smoothness). It can also be used to define the integrals of *) (* analytic functions over arbitrary continuous paths. This is just done for *) (* winding numbers now; I'm not sure if it's worth going further with that. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRAL_NEARBY_ENDS,PATH_INTEGRAL_NEARBY_LOOP = (CONJ_PAIR o prove) (`(!s p. open s /\ path p /\ path_image p SUBSET s ==> ?d. &0 < d /\ !g h. valid_path g /\ valid_path h /\ (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < d /\ norm(h t - p t) < d) /\ pathstart h = pathstart g /\ pathfinish h = pathfinish g ==> path_image g SUBSET s /\ path_image h SUBSET s /\ !f. f holomorphic_on s ==> path_integral h f = path_integral g f) /\ (!s p. open s /\ path p /\ path_image p SUBSET s ==> ?d. &0 < d /\ !g h. valid_path g /\ valid_path h /\ (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < d /\ norm(h t - p t) < d) /\ pathfinish g = pathstart g /\ pathfinish h = pathstart h ==> path_image g SUBSET s /\ path_image h SUBSET s /\ !f. f holomorphic_on s ==> path_integral h f = path_integral g f)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[]) [`open(s:complex->bool)`; `path(p:real^1->complex)`; `path_image(p:real^1->complex) SUBSET s`] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN MATCH_MP_TAC(MESON[] `(?x. P x /\ Q x) ==> (?x. P x) /\ (?x. Q x)`) THEN SUBGOAL_THEN `!z. z IN path_image p ==> ?e. &0 < e /\ ball(z:complex,e) SUBSET s` MP_TAC THENL [ASM_MESON_TAC[OPEN_CONTAINS_BALL; SUBSET]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `ee:complex->real` THEN DISCH_THEN(LABEL_TAC "*") THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL o MATCH_MP COMPACT_PATH_IMAGE) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\z:complex. ball(z,ee z / &3)) (path_image p)`) THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; SUBSET] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `z:complex` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_ARITH `&0 < e / &3 <=> &0 < e`]; ALL_TAC] THEN REWRITE_TAC[path_image; GSYM IMAGE_o] THEN REWRITE_TAC[GSYM path_image] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; MESON[] `(?f s. (P s /\ f = g s) /\ Q f) <=> ?s. P s /\ Q(g s)`] THEN REWRITE_TAC[UNIONS_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:real^1->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; o_THM] THEN ASM_CASES_TAC `k:real^1->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[PATH_IMAGE_NONEMPTY]; DISCH_THEN(LABEL_TAC "+")] THEN SUBGOAL_THEN `!i:real^1. i IN k ==> &0 < ee((p i):complex)` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE]; ALL_TAC] THEN ABBREV_TAC `e = inf(IMAGE ((ee:complex->real) o (p:real^1->complex)) k)` THEN MP_TAC(ISPEC `IMAGE ((ee:complex->real) o (p:real^1->complex)) k` INF_FINITE) THEN MP_TAC(ISPECL [`IMAGE ((ee:complex->real) o (p:real^1->complex)) k`; `&0`] REAL_LT_INF_FINITE) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN EXISTS_TAC `e / &3` THEN MP_TAC(ISPECL [`p:real^1->complex`; `interval[vec 0:real^1,vec 1]`] COMPACT_UNIFORMLY_CONTINUOUS) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN ANTS_TAC THENL [ASM_MESON_TAC[path]; ALL_TAC] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^1->complex`; `h:real^1->complex`] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[]) [`!t. t IN interval[vec 0,vec 1] ==> norm((g:real^1->complex) t - p t) < e / &3 /\ norm((h:real^1->complex) t - p t) < e / &3`; `valid_path(g:real^1->complex)`; `valid_path(h:real^1->complex)`] THEN MATCH_MP_TAC(TAUT `q /\ (p1 \/ p2 ==> q ==> r) ==> (p1 ==> q /\ r) /\ (p2 ==> q /\ r)`) THEN CONJ_TAC THENL [CONJ_TAC THEN REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REMOVE_THEN "+" (MP_TAC o SPEC `(p:real^1->complex) t`) THEN ASM_SIMP_TAC[path_image; FUN_IN_IMAGE; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THENL [SUBGOAL_THEN `(g:real^1->complex) t IN ball(p(u:real^1),ee(p u))` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]]; SUBGOAL_THEN `(h:real^1->complex) t IN ball(p(u:real^1),ee(p u))` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]]] THEN REWRITE_TAC[IN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `dist(gu,gt) < eu / &3 ==> norm(ht - gt) < e / &3 /\ e <= eu ==> dist(gu,ht) < eu`)) THEN ASM_SIMP_TAC[]; DISCH_TAC THEN STRIP_TAC THEN X_GEN_TAC `f:complex->complex` THEN DISCH_TAC] THEN SUBGOAL_THEN `?ff. !z. z IN path_image p ==> &0 < ee z /\ ball(z,ee z) SUBSET s /\ !w. w IN ball(z,ee z) ==> (ff z has_complex_derivative f w) (at w)` MP_TAC THENL [REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM; RIGHT_EXISTS_AND_THM] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(z:complex,ee z)`; `{}:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CONVEX_BALL; FINITE_EMPTY] THEN SIMP_TAC[DIFF_EMPTY; INTERIOR_OPEN; OPEN_BALL] THEN SUBGOAL_THEN `f holomorphic_on ball(z,ee z)` MP_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[]; SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN SIMP_TAC[holomorphic_on; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; complex_differentiable]]; REMOVE_THEN "*" (K ALL_TAC) THEN DISCH_THEN(CHOOSE_THEN (LABEL_TAC "*"))] THEN MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n. n <= N ==> path_integral(subpath (vec 0) (&n / &N % vec 1) h) f - path_integral(subpath (vec 0) (&n / &N % vec 1) g) f = path_integral(linepath (g(&n / &N % vec 1),h(&n / &N % vec 1))) f - path_integral(linepath (g(vec 0),h(vec 0))) f` (MP_TAC o SPEC `N:num`) THENL [ALL_TAC; ASM_SIMP_TAC[LE_REFL; REAL_DIV_REFL; REAL_OF_NUM_EQ; VECTOR_MUL_LID] THEN FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[pathstart; pathfinish] THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBPATH_TRIVIAL; PATH_INTEGRAL_TRIVIAL] THEN CONV_TAC COMPLEX_RING] THEN INDUCT_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LZERO; VECTOR_MUL_LZERO] THEN FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_SUBPATH_REFL] THEN REWRITE_TAC[COMPLEX_SUB_REFL]; DISCH_TAC THEN FIRST_X_ASSUM(K ALL_TAC o check (is_disj o concl))] THEN REMOVE_THEN "+" (MP_TAC o SPEC `(p:real^1->complex)(&n / &N % vec 1)`) THEN REWRITE_TAC[IN_BALL] THEN ANTS_TAC THENL [REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`(ff:complex->complex->complex) (p(t:real^1))`; `f:complex->complex`; `subpath (&n / &N % vec 1) (&(SUC n) / &N % vec 1) (g:real^1->complex) ++ linepath(g (&(SUC n) / &N % vec 1),h(&(SUC n) / &N % vec 1)) ++ subpath (&(SUC n) / &N % vec 1) (&n / &N % vec 1) h ++ linepath(h (&n / &N % vec 1),g (&n / &N % vec 1))`; `ball((p:real^1->complex) t,ee(p t))`] CAUCHY_THEOREM_PRIMITIVE) THEN ASM_SIMP_TAC[VALID_PATH_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; VALID_PATH_LINEPATH; UNION_SUBSET] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ANTS_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `(p:real^1->complex) t`) THEN ANTS_TAC THENL [ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]; ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; CENTRE_IN_BALL]]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ q /\ (p ==> r ==> s) ==> (p /\ q ==> r) ==> s`) THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC VALID_PATH_SUBPATH THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [SUBGOAL_THEN `drop(&n / &N % vec 1) <= drop(&(SUC n) / &N % vec 1)` ASSUME_TAC THENL [ASM_SIMP_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_LE] THEN ARITH_TAC; ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; PATH_IMAGE_LINEPATH] THEN ONCE_REWRITE_TAC[GSYM REVERSEPATH_SUBPATH] THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; PATH_IMAGE_REVERSEPATH]] THEN MATCH_MP_TAC(TAUT `(p /\ r) /\ (p /\ r ==> q /\ s) ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN STRIP_TAC THEN REWRITE_TAC[IN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `!e pu. dist(pt,pn) < ee / &3 ==> dist(pn,pu) < e / &3 /\ e <= ee /\ norm(gu - pu) < e / &3 /\ norm(hu - pu) < e / &3 ==> dist(pt,gu) < ee /\ dist(pt,hu) < ee`)) THEN MAP_EVERY EXISTS_TAC [`e:real`; `(p:real^1->complex) u`] THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `(u:real^1) IN interval[vec 0,vec 1]` ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE]]; ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1; DROP_VEC; DROP_CMUL; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POS; REAL_LE_DIV; REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE; ARITH_RULE `SUC n <= N ==> n <= N`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `u <= s ==> n <= u /\ s - n < d ==> abs(n - u) < d`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `n <= SUC n`] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC n - n = 1`; REAL_MUL_LID]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN REWRITE_TAC[DROP_VEC; DROP_CMUL; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_POS; REAL_LE_DIV; REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC]; STRIP_TAC THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP PATH_INTEGRAL_UNIQUE th) THEN MP_TAC(MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE th)) THEN ASM_SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN_EQ; VALID_PATH_LINEPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; VALID_PATH_LINEPATH; PATH_INTEGRAL_JOIN] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl)) THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= N ==> n <= N`] THEN MATCH_MP_TAC(COMPLEX_RING `hn - he = hn' /\ gn + gd = gn' /\ hgn = --ghn ==> hn - gn = ghn - gh0 ==> gd + ghn' + he + hgn = Cx(&0) ==> hn' - gn' = ghn' - gh0`) THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[complex_sub; GSYM PATH_INTEGRAL_REVERSEPATH] THEN REWRITE_TAC[REVERSEPATH_SUBPATH] THEN MATCH_MP_TAC PATH_INTEGRAL_SUBPATH_COMBINE; MATCH_MP_TAC PATH_INTEGRAL_SUBPATH_COMBINE; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REVERSEPATH_LINEPATH] THEN MATCH_MP_TAC PATH_INTEGRAL_REVERSEPATH] THEN ASM_REWRITE_TAC[VALID_PATH_LINEPATH] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= N ==> n <= N`] THEN TRY(MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN NO_TAC) THEN ASM_MESON_TAC[PATH_INTEGRABLE_REVERSEPATH; VALID_PATH_LINEPATH; REVERSEPATH_LINEPATH]]);; (* ------------------------------------------------------------------------- *) (* Hence we can treat even non-rectifiable paths as having a "length" *) (* for bounds on analytic functions in open sets. *) (* ------------------------------------------------------------------------- *) let VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION = prove (`!p:real^1->complex. vector_polynomial_function p ==> valid_path p`, REPEAT STRIP_TAC THEN REWRITE_TAC[valid_path] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN REWRITE_TAC[VECTOR_DERIVATIVE_WORKS] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[vector_derivative] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION]);; let PATH_INTEGRAL_BOUND_EXISTS = prove (`!s g. open s /\ valid_path g /\ path_image g SUBSET s ==> ?L. &0 < L /\ !f B. f holomorphic_on s /\ (!z. z IN s ==> norm(f z) <= B) ==> norm(path_integral g f) <= L * B`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:complex->bool`; `g:real^1->complex`] PATH_INTEGRAL_NEARBY_ENDS) THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `g:real^1->complex`) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MP_TAC(ISPECL [`g:real^1->complex`; `d:real`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->complex`) THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `p':real^1->complex` STRIP_ASSUME_TAC o MATCH_MP HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION) THEN SUBGOAL_THEN `bounded(IMAGE (p':real^1->complex) (interval[vec 0,vec 1]))` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_INTERVAL] THEN ASM_MESON_TAC[CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; CONTINUOUS_AT_IMP_CONTINUOUS_ON]; REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `L:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `f path_integrable_on p /\ valid_path p` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]; ALL_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `p:real^1->complex`] PATH_INTEGRAL_INTEGRAL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral (interval[vec 0,vec 1]) (\x:real^1. lift(L * B)))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[INTEGRABLE_CONST; GSYM PATH_INTEGRABLE_ON] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[path_image; SUBSET; IN_IMAGE]; ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_UNIQUE_AT]]; REWRITE_TAC[INTEGRAL_CONST; CONTENT_UNIT_1; VECTOR_MUL_LID] THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Winding number. *) (* ------------------------------------------------------------------------- *) let winding_number = new_definition `winding_number(g,z) = @n. !e. &0 < e ==> ?p. valid_path p /\ ~(z IN path_image p) /\ pathstart p = pathstart g /\ pathfinish p = pathfinish g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ path_integral p (\w. Cx(&1) / (w - z)) = Cx(&2) * Cx(pi) * ii * n`;; let CX_2PII_NZ = prove (`~(Cx(&2) * Cx(pi) * ii = Cx(&0))`, SIMP_TAC[COMPLEX_ENTIRE; CX_PI_NZ; II_NZ; CX_INJ; REAL_OF_NUM_EQ; ARITH]);; let PATH_INTEGRABLE_INVERSEDIFF = prove (`!g z. valid_path g /\ ~(z IN path_image g) ==> (\w. Cx(&1) / (w - z)) path_integrable_on g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN EXISTS_TAC `(:complex) DELETE z` THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN; SET_RULE `s SUBSET (UNIV DELETE x) <=> ~(x IN s)`] THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_UNIV; IN_DELETE] THEN STRIP_TAC THEN W(MP_TAC o DISCH_ALL o COMPLEX_DIFF_CONV o snd o dest_exists o snd) THEN ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN MESON_TAC[]);; let WINDING_NUMBER = prove (`!g z e. path g /\ ~(z IN path_image g) /\ &0 < e ==> ?p. valid_path p /\ ~(z IN path_image p) /\ pathstart p = pathstart g /\ pathfinish p = pathfinish g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ path_integral p (\w. Cx(&1) / (w - z)) = Cx(&2) * Cx(pi) * ii * winding_number(g,z)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[winding_number] THEN CONV_TAC SELECT_CONV THEN MP_TAC(ISPECL [`(:complex) DELETE z`; `g:real^1->complex`] PATH_INTEGRAL_NEARBY_ENDS) THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `d / &2`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^1->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `Cx(&1) / (Cx(&2) * Cx pi * ii) * path_integral h (\w. Cx(&1) / (w - z))` THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `min d e / &2`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION; CX_2PII_NZ; COMPLEX_FIELD `~(a * b * c = Cx(&0)) ==> a * b * c * Cx(&1) / (a * b * c) * z = z`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`h:real^1->complex`; `p:real^1->complex`]) THEN ANTS_TAC THENL [ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN ASM_MESON_TAC[NORM_ARITH `norm(h - g) < d / &2 /\ norm(p - g) < min d e / &2 ==> norm(h - g) < d /\ norm(p - g) < d`]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `t SUBSET UNIV DELETE x <=> ~(x IN t)`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[NORM_SUB; REAL_ARITH `&0 < e /\ x < min d e / &2 ==> x < e`]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN] THEN REWRITE_TAC[IN_DELETE; IN_UNIV; GSYM complex_differentiable] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN ASM_REWRITE_TAC[COMPLEX_SUB_0]);; let WINDING_NUMBER_UNIQUE = prove (`!g z e n. path g /\ ~(z IN path_image g) /\ (!e. &0 < e ==> ?p. valid_path p /\ ~(z IN path_image p) /\ pathstart p = pathstart g /\ pathfinish p = pathfinish g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ path_integral p (\w. Cx(&1) / (w - z)) = Cx(&2) * Cx(pi) * ii * n) ==> winding_number(g,z) = n`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:complex) DELETE z`; `g:real^1->complex`] PATH_INTEGRAL_NEARBY_ENDS) THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] WINDING_NUMBER) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `q:real^1->complex`]) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\w. Cx(&1) / (w - z)`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN] THEN REWRITE_TAC[IN_DELETE; IN_UNIV; GSYM complex_differentiable] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN ASM_REWRITE_TAC[COMPLEX_SUB_0]; ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_RING]);; let WINDING_NUMBER_UNIQUE_LOOP = prove (`!g z e n. path g /\ ~(z IN path_image g) /\ pathfinish g = pathstart g /\ (!e. &0 < e ==> ?p. valid_path p /\ ~(z IN path_image p) /\ pathfinish p = pathstart p /\ (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ path_integral p (\w. Cx(&1) / (w - z)) = Cx(&2) * Cx(pi) * ii * n) ==> winding_number(g,z) = n`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:complex) DELETE z`; `g:real^1->complex`] PATH_INTEGRAL_NEARBY_LOOP) THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] WINDING_NUMBER) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `q:real^1->complex`]) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\w. Cx(&1) / (w - z)`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN] THEN REWRITE_TAC[IN_DELETE; IN_UNIV; GSYM complex_differentiable] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN ASM_REWRITE_TAC[COMPLEX_SUB_0]; ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_RING]);; let WINDING_NUMBER_VALID_PATH = prove (`!g z. valid_path g /\ ~(z IN path_image g) ==> winding_number(g,z) = Cx(&1) / (Cx(&2) * Cx(pi) * ii) * path_integral g (\w. Cx(&1) / (w - z))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `g:real^1->complex` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_FIELD);; let HAS_PATH_INTEGRAL_WINDING_NUMBER = prove (`!g z. valid_path g /\ ~(z IN path_image g) ==> ((\w. Cx(&1) / (w - z)) has_path_integral (Cx(&2) * Cx(pi) * ii * winding_number(g,z))) g`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH] THEN ASM_SIMP_TAC[CX_2PII_NZ; COMPLEX_FIELD `~(a * b * c = Cx(&0)) ==> a * b * c * Cx(&1) / (a * b * c) * z = z`] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]);; let WINDING_NUMBER_TRIVIAL = prove (`!a z. ~(z = a) ==> winding_number(linepath(a,a),z) = Cx(&0)`, SIMP_TAC[VALID_PATH_LINEPATH; PATH_INTEGRAL_TRIVIAL; COMPLEX_MUL_RZERO; WINDING_NUMBER_VALID_PATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; IN_SING]);; let WINDING_NUMBER_JOIN = prove (`!g1 g2 z. path g1 /\ path g2 /\ pathfinish g1 = pathstart g2 /\ ~(z IN path_image g1) /\ ~(z IN path_image g2) ==> winding_number(g1 ++ g2,z) = winding_number(g1,z) + winding_number(g2,z)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; IN_UNION] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`g2:real^1->complex`; `z:complex`; `e:real`] WINDING_NUMBER) THEN MP_TAC(ISPECL [`g1:real^1->complex`; `z:complex`; `e:real`] WINDING_NUMBER) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p1:real^1->complex` THEN STRIP_TAC THEN X_GEN_TAC `p2:real^1->complex` THEN STRIP_TAC THEN EXISTS_TAC `p1 ++ p2:real^1->complex` THEN ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; IN_UNION] THEN CONJ_TAC THENL [REWRITE_TAC[joinpaths; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC; W(MP_TAC o PART_MATCH (lhs o rand) PATH_INTEGRAL_JOIN o lhand o snd) THEN ASM_REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_INVERSEDIFF THEN ASM_REWRITE_TAC[]]);; let WINDING_NUMBER_REVERSEPATH = prove (`!g z. path g /\ ~(z IN path_image g) ==> winding_number(reversepath g,z) = --(winding_number(g,z))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `e:real`] WINDING_NUMBER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `reversepath p:real^1->complex` THEN ASM_SIMP_TAC[VALID_PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_INTEGRAL_REVERSEPATH; PATH_INTEGRABLE_INVERSEDIFF] THEN REWRITE_TAC[COMPLEX_MUL_RNEG; reversepath; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB] THEN ASM_REAL_ARITH_TAC);; let WINDING_NUMBER_SHIFTPATH = prove (`!g a z. path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) /\ a IN interval[vec 0,vec 1] ==> winding_number(shiftpath a g,z) = winding_number(g,z)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE_LOOP THEN ASM_SIMP_TAC[PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `e:real`] WINDING_NUMBER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `shiftpath a p:real^1->complex` THEN ASM_SIMP_TAC[VALID_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; PATH_INTEGRAL_SHIFTPATH; PATH_INTEGRABLE_INVERSEDIFF] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH] THEN SIMP_TAC[COMPLEX_MUL_RNEG; shiftpath; IN_INTERVAL_1; DROP_ADD; DROP_VEC] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_ADD] THEN ASM_REAL_ARITH_TAC);; let WINDING_NUMBER_SPLIT_LINEPATH = prove (`!a b c z. c IN segment[a,b] /\ ~(z IN segment[a,b]) ==> winding_number(linepath(a,b),z) = winding_number(linepath(a,c),z) + winding_number(linepath(c,b),z)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~((z:complex) IN segment[a,c]) /\ ~(z IN segment[c,b])` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(z IN s) ==> t SUBSET s ==> ~(z IN t)`)) THEN ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; PATH_IMAGE_LINEPATH; VALID_PATH_LINEPATH] THEN REWRITE_TAC[GSYM COMPLEX_ADD_LDISTRIB] THEN AP_TERM_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_SPLIT_LINEPATH THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID] THEN ASM_MESON_TAC[COMPLEX_SUB_0]]);; let WINDING_NUMBER_EQUAL = prove (`!p q z. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) ==> winding_number(p,z) = winding_number(q,z)`, REPEAT STRIP_TAC THEN SIMP_TAC[winding_number; PATH_INTEGRAL_INTEGRAL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `W:complex` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `g:real^1->complex` THEN ASM_SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]);; let WINDING_NUMBER_OFFSET = prove (`!p z. winding_number(p,z) = winding_number((\w. p w - z),Cx(&0))`, REPEAT GEN_TAC THEN REWRITE_TAC[winding_number; PATH_INTEGRAL_INTEGRAL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `W:complex` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[path_image; valid_path; pathstart; pathfinish] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->complex` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `\t. (g:real^1->complex) t - z`; EXISTS_TAC `\t. (g:real^1->complex) t + z`] THEN ASM_REWRITE_TAC[COMPLEX_RING `(p - z) - (g - z):complex = p - g`; COMPLEX_RING `p - (g + z):complex = p - z - g`; COMPLEX_RING `(p - z) + z:complex = p`; COMPLEX_SUB_RZERO] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN ASM_SIMP_TAC[PIECEWISE_DIFFERENTIABLE_ADD; PIECEWISE_DIFFERENTIABLE_SUB; DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE; DIFFERENTIABLE_ON_CONST; IN_IMAGE] THEN ASM_REWRITE_TAC[COMPLEX_RING `Cx(&0) = w - z <=> z = w`; COMPLEX_RING `z = w + z <=> Cx(&0) = w`] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_RING `(w + z) - z = w - Cx(&0)`] THEN AP_TERM_TAC THEN REWRITE_TAC[vector_derivative; has_vector_derivative; HAS_DERIVATIVE_AT; COMPLEX_RING `(x - z) - (w - z):complex = x - w`; COMPLEX_RING `(x + z) - (w + z):complex = x - w`]);; (* ------------------------------------------------------------------------- *) (* A combined theorem deducing several things piecewise. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_JOIN_POS_COMBINED = prove (`!g1 g2 z. (valid_path g1 /\ ~(z IN path_image g1) /\ &0 < Re(winding_number(g1,z))) /\ (valid_path g2 /\ ~(z IN path_image g2) /\ &0 < Re(winding_number(g2,z))) /\ pathfinish g1 = pathstart g2 ==> valid_path(g1 ++ g2) /\ ~(z IN path_image(g1 ++ g2)) /\ &0 < Re(winding_number(g1 ++ g2,z))`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[VALID_PATH_JOIN] THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; VALID_PATH_IMP_PATH; IN_UNION] THEN ASM_SIMP_TAC[WINDING_NUMBER_JOIN; VALID_PATH_IMP_PATH; RE_ADD] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Useful sufficient conditions for the winding number to be positive etc. *) (* ------------------------------------------------------------------------- *) let RE_WINDING_NUMBER = prove (`!g z. valid_path g /\ ~(z IN path_image g) ==> Re(winding_number(g,z)) = Im(path_integral g (\w. Cx(&1) / (w - z))) / (&2 * pi)`, SIMP_TAC[WINDING_NUMBER_VALID_PATH; complex_div; COMPLEX_MUL_LID] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN REWRITE_TAC[COMPLEX_INV_MUL; GSYM CX_INV; COMPLEX_INV_II] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; RE_NEG] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; RE_MUL_CX; RE_MUL_II] THEN MP_TAC PI_POS THEN CONV_TAC REAL_FIELD);; let WINDING_NUMBER_POS_LE = prove (`!g z. valid_path g /\ ~(z IN path_image g) /\ (!x. x IN interval(vec 0,vec 1) ==> &0 <= Im(vector_derivative g (at x) * cnj(g x - z))) ==> &0 <= Re(winding_number(g,z))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RE_WINDING_NUMBER] THEN MATCH_MP_TAC REAL_LE_DIV THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; PI_POS; REAL_LT_IMP_LE; IM_DEF] THEN MATCH_MP_TAC(INST_TYPE [`:1`,`:M`; `:2`,`:N`] HAS_INTEGRAL_COMPONENT_POS) THEN MAP_EVERY EXISTS_TAC [`\x:real^1. if x IN interval(vec 0,vec 1) then Cx(&1) / (g x - z) * vector_derivative g (at x) else Cx(&0)`; `interval[vec 0:real^1,vec 1]`] THEN REWRITE_TAC[ARITH; DIMINDEX_2] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN EXISTS_TAC `\x:real^1. Cx(&1) / (g x - z) * vector_derivative g (at x)` THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM HAS_PATH_INTEGRAL] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM IM_DEF; IM_CX; REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN REWRITE_TAC[complex_inv; complex_inv; complex_mul; RE; IM; cnj] THEN REWRITE_TAC[real_div; REAL_RING `(a * x) * b + (--c * x) * d:real = x * (a * b - c * d)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN SIMP_TAC[REAL_POW_2; REAL_LE_INV_EQ; REAL_LE_ADD; REAL_LE_SQUARE] THEN ASM_REAL_ARITH_TAC);; let WINDING_NUMBER_POS_LT_LEMMA = prove (`!g z e. valid_path g /\ ~(z IN path_image g) /\ &0 < e /\ (!x. x IN interval(vec 0,vec 1) ==> e <= Im(vector_derivative g (at x) / (g x - z))) ==> &0 < Re(winding_number(g,z))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RE_WINDING_NUMBER] THEN MATCH_MP_TAC REAL_LT_DIV THEN SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; PI_POS] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `Im(ii * Cx e)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[COMPLEX_MUL_LNEG; IM_MUL_II; IM_NEG; RE_CX]; ALL_TAC] THEN REWRITE_TAC[IM_DEF] THEN MATCH_MP_TAC(ISPECL [`\x:real^1. ii * Cx e`; `\x:real^1. if x IN interval(vec 0,vec 1) then Cx(&1) / (g x - z) * vector_derivative g (at x) else ii * Cx e`; `interval[vec 0:real^1,vec 1]`; `ii * Cx e`; `path_integral g (\w. Cx(&1) / (w - z))`; `2`] HAS_INTEGRAL_COMPONENT_LE) THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN ONCE_REWRITE_TAC[GSYM CONTENT_UNIT_1] THEN REWRITE_TAC[HAS_INTEGRAL_CONST]; MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN EXISTS_TAC `\x:real^1. Cx(&1) / (g x - z) * vector_derivative g (at x)` THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM HAS_PATH_INTEGRAL] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM IM_DEF; IM_CX; REAL_LE_REFL] THEN REWRITE_TAC[IM_MUL_II; RE_CX] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LID; COMPLEX_MUL_SYM]]);; let WINDING_NUMBER_POS_LT = prove (`!g z e. valid_path g /\ ~(z IN path_image g) /\ &0 < e /\ (!x. x IN interval(vec 0,vec 1) ==> e <= Im(vector_derivative g (at x) * cnj(g x - z))) ==> &0 < Re(winding_number(g,z))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `bounded (IMAGE (\w. w - z) (path_image g))` MP_TAC THENL [REWRITE_TAC[path_image; GSYM IMAGE_o] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON THEN ASM_REWRITE_TAC[GSYM valid_path]; ALL_TAC] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC WINDING_NUMBER_POS_LT_LEMMA THEN EXISTS_TAC `e:real / B pow 2` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN REWRITE_TAC[real_div; complex_div; GSYM CX_INV; GSYM CX_POW] THEN REWRITE_TAC[IM_MUL_CX] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_POW_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN UNDISCH_TAC `~((z:complex) IN path_image g)`; MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN REWRITE_TAC[path_image; IN_IMAGE] THEN ASM_MESON_TAC[SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]);; (* ------------------------------------------------------------------------- *) (* The winding number is an integer (proof from Ahlfors's book). *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_AHLFORS_LEMMA = prove (`!g a b. g piecewise_differentiable_on interval [a,b] /\ drop a <= drop b /\ (!x. x IN interval [a,b] ==> ~(g x = z)) ==> (\x. vector_derivative g (at x within interval[a,b]) / (g(x) - z)) integrable_on interval[a,b] /\ cexp(--(integral (interval[a,b]) (\x. vector_derivative g (at x within interval[a,b]) / (g(x) - z)))) * (g(b) - z) = g(a) - z`, let lemma = prove (`!f g g' s x z. (g has_vector_derivative g') (at x within s) /\ (f has_vector_derivative (g' / (g x - z))) (at x within s) /\ ~(g x = z) ==> ((\x. cexp(--f x) * (g x - z)) has_vector_derivative Cx(&0)) (at x within s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `cexp(--f x) * (g' - Cx(&0)) + (cexp(--f x) * --(g' / ((g:real^1->complex) x - z))) * (g x - z) = Cx(&0)` (SUBST1_TAC o SYM) THENL [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN MATCH_MP_TAC(ISPEC `( * ):complex->complex->complex` HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN) THEN REWRITE_TAC[BILINEAR_COMPLEX_MUL; GSYM COMPLEX_VEC_0] THEN ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_SUB; ETA_AX; HAS_VECTOR_DERIVATIVE_CONST] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[has_vector_derivative] THEN SUBGOAL_THEN `!x y. (\z. drop z % (x * y :complex)) = (\w. x * w) o (\z. drop z % y)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; COMPLEX_CMUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN REWRITE_TAC[GSYM has_complex_derivative; GSYM has_vector_derivative] THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_CEXP; HAS_COMPLEX_DERIVATIVE_AT_WITHIN] THEN ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_NEG]) in REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!w. ~(w = z) ==> ?h. !y. norm(y - w) < norm(w - z) ==> (h has_complex_derivative inv(y - z)) (at y)` (LABEL_TAC "P") THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\w:complex. inv(w - z)`; `ball(w:complex,norm(w - z))`; `{}:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; INTERIOR_OPEN] THEN REWRITE_TAC[CONVEX_BALL; FINITE_RULES; DIFF_EMPTY] THEN ANTS_TAC THENL [SUBGOAL_THEN `(\w. inv(w - z)) holomorphic_on ball(w:complex,norm(w - z))` (fun th -> MESON_TAC[HOLOMORPHIC_ON_OPEN; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; OPEN_BALL; complex_differentiable; th]) THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; IN_BALL] THEN X_GEN_TAC `u:complex` THEN DISCH_TAC THEN EXISTS_TAC `--Cx(&1) / (u - z) pow 2` THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_SUB_0] THEN ASM_MESON_TAC[REAL_LT_REFL; dist]; ALL_TAC] THEN REWRITE_TAC[IN_BALL; dist] THEN MESON_TAC[NORM_SUB]; ALL_TAC] THEN SUBGOAL_THEN `!t. t IN interval[a,b] ==> (\x. vector_derivative g (at x within interval[a,b]) / (g(x) - z)) integrable_on interval[a,t] /\ cexp(--(integral (interval[a,t]) (\x. vector_derivative g (at x within interval[a,b]) / (g(x) - z)))) * (g(t) - z) = g(a) - z` (fun th -> MATCH_MP_TAC th THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]) THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_INTERVAL_1]] THEN REWRITE_TAC[integrable_on; complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN REWRITE_TAC[GSYM integrable_on] THEN MATCH_MP_TAC PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY THEN EXISTS_TAC `(:complex) DELETE z` THEN ASM_SIMP_TAC[IN_DELETE; IN_UNIV; DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN EXISTS_TAC `norm(w - z:complex)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [piecewise_differentiable_on]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_DIFF; FINITE_IMP_COUNTABLE] THEN X_GEN_TAC `k:real^1->bool` THEN STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_INTERVAL; INTEGRAL_REFL] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_NEG_0; CEXP_0; COMPLEX_MUL_LID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; ETA_AX; PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC CONTINUOUS_ON_NEG THEN MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN MP_TAC(ISPECL [`\w:complex. inv(w - z)`; `ball((g:real^1->complex) t,dist(g t,z))`; `{}:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; INTERIOR_OPEN] THEN REWRITE_TAC[CONVEX_BALL; FINITE_RULES; DIFF_EMPTY] THEN ANTS_TAC THENL [SUBGOAL_THEN `(\w. inv(w - z)) holomorphic_on ball(g(t:real^1),dist(g t,z))` (fun th -> MESON_TAC[HOLOMORPHIC_ON_OPEN; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; OPEN_BALL; complex_differentiable; th]) THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; IN_BALL] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN EXISTS_TAC `--Cx(&1) / (w - z) pow 2` THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_SUB_0] THEN ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN REWRITE_TAC[IN_BALL; dist] THEN DISCH_THEN(X_CHOOSE_TAC `h:complex->complex`) THEN SUBGOAL_THEN `(\h. Cx(&0)) = (\h. drop h % Cx(&0))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; GSYM COMPLEX_VEC_0; VECTOR_MUL_RZERO]; ALL_TAC] THEN REWRITE_TAC[GSYM has_vector_derivative] THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `vector_derivative g (at t within interval[a,b]):complex` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN ASM_MESON_TAC[DIFFERENTIABLE_AT_WITHIN]; ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[has_vector_derivative] THEN MATCH_MP_TAC HAS_DERIVATIVE_TRANSFORM_WITHIN THEN ASM_REWRITE_TAC[GSYM has_vector_derivative] THEN EXISTS_TAC `\u. integral (interval [a,t]) (\x. vector_derivative g (at x within interval [a,b]) / ((g:real^1->complex) x - z)) + (h(g(u)) - h(g(t)))` THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; CONJ_ASSOC] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[COMPLEX_RING `a + (b - c) = b + (a - c):complex`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN REWRITE_TAC[has_vector_derivative] THEN SUBGOAL_THEN `!x y. (\h. drop h % x / y) = (\x. inv(y) * x) o (\h. drop h % x)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; COMPLEX_CMUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN REWRITE_TAC[GSYM has_complex_derivative; GSYM has_vector_derivative] THEN REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIFFERENTIABLE_AT_WITHIN]; ALL_TAC] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; COMPLEX_NORM_NZ] THEN ASM_SIMP_TAC[COMPLEX_SUB_0]] THEN SUBGOAL_THEN `?d. &0 < d /\ !y:real^1. y IN interval[a,b] /\ dist(y,t) < d ==> dist(g y:complex,g t) < norm(g t - z) /\ ~(y IN k)` MP_TAC THENL [SUBGOAL_THEN `(g:real^1->complex) continuous (at t within interval[a,b])` MP_TAC THENL [ASM_MESON_TAC[PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; ALL_TAC] THEN REWRITE_TAC[continuous_within] THEN DISCH_THEN(MP_TAC o SPEC `norm((g:real^1->complex) t - z)`) THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC o SPEC `t:real^1` o MATCH_MP FINITE_SET_AVOID) THEN EXISTS_TAC `min d1 d2` THEN ASM_SIMP_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[DIST_SYM; REAL_NOT_LE]; ALL_TAC] THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:real^1` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `drop t <= drop u \/ drop u <= drop t`) THENL [SUBGOAL_THEN `integral (interval [a,u]) (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) = integral (interval [a,t]) (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) + integral (interval [t,u]) (\x. vector_derivative g (at x within interval [a,b]) / (g x - z))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_MESON_TAC[IN_INTERVAL_1]; ALL_TAC] THEN SIMP_TAC[COMPLEX_RING `a + x = a + y <=> y:complex = x`]; SUBGOAL_THEN `integral (interval [a,t]) (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) = integral (interval [a,u]) (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) + integral (interval [u,t]) (\x. vector_derivative g (at x within interval [a,b]) / (g x - z))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_MESON_TAC[IN_INTERVAL_1]; ALL_TAC] THEN SIMP_TAC[COMPLEX_RING `(a + x) + (w - z) = a <=> x:complex = z - w`]] THEN (MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[has_vector_derivative; COMPLEX_CMUL] THEN SUBGOAL_THEN `!x y. (\h. Cx(drop h) * x / y) = (\x. inv(y) * x) o (\h. drop h % x)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; COMPLEX_CMUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN REWRITE_TAC[GSYM has_complex_derivative; GSYM has_vector_derivative] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (fun t -> not(is_forall (concl t))))) THEN REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB] THEN REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; REAL_LE_REFL] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM dist] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; REAL_LE_TRANS]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (fun t -> not(is_forall (concl t))))) THEN REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB] THEN REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; REAL_LE_REFL] THEN REAL_ARITH_TAC));; let WINDING_NUMBER_AHLFORS = prove (`!g z a b. g piecewise_differentiable_on interval [a,b] /\ drop a <= drop b /\ (!x. x IN interval [a,b] ==> ~(g x = z)) ==> (\x. vector_derivative g (at x) / (g(x) - z)) integrable_on interval[a,b] /\ cexp(--(integral (interval[a,b]) (\x. vector_derivative g (at x) / (g(x) - z)))) * (g(b) - z) = g(a) - z`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[integrable_on; integral] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM](GSYM complex_div)] THEN REWRITE_TAC[GSYM integral; GSYM integrable_on] THEN MATCH_MP_TAC WINDING_NUMBER_AHLFORS_LEMMA THEN ASM_REWRITE_TAC[]);; let WINDING_NUMBER_AHLFORS_FULL = prove (`!p z. path p /\ ~(z IN path_image p) ==> pathfinish p - z = cexp(Cx(&2) * Cx pi * ii * winding_number(p,z)) * (pathstart p - z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:real^1->complex`; `z:complex`; `&1`] WINDING_NUMBER) THEN ASM_REWRITE_TAC[REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->complex` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN RULE_ASSUM_TAC(REWRITE_RULE[valid_path; path_image; IN_IMAGE; NOT_EXISTS_THM]) THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `vec 0:real^1`; `vec 1:real^1`] WINDING_NUMBER_AHLFORS) THEN ASM_SIMP_TAC[DROP_VEC; REAL_POS; pathstart; pathfinish] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2)] THEN REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_MUL_ASSOC; PATH_INTEGRAL_INTEGRAL] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `Cx(&1) / z * w = w / z`] THEN REWRITE_TAC[GSYM complex_sub; COMPLEX_SUB_REFL; CEXP_0; COMPLEX_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* State in terms of complex integers. Note the useful equality version. *) (* ------------------------------------------------------------------------- *) let complex_integer = new_definition `complex_integer z <=> integer(Re z) /\ Im z = &0`;; let COMPLEX_INTEGER = prove (`complex_integer z <=> ?n. integer n /\ z = Cx n`, REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX; complex_integer] THEN MESON_TAC[]);; let INTEGER_WINDING_NUMBER_EQ = prove (`!g z. path g /\ ~(z IN path_image g) ==> (complex_integer(winding_number(g,z)) <=> pathfinish g = pathstart g)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `e:real`] WINDING_NUMBER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `complex_integer(winding_number(p,z)) <=> pathfinish p = pathstart p` MP_TAC THENL [UNDISCH_THEN `path_integral p (\w. Cx(&1) / (w - z)) = Cx(&2) * Cx pi * ii * winding_number (g,z)` (K ALL_TAC) THEN ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH]; ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; CX_2PII_NZ; COMPLEX_FIELD `~(a * b * c = Cx(&0)) ==> Cx(&1) / (a * b * c) * a * b * c * z = z`]] THEN UNDISCH_THEN `pathstart p:complex = pathstart g` (SUBST_ALL_TAC o SYM) THEN UNDISCH_THEN `pathfinish p:complex = pathfinish g` (SUBST_ALL_TAC o SYM) THEN RULE_ASSUM_TAC(REWRITE_RULE[valid_path; path_image]) THEN REWRITE_TAC[pathfinish; pathstart] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `cexp(path_integral p (\w. Cx(&1) / (w - z))) = Cx(&1)` THEN CONJ_TAC THENL [REWRITE_TAC[CEXP_EQ_1; complex_integer] THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID; COMPLEX_INV_MUL] THEN SIMP_TAC[GSYM CX_INV; GSYM CX_MUL; COMPLEX_MUL_ASSOC; COMPLEX_INV_II] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; RE_MUL_II; IM_MUL_II; RE_NEG; IM_NEG] THEN REWRITE_TAC[REAL_NEGNEG; REAL_ENTIRE; REAL_INV_EQ_0; REAL_NEG_EQ_0] THEN SIMP_TAC[REAL_OF_NUM_EQ; ARITH; REAL_LT_IMP_NZ; PI_POS] THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < p ==> (x = &2 * n * p <=> (inv(&2) * inv(p)) * x = n)`] THEN MESON_TAC[]; MP_TAC(ISPECL [`p:real^1->complex`; `z:complex`; `vec 0:real^1`; `vec 1:real^1`] WINDING_NUMBER_AHLFORS) THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN REWRITE_TAC[integral; GSYM HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN REWRITE_TAC[GSYM has_path_integral; GSYM path_integral] THEN REWRITE_TAC[CEXP_NEG; COMPLEX_MUL_RID] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(i = Cx(&0)) /\ ~(g0 = z) ==> (inv i * (g1 - z) = g0 - z ==> (i = Cx(&1) <=> g1 = g0))`) THEN REWRITE_TAC[CEXP_NZ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_IMAGE]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN MESON_TAC[REAL_POS; DROP_VEC]]);; let INTEGER_WINDING_NUMBER = prove (`!g z. path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) ==> complex_integer(winding_number(g,z))`, MESON_TAC[INTEGER_WINDING_NUMBER_EQ]);; (* ------------------------------------------------------------------------- *) (* For |WN| >= 1 the path must contain points in every direction. *) (* We can thus bound the WN of a path that doesn't meet some "cut". *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_POS_MEETS = prove (`!g z. valid_path g /\ ~(z IN path_image g) /\ Re(winding_number(g,z)) >= &1 ==> !w. ~(w = z) ==> ?a. &0 < a /\ z + (Cx a * (w - z)) IN path_image g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!t. t IN interval[vec 0,vec 1] ==> ~((g:real^1->complex) t = z)` ASSUME_TAC THENL [UNDISCH_TAC `~((z:complex) IN path_image g)` THEN REWRITE_TAC[path_image; IN_IMAGE] THEN MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `r:complex = (w - z) / (pathstart g - z)` THEN STRIP_ASSUME_TAC(GSYM(SPEC `r:complex` ARG)) THEN SUBGOAL_THEN `?t. t IN interval[vec 0,vec 1] /\ Im(integral (interval[vec 0,t]) (\x. vector_derivative g (at x) / (g x - z))) = Arg r` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IM_DEF] THEN MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN ASM_SIMP_TAC[DIMINDEX_2; DROP_VEC; ARITH; INTEGRAL_REFL; REAL_POS; VEC_COMPONENT] THEN CONJ_TAC THENL [MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN REWRITE_TAC[GSYM PATH_INTEGRABLE_ON] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv z = Cx(&1) / z`] THEN MATCH_MP_TAC PATH_INTEGRABLE_INVERSEDIFF THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * pi` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN UNDISCH_TAC `Re(winding_number (g,z)) >= &1` THEN ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; GSYM IM_DEF] THEN REWRITE_TAC[path_integral; HAS_PATH_INTEGRAL; GSYM integral] THEN SUBST1_TAC(COMPLEX_FIELD `ii = --inv ii`) THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_NEG] THEN REWRITE_TAC[GSYM CX_INV; GSYM CX_MUL; COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[RE_MUL_CX; RE; COMPLEX_MUL_RNEG; RE_NEG; COMPLEX_MUL_LNEG; COMPLEX_INV_INV; GSYM COMPLEX_MUL_ASSOC; RE_MUL_II] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_NEGNEG] THEN SIMP_TAC[REAL_ARITH `((&1 * inv(&2)) * p) * x >= &1 <=> &2 <= x * p`] THEN SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; PI_POS] THEN REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_AC]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `vec 0:real^1`; `t:real^1`] WINDING_NUMBER_AHLFORS) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN RULE_ASSUM_TAC(REWRITE_RULE[valid_path]) THEN ASM_REWRITE_TAC[]; ALL_TAC; GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th)] THEN UNDISCH_TAC `(t:real^1) IN interval[vec 0,vec 1]` THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[CEXP_NEG] THEN ABBREV_TAC `i = integral (interval [vec 0,t]) (\x. vector_derivative g (at x) / (g x - z))` THEN SUBST1_TAC(SPEC `i:complex` COMPLEX_EXPAND) THEN ASM_REWRITE_TAC[CEXP_ADD; COMPLEX_INV_MUL; GSYM CX_EXP] THEN UNDISCH_TAC `Cx(norm r) * cexp(ii * Cx(Arg r)) = r` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_FIELD `x * e = r /\ (y * inv e) * w = z ==> ~(e = Cx(&0)) ==> x * y * w = r * z`)) THEN REWRITE_TAC[CEXP_NZ] THEN EXPAND_TAC "r" THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [pathstart] THEN SUBGOAL_THEN `~((g:real^1->complex)(vec 0) = z)` ASSUME_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS]; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_SUB_0; GSYM CX_INV; GSYM CX_MUL; COMPLEX_MUL_ASSOC; GSYM real_div] THEN DISCH_TAC THEN EXISTS_TAC `exp(Re i) / norm(r:complex)` THEN SUBGOAL_THEN `~(r = Cx(&0))` ASSUME_TAC THENL [EXPAND_TAC "r" THEN MATCH_MP_TAC(COMPLEX_FIELD `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> ~(x / y = Cx(&0))`) THEN ASM_REWRITE_TAC[COMPLEX_SUB_0; pathstart]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_EXP_POS_LT; COMPLEX_NORM_NZ] THEN REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `t:real^1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(COMPLEX_FIELD `inv i * (gt - z) = wz /\ ~(i = Cx(&0)) ==> z + i * wz = gt`) THEN ASM_REWRITE_TAC[GSYM CX_INV; REAL_INV_DIV; CX_INJ] THEN MATCH_MP_TAC(REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> ~(x / y = &0)`) THEN ASM_REWRITE_TAC[REAL_EXP_NZ; COMPLEX_NORM_ZERO]);; let WINDING_NUMBER_BIG_MEETS = prove (`!g z. valid_path g /\ ~(z IN path_image g) /\ abs(Re(winding_number(g,z))) >= &1 ==> !w. ~(w = z) ==> ?a. &0 < a /\ z + (Cx a * (w - z)) IN path_image g`, REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[WINDING_NUMBER_POS_MEETS] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[GSYM RE_NEG; VALID_PATH_IMP_PATH; GSYM WINDING_NUMBER_REVERSEPATH] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN MATCH_MP_TAC WINDING_NUMBER_POS_MEETS THEN ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH; VALID_PATH_REVERSEPATH]);; let WINDING_NUMBER_LT_1 = prove (`!g w z. valid_path g /\ ~(z IN path_image g) /\ ~(w = z) /\ (!a. &0 < a ==> ~(z + (Cx a * (w - z)) IN path_image g)) ==> Re(winding_number(g,z)) < &1`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE; GSYM real_ge] THEN ASM_MESON_TAC[WINDING_NUMBER_POS_MEETS]);; (* ------------------------------------------------------------------------- *) (* One way of proving that WN=1 for a loop. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_EQ_1 = prove (`!g z. valid_path g /\ ~(z IN path_image g) /\ pathfinish g = pathstart g /\ &0 < Re(winding_number(g,z)) /\ Re(winding_number(g,z)) < &2 ==> winding_number(g,z) = Cx(&1)`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `complex_integer(winding_number(g,z))` MP_TAC THENL [ASM_SIMP_TAC[INTEGER_WINDING_NUMBER; VALID_PATH_IMP_PATH]; ALL_TAC] THEN SIMP_TAC[complex_integer; COMPLEX_EQ; RE_CX; IM_CX] THEN SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Continuity of winding number and invariance on connected sets. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_AT_WINDING_NUMBER = prove (`!g z. path g /\ ~(z IN path_image g) ==> (\w. winding_number(g,w)) continuous (at z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_CBALL) THEN ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_CBALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(:complex) DIFF cball(z,e / &2)`; `g:real^1->complex`] PATH_INTEGRAL_NEARBY_ENDS) THEN ASM_SIMP_TAC[OPEN_DIFF; OPEN_UNIV; CLOSED_CBALL] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL; SUBSET; IN_UNIV] THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `min d e / &2`] WINDING_NUMBER) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\w. winding_number(p,w)`; `min d e / &2`] THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[path_image; IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^1->complex) t`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`) THEN ASM_SIMP_TAC[path_image; FUN_IN_IMAGE] THEN UNDISCH_TAC `dist (w:complex,z) < min d e / &2` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; DISCH_TAC THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `w:complex`; `min k (min d e) / &2`] WINDING_NUMBER) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN ANTS_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `p:real^1->complex` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `q:real^1->complex`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS)] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; IN_DELETE; IN_UNIV; COMPLEX_SUB_0] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[IN_DIFF] THEN REWRITE_TAC[IN_UNIV; IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC]; UNDISCH_TAC `~((z:complex) IN path_image p)` THEN UNDISCH_TAC `valid_path(p:real^1->complex)` THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`z:complex`,`z:complex`) THEN SPEC_TAC(`p:real^1->complex`,`g:real^1->complex`)] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(:complex) DIFF cball(z, &3 / &4 * d)`; `g:real^1->complex`] PATH_INTEGRAL_BOUND_EXISTS) THEN ASM_REWRITE_TAC[GSYM closed; CLOSED_CBALL; SUBSET; IN_DIFF; IN_CBALL; IN_UNIV; REAL_NOT_LE] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ARITH `&0 < d /\ ~(&3 / &4 * d < x) ==> x < d`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `L:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[continuous_at] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `min (d / &4) (e / &2 * d pow 2 / L / &4)` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_POW_LT; REAL_LT_DIV; REAL_LT_MUL; REAL_HALF; REAL_ARITH `&0 < x / &4 <=> &0 < x`] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `~((w:complex) IN path_image g)` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[dist; WINDING_NUMBER_VALID_PATH; GSYM COMPLEX_SUB_LDISTRIB] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_NUM; COMPLEX_NORM_II; REAL_ABS_PI] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_RID] THEN MATCH_MP_TAC(REAL_ARITH `inv p * x <= &1 * x /\ x < e ==> inv p * x < e`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!d. &0 < e /\ d = e / &2 /\ x <= d ==> x < e`) THEN EXISTS_TAC `L * (e / &2 * d pow 2 / L / &4) * inv(d / &2) pow 2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY UNDISCH_TAC [`&0 < d`; `&0 < L`] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN SUBGOAL_THEN `path_integral g (\x. Cx(&1) / (x - w)) - path_integral g (\x. Cx(&1) / (x - z)) = path_integral g (\x. Cx(&1) / (x - w) - Cx(&1) / (x - z))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_SUB THEN CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_INVERSEDIFF THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; GSYM closed; CLOSED_CBALL] THEN REWRITE_TAC[IN_UNIV; IN_DIFF; IN_CBALL; REAL_NOT_LE; AND_FORALL_THM] THEN X_GEN_TAC `x:complex` THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN DISCH_TAC THEN REWRITE_TAC[GSYM complex_differentiable] THEN SUBGOAL_THEN `~(x:complex = w) /\ ~(x = z)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN ASM_SIMP_TAC[COMPLEX_SUB_0; COMPLEX_DIFFERENTIABLE_SUB; COMPLEX_DIFFERENTIABLE_ID; COMPLEX_DIFFERENTIABLE_CONST]; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(x = w) /\ ~(x = z) ==> Cx(&1) / (x - w) - Cx(&1) / (x - z) = (w - z) * inv((x - w) * (x - z))`] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; GSYM dist; REAL_LT_IMP_LE] THEN REWRITE_TAC[COMPLEX_NORM_INV; REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_POW_2; REAL_LT_MUL; REAL_HALF; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_IMP_LE] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN CONV_TAC NORM_ARITH);; let CONTINUOUS_ON_WINDING_NUMBER = prove (`!g. path g ==> (\w. winding_number(g,w)) continuous_on ((:complex) DIFF path_image g)`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; GSYM closed; OPEN_UNIV; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN SIMP_TAC[IN_DIFF; IN_UNIV; CONTINUOUS_AT_WINDING_NUMBER]);; let WINDING_NUMBER_CONSTANT = prove (`!s g. path g /\ pathfinish g = pathstart g /\ connected s /\ s INTER path_image g = {} ==> ?k. !z. z IN s ==> winding_number(g,z) = k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:complex) DIFF path_image g` THEN ASM_SIMP_TAC[CONTINUOUS_ON_WINDING_NUMBER] THEN ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `w:complex` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `complex_integer(winding_number(g,w)) /\ complex_integer(winding_number(g,z))` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC INTEGER_WINDING_NUMBER THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[COMPLEX_INTEGER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[GSYM CX_SUB; CX_INJ; COMPLEX_NORM_CX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN ASM_SIMP_TAC[REAL_SUB_0; INTEGER_CLOSED]);; let WINDING_NUMBER_EQ = prove (`!g s w z. path g /\ pathfinish g = pathstart g /\ w IN s /\ z IN s /\ connected s /\ s INTER path_image g = {} ==> winding_number(g,w) = winding_number(g,z)`, MESON_TAC[WINDING_NUMBER_CONSTANT]);; let OPEN_WINDING_NUMBER_LEVELSETS = prove (`!g k. path g /\ pathfinish g = pathstart g ==> open {z | ~(z IN path_image g) /\ winding_number(g,z) = k}`, REPEAT STRIP_TAC THEN REWRITE_TAC[open_def; IN_ELIM_THM] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN MP_TAC(ISPECL [`ball(z:complex,e)`; `g:real^1->complex`] WINDING_NUMBER_CONSTANT) THEN ASM_SIMP_TAC[CONNECTED_BALL; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_BALL] THEN ASM_MESON_TAC[DIST_REFL; DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Winding number is zero "outside" a curve, in various senses. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_ZERO_IN_OUTSIDE = prove (`!g z. path g /\ pathfinish g = pathstart g /\ z IN outside(path_image g) ==> winding_number(g,z) = Cx(&0)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`path_image(g:real^1->complex)`; `Cx(&0)`] BOUNDED_SUBSET_BALL) THEN ASM_SIMP_TAC[BOUNDED_PATH_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?w. ~(w IN ball(Cx(&0),B + &1))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s = UNIV) ==> ?z. ~(z IN s)`) THEN MESON_TAC[BOUNDED_BALL; NOT_BOUNDED_UNIV]; ALL_TAC] THEN MP_TAC(ISPECL [`Cx(&0)`; `B:real`; `B + &1`] SUBSET_BALL) THEN REWRITE_TAC[REAL_ARITH `B <= B + &1`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`path_image(g:real^1->complex)`; `ball(Cx(&0),B + &1)`] OUTSIDE_SUBSET_CONVEX) THEN ASM_REWRITE_TAC[CONVEX_BALL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(g,w)` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`outside(path_image(g:real^1->complex))`; `g:real^1->complex`] WINDING_NUMBER_CONSTANT) THEN ASM_SIMP_TAC[OUTSIDE_NO_OVERLAP; CONNECTED_OUTSIDE; DIMINDEX_2; LE_REFL; BOUNDED_PATH_IMAGE] THEN ASM SET_TAC[]; MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC] THEN MP_TAC(ISPECL [`g:real^1->complex`; `min e (&1)`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN CONJ_TAC THENL [UNDISCH_TAC `~(w IN ball (Cx(&0),B + &1))` THEN REWRITE_TAC[CONTRAPOS_THM; path_image; IN_BALL] THEN SPEC_TAC(`w:complex`,`x:complex`) THEN REWRITE_TAC[FORALL_IN_IMAGE]; REWRITE_TAC[COMPLEX_MUL_RZERO] THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX_SIMPLE THEN EXISTS_TAC `ball(Cx(&0),B + &1)` THEN ASM_SIMP_TAC[CONVEX_BALL; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; COMPLEX_SUB_0] THEN ASM_MESON_TAC[]; REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; IN_BALL]]] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN MATCH_MP_TAC(NORM_ARITH `!g:real^1->complex. norm(p t - g t) < &1 /\ norm(g t) <= B ==> norm(p t) < B + &1`) THEN EXISTS_TAC `g:real^1->complex` THEN UNDISCH_TAC `path_image g SUBSET ball (Cx(&0),B)` THEN ASM_SIMP_TAC[SUBSET; IN_BALL; path_image; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; REAL_LT_IMP_LE]]);; let WINDING_NUMBER_ZERO_OUTSIDE = prove (`!g s z. path g /\ convex s /\ pathfinish g = pathstart g /\ ~(z IN s) /\ path_image g SUBSET s ==> winding_number(g,z) = Cx(&0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_ZERO_IN_OUTSIDE THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`path_image(g:real^1->complex)`; `s:complex->bool`] OUTSIDE_SUBSET_CONVEX) THEN ASM SET_TAC[]);; let WINDING_NUMBER_ZERO_ATINFINITY = prove (`!g. path g /\ pathfinish g = pathstart g ==> ?B. !z. B <= norm(z) ==> winding_number(g,z) = Cx(&0)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `bounded (path_image g :complex->bool)` MP_TAC THENL [ASM_SIMP_TAC[BOUNDED_PATH_IMAGE]; ALL_TAC] THEN REWRITE_TAC[bounded] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `B + &1` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_ZERO_OUTSIDE THEN EXISTS_TAC `cball(Cx(&0),B)` THEN ASM_REWRITE_TAC[CONVEX_CBALL] THEN REWRITE_TAC[SUBSET; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN ASM_MESON_TAC[REAL_ARITH `~(B + &1 <= z /\ z <= B)`]);; let WINDING_NUMBER_ZERO_POINT = prove (`!g s. path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s ==> ?z. z IN s /\ winding_number(g,z) = Cx(&0)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`path_image g:complex->bool`; `s:complex->bool`] OUTSIDE_COMPACT_IN_OPEN) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_EMPTY; PATH_IMAGE_NONEMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[IN_INTER] THEN ASM_SIMP_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE]);; (* ------------------------------------------------------------------------- *) (* If a path winds round a set, it winds rounds its inside. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_AROUND_INSIDE = prove (`!g s z. path g /\ pathfinish g = pathstart g /\ closed s /\ connected s /\ s INTER path_image g = {} /\ z IN s /\ ~(winding_number(g,z) = Cx(&0)) ==> !w. w IN s UNION inside(s) ==> winding_number(g,w) = winding_number(g,z)`, MAP_EVERY X_GEN_TAC [`g:real^1->complex`; `s:complex->bool`; `z0:complex`] THEN STRIP_TAC THEN SUBGOAL_THEN `!z. z IN s ==> winding_number(g,z) = winding_number(g,z0)` ASSUME_TAC THENL [ASM_MESON_TAC[WINDING_NUMBER_EQ]; ALL_TAC] THEN ABBREV_TAC `k = winding_number (g,z0)` THEN SUBGOAL_THEN `(s:complex->bool) SUBSET inside(path_image g)` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; INSIDE_OUTSIDE; IN_DIFF; IN_UNIV; IN_UNION] THEN X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE]]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MP_TAC(ISPECL [`s:complex->bool`; `path_image g:complex->bool`] INSIDE_INSIDE_COMPACT_CONNECTED) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN STRIP_TAC THEN EXPAND_TAC "k" THEN MATCH_MP_TAC WINDING_NUMBER_EQ THEN EXISTS_TAC `s UNION inside s :complex->bool` THEN ASM_SIMP_TAC[CONNECTED_WITH_INSIDE; IN_UNION] THEN MP_TAC(ISPEC `path_image g :complex->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Bounding a WN by 1/2 for a path and point in opposite halfspaces. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_SUBPATH_CONTINUOUS = prove (`!g z. valid_path g /\ ~(z IN path_image g) ==> (\a. winding_number(subpath (vec 0) a g,z)) continuous_on interval[vec 0,vec 1]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\a. Cx(&1) / (Cx(&2) * Cx pi * ii) * integral (interval[vec 0,a]) (\t. Cx(&1) / (g t - z) * vector_derivative g (at t))` THEN CONJ_TAC THENL [X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Cx(&1) / (Cx(&2) * Cx pi * ii) * path_integral (subpath (vec 0) a g) (\w. Cx(&1) / (w - z))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_SUBPATH_INTEGRAL THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; PATH_INTEGRABLE_INVERSEDIFF] THEN ASM_MESON_TAC[IN_INTERVAL_1]; REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_VALID_PATH THEN ASM_MESON_TAC[VALID_PATH_SUBPATH; SUBSET; VALID_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL; PATH_IMAGE_SUBPATH_SUBSET]]; MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN REWRITE_TAC[GSYM PATH_INTEGRABLE_ON] THEN ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]]);; let WINDING_NUMBER_IVT_POS = prove (`!g z w. valid_path g /\ ~(z IN path_image g) /\ &0 <= w /\ w <= Re(winding_number(g,z)) ==> ?t. t IN interval[vec 0,vec 1] /\ Re(winding_number(subpath (vec 0) t g,z)) = w`, REPEAT STRIP_TAC THEN REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN ASM_SIMP_TAC[WINDING_NUMBER_SUBPATH_CONTINUOUS] THEN ASM_REWRITE_TAC[SUBPATH_TRIVIAL; GSYM RE_DEF; DIMINDEX_2; ARITH] THEN REWRITE_TAC[DROP_VEC; REAL_POS; SUBPATH_REFL] THEN MP_TAC(ISPECL [`(g:real^1->complex) (vec 0)`; `z:complex`] WINDING_NUMBER_TRIVIAL) THEN ASM_MESON_TAC[pathstart; PATHSTART_IN_PATH_IMAGE; RE_CX]);; let WINDING_NUMBER_IVT_NEG = prove (`!g z w. valid_path g /\ ~(z IN path_image g) /\ Re(winding_number(g,z)) <= w /\ w <= &0 ==> ?t. t IN interval[vec 0,vec 1] /\ Re(winding_number(subpath (vec 0) t g,z)) = w`, REPEAT STRIP_TAC THEN REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC IVT_DECREASING_COMPONENT_ON_1 THEN ASM_SIMP_TAC[WINDING_NUMBER_SUBPATH_CONTINUOUS] THEN ASM_REWRITE_TAC[SUBPATH_TRIVIAL; GSYM RE_DEF; DIMINDEX_2; ARITH] THEN REWRITE_TAC[DROP_VEC; REAL_POS; SUBPATH_REFL] THEN MP_TAC(ISPECL [`(g:real^1->complex) (vec 0)`; `z:complex`] WINDING_NUMBER_TRIVIAL) THEN ASM_MESON_TAC[pathstart; PATHSTART_IN_PATH_IMAGE; RE_CX]);; let WINDING_NUMBER_IVT_ABS = prove (`!g z w. valid_path g /\ ~(z IN path_image g) /\ &0 <= w /\ w <= abs(Re(winding_number(g,z))) ==> ?t. t IN interval[vec 0,vec 1] /\ abs(Re(winding_number(subpath (vec 0) t g,z))) = w`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= Re(winding_number(g,z))` THEN ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `w:real`] WINDING_NUMBER_IVT_POS); MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `--w:real`] WINDING_NUMBER_IVT_NEG)] THEN (ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; let WINDING_NUMBER_LT_HALF = prove (`!g z a b. valid_path g /\ a dot z <= b /\ path_image g SUBSET {w | a dot w > b} ==> abs(Re(winding_number(g,z))) < &1 / &2`, let lemma = prove (`!g z a b. valid_path g /\ ~(z IN path_image g) /\ a dot z <= b /\ path_image g SUBSET {w | a dot w > b} ==> Re(winding_number(g,z)) < &1 / &2`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `&1 / &2`] WINDING_NUMBER_IVT_POS) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN MP_TAC(ISPECL [`subpath (vec 0) t (g:real^1->complex)`; `z:complex`] WINDING_NUMBER_AHLFORS_FULL) THEN ASM_SIMP_TAC[VALID_PATH_SUBPATH; VALID_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL; NOT_IMP] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(z IN t) ==> s SUBSET t ==> ~(z IN s)`)) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; ENDS_IN_UNIT_INTERVAL; VALID_PATH_IMP_PATH]; ASM_REWRITE_TAC[EULER; RE_MUL_CX; RE_MUL_II; IM_MUL_CX; IM_MUL_II] THEN REWRITE_TAC[REAL_ARITH `&2 * pi * &1 / &2 = pi`; SIN_PI; COS_PI] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_RID; GSYM COMPLEX_CMUL] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < a dot ((g:real^1->complex) t - z) /\ &0 < a dot (g(vec 0) - z)` MP_TAC THENL [REWRITE_TAC[DOT_RSUB; REAL_SUB_LT] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[GSYM real_gt] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `g SUBSET {z | a dot z > b} ==> t IN g ==> a dot t > b`)) THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; ASM_REWRITE_TAC[DOT_RMUL] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(&0 < -- x)`) THEN REWRITE_TAC[REAL_EXP_POS_LT]]]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `x < a /\ --x < a ==> abs x < a`) THEN CONJ_TAC THENL [ASM_MESON_TAC[lemma]; ALL_TAC] THEN MP_TAC(ISPECL [`reversepath g:real^1->complex`; `z:complex`; `a:complex`; `b:real`] lemma) THEN ASM_SIMP_TAC[VALID_PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; WINDING_NUMBER_REVERSEPATH; VALID_PATH_IMP_PATH; RE_NEG] THEN REAL_ARITH_TAC);; let WINDING_NUMBER_LE_HALF = prove (`!g z a b. valid_path g /\ ~(z IN path_image g) /\ ~(a = vec 0) /\ a dot z <= b /\ path_image g SUBSET {w | a dot w >= b} ==> abs(Re(winding_number(g,z))) <= &1 / &2`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] CONTINUOUS_AT_WINDING_NUMBER) THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH; continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `abs(Re(winding_number(g,z))) - &1 / &2`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z - d / &2 / norm(a) % a:complex`) THEN REWRITE_TAC[NORM_ARITH `dist(z - d:complex,z) = norm d`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `abs(Re w' - Re w) <= norm(w' - w) /\ abs(Re w') < &1 / &2 ==> ~(dist(w',w) < abs(Re w) - &1 / &2)`) THEN REWRITE_TAC[GSYM RE_SUB] THEN CONJ_TAC THENL [SIMP_TAC[COMPONENT_LE_NORM; RE_DEF; DIMINDEX_2; ARITH]; ALL_TAC] THEN MATCH_MP_TAC WINDING_NUMBER_LT_HALF THEN EXISTS_TAC `a:complex` THEN EXISTS_TAC `b - d / &3 * norm(a:complex)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[DOT_RSUB; DOT_RMUL; GSYM NORM_POW_2] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD `~(a = &0) ==> x / a * a pow 2 = x * a`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a:real <= b ==> d <= e ==> a - e <= b - d`)) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> !x. a dot x >= b ==> a dot x > b - e`) THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[NORM_POS_LT] THEN ASM_REAL_ARITH_TAC]);; let WINDING_NUMBER_LT_HALF_LINEPATH = prove (`!a b z. ~(z IN segment[a,b]) ==> abs(Re(winding_number(linepath(a,b),z))) < &1 / &2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_HALF THEN MP_TAC(ISPECL [`segment[a:complex,b]`; `z:complex`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN ASM_REWRITE_TAC[CONVEX_SEGMENT; CLOSED_SEGMENT] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH; SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Positivity of WN for a linepath. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_LINEPATH_POS_LT = prove (`!a b z. &0 < Im((b - a) * cnj(b - z)) ==> &0 < Re(winding_number(linepath(a,b),z))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_POS_LT THEN EXISTS_TAC `Im((b - a) * cnj(b - z))` THEN ASM_REWRITE_TAC[VALID_PATH_LINEPATH; VECTOR_DERIVATIVE_LINEPATH_AT] THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SPEC_TAC(`z:complex`,`z:complex`) THEN REWRITE_TAC[path_image; FORALL_IN_IMAGE; linepath] THEN REWRITE_TAC[VECTOR_ARITH `b - ((&1 - x) % a + x % b) = (&1 - x) % (b - a)`] THEN REWRITE_TAC[COMPLEX_CMUL; CNJ_MUL; CNJ_CX] THEN REWRITE_TAC[COMPLEX_RING `a * Cx x * cnj a = Cx x * a * cnj a`] THEN SIMP_TAC[COMPLEX_MUL_CNJ; GSYM CX_POW; GSYM CX_MUL; IM_CX; REAL_LT_REFL]; ALL_TAC] THEN SUBGOAL_THEN `segment[a,b] SUBSET {y | Im((b - a) * cnj(b - z)) <= Im((b - a) * cnj(y - z))}` MP_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{a,b} SUBSET {y | P y} <=> P a /\ P b`] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[cnj; complex_mul; RE; IM; RE_SUB; IM_SUB] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB; IM_SUB; CNJ_SUB; REAL_LE_SUB_LADD] THEN REWRITE_TAC[CONVEX_ALT; cnj; complex_mul; RE; IM; RE_SUB; IM_SUB] THEN REWRITE_TAC[IN_ELIM_THM; IM_ADD; RE_ADD; IM_CMUL; RE_CMUL] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_NEG_RMUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `e <= ab * ((&1 - u) * x + u * y) + ab' * ((&1 - u) * x' + u * y') <=> (&1 - u) * e + u * e <= (&1 - u) * (ab * x + ab' * x') + u * (ab * y + ab' * y')`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]]);; (* ------------------------------------------------------------------------- *) (* Winding number for a triangle. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_TRIANGLE = prove (`!a b c z. z IN interior(convex hull {a,b,c}) ==> winding_number(linepath(a,b) ++ linepath(b,c) ++ linepath(c,a),z) = if &0 < Im((b - a) * cnj (b - z)) then Cx(&1) else --Cx(&1)`, let lemma1 = prove (`!a b c. vec 0 IN interior(convex hull {a,b,c}) ==> ~(Im(a / b) <= &0 /\ &0 <= Im(b / c))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM COMPLEX_INV_DIV] THEN REWRITE_TAC[IM_COMPLEX_INV_GE_0] THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:complex` THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; GSYM CX_MUL; REAL_MUL_RID] THEN X_GEN_TAC `x:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN REWRITE_TAC[IM_DIV_CX] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[NOT_IN_INTERIOR_CONVEX_HULL_3; COMPLEX_VEC_0] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LZERO] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. ~(x IN s) /\ t SUBSET s ==> ~(x IN t)`) THEN EXISTS_TAC `interior {z | Im z <= &0}` THEN CONJ_TAC THENL [REWRITE_TAC[IM_DEF; INTERIOR_HALFSPACE_COMPONENT_LE] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; IN_ELIM_THM; VEC_COMPONENT] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_IM_LE] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[IM_CX; REAL_LE_REFL]]) in let lemma2 = prove (`z IN interior(convex hull {a,b,c}) ==> &0 < Im((b - a) * cnj (b - z)) /\ &0 < Im((c - b) * cnj (c - z)) /\ &0 < Im((a - c) * cnj (a - z)) \/ Im((b - a) * cnj (b - z)) < &0 /\ &0 < Im((b - c) * cnj (b - z)) /\ &0 < Im((a - b) * cnj (a - z)) /\ &0 < Im((c - a) * cnj (c - z))`, GEOM_ORIGIN_TAC `z:complex` THEN REWRITE_TAC[VECTOR_SUB_RZERO; COMPLEX_SUB_RDISTRIB] THEN REWRITE_TAC[COMPLEX_MUL_CNJ; IM_SUB; GSYM CX_POW; IM_CX] THEN REWRITE_TAC[REAL_ARITH `&0 < &0 - x <=> x < &0`; REAL_ARITH `&0 - x < &0 <=> &0 < x`] THEN REWRITE_TAC[GSYM IM_COMPLEX_DIV_GT_0; GSYM IM_COMPLEX_DIV_LT_0] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM COMPLEX_INV_DIV] THEN REWRITE_TAC[IM_COMPLEX_INV_LT_0; IM_COMPLEX_INV_GT_0] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV o RAND_CONV) [GSYM COMPLEX_INV_DIV] THEN REWRITE_TAC[IM_COMPLEX_INV_LT_0] THEN MP_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] lemma1) THEN MP_TAC(ISPECL [`b:complex`; `c:complex`; `a:complex`] lemma1) THEN MP_TAC(ISPECL [`c:complex`; `a:complex`; `b:complex`] lemma1) THEN POP_ASSUM MP_TAC THEN SIMP_TAC[INSERT_AC] THEN REAL_ARITH_TAC) in let lemma3 = prove (`!a b c z. z IN interior(convex hull {a,b,c}) /\ &0 < Im((b - a) * cnj (b - z)) /\ &0 < Im((c - b) * cnj (c - z)) /\ &0 < Im((a - c) * cnj (a - z)) ==> winding_number (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a),z) = Cx(&1)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_EQ_1 THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; CONJ_ASSOC; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT(MATCH_MP_TAC WINDING_NUMBER_JOIN_POS_COMBINED THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN CONJ_TAC) THEN ASM_SIMP_TAC[WINDING_NUMBER_LINEPATH_POS_LT; VALID_PATH_LINEPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH]; RULE_ASSUM_TAC(REWRITE_RULE [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_IMAGE_JOIN; PATH_JOIN; IN_UNION; PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; RE_ADD; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN MATCH_MP_TAC(REAL_ARITH `abs a < &1 / &2 /\ abs b < &1 / &2 /\ abs c < &1 / &2 ==> a + b + c < &2`) THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_HALF_LINEPATH THEN ASM_REWRITE_TAC[]]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP lemma2) THEN ASM_SIMP_TAC[lemma3; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN SUBGOAL_THEN `winding_number (linepath(c,b) ++ linepath(b,a) ++ linepath(a,c),z) = Cx(&1)` MP_TAC THENL [MATCH_MP_TAC lemma3 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[INSERT_AC]; COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN RULE_ASSUM_TAC(REWRITE_RULE [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN FIRST_ASSUM(ASSUME_TAC o ONCE_REWRITE_RULE[SEGMENT_SYM] o CONJUNCT2) THEN ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_IMAGE_JOIN; PATH_JOIN; IN_UNION; PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; RE_ADD; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN ASM_SIMP_TAC[COMPLEX_NEG_ADD; GSYM WINDING_NUMBER_REVERSEPATH; PATH_IMAGE_LINEPATH; PATH_LINEPATH; REVERSEPATH_LINEPATH] THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* Cauchy's integral formula, again for a convex enclosing set. *) (* ------------------------------------------------------------------------- *) let CAUCHY_INTEGRAL_FORMULA_WEAK = prove (`!f s k g z. convex s /\ FINITE k /\ f continuous_on s /\ (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) /\ z IN interior(s) DIFF k /\ valid_path g /\ (path_image g) SUBSET (s DELETE z) /\ pathfinish g = pathstart g ==> ((\w. f(w) / (w - z)) has_path_integral (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `z:complex`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[complex_differentiable; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f':complex` THEN DISCH_TAC THEN MP_TAC(SPECL [`\w:complex. if w = z then f' else (f w - f z) / (w - z)`; `s:complex->bool`; `(z:complex) INSERT k`; `g:real^1->complex`] CAUCHY_THEOREM_CONVEX) THEN REWRITE_TAC[IN_DIFF; IN_INSERT; DE_MORGAN_THM] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FINITE_INSERT] THEN REPEAT CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\w:complex. (f w - f z) / (w - z)` THEN EXISTS_TAC `dist(w:complex,z)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID]; ASM SET_TAC[]] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `w:complex = z` THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN EXISTS_TAC `\w:complex. (f w - f z) / (w - z)` THEN EXISTS_TAC `dist(w:complex,z)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV_WITHIN THEN RULE_ASSUM_TAC(REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN ASM_SIMP_TAC[CONTINUOUS_CONST; CONTINUOUS_SUB; CONTINUOUS_WITHIN_ID; ETA_AX; COMPLEX_SUB_0]] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN MATCH_MP_TAC LIM_TRANSFORM_AWAY_WITHIN THEN EXISTS_TAC `\w:complex. (f w - f z) / (w - z)` THEN SIMP_TAC[] THEN EXISTS_TAC `z + Cx(&1)` THEN CONJ_TAC THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN REWRITE_TAC[GSYM HAS_COMPLEX_DERIVATIVE_WITHIN] THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; ALL_TAC] THEN MP_TAC(SPECL [`g:real^1->complex`; `z:complex`] HAS_PATH_INTEGRAL_WINDING_NUMBER) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(f:complex->complex) z` o MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_ADD) THEN REWRITE_TAC[COMPLEX_RING `f * Cx(&2) * a * b * c + Cx(&0) = Cx(&2) * a * b * c * f`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `~(w:complex = z)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_FIELD);; let CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE = prove (`!f s g z. convex s /\ f holomorphic_on s /\ z IN interior(s) /\ valid_path g /\ (path_image g) SUBSET (s DELETE z) /\ pathfinish g = pathstart g ==> ((\w. f(w) / (w - z)) has_path_integral (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_INTEGRAL_FORMULA_WEAK THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN ASM_REWRITE_TAC[DIFF_EMPTY; FINITE_RULES] THEN SIMP_TAC[OPEN_INTERIOR; complex_differentiable; GSYM HOLOMORPHIC_ON_OPEN] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; INTERIOR_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Homotopy forms of Cauchy's theorem. The first two proofs are almost the *) (* same and could potentially be unified with a little more work. *) (* ------------------------------------------------------------------------- *) let CAUCHY_THEOREM_HOMOTOPIC_PATHS = prove (`!f g h s. open s /\ f holomorphic_on s /\ valid_path g /\ valid_path h /\ homotopic_paths s g h ==> path_integral g f = path_integral h f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN REWRITE_TAC[homotopic_with; LEFT_IMP_EXISTS_THM; PCROSS] THEN X_GEN_TAC `k:real^(1,1)finite_sum->complex` THEN STRIP_TAC THEN SUBGOAL_THEN `!t. t IN interval[vec 0:real^1,vec 1] ==> ?e. &0 < e /\ !t1 t2. t1 IN interval[vec 0:real^1,vec 1] /\ t2 IN interval[vec 0,vec 1] /\ norm(t1 - t) < e /\ norm(t2 - t) < e ==> ?d. &0 < d /\ !g1 g2. valid_path g1 /\ valid_path g2 /\ (!u. u IN interval[vec 0,vec 1] ==> norm(g1 u - k(pastecart t1 u)) < d /\ norm(g2 u - k(pastecart t2 u)) < d) /\ pathstart g1 = pathstart g /\ pathfinish g1 = pathfinish g /\ pathstart g2 = pathstart g /\ pathfinish g2 = pathfinish g ==> path_image g1 SUBSET s /\ path_image g2 SUBSET s /\ path_integral g2 f = path_integral g1 f` MP_TAC THENL [X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:complex->bool`; `\u. (k:real^(1,1)finite_sum->complex)(pastecart t u)`] PATH_INTEGRAL_NEARBY_ENDS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[path_image; path; IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_UNIFORMLY_CONTINUOUS)) THEN SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; COMPACT_INTERVAL] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!t x t' x'. P t x t' x') ==> (!t t' u. P t u t' u)`)) THEN REWRITE_TAC[dist; NORM_PASTECART; PASTECART_SUB] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[TAUT `a /\ b /\ c /\ b /\ d <=> a /\ c /\ b /\ d`] THEN SIMP_TAC[REAL_ADD_RID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN STRIP_TAC THEN EXISTS_TAC `e / &4` THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN MAP_EVERY X_GEN_TAC [`g1:real^1->complex`; `g2:real^1->complex`] THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`g1:real^1->complex`; `g2:real^1->complex`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN ASM_MESON_TAC[NORM_ARITH `norm(g1 - k1) < e / &4 /\ norm(g2 - k2) < e / &4 /\ norm(k1 - kt) < e / &4 /\ norm(k2 - kt) < e / &4 ==> norm(g1 - kt) < e /\ norm(g2 - kt) < e`]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[ SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `ee:real^1->real` THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]` COMPACT_IMP_HEINE_BOREL) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\t:real^1. ball(t,ee t / &3)) (interval[vec 0,vec 1])`) THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; SUBSET] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `t:real^1` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_ARITH `&0 < e / &3 <=> &0 < e`]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; MESON[] `(?f s. (P s /\ f = g s) /\ Q f) <=> ?s. P s /\ Q(g s)`] THEN REWRITE_TAC[UNIONS_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:real^1->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `k:real^1->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN REAL_ARITH_TAC; DISCH_THEN(LABEL_TAC "+")] THEN SUBGOAL_THEN `!i:real^1. i IN k ==> &0 < ee(i)` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN ABBREV_TAC `e = inf(IMAGE (ee:real^1->real) k)` THEN MP_TAC(ISPEC `IMAGE (ee:real^1->real) k` INF_FINITE) THEN MP_TAC(ISPECL [`IMAGE (ee:real^1->real) k`; `&0`] REAL_LT_INF_FINITE) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN DISCH_TAC THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN MP_TAC(ISPEC `e / &3` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n. n <= N ==> ?d. &0 < d /\ !j. valid_path j /\ (!u. u IN interval [vec 0,vec 1] ==> norm(j u - k(pastecart (lift(&n / &N)) u)) < d) /\ pathstart j = pathstart g /\ pathfinish j = pathfinish g ==> path_image j SUBSET s /\ path_integral j f = path_integral g f` (MP_TAC o SPEC `N:num`) THENL [ALL_TAC; REWRITE_TAC[LE_REFL; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `h:real^1->complex`) THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]] THEN INDUCT_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `vec 0:real^1`) THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; LE_0; LIFT_NUM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REPEAT(DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `j:real^1->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`g:real^1->complex`; `j:real^1->complex`]) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `lift(&n / &N) IN interval[vec 0,vec 1] /\ lift(&(SUC n) / &N) IN interval[vec 0,vec 1]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "+" (MP_TAC o SPEC `lift(&n / &N)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN REMOVE_THEN "*" (MP_TAC o SPEC `t:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`lift(&n / &N)`; `lift(&(SUC n) / &N)`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN MATCH_MP_TAC(NORM_ARITH `!e. norm(n' - n:real^N) < e / &3 /\ e <= ee ==> dist(t,n) < ee / &3 ==> norm(n - t) < ee /\ norm(n' - t) < ee`) THEN EXISTS_TAC `e:real` THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `n <= SUC n`] THEN REWRITE_TAC[ARITH_RULE `SUC n - n = 1`; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[GSYM real_div]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d2:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `j:real^1->complex` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\u:real^1. (k(pastecart (lift (&n / &N)) u):complex)`; `min d1 d2`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN ANTS_TAC THENL [REWRITE_TAC[path] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC)] THEN REMOVE_THEN "1" (MP_TAC o SPEC `p:real^1->complex`) THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `j:real^1->complex`]) THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]);; let CAUCHY_THEOREM_HOMOTOPIC_LOOPS = prove (`!f g h s. open s /\ f holomorphic_on s /\ valid_path g /\ valid_path h /\ homotopic_loops s g h ==> path_integral g f = path_integral h f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:real^(1,1)finite_sum->complex` THEN STRIP_TAC THEN SUBGOAL_THEN `!t. t IN interval[vec 0:real^1,vec 1] ==> ?e. &0 < e /\ !t1 t2. t1 IN interval[vec 0:real^1,vec 1] /\ t2 IN interval[vec 0,vec 1] /\ norm(t1 - t) < e /\ norm(t2 - t) < e ==> ?d. &0 < d /\ !g1 g2. valid_path g1 /\ valid_path g2 /\ (!u. u IN interval[vec 0,vec 1] ==> norm(g1 u - k(pastecart t1 u)) < d /\ norm(g2 u - k(pastecart t2 u)) < d) /\ pathfinish g1 = pathstart g1 /\ pathfinish g2 = pathstart g2 ==> path_image g1 SUBSET s /\ path_image g2 SUBSET s /\ path_integral g2 f = path_integral g1 f` MP_TAC THENL [X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:complex->bool`; `\u. (k:real^(1,1)finite_sum->complex)(pastecart t u)`] PATH_INTEGRAL_NEARBY_LOOP) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[path_image; path; IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_UNIFORMLY_CONTINUOUS)) THEN SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; COMPACT_INTERVAL] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!t x t' x'. P t x t' x') ==> (!t t' u. P t u t' u)`)) THEN REWRITE_TAC[dist; NORM_PASTECART; PASTECART_SUB] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[TAUT `a /\ b /\ c /\ b /\ d <=> a /\ c /\ b /\ d`] THEN SIMP_TAC[REAL_ADD_RID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN STRIP_TAC THEN EXISTS_TAC `e / &4` THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN MAP_EVERY X_GEN_TAC [`g1:real^1->complex`; `g2:real^1->complex`] THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`g1:real^1->complex`; `g2:real^1->complex`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN ASM_MESON_TAC[NORM_ARITH `norm(g1 - k1) < e / &4 /\ norm(g2 - k2) < e / &4 /\ norm(k1 - kt) < e / &4 /\ norm(k2 - kt) < e / &4 ==> norm(g1 - kt) < e /\ norm(g2 - kt) < e`]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[ SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `ee:real^1->real` THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]` COMPACT_IMP_HEINE_BOREL) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\t:real^1. ball(t,ee t / &3)) (interval[vec 0,vec 1])`) THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; SUBSET] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `t:real^1` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_ARITH `&0 < e / &3 <=> &0 < e`]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; MESON[] `(?f s. (P s /\ f = g s) /\ Q f) <=> ?s. P s /\ Q(g s)`] THEN REWRITE_TAC[UNIONS_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:real^1->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `k:real^1->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN REAL_ARITH_TAC; DISCH_THEN(LABEL_TAC "+")] THEN SUBGOAL_THEN `!i:real^1. i IN k ==> &0 < ee(i)` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN ABBREV_TAC `e = inf(IMAGE (ee:real^1->real) k)` THEN MP_TAC(ISPEC `IMAGE (ee:real^1->real) k` INF_FINITE) THEN MP_TAC(ISPECL [`IMAGE (ee:real^1->real) k`; `&0`] REAL_LT_INF_FINITE) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN DISCH_TAC THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN MP_TAC(ISPEC `e / &3` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n. n <= N ==> ?d. &0 < d /\ !j. valid_path j /\ (!u. u IN interval [vec 0,vec 1] ==> norm(j u - k(pastecart (lift(&n / &N)) u)) < d) /\ pathfinish j = pathstart j ==> path_image j SUBSET s /\ path_integral j f = path_integral g f` (MP_TAC o SPEC `N:num`) THENL [ALL_TAC; REWRITE_TAC[LE_REFL; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `h:real^1->complex`) THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]] THEN INDUCT_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `vec 0:real^1`) THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; LE_0; LIFT_NUM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REPEAT(DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `j:real^1->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`g:real^1->complex`; `j:real^1->complex`]) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `lift(&n / &N) IN interval[vec 0,vec 1] /\ lift(&(SUC n) / &N) IN interval[vec 0,vec 1]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "+" (MP_TAC o SPEC `lift(&n / &N)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN REMOVE_THEN "*" (MP_TAC o SPEC `t:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`lift(&n / &N)`; `lift(&(SUC n) / &N)`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN MATCH_MP_TAC(NORM_ARITH `!e. norm(n' - n:real^N) < e / &3 /\ e <= ee ==> dist(t,n) < ee / &3 ==> norm(n - t) < ee /\ norm(n' - t) < ee`) THEN EXISTS_TAC `e:real` THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `n <= SUC n`] THEN REWRITE_TAC[ARITH_RULE `SUC n - n = 1`; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[GSYM real_div]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d2:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `j:real^1->complex` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\u:real^1. (k(pastecart (lift (&n / &N)) u):complex)`; `min d1 d2`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN ANTS_TAC THENL [REWRITE_TAC[path] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC)] THEN REMOVE_THEN "1" (MP_TAC o SPEC `p:real^1->complex`) THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `j:real^1->complex`]) THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]);; let CAUCHY_THEOREM_NULL_HOMOTOPIC = prove (`!f g s a. open s /\ f holomorphic_on s /\ a IN s /\ valid_path g /\ homotopic_loops s g (linepath(a,a)) ==> (f has_path_integral Cx(&0)) g`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN MATCH_MP_TAC (MESON[HAS_PATH_INTEGRAL_INTEGRAL; path_integrable_on; PATH_INTEGRAL_UNIQUE] `!p. f path_integrable_on g /\ (f has_path_integral y) p /\ path_integral g f = path_integral p f ==> (f has_path_integral y) g`) THEN EXISTS_TAC `linepath(a:complex,a)` THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX_SIMPLE THEN EXISTS_TAC `ball(a:complex,e)` THEN ASM_REWRITE_TAC[VALID_PATH_LINEPATH; CONVEX_BALL; PATH_IMAGE_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[SEGMENT_REFL; SING_SUBSET; IN_BALL; CENTRE_IN_BALL] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; MATCH_MP_TAC CAUCHY_THEOREM_HOMOTOPIC_LOOPS THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[VALID_PATH_LINEPATH]]);; let CAUCHY_THEOREM_SIMPLY_CONNECTED = prove (`!f g s. open s /\ simply_connected s /\ f holomorphic_on s /\ valid_path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g ==> (f has_path_integral Cx(&0)) g`, REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_NULL_HOMOTOPIC THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `pathstart g :complex`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN ASM_SIMP_TAC[PATHFINISH_LINEPATH; VALID_PATH_IMP_PATH]]);; (* ------------------------------------------------------------------------- *) (* More winding number properties, including the fact that it's +-1 inside *) (* a simple closed curve. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_HOMOTOPIC_PATHS = prove (`!g h z. homotopic_paths ((:complex) DELETE z) g h ==> winding_number(g,z) = winding_number(h,z)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `(:complex) DELETE z`] HOMOTOPIC_NEARBY_PATHS) THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `d:real`] WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h:real^1->complex`; `(:complex) DELETE z`] HOMOTOPIC_NEARBY_PATHS) THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h:real^1->complex`; `z:complex`; `e:real`] WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `path_integral p (\w. Cx(&1) / (w - z)) = path_integral q (\w. Cx(&1) / (w - z))` MP_TAC THENL [MATCH_MP_TAC CAUCHY_THEOREM_HOMOTOPIC_PATHS THEN EXISTS_TAC `(:complex) DELETE z` THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_SUB; IN_DELETE; COMPLEX_SUB_0]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `g:real^1->complex` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]; MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `h:real^1->complex` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]]; ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_RING]);; let WINDING_NUMBER_HOMOTOPIC_LOOPS = prove (`!g h z. homotopic_loops ((:complex) DELETE z) g h ==> winding_number(g,z) = winding_number(h,z)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `(:complex) DELETE z`] HOMOTOPIC_NEARBY_LOOPS) THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `d:real`] WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h:real^1->complex`; `(:complex) DELETE z`] HOMOTOPIC_NEARBY_LOOPS) THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h:real^1->complex`; `z:complex`; `e:real`] WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `path_integral p (\w. Cx(&1) / (w - z)) = path_integral q (\w. Cx(&1) / (w - z))` MP_TAC THENL [MATCH_MP_TAC CAUCHY_THEOREM_HOMOTOPIC_LOOPS THEN EXISTS_TAC `(:complex) DELETE z` THEN ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_SUB; IN_DELETE; COMPLEX_SUB_0]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `g:real^1->complex` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]; MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `h:real^1->complex` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]]; ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_RING]);; let WINDING_NUMBER_PATHS_LINEAR_EQ = prove (`!g h z. path g /\ path h /\ pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ (!t. t IN interval[vec 0,vec 1] ==> ~(z IN segment[g t,h t])) ==> winding_number(h,z) = winding_number(g,z)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR THEN ASM SET_TAC[]);; let WINDING_NUMBER_LOOPS_LINEAR_EQ = prove (`!g h z. path g /\ path h /\ pathfinish g = pathstart g /\ pathfinish h = pathstart h /\ (!t. t IN interval[vec 0,vec 1] ==> ~(z IN segment[g t,h t])) ==> winding_number(h,z) = winding_number(g,z)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_LOOPS THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR THEN ASM SET_TAC[]);; let WINDING_NUMBER_NEARBY_PATHS_EQ = prove (`!g h z. path g /\ path h /\ pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < norm(g t - z)) ==> winding_number(h,z) = winding_number(g,z)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT THEN ASM SET_TAC[]);; let WINDING_NUMBER_NEARBY_LOOPS_EQ = prove (`!g h z. path g /\ path h /\ pathfinish g = pathstart g /\ pathfinish h = pathstart h /\ (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < norm(g t - z)) ==> winding_number(h,z) = winding_number(g,z)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_LOOPS THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT THEN ASM SET_TAC[]);; let WINDING_NUMBER_SUBPATH_COMBINE = prove (`!g u v w z. path g /\ ~(z IN path_image g) /\ u IN interval [vec 0,vec 1] /\ v IN interval [vec 0,vec 1] /\ w IN interval [vec 0,vec 1] ==> winding_number(subpath u v g,z) + winding_number(subpath v w g,z) = winding_number(subpath u w g,z)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(subpath u v g ++ subpath v w g,z)` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_JOIN THEN ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN ASM_MESON_TAC[SUBSET; PATH_IMAGE_SUBPATH_SUBSET]; MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let WINDING_NUMBER_STRONG = prove (`!g z e. path g /\ ~(z IN path_image g) /\ &0 < e ==> ?p. vector_polynomial_function p /\ valid_path p /\ ~(z IN path_image p) /\ pathstart p = pathstart g /\ pathfinish p = pathfinish g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ path_integral p (\w. Cx(&1) / (w - z)) = Cx(&2) * Cx(pi) * ii * winding_number(g,z)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?d. &0 < d /\ !t. t IN interval[vec 0,vec 1] ==> d <= norm((g:real^1->complex) t - z)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `setdist({z:complex},path_image g)` THEN REWRITE_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN ASM_SIMP_TAC[SETDIST_EQ_0_CLOSED_COMPACT; CLOSED_SING; COMPACT_PATH_IMAGE; PATH_IMAGE_NONEMPTY] THEN CONJ_TAC THENL [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[path_image] THEN ASM SET_TAC[]; MP_TAC(ISPECL [`g:real^1->complex`; `min d e`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[path_image; IN_IMAGE] THEN ASM_MESON_TAC[NORM_SUB; REAL_NOT_LT]; DISCH_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `!w'. ~(a * b * c = Cx(&0)) /\ w' = w /\ w' = Cx(&1) / (a * b * c) * i ==> i = a * b * c * w`) THEN EXISTS_TAC `winding_number(p,z)` THEN REWRITE_TAC[CX_2PII_NZ] THEN CONJ_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_NEARBY_PATHS_EQ; ALL_TAC] THEN ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; VALID_PATH_IMP_PATH; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN ASM_MESON_TAC[REAL_LTE_TRANS; NORM_SUB]]]);; let WINDING_NUMBER_FROM_INNERPATH = prove (`!c1 c2 c a b z:complex d. ~(a = b) /\ simple_path c1 /\ pathstart c1 = a /\ pathfinish c1 = b /\ simple_path c2 /\ pathstart c2 = a /\ pathfinish c2 = b /\ simple_path c /\ pathstart c = a /\ pathfinish c = b /\ path_image c1 INTER path_image c2 = {a,b} /\ path_image c1 INTER path_image c = {a,b} /\ path_image c2 INTER path_image c = {a,b} /\ ~(path_image c INTER inside(path_image c1 UNION path_image c2) = {}) /\ z IN inside(path_image c1 UNION path_image c) /\ winding_number(c1 ++ reversepath c,z) = d /\ ~(d = Cx(&0)) ==> z IN inside(path_image c1 UNION path_image c2) /\ winding_number(c1 ++ reversepath c2,z) = d`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`c1:real^1->complex`; `c2:real^1->complex`; `c:real^1->complex`; `a:complex`; `b:complex`] SPLIT_INSIDE_SIMPLE_CLOSED_CURVE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `winding_number(c1 ++ reversepath c,z) = d` THEN MP_TAC(ISPECL [`c ++ reversepath(c2:real^1->complex)`; `z:complex`] WINDING_NUMBER_ZERO_IN_OUTSIDE) THEN SUBGOAL_THEN `~((z:complex) IN path_image c) /\ ~(z IN path_image c1) /\ ~(z IN path_image c2)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `(path_image c1 UNION path_image c):complex->bool` INSIDE_NO_OVERLAP) THEN MP_TAC(ISPEC `(path_image c1 UNION path_image c2):complex->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[]; ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH; SIMPLE_PATH_IMP_PATH; WINDING_NUMBER_JOIN; WINDING_NUMBER_REVERSEPATH] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN ASM SET_TAC[]; CONV_TAC COMPLEX_RING]]);; let SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE = prove (`!g. simple_path g ==> (!z. z IN inside(path_image g) ==> winding_number(g,z) = Cx(&1)) \/ (!z. z IN inside(path_image g) ==> winding_number(g,z) = --Cx(&1))`, let lemma1 = prove (`!p a e. &0 < e /\ simple_path(p ++ linepath(a - e % basis 1,a + e % basis 1)) /\ pathstart p = a + e % basis 1 /\ pathfinish p = a - e % basis 1 /\ ball(a,e) INTER path_image p = {} ==> ?z. z IN inside(path_image (p ++ linepath(a - e % basis 1,a + e % basis 1))) /\ norm(winding_number (p ++ linepath(a - e % basis 1,a + e % basis 1),z)) = &1`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:real^1->complex`; `linepath(a - e % basis 1,a + e % basis 1)`] SIMPLE_PATH_JOIN_LOOP_EQ) THEN ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_LINEPATH] THEN STRIP_TAC THEN SUBGOAL_THEN `(a:complex) IN frontier(inside (path_image(p ++ linepath(a - e % basis 1,a + e % basis 1))))` MP_TAC THENL [FIRST_ASSUM (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] JORDAN_INSIDE_OUTSIDE)) THEN ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_LINEPATH] THEN STRIP_TAC THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH] THEN REWRITE_TAC[IN_UNION; PATH_IMAGE_LINEPATH] THEN DISJ2_TAC THEN REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FRONTIER_STRADDLE] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:complex` STRIP_ASSUME_TAC o CONJUNCT1) THEN MP_TAC(ISPEC `path_image (p ++ linepath(a - e % basis 1:complex,a + e % basis 1))` INSIDE_NO_OVERLAP) THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `c:complex`) THEN ASM_REWRITE_TAC[IN_INTER; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SEGMENT_AS_BALL] THEN ASM_REWRITE_TAC[IN_INTER; VECTOR_ARITH `inv(&2) % ((a - e) + (a + e)):complex = a`; VECTOR_ARITH `(a + e) - (a - e):complex = &2 % e`] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> (abs(&2) * abs e * &1) / &2 = e`] THEN ASM_SIMP_TAC[IN_CBALL; REAL_LT_IMP_LE] THEN STRIP_TAC THEN SUBGOAL_THEN `~collinear{a - e % basis 1,c:complex,a + e % basis 1}` ASSUME_TAC THENL [MP_TAC(ISPECL [`a - e % basis 1:complex`; `a + e % basis 1:complex`; `c:complex`] COLLINEAR_3_AFFINE_HULL) THEN ASM_SIMP_TAC[VECTOR_ARITH `a - x:complex = a + x <=> x = vec 0`; BASIS_NONZERO; DIMINDEX_2; ARITH; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN REWRITE_TAC[INSERT_AC]; ALL_TAC] THEN SUBGOAL_THEN `~(interior(convex hull {a - e % basis 1,c:complex,a + e % basis 1}) = {})` MP_TAC THENL [ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3_MINIMAL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN REPEAT(ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `&1 / &3`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:complex->real` o MATCH_MP WINDING_NUMBER_TRIANGLE) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[NORM_NEG; COND_ID; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN DISCH_TAC THEN MP_TAC(ISPECL [`linepath(a + e % basis 1:complex,a - e % basis 1)`; `p:real^1->complex`; `linepath(a + e % basis 1:complex,c) ++ linepath(c,a - e % basis 1)`; `a + e % basis 1:complex`; `a - e % basis 1:complex`; `z:complex`; `winding_number (linepath(a - e % basis 1,c) ++ linepath(c,a + e % basis 1) ++ linepath(a + e % basis 1,a - e % basis 1), z)`] WINDING_NUMBER_FROM_INNERPATH) THEN ASM_SIMP_TAC[SIMPLE_PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; VECTOR_ARITH `a + x:complex = a - x <=> x = vec 0`; BASIS_NONZERO; DIMINDEX_2; ARITH; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; ARC_IMP_SIMPLE_PATH; PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(TAUT `(p ==> p') /\ (p /\ q ==> q') ==> p /\ q ==> p' /\ q'`) THEN CONJ_TAC THENL [MESON_TAC[UNION_COMM; SEGMENT_SYM]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST_ALL_TAC o SYM)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `norm(z:complex) = &1 ==> u = --z ==> norm u = &1`)) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REVERSEPATH_LINEPATH] THEN ASM_SIMP_TAC[GSYM REVERSEPATH_JOINPATHS; PATHSTART_LINEPATH] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a:complex = --b <=> b = --a`] THEN MATCH_MP_TAC WINDING_NUMBER_REVERSEPATH THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH; ARC_IMP_PATH; PATH_IMAGE_LINEPATH] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_IMP_SIMPLE_PATH THEN MATCH_MP_TAC ARC_JOIN THEN REWRITE_TAC[ARC_LINEPATH_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REPEAT(CONJ_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN FIRST_X_ASSUM CONTR_TAC; ALL_TAC]) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN MATCH_MP_TAC INTER_SEGMENT THEN ASM_MESON_TAC[INSERT_AC]; REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER p = {} ==> s SUBSET b /\ k SUBSET p ==> (s UNION k) INTER p = k`)) THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_SEGMENT; IN_BALL] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (a + e) + u % (a - e):complex = a + (&1 - &2 * u) % e`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a:complex,a + e) = norm e`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `x * e < &1 * e /\ &0 < e ==> x * abs e * &1 < e`) THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]; MATCH_MP_TAC(SET_RULE `s INTER t1 = {a} /\ s INTER t2 = {b} ==> s INTER (t1 UNION t2) = {a,b}`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SEGMENT_SYM]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SEGMENT_SYM]] THEN MATCH_MP_TAC INTER_SEGMENT THEN DISJ2_TAC THEN ASM_MESON_TAC[INSERT_AC]; MATCH_MP_TAC(SET_RULE `s INTER t1 = {a} /\ s INTER t2 = {b} ==> s INTER (t1 UNION t2) = {a,b}`) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SEGMENT_SYM]; ALL_TAC] THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN MATCH_MP_TAC(SET_RULE `b IN p /\ ~(c IN p) /\ p INTER s = {} ==> p INTER (s UNION {c,b}) = {b}`) THEN (CONJ_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ASM_REWRITE_TAC[]]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER p = {} ==> s SUBSET b ==> p INTER s = {}`)) THEN REWRITE_TAC[GSYM INTERIOR_CBALL] THEN MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN ASM_REWRITE_TAC[CONVEX_CBALL; INTERIOR_CBALL; IN_BALL] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:complex,a - e) = norm e`; NORM_ARITH `dist(a:complex,a + e) = norm e`] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `c:complex` THEN REWRITE_TAC[IN_INTER; ENDS_IN_SEGMENT; IN_UNION] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c IN s ==> s = t ==> c IN t`)) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH] THEN REWRITE_TAC[UNION_COMM; PATH_IMAGE_LINEPATH; SEGMENT_SYM]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM INSIDE_OF_TRIANGLE]) THEN REWRITE_TAC[UNION_ACI; SEGMENT_SYM]; ASM_SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; REVERSEPATH_LINEPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_JOIN; PATH_LINEPATH; PATH_IMAGE_JOIN; IN_UNION; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN CONV_TAC COMPLEX_RING; DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [COMPLEX_NORM_CX]) THEN REAL_ARITH_TAC]) in let lemma2 = prove (`!p a d e. &0 < d /\ &0 < e /\ simple_path(p ++ linepath(a - d % basis 1,a + e % basis 1)) /\ pathstart p = a + e % basis 1 /\ pathfinish p = a - d % basis 1 ==> ?z. z IN inside(path_image (p ++ linepath(a - d % basis 1,a + e % basis 1))) /\ norm(winding_number (p ++ linepath(a - d % basis 1,a + e % basis 1),z)) = &1`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:real^1->complex`; `linepath(a - d % basis 1,a + e % basis 1)`] SIMPLE_PATH_JOIN_LOOP_EQ) THEN ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_LINEPATH] THEN REWRITE_TAC[ARC_LINEPATH_EQ; PATH_IMAGE_LINEPATH] THEN STRIP_TAC THEN SUBGOAL_THEN `~((a:complex) IN path_image p)` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p INTER s SUBSET {d,e} ==> a IN s /\ ~(d = a) /\ ~(e = a) ==> ~(a IN p)`)) THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; NORM_ARITH `dist(a - d:complex,a) + dist(a,a + e) = norm(d) + norm(e)`; VECTOR_ARITH `a + e:complex = a <=> e = vec 0`; VECTOR_ARITH `a - d:complex = a <=> d = vec 0`] THEN SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_EQ_0] THEN ASM_SIMP_TAC[BASIS_NONZERO; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `(:complex) DIFF path_image p` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[GSYM closed; CLOSED_ARC_IMAGE; IN_UNIV; IN_DIFF] THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `kde:real = min k (min d e) / &2` THEN SUBGOAL_THEN `&0 < kde /\ kde < k /\ kde < d /\ kde < e` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`linepath(a + kde % basis 1,a + e % basis 1) ++ p ++ linepath(a - d % basis 1,a - kde % basis 1)`; `a:complex`; `kde:real`] lemma1) THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; SIMPLE_PATH_JOIN_LOOP_EQ] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_JOIN THEN ASM_SIMP_TAC[ARC_JOIN_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_LINEPATH; ARC_LINEPATH_EQ; PATH_IMAGE_JOIN] THEN REWRITE_TAC[VECTOR_ARITH `a + e:complex = a + d <=> e - d = vec 0`; VECTOR_ARITH `a - d:complex = a - e <=> e - d = vec 0`] THEN REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; VECTOR_MUL_EQ_0; REAL_SUB_0] THEN ASM_SIMP_TAC[BASIS_NONZERO; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_SIMP_TAC[REAL_LT_IMP_NE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p INTER de SUBSET {e,d} ==> dk SUBSET de /\ ke SUBSET de /\ ~(e IN dk) /\ ~(d IN ke) /\ ke INTER dk = {} ==> p INTER dk SUBSET {d} /\ ke INTER (p UNION dk) SUBSET {e}`)) THEN REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e) /\ dist(a + d,a - e) = norm(d + e) /\ dist(a - d,a - e) = norm(d - e) /\ dist(a + d,a + e) = norm(d - e)`] THEN REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY] THEN MATCH_MP_TAC(MESON[REAL_LT_ANTISYM] `!a:complex. (!x. x IN t ==> x$1 < a$1) /\ (!x. x IN s ==> a$1 < x$1) ==> !x. ~(x IN s /\ x IN t)`) THEN EXISTS_TAC `a:complex` THEN SIMP_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[REAL_ARITH `(a < (&1 - u) * (a + x) + u * (a + y) <=> &0 < (&1 - u) * x + u * y) /\ ((&1 - u) * (a - x) + u * (a - y) < a <=> &0 < (&1 - u) * x + u * y)`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `&0 < (&1 - u) * x + u * y <=> (&1 - u) * --x + u * --y < &0`] THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[ARC_LINEPATH_EQ; VECTOR_MUL_EQ_0; VECTOR_ARITH `a - k:complex = a + k <=> k = vec 0`] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_2; ARITH]; MATCH_MP_TAC(SET_RULE `kk INTER p = {} /\ kk INTER ke = {kp} /\ dk INTER kk = {kn} ==> (ke UNION p UNION dk) INTER kk SUBSET {kp,kn}`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER p = {} ==> s SUBSET b ==> s INTER p = {}`)) THEN SIMP_TAC[SUBSET; IN_SEGMENT; IN_BALL; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (a - d) + u % (a + d):complex = a - (&1 - &2 * u) % d`; NORM_ARITH `dist(a:complex,a - d) = norm d`] THEN REPEAT STRIP_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `&0 < kd /\ a * kd <= &1 * kd /\ kd < k ==> a * abs kd * &1 < k`) THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN ASM_REAL_ARITH_TAC; CONJ_TAC THEN MATCH_MP_TAC INTER_SEGMENT THEN DISJ1_TAC THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e) /\ dist(a + d,a - e) = norm(d + e) /\ dist(a - d,a - e) = norm(d - e) /\ dist(a + d,a + e) = norm(d - e)`] THEN REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[UNION_OVER_INTER; EMPTY_UNION] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER p = {} ==> c SUBSET b ==> c INTER p = {}`)) THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN t ==> ~(x IN s)`] THEN SIMP_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM; IN_BALL] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (a - d) + u % (a - e):complex = a - ((&1 - u) % d + u % e) /\ (&1 - u) % (a + d) + u % (a + e):complex = a + ((&1 - u) % d + u % e)`; NORM_ARITH `dist(a:complex,a + d) = norm d /\ dist(a,a - e) = norm e`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN REWRITE_TAC[REAL_NOT_LT; REAL_MUL_RID] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN REWRITE_TAC[REAL_ARITH `(k <= (&1 - u) * k + u * e <=> &0 <= u * (e - k)) /\ (k <= (&1 - u) * d + u * k <=> &0 <= (&1 - u) * (d - k))`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN MATCH_MP_TAC(TAUT `(p <=> p') /\ (p /\ p' ==> (q <=> q')) ==> p /\ q ==> p' /\ q'`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[SET_RULE `(c UNION p UNION a) UNION b = p UNION (a UNION b UNION c)`] THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) UNION_SEGMENT o rand o lhand o snd) THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between; NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; NORM_ARITH `dist(a + d:complex,a + e) = norm(d - e)`] THEN ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC UNION_SEGMENT THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between; NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; NORM_ARITH `dist(a - d:complex,a - e) = norm(d - e)`] THEN ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (MESON[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY] `z IN inside s ==> ~(z IN s)`))) THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_JOIN; ARC_IMP_PATH; PATH_LINEPATH; PATH_IMAGE_JOIN; IN_UNION; PATH_IMAGE_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN MATCH_MP_TAC(COMPLEX_RING `d + k + e:complex = z ==> (e + p + d) + k = p + z`) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(linepath (a - d % basis 1:complex,a - kde % basis 1),z) + winding_number(linepath (a - kde % basis 1,a + e % basis 1),z)` THEN CONJ_TAC THENL [AP_TERM_TAC; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_SPLIT_LINEPATH THEN ASM_REWRITE_TAC[] THENL [CONJ_TAC THENL [ALL_TAC; SUBGOAL_THEN `~(z IN segment[a - kde % basis 1:complex,a + kde % basis 1]) /\ ~(z IN segment[a + kde % basis 1,a + e % basis 1])` MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s UNION t = u ==> ~(z IN s) /\ ~(z IN t) ==> ~(z IN u)`) THEN MATCH_MP_TAC UNION_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; NORM_ARITH `dist(a - d:complex,a - e) = norm(d - e)`; NORM_ARITH `dist(a + d:complex,a + e) = norm(d - e)`] THEN ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC) in let lemma3 = prove (`!p:real^1->complex. simple_path p /\ pathfinish p = pathstart p ==> ?z. z IN inside(path_image p) /\ norm(winding_number(p,z)) = &1`, GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `p:real^1->complex` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN UNDISCH_TAC `~(inside(path_image p):complex->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN MP_TAC(ISPECL [`inside(path_image p):complex->bool`; `a:complex`; `basis 1:complex`] RAY_TO_FRONTIER) THEN MP_TAC(ISPECL [`inside(path_image p):complex->bool`; `a:complex`; `--basis 1:complex`] RAY_TO_FRONTIER) THEN ASM_SIMP_TAC[INTERIOR_OPEN; VECTOR_NEG_EQ_0; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN REWRITE_TAC[VECTOR_ARITH `a + d % --b:complex = a - d % b`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?t. t IN interval[vec 0,vec 1] /\ (p:real^1->complex) t = a - d % basis 1` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[path_image; IN_IMAGE]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?q. simple_path q /\ pathstart q:complex = a - d % basis 1 /\ pathfinish q = a - d % basis 1 /\ path_image q = path_image p /\ (!z. z IN inside(path_image p) ==> winding_number(q,z) = winding_number(p,z))` MP_TAC THENL [EXISTS_TAC `shiftpath t (p:real^1->complex)` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH; DROP_VEC; SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_SHIFTPATH THEN ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` MP_TAC) THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN SUBGOAL_THEN `?z. z IN inside(path_image q) /\ norm(winding_number(q,z)) = &1` (fun th -> MESON_TAC[th]) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev o filter (fun tm -> not(free_in `t:real^1` (concl tm) || free_in `p:real^1->complex` (concl tm)))) THEN STRIP_TAC] THEN SUBGOAL_THEN `?t. t IN interval[vec 0,vec 1] /\ (q:real^1->complex) t = a + e % basis 1` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[path_image; IN_IMAGE]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(a - d % basis 1:complex = a + e % basis 1)` ASSUME_TAC THENL [REWRITE_TAC[VECTOR_ARITH `a - d % l:complex = a + e % l <=> (e + d) % l = vec 0`] THEN SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `path_image q INTER segment[a - d % basis 1,a + e % basis 1] = {a - d % basis 1:complex,a + e % basis 1}` ASSUME_TAC THENL [REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN MATCH_MP_TAC(SET_RULE `a IN p /\ b IN p /\ p INTER s = {} ==> p INTER (s UNION {a,b}) = {a,b}`) THEN CONJ_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[path_image; IN_IMAGE]; ALL_TAC] THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL] THEN REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN t ==> ~(x IN s)`] THEN REWRITE_TAC[IN_SEGMENT; VECTOR_ARITH `(&1 - u) % (a - d % l) + u % (a + e % l):complex = a + (u * e - (&1 - u) * d) % l`] THEN X_GEN_TAC `y:complex` THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON [INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY] `x IN inside s ==> ~(x IN s)`) THEN ASM_CASES_TAC `&0 <= k * e - (&1 - k) * d` THENL [ALL_TAC; ONCE_REWRITE_TAC[VECTOR_ARITH `a + (s - t) % l:complex = a - (t - s) % l`]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `~(&0 <= a - b) ==> &0 <= b - a`] THEN REWRITE_TAC[REAL_ARITH `k * e - (&1 - k) * d < e <=> &0 < (&1 - k) * (d + e)`] THEN REWRITE_TAC[REAL_ARITH `(&1 - k) * d - k * e < d <=> &0 < k * (d + e)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`subpath t (vec 0) (q:real^1->complex)`; `a:complex`; `d:real`; `e:real`] lemma2) THEN ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_IMAGE_JOIN; PATHSTART_LINEPATH] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[pathstart]] THEN MATCH_MP_TAC SIMPLE_PATH_JOIN_LOOP THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[ARC_LINEPATH_EQ] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p INTER s = {a,b} ==> p' SUBSET p ==> p' INTER s SUBSET {b,a}`)) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL]]; DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`subpath (vec 0) t (q:real^1->complex)`; `subpath (vec 1) t (q:real^1->complex)`; `linepath(a - d % basis 1:complex,a + e % basis 1)`; `a - d % basis 1:complex`; `a + e % basis 1:complex`; `z:complex`; `--winding_number (subpath t (vec 0) q ++ linepath (a - d % basis 1,a + e % basis 1),z)`] WINDING_NUMBER_FROM_INNERPATH) THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[REVERSEPATH_SUBPATH; REVERSEPATH_LINEPATH] THEN SUBGOAL_THEN `path_image (subpath (vec 0) t q) UNION path_image (subpath (vec 1) t q) :complex->bool = path_image q` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN REWRITE_TAC[REVERSEPATH_SUBPATH] THEN SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_UNION; PATH_IMAGE_REVERSEPATH] THEN SUBGOAL_THEN `interval[vec 0:real^1,t] UNION interval[t,vec 1] = interval[vec 0,vec 1]` (fun th -> ASM_REWRITE_TAC[th; GSYM path_image]) THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN REPLICATE_TAC 2 (ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[SIMPLE_PATH_LINEPATH_EQ; PATH_IMAGE_LINEPATH] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN REWRITE_TAC[REVERSEPATH_SUBPATH] THEN SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `a IN s /\ a IN t /\ b IN s /\ b IN t /\ (!x. x IN s ==> !y. y IN t ==> x = y ==> x = a \/ x = b) ==> s INTER t = {a,b}`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `t:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `t:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN X_GEN_TAC `s:real^1` THEN STRIP_TAC THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`s:real^1`; `u:real^1`] o CONJUNCT2) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (REPEAT_TCL CONJUNCTS_THEN SUBST_ALL_TAC)) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `drop u = drop t` MP_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ]]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p INTER s = {a,b} ==> a IN q /\ b IN q /\ q SUBSET p ==> q INTER s = {a,b}`)) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN CONJ_TAC THENL [EXISTS_TAC `vec 0:real^1`; EXISTS_TAC `t:real^1`] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p INTER s = {a,b} ==> a IN q /\ b IN q /\ q SUBSET p ==> q INTER s = {a,b}`)) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL] THEN ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN REWRITE_TAC[REVERSEPATH_SUBPATH] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN CONJ_TAC THENL [EXISTS_TAC `vec 1:real^1`; EXISTS_TAC `t:real^1`] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; NORM_ARITH `dist(a - d:complex,a) = norm(d)`; NORM_ARITH `dist(a:complex,a + e) = norm e`] THEN ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[PATH_IMAGE_LINEPATH]) THEN ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]; W(MP_TAC o PART_MATCH (rand o rand) WINDING_NUMBER_REVERSEPATH o rand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_IMAGE_JOIN; PATH_LINEPATH; SIMPLE_PATH_IMP_PATH; PATHSTART_LINEPATH; PATHFINISH_SUBPATH; PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH; REVERSEPATH_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_LINEPATH] THEN MATCH_MP_TAC(MESON[COMPLEX_ADD_SYM] `winding_number(g ++ h,z) = winding_number(g,z) + winding_number(h,z) /\ winding_number(h ++ g,z) = winding_number(h,z) + winding_number(g,z) ==> winding_number(g ++ h,z) =winding_number(h ++ g,z)`) THEN CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_JOIN THEN ASM_SIMP_TAC[PATH_LINEPATH; PATH_SUBPATH; PATH_SUBPATH; SIMPLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN REWRITE_TAC[SET_RULE `~(z IN s) /\ ~(z IN t) <=> ~(z IN s UNION t)`] THEN ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN REWRITE_TAC[REVERSEPATH_LINEPATH; REVERSEPATH_SUBPATH] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]]; REWRITE_TAC[COMPLEX_NEG_EQ_0] THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE [COMPLEX_NORM_CX; REAL_OF_NUM_EQ; REAL_ABS_NUM; ARITH]) THEN FIRST_X_ASSUM CONTR_TAC]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[COMPLEX_RING `a:complex = --b <=> --a = b`] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN RULE_ASSUM_TAC(REWRITE_RULE[NORM_NEG])] THEN EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `winding_number(subpath (vec 0) t q ++ subpath t (vec 1) q,z) = winding_number(subpath (vec 0) (vec 1) q,z)` (fun th -> ASM_MESON_TAC[th; SUBPATH_TRIVIAL]) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(subpath (vec 0) t q,z) + winding_number(subpath t (vec 1) q,z)` THEN CONJ_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_JOIN THEN ASM_SIMP_TAC[PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL; SIMPLE_PATH_IMP_PATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN SUBGOAL_THEN `~((z:complex) IN path_image q)` MP_TAC THENL [ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; MATCH_MP_TAC(SET_RULE `s1 SUBSET s /\ s2 SUBSET s ==> ~(z IN s) ==> ~(z IN s1) /\ ~(z IN s2)`) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; ENDS_IN_UNIT_INTERVAL; SIMPLE_PATH_IMP_PATH]]; MATCH_MP_TAC WINDING_NUMBER_SUBPATH_COMBINE THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; GSYM IN_INTERVAL_1] THEN ASM_SIMP_TAC[UNIT_INTERVAL_NONEMPTY; SIMPLE_PATH_IMP_PATH] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]]) in GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `pathfinish g:complex = pathstart g` THENL [ALL_TAC; ASM_MESON_TAC[INSIDE_SIMPLE_CURVE_IMP_CLOSED]] THEN MATCH_MP_TAC(MESON[] `(?k. !z. z IN s ==> f z = k) /\ (?z. z IN s /\ (f z = a \/ f z = b)) ==> (!z. z IN s ==> f z = a) \/ (!z. z IN s ==> f z = b)`) THEN CONJ_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_CONSTANT THEN ASM_SIMP_TAC[INSIDE_NO_OVERLAP; SIMPLE_PATH_IMP_PATH] THEN ASM_SIMP_TAC[JORDAN_INSIDE_OUTSIDE]; MP_TAC(SPEC `g:real^1->complex` lemma3) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] INTEGER_WINDING_NUMBER) THEN ANTS_TAC THENL [ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; SIMP_TAC[complex_integer; COMPLEX_EQ; IM_NEG; IM_CX] THEN SIMP_TAC[GSYM real; REAL_NORM; RE_NEG; RE_CX] THEN REAL_ARITH_TAC]]);; let SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE = prove (`!g z. simple_path g /\ z IN inside(path_image g) ==> abs(Re(winding_number(g,z))) = &1`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE) THEN ASM_SIMP_TAC[RE_NEG; RE_CX; REAL_ABS_NUM; REAL_ABS_NEG]);; let SIMPLE_CLOSED_PATH_NORM_WINDING_NUMBER_INSIDE = prove (`!g z. simple_path g /\ z IN inside(path_image g) ==> norm(winding_number(g,z)) = &1`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `pathfinish g:complex = pathstart g` ASSUME_TAC THENL [ASM_MESON_TAC[INSIDE_SIMPLE_CURVE_IMP_CLOSED]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] INTEGER_WINDING_NUMBER) THEN ANTS_TAC THENL [ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; ASM_SIMP_TAC[complex_integer; GSYM real; REAL_NORM; SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE]]);; let SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES = prove (`!g z. simple_path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) ==> winding_number(g,z) IN {--Cx(&1),Cx(&0),Cx(&1)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `path_image g:complex->bool` INSIDE_UNION_OUTSIDE) THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_UNION] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN ASM_SIMP_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE; SIMPLE_PATH_IMP_PATH] THEN ASM_MESON_TAC[SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE]);; let SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS = prove (`!g z. simple_path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) /\ &0 < Re(winding_number(g,z)) ==> winding_number(g,z) = Cx(&1)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES) THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN UNDISCH_TAC `&0 < Re(winding_number(g,z))` THEN ASM_REWRITE_TAC[RE_NEG; RE_CX] THEN REAL_ARITH_TAC);; let SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO = prove (`!s g z. simply_connected s /\ path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ ~(z IN s) ==> winding_number(g,z) = Cx(&0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(linepath(pathstart g,pathstart g),z)` THEN CONJ_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN EXISTS_TAC `pathstart(g:real^1->complex)` THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [simply_connected]) THEN ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; INSERT_SUBSET; EMPTY_SUBSET]; MATCH_MP_TAC WINDING_NUMBER_TRIVIAL] THEN MP_TAC(ISPEC `g:real^1->complex` PATHSTART_IN_PATH_IMAGE) THEN ASM SET_TAC[]);; let NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO = prove (`!s. ~(?z. ~(z IN s) /\ bounded(connected_component ((:complex) DIFF s) z)) ==> !g z. path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ ~(z IN s) ==> winding_number(g,z) = Cx(&0)`, REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_ZERO_IN_OUTSIDE THEN ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);; let NO_BOUNDED_PATH_COMPONENT_IMP_WINDING_NUMBER_ZERO = prove (`!s. ~(?z. ~(z IN s) /\ bounded(path_component ((:complex) DIFF s) z)) ==> !g z. path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ ~(z IN s) ==> winding_number(g,z) = Cx(&0)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO THEN ASM_MESON_TAC[PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; BOUNDED_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Partial circle path. *) (* ------------------------------------------------------------------------- *) let partcirclepath = new_definition `partcirclepath(z,r,s,t) = \x. z + Cx(r) * cexp(ii * linepath(Cx(s),Cx(t)) x)`;; let PATHSTART_PARTCIRCLEPATH = prove (`!r z s t. pathstart(partcirclepath(z,r,s,t)) = z + Cx(r) * cexp(ii * Cx(s))`, REWRITE_TAC[pathstart; partcirclepath; REWRITE_RULE[pathstart] PATHSTART_LINEPATH]);; let PATHFINISH_PARTCIRCLEPATH = prove (`!r z s t. pathfinish(partcirclepath(z,r,s,t)) = z + Cx(r) * cexp(ii * Cx(t))`, REWRITE_TAC[pathfinish; partcirclepath; REWRITE_RULE[pathfinish] PATHFINISH_LINEPATH]);; let HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH = prove (`!z r s t x. ((partcirclepath(z,r,s,t)) has_vector_derivative (ii * Cx(r) * (Cx t - Cx s) * cexp(ii * linepath(Cx(s),Cx(t)) x))) (at x)`, REWRITE_TAC[partcirclepath; linepath; COMPLEX_CMUL; CX_SUB] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; let VECTOR_DERIVATIVE_PARTCIRCLEPATH = prove (`!z r s t x. vector_derivative (partcirclepath(z,r,s,t)) (at x) = ii * Cx(r) * (Cx t - Cx s) * cexp(ii * linepath(Cx(s),Cx(t)) x)`, REPEAT GEN_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH]);; let VALID_PATH_PARTCIRCLEPATH = prove (`!z r s t. valid_path(partcirclepath(z,r,s,t))`, REPEAT GEN_TAC THEN REWRITE_TAC[valid_path] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN REWRITE_TAC[differentiable_on] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN REWRITE_TAC[VECTOR_DERIVATIVE_WORKS; VECTOR_DERIVATIVE_PARTCIRCLEPATH; HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH]);; let PATH_PARTCIRCLEPATH = prove (`!z r s t. path(partcirclepath(z,r,s,t))`, SIMP_TAC[VALID_PATH_PARTCIRCLEPATH; VALID_PATH_IMP_PATH]);; let PATH_IMAGE_PARTCIRCLEPATH = prove (`!z r s t. &0 <= r /\ s <= t ==> path_image(partcirclepath(z,r,s,t)) = {z + Cx(r) * cexp(ii * Cx x) | s <= x /\ x <= t}`, REPEAT STRIP_TAC THEN REWRITE_TAC[path_image; partcirclepath] THEN REWRITE_TAC[EXTENSION; TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`] THEN REWRITE_TAC[FORALL_AND_THM; FORALL_IN_IMAGE; IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_TAC THEN EXISTS_TAC `(&1 - drop x) * s + drop x * t` THEN REWRITE_TAC[linepath; CX_ADD; CX_SUB; COMPLEX_CMUL; CX_MUL] THEN REWRITE_TAC[REAL_ARITH `s <= (&1 - x) * s + x * t <=> &0 <= x * (t - s)`; REAL_ARITH `(&1 - x) * s + x * t <= t <=> &0 <= (&1 - x) * (t - s)`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_CASES_TAC `s:real < t` THENL [EXISTS_TAC `lift((x - s) / (t - s))` THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT; LIFT_DROP; DROP_VEC; linepath; REAL_MUL_LZERO; REAL_MUL_LID; REAL_SUB_LE; REAL_ARITH `x - s:real <= t - s <=> x <= t`] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_CMUL; CX_SUB; CX_DIV] THEN SUBGOAL_THEN `~(Cx(s) = Cx(t))` MP_TAC THENL [ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NE]; CONV_TAC COMPLEX_FIELD]; UNDISCH_TAC `s:real <= t` THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN SUBST_ALL_TAC THEN EXISTS_TAC `vec 0:real^1` THEN SIMP_TAC[IN_INTERVAL_1; DROP_VEC; linepath; VECTOR_MUL_LZERO; REAL_SUB_RZERO; VECTOR_MUL_LID; VECTOR_ADD_RID; REAL_POS] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CX_INJ] THEN ASM_REAL_ARITH_TAC]);; let PATH_IMAGE_PARTCIRCLEPATH_SUBSET_ABS = prove (`!z r s t. path_image(partcirclepath(z,r,s,t)) SUBSET sphere(z,abs r)`, REPEAT GEN_TAC THEN REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[partcirclepath; IN_SPHERE] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[NORM_ARITH `dist(z,z + x) = norm x`; COMPLEX_NORM_MUL] THEN REWRITE_TAC[NORM_CEXP; RE_MUL_II; IM_LINEPATH_CX; REAL_NEG_0] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_EXP_0] THEN REAL_ARITH_TAC);; let PATH_IMAGE_PARTCIRCLEPATH_SUBSET = prove (`!z r s t. &0 <= r ==> path_image(partcirclepath(z,r,s,t)) SUBSET sphere(z,r)`, MESON_TAC[PATH_IMAGE_PARTCIRCLEPATH_SUBSET_ABS; real_abs]);; let IN_PATH_IMAGE_PARTCIRCLEPATH = prove (`!z r s t w. &0 <= r /\ w IN path_image(partcirclepath(z,r,s,t)) ==> norm(w - z) = r`, MP_TAC PATH_IMAGE_PARTCIRCLEPATH_SUBSET THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[SUBSET; IN_SPHERE; dist; NORM_SUB] THEN SET_TAC[]);; let RECTIFIABLE_PATH_PARTCIRCLEPATH,PATH_LENGTH_PARTCIRCLEPATH = let lemma = prove (`(partcirclepath (z,r,s,t) has_vector_derivative ii * Cx(t - s) * partcirclepath (Cx(&0),r,s,t) u) (at u)`, REWRITE_TAC[partcirclepath; linepath; COMPLEX_CMUL; CX_SUB] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[CX_MUL; CX_SUB; CX_ADD] THEN CONV_TAC COMPLEX_RING) in let RECTIFIABLE_PATH_PARTCIRCLEPATH = prove (`!z r s t. rectifiable_path(partcirclepath(z,r,s,t))`, REPEAT GEN_TAC THEN REWRITE_TAC[rectifiable_path; PATH_PARTCIRCLEPATH] THEN MATCH_MP_TAC HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_HAS_BOUNDED_VARIATION_ON THEN EXISTS_TAC `\x. ii * Cx(t - s) * partcirclepath (Cx(&0),r,s,t) x` THEN SIMP_TAC[lemma; HAS_VECTOR_DERIVATIVE_AT_WITHIN] THEN REWRITE_TAC[CONVEX_INTERVAL; BOUNDED_INTERVAL] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_INTERVAL] THEN REPLICATE_TAC 2 (MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL) THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE THEN REWRITE_TAC[ETA_AX] THEN MESON_TAC[lemma]) in let PATH_LENGTH_PARTCIRCLEPATH = prove (`!z r s t. path_length(partcirclepath(z,r,s,t)) = abs(r * (t - s))`, SIMP_TAC[PATH_LENGTH_VALID_PATH; VALID_PATH_PARTCIRCLEPATH; RECTIFIABLE_PATH_PARTCIRCLEPATH] THEN REWRITE_TAC[MATCH_MP HAS_VECTOR_DERIVATIVE_UNIQUE_AT lemma] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_II; partcirclepath; COMPLEX_ADD_LID; COMPLEX_NORM_CX; NORM_CEXP] THEN REWRITE_TAC[RE_MUL_II; linepath; IM_CMUL; IM_ADD; IM_CX] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_LID; REAL_ADD_RID] THEN REWRITE_TAC[REAL_EXP_0; REAL_NEG_0; REAL_MUL_RID] THEN REWRITE_TAC[INTEGRAL_CONST; CONTENT_UNIT; VECTOR_MUL_LID; LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_MUL_SYM]) in RECTIFIABLE_PATH_PARTCIRCLEPATH,PATH_LENGTH_PARTCIRCLEPATH;; let HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG = prove (`!f i z r s t B k. FINITE k /\ (f has_path_integral i) (partcirclepath(z,r,s,t)) /\ &0 <= B /\ &0 < r /\ s <= t /\ (!x. x IN path_image(partcirclepath(z,r,s,t)) DIFF k ==> norm(f x) <= B) ==> norm(i) <= B * r * (t - s)`, let lemma1 = prove (`!b w. FINITE {z | norm(z) <= b /\ cexp(z) = w}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[CEXP_NZ; SET_RULE `{x | F} = {}`; FINITE_RULES] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CEXP_CLOG) THEN REWRITE_TAC[CEXP_EQ] THEN REWRITE_TAC[SET_RULE `{z | P z /\ ?n. Q n /\ z = f n} = IMAGE f {n | Q n /\ P(f n)}`] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{n | integer n /\ norm(Cx(&2 * n * pi) * ii) <= b + norm(clog w)}` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUBSET; IN_ELIM_THM] THEN NORM_ARITH_TAC] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN REWRITE_TAC[REAL_MUL_RID; REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI] THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_LE_RDIV_EQ; PI_POS] THEN REWRITE_TAC[REAL_ARITH `&2 * x <= a <=> x <= a / &2`] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG]) in let lemma2 = prove (`!a b. ~(a = Cx(&0)) ==> FINITE {z | norm(z) <= b /\ cexp(a * z) = w}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\z. z / a) {z | norm(z) <= b * norm(a) /\ cexp(z) = w}` THEN SIMP_TAC[lemma1; FINITE_IMAGE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(a = Cx(&0)) ==> (x = y / a <=> a * x = y)`; UNWIND_THM1; COMPLEX_NORM_MUL; REAL_LE_LMUL; NORM_POS_LE]) in REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL] THEN STRIP_TAC THEN MP_TAC(ASSUME `s <= t`) THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL [ALL_TAC; FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH] THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN SIMP_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0_EQ; NORM_0] THEN REAL_ARITH_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[GSYM CONTENT_UNIT_1] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN EXISTS_TAC `\x. if (partcirclepath(z,r,s,t) x) IN k then Cx(&0) else f(partcirclepath(z,r,s,t) x) * vector_derivative (partcirclepath(z,r,s,t)) (at x)` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; REAL_SUB_LE]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `\x. f(partcirclepath(z,r,s,t) x) * vector_derivative (partcirclepath(z,r,s,t)) (at x)` THEN EXISTS_TAC `{x | x IN interval[vec 0,vec 1] /\ (partcirclepath(z,r,s,t) x) IN k}` THEN ASM_SIMP_TAC[IN_DIFF; IN_ELIM_THM; IMP_CONJ] THEN MATCH_MP_TAC NEGLIGIBLE_FINITE THEN MATCH_MP_TAC FINITE_FINITE_PREIMAGE_GENERAL THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:complex` THEN DISCH_TAC THEN REWRITE_TAC[partcirclepath] THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD `~(r = Cx(&0)) ==> (z + r * e = y <=> e = (y - z) / r)`] THEN REWRITE_TAC[linepath; COMPLEX_CMUL] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_ADD] THEN REWRITE_TAC[REAL_ARITH `(&1 - t) * x + t * y = x + t * (y - x)`] THEN REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(e = Cx(&0)) ==> (e * x = y <=> x = y / e)`] THEN ABBREV_TAC `w = (y - z) / Cx r / cexp(ii * Cx s)` THEN REWRITE_TAC[CX_MUL; COMPLEX_RING `ii * Cx x * Cx(t - s) = (ii * Cx(t - s)) * Cx x`] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x | Cx(drop x) IN {z | norm(z) <= &1 /\ cexp((ii * Cx(t - s)) * z) = w}}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE_INJ THEN REWRITE_TAC[CX_INJ; DROP_EQ] THEN MATCH_MP_TAC lemma2 THEN REWRITE_TAC[COMPLEX_RING `ii * x = Cx(&0) <=> x = Cx(&0)`] THEN ASM_SIMP_TAC[CX_INJ; REAL_SUB_0; REAL_LT_IMP_NE]; SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN SIMP_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN REWRITE_TAC[NORM_CEXP; RE_MUL_II; IM_LINEPATH_CX] THEN REWRITE_TAC[REAL_EXP_0; REAL_NEG_0; REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; GSYM CX_SUB; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC);; let HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH = prove (`!f i z r s t B. (f has_path_integral i) (partcirclepath(z,r,s,t)) /\ &0 <= B /\ &0 < r /\ s <= t /\ (!x. x IN path_image(partcirclepath(z,r,s,t)) ==> norm(f x) <= B) ==> norm(i) <= B * r * (t - s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `z:complex`; `{}:complex->bool`] THEN ASM_REWRITE_TAC[FINITE_RULES; IN_DIFF; NOT_IN_EMPTY]);; let PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH = prove (`!f z r s t. f continuous_on path_image(partcirclepath(z,r,s,t)) ==> f path_integrable_on (partcirclepath(z,r,s,t))`, REPEAT GEN_TAC THEN REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL] THEN REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH; GSYM integrable_on] THEN DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[GSYM path_image; ETA_AX] THEN MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON THEN ASM_REWRITE_TAC[GSYM valid_path; VALID_PATH_PARTCIRCLEPATH]; ALL_TAC] THEN REWRITE_TAC[linepath] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN REWRITE_TAC[VECTOR_ARITH `(&1 - x) % s + x % t = s + x % (t - s)`] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; COMPLEX_CMUL; CX_MUL; CX_SUB] THEN CONV_TAC COMPLEX_RING);; let WINDING_NUMBER_PARTCIRCLEPATH_POS_LT = prove (`!r z s t w. s < t /\ norm(w - z) < r ==> &0 < Re(winding_number(partcirclepath(z,r,s,t),w))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_POS_LT THEN EXISTS_TAC `r * (t - s) * (r - norm(w - z:complex))` THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `n < r ==> &0 <= n ==> &0 < r`)) THEN REWRITE_TAC[NORM_POS_LE] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT; VALID_PATH_PARTCIRCLEPATH] THEN ASM_REWRITE_TAC[VALID_PATH_PARTCIRCLEPATH] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_PATH_IMAGE_PARTCIRCLEPATH; REAL_LT_IMP_LE; REAL_LT_REFL]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH] THEN REWRITE_TAC[partcirclepath] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; IM_MUL_II; RE_MUL_CX; GSYM CX_SUB] THEN REWRITE_TAC[CNJ_ADD; CNJ_SUB; CNJ_MUL; CNJ_CX] THEN REWRITE_TAC[COMPLEX_RING `c * ((z + r * c') - w):complex = r * c * c' - c * (w - z)`] THEN REWRITE_TAC[COMPLEX_MUL_CNJ; NORM_CEXP; RE_MUL_II] THEN REWRITE_TAC[IM_LINEPATH_CX; REAL_NEG_0; REAL_EXP_0; COMPLEX_MUL_RID; COMPLEX_POW_2] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_SUB_LT; RE_SUB; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `norm(x) <= norm(y) /\ abs(Re(x)) <= norm(x) ==> r - norm(y) <= r - Re x`) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; RE_MUL_II; IM_LINEPATH_CX] THEN REWRITE_TAC[REAL_EXP_0; REAL_NEG_0; REAL_MUL_LID; GSYM CNJ_SUB] THEN REWRITE_TAC[COMPLEX_NORM_CNJ; REAL_LE_REFL]);; let SIMPLE_PATH_PARTCIRCLEPATH = prove (`!z r s t. simple_path(partcirclepath(z,r,s,t)) <=> ~(r = &0) /\ ~(s = t) /\ abs(s - t) <= &2 * pi`, let lemma = prove (`(!x y. (&0 <= x /\ x <= &1) /\ (&0 <= y /\ y <= &1) ==> P(abs(x - y))) <=> (!x. &0 <= x /\ x <= &1 ==> P x)`, MESON_TAC[REAL_ARITH `(&0 <= x /\ x <= &1) /\ (&0 <= y /\ y <= &1) ==> &0 <= abs(x - y) /\ abs(x - y) <= &1`; REAL_ARITH `&0 <= &0 /\ &0 <= &1`; REAL_ARITH `(&0 <= x ==> abs(x - &0) = x)`]) in REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; PATH_PARTCIRCLEPATH] THEN REWRITE_TAC[partcirclepath] THEN SIMP_TAC[COMPLEX_RING `z + r * x = z + r * y <=> r * (x - y) = Cx(&0)`] THEN REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ] THEN ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &3)`; `lift(&1 / &2)`]) THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ASM_CASES_TAC `s:real = t` THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &3)`; `lift(&1 / &2)`]) THEN REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - t) % x + t % x = x`] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_SUB_0]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_SUB_0; CEXP_EQ] THEN REWRITE_TAC[COMPLEX_RING `ii * x = ii * y + z * ii <=> ii * (x - (y + z)) = Cx(&0)`] THEN REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; LINEPATH_CX] THEN REWRITE_TAC[GSYM CX_SUB; GSYM CX_ADD; CX_INJ] THEN REWRITE_TAC[REAL_ARITH `((&1 - x) * s + x * t) - (((&1 - y) * s + y * t) + z) = &0 <=> (x - y) * (t - s) = z`] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; IN_INTERVAL_1] THEN SIMP_TAC[REAL_ARITH `&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 ==> (x = y \/ x = &0 /\ y = &1 \/ x = &1 /\ y = &0 <=> abs(x - y) = &0 \/ abs(x - y) = &1)`] THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> (x = &2 * n * pi <=> n = x / (&2 * pi))`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM2] THEN ONCE_REWRITE_TAC[GSYM INTEGER_ABS] THEN REWRITE_TAC[GSYM FORALL_DROP; REAL_ABS_MUL; REAL_ABS_DIV] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_PI] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] THEN REWRITE_TAC[lemma] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `(&2 * pi) / abs(t - s)`) THEN ASM_SIMP_TAC[REAL_ABS_SUB; REAL_FIELD `~(s = t) ==> x / abs(s - t) * abs(s - t) = x`] THEN ASM_SIMP_TAC[PI_POS; INTEGER_CLOSED; REAL_FIELD `&0 < pi ==> (&2 * pi) / (&2 * pi) = &1`] THEN ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_SUB_0] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; DISCH_TAC THEN X_GEN_TAC `x:real` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] REAL_ABS_INTEGER_LEMMA)) THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_NUM; REAL_ABS_PI] THEN SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN ASM_REWRITE_TAC[REAL_ENTIRE; REAL_MUL_LID; REAL_ARITH `abs(t - s) = &0 <=> s = t`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `p <= x * abs(s - t) ==> abs(s - t) <= p ==> &1 * abs(s - t) <= x * abs(s - t)`)) THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; GSYM REAL_ABS_NZ; REAL_SUB_0] THEN ASM_REAL_ARITH_TAC]);; let ARC_PARTCIRCLEPATH = prove (`!z r s t. ~(r = &0) /\ ~(s = t) /\ abs(s - t) < &2 * pi ==> arc(partcirclepath(z,r,s,t))`, REPEAT STRIP_TAC THEN REWRITE_TAC[arc; PATH_PARTCIRCLEPATH] THEN REWRITE_TAC[partcirclepath] THEN SIMP_TAC[COMPLEX_RING `z + r * x = z + r * y <=> r * (x - y) = Cx(&0)`] THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ] THEN REWRITE_TAC[COMPLEX_SUB_0; CEXP_EQ] THEN REWRITE_TAC[COMPLEX_RING `ii * x = ii * y + z * ii <=> ii * (x - (y + z)) = Cx(&0)`] THEN REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; LINEPATH_CX] THEN REWRITE_TAC[GSYM CX_SUB; GSYM CX_ADD; CX_INJ] THEN REWRITE_TAC[REAL_ARITH `((&1 - x) * s + x * t) - (((&1 - y) * s + y * t) + z) = &0 <=> (x - y) * (t - s) = z`] THEN REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `n:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ENTIRE; REAL_SUB_0; DROP_EQ] THEN MP_TAC(SPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(REAL_ARITH `abs x < abs y ==> ~(x = y)`) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 * &2 * pi` THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[REAL_ARITH `&2 * n * pi = n * &2 * pi`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1 * abs(t - s)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_MUL_LID] THEN ASM_MESON_TAC[REAL_ABS_SUB]] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);; let WINDING_NUMBER_PARTCIRCLEPATH = prove (`!z r s t. ~(r = &0) ==> winding_number (partcirclepath(z,r,s,t),z) = Cx((t - s) / (&2 * pi))`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_VALID_PATH o lhand o snd) THEN REWRITE_TAC[VALID_PATH_PARTCIRCLEPATH] THEN ANTS_TAC THENL [MATCH_MP_TAC(SET_RULE `!s. ~(z IN s) /\ t SUBSET s ==> ~(z IN t)`) THEN EXISTS_TAC `sphere(z:complex,abs r)` THEN ASM_REWRITE_TAC[PATH_IMAGE_PARTCIRCLEPATH_SUBSET_ABS; IN_SPHERE] THEN POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[complex_div; CX_DIV; CX_MUL; COMPLEX_INV_MUL] THEN MATCH_MP_TAC(COMPLEX_FIELD `i = ii * ts ==> (Cx(&1) * inv(Cx(&2)) * p * inv ii) * i = ts * inv(Cx(&2)) * p`) THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_PATH_INTEGRAL; VECTOR_DERIVATIVE_PARTCIRCLEPATH] THEN REWRITE_TAC[partcirclepath; COMPLEX_ADD_SUB] THEN ASM_SIMP_TAC[CEXP_NZ; CX_INJ; CX_SUB; COMPLEX_FIELD `~(r = Cx(&0)) /\ ~(e = Cx(&0)) ==> (Cx(&1) * inv(r * e)) * ii * r * ts * e = ii * ts`] THEN MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`; `ii * (Cx t - Cx s)`] HAS_INTEGRAL_CONST) THEN SIMP_TAC[CONTENT_1; DROP_VEC; REAL_POS; REAL_SUB_RZERO; VECTOR_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Special case of one complete circle. *) (* ------------------------------------------------------------------------- *) let circlepath = new_definition `circlepath(z,r) = partcirclepath(z,r,&0,&2 * pi)`;; let CIRCLEPATH = prove (`circlepath(z,r) = \x. z + Cx(r) * cexp(Cx(&2) * Cx pi * ii * Cx(drop x))`, REWRITE_TAC[circlepath; partcirclepath; linepath; COMPLEX_CMUL] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN REWRITE_TAC[CX_MUL; COMPLEX_MUL_AC]);; let PATH_CIRCLEPATH = prove (`!z r. path(circlepath(z,r))`, REWRITE_TAC[circlepath; PATH_PARTCIRCLEPATH]);; let PATHSTART_CIRCLEPATH = prove (`!r z. pathstart(circlepath(z,r)) = z + Cx(r)`, REWRITE_TAC[circlepath; PATHSTART_PARTCIRCLEPATH] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_MUL_RID]);; let PATHFINISH_CIRCLEPATH = prove (`!r z. pathfinish(circlepath(z,r)) = z + Cx(r)`, REWRITE_TAC[circlepath; PATHFINISH_PARTCIRCLEPATH] THEN REWRITE_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN] THEN REWRITE_TAC[SIN_NPI; COS_NPI; REAL_POW_NEG; ARITH; REAL_POW_ONE] THEN CONV_TAC COMPLEX_RING);; let HAS_VECTOR_DERIVATIVE_CIRCLEPATH = prove (`((circlepath (z,r)) has_vector_derivative (Cx(&2) * Cx(pi) * ii * Cx(r) * cexp(Cx(&2) * Cx pi * ii * Cx(drop x)))) (at x)`, REWRITE_TAC[CIRCLEPATH] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; let VECTOR_DERIVATIVE_CIRCLEPATH = prove (`vector_derivative (circlepath (z,r)) (at x) = Cx(&2) * Cx(pi) * ii * Cx(r) * cexp(Cx(&2) * Cx pi * ii * Cx(drop x))`, MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CIRCLEPATH]);; let VALID_PATH_CIRCLEPATH = prove (`!z r. valid_path (circlepath(z,r))`, REWRITE_TAC[circlepath; VALID_PATH_PARTCIRCLEPATH]);; let RECTIFIABLE_PATH_CIRCLEPATH = prove (`!z r. rectifiable_path(circlepath(z,r))`, REWRITE_TAC[circlepath; RECTIFIABLE_PATH_PARTCIRCLEPATH]);; let PATH_LENGTH_CIRCLEPATH = prove (`!z r. path_length(circlepath(z,r)) = &2 * pi * abs r`, REWRITE_TAC[circlepath; PATH_LENGTH_PARTCIRCLEPATH] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_SUB_RZERO; REAL_ABS_NUM; REAL_ABS_PI] THEN REWRITE_TAC[REAL_MUL_AC]);; let SHIFTPATH_CIRCLEPATH = prove (`!a z r. shiftpath a (circlepath(z,r)) = partcirclepath(z,r,&2 * pi * drop a,&2 * pi * (drop a + &1))`, REWRITE_TAC[FUN_EQ_THM; circlepath] THEN REPEAT GEN_TAC THEN REWRITE_TAC[shiftpath; partcirclepath] THEN COND_CASES_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[linepath; COMPLEX_CMUL; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN REWRITE_TAC[CX_MUL; DROP_ADD; DROP_SUB; DROP_VEC; CX_ADD; CX_SUB] THEN REWRITE_TAC[COMPLEX_RING `(Cx(&1) - x) * t * p * a + x * t * p * (a + Cx(&1)) = (a + x) * t * p`] THEN REWRITE_TAC[COMPLEX_RING `a + x - Cx(&1) = (a + x) - Cx(&1)`] THEN REWRITE_TAC[COMPLEX_SUB_RDISTRIB; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN MATCH_MP_TAC(COMPLEX_FIELD `y = Cx(&1) ==> x / y = x`) THEN MP_TAC(ISPEC `&1:real` CEXP_INTEGER_2PI) THEN REWRITE_TAC[INTEGER_CLOSED; CX_MUL; COMPLEX_MUL_AC]);; let PATH_IMAGE_CIRCLEPATH = prove (`!z r. &0 <= r ==> path_image (circlepath(z,r)) = sphere(z,r)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CIRCLEPATH; path_image] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(w,z) = norm(z - w)`] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; COMPLEX_RING `(z + r) - z = r:complex`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[COMPLEX_RING `Cx(&2) * p * i * z = (Cx(&2) * p * z) * i`] THEN REWRITE_TAC[RE_MUL_II; GSYM CX_MUL; IM_CX] THEN REWRITE_TAC[REAL_EXP_NEG; REAL_EXP_0; REAL_MUL_RID; COMPLEX_NORM_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:complex` THEN DISCH_TAC THEN ABBREV_TAC `w:complex = x - z` THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (COMPLEX_RING `x - z = w:complex ==> x = z + w`)) THEN REWRITE_TAC[IN_IMAGE; COMPLEX_RING `z + a = z + b:complex <=> a = b`] THEN ASM_CASES_TAC `w = Cx(&0)` THENL [UNDISCH_THEN `norm(w:complex) = r` (MP_TAC o SYM) THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_ABS_ZERO] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_MUL_LZERO] THEN REWRITE_TAC[MEMBER_NOT_EMPTY; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN REWRITE_TAC[REAL_NOT_LT; REAL_POS]; ALL_TAC] THEN MP_TAC(SPECL [`Re(w / Cx(norm w))`; `Im(w / Cx(norm w))`] SINCOS_TOTAL_2PI) THEN REWRITE_TAC[GSYM COMPLEX_SQNORM] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_ONE; COMPLEX_NORM_ZERO] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `lift(t / (&2 * pi))` THEN ONCE_REWRITE_TAC[COMPLEX_RING `Cx(&2) * p * i * z = i * (Cx(&2) * p * z)`] THEN REWRITE_TAC[CEXP_EULER; LIFT_DROP; CX_DIV; CX_MUL] THEN ASM_SIMP_TAC[CX_PI_NZ; COMPLEX_FIELD `~(p = Cx(&0)) ==> Cx(&2) * p * t / (Cx(&2) * p) = t`] THEN ASM_REWRITE_TAC[GSYM CX_COS; GSYM CX_SIN] THEN CONJ_TAC THENL [REWRITE_TAC[complex_div; GSYM CX_INV] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `Re(w * Cx x) = Re(w) * x`; SIMPLE_COMPLEX_ARITH `Im(w * Cx x) = Im(w) * x`] THEN REWRITE_TAC[COMPLEX_ADD_LDISTRIB; GSYM CX_MUL] THEN SUBGOAL_THEN `!z:real. r * z * inv r = z` MP_TAC THENL [SUBGOAL_THEN `~(r = &0)` MP_TAC THENL [ALL_TAC; CONV_TAC REAL_FIELD] THEN ASM_MESON_TAC[COMPLEX_NORM_ZERO]; ONCE_REWRITE_TAC[COMPLEX_RING `t * ii * s = ii * t * s`] THEN SIMP_TAC[GSYM CX_MUL; GSYM COMPLEX_EXPAND]]; REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_MUL; PI_POS; REAL_OF_NUM_LT; ARITH] THEN ASM_REAL_ARITH_TAC]);; let HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH_STRONG = prove (`!f i z r B k. FINITE k /\ (f has_path_integral i) (circlepath(z,r)) /\ &0 <= B /\ &0 < r /\ (!x. norm(x - z) = r /\ ~(x IN k) ==> norm(f x) <= B) ==> norm(i) <= B * (&2 * pi * r)`, REWRITE_TAC[circlepath] THEN REPEAT STRIP_TAC THEN SUBST1_TAC(REAL_ARITH `B * (&2 * pi * r) = B * r * (&2 * pi - &0)`) THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `z:complex`; `k:complex->bool`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; PI_POS; IN_DIFF] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; GSYM circlepath; REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(w,z) = norm(z - w)`]);; let HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH = prove (`!f i z r B. (f has_path_integral i) (circlepath(z,r)) /\ &0 <= B /\ &0 < r /\ (!x. norm(x - z) = r ==> norm(f x) <= B) ==> norm(i) <= B * (&2 * pi * r)`, REWRITE_TAC[circlepath] THEN REPEAT STRIP_TAC THEN SUBST1_TAC(REAL_ARITH `B * (&2 * pi * r) = B * r * (&2 * pi - &0)`) THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `z:complex`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; PI_POS] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; GSYM circlepath; REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(w,z) = norm(z - w)`]);; let PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH = prove (`!f z r. f continuous_on path_image(circlepath(z,r)) ==> f path_integrable_on (circlepath(z,r))`, SIMP_TAC[PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH; circlepath]);; let SIMPLE_PATH_CIRCLEPATH = prove (`!z r. simple_path(circlepath(z,r)) <=> ~(r = &0)`, REWRITE_TAC[circlepath; SIMPLE_PATH_PARTCIRCLEPATH] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let WINDING_NUMBER_CIRCLEPATH = prove (`!z r w. norm(w - z) < r ==> winding_number(circlepath(z,r),w) = Cx(&1)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS THEN REWRITE_TAC[SIMPLE_PATH_CIRCLEPATH; PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH; CONJ_ASSOC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `n < r ==> (&0 <= n ==> &0 <= r /\ &0 < r) /\ n < r`)) THEN SIMP_TAC[NORM_POS_LE; PATH_IMAGE_CIRCLEPATH; IN_ELIM_THM] THEN ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(w,z) = norm(z - w)`] THEN REAL_ARITH_TAC; REWRITE_TAC[circlepath] THEN MATCH_MP_TAC WINDING_NUMBER_PARTCIRCLEPATH_POS_LT THEN ASM_SIMP_TAC[REAL_LT_MUL; PI_POS; REAL_OF_NUM_LT; ARITH]]);; (* ------------------------------------------------------------------------- *) (* We can also deduce this; it's pushed to this late point in the build *) (* just for the convenience of using "circlepath". *) (* ------------------------------------------------------------------------- *) let RECTIFIABLE_LOOP_RELATIVE_FRONTIER_CONVEX = prove (`!s:real^N->bool. bounded s /\ convex s /\ aff_dim s = &2 ==> ?g. simple_path g /\ rectifiable_path g /\ pathfinish g = pathstart g /\ path_image g = relative_frontier s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`cball(Cx(&0),&1)`; `s:real^N->bool`] BILIPSCHITZ_HOMEOMORPHISM_RELATIVE_FRONTIERS) THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN REWRITE_TAC[RELATIVE_FRONTIER_CBALL; DIMINDEX_2; homeomorphism] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:complex->real^N`; `g:real^N->complex`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN EXISTS_TAC `(f:complex->real^N) o circlepath(Cx(&0),&1)` THEN ASM_SIMP_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_CIRCLEPATH; REAL_POS] THEN REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE; PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH] THEN REWRITE_TAC[simple_path; rectifiable_path; o_THM] THEN ASM_SIMP_TAC[PATH_CONTINUOUS_IMAGE; PATH_IMAGE_CIRCLEPATH; REAL_POS; PATH_CIRCLEPATH] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(SPECL [`Cx(&0)`; `&1`] SIMPLE_PATH_CIRCLEPATH) THEN MP_TAC(SPECL [`Cx(&0)`; `&1`] PATH_IMAGE_CIRCLEPATH) THEN REWRITE_TAC[simple_path] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[path_image; EXTENSION; IN_IMAGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE THEN SIMP_TAC[GSYM path_image; PATH_IMAGE_CIRCLEPATH; REAL_POS] THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MP_TAC(SPECL [`Cx(&0)`; `&1`] RECTIFIABLE_PATH_CIRCLEPATH) THEN SIMP_TAC[rectifiable_path]]);; let RECTIFIABLE_LOOP_FRONTIER_CONVEX = prove (`!s:real^2->bool. bounded s /\ convex s /\ ~(interior s = {}) ==> ?g. simple_path g /\ rectifiable_path g /\ pathfinish g = pathstart g /\ path_image g = frontier s`, SIMP_TAC[GSYM RELATIVE_FRONTIER_NONEMPTY_INTERIOR] THEN SIMP_TAC[IMP_CONJ; GSYM AFF_DIM_NONEMPTY_INTERIOR_EQ; DIMINDEX_2] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[RECTIFIABLE_LOOP_RELATIVE_FRONTIER_CONVEX]);; let RECTIFIABLE_PATH_FRONTIER_CONVEX = prove (`!s:real^2->bool. bounded s /\ convex s /\ ~(s = {}) ==> ?g. rectifiable_path g /\ pathfinish g = pathstart g /\ path_image g = frontier s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FRONTIER_CLOSURE_CONVEX; GSYM COMPACT_CLOSURE] THEN SUBGOAL_THEN `compact(closure s:real^2->bool) /\ convex(closure s) /\ ~(closure s = {})` MP_TAC THENL [ASM_SIMP_TAC[CONVEX_CLOSURE; COMPACT_CLOSURE; CLOSURE_EQ_EMPTY]; POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`closure s:real^2->bool`,`s:real^2->bool`)] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `interior s:real^2->bool = {}` THENL [ALL_TAC; MP_TAC(SPEC `s:real^2->bool` RECTIFIABLE_LOOP_FRONTIER_CONVEX) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN MESON_TAC[]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_NONEMPTY_INTERIOR_EQ) THEN ASM_REWRITE_TAC[DIMINDEX_2] THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^2->bool` COMPACT_CONVEX_COLLINEAR_SEGMENT) THEN ASM_REWRITE_TAC[COLLINEAR_AFF_DIM; INT_ARITH `x:int <= &1 <=> x < &2`] THEN ASM_REWRITE_TAC[INT_LT_LE] THEN REWRITE_TAC[GSYM DIMINDEX_2] THEN REWRITE_TAC[AFF_DIM_LE_UNIV; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^2`; `b:real^2`] THEN STRIP_TAC THEN EXISTS_TAC `linepath(a:real^2,b) ++ linepath(b,a)` THEN SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; RECTIFIABLE_PATH_JOIN; RECTIFIABLE_PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; FRONTIER_SEGMENT] THEN REWRITE_TAC[SEGMENT_SYM; DIMINDEX_2; LE_REFL; UNION_IDEMPOT]);; (* ------------------------------------------------------------------------- *) (* Hence the Cauchy formula for points inside a circle. *) (* ------------------------------------------------------------------------- *) let CAUCHY_INTEGRAL_CIRCLEPATH = prove (`!f z r w. f continuous_on cball(z,r) /\ f holomorphic_on ball(z,r) /\ w IN ball(z,r) ==> ((\u. f(u) / (u - w)) has_path_integral (Cx(&2) * Cx(pi) * ii * f(w))) (circlepath(z,r))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `cball(z:complex,r)`; `{}:complex->bool`; `circlepath(z,r)`; `w:complex`] CAUCHY_INTEGRAL_FORMULA_WEAK) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN ASM_SIMP_TAC[WINDING_NUMBER_CIRCLEPATH; COMPLEX_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[VALID_PATH_CIRCLEPATH; PATHSTART_CIRCLEPATH; FINITE_RULES; PATHFINISH_CIRCLEPATH; CONVEX_CBALL; INTERIOR_CBALL; DIFF_EMPTY] THEN REWRITE_TAC[complex_differentiable] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `n < r ==> &0 <= n ==> &0 <= r`)) THEN SIMP_TAC[NORM_POS_LE; PATH_IMAGE_CIRCLEPATH] THEN REWRITE_TAC[SET_RULE `s SUBSET c DELETE q <=> s SUBSET c /\ ~(q IN s)`] THEN REWRITE_TAC[SPHERE_SUBSET_CBALL; IN_SPHERE] THEN UNDISCH_TAC `norm(w - z:complex) < r` THEN CONV_TAC NORM_ARITH);; let CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE = prove (`!f z r w. f holomorphic_on cball(z,r) /\ w IN ball(z,r) ==> ((\u. f(u) / (u - w)) has_path_integral (Cx(&2) * Cx(pi) * ii * f(w))) (circlepath(z,r))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_INTEGRAL_CIRCLEPATH THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; HOLOMORPHIC_ON_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Uniform convergence of path integral when the derivative of the path is *) (* bounded, and in particular for the special case of a circle. *) (* ------------------------------------------------------------------------- *) let PATH_INTEGRAL_UNIFORM_LIMIT = prove (`!net f B g l. ~(trivial_limit net) /\ valid_path g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(vector_derivative g (at t)) <= B) /\ eventually (\n:A. (f n) path_integrable_on g) net /\ (!e. &0 < e ==> eventually (\n. !x. x IN path_image g ==> norm(f n x - l x) < e) net) ==> l path_integrable_on g /\ ((\n. path_integral g (f n)) --> path_integral g l) net`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL; GSYM integrable_on] THEN MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs B + &1`] THEN UNDISCH_TAC `eventually (\n:A. (f n) path_integrable_on g) net` THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN ASM_REWRITE_TAC[path_image; path_integrable_on; FORALL_IN_IMAGE] THEN REWRITE_TAC[HAS_PATH_INTEGRAL; GSYM integrable_on] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. f (a:A) (g x) * vector_derivative g (at x)` THEN ASM_REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e / (abs B + &1) * B` THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; REWRITE_TAC[REAL_ARITH `e / x * B <= e <=> &0 <= e * (&1 - B / x)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_SUB_LE; REAL_LE_LDIV_EQ; REAL_ARITH `&0 < abs B + &1`] THEN REAL_ARITH_TAC]; ALL_TAC] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN REWRITE_TAC[tendsto] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs B + &1`; REAL_HALF] THEN UNDISCH_TAC `eventually (\n:A. (f n) path_integrable_on g) net` THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[PATH_INTEGRAL_INTEGRAL; DIST_0; GSYM INTEGRAL_SUB; GSYM PATH_INTEGRABLE_ON; ETA_AX] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `drop(integral (interval[vec 0,vec 1]) (\x:real^1. lift(e / &2)))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_SIMP_TAC[INTEGRABLE_SUB; GSYM PATH_INTEGRABLE_ON; ETA_AX] THEN REWRITE_TAC[INTEGRABLE_CONST; GSYM COMPLEX_SUB_RDISTRIB; LIFT_DROP] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e / &2 / (abs B + &1) * B` THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_IMAGE; path_image] THEN ASM_MESON_TAC[]; REWRITE_TAC[REAL_ARITH `e / x * B <= e <=> &0 <= e * (&1 - B / x)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_SUB_LE; REAL_LE_LDIV_EQ; REAL_ARITH `&0 < abs B + &1`] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[INTEGRAL_CONST; CONTENT_UNIT_1; VECTOR_MUL_LID; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]);; let PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH = prove (`!net f l z r. &0 < r /\ ~(trivial_limit net) /\ eventually (\n:A. (f n) path_integrable_on circlepath(z,r)) net /\ (!e. &0 < e ==> eventually (\n. !x. x IN path_image (circlepath(z,r)) ==> norm(f n x - l x) < e) net) ==> l path_integrable_on circlepath(z,r) /\ ((\n. path_integral (circlepath(z,r)) (f n)) --> path_integral (circlepath(z,r)) l) net`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIFORM_LIMIT THEN EXISTS_TAC `&2 * pi * r` THEN ASM_SIMP_TAC[PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[VALID_PATH_CIRCLEPATH; VECTOR_DERIVATIVE_CIRCLEPATH] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_LID] THEN REWRITE_TAC[NORM_CEXP; RE_MUL_CX; RE_MUL_II; IM_CX] THEN REWRITE_TAC[REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; REAL_MUL_RID] THEN ASM_SIMP_TAC[real_abs; REAL_LE_REFL; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* General stepping result for derivative formulas. *) (* ------------------------------------------------------------------------- *) let CAUCHY_NEXT_DERIVATIVE = prove (`!f' f g s k B. ~(k = 0) /\ open s /\ valid_path g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(vector_derivative g (at t)) <= B) /\ f' continuous_on path_image g /\ (!w. w IN s DIFF path_image g ==> ((\u. f'(u) / (u - w) pow k) has_path_integral f w) g) ==> !w. w IN s DIFF path_image g ==> (\u. f'(u) / (u - w) pow (k + 1)) path_integrable_on g /\ (f has_complex_derivative (Cx(&k) * path_integral g (\u. f'(u) / (u - w) pow (k + 1)))) (at w)`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN MP_TAC(ISPEC `s DIFF path_image(g:real^1->complex)` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[OPEN_DIFF; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`at(w:complex)`; `\u x:complex. f'(x) * (inv(x - u) pow k - inv(x - w) pow k) / (u - w) / Cx(&k)`; `B:real`; `g:real^1->complex`; `\u. f'(u) / (u - w) pow (k + 1)`] PATH_INTEGRAL_UNIFORM_LIMIT) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&k)` o MATCH_MP LIM_COMPLEX_LMUL) THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LIM_TRANSFORM_AT) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN SUBGOAL_THEN `~(u:complex = w)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_SUB_0; COMPLEX_NORM_0; REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; COMPLEX_FIELD `~(y = Cx(&0)) ==> (y * x = z <=> x = z / y)`] THEN ASM_SIMP_TAC[COMPLEX_SUB_0; CX_INJ; REAL_OF_NUM_EQ; COMPLEX_SUB_LDISTRIB; COMPLEX_FIELD `~(c = Cx(&0)) ==> (a - b) / c = a / c - b / c`] THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_DIV) THEN REWRITE_TAC[GSYM complex_div; COMPLEX_POW_INV] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_REFL; NORM_0] THEN ASM_MESON_TAC[NORM_SUB]] THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_AT] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN REPEAT(MATCH_MP_TAC PATH_INTEGRABLE_COMPLEX_RMUL) THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB; COMPLEX_POW_INV; GSYM complex_div] THEN MATCH_MP_TAC PATH_INTEGRABLE_SUB THEN REWRITE_TAC[path_integrable_on] THEN CONJ_TAC THENL [EXISTS_TAC `(f:complex->complex) u`; EXISTS_TAC `(f:complex->complex) w`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_REFL; NORM_0] THEN ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN SUBGOAL_THEN `!e. &0 < e ==> eventually (\n. !x. x IN path_image g ==> norm ((inv (x - n) pow k - inv (x - w) pow k) / (n - w) / Cx(&k) - inv(x - w) pow (k + 1)) < e) (at w)` ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `bounded(IMAGE (f':complex->complex) (path_image g))` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_VALID_PATH_IMAGE]; ALL_TAC] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / C:real`) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `u:complex` THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:complex` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN REWRITE_TAC[COMPLEX_POW_INV] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `min (d / &2) ((e * (d / &2) pow (k + 2)) / (&k + &1))` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_HALF; REAL_POW_LT; REAL_LT_MUL; dist; REAL_LT_DIV; REAL_ARITH `&0 < &k + &1`] THEN X_GEN_TAC `u:complex` THEN STRIP_TAC THEN X_GEN_TAC `x:complex` THEN DISCH_TAC THEN MP_TAC(ISPECL [`\n w. if n = 0 then inv(x - w) pow k else if n = 1 then Cx(&k) / (x - w) pow (k + 1) else (Cx(&k) * Cx(&k + &1)) / (x - w) pow (k + 2)`; `1`; `ball(w:complex,d / &2)`; `(&k * (&k + &1)) / (d / &2) pow (k + 2)`] COMPLEX_TAYLOR) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[CONVEX_BALL; ADD_EQ_0; ARITH] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `v:complex` THEN REWRITE_TAC[IN_BALL; dist] THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX]THEN REWRITE_TAC[real_div; GSYM REAL_POW_INV; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ARITH `abs(&k + &1) = &k + &1`] THEN REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[GSYM real_div; REAL_POW_LT; REAL_HALF] THEN REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> &0 <= d / &2`] THEN UNDISCH_TAC `ball(w:complex,d) SUBSET s DIFF path_image g` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_BALL] THEN UNDISCH_TAC `norm(w - v:complex) < d / &2` THEN CONV_TAC NORM_ARITH] THEN GEN_TAC THEN X_GEN_TAC `y:complex` THEN REWRITE_TAC[IN_BALL; dist] THEN STRIP_TAC THEN SUBGOAL_THEN `~(y:complex = x)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `ball(w:complex,d) SUBSET s DIFF path_image g` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_BALL; dist] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP (ARITH_RULE `i <= 1 ==> i = 0 \/ i = 1`)) THEN REWRITE_TAC[ARITH] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_POW_EQ_0; COMPLEX_INV_EQ_0; CONJ_ASSOC; COMPLEX_MUL_LZERO; COMPLEX_SUB_0; ADD_EQ_0; ARITH] THEN REWRITE_TAC[COMPLEX_SUB_LZERO; COMPLEX_NEG_NEG; complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LID; GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_POW_INV; GSYM COMPLEX_INV_MUL; GSYM COMPLEX_POW_ADD] THEN ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> k - 1 + 2 = k + 1`] THEN REWRITE_TAC[COMPLEX_INV_INV; ADD_SUB; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG; COMPLEX_MUL_RID; COMPLEX_POW_POW] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM REAL_OF_NUM_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_POW_INV] THEN ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_INV_EQ_0; COMPLEX_SUB_0; COMPLEX_FIELD `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> (z * inv x = inv y <=> y * z = x)`] THEN REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN AP_TERM_TAC THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`w:complex`; `u:complex`]) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; NUMSEG_CONV `0..1`] THEN ASM_SIMP_TAC[IN_BALL; dist; VSUM_CLAUSES; FINITE_RULES] THEN ANTS_TAC THENL [ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN REWRITE_TAC[complex_pow; VECTOR_ADD_RID; ARITH; FACT] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_DIV_1; COMPLEX_MUL_RID; COMPLEX_POW_1] THEN SUBGOAL_THEN `~(u:complex = w)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; REAL_LT_REFL]; ALL_TAC] THEN SUBGOAL_THEN `~(x:complex = w)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_SUB_0; COMPLEX_POW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; COMPLEX_FIELD `~(d = Cx(&0)) /\ ~(c = Cx(&0)) /\ ~(e = Cx(&0)) ==> a - (b + c / d * e) = ((a - b) / e / c - inv d) * c * e`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_DIV_1] THEN REWRITE_TAC[REAL_ABS_NUM; GSYM COMPLEX_POW_INV] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&k * norm(u - w:complex)` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; LT_NZ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n <= x ==> x < y ==> n < y`)) THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_POW_2; REAL_MUL_ASSOC; REAL_LT_RMUL_EQ] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; LT_NZ] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = (c * a) * b`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_HALF; REAL_POW_LT] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ARITH `&0 < &k + &1`]);; let CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH = prove (`!f g z r k. ~(k = 0) /\ (f continuous_on path_image(circlepath(z,r))) /\ (!w. w IN ball(z,r) ==> ((\u. f(u) / (u - w) pow k) has_path_integral g w) (circlepath(z,r))) ==> !w. w IN ball(z,r) ==> (\u. f(u) / (u - w) pow (k + 1)) path_integrable_on (circlepath(z,r)) /\ (g has_complex_derivative (Cx(&k) * path_integral(circlepath(z,r)) (\u. f(u) / (u - w) pow (k + 1)))) (at w)`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `&0 <= r` THENL [ALL_TAC; GEN_TAC THEN REWRITE_TAC[IN_BALL] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN UNDISCH_TAC `~(&0 <= r)` THEN CONV_TAC NORM_ARITH] THEN MP_TAC(ISPECL [`f:complex->complex`; `g:complex->complex`; `circlepath(z,r)`; `ball(z:complex,r)`; `k:num`; `&2 * pi * r`] CAUCHY_NEXT_DERIVATIVE) THEN ASM_REWRITE_TAC[OPEN_BALL; VALID_PATH_CIRCLEPATH] THEN SUBGOAL_THEN `ball(z,r) DIFF path_image(circlepath (z,r)) = ball(z,r)` SUBST1_TAC THENL [REWRITE_TAC[SET_RULE `s DIFF t = s <=> !x. x IN t ==> ~(x IN s)`] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; IN_SPHERE; IN_BALL; REAL_LT_REFL]; DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_DERIVATIVE_CIRCLEPATH] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_LID] THEN REWRITE_TAC[NORM_CEXP; RE_MUL_CX; RE_MUL_II; IM_CX] THEN REWRITE_TAC[REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; REAL_MUL_RID] THEN ASM_SIMP_TAC[real_abs; REAL_LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* In particular, the first derivative formula. *) (* ------------------------------------------------------------------------- *) let CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH = prove (`!f z r w. f continuous_on cball(z,r) /\ f holomorphic_on ball(z,r) /\ w IN ball(z,r) ==> (\u. f(u) / (u - w) pow 2) path_integrable_on circlepath(z,r) /\ (f has_complex_derivative (Cx(&1) / (Cx(&2) * Cx(pi) * ii) * path_integral(circlepath(z,r)) (\u. f(u) / (u - w) pow 2))) (at w)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `\x:complex. Cx(&2) * Cx(pi) * ii * f x`; `z:complex`; `r:real`; `1`] CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN ASM_SIMP_TAC[COMPLEX_POW_1; ARITH; CAUCHY_INTEGRAL_CIRCLEPATH] THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `n < r ==> &0 <= n ==> &0 <= r`)) THEN SIMP_TAC[DIST_POS_LE; PATH_IMAGE_CIRCLEPATH; SPHERE_SUBSET_CBALL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o MATCH_MP HAS_COMPLEX_DERIVATIVE_LMUL_AT) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_FIELD);; (* ------------------------------------------------------------------------- *) (* Existence of all higher derivatives. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_DERIVATIVE = prove (`!f f' s. open s /\ (!z. z IN s ==> (f has_complex_derivative f'(z)) (at z)) ==> f' holomorphic_on s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`\x. Cx(&1) / (Cx(&2) * Cx pi * ii) * f(x:complex)`; `f':complex->complex`; `z:complex`; `r:real`; `2`] CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[CENTRE_IN_BALL]] THEN SUBGOAL_THEN `f holomorphic_on cball(z,r)` ASSUME_TAC THENL [ASM_REWRITE_TAC[holomorphic_on] THEN ASM_MESON_TAC[SUBSET; HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; ALL_TAC] THEN REWRITE_TAC[ARITH] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE; SPHERE_SUBSET_CBALL]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `z:complex`; `r:real`; `w:complex`] CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH) THEN ANTS_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; BALL_SUBSET_CBALL]; ALL_TAC] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRAL) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM complex_div] THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`f:complex->complex`; `w:complex`] THEN ASM_REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL]);; let HOLOMORPHIC_COMPLEX_DERIVATIVE = prove (`!f s. open s /\ f holomorphic_on s ==> (complex_derivative f) holomorphic_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_DERIVATIVE THEN EXISTS_TAC `f:complex->complex` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DERIVATIVE; HOLOMORPHIC_ON_OPEN]);; let ANALYTIC_COMPLEX_DERIVATIVE = prove (`!f s. f analytic_on s ==> (complex_derivative f) analytic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_BALL]);; let HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE = prove (`!f s n. open s /\ f holomorphic_on s ==> (higher_complex_derivative n f) holomorphic_on s`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; higher_complex_derivative]);; let ANALYTIC_HIGHER_COMPLEX_DERIVATIVE = prove (`!f s n. f analytic_on s ==> (higher_complex_derivative n f) analytic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE; OPEN_BALL]);; let HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE = prove (`!f s x n. open s /\ f holomorphic_on s /\ x IN s ==> ((higher_complex_derivative n f) has_complex_derivative (higher_complex_derivative (SUC n) f x)) (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[higher_complex_derivative] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]);; (* ------------------------------------------------------------------------- *) (* Morera's theorem. *) (* ------------------------------------------------------------------------- *) let MORERA_LOCAL_TRIANGLE_GEN = prove (`!f s. (!z. z IN s ==> ?e a. &0 < e /\ z IN ball(a,e) /\ f continuous_on ball(a,e) /\ !b c. segment[b,c] SUBSET ball(a,e) ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = Cx(&0)) ==> f analytic_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[analytic_on] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`e:real`; `a:complex`] THEN STRIP_TAC THEN EXISTS_TAC `e - dist(a:complex,z)` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN NORM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(a:complex,e)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_DERIVATIVE THEN REWRITE_TAC[OPEN_BALL] THEN MATCH_MP_TAC TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE THEN EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CENTRE_IN_BALL]; REWRITE_TAC[SUBSET; IN_BALL] THEN NORM_ARITH_TAC]);; let MORERA_LOCAL_TRIANGLE = prove (`!f s. (!z. z IN s ==> ?t. open t /\ z IN t /\ f continuous_on t /\ !a b c. convex hull {a,b,c} SUBSET t ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = Cx(&0)) ==> f analytic_on s`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MORERA_LOCAL_TRIANGLE_GEN THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:complex->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:complex`; `w:complex`] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CENTRE_IN_BALL] THEN MP_TAC(ISPECL [`x:complex`; `w:complex`] ENDS_IN_SEGMENT) THEN ASM SET_TAC[]);; let MORERA_TRIANGLE = prove (`!f s. open s /\ f continuous_on s /\ (!a b c. convex hull {a,b,c} SUBSET s ==> path_integral (linepath(a,b)) f + path_integral (linepath(b,c)) f + path_integral (linepath(c,a)) f = Cx(&0)) ==> f analytic_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MORERA_LOCAL_TRIANGLE THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Combining theorems for higher derivatives including Leibniz rule. *) (* ------------------------------------------------------------------------- *) let HIGHER_COMPLEX_DERIVATIVE_EQ_ITER = prove (`!n. higher_complex_derivative n = ITER n complex_derivative`, INDUCT_TAC THEN ASM_REWRITE_TAC [FUN_EQ_THM; ITER; higher_complex_derivative]);; let HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE = prove (`!f m n. higher_complex_derivative m (higher_complex_derivative n f) = higher_complex_derivative (m + n) f`, REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_EQ_ITER; ITER_ADD]);; let higher_complex_derivative_alt = prove (`(!f. higher_complex_derivative 0 f = f) /\ (!f z n. higher_complex_derivative (SUC n) f = higher_complex_derivative n (complex_derivative f))`, REWRITE_TAC [HIGHER_COMPLEX_DERIVATIVE_EQ_ITER; ITER_ALT]);; let HIGHER_COMPLEX_DERIVATIVE_LINEAR = prove (`!c n. higher_complex_derivative n (\w. c * w) = \z. if n = 0 then c * z else if n = 1 then c else (Cx(&0))`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC [higher_complex_derivative; NOT_SUC; SUC_INJ; ONE] THEN STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THEN REWRITE_TAC [NOT_SUC; SUC_INJ; COMPLEX_DERIVATIVE_LINEAR; COMPLEX_DERIVATIVE_CONST]);; let HIGHER_COMPLEX_DERIVATIVE_CONST = prove (`!i c. higher_complex_derivative i (\w.c) = \w. if i=0 then c else Cx(&0)`, INDUCT_TAC THEN ASM_REWRITE_TAC [higher_complex_derivative_alt; NOT_SUC; COMPLEX_DERIVATIVE_CONST; FUN_EQ_THM] THEN MESON_TAC[]);; let HIGHER_COMPLEX_DERIVATIVE_ID = prove (`!z i. higher_complex_derivative i (\w.w) z = if i = 0 then z else if i = 1 then Cx(&1) else Cx(&0)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC [higher_complex_derivative_alt; NOT_SUC; ONE; SUC_INJ] THEN REWRITE_TAC[COMPLEX_DERIVATIVE_ID; HIGHER_COMPLEX_DERIVATIVE_CONST; ONE]);; let HAS_COMPLEX_DERIVATIVE_ITER_1 = prove (`!f n z. f z = z /\ (f has_complex_derivative Cx(&1)) (at z) ==> (ITER n f has_complex_derivative Cx(&1)) (at z)`, GEN_TAC THEN INDUCT_TAC THEN REPEAT STRIP_TAC THEN REWRITE_TAC [ITER_POINTLESS; I_DEF; HAS_COMPLEX_DERIVATIVE_ID] THEN SUBGOAL_THEN `Cx(&1) = Cx(&1) * Cx(&1)` SUBST1_TAC THENL [REWRITE_TAC [COMPLEX_MUL_LID]; ASM_SIMP_TAC [ITER_FIXPOINT; COMPLEX_DIFF_CHAIN_AT]]);; let HIGHER_COMPLEX_DERIVATIVE_NEG = prove (`!f s n z. open s /\ f holomorphic_on s /\ z IN s ==> higher_complex_derivative n (\w. --(f w)) z = --(higher_complex_derivative n f z)`, REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC [higher_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `(\w. --(higher_complex_derivative n f w))` THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_NEG THEN REWRITE_TAC [ETA_AX; GSYM higher_complex_derivative] THEN ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]);; let HIGHER_COMPLEX_DERIVATIVE_ADD = prove (`!f g s n z. open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s ==> higher_complex_derivative n (\w. f w + g w) z = higher_complex_derivative n f z + higher_complex_derivative n g z`, REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC [higher_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `(\w. higher_complex_derivative n f w + higher_complex_derivative n g w)` THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ADD THEN REWRITE_TAC [ETA_AX; GSYM higher_complex_derivative] THEN ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]);; let HIGHER_COMPLEX_DERIVATIVE_SUB = prove (`!f g s n z. open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s ==> higher_complex_derivative n (\w. f w - g w) z = higher_complex_derivative n f z - higher_complex_derivative n g z`, REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC [higher_complex_derivative] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `(\w. higher_complex_derivative n f w - higher_complex_derivative n g w)` THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN REWRITE_TAC [ETA_AX; GSYM higher_complex_derivative] THEN ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]);; let HIGHER_COMPLEX_DERIVATIVE_MUL = prove (`!f g s n z. open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s ==> higher_complex_derivative n (\w. f w * g w) z = vsum (0..n) (\i. Cx(&(binom(n,i))) * higher_complex_derivative i f z * higher_complex_derivative (n-i) g z)`, REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN INDUCT_TAC THEN REPEAT STRIP_TAC THEN REWRITE_TAC [NUMSEG_SING; VSUM_SING; SUB] THEN REWRITE_TAC [higher_complex_derivative; binom; COMPLEX_MUL_LID] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\w. vsum (0..n) (\i. Cx(&(binom (n,i))) * higher_complex_derivative i f w * higher_complex_derivative (n-i) g w)` THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN SUBGOAL_THEN `vsum (0..SUC n) (\i. Cx(&(binom (SUC n,i))) * higher_complex_derivative i f z * higher_complex_derivative (SUC n-i) g z) = vsum (0..n) (\i. Cx(&(binom (n,i))) * (higher_complex_derivative i f z * higher_complex_derivative (SUC n-i) g z + higher_complex_derivative (SUC i) f z * higher_complex_derivative (n-i) g z))` SUBST1_TAC THENL [SUBGOAL_THEN `!i. binom(SUC n,i) = binom(n,i) + if i=0 then 0 else binom(n,PRE i)` (fun th -> REWRITE_TAC[th; GSYM REAL_OF_NUM_ADD; CX_ADD]) THENL [INDUCT_TAC THEN REWRITE_TAC[binom; NOT_SUC; PRE; ADD_SYM; ADD_0]; REWRITE_TAC [COMPLEX_ADD_LDISTRIB; COMPLEX_ADD_RDISTRIB]] THEN SIMP_TAC [VSUM_ADD; FINITE_NUMSEG] THEN BINOP_TAC THENL [REWRITE_TAC [VSUM_CLAUSES_NUMSEG; LE_0] THEN SUBGOAL_THEN `binom(n,SUC n)=0` SUBST1_TAC THENL [REWRITE_TAC [BINOM_EQ_0] THEN ARITH_TAC; CONV_TAC COMPLEX_RING]; SIMP_TAC [VSUM_CLAUSES_LEFT; SPEC `SUC n` LE_0] THEN REWRITE_TAC [COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; GSYM ADD1; VSUM_SUC; o_DEF; SUB_SUC; NOT_SUC; PRE]]; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_VSUM THEN REWRITE_TAC [FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN ASM_SIMP_TAC [ETA_AX; ARITH_RULE `i <= n ==> SUC n - i = SUC (n-i)`] THEN ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]]);; let HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove (`!f g s i z. open s /\ f holomorphic_on s /\ g holomorphic_on s /\ (!w. w IN s ==> f w = g w) /\ z IN s ==> higher_complex_derivative i f z = higher_complex_derivative i g z`, REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN INDUCT_TAC THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC [higher_complex_derivative] THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN ASM_MESON_TAC [HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]);; let HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR = prove (`!f u s t n z. f holomorphic_on t /\ open s /\ open t /\ (!w. w IN s ==> u * w IN t) /\ z IN s ==> higher_complex_derivative n (\w. f (u * w)) z = u pow n * higher_complex_derivative n f (u * z)`, REWRITE_TAC [RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC [higher_complex_derivative; complex_pow; COMPLEX_MUL_LID] THEN REPEAT STRIP_TAC THEN EQ_TRANS_TAC `complex_derivative (\z. u pow n * higher_complex_derivative n f (u * z)) z` THENL [MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (REWRITE_RULE [o_DEF] (SPECL [`\z:complex. u * z`; `f:complex->complex`] HOLOMORPHIC_ON_COMPOSE_GEN)) THEN EXISTS_TAC `t:complex->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (REWRITE_RULE [o_DEF] (SPECL [`\w:complex. u:complex`; `\w:complex. w`] HOLOMORPHIC_ON_MUL)) THEN REWRITE_TAC [HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID]; MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN SIMP_TAC [HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_CONST] THEN MATCH_MP_TAC (REWRITE_RULE [o_DEF] (SPECL [`\w. u * w`; `higher_complex_derivative f n`] HOLOMORPHIC_ON_COMPOSE_GEN)) THEN EXISTS_TAC `t:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC (REWRITE_RULE [o_DEF] (SPECL [`\w:complex. u:complex`; `\w:complex. w`] HOLOMORPHIC_ON_MUL)) THEN REWRITE_TAC [HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID]; ASM_SIMP_TAC [HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]]]; EQ_TRANS_TAC `u pow n * complex_derivative (\z. higher_complex_derivative n f (u * z)) z` THENL [MATCH_MP_TAC COMPLEX_DERIVATIVE_LMUL THEN MATCH_MP_TAC ANALYTIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (REWRITE_RULE [o_DEF] ANALYTIC_ON_COMPOSE_GEN) THEN EXISTS_TAC `t:complex->bool` THEN ASM_SIMP_TAC [ANALYTIC_ON_LINEAR; ANALYTIC_HIGHER_COMPLEX_DERIVATIVE; ANALYTIC_ON_OPEN]; ABBREV_TAC `a = u:complex pow n` THEN REWRITE_TAC [COMPLEX_MUL_AC; COMPLEX_EQ_MUL_LCANCEL] THEN ASM_CASES_TAC `a = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [COMPLEX_MUL_SYM] THEN MATCH_MP_TAC (REWRITE_RULE [o_DEF; COMPLEX_DIFFERENTIABLE_LINEAR; COMPLEX_DERIVATIVE_LINEAR] (SPECL [`\w. u * w`;`higher_complex_derivative n f`] COMPLEX_DERIVATIVE_CHAIN)) THEN ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]]]);; let HIGHER_COMPLEX_DERIVATIVE_ADD_AT = prove (`!f g n z. f analytic_on {z} /\ g analytic_on {z} ==> higher_complex_derivative n (\w. f w + g w) z = higher_complex_derivative n f z + higher_complex_derivative n g z`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_ADD]);; let HIGHER_COMPLEX_DERIVATIVE_SUB_AT = prove (`!f g n z. f analytic_on {z} /\ g analytic_on {z} ==> higher_complex_derivative n (\w. f w - g w) z = higher_complex_derivative n f z - higher_complex_derivative n g z`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_SUB]);; let HIGHER_COMPLEX_DERIVATIVE_NEG_AT = prove (`!f n z. f analytic_on {z} ==> higher_complex_derivative n (\w. --(f w)) z = --(higher_complex_derivative n f z)`, REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_NEG]);; let HIGHER_COMPLEX_DERIVATIVE_MUL_AT = prove (`!f g n z. f analytic_on {z} /\ g analytic_on {z} ==> higher_complex_derivative n (\w. f w * g w) z = vsum (0..n) (\i. Cx(&(binom(n,i))) * higher_complex_derivative i f z * higher_complex_derivative (n-i) g z)`, REWRITE_TAC [ANALYTIC_AT_TWO] THEN MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_MUL]);; (* ------------------------------------------------------------------------- *) (* Nonexistence of isolated singularities and a stronger integral formula. *) (* ------------------------------------------------------------------------- *) let NO_ISOLATED_SINGULARITY = prove (`!f s k. open s /\ FINITE k /\ f continuous_on s /\ f holomorphic_on (s DIFF k) ==> f holomorphic_on s`, REPEAT GEN_TAC THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DIFF; FINITE_IMP_CLOSED; IMP_CONJ] THEN REWRITE_TAC[GSYM complex_differentiable] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `(z:complex) IN k` THEN ASM_SIMP_TAC[IN_DIFF] THEN MP_TAC(ISPECL [`z:complex`; `k:complex->bool`] FINITE_SET_AVOID) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `f holomorphic_on ball(z,min d e)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; CENTRE_IN_BALL; REAL_LT_MIN; complex_differentiable]] THEN SUBGOAL_THEN `?g. !w. w IN ball(z,min d e) ==> (g has_complex_derivative f w) (at w within ball(z,min d e))` MP_TAC THENL [ALL_TAC; SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN MESON_TAC[HOLOMORPHIC_DERIVATIVE; OPEN_BALL]] THEN MATCH_MP_TAC PATHINTEGRAL_CONVEX_PRIMITIVE THEN REWRITE_TAC[CONVEX_BALL] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b SUBSET s ==> c SUBSET b ==> c SUBSET s`)) THEN REWRITE_TAC[SUBSET; IN_BALL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_COFINITE THEN EXISTS_TAC `k:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[]; X_GEN_TAC `w:complex` THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN SPEC_TAC(`w:complex`,`w:complex`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (s DIFF k) SUBSET (t DIFF k)`) THEN MATCH_MP_TAC(SET_RULE `interior s SUBSET s /\ s SUBSET t ==> interior s SUBSET t`) THEN REWRITE_TAC[INTERIOR_SUBSET]] THEN (MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,e)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,min d e)` THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_BALL] THEN REAL_ARITH_TAC]));; let CAUCHY_INTEGRAL_FORMULA_CONVEX = prove (`!f s k g z. convex s /\ FINITE k /\ f continuous_on s /\ (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) /\ z IN interior(s) /\ valid_path g /\ (path_image g) SUBSET (s DELETE z) /\ pathfinish g = pathstart g ==> ((\w. f(w) / (w - z)) has_path_integral (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_INTEGRAL_FORMULA_WEAK THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN ASM_REWRITE_TAC[DIFF_EMPTY; FINITE_RULES] THEN SIMP_TAC[GSYM HOLOMORPHIC_ON_OPEN; complex_differentiable; OPEN_INTERIOR] THEN MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `k:complex->bool` THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[INTERIOR_SUBSET]; ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DIFF; FINITE_IMP_CLOSED; OPEN_INTERIOR; GSYM complex_differentiable]]);; (* ------------------------------------------------------------------------- *) (* Formula for higher derivatives. *) (* ------------------------------------------------------------------------- *) let CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH = prove (`!f z r k w. f continuous_on cball(z,r) /\ f holomorphic_on ball(z,r) /\ w IN ball(z,r) ==> ((\u. f(u) / (u - w) pow (k + 1)) has_path_integral ((Cx(&2) * Cx(pi) * ii) / Cx(&(FACT k)) * higher_complex_derivative k f w)) (circlepath(z,r))`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `&0 < r` THENL [ALL_TAC; REWRITE_TAC[IN_BALL] THEN ASM_MESON_TAC[NORM_ARITH `~(&0 < r) ==> ~(dist(a,b) < r)`]] THEN INDUCT_TAC THEN REWRITE_TAC[higher_complex_derivative] THENL [REWRITE_TAC[ARITH; COMPLEX_POW_1; FACT; COMPLEX_DIV_1] THEN ASM_SIMP_TAC[GSYM COMPLEX_MUL_ASSOC; CAUCHY_INTEGRAL_CIRCLEPATH]; ALL_TAC] THEN MP_TAC(SPECL [`f:complex->complex`; `\x. (Cx(&2) * Cx(pi) * ii) / Cx(&(FACT k)) * higher_complex_derivative k f x`; `z:complex`; `r:real`; `k + 1`] CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN ASM_REWRITE_TAC[ADD1; ARITH_RULE `(k + 1) + 1 = k + 2`] THEN ANTS_TAC THENL [REWRITE_TAC[ADD_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE; SPHERE_SUBSET_CBALL]; ALL_TAC] THEN DISCH_THEN(fun th -> X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MP_TAC(SPEC `w:complex` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:complex` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(a = Cx(&0)) /\ ~(b = Cx(&0)) /\ x = b / a * y ==> y = a / b * x`) THEN REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_LMUL_AT) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&(FACT k)) / (Cx(&2) * Cx pi * ii)`) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> (a / b) * (b / a) * x = x`) THEN REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]; REWRITE_TAC[FACT; GSYM REAL_OF_NUM_MUL; GSYM ADD1; CX_MUL] THEN MATCH_MP_TAC(COMPLEX_FIELD `z:complex = y /\ ~(d = Cx(&0)) ==> k / d * k1 * z = (k1 * k) / d * y`) THEN REWRITE_TAC[CX_2PII_NZ] THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]]);; let CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH = prove (`!f z r k w. f continuous_on cball(z,r) /\ f holomorphic_on ball(z,r) /\ w IN ball(z,r) ==> (\u. f(u) / (u - w) pow (k + 1)) path_integrable_on circlepath(z,r) /\ higher_complex_derivative k f w = Cx(&(FACT k)) / (Cx(&2) * Cx(pi) * ii) * path_integral(circlepath(z,r)) (\u. f(u) / (u - w) pow (k + 1))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH) THEN CONJ_TAC THENL [ASM_MESON_TAC[path_integrable_on]; ALL_TAC] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(a = Cx(&0)) /\ ~(b = Cx(&0)) /\ x = b / a * y ==> y = a / b * x`) THEN REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* A holomorphic function is analytic, i.e. has local power series. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_POWER_SERIES = prove (`!f z w r. f holomorphic_on ball(z,r) /\ w IN ball(z,r) ==> ((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (w - z) pow n) sums f(w)) (from 0)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?r. &0 < r /\ f holomorphic_on cball(z,r) /\ w IN ball(z,r)` MP_TAC THENL [EXISTS_TAC `(r + dist(w:complex,z)) / &2` THEN REPEAT CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(z:complex,r)` THEN ASM_REWRITE_TAC[SUBSET]; ALL_TAC] THEN UNDISCH_TAC `(w:complex) IN ball(z,r)` THEN REWRITE_TAC[IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `f holomorphic_on ball(z,r) /\ f continuous_on cball(z,r)` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN ASM_MESON_TAC[BALL_SUBSET_CBALL]; ALL_TAC] THEN SUBGOAL_THEN `((\k. path_integral (circlepath(z,r)) (\u. f u / (u - z) pow (k + 1)) * (w - z) pow k) sums path_integral (circlepath(z,r)) (\u. f u / (u - w))) (from 0)` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `inv(Cx(&2) * Cx(pi) * ii)` o MATCH_MP SERIES_COMPLEX_LMUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN MP_TAC(SPECL [`f:complex->complex`; `z:complex`; `r:real`; `k:num`; `z:complex`] CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN MATCH_MP_TAC(COMPLEX_FIELD `~(pit = Cx(&0)) /\ ~(fact = Cx(&0)) ==> inv(pit) * ((pit / fact) * d) * wz = d / fact * wz`) THEN REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]; MP_TAC(SPECL [`f:complex->complex`; `z:complex`; `r:real`; `w:complex`] CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN MATCH_MP_TAC(COMPLEX_FIELD `~(x * y * z = Cx(&0)) ==> inv(x * y * z) * x * y * z * w = w`) THEN REWRITE_TAC[CX_2PII_NZ]]] THEN REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. path_integral (circlepath(z,r)) (\u. vsum (0..n) (\k. f u * (w - z) pow k / (u - z) pow (k + 1)))` THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhs o rand) PATH_INTEGRAL_VSUM o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a * b / c:complex = b * a / c`] THEN MATCH_MP_TAC PATH_INTEGRABLE_COMPLEX_LMUL THEN ASM_SIMP_TAC[CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; CENTRE_IN_BALL]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a * b / c:complex = a / c * b`] THEN MATCH_MP_TAC PATH_INTEGRAL_COMPLEX_RMUL THEN ASM_SIMP_TAC[CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; CENTRE_IN_BALL]; ALL_TAC] THEN MATCH_MP_TAC(CONJUNCT2 (REWRITE_RULE[FORALL_AND_THM; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH)) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC PATH_INTEGRABLE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a * b / c:complex = b * a / c`] THEN MATCH_MP_TAC PATH_INTEGRABLE_COMPLEX_LMUL THEN ASM_SIMP_TAC[CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; CENTRE_IN_BALL]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE; IN_ELIM_THM] THEN SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG; complex_div] THEN REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_INV_MUL; COMPLEX_POW_1] THEN SIMP_TAC[COMPLEX_MUL_ASSOC; VSUM_COMPLEX_RMUL; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM complex_div; GSYM COMPLEX_POW_DIV] THEN REWRITE_TAC[VSUM_GP; CONJUNCT1 LT; CONJUNCT1 complex_pow] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN SUBGOAL_THEN `?B. &0 < B /\ !u:complex. u IN cball(z,r) ==> norm(f u:complex) <= B` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `IMAGE (f:complex->complex) (cball(z,r))` COMPACT_IMP_BOUNDED) THEN ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; COMPACT_CBALL] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `?k. &0 < k /\ k <= r /\ norm(w - z) <= r - k /\ !u. norm(u - z) = r ==> k <= norm(u - w)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `r - dist(z:complex,w)` THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_BALL] THEN NORM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(z,x) = r <=> norm(x - z) = r`] THEN MP_TAC(SPECL [`(r - k) / r:real`; `e / B * k:real`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_HALF; REAL_LT_MUL] THEN ASM_REWRITE_TAC[REAL_ARITH `r - k < &1 * r <=> &0 < k`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `u:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `~(u:complex = z) /\ ~(u = w)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN MAP_EVERY UNDISCH_TAC [`&0 < r`; `norm(u - z:complex) = r`] THEN NORM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(u = z) /\ ~(u = w) ==> ~((w - z) / (u - z) = Cx(&1))`] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(u = z) /\ ~(u = w) ==> x / (Cx(&1) - (w - z) / (u - z)) / (u - z) = x / (u - w)`] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(u = w) ==> (Cx(&1) - e) / (u - w) - inv(u - w) = --(e / (u - w))`] THEN REWRITE_TAC[COMPLEX_NORM_DIV; NORM_NEG; COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * ((r - k) / r) pow N / k:real` THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ]] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[dist; REAL_LE_REFL]; MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; ALL_TAC] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[GSYM real_div] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; ALL_TAC; REWRITE_TAC[REAL_LE_INV_EQ; NORM_POS_LE]; MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `((r - k) / r:real) pow (SUC n)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE]; MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN ASM_SIMP_TAC[ARITH_RULE `N <= n ==> N <= SUC n`] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* These weak Liouville versions don't even need the derivative formula. *) (* ------------------------------------------------------------------------- *) let LIOUVILLE_WEAK = prove (`!f l. f holomorphic_on (:complex) /\ (f --> l) at_infinity ==> !z. f(z) = l`, SUBGOAL_THEN `!f. f holomorphic_on (:complex) /\ (f --> Cx(&0)) at_infinity ==> !z. f(z) = Cx(&0)` MP_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPEC `\z. (f:complex->complex) z - l`) THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; ETA_AX; GSYM LIM_NULL; GSYM COMPLEX_VEC_0]] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `p = ~ ~ p`] THEN PURE_REWRITE_TAC[GSYM COMPLEX_NORM_NZ] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_INFINITY]) THEN DISCH_THEN(MP_TAC o SPEC `norm((f:complex->complex) z) / &2`) THEN ASM_REWRITE_TAC[dist; REAL_HALF; COMPLEX_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`f:complex->complex`; `z:complex`; `&1 + abs B + norm(z:complex)`; `z:complex`] CAUCHY_INTEGRAL_CIRCLEPATH) THEN ASM_SIMP_TAC[CONVEX_UNIV; INTERIOR_OPEN; OPEN_UNIV; IN_UNIV] THEN ABBREV_TAC `R = &1 + abs B + norm(z:complex)` THEN SUBGOAL_THEN `&0 < R` ASSUME_TAC THENL [ASM_MESON_TAC[NORM_POS_LE; REAL_ABS_POS; REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 < &1 + x + y`]; ALL_TAC] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; NOT_IMP; CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH)) THEN DISCH_THEN(MP_TAC o SPEC `norm((f:complex->complex) z) / &2 / R`) THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_POS; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < R ==> x / R * &2 * pi * R = &2 * pi * x`] THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LE] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LE_DIV2_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `norm(x - z:complex) = R` THEN EXPAND_TAC "R" THEN MATCH_MP_TAC(REAL_ARITH `d <= x + z ==> d = &1 + abs b + z ==> x >= b`) THEN REWRITE_TAC[VECTOR_SUB] THEN MESON_TAC[NORM_TRIANGLE; NORM_NEG]; REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_PI; COMPLEX_NORM_II] THEN SIMP_TAC[REAL_LT_LMUL_EQ; REAL_OF_NUM_LT; ARITH; PI_POS; REAL_MUL_LID] THEN SUBGOAL_THEN `?w:complex. norm w = abs B` MP_TAC THENL [MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_ABS_POS]; ALL_TAC] THEN ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH `abs B >= B /\ (&0 <= x /\ x < z / &2 ==> z / &2 < z)`]]);; let LIOUVILLE_WEAK_INVERSE = prove (`!f. f holomorphic_on (:complex) /\ (!B. eventually (\x. norm(f x) >= B) at_infinity) ==> ?z. f(z) = Cx(&0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN PURE_REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN MP_TAC(SPECL [`\x:complex. Cx(&1) / (f(x))`; `Cx(&0)`] LIOUVILLE_WEAK) THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(y = Cx(&0)) ==> ~(Cx(&1) / y = Cx(&0))`] THEN CONJ_TAC THENL [REWRITE_TAC[holomorphic_on; complex_div; COMPLEX_MUL_LID; IN_UNIV] THEN GEN_TAC THEN REWRITE_TAC[GSYM complex_differentiable; WITHIN_UNIV] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_INV_AT THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[OPEN_UNIV; HOLOMORPHIC_ON_OPEN; IN_UNIV; complex_differentiable]; REWRITE_TAC[tendsto] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&2/ e`) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[dist; COMPLEX_SUB_RZERO; real_ge; COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* In particular we get the Fundamental Theorem of Algebra. *) (* ------------------------------------------------------------------------- *) let FTA = prove (`!a n. a(0) = Cx(&0) \/ ~(!k. k IN 1..n ==> a(k) = Cx(&0)) ==> ?z. vsum(0..n) (\i. a(i) * z pow i) = Cx(&0)`, REPEAT STRIP_TAC THENL [EXISTS_TAC `Cx(&0)` THEN SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0] THEN ASM_SIMP_TAC[ADD_CLAUSES; COMPLEX_POW_ZERO; LE_1; COMPLEX_ADD_LID; COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0]; MATCH_MP_TAC LIOUVILLE_WEAK_INVERSE THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_VSUM THEN SIMP_TAC[FINITE_NUMSEG; HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID]; ASM_MESON_TAC[COMPLEX_POLYFUN_EXTREMAL]]]);; (* ------------------------------------------------------------------------- *) (* Weierstrass convergence theorem. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_UNIFORM_LIMIT = prove (`!net:(A net) f g z r. ~(trivial_limit net) /\ eventually (\n. (f n) continuous_on cball(z,r) /\ (f n) holomorphic_on ball(z,r)) net /\ (!e. &0 < e ==> eventually (\n. !x. x IN cball(z,r) ==> norm(f n x - g x) < e) net) ==> g continuous_on cball(z,r) /\ g holomorphic_on ball(z,r)`, REPEAT GEN_TAC THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL [ASM_SIMP_TAC[BALL_EMPTY; holomorphic_on; NOT_IN_EMPTY] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `r <= &0 ==> r < &0 \/ r = &0`)) THEN ASM_SIMP_TAC[continuous_on; CBALL_EMPTY; CBALL_SING; NOT_IN_EMPTY] THEN SIMP_TAC[IN_SING; DIST_REFL] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_UNIFORM_LIMIT THEN MAP_EVERY EXISTS_TAC [`net:A net`; `f:A->complex->complex`] THEN RULE_ASSUM_TAC(REWRITE_RULE[EVENTUALLY_AND]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x. Cx(&1) / (Cx(&2) * Cx pi * ii) * g(x:complex)`; `g:complex->complex`; `z:complex`; `r:real`; `1`] CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[ARITH] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN SIMP_TAC[SPHERE_SUBSET_CBALL]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_POW_1] THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN SUBGOAL_THEN `(\u. g u / (u - w)) path_integrable_on circlepath(z,r) /\ ((\n:A. path_integral(circlepath(z,r)) (\u. f n u / (u - w))) --> path_integral(circlepath(z,r)) (\u. g u / (u - w))) net` MP_TAC THENL [MATCH_MP_TAC PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN SIMP_TAC[SUBSET; IN_CBALL; IN_ELIM_THM; NORM_SUB; dist; REAL_LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[COMPLEX_POW_EQ_0; ARITH; IN_ELIM_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_SUB_0] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e * abs(r - norm(w - z:complex))`) THEN SUBGOAL_THEN `&0 < e * abs(r - norm(w - z:complex))` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN SIMP_TAC[REAL_SUB_0] THEN ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:complex` THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[dist; REAL_LE_REFL] THEN SUBGOAL_THEN `~(x:complex = w)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[IN_BALL; dist; NORM_SUB; REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(x = w) ==> a / (x - w) - b / (x - w) = (a - b:complex) / (x - w)`] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; COMPLEX_POW_EQ_0; COMPLEX_SUB_0] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_IMP_LE; COMPLEX_NORM_POW] THEN MATCH_MP_TAC(REAL_ARITH `w < r /\ r <= x + w ==> abs(r - w) <= x`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_BALL; dist; NORM_SUB]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRAL) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC LIM_UNIQUE THEN MAP_EVERY EXISTS_TAC [`net:A net`; `\n. (f:A->complex->complex) n w`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[tendsto; dist] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL]] THEN SUBGOAL_THEN `((\n:A. Cx(&2) * Cx pi * ii * f n w) --> path_integral (circlepath (z,r)) (\u. g u / (u - w))) net` MP_TAC THENL [MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n:A. path_integral (circlepath (z,r)) (\u. f n u / (u - w))` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC CAUCHY_INTEGRAL_CIRCLEPATH THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o MATCH_MP LIM_COMPLEX_LMUL) THEN SIMP_TAC[CX_2PII_NZ; COMPLEX_FIELD `~(x * y * z = Cx(&0)) ==> Cx(&1) / (x * y * z) * x * y * z * w = w`]);; (* ------------------------------------------------------------------------- *) (* Version showing that the limit is the limit of the derivatives. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT = prove (`!net:(A net) f f' g z r. &0 < r /\ ~(trivial_limit net) /\ eventually (\n. (f n) continuous_on cball(z,r) /\ (!w. w IN ball(z,r) ==> ((f n) has_complex_derivative (f' n w)) (at w))) net /\ (!e. &0 < e ==> eventually (\n. !x. x IN cball(z,r) ==> norm(f n x - g x) < e) net) ==> g continuous_on cball(z,r) /\ ?g'. !w. w IN ball(z,r) ==> (g has_complex_derivative (g' w)) (at w) /\ ((\n. f' n w) --> g' w) net`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`net:(A)net`; `f:A->complex->complex`; `g:complex->complex`; `z:complex`; `r:real`] HOLOMORPHIC_UNIFORM_LIMIT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM])) THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':complex->complex` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. Cx(&1) / (Cx(&2) * Cx pi * ii) * (path_integral(circlepath(z,r)) (\x. f (n:A) x / (x - w) pow 2) - path_integral(circlepath(z,r)) (\x. g x / (x - w) pow 2))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB] THEN BINOP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THENL [EXISTS_TAC `(f:A->complex->complex) a`; EXISTS_TAC `g:complex->complex`] THEN EXISTS_TAC `w:complex` THEN ASM_SIMP_TAC[] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (rand o rand) CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH w)) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN ANTS_TAC THEN SIMP_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_VEC_0] THEN SUBST1_TAC(SYM(SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` COMPLEX_MUL_RZERO)) THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[GSYM LIM_NULL] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (rand o rand) PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH w)) THEN ANTS_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN SIMP_TAC[SUBSET; IN_CBALL; IN_ELIM_THM; NORM_SUB; dist; REAL_LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[COMPLEX_POW_EQ_0; ARITH; IN_ELIM_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_SUB_0] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e * abs(r - norm(w - z:complex)) pow 2`) THEN SUBGOAL_THEN `&0 < e * abs(r - norm(w - z:complex)) pow 2` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[GSYM REAL_ABS_NZ] THEN SIMP_TAC[REAL_SUB_0] THEN ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:complex` THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[dist; REAL_LE_REFL] THEN SUBGOAL_THEN `~(x:complex = w)` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[IN_BALL; dist; NORM_SUB; REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(x = w) ==> a / (x - w) pow 2 - b / (x - w) pow 2 = (a - b:complex) / (x - w) pow 2`] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; COMPLEX_POW_EQ_0; COMPLEX_SUB_0] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_IMP_LE; COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `w < r /\ r <= x + w ==> abs(r - w) <= x`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_BALL; dist; NORM_SUB]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE]);; (* ------------------------------------------------------------------------- *) (* Some more simple/convenient versions for applications. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_UNIFORM_SEQUENCE = prove (`!f g s. open s /\ (!n. (f n) holomorphic_on s) /\ (!x. x IN s ==> ?d. &0 < d /\ cball(x,d) SUBSET s /\ !e. &0 < e ==> eventually (\n. !y. y IN cball(x,d) ==> norm(f n y - g y) < e) sequentially) ==> g holomorphic_on s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`sequentially`; `f:num->complex->complex`; `g:complex->complex`; `z:complex`; `r:real`] HOLOMORPHIC_UNIFORM_LIMIT) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ANTS_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; BALL_SUBSET_CBALL]; SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN ASM_MESON_TAC[CENTRE_IN_BALL]]);; let HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE = prove (`!f f' g s. open s /\ (!n x. x IN s ==> ((f n) has_complex_derivative f' n x) (at x)) /\ (!x. x IN s ==> ?d. &0 < d /\ cball(x,d) SUBSET s /\ !e. &0 < e ==> eventually (\n. !y. y IN cball(x,d) ==> norm(f n y - g y) < e) sequentially) ==> ?g'. !x. x IN s ==> (g has_complex_derivative g'(x)) (at x) /\ ((\n. f' n x) --> g'(x)) sequentially`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`sequentially`; `f:num->complex->complex`; `f':num->complex->complex`; `g:complex->complex`; `z:complex`; `r:real`] HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[CENTRE_IN_BALL]] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; SUBSET]; ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET]]);; (* ------------------------------------------------------------------------- *) (* A one-stop shop for an analytic function defined by a series. *) (* ------------------------------------------------------------------------- *) let SERIES_AND_DERIVATIVE_COMPARISON = prove (`!f f' s k h. open s /\ (!n x. n IN k /\ x IN s ==> (f n has_complex_derivative f' n x) (at x)) /\ (?l. (lift o h sums l) k) /\ (?N. !n x. N <= n /\ n IN k /\ x IN s ==> norm(f n x) <= h n) ==> ?g g'. !x. x IN s ==> ((\n. f n x) sums g x) k /\ ((\n. f' n x) sums g' x) k /\ (g has_complex_derivative g' x) (at x)`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_COMPARISON_UNIFORM) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[TAUT `a ==> b /\ c /\ d <=> (a ==> b) /\ (a ==> d /\ c)`] THEN REWRITE_TAC[FORALL_AND_THM; RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[sums] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE THEN EXISTS_TAC `\n x. vsum (k INTER (0..n)) (\n. (f:num->complex->complex) n x)` THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_VSUM; FINITE_INTER_NUMSEG; IN_INTER] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[SUBSET]);; (* ------------------------------------------------------------------------- *) (* A version where we only have local uniform/comparative convergence. *) (* ------------------------------------------------------------------------- *) let SERIES_AND_DERIVATIVE_COMPARISON_LOCAL = prove (`!f f' s k. open s /\ (!n x. n IN k /\ x IN s ==> (f n has_complex_derivative f' n x) (at x)) /\ (!x. x IN s ==> ?d h N. &0 < d /\ (?l. (lift o h sums l) k) /\ !n y. N <= n /\ n IN k /\ y IN ball(x,d) ==> norm(f n y) <= h n) ==> ?g g'. !x. x IN s ==> ((\n. f n x) sums g x) k /\ ((\n. f' n x) sums g' x) k /\ (g has_complex_derivative g' x) (at x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. infsum k (\n. (f:num->complex->complex) n x)` THEN REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:real`; `h:num->real`; `N:num`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPECL [`f:num->complex->complex`; `f':num->complex->complex`; `ball(z:complex,d) INTER s`; `k:num->bool`; `h:num->real`] SERIES_AND_DERIVATIVE_COMPARISON) THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL; IN_INTER] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM; RIGHT_EXISTS_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN X_GEN_TAC `g':complex` THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[SUMS_INFSUM; CENTRE_IN_BALL; summable]; ALL_TAC] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN EXISTS_TAC `g:complex->complex` THEN MP_TAC(ISPEC `ball(z:complex,d) INTER s` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTER] THEN ASM_MESON_TAC[INFSUM_UNIQUE; SUBSET; IN_BALL; DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Sometimes convenient to compare with a complex series of +ve reals. *) (* ------------------------------------------------------------------------- *) let SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX = prove (`!f f' s k. open s /\ (!n x. n IN k /\ x IN s ==> (f n has_complex_derivative f' n x) (at x)) /\ (!x. x IN s ==> ?d h N. &0 < d /\ summable k h /\ (!n. n IN k ==> real(h n) /\ &0 <= Re(h n)) /\ (!n y. N <= n /\ n IN k /\ y IN ball(x,d) ==> norm(f n y) <= norm(h n))) ==> ?g g'. !x. x IN s ==> ((\n. f n x) sums g x) k /\ ((\n. f' n x) sums g' x) k /\ (g has_complex_derivative g' x) (at x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_LOCAL THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_THEN(X_CHOOSE_THEN `h:num->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n. norm((h:num->complex) n)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [summable]) THEN DISCH_THEN(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `lift(Re l)` THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\i:num. lift(Re(h i))` THEN ASM_SIMP_TAC[REAL_NORM_POS; o_DEF] THEN REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC SERIES_COMPONENT THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; let SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX = prove (`!f s k. open s /\ (!n x. n IN k /\ x IN s ==> (f n) complex_differentiable (at x)) /\ (!x. x IN s ==> ?d h N. &0 < d /\ summable k h /\ (!n. n IN k ==> real(h n) /\ &0 <= Re(h n)) /\ (!n y. N <= n /\ n IN k /\ y IN ball(x,d) ==> norm(f n y) <= norm(h n))) ==> ?g. !x. x IN s ==> ((\n. f n x) sums g x) k /\ g complex_differentiable (at x)`, REPEAT GEN_TAC THEN REWRITE_TAC[complex_differentiable; RIGHT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC (PAT_CONV `\x. a /\ x /\ b ==> x` o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN DISCH_THEN(CHOOSE_THEN (MP_TAC o MATCH_MP SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX)) THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* In particular, a power series is analytic inside circle of convergence. *) (* ------------------------------------------------------------------------- *) let POWER_SERIES_AND_DERIVATIVE_0 = prove (`!k a r. summable k (\n. a(n) * Cx(r) pow n) ==> ?g g'. !z. norm(z) < r ==> ((\n. a(n) * z pow n) sums g(z)) k /\ ((\n. Cx(&n) * a(n) * z pow (n - 1)) sums g'(z)) k /\ (g has_complex_derivative g' z) (at z)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < r` THEN ASM_SIMP_TAC[NORM_ARITH `~(&0 < r) ==> ~(norm z < r)`] THEN SUBGOAL_THEN `!z. norm(z) < r <=> z IN ball(Cx(&0),r)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG]; ALL_TAC] THEN MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX THEN REWRITE_TAC[OPEN_BALL; IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`(r - norm(z:complex)) / &2`; `\n. Cx(norm(a(n):complex) * ((r + norm(z:complex)) / &2) pow n)`; `0`] THEN ASM_REWRITE_TAC[REAL_SUB_LT; REAL_HALF; REAL_CX; RE_CX] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[CX_MUL; CX_POW] THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV_WEAK THEN EXISTS_TAC `Cx r` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPLEX_NORM_CX]; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_POW_LE; REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_MUL] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REWRITE_TAC[COMPLEX_NORM_POW; REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2] THEN ASM_NORM_ARITH_TAC);; let POWER_SERIES_AND_DERIVATIVE = prove (`!k a r w. summable k (\n. a(n) * Cx(r) pow n) ==> ?g g'. !z. z IN ball(w,r) ==> ((\n. a(n) * (z - w) pow n) sums g(z)) k /\ ((\n. Cx(&n) * a(n) * (z - w) pow (n - 1)) sums g'(z)) k /\ (g has_complex_derivative g' z) (at z)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP POWER_SERIES_AND_DERIVATIVE_0) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:complex->complex`; `g':complex->complex`] THEN DISCH_TAC THEN EXISTS_TAC `(\z. g(z - w)):complex->complex` THEN EXISTS_TAC `(\z. g'(z - w)):complex->complex` THEN REWRITE_TAC[IN_BALL; dist] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z - w:complex`) THEN ANTS_TAC THENL [ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM COMPLEX_MUL_RID] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN ASM_REWRITE_TAC[] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO]);; let POWER_SERIES_HOLOMORPHIC = prove (`!a k f z r. (!w. w IN ball(z,r) ==> ((\n. a(n) * (w - z) pow n) sums f w) k) ==> f holomorphic_on ball(z,r)`, REPEAT STRIP_TAC THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_BALL; dist] THEN DISCH_TAC THEN MP_TAC(ISPECL [`k:num->bool`; `a:num->complex`; `(norm(z - w:complex) + r) / &2`; `z:complex`] POWER_SERIES_AND_DERIVATIVE) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `z + Cx((norm(z - w) + r) / &2)`) THEN REWRITE_TAC[IN_BALL; dist; COMPLEX_RING `(z + w) - z:complex = w`; NORM_ARITH `norm(z - (z + w)) = norm w`; summable] THEN ANTS_TAC THENL [REWRITE_TAC[COMPLEX_NORM_CX]; MESON_TAC[]] THEN POP_ASSUM MP_TAC THEN NORM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g':complex->complex` (LABEL_TAC "*")) THEN EXISTS_TAC `(g':complex->complex) w` THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`g:complex->complex`; `(r - norm(z - w:complex)) / &2`] THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `norm(z - w:complex) < r` THEN NORM_ARITH_TAC; ALL_TAC; REMOVE_THEN "*" (MP_TAC o SPEC `w:complex`) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN REWRITE_TAC[IN_BALL] THEN UNDISCH_TAC `norm(z - w:complex) < r` THEN NORM_ARITH_TAC] THEN X_GEN_TAC `u:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `(\n. a(n) * (u - z) pow n):num->complex` THEN EXISTS_TAC `k:num->bool` THEN CONJ_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `u:complex`) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]]; FIRST_X_ASSUM MATCH_MP_TAC] THEN REWRITE_TAC[IN_BALL] THEN ASM_NORM_ARITH_TAC);; let HOLOMORPHIC_IFF_POWER_SERIES = prove (`!f z r. f holomorphic_on ball(z,r) <=> !w. w IN ball(z,r) ==> ((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (w - z) pow n) sums f w) (from 0)`, REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_POWER_SERIES]; ALL_TAC] THEN MATCH_MP_TAC POWER_SERIES_HOLOMORPHIC THEN MAP_EVERY EXISTS_TAC [`\n. higher_complex_derivative n f z / Cx(&(FACT n))`; `from 0`] THEN ASM_REWRITE_TAC[]);; let POWER_SERIES_ANALYTIC = prove (`!a k f z r. (!w. w IN ball(z,r) ==> ((\n. a(n) * (w - z) pow n) sums f w) k) ==> f analytic_on ball(z,r)`, SIMP_TAC[ANALYTIC_ON_OPEN; OPEN_BALL] THEN REWRITE_TAC[POWER_SERIES_HOLOMORPHIC]);; let ANALYTIC_IFF_POWER_SERIES = prove (`!f z r. f analytic_on ball(z,r) <=> !w. w IN ball(z,r) ==> ((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (w - z) pow n) sums f w) (from 0)`, SIMP_TAC[ANALYTIC_ON_OPEN; OPEN_BALL] THEN REWRITE_TAC[HOLOMORPHIC_IFF_POWER_SERIES]);; let HIGHER_COMPLEX_DERIVATIVE_POWER_SERIES = prove (`!f c r n. &0 < r /\ n IN k /\ (!w. dist(w,z) < r ==> ((\i. c i * (w - z) pow i) sums f(w)) k) ==> higher_complex_derivative n f z / Cx(&(FACT n)) = c n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `f holomorphic_on ball(z,r)` ASSUME_TAC THENL [MATCH_MP_TAC POWER_SERIES_HOLOMORPHIC THEN REWRITE_TAC[IN_BALL] THEN ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN SUBGOAL_THEN `!i. i IN (:num) ==> higher_complex_derivative i f z / Cx(&(FACT i)) - (if i IN k then c i else vec 0) = Cx(&0)` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_UNIV; COMPLEX_SUB_0]] THEN MATCH_MP_TAC POWER_SERIES_LIMIT_POINT_OF_ZEROS THEN MAP_EVERY EXISTS_TAC [`\w:complex. Cx(&0)`; `z:complex`; `r:real`; `ball(z:complex,r)`] THEN ASM_SIMP_TAC[LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_SUB_RDISTRIB] THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = (f:complex->complex) w - f w`) THEN MATCH_MP_TAC SERIES_SUB THEN CONJ_TAC THENL [REWRITE_TAC[GSYM FROM_0] THEN MATCH_MP_TAC HOLOMORPHIC_POWER_SERIES THEN ASM_MESON_TAC[IN_BALL; DIST_SYM]; REWRITE_TAC[COND_RAND; COND_RATOR; COMPLEX_VEC_0] THEN REWRITE_TAC[COMPLEX_MUL_LZERO] THEN ASM_SIMP_TAC[GSYM COMPLEX_VEC_0; SERIES_RESTRICT]]);; (* ------------------------------------------------------------------------- *) (* Taylor series for log. It's this late because we can more easily get *) (* a good error bound given the convergence of the series. *) (* ------------------------------------------------------------------------- *) let CLOG_CONVERGES = prove (`!z. norm(z) < &1 ==> ((\n. --Cx(&1) pow (n + 1) * z pow n / Cx(&n)) sums clog(Cx(&1) + z)) (from 1)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`clog o (\z. Cx(&1) + z)`; `Cx(&0)`; `&1`] HOLOMORPHIC_IFF_POWER_SERIES) THEN REWRITE_TAC[COMPLEX_IN_BALL_0; o_THM] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL [REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC; MATCH_MP_TAC HOLOMORPHIC_ON_CLOG THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RE_ADD; RE_CX] THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(Re x) <= norm x /\ norm x < &1 ==> &0 < &1 + Re x`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN REWRITE_TAC[o_DEF; higher_complex_derivative; CLOG_1; COMPLEX_ADD_RID] THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMS_EQ) THEN REWRITE_TAC[COMPLEX_RING `(h * f) * z = p * z * g <=> z = Cx(&0) \/ h * f = p * g`] THEN SUBGOAL_THEN `!n w. 1 <= n /\ norm w < &1 ==> higher_complex_derivative n (\z. clog(Cx(&1) + z)) w = --Cx(&1) pow (n + 1) * Cx(&(FACT(n - 1))) / (Cx(&1) + w) pow n` (fun th -> SIMP_TAC[IN_FROM; COMPLEX_NORM_0; REAL_LT_01; th]) THENL [INDUCT_TAC THEN REWRITE_TAC[ARITH; higher_complex_derivative] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[higher_complex_derivative] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_POW_1] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[complex_div; COMPLEX_POW_NEG; COMPLEX_ADD_LID] THEN REWRITE_TAC[COMPLEX_POW_ONE; ARITH; COMPLEX_MUL_LID] THEN DISCH_TAC THEN REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `abs(Re x) <= norm x /\ norm x < &1 ==> &0 < &1 + Re x`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`\w. --Cx(&1) pow (n + 1) * Cx(&(FACT(n - 1))) / (Cx(&1) + w) pow n`; `ball(Cx(&0),&1)`] THEN ASM_SIMP_TAC[OPEN_BALL; LE_1; COMPLEX_IN_BALL_0] THEN COMPLEX_DIFF_TAC THEN ASM_SIMP_TAC[FACT; ARITH_RULE `~(n = 0) ==> SUC n - 1 = SUC(n - 1)`] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_POW_ADD; complex_pow; COMPLEX_POW_1] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; complex_div; COMPLEX_SUB_LZERO] THEN REWRITE_TAC[GSYM complex_div; COMPLEX_NEG_NEG; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN REWRITE_TAC[GSYM(CONJUNCT2 complex_pow); complex_div] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN ASM_REWRITE_TAC[GSYM complex_div; COMPLEX_POW_EQ_0] THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ (p ==> q)`] THEN SIMP_TAC[COMPLEX_DIV_POW2; COMPLEX_POW_POW] THEN ASM_REWRITE_TAC[ARITH_RULE `n * 2 <= n - 1 <=> n = 0`] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n * 2 - (n - 1) = SUC n`] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN REWRITE_TAC[complex_div; CX_MUL; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[COMPLEX_MUL_AC] THEN MP_TAC(SPEC `&1` COMPLEX_NORM_CX) THEN UNDISCH_TAC `norm(w:complex) < &1` THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN CONV_TAC NORM_ARITH]; MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH] THEN X_GEN_TAC `n:num` THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN DISJ2_TAC THEN REWRITE_TAC[FACT; ARITH_RULE `SUC n - 1 = n`; COMPLEX_ADD_RID] THEN REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_DIV_1; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[CX_MUL; COMPLEX_INV_MUL; COMPLEX_RING `(a * f) * i * n = a * i <=> f * n = Cx(&1) \/ a * i = Cx(&0)`] THEN SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]]);; let CLOG_CONVERGES_STRONG = prove (`!z. norm(z) <= &1 /\ ~(z = --Cx(&1)) ==> ((\n. --Cx(&1) pow (n + 1) * z pow n / Cx(&n)) sums clog(Cx(&1) + z)) (from 1)`, SUBGOAL_THEN `!z. norm(z) <= &1 /\ ~(z = --Cx(&1)) ==> summable (from 1) (\n. --Cx(&1) pow (n + 1) * z pow n / Cx(&n))` MP_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC SERIES_DIRICHLET_COMPLEX THEN MAP_EVERY EXISTS_TAC [`1`; `0`] THEN REWRITE_TAC[LIM_INV_N; REAL_INV_EQ; REAL_CX; GSYM CX_INV; RE_CX] THEN ASM_SIMP_TAC[REAL_LE_INV2; GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1; REAL_ARITH `&n <= &n + &1`] THEN REWRITE_TAC[COMPLEX_POW_ADD; GSYM COMPLEX_POW_MUL; COMPLEX_RING `(a * --Cx(&1) pow 1) * c = --(a * c)`] THEN REWRITE_TAC[VSUM_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN ASM_REWRITE_TAC[VSUM_GP; COMPLEX_RING `--z = Cx(&1) <=> z = --Cx(&1)`] THEN REWRITE_TAC[CONJUNCT1 complex_pow; CONJUNCT1 LT; bounded] THEN EXISTS_TAC `&2 / norm(Cx(&1) + z)` THEN REWRITE_TAC[FORALL_IN_GSPEC; COMPLEX_RING `w - --z:complex = w + z`] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_DIV; real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; NORM_POS_LE] THEN MATCH_MP_TAC(NORM_ARITH `norm(x) = &1 /\ norm(y) <= &1 ==> norm(x - y) <= &2`) THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[NORM_NEG; NORM_POS_LE]; REWRITE_TAC[summable] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `l:complex->complex` THEN DISCH_TAC THEN SUBGOAL_THEN `!z. norm z < &1 ==> l z = clog(Cx(&1) + z)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOG_CONVERGES) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SERIES_UNIQUE) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; NORM_NEG; REAL_LT_REFL]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN ASM_CASES_TAC `norm(z:complex) < &1` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `norm(z:complex) = &1` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `clog(Cx(&1) + z) = l z` (fun th -> ASM_MESON_TAC[th]) THEN MATCH_MP_TAC(ISPEC `at (vec 1:real^1) within interval(vec 0,vec 1)` LIM_UNIQUE) THEN EXISTS_TAC `(l:complex->complex) o (\t. drop t % z)` THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN SIMP_TAC[LIMPT_OF_OPEN_CLOSURE; CLOSURE_INTERVAL; OPEN_INTERVAL; UNIT_INTERVAL_NONEMPTY; ENDS_IN_UNIT_INTERVAL] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\t. clog(Cx(&1) + drop t % z)` THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[VECTOR_SUB_EQ; o_THM; EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; FORALL_LIFT] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; DIST_LIFT] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `norm z = &1 ==> x < &1 * norm z ==> x < &1`)) THEN REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(ISPEC `clog` LIM_CONTINUOUS_FUNCTION) THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_AT_CLOG THEN REWRITE_TAC[RE_ADD; RE_CX; IM_ADD; IM_CX; REAL_ADD_LID] THEN MATCH_MP_TAC(REAL_ARITH `abs(Re z) <= norm z /\ norm z = &1 /\ ~(Re z = -- &1 /\ Im z = &0) ==> Im z = &0 ==> &0 < &1 + Re z`) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(z = --Cx(&1))` THEN REWRITE_TAC[COMPLEX_EQ; RE_NEG; IM_NEG; RE_CX; IM_CX] THEN REAL_ARITH_TAC; MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIFT_NUM; o_DEF; LIFT_DROP; LIM_WITHIN_ID]]]; MATCH_MP_TAC LIM_COMPOSE_WITHIN THEN EXISTS_TAC `{w:complex | norm(z - w) <= &1 * (norm z - norm w)}` THEN EXISTS_TAC `&1 % z:complex` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIFT_NUM; o_DEF; LIFT_DROP; LIM_WITHIN_ID]; REWRITE_TAC[EVENTUALLY_WITHIN; VECTOR_MUL_LID] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM] THEN X_GEN_TAC `t:real` THEN REWRITE_TAC[NORM_MUL; DIST_LIFT] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH `z - t % z = (&1 - t) % z`] THEN REWRITE_TAC[REAL_ARITH `x - t * x:real = (&1 - t) * x`] THEN REWRITE_TAC[NORM_MUL; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`&1`; `from 1`; `\n. --Cx(&1) pow (n + 1) / Cx(&n)`; `z:complex`] ABEL_LIMIT_THEOREM) THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a / c * b:complex = a * b / c`] THEN REWRITE_TAC[REAL_LT_01] THEN ANTS_TAC THENL [ASM_MESON_TAC[summable]; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC(MESON[LIM_TRANSFORM] `l = m /\ ((\x. f x - g x) --> vec 0) net ==> (f --> l) net ==> (g --> m) net`) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC INFSUM_UNIQUE THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[REAL_MUL_LID] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `norm(z - w:complex) <= norm(z) - norm(w)` THEN ASM_REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[NORM_ARITH `norm(x - y) <= &0 <=> x = y`] THEN CONV_TAC NORM_ARITH]]);; let TAYLOR_CLOG = prove (`!n z. norm(z) < &1 ==> norm(clog(Cx(&1) + z) - vsum(1..n) (\k. --Cx(&1) pow (k + 1) * z pow k / Cx(&k))) <= norm z pow (n + 1) / (&1 - norm z)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `z:complex` CLOG_CONVERGES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n + 1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ADD_SUB]] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SERIES_BOUND)) THEN EXISTS_TAC `\k. norm(z:complex) pow k` THEN REWRITE_TAC[GSYM SERIES_CX_LIFT; o_DEF; CX_POW; CX_DIV; CX_SUB] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NORM; SUMS_GP] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW; NORM_NEG] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; GSYM COMPLEX_NORM_POW] THEN SUBGOAL_THEN `0 < m` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x * (m - &1) ==> x <= x * m`) THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE; REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_1]);; let TAYLOR_CLOG_NEG = prove (`!n z. norm(z) < &1 ==> norm(clog(Cx(&1) - z) + vsum(1..n) (\k. z pow k / Cx(&k))) <= norm z pow (n + 1) / (&1 - norm z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`n:num`; `--z:complex`] TAYLOR_CLOG) THEN ASM_REWRITE_TAC[NORM_NEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB; GSYM VSUM_NEG] THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_POW_ONE; complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_POW_1] THEN REWRITE_TAC[COMPLEX_MUL_RID; COMPLEX_NEG_NEG] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM COMPLEX_POW_MUL] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_LID; COMPLEX_NEG_NEG]);; let LOG2_APPROX_32 = prove (`abs(log(&2) - &2977044471 / &4294967296) <= inv(&2 pow 32)`, MP_TAC(SPECL [`35`; `Cx(--inv(&2))`] TAYLOR_CLOG) THEN SIMP_TAC[GSYM CX_DIV; GSYM CX_POW; GSYM CX_NEG; GSYM CX_ADD; GSYM CX_MUL; VSUM_CX; COMPLEX_NORM_CX; GSYM CX_LOG; GSYM CX_SUB; REAL_ARITH `&0 < &1 + --inv(&2)`] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `a * b / c:real = a / c * b`] THEN CONV_TAC(ONCE_DEPTH_CONV EXPAND_SUM_CONV) THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN SIMP_TAC[LOG_INV; REAL_ARITH `&0 < &2`] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Taylor series for arctan. *) (* ------------------------------------------------------------------------- *) let CATN_CONVERGES_STRONG = prove (`!z. norm z <= &1 /\ ~(z = ii) /\ ~(z = --ii) ==> ((\n. --Cx(&1) pow n / Cx(&(2 * n + 1)) * z pow (2 * n + 1)) sums catn z) (from 0)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SERIES_ODD] THEN MP_TAC(ISPEC `ii * z` CLOG_CONVERGES_STRONG) THEN MP_TAC(ISPEC `--ii * z` CLOG_CONVERGES_STRONG) THEN ASM_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_II; NORM_NEG] THEN ASM_REWRITE_TAC[COMPLEX_RING `ii * z = --Cx(&1) <=> z = ii`] THEN ASM_REWRITE_TAC[COMPLEX_RING `--ii * z = --Cx(&1) <=> z = --ii`] THEN ASM_REWRITE_TAC[REAL_MUL_LID; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `ii / Cx(&2)` o MATCH_MP SERIES_COMPLEX_LMUL) THEN REWRITE_TAC[COMPLEX_RING `a + --ii * z = a - ii * z`] THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN MATCH_MP_TAC(MESON[] `f = g /\ l = m ==> (f sums l) s ==> (g sums m) s`) THEN CONJ_TAC THENL [SIMP_TAC[FUN_EQ_THM; COMPLEX_POW_ADD; COMPLEX_POW_1; SIMPLE_COMPLEX_ARITH `(a * --Cx(&1)) * b / c - (a * --Cx(&1)) * b' / c = (a * b' - a * b) / c`] THEN X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[GSYM COND_SWAP] THEN REWRITE_TAC[COMPLEX_VEC_0] THEN REWRITE_TAC[GSYM COMPLEX_POW_MUL; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[COMPLEX_NEG_NEG; COMPLEX_MUL_LID] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COMPLEX_POW_NEG] THEN REWRITE_TAC[NOT_ODD] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM; ADD1] THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `(2 * m + 1) DIV 2 = m`; SIMPLE_COMPLEX_ARITH `i / Cx(&2) * (--x - x) / y = --i * x / y`] THEN REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_POW_1; complex_div] THEN REWRITE_TAC[COMPLEX_RING `--ii * (x * ii * z) * y = x * y * z`] THEN REWRITE_TAC[COMPLEX_POW_MUL; GSYM COMPLEX_POW_POW; COMPLEX_POW_II_2] THEN REWRITE_TAC[COMPLEX_MUL_AC]; REWRITE_TAC[catn] THEN AP_TERM_TAC THEN MATCH_MP_TAC(GSYM CLOG_DIV_POS) THEN REWRITE_TAC[RE_SUB; RE_MUL_II; RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `abs x < &1 ==> &0 < &1 - --x /\ &0 < &1 + --x`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n <= &1 ==> a <= n /\ (a = &1 ==> ~(n = &1)) ==> a < &1`)) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; GSYM NORM_POW_2] THEN REWRITE_TAC[COMPLEX_SQNORM] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN SIMP_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_EQ_ADD_RCANCEL_0] THEN REWRITE_TAC[REAL_POW_EQ_0; ARITH_EQ; REAL_ABS_ZERO] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE_II; IM_NEG; IM_II; RE_NEG] THEN ASM_REAL_ARITH_TAC]);; let CATN_CONVERGES = prove (`!z. norm(z) < &1 ==> ((\n. --(Cx(&1)) pow n / Cx(&(2 * n + 1)) * z pow (2 * n + 1)) sums catn(z)) (from 0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CATN_CONVERGES_STRONG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_II] THEN REAL_ARITH_TAC);; let TAYLOR_CATN = prove (`!n z. norm(z) < &1 ==> norm(catn z - vsum(0..n) (\k. --(Cx(&1)) pow k / Cx(&(2 * k + 1)) * z pow (2 * k + 1))) <= norm(z) pow (2 * n + 3) / ((&2 * &n + &3) * (&1 - norm z pow 2))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CATN_CONVERGES) THEN DISCH_THEN(MP_TAC o SPEC `n + 1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `0 < n + 1`; ADD_SUB] THEN MATCH_MP_TAC(MESON[] `(!l. (f sums l) k ==> norm l <= e) ==> (f sums a) k ==> norm a <= e`) THEN GEN_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] SERIES_BOUND) THEN EXISTS_TAC `\i. norm(z:complex) / (&2 * &n + &3) * (norm(z) pow 2) pow i` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SERIES_CX_LIFT; o_DEF] THEN MP_TAC(ISPECL [`n + 1`; `Cx(norm(z:complex) pow 2)`] SUMS_GP) THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_POW; REAL_ABS_NORM; ABS_SQUARE_LT_1; REAL_ABS_ABS] THEN DISCH_THEN(MP_TAC o SPEC `Cx(norm(z:complex) / (&2 * &n + &3))` o MATCH_MP SERIES_COMPLEX_LMUL) THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_SUB; GSYM CX_DIV; GSYM CX_MUL] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_POW_POW; REAL_POW_ADD; REAL_POW_1; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC; X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_FROM] THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_POW_ONE] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `a / b * c:real = inv b * (a * c)`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow); REAL_POW_POW; ADD1] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN REWRITE_TAC[REAL_MUL_LID; real_div] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_MUL] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The classical limit for e and other useful limits. *) (* ------------------------------------------------------------------------- *) let CEXP_LIMIT = prove (`!z. ((\n. (Cx(&1) + z / Cx(&n)) pow n) --> cexp(z)) sequentially`, GEN_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. cexp(Cx(&n) * clog(Cx(&1) + z / Cx(&n)))` THEN CONJ_TAC THENL [REWRITE_TAC[CEXP_N; EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(SPEC `norm(z:complex) + &1` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[LE] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[NORM_ARITH `~(norm(z:complex) + &1 <= &0)`]; DISCH_TAC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CEXP_CLOG THEN ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; COMPLEX_FIELD `~(n = Cx(&0)) ==> (Cx(&1) + z / n = Cx(&0) <=> z = --n)`] THEN DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\n. Cx(&2 * norm(z:complex) pow 2) * inv(Cx(&n))` THEN SIMP_TAC[LIM_INV_N; LIM_NULL_COMPLEX_LMUL] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(SPEC `&2 * norm(z:complex) + &1` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `MAX N (MAX 1 2)` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN STRIP_TAC THEN ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_FIELD `~(n = Cx(&0)) ==> n * l - z = (l - z / n) * n`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_NORM_INV] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN MP_TAC(ISPECL [`1`; `z / Cx(&n)`] TAYLOR_CLOG) THEN REWRITE_TAC[GSYM CX_ADD; VSUM_SING_NUMSEG; COMPLEX_NORM_CX] THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM; COMPLEX_DIV_1] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_POW_NEG; COMPLEX_POW_ONE; ARITH] THEN REWRITE_TAC[COMPLEX_MUL_LID; REAL_POW_DIV] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_ARITH `a / b / c:real = (a / c) * inv b`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_NORM; REAL_ABS_POW; real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 / &2 <= &1 - x * &1 / n <=> x / n <= &1 / &2`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC]);; let EXP_LIMIT = prove (`!x. ((\n. (&1 + x / &n) pow n) ---> exp(x)) sequentially`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_POW; CX_ADD; CX_DIV; CX_EXP] THEN REWRITE_TAC[CEXP_LIMIT]);; let LIM_LOGPLUS1_OVER_X = prove (`((\x. clog(Cx(&1) + x) / x) --> Cx(&1)) (at(Cx(&0)))`, ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\x. Cx(&2) * x` THEN CONJ_TAC THENL [ALL_TAC; LIM_TAC THEN REWRITE_TAC[COMPLEX_MUL_RZERO]] THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `&1 / &2` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[dist; COMPLEX_SUB_RZERO; COMPLEX_NORM_NZ] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `norm(z:complex)` THEN ASM_REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_NORM_NZ] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(z = Cx(&0)) ==> z * (l / z - Cx(&1)) = l - z`] THEN MP_TAC(ISPECL [`1`; `z:complex`] TAYLOR_CLOG) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[VSUM_SING_NUMSEG]] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_DIV_1] THEN REWRITE_TAC[COMPLEX_POW_NEG; ARITH_EVEN; COMPLEX_POW_ONE] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[COMPLEX_RING `z * Cx(&2) * z = z pow 2 * Cx(&2)`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; real_div; COMPLEX_NORM_CX] THEN REWRITE_TAC[GSYM COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC);; let LIM_N_MUL_SUB_CLOG = prove (`!w z. ((\n. Cx(&n) * (clog(Cx(&n) + w) - clog(Cx(&n) + z))) --> w - z) sequentially`, REPEAT GEN_TAC THEN ASM_CASES_TAC `w:complex = z` THEN ASM_REWRITE_TAC[COMPLEX_SUB_REFL; LIM_CONST; COMPLEX_MUL_RZERO] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (Cx(&n) + z) / (Cx(&1) + z / Cx(&n)) * clog(Cx(&1) + (w - z) / (Cx(&n) + z))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(SPEC `max (norm(w:complex)) (norm(z:complex)) + &1` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < Re(Cx(&n) + w) /\ &0 < Re(Cx(&n) + z)` MP_TAC THENL [REWRITE_TAC[RE_ADD; RE_CX] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH `norm z < n /\ abs(Re z) <= norm z ==> &0 < n + Re z`) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REAL_ARITH_TAC; MAP_EVERY ASM_CASES_TAC [`Cx(&n) + w = Cx(&0)`; `Cx(&n) + z = Cx(&0)`] THEN ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL] THEN STRIP_TAC] THEN SUBGOAL_THEN `~(Cx(&n) = Cx(&0))` ASSUME_TAC THENL [REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `max (norm(w:complex)) (norm (z:complex)) + &1 <= &N` THEN RULE_ASSUM_TAC(REWRITE_RULE[CONJUNCT1 LE]) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; ASM_SIMP_TAC[COMPLEX_FIELD `~(n + z = Cx(&0)) /\ ~(n = Cx(&0)) ==> (n + z) / (Cx(&1) + z / n) = n`] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(n + z = Cx(&0)) ==> Cx(&1) + (w - z) / (n + z) = (n + w) / (n + z)`] THEN REWRITE_TAC[complex_div] THEN IMP_REWRITE_TAC[CLOG_MUL_SIMPLE] THEN ASM_REWRITE_TAC[COMPLEX_INV_EQ_0] THEN ASM_SIMP_TAC[CLOG_INV] THEN CONJ_TAC THENL [CONV_TAC COMPLEX_RING; REWRITE_TAC[IM_NEG]] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) < pi / &2 /\ abs(y) < pi / &2 ==> --pi < x + --y /\ x + --y <= pi`) THEN ASM_SIMP_TAC[RE_CLOG_POS_LT]]; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a / b * c:complex = inv b * a * c`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_LID] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_INV_1] THEN MATCH_MP_TAC LIM_COMPLEX_INV THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST; complex_div] THEN SIMP_TAC[LIM_NULL_COMPLEX_LMUL; LIM_INV_N]; ALL_TAC] THEN SUBGOAL_THEN `(\n. (Cx(&n) + z) * clog (Cx(&1) + (w - z) / (Cx(&n) + z))) = (\x. (w - z) * clog(Cx(&1) + x) / x) o (\n. (w - z) / (Cx(&n) + z))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; complex_div] THEN REWRITE_TAC[COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPOSE_AT THEN EXISTS_TAC `Cx(&0)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[complex_div] THEN SIMP_TAC[LIM_INV_N_OFFSET; LIM_NULL_COMPLEX_LMUL]; REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(SPEC `norm(z:complex) + &1` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN ASM_REWRITE_TAC[COMPLEX_DIV_EQ_0; COMPLEX_SUB_0] THEN REWRITE_TAC[COMPLEX_RING `n + z = Cx(&0) <=> z = --n`] THEN DISCH_TAC THEN UNDISCH_TAC `norm(z:complex) + &1 <= &N` THEN ASM_REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_RID] THEN SIMP_TAC[LIM_COMPLEX_LMUL; LIM_LOGPLUS1_OVER_X]]]);; let LIM_SUB_CLOG = prove (`!w z. ((\n. clog(Cx(&n) + w) - clog(Cx(&n) + z)) --> Cx(&0)) sequentially`, REPEAT GEN_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = Cx(&0) * (w - z)`) THEN EXISTS_TAC `\n. inv(Cx(&n)) * Cx(&n) * (clog(Cx(&n) + w) - clog(Cx(&n) + z))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; GSYM REAL_OF_NUM_EQ] THEN REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD; MATCH_MP_TAC LIM_COMPLEX_MUL THEN REWRITE_TAC[LIM_INV_N; LIM_N_MUL_SUB_CLOG]]);; (* ------------------------------------------------------------------------- *) (* Equality between holomorphic functions, on open ball then connected set. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_FUN_EQ_ON_BALL = prove (`!f g z r w. f holomorphic_on ball(z,r) /\ g holomorphic_on ball(z,r) /\ w IN ball(z,r) /\ (!n. higher_complex_derivative n f z = higher_complex_derivative n g z) ==> f w = g w`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (w - z) pow n)` THEN EXISTS_TAC `(from 0)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC []] THEN ASM_MESON_TAC [HOLOMORPHIC_POWER_SERIES]);; let HOLOMORPHIC_FUN_EQ_0_ON_BALL = prove (`!f z r w. w IN ball(z,r) /\ f holomorphic_on ball(z,r) /\ (!n. higher_complex_derivative n f z = Cx(&0)) ==> f w = Cx(&0)`, REPEAT STRIP_TAC THEN SUBST1_TAC (GSYM (BETA_CONV `(\z:complex. Cx(&0)) w`)) THEN MATCH_MP_TAC HOLOMORPHIC_FUN_EQ_ON_BALL THEN REWRITE_TAC [HOLOMORPHIC_ON_CONST; HIGHER_COMPLEX_DERIVATIVE_CONST] THEN ASM_MESON_TAC []);; let HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED = prove (`!f s z. open s /\ connected s /\ f holomorphic_on s /\ z IN s /\ (!n. higher_complex_derivative n f z = Cx(&0)) ==> !w. w IN s ==> f w = Cx(&0)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{w | w IN s /\ !n. higher_complex_derivative n f w = Cx(&0)}`) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[higher_complex_derivative]] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `open(s:complex->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_BALL; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:complex` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `u:complex` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_FUN_EQ_0_ON_BALL THEN MAP_EVERY EXISTS_TAC [`w:complex`; `e:real`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; OPEN_BALL; SUBSET]; ASM_REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]]; SUBGOAL_THEN `closed_in (subtopology euclidean s) (INTERS (IMAGE (\n. {w | w IN s /\ higher_complex_derivative n f w = Cx(&0)}) (:num)))` MP_TAC THENL [MATCH_MP_TAC CLOSED_IN_INTERS THEN REWRITE_TAC[IMAGE_EQ_EMPTY; UNIV_NOT_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN SIMP_TAC[ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SIMP_TAC[INTERS; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN SET_TAC[]]]);; let HOLOMORPHIC_FUN_EQ_ON_CONNECTED = prove (`!f g z s w. open s /\ connected s /\ f holomorphic_on s /\ g holomorphic_on s /\ w IN s /\ z IN s /\ (!n. higher_complex_derivative n f z = higher_complex_derivative n g z) ==> f w = g w`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. (f:complex->complex) z - g z`; `s:complex->bool`; `z:complex`] HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED) THEN ASM_REWRITE_TAC[RIGHT_IMP_FORALL_THM; HOLOMORPHIC_ON_SUB] THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB] THEN MP_TAC(ISPECL [`f:complex->complex`; `g:complex->complex`; `s:complex->bool`] HIGHER_COMPLEX_DERIVATIVE_SUB) THEN ASM_SIMP_TAC[COMPLEX_SUB_0]);; let HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED = prove (`!f s z. open s /\ connected s /\ f holomorphic_on s /\ z IN s /\ (!n. 0 < n ==> higher_complex_derivative n f z = Cx(&0)) ==> !w. w IN s ==> f w = f z`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\w. (f:complex->complex) w - f z`; `s:complex->bool`; `z:complex`] HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED) THEN ASM_REWRITE_TAC[COMPLEX_SUB_0; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[higher_complex_derivative; COMPLEX_SUB_REFL] THEN MP_TAC(ISPECL [`f:complex->complex`; `(\w. f(z:complex)):complex->complex`; `s:complex->bool`; `n:num`; `z:complex`] HIGHER_COMPLEX_DERIVATIVE_SUB) THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[LE_1; HIGHER_COMPLEX_DERIVATIVE_CONST; COMPLEX_SUB_REFL]);; (* ------------------------------------------------------------------------- *) (* Some basic lemmas about poles/singularities. *) (* ------------------------------------------------------------------------- *) let POLE_LEMMA = prove (`!f s a. f holomorphic_on s /\ a IN interior(s) ==> (\z. if z = a then complex_derivative f a else (f(z) - f(a)) / (z - a)) holomorphic_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(a:complex) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!z. z IN s /\ ~(z = a) ==> (\z. if z = a then complex_derivative f a else (f(z) - f(a)) / (z - a)) complex_differentiable (at z within s)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN EXISTS_TAC `\z:complex. (f(z) - f(a)) / (z - a)` THEN EXISTS_TAC `dist(a:complex,z)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_WITHIN THEN ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID] THEN ASM_MESON_TAC[holomorphic_on; complex_differentiable]]; ALL_TAC] THEN REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `z:complex = a` THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN SUBGOAL_THEN `(\z. if z = a then complex_derivative f a else (f z - f a) / (z - a)) holomorphic_on ball(a,e)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; GSYM complex_differentiable; CENTRE_IN_BALL; COMPLEX_DIFFERENTIABLE_AT_WITHIN]] THEN MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `{a:complex}` THEN SIMP_TAC[OPEN_BALL; FINITE_RULES] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s DELETE (a:complex)` THEN ASM_SIMP_TAC[SET_RULE `b SUBSET s ==> b DIFF {a} SUBSET s DELETE a`] THEN ASM_SIMP_TAC[holomorphic_on; GSYM complex_differentiable; IN_DELETE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[]; ALL_TAC] THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_DIFF; FINITE_IMP_CLOSED; OPEN_BALL; FINITE_INSERT; FINITE_RULES; GSYM complex_differentiable] THEN REWRITE_TAC[IN_DIFF; IN_BALL; IN_SING] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w:complex = a` THENL [ALL_TAC; ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT]] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `f holomorphic_on ball(a,e)` MP_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN REWRITE_TAC[GSYM complex_differentiable; IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[GSYM HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT; CONTINUOUS_AT] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LIM_TRANSFORM_AT) THEN EXISTS_TAC `&1` THEN REWRITE_TAC[GSYM DIST_NZ; REAL_LT_01] THEN X_GEN_TAC `u:complex` THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; let POLE_LEMMA_OPEN = prove (`!f s a. open s /\ f holomorphic_on s ==> (\z. if z = a then complex_derivative f a else (f z - f a) / (z - a)) holomorphic_on s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:complex) IN s` THENL [MATCH_MP_TAC POLE_LEMMA THEN ASM_SIMP_TAC[INTERIOR_OPEN]; ALL_TAC] THEN REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`\z:complex. (f(z) - f(a)) / (z - a)`; `&1`] THEN ASM_REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_WITHIN THEN ASM_REWRITE_TAC[COMPLEX_SUB_0; CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID] THEN ASM_MESON_TAC[holomorphic_on; complex_differentiable]);; let POLE_THEOREM = prove (`!f g s a. g holomorphic_on s /\ a IN interior(s) /\ (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) ==> (\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) holomorphic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP POLE_LEMMA) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex` o last o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD);; let POLE_THEOREM_OPEN = prove (`!f g s a. open s /\ g holomorphic_on s /\ (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) ==> (\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) holomorphic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP POLE_LEMMA_OPEN) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex` o last o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD);; let POLE_THEOREM_0 = prove (`!f g s a. g holomorphic_on s /\ a IN interior(s) /\ (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) /\ f a = complex_derivative g a /\ g(a) = Cx(&0) ==> f holomorphic_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) holomorphic_on s` MP_TAC THENL [ASM_SIMP_TAC[POLE_THEOREM]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING);; let POLE_THEOREM_OPEN_0 = prove (`!f g s a. open s /\ g holomorphic_on s /\ (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) /\ f a = complex_derivative g a /\ g(a) = Cx(&0) ==> f holomorphic_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) holomorphic_on s` MP_TAC THENL [ASM_SIMP_TAC[POLE_THEOREM_OPEN]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING);; let POLE_THEOREM_ANALYTIC = prove (`!f g s a. g analytic_on s /\ (!z. z IN s ==> ?d. &0 < d /\ !w. w IN ball(z,d) /\ ~(w = a) ==> g(w) = (w - a) * f(w)) ==> (\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) analytic_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B")) THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REMOVE_THEN "A" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC POLE_THEOREM_OPEN THEN ASM_SIMP_TAC[BALL_MIN_INTER; OPEN_BALL; IN_INTER] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; let POLE_THEOREM_ANALYTIC_0 = prove (`!f g s a. g analytic_on s /\ (!z. z IN s ==> ?d. &0 < d /\ !w. w IN ball(z,d) /\ ~(w = a) ==> g(w) = (w - a) * f(w)) /\ f a = complex_derivative g a /\ g(a) = Cx(&0) ==> f analytic_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) analytic_on s` MP_TAC THENL [ASM_SIMP_TAC[POLE_THEOREM_ANALYTIC]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING);; let POLE_THEOREM_ANALYTIC_OPEN_SUPERSET = prove (`!f g s a t. s SUBSET t /\ open t /\ g analytic_on s /\ (!z. z IN t /\ ~(z = a) ==> g(z) = (z - a) * f(z)) ==> (\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) analytic_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC POLE_THEOREM_ANALYTIC THEN ASM_MESON_TAC[OPEN_CONTAINS_BALL; SUBSET]);; let POLE_THEOREM_ANALYTIC_OPEN_SUPERSET_0 = prove (`!f g s a t. s SUBSET t /\ open t /\ g analytic_on s /\ (!z. z IN t /\ ~(z = a) ==> g(z) = (z - a) * f(z)) /\ f a = complex_derivative g a /\ g(a) = Cx(&0) ==> f analytic_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\z. if z = a then complex_derivative g a else f(z) - g(a) / (z - a)) analytic_on s` MP_TAC THENL [MATCH_MP_TAC POLE_THEOREM_ANALYTIC_OPEN_SUPERSET THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING);; let HOLOMORPHIC_ON_EXTEND_LIM,HOLOMORPHIC_ON_EXTEND_BOUNDED = (CONJ_PAIR o prove) (`(!f a s. f holomorphic_on (s DELETE a) /\ a IN interior s ==> ((?g. g holomorphic_on s /\ (!z. z IN s DELETE a ==> g z = f z)) <=> ((\z. (z - a) * f(z)) --> Cx(&0)) (at a))) /\ (!f a s. f holomorphic_on (s DELETE a) /\ a IN interior s ==> ((?g. g holomorphic_on s /\ (!z. z IN s DELETE a ==> g z = f z)) <=> (?B. eventually (\z. norm(f z) <= B) (at a))))`, REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> (p ==> q /\ r)`] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(p ==> r) /\ (r ==> q) /\ (q ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` (CONJUNCTS_THEN2 (MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) ASSUME_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `interior s:complex->bool` o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[INTERIOR_SUBSET; CONTINUOUS_ON] THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_SIMP_TAC[LIM_WITHIN_OPEN; OPEN_INTERIOR; tendsto] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(fun th -> EXISTS_TAC `norm((g:complex->complex) a) + &1` THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP EVENTUALLY_WITHIN_INTERIOR th)]) THEN ASM_SIMP_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ] THEN EXISTS_TAC `&1` THEN CONV_TAC NORM_ARITH; DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN EXISTS_TAC `B:real` THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = a - a`) THEN SIMP_TAC[LIM_AT_ID; LIM_CONST; LIM_SUB] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN SIMP_TAC[]; DISCH_TAC THEN ABBREV_TAC `h = \z. (z - a) pow 2 * f z` THEN SUBGOAL_THEN `(h has_complex_derivative Cx(&0)) (at a)` ASSUME_TAC THENL [EXPAND_TAC "h" THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT] THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\z:complex. (z - a) * f z`; `&1`] THEN ASM_SIMP_TAC[REAL_LT_01; GSYM DIST_NZ] THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN SUBGOAL_THEN `h holomorphic_on s` ASSUME_TAC THENL [REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `z:complex = a` THENL [ASM_MESON_TAC[complex_differentiable; COMPLEX_DIFFERENTIABLE_AT_WITHIN]; ALL_TAC] THEN EXPAND_TAC "h" THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_MUL_WITHIN THEN CONJ_TAC THENL [COMPLEX_DIFFERENTIABLE_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_DELETE; complex_differentiable] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:complex` THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_SET THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `dist(a:complex,z)` THEN ASM_REWRITE_TAC[IN_DELETE; NORM_ARITH `&0 < dist(a,b) <=> ~(a = b)`] THEN MESON_TAC[REAL_LT_REFL]; MP_TAC(SPECL [`h:complex->complex`; `s:complex->bool`; `a:complex`] POLE_LEMMA) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `g = \z. if z = a then complex_derivative h a else (h z - h a) / (z - a)` THEN DISCH_TAC THEN EXISTS_TAC `\z. if z = a then complex_derivative g a else (g z - g a) / (z - a)` THEN ASM_SIMP_TAC[POLE_LEMMA; IN_DELETE] THEN EXPAND_TAC "g" THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE th]) THEN SIMP_TAC[COMPLEX_SUB_RZERO] THEN EXPAND_TAC "h" THEN SIMP_TAC[] THEN CONV_TAC COMPLEX_FIELD]]);; (* ------------------------------------------------------------------------- *) (* General, homology form of Cauchy's theorem. Proof is based on Dixon's, *) (* as presented in Lang's "Complex Analysis" book. *) (* ------------------------------------------------------------------------- *) let CAUCHY_INTEGRAL_FORMULA_GLOBAL = prove (`!f s g z. open s /\ f holomorphic_on s /\ z IN s /\ valid_path g /\ pathfinish g = pathstart g /\ path_image g SUBSET s DELETE z /\ (!w. ~(w IN s) ==> winding_number(g,w) = Cx(&0)) ==> ((\w. f(w) / (w - z)) has_path_integral (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, MATCH_MP_TAC(MESON[] `((!f s g. vector_polynomial_function g ==> P f s g) ==> !f s g. P f s g) /\ (!f s g. vector_polynomial_function g ==> P f s g) ==> !f s g. P f s g`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s DELETE (z:complex)`; `g:real^1->complex`] PATH_INTEGRAL_NEARBY_ENDS) THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH; OPEN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->complex`; `d:real`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`g:real^1->complex`; `p:real^1->complex`]) THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`f:complex->complex`; `s:complex->bool`; `p:real^1->complex`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN SUBGOAL_THEN `winding_number(p,z) = winding_number(g,z) /\ !w. ~(w IN s) ==> winding_number(p,w) = winding_number(g,w)` (fun th -> SIMP_TAC[th]) THENL [FIRST_X_ASSUM(K ALL_TAC o SPEC `z:complex`) THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (SET_RULE `g SUBSET s DELETE z ==> ~(z IN g) /\ (!y. ~(y IN s) ==> ~(y IN g))`))) THEN ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; IN_DELETE; COMPLEX_SUB_0] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN MATCH_MP_TAC(MESON[HAS_PATH_INTEGRAL_INTEGRAL; path_integrable_on; PATH_INTEGRAL_UNIQUE] `f path_integrable_on g /\ path_integral p f = path_integral g f ==> (f has_path_integral y) p ==> (f has_path_integral y) g`) THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN EXISTS_TAC `s DELETE (z:complex)` THEN ASM_SIMP_TAC[OPEN_DELETE]; FIRST_X_ASSUM MATCH_MP_TAC] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; IN_DELETE; COMPLEX_SUB_0] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; DELETE_SUBSET]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`f:complex->complex`; `u:complex->bool`; `g:real^1->complex`] THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `g':real^1->complex` STRIP_ASSUME_TAC o MATCH_MP HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION) THEN SUBGOAL_THEN `bounded(IMAGE (g':real^1->complex) (interval[vec 0,vec 1]))` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_INTERVAL] THEN ASM_MESON_TAC[CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; CONTINUOUS_AT_IMP_CONTINUOUS_ON]; REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP VALID_PATH_IMP_PATH) THEN MAP_EVERY ABBREV_TAC [`d = \z w. if w = z then complex_derivative f z else (f(w) - f(z)) / (w - z)`; `v = {w | ~(w IN path_image g) /\ winding_number(g,w) = Cx(&0)}`] THEN SUBGOAL_THEN `open(v:complex->bool)` ASSUME_TAC THENL [EXPAND_TAC "v" THEN MATCH_MP_TAC OPEN_WINDING_NUMBER_LEVELSETS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `u UNION v = (:complex)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!y:complex. y IN u ==> (d y) holomorphic_on u` ASSUME_TAC THENL [X_GEN_TAC `y:complex` THEN STRIP_TAC THEN EXPAND_TAC "d" THEN MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `{y:complex}` THEN ASM_REWRITE_TAC[FINITE_SING] THEN CONJ_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `w:complex = y` THENL [UNDISCH_THEN `w:complex = y` SUBST_ALL_TAC THEN REWRITE_TAC[CONTINUOUS_AT] THEN MATCH_MP_TAC LIM_TRANSFORM_AWAY_AT THEN EXISTS_TAC `\w:complex. (f w - f y) / (w - y)` THEN SIMP_TAC[] THEN EXISTS_TAC `y + Cx(&1)` THEN CONJ_TAC THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN REWRITE_TAC[GSYM HAS_COMPLEX_DERIVATIVE_AT] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT]; ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DELETE; IN_DELETE; SET_RULE `s DIFF {x} = s DELETE x`; GSYM complex_differentiable] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\w:complex. (f w - f y) / (w - y)` THEN EXISTS_TAC `dist(w:complex,y)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN (CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC]) THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN SUBGOAL_THEN `!y. ~(y IN path_image g) ==> (\x. (f x - f y) / (x - y)) path_integrable_on g` ASSUME_TAC THENL [X_GEN_TAC `y:complex` THEN DISCH_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN EXISTS_TAC `u DELETE (y:complex)` THEN ASM_SIMP_TAC[OPEN_DELETE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[IN_DELETE; COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `u:complex->bool` THEN ASM_REWRITE_TAC[DELETE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!y:complex. d y path_integrable_on g` ASSUME_TAC THENL [X_GEN_TAC `y:complex` THEN ASM_CASES_TAC `(y:complex) IN path_image g` THENL [MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]; MATCH_MP_TAC PATH_INTEGRABLE_EQ THEN EXISTS_TAC `\x:complex. (f x - f y) / (x - y)` THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "d" THEN ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `?h. (!z. z IN u ==> ((d z) has_path_integral h(z)) g) /\ (!z. z IN v ==> ((\w. f(w) / (w - z)) has_path_integral h(z)) g)` (CHOOSE_THEN (CONJUNCTS_THEN2 (LABEL_TAC "u") (LABEL_TAC "v"))) THENL [EXISTS_TAC `\z. if z IN u then path_integral g (d z) else path_integral g (\w. f(w) / (w - z))` THEN SIMP_TAC[] THEN CONJ_TAC THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THENL [ASM_MESON_TAC[HAS_PATH_INTEGRAL_INTEGRAL]; ALL_TAC] THEN ASM_CASES_TAC `(w:complex) IN u` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_SIMP_TAC[COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN ASM_MESON_TAC[]; ASM SET_TAC[]]] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_EQ THEN EXISTS_TAC `\x:complex. (f x - f w) / (x - w) + f(w) / (x - w)` THEN CONJ_TAC THENL [X_GEN_TAC `x:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN UNDISCH_TAC `(w:complex) IN v` THEN EXPAND_TAC "v" THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC(MESON[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_INTEGRAL; path_integrable_on; PATH_INTEGRAL_EQ; PATH_INTEGRABLE_EQ] `g path_integrable_on p /\ (!x. x IN path_image p ==> f x = g x) ==> (f has_path_integral path_integral p g) p`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "d" THEN ASM_MESON_TAC[]; SUBGOAL_THEN `Cx(&0) = (f w) * Cx(&2) * Cx pi * ii * winding_number(g,w)` SUBST1_TAC THENL [ASM_REWRITE_TAC[COMPLEX_MUL_RZERO]; ALL_TAC] THEN ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x / y = x * Cx(&1) / y`] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_LMUL THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_WINDING_NUMBER THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!z. (h:complex->complex) z = Cx(&0)` ASSUME_TAC THENL [ALL_TAC; REMOVE_THEN "u" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "d" THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `\w. (f w - f z) / (w - z)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] HAS_PATH_INTEGRAL_EQ)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(SPECL [`g:real^1->complex`; `z:complex`] HAS_PATH_INTEGRAL_WINDING_NUMBER) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_RMUL) THEN DISCH_THEN(MP_TAC o SPEC `(f:complex->complex) z`) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_ADD) THEN REWRITE_TAC[complex_div; COMPLEX_ADD_RID; COMPLEX_RING `(Cx(&1) * i) * fz + (fx - fz) * i = fx * i`] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC]] THEN UNDISCH_THEN `(z:complex) IN u` (K ALL_TAC) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `p SUBSET u DELETE z ==> p SUBSET u`)) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN STRIP_TAC THEN MATCH_MP_TAC LIOUVILLE_WEAK THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `?t:complex->bool. compact t /\ path_image g SUBSET interior t /\ t SUBSET u` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?dd. &0 < dd /\ {y + k | y IN path_image g /\ k IN ball(vec 0,dd)} SUBSET u` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `u = (:complex)` THENL [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01; SUBSET_UNIV]; ALL_TAC] THEN MP_TAC(ISPECL [`path_image g:complex->bool`; `(:complex) DIFF u`] SEPARATE_COMPACT_CLOSED) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `dd:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `dd / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`y:complex`; `k:complex`] THEN MATCH_MP_TAC(TAUT `(a /\ ~c ==> ~b) ==> a /\ b ==> c`) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:complex`; `y + k:complex`]) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_BALL] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN EXISTS_TAC `{y + k:complex | y IN path_image g /\ k IN cball(vec 0,dd / &2)}` THEN ASM_SIMP_TAC[COMPACT_SUMS; COMPACT_PATH_IMAGE; COMPACT_CBALL] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_INTERIOR; IN_ELIM_THM] THEN X_GEN_TAC `y:complex` THEN DISCH_TAC THEN EXISTS_TAC `dd / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`y:complex`; `x - y:complex`] THEN ASM_REWRITE_TAC[IN_CBALL] THEN UNDISCH_TAC `dist(y:complex,x) < dd / &2` THEN CONV_TAC NORM_ARITH; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `{x + y:real^N | x IN s /\ y IN t} SUBSET u ==> t' SUBSET t ==> {x + y | x IN s /\ y IN t'} SUBSET u`)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN UNDISCH_TAC `&0 < dd` THEN CONV_TAC NORM_ARITH]; ALL_TAC] THEN MP_TAC(ISPECL [`interior t:complex->bool`; `g:real^1->complex`] PATH_INTEGRAL_BOUND_EXISTS) THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN DISCH_THEN(X_CHOOSE_THEN `L:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `bounded(IMAGE (f:complex->complex) t)` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET]; REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIM_AT_INFINITY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(D * L) / (e / &2) + C:real` THEN REWRITE_TAC[real_ge] THEN X_GEN_TAC `y:complex` THEN DISCH_TAC THEN REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN SUBGOAL_THEN `h y = path_integral g (\w. f w / (w - y))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "v" THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `(D * L) / (e / &2) + C <= norm(y:complex)` THEN MATCH_MP_TAC(REAL_ARITH `&0 < d /\ x <= c ==> d + c <= x ==> F`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; MATCH_MP_TAC WINDING_NUMBER_ZERO_OUTSIDE THEN EXISTS_TAC `cball(Cx(&0),C)` THEN ASM_REWRITE_TAC[CONVEX_CBALL; SUBSET; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]] THEN UNDISCH_TAC `(D * L) / (e / &2) + C <= norm(y:complex)` THEN MATCH_MP_TAC(REAL_ARITH `&0 < d ==> d + c <= x ==> ~(x <= c)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `L * (e / &2 / L)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_HALF] THEN ASM_REAL_ARITH_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS; INTERIOR_SUBSET]; SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; COMPLEX_SUB_0]] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `d + c <= norm y ==> &0 < d /\ norm w <= c ==> ~(w = y)`)) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF] THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN SIMP_TAC[COMPLEX_NORM_DIV] THEN SUBGOAL_THEN `&0 < norm(w - y)` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `d + c <= norm y ==> &0 < d /\ norm w <= c ==> &0 < norm(w - y)`)) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF] THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ASM_SIMP_TAC[REAL_LE_LDIV_EQ]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `D:real` THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `e / &2 / L * x = (x * (e / &2)) / L`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ; REAL_HALF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `d + c <= norm y ==> norm w <= c ==> d <= norm(w - y)`)) THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; DISCH_TAC] THEN SUBGOAL_THEN `(\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) continuous_on {pastecart x z | x IN u /\ z IN u}` ASSUME_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN EXPAND_TAC "d" THEN REWRITE_TAC[FORALL_IN_GSPEC; continuous_within; IMP_CONJ] THEN MAP_EVERY X_GEN_TAC [`x:complex`; `z:complex`] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; FORALL_PASTECART] THEN REWRITE_TAC[dist; IMP_IMP; GSYM CONJ_ASSOC; PASTECART_SUB] THEN ASM_CASES_TAC `z:complex = x` THEN ASM_REWRITE_TAC[] THENL [UNDISCH_THEN `z:complex = x` (SUBST_ALL_TAC o SYM); SUBGOAL_THEN `(\y. (f(sndcart y) - f(fstcart y)) / (sndcart y - fstcart y)) continuous at (pastecart x z)` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV_AT THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART; LINEAR_SNDCART] THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART; LINEAR_SNDCART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_EQ_CONTINUOUS_AT]; ALL_TAC] THEN REWRITE_TAC[continuous_at; dist; FORALL_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_SUB] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k1:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `open({pastecart x z | x IN u /\ z IN u} DIFF {y | y IN UNIV /\ fstcart y - sndcart y = Cx(&0)})` MP_TAC THENL [MATCH_MP_TAC OPEN_DIFF THEN ASM_SIMP_TAC[REWRITE_RULE[PCROSS] OPEN_PCROSS] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN REWRITE_TAC[CLOSED_UNIV] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; SIMP_TAC[OPEN_CONTAINS_BALL; IN_DIFF; IMP_CONJ; FORALL_IN_GSPEC] THEN DISCH_THEN(MP_TAC o SPECL [`x:complex`; `z:complex`]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; COMPLEX_SUB_0] THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; FORALL_PASTECART; IN_DIFF; IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_ELIM_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist; PASTECART_SUB; FSTCART_PASTECART; SNDCART_PASTECART] THEN DISCH_THEN(X_CHOOSE_THEN `k2:real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `min k1 k2:real` THEN ASM_SIMP_TAC[REAL_LT_MIN; COMPLEX_NORM_NZ; COMPLEX_SUB_0]] THEN SUBGOAL_THEN `(complex_derivative f) continuous at z` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_INTERIOR THEN EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[dist; REAL_HALF]] THEN DISCH_THEN(X_CHOOSE_THEN `k1:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_BALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min k1 k2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`x':complex`; `z':complex`] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `e / &2 = e / &2 / norm(z' - x') * norm(z' - x':complex)` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `\u. (complex_derivative f u - complex_derivative f z) / (z' - x')` THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE; REAL_HALF] THEN CONJ_TAC THENL [ASM_SIMP_TAC[COMPLEX_FIELD `~(z:complex = x) ==> a / (z - x) - b = (a - b * (z - x)) / (z - x)`] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_DIV THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN REWRITE_TAC[HAS_PATH_INTEGRAL_CONST_LINEPATH] THEN MP_TAC(ISPECL [`f:complex->complex`; `complex_derivative f`; `linepath(x':complex,z')`; `u:complex->bool`] PATH_INTEGRAL_PRIMITIVE) THEN REWRITE_TAC[ETA_AX; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[VALID_PATH_LINEPATH] THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; GSYM HOLOMORPHIC_ON_DIFFERENTIABLE; HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HOLOMORPHIC_ON_OPEN; complex_differentiable]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,k2)`]; X_GEN_TAC `w:complex` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_NORM_DIV; real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 ==> x <= e * inv(&2)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[NORM_SUB] dist] (GSYM IN_BALL)] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `w IN s ==> s SUBSET t ==> w IN t`))] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_BALL; dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; ALL_TAC] THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_UNIV; IN_UNIV; GSYM complex_differentiable] THEN X_GEN_TAC `z0:complex` THEN ASM_CASES_TAC `(z0:complex) IN v` THENL [MP_TAC(ISPECL [`f:complex->complex`; `h:complex->complex`; `g:real^1->complex`; `v:complex->bool`; `1`; `B:real`] CAUCHY_NEXT_DERIVATIVE) THEN ASM_SIMP_TAC[IN_DIFF; ARITH_EQ; COMPLEX_POW_1] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_UNIQUE_AT]; ALL_TAC] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `u:complex->bool` THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `z0:complex`) THEN UNDISCH_TAC `(z0:complex) IN v` THEN EXPAND_TAC "v" THEN SIMP_TAC[IN_ELIM_THM; complex_differentiable] THEN MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(z0:complex) IN u` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_BALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z0:complex`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `ball(z0:complex,e)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MATCH_MP_TAC ANALYTIC_IMP_HOLOMORPHIC THEN MATCH_MP_TAC MORERA_TRIANGLE THEN REWRITE_TAC[OPEN_BALL] THEN SUBGOAL_THEN `(h:complex->complex) continuous_on u` ASSUME_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN MAP_EVERY X_GEN_TAC [`a:num->complex`; `x:complex`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`sequentially`; `\n:num x. (d:complex->complex->complex) (a n) x`; `B:real`; `g:real^1->complex`; `(d:complex->complex->complex) x`] PATH_INTEGRAL_UNIFORM_LIMIT) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; ETA_AX; EVENTUALLY_TRUE] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_UNIQUE_AT]; ALL_TAC] THEN X_GEN_TAC `ee:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_CBALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `dd:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) uniformly_continuous_on {pastecart w z | w IN cball(x,dd) /\ z IN path_image g}` MP_TAC THENL [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN ASM_SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; COMPACT_CBALL; COMPACT_VALID_PATH_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `ee:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `kk:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GENL [`w:complex`; `z:complex`] o SPECL [`pastecart (x:complex) (z:complex)`; `pastecart (w:complex) (z:complex)`]) THEN SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE; dist; PASTECART_SUB] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; NORM_PASTECART] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[TAUT `b /\ (a /\ b) /\ c ==> d <=> a /\ b /\ c ==> d`] THEN SIMP_TAC[REAL_ADD_RID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `min dd kk:real`) THEN ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; REAL_LT_MIN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_CBALL; GSYM dist; REAL_LT_IMP_LE]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!w. w IN u ==> (\z. d z w) holomorphic_on u` ASSUME_TAC THENL [EXPAND_TAC "d" THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `{y:complex}` THEN ASM_REWRITE_TAC[FINITE_SING] THEN CONJ_TAC THENL [SUBGOAL_THEN `((\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) o (\z. pastecart y z)) continuous_on u` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM]; EXPAND_TAC "d" THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC(COMPLEX_RING `x':complex = --x /\ y' = --y ==> x * y = x' * y'`) THEN REWRITE_TAC[GSYM COMPLEX_INV_NEG; COMPLEX_NEG_SUB]]; ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DELETE; IN_DELETE; SET_RULE `s DIFF {x} = s DELETE x`; GSYM complex_differentiable] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\w:complex. (f y - f w) / (y - w)` THEN EXISTS_TAC `dist(w:complex,y)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN (CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC]) THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]]; ALL_TAC] THEN SUBGOAL_THEN `!w a b:complex. w IN u /\ segment[a,b] SUBSET u ==> (\z. d z w) path_integrable_on (linepath(a,b))` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; ALL_TAC] THEN SUBGOAL_THEN `!a b:complex. segment[a,b] SUBSET u ==> (\w. path_integral (linepath(a,b)) (\z. d z w)) continuous_on u` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:complex = b` THENL [ASM_SIMP_TAC[PATH_INTEGRAL_TRIVIAL; CONTINUOUS_ON_CONST]; ALL_TAC] THEN REWRITE_TAC[continuous_on] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN X_GEN_TAC `ee:real` THEN DISCH_TAC THEN ASM_SIMP_TAC[dist; GSYM PATH_INTEGRAL_SUB] THEN MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_CBALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `dd:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) uniformly_continuous_on {pastecart z t | z IN segment[a,b] /\ t IN cball(w,dd)}` MP_TAC THENL [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN ASM_SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; COMPACT_CBALL; COMPACT_SEGMENT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `ee / &2 / norm(b - a:complex)`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN DISCH_THEN(X_CHOOSE_THEN `kk:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GENL [`z:complex`; `r:complex`] o SPECL [`pastecart (r:complex) (z:complex)`; `pastecart (r:complex) (w:complex)`]) THEN SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE; dist; PASTECART_SUB] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; NORM_PASTECART] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[TAUT `(a /\ b) /\ a /\ c ==> d <=> a /\ b /\ c ==> d`] THEN SIMP_TAC[REAL_ADD_LID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN EXISTS_TAC `min dd kk:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x:complex` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `ee / &2 = ee / &2 / norm(b - a) * norm(b - a:complex)` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `\r. (d:complex->complex->complex) r x - d r w` THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE; REAL_HALF] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN MATCH_MP_TAC PATH_INTEGRABLE_SUB THEN ASM_SIMP_TAC[]; REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [NORM_SUB] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_CBALL; dist] THEN ASM_MESON_TAC[NORM_SUB; REAL_LT_IMP_LE]]; ALL_TAC] THEN SUBGOAL_THEN `!a b. segment[a,b] SUBSET u ==> (\w. path_integral (linepath (a,b)) (\z. d z w)) path_integrable_on g` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_INTEGRABLE_ON] THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL [SUBGOAL_THEN `((\w. path_integral (linepath(a,b)) (\z. d z w)) o (g:real^1->complex)) continuous_on interval[vec 0,vec 1]` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[GSYM path; VALID_PATH_IMP_PATH] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[GSYM path_image]; REWRITE_TAC[o_DEF]]; FIRST_ASSUM(fun th -> REWRITE_TAC [MATCH_MP HAS_VECTOR_DERIVATIVE_UNIQUE_AT (SPEC_ALL th)]) THEN ASM_SIMP_TAC[ETA_AX; GSYM path; VALID_PATH_IMP_PATH; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]]; ALL_TAC] THEN SUBGOAL_THEN `!a b. segment[a,b] SUBSET u ==> path_integral (linepath(a,b)) h = path_integral g (\w. path_integral (linepath (a,b)) (\z. d z w))` ASSUME_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`; `c:complex`] THEN DISCH_TAC THEN SUBGOAL_THEN `segment[a:complex,b] SUBSET u /\ segment[b,c] SUBSET u /\ segment[c,a] SUBSET u` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SEGMENTS_SUBSET_CONVEX_HULL; SUBSET_TRANS]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN ASM_SIMP_TAC[GSYM PATH_INTEGRAL_ADD; PATH_INTEGRABLE_ADD] THEN MATCH_MP_TAC PATH_INTEGRAL_EQ_0 THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `(w:complex) IN u` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM PATH_INTEGRAL_JOIN; VALID_PATH_LINEPATH; VALID_PATH_JOIN; PATHSTART_JOIN; PATH_INTEGRABLE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]] THEN MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `path_integral (linepath(a,b)) (\z. path_integral g (d z))` THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_INTEGRAL_EQ THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET]; MATCH_MP_TAC(REWRITE_RULE[PCROSS] PATH_INTEGRAL_SWAP) THEN REWRITE_TAC[VALID_PATH_LINEPATH; VECTOR_DERIVATIVE_LINEPATH_AT; CONTINUOUS_ON_CONST] THEN FIRST_ASSUM(fun th -> REWRITE_TAC [MATCH_MP HAS_VECTOR_DERIVATIVE_UNIQUE_AT (SPEC_ALL th)]) THEN ASM_SIMP_TAC[ETA_AX; CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; CONTINUOUS_AT_IMP_CONTINUOUS_ON] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN ASM SET_TAC[]]);; let CAUCHY_THEOREM_GLOBAL = prove (`!f s g. open s /\ f holomorphic_on s /\ valid_path g /\ pathfinish g = pathstart g /\ path_image g SUBSET s /\ (!z. ~(z IN s) ==> winding_number(g,z) = Cx(&0)) ==> (f has_path_integral Cx(&0)) g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?z:complex. z IN s /\ ~(z IN path_image g)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ ~(t = s) ==> ?z. z IN s /\ ~(z IN t)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON [CLOPEN; COMPACT_EQ_BOUNDED_CLOSED; NOT_BOUNDED_UNIV] `open s /\ compact t /\ ~(t = {}) ==> ~(t = s)`) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; PATH_IMAGE_NONEMPTY; VALID_PATH_IMP_PATH]; MP_TAC(ISPECL [`\w:complex. (w - z) * f(w)`; `s:complex->bool`; `g:real^1->complex`; `z:complex`] CAUCHY_INTEGRAL_FORMULA_GLOBAL) THEN ASM_SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w:complex = z` THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(w:complex = z) ==> ((w - z) * f) / (w - z) = f`]]);; let CAUCHY_THEOREM_GLOBAL_OUTSIDE = prove (`!f s g. open s /\ f holomorphic_on s /\ valid_path g /\ pathfinish g = pathstart g /\ (!z. ~(z IN s) ==> z IN outside(path_image g)) ==> (f has_path_integral Cx(&0)) g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_GLOBAL THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE; VALID_PATH_IMP_PATH] THEN MP_TAC(ISPEC `path_image(g:real^1->complex)` OUTSIDE_NO_OVERLAP) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Basic residue integrals. *) (* ------------------------------------------------------------------------- *) let HAS_RESIDUE_INTEGRAL = prove (`!g z n. valid_path g /\ ~(z IN path_image g) /\ pathfinish g = pathstart g ==> ((\w. inv(w - z) pow n) has_path_integral (if n = 1 then Cx(&2) * Cx pi * ii * winding_number(g,z) else Cx(&0))) g`, REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [MP_TAC(ISPECL [`\w:complex. Cx(&1)`; `(:complex)`; `g:real^1->complex`; `z:complex`] CAUCHY_INTEGRAL_FORMULA_GLOBAL) THEN ASM_REWRITE_TAC[COMPLEX_MUL_LID; complex_div; IN_UNIV; OPEN_UNIV] THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_MUL_RID] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN ASM SET_TAC[]; MATCH_MP_TAC CAUCHY_THEOREM_PRIMITIVE THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `(:complex) DELETE z` THEN ASM_REWRITE_TAC[IN_UNIV; IN_DELETE; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_CASES_TAC `n = 0` THENL [EXISTS_TAC `\w:complex. w`; EXISTS_TAC `\w. --inv(Cx(&(n - 1))) * inv(w - z) pow (n - 1)`] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN ASM_REWRITE_TAC[complex_pow; HAS_COMPLEX_DERIVATIVE_ID] THEN COMPLEX_DIFF_TAC THEN ASM_SIMP_TAC[COMPLEX_SUB_0; GSYM REAL_OF_NUM_SUB; LE_1; CX_SUB] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ ~(n = 1) ==> n - 1 - 1 = n - 2`; ARITH_RULE `2 <= n <=> ~(n = 0) /\ ~(n = 1)`; ARITH_EQ; COMPLEX_DIV_POW; COMPLEX_SUB_0; COMPLEX_INV_EQ_0] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(n1 = Cx(&0)) /\ ~(wz = Cx(&0)) ==> --inv n1 * n1 * ip / inv wz pow 2 * --(Cx(&1) - Cx(&0)) / wz pow 2 = ip`) THEN ASM_REWRITE_TAC[COMPLEX_SUB_0; CX_INJ; REAL_OF_NUM_EQ]]);; let HAS_RESIDUE_INTEGRAL_INTEGER = prove (`!g z n. valid_path g /\ ~(z IN path_image g) /\ pathfinish g = pathstart g /\ complex_integer n ==> ((\w. (w - z) cpow n) has_path_integral (if n = --Cx(&1) then Cx(&2) * Cx pi * ii * winding_number(g,z) else Cx(&0))) g`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPLEX_INTEGER]) THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN UNDISCH_THEN `n = Cx m` SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [is_int]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN ASM_REWRITE_TAC[CX_INJ; GSYM CX_NEG; CPOW_NEG] THENL [REWRITE_TAC[REAL_ARITH `~(&n = -- &1)`] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_EQ THEN EXISTS_TAC `\w:complex. (w - z) pow n` THEN REWRITE_TAC[CPOW_N; COMPLEX_SUB_0] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CAUCHY_THEOREM_PRIMITIVE THEN EXISTS_TAC `\w. inv(Cx(&(n + 1))) * (w - z) pow (n + 1)` THEN EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN X_GEN_TAC `w:complex` THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_RID; ADD_SUB] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(n = Cx(&0)) ==> inv n * n * w = w`) THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ] THEN ARITH_TAC; REWRITE_TAC[REAL_EQ_NEG2; REAL_OF_NUM_EQ; CX_NEG; CPOW_NEG] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_EQ THEN EXISTS_TAC `\w:complex. inv(w - z) pow n` THEN ASM_SIMP_TAC[HAS_RESIDUE_INTEGRAL; CPOW_N; COMPLEX_SUB_0] THEN ASM_MESON_TAC[COMPLEX_POW_INV]]);; (* ------------------------------------------------------------------------- *) (* First Cartan Theorem. *) (* ------------------------------------------------------------------------- *) let HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA = prove (`!f g z s t n i. open s /\ f holomorphic_on s /\ z IN s /\ open t /\ g holomorphic_on t /\ (!w. w IN s ==> f w IN t) /\ complex_derivative f z = Cx(&1) /\ (!i. 1 < i /\ i <= n ==> higher_complex_derivative i f z = Cx(&0)) /\ i <= n ==> higher_complex_derivative i (g o f) z = higher_complex_derivative i g (f z)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `open s /\ f holomorphic_on s /\ z IN s /\ open t /\ (!w. w IN s ==> f w IN t) /\ complex_derivative f z = Cx(&1) /\ (!i. 1 < i /\ i <= n ==> higher_complex_derivative i f z = Cx(&0)) ==> !i g. g holomorphic_on t /\ i <= n ==> higher_complex_derivative i (g o f) z = higher_complex_derivative i g (f z)` (fun th -> MESON_TAC [th]) THEN STRIP_TAC THEN INDUCT_TAC THEN REWRITE_TAC [LE_SUC_LT; higher_complex_derivative_alt; o_THM] THEN REPEAT STRIP_TAC THEN EQ_TRANS_TAC `higher_complex_derivative i (\w. complex_derivative g (f w) * complex_derivative f w) z` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC [] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC [] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `t:complex->bool` THEN ASM_SIMP_TAC []; MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL [REWRITE_TAC [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `t:complex->bool` THEN ASM_REWRITE_TAC [] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC []; ASM_REWRITE_TAC [ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC []]; REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_CHAIN THEN ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]]; EQ_TRANS_TAC `vsum (0..i) (\j. Cx(&(binom (i,j))) * higher_complex_derivative j (\w. complex_derivative g (f w)) z * higher_complex_derivative (i - j) (complex_derivative f) z)` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_MUL THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC [] THEN ASM_SIMP_TAC [HOLOMORPHIC_COMPLEX_DERIVATIVE] THEN REWRITE_TAC [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `t:complex->bool` THEN ASM_REWRITE_TAC [] THEN ASM_SIMP_TAC [HOLOMORPHIC_COMPLEX_DERIVATIVE]; REWRITE_TAC [GSYM higher_complex_derivative_alt] THEN EQ_TRANS_TAC `vsum (i..i) (\j. Cx(&(binom (i,j))) * higher_complex_derivative j (\w. complex_derivative g (f w)) z * higher_complex_derivative (SUC (i - j)) f z)` THENL [MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[SUBSET_NUMSEG; LT_REFL; LE_0; LE_REFL; IN_NUMSEG_0; NUMSEG_SING; IN_SING] THEN X_GEN_TAC `j:num` THEN REWRITE_TAC [ARITH_RULE `j:num <= i /\ ~(j = i) <=> j < i`] THEN DISCH_TAC THEN ASSERT_TAC `1 < SUC (i - j) /\ SUC (i - j) <= n` THENL [ASM_SIMP_TAC [ARITH_RULE `i < n /\ j < i ==> 1 < SUC (i - j) /\ SUC (i - j) <= n`] THEN MATCH_MP_TAC (ARITH_RULE `i < n /\ j < i ==> 1 < SUC (i - j)`) THEN ASM_REWRITE_TAC []; ASM_SIMP_TAC [COMPLEX_MUL_RZERO; COMPLEX_VEC_0]]; REWRITE_TAC [NUMSEG_SING; VSUM_SING; BINOM_REFL; SUB_REFL] THEN ASM_REWRITE_TAC [COMPLEX_MUL_LID; COMPLEX_MUL_RID; higher_complex_derivative] THEN ASM_REWRITE_TAC [GSYM o_DEF] THEN REWRITE_TAC [GSYM higher_complex_derivative; higher_complex_derivative_alt] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC [ARITH_RULE `i:num < n ==> i <= n`] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC []]]]);; let HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA = prove (`!f s z n m i. open s /\ f holomorphic_on s /\ (!w. w IN s ==> f w IN s) /\ z IN s /\ f z = z /\ complex_derivative f z = Cx(&1) /\ (!i. 1 < i /\ i <= n ==> higher_complex_derivative i f z = Cx(&0)) /\ i <= n ==> higher_complex_derivative i (ITER m f) z = higher_complex_derivative i f z`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC [RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC [IMP_IMP] THEN STRIP_TAC THEN ASSERT_TAC `!m. ITER m f z = z:complex` THENL [INDUCT_TAC THEN ASM_REWRITE_TAC [ITER]; ALL_TAC] THEN ASSERT_TAC `!m (w:complex). w IN s ==> ITER m f w IN s` THENL [INDUCT_TAC THEN ASM_SIMP_TAC [ITER]; ALL_TAC] THEN ASSERT_TAC `!m. ITER m f holomorphic_on s` THENL [INDUCT_TAC THEN REWRITE_TAC [ITER_POINTLESS] THENL [ASM_SIMP_TAC [I_DEF; HOLOMORPHIC_ON_ID]; MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `s:complex ->bool` THEN ASM_REWRITE_TAC []]; ALL_TAC] THEN INDUCT_TAC THENL [REWRITE_TAC [ITER_POINTLESS; I_DEF; HIGHER_COMPLEX_DERIVATIVE_ID] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC [higher_complex_derivative]; ALL_TAC] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC [higher_complex_derivative; ONE]; ALL_TAC] THEN MATCH_MP_TAC EQ_SYM THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC [ARITH_RULE `~(i = 0) /\ ~(i = 1) ==> 1 < i`]; GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC [ITER_ALT_POINTLESS] THEN EQ_TRANS_TAC `higher_complex_derivative i (ITER m f) (f z)` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA THEN EXISTS_TAC `s:complex ->bool` THEN EXISTS_TAC `s:complex ->bool` THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC []; ASM_REWRITE_TAC [] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC []]]);; let HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA = prove (`!f s z n m. open s /\ f holomorphic_on s /\ (!w. w IN s ==> f w IN s) /\ z IN s /\ f z = z /\ complex_derivative f z = Cx(&1) /\ (!i. 1 < i /\ i < n ==> higher_complex_derivative i f z = Cx(&0)) /\ 1 < n ==> higher_complex_derivative n (ITER m f) z = Cx(&m) * higher_complex_derivative n f z`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC [LT_SUC_LE] THEN REWRITE_TAC [LT] THEN REWRITE_TAC [RIGHT_FORALL_IMP_THM] THEN STRIP_TAC THEN ASSERT_TAC `!m. ITER m f z = z:complex` THENL [INDUCT_TAC THEN ASM_REWRITE_TAC [ITER]; ALL_TAC] THEN ASSERT_TAC `!m (w:complex). w IN s ==> ITER m f w IN s` THENL [INDUCT_TAC THEN ASM_SIMP_TAC [ITER]; ALL_TAC] THEN ASSERT_TAC `!m. ITER m f holomorphic_on s` THENL [INDUCT_TAC THEN REWRITE_TAC [ITER_POINTLESS] THEN ASM_SIMP_TAC [I_DEF; HOLOMORPHIC_ON_ID] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `s:complex ->bool` THEN ASM_REWRITE_TAC []; ALL_TAC] THEN ASSERT_TAC `!w. w IN s ==> f complex_differentiable at w` THENL [ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN ASSERT_TAC `!m w. w IN s ==> ITER m f complex_differentiable at w` THENL [ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN ASSERT_TAC `!m. complex_derivative (ITER m f) z = Cx(&1)` THENL [INDUCT_TAC THEN ASM_REWRITE_TAC [ITER_POINTLESS] THENL [REWRITE_TAC [I_DEF; COMPLEX_DERIVATIVE_ID]; ALL_TAC] THEN ASM_SIMP_TAC [COMPLEX_DERIVATIVE_CHAIN; HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT] THEN REWRITE_TAC [COMPLEX_MUL_LID]; ALL_TAC] THEN INDUCT_TAC THEN REWRITE_TAC [higher_complex_derivative_alt; ITER_POINTLESS] THENL [ASM_REWRITE_TAC [COMPLEX_MUL_LZERO; I_DEF; COMPLEX_DERIVATIVE_ID; HIGHER_COMPLEX_DERIVATIVE_CONST; ARITH_RULE `n = 0 <=> ~(1 <= n)`]; ALL_TAC] THEN EQ_TRANS_TAC `higher_complex_derivative n (\w. complex_derivative f (ITER m f w) * complex_derivative (ITER m f) w) z` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC [o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC [ETA_AX]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL [ONCE_REWRITE_TAC [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_ID] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[]]; GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_CHAIN THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN ASM_MESON_TAC []; MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN ASM_MESON_TAC []]]; ALL_TAC] THEN EQ_TRANS_TAC `vsum (0..n) (\i. Cx(&(binom (n,i))) * higher_complex_derivative i (\w. complex_derivative f (ITER m f w)) z * higher_complex_derivative (n - i) (complex_derivative (ITER m f)) z)` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_MUL THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN EQ_TRANS_TAC `vsum {0,n} (\i. Cx(&(binom (n,i))) * higher_complex_derivative i (\w. complex_derivative f (ITER m f w)) z * higher_complex_derivative (n - i) (complex_derivative (ITER m f)) z)` THENL [MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC [INSERT_SUBSET; EMPTY_SUBSET; IN_NUMSEG_0; LE_0; LE_REFL; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC [GSYM higher_complex_derivative_alt] THEN ASSERT_TAC `1 < SUC (n-i) /\ SUC (n-i) <= n` THENL [ASM_SIMP_TAC [ARITH_RULE `i <= n /\ ~(i=0) /\ ~(i=n) ==> 1 < SUC (n-i) /\ SUC (n-i) <= n`]; ALL_TAC] THEN ASM_SIMP_TAC [] THEN SUBGOAL_THEN `higher_complex_derivative (SUC (n - i)) (ITER m f) z = Cx(&0)` SUBST1_TAC THENL [EQ_TRANS_TAC `higher_complex_derivative (SUC (n - i)) f z` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC []; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC []]; ASM_REWRITE_TAC [COMPLEX_MUL_RZERO; COMPLEX_VEC_0]]; ALL_TAC] THEN SIMP_TAC [VSUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC [binom; BINOM_REFL; COMPLEX_MUL_LID; SUB_REFL; SUB; higher_complex_derivative] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC [] THENL [REWRITE_TAC [higher_complex_derivative] THEN POP_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC (REWRITE_RULE [higher_complex_derivative]) THEN ASM_REWRITE_TAC [COMPLEX_MUL_RID; COMPLEX_MUL_LID; COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN ASM_MESON_TAC [ARITH_RULE `~(1 <= 0)`]; ALL_TAC] THEN ASM_REWRITE_TAC [COMPLEX_MUL_LID; COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN ASM_REWRITE_TAC [COMPLEX_MUL_RID] THEN ASM_REWRITE_TAC [GSYM higher_complex_derivative_alt] THEN SUBGOAL_THEN `(\w. complex_derivative f (ITER m f w)) = complex_derivative f o ITER m f` SUBST1_TAC THENL [REWRITE_TAC [FUN_EQ_THM; o_THM]; ALL_TAC] THEN SUBGOAL_THEN `higher_complex_derivative n (complex_derivative f o ITER m f) z = higher_complex_derivative n (complex_derivative f) (ITER m f z)` SUBST1_TAC THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA THEN EXISTS_TAC `s:complex->bool` THEN EXISTS_TAC `s:complex->bool` THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; LE_REFL] THEN REPEAT STRIP_TAC THEN EQ_TRANS_TAC `higher_complex_derivative i f z` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA THEN EXISTS_TAC `s:complex->bool` THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[]]; ALL_TAC] THEN ASSERT_TAC `Cx(&(SUC m)) = Cx(&m) + Cx(&1)` THENL [REWRITE_TAC [GSYM CX_ADD; REAL_OF_NUM_ADD; ONE; ADD_SUC; ADD_0]; ASM_REWRITE_TAC[COMPLEX_POLY_CLAUSES; GSYM higher_complex_derivative_alt]]);; let CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND = prove (`!f z y r B0 n. &0 < r /\ 0 < n /\ f holomorphic_on ball(z,r) /\ f continuous_on cball(z,r) /\ (!w. w IN ball(z,r) ==> f w IN ball(y,B0)) ==> norm (higher_complex_derivative n f z) <= &(FACT n) * B0 / r pow n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `higher_complex_derivative n f z = higher_complex_derivative n (\w. f w - y) z` SUBST1_TAC THENL [EQ_TRANS_TAC `higher_complex_derivative n (\w. f w) z - higher_complex_derivative n (\w. y) z` THENL [ASM_SIMP_TAC [HIGHER_COMPLEX_DERIVATIVE_CONST; ARITH_RULE `0 ~(n=0)`] THEN REWRITE_TAC [COMPLEX_SUB_RZERO; ETA_AX]; MATCH_MP_TAC EQ_SYM THEN REWRITE_TAC [ETA_AX] THEN MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_SUB THEN EXISTS_TAC `ball(z:complex,r)` THEN ASM_SIMP_TAC [OPEN_BALL; HOLOMORPHIC_ON_CONST; CENTRE_IN_BALL]]; ALL_TAC] THEN SUBGOAL_THEN `norm ((Cx(&2) * Cx pi * ii) / Cx(&(FACT n)) * higher_complex_derivative n (\w. f w - y) z) <= (B0 / r pow (n + 1)) * &2 * pi * r` MP_TAC THENL [MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH THEN EXISTS_TAC `(\u. (f u - y) / (u - z) pow (n + 1))` THEN EXISTS_TAC `z:complex` THEN STRIP_TAC THENL [MATCH_MP_TAC CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_REWRITE_TAC [CONTINUOUS_ON_CONST]; MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN ASM_REWRITE_TAC [HOLOMORPHIC_ON_CONST]]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_DIV THEN STRIP_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC (prove(`(?x. &0 <= x /\ x < B0) ==> &0 < B0`, REAL_ARITH_TAC)) THEN EXISTS_TAC `norm ((\u. (f:complex->complex) u - y) z)` THEN SIMP_TAC[NORM_POS_LE] THEN SUBGOAL_THEN `!w:complex. f w IN ball(y,B0) ==> norm (f w - y) < B0` MATCH_MP_TAC THENL [ASM_MESON_TAC [dist; DIST_SYM; IN_BALL; CENTRE_IN_BALL]; ALL_TAC] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CENTRE_IN_BALL]; MATCH_MP_TAC(SPECL [`r:real`;`n + 1`] REAL_POW_LE) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_NORM_DIV;COMPLEX_NORM_POW] THEN ASM_SIMP_TAC [REAL_LE_DIV2_EQ; REAL_POW_LT] THEN ONCE_REWRITE_TAC[MESON[] `!(f:complex->complex). (f x - y) = (\w. f w - y) x`] THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSURE_NORM_LE THEN EXISTS_TAC `ball(z:complex,r)` THEN ASM_SIMP_TAC[CLOSURE_BALL] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST]; SUBGOAL_THEN `!w:complex. f w IN ball(y,B0) ==> norm (f w - y) <= B0` MATCH_MP_TAC THENL [REWRITE_TAC[GSYM dist;IN_BALL;DIST_SYM;REAL_LT_IMP_LE]; ASM_MESON_TAC [dist; DIST_SYM; IN_BALL; CENTRE_IN_BALL]]; ASM_REWRITE_TAC[cball;IN_ELIM_THM;dist;DIST_SYM] THEN ASM_SIMP_TAC[REAL_EQ_IMP_LE]]]; ALL_TAC] THEN REWRITE_TAC [COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_II; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID] THEN STRIP_TAC THEN ABBREV_TAC `a = (&2 * pi) / &(FACT n)` THEN SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL [EXPAND_TAC "a" THEN SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; FACT_LT; ARITH; PI_POS]; ALL_TAC] THEN SUBGOAL_THEN `B0 / r pow (n + 1) * &2 * pi * r = a * (&(FACT n) * B0 / r pow n)` SUBST_ALL_TAC THENL [EXPAND_TAC "a" THEN REWRITE_TAC [GSYM ADD1; real_pow] THEN SUBGOAL_THEN `~(&(FACT n) = &0) /\ &0 < r` MP_TAC THENL [ASM_REWRITE_TAC[FACT_NZ; REAL_OF_NUM_EQ]; CONV_TAC REAL_FIELD]; ASM_MESON_TAC [REAL_LE_LCANCEL_IMP]]);; let FIRST_CARTAN_THM_DIM_1 = prove (`!f s z w. open s /\ connected s /\ bounded s /\ (!w. w IN s ==> f w IN s) /\ f holomorphic_on s /\ z IN s /\ f z = z /\ complex_derivative f z = Cx(&1) /\ w IN s ==> f w = w`, REWRITE_TAC [RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT STRIP_TAC THEN EQ_TRANS_TAC `I w:complex` THENL [MATCH_MP_TAC HOLOMORPHIC_FUN_EQ_ON_CONNECTED; REWRITE_TAC [I_THM]] THEN EXISTS_TAC `z:complex` THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC [I_DEF; HOLOMORPHIC_ON_ID] THEN GEN_TAC THEN STRIP_ASSUME_TAC (ARITH_RULE `n = 0 \/ n = 1 \/ 1 < n`) THENL [ASM_REWRITE_TAC [higher_complex_derivative]; ASM_REWRITE_TAC [ONE; higher_complex_derivative; COMPLEX_DERIVATIVE_ID]; ASM_REWRITE_TAC [HIGHER_COMPLEX_DERIVATIVE_ID]] THEN ASM_SIMP_TAC [ARITH_RULE `1 < n ==> ~(n=0) /\ ~(n=1)`] THEN POP_ASSUM MP_TAC THEN SPEC_TAC (`n:num`,`n:num`) THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN REWRITE_TAC [GSYM COMPLEX_NORM_ZERO] THEN MATCH_MP_TAC REAL_ARCH_RDIV_EQ_0 THEN REWRITE_TAC [NORM_POS_LE] THEN ASSERT_TAC `?c. s SUBSET ball(z:complex,c)` THENL [ASSERT_TAC `?c. !w:complex. w IN s ==> norm w <= c` THENL [ASM_REWRITE_TAC[GSYM bounded]; EXISTS_TAC `&2 * c + &1` THEN REWRITE_TAC [SUBSET] THEN GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `norm (x:complex) <= c /\ norm (z:complex) <= c` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC [IN_BALL] THEN NORM_ARITH_TAC]]; ALL_TAC] THEN ASSERT_TAC `?r. &0 < r /\ cball(z:complex,r) SUBSET s` THENL [ASM_MESON_TAC [OPEN_CONTAINS_CBALL]; EXISTS_TAC `&(FACT n) * c / r pow n`] THEN ASSERT_TAC `&0 < c` THENL [SUBGOAL_THEN `~(ball(z:complex,c) = {})` MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC [BALL_EQ_EMPTY; REAL_NOT_LE]]; ALL_TAC] THEN ASSERT_TAC `ball(z:complex,r) SUBSET s` THENL [ASM_MESON_TAC [SUBSET_TRANS; BALL_SUBSET_CBALL]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN REWRITE_TAC [REAL_LT_01; FACT_LE; REAL_OF_NUM_LE]; MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC [REAL_LT_IMP_LE; REAL_POW_LE]]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [GSYM COMPLEX_NORM_NUM] THEN REWRITE_TAC [GSYM COMPLEX_NORM_MUL] THEN SUBGOAL_THEN `Cx(&m) * higher_complex_derivative n f z = higher_complex_derivative n (ITER m f) z` SUBST1_TAC THENL [MATCH_MP_TAC (GSYM HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA) THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC []; ALL_TAC] THEN REWRITE_TAC [COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_POS] THEN MATCH_MP_TAC CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND THEN EXISTS_TAC `z:complex` THEN ASM_SIMP_TAC [ARITH_RULE `1 0 < n`] THEN ASSERT_TAC `!m w. w:complex IN s ==> ITER m f w IN s` THENL [INDUCT_TAC THEN ASM_SIMP_TAC [ITER]; ASSERT_TAC `!m. ITER m f holomorphic_on s` THENL [INDUCT_TAC THEN REWRITE_TAC [ITER_POINTLESS] THENL [ASM_SIMP_TAC [I_DEF; HOLOMORPHIC_ON_ID]; MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC []]; ASSERT_TAC `ITER m f holomorphic_on ball(z,r)` THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN ASM SET_TAC []; ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL [ASM_MESON_TAC [CONTINUOUS_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; ASM SET_TAC []]]]);; (* ------------------------------------------------------------------------- *) (* Second Cartan Theorem. *) (* ------------------------------------------------------------------------- *) let SECOND_CARTAN_THM_DIM_1 = prove (`!g f r. &0 < r /\ g holomorphic_on ball(Cx(&0),r) /\ (!z. z IN ball(Cx(&0),r) ==> g z IN ball(Cx(&0),r)) /\ g(Cx(&0)) = Cx(&0) /\ f holomorphic_on ball(Cx(&0),r) /\ (!z. z IN ball(Cx(&0),r) ==> f z IN ball(Cx(&0),r)) /\ f (Cx(&0)) = Cx(&0) /\ (!z. z IN ball(Cx(&0),r) ==> g (f z) = z) /\ (!z. z IN ball(Cx(&0),r) ==> f (g z) = z) ==> ?t. !z. z IN ball(Cx(&0),r) ==> g z = cexp(ii * Cx t) * z`, let COMPLEX_DERIVATIVE_LEFT_INVERSE = prove (`!s t f g w. open s /\ open t /\ (!z. z IN s ==> f z IN t) /\ f holomorphic_on s /\ (!z. z IN t ==> g z IN s) /\ g holomorphic_on t /\ (!z. z IN s ==> g (f z) = z) /\ w IN s ==> complex_derivative f w * complex_derivative g (f w) = Cx(&1)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [COMPLEX_MUL_SYM] THEN SUBGOAL_THEN `complex_derivative g (f w) * complex_derivative f w = complex_derivative (g o f) w ` SUBST1_TAC THENL [ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; COMPLEX_DERIVATIVE_CHAIN]; EQ_TRANS_TAC `complex_derivative (\u. u) w` THENL [MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_ID;o_THM] THEN ASM_MESON_TAC [HOLOMORPHIC_ON_COMPOSE_GEN]; ASM_SIMP_TAC[COMPLEX_DERIVATIVE_ID]]]) in let LEMMA_1 = prove (`!s f. open s /\ connected s /\ f holomorphic_on s /\ Cx(&0) IN s /\ (!u z. norm u = &1 /\ z IN s ==> u * z IN s) /\ (!u z. norm u = &1 /\ z IN s ==> f (u * z) = u * f z) ==> ?c. !z. z IN s ==> f z = c * z`, REPEAT STRIP_TAC THEN ABBREV_TAC `c = complex_derivative f (Cx(&0))` THEN EXISTS_TAC `c : complex` THEN SUBGOAL_THEN `f(Cx(&0)) = Cx(&0)` ASSUME_TAC THENL [FIRST_X_ASSUM (MP_TAC o SPECL [`--Cx(&1)`;`Cx(&0)`]) THEN ASM_REWRITE_TAC [NORM_NEG; COMPLEX_NORM_NUM; COMPLEX_MUL_RZERO] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN SUBGOAL_THEN `!n u z. norm u = &1 /\ z IN s ==> u pow n * higher_complex_derivative n f (u * z) = u * higher_complex_derivative n f z` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EQ_TRANS_TAC `higher_complex_derivative n (\w. f (u * w)) z` THENL [MATCH_MP_TAC EQ_SYM THEN MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR THEN EXISTS_TAC `s:complex->bool` THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN EQ_TRANS_TAC `higher_complex_derivative n (\w. u * f w) z` THENL [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC (REWRITE_RULE [o_DEF] (SPECL [`\w:complex. u*w`; `f:complex->complex`] HOLOMORPHIC_ON_COMPOSE_GEN)) THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [HOLOMORPHIC_ON_LINEAR]; MATCH_MP_TAC (REWRITE_RULE [o_DEF] (SPECL [`f:complex->complex`; `\w:complex. u*w`] HOLOMORPHIC_ON_COMPOSE_GEN)) THEN EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC [HOLOMORPHIC_ON_LINEAR; IN_UNIV]]; POP_ASSUM MP_TAC THEN SPEC_TAC (`z:complex`,`z:complex`) THEN SPEC_TAC (`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC [higher_complex_derivative] THEN GEN_TAC THEN DISCH_TAC THEN EQ_TRANS_TAC `complex_derivative (\w. u * higher_complex_derivative n f w) z` THENL [MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_REWRITE_TAC [HOLOMORPHIC_ON_CONST]; MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_REWRITE_TAC [HOLOMORPHIC_ON_CONST; ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC COMPLEX_DERIVATIVE_LMUL THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN ASM_MESON_TAC [HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]]]; SUBGOAL_THEN `!n. 2 <= n ==> higher_complex_derivative n f (Cx(&0)) = Cx(&0)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!n z. 2 <= n /\ (!u. norm u = &1 ==> u pow n * z = u * z) ==> z = Cx(&0)` MATCH_MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC (COMPLEX_RING `!u. ~(u pow n' = u) /\ u pow n' * z = u * z ==> z = Cx(&0)`) THEN SUBGOAL_THEN `2 <= n' ==> ?u. norm u = &1 /\ ~(u pow n' = u)` (fun th -> ASM_MESON_TAC [th]) THEN STRUCT_CASES_TAC (SPEC `n':num` num_CASES) THEN REWRITE_TAC [ARITH_LE; ARITH_RULE `2 <= SUC n'' <=> 1 <= n''`; complex_pow] THEN DISCH_TAC THEN MP_TAC (SPEC `n'':num` COMPLEX_NOT_ROOT_UNITY) THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN EXISTS_TAC `u:complex` THEN ASM_REWRITE_TAC [] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [CONTRAPOS_THM] THEN SUBGOAL_THEN `~(u = Cx(&0))` MP_TAC THENL [ASM_REWRITE_TAC [GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ]; CONV_TAC COMPLEX_FIELD]; EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`n:num`;`u:complex`;`Cx(&0)`]) THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO]]; REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE [] (SPECL [`f:complex->complex`; `\z. c*z`; `Cx(&0)`; `s:complex->bool`] HOLOMORPHIC_FUN_EQ_ON_CONNECTED)) THEN ASM_REWRITE_TAC [COMPLEX_MUL_RZERO; HOLOMORPHIC_ON_LINEAR; HIGHER_COMPLEX_DERIVATIVE_LINEAR] THEN GEN_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `n:num`) THEN STRUCT_CASES_TAC (ARITH_RULE `n = 0 \/ n = 1 \/ 2 <= n`) THEN ASM_SIMP_TAC [higher_complex_derivative; ARITH_EQ; ARITH_LE; ONE] THEN ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n=0)`] THEN ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n=SUC 0)`]]]) in let LEMMA_2 = prove (`!r c. &0 < r /\ &0 <= c /\ (!x. &0 <= x /\ x < r ==> c * x < r) ==> c <= &1`, REPEAT STRIP_TAC THEN REWRITE_TAC [GSYM REAL_NOT_LT] THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `r * (c + &1) / (&2 * c)`) THEN REWRITE_TAC [MESON [] `((a ==> b) ==> F) <=> (a /\ ~b)`] THEN CONJ_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `r * &1` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC [REAL_MUL_RID; REAL_LE_REFL]] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 < &2 * c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC [REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC [REAL_NOT_LT] THEN ONCE_REWRITE_TAC [REAL_RING `!a b c:real. a * b * c = b * a * c`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `r * &1` THEN CONJ_TAC THENL [REWRITE_TAC [REAL_MUL_RID; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < &2 * c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC [REAL_ARITH `&0 < c ==> a * b / c = (a * b) / c`] THEN SUBGOAL_THEN `(c * (c + &1)) / (&2 * c) = (c + &1) / &2` SUBST1_TAC THENL [ASM_SIMP_TAC [RAT_LEMMA5; REAL_ARITH `&0 < &2`] THEN ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `!u z. norm u = &1 /\ z IN ball(Cx(&0),r) ==> u * g z = g (u * z)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(u = Cx(&0))` ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM COMPLEX_NORM_NZ] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!w. w IN ball(Cx(&0),r) ==> f (u * g w) / u = w` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FIRST_CARTAN_THM_DIM_1 THEN EXISTS_TAC `ball(Cx(&0),r)` THEN EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC [OPEN_BALL;CONNECTED_BALL;BOUNDED_BALL; COMPLEX_MUL_RZERO; CENTRE_IN_BALL] THEN ASSERT_TAC `!z. norm (u * z) = norm z` THENL [ASM_REWRITE_TAC [COMPLEX_NORM_MUL; REAL_MUL_LID]; ALL_TAC] THEN ASSERT_TAC `!z. z IN ball(Cx(&0),r) ==> u * z IN ball(Cx(&0),r)` THENL [ASM_REWRITE_TAC [COMPLEX_IN_BALL_0]; ALL_TAC] THEN ASSERT_TAC `!z. z IN ball(Cx(&0),r) ==> z / u IN ball(Cx(&0),r)` THENL [ASM_REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_DIV; REAL_DIV_1]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST]] THEN SUBGOAL_THEN `(\w:complex. f (u * g w) : complex) = f o (\w. u * g w)` SUBST1_TAC THENL [REWRITE_TAC [o_DEF]; MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN] THEN EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST]; ASM_SIMP_TAC[]]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC [complex_div; COMPLEX_MUL_LZERO]; ALL_TAC] THEN SUBGOAL_THEN `Cx(&1) = u / u` SUBST1_TAC THENL [ASM_SIMP_TAC [COMPLEX_DIV_REFL]; ALL_TAC] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CDIV_AT THEN SUBGOAL_THEN `(\w:complex. f (u * g w) : complex) = f o (\w. u * g w)` SUBST1_TAC THENL [REWRITE_TAC [o_DEF]; ALL_TAC] THEN SUBGOAL_THEN `((\w. f (u * g w)) has_complex_derivative complex_derivative f (u * g(Cx(&0))) * (u * complex_derivative g (Cx(&0)))) (at (Cx(&0)))` MP_TAC THENL [MATCH_MP_TAC (REWRITE_RULE [o_DEF] (SPECL [`\w:complex. u * g(w):complex`; `f:complex->complex`] COMPLEX_DIFF_CHAIN_AT)) THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT THEN REWRITE_TAC [HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL]; REWRITE_TAC [HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; COMPLEX_MUL_RZERO]]; SUBGOAL_THEN `complex_derivative f (u * g (Cx(&0))) * (u * complex_derivative g (Cx(&0))) = u` SUBST1_TAC THENL [ALL_TAC; REWRITE_TAC[o_DEF]] THEN ABBREV_TAC `g' = complex_derivative g (Cx(&0))` THEN ABBREV_TAC `f' = complex_derivative f (Cx(&0))` THEN SUBGOAL_THEN `f' * g' = Cx(&1)` ASSUME_TAC THENL [EXPAND_TAC "g'" THEN EXPAND_TAC "f'" THEN SUBGOAL_THEN `complex_derivative g (Cx(&0)) = complex_derivative g (f (Cx(&0)))` SUBST1_TAC THENL [ASM_REWRITE_TAC []; MATCH_MP_TAC COMPLEX_DERIVATIVE_LEFT_INVERSE THEN EXISTS_TAC `ball(Cx(&0),r)` THEN EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_REWRITE_TAC [OPEN_BALL; CENTRE_IN_BALL]]; ASM_REWRITE_TAC [COMPLEX_MUL_RZERO] THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_RING]]; SUBGOAL_THEN `f(u*g(z)) = f (g (u * z)) : complex` MP_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `u * z:complex` THEN CONJ_TAC THENL [SUBGOAL_THEN `!x y:complex. x / u = y ==> x = u * y` MATCH_MP_TAC THENL [REWRITE_TAC [complex_div] THEN GEN_TAC THEN GEN_TAC THEN DISCH_THEN (SUBST1_TAC o GSYM) THEN SUBGOAL_THEN `x = (inv u * u) * x` MP_TAC THENL [ASM_SIMP_TAC [COMPLEX_MUL_LINV; COMPLEX_MUL_LID]; REWRITE_TAC [COMPLEX_MUL_AC]]; POP_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC []]; MATCH_MP_TAC EQ_SYM THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_MUL; REAL_MUL_LID] THEN ASM_REWRITE_TAC [GSYM COMPLEX_IN_BALL_0]]; DISCH_TAC THEN SUBGOAL_THEN `g (f (u * g z)) = g (f (g (u * z : complex))) : complex` MP_TAC THENL [POP_ASSUM SUBST1_TAC THEN REWRITE_TAC []; SUBGOAL_THEN `u * g z IN ball (Cx(&0),r) /\ u * z IN ball(Cx(&0),r)` MP_TAC THENL [ASM_REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_MUL; REAL_MUL_LID] THEN REWRITE_TAC [GSYM COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[]; ASM_SIMP_TAC[]]]]]; SUBGOAL_THEN `?c. !z. z IN ball(Cx(&0),r) ==> g z = c * z` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC LEMMA_1 THEN ASM_SIMP_TAC [OPEN_BALL; CONNECTED_BALL; CENTRE_IN_BALL] THEN SIMP_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_MUL; REAL_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `norm (c:complex) = &1` ASSUME_TAC THENL [ALL_TAC; ASM_MESON_TAC [COMPLEX_NORM_EQ_1_CEXP]] THEN SUBGOAL_THEN `~(norm (c:complex) = &0)` ASSUME_TAC THENL [REWRITE_TAC [COMPLEX_NORM_ZERO] THEN STRIP_TAC THEN SUBGOAL_THEN `Cx(&0) = Cx(r / &2)` MP_TAC THENL [ALL_TAC; REWRITE_TAC [CX_INJ] THEN ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `Cx(r / &2) IN ball(Cx(&0),r)` ASSUME_TAC THENL [REWRITE_TAC [COMPLEX_IN_BALL_0; CX_DIV; COMPLEX_NORM_DIV; COMPLEX_NORM_NUM] THEN REWRITE_TAC [COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; EQ_TRANS_TAC `g (f (Cx(r / &2)):complex):complex` THENL [EQ_TRANS_TAC `c * (f (Cx(r / &2)):complex)` THENL [ASM_REWRITE_TAC [COMPLEX_MUL_LZERO]; ASM_MESON_TAC[]]; ASM_MESON_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `&0 < norm (c:complex)` ASSUME_TAC THENL [POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN REWRITE_TAC [GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC LEMMA_2 THEN EXISTS_TAC `r : real` THEN ASM_REWRITE_TAC [NORM_POS_LE] THEN GEN_TAC THEN STRIP_TAC THEN ABBREV_TAC `p = Cx x` THEN SUBGOAL_THEN `x = norm (p:complex)` SUBST_ALL_TAC THENL [EXPAND_TAC "p" THEN REWRITE_TAC [COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC [GSYM COMPLEX_NORM_MUL] THEN SUBGOAL_THEN `c * p = g p` SUBST1_TAC THENL [ALL_TAC; ASM_MESON_TAC [COMPLEX_IN_BALL_0]] THEN FIRST_X_ASSUM (MATCH_MP_TAC o GSYM) THEN ASM_MESON_TAC [COMPLEX_IN_BALL_0]]; ALL_TAC] THEN SUBST1_TAC (GSYM (SPEC `norm (c:complex)` REAL_INV_INV)) THEN MATCH_MP_TAC REAL_INV_1_LE THEN CONJ_TAC THENL [ASM_MESON_TAC [REAL_LT_INV]; ALL_TAC] THEN MATCH_MP_TAC LEMMA_2 THEN EXISTS_TAC `r:real` THEN ASM_REWRITE_TAC [] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `x = norm (g (f (Cx x):complex):complex)` SUBST1_TAC THENL [SUBGOAL_THEN `g (f (Cx x):complex) = Cx x` SUBST1_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC [COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC]; SUBGOAL_THEN `g (f (Cx x):complex) = c * f (Cx x) : complex` SUBST1_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC [COMPLEX_NORM_MUL; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC [REAL_MUL_LINV; REAL_MUL_LID; GSYM COMPLEX_IN_BALL_0] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC]]]);; (* ------------------------------------------------------------------------- *) (* Cauchy's inequality and more versions of Liouville. *) (* ------------------------------------------------------------------------- *) let CAUCHY_INEQUALITY = prove (`!f z r (B:real) n. f continuous_on cball(z,r) /\ f holomorphic_on ball(z,r) /\ &0 < r /\ (!x:complex. norm(z-x) = r ==> norm(f x) <= B) ==> norm (higher_complex_derivative n f z) <= &(FACT n) * B / r pow n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= B` ASSUME_TAC THENL [SUBGOAL_THEN `?x:complex. norm (z-x) = r` STRIP_ASSUME_TAC THENL [ EXISTS_TAC `z + Cx r` THEN ASM_SIMP_TAC[COMPLEX_ADD_SUB2;NORM_NEG; COMPLEX_NORM_CX;REAL_ABS_REFL;REAL_LT_IMP_LE];ALL_TAC] THEN ASM_MESON_TAC [NORM_POS_LE;REAL_LE_TRANS]; SUBGOAL_THEN `norm ((Cx(&2) * Cx pi * ii) / Cx(&(FACT n)) * higher_complex_derivative n f z) <= (B / r pow (n + 1)) * &2 * pi * r` MP_TAC THENL[ MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH THEN EXISTS_TAC `\u. (f:complex->complex) u / (u - z) pow (n + 1)` THEN EXISTS_TAC `z:complex` THEN CONJ_TAC THENL [MATCH_MP_TAC CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH THEN ASM_SIMP_TAC [CENTRE_IN_BALL]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC [REAL_POW_LE;REAL_LT_IMP_LE];ALL_TAC]THEN ASM_REWRITE_TAC [] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC [COMPLEX_NORM_DIV;COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B:real / r pow (n+1)` THEN ASM_SIMP_TAC[ REAL_LE_DIV2_EQ; REAL_POW_LT;NORM_SUB;REAL_LE_REFL]; REWRITE_TAC[COMPLEX_NORM_DIV;COMPLEX_NORM_MUL; COMPLEX_NORM_II; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID;REAL_ABS_NUM] THEN SUBGOAL_THEN `B / r pow (n + 1) * &2 * pi * r = (&2 * pi) / &(FACT n) * (((&(FACT n) * B) * r/ r pow (n+1)))` SUBST1_TAC THENL [SUBGOAL_THEN `~(&(FACT n) = &0)` MP_TAC THENL [REWRITE_TAC [FACT_NZ;REAL_OF_NUM_EQ];ALL_TAC] THEN CONV_TAC REAL_FIELD;SUBGOAL_THEN `&0 < (&2 * pi) / &(FACT n)` ASSUME_TAC THENL[MATCH_MP_TAC REAL_LT_DIV THEN SIMP_TAC[FACT_LT;REAL_OF_NUM_LT] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC;SUBGOAL_THEN `(&(FACT n) * B) * r / r pow (n + 1) = &(FACT n) * B / r pow n` SUBST1_TAC THENL [REWRITE_TAC[GSYM ADD1; real_pow] THEN MP_TAC (ASSUME `&0 < r`) THEN CONV_TAC REAL_FIELD; ASM_MESON_TAC [REAL_LE_LCANCEL_IMP]]]]]]);; let LIOUVILLE_POLYNOMIAL = prove (`!f A B n. f holomorphic_on (:complex) /\ (!z. A <= norm(z) ==> norm(f z) <= B * norm(z) pow n) ==> !z. f(z) = vsum (0..n) (\k. higher_complex_derivative k f (Cx(&0)) / Cx(&(FACT k)) * z pow k)`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `B <= &0 \/ &0 < B`) THENL [MP_TAC(ISPECL [`f:complex->complex`; `Cx(&0)`] LIOUVILLE_WEAK) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN EXISTS_TAC `A:real` THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC(NORM_ARITH `r <= &0 ==> norm z <= r ==> z = vec 0`) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= --b * x ==> b * x <= &0`) THEN MATCH_MP_TAC REAL_LE_MUL THEN SIMP_TAC[NORM_POS_LE; REAL_POW_LE] THEN ASM_REAL_ARITH_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM FUN_EQ_THM] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_CONST] THEN REWRITE_TAC[COND_ID; complex_div; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0]]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN SUBGOAL_THEN `((\n. higher_complex_derivative n f (Cx(&0)) / Cx(&(FACT n)) * (z - Cx(&0)) pow n) sums f(z)) (from 0)` MP_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_POWER_SERIES THEN EXISTS_TAC `norm(z:complex) + &1` THEN REWRITE_TAC[COMPLEX_IN_BALL_0; REAL_ARITH `x < x + &1`] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; REWRITE_TAC[COMPLEX_SUB_RZERO] THEN DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `n + 1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ADD_SUB; ARITH_RULE `0 < n + 1`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SERIES_UNIQUE) THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC SUMS_0 THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_FROM; ARITH_RULE `n + 1 <= k <=> n < k`] THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN REWRITE_TAC[COMPLEX_DIV_EQ_0] THEN REPEAT DISJ1_TAC THEN MATCH_MP_TAC(MESON[COMPLEX_NORM_NZ] `~(&0 < norm w) ==> w = Cx(&0)`) THEN DISCH_TAC THEN ABBREV_TAC `w = Cx(&(FACT k) * B / norm(higher_complex_derivative k f (Cx(&0))) + abs A + &1)` THEN SUBGOAL_THEN `~(w = Cx(&0))` ASSUME_TAC THENL [EXPAND_TAC "w" THEN REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> ~(x + abs a + &1 = &0)`) THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]; ALL_TAC] THEN MP_TAC(SPECL [`f:complex->complex`; `Cx(&0)`; `norm(w:complex)`; `B * norm(w:complex) pow n`; `k:num`] CAUCHY_INEQUALITY) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; ASM_REWRITE_TAC[COMPLEX_NORM_NZ]; REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN X_GEN_TAC `x:complex` THEN DISCH_THEN(fun th -> SUBST1_TAC(SYM th) THEN ASSUME_TAC th) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "w" THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= k ==> a <= abs(k + abs a + &1)`) THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]; REWRITE_TAC[REAL_ARITH `~(d:real <= f * (b * n) / k) <=> f * b * (n / k) < d`] THEN ASM_SIMP_TAC[REAL_DIV_POW2; COMPLEX_NORM_ZERO] THEN ASM_REWRITE_TAC[REAL_MUL_ASSOC; GSYM NOT_LT] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; REAL_POW_LT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ] THEN TRANS_TAC REAL_LTE_TRANS `norm(w:complex) pow 1` THEN CONJ_TAC THENL [EXPAND_TAC "w" THEN REWRITE_TAC[REAL_POW_1; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= k * B / d ==> (B * k) / d < abs(k * B / d + abs a + &1)`); MATCH_MP_TAC REAL_POW_MONO THEN CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN EXPAND_TAC "w" THEN REWRITE_TAC[REAL_POW_1; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= k * B / d ==> &1 <= abs(k * B / d + abs a + &1)`)] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]]);; let LIOUVILLE_THEOREM = prove (`!f. f holomorphic_on (:complex) /\ bounded (IMAGE f (:complex)) ==> ?c. !z. f(z) = c`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `&0`; `B:real`; `0`] LIOUVILLE_POLYNOMIAL) THEN ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; real_pow; REAL_MUL_RID; complex_pow] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A holomorphic function f has only isolated zeros unless f is 0. *) (* ------------------------------------------------------------------------- *) let ISOLATED_ZEROS = prove (`!f a z w. open a /\ connected a /\ f holomorphic_on a /\ z IN a /\ f z = Cx(&0) /\ w IN a /\ ~(f w = Cx(&0)) ==> (?r. &0 < r /\ ball(z,r) SUBSET a /\ (!w. w IN ball(z,r) /\ ~(w=z) ==> ~(f w = Cx(&0))))`, REPEAT STRIP_TAC THEN ASSERT_TAC `?k. ~(higher_complex_derivative k f z = Cx(&0)) /\ (!n. n < k ==> higher_complex_derivative n f z = Cx(&0))` THENL [EXISTS_TAC `minimal n. (~(higher_complex_derivative n f z = Cx(&0)))` THEN SUBGOAL_THEN `?k'. ~(higher_complex_derivative k' f z = Cx(&0))` (fun th-> ASM_MESON_TAC[th;MINIMAL]) THEN REWRITE_TAC[GSYM NOT_FORALL_THM] THEN STRIP_TAC THEN ASM_MESON_TAC[HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED]; ALL_TAC] THEN SUBGOAL_THEN `~(k = 0)`ASSUME_TAC THENL [STRIP_TAC THEN MP_TAC(ASSUME `~(higher_complex_derivative k f z = Cx(&0))`) THEN ASM_MESON_TAC[higher_complex_derivative]; STRIP_ASSUME_TAC (MESON [OPEN_CONTAINS_BALL;ASSUME `open (a:complex->bool)`; ASSUME `z:complex IN a`] `?s. &0 < s /\ ball (z:complex,s) SUBSET a`) THEN ASSUME_TAC (MESON [HOLOMORPHIC_POWER_SERIES; ASSUME `f holomorphic_on a`;ASSUME `ball (z:complex,s) SUBSET a`;HOLOMORPHIC_ON_SUBSET] `!w:complex. w IN ball(z,s) ==> ((\n. higher_complex_derivative n f z / Cx(&(FACT n))*(w -z) pow n) sums f w) (from 0)`) THEN ASSERT_TAC `?g:complex->complex. !x:complex. x IN ball(z,s) ==> (((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow (n-k))) sums g x) (from k)` THENL [EXISTS_TAC `\x:complex. lim sequentially (\m. vsum (k..m) (\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow (n-k)))` THEN GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!m. k..m = (0..m) INTER from k` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_FROM; IN_INTER; IN_ELIM_THM; IN_NUMSEG] THEN ARITH_TAC;ASM_REWRITE_TAC[] THEN REWRITE_TAC [SET_RULE `!m. (0..m) INTER from k = from k INTER (0..m)`;SUMS_LIM]] THEN ASM_CASES_TAC `x:complex = z` THENL [ASM_REWRITE_TAC[COMPLEX_SUB_REFL;summable] THEN EXISTS_TAC `higher_complex_derivative k f z / Cx(&(FACT k))` THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n. if n = k then higher_complex_derivative k f z / Cx(&(FACT k)) else Cx(&0)` THEN CONJ_TAC THENL [REWRITE_TAC [IN_FROM] THEN GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[COMPLEX_POW_ZERO;SUB_REFL;COMPLEX_MUL_RID]; ASM_SIMP_TAC[COMPLEX_POW_ZERO; ARITH_RULE `k <= x' /\ ~(x' = k) ==> ~(x' - k = 0)`;COMPLEX_MUL_RZERO]]; MATCH_MP_TAC SERIES_VSUM THEN EXISTS_TAC `{k:num}` THEN SIMP_TAC [FINITE_SING;from;IN_SING; COMPLEX_VEC_0;VSUM_SING] THEN SET_TAC[LE_REFL]]; MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow n / (x-z) pow k` THEN CONJ_TAC THENL [REWRITE_TAC [IN_FROM] THEN GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `(x:complex - z) pow (x' - k) = (x - z) pow x' / (x - z) pow k` (fun th-> REWRITE_TAC[th;COMPLEX_EQ_MUL_LCANCEL]) THEN MATCH_MP_TAC COMPLEX_DIV_POW THEN ASM_SIMP_TAC [COMPLEX_SUB_0]; SUBGOAL_THEN `(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow n / (x - z) pow k) = (\n. (higher_complex_derivative n f z / Cx(&(FACT n)) *(x - z) pow n) / (x - z) pow k) ` SUBST1_TAC THENL [REWRITE_TAC [FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC COMPLEX_FIELD; MATCH_MP_TAC SUMMABLE_COMPLEX_DIV THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `0` THEN ASM_MESON_TAC[summable]]]];ALL_TAC] THEN ASSERT_TAC `~(g (z:complex) = Cx(&0)) /\ (!x. x IN ball(z,s) ==> f x = (x - z) pow k * g(x))` THENL [CONJ_TAC THENL [MATCH_MP_TAC (COMPLEX_FIELD `!x y:complex. x = y /\ ~(y= Cx(&0)) ==> ~(x=Cx(&0))`) THEN EXISTS_TAC `higher_complex_derivative k f z / Cx(&(FACT k))` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC [GSYM COMPLEX_SUB_0] THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * Cx(&0) pow (n-k))` THEN EXISTS_TAC `from (k +1)` THEN CONJ_TAC THENL [SUBST1_TAC (MESON [VSUM_SING_NUMSEG] `higher_complex_derivative k f z / Cx(&(FACT k)) = vsum (k..k) (\n. higher_complex_derivative n f z / Cx(&(FACT n))) `) THEN SUBGOAL_THEN `vsum (k..k) (\n. higher_complex_derivative n f z / Cx(&(FACT n))) = vsum (k..((k+1)-1)) (\n. higher_complex_derivative n f z / Cx(&(FACT n)) * Cx(&0) pow (n - k))` SUBST1_TAC THENL [ REWRITE_TAC[VSUM_SING_NUMSEG; COMPLEX_POW_ZERO;SUB_REFL;COMPLEX_MUL_RID; ARITH_RULE `((k:num) + 1) -1 = k`]; MATCH_MP_TAC SUMS_OFFSET THEN ASM_REWRITE_TAC[ARITH_RULE `k:num <= k+1 /\ 0 < k+1`] THEN POP_ASSUM (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL;COMPLEX_SUB_REFL]];MATCH_MP_TAC SUMS_COMPLEX_0 THEN GEN_TAC THEN SIMP_TAC [IN_FROM;COMPLEX_POW_ZERO; ARITH_RULE `k + 1 <= n <=> ~(n-k= 0)`;COMPLEX_MUL_RZERO]]; MATCH_MP_TAC (COMPLEX_FIELD `!x y. ~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> ~(x / y = Cx(&0))`) THEN ASM_REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN SUBST1_TAC (MESON [COMPLEX_NORM_CX] `norm (Cx(&(FACT k))) = abs ((&(FACT k)))`) THEN SIMP_TAC [REAL_ABS_ZERO;FACT_LT;REAL_OF_NUM_LT;REAL_LT_IMP_NZ]]; ALL_TAC] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow n)`THEN EXISTS_TAC `(from 0)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ASM_CASES_TAC `x:complex = z` THENL [ ASM_REWRITE_TAC[COMPLEX_SUB_REFL] THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n:num. Cx(&0)` THEN CONJ_TAC THENL [REWRITE_TAC[IN_FROM;COMPLEX_POW_ZERO] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN COND_CASES_TAC THENL [ ASM_REWRITE_TAC[higher_complex_derivative] THEN CONV_TAC COMPLEX_FIELD; REWRITE_TAC[COMPLEX_MUL_RZERO]]; ASM_REWRITE_TAC[COMPLEX_POW_ZERO;COMPLEX_MUL_LZERO] THEN ASM_REWRITE_TAC[SERIES_0;GSYM COMPLEX_VEC_0]];ALL_TAC] THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n.(x-z) pow k * higher_complex_derivative n f z / Cx(&(FACT n)) *(x - z) pow (n - k)` THEN CONJ_TAC THENL [REWRITE_TAC[IN_FROM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_CASES_TAC `n:num < k` THENL [ASM_SIMP_TAC[] THEN CONV_TAC COMPLEX_FIELD; SUBGOAL_THEN `(x:complex-z) pow (n-k) = (x-z) pow n / (x-z) pow k` SUBST1_TAC THENL [MATCH_MP_TAC COMPLEX_DIV_POW THEN ASM_SIMP_TAC[COMPLEX_SUB_0; ARITH_RULE `~(n:num < k) ==> k <= n`]; SUBST1_TAC (COMPLEX_FIELD `(x - z) pow k * higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow n / (x - z) pow k = higher_complex_derivative n f z / Cx(&(FACT n)) * (x-z) pow k * (x - z) pow n / (x - z) pow k`) THEN MESON_TAC [ASSUME `~(x:complex = z)`; COMPLEX_DIV_LMUL;COMPLEX_SUB_0;COMPLEX_POW_EQ_0]]]; MATCH_MP_TAC SERIES_COMPLEX_LMUL THEN SUBST1_TAC (MESON [COMPLEX_ADD_RID] `(g:complex->complex) x = g x + Cx(&0)`) THEN SUBGOAL_THEN `Cx(&0) = vsum (0.. (k-1)) (\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow (n - k))` SUBST1_TAC THENL [ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC [GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC [IN_NUMSEG] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[ARITH_RULE ` ~(k = 0) /\ n <= k - 1 ==> n < k`] THEN REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_FIELD; MATCH_MP_TAC SUMS_OFFSET_REV THEN ASM_SIMP_TAC[ARITH_RULE `0 <= k /\ ~(k = 0) ==> 0 < k`;LE_0]]]];ALL_TAC] THEN ASSERT_TAC `?r. &0 < r /\ (!x:complex. dist (z,x) < r ==> ~((g:complex->complex) x = Cx(&0)))` THENL [ MATCH_MP_TAC CONTINUOUS_ON_OPEN_AVOID THEN EXISTS_TAC `ball(z:complex, s)` THEN ASM_REWRITE_TAC[OPEN_BALL;CENTRE_IN_BALL] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC ANALYTIC_IMP_HOLOMORPHIC THEN MATCH_MP_TAC POWER_SERIES_ANALYTIC THEN EXISTS_TAC `\n. higher_complex_derivative (n+k) f z / Cx(&(FACT (n+k)))` THEN EXISTS_TAC `from 0` THEN REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SERIES_FROM] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `(\n.vsum (k..(k+n)) (\n. higher_complex_derivative n f z / Cx(&(FACT n)) *(w' - z) pow (n-k)))` THEN CONJ_TAC THENL [SIMP_TAC [VSUM_OFFSET_0;ARITH_RULE `!k n :num.(k + n) - k = n`; ARITH_RULE `!k n:num. k <= k + n`;ADD_ASSOC; ARITH_RULE `!k n :num.(n + k) - k = n`] THEN SUBGOAL_THEN `(\x. vsum (0..x) (\i. higher_complex_derivative (i + k) f z / Cx(&(FACT (i + k))) * (w' - z) pow i) - vsum (0..x) (\n. higher_complex_derivative (n + k) f z / Cx(&(FACT (n + k))) * (w' - z) pow n)) = (\x. Cx(&0))` (fun th-> SIMP_TAC[th;COMPLEX_VEC_0;LIM_CONST]) THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[COMPLEX_SUB_0]; SUBGOAL_THEN `(\n. vsum (k..k + n) (\n. higher_complex_derivative n f z / Cx(&(FACT n)) *(w' - z) pow (n - k))) = (\n. vsum (k..n+k)(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (w' - z) pow (n - k)))` SUBST1_TAC THENL [ REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[ADD_SYM]; MP_TAC (ISPECL [`(\n. vsum (k..n) (\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (w' - z) pow (n - k)))`;`(g:complex->complex) w'`;`k:num`] SEQ_OFFSET) THEN ONCE_REWRITE_TAC[GSYM SERIES_FROM] THEN ASM_SIMP_TAC[]]]; ALL_TAC] THEN EXISTS_TAC `min r s` THEN CONJ_TAC THENL [MP_TAC (CONJ (ASSUME `&0 < r`) (ASSUME `&0 < s`)) THEN REAL_ARITH_TAC; CONJ_TAC THENL [REWRITE_TAC[real_min] THEN COND_CASES_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,s)` THEN ASM_REWRITE_TAC[ball] THEN SET_TAC[ASSUME `r:real <= s`;REAL_LTE_TRANS]; ASM_REWRITE_TAC[]];GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `(f:complex->complex) w' = (w' - z) pow k * (g:complex->complex) w'` SUBST1_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC (ASSUME `w':complex IN ball (z,min r s)`) THEN REWRITE_TAC [real_min] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[IN_BALL;REAL_LTE_TRANS]; REWRITE_TAC[]];SIMP_TAC [COMPLEX_ENTIRE;DE_MORGAN_THM] THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_POW_EQ_0;DE_MORGAN_THM] THEN DISJ1_TAC THEN ASM_REWRITE_TAC [COMPLEX_SUB_0]; FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC (ASSUME `w':complex IN ball (z,min r s)`) THEN REWRITE_TAC [real_min] THEN COND_CASES_TAC THENL [REWRITE_TAC[IN_BALL]; ASM_MESON_TAC[REAL_NOT_LE;IN_BALL;REAL_LT_TRANS]]]]]]]);; (* ------------------------------------------------------------------------- *) (* Analytic continuation. *) (* ------------------------------------------------------------------------- *) let ANALYTIC_CONTINUATION = prove (`!f a u z. open a /\ connected a /\ f holomorphic_on a /\ u SUBSET a /\ z IN a /\ z limit_point_of u /\ (!w. w IN u ==> f w = Cx(&0)) ==> (!w. w IN a ==> f w = Cx(&0))`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[TAUT ` (p ==> q) <=> ~( p /\ (~ q))`;GSYM NOT_EXISTS_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `(f:complex->complex) z = Cx(&0)` ASSUME_TAC THENL [STRIP_ASSUME_TAC(MESON [OPEN_CONTAINS_CBALL; ASSUME `open (a:complex->bool)`; ASSUME `z:complex IN a`] `?e. &0 < e /\ cball (z:complex,e) SUBSET a`) THEN ABBREV_TAC `s = cball(z:complex,e) INTER (u:complex->bool)` THEN ASSERT_TAC `f:complex->complex continuous_on closure s /\ (!x:complex. x IN s ==> f x = Cx(&0)) /\ z:complex IN closure s` THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `a:complex->bool` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(z:complex,e)` THEN ASM_MESON_TAC[CLOSED_CBALL;INTER_SUBSET;CLOSURE_MINIMAL]; CONJ_TAC THENL [ASM_MESON_TAC[INTER_SUBSET;SUBSET]; ASM_SIMP_TAC[closure;IN_UNION] THEN DISJ2_TAC THEN SUBGOAL_THEN `z:complex limit_point_of s` (fun thm-> SET_TAC[thm]) THEN REWRITE_TAC [LIMPT_APPROACHABLE] THEN GEN_TAC THEN DISCH_TAC THEN ASSERT_TAC `?x:complex. x IN u /\ ~(x = z) /\ dist (x , z) < min e' e` THENL [MP_TAC (ISPECL [`z:complex`;`u:complex->bool`] LIMPT_APPROACHABLE) THEN ASM_SIMP_TAC[REAL_LT_MIN];EXISTS_TAC `x:complex` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC [GSYM (ASSUME `cball (z:complex,e) INTER u = s`);IN_INTER; ASSUME `x:complex IN u`;IN_CBALL] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LT_MIN;DIST_SYM]; ASM_MESON_TAC [REAL_LT_MIN]]]]]; ASM_MESON_TAC [CONTINUOUS_CONSTANT_ON_CLOSURE]]; MP_TAC(SPECL [`f:complex->complex`;`a:complex->bool`;`z:complex`;`w:complex`] ISOLATED_ZEROS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `?x:complex. x IN ball(z,r) /\ x IN u /\ ~(x=z) /\ (f:complex->complex) x = Cx(&0)`(fun thm->ASM_MESON_TAC[thm]) THEN MP_TAC (ISPECL [`z:complex`;`u:complex->bool`] LIMPT_APPROACHABLE) THEN ASM_REWRITE_TAC [] THEN DISCH_TAC THEN POP_ASSUM (MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN EXISTS_TAC `x':complex` THEN ASM_MESON_TAC[IN_BALL;DIST_SYM]]);; let HOLOMORPHIC_FUNCTION_ENTIRE = prove (`!f g s. open s /\ connected s /\ f continuous_on s /\ g holomorphic_on s /\ (!z. z IN s ==> f z * g z = Cx(&0)) ==> (!z. z IN s ==> f z = Cx(&0)) \/ (!z. z IN s ==> g z = Cx(&0))`, REPEAT STRIP_TAC THEN REWRITE_TAC[MESON[] `(!x. P x) \/ (!x. Q x) <=> !x. ~P x ==> !x. Q x`] THEN X_GEN_TAC `a:complex` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o ISPEC `f:complex->complex` o MATCH_MP CONTINUOUS_ON_EQ_CONTINUOUS_AT) THEN ASM_REWRITE_TAC[continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `norm((f:complex->complex) a)`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC ANALYTIC_CONTINUATION THEN MAP_EVERY EXISTS_TAC [`ball(a:complex,min d e)`; `a:complex`] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_BALL]) THEN ASM_SIMP_TAC[SUBSET; IN_BALL; REAL_LT_MIN] THEN ASM_SIMP_TAC[LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_MIN; REAL_LT_IMP_LE] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN ASM_CASES_TAC `(z:complex) IN s` THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM; COMPLEX_ENTIRE] THEN ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN CONV_TAC NORM_ARITH);; let HOLOMORPHIC_FUNCTION_ENTIRE_PRODUCT = prove (`!f s k:A->bool. open s /\ connected s /\ FINITE k /\ ~(k = {}) /\ (!i. i IN k ==> f i holomorphic_on s) /\ (!z. z IN s ==> cproduct k (\i. f i z) = Cx(&0)) ==> ?i. i IN k /\ !z. z IN s ==> f i z = Cx(&0)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; NOT_INSERT_EMPTY] THEN ASM_SIMP_TAC[CPRODUCT_CLAUSES] THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[CPRODUCT_CLAUSES; COMPLEX_MUL_RID] THEN SIMP_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> MP_TAC(PART_MATCH (funpow 4 rand o lhand) HOLOMORPHIC_FUNCTION_ENTIRE (concl th))) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; ETA_AX] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_CPRODUCT] THEN MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Open mapping theorem. *) (* ------------------------------------------------------------------------- *) let OPEN_MAPPING_THM = prove (`!a f. open a /\ connected a /\ f holomorphic_on a /\ ~(?c:complex. !z:complex. z IN a ==> f z = c) ==> (!u. open u /\ u SUBSET a ==> open(IMAGE f u))`, let LEMMA_ZERO = prove (`!f z r. f continuous_on cball(z,r) /\ f holomorphic_on ball(z,r) /\ &0 < r /\ (!w. norm(z-w) =r ==> norm(f z) < norm(f w)) ==> (?w. w IN ball(z,r) /\ f w = Cx(&0))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN ` ((!x:complex. x IN ball(z,r) ==> ~((f:complex->complex) x = Cx(&0))) ==> F ) ==> ( ?w:complex. w IN ball(z,r) /\ f w = Cx(&0))` MATCH_MP_TAC THENL [MESON_TAC[]; STRIP_TAC THEN SUBGOAL_THEN `&0 < norm ((f:complex->complex) z)` ASSUME_TAC THENL [ASM_SIMP_TAC[COMPLEX_NORM_NZ; CENTRE_IN_BALL; SPEC `z:complex` (ASSUME`!x:complex. x IN ball(z,r) ==> ~((f:complex->complex) x = Cx(&0))`)]; ALL_TAC] THEN SUBGOAL_THEN `(!x:complex. x IN cball(z,r) ==> ~((f:complex->complex) x = Cx(&0)))` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC [IN_CBALL;dist] THEN REWRITE_TAC[REAL_ARITH `a <= b <=> a < b \/ a = b`] THEN REWRITE_TAC [TAUT `((p \/ q) ==> r ) <=> ((p ==> r ) /\ (q ==> r))`] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_BALL;dist]; DISCH_TAC THEN REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `norm ((f:complex->complex) z)` THEN ASM_SIMP_TAC [SPEC `z':complex` (ASSUME `!w:complex. norm (w - z) = r ==> norm ((f:complex->complex) z) < norm (f w)`)]]; ALL_TAC] THEN SUBGOAL_THEN `~(frontier(cball(z:complex,r))={})` ASSUME_TAC THENL [REWRITE_TAC[FRONTIER_CBALL;sphere;dist] THEN SUBGOAL_THEN `?x:complex. norm(z-x) = r` (fun th-> SET_TAC [MEMBER_NOT_EMPTY;th]) THEN EXISTS_TAC `z + Cx r` THEN ASM_SIMP_TAC[COMPLEX_ADD_SUB2;NORM_NEG;COMPLEX_NORM_CX; REAL_ABS_REFL;REAL_LT_IMP_LE];ALL_TAC] THEN ABBREV_TAC `g = \z. inv ((f:complex->complex) z)` THEN ASSERT_TAC `(g:complex->complex) continuous_on cball(z,r) /\ g holomorphic_on ball(z,r)` THENL [CONJ_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_INV_WITHIN THEN ASM_MESON_TAC [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN];EXPAND_TAC "g" THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN ASM_REWRITE_TAC[]];ALL_TAC] THEN SUBGOAL_THEN `?w:complex. w IN frontier(cball(z,r)) /\ (!x:complex. x IN frontier(cball(z,r)) ==> norm ((f:complex->complex) w) <= norm (f x))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC CONTINUOUS_ATTAINS_INF THEN ASM_SIMP_TAC[COMPACT_FRONTIER;COMPACT_CBALL;CBALL_EQ_EMPTY; REAL_ARITH `!r:real. &0 < r ==> ~(r < &0)` ] THEN SUBGOAL_THEN `lift o (\x. norm ((f:complex->complex) x)) = (lift o norm) o (\x. f x) ` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[SUBSET_TRANS;CLOSED_CBALL;FRONTIER_SUBSET_CLOSED]; ASM_MESON_TAC [CONTINUOUS_ON_LIFT_NORM; HOLOMORPHIC_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON;SUBSET_TRANS;CLOSED_CBALL; FRONTIER_SUBSET_CLOSED]]];ALL_TAC] THEN SUBGOAL_THEN `?w:complex. norm (z-w) = r /\ norm ((f:complex->complex) w) <= norm (f z)` (fun thm -> ASM_MESON_TAC[thm;REAL_NOT_LE]) THEN EXISTS_TAC `w:complex` THEN CONJ_TAC THENL [MP_TAC (ASSUME `w:complex IN frontier (cball (z,r))`) THEN REWRITE_TAC[FRONTIER_CBALL;sphere;dist] THEN SET_TAC[];ALL_TAC] THEN SUBGOAL_THEN `&0 < norm ((f:complex->complex) w)` ASSUME_TAC THENL [REWRITE_TAC[NORM_POS_LT;COMPLEX_VEC_0] THEN MATCH_MP_TAC (ASSUME `!x. x:complex IN cball (z,r) ==> ~(f x = Cx(&0))`) THEN MATCH_MP_TAC (SET_RULE `!x:complex u s. x IN u /\ u SUBSET s ==> x IN s `) THEN EXISTS_TAC `frontier(cball(z:complex,r))` THEN ASM_SIMP_TAC[CLOSED_CBALL;FRONTIER_SUBSET_CLOSED];ALL_TAC] THEN SUBGOAL_THEN `inv (norm ((f:complex-> complex) w)) = &1/ (norm (f w))` ASSUME_TAC THENL [MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO;GSYM COMPLEX_NORM_NZ]; ASSERT_TAC `?x:complex. x IN frontier(cball(z,r)) /\ (!y. y IN frontier(cball(z,r)) ==> norm ((g:complex->complex) y) <= norm (g x))` THENL [MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN ASM_SIMP_TAC[COMPACT_FRONTIER; COMPACT_CBALL;CBALL_EQ_EMPTY; REAL_ARITH `!r:real. &0 < r ==> ~(r < &0)`] THEN SUBGOAL_THEN `lift o (\x. norm ((g:complex->complex) x)) = (lift o norm) o (\x. g x) ` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[SUBSET_TRANS;CLOSED_CBALL; FRONTIER_SUBSET_CLOSED]; ASM_MESON_TAC [CONTINUOUS_ON_LIFT_NORM; HOLOMORPHIC_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON;SUBSET_TRANS; CLOSED_CBALL; FRONTIER_SUBSET_CLOSED]]];ALL_TAC] THEN SUBGOAL_THEN `&0 < norm ((f:complex->complex) x)` ASSUME_TAC THENL [REWRITE_TAC[NORM_POS_LT;COMPLEX_VEC_0] THEN MATCH_MP_TAC (ASSUME `!x. x:complex IN cball (z,r) ==> ~(f x = Cx(&0))`) THEN MATCH_MP_TAC (SET_RULE `!x:complex u s. x IN u /\ u SUBSET s ==> x IN s `) THEN EXISTS_TAC `frontier(cball(z:complex,r))` THEN ASM_SIMP_TAC[CLOSED_CBALL;FRONTIER_SUBSET_CLOSED]; ABBREV_TAC `B = norm ((g:complex->complex) x)` THEN SUBGOAL_THEN `norm (higher_complex_derivative 0 g z) <= (&(FACT 0)) * B / (r pow 0) ` MP_TAC THENL[MATCH_MP_TAC CAUCHY_INEQUALITY THEN ASM_REWRITE_TAC[] THEN MP_TAC (ASSUME `!y:complex. y IN frontier (cball (z,r)) ==> norm ((g:complex ->complex) y) <= B`) THEN SIMP_TAC [FRONTIER_CBALL;sphere;dist] THEN SET_TAC[]; REWRITE_TAC [higher_complex_derivative;FACT;real_pow; REAL_MUL_LID;REAL_DIV_1] THEN DISCH_TAC THEN SUBGOAL_THEN `inv (norm ((f:complex->complex) z)) <= inv (norm (f w)) ==> norm (f w) <= norm (f z)` MATCH_MP_TAC THENL [SUBGOAL_THEN `inv (norm ((f:complex-> complex) z)) = &1/ (norm (f z))` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_SIMP_TAC[REAL_ARITH `&0 < norm ((f:complex->complex) z) ==> ~(norm (f z) = &0) `]; ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBST1_TAC (REAL_ARITH `norm ((f:complex->complex) w)= &1 * norm (f w)`) THEN SUBST1_TAC(REAL_ARITH `norm ((f:complex->complex) z)= &1 * norm (f z)`) THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC (TAUT `(p <=> q ) ==> ( p ==> q)`) THEN MATCH_MP_TAC RAT_LEMMA4 THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[GSYM COMPLEX_NORM_INV] THEN SUBGOAL_THEN `inv ((f:complex->complex) z) = g z /\ inv (f w) = g w` (fun thm -> REWRITE_TAC[thm]) THENL [ASM_MESON_TAC[];MATCH_MP_TAC (REAL_ARITH `!x y z:real. x <= y /\ y = z ==> x <= z`) THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [EXPAND_TAC "B" THEN REWRITE_TAC[SYM (ASSUME`(\z. inv ((f:complex->complex) z)) = g`);COMPLEX_NORM_INV] THEN SUBGOAL_THEN `inv (norm ((f:complex->complex) x)) = &1 / norm (f x)` (fun thm -> REWRITE_TAC[thm]) THENL [MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ASM_REWRITE_TAC[] THEN MP_TAC (SPEC `x:complex`(ASSUME`!x:complex. x IN frontier (cball (z,r)) ==> norm ((f:complex->complex) w) <= norm (f x)`)) THEN REWRITE_TAC [ASSUME`x:complex IN frontier (cball (z,r))`] THEN SUBST1_TAC (REAL_ARITH `norm ((f:complex->complex) w)= &1* norm (f w)`) THEN SUBST1_TAC (REAL_ARITH `norm ((f:complex->complex) x)= &1 * norm (f x)`) THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_LID] THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC (TAUT `(q <=> p ) ==> ( p ==> q)`) THEN MATCH_MP_TAC (RAT_LEMMA4) THEN ASM_REWRITE_TAC[]];ASM_MESON_TAC[]]]]]]]]) in REPEAT STRIP_TAC THEN ASSUME_TAC (MESON [HOLOMORPHIC_ON_SUBSET; ASSUME `(u:complex->bool) SUBSET a`;ASSUME `f holomorphic_on a`] `f holomorphic_on u`) THEN ASM_CASES_TAC `(u:complex->bool)={}` THENL [ ASM_MESON_TAC[SUBSET_EMPTY;IMAGE_EQ_EMPTY;OPEN_EMPTY];ALL_TAC] THEN SUBGOAL_THEN `!f u. ~(u={}) /\ open u /\ connected u /\ f holomorphic_on u /\ ~(?c:complex. !z:complex. z IN u ==> f z=c) ==> open (IMAGE f u)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL;IN_IMAGE] THEN GEN_TAC THEN STRIP_TAC THEN ASSERT_TAC `(\z:complex.(f':complex->complex)z - f' x') holomorphic_on (u':complex->bool) /\ (\z:complex. f' z - f' x')x' = Cx(&0)` THENL [ ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST;HOLOMORPHIC_ON_SUB; BETA_THM;COMPLEX_SUB_REFL];ALL_TAC] THEN ASSERT_TAC `?s:real. &0 < s /\ ball(x',s) SUBSET u' /\ (!z:complex. z IN ball(x',s) /\ ~(z = x') ==> ~((\z:complex.(f':complex->complex)z - f' x') z = Cx(&0)))` THENL [ MATCH_MP_TAC ISOLATED_ZEROS THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[COMPLEX_SUB_0]; ASSERT_TAC `?r. &0 < r /\ cball(x':complex,r) SUBSET ball(x',s)` THENL[ EXISTS_TAC `s:real / &2` THEN ASM_SIMP_TAC [REAL_ARITH `&0 < s ==> &0 < s/ &2`;SUBSET;IN_CBALL;IN_BALL] THEN MP_TAC (ASSUME `&0 < s`) THEN REAL_ARITH_TAC;ALL_TAC] THEN ASSERT_TAC `cball(x',r) SUBSET u' /\ (!z:complex. z IN cball(x',r) /\ ~(z=x')==> ~((\z:complex.(f':complex->complex)z - f' x') z = Cx(&0)))` THENL [CONJ_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS]; MESON_TAC[ASSUME `!z:complex. z IN ball (x',s) /\ ~(z = x') ==> ~((\z. (f':complex->complex) z - f' x') z = Cx(&0))`; ASSUME `cball (x':complex,r) SUBSET ball (x',s)`;SUBSET]];ALL_TAC] THEN SUBGOAL_THEN `frontier (cball (x':complex,r)) SUBSET u'` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(x':complex,r)` THEN ASM_MESON_TAC[CLOSED_CBALL;FRONTIER_SUBSET_CLOSED];ALL_TAC] THEN ASSERT_TAC `?w. w IN frontier(cball(x':complex,r)) /\ (!z. z IN frontier(cball(x',r)) ==> norm ((f':complex->complex)w - f' x') <= norm(f' z - f' x'))` THENL [MATCH_MP_TAC CONTINUOUS_ATTAINS_INF THEN ASM_SIMP_TAC[COMPACT_FRONTIER;COMPACT_CBALL;CBALL_EQ_EMPTY; REAL_ARITH `!r:real. &0 < r ==> ~(r < &0)` ] THEN CONJ_TAC THENL [REWRITE_TAC[REWRITE_RULE[sphere] FRONTIER_CBALL;dist] THEN SUBGOAL_THEN `?x:complex. norm(x'-x) = r` (fun th-> SET_TAC [MEMBER_NOT_EMPTY;th]) THEN EXISTS_TAC `x' + Cx r` THEN ASM_SIMP_TAC[COMPLEX_ADD_SUB2;NORM_NEG;COMPLEX_NORM_CX; REAL_ABS_REFL;REAL_LT_IMP_LE]; SUBGOAL_THEN `lift o (\z. norm ((f':complex->complex) z - f' x')) = (lift o norm) o (\z. f' z - f' x') ` SUBST1_TAC THENL [ REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC [CONTINUOUS_ON_LIFT_NORM; HOLOMORPHIC_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]]];ALL_TAC] THEN ABBREV_TAC `e = (norm ((f':complex->complex) w - f' x'))*(&1/ &3)` THEN SUBGOAL_THEN `&0complex) w - f' x' = (\w. f' w - f' x')w `) THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL[MESON_TAC[ASSUME `w:complex IN frontier (cball (x',r))`; FRONTIER_SUBSET_CLOSED; CLOSED_CBALL;SET_RULE `!x:complex s t. x IN s /\ s SUBSET t ==> x IN t` ];ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC (REAL_ARITH `&0 < r /\ r = norm (w:complex - x') ==> &0 < norm (w - x')`) THEN ASM_REWRITE_TAC[] THEN MP_TAC (ASSUME `w:complex IN frontier (cball (x',r))`) THEN SIMP_TAC[FRONTIER_CBALL; sphere; dist; IN_ELIM_THM; NORM_SUB]]; ALL_TAC] THEN EXISTS_TAC `e:real` THEN REWRITE_TAC[ASSUME `&0complex) x = Cx(&0)) ==> ?x. x'' - f' x = Cx(&0) /\ x IN u'` MATCH_MP_TAC THENL [ STRIP_TAC THEN EXISTS_TAC `x''':complex` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (SET_RULE `!x:complex u s. x IN u /\ u SUBSET s ==> x IN s`) THEN EXISTS_TAC `ball(x':complex,r)` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[BALL_SUBSET_CBALL;SUBSET_TRANS]; MATCH_MP_TAC LEMMA_ZERO THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN ASM_MESON_TAC [HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_SUBSET]; CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN ASM_MESON_TAC[ HOLOMORPHIC_ON_CONST;HOLOMORPHIC_ON_SUBSET;BALL_SUBSET_CBALL]; ASM_REWRITE_TAC[] THEN X_GEN_TAC `w':complex` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN CONJ_TAC THENL [MESON_TAC [NORM_SUB;dist;IN_BALL; ASSUME`x'':complex IN ball (x,e)`; ASSUME `x:complex = (f':complex->complex) x'`]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2*e` THEN ASM_SIMP_TAC[REAL_ARITH `&0 e <= &2 * e`;NORM_SUB] THEN SUBST1_TAC (COMPLEX_RING `(f':complex->complex) w' - x'' = f' w' -x + x - x''`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm ((f':complex->complex) w' - x) - norm (x-x'')` THEN CONJ_TAC THENL [SUBST1_TAC (REAL_ARITH `&2 * e = &3 *e - e`) THEN MATCH_MP_TAC (REAL_ARITH `!x y z w:real. x<=y /\ z x-w <= y-z`) THEN CONJ_TAC THENL [EXPAND_TAC "e" THEN ASM_REWRITE_TAC[REAL_ARITH `&3 * norm ((f':complex->complex) w - f' x') * &1 / &3 = norm (f' w - f' x')`] THEN FIRST_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[FRONTIER_CBALL; sphere; NORM_SUB; IN_ELIM_THM; dist]; UNDISCH_TAC `x'':complex IN ball (x,e)` THEN REWRITE_TAC [IN_BALL;dist;ASSUME`x:complex = (f':complex->complex) x'`]]; MATCH_MP_TAC (REAL_ARITH `!x y z:real. x<=y+z ==> x-z<=y`) THEN REWRITE_TAC[COMPLEX_NORM_TRIANGLE_SUB]]]]]]];ALL_TAC] THEN ASM_CASES_TAC `connected (u:complex->bool)` THENL [ SUBGOAL_THEN `~(?c:complex. !z:complex. z IN u ==> f z=c)` (fun th-> ASM_MESON_TAC [th]) THEN ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN STRIP_TAC THEN ABBREV_TAC `w:complex= CHOICE u` THEN ASSUME_TAC (MESON [CHOICE_DEF;GSYM (ASSUME `CHOICE u = w:complex`); ASSUME `~(u:complex->bool = {})`] `w:complex IN u`) THEN ASSERT_TAC `w:complex limit_point_of u` THENL [MATCH_MP_TAC INTERIOR_LIMIT_POINT THEN ASM_SIMP_TAC [INTERIOR_OPEN]; SUBGOAL_THEN `(\z. (f:complex->complex) z - c) holomorphic_on a` ASSUME_TAC THENL [ASM_SIMP_TAC [HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST]; ASSUME_TAC (MESON [ASSUME `w:complex IN u`;ASSUME `u:complex->bool SUBSET a`; SET_RULE `w:complex IN u /\ u SUBSET a ==> w IN a`] `w:complex IN a`) THEN MP_TAC(SPECL [`\z:complex.(f:complex->complex)z - c`; `a:complex->bool`; `u:complex->bool`; `w:complex`] ANALYTIC_CONTINUATION) THEN ASM_REWRITE_TAC [] THEN MP_TAC (ASSUME `~(?c:complex. !z. z IN a ==> (f:complex->complex) z = c)`) THEN ONCE_REWRITE_TAC [GSYM COMPLEX_SUB_0; GSYM COMPLEX_SUB_RZERO] THEN ONCE_REWRITE_TAC [COMPLEX_SUB_RZERO] THEN MESON_TAC[]]];ALL_TAC] THEN SUBST1_TAC (MESON [UNIONS_COMPONENTS] `u:complex->bool = UNIONS ( components u)`) THEN REWRITE_TAC [IMAGE_UNIONS] THEN MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_IMAGE] THEN GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN STRIP_ASSUME_TAC(MESON [IN_COMPONENTS; ASSUME `(x:complex->bool) IN components u`] `?w:complex. w IN u /\ x = connected_component u w`) THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_EMPTY;OPEN_CONNECTED_COMPONENT; CONNECTED_CONNECTED_COMPONENT] THEN CONJ_TAC THENL [ASM_MESON_TAC [CONNECTED_COMPONENT_SUBSET; HOLOMORPHIC_ON_SUBSET]; ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN STRIP_TAC THEN ABBREV_TAC `y = CHOICE (x:complex->bool)` THEN SUBGOAL_THEN `y:complex IN x` ASSUME_TAC THENL [EXPAND_TAC "y" THEN MATCH_MP_TAC CHOICE_DEF THEN ASM_MESON_TAC [CONNECTED_COMPONENT_EQ_EMPTY]; ASSUME_TAC (MESON [OPEN_COMPONENTS;ASSUME `open (u:complex->bool)`; ASSUME` x:complex->bool IN components u`] `open (x:complex->bool)`) THEN ASSERT_TAC `y:complex limit_point_of x` THENL [ MATCH_MP_TAC INTERIOR_LIMIT_POINT THEN ASSUME_TAC (MESON [OPEN_COMPONENTS;ASSUME `open (u:complex->bool)`; ASSUME` x:complex->bool IN components u`] `open (x:complex->bool)`) THEN SIMP_TAC [INTERIOR_OPEN;ASSUME `open (x:complex->bool)`; ASSUME `y:complex IN x`]; SUBGOAL_THEN `(\z. (f:complex->complex) z - c) holomorphic_on a` ASSUME_TAC THENL [ ASM_SIMP_TAC [HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST]; SUBGOAL_THEN `x:complex->bool SUBSET a` ASSUME_TAC THENL [ MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `u:complex->bool` THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; SUBGOAL_THEN `y:complex IN a` ASSUME_TAC THENL [ MATCH_MP_TAC (SET_RULE `y:complex IN x /\ x SUBSET a ==> y IN a`) THEN ASM_REWRITE_TAC[]; MP_TAC(SPECL [`\z:complex.(f:complex->complex)z - c`; `a:complex->bool`; `x:complex->bool`; `y:complex`] ANALYTIC_CONTINUATION) THEN ASM_REWRITE_TAC [] THEN MP_TAC (ASSUME `~(?c:complex. !z. z IN a ==> (f:complex->complex) z = c)`) THEN ONCE_REWRITE_TAC [GSYM COMPLEX_SUB_0;GSYM COMPLEX_SUB_RZERO] THEN ONCE_REWRITE_TAC [COMPLEX_SUB_RZERO] THEN MESON_TAC[]]]]]]]);; (* ------------------------------------------------------------------------- *) (* Maximum modulus principle. *) (* ------------------------------------------------------------------------- *) let MAXIMUM_MODULUS_PRINCIPLE = prove (`!f a u w. open a /\ connected a /\ f holomorphic_on a /\ open u /\ u SUBSET a /\ w IN u /\ (!z. z IN u ==> norm(f z) <= norm(f w)) ==> (?c. !z. z IN a ==> f z = c)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(open (IMAGE (f:complex->complex) u))` (fun th -> ASM_MESON_TAC[th; OPEN_MAPPING_THM]) THEN REWRITE_TAC[OPEN_CONTAINS_BALL;NOT_FORALL_THM] THEN EXISTS_TAC `(f:complex->complex) w` THEN MATCH_MP_TAC (TAUT `!p q. (p /\ ~ q) ==> ~(p ==> q)`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_IMAGE]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM;SUBSET] THEN GEN_TAC THEN ASM_CASES_TAC `~(&0 < e)` THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN DISJ2_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `if &0 < Re((f:complex->complex) w) then f w + Cx(e / &2) else f w - Cx(e/ &2) ` THEN ABBREV_TAC `x = if &0complex) w) then f w + Cx(e / &2) else f w - Cx(e / &2)` THEN MATCH_MP_TAC (TAUT `!p q. (p /\ ~ q) ==> ~(p ==> q)`) THEN CONJ_TAC THENL [REWRITE_TAC[IN_BALL;dist] THEN MATCH_MP_TAC (REAL_ARITH `!x y z:real. x = y /\ y < z ==> x < z `) THEN EXISTS_TAC `e / &2` THEN EXPAND_TAC "x" THEN COND_CASES_TAC THENL [ASM_SIMP_TAC [NORM_NEG;COMPLEX_ADD_SUB2;REAL_ARITH `&0 < e ==> e / &2 &0 <= e / &2`]; ASM_SIMP_TAC [COMPLEX_SUB_SUB2; REAL_ARITH `&0 < e ==> e / &2 &0 <= e / &2`]]; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM; DE_MORGAN_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x':complex IN u)` THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISJ1_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC (NORM_ARITH `!x y:complex. ~(norm x=norm y) ==> ~(x=y)`) THEN REWRITE_TAC[REAL_NOT_EQ] THEN DISJ2_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm ((f:complex->complex) w)` THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "x" THEN COND_CASES_TAC THEN REWRITE_TAC [complex_norm;RE_ADD;IM_ADD; IM_CX;RE_CX;REAL_ADD_RID] THENL [MATCH_MP_TAC SQRT_MONO_LT THEN MATCH_MP_TAC (REAL_ARITH `!x:real y z. x < y ==> x + z < y + z`) THEN REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS] THEN ASM_SIMP_TAC [REAL_ARITH `!x y. &0 < x /\ &0 < y ==> abs (x+y) = abs x + abs y`; REAL_ARITH `!x:real. &0 < x ==> &0 < x / &2`] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC [complex_norm;RE_SUB;IM_SUB; IM_CX;RE_CX;REAL_SUB_RZERO] THEN MATCH_MP_TAC SQRT_MONO_LT THEN MATCH_MP_TAC (REAL_ARITH `!x:real y z. x < y ==> x + z < y + z`) THEN REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN ASM_SIMP_TAC [REAL_ARITH `!x y. x <= &0 /\ &0 < y ==> abs (x - y) = abs x + abs y`; REAL_ARITH `!x. &0 < x ==> &0 < x/ &2`] THEN ASM_REAL_ARITH_TAC);; let MAXIMUM_MODULUS_FRONTIER = prove (`!f s B. bounded s /\ f holomorphic_on (interior s) /\ f continuous_on (closure s) /\ (!z. z IN frontier s ==> norm(f z) <= B) ==> !z. z IN s ==> norm(f z) <= B`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`norm o (f:complex->complex)`; `closure s:complex->bool`] CONTINUOUS_ATTAINS_SUP) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE; CLOSURE_EQ_EMPTY] THEN ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_SIMP_TAC[o_DEF; CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `norm((f:complex->complex) z) <= B` ASSUME_TAC THENL [ALL_TAC; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET; REAL_LE_TRANS]] THEN ASM_CASES_TAC `(z:complex) IN frontier s` THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `(z:complex) IN interior s` ASSUME_TAC THENL [ASM_MESON_TAC[frontier; IN_DIFF]; ALL_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `connected_component (interior s) (z:complex)`; `connected_component (interior s) (z:complex)`; `z:complex`] MAXIMUM_MODULUS_PRINCIPLE) THEN ASSUME_TAC(ISPECL [`interior s:complex->bool`; `z:complex`] CONNECTED_COMPONENT_SUBSET) THEN ASSUME_TAC(ISPEC `s:complex->bool` INTERIOR_SUBSET) THEN ASSUME_TAC(ISPEC `s:complex->bool` CLOSURE_SUBSET) THEN SUBGOAL_THEN `(z:complex) IN connected_component (interior s) z` ASSUME_TAC THENL [ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]; ALL_TAC] THEN SIMP_TAC[OPEN_CONNECTED_COMPONENT; OPEN_INTERIOR; SUBSET_REFL] THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS]; DISCH_THEN(X_CHOOSE_TAC `c:complex`)] THEN SUBGOAL_THEN `!w. w IN closure(connected_component (interior s) z) ==> (f:complex->complex) w IN {c}` MP_TAC THENL [MATCH_MP_TAC FORALL_IN_CLOSURE THEN ASM_REWRITE_TAC[IN_SING; CLOSED_SING] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET_TRANS]; REWRITE_TAC[IN_SING]] THEN SUBGOAL_THEN `~(frontier(connected_component (interior s) (z:complex)) = {})` MP_TAC THENL [REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[BOUNDED_SUBSET; NOT_BOUNDED_UNIV]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `a:complex` THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_SIMP_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a IN s ==> s SUBSET t ==> a IN t`)) THEN TRANS_TAC SUBSET_TRANS `frontier(interior s:complex->bool)` THEN SIMP_TAC[FRONTIER_INTERIOR_SUBSET; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]);; let MAXIMUM_REAL_FRONTIER = prove (`!f s B. bounded s /\ f holomorphic_on (interior s) /\ f continuous_on (closure s) /\ (!z. z IN frontier s ==> Re(f z) <= B) ==> !z. z IN s ==> Re(f z) <= B`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`cexp o (f:complex->complex)`; `s:complex->bool`; `exp B`] MAXIMUM_MODULUS_FRONTIER) THEN ASM_SIMP_TAC[NORM_CEXP; o_THM; HOLOMORPHIC_ON_COMPOSE; HOLOMORPHIC_ON_CEXP; CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CEXP] THEN ASM_REWRITE_TAC[REAL_EXP_MONO_LE]);; let HOLOMORPHIC_CONSTANT_ON_FRONTIER = prove (`!f s c. bounded s /\ f holomorphic_on interior s /\ f continuous_on closure s /\ (!z. z IN frontier s ==> f z = c) ==> !z. z IN s ==> f z = c`, REWRITE_TAC[NORM_ARITH `x:complex = c <=> norm(x - c) <= &0`] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MAXIMUM_MODULUS_FRONTIER THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; CONTINUOUS_ON_SUB; HOLOMORPHIC_ON_CONST; CONTINUOUS_ON_CONST]);; let HOLOMORPHIC_CONSTANT_NORM = prove (`!f s. open s /\ connected s /\ f holomorphic_on s /\ (?c. !z. z IN s ==> norm(f z) = c) ==> ?a. !z. z IN s ==> f z = a`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN MATCH_MP_TAC MAXIMUM_MODULUS_PRINCIPLE THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `w:complex`] THEN ASM_SIMP_TAC[SUBSET_REFL; REAL_LE_REFL]);; let HOLOMORPHIC_NONZERO_CONSTANT_NORM_ON_FRONTIER = prove (`!f s. bounded s /\ open s /\ connected s /\ f holomorphic_on s /\ f continuous_on closure s /\ (!z. z IN s ==> ~(f z = Cx(&0))) /\ (?c. !z. z IN frontier s ==> norm(f z) = c) ==> ?a. !z. z IN s ==> f z = a`, REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [DISCH_THEN(fun th -> EXISTS_TAC `Cx(&0)` THEN MP_TAC th) THEN ASM_REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN REWRITE_TAC[NORM_ARITH `norm(x) = &0 <=> norm(x) <= &0`] THEN ASM_MESON_TAC[MAXIMUM_MODULUS_FRONTIER; INTERIOR_OPEN]; STRIP_TAC] THEN MATCH_MP_TAC HOLOMORPHIC_CONSTANT_NORM THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `c:real` THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN CONJ_TAC THENL [MATCH_MP_TAC MAXIMUM_MODULUS_FRONTIER THEN ASM_SIMP_TAC[REAL_LE_REFL; INTERIOR_OPEN]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; COMPLEX_INV_EQ_0] THEN UNDISCH_TAC `(w:complex) IN s` THEN SPEC_TAC(`w:complex`,`w:complex`) THEN MATCH_MP_TAC MAXIMUM_MODULUS_FRONTIER THEN ASM_SIMP_TAC[REAL_LE_REFL; INTERIOR_OPEN; HOLOMORPHIC_ON_INV] THEN ASM_SIMP_TAC[COMPLEX_NORM_INV; REAL_LE_REFL] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `(w:complex) IN frontier s` THENL [ASM_MESON_TAC[COMPLEX_NORM_ZERO]; ASM_MESON_TAC[frontier; IN_DIFF; INTERIOR_SUBSET; SUBSET]]);; let MAXIMUM_MODULUS_LIMIT_ATINFINITY = prove (`!f s B. &0 <= B /\ f holomorphic_on interior s /\ f continuous_on closure s /\ (!z. z IN frontier s ==> norm(f z) <= B) /\ (f --> Cx(&0)) (at_infinity within s) ==> !z. z IN s ==> norm(f z) <= B`, let lemma = prove (`(!c. b < c ==> a <= c) ==> a <= b`, DISCH_THEN(MP_TAC o SPEC `(a + b) / &2`) THEN REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN X_GEN_TAC `C:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_INFINITY_WITHIN_POS]) THEN DISCH_THEN(MP_TAC o SPEC `C:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO; real_ge] THEN DISCH_THEN(X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:complex->complex`; `s INTER ball(Cx(&0),R + &1)`; `C:real`] MAXIMUM_MODULUS_FRONTIER) THEN ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_BALL] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[IN_INTER; COMPLEX_IN_BALL_0] THEN ASM_MESON_TAC[REAL_ARITH `r <= z \/ z < r + &1`; REAL_LT_IMP_LE]] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_INTERIOR; INTER_SUBSET]; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_CLOSURE; INTER_SUBSET]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] FRONTIER_INTER_SUBSET_INTER)) THEN ASM_SIMP_TAC[IN_UNION; FRONTIER_BALL; COMPLEX_IN_SPHERE_0; IN_INTER; CLOSURE_BALL; COMPLEX_IN_CBALL_0; REAL_ARITH `&0 < r ==> &0 < r + &1`] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN ASM_SIMP_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]] THEN REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `w = r + &1 ==> ~(w <= r)`)) THEN REWRITE_TAC[GSYM COMPLEX_IN_CBALL_0; IMP_IMP] THEN REWRITE_TAC[SET_RULE `~(x IN s) /\ x IN t <=> x IN (UNIV DIFF s) INTER t`] THEN MP_TAC(ISPECL [`(:complex) DIFF cball(Cx(&0),R)`; `s:complex->bool`] OPEN_INTER_CLOSURE_SUBSET) THEN REWRITE_TAC[GSYM closed; IMP_IMP; CLOSED_CBALL; COMPLEX_IN_CBALL_0] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s SUBSET t /\ x IN s ==> x IN t`)) THEN SPEC_TAC(`w:complex`,`w:complex`) THEN MATCH_MP_TAC CONTINUOUS_LE_ON_CLOSURE THEN REWRITE_TAC[IN_INTER; COMPLEX_IN_CBALL_0; IN_UNIV; IN_DIFF; REAL_NOT_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN ASM_MESON_TAC[INTER_SUBSET; CONTINUOUS_ON_SUBSET; SUBSET_CLOSURE]);; let MAXIMUM_MODULUS_BOUNDED_FUNCTION = prove (`!f s B. f holomorphic_on interior s /\ f continuous_on closure s /\ (!z. z IN frontier s ==> norm(f z) <= B) /\ ~(s = (:complex)) /\ bounded(IMAGE f s) ==> !z. z IN s ==> norm(f z) <= B`, let lemma = prove (`(!c. b < c ==> a <= c) ==> a <= b`, DISCH_THEN(MP_TAC o SPEC `(a + b) / &2`) THEN REAL_ARITH_TAC) in REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `B < &0` THENL [SUBGOAL_THEN `~(frontier(s:complex->bool) = {})` MP_TAC THENL [ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY]; ALL_TAC] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; NORM_ARITH `B < &0 ==> ~(norm z <= B)`]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(z:complex) IN interior s` THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN MP_TAC(ISPEC `s:complex->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN MATCH_MP_TAC lemma THEN X_GEN_TAC `D:real` THEN DISCH_TAC THEN MP_TAC(SPECL [`B:real`; `D:real`] REAL_LT_BETWEEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?p:complex r. &0 < r /\ p IN s /\ cball(p,r) SUBSET s /\ ~(z IN cball(p,r)) /\ !w. w IN cball(p,r) ==> norm(f w:complex) <= C` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = UNIV) ==> interior s SUBSET s ==> ?a. ~(a IN interior s)`)) THEN REWRITE_TAC[INTERIOR_SUBSET] THEN DISCH_THEN(X_CHOOSE_TAC `q:complex`) THEN MP_TAC(ISPECL [`s:complex->bool`; `z:complex`; `q:complex`] SEGMENT_TO_FRONTIER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:complex` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `c:complex`) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `C - B:real`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?p:complex. p IN segment(z,c) /\ dist(p,c) < d / &2` MP_TAC THENL [EXISTS_TAC `c + min (&1 / &2) (d / &4 / dist(z,c)) % (z - c):complex` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `min (&1 / &2) (d / &4 / dist(z:complex,c))` THEN REWRITE_TAC[VECTOR_ARITH `c + a % (z - c) = (&1 - a) % c + a % z`] THEN REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[NORM_ARITH `dist(c + z:complex,c) = norm z`] THEN REWRITE_TAC[NORM_MUL] THEN ASM_SIMP_TAC[GSYM dist; GSYM REAL_LT_RDIV_EQ; GSYM DIST_NZ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 < b /\ c / &2 = b ==> abs(min a b) < c`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC]] THEN REPEAT(MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[GSYM DIST_NZ]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `(p:complex) IN interior s` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTERIOR_CBALL]] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min r (min (d / &2) (dist(p:complex,z) / &2))` THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ; REAL_HALF] THEN ASM_MESON_TAC[ENDS_NOT_IN_SEGMENT]; ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; TRANS_TAC SUBSET_TRANS `cball(p:complex,r)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_CBALL THEN REAL_ARITH_TAC; REWRITE_TAC[IN_CBALL; REAL_LE_MIN; NORM_ARITH `dist(a,b) <= dist(a,b) / &2 <=> a = b`] THEN ASM_MESON_TAC[ENDS_NOT_IN_SEGMENT]; X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_CBALL; REAL_LE_MIN] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN_CBALL; CLOSURE_SUBSET]; MAP_EVERY UNDISCH_TAC [`dist(p:complex,w) <= d / &2`; `dist(p:complex,c) < d / &2`] THEN CONV_TAC NORM_ARITH]; FIRST_X_ASSUM(MP_TAC o SPEC `c:complex`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH]]]; ALL_TAC] THEN SUBGOAL_THEN `&0 < C /\ &0 < D` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(z:complex = p)` ASSUME_TAC THENL [ASM_MESON_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `((\n. root n (norm(z - p) / r)) ---> &1) sequentially` MP_TAC THENL [REWRITE_TAC[root] THEN ASM_SIMP_TAC[real_sgn; real_abs; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; REAL_LT_IMP_LE; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_EXP_0] THEN MATCH_MP_TAC(SPEC `exp` REALLIM_REAL_CONTINUOUS_FUNCTION) THEN REWRITE_TAC[REAL_CONTINUOUS_AT_EXP; real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_N]; ALL_TAC] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `(D - C:real) / C`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n + 1`)) THEN REWRITE_TAC[LE_ADD] THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPECL [`\w. Cx(r) / (w - p) * (f w) pow (n + 1)`; `s DIFF cball(p:complex,r)`; `(C:real) pow (n + 1)`] MAXIMUM_MODULUS_LIMIT_ATINFINITY) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_SUB_0] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN ASM_SIMP_TAC[IN_DIFF; CENTRE_IN_CBALL; REAL_LT_IMP_LE]; MATCH_MP_TAC HOLOMORPHIC_ON_POW THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]]; MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_SUB_0] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] CLOSURE_INTER_SUBSET)) THEN REWRITE_TAC[CLOSURE_COMPLEMENT; INTERIOR_CBALL] THEN ASM_REWRITE_TAC[IN_INTER; IN_UNIV; IN_DIFF; CENTRE_IN_BALL]; MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_POW THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]]; X_GEN_TAC `w:complex` THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] FRONTIER_INTER_SUBSET_INTER)) THEN REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_CBALL; CLOSURE_COMPLEMENT] THEN ASM_REWRITE_TAC[IN_UNION; IN_INTER; IN_DIFF; IN_UNIV; INTERIOR_CBALL; IN_BALL] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_DIV] THEN ASM_SIMP_TAC[COMPLEX_NORM_POW; real_abs; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `a / b * c:real = (a * c) / b`] THEN ASM_CASES_TAC `w:complex = p` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; IN_SPHERE; DIST_REFL; REAL_LT_IMP_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[IN_BALL; dist; REAL_NOT_LT] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LE_REFL; REAL_LT_IMP_LE] THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_CBALL; dist; REAL_LE_REFL]; TRANS_TAC REAL_LE_TRANS `B:real` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]; MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN REWRITE_TAC[FORALL_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `E:real` THEN STRIP_TAC THEN EXISTS_TAC `(E:real) pow (n + 1)` THEN CONJ_TAC THENL [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN MP_TAC(ISPEC `--p:complex` LIM_INV_Z_OFFSET) THEN REWRITE_TAC[LIM_AT_INFINITY_WITHIN; LIM_AT_INFINITY; GSYM complex_sub; IN_DIFF] THEN MESON_TAC[]; REWRITE_TAC[EVENTUALLY_AT_INFINITY_WITHIN] THEN EXISTS_TAC `&0` THEN REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE]]]; DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_ARITH `a * inv b * c:real = c / b * a`] THEN DISCH_TAC] THEN MATCH_MP_TAC REAL_POW_LE2_REV THEN EXISTS_TAC `n + 1` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; ADD_EQ_0; ARITH_EQ] THEN REWRITE_TAC[GSYM COMPLEX_NORM_POW] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN SUBGOAL_THEN `D:real = D / C * C` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_IMP_LE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_FIELD `abs(x - &1) < (D - C) / C ==> &0 < C ==> x <= D / C`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n + 1` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_POW_LE2)) THEN ASM_SIMP_TAC[ROOT_POS_LE; REAL_LT_IMP_LE; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; REAL_POW_ROOT; ADD_EQ_0; ARITH_EQ]);; let HOLOMORPHIC_CONSTANT_ON_SPHERE_SEGMENT = prove (`!f a r s c. f holomorphic_on ball(a,r) /\ f continuous_on cball(a,r) /\ open_in (subtopology euclidean (sphere(a,r))) s /\ ~(s = {}) /\ (!z. z IN s ==> f z = c) ==> !z. z IN cball(a,r) ==> f z = c`, SUBGOAL_THEN `!f t. f holomorphic_on ball(Cx(&0),&1) /\ f continuous_on cball(Cx(&0),&1) /\ open_in (subtopology euclidean (sphere(Cx(&0),&1))) t /\ ~(t = {}) /\ (!z. z IN t ==> f z = Cx(&0)) ==> !z. z IN cball(Cx(&0),&1) ==> f z = Cx(&0)` ASSUME_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[CBALL_EMPTY; NOT_IN_EMPTY] THEN ASM_CASES_TAC `r = &0` THENL [ASM_REWRITE_TAC[] THEN SIMP_TAC[CBALL_SING; open_in; IN_SING; SPHERE_SING] THEN SET_TAC[]; SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; STRIP_TAC]] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\z. (f:complex->complex)(a + r % z) - c`; `IMAGE (\z. inv(r) % (z - a)) s`]) THEN ASM_REWRITE_TAC[COMPLEX_SUB_0; IMAGE_EQ_EMPTY] THEN SUBGOAL_THEN `cball(a,r) = IMAGE (\z. a + z) (IMAGE (\z. r % z) (cball(Cx(&0),&1))) /\ ball(a,r) = IMAGE (\z. a + z) (IMAGE (\z. r % z) (ball(Cx(&0),&1)))` MP_TAC THENL [ASM_SIMP_TAC[GSYM CBALL_TRANSLATION; GSYM CBALL_SCALING] THEN ASM_SIMP_TAC[GSYM BALL_TRANSLATION; GSYM BALL_SCALING] THEN REWRITE_TAC[REAL_MUL_RID; COMPLEX_CMUL; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]; REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN DISCH_THEN(CONJUNCTS_THEN (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)))] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_CONST; COMPLEX_CMUL; HOLOMORPHIC_ON_LMUL; HOLOMORPHIC_ON_ID]; MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]; SUBGOAL_THEN `sphere(Cx(&0),&1) = IMAGE (\x. inv r % x) (IMAGE (\x. --a + x) (sphere(a,r)))` SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM SPHERE_TRANSLATION; GSYM SPHERE_SCALING; REAL_LT_INV_EQ; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_RING `a * (--x + x) = Cx(&0)`]; ALL_TAC] THEN SUBGOAL_THEN `(\x:complex. inv r % (x - a)) = (\x. inv r % x) o (\x. --a + x)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; FUN_EQ_THM] THEN CONV_TAC VECTOR_ARITH; REWRITE_TAC[IMAGE_o]] THEN W(MP_TAC o PART_MATCH (lhand o rand) OPEN_IN_INJECTIVE_LINEAR_IMAGE o snd) THEN ASM_REWRITE_TAC[LINEAR_SCALING; VECTOR_MUL_LCANCEL; REAL_INV_EQ_0] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[OPEN_IN_TRANSLATION_EQ]]] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `?a d. &0 < d /\ !x. abs(x - a) <= d ==> f(cexp(ii * Cx x)) = Cx(&0)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?a. cexp(ii * Cx a) IN t` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[SUBSET; COMPLEX_IN_SPHERE_0] THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `w:complex` ARG) THEN ASM_REWRITE_TAC[COMPLEX_MUL_LID] THEN ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real` THEN DISCH_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean UNIV) {x | x IN UNIV /\ cexp(ii * Cx(drop x)) IN t}` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `sphere(Cx(&0),&1)` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0] THEN REWRITE_TAC[NORM_CEXP; RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]; REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; IN_UNIV]] THEN REWRITE_TAC[OPEN_CONTAINS_CBALL; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `lift a`) THEN ASM_REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN REWRITE_TAC[SUBSET; FORALL_LIFT; IN_CBALL; IN_ELIM_THM; LIFT_DROP] THEN REWRITE_TAC[DIST_LIFT] THEN ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN MP_TAC(ISPEC `(&2 * pi) / d` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MP_TAC(ISPECL [`\z. cproduct (0..N) (\i. f(cexp(ii * Cx(&i * d)) * z))`; `ball(Cx(&0),&1)`; `Cx(&0)`] HOLOMORPHIC_CONSTANT_ON_FRONTIER) THEN SIMP_TAC[REAL_LT_01; FRONTIER_BALL; CLOSURE_BALL; BOUNDED_BALL] THEN SIMP_TAC[INTERIOR_OPEN; OPEN_BALL] THEN SUBGOAL_THEN `!i. (\z. f(cexp(ii * Cx(&i * d)) * z)) holomorphic_on ball(Cx(&0),&1)` ASSUME_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_LMUL; HOLOMORPHIC_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0] THEN REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; RE_MUL_II] THEN REWRITE_TAC[IM_CX; REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[HOLOMORPHIC_ON_CPRODUCT; FINITE_NUMSEG] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CPRODUCT THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_CBALL_0] THEN REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; RE_MUL_II] THEN REWRITE_TAC[IM_CX; REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_SPHERE_0] THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_TAC THEN SIMP_TAC[CPRODUCT_EQ_0; FINITE_NUMSEG] THEN MP_TAC(ISPEC `Arg(cexp(ii * Cx a) / z) / d` FLOOR_POS) THEN ASM_SIMP_TAC[ARG; REAL_LE_DIV; REAL_LT_IMP_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG; GSYM REAL_OF_NUM_LE; REAL_POS] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THENL [SIMP_TAC[REAL_FLOOR_LE; INTEGER_CLOSED] THEN FIRST_X_ASSUM (MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= n ==> b < a ==> b - &1 < n`)) THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ] THEN REWRITE_TAC[ARG]; ALL_TAC] THEN MP_TAC(ISPEC `Arg(cexp(ii * Cx a) / z) / d` FLOOR_FRAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH `z:real = a + b ==> a = z - b`)) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < d ==> (x / d - y) * d = x - y * d`] THEN REWRITE_TAC[CX_SUB; CX_MUL; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN MP_TAC(last(CONJUNCTS(ISPEC `cexp(ii * Cx a) / z` (GSYM ARG)))) THEN ASM_REWRITE_TAC[COMPLEX_NORM_DIV; REAL_DIV_1; NORM_CEXP] THEN REWRITE_TAC[RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0; COMPLEX_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> a / z / w * z = a / w`] THEN REWRITE_TAC[GSYM CEXP_SUB; GSYM COMPLEX_SUB_LDISTRIB] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_ARITH `abs(a - x - a) <= d <=> abs(x) <= &1 * d`] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ARITH `&0 < d ==> abs d = d`] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN ASM_REAL_ARITH_TAC; DISCH_TAC THEN FIRST_ASSUM(fun th -> MP_TAC(PART_MATCH (funpow 5 rand o lhand) HOLOMORPHIC_FUNCTION_ENTIRE_PRODUCT (concl th))) THEN ASM_REWRITE_TAC[FINITE_NUMSEG; OPEN_BALL; CONNECTED_BALL] THEN REWRITE_TAC[NUMSEG_EMPTY; CONJUNCT1 LT] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN SIMP_TAC[GSYM IN_SING; GSYM CLOSURE_BALL; REAL_LT_01] THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN ASM_SIMP_TAC[IN_SING; CLOSURE_BALL; CLOSED_SING; REAL_LT_01] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `cexp(--(ii * Cx(&k * d))) * z`) THEN ASM_SIMP_TAC[COMPLEX_IN_BALL_0; COMPLEX_NORM_MUL; NORM_CEXP; RE_NEG] THEN ASM_SIMP_TAC[RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CEXP_ADD; COMPLEX_ADD_RINV] THEN REWRITE_TAC[CEXP_0; COMPLEX_MUL_LID]]);; (* ------------------------------------------------------------------------- *) (* A proper holomorphic function maps frontier onto frontier. *) (* ------------------------------------------------------------------------- *) let FRONTIER_PROPER_HOLOMORPHIC_IMAGE = prove (`!f s. open s /\ connected s /\ bounded s /\ f holomorphic_on s /\ f continuous_on closure s /\ (!k. compact k /\ k SUBSET IMAGE f s ==> compact {x | x IN s /\ f x IN k}) ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[FRONTIER_EMPTY; IMAGE_CLAUSES] THEN ASM_CASES_TAC `?c. !z. z IN s ==> (f:complex->complex) z = c` THENL [FIRST_X_ASSUM(X_CHOOSE_TAC `c:complex`) THEN SUBGOAL_THEN `!x. x IN closure s ==> (f:complex->complex) x IN {c}` ASSUME_TAC THENL [MATCH_MP_TAC FORALL_IN_CLOSURE THEN ASM_REWRITE_TAC[IN_SING; CLOSED_SING]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (f:complex->complex) s = {c}` SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FRONTIER_SING]] THEN SUBGOAL_THEN `~(frontier s:complex->bool = {})` MP_TAC THENL [ALL_TAC; REWRITE_TAC[frontier] THEN ASM SET_TAC[]] THEN ASM_MESON_TAC[FRONTIER_EQ_EMPTY; NOT_BOUNDED_UNIV]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC FRONTIER_PROPER_OPEN_MAP_IMAGE THEN EXISTS_TAC `IMAGE (f:complex->complex) s` THEN ASM_SIMP_TAC[SUBSET_REFL] THEN MP_TAC(ISPECL [`s:complex->bool`; `f:complex->complex`] OPEN_MAPPING_THM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `s:complex->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; (* ------------------------------------------------------------------------- *) (* Various forms of Hadamard's three-line theorem. *) (* ------------------------------------------------------------------------- *) let HADAMARD_THREE_LINE_EXPLICIT_RE = prove (`!f:complex->complex a b u v ma mb. a <= b /\ f holomorphic_on {z | a < Re z /\ Re z < b} /\ f continuous_on {z | a <= Re z /\ Re z <= b} /\ bounded (IMAGE f {z | a < Re z /\ Re z < b}) /\ (!z. Re z = a ==> norm(f z) <= ma) /\ (!z. Re z = b ==> norm(f z) <= mb) /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> !z. Re z = u * a + v * b ==> norm(f z) <= ma rpow u * mb rpow v`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= ma /\ &0 <= mb` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[NORM_ARITH `norm z <= a ==> &0 <= a`; RE_MUL_II; RE_CX]; ALL_TAC] THEN ASM_CASES_TAC `b:real = a` THENL [ASM_SIMP_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `(min ma mb) rpow (u + v)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[RPOW_POW; REAL_POW_1] THEN ASM_MESON_TAC[REAL_ARITH `x <= a /\ x <= b ==> x <= min a b`]; ASM_SIMP_TAC[RPOW_ADD_ALT; REAL_LE_MIN; REAL_OF_NUM_EQ; ARITH_EQ] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[RPOW_POS_LE; REAL_LE_MIN; RPOW_LE2; REAL_MIN_LE; REAL_LE_REFL]]; SUBGOAL_THEN `a < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN SUBGOAL_THEN `open {z | a < Re z /\ Re z < b} /\ convex {z | a < Re z /\ Re z < b} /\ closure {z | a < Re z /\ Re z < b} = {z | a <= Re z /\ Re z <= b}` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSURE_INTER_CONVEX_OPEN; RE_DEF; CONVEX_HALFSPACE_COMPONENT_LT; REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT; OPEN_INTER; OPEN_HALFSPACE_COMPONENT_LT; CLOSURE_HALFSPACE_COMPONENT_LT; REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; real_ge; REWRITE_RULE[real_gt] CLOSURE_HALFSPACE_COMPONENT_GT; CONVEX_INTER] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(SET_RULE `s INTER t = {} ==> (?x. x IN s /\ x IN t) ==> P`)) THEN EXISTS_TAC `Cx((a + b) / &2)` THEN REWRITE_TAC[IN_ELIM_THM; GSYM RE_DEF; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `frontier {z | a < Re z /\ Re z < b} = {z | Re z = a} UNION {z | Re z = b}` ASSUME_TAC THENL [ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_DIFF; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `ma * mb = &0` THENL [MP_TAC(ISPECL [`\z. (f:complex->complex)(Cx(a + b) - z)`; `f:complex->complex`; `{z | a < Re z /\ Re z < b}`] HOLOMORPHIC_FUNCTION_ENTIRE) THEN ASM_SIMP_TAC[CONVEX_CONNECTED] THEN ANTS_TAC THENL [CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; RE_SUB; RE_CX] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM COMPLEX_VEC_0; NORM_ARITH `x = vec 0 <=> norm(x) <= &0`]] THEN MATCH_MP_TAC MAXIMUM_MODULUS_BOUNDED_FUNCTION THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; RE_SUB; RE_CX] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; RE_SUB; RE_CX] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[FORALL_IN_UNION; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ENTIRE]) THEN REWRITE_TAC[NORM_ARITH `norm z <= &0 <=> z = vec 0`] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ENTIRE] THENL [GEN_REWRITE_TAC LAND_CONV [DISJ_SYM]; ALL_TAC] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[NORM_ARITH `z = vec 0 <=> norm z <= &0`] THEN (DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL [DISJ1_TAC; ASM_MESON_TAC[]]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[RE_SUB; RE_CX] THEN REAL_ARITH_TAC; REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `Cx b`) THEN REWRITE_TAC[RE_CX; REAL_LT_REFL]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `B * B:real` THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[RE_SUB; RE_CX] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) ==> p \/ q ==> r`) THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(fun th -> X_GEN_TAC `z:complex` THEN MP_TAC(SPEC `Cx(a + b) - z` th)) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[COMPLEX_SUB_SUB2] THEN REWRITE_TAC[RE_SUB; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM IN_SING] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] FORALL_IN_CLOSURE))) THEN ASM_REWRITE_TAC[CLOSED_SING; IN_SING; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN ASM_SIMP_TAC[RPOW_POS_LE; COMPLEX_NORM_0; REAL_LE_MUL] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(REAL_ARITH `(u + v) * a = a /\ (u + v) * b = b /\ u * a <= u * b /\ v * a <= v * b ==> a <= u * a + v * b /\ u * a + v * b <= b`) THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [REAL_ENTIRE]) THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < ma /\ &0 < mb` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN MP_TAC(ISPECL [`\z. f(z) * Cx(ma / mb) cpow ((z - Cx a) / (Cx b - Cx a))`; `{z | a < Re z /\ Re z < b}`; `ma:real`] MAXIMUM_MODULUS_BOUNDED_FUNCTION) THEN ASM_SIMP_TAC[NORM_CPOW; RE_CX; REAL_CX; COMPLEX_NORM_MUL; REAL_LT_DIV] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[INTERIOR_OPEN] THEN MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_CPOW_RIGHT THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC HOLOMORPHIC_ON_RMUL THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID]; MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_CPOW_RIGHT THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_RMUL THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; REWRITE_TAC[FORALL_IN_UNION; IN_ELIM_THM] THEN SIMP_TAC[GSYM CX_SUB; RE_DIV_CX; RE_SUB; RE_CX] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_0; REAL_LT_IMP_NE] THEN REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; RPOW_POW] THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_POW_1; GSYM real_div] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; real_abs; REAL_LT_DIV; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `x * y / z:real = (y * x) / z`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ]; REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `Cx b`) THEN REWRITE_TAC[RE_CX; REAL_LT_REFL]; REWRITE_TAC[bounded; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[NORM_CPOW; RE_CX; REAL_CX; COMPLEX_NORM_MUL; REAL_LT_DIV] THEN REWRITE_TAC[GSYM CX_SUB; RE_DIV_CX; RE_SUB; RE_CX] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; real_abs; REAL_LT_DIV; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `B * max (ma / mb) (&1)` THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; RPOW_POS_LE; REAL_LT_DIV; REAL_LT_IMP_LE] THEN DISJ_CASES_TAC(REAL_ARITH `&1 <= ma / mb \/ ma / mb <= &1`) THENL [MATCH_MP_TAC(REAL_ARITH `x <= y pow 1 ==> x <= max y z`) THEN REWRITE_TAC[GSYM RPOW_POW] THEN MATCH_MP_TAC RPOW_MONO_LE THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `x rpow z <= x pow 0 ==> x rpow z <= max y (&1)`) THEN REWRITE_TAC[GSYM RPOW_POW] THEN MATCH_MP_TAC RPOW_MONO_INV THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT; REAL_LT_DIV] THEN ASM_REAL_ARITH_TAC]]; SUBGOAL_THEN `u = &0 /\ v = &1 \/ u = &1 /\ v = &0 \/ &0 < u /\ u < &1 /\ &0 < v /\ v < &1` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; RPOW_POW] THEN ASM_REWRITE_TAC[real_pow; REAL_POW_1; REAL_ADD_LID; REAL_MUL_LID]; ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; RPOW_POW] THEN ASM_REWRITE_TAC[real_pow; REAL_POW_1; REAL_ADD_RID; REAL_MUL_RID]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:complex` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th)] THEN ASM_REWRITE_TAC[IN_ELIM_THM; RE_SUB; GSYM CX_SUB; RE_DIV_CX] THEN ANTS_TAC THENL [MATCH_MP_TAC(REAL_ARITH `(u + v) * a = a /\ (u + v) * b = b /\ u * a < u * b /\ v * a < v * b ==> a < u * a + v * b /\ u * a + v * b < b`) THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[COMPLEX_NORM_CX; real_abs; REAL_LT_IMP_LE; REAL_LT_DIV]] THEN REWRITE_TAC[RE_CX; RPOW_DIV] THEN ASM_SIMP_TAC[REAL_FIELD `a < b /\ u + v = &1 ==> ((u * a + v * b) - a) / (b - a) = v`] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; RPOW_POS_LT] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; RPOW_POS_LT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; RPOW_POS_LT] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN ASM_SIMP_TAC[GSYM RPOW_ADD; RPOW_POW; REAL_POW_1; REAL_LE_REFL]]);; let HADAMARD_THREE_LINE_EXPLICIT_IM = prove (`!f:complex->complex a b u v. a <= b /\ f holomorphic_on {z | a < Im z /\ Im z < b} /\ f continuous_on {z | a <= Im z /\ Im z <= b} /\ bounded (IMAGE f {z | a < Im z /\ Im z < b}) /\ (!z. Im z = a ==> norm(f z) <= ma) /\ (!z. Im z = b ==> norm(f z) <= mb) /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> !z. Im z = u * a + v * b ==> norm(f z) <= ma rpow u * mb rpow v`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MESON[COMPLEX_RING `ii * --ii * z = z`] `(!z. P z) <=> (!z. P(ii * z))`] THEN REWRITE_TAC[IM_MUL_II] THEN STRIP_TAC THEN MATCH_MP_TAC HADAMARD_THREE_LINE_EXPLICIT_RE THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_LMUL; HOLOMORPHIC_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)); GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC IMAGE_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IM_MUL_II]);; let HADAMARD_THREE_LINE_RE = prove (`!f:complex->complex a b. f holomorphic_on {z | a < Re z /\ Re z < b} /\ f continuous_on {z | a <= Re z /\ Re z <= b} /\ bounded (IMAGE f {z | a <= Re z /\ Re z <= b}) ==> (\y. sup {norm(f z) | Re z = y}) real_log_convex_on real_interval[a,b]`, MAP_EVERY X_GEN_TAC [`f:complex->complex`; `c:real`; `d:real`] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `d < c` THENL [ASM_MESON_TAC[REAL_LOG_CONVEX_ON_EMPTY; REAL_INTERVAL_EQ_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `!z x. c <= x /\ x <= d /\ Re z = x ==> norm(f z:complex) <= sup {norm(f w:complex) | Re w = x}` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(SPEC `{norm(f w:complex) | Re w = x}` BOUNDED_HAS_SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN ASM_MESON_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `norm(f(Cx x):complex)` THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `Cx x` THEN ASM_REWRITE_TAC[RE_CX]]; ALL_TAC] THEN SUBGOAL_THEN `!x. c <= x /\ x <= d ==> &0 <= sup {norm(f w:complex) | Re w = x}` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `?z. Re z = x` STRIP_ASSUME_TAC THENL [EXISTS_TAC `Cx x` THEN REWRITE_TAC[RE_CX]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `norm((f:complex->complex) z)` THEN ASM_SIMP_TAC[NORM_POS_LE]; ALL_TAC] THEN ASM_CASES_TAC `d:real = c` THEN ASM_SIMP_TAC[REAL_INTERVAL_SING; REAL_LOG_CONVEX_ON_SING; REAL_LE_REFL] THEN SUBGOAL_THEN `c < d` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[real_log_convex_on] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REPEAT CONJ_TAC THENL [SIMP_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN REWRITE_TAC[GSYM RPOW_POW] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC RPOW_ADD_ALT THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM; REAL_MUL_SYM] THEN MESON_TAC[]; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(REAL_ARITH `(u + v) * a = a /\ (u + v) * b = b /\ c <= a /\ b <= d /\ u * a <= u * b /\ v * a <= v * b ==> c <= u * a + v * b /\ u * a + v * b <= d`) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_SIMP_TAC[REAL_MUL_LID; REAL_LE_LMUL; REAL_LT_IMP_LE]; MATCH_MP_TAC REAL_SUP_LE THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM MEMBER_NOT_EMPTY] THEN CONJ_TAC THENL [EXISTS_TAC `norm(f(Cx(u * a + v * b)):complex)` THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[RE_CX]; MATCH_MP_TAC HADAMARD_THREE_LINE_EXPLICIT_RE THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC IMAGE_SUBSET] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]]);; let HADAMARD_THREE_LINE_IM = prove (`!f:complex->complex a b. f holomorphic_on {z | a < Im z /\ Im z < b} /\ f continuous_on {z | a <= Im z /\ Im z <= b} /\ bounded (IMAGE f {z | a <= Im z /\ Im z <= b}) ==> (\y. sup {norm(f z) | Im z = y}) real_log_convex_on real_interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:complex->complex) o (\z. ii * z)`; `a:real`; `b:real`] HADAMARD_THREE_LINE_RE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_LMUL; HOLOMORPHIC_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)); MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC IMAGE_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IM_MUL_II]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!z. Q(ii * z) <=> P z) /\ (!z. ii * --ii * z = z) ==> {f(ii * z) | P z} = {f z | Q z}`) THEN REWRITE_TAC[IM_MUL_II] THEN CONV_TAC COMPLEX_RING]);; (* ------------------------------------------------------------------------- *) (* Likewise the three-circle theorem. *) (* ------------------------------------------------------------------------- *) let HADAMARD_THREE_CIRCLE_EXPLICIT = prove (`!f a b u v ma mb. &0 < a /\ a <= b /\ f holomorphic_on {z | a < norm z /\ norm z < b} /\ f continuous_on {z | a <= norm z /\ norm z <= b} /\ (!z. norm z = a ==> norm (f z) <= ma) /\ (!z. norm z = b ==> norm (f z) <= mb) /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> !z. norm z = a rpow u * b rpow v ==> norm(f z) <= ma rpow u * mb rpow v`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`(f:complex->complex) o cexp`; `log a`; `log b`; `u:real`; `v:real`; `ma:real`; `mb:real`] HADAMARD_THREE_LINE_EXPLICIT_RE) THEN ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [ASM_SIMP_TAC[LOG_MONO_LE_IMP; IMAGE_o] THEN SUBGOAL_THEN `IMAGE cexp {z | log a < Re z /\ Re z < log b} = {z | a < norm z /\ norm z < b} /\ IMAGE cexp {z | log a <= Re z /\ Re z <= log b} = {z | a <= norm z /\ norm z <= b}` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; NORM_CEXP] THEN (CONJ_TAC THEN X_GEN_TAC `z:complex` THENL [ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[CEXP_CLOG]]; GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_EXP_MONO_LT; GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG]]); ASM_REWRITE_TAC[]] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_CEXP]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CEXP]; FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_CONTINUOUS_IMAGE)) THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b <=> x <= b /\ ~(x < a)`] THEN REWRITE_TAC[NORM_ARITH `norm z = dist(vec 0,z)`] THEN REWRITE_TAC[GSYM IN_BALL; GSYM IN_CBALL; GSYM DIFF] THEN SIMP_TAC[COMPACT_DIFF; COMPACT_CBALL; OPEN_BALL]; DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_CEXP; EXP_LOG]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_CEXP; EXP_LOG]]; DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `z = Cx(&0)` THENL [MATCH_MP_TAC(MESON[] `~(b = a) ==> a = b ==> p`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_ENTIRE; RPOW_EQ_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `clog z`)] THEN ASM_SIMP_TAC[CEXP_CLOG; RE_CLOG] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[LOG_MUL; RPOW_POS_LT; LOG_RPOW]]);; let HADAMARD_THREE_CIRCLE = prove (`!f a b. &0 < a /\ a <= b /\ f holomorphic_on {z | exp a < norm z /\ norm z < exp b} /\ f continuous_on {z | exp a <= norm z /\ norm z <= exp b} ==> (\y. sup {norm (f z) | norm z = exp y}) real_log_convex_on real_interval [a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_log_convex_on] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!x y. P x y <=> Q y x) ==> ((!x y. P x y) <=> (!x y. Q x y))`) THEN REWRITE_TAC[REAL_ADD_SYM; REAL_MUL_SYM] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `d:real`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `!z x. c <= x /\ x <= d /\ norm(z:complex) = exp x ==> norm(f z:complex) <= sup {norm(f w:complex) | norm w = exp x}` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(SPEC `{norm((f:complex->complex) w) | norm w = exp x}` BOUNDED_HAS_SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `IMAGE lift {norm(f x) | P x} = IMAGE (\x. lift(norm(f x))) {x | P x}`] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_EXP_MONO_LE] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM IN_SPHERE_0; COMPACT_SPHERE; SET_RULE `{x | x IN s} = s`]]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`norm(f(Cx(exp x)):complex)`; `Cx(exp x)`] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_EXP]]; ALL_TAC] THEN SUBGOAL_THEN `!x. c <= x /\ x <= d ==> &0 <= sup {norm((f:complex->complex) w) | norm w = exp x}` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `?z:complex. norm z = exp x` STRIP_ASSUME_TAC THENL [EXISTS_TAC `Cx(exp x)` THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_EXP]; TRANS_TAC REAL_LE_TRANS `norm((f:complex->complex) z)` THEN ASM_SIMP_TAC[NORM_POS_LE]]; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(REAL_ARITH `(u + v) * c = c /\ (u + v) * d = d /\ u * c <= u * d /\ v * c <= v * d ==> c <= u * c + v * d /\ u * c + v * d <= d`) THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_MUL_LID]; ALL_TAC] THEN MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`norm(f(Cx(exp(u * c + v * d))):complex)`; `Cx(exp(u * c + v * d))`] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_EXP]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] HADAMARD_THREE_CIRCLE_EXPLICIT) THEN MAP_EVERY EXISTS_TAC [`exp c`; `exp d`] THEN ASM_REWRITE_TAC[REAL_EXP_POS_LT; REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `c <= a /\ b <= d ==> a < x /\ x < b ==> c < x /\ x < d`) THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN ASM_MESON_TAC[IN_REAL_INTERVAL]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `c <= a /\ b <= d ==> a <= x /\ x <= b ==> c <= x /\ x <= d`) THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN ASM_MESON_TAC[IN_REAL_INTERVAL]; REWRITE_TAC[rpow; REAL_EXP_POS_LT; LOG_EXP; REAL_EXP_ADD]]);; (* ------------------------------------------------------------------------- *) (* Factoring out a zero according to its order. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_FACTOR_ORDER_OF_ZERO = prove (`!f s n. open s /\ z IN s /\ f holomorphic_on s /\ 0 < n /\ ~(higher_complex_derivative n f z = Cx(&0)) /\ (!m. 0 < m /\ m < n ==> higher_complex_derivative m f z = Cx(&0)) ==> ?g r. &0 < r /\ g holomorphic_on ball(z,r) /\ (!w. w IN ball(z,r) ==> f(w) - f(z) = (w - z) pow n * g(w)) /\ (!w. w IN ball(z,r) ==> ~(g w = Cx(&0)))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!w. w IN ball(z,r) ==> ((\m. higher_complex_derivative m f z / Cx(&(FACT m)) * (w - z) pow m) sums f(w) - f(z)) (from n)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `z:complex`; `w:complex`; `r:real`] HOLOMORPHIC_POWER_SERIES) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN REWRITE_TAC[FACT; higher_complex_derivative; COMPLEX_DIV_1] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC EQ_IMP] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_RING `p = Cx(&0) ==> w - z - p = w - z`) THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[IN_NUMSEG; COMPLEX_VEC_0] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_ENTIRE; complex_div] THEN REPEAT DISJ1_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `g = \w. infsum (from 0) (\m. higher_complex_derivative (m + n) f z / Cx(&(FACT(m + n))) * (w - z) pow m)` THEN SUBGOAL_THEN `!w. w IN ball(z,r) ==> ((\m. higher_complex_derivative (m + n) f z / Cx(&(FACT(m + n))) * (w - z) pow m) sums g(w)) (from 0)` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[SUMS_INFSUM] THEN ASM_CASES_TAC `w:complex = z` THENL [MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `1` THEN MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\n:num. Cx(&0)` THEN REWRITE_TAC[SUMMABLE_0; GSYM COMPLEX_VEC_0] THEN ASM_SIMP_TAC[IN_FROM; COMPLEX_VEC_0; COMPLEX_SUB_REFL; COMPLEX_POW_ZERO; LE_1; COMPLEX_MUL_RZERO]; SUBGOAL_THEN `!x:complex m. x * (w - z) pow m = (x * (w - z) pow (m + n)) / (w - z) pow n` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN SIMP_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC; COMPLEX_POW_ADD] THEN ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_POW_EQ_0; COMPLEX_SUB_0] THEN REWRITE_TAC[COMPLEX_MUL_RID]; MATCH_MP_TAC SUMMABLE_COMPLEX_DIV THEN MP_TAC(GEN `a:num->complex` (ISPECL [`n:num`; `a:num->complex`] SUMMABLE_REINDEX)) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[summable; ADD_CLAUSES] THEN ASM_MESON_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `g holomorphic_on ball(z,r)` ASSUME_TAC THENL [MATCH_MP_TAC POWER_SERIES_HOLOMORPHIC THEN EXISTS_TAC `\m. higher_complex_derivative (m + n) f z / Cx(&(FACT (m + n)))` THEN EXISTS_TAC `from 0` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!w. w IN ball(z,r) ==> f w - f z = (w - z) pow n * g(w)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `\m. higher_complex_derivative m f z / Cx(&(FACT m)) * (w - z) pow m` THEN EXISTS_TAC `from n` THEN ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ARITH_RULE `n = 0 + n`] THEN REWRITE_TAC[GSYM SUMS_REINDEX] THEN REWRITE_TAC[COMPLEX_POW_ADD] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = c * a * b`] THEN MATCH_MP_TAC SERIES_COMPLEX_LMUL THEN ASM_SIMP_TAC[]; ALL_TAC] THEN EXISTS_TAC `g:complex->complex` THEN SUBGOAL_THEN `(g:complex->complex) continuous_on ball(z,r)` MP_TAC THENL [ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; ALL_TAC] THEN REWRITE_TAC[continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `norm((g:complex->complex) z)`) THEN ANTS_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0)` o MATCH_MP(REWRITE_RULE[IMP_CONJ] SERIES_UNIQUE)) THEN REWRITE_TAC[complex_pow; ADD_CLAUSES; COMPLEX_MUL_RID] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC SUMS_0 THEN SIMP_TAC[IN_FROM; LE_1; COMPLEX_SUB_REFL; COMPLEX_POW_ZERO] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]; SIMP_TAC[COMPLEX_SUB_0; NORM_POS_LT] THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_ENTIRE] THEN REWRITE_TAC[COMPLEX_INV_EQ_0; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d r:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN SUBGOAL_THEN `ball(z,min d r) SUBSET ball(z:complex,r)` ASSUME_TAC THENL [SIMP_TAC[SUBSET_BALL; REAL_ARITH `min d r <= r`]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN REWRITE_TAC[IN_BALL; REAL_LT_MIN; GSYM COMPLEX_VEC_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM_MESON_TAC[DIST_SYM; NORM_ARITH `dist(x,y) < norm y ==> ~(x = vec 0)`]);; let HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG = prove (`!f s n z. open s /\ z IN s /\ f holomorphic_on s /\ 0 < n /\ ~(higher_complex_derivative n f z = Cx(&0)) /\ (!m. 0 < m /\ m < n ==> higher_complex_derivative m f z = Cx(&0)) ==> ?g r. &0 < r /\ g holomorphic_on ball(z,r) /\ (!w. w IN ball(z,r) ==> f(w) - f(z) = ((w - z) * g w) pow n) /\ (!w. w IN ball(z,r) ==> ~(g w = Cx(&0)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`] HOLOMORPHIC_FACTOR_ORDER_OF_ZERO) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\z. complex_derivative g z / g z`; `ball(z:complex,r)`; `{}:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN REWRITE_TAC[CONVEX_BALL; FINITE_RULES; DIFF_EMPTY] THEN ANTS_TAC THENL [SIMP_TAC[GSYM HOLOMORPHIC_ON_OPEN; OPEN_BALL; INTERIOR_OPEN; complex_differentiable] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN REWRITE_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_BALL; HOLOMORPHIC_ON_DIV; ETA_AX]; SIMP_TAC[OPEN_BALL; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`\z:complex. cexp(h z) / g z`; `ball(z:complex,r)`] HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN REWRITE_TAC[OPEN_BALL; CONNECTED_BALL] THEN ANTS_TAC THENL [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `Cx(&0) = ((complex_derivative g w / g w * cexp(h w)) * g w - cexp(h w) * complex_derivative g w) / g w pow 2` SUBST1_TAC THENL [ASM_SIMP_TAC[COMPLEX_FIELD `~(z = Cx(&0)) ==> (d / z * e) * z = e * d`] THEN SIMPLE_COMPLEX_ARITH_TAC; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DIV_AT THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_CEXP]; ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable; OPEN_BALL; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]]]; DISCH_THEN(X_CHOOSE_THEN `c:complex` MP_TAC) THEN ASM_CASES_TAC `c = Cx(&0)` THENL [ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> ~(x / y = Cx(&0))`] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[COMPLEX_FIELD `~(y = Cx(&0)) /\ ~(z = Cx(&0)) ==> (x / y = z <=> y = inv(z) * x)`] THEN DISCH_TAC THEN EXISTS_TAC `\z:complex. cexp((clog(inv c) + h z) / Cx(&n))` THEN REWRITE_TAC[CEXP_NZ; GSYM CEXP_N; COMPLEX_POW_MUL] THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG; COMPLEX_INV_EQ_0] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST; CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL]]]);; let HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT = prove (`!f s z. open s /\ connected s /\ z IN s /\ f holomorphic_on s /\ f(z) = Cx(&0) /\ ~(?c. !w. w IN s ==> f w = c) ==> ?g r n. 0 < n /\ &0 < r /\ ball(z,r) SUBSET s /\ g holomorphic_on ball(z,r) /\ (!w. w IN ball(z,r) ==> f w = (w - z) pow n * g w) /\ (!w. w IN ball(z,r) ==> ~(g w = Cx(&0)))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!n. 0 < n ==> higher_complex_derivative n f z = Cx(&0)` THENL [MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `z:complex`] HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r0:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[NOT_IMP; GSYM IMP_CONJ_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`] HOLOMORPHIC_FACTOR_ORDER_OF_ZERO) THEN ASM_REWRITE_TAC[COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN DISCH_THEN(X_CHOOSE_THEN `r1:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min r0 r1:real` THEN EXISTS_TAC `n:num` THEN ASM_SIMP_TAC[BALL_MIN_INTER; IN_INTER; REAL_LT_MIN] THEN CONJ_TAC THENL [ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]]]);; let HOLOMORPHIC_LOWER_BOUND_DIFFERENCE = prove (`!f s z. open s /\ connected s /\ z IN s /\ f holomorphic_on s /\ ~(!w. w IN s ==> f w = f z) ==> ?k n r. &0 < k /\ &0 < r /\ ball(z,r) SUBSET s /\ !w. w IN ball(z,r) ==> k * norm(w - z) pow n <= norm(f w - f z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `z:complex`] HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED) THEN ASM_REWRITE_TAC[NOT_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[NOT_IMP; IMP_IMP] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`] HOLOMORPHIC_FACTOR_ORDER_OF_ZERO) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:complex->complex`; `r:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `d = min e r / &2` THEN SUBGOAL_THEN `ball(z,d) SUBSET cball(z,d) /\ cball(z:complex,d) SUBSET ball(z,r) /\ cball(z,d) SUBSET ball(z,e)` ASSUME_TAC THENL [REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`IMAGE (g:complex->complex) (cball(z,d))`; `Cx(&0)`] DISTANCE_ATTAINS_INF) THEN REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_SUB; CBALL_EQ_EMPTY] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_CLOSED; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_CBALL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; SUBSET_TRANS]; REWRITE_TAC[COMPLEX_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `p:complex` STRIP_ASSUME_TAC)] THEN MAP_EVERY EXISTS_TAC [`norm((g:complex->complex) p)`; `d:real`] THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_REAL_ARITH_TAC; ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; let POLE_AT_INFINITY = prove (`!f l. f holomorphic_on (:complex) /\ ((inv o f) --> l) at_infinity ==> ?a n. !z. f(z) = vsum(0..n) (\i. a i * z pow i)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `l = Cx(&0)` THENL [FIRST_X_ASSUM SUBST1_TAC THEN STRIP_TAC; REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_COMPLEX_INV)) THEN ASM_REWRITE_TAC[o_THM; COMPLEX_INV_INV; ETA_AX] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `inv(l:complex)`] LIOUVILLE_WEAK) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(\n. inv l):num->complex` THEN EXISTS_TAC `0` THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG; complex_pow; COMPLEX_MUL_RID]] THEN ASM_CASES_TAC `?r. &0 < r /\ !z. z IN ball(Cx(&0),r) DELETE Cx(&0) ==> ~(f(inv z) = Cx(&0))` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`inv o (f:complex->complex) o inv`; `Cx(&0)`; `ball(Cx(&0),r)`] HOLOMORPHIC_ON_EXTEND_BOUNDED) THEN ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL [REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN REWRITE_TAC[HOLOMORPHIC_ON_ID] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_INFINITY_COMPLEX_0]) THEN REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[o_THM; dist; COMPLEX_SUB_RZERO] THEN CONV_TAC NORM_ARITH; REWRITE_TAC[o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `(g:complex->complex)(Cx(&0)) = Cx(&0)` ASSUME_TAC THENL [MATCH_MP_TAC(ISPEC `at(Cx(&0))` LIM_UNIQUE) THEN EXISTS_TAC `g:complex->complex` THEN REWRITE_TAC[TRIVIAL_LIMIT_AT] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CONTINUOUS_AT] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL; CENTRE_IN_BALL; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `inv o (f:complex->complex) o inv` THEN EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_ASSOC; o_THM; GSYM LIM_AT_INFINITY_COMPLEX_0] THEN ASM SET_TAC[]]; ALL_TAC] THEN EXISTS_TAC`\k. higher_complex_derivative k f (Cx(&0)) / Cx(&(FACT k))` THEN MP_TAC(ISPECL [`g:complex->complex`; `ball(Cx(&0),r)`; `Cx(&0)`] HOLOMORPHIC_LOWER_BOUND_DIFFERENCE) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL [SUBGOAL_THEN `~(ball(Cx(&0),r) DELETE Cx(&0) = {})` MP_TAC THENL [ALL_TAC; ASM SET_TAC[COMPLEX_INV_EQ_0]] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; COMPLEX_IN_BALL_0; IN_DELETE] THEN EXISTS_TAC `Cx(r / &2)` THEN REWRITE_TAC[COMPLEX_NORM_CX; CX_INJ] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[COMPLEX_SUB_RZERO]] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC LIOUVILLE_POLYNOMIAL THEN FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN MAP_EVERY EXISTS_TAC [`&2 / e`; `inv(B:real)`] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `inv(z) IN ball(Cx(&0),e) DELETE Cx(&0)` ASSUME_TAC THENL [REWRITE_TAC[IN_DELETE; COMPLEX_INV_EQ_0; COMPLEX_IN_BALL_0] THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_LINV THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&2 / e <= z ==> &0 < inv e ==> inv e < z`)) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ]; UNDISCH_TAC `&2 / e <= norm(z:complex)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_NORM_0; REAL_NOT_LE] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]; ALL_TAC] THEN SUBGOAL_THEN `inv(z) IN ball(Cx(&0),r) DELETE Cx(&0)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(f:complex->complex) z = inv(g(inv z))` SUBST1_TAC THENL [ASM_SIMP_TAC[COMPLEX_INV_INV]; ALL_TAC] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) [GSYM COMPLEX_INV_INV] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_INV] THEN REWRITE_TAC[REAL_POW_INV; GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_INFINITY_COMPLEX_0]) THEN REWRITE_TAC[LIM_AT; o_THM; dist; COMPLEX_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_DELETE; COMPLEX_IN_BALL_0] THEN DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:complex->complex`; `Cx(&0)`] LIOUVILLE_WEAK) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`\n:num. Cx(&0)`; `0`] THEN ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; COMPLEX_MUL_LZERO]] THEN REWRITE_TAC[LIM_AT_INFINITY_COMPLEX_0] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `r:real` THEN ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[o_THM; COMPLEX_NORM_NZ] THEN STRIP_TAC THEN MP_TAC(ISPEC `IMAGE ((f:complex->complex) o inv) (ball(Cx(&0),r) DELETE Cx(&0))` CONNECTED_CLOSED) THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL; DIMINDEX_2; LE_REFL] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN SET_TAC[]; ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`{Cx(&0)}`; `(:complex) DIFF ball(Cx(&0),&1)`]) THEN SIMP_TAC[CLOSED_SING; CLOSED_DIFF; CLOSED_UNIV; OPEN_BALL] THEN SIMP_TAC[CENTRE_IN_BALL; REAL_LT_01; SET_RULE `a IN s ==> {a} INTER (UNIV DIFF s) INTER t = {}`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; SET_RULE `s INTER IMAGE f t = {} <=> !x. x IN t ==> ~(f x IN s)`] THEN REWRITE_TAC[IN_SING; IN_DIFF; IN_UNIV; IN_UNION] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0; GSYM COMPLEX_NORM_NZ] THEN X_GEN_TAC `x:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:complex`) THEN MATCH_MP_TAC(TAUT `(~q /\ ~r ==> ~p) ==> p ==> q \/ r`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_INV; REAL_NOT_LT] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPLEX_NORM_NZ]; REWRITE_TAC[COMPLEX_IN_BALL_0; IN_DELETE] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[COMPLEX_IN_BALL_0; IN_DELETE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ; REAL_NOT_LT; COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPLEX_NORM_NZ]]]);; (* ------------------------------------------------------------------------- *) (* Entire proper functions C->C are precisely the non-trivial polynomials. *) (* ------------------------------------------------------------------------- *) let PROPER_MAP_COMPLEX_POLYFUN = prove (`!s k c n. closed s /\ compact k /\ (?i. i IN 1..n /\ ~(c i = Cx(&0))) ==> compact {z | z IN s /\ vsum(0..n) (\i. c i * z pow i) IN k}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`c:num->complex`; `n:num`] COMPLEX_POLYFUN_EXTREMAL) THEN DISCH_THEN DISJ_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `B + &1`) THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY_POS; real_ge; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:complex` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN FIRST_X_ASSUM(MP_TAC o SPEC `vsum(0..n) (\i. c i * z pow i)` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_POW THEN REWRITE_TAC[CONTINUOUS_AT_ID]]);; let PROPER_MAP_COMPLEX_POLYFUN_UNIV = prove (`!k c n. compact k /\ (?i. i IN 1..n /\ ~(c i = Cx(&0))) ==> compact {z | vsum(0..n) (\i. c i * z pow i) IN k}`, MP_TAC(SPEC `(:complex)` PROPER_MAP_COMPLEX_POLYFUN) THEN REWRITE_TAC[IN_UNIV; CLOSED_UNIV]);; let PROPER_MAP_COMPLEX_POLYFUN_EQ = prove (`!f. f holomorphic_on (:complex) ==> ((!k. compact k ==> compact {z | f z IN k}) <=> ?c n. 0 < n /\ ~(c n = Cx(&0)) /\ f = \z. vsum(0..n) (\i. c i * z pow i))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PROPER_MAP_COMPLEX_POLYFUN_UNIV THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_REFL; LE_1]] THEN MP_TAC(ISPECL [`f:complex->complex`; `Cx(&0)`] POLE_AT_INFINITY) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[LIM_AT_INFINITY; real_ge] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; DIST_0; o_THM] THEN FIRST_X_ASSUM(MP_TAC o SPEC `cball(vec 0:complex,inv e)`) THEN REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; IN_ELIM_THM; IN_CBALL_0] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `B + &1` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_01] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_SIMP_TAC[REAL_ARITH `B + &1 <= x ==> ~(x <= B)`; REAL_NOT_LE] THEN ASM_SIMP_TAC[COMPLEX_NORM_INV; REAL_LT_LINV]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->complex` THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN ASM_CASES_TAC `!i. i IN 1..n ==> a i = Cx(&0)` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `{a 0:complex}`) THEN ASM_SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES; COMPACT_SING] THEN SIMP_TAC[IN_SING; COMPLEX_MUL_LZERO; complex_pow; COMPLEX_MUL_RID] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0; VECTOR_ADD_RID; UNIV_GSPEC] THEN MESON_TAC[COMPACT_IMP_BOUNDED; NOT_BOUNDED_UNIV]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] (fst(EQ_IMP_RULE(SPEC_ALL num_MAX))))) THEN REWRITE_TAC[NOT_IMP; IN_NUMSEG] THEN ANTS_TAC THENL [MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LE_1; FUN_EQ_THM] THEN GEN_TAC THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN ASM_REWRITE_TAC[SUBSET_NUMSEG; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN X_GEN_TAC `j:num` THEN REWRITE_TAC[COMPLEX_VEC_0; NOT_LE] THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_ENTIRE] THEN DISJ1_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Power and squaring functions as covering maps. *) (* ------------------------------------------------------------------------- *) let COVERING_SPACE_POW_PUNCTURED_PLANE = prove (`!n. 0 < n ==> covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow n)) ((:complex) DIFF {Cx (&0)})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP THEN REWRITE_TAC[IN_DIFF; IN_SING] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_POW THEN REWRITE_TAC[CONTINUOUS_ON_ID]; REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV; IN_SING] THEN ASM_MESON_TAC[COMPLEX_POW_EQ_0; EXISTS_COMPLEX_ROOT; LE_1]; X_GEN_TAC `k:complex->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`(:complex)`; `k:complex->bool`; `\i:num. if i = n then Cx(&1) else Cx(&0)`; `n:num`] PROPER_MAP_COMPLEX_POLYFUN) THEN ASM_REWRITE_TAC[CLOSED_UNIV] THEN ANTS_TAC THENL [EXISTS_TAC `n:num` THEN ASM_SIMP_TAC[IN_NUMSEG; LE_1; LE_REFL] THEN CONV_TAC COMPLEX_RING; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[COND_RAND; COND_RATOR; COMPLEX_MUL_LZERO] THEN SIMP_TAC[GSYM COMPLEX_VEC_0; VSUM_DELTA; IN_NUMSEG; LE_0; LE_REFL] THEN REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_VEC_0] THEN X_GEN_TAC `z:complex` THEN MP_TAC(ISPECL [`z:complex`; `n:num`] COMPLEX_POW_EQ_0) THEN ASM_SIMP_TAC[LE_1] THEN ASM SET_TAC[]]; SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_UNIV; IN_SING] THEN ASM_SIMP_TAC[COMPLEX_POW_EQ_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] OPEN_MAPPING_THM) THEN EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV; OPEN_UNIV; IN_UNIV] THEN SIMP_TAC[HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_ID] THEN MATCH_MP_TAC(SET_RULE `~(f(Cx(&1)) = f(Cx(&0))) ==> ~(?c. !z. f z = c)`) THEN ASM_SIMP_TAC[COMPLEX_POW_ZERO; COMPLEX_POW_EQ_0; LE_1] THEN CONV_TAC COMPLEX_RING; X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN MP_TAC(ISPECL [`\w:complex. w`; `ball(z:complex,norm z)`] CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN ANTS_TAC THENL [SIMP_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; CONVEX_BALL; CONVEX_IMP_SIMPLY_CONNECTED] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[GSYM COMPLEX_VEC_0; IN_BALL] THEN CONV_TAC NORM_ARITH; SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `l:complex->complex` (STRIP_ASSUME_TAC o GSYM))] THEN SUBGOAL_THEN `(l:complex->complex) continuous at z` MP_TAC THENL [ASM_SIMP_TAC[CENTRE_IN_BALL; COMPLEX_NORM_NZ]; ALL_TAC] THEN REWRITE_TAC[continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `pi / &n`) THEN ASM_SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(z:complex,min r (norm z))` THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; COMPLEX_NORM_NZ; REAL_LT_MIN] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN SIMP_TAC[IN_BALL; REAL_LT_MIN; dist; COMPLEX_SUB_RZERO; REAL_LT_REFL] THEN MAP_EVERY X_GEN_TAC [`x:complex`; `y:complex`] THEN REWRITE_TAC[GSYM dist] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `x = cexp(l x) /\ y = cexp(l y)` (CONJUNCTS_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[IN_BALL]; REWRITE_TAC[GSYM CEXP_N]] THEN GEN_REWRITE_TAC LAND_CONV [CEXP_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN ASM_CASES_TAC `k = &0` THENL [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; COMPLEX_EQ_MUL_LCANCEL; CX_INJ] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; LE_1]; STRIP_TAC THEN MATCH_MP_TAC(TAUT `F ==> p`)] THEN SUBGOAL_THEN `norm(Cx(&n) * l(x:complex) - Cx(&n) * l y) < &2 * pi` MP_TAC THENL [REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL] THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM REAL_LT_RDIV_EQ); REAL_OF_NUM_LT] THEN REWRITE_TAC[REAL_ARITH `(&2 * x) / y = &2 * x / y`] THEN MATCH_MP_TAC(NORM_ARITH `!z. dist(x,z) < a /\ dist(y,z) < a ==> norm(x - y) < &2 * a`) THEN ASM_MESON_TAC[DIST_SYM]; ASM_REWRITE_TAC[COMPLEX_RING `(y + z) - y:complex = z`] THEN REWRITE_TAC[REAL_NOT_LT; COMPLEX_NORM_MUL; COMPLEX_NORM_II] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_MUL_RID; REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_PI] THEN ONCE_REWRITE_TAC[REAL_ARITH `&2 * pi = &2 * &1 * pi`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ; PI_POS; REAL_ARITH `&0 < &2`] THEN ASM_SIMP_TAC[REAL_ABS_INTEGER_LEMMA]]]);; let COVERING_SPACE_SQUARE_PUNCTURED_PLANE = prove (`covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow 2)) ((:complex) DIFF {Cx (&0)})`, SIMP_TAC[COVERING_SPACE_POW_PUNCTURED_PLANE; ARITH]);; (* ------------------------------------------------------------------------- *) (* Relating invertibility and nonvanishing of derivative. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE = prove (`!f s z. f holomorphic_on s /\ open s /\ z IN s /\ ~(complex_derivative f z = Cx(&0)) ==> ?t. z IN t /\ open t /\ (!x x'. x IN t /\ x' IN t /\ f x' = f x ==> x' = x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LOCALLY_INJECTIVE THEN EXISTS_TAC `\z h. complex_derivative f z * h` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[GSYM has_complex_derivative] THEN REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM] THEN ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC LINEAR_INJECTIVE_LEFT_INVERSE THEN ASM_SIMP_TAC[LINEAR_COMPLEX_MUL; COMPLEX_EQ_MUL_LCANCEL]; ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `(complex_derivative f) continuous_on s` MP_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE]; ALL_TAC] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[dist; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d r:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB] THEN MATCH_MP_TAC (CONJUNCT2(MATCH_MP ONORM (SPEC_ALL LINEAR_COMPLEX_MUL))) THEN GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]]);; let HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE = prove (`!f s z. f holomorphic_on s /\ open s /\ z IN s /\ ~(complex_derivative f z = Cx(&0)) ==> ?t g. z IN t /\ open t /\ open(IMAGE f t) /\ t SUBSET s /\ (!w. w IN t ==> g(f w) = w) /\ (!y. y IN (IMAGE f t) ==> f(g y) = y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE) THEN DISCH_THEN(X_CHOOSE_THEN `t:complex->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN DISCH_THEN(X_CHOOSE_TAC `g:complex->complex`) THEN EXISTS_TAC `s INTER t:complex->bool` THEN EXISTS_TAC `g:complex->complex` THEN ASM_SIMP_TAC[OPEN_INTER; IN_INTER; INTER_SUBSET; FORALL_IN_IMAGE] THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; let HOLOMORPHIC_INJECTIVE_IMP_REGULAR = prove (`!f s. f holomorphic_on s /\ open s /\ (!w z. w IN s /\ z IN s /\ f w = f z ==> w = z) ==> !z. z IN s ==> ~(complex_derivative f z = Cx(&0))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `!n. 0 < n ==> higher_complex_derivative n f z = Cx(&0)` THENL [MP_TAC(ISPECL [`f:complex->complex`; `ball(z:complex,r)`; `z:complex`] HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED) THEN ASM_SIMP_TAC[OPEN_BALL; CONNECTED_BALL; CENTRE_IN_BALL; NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `z + Cx(r / &2)`) THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(z,z + r) = norm r`] THEN REWRITE_TAC[COMPLEX_NORM_CX; NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`z:complex`; `z + Cx(r / &2)`]) THEN ASM_REWRITE_TAC[COMPLEX_RING `z = z + a <=> a = Cx(&0)`] THEN REWRITE_TAC[NOT_IMP; CX_INJ] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(z,z + r) = norm r`] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM])] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[NOT_IMP; GSYM IMP_CONJ_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`; `z:complex`] HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:complex->complex`; `k:real`] THEN STRIP_TAC THEN ASM_CASES_TAC `n = 1` THENL [ASM_MESON_TAC[HIGHER_COMPLEX_DERIVATIVE_1]; ALL_TAC] THEN MP_TAC(ISPECL[`\w:complex. (w - z) * g(w)`; `ball(z:complex,min r k)`; `z:complex`] HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE) THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; NOT_IMP; REAL_LT_MIN] THEN CONJ_TAC THENL [SUBGOAL_THEN `!w. w IN ball(z,min r k) ==> ((\w. (w - z) * g w) has_complex_derivative ((w - z) * complex_derivative g w + (Cx(&1) - Cx(&0)) * g w)) (at w)` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `w IN ball(z:complex,k)` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; SUBSET_BALL; REAL_ARITH `min r k <= k`]; ALL_TAC] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_ID; HAS_COMPLEX_DERIVATIVE_SUB; HAS_COMPLEX_DERIVATIVE_CONST; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_BALL]; SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_MIN] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; COMPLEX_SUB_RZERO; COMPLEX_MUL_LID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]]; REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:complex->bool`; `h:complex->complex`] THEN ABBREV_TAC `u = IMAGE (\w:complex. (w - z) * g w) t` THEN STRIP_TAC THEN MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_CBALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN ANTS_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM; SUBSET; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `Cx(e) * cexp(Cx(&2) * Cx pi * ii * Cx(&0 / &n))` th) THEN MP_TAC(ISPEC `Cx(e) * cexp(Cx(&2) * Cx pi * ii * Cx(&1 / &n))` th)) THEN REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; RE_MUL_CX; RE_MUL_II] THEN REWRITE_TAC[IM_CX; REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_MUL_RID] THEN SIMP_TAC[REAL_ARITH `&0 < e ==> abs e <= e`; ASSUME `&0 < e`] THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `y1:complex` (STRIP_ASSUME_TAC o GSYM)) THEN DISCH_THEN(X_CHOOSE_THEN `y0:complex` (STRIP_ASSUME_TAC o GSYM)) THEN UNDISCH_THEN `!w. w IN ball (z,k) ==> f w - f z = ((w - z) * g w) pow n` (fun th -> MP_TAC(SPEC `y1:complex` th) THEN MP_TAC(SPEC `y0:complex` th)) THEN MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ ~(q1 /\ q2) ==> (p1 ==> q1) ==> (p2 ==> q2) ==> F`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; SUBSET_BALL; REAL_ARITH `min r k <= k`]; MATCH_MP_TAC(MESON[] `x' = y' /\ ~(x = y) ==> ~(x = x' /\ y = y')`)] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_LEFT_INVERSE]) THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[COMPLEX_POW_MUL] THEN ASM_SIMP_TAC[COMPLEX_ROOT_UNITY; LE_1]; REWRITE_TAC[COMPLEX_RING `x - a:complex = y - a <=> x = y`] THEN DISCH_TAC THEN UNDISCH_THEN `!w z. w IN s /\ z IN s /\ (f:complex->complex) w = f z ==> w = z` (MP_TAC o SPECL [`y0:complex`; `y1:complex`]) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; SUBSET_BALL; REAL_ARITH `min r k <= r`]; DISCH_THEN SUBST_ALL_TAC] THEN MP_TAC(ISPECL [`n:num`; `0`; `1`] COMPLEX_ROOT_UNITY_EQ) THEN ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(TAUT `a /\ ~b ==> ~(a <=> b)`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (COMPLEX_RING `z = e * y ==> z = e * x /\ ~(e = Cx(&0)) ==> x = y`)) THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ]; REWRITE_TAC[num_congruent; int_congruent] THEN DISCH_THEN(X_CHOOSE_THEN `d:int` (MP_TAC o AP_TERM `abs:int->int` o SYM)) THEN REWRITE_TAC[INT_ABS_NUM; INT_SUB_LZERO; INT_ABS_NEG] THEN ASM_REWRITE_TAC[INT_ABS_MUL_1; INT_OF_NUM_EQ; INT_ABS_NUM]]]]);; (* ------------------------------------------------------------------------- *) (* Hence a nice clean inverse function theorem. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_ON_INVERSE = prove (`!f s. f holomorphic_on s /\ open s /\ (!w z. w IN s /\ z IN s /\ f w = f z ==> w = z) ==> open(IMAGE f s) /\ ?g. g holomorphic_on (IMAGE f s) /\ (!z. z IN s ==> complex_derivative f z * complex_derivative g (f z) = Cx(&1)) /\ (!z. z IN s ==> g(f z) = z) /\ (!y. y IN (IMAGE f s) ==> f(g y) = y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN STRIP_TAC THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; FORALL_IN_IMAGE] THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `(z:complex) IN s` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:complex->complex`; `g:complex->complex`; `complex_derivative f z`; `s:complex->bool`; `z:complex`] HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; IMP_CONJ] THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; HOLOMORPHIC_ON_OPEN; complex_differentiable]; ALL_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] HOLOMORPHIC_INJECTIVE_IMP_REGULAR) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(MP_TAC o SPEC `z:complex`)] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(z = Cx(&0)) ==> (z * w = Cx(&1) <=> w = inv z)`] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_DERIVATIVE]);; (* ------------------------------------------------------------------------- *) (* Holomorphism of covering maps and lifts. *) (* ------------------------------------------------------------------------- *) let COVERING_SPACE_LIFT_IS_HOLOMORPHIC = prove (`!p c s f g u. covering_space (c,p) s /\ open c /\ p holomorphic_on c /\ f holomorphic_on u /\ IMAGE f u SUBSET s /\ IMAGE g u SUBSET c /\ g continuous_on u /\ (!x. x IN u ==> p(g x) = f x) ==> g holomorphic_on u`, REPEAT STRIP_TAC THEN REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(f:complex->complex) z` o last o CONJUNCTS o GEN_REWRITE_RULE I [covering_space]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_OPEN_EQ]] THEN DISCH_THEN(X_CHOOSE_THEN `t:complex->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vv:(complex->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE o SPEC `(g:complex->complex) z`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN DISCH_THEN(X_CHOOSE_THEN `v:complex->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`p:complex->complex`; `v:complex->bool`] HOLOMORPHIC_ON_INVERSE) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `p':complex->complex` STRIP_ASSUME_TAC)] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN EXISTS_TAC `(p':complex->complex) o (f:complex->complex)` THEN MP_TAC(ISPECL [`g:complex->complex`; `u:complex->bool`; `c:complex->bool`; `v:complex->bool`] CONTINUOUS_OPEN_IN_PREIMAGE_GEN) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_EQ] THEN REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o SPEC `z:complex` o CONJUNCT2) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[o_THM; IN_ELIM_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `IMAGE (p:complex->complex) v` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let COVERING_SPACE_LIFT_HOLOMORPHIC = prove (`!p c s f u. covering_space (c,p) s /\ p holomorphic_on c /\ open c /\ simply_connected u /\ locally path_connected u /\ f holomorphic_on u /\ IMAGE f u SUBSET s ==> ?g. g holomorphic_on u /\ IMAGE g u SUBSET c /\ !y. y IN u ==> p(g y) = f y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:complex->complex`; `c:complex->bool`; `s:complex->bool`; `f:complex->complex`; `u:complex->bool`] COVERING_SPACE_LIFT) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_IS_HOLOMORPHIC)) THEN EXISTS_TAC `f:complex->complex` THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* The Schwarz lemma. *) (* ------------------------------------------------------------------------- *) let SCHWARZ_LEMMA = prove (`!f. f holomorphic_on ball(Cx(&0),&1) /\ (!z:complex. norm z < &1 ==> norm (f z) < &1) /\ f(Cx(&0)) = Cx(&0) ==> (!z. norm z < &1 ==> norm(f z) <= norm z) /\ norm(complex_derivative f(Cx(&0))) <= &1 /\ ((?z. norm z < &1 /\ ~(z= Cx(&0)) /\ norm(f z) = norm z) \/ norm(complex_derivative f (Cx(&0))) = &1 ==> ?c. (!z. norm z < &1 ==> f z = c*z) /\ norm c = &1)`, let LEMMA1 = prove (`!f a. open a /\ connected a /\ bounded a /\ ~(a = {}) /\ f holomorphic_on a /\ f continuous_on (closure a) ==> (?w. w IN (frontier a) /\ (!z. z IN (closure a) ==> norm (f z) <= norm (f w)))`, REPEAT STRIP_TAC THEN ASSERT_TAC `?x. x IN closure a /\ (!z. z IN closure a ==> norm((f:complex->complex) z) <= norm(f x))` THENL [MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN ASM_SIMP_TAC [COMPACT_CLOSURE;CLOSURE_EQ_EMPTY] THEN SUBGOAL_THEN `lift o (\x. norm((f:complex->complex) x)) = (lift o norm) o (\x. f x) ` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC [CONTINUOUS_ON_LIFT_NORM;ETA_AX]]; ALL_TAC] THEN ASM_CASES_TAC `x:complex IN frontier a` THENL [EXISTS_TAC `x:complex` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `x:complex IN interior a` MP_TAC THENL [POP_ASSUM MP_TAC THEN REWRITE_TAC[frontier;DIFF] THEN SET_TAC[ASSUME `x:complex IN closure a`]; ALL_TAC] THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN DISCH_TAC THEN SUBGOAL_THEN `?c. !z. z IN a ==> (f:complex->complex) z = c` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC MAXIMUM_MODULUS_PRINCIPLE THEN EXISTS_TAC `a:complex->bool` THEN EXISTS_TAC `x:complex` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[closure;UNION] THEN SET_TAC[ASSUME `z:complex IN a`]; ALL_TAC] THEN SUBGOAL_THEN `CHOICE(frontier(a:complex->bool)) IN frontier a` ASSUME_TAC THENL [MATCH_MP_TAC CHOICE_DEF THEN MATCH_MP_TAC FRONTIER_NOT_EMPTY THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[NOT_BOUNDED_UNIV]]; ALL_TAC] THEN EXISTS_TAC `CHOICE(frontier(a:complex->bool))` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN SUBGOAL_THEN `!z. z IN closure a ==> (f:complex->complex) z = c` ASSUME_TAC THENL [MP_TAC (ISPECL [`f:complex->complex`; `closure (a:complex->bool)`; `{c:complex}`] CONTINUOUS_CLOSED_PREIMAGE) THEN ASM_REWRITE_TAC [CLOSED_CLOSURE; CLOSED_SING] THEN ABBREV_TAC `s = {x | x IN closure(a:complex->bool) /\ (f:complex->complex) x IN {c}}` THEN DISCH_TAC THEN SUBGOAL_THEN `closure a SUBSET (s:complex->bool)` ASSUME_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN EXPAND_TAC "s" THEN ASSUME_TAC (MESON [CLOSURE_SUBSET;GSYM SUBSET] `!x:complex. x IN a ==> x IN closure a`) THEN SET_TAC [ASSUME `!x:complex. x IN a ==> x IN closure a`; ASSUME `!z:complex. z IN a ==> f z = c:complex`]; ASM_REWRITE_TAC[]]; POP_ASSUM MP_TAC THEN EXPAND_TAC "s" THEN SET_TAC[]]; EQ_TRANS_TAC `norm(c:complex)` THENL [ASM_SIMP_TAC[]; ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC (NORM_ARITH `!x y:complex. x = y ==> norm x = norm y`) THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[frontier;IN_DIFF]]]) in let LEMMA2 = prove (`!(f:complex->complex) r w s. &0 < r /\ f holomorphic_on ball(Cx(&0),r) /\ &0 < s /\ ball(w,s) SUBSET ball(Cx(&0),r) /\ (!z. norm (w-z) < s ==> norm(f z) <= norm(f w)) ==> (?c. !z. norm z < r ==> f z = c)`, REPEAT STRIP_TAC THEN MP_TAC (SPECL[`f:complex->complex`;`ball (Cx(&0),r)`; `ball (w:complex,s)`; `w:complex`] MAXIMUM_MODULUS_PRINCIPLE) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; IN_BALL;DIST_REFL] THEN ASM_REWRITE_TAC[dist;COMPLEX_SUB_LZERO;NORM_NEG]) in let LEMMA3 = prove (`!r:real f. f holomorphic_on (ball(Cx(&0),r)) /\ f (Cx(&0))=Cx(&0) ==> (?h. h holomorphic_on (ball(Cx(&0),r)) /\ ((!z. norm z < r ==> f z=z*(h z)) /\ (complex_derivative f (Cx(&0)))= h (Cx(&0))))`, REPEAT STRIP_TAC THEN ABBREV_TAC `h = \z. if z = Cx(&0) then complex_derivative f (Cx(&0)) else f z/z` THEN EXISTS_TAC `h:complex->complex` THEN ASSERT_TAC `(!z:complex. norm z < r ==> (f:complex->complex) z = z * h z) /\ complex_derivative f (Cx(&0)) = h (Cx(&0))` THENL [CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "h" THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]; POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD]; EXPAND_TAC "h" THEN ASM_REWRITE_TAC[]];ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POLE_THEOREM_OPEN_0 THEN EXISTS_TAC `(f:complex->complex)` THEN EXISTS_TAC `Cx(&0)` THEN ASM_SIMP_TAC[OPEN_BALL;IN_BALL;COMPLEX_SUB_RZERO; dist;COMPLEX_SUB_LZERO;NORM_NEG]) in GEN_TAC THEN STRIP_TAC THEN MP_TAC (SPECL [`&1`;`f:complex->complex`] LEMMA3) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `!z. norm z < &1 ==> norm ((h:complex->complex) z) <= &1` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC (prove (`!x y:real. (!a. y x x <= y`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[REAL_LT_BETWEEN] THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM] THEN X_GEN_TAC `z:real` THEN POP_ASSUM (MP_TAC o SPEC `z:real`) THEN REAL_ARITH_TAC)) THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?r. norm (z:complex) < r /\ inv r < a /\ r < &1` MP_TAC THENL [SUBGOAL_THEN `max (inv a) (norm(z:complex)) < &1` MP_TAC THENL [ASM_SIMP_TAC[REAL_MAX_LT; REAL_INV_LT_1]; GEN_REWRITE_TAC LAND_CONV [REAL_LT_BETWEEN] THEN DISCH_THEN (X_CHOOSE_TAC `r:real`) THEN EXISTS_TAC `r:real` THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[REAL_MAX_LT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_LINV THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LET_TRANS; NORM_POS_LE]; ALL_TAC] THEN SUBGOAL_THEN `inv (r:real) = &1/r` ASSUME_TAC THENL [MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN SUBGOAL_THEN `?w. norm w = r /\ (!z. norm z < r ==> norm((h:complex->complex) z) <= norm(h w))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(prove (`!f r. &0 < r /\ f holomorphic_on ball(Cx(&0),r) /\ f continuous_on cball(Cx(&0),r) ==> (?w. norm w = r /\ (!z. norm z < r ==> norm(f z) <= norm(f w)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL[`f:complex->complex`; `ball(Cx(&0),r)`] LEMMA1) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BOUNDED_BALL; BALL_EQ_EMPTY; REAL_ARITH `!r:real. ~(r <= &0) <=> &0 < r`] THEN ASM_SIMP_TAC[CLOSURE_BALL] THEN STRIP_TAC THEN EXISTS_TAC `w:complex` THEN CONJ_TAC THENL [UNDISCH_TAC `w:complex IN frontier(ball(Cx(&0),r))` THEN ASM_SIMP_TAC[FRONTIER_BALL;sphere;dist;COMPLEX_SUB_LZERO;NORM_NEG] THEN SET_TAC[]; POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_CBALL;dist;COMPLEX_SUB_LZERO;NORM_NEG] THEN MESON_TAC [REAL_LT_IMP_LE]])) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_SIMP_TAC [SUBSET_BALL;REAL_LT_IMP_LE]; MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN ASM_MESON_TAC[REAL_LET_TRANS]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(h(w:complex):complex)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `h w:complex = f w / w` SUBST1_TAC THENL [ASM_SIMP_TAC[] THEN MP_TAC (MESON [GSYM COMPLEX_NORM_ZERO;REAL_NOT_EQ; ASSUME `norm(w:complex) =r`; ASSUME `&0 < r`] `~(w=Cx(&0))`) THEN CONV_TAC(COMPLEX_FIELD); ASM_REWRITE_TAC[COMPLEX_NORM_DIV] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1/(r:real)` THEN ASM_SIMP_TAC [REAL_LT_DIV2_EQ] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv (r:real)` THEN ASM_REWRITE_TAC[REAL_LE_REFL]]; ALL_TAC] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_SIMP_TAC[COMPLEX_MUL_LZERO;REAL_LE_REFL]; SUBST1_TAC (REAL_ARITH `norm (z:complex) = norm z * &1`) THEN ASM_SIMP_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[NORM_POS_LE]]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC [COMPLEX_NORM_ZERO;REAL_LT_01]; ALL_TAC] THEN REWRITE_TAC[TAUT `((p \/ q) ==> r) <=> ((p ==> r) /\ (q ==> r))`] THEN CONJ_TAC THENL [STRIP_TAC THEN SUBGOAL_THEN `norm ((h:complex->complex) z) = &1` ASSUME_TAC THENL [SUBGOAL_THEN `(h:complex->complex) z = f z/z` SUBST1_TAC THENL [UNDISCH_THEN `!z:complex. norm z < &1 ==> f z = z * h z` (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(z = Cx(&0))` THEN CONV_TAC(COMPLEX_FIELD); ASM_SIMP_TAC[COMPLEX_NORM_ZERO;REAL_DIV_REFL;COMPLEX_NORM_DIV]]; SUBGOAL_THEN `?c. (!z. norm z < &1 ==> (h:complex->complex) z = c)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC LEMMA2 THEN EXISTS_TAC `z:complex` THEN EXISTS_TAC `&1 - norm(z:complex)` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_SUB_LT]; CONJ_TAC THENL [REWRITE_TAC[SUBSET;IN_BALL] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `dist(Cx(&0), z) + dist(z,x)` THEN REWRITE_TAC[DIST_TRIANGLE] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[dist;COMPLEX_SUB_LZERO;NORM_NEG] THEN REAL_ARITH_TAC; GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(z:complex) + norm(z' - z)` THEN REWRITE_TAC[NORM_TRIANGLE_SUB] THEN REWRITE_TAC[NORM_SUB] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NORM_SUB] THEN REAL_ARITH_TAC]]; EXISTS_TAC `c:complex` THEN CONJ_TAC THENL [ASM_SIMP_TAC[COMPLEX_MUL_SYM]; POP_ASSUM (MP_TAC o SPEC `z:complex`) THEN ASM_MESON_TAC[]]]]; ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `?c. (!z. norm z < &1 ==> (h:complex->complex) z = c)` STRIP_ASSUME_TAC THENL[MATCH_MP_TAC LEMMA2 THEN EXISTS_TAC `Cx(&0)` THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`; SUBSET_REFL; COMPLEX_SUB_LZERO; NORM_NEG]; EXISTS_TAC `c:complex` THEN CONJ_TAC THENL [ASM_SIMP_TAC[COMPLEX_MUL_SYM];POP_ASSUM (MP_TAC o SPEC `Cx(&0)`) THEN ASM_MESON_TAC[COMPLEX_NORM_0; REAL_LT_01]]]]);; let HOLOMORPHIC_SUBORDINATION = prove (`!f g a r s. r <= s /\ f a = g a /\ f holomorphic_on ball(a,s) /\ g holomorphic_on ball(a,s) /\ (!w z. w IN ball(a,s) /\ z IN ball(a,s) /\ g w = g z ==> w = z) /\ IMAGE f (ball(a,s)) SUBSET IMAGE g (ball(a,s)) ==> IMAGE f (ball(a,r)) SUBSET IMAGE g (ball(a,r))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; IMAGE_CLAUSES; EMPTY_SUBSET] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; REAL_NOT_LT] THEN ASM_CASES_TAC `s = &0` THEN ASM_SIMP_TAC[CONJ_ASSOC; ONCE_REWRITE_RULE[CONJ_SYM] REAL_LE_ANTISYM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < s` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`g:complex->complex`; `ball(a:complex,s)`] HOLOMORPHIC_ON_INVERSE) THEN ASM_REWRITE_TAC[OPEN_BALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_ALT]) THEN MP_TAC(SPEC `(\z. (z - a) / Cx s) o (h:complex->complex) o (f:complex->complex) o (\z. a + Cx s * z)` SCHWARZ_LEMMA) THEN REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[complex_div; HOLOMORPHIC_ON_RMUL; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; o_ASSOC] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_LMUL; HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN ASM_REWRITE_TAC[GSYM COMPLEX_CMUL; IMAGE_AFFINITY_BALL] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_MUL_RID; SUBSET_REFL]; SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LT_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_LID; GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist)] THEN REWRITE_TAC[GSYM IN_BALL] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `(a + Cx s * z) IN ball(a:complex,s)` ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(a:complex,a + x) = norm x`] THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_MUL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 < s ==> s * z < s * &1 ==> abs s * z < s`)) THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ]; REWRITE_TAC[COMPLEX_DIV_EQ_0] THEN DISJ1_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_SUB_0] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]]; DISCH_THEN(LABEL_TAC "*" o CONJUNCT1) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_BALL; dist; IN_IMAGE] THEN STRIP_TAC THEN EXISTS_TAC `(h:complex->complex) (f(z:complex))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_BALL; dist] THEN ASM_REAL_ARITH_TAC; REMOVE_THEN "*" (MP_TAC o SPEC `(z - a) / Cx s`) THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LE_DIV2_EQ] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= x /\ y < b ==> x <= y ==> a < b`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `y:real^2 = x ==> norm(x - a) <= norm(a - y)`) THEN AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM CX_INJ]) THEN CONV_TAC COMPLEX_FIELD]]);; (* ------------------------------------------------------------------------- *) (* The Schwarz reflection principle. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_ON_PASTE_ACROSS_LINE = prove (`!f s a k. open s /\ ~(a = vec 0) /\ f holomorphic_on {z | z IN s /\ k < a dot z} /\ f holomorphic_on {z | z IN s /\ a dot z < k} /\ f continuous_on s ==> f holomorphic_on s`, let lemma0 = prove (`!d a b:real^N k. d dot a <= k /\ k <= d dot b ==> ?c. c IN segment[a,b] /\ d dot c = k /\ (!z. z IN segment[a,c] ==> d dot z <= k) /\ (!z. z IN segment[c,b] ==> k <= d dot z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`segment[a:real^N,b]`; `a:real^N`; `b:real^N`; `d:real^N`; `k:real`] CONNECTED_IVT_HYPERPLANE) THEN ASM_REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[SET_RULE `(!z. z IN s ==> P z) <=> s SUBSET {x | P x}`] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LE; REWRITE_RULE[real_ge] CONVEX_HALFSPACE_GE; SUBSET; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_LE_REFL]) in let lemma1 = prove (`!f s d k a b c. convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ d dot a <= k /\ d dot b <= k /\ d dot c <= k /\ f holomorphic_on {z | z IN s /\ d dot z < k} /\ f holomorphic_on {z | z IN s /\ k < d dot z} /\ f continuous_on s ==> path_integral (linepath (a,b)) f + path_integral (linepath (b,c)) f + path_integral (linepath (c,a)) f = Cx(&0)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `b:complex`; `c:complex`] CAUCHY_THEOREM_TRIANGLE_INTERIOR) THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `{z:complex | z IN s /\ d dot z < k}` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `interior(s INTER {x:complex | d dot x <= k})` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HALFSPACE_LE] THEN ASM SET_TAC[]; ASM_SIMP_TAC[INTERIOR_INTER; INTERIOR_HALFSPACE_LE; INTERIOR_OPEN] THEN SET_TAC[]]]; REWRITE_TAC[HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL]]) in let lemma2 = prove (`!f s d k a b c. convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ d dot a <= k /\ d dot b <= k /\ f holomorphic_on {z | z IN s /\ d dot z < k} /\ f holomorphic_on {z | z IN s /\ k < d dot z} /\ f continuous_on s ==> path_integral (linepath (a,b)) f + path_integral (linepath (b,c)) f + path_integral (linepath (c,a)) f = Cx(&0)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(d:complex) dot c <= k` THENL [MATCH_MP_TAC lemma1 THEN ASM_MESON_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN MP_TAC(ISPECL [`d:complex`; `b:complex`; `c:complex`; `k:real`] lemma0) THEN MP_TAC(ISPECL [`d:complex`; `a:complex`; `c:complex`; `k:real`] lemma0) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_THEN `a':complex` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b':complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(a':complex) IN s /\ b' IN s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SEGMENT_SYM; SUBSET]; ALL_TAC] THEN MP_TAC(SPECL [`f:complex->complex`; `c:complex`; `a:complex`; `a':complex`] PATH_INTEGRAL_SPLIT_LINEPATH) THEN MP_TAC(SPECL [`f:complex->complex`; `b:complex`; `c:complex`; `b':complex`] PATH_INTEGRAL_SPLIT_LINEPATH) THEN ASM_REWRITE_TAC[] THEN REPEAT(ANTS_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SEGMENT_SYM; CONTINUOUS_ON_SUBSET]; ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]]) THEN MP_TAC(ISPECL [`f:complex->complex`; `linepath(a':complex,b')`] PATH_INTEGRAL_REVERSEPATH) THEN REWRITE_TAC[REVERSEPATH_LINEPATH; VALID_PATH_LINEPATH] THEN ANTS_TAC THENL [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `s INTER {x:complex | d dot x <= k}`; `{}:complex->bool`; `linepath(a:complex,b) ++ linepath(b,b') ++ linepath(b',a') ++ linepath(a',a)`] CAUCHY_THEOREM_CONVEX) THEN MP_TAC(ISPECL [`f:complex->complex`; `s INTER {x:complex | k <= d dot x}`; `{}:complex->bool`; `linepath(b':complex,c) ++ linepath(c,a') ++ linepath(a',b')`] CAUCHY_THEOREM_CONVEX) THEN MATCH_MP_TAC(TAUT `(q /\ q' ==> r) /\ (p /\ p') ==> (p ==> q) ==> (p' ==> q') ==> r`) THEN CONJ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN (fun th -> MP_TAC(MATCH_MP PATH_INTEGRAL_UNIQUE th) THEN MP_TAC(MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE th))); ASM_SIMP_TAC[DIFF_EMPTY; INTERIOR_INTER; INTERIOR_HALFSPACE_LE; REWRITE_RULE[real_ge] INTERIOR_HALFSPACE_GE] THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HALFSPACE_LE; FINITE_EMPTY; REWRITE_RULE[real_ge] CONVEX_HALFSPACE_GE]] THEN SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; VALID_PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_INTEGRAL_JOIN] THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; UNION_SUBSET; SUBSET_INTER] THEN ASM_SIMP_TAC[fst(EQ_IMP_RULE(SPEC_ALL CONVEX_CONTAINS_SEGMENT_EQ)); CONVEX_HALFSPACE_LE; REWRITE_RULE[real_ge] CONVEX_HALFSPACE_GE; IN_ELIM_THM; REAL_LT_IMP_LE; REAL_LE_REFL] THEN ASM_SIMP_TAC[complex_differentiable; GSYM HOLOMORPHIC_ON_OPEN; OPEN_INTER; INTERIOR_OPEN; OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN RULE_ASSUM_TAC(REWRITE_RULE[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`]) THEN ASM_REWRITE_TAC[real_gt] THEN ASM_MESON_TAC[INTER_SUBSET; CONTINUOUS_ON_SUBSET]) in let lemma3 = prove (`!f s d k a b c. convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ d dot a <= k /\ f holomorphic_on {z | z IN s /\ d dot z < k} /\ f holomorphic_on {z | z IN s /\ k < d dot z} /\ f continuous_on s ==> path_integral (linepath (a,b)) f + path_integral (linepath (b,c)) f + path_integral (linepath (c,a)) f = Cx(&0)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(d:complex) dot b <= k` THENL [MATCH_MP_TAC lemma2 THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(d:complex) dot c <= k` THENL [ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = c + a + b`] THEN MATCH_MP_TAC(GEN_ALL lemma2) THEN ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = b + c + a`] THEN MATCH_MP_TAC(GEN_ALL lemma2) THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `--d:real^2`; `--k:real`] THEN ASM_REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN ASM_REAL_ARITH_TAC) in let lemma4 = prove (`!f s d k a b c. convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ f holomorphic_on {z | z IN s /\ d dot z < k} /\ f holomorphic_on {z | z IN s /\ k < d dot z} /\ f continuous_on s ==> path_integral (linepath (a,b)) f + path_integral (linepath (b,c)) f + path_integral (linepath (c,a)) f = Cx(&0)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(d:complex) dot a <= k` THENL [MATCH_MP_TAC lemma3 THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC lemma3 THEN MAP_EVERY EXISTS_TAC [`s:complex->bool`; `--d:real^2`; `--k:real`] THEN ASM_REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN ASM_REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN MATCH_MP_TAC ANALYTIC_IMP_HOLOMORPHIC THEN MATCH_MP_TAC MORERA_LOCAL_TRIANGLE THEN X_GEN_TAC `p:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `p:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(p:complex,e)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`u:complex`; `v:complex`; `w:complex`] THEN SIMP_TAC[SUBSET_HULL; CONVEX_BALL; INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN MATCH_MP_TAC lemma4 THEN MAP_EVERY EXISTS_TAC [`ball(p:complex,e)`; `a:complex`; `k:real`] THEN ASM_REWRITE_TAC[CONVEX_BALL; OPEN_BALL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `{z:complex | z IN s /\ a dot z < k}`; MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `{z:complex | z IN s /\ k < a dot z}`; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let SCHWARZ_REFLECTION = prove (`!f s. open s /\ (!z. z IN s ==> cnj z IN s) /\ f holomorphic_on {z | z IN s /\ &0 < Im z} /\ f continuous_on {z | z IN s /\ &0 <= Im z} /\ (!z. z IN s /\ real z ==> real(f z)) ==> (\z. if &0 <= Im z then f(z) else cnj(f(cnj z))) holomorphic_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_PASTE_ACROSS_LINE THEN MAP_EVERY EXISTS_TAC [`basis 2:complex`; `&0`] THEN ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_2; ARITH] THEN REWRITE_TAC[GSYM IM_DEF] THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `f holomorphic_on {z | z IN s /\ &0 < Im z}` THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLOMORPHIC_EQ THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE]; SUBGOAL_THEN `(cnj o f o cnj) holomorphic_on {z | z IN s /\ Im z < &0}` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLOMORPHIC_EQ THEN SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; o_THM]] THEN UNDISCH_TAC `f holomorphic_on {z | z IN s /\ &0 < Im z}` THEN REWRITE_TAC[holomorphic_on; IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `cnj z`) THEN ASM_SIMP_TAC[IM_CNJ; REAL_ARITH `&0 < --x <=> x < &0`] THEN DISCH_THEN(X_CHOOSE_THEN `w:complex` (fun th -> EXISTS_TAC `cnj w` THEN MP_TAC th)) THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN; LIM_WITHIN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM FORALL_CNJ] THEN REWRITE_TAC[IN_ELIM_THM; dist; GSYM CNJ_SUB; o_THM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM COMPLEX_NORM_CNJ] THEN REWRITE_TAC[CNJ_SUB; CNJ_DIV; CNJ_CNJ] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IM_CNJ] THEN ASM_REAL_ARITH_TAC; SUBGOAL_THEN `s = {z | z IN s /\ &0 <= Im z} UNION {z | z IN s /\ Im z <= &0}` (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THENL [SET_TAC[REAL_LE_TOTAL]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SET_RULE `{z | z IN s /\ P z} = s INTER {z | P z}`] THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_HALFSPACE_IM_LE; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_IM_GE] THEN CONJ_TAC THENL [REPLICATE_TAC 2 (MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN REWRITE_TAC[CONTINUOUS_ON_CNJ]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_INTER; IM_CNJ] THEN REAL_ARITH_TAC; X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `real z` ASSUME_TAC THENL [REWRITE_TAC[real] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_CNJ]) THEN ASM_MESON_TAC[]]]);; let SCHWARZ_REFLECTION_UNIQUE = prove (`!f s. open s /\ connected s /\ (!z. z IN s ==> cnj z IN s) /\ f holomorphic_on s /\ (!z. z IN s /\ real z ==> real(f z)) ==> (!z. z IN s ==> f(cnj z) = cnj(f z))`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `!z. z IN s ==> real z` THENL [ASM_MESON_TAC[REAL_CNJ; real]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[real; NOT_IMP; REAL_ARITH `~(x = &0) <=> &0 < x \/ &0 < --x`; GSYM IM_CNJ] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(?z. P z /\ (Q z \/ R z)) ==> (!z. P z ==> P(cnj z)) /\ (!z. R z ==> Q(cnj z)) ==> ?z. P z /\ Q z`)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] SCHWARZ_REFLECTION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT]; DISCH_TAC] THEN SUBGOAL_THEN `!z. z IN s ==> (if &0 <= Im z then f z else cnj (f (cnj z))) - f z = Cx(&0)` MP_TAC THENL [ALL_TAC; DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `Im z = &0 \/ &0 < Im z \/ Im z < &0`) THENL [ASM_MESON_TAC[REAL_CNJ; real]; REMOVE_THEN "*" (MP_TAC o SPEC `cnj z`) THEN ASM_SIMP_TAC[IM_CNJ; REAL_ARITH `&0 <= --z <=> ~(&0 < z)`; CNJ_CNJ] THEN CONV_TAC COMPLEX_RING; REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN ASM_SIMP_TAC[GSYM REAL_NOT_LT; COMPLEX_SUB_0] THEN MESON_TAC[CNJ_CNJ]]] THEN MATCH_MP_TAC ANALYTIC_CONTINUATION THEN EXISTS_TAC `s INTER {w | Im w > &0}` THEN ASM_SIMP_TAC[IN_INTER; real_gt; REAL_LT_IMP_LE; COMPLEX_SUB_0; IN_ELIM_THM; INTER_SUBSET; RIGHT_EXISTS_AND_THM; HOLOMORPHIC_ON_SUB] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `w:complex` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIMPT_OF_OPEN THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[GSYM real_gt; OPEN_HALFSPACE_IM_GT]);; (* ------------------------------------------------------------------------- *) (* Bloch's theorem. *) (* ------------------------------------------------------------------------- *) let BLOCH_LEMMA = prove (`!f a r. &0 < r /\ f holomorphic_on cball(a,r) /\ (!z. z IN ball(a,r) ==> norm(complex_derivative f z) <= &2 * norm(complex_derivative f a)) ==> ball(f(a),(&3 - &2 * sqrt(&2)) * r * norm(complex_derivative f a)) SUBSET IMAGE f (ball(a,r))`, SUBGOAL_THEN `!f r. &0 < r /\ f holomorphic_on cball(Cx(&0),r) /\ f(Cx(&0)) = Cx(&0) /\ (!z. z IN ball(Cx(&0),r) ==> norm(complex_derivative f z) <= &2 * norm(complex_derivative f (Cx(&0)))) ==> ball(Cx(&0), (&3 - &2 * sqrt(&2)) * r * norm(complex_derivative f (Cx(&0)))) SUBSET IMAGE f (ball(Cx(&0),r))` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\z. (f:complex->complex)(a + z) - f(a)`; `r:real`]) THEN ASM_REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_SUB_REFL] THEN SUBGOAL_THEN `!z. z IN ball(Cx(&0),r) ==> complex_derivative (\w. f (a + w) - f a) z = complex_derivative f (a + z)` (fun th -> ASM_SIMP_TAC[CENTRE_IN_BALL; COMPLEX_ADD_RID; th]) THENL [REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN ONCE_REWRITE_TAC [COMPLEX_RING `complex_derivative f z = complex_derivative f z * (Cx(&0) + Cx(&1)) - Cx(&0)`] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_ADD; HAS_COMPLEX_DERIVATIVE_CONST; HAS_COMPLEX_DERIVATIVE_ID; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN DISCH_THEN(MP_TAC o SPEC `a + z:complex`) THEN ASM_SIMP_TAC[IN_CBALL; NORM_ARITH `norm z < r ==> dist(a,a+z) <= r`] THEN REWRITE_TAC[GSYM complex_differentiable] THEN DISCH_THEN(MP_TAC o SPEC `ball(a:complex,r)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET)) THEN ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_WITHIN_OPEN THEN ASM_REWRITE_TAC[IN_BALL; OPEN_BALL; NORM_ARITH `dist(a,a + z) = norm z`]; ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN EXISTS_TAC `cball(a:complex,r)` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; COMPLEX_IN_CBALL_0] THEN REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC; X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_BALL; NORM_ARITH `dist(a,a + z) = norm z`]]; REWRITE_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_IMAGE] THEN REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN DISCH_THEN(fun th -> X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MP_TAC(SPEC `z - (f:complex->complex) a` th)) THEN ASM_REWRITE_TAC[COMPLEX_RING `z - a:complex = w - a <=> z = w`] THEN DISCH_THEN(X_CHOOSE_TAC `x:complex`) THEN EXISTS_TAC `a + x:complex` THEN ASM_REWRITE_TAC[COMPLEX_ADD_SUB]]]] THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `&0 < &3 - &2 * sqrt(&2)` ASSUME_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < a - &2 * b <=> b < a / &2`] THEN MATCH_MP_TAC REAL_LT_LSQRT THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `&0 < r` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_CASES_TAC `complex_derivative f (Cx(&0)) = Cx(&0)` THEN ASM_SIMP_TAC[COMPLEX_NORM_0; REAL_MUL_RZERO; BALL_TRIVIAL; EMPTY_SUBSET] THEN ABBREV_TAC `C = &2 * norm(complex_derivative f (Cx(&0)))` THEN SUBGOAL_THEN `&0 < C` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_NORM_NZ; REAL_ARITH `&0 < &2 * x <=> &0 < x`]; ALL_TAC] THEN SUBGOAL_THEN `!z. z IN ball(Cx(&0),r) ==> norm(complex_derivative f z - complex_derivative f (Cx(&0))) <= norm(z) / (r - norm(z)) * C` (LABEL_TAC "+") THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `!R. norm z < R /\ R < r ==> norm(complex_derivative f z - complex_derivative f (Cx(&0))) <= norm(z) / (R - norm(z)) * C` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`complex_derivative f`; `cball(Cx(&0),R)`; `circlepath(Cx(&0),R)`] CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN REWRITE_TAC[CONVEX_CBALL; VALID_PATH_CIRCLEPATH; INTERIOR_CBALL; PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH] THEN SUBGOAL_THEN `&0 < R` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LET_TRANS; NORM_POS_LE]; ALL_TAC] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_CBALL; IN_BALL; IN_DELETE] THEN SIMP_TAC[WINDING_NUMBER_CIRCLEPATH; COMPLEX_SUB_RZERO; COMPLEX_SUB_LZERO; dist; NORM_NEG; REAL_LE_REFL; MESON[REAL_LT_REFL] `norm z < R /\ (!w. norm w = R ==> ~(w = z)) <=> norm z < R`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN ANTS_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),r)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN REWRITE_TAC[OPEN_BALL] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `cball(Cx(&0),r)` THEN ASM_REWRITE_TAC[BALL_SUBSET_CBALL]; ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL; REAL_ADD_LID]]; REWRITE_TAC[COMPLEX_MUL_LID]] THEN DISCH_THEN(fun th -> MP_TAC (CONJ (SPEC `z:complex` th) (SPEC `Cx(&0)` th))) THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_RZERO] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN DISCH_THEN(MP_TAC o SPEC `C * norm(z) / (R * (R - norm(z:complex)))` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH)) THEN ASM_REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID; REAL_ABS_PI] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < R /\ z < R ==> (C * z / (R * (R - z))) * &2 * pi * R = &2 * pi * z / (R - z) * C`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < &2`; PI_POS] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_DIV; REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; NORM_POS_LE; COMPLEX_SUB_RZERO] THEN X_GEN_TAC `x:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `~(x = Cx(&0)) /\ ~(x = z)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL; COMPLEX_NORM_0]; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(x = Cx(&0)) /\ ~(x = z) ==> d / (x - z) - d / x = d * z / (x * (x - z))`] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE; IN_BALL; dist; NORM_NEG; COMPLEX_SUB_LZERO] THEN REWRITE_TAC[COMPLEX_NORM_DIV; real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT; COMPLEX_NORM_MUL] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN UNDISCH_TAC `norm(x:complex) = R` THEN CONV_TAC NORM_ARITH; DISCH_TAC THEN MP_TAC(ISPECL [`\x. lift(norm(z:complex) / (drop x - norm z) * C)`; `interval(lift((norm(z:complex) + r) / &2),lift r)`; `lift r`; `norm(complex_derivative f z - complex_derivative f (Cx(&0)))`; `1`] CONTINUOUS_ON_CLOSURE_COMPONENT_GE) THEN REWRITE_TAC[GSYM drop; LIFT_DROP; CLOSURE_INTERVAL] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_TAC THEN ASM_SIMP_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; LIFT_DROP; REAL_ARITH `z < r ==> ~(r <= (z + r) / &2) /\ ~(r < (z + r) / &2)`] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP; IN_INTERVAL_1] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_ARITH `(z + r) / &2 < R /\ R < r ==> z < R`]] THEN REWRITE_TAC[LIFT_CMUL; real_div] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF; LIFT_CMUL] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LIFT_DROP; CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_ID] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!z. z IN ball(Cx(&0),r) ==> (norm(z) - norm(z) pow 2 / (r - norm(z))) * norm(complex_derivative f (Cx(&0))) <= norm(f z)` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_TAC THEN MP_TAC(ISPECL[`\z. f(z) - complex_derivative f (Cx(&0)) * z`; `\z. complex_derivative f z - complex_derivative f (Cx(&0))`; `linepath(Cx(&0),z)`; `ball(Cx(&0),r)`] PATH_INTEGRAL_PRIMITIVE) THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ANTS_TAC THENL [REWRITE_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a - complex_derivative f b = a - complex_derivative f b * Cx(&1)`] THEN CONJ_TAC THENL [X_GEN_TAC `x:complex` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN; HAS_COMPLEX_DERIVATIVE_ID] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN REWRITE_TAC[GSYM complex_differentiable] THEN DISCH_THEN(MP_TAC o SPEC `ball(Cx(&0),r)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET)) THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_WITHIN_OPEN; OPEN_BALL] THEN REWRITE_TAC[BALL_SUBSET_CBALL]; MATCH_MP_TAC(REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_BALL) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]]; ALL_TAC] THEN SIMP_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; HAS_PATH_INTEGRAL_LINEPATH] THEN REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[linepath; COMPLEX_CMUL; COMPLEX_MUL_RZERO; LIFT_DROP] THEN REWRITE_TAC[COMPLEX_ADD_LID; FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\t. lift(norm(z:complex) pow 2 * drop t / (r - norm(z)) * C)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRAL_NORM_BOUND_INTEGRAL)) THEN REWRITE_TAC[linepath; COMPLEX_CMUL; COMPLEX_MUL_RZERO; LIFT_DROP] THEN REWRITE_TAC[COMPLEX_ADD_LID; FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP] THEN REWRITE_TAC[REAL_ARITH `a * b / c * d:real = (a / c * d) * b`] THEN REWRITE_TAC[LIFT_CMUL; LIFT_DROP; DROP_VEC] THEN MP_TAC(ISPECL [`\x. inv(&2) * x pow 2`; `\x:real. x`; `&0`; `&1`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[REAL_POS] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC; REWRITE_TAC[has_real_integral; o_DEF; IMAGE_LIFT_REAL_INTERVAL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_DROP; LIFT_NUM] THEN DISCH_THEN(MP_TAC o SPEC `norm(z:complex) pow 2 / (r - norm z) * C` o MATCH_MP HAS_INTEGRAL_CMUL) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [X_GEN_TAC `t:real` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(z pow 2 / y * c) * t:real = (z / y * t * c) * z`] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REMOVE_THEN "+" (MP_TAC o SPEC `Cx(t) * z`) THEN REWRITE_TAC[IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN SUBGOAL_THEN `norm(Cx t * z) <= norm z` ASSUME_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_MUL_ASSOC; real_div] THEN ASM_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; real_abs] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `(t * z) * w:real = (z * w) * t`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE; REAL_LE_INV_EQ; REAL_SUB_LE] THEN REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_INV2] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [COMPLEX_NORM_MUL]) THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[COMPLEX_SUB_RZERO]] THEN MATCH_MP_TAC(NORM_ARITH `abc <= norm d - e ==> norm(f - d) <= e ==> abc <= norm f`) THEN REWRITE_TAC[REAL_SUB_RDISTRIB; ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] COMPLEX_NORM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `y <= x ==> a - x <= a - y`) THEN REWRITE_TAC[DROP_CMUL; GSYM REAL_MUL_ASSOC; LIFT_DROP] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_POW_2] THEN EXPAND_TAC "C" THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `IMAGE (f:complex->complex) (ball(Cx(&0),(&1 - sqrt(&2) / &2) * r))` THEN SUBGOAL_THEN `&0 < &1 - sqrt(&2) / &2 /\ &1 - sqrt(&2) / &2 < &1` STRIP_ASSUME_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < &1 - s / &2 /\ &1 - s / &2 < &1 <=> &0 < s /\ s < &2`] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_RSQRT; MATCH_MP_TAC REAL_LT_LSQRT] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC IMAGE_SUBSET THEN MATCH_MP_TAC SUBSET_BALL THEN REWRITE_TAC[REAL_ARITH `x * r <= r <=> &0 <= r * (&1 - x)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN MATCH_MP_TAC BALL_SUBSET_OPEN_MAP_IMAGE THEN ASM_SIMP_TAC[REAL_LT_MUL; BOUNDED_BALL; CLOSURE_BALL; CENTRE_IN_BALL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(Cx(&0),r)` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN MATCH_MP_TAC SUBSET_CBALL THEN REWRITE_TAC[REAL_ARITH `x * r <= r <=> &0 <= r * (&1 - x)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] OPEN_MAPPING_THM) THEN EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_SIMP_TAC[OPEN_BALL; CONNECTED_BALL; INTERIOR_OPEN; SUBSET_REFL] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; BALL_SUBSET_CBALL]; ALL_TAC; MATCH_MP_TAC SUBSET_BALL THEN REWRITE_TAC[REAL_ARITH `x * r <= r <=> &0 <= r * (&1 - x)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `y:complex`) THEN MP_TAC(ISPECL [`f:complex->complex`; `(\x. y):complex->complex`; `ball(Cx(&0),r)`; `Cx(&0)`] COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN) THEN ASM_REWRITE_TAC[OPEN_BALL; HOLOMORPHIC_ON_CONST; COMPLEX_DERIVATIVE_CONST; CENTRE_IN_BALL] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; BALL_SUBSET_CBALL]; REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < &3 - &2 * s <=> s < &3 / &2`] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[FRONTIER_BALL; sphere; REAL_LT_MUL; dist; IN_ELIM_THM] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_BALL; dist; COMPLEX_SUB_LZERO; COMPLEX_SUB_RZERO] THEN ASM_REWRITE_TAC[NORM_NEG] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ARITH `x * r < r <=> &0 < r * (&1 - x)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE; REAL_ARITH `r - (&1 - s) * r = s * r`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_FIELD `&0 < r ==> a * r - (b * r) pow 2 * x * inv r = (a - b pow 2 * x) * r`] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MP_TAC(SPEC `&2` SQRT_WORKS) THEN CONV_TAC REAL_FIELD);; let BLOCH_UNIT = prove (`!f a. f holomorphic_on ball(a,&1) /\ complex_derivative f a = Cx(&1) ==> ?b r. &1 / &12 < r /\ ball(b,r) SUBSET IMAGE f (ball(a,&1))`, REPEAT STRIP_TAC THEN ABBREV_TAC `r = &249 / &256` THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `g = \z. complex_derivative f z * Cx(r - norm(z - a))` THEN MP_TAC(ISPECL [`IMAGE (g:complex->complex) (cball(a,r))`; `Cx(&0)`] DISTANCE_ATTAINS_SUP) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; CBALL_EQ_EMPTY] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_CBALL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `ball(a:complex,&1)` THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; ETA_AX; OPEN_BALL]; REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]]; REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(a,b) = norm(b - a)`] THEN REWRITE_TAC[COMPLEX_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `p:complex` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `norm(p - a:complex) < r` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:complex`) THEN ASM_SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; REAL_LT_IMP_LE] THEN EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; COMPLEX_SUB_RZERO; COMPLEX_NORM_CX] THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `t = (r - norm(p - a:complex)) / &2` THEN SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `(f:complex->complex) p` THEN EXISTS_TAC `(&3 - &2 * sqrt (&2)) * t * norm (complex_derivative f p)` THEN MP_TAC(ISPECL [`f:complex->complex`; `p:complex`; `t:real`] BLOCH_LEMMA) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_BALLS; dist; COMPLEX_SUB_RZERO] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN SUBGOAL_THEN `norm(z - a:complex) < r` ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; GSYM REAL_LE_RDIV_EQ; REAL_ARITH `z < r ==> &0 < abs(r - z)`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_ARITH `z < r ==> &0 < abs(r - z)`] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC]; DISCH_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `a:complex`) THEN ASM_SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; REAL_LT_IMP_LE] THEN EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_SUB_RZERO; real_abs; REAL_SUB_LE; REAL_LT_IMP_LE; COMPLEX_SUB_REFL; COMPLEX_NORM_0] THEN EXPAND_TAC "t" THEN REWRITE_TAC[REAL_ARITH `a < b * c / &2 * d <=> a < (d * c) * (b / &2)`] THEN SUBGOAL_THEN `sqrt (&2) < &2113 / &1494` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_LSQRT THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `&0 < &3 - &2 * sqrt(&2)` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_HALF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_HALF] THEN EXPAND_TAC "r" THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_BALLS; dist; COMPLEX_SUB_RZERO] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC]]);; let BLOCH = prove (`!f a r r'. &0 < r /\ f holomorphic_on ball(a,r) /\ r' <= r * norm(complex_derivative f a) / &12 ==> ?b. ball(b,r') SUBSET IMAGE f (ball(a,r))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `complex_derivative f a = Cx(&0)` THENL [ASM_SIMP_TAC[COMPLEX_NORM_0; real_div; REAL_MUL_RZERO; REAL_MUL_LZERO; BALL_EMPTY; EMPTY_SUBSET]; ALL_TAC] THEN ABBREV_TAC `C = complex_derivative f a` THEN SUBGOAL_THEN `&0 < norm(C:complex)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_NORM_NZ]; STRIP_TAC] THEN MP_TAC(ISPECL [`\z. (f:complex->complex)(a + Cx r * z) / (C * Cx r)`; `Cx(&0)`] BLOCH_UNIT) THEN SUBGOAL_THEN `!z. z IN ball(Cx(&0),&1) ==> ((\z. f (a + Cx r * z) / (C * Cx r)) has_complex_derivative (complex_derivative f (a + Cx r * z) / C)) (at z)` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `complex_derivative f (a + Cx r * z) / C = (complex_derivative f (a + Cx r * z) * Cx r) / (C * Cx r)` SUBST1_TAC THENL [ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD `~(r = Cx(&0)) /\ ~(c = Cx(&0)) ==> (d * r) / (c * r) = d / c`]; ALL_TAC] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CDIV_AT THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN CONJ_TAC THENL [COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT)) THEN REWRITE_TAC[OPEN_BALL; IN_BALL; NORM_ARITH `dist(a,a + b) = norm b`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> (abs r * z < r <=> &0 < r * (&1 - z))`; REAL_LT_MUL; REAL_SUB_LT]; ALL_TAC] THEN ANTS_TAC THENL [SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN ASM_SIMP_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_DIV_REFL]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:complex`; `t:real`] THEN STRIP_TAC THEN EXISTS_TAC `(C * Cx r) * b` THEN FIRST_ASSUM(MP_TAC o ISPEC `\z. (C * Cx r) * z` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `v SUBSET s /\ t SUBSET w ==> s SUBSET IMAGE f t ==> v SUBSET IMAGE f w`) THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_IMAGE; IN_BALL; dist] THEN X_GEN_TAC `x:complex` THEN DISCH_TAC THEN EXISTS_TAC `x / (C * Cx r)` THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `norm(C * Cx r)` THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_SUB_LDISTRIB] THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> a * abs r = r * a`] THEN ASM_REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; COMPLEX_NORM_NZ] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0] THEN REWRITE_TAC[OPEN_BALL; IN_BALL; NORM_ARITH `dist(a,a + b) = norm b`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> (abs r * z < r <=> &0 < r * (&1 - z))`; REAL_LT_MUL; REAL_SUB_LT]]);; let BLOCH_COROLLARY = prove (`!f s a t r. f holomorphic_on s /\ a IN s /\ (!z. z IN frontier s ==> t <= dist(a,z)) /\ r <= t * norm(complex_derivative f a) / &12 ==> ?b. ball(b,r) SUBSET IMAGE f s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH `r <= t ==> r <= &0 \/ &0 < t`)) THEN SIMP_TAC[BALL_EMPTY; EMPTY_SUBSET] THEN ASM_CASES_TAC `complex_derivative f a = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_ARITH `&0 < x / &12 <=> &0 < x`; COMPLEX_NORM_NZ] THEN DISCH_TAC THEN SUBGOAL_THEN `ball(a:complex,t) SUBSET s` ASSUME_TAC THENL [MP_TAC(ISPECL [`ball(a:complex,t)`; `s:complex->bool`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_BALL; SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN MATCH_MP_TAC(TAUT `~p /\ r ==> (~p /\ ~q ==> ~r) ==> q`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL]; REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_BALL] THEN ASM_MESON_TAC[REAL_NOT_LE]]; ALL_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `a:complex`; `t:real`; `r:real`] BLOCH) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Schottky's theorem. *) (* ------------------------------------------------------------------------- *) let SCHOTTKY = prove (`!f r. f holomorphic_on cball(Cx(&0),&1) /\ norm(f(Cx(&0))) <= r /\ (!z. z IN cball(Cx(&0),&1) ==> ~(f z = Cx(&0) \/ f z = Cx(&1))) ==> !t z. &0 < t /\ t < &1 /\ norm(z) <= t ==> norm(f z) <= exp(pi * exp(pi * (&2 + &2 * r + &12 * t / (&1 - t))))`, let lemma0 = prove (`!f s a. f holomorphic_on s /\ contractible s /\ a IN s /\ (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1))) ==> (?g. g holomorphic_on s /\ norm(g a) <= &1 + norm(f a) / &3 /\ (!z. z IN s ==> f z = ccos(Cx pi * g z)))`, REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED) THEN EXISTS_TAC `\z:complex. g z / Cx pi` THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; PI_NZ; COMPLEX_NORM_DIV; HOLOMORPHIC_ON_DIV; HOLOMORPHIC_ON_CONST; REAL_LE_LDIV_EQ; COMPLEX_NORM_CX; REAL_ABS_PI; PI_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x <= pi + a ==> a * &3 <= n * pi ==> x <= (&1 + n / &3) * pi`)) THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC) in let lemma1 = prove (`!n. 0 < n ==> &0 < &n + sqrt(&n pow 2 - &1)`, MESON_TAC[REAL_LTE_ADD; REAL_OF_NUM_LT; SQRT_POS_LE; REAL_POW_LE_1; REAL_SUB_LE; REAL_OF_NUM_LE; LE_1]) in let lemma2 = prove (`!x. &0 <= x ==> ?n. 0 < n /\ abs(x - log(&n + sqrt(&n pow 2 - &1)) / pi) < &1 / &2`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\n. 0 < n /\ log(&n + sqrt(&n pow 2 - &1)) / pi <= x` num_MAX) THEN SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `1` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[ARITH; SQRT_0; REAL_ADD_RID; LOG_1] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPEC `exp(x * pi)` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SIMP_TAC[REAL_LE_LDIV_EQ; PI_POS] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[lemma1; EXP_LOG] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN MATCH_MP_TAC(REAL_ARITH `e <= n /\ &0 <= x ==> m + x <= e ==> m <= n`) THEN ASM_SIMP_TAC[SQRT_POS_LE; REAL_POW_LE_1; REAL_SUB_LE; REAL_OF_NUM_LE; LE_1]; DISCH_THEN(X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) (MP_TAC o SPEC `n + 1`))) THEN REWRITE_TAC[ARITH_RULE `~(n + 1 <= n) /\ 0 < n + 1`] THEN REWRITE_TAC[REAL_NOT_LE; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x < b /\ a <= x ==> b - a < &1 ==> abs(x - a) < &1 / &2 \/ abs(x - b) < &1 / &2`)) THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `0 < n + 1`]] THEN REWRITE_TAC[REAL_ARITH `x / pi - y / pi = (x - y) / pi`] THEN SIMP_TAC[PI_POS; REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&3` THEN CONJ_TAC THENL [ALL_TAC; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC] THEN ASM_SIMP_TAC[lemma1; GSYM LOG_DIV; ARITH_RULE `0 < n + 1`] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `0 < n ==> n = 1 \/ 2 <= n`)) THENL [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_0; REAL_ADD_RID; REAL_DIV_1] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN SIMP_TAC[EXP_LOG; REAL_LTE_ADD; SQRT_POS_LE; REAL_POS; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 + &3` THEN SIMP_TAC[REAL_EXP_LE_X; REAL_POS] THEN REWRITE_TAC[REAL_ARITH `&2 + s <= a <=> s <= a - &2`] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `log(&2)` THEN CONJ_TAC THENL [MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_SIMP_TAC[lemma1; ARITH_RULE `0 < n + 1`; REAL_LT_DIV; REAL_LE_LDIV_EQ] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= n /\ s <= &2 * t ==> (n + &1) + s <= &2 * (n + t)`) THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_1] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_POW_LE_1; REAL_ARITH `&1 <= &n + &1`; REAL_ARITH `&0 <= &2 * x <=> &0 <= x`; REAL_POW_MUL; SQRT_POW_2; REAL_LE_MUL; REAL_POS; SQRT_POS_LE; REAL_OF_NUM_LE; LE_1] THEN MATCH_MP_TAC(REAL_ARITH `&2 <= n /\ &2 * n <= n * n ==> (n + &1) pow 2 - &1 <= &2 pow 2 * (n pow 2 - &1)`) THEN ASM_SIMP_TAC[REAL_LE_RMUL; REAL_OF_NUM_LE; LE_0]; ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 + &3` THEN SIMP_TAC[REAL_EXP_LE_X; REAL_POS] THEN REAL_ARITH_TAC]]]) in let lemma3 = prove (`!z. z IN ({complex(m,log(&n + sqrt(&n pow 2 - &1)) / pi) | integer m /\ 0 < n} UNION {complex(m,--log(&n + sqrt(&n pow 2 - &1)) / pi) | integer m /\ 0 < n}) ==> ccos(Cx(pi) * ccos(Cx pi * z)) = Cx(&1) \/ ccos(Cx(pi) * ccos(Cx pi * z)) = --Cx(&1)`, REWRITE_TAC[COMPLEX_RING `x = Cx(&1) \/ x = --Cx(&1) <=> Cx(&1) - x pow 2 = Cx(&0)`] THEN REWRITE_TAC[COMPLEX_POW_EQ_0; ARITH_EQ; CSIN_EQ_0; REWRITE_RULE[COMPLEX_RING `s pow 2 + c pow 2 = Cx(&1) <=> Cx(&1) - c pow 2 = s pow 2`] CSIN_CIRCLE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[CX_MUL] THEN REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL; CX_INJ; PI_NZ] THEN REWRITE_TAC[IN_UNION; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[complex_mul; RE; IM; RE_CX; IM_CX; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; PI_NZ; REAL_ADD_RID; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[ccos; COMPLEX_MUL_LNEG; CEXP_NEG] THEN CONJ_TAC THENL [ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(e = Cx(&0)) ==> ((e + inv e) / Cx(&2) = n <=> inv e pow 2 - Cx(&2) * n * inv e + Cx(&1) = Cx(&0))`]; ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(e = Cx(&0)) ==> ((e + inv e) / Cx(&2) = n <=> e pow 2 - Cx(&2) * n * e + Cx(&1) = Cx(&0))`]] THEN SIMP_TAC[COMPLEX_TRAD; COMPLEX_RING `ii * (a + ii * b) = --b + ii * a`] THEN REWRITE_TAC[GSYM COMPLEX_TRAD; GSYM CX_NEG; CEXP_COMPLEX] THEN SIMP_TAC[REAL_EXP_NEG; EXP_LOG; lemma1] THEN SIMP_TAC[SIN_INTEGER_PI; REAL_INV_INV] THEN REWRITE_TAC[COMPLEX_TRAD; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_MUL; GSYM CX_ADD; GSYM CX_ADD; GSYM CX_SUB; GSYM CX_INV; CX_INJ] THEN REWRITE_TAC[REAL_INV_MUL; REAL_INV_INV; REAL_POW_MUL] THEN ONCE_REWRITE_TAC[GSYM COS_ABS] THEN REWRITE_TAC[REAL_ABS_MUL] THEN MAP_EVERY X_GEN_TAC [`i:real`; `n:num`] THEN REWRITE_TAC[integer] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) ASSUME_TAC) THEN REWRITE_TAC[GSYM integer] THEN REWRITE_TAC[real_abs; PI_POS_LE] THEN REWRITE_TAC[COS_NPI; REAL_POW_INV; REAL_POW_POW] THEN REWRITE_TAC[REAL_POW_NEG; EVEN_MULT; ARITH; REAL_POW_ONE] THEN (ASM_CASES_TAC `EVEN m` THEN ASM_REWRITE_TAC[REAL_INV_NEG; REAL_INV_1; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `a - &2 * n * x * --(&1) = a - &2 * --n * x`] THENL [EXISTS_TAC `&n:real`; EXISTS_TAC `--(&n):real`] THEN REWRITE_TAC[REAL_NEG_NEG; REAL_RING `(n + s) pow 2 - &2 * n * (n + s) + &1 = &0 <=> s pow 2 = n pow 2 - &1`] THEN SIMP_TAC[INTEGER_CLOSED] THEN MATCH_MP_TAC SQRT_POW_2 THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; LE_1])) in REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\z:complex. Cx(&2) * f z - Cx(&1)`; `cball(Cx(&0),&1)`; `Cx(&0)`] lemma0) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; CENTRE_IN_CBALL; REAL_POS; COMPLEX_RING `Cx(&2) * z - Cx(&1) = Cx(&1) <=> z = Cx(&1)`; COMPLEX_RING `Cx(&2) * z - Cx(&1) = --Cx(&1) <=> z = Cx(&0)`; CONVEX_IMP_CONTRACTIBLE; CONVEX_CBALL] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h:complex->complex`; `cball(Cx(&0),&1)`; `Cx(&0)`] lemma0) THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_POS; CONVEX_IMP_CONTRACTIBLE; CONVEX_CBALL] THEN ANTS_TAC THENL [X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN ASM_REWRITE_TAC[COMPLEX_MUL_RID; COMPLEX_MUL_RNEG; CCOS_NEG; GSYM CX_COS; COS_PI; CX_NEG] THEN CONV_TAC COMPLEX_RING; DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)] THEN MAP_EVERY UNDISCH_TAC [`!z. z IN cball (Cx(&0),&1) ==> Cx(&2) * f z - Cx(&1) = ccos(Cx pi * h z)`; `!z. z IN cball(Cx(&0),&1) ==> h z = ccos(Cx pi * g z)`] THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN SUBGOAL_THEN `norm(g(Cx(&0)):complex) <= &2 + norm(f(Cx(&0)):complex)` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `h <= p ==> p / &3 <= &1 + f ==> &1 + h / &3 <= &2 + f`)) THEN MP_TAC(ISPEC `&1` COMPLEX_NORM_CX) THEN REWRITE_TAC[GSYM COMPLEX_CMUL] THEN CONV_TAC NORM_ARITH; MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`h holomorphic_on cball(Cx(&0),&1)`; `norm(g(Cx(&0)):complex) <= &1 + norm(h(Cx(&0)):complex) / &3`; `norm(h(Cx(&0)):complex) <= &1 + norm(Cx(&2) * f(Cx(&0)) - Cx(&1)) / &3`]] THEN MAP_EVERY X_GEN_TAC [`t:real`; `z:complex`] THEN STRIP_TAC THEN SUBGOAL_THEN `z IN ball(Cx(&0),&1)` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_IN_BALL_0] THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL))] THEN SUBGOAL_THEN `norm(g(z) - g(Cx(&0))) <= &12 * t / (&1 - t)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `g':complex->complex`) THEN MP_TAC(ISPECL [`g:complex->complex`; `g':complex->complex`; `linepath(Cx(&0),z)`; `cball(Cx(&0),&1)`] PATH_INTEGRAL_PRIMITIVE) THEN ASM_REWRITE_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_SIMP_TAC[CONVEX_CONTAINS_SEGMENT_IMP; CONVEX_CBALL] THEN REWRITE_TAC[CENTRE_IN_CBALL; REAL_POS] THEN DISCH_THEN(MP_TAC o SPEC `&12 / (&1 - t)` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_BOUND_LINEPATH)) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_SUB_LT; REAL_LT_IMP_LE] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MP_TAC(ISPECL [`Cx(&0)`; `z:complex`; `w:complex`] SEGMENT_BOUND) THEN ASM_REWRITE_TAC[COMPLEX_SUB_RZERO] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:complex->complex`; `cball(Cx(&0),&1)`; `w:complex`; `&1 - t`; `&1`] BLOCH_COROLLARY) THEN ASM_REWRITE_TAC[FRONTIER_CBALL; COMPLEX_IN_CBALL_0; COMPLEX_IN_SPHERE_0] THEN MATCH_MP_TAC(TAUT `p /\ q /\ ~s /\ (~r ==> t) ==> (p /\ q /\ r ==> s) ==> t`) THEN REWRITE_TAC[REAL_NOT_LE] THEN REPEAT CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MAP_EVERY UNDISCH_TAC [`norm(w:complex) <= norm(z:complex)`; `norm(z:complex) <= t`] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC(SET_RULE `!t u. (!b. (?w. w IN t /\ w IN ball(b,&1)) \/ (?w. w IN u /\ w IN ball(b,&1))) /\ (!x. x IN d ==> ~(g x IN t UNION u)) ==> ~(?b. ball(b,&1) SUBSET IMAGE g d)`) THEN MAP_EVERY EXISTS_TAC [`{ complex(m,log(&n + sqrt(&n pow 2 - &1)) / pi) | integer m /\ 0 < n}`; `{ complex(m,--log(&n + sqrt(&n pow 2 - &1)) / pi) | integer m /\ 0 < n}`] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN CONJ_TAC THENL [X_GEN_TAC `b:complex` THEN REWRITE_TAC[OR_EXISTS_THM] THEN MP_TAC(ISPEC `Re b` INTEGER_ROUND) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_BALL] THEN DISJ_CASES_TAC(REAL_ARITH `&0 <= Im b \/ &0 <= --(Im b)`) THENL [MP_TAC(SPEC `Im b` lemma2); MP_TAC(SPEC `--(Im b)` lemma2)] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [DISJ1_TAC; DISJ2_TAC] THEN REWRITE_TAC[dist] THEN W(MP_TAC o PART_MATCH lhand COMPLEX_NORM_LE_RE_IM o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC(REAL_ARITH `x <= &1 / &2 /\ y < &1 / &2 ==> x + y < &1`) THEN ASM_REWRITE_TAC[RE_SUB; IM_SUB; RE; IM] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `v:complex` THEN DISCH_TAC THEN DISCH_THEN(DISJ_CASES_TAC o MATCH_MP lemma3) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:complex`)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING]; REWRITE_TAC[REAL_ARITH `a * c / &12 < &1 <=> c * a < &12`] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN MATCH_MP_TAC (NORM_ARITH `x = y ==> norm(x) < d ==> norm(y) <= d`) THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`g:complex->complex`; `w:complex`] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL [MESON_TAC[complex_differentiable]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `!s. (g has_complex_derivative g') (at x within s) /\ ((g has_complex_derivative g') (at x within s) <=> (g has_complex_derivative g') (at x)) ==> (g has_complex_derivative g') (at x)`) THEN EXISTS_TAC `cball(Cx(&0),&1)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_IN_CBALL_0] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN; HAS_COMPLEX_DERIVATIVE_AT] THEN MATCH_MP_TAC LIM_WITHIN_INTERIOR THEN REWRITE_TAC[INTERIOR_CBALL; COMPLEX_IN_BALL_0] THEN ASM_REAL_ARITH_TAC]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ONCE_REWRITE_TAC[REAL_ARITH `&12 * t / s = &12 / s * t`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_SUB_LT; REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[COMPLEX_SUB_RZERO]]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_RING `y = (Cx(&1) + (Cx(&2) * y - Cx(&1))) / Cx(&2)`] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN W(MP_TAC o PART_MATCH lhand NORM_CCOS_PLUS1_LE o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS; REAL_EXP_MONO_LE; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_PI] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[PI_POS_LE] THEN W(MP_TAC o PART_MATCH lhand NORM_CCOS_LE o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_EXP_MONO_LE; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_PI] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[PI_POS_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `norm(z - w) <= c ==> norm w <= a + b ==> norm z <= a + b + c`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN UNDISCH_TAC `norm(f(Cx(&0)):complex) <= r` THEN CONV_TAC NORM_ARITH]);; (* ------------------------------------------------------------------------- *) (* The Little Picard Theorem. *) (* ------------------------------------------------------------------------- *) let LANDAU_PICARD = prove (`?R. (!z. &0 < R z) /\ !f. f holomorphic_on cball(Cx(&0),R(f(Cx(&0)))) /\ (!z. z IN cball(Cx(&0),R(f(Cx(&0)))) ==> ~(f(z) = Cx(&0)) /\ ~(f(z) = Cx(&1))) ==> norm(complex_derivative f (Cx(&0))) < &1`, ABBREV_TAC `R = \z:complex. &3 * exp(pi * exp(pi * (&2 + &2 * norm(z) + &12)))` THEN EXISTS_TAC `R:complex->real` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [EXPAND_TAC "R" THEN REWRITE_TAC[REAL_EXP_POS_LT; REAL_ARITH `&0 < &3 * x <=> &0 < x`]; DISCH_TAC] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `r = (R:complex->real)(f(Cx(&0)))` THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `g = \z. (f:complex->complex)(Cx r * z)` THEN SUBGOAL_THEN `!z. z IN cball(Cx(&0),&1) ==> (Cx r * z) IN cball(Cx(&0),r)` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_IN_CBALL_0; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < r ==> (abs r * z <= r <=> r * z <= r * &1)`]; ALL_TAC] THEN SUBGOAL_THEN `g holomorphic_on cball(Cx(&0),&1)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]; ALL_TAC] THEN MP_TAC(ISPECL [`g:complex->complex`; `norm(f(Cx(&0)):complex)`] SCHOTTKY) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_MUL_RZERO; REAL_LE_REFL] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &2`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC(ASSUME `(R:complex->real)(f(Cx(&0))) = r`) THEN EXPAND_TAC "R" THEN SIMP_TAC[REAL_ARITH `&3 * x = r <=> x = r / &3`] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPECL [`g:complex->complex`; `Cx(&0)`; `&1 / &2`; `r / &3`; `1`] CAUCHY_INEQUALITY) THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_1] THEN ASM_SIMP_TAC[COMPLEX_SUB_LZERO; NORM_NEG; REAL_EQ_IMP_LE] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `complex_derivative g (Cx(&0)) = Cx r * complex_derivative f (Cx(&0))` SUBST1_TAC THENL [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN CONJ_TAC THENL [COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; HOLOMORPHIC_ON_SUBSET]; REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < r ==> (abs r * z <= &1 * r / &3 / (&1 / &2) <=> r * z <= r * &2 / &3)`] THEN REAL_ARITH_TAC]);; let LITTLE_PICARD = prove (`!f a b. f holomorphic_on (:complex) /\ ~(a = b) /\ IMAGE f (:complex) INTER {a,b} = {} ==> ?c. f = \x. c`, let lemma = prove (`!f. f holomorphic_on (:complex) /\ (!z. ~(f z = Cx(&0)) /\ ~(f z = Cx(&1))) ==> ?c. f = \x. c`, X_CHOOSE_THEN `R:complex->real` MP_TAC LANDAU_PICARD THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `(:complex)`] HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN REWRITE_TAC[IN_UNIV; FUN_EQ_THM; CONNECTED_UNIV; OPEN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `complex_derivative f w = Cx(&0)` THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_UNIV; IN_UNIV]; MATCH_MP_TAC(TAUT `F ==> p`)] THEN FIRST_X_ASSUM(MP_TAC o SPEC `\z. (f:complex->complex)(w + z / complex_derivative f w)`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]] THEN REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC; SUBGOAL_THEN `complex_derivative (\z. f (w + z / complex_derivative f w)) (Cx(&0)) = complex_derivative f w * inv(complex_derivative f w)` SUBST1_TAC THENL [ALL_TAC; ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_LT_REFL]] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN CONJ_TAC THENL [COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_MUL_LID; complex_div]; REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_UNIV; IN_UNIV]]]) in REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x:complex. Cx(&1) / (b - a) * (f x - b) + Cx(&1)` lemma) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST] THEN ASM_SIMP_TAC[FUN_EQ_THM; COMPLEX_FIELD `~(a = b) ==> (Cx(&1) / (b - a) * (f - b) + Cx(&1) = c <=> f = b + (b - a) / Cx(&1) * (c - Cx(&1)))`] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SET_RULE `IMAGE f UNIV INTER t = {} <=> !x. ~(f x IN t)`]) THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[CONTRAPOS_THM; IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* A couple of little applications of Little Picard. *) (* ------------------------------------------------------------------------- *) let HOLOMORPHIC_PERIODIC_FIXPOINT = prove (`!f p. f holomorphic_on (:complex) /\ ~(p = Cx(&0)) /\ (!z. f(z + p) = f(z)) ==> ?x. f(x) = x`, REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z:complex. f(z) - z`; `Cx(&0)`; `p:complex`] LITTLE_PICARD) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; NOT_IMP] THEN REWRITE_TAC[SET_RULE `IMAGE f UNIV INTER {a,b} = {} <=> !x. ~(f x = a) /\ ~(f x = b)`] THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_RING `a - b:complex = c <=> a = b + c`; COMPLEX_ADD_RID] THEN ASM_MESON_TAC[]; REWRITE_TAC[NOT_EXISTS_THM; FUN_EQ_THM] THEN GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC(SPEC `p + p:complex` th) THEN MP_TAC(SPEC `p:complex` th)) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(p = Cx(&0))` THEN CONV_TAC COMPLEX_RING]);; let HOLOMORPHIC_INVOLUTION_POINT = prove (`!f. f holomorphic_on (:complex) /\ ~(?a. f = \x. a + x) ==> ?x. f(f x) = x`, REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!z:complex. ~(f z = z)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. (f(f x) - x) / (f x - x)`; `Cx(&0)`; `Cx(&1)`] LITTLE_PICARD) THEN REWRITE_TAC[NOT_IMP; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[SET_RULE `IMAGE f UNIV INTER {a,b} = {} <=> !x. ~(f x = a) /\ ~(f x = b)`] THEN ASM_SIMP_TAC[FUN_EQ_THM; COMPLEX_FIELD `~(a:complex = b) ==> (x / (a - b) = c <=> x = c * (a - b))`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_SIMP_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_ID] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_LID; COMPLEX_SUB_0] THEN REWRITE_TAC[COMPLEX_RING `x - a:complex = y - a <=> x = y`] THEN ASM_MESON_TAC[]; DISCH_THEN(X_CHOOSE_THEN `c:complex` MP_TAC)] THEN ASM_CASES_TAC `c = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_SUB_0] THEN ASM_CASES_TAC `c = Cx(&1)` THEN ASM_REWRITE_TAC[COMPLEX_RING `ffx - x = Cx(&1) * (fx - x) <=> ffx = fx`] THEN REWRITE_TAC[COMPLEX_RING `ffx - x = c * (fx - x) <=> (ffx - c * fx) = x * (Cx(&1) - c)`] THEN DISCH_TAC THEN MP_TAC(SPECL [`complex_derivative f o f`; `Cx(&0)`; `c:complex`] LITTLE_PICARD) THEN REWRITE_TAC[SET_RULE `IMAGE f UNIV INTER {a,b} = {} <=> !x. ~(f x = a) /\ ~(f x = b)`] THEN ASM_REWRITE_TAC[o_THM; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_MESON_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_UNIV; SUBSET_UNIV; HOLOMORPHIC_ON_SUBSET]; MP_TAC(MATCH_MP MONO_FORALL (GEN `z:complex` (SPECL [`\x:complex. f(f x) - c * f x`; `z:complex`; `complex_derivative f z * (complex_derivative f (f z) - c)`; `Cx(&1) * (Cx(&1) - c)`] COMPLEX_DERIVATIVE_UNIQUE_AT))) THEN ANTS_TAC THENL [REPEAT STRIP_TAC THENL [REWRITE_TAC[COMPLEX_RING `a * (b - c):complex = b * a - c * a`] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; IN_UNIV; OPEN_UNIV]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_RMUL_AT THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_ID]]; DISCH_THEN(fun th -> X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THEN MP_TAC th) THENL [DISCH_THEN(MP_TAC o SPEC `(f:complex->complex) z`); DISCH_THEN(MP_TAC o SPEC `z:complex`)] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(c = Cx(&1))` THEN CONV_TAC COMPLEX_RING]; REWRITE_TAC[FUN_EQ_THM; o_THM] THEN DISCH_THEN(X_CHOOSE_TAC `k:complex`) THEN SUBGOAL_THEN `open(IMAGE (f:complex->complex) (:complex))` ASSUME_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] OPEN_MAPPING_THM) THEN EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; SUBSET_UNIV; IN_UNIV] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\z. complex_derivative f z - k`; `(:complex)`; `IMAGE (f:complex->complex) (:complex)`; `(f:complex->complex) z`] ANALYTIC_CONTINUATION) THEN REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; SUBSET_UNIV; IN_UNIV] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; COMPLEX_SUB_0; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_UNIV; SUBSET_UNIV; HOLOMORPHIC_ON_SUBSET; HOLOMORPHIC_ON_CONST]; MATCH_MP_TAC LIMPT_OF_OPEN THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; DISCH_TAC] THEN MP_TAC(ISPECL [`\x:complex. f x - k * x`; `(:complex)`] HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; IN_UNIV; NOT_IMP] THEN CONJ_TAC THENL [X_GEN_TAC `z:complex` THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = k - k * Cx(&1)`) THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; HOLOMORPHIC_ON_OPEN; OPEN_UNIV; IN_UNIV; complex_differentiable]; COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING]; DISCH_THEN(X_CHOOSE_THEN `l:complex` MP_TAC) THEN REWRITE_TAC[COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th; FUN_EQ_THM])) THEN ASM_CASES_TAC `k = Cx(&1)` THENL [UNDISCH_TAC `!a:complex. ~(!x. k * x + l = a + x)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LID] THEN MESON_TAC[COMPLEX_ADD_SYM]; UNDISCH_TAC `!z:complex. ~(k * z + l = z)` THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(k = Cx(&1)) ==> (k * z + l = z <=> z = l / (Cx(&1) - k))`] THEN MESON_TAC[]]]]);; (* ------------------------------------------------------------------------- *) (* Montel's theorem: a sequence of holomorphic functions uniformly bounded *) (* on compact subsets of an open set S has a subsequence that converges to a *) (* holomorphic function, and converges *uniformly* on compact subsets of S. *) (* ------------------------------------------------------------------------- *) let MONTEL = prove (`!(f:num->complex->complex) p s. open s /\ (!h. h IN p ==> h holomorphic_on s) /\ (!k. compact k /\ k SUBSET s ==> ?b. !h z. h IN p /\ z IN k ==> norm(h z) <= b) /\ (!n. (f n) IN p) ==> ?g r. g holomorphic_on s /\ (!m n:num. m < n ==> r m < r n) /\ (!x. x IN s ==> ((\n. f (r n) x) --> g(x)) sequentially) /\ (!k e. compact k /\ k SUBSET s /\ &0 < e ==> ?N. !n x. n >= N /\ x IN k ==> norm(f (r n) x - g x) < e)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SPEC_TAC(`f:num->complex->complex`,`f:num->complex->complex`) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM GE; dist] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_UNION_COMPACT_SUBSETS) THEN DISCH_THEN(X_CHOOSE_THEN `k:num->complex->bool` (fun th -> FIRST_X_ASSUM(MP_TAC o GEN `i:num `o SPEC `(k:num->complex->bool) i`) THEN STRIP_ASSUME_TAC th)) THEN ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:num->real` THEN DISCH_TAC THEN SUBGOAL_THEN `!(f:num->complex->complex) (i:num). (!n. f n IN p) ==> ?r g. (!m n:num. m < n ==> r m < r n) /\ (!e. &0 < e ==> ?N. !n x. n >= N /\ x IN k i ==> norm((f o r) n x - g x) < e)` MP_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN MP_TAC(ISPECL [`f:num->complex->complex`; `(k:num->complex->bool) i`; `(B:num->real) i`] ARZELA_ASCOLI) THEN ANTS_TAC THENL [ASM_SIMP_TAC[]; MESON_TAC[]] THEN MAP_EVERY X_GEN_TAC [`z:complex`; `e:real`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_CBALL]] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?M. &0 < M /\ !n w. dist(z,w) <= &2 / &3 * r ==> norm((f:num->complex->complex) n w) <= M` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `cball(z:complex,&2 / &3 * r)`) THEN ASM_SIMP_TAC[SUBSET; IN_CBALL; COMPACT_CBALL; NORM_ARITH `dist(a,b) <= &2 / &3 * r ==> dist(a,b) <= r`] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN REWRITE_TAC[GE; LE_REFL] THEN DISCH_TAC THEN EXISTS_TAC `abs(B(N:num)) + &1` THEN REWRITE_TAC[REAL_ARITH `&0 < abs x + &1`] THEN ASM_MESON_TAC[SUBSET; REAL_ARITH `x <= b ==> x <= abs b + &1`]; ALL_TAC] THEN EXISTS_TAC `min (r / &3) ((e * r) / (&6 * M))` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN MAP_EVERY X_GEN_TAC [`n:num`; `y:complex`] THEN STRIP_TAC THEN MP_TAC (ISPECL [`(f:num->complex->complex) n`; `cball(z:complex,&2 / &3 * r)`; `circlepath(z:complex,&2 / &3 * r)`] CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN REWRITE_TAC[CONVEX_CBALL; VALID_PATH_CIRCLEPATH] THEN REWRITE_TAC[PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH] THEN SIMP_TAC[INTERIOR_CBALL; IN_BALL; WINDING_NUMBER_CIRCLEPATH; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_ARITH `&0 < r ==> &0 <= &2 / &3 * r`] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN SIMP_TAC[SUBSET; IN_CBALL; IN_DELETE; IN_ELIM_THM; REAL_LE_REFL; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN ONCE_REWRITE_TAC[TAUT `p ==> ~q <=> q ==> ~p`] THEN SIMP_TAC[FORALL_UNWIND_THM2; IMP_CONJ; REAL_LT_IMP_NE] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; COMPLEX_MUL_LID] THEN ANTS_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[SUBSET; IN_CBALL] THEN ASM_SIMP_TAC[NORM_ARITH `dist(a,b) <= &2 / &3 * r ==> dist(a,b) <= r`]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `y:complex` th) THEN MP_TAC(SPEC `z:complex` th)) THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NORM_ARITH `norm(z - y) < r / &3 ==> norm(y - z) < &2 / &3 * r`] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH)) THEN REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_II; COMPLEX_NORM_CX; REAL_ABS_PI; REAL_ABS_NUM; REAL_MUL_LID] THEN DISCH_THEN(MP_TAC o SPEC `e / r:real`) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < r ==> e / r * &2 * pi * c * r = &2 * pi * e * c`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; PI_POS] THEN ANTS_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_LT_MUL] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `~(w:complex = z) /\ ~(w = y)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[NORM_0; VECTOR_SUB_REFL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[NORM_SUB]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(w:complex = z) /\ ~(w = y) ==> (a / (w - z) - a / (w - y) = (a * (z - y)) / ((w - z) * (w - y)))`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT; VECTOR_SUB_EQ; REAL_FIELD `&0 < r ==> e / r * (&2 / &3 * r) * x = &2 / &3 * e * x`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `M * (e * r) / (&6 * M)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[NORM_ARITH `dist(x,y) = norm(y - x)`; REAL_LE_REFL]; ASM_SIMP_TAC[REAL_FIELD `&0 < M ==> M * e / (&6 * M) = e / &6`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x <= y * &3 ==> x / &6 <= &2 / &3 * y`) THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN MAP_EVERY UNDISCH_TAC [`norm(w - z:complex) = &2 / &3 * r`; `norm(z - y:complex) < r / &3`] THEN CONV_TAC NORM_ARITH]; ALL_TAC] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN DISCH_THEN(fun th -> X_GEN_TAC `f:num->complex->complex` THEN DISCH_TAC THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o GENL [`i:num`; `r:num->num`] o SPECL [`(f:num->complex->complex) o (r:num->num)`; `i:num`]) THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV o ONCE_DEPTH_CONV) [o_THM] THEN ASM_REWRITE_TAC[GSYM o_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUBSEQUENCE_DIAGONALIZATION_LEMMA)) THEN ANTS_TAC THENL [SIMP_TAC[o_THM; GE] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `MAX M N` THEN REWRITE_TAC[ARITH_RULE `MAX m n <= x <=> m <= x /\ n <= x`] THEN ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `I:num->num`) THEN REWRITE_TAC[I_O_ID; RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!x. x IN s ==> ?l. !e. &0 < e ==> ?N:num. !n. n >= N ==> norm((f:num->complex->complex) (r n) x - l) < e` MP_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{z:complex}`) THEN ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN DISCH_THEN(X_CHOOSE_THEN `G:num->complex->complex` MP_TAC) THEN DISCH_THEN(LABEL_TAC "*" o SPEC `N:num`) THEN EXISTS_TAC `(G:num->complex->complex) N z` THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `MAX M N` THEN REWRITE_TAC[ARITH_RULE `a >= MAX m n <=> a >= m /\ a >= n`] THEN ASM_MESON_TAC[GE_REFL]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`t:complex->bool`; `e:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:complex->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `h:complex->complex` (LABEL_TAC "*") o SPEC `N:num`) THEN SUBGOAL_THEN `!w. w IN t ==> g w = (h:complex->complex) w` (fun th -> ASM_MESON_TAC[GE_REFL; SUBSET; th]) THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (f:num->complex->complex)(r n) w` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SEQUENTIALLY] THEN REWRITE_TAC[GSYM GE; dist; o_THM] THEN ASM_MESON_TAC[SUBSET; GE_REFL]; DISCH_THEN(LABEL_TAC "*")] THEN MATCH_MP_TAC HOLOMORPHIC_UNIFORM_SEQUENCE THEN EXISTS_TAC `(f:num->complex->complex) o (r:num->num)` THEN ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[COMPACT_CBALL; GE]);; (* ------------------------------------------------------------------------- *) (* Moebius functions are biholomorphisms of the unit disc. *) (* ------------------------------------------------------------------------- *) let moebius_function = new_definition `!t w z. moebius_function t w z = cexp(ii * Cx t) * (z - w) / (Cx(&1) - cnj w * z)`;; let MOEBIUS_FUNCTION_SIMPLE = prove (`!w z. moebius_function (&0) w z = (z - w) / (Cx(&1) - cnj w * z)`, REWRITE_TAC[moebius_function; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_MUL_LID]);; let MOEBIUS_FUNCTION_EQ_ZERO = prove (`!t w. moebius_function t w w = Cx(&0)`, REWRITE_TAC [moebius_function] THEN CONV_TAC COMPLEX_FIELD);; let MOEBIUS_FUNCTION_OF_ZERO = prove (`!t w. moebius_function t w (Cx(&0)) = -- cexp(ii * Cx t) * w`, REWRITE_TAC [moebius_function] THEN CONV_TAC COMPLEX_FIELD);; let MOEBIUS_FUNCTION_NORM_LT_1 = prove (`!t w z. norm w < &1 /\ norm z < &1 ==> norm (moebius_function t w z) < &1`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a. &0 <= a /\ &0 < &1 - a pow 2 ==> a < &1` MATCH_MP_TAC THENL [GEN_TAC THEN ASM_CASES_TAC `&0 <= a` THEN ASM_REWRITE_TAC [REAL_FIELD `&1 - a pow 2 = (&1 - a) * (&1 + a)`; REAL_MUL_POS_LT] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC [NORM_POS_LE] THEN SUBGOAL_THEN `~(Cx(&1) - cnj w * z = Cx(&0))` ASSUME_TAC THENL [REWRITE_TAC [COMPLEX_SUB_0] THEN SUBGOAL_THEN `~(norm (Cx(&1)) = norm (cnj w * z))` (fun th -> MESON_TAC [th]) THEN REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ] THEN MATCH_MP_TAC (REAL_ARITH `a * b < &1 ==> ~(&1 = a * b)`) THEN STRIP_ASSUME_TAC (NORM_ARITH `norm (z:complex) = &0 \/ &0 < norm z`) THENL [ASM_REWRITE_TAC [REAL_MUL_RZERO; REAL_LT_01]; MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (z:complex)` THEN ASM_SIMP_TAC[REAL_LT_RMUL; REAL_MUL_LID]]; ALL_TAC] THEN SUBGOAL_THEN `&1 - norm (moebius_function t w z) pow 2 = ((&1 - norm w pow 2) / (norm (Cx(&1) - cnj w * z) pow 2)) * (&1 - norm z pow 2)` SUBST1_TAC THENL [REWRITE_TAC [moebius_function; GSYM CX_INJ; CX_SUB; CX_MUL; CX_DIV; CX_POW; CNJ_SUB; CNJ_CX; CNJ_MUL; CNJ_DIV; CNJ_CNJ; COMPLEX_NORM_POW_2] THEN SUBGOAL_THEN `cnj (cexp(ii * Cx t)) * (cexp(ii * Cx t)) = Cx(&1) /\ ~(Cx(&1) - cnj w * z = Cx(&0)) /\ ~(Cx(&1) - w * cnj z = Cx(&0))` MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN REWRITE_TAC [CNJ_CEXP; CNJ_MUL; CNJ_II; CNJ_CX; COMPLEX_MUL_LNEG; CEXP_NEG_LMUL] THEN ASM_REWRITE_TAC [] THEN SUBGOAL_THEN `~(cnj (Cx(&1) - cnj w * z) = Cx(&0))` MP_TAC THENL [ASM_REWRITE_TAC [CNJ_EQ_0]; REWRITE_TAC [CNJ_SUB; CNJ_CX; CNJ_MUL; CNJ_CNJ]]; SUBGOAL_THEN `!u:complex. norm u < &1 ==> &0 < &1 - norm u pow 2` ASSUME_TAC THENL [REWRITE_TAC [REAL_FIELD `!a. &1 - a pow 2 = (&1 - a) * (&1 + a)`] THEN ASM_SIMP_TAC [REAL_LT_MUL; REAL_SUB_LT; REAL_LTE_ADD; REAL_LT_01; NORM_POS_LE]; SUBGOAL_THEN `&0 < norm (Cx(&1) - cnj w * z) pow 2` (fun th -> ASM_MESON_TAC [th; REAL_LT_MUL; REAL_LT_DIV]) THEN ASM_REWRITE_TAC [REAL_RING `!a:real. a pow 2 = a * a`; REAL_LT_SQUARE; COMPLEX_NORM_ZERO]]]);; let MOEBIUS_FUNCTION_HOLOMORPHIC = prove (`!t w. norm w < &1 ==> moebius_function t w holomorphic_on ball(Cx(&0),&1)`, let LEMMA_1 = prove (`!a b:complex. norm a < &1 /\ norm b < &1 ==> ~(Cx(&1) - a * b = Cx(&0))`, GEN_TAC THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [COMPLEX_SUB_0] THEN SUBGOAL_THEN `~(norm (Cx(&1)) = norm (a * b))` (fun th -> MESON_TAC[th]) THEN REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC (REAL_ARITH `!x y. y < x ==> ~(x = y)`) THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC [COMPLEX_NORM_NUM; REAL_MUL_RZERO; REAL_LT_01] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (b:complex)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC [COMPLEX_NORM_NZ]; ASM_REWRITE_TAC [REAL_MUL_LID]]) in REPEAT STRIP_TAC THEN SUBST1_TAC (GSYM (ISPEC `moebius_function t w` ETA_AX)) THEN REWRITE_TAC [moebius_function] THEN MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC (REWRITE_RULE [o_DEF] HOLOMORPHIC_ON_COMPOSE_GEN) THEN EXISTS_TAC `(:complex)` THEN REWRITE_TAC [HOLOMORPHIC_ON_CEXP; IN_UNIV] THEN SIMP_TAC [HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST]; MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_MUL] THEN ASM_SIMP_TAC[COMPLEX_IN_BALL_0; LEMMA_1; COMPLEX_NORM_CNJ]]);; let MOEBIUS_FUNCTION_COMPOSE = prove (`!w1 w2 z. -- w1 = w2 /\ norm w1 < &1 /\ norm z < &1 ==> moebius_function (&0) w1 (moebius_function (&0) w2 z) = z`, let LEMMA_1 = prove (`!a b:complex. norm a < &1 /\ norm b < &1 ==> ~(Cx(&1) - a * b = Cx(&0))`, GEN_TAC THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [COMPLEX_SUB_0] THEN SUBGOAL_THEN `~(norm (Cx(&1)) = norm (a * b))` (fun th -> MESON_TAC[th]) THEN REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC (REAL_ARITH `!x y. y < x ==> ~(x = y)`) THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC [COMPLEX_NORM_NUM; REAL_MUL_RZERO; REAL_LT_01] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (b:complex)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC [COMPLEX_NORM_NZ]; ASM_REWRITE_TAC [REAL_MUL_LID]]) in let LEMMA_1_ALT = prove (`!a b:complex. norm a < &1 /\ norm b < &1 ==> ~(Cx(&1) + a * b = Cx(&0))`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBST1_TAC (COMPLEX_RING `a : complex = -- (-- a)`) THEN ABBREV_TAC `u : complex= -- a` THEN REWRITE_TAC [COMPLEX_MUL_LNEG; GSYM complex_sub] THEN MATCH_MP_TAC LEMMA_1 THEN EXPAND_TAC "u" THEN ASM_REWRITE_TAC[NORM_NEG]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `norm (w2:complex) < &1` ASSUME_TAC THENL [EXPAND_TAC "w2" THEN ASM_REWRITE_TAC [NORM_NEG]; ALL_TAC] THEN REWRITE_TAC [moebius_function; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_MUL_LID] THEN MATCH_MP_TAC (COMPLEX_FIELD `!a b c. ~(b = Cx(&0)) /\ a = b * c ==> a / b = c`) THEN CONJ_TAC THENL [ALL_TAC; MP_TAC (SPECL [`cnj w2`;`z:complex`] LEMMA_1) THEN ASM_REWRITE_TAC [COMPLEX_NORM_CNJ] THEN EXPAND_TAC "w2" THEN REWRITE_TAC [CNJ_NEG] THEN CONV_TAC COMPLEX_FIELD] THEN MATCH_MP_TAC (COMPLEX_FIELD `!a b c d. ~(d = Cx(&0)) /\ ~(d * a - b * c = Cx(&0)) ==> ~(a - b * c / d = Cx(&0))`) THEN ASM_SIMP_TAC [LEMMA_1; COMPLEX_NORM_CNJ] THEN ASM_REWRITE_TAC [COMPLEX_MUL_RID] THEN SUBGOAL_THEN `Cx(&1) - cnj w2 * z - cnj w1 * (z - w2) = Cx(&1) + cnj w1 * w2` SUBST1_TAC THENL [EXPAND_TAC "w2" THEN REWRITE_TAC [CNJ_NEG] THEN CONV_TAC COMPLEX_RING; ASM_SIMP_TAC [LEMMA_1_ALT; COMPLEX_NORM_CNJ]]);; let BALL_BIHOLOMORPHISM_EXISTS = prove (`!a. a IN ball(Cx(&0),&1) ==> ?f g. f(a) = Cx(&0) /\ f holomorphic_on ball (Cx(&0),&1) /\ (!z. z IN ball (Cx(&0),&1) ==> f z IN ball (Cx(&0),&1)) /\ g holomorphic_on ball (Cx(&0),&1) /\ (!z. z IN ball (Cx(&0),&1) ==> g z IN ball (Cx(&0),&1)) /\ (!z. z IN ball (Cx(&0),&1) ==> f (g z) = z) /\ (!z. z IN ball (Cx(&0),&1) ==> g (f z) = z)`, REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `moebius_function (&0) a` THEN EXISTS_TAC `moebius_function (&0) (--a)` THEN ASM_SIMP_TAC[COMPLEX_IN_BALL_0; MOEBIUS_FUNCTION_COMPOSE; COMPLEX_NEG_NEG; NORM_NEG] THEN ASM_SIMP_TAC[MOEBIUS_FUNCTION_NORM_LT_1; NORM_NEG; MOEBIUS_FUNCTION_HOLOMORPHIC; MOEBIUS_FUNCTION_EQ_ZERO]);; let BALL_BIHOLOMORPHISM_MOEBIUS_FUNCTION = prove (`!f g. f holomorphic_on ball (Cx(&0),&1) /\ (!z. z IN ball (Cx(&0),&1) ==> f z IN ball (Cx(&0),&1)) /\ g holomorphic_on ball (Cx(&0),&1) /\ (!z. z IN ball (Cx(&0),&1) ==> g z IN ball (Cx(&0),&1)) /\ (!z. z IN ball (Cx(&0),&1) ==> f (g z) = z) /\ (!z. z IN ball (Cx(&0),&1) ==> g (f z) = z) ==> ?t w. w IN ball (Cx(&0),&1) /\ (!z. z IN ball (Cx(&0),&1) ==> f z = moebius_function t w z)`, let LEMMA_1 = prove (`!a b:complex. norm a < &1 /\ norm b < &1 ==> ~(Cx(&1) - a * b = Cx(&0))`, GEN_TAC THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [COMPLEX_SUB_0] THEN SUBGOAL_THEN `~(norm (Cx(&1)) = norm (a * b))` (fun th -> MESON_TAC[th]) THEN REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC (REAL_ARITH `!x y. y < x ==> ~(x = y)`) THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC [COMPLEX_NORM_NUM; REAL_MUL_RZERO; REAL_LT_01] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (b:complex)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC [COMPLEX_NORM_NZ]; ASM_REWRITE_TAC [REAL_MUL_LID]]) in let LEMMA_2 = prove (`!t w s z. norm w < &1 /\ norm z < &1 ==> moebius_function t w (cexp(ii * Cx s) * z) = moebius_function (t + s) (cexp(-- (ii * Cx s)) * w) z`, REPEAT STRIP_TAC THEN REWRITE_TAC[moebius_function; CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD; GSYM COMPLEX_MUL_ASSOC; COMPLEX_EQ_MUL_LCANCEL; CEXP_NZ; CNJ_MUL] THEN MATCH_MP_TAC (COMPLEX_FIELD `!a b c d e. ~(b = Cx(&0)) /\ ~(e = Cx(&0)) /\ e * a = b * c * d ==> a / b = c * d / e`) THEN CONJ_TAC THENL [MATCH_MP_TAC LEMMA_1 THEN ASM_REWRITE_TAC [COMPLEX_NORM_CNJ; COMPLEX_NORM_MUL; NORM_CEXP_II; REAL_MUL_LID]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC [COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LEMMA_1 THEN ASM_REWRITE_TAC [COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; COMPLEX_NEG_RMUL; GSYM CX_NEG; NORM_CEXP_II; REAL_MUL_LID]; REWRITE_TAC [CNJ_CEXP; CNJ_NEG; CNJ_MUL; CNJ_II; CNJ_CX; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG; CEXP_NEG] THEN ABBREV_TAC `a = cexp(ii * Cx s)` THEN SUBGOAL_THEN `inv a * a = Cx(&1)` MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN MATCH_MP_TAC COMPLEX_MUL_LINV THEN EXPAND_TAC "a" THEN REWRITE_TAC [CEXP_NZ]]) in REWRITE_TAC [COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `w:complex = f (Cx(&0))` THEN SUBGOAL_THEN `norm(w:complex) < &1` ASSUME_TAC THENL [ASM_MESON_TAC [COMPLEX_NORM_NUM; REAL_LT_01]; ALL_TAC] THEN SUBGOAL_THEN `?t. !z. z IN ball (Cx(&0),&1) ==> moebius_function (&0) w (f z) = cexp(ii * Cx t) * z` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `t:real` THEN EXISTS_TAC `-- (cexp(-- (ii * Cx t)) * w)` THEN ASM_REWRITE_TAC [NORM_NEG; COMPLEX_NORM_MUL; COMPLEX_NEG_RMUL; GSYM CX_NEG; NORM_CEXP_II; REAL_MUL_LID] THEN GEN_TAC THEN DISCH_TAC THEN EQ_TRANS_TAC `moebius_function (&0) (--w) (moebius_function (&0) w (f (z:complex)))` THENL [MATCH_MP_TAC EQ_SYM THEN MATCH_MP_TAC MOEBIUS_FUNCTION_COMPOSE THEN ASM_SIMP_TAC [COMPLEX_NEG_NEG; NORM_NEG]; ASM_SIMP_TAC[COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[LEMMA_2; NORM_NEG] THEN REWRITE_TAC [REAL_ADD_LID; CX_NEG; COMPLEX_MUL_RNEG]]] THEN MATCH_MP_TAC SECOND_CARTAN_THM_DIM_1 THEN EXISTS_TAC `\z. g (moebius_function (&0) (--w) z) : complex` THEN REWRITE_TAC [COMPLEX_IN_BALL_0] THEN REWRITE_TAC [REAL_LT_01] THEN CONJ_TAC THENL [MATCH_MP_TAC (REWRITE_RULE [o_DEF] HOLOMORPHIC_ON_COMPOSE_GEN) THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_SIMP_TAC [ETA_AX; MOEBIUS_FUNCTION_HOLOMORPHIC; COMPLEX_IN_BALL_0]; ALL_TAC] THEN CONJ_TAC THENL [ASM_SIMP_TAC [MOEBIUS_FUNCTION_NORM_LT_1]; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC [MOEBIUS_FUNCTION_EQ_ZERO]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC (REWRITE_RULE [o_DEF] HOLOMORPHIC_ON_COMPOSE_GEN) THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_SIMP_TAC [COMPLEX_IN_BALL_0; MOEBIUS_FUNCTION_NORM_LT_1; NORM_NEG] THEN ASM_SIMP_TAC [ETA_AX; MOEBIUS_FUNCTION_HOLOMORPHIC; NORM_NEG]; ALL_TAC] THEN CONJ_TAC THENL [ASM_SIMP_TAC [MOEBIUS_FUNCTION_NORM_LT_1; NORM_NEG]; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC [MOEBIUS_FUNCTION_OF_ZERO; COMPLEX_MUL_RZERO; CEXP_0; GSYM COMPLEX_NEG_LMUL; COMPLEX_MUL_LID; COMPLEX_NEG_NEG] THEN ASM_MESON_TAC [COMPLEX_NORM_0; REAL_LT_01]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC [REWRITE_RULE [COMPLEX_NEG_NEG; NORM_NEG] (SPECL [`--w:complex`;`w:complex`] MOEBIUS_FUNCTION_COMPOSE)]] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `f (g (moebius_function (&0) (--w) z) : complex) = (moebius_function (&0) (--w) z)` SUBST1_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC [MOEBIUS_FUNCTION_NORM_LT_1; NORM_NEG]; MATCH_MP_TAC MOEBIUS_FUNCTION_COMPOSE THEN ASM_REWRITE_TAC []]);; (* ------------------------------------------------------------------------- *) (* Some simple but useful cases of Hurwitz's theorem. *) (* ------------------------------------------------------------------------- *) let HURWITZ_NO_ZEROS = prove (`!f:num->complex->complex g s. open s /\ connected s /\ (!n. (f n) holomorphic_on s) /\ g holomorphic_on s /\ (!k e. compact k /\ k SUBSET s /\ &0 < e ==> ?N. !n x. n >= N /\ x IN k ==> norm(f n x - g x) < e) /\ ~(?c. !z. z IN s ==> g z = c) /\ (!n z. z IN s ==> ~(f n z = Cx(&0))) ==> (!z. z IN s ==> ~(g z = Cx(&0)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `z0:complex` THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`g:complex->complex`; `s:complex->bool`; `z0:complex`] HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:complex->complex`; `r:real`; `m:num`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`sequentially`; `\n:num z. complex_derivative (f n) z / f n z`; `\z. complex_derivative g z / g z`; `z0:complex`; `r / &2`] PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH) THEN ASM_REWRITE_TAC[REAL_HALF; TRIVIAL_LIMIT_SEQUENTIALLY; NOT_IMP] THEN SUBGOAL_THEN `!n:num. ((\z. complex_derivative (f n) z / f n z) has_path_integral (Cx(&0))) (circlepath(z0,r / &2))` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC CAUCHY_THEOREM_DISC_SIMPLE THEN MAP_EVERY EXISTS_TAC [`z0:complex`; `r:real`] THEN ASM_SIMP_TAC[VALID_PATH_CIRCLEPATH; PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH; PATH_IMAGE_CIRCLEPATH; REAL_HALF; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN REWRITE_TAC[SUBSET; IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_ARITH `&0 < r ==> r / &2 < r`] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN REWRITE_TAC[OPEN_BALL]; REWRITE_TAC[ETA_AX]; ASM_MESON_TAC[SUBSET]] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[path_integrable_on] THEN ASM_MESON_TAC[]; MATCH_MP_TAC UNIFORM_LIM_COMPLEX_DIV THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; CONJ_ASSOC] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM CONJ_ASSOC] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_HALF; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `IMAGE (complex_derivative g) {w | norm(w - z0) = r / &2}` COMPACT_IMP_BOUNDED) THEN ANTS_TAC THENL [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[o_DEF; REWRITE_RULE[sphere; NORM_ARITH `dist(w:real^N,z) = norm(z - w)`] COMPACT_SPHERE] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH; REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[]]; MP_TAC(ISPEC `IMAGE (norm o (g:complex->complex)) {w | norm(w - z0) = r / &2}` COMPACT_ATTAINS_INF) THEN REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM IMAGE_o; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; o_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[o_DEF; REWRITE_RULE[sphere; NORM_ARITH `dist(w:real^N,z) = norm(z - w)`] COMPACT_SPHERE] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN EXISTS_TAC `z0 + Cx(r / &2)` THEN REWRITE_TAC[VECTOR_ARITH `(a + b) - a:real^N = b`] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(X_CHOOSE_THEN `ww:complex` MP_TAC) THEN STRIP_TAC THEN EXISTS_TAC `norm((g:complex->complex) ww)` THEN ASM_SIMP_TAC[ALWAYS_EVENTUALLY; COMPLEX_NORM_NZ] THEN DISCH_THEN(ASSUME_TAC o REWRITE_RULE[COMPLEX_NORM_ZERO]) THEN UNDISCH_TAC `!w. w IN ball(z0,r) ==> g w = (w - z0) pow m * h w` THEN DISCH_THEN(MP_TAC o SPEC `ww:complex`) THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0] THEN REWRITE_TAC[IN_BALL; GSYM COMPLEX_NORM_ZERO] THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_REAL_ARITH_TAC]; X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`cball(z0:complex,&3 * r / &4)`; `r / &4 * e / &2`]) THEN REWRITE_TAC[COMPACT_CBALL] THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; IN_ELIM_THM] THEN UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH; REWRITE_TAC[GE; EVENTUALLY_SEQUENTIALLY; IN_CBALL; dist] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MP_TAC(ISPECL [`\z. (f:num->complex->complex) n z - g z`; `w:complex`; `Cx(&0)`; `r / &4`; `r / &4 * e / &2`; `1`] CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND) THEN REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_1; COMPLEX_IN_BALL_0] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV] THEN REPEAT CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; X_GEN_TAC `y:complex` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY UNDISCH_TAC [`norm(w - z0:complex) = r / &2`; `dist(w:complex,y) < r / &4`] THEN CONV_TAC NORM_ARITH] THEN (MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; IN_ELIM_THM] THEN UNDISCH_TAC `norm(w - z0:complex) = r / &2` THEN UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH); CONV_TAC NUM_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_FIELD `&0 < r /\ &0 < e ==> &1 * (r / &4 * e / &2) / (r / &4) pow 1 = e / &2`] THEN MATCH_MP_TAC(NORM_ARITH `x = y /\ &0 < e ==> norm(x) <= e / &2 ==> norm(y) < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_REAL_ARITH_TAC]; X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{w:complex | norm(w - z0) = r / &2}`; `e:real`]) THEN ASM_REWRITE_TAC[GE; IN_ELIM_THM; REWRITE_RULE[sphere; NORM_ARITH `dist(w:real^N,z) = norm(z - w)`] COMPACT_SPHERE] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH]; FIRST_ASSUM(ASSUME_TAC o GEN `n:num` o MATCH_MP PATH_INTEGRAL_UNIQUE o SPEC `n:num`) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[LIM_CONST_EQ; TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC(COMPLEX_RING `!q r. p = q /\ q = r /\ ~(r = Cx(&0)) ==> ~(Cx(&0) = p)`) THEN MAP_EVERY EXISTS_TAC [`path_integral (circlepath(z0,r / &2)) (\z. Cx(&m) / (z - z0) + complex_derivative h z / h z)`; `Cx(&2) * Cx pi * ii * Cx(&m)`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_INTEGRAL_EQ THEN X_GEN_TAC `w:complex` THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; IN_ELIM_THM; REAL_HALF; REAL_LT_IMP_LE; sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN ASM_CASES_TAC `w:complex = z0` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN SUBGOAL_THEN `w IN ball(z0:complex,r)` ASSUME_TAC THENL [REWRITE_TAC[IN_BALL] THEN MAP_EVERY UNDISCH_TAC [`norm (w - z0) = r / &2`; `&0 < r`] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN ASM_SIMP_TAC[] THEN ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0; COMPLEX_SUB_0; COMPLEX_FIELD `~(y = Cx(&0)) ==> (x / y = w <=> x = y * w)`] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(h = Cx(&0)) ==> (m * h) * (x + y / h) = m * y + m * h * x`] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\w:complex. (w - z0) pow m * h w` THEN EXISTS_TAC `ball(z0:complex,r)` THEN ASM_SIMP_TAC[OPEN_BALL] THEN SUBGOAL_THEN `(w - z0) pow m * h w * Cx(&m) / (w - z0) = (Cx(&m) * (w - z0) pow (m - 1)) * h w` SUBST1_TAC THENL [MATCH_MP_TAC(COMPLEX_FIELD `w * mm = z /\ ~(w = Cx(&0)) ==> z * h * m / w = (m * mm) * h`) THEN ASM_REWRITE_TAC[COMPLEX_SUB_0; GSYM(CONJUNCT2 complex_pow)] THEN AP_TERM_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN CONJ_TAC THENL [COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING; REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_BALL]]]; GEN_REWRITE_TAC RAND_CONV [GSYM COMPLEX_ADD_RID] THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; HOLOMORPHIC_ON_CONST]; MATCH_MP_TAC CAUCHY_THEOREM_DISC_SIMPLE THEN MAP_EVERY EXISTS_TAC [`z0:complex`; `r:real`] THEN ASM_SIMP_TAC[VALID_PATH_CIRCLEPATH; PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH; PATH_IMAGE_CIRCLEPATH; REAL_HALF; REAL_LT_IMP_LE] THEN REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN REWRITE_TAC[SUBSET; IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_ARITH `&0 < r ==> r / &2 < r`] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[OPEN_BALL]]; REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; PI_NZ; II_NZ; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[LE_1; ARITH_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]]]);; let HURWITZ_INJECTIVE = prove (`!f:num->complex->complex g s. open s /\ connected s /\ (!n. (f n) holomorphic_on s) /\ g holomorphic_on s /\ (!k e. compact k /\ k SUBSET s /\ &0 < e ==> ?N. !n x. n >= N /\ x IN k ==> norm(f n x - g x) < e) /\ ~(?c. !z. z IN s ==> g z = c) /\ (!n w z. w IN s /\ z IN s /\ f n w = f n z ==> w = z) ==> (!w z. w IN s /\ z IN s /\ g w = g z ==> w = z)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`z1:complex`; `z2:complex`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `(g:complex->complex) z2`) THEN REWRITE_TAC[] THEN X_GEN_TAC `z0:complex` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REPEAT DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[MESON[] `(!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) <=> (!x y. x IN s /\ y IN s ==> (g x = g y <=> x = y))`]) THEN MP_TAC(ISPECL [`\z. (g:complex->complex) z - g z1`; `s:complex->bool`; `z2:complex`; `z0:complex`] ISOLATED_ZEROS) THEN ASM_SIMP_TAC[COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\n z. (f:num->complex->complex) n z - f n z1`; `\z. (g:complex->complex) z - g z1`; `s DELETE (z1:complex)`] HURWITZ_NO_ZEROS) THEN REWRITE_TAC[NOT_IMP; COMPLEX_SUB_0] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[OPEN_DELETE]; ASM_SIMP_TAC[CONNECTED_OPEN_DELETE; DIMINDEX_2; LE_REFL]; GEN_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; ETA_AX; HOLOMORPHIC_ON_CONST] THEN SET_TAC[]; MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; ETA_AX; HOLOMORPHIC_ON_CONST] THEN SET_TAC[]; MAP_EVERY X_GEN_TAC [`k:complex->bool`; `e:real`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `k SUBSET s DELETE z ==> k SUBSET s`)) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`k:complex->bool`; `e / &2`] th) THEN MP_TAC(SPECL [`{z1:complex}`; `e / &2`] th)) THEN ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET; REAL_HALF] THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; FORALL_UNWIND_THM2] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `N1:num`) (X_CHOOSE_TAC `N2:num`)) THEN EXISTS_TAC `MAX N1 N2` THEN REPEAT STRIP_TAC THEN UNDISCH_THEN `(g:complex->complex) z1 = g z2` (SUBST1_TAC o SYM) THEN MATCH_MP_TAC(NORM_ARITH `norm(x1 - x2) < e / &2 /\ norm(y1 - y2) < e / &2 ==> norm(x1 - y1 - (x2 - y2)) < e`) THEN ASM_MESON_TAC[ARITH_RULE `x >= MAX m n <=> x >= m /\ x >= n`]; REWRITE_TAC[IN_DELETE; COMPLEX_EQ_SUB_RADD] THEN DISCH_THEN(CHOOSE_THEN (fun th -> MAP_EVERY (MP_TAC o C SPEC th) [`z0:complex`; `z1:complex`; `z2:complex`])) THEN ASM_MESON_TAC[]; REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[]; REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The Great Picard theorem, and a thematic Montel variant. *) (* ------------------------------------------------------------------------- *) let GREAT_PICARD,MONTEL_OMITTING = (CONJ_PAIR o prove) (`(!f n a b z. open n /\ z IN n /\ ~(a = b) /\ f holomorphic_on (n DELETE z) /\ (!w. w IN n DELETE z ==> ~(f w = a) /\ ~(f w = b)) ==> ?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)) /\ (!f:num->complex->complex p s a b. open s /\ connected s /\ ~(a = b) /\ (!h. h IN p ==> h holomorphic_on s /\ !z. z IN s ==> ~(h z = a) /\ ~(h z = b)) /\ (!n. f n IN p) ==> ?r. (!m n. m < n ==> r m < r n) /\ ((!x. x IN s ==> ((\n. inv(f (r n) x)) --> Cx(&0)) sequentially) /\ (!k c. compact k /\ k SUBSET s ==> ?N. !n x. n >= N /\ x IN k ==> c < norm(f (r n) x)) \/ ?g. g holomorphic_on s /\ (!x. x IN s ==> ((\n. f (r n) x) --> g x) sequentially) /\ (!k e. compact k /\ k SUBSET s /\ &0 < e ==> ?N. !n x. n >= N /\ x IN k ==> norm(f (r n) x - g x) < e)))`, let lemma1 = prove (`!p q r s w. open s /\ connected s /\ w IN s /\ &0 < r /\ (!h. h IN p ==> h holomorphic_on s /\ !z. z IN s ==> ~(h z = Cx(&0)) /\ ~(h z = Cx(&1))) /\ (!h. h IN q ==> h IN p /\ norm(h w) <= r) ==> ?B n. &0 < B /\ open n /\ w IN n /\ n SUBSET s /\ !h z. h IN q /\ z IN n ==> norm(h z) <= B`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`exp(pi * exp(pi * (&2 + &2 * r + &12)))`; `ball(w:complex,e / &2)`] THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_HALF] THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`f:complex->complex`; `z:complex`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`)) THEN ASM_CASES_TAC `(f:complex->complex) IN p` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. (f:complex->complex) (w + Cx e * z)`; `r:real`] SCHOTTKY) THEN ASM_REWRITE_TAC[DE_MORGAN_THM; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN ANTS_TAC THENL [CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `u:complex` THEN DISCH_TAC; X_GEN_TAC `u:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(w,w + z) = norm z`] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < e ==> (abs e * u <= e <=> e * u <= e * &1)`] THEN ASM_MESON_TAC[COMPLEX_IN_CBALL_0]; DISCH_THEN(MP_TAC o SPECL [`&1 / &2`; `Cx(inv e) * (z - w)`]) THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN ASM_SIMP_TAC[REAL_MUL_RINV; COMPLEX_NORM_MUL; REAL_LT_IMP_NZ] THEN REWRITE_TAC[COMPLEX_RING `w + Cx(&1) * (z - w) = z`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_INV] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `inv e * x:real = x / e`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN CONV_TAC NORM_ARITH]) in let lemma2 = prove (`!s t:real^N->bool. connected t /\ ~(s = {}) /\ s SUBSET t /\ open s /\ (!x. x limit_point_of s /\ x IN t ==> x IN s) ==> s = t`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[CLOSED_IN_LIMPT] THEN ASM_SIMP_TAC[OPEN_SUBSET]) in let lemma3 = prove (`!p s w q. open s /\ connected s /\ w IN s /\ (!h. h IN p ==> h holomorphic_on s /\ !z. z IN s ==> ~(h z = Cx(&0)) /\ ~(h z = Cx(&1))) /\ (!h. h IN q ==> h IN p /\ norm(h w) <= &1) ==> !k. compact k /\ k SUBSET s ==> ?b. !h z. h IN q /\ z IN k ==> norm(h z) <= b`, REPEAT GEN_TAC THEN STRIP_TAC THEN ABBREV_TAC `u = {z | z IN s /\ ?B n. &0 < B /\ open n /\ z IN n /\ n SUBSET s /\ !h:complex->complex z'. h IN q /\ z' IN n ==> norm(h z') <= B}` THEN SUBGOAL_THEN `(u:complex->bool) SUBSET s` ASSUME_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[SUBSET_RESTRICT]; ALL_TAC] THEN SUBGOAL_THEN `u:complex->bool = s` ASSUME_TAC THENL [MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `w:complex` THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma1 THEN MAP_EVERY EXISTS_TAC [`p:(complex->complex)->bool`; `&1`] THEN ASM_REWRITE_TAC[REAL_LT_01]; ALL_TAC] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN X_GEN_TAC `z:complex` THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:complex->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "u" THEN ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `v:complex` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`B:real`; `n:complex->bool`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `v:complex` THEN STRIP_TAC THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma1 THEN EXISTS_TAC `p:(complex->complex)->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MESON[] `(?r. P r /\ Q r) <=> ~(!r. P r ==> ~Q r)`] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&n + &1:real`) THEN REWRITE_TAC[REAL_ARITH `&0 < &n + &1`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [NOT_FORALL_THM] THEN ASM_SIMP_TAC[SKOLEM_THM] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; REAL_NOT_LE] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->complex->complex` STRIP_ASSUME_TAC) THEN ABBREV_TAC `g:num->complex->complex = \n z. inv(f n z)` THEN SUBGOAL_THEN `!n:num. (g n) holomorphic_on s` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "g" THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN REWRITE_TAC[ETA_AX] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n:num z:complex. z IN s ==> ~(g n z = Cx(&0)) /\ ~(g n z = Cx(&1))` STRIP_ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_INV_EQ_0; COMPLEX_INV_EQ_1] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?B n. &0 < B /\ open n /\ v IN n /\ n SUBSET s /\ !h z. h IN {(g:num->complex->complex) n | n IN (:num)} /\ z IN n ==> norm(h z) <= B` MP_TAC THENL [MATCH_MP_TAC lemma1 THEN EXISTS_TAC `{h | h holomorphic_on s /\ !z. z IN s ==> ~(h z = Cx(&0)) /\ ~(h z = Cx(&1))}` THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; REAL_LT_01] THEN X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_MESON_TAC[REAL_ARITH `&n + &1 < f ==> &1 <= f`]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_UNIV] THEN STRIP_TAC] THEN UNDISCH_TAC `open(n:complex->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:num->complex->complex`; `{(g:num->complex->complex) n | n IN (:num)}`; `ball(v:complex,e)`] MONTEL) THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_UNIV; IMP_IMP; OPEN_BALL; GSYM CONJ_ASSOC] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ASM SET_TAC[]]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:complex->complex`; `j:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `h(v:complex) = Cx(&0)` ASSUME_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (g:num->complex->complex) (j n) v` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&n)` THEN REWRITE_TAC[SEQ_HARMONIC] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN TRANS_TAC REAL_LE_TRANS `&i + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `&((j:num->num) i) + &1` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_RADD; REAL_OF_NUM_LE] THEN ASM_MESON_TAC[MONOTONE_BIGGER]; ALL_TAC] THEN MP_TAC(ISPECL [`(g:num->complex->complex) o (j:num->num)`; `h:complex->complex`; `ball(v:complex,e)`] HURWITZ_NO_ZEROS) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL] THEN ASM_REWRITE_TAC[NOT_IMP; o_THM] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS]; ASM_MESON_TAC[]; ALL_TAC; ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]] THEN DISCH_THEN(X_CHOOSE_THEN `c:complex` (fun th -> MP_TAC th THEN MP_TAC(SPEC `v:complex` th))) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `y IN ball(v:complex,e)` ASSUME_TAC THENL [REWRITE_TAC[IN_BALL] THEN ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN UNDISCH_TAC `(y:complex) IN u` THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `C:real` MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `nn:complex->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`(f:num->complex->complex) n`; `y:complex`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{y:complex}`) THEN ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `inv(C:real)`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN ASM_SIMP_TAC[GE; LE_REFL; COMPLEX_SUB_RZERO; REAL_NOT_LT] THEN EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM SET_TAC[]; X_GEN_TAC `k:complex->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!x:complex. x IN k ==> x IN u` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!x. P x ==> Q x /\ ?y z. R x y z) ==> !x. ?y z. P x ==> R x y z`)) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:complex->real`; `n:complex->complex->bool`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (n:complex->complex->bool) k`) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `j:complex->bool` MP_TAC) THEN ASM_CASES_TAC `j:complex->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0] THENL [SET_TAC[]; STRIP_TAC] THEN EXISTS_TAC `sup(IMAGE (b:complex->real) j)` THEN ASM_SIMP_TAC[REAL_LE_SUP_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN ASM SET_TAC[]]) in let lemma4 = prove (`!f k B. &0 < k /\ f holomorphic_on ball(Cx(&0),k) DELETE Cx(&0) /\ (!e. &0 < e /\ e < k ==> ?d. &0 < d /\ d < e /\ !z. z IN sphere(Cx(&0),d) ==> norm(f z) <= B) ==> ?e. &0 < e /\ e < k /\ !z. z IN ball(Cx(&0),e) DELETE Cx(&0) ==> norm(f z) <= B`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `k / &2`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `norm(z:complex)`) THEN REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!w. w IN cball(Cx(&0),e) DIFF ball(Cx(&0),d) ==> norm(f w:complex) <= B` MATCH_MP_TAC THENL [MATCH_MP_TAC MAXIMUM_MODULUS_FRONTIER; ASM_REWRITE_TAC[IN_DIFF; COMPLEX_IN_BALL_0; COMPLEX_IN_CBALL_0] THEN ASM_REAL_ARITH_TAC] THEN SIMP_TAC[BOUNDED_CBALL; BOUNDED_DIFF; CONJ_ASSOC] THEN CONJ_TAC THENL [SIMP_TAC[CLOSURE_CLOSED; CLOSED_DIFF; CLOSED_CBALL; OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[INTERIOR_SUBSET; HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] `f holomorphic_on t ==> s SUBSET t ==> f holomorphic_on interior s /\ f continuous_on s`)) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ a IN u ==> s DIFF u SUBSET t DELETE a`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `w:complex` THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN REWRITE_TAC[SET_RULE `UNIV DIFF (s DIFF t) = (UNIV DIFF s) UNION t`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] FRONTIER_UNION_SUBSET)) THEN ASM_SIMP_TAC[FRONTIER_COMPLEMENT; FRONTIER_BALL; FRONTIER_CBALL] THEN ASM SET_TAC[]]) in let lemma5 = prove (`!f. f holomorphic_on (ball(Cx(&0),&1) DELETE (Cx(&0))) /\ (!z. z IN ball(Cx(&0),&1) DELETE Cx(&0) ==> ~(f z = Cx(&0)) /\ ~(f z = Cx(&1))) ==> ?e b. &0 < e /\ e < &1 /\ &0 < b /\ ((!z. z IN ball(Cx(&0),e) DELETE Cx(&0) ==> norm(f z) <= b) \/ (!z. z IN ball(Cx(&0),e) DELETE Cx(&0) ==> norm(f z) >= b))`, REPEAT STRIP_TAC THEN ABBREV_TAC `h = \n z. (f:complex->complex) (z / Cx(&n + &1))` THEN SUBGOAL_THEN `(!n:num. (h n) holomorphic_on ball(Cx(&0),&1) DELETE Cx(&0)) /\ (!n z. z IN ball(Cx(&0),&1) DELETE Cx(&0) ==> ~(h n z = Cx(&0)) /\ ~(h n z = Cx(&1)))` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN X_GEN_TAC `n:num` THEN EXPAND_TAC "h" THEN SIMP_TAC[] THENL [ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN REWRITE_TAC[HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; CX_INJ] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET))]; SUBGOAL_THEN `!z. z IN ball (Cx(&0),&1) DELETE Cx(&0) ==> z / Cx(&n + &1) IN ball (Cx(&0),&1) DELETE Cx(&0)` (fun th -> ASM_MESON_TAC[th])] THEN REWRITE_TAC[IN_DELETE; FORALL_IN_IMAGE; SUBSET; COMPLEX_IN_BALL_0] THEN SIMP_TAC[COMPLEX_DIV_EQ_0; CX_INJ; REAL_ARITH `~(&n + &1 = &0)`] THEN SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ARITH `&0 < &n + &1`; REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_LDIV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?w. w IN ball(Cx(&0),&1) DELETE Cx(&0)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `Cx(&1 / &2)` THEN REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0; COMPLEX_NORM_CX; CX_INJ] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MP_TAC(ISPECL [`{g | g holomorphic_on ball(Cx(&0),&1) DELETE Cx(&0) /\ !z. z IN ball(Cx(&0),&1) DELETE Cx(&0) ==> ~(g z = Cx(&0)) /\ ~(g z = Cx(&1))}`; `ball(Cx(&0),&1) DELETE Cx(&0)`; `w:complex`] lemma3) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN SIMP_TAC[OPEN_BALL; OPEN_DELETE; CONNECTED_BALL; DIMINDEX_2; LE_REFL; CONNECTED_OPEN_DELETE; IN_ELIM_THM] THEN SUBGOAL_THEN `INFINITE {n | norm((h:num->complex->complex) n w) <= &1} \/ INFINITE {n | &1 <= norm((h:num->complex->complex) n w)}` MP_TAC THENL [MP_TAC num_INFINITE THEN REWRITE_TAC[INFINITE; GSYM DE_MORGAN_THM; GSYM FINITE_UNION] THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SIMP_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_ENUMERATE_WEAK) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THENL [DISCH_THEN(MP_TAC o SPEC `{(h:num->complex->complex) (r n) | n IN (:num)}`); DISCH_THEN(MP_TAC o SPEC `{inv o (h:num->complex->complex) (r n) | n IN (:num)}`)] THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM_SIMP_TAC[o_DEF; COMPLEX_INV_EQ_0; COMPLEX_INV_EQ_1] THEN ASM_SIMP_TAC[COMPLEX_NORM_INV; REAL_INV_LE_1] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_INV; ETA_AX] THEN DISCH_THEN(MP_TAC o SPEC `sphere(Cx(&0),&1 / &2)`) THEN (ANTS_TAC THENL [REWRITE_TAC[SUBSET; COMPLEX_IN_SPHERE_0; IN_DELETE; COMPLEX_IN_BALL_0; COMPACT_SPHERE; GSYM COMPLEX_NORM_NZ] THEN SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC]) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN EXPAND_TAC "h" THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THENL [EXISTS_TAC `abs b + &1`; EXISTS_TAC `inv(abs b + &1)`] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < abs b + &1`] THEN REWRITE_TAC[LEFT_OR_DISTRIB; EXISTS_OR_THM] THENL [DISJ1_TAC THEN MATCH_MP_TAC lemma4 THEN ASM_REWRITE_TAC[REAL_LT_01]; DISJ2_TAC THEN MP_TAC(ISPECL [`inv o (f:complex->complex)`; `&1`; `abs b + &1`] lemma4) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_INV; ETA_AX; o_DEF; REAL_LT_01] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[COMPLEX_NORM_INV; real_ge; IN_DELETE; COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV_EQ] THEN REWRITE_TAC[COMPLEX_NORM_NZ] THEN MATCH_MP_TAC(TAUT `!q. ~p /\ ~q ==> ~p`) THEN EXISTS_TAC `f(z:complex) = Cx(&1)` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0] THEN ASM_REAL_ARITH_TAC]] THEN (X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN EXISTS_TAC `inv(&2 * (&(r(n:num)) + &1))` THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [TRANS_TAC REAL_LET_TRANS `inv(&n)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN MATCH_MP_TAC(ARITH_RULE `m <= n ==> m <= 2 * (n + 1)`) THEN ASM_MESON_TAC[MONOTONE_BIGGER]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_SPHERE_0] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `Cx(&(r(n:num)) + &1) * z`]) THEN ASM_REWRITE_TAC[COMPLEX_IN_SPHERE_0; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN ANTS_TAC THENL [CONV_TAC REAL_FIELD; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `x = y ==> norm x <= b ==> norm y <= abs b + &1`) THEN REPEAT AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(z = Cx(&0)) ==> (z * w) / z = w`) THEN REWRITE_TAC[CX_INJ] THEN REAL_ARITH_TAC)) in let lemma6 = prove (`!f n a z. open n /\ z IN n /\ ~(a = Cx(&0)) /\ f holomorphic_on (n DELETE z) /\ (!w. w IN n DELETE z ==> ~(f w = Cx(&0)) /\ ~(f w = a)) ==> ?r. &0 < r /\ ball(z,r) SUBSET n /\ (bounded(IMAGE f (ball (z,r) DELETE z)) \/ bounded(IMAGE (inv o f) (ball (z,r) DELETE z)))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `\w. (f:complex->complex) (z + Cx r * w) / a` lemma5) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0; IN_DELETE] THEN GEN_TAC THEN STRIP_TAC; ASM_SIMP_TAC[COMPLEX_FIELD `~(a = Cx(&0)) ==> (x / a = z <=> x = a * z)`] THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_IN_BALL_0; IN_DELETE] THEN GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_DELETE]] THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_RING `z + a * b = z <=> a = Cx(&0) \/ b = Cx(&0)`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(a,a + b) = norm b`] THEN ASM_SIMP_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; real_abs; REAL_LT_IMP_LE; REAL_ARITH `r * x < r <=> &0 < r * (&1 - x)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM; bounded; FORALL_IN_IMAGE; o_THM]] THEN MAP_EVERY X_GEN_TAC [`e:real`; `b:real`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN EXISTS_TAC `e * r:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN ASM_SIMP_TAC[SUBSET_BALLS; REAL_ADD_LID; DIST_REFL; REAL_LT_MUL; REAL_SUB_LT; REAL_ARITH `&0 < r * (&1 - e) ==> e * r <= r`]; DISCH_TAC] THEN FIRST_X_ASSUM(DISJ_CASES_THEN (LABEL_TAC "*")) THENL [DISJ1_TAC THEN EXISTS_TAC `norm(a:complex) * b`; DISJ2_TAC THEN EXISTS_TAC `inv(norm(a:complex) * b)`] THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_BALL; IN_DELETE] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `(w - z) / Cx r`) THEN ASM_SIMP_TAC[IN_DELETE; COMPLEX_IN_BALL_0; COMPLEX_DIV_EQ_0; COMPLEX_SUB_0; CX_INJ; REAL_LT_IMP_NZ; COMPLEX_NORM_DIV; COMPLEX_NORM_CX; real_abs; REAL_LT_IMP_LE; REAL_LT_LDIV_EQ; NORM_ARITH `norm(w - z) = dist(z,w)`; COMPLEX_DIV_LMUL] THEN REWRITE_TAC[real_ge; COMPLEX_RING `z + w - z:complex = w`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; COMPLEX_NORM_NZ] THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_MUL; COMPLEX_NORM_NZ]) in let montel_01 = prove (`!f:num->complex->complex p s. open s /\ connected s /\ (!h. h IN p ==> h holomorphic_on s /\ !z. z IN s ==> ~(h z = Cx(&0)) /\ ~(h z = Cx(&1))) /\ (!n. f n IN p) ==> ?r. (!m n. m < n ==> r m < r n) /\ ((!x. x IN s ==> ((\n. inv(f (r n) x)) --> Cx(&0)) sequentially) /\ (!k e. compact k /\ k SUBSET s /\ &0 < e ==> ?N. !n x. n >= N /\ x IN k ==> norm(inv(f (r n) x)) < e) \/ ?g. g holomorphic_on s /\ (!x. x IN s ==> ((\n. f (r n) x) --> g x) sequentially) /\ (!k e. compact k /\ k SUBSET s /\ &0 < e ==> ?N. !n x. n >= N /\ x IN k ==> norm(f (r n) x - g x) < e))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THENL [ASM_SIMP_TAC[SUBSET_EMPTY; NOT_IN_EMPTY; HOLOMORPHIC_ON_EMPTY] THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `INFINITE {n | norm((f:num->complex->complex) n w) <= &1} \/ INFINITE {n | &1 <= norm((f:num->complex->complex) n w)}` MP_TAC THENL [MP_TAC num_INFINITE THEN REWRITE_TAC[INFINITE; GSYM DE_MORGAN_THM; GSYM FINITE_UNION] THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SIMP_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THENL [REWRITE_TAC[EXISTS_OR_THM; LEFT_OR_DISTRIB; RIGHT_AND_EXISTS_THM] THEN DISJ2_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MP_TAC(ISPECL [`\n:num. (f:num->complex->complex) (r n)`; `{(f:num->complex->complex) (r n) | n IN (:num)}`; `s:complex->bool`] MONTEL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC lemma3 THEN MAP_EVERY EXISTS_TAC [`p:(complex->complex)->bool`; `w:complex`] THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN DISCH_THEN(X_CHOOSE_THEN `k:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:num->num) o (k:num->num)` THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]; MP_TAC(ISPECL [`\n:num. inv o (f:num->complex->complex) (r n)`; `{inv o (f:num->complex->complex) (r n) | n IN (:num)}`; `s:complex->bool`] MONTEL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; o_DEF] THEN GEN_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN ASM_SIMP_TAC[ETA_AX]; ALL_TAC] THEN MATCH_MP_TAC lemma3 THEN EXISTS_TAC `{inv o (f:num->complex->complex) (r n) | n IN (:num)}` THEN EXISTS_TAC `w:complex` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM_SIMP_TAC[o_THM; COMPLEX_INV_EQ_0; COMPLEX_INV_EQ_1] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN ASM_SIMP_TAC[ETA_AX]; SET_TAC[]; REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`g:complex->complex`; `k:num->num`] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN EXISTS_TAC `(r:num->num) o (k:num->num)` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `!w:complex. w IN s ==> ~(g w = Cx(&0))` THENL [DISJ2_TAC THEN EXISTS_TAC `inv o (g:complex->complex)` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_INV; o_DEF] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o BINDER_CONV) [GSYM COMPLEX_INV_INV] THEN MATCH_MP_TAC LIM_COMPLEX_INV THEN ASM_SIMP_TAC[]; ALL_TAC] THEN X_GEN_TAC `k:complex->bool` THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `?d. &0 < d /\ !x. x IN k ==> d <= norm((g:complex->complex) x)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`IMAGE (g:complex->complex) k`; `Cx(&0)`] SEPARATE_POINT_CLOSED) THEN REWRITE_TAC[FORALL_IN_IMAGE; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET]; MP_TAC(ISPECL [`sequentially`; `\x:complex. x IN k`; `\x n:num. inv((f:num->complex->complex) (r (k n:num)) x)`; `g:complex->complex`; `d:real`] UNIFORM_LIM_COMPLEX_INV) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; COMPLEX_INV_INV; GE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[GE]]; DISJ1_TAC THEN SUBGOAL_THEN `!w:complex. w IN s ==> g w = Cx(&0)` ASSUME_TAC THENL [MP_TAC(ISPECL [`\n:num x. inv((f:num->complex->complex) (r(k n:num)) x)`; `g:complex->complex`; `s:complex->bool`] HURWITZ_NO_ZEROS) THEN ASM_SIMP_TAC[COMPLEX_INV_EQ_0] THEN MATCH_MP_TAC(TAUT `(r ==> s) /\ p ==> ~(p /\ ~r) ==> s`) THEN CONJ_TAC THENL [ASM_MESON_TAC[]; GEN_TAC] THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN ASM_SIMP_TAC[ETA_AX]; CONJ_TAC THENL [ASM_MESON_TAC[COMPLEX_SUB_RZERO]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:complex->bool`; `e:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:complex->bool`; `e:real`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[COMPLEX_SUB_RZERO]]]]) in REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`\z. (f:complex->complex) z - a`; `n:complex->bool`; `b - a:complex`; `z:complex`] lemma6) THEN ASM_SIMP_TAC[COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; ETA_AX; COMPLEX_RING `x - a:complex = y - a <=> x = y`] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[EXISTS_OR_THM] THEN MATCH_MP_TAC(TAUT `(p ==> r) /\ (~r /\ q ==> s) ==> p \/ q ==> r \/ s`) THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`f:complex->complex`; `z:complex`; `ball(z:complex,r)`] HOLOMORPHIC_ON_EXTEND_BOUNDED) THEN ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`)] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_AT; FORALL_IN_IMAGE; IN_BALL; IN_DELETE] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `r:real` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_BALL; DIST_NZ; IN_DELETE] THEN ASM_MESON_TAC[NORM_ARITH `norm(x - y) <= B ==> norm(x) <= norm(y) + B`; DIST_SYM]; DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:complex->complex) z` THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`g:complex->complex`; `ball(z:complex,r)`] THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; IN_DELETE] THEN ASM_SIMP_TAC[GSYM CONTINUOUS_AT] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; OPEN_BALL; CONTINUOUS_ON_EQ_CONTINUOUS_AT; CENTRE_IN_BALL]]; MP_TAC(ISPECL [`\z. inv((f:complex->complex) z - a)`; `z:complex`; `ball(z:complex,r)`] HOLOMORPHIC_ON_EXTEND_BOUNDED) THEN ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN REWRITE_TAC[HOLOMORPHIC_ON_CONST; ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`)] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN SIMP_TAC[EVENTUALLY_AT; o_DEF; FORALL_IN_IMAGE; IN_BALL; IN_DELETE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `r:real` THEN ASM_MESON_TAC[DIST_NZ; DIST_SYM]; DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `((g:complex->complex) --> g z) (at z)` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM CONTINUOUS_AT] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; OPEN_BALL; CONTINUOUS_ON_EQ_CONTINUOUS_AT; CENTRE_IN_BALL]; ALL_TAC] THEN ASM_CASES_TAC `(g:complex->complex) z = Cx(&0)` THENL [EXISTS_TAC `Cx(&0)` THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\w:complex. g(w) / (Cx(&1) + a * g w)` THEN EXISTS_TAC `ball(z:complex,r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_DEF] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(g = Cx(&0)) /\ inv(g) = f - a ==> (Cx(&1) + a * g) / g = f`) THEN ASM_SIMP_TAC[IN_DELETE; COMPLEX_INV_INV; COMPLEX_INV_EQ_0] THEN REWRITE_TAC[COMPLEX_SUB_0] THEN ASM SET_TAC[]; SUBST1_TAC(COMPLEX_FIELD `Cx(&0) = Cx(&0) / (Cx(&1) + a * Cx(&0))`) THEN MATCH_MP_TAC LIM_COMPLEX_DIV THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC; CONV_TAC COMPLEX_RING] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN REWRITE_TAC[LIM_CONST] THEN ASM_MESON_TAC[]]; EXISTS_TAC `g(z:complex) / (Cx(&1) + a * g z)` THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\w:complex. g(w) / (Cx(&1) + a * g w)` THEN EXISTS_TAC `ball(z:complex,r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_DEF] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(g = Cx(&0)) /\ inv(g) = f - a ==> (Cx(&1) + a * g) / g = f`) THEN ASM_SIMP_TAC[IN_DELETE; COMPLEX_INV_INV; COMPLEX_INV_EQ_0] THEN REWRITE_TAC[COMPLEX_SUB_0] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPLEX_DIV THEN ASM_SIMP_TAC[LIM_ADD; LIM_COMPLEX_MUL; LIM_CONST] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0) / g(z:complex)`) THEN REWRITE_TAC[] THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\w:complex. (Cx(&1) + a * g w) / g w` THEN EXISTS_TAC `ball(z:complex,r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_DEF] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(g = Cx(&0)) /\ inv(g) = f - a ==> (Cx(&1) + a * g) / g = f`) THEN ASM_SIMP_TAC[IN_DELETE; COMPLEX_INV_INV; COMPLEX_INV_EQ_0] THEN REWRITE_TAC[COMPLEX_SUB_0] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPLEX_DIV THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LIM_ADD; LIM_CONST; LIM_COMPLEX_MUL]]]; REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n. (\z. (z - a) / (b - a)) o (f:num->complex->complex) n`; `IMAGE (\f. (\z. (z - a) / (b - a)) o (f:complex->complex)) p`; `s:complex->bool`] montel_01) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE]; ASM SET_TAC[]] THEN ASM_SIMP_TAC[o_THM; COMPLEX_FIELD `~(a:complex = b) ==> (x / (b - a) = y <=> x = (b - a) * y)`] THEN ASM_SIMP_TAC[COMPLEX_MUL_RZERO; COMPLEX_MUL_RID; COMPLEX_RING `x - a:complex = y - a <=> x = y`] THEN ASM_SIMP_TAC[COMPLEX_SUB_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN REWRITE_TAC[HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC THENL [STRIP_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[LIM_SEQUENTIALLY; dist; COMPLEX_SUB_RZERO; GE] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:complex` THEN DISCH_TAC THEN X_GEN_TAC `c:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`{x:complex}`; `inv(c:real)`] th)) THEN ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET; IN_SING] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV_EQ]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:complex->bool`; `c:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:complex->bool`; `norm(b - a:complex) / (abs c + norm(a:complex) + &1)`]) THEN ASM_SIMP_TAC[NORM_ARITH `&0 < abs x + norm(a) + &1`; REAL_LT_DIV; COMPLEX_NORM_NZ;COMPLEX_SUB_0; COMPLEX_INV_DIV] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC(TAUT `(p ==> q ==> r) ==> (p ==> q) ==> (p ==> r)`) THEN STRIP_TAC THEN REWRITE_TAC[o_DEF; COMPLEX_INV_DIV] THEN REWRITE_TAC[COMPLEX_NORM_DIV; real_div] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_INV2)) THEN REWRITE_TAC[REAL_INV_INV; REAL_LT_INV_EQ; COMPLEX_NORM_NZ] THEN REWRITE_TAC[COMPLEX_SUB_0] THEN ANTS_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]; DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(MESON[] `(!g. R g ==> Q g) /\ (?g. P g /\ R g) ==> ?g. P g /\ Q g /\ R g`) THEN CONJ_TAC THENL [REWRITE_TAC[LIM_SEQUENTIALLY; dist; COMPLEX_SUB_RZERO; GE] THEN MESON_TAC[SING_SUBSET; COMPACT_SING; IN_SING]; ALL_TAC] THEN EXISTS_TAC `(\z. a + (b - a) * z) o (g:complex->complex)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_MUL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:complex->bool`; `e:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:complex->bool`; `e / norm(b - a:complex)`]) THEN ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[o_DEF] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `norm(inv(b - a:complex))` THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; COMPLEX_INV_EQ_0; COMPLEX_SUB_0] THEN REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_NORM_INV; GSYM real_div] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(a:complex = b) ==> (f - (a + (b - a) * g)) * inv(b - a) = (f - a) / (b - a) - g`]]]);; let GREAT_PICARD_ALT = prove (`!f n z. open n /\ z IN n /\ f holomorphic_on (n DELETE z) /\ ~(?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)) ==> ?a. (:complex) DELETE a SUBSET IMAGE f (n DELETE z)`, REPEAT STRIP_TAC THEN MP_TAC(GENL [`a:complex`; `b:complex`] (ISPECL [`f:complex->complex`; `n:complex->bool`; `a:complex`; `b:complex`; `z:complex`] GREAT_PICARD)) THEN ASM_REWRITE_TAC[IN_DELETE; SUBSET; IN_UNIV; IN_IMAGE] THEN MESON_TAC[]);; let GREAT_PICARD_INFINITE = prove (`!f n z. open n /\ z IN n /\ f holomorphic_on (n DELETE z) /\ ~(?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)) ==> ?a. !w. ~(w = a) ==> INFINITE {x | x IN n DELETE z /\ f x = w}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(!a b. ~(a = b) /\ ~(P a) /\ ~(P b) ==> F) ==> ?a. !w. ~(w = a) ==> P w`) THEN MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN REWRITE_TAC[INFINITE; GSYM FINITE_UNION; SET_RULE `{x | x IN s /\ f x = a} UNION {x | x IN s /\ f x = b} = {x | x IN s /\ f x IN {a,b}}`] THEN STRIP_TAC THEN SUBGOAL_THEN `?r. &0 < r /\ ball(z:complex,r) SUBSET n /\ !x. x IN n DELETE z /\ f x IN {a:complex, b} ==> ~(x IN ball(z,r))` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `{x | x IN n DELETE z /\ (f:complex->complex) x IN {a, b}} = {}` THENL [EXISTS_TAC `r:real` THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `min r (inf (IMAGE (\x. dist(z,x)) {x | x IN n DELETE z /\ (f:complex->complex) x IN {a, b}}))` THEN REWRITE_TAC[IN_BALL; REAL_LT_MIN] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[IN_DELETE; DIST_NZ; DIST_SYM] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_REFL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_BALLS; REAL_MIN_LE; DIST_REFL; REAL_ADD_LID; REAL_LE_REFL]; MP_TAC(ISPECL [`f:complex->complex`; `ball(z:complex,r)`; `a:complex`; `b:complex`; `z:complex`] GREAT_PICARD) THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]]);; let CASORATI_WEIERSTRASS = prove (`!f n z. open n /\ z IN n /\ f holomorphic_on (n DELETE z) /\ ~(?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)) ==> closure(IMAGE f (n DELETE z)) = (:complex)`, REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `a:complex` o MATCH_MP GREAT_PICARD_ALT) THEN MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ t = UNIV ==> s = UNIV`) THEN EXISTS_TAC `closure((:complex) DELETE a)` THEN ASM_SIMP_TAC[SUBSET_CLOSURE] THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN REWRITE_TAC[CLOSURE_COMPLEMENT; INTERIOR_SING; DIFF_EMPTY]);; (* ------------------------------------------------------------------------- *) (* A big chain of equivalents of simple connectedness for an open set. *) (* ------------------------------------------------------------------------- *) let [SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO; SIMPLY_CONNECTED_EQ_PATH_INTEGRAL_ZERO; SIMPLY_CONNECTED_EQ_GLOBAL_PRIMITIVE; SIMPLY_CONNECTED_EQ_HOLOMORPHIC_LOG; SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT; SIMPLY_CONNECTED_EQ_INJECTIVE_HOLOMORPHIC_SQRT; SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC; SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] = (CONJUNCTS o prove) (`(!s. open s ==> (simply_connected s <=> connected s /\ !g z. path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ ~(z IN s) ==> winding_number(g,z) = Cx(&0))) /\ (!s. open s ==> (simply_connected s <=> connected s /\ !g f. valid_path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ f holomorphic_on s ==> (f has_path_integral Cx(&0)) g)) /\ (!s. open s ==> (simply_connected s <=> connected s /\ !f. f holomorphic_on s ==> ?h. !z. z IN s ==> (h has_complex_derivative f(z)) (at z))) /\ (!s. open s ==> (simply_connected s <=> connected s /\ !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z))) /\ (!s. open s ==> (simply_connected s <=> connected s /\ !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = g z pow 2)) /\ (!s. open s ==> (simply_connected s <=> connected s /\ !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = g z pow 2)) /\ (!s. open s ==> (simply_connected s <=> s = {} \/ s = (:complex) \/ ?f g. f holomorphic_on s /\ g holomorphic_on ball(Cx(&0),&1) /\ (!z. z IN s ==> f(z) IN ball(Cx(&0),&1) /\ g(f z) = z) /\ (!z. z IN ball(Cx(&0),&1) ==> g(z) IN s /\ f(g z) = z))) /\ (!s. open s ==> (simply_connected(s:complex->bool) <=> s = {} \/ s homeomorphic ball(Cx(&0),&1)))`, REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN X_GEN_TAC `s:complex->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(p0 ==> p1) /\ (p1 ==> p2) /\ (p2 ==> p3) /\ (p3 ==> p4) /\ (p4 ==> p5) /\ (p5 ==> p6) /\ (p6 ==> p7) /\ (p7 ==> p8) /\ (p8 ==> p0) ==> (p0 <=> p1) /\ (p0 <=> p2) /\ (p0 <=> p3) /\ (p0 <=> p4) /\ (p0 <=> p5) /\ (p0 <=> p6) /\ (p0 <=> p7) /\ (p0 <=> p8)`) THEN REPEAT CONJ_TAC THENL [SIMP_TAC[SIMPLY_CONNECTED_IMP_CONNECTED] THEN MESON_TAC[SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CAUCHY_THEOREM_GLOBAL THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[VALID_PATH_IMP_PATH]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `f:complex->complex` THEN ASM_CASES_TAC `s:complex->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN EXISTS_TAC `\z. path_integral (@g. vector_polynomial_function g /\ path_image g SUBSET s /\ pathstart g = a /\ pathfinish g = z) f` THEN X_GEN_TAC `x:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[has_complex_derivative] THEN REWRITE_TAC[has_derivative_at; LINEAR_COMPLEX_MUL] THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\y. inv(norm(y - x)) % (path_integral(linepath(x,y)) f - f x * (y - x))` THEN REWRITE_TAC[VECTOR_ARITH `i % (x - a) - i % (y - (z + a)) = i % (x + z - y)`] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN MP_TAC(ISPEC `s:complex->bool` CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(y:complex) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; IN_CBALL; REAL_LT_IMP_LE; DIST_SYM]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `y:complex` th) THEN MP_TAC(SPEC `x:complex` th)) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY ABBREV_TAC [`g1 = @g. vector_polynomial_function g /\ path_image g SUBSET s /\ pathstart g = (a:complex) /\ pathfinish g = x`; `g2 = @g. vector_polynomial_function g /\ path_image g SUBSET s /\ pathstart g = (a:complex) /\ pathfinish g = y`] THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`g1 ++ linepath (x:complex,y) ++ reversepath g2`; `f:complex->complex`]) THEN ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN SUBGOAL_THEN `segment[x:complex,y] SUBSET s` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(x:complex,d)` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CBALL] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_SIMP_TAC[IN_CBALL; DIST_REFL] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; DIST_SYM]; ALL_TAC] THEN SUBGOAL_THEN `f path_integrable_on g1 /\ f path_integrable_on g2 /\ f path_integrable_on linepath(x,y)` STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN ASM_REWRITE_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH]; ALL_TAC] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE)] THEN ASM_SIMP_TAC[VALID_PATH_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION; PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH; PATH_IMAGE_REVERSEPATH; PATHSTART_REVERSEPATH; VALID_PATH_LINEPATH; VALID_PATH_REVERSEPATH; UNION_SUBSET; PATH_INTEGRAL_JOIN; PATH_INTEGRABLE_JOIN; PATH_INTEGRABLE_REVERSEPATH; PATH_INTEGRAL_REVERSEPATH] THEN REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_RING; REWRITE_TAC[LIM_AT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `(f:complex->complex) continuous at x` MP_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_EQ_CONTINUOUS_AT]; ALL_TAC] THEN REWRITE_TAC[continuous_at; dist; VECTOR_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `f path_integrable_on linepath(x,y)` MP_TAC THENL [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_EQ_CONTINUOUS_AT]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:complex,d2)` THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INSERT; NOT_IN_EMPTY; dist] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dist; NORM_0; VECTOR_SUB_REFL] THEN ASM_MESON_TAC[NORM_SUB]; ASM_REWRITE_TAC[SUBSET; dist; IN_BALL]]]; ALL_TAC] THEN REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:complex` THEN MP_TAC(SPECL [`x:complex`; `y:complex`; `(f:complex->complex) x`] HAS_PATH_INTEGRAL_CONST_LINEPATH) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_NEG) THEN REWRITE_TAC[COMPLEX_NEG_SUB] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN EXISTS_TAC `\w. (f:complex->complex) w - f x` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 <= e / &2`] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[REAL_LET_TRANS; SEGMENT_BOUND]]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `f:complex->complex` THEN ASM_CASES_TAC `s:complex->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `\z. complex_derivative f z / f z`) THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; HOLOMORPHIC_ON_DIV; ETA_AX] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\z:complex. cexp(g z) / f z`; `s:complex->bool`] HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `Cx(&0) = ((complex_derivative f z / f z * cexp(g z)) * f z - cexp(g z) * complex_derivative f z) / f z pow 2` SUBST1_TAC THENL [ASM_SIMP_TAC[COMPLEX_FIELD `~(z = Cx(&0)) ==> (d / z * e) * z = e * d`] THEN SIMPLE_COMPLEX_ARITH_TAC; MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DIV_AT THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_CEXP]; ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]]]; DISCH_THEN(X_CHOOSE_THEN `c:complex` MP_TAC) THEN ASM_CASES_TAC `c = Cx(&0)` THENL [ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> ~(x / y = Cx(&0))`] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[COMPLEX_FIELD `~(y = Cx(&0)) /\ ~(z = Cx(&0)) ==> (x / y = z <=> y = inv(z) * x)`] THEN DISCH_TAC THEN EXISTS_TAC `\z:complex. clog(inv c) + g z` THEN ASM_SIMP_TAC[CEXP_CLOG; CEXP_ADD; COMPLEX_INV_EQ_0] THEN MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN]]]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST] THEN CONV_TAC COMPLEX_RING; MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[]; POP_ASSUM MP_TAC THEN SPEC_TAC(`s:complex->bool`,`s:complex->bool`) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; FORALL_AND_THM] THEN SUBGOAL_THEN `!s:complex->bool. open s /\ connected s /\ Cx(&0) IN s /\ s SUBSET ball(Cx(&0),&1) /\ (!f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ?g. g holomorphic_on s /\ (!z. z IN s ==> f z = g z pow 2)) ==> ?f g. f holomorphic_on s /\ g holomorphic_on ball(Cx(&0),&1) /\ (!z. z IN s ==> f z IN ball(Cx(&0),&1) /\ g(f z) = z) /\ (!z. z IN ball(Cx(&0),&1) ==> g z IN s /\ f(g z) = z)` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `s = (:complex)` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?a b:complex. a IN s /\ ~(b IN s)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?f. f holomorphic_on s /\ f(a) = Cx(&0) /\ IMAGE f s SUBSET ball(Cx(&0),&1) /\ (!w z. w IN s /\ z IN s /\ f w = f z ==> w = z)` MP_TAC THENL [FIRST_X_ASSUM(K ALL_TAC o SPEC `(:complex)`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `\z:complex. z - b`) THEN ANTS_TAC THENL [SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; COMPLEX_RING `x - b:complex = y - b <=> x = y`] THEN ASM_MESON_TAC[COMPLEX_SUB_0]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_EQ_SUB_RADD] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:complex->bool`; `g:complex->complex`] OPEN_MAPPING_THM) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN ANTS_TAC THENL [SUBGOAL_THEN `a IN ball(a,d) /\ (a + Cx(d / &2)) IN ball(a,d) /\ ~(a + Cx(d / &2) = a)` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; COMPLEX_EQ_ADD_LCANCEL_0; CX_INJ] THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(a,a + d) = norm d`] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `ball(a:complex,d)`) THEN ASM_REWRITE_TAC[OPEN_BALL] THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `(g:complex->complex) a`) THEN ASM_SIMP_TAC[FUN_IN_IMAGE; CENTRE_IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!z:complex. z IN s ==> ~(g(z) IN ball(--(g a),r))` MP_TAC THENL [REWRITE_TAC[IN_BALL] THEN X_GEN_TAC `z:complex` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `--((g:complex->complex) z)`) THEN ASM_REWRITE_TAC[IN_BALL; NORM_ARITH `dist(w,--z) = dist(--w,z)`] THEN REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w:complex = z` THENL [ASM_REWRITE_TAC[COMPLEX_RING `--z = z <=> z = Cx(&0)`] THEN ASM_MESON_TAC[COMPLEX_RING `Cx(&0) pow 2 + b = b`]; ASM_MESON_TAC[COMPLEX_RING `(--z:complex) pow 2 = z pow 2`]]; REWRITE_TAC[IN_BALL; NORM_ARITH `dist(--a,b) = norm(b + a)`] THEN ASM_CASES_TAC `!z:complex. z IN s ==> ~(g z + g a = Cx(&0))` THENL [REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC; ASM_MESON_TAC[COMPLEX_NORM_0]] THEN EXISTS_TAC `\z:complex. Cx(r / &3) / (g z + g a) - Cx(r / &3) / (g a + g a)` THEN REWRITE_TAC[COMPLEX_SUB_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_CONST; ETA_AX]; ASM_SIMP_TAC[IMP_CONJ; CX_INJ; REAL_LT_IMP_NZ; REAL_ARITH `&0 < r ==> ~(r / &3 = &0)`; COMPLEX_FIELD `~(a = Cx(&0)) /\ ~(x + k = Cx(&0)) /\ ~(y + k = Cx(&0)) ==> (a / (x + k) - c = a / (y + k) - c <=> x = y)`] THEN CONJ_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]] THEN REWRITE_TAC[FORALL_IN_IMAGE; COMPLEX_SUB_LZERO; NORM_NEG] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(x) <= &1 / &3 /\ norm(y) <= &1 / &3 ==> norm(x - y) < &1`) THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_DIV] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_POS] THEN REWRITE_TAC[REAL_ARITH `r / &3 / x <= &1 / &3 <=> r / x <= &1`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; COMPLEX_NORM_NZ] THEN ASM_SIMP_TAC[REAL_MUL_LID]]]; REWRITE_TAC[MESON[] `(!x y. P x /\ P y /\ f x = f y ==> x = y) <=> (!x y. P x /\ P y ==> (f x = f y <=> x = y))`] THEN DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h:complex->complex`; `s:complex->bool`] HOLOMORPHIC_ON_INVERSE) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `k:complex->complex` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (h:complex->complex) s`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; ASM SET_TAC[]; REWRITE_TAC[FORALL_IN_IMAGE]] THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:complex->complex) o (h:complex->complex)`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_COMPOSE]; ALL_TAC] THEN ASM_REWRITE_TAC[o_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:complex->complex) o (k:complex->complex)` THEN ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `f:complex->complex` (X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(f:complex->complex) o (h:complex->complex)` THEN EXISTS_TAC `(k:complex->complex) o (g:complex->complex)` THEN ASM_SIMP_TAC[o_THM; HOLOMORPHIC_ON_COMPOSE] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]]] THEN X_GEN_TAC `s:complex->bool` THEN STRIP_TAC THEN ABBREV_TAC `ff = { h | h holomorphic_on s /\ IMAGE h s SUBSET ball(Cx(&0),&1) /\ h(Cx(&0)) = Cx(&0) /\ (!x y. x IN s /\ y IN s ==> (h x = h y <=> x = y))}` THEN SUBGOAL_THEN `(\z:complex. z) IN ff` MP_TAC THENL [EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM; IMAGE_ID] THEN ASM_REWRITE_TAC[HOLOMORPHIC_ON_ID]; ASM_CASES_TAC `ff:(complex->complex)->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN DISCH_TAC] THEN SUBGOAL_THEN `!h. h IN ff ==> h holomorphic_on s` ASSUME_TAC THENL [EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM]; ALL_TAC] THEN SUBGOAL_THEN `?f:complex->complex. f IN ff /\ (!h. h IN ff ==> norm(complex_derivative h (Cx(&0))) <= norm(complex_derivative f (Cx(&0))))` MP_TAC THENL [MP_TAC(ISPEC `{ norm(complex_derivative h (Cx(&0))) | h IN ff}` SUP) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; COMPLEX_SUB_LZERO; dist; NORM_NEG] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(r):real` THEN X_GEN_TAC `f:complex->complex` THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM; FORALL_IN_IMAGE; SUBSET] THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; COMPLEX_SUB_LZERO; dist; NORM_NEG] THEN STRIP_TAC THEN MP_TAC(ISPEC `\z. (f:complex->complex) (Cx(r) * z)` SCHWARZ_LEMMA) THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO] THEN SUBGOAL_THEN `!z. z IN ball(Cx(&0),&1) ==> ((\z. f (Cx r * z)) has_complex_derivative complex_derivative f (Cx(r) * z) * Cx(r)) (at z)` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[o_DEF] COMPLEX_DIFF_CHAIN_AT) THEN CONJ_TAC THENL [COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_RID]; REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN ASM_SIMP_TAC[GSYM COMPLEX_IN_BALL_0; REAL_LT_LMUL_EQ]; ALL_TAC] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[holomorphic_on] THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN ASM_SIMP_TAC[GSYM COMPLEX_IN_BALL_0; REAL_LT_LMUL_EQ]]; REMOVE_THEN "*" (MP_TAC o SPEC `Cx(&0)`) THEN REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_NORM_MUL] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; real_abs; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; real_div; REAL_MUL_LID]]; ALL_TAC] THEN ABBREV_TAC `l = sup { norm(complex_derivative h (Cx(&0))) | h IN ff}` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_TAC THEN SUBGOAL_THEN `?f. (!n. (f n) IN ff) /\ ((\n. Cx(norm(complex_derivative (f n) (Cx(&0))))) --> Cx(l)) sequentially` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `!n. ?f. f IN ff /\ abs(norm(complex_derivative f (Cx(&0))) - l) < inv(&n + &1)` MP_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_ASSUM(MP_TAC o SPEC `l - inv(&n + &1)` o CONJUNCT2) THEN REWRITE_TAC[REAL_ARITH `l <= l - i <=> ~(&0 < i)`; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:complex->complex` THEN ASM_CASES_TAC `(f:complex->complex) IN ff` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `n <= l ==> ~(n <= l - e) ==> abs(n - l) < e`) THEN ASM_SIMP_TAC[]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->complex->complex` THEN STRIP_TAC THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&m + &1)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_SUB] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]; ALL_TAC] THEN MP_TAC(ISPECL [`f:num->complex->complex`; `ff:(complex->complex)->bool`; `s:complex->bool`] MONTEL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; COMPLEX_SUB_LZERO; dist; NORM_NEG] THEN MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `g complex_differentiable (at(Cx(&0))) /\ norm(complex_derivative g (Cx(&0))) = l` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`(f:num->complex->complex) o (r:num->num)`; `(\n:num z. complex_derivative (f n) z) o (r:num->num)`; `g:complex->complex`; `s:complex->bool`] HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE) THEN ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`cball(z:complex,d)`; `e:real`]) THEN ASM_REWRITE_TAC[COMPACT_CBALL; GE] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g':complex->complex` MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN ASM_REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o ISPEC `\z:complex. Cx(norm z)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN REWRITE_TAC[CONTINUOUS_AT_CX_NORM] THEN DISCH_TAC THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[complex_differentiable]; ALL_TAC] THEN GEN_REWRITE_TAC I [GSYM CX_INJ] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. Cx(norm(complex_derivative(f((r:num->num) n)) (Cx(&0))))` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MP_TAC(ISPECL [`\n:num. Cx(norm(complex_derivative (f n) (Cx(&0))))`; `r:num->num`; `Cx l`] LIM_SUBSEQUENCE) THEN ASM_REWRITE_TAC[o_DEF]]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `~(?c. !z. z IN s ==> (g:complex->complex) z = c)` ASSUME_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `c:complex`) THEN SUBGOAL_THEN `complex_derivative g (Cx(&0)) = Cx(&0)` MP_TAC THENL [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`(\z. c):complex->complex`; `s:complex->bool`] THEN ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST] THEN ASM_MESON_TAC[]; DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\z:complex. z` o CONJUNCT1) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_DERIVATIVE_ID; COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]; ALL_TAC] THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0] THEN SUBGOAL_THEN `!z. z IN s ==> norm((g:complex->complex) z) <= &1` ASSUME_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n:num. (f:num->complex->complex) (r n) z` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN SUBGOAL_THEN `(f:num->complex->complex) (r(n:num)) IN ff` MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0; REAL_LT_IMP_LE]; X_GEN_TAC `z:complex` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:complex->complex`; `s:complex->bool`; `s:complex->bool`; `z:complex`] MAXIMUM_MODULUS_PRINCIPLE) THEN ASM_REWRITE_TAC[SUBSET_REFL]]; MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (f:num->complex->complex) (r n) (Cx(&0))` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN SUBGOAL_THEN `(f:num->complex->complex) (r(n:num)) IN ff` MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM]; MATCH_MP_TAC(REWRITE_RULE [MESON[] `(!x y. P x /\ P y /\ f x = f y ==> x = y) <=> (!x y. P x /\ P y ==> (f x = f y <=> x = y))`] HURWITZ_INJECTIVE) THEN EXISTS_TAC `(f:num->complex->complex) o (r:num->num)` THEN ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `n:num` THEN SUBGOAL_THEN `(f:num->complex->complex) (r(n:num)) IN ff` MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN MP_TAC(SPECL [`f:complex->complex`; `s:complex->bool`] HOLOMORPHIC_ON_INVERSE) THEN ANTS_TAC THENL [UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN ASM_CASES_TAC `IMAGE (f:complex->complex) s = ball(Cx(&0),&1)` THENL [ASM_SIMP_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN UNDISCH_TAC `~(IMAGE (f:complex->complex) s = ball(Cx(&0),&1))` THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; COMPLEX_IN_BALL_0] THEN X_GEN_TAC `a:complex` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE; MESON[] `(?x. a = f x /\ x IN s) <=> ~(!x. x IN s ==> ~(f x = a))`] THEN DISCH_TAC THEN MP_TAC(ISPEC `a:complex` BALL_BIHOLOMORPHISM_EXISTS) THEN ASM_REWRITE_TAC[COMPLEX_IN_BALL_0; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:complex->complex`; `t':complex->complex`] THEN STRIP_TAC THEN SUBGOAL_THEN `!z. z IN s ==> norm((f:complex->complex) z) < &1` ASSUME_TAC THENL [UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0]; ALL_TAC] THEN SUBGOAL_THEN `?sq. sq holomorphic_on (IMAGE (t o f) s) /\ !z. z IN s ==> sq((t:complex->complex) ((f:complex->complex) z)) pow 2 = t(f z)` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `!f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ?g. g holomorphic_on s /\ (!z. z IN s ==> f z = g z pow 2)` THEN DISCH_THEN(MP_TAC o SPEC `(t:complex->complex) o (f:complex->complex)`) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; COMPLEX_IN_BALL_0]) THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN STRIP_TAC THEN GEN_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `t':complex->complex`) THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM_MESON_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `q:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(q:complex->complex) o (g:complex->complex) o (t':complex->complex)` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0; o_THM] THENL [ASM_MESON_TAC[]; ASM SET_TAC[]; ASM_MESON_TAC[]]; X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(q:complex->complex) z pow 2` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN ASM_MESON_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `!z. z IN s ==> norm((sq:complex->complex) ((t:complex->complex)((f:complex->complex) z))) < &1` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM ABS_SQUARE_LT_1; GSYM COMPLEX_NORM_POW] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `(sq:complex->complex) ((t:complex->complex)((f:complex->complex) (Cx(&0))))` BALL_BIHOLOMORPHISM_EXISTS) THEN ASM_SIMP_TAC[COMPLEX_IN_BALL_0; NOT_IMP; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`r:complex->complex`; `r':complex->complex`] THEN STRIP_TAC THEN UNDISCH_TAC `!h. h IN ff ==> norm(complex_derivative h (Cx(&0))) <= norm(complex_derivative f (Cx(&0)))` THEN DISCH_THEN(fun th -> MP_TAC(SPEC `(r:complex->complex) o (sq:complex->complex) o (t:complex->complex) o (f:complex->complex)` th) THEN MP_TAC(SPEC `\z:complex. z` th)) THEN ASM_REWRITE_TAC[COMPLEX_DERIVATIVE_ID; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN DISCH_TAC THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LE] THEN EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[]; ASM_SIMP_TAC[o_THM]; MAP_EVERY X_GEN_TAC [`w:complex`; `z:complex`] THEN STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `r':complex->complex`) THEN ASM_SIMP_TAC[o_THM] THEN DISCH_THEN(MP_TAC o AP_TERM `\z:complex. z pow 2`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `t':complex->complex`) THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; STRIP_TAC] THEN MP_TAC(ISPEC `(t':complex->complex) o (\z. z pow 2) o (r':complex->complex)` SCHWARZ_LEMMA) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC) THEN SIMP_TAC[HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[COMPLEX_NORM_POW; ABS_SQUARE_LT_1; REAL_ABS_NORM]; ASM_SIMP_TAC[COMPLEX_NORM_POW; ABS_SQUARE_LT_1; REAL_ABS_NORM; o_THM]; UNDISCH_THEN `(r:complex->complex) ((sq:complex->complex) ((t:complex->complex) (f(Cx(&0))))) = Cx(&0)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM th]) THEN ASM_SIMP_TAC[o_THM] THEN UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM]]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC (TAUT `~r /\ (p /\ ~q ==> s) ==> p /\ (q' \/ q ==> r) ==> s`) THEN CONJ_TAC THENL [REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `c:complex` THEN ASM_CASES_TAC `c = Cx(&0)` THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_OF_NUM_EQ; ARITH] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `(r:complex->complex) (--(Cx(&1) / Cx(&2)))` th) THEN MP_TAC(ISPEC `(r:complex->complex) (Cx(&1) / Cx(&2))` th)) THEN MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r`) THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `~(b1 = b2) /\ a1 = a2 ==> (a1 = b1 /\ a2 = b2 ==> F)`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL] THEN DISCH_THEN(MP_TAC o AP_TERM `r':complex->complex`) THEN FIRST_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o lhand o snd)) THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(COMPLEX_RING `x = --(Cx(&1) / Cx(&2)) ==> ~(Cx(&1) / Cx(&2) = x)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[o_DEF] THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_RING `x = Cx(&1) / Cx(&2) /\ y = --(Cx(&1) / Cx(&2)) ==> x pow 2 = y pow 2`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; REWRITE_TAC[GSYM REAL_LT_LE] THEN DISCH_TAC THEN UNDISCH_TAC `&1 <= norm (complex_derivative f (Cx(&0)))` THEN SUBGOAL_THEN `complex_derivative f (Cx(&0)) = complex_derivative (t' o (\z:complex. z pow 2) o r') (Cx(&0)) * complex_derivative (r o (sq:complex->complex) o (t:complex->complex) o f) (Cx(&0))` (fun th -> REWRITE_TAC[th; COMPLEX_NORM_MUL]) THENL [ALL_TAC; REWRITE_TAC[REAL_ARITH `a * b < b <=> &0 < (&1 - a) * b`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&1 <= x ==> ~(x = &0)`)) THEN SIMP_TAC[REAL_ENTIRE; NORM_EQ_0; GSYM NORM_POS_LT; DE_MORGAN_THM] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `((t':complex->complex) o (\z:complex. z pow 2) o (r':complex->complex)) o ((r:complex->complex) o (sq:complex->complex) o (t:complex->complex) o (f:complex->complex))` THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_SIMP_TAC[o_THM]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THENL [EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN REPEAT(MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC) THEN SIMP_TAC[HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[COMPLEX_NORM_POW; ABS_SQUARE_LT_1; REAL_ABS_NORM]]]]; ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `s = (:complex)` THEN ASM_REWRITE_TAC[] THENL [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_BALL_UNIV THEN REWRITE_TAC[REAL_LT_01]; REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]]; STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_SIMPLY_CONNECTED_EQ) THEN SIMP_TAC[CONVEX_IMP_SIMPLY_CONNECTED; CONVEX_BALL]]);; let CONTRACTIBLE_EQ_SIMPLY_CONNECTED_2D = prove (`!s:real^2->bool. open s ==> (contractible s <=> simply_connected s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED] THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONTRACTIBLE_EMPTY] THEN ASM_MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ; CONVEX_IMP_CONTRACTIBLE; CONVEX_BALL]);; (* ------------------------------------------------------------------------- *) (* A further chain of equivalents about components of the complement of a *) (* simply connected set (following 1.35 in Burckel's book). *) (* ------------------------------------------------------------------------- *) let [SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES; SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS; SIMPLY_CONNECTED_EQ_EMPTY_INSIDE] = (CONJUNCTS o prove) (`(!s:complex->bool. open s ==> (simply_connected s <=> connected s /\ if bounded s then connected(frontier s) else !c. c IN components(frontier s) ==> ~bounded c)) /\ (!s. open s ==> (simply_connected s <=> connected s /\ !c. c IN components ((:complex) DIFF s) ==> ~bounded c)) /\ (!s:complex->bool. open s ==> (simply_connected s <=> connected s /\ inside s = {}))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:complex->bool` THEN ASM_CASES_TAC `open(s:complex->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(q3 ==> p) /\ (q2 ==> q3) /\ (q1 ==> q2) /\ (p ==> q1) ==> (p <=> q1) /\ (p <=> q2) /\ (p <=> q3)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[INSIDE_OUTSIDE] THEN REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = {} <=> !x. ~(x IN s) ==> x IN t`] THEN STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO] THEN GEN_TAC THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_ZERO_IN_OUTSIDE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_MONO) THEN ASM SET_TAC[]; REWRITE_TAC[components; FORALL_IN_GSPEC; inside] THEN SET_TAC[]; ASM_CASES_TAC `connected(s:complex->bool)` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL [DISCH_TAC THEN REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_EQ_SELF; CONNECTED_UNIV; IN_UNIV; NOT_BOUNDED_UNIV] THEN ASM_CASES_TAC `s = (:complex)` THENL [ASM_MESON_TAC[NOT_BOUNDED_UNIV]; ALL_TAC] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY) THEN REWRITE_TAC[outside; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `connected_component ((:complex) DIFF s) w = connected_component ((:complex) DIFF s) z` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC JOINABLE_CONNECTED_COMPONENT_EQ THEN EXISTS_TAC `frontier s :complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `i = s ==> s' DIFF i SUBSET UNIV DIFF s`) THEN ASM_REWRITE_TAC[INTERIOR_EQ]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `frontier c SUBSET c /\ frontier c SUBSET f /\ ~(frontier c = {}) ==> ~(c INTER f = {})`) THEN REWRITE_TAC[FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] THEN ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF; IN_UNIV; CONNECTED_COMPONENT_EQ_UNIV; SET_RULE `UNIV DIFF s = UNIV <=> s = {}`] THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `c = s ==> c DIFF i SUBSET s`) THEN ASM_REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; DISCH_TAC THEN REWRITE_TAC[components; FORALL_IN_GSPEC] THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN DISCH_TAC THEN SUBGOAL_THEN `?z:complex. z IN frontier s /\ z IN connected_component ((:real^2) DIFF s) w` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN MATCH_MP_TAC(SET_RULE `frontier c SUBSET c /\ frontier c SUBSET f /\ ~(frontier c = {}) ==> ?z. z IN f /\ z IN c`) THEN ASM_REWRITE_TAC[FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] THEN CONJ_TAC THENL [REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `c = s ==> c DIFF i SUBSET s`) THEN ASM_REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_EQ_UNIV; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[SET_RULE `UNIV DIFF s = UNIV <=> s = {}`] THEN ASM_MESON_TAC[BOUNDED_EMPTY]]; FIRST_X_ASSUM(MP_TAC o SPEC `connected_component (frontier s) (z:complex)`) THEN REWRITE_TAC[components; IN_ELIM_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CONTRAPOS_THM]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN SUBGOAL_THEN `connected_component ((:complex) DIFF s) w = connected_component ((:complex) DIFF s) z` SUBST1_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `frontier s :complex->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `i = s ==> s' DIFF i SUBSET UNIV DIFF s`) THEN ASM_REWRITE_TAC[INTERIOR_EQ]]]]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED th) THEN MP_TAC th) THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[BOUNDED_EMPTY; FRONTIER_EMPTY; CONNECTED_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism] THEN MAP_EVERY X_GEN_TAC [`g:real^2->real^2`; `f:real^2->real^2`] THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`D = \n. ball(vec 0:real^2,&1 - inv(&n + &2))`; `A = \n. {z:real^2 | &1 - inv(&n + &2) < norm z /\ norm z < &1}`; `X = \n:num. closure(IMAGE (f:real^2->real^2) (A n))`] THEN SUBGOAL_THEN `frontier s = INTERS {X n:real^2->bool | n IN (:num)}` SUBST1_TAC THENL [ASM_SIMP_TAC[frontier; INTERIOR_OPEN; INTERS_GSPEC; IN_UNIV] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_DIFF] THEN X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN UNDISCH_TAC `(x:real^2) IN closure s` THEN SUBGOAL_THEN `s = IMAGE (f:real^2->real^2) (closure (D(n:num))) UNION IMAGE f (A n)` SUBST1_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC(SET_RULE `t UNION u = s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f s = IMAGE f t UNION IMAGE f u`) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MAP_EVERY EXPAND_TAC ["A"; "D"] THEN SIMP_TAC[CLOSURE_BALL; REAL_SUB_LT; REAL_INV_LT_1; REAL_ARITH `&1 < &n + &2`] THEN REWRITE_TAC[EXTENSION; IN_UNION; COMPLEX_IN_BALL_0; IN_CBALL_0; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e <= &1 ==> (x <= &1 - e \/ &1 - e < x /\ x < &1 <=> x < &1)`) THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_INV_LE_1; REAL_ARITH `&1 <= &n + &2`; REAL_ARITH `&0 < &n + &2`]; EXPAND_TAC "X" THEN REWRITE_TAC[CLOSURE_UNION] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(x IN s) ==> t SUBSET s ==> x IN t UNION u ==> x IN u`)) THEN EXPAND_TAC "D" THEN SIMP_TAC[CLOSURE_BALL; REAL_SUB_LT; REAL_INV_LT_1; REAL_ARITH `&1 < &n + &2`; COMPACT_CBALL] THEN MATCH_MP_TAC(SET_RULE `closure s = s /\ s SUBSET t ==> closure s SUBSET t`) THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_CBALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); EXPAND_TAC "s" THEN MATCH_MP_TAC IMAGE_SUBSET] THEN REWRITE_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_CBALL_0] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> a <= &1 - x ==> a < &1`) THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]; MATCH_MP_TAC(SET_RULE `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN CONJ_TAC THENL [EXPAND_TAC "X" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^2` THEN DISCH_THEN(MP_TAC o SPEC `0`) THEN SPEC_TAC(`x:real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN EXPAND_TAC "s" THEN MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; COMPLEX_IN_BALL_0] THEN REAL_ARITH_TAC; REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN MAP_EVERY EXPAND_TAC ["s"; "X"] THEN REWRITE_TAC[TAUT `~(a /\ b) <=> b ==> ~a`; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^2` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN DISCH_TAC THEN MP_TAC(SPEC `&1 - norm(x:real^2)` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_SUB_LT; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. y IN s /\ (s INTER t = {}) ==> ~(y IN t)`) THEN EXISTS_TAC `IMAGE (f:real^2->real^2) (D(n:num))` THEN CONJ_TAC THENL [MATCH_MP_TAC FUN_IN_IMAGE THEN EXPAND_TAC "D" THEN REWRITE_TAC[IN_BALL_0] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n < &1 - x ==> m < n ==> x < &1 - m`)) THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN REAL_ARITH_TAC; SUBGOAL_THEN `open(IMAGE (f:real^2->real^2) (D(n:num)))` MP_TAC THENL [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN SUBGOAL_THEN `(D:num->real^2->bool) n SUBSET ball(Cx(&0),&1)` ASSUME_TAC THENL [EXPAND_TAC "D" THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC SUBSET_BALL THEN REWRITE_TAC[REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN REAL_ARITH_TAC; REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; EXPAND_TAC "D" THEN REWRITE_TAC[OPEN_BALL]; ASM SET_TAC[]]]; SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `!u. (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\ s UNION t SUBSET u /\ s INTER t = {} ==> IMAGE f s INTER IMAGE f t = {}`) THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY EXPAND_TAC ["D"; "A"] THEN REWRITE_TAC[COMPLEX_IN_BALL_0; IN_BALL_0; SUBSET; NOT_IN_EMPTY; IN_UNION; IN_ELIM_THM; IN_INTER; EXTENSION] THEN CONJ_TAC THENL [GEN_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> x < &1 - e \/ &1 - e < x /\ x < &1 ==> x < &1`) THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]]]]; ALL_TAC] THEN SUBGOAL_THEN `!n. closed((X:num->complex->bool) n)` ASSUME_TAC THENL [EXPAND_TAC "X" THEN REWRITE_TAC[CLOSED_CLOSURE]; ALL_TAC] THEN SUBGOAL_THEN `!n. connected((X:num->complex->bool) n)` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN EXPAND_TAC "X" THEN MATCH_MP_TAC CONNECTED_CLOSURE THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN EXPAND_TAC "A" THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_ELIM_THM]; ONCE_REWRITE_TAC[NORM_ARITH `norm z = norm(z - vec 0)`] THEN SIMP_TAC[CONNECTED_ANNULUS; DIMINDEX_2; LE_REFL]]; ALL_TAC] THEN SUBGOAL_THEN `!n. ((X:num->complex->bool) n) SUBSET closure s` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "X" THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN EXPAND_TAC "s" THEN MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN SIMP_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_ELIM_THM]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m <= n ==> (X:num->complex->bool) n SUBSET X m` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN EXPAND_TAC "X" THEN MATCH_MP_TAC SUBSET_CLOSURE THEN MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `n <= m ==> &1 - n < x /\ x < &1 ==> &1 - m < x /\ x < &1`) THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LE_RADD; REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THENL [MATCH_MP_TAC CONNECTED_NEST THEN ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_CLOSURE]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~(bounded((X:num->complex->bool) n))` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN DISCH_TAC THEN UNDISCH_TAC `~bounded(s:complex->bool)` THEN EXPAND_TAC "s" THEN REWRITE_TAC[] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (f:complex->complex) (cball(Cx(&0),&1 - inv(&n + &2)) UNION A n)` THEN CONJ_TAC THENL [REWRITE_TAC[IMAGE_UNION; BOUNDED_UNION] THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN SIMP_TAC[COMPACT_CBALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; COMPLEX_IN_CBALL_0; COMPLEX_IN_BALL_0] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> x <= &1 - e ==> x < &1`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN EXPAND_TAC "X" THEN REWRITE_TAC[CLOSURE_SUBSET]]; MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN REWRITE_TAC[SUBSET; IN_UNION; COMPLEX_IN_BALL_0; COMPLEX_IN_CBALL_0; IN_ELIM_THM] THEN REAL_ARITH_TAC]; ALL_TAC] THEN X_GEN_TAC `c:complex->bool` THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `closed(INTERS {X n:complex->bool | n IN (:num)})` ASSUME_TAC THENL [ASM_SIMP_TAC[CLOSED_INTERS; FORALL_IN_GSPEC]; ALL_TAC] THEN SUBGOAL_THEN `closed(c:complex->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_COMPONENTS]; ALL_TAC] THEN SUBGOAL_THEN `compact(c:complex->bool)` ASSUME_TAC THENL [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `?k:complex->bool. c SUBSET k /\ compact k /\ k SUBSET INTERS {X n | n IN (:num)} /\ closed(INTERS {X n | n IN (:num)} DIFF k)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL[`INTERS {X n:complex->bool | n IN (:num)}`;`c:complex->bool`] SURA_BURA) THEN ASM_SIMP_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; CLOSED_IMP_LOCALLY_COMPACT] THEN MATCH_MP_TAC(MESON[] `~(c = i {}) /\ (~(f = {}) ==> P) ==> c = i f ==> P`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERS_0] THEN ASM_MESON_TAC[NOT_BOUNDED_UNIV]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:complex->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS]]; ALL_TAC] THEN MP_TAC(ISPECL [`k:complex->bool`; `INTERS {X n:complex->bool | n IN (:num)} DIFF k`] SEPARATION_NORMAL_COMPACT) THEN ASM_SIMP_TAC[NOT_EXISTS_THM; SET_RULE `k INTER (s DIFF k) = {}`] THEN MAP_EVERY X_GEN_TAC [`v:complex->bool`; `v':complex->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `v INTER (INTERS {X n:complex->bool | n IN (:num)} DIFF k) = {}` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`closure(v) DIFF v:complex->bool`; `{X n INTER closure(v:complex->bool) | n IN (:num)}`] COMPACT_IMP_FIP) THEN ASM_SIMP_TAC[COMPACT_DIFF; FORALL_IN_GSPEC; CLOSED_INTER; CLOSED_CLOSURE; NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; SUBGOAL_THEN `INTERS {X n INTER closure v :complex->bool | n IN (:num)} = INTERS {X n | n IN (:num)} INTER closure v` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNIV] THEN MESON_TAC[]; MP_TAC(ISPECL [`v':complex->bool`; `v:complex->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FINITE_SUBSET_IMAGE; SUBSET_UNIV; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `i:num->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_CASES_TAC `i:num->bool = {}` THENL [ASM_REWRITE_TAC[IMAGE_CLAUSES; INTERS_0; INTER_UNIV] THEN MP_TAC(ISPEC `v:complex->bool` FRONTIER_EQ_EMPTY) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]; ASM_MESON_TAC[CLOSURE_UNIV; COMPACT_IMP_BOUNDED; NOT_BOUNDED_UNIV]]; ALL_TAC] THEN SUBGOAL_THEN `?n:num. n IN i /\ !m. m IN i ==> m <= n` (X_CHOOSE_TAC `p:num`) THENL [MAP_EVERY UNDISCH_TAC [`~(i:num->bool = {})`; `FINITE(i:num->bool)`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`i:num->bool`,`i:num->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_INSERT_EMPTY] THEN MAP_EVERY X_GEN_TAC [`n:num`; `i:num->bool`] THEN ASM_CASES_TAC `i:num->bool = {}` THEN ASM_REWRITE_TAC[LE_REFL; NOT_IN_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o CONJUNCT1) THEN DISJ_CASES_TAC(ARITH_RULE `n:num <= p \/ p <= n`) THEN ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `INTERS (IMAGE (\n:num. X n INTER closure v) i):complex->bool = X p INTER closure v` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; INTERS_IMAGE; IN_ELIM_THM; IN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE `(c DIFF v) INTER (x INTER c) = {} ==> x INTER c SUBSET v`)) THEN SUBGOAL_THEN `connected((X:num->complex->bool) p)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN(MP_TAC o SPEC `(X:num->complex->bool) p INTER closure v`) THEN REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `(X:num->complex->bool) p INTER closure v = X p INTER v` SUBST1_TAC THENL [MP_TAC(ISPEC `v:complex->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN REWRITE_TAC[CLOSED_CLOSURE]; MATCH_MP_TAC(SET_RULE `!k. k SUBSET s /\ ~(k = {}) ==> ~(s = {})`) THEN EXISTS_TAC `k:complex->bool` THEN CONJ_TAC THENL [MP_TAC(ISPEC `v:complex->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]]; DISCH_THEN(MP_TAC o AP_TERM `bounded:(complex->bool)->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `closure v:complex->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN SET_TAC[]]);; let SIMPLY_CONNECTED_IFF_SIMPLE = prove (`!s:real^2->bool. open s /\ bounded s ==> (simply_connected s <=> connected s /\ connected((:real^2) DIFF s))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS] THEN ASM_CASES_TAC `connected(s:real^2->bool)` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN EXISTS_TAC `(:real^2) DIFF s` THEN ASM_SIMP_TAC[COMPL_COMPL] THEN REWRITE_TAC[LE_REFL; DIMINDEX_2]; DISCH_TAC THEN ASM_CASES_TAC `(:real^2) DIFF s = {}` THEN ASM_REWRITE_TAC[COMPONENTS_EMPTY; NOT_IN_EMPTY] THEN SUBGOAL_THEN `components((:real^2) DIFF s) = {(:real^2) DIFF s}` SUBST1_TAC THENL [ASM_REWRITE_TAC[COMPONENTS_EQ_SING]; ALL_TAC] THEN GEN_TAC THEN SIMP_TAC[IN_SING] THEN DISCH_TAC THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN ASM_REWRITE_TAC[COMPL_COMPL]]);; let CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS = prove (`!s:real^2->bool. open s /\ bounded s ==> (connected((:real^2) DIFF s) <=> !c. c IN components s ==> simply_connected c)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `!c. c IN components s ==> connected((:real^2) DIFF c)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[NONSEPARATION_BY_COMPONENT_EQ]; ALL_TAC] THEN ASM_MESON_TAC[SIMPLY_CONNECTED_IFF_SIMPLE; OPEN_COMPONENTS; IN_COMPONENTS_SUBSET; BOUNDED_SUBSET; IN_COMPONENTS_CONNECTED]);; let SIMPLY_CONNECTED_COMPONENT_PATH_COMPLEMENT = prove (`!g c. path g /\ c IN components((:real^2) DIFF path_image g) /\ bounded c ==> simply_connected c`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) SIMPLY_CONNECTED_IFF_SIMPLE o snd) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)) THEN ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE] THEN DISCH_TAC THEN DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN EXISTS_TAC `path_image g:real^2->bool` THEN ASM_SIMP_TAC[SUBSET_UNIV; CONNECTED_UNIV; CONNECTED_PATH_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Yet another set of equivalences based on *continuous* logs and sqrts. *) (* ------------------------------------------------------------------------- *) let SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG,SIMPLY_CONNECTED_EQ_CONTINUOUS_SQRT = (CONJ_PAIR o prove) (`(!s. open s ==> (simply_connected s <=> connected s /\ !f. f continuous_on s /\ (!z:complex. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g continuous_on s /\ !z. z IN s ==> f z = cexp(g z))) /\ (!s. open s ==> (simply_connected s <=> connected s /\ !f. f continuous_on s /\ (!z:complex. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g continuous_on s /\ !z. z IN s ==> f z = g z pow 2))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:complex->bool` THEN ASM_CASES_TAC `open(s:complex->bool)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `connected(s:complex->bool)` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[SIMPLY_CONNECTED_IMP_CONNECTED]] THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:complex->complex`; `h:complex->complex`] THEN STRIP_TAC THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN MP_TAC(ISPECL [`(f:complex->complex) o (h:complex->complex)`; `Cx(&0)`; `&1`] CONTINUOUS_LOGARITHM_ON_BALL) THEN ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:complex->complex) o (k:complex->complex)` THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]; DISCH_TAC THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN CONV_TAC COMPLEX_RING; DISCH_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT] THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN STRIP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `~((g:complex->complex) z = Cx(&0))` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_RING `Cx(&0) pow 2 = Cx(&0)`]; ALL_TAC] THEN EXISTS_TAC `complex_derivative f z / (Cx(&2) * g z)` THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT] THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\x:complex. (f(x) - f(z)) / (x - z) / (g(x) + g(z))` THEN SUBGOAL_THEN `?d. &0 < d /\ !w:complex. w IN s /\ w IN ball(z,d) ==> ~(g w + g z = Cx(&0))` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `z:complex` o GEN_REWRITE_RULE I [continuous_on]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `norm((g:complex->complex) z)`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[IN_BALL; GSYM COMPLEX_VEC_0] THEN MESON_TAC[NORM_ARITH `dist(z,x) < norm z ==> ~(x + z = vec 0)`]; ALL_TAC] THEN EXISTS_TAC `ball(z:complex,d) INTER s` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL]; ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(x = z) /\ ~(gx + gz = Cx(&0)) ==> (gx pow 2 - gz pow 2) / (x - z) / (gx + gz) = (gx - gz) / (x - z)`) THEN ASM_SIMP_TAC[]; MATCH_MP_TAC LIM_COMPLEX_DIV THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; GSYM HAS_COMPLEX_DERIVATIVE_AT] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; CX_INJ] THEN REWRITE_TAC[COMPLEX_MUL_2; REAL_OF_NUM_EQ; ARITH_EQ] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST; GSYM CONTINUOUS_AT] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_INTERIOR; INTERIOR_OPEN]]]);; (* ------------------------------------------------------------------------- *) (* Relations to the borsukian property. *) (* ------------------------------------------------------------------------- *) let SIMPLY_CONNECTED_EQ_BORSUKIAN = prove (`!s:real^2->bool. open s ==> (simply_connected s <=> connected s /\ borsukian s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG] THEN AP_TERM_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN AP_TERM_TAC THEN ABS_TAC THEN SET_TAC[]);; let BORSUKIAN_EQ_SIMPLY_CONNECTED = prove (`!s:real^2->bool. open s ==> (borsukian s <=> !c. c IN components s ==> simply_connected c)`, ASM_SIMP_TAC[BORSUKIAN_COMPONENTWISE_EQ; OPEN_IMP_LOCALLY_CONNECTED] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM (ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] OPEN_COMPONENTS)) THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_BORSUKIAN] THEN ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]);; let BORSUKIAN_SEPARATION_OPEN_CLOSED = prove (`!s:real^2->bool. (open s \/ closed s) /\ bounded s ==> (borsukian s <=> connected((:real^2) DIFF s))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BORSUKIAN_SEPARATION_COMPACT; COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_SIMP_TAC[BORSUKIAN_EQ_SIMPLY_CONNECTED; CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS]);; (* ------------------------------------------------------------------------- *) (* A per-function version for continuous logs, a kind of monodromy. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_COMPOSE_CEXP = prove (`!p. path p ==> winding_number(cexp o p,Cx(&0)) = Cx(&1) / (Cx(&2) * Cx pi * ii) * (pathfinish p - pathstart p)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?e. &0 < e /\ !t:real^1. t IN interval[vec 0,vec 1] ==> e <= norm(cexp(p t))` STRIP_ASSUME_TAC THENL [EXISTS_TAC `setdist({Cx(&0)},path_image (cexp o p))` THEN REWRITE_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN ASM_SIMP_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_CEXP; CLOSED_SING; SETDIST_EQ_0_CLOSED_COMPACT; COMPACT_PATH_IMAGE; PATH_IMAGE_NONEMPTY] THEN REWRITE_TAC[NOT_INSERT_EMPTY; path_image; IMAGE_o] THEN CONJ_TAC THENL [MP_TAC CEXP_NZ THEN SET_TAC[]; REPEAT STRIP_TAC] THEN ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN REWRITE_TAC[COMPLEX_RING `--x = Cx(&0) - x`] THEN REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`path_image(p:real^1->complex)`; `Cx(&0)`] BOUNDED_SUBSET_CBALL) THEN ASM_SIMP_TAC[BOUNDED_PATH_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN REWRITE_TAC[SUBSET; COMPLEX_IN_CBALL_0] THEN STRIP_TAC THEN MP_TAC(ISPECL [`cexp`; `cball(Cx(&0),B + &1)`] COMPACT_UNIFORMLY_CONTINUOUS) THEN REWRITE_TAC[CONTINUOUS_ON_CEXP; COMPACT_CBALL] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[COMPLEX_IN_CBALL_0] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`p:real^1->complex`; `min (&1) d`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->complex` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(cexp o g,Cx(&0))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_NEARBY_PATHS_EQ THEN ASM_SIMP_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_CEXP; PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO; o_THM] THEN REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC(NORM_ARITH `norm(g - p) < &1 /\ norm(p) <= B ==> norm(p) <= B + &1 /\ norm(g) <= B + &1`) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[path_image] THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH (lhs o rand) WINDING_NUMBER_VALID_PATH o lhs o snd) THEN REWRITE_TAC[PATH_INTEGRAL_INTEGRAL; COMPLEX_SUB_RZERO] THEN ANTS_TAC THENL [REWRITE_TAC[path_image; IN_IMAGE; o_THM; CEXP_NZ] THEN REWRITE_TAC[valid_path] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN REWRITE_TAC[differentiable_on] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN REWRITE_TAC[differentiable] THEN ASM_MESON_TAC[has_vector_derivative; HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION]; GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE THEN COMPLEX_DIFFERENTIABLE_TAC]; DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `integral (interval [vec 0,vec 1]) (\x. vector_derivative (g:real^1->complex) (at x))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(e = Cx(&0)) /\ v' = e * v ==> Cx(&1) / e * v' = v`) THEN REWRITE_TAC[CEXP_NZ] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_UNIQUE_AT THEN MP_TAC(ISPECL [`g:real^1->complex`; `cexp`; `\h. drop h % vector_derivative (g:real^1->complex) (at t)`; `\w. cexp(g(t:real^1)) * w`; `t:real^1`] DIFF_CHAIN_AT) THEN REWRITE_TAC[GSYM has_vector_derivative; GSYM has_complex_derivative; GSYM VECTOR_DERIVATIVE_WORKS; HAS_COMPLEX_DERIVATIVE_CEXP; differentiable] THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION; has_vector_derivative]; REWRITE_TAC[has_vector_derivative; o_DEF] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING]; MP_TAC(ISPECL [`g:real^1->complex`; `\x. vector_derivative (g:real^1->complex) (at x)`; `vec 0:real^1`; `vec 1:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN REWRITE_TAC[differentiable] THEN ASM_MESON_TAC[has_vector_derivative; HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION]; DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[pathstart; pathfinish]]]]]);; let MONODROMY_CONTINUOUS_LOG = prove (`!f:complex->complex s. open s /\ f continuous_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> ((!p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p ==> winding_number(f o p,Cx(&0)) = Cx(&0)) <=> (?g. g continuous_on s /\ !z. z IN s ==> f(z) = cexp(g z)))`, let lemma = prove (`!f g s p. f continuous_on s /\ g continuous_on s /\ (!z:complex. z IN s ==> f(z) = cexp(g z)) /\ path p /\ path_image p SUBSET s ==> winding_number(f o p,Cx(&0)) = Cx(&1) / (Cx(&2) * Cx pi * ii) * (pathfinish(g o p) - pathstart(g o p))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(cexp o g o (p:real^1->complex),Cx(&0))` THEN CONJ_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_NEARBY_PATHS_EQ THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[PATHSTART_COMPOSE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE]; REWRITE_TAC[PATHFINISH_COMPOSE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; PATHFINISH_IN_PATH_IMAGE]; GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_THM; COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC(NORM_ARITH `x = y /\ ~(z = vec 0) ==> norm(x - y) < norm z`) THEN REWRITE_TAC[COMPLEX_VEC_0; CEXP_NZ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE]]; MATCH_MP_TAC WINDING_NUMBER_COMPOSE_CEXP THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]) in REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `g:complex->complex`; `s:complex->bool`; `p:real^1->complex`] lemma) THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_RZERO]] THEN DISCH_TAC THEN EXISTS_TAC `\z. let c = connected_component s (z:complex) in let z0 = (@) c in let p = @p. path p /\ path_image p SUBSET c /\ pathstart p = z0 /\ pathfinish p = z in Cx(&2) * Cx(pi) * ii * winding_number(f o p,Cx(&0)) + clog(f z0)` THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN REPEAT LET_TAC THEN SUBGOAL_THEN `(z:complex) IN c` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN SUBGOAL_THEN `(z0:complex) IN c` ASSUME_TAC THENL [EXPAND_TAC "z0" THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC SELECT_AX THEN ASM_MESON_TAC[IN]; ALL_TAC] THEN SUBGOAL_THEN `(c:complex->bool) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `connected(c:complex->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN SUBGOAL_THEN `open(c:complex->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_CONNECTED_COMPONENT]; ALL_TAC] THEN SUBGOAL_THEN `path_connected(c:complex->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN SUBGOAL_THEN `path p /\ path_image p SUBSET c /\ pathstart p = z0 /\ pathfinish p = (z:complex)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "p" THEN CONV_TAC SELECT_CONV THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[path_connected]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(f:complex->complex) o (p:real^1->complex)`; `Cx(&0)`] WINDING_NUMBER_AHLFORS_FULL) THEN REWRITE_TAC[CEXP_ADD] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[path_image; IMAGE_o] THEN REWRITE_TAC[GSYM path_image] THEN ASM SET_TAC[]]; ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN REWRITE_TAC[COMPLEX_SUB_RZERO] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CEXP_CLOG THEN ASM SET_TAC[]]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_OPEN THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:complex->bool` THEN DISCH_TAC THEN ABBREV_TAC `z0:complex = (@) c` THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN ABBREV_TAC `g = \z. let p = @p. path p /\ path_image p SUBSET c /\ pathstart p = z0 /\ pathfinish p = z in Cx(&2) * Cx(pi) * ii * winding_number(f o p,Cx(&0)) + clog(f(z0:complex))` THEN EXISTS_TAC `g:complex->complex` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN EXPAND_TAC "z0" THEN SUBGOAL_THEN `connected_component s (z:complex) = c` (fun th -> REWRITE_TAC[th]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_COMPONENTS]) THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; ALL_TAC] THEN SUBGOAL_THEN `(z0:complex) IN c` ASSUME_TAC THENL [EXPAND_TAC "z0" THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC SELECT_AX THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(c:complex->bool) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `connected(c:complex->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN SUBGOAL_THEN `open(c:complex->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_COMPONENTS]; ALL_TAC] THEN SUBGOAL_THEN `path_connected(c:complex->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN c ==> ?p. path (p:real^1->complex) /\ path_image p SUBSET c /\ pathstart p = z0 /\ pathfinish p = x /\ g(x) = Cx(&2) * Cx pi * ii * winding_number(f o p,Cx(&0)) + clog (f z0)` (LABEL_TAC "*") THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN ABBREV_TAC `p = @p. path p /\ path_image p SUBSET c /\ pathstart p = z0 /\ pathfinish p = (z:complex)` THEN EXISTS_TAC `p:real^1->complex` THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[] THEN EXPAND_TAC "p" THEN CONV_TAC SELECT_CONV THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `z:complex` o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC(SPEC `ball(z:complex,e)` SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG) THEN SIMP_TAC[OPEN_BALL; CONVEX_BALL; CONVEX_IMP_SIMPLY_CONNECTED] THEN DISCH_THEN(MP_TAC o SPEC `f:complex->complex` o CONJUNCT2) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; DISCH_THEN(X_CHOOSE_THEN `l:complex->complex` STRIP_ASSUME_TAC)] THEN REWRITE_TAC[CONTINUOUS_AT] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN ONCE_REWRITE_TAC[DIST_SYM] THEN EXISTS_TAC `\w. Cx(&2) * Cx pi * ii * winding_number((f:complex->complex) o linepath(z,w),Cx(&0))` THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN STRIP_TAC THEN REMOVE_THEN "*" (fun th -> MP_TAC(SPEC `w:complex` th) THEN MP_TAC(SPEC `z:complex` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; IN_BALL; DIST_SYM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(COMPLEX_RING `(z + x) - y = Cx(&0) ==> a * b * c * x = (a * b * c * y + l) - (a * b * c * z + l)`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p ++ linepath(z:complex,w) ++ reversepath q`) THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_JOIN_EQ; PATH_LINEPATH; PATH_REVERSEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN ASM_REWRITE_TAC[UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `c:complex->bool` THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,e)` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL; EMPTY_SUBSET] THEN ASM_REWRITE_TAC[IN_BALL; CONVEX_BALL]; DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN REWRITE_TAC[PATH_COMPOSE_JOIN; PATH_COMPOSE_REVERSEPATH] THEN W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_JOIN o rand o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_SUB; GSYM VECTOR_ADD_ASSOC] THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_JOIN o rand o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(GSYM WINDING_NUMBER_REVERSEPATH)]] THEN ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATHSTART_COMPOSE; PATHFINISH_COMPOSE; PATH_IMAGE_REVERSEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_REVERSEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_JOIN; PATH_IMAGE_JOIN; IN_UNION; DE_MORGAN_THM] THEN REWRITE_TAC[PATH_IMAGE_COMPOSE; SET_RULE `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`] THEN REPEAT CONJ_TAC THEN ((MATCH_MP_TAC PATH_CONTINUOUS_IMAGE) ORELSE (X_GEN_TAC `x:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC)) THEN ASM_REWRITE_TAC[PATH_LINEPATH] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:complex` THEN STRIP_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN TRY(FIRST_X_ASSUM(fun th -> MATCH_MP_TAC(GEN_REWRITE_RULE I [SUBSET] th) THEN FIRST_X_ASSUM ACCEPT_TAC)) THEN UNDISCH_TAC `(x:complex) IN path_image(linepath(z,w))` THEN SPEC_TAC(`x:complex`,`x:complex`) THEN REWRITE_TAC[GSYM SUBSET; PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,e)` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL; EMPTY_SUBSET] THEN ASM_REWRITE_TAC[IN_BALL; CONVEX_BALL]]; MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\w. Cx(&2) * Cx pi * ii * Cx(&1) / (Cx(&2) * Cx pi * ii) * (pathfinish(l o linepath(z:complex,w)) - pathstart (l o linepath(z,w)))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `e:real` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH `x - y = vec 0 <=> y = x`] THEN REPLICATE_TAC 3 AP_TERM_TAC THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `ball(z:complex,e)` THEN ASM_REWRITE_TAC[PATH_LINEPATH] THEN CONJ_TAC THENL[ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL; EMPTY_SUBSET] THEN ASM_REWRITE_TAC[IN_BALL]; REWRITE_TAC[COMPLEX_VEC_0] THEN REPEAT(MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL) THEN REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH; PATHFINISH_COMPOSE; PATHFINISH_LINEPATH] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM LIM_NULL; GSYM CONTINUOUS_AT] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL; CENTRE_IN_BALL]]]);; (* ------------------------------------------------------------------------- *) (* The winding number defines a continuous logarithm for the path itself. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM = prove (`!p z. path p /\ ~(z IN path_image p) ==> ?q. path q /\ pathfinish q - pathstart q = Cx(&2) * Cx pi * ii * winding_number(p,z) /\ !t. t IN interval[vec 0,vec 1] ==> p(t) = z + cexp(q t)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\t:real^1. Cx(&2) * Cx pi * ii * winding_number(subpath (vec 0) t p,z) + clog(pathstart p - z)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `~((p:real^1->complex) t = z)` ASSUME_TAC THENL [ASM_MESON_TAC[path_image; IN_IMAGE]; ALL_TAC] THEN MP_TAC(SPEC `ball((p:real^1->complex) t,norm(p t - z))` SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG) THEN SIMP_TAC[OPEN_BALL; CONVEX_BALL; CONVEX_IMP_SIMPLY_CONNECTED] THEN DISCH_THEN(MP_TAC o SPEC `\w:complex. w - z` o CONJUNCT2) THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN REWRITE_TAC[COMPLEX_SUB_0] THEN ANTS_TAC THENL [GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[IN_BALL; dist; REAL_LT_REFL]; DISCH_THEN(X_CHOOSE_THEN `l:complex->complex` STRIP_ASSUME_TAC)] THEN ONCE_REWRITE_TAC[WINDING_NUMBER_OFFSET] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN GEN_REWRITE_TAC LAND_CONV [continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `t:real^1`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `norm((p:real^1->complex) t - z)`) THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN EXISTS_TAC `\u. Cx(&1) / (Cx(&2) * Cx pi * ii) * (pathfinish((l:complex->complex) o subpath t u p) - pathstart(l o subpath t u p))` THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `path_image(subpath t u p) SUBSET ball(p t:complex,norm (p t - z))` ASSUME_TAC THENL [REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN SUBGOAL_THEN `segment[t,u] SUBSET interval[vec 0,vec 1] /\ segment[t,u] SUBSET ball(t:real^1,d)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL; CONVEX_INTERVAL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rand o rand) WINDING_NUMBER_COMPOSE_CEXP o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[PATH_SUBPATH] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number((\w. subpath t u p w - z),Cx(&0))` THEN CONJ_TAC THENL [MATCH_MP_TAC WINDING_NUMBER_EQUAL THEN REWRITE_TAC[o_THM; GSYM path_image; SET_RULE `(!x. x IN s ==> cexp(l(subpath t u p x)) = subpath t u p x - z) <=> (!y. y IN IMAGE (subpath t u p) s ==> cexp(l y) = y - z)`] THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[GSYM WINDING_NUMBER_OFFSET] THEN REWRITE_TAC[ETA_AX] THEN MP_TAC(ISPECL [`p:real^1->complex`; `vec 0:real^1`; `t:real^1`; `u:real^1`; `z:complex`] WINDING_NUMBER_SUBPATH_COMBINE) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN CONV_TAC COMPLEX_RING]; REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_SUBPATH; PATHFINISH_COMPOSE; PATHFINISH_SUBPATH] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM LIM_NULL] THEN REWRITE_TAC[GSYM CONTINUOUS_WITHIN] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; path]; MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN UNDISCH_TAC `(l:complex->complex) continuous_on ball(p(t:real^1),norm(p t - z))` THEN SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; NORM_POS_LT]]]; REWRITE_TAC[pathstart; pathfinish; SUBPATH_REFL; SUBPATH_TRIVIAL] THEN MATCH_MP_TAC(COMPLEX_FIELD `w' = Cx(&0) ==> (a * b * c * w + l) - (a * b * c * w' + l) = a * b * c * w`) THEN MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN MP_TAC(ISPEC `p:real^1->complex` PATHSTART_IN_PATH_IMAGE) THEN REWRITE_TAC[pathstart] THEN ASM_MESON_TAC[]; X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN MP_TAC(ISPECL [`subpath (vec 0) t (p:real^1->complex)`; `z:complex`] WINDING_NUMBER_AHLFORS_FULL) THEN REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; PATH_SUBPATH; CEXP_ADD; REWRITE_RULE[SET_RULE `s SUBSET t <=> !x. ~(x IN t) ==> ~(x IN s)`] PATH_IMAGE_SUBPATH_SUBSET] THEN MATCH_MP_TAC(COMPLEX_RING `t:complex = s ==> p - z = e * s ==> p = z + e * t`) THEN REWRITE_TAC[pathstart] THEN MATCH_MP_TAC CEXP_CLOG THEN REWRITE_TAC[COMPLEX_SUB_0] THEN ASM_MESON_TAC[pathstart; PATHSTART_IN_PATH_IMAGE]]);; (* ------------------------------------------------------------------------- *) (* Winding number equality is the same as path/loop homotopy in C - {0}. *) (* ------------------------------------------------------------------------- *) let WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ = prove (`!p z. path p /\ ~(z IN path_image p) ==> (winding_number(p,z) = Cx(&0) <=> ?a. homotopic_loops ((:complex) DELETE z) p (\t. a))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:real^1->complex`; `z:complex`] WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM) THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_SUB_0] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `z + Cx(&1)` THEN MP_TAC(ISPECL [`\r:real^1->complex. pathfinish r = pathstart r`; `q:real^1->complex`; `\t:real^1. Cx(&0)`; `\w. z + cexp w`; `interval[vec 0:real^1,vec 1]`; `(:complex)`; `(:complex) DELETE z`] HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT) THEN ASM_SIMP_TAC[CONTINUOUS_ON_CEXP; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CEXP_0; homotopic_loops; o_DEF] THEN ANTS_TAC THENL [REWRITE_TAC[CEXP_NZ; COMPLEX_EQ_ADD_LCANCEL_0; SET_RULE `IMAGE f UNIV SUBSET UNIV DELETE z <=> !x. ~(f x = z)`] THEN MATCH_MP_TAC HOMOTOPIC_WITH_MONO THEN EXISTS_TAC `\r:real^1->complex. pathfinish r = pathstart r` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM homotopic_loops] THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN REWRITE_TAC[path; pathstart; pathfinish; CONTINUOUS_ON_CONST]; SIMP_TAC[pathstart; pathfinish]]; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN ASM_SIMP_TAC[o_THM; pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]]; FIRST_ASSUM(MP_TAC o MATCH_MP WINDING_NUMBER_HOMOTOPIC_LOOPS) THEN ASM_REWRITE_TAC[GSYM LINEPATH_REFL] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN REWRITE_TAC[GSYM LINEPATH_REFL; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN SET_TAC[]]);; let WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ = prove (`!p z. path p /\ ~(z IN path_image p) ==> (winding_number(p,z) = Cx(&0) <=> homotopic_paths ((:complex) DELETE z) p (linepath(pathstart p,pathstart p)))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_SIMP_TAC[WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ] THEN REWRITE_TAC[GSYM LINEPATH_REFL; HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL; LEFT_IMP_EXISTS_THM]; STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP WINDING_NUMBER_HOMOTOPIC_PATHS) THEN ASM_REWRITE_TAC[GSYM LINEPATH_REFL] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);; let WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ = prove (`!p z. path p /\ ~(z IN path_image p) ==> (winding_number(p,z) = Cx(&0) <=> ?a. homotopic_paths ((:complex) DELETE z) p (\t. a))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_SIMP_TAC[WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ] THEN REWRITE_TAC[GSYM LINEPATH_REFL] THEN MESON_TAC[]; STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP WINDING_NUMBER_HOMOTOPIC_PATHS) THEN ASM_REWRITE_TAC[GSYM LINEPATH_REFL] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN REWRITE_TAC[GSYM LINEPATH_REFL; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN SET_TAC[]]);; let WINDING_NUMBER_HOMOTOPIC_PATHS_EQ = prove (`!p q z. path p /\ ~(z IN path_image p) /\ path q /\ ~(z IN path_image q) /\ pathstart q = pathstart p /\ pathfinish q = pathfinish p ==> (winding_number(p,z) = winding_number(q,z) <=> homotopic_paths ((:complex) DELETE z) p q)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[WINDING_NUMBER_HOMOTOPIC_PATHS] THEN DISCH_TAC THEN MP_TAC(ISPECL [`p ++ reversepath q:real^1->complex`; `z:complex`] WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ) THEN ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH; PATH_IMAGE_JOIN; IN_UNION; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; WINDING_NUMBER_JOIN; WINDING_NUMBER_REVERSEPATH; COMPLEX_ADD_RINV] THEN REWRITE_TAC[GSYM LINEPATH_REFL] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_LOOP_PARTS)) THEN ASM_REWRITE_TAC[]);; let WINDING_NUMBER_HOMOTOPIC_LOOPS_EQ = prove (`!p q z. path p /\ pathfinish p = pathstart p /\ ~(z IN path_image p) /\ path q /\ pathfinish q = pathstart q /\ ~(z IN path_image q) ==> (winding_number(p,z) = winding_number(q,z) <=> homotopic_loops ((:complex) DELETE z) p q)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[WINDING_NUMBER_HOMOTOPIC_LOOPS] THEN DISCH_TAC THEN SUBGOAL_THEN `~(pathstart p:complex = z) /\ ~(pathstart q = z)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN MP_TAC(ISPECL [`(:complex)`; `z:complex`] PATH_CONNECTED_OPEN_DELETE) THEN REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; DIMINDEX_2; LE_REFL] THEN REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL [`pathstart p:complex`; `pathstart q:complex`]) THEN ASM_REWRITE_TAC[IN_UNIV; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^1->complex` THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN STRIP_TAC THEN SUBGOAL_THEN `~(pathstart r:complex = z)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `r ++ q ++ reversepath r:real^1->complex` THEN ASM_SIMP_TAC[HOMOTOPIC_LOOPS_CONJUGATE; SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN W(MP_TAC o PART_MATCH (rand o rand) WINDING_NUMBER_HOMOTOPIC_PATHS_EQ o snd) THEN ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_IMAGE_JOIN; IN_UNION; PATH_IMAGE_REVERSEPATH; WINDING_NUMBER_JOIN; WINDING_NUMBER_REVERSEPATH] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SIMPLE_COMPLEX_ARITH_TAC);; let HOMOTOPIC_LOOPS_PARTCIRCLEPATH = prove (`!g z r n. path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) /\ &0 < r /\ winding_number(g,z) = Cx(n) ==> homotopic_loops ((:complex) DELETE z) g (partcirclepath(z,r,&0,&2 * n * pi))`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) WINDING_NUMBER_HOMOTOPIC_LOOPS_EQ o snd) THEN ASM_REWRITE_TAC[PATH_PARTCIRCLEPATH] THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q /\ r ==> ((p /\ q ==> (r <=> s)) ==> s)`) THEN REPEAT CONJ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] INTEGER_WINDING_NUMBER_EQ)) THEN REWRITE_TAC[PATH_PARTCIRCLEPATH] THEN DISCH_THEN(SUBST1_TAC o SYM); MATCH_MP_TAC(SET_RULE `!s. ~(z IN s) /\ t SUBSET s ==> ~(z IN t)`) THEN EXISTS_TAC `sphere(z:complex,abs r)` THEN ASM_REWRITE_TAC[PATH_IMAGE_PARTCIRCLEPATH_SUBSET_ABS; IN_SPHERE] THEN REWRITE_TAC[DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[WINDING_NUMBER_PARTCIRCLEPATH; REAL_LT_IMP_NZ] THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < p ==> (&2 * n * p - &0) / (&2 * p) = n`] THEN MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] INTEGER_WINDING_NUMBER_EQ) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* A few simple corollaries from the various equivalences. *) (* ------------------------------------------------------------------------- *) let SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH = prove (`!p:real^1->real^2. simple_path p ==> simply_connected(inside(path_image p))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_EMPTY_INSIDE; OPEN_INSIDE; CLOSED_PATH_IMAGE; INSIDE_INSIDE_EQ_EMPTY; CONNECTED_PATH_IMAGE] THEN ASM_CASES_TAC `pathstart(p):real^2 = pathfinish p` THEN ASM_SIMP_TAC[JORDAN_INSIDE_OUTSIDE; INSIDE_ARC_EMPTY; ARC_SIMPLE_PATH] THEN REWRITE_TAC[CONNECTED_EMPTY]);; let HOMEOMORPHIC_INSIDE_SIMPLE_PATH_BALL = prove (`!p:real^1->real^2 a:real^2 r. simple_path p /\ pathfinish p = pathstart p /\ &0 < r ==> inside(path_image p) homeomorphic ball(a,r)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `inside(path_image p):real^2->bool` SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC) THEN MP_TAC(ISPEC `p:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN ASM_SIMP_TAC[HOMEOMORPHIC_BALLS; REAL_LT_01]);; let SIMPLY_CONNECTED_INTER = prove (`!s t:real^2->bool. open s /\ open t /\ simply_connected s /\ simply_connected t /\ connected (s INTER t) ==> simply_connected (s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN SIMP_TAC[SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO; OPEN_INTER] THEN REWRITE_TAC[SUBSET; IN_INTER] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* More sufficient conditions for Borsukian-ness. *) (* ------------------------------------------------------------------------- *) let FINITE_ORDER_FUNDAMENTAL_GROUP_IMP_BORSUKIAN = prove (`!s a:real^N. path_connected s /\ locally path_connected s /\ a IN s /\ (!p. path p /\ path_image p SUBSET s /\ pathstart p = a /\ pathfinish p = a ==> ?n. homotopic_paths s (ITER n ((++) p) p) (linepath(a,a))) ==> borsukian s`, let lemma = prove (`!n f p q. f o ITER n ((++) p) q = ITER n ((++) (f o p)) (f o q)`, INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; PATH_COMPOSE_JOIN]) and wemma = prove (`!p z n. path p /\ pathfinish p = pathstart p /\ ~(z IN path_image p) ==> winding_number(ITER n ((++) p) p,z) = Cx(&n + &1) * winding_number(p,z)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; COMPLEX_MUL_LID; REAL_ADD_LID] THEN W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_JOIN o lhand o snd) THEN ASM_REWRITE_TAC[CX_ADD; GSYM REAL_OF_NUM_SUC] THEN ANTS_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ITER; PATH_JOIN; PATHSTART_JOIN; PATH_IMAGE_JOIN] THEN ASM SET_TAC[]) in REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->complex`; `s:real^N->bool`; `clog(f(a:real^N))`; `a:real^N`] (MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_STRONGER) COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CEXP_CLOG THEN ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN EXISTS_TAC `(f:real^N->complex) a` THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN SUBGOAL_THEN `path((f:real^N->complex) o p)` ASSUME_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `~(Cx(&0) IN path_image((f:real^N->complex) o p))` ASSUME_TAC THENL [REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`ITER n ((++) p) p:real^1->real^N`; `linepath(a:real^N,a)`; `f:real^N->complex`; `s:real^N->bool`; `(:real^2) DIFF {Cx (&0)}`] HOMOTOPIC_PATHS_CONTINUOUS_IMAGE) THEN ASM_REWRITE_TAC[SET_RULE `s DIFF {a} = s DELETE a`; LINEPATH_REFL] THEN DISCH_THEN(MP_TAC o MATCH_MP WINDING_NUMBER_HOMOTOPIC_PATHS) THEN REWRITE_TAC[lemma] THEN W(MP_TAC o PART_MATCH (lhand o rand) wemma o lhand o lhand o snd) THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN REWRITE_TAC[GSYM LINEPATH_REFL] THEN W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_TRIVIAL o rand o lhand o snd) THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; REAL_ARITH `~(&n + &1 = &0)`] THEN W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ o lhand o snd) THEN ASM_REWRITE_TAC[LINEPATH_REFL] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN(X_CHOOSE_THEN `b:complex` (fun th -> MP_TAC th THEN MP_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH th))) THEN ASM_SIMP_TAC[PATHFINISH_COMPOSE] THEN REWRITE_TAC[pathfinish]);; let FINITE_FUNDAMENTAL_GROUP_IMP_BORSUKIAN = prove (`!s:real^N->bool a. path_connected s /\ locally path_connected s /\ a IN s /\ FINITE (fundamental_group(s,a)) ==> borsukian s`, REWRITE_TAC[fundamental_group] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_ORDER_FUNDAMENTAL_GROUP_IMP_BORSUKIAN THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `(!n. path(ITER n ((++) p) (linepath(a:real^N,a)))) /\ (!n. path_image(ITER n ((++) p) (linepath(a:real^N,a))) SUBSET s) /\ (!n. pathstart(ITER n ((++) p) (linepath(a:real^N,a))) = a) /\ (!n. pathfinish(ITER n ((++) p) (linepath(a:real^N,a))) = a)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN INDUCT_TAC THEN ASM_SIMP_TAC[ITER; PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET; SUBSET_PATH_IMAGE_JOIN]; ALL_TAC] THEN MP_TAC(ISPECL [`\n. homotopic_paths s (ITER n ((++) p) (linepath(a:real^N,a)))`; `(:num)`] FINITE_IMAGE_INJ_EQ) THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC(TAUT `~r /\ q /\ (~p ==> s) ==> (p ==> (q <=> r)) ==> s`) THEN REWRITE_TAC[GSYM INFINITE; num_INFINITE] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN MATCH_MP_TAC(SET_RULE `(!n. P(ITER n f p)) ==> (!n. homotopic_paths s (ITER n f p) IN {homotopic_paths s f | P f})`) THEN ASM_MESON_TAC[]; REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC WLOG_LT THEN REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[NOT_IMP; LT_EXISTS; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!a b c. P a b c) <=> (!a c b. P a b c)`] THEN REWRITE_TAC[FORALL_UNWIND_THM2; GSYM ITER_ADD] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN EXISTS_TAC `n:num` THEN TRANS_TAC HOMOTOPIC_PATHS_TRANS `ITER (SUC n) ((++) p) (linepath(a:real^N,a))` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[ITER_ALT] THEN SPEC_TAC(`n:num`,`q:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER] THENL [ASM_MESON_TAC[HOMOTOPIC_PATHS_RID; HOMOTOPIC_PATHS_SYM]; MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN CONV_TAC SYM_CONV THEN SPEC_TAC(`q:num`,`k:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; PATHSTART_JOIN]]; FIRST_X_ASSUM(MP_TAC o C AP_THM `ITER m ((++) p) (linepath(a:real^N,a))`) THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN SPEC_TAC(`m:num`,`q:num`) THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 ITER] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ITER] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_LCANCEL) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`q:num`,`k:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; PATHSTART_JOIN]]]);; (* ------------------------------------------------------------------------- *) (* Pick out the Riemann Mapping Theorem from the earlier chain. *) (* ------------------------------------------------------------------------- *) let RIEMANN_MAPPING_THEOREM = prove (`!s. open s /\ simply_connected s <=> s = {} \/ s = (:real^2) \/ ?f g. f holomorphic_on s /\ g holomorphic_on ball(Cx(&0),&1) /\ (!z. z IN s ==> f z IN ball(Cx(&0),&1) /\ g(f z) = z) /\ (!z. z IN ball(Cx(&0),&1) ==> g z IN s /\ f(g z) = z)`, GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) /\ (c ==> a) ==> (a /\ b <=> c)`) THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN SUBGOAL_THEN `s = IMAGE (g:complex->complex) (ball(Cx(&0),&1))` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN ASM_SIMP_TAC[OPEN_BALL; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Extension of conformal maps to the frontier of the unit disc. *) (* ------------------------------------------------------------------------- *) let TORHORST_CONFORMAL_EXTENSION_THEOREM = prove (`!f s. f holomorphic_on ball(Cx(&0),&1) /\ IMAGE f (ball(Cx(&0),&1)) = s /\ (!w z. w IN ball(Cx(&0),&1) /\ z IN ball(Cx(&0),&1) /\ f w = f z ==> w = z) ==> ((?g. g continuous_on cball(Cx(&0),&1) /\ !z. z IN ball(Cx(&0),&1) ==> g z = f z) <=> bounded s /\ locally connected (frontier s))`, let lemma = prove (`(?a b. ~(a = b) /\ IMAGE g i INTER s = {a,b}) ==> ?a b. a IN IMAGE g i /\ b IN IMAGE g i /\ ~(a = b) /\ IMAGE g i INTER s = {a,b}`, REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SET_TAC[]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(Cx(&0),&1)`] HOLOMORPHIC_ON_INVERSE) THEN ASM_REWRITE_TAC[OPEN_BALL] THEN RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `f':complex->complex` STRIP_ASSUME_TAC) THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM COMPACT_CLOSURE] THEN MP_TAC(ISPECL [`g:complex->complex`; `ball(Cx(&0),&1)`] CLOSURE_IMAGE_BOUNDED) THEN ASM_SIMP_TAC[CLOSURE_BALL; BOUNDED_BALL; REAL_LT_01] THEN SUBGOAL_THEN `IMAGE (g:complex->complex) (ball(Cx(&0),&1)) = s` SUBST1_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; COMPACT_CBALL]; MP_TAC(ISPECL [`g:complex->complex`; `ball(Cx(&0),&1)`] FRONTIER_PROPER_HOLOMORPHIC_IMAGE) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BOUNDED_BALL] THEN ASM_SIMP_TAC[CLOSURE_BALL; FRONTIER_BALL; REAL_LT_01] THEN SUBGOAL_THEN `IMAGE (g:complex->complex) (ball(Cx(&0),&1)) = s` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_EQ]; ALL_TAC] THEN X_GEN_TAC `k:complex->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN ball(Cx (&0),&1) /\ (g:complex->complex) x IN k} = IMAGE f' k` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT THEN REWRITE_TAC[COMPACT_SPHERE; LOCALLY_CONNECTED_SPHERE] THEN ASM_MESON_TAC[SPHERE_SUBSET_CBALL; CONTINUOUS_ON_SUBSET]]]; STRIP_TAC] THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(Cx(&0),&1)`] UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN ASM_SIMP_TAC[CLOSURE_BALL; REAL_LT_01] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS]] THEN ABBREV_TAC `A = {z:complex | &1 / &2 < norm z /\ norm z < &1}` THEN SUBGOAL_THEN `bounded(A:complex->bool)` ASSUME_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN REWRITE_TAC[BOUNDED_BALL] THEN EXPAND_TAC "A" THEN SIMP_TAC[SUBSET; IN_ELIM_THM; COMPLEX_IN_BALL_0]; ALL_TAC] THEN MATCH_MP_TAC UNIFORMLY_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(Cx(&0),&1 / &2) UNION A` THEN CONJ_TAC THENL [MATCH_MP_TAC UNIFORMLY_CONTINUOUS_ON_UNION THEN ASM_REWRITE_TAC[BOUNDED_CBALL; CLOSURE_CBALL] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; SUBSET; IN_UNION] THEN EXPAND_TAC "A" THEN SIMP_TAC[SUBSET; IN_ELIM_THM; COMPLEX_IN_BALL_0; COMPLEX_IN_CBALL_0] THEN REAL_ARITH_TAC]; EXPAND_TAC "A" THEN REWRITE_TAC[IN_UNION; SUBSET] THEN REWRITE_TAC[COMPLEX_IN_BALL_0; COMPLEX_IN_CBALL_0; IN_ELIM_THM] THEN REAL_ARITH_TAC] THEN SUBGOAL_THEN `!e. &0 < e ==> ?d. &0 < d /\ !x y. x IN (:complex) DIFF s /\ y IN (:complex) DIFF s /\ dist(x,y) < d ==> ?c. x IN c /\ y IN c /\ DISJOINT c s /\ connected c /\ bounded c /\ diameter c <= e` (LABEL_TAC "ULC") THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `frontier s:complex->bool` COMPACT_LOCALLY_CONNECTED_IMP_ULC) THEN ASM_SIMP_TAC[COMPACT_FRONTIER_BOUNDED] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (e / &3)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; IN_DIFF; IN_UNIV] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN STRIP_TAC THEN ASM_CASES_TAC `DISJOINT (segment[a:complex,b]) s` THENL [EXISTS_TAC `segment[a:complex,b]` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN REWRITE_TAC[BOUNDED_SEGMENT; DIAMETER_SEGMENT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(segment[a:complex,b] INTER frontier s = {})` ASSUME_TAC THENL [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN REWRITE_TAC[CONNECTED_SEGMENT] THEN MP_TAC(ISPECL [`a:complex`; `b:complex`] ENDS_IN_SEGMENT) THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`a':complex = closest_point (segment[a,b] INTER frontier(s)) a`; `b':complex = closest_point (segment[a,b] INTER frontier(s)) b`] THEN SUBGOAL_THEN `(a':complex) IN segment[a,b] INTER frontier(s) /\ (b':complex) IN segment[a,b] INTER frontier(s)` MP_TAC THENL [MAP_EVERY EXPAND_TAC ["a'"; "b'"] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_SET THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT; FRONTIER_CLOSED]; REWRITE_TAC[IN_INTER] THEN STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a':complex`; `b':complex`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [TRANS_TAC REAL_LET_TRANS `dist(a:complex,b)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_IN_CLOSED_SEGMENT_2 THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_THEN `c:complex->bool` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `segment[a:complex,a'] UNION segment[b,b'] UNION c` THEN ASM_REWRITE_TAC[IN_UNION; ENDS_IN_SEGMENT] THEN ASM_SIMP_TAC[BOUNDED_UNION; BOUNDED_SEGMENT] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT (s UNION t) u <=> DISJOINT s u /\ DISJOINT t u`] THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM FRONTIER_DISJOINT_EQ]) THEN REPEAT CONJ_TAC THENL [ALL_TAC; ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `DISJOINT (segment[a,b] DELETE b) s /\ ~(b IN s) ==> DISJOINT(segment[a,b]) s`) THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC(SET_RULE `(~(s = {}) ==> s INTER t = {}) ==> DISJOINT s t`) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(segment[a,b] DELETE b = {}) ==> (segment[a,a] = {a} ==> ~(a = b))`)) THEN REWRITE_TAC[SEGMENT_REFL] THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `p /\ ~q /\ ~r ==> ~s <=> ~r /\ p /\ s ==> q`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_SEMIOPEN_SEGMENT] THEN (CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `a IN segment[a,b] /\ ~(a IN s) /\ ~(a = b) ==> ~(segment[a,b] DELETE b DIFF s = {})`) THEN REWRITE_TAC[ENDS_IN_SEGMENT] THEN ASM SET_TAC[]; ALL_TAC]) THEN MP_TAC(ISPEC `segment[a:complex,b] INTER frontier s` CLOSEST_POINT_EXISTS) THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT; FRONTIER_CLOSED] THENL [DISCH_THEN(MP_TAC o SPEC `a:complex`); DISCH_THEN(MP_TAC o SPEC `b:complex`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[SET_RULE `(s DELETE a) INTER t = {} <=> !y. y IN s INTER t ==> y = a`] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_INTER] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_SEGMENT; SUBSET; ENDS_IN_SEGMENT]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC]) THEN MATCH_MP_TAC(NORM_ARITH `~(p = q) /\ (~(x = a) ==> dist(a,x) < dist(p,q)) ==> ~(dist(p,q) <= dist(a,x))`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_CLOSED_OPEN]) THEN ASM_REWRITE_TAC[IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN CONV_TAC NORM_ARITH; REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONNECTED_SEGMENT] THEN CONJ_TAC THEN ASM_REWRITE_TAC[]) THEN MATCH_MP_TAC(SET_RULE `b IN segment[a,b] /\ b IN s ==> ~(segment[a,b] INTER s = {})`) THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; IN_UNION]; W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_UNION_LE o lhand o snd) THEN ASM_SIMP_TAC[BOUNDED_UNION; BOUNDED_SEGMENT] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a':complex` THEN ASM_REWRITE_TAC[IN_INTER; ENDS_IN_SEGMENT; IN_UNION]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_UNION_LE o rand o lhand o snd) THEN ASM_SIMP_TAC[BOUNDED_UNION; BOUNDED_SEGMENT] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `b':complex` THEN ASM_REWRITE_TAC[IN_INTER; ENDS_IN_SEGMENT; IN_UNION]; MATCH_MP_TAC(REAL_ARITH `c <= e / &3 /\ a < e / &3 /\ b < e / &3 ==> bc <= b + c ==> a + bc <= e`)] THEN ASM_REWRITE_TAC[DIAMETER_SEGMENT] THEN CONJ_TAC THEN TRANS_TAC REAL_LET_TRANS `dist(a:complex,b)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_IN_CLOSED_SEGMENT_2 THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT]]; ALL_TAC] THEN REWRITE_TAC[uniformly_continuous_on] THEN MATCH_MP_TAC(MESON[REAL_ARITH `&0 < e /\ &0 < d ==> &0 < min e (d / &2) /\ min e (d / &2) <= e /\ min e (d / &2) < d`] `!d. (!d e. &0 < d /\ d <= e /\ P d ==> P e) /\ &0 < d /\ (!e. &0 < e /\ e < d ==> P e) ==> (!e. &0 < e ==> P e)`) THEN EXISTS_TAC `setdist({(f:complex->complex)(Cx(&0))},frontier s) * &2` THEN CONJ_TAC THENL [MESON_TAC[REAL_LTE_TRANS]; ALL_TAC] THEN SIMP_TAC[REAL_ARITH `a < b * &2 <=> a / &2 < b`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN SUBGOAL_THEN `~(s:complex->bool = {})` ASSUME_TAC THENL [EXPAND_TAC "s" THEN REWRITE_TAC[IMAGE_EQ_EMPTY; BALL_EQ_EMPTY] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `~(frontier s:complex->bool = {})` ASSUME_TAC THENL [ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY] THEN ASM_MESON_TAC[NOT_BOUNDED_UNIV]; ASM_SIMP_TAC[CLOSURE_CLOSED; FRONTIER_CLOSED]] THEN CONJ_TAC THENL [REWRITE_TAC[frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN EXPAND_TAC "s" THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN REMOVE_THEN "ULC" (MP_TAC o SPEC `e / &4`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[REAL_ARITH `(&0 < d ==> &0 < d / &2 /\ (x <= d / &2 ==> x < d))`] `(?d. &0 < d /\ (!x y. P x /\ P y /\ dist(x,y) < d ==> R x y)) ==> ?d. &0 < d /\ (!x y. P x /\ P y /\ dist(x,y) <= d ==> R x y)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[REAL_ARITH `&0 < d /\ &0 < e ==> &0 < min d e / &4 /\ min d e / &4 < d /\ min d e / &4 < e /\ min d e / &4 < e / &2`] `(?d. &0 < d /\ P d) ==> (!d e. &0 < d /\ d < e /\ P e ==> P d) ==> !e. &0 < e ==> ?d. &0 < d /\ d < e /\ d < e / &2 /\ P d`)) THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?k. &0 < k /\ k < &1 / &4 /\ k < exp(-- &4 * pi * measure(s:complex->bool) / d pow 2)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_LT_MIN; GSYM REAL_LT_BETWEEN] THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_EXP_POS_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`z:complex`; `z':complex`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `((\x. lift(norm(complex_derivative f x) pow 2)) has_integral (lift(measure(s:complex->bool)))) (ball(Cx(&0),&1))` MP_TAC THENL [MP_TAC(ISPECL [`f:complex->complex`; `\z h. complex_derivative f z * h`; `ball(Cx(&0),&1)`] MEASURE_DIFFERENTIABLE_IMAGE_EQ) THEN MP_TAC(ISPECL [`f:complex->complex`; `\z h. complex_derivative f z * h`; `ball(Cx(&0),&1)`] MEASURABLE_DIFFERENTIABLE_IMAGE_EQ) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_BALL] THEN REWRITE_TAC[GSYM has_complex_derivative] THEN MATCH_MP_TAC(TAUT `s /\ p /\ q /\ (r /\ t ==> u) ==> (p /\ q ==> (s <=> r)) ==> (p /\ q /\ r ==> t) ==> u`) THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[MEASURABLE_OPEN]; SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_BALL]; ASM_MESON_TAC[]; REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL]] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ); DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_EQ] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_SQNORM; DET_2; matrix] THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_2; ARITH] THEN REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; complex_mul; COMPLEX_BASIS] THEN REWRITE_TAC[RE_CX; IM_CX; RE; IM; RE_II; IM_II] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; REAL_SUB_RZERO] THEN REWRITE_TAC[REAL_ADD_RID; REAL_SUB_LZERO; REAL_ADD_LID] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x pow 2 /\ &0 <= y pow 2 ==> abs(x * x - --y * y) = x pow 2 + y pow 2`) THEN REWRITE_TAC[REAL_LE_POW_2]; GEN_REWRITE_TAC LAND_CONV [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN SUBST1_TAC(SYM(ISPEC `z:complex` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_TRANSLATION]] THEN ABBREV_TAC `h = \x. if z + x IN ball(Cx(&0),&1) then complex_derivative f (z + x) else vec 0` THEN SUBGOAL_THEN `(\x. if z + x IN ball(Cx(&0),&1) then lift(norm(complex_derivative f (z + x)) pow 2) else vec 0) = (\x. lift(norm((h:complex->complex) x) pow 2))` SUBST1_TAC THENL [EXPAND_TAC "h" THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP; NORM_0; REAL_POW_ZERO; ARITH; LIFT_NUM]; DISCH_TAC] THEN MP_TAC(ISPEC `\x. lift(norm((h:complex->complex) x) pow 2)` FUBINI_POLAR) THEN SUBGOAL_THEN `(\x. lift(norm((h:complex->complex) x) pow 2)) absolutely_integrable_on (:complex)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN MATCH_MP_TAC(TAUT `(q <=> p) ==> p ==> q`) THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS THEN EXPAND_TAC "h" THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP; REAL_LE_POW_2; DROP_VEC; REAL_POS]; ASM_REWRITE_TAC[]] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN STRIP_TAC THEN SUBGOAL_THEN `!r. (\t. (h:complex->complex) (Cx r * cexp(ii * Cx(drop t)))) measurable_on interval[vec 0,lift(&2 * pi)]` ASSUME_TAC THENL [REWRITE_TAC[FORALL_DROP] THEN X_GEN_TAC `r:real^1` THEN EXPAND_TAC "h" THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MESON[] `(if p then if q then x else vec 0 else vec 0) = (if p /\ q then x else vec 0)`] THEN REWRITE_TAC[SET_RULE `x IN s /\ P x <=> x IN s INTER {x | P x}`] THEN ONCE_REWRITE_TAC[MEASURABLE_ON_UNIV] THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN ASM_REWRITE_TAC[OPEN_BALL]]; MATCH_MP_TAC LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN THEN REWRITE_TAC[OPEN_BALL; LEBESGUE_MEASURABLE_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL]] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]; ALL_TAC] THEN SUBGOAL_THEN `negligible {r | &0 <= drop r /\ ~((\x. lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop x))):complex))) absolutely_integrable_on interval[vec 0,lift(&2 * pi)] /\ drop(integral (interval[vec 0,lift(&2 * pi)]) (\x. lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop x))))))) pow 2 <= &2 * pi * drop(integral (interval[vec 0,lift(&2 * pi)]) (\x. lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop x)))) pow 2))))}` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[NEGLIGIBLE_SUBSET; NEGLIGIBLE_SING; NEGLIGIBLE_UNION] `negligible s ==> t SUBSET {vec 0} UNION s ==> negligible t`)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; IN_SING] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP; GSYM DROP_EQ; DROP_VEC] THEN X_GEN_TAC `r:real` THEN ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `&0 <= r` THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CMUL_EQ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(\x. vec 1):real^1->real^1`; `\t. (h:complex->complex) (Cx r * cexp(ii * Cx(drop t)))`; `interval[vec 0,lift(&2 * pi)]`] SQUARE_INTEGRAL_SQUARE_INTEGRABLE_PRODUCT_LE) THEN MP_TAC(ISPECL [`\x y. lift(drop x * drop y)`; `\t:real^1. lift(norm(vec 1:real^1))`; `\t. lift(norm((h:complex->complex) (Cx r * cexp(ii * Cx(drop t)))))`; `interval[vec 0,lift(&2 * pi)]`] ABSOLUTELY_INTEGRABLE_SQUARE_INTEGRABLE_PRODUCT) THEN ASM_REWRITE_TAC[NORM_1; LIFT_DROP; NORM_LIFT; DROP_VEC; o_THM] THEN REWRITE_TAC[REAL_ABS_NORM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM; REAL_MUL_LID; MEASURABLE_ON_CONST_EQ] THEN REWRITE_TAC[INTEGRABLE_ON_CONST; INTEGRAL_CONST] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL; MEASURABLE_INTERVAL] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ASM_SIMP_TAC[MEASURABLE_ON_NORM; BILINEAR_LIFT_MUL] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC(REAL_ARITH `x * a = x * (&2 * pi) ==> a * x <= &2 * pi * x`) THEN AP_TERM_TAC THEN SIMP_TAC[CONTENT_1; DROP_VEC; LIFT_DROP; PI_POS; DROP_CMUL; REAL_ARITH `&0 < pi ==> &0 <= &2 * pi`] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `k < sqrt k` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_RSQRT THEN REWRITE_TAC[REAL_ARITH `k pow 2 < k <=> &0 < k * (&1 - k)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?r. k < r /\ r < sqrt k /\ (\t. r % lift(norm(h(Cx r * cexp(ii * Cx(drop t))):complex))) absolutely_integrable_on interval[vec 0,lift(&2 * pi)] /\ drop(integral (interval[vec 0,lift(&2 * pi)]) (\t. r % lift(norm(h(Cx r * cexp(ii * Cx(drop t))))))) < d` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MESON[] `~(!x. P x /\ Q x /\ R x ==> ~S x) ==> ?x. P x /\ Q x /\ R x /\ S x`) THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN UNDISCH_TAC `k < exp(-- &4 * pi * measure(s:complex->bool) / d pow 2)` THEN MP_TAC(SPEC `k:real` EXP_LOG) THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN REWRITE_TAC[REAL_ARITH `-- &4 * x * a / b <= y <=> --y <= (&4 * x * a) / b`] THEN ASM_SIMP_TAC[GSYM LOG_INV; REAL_LE_RDIV_EQ; REAL_POW_LT] THEN REWRITE_TAC[REAL_ARITH `x * y <= &4 * z <=> y * x / &2 <= &2 * z`] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[lift(k),lift(sqrt k)]) (\x. lift(d pow 2 / drop x)))` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`lift o (\t. d pow 2 * log t) o drop`; `\t. lift(d pow 2 / drop t)`; `lift k`; `lift(sqrt k)`] FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[LIFT_DROP; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[GSYM HAS_REAL_VECTOR_DERIVATIVE_AT] THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN ASM_SIMP_TAC[o_THM; LOG_SQRT; LIFT_DROP; LOG_INV; DROP_SUB] THEN REAL_ARITH_TAC]; ALL_TAC] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM LIFT_DROP] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 4 RAND_CONV) [SYM th]) THEN REWRITE_TAC[GSYM DROP_CMUL] THEN ASM_SIMP_TAC[GSYM INTEGRAL_CMUL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; INTEGRABLE_CMUL] THEN TRANS_TAC REAL_LE_TRANS `drop (integral (interval[lift(k),lift(sqrt k)]) (\r. &2 % pi % integral (interval[vec 0,lift(&2 * pi)]) (\t. drop r % lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop t))):complex) pow 2))))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE_AE THEN EXISTS_TAC `{r | &0 <= drop r /\ ~((\t. drop r % lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop t))):complex) pow 2)) absolutely_integrable_on interval[vec 0,lift(&2 * pi)])}` THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; INTEGRABLE_CMUL] THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p /\ r ==> p /\ q /\ r`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; INTEGRABLE_CMUL]; REWRITE_TAC[SUBSET; IN_INTERVAL_1; FORALL_LIFT; LIFT_DROP; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[FORALL_LIFT; LIFT_DROP; IN_ELIM_THM; IN_DIFF] THEN X_GEN_TAC `r:real` THEN ASM_CASES_TAC `&0 <= r` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[DROP_CMUL; REAL_ARITH `&0 <= &2 * x <=> &0 <= x`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[PI_POS_LE] THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ASM_SIMP_TAC[DROP_CMUL; LIFT_DROP; REAL_LE_MUL; REAL_LE_POW_2]]] THEN MATCH_MP_TAC INTEGRAL_DROP_LE_AE THEN EXISTS_TAC `{lift k,lift(sqrt k)} UNION {r | &0 <= drop r /\ ~((\t. drop r % lift (norm(h(Cx (drop r) * cexp(ii * Cx(drop t)))) pow 2)) absolutely_integrable_on interval[vec 0,lift(&2 * pi)])} UNION {r | &0 <= drop r /\ ~((\x. lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop x))):complex))) absolutely_integrable_on interval[vec 0,lift(&2 * pi)] /\ drop(integral (interval[vec 0,lift(&2 * pi)]) (\x. lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop x))))))) pow 2 <= &2 * pi * drop(integral (interval[vec 0,lift(&2 * pi)]) (\x. lift(norm(h(Cx(drop r) * cexp(ii * Cx(drop x)))) pow 2))))}` THEN ASM_SIMP_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN STRIP_TAC THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV) THEN REWRITE_TAC[LIFT_DROP; CONTINUOUS_AT_ID] THEN ASM_REAL_ARITH_TAC; REPEAT(MATCH_MP_TAC INTEGRABLE_CMUL) THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `{r | &0 <= drop r}` THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_ELIM_THM; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_DIFF; IN_UNION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP; IN_INTERVAL_1; LIFT_EQ] THEN X_GEN_TAC `r:real` THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LT_IMP_LE]] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_CMUL_EQ; REAL_LT_IMP_NZ] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTEGRAL_CMUL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[DROP_CMUL; REAL_ARITH `a <= &2 * pi * r * x <=> a <= (&2 * pi * x) * r`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM real_div] THEN REWRITE_TAC[GSYM REAL_POW_DIV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM DROP_CMUL] THEN ASM_SIMP_TAC [GSYM INTEGRAL_CMUL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_CMUL] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL [UNDISCH_TAC `(z:complex) IN A` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN EXPAND_TAC "A" THEN SIMP_TAC[IN_ELIM_THM; COMPLEX_NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `r < &1 / &2` ASSUME_TAC THENL [TRANS_TAC REAL_LTE_TRANS `sqrt k` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?u v. &0 <= u /\ u < v /\ v <= u + &2 * pi /\ path_image(partcirclepath (z,r,u,v)) = cball(Cx(&0),&1) INTER sphere(z,r) /\ IMAGE (partcirclepath (z,r,u,v)) (interval(vec 0,vec 1)) SUBSET ball(Cx(&0),&1) /\ (pathfinish(partcirclepath (z,r,u,v)) IN ball(Cx(&0),&1) <=> pathstart(partcirclepath (z,r,u,v)) IN ball(Cx(&0),&1))` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `sphere(z,r) SUBSET ball(Cx(&0),&1)` THENL [MAP_EVERY EXISTS_TAC [`&0`; `&2 * pi`] THEN REWRITE_TAC[GSYM circlepath; PATH_IMAGE_CIRCLEPATH] THEN REWRITE_TAC[REAL_LE_REFL; REAL_ADD_LID] THEN CONJ_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE `IMAGE g i = s /\ IMAGE g i SUBSET b /\ b SUBSET c /\ j SUBSET i /\ f IN IMAGE g i /\ k IN IMAGE g i ==> IMAGE g i = c INTER s /\ IMAGE g j SUBSET b /\ (f IN b <=> k IN b)`) THEN REWRITE_TAC[GSYM path_image; BALL_SUBSET_CBALL] THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE] THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE]; ALL_TAC] THEN ABBREV_TAC `w:complex = (&1 + r / norm(z)) % z` THEN SUBGOAL_THEN `w IN sphere(z:complex,r)` ASSUME_TAC THENL [EXPAND_TAC "w" THEN REWRITE_TAC[IN_SPHERE; VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[NORM_ARITH `dist(z,&1 % z + w) = norm w`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; COMPLEX_NORM_ZERO] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!y:complex. y IN sphere(z,r) /\ ~(y = w) ==> norm y < norm w` ASSUME_TAC THENL [EXPAND_TAC "w" THEN REWRITE_TAC[NORM_MUL; IN_SPHERE] THEN ASM_SIMP_TAC[real_abs; REAL_LE_ADD; REAL_POS; REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE] THEN ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD `~(z = &0) ==> (&1 + r / z) * z = z + r`] THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN EXPAND_TAC "r" THEN REWRITE_TAC[NORM_ARITH `norm w < norm z + dist(z,w) <=> ~(dist(vec 0,w) = dist(vec 0,z) + dist(z,w))`] THEN REWRITE_TAC[COMPLEX_VEC_0; GSYM between] THEN REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `q:real` MP_TAC) THEN ASM_CASES_TAC `q = &0` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO] THEN ASM_CASES_TAC `q = &1` THEN ASM_SIMP_TAC[GSYM DIST_EQ_0; COMPLEX_MUL_LID; REAL_LT_IMP_NZ] THEN ASM_REWRITE_TAC[REAL_LE_LT; DIST_EQ_0] THEN STRIP_TAC THEN UNDISCH_TAC `~(y:complex = w)` THEN EXPAND_TAC "w" THEN REWRITE_TAC[VECTOR_ARITH `y = (&1 + e) % z <=> z - y = --e % z`] THEN EXPAND_TAC "r" THEN REWRITE_TAC[ASSUME `z = Cx q * y`] THEN REWRITE_TAC[GSYM COMPLEX_CMUL; NORM_MUL; NORM_NEG; dist; VECTOR_ARITH `q % y - y = --((&1 - q) % y)`] THEN ASM_SIMP_TAC[real_div; REAL_INV_MUL; real_abs; REAL_LT_IMP_LE; REAL_SUB_LE; VECTOR_MUL_LNEG; VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(REAL_FIELD `~(q = &0) /\ ~(y = &0) ==> &1 - q = (((&1 - q) * y) * inv q * inv y) * q`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO] THEN ASM_MESON_TAC[COMPLEX_MUL_RZERO]; ALL_TAC] THEN SUBGOAL_THEN `~(w IN ball(Cx(&0),&1))` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_IN_BALL_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; COMPLEX_IN_BALL_0]) THEN ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `w IN path_image(circlepath(z,r))` MP_TAC THENL [ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image]] THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN ABBREV_TAC `g = shiftpath p (circlepath(z,r))` THEN SUBGOAL_THEN `pathstart g:complex = w /\ pathfinish g = w` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["g"; "w"] THEN ASM_MESON_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH; PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH; IN_INTERVAL_1; DROP_VEC]; ALL_TAC] THEN SUBGOAL_THEN `simple_path(g:real^1->complex)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN MATCH_MP_TAC SIMPLE_PATH_SHIFTPATH THEN ASM_REWRITE_TAC[PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH] THEN ASM_SIMP_TAC[SIMPLE_PATH_CIRCLEPATH; REAL_LT_IMP_NZ]; ALL_TAC] THEN SUBGOAL_THEN `path_image g = sphere(z:complex,r)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; PATHFINISH_CIRCLEPATH; REAL_LT_IMP_LE; PATHSTART_CIRCLEPATH; PATH_IMAGE_CIRCLEPATH]; ALL_TAC] THEN SUBGOAL_THEN `?a b. a IN interval[vec 0,vec 1] /\ b IN interval[vec 0,vec 1] /\ drop a < drop b /\ g(a) IN sphere(Cx(&0),&1) /\ g(b) IN sphere(Cx(&0),&1) /\ IMAGE g (interval[a,b]) = sphere(z,r) INTER cball(Cx(&0),&1) /\ IMAGE g (interval(a,b)) = sphere(z,r) INTER ball(Cx(&0),&1)` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `sphere(z,r) SUBSET cball(Cx(&0),&1)` THENL [SUBGOAL_THEN `w IN sphere(Cx(&0),&1)` ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM CBALL_DIFF_BALL; IN_DIFF] THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^1`; `vec 1:real^1`] THEN REWRITE_TAC[DROP_VEC; REAL_LT_01; ENDS_IN_UNIT_INTERVAL] THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN MATCH_MP_TAC(SET_RULE `!w. w IN u /\ g a = w /\ g b = w /\ (!x. x IN i DIFF {a,b} ==> ~(g x = g a)) /\ IMAGE g i = c /\ c DELETE w = d ==> g a IN u /\ g b IN u /\ IMAGE g i = c /\ IMAGE g (i DIFF {a,b}) = d`) THEN EXISTS_TAC `w:complex` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]; ASM_REWRITE_TAC[GSYM path_image] THEN ASM SET_TAC[]; REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN MATCH_MP_TAC(SET_RULE `~(w IN b) /\ w IN r /\ w IN s /\ (!z. z IN r /\ ~(z = w) ==> ~(z IN s)) ==> (r INTER (b UNION s)) DELETE w = r INTER b`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPLEX_IN_SPHERE_0] THEN ASM_MESON_TAC[COMPLEX_IN_SPHERE_0; REAL_LT_REFL]]; ALL_TAC] THEN SUBGOAL_THEN `~(w IN cball(Cx(&0),&1))` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_IN_CBALL_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; COMPLEX_IN_CBALL_0]) THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `(sphere(z,r) INTER sphere(Cx(&0),&1)) HAS_SIZE 2` MP_TAC THENL [MP_TAC(ISPECL [ `z:complex`; `Cx(&0)`; `r:real`; `&1`] CARD_CIRCLE_INTERSECTION_LE) THEN MP_TAC(ISPECL [ `z:complex`; `Cx(&0)`; `r:real`; `&1`] FINITE_CIRCLE_INTERSECTION) THEN ASM_REWRITE_TAC[HAS_SIZE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [ `z:complex`; `Cx(&0)`; `r:real`; `&1`] HAS_SIZE_INTER_SPHERE_1) THEN DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(p <=> q) ==> ~q ==> ~p`)) THEN ANTS_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC(ARITH_RULE `~(n = 0) ==> ~(n = 1) ==> n <= 2 ==> n = 2`) THEN ASM_SIMP_TAC[CARD_EQ_0] THEN REWRITE_TAC[INTER_SPHERE_EQ_EMPTY] THEN REWRITE_TAC[DIMINDEX_2; ARITH_EQ; dist; COMPLEX_SUB_RZERO]] THEN UNDISCH_TAC `~(sphere(z,r) SUBSET cball(Cx (&0),&1))` THEN SIMP_TAC[SPHERE_SUBSET_CONVEX; CONVEX_CBALL; SUBSET_BALLS] THEN ASM_SIMP_TAC[dist; COMPLEX_SUB_RZERO; DE_MORGAN_THM] THEN UNDISCH_TAC `(z:complex) IN A` THEN EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; CONV_TAC(LAND_CONV HAS_SIZE_CONV)] THEN SUBST1_TAC(SYM(ASSUME `path_image g = sphere(z:complex,r)`)) THEN REWRITE_TAC[path_image] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]; REWRITE_TAC[FORALL_DROP; LIFT_DROP]] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN ASM_REWRITE_TAC[CONJ_ASSOC; GSYM BALL_UNION_SPHERE] THEN ASM_SIMP_TAC[CLOSED_OPEN_INTERVAL_1; REAL_LT_IMP_LE] THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(a:real^1 = vec 0) /\ ~(a = vec 1) /\ ~(b:real^1 = vec 0) /\ ~(b = vec 1)` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM SPHERE_UNION_BALL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < drop a /\ drop a < &1 /\ &0 < drop b /\ drop b < &1` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]; ALL_TAC] THEN MP_TAC(ISPECL [`IMAGE (g:real^1->real^2) (interval[vec 0,vec 1] DIFF interval[a,b])`; `cball(Cx(&0),&1)`] CONNECTED_INTER_FRONTIER) THEN MATCH_MP_TAC(TAUT `p /\ s /\ ~r /\ (q ==> t) ==> (p /\ ~q /\ ~r ==> ~s) ==> t`) THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `interval[vec 0,vec 1] DIFF interval[a,b] = {x | &0 <= drop x /\ drop x < drop a} UNION {x | drop b < drop x /\ drop x <= &1}` SUBST1_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; EXTENSION; IN_DIFF; IN_ELIM_THM; IN_UNION; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMAGE_UNION] THEN MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC; GSYM MEMBER_NOT_EMPTY] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1_CASES] THEN (CONJ_TAC THENL [ALL_TAC; SET_TAC[]]) THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path; SIMPLE_PATH_IMP_PATH] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `w:complex` THEN REWRITE_TAC[IN_INTER; IN_IMAGE] THEN CONJ_TAC THENL [EXISTS_TAC `vec 0:real^1`; EXISTS_TAC `vec 1:real^1`] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; DROP_VEC; REAL_LE_REFL]]; REWRITE_TAC[FRONTIER_CBALL] THEN MATCH_MP_TAC(SET_RULE `a IN interval[a,b] /\ b IN interval[a,b] /\ (!t. t IN i /\ ~(t = a) /\ ~(t = b) ==> ~(g t = g a) /\ ~(g t = g b)) /\ IMAGE g i INTER s = {g a,g b} ==> IMAGE g (i DIFF interval[a,b]) INTER s = {}`) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONJ_ASSOC] THEN ASM_SIMP_TAC[INTERVAL_NE_EMPTY_1; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF] THEN EXISTS_TAC `w:complex` THEN ASM_REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[IN_DIFF; ENDS_IN_UNIT_INTERVAL] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN MP_TAC(ISPECL [`IMAGE (g:real^1->real^2) (interval(a,b))`; `ball(Cx(&0),&1)`] CONNECTED_INTER_FRONTIER) THEN MATCH_MP_TAC(TAUT `p /\ s /\ ~q /\ (r ==> t) ==> (p /\ ~q /\ ~r ==> ~s) ==> t`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path; SIMPLE_PATH_IMP_PATH] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; SIMP_TAC[FRONTIER_BALL; REAL_LT_01] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g i INTER s = {g a,g b} ==> ~(a IN j) /\ ~(b IN j) /\ j SUBSET i /\ (!t. t IN i /\ ~(t = a) /\ ~(t = b) ==> ~(g t = g a) /\ ~(g t = g b)) ==> IMAGE g j INTER s = {}`)) THEN REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g (i DIFF a') INTER c = {} ==> b SUBSET c /\ IMAGE g (a' DIFF a) INTER b = {} /\ ~(IMAGE g i INTER b = {}) ==> ~(IMAGE g a INTER b = {})`)) THEN REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; BALL_SUBSET_CBALL] THEN REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM path_image; CBALL_DIFF_SPHERE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`ball(Cx(&0),&1)`; `cball(z:complex,r)`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_BALL; FRONTIER_CBALL; NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN REWRITE_TAC[INTER_BALLS_EQ_EMPTY; SUBSET_BALLS] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN UNDISCH_TAC `(z:complex) IN A` THEN EXPAND_TAC "A" THEN REWRITE_TAC[COMPLEX_SUB_RZERO; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `a SUBSET i /\ IMAGE g (i DIFF a) INTER b = {} ==> IMAGE g a DIFF b = {} ==> IMAGE g a = IMAGE g i INTER b`) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g (i DIFF ab) INTER c = {} ==> d SUBSET c /\ {g a,g b} INTER d = {} ==> IMAGE g (i DIFF (ab DIFF {a,b})) INTER d = {}`)) THEN REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`&2 * pi * (drop p + drop a)`; `&2 * pi * (drop p + drop b)`] THEN REWRITE_TAC[REAL_ARITH `&2 * pi * x + &2 * pi = &2 * pi * (x + &1)`] THEN SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_LE_MUL_EQ; REAL_ARITH `&0 < &2`; PI_POS] THEN REPLICATE_TAC 3 (CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN ABBREV_TAC `q = partcirclepath (z,r,&2 * pi * (drop p + drop a),&2 * pi * (drop p + drop b))` THEN SUBGOAL_THEN `pathstart q:complex = g(a:real^1) /\ pathfinish q = g b` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["q"; "g"] THEN SIMP_TAC[SHIFTPATH_CIRCLEPATH] THEN REWRITE_TAC[PATHSTART_PARTCIRCLEPATH; PATHFINISH_PARTCIRCLEPATH] THEN REWRITE_TAC[partcirclepath; LINEPATH_CX] THEN CONJ_TAC THEN REPLICATE_TAC 5 AP_TERM_TAC THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM CBALL_DIFF_SPHERE; IN_DIFF] THEN REWRITE_TAC[CBALL_DIFF_SPHERE]] THEN SIMP_TAC[path_image; CLOSED_OPEN_INTERVAL_1; DROP_VEC; REAL_POS] THEN SUBGOAL_THEN `IMAGE (q:real^1->complex) (interval(vec 0,vec 1)) = IMAGE (g:real^1->complex) (interval(a,b))` ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[IMAGE_UNION; INTER_SUBSET] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SYM th]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN ASM_SIMP_TAC[CLOSED_OPEN_INTERVAL_1; REAL_LT_IMP_LE] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM SET_TAC[]] THEN MAP_EVERY EXPAND_TAC ["g"; "q"] THEN REWRITE_TAC[SHIFTPATH_CIRCLEPATH] THEN MP_TAC(ISPECL [`a:real^1`; `b:real^1`] (CONJUNCT2 SEGMENT_IMAGE_INTERVAL)) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM IMAGE_o] THEN EXPAND_TAC "q" THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[partcirclepath] THEN REWRITE_TAC[LINEPATH_CX; o_DEF] THEN REPLICATE_TAC 5 AP_TERM_TAC THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_CMUL] THEN REAL_ARITH_TAC; ABBREV_TAC `g = partcirclepath (z,r,u,v)`] THEN SUBGOAL_THEN `((f:complex->complex) o (g:real^1->complex)) has_bounded_variation_on interval(vec 0,vec 1) /\ vector_variation (interval(vec 0,vec 1)) (f o g) <= d` STRIP_ASSUME_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) HAS_BOUNDED_VECTOR_VARIATION_ON_SUBINTERVALS o snd) THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN DISCH_THEN SUBST1_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_EMPTY; VECTOR_VARIATION_ON_EMPTY; REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY_1]) THEN ASM_REWRITE_TAC[DROP_VEC] THEN STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`(f:complex->complex) o (g:real^1->complex)`; `{}:real^1->bool`; `a:real^1`; `b:real^1`] HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE) THEN MP_TAC(ISPECL [`(f:complex->complex) o (g:real^1->complex)`; `{}:real^1->bool`; `a:real^1`; `b:real^1`] VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE) THEN REWRITE_TAC[COUNTABLE_EMPTY; DIFF_EMPTY] THEN MATCH_MP_TAC(MESON[] `(d ==> c) /\ d /\ i /\ v' <= k ==> (c /\ d /\ b ==> v = v') ==> (c /\ d ==> (b <=> i)) ==> b /\ v <= k`) THEN CONJ_TAC THENL [MESON_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; DIFFERENTIABLE_IMP_CONTINUOUS_ON]; ALL_TAC] THEN SUBGOAL_THEN `!t. t IN interval[a:real^1,b] ==> ((g:real^1->complex) has_derivative (\h. ii * Cx r * Cx(v - u) * cexp(ii * (Cx(u) + Cx(v - u) * Cx(drop t))) * Cx(drop h))) (at t)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[partcirclepath; LINEPATH_CX] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ABS_CONV) [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN REWRITE_TAC[COMPLEX_RING `ii * r * x = r * ii * x`] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_CMUL] THEN MATCH_MP_TAC HAS_DERIVATIVE_CMUL THEN REWRITE_TAC[REAL_ARITH `(&1 - x) * u + x * v = u + (v - u) * x`] THEN REWRITE_TAC[CX_ADD; CX_MUL] THEN MP_TAC(ISPECL [`\t. ii * (Cx(u) + Cx(v - u) * Cx(drop t))`; `cexp`; `\t. ii * (Cx(v - u) * Cx(drop t))`; `\h. cexp(ii * (Cx(u) + Cx(v - u) * Cx(drop t))) * h`; `t:real^1`] DIFF_CHAIN_AT) THEN REWRITE_TAC[GSYM has_complex_derivative] THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CEXP] THEN ANTS_TAC THENL [REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ABS_CONV) [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REPEAT(MATCH_MP_TAC LINEAR_COMPLEX_LMUL) THEN REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_MUL; CX_ADD] THEN REWRITE_TAC[COMPLEX_CMUL]; REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; COMPLEX_MUL_AC]]; ALL_TAC] THEN SUBGOAL_THEN `!t. t IN interval[a:real^1,b] ==> (((f:complex->complex) o g) has_vector_derivative ii * Cx r * Cx(v - u) * cexp(ii * (Cx(u) + Cx(v - u) * Cx(drop t))) * complex_derivative f (g t)) (at t)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->complex`; `f:complex->complex`; `\h. ii * Cx r * Cx(v - u) * cexp(ii * (Cx(u) + Cx(v - u) * Cx(drop t))) * Cx(drop h)`; `\z. complex_derivative f (g(t:real^1)) * z`; `t:real^1`] DIFF_CHAIN_AT) THEN ASM_SIMP_TAC[GSYM has_complex_derivative] THEN ANTS_TAC THENL [REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_REWRITE_TAC[OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g s SUBSET b ==> t IN s ==> g t IN b`)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[o_DEF; has_vector_derivative] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; COMPLEX_CMUL; COMPLEX_MUL_AC]]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_DIFFERENTIABLE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(\t. ii * Cx r * Cx (v - u) * cexp (ii * (Cx u + Cx (v - u) * Cx (drop t))) * complex_derivative f (g t)) absolutely_integrable_on interval[a,b] /\ drop (integral (interval [a,b]) (\t. lift(norm(ii * Cx r * Cx (v - u) * cexp(ii * (Cx u + Cx (v - u) * Cx (drop t))) * complex_derivative f (g t))))) <= d` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ABSOLUTELY_INTEGRABLE_EQ); MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REPEAT AP_TERM_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_UNIQUE_AT THEN ASM_SIMP_TAC[]] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL) THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ASM_MESON_TAC[path; PATH_PARTCIRCLEPATH]; ALL_TAC]; MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g s SUBSET b ==> t SUBSET s ==> IMAGE g t SUBSET b`))] THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN REWRITE_TAC[NORM_CEXP; RE_MUL_II; IM_ADD; IM_CX; IM_MUL_CX] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_NEG_0; REAL_EXP_0] THEN REWRITE_TAC[REAL_MUL_LID; REAL_ADD_RID] THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_ARITH `&0 < a ==> abs a = a`] THEN REWRITE_TAC[LIFT_CMUL; INTEGRABLE_CMUL_EQ] THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ (p ==> q)`] THEN SIMP_TAC[INTEGRAL_CMUL; VECTOR_MUL_ASSOC; DROP_CMUL] THEN REWRITE_TAC[TAUT `p /\ (p ==> q) <=> p /\ q`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_MUL; REAL_SUB_LT] THEN SUBGOAL_THEN `((\t. lift(norm((h:complex->complex)(Cx r * cexp(ii * Cx(drop t)))))) o (\t. lift u + (v - u) % t)) integrable_on interval[a,b] /\ drop(integral (interval[a,b]) ((\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t)))))) o (\t. lift u + (v - u) % t))) <= d / (r * (v - u))` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ); MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ] THEN REWRITE_TAC[] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[o_DEF] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN (SUBGOAL_THEN `g(t:real^1) IN ball(Cx(&0),&1)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g s SUBSET b ==> t IN s ==> g t IN b`)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; MAP_EVERY EXPAND_TAC ["h"; "g"] THEN REWRITE_TAC[partcirclepath; LINEPATH_CX; o_DEF] THEN REWRITE_TAC[REAL_ARITH `(&1 - t) * u + t * v = u + (v - u) * t`] THEN SIMP_TAC[DROP_ADD; LIFT_DROP; DROP_CMUL]])] THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN MP_TAC(ISPECL [`\t. lift(norm((h:complex->complex)(Cx r * cexp(ii * Cx(drop t)))))`; `integral (interval[lift u,lift v]) (\t. lift(norm((h:complex->complex)(Cx r * cexp(ii * Cx(drop t))))))`; `interval[lift u,lift v]`; `v - u:real`; `lift u`] HAS_INTEGRAL_AFFINITY) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL; o_DEF] THEN SUBGOAL_THEN `(\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))):complex))) integrable_on interval[lift u,lift v] /\ drop(integral (interval[lift u,lift v]) (\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))))))) <= d / r` ASSUME_TAC THENL [SUBGOAL_THEN `(\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))):complex))) integrable_on interval[lift u,lift u + lift(&2 * pi)] /\ drop(integral (interval[lift u,lift u + lift(&2 * pi)]) (\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))))))) <= d / r` STRIP_ASSUME_TAC THENL [ALL_TAC; MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; DROP_ADD; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[lift u,lift u + lift(&2 * pi)]) (\t. lift(norm((h:complex->complex) (Cx r * cexp(ii * Cx(drop t)))))))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; DROP_ADD; LIFT_DROP] THEN ASM_REAL_ARITH_TAC] THEN UNDISCH_TAC `drop(integral (interval [vec 0,lift (&2 * pi)]) (\t. r % lift(norm(h(Cx r * cexp(ii * Cx(drop t))):complex)))) < d` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ABSOLUTELY_INTEGRABLE_CMUL_EQ]) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ASM_SIMP_TAC[INTEGRAL_CMUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] DROP_CMUL] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN DISCH_TAC THEN ABBREV_TAC `u' = lift((&2 * pi) * frac(u / (&2 * pi)))` THEN SUBGOAL_THEN `(\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))):complex))) integrable_on interval[vec 0,u'] /\ (\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))):complex))) integrable_on interval[u',lift(&2 * pi)]` MP_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_SUBINTERVAL)) THEN EXPAND_TAC "u'" THEN REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN DISJ2_TAC THEN SIMP_TAC[REAL_LE_MUL; FLOOR_FRAC; PI_POS_LE; REAL_POS; REAL_LE_REFL; REAL_ARITH `a * x <= a <=> &0 <= a * (&1 - x)`; REAL_SUB_LE; REAL_LT_IMP_LE]; DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th)] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRAL] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE [TAUT `p /\ q /\ r /\ s ==> t <=> r /\ s ==> p /\ q ==> t`] HAS_INTEGRAL_COMBINE)) THEN ANTS_TAC THENL [EXPAND_TAC "u'" THEN REWRITE_TAC[DROP_VEC; LIFT_DROP] THEN SIMP_TAC[REAL_LE_MUL; FLOOR_FRAC; PI_POS_LE; REAL_POS; REAL_LE_REFL; REAL_ARITH `a * x <= a <=> &0 <= a * (&1 - x)`; REAL_SUB_LE; REAL_LT_IMP_LE]; DISCH_THEN(SUBST_ALL_TAC o MATCH_MP INTEGRAL_UNIQUE)] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN SUBGOAL_THEN `((\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))):complex))) has_integral integral (interval[vec 0,u']) (\t. lift(norm(h(Cx r * cexp(ii * Cx(drop t))))))) (interval[lift(&2 * pi),u' + lift(&2 * pi)])` MP_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV o LAND_CONV) [GSYM VECTOR_ADD_LID] THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN REWRITE_TAC[INTERVAL_TRANSLATION] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_TRANSLATION] THEN REWRITE_TAC[DROP_ADD; LIFT_DROP; CX_ADD; CEXP_ADD; COMPLEX_ADD_LDISTRIB] THEN ONCE_REWRITE_TAC[MESON[REAL_MUL_LID; COMPLEX_MUL_SYM] `ii * Cx(&2 * pi) = Cx(&2 * &1 * pi) * ii`] THEN SIMP_TAC[CEXP_INTEGER_2PI; INTEGER_CLOSED] THEN ASM_REWRITE_TAC[COMPLEX_MUL_LID; GSYM HAS_INTEGRAL_INTEGRAL]; ALL_TAC] THEN UNDISCH_TAC `(\t. lift(norm(h(Cx r * cexp (ii * Cx (drop t))):complex))) integrable_on interval[u',lift(&2 * pi)]` THEN REWRITE_TAC[IMP_IMP; HAS_INTEGRAL_INTEGRAL] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE [TAUT `p /\ q /\ r /\ s ==> t <=> r /\ s ==> p /\ q ==> t`] HAS_INTEGRAL_COMBINE)) THEN ANTS_TAC THENL [EXPAND_TAC "u'" THEN REWRITE_TAC[LIFT_DROP; DROP_ADD] THEN SIMP_TAC[REAL_LE_ADDL; REAL_LE_MUL; FLOOR_FRAC; PI_POS_LE; REAL_POS; REAL_LE_REFL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ARITH `a * x <= a <=> &0 <= a * (&1 - x)`]; REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL]] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [VECTOR_ADD_SYM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST_ALL_TAC o SYM)) THEN DISCH_THEN(fun th -> CONJ_TAC THENL [MP_TAC th; ALL_TAC]) THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < d ==> x = y ==> y <= d`))] THEN (SUBGOAL_THEN `interval[lift u,lift u + lift(&2 * pi)] = interval[lift((&2 * pi) * floor(u / (&2 * pi))) + u', lift((&2 * pi) * floor(u / (&2 * pi))) + u' + lift(&2 * pi)]` SUBST1_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ; GSYM DROP_EQ; LIFT_DROP; DROP_ADD] THEN REWRITE_TAC[REAL_EQ_ADD_RCANCEL; REAL_ADD_ASSOC] THEN EXPAND_TAC "u'" THEN REWRITE_TAC[LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> (u = (&2 * pi) * x <=> x = u / (&2 * pi))`] THEN REWRITE_TAC[GSYM FLOOR_FRAC]; REWRITE_TAC[INTERVAL_TRANSLATION]]) THENL [REWRITE_TAC[GSYM INTEGRABLE_TRANSLATION] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ); AP_TERM_TAC THEN REWRITE_TAC[GSYM INTEGRAL_TRANSLATION] THEN MATCH_MP_TAC INTEGRAL_EQ] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN REPLICATE_TAC 4 AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[CEXP_EQ] THEN EXISTS_TAC `floor(u / (&2 * pi))` THEN REWRITE_TAC[FLOOR] THEN MATCH_MP_TAC(COMPLEX_RING `y + x = z ==> ii * z = ii * x + y * ii`) THEN REWRITE_TAC[GSYM CX_ADD; DROP_ADD; LIFT_DROP] THEN AP_TERM_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_SUB_0; REAL_LT_IMP_NE] THEN REWRITE_TAC[DIMINDEX_1; REAL_POW_1; IMAGE_AFFINITY_INTERVAL] THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_LE_INV_EQ] THEN REWRITE_TAC[REAL_SUB_LE; LIFT_DROP; VECTOR_ADD_RINV] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ARITH `u < v ==> ~(v < u)`] THEN REWRITE_TAC[VECTOR_ARITH `a % v + --(a % u):real^1 = a % (v - u)`] THEN REWRITE_TAC[GSYM LIFT_CMUL; GSYM LIFT_SUB] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_SUB_0; REAL_LT_IMP_NE] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; LIFT_NUM] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[vec 0,vec 1]) (\x. lift(norm((h:complex->complex) (Cx r * cexp(ii * Cx((v - u) * drop x + u)))))))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[DROP_CMUL] THEN ASM_SIMP_TAC[REAL_ARITH `u < v ==> abs(v - u) = v - u`] THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `a * b * c:real = c * a * b`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_INV_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ]; ALL_TAC] THEN SUBGOAL_THEN `simple_path(g:real^1->complex)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[SIMPLE_PATH_PARTCIRCLEPATH] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `path(g:real^1->complex)` ASSUME_TAC THENL [ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH]; ALL_TAC] THEN ASM_CASES_TAC `cball(z,r) SUBSET ball(Cx(&0),&1)` THENL [SUBGOAL_THEN `diameter(frontier (IMAGE (f:complex->complex) (ball(z,r)))) < e` MP_TAC THENL [TRANS_TAC REAL_LET_TRANS `d:real` THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhand o rand) FRONTIER_PROPER_HOLOMORPHIC_IMAGE o rand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BOUNDED_BALL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN REWRITE_TAC[BALL_SUBSET_CBALL] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[CLOSURE_BALL] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN ASM_REWRITE_TAC[]; X_GEN_TAC `k:complex->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN ball(z,r) /\ (f:complex->complex) x IN k} = IMAGE f' k` SUBST1_TAC THENL [MP_TAC(ISPECL [`z:complex`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `IMAGE (f:complex->complex) (ball(z,r))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`z:complex`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]]]; DISCH_THEN SUBST1_TAC] THEN ASM_SIMP_TAC[FRONTIER_BALL] THEN MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; FORALL_IN_IMAGE_2] THEN SUBGOAL_THEN `sphere(z:complex,r) = path_image g` SUBST1_TAC THENL [ASM_REWRITE_TAC[SET_RULE `s = c INTER s <=> s SUBSET c`] THEN TRANS_TAC SUBSET_TRANS `ball(Cx(&0),&1)` THEN REWRITE_TAC[BALL_SUBSET_CBALL] THEN REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]; REWRITE_TAC[path_image; FORALL_IN_IMAGE_2]] THEN MP_TAC(ISPECL [`(f:complex->complex) o (g:real^1->complex)`; `interval(vec 0:real^1,vec 1)`; `INTERS {cball((f:complex->complex)(g y),d) | y IN interval[vec 0:real^1,vec 1]}`] FORALL_IN_CLOSURE) THEN SIMP_TAC[CLOSURE_OPEN_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; o_THM; IN_CBALL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN SIMP_TAC[CLOSED_INTERS; FORALL_IN_GSPEC; CLOSED_CBALL] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[GSYM path; SIMPLE_PATH_IMP_PATH; GSYM path_image] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]; X_GEN_TAC `a:real^1` THEN DISCH_TAC] THEN MP_TAC(ISPECL [`(f:complex->complex) o (g:real^1->complex)`; `interval(vec 0:real^1,vec 1)`; `cball((f:complex->complex)(g(a:real^1)),d)`] FORALL_IN_CLOSURE) THEN REWRITE_TAC[o_THM; IN_CBALL; CLOSED_CBALL] THEN SIMP_TAC[CLOSURE_OPEN_INTERVAL; UNIT_INTERVAL_NONEMPTY; dist] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[GSYM path; SIMPLE_PATH_IMP_PATH; GSYM path_image] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]; X_GEN_TAC `b:real^1` THEN DISCH_TAC] THEN MP_TAC(ISPECL [`(f:complex->complex) o (g:real^1->complex)`; `interval(vec 0:real^1,vec 1)`; `a:real^1`; `b:real^1`] VECTOR_VARIATION_GE_NORM_FUNCTION) THEN ASM_REWRITE_TAC[o_THM; NORM_SUB] THEN ANTS_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN ASM_REWRITE_TAC[CONVEX_INTERVAL]; W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_FRONTIER o lhand o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (f:complex->complex) (ball(Cx(&0),&1))` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; MATCH_MP_TAC IMAGE_SUBSET] THEN ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[REAL_NOT_LT] THEN TRANS_TAC REAL_LE_TRANS `dist((f:complex->complex) z',f z)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`z:complex`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `~(sphere(z,r) SUBSET ball(Cx(&0),&1))` ASSUME_TAC THENL [ASM_SIMP_TAC[SPHERE_SUBSET_CONVEX; CONVEX_BALL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (TAUT `(p <=> q) ==> ~(p /\ q) ==> ~p /\ ~q`)) THEN ANTS_TAC THENL [REWRITE_TAC[pathfinish; pathstart] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g i SUBSET b ==> ~(IMAGE g (i UNION {x,y}) SUBSET b) ==> ~(g y IN b /\ g x IN b)`)) THEN SIMP_TAC[GSYM CLOSED_OPEN_INTERVAL_1; DROP_VEC; REAL_POS] THEN ASM_REWRITE_TAC[GSYM path_image; GSYM SPHERE_UNION_BALL] THEN MATCH_MP_TAC(SET_RULE `~(s INTER z = {}) /\ s INTER b = {} ==> ~((s UNION b) INTER z SUBSET b)`) THEN CONJ_TAC THENL [REWRITE_TAC[INTER_SPHERE_EQ_EMPTY; DIMINDEX_2; ARITH] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET_BALLS]) THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; COMPLEX_SUB_RZERO; NORM_NEG] THEN UNDISCH_TAC `(z:complex) IN A` THEN EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[EXTENSION; COMPLEX_IN_SPHERE_0; COMPLEX_IN_BALL_0; IN_INTER; NOT_IN_EMPTY] THEN REAL_ARITH_TAC]; STRIP_TAC] THEN SUBGOAL_THEN `pathstart g IN sphere(Cx(&0),&1) /\ pathfinish g IN sphere(Cx(&0),&1)` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM CBALL_DIFF_BALL; IN_DIFF] THEN FIRST_X_ASSUM (MATCH_MP_TAC o MATCH_MP (SET_RULE `g = c INTER s ==> x IN g /\ y IN g ==> x IN c /\ y IN c`)) THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN MP_TAC(ISPECL [`(f:complex->complex) o (g:real^1->complex)`; `interval(vec 0:real^1,vec 1)`] UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [ASM_MESON_TAC[path; CONTINUOUS_ON_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]; MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]]; DISCH_THEN(X_CHOOSE_THEN `fg:real^1->complex` MP_TAC) THEN REWRITE_TAC[CLOSURE_INTERVAL; UNIT_INTERVAL_NONEMPTY; o_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(ASSUME_TAC o GSYM o CONJUNCT1) THEN FIRST_ASSUM(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN REWRITE_TAC[GSYM path] THEN DISCH_TAC] THEN MAP_EVERY ABBREV_TAC [`a = pathstart(fg:real^1->complex)`; `b = pathfinish(fg:real^1->complex)`] THEN MP_TAC(ISPECL [`\z. (fg:real^1->complex) (fstcart z) - fg(sndcart z)`; `interval(vec 0:real^1,vec 1) PCROSS interval(vec 0:real^1,vec 1)`; `cball(Cx(&0),d)`] FORALL_IN_CLOSURE) THEN REWRITE_TAC[CLOSED_CBALL; CLOSURE_PCROSS] THEN REWRITE_TAC[CLOSURE_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[NOT_IMP; COMPLEX_IN_CBALL_0; GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN ASM_REWRITE_TAC[GSYM path]; MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `norm(((f:complex->complex) o g) (x:real^1) - (f o g) y)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[o_THM; REAL_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN ASM_REWRITE_TAC[CONVEX_INTERVAL]; DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `(!x y. x IN i /\ y IN i ==> norm(f x - f y) <= d) ==> !x y. x IN IMAGE f i /\ y IN IMAGE f i ==> norm(x - y) <= d`)) THEN REWRITE_TAC[GSYM path_image] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(SPECL [`pathstart fg:complex`; `pathfinish fg:complex`] th)) THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN SUBGOAL_THEN `(a:complex) IN frontier s /\ b IN frontier s` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[frontier; IN_DIFF; INTERIOR_OPEN] THEN CONJ_TAC THEN (CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. a IN t /\ t SUBSET s ==> a IN s`) THEN EXISTS_TAC `path_image(fg:real^1->complex)` THEN CONJ_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; REWRITE_TAC[path_image]] THEN MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`] (CONJUNCT2 CLOSURE_INTERVAL)) THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REWRITE_TAC[CLOSURE_INTERVAL; CLOSED_CLOSURE] THEN ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY; GSYM path] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN i ==> f(g x) = h x) ==> IMAGE f (IMAGE g i) SUBSET s /\ s SUBSET closure s ==> IMAGE h i SUBSET closure s`)) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN ASM SET_TAC[]; DISCH_TAC]) THEN MP_TAC(ISPECL [`fg:real^1->complex`; `interval[vec 0:real^1,vec 1]`] CONTINUOUS_ON) THEN ASM_REWRITE_TAC[GSYM path] THENL [DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`); DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`)] THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN DISCH_THEN(MP_TAC o ISPEC `f':complex->complex` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN SUBST1_TAC(SYM(ISPEC `fg:real^1->complex` pathstart)) THEN SUBST1_TAC(SYM(ISPEC `fg:real^1->complex` pathfinish)) THEN ASM_REWRITE_TAC[NOT_IMP] THEN (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; ALL_TAC]) THEN MP_TAC(ISPECL [`g:real^1->complex`; `interval[vec 0:real^1,vec 1]`] CONTINUOUS_ON) THEN ASM_REWRITE_TAC[GSYM path] THENL [DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`); DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`)] THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN MATCH_MP_TAC(MESON[LIM_UNIQUE] `~trivial_limit net /\ ((f --> a) net <=> (g --> a) net) /\ ~(a = b) ==> (g --> b) net ==> ~((f --> a) net)`) THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN (REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN MATCH_MP_TAC(SET_RULE `{a,b} SUBSET interval[a,b] /\ ~(a = b) ==> ~(?c. interval[a,b] = {c})`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV; MATCH_MP_TAC LIM_TRANSFORM_EQ THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_INTERVAL_1; DIST_0; DROP_VEC; NORM_REAL] THEN REWRITE_TAC[DIST_1; DROP_VEC] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[GSYM drop] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN STRIP_TAC THEN TRANS_TAC EQ_TRANS `(f':complex->complex)(f((g:real^1->complex) x))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g i SUBSET b ==> x IN i ==> g x IN b`))] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM SET_TAC[]]); ALL_TAC] THEN SUBGOAL_THEN `~((a:complex) IN s) /\ ~(b IN s)` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN ASM_MESON_TAC[INTERIOR_OPEN]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`a:complex`; `b:complex`] th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[dist] THEN NO_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `E:complex->bool` STRIP_ASSUME_TAC)) THEN ABBREV_TAC `B:complex->bool = path_image fg UNION closure E` THEN SUBGOAL_THEN `connected(B:complex->bool)` ASSUME_TAC THENL [EXPAND_TAC "B" THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; CONNECTED_CLOSURE] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `a:complex` THEN ASM_SIMP_TAC[CLOSURE_INC] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `compact(B:complex->bool)` ASSUME_TAC THENL [EXPAND_TAC "B" THEN MATCH_MP_TAC COMPACT_UNION THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_CLOSURE]; ALL_TAC] THEN SUBGOAL_THEN `B SUBSET ball(a:complex,e / &2)` ASSUME_TAC THENL [EXPAND_TAC "B" THEN REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[SUBSET] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[IN_BALL] THEN TRANS_TAC REAL_LET_TRANS `d:real` THEN ASM_REWRITE_TAC[dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN closure E ==> x IN cball(a:complex,e / &4)` MP_TAC THENL [MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_CBALL; CONTINUOUS_ON_ID; IN_CBALL] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `diameter(E:complex->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `?c. c IN {(f:complex->complex) z,f z'} /\ ~(c IN ball(a,e / &2))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY; IN_BALL] THEN UNDISCH_TAC `e <= dist((f:complex->complex) z',f z)` THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN MP_TAC(ISPECL [`B:complex->bool`; `(:complex) DIFF s`; `c:complex`; `f(Cx(&0)):complex`] JANISZEWSKI) THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN REWRITE_TAC[COMPL_COMPL] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `connected(closure E:complex->bool)` MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_CLOSURE]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN EXPAND_TAC "B" THEN MATCH_MP_TAC(SET_RULE `!a b. a IN e /\ b IN e /\ s INTER e = {} /\ p DIFF {a,b} SUBSET s ==> e = (p UNION e) INTER (UNIV DIFF s)`) THEN MAP_EVERY EXISTS_TAC [`a:complex`; `b:complex`] THEN ASM_SIMP_TAC[CLOSURE_INC; OPEN_INTER_CLOSURE_EQ_EMPTY] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[path_image]] THEN MAP_EVERY EXPAND_TAC ["a"; "b"] THEN REWRITE_TAC[pathstart; pathfinish] THEN MATCH_MP_TAC(SET_RULE `IMAGE f (i DIFF {a,b}) SUBSET s ==> IMAGE f i DIFF {f a,f b} SUBSET s`) THEN REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]; REWRITE_TAC[connected_component] THEN EXISTS_TAC `(:complex) DIFF ball(a,e / &2)` THEN SIMP_TAC[CONNECTED_COMPLEMENT_BOUNDED_CONVEX; DIMINDEX_2; ARITH; BOUNDED_BALL; CONVEX_BALL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN REWRITE_TAC[IN_BALL; REAL_NOT_LT] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN TRANS_TAC REAL_LE_TRANS `setdist({f(Cx(&0)):complex},frontier s)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]; REWRITE_TAC[connected_component] THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONNECTED_BALL]; SUBGOAL_THEN `{Cx(&0),z,z'} SUBSET ball(Cx(&0),&1)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CENTRE_IN_BALL] THEN REWRITE_TAC[REAL_LT_01; COMPLEX_IN_BALL_0] THEN MAP_EVERY UNDISCH_TAC [`(z:complex) IN A`; `(z':complex) IN A`] THEN EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(:complex) DIFF (B UNION (:complex) DIFF s) = s DIFF path_image fg` SUBST1_TAC THENL [EXPAND_TAC "B" THEN MATCH_MP_TAC(SET_RULE `s INTER e = {} ==> UNIV DIFF ((p UNION e) UNION (UNIV DIFF s)) = s DIFF p`) THEN ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM OPEN_PATH_CONNECTED_COMPONENT; OPEN_DIFF; CLOSED_PATH_IMAGE] THEN ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN REWRITE_TAC[path_component] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN ABBREV_TAC `q = (f':complex->complex) o (p:real^1->complex)` THEN SUBGOAL_THEN `path_image q SUBSET ball(Cx(&0),&1) DIFF path_image g` ASSUME_TAC THENL [EXPAND_TAC "q" THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN TRANS_TAC SUBSET_TRANS `IMAGE (f':complex->complex) (s DIFF path_image fg)` THEN ASM_SIMP_TAC[IMAGE_SUBSET; BALL_SUBSET_CBALL; SET_RULE `b SUBSET c ==> b DIFF (c INTER s) = b DIFF s`] THEN MATCH_MP_TAC(SET_RULE `(!z. z IN b ==> f'(f z) = z) /\ IMAGE f b = s /\ IMAGE f (b INTER p) SUBSET p' ==> IMAGE f' (s DIFF p') SUBSET (b DIFF p)`) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `IMAGE (f:complex->complex) (IMAGE g (interval(vec 0:real^1,vec 1)))` THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN MATCH_MP_TAC(SET_RULE `~(g a IN s) /\ ~(g b IN s) /\ s SUBSET IMAGE g i ==> s SUBSET IMAGE g (i DIFF {a,b})`) THEN ASM_REWRITE_TAC[GSYM path_image; IN_INTER] THEN CONJ_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN MP_TAC(ISPECL [`Cx(&0)`; `&1`] BALL_SUBSET_CBALL) THEN SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN i ==> f(g x) = fg x) ==> IMAGE fg i SUBSET s ==> IMAGE f (IMAGE g i) SUBSET s`)) THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]]; ALL_TAC] THEN MP_TAC(ISPECL [`path_image q:complex->bool`; `cball(z:complex,r)`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[NOT_IMP; FRONTIER_CBALL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_PATH_IMAGE THEN EXPAND_TAC "q" THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[path_image; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN EXISTS_TAC `vec 1:real^1` THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN SUBST1_TAC(SYM(ISPEC `q:real^1->complex` pathfinish)) THEN EXPAND_TAC "q" THEN REWRITE_TAC[PATHFINISH_COMPOSE] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{z,z'} SUBSET cball(z,r) INTER ball(Cx(&0),&1)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MAP_EVERY UNDISCH_TAC [`(z:complex) IN A`; `(z':complex) IN A`] THEN EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTER; COMPLEX_IN_BALL_0] THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_CBALL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[path_image; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_DIFF] THEN EXISTS_TAC `vec 0:real^1` THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN SUBST1_TAC(SYM(ISPEC `q:real^1->complex` pathstart)) THEN EXPAND_TAC "q" THEN REWRITE_TAC[PATHSTART_COMPOSE] THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`Cx(&0)`; `&1`] CENTRE_IN_BALL) THEN ASM_SIMP_TAC[REAL_LT_01] THEN DISCH_TAC THEN UNDISCH_TAC `(z:complex) IN A` THEN EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM; IN_CBALL; dist; COMPLEX_SUB_RZERO] THEN ASM_REAL_ARITH_TAC; UNDISCH_TAC `path_image q SUBSET ball(Cx(&0),&1) DIFF path_image g` THEN ASM_SIMP_TAC[BALL_SUBSET_CBALL; SET_RULE `b SUBSET c ==> b DIFF (c INTER s) = b DIFF s`] THEN SET_TAC[]]);; let CARATHEODORY_CONFORMAL_EXTENSION_LEMMA = prove (`!f s a. f holomorphic_on ball(Cx(&0),&1) /\ f continuous_on cball(Cx(&0),&1) /\ IMAGE f (ball(Cx(&0),&1)) = s /\ (!w z. w IN ball(Cx(&0),&1) /\ z IN ball(Cx(&0),&1) /\ f w = f z ==> w = z) /\ a IN closure s ==> ({x | x IN cball(Cx(&0),&1) /\ f x = a} HAS_SIZE 1 <=> connected (frontier(s) DELETE a))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(Cx(&0),&1)`] HOLOMORPHIC_ON_INVERSE) THEN ASM_REWRITE_TAC[OPEN_BALL] THEN RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `f':complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(Cx(&0),&1)`] FRONTIER_PROPER_HOLOMORPHIC_IMAGE) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BOUNDED_BALL] THEN ASM_SIMP_TAC[CLOSURE_BALL; FRONTIER_BALL; REAL_LT_01] THEN ANTS_TAC THENL [X_GEN_TAC `k:complex->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN ball(Cx (&0),&1) /\ (f:complex->complex) x IN k} = IMAGE f' k` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET]; DISCH_THEN(ASSUME_TAC o SYM)] THEN ASM_CASES_TAC `(a:complex) IN s` THENL [SUBGOAL_THEN `~((a:complex) IN frontier s)` ASSUME_TAC THENL [ASM_SIMP_TAC[frontier; IN_DIFF; INTERIOR_OPEN]; ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`]] THEN MATCH_MP_TAC(TAUT `q /\ p ==> (p <=> q)`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_SPHERE_EQ; DIMINDEX_2; ARITH] THEN ASM_MESON_TAC[SPHERE_SUBSET_CBALL; CONTINUOUS_ON_SUBSET]; ASM_SIMP_TAC[GSYM BALL_UNION_SPHERE; SET_RULE `~(a IN IMAGE f s) ==> {x | x IN b UNION s /\ f x = a} = {x | x IN b /\ f x = a}`] THEN CONV_TAC HAS_SIZE_CONV THEN EXISTS_TAC `(f':complex->complex) a` THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(a:complex) IN frontier s` ASSUME_TAC THENL [ASM_SIMP_TAC[frontier; IN_DIFF; INTERIOR_OPEN]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM BALL_UNION_SPHERE; SET_RULE `~(a IN IMAGE f b) ==> {x | x IN b UNION s /\ f x = a} = {x | x IN s /\ f x = a}`] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:complex` MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `{x | x IN s /\ f x = y} = {a} ==> IMAGE f s DELETE y = IMAGE f (s DELETE a)`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SPHERE_SUBSET_CBALL; SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`]; MP_TAC(ISPECL [`circlepath(Cx(&0),&1)`; `u:complex`] CONNECTED_SIMPLE_PATH_IMAGE_DELETE) THEN SIMP_TAC[SIMPLE_PATH_CIRCLEPATH; PATH_IMAGE_CIRCLEPATH; REAL_OF_NUM_EQ; REAL_POS; ARITH] THEN REWRITE_TAC[PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH]]; DISCH_TAC] THEN MATCH_MP_TAC(SET_RULE `a IN IMAGE f s /\ (!u v. ~(u IN s /\ v IN s /\ f u = a /\ f v = a /\ ~(u = v))) ==> ?w. {x | x IN s /\ f x = a} = {w}`) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `segment(u,v) SUBSET ball(Cx(&0),&1)` ASSUME_TAC THENL [MATCH_MP_TAC OPEN_SEGMENT_SUBSET_BALL THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_IN_SPHERE_0]) THEN ASM_REWRITE_TAC[COMPLEX_IN_CBALL_0; REAL_LE_REFL]; ALL_TAC] THEN MP_TAC(SPEC `(f:complex->complex) o linepath(u,v)` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE; PATH_IMAGE_COMPOSE; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[simple_path] THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_IN_SPHERE_0]) THEN ASM_REWRITE_TAC[CONVEX_CBALL; COMPLEX_IN_CBALL_0; REAL_LE_REFL]; SIMP_TAC[CLOSED_OPEN_INTERVAL_1; DROP_VEC; REAL_POS] THEN SUBGOAL_THEN `!x. x IN interval(vec 0,vec 1) ==> linepath(u,v) x IN ball(Cx(&0),&1)` ASSUME_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN EXISTS_TAC `segment(u:complex,v)` THEN ASM_REWRITE_TAC[linepath; IN_SEGMENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_UNION] THEN REWRITE_TAC[o_THM; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN SUBST1_TAC(SYM(ISPEC `linepath(u:complex,v)` pathstart)) THEN SUBST1_TAC(SYM(ISPEC `linepath(u:complex,v)` pathfinish)) THEN ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`u:complex`; `v:complex`] ARC_LINEPATH) THEN ASM_REWRITE_TAC[arc; PATH_LINEPATH] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_SIMP_TAC[CLOSED_OPEN_INTERVAL_1; DROP_VEC; REAL_POS] THEN ASM_REWRITE_TAC[IN_UNION]]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`A = inside(IMAGE (f:complex->complex) (segment[u,v]))`; `B = outside(IMAGE (f:complex->complex) (segment[u,v]))`] THEN STRIP_TAC THEN UNDISCH_TAC `connected(frontier s DELETE (a:complex))` THEN REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`A:complex->bool`; `B:complex->bool`] THEN ASM_REWRITE_TAC[GSYM INTER_ASSOC; INTER_EMPTY] THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN ASM_REWRITE_TAC[IMAGE_UNION; IMAGE_CLAUSES] THEN MATCH_MP_TAC(SET_RULE `IMAGE f i INTER r = {} ==> r DELETE a SUBSET UNIV DIFF (IMAGE f i UNION {a,a})`) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?p q. ~(p = vec 0) /\ segment[u,v] SUBSET {z:complex | p dot z = q}` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC AFF_LOWDIM_SUBSET_HYPERPLANE THEN REWRITE_TAC[AFF_DIM_SEGMENT; DIMINDEX_2] THEN INT_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`cball(Cx(&0),&1)`; `u:complex`; `v:complex`] CONVEX_LINE_INTERSECTION_UNIQUE_CLOSED) THEN ASM_REWRITE_TAC[CONVEX_CBALL; CLOSED_CBALL; RELATIVE_FRONTIER_CBALL; REAL_OF_NUM_EQ; ARITH_EQ; RELATIVE_INTERIOR_CBALL] THEN ANTS_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET t ==> ~(s INTER t = {})`) THEN ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY]; ALL_TAC] THEN MP_TAC(ISPECL [`{u:complex,v}`; `{z:complex | p dot z = q}`] AFF_DIM_EQ_AFFINE_HULL) THEN ASM_REWRITE_TAC[AFF_DIM_2; INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE; HULL_P] THEN REWRITE_TAC[DIMINDEX_2] THEN CONV_TAC INT_REDUCE_CONV THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT]; DISCH_THEN SUBST1_TAC] THEN DISCH_TAC THEN MAP_EVERY ABBREV_TAC [`C = {x | x IN cball(Cx(&0),&1) /\ ~(f x:complex = a)} INTER {x | p dot x < q}`; `D = {x | x IN cball(Cx(&0),&1) /\ ~(f x:complex = a)} INTER {x | p dot x > q}`] THEN SUBGOAL_THEN `connected(C:complex->bool) /\ connected(D:complex->bool)` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["C"; "D"] THEN CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL [EXISTS_TAC `ball(Cx(&0),&1) INTER {x | p dot x < q}`; EXISTS_TAC `ball(Cx(&0),&1) INTER {x | p dot x > q}`] THEN SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTER; CONVEX_BALL; CONVEX_HALFSPACE_LT; CONVEX_HALFSPACE_GT] THEN (CONJ_TAC THENL [REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN ASM SET_TAC[]; ALL_TAC]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC(SET_RULE `u SUBSET closure t INTER s /\ s INTER closure t SUBSET closure(s INTER t) ==> u SUBSET closure(s INTER t)`) THEN SIMP_TAC[OPEN_INTER_CLOSURE_SUBSET; OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN SIMP_TAC[CLOSURE_BALL; REAL_LT_01] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (f:complex->complex) C INTER IMAGE f (segment [u,v]) = {} /\ IMAGE f D INTER IMAGE f (segment[u,v]) = {}` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["C"; "D"] THEN CONJ_TAC THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN; GSYM BALL_UNION_SPHERE] THEN MATCH_MP_TAC(SET_RULE `f u = a /\ f v = a /\ ~(a IN IMAGE f b) /\ IMAGE f s INTER IMAGE f b = {} /\ i SUBSET b /\ i INTER h = {} /\ (!x y. x IN b /\ y IN b ==> (f x = f y <=> x = y)) ==> IMAGE f ({x | x IN b UNION s /\ ~(f x = a)} INTER h) INTER IMAGE f (i UNION {u,v}) = {}`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN REWRITE_TAC[SET_RULE `(t DIFF s) INTER s = {}`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `segment[u,v] SUBSET p ==> segment(u,v) SUBSET segment[u,v] /\ p INTER h = {} ==> segment(u,v) INTER h = {}`)) THEN REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(IMAGE (f:complex->complex) C SUBSET A \/ IMAGE f C SUBSET B) /\ (IMAGE (f:complex->complex) D SUBSET A \/ IMAGE f D SUBSET B)` MP_TAC THENL [CONJ_TAC THENL [MP_TAC(ISPEC `IMAGE (f:complex->complex) C` CONNECTED_INTER_FRONTIER); MP_TAC(ISPEC `IMAGE (f:complex->complex) D` CONNECTED_INTER_FRONTIER)] THEN DISCH_THEN(MP_TAC o SPEC `A:complex->bool`) THEN (MATCH_MP_TAC(TAUT `(r ==> t) /\ (q /\ s ==> u) /\ p /\ s ==> (p /\ ~q /\ ~r ==> ~s) ==> t \/ u`) THEN CONJ_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]); ALL_TAC] THEN SUBGOAL_THEN `~(IMAGE (f:complex->complex) (C UNION D) INTER A = {}) /\ ~(IMAGE f (C UNION D) INTER B = {})` MP_TAC THENL [SUBGOAL_THEN `~(s INTER A:complex->bool = {}) /\ ~(s INTER B = {})` MP_TAC THENL [CONJ_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[GSYM FRONTIER_UNION_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `(?x. x IN u /\ f x IN s) ==> ~(s INTER (IMAGE f u UNION i) = {})`) THEN EXISTS_TAC `midpoint(u,v):complex` THEN REWRITE_TAC[MIDPOINT_IN_SEGMENT] THEN EXPAND_TAC "s" THEN MATCH_MP_TAC FUN_IN_IMAGE THEN MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN EXISTS_TAC `segment(u:complex,v)` THEN ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT]; ALL_TAC] THEN EXPAND_TAC "s" THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN b DIFF c ==> ~(f x IN a)) ==> ~(IMAGE f b INTER a = {}) ==> ~(IMAGE f c INTER a = {})`) THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `A UNION B = UNIV DIFF (IMAGE f i) ==> s SUBSET i ==> !x. x IN s ==> ~(f x IN A)`)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `A UNION B = UNIV DIFF (IMAGE f i) ==> s SUBSET i ==> !x. x IN s ==> ~(f x IN B)`))] THEN MAP_EVERY EXPAND_TAC ["C"; "D"] THEN REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN MATCH_MP_TAC(SET_RULE `~(a IN IMAGE f b) /\ (!x. x IN b /\ ~(x IN h1 \/ x IN h2) ==> x IN t) ==> b DIFF ({x | x IN b UNION s /\ ~(f x = a)} INTER h1 UNION {x | x IN b UNION s /\ ~(f x = a)} INTER h2) SUBSET t`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_ARITH `~(x < q \/ x > q) <=> x = q`] THEN REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `(~(IMAGE f (C UNION D) INTER A = {}) /\ ~(IMAGE f (C UNION D) INTER B = {})) /\ (IMAGE f C SUBSET A \/ IMAGE f C SUBSET B) /\ (IMAGE f D SUBSET A \/ IMAGE f D SUBSET B) ==> A INTER B = {} ==> IMAGE f C SUBSET A /\ IMAGE f D SUBSET B \/ IMAGE f D SUBSET A /\ IMAGE f C SUBSET B`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM(ASSUME `IMAGE (f:complex->complex) (sphere (Cx (&0),&1)) = frontier s`)] THEN MATCH_MP_TAC(SET_RULE `((!x. x IN C ==> ~(f x = a)) /\ (!x. x IN D ==> ~(f x = a))) /\ (~(C INTER s = {}) /\ ~(D INTER s = {})) ==> IMAGE f C SUBSET A /\ IMAGE f D SUBSET B \/ IMAGE f D SUBSET A /\ IMAGE f C SUBSET B ==> ~(A INTER IMAGE f s DELETE a = {}) /\ ~(B INTER IMAGE f s DELETE a = {})`) THEN MAP_EVERY EXPAND_TAC ["C"; "D"] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN CONJ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM BALL_UNION_SPHERE; IN_UNION; MESON[] `(?x. (((x IN b \/ x IN s) /\ ~(f x = a)) /\ Q x) /\ x IN s) <=> ~(!x. x IN s /\ Q x ==> f x = a)`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `Cx(&0)`; `&1`] HOLOMORPHIC_CONSTANT_ON_SPHERE_SEGMENT) THENL [DISCH_THEN(MP_TAC o SPEC `sphere(Cx(&0),&1) INTER {x | p dot x < q}`); DISCH_THEN(MP_TAC o SPEC `sphere(Cx(&0),&1) INTER {x | p dot x > q}`)] THEN DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN REWRITE_TAC[TAUT `~(~p ==> q) <=> ~q /\ ~p`] THEN (CONJ_TAC THENL [REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(SET_RULE `(!x y. x IN b /\ y IN b ==> (f x = f y <=> x = y)) ==> (?x y. x IN b /\ y IN b /\ ~(x = y)) ==> ~(!x. x IN b UNION s ==> f x = a)`)) THEN MAP_EVERY EXISTS_TAC [`Cx(&0)`; `Cx(&1 / &2)`] THEN REWRITE_TAC[COMPLEX_IN_BALL_0; CX_INJ; COMPLEX_NORM_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[GSYM FRONTIER_BALL; REAL_LT_01] THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN SIMP_TAC[CONVEX_CONNECTED; CONVEX_HALFSPACE_LT; CONVEX_HALFSPACE_GT] THEN REWRITE_TAC[SET_RULE `{x | P x} INTER b = {} <=> b SUBSET {x | ~P x}`] THEN REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN (CONJ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN REWRITE_TAC[REAL_ARITH `~(x < y) <=> x >= y`; REAL_ARITH `~(x > y) <=> x <= y`] THEN SIMP_TAC[INTERIOR_OPEN; OPEN_BALL] THEN ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; INTERIOR_HALFSPACE_GE] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `midpoint(u,v):complex`) THEN MP_TAC(ISPECL [`u:complex`; `v:complex`] (CONJUNCT2 MIDPOINT_IN_SEGMENT)) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `segment[u,v] SUBSET t ==> segment(u,v) SUBSET segment[u,v] /\ (!x. x IN t ==> ~(x IN s)) /\ segment(u,v) SUBSET b ==> w IN segment(u,v) ==> ~(w IN b ==> w IN s)`)) THEN ASM_REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN SIMP_TAC[real_gt; IN_ELIM_THM; REAL_LT_REFL]; DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN ASM_REWRITE_TAC[BOUNDED_BALL; BOUNDED_HALFSPACE_LT; BOUNDED_HALFSPACE_GT]]));; (* ------------------------------------------------------------------------- *) (* Full Caratheodory and Jordan-Schoenflies theorems. *) (* ------------------------------------------------------------------------- *) let CARATHEODORY_CONFORMAL_EXTENSION_THEOREM,JORDAN_SCHOENFLIES_CIRCLE = let carat_cball = prove (`!f s p. f holomorphic_on ball(Cx(&0),&1) /\ IMAGE f (ball(Cx(&0),&1)) = s /\ (!w z. w IN ball(Cx(&0),&1) /\ z IN ball(Cx(&0),&1) /\ f w = f z ==> w = z) /\ simple_path p /\ path_image p = frontier s ==> ?g h. homeomorphism (cball(Cx(&0),&1),closure s) (g,h) /\ IMAGE g (ball(Cx(&0),&1)) = s /\ IMAGE g (sphere(Cx(&0),&1)) = frontier s /\ !x. x IN ball(Cx(&0),&1) ==> g x = f x`, REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(Cx(&0),&1)`] HOLOMORPHIC_ON_INVERSE) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT; OPEN_BALL] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPEC `s:complex->bool` SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `bounded(s:complex->bool)` THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(CHOOSE_THEN (K ALL_TAC)); FIRST_X_ASSUM(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> (p <=> r /\ q) ==> s`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] THEN DISJ2_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC [`g:complex->complex`; `f:complex->complex`] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `frontier s:complex->bool`) THEN REWRITE_TAC[IN_COMPONENTS_SELF; NOT_IMP] THEN REWRITE_TAC[SYM(ASSUME `path_image p:complex->bool = frontier s`)] THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATH_IMAGE_NONEMPTY; BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]]] THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] TORHORST_CONFORMAL_EXTENSION_THEOREM) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT] THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[LOCALLY_CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f':complex->complex` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o GSYM)) THEN SIMP_TAC[] THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC [`bounded(s:complex->bool)`; `path_image p:complex->bool = frontier s`; `open(s:complex->bool)`; `simple_path(p:real^1->complex)`; `(f':complex->complex) continuous_on cball(Cx(&0),&1)`] THEN SUBGOAL_THEN `!w z. w IN ball(Cx(&0),&1) /\ z IN ball(Cx(&0),&1) /\ f' w:complex = f' z ==> w = z` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (f':complex->complex) (ball(Cx(&0),&1)) = s` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `f' holomorphic_on ball(Cx(&0),&1)` MP_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_EQ]; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`f':complex->complex`,`f:complex->complex`) THEN REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_PATH_CASES) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_ARC_EMPTY) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTERIOR_INSIDE_FRONTIER) THEN ASM_SIMP_TAC[INTERIOR_OPEN; SUBSET_EMPTY] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IMAGE_EQ_EMPTY; BALL_EQ_EMPTY] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN EXISTS_TAC `f:complex->complex` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!a. a IN closure s ==> ?!x. x IN cball(Cx(&0),&1) /\ (f:complex->complex) x = a` ASSUME_TAC THENL [X_GEN_TAC `a:complex` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `a:complex`] CARATHEODORY_CONFORMAL_EXTENSION_LEMMA) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT; HAS_SIZE_1_EXISTS; IN_ELIM_THM] THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC(SYM(ASSUME `path_image p:complex->bool = frontier s`)) THEN MATCH_MP_TAC CONNECTED_SIMPLE_PATH_IMAGE_DELETE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (f:complex->complex) (cball(Cx(&0),&1)) = closure s` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SIMP_TAC[GSYM CLOSURE_BALL; REAL_LT_01] THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN ASM_SIMP_TAC[CLOSURE_BALL; REAL_LT_01; CLOSED_CLOSURE; CLOSURE_SUBSET]; ALL_TAC] THEN SIMP_TAC[frontier; GSYM CBALL_DIFF_BALL; LEFT_EXISTS_AND_THM] THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN ASM_REWRITE_TAC[COMPACT_CBALL; INJECTIVE_ON_ALT] THEN ASM SET_TAC[]; MP_TAC(ISPECL [`Cx(&0)`; `&1`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]]) in let js_cball = prove (`!g:real^2->real^2 h s z:real^2. homeomorphism (sphere(vec 0,&1),s) (g,h) /\ z IN inside s ==> ?g' h'. homeomorphism (cball(vec 0,&1),closure(inside s)) (g',h') /\ (!x. x IN sphere(vec 0,&1) ==> g' x = g x) /\ (!y. y IN s ==> h' y = h y) /\ IMAGE g' (sphere(vec 0,&1)) = s /\ IMAGE g' (ball(vec 0,&1)) = inside s /\ g'(vec 0) = z`, REWRITE_TAC[COMPLEX_VEC_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `compact(s:real^2->bool)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_IMP_HOMEOMORPHIC) THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN REWRITE_TAC[COMPACT_SPHERE]; FIRST_ASSUM(ASSUME_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP COMPACT_IMP_CLOSED)] THEN MP_TAC(ISPECL [`s:real^2->bool`; `Cx(&0)`; `&1`] HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[homeomorphic; HOMEOMORPHIC_SYM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^2` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `frontier(inside s):complex->bool = s` ASSUME_TAC THENL [ASM_MESON_TAC[JORDAN_INSIDE_OUTSIDE]; ALL_TAC] THEN SUBGOAL_THEN `?f k:complex->complex. homeomorphism (cball (Cx (&0),&1),closure (inside s)) (f,k) /\ IMAGE f (ball (Cx (&0),&1)) = inside s /\ IMAGE f (sphere (Cx (&0),&1)) = s /\ f(Cx(&0)) = z` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?f k. f holomorphic_on ball(Cx(&0),&1) /\ k holomorphic_on inside s /\ f(Cx(&0)) = z /\ (!z. z IN ball(Cx(&0),&1) ==> f z IN inside s /\ k(f z) = z) /\ (!z. z IN inside s ==> k z IN ball(Cx(&0),&1) /\ f(k z) = z)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `inside(path_image p):complex->bool` RIEMANN_MAPPING_THEOREM) THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH; OPEN_INSIDE] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[JORDAN_INSIDE_OUTSIDE]; DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^2->bool)->bool`) THEN ASM_SIMP_TAC[BOUNDED_INSIDE; NOT_BOUNDED_UNIV]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`k0:complex->complex`; `h0:complex->complex`] THEN STRIP_TAC THEN MP_TAC(ISPEC `(k0:complex->complex) z` BALL_BIHOLOMORPHISM_EXISTS) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:complex->complex`; `h1:complex->complex`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(h0:complex->complex) o (h1:complex->complex)`; `(k1:complex->complex) o (k0:complex->complex)`] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]; MP_TAC(ISPECL [`f:complex->complex`; `inside s:complex->bool`; `p:real^1->complex`] carat_cball) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_01]]; ALL_TAC] THEN ABBREV_TAC `kg = (k:complex->complex) o (g:complex->complex)` THEN ABBREV_TAC `r = \z. norm z % (kg:complex->complex) (inv(norm z) % z)` THEN SUBGOAL_THEN `!w. norm((r:complex->complex) w) = norm w` ASSUME_TAC THENL [X_GEN_TAC `w:complex` THEN EXPAND_TAC "r" THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NORM] THEN ASM_CASES_TAC `w:complex = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC(REAL_RING `x = &1 ==> y * x = y`) THEN RULE_ASSUM_TAC(REWRITE_RULE [HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0]) THEN EXPAND_TAC "kg" THEN REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM COMPLEX_IN_SPHERE_0] THEN SUBGOAL_THEN `sphere(Cx(&0),&1) = IMAGE (k:complex->complex) s` SUBST1_TAC THENL [MP_TAC(ISPECL [`Cx(&0)`; `&1`] SPHERE_SUBSET_CBALL) THEN ASM SET_TAC[]; MATCH_MP_TAC FUN_IN_IMAGE] THEN REPEAT(FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NORM; REAL_ABS_INV] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; ALL_TAC] THEN SUBGOAL_THEN `!w x. (r:complex->complex) w = r x <=> w = x` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(AP_TERM `norm:complex->real` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXPAND_TAC "r" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN ASM_CASES_TAC `x:complex = vec 0` THEN ASM_REWRITE_TAC[NORM_EQ_0] THENL [ASM_MESON_TAC[NORM_EQ_0]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])) THEN EXPAND_TAC "kg" THEN REWRITE_TAC[o_THM] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN s ==> f(k x) = x) ==> (a IN s /\ b IN s) /\ (a = b ==> P) ==> k a = k b ==> P`)) THEN CONJ_TAC THENL [CONJ_TAC THEN REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_IN_SPHERE_0; NORM_MUL; REAL_ABS_NORM; REAL_ABS_INV] THEN ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN s ==> f(k x) = x) ==> (a IN s /\ b IN s) /\ (a = b ==> P) ==> k a = k b ==> P`)) THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_IN_SPHERE_0; NORM_MUL; REAL_ABS_NORM; REAL_ABS_INV] THEN ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0]; ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_INV_EQ_0; NORM_EQ_0]]; ALL_TAC] THEN SUBGOAL_THEN `r(Cx(&0)) = Cx(&0)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_NORM_ZERO]; ALL_TAC] THEN SUBGOAL_THEN `(r:complex->complex) continuous_on UNIV` ASSUME_TAC THENL [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_UNIV] THEN ASM_CASES_TAC `x = Cx(&0)` THENL [ASM_REWRITE_TAC[continuous_at; dist; COMPLEX_SUB_RZERO] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(r:complex->complex) continuous (at x within (UNIV DELETE Cx(&0)))` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[CONTINUOUS_WITHIN; CONTINUOUS_AT; LIM_WITHIN_OPEN; IN_DELETE; IN_UNIV; OPEN_UNIV; OPEN_DELETE]] THEN EXPAND_TAC "r" THEN MATCH_MP_TAC CONTINUOUS_MUL THEN SIMP_TAC[CONTINUOUS_AT_LIFT_NORM; CONTINUOUS_AT_WITHIN] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN REWRITE_TAC[CONTINUOUS_WITHIN_ID]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `sphere(Cx(&0),&1)` THEN CONJ_TAC THENL [EXPAND_TAC "kg" THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN ASM_SIMP_TAC[COMPLEX_IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; COMPLEX_NORM_ZERO; REAL_MUL_LINV]; MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `closure(inside s):complex->bool` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure(inside s) /\ x IN s ==> x IN closure(inside s)`) THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[COMPLEX_IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; COMPLEX_NORM_ZERO; REAL_MUL_LINV]; ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; SUBSET_UNION]]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE] THEN SIMP_TAC[COMPLEX_IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; COMPLEX_NORM_ZERO; REAL_MUL_LINV]]; ALL_TAC] THEN EXISTS_TAC `(f:complex->complex) o (r:complex->complex)` THEN MATCH_MP_TAC(MESON[] `u /\ q /\ (!x. P x /\ q ==> R x /\ s /\ t) /\ (?x. P x) ==> ?x. P x /\ q /\ R x /\ s /\ t /\ u`) THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[o_THM]; EXPAND_TAC "r" THEN SIMP_TAC[COMPLEX_IN_SPHERE_0; o_THM] THEN X_GEN_TAC `x:complex` THEN DISCH_TAC THEN REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID] THEN EXPAND_TAC "kg" THEN REWRITE_TAC[o_THM] THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure(inside s) /\ x IN s ==> x IN closure(inside s)`) THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[COMPLEX_IN_SPHERE_0]; X_GEN_TAC `h':complex->complex` THEN ABBREV_TAC `g' = (f:complex->complex) o (r:complex->complex)` THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])) THEN REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN CONJ_TAC THENL [X_GEN_TAC `y:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `(g':complex->complex)(h'(y:complex)) = g'(h y)` MP_TAC THENL [ASM_SIMP_TAC[GSYM FRONTIER_UNION_INTERIOR; IN_UNION] THEN TRANS_TAC EQ_TRANS `(g:complex->complex)(h(y:complex))` THEN CONJ_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o AP_TERM `h':complex->complex`) THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM FRONTIER_UNION_INTERIOR; IN_UNION]; REWRITE_TAC[GSYM BALL_UNION_SPHERE; IN_UNION] THEN ASM SET_TAC[]]]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN SUBGOAL_THEN `IMAGE (g':complex->complex) (cball(Cx(&0),&1)) = closure(inside s)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ IMAGE f s DIFF IMAGE f t = b ==> IMAGE f (s DIFF t) = b`) THEN ASM_REWRITE_TAC[SPHERE_SUBSET_CBALL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM FRONTIER_UNION_INTERIOR] THEN ASM_SIMP_TAC[OPEN_INSIDE; INTERIOR_OPEN] THEN MP_TAC(ISPEC `s:complex->bool` INSIDE_NO_OVERLAP) THEN SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN REWRITE_TAC[COMPACT_CBALL; IMAGE_o] THEN SUBGOAL_THEN `IMAGE r (cball(Cx(&0),&1)) = cball(Cx(&0),&1)` ASSUME_TAC THENL [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN ASM_REWRITE_TAC[COMPLEX_IN_CBALL_0] THEN X_GEN_TAC `y:complex` THEN DISCH_TAC THEN ASM_CASES_TAC `y = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `norm y % (h:complex->complex)((f:complex->complex) (inv(norm y) % y))` THEN ABBREV_TAC `y':complex = inv(norm y) % y` THEN SUBGOAL_THEN `y' IN sphere(Cx(&0),&1)` ASSUME_TAC THENL [EXPAND_TAC "y'" THEN ASM_SIMP_TAC[COMPLEX_IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; COMPLEX_NORM_ZERO; REAL_MUL_LINV]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])) THEN SUBGOAL_THEN `h((f:complex->complex) y') IN sphere(Cx(&0),&1)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN EXPAND_TAC "r" THEN SIMP_TAC[COMPLEX_IN_SPHERE_0; NORM_MUL] THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_RID; REAL_ABS_NORM] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; COMPLEX_NORM_ZERO] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN TRANS_TAC EQ_TRANS `norm(y:complex) % y':complex` THEN CONJ_TAC THENL [AP_TERM_TAC THEN EXPAND_TAC "kg" THEN REWRITE_TAC[o_DEF] THEN MP_TAC(ISPECL [`Cx(&0)`; `&1`] SPHERE_SUBSET_CBALL) THEN ASM SET_TAC[]; EXPAND_TAC "y'" THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; COMPLEX_NORM_ZERO] THEN REWRITE_TAC[VECTOR_MUL_LID]]; RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; MAP_EVERY X_GEN_TAC [`x:complex`; `y:complex`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN DISCH_THEN(MP_TAC o AP_TERM `k:complex->complex`) THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN ASM SET_TAC[]]]]) in let inv_lemma = prove (`!g. simple_path g /\ pathfinish g = pathstart g /\ Cx(&0) IN inside(path_image g) ==> homeomorphism(outside(path_image g), inside(path_image(inv o g)) DELETE Cx(&0)) (inv,inv)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(Cx(&0) IN outside(path_image g))` ASSUME_TAC THENL [MP_TAC(ISPEC `path_image g:complex->bool` INSIDE_INTER_OUTSIDE) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(Cx(&0) IN path_image g)` ASSUME_TAC THENL [MP_TAC(ISPEC `path_image g:complex->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[homeomorphism; COMPLEX_INV_INV] THEN MATCH_MP_TAC(TAUT `(q /\ s) /\ (p /\ r) ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM2; IN_DELETE]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ IMAGE f s = t ==> IMAGE f s = t /\ IMAGE f t = s`) THEN REWRITE_TAC[COMPLEX_INV_INV] THEN SUBGOAL_THEN `pathfinish(inv o g) = pathstart (inv o g)` ASSUME_TAC THENL [ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE]; ALL_TAC] THEN SUBGOAL_THEN `simple_path(inv o g)` ASSUME_TAC THENL [MATCH_MP_TAC SIMPLE_PATH_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[o_THM; COMPLEX_EQ_INV2] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `g:real^1->complex` JORDAN_INSIDE_OUTSIDE) THEN MP_TAC(ISPEC `inv o (g:real^1->complex)` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s t'. (s SUBSET s' \/ s SUBSET t') /\ (t SUBSET s' \/ t SUBSET t') /\ ~(s SUBSET s') /\ DISJOINT s' t' /\ ~(s' = {}) /\ s' SUBSET s UNION t ==> t = s'`) THEN EXISTS_TAC `IMAGE inv (inside (path_image g) DELETE Cx(&0))` THEN EXISTS_TAC `outside (path_image (inv o g))` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ f z = z /\ (IMAGE f (s DELETE z) SUBSET t \/ P) ==> IMAGE f (s DELETE z) SUBSET t DELETE z \/ P`) THEN REWRITE_TAC[COMPLEX_INV_0; COMPLEX_INV_INV] THEN REWRITE_TAC[SET_RULE `s SUBSET t \/ s SUBSET u <=> ?a. a IN {t,u} /\ s SUBSET a`] THEN ASM_SIMP_TAC[GSYM JORDAN_COMPONENTS] THEN MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ i INTER c = {} ==> IMAGE f (i DELETE a) SUBSET UNIV DIFF IMAGE f c`) THEN REWRITE_TAC[COMPLEX_INV_INV; INSIDE_NO_OVERLAP]; REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN DISCH_THEN(MP_TAC o AP_TERM `bounded:(complex->bool)->bool`) THEN ASM_SIMP_TAC[BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN REWRITE_TAC[NOT_BOUNDED_UNIV]; MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONNECTED_OPEN_DELETE; DIMINDEX_2; LE_REFL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM SET_TAC[]]; MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ f z = z /\ ~(z IN s) /\ (IMAGE f s SUBSET t \/ Q) ==> IMAGE f s SUBSET t DELETE z \/ Q`) THEN ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_INV_INV] THEN REWRITE_TAC[SET_RULE `s SUBSET t \/ s SUBSET u <=> ?a. a IN {t,u} /\ s SUBSET a`] THEN ASM_SIMP_TAC[GSYM JORDAN_COMPONENTS] THEN MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ i INTER c = {} ==> IMAGE f i SUBSET UNIV DIFF IMAGE f c`) THEN REWRITE_TAC[COMPLEX_INV_INV; OUTSIDE_NO_OVERLAP]; REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN DISCH_THEN(MP_TAC o AP_TERM `bounded:(complex->bool)->bool`) THEN ASM_SIMP_TAC[BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN REWRITE_TAC[NOT_BOUNDED_UNIV]; MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONNECTED_OPEN_DELETE; DIMINDEX_2; LE_REFL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM SET_TAC[]]; DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN ASM_REWRITE_TAC[BOUNDED_DELETE] THEN MP_TAC(ISPEC `inside(path_image g):complex->bool` OPEN_CONTAINS_CBALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `b SUBSET i ==> IMAGE inv (b DELETE Cx(&0)) SUBSET IMAGE inv(i DELETE Cx(&0))`)) THEN MATCH_MP_TAC(MESON[BOUNDED_SUBSET] `~bounded s ==> s SUBSET t ==> ~bounded t`) THEN REWRITE_TAC[bounded; IN_DELETE; IMP_CONJ; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `Cx(min r (inv(abs B + &1)))`) THEN REWRITE_TAC[COMPLEX_NORM_INV; COMPLEX_NORM_CX; COMPLEX_IN_CBALL_0] THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < abs B + &1`; CX_INJ; REAL_ARITH `&0 < r /\ &0 < s ==> abs(min r s) <= r`; REAL_ARITH `&0 < r /\ &0 < s ==> ~(min r s = &0)`] THEN REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC(REAL_ARITH `abs B + &1 <= x ==> B < x`) THEN MATCH_MP_TAC REAL_LE_RINV THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_LT_MIN; REAL_LT_INV_EQ; REAL_ARITH `&0 < abs B + &1`] THEN GEN_REWRITE_TAC LAND_CONV [real_abs] THEN ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_ARITH `&0 <= abs B + &1`] THEN REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `s INTER t = {} ==> DISJOINT (s DELETE a) t`) THEN REWRITE_TAC[INSIDE_INTER_OUTSIDE]; REWRITE_TAC[SET_RULE `s DELETE a = {} <=> s = {} \/ s = {a}`] THEN ASM_MESON_TAC[NOT_OPEN_SING]; ASM_SIMP_TAC[COMPLEX_INV_INV; COMPLEX_INV_0; SET_RULE `(!x. f(f x) = x) /\ f z = z /\ ~(z IN t) ==> IMAGE f (s DELETE z) UNION IMAGE f t = IMAGE f (s UNION t) DELETE z`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s UNION t = UNIV DIFF g ==> (UNIV DIFF g) DELETE z SUBSET u ==> s DELETE z SUBSET u`)) THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN MP_TAC COMPLEX_INV_INV THEN MP_TAC COMPLEX_INV_0 THEN ASM SET_TAC[]]) in let js_noball_0 = prove (`!g:real^2->real^2 h s. homeomorphism (sphere(vec 0,&1),s) (g,h) /\ vec 0 IN inside s ==> ?g' h'. homeomorphism ((:complex) DIFF ball(Cx(&0),&1), closure(outside s)) (g',h') /\ (!x. x IN sphere(vec 0,&1) ==> g' x = g x) /\ (!y. y IN s ==> h' y = h y) /\ IMAGE g' (sphere(vec 0,&1)) = s /\ IMAGE g' ((:complex) DIFF cball(vec 0,&1)) = outside s`, REWRITE_TAC[COMPLEX_VEC_0] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^2->bool`; `Cx(&0)`; `&1`] HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[homeomorphic; HOMEOMORPHIC_SYM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^2` STRIP_ASSUME_TAC) THEN ABBREV_TAC `q = inv o (p:real^1->real^2)` THEN MP_TAC(ISPEC `p:real^1->real^2` inv_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `~(Cx(&0) IN outside(path_image p))` ASSUME_TAC THENL [MP_TAC(ISPEC `path_image p:complex->bool` INSIDE_INTER_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(Cx(&0) IN path_image p)` ASSUME_TAC THENL [MP_TAC(ISPEC `path_image p:complex->bool` INSIDE_NO_OVERLAP) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `pathfinish q:complex = pathstart q` ASSUME_TAC THENL [EXPAND_TAC "q" THEN REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `simple_path(q:real^1->real^2)` ASSUME_TAC THENL [EXPAND_TAC "q" THEN MATCH_MP_TAC SIMPLE_PATH_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[o_THM; COMPLEX_EQ_INV2] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `homeomorphism (closure(outside s), closure(inside (path_image q)) DELETE Cx (&0)) (inv,inv)` MP_TAC THENL [SUBGOAL_THEN `closure(outside s):complex->bool = s UNION outside s /\ closure(inside(path_image q)):complex->bool = path_image q UNION inside(path_image q)` (CONJUNCTS_THEN SUBST1_TAC) THENL [REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN MP_TAC(ISPEC `q:real^1->complex` JORDAN_INSIDE_OUTSIDE) THEN MP_TAC(ISPEC `p:real^1->complex` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN ASM_REWRITE_TAC[homeomorphism; COMPLEX_INV_INV] THEN MATCH_MP_TAC(TAUT `(q /\ s) /\ (p /\ r) ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM2; IN_DELETE; IN_UNION] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ IMAGE f s = t ==> IMAGE f s = t /\ IMAGE f t = s`) THEN REWRITE_TAC[COMPLEX_INV_INV] THEN ASM_REWRITE_TAC[IMAGE_UNION] THEN EXPAND_TAC "q" THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `~(z IN s) ==> s UNION t DELETE z = (s UNION t) DELETE z`) THEN MATCH_MP_TAC(SET_RULE `(!x:complex. inv(inv x) = x) /\ ~(inv x IN s) ==> ~(x IN IMAGE inv s)`) THEN ASM_MESON_TAC[COMPLEX_INV_INV; COMPLEX_INV_0]; UNDISCH_TAC `homeomorphism (outside s,inside (path_image q) DELETE Cx (&0)) (inv,inv)` THEN GEN_REWRITE_TAC LAND_CONV [homeomorphism] THEN REWRITE_TAC[COMPLEX_INV_INV] THEN STRIP_TAC THEN DISCH_TAC] THEN SUBGOAL_THEN `~(Cx(&0) IN path_image q)` ASSUME_TAC THENL [ONCE_REWRITE_TAC[GSYM COMPLEX_INV_0] THEN EXPAND_TAC "q" THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `f x IN IMAGE f s ==> (!x. f(f x) = x) ==> x IN s`)) THEN ASM_REWRITE_TAC[COMPLEX_INV_INV]; ALL_TAC] THEN SUBGOAL_THEN `Cx(&0) IN inside(path_image q)` ASSUME_TAC THENL [SUBGOAL_THEN `Cx(&0) IN closure(inside(path_image q))` MP_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS o MATCH_MP HOMEOMORPHISM_IMP_HOMEOMORPHIC) THEN ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN REWRITE_TAC[BOUNDED_CLOSURE_EQ] THEN EXPAND_TAC "s" THEN ASM_SIMP_TAC[BOUNDED_INSIDE; UNBOUNDED_OUTSIDE; BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]; REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN MP_TAC(ISPEC `path_image q:complex->bool` FRONTIER_INSIDE_SUBSET) THEN ASM_SIMP_TAC[CLOSED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN ASM SET_TAC[]]; ALL_TAC] THEN MP_TAC(ISPECL [`inv o (g:complex->complex)`; `(h:complex->complex) o inv`; `path_image q:complex->bool`; `Cx(&0)`] js_cball) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[COMPLEX_VEC_0] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `p:real^1->complex` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; SUBSET_UNION]; MP_TAC(ISPEC `q:real^1->complex` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]; EXPAND_TAC "q" THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_VEC_0; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g':complex->complex`; `h':complex->complex`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`inv o (g':complex->complex) o (\x. inv(norm x) pow 2 % x)`; `(\x. inv(norm x) pow 2 % x) o (h':complex->complex) o inv`] THEN SUBGOAL_THEN `IMAGE (\x. inv (norm x) pow 2 % x) ((:real^2) DIFF cball(Cx(&0),&1)) = ball(Cx(&0),&1) DELETE Cx(&0) /\ IMAGE (\x. inv (norm x) pow 2 % x) ((:real^2) DIFF ball(Cx(&0),&1)) = cball(Cx(&0),&1) DELETE Cx(&0)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ IMAGE f s SUBSET t /\ IMAGE f t SUBSET s ==> IMAGE f s = t`) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[NORM_MUL; COMPLEX_IN_CBALL_0; COMPLEX_IN_BALL_0] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; VECTOR_MUL_EQ_0; REAL_POW_EQ_0] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN SIMP_TAC[NORM_EQ_0; REAL_FIELD `~(n = &0) ==> inv n pow 2 * n = inv n`; REAL_FIELD `&1 <= n ==> inv n pow 2 * n = inv n`; REAL_FIELD `&1 < n ==> inv n pow 2 * n = inv n`] THEN SIMP_TAC[REAL_INV_LT_1; REAL_INV_LE_1] THEN SIMP_TAC[REAL_INV_1_LE; REAL_INV_1_LT; NORM_POS_LT] THEN CONJ_TAC THEN X_GEN_TAC `x:complex` THEN ASM_CASES_TAC `x:complex = vec 0` THEN ASM_REWRITE_TAC[NORM_0; VECTOR_MUL_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(x:complex = vec 0)` THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [o_ASSOC] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `cball(Cx(&0),&1) DELETE Cx(&0)` THEN CONJ_TAC THENL [REWRITE_TAC[HOMEOMORPHISM; COMPLEX_INV_INV] THEN MATCH_MP_TAC(TAUT `(p /\ r) /\ (q /\ s) ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_POW THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_NORM_ZERO; IN_DIFF; IN_UNIV; IN_DELETE] THEN REWRITE_TAC[CENTRE_IN_BALL; CENTRE_IN_CBALL] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `IMAGE f s = s' /\ (!x. f(f x) = x) ==> IMAGE f s SUBSET s' /\ IMAGE f s' SUBSET s`) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:complex` THEN ASM_CASES_TAC `x:complex = vec 0` THEN ASM_REWRITE_TAC[NORM_0; VECTOR_MUL_RZERO]; CONJ_TAC THEN X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_DELETE; IN_DIFF; IN_UNIV; IN_DELETE; GSYM COMPLEX_VEC_0] THEN ASM_CASES_TAC `x:complex = vec 0` THEN ASM_REWRITE_TAC[CENTRE_IN_CBALL; CENTRE_IN_BALL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(K ALL_TAC)] THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RCANCEL] THEN DISJ1_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NORM] THEN UNDISCH_TAC `~(x:complex = vec 0)` THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `closure(inside(path_image q)) DELETE Cx(&0)` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHISM_SYM]] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN REWRITE_TAC[DELETE_SUBSET] THEN MATCH_MP_TAC(SET_RULE `IMAGE f s = s' /\ z IN s /\ f z = z /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f (s DELETE z) = s' DELETE z`) THEN ASM_REWRITE_TAC[CENTRE_IN_CBALL; REAL_POS] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]; REWRITE_TAC[o_THM; MESON[COMPLEX_INV_INV] `inv x = y <=> x = inv y`] THEN REWRITE_TAC[COMPLEX_IN_SPHERE_0] THEN REPEAT STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[o_THM]) THEN ASM_REWRITE_TAC[REAL_INV_1; REAL_POW_ONE; VECTOR_MUL_LID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[COMPLEX_IN_SPHERE_0]; X_GEN_TAC `y:complex` THEN DISCH_TAC THEN UNDISCH_TAC `!y. y IN path_image q ==> (h':complex->complex) y = (h o inv) y` THEN EXPAND_TAC "q" THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN DISCH_THEN(MP_TAC o SPEC `inv y:complex`) THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_INV_INV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_RCANCEL] THEN DISJ1_TAC THEN MATCH_MP_TAC(REAL_FIELD `x = &1 ==> inv(x) pow 2 = &1`) THEN REWRITE_TAC[GSYM COMPLEX_IN_SPHERE_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN SUBGOAL_THEN `IMAGE (\x. inv(norm x) pow 2 % x) (sphere(Cx(&0),&1)) = sphere(Cx(&0),&1)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = x) ==> IMAGE f s = s`) THEN SIMP_TAC[COMPLEX_IN_SPHERE_0; REAL_INV_1; REAL_POW_ONE; VECTOR_MUL_LID]; ASM_REWRITE_TAC[] THEN EXPAND_TAC "q" THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; COMPLEX_INV_INV; IMAGE_ID]]; ASM_REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ t = IMAGE f s ==> IMAGE f t = s`) THEN ASM_REWRITE_TAC[COMPLEX_INV_INV] THEN MATCH_MP_TAC(SET_RULE `f z = z /\ z IN b /\ IMAGE f b = i /\ (!x y. x IN b /\ y IN b /\ f x = f y ==> x = y) ==> IMAGE f (b DELETE z) = i DELETE z`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN MP_TAC(ISPECL [`Cx(&0)`; `&1`] BALL_SUBSET_CBALL) THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]) in let js_noball = prove (`!g:real^2->real^2 h s. homeomorphism (sphere(vec 0,&1),s) (g,h) ==> ?g' h'. homeomorphism ((:complex) DIFF ball(Cx(&0),&1), closure(outside s)) (g',h') /\ (!x. x IN sphere(vec 0,&1) ==> g' x = g x) /\ (!y. y IN s ==> h' y = h y) /\ IMAGE g' (sphere(vec 0,&1)) = s /\ IMAGE g' ((:complex) DIFF cball(vec 0,&1)) = outside s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?a:complex. a IN inside s` MP_TAC THENL [MP_TAC(ISPECL [`s:real^2->bool`; `vec 0:complex`; `&1`] HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[homeomorphic; HOMEOMORPHIC_SYM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^2` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `p:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY]; DISCH_THEN(X_CHOOSE_TAC `z:complex`)] THEN MP_TAC(ISPECL [`(\x. --z + x) o (g:complex->complex)`; `(h:complex->complex) o (\x. z + x)`; `IMAGE (\x:complex. --z + x) s`] js_noball_0) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INSIDE_TRANSLATION; IN_IMAGE; UNWIND_THM2; VECTOR_ARITH `vec 0:real^N = --z + x <=> x = z`] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[homeomorphism; CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; GSYM IMAGE_o; o_DEF; FORALL_IN_IMAGE] THEN REWRITE_TAC[COMPLEX_RING `z + --z + x:complex = x`; IMAGE_ID]; REWRITE_TAC[OUTSIDE_TRANSLATION; CLOSURE_TRANSLATION; FORALL_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[o_THM; COMPLEX_RING `z + --z + x:complex = x`]] THEN MAP_EVERY X_GEN_TAC [`f:complex->complex`; `k:complex->complex`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(\x. z + x) o (f:complex->complex)`; `(k:complex->complex) o (\x. --z + x)`] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_REWRITE_TAC[homeomorphism; IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[COMPLEX_RING `--z + z + x:complex = x`]; REWRITE_TAC[GSYM IMAGE_o; IMAGE_ID; o_DEF; COMPLEX_RING `z + --z + x:complex = x`]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[COMPLEX_RING `z + x:complex = y <=> x = --z + y`] THEN REPEAT(FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]]; ASM_REWRITE_TAC[IMAGE_o] THEN ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[COMPLEX_RING `z + --z + x:complex = x`; IMAGE_ID]]) in let CARATHEODORY_CONFORMAL_EXTENSION_THEOREM = prove (`!f s p. f holomorphic_on ball(Cx(&0),&1) /\ IMAGE f (ball(Cx(&0),&1)) = s /\ (!w z. w IN ball(Cx(&0),&1) /\ z IN ball(Cx(&0),&1) /\ f w = f z ==> w = z) /\ simple_path p /\ path_image p = frontier s ==> ?g h. homeomorphism ((:complex),(:complex)) (g,h) /\ IMAGE g (ball(Cx(&0),&1)) = s /\ IMAGE g (cball(Cx(&0),&1)) = closure s /\ IMAGE g (sphere(Cx(&0),&1)) = frontier s /\ IMAGE g ((:complex) DIFF cball(Cx(&0),&1)) = (:complex) DIFF closure s /\ !x. x IN ball(Cx(&0),&1) ==> g x = f x`, REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `ball(Cx(&0),&1)`] HOLOMORPHIC_ON_INVERSE) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT; OPEN_BALL] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `f':complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `s:complex->bool` SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> s \/ p) ==> r`) THEN CONJ_TAC THENL [REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC [`f':complex->complex`; `f:complex->complex`] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `bounded(s:complex->bool)` THENL [ASM_SIMP_TAC[SIMPLY_CONNECTED_IFF_SIMPLE] THEN STRIP_TAC; ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES] THEN DISCH_THEN(MP_TAC o SPEC `frontier s:complex->bool` o CONJUNCT2) THEN REWRITE_TAC[IN_COMPONENTS_SELF; NOT_IMP] THEN REWRITE_TAC[SYM(ASSUME `path_image p:complex->bool = frontier s`)] THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATH_IMAGE_NONEMPTY; BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_PATH_CASES) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_ARC_EMPTY) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTERIOR_INSIDE_FRONTIER) THEN ASM_SIMP_TAC[INTERIOR_OPEN; SUBSET_EMPTY] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IMAGE_EQ_EMPTY; BALL_EQ_EMPTY] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN MP_TAC(ISPEC `p:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `p:real^1->complex`] carat_cball) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g1:complex->complex`; `h1:complex->complex`] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM COMPLEX_VEC_0]) THEN SUBGOAL_THEN `inside(frontier s) = s /\ outside(frontier s) = (:real^2) DIFF closure s` (CONJUNCTS_THEN (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)) THENL [MATCH_MP_TAC INSIDE_OUTSIDE_UNIQUE THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN EXISTS_TAC `cball(vec 0:real^2,&1)` THEN REWRITE_TAC[DIMINDEX_2; LE_REFL; CONVEX_CBALL; COMPACT_CBALL] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN ASM_MESON_TAC[]; MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN ASM_SIMP_TAC[BOUNDED_CLOSURE; COMPL_COMPL]; REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`inside(frontier s):real^2->bool`; `outside(frontier s):real^2->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN ASM SET_TAC[]]; UNDISCH_THEN `frontier s:real^2->bool = frontier s` (K ALL_TAC)] THEN MP_TAC(ISPECL [`g1:real^2->real^2`; `h1:real^2->real^2`; `frontier s:real^2->bool`] js_noball) THEN ANTS_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM CBALL_DIFF_BALL; frontier] THEN SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM COMPLEX_VEC_0]] THEN MAP_EVERY X_GEN_TAC [`g2:real^2->real^2`; `h2:real^2->real^2`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN MP_TAC(ASSUME `homeomorphism (cball (vec 0,&1),closure s) (g1:real^2->real^2,h1)`) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (ONCE_REWRITE_RULE[CONJ_ASSOC] HOMOEOMORPHISM_PASTE))) THEN RULE_ASSUM_TAC(REWRITE_RULE[FRONTIER_COMPLEMENT]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [DISJ2_TAC THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[SUBSET_UNION; CLOSED_CBALL; OPEN_BALL; GSYM OPEN_CLOSED] THEN REWRITE_TAC[CLOSED_CLOSURE]; REWRITE_TAC[GSYM SPHERE_UNION_BALL] THEN ASM SET_TAC[]; GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM CLOSURE_CLOSURE] THEN ASM_REWRITE_TAC[GSYM FRONTIER_CLOSURES]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^2->real^2` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^2->real^2` THEN SUBGOAL_THEN `cball(vec 0,&1) UNION (:real^2) DIFF ball(vec 0,&1) = (:real^2)` SUBST1_TAC THENL [REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `closure s UNION closure ((:real^2) DIFF closure s) = (:real^2)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `UNIV DIFF c SUBSET closure(UNIV DIFF c) ==> c UNION closure(UNIV DIFF c) = UNIV`) THEN REWRITE_TAC[CLOSURE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `closure s INTER closure ((:real^2) DIFF closure s) = frontier s` SUBST1_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM CLOSURE_CLOSURE] THEN ASM_REWRITE_TAC[GSYM FRONTIER_CLOSURES]; ALL_TAC] THEN SUBGOAL_THEN `cball(vec 0,&1) DIFF ((:real^2) DIFF ball (vec 0,&1)) = ball(vec 0,&1)` SUBST1_TAC THENL [MP_TAC(ISPECL [`vec 0:real^2`; `&1`] BALL_SUBSET_CBALL) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `cball(vec 0,&1) INTER ((:real^2) DIFF ball(vec 0,&1)) = sphere(vec 0,&1)` SUBST1_TAC THENL [REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(:real^2) DIFF ball(vec 0,&1) DIFF cball(vec 0,&1) = (:real^2) DIFF cball(vec 0,&1)` SUBST1_TAC THENL [MP_TAC(ISPECL [`vec 0:real^2`; `&1`] BALL_SUBSET_CBALL) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `closure s DIFF closure ((:real^2) DIFF closure s) = s` SUBST1_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CLOSURE_UNION_FRONTIER] THEN ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; SET_RULE `c DIFF (UNIV DIFF c UNION s) = c DIFF s`] THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN MP_TAC(ISPEC `s:real^2->bool` CLOSURE_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `closure ((:real^2) DIFF closure s) DIFF closure s = (:real^2) DIFF closure s` SUBST1_TAC THENL [MP_TAC(ISPEC `(:real^2) DIFF closure s` CLOSURE_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN SIMP_TAC[] THEN SIMP_TAC[GSYM SPHERE_UNION_BALL; IN_UNION] THEN ASM_REWRITE_TAC[]]) in let JORDAN_SCHOENFLIES_CIRCLE = prove (`!g:real^2->real^2 h s. homeomorphism (sphere(vec 0,&1),s) (g,h) ==> ?g' h'. homeomorphism ((:real^2),(:real^2)) (g',h') /\ (!x. x IN sphere(vec 0,&1) ==> g' x = g x) /\ (!y. y IN s ==> h' y = h y) /\ IMAGE g' (ball(vec 0,&1)) = inside s /\ IMAGE g' (sphere(vec 0,&1)) = s /\ IMAGE g' ((:real^2) DIFF cball(vec 0,&1)) = outside s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP js_noball) THEN MP_TAC(ISPECL [`s:real^2->bool`; `vec 0:real^2`; `&1`] HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[homeomorphic; HOMEOMORPHIC_SYM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^2` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `p:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `?z:real^2. z IN inside s` CHOOSE_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^2->real^2`; `h:real^2->real^2`; `s:real^2->bool`; `z:real^2`] js_cball) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM COMPLEX_VEC_0] THEN MAP_EVERY X_GEN_TAC [`g1:real^2->real^2`; `h1:real^2->real^2`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`g2:real^2->real^2`; `h2:real^2->real^2`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (ONCE_REWRITE_RULE[CONJ_ASSOC] HOMOEOMORPHISM_PASTE)) th)) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [DISJ2_TAC THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[SUBSET_UNION; CLOSED_CBALL; OPEN_BALL; GSYM OPEN_CLOSED] THEN REWRITE_TAC[CLOSED_CLOSURE]; REWRITE_TAC[GSYM SPHERE_UNION_BALL] THEN ASM SET_TAC[]; ASM_SIMP_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^2->real^2` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^2->real^2` THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; GSYM BALL_UNION_SPHERE] THEN REWRITE_TAC[SET_RULE `(b UNION s) UNION (UNIV DIFF b) = UNIV`] THEN ASM_SIMP_TAC[SET_RULE `i UNION e = UNIV DIFF s /\ i INTER e = {} ==> (i UNION s) UNION (e UNION s) = UNIV /\ (i UNION s) DIFF (e UNION s) = i /\ (e UNION s) DIFF (i UNION s) = e /\ (i UNION s) INTER (e UNION s) = s`] THEN REWRITE_TAC[SET_RULE `(b UNION s) INTER (UNIV DIFF b) = s DIFF b`] THEN REWRITE_TAC[SET_RULE `(b UNION s) DIFF (UNIV DIFF b) = b`] THEN REWRITE_TAC[SET_RULE `UNIV DIFF b DIFF (b UNION s) = UNIV DIFF (b UNION s)`] THEN REWRITE_TAC[GSYM CBALL_DIFF_BALL; SET_RULE `c DIFF b DIFF b = c DIFF b`] THEN SIMP_TAC[CBALL_DIFF_BALL] THEN ASM SET_TAC[]]) in CARATHEODORY_CONFORMAL_EXTENSION_THEOREM,JORDAN_SCHOENFLIES_CIRCLE;; let JORDAN_SCHOENFLIES = prove (`!g h f f'. simple_path g /\ simple_path h /\ homeomorphism (path_image g,path_image h) (f,f') ==> ?k k'. homeomorphism ((:real^2),(:real^2)) (k,k') /\ (!x. x IN path_image g ==> k x = f x) /\ (!y. y IN path_image h ==> k' y = f' y) /\ IMAGE k (path_image g) = path_image h /\ IMAGE k (inside(path_image g)) = inside(path_image h) /\ IMAGE k (outside(path_image g)) = outside(path_image h)`, let lemma = prove (`!g h f f'. simple_path g /\ pathfinish g = pathstart g /\ simple_path h /\ pathfinish h = pathstart h /\ homeomorphism (path_image g,path_image h) (f,f') ==> ?k k'. homeomorphism ((:real^2),(:real^2)) (k,k') /\ (!x. x IN path_image g ==> k x = f x) /\ (!y. y IN path_image h ==> k' y = f' y) /\ IMAGE k (path_image g) = path_image h /\ IMAGE k (inside(path_image g)) = inside(path_image h) /\ IMAGE k (outside(path_image g)) = outside(path_image h)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^2`; `vec 0:real^2`; `&1`] HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE) THEN ASM_REWRITE_TAC[REAL_LT_01] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g1:real^2->real^2`; `g2:real^2->real^2`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(f:real^2->real^2) o (g1:real^2->real^2)`; `(g2:real^2->real^2) o (f':real^2->real^2)`; `path_image h:real^2->bool`] JORDAN_SCHOENFLIES_CIRCLE) THEN MP_TAC(ISPECL [`g1:real^2->real^2`; `g2:real^2->real^2`; `path_image g:real^2->bool`] JORDAN_SCHOENFLIES_CIRCLE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g1':real^2->real^2`; `g2':real^2->real^2`] THEN STRIP_TAC THEN ANTS_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM]] THEN MAP_EVERY X_GEN_TAC [`h1':real^2->real^2`; `h2':real^2->real^2`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(h1':real^2->real^2) o (g2':real^2->real^2)`; `(g1':real^2->real^2) o (h2':real^2->real^2)`] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; REWRITE_TAC[IMAGE_o; o_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_UNIV]) THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN ASM_SIMP_TAC[] THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `(f:real^2->real^2)(g1((g2:real^2->real^2) x))` THEN ASM SET_TAC[]; REPEAT CONJ_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN AP_TERM_TAC THEN REPEAT(FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. g(f x) = x) ==> IMAGE f t = s ==> IMAGE g s = t`)) THEN ASM_REWRITE_TAC[]]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^2`; `h:real^1->real^2`] HOMEOMORPHIC_SIMPLE_PATH_ARC_EQ) THEN ANTS_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN ASM_CASES_TAC `arc(h:real^1->real^2)` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THENL [ALL_TAC; MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ARC_SIMPLE_PATH]] THEN SUBGOAL_THEN `?g'. arc g' /\ pathstart g':real^2 = pathfinish g /\ pathfinish g' = pathstart g /\ simple_path(g ++ g')` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `g:real^1->real^2` PATH_CONNECTED_OPEN_ARC_COMPLEMENT) THEN REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN DISCH_THEN(MP_TAC o SPECL [`pathfinish g:real^2`; `pathstart g:real^2`]) THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_INSERT; path_component] THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `g':real^1->real^2` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g':real^1->real^2`; `pathfinish g:real^2`; `pathstart g:real^2`] PATH_CONTAINS_ARC) THEN ASM_SIMP_TAC[ARC_DISTINCT_ENDS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g'':real^1->real^2` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SIMPLE_PATH_JOIN_LOOP THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?h'. arc h' /\ pathstart h':real^2 = pathfinish h /\ pathfinish h' = pathstart h /\ simple_path(h ++ h')` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `h:real^1->real^2` PATH_CONNECTED_OPEN_ARC_COMPLEMENT) THEN REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN DISCH_THEN(MP_TAC o SPECL [`pathfinish h:real^2`; `pathstart h:real^2`]) THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_INSERT; path_component] THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `h':real^1->real^2` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h':real^1->real^2`; `pathfinish h:real^2`; `pathstart h:real^2`] PATH_CONTAINS_ARC) THEN ASM_SIMP_TAC[ARC_DISTINCT_ENDS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h'':real^1->real^2` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SIMPLE_PATH_JOIN_LOOP THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?k k':real^2->real^2. homeomorphism (path_image(g ++ g'),path_image(h ++ h')) (k,k') /\ (!x. x IN path_image g ==> k x = f x) /\ (!y. y IN path_image h ==> k' y = f' y)` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN SUBGOAL_THEN `?q q':real^2->real^2. homeomorphism (path_image g',path_image h') (q,q') /\ q(pathstart g') = f(pathstart g') /\ q(pathfinish g') = f(pathfinish g') /\ q'(pathstart h') = f'(pathstart h') /\ q'(pathfinish h') = f'(pathfinish h')` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`g:real^1->real^2`; `h:real^1->real^2`; `f:real^2->real^2`; `f':real^2->real^2`] ARC_HOMEOMORPHISM_ENDS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [MP_TAC(ISPECL [`g':real^1->real^2`; `h':real^1->real^2`] HOMEOMORPHISM_ARC_IMAGES); MP_TAC(ISPECL [`reversepath g':real^1->real^2`; `h':real^1->real^2`] HOMEOMORPHISM_ARC_IMAGES)] THEN ASM_REWRITE_TAC[ARC_REVERSEPATH_EQ] THEN ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN REWRITE_TAC[PATH_IMAGE_REVERSEPATH] THEN MESON_TAC[]; MP_TAC(ISPECL [`f:real^2->real^2`; `f':real^2->real^2`; `q:real^2->real^2`; `q':real^2->real^2`; `path_image g:real^2->bool`; `path_image h:real^2->bool`; `path_image g':real^2->bool`; `path_image h':real^2->bool`] HOMOEOMORPHISM_PASTE) THEN ANTS_TAC THENL [ALL_TAC; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN ASM_SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_PATH_IMAGE; ARC_IMP_PATH] THEN REWRITE_TAC[SUBSET_UNION] THEN MAP_EVERY UNDISCH_TAC [`simple_path(h ++ h':real^1->real^2)`; `simple_path(g ++ g':real^1->real^2)`] THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ_ALT] THEN ASM SET_TAC[]]; MP_TAC(ISPECL [`g ++ g':real^1->real^2`; `h ++ h':real^1->real^2`; `k:real^2->real^2`; `k':real^2->real^2`] lemma) THEN ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^2->real^2` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q':real^2->real^2` THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; IN_UNION] THEN STRIP_TAC THEN ASM_SIMP_TAC[INSIDE_ARC_EMPTY; OUTSIDE_INSIDE; UNION_EMPTY] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM; IN_UNIV]) THEN CONJ_TAC THEN ASM SET_TAC[]]);; let JORDAN_SCHOENFLIES_S2 = prove (`!g h f f' z:real^3 r. simple_path g /\ simple_path h /\ path_image g SUBSET sphere(z,r) /\ path_image h SUBSET sphere(z,r) /\ homeomorphism (path_image g,path_image h) (f,f') ==> ?k k'. homeomorphism (sphere(z,r),sphere(z,r)) (k,k') /\ (!x. x IN path_image g ==> k x = f x) /\ (!y. y IN path_image h ==> k' y = f' y)`, let lemma = prove (`!g:real^1->real^3 z r. simple_path g /\ path_image g SUBSET sphere(z,r) ==> &0 < r /\ path_image g PSUBSET sphere(z,r)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ASM_SIMP_TAC[GSYM INFINITE; INFINITE_SIMPLE_PATH_IMAGE] THEN REWRITE_TAC[INFINITE; FINITE_SPHERE; DIMINDEX_3; ARITH_EQ; REAL_NOT_LE]; DISCH_TAC] THEN ASM_REWRITE_TAC[PSUBSET] THEN ASM_CASES_TAC `pathstart g:real^3 = pathfinish g` THENL [DISCH_THEN(MP_TAC o AP_TERM `\s:real^3->bool. s homeomorphic sphere(vec 0:real^2,&1)`) THEN ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01] THEN SIMP_TAC[HOMEOMORPHIC_SPHERES_EQ; DIMINDEX_2; DIMINDEX_3; ARITH_EQ] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(MP_TAC o AP_TERM `\s:real^3->bool. s homeomorphic segment[vec 0:real^1,vec 1]`) THEN ASM_SIMP_TAC[ARC_SIMPLE_PATH; VEC_EQ; ARITH_EQ; HOMEOMORPHIC_ARC_IMAGE_SEGMENT] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_CONTRACTIBLE_EQ) THEN SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_SEGMENT; CONTRACTIBLE_SPHERE] THEN ASM_REAL_ARITH_TAC]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`h:real^1->real^3`; `z:real^3`; `r:real`] lemma) THEN MP_TAC(ISPECL [`g:real^1->real^3`; `z:real^3`; `r:real`] lemma) THEN ASM_CASES_TAC `&0 < r` THEN ASM_REWRITE_TAC[PSUBSET_ALT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^3` THEN STRIP_TAC THEN X_GEN_TAC `b:real^3` THEN STRIP_TAC THEN SUBGOAL_THEN `(sphere(z:real^3,r) DELETE a) homeomorphic (:real^2) /\ (sphere(z:real^3,r) DELETE b) homeomorphic (:real^2)` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH]; REWRITE_TAC[IMP_CONJ; homeomorphic; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`f1:real^3->real^2`; `g1:real^2->real^3`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`f2:real^3->real^2`; `g2:real^2->real^3`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(f1:real^3->real^2) o (g:real^1->real^3)`; `(f2:real^3->real^2) o (h:real^1->real^3)`; `(f2:real^3->real^2) o (f:real^3->real^3) o (g1:real^2->real^3)`; `(f1:real^3->real^2) o (f':real^3->real^3) o (g2:real^2->real^3)`] JORDAN_SCHOENFLIES) THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC SIMPLE_PATH_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_UNIV]) THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN ASM SET_TAC[]]); REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [o_ASSOC] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `path_image h:real^3->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `path_image g:real^3->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN ASM SET_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`k:real^2->real^2`; `k':real^2->real^2`] THEN REWRITE_TAC[PATH_IMAGE_COMPOSE; GSYM IMAGE_o] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(g2:real^2->real^3) o (k:real^2->real^2) o (f1:real^3->real^2)`; `(g1:real^2->real^3) o (k':real^2->real^2) o (f2:real^3->real^2)`; `sphere(z:real^3,r)`; `sphere(z:real^3,r)`; `a:real^3`; `b:real^3`] HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS) THEN ASM_REWRITE_TAC[COMPACT_SPHERE] THEN ANTS_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [o_ASSOC] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `(:real^2)` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHISM_SYM]] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `(:real^2)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:real^3->real^3` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j':real^3->real^3` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^3` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; o_THM]) THEN ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC(MESON[] `g1(f1 x) = x /\ g2(f2(f x)) = f x ==> g2(f2(f(g1(f1 x)))) = f x`) THEN CONJ_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_UNIV; o_THM]) THEN REWRITE_TAC[o_THM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; hol-light/Multivariate/clifford.ml000066400000000000000000001276621303454263000175530ustar00rootroot00000000000000(* ========================================================================= *) (* Geometric algebra. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* ========================================================================= *) needs "Multivariate/vectors.ml";; needs "Library/binary.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Some basic lemmas, mostly set theory. *) (* ------------------------------------------------------------------------- *) let CARD_UNION_LEMMA = prove (`FINITE s /\ FINITE t /\ FINITE u /\ FINITE v /\ s INTER t = {} /\ u INTER v = {} /\ s UNION t = u UNION v ==> CARD(s) + CARD(t) = CARD(u) + CARD(v)`, MESON_TAC[CARD_UNION]);; let CARD_DIFF_INTER = prove (`!s t. FINITE s ==> CARD s = CARD(s DIFF t) + CARD(s INTER t)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let CARD_ADD_SYMDIFF_INTER = prove (`!s t:A->bool. FINITE s /\ FINITE t ==> CARD s + CARD t = CARD((s DIFF t) UNION (t DIFF s)) + 2 * CARD(s INTER t)`, REPEAT STRIP_TAC THEN SUBST1_TAC(SPEC `t:A->bool`(MATCH_MP CARD_DIFF_INTER (ASSUME `FINITE(s:A->bool)`))) THEN SUBST1_TAC(SPEC `s:A->bool`(MATCH_MP CARD_DIFF_INTER (ASSUME `FINITE(t:A->bool)`))) THEN REWRITE_TAC[INTER_ACI] THEN MATCH_MP_TAC(ARITH_RULE `c = a + b ==> (a + x) + (b + x) = c + 2 * x`) THEN MATCH_MP_TAC CARD_UNION THEN ASM_SIMP_TAC[FINITE_DIFF] THEN SET_TAC[]);; let SYMDIFF_PARITY_LEMMA = prove (`!s t u. FINITE s /\ FINITE t /\ (s DIFF t) UNION (t DIFF s) = u ==> EVEN(CARD u) = (EVEN(CARD s) <=> EVEN(CARD t))`, ONCE_REWRITE_TAC[GSYM EVEN_ADD] THEN SIMP_TAC[CARD_ADD_SYMDIFF_INTER] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH]);; let FINITE_CART_SUBSET_LEMMA = prove (`!P m n. FINITE {i,j | i IN 1..m /\ j IN 1..n /\ P i j}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{i,j | i IN 1..m /\ j IN 1..n}` THEN SIMP_TAC[SUBSET; FINITE_PRODUCT; FINITE_NUMSEG] THEN SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM]);; (* ------------------------------------------------------------------------- *) (* Index type for "multivectors" (k-vectors for all k <= N). *) (* ------------------------------------------------------------------------- *) let multivector_tybij_th = prove (`?s. s SUBSET (1..dimindex(:N))`, MESON_TAC[EMPTY_SUBSET]);; let multivector_tybij = new_type_definition "multivector" ("mk_multivector","dest_multivector") multivector_tybij_th;; let MULTIVECTOR_IMAGE = prove (`(:(N)multivector) = IMAGE mk_multivector {s | s SUBSET 1..dimindex(:N)}`, REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[multivector_tybij]);; let HAS_SIZE_MULTIVECTOR = prove (`(:(N)multivector) HAS_SIZE (2 EXP dimindex(:N))`, REWRITE_TAC[MULTIVECTOR_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN SIMP_TAC[HAS_SIZE_POWERSET; HAS_SIZE_NUMSEG_1; IN_ELIM_THM] THEN MESON_TAC[multivector_tybij]);; let FINITE_MULTIVECTOR = prove (`FINITE(:(N)multivector)`, MESON_TAC[HAS_SIZE; HAS_SIZE_MULTIVECTOR]);; let DIMINDEX_MULTIVECTOR = prove (`dimindex(:(N)multivector) = 2 EXP dimindex(:N)`, MESON_TAC[DIMINDEX_UNIQUE; HAS_SIZE_MULTIVECTOR]);; let DEST_MK_MULTIVECTOR = prove (`!s. s SUBSET 1..dimindex(:N) ==> dest_multivector(mk_multivector s :(N)multivector) = s`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM multivector_tybij] THEN ASM_REWRITE_TAC[]);; let FORALL_MULTIVECTOR = prove (`(!s. s SUBSET 1..dimindex(:N) ==> P(mk_multivector s)) <=> (!m:(N)multivector. P m)`, EQ_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN DISCH_TAC THEN GEN_TAC THEN MP_TAC(ISPEC `m:(N)multivector` (REWRITE_RULE[EXTENSION] MULTIVECTOR_IMAGE)) THEN REWRITE_TAC[IN_UNIV; IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* The bijections we use for indexing. *) (* *) (* Note that we need a *single* bijection over the entire space that also *) (* works for the various subsets. Hence the tedious explicit construction. *) (* ------------------------------------------------------------------------- *) let setcode = new_definition `setcode s = 1 + binarysum (IMAGE PRE s)`;; let codeset = new_definition `codeset n = IMAGE SUC (bitset(n - 1))`;; let CODESET_SETCODE_BIJECTIONS = prove (`(!i. i IN 1..(2 EXP n) ==> codeset i SUBSET 1..n /\ setcode(codeset i) = i) /\ (!s. s SUBSET (1..n) ==> (setcode s) IN 1..(2 EXP n) /\ codeset(setcode s) = s)`, REWRITE_TAC[codeset; setcode; ADD_SUB2; GSYM IMAGE_o; o_DEF; PRE] THEN REWRITE_TAC[SET_RULE `IMAGE (\x. x) s = s`] THEN CONJ_TAC THEN GEN_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN SIMP_TAC[ARITH_RULE `1 <= i ==> (1 + b = i <=> b = i - 1)`] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n /\ SUC n <= k <=> n < k`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `1 <= i /\ i <= t ==> i - 1 < t`)) THEN MESON_TAC[BITSET_BOUND; BINARYSUM_BITSET]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `PRE` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[IN_NUMSEG; SUBSET] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `x < n ==> 1 <= 1 + x /\ 1 + x <= n`) THEN MATCH_MP_TAC BINARYSUM_BOUND THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `IMAGE SUC (IMAGE PRE s)` THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMAGE; FINITE_SUBSET; FINITE_NUMSEG; BITSET_BINARYSUM]; ALL_TAC] THEN UNDISCH_TAC `s SUBSET 1..n` THEN REWRITE_TAC[SUBSET; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN MESON_TAC[ARITH_RULE `1 <= n ==> SUC(PRE n) = n`]);; let FORALL_SETCODE = prove (`(!s. s SUBSET (1..n) ==> P(setcode s)) <=> (!i. i IN 1..(2 EXP n) ==> P i)`, MESON_TAC[CODESET_SETCODE_BIJECTIONS; SUBSET]);; let SETCODE_BOUNDS = prove (`!s n. s SUBSET 1..n ==> setcode s IN (1..(2 EXP n))`, MESON_TAC[CODESET_SETCODE_BIJECTIONS]);; (* ------------------------------------------------------------------------- *) (* Indexing directly via subsets. *) (* ------------------------------------------------------------------------- *) parse_as_infix("$$",(25,"left"));; let sindex = new_definition `(x:real^(N)multivector)$$s = x$(setcode s)`;; parse_as_binder "lambdas";; let lambdas = new_definition `(lambdas) (g:(num->bool)->real) = (lambda i. g(codeset i)):real^(N)multivector`;; (* ------------------------------------------------------------------------- *) (* Crucial properties. *) (* ------------------------------------------------------------------------- *) let MULTIVECTOR_EQ = prove (`!x y:real^(N)multivector. x = y <=> !s. s SUBSET 1..dimindex(:N) ==> x$$s = y$$s`, SIMP_TAC[CART_EQ; sindex; FORALL_SETCODE; GSYM IN_NUMSEG; DIMINDEX_MULTIVECTOR]);; let MULTIVECTOR_BETA = prove (`!s. s SUBSET 1..dimindex(:N) ==> ((lambdas) g :real^(N)multivector)$$s = g s`, SIMP_TAC[sindex; lambdas; LAMBDA_BETA; SETCODE_BOUNDS; DIMINDEX_MULTIVECTOR; GSYM IN_NUMSEG] THEN MESON_TAC[CODESET_SETCODE_BIJECTIONS]);; let MULTIVECTOR_UNIQUE = prove (`!m:real^(N)multivector g. (!s. s SUBSET 1..dimindex(:N) ==> m$$s = g s) ==> (lambdas) g = m`, SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_BETA] THEN MESON_TAC[]);; let MULTIVECTOR_ETA = prove (`(lambdas s. m$$s) = m`, SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_BETA]);; (* ------------------------------------------------------------------------- *) (* Also componentwise operations; they all work in this style. *) (* ------------------------------------------------------------------------- *) let MULTIVECTOR_ADD_COMPONENT = prove (`!x y:real^(N)multivector s. s SUBSET (1..dimindex(:N)) ==> (x + y)$$s = x$$s + y$$s`, SIMP_TAC[sindex; SETCODE_BOUNDS; DIMINDEX_MULTIVECTOR; GSYM IN_NUMSEG; VECTOR_ADD_COMPONENT]);; let MULTIVECTOR_MUL_COMPONENT = prove (`!c x:real^(N)multivector s. s SUBSET (1..dimindex(:N)) ==> (c % x)$$s = c * x$$s`, SIMP_TAC[sindex; SETCODE_BOUNDS; DIMINDEX_MULTIVECTOR; GSYM IN_NUMSEG; VECTOR_MUL_COMPONENT]);; let MULTIVECTOR_VEC_COMPONENT = prove (`!k s. s SUBSET (1..dimindex(:N)) ==> (vec k :real^(N)multivector)$$s = &k`, SIMP_TAC[sindex; SETCODE_BOUNDS; DIMINDEX_MULTIVECTOR; GSYM IN_NUMSEG; VEC_COMPONENT]);; let MULTIVECTOR_VSUM_COMPONENT = prove (`!f:A->real^(N)multivector t s. s SUBSET (1..dimindex(:N)) ==> (vsum t f)$$s = sum t (\x. (f x)$$s)`, SIMP_TAC[vsum; sindex; LAMBDA_BETA; SETCODE_BOUNDS; GSYM IN_NUMSEG; DIMINDEX_MULTIVECTOR]);; let MULTIVECTOR_VSUM = prove (`!t f. vsum t f = lambdas s. sum t (\x. (f x)$$s)`, SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_BETA; MULTIVECTOR_VSUM_COMPONENT]);; (* ------------------------------------------------------------------------- *) (* Basis vectors indexed by subsets of 1..N. *) (* ------------------------------------------------------------------------- *) let mbasis = new_definition `mbasis i = lambdas s. if i = s then &1 else &0`;; let MBASIS_COMPONENT = prove (`!s t. s SUBSET (1..dimindex(:N)) ==> (mbasis t :real^(N)multivector)$$s = if s = t then &1 else &0`, SIMP_TAC[mbasis; IN_ELIM_THM; MULTIVECTOR_BETA] THEN MESON_TAC[]);; let MBASIS_EQ_0 = prove (`!s. (mbasis s :real^(N)multivector = vec 0) <=> ~(s SUBSET 1..dimindex(:N))`, SIMP_TAC[MULTIVECTOR_EQ; MBASIS_COMPONENT; MULTIVECTOR_VEC_COMPONENT] THEN MESON_TAC[REAL_ARITH `~(&1 = &0)`]);; let MBASIS_NONZERO = prove (`!s. s SUBSET 1..dimindex(:N) ==> ~(mbasis s :real^(N)multivector = vec 0)`, REWRITE_TAC[MBASIS_EQ_0]);; let MBASIS_EXPANSION = prove (`!x:real^(N)multivector. vsum {s | s SUBSET 1..dimindex(:N)} (\s. x$$s % mbasis s) = x`, SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_VSUM_COMPONENT; MULTIVECTOR_MUL_COMPONENT; MBASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `x * (if p then &1 else &0) = if p then x else &0`; SUM_DELTA; IN_ELIM_THM]);; let SPAN_MBASIS = prove (`span {mbasis s :real^(N)multivector | s SUBSET 1..dimindex(:N)} = UNIV`, REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^(N)multivector` THEN GEN_REWRITE_TAC LAND_CONV [GSYM MBASIS_EXPANSION] THEN MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_NUMSEG; FINITE_POWERSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Linear and bilinear functions are determined by their effect on basis. *) (* ------------------------------------------------------------------------- *) let LINEAR_EQ_MBASIS = prove (`!f:real^(M)multivector->real^N g b s. linear f /\ linear g /\ (!s. s SUBSET 1..dimindex(:M) ==> f(mbasis s) = g(mbasis s)) ==> f = g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. x IN UNIV ==> (f:real^(M)multivector->real^N) x = g x` (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN MATCH_MP_TAC LINEAR_EQ THEN EXISTS_TAC `{mbasis s :real^(M)multivector | s SUBSET 1..dimindex(:M)}` THEN ASM_REWRITE_TAC[SPAN_MBASIS; SUBSET_REFL; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let BILINEAR_EQ_MBASIS = prove (`!f:real^(M)multivector->real^(N)multivector->real^P g b s. bilinear f /\ bilinear g /\ (!s t. s SUBSET 1..dimindex(:M) /\ t SUBSET 1..dimindex(:N) ==> f (mbasis s) (mbasis t) = g (mbasis s) (mbasis t)) ==> f = g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x y. x IN UNIV /\ y IN UNIV ==> (f:real^(M)multivector->real^(N)multivector->real^P) x y = g x y` (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN MATCH_MP_TAC BILINEAR_EQ THEN EXISTS_TAC `{mbasis s :real^(M)multivector | s SUBSET 1..dimindex(:M)}` THEN EXISTS_TAC `{mbasis t :real^(N)multivector | t SUBSET 1..dimindex(:N)}` THEN ASM_REWRITE_TAC[SPAN_MBASIS; SUBSET_REFL; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A way of proving linear properties by extension from basis. *) (* ------------------------------------------------------------------------- *) let LINEAR_PROPERTY = prove (`!P. P(vec 0) /\ (!x y. P x /\ P y ==> P(x + y)) ==> !f s. FINITE s /\ (!i. i IN s ==> P(f i)) ==> P(vsum s f)`, GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[VSUM_CLAUSES; IN_INSERT]);; let MBASIS_EXTENSION = prove (`!P. (!s. s SUBSET 1..dimindex(:N) ==> P(mbasis s)) /\ (!c x. P x ==> P(c % x)) /\ (!x y. P x /\ P y ==> P(x + y)) ==> !x:real^(N)multivector. P x`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM MBASIS_EXPANSION] THEN MATCH_MP_TAC(SIMP_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] LINEAR_PROPERTY) THEN ASM_SIMP_TAC[FINITE_POWERSET; FINITE_NUMSEG; IN_ELIM_THM] THEN ASM_MESON_TAC[EMPTY_SUBSET; VECTOR_MUL_LZERO]);; (* ------------------------------------------------------------------------- *) (* Injection from regular vectors. *) (* ------------------------------------------------------------------------- *) let multivec = new_definition `(multivec:real^N->real^(N)multivector) x = vsum(1..dimindex(:N)) (\i. x$i % mbasis{i})`;; (* ------------------------------------------------------------------------- *) (* Subspace of k-vectors. *) (* ------------------------------------------------------------------------- *) parse_as_infix("multivector",(12,"right"));; let multivector = new_definition `k multivector (p:real^(N)multivector) <=> !s. s SUBSET (1..dimindex(:N)) /\ ~(p$$s = &0) ==> s HAS_SIZE k`;; (* ------------------------------------------------------------------------- *) (* k-grade part of a multivector. *) (* ------------------------------------------------------------------------- *) parse_as_infix("grade",(22,"right"));; let grade = new_definition `k grade (p:real^(N)multivector) = (lambdas s. if s HAS_SIZE k then p$$s else &0):real^(N)multivector`;; let MULTIVECTOR_GRADE = prove (`!k x. k multivector (k grade x)`, SIMP_TAC[multivector; grade; MULTIVECTOR_BETA; IMP_CONJ] THEN MESON_TAC[]);; let GRADE_ADD = prove (`!x y k. k grade (x + y) = (k grade x) + (k grade y)`, SIMP_TAC[grade; MULTIVECTOR_EQ; MULTIVECTOR_ADD_COMPONENT; MULTIVECTOR_BETA; COND_COMPONENT] THEN REAL_ARITH_TAC);; let GRADE_CMUL = prove (`!c x k. k grade (c % x) = c % (k grade x)`, SIMP_TAC[grade; MULTIVECTOR_EQ; MULTIVECTOR_MUL_COMPONENT; MULTIVECTOR_BETA; COND_COMPONENT] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* General product construct. *) (* ------------------------------------------------------------------------- *) let Product_DEF = new_definition `(Product mult op :real^(N)multivector->real^(N)multivector->real^(N)multivector) x y = vsum {s | s SUBSET 1..dimindex(:N)} (\s. vsum {s | s SUBSET 1..dimindex(:N)} (\t. (x$$s * y$$t * mult s t) % mbasis (op s t)))`;; (* ------------------------------------------------------------------------- *) (* This is always bilinear. *) (* ------------------------------------------------------------------------- *) let BILINEAR_PRODUCT = prove (`!mult op. bilinear(Product mult op)`, REWRITE_TAC[bilinear; linear; Product_DEF] THEN SIMP_TAC[GSYM VSUM_LMUL; MULTIVECTOR_MUL_COMPONENT] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_AC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[Product_DEF] THEN SIMP_TAC[GSYM VSUM_ADD; FINITE_POWERSET; FINITE_NUMSEG] THEN REPEAT(MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC) THEN ASM_SIMP_TAC[MULTIVECTOR_ADD_COMPONENT] THEN VECTOR_ARITH_TAC);; let PRODUCT_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_PRODUCT;; let PRODUCT_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_PRODUCT;; let PRODUCT_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_PRODUCT;; let PRODUCT_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_PRODUCT;; let PRODUCT_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_PRODUCT;; let PRODUCT_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_PRODUCT;; let PRODUCT_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_PRODUCT;; let PRODUCT_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_PRODUCT;; (* ------------------------------------------------------------------------- *) (* Under suitable conditions, it's also associative. *) (* ------------------------------------------------------------------------- *) let PRODUCT_ASSOCIATIVE = prove (`!op mult. (!s t. s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) ==> (op s t) SUBSET 1..dimindex(:N)) /\ (!s t u. op s (op t u) = op (op s t) u) /\ (!s t u. mult t u * mult s (op t u) = mult s t * mult (op s t) u) ==> !x y z:real^(N)multivector. Product mult op x (Product mult op y z) = Product mult op (Product mult op x y) z`, let SUM_SWAP_POWERSET = SIMP_RULE[FINITE_POWERSET; FINITE_NUMSEG] (repeat(SPEC `{s | s SUBSET 1..dimindex(:N)}`) (ISPEC `f:(num->bool)->(num->bool)->real` SUM_SWAP)) in let SWAP_TAC cnv n = GEN_REWRITE_TAC (cnv o funpow n BINDER_CONV) [SUM_SWAP_POWERSET] THEN REWRITE_TAC[] in let SWAPS_TAC cnv ns x = MAP_EVERY (SWAP_TAC cnv) ns THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC x THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC in REWRITE_TAC[Product_DEF] THEN REPEAT STRIP_TAC THEN SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_VSUM_COMPONENT; MBASIS_COMPONENT; MULTIVECTOR_MUL_COMPONENT] THEN SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL] THEN X_GEN_TAC `r:num->bool` THEN STRIP_TAC THEN SWAPS_TAC RAND_CONV [1;0] `s:num->bool` THEN SWAP_TAC LAND_CONV 0 THEN SWAPS_TAC RAND_CONV [1;0] `t:num->bool` THEN SWAP_TAC RAND_CONV 0 THEN SWAPS_TAC LAND_CONV [0] `u:num->bool` THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_ARITH `(if p then a else &0) * b = if p then a * b else &0`; REAL_ARITH `a * (if p then b else &0) = if p then a * b else &0`] THEN SIMP_TAC[SUM_DELTA] THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* Geometric product. *) (* ------------------------------------------------------------------------- *) overload_interface ("*", `geom_mul:real^(N)multivector->real^(N)multivector->real^(N)multivector`);; let geom_mul = new_definition `(x:real^(N)multivector) * y = Product (\s t. --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) /\ i IN s /\ j IN t /\ i > j}) (\s t. (s DIFF t) UNION (t DIFF s)) x y`;; let BILINEAR_GEOM = prove (`bilinear(geom_mul)`, REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] geom_mul] THEN MATCH_ACCEPT_TAC BILINEAR_PRODUCT);; let GEOM_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_GEOM;; let GEOM_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_GEOM;; let GEOM_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_GEOM;; let GEOM_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_GEOM;; let GEOM_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_GEOM;; let GEOM_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_GEOM;; let GEOM_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_GEOM;; let GEOM_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_GEOM;; let GEOM_ASSOC = prove (`!x y z:real^(N)multivector. x * (y * z) = (x * y) * z`, REWRITE_TAC[geom_mul] THEN MATCH_MP_TAC PRODUCT_ASSOCIATIVE THEN REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EVEN_ADD] THEN W(fun (_,w) -> let tu = funpow 2 lhand w in let su = vsubst[`s:num->bool`,`t:num->bool`] tu in let st = vsubst[`t:num->bool`,`u:num->bool`] su in MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC(end_itlist (curry mk_eq) [st; su; tu])) THEN CONJ_TAC THENL [MATCH_MP_TAC(TAUT `(x <=> y <=> z) ==> ((a <=> x) <=> (y <=> z <=> a))`); AP_TERM_TAC THEN CONV_TAC SYM_CONV] THEN MATCH_MP_TAC SYMDIFF_PARITY_LEMMA THEN REWRITE_TAC[FINITE_CART_SUBSET_LEMMA] THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_UNION; IN_DIFF] THEN CONV_TAC TAUT);; (* ------------------------------------------------------------------------- *) (* Outer product. *) (* ------------------------------------------------------------------------- *) parse_as_infix("outer",(20,"right"));; let outer = new_definition `!x y:real^(N)multivector. x outer y = Product (\s t. if ~(s INTER t = {}) then &0 else --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) /\ i IN s /\ j IN t /\ i > j}) (\s t. (s DIFF t) UNION (t DIFF s)) x y`;; let OUTER = prove (`!x y:real^(N)multivector. x outer y = Product (\s t. if ~(s INTER t = {}) then &0 else --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) /\ i IN s /\ j IN t /\ i > j}) (UNION) x y`, REPEAT GEN_TAC THEN REWRITE_TAC[outer; Product_DEF] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN ASM_CASES_TAC `s INTER t :num->bool = {}` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[SET_RULE `(s INTER t = {}) ==> (s DIFF t) UNION (t DIFF s) = s UNION t`]);; let BILINEAR_OUTER = prove (`bilinear(outer)`, REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] outer] THEN MATCH_ACCEPT_TAC BILINEAR_PRODUCT);; let OUTER_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_OUTER;; let OUTER_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_OUTER;; let OUTER_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_OUTER;; let OUTER_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_OUTER;; let OUTER_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_OUTER;; let OUTER_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_OUTER;; let OUTER_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_OUTER;; let OUTER_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_OUTER;; let OUTER_ASSOC = prove (`!x y z:real^(N)multivector. x outer (y outer z) = (x outer y) outer z`, REWRITE_TAC[OUTER] THEN MATCH_MP_TAC PRODUCT_ASSOCIATIVE THEN SIMP_TAC[UNION_SUBSET; UNION_ASSOC; SET_RULE `s INTER (t UNION u) = (s INTER t) UNION (s INTER u)`; SET_RULE `(t UNION u) INTER s = (t INTER s) UNION (u INTER s)`] THEN REWRITE_TAC[EMPTY_UNION] THEN REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s INTER t :num->bool = {}`; `s INTER u :num->bool = {}`; `t INTER u :num->bool = {}`] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN AP_TERM_TAC THEN MATCH_MP_TAC CARD_UNION_LEMMA THEN REWRITE_TAC[FINITE_CART_SUBSET_LEMMA] THEN SIMP_TAC[EXTENSION; FORALL_PAIR_THM; NOT_IN_EMPTY; IN_UNION; IN_INTER] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN ASM SET_TAC []);; (* ------------------------------------------------------------------------- *) (* Inner product. *) (* ------------------------------------------------------------------------- *) parse_as_infix("inner",(20,"right"));; let inner = new_definition `!x y:real^(N)multivector. x inner y = Product (\s t. if s = {} \/ t = {} \/ ~((s DIFF t) = {} /\ ~(t DIFF s = {})) then &0 else --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) /\ i IN s /\ j IN t /\ i > j}) (\s t. (s DIFF t) UNION (t DIFF s)) x y`;; let BILINEAR_INNER = prove (`bilinear(inner)`, REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] inner] THEN MATCH_ACCEPT_TAC BILINEAR_PRODUCT);; let INNER_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_INNER;; let INNER_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_INNER;; let INNER_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_INNER;; let INNER_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_INNER;; let INNER_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_INNER;; let INNER_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_INNER;; let INNER_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_INNER;; let INNER_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_INNER;; (* ------------------------------------------------------------------------- *) (* Actions of products on basis and singleton basis. *) (* ------------------------------------------------------------------------- *) let PRODUCT_MBASIS = prove (`!s t. Product mult op (mbasis s) (mbasis t) :real^(N)multivector = if s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) then mult s t % mbasis(op s t) else vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[Product_DEF] THEN SIMP_TAC[MULTIVECTOR_MUL_COMPONENT; MBASIS_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `(if p then &1 else &0) * (if q then &1 else &0) * x = if q then if p then x else &0 else &0`] THEN REPEAT (GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RAND] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RATOR] THEN SIMP_TAC[VECTOR_MUL_LZERO; COND_ID; VSUM_DELTA; IN_ELIM_THM; VSUM_0] THEN ASM_CASES_TAC `t SUBSET 1..dimindex(:N)` THEN ASM_REWRITE_TAC[]));; let PRODUCT_MBASIS_SING = prove (`!i j. Product mult op (mbasis{i}) (mbasis{j}) :real^(N)multivector = if i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) then mult {i} {j} % mbasis(op {i} {j}) else vec 0`, REWRITE_TAC[PRODUCT_MBASIS; SET_RULE `{x} SUBSET s <=> x IN s`]);; let GEOM_MBASIS = prove (`!s t. mbasis s * mbasis t :real^(N)multivector = if s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) then --(&1) pow CARD {i,j | i IN s /\ j IN t /\ i > j} % mbasis((s DIFF t) UNION (t DIFF s)) else vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[geom_mul; PRODUCT_MBASIS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM] THEN ASM_MESON_TAC[SUBSET]);; let GEOM_MBASIS_SING = prove (`!i j. mbasis{i} * mbasis{j} :real^(N)multivector = if i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) then if i = j then mbasis{} else if i < j then mbasis{i,j} else --(mbasis{i,j}) else vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[geom_mul; PRODUCT_MBASIS_SING] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THEN SUBGOAL_THEN `{i',j' | i' IN 1 .. dimindex (:N) /\ j' IN 1 .. dimindex (:N) /\ i' = i /\ j' = j /\ i' > j'} = if i > j then {(i,j)} else {}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_SING] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; PAIR_EQ] THEN ASM_MESON_TAC[LT_REFL]; ALL_TAC] THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[GT; LT_REFL] THENL [REWRITE_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID] THEN AP_TERM_TAC THEN SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SET_RULE `~(i = j) ==> ({i} DIFF {j}) UNION ({j} DIFF {i}) = {i,j}`] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(i:num = j) ==> (j < i <=> ~(i < j))`)) THEN ASM_CASES_TAC `i:num < j` THEN ASM_SIMP_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID; FINITE_RULES; NOT_IN_EMPTY] THEN VECTOR_ARITH_TAC);; let OUTER_MBASIS = prove (`!s t. (mbasis s) outer (mbasis t) :real^(N)multivector = if s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) /\ s INTER t = {} then --(&1) pow CARD {i,j | i IN s /\ j IN t /\ i > j} % mbasis(s UNION t) else vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[OUTER; PRODUCT_MBASIS] THEN ASM_CASES_TAC `(s:num->bool) INTER t = {}` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; COND_ID] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM] THEN ASM_MESON_TAC[SUBSET]);; let OUTER_MBASIS_SING = prove (`!i j. mbasis{i} outer mbasis{j} :real^(N)multivector = if i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) /\ ~(i = j) then if i < j then mbasis{i,j} else --(mbasis{i,j}) else vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[OUTER; PRODUCT_MBASIS_SING] THEN REWRITE_TAC[SET_RULE `{i} INTER {j} = {} <=> ~(i = j)`] THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; COND_ID] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THEN SUBGOAL_THEN `{i',j' | i' IN 1 .. dimindex (:N) /\ j' IN 1 .. dimindex (:N) /\ i' = i /\ j' = j /\ i' > j'} = if i > j then {(i,j)} else {}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_SING] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; PAIR_EQ] THEN ASM_MESON_TAC[LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[GT; SET_RULE `{i} UNION {j} = {i,j}`] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `~(i:num = j) ==> (j < i <=> ~(i < j))`)) THEN ASM_CASES_TAC `i:num < j` THEN ASM_SIMP_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID; FINITE_RULES; NOT_IN_EMPTY] THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some simple consequences. *) (* ------------------------------------------------------------------------- *) let OUTER_MBASIS_SKEWSYM = prove (`!i j. mbasis{i} outer mbasis{j} = --(mbasis{j} outer mbasis{i})`, REPEAT GEN_TAC THEN REWRITE_TAC[OUTER_MBASIS_SING] THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[VECTOR_NEG_0] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(i:num = j) ==> i < j /\ ~(j < i) \/ j < i /\ ~(i < j)`)) THEN ASM_REWRITE_TAC[CONJ_ACI] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_NEG; VECTOR_NEG_0] THEN REPEAT AP_TERM_TAC THEN SET_TAC[]);; let OUTER_MBASIS_REFL = prove (`!i. mbasis{i} outer mbasis{i} = vec 0`, GEN_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `!x:real^N. x = --x ==> x = vec 0`) THEN MATCH_ACCEPT_TAC OUTER_MBASIS_SKEWSYM);; let OUTER_MBASIS_LSCALAR = prove (`!x. mbasis{} outer x = x`, MATCH_MP_TAC MBASIS_EXTENSION THEN SIMP_TAC[OUTER_RMUL; OUTER_RADD] THEN SIMP_TAC[OUTER_MBASIS; EMPTY_SUBSET; INTER_EMPTY; UNION_EMPTY] THEN REWRITE_TAC[SET_RULE `{i,j | i IN {} /\ j IN s /\ i:num > j} = {}`] THEN REWRITE_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID]);; let OUTER_MBASIS_RSCALAR = prove (`!x. x outer mbasis{} = x`, MATCH_MP_TAC MBASIS_EXTENSION THEN SIMP_TAC[OUTER_LMUL; OUTER_LADD] THEN SIMP_TAC[OUTER_MBASIS; EMPTY_SUBSET; INTER_EMPTY; UNION_EMPTY] THEN REWRITE_TAC[SET_RULE `{i,j | i IN s /\ j IN {} /\ i:num > j} = {}`] THEN REWRITE_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID]);; let MBASIS_SPLIT = prove (`!a s. (!x. x IN s ==> a < x) ==> mbasis (a INSERT s) = mbasis{a} outer mbasis s`, REPEAT STRIP_TAC THEN REWRITE_TAC[OUTER_MBASIS] THEN SUBGOAL_THEN `{a:num} INTER s = {}` SUBST1_TAC THENL [ASM SET_TAC [LT_REFL]; ALL_TAC] THEN SIMP_TAC[SET_RULE`{a} SUBSET t /\ s SUBSET t <=> (a INSERT s) SUBSET t`] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[MBASIS_EQ_0]] THEN REWRITE_TAC[SET_RULE `{a} UNION s = a INSERT s`] THEN SUBGOAL_THEN `{(i:num),(j:num) | i IN {a} /\ j IN s /\ i > j} = {}` (fun th -> SIMP_TAC[th; CARD_CLAUSES; real_pow; VECTOR_MUL_LID]) THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_SING; NOT_IN_EMPTY] THEN ASM_MESON_TAC[ARITH_RULE `~(n < m /\ n:num > m)`]);; (* ------------------------------------------------------------------------- *) (* Just for generality, normalize a set enumeration. *) (* ------------------------------------------------------------------------- *) let SETENUM_NORM_CONV = let conv = GEN_REWRITE_CONV I [EXTENSION] THENC GEN_REWRITE_CONV TOP_SWEEP_CONV [IN_SING; IN_INSERT] THENC BINDER_CONV(EQT_INTRO o DISJ_ACI_RULE) THENC GEN_REWRITE_CONV I [FORALL_SIMP] in fun tm -> let nums = dest_setenum tm in let nums' = map mk_numeral (sort ( a < x) <=> T) /\ ((!x:num. x IN (y INSERT s) ==> a < x) <=> a < y /\ (!x. x IN s ==> a < x))` in let SET_CHECK_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV [setlemma] THENC NUM_REDUCE_CONV and INST_SPLIT = PART_MATCH (lhs o rand) MBASIS_SPLIT and INST_MERGE = PART_MATCH (lhs o rand) (GSYM MBASIS_SPLIT) in let rec conv tm = if length(dest_setenum(rand tm)) <= 1 then REFL tm else let th = MP_CONV SET_CHECK_CONV (INST_SPLIT tm) in let th' = RAND_CONV conv (rand(concl th)) in TRANS th th' in (fun tm -> try let op,se = dest_comb tm in if fst(dest_const op) = "mbasis" && forall is_numeral (dest_setenum se) then (RAND_CONV SETENUM_NORM_CONV THENC conv) tm else fail() with Failure _ -> failwith "MBASIS_SPLIT_CONV"), (fun tm -> try MP_CONV SET_CHECK_CONV (INST_MERGE tm) with Failure _ -> failwith "MBASIS_MERGE_CONV");; (* ------------------------------------------------------------------------- *) (* Convergent (if slow) rewrite set to bubble into position. *) (* ------------------------------------------------------------------------- *) let OUTER_ACI = prove (`(!x y z. (x outer y) outer z = x outer (y outer z)) /\ (!i j. i > j ==> mbasis{i} outer mbasis{j} = --(&1) % (mbasis{j} outer mbasis{i})) /\ (!i j x. i > j ==> mbasis{i} outer mbasis{j} outer x = --(&1) % (mbasis{j} outer mbasis{i} outer x)) /\ (!i. mbasis{i} outer mbasis{i} = vec 0) /\ (!i x. mbasis{i} outer mbasis{i} outer x = vec 0) /\ (!x. mbasis{} outer x = x) /\ (!x. x outer mbasis{} = x)`, REWRITE_TAC[OUTER_ASSOC; OUTER_LZERO; OUTER_RZERO; OUTER_LADD; OUTER_RADD; OUTER_LMUL; OUTER_RMUL; OUTER_LZERO; OUTER_RZERO] THEN REWRITE_TAC[OUTER_MBASIS_REFL; OUTER_LZERO] THEN REWRITE_TAC[OUTER_MBASIS_LSCALAR; OUTER_MBASIS_RSCALAR] THEN SIMP_TAC[GSYM VECTOR_NEG_MINUS1; VECTOR_ARITH `x - y:real^N = x + --y`] THEN MESON_TAC[OUTER_MBASIS_SKEWSYM; OUTER_LNEG]);; (* ------------------------------------------------------------------------- *) (* Group the final "c1 % mbasis s1 + ... + cn % mbasis sn". *) (* ------------------------------------------------------------------------- *) let MBASIS_GROUP_CONV tm = let tms = striplist(dest_binary "vector_add") tm in if length tms = 1 then LAND_CONV REAL_POLY_CONV tm else let vadd_tm = rator(rator tm) in let mk_vadd = mk_binop vadd_tm in let mbs = map (snd o dest_binary "%") tms in let tmbs = zip mbs tms and mset = setify mbs in let grps = map (fun x -> map snd (filter (fun (x',_) -> x' = x) tmbs)) mset in let tm' = end_itlist mk_vadd (map (end_itlist mk_vadd) grps) in let th1 = AC VECTOR_ADD_AC (mk_eq(tm,tm')) and th2 = (GEN_REWRITE_CONV DEPTH_CONV [GSYM VECTOR_ADD_RDISTRIB] THENC DEPTH_BINOP_CONV vadd_tm (LAND_CONV REAL_POLY_CONV)) tm' in TRANS th1 th2;; (* ------------------------------------------------------------------------- *) (* Overall conversion. *) (* ------------------------------------------------------------------------- *) let OUTER_CANON_CONV = ONCE_DEPTH_CONV MBASIS_SPLIT_CONV THENC GEN_REWRITE_CONV TOP_DEPTH_CONV [VECTOR_SUB; VECTOR_NEG_MINUS1; OUTER_LADD; OUTER_RADD; OUTER_LMUL; OUTER_RMUL; OUTER_LZERO; OUTER_RZERO; VECTOR_ADD_LDISTRIB; VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THENC REAL_RAT_REDUCE_CONV THENC PURE_SIMP_CONV[OUTER_ACI; ARITH_GT; ARITH_GE; OUTER_LMUL; OUTER_RMUL; OUTER_LZERO; OUTER_RZERO] THENC PURE_REWRITE_CONV[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_ADD_RID; VECTOR_MUL_ASSOC] THENC GEN_REWRITE_CONV I [GSYM VECTOR_MUL_LID] THENC PURE_REWRITE_CONV [VECTOR_ADD_LDISTRIB; VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC] THENC REAL_RAT_REDUCE_CONV THENC PURE_REWRITE_CONV[GSYM VECTOR_ADD_ASSOC] THENC DEPTH_CONV MBASIS_MERGE_CONV THENC MBASIS_GROUP_CONV THENC GEN_REWRITE_CONV DEPTH_CONV [GSYM VECTOR_ADD_RDISTRIB] THENC REAL_RAT_REDUCE_CONV;; (* ------------------------------------------------------------------------- *) (* Iterated operation in order. *) (* I guess this ought to be added to the core... *) (* ------------------------------------------------------------------------- *) let seqiterate_EXISTS = prove (`!op f. ?h. !s. h s = if INFINITE s \/ s = {} then neutral op else let i = minimal x. x IN s in if s = {i} then f(i) else op (f i) (h (s DELETE i))`, REPEAT GEN_TAC THEN REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(MATCH_MP WF_REC (ISPEC `CARD:(num->bool)->num` WF_MEASURE)) THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN LET_TAC THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[MEASURE] THEN RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN SUBGOAL_THEN `?i:num. i IN s` MP_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [MINIMAL] THEN ASM_SIMP_TAC[CARD_DELETE; CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`]);; let EXISTS_SWAP = prove (`!P. (?f. P f) <=> (?f:A->B->C. P (\b a. f a b))`, GEN_TAC THEN EQ_TAC THEN DISCH_THEN CHOOSE_TAC THENL [EXISTS_TAC `\a b. (f:B->A->C) b a` THEN ASM_REWRITE_TAC[ETA_AX]; ASM_MESON_TAC[]]);; let seqiterate = new_specification ["seqiterate"] (REWRITE_RULE[SKOLEM_THM] (ONCE_REWRITE_RULE[EXISTS_SWAP] (ONCE_REWRITE_RULE[SKOLEM_THM] seqiterate_EXISTS)));; let MINIMAL_IN_INSERT = prove (`!s i. (!j. j IN s ==> i < j) ==> (minimal j. j IN (i INSERT s)) = i`, REPEAT STRIP_TAC THEN REWRITE_TAC[minimal] THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[LT_ANTISYM]);; let SEQITERATE_CLAUSES = prove (`(!op f. seqiterate op {} f = neutral op) /\ (!op f i. seqiterate op {i} f = f(i)) /\ (!op f i s. FINITE s /\ ~(s = {}) /\ (!j. j IN s ==> i < j) ==> seqiterate op (i INSERT s) f = op (f i) (seqiterate op s f))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [seqiterate] THEN ASM_SIMP_TAC[NOT_INSERT_EMPTY; INFINITE; FINITE_INSERT; FINITE_RULES] THEN ASM_SIMP_TAC[MINIMAL_IN_INSERT; NOT_IN_EMPTY; LET_DEF; LET_END_DEF] THEN SUBGOAL_THEN `~((i:num) IN s)` ASSUME_TAC THENL [ASM_MESON_TAC[LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[DELETE_INSERT; SET_RULE `~(i IN s) /\ ~(s = {}) ==> (s DELETE i = s) /\ ~(i INSERT s = {i})`]);; (* ------------------------------------------------------------------------- *) (* In the "common" case this agrees with ordinary iteration. *) (* ------------------------------------------------------------------------- *) let SEQITERATE_ITERATE = prove (`!op f s. monoidal op /\ FINITE s ==> seqiterate op s f = iterate op s f`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_DELETE THEN ASM_SIMP_TAC[SEQITERATE_CLAUSES; ITERATE_CLAUSES] THEN GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `i IN s ==> s = i INSERT (s DELETE i)`)) THEN ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_DELETE; IN_DELETE] THEN ASM_CASES_TAC `s DELETE (i:num) = {}` THEN ASM_SIMP_TAC[SEQITERATE_CLAUSES; ITERATE_CLAUSES] THENL [ASM_MESON_TAC[monoidal]; FIRST_X_ASSUM(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC(last(CONJUNCTS SEQITERATE_CLAUSES)) THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN ASM_MESON_TAC[LT_ANTISYM; LT_CASES]);; (* ------------------------------------------------------------------------- *) (* Outermorphism extension. *) (* ------------------------------------------------------------------------- *) let outermorphism = new_definition `outermorphism(f:real^N->real^P) (x:real^(N)multivector) = vsum {s | s SUBSET 1..dimindex(:N)} (\s. x$$s % seqiterate(outer) s (multivec o f o basis))`;; let NEUTRAL_OUTER = prove (`neutral(outer) = mbasis{}`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[OUTER_MBASIS_LSCALAR; OUTER_MBASIS_RSCALAR]);; let OUTERMORPHISM_MBASIS = prove (`!f:real^M->real^N s t. s SUBSET 1..dimindex(:M) ==> outermorphism f (mbasis s) = seqiterate(outer) s (multivec o f o basis)`, REWRITE_TAC[outermorphism] THEN SIMP_TAC[MBASIS_COMPONENT] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN SIMP_TAC[VECTOR_MUL_LZERO; VSUM_DELTA; IN_ELIM_THM; VECTOR_MUL_LID]);; let OUTERMORPHISM_MBASIS_EMPTY = prove (`!f. outermorphism f (mbasis {}) = mbasis {}`, SIMP_TAC[OUTERMORPHISM_MBASIS; EMPTY_SUBSET; SEQITERATE_CLAUSES] THEN REWRITE_TAC[NEUTRAL_OUTER]);; (* ------------------------------------------------------------------------- *) (* Reversion operation. *) (* ------------------------------------------------------------------------- *) let reversion = new_definition `(reversion:real^(N)multivector->real^(N)multivector) x = lambdas s. --(&1) pow ((CARD(s) * (CARD(s) - 1)) DIV 2) * x$$s`;; hol-light/Multivariate/complex_database.ml000066400000000000000000025734151303454263000212610ustar00rootroot00000000000000needs "help.ml";; theorems := [ "ABEL_LEMMA",ABEL_LEMMA; "ABEL_LIMIT_THEOREM",ABEL_LIMIT_THEOREM; "ABEL_LIMIT_THEOREM_1",ABEL_LIMIT_THEOREM_1; "ABEL_POWER_SERIES_CONTINUOUS",ABEL_POWER_SERIES_CONTINUOUS; "ABEL_POWER_SERIES_CONTINUOUS_1",ABEL_POWER_SERIES_CONTINUOUS_1; "ABSOLUTELY_CONTINUOUS_COMPARISON",ABSOLUTELY_CONTINUOUS_COMPARISON; "ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV",ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV; "ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV_GEN",ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV_GEN; "ABSOLUTELY_CONTINUOUS_EXTENDS_TO_CLOSURE",ABSOLUTELY_CONTINUOUS_EXTENDS_TO_CLOSURE; "ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY",ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY; "ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ",ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ; "ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_LEFT",ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_LEFT; "ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT",ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT; "ABSOLUTELY_CONTINUOUS_INTEGRAL",ABSOLUTELY_CONTINUOUS_INTEGRAL; "ABSOLUTELY_CONTINUOUS_ISOMETRIC",ABSOLUTELY_CONTINUOUS_ISOMETRIC; "ABSOLUTELY_CONTINUOUS_ISOMETRIC_COMPOSE",ABSOLUTELY_CONTINUOUS_ISOMETRIC_COMPOSE; "ABSOLUTELY_CONTINUOUS_LIPSCHITZ_COMPOSE",ABSOLUTELY_CONTINUOUS_LIPSCHITZ_COMPOSE; "ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE",ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE; "ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_GEN",ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_GEN; "ABSOLUTELY_CONTINUOUS_MEASURE_IMAGE",ABSOLUTELY_CONTINUOUS_MEASURE_IMAGE; "ABSOLUTELY_CONTINUOUS_ON_ADD",ABSOLUTELY_CONTINUOUS_ON_ADD; "ABSOLUTELY_CONTINUOUS_ON_BILINEAR",ABSOLUTELY_CONTINUOUS_ON_BILINEAR; "ABSOLUTELY_CONTINUOUS_ON_CLOSURE",ABSOLUTELY_CONTINUOUS_ON_CLOSURE; "ABSOLUTELY_CONTINUOUS_ON_CLOSURE_EQ",ABSOLUTELY_CONTINUOUS_ON_CLOSURE_EQ; "ABSOLUTELY_CONTINUOUS_ON_CMUL",ABSOLUTELY_CONTINUOUS_ON_CMUL; "ABSOLUTELY_CONTINUOUS_ON_CMUL_EQ",ABSOLUTELY_CONTINUOUS_ON_CMUL_EQ; "ABSOLUTELY_CONTINUOUS_ON_COMBINE",ABSOLUTELY_CONTINUOUS_ON_COMBINE; "ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE",ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE; "ABSOLUTELY_CONTINUOUS_ON_COMPOSE",ABSOLUTELY_CONTINUOUS_ON_COMPOSE; "ABSOLUTELY_CONTINUOUS_ON_COMPOSE_LINEAR",ABSOLUTELY_CONTINUOUS_ON_COMPOSE_LINEAR; "ABSOLUTELY_CONTINUOUS_ON_CONST",ABSOLUTELY_CONTINUOUS_ON_CONST; "ABSOLUTELY_CONTINUOUS_ON_DIVISION",ABSOLUTELY_CONTINUOUS_ON_DIVISION; "ABSOLUTELY_CONTINUOUS_ON_EMPTY",ABSOLUTELY_CONTINUOUS_ON_EMPTY; "ABSOLUTELY_CONTINUOUS_ON_EQ",ABSOLUTELY_CONTINUOUS_ON_EQ; "ABSOLUTELY_CONTINUOUS_ON_ID",ABSOLUTELY_CONTINUOUS_ON_ID; "ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS",ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS; "ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON",ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON; "ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS",ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS; "ABSOLUTELY_CONTINUOUS_ON_INTERIOR",ABSOLUTELY_CONTINUOUS_ON_INTERIOR; "ABSOLUTELY_CONTINUOUS_ON_INTERIOR_EQ",ABSOLUTELY_CONTINUOUS_ON_INTERIOR_EQ; "ABSOLUTELY_CONTINUOUS_ON_LIFT_ABS",ABSOLUTELY_CONTINUOUS_ON_LIFT_ABS; "ABSOLUTELY_CONTINUOUS_ON_MAX",ABSOLUTELY_CONTINUOUS_ON_MAX; "ABSOLUTELY_CONTINUOUS_ON_MIN",ABSOLUTELY_CONTINUOUS_ON_MIN; "ABSOLUTELY_CONTINUOUS_ON_MUL",ABSOLUTELY_CONTINUOUS_ON_MUL; "ABSOLUTELY_CONTINUOUS_ON_NEG",ABSOLUTELY_CONTINUOUS_ON_NEG; "ABSOLUTELY_CONTINUOUS_ON_NORM",ABSOLUTELY_CONTINUOUS_ON_NORM; "ABSOLUTELY_CONTINUOUS_ON_NULL",ABSOLUTELY_CONTINUOUS_ON_NULL; "ABSOLUTELY_CONTINUOUS_ON_SING",ABSOLUTELY_CONTINUOUS_ON_SING; "ABSOLUTELY_CONTINUOUS_ON_SUB",ABSOLUTELY_CONTINUOUS_ON_SUB; "ABSOLUTELY_CONTINUOUS_ON_SUBSET",ABSOLUTELY_CONTINUOUS_ON_SUBSET; "ABSOLUTELY_CONTINUOUS_ON_TRANSLATION",ABSOLUTELY_CONTINUOUS_ON_TRANSLATION; "ABSOLUTELY_CONTINUOUS_ON_VMUL",ABSOLUTELY_CONTINUOUS_ON_VMUL; "ABSOLUTELY_CONTINUOUS_ON_VMUL_EQ",ABSOLUTELY_CONTINUOUS_ON_VMUL_EQ; "ABSOLUTELY_CONTINUOUS_ON_VSUM",ABSOLUTELY_CONTINUOUS_ON_VSUM; "ABSOLUTELY_CONTINUOUS_RECTIFIABLE_VALID_PATH",ABSOLUTELY_CONTINUOUS_RECTIFIABLE_VALID_PATH; "ABSOLUTELY_CONTINUOUS_VECTOR_VARIATION",ABSOLUTELY_CONTINUOUS_VECTOR_VARIATION; "ABSOLUTELY_INTEGRABLE_0",ABSOLUTELY_INTEGRABLE_0; "ABSOLUTELY_INTEGRABLE_ABS",ABSOLUTELY_INTEGRABLE_ABS; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND; "ABSOLUTELY_INTEGRABLE_ABS_1",ABSOLUTELY_INTEGRABLE_ABS_1; "ABSOLUTELY_INTEGRABLE_ABS_EQ",ABSOLUTELY_INTEGRABLE_ABS_EQ; "ABSOLUTELY_INTEGRABLE_ADD",ABSOLUTELY_INTEGRABLE_ADD; "ABSOLUTELY_INTEGRABLE_AFFINITY",ABSOLUTELY_INTEGRABLE_AFFINITY; "ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS; "ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT; "ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ; "ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ_ALT",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ_ALT; "ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; "ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ; "ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ; "ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE",ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE; "ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_EQ; "ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES",ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES; "ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_LINEAR",ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_LINEAR; "ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_POLAR",ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_POLAR; "ABSOLUTELY_INTEGRABLE_CMUL",ABSOLUTELY_INTEGRABLE_CMUL; "ABSOLUTELY_INTEGRABLE_CMUL_EQ",ABSOLUTELY_INTEGRABLE_CMUL_EQ; "ABSOLUTELY_INTEGRABLE_COMPONENTWISE",ABSOLUTELY_INTEGRABLE_COMPONENTWISE; "ABSOLUTELY_INTEGRABLE_CONST",ABSOLUTELY_INTEGRABLE_CONST; "ABSOLUTELY_INTEGRABLE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_CONTINUOUS; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_AE",ABSOLUTELY_INTEGRABLE_CONVOLUTION_AE; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF",ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_L2",ABSOLUTELY_INTEGRABLE_CONVOLUTION_L2; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_LINF_L1",ABSOLUTELY_INTEGRABLE_CONVOLUTION_LINF_L1; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_SYM",ABSOLUTELY_INTEGRABLE_CONVOLUTION_SYM; "ABSOLUTELY_INTEGRABLE_DIFF",ABSOLUTELY_INTEGRABLE_DIFF; "ABSOLUTELY_INTEGRABLE_EQ",ABSOLUTELY_INTEGRABLE_EQ; "ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS",ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS; "ABSOLUTELY_INTEGRABLE_IMPROPER",ABSOLUTELY_INTEGRABLE_IMPROPER; "ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE",ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; "ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE",ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE; "ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE",ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE; "ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE_ALT",ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE_ALT; "ABSOLUTELY_INTEGRABLE_INF_1",ABSOLUTELY_INTEGRABLE_INF_1; "ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND; "ABSOLUTELY_INTEGRABLE_INTER",ABSOLUTELY_INTEGRABLE_INTER; "ABSOLUTELY_INTEGRABLE_LE",ABSOLUTELY_INTEGRABLE_LE; "ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS",ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS; "ABSOLUTELY_INTEGRABLE_LINEAR",ABSOLUTELY_INTEGRABLE_LINEAR; "ABSOLUTELY_INTEGRABLE_MAX",ABSOLUTELY_INTEGRABLE_MAX; "ABSOLUTELY_INTEGRABLE_MAX_1",ABSOLUTELY_INTEGRABLE_MAX_1; "ABSOLUTELY_INTEGRABLE_MEASURABLE",ABSOLUTELY_INTEGRABLE_MEASURABLE; "ABSOLUTELY_INTEGRABLE_MIN",ABSOLUTELY_INTEGRABLE_MIN; "ABSOLUTELY_INTEGRABLE_MIN_1",ABSOLUTELY_INTEGRABLE_MIN_1; "ABSOLUTELY_INTEGRABLE_NEG",ABSOLUTELY_INTEGRABLE_NEG; "ABSOLUTELY_INTEGRABLE_NEG_EQ",ABSOLUTELY_INTEGRABLE_NEG_EQ; "ABSOLUTELY_INTEGRABLE_NORM",ABSOLUTELY_INTEGRABLE_NORM; "ABSOLUTELY_INTEGRABLE_ON_CONST",ABSOLUTELY_INTEGRABLE_ON_CONST; "ABSOLUTELY_INTEGRABLE_ON_EMPTY",ABSOLUTELY_INTEGRABLE_ON_EMPTY; "ABSOLUTELY_INTEGRABLE_ON_IMAGE",ABSOLUTELY_INTEGRABLE_ON_IMAGE; "ABSOLUTELY_INTEGRABLE_ON_INDICATOR",ABSOLUTELY_INTEGRABLE_ON_INDICATOR; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ_ALT",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ_ALT; "ABSOLUTELY_INTEGRABLE_ON_LINEAR_IMAGE",ABSOLUTELY_INTEGRABLE_ON_LINEAR_IMAGE; "ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC",ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC; "ABSOLUTELY_INTEGRABLE_ON_NEGLIGIBLE",ABSOLUTELY_INTEGRABLE_ON_NEGLIGIBLE; "ABSOLUTELY_INTEGRABLE_ON_NULL",ABSOLUTELY_INTEGRABLE_ON_NULL; "ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL",ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL; "ABSOLUTELY_INTEGRABLE_PASTECART_SYM",ABSOLUTELY_INTEGRABLE_PASTECART_SYM; "ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV",ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV; "ABSOLUTELY_INTEGRABLE_REFLECT",ABSOLUTELY_INTEGRABLE_REFLECT; "ABSOLUTELY_INTEGRABLE_REFLECT_GEN",ABSOLUTELY_INTEGRABLE_REFLECT_GEN; "ABSOLUTELY_INTEGRABLE_RESTRICT_INTER",ABSOLUTELY_INTEGRABLE_RESTRICT_INTER; "ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV",ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; "ABSOLUTELY_INTEGRABLE_SET_VARIATION",ABSOLUTELY_INTEGRABLE_SET_VARIATION; "ABSOLUTELY_INTEGRABLE_SPIKE",ABSOLUTELY_INTEGRABLE_SPIKE; "ABSOLUTELY_INTEGRABLE_SPIKE_EQ",ABSOLUTELY_INTEGRABLE_SPIKE_EQ; "ABSOLUTELY_INTEGRABLE_SPIKE_SET",ABSOLUTELY_INTEGRABLE_SPIKE_SET; "ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ",ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ; "ABSOLUTELY_INTEGRABLE_SQUARE_INTEGRABLE_PRODUCT",ABSOLUTELY_INTEGRABLE_SQUARE_INTEGRABLE_PRODUCT; "ABSOLUTELY_INTEGRABLE_SUB",ABSOLUTELY_INTEGRABLE_SUB; "ABSOLUTELY_INTEGRABLE_SUP_1",ABSOLUTELY_INTEGRABLE_SUP_1; "ABSOLUTELY_INTEGRABLE_TRANSLATION",ABSOLUTELY_INTEGRABLE_TRANSLATION; "ABSOLUTELY_INTEGRABLE_TWIZZLE_EQ",ABSOLUTELY_INTEGRABLE_TWIZZLE_EQ; "ABSOLUTELY_INTEGRABLE_UNION",ABSOLUTELY_INTEGRABLE_UNION; "ABSOLUTELY_INTEGRABLE_VSUM",ABSOLUTELY_INTEGRABLE_VSUM; "ABSOLUTELY_REAL_INTEGRABLE_0",ABSOLUTELY_REAL_INTEGRABLE_0; "ABSOLUTELY_REAL_INTEGRABLE_ABS",ABSOLUTELY_REAL_INTEGRABLE_ABS; "ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_BOUND",ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_BOUND; "ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND",ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND; "ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_UBOUND",ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_UBOUND; "ABSOLUTELY_REAL_INTEGRABLE_ADD",ABSOLUTELY_REAL_INTEGRABLE_ADD; "ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT",ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT; "ABSOLUTELY_REAL_INTEGRABLE_CONST",ABSOLUTELY_REAL_INTEGRABLE_CONST; "ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS",ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS; "ABSOLUTELY_REAL_INTEGRABLE_DECREASING",ABSOLUTELY_REAL_INTEGRABLE_DECREASING; "ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT",ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT; "ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE",ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; "ABSOLUTELY_REAL_INTEGRABLE_INCREASING",ABSOLUTELY_REAL_INTEGRABLE_INCREASING; "ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT",ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT; "ABSOLUTELY_REAL_INTEGRABLE_INF",ABSOLUTELY_REAL_INTEGRABLE_INF; "ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND",ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND; "ABSOLUTELY_REAL_INTEGRABLE_LE",ABSOLUTELY_REAL_INTEGRABLE_LE; "ABSOLUTELY_REAL_INTEGRABLE_LINEAR",ABSOLUTELY_REAL_INTEGRABLE_LINEAR; "ABSOLUTELY_REAL_INTEGRABLE_LMUL",ABSOLUTELY_REAL_INTEGRABLE_LMUL; "ABSOLUTELY_REAL_INTEGRABLE_MAX",ABSOLUTELY_REAL_INTEGRABLE_MAX; "ABSOLUTELY_REAL_INTEGRABLE_MIN",ABSOLUTELY_REAL_INTEGRABLE_MIN; "ABSOLUTELY_REAL_INTEGRABLE_NEG",ABSOLUTELY_REAL_INTEGRABLE_NEG; "ABSOLUTELY_REAL_INTEGRABLE_ON",ABSOLUTELY_REAL_INTEGRABLE_ON; "ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL",ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL; "ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE",ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE; "ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV",ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV; "ABSOLUTELY_REAL_INTEGRABLE_RMUL",ABSOLUTELY_REAL_INTEGRABLE_RMUL; "ABSOLUTELY_REAL_INTEGRABLE_SUB",ABSOLUTELY_REAL_INTEGRABLE_SUB; "ABSOLUTELY_REAL_INTEGRABLE_SUM",ABSOLUTELY_REAL_INTEGRABLE_SUM; "ABSOLUTELY_REAL_INTEGRABLE_SUP",ABSOLUTELY_REAL_INTEGRABLE_SUP; "ABSOLUTELY_SETCONTINUOUS_COMPARISON",ABSOLUTELY_SETCONTINUOUS_COMPARISON; "ABSOLUTELY_SETCONTINUOUS_INDEFINITE_INTEGRAL",ABSOLUTELY_SETCONTINUOUS_INDEFINITE_INTEGRAL; "ABSOLUTELY_SETCONTINUOUS_ON_0",ABSOLUTELY_SETCONTINUOUS_ON_0; "ABSOLUTELY_SETCONTINUOUS_ON_ADD",ABSOLUTELY_SETCONTINUOUS_ON_ADD; "ABSOLUTELY_SETCONTINUOUS_ON_ALT",ABSOLUTELY_SETCONTINUOUS_ON_ALT; "ABSOLUTELY_SETCONTINUOUS_ON_CMUL",ABSOLUTELY_SETCONTINUOUS_ON_CMUL; "ABSOLUTELY_SETCONTINUOUS_ON_COMPONENTWISE",ABSOLUTELY_SETCONTINUOUS_ON_COMPONENTWISE; "ABSOLUTELY_SETCONTINUOUS_ON_COMPOSE_LINEAR",ABSOLUTELY_SETCONTINUOUS_ON_COMPOSE_LINEAR; "ABSOLUTELY_SETCONTINUOUS_ON_DIVISION",ABSOLUTELY_SETCONTINUOUS_ON_DIVISION; "ABSOLUTELY_SETCONTINUOUS_ON_EQ",ABSOLUTELY_SETCONTINUOUS_ON_EQ; "ABSOLUTELY_SETCONTINUOUS_ON_IMP_HAS_BOUNDED_SETVARIATION_ON",ABSOLUTELY_SETCONTINUOUS_ON_IMP_HAS_BOUNDED_SETVARIATION_ON; "ABSOLUTELY_SETCONTINUOUS_ON_LIFT_ABS",ABSOLUTELY_SETCONTINUOUS_ON_LIFT_ABS; "ABSOLUTELY_SETCONTINUOUS_ON_MUL",ABSOLUTELY_SETCONTINUOUS_ON_MUL; "ABSOLUTELY_SETCONTINUOUS_ON_NEG",ABSOLUTELY_SETCONTINUOUS_ON_NEG; "ABSOLUTELY_SETCONTINUOUS_ON_NORM",ABSOLUTELY_SETCONTINUOUS_ON_NORM; "ABSOLUTELY_SETCONTINUOUS_ON_NULL",ABSOLUTELY_SETCONTINUOUS_ON_NULL; "ABSOLUTELY_SETCONTINUOUS_ON_SUB",ABSOLUTELY_SETCONTINUOUS_ON_SUB; "ABSOLUTELY_SETCONTINUOUS_ON_SUBSET",ABSOLUTELY_SETCONTINUOUS_ON_SUBSET; "ABSOLUTELY_SETCONTINUOUS_ON_VSUM",ABSOLUTELY_SETCONTINUOUS_ON_VSUM; "ABSOLUTELY_SUMMABLE_IMP_CAUCHY",ABSOLUTELY_SUMMABLE_IMP_CAUCHY; "ABSOLUTE_EXTENSOR_IMP_AR",ABSOLUTE_EXTENSOR_IMP_AR; "ABSOLUTE_INTEGRAL_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ",ABSOLUTE_INTEGRAL_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ; "ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION",ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION; "ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION_ALT",ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION_ALT; "ABSOLUTE_INTEGRATION_BY_PARTS",ABSOLUTE_INTEGRATION_BY_PARTS; "ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR",ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR; "ABSOLUTE_REAL_INTEGRATION_BY_PARTS",ABSOLUTE_REAL_INTEGRATION_BY_PARTS; "ABSOLUTE_RETRACTION_CONVEX_CLOSED",ABSOLUTE_RETRACTION_CONVEX_CLOSED; "ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE",ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE; "ABSOLUTE_RETRACT_CONTRACTIBLE_ANR",ABSOLUTE_RETRACT_CONTRACTIBLE_ANR; "ABSOLUTE_RETRACT_CONVEX",ABSOLUTE_RETRACT_CONVEX; "ABSOLUTE_RETRACT_CONVEX_CLOSED",ABSOLUTE_RETRACT_CONVEX_CLOSED; "ABSOLUTE_RETRACT_FROM_UNION_AND_INTER",ABSOLUTE_RETRACT_FROM_UNION_AND_INTER; "ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT",ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT; "ABSOLUTE_RETRACT_IMP_AR",ABSOLUTE_RETRACT_IMP_AR; "ABSOLUTE_RETRACT_IMP_AR_GEN",ABSOLUTE_RETRACT_IMP_AR_GEN; "ABSOLUTE_RETRACT_PATH_IMAGE_ARC",ABSOLUTE_RETRACT_PATH_IMAGE_ARC; "ABSOLUTE_RETRACT_UNION",ABSOLUTE_RETRACT_UNION; "ABSORPTION",ABSORPTION; "ABS_DROP",ABS_DROP; "ABS_SIMP",ABS_SIMP; "ABS_SQUARE_EQ_1",ABS_SQUARE_EQ_1; "ABS_SQUARE_LE_1",ABS_SQUARE_LE_1; "ABS_SQUARE_LT_1",ABS_SQUARE_LT_1; "ACCESSIBLE_FRONTIER_ANR_COMPLEMENT_COMPONENT",ACCESSIBLE_FRONTIER_ANR_COMPLEMENT_COMPONENT; "ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT",ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT; "ACS_0",ACS_0; "ACS_1",ACS_1; "ACS_ASN",ACS_ASN; "ACS_ASN_SQRT_NEG",ACS_ASN_SQRT_NEG; "ACS_ASN_SQRT_POS",ACS_ASN_SQRT_POS; "ACS_ATN",ACS_ATN; "ACS_BOUNDS",ACS_BOUNDS; "ACS_BOUNDS_LT",ACS_BOUNDS_LT; "ACS_COS",ACS_COS; "ACS_INJ",ACS_INJ; "ACS_MONO_LE",ACS_MONO_LE; "ACS_MONO_LE_EQ",ACS_MONO_LE_EQ; "ACS_MONO_LT",ACS_MONO_LT; "ACS_MONO_LT_EQ",ACS_MONO_LT_EQ; "ACS_NEG",ACS_NEG; "ACS_NEG_1",ACS_NEG_1; "ADD",ADD; "ADD1",ADD1; "ADDITIVE_CONTENT_DIVISION",ADDITIVE_CONTENT_DIVISION; "ADDITIVE_CONTENT_TAGGED_DIVISION",ADDITIVE_CONTENT_TAGGED_DIVISION; "ADDITIVE_DIVISION_1",ADDITIVE_DIVISION_1; "ADDITIVE_TAGGED_DIVISION_1",ADDITIVE_TAGGED_DIVISION_1; "ADD_0",ADD_0; "ADD_AC",ADD_AC; "ADD_ASSOC",ADD_ASSOC; "ADD_CLAUSES",ADD_CLAUSES; "ADD_EQ_0",ADD_EQ_0; "ADD_SUB",ADD_SUB; "ADD_SUB2",ADD_SUB2; "ADD_SUBR",ADD_SUBR; "ADD_SUBR2",ADD_SUBR2; "ADD_SUC",ADD_SUC; "ADD_SYM",ADD_SYM; "ADJOINT_ADJOINT",ADJOINT_ADJOINT; "ADJOINT_CLAUSES",ADJOINT_CLAUSES; "ADJOINT_COMPOSE",ADJOINT_COMPOSE; "ADJOINT_INJECTIVE",ADJOINT_INJECTIVE; "ADJOINT_INJECTIVE_INJECTIVE",ADJOINT_INJECTIVE_INJECTIVE; "ADJOINT_INJECTIVE_INJECTIVE_0",ADJOINT_INJECTIVE_INJECTIVE_0; "ADJOINT_LINEAR",ADJOINT_LINEAR; "ADJOINT_MATRIX",ADJOINT_MATRIX; "ADJOINT_SURJECTIVE",ADJOINT_SURJECTIVE; "ADJOINT_UNIQUE",ADJOINT_UNIQUE; "ADJOINT_WORKS",ADJOINT_WORKS; "ADMISSIBLE_BASE",ADMISSIBLE_BASE; "ADMISSIBLE_COMB",ADMISSIBLE_COMB; "ADMISSIBLE_COND",ADMISSIBLE_COND; "ADMISSIBLE_CONST",ADMISSIBLE_CONST; "ADMISSIBLE_GUARDED_PATTERN",ADMISSIBLE_GUARDED_PATTERN; "ADMISSIBLE_IMP_SUPERADMISSIBLE",ADMISSIBLE_IMP_SUPERADMISSIBLE; "ADMISSIBLE_LAMBDA",ADMISSIBLE_LAMBDA; "ADMISSIBLE_MAP",ADMISSIBLE_MAP; "ADMISSIBLE_MATCH",ADMISSIBLE_MATCH; "ADMISSIBLE_MATCH_SEQPATTERN",ADMISSIBLE_MATCH_SEQPATTERN; "ADMISSIBLE_NEST",ADMISSIBLE_NEST; "ADMISSIBLE_NSUM",ADMISSIBLE_NSUM; "ADMISSIBLE_RAND",ADMISSIBLE_RAND; "ADMISSIBLE_SEQPATTERN",ADMISSIBLE_SEQPATTERN; "ADMISSIBLE_SUM",ADMISSIBLE_SUM; "ADMISSIBLE_UNGUARDED_PATTERN",ADMISSIBLE_UNGUARDED_PATTERN; "AFFINE",AFFINE; "AFFINE_AFFINE_HULL",AFFINE_AFFINE_HULL; "AFFINE_AFFINITY",AFFINE_AFFINITY; "AFFINE_AFFINITY_EQ",AFFINE_AFFINITY_EQ; "AFFINE_ALT",AFFINE_ALT; "AFFINE_BASIS_EXISTS",AFFINE_BASIS_EXISTS; "AFFINE_BOUNDED_EQ_LOWDIM",AFFINE_BOUNDED_EQ_LOWDIM; "AFFINE_BOUNDED_EQ_TRIVIAL",AFFINE_BOUNDED_EQ_TRIVIAL; "AFFINE_DEPENDENT_BIGGERSET",AFFINE_DEPENDENT_BIGGERSET; "AFFINE_DEPENDENT_BIGGERSET_GENERAL",AFFINE_DEPENDENT_BIGGERSET_GENERAL; "AFFINE_DEPENDENT_CHOOSE",AFFINE_DEPENDENT_CHOOSE; "AFFINE_DEPENDENT_EXPLICIT",AFFINE_DEPENDENT_EXPLICIT; "AFFINE_DEPENDENT_EXPLICIT_FINITE",AFFINE_DEPENDENT_EXPLICIT_FINITE; "AFFINE_DEPENDENT_IMP_COLLINEAR_3",AFFINE_DEPENDENT_IMP_COLLINEAR_3; "AFFINE_DEPENDENT_IMP_DEPENDENT",AFFINE_DEPENDENT_IMP_DEPENDENT; "AFFINE_DEPENDENT_LINEAR_IMAGE",AFFINE_DEPENDENT_LINEAR_IMAGE; "AFFINE_DEPENDENT_LINEAR_IMAGE_EQ",AFFINE_DEPENDENT_LINEAR_IMAGE_EQ; "AFFINE_DEPENDENT_MONO",AFFINE_DEPENDENT_MONO; "AFFINE_DEPENDENT_TRANSLATION",AFFINE_DEPENDENT_TRANSLATION; "AFFINE_DEPENDENT_TRANSLATION_EQ",AFFINE_DEPENDENT_TRANSLATION_EQ; "AFFINE_DIFFERENCES",AFFINE_DIFFERENCES; "AFFINE_DIFFS_SUBSPACE",AFFINE_DIFFS_SUBSPACE; "AFFINE_EMPTY",AFFINE_EMPTY; "AFFINE_EQ_SUBSPACE",AFFINE_EQ_SUBSPACE; "AFFINE_EXISTS",AFFINE_EXISTS; "AFFINE_EXPLICIT",AFFINE_EXPLICIT; "AFFINE_HULLS_EQ",AFFINE_HULLS_EQ; "AFFINE_HULL_0_2_EXPLICIT",AFFINE_HULL_0_2_EXPLICIT; "AFFINE_HULL_0_3_EXPLICIT",AFFINE_HULL_0_3_EXPLICIT; "AFFINE_HULL_0_EXPLICIT",AFFINE_HULL_0_EXPLICIT; "AFFINE_HULL_2",AFFINE_HULL_2; "AFFINE_HULL_2_ALT",AFFINE_HULL_2_ALT; "AFFINE_HULL_3",AFFINE_HULL_3; "AFFINE_HULL_3_IMP_COLLINEAR",AFFINE_HULL_3_IMP_COLLINEAR; "AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR; "AFFINE_HULL_AFFINE_INTER_OPEN",AFFINE_HULL_AFFINE_INTER_OPEN; "AFFINE_HULL_AFFINE_INTER_OPEN_IN",AFFINE_HULL_AFFINE_INTER_OPEN_IN; "AFFINE_HULL_AFFINITY",AFFINE_HULL_AFFINITY; "AFFINE_HULL_CLOSURE",AFFINE_HULL_CLOSURE; "AFFINE_HULL_CONIC_HULL",AFFINE_HULL_CONIC_HULL; "AFFINE_HULL_CONVEX_HULL",AFFINE_HULL_CONVEX_HULL; "AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; "AFFINE_HULL_CONVEX_INTER_OPEN",AFFINE_HULL_CONVEX_INTER_OPEN; "AFFINE_HULL_CONVEX_INTER_OPEN_IN",AFFINE_HULL_CONVEX_INTER_OPEN_IN; "AFFINE_HULL_EMPTY",AFFINE_HULL_EMPTY; "AFFINE_HULL_EQ",AFFINE_HULL_EQ; "AFFINE_HULL_EQ_EMPTY",AFFINE_HULL_EQ_EMPTY; "AFFINE_HULL_EQ_SING",AFFINE_HULL_EQ_SING; "AFFINE_HULL_EQ_SPAN",AFFINE_HULL_EQ_SPAN; "AFFINE_HULL_EQ_SPAN_EQ",AFFINE_HULL_EQ_SPAN_EQ; "AFFINE_HULL_EXPLICIT",AFFINE_HULL_EXPLICIT; "AFFINE_HULL_EXPLICIT_ALT",AFFINE_HULL_EXPLICIT_ALT; "AFFINE_HULL_EXPLICIT_UNIQUE",AFFINE_HULL_EXPLICIT_UNIQUE; "AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR",AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR; "AFFINE_HULL_FINITE",AFFINE_HULL_FINITE; "AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES",AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES; "AFFINE_HULL_FINITE_STEP",AFFINE_HULL_FINITE_STEP; "AFFINE_HULL_FINITE_STEP_GEN",AFFINE_HULL_FINITE_STEP_GEN; "AFFINE_HULL_HALFSPACE_GE",AFFINE_HULL_HALFSPACE_GE; "AFFINE_HULL_HALFSPACE_GT",AFFINE_HULL_HALFSPACE_GT; "AFFINE_HULL_HALFSPACE_LE",AFFINE_HULL_HALFSPACE_LE; "AFFINE_HULL_HALFSPACE_LT",AFFINE_HULL_HALFSPACE_LT; "AFFINE_HULL_INDEXED",AFFINE_HULL_INDEXED; "AFFINE_HULL_INSERT_SPAN",AFFINE_HULL_INSERT_SPAN; "AFFINE_HULL_INSERT_SUBSET_SPAN",AFFINE_HULL_INSERT_SUBSET_SPAN; "AFFINE_HULL_INTER",AFFINE_HULL_INTER; "AFFINE_HULL_INTERS",AFFINE_HULL_INTERS; "AFFINE_HULL_LINEAR_IMAGE",AFFINE_HULL_LINEAR_IMAGE; "AFFINE_HULL_NONEMPTY_INTERIOR",AFFINE_HULL_NONEMPTY_INTERIOR; "AFFINE_HULL_OPEN",AFFINE_HULL_OPEN; "AFFINE_HULL_OPEN_IN",AFFINE_HULL_OPEN_IN; "AFFINE_HULL_OPEN_IN_AFFINE",AFFINE_HULL_OPEN_IN_AFFINE; "AFFINE_HULL_OPEN_IN_CONVEX",AFFINE_HULL_OPEN_IN_CONVEX; "AFFINE_HULL_PCROSS",AFFINE_HULL_PCROSS; "AFFINE_HULL_RELATIVE_FRONTIER_BOUNDED",AFFINE_HULL_RELATIVE_FRONTIER_BOUNDED; "AFFINE_HULL_RELATIVE_INTERIOR",AFFINE_HULL_RELATIVE_INTERIOR; "AFFINE_HULL_SCALING",AFFINE_HULL_SCALING; "AFFINE_HULL_SEGMENT",AFFINE_HULL_SEGMENT; "AFFINE_HULL_SING",AFFINE_HULL_SING; "AFFINE_HULL_SPAN",AFFINE_HULL_SPAN; "AFFINE_HULL_SUBSET_SPAN",AFFINE_HULL_SUBSET_SPAN; "AFFINE_HULL_SUMS",AFFINE_HULL_SUMS; "AFFINE_HULL_TRANSLATION",AFFINE_HULL_TRANSLATION; "AFFINE_HULL_UNIV",AFFINE_HULL_UNIV; "AFFINE_HYPERPLANE",AFFINE_HYPERPLANE; "AFFINE_HYPERPLANE_SUMS_EQ_UNIV",AFFINE_HYPERPLANE_SUMS_EQ_UNIV; "AFFINE_IMP_CONVEX",AFFINE_IMP_CONVEX; "AFFINE_IMP_POLYHEDRON",AFFINE_IMP_POLYHEDRON; "AFFINE_IMP_SUBSPACE",AFFINE_IMP_SUBSPACE; "AFFINE_INDEPENDENT_1",AFFINE_INDEPENDENT_1; "AFFINE_INDEPENDENT_2",AFFINE_INDEPENDENT_2; "AFFINE_INDEPENDENT_CARD_DIM_DIFFS",AFFINE_INDEPENDENT_CARD_DIM_DIFFS; "AFFINE_INDEPENDENT_CARD_LE",AFFINE_INDEPENDENT_CARD_LE; "AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL",AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL; "AFFINE_INDEPENDENT_DELETE",AFFINE_INDEPENDENT_DELETE; "AFFINE_INDEPENDENT_EMPTY",AFFINE_INDEPENDENT_EMPTY; "AFFINE_INDEPENDENT_IFF_CARD",AFFINE_INDEPENDENT_IFF_CARD; "AFFINE_INDEPENDENT_IMP_FINITE",AFFINE_INDEPENDENT_IMP_FINITE; "AFFINE_INDEPENDENT_INSERT",AFFINE_INDEPENDENT_INSERT; "AFFINE_INDEPENDENT_SPAN_EQ",AFFINE_INDEPENDENT_SPAN_EQ; "AFFINE_INDEPENDENT_SPAN_GT",AFFINE_INDEPENDENT_SPAN_GT; "AFFINE_INDEPENDENT_STDBASIS",AFFINE_INDEPENDENT_STDBASIS; "AFFINE_INDEPENDENT_SUBSET",AFFINE_INDEPENDENT_SUBSET; "AFFINE_INDEXED",AFFINE_INDEXED; "AFFINE_INTER",AFFINE_INTER; "AFFINE_INTERS",AFFINE_INTERS; "AFFINE_LINEAR_IMAGE",AFFINE_LINEAR_IMAGE; "AFFINE_LINEAR_IMAGE_EQ",AFFINE_LINEAR_IMAGE_EQ; "AFFINE_LINEAR_PREIMAGE",AFFINE_LINEAR_PREIMAGE; "AFFINE_NEGATIONS",AFFINE_NEGATIONS; "AFFINE_PARALLEL_SLICE",AFFINE_PARALLEL_SLICE; "AFFINE_PCROSS",AFFINE_PCROSS; "AFFINE_PCROSS_EQ",AFFINE_PCROSS_EQ; "AFFINE_SCALING",AFFINE_SCALING; "AFFINE_SCALING_EQ",AFFINE_SCALING_EQ; "AFFINE_SING",AFFINE_SING; "AFFINE_SPAN",AFFINE_SPAN; "AFFINE_STANDARD_HYPERPLANE",AFFINE_STANDARD_HYPERPLANE; "AFFINE_SUMS",AFFINE_SUMS; "AFFINE_TRANSLATION",AFFINE_TRANSLATION; "AFFINE_TRANSLATION_EQ",AFFINE_TRANSLATION_EQ; "AFFINE_TRANSLATION_SUBSPACE",AFFINE_TRANSLATION_SUBSPACE; "AFFINE_TRANSLATION_SUBSPACE_EXPLICIT",AFFINE_TRANSLATION_SUBSPACE_EXPLICIT; "AFFINE_TRANSLATION_UNIQUE_SUBSPACE",AFFINE_TRANSLATION_UNIQUE_SUBSPACE; "AFFINE_UNIV",AFFINE_UNIV; "AFFINE_VSUM",AFFINE_VSUM; "AFFINE_VSUM_STRONG",AFFINE_VSUM_STRONG; "AFFINITY_INVERSES",AFFINITY_INVERSES; "AFFINITY_SCALING_TRANSLATION",AFFINITY_SCALING_TRANSLATION; "AFF_DIM",AFF_DIM; "AFF_DIM_2",AFF_DIM_2; "AFF_DIM_AFFINE_HULL",AFF_DIM_AFFINE_HULL; "AFF_DIM_AFFINE_INDEPENDENT",AFF_DIM_AFFINE_INDEPENDENT; "AFF_DIM_AFFINE_INTER_HYPERPLANE",AFF_DIM_AFFINE_INTER_HYPERPLANE; "AFF_DIM_BALL",AFF_DIM_BALL; "AFF_DIM_CBALL",AFF_DIM_CBALL; "AFF_DIM_CLOSURE",AFF_DIM_CLOSURE; "AFF_DIM_CONIC_HULL",AFF_DIM_CONIC_HULL; "AFF_DIM_CONIC_HULL_DIM",AFF_DIM_CONIC_HULL_DIM; "AFF_DIM_CONVEX_HULL",AFF_DIM_CONVEX_HULL; "AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR",AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR; "AFF_DIM_CONVEX_INTER_OPEN",AFF_DIM_CONVEX_INTER_OPEN; "AFF_DIM_DIM",AFF_DIM_DIM; "AFF_DIM_DIMENSION",AFF_DIM_DIMENSION; "AFF_DIM_DIMENSION_ALT",AFF_DIM_DIMENSION_ALT; "AFF_DIM_DIM_0",AFF_DIM_DIM_0; "AFF_DIM_DIM_AFFINE_DIFFS",AFF_DIM_DIM_AFFINE_DIFFS; "AFF_DIM_DIM_AFFINE_DIFFS_STRONG",AFF_DIM_DIM_AFFINE_DIFFS_STRONG; "AFF_DIM_DIM_SUBSPACE",AFF_DIM_DIM_SUBSPACE; "AFF_DIM_EMPTY",AFF_DIM_EMPTY; "AFF_DIM_EQ_0",AFF_DIM_EQ_0; "AFF_DIM_EQ_AFFINE_HULL",AFF_DIM_EQ_AFFINE_HULL; "AFF_DIM_EQ_FULL",AFF_DIM_EQ_FULL; "AFF_DIM_EQ_FULL_GEN",AFF_DIM_EQ_FULL_GEN; "AFF_DIM_EQ_HYPERPLANE",AFF_DIM_EQ_HYPERPLANE; "AFF_DIM_EQ_INTER_HYPERPLANE",AFF_DIM_EQ_INTER_HYPERPLANE; "AFF_DIM_EQ_MINUS1",AFF_DIM_EQ_MINUS1; "AFF_DIM_GE",AFF_DIM_GE; "AFF_DIM_HALFSPACE_GE",AFF_DIM_HALFSPACE_GE; "AFF_DIM_HALFSPACE_GT",AFF_DIM_HALFSPACE_GT; "AFF_DIM_HALFSPACE_LE",AFF_DIM_HALFSPACE_LE; "AFF_DIM_HALFSPACE_LT",AFF_DIM_HALFSPACE_LT; "AFF_DIM_HYPERPLANE",AFF_DIM_HYPERPLANE; "AFF_DIM_INJECTIVE_LINEAR_IMAGE",AFF_DIM_INJECTIVE_LINEAR_IMAGE; "AFF_DIM_INSERT",AFF_DIM_INSERT; "AFF_DIM_INTERVAL",AFF_DIM_INTERVAL; "AFF_DIM_LE_CARD",AFF_DIM_LE_CARD; "AFF_DIM_LE_DIM",AFF_DIM_LE_DIM; "AFF_DIM_LE_UNIV",AFF_DIM_LE_UNIV; "AFF_DIM_LINEAR_IMAGE_LE",AFF_DIM_LINEAR_IMAGE_LE; "AFF_DIM_LT_FULL",AFF_DIM_LT_FULL; "AFF_DIM_NONEMPTY_INTERIOR",AFF_DIM_NONEMPTY_INTERIOR; "AFF_DIM_NONEMPTY_INTERIOR_EQ",AFF_DIM_NONEMPTY_INTERIOR_EQ; "AFF_DIM_NONEMPTY_INTERIOR_OF",AFF_DIM_NONEMPTY_INTERIOR_OF; "AFF_DIM_NONEMPTY_INTERIOR_OF_EQ",AFF_DIM_NONEMPTY_INTERIOR_OF_EQ; "AFF_DIM_OPEN",AFF_DIM_OPEN; "AFF_DIM_OPEN_IN",AFF_DIM_OPEN_IN; "AFF_DIM_PCROSS",AFF_DIM_PCROSS; "AFF_DIM_POS_LE",AFF_DIM_POS_LE; "AFF_DIM_PSUBSET",AFF_DIM_PSUBSET; "AFF_DIM_RELATIVE_INTERIOR",AFF_DIM_RELATIVE_INTERIOR; "AFF_DIM_SEGMENT",AFF_DIM_SEGMENT; "AFF_DIM_SIMPLEX",AFF_DIM_SIMPLEX; "AFF_DIM_SING",AFF_DIM_SING; "AFF_DIM_SUBSET",AFF_DIM_SUBSET; "AFF_DIM_SUMS_INTER",AFF_DIM_SUMS_INTER; "AFF_DIM_TRANSLATION_EQ",AFF_DIM_TRANSLATION_EQ; "AFF_DIM_UNION",AFF_DIM_UNION; "AFF_DIM_UNIQUE",AFF_DIM_UNIQUE; "AFF_DIM_UNIV",AFF_DIM_UNIV; "AFF_LOWDIM_SUBSET_HYPERPLANE",AFF_LOWDIM_SUBSET_HYPERPLANE; "AGM",AGM; "AGM_2",AGM_2; "AGM_GEN",AGM_GEN; "AGM_ROOT",AGM_ROOT; "AGM_RPOW",AGM_RPOW; "AGM_SQRT",AGM_SQRT; "ALL",ALL; "ALL2",ALL2; "ALL2_ALL",ALL2_ALL; "ALL2_AND_RIGHT",ALL2_AND_RIGHT; "ALL2_DEF",ALL2_DEF; "ALL2_MAP",ALL2_MAP; "ALL2_MAP2",ALL2_MAP2; "ALL_APPEND",ALL_APPEND; "ALL_EL",ALL_EL; "ALL_FILTER",ALL_FILTER; "ALL_IMP",ALL_IMP; "ALL_MAP",ALL_MAP; "ALL_MEM",ALL_MEM; "ALL_MP",ALL_MP; "ALL_T",ALL_T; "ALTERNATING_SUM_BOUND",ALTERNATING_SUM_BOUND; "ALTERNATING_SUM_BOUNDS",ALTERNATING_SUM_BOUNDS; "ALWAYS_EVENTUALLY",ALWAYS_EVENTUALLY; "ANALYTIC_AT",ANALYTIC_AT; "ANALYTIC_AT_ADD",ANALYTIC_AT_ADD; "ANALYTIC_AT_BALL",ANALYTIC_AT_BALL; "ANALYTIC_AT_MUL",ANALYTIC_AT_MUL; "ANALYTIC_AT_POW",ANALYTIC_AT_POW; "ANALYTIC_AT_SUB",ANALYTIC_AT_SUB; "ANALYTIC_AT_TWO",ANALYTIC_AT_TWO; "ANALYTIC_BOREL_MEASURABLE_IMAGE",ANALYTIC_BOREL_MEASURABLE_IMAGE; "ANALYTIC_BOREL_MEASURABLE_PREIMAGE",ANALYTIC_BOREL_MEASURABLE_PREIMAGE; "ANALYTIC_COMPLEX_DERIVATIVE",ANALYTIC_COMPLEX_DERIVATIVE; "ANALYTIC_CONTINUATION",ANALYTIC_CONTINUATION; "ANALYTIC_CONTINUOUS_IMAGE",ANALYTIC_CONTINUOUS_IMAGE; "ANALYTIC_CONTINUOUS_PREIMAGE",ANALYTIC_CONTINUOUS_PREIMAGE; "ANALYTIC_EMPTY",ANALYTIC_EMPTY; "ANALYTIC_HIGHER_COMPLEX_DERIVATIVE",ANALYTIC_HIGHER_COMPLEX_DERIVATIVE; "ANALYTIC_IFF_POWER_SERIES",ANALYTIC_IFF_POWER_SERIES; "ANALYTIC_IMP_HOLOMORPHIC",ANALYTIC_IMP_HOLOMORPHIC; "ANALYTIC_IMP_LEBESGUE_MEASURABLE",ANALYTIC_IMP_LEBESGUE_MEASURABLE; "ANALYTIC_INTER",ANALYTIC_INTER; "ANALYTIC_INTERS",ANALYTIC_INTERS; "ANALYTIC_LINEAR_IMAGE",ANALYTIC_LINEAR_IMAGE; "ANALYTIC_ON_ADD",ANALYTIC_ON_ADD; "ANALYTIC_ON_ANALYTIC_AT",ANALYTIC_ON_ANALYTIC_AT; "ANALYTIC_ON_COMPOSE",ANALYTIC_ON_COMPOSE; "ANALYTIC_ON_COMPOSE_GEN",ANALYTIC_ON_COMPOSE_GEN; "ANALYTIC_ON_CONST",ANALYTIC_ON_CONST; "ANALYTIC_ON_DIV",ANALYTIC_ON_DIV; "ANALYTIC_ON_HOLOMORPHIC",ANALYTIC_ON_HOLOMORPHIC; "ANALYTIC_ON_ID",ANALYTIC_ON_ID; "ANALYTIC_ON_IMP_DIFFERENTIABLE_AT",ANALYTIC_ON_IMP_DIFFERENTIABLE_AT; "ANALYTIC_ON_INV",ANALYTIC_ON_INV; "ANALYTIC_ON_LINEAR",ANALYTIC_ON_LINEAR; "ANALYTIC_ON_MUL",ANALYTIC_ON_MUL; "ANALYTIC_ON_NEG",ANALYTIC_ON_NEG; "ANALYTIC_ON_OPEN",ANALYTIC_ON_OPEN; "ANALYTIC_ON_POW",ANALYTIC_ON_POW; "ANALYTIC_ON_SUB",ANALYTIC_ON_SUB; "ANALYTIC_ON_SUBSET",ANALYTIC_ON_SUBSET; "ANALYTIC_ON_UNION",ANALYTIC_ON_UNION; "ANALYTIC_ON_UNIONS",ANALYTIC_ON_UNIONS; "ANALYTIC_ON_VSUM",ANALYTIC_ON_VSUM; "ANALYTIC_PCROSS",ANALYTIC_PCROSS; "ANALYTIC_PCROSS_EQ",ANALYTIC_PCROSS_EQ; "ANALYTIC_TRANSLATION",ANALYTIC_TRANSLATION; "ANALYTIC_UNION",ANALYTIC_UNION; "ANALYTIC_UNIONS",ANALYTIC_UNIONS; "ANALYTIC_UNIV",ANALYTIC_UNIV; "AND_ALL",AND_ALL; "AND_ALL2",AND_ALL2; "AND_CLAUSES",AND_CLAUSES; "AND_DEF",AND_DEF; "AND_FORALL_THM",AND_FORALL_THM; "ANR",ANR; "ANR_BALL",ANR_BALL; "ANR_CBALL",ANR_CBALL; "ANR_CLOSED_UNION",ANR_CLOSED_UNION; "ANR_CLOSED_UNION_LOCAL",ANR_CLOSED_UNION_LOCAL; "ANR_CLOSURE_FROM_FRONTIER",ANR_CLOSURE_FROM_FRONTIER; "ANR_COMPONENTWISE",ANR_COMPONENTWISE; "ANR_COMPONENT_ANR",ANR_COMPONENT_ANR; "ANR_CONNECTED_COMPONENT_ANR",ANR_CONNECTED_COMPONENT_ANR; "ANR_COVERING_SPACE",ANR_COVERING_SPACE; "ANR_COVERING_SPACE_EQ",ANR_COVERING_SPACE_EQ; "ANR_DELETE",ANR_DELETE; "ANR_EMPTY",ANR_EMPTY; "ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; "ANR_FINITE_UNIONS_CONVEX_CLOSED",ANR_FINITE_UNIONS_CONVEX_CLOSED; "ANR_FROM_UNION_AND_INTER",ANR_FROM_UNION_AND_INTER; "ANR_FROM_UNION_AND_INTER_LOCAL",ANR_FROM_UNION_AND_INTER_LOCAL; "ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR; "ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT; "ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; "ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; "ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; "ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT; "ANR_IMP_LOCALLY_CONNECTED",ANR_IMP_LOCALLY_CONNECTED; "ANR_IMP_LOCALLY_PATH_CONNECTED",ANR_IMP_LOCALLY_PATH_CONNECTED; "ANR_IMP_NEIGHBOURHOOD_RETRACT",ANR_IMP_NEIGHBOURHOOD_RETRACT; "ANR_INSERT",ANR_INSERT; "ANR_INTERIOR",ANR_INTERIOR; "ANR_INTERVAL",ANR_INTERVAL; "ANR_LINEAR_IMAGE_EQ",ANR_LINEAR_IMAGE_EQ; "ANR_LOCALLY",ANR_LOCALLY; "ANR_NEIGHBORHOOD_RETRACT",ANR_NEIGHBORHOOD_RETRACT; "ANR_OPEN_IN",ANR_OPEN_IN; "ANR_OPEN_UNION",ANR_OPEN_UNION; "ANR_OPEN_UNIONS",ANR_OPEN_UNIONS; "ANR_PATH_COMPONENT_ANR",ANR_PATH_COMPONENT_ANR; "ANR_PATH_IMAGE_SIMPLE_PATH",ANR_PATH_IMAGE_SIMPLE_PATH; "ANR_PCROSS",ANR_PCROSS; "ANR_PCROSS_EQ",ANR_PCROSS_EQ; "ANR_RELATIVE_FRONTIER_CONVEX",ANR_RELATIVE_FRONTIER_CONVEX; "ANR_RELATIVE_INTERIOR",ANR_RELATIVE_INTERIOR; "ANR_RETRACT_OF_ANR",ANR_RETRACT_OF_ANR; "ANR_SIMPLICIAL_COMPLEX",ANR_SIMPLICIAL_COMPLEX; "ANR_SING",ANR_SING; "ANR_SPHERE",ANR_SPHERE; "ANR_STRONG_DEFORMATION_RETRACTION",ANR_STRONG_DEFORMATION_RETRACTION; "ANR_TRANSLATION",ANR_TRANSLATION; "ANR_TRIANGULATION",ANR_TRIANGULATION; "ANR_UNION_EXTENSION_LEMMA",ANR_UNION_EXTENSION_LEMMA; "ANR_UNIV",ANR_UNIV; "ANTIDERIVATIVE_CONTINUOUS",ANTIDERIVATIVE_CONTINUOUS; "ANTIDERIVATIVE_INTEGRAL_CONTINUOUS",ANTIDERIVATIVE_INTEGRAL_CONTINUOUS; "ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL",ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL; "ANY_CLOSEST_POINT_DOT",ANY_CLOSEST_POINT_DOT; "ANY_CLOSEST_POINT_UNIQUE",ANY_CLOSEST_POINT_UNIQUE; "ANY_IN_CONIC_HULL_SIMPLEX",ANY_IN_CONIC_HULL_SIMPLEX; "APPELL_SEQUENCE",APPELL_SEQUENCE; "APPEND",APPEND; "APPEND_ASSOC",APPEND_ASSOC; "APPEND_BUTLAST_LAST",APPEND_BUTLAST_LAST; "APPEND_EQ_NIL",APPEND_EQ_NIL; "APPEND_LCANCEL",APPEND_LCANCEL; "APPEND_NIL",APPEND_NIL; "APPEND_RCANCEL",APPEND_RCANCEL; "APPEND_SING",APPEND_SING; "APPROACHABLE_LT_LE",APPROACHABLE_LT_LE; "APPROXIMABLE_ON_DIVISION",APPROXIMABLE_ON_DIVISION; "AR",AR; "ARBITRARILY_SMALL_CONTINUUM",ARBITRARILY_SMALL_CONTINUUM; "ARCH_EVENTUALLY_INV",ARCH_EVENTUALLY_INV; "ARCH_EVENTUALLY_INV1",ARCH_EVENTUALLY_INV1; "ARCH_EVENTUALLY_LE",ARCH_EVENTUALLY_LE; "ARCH_EVENTUALLY_LT",ARCH_EVENTUALLY_LT; "ARCH_EVENTUALLY_POW",ARCH_EVENTUALLY_POW; "ARCH_EVENTUALLY_POW_INV",ARCH_EVENTUALLY_POW_INV; "ARC_ASSOC",ARC_ASSOC; "ARC_CONNECTED_TRANS",ARC_CONNECTED_TRANS; "ARC_CONTINUOUS_IMAGE",ARC_CONTINUOUS_IMAGE; "ARC_DISTINCT_ENDS",ARC_DISTINCT_ENDS; "ARC_ENDS_UNIQUE",ARC_ENDS_UNIQUE; "ARC_HOMEOMORPHISM_ENDS",ARC_HOMEOMORPHISM_ENDS; "ARC_IMAGE_UNIQUE",ARC_IMAGE_UNIQUE; "ARC_IMP_PATH",ARC_IMP_PATH; "ARC_IMP_SIMPLE_PATH",ARC_IMP_SIMPLE_PATH; "ARC_JOIN",ARC_JOIN; "ARC_JOIN_EQ",ARC_JOIN_EQ; "ARC_JOIN_EQ_ALT",ARC_JOIN_EQ_ALT; "ARC_LENGTH_MINIMAL",ARC_LENGTH_MINIMAL; "ARC_LENGTH_REPARAMETRIZATION",ARC_LENGTH_REPARAMETRIZATION; "ARC_LENGTH_UNIQUE",ARC_LENGTH_UNIQUE; "ARC_LINEAR_IMAGE_EQ",ARC_LINEAR_IMAGE_EQ; "ARC_LINEPATH",ARC_LINEPATH; "ARC_LINEPATH_EQ",ARC_LINEPATH_EQ; "ARC_PARTCIRCLEPATH",ARC_PARTCIRCLEPATH; "ARC_REVERSEPATH",ARC_REVERSEPATH; "ARC_REVERSEPATH_EQ",ARC_REVERSEPATH_EQ; "ARC_SIMPLE_PATH",ARC_SIMPLE_PATH; "ARC_SIMPLE_PATH_SUBPATH",ARC_SIMPLE_PATH_SUBPATH; "ARC_SIMPLE_PATH_SUBPATH_INTERIOR",ARC_SIMPLE_PATH_SUBPATH_INTERIOR; "ARC_SUBPATH_ARC",ARC_SUBPATH_ARC; "ARC_SUBPATH_EQ",ARC_SUBPATH_EQ; "ARC_TRANSLATION_EQ",ARC_TRANSLATION_EQ; "ARG",ARG; "ARG_0",ARG_0; "ARG_ATAN_UPPERHALF",ARG_ATAN_UPPERHALF; "ARG_CEXP",ARG_CEXP; "ARG_CLOG",ARG_CLOG; "ARG_CNJ",ARG_CNJ; "ARG_DIV_CX",ARG_DIV_CX; "ARG_EQ",ARG_EQ; "ARG_EQ_0",ARG_EQ_0; "ARG_EQ_0_PI",ARG_EQ_0_PI; "ARG_EQ_PI",ARG_EQ_PI; "ARG_INV",ARG_INV; "ARG_INV_EQ_0",ARG_INV_EQ_0; "ARG_LE_DIV_SUM",ARG_LE_DIV_SUM; "ARG_LE_DIV_SUM_EQ",ARG_LE_DIV_SUM_EQ; "ARG_LE_PI",ARG_LE_PI; "ARG_LT_NZ",ARG_LT_NZ; "ARG_LT_PI",ARG_LT_PI; "ARG_MUL",ARG_MUL; "ARG_MUL_CX",ARG_MUL_CX; "ARG_NUM",ARG_NUM; "ARG_REAL",ARG_REAL; "ARG_ROTATE2D",ARG_ROTATE2D; "ARG_ROTATE2D_UNIQUE",ARG_ROTATE2D_UNIQUE; "ARG_ROTATE2D_UNIQUE_2PI",ARG_ROTATE2D_UNIQUE_2PI; "ARG_UNIQUE",ARG_UNIQUE; "ARITH",ARITH; "ARITH_ADD",ARITH_ADD; "ARITH_EQ",ARITH_EQ; "ARITH_EVEN",ARITH_EVEN; "ARITH_EXP",ARITH_EXP; "ARITH_GE",ARITH_GE; "ARITH_GT",ARITH_GT; "ARITH_LE",ARITH_LE; "ARITH_LT",ARITH_LT; "ARITH_MULT",ARITH_MULT; "ARITH_ODD",ARITH_ODD; "ARITH_PRE",ARITH_PRE; "ARITH_SUB",ARITH_SUB; "ARITH_SUC",ARITH_SUC; "ARITH_ZERO",ARITH_ZERO; "ARZELA_ASCOLI",ARZELA_ASCOLI; "ARZELA_ASCOLI_LIPSCHITZ",ARZELA_ASCOLI_LIPSCHITZ; "AR_ANR",AR_ANR; "AR_ARC_IMAGE",AR_ARC_IMAGE; "AR_BALL",AR_BALL; "AR_CBALL",AR_CBALL; "AR_CLOSED_UNION",AR_CLOSED_UNION; "AR_CLOSED_UNION_LOCAL",AR_CLOSED_UNION_LOCAL; "AR_DEFORMATION_RETRACT_OF_CONTRACTIBLE",AR_DEFORMATION_RETRACT_OF_CONTRACTIBLE; "AR_EQ_ABSOLUTE_EXTENSOR",AR_EQ_ABSOLUTE_EXTENSOR; "AR_FROM_UNION_AND_INTER",AR_FROM_UNION_AND_INTER; "AR_FROM_UNION_AND_INTER_LOCAL",AR_FROM_UNION_AND_INTER_LOCAL; "AR_IMP_ABSOLUTE_EXTENSOR",AR_IMP_ABSOLUTE_EXTENSOR; "AR_IMP_ABSOLUTE_RETRACT",AR_IMP_ABSOLUTE_RETRACT; "AR_IMP_ABSOLUTE_RETRACT_UNIV",AR_IMP_ABSOLUTE_RETRACT_UNIV; "AR_IMP_ANR",AR_IMP_ANR; "AR_IMP_CONNECTED",AR_IMP_CONNECTED; "AR_IMP_CONTRACTIBLE",AR_IMP_CONTRACTIBLE; "AR_IMP_LOCALLY_CONNECTED",AR_IMP_LOCALLY_CONNECTED; "AR_IMP_LOCALLY_PATH_CONNECTED",AR_IMP_LOCALLY_PATH_CONNECTED; "AR_IMP_NONEMPTY",AR_IMP_NONEMPTY; "AR_IMP_PATH_CONNECTED",AR_IMP_PATH_CONNECTED; "AR_IMP_RETRACT",AR_IMP_RETRACT; "AR_INTERVAL",AR_INTERVAL; "AR_LINEAR_IMAGE_EQ",AR_LINEAR_IMAGE_EQ; "AR_PCROSS",AR_PCROSS; "AR_PCROSS_EQ",AR_PCROSS_EQ; "AR_RETRACT_OF_AR",AR_RETRACT_OF_AR; "AR_SING",AR_SING; "AR_STRONG_DEFORMATION_RETRACT_OF_AR",AR_STRONG_DEFORMATION_RETRACT_OF_AR; "AR_TRANSLATION",AR_TRANSLATION; "AR_UNIV",AR_UNIV; "ASN_0",ASN_0; "ASN_1",ASN_1; "ASN_ACS",ASN_ACS; "ASN_ACS_SQRT_NEG",ASN_ACS_SQRT_NEG; "ASN_ACS_SQRT_POS",ASN_ACS_SQRT_POS; "ASN_ATN",ASN_ATN; "ASN_BOUNDS",ASN_BOUNDS; "ASN_BOUNDS_LT",ASN_BOUNDS_LT; "ASN_BOUNDS_PI2",ASN_BOUNDS_PI2; "ASN_MONO_LE",ASN_MONO_LE; "ASN_MONO_LE_EQ",ASN_MONO_LE_EQ; "ASN_MONO_LT",ASN_MONO_LT; "ASN_MONO_LT_EQ",ASN_MONO_LT_EQ; "ASN_NEG",ASN_NEG; "ASN_NEG_1",ASN_NEG_1; "ASN_PLUS_ACS",ASN_PLUS_ACS; "ASN_SIN",ASN_SIN; "ASSOC",ASSOC; "AT",AT; "ATN_0",ATN_0; "ATN_1",ATN_1; "ATN_ABS",ATN_ABS; "ATN_ABS_LE_X",ATN_ABS_LE_X; "ATN_ADD",ATN_ADD; "ATN_ADD_SMALL",ATN_ADD_SMALL; "ATN_BOUND",ATN_BOUND; "ATN_BOUNDS",ATN_BOUNDS; "ATN_INJ",ATN_INJ; "ATN_INV",ATN_INV; "ATN_LE_PI4",ATN_LE_PI4; "ATN_LE_X",ATN_LE_X; "ATN_LT_PI4",ATN_LT_PI4; "ATN_LT_PI4_NEG",ATN_LT_PI4_NEG; "ATN_LT_PI4_POS",ATN_LT_PI4_POS; "ATN_MONO_LE_EQ",ATN_MONO_LE_EQ; "ATN_MONO_LT",ATN_MONO_LT; "ATN_MONO_LT_EQ",ATN_MONO_LT_EQ; "ATN_NEG",ATN_NEG; "ATN_POS_LE",ATN_POS_LE; "ATN_POS_LT",ATN_POS_LT; "ATN_TAN",ATN_TAN; "ATREAL",ATREAL; "AT_INFINITY",AT_INFINITY; "AT_NEGINFINITY",AT_NEGINFINITY; "AT_POSINFINITY",AT_POSINFINITY; "AUSTIN_LEMMA",AUSTIN_LEMMA; "Arg_DEF",Arg_DEF; "BABY_SARD",BABY_SARD; "BABY_SARD_ALT",BABY_SARD_ALT; "BACK_AND_FORTH",BACK_AND_FORTH; "BACK_AND_FORTH_2",BACK_AND_FORTH_2; "BACK_AND_FORTH_ALT",BACK_AND_FORTH_ALT; "BAIRE",BAIRE; "BAIRE0_INDICATOR",BAIRE0_INDICATOR; "BAIRE1_DET_JACOBIAN",BAIRE1_DET_JACOBIAN; "BAIRE1_INDICATOR",BAIRE1_INDICATOR; "BAIRE1_PARTIAL_DERIVATIVES",BAIRE1_PARTIAL_DERIVATIVES; "BAIRE1_VECTOR_DERIVATIVE",BAIRE1_VECTOR_DERIVATIVE; "BAIRE_ADD",BAIRE_ADD; "BAIRE_ALT",BAIRE_ALT; "BAIRE_BILINEAR",BAIRE_BILINEAR; "BAIRE_CMUL",BAIRE_CMUL; "BAIRE_COMPONENTWISE",BAIRE_COMPONENTWISE; "BAIRE_COMPOSE_CONTINUOUS",BAIRE_COMPOSE_CONTINUOUS; "BAIRE_CONST",BAIRE_CONST; "BAIRE_CONTINUOUS_COMPOSE_UNIV",BAIRE_CONTINUOUS_COMPOSE_UNIV; "BAIRE_EQ",BAIRE_EQ; "BAIRE_IMP_BOREL_MEASURABLE",BAIRE_IMP_BOREL_MEASURABLE; "BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE",BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE; "BAIRE_INDICATOR_COMPLEMENT",BAIRE_INDICATOR_COMPLEMENT; "BAIRE_INDICATOR_COMPLEMENT_UNIV",BAIRE_INDICATOR_COMPLEMENT_UNIV; "BAIRE_INDICATOR_CONTINUOUS_PREIMAGE",BAIRE_INDICATOR_CONTINUOUS_PREIMAGE; "BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV",BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV; "BAIRE_INDICATOR_DELTA",BAIRE_INDICATOR_DELTA; "BAIRE_INDICATOR_DIFF",BAIRE_INDICATOR_DIFF; "BAIRE_INDICATOR_EMPTY",BAIRE_INDICATOR_EMPTY; "BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE",BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE; "BAIRE_INDICATOR_INTER",BAIRE_INDICATOR_INTER; "BAIRE_INDICATOR_INTERS",BAIRE_INDICATOR_INTERS; "BAIRE_INDICATOR_REFL",BAIRE_INDICATOR_REFL; "BAIRE_INDICATOR_SUC",BAIRE_INDICATOR_SUC; "BAIRE_INDICATOR_TRANSLATION",BAIRE_INDICATOR_TRANSLATION; "BAIRE_INDICATOR_UNION",BAIRE_INDICATOR_UNION; "BAIRE_INDICATOR_UNIONS",BAIRE_INDICATOR_UNIONS; "BAIRE_INDICATOR_UNIV",BAIRE_INDICATOR_UNIV; "BAIRE_MAX",BAIRE_MAX; "BAIRE_MIN",BAIRE_MIN; "BAIRE_MONO",BAIRE_MONO; "BAIRE_MUL",BAIRE_MUL; "BAIRE_NORM",BAIRE_NORM; "BAIRE_PASTECART",BAIRE_PASTECART; "BAIRE_PRODUCT",BAIRE_PRODUCT; "BAIRE_SUB",BAIRE_SUB; "BAIRE_SUBSET",BAIRE_SUBSET; "BAIRE_UNIFORM_APPROXIMATION",BAIRE_UNIFORM_APPROXIMATION; "BAIRE_UNIFORM_LIMIT",BAIRE_UNIFORM_LIMIT; "BAIRE_VSUM",BAIRE_VSUM; "BALL_1",BALL_1; "BALL_BIHOLOMORPHISM_EXISTS",BALL_BIHOLOMORPHISM_EXISTS; "BALL_BIHOLOMORPHISM_MOEBIUS_FUNCTION",BALL_BIHOLOMORPHISM_MOEBIUS_FUNCTION; "BALL_EMPTY",BALL_EMPTY; "BALL_EQ_EMPTY",BALL_EQ_EMPTY; "BALL_INTERVAL",BALL_INTERVAL; "BALL_INTERVAL_0",BALL_INTERVAL_0; "BALL_LINEAR_IMAGE",BALL_LINEAR_IMAGE; "BALL_MAX_UNION",BALL_MAX_UNION; "BALL_MIN_INTER",BALL_MIN_INTER; "BALL_SCALING",BALL_SCALING; "BALL_SUBSET_CBALL",BALL_SUBSET_CBALL; "BALL_SUBSET_OPEN_MAP_IMAGE",BALL_SUBSET_OPEN_MAP_IMAGE; "BALL_TRANSLATION",BALL_TRANSLATION; "BALL_TRIVIAL",BALL_TRIVIAL; "BALL_UNION_SPHERE",BALL_UNION_SPHERE; "BANACH_FIX",BANACH_FIX; "BANACH_FIXPOINT_THM",BANACH_FIXPOINT_THM; "BANACH_FIX_ITER",BANACH_FIX_ITER; "BANACH_SPROPERTY_IMP_FINITE_PREIMAGES",BANACH_SPROPERTY_IMP_FINITE_PREIMAGES; "BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY",BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY; "BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY_OUTER",BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY_OUTER; "BANACH_SPROPERTY_IMP_PRESERVES_MEASURABLE",BANACH_SPROPERTY_IMP_PRESERVES_MEASURABLE; "BANACH_SPROPERTY_OUTER",BANACH_SPROPERTY_OUTER; "BANACH_ZARECKI",BANACH_ZARECKI; "BANACH_ZARECKI_GEN",BANACH_ZARECKI_GEN; "BARYCENTRE_0",BARYCENTRE_0; "BARYCENTRE_1",BARYCENTRE_1; "BARYCENTRE_2",BARYCENTRE_2; "BARYCENTRE_IN_AFFINE_HULL",BARYCENTRE_IN_AFFINE_HULL; "BARYCENTRE_IN_CONVEX_HULL",BARYCENTRE_IN_CONVEX_HULL; "BARYCENTRE_IN_RELATIVE_INTERIOR",BARYCENTRE_IN_RELATIVE_INTERIOR; "BARYCENTRE_LINEAR_IMAGE",BARYCENTRE_LINEAR_IMAGE; "BARYCENTRE_NOT_IN_SET",BARYCENTRE_NOT_IN_SET; "BARYCENTRE_TRANSLATION",BARYCENTRE_TRANSLATION; "BASIS_CARD_EQ_DIM",BASIS_CARD_EQ_DIM; "BASIS_COMPONENT",BASIS_COMPONENT; "BASIS_COORDINATES_CONTINUOUS",BASIS_COORDINATES_CONTINUOUS; "BASIS_COORDINATES_LIPSCHITZ",BASIS_COORDINATES_LIPSCHITZ; "BASIS_EQ_0",BASIS_EQ_0; "BASIS_EXISTS",BASIS_EXISTS; "BASIS_EXISTS_FINITE",BASIS_EXISTS_FINITE; "BASIS_EXPANSION",BASIS_EXPANSION; "BASIS_EXPANSION_UNIQUE",BASIS_EXPANSION_UNIQUE; "BASIS_HAS_SIZE_DIM",BASIS_HAS_SIZE_DIM; "BASIS_HAS_SIZE_UNIV",BASIS_HAS_SIZE_UNIV; "BASIS_INJ",BASIS_INJ; "BASIS_INJ_EQ",BASIS_INJ_EQ; "BASIS_NE",BASIS_NE; "BASIS_NONZERO",BASIS_NONZERO; "BASIS_ORTHOGONAL",BASIS_ORTHOGONAL; "BASIS_SUBSPACE_EXISTS",BASIS_SUBSPACE_EXISTS; "BEPPO_LEVI_DECREASING",BEPPO_LEVI_DECREASING; "BEPPO_LEVI_INCREASING",BEPPO_LEVI_INCREASING; "BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING; "BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE; "BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING; "BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE; "BERNOULLI",BERNOULLI; "BERNOULLI_1",BERNOULLI_1; "BERNOULLI_1_0",BERNOULLI_1_0; "BERNOULLI_ADD",BERNOULLI_ADD; "BERNOULLI_ALT",BERNOULLI_ALT; "BERNOULLI_BOUND",BERNOULLI_BOUND; "BERNOULLI_EVEN_BOUND",BERNOULLI_EVEN_BOUND; "BERNOULLI_EXPANSION",BERNOULLI_EXPANSION; "BERNOULLI_HALF",BERNOULLI_HALF; "BERNOULLI_NUMBER",BERNOULLI_NUMBER; "BERNOULLI_NUMBER_ALT",BERNOULLI_NUMBER_ALT; "BERNOULLI_NUMBER_EQ_0",BERNOULLI_NUMBER_EQ_0; "BERNOULLI_NUMBER_ZERO",BERNOULLI_NUMBER_ZERO; "BERNOULLI_RAABE_2",BERNOULLI_RAABE_2; "BERNOULLI_REFLECT",BERNOULLI_REFLECT; "BERNOULLI_SUB_ADD1",BERNOULLI_SUB_ADD1; "BERNOULLI_UNIQUE",BERNOULLI_UNIQUE; "BERNSTEIN_LEMMA",BERNSTEIN_LEMMA; "BERNSTEIN_POS",BERNSTEIN_POS; "BERNSTEIN_WEIERSTRASS",BERNSTEIN_WEIERSTRASS; "BESSEL_INEQUALITY",BESSEL_INEQUALITY; "BETA_THM",BETA_THM; "BETWEEN_1",BETWEEN_1; "BETWEEN_ANTISYM",BETWEEN_ANTISYM; "BETWEEN_CMUL_LIFT",BETWEEN_CMUL_LIFT; "BETWEEN_COLLINEAR_DIST_EQ",BETWEEN_COLLINEAR_DIST_EQ; "BETWEEN_DIST_LE",BETWEEN_DIST_LE; "BETWEEN_DIST_LT",BETWEEN_DIST_LT; "BETWEEN_DOT",BETWEEN_DOT; "BETWEEN_EXISTS_EXTENSION",BETWEEN_EXISTS_EXTENSION; "BETWEEN_IMP_COLLINEAR",BETWEEN_IMP_COLLINEAR; "BETWEEN_IN_CONVEX_HULL",BETWEEN_IN_CONVEX_HULL; "BETWEEN_IN_SEGMENT",BETWEEN_IN_SEGMENT; "BETWEEN_LINEAR_IMAGE_EQ",BETWEEN_LINEAR_IMAGE_EQ; "BETWEEN_MIDPOINT",BETWEEN_MIDPOINT; "BETWEEN_NORM",BETWEEN_NORM; "BETWEEN_NORM_LE",BETWEEN_NORM_LE; "BETWEEN_NORM_LT",BETWEEN_NORM_LT; "BETWEEN_REFL",BETWEEN_REFL; "BETWEEN_REFL_EQ",BETWEEN_REFL_EQ; "BETWEEN_RESTRICTED_CASES",BETWEEN_RESTRICTED_CASES; "BETWEEN_SYM",BETWEEN_SYM; "BETWEEN_TRANS",BETWEEN_TRANS; "BETWEEN_TRANSLATION",BETWEEN_TRANSLATION; "BETWEEN_TRANS_2",BETWEEN_TRANS_2; "BICONNECTED_IMP_CONTINUOUS_ON",BICONNECTED_IMP_CONTINUOUS_ON; "BIJ",BIJ; "BIJECTIONS_CARD_EQ",BIJECTIONS_CARD_EQ; "BIJECTIONS_HAS_SIZE",BIJECTIONS_HAS_SIZE; "BIJECTIONS_HAS_SIZE_EQ",BIJECTIONS_HAS_SIZE_EQ; "BIJECTIVE_INJECTIVE_SURJECTIVE",BIJECTIVE_INJECTIVE_SURJECTIVE; "BIJECTIVE_INVERSES",BIJECTIVE_INVERSES; "BIJECTIVE_LEFT_RIGHT_INVERSE",BIJECTIVE_LEFT_RIGHT_INVERSE; "BIJECTIVE_ON_LEFT_RIGHT_INVERSE",BIJECTIVE_ON_LEFT_RIGHT_INVERSE; "BILINEAR_BOUNDED",BILINEAR_BOUNDED; "BILINEAR_BOUNDED_POS",BILINEAR_BOUNDED_POS; "BILINEAR_COMPLEX_MUL",BILINEAR_COMPLEX_MUL; "BILINEAR_CONTINUOUS_COMPOSE",BILINEAR_CONTINUOUS_COMPOSE; "BILINEAR_CONTINUOUS_ON",BILINEAR_CONTINUOUS_ON; "BILINEAR_CONTINUOUS_ON_COMPOSE",BILINEAR_CONTINUOUS_ON_COMPOSE; "BILINEAR_DIFFERENTIABLE_AT_COMPOSE",BILINEAR_DIFFERENTIABLE_AT_COMPOSE; "BILINEAR_DIFFERENTIABLE_ON_COMPOSE",BILINEAR_DIFFERENTIABLE_ON_COMPOSE; "BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE",BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE; "BILINEAR_DOT",BILINEAR_DOT; "BILINEAR_DROP_MUL",BILINEAR_DROP_MUL; "BILINEAR_EPSILON_DELTA",BILINEAR_EPSILON_DELTA; "BILINEAR_EQ",BILINEAR_EQ; "BILINEAR_EQ_MBASIS",BILINEAR_EQ_MBASIS; "BILINEAR_EQ_STDBASIS",BILINEAR_EQ_STDBASIS; "BILINEAR_GEOM",BILINEAR_GEOM; "BILINEAR_INNER",BILINEAR_INNER; "BILINEAR_LADD",BILINEAR_LADD; "BILINEAR_LIFT_MUL",BILINEAR_LIFT_MUL; "BILINEAR_LMUL",BILINEAR_LMUL; "BILINEAR_LNEG",BILINEAR_LNEG; "BILINEAR_LSUB",BILINEAR_LSUB; "BILINEAR_LSUM",BILINEAR_LSUM; "BILINEAR_LZERO",BILINEAR_LZERO; "BILINEAR_MUL_DROP",BILINEAR_MUL_DROP; "BILINEAR_OUTER",BILINEAR_OUTER; "BILINEAR_PRODUCT",BILINEAR_PRODUCT; "BILINEAR_RADD",BILINEAR_RADD; "BILINEAR_RMUL",BILINEAR_RMUL; "BILINEAR_RNEG",BILINEAR_RNEG; "BILINEAR_RSUB",BILINEAR_RSUB; "BILINEAR_RSUM",BILINEAR_RSUM; "BILINEAR_RZERO",BILINEAR_RZERO; "BILINEAR_SWAP",BILINEAR_SWAP; "BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE",BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE; "BILINEAR_VSUM",BILINEAR_VSUM; "BILINEAR_VSUM_CONVOLUTION_1",BILINEAR_VSUM_CONVOLUTION_1; "BILINEAR_VSUM_CONVOLUTION_2",BILINEAR_VSUM_CONVOLUTION_2; "BILINEAR_VSUM_PARTIAL_PRE",BILINEAR_VSUM_PARTIAL_PRE; "BILINEAR_VSUM_PARTIAL_SUC",BILINEAR_VSUM_PARTIAL_SUC; "BILIPSCHITZ_HOMEOMORPHISM_RELATIVE_FRONTIERS",BILIPSCHITZ_HOMEOMORPHISM_RELATIVE_FRONTIERS; "BILIPSCHITZ_HOMEOMORPHISM_SPHERICAL_PROJECTION",BILIPSCHITZ_HOMEOMORPHISM_SPHERICAL_PROJECTION; "BINARYSUM_BITSET",BINARYSUM_BITSET; "BINARYSUM_BOUND",BINARYSUM_BOUND; "BINARYSUM_BOUND_EQ",BINARYSUM_BOUND_EQ; "BINARYSUM_BOUND_LEMMA",BINARYSUM_BOUND_LEMMA; "BINARYSUM_DIV",BINARYSUM_DIV; "BINARYSUM_DIV_DIVISIBLE",BINARYSUM_DIV_DIVISIBLE; "BINARY_INDUCT",BINARY_INDUCT; "BINOM",BINOM; "BINOMIAL_THEOREM",BINOMIAL_THEOREM; "BINOM_0",BINOM_0; "BINOM_1",BINOM_1; "BINOM_BOTH_STEP",BINOM_BOTH_STEP; "BINOM_BOTH_STEP_DOWN",BINOM_BOTH_STEP_DOWN; "BINOM_BOTH_STEP_REAL",BINOM_BOTH_STEP_REAL; "BINOM_BOTTOM_STEP",BINOM_BOTTOM_STEP; "BINOM_BOTTOM_STEP_REAL",BINOM_BOTTOM_STEP_REAL; "BINOM_EQ_0",BINOM_EQ_0; "BINOM_FACT",BINOM_FACT; "BINOM_GE_TOP",BINOM_GE_TOP; "BINOM_LT",BINOM_LT; "BINOM_MUL_SHIFT",BINOM_MUL_SHIFT; "BINOM_PENULT",BINOM_PENULT; "BINOM_REFL",BINOM_REFL; "BINOM_SYM",BINOM_SYM; "BINOM_TOP_STEP",BINOM_TOP_STEP; "BINOM_TOP_STEP_REAL",BINOM_TOP_STEP_REAL; "BIT0",BIT0; "BIT0_DEF",BIT0_DEF; "BIT0_THM",BIT0_THM; "BIT1",BIT1; "BIT1_DEF",BIT1_DEF; "BIT1_THM",BIT1_THM; "BITSET_0",BITSET_0; "BITSET_BINARYSUM",BITSET_BINARYSUM; "BITSET_BOUND",BITSET_BOUND; "BITSET_BOUND_EQ",BITSET_BOUND_EQ; "BITSET_BOUND_LEMMA",BITSET_BOUND_LEMMA; "BITSET_BOUND_WEAK",BITSET_BOUND_WEAK; "BITSET_EQ",BITSET_EQ; "BITSET_EQ_EMPTY",BITSET_EQ_EMPTY; "BITSET_STEP",BITSET_STEP; "BLASCHKE",BLASCHKE; "BLASCHKE_UNIV",BLASCHKE_UNIV; "BLOCH",BLOCH; "BLOCH_COROLLARY",BLOCH_COROLLARY; "BLOCH_LEMMA",BLOCH_LEMMA; "BLOCH_UNIT",BLOCH_UNIT; "BOHL",BOHL; "BOHL_ALT",BOHL_ALT; "BOHL_SIMPLE",BOHL_SIMPLE; "BOLZANO_WEIERSTRASS",BOLZANO_WEIERSTRASS; "BOLZANO_WEIERSTRASS_CONTRAPOS",BOLZANO_WEIERSTRASS_CONTRAPOS; "BOLZANO_WEIERSTRASS_IMP_BOUNDED",BOLZANO_WEIERSTRASS_IMP_BOUNDED; "BOLZANO_WEIERSTRASS_IMP_CLOSED",BOLZANO_WEIERSTRASS_IMP_CLOSED; "BOOL_CASES_AX",BOOL_CASES_AX; "BOREL_BOREL_MEASURABLE_PREIMAGE",BOREL_BOREL_MEASURABLE_PREIMAGE; "BOREL_COMPLEMENT",BOREL_COMPLEMENT; "BOREL_DIFF",BOREL_DIFF; "BOREL_DOMAIN_OF_INJECTIVITY",BOREL_DOMAIN_OF_INJECTIVITY; "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS; "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN; "BOREL_EMPTY",BOREL_EMPTY; "BOREL_IMP_ANALYTIC",BOREL_IMP_ANALYTIC; "BOREL_IMP_LEBESGUE_MEASURABLE",BOREL_IMP_LEBESGUE_MEASURABLE; "BOREL_INDUCT_CLOSED_UNIONS_INTERS",BOREL_INDUCT_CLOSED_UNIONS_INTERS; "BOREL_INDUCT_COMPACT",BOREL_INDUCT_COMPACT; "BOREL_INDUCT_COMPACT_ALT",BOREL_INDUCT_COMPACT_ALT; "BOREL_INDUCT_COMPACT_DIFF",BOREL_INDUCT_COMPACT_DIFF; "BOREL_INDUCT_COMPACT_UNIONS_INTERS",BOREL_INDUCT_COMPACT_UNIONS_INTERS; "BOREL_INDUCT_OPEN_UNIONS_INTERS",BOREL_INDUCT_OPEN_UNIONS_INTERS; "BOREL_INDUCT_UNIONS_INTERS",BOREL_INDUCT_UNIONS_INTERS; "BOREL_INTER",BOREL_INTER; "BOREL_INTERS",BOREL_INTERS; "BOREL_LINEAR_IMAGE",BOREL_LINEAR_IMAGE; "BOREL_MEASURABLE_ADD",BOREL_MEASURABLE_ADD; "BOREL_MEASURABLE_BILINEAR",BOREL_MEASURABLE_BILINEAR; "BOREL_MEASURABLE_CASES",BOREL_MEASURABLE_CASES; "BOREL_MEASURABLE_CMUL",BOREL_MEASURABLE_CMUL; "BOREL_MEASURABLE_COMPONENTWISE",BOREL_MEASURABLE_COMPONENTWISE; "BOREL_MEASURABLE_COMPOSE",BOREL_MEASURABLE_COMPOSE; "BOREL_MEASURABLE_CONST",BOREL_MEASURABLE_CONST; "BOREL_MEASURABLE_CONTINUOUS_COMPOSE",BOREL_MEASURABLE_CONTINUOUS_COMPOSE; "BOREL_MEASURABLE_EQ",BOREL_MEASURABLE_EQ; "BOREL_MEASURABLE_EXTENSION",BOREL_MEASURABLE_EXTENSION; "BOREL_MEASURABLE_IMP_MEASURABLE_ON",BOREL_MEASURABLE_IMP_MEASURABLE_ON; "BOREL_MEASURABLE_INDICATOR",BOREL_MEASURABLE_INDICATOR; "BOREL_MEASURABLE_MAX",BOREL_MEASURABLE_MAX; "BOREL_MEASURABLE_MIN",BOREL_MEASURABLE_MIN; "BOREL_MEASURABLE_MUL",BOREL_MEASURABLE_MUL; "BOREL_MEASURABLE_NORM",BOREL_MEASURABLE_NORM; "BOREL_MEASURABLE_ON_INDICATOR",BOREL_MEASURABLE_ON_INDICATOR; "BOREL_MEASURABLE_ON_SUBSET",BOREL_MEASURABLE_ON_SUBSET; "BOREL_MEASURABLE_PASTECART",BOREL_MEASURABLE_PASTECART; "BOREL_MEASURABLE_PREIMAGE_BOREL",BOREL_MEASURABLE_PREIMAGE_BOREL; "BOREL_MEASURABLE_PRODUCT",BOREL_MEASURABLE_PRODUCT; "BOREL_MEASURABLE_RESTRICT",BOREL_MEASURABLE_RESTRICT; "BOREL_MEASURABLE_SUB",BOREL_MEASURABLE_SUB; "BOREL_MEASURABLE_VSUM",BOREL_MEASURABLE_VSUM; "BOREL_PCROSS",BOREL_PCROSS; "BOREL_PCROSS_EQ",BOREL_PCROSS_EQ; "BOREL_POINTS_OF_DIFFERENTIABILITY",BOREL_POINTS_OF_DIFFERENTIABILITY; "BOREL_PREIMAGE_FINITE",BOREL_PREIMAGE_FINITE; "BOREL_PREIMAGE_HAS_SIZE",BOREL_PREIMAGE_HAS_SIZE; "BOREL_PREIMAGE_INFINITE",BOREL_PREIMAGE_INFINITE; "BOREL_TRANSLATION",BOREL_TRANSLATION; "BOREL_UNION",BOREL_UNION; "BOREL_UNIONS",BOREL_UNIONS; "BOREL_UNIV",BOREL_UNIV; "BORSUKIAN_1",BORSUKIAN_1; "BORSUKIAN_1_GEN",BORSUKIAN_1_GEN; "BORSUKIAN_ALT",BORSUKIAN_ALT; "BORSUKIAN_CIRCLE",BORSUKIAN_CIRCLE; "BORSUKIAN_CIRCLE_ALT",BORSUKIAN_CIRCLE_ALT; "BORSUKIAN_CLOSED_UNION",BORSUKIAN_CLOSED_UNION; "BORSUKIAN_COMPONENTWISE",BORSUKIAN_COMPONENTWISE; "BORSUKIAN_COMPONENTWISE_EQ",BORSUKIAN_COMPONENTWISE_EQ; "BORSUKIAN_CONTINUOUS_LOGARITHM",BORSUKIAN_CONTINUOUS_LOGARITHM; "BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE",BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE; "BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX",BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX; "BORSUKIAN_EMPTY",BORSUKIAN_EMPTY; "BORSUKIAN_EQ_SIMPLY_CONNECTED",BORSUKIAN_EQ_SIMPLY_CONNECTED; "BORSUKIAN_IMP_UNICOHERENT",BORSUKIAN_IMP_UNICOHERENT; "BORSUKIAN_INJECTIVE_LINEAR_IMAGE",BORSUKIAN_INJECTIVE_LINEAR_IMAGE; "BORSUKIAN_MONOTONE_IMAGE_COMPACT",BORSUKIAN_MONOTONE_IMAGE_COMPACT; "BORSUKIAN_OPEN_MAP_IMAGE_COMPACT",BORSUKIAN_OPEN_MAP_IMAGE_COMPACT; "BORSUKIAN_OPEN_UNION",BORSUKIAN_OPEN_UNION; "BORSUKIAN_RETRACTION_GEN",BORSUKIAN_RETRACTION_GEN; "BORSUKIAN_SEPARATION_COMPACT",BORSUKIAN_SEPARATION_COMPACT; "BORSUKIAN_SEPARATION_OPEN_CLOSED",BORSUKIAN_SEPARATION_OPEN_CLOSED; "BORSUKIAN_SPHERE",BORSUKIAN_SPHERE; "BORSUKIAN_TRANSLATION",BORSUKIAN_TRANSLATION; "BORSUKIAN_UNIV",BORSUKIAN_UNIV; "BORSUK_HOMOTOPY_EXTENSION",BORSUK_HOMOTOPY_EXTENSION; "BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC",BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC; "BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ",BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ; "BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT",BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT; "BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT",BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT; "BORSUK_MAP_INTO_SPHERE",BORSUK_MAP_INTO_SPHERE; "BORSUK_SEPARATION_THEOREM",BORSUK_SEPARATION_THEOREM; "BORSUK_SEPARATION_THEOREM_GEN",BORSUK_SEPARATION_THEOREM_GEN; "BOTTOM",BOTTOM; "BOUNDARY_BUMPING_THEOREM",BOUNDARY_BUMPING_THEOREM; "BOUNDARY_BUMPING_THEOREM_ALT",BOUNDARY_BUMPING_THEOREM_ALT; "BOUNDARY_BUMPING_THEOREM_CLOSED",BOUNDARY_BUMPING_THEOREM_CLOSED; "BOUNDARY_BUMPING_THEOREM_INTER",BOUNDARY_BUMPING_THEOREM_INTER; "BOUNDARY_BUMPING_THEOREM_INTER_ALT",BOUNDARY_BUMPING_THEOREM_INTER_ALT; "BOUNDARY_BUMPING_THEOREM_OPEN",BOUNDARY_BUMPING_THEOREM_OPEN; "BOUNDARY_BUMPING_THEOREM_OPEN_ALT",BOUNDARY_BUMPING_THEOREM_OPEN_ALT; "BOUNDED_AFFINITY",BOUNDED_AFFINITY; "BOUNDED_AFFINITY_EQ",BOUNDED_AFFINITY_EQ; "BOUNDED_AND_DIAMETER_LE",BOUNDED_AND_DIAMETER_LE; "BOUNDED_ARC_IMAGE",BOUNDED_ARC_IMAGE; "BOUNDED_BALL",BOUNDED_BALL; "BOUNDED_CBALL",BOUNDED_CBALL; "BOUNDED_CLOSED_CHAIN",BOUNDED_CLOSED_CHAIN; "BOUNDED_CLOSED_IMP_COMPACT",BOUNDED_CLOSED_IMP_COMPACT; "BOUNDED_CLOSED_INTERVAL",BOUNDED_CLOSED_INTERVAL; "BOUNDED_CLOSED_NEST",BOUNDED_CLOSED_NEST; "BOUNDED_CLOSURE",BOUNDED_CLOSURE; "BOUNDED_CLOSURE_EQ",BOUNDED_CLOSURE_EQ; "BOUNDED_COMMON_FRONTIER_DOMAINS",BOUNDED_COMMON_FRONTIER_DOMAINS; "BOUNDED_COMPONENTS_INSIDE",BOUNDED_COMPONENTS_INSIDE; "BOUNDED_COMPONENTWISE",BOUNDED_COMPONENTWISE; "BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS",BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS; "BOUNDED_CONVEX_HULL",BOUNDED_CONVEX_HULL; "BOUNDED_CONVEX_HULL_EQ",BOUNDED_CONVEX_HULL_EQ; "BOUNDED_DECREASING_CONVERGENT",BOUNDED_DECREASING_CONVERGENT; "BOUNDED_DELETE",BOUNDED_DELETE; "BOUNDED_DIFF",BOUNDED_DIFF; "BOUNDED_DIFFS",BOUNDED_DIFFS; "BOUNDED_EMPTY",BOUNDED_EMPTY; "BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION",BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION; "BOUNDED_EQ_BOLZANO_WEIERSTRASS",BOUNDED_EQ_BOLZANO_WEIERSTRASS; "BOUNDED_EQ_TOTALLY_BOUNDED",BOUNDED_EQ_TOTALLY_BOUNDED; "BOUNDED_FINITE",BOUNDED_FINITE; "BOUNDED_FRONTIER",BOUNDED_FRONTIER; "BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED",BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED; "BOUNDED_FUNCTIONS_BIJECTIONS_1",BOUNDED_FUNCTIONS_BIJECTIONS_1; "BOUNDED_FUNCTIONS_BIJECTIONS_2",BOUNDED_FUNCTIONS_BIJECTIONS_2; "BOUNDED_HALFSPACE_GE",BOUNDED_HALFSPACE_GE; "BOUNDED_HALFSPACE_GT",BOUNDED_HALFSPACE_GT; "BOUNDED_HALFSPACE_LE",BOUNDED_HALFSPACE_LE; "BOUNDED_HALFSPACE_LT",BOUNDED_HALFSPACE_LT; "BOUNDED_HAS_INF",BOUNDED_HAS_INF; "BOUNDED_HAS_SUP",BOUNDED_HAS_SUP; "BOUNDED_HYPERPLANE_EQ_TRIVIAL",BOUNDED_HYPERPLANE_EQ_TRIVIAL; "BOUNDED_IMAGE_IN_COMPACTIFICATION",BOUNDED_IMAGE_IN_COMPACTIFICATION; "BOUNDED_INCREASING_CONVERGENT",BOUNDED_INCREASING_CONVERGENT; "BOUNDED_INSERT",BOUNDED_INSERT; "BOUNDED_INSIDE",BOUNDED_INSIDE; "BOUNDED_INTEGRALS_OVER_SUBINTERVALS",BOUNDED_INTEGRALS_OVER_SUBINTERVALS; "BOUNDED_INTER",BOUNDED_INTER; "BOUNDED_INTERIOR",BOUNDED_INTERIOR; "BOUNDED_INTERS",BOUNDED_INTERS; "BOUNDED_INTERVAL",BOUNDED_INTERVAL; "BOUNDED_LIFT",BOUNDED_LIFT; "BOUNDED_LINEAR_IMAGE",BOUNDED_LINEAR_IMAGE; "BOUNDED_LINEAR_IMAGE_EQ",BOUNDED_LINEAR_IMAGE_EQ; "BOUNDED_LIPSCHITZ_IMAGE",BOUNDED_LIPSCHITZ_IMAGE; "BOUNDED_NEGATIONS",BOUNDED_NEGATIONS; "BOUNDED_NORM_IMAGE",BOUNDED_NORM_IMAGE; "BOUNDED_PARTIAL_REAL_SUMS",BOUNDED_PARTIAL_REAL_SUMS; "BOUNDED_PARTIAL_SUMS",BOUNDED_PARTIAL_SUMS; "BOUNDED_PATH_IMAGE",BOUNDED_PATH_IMAGE; "BOUNDED_PCROSS",BOUNDED_PCROSS; "BOUNDED_PCROSS_EQ",BOUNDED_PCROSS_EQ; "BOUNDED_POS",BOUNDED_POS; "BOUNDED_POS_LT",BOUNDED_POS_LT; "BOUNDED_RECTIFIABLE_PATH_IMAGE",BOUNDED_RECTIFIABLE_PATH_IMAGE; "BOUNDED_RELATIVE_FRONTIER",BOUNDED_RELATIVE_FRONTIER; "BOUNDED_RELATIVE_INTERIOR",BOUNDED_RELATIVE_INTERIOR; "BOUNDED_SCALING",BOUNDED_SCALING; "BOUNDED_SCALING_EQ",BOUNDED_SCALING_EQ; "BOUNDED_SEGMENT",BOUNDED_SEGMENT; "BOUNDED_SEPARATION_1D",BOUNDED_SEPARATION_1D; "BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE; "BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL; "BOUNDED_SET_VARIATION_FROM_PASTECART",BOUNDED_SET_VARIATION_FROM_PASTECART; "BOUNDED_SET_VARIATION_ON_PASTECART",BOUNDED_SET_VARIATION_ON_PASTECART; "BOUNDED_SIMPLE_PATH_IMAGE",BOUNDED_SIMPLE_PATH_IMAGE; "BOUNDED_SING",BOUNDED_SING; "BOUNDED_SLICE",BOUNDED_SLICE; "BOUNDED_SPHERE",BOUNDED_SPHERE; "BOUNDED_SUBSET",BOUNDED_SUBSET; "BOUNDED_SUBSET_BALL",BOUNDED_SUBSET_BALL; "BOUNDED_SUBSET_CBALL",BOUNDED_SUBSET_CBALL; "BOUNDED_SUBSET_CLOSED_INTERVAL",BOUNDED_SUBSET_CLOSED_INTERVAL; "BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC; "BOUNDED_SUBSET_OPEN_INTERVAL",BOUNDED_SUBSET_OPEN_INTERVAL; "BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC; "BOUNDED_SUMS",BOUNDED_SUMS; "BOUNDED_SUMS_IMAGE",BOUNDED_SUMS_IMAGE; "BOUNDED_SUMS_IMAGES",BOUNDED_SUMS_IMAGES; "BOUNDED_TRANSLATION",BOUNDED_TRANSLATION; "BOUNDED_TRANSLATION_EQ",BOUNDED_TRANSLATION_EQ; "BOUNDED_ULC_IMP_FCCOVERABLE",BOUNDED_ULC_IMP_FCCOVERABLE; "BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE",BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE; "BOUNDED_UNION",BOUNDED_UNION; "BOUNDED_UNIONS",BOUNDED_UNIONS; "BOUNDED_UNIQUE_OUTSIDE",BOUNDED_UNIQUE_OUTSIDE; "BOUNDED_VALID_PATH_IMAGE",BOUNDED_VALID_PATH_IMAGE; "BOUNDED_VARIATION_FROM_PASTECART",BOUNDED_VARIATION_FROM_PASTECART; "BOUNDED_VECTOR_VARIATION_ON_PASTECART",BOUNDED_VECTOR_VARIATION_ON_PASTECART; "BOUNDED_WITH_INSIDE",BOUNDED_WITH_INSIDE; "BOUNDS_DIVIDED",BOUNDS_DIVIDED; "BOUNDS_IGNORE",BOUNDS_IGNORE; "BOUNDS_LINEAR",BOUNDS_LINEAR; "BOUNDS_LINEAR_0",BOUNDS_LINEAR_0; "BOUNDS_NOTZERO",BOUNDS_NOTZERO; "BROUWER",BROUWER; "BROUWER_ABSOLUTE_RETRACT",BROUWER_ABSOLUTE_RETRACT; "BROUWER_ABSOLUTE_RETRACT_GEN",BROUWER_ABSOLUTE_RETRACT_GEN; "BROUWER_AR",BROUWER_AR; "BROUWER_BALL",BROUWER_BALL; "BROUWER_CONTRACTIBLE_ANR",BROUWER_CONTRACTIBLE_ANR; "BROUWER_CUBE",BROUWER_CUBE; "BROUWER_DEGREE2_HOMOTOPY_INVARIANCE_LEMMA",BROUWER_DEGREE2_HOMOTOPY_INVARIANCE_LEMMA; "BROUWER_DEGREE3_LINEAR",BROUWER_DEGREE3_LINEAR; "BROUWER_DEGREE3_LINEAR_GEN",BROUWER_DEGREE3_LINEAR_GEN; "BROUWER_DEGREE3_PERTURB",BROUWER_DEGREE3_PERTURB; "BROUWER_DEGREE3_POINT_INDEPENDENCE",BROUWER_DEGREE3_POINT_INDEPENDENCE; "BROUWER_FACTOR_THROUGH_AR",BROUWER_FACTOR_THROUGH_AR; "BROUWER_INESSENTIAL_ANR",BROUWER_INESSENTIAL_ANR; "BROUWER_REDUCTION_THEOREM",BROUWER_REDUCTION_THEOREM; "BROUWER_REDUCTION_THEOREM_GEN",BROUWER_REDUCTION_THEOREM_GEN; "BROUWER_SURJECTIVE",BROUWER_SURJECTIVE; "BROUWER_SURJECTIVE_CBALL",BROUWER_SURJECTIVE_CBALL; "BROUWER_WEAK",BROUWER_WEAK; "BUTLAST",BUTLAST; "BUTLAST_APPEND",BUTLAST_APPEND; "CACS_0",CACS_0; "CACS_1",CACS_1; "CACS_BODY_LEMMA",CACS_BODY_LEMMA; "CACS_BOUNDS",CACS_BOUNDS; "CACS_CASN_SQRT_POS",CACS_CASN_SQRT_POS; "CACS_CCOS",CACS_CCOS; "CACS_NEG_1",CACS_NEG_1; "CACS_RANGE_LEMMA",CACS_RANGE_LEMMA; "CACS_UNIQUE",CACS_UNIQUE; "CANTOR_BAIRE_STATIONARY_PRINCIPLE",CANTOR_BAIRE_STATIONARY_PRINCIPLE; "CANTOR_BENDIXSON",CANTOR_BENDIXSON; "CANTOR_BENDIXSON_GEN",CANTOR_BENDIXSON_GEN; "CANTOR_THM",CANTOR_THM; "CANTOR_THM_UNIV",CANTOR_THM_UNIV; "CARATHEODORY",CARATHEODORY; "CARATHEODORY_AFF_DIM",CARATHEODORY_AFF_DIM; "CARATHEODORY_CONFORMAL_EXTENSION_LEMMA",CARATHEODORY_CONFORMAL_EXTENSION_LEMMA; "CARATHEODORY_CONFORMAL_EXTENSION_THEOREM",CARATHEODORY_CONFORMAL_EXTENSION_THEOREM; "CARD",CARD; "CARD_ADD2_ABSORB_LE",CARD_ADD2_ABSORB_LE; "CARD_ADD2_ABSORB_LT",CARD_ADD2_ABSORB_LT; "CARD_ADD_ABSORB_LE",CARD_ADD_ABSORB_LE; "CARD_ADD_ABSORB_LEFT",CARD_ADD_ABSORB_LEFT; "CARD_ADD_ABSORB_RIGHT",CARD_ADD_ABSORB_RIGHT; "CARD_ADD_ASSOC",CARD_ADD_ASSOC; "CARD_ADD_C",CARD_ADD_C; "CARD_ADD_CONG",CARD_ADD_CONG; "CARD_ADD_FINITE",CARD_ADD_FINITE; "CARD_ADD_FINITE_EQ",CARD_ADD_FINITE_EQ; "CARD_ADD_LE_MUL_INFINITE",CARD_ADD_LE_MUL_INFINITE; "CARD_ADD_SYM",CARD_ADD_SYM; "CARD_ADD_SYMDIFF_INTER",CARD_ADD_SYMDIFF_INTER; "CARD_BOOL",CARD_BOOL; "CARD_CART",CARD_CART; "CARD_CART_UNIV",CARD_CART_UNIV; "CARD_CIRCLE_INTERSECTION_LE",CARD_CIRCLE_INTERSECTION_LE; "CARD_CLAUSES",CARD_CLAUSES; "CARD_COLUMNS_LE",CARD_COLUMNS_LE; "CARD_COMPLEX_ROOTS_UNITY",CARD_COMPLEX_ROOTS_UNITY; "CARD_COMPONENTS_COMPLEMENT_CONVEX",CARD_COMPONENTS_COMPLEMENT_CONVEX; "CARD_COUNTABLE_CONG",CARD_COUNTABLE_CONG; "CARD_CROSS",CARD_CROSS; "CARD_DELETE",CARD_DELETE; "CARD_DIFF",CARD_DIFF; "CARD_DIFF_ABSORB",CARD_DIFF_ABSORB; "CARD_DIFF_INTER",CARD_DIFF_INTER; "CARD_DISJOINT_UNION",CARD_DISJOINT_UNION; "CARD_EMPTY_LE",CARD_EMPTY_LE; "CARD_EQ_0",CARD_EQ_0; "CARD_EQ_ANALYTIC_SETS",CARD_EQ_ANALYTIC_SETS; "CARD_EQ_ARC_IMAGE",CARD_EQ_ARC_IMAGE; "CARD_EQ_BAIRE_FUNCTIONS",CARD_EQ_BAIRE_FUNCTIONS; "CARD_EQ_BALL",CARD_EQ_BALL; "CARD_EQ_BIJECTION",CARD_EQ_BIJECTION; "CARD_EQ_BIJECTIONS",CARD_EQ_BIJECTIONS; "CARD_EQ_BOREL_MEASURABLE_FUNCTIONS",CARD_EQ_BOREL_MEASURABLE_FUNCTIONS; "CARD_EQ_BOREL_SETS",CARD_EQ_BOREL_SETS; "CARD_EQ_CARD",CARD_EQ_CARD; "CARD_EQ_CARD_IMP",CARD_EQ_CARD_IMP; "CARD_EQ_CART",CARD_EQ_CART; "CARD_EQ_CBALL",CARD_EQ_CBALL; "CARD_EQ_CLOSED",CARD_EQ_CLOSED; "CARD_EQ_CLOSED_SETS",CARD_EQ_CLOSED_SETS; "CARD_EQ_COMPACT_SETS",CARD_EQ_COMPACT_SETS; "CARD_EQ_CONDENSATION_POINTS",CARD_EQ_CONDENSATION_POINTS; "CARD_EQ_CONDENSATION_POINTS_IN_SET",CARD_EQ_CONDENSATION_POINTS_IN_SET; "CARD_EQ_CONG",CARD_EQ_CONG; "CARD_EQ_CONNECTED",CARD_EQ_CONNECTED; "CARD_EQ_CONVEX",CARD_EQ_CONVEX; "CARD_EQ_COUNTABLE",CARD_EQ_COUNTABLE; "CARD_EQ_COUNTABLE_SUBSETS_REAL",CARD_EQ_COUNTABLE_SUBSETS_REAL; "CARD_EQ_COUNTABLE_SUBSETS_SUBREAL",CARD_EQ_COUNTABLE_SUBSETS_SUBREAL; "CARD_EQ_COVERING_MAP_FIBRES",CARD_EQ_COVERING_MAP_FIBRES; "CARD_EQ_DIM",CARD_EQ_DIM; "CARD_EQ_EMPTY",CARD_EQ_EMPTY; "CARD_EQ_EUCLIDEAN",CARD_EQ_EUCLIDEAN; "CARD_EQ_FINITE",CARD_EQ_FINITE; "CARD_EQ_FINITE_SUBSETS",CARD_EQ_FINITE_SUBSETS; "CARD_EQ_FSIGMA_SETS",CARD_EQ_FSIGMA_SETS; "CARD_EQ_FULLSIZE_POWERSET",CARD_EQ_FULLSIZE_POWERSET; "CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS",CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS; "CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE",CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE; "CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT",CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT; "CARD_EQ_GDELTA_SETS",CARD_EQ_GDELTA_SETS; "CARD_EQ_IMAGE",CARD_EQ_IMAGE; "CARD_EQ_IMP_LE",CARD_EQ_IMP_LE; "CARD_EQ_INTEGER",CARD_EQ_INTEGER; "CARD_EQ_INTERVAL",CARD_EQ_INTERVAL; "CARD_EQ_LIMITED_POWERSET",CARD_EQ_LIMITED_POWERSET; "CARD_EQ_LIST",CARD_EQ_LIST; "CARD_EQ_LIST_GEN",CARD_EQ_LIST_GEN; "CARD_EQ_NONEMPTY_INTERIOR",CARD_EQ_NONEMPTY_INTERIOR; "CARD_EQ_NSUM",CARD_EQ_NSUM; "CARD_EQ_OPEN",CARD_EQ_OPEN; "CARD_EQ_OPEN_IN",CARD_EQ_OPEN_IN; "CARD_EQ_OPEN_IN_AFFINE",CARD_EQ_OPEN_IN_AFFINE; "CARD_EQ_OPEN_SETS",CARD_EQ_OPEN_SETS; "CARD_EQ_ORDINAL_EXISTS",CARD_EQ_ORDINAL_EXISTS; "CARD_EQ_PATH_CONNECTED",CARD_EQ_PATH_CONNECTED; "CARD_EQ_PCROSS",CARD_EQ_PCROSS; "CARD_EQ_PERFECT_SET",CARD_EQ_PERFECT_SET; "CARD_EQ_RATIONAL",CARD_EQ_RATIONAL; "CARD_EQ_REAL",CARD_EQ_REAL; "CARD_EQ_REAL_IMP_UNCOUNTABLE",CARD_EQ_REAL_IMP_UNCOUNTABLE; "CARD_EQ_REAL_SEQUENCES",CARD_EQ_REAL_SEQUENCES; "CARD_EQ_REFL",CARD_EQ_REFL; "CARD_EQ_REFL_IMP",CARD_EQ_REFL_IMP; "CARD_EQ_RESTRICTED_POWERSET",CARD_EQ_RESTRICTED_POWERSET; "CARD_EQ_SEGMENT",CARD_EQ_SEGMENT; "CARD_EQ_SIMPLE_PATH_IMAGE",CARD_EQ_SIMPLE_PATH_IMAGE; "CARD_EQ_SPHERE",CARD_EQ_SPHERE; "CARD_EQ_SUM",CARD_EQ_SUM; "CARD_EQ_SYM",CARD_EQ_SYM; "CARD_EQ_TRANS",CARD_EQ_TRANS; "CARD_EVEN_PERMUTATIONS",CARD_EVEN_PERMUTATIONS; "CARD_EXP_0",CARD_EXP_0; "CARD_EXP_ABSORB",CARD_EXP_ABSORB; "CARD_EXP_ADD",CARD_EXP_ADD; "CARD_EXP_C",CARD_EXP_C; "CARD_EXP_CANTOR",CARD_EXP_CANTOR; "CARD_EXP_CONG",CARD_EXP_CONG; "CARD_EXP_EQ_REAL",CARD_EXP_EQ_REAL; "CARD_EXP_FINITE",CARD_EXP_FINITE; "CARD_EXP_GRAPH",CARD_EXP_GRAPH; "CARD_EXP_GRAPH_PAIRED",CARD_EXP_GRAPH_PAIRED; "CARD_EXP_LE_REAL",CARD_EXP_LE_REAL; "CARD_EXP_MUL",CARD_EXP_MUL; "CARD_EXP_POWERSET",CARD_EXP_POWERSET; "CARD_EXP_SING",CARD_EXP_SING; "CARD_EXP_UNIV",CARD_EXP_UNIV; "CARD_EXP_ZERO",CARD_EXP_ZERO; "CARD_FACES_OF_SIMPLEX",CARD_FACES_OF_SIMPLEX; "CARD_FINITE_CONG",CARD_FINITE_CONG; "CARD_FINITE_IMAGE",CARD_FINITE_IMAGE; "CARD_FRONTIER_INTERVAL_1",CARD_FRONTIER_INTERVAL_1; "CARD_FUNSPACE",CARD_FUNSPACE; "CARD_FUNSPACE_CONG",CARD_FUNSPACE_CONG; "CARD_FUNSPACE_CURRY",CARD_FUNSPACE_CURRY; "CARD_FUNSPACE_LE",CARD_FUNSPACE_LE; "CARD_FUNSPACE_UNIV",CARD_FUNSPACE_UNIV; "CARD_GE_DIM_INDEPENDENT",CARD_GE_DIM_INDEPENDENT; "CARD_HAS_SIZE_CONG",CARD_HAS_SIZE_CONG; "CARD_IMAGE_EQ_INJ",CARD_IMAGE_EQ_INJ; "CARD_IMAGE_INJ",CARD_IMAGE_INJ; "CARD_IMAGE_INJ_EQ",CARD_IMAGE_INJ_EQ; "CARD_IMAGE_LE",CARD_IMAGE_LE; "CARD_INFINITE_CONG",CARD_INFINITE_CONG; "CARD_INTSEG_INT",CARD_INTSEG_INT; "CARD_LDISTRIB",CARD_LDISTRIB; "CARD_LET_TOTAL",CARD_LET_TOTAL; "CARD_LET_TRANS",CARD_LET_TRANS; "CARD_LE_ADD",CARD_LE_ADD; "CARD_LE_ADDL",CARD_LE_ADDL; "CARD_LE_ADDR",CARD_LE_ADDR; "CARD_LE_ANTISYM",CARD_LE_ANTISYM; "CARD_LE_CARD",CARD_LE_CARD; "CARD_LE_CARD_IMP",CARD_LE_CARD_IMP; "CARD_LE_COMPONENTS",CARD_LE_COMPONENTS; "CARD_LE_COMPONENTS_CLOSURE_FRONTIER",CARD_LE_COMPONENTS_CLOSURE_FRONTIER; "CARD_LE_COMPONENTS_FRONTIER",CARD_LE_COMPONENTS_FRONTIER; "CARD_LE_COMPONENTS_UNION",CARD_LE_COMPONENTS_UNION; "CARD_LE_CONG",CARD_LE_CONG; "CARD_LE_CONNECTED_COMPONENTS",CARD_LE_CONNECTED_COMPONENTS; "CARD_LE_COUNTABLE",CARD_LE_COUNTABLE; "CARD_LE_COUNTABLE_SUBSETS",CARD_LE_COUNTABLE_SUBSETS; "CARD_LE_DIM_SPANNING",CARD_LE_DIM_SPANNING; "CARD_LE_EMPTY",CARD_LE_EMPTY; "CARD_LE_EQ_SUBSET",CARD_LE_EQ_SUBSET; "CARD_LE_EXISTS",CARD_LE_EXISTS; "CARD_LE_EXP",CARD_LE_EXP; "CARD_LE_EXP_LEFT",CARD_LE_EXP_LEFT; "CARD_LE_EXP_RIGHT",CARD_LE_EXP_RIGHT; "CARD_LE_FINITE",CARD_LE_FINITE; "CARD_LE_FINITE_INFINITE",CARD_LE_FINITE_INFINITE; "CARD_LE_FINITE_SUBSETS",CARD_LE_FINITE_SUBSETS; "CARD_LE_IMAGE",CARD_LE_IMAGE; "CARD_LE_IMAGE_GEN",CARD_LE_IMAGE_GEN; "CARD_LE_INFINITE",CARD_LE_INFINITE; "CARD_LE_INJ",CARD_LE_INJ; "CARD_LE_LIST",CARD_LE_LIST; "CARD_LE_LT",CARD_LE_LT; "CARD_LE_MUL",CARD_LE_MUL; "CARD_LE_PATH_COMPONENTS",CARD_LE_PATH_COMPONENTS; "CARD_LE_POWERSET",CARD_LE_POWERSET; "CARD_LE_REFL",CARD_LE_REFL; "CARD_LE_RELATIONAL",CARD_LE_RELATIONAL; "CARD_LE_RELATIONAL_FULL",CARD_LE_RELATIONAL_FULL; "CARD_LE_RETRACT_COMPLEMENT_COMPONENTS",CARD_LE_RETRACT_COMPLEMENT_COMPONENTS; "CARD_LE_SQUARE",CARD_LE_SQUARE; "CARD_LE_SUBPOWERSET",CARD_LE_SUBPOWERSET; "CARD_LE_SUBSET",CARD_LE_SUBSET; "CARD_LE_TOTAL",CARD_LE_TOTAL; "CARD_LE_TRANS",CARD_LE_TRANS; "CARD_LE_UNIONS",CARD_LE_UNIONS; "CARD_LE_UNIONS2",CARD_LE_UNIONS2; "CARD_LE_UNIONS_CHAIN",CARD_LE_UNIONS_CHAIN; "CARD_LE_UNIV",CARD_LE_UNIV; "CARD_LTE_TOTAL",CARD_LTE_TOTAL; "CARD_LTE_TRANS",CARD_LTE_TRANS; "CARD_LT_ADD",CARD_LT_ADD; "CARD_LT_CARD",CARD_LT_CARD; "CARD_LT_CONG",CARD_LT_CONG; "CARD_LT_FINITE_INFINITE",CARD_LT_FINITE_INFINITE; "CARD_LT_IMP_DISCONNECTED",CARD_LT_IMP_DISCONNECTED; "CARD_LT_IMP_LE",CARD_LT_IMP_LE; "CARD_LT_IMP_SUC_LE",CARD_LT_IMP_SUC_LE; "CARD_LT_LE",CARD_LT_LE; "CARD_LT_REFL",CARD_LT_REFL; "CARD_LT_TOTAL",CARD_LT_TOTAL; "CARD_LT_TRANS",CARD_LT_TRANS; "CARD_MUL2_ABSORB_LE",CARD_MUL2_ABSORB_LE; "CARD_MUL_ABSORB",CARD_MUL_ABSORB; "CARD_MUL_ABSORB_LE",CARD_MUL_ABSORB_LE; "CARD_MUL_ASSOC",CARD_MUL_ASSOC; "CARD_MUL_C",CARD_MUL_C; "CARD_MUL_CONG",CARD_MUL_CONG; "CARD_MUL_EXP",CARD_MUL_EXP; "CARD_MUL_FINITE",CARD_MUL_FINITE; "CARD_MUL_FINITE_EQ",CARD_MUL_FINITE_EQ; "CARD_MUL_LT_INFINITE",CARD_MUL_LT_INFINITE; "CARD_MUL_LT_LEMMA",CARD_MUL_LT_LEMMA; "CARD_MUL_SYM",CARD_MUL_SYM; "CARD_NOT_LE",CARD_NOT_LE; "CARD_NOT_LT",CARD_NOT_LT; "CARD_NUMSEG",CARD_NUMSEG; "CARD_NUMSEG_1",CARD_NUMSEG_1; "CARD_NUMSEG_LE",CARD_NUMSEG_LE; "CARD_NUMSEG_LEMMA",CARD_NUMSEG_LEMMA; "CARD_NUMSEG_LT",CARD_NUMSEG_LT; "CARD_PERMUTATIONS",CARD_PERMUTATIONS; "CARD_POWERSET",CARD_POWERSET; "CARD_POWERSET_CONG",CARD_POWERSET_CONG; "CARD_PRODUCT",CARD_PRODUCT; "CARD_PSUBSET",CARD_PSUBSET; "CARD_RDISTRIB",CARD_RDISTRIB; "CARD_ROWS_LE",CARD_ROWS_LE; "CARD_SET_OF_LIST_LE",CARD_SET_OF_LIST_LE; "CARD_SING",CARD_SING; "CARD_SING_LE",CARD_SING_LE; "CARD_SQUARE_INFINITE",CARD_SQUARE_INFINITE; "CARD_SQUARE_NUM",CARD_SQUARE_NUM; "CARD_STDBASIS",CARD_STDBASIS; "CARD_SUBSET",CARD_SUBSET; "CARD_SUBSET_EQ",CARD_SUBSET_EQ; "CARD_SUBSET_IMAGE",CARD_SUBSET_IMAGE; "CARD_SUBSET_LE",CARD_SUBSET_LE; "CARD_SUSLIN_EQ",CARD_SUSLIN_EQ; "CARD_SUSLIN_LE",CARD_SUSLIN_LE; "CARD_UNION",CARD_UNION; "CARD_UNIONS",CARD_UNIONS; "CARD_UNIONS_LE",CARD_UNIONS_LE; "CARD_UNION_ABSORB_LEFT",CARD_UNION_ABSORB_LEFT; "CARD_UNION_ABSORB_RIGHT",CARD_UNION_ABSORB_RIGHT; "CARD_UNION_EQ",CARD_UNION_EQ; "CARD_UNION_GEN",CARD_UNION_GEN; "CARD_UNION_LE",CARD_UNION_LE; "CARD_UNION_LEMMA",CARD_UNION_LEMMA; "CARD_UNION_OVERLAP",CARD_UNION_OVERLAP; "CARD_UNION_OVERLAP_EQ",CARD_UNION_OVERLAP_EQ; "CART_EQ",CART_EQ; "CART_EQ_FULL",CART_EQ_FULL; "CASEWISE",CASEWISE; "CASEWISE_CASES",CASEWISE_CASES; "CASEWISE_DEF",CASEWISE_DEF; "CASEWISE_WORKS",CASEWISE_WORKS; "CASN_0",CASN_0; "CASN_1",CASN_1; "CASN_BODY_LEMMA",CASN_BODY_LEMMA; "CASN_BOUNDS",CASN_BOUNDS; "CASN_CACS_SQRT_POS",CASN_CACS_SQRT_POS; "CASN_CSIN",CASN_CSIN; "CASN_NEG_1",CASN_NEG_1; "CASN_RANGE_LEMMA",CASN_RANGE_LEMMA; "CASN_UNIQUE",CASN_UNIQUE; "CASORATI_WEIERSTRASS",CASORATI_WEIERSTRASS; "CATN_0",CATN_0; "CATN_CONVERGES",CATN_CONVERGES; "CATN_CONVERGES_STRONG",CATN_CONVERGES_STRONG; "CATN_CTAN",CATN_CTAN; "CAUCHY",CAUCHY; "CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE",CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE; "CAUCHY_CONTINUOUS_EQ_EXTENDS_TO_CLOSURE",CAUCHY_CONTINUOUS_EQ_EXTENDS_TO_CLOSURE; "CAUCHY_CONTINUOUS_EXTENDS_TO_CAUCHY_CONTINUOUS_CLOSURE",CAUCHY_CONTINUOUS_EXTENDS_TO_CAUCHY_CONTINUOUS_CLOSURE; "CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE",CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE; "CAUCHY_CONTINUOUS_IMP_CONTINUOUS",CAUCHY_CONTINUOUS_IMP_CONTINUOUS; "CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA",CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA; "CAUCHY_CONVERGENT_SUBSEQUENCE",CAUCHY_CONVERGENT_SUBSEQUENCE; "CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH",CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH; "CAUCHY_EQ_SUMMABLE",CAUCHY_EQ_SUMMABLE; "CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH",CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH; "CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND",CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND; "CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH",CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; "CAUCHY_IMP_BOUNDED",CAUCHY_IMP_BOUNDED; "CAUCHY_INEQUALITY",CAUCHY_INEQUALITY; "CAUCHY_INTEGRAL_CIRCLEPATH",CAUCHY_INTEGRAL_CIRCLEPATH; "CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE",CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE; "CAUCHY_INTEGRAL_FORMULA_CONVEX",CAUCHY_INTEGRAL_FORMULA_CONVEX; "CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE",CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE; "CAUCHY_INTEGRAL_FORMULA_GLOBAL",CAUCHY_INTEGRAL_FORMULA_GLOBAL; "CAUCHY_INTEGRAL_FORMULA_WEAK",CAUCHY_INTEGRAL_FORMULA_WEAK; "CAUCHY_IN_EQ_CAUCHY",CAUCHY_IN_EQ_CAUCHY; "CAUCHY_ISOMETRIC",CAUCHY_ISOMETRIC; "CAUCHY_NEXT_DERIVATIVE",CAUCHY_NEXT_DERIVATIVE; "CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH",CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH; "CAUCHY_OFFSET",CAUCHY_OFFSET; "CAUCHY_RIEMANN",CAUCHY_RIEMANN; "CAUCHY_SUBSEQUENCE",CAUCHY_SUBSEQUENCE; "CAUCHY_THEOREM_CONVEX",CAUCHY_THEOREM_CONVEX; "CAUCHY_THEOREM_CONVEX_SIMPLE",CAUCHY_THEOREM_CONVEX_SIMPLE; "CAUCHY_THEOREM_DISC",CAUCHY_THEOREM_DISC; "CAUCHY_THEOREM_DISC_SIMPLE",CAUCHY_THEOREM_DISC_SIMPLE; "CAUCHY_THEOREM_FLAT",CAUCHY_THEOREM_FLAT; "CAUCHY_THEOREM_FLAT_LEMMA",CAUCHY_THEOREM_FLAT_LEMMA; "CAUCHY_THEOREM_GLOBAL",CAUCHY_THEOREM_GLOBAL; "CAUCHY_THEOREM_GLOBAL_OUTSIDE",CAUCHY_THEOREM_GLOBAL_OUTSIDE; "CAUCHY_THEOREM_HOMOTOPIC_LOOPS",CAUCHY_THEOREM_HOMOTOPIC_LOOPS; "CAUCHY_THEOREM_HOMOTOPIC_PATHS",CAUCHY_THEOREM_HOMOTOPIC_PATHS; "CAUCHY_THEOREM_NULL_HOMOTOPIC",CAUCHY_THEOREM_NULL_HOMOTOPIC; "CAUCHY_THEOREM_PRIMITIVE",CAUCHY_THEOREM_PRIMITIVE; "CAUCHY_THEOREM_QUADRISECTION",CAUCHY_THEOREM_QUADRISECTION; "CAUCHY_THEOREM_SIMPLY_CONNECTED",CAUCHY_THEOREM_SIMPLY_CONNECTED; "CAUCHY_THEOREM_STARLIKE",CAUCHY_THEOREM_STARLIKE; "CAUCHY_THEOREM_STARLIKE_SIMPLE",CAUCHY_THEOREM_STARLIKE_SIMPLE; "CAUCHY_THEOREM_TRIANGLE",CAUCHY_THEOREM_TRIANGLE; "CAUCHY_THEOREM_TRIANGLE_COFINITE",CAUCHY_THEOREM_TRIANGLE_COFINITE; "CAUCHY_THEOREM_TRIANGLE_INTERIOR",CAUCHY_THEOREM_TRIANGLE_INTERIOR; "CBALL_DIFF_BALL",CBALL_DIFF_BALL; "CBALL_DIFF_SPHERE",CBALL_DIFF_SPHERE; "CBALL_EMPTY",CBALL_EMPTY; "CBALL_EQ_EMPTY",CBALL_EQ_EMPTY; "CBALL_EQ_SING",CBALL_EQ_SING; "CBALL_INTERVAL",CBALL_INTERVAL; "CBALL_INTERVAL_0",CBALL_INTERVAL_0; "CBALL_LINEAR_IMAGE",CBALL_LINEAR_IMAGE; "CBALL_MAX_UNION",CBALL_MAX_UNION; "CBALL_MIN_INTER",CBALL_MIN_INTER; "CBALL_SCALING",CBALL_SCALING; "CBALL_SING",CBALL_SING; "CBALL_TRANSLATION",CBALL_TRANSLATION; "CBALL_TRIVIAL",CBALL_TRIVIAL; "CCOS_0",CCOS_0; "CCOS_ADD",CCOS_ADD; "CCOS_CACS",CCOS_CACS; "CCOS_CASN",CCOS_CASN; "CCOS_CASN_NZ",CCOS_CASN_NZ; "CCOS_CONVERGES",CCOS_CONVERGES; "CCOS_CSIN_CSQRT",CCOS_CSIN_CSQRT; "CCOS_DOUBLE",CCOS_DOUBLE; "CCOS_DOUBLE_CCOS",CCOS_DOUBLE_CCOS; "CCOS_DOUBLE_CSIN",CCOS_DOUBLE_CSIN; "CCOS_EQ",CCOS_EQ; "CCOS_EQ_0",CCOS_EQ_0; "CCOS_EQ_1",CCOS_EQ_1; "CCOS_EQ_MINUS1",CCOS_EQ_MINUS1; "CCOS_NEG",CCOS_NEG; "CCOS_SUB",CCOS_SUB; "CELL_COMPLEX_DISJOINT_RELATIVE_INTERIORS",CELL_COMPLEX_DISJOINT_RELATIVE_INTERIORS; "CELL_COMPLEX_SUBDIVISION_EXISTS",CELL_COMPLEX_SUBDIVISION_EXISTS; "CENTRE_IN_BALL",CENTRE_IN_BALL; "CENTRE_IN_CBALL",CENTRE_IN_CBALL; "CENTRE_IN_MBALL",CENTRE_IN_MBALL; "CENTRE_IN_MBALL_EQ",CENTRE_IN_MBALL_EQ; "CENTRE_IN_MCBALL",CENTRE_IN_MCBALL; "CENTRE_IN_MCBALL_EQ",CENTRE_IN_MCBALL_EQ; "CEXP_0",CEXP_0; "CEXP_ADD",CEXP_ADD; "CEXP_ADD_MUL",CEXP_ADD_MUL; "CEXP_BOUND_BLEMMA",CEXP_BOUND_BLEMMA; "CEXP_BOUND_HALF",CEXP_BOUND_HALF; "CEXP_BOUND_LEMMA",CEXP_BOUND_LEMMA; "CEXP_CLOG",CEXP_CLOG; "CEXP_COMPLEX",CEXP_COMPLEX; "CEXP_CONVERGES",CEXP_CONVERGES; "CEXP_CONVERGES_UNIFORMLY",CEXP_CONVERGES_UNIFORMLY; "CEXP_CONVERGES_UNIFORMLY_CAUCHY",CEXP_CONVERGES_UNIFORMLY_CAUCHY; "CEXP_CONVERGES_UNIQUE",CEXP_CONVERGES_UNIQUE; "CEXP_EQ",CEXP_EQ; "CEXP_EQ_1",CEXP_EQ_1; "CEXP_EULER",CEXP_EULER; "CEXP_II_NE_1",CEXP_II_NE_1; "CEXP_II_PI",CEXP_II_PI; "CEXP_INTEGER_2PI",CEXP_INTEGER_2PI; "CEXP_LIMIT",CEXP_LIMIT; "CEXP_MUL_CPOW",CEXP_MUL_CPOW; "CEXP_N",CEXP_N; "CEXP_NEG",CEXP_NEG; "CEXP_NEG_LMUL",CEXP_NEG_LMUL; "CEXP_NEG_RMUL",CEXP_NEG_RMUL; "CEXP_NZ",CEXP_NZ; "CEXP_SUB",CEXP_SUB; "CEXP_VSUM",CEXP_VSUM; "CFUNSPACE",CFUNSPACE; "CFUNSPACE_IMP_BOUNDED2",CFUNSPACE_IMP_BOUNDED2; "CFUNSPACE_MDIST_LE",CFUNSPACE_MDIST_LE; "CFUNSPACE_MDIST_LT",CFUNSPACE_MDIST_LT; "CFUNSPACE_SUBSET_FUNSPACE",CFUNSPACE_SUBSET_FUNSPACE; "CHAIN_SUBSET",CHAIN_SUBSET; "CHARACTERISTIC_POLYNOMIAL",CHARACTERISTIC_POLYNOMIAL; "CHOICE",CHOICE; "CHOICE_DEF",CHOICE_DEF; "CHOICE_PAIRED_THM",CHOICE_PAIRED_THM; "CHOICE_UNPAIR_THM",CHOICE_UNPAIR_THM; "CHOOSE_AFFINE_SUBSET",CHOOSE_AFFINE_SUBSET; "CHOOSE_LARGE_COMPACT_SUBSET",CHOOSE_LARGE_COMPACT_SUBSET; "CHOOSE_LARGE_MEASURABLE_SUBSET",CHOOSE_LARGE_MEASURABLE_SUBSET; "CHOOSE_POLYTOPE",CHOOSE_POLYTOPE; "CHOOSE_SIMPLEX",CHOOSE_SIMPLEX; "CHOOSE_SUBSET",CHOOSE_SUBSET; "CHOOSE_SUBSET_BETWEEN",CHOOSE_SUBSET_BETWEEN; "CHOOSE_SUBSET_EQ",CHOOSE_SUBSET_EQ; "CHOOSE_SUBSET_STRONG",CHOOSE_SUBSET_STRONG; "CHOOSE_SUBSPACE_OF_SUBSPACE",CHOOSE_SUBSPACE_OF_SUBSPACE; "CHOOSE_SURROUNDING_SIMPLEX",CHOOSE_SURROUNDING_SIMPLEX; "CHOOSE_SURROUNDING_SIMPLEX_FULL",CHOOSE_SURROUNDING_SIMPLEX_FULL; "CIRCLEPATH",CIRCLEPATH; "CIRCLE_SINCOS",CIRCLE_SINCOS; "CLOG_1",CLOG_1; "CLOG_CEXP",CLOG_CEXP; "CLOG_CONVERGES",CLOG_CONVERGES; "CLOG_CONVERGES_STRONG",CLOG_CONVERGES_STRONG; "CLOG_DIV_POS",CLOG_DIV_POS; "CLOG_EQ",CLOG_EQ; "CLOG_II",CLOG_II; "CLOG_INV",CLOG_INV; "CLOG_MUL",CLOG_MUL; "CLOG_MUL_CX",CLOG_MUL_CX; "CLOG_MUL_II",CLOG_MUL_II; "CLOG_MUL_POS",CLOG_MUL_POS; "CLOG_MUL_SIMPLE",CLOG_MUL_SIMPLE; "CLOG_MUL_UNWINDING",CLOG_MUL_UNWINDING; "CLOG_NEG",CLOG_NEG; "CLOG_NEG_1",CLOG_NEG_1; "CLOG_NEG_II",CLOG_NEG_II; "CLOG_UNIQUE",CLOG_UNIQUE; "CLOG_WORKS",CLOG_WORKS; "CLOPEN",CLOPEN; "CLOPEN_IN_COMPONENTS",CLOPEN_IN_COMPONENTS; "CLOPEN_IN_EQ_FRONTIER_OF",CLOPEN_IN_EQ_FRONTIER_OF; "CLOPEN_UNIONS_COMPONENTS",CLOPEN_UNIONS_COMPONENTS; "CLOSED_AFFINE",CLOSED_AFFINE; "CLOSED_AFFINE_HULL",CLOSED_AFFINE_HULL; "CLOSED_AFFINITY",CLOSED_AFFINITY; "CLOSED_AFFINITY_EQ",CLOSED_AFFINITY_EQ; "CLOSED_ALGEBRAIC_VARIETY",CLOSED_ALGEBRAIC_VARIETY; "CLOSED_APPROACHABLE",CLOSED_APPROACHABLE; "CLOSED_ARC_IMAGE",CLOSED_ARC_IMAGE; "CLOSED_ARG_LE",CLOSED_ARG_LE; "CLOSED_AS_FRONTIER",CLOSED_AS_FRONTIER; "CLOSED_AS_FRONTIER_OF_SUBSET",CLOSED_AS_FRONTIER_OF_SUBSET; "CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE",CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE; "CLOSED_CBALL",CLOSED_CBALL; "CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON",CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON; "CLOSED_CLOSURE",CLOSED_CLOSURE; "CLOSED_COMPACT_DIFFERENCES",CLOSED_COMPACT_DIFFERENCES; "CLOSED_COMPACT_IN",CLOSED_COMPACT_IN; "CLOSED_COMPACT_PROJECTION",CLOSED_COMPACT_PROJECTION; "CLOSED_COMPACT_SUMS",CLOSED_COMPACT_SUMS; "CLOSED_COMPONENTS",CLOSED_COMPONENTS; "CLOSED_CONDENSATION_POINTS",CLOSED_CONDENSATION_POINTS; "CLOSED_CONIC_HULL",CLOSED_CONIC_HULL; "CLOSED_CONIC_HULL_STRONG",CLOSED_CONIC_HULL_STRONG; "CLOSED_CONIC_HULL_VERTEX_IMAGE",CLOSED_CONIC_HULL_VERTEX_IMAGE; "CLOSED_CONNECTED_COMPONENT",CLOSED_CONNECTED_COMPONENT; "CLOSED_CONNECTED_PREIMAGES_IMP_CONTINUOUS_ON",CLOSED_CONNECTED_PREIMAGES_IMP_CONTINUOUS_ON; "CLOSED_CONTAINS_SEQUENTIAL_LIMIT",CLOSED_CONTAINS_SEQUENTIAL_LIMIT; "CLOSED_CONVEX_CONE_HULL",CLOSED_CONVEX_CONE_HULL; "CLOSED_CONVEX_CONE_HULL_STRONG",CLOSED_CONVEX_CONE_HULL_STRONG; "CLOSED_DIFF",CLOSED_DIFF; "CLOSED_DIFF_OPEN_INTERVAL_1",CLOSED_DIFF_OPEN_INTERVAL_1; "CLOSED_EMPTY",CLOSED_EMPTY; "CLOSED_EQ_CONTINUOUS_LEVELSET",CLOSED_EQ_CONTINUOUS_LEVELSET; "CLOSED_EXTREME_POINTS_2D",CLOSED_EXTREME_POINTS_2D; "CLOSED_FIP",CLOSED_FIP; "CLOSED_FORALL",CLOSED_FORALL; "CLOSED_FORALL_IN",CLOSED_FORALL_IN; "CLOSED_HALFSPACE_COMPONENT_GE",CLOSED_HALFSPACE_COMPONENT_GE; "CLOSED_HALFSPACE_COMPONENT_LE",CLOSED_HALFSPACE_COMPONENT_LE; "CLOSED_HALFSPACE_GE",CLOSED_HALFSPACE_GE; "CLOSED_HALFSPACE_IM_EQ",CLOSED_HALFSPACE_IM_EQ; "CLOSED_HALFSPACE_IM_GE",CLOSED_HALFSPACE_IM_GE; "CLOSED_HALFSPACE_IM_LE",CLOSED_HALFSPACE_IM_LE; "CLOSED_HALFSPACE_LE",CLOSED_HALFSPACE_LE; "CLOSED_HALFSPACE_RE_EQ",CLOSED_HALFSPACE_RE_EQ; "CLOSED_HALFSPACE_RE_GE",CLOSED_HALFSPACE_RE_GE; "CLOSED_HALFSPACE_RE_LE",CLOSED_HALFSPACE_RE_LE; "CLOSED_HYPERPLANE",CLOSED_HYPERPLANE; "CLOSED_IMP_ANALYTIC",CLOSED_IMP_ANALYTIC; "CLOSED_IMP_BAIRE1_INDICATOR",CLOSED_IMP_BAIRE1_INDICATOR; "CLOSED_IMP_BOREL",CLOSED_IMP_BOREL; "CLOSED_IMP_FIP",CLOSED_IMP_FIP; "CLOSED_IMP_FIP_COMPACT",CLOSED_IMP_FIP_COMPACT; "CLOSED_IMP_FSIGMA",CLOSED_IMP_FSIGMA; "CLOSED_IMP_GDELTA",CLOSED_IMP_GDELTA; "CLOSED_IMP_LOCALLY_COMPACT",CLOSED_IMP_LOCALLY_COMPACT; "CLOSED_IN",CLOSED_IN; "CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE; "CLOSED_INJECTIVE_IMAGE_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSPACE; "CLOSED_INJECTIVE_LINEAR_IMAGE",CLOSED_INJECTIVE_LINEAR_IMAGE; "CLOSED_INJECTIVE_LINEAR_IMAGE_EQ",CLOSED_INJECTIVE_LINEAR_IMAGE_EQ; "CLOSED_INSERT",CLOSED_INSERT; "CLOSED_INTER",CLOSED_INTER; "CLOSED_INTERS",CLOSED_INTERS; "CLOSED_INTERS_COMPACT",CLOSED_INTERS_COMPACT; "CLOSED_INTERVAL",CLOSED_INTERVAL; "CLOSED_INTERVAL_AS_CONVEX_HULL",CLOSED_INTERVAL_AS_CONVEX_HULL; "CLOSED_INTERVAL_DROPOUT",CLOSED_INTERVAL_DROPOUT; "CLOSED_INTERVAL_EQ",CLOSED_INTERVAL_EQ; "CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL",CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL; "CLOSED_INTERVAL_LEFT",CLOSED_INTERVAL_LEFT; "CLOSED_INTERVAL_RIGHT",CLOSED_INTERVAL_RIGHT; "CLOSED_INTER_COMPACT",CLOSED_INTER_COMPACT; "CLOSED_IN_ANALYTIC",CLOSED_IN_ANALYTIC; "CLOSED_IN_BOREL",CLOSED_IN_BOREL; "CLOSED_IN_CLOSED",CLOSED_IN_CLOSED; "CLOSED_IN_CLOSED_EQ",CLOSED_IN_CLOSED_EQ; "CLOSED_IN_CLOSED_INTER",CLOSED_IN_CLOSED_INTER; "CLOSED_IN_CLOSED_TRANS",CLOSED_IN_CLOSED_TRANS; "CLOSED_IN_CLOSURE_OF",CLOSED_IN_CLOSURE_OF; "CLOSED_IN_COMPACT",CLOSED_IN_COMPACT; "CLOSED_IN_COMPACT_EQ",CLOSED_IN_COMPACT_EQ; "CLOSED_IN_COMPACT_PROJECTION",CLOSED_IN_COMPACT_PROJECTION; "CLOSED_IN_COMPONENT",CLOSED_IN_COMPONENT; "CLOSED_IN_CONIC_HULL",CLOSED_IN_CONIC_HULL; "CLOSED_IN_CONNECTED_COMPONENT",CLOSED_IN_CONNECTED_COMPONENT; "CLOSED_IN_CONTAINS_DERIVED_SET",CLOSED_IN_CONTAINS_DERIVED_SET; "CLOSED_IN_DIFF",CLOSED_IN_DIFF; "CLOSED_IN_DIFF_OPEN",CLOSED_IN_DIFF_OPEN; "CLOSED_IN_EMPTY",CLOSED_IN_EMPTY; "CLOSED_IN_EQ_CONTINUOUS_LEVELSET",CLOSED_IN_EQ_CONTINUOUS_LEVELSET; "CLOSED_IN_EUCLIDEAN",CLOSED_IN_EUCLIDEAN; "CLOSED_IN_FRONTIER_OF",CLOSED_IN_FRONTIER_OF; "CLOSED_IN_FSIGMA",CLOSED_IN_FSIGMA; "CLOSED_IN_GDELTA",CLOSED_IN_GDELTA; "CLOSED_IN_IMP_SUBSET",CLOSED_IN_IMP_SUBSET; "CLOSED_IN_INJECTIVE_LINEAR_IMAGE",CLOSED_IN_INJECTIVE_LINEAR_IMAGE; "CLOSED_IN_INSERT",CLOSED_IN_INSERT; "CLOSED_IN_INTER",CLOSED_IN_INTER; "CLOSED_IN_INTERS",CLOSED_IN_INTERS; "CLOSED_IN_INTER_CLOSED",CLOSED_IN_INTER_CLOSED; "CLOSED_IN_INTER_CLOSURE",CLOSED_IN_INTER_CLOSURE; "CLOSED_IN_LIMPT",CLOSED_IN_LIMPT; "CLOSED_IN_LOCALLY_FINITE_UNIONS",CLOSED_IN_LOCALLY_FINITE_UNIONS; "CLOSED_IN_MCBALL",CLOSED_IN_MCBALL; "CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE",CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE; "CLOSED_IN_METRIC",CLOSED_IN_METRIC; "CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; "CLOSED_IN_PCROSS",CLOSED_IN_PCROSS; "CLOSED_IN_PCROSS_EQ",CLOSED_IN_PCROSS_EQ; "CLOSED_IN_REFL",CLOSED_IN_REFL; "CLOSED_IN_RELATIVE_TO",CLOSED_IN_RELATIVE_TO; "CLOSED_IN_RETRACT",CLOSED_IN_RETRACT; "CLOSED_IN_SEPARATED_UNION",CLOSED_IN_SEPARATED_UNION; "CLOSED_IN_SEQUENTIAL_LIMITS",CLOSED_IN_SEQUENTIAL_LIMITS; "CLOSED_IN_SING",CLOSED_IN_SING; "CLOSED_IN_SUBSET",CLOSED_IN_SUBSET; "CLOSED_IN_SUBSET_TRANS",CLOSED_IN_SUBSET_TRANS; "CLOSED_IN_SUBTOPOLOGY",CLOSED_IN_SUBTOPOLOGY; "CLOSED_IN_SUBTOPOLOGY_EMPTY",CLOSED_IN_SUBTOPOLOGY_EMPTY; "CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET",CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET; "CLOSED_IN_SUBTOPOLOGY_REFL",CLOSED_IN_SUBTOPOLOGY_REFL; "CLOSED_IN_SUBTOPOLOGY_UNION",CLOSED_IN_SUBTOPOLOGY_UNION; "CLOSED_IN_TOPSPACE",CLOSED_IN_TOPSPACE; "CLOSED_IN_TRANS",CLOSED_IN_TRANS; "CLOSED_IN_TRANSLATION_EQ",CLOSED_IN_TRANSLATION_EQ; "CLOSED_IN_TRANS_EQ",CLOSED_IN_TRANS_EQ; "CLOSED_IN_UNION",CLOSED_IN_UNION; "CLOSED_IN_UNIONS",CLOSED_IN_UNIONS; "CLOSED_IN_UNION_COMPLEMENT_COMPONENT",CLOSED_IN_UNION_COMPLEMENT_COMPONENT; "CLOSED_IN_UNION_COMPLEMENT_COMPONENTS",CLOSED_IN_UNION_COMPLEMENT_COMPONENTS; "CLOSED_IRREDUCIBLE_SEPARATOR",CLOSED_IRREDUCIBLE_SEPARATOR; "CLOSED_LIFT",CLOSED_LIFT; "CLOSED_LIMPT",CLOSED_LIMPT; "CLOSED_LIMPTS",CLOSED_LIMPTS; "CLOSED_LOCALLY_FINITE_UNIONS",CLOSED_LOCALLY_FINITE_UNIONS; "CLOSED_LOCAL_HOMEOMORPHISM_GLOBAL",CLOSED_LOCAL_HOMEOMORPHISM_GLOBAL; "CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP",CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP; "CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER",CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER; "CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN",CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN; "CLOSED_MAP_CLOSURES",CLOSED_MAP_CLOSURES; "CLOSED_MAP_FROM_COMPOSITION_INJECTIVE",CLOSED_MAP_FROM_COMPOSITION_INJECTIVE; "CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE",CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE; "CLOSED_MAP_FSTCART",CLOSED_MAP_FSTCART; "CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE",CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE; "CLOSED_MAP_IMP_OPEN_MAP",CLOSED_MAP_IMP_OPEN_MAP; "CLOSED_MAP_IMP_QUOTIENT_MAP",CLOSED_MAP_IMP_QUOTIENT_MAP; "CLOSED_MAP_NORM",CLOSED_MAP_NORM; "CLOSED_MAP_OPEN_SUPERSET_PREIMAGE",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE; "CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ; "CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT; "CLOSED_MAP_RESTRICT",CLOSED_MAP_RESTRICT; "CLOSED_MAP_SNDCART",CLOSED_MAP_SNDCART; "CLOSED_NEGATIONS",CLOSED_NEGATIONS; "CLOSED_OPEN_INTERVAL_1",CLOSED_OPEN_INTERVAL_1; "CLOSED_PATH_IMAGE",CLOSED_PATH_IMAGE; "CLOSED_PCROSS",CLOSED_PCROSS; "CLOSED_PCROSS_EQ",CLOSED_PCROSS_EQ; "CLOSED_POSITIVE_ORTHANT",CLOSED_POSITIVE_ORTHANT; "CLOSED_REAL",CLOSED_REAL; "CLOSED_REAL_SET",CLOSED_REAL_SET; "CLOSED_RELATIVE_BOUNDARY",CLOSED_RELATIVE_BOUNDARY; "CLOSED_RELATIVE_FRONTIER",CLOSED_RELATIVE_FRONTIER; "CLOSED_RELATIVE_TO",CLOSED_RELATIVE_TO; "CLOSED_SCALING",CLOSED_SCALING; "CLOSED_SCALING_EQ",CLOSED_SCALING_EQ; "CLOSED_SEGMENT",CLOSED_SEGMENT; "CLOSED_SEGMENT_DESCALE",CLOSED_SEGMENT_DESCALE; "CLOSED_SEGMENT_LINEAR_IMAGE",CLOSED_SEGMENT_LINEAR_IMAGE; "CLOSED_SEQUENTIAL_LIMITS",CLOSED_SEQUENTIAL_LIMITS; "CLOSED_SHIFTPATH",CLOSED_SHIFTPATH; "CLOSED_SIMPLEX",CLOSED_SIMPLEX; "CLOSED_SIMPLE_PATH_IMAGE",CLOSED_SIMPLE_PATH_IMAGE; "CLOSED_SING",CLOSED_SING; "CLOSED_SLICE",CLOSED_SLICE; "CLOSED_SPAN",CLOSED_SPAN; "CLOSED_SPHERE",CLOSED_SPHERE; "CLOSED_STANDARD_HYPERPLANE",CLOSED_STANDARD_HYPERPLANE; "CLOSED_STRIP_COMPONENT_LE",CLOSED_STRIP_COMPONENT_LE; "CLOSED_SUBSET",CLOSED_SUBSET; "CLOSED_SUBSET_EQ",CLOSED_SUBSET_EQ; "CLOSED_SUBSPACE",CLOSED_SUBSPACE; "CLOSED_SUBSTANDARD",CLOSED_SUBSTANDARD; "CLOSED_TRANSLATION",CLOSED_TRANSLATION; "CLOSED_TRANSLATION_EQ",CLOSED_TRANSLATION_EQ; "CLOSED_UNION",CLOSED_UNION; "CLOSED_UNIONS",CLOSED_UNIONS; "CLOSED_UNIONS_COMPONENTS_MEETING_CLOSED",CLOSED_UNIONS_COMPONENTS_MEETING_CLOSED; "CLOSED_UNION_COMPACT_SUBSETS",CLOSED_UNION_COMPACT_SUBSETS; "CLOSED_UNION_COMPLEMENT_COMPONENT",CLOSED_UNION_COMPLEMENT_COMPONENT; "CLOSED_UNION_COMPLEMENT_COMPONENTS",CLOSED_UNION_COMPLEMENT_COMPONENTS; "CLOSED_UNIV",CLOSED_UNIV; "CLOSED_VALID_PATH_IMAGE",CLOSED_VALID_PATH_IMAGE; "CLOSED_WITH_INSIDE",CLOSED_WITH_INSIDE; "CLOSER_POINTS_LEMMA",CLOSER_POINTS_LEMMA; "CLOSER_POINT_LEMMA",CLOSER_POINT_LEMMA; "CLOSEST_POINT_AFFINE_ORTHOGONAL",CLOSEST_POINT_AFFINE_ORTHOGONAL; "CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ",CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ; "CLOSEST_POINT_DOT",CLOSEST_POINT_DOT; "CLOSEST_POINT_EXISTS",CLOSEST_POINT_EXISTS; "CLOSEST_POINT_FRONTIER",CLOSEST_POINT_FRONTIER; "CLOSEST_POINT_IDEMPOTENT",CLOSEST_POINT_IDEMPOTENT; "CLOSEST_POINT_IN_FRONTIER",CLOSEST_POINT_IN_FRONTIER; "CLOSEST_POINT_IN_INTERIOR",CLOSEST_POINT_IN_INTERIOR; "CLOSEST_POINT_IN_RELATIVE_FRONTIER",CLOSEST_POINT_IN_RELATIVE_FRONTIER; "CLOSEST_POINT_IN_RELATIVE_INTERIOR",CLOSEST_POINT_IN_RELATIVE_INTERIOR; "CLOSEST_POINT_IN_SET",CLOSEST_POINT_IN_SET; "CLOSEST_POINT_LE",CLOSEST_POINT_LE; "CLOSEST_POINT_LIPSCHITZ",CLOSEST_POINT_LIPSCHITZ; "CLOSEST_POINT_LT",CLOSEST_POINT_LT; "CLOSEST_POINT_REFL",CLOSEST_POINT_REFL; "CLOSEST_POINT_SELF",CLOSEST_POINT_SELF; "CLOSEST_POINT_SUBSPACE_ORTHOGONAL",CLOSEST_POINT_SUBSPACE_ORTHOGONAL; "CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ",CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ; "CLOSEST_POINT_TRANSLATION",CLOSEST_POINT_TRANSLATION; "CLOSEST_POINT_UNIQUE",CLOSEST_POINT_UNIQUE; "CLOSURE_AFFINITY",CLOSURE_AFFINITY; "CLOSURE_APPROACHABLE",CLOSURE_APPROACHABLE; "CLOSURE_BALL",CLOSURE_BALL; "CLOSURE_BOUNDED_LINEAR_IMAGE",CLOSURE_BOUNDED_LINEAR_IMAGE; "CLOSURE_CBALL",CLOSURE_CBALL; "CLOSURE_CLOSED",CLOSURE_CLOSED; "CLOSURE_CLOSURE",CLOSURE_CLOSURE; "CLOSURE_COCOUNTABLE_COORDINATES",CLOSURE_COCOUNTABLE_COORDINATES; "CLOSURE_COMPLEMENT",CLOSURE_COMPLEMENT; "CLOSURE_CONIC_HULL",CLOSURE_CONIC_HULL; "CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS",CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS; "CLOSURE_CONVEX_HULL",CLOSURE_CONVEX_HULL; "CLOSURE_CONVEX_INTER_AFFINE",CLOSURE_CONVEX_INTER_AFFINE; "CLOSURE_CONVEX_INTER_SUPERSET",CLOSURE_CONVEX_INTER_SUPERSET; "CLOSURE_COSMALL_COORDINATES",CLOSURE_COSMALL_COORDINATES; "CLOSURE_DELETE",CLOSURE_DELETE; "CLOSURE_DYADIC_RATIONALS",CLOSURE_DYADIC_RATIONALS; "CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET",CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; "CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET",CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET; "CLOSURE_EMPTY",CLOSURE_EMPTY; "CLOSURE_EQ",CLOSURE_EQ; "CLOSURE_EQ_EMPTY",CLOSURE_EQ_EMPTY; "CLOSURE_HALFSPACE_COMPONENT_GT",CLOSURE_HALFSPACE_COMPONENT_GT; "CLOSURE_HALFSPACE_COMPONENT_LT",CLOSURE_HALFSPACE_COMPONENT_LT; "CLOSURE_HALFSPACE_GT",CLOSURE_HALFSPACE_GT; "CLOSURE_HALFSPACE_LT",CLOSURE_HALFSPACE_LT; "CLOSURE_HULL",CLOSURE_HULL; "CLOSURE_HYPERPLANE",CLOSURE_HYPERPLANE; "CLOSURE_IMAGE_BOUNDED",CLOSURE_IMAGE_BOUNDED; "CLOSURE_IMAGE_CLOSURE",CLOSURE_IMAGE_CLOSURE; "CLOSURE_INC",CLOSURE_INC; "CLOSURE_INJECTIVE_LINEAR_IMAGE",CLOSURE_INJECTIVE_LINEAR_IMAGE; "CLOSURE_INSERT",CLOSURE_INSERT; "CLOSURE_INSIDE_SUBSET",CLOSURE_INSIDE_SUBSET; "CLOSURE_INTERIOR",CLOSURE_INTERIOR; "CLOSURE_INTERIOR_IDEMP",CLOSURE_INTERIOR_IDEMP; "CLOSURE_INTERIOR_UNION_CLOSED",CLOSURE_INTERIOR_UNION_CLOSED; "CLOSURE_INTERS_CONVEX",CLOSURE_INTERS_CONVEX; "CLOSURE_INTERS_CONVEX_OPEN",CLOSURE_INTERS_CONVEX_OPEN; "CLOSURE_INTERS_SUBSET",CLOSURE_INTERS_SUBSET; "CLOSURE_INTERVAL",CLOSURE_INTERVAL; "CLOSURE_INTER_CONVEX",CLOSURE_INTER_CONVEX; "CLOSURE_INTER_CONVEX_OPEN",CLOSURE_INTER_CONVEX_OPEN; "CLOSURE_INTER_SUBSET",CLOSURE_INTER_SUBSET; "CLOSURE_IRRATIONAL_COORDINATES",CLOSURE_IRRATIONAL_COORDINATES; "CLOSURE_LINEAR_IMAGE_SUBSET",CLOSURE_LINEAR_IMAGE_SUBSET; "CLOSURE_LOCALLY_FINITE_UNIONS",CLOSURE_LOCALLY_FINITE_UNIONS; "CLOSURE_MINIMAL",CLOSURE_MINIMAL; "CLOSURE_MINIMAL_EQ",CLOSURE_MINIMAL_EQ; "CLOSURE_MINIMAL_LOCAL",CLOSURE_MINIMAL_LOCAL; "CLOSURE_NEGATIONS",CLOSURE_NEGATIONS; "CLOSURE_NONEMPTY_OPEN_INTER",CLOSURE_NONEMPTY_OPEN_INTER; "CLOSURE_OF",CLOSURE_OF; "CLOSURE_OF_ALT",CLOSURE_OF_ALT; "CLOSURE_OF_CLOSED_IN",CLOSURE_OF_CLOSED_IN; "CLOSURE_OF_CLOSURE_OF",CLOSURE_OF_CLOSURE_OF; "CLOSURE_OF_COMPLEMENT",CLOSURE_OF_COMPLEMENT; "CLOSURE_OF_EMPTY",CLOSURE_OF_EMPTY; "CLOSURE_OF_EQ",CLOSURE_OF_EQ; "CLOSURE_OF_EQ_EMPTY_GEN",CLOSURE_OF_EQ_EMPTY_GEN; "CLOSURE_OF_EQ_UNIV",CLOSURE_OF_EQ_UNIV; "CLOSURE_OF_HULL",CLOSURE_OF_HULL; "CLOSURE_OF_INJECTIVE_LINEAR_IMAGE",CLOSURE_OF_INJECTIVE_LINEAR_IMAGE; "CLOSURE_OF_INTERIOR_OF",CLOSURE_OF_INTERIOR_OF; "CLOSURE_OF_INTERIOR_OF_IDEMP",CLOSURE_OF_INTERIOR_OF_IDEMP; "CLOSURE_OF_MINIMAL",CLOSURE_OF_MINIMAL; "CLOSURE_OF_MINIMAL_EQ",CLOSURE_OF_MINIMAL_EQ; "CLOSURE_OF_MONO",CLOSURE_OF_MONO; "CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF",CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF; "CLOSURE_OF_OPEN_IN_INTER_SUPERSET",CLOSURE_OF_OPEN_IN_INTER_SUPERSET; "CLOSURE_OF_OPEN_IN_SUBTOPOLOGY_INTER_CLOSURE_OF",CLOSURE_OF_OPEN_IN_SUBTOPOLOGY_INTER_CLOSURE_OF; "CLOSURE_OF_RESTRICT",CLOSURE_OF_RESTRICT; "CLOSURE_OF_SUBSET",CLOSURE_OF_SUBSET; "CLOSURE_OF_SUBSET_EQ",CLOSURE_OF_SUBSET_EQ; "CLOSURE_OF_SUBSET_INTER",CLOSURE_OF_SUBSET_INTER; "CLOSURE_OF_SUBSET_SUBTOPOLOGY",CLOSURE_OF_SUBSET_SUBTOPOLOGY; "CLOSURE_OF_SUBSET_TOPSPACE",CLOSURE_OF_SUBSET_TOPSPACE; "CLOSURE_OF_SUBTOPOLOGY",CLOSURE_OF_SUBTOPOLOGY; "CLOSURE_OF_SUBTOPOLOGY_MONO",CLOSURE_OF_SUBTOPOLOGY_MONO; "CLOSURE_OF_SUBTOPOLOGY_OPEN",CLOSURE_OF_SUBTOPOLOGY_OPEN; "CLOSURE_OF_SUBTOPOLOGY_SUBSET",CLOSURE_OF_SUBTOPOLOGY_SUBSET; "CLOSURE_OF_TOPSPACE",CLOSURE_OF_TOPSPACE; "CLOSURE_OF_TRANSLATION",CLOSURE_OF_TRANSLATION; "CLOSURE_OF_UNION",CLOSURE_OF_UNION; "CLOSURE_OF_UNIONS",CLOSURE_OF_UNIONS; "CLOSURE_OF_UNIQUE",CLOSURE_OF_UNIQUE; "CLOSURE_OF_UNIV",CLOSURE_OF_UNIV; "CLOSURE_OPEN_INTERVAL",CLOSURE_OPEN_INTERVAL; "CLOSURE_OPEN_INTER_CLOSURE",CLOSURE_OPEN_INTER_CLOSURE; "CLOSURE_OPEN_INTER_SUPERSET",CLOSURE_OPEN_INTER_SUPERSET; "CLOSURE_OPEN_IN_INTER_CLOSURE",CLOSURE_OPEN_IN_INTER_CLOSURE; "CLOSURE_OUTSIDE_SUBSET",CLOSURE_OUTSIDE_SUBSET; "CLOSURE_PCROSS",CLOSURE_PCROSS; "CLOSURE_RATIONALS_IN_CONVEX_SET",CLOSURE_RATIONALS_IN_CONVEX_SET; "CLOSURE_RATIONALS_IN_OPEN_SET",CLOSURE_RATIONALS_IN_OPEN_SET; "CLOSURE_RATIONAL_COORDINATES",CLOSURE_RATIONAL_COORDINATES; "CLOSURE_SCALING",CLOSURE_SCALING; "CLOSURE_SEGMENT",CLOSURE_SEGMENT; "CLOSURE_SEQUENTIAL",CLOSURE_SEQUENTIAL; "CLOSURE_SING",CLOSURE_SING; "CLOSURE_SPHERE",CLOSURE_SPHERE; "CLOSURE_STRIP_COMPONENT_LT",CLOSURE_STRIP_COMPONENT_LT; "CLOSURE_SUBSET",CLOSURE_SUBSET; "CLOSURE_SUBSET_AFFINE_HULL",CLOSURE_SUBSET_AFFINE_HULL; "CLOSURE_SUBSET_EQ",CLOSURE_SUBSET_EQ; "CLOSURE_SUBSET_SPAN",CLOSURE_SUBSET_SPAN; "CLOSURE_SUMS",CLOSURE_SUMS; "CLOSURE_SURJECTIVE_LINEAR_IMAGE",CLOSURE_SURJECTIVE_LINEAR_IMAGE; "CLOSURE_TRANSLATION",CLOSURE_TRANSLATION; "CLOSURE_UNION",CLOSURE_UNION; "CLOSURE_UNIONS",CLOSURE_UNIONS; "CLOSURE_UNIONS_SUBSET",CLOSURE_UNIONS_SUBSET; "CLOSURE_UNION_FRONTIER",CLOSURE_UNION_FRONTIER; "CLOSURE_UNIQUE",CLOSURE_UNIQUE; "CLOSURE_UNIV",CLOSURE_UNIV; "CNJ_ADD",CNJ_ADD; "CNJ_CCOS",CNJ_CCOS; "CNJ_CEXP",CNJ_CEXP; "CNJ_CLOG",CNJ_CLOG; "CNJ_CNJ",CNJ_CNJ; "CNJ_CPRODUCT",CNJ_CPRODUCT; "CNJ_CSIN",CNJ_CSIN; "CNJ_CSQRT",CNJ_CSQRT; "CNJ_CTAN",CNJ_CTAN; "CNJ_CX",CNJ_CX; "CNJ_DIV",CNJ_DIV; "CNJ_EQ_0",CNJ_EQ_0; "CNJ_EQ_CX",CNJ_EQ_CX; "CNJ_II",CNJ_II; "CNJ_INJ",CNJ_INJ; "CNJ_INV",CNJ_INV; "CNJ_MUL",CNJ_MUL; "CNJ_NEG",CNJ_NEG; "CNJ_POW",CNJ_POW; "CNJ_SUB",CNJ_SUB; "CNJ_VSUM",CNJ_VSUM; "COBOUNDED_HAS_BOUNDED_COMPONENT",COBOUNDED_HAS_BOUNDED_COMPONENT; "COBOUNDED_IMP_UNBOUNDED",COBOUNDED_IMP_UNBOUNDED; "COBOUNDED_INTER_UNBOUNDED",COBOUNDED_INTER_UNBOUNDED; "COBOUNDED_OUTSIDE",COBOUNDED_OUTSIDE; "COBOUNDED_UNBOUNDED_COMPONENT",COBOUNDED_UNBOUNDED_COMPONENT; "COBOUNDED_UNBOUNDED_COMPONENTS",COBOUNDED_UNBOUNDED_COMPONENTS; "COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT; "COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS; "COCOUNTABLE_APPROXIMATION",COCOUNTABLE_APPROXIMATION; "CODESET_SETCODE_BIJECTIONS",CODESET_SETCODE_BIJECTIONS; "COFACTOR_0",COFACTOR_0; "COFACTOR_1",COFACTOR_1; "COFACTOR_1_GEN",COFACTOR_1_GEN; "COFACTOR_CMUL",COFACTOR_CMUL; "COFACTOR_COFACTOR",COFACTOR_COFACTOR; "COFACTOR_COLUMN",COFACTOR_COLUMN; "COFACTOR_EQ_0",COFACTOR_EQ_0; "COFACTOR_I",COFACTOR_I; "COFACTOR_MATRIX_INV",COFACTOR_MATRIX_INV; "COFACTOR_MATRIX_MUL",COFACTOR_MATRIX_MUL; "COFACTOR_ROW",COFACTOR_ROW; "COFACTOR_TRANSP",COFACTOR_TRANSP; "COHOMOTOPICALLY_TRIVIAL_1D",COHOMOTOPICALLY_TRIVIAL_1D; "COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS; "COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL; "COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; "COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; "COLLINEAR_1",COLLINEAR_1; "COLLINEAR_2",COLLINEAR_2; "COLLINEAR_3",COLLINEAR_3; "COLLINEAR_3_2D",COLLINEAR_3_2D; "COLLINEAR_3_AFFINE_HULL",COLLINEAR_3_AFFINE_HULL; "COLLINEAR_3_DOT_MULTIPLES",COLLINEAR_3_DOT_MULTIPLES; "COLLINEAR_3_EQ_AFFINE_DEPENDENT",COLLINEAR_3_EQ_AFFINE_DEPENDENT; "COLLINEAR_3_EXPAND",COLLINEAR_3_EXPAND; "COLLINEAR_3_EXPLICIT",COLLINEAR_3_EXPLICIT; "COLLINEAR_3_IN_AFFINE_HULL",COLLINEAR_3_IN_AFFINE_HULL; "COLLINEAR_3_TRANS",COLLINEAR_3_TRANS; "COLLINEAR_4_3",COLLINEAR_4_3; "COLLINEAR_AFFINE_HULL",COLLINEAR_AFFINE_HULL; "COLLINEAR_AFFINE_HULL_COLLINEAR",COLLINEAR_AFFINE_HULL_COLLINEAR; "COLLINEAR_AFF_DIM",COLLINEAR_AFF_DIM; "COLLINEAR_ALT",COLLINEAR_ALT; "COLLINEAR_ALT2",COLLINEAR_ALT2; "COLLINEAR_BETWEEN_CASES",COLLINEAR_BETWEEN_CASES; "COLLINEAR_BETWEEN_CASES_2",COLLINEAR_BETWEEN_CASES_2; "COLLINEAR_CONVEX_HULL_COLLINEAR",COLLINEAR_CONVEX_HULL_COLLINEAR; "COLLINEAR_DESCALE",COLLINEAR_DESCALE; "COLLINEAR_DIST_BETWEEN",COLLINEAR_DIST_BETWEEN; "COLLINEAR_DIST_IN_CLOSED_SEGMENT",COLLINEAR_DIST_IN_CLOSED_SEGMENT; "COLLINEAR_DIST_IN_OPEN_SEGMENT",COLLINEAR_DIST_IN_OPEN_SEGMENT; "COLLINEAR_EMPTY",COLLINEAR_EMPTY; "COLLINEAR_EXTREME_POINTS",COLLINEAR_EXTREME_POINTS; "COLLINEAR_HYPERPLANE_2",COLLINEAR_HYPERPLANE_2; "COLLINEAR_IMP_COPLANAR",COLLINEAR_IMP_COPLANAR; "COLLINEAR_LEMMA",COLLINEAR_LEMMA; "COLLINEAR_LEMMA_ALT",COLLINEAR_LEMMA_ALT; "COLLINEAR_LINEAR_IMAGE",COLLINEAR_LINEAR_IMAGE; "COLLINEAR_LINEAR_IMAGE_EQ",COLLINEAR_LINEAR_IMAGE_EQ; "COLLINEAR_MIDPOINT",COLLINEAR_MIDPOINT; "COLLINEAR_SEGMENT",COLLINEAR_SEGMENT; "COLLINEAR_SIMPLE_PATH_IMAGE",COLLINEAR_SIMPLE_PATH_IMAGE; "COLLINEAR_SING",COLLINEAR_SING; "COLLINEAR_SMALL",COLLINEAR_SMALL; "COLLINEAR_SPAN",COLLINEAR_SPAN; "COLLINEAR_STANDARD_HYPERPLANE_2",COLLINEAR_STANDARD_HYPERPLANE_2; "COLLINEAR_SUBSET",COLLINEAR_SUBSET; "COLLINEAR_TRANSLATION",COLLINEAR_TRANSLATION; "COLLINEAR_TRANSLATION_EQ",COLLINEAR_TRANSLATION_EQ; "COLLINEAR_TRIPLES",COLLINEAR_TRIPLES; "COLUMNS_IMAGE_BASIS",COLUMNS_IMAGE_BASIS; "COLUMNS_NONEMPTY",COLUMNS_NONEMPTY; "COLUMNS_TRANSP",COLUMNS_TRANSP; "COLUMN_0",COLUMN_0; "COLUMN_MATRIX_MUL",COLUMN_MATRIX_MUL; "COLUMN_TRANSP",COLUMN_TRANSP; "COMMA_DEF",COMMA_DEF; "COMMON_FRONTIER_DOMAINS",COMMON_FRONTIER_DOMAINS; "COMMUTING_MATRIX_INV_COVARIANCE",COMMUTING_MATRIX_INV_COVARIANCE; "COMMUTING_MATRIX_INV_NORMAL",COMMUTING_MATRIX_INV_NORMAL; "COMMUTING_WITH_DIAGONAL_MATRIX",COMMUTING_WITH_DIAGONAL_MATRIX; "COMMUTING_WITH_SQUARE_ROOT_MATRIX",COMMUTING_WITH_SQUARE_ROOT_MATRIX; "COMPACT_AFFINITY",COMPACT_AFFINITY; "COMPACT_AFFINITY_EQ",COMPACT_AFFINITY_EQ; "COMPACT_AR",COMPACT_AR; "COMPACT_ARC_IMAGE",COMPACT_ARC_IMAGE; "COMPACT_ATTAINS_INF",COMPACT_ATTAINS_INF; "COMPACT_ATTAINS_SUP",COMPACT_ATTAINS_SUP; "COMPACT_CBALL",COMPACT_CBALL; "COMPACT_CHAIN",COMPACT_CHAIN; "COMPACT_CLOSED_DIFFERENCES",COMPACT_CLOSED_DIFFERENCES; "COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON",COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON; "COMPACT_CLOSED_SUMS",COMPACT_CLOSED_SUMS; "COMPACT_CLOSURE",COMPACT_CLOSURE; "COMPACT_COMPONENTS",COMPACT_COMPONENTS; "COMPACT_CONNECTED_COMPONENT",COMPACT_CONNECTED_COMPONENT; "COMPACT_CONTINUOUS_IMAGE",COMPACT_CONTINUOUS_IMAGE; "COMPACT_CONTINUOUS_IMAGE_EQ",COMPACT_CONTINUOUS_IMAGE_EQ; "COMPACT_CONVEX_COLLINEAR_SEGMENT",COMPACT_CONVEX_COLLINEAR_SEGMENT; "COMPACT_CONVEX_COLLINEAR_SEGMENT_ALT",COMPACT_CONVEX_COLLINEAR_SEGMENT_ALT; "COMPACT_CONVEX_COMBINATIONS",COMPACT_CONVEX_COMBINATIONS; "COMPACT_CONVEX_HULL",COMPACT_CONVEX_HULL; "COMPACT_DIFF",COMPACT_DIFF; "COMPACT_DIFFERENCES",COMPACT_DIFFERENCES; "COMPACT_EMPTY",COMPACT_EMPTY; "COMPACT_EQ_BOLZANO_WEIERSTRASS",COMPACT_EQ_BOLZANO_WEIERSTRASS; "COMPACT_EQ_BOUNDED_CLOSED",COMPACT_EQ_BOUNDED_CLOSED; "COMPACT_EQ_HEINE_BOREL",COMPACT_EQ_HEINE_BOREL; "COMPACT_EQ_HEINE_BOREL_GEN",COMPACT_EQ_HEINE_BOREL_GEN; "COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY",COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY; "COMPACT_FIP",COMPACT_FIP; "COMPACT_FRONTIER",COMPACT_FRONTIER; "COMPACT_FRONTIER_BOUNDED",COMPACT_FRONTIER_BOUNDED; "COMPACT_FRONTIER_LINE_LEMMA",COMPACT_FRONTIER_LINE_LEMMA; "COMPACT_HAUSDIST",COMPACT_HAUSDIST; "COMPACT_IMP_ANALYTIC",COMPACT_IMP_ANALYTIC; "COMPACT_IMP_BOREL",COMPACT_IMP_BOREL; "COMPACT_IMP_BOUNDED",COMPACT_IMP_BOUNDED; "COMPACT_IMP_CLOSED",COMPACT_IMP_CLOSED; "COMPACT_IMP_COMPACT_IN_SUBTOPOLOGY",COMPACT_IMP_COMPACT_IN_SUBTOPOLOGY; "COMPACT_IMP_COMPLETE",COMPACT_IMP_COMPLETE; "COMPACT_IMP_FIP",COMPACT_IMP_FIP; "COMPACT_IMP_HEINE_BOREL",COMPACT_IMP_HEINE_BOREL; "COMPACT_IMP_TOTALLY_BOUNDED",COMPACT_IMP_TOTALLY_BOUNDED; "COMPACT_INSERT",COMPACT_INSERT; "COMPACT_INTER",COMPACT_INTER; "COMPACT_INTERS",COMPACT_INTERS; "COMPACT_INTERVAL",COMPACT_INTERVAL; "COMPACT_INTERVAL_EQ",COMPACT_INTERVAL_EQ; "COMPACT_INTER_CLOSED",COMPACT_INTER_CLOSED; "COMPACT_IN_IFF_COMPACT",COMPACT_IN_IFF_COMPACT; "COMPACT_IN_IMP_MBOUNDED",COMPACT_IN_IMP_MBOUNDED; "COMPACT_IN_MSPACE_CFUNSPACE",COMPACT_IN_MSPACE_CFUNSPACE; "COMPACT_IN_SEPARATED_UNION",COMPACT_IN_SEPARATED_UNION; "COMPACT_IN_SUBSET_TOPSPACE",COMPACT_IN_SUBSET_TOPSPACE; "COMPACT_IN_SUBTOPOLOGY_EQ",COMPACT_IN_SUBTOPOLOGY_EQ; "COMPACT_IN_SUBTOPOLOGY_IMP_COMPACT",COMPACT_IN_SUBTOPOLOGY_IMP_COMPACT; "COMPACT_LEMMA",COMPACT_LEMMA; "COMPACT_LINEAR_IMAGE",COMPACT_LINEAR_IMAGE; "COMPACT_LINEAR_IMAGE_EQ",COMPACT_LINEAR_IMAGE_EQ; "COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE",COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE; "COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE_ALT",COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE_ALT; "COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE",COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE; "COMPACT_LOCALLY_CONNECTED_IMP_ULC",COMPACT_LOCALLY_CONNECTED_IMP_ULC; "COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT",COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT; "COMPACT_NEGATIONS",COMPACT_NEGATIONS; "COMPACT_NEST",COMPACT_NEST; "COMPACT_OPEN",COMPACT_OPEN; "COMPACT_PARTITION_CONTAINING_CLOSED",COMPACT_PARTITION_CONTAINING_CLOSED; "COMPACT_PARTITION_CONTAINING_POINTS",COMPACT_PARTITION_CONTAINING_POINTS; "COMPACT_PATH_IMAGE",COMPACT_PATH_IMAGE; "COMPACT_PCROSS",COMPACT_PCROSS; "COMPACT_PCROSS_EQ",COMPACT_PCROSS_EQ; "COMPACT_REAL_LEMMA",COMPACT_REAL_LEMMA; "COMPACT_RELATIVE_BOUNDARY",COMPACT_RELATIVE_BOUNDARY; "COMPACT_RELATIVE_FRONTIER",COMPACT_RELATIVE_FRONTIER; "COMPACT_RELATIVE_FRONTIER_BOUNDED",COMPACT_RELATIVE_FRONTIER_BOUNDED; "COMPACT_SCALING",COMPACT_SCALING; "COMPACT_SCALING_EQ",COMPACT_SCALING_EQ; "COMPACT_SEGMENT",COMPACT_SEGMENT; "COMPACT_SEQUENCE_WITH_LIMIT",COMPACT_SEQUENCE_WITH_LIMIT; "COMPACT_SEQUENCE_WITH_LIMIT_GEN",COMPACT_SEQUENCE_WITH_LIMIT_GEN; "COMPACT_SIMPLEX",COMPACT_SIMPLEX; "COMPACT_SIMPLE_PATH_IMAGE",COMPACT_SIMPLE_PATH_IMAGE; "COMPACT_SING",COMPACT_SING; "COMPACT_SLICE",COMPACT_SLICE; "COMPACT_SPHERE",COMPACT_SPHERE; "COMPACT_SUBSET_FRONTIER_RETRACTION",COMPACT_SUBSET_FRONTIER_RETRACTION; "COMPACT_SUMS",COMPACT_SUMS; "COMPACT_SUP_MAXDISTANCE",COMPACT_SUP_MAXDISTANCE; "COMPACT_TRANSLATION",COMPACT_TRANSLATION; "COMPACT_TRANSLATION_EQ",COMPACT_TRANSLATION_EQ; "COMPACT_UNIFORMLY_CONTINUOUS",COMPACT_UNIFORMLY_CONTINUOUS; "COMPACT_UNIFORMLY_EQUICONTINUOUS",COMPACT_UNIFORMLY_EQUICONTINUOUS; "COMPACT_UNION",COMPACT_UNION; "COMPACT_UNIONS",COMPACT_UNIONS; "COMPACT_VALID_PATH_IMAGE",COMPACT_VALID_PATH_IMAGE; "COMPACT_WITH_INSIDE",COMPACT_WITH_INSIDE; "COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ",COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ; "COMPLEMENT_CONNECTED_COMPONENT_UNIONS",COMPLEMENT_CONNECTED_COMPONENT_UNIONS; "COMPLEMENT_PATH_COMPONENT_UNIONS",COMPLEMENT_PATH_COMPONENT_UNIONS; "COMPLETE_ABSOLUTELY_SUMMABLE",COMPLETE_ABSOLUTELY_SUMMABLE; "COMPLETE_EQ_CLOSED",COMPLETE_EQ_CLOSED; "COMPLETE_HAUSDIST",COMPLETE_HAUSDIST; "COMPLETE_HAUSDIST_CONVEX",COMPLETE_HAUSDIST_CONVEX; "COMPLETE_HAUSDIST_CONVEX_UNIV",COMPLETE_HAUSDIST_CONVEX_UNIV; "COMPLETE_HAUSDIST_UNIV",COMPLETE_HAUSDIST_UNIV; "COMPLETE_INJECTIVE_LINEAR_IMAGE",COMPLETE_INJECTIVE_LINEAR_IMAGE; "COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ",COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ; "COMPLETE_ISOMETRIC_IMAGE",COMPLETE_ISOMETRIC_IMAGE; "COMPLETE_SUBSPACE",COMPLETE_SUBSPACE; "COMPLETE_TRANSLATION_EQ",COMPLETE_TRANSLATION_EQ; "COMPLETE_UNIV",COMPLETE_UNIV; "COMPLEX",COMPLEX; "COMPLEX_ADD2_SUB2",COMPLEX_ADD2_SUB2; "COMPLEX_ADD_AC",COMPLEX_ADD_AC; "COMPLEX_ADD_ASSOC",COMPLEX_ADD_ASSOC; "COMPLEX_ADD_CCOS",COMPLEX_ADD_CCOS; "COMPLEX_ADD_CNJ",COMPLEX_ADD_CNJ; "COMPLEX_ADD_CSIN",COMPLEX_ADD_CSIN; "COMPLEX_ADD_CTAN",COMPLEX_ADD_CTAN; "COMPLEX_ADD_LDISTRIB",COMPLEX_ADD_LDISTRIB; "COMPLEX_ADD_LID",COMPLEX_ADD_LID; "COMPLEX_ADD_LINV",COMPLEX_ADD_LINV; "COMPLEX_ADD_RDISTRIB",COMPLEX_ADD_RDISTRIB; "COMPLEX_ADD_RID",COMPLEX_ADD_RID; "COMPLEX_ADD_RINV",COMPLEX_ADD_RINV; "COMPLEX_ADD_SUB",COMPLEX_ADD_SUB; "COMPLEX_ADD_SUB2",COMPLEX_ADD_SUB2; "COMPLEX_ADD_SYM",COMPLEX_ADD_SYM; "COMPLEX_BASIS",COMPLEX_BASIS; "COMPLEX_CAUCHY_SCHWARZ_EQ",COMPLEX_CAUCHY_SCHWARZ_EQ; "COMPLEX_CMUL",COMPLEX_CMUL; "COMPLEX_DERIVATIVE_ADD",COMPLEX_DERIVATIVE_ADD; "COMPLEX_DERIVATIVE_ADD_AT",COMPLEX_DERIVATIVE_ADD_AT; "COMPLEX_DERIVATIVE_CHAIN",COMPLEX_DERIVATIVE_CHAIN; "COMPLEX_DERIVATIVE_COMPOSE_LINEAR",COMPLEX_DERIVATIVE_COMPOSE_LINEAR; "COMPLEX_DERIVATIVE_CONST",COMPLEX_DERIVATIVE_CONST; "COMPLEX_DERIVATIVE_ID",COMPLEX_DERIVATIVE_ID; "COMPLEX_DERIVATIVE_JACOBIAN",COMPLEX_DERIVATIVE_JACOBIAN; "COMPLEX_DERIVATIVE_LINEAR",COMPLEX_DERIVATIVE_LINEAR; "COMPLEX_DERIVATIVE_LMUL",COMPLEX_DERIVATIVE_LMUL; "COMPLEX_DERIVATIVE_LMUL_AT",COMPLEX_DERIVATIVE_LMUL_AT; "COMPLEX_DERIVATIVE_MUL",COMPLEX_DERIVATIVE_MUL; "COMPLEX_DERIVATIVE_MUL_AT",COMPLEX_DERIVATIVE_MUL_AT; "COMPLEX_DERIVATIVE_RMUL",COMPLEX_DERIVATIVE_RMUL; "COMPLEX_DERIVATIVE_RMUL_AT",COMPLEX_DERIVATIVE_RMUL_AT; "COMPLEX_DERIVATIVE_SUB",COMPLEX_DERIVATIVE_SUB; "COMPLEX_DERIVATIVE_SUB_AT",COMPLEX_DERIVATIVE_SUB_AT; "COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN",COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; "COMPLEX_DERIVATIVE_UNIQUE_AT",COMPLEX_DERIVATIVE_UNIQUE_AT; "COMPLEX_DIFFERENTIABLE_ADD",COMPLEX_DIFFERENTIABLE_ADD; "COMPLEX_DIFFERENTIABLE_AT_CACS",COMPLEX_DIFFERENTIABLE_AT_CACS; "COMPLEX_DIFFERENTIABLE_AT_CASN",COMPLEX_DIFFERENTIABLE_AT_CASN; "COMPLEX_DIFFERENTIABLE_AT_CATN",COMPLEX_DIFFERENTIABLE_AT_CATN; "COMPLEX_DIFFERENTIABLE_AT_CCOS",COMPLEX_DIFFERENTIABLE_AT_CCOS; "COMPLEX_DIFFERENTIABLE_AT_CEXP",COMPLEX_DIFFERENTIABLE_AT_CEXP; "COMPLEX_DIFFERENTIABLE_AT_CLOG",COMPLEX_DIFFERENTIABLE_AT_CLOG; "COMPLEX_DIFFERENTIABLE_AT_CSIN",COMPLEX_DIFFERENTIABLE_AT_CSIN; "COMPLEX_DIFFERENTIABLE_AT_CSQRT",COMPLEX_DIFFERENTIABLE_AT_CSQRT; "COMPLEX_DIFFERENTIABLE_AT_CTAN",COMPLEX_DIFFERENTIABLE_AT_CTAN; "COMPLEX_DIFFERENTIABLE_AT_WITHIN",COMPLEX_DIFFERENTIABLE_AT_WITHIN; "COMPLEX_DIFFERENTIABLE_BOUND",COMPLEX_DIFFERENTIABLE_BOUND; "COMPLEX_DIFFERENTIABLE_CARATHEODORY_AT",COMPLEX_DIFFERENTIABLE_CARATHEODORY_AT; "COMPLEX_DIFFERENTIABLE_CARATHEODORY_WITHIN",COMPLEX_DIFFERENTIABLE_CARATHEODORY_WITHIN; "COMPLEX_DIFFERENTIABLE_COMPOSE",COMPLEX_DIFFERENTIABLE_COMPOSE; "COMPLEX_DIFFERENTIABLE_COMPOSE_AT",COMPLEX_DIFFERENTIABLE_COMPOSE_AT; "COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN",COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN; "COMPLEX_DIFFERENTIABLE_CONST",COMPLEX_DIFFERENTIABLE_CONST; "COMPLEX_DIFFERENTIABLE_CPOW_RIGHT",COMPLEX_DIFFERENTIABLE_CPOW_RIGHT; "COMPLEX_DIFFERENTIABLE_CPRODUCT_AT",COMPLEX_DIFFERENTIABLE_CPRODUCT_AT; "COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN",COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN; "COMPLEX_DIFFERENTIABLE_DIV_AT",COMPLEX_DIFFERENTIABLE_DIV_AT; "COMPLEX_DIFFERENTIABLE_DIV_WITHIN",COMPLEX_DIFFERENTIABLE_DIV_WITHIN; "COMPLEX_DIFFERENTIABLE_EQ_CONFORMAL",COMPLEX_DIFFERENTIABLE_EQ_CONFORMAL; "COMPLEX_DIFFERENTIABLE_ID",COMPLEX_DIFFERENTIABLE_ID; "COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT",COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT; "COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN",COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; "COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE",COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE; "COMPLEX_DIFFERENTIABLE_INV_AT",COMPLEX_DIFFERENTIABLE_INV_AT; "COMPLEX_DIFFERENTIABLE_INV_WITHIN",COMPLEX_DIFFERENTIABLE_INV_WITHIN; "COMPLEX_DIFFERENTIABLE_LINEAR",COMPLEX_DIFFERENTIABLE_LINEAR; "COMPLEX_DIFFERENTIABLE_MUL_AT",COMPLEX_DIFFERENTIABLE_MUL_AT; "COMPLEX_DIFFERENTIABLE_MUL_WITHIN",COMPLEX_DIFFERENTIABLE_MUL_WITHIN; "COMPLEX_DIFFERENTIABLE_NEG",COMPLEX_DIFFERENTIABLE_NEG; "COMPLEX_DIFFERENTIABLE_POW_AT",COMPLEX_DIFFERENTIABLE_POW_AT; "COMPLEX_DIFFERENTIABLE_POW_WITHIN",COMPLEX_DIFFERENTIABLE_POW_WITHIN; "COMPLEX_DIFFERENTIABLE_SUB",COMPLEX_DIFFERENTIABLE_SUB; "COMPLEX_DIFFERENTIABLE_TRANSFORM_AT",COMPLEX_DIFFERENTIABLE_TRANSFORM_AT; "COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN",COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN; "COMPLEX_DIFFERENTIABLE_WITHIN_CACS",COMPLEX_DIFFERENTIABLE_WITHIN_CACS; "COMPLEX_DIFFERENTIABLE_WITHIN_CASN",COMPLEX_DIFFERENTIABLE_WITHIN_CASN; "COMPLEX_DIFFERENTIABLE_WITHIN_CATN",COMPLEX_DIFFERENTIABLE_WITHIN_CATN; "COMPLEX_DIFFERENTIABLE_WITHIN_CCOS",COMPLEX_DIFFERENTIABLE_WITHIN_CCOS; "COMPLEX_DIFFERENTIABLE_WITHIN_CEXP",COMPLEX_DIFFERENTIABLE_WITHIN_CEXP; "COMPLEX_DIFFERENTIABLE_WITHIN_CLOG",COMPLEX_DIFFERENTIABLE_WITHIN_CLOG; "COMPLEX_DIFFERENTIABLE_WITHIN_CSIN",COMPLEX_DIFFERENTIABLE_WITHIN_CSIN; "COMPLEX_DIFFERENTIABLE_WITHIN_CSQRT",COMPLEX_DIFFERENTIABLE_WITHIN_CSQRT; "COMPLEX_DIFFERENTIABLE_WITHIN_CTAN",COMPLEX_DIFFERENTIABLE_WITHIN_CTAN; "COMPLEX_DIFFERENTIABLE_WITHIN_OPEN",COMPLEX_DIFFERENTIABLE_WITHIN_OPEN; "COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET",COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET; "COMPLEX_DIFFSQ",COMPLEX_DIFFSQ; "COMPLEX_DIFF_CHAIN_AT",COMPLEX_DIFF_CHAIN_AT; "COMPLEX_DIFF_CHAIN_WITHIN",COMPLEX_DIFF_CHAIN_WITHIN; "COMPLEX_DIV_1",COMPLEX_DIV_1; "COMPLEX_DIV_CNJ",COMPLEX_DIV_CNJ; "COMPLEX_DIV_EQ_0",COMPLEX_DIV_EQ_0; "COMPLEX_DIV_LMUL",COMPLEX_DIV_LMUL; "COMPLEX_DIV_POW",COMPLEX_DIV_POW; "COMPLEX_DIV_POW2",COMPLEX_DIV_POW2; "COMPLEX_DIV_REFL",COMPLEX_DIV_REFL; "COMPLEX_DIV_RMUL",COMPLEX_DIV_RMUL; "COMPLEX_DIV_ROTATION",COMPLEX_DIV_ROTATION; "COMPLEX_ENTIRE",COMPLEX_ENTIRE; "COMPLEX_EQ",COMPLEX_EQ; "COMPLEX_EQ_0",COMPLEX_EQ_0; "COMPLEX_EQ_ADD_LCANCEL",COMPLEX_EQ_ADD_LCANCEL; "COMPLEX_EQ_ADD_LCANCEL_0",COMPLEX_EQ_ADD_LCANCEL_0; "COMPLEX_EQ_ADD_RCANCEL",COMPLEX_EQ_ADD_RCANCEL; "COMPLEX_EQ_ADD_RCANCEL_0",COMPLEX_EQ_ADD_RCANCEL_0; "COMPLEX_EQ_CEXP",COMPLEX_EQ_CEXP; "COMPLEX_EQ_INV2",COMPLEX_EQ_INV2; "COMPLEX_EQ_MUL_LCANCEL",COMPLEX_EQ_MUL_LCANCEL; "COMPLEX_EQ_MUL_RCANCEL",COMPLEX_EQ_MUL_RCANCEL; "COMPLEX_EQ_NEG2",COMPLEX_EQ_NEG2; "COMPLEX_EQ_SUB_LADD",COMPLEX_EQ_SUB_LADD; "COMPLEX_EQ_SUB_RADD",COMPLEX_EQ_SUB_RADD; "COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE",COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE; "COMPLEX_EXPAND",COMPLEX_EXPAND; "COMPLEX_INTEGER",COMPLEX_INTEGER; "COMPLEX_INV_0",COMPLEX_INV_0; "COMPLEX_INV_1",COMPLEX_INV_1; "COMPLEX_INV_CNJ",COMPLEX_INV_CNJ; "COMPLEX_INV_DIV",COMPLEX_INV_DIV; "COMPLEX_INV_EQ_0",COMPLEX_INV_EQ_0; "COMPLEX_INV_EQ_1",COMPLEX_INV_EQ_1; "COMPLEX_INV_II",COMPLEX_INV_II; "COMPLEX_INV_INV",COMPLEX_INV_INV; "COMPLEX_INV_MUL",COMPLEX_INV_MUL; "COMPLEX_INV_NEG",COMPLEX_INV_NEG; "COMPLEX_IN_BALL_0",COMPLEX_IN_BALL_0; "COMPLEX_IN_CBALL_0",COMPLEX_IN_CBALL_0; "COMPLEX_IN_SPHERE_0",COMPLEX_IN_SPHERE_0; "COMPLEX_L1_LE_NORM",COMPLEX_L1_LE_NORM; "COMPLEX_LINEAR",COMPLEX_LINEAR; "COMPLEX_LINEAR_ALT",COMPLEX_LINEAR_ALT; "COMPLEX_LNEG_UNIQ",COMPLEX_LNEG_UNIQ; "COMPLEX_MUL_2",COMPLEX_MUL_2; "COMPLEX_MUL_AC",COMPLEX_MUL_AC; "COMPLEX_MUL_ASSOC",COMPLEX_MUL_ASSOC; "COMPLEX_MUL_CCOS_CCOS",COMPLEX_MUL_CCOS_CCOS; "COMPLEX_MUL_CCOS_CSIN",COMPLEX_MUL_CCOS_CSIN; "COMPLEX_MUL_CNJ",COMPLEX_MUL_CNJ; "COMPLEX_MUL_CSIN_CCOS",COMPLEX_MUL_CSIN_CCOS; "COMPLEX_MUL_CSIN_CSIN",COMPLEX_MUL_CSIN_CSIN; "COMPLEX_MUL_LID",COMPLEX_MUL_LID; "COMPLEX_MUL_LINV",COMPLEX_MUL_LINV; "COMPLEX_MUL_LNEG",COMPLEX_MUL_LNEG; "COMPLEX_MUL_LZERO",COMPLEX_MUL_LZERO; "COMPLEX_MUL_RID",COMPLEX_MUL_RID; "COMPLEX_MUL_RINV",COMPLEX_MUL_RINV; "COMPLEX_MUL_RNEG",COMPLEX_MUL_RNEG; "COMPLEX_MUL_RZERO",COMPLEX_MUL_RZERO; "COMPLEX_MUL_SYM",COMPLEX_MUL_SYM; "COMPLEX_MVT",COMPLEX_MVT; "COMPLEX_MVT_LINE",COMPLEX_MVT_LINE; "COMPLEX_NEG_0",COMPLEX_NEG_0; "COMPLEX_NEG_ADD",COMPLEX_NEG_ADD; "COMPLEX_NEG_EQ",COMPLEX_NEG_EQ; "COMPLEX_NEG_EQ_0",COMPLEX_NEG_EQ_0; "COMPLEX_NEG_INV",COMPLEX_NEG_INV; "COMPLEX_NEG_LMUL",COMPLEX_NEG_LMUL; "COMPLEX_NEG_MINUS1",COMPLEX_NEG_MINUS1; "COMPLEX_NEG_MUL2",COMPLEX_NEG_MUL2; "COMPLEX_NEG_NEG",COMPLEX_NEG_NEG; "COMPLEX_NEG_RMUL",COMPLEX_NEG_RMUL; "COMPLEX_NEG_SUB",COMPLEX_NEG_SUB; "COMPLEX_NORM_0",COMPLEX_NORM_0; "COMPLEX_NORM_ABS_NORM",COMPLEX_NORM_ABS_NORM; "COMPLEX_NORM_CNJ",COMPLEX_NORM_CNJ; "COMPLEX_NORM_CX",COMPLEX_NORM_CX; "COMPLEX_NORM_DIV",COMPLEX_NORM_DIV; "COMPLEX_NORM_EQ_1_CEXP",COMPLEX_NORM_EQ_1_CEXP; "COMPLEX_NORM_GE_RE_IM",COMPLEX_NORM_GE_RE_IM; "COMPLEX_NORM_II",COMPLEX_NORM_II; "COMPLEX_NORM_INV",COMPLEX_NORM_INV; "COMPLEX_NORM_LE_RE_IM",COMPLEX_NORM_LE_RE_IM; "COMPLEX_NORM_MUL",COMPLEX_NORM_MUL; "COMPLEX_NORM_NUM",COMPLEX_NORM_NUM; "COMPLEX_NORM_NZ",COMPLEX_NORM_NZ; "COMPLEX_NORM_POW",COMPLEX_NORM_POW; "COMPLEX_NORM_POW_2",COMPLEX_NORM_POW_2; "COMPLEX_NORM_TRIANGLE_SUB",COMPLEX_NORM_TRIANGLE_SUB; "COMPLEX_NORM_VSUM_BOUND",COMPLEX_NORM_VSUM_BOUND; "COMPLEX_NORM_VSUM_BOUND_SUBSET",COMPLEX_NORM_VSUM_BOUND_SUBSET; "COMPLEX_NORM_VSUM_SUM_RE",COMPLEX_NORM_VSUM_SUM_RE; "COMPLEX_NORM_ZERO",COMPLEX_NORM_ZERO; "COMPLEX_NOT_ROOT_UNITY",COMPLEX_NOT_ROOT_UNITY; "COMPLEX_ORTHOGONAL_ROTATION",COMPLEX_ORTHOGONAL_ROTATION; "COMPLEX_ORTHOGONAL_ROTOINVERSION",COMPLEX_ORTHOGONAL_ROTOINVERSION; "COMPLEX_ORTHOGONAL_TRANSFORMATION",COMPLEX_ORTHOGONAL_TRANSFORMATION; "COMPLEX_POLYFUN_EQ_0",COMPLEX_POLYFUN_EQ_0; "COMPLEX_POLYFUN_EQ_CONST",COMPLEX_POLYFUN_EQ_CONST; "COMPLEX_POLYFUN_EXTREMAL",COMPLEX_POLYFUN_EXTREMAL; "COMPLEX_POLYFUN_EXTREMAL_LEMMA",COMPLEX_POLYFUN_EXTREMAL_LEMMA; "COMPLEX_POLYFUN_FINITE_ROOTS",COMPLEX_POLYFUN_FINITE_ROOTS; "COMPLEX_POLYFUN_LINEAR_FACTOR",COMPLEX_POLYFUN_LINEAR_FACTOR; "COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT",COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT; "COMPLEX_POLYFUN_ROOTBOUND",COMPLEX_POLYFUN_ROOTBOUND; "COMPLEX_POLY_CLAUSES",COMPLEX_POLY_CLAUSES; "COMPLEX_POLY_NEG_CLAUSES",COMPLEX_POLY_NEG_CLAUSES; "COMPLEX_POW_1",COMPLEX_POW_1; "COMPLEX_POW_2",COMPLEX_POW_2; "COMPLEX_POW_ADD",COMPLEX_POW_ADD; "COMPLEX_POW_DIV",COMPLEX_POW_DIV; "COMPLEX_POW_EQ_0",COMPLEX_POW_EQ_0; "COMPLEX_POW_EQ_1",COMPLEX_POW_EQ_1; "COMPLEX_POW_II_2",COMPLEX_POW_II_2; "COMPLEX_POW_INV",COMPLEX_POW_INV; "COMPLEX_POW_MUL",COMPLEX_POW_MUL; "COMPLEX_POW_NEG",COMPLEX_POW_NEG; "COMPLEX_POW_ONE",COMPLEX_POW_ONE; "COMPLEX_POW_POW",COMPLEX_POW_POW; "COMPLEX_POW_ZERO",COMPLEX_POW_ZERO; "COMPLEX_RNEG_UNIQ",COMPLEX_RNEG_UNIQ; "COMPLEX_ROOTS_UNITY",COMPLEX_ROOTS_UNITY; "COMPLEX_ROOT_POLYFUN",COMPLEX_ROOT_POLYFUN; "COMPLEX_ROOT_UNITY",COMPLEX_ROOT_UNITY; "COMPLEX_ROOT_UNITY_EQ",COMPLEX_ROOT_UNITY_EQ; "COMPLEX_ROOT_UNITY_EQ_1",COMPLEX_ROOT_UNITY_EQ_1; "COMPLEX_SQNORM",COMPLEX_SQNORM; "COMPLEX_STONE_WEIERSTRASS",COMPLEX_STONE_WEIERSTRASS; "COMPLEX_STONE_WEIERSTRASS_ALT",COMPLEX_STONE_WEIERSTRASS_ALT; "COMPLEX_SUB_0",COMPLEX_SUB_0; "COMPLEX_SUB_ADD",COMPLEX_SUB_ADD; "COMPLEX_SUB_ADD2",COMPLEX_SUB_ADD2; "COMPLEX_SUB_CCOS",COMPLEX_SUB_CCOS; "COMPLEX_SUB_CSIN",COMPLEX_SUB_CSIN; "COMPLEX_SUB_CTAN",COMPLEX_SUB_CTAN; "COMPLEX_SUB_LDISTRIB",COMPLEX_SUB_LDISTRIB; "COMPLEX_SUB_LNEG",COMPLEX_SUB_LNEG; "COMPLEX_SUB_LZERO",COMPLEX_SUB_LZERO; "COMPLEX_SUB_NEG2",COMPLEX_SUB_NEG2; "COMPLEX_SUB_POLYFUN",COMPLEX_SUB_POLYFUN; "COMPLEX_SUB_POLYFUN_ALT",COMPLEX_SUB_POLYFUN_ALT; "COMPLEX_SUB_POW",COMPLEX_SUB_POW; "COMPLEX_SUB_POW_L1",COMPLEX_SUB_POW_L1; "COMPLEX_SUB_POW_R1",COMPLEX_SUB_POW_R1; "COMPLEX_SUB_RDISTRIB",COMPLEX_SUB_RDISTRIB; "COMPLEX_SUB_REFL",COMPLEX_SUB_REFL; "COMPLEX_SUB_RNEG",COMPLEX_SUB_RNEG; "COMPLEX_SUB_RZERO",COMPLEX_SUB_RZERO; "COMPLEX_SUB_SUB",COMPLEX_SUB_SUB; "COMPLEX_SUB_SUB2",COMPLEX_SUB_SUB2; "COMPLEX_SUB_TRIANGLE",COMPLEX_SUB_TRIANGLE; "COMPLEX_TAYLOR",COMPLEX_TAYLOR; "COMPLEX_TAYLOR_MVT",COMPLEX_TAYLOR_MVT; "COMPLEX_TRAD",COMPLEX_TRAD; "COMPLEX_UNIMODULAR_POLAR",COMPLEX_UNIMODULAR_POLAR; "COMPLEX_VEC_0",COMPLEX_VEC_0; "COMPL_COMPL",COMPL_COMPL; "COMPONENT",COMPONENT; "COMPONENTS_COMPLEMENT_FRONTIER",COMPONENTS_COMPLEMENT_FRONTIER; "COMPONENTS_CONVEX_COMPLEMENT_CONTAINS_HALFSPACE",COMPONENTS_CONVEX_COMPLEMENT_CONTAINS_HALFSPACE; "COMPONENTS_EMPTY",COMPONENTS_EMPTY; "COMPONENTS_EQ",COMPONENTS_EQ; "COMPONENTS_EQ_EMPTY",COMPONENTS_EQ_EMPTY; "COMPONENTS_EQ_SING",COMPONENTS_EQ_SING; "COMPONENTS_EQ_SING_EXISTS",COMPONENTS_EQ_SING_EXISTS; "COMPONENTS_INTERMEDIATE_SUBSET",COMPONENTS_INTERMEDIATE_SUBSET; "COMPONENTS_INTER_COMPONENTS",COMPONENTS_INTER_COMPONENTS; "COMPONENTS_LINEAR_IMAGE",COMPONENTS_LINEAR_IMAGE; "COMPONENTS_MAXIMAL",COMPONENTS_MAXIMAL; "COMPONENTS_NONOVERLAP",COMPONENTS_NONOVERLAP; "COMPONENTS_OPEN_UNIQUE",COMPONENTS_OPEN_UNIQUE; "COMPONENTS_PCROSS",COMPONENTS_PCROSS; "COMPONENTS_SEPARATED_UNION",COMPONENTS_SEPARATED_UNION; "COMPONENTS_SUBSETS_CLOPEN_PARTITION",COMPONENTS_SUBSETS_CLOPEN_PARTITION; "COMPONENTS_TRANSLATION",COMPONENTS_TRANSLATION; "COMPONENTS_UNIQUE",COMPONENTS_UNIQUE; "COMPONENTS_UNIQUE_2",COMPONENTS_UNIQUE_2; "COMPONENTS_UNIQUE_EQ",COMPONENTS_UNIQUE_EQ; "COMPONENTS_UNIV",COMPONENTS_UNIV; "COMPONENT_CLOPEN_HAUSDIST",COMPONENT_CLOPEN_HAUSDIST; "COMPONENT_CLOPEN_HAUSDIST_EXPLICIT",COMPONENT_CLOPEN_HAUSDIST_EXPLICIT; "COMPONENT_COMPLEMENT_CONNECTED",COMPONENT_COMPLEMENT_CONNECTED; "COMPONENT_INTERMEDIATE_CLOPEN",COMPONENT_INTERMEDIATE_CLOPEN; "COMPONENT_LE_INFNORM",COMPONENT_LE_INFNORM; "COMPONENT_LE_NORM",COMPONENT_LE_NORM; "COMPONENT_LE_ONORM",COMPONENT_LE_ONORM; "COMPONENT_RETRACT_COMPLEMENT_MEETS",COMPONENT_RETRACT_COMPLEMENT_MEETS; "CONDENSATION_POINTS_EQ_EMPTY",CONDENSATION_POINTS_EQ_EMPTY; "CONDENSATION_POINT_ALT",CONDENSATION_POINT_ALT; "CONDENSATION_POINT_IMP_LIMPT",CONDENSATION_POINT_IMP_LIMPT; "CONDENSATION_POINT_INFINITE_BALL",CONDENSATION_POINT_INFINITE_BALL; "CONDENSATION_POINT_INFINITE_CBALL",CONDENSATION_POINT_INFINITE_CBALL; "CONDENSATION_POINT_OF_CONDENSATION_POINTS",CONDENSATION_POINT_OF_CONDENSATION_POINTS; "CONDENSATION_POINT_OF_SUBSET",CONDENSATION_POINT_OF_SUBSET; "COND_ABS",COND_ABS; "COND_CLAUSES",COND_CLAUSES; "COND_COMPONENT",COND_COMPONENT; "COND_DEF",COND_DEF; "COND_ELIM_THM",COND_ELIM_THM; "COND_EXPAND",COND_EXPAND; "COND_ID",COND_ID; "COND_RAND",COND_RAND; "COND_RATOR",COND_RATOR; "COND_SWAP",COND_SWAP; "CONGRUENT_IMAGE_STD_SIMPLEX",CONGRUENT_IMAGE_STD_SIMPLEX; "CONIC_CLOSURE",CONIC_CLOSURE; "CONIC_CONIC_HULL",CONIC_CONIC_HULL; "CONIC_CONTAINS_0",CONIC_CONTAINS_0; "CONIC_CONVEX_CONE_HULL",CONIC_CONVEX_CONE_HULL; "CONIC_CONVEX_HULL",CONIC_CONVEX_HULL; "CONIC_EMPTY",CONIC_EMPTY; "CONIC_HALFSPACE_GE",CONIC_HALFSPACE_GE; "CONIC_HALFSPACE_LE",CONIC_HALFSPACE_LE; "CONIC_HULLS_EQ_IMP_SPANS_EQ",CONIC_HULLS_EQ_IMP_SPANS_EQ; "CONIC_HULL_0",CONIC_HULL_0; "CONIC_HULL_AS_IMAGE",CONIC_HULL_AS_IMAGE; "CONIC_HULL_CONTAINS_0",CONIC_HULL_CONTAINS_0; "CONIC_HULL_CONVEX_HULL",CONIC_HULL_CONVEX_HULL; "CONIC_HULL_DIFF",CONIC_HULL_DIFF; "CONIC_HULL_EMPTY",CONIC_HULL_EMPTY; "CONIC_HULL_EQ",CONIC_HULL_EQ; "CONIC_HULL_EQ_AFFINE_HULL",CONIC_HULL_EQ_AFFINE_HULL; "CONIC_HULL_EQ_EMPTY",CONIC_HULL_EQ_EMPTY; "CONIC_HULL_EQ_SING",CONIC_HULL_EQ_SING; "CONIC_HULL_EQ_SPAN",CONIC_HULL_EQ_SPAN; "CONIC_HULL_EQ_SPAN_EQ",CONIC_HULL_EQ_SPAN_EQ; "CONIC_HULL_EXPLICIT",CONIC_HULL_EXPLICIT; "CONIC_HULL_IMAGE_SCALE",CONIC_HULL_IMAGE_SCALE; "CONIC_HULL_INTER",CONIC_HULL_INTER; "CONIC_HULL_INTER_AFFINE_HULL",CONIC_HULL_INTER_AFFINE_HULL; "CONIC_HULL_LINEAR_IMAGE",CONIC_HULL_LINEAR_IMAGE; "CONIC_HULL_POINTLESS_AS_IMAGE",CONIC_HULL_POINTLESS_AS_IMAGE; "CONIC_HULL_RELATIVE_FRONTIER",CONIC_HULL_RELATIVE_FRONTIER; "CONIC_HULL_RELATIVE_INTERIOR",CONIC_HULL_RELATIVE_INTERIOR; "CONIC_HULL_RELATIVE_INTERIOR_SUBSET",CONIC_HULL_RELATIVE_INTERIOR_SUBSET; "CONIC_HULL_SUBSET_CONVEX_CONE_HULL",CONIC_HULL_SUBSET_CONVEX_CONE_HULL; "CONIC_HULL_SUBSET_SPAN",CONIC_HULL_SUBSET_SPAN; "CONIC_HULL_UNIV",CONIC_HULL_UNIV; "CONIC_HULL_VERTEX_IMAGE_LINEAR",CONIC_HULL_VERTEX_IMAGE_LINEAR; "CONIC_IMAGE_MULTIPLE",CONIC_IMAGE_MULTIPLE; "CONIC_IMAGE_MULTIPLE_EQ",CONIC_IMAGE_MULTIPLE_EQ; "CONIC_IMP_BORSUKIAN",CONIC_IMP_BORSUKIAN; "CONIC_IMP_CONNECTED",CONIC_IMP_CONNECTED; "CONIC_IMP_CONTRACTIBLE",CONIC_IMP_CONTRACTIBLE; "CONIC_IMP_PATH_CONNECTED",CONIC_IMP_PATH_CONNECTED; "CONIC_IMP_SIMPLY_CONNECTED",CONIC_IMP_SIMPLY_CONNECTED; "CONIC_IMP_STARLIKE",CONIC_IMP_STARLIKE; "CONIC_INTERIOR",CONIC_INTERIOR; "CONIC_INTERIOR_INSERT",CONIC_INTERIOR_INSERT; "CONIC_INTERS",CONIC_INTERS; "CONIC_LINEAR_IMAGE",CONIC_LINEAR_IMAGE; "CONIC_LINEAR_IMAGE_EQ",CONIC_LINEAR_IMAGE_EQ; "CONIC_MUL",CONIC_MUL; "CONIC_NEGATIONS",CONIC_NEGATIONS; "CONIC_PCROSS",CONIC_PCROSS; "CONIC_PCROSS_EQ",CONIC_PCROSS_EQ; "CONIC_POSITIVE_ORTHANT",CONIC_POSITIVE_ORTHANT; "CONIC_RELATIVE_INTERIOR",CONIC_RELATIVE_INTERIOR; "CONIC_RELATIVE_INTERIOR_INSERT",CONIC_RELATIVE_INTERIOR_INSERT; "CONIC_SPAN",CONIC_SPAN; "CONIC_SUBSET_AS_CONIC_HULL",CONIC_SUBSET_AS_CONIC_HULL; "CONIC_SUMS",CONIC_SUMS; "CONIC_UNIV",CONIC_UNIV; "CONJ_ACI",CONJ_ACI; "CONJ_ASSOC",CONJ_ASSOC; "CONJ_SYM",CONJ_SYM; "CONNECTED",CONNECTED; "CONNECTED_2",CONNECTED_2; "CONNECTED_AFFINITY",CONNECTED_AFFINITY; "CONNECTED_AFFINITY_EQ",CONNECTED_AFFINITY_EQ; "CONNECTED_ANNULUS",CONNECTED_ANNULUS; "CONNECTED_ARC_COMPLEMENT",CONNECTED_ARC_COMPLEMENT; "CONNECTED_ARC_IMAGE",CONNECTED_ARC_IMAGE; "CONNECTED_ARC_IMAGE_DELETE",CONNECTED_ARC_IMAGE_DELETE; "CONNECTED_BALL",CONNECTED_BALL; "CONNECTED_CARD_EQ_IFF_NONTRIVIAL",CONNECTED_CARD_EQ_IFF_NONTRIVIAL; "CONNECTED_CARD_LT_IFF_TRIVIAL",CONNECTED_CARD_LT_IFF_TRIVIAL; "CONNECTED_CBALL",CONNECTED_CBALL; "CONNECTED_CHAIN",CONNECTED_CHAIN; "CONNECTED_CHAIN_GEN",CONNECTED_CHAIN_GEN; "CONNECTED_CLOPEN",CONNECTED_CLOPEN; "CONNECTED_CLOSED",CONNECTED_CLOSED; "CONNECTED_CLOSED_IN",CONNECTED_CLOSED_IN; "CONNECTED_CLOSED_IN_EQ",CONNECTED_CLOSED_IN_EQ; "CONNECTED_CLOSED_MONOTONE_PREIMAGE",CONNECTED_CLOSED_MONOTONE_PREIMAGE; "CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON",CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON; "CONNECTED_CLOSED_SET",CONNECTED_CLOSED_SET; "CONNECTED_CLOSURE",CONNECTED_CLOSURE; "CONNECTED_CLOSURE_FROM_FRONTIER",CONNECTED_CLOSURE_FROM_FRONTIER; "CONNECTED_COMMON_FRONTIER_DOMAINS",CONNECTED_COMMON_FRONTIER_DOMAINS; "CONNECTED_COMPACT_INTERVAL_1",CONNECTED_COMPACT_INTERVAL_1; "CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; "CONNECTED_COMPLEMENT_BOUNDED_CONVEX",CONNECTED_COMPLEMENT_BOUNDED_CONVEX; "CONNECTED_COMPLEMENT_CONTRACTIBLE",CONNECTED_COMPLEMENT_CONTRACTIBLE; "CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; "CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS",CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS; "CONNECTED_COMPLEMENT_SIMPLE_PATH_IMAGE",CONNECTED_COMPLEMENT_SIMPLE_PATH_IMAGE; "CONNECTED_COMPLEMENT_SUBSET_CIRCLE",CONNECTED_COMPLEMENT_SUBSET_CIRCLE; "CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE",CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE; "CONNECTED_COMPONENTS",CONNECTED_COMPONENTS; "CONNECTED_COMPONENT_1",CONNECTED_COMPONENT_1; "CONNECTED_COMPONENT_1_GEN",CONNECTED_COMPONENT_1_GEN; "CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED",CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED; "CONNECTED_COMPONENT_DIFF_NONSEPARATED",CONNECTED_COMPONENT_DIFF_NONSEPARATED; "CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT",CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT; "CONNECTED_COMPONENT_DISJOINT",CONNECTED_COMPONENT_DISJOINT; "CONNECTED_COMPONENT_EMPTY",CONNECTED_COMPONENT_EMPTY; "CONNECTED_COMPONENT_EQ",CONNECTED_COMPONENT_EQ; "CONNECTED_COMPONENT_EQUIVALENCE_RELATION",CONNECTED_COMPONENT_EQUIVALENCE_RELATION; "CONNECTED_COMPONENT_EQ_EMPTY",CONNECTED_COMPONENT_EQ_EMPTY; "CONNECTED_COMPONENT_EQ_EQ",CONNECTED_COMPONENT_EQ_EQ; "CONNECTED_COMPONENT_EQ_SELF",CONNECTED_COMPONENT_EQ_SELF; "CONNECTED_COMPONENT_EQ_UNIV",CONNECTED_COMPONENT_EQ_UNIV; "CONNECTED_COMPONENT_EQ_WELLCHAINED",CONNECTED_COMPONENT_EQ_WELLCHAINED; "CONNECTED_COMPONENT_IDEMP",CONNECTED_COMPONENT_IDEMP; "CONNECTED_COMPONENT_IMP_WELLCHAINED",CONNECTED_COMPONENT_IMP_WELLCHAINED; "CONNECTED_COMPONENT_IN",CONNECTED_COMPONENT_IN; "CONNECTED_COMPONENT_INSIDE",CONNECTED_COMPONENT_INSIDE; "CONNECTED_COMPONENT_INTERMEDIATE_SUBSET",CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; "CONNECTED_COMPONENT_IN_COMPONENTS",CONNECTED_COMPONENT_IN_COMPONENTS; "CONNECTED_COMPONENT_LIMIT",CONNECTED_COMPONENT_LIMIT; "CONNECTED_COMPONENT_LINEAR_IMAGE",CONNECTED_COMPONENT_LINEAR_IMAGE; "CONNECTED_COMPONENT_MAXIMAL",CONNECTED_COMPONENT_MAXIMAL; "CONNECTED_COMPONENT_MONO",CONNECTED_COMPONENT_MONO; "CONNECTED_COMPONENT_NONOVERLAP",CONNECTED_COMPONENT_NONOVERLAP; "CONNECTED_COMPONENT_OF_SUBSET",CONNECTED_COMPONENT_OF_SUBSET; "CONNECTED_COMPONENT_OUTSIDE",CONNECTED_COMPONENT_OUTSIDE; "CONNECTED_COMPONENT_OVERLAP",CONNECTED_COMPONENT_OVERLAP; "CONNECTED_COMPONENT_PCROSS",CONNECTED_COMPONENT_PCROSS; "CONNECTED_COMPONENT_REFL",CONNECTED_COMPONENT_REFL; "CONNECTED_COMPONENT_REFL_EQ",CONNECTED_COMPONENT_REFL_EQ; "CONNECTED_COMPONENT_SEPARATED_UNION",CONNECTED_COMPONENT_SEPARATED_UNION; "CONNECTED_COMPONENT_SET",CONNECTED_COMPONENT_SET; "CONNECTED_COMPONENT_SUBSET",CONNECTED_COMPONENT_SUBSET; "CONNECTED_COMPONENT_SYM",CONNECTED_COMPONENT_SYM; "CONNECTED_COMPONENT_SYM_EQ",CONNECTED_COMPONENT_SYM_EQ; "CONNECTED_COMPONENT_TRANS",CONNECTED_COMPONENT_TRANS; "CONNECTED_COMPONENT_TRANSLATION",CONNECTED_COMPONENT_TRANSLATION; "CONNECTED_COMPONENT_UNIONS",CONNECTED_COMPONENT_UNIONS; "CONNECTED_COMPONENT_UNIQUE",CONNECTED_COMPONENT_UNIQUE; "CONNECTED_COMPONENT_UNIV",CONNECTED_COMPONENT_UNIV; "CONNECTED_CONNECTED_COMPONENT",CONNECTED_CONNECTED_COMPONENT; "CONNECTED_CONNECTED_COMPONENT_SET",CONNECTED_CONNECTED_COMPONENT_SET; "CONNECTED_CONNECTED_DIFF",CONNECTED_CONNECTED_DIFF; "CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES",CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES; "CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON",CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON; "CONNECTED_CONTINUOUS_IMAGE",CONNECTED_CONTINUOUS_IMAGE; "CONNECTED_CONVEX_1",CONNECTED_CONVEX_1; "CONNECTED_CONVEX_1_GEN",CONNECTED_CONVEX_1_GEN; "CONNECTED_CONVEX_DIFF_CARD_LT",CONNECTED_CONVEX_DIFF_CARD_LT; "CONNECTED_CONVEX_DIFF_COUNTABLE",CONNECTED_CONVEX_DIFF_COUNTABLE; "CONNECTED_CONVEX_DIFF_LOWDIM",CONNECTED_CONVEX_DIFF_LOWDIM; "CONNECTED_DELETE_INTERIOR_POINT",CONNECTED_DELETE_INTERIOR_POINT; "CONNECTED_DELETE_INTERIOR_POINT_EQ",CONNECTED_DELETE_INTERIOR_POINT_EQ; "CONNECTED_DIFF_BALL",CONNECTED_DIFF_BALL; "CONNECTED_DIFF_OPEN_FROM_CLOSED",CONNECTED_DIFF_OPEN_FROM_CLOSED; "CONNECTED_DIMENSION_EQ_SING",CONNECTED_DIMENSION_EQ_SING; "CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE",CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE; "CONNECTED_EMPTY",CONNECTED_EMPTY; "CONNECTED_EQUIVALENCE_RELATION",CONNECTED_EQUIVALENCE_RELATION; "CONNECTED_EQUIVALENCE_RELATION_GEN",CONNECTED_EQUIVALENCE_RELATION_GEN; "CONNECTED_EQ_CARD_COMPONENTS",CONNECTED_EQ_CARD_COMPONENTS; "CONNECTED_EQ_COMPONENTS_SING",CONNECTED_EQ_COMPONENTS_SING; "CONNECTED_EQ_COMPONENTS_SING_EXISTS",CONNECTED_EQ_COMPONENTS_SING_EXISTS; "CONNECTED_EQ_COMPONENTS_SUBSET_SING",CONNECTED_EQ_COMPONENTS_SUBSET_SING; "CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS",CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS; "CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED",CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED; "CONNECTED_EQ_COMPONENT_DIFF_CLOSED_NONSEPARATED",CONNECTED_EQ_COMPONENT_DIFF_CLOSED_NONSEPARATED; "CONNECTED_EQ_CONNECTED_COMPONENTS_EQ",CONNECTED_EQ_CONNECTED_COMPONENTS_EQ; "CONNECTED_EQ_CONNECTED_COMPONENT_EQ",CONNECTED_EQ_CONNECTED_COMPONENT_EQ; "CONNECTED_EQ_WELLCHAINED",CONNECTED_EQ_WELLCHAINED; "CONNECTED_FINITE_EQ_LOWDIM",CONNECTED_FINITE_EQ_LOWDIM; "CONNECTED_FINITE_IFF_COUNTABLE",CONNECTED_FINITE_IFF_COUNTABLE; "CONNECTED_FINITE_IFF_SING",CONNECTED_FINITE_IFF_SING; "CONNECTED_FROM_CLOSED_UNION_AND_INTER",CONNECTED_FROM_CLOSED_UNION_AND_INTER; "CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL",CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL; "CONNECTED_FROM_OPEN_UNION_AND_INTER",CONNECTED_FROM_OPEN_UNION_AND_INTER; "CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL",CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL; "CONNECTED_FRONTIER_COMPONENT_COMPLEMENT",CONNECTED_FRONTIER_COMPONENT_COMPLEMENT; "CONNECTED_FRONTIER_DISJOINT",CONNECTED_FRONTIER_DISJOINT; "CONNECTED_FRONTIER_SIMPLE",CONNECTED_FRONTIER_SIMPLE; "CONNECTED_FULL_CONVEX_DIFF_LOWDIM",CONNECTED_FULL_CONVEX_DIFF_LOWDIM; "CONNECTED_FULL_REGULAR_DIFF_LOWDIM",CONNECTED_FULL_REGULAR_DIFF_LOWDIM; "CONNECTED_HAUSDIST_LIMIT",CONNECTED_HAUSDIST_LIMIT; "CONNECTED_IFF_CONNECTABLE_POINTS",CONNECTED_IFF_CONNECTABLE_POINTS; "CONNECTED_IFF_CONNECTED_COMPONENT",CONNECTED_IFF_CONNECTED_COMPONENT; "CONNECTED_IMP_CONNECTED_COMPONENT",CONNECTED_IMP_CONNECTED_COMPONENT; "CONNECTED_IMP_NONSEPARATED_UNION",CONNECTED_IMP_NONSEPARATED_UNION; "CONNECTED_IMP_PERFECT",CONNECTED_IMP_PERFECT; "CONNECTED_IMP_PERFECT_AFF_DIM",CONNECTED_IMP_PERFECT_AFF_DIM; "CONNECTED_IMP_PERFECT_CLOSED",CONNECTED_IMP_PERFECT_CLOSED; "CONNECTED_IMP_WELLCHAINED",CONNECTED_IMP_WELLCHAINED; "CONNECTED_INDUCTION",CONNECTED_INDUCTION; "CONNECTED_INDUCTION_SIMPLE",CONNECTED_INDUCTION_SIMPLE; "CONNECTED_INFINITE_IFF_CARD_EQ",CONNECTED_INFINITE_IFF_CARD_EQ; "CONNECTED_INSERT",CONNECTED_INSERT; "CONNECTED_INSERT_COMPACT",CONNECTED_INSERT_COMPACT; "CONNECTED_INSERT_LIMPT",CONNECTED_INSERT_LIMPT; "CONNECTED_INTERMEDIATE_CLOSURE",CONNECTED_INTERMEDIATE_CLOSURE; "CONNECTED_INTERVAL",CONNECTED_INTERVAL; "CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS",CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS; "CONNECTED_INTER_FRONTIER",CONNECTED_INTER_FRONTIER; "CONNECTED_INTER_RELATIVE_FRONTIER",CONNECTED_INTER_RELATIVE_FRONTIER; "CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ",CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ; "CONNECTED_IVT_COMPONENT",CONNECTED_IVT_COMPONENT; "CONNECTED_IVT_HYPERPLANE",CONNECTED_IVT_HYPERPLANE; "CONNECTED_LIMIT_POINTS",CONNECTED_LIMIT_POINTS; "CONNECTED_LIMIT_POINTS_EQ_CLOSURE",CONNECTED_LIMIT_POINTS_EQ_CLOSURE; "CONNECTED_LINEAR_IMAGE",CONNECTED_LINEAR_IMAGE; "CONNECTED_LINEAR_IMAGE_EQ",CONNECTED_LINEAR_IMAGE_EQ; "CONNECTED_MONOTONE_QUOTIENT_PREIMAGE",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE; "CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN; "CONNECTED_NEGATIONS",CONNECTED_NEGATIONS; "CONNECTED_NEST",CONNECTED_NEST; "CONNECTED_NEST_GEN",CONNECTED_NEST_GEN; "CONNECTED_OPEN_ARC_CONNECTED",CONNECTED_OPEN_ARC_CONNECTED; "CONNECTED_OPEN_DELETE",CONNECTED_OPEN_DELETE; "CONNECTED_OPEN_DELETE_EQ",CONNECTED_OPEN_DELETE_EQ; "CONNECTED_OPEN_DIFF_CARD_LT",CONNECTED_OPEN_DIFF_CARD_LT; "CONNECTED_OPEN_DIFF_CBALL",CONNECTED_OPEN_DIFF_CBALL; "CONNECTED_OPEN_DIFF_COUNTABLE",CONNECTED_OPEN_DIFF_COUNTABLE; "CONNECTED_OPEN_DIFF_LOWDIM",CONNECTED_OPEN_DIFF_LOWDIM; "CONNECTED_OPEN_IN",CONNECTED_OPEN_IN; "CONNECTED_OPEN_IN_CONVEX_DIFF_LOWDIM",CONNECTED_OPEN_IN_CONVEX_DIFF_LOWDIM; "CONNECTED_OPEN_IN_DIFF_CARD_LT",CONNECTED_OPEN_IN_DIFF_CARD_LT; "CONNECTED_OPEN_IN_DIFF_LOWDIM",CONNECTED_OPEN_IN_DIFF_LOWDIM; "CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM",CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM; "CONNECTED_OPEN_IN_EQ",CONNECTED_OPEN_IN_EQ; "CONNECTED_OPEN_IN_SPHERE_DELETE_EQ",CONNECTED_OPEN_IN_SPHERE_DELETE_EQ; "CONNECTED_OPEN_MONOTONE_PREIMAGE",CONNECTED_OPEN_MONOTONE_PREIMAGE; "CONNECTED_OPEN_PATH_CONNECTED",CONNECTED_OPEN_PATH_CONNECTED; "CONNECTED_OPEN_SET",CONNECTED_OPEN_SET; "CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED",CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED; "CONNECTED_OUTSIDE",CONNECTED_OUTSIDE; "CONNECTED_PATH_IMAGE",CONNECTED_PATH_IMAGE; "CONNECTED_PCROSS",CONNECTED_PCROSS; "CONNECTED_PCROSS_EQ",CONNECTED_PCROSS_EQ; "CONNECTED_PUNCTURED_BALL",CONNECTED_PUNCTURED_BALL; "CONNECTED_PUNCTURED_CBALL",CONNECTED_PUNCTURED_CBALL; "CONNECTED_PUNCTURED_CONVEX",CONNECTED_PUNCTURED_CONVEX; "CONNECTED_PUNCTURED_SPHERE",CONNECTED_PUNCTURED_SPHERE; "CONNECTED_PUNCTURED_UNIVERSE",CONNECTED_PUNCTURED_UNIVERSE; "CONNECTED_REAL",CONNECTED_REAL; "CONNECTED_REAL_LEMMA",CONNECTED_REAL_LEMMA; "CONNECTED_RETRACT_COMPLEMENT",CONNECTED_RETRACT_COMPLEMENT; "CONNECTED_SCALING",CONNECTED_SCALING; "CONNECTED_SCALING_EQ",CONNECTED_SCALING_EQ; "CONNECTED_SEGMENT",CONNECTED_SEGMENT; "CONNECTED_SEMIOPEN_SEGMENT",CONNECTED_SEMIOPEN_SEGMENT; "CONNECTED_SEPARATION",CONNECTED_SEPARATION; "CONNECTED_SEPARATION_ALT",CONNECTED_SEPARATION_ALT; "CONNECTED_SIMPLE_PATH_ENDLESS",CONNECTED_SIMPLE_PATH_ENDLESS; "CONNECTED_SIMPLE_PATH_IMAGE",CONNECTED_SIMPLE_PATH_IMAGE; "CONNECTED_SIMPLE_PATH_IMAGE_DELETE",CONNECTED_SIMPLE_PATH_IMAGE_DELETE; "CONNECTED_SING",CONNECTED_SING; "CONNECTED_SPHERE",CONNECTED_SPHERE; "CONNECTED_SPHERE_EQ",CONNECTED_SPHERE_EQ; "CONNECTED_SPHERE_GEN",CONNECTED_SPHERE_GEN; "CONNECTED_SUBSET_ARC_PAIR",CONNECTED_SUBSET_ARC_PAIR; "CONNECTED_SUBSET_CLOPEN",CONNECTED_SUBSET_CLOPEN; "CONNECTED_SUBSET_PATH_IMAGE_ARC",CONNECTED_SUBSET_PATH_IMAGE_ARC; "CONNECTED_SUBSET_SEGMENT",CONNECTED_SUBSET_SEGMENT; "CONNECTED_SUMS",CONNECTED_SUMS; "CONNECTED_TRANSLATION",CONNECTED_TRANSLATION; "CONNECTED_TRANSLATION_EQ",CONNECTED_TRANSLATION_EQ; "CONNECTED_UNION",CONNECTED_UNION; "CONNECTED_UNIONS",CONNECTED_UNIONS; "CONNECTED_UNIONS_PAIRWISE",CONNECTED_UNIONS_PAIRWISE; "CONNECTED_UNIONS_STRONG",CONNECTED_UNIONS_STRONG; "CONNECTED_UNION_CLOPEN_IN_COMPLEMENT",CONNECTED_UNION_CLOPEN_IN_COMPLEMENT; "CONNECTED_UNION_STRONG",CONNECTED_UNION_STRONG; "CONNECTED_UNIV",CONNECTED_UNIV; "CONNECTED_UNIV_DIFF_LOWDIM",CONNECTED_UNIV_DIFF_LOWDIM; "CONNECTED_VALID_PATH_IMAGE",CONNECTED_VALID_PATH_IMAGE; "CONNECTED_WITH_INSIDE",CONNECTED_WITH_INSIDE; "CONNECTED_WITH_OUTSIDE",CONNECTED_WITH_OUTSIDE; "CONNECTED_WITH_RELATIVE_INTERIOR_OPEN_IN_CONVEX",CONNECTED_WITH_RELATIVE_INTERIOR_OPEN_IN_CONVEX; "CONSTR",CONSTR; "CONSTR_BOT",CONSTR_BOT; "CONSTR_IND",CONSTR_IND; "CONSTR_INJ",CONSTR_INJ; "CONSTR_REC",CONSTR_REC; "CONS_11",CONS_11; "CONS_HD_TL",CONS_HD_TL; "CONTAINS_COMPONENT_OF_CLOSURE_FRONTIER",CONTAINS_COMPONENT_OF_CLOSURE_FRONTIER; "CONTAINS_COMPONENT_OF_COMPACT_FRONTIER",CONTAINS_COMPONENT_OF_COMPACT_FRONTIER; "CONTENT_0_SUBSET",CONTENT_0_SUBSET; "CONTENT_0_SUBSET_GEN",CONTENT_0_SUBSET_GEN; "CONTENT_1",CONTENT_1; "CONTENT_CLOSED_INTERVAL",CONTENT_CLOSED_INTERVAL; "CONTENT_CLOSED_INTERVAL_CASES",CONTENT_CLOSED_INTERVAL_CASES; "CONTENT_DOUBLESPLIT",CONTENT_DOUBLESPLIT; "CONTENT_EMPTY",CONTENT_EMPTY; "CONTENT_EQ_0",CONTENT_EQ_0; "CONTENT_EQ_0_1",CONTENT_EQ_0_1; "CONTENT_EQ_0_GEN",CONTENT_EQ_0_GEN; "CONTENT_EQ_0_INTERIOR",CONTENT_EQ_0_INTERIOR; "CONTENT_IMAGE_AFFINITY_INTERVAL",CONTENT_IMAGE_AFFINITY_INTERVAL; "CONTENT_IMAGE_STRETCH_INTERVAL",CONTENT_IMAGE_STRETCH_INTERVAL; "CONTENT_LT_NZ",CONTENT_LT_NZ; "CONTENT_PASTECART",CONTENT_PASTECART; "CONTENT_POS_LE",CONTENT_POS_LE; "CONTENT_POS_LT",CONTENT_POS_LT; "CONTENT_POS_LT_1",CONTENT_POS_LT_1; "CONTENT_POS_LT_EQ",CONTENT_POS_LT_EQ; "CONTENT_SPLIT",CONTENT_SPLIT; "CONTENT_SUBSET",CONTENT_SUBSET; "CONTENT_UNIT",CONTENT_UNIT; "CONTENT_UNIT_1",CONTENT_UNIT_1; "CONTINUOUS_ABS",CONTINUOUS_ABS; "CONTINUOUS_ADD",CONTINUOUS_ADD; "CONTINUOUS_ADDITIVE_IMP_LINEAR",CONTINUOUS_ADDITIVE_IMP_LINEAR; "CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "CONTINUOUS_AGREE_ON_CLOSURE",CONTINUOUS_AGREE_ON_CLOSURE; "CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_AT",CONTINUOUS_AT; "CONTINUOUS_ATREAL",CONTINUOUS_ATREAL; "CONTINUOUS_ATREAL_COMPOSE",CONTINUOUS_ATREAL_COMPOSE; "CONTINUOUS_ATREAL_SQRT_COMPOSE",CONTINUOUS_ATREAL_SQRT_COMPOSE; "CONTINUOUS_ATREAL_WITHINREAL",CONTINUOUS_ATREAL_WITHINREAL; "CONTINUOUS_ATTAINS_INF",CONTINUOUS_ATTAINS_INF; "CONTINUOUS_ATTAINS_SUP",CONTINUOUS_ATTAINS_SUP; "CONTINUOUS_AT_ARG",CONTINUOUS_AT_ARG; "CONTINUOUS_AT_AVOID",CONTINUOUS_AT_AVOID; "CONTINUOUS_AT_BALL",CONTINUOUS_AT_BALL; "CONTINUOUS_AT_CACS",CONTINUOUS_AT_CACS; "CONTINUOUS_AT_CASN",CONTINUOUS_AT_CASN; "CONTINUOUS_AT_CATN",CONTINUOUS_AT_CATN; "CONTINUOUS_AT_CCOS",CONTINUOUS_AT_CCOS; "CONTINUOUS_AT_CEXP",CONTINUOUS_AT_CEXP; "CONTINUOUS_AT_CLOG",CONTINUOUS_AT_CLOG; "CONTINUOUS_AT_CLOSEST_POINT",CONTINUOUS_AT_CLOSEST_POINT; "CONTINUOUS_AT_CNJ",CONTINUOUS_AT_CNJ; "CONTINUOUS_AT_COMPOSE",CONTINUOUS_AT_COMPOSE; "CONTINUOUS_AT_COMPOSE_EQ",CONTINUOUS_AT_COMPOSE_EQ; "CONTINUOUS_AT_CSIN",CONTINUOUS_AT_CSIN; "CONTINUOUS_AT_CSQRT",CONTINUOUS_AT_CSQRT; "CONTINUOUS_AT_CTAN",CONTINUOUS_AT_CTAN; "CONTINUOUS_AT_CX_DOT",CONTINUOUS_AT_CX_DOT; "CONTINUOUS_AT_CX_IM",CONTINUOUS_AT_CX_IM; "CONTINUOUS_AT_CX_NORM",CONTINUOUS_AT_CX_NORM; "CONTINUOUS_AT_CX_RE",CONTINUOUS_AT_CX_RE; "CONTINUOUS_AT_DIST_CLOSEST_POINT",CONTINUOUS_AT_DIST_CLOSEST_POINT; "CONTINUOUS_AT_ID",CONTINUOUS_AT_ID; "CONTINUOUS_AT_IMP_CONTINUOUS_ON",CONTINUOUS_AT_IMP_CONTINUOUS_ON; "CONTINUOUS_AT_INV",CONTINUOUS_AT_INV; "CONTINUOUS_AT_LIFT_COMPONENT",CONTINUOUS_AT_LIFT_COMPONENT; "CONTINUOUS_AT_LIFT_DIST",CONTINUOUS_AT_LIFT_DIST; "CONTINUOUS_AT_LIFT_DOT",CONTINUOUS_AT_LIFT_DOT; "CONTINUOUS_AT_LIFT_INFNORM",CONTINUOUS_AT_LIFT_INFNORM; "CONTINUOUS_AT_LIFT_NORM",CONTINUOUS_AT_LIFT_NORM; "CONTINUOUS_AT_LIFT_RANGE",CONTINUOUS_AT_LIFT_RANGE; "CONTINUOUS_AT_LIFT_SETDIST",CONTINUOUS_AT_LIFT_SETDIST; "CONTINUOUS_AT_LINEAR_IMAGE",CONTINUOUS_AT_LINEAR_IMAGE; "CONTINUOUS_AT_OPEN",CONTINUOUS_AT_OPEN; "CONTINUOUS_AT_SEQUENTIALLY",CONTINUOUS_AT_SEQUENTIALLY; "CONTINUOUS_AT_SEQUENTIALLY_ALT",CONTINUOUS_AT_SEQUENTIALLY_ALT; "CONTINUOUS_AT_SEQUENTIALLY_INJ",CONTINUOUS_AT_SEQUENTIALLY_INJ; "CONTINUOUS_AT_SQRT",CONTINUOUS_AT_SQRT; "CONTINUOUS_AT_SQRT_COMPOSE",CONTINUOUS_AT_SQRT_COMPOSE; "CONTINUOUS_AT_TRANSLATION",CONTINUOUS_AT_TRANSLATION; "CONTINUOUS_AT_WINDING_NUMBER",CONTINUOUS_AT_WINDING_NUMBER; "CONTINUOUS_AT_WITHIN",CONTINUOUS_AT_WITHIN; "CONTINUOUS_AT_WITHIN_INV",CONTINUOUS_AT_WITHIN_INV; "CONTINUOUS_BOREL_PREIMAGE",CONTINUOUS_BOREL_PREIMAGE; "CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS",CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS; "CONTINUOUS_CARD_LT_RANGE_CONSTANT",CONTINUOUS_CARD_LT_RANGE_CONSTANT; "CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ",CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ; "CONTINUOUS_CLOSED_GRAPH",CONTINUOUS_CLOSED_GRAPH; "CONTINUOUS_CLOSED_GRAPH_EQ",CONTINUOUS_CLOSED_GRAPH_EQ; "CONTINUOUS_CLOSED_GRAPH_GEN",CONTINUOUS_CLOSED_GRAPH_GEN; "CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS",CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS; "CONTINUOUS_CLOSED_IN_PREIMAGE",CONTINUOUS_CLOSED_IN_PREIMAGE; "CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT; "CONTINUOUS_CLOSED_IN_PREIMAGE_EQ",CONTINUOUS_CLOSED_IN_PREIMAGE_EQ; "CONTINUOUS_CLOSED_IN_PREIMAGE_GEN",CONTINUOUS_CLOSED_IN_PREIMAGE_GEN; "CONTINUOUS_CLOSED_IN_PREIMAGE_SUBSET",CONTINUOUS_CLOSED_IN_PREIMAGE_SUBSET; "CONTINUOUS_CLOSED_PREIMAGE",CONTINUOUS_CLOSED_PREIMAGE; "CONTINUOUS_CLOSED_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_PREIMAGE_CONSTANT; "CONTINUOUS_CLOSED_PREIMAGE_UNIV",CONTINUOUS_CLOSED_PREIMAGE_UNIV; "CONTINUOUS_CMUL",CONTINUOUS_CMUL; "CONTINUOUS_COMPLEX_DIV",CONTINUOUS_COMPLEX_DIV; "CONTINUOUS_COMPLEX_DIV_AT",CONTINUOUS_COMPLEX_DIV_AT; "CONTINUOUS_COMPLEX_DIV_WITHIN",CONTINUOUS_COMPLEX_DIV_WITHIN; "CONTINUOUS_COMPLEX_INV",CONTINUOUS_COMPLEX_INV; "CONTINUOUS_COMPLEX_INV_AT",CONTINUOUS_COMPLEX_INV_AT; "CONTINUOUS_COMPLEX_INV_WITHIN",CONTINUOUS_COMPLEX_INV_WITHIN; "CONTINUOUS_COMPLEX_LMUL",CONTINUOUS_COMPLEX_LMUL; "CONTINUOUS_COMPLEX_MUL",CONTINUOUS_COMPLEX_MUL; "CONTINUOUS_COMPLEX_POW",CONTINUOUS_COMPLEX_POW; "CONTINUOUS_COMPLEX_RMUL",CONTINUOUS_COMPLEX_RMUL; "CONTINUOUS_COMPONENTWISE",CONTINUOUS_COMPONENTWISE; "CONTINUOUS_COMPONENTWISE_LIFT",CONTINUOUS_COMPONENTWISE_LIFT; "CONTINUOUS_CONST",CONTINUOUS_CONST; "CONTINUOUS_CONSTANT_ON_CLOSURE",CONTINUOUS_CONSTANT_ON_CLOSURE; "CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_CONTINUOUS_ATREAL",CONTINUOUS_CONTINUOUS_ATREAL; "CONTINUOUS_CONTINUOUS_WITHINREAL",CONTINUOUS_CONTINUOUS_WITHINREAL; "CONTINUOUS_COUNTABLE_RANGE_CONSTANT",CONTINUOUS_COUNTABLE_RANGE_CONSTANT; "CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ",CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ; "CONTINUOUS_CPRODUCT",CONTINUOUS_CPRODUCT; "CONTINUOUS_CX_ATREAL",CONTINUOUS_CX_ATREAL; "CONTINUOUS_CX_DROP",CONTINUOUS_CX_DROP; "CONTINUOUS_CX_LIFT",CONTINUOUS_CX_LIFT; "CONTINUOUS_CX_WITHINREAL",CONTINUOUS_CX_WITHINREAL; "CONTINUOUS_DECREASING_IMAGE_INTERVAL_1",CONTINUOUS_DECREASING_IMAGE_INTERVAL_1; "CONTINUOUS_DET_EXPLICIT",CONTINUOUS_DET_EXPLICIT; "CONTINUOUS_DIAMETER",CONTINUOUS_DIAMETER; "CONTINUOUS_DISCONNECTED_RANGE_CONSTANT",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT; "CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; "CONTINUOUS_DISCRETE_RANGE_CONSTANT",CONTINUOUS_DISCRETE_RANGE_CONSTANT; "CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ",CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; "CONTINUOUS_EQ_CAUCHY_AT",CONTINUOUS_EQ_CAUCHY_AT; "CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED",CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED; "CONTINUOUS_EQ_CAUCHY_WITHIN",CONTINUOUS_EQ_CAUCHY_WITHIN; "CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING",CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING; "CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN",CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN; "CONTINUOUS_EQ_COMPACT_PATH_CONNECTED_PRESERVING",CONTINUOUS_EQ_COMPACT_PATH_CONNECTED_PRESERVING; "CONTINUOUS_FINITE_RANGE_CONSTANT",CONTINUOUS_FINITE_RANGE_CONSTANT; "CONTINUOUS_FINITE_RANGE_CONSTANT_EQ",CONTINUOUS_FINITE_RANGE_CONSTANT_EQ; "CONTINUOUS_FROM_CLOSED_GRAPH",CONTINUOUS_FROM_CLOSED_GRAPH; "CONTINUOUS_FSIGMA_PREIMAGE",CONTINUOUS_FSIGMA_PREIMAGE; "CONTINUOUS_FSTCART",CONTINUOUS_FSTCART; "CONTINUOUS_FUNCTION_HAS_EIGENVALUES_ODD_DIM",CONTINUOUS_FUNCTION_HAS_EIGENVALUES_ODD_DIM; "CONTINUOUS_GDELTA_PREIMAGE",CONTINUOUS_GDELTA_PREIMAGE; "CONTINUOUS_GE_ON_CLOSURE",CONTINUOUS_GE_ON_CLOSURE; "CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_IMAGE_NESTED_INTERS",CONTINUOUS_IMAGE_NESTED_INTERS; "CONTINUOUS_IMAGE_NESTED_INTERS_GEN",CONTINUOUS_IMAGE_NESTED_INTERS_GEN; "CONTINUOUS_IMAGE_SUBSET_INTERIOR",CONTINUOUS_IMAGE_SUBSET_INTERIOR; "CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR",CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR; "CONTINUOUS_IMP_BOREL_MEASURABLE_ON",CONTINUOUS_IMP_BOREL_MEASURABLE_ON; "CONTINUOUS_IMP_CLOSED_MAP",CONTINUOUS_IMP_CLOSED_MAP; "CONTINUOUS_IMP_MEASURABLE_ON",CONTINUOUS_IMP_MEASURABLE_ON; "CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET; "CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "CONTINUOUS_IMP_QUOTIENT_MAP",CONTINUOUS_IMP_QUOTIENT_MAP; "CONTINUOUS_IMP_REAL_MEASURABLE_ON",CONTINUOUS_IMP_REAL_MEASURABLE_ON; "CONTINUOUS_INCREASING_IMAGE_INTERVAL_1",CONTINUOUS_INCREASING_IMAGE_INTERVAL_1; "CONTINUOUS_INJECTIVE_IFF_MONOTONIC",CONTINUOUS_INJECTIVE_IFF_MONOTONIC; "CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1; "CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1; "CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE",CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE; "CONTINUOUS_INJECTIVE_IMP_MONOTONIC",CONTINUOUS_INJECTIVE_IMP_MONOTONIC; "CONTINUOUS_INTERVAL_BIJ",CONTINUOUS_INTERVAL_BIJ; "CONTINUOUS_INV",CONTINUOUS_INV; "CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP",CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP; "CONTINUOUS_IVT_LOCAL_EXTREMUM",CONTINUOUS_IVT_LOCAL_EXTREMUM; "CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP; "CONTINUOUS_LEVELSET_OPEN",CONTINUOUS_LEVELSET_OPEN; "CONTINUOUS_LEVELSET_OPEN_IN",CONTINUOUS_LEVELSET_OPEN_IN; "CONTINUOUS_LEVELSET_OPEN_IN_CASES",CONTINUOUS_LEVELSET_OPEN_IN_CASES; "CONTINUOUS_LE_ON_CLOSURE",CONTINUOUS_LE_ON_CLOSURE; "CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_LIFT_ABS",CONTINUOUS_LIFT_ABS; "CONTINUOUS_LIFT_ABS_COMPONENT",CONTINUOUS_LIFT_ABS_COMPONENT; "CONTINUOUS_LIFT_COMPONENT_COMPOSE",CONTINUOUS_LIFT_COMPONENT_COMPOSE; "CONTINUOUS_LIFT_DET",CONTINUOUS_LIFT_DET; "CONTINUOUS_LIFT_DOT2",CONTINUOUS_LIFT_DOT2; "CONTINUOUS_LIFT_NORM_COMPOSE",CONTINUOUS_LIFT_NORM_COMPOSE; "CONTINUOUS_LIFT_POW",CONTINUOUS_LIFT_POW; "CONTINUOUS_LIFT_PRODUCT",CONTINUOUS_LIFT_PRODUCT; "CONTINUOUS_LINEPATH_AT",CONTINUOUS_LINEPATH_AT; "CONTINUOUS_LOGARITHM_ON_BALL",CONTINUOUS_LOGARITHM_ON_BALL; "CONTINUOUS_LOGARITHM_ON_CBALL",CONTINUOUS_LOGARITHM_ON_CBALL; "CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE",CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE; "CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED",CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED; "CONTINUOUS_MAP_CLOSURES",CONTINUOUS_MAP_CLOSURES; "CONTINUOUS_MAP_CLOSURES_GEN",CONTINUOUS_MAP_CLOSURES_GEN; "CONTINUOUS_MATRIX_COMPONENTWISE",CONTINUOUS_MATRIX_COMPONENTWISE; "CONTINUOUS_MAX",CONTINUOUS_MAX; "CONTINUOUS_MAX_1",CONTINUOUS_MAX_1; "CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_TRANSLATION",CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_TRANSLATION; "CONTINUOUS_MEASURE_TRANSLATION_DIFF",CONTINUOUS_MEASURE_TRANSLATION_DIFF; "CONTINUOUS_MEASURE_TRANSLATION_SYMDIFF",CONTINUOUS_MEASURE_TRANSLATION_SYMDIFF; "CONTINUOUS_MIDPOINT_CONVEX",CONTINUOUS_MIDPOINT_CONVEX; "CONTINUOUS_MIN",CONTINUOUS_MIN; "CONTINUOUS_MIN_1",CONTINUOUS_MIN_1; "CONTINUOUS_MUL",CONTINUOUS_MUL; "CONTINUOUS_NEG",CONTINUOUS_NEG; "CONTINUOUS_ON",CONTINUOUS_ON; "CONTINUOUS_ON_ABS",CONTINUOUS_ON_ABS; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM_GEN",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM_GEN; "CONTINUOUS_ON_ADD",CONTINUOUS_ON_ADD; "CONTINUOUS_ON_ARG",CONTINUOUS_ON_ARG; "CONTINUOUS_ON_AVOID",CONTINUOUS_ON_AVOID; "CONTINUOUS_ON_BORSUK_MAP",CONTINUOUS_ON_BORSUK_MAP; "CONTINUOUS_ON_CACS",CONTINUOUS_ON_CACS; "CONTINUOUS_ON_CACS_REAL",CONTINUOUS_ON_CACS_REAL; "CONTINUOUS_ON_CASES",CONTINUOUS_ON_CASES; "CONTINUOUS_ON_CASES_1",CONTINUOUS_ON_CASES_1; "CONTINUOUS_ON_CASES_LE",CONTINUOUS_ON_CASES_LE; "CONTINUOUS_ON_CASES_LOCAL",CONTINUOUS_ON_CASES_LOCAL; "CONTINUOUS_ON_CASES_LOCAL_OPEN",CONTINUOUS_ON_CASES_LOCAL_OPEN; "CONTINUOUS_ON_CASES_OPEN",CONTINUOUS_ON_CASES_OPEN; "CONTINUOUS_ON_CASN",CONTINUOUS_ON_CASN; "CONTINUOUS_ON_CASN_REAL",CONTINUOUS_ON_CASN_REAL; "CONTINUOUS_ON_CATN",CONTINUOUS_ON_CATN; "CONTINUOUS_ON_CCOS",CONTINUOUS_ON_CCOS; "CONTINUOUS_ON_CEXP",CONTINUOUS_ON_CEXP; "CONTINUOUS_ON_CLOG",CONTINUOUS_ON_CLOG; "CONTINUOUS_ON_CLOPEN_INDICATOR",CONTINUOUS_ON_CLOPEN_INDICATOR; "CONTINUOUS_ON_CLOSED",CONTINUOUS_ON_CLOSED; "CONTINUOUS_ON_CLOSED_GEN",CONTINUOUS_ON_CLOSED_GEN; "CONTINUOUS_ON_CLOSEST_POINT",CONTINUOUS_ON_CLOSEST_POINT; "CONTINUOUS_ON_CLOSURE",CONTINUOUS_ON_CLOSURE; "CONTINUOUS_ON_CLOSURE_COMPONENT_GE",CONTINUOUS_ON_CLOSURE_COMPONENT_GE; "CONTINUOUS_ON_CLOSURE_COMPONENT_LE",CONTINUOUS_ON_CLOSURE_COMPONENT_LE; "CONTINUOUS_ON_CLOSURE_NORM_LE",CONTINUOUS_ON_CLOSURE_NORM_LE; "CONTINUOUS_ON_CLOSURE_SEQUENTIALLY",CONTINUOUS_ON_CLOSURE_SEQUENTIALLY; "CONTINUOUS_ON_CMUL",CONTINUOUS_ON_CMUL; "CONTINUOUS_ON_CNJ",CONTINUOUS_ON_CNJ; "CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION",CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION; "CONTINUOUS_ON_COMPARISON",CONTINUOUS_ON_COMPARISON; "CONTINUOUS_ON_COMPLEX_DIV",CONTINUOUS_ON_COMPLEX_DIV; "CONTINUOUS_ON_COMPLEX_INV",CONTINUOUS_ON_COMPLEX_INV; "CONTINUOUS_ON_COMPLEX_LMUL",CONTINUOUS_ON_COMPLEX_LMUL; "CONTINUOUS_ON_COMPLEX_MUL",CONTINUOUS_ON_COMPLEX_MUL; "CONTINUOUS_ON_COMPLEX_POW",CONTINUOUS_ON_COMPLEX_POW; "CONTINUOUS_ON_COMPLEX_RMUL",CONTINUOUS_ON_COMPLEX_RMUL; "CONTINUOUS_ON_COMPONENTS",CONTINUOUS_ON_COMPONENTS; "CONTINUOUS_ON_COMPONENTS_EQ",CONTINUOUS_ON_COMPONENTS_EQ; "CONTINUOUS_ON_COMPONENTS_FINITE",CONTINUOUS_ON_COMPONENTS_FINITE; "CONTINUOUS_ON_COMPONENTS_GEN",CONTINUOUS_ON_COMPONENTS_GEN; "CONTINUOUS_ON_COMPONENTS_OPEN",CONTINUOUS_ON_COMPONENTS_OPEN; "CONTINUOUS_ON_COMPONENTS_OPEN_EQ",CONTINUOUS_ON_COMPONENTS_OPEN_EQ; "CONTINUOUS_ON_COMPONENTWISE_LIFT",CONTINUOUS_ON_COMPONENTWISE_LIFT; "CONTINUOUS_ON_COMPOSE",CONTINUOUS_ON_COMPOSE; "CONTINUOUS_ON_COMPOSE_ARG",CONTINUOUS_ON_COMPOSE_ARG; "CONTINUOUS_ON_COMPOSE_QUOTIENT",CONTINUOUS_ON_COMPOSE_QUOTIENT; "CONTINUOUS_ON_CONST",CONTINUOUS_ON_CONST; "CONTINUOUS_ON_CONST_DYADIC_RATIONALS",CONTINUOUS_ON_CONST_DYADIC_RATIONALS; "CONTINUOUS_ON_CONVOLUTION_L1_LINF",CONTINUOUS_ON_CONVOLUTION_L1_LINF; "CONTINUOUS_ON_CONVOLUTION_LINF_L1",CONTINUOUS_ON_CONVOLUTION_LINF_L1; "CONTINUOUS_ON_CPOW_RIGHT",CONTINUOUS_ON_CPOW_RIGHT; "CONTINUOUS_ON_CPRODUCT",CONTINUOUS_ON_CPRODUCT; "CONTINUOUS_ON_CSIN",CONTINUOUS_ON_CSIN; "CONTINUOUS_ON_CSQRT",CONTINUOUS_ON_CSQRT; "CONTINUOUS_ON_CTAN",CONTINUOUS_ON_CTAN; "CONTINUOUS_ON_CX_DOT",CONTINUOUS_ON_CX_DOT; "CONTINUOUS_ON_CX_DROP",CONTINUOUS_ON_CX_DROP; "CONTINUOUS_ON_CX_IM",CONTINUOUS_ON_CX_IM; "CONTINUOUS_ON_CX_LIFT",CONTINUOUS_ON_CX_LIFT; "CONTINUOUS_ON_CX_NORM",CONTINUOUS_ON_CX_NORM; "CONTINUOUS_ON_CX_RE",CONTINUOUS_ON_CX_RE; "CONTINUOUS_ON_DIST_CLOSEST_POINT",CONTINUOUS_ON_DIST_CLOSEST_POINT; "CONTINUOUS_ON_EMPTY",CONTINUOUS_ON_EMPTY; "CONTINUOUS_ON_EQ",CONTINUOUS_ON_EQ; "CONTINUOUS_ON_EQ_CONTINUOUS_AT",CONTINUOUS_ON_EQ_CONTINUOUS_AT; "CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN",CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; "CONTINUOUS_ON_FINITE",CONTINUOUS_ON_FINITE; "CONTINUOUS_ON_FSTCART",CONTINUOUS_ON_FSTCART; "CONTINUOUS_ON_ID",CONTINUOUS_ON_ID; "CONTINUOUS_ON_IMP_BAIRE",CONTINUOUS_ON_IMP_BAIRE; "CONTINUOUS_ON_IMP_CLOSED_IN",CONTINUOUS_ON_IMP_CLOSED_IN; "CONTINUOUS_ON_IMP_OPEN_IN",CONTINUOUS_ON_IMP_OPEN_IN; "CONTINUOUS_ON_INTERIOR",CONTINUOUS_ON_INTERIOR; "CONTINUOUS_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ",CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ; "CONTINUOUS_ON_INTERMEDIATE_CLOSURE_POINTWISE",CONTINUOUS_ON_INTERMEDIATE_CLOSURE_POINTWISE; "CONTINUOUS_ON_INTERVAL_BIJ",CONTINUOUS_ON_INTERVAL_BIJ; "CONTINUOUS_ON_INV",CONTINUOUS_ON_INV; "CONTINUOUS_ON_INVERSE",CONTINUOUS_ON_INVERSE; "CONTINUOUS_ON_INVERSE_CLOSED_MAP",CONTINUOUS_ON_INVERSE_CLOSED_MAP; "CONTINUOUS_ON_INVERSE_INTO_1D",CONTINUOUS_ON_INVERSE_INTO_1D; "CONTINUOUS_ON_INVERSE_OPEN",CONTINUOUS_ON_INVERSE_OPEN; "CONTINUOUS_ON_INVERSE_OPEN_MAP",CONTINUOUS_ON_INVERSE_OPEN_MAP; "CONTINUOUS_ON_LIFT_ABS",CONTINUOUS_ON_LIFT_ABS; "CONTINUOUS_ON_LIFT_ABS_COMPONENT",CONTINUOUS_ON_LIFT_ABS_COMPONENT; "CONTINUOUS_ON_LIFT_COMPONENT",CONTINUOUS_ON_LIFT_COMPONENT; "CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE",CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; "CONTINUOUS_ON_LIFT_DET",CONTINUOUS_ON_LIFT_DET; "CONTINUOUS_ON_LIFT_DIST",CONTINUOUS_ON_LIFT_DIST; "CONTINUOUS_ON_LIFT_DOT",CONTINUOUS_ON_LIFT_DOT; "CONTINUOUS_ON_LIFT_DOT2",CONTINUOUS_ON_LIFT_DOT2; "CONTINUOUS_ON_LIFT_NORM",CONTINUOUS_ON_LIFT_NORM; "CONTINUOUS_ON_LIFT_NORM_COMPOSE",CONTINUOUS_ON_LIFT_NORM_COMPOSE; "CONTINUOUS_ON_LIFT_POW",CONTINUOUS_ON_LIFT_POW; "CONTINUOUS_ON_LIFT_PRODUCT",CONTINUOUS_ON_LIFT_PRODUCT; "CONTINUOUS_ON_LIFT_RANGE",CONTINUOUS_ON_LIFT_RANGE; "CONTINUOUS_ON_LIFT_SETDIST",CONTINUOUS_ON_LIFT_SETDIST; "CONTINUOUS_ON_LIFT_SQRT",CONTINUOUS_ON_LIFT_SQRT; "CONTINUOUS_ON_LIFT_SQRT_COMPOSE",CONTINUOUS_ON_LIFT_SQRT_COMPOSE; "CONTINUOUS_ON_LINEPATH",CONTINUOUS_ON_LINEPATH; "CONTINUOUS_ON_MATRIX_COMPONENTWISE",CONTINUOUS_ON_MATRIX_COMPONENTWISE; "CONTINUOUS_ON_MAX",CONTINUOUS_ON_MAX; "CONTINUOUS_ON_MAX_1",CONTINUOUS_ON_MAX_1; "CONTINUOUS_ON_MDIST",CONTINUOUS_ON_MDIST; "CONTINUOUS_ON_MIN",CONTINUOUS_ON_MIN; "CONTINUOUS_ON_MIN_1",CONTINUOUS_ON_MIN_1; "CONTINUOUS_ON_MUL",CONTINUOUS_ON_MUL; "CONTINUOUS_ON_NEG",CONTINUOUS_ON_NEG; "CONTINUOUS_ON_NO_LIMPT",CONTINUOUS_ON_NO_LIMPT; "CONTINUOUS_ON_OPEN",CONTINUOUS_ON_OPEN; "CONTINUOUS_ON_OPEN_AVOID",CONTINUOUS_ON_OPEN_AVOID; "CONTINUOUS_ON_OPEN_GEN",CONTINUOUS_ON_OPEN_GEN; "CONTINUOUS_ON_PASTECART",CONTINUOUS_ON_PASTECART; "CONTINUOUS_ON_PATH_LENGTH_SUBPATH_LEFT",CONTINUOUS_ON_PATH_LENGTH_SUBPATH_LEFT; "CONTINUOUS_ON_PATH_LENGTH_SUBPATH_RIGHT",CONTINUOUS_ON_PATH_LENGTH_SUBPATH_RIGHT; "CONTINUOUS_ON_REFLECT",CONTINUOUS_ON_REFLECT; "CONTINUOUS_ON_RESTRICT",CONTINUOUS_ON_RESTRICT; "CONTINUOUS_ON_SEQUENTIALLY",CONTINUOUS_ON_SEQUENTIALLY; "CONTINUOUS_ON_SING",CONTINUOUS_ON_SING; "CONTINUOUS_ON_SNDCART",CONTINUOUS_ON_SNDCART; "CONTINUOUS_ON_SUB",CONTINUOUS_ON_SUB; "CONTINUOUS_ON_SUBSET",CONTINUOUS_ON_SUBSET; "CONTINUOUS_ON_UNION",CONTINUOUS_ON_UNION; "CONTINUOUS_ON_UNION_LOCAL",CONTINUOUS_ON_UNION_LOCAL; "CONTINUOUS_ON_UNION_LOCAL_OPEN",CONTINUOUS_ON_UNION_LOCAL_OPEN; "CONTINUOUS_ON_UNION_OPEN",CONTINUOUS_ON_UNION_OPEN; "CONTINUOUS_ON_UPPERHALF_ARG",CONTINUOUS_ON_UPPERHALF_ARG; "CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION",CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION; "CONTINUOUS_ON_VECTOR_VARIATION",CONTINUOUS_ON_VECTOR_VARIATION; "CONTINUOUS_ON_VMUL",CONTINUOUS_ON_VMUL; "CONTINUOUS_ON_VSUM",CONTINUOUS_ON_VSUM; "CONTINUOUS_ON_WINDING_NUMBER",CONTINUOUS_ON_WINDING_NUMBER; "CONTINUOUS_OPEN_IN_PREIMAGE",CONTINUOUS_OPEN_IN_PREIMAGE; "CONTINUOUS_OPEN_IN_PREIMAGE_EQ",CONTINUOUS_OPEN_IN_PREIMAGE_EQ; "CONTINUOUS_OPEN_IN_PREIMAGE_GEN",CONTINUOUS_OPEN_IN_PREIMAGE_GEN; "CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET",CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET; "CONTINUOUS_OPEN_PREIMAGE",CONTINUOUS_OPEN_PREIMAGE; "CONTINUOUS_OPEN_PREIMAGE_UNIV",CONTINUOUS_OPEN_PREIMAGE_UNIV; "CONTINUOUS_PASTECART",CONTINUOUS_PASTECART; "CONTINUOUS_REAL_CONTINUOUS_ATREAL_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_ATREAL_COMPOSE; "CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE; "CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE; "CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE; "CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP; "CONTINUOUS_SNDCART",CONTINUOUS_SNDCART; "CONTINUOUS_SQRT_ON_CONTRACTIBLE",CONTINUOUS_SQRT_ON_CONTRACTIBLE; "CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED",CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED; "CONTINUOUS_SUB",CONTINUOUS_SUB; "CONTINUOUS_TRANSFORM_AT",CONTINUOUS_TRANSFORM_AT; "CONTINUOUS_TRANSFORM_WITHIN",CONTINUOUS_TRANSFORM_WITHIN; "CONTINUOUS_TRANSFORM_WITHINREAL_SET_IMP",CONTINUOUS_TRANSFORM_WITHINREAL_SET_IMP; "CONTINUOUS_TRANSFORM_WITHIN_OPEN",CONTINUOUS_TRANSFORM_WITHIN_OPEN; "CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN",CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN; "CONTINUOUS_TRANSFORM_WITHIN_SET_IMP",CONTINUOUS_TRANSFORM_WITHIN_SET_IMP; "CONTINUOUS_TRIVIAL_LIMIT",CONTINUOUS_TRIVIAL_LIMIT; "CONTINUOUS_UNIFORMLY_CAUCHY_LIMIT",CONTINUOUS_UNIFORMLY_CAUCHY_LIMIT; "CONTINUOUS_UNIFORM_LIMIT",CONTINUOUS_UNIFORM_LIMIT; "CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION",CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; "CONTINUOUS_VMUL",CONTINUOUS_VMUL; "CONTINUOUS_VSUM",CONTINUOUS_VSUM; "CONTINUOUS_WITHIN",CONTINUOUS_WITHIN; "CONTINUOUS_WITHINREAL",CONTINUOUS_WITHINREAL; "CONTINUOUS_WITHINREAL_COMPOSE",CONTINUOUS_WITHINREAL_COMPOSE; "CONTINUOUS_WITHINREAL_SQRT_COMPOSE",CONTINUOUS_WITHINREAL_SQRT_COMPOSE; "CONTINUOUS_WITHINREAL_SUBSET",CONTINUOUS_WITHINREAL_SUBSET; "CONTINUOUS_WITHIN_AVOID",CONTINUOUS_WITHIN_AVOID; "CONTINUOUS_WITHIN_BALL",CONTINUOUS_WITHIN_BALL; "CONTINUOUS_WITHIN_CACS",CONTINUOUS_WITHIN_CACS; "CONTINUOUS_WITHIN_CACS_REAL",CONTINUOUS_WITHIN_CACS_REAL; "CONTINUOUS_WITHIN_CASN",CONTINUOUS_WITHIN_CASN; "CONTINUOUS_WITHIN_CASN_REAL",CONTINUOUS_WITHIN_CASN_REAL; "CONTINUOUS_WITHIN_CATN",CONTINUOUS_WITHIN_CATN; "CONTINUOUS_WITHIN_CCOS",CONTINUOUS_WITHIN_CCOS; "CONTINUOUS_WITHIN_CEXP",CONTINUOUS_WITHIN_CEXP; "CONTINUOUS_WITHIN_CLOG",CONTINUOUS_WITHIN_CLOG; "CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL",CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL; "CONTINUOUS_WITHIN_CNJ",CONTINUOUS_WITHIN_CNJ; "CONTINUOUS_WITHIN_COMPARISON",CONTINUOUS_WITHIN_COMPARISON; "CONTINUOUS_WITHIN_COMPOSE",CONTINUOUS_WITHIN_COMPOSE; "CONTINUOUS_WITHIN_CSIN",CONTINUOUS_WITHIN_CSIN; "CONTINUOUS_WITHIN_CSQRT",CONTINUOUS_WITHIN_CSQRT; "CONTINUOUS_WITHIN_CSQRT_POSREAL",CONTINUOUS_WITHIN_CSQRT_POSREAL; "CONTINUOUS_WITHIN_CTAN",CONTINUOUS_WITHIN_CTAN; "CONTINUOUS_WITHIN_CX_DOT",CONTINUOUS_WITHIN_CX_DOT; "CONTINUOUS_WITHIN_CX_NORM",CONTINUOUS_WITHIN_CX_NORM; "CONTINUOUS_WITHIN_ID",CONTINUOUS_WITHIN_ID; "CONTINUOUS_WITHIN_LIFT_SQRT",CONTINUOUS_WITHIN_LIFT_SQRT; "CONTINUOUS_WITHIN_OPEN",CONTINUOUS_WITHIN_OPEN; "CONTINUOUS_WITHIN_OPEN_IN",CONTINUOUS_WITHIN_OPEN_IN; "CONTINUOUS_WITHIN_SEQUENTIALLY",CONTINUOUS_WITHIN_SEQUENTIALLY; "CONTINUOUS_WITHIN_SEQUENTIALLY_ALT",CONTINUOUS_WITHIN_SEQUENTIALLY_ALT; "CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP",CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP; "CONTINUOUS_WITHIN_SEQUENTIALLY_INJ",CONTINUOUS_WITHIN_SEQUENTIALLY_INJ; "CONTINUOUS_WITHIN_SQRT_COMPOSE",CONTINUOUS_WITHIN_SQRT_COMPOSE; "CONTINUOUS_WITHIN_SUBSET",CONTINUOUS_WITHIN_SUBSET; "CONTINUOUS_WITHIN_UPPERHALF_ARG",CONTINUOUS_WITHIN_UPPERHALF_ARG; "CONTINUUM_UNION_COMPONENTS_COMPLEMENT",CONTINUUM_UNION_COMPONENTS_COMPLEMENT; "CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT",CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT; "CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS",CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS; "CONTRACTIBLE_EMPTY",CONTRACTIBLE_EMPTY; "CONTRACTIBLE_EQ_SIMPLY_CONNECTED_2D",CONTRACTIBLE_EQ_SIMPLY_CONNECTED_2D; "CONTRACTIBLE_IMP_BORSUKIAN",CONTRACTIBLE_IMP_BORSUKIAN; "CONTRACTIBLE_IMP_CONNECTED",CONTRACTIBLE_IMP_CONNECTED; "CONTRACTIBLE_IMP_HOLOMORPHIC_ACS",CONTRACTIBLE_IMP_HOLOMORPHIC_ACS; "CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED",CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED; "CONTRACTIBLE_IMP_HOLOMORPHIC_LOG",CONTRACTIBLE_IMP_HOLOMORPHIC_LOG; "CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT",CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT; "CONTRACTIBLE_IMP_PATH_CONNECTED",CONTRACTIBLE_IMP_PATH_CONNECTED; "CONTRACTIBLE_IMP_SIMPLY_CONNECTED",CONTRACTIBLE_IMP_SIMPLY_CONNECTED; "CONTRACTIBLE_IMP_UNICOHERENT",CONTRACTIBLE_IMP_UNICOHERENT; "CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE",CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE; "CONTRACTIBLE_PCROSS",CONTRACTIBLE_PCROSS; "CONTRACTIBLE_PCROSS_EQ",CONTRACTIBLE_PCROSS_EQ; "CONTRACTIBLE_PUNCTURED_SPHERE",CONTRACTIBLE_PUNCTURED_SPHERE; "CONTRACTIBLE_SING",CONTRACTIBLE_SING; "CONTRACTIBLE_SPHERE",CONTRACTIBLE_SPHERE; "CONTRACTIBLE_TRANSLATION",CONTRACTIBLE_TRANSLATION; "CONTRACTIBLE_UNIV",CONTRACTIBLE_UNIV; "CONTRACTION_IMP_CONTINUOUS_ON",CONTRACTION_IMP_CONTINUOUS_ON; "CONTRACTION_IMP_UNIQUE_FIXPOINT",CONTRACTION_IMP_UNIQUE_FIXPOINT; "CONTRAPOS_THM",CONTRAPOS_THM; "CONVERGENCE_IN_MEASURE",CONVERGENCE_IN_MEASURE; "CONVERGENCE_IN_MEASURE_UNIQUE",CONVERGENCE_IN_MEASURE_UNIQUE; "CONVERGENT_BOUNDED_DECREASING_1",CONVERGENT_BOUNDED_DECREASING_1; "CONVERGENT_BOUNDED_INCREASING",CONVERGENT_BOUNDED_INCREASING; "CONVERGENT_BOUNDED_INCREASING_1",CONVERGENT_BOUNDED_INCREASING_1; "CONVERGENT_BOUNDED_MONOTONE",CONVERGENT_BOUNDED_MONOTONE; "CONVERGENT_BOUNDED_MONOTONE_1",CONVERGENT_BOUNDED_MONOTONE_1; "CONVERGENT_BOUNDED_MONOTONE_EQ",CONVERGENT_BOUNDED_MONOTONE_EQ; "CONVERGENT_EQ_CAUCHY",CONVERGENT_EQ_CAUCHY; "CONVERGENT_EQ_CAUCHY_AT",CONVERGENT_EQ_CAUCHY_AT; "CONVERGENT_EQ_CAUCHY_WITHIN",CONVERGENT_EQ_CAUCHY_WITHIN; "CONVERGENT_EQ_ZERO_OSCILLATION",CONVERGENT_EQ_ZERO_OSCILLATION; "CONVERGENT_IMP_BOUNDED",CONVERGENT_IMP_BOUNDED; "CONVERGENT_IMP_CAUCHY",CONVERGENT_IMP_CAUCHY; "CONVERGENT_OFFSET",CONVERGENT_OFFSET; "CONVERGENT_OFFSET_EQ",CONVERGENT_OFFSET_EQ; "CONVERGENT_OFFSET_REV",CONVERGENT_OFFSET_REV; "CONVERGENT_REAL_BOUNDED_MONOTONE",CONVERGENT_REAL_BOUNDED_MONOTONE; "CONVERGENT_SUBSEQUENCE",CONVERGENT_SUBSEQUENCE; "CONVEX",CONVEX; "CONVEXITY_PRESERVING",CONVEXITY_PRESERVING; "CONVEXITY_PRESERVING_ALT",CONVEXITY_PRESERVING_ALT; "CONVEXITY_PRESERVING_SHRINK_0",CONVEXITY_PRESERVING_SHRINK_0; "CONVEX_ADD",CONVEX_ADD; "CONVEX_ADD_EQ",CONVEX_ADD_EQ; "CONVEX_AFFINITY",CONVEX_AFFINITY; "CONVEX_AFFINITY_EQ",CONVEX_AFFINITY_EQ; "CONVEX_ALT",CONVEX_ALT; "CONVEX_AND_AFFINE_INTER_OPEN",CONVEX_AND_AFFINE_INTER_OPEN; "CONVEX_BALL",CONVEX_BALL; "CONVEX_BOUNDS_LEMMA",CONVEX_BOUNDS_LEMMA; "CONVEX_CBALL",CONVEX_CBALL; "CONVEX_CLOSED_CONTAINS_SAME_RAY",CONVEX_CLOSED_CONTAINS_SAME_RAY; "CONVEX_CLOSURE",CONVEX_CLOSURE; "CONVEX_CLOSURE_INTERIOR",CONVEX_CLOSURE_INTERIOR; "CONVEX_CLOSURE_RELATIVE_INTERIOR",CONVEX_CLOSURE_RELATIVE_INTERIOR; "CONVEX_CMUL",CONVEX_CMUL; "CONVEX_CONCAVE_EQ_AFFINE",CONVEX_CONCAVE_EQ_AFFINE; "CONVEX_CONE",CONVEX_CONE; "CONVEX_CONE_ADD",CONVEX_CONE_ADD; "CONVEX_CONE_CONTAINS_0",CONVEX_CONE_CONTAINS_0; "CONVEX_CONE_CONVEX_CONE_HULL",CONVEX_CONE_CONVEX_CONE_HULL; "CONVEX_CONE_HALFSPACE_GE",CONVEX_CONE_HALFSPACE_GE; "CONVEX_CONE_HALFSPACE_LE",CONVEX_CONE_HALFSPACE_LE; "CONVEX_CONE_HULL_ADD",CONVEX_CONE_HULL_ADD; "CONVEX_CONE_HULL_CONTAINS_0",CONVEX_CONE_HULL_CONTAINS_0; "CONVEX_CONE_HULL_CONVEX_HULL",CONVEX_CONE_HULL_CONVEX_HULL; "CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY",CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; "CONVEX_CONE_HULL_EMPTY",CONVEX_CONE_HULL_EMPTY; "CONVEX_CONE_HULL_LINEAR_IMAGE",CONVEX_CONE_HULL_LINEAR_IMAGE; "CONVEX_CONE_HULL_MUL",CONVEX_CONE_HULL_MUL; "CONVEX_CONE_HULL_NONEMPTY",CONVEX_CONE_HULL_NONEMPTY; "CONVEX_CONE_HULL_SEPARATE",CONVEX_CONE_HULL_SEPARATE; "CONVEX_CONE_HULL_SEPARATE_NONEMPTY",CONVEX_CONE_HULL_SEPARATE_NONEMPTY; "CONVEX_CONE_HULL_UNION",CONVEX_CONE_HULL_UNION; "CONVEX_CONE_INTERS",CONVEX_CONE_INTERS; "CONVEX_CONE_LINEAR_IMAGE",CONVEX_CONE_LINEAR_IMAGE; "CONVEX_CONE_LINEAR_IMAGE_EQ",CONVEX_CONE_LINEAR_IMAGE_EQ; "CONVEX_CONE_MUL",CONVEX_CONE_MUL; "CONVEX_CONE_NEGATIONS",CONVEX_CONE_NEGATIONS; "CONVEX_CONE_NONEMPTY",CONVEX_CONE_NONEMPTY; "CONVEX_CONE_PCROSS",CONVEX_CONE_PCROSS; "CONVEX_CONE_PCROSS_EQ",CONVEX_CONE_PCROSS_EQ; "CONVEX_CONE_SING",CONVEX_CONE_SING; "CONVEX_CONE_SPAN",CONVEX_CONE_SPAN; "CONVEX_CONE_SUMS",CONVEX_CONE_SUMS; "CONVEX_CONIC_HULL",CONVEX_CONIC_HULL; "CONVEX_CONIC_HULL_VERTEX_IMAGE",CONVEX_CONIC_HULL_VERTEX_IMAGE; "CONVEX_CONNECTED",CONVEX_CONNECTED; "CONVEX_CONNECTED_1",CONVEX_CONNECTED_1; "CONVEX_CONNECTED_1_GEN",CONVEX_CONNECTED_1_GEN; "CONVEX_CONNECTED_COLLINEAR",CONVEX_CONNECTED_COLLINEAR; "CONVEX_CONTAINS_OPEN_SEGMENT",CONVEX_CONTAINS_OPEN_SEGMENT; "CONVEX_CONTAINS_SEGMENT",CONVEX_CONTAINS_SEGMENT; "CONVEX_CONTAINS_SEGMENT_EQ",CONVEX_CONTAINS_SEGMENT_EQ; "CONVEX_CONTAINS_SEGMENT_IMP",CONVEX_CONTAINS_SEGMENT_IMP; "CONVEX_CONVEX_CONE_HULL",CONVEX_CONVEX_CONE_HULL; "CONVEX_CONVEX_HULL",CONVEX_CONVEX_HULL; "CONVEX_DIFFERENCES",CONVEX_DIFFERENCES; "CONVEX_DISTANCE",CONVEX_DISTANCE; "CONVEX_EMPTY",CONVEX_EMPTY; "CONVEX_EPIGRAPH",CONVEX_EPIGRAPH; "CONVEX_EPIGRAPH_CONVEX",CONVEX_EPIGRAPH_CONVEX; "CONVEX_EQ_CONNECTED_LINE_INTERSECTION",CONVEX_EQ_CONNECTED_LINE_INTERSECTION; "CONVEX_EQ_CONVEX_LINE_INTERSECTION",CONVEX_EQ_CONVEX_LINE_INTERSECTION; "CONVEX_EXPLICIT",CONVEX_EXPLICIT; "CONVEX_FACIAL_PARTITION",CONVEX_FACIAL_PARTITION; "CONVEX_FINITE",CONVEX_FINITE; "CONVEX_HALFSPACE_COMPONENT_GE",CONVEX_HALFSPACE_COMPONENT_GE; "CONVEX_HALFSPACE_COMPONENT_GT",CONVEX_HALFSPACE_COMPONENT_GT; "CONVEX_HALFSPACE_COMPONENT_LE",CONVEX_HALFSPACE_COMPONENT_LE; "CONVEX_HALFSPACE_COMPONENT_LT",CONVEX_HALFSPACE_COMPONENT_LT; "CONVEX_HALFSPACE_COMPONENT_SGN",CONVEX_HALFSPACE_COMPONENT_SGN; "CONVEX_HALFSPACE_GE",CONVEX_HALFSPACE_GE; "CONVEX_HALFSPACE_GT",CONVEX_HALFSPACE_GT; "CONVEX_HALFSPACE_IM_GE",CONVEX_HALFSPACE_IM_GE; "CONVEX_HALFSPACE_IM_GT",CONVEX_HALFSPACE_IM_GT; "CONVEX_HALFSPACE_IM_LE",CONVEX_HALFSPACE_IM_LE; "CONVEX_HALFSPACE_IM_LT",CONVEX_HALFSPACE_IM_LT; "CONVEX_HALFSPACE_IM_SGN",CONVEX_HALFSPACE_IM_SGN; "CONVEX_HALFSPACE_INTERSECTION",CONVEX_HALFSPACE_INTERSECTION; "CONVEX_HALFSPACE_LE",CONVEX_HALFSPACE_LE; "CONVEX_HALFSPACE_LT",CONVEX_HALFSPACE_LT; "CONVEX_HALFSPACE_RE_GE",CONVEX_HALFSPACE_RE_GE; "CONVEX_HALFSPACE_RE_GT",CONVEX_HALFSPACE_RE_GT; "CONVEX_HALFSPACE_RE_LE",CONVEX_HALFSPACE_RE_LE; "CONVEX_HALFSPACE_RE_LT",CONVEX_HALFSPACE_RE_LT; "CONVEX_HALFSPACE_RE_SGN",CONVEX_HALFSPACE_RE_SGN; "CONVEX_HALFSPACE_SGN",CONVEX_HALFSPACE_SGN; "CONVEX_HAS_BOUNDED_VARIATION",CONVEX_HAS_BOUNDED_VARIATION; "CONVEX_HAS_BOUNDED_VARIATION_EQ",CONVEX_HAS_BOUNDED_VARIATION_EQ; "CONVEX_HAUSDIST_LIMIT",CONVEX_HAUSDIST_LIMIT; "CONVEX_HULLS_EQ",CONVEX_HULLS_EQ; "CONVEX_HULL_2",CONVEX_HULL_2; "CONVEX_HULL_2_ALT",CONVEX_HULL_2_ALT; "CONVEX_HULL_3",CONVEX_HULL_3; "CONVEX_HULL_3_ALT",CONVEX_HULL_3_ALT; "CONVEX_HULL_AFFINITY",CONVEX_HULL_AFFINITY; "CONVEX_HULL_CARATHEODORY",CONVEX_HULL_CARATHEODORY; "CONVEX_HULL_CARATHEODORY_AFF_DIM",CONVEX_HULL_CARATHEODORY_AFF_DIM; "CONVEX_HULL_CLOSURE",CONVEX_HULL_CLOSURE; "CONVEX_HULL_CLOSURE_SUBSET",CONVEX_HULL_CLOSURE_SUBSET; "CONVEX_HULL_EMPTY",CONVEX_HULL_EMPTY; "CONVEX_HULL_EQ",CONVEX_HULL_EQ; "CONVEX_HULL_EQ_EMPTY",CONVEX_HULL_EQ_EMPTY; "CONVEX_HULL_EQ_SING",CONVEX_HULL_EQ_SING; "CONVEX_HULL_EXCHANGE_INTER",CONVEX_HULL_EXCHANGE_INTER; "CONVEX_HULL_EXCHANGE_UNION",CONVEX_HULL_EXCHANGE_UNION; "CONVEX_HULL_EXPLICIT",CONVEX_HULL_EXPLICIT; "CONVEX_HULL_FINITE",CONVEX_HULL_FINITE; "CONVEX_HULL_FINITE_IMAGE_EXPLICIT",CONVEX_HULL_FINITE_IMAGE_EXPLICIT; "CONVEX_HULL_FINITE_STEP",CONVEX_HULL_FINITE_STEP; "CONVEX_HULL_IMAGE",CONVEX_HULL_IMAGE; "CONVEX_HULL_IMAGE_LT",CONVEX_HULL_IMAGE_LT; "CONVEX_HULL_INDEXED",CONVEX_HULL_INDEXED; "CONVEX_HULL_INSERT",CONVEX_HULL_INSERT; "CONVEX_HULL_INSERT_ALT",CONVEX_HULL_INSERT_ALT; "CONVEX_HULL_INSERT_REDUNDANT_POINT",CONVEX_HULL_INSERT_REDUNDANT_POINT; "CONVEX_HULL_INSERT_SEGMENTS",CONVEX_HULL_INSERT_SEGMENTS; "CONVEX_HULL_INTER",CONVEX_HULL_INTER; "CONVEX_HULL_INTERIOR_SUBSET",CONVEX_HULL_INTERIOR_SUBSET; "CONVEX_HULL_INTERS",CONVEX_HULL_INTERS; "CONVEX_HULL_LINEAR_IMAGE",CONVEX_HULL_LINEAR_IMAGE; "CONVEX_HULL_PCROSS",CONVEX_HULL_PCROSS; "CONVEX_HULL_REDUNDANT_POINT",CONVEX_HULL_REDUNDANT_POINT; "CONVEX_HULL_REDUNDANT_SUBSET",CONVEX_HULL_REDUNDANT_SUBSET; "CONVEX_HULL_REDUNDANT_SUBSET_GEN",CONVEX_HULL_REDUNDANT_SUBSET_GEN; "CONVEX_HULL_REDUNDANT_SUBSET_REV",CONVEX_HULL_REDUNDANT_SUBSET_REV; "CONVEX_HULL_SCALING",CONVEX_HULL_SCALING; "CONVEX_HULL_SING",CONVEX_HULL_SING; "CONVEX_HULL_SPHERE",CONVEX_HULL_SPHERE; "CONVEX_HULL_SUBSET",CONVEX_HULL_SUBSET; "CONVEX_HULL_SUBSET_AFFINE_HULL",CONVEX_HULL_SUBSET_AFFINE_HULL; "CONVEX_HULL_SUBSET_CONVEX_CONE_HULL",CONVEX_HULL_SUBSET_CONVEX_CONE_HULL; "CONVEX_HULL_SUBSET_SPAN",CONVEX_HULL_SUBSET_SPAN; "CONVEX_HULL_SUMS",CONVEX_HULL_SUMS; "CONVEX_HULL_TRANSLATION",CONVEX_HULL_TRANSLATION; "CONVEX_HULL_UNION_EXPLICIT",CONVEX_HULL_UNION_EXPLICIT; "CONVEX_HULL_UNION_NONEMPTY_EXPLICIT",CONVEX_HULL_UNION_NONEMPTY_EXPLICIT; "CONVEX_HULL_UNION_UNIONS",CONVEX_HULL_UNION_UNIONS; "CONVEX_HULL_UNIV",CONVEX_HULL_UNIV; "CONVEX_HYPERPLANE",CONVEX_HYPERPLANE; "CONVEX_IMP_ANR",CONVEX_IMP_ANR; "CONVEX_IMP_AR",CONVEX_IMP_AR; "CONVEX_IMP_BORSUKIAN",CONVEX_IMP_BORSUKIAN; "CONVEX_IMP_BOUNDED_ON_INTERVAL",CONVEX_IMP_BOUNDED_ON_INTERVAL; "CONVEX_IMP_CONTRACTIBLE",CONVEX_IMP_CONTRACTIBLE; "CONVEX_IMP_LIPSCHITZ",CONVEX_IMP_LIPSCHITZ; "CONVEX_IMP_LOCALLY_BOUNDED",CONVEX_IMP_LOCALLY_BOUNDED; "CONVEX_IMP_LOCALLY_CONNECTED",CONVEX_IMP_LOCALLY_CONNECTED; "CONVEX_IMP_LOCALLY_LIPSCHITZ",CONVEX_IMP_LOCALLY_LIPSCHITZ; "CONVEX_IMP_LOCALLY_PATH_CONNECTED",CONVEX_IMP_LOCALLY_PATH_CONNECTED; "CONVEX_IMP_PATH_CONNECTED",CONVEX_IMP_PATH_CONNECTED; "CONVEX_IMP_PIECEWISE_MONOTONE",CONVEX_IMP_PIECEWISE_MONOTONE; "CONVEX_IMP_SIMPLY_CONNECTED",CONVEX_IMP_SIMPLY_CONNECTED; "CONVEX_IMP_STARLIKE",CONVEX_IMP_STARLIKE; "CONVEX_IMP_UNICOHERENT",CONVEX_IMP_UNICOHERENT; "CONVEX_INDEXED",CONVEX_INDEXED; "CONVEX_INNER_APPROXIMATION",CONVEX_INNER_APPROXIMATION; "CONVEX_INNER_POLYTOPE",CONVEX_INNER_POLYTOPE; "CONVEX_INTER",CONVEX_INTER; "CONVEX_INTERIOR",CONVEX_INTERIOR; "CONVEX_INTERIOR_CLOSURE",CONVEX_INTERIOR_CLOSURE; "CONVEX_INTERMEDIATE_BALL",CONVEX_INTERMEDIATE_BALL; "CONVEX_INTERS",CONVEX_INTERS; "CONVEX_INTERVAL",CONVEX_INTERVAL; "CONVEX_LINEAR_IMAGE",CONVEX_LINEAR_IMAGE; "CONVEX_LINEAR_IMAGE_EQ",CONVEX_LINEAR_IMAGE_EQ; "CONVEX_LINEAR_PREIMAGE",CONVEX_LINEAR_PREIMAGE; "CONVEX_LINE_INTERSECTION_UNIQUE_CLOSED",CONVEX_LINE_INTERSECTION_UNIQUE_CLOSED; "CONVEX_LINE_INTERSECTION_UNIQUE_OPEN",CONVEX_LINE_INTERSECTION_UNIQUE_OPEN; "CONVEX_LOCAL_GLOBAL_MINIMUM",CONVEX_LOCAL_GLOBAL_MINIMUM; "CONVEX_LOCAL_GLOBAL_MINIMUM_GEN",CONVEX_LOCAL_GLOBAL_MINIMUM_GEN; "CONVEX_LOCAL_GLOBAL_MINIMUM_SEGMENT",CONVEX_LOCAL_GLOBAL_MINIMUM_SEGMENT; "CONVEX_LOWER",CONVEX_LOWER; "CONVEX_LOWER_SEGMENT",CONVEX_LOWER_SEGMENT; "CONVEX_LOWER_SEGMENT_LT",CONVEX_LOWER_SEGMENT_LT; "CONVEX_MAX",CONVEX_MAX; "CONVEX_NEARBY_IN_SCALING",CONVEX_NEARBY_IN_SCALING; "CONVEX_NEARBY_IN_SCALING_RELATIVE_INTERIOR",CONVEX_NEARBY_IN_SCALING_RELATIVE_INTERIOR; "CONVEX_NEARBY_NOT_IN_SCALING",CONVEX_NEARBY_NOT_IN_SCALING; "CONVEX_NEGATIONS",CONVEX_NEGATIONS; "CONVEX_NORM",CONVEX_NORM; "CONVEX_ON_COMPOSE_LINEAR",CONVEX_ON_COMPOSE_LINEAR; "CONVEX_ON_CONST",CONVEX_ON_CONST; "CONVEX_ON_CONTINUOUS",CONVEX_ON_CONTINUOUS; "CONVEX_ON_CONTINUOUS_ON_RELATIVE_INTERIOR",CONVEX_ON_CONTINUOUS_ON_RELATIVE_INTERIOR; "CONVEX_ON_CONVEX_HULL_BOUND",CONVEX_ON_CONVEX_HULL_BOUND; "CONVEX_ON_CONVEX_HULL_BOUND_EQ",CONVEX_ON_CONVEX_HULL_BOUND_EQ; "CONVEX_ON_COUNTABLE_NONDIFFERENTIABLE",CONVEX_ON_COUNTABLE_NONDIFFERENTIABLE; "CONVEX_ON_DERIVATIVES",CONVEX_ON_DERIVATIVES; "CONVEX_ON_DERIVATIVES_IMP",CONVEX_ON_DERIVATIVES_IMP; "CONVEX_ON_DERIVATIVE_SECANT",CONVEX_ON_DERIVATIVE_SECANT; "CONVEX_ON_DERIVATIVE_SECANT_IMP",CONVEX_ON_DERIVATIVE_SECANT_IMP; "CONVEX_ON_DIRECTIONAL_DERIVATIVES",CONVEX_ON_DIRECTIONAL_DERIVATIVES; "CONVEX_ON_DIRECTIONAL_DERIVATIVE_FUNCTIONS",CONVEX_ON_DIRECTIONAL_DERIVATIVE_FUNCTIONS; "CONVEX_ON_EMPTY",CONVEX_ON_EMPTY; "CONVEX_ON_EPIGRAPH_SLICE_LE",CONVEX_ON_EPIGRAPH_SLICE_LE; "CONVEX_ON_EPIGRAPH_SLICE_LT",CONVEX_ON_EPIGRAPH_SLICE_LT; "CONVEX_ON_EQ",CONVEX_ON_EQ; "CONVEX_ON_IMP_JENSEN",CONVEX_ON_IMP_JENSEN; "CONVEX_ON_IMP_MIDPOINT_CONVEX",CONVEX_ON_IMP_MIDPOINT_CONVEX; "CONVEX_ON_INDEFINITE_INTEGRAL_INCREASING",CONVEX_ON_INDEFINITE_INTEGRAL_INCREASING; "CONVEX_ON_IS_INDEFINITE_INTEGRAL",CONVEX_ON_IS_INDEFINITE_INTEGRAL; "CONVEX_ON_JENSEN",CONVEX_ON_JENSEN; "CONVEX_ON_LEFT_DIFFERENTIABLE",CONVEX_ON_LEFT_DIFFERENTIABLE; "CONVEX_ON_LEFT_SECANT",CONVEX_ON_LEFT_SECANT; "CONVEX_ON_LEFT_SECANT_MUL",CONVEX_ON_LEFT_SECANT_MUL; "CONVEX_ON_MID_SECANT",CONVEX_ON_MID_SECANT; "CONVEX_ON_MID_SECANT_MUL",CONVEX_ON_MID_SECANT_MUL; "CONVEX_ON_RIGHT_DIFFERENTIABLE",CONVEX_ON_RIGHT_DIFFERENTIABLE; "CONVEX_ON_RIGHT_SECANT",CONVEX_ON_RIGHT_SECANT; "CONVEX_ON_RIGHT_SECANT_MUL",CONVEX_ON_RIGHT_SECANT_MUL; "CONVEX_ON_SECANTS_1",CONVEX_ON_SECANTS_1; "CONVEX_ON_SECANTS_1_IMP",CONVEX_ON_SECANTS_1_IMP; "CONVEX_ON_SECANT_DERIVATIVE",CONVEX_ON_SECANT_DERIVATIVE; "CONVEX_ON_SECANT_DERIVATIVE_IMP",CONVEX_ON_SECANT_DERIVATIVE_IMP; "CONVEX_ON_SETDIST",CONVEX_ON_SETDIST; "CONVEX_ON_SING",CONVEX_ON_SING; "CONVEX_ON_SUBSET",CONVEX_ON_SUBSET; "CONVEX_ON_SUP",CONVEX_ON_SUP; "CONVEX_ON_TRANSLATION",CONVEX_ON_TRANSLATION; "CONVEX_OPEN_SEGMENT_CASES",CONVEX_OPEN_SEGMENT_CASES; "CONVEX_OUTER_APPROXIMATION",CONVEX_OUTER_APPROXIMATION; "CONVEX_OUTER_POLYTOPE",CONVEX_OUTER_POLYTOPE; "CONVEX_PCROSS",CONVEX_PCROSS; "CONVEX_PCROSS_EQ",CONVEX_PCROSS_EQ; "CONVEX_POSITIVE_ORTHANT",CONVEX_POSITIVE_ORTHANT; "CONVEX_PREIMAGE_CONCAVE_SCALING",CONVEX_PREIMAGE_CONCAVE_SCALING; "CONVEX_REAL",CONVEX_REAL; "CONVEX_RELATIVE_BOUNDARY_SUBSET_OF_PROPER_FACE",CONVEX_RELATIVE_BOUNDARY_SUBSET_OF_PROPER_FACE; "CONVEX_RELATIVE_INTERIOR",CONVEX_RELATIVE_INTERIOR; "CONVEX_RELATIVE_INTERIOR_CLOSURE",CONVEX_RELATIVE_INTERIOR_CLOSURE; "CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE; "CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE; "CONVEX_SCALING",CONVEX_SCALING; "CONVEX_SCALING_EQ",CONVEX_SCALING_EQ; "CONVEX_SEGMENT",CONVEX_SEGMENT; "CONVEX_SEMIOPEN_SEGMENT",CONVEX_SEMIOPEN_SEGMENT; "CONVEX_SIMPLEX",CONVEX_SIMPLEX; "CONVEX_SING",CONVEX_SING; "CONVEX_SLICE",CONVEX_SLICE; "CONVEX_SPAN",CONVEX_SPAN; "CONVEX_STANDARD_HYPERPLANE",CONVEX_STANDARD_HYPERPLANE; "CONVEX_STARCENTRES",CONVEX_STARCENTRES; "CONVEX_STRIP_COMPONENT_LE",CONVEX_STRIP_COMPONENT_LE; "CONVEX_STRIP_COMPONENT_LT",CONVEX_STRIP_COMPONENT_LT; "CONVEX_SUMS",CONVEX_SUMS; "CONVEX_SUMS_MULTIPLES",CONVEX_SUMS_MULTIPLES; "CONVEX_SYMDIFF_CLOSE_TO_FRONTIER",CONVEX_SYMDIFF_CLOSE_TO_FRONTIER; "CONVEX_TRANSLATION",CONVEX_TRANSLATION; "CONVEX_TRANSLATION_EQ",CONVEX_TRANSLATION_EQ; "CONVEX_TRANSLATION_SUBSET_PREIMAGE",CONVEX_TRANSLATION_SUBSET_PREIMAGE; "CONVEX_TRANSLATION_SUPERSET_PREIMAGE",CONVEX_TRANSLATION_SUPERSET_PREIMAGE; "CONVEX_UNIONS_FULLDIM_CELLS",CONVEX_UNIONS_FULLDIM_CELLS; "CONVEX_UNIV",CONVEX_UNIV; "CONVEX_VSUM",CONVEX_VSUM; "CONVEX_VSUM_STRONG",CONVEX_VSUM_STRONG; "COPLANAR_2",COPLANAR_2; "COPLANAR_3",COPLANAR_3; "COPLANAR_AFFINE_HULL_COPLANAR",COPLANAR_AFFINE_HULL_COPLANAR; "COPLANAR_AFF_DIM",COPLANAR_AFF_DIM; "COPLANAR_EMPTY",COPLANAR_EMPTY; "COPLANAR_INTERSECTING_LINES",COPLANAR_INTERSECTING_LINES; "COPLANAR_LINEAR_IMAGE",COPLANAR_LINEAR_IMAGE; "COPLANAR_LINEAR_IMAGE_EQ",COPLANAR_LINEAR_IMAGE_EQ; "COPLANAR_SING",COPLANAR_SING; "COPLANAR_SMALL",COPLANAR_SMALL; "COPLANAR_SUBSET",COPLANAR_SUBSET; "COPLANAR_TRANSLATION",COPLANAR_TRANSLATION; "COPLANAR_TRANSLATION_EQ",COPLANAR_TRANSLATION_EQ; "COSMALL_APPROXIMATION",COSMALL_APPROXIMATION; "COS_0",COS_0; "COS_ABS",COS_ABS; "COS_ACS",COS_ACS; "COS_ADD",COS_ADD; "COS_ASN",COS_ASN; "COS_ASN_NZ",COS_ASN_NZ; "COS_ATN",COS_ATN; "COS_ATN_NZ",COS_ATN_NZ; "COS_BOUND",COS_BOUND; "COS_BOUNDS",COS_BOUNDS; "COS_DOUBLE",COS_DOUBLE; "COS_DOUBLE_BOUND",COS_DOUBLE_BOUND; "COS_DOUBLE_COS",COS_DOUBLE_COS; "COS_DOUBLE_SIN",COS_DOUBLE_SIN; "COS_EQ",COS_EQ; "COS_EQ_0",COS_EQ_0; "COS_EQ_1",COS_EQ_1; "COS_EQ_MINUS1",COS_EQ_MINUS1; "COS_GOESNEGATIVE",COS_GOESNEGATIVE; "COS_GOESNEGATIVE_LEMMA",COS_GOESNEGATIVE_LEMMA; "COS_HASZERO",COS_HASZERO; "COS_INJ_PI",COS_INJ_PI; "COS_INTEGER_2PI",COS_INTEGER_2PI; "COS_MONO_LE",COS_MONO_LE; "COS_MONO_LE_EQ",COS_MONO_LE_EQ; "COS_MONO_LT",COS_MONO_LT; "COS_MONO_LT_EQ",COS_MONO_LT_EQ; "COS_NEG",COS_NEG; "COS_NONTRIVIAL",COS_NONTRIVIAL; "COS_NPI",COS_NPI; "COS_ONE_2PI",COS_ONE_2PI; "COS_PERIODIC",COS_PERIODIC; "COS_PERIODIC_PI",COS_PERIODIC_PI; "COS_PI",COS_PI; "COS_PI2",COS_PI2; "COS_PI3",COS_PI3; "COS_PI6",COS_PI6; "COS_POS_PI",COS_POS_PI; "COS_POS_PI2",COS_POS_PI2; "COS_POS_PI_LE",COS_POS_PI_LE; "COS_SIN",COS_SIN; "COS_SUB",COS_SUB; "COS_TAN",COS_TAN; "COS_TREBLE_COS",COS_TREBLE_COS; "COS_ZERO",COS_ZERO; "COS_ZERO_PI",COS_ZERO_PI; "COUNTABLE",COUNTABLE; "COUNTABLE_ALT",COUNTABLE_ALT; "COUNTABLE_ANR_COMPONENTS",COUNTABLE_ANR_COMPONENTS; "COUNTABLE_ANR_CONNECTED_COMPONENTS",COUNTABLE_ANR_CONNECTED_COMPONENTS; "COUNTABLE_ANR_PATH_COMPONENTS",COUNTABLE_ANR_PATH_COMPONENTS; "COUNTABLE_ASCENDING_CHAIN",COUNTABLE_ASCENDING_CHAIN; "COUNTABLE_ASCENDING_CLOPEN_CHAIN",COUNTABLE_ASCENDING_CLOPEN_CHAIN; "COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN",COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN; "COUNTABLE_AS_IMAGE",COUNTABLE_AS_IMAGE; "COUNTABLE_AS_IMAGE_NUM_SUBSET",COUNTABLE_AS_IMAGE_NUM_SUBSET; "COUNTABLE_AS_IMAGE_SUBSET",COUNTABLE_AS_IMAGE_SUBSET; "COUNTABLE_AS_IMAGE_SUBSET_EQ",COUNTABLE_AS_IMAGE_SUBSET_EQ; "COUNTABLE_AS_INJECTIVE_IMAGE",COUNTABLE_AS_INJECTIVE_IMAGE; "COUNTABLE_AS_INJECTIVE_IMAGE_SUBSET",COUNTABLE_AS_INJECTIVE_IMAGE_SUBSET; "COUNTABLE_CARD_ADD",COUNTABLE_CARD_ADD; "COUNTABLE_CARD_ADD_EQ",COUNTABLE_CARD_ADD_EQ; "COUNTABLE_CARD_MUL",COUNTABLE_CARD_MUL; "COUNTABLE_CARD_MUL_EQ",COUNTABLE_CARD_MUL_EQ; "COUNTABLE_CART",COUNTABLE_CART; "COUNTABLE_CASES",COUNTABLE_CASES; "COUNTABLE_CLOPEN_IN",COUNTABLE_CLOPEN_IN; "COUNTABLE_COMPACT_OPEN_IN",COUNTABLE_COMPACT_OPEN_IN; "COUNTABLE_COMPONENTS",COUNTABLE_COMPONENTS; "COUNTABLE_COMPONENTS_UNION",COUNTABLE_COMPONENTS_UNION; "COUNTABLE_CONNECTED_COMPONENTS",COUNTABLE_CONNECTED_COMPONENTS; "COUNTABLE_CROSS",COUNTABLE_CROSS; "COUNTABLE_DELETE",COUNTABLE_DELETE; "COUNTABLE_DESCENDING_CHAIN",COUNTABLE_DESCENDING_CHAIN; "COUNTABLE_DESCENDING_CLOPEN_CHAIN",COUNTABLE_DESCENDING_CLOPEN_CHAIN; "COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN",COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN; "COUNTABLE_DIFF_FINITE",COUNTABLE_DIFF_FINITE; "COUNTABLE_DISJOINT_NONEMPTY_INTERIOR_SUBSETS",COUNTABLE_DISJOINT_NONEMPTY_INTERIOR_SUBSETS; "COUNTABLE_DISJOINT_OPEN_IN_SUBSETS",COUNTABLE_DISJOINT_OPEN_IN_SUBSETS; "COUNTABLE_DISJOINT_OPEN_SUBSETS",COUNTABLE_DISJOINT_OPEN_SUBSETS; "COUNTABLE_ELEMENTARY_DIVISION",COUNTABLE_ELEMENTARY_DIVISION; "COUNTABLE_EMPTY",COUNTABLE_EMPTY; "COUNTABLE_EMPTY_INTERIOR",COUNTABLE_EMPTY_INTERIOR; "COUNTABLE_ENR_COMPONENTS",COUNTABLE_ENR_COMPONENTS; "COUNTABLE_ENR_CONNECTED_COMPONENTS",COUNTABLE_ENR_CONNECTED_COMPONENTS; "COUNTABLE_ENR_PATH_COMPONENTS",COUNTABLE_ENR_PATH_COMPONENTS; "COUNTABLE_FINITE_SUBSETS",COUNTABLE_FINITE_SUBSETS; "COUNTABLE_FL",COUNTABLE_FL; "COUNTABLE_IMAGE",COUNTABLE_IMAGE; "COUNTABLE_IMAGE_INJ",COUNTABLE_IMAGE_INJ; "COUNTABLE_IMAGE_INJ_EQ",COUNTABLE_IMAGE_INJ_EQ; "COUNTABLE_IMAGE_INJ_GENERAL",COUNTABLE_IMAGE_INJ_GENERAL; "COUNTABLE_IMP_CARD_LT_REAL",COUNTABLE_IMP_CARD_LT_REAL; "COUNTABLE_IMP_DIMENSION_LE_0",COUNTABLE_IMP_DIMENSION_LE_0; "COUNTABLE_IMP_DISCONNECTED",COUNTABLE_IMP_DISCONNECTED; "COUNTABLE_IMP_FSIGMA",COUNTABLE_IMP_FSIGMA; "COUNTABLE_INSERT",COUNTABLE_INSERT; "COUNTABLE_INTEGER",COUNTABLE_INTEGER; "COUNTABLE_INTEGER_COORDINATES",COUNTABLE_INTEGER_COORDINATES; "COUNTABLE_INTER",COUNTABLE_INTER; "COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR",COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR; "COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR",COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR; "COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE",COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE; "COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION",COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION; "COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE",COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE; "COUNTABLE_INTERSECTION_OF_COMPLEMENT",COUNTABLE_INTERSECTION_OF_COMPLEMENT; "COUNTABLE_INTERSECTION_OF_IDEMPOT",COUNTABLE_INTERSECTION_OF_IDEMPOT; "COUNTABLE_INTERSECTION_OF_INC",COUNTABLE_INTERSECTION_OF_INC; "COUNTABLE_INTERSECTION_OF_INTER",COUNTABLE_INTERSECTION_OF_INTER; "COUNTABLE_INTERSECTION_OF_INTERS",COUNTABLE_INTERSECTION_OF_INTERS; "COUNTABLE_INTERSECTION_OF_UNION",COUNTABLE_INTERSECTION_OF_UNION; "COUNTABLE_ISOLATED_SET",COUNTABLE_ISOLATED_SET; "COUNTABLE_LIST",COUNTABLE_LIST; "COUNTABLE_LIST_GEN",COUNTABLE_LIST_GEN; "COUNTABLE_LOCAL_MAXIMA",COUNTABLE_LOCAL_MAXIMA; "COUNTABLE_LOCAL_MINIMA",COUNTABLE_LOCAL_MINIMA; "COUNTABLE_NON_CONDENSATION_POINTS",COUNTABLE_NON_CONDENSATION_POINTS; "COUNTABLE_NON_LIMIT_POINTS",COUNTABLE_NON_LIMIT_POINTS; "COUNTABLE_OPEN_COMPONENTS",COUNTABLE_OPEN_COMPONENTS; "COUNTABLE_OPEN_CONNECTED_COMPONENTS",COUNTABLE_OPEN_CONNECTED_COMPONENTS; "COUNTABLE_OPEN_INTERVAL",COUNTABLE_OPEN_INTERVAL; "COUNTABLE_PATH_COMPONENTS",COUNTABLE_PATH_COMPONENTS; "COUNTABLE_PCROSS",COUNTABLE_PCROSS; "COUNTABLE_PCROSS_EQ",COUNTABLE_PCROSS_EQ; "COUNTABLE_PRODUCT_DEPENDENT",COUNTABLE_PRODUCT_DEPENDENT; "COUNTABLE_RATIONAL",COUNTABLE_RATIONAL; "COUNTABLE_RATIONAL_COORDINATES",COUNTABLE_RATIONAL_COORDINATES; "COUNTABLE_RESTRICT",COUNTABLE_RESTRICT; "COUNTABLE_SING",COUNTABLE_SING; "COUNTABLE_STRICT_LOCAL_MAXIMA",COUNTABLE_STRICT_LOCAL_MAXIMA; "COUNTABLE_STRICT_LOCAL_MINIMA",COUNTABLE_STRICT_LOCAL_MINIMA; "COUNTABLE_SUBSET",COUNTABLE_SUBSET; "COUNTABLE_SUBSET_IMAGE",COUNTABLE_SUBSET_IMAGE; "COUNTABLE_SUBSET_NUM",COUNTABLE_SUBSET_NUM; "COUNTABLE_UNION",COUNTABLE_UNION; "COUNTABLE_UNIONS",COUNTABLE_UNIONS; "COUNTABLE_UNION_IMP",COUNTABLE_UNION_IMP; "COUNTABLE_UNION_OF_ASCENDING",COUNTABLE_UNION_OF_ASCENDING; "COUNTABLE_UNION_OF_BAIRE0_INDICATOR",COUNTABLE_UNION_OF_BAIRE0_INDICATOR; "COUNTABLE_UNION_OF_BAIRE_INDICATOR",COUNTABLE_UNION_OF_BAIRE_INDICATOR; "COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE",COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE; "COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION",COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION; "COUNTABLE_UNION_OF_BIJECTIVE_IMAGE",COUNTABLE_UNION_OF_BIJECTIVE_IMAGE; "COUNTABLE_UNION_OF_COMPLEMENT",COUNTABLE_UNION_OF_COMPLEMENT; "COUNTABLE_UNION_OF_EXPLICIT",COUNTABLE_UNION_OF_EXPLICIT; "COUNTABLE_UNION_OF_IDEMPOT",COUNTABLE_UNION_OF_IDEMPOT; "COUNTABLE_UNION_OF_INC",COUNTABLE_UNION_OF_INC; "COUNTABLE_UNION_OF_INTER",COUNTABLE_UNION_OF_INTER; "COUNTABLE_UNION_OF_RELATIVE_TO",COUNTABLE_UNION_OF_RELATIVE_TO; "COUNTABLE_UNION_OF_UNION",COUNTABLE_UNION_OF_UNION; "COUNTABLE_UNION_OF_UNIONS",COUNTABLE_UNION_OF_UNIONS; "COVARIANCE_MATRIX_EQ_0",COVARIANCE_MATRIX_EQ_0; "COVARIANCE_MATRIX_EQ_SQUARE",COVARIANCE_MATRIX_EQ_SQUARE; "COVARIANCE_MATRIX_INV",COVARIANCE_MATRIX_INV; "COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL",COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL; "COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL_ALT",COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL_ALT; "COVERING_LEMMA",COVERING_LEMMA; "COVERING_SPACE_CEXP_PUNCTURED_PLANE",COVERING_SPACE_CEXP_PUNCTURED_PLANE; "COVERING_SPACE_CLOSED_MAP",COVERING_SPACE_CLOSED_MAP; "COVERING_SPACE_COMPACT",COVERING_SPACE_COMPACT; "COVERING_SPACE_COUNTABLE_SHEETS",COVERING_SPACE_COUNTABLE_SHEETS; "COVERING_SPACE_FIBRE_NO_LIMPT",COVERING_SPACE_FIBRE_NO_LIMPT; "COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE",COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE; "COVERING_SPACE_FINITE_SHEETS",COVERING_SPACE_FINITE_SHEETS; "COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP; "COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG; "COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP; "COVERING_SPACE_HOMEOMORPHISM",COVERING_SPACE_HOMEOMORPHISM; "COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL",COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL; "COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ",COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ; "COVERING_SPACE_IMP_CONTINUOUS",COVERING_SPACE_IMP_CONTINUOUS; "COVERING_SPACE_IMP_SURJECTIVE",COVERING_SPACE_IMP_SURJECTIVE; "COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP",COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP; "COVERING_SPACE_INJECTIVE",COVERING_SPACE_INJECTIVE; "COVERING_SPACE_LIFT",COVERING_SPACE_LIFT; "COVERING_SPACE_LIFT_GENERAL",COVERING_SPACE_LIFT_GENERAL; "COVERING_SPACE_LIFT_HOLOMORPHIC",COVERING_SPACE_LIFT_HOLOMORPHIC; "COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION",COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION; "COVERING_SPACE_LIFT_HOMOTOPIC_PATH",COVERING_SPACE_LIFT_HOMOTOPIC_PATH; "COVERING_SPACE_LIFT_HOMOTOPIC_PATHS",COVERING_SPACE_LIFT_HOMOTOPIC_PATHS; "COVERING_SPACE_LIFT_HOMOTOPY",COVERING_SPACE_LIFT_HOMOTOPY; "COVERING_SPACE_LIFT_HOMOTOPY_ALT",COVERING_SPACE_LIFT_HOMOTOPY_ALT; "COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION",COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION; "COVERING_SPACE_LIFT_IS_HOLOMORPHIC",COVERING_SPACE_LIFT_IS_HOLOMORPHIC; "COVERING_SPACE_LIFT_PATH",COVERING_SPACE_LIFT_PATH; "COVERING_SPACE_LIFT_PATH_STRONG",COVERING_SPACE_LIFT_PATH_STRONG; "COVERING_SPACE_LIFT_STRONG",COVERING_SPACE_LIFT_STRONG; "COVERING_SPACE_LIFT_STRONGER",COVERING_SPACE_LIFT_STRONGER; "COVERING_SPACE_LIFT_UNIQUE",COVERING_SPACE_LIFT_UNIQUE; "COVERING_SPACE_LIFT_UNIQUE_GEN",COVERING_SPACE_LIFT_UNIQUE_GEN; "COVERING_SPACE_LIFT_UNIQUE_IDENTITY",COVERING_SPACE_LIFT_UNIQUE_IDENTITY; "COVERING_SPACE_LOCALIZED_HOMEOMORPHISM",COVERING_SPACE_LOCALIZED_HOMEOMORPHISM; "COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT",COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT; "COVERING_SPACE_LOCALLY",COVERING_SPACE_LOCALLY; "COVERING_SPACE_LOCALLY_COMPACT",COVERING_SPACE_LOCALLY_COMPACT; "COVERING_SPACE_LOCALLY_COMPACT_EQ",COVERING_SPACE_LOCALLY_COMPACT_EQ; "COVERING_SPACE_LOCALLY_CONNECTED",COVERING_SPACE_LOCALLY_CONNECTED; "COVERING_SPACE_LOCALLY_CONNECTED_EQ",COVERING_SPACE_LOCALLY_CONNECTED_EQ; "COVERING_SPACE_LOCALLY_EQ",COVERING_SPACE_LOCALLY_EQ; "COVERING_SPACE_LOCALLY_HOMEOMORPHIC",COVERING_SPACE_LOCALLY_HOMEOMORPHIC; "COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ",COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ; "COVERING_SPACE_LOCALLY_PATH_CONNECTED",COVERING_SPACE_LOCALLY_PATH_CONNECTED; "COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ",COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ; "COVERING_SPACE_LOCAL_HOMEOMORPHISM",COVERING_SPACE_LOCAL_HOMEOMORPHISM; "COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT",COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT; "COVERING_SPACE_MONODROMY",COVERING_SPACE_MONODROMY; "COVERING_SPACE_OPEN_MAP",COVERING_SPACE_OPEN_MAP; "COVERING_SPACE_POW_PUNCTURED_PLANE",COVERING_SPACE_POW_PUNCTURED_PLANE; "COVERING_SPACE_QUOTIENT_MAP",COVERING_SPACE_QUOTIENT_MAP; "COVERING_SPACE_SELF_FINITE_FUNDAMENTAL_GROUP",COVERING_SPACE_SELF_FINITE_FUNDAMENTAL_GROUP; "COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP",COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP; "COVERING_SPACE_SQUARE_PUNCTURED_PLANE",COVERING_SPACE_SQUARE_PUNCTURED_PLANE; "CPOW_0",CPOW_0; "CPOW_1",CPOW_1; "CPOW_ADD",CPOW_ADD; "CPOW_EQ_0",CPOW_EQ_0; "CPOW_MUL_REAL",CPOW_MUL_REAL; "CPOW_N",CPOW_N; "CPOW_NEG",CPOW_NEG; "CPOW_REAL_REAL",CPOW_REAL_REAL; "CPOW_SUB",CPOW_SUB; "CPOW_SUC",CPOW_SUC; "CPRODUCT_1",CPRODUCT_1; "CPRODUCT_CLAUSES",CPRODUCT_CLAUSES; "CPRODUCT_CLAUSES_LEFT",CPRODUCT_CLAUSES_LEFT; "CPRODUCT_CLAUSES_NUMSEG",CPRODUCT_CLAUSES_NUMSEG; "CPRODUCT_CLAUSES_RIGHT",CPRODUCT_CLAUSES_RIGHT; "CPRODUCT_CONST",CPRODUCT_CONST; "CPRODUCT_CONST_NUMSEG",CPRODUCT_CONST_NUMSEG; "CPRODUCT_EQ",CPRODUCT_EQ; "CPRODUCT_EQ_0",CPRODUCT_EQ_0; "CPRODUCT_EQ_1",CPRODUCT_EQ_1; "CPRODUCT_IMAGE",CPRODUCT_IMAGE; "CPRODUCT_INV",CPRODUCT_INV; "CPRODUCT_MUL",CPRODUCT_MUL; "CPRODUCT_OFFSET",CPRODUCT_OFFSET; "CPRODUCT_PAIR",CPRODUCT_PAIR; "CPRODUCT_POW",CPRODUCT_POW; "CPRODUCT_REFLECT",CPRODUCT_REFLECT; "CPRODUCT_SING",CPRODUCT_SING; "CRAMER",CRAMER; "CRAMER_LEMMA",CRAMER_LEMMA; "CRAMER_LEMMA_TRANSP",CRAMER_LEMMA_TRANSP; "CRAMER_MATRIX_LEFT",CRAMER_MATRIX_LEFT; "CRAMER_MATRIX_LEFT_INVERSE",CRAMER_MATRIX_LEFT_INVERSE; "CRAMER_MATRIX_RIGHT",CRAMER_MATRIX_RIGHT; "CRAMER_MATRIX_RIGHT_INVERSE",CRAMER_MATRIX_RIGHT_INVERSE; "CROSS",CROSS; "CROSS_DIFF",CROSS_DIFF; "CROSS_EMPTY",CROSS_EMPTY; "CROSS_EQ",CROSS_EQ; "CROSS_EQ_EMPTY",CROSS_EQ_EMPTY; "CROSS_INTER",CROSS_INTER; "CROSS_INTERS",CROSS_INTERS; "CROSS_INTERS_INTERS",CROSS_INTERS_INTERS; "CROSS_MONO",CROSS_MONO; "CROSS_UNION",CROSS_UNION; "CROSS_UNIONS",CROSS_UNIONS; "CROSS_UNIONS_UNIONS",CROSS_UNIONS_UNIONS; "CROSS_UNIV",CROSS_UNIV; "CSIN_0",CSIN_0; "CSIN_ADD",CSIN_ADD; "CSIN_CACS",CSIN_CACS; "CSIN_CACS_NZ",CSIN_CACS_NZ; "CSIN_CASN",CSIN_CASN; "CSIN_CCOS_CSQRT",CSIN_CCOS_CSQRT; "CSIN_CIRCLE",CSIN_CIRCLE; "CSIN_CONVERGES",CSIN_CONVERGES; "CSIN_DOUBLE",CSIN_DOUBLE; "CSIN_EQ",CSIN_EQ; "CSIN_EQ_0",CSIN_EQ_0; "CSIN_EQ_1",CSIN_EQ_1; "CSIN_EQ_MINUS1",CSIN_EQ_MINUS1; "CSIN_NEG",CSIN_NEG; "CSIN_SUB",CSIN_SUB; "CSQRT",CSQRT; "CSQRT_0",CSQRT_0; "CSQRT_1",CSQRT_1; "CSQRT_CEXP_CLOG",CSQRT_CEXP_CLOG; "CSQRT_CX",CSQRT_CX; "CSQRT_EQ_0",CSQRT_EQ_0; "CSQRT_PRINCIPAL",CSQRT_PRINCIPAL; "CSQRT_UNIQUE",CSQRT_UNIQUE; "CTAN_0",CTAN_0; "CTAN_ADD",CTAN_ADD; "CTAN_CATN",CTAN_CATN; "CTAN_DOUBLE",CTAN_DOUBLE; "CTAN_NEG",CTAN_NEG; "CTAN_SUB",CTAN_SUB; "CURRY_DEF",CURRY_DEF; "CX_2PII_NZ",CX_2PII_NZ; "CX_ABS",CX_ABS; "CX_ACS",CX_ACS; "CX_ADD",CX_ADD; "CX_ASN",CX_ASN; "CX_ATN",CX_ATN; "CX_COS",CX_COS; "CX_COSH",CX_COSH; "CX_DEF",CX_DEF; "CX_DIV",CX_DIV; "CX_EXP",CX_EXP; "CX_IM_CNJ",CX_IM_CNJ; "CX_INJ",CX_INJ; "CX_INV",CX_INV; "CX_LOG",CX_LOG; "CX_MUL",CX_MUL; "CX_NEG",CX_NEG; "CX_PI_NZ",CX_PI_NZ; "CX_POW",CX_POW; "CX_PRODUCT",CX_PRODUCT; "CX_RE_CNJ",CX_RE_CNJ; "CX_SIN",CX_SIN; "CX_SINH",CX_SINH; "CX_SQRT",CX_SQRT; "CX_SUB",CX_SUB; "CX_TAN",CX_TAN; "DARBOUX_AND_REGULATED_IMP_CONTINUOUS",DARBOUX_AND_REGULATED_IMP_CONTINUOUS; "DECIMAL",DECIMAL; "DECOMPOSITION",DECOMPOSITION; "DECREASING_BOUNDED_VARIATION",DECREASING_BOUNDED_VARIATION; "DECREASING_BOUNDED_VARIATION_GEN",DECREASING_BOUNDED_VARIATION_GEN; "DECREASING_CLOSED_NEST",DECREASING_CLOSED_NEST; "DECREASING_CLOSED_NEST_SING",DECREASING_CLOSED_NEST_SING; "DECREASING_COUNTABLE_DISCONTINUITIES",DECREASING_COUNTABLE_DISCONTINUITIES; "DECREASING_LEFT_LIMIT",DECREASING_LEFT_LIMIT; "DECREASING_LEFT_LIMIT_1",DECREASING_LEFT_LIMIT_1; "DECREASING_LEFT_LIMIT_1_GEN",DECREASING_LEFT_LIMIT_1_GEN; "DECREASING_RIGHT_LIMIT",DECREASING_RIGHT_LIMIT; "DECREASING_RIGHT_LIMIT_1",DECREASING_RIGHT_LIMIT_1; "DECREASING_RIGHT_LIMIT_1_GEN",DECREASING_RIGHT_LIMIT_1_GEN; "DECREASING_VECTOR_VARIATION",DECREASING_VECTOR_VARIATION; "DEFORMATION_RETRACT",DEFORMATION_RETRACT; "DEFORMATION_RETRACTION_COMPOSE",DEFORMATION_RETRACTION_COMPOSE; "DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT",DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT; "DEFORMATION_RETRACT_OF_CONTRACTIBLE",DEFORMATION_RETRACT_OF_CONTRACTIBLE; "DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING",DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING; "DEFORMATION_RETRACT_TRANS",DEFORMATION_RETRACT_TRANS; "DELETE",DELETE; "DELETE_COMM",DELETE_COMM; "DELETE_DELETE",DELETE_DELETE; "DELETE_INSERT",DELETE_INSERT; "DELETE_INTER",DELETE_INTER; "DELETE_NON_ELEMENT",DELETE_NON_ELEMENT; "DELETE_SUBSET",DELETE_SUBSET; "DEMOIVRE",DEMOIVRE; "DENSE_ACCESSIBLE_FRONTIER_POINTS",DENSE_ACCESSIBLE_FRONTIER_POINTS; "DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED",DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED; "DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS",DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS; "DENSE_COMPLEMENT_AFFINE",DENSE_COMPLEMENT_AFFINE; "DENSE_COMPLEMENT_CONVEX",DENSE_COMPLEMENT_CONVEX; "DENSE_COMPLEMENT_CONVEX_CLOSED",DENSE_COMPLEMENT_CONVEX_CLOSED; "DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL",DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL; "DENSE_COMPLEMENT_SUBSPACE",DENSE_COMPLEMENT_SUBSPACE; "DENSE_GDELTA_IMP_LARGE",DENSE_GDELTA_IMP_LARGE; "DENSE_IMP_PERFECT",DENSE_IMP_PERFECT; "DENSE_INTERSECTS_OPEN",DENSE_INTERSECTS_OPEN; "DENSE_LIMIT_POINTS",DENSE_LIMIT_POINTS; "DENSE_OPEN_INTER",DENSE_OPEN_INTER; "DENSE_OPEN_INTERS",DENSE_OPEN_INTERS; "DEPENDENT_2",DEPENDENT_2; "DEPENDENT_3",DEPENDENT_3; "DEPENDENT_AFFINE_DEPENDENT_CASES",DEPENDENT_AFFINE_DEPENDENT_CASES; "DEPENDENT_BIGGERSET",DEPENDENT_BIGGERSET; "DEPENDENT_BIGGERSET_GENERAL",DEPENDENT_BIGGERSET_GENERAL; "DEPENDENT_CHOICE",DEPENDENT_CHOICE; "DEPENDENT_CHOICE_FIXED",DEPENDENT_CHOICE_FIXED; "DEPENDENT_EQ_DIM_LT_CARD",DEPENDENT_EQ_DIM_LT_CARD; "DEPENDENT_EXPLICIT",DEPENDENT_EXPLICIT; "DEPENDENT_FINITE",DEPENDENT_FINITE; "DEPENDENT_IMP_AFFINE_DEPENDENT",DEPENDENT_IMP_AFFINE_DEPENDENT; "DEPENDENT_LINEAR_IMAGE",DEPENDENT_LINEAR_IMAGE; "DEPENDENT_LINEAR_IMAGE_EQ",DEPENDENT_LINEAR_IMAGE_EQ; "DEPENDENT_MONO",DEPENDENT_MONO; "DEPENDENT_SING",DEPENDENT_SING; "DERIVED_SET_OF_EMPTY",DERIVED_SET_OF_EMPTY; "DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE",DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE; "DERIVED_SET_OF_MONO",DERIVED_SET_OF_MONO; "DERIVED_SET_OF_RESTRICT",DERIVED_SET_OF_RESTRICT; "DERIVED_SET_OF_SUBSET_CLOSURE_OF",DERIVED_SET_OF_SUBSET_CLOSURE_OF; "DERIVED_SET_OF_SUBSET_SUBTOPOLOGY",DERIVED_SET_OF_SUBSET_SUBTOPOLOGY; "DERIVED_SET_OF_SUBSET_TOPSPACE",DERIVED_SET_OF_SUBSET_TOPSPACE; "DERIVED_SET_OF_SUBTOPOLOGY",DERIVED_SET_OF_SUBTOPOLOGY; "DERIVED_SET_OF_TRANSLATION",DERIVED_SET_OF_TRANSLATION; "DERIVED_SET_OF_UNION",DERIVED_SET_OF_UNION; "DERIVED_SET_OF_UNIONS",DERIVED_SET_OF_UNIONS; "DEST_MK_MULTIVECTOR",DEST_MK_MULTIVECTOR; "DEST_REC_INJ",DEST_REC_INJ; "DET_0",DET_0; "DET_1",DET_1; "DET_1_GEN",DET_1_GEN; "DET_2",DET_2; "DET_3",DET_3; "DET_4",DET_4; "DET_CMUL",DET_CMUL; "DET_COFACTOR",DET_COFACTOR; "DET_COFACTOR_EXPANSION",DET_COFACTOR_EXPANSION; "DET_DEPENDENT_COLUMNS",DET_DEPENDENT_COLUMNS; "DET_DEPENDENT_ROWS",DET_DEPENDENT_ROWS; "DET_DIAGONAL",DET_DIAGONAL; "DET_EQ_0",DET_EQ_0; "DET_EQ_0_RANK",DET_EQ_0_RANK; "DET_I",DET_I; "DET_IDENTICAL_COLUMNS",DET_IDENTICAL_COLUMNS; "DET_IDENTICAL_ROWS",DET_IDENTICAL_ROWS; "DET_LE_ONORM_POW",DET_LE_ONORM_POW; "DET_LINEAR_ROWS",DET_LINEAR_ROWS; "DET_LINEAR_ROWS_VSUM",DET_LINEAR_ROWS_VSUM; "DET_LINEAR_ROWS_VSUM_LEMMA",DET_LINEAR_ROWS_VSUM_LEMMA; "DET_LINEAR_ROW_VSUM",DET_LINEAR_ROW_VSUM; "DET_LOWERTRIANGULAR",DET_LOWERTRIANGULAR; "DET_MAPROWS_LINEAR",DET_MAPROWS_LINEAR; "DET_MATRIX_EQ_0",DET_MATRIX_EQ_0; "DET_MATRIX_EQ_0_LEFT",DET_MATRIX_EQ_0_LEFT; "DET_MATRIX_EQ_0_RIGHT",DET_MATRIX_EQ_0_RIGHT; "DET_MATRIX_INV",DET_MATRIX_INV; "DET_MATRIX_REFLECT_ALONG",DET_MATRIX_REFLECT_ALONG; "DET_MATRIX_ROTATE2D",DET_MATRIX_ROTATE2D; "DET_MUL",DET_MUL; "DET_NEG",DET_NEG; "DET_OPEN_MAP",DET_OPEN_MAP; "DET_ORDERED_SIMPLEX_EQ_0",DET_ORDERED_SIMPLEX_EQ_0; "DET_ORDERED_SIMPLEX_EQ_0_GEN",DET_ORDERED_SIMPLEX_EQ_0_GEN; "DET_ORDERED_SIMPLEX_NZ",DET_ORDERED_SIMPLEX_NZ; "DET_ORTHOGONAL_MATRIX",DET_ORTHOGONAL_MATRIX; "DET_PERMUTE_COLUMNS",DET_PERMUTE_COLUMNS; "DET_PERMUTE_ROWS",DET_PERMUTE_ROWS; "DET_POSITIVE_DEFINITE",DET_POSITIVE_DEFINITE; "DET_POSITIVE_SEMIDEFINITE",DET_POSITIVE_SEMIDEFINITE; "DET_ROWS_MUL",DET_ROWS_MUL; "DET_ROW_ADD",DET_ROW_ADD; "DET_ROW_MUL",DET_ROW_MUL; "DET_ROW_OPERATION",DET_ROW_OPERATION; "DET_ROW_SPAN",DET_ROW_SPAN; "DET_SIMILAR",DET_SIMILAR; "DET_TRANSP",DET_TRANSP; "DET_UPPERTRIANGULAR",DET_UPPERTRIANGULAR; "DET_ZERO_COLUMN",DET_ZERO_COLUMN; "DET_ZERO_ROW",DET_ZERO_ROW; "DE_MORGAN_THM",DE_MORGAN_THM; "DIAGONAL_MATRIX",DIAGONAL_MATRIX; "DIAGONAL_MATRIX_ADD",DIAGONAL_MATRIX_ADD; "DIAGONAL_MATRIX_CMUL",DIAGONAL_MATRIX_CMUL; "DIAGONAL_MATRIX_INV",DIAGONAL_MATRIX_INV; "DIAGONAL_MATRIX_INV_COMPONENT",DIAGONAL_MATRIX_INV_COMPONENT; "DIAGONAL_MATRIX_INV_EXPLICIT",DIAGONAL_MATRIX_INV_EXPLICIT; "DIAGONAL_MATRIX_MAT",DIAGONAL_MATRIX_MAT; "DIAGONAL_MATRIX_MUL",DIAGONAL_MATRIX_MUL; "DIAGONAL_MATRIX_MUL_COMPONENT",DIAGONAL_MATRIX_MUL_COMPONENT; "DIAGONAL_MATRIX_MUL_EQ",DIAGONAL_MATRIX_MUL_EQ; "DIAGONAL_MATRIX_MUL_EXPLICIT",DIAGONAL_MATRIX_MUL_EXPLICIT; "DIAGONAL_POSITIVE_DEFINITE",DIAGONAL_POSITIVE_DEFINITE; "DIAGONAL_POSITIVE_SEMIDEFINITE",DIAGONAL_POSITIVE_SEMIDEFINITE; "DIAMETERS_HAUSDIST_BOUND",DIAMETERS_HAUSDIST_BOUND; "DIAMETER_AFFINITY",DIAMETER_AFFINITY; "DIAMETER_ATTAINED_FRONTIER",DIAMETER_ATTAINED_FRONTIER; "DIAMETER_ATTAINED_RELATIVE_FRONTIER",DIAMETER_ATTAINED_RELATIVE_FRONTIER; "DIAMETER_BALL",DIAMETER_BALL; "DIAMETER_BOUNDED",DIAMETER_BOUNDED; "DIAMETER_BOUNDED_BOUND",DIAMETER_BOUNDED_BOUND; "DIAMETER_BOUNDED_BOUND_LT",DIAMETER_BOUNDED_BOUND_LT; "DIAMETER_CBALL",DIAMETER_CBALL; "DIAMETER_CLOSURE",DIAMETER_CLOSURE; "DIAMETER_COMPACT_ATTAINED",DIAMETER_COMPACT_ATTAINED; "DIAMETER_CONVEX_HULL",DIAMETER_CONVEX_HULL; "DIAMETER_EMPTY",DIAMETER_EMPTY; "DIAMETER_EQ_0",DIAMETER_EQ_0; "DIAMETER_FRONTIER",DIAMETER_FRONTIER; "DIAMETER_INTERVAL",DIAMETER_INTERVAL; "DIAMETER_LE",DIAMETER_LE; "DIAMETER_LE_SUMS_LEFT",DIAMETER_LE_SUMS_LEFT; "DIAMETER_LE_SUMS_RIGHT",DIAMETER_LE_SUMS_RIGHT; "DIAMETER_LINEAR_IMAGE",DIAMETER_LINEAR_IMAGE; "DIAMETER_LT_SUMS_LEFT",DIAMETER_LT_SUMS_LEFT; "DIAMETER_LT_SUMS_RIGHT",DIAMETER_LT_SUMS_RIGHT; "DIAMETER_POS_LE",DIAMETER_POS_LE; "DIAMETER_RELATIVE_FRONTIER",DIAMETER_RELATIVE_FRONTIER; "DIAMETER_SCALING",DIAMETER_SCALING; "DIAMETER_SEGMENT",DIAMETER_SEGMENT; "DIAMETER_SIMPLEX",DIAMETER_SIMPLEX; "DIAMETER_SING",DIAMETER_SING; "DIAMETER_SPHERE",DIAMETER_SPHERE; "DIAMETER_SUBSET",DIAMETER_SUBSET; "DIAMETER_SUBSET_CBALL",DIAMETER_SUBSET_CBALL; "DIAMETER_SUBSET_CBALL_NONEMPTY",DIAMETER_SUBSET_CBALL_NONEMPTY; "DIAMETER_SUMS",DIAMETER_SUMS; "DIAMETER_TRANSLATION",DIAMETER_TRANSLATION; "DIAMETER_UNION_LE",DIAMETER_UNION_LE; "DIFF",DIFF; "DIFFERENTIABLE_ADD",DIFFERENTIABLE_ADD; "DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON",DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; "DIFFERENTIABLE_AT_LIFT_DOT2",DIFFERENTIABLE_AT_LIFT_DOT2; "DIFFERENTIABLE_AT_WITHIN",DIFFERENTIABLE_AT_WITHIN; "DIFFERENTIABLE_BOUND",DIFFERENTIABLE_BOUND; "DIFFERENTIABLE_CHAIN_AT",DIFFERENTIABLE_CHAIN_AT; "DIFFERENTIABLE_CHAIN_WITHIN",DIFFERENTIABLE_CHAIN_WITHIN; "DIFFERENTIABLE_CMUL",DIFFERENTIABLE_CMUL; "DIFFERENTIABLE_COMPONENTWISE_AT",DIFFERENTIABLE_COMPONENTWISE_AT; "DIFFERENTIABLE_COMPONENTWISE_WITHIN",DIFFERENTIABLE_COMPONENTWISE_WITHIN; "DIFFERENTIABLE_CONST",DIFFERENTIABLE_CONST; "DIFFERENTIABLE_COUNTABLE_PREIMAGES",DIFFERENTIABLE_COUNTABLE_PREIMAGES; "DIFFERENTIABLE_DISCRETE_PREIMAGES",DIFFERENTIABLE_DISCRETE_PREIMAGES; "DIFFERENTIABLE_DISCRETE_PREIMAGES_CLOSED",DIFFERENTIABLE_DISCRETE_PREIMAGES_CLOSED; "DIFFERENTIABLE_FINITE_PREIMAGES",DIFFERENTIABLE_FINITE_PREIMAGES; "DIFFERENTIABLE_FINITE_PREIMAGES_GEN",DIFFERENTIABLE_FINITE_PREIMAGES_GEN; "DIFFERENTIABLE_ID",DIFFERENTIABLE_ID; "DIFFERENTIABLE_IMP_CONTINUOUS_AT",DIFFERENTIABLE_IMP_CONTINUOUS_AT; "DIFFERENTIABLE_IMP_CONTINUOUS_ON",DIFFERENTIABLE_IMP_CONTINUOUS_ON; "DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN",DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; "DIFFERENTIABLE_IMP_OPEN_MAP",DIFFERENTIABLE_IMP_OPEN_MAP; "DIFFERENTIABLE_IMP_OPEN_MAP_ALT",DIFFERENTIABLE_IMP_OPEN_MAP_ALT; "DIFFERENTIABLE_IMP_OPEN_MAP_GEN",DIFFERENTIABLE_IMP_OPEN_MAP_GEN; "DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE",DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE; "DIFFERENTIABLE_LIFT_COMPONENT",DIFFERENTIABLE_LIFT_COMPONENT; "DIFFERENTIABLE_LINEAR",DIFFERENTIABLE_LINEAR; "DIFFERENTIABLE_MUL_AT",DIFFERENTIABLE_MUL_AT; "DIFFERENTIABLE_MUL_WITHIN",DIFFERENTIABLE_MUL_WITHIN; "DIFFERENTIABLE_NEG",DIFFERENTIABLE_NEG; "DIFFERENTIABLE_NORM_AT",DIFFERENTIABLE_NORM_AT; "DIFFERENTIABLE_ON_ADD",DIFFERENTIABLE_ON_ADD; "DIFFERENTIABLE_ON_COMPOSE",DIFFERENTIABLE_ON_COMPOSE; "DIFFERENTIABLE_ON_CONST",DIFFERENTIABLE_ON_CONST; "DIFFERENTIABLE_ON_EMPTY",DIFFERENTIABLE_ON_EMPTY; "DIFFERENTIABLE_ON_EQ",DIFFERENTIABLE_ON_EQ; "DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT",DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; "DIFFERENTIABLE_ON_ID",DIFFERENTIABLE_ON_ID; "DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE",DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE; "DIFFERENTIABLE_ON_LIFT_DOT2",DIFFERENTIABLE_ON_LIFT_DOT2; "DIFFERENTIABLE_ON_LINEAR",DIFFERENTIABLE_ON_LINEAR; "DIFFERENTIABLE_ON_MUL",DIFFERENTIABLE_ON_MUL; "DIFFERENTIABLE_ON_NEG",DIFFERENTIABLE_ON_NEG; "DIFFERENTIABLE_ON_NORM",DIFFERENTIABLE_ON_NORM; "DIFFERENTIABLE_ON_REAL_POLYNOMIAL_FUNCTION",DIFFERENTIABLE_ON_REAL_POLYNOMIAL_FUNCTION; "DIFFERENTIABLE_ON_REFLECT",DIFFERENTIABLE_ON_REFLECT; "DIFFERENTIABLE_ON_SQNORM",DIFFERENTIABLE_ON_SQNORM; "DIFFERENTIABLE_ON_SUB",DIFFERENTIABLE_ON_SUB; "DIFFERENTIABLE_ON_SUBSET",DIFFERENTIABLE_ON_SUBSET; "DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION",DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION; "DIFFERENTIABLE_PIECEWISE_DIFFERENTIABLE_COMPOSE",DIFFERENTIABLE_PIECEWISE_DIFFERENTIABLE_COMPOSE; "DIFFERENTIABLE_REAL_COMPLEX",DIFFERENTIABLE_REAL_COMPLEX; "DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT",DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT; "DIFFERENTIABLE_SQNORM_AT",DIFFERENTIABLE_SQNORM_AT; "DIFFERENTIABLE_SUB",DIFFERENTIABLE_SUB; "DIFFERENTIABLE_TRANSFORM_AT",DIFFERENTIABLE_TRANSFORM_AT; "DIFFERENTIABLE_TRANSFORM_WITHIN",DIFFERENTIABLE_TRANSFORM_WITHIN; "DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION",DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION; "DIFFERENTIABLE_VSUM",DIFFERENTIABLE_VSUM; "DIFFERENTIABLE_VSUM_NUMSEG",DIFFERENTIABLE_VSUM_NUMSEG; "DIFFERENTIABLE_WITHIN_LIFT_DOT2",DIFFERENTIABLE_WITHIN_LIFT_DOT2; "DIFFERENTIABLE_WITHIN_OPEN",DIFFERENTIABLE_WITHIN_OPEN; "DIFFERENTIABLE_WITHIN_SUBSET",DIFFERENTIABLE_WITHIN_SUBSET; "DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM",DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM; "DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM",DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM; "DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN",DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN; "DIFFERENTIAL_ZERO_LEVELSET_DENSITY",DIFFERENTIAL_ZERO_LEVELSET_DENSITY; "DIFFERENTIAL_ZERO_MAXMIN",DIFFERENTIAL_ZERO_MAXMIN; "DIFFERENTIAL_ZERO_MAXMIN_COMPONENT",DIFFERENTIAL_ZERO_MAXMIN_COMPONENT; "DIFFERENTIAL_ZERO_MAXMIN_DENSITY",DIFFERENTIAL_ZERO_MAXMIN_DENSITY; "DIFFERENT_NORM_3_COLLINEAR_POINTS",DIFFERENT_NORM_3_COLLINEAR_POINTS; "DIFFS_AFFINE_HULL_SPAN",DIFFS_AFFINE_HULL_SPAN; "DIFF_CHAIN_AT",DIFF_CHAIN_AT; "DIFF_CHAIN_WITHIN",DIFF_CHAIN_WITHIN; "DIFF_CLOSURE_SUBSET",DIFF_CLOSURE_SUBSET; "DIFF_DIFF",DIFF_DIFF; "DIFF_EMPTY",DIFF_EMPTY; "DIFF_EQ_EMPTY",DIFF_EQ_EMPTY; "DIFF_INSERT",DIFF_INSERT; "DIFF_INTERS",DIFF_INTERS; "DIFF_UNIONS",DIFF_UNIONS; "DIFF_UNIONS_NONEMPTY",DIFF_UNIONS_NONEMPTY; "DIFF_UNIONS_PAIRWISE_DISJOINT",DIFF_UNIONS_PAIRWISE_DISJOINT; "DIFF_UNIV",DIFF_UNIV; "DIMENSION_ATMOST_RATIONAL_COORDINATES",DIMENSION_ATMOST_RATIONAL_COORDINATES; "DIMENSION_COMPLEMENT_RATIONAL_COORDINATES",DIMENSION_COMPLEMENT_RATIONAL_COORDINATES; "DIMENSION_DECOMPOSITION",DIMENSION_DECOMPOSITION; "DIMENSION_DELETE",DIMENSION_DELETE; "DIMENSION_DIMENSION_LE",DIMENSION_DIMENSION_LE; "DIMENSION_EMPTY",DIMENSION_EMPTY; "DIMENSION_EQ_AFF_DIM",DIMENSION_EQ_AFF_DIM; "DIMENSION_EQ_FULL",DIMENSION_EQ_FULL; "DIMENSION_EQ_FULL_ALT",DIMENSION_EQ_FULL_ALT; "DIMENSION_EQ_FULL_GEN",DIMENSION_EQ_FULL_GEN; "DIMENSION_EQ_LOCALLY_CLOPEN",DIMENSION_EQ_LOCALLY_CLOPEN; "DIMENSION_EQ_MINUS1",DIMENSION_EQ_MINUS1; "DIMENSION_EQ_ON_NBDS",DIMENSION_EQ_ON_NBDS; "DIMENSION_EQ_ON_OPEN_SUBSETS",DIMENSION_EQ_ON_OPEN_SUBSETS; "DIMENSION_EXACTLY_RATIONAL_COORDINATES",DIMENSION_EXACTLY_RATIONAL_COORDINATES; "DIMENSION_FRONTIER_BOUNDED_OPEN",DIMENSION_FRONTIER_BOUNDED_OPEN; "DIMENSION_FRONTIER_NONDENSE_OPEN",DIMENSION_FRONTIER_NONDENSE_OPEN; "DIMENSION_GE",DIMENSION_GE; "DIMENSION_INSERT",DIMENSION_INSERT; "DIMENSION_LE_AFF_DIM",DIMENSION_LE_AFF_DIM; "DIMENSION_LE_BOUND",DIMENSION_LE_BOUND; "DIMENSION_LE_CASES",DIMENSION_LE_CASES; "DIMENSION_LE_CLOSED_IN_UNIONS",DIMENSION_LE_CLOSED_IN_UNIONS; "DIMENSION_LE_DIMINDEX",DIMENSION_LE_DIMINDEX; "DIMENSION_LE_EQ",DIMENSION_LE_EQ; "DIMENSION_LE_EQ_ALT",DIMENSION_LE_EQ_ALT; "DIMENSION_LE_EQ_EMPTY",DIMENSION_LE_EQ_EMPTY; "DIMENSION_LE_EQ_GEN",DIMENSION_LE_EQ_GEN; "DIMENSION_LE_EQ_GENERAL",DIMENSION_LE_EQ_GENERAL; "DIMENSION_LE_EQ_LOCAL",DIMENSION_LE_EQ_LOCAL; "DIMENSION_LE_EQ_LOCALLY",DIMENSION_LE_EQ_LOCALLY; "DIMENSION_LE_EQ_SUBTOPOLOGY",DIMENSION_LE_EQ_SUBTOPOLOGY; "DIMENSION_LE_IMP_GE",DIMENSION_LE_IMP_GE; "DIMENSION_LE_INDUCT",DIMENSION_LE_INDUCT; "DIMENSION_LE_MINUS1",DIMENSION_LE_MINUS1; "DIMENSION_LE_MONO",DIMENSION_LE_MONO; "DIMENSION_LE_RATIONAL_COORDINATES",DIMENSION_LE_RATIONAL_COORDINATES; "DIMENSION_LE_RULES",DIMENSION_LE_RULES; "DIMENSION_LE_SUBTOPOLOGIES",DIMENSION_LE_SUBTOPOLOGIES; "DIMENSION_LE_SUBTOPOLOGY",DIMENSION_LE_SUBTOPOLOGY; "DIMENSION_LE_UNION",DIMENSION_LE_UNION; "DIMENSION_LE_UNIONS",DIMENSION_LE_UNIONS; "DIMENSION_LE_UNIONS_RELATIVE",DIMENSION_LE_UNIONS_RELATIVE; "DIMENSION_LE_UNIONS_ZERODIMENSIONAL",DIMENSION_LE_UNIONS_ZERODIMENSIONAL; "DIMENSION_LE_UNIONS_ZERODIMENSIONAL_EQ",DIMENSION_LE_UNIONS_ZERODIMENSIONAL_EQ; "DIMENSION_LE_UNION_CLOSED_IN",DIMENSION_LE_UNION_CLOSED_IN; "DIMENSION_LE_UNION_GEN",DIMENSION_LE_UNION_GEN; "DIMENSION_LE_UNION_RELATIVE",DIMENSION_LE_UNION_RELATIVE; "DIMENSION_LE_UNION_RELATIVE_GEN",DIMENSION_LE_UNION_RELATIVE_GEN; "DIMENSION_LINEAR_IMAGE",DIMENSION_LINEAR_IMAGE; "DIMENSION_LT_FULL",DIMENSION_LT_FULL; "DIMENSION_LT_FULL_ALT",DIMENSION_LT_FULL_ALT; "DIMENSION_LT_FULL_GEN",DIMENSION_LT_FULL_GEN; "DIMENSION_NONEMPTY_INTERIOR",DIMENSION_NONEMPTY_INTERIOR; "DIMENSION_OPEN",DIMENSION_OPEN; "DIMENSION_OPEN_IN_CONVEX",DIMENSION_OPEN_IN_CONVEX; "DIMENSION_PCROSS_EQ_0",DIMENSION_PCROSS_EQ_0; "DIMENSION_PCROSS_LE",DIMENSION_PCROSS_LE; "DIMENSION_POS_LE",DIMENSION_POS_LE; "DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN",DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN; "DIMENSION_RELATIVE_FRONTIER_CONVEX",DIMENSION_RELATIVE_FRONTIER_CONVEX; "DIMENSION_RELATIVE_FRONTIER_NONDENSE_OPEN",DIMENSION_RELATIVE_FRONTIER_NONDENSE_OPEN; "DIMENSION_SEPARATION_THEOREM",DIMENSION_SEPARATION_THEOREM; "DIMENSION_SING",DIMENSION_SING; "DIMENSION_SPHERE",DIMENSION_SPHERE; "DIMENSION_SPHERE_INTER_AFFINE",DIMENSION_SPHERE_INTER_AFFINE; "DIMENSION_SUBSET",DIMENSION_SUBSET; "DIMENSION_SUBSET_EXISTS",DIMENSION_SUBSET_EXISTS; "DIMENSION_SUBSPACE",DIMENSION_SUBSPACE; "DIMENSION_TRANSLATION",DIMENSION_TRANSLATION; "DIMENSION_UNION_LE_BASIC",DIMENSION_UNION_LE_BASIC; "DIMENSION_UNIV",DIMENSION_UNIV; "DIMENSION_ZERO_REDUCTION_THEOREM",DIMENSION_ZERO_REDUCTION_THEOREM; "DIMENSION_ZERO_REDUCTION_THEOREM_2",DIMENSION_ZERO_REDUCTION_THEOREM_2; "DIMENSION_ZERO_SEPARATION_THEOREM",DIMENSION_ZERO_SEPARATION_THEOREM; "DIMINDEX_1",DIMINDEX_1; "DIMINDEX_2",DIMINDEX_2; "DIMINDEX_3",DIMINDEX_3; "DIMINDEX_4",DIMINDEX_4; "DIMINDEX_FINITE_DIFF",DIMINDEX_FINITE_DIFF; "DIMINDEX_FINITE_IMAGE",DIMINDEX_FINITE_IMAGE; "DIMINDEX_FINITE_PROD",DIMINDEX_FINITE_PROD; "DIMINDEX_FINITE_SUM",DIMINDEX_FINITE_SUM; "DIMINDEX_GE_1",DIMINDEX_GE_1; "DIMINDEX_HAS_SIZE_FINITE_DIFF",DIMINDEX_HAS_SIZE_FINITE_DIFF; "DIMINDEX_HAS_SIZE_FINITE_PROD",DIMINDEX_HAS_SIZE_FINITE_PROD; "DIMINDEX_HAS_SIZE_FINITE_SUM",DIMINDEX_HAS_SIZE_FINITE_SUM; "DIMINDEX_MULTIVECTOR",DIMINDEX_MULTIVECTOR; "DIMINDEX_NONZERO",DIMINDEX_NONZERO; "DIMINDEX_UNIQUE",DIMINDEX_UNIQUE; "DIMINDEX_UNIV",DIMINDEX_UNIV; "DIM_BASIS_IMAGE",DIM_BASIS_IMAGE; "DIM_CLOSURE",DIM_CLOSURE; "DIM_CONIC_HULL",DIM_CONIC_HULL; "DIM_CONVEX_HULL",DIM_CONVEX_HULL; "DIM_DIMENSION",DIM_DIMENSION; "DIM_EMPTY",DIM_EMPTY; "DIM_EQ_0",DIM_EQ_0; "DIM_EQ_CARD",DIM_EQ_CARD; "DIM_EQ_FULL",DIM_EQ_FULL; "DIM_EQ_HYPERPLANE",DIM_EQ_HYPERPLANE; "DIM_EQ_SPAN",DIM_EQ_SPAN; "DIM_EQ_SUBSPACE",DIM_EQ_SUBSPACE; "DIM_EQ_SUBSPACES",DIM_EQ_SUBSPACES; "DIM_HYPERPLANE",DIM_HYPERPLANE; "DIM_IMAGE_KERNEL",DIM_IMAGE_KERNEL; "DIM_IMAGE_KERNEL_GEN",DIM_IMAGE_KERNEL_GEN; "DIM_IMAGE_SCALE",DIM_IMAGE_SCALE; "DIM_INJECTIVE_LINEAR_IMAGE",DIM_INJECTIVE_LINEAR_IMAGE; "DIM_INJECTIVE_ON_LINEAR_IMAGE",DIM_INJECTIVE_ON_LINEAR_IMAGE; "DIM_INSERT",DIM_INSERT; "DIM_INSERT_0",DIM_INSERT_0; "DIM_KERNEL_COMPOSE",DIM_KERNEL_COMPOSE; "DIM_LE_CARD",DIM_LE_CARD; "DIM_LINEAR_IMAGE_LE",DIM_LINEAR_IMAGE_LE; "DIM_NONEMPTY_INTERIOR",DIM_NONEMPTY_INTERIOR; "DIM_OPEN",DIM_OPEN; "DIM_OPEN_IN",DIM_OPEN_IN; "DIM_ORTHOGONAL_SUM",DIM_ORTHOGONAL_SUM; "DIM_PCROSS",DIM_PCROSS; "DIM_PCROSS_STRONG",DIM_PCROSS_STRONG; "DIM_PSUBSET",DIM_PSUBSET; "DIM_REAL",DIM_REAL; "DIM_ROWS_LE_DIM_COLUMNS",DIM_ROWS_LE_DIM_COLUMNS; "DIM_SING",DIM_SING; "DIM_SPAN",DIM_SPAN; "DIM_SPECIAL_HYPERPLANE",DIM_SPECIAL_HYPERPLANE; "DIM_SPECIAL_SUBSPACE",DIM_SPECIAL_SUBSPACE; "DIM_SUBSET",DIM_SUBSET; "DIM_SUBSET_UNIV",DIM_SUBSET_UNIV; "DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS",DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS; "DIM_SUBSTANDARD",DIM_SUBSTANDARD; "DIM_SUMS_INTER",DIM_SUMS_INTER; "DIM_UNION_INTER",DIM_UNION_INTER; "DIM_UNIQUE",DIM_UNIQUE; "DIM_UNIV",DIM_UNIV; "DINI",DINI; "DISCRETE_BOUNDED_IMP_FINITE",DISCRETE_BOUNDED_IMP_FINITE; "DISCRETE_EQ_FINITE_BOUNDED",DISCRETE_EQ_FINITE_BOUNDED; "DISCRETE_EQ_FINITE_BOUNDED_CLOSED",DISCRETE_EQ_FINITE_BOUNDED_CLOSED; "DISCRETE_EQ_FINITE_COMPACT",DISCRETE_EQ_FINITE_COMPACT; "DISCRETE_IMP_CLOSED",DISCRETE_IMP_CLOSED; "DISCRETE_IMP_COUNTABLE",DISCRETE_IMP_COUNTABLE; "DISCRETE_SET",DISCRETE_SET; "DISJOINT",DISJOINT; "DISJOINT_AFFINE_HULL",DISJOINT_AFFINE_HULL; "DISJOINT_DELETE_SYM",DISJOINT_DELETE_SYM; "DISJOINT_EMPTY",DISJOINT_EMPTY; "DISJOINT_EMPTY_REFL",DISJOINT_EMPTY_REFL; "DISJOINT_HALFSPACES_IMP_COLLINEAR",DISJOINT_HALFSPACES_IMP_COLLINEAR; "DISJOINT_HYPERPLANES_IMP_COLLINEAR",DISJOINT_HYPERPLANES_IMP_COLLINEAR; "DISJOINT_INSERT",DISJOINT_INSERT; "DISJOINT_INTERVAL",DISJOINT_INTERVAL; "DISJOINT_INTERVAL_1",DISJOINT_INTERVAL_1; "DISJOINT_MBALL",DISJOINT_MBALL; "DISJOINT_NUMSEG",DISJOINT_NUMSEG; "DISJOINT_RELATIVE_INTERIOR_CONVEX_HULL",DISJOINT_RELATIVE_INTERIOR_CONVEX_HULL; "DISJOINT_SYM",DISJOINT_SYM; "DISJOINT_UNION",DISJOINT_UNION; "DISJ_ACI",DISJ_ACI; "DISJ_ASSOC",DISJ_ASSOC; "DISJ_SYM",DISJ_SYM; "DISTANCE_ATTAINS_INF",DISTANCE_ATTAINS_INF; "DISTANCE_ATTAINS_SUP",DISTANCE_ATTAINS_SUP; "DIST_0",DIST_0; "DIST_1",DIST_1; "DIST_ADD2",DIST_ADD2; "DIST_ADD2_REV",DIST_ADD2_REV; "DIST_ADDBOUND",DIST_ADDBOUND; "DIST_CEXP_II_1",DIST_CEXP_II_1; "DIST_CLOSEST_POINT_LIPSCHITZ",DIST_CLOSEST_POINT_LIPSCHITZ; "DIST_CONVEX_HULL_BOUND_2",DIST_CONVEX_HULL_BOUND_2; "DIST_CONVEX_HULL_BOUND_EQ",DIST_CONVEX_HULL_BOUND_EQ; "DIST_CX",DIST_CX; "DIST_DECREASES_CLOSED_SEGMENT",DIST_DECREASES_CLOSED_SEGMENT; "DIST_DECREASES_OPEN_SEGMENT",DIST_DECREASES_OPEN_SEGMENT; "DIST_DESCALE",DIST_DESCALE; "DIST_ELIM_THM",DIST_ELIM_THM; "DIST_ENDPOINTS_LE_PATH_LENGTH",DIST_ENDPOINTS_LE_PATH_LENGTH; "DIST_EQ",DIST_EQ; "DIST_EQ_0",DIST_EQ_0; "DIST_FSTCART",DIST_FSTCART; "DIST_INCREASES_ONLINE",DIST_INCREASES_ONLINE; "DIST_IN_CLOSED_SEGMENT",DIST_IN_CLOSED_SEGMENT; "DIST_IN_CLOSED_SEGMENT_2",DIST_IN_CLOSED_SEGMENT_2; "DIST_IN_OPEN_SEGMENT",DIST_IN_OPEN_SEGMENT; "DIST_LADD",DIST_LADD; "DIST_LADD_0",DIST_LADD_0; "DIST_LE_0",DIST_LE_0; "DIST_LE_CASES",DIST_LE_CASES; "DIST_LE_DIAMETER",DIST_LE_DIAMETER; "DIST_LE_PASTECART",DIST_LE_PASTECART; "DIST_LIFT",DIST_LIFT; "DIST_LMUL",DIST_LMUL; "DIST_LZERO",DIST_LZERO; "DIST_MIDPOINT",DIST_MIDPOINT; "DIST_MUL",DIST_MUL; "DIST_NZ",DIST_NZ; "DIST_PASTECART_CANCEL",DIST_PASTECART_CANCEL; "DIST_PASTECART_LE",DIST_PASTECART_LE; "DIST_POINTS_LE_PATH_LENGTH",DIST_POINTS_LE_PATH_LENGTH; "DIST_POS_LE",DIST_POS_LE; "DIST_POS_LT",DIST_POS_LT; "DIST_RADD",DIST_RADD; "DIST_RADD_0",DIST_RADD_0; "DIST_REAL",DIST_REAL; "DIST_REFL",DIST_REFL; "DIST_RESCALE",DIST_RESCALE; "DIST_RMUL",DIST_RMUL; "DIST_RZERO",DIST_RZERO; "DIST_SNDCART",DIST_SNDCART; "DIST_SYM",DIST_SYM; "DIST_TRIANGLE",DIST_TRIANGLE; "DIST_TRIANGLES_LE",DIST_TRIANGLES_LE; "DIST_TRIANGLE_ADD",DIST_TRIANGLE_ADD; "DIST_TRIANGLE_ADD_HALF",DIST_TRIANGLE_ADD_HALF; "DIST_TRIANGLE_ALT",DIST_TRIANGLE_ALT; "DIST_TRIANGLE_EQ",DIST_TRIANGLE_EQ; "DIST_TRIANGLE_HALF_L",DIST_TRIANGLE_HALF_L; "DIST_TRIANGLE_HALF_R",DIST_TRIANGLE_HALF_R; "DIST_TRIANGLE_LE",DIST_TRIANGLE_LE; "DIST_TRIANGLE_LT",DIST_TRIANGLE_LT; "DIVIDES_LE",DIVIDES_LE; "DIVISION",DIVISION; "DIVISION_0",DIVISION_0; "DIVISION_1_SORT",DIVISION_1_SORT; "DIVISION_COMMON_POINT_BOUND",DIVISION_COMMON_POINT_BOUND; "DIVISION_CONTAINS",DIVISION_CONTAINS; "DIVISION_DISJOINT_UNION",DIVISION_DISJOINT_UNION; "DIVISION_DOUBLESPLIT",DIVISION_DOUBLESPLIT; "DIVISION_INTER",DIVISION_INTER; "DIVISION_INTER_1",DIVISION_INTER_1; "DIVISION_OF",DIVISION_OF; "DIVISION_OF_AFFINITY",DIVISION_OF_AFFINITY; "DIVISION_OF_CLOSED",DIVISION_OF_CLOSED; "DIVISION_OF_CONTENT_0",DIVISION_OF_CONTENT_0; "DIVISION_OF_FINITE",DIVISION_OF_FINITE; "DIVISION_OF_NONTRIVIAL",DIVISION_OF_NONTRIVIAL; "DIVISION_OF_REFLECT",DIVISION_OF_REFLECT; "DIVISION_OF_SELF",DIVISION_OF_SELF; "DIVISION_OF_SING",DIVISION_OF_SING; "DIVISION_OF_SUBSET",DIVISION_OF_SUBSET; "DIVISION_OF_TAGGED_DIVISION",DIVISION_OF_TAGGED_DIVISION; "DIVISION_OF_TRANSLATION",DIVISION_OF_TRANSLATION; "DIVISION_OF_TRIVIAL",DIVISION_OF_TRIVIAL; "DIVISION_OF_UNIONS",DIVISION_OF_UNIONS; "DIVISION_OF_UNION_SELF",DIVISION_OF_UNION_SELF; "DIVISION_POINTS_FINITE",DIVISION_POINTS_FINITE; "DIVISION_POINTS_PSUBSET",DIVISION_POINTS_PSUBSET; "DIVISION_POINTS_SUBSET",DIVISION_POINTS_SUBSET; "DIVISION_SIMP",DIVISION_SIMP; "DIVISION_SPLIT",DIVISION_SPLIT; "DIVISION_SPLIT_LEFT_INJ",DIVISION_SPLIT_LEFT_INJ; "DIVISION_SPLIT_RIGHT_INJ",DIVISION_SPLIT_RIGHT_INJ; "DIVISION_UNION_INTERVALS_EXISTS",DIVISION_UNION_INTERVALS_EXISTS; "DIVMOD_ELIM_THM",DIVMOD_ELIM_THM; "DIVMOD_ELIM_THM'",DIVMOD_ELIM_THM'; "DIVMOD_EXIST",DIVMOD_EXIST; "DIVMOD_EXIST_0",DIVMOD_EXIST_0; "DIVMOD_UNIQ",DIVMOD_UNIQ; "DIVMOD_UNIQ_LEMMA",DIVMOD_UNIQ_LEMMA; "DIV_0",DIV_0; "DIV_1",DIV_1; "DIV_ADD_MOD",DIV_ADD_MOD; "DIV_DIV",DIV_DIV; "DIV_EQ_0",DIV_EQ_0; "DIV_EQ_EXCLUSION",DIV_EQ_EXCLUSION; "DIV_LE",DIV_LE; "DIV_LE_EXCLUSION",DIV_LE_EXCLUSION; "DIV_LT",DIV_LT; "DIV_MOD",DIV_MOD; "DIV_MONO",DIV_MONO; "DIV_MONO2",DIV_MONO2; "DIV_MONO_LT",DIV_MONO_LT; "DIV_MULT",DIV_MULT; "DIV_MULT2",DIV_MULT2; "DIV_MULT_ADD",DIV_MULT_ADD; "DIV_MUL_LE",DIV_MUL_LE; "DIV_REFL",DIV_REFL; "DIV_UNIQ",DIV_UNIQ; "DOMINATED_CONVERGENCE",DOMINATED_CONVERGENCE; "DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE",DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE; "DOMINATED_CONVERGENCE_AE",DOMINATED_CONVERGENCE_AE; "DOMINATED_CONVERGENCE_INTEGRABLE",DOMINATED_CONVERGENCE_INTEGRABLE; "DOT_1",DOT_1; "DOT_2",DOT_2; "DOT_3",DOT_3; "DOT_4",DOT_4; "DOT_BASIS",DOT_BASIS; "DOT_BASIS_BASIS",DOT_BASIS_BASIS; "DOT_BASIS_BASIS_UNEQUAL",DOT_BASIS_BASIS_UNEQUAL; "DOT_CAUCHY_SCHWARZ_EQUAL",DOT_CAUCHY_SCHWARZ_EQUAL; "DOT_CNJ",DOT_CNJ; "DOT_COMPLEX_MUL_CNJ",DOT_COMPLEX_MUL_CNJ; "DOT_DROPOUT",DOT_DROPOUT; "DOT_EQ_0",DOT_EQ_0; "DOT_LADD",DOT_LADD; "DOT_LMUL",DOT_LMUL; "DOT_LMUL_MATRIX",DOT_LMUL_MATRIX; "DOT_LNEG",DOT_LNEG; "DOT_LSUB",DOT_LSUB; "DOT_LSUM",DOT_LSUM; "DOT_LZERO",DOT_LZERO; "DOT_MATRIX_PRODUCT",DOT_MATRIX_PRODUCT; "DOT_MATRIX_TRANSP_LMUL",DOT_MATRIX_TRANSP_LMUL; "DOT_MATRIX_TRANSP_RMUL",DOT_MATRIX_TRANSP_RMUL; "DOT_MATRIX_VECTOR_MUL",DOT_MATRIX_VECTOR_MUL; "DOT_NORM",DOT_NORM; "DOT_NORM_NEG",DOT_NORM_NEG; "DOT_NORM_SUB",DOT_NORM_SUB; "DOT_PASTECART",DOT_PASTECART; "DOT_POS_LE",DOT_POS_LE; "DOT_POS_LT",DOT_POS_LT; "DOT_PUSHIN",DOT_PUSHIN; "DOT_RADD",DOT_RADD; "DOT_RMUL",DOT_RMUL; "DOT_RNEG",DOT_RNEG; "DOT_ROWVECTOR_COLUMNVECTOR",DOT_ROWVECTOR_COLUMNVECTOR; "DOT_RSUB",DOT_RSUB; "DOT_RSUM",DOT_RSUM; "DOT_RZERO",DOT_RZERO; "DOT_SQUARE_NORM",DOT_SQUARE_NORM; "DOT_SYM",DOT_SYM; "DOUBLE_INTEGRABLE_CONVOLUTION",DOUBLE_INTEGRABLE_CONVOLUTION; "DOUBLE_INTEGRAL_CONVOLUTION",DOUBLE_INTEGRAL_CONVOLUTION; "DOUBLE_LEBESGUE_MEASURABLE",DOUBLE_LEBESGUE_MEASURABLE; "DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION",DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION; "DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION_GEN",DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION_GEN; "DOUBLE_LEBESGUE_MEASURABLE_LEFT_INVERSE",DOUBLE_LEBESGUE_MEASURABLE_LEFT_INVERSE; "DOUBLE_LEBESGUE_MEASURABLE_ON",DOUBLE_LEBESGUE_MEASURABLE_ON; "DOUBLE_LEBESGUE_MEASURABLE_RIGHT_INVERSE",DOUBLE_LEBESGUE_MEASURABLE_RIGHT_INVERSE; "DROPOUT_0",DROPOUT_0; "DROPOUT_ADD",DROPOUT_ADD; "DROPOUT_EQ",DROPOUT_EQ; "DROPOUT_GALOIS",DROPOUT_GALOIS; "DROPOUT_MUL",DROPOUT_MUL; "DROPOUT_PUSHIN",DROPOUT_PUSHIN; "DROPOUT_SUB",DROPOUT_SUB; "DROP_ADD",DROP_ADD; "DROP_BASIS",DROP_BASIS; "DROP_CMUL",DROP_CMUL; "DROP_DIFFERENTIAL_NEG_AT_MAXIMUM",DROP_DIFFERENTIAL_NEG_AT_MAXIMUM; "DROP_DIFFERENTIAL_POS_AT_MINIMUM",DROP_DIFFERENTIAL_POS_AT_MINIMUM; "DROP_EQ",DROP_EQ; "DROP_EQ_0",DROP_EQ_0; "DROP_INDICATOR",DROP_INDICATOR; "DROP_INDICATOR_ABS_LE_1",DROP_INDICATOR_ABS_LE_1; "DROP_INDICATOR_LE_1",DROP_INDICATOR_LE_1; "DROP_INDICATOR_POS_LE",DROP_INDICATOR_POS_LE; "DROP_IN_IMAGE_DROP",DROP_IN_IMAGE_DROP; "DROP_IN_REAL_INTERVAL",DROP_IN_REAL_INTERVAL; "DROP_LAMBDA",DROP_LAMBDA; "DROP_MIDPOINT",DROP_MIDPOINT; "DROP_NEG",DROP_NEG; "DROP_SUB",DROP_SUB; "DROP_VEC",DROP_VEC; "DROP_VSUM",DROP_VSUM; "DROP_WLOG_LE",DROP_WLOG_LE; "DSUM_BOUND",DSUM_BOUND; "DUGUNDJI",DUGUNDJI; "EDELSTEIN_FIX",EDELSTEIN_FIX; "EDELSTEIN_FIX_ITER",EDELSTEIN_FIX_ITER; "EDGE_OF_IMP_SUBSET",EDGE_OF_IMP_SUBSET; "EDGE_OF_LINEAR_IMAGE",EDGE_OF_LINEAR_IMAGE; "EDGE_OF_TRANSLATION_EQ",EDGE_OF_TRANSLATION_EQ; "EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS",EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS; "EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS",EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS; "EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS",EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS; "EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS",EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS; "EGOROV",EGOROV; "EIGENVALUES_CHARACTERISTIC",EIGENVALUES_CHARACTERISTIC; "EIGENVALUES_CHARACTERISTIC_ALT",EIGENVALUES_CHARACTERISTIC_ALT; "EIGENVALUE_LOWERBOUND_DOT",EIGENVALUE_LOWERBOUND_DOT; "EIGENVALUE_LOWERBOUND_DOT_EQ",EIGENVALUE_LOWERBOUND_DOT_EQ; "EL",EL; "ELEMENTARY_BOUNDED",ELEMENTARY_BOUNDED; "ELEMENTARY_COMPACT",ELEMENTARY_COMPACT; "ELEMENTARY_EMPTY",ELEMENTARY_EMPTY; "ELEMENTARY_INTER",ELEMENTARY_INTER; "ELEMENTARY_INTERS",ELEMENTARY_INTERS; "ELEMENTARY_INTERVAL",ELEMENTARY_INTERVAL; "ELEMENTARY_SUBSET_INTERVAL",ELEMENTARY_SUBSET_INTERVAL; "ELEMENTARY_UNION",ELEMENTARY_UNION; "ELEMENTARY_UNIONS_INTERVALS",ELEMENTARY_UNIONS_INTERVALS; "ELEMENTARY_UNION_INTERVAL",ELEMENTARY_UNION_INTERVAL; "ELEMENTARY_UNION_INTERVAL_STRONG",ELEMENTARY_UNION_INTERVAL_STRONG; "ELEMENT_LE_SUP",ELEMENT_LE_SUP; "EL_APPEND",EL_APPEND; "EL_CONS",EL_CONS; "EL_LIST_OF_SEQ",EL_LIST_OF_SEQ; "EL_MAP",EL_MAP; "EL_TL",EL_TL; "EMPTY",EMPTY; "EMPTY_AS_INTERVAL",EMPTY_AS_INTERVAL; "EMPTY_AS_REAL_INTERVAL",EMPTY_AS_REAL_INTERVAL; "EMPTY_DELETE",EMPTY_DELETE; "EMPTY_DIFF",EMPTY_DIFF; "EMPTY_DIVISION_OF",EMPTY_DIVISION_OF; "EMPTY_EXPOSED_FACE_OF",EMPTY_EXPOSED_FACE_OF; "EMPTY_FACE_OF",EMPTY_FACE_OF; "EMPTY_GSPEC",EMPTY_GSPEC; "EMPTY_IMP_COMPACT_IN",EMPTY_IMP_COMPACT_IN; "EMPTY_INSIDE_PSUBSET_CONVEX_FRONTIER",EMPTY_INSIDE_PSUBSET_CONVEX_FRONTIER; "EMPTY_INTERIOR_AFFINE_HULL",EMPTY_INTERIOR_AFFINE_HULL; "EMPTY_INTERIOR_AFF_DIM",EMPTY_INTERIOR_AFF_DIM; "EMPTY_INTERIOR_ALGEBRAIC_VARIETY",EMPTY_INTERIOR_ALGEBRAIC_VARIETY; "EMPTY_INTERIOR_CONVEX_HULL",EMPTY_INTERIOR_CONVEX_HULL; "EMPTY_INTERIOR_FINITE",EMPTY_INTERIOR_FINITE; "EMPTY_INTERIOR_LOWDIM",EMPTY_INTERIOR_LOWDIM; "EMPTY_INTERIOR_LOWDIM_GEN",EMPTY_INTERIOR_LOWDIM_GEN; "EMPTY_INTERIOR_LOWDIM_GEN_LE",EMPTY_INTERIOR_LOWDIM_GEN_LE; "EMPTY_INTERIOR_OF_AFF_DIM",EMPTY_INTERIOR_OF_AFF_DIM; "EMPTY_INTERIOR_SUBSET_HYPERPLANE",EMPTY_INTERIOR_SUBSET_HYPERPLANE; "EMPTY_NOT_UNIV",EMPTY_NOT_UNIV; "EMPTY_SUBSET",EMPTY_SUBSET; "EMPTY_UNION",EMPTY_UNION; "EMPTY_UNIONS",EMPTY_UNIONS; "ENDPOINTS_NOT_IN_INTERIOR_SIMPLE_PATH_IMAGE",ENDPOINTS_NOT_IN_INTERIOR_SIMPLE_PATH_IMAGE; "ENDPOINTS_SHIFTPATH",ENDPOINTS_SHIFTPATH; "ENDS_IN_INTERVAL",ENDS_IN_INTERVAL; "ENDS_IN_REAL_INTERVAL",ENDS_IN_REAL_INTERVAL; "ENDS_IN_REAL_SEGMENT",ENDS_IN_REAL_SEGMENT; "ENDS_IN_SEGMENT",ENDS_IN_SEGMENT; "ENDS_IN_UNIT_INTERVAL",ENDS_IN_UNIT_INTERVAL; "ENDS_NOT_IN_SEGMENT",ENDS_NOT_IN_SEGMENT; "ENR",ENR; "ENR_ANR",ENR_ANR; "ENR_BALL",ENR_BALL; "ENR_BOUNDED",ENR_BOUNDED; "ENR_CBALL",ENR_CBALL; "ENR_CLOSED_UNION",ENR_CLOSED_UNION; "ENR_CLOSED_UNION_LOCAL",ENR_CLOSED_UNION_LOCAL; "ENR_CLOSURE_FROM_FRONTIER",ENR_CLOSURE_FROM_FRONTIER; "ENR_COMPONENTWISE",ENR_COMPONENTWISE; "ENR_COMPONENT_ENR",ENR_COMPONENT_ENR; "ENR_CONNECTED_COMPONENT_ENR",ENR_CONNECTED_COMPONENT_ENR; "ENR_CONVEX_CLOSED",ENR_CONVEX_CLOSED; "ENR_COVERING_SPACE",ENR_COVERING_SPACE; "ENR_COVERING_SPACE_EQ",ENR_COVERING_SPACE_EQ; "ENR_DELETE",ENR_DELETE; "ENR_EMPTY",ENR_EMPTY; "ENR_FINITE_UNIONS_CONVEX_CLOSED",ENR_FINITE_UNIONS_CONVEX_CLOSED; "ENR_FROM_UNION_AND_INTER",ENR_FROM_UNION_AND_INTER; "ENR_FROM_UNION_AND_INTER_GEN",ENR_FROM_UNION_AND_INTER_GEN; "ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; "ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; "ENR_IMP_ANR",ENR_IMP_ANR; "ENR_IMP_FSGIMA",ENR_IMP_FSGIMA; "ENR_IMP_GDELTA",ENR_IMP_GDELTA; "ENR_IMP_LOCALLY_COMPACT",ENR_IMP_LOCALLY_COMPACT; "ENR_IMP_LOCALLY_CONNECTED",ENR_IMP_LOCALLY_CONNECTED; "ENR_IMP_LOCALLY_PATH_CONNECTED",ENR_IMP_LOCALLY_PATH_CONNECTED; "ENR_INSERT",ENR_INSERT; "ENR_INTERIOR",ENR_INTERIOR; "ENR_INTERVAL",ENR_INTERVAL; "ENR_INTER_CLOSED_OPEN",ENR_INTER_CLOSED_OPEN; "ENR_LINEAR_IMAGE_EQ",ENR_LINEAR_IMAGE_EQ; "ENR_LOCALLY",ENR_LOCALLY; "ENR_NEIGHBORHOOD_RETRACT",ENR_NEIGHBORHOOD_RETRACT; "ENR_OPEN_IN",ENR_OPEN_IN; "ENR_OPEN_UNION",ENR_OPEN_UNION; "ENR_OPEN_UNIONS",ENR_OPEN_UNIONS; "ENR_PATH_COMPONENT_ENR",ENR_PATH_COMPONENT_ENR; "ENR_PATH_IMAGE_SIMPLE_PATH",ENR_PATH_IMAGE_SIMPLE_PATH; "ENR_PCROSS",ENR_PCROSS; "ENR_PCROSS_EQ",ENR_PCROSS_EQ; "ENR_RELATIVE_FRONTIER_CONVEX",ENR_RELATIVE_FRONTIER_CONVEX; "ENR_RELATIVE_INTERIOR",ENR_RELATIVE_INTERIOR; "ENR_RETRACT_OF_ENR",ENR_RETRACT_OF_ENR; "ENR_SIMPLICIAL_COMPLEX",ENR_SIMPLICIAL_COMPLEX; "ENR_SING",ENR_SING; "ENR_SPHERE",ENR_SPHERE; "ENR_TRANSLATION",ENR_TRANSLATION; "ENR_TRIANGULATION",ENR_TRIANGULATION; "ENR_UNIV",ENR_UNIV; "EPSILON_DELTA_MINIMAL",EPSILON_DELTA_MINIMAL; "EQUIINTEGRABLE_ADD",EQUIINTEGRABLE_ADD; "EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS; "EQUIINTEGRABLE_CMUL",EQUIINTEGRABLE_CMUL; "EQUIINTEGRABLE_DIVISION",EQUIINTEGRABLE_DIVISION; "EQUIINTEGRABLE_EQ",EQUIINTEGRABLE_EQ; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT; "EQUIINTEGRABLE_LIMIT",EQUIINTEGRABLE_LIMIT; "EQUIINTEGRABLE_NEG",EQUIINTEGRABLE_NEG; "EQUIINTEGRABLE_ON_NULL",EQUIINTEGRABLE_ON_NULL; "EQUIINTEGRABLE_ON_SING",EQUIINTEGRABLE_ON_SING; "EQUIINTEGRABLE_ON_SPLIT",EQUIINTEGRABLE_ON_SPLIT; "EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS; "EQUIINTEGRABLE_REFLECT",EQUIINTEGRABLE_REFLECT; "EQUIINTEGRABLE_SUB",EQUIINTEGRABLE_SUB; "EQUIINTEGRABLE_SUBSET",EQUIINTEGRABLE_SUBSET; "EQUIINTEGRABLE_SUM",EQUIINTEGRABLE_SUM; "EQUIINTEGRABLE_UNIFORM_LIMIT",EQUIINTEGRABLE_UNIFORM_LIMIT; "EQUIINTEGRABLE_UNION",EQUIINTEGRABLE_UNION; "EQ_ADD_LCANCEL",EQ_ADD_LCANCEL; "EQ_ADD_LCANCEL_0",EQ_ADD_LCANCEL_0; "EQ_ADD_RCANCEL",EQ_ADD_RCANCEL; "EQ_ADD_RCANCEL_0",EQ_ADD_RCANCEL_0; "EQ_BALLS",EQ_BALLS; "EQ_C",EQ_C; "EQ_CLAUSES",EQ_CLAUSES; "EQ_C_BIJECTIONS",EQ_C_BIJECTIONS; "EQ_EXP",EQ_EXP; "EQ_EXT",EQ_EXT; "EQ_IMP",EQ_IMP; "EQ_IMP_LE",EQ_IMP_LE; "EQ_INTERVAL",EQ_INTERVAL; "EQ_INTERVAL_1",EQ_INTERVAL_1; "EQ_MULT_LCANCEL",EQ_MULT_LCANCEL; "EQ_MULT_RCANCEL",EQ_MULT_RCANCEL; "EQ_REFL",EQ_REFL; "EQ_SPAN_INSERT_EQ",EQ_SPAN_INSERT_EQ; "EQ_SUMS_LCANCEL",EQ_SUMS_LCANCEL; "EQ_SUMS_RCANCEL",EQ_SUMS_RCANCEL; "EQ_SYM",EQ_SYM; "EQ_SYM_EQ",EQ_SYM_EQ; "EQ_TRANS",EQ_TRANS; "EQ_UNIV",EQ_UNIV; "ETA_AX",ETA_AX; "EUCLIDEAN_CLOSURE_OF",EUCLIDEAN_CLOSURE_OF; "EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF",EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF; "EUCLIDEAN_FRONTIER_OF",EUCLIDEAN_FRONTIER_OF; "EUCLIDEAN_INTERIOR_OF",EUCLIDEAN_INTERIOR_OF; "EUCLIDEAN_METRIC",EUCLIDEAN_METRIC; "EUCLIDEAN_SPACE_INFINITE",EUCLIDEAN_SPACE_INFINITE; "EULER",EULER; "EULER_ROTATION_THEOREM",EULER_ROTATION_THEOREM; "EULER_ROTATION_THEOREM_GEN",EULER_ROTATION_THEOREM_GEN; "EULER_ROTOINVERSION_THEOREM",EULER_ROTOINVERSION_THEOREM; "EVEN",EVEN; "EVENPERM_COMPOSE",EVENPERM_COMPOSE; "EVENPERM_I",EVENPERM_I; "EVENPERM_INVERSE",EVENPERM_INVERSE; "EVENPERM_SWAP",EVENPERM_SWAP; "EVENPERM_UNIQUE",EVENPERM_UNIQUE; "EVENTUALLY_AND",EVENTUALLY_AND; "EVENTUALLY_AT",EVENTUALLY_AT; "EVENTUALLY_ATREAL",EVENTUALLY_ATREAL; "EVENTUALLY_AT_INFINITY",EVENTUALLY_AT_INFINITY; "EVENTUALLY_AT_INFINITY_POS",EVENTUALLY_AT_INFINITY_POS; "EVENTUALLY_AT_INFINITY_WITHIN",EVENTUALLY_AT_INFINITY_WITHIN; "EVENTUALLY_AT_NEGINFINITY",EVENTUALLY_AT_NEGINFINITY; "EVENTUALLY_AT_POSINFINITY",EVENTUALLY_AT_POSINFINITY; "EVENTUALLY_AT_REFLECT",EVENTUALLY_AT_REFLECT; "EVENTUALLY_AT_TOPOLOGICAL",EVENTUALLY_AT_TOPOLOGICAL; "EVENTUALLY_AT_WITHIN",EVENTUALLY_AT_WITHIN; "EVENTUALLY_AT_ZERO",EVENTUALLY_AT_ZERO; "EVENTUALLY_FALSE",EVENTUALLY_FALSE; "EVENTUALLY_FORALL",EVENTUALLY_FORALL; "EVENTUALLY_HAPPENS",EVENTUALLY_HAPPENS; "EVENTUALLY_HAPPENS_AT",EVENTUALLY_HAPPENS_AT; "EVENTUALLY_IN_OPEN",EVENTUALLY_IN_OPEN; "EVENTUALLY_IN_SEQUENTIALLY",EVENTUALLY_IN_SEQUENTIALLY; "EVENTUALLY_MONO",EVENTUALLY_MONO; "EVENTUALLY_MP",EVENTUALLY_MP; "EVENTUALLY_NO_SUBSEQUENCE",EVENTUALLY_NO_SUBSEQUENCE; "EVENTUALLY_SCALABLE_PROPERTY",EVENTUALLY_SCALABLE_PROPERTY; "EVENTUALLY_SCALABLE_PROPERTY_EQ",EVENTUALLY_SCALABLE_PROPERTY_EQ; "EVENTUALLY_SEQUENTIALLY",EVENTUALLY_SEQUENTIALLY; "EVENTUALLY_SUBSEQUENCE",EVENTUALLY_SUBSEQUENCE; "EVENTUALLY_TRUE",EVENTUALLY_TRUE; "EVENTUALLY_WITHIN",EVENTUALLY_WITHIN; "EVENTUALLY_WITHINREAL",EVENTUALLY_WITHINREAL; "EVENTUALLY_WITHINREAL_LE",EVENTUALLY_WITHINREAL_LE; "EVENTUALLY_WITHIN_DELETE",EVENTUALLY_WITHIN_DELETE; "EVENTUALLY_WITHIN_IMP",EVENTUALLY_WITHIN_IMP; "EVENTUALLY_WITHIN_INTERIOR",EVENTUALLY_WITHIN_INTERIOR; "EVENTUALLY_WITHIN_INTERIOR_INTER",EVENTUALLY_WITHIN_INTERIOR_INTER; "EVENTUALLY_WITHIN_INTERIOR_LOCAL",EVENTUALLY_WITHIN_INTERIOR_LOCAL; "EVENTUALLY_WITHIN_INTER_IMP",EVENTUALLY_WITHIN_INTER_IMP; "EVENTUALLY_WITHIN_LE",EVENTUALLY_WITHIN_LE; "EVENTUALLY_WITHIN_OPEN",EVENTUALLY_WITHIN_OPEN; "EVENTUALLY_WITHIN_OPEN_IN",EVENTUALLY_WITHIN_OPEN_IN; "EVENTUALLY_WITHIN_REFLECT",EVENTUALLY_WITHIN_REFLECT; "EVENTUALLY_WITHIN_TOPOLOGICAL",EVENTUALLY_WITHIN_TOPOLOGICAL; "EVENTUALLY_WITHIN_ZERO",EVENTUALLY_WITHIN_ZERO; "EVEN_ADD",EVEN_ADD; "EVEN_AND_ODD",EVEN_AND_ODD; "EVEN_DOUBLE",EVEN_DOUBLE; "EVEN_EXISTS",EVEN_EXISTS; "EVEN_EXISTS_LEMMA",EVEN_EXISTS_LEMMA; "EVEN_EXP",EVEN_EXP; "EVEN_MOD",EVEN_MOD; "EVEN_MULT",EVEN_MULT; "EVEN_NSUM",EVEN_NSUM; "EVEN_ODD_DECOMPOSITION",EVEN_ODD_DECOMPOSITION; "EVEN_OR_ODD",EVEN_OR_ODD; "EVEN_SUB",EVEN_SUB; "EX",EX; "EXCHANGE_LEMMA",EXCHANGE_LEMMA; "EXCLUDED_MIDDLE",EXCLUDED_MIDDLE; "EXISTS_ARC_PSUBSET_SIMPLE_PATH",EXISTS_ARC_PSUBSET_SIMPLE_PATH; "EXISTS_BOOL_THM",EXISTS_BOOL_THM; "EXISTS_CNJ",EXISTS_CNJ; "EXISTS_COMPLEX",EXISTS_COMPLEX; "EXISTS_COMPLEX'",EXISTS_COMPLEX'; "EXISTS_COMPLEX_ROOT",EXISTS_COMPLEX_ROOT; "EXISTS_COMPONENT_SUPERSET",EXISTS_COMPONENT_SUPERSET; "EXISTS_COUNTABLE_SUBSET_IMAGE",EXISTS_COUNTABLE_SUBSET_IMAGE; "EXISTS_COUNTABLE_SUBSET_IMAGE_INJ",EXISTS_COUNTABLE_SUBSET_IMAGE_INJ; "EXISTS_CURRY",EXISTS_CURRY; "EXISTS_DEF",EXISTS_DEF; "EXISTS_DIFF",EXISTS_DIFF; "EXISTS_DOUBLE_ARC",EXISTS_DOUBLE_ARC; "EXISTS_DOUBLE_ARC_EXPLICIT",EXISTS_DOUBLE_ARC_EXPLICIT; "EXISTS_DROP",EXISTS_DROP; "EXISTS_DROP_FUN",EXISTS_DROP_FUN; "EXISTS_DROP_IMAGE",EXISTS_DROP_IMAGE; "EXISTS_EX",EXISTS_EX; "EXISTS_FINITE_SUBSET_IMAGE",EXISTS_FINITE_SUBSET_IMAGE; "EXISTS_FINITE_SUBSET_IMAGE_INJ",EXISTS_FINITE_SUBSET_IMAGE_INJ; "EXISTS_IN_CLAUSES",EXISTS_IN_CLAUSES; "EXISTS_IN_CROSS",EXISTS_IN_CROSS; "EXISTS_IN_GSPEC",EXISTS_IN_GSPEC; "EXISTS_IN_IMAGE",EXISTS_IN_IMAGE; "EXISTS_IN_INSERT",EXISTS_IN_INSERT; "EXISTS_IN_PCROSS",EXISTS_IN_PCROSS; "EXISTS_IN_UNION",EXISTS_IN_UNION; "EXISTS_IN_UNIONS",EXISTS_IN_UNIONS; "EXISTS_LIFT",EXISTS_LIFT; "EXISTS_LIFT_FUN",EXISTS_LIFT_FUN; "EXISTS_LIFT_IMAGE",EXISTS_LIFT_IMAGE; "EXISTS_NOT_THM",EXISTS_NOT_THM; "EXISTS_ONE_REP",EXISTS_ONE_REP; "EXISTS_OPTION",EXISTS_OPTION; "EXISTS_OR_THM",EXISTS_OR_THM; "EXISTS_PAIRED_THM",EXISTS_PAIRED_THM; "EXISTS_PAIR_THM",EXISTS_PAIR_THM; "EXISTS_PASTECART",EXISTS_PASTECART; "EXISTS_PATH_SUBPATH_TO_FRONTIER",EXISTS_PATH_SUBPATH_TO_FRONTIER; "EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED",EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED; "EXISTS_REAL",EXISTS_REAL; "EXISTS_REFL",EXISTS_REFL; "EXISTS_SIMP",EXISTS_SIMP; "EXISTS_SUBARC_OF_ARC_NOENDS",EXISTS_SUBARC_OF_ARC_NOENDS; "EXISTS_SUBPATH_OF_ARC_NOENDS",EXISTS_SUBPATH_OF_ARC_NOENDS; "EXISTS_SUBPATH_OF_PATH",EXISTS_SUBPATH_OF_PATH; "EXISTS_SUBSET_IMAGE",EXISTS_SUBSET_IMAGE; "EXISTS_SUBSET_IMAGE_INJ",EXISTS_SUBSET_IMAGE_INJ; "EXISTS_SUBSET_INSERT",EXISTS_SUBSET_INSERT; "EXISTS_SUBSET_UNION",EXISTS_SUBSET_UNION; "EXISTS_SUM_THM",EXISTS_SUM_THM; "EXISTS_SWAP",EXISTS_SWAP; "EXISTS_THM",EXISTS_THM; "EXISTS_TRIPLED_THM",EXISTS_TRIPLED_THM; "EXISTS_UNCURRY",EXISTS_UNCURRY; "EXISTS_UNIQUE",EXISTS_UNIQUE; "EXISTS_UNIQUE_ALT",EXISTS_UNIQUE_ALT; "EXISTS_UNIQUE_DEF",EXISTS_UNIQUE_DEF; "EXISTS_UNIQUE_REFL",EXISTS_UNIQUE_REFL; "EXISTS_UNIQUE_THM",EXISTS_UNIQUE_THM; "EXISTS_UNPAIR_THM",EXISTS_UNPAIR_THM; "EXISTS_VECTOR_1",EXISTS_VECTOR_1; "EXISTS_VECTOR_2",EXISTS_VECTOR_2; "EXISTS_VECTOR_3",EXISTS_VECTOR_3; "EXISTS_VECTOR_4",EXISTS_VECTOR_4; "EXP",EXP; "EXPAND_CLOSED_OPEN_INTERVAL",EXPAND_CLOSED_OPEN_INTERVAL; "EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL; "EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL; "EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL; "EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL; "EXPOSED_FACET_OF",EXPOSED_FACET_OF; "EXPOSED_FACE_OF",EXPOSED_FACE_OF; "EXPOSED_FACE_OF_IMP_FACE_OF",EXPOSED_FACE_OF_IMP_FACE_OF; "EXPOSED_FACE_OF_INTER",EXPOSED_FACE_OF_INTER; "EXPOSED_FACE_OF_INTERS",EXPOSED_FACE_OF_INTERS; "EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; "EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; "EXPOSED_FACE_OF_LINEAR_IMAGE",EXPOSED_FACE_OF_LINEAR_IMAGE; "EXPOSED_FACE_OF_PARALLEL",EXPOSED_FACE_OF_PARALLEL; "EXPOSED_FACE_OF_POLYHEDRON",EXPOSED_FACE_OF_POLYHEDRON; "EXPOSED_FACE_OF_REFL",EXPOSED_FACE_OF_REFL; "EXPOSED_FACE_OF_REFL_EQ",EXPOSED_FACE_OF_REFL_EQ; "EXPOSED_FACE_OF_SUMS",EXPOSED_FACE_OF_SUMS; "EXPOSED_FACE_OF_TRANSLATION_EQ",EXPOSED_FACE_OF_TRANSLATION_EQ; "EXPOSED_POINT_OF_FURTHEST_POINT",EXPOSED_POINT_OF_FURTHEST_POINT; "EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; "EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; "EXP_1",EXP_1; "EXP_2",EXP_2; "EXP_ADD",EXP_ADD; "EXP_EQ_0",EXP_EQ_0; "EXP_EQ_1",EXP_EQ_1; "EXP_LIMIT",EXP_LIMIT; "EXP_LOG",EXP_LOG; "EXP_LT_0",EXP_LT_0; "EXP_MONO_EQ",EXP_MONO_EQ; "EXP_MONO_LE",EXP_MONO_LE; "EXP_MONO_LE_IMP",EXP_MONO_LE_IMP; "EXP_MONO_LT",EXP_MONO_LT; "EXP_MONO_LT_IMP",EXP_MONO_LT_IMP; "EXP_MULT",EXP_MULT; "EXP_ONE",EXP_ONE; "EXP_ZERO",EXP_ZERO; "EXTEND_FL",EXTEND_FL; "EXTEND_INSEG",EXTEND_INSEG; "EXTEND_LINSEG",EXTEND_LINSEG; "EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE",EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE; "EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN",EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN; "EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE",EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE; "EXTEND_MAP_CELL_COMPLEX_TO_SPHERE",EXTEND_MAP_CELL_COMPLEX_TO_SPHERE; "EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE",EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE; "EXTEND_MAP_SPHERE_TO_SPHERE",EXTEND_MAP_SPHERE_TO_SPHERE; "EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE",EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE; "EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN",EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN; "EXTEND_MAP_SPHERE_TO_SPHERE_GEN",EXTEND_MAP_SPHERE_TO_SPHERE_GEN; "EXTEND_MAP_UNIV_TO_SPHERE_COFINITE",EXTEND_MAP_UNIV_TO_SPHERE_COFINITE; "EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT",EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT; "EXTEND_TO_AFFINE_BASIS",EXTEND_TO_AFFINE_BASIS; "EXTENSION",EXTENSION; "EXTENSIONAL",EXTENSIONAL; "EXTENSIONAL_EMPTY",EXTENSIONAL_EMPTY; "EXTENSIONAL_EQ",EXTENSIONAL_EQ; "EXTENSION_FROM_CLOPEN",EXTENSION_FROM_CLOPEN; "EXTENSION_FROM_COMPONENT",EXTENSION_FROM_COMPONENT; "EXTENSION_INTO_AR",EXTENSION_INTO_AR; "EXTENSION_INTO_AR_LOCAL",EXTENSION_INTO_AR_LOCAL; "EXTREME_POINTS_OF_CONVEX_HULL",EXTREME_POINTS_OF_CONVEX_HULL; "EXTREME_POINTS_OF_CONVEX_HULL_AFFINE_INDEPENDENT",EXTREME_POINTS_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "EXTREME_POINTS_OF_CONVEX_HULL_EQ",EXTREME_POINTS_OF_CONVEX_HULL_EQ; "EXTREME_POINTS_OF_LINEAR_IMAGE",EXTREME_POINTS_OF_LINEAR_IMAGE; "EXTREME_POINTS_OF_STILLCONVEX",EXTREME_POINTS_OF_STILLCONVEX; "EXTREME_POINTS_OF_TRANSLATION",EXTREME_POINTS_OF_TRANSLATION; "EXTREME_POINT_EXISTS_CONVEX",EXTREME_POINT_EXISTS_CONVEX; "EXTREME_POINT_IN_FRONTIER",EXTREME_POINT_IN_FRONTIER; "EXTREME_POINT_IN_RELATIVE_FRONTIER",EXTREME_POINT_IN_RELATIVE_FRONTIER; "EXTREME_POINT_NOT_IN_INTERIOR",EXTREME_POINT_NOT_IN_INTERIOR; "EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR",EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR; "EXTREME_POINT_OF_CBALL",EXTREME_POINT_OF_CBALL; "EXTREME_POINT_OF_CONIC",EXTREME_POINT_OF_CONIC; "EXTREME_POINT_OF_CONIC_HULL",EXTREME_POINT_OF_CONIC_HULL; "EXTREME_POINT_OF_CONVEX_HULL",EXTREME_POINT_OF_CONVEX_HULL; "EXTREME_POINT_OF_CONVEX_HULL_2",EXTREME_POINT_OF_CONVEX_HULL_2; "EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT; "EXTREME_POINT_OF_CONVEX_HULL_EQ",EXTREME_POINT_OF_CONVEX_HULL_EQ; "EXTREME_POINT_OF_CONVEX_HULL_INSERT",EXTREME_POINT_OF_CONVEX_HULL_INSERT; "EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ",EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ; "EXTREME_POINT_OF_EMPTY",EXTREME_POINT_OF_EMPTY; "EXTREME_POINT_OF_FACE",EXTREME_POINT_OF_FACE; "EXTREME_POINT_OF_INTER",EXTREME_POINT_OF_INTER; "EXTREME_POINT_OF_INTER_GEN",EXTREME_POINT_OF_INTER_GEN; "EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; "EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; "EXTREME_POINT_OF_LINEAR_IMAGE",EXTREME_POINT_OF_LINEAR_IMAGE; "EXTREME_POINT_OF_MIDPOINT",EXTREME_POINT_OF_MIDPOINT; "EXTREME_POINT_OF_SEGMENT",EXTREME_POINT_OF_SEGMENT; "EXTREME_POINT_OF_SING",EXTREME_POINT_OF_SING; "EXTREME_POINT_OF_STILLCONVEX",EXTREME_POINT_OF_STILLCONVEX; "EXTREME_POINT_OF_STILLCONVEX_IMP",EXTREME_POINT_OF_STILLCONVEX_IMP; "EXTREME_POINT_OF_TRANSLATION_EQ",EXTREME_POINT_OF_TRANSLATION_EQ; "EXTREME_POINT_RELATIVE_FRONTIER",EXTREME_POINT_RELATIVE_FRONTIER; "EX_IMP",EX_IMP; "EX_MAP",EX_MAP; "EX_MEM",EX_MEM; "E_APPROX_32",E_APPROX_32; "FACES_OF_LINEAR_IMAGE",FACES_OF_LINEAR_IMAGE; "FACES_OF_SIMPLEX",FACES_OF_SIMPLEX; "FACES_OF_TRANSLATION",FACES_OF_TRANSLATION; "FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT",FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT; "FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT; "FACET_OF_EMPTY",FACET_OF_EMPTY; "FACET_OF_HALFSPACE_GE",FACET_OF_HALFSPACE_GE; "FACET_OF_HALFSPACE_LE",FACET_OF_HALFSPACE_LE; "FACET_OF_IMP_FACE_OF",FACET_OF_IMP_FACE_OF; "FACET_OF_IMP_PROPER",FACET_OF_IMP_PROPER; "FACET_OF_IMP_SUBSET",FACET_OF_IMP_SUBSET; "FACET_OF_LINEAR_IMAGE",FACET_OF_LINEAR_IMAGE; "FACET_OF_POLYHEDRON",FACET_OF_POLYHEDRON; "FACET_OF_POLYHEDRON_EXPLICIT",FACET_OF_POLYHEDRON_EXPLICIT; "FACET_OF_REFL",FACET_OF_REFL; "FACET_OF_TRANSLATION_EQ",FACET_OF_TRANSLATION_EQ; "FACE_OF_AFFINE_EQ",FACE_OF_AFFINE_EQ; "FACE_OF_AFFINE_TRIVIAL",FACE_OF_AFFINE_TRIVIAL; "FACE_OF_AFF_DIM_0",FACE_OF_AFF_DIM_0; "FACE_OF_AFF_DIM_LT",FACE_OF_AFF_DIM_LT; "FACE_OF_CONIC",FACE_OF_CONIC; "FACE_OF_CONIC_HULL",FACE_OF_CONIC_HULL; "FACE_OF_CONIC_HULL_EQ",FACE_OF_CONIC_HULL_EQ; "FACE_OF_CONIC_HULL_REV",FACE_OF_CONIC_HULL_REV; "FACE_OF_CONVEX_HULLS",FACE_OF_CONVEX_HULLS; "FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "FACE_OF_CONVEX_HULL_INSERT",FACE_OF_CONVEX_HULL_INSERT; "FACE_OF_CONVEX_HULL_INSERT_EQ",FACE_OF_CONVEX_HULL_INSERT_EQ; "FACE_OF_CONVEX_HULL_SUBSET",FACE_OF_CONVEX_HULL_SUBSET; "FACE_OF_DISJOINT_INTERIOR",FACE_OF_DISJOINT_INTERIOR; "FACE_OF_DISJOINT_RELATIVE_INTERIOR",FACE_OF_DISJOINT_RELATIVE_INTERIOR; "FACE_OF_EMPTY",FACE_OF_EMPTY; "FACE_OF_EQ",FACE_OF_EQ; "FACE_OF_FACE",FACE_OF_FACE; "FACE_OF_HALFSPACE_GE",FACE_OF_HALFSPACE_GE; "FACE_OF_HALFSPACE_LE",FACE_OF_HALFSPACE_LE; "FACE_OF_IMP_CLOSED",FACE_OF_IMP_CLOSED; "FACE_OF_IMP_COMPACT",FACE_OF_IMP_COMPACT; "FACE_OF_IMP_CONVEX",FACE_OF_IMP_CONVEX; "FACE_OF_IMP_SUBSET",FACE_OF_IMP_SUBSET; "FACE_OF_INTER",FACE_OF_INTER; "FACE_OF_INTERS",FACE_OF_INTERS; "FACE_OF_INTER_AS_INTER_OF_FACE",FACE_OF_INTER_AS_INTER_OF_FACE; "FACE_OF_INTER_INTER",FACE_OF_INTER_INTER; "FACE_OF_INTER_SUBFACE",FACE_OF_INTER_SUBFACE; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG; "FACE_OF_LINEAR_IMAGE",FACE_OF_LINEAR_IMAGE; "FACE_OF_PCROSS",FACE_OF_PCROSS; "FACE_OF_PCROSS_DECOMP",FACE_OF_PCROSS_DECOMP; "FACE_OF_PCROSS_EQ",FACE_OF_PCROSS_EQ; "FACE_OF_POLYHEDRON",FACE_OF_POLYHEDRON; "FACE_OF_POLYHEDRON_EXPLICIT",FACE_OF_POLYHEDRON_EXPLICIT; "FACE_OF_POLYHEDRON_FACE_OF_FACET",FACE_OF_POLYHEDRON_FACE_OF_FACET; "FACE_OF_POLYHEDRON_POLYHEDRON",FACE_OF_POLYHEDRON_POLYHEDRON; "FACE_OF_POLYHEDRON_SUBSET_EXPLICIT",FACE_OF_POLYHEDRON_SUBSET_EXPLICIT; "FACE_OF_POLYHEDRON_SUBSET_FACET",FACE_OF_POLYHEDRON_SUBSET_FACET; "FACE_OF_POLYTOPE_INSERT_EQ",FACE_OF_POLYTOPE_INSERT_EQ; "FACE_OF_POLYTOPE_POLYTOPE",FACE_OF_POLYTOPE_POLYTOPE; "FACE_OF_REFL",FACE_OF_REFL; "FACE_OF_REFL_EQ",FACE_OF_REFL_EQ; "FACE_OF_SIMPLEX_SUBSET",FACE_OF_SIMPLEX_SUBSET; "FACE_OF_SING",FACE_OF_SING; "FACE_OF_SLICE",FACE_OF_SLICE; "FACE_OF_STILLCONVEX",FACE_OF_STILLCONVEX; "FACE_OF_SUBSET",FACE_OF_SUBSET; "FACE_OF_SUBSET_FRONTIER_AFF_DIM",FACE_OF_SUBSET_FRONTIER_AFF_DIM; "FACE_OF_SUBSET_RELATIVE_BOUNDARY",FACE_OF_SUBSET_RELATIVE_BOUNDARY; "FACE_OF_SUBSET_RELATIVE_FRONTIER",FACE_OF_SUBSET_RELATIVE_FRONTIER; "FACE_OF_SUBSET_RELATIVE_FRONTIER_AFF_DIM",FACE_OF_SUBSET_RELATIVE_FRONTIER_AFF_DIM; "FACE_OF_TRANS",FACE_OF_TRANS; "FACE_OF_TRANSLATION_EQ",FACE_OF_TRANSLATION_EQ; "FACT",FACT; "FACTOR_CONTINUOUS_THROUGH_VARIATION",FACTOR_CONTINUOUS_THROUGH_VARIATION; "FACTOR_THROUGH_VARIATION",FACTOR_THROUGH_VARIATION; "FACT_LE",FACT_LE; "FACT_LT",FACT_LT; "FACT_MONO",FACT_MONO; "FACT_NZ",FACT_NZ; "FARKAS_LEMMA",FARKAS_LEMMA; "FARKAS_LEMMA_ALT",FARKAS_LEMMA_ALT; "FASHODA",FASHODA; "FASHODA_INTERLACE",FASHODA_INTERLACE; "FASHODA_UNIT",FASHODA_UNIT; "FASHODA_UNIT_PATH",FASHODA_UNIT_PATH; "FATOU",FATOU; "FATOU_STRONG",FATOU_STRONG; "FCCOVERABLE_IMP_LOCALLY_CONNECTED",FCCOVERABLE_IMP_LOCALLY_CONNECTED; "FCCOVERABLE_INTERMEDIATE_CLOSURE",FCCOVERABLE_INTERMEDIATE_CLOSURE; "FCONS",FCONS; "FCONS_UNDO",FCONS_UNDO; "FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT",FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT; "FILTER",FILTER; "FILTER_APPEND",FILTER_APPEND; "FILTER_MAP",FILTER_MAP; "FINE_DIVISION_EXISTS",FINE_DIVISION_EXISTS; "FINE_INTER",FINE_INTER; "FINE_INTERS",FINE_INTERS; "FINE_SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX",FINE_SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX; "FINE_SUBSET",FINE_SUBSET; "FINE_TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX",FINE_TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX; "FINE_UNION",FINE_UNION; "FINE_UNIONS",FINE_UNIONS; "FINITELY_GENERATED_CONIC_POLYHEDRON",FINITELY_GENERATED_CONIC_POLYHEDRON; "FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC",FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC; "FINITE_ANR_COMPONENTS",FINITE_ANR_COMPONENTS; "FINITE_BALL",FINITE_BALL; "FINITE_BITSET",FINITE_BITSET; "FINITE_BOOL",FINITE_BOOL; "FINITE_BOUNDED_FUNCTIONS",FINITE_BOUNDED_FUNCTIONS; "FINITE_CARD_COMPLEX_ROOTS_UNITY",FINITE_CARD_COMPLEX_ROOTS_UNITY; "FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT",FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT; "FINITE_CARD_LT",FINITE_CARD_LT; "FINITE_CART",FINITE_CART; "FINITE_CART_SUBSET_LEMMA",FINITE_CART_SUBSET_LEMMA; "FINITE_CART_UNIV",FINITE_CART_UNIV; "FINITE_CASES",FINITE_CASES; "FINITE_CBALL",FINITE_CBALL; "FINITE_CIRCLE_INTERSECTION",FINITE_CIRCLE_INTERSECTION; "FINITE_COLUMNS",FINITE_COLUMNS; "FINITE_COMPLEMENT_ANR_COMPONENTS",FINITE_COMPLEMENT_ANR_COMPONENTS; "FINITE_COMPLEMENT_ENR_COMPONENTS",FINITE_COMPLEMENT_ENR_COMPONENTS; "FINITE_COMPLEX_ROOTS_UNITY",FINITE_COMPLEX_ROOTS_UNITY; "FINITE_COMPONENTS",FINITE_COMPONENTS; "FINITE_COMPONENTS_COMPLEMENT_CONVEX",FINITE_COMPONENTS_COMPLEMENT_CONVEX; "FINITE_COMPONENTS_MEETING_COMPACT_SUBSET",FINITE_COMPONENTS_MEETING_COMPACT_SUBSET; "FINITE_COMPONENTS_UNION",FINITE_COMPONENTS_UNION; "FINITE_CROSS",FINITE_CROSS; "FINITE_CROSS_EQ",FINITE_CROSS_EQ; "FINITE_DELETE",FINITE_DELETE; "FINITE_DELETE_IMP",FINITE_DELETE_IMP; "FINITE_DIFF",FINITE_DIFF; "FINITE_DIFF_IMAGE",FINITE_DIFF_IMAGE; "FINITE_EIGENVALUES",FINITE_EIGENVALUES; "FINITE_EMPTY",FINITE_EMPTY; "FINITE_EMPTY_INTERIOR",FINITE_EMPTY_INTERIOR; "FINITE_ENR_COMPONENTS",FINITE_ENR_COMPONENTS; "FINITE_EQ_BOUNDED_DISCRETE",FINITE_EQ_BOUNDED_DISCRETE; "FINITE_FACES_OF_SIMPLEX",FINITE_FACES_OF_SIMPLEX; "FINITE_FINITE_IMAGE",FINITE_FINITE_IMAGE; "FINITE_FINITE_PREIMAGE",FINITE_FINITE_PREIMAGE; "FINITE_FINITE_PREIMAGE_GENERAL",FINITE_FINITE_PREIMAGE_GENERAL; "FINITE_FINITE_UNIONS",FINITE_FINITE_UNIONS; "FINITE_FL",FINITE_FL; "FINITE_FUNDAMENTAL_GROUP_IMP_BORSUKIAN",FINITE_FUNDAMENTAL_GROUP_IMP_BORSUKIAN; "FINITE_FUNSPACE",FINITE_FUNSPACE; "FINITE_FUNSPACE_UNIV",FINITE_FUNSPACE_UNIV; "FINITE_HAS_SIZE",FINITE_HAS_SIZE; "FINITE_IMAGE",FINITE_IMAGE; "FINITE_IMAGE_EXPAND",FINITE_IMAGE_EXPAND; "FINITE_IMAGE_IMAGE",FINITE_IMAGE_IMAGE; "FINITE_IMAGE_INJ",FINITE_IMAGE_INJ; "FINITE_IMAGE_INJ_EQ",FINITE_IMAGE_INJ_EQ; "FINITE_IMAGE_INJ_GENERAL",FINITE_IMAGE_INJ_GENERAL; "FINITE_IMP_ANR",FINITE_IMP_ANR; "FINITE_IMP_BOUNDED",FINITE_IMP_BOUNDED; "FINITE_IMP_BOUNDED_CONVEX_HULL",FINITE_IMP_BOUNDED_CONVEX_HULL; "FINITE_IMP_CLOSED",FINITE_IMP_CLOSED; "FINITE_IMP_CLOSED_IN",FINITE_IMP_CLOSED_IN; "FINITE_IMP_COMPACT",FINITE_IMP_COMPACT; "FINITE_IMP_COMPACT_CONVEX_HULL",FINITE_IMP_COMPACT_CONVEX_HULL; "FINITE_IMP_COMPACT_IN",FINITE_IMP_COMPACT_IN; "FINITE_IMP_COUNTABLE",FINITE_IMP_COUNTABLE; "FINITE_IMP_DIMENSION_LE_0",FINITE_IMP_DIMENSION_LE_0; "FINITE_IMP_ENR",FINITE_IMP_ENR; "FINITE_IMP_NOT_OPEN",FINITE_IMP_NOT_OPEN; "FINITE_IMP_TOTALLY_DISCONNECTED",FINITE_IMP_TOTALLY_DISCONNECTED; "FINITE_INDEX_INJ",FINITE_INDEX_INJ; "FINITE_INDEX_INRANGE",FINITE_INDEX_INRANGE; "FINITE_INDEX_INRANGE_2",FINITE_INDEX_INRANGE_2; "FINITE_INDEX_NUMBERS",FINITE_INDEX_NUMBERS; "FINITE_INDEX_NUMSEG",FINITE_INDEX_NUMSEG; "FINITE_INDEX_NUMSEG_SPECIAL",FINITE_INDEX_NUMSEG_SPECIAL; "FINITE_INDEX_WORKS",FINITE_INDEX_WORKS; "FINITE_INDUCT",FINITE_INDUCT; "FINITE_INDUCT_DELETE",FINITE_INDUCT_DELETE; "FINITE_INDUCT_STRONG",FINITE_INDUCT_STRONG; "FINITE_INSERT",FINITE_INSERT; "FINITE_INTER",FINITE_INTER; "FINITE_INTERVAL_1",FINITE_INTERVAL_1; "FINITE_INTER_COLLINEAR_OPEN_SEGMENTS",FINITE_INTER_COLLINEAR_OPEN_SEGMENTS; "FINITE_INTER_NUMSEG",FINITE_INTER_NUMSEG; "FINITE_INTSEG",FINITE_INTSEG; "FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS",FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS; "FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS",FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS; "FINITE_MULTIVECTOR",FINITE_MULTIVECTOR; "FINITE_NUMSEG",FINITE_NUMSEG; "FINITE_NUMSEG_LE",FINITE_NUMSEG_LE; "FINITE_NUMSEG_LT",FINITE_NUMSEG_LT; "FINITE_ORDER_FUNDAMENTAL_GROUP_IMP_BORSUKIAN",FINITE_ORDER_FUNDAMENTAL_GROUP_IMP_BORSUKIAN; "FINITE_PCROSS",FINITE_PCROSS; "FINITE_PCROSS_EQ",FINITE_PCROSS_EQ; "FINITE_PERMUTATIONS",FINITE_PERMUTATIONS; "FINITE_POLYHEDRON_EXPOSED_FACES",FINITE_POLYHEDRON_EXPOSED_FACES; "FINITE_POLYHEDRON_EXTREME_POINTS",FINITE_POLYHEDRON_EXTREME_POINTS; "FINITE_POLYHEDRON_FACES",FINITE_POLYHEDRON_FACES; "FINITE_POLYHEDRON_FACETS",FINITE_POLYHEDRON_FACETS; "FINITE_POLYTOPE_FACES",FINITE_POLYTOPE_FACES; "FINITE_POLYTOPE_FACETS",FINITE_POLYTOPE_FACETS; "FINITE_POWERSET",FINITE_POWERSET; "FINITE_PRODUCT",FINITE_PRODUCT; "FINITE_PRODUCT_DEPENDENT",FINITE_PRODUCT_DEPENDENT; "FINITE_PROD_IMAGE",FINITE_PROD_IMAGE; "FINITE_REAL_INTERVAL",FINITE_REAL_INTERVAL; "FINITE_RECURSION",FINITE_RECURSION; "FINITE_RECURSION_DELETE",FINITE_RECURSION_DELETE; "FINITE_RESTRICT",FINITE_RESTRICT; "FINITE_ROWS",FINITE_ROWS; "FINITE_RULES",FINITE_RULES; "FINITE_SEGMENT",FINITE_SEGMENT; "FINITE_SET_AS_MATRIX_ROWS",FINITE_SET_AS_MATRIX_ROWS; "FINITE_SET_AVOID",FINITE_SET_AVOID; "FINITE_SET_OF_LIST",FINITE_SET_OF_LIST; "FINITE_SING",FINITE_SING; "FINITE_SPHERE",FINITE_SPHERE; "FINITE_SPHERE_1",FINITE_SPHERE_1; "FINITE_STDBASIS",FINITE_STDBASIS; "FINITE_SUBSET",FINITE_SUBSET; "FINITE_SUBSET_IMAGE",FINITE_SUBSET_IMAGE; "FINITE_SUBSET_IMAGE_IMP",FINITE_SUBSET_IMAGE_IMP; "FINITE_SUBSET_NUMSEG",FINITE_SUBSET_NUMSEG; "FINITE_SUBSET_UNIONS",FINITE_SUBSET_UNIONS; "FINITE_SUBSET_UNIONS_CHAIN",FINITE_SUBSET_UNIONS_CHAIN; "FINITE_SUM_IMAGE",FINITE_SUM_IMAGE; "FINITE_SUPPORT",FINITE_SUPPORT; "FINITE_SUPPORT_DELTA",FINITE_SUPPORT_DELTA; "FINITE_TRANSITIVITY_CHAIN",FINITE_TRANSITIVITY_CHAIN; "FINITE_UNION",FINITE_UNION; "FINITE_UNIONS",FINITE_UNIONS; "FINITE_UNION_IMP",FINITE_UNION_IMP; "FINITE_UNIV_PAIR",FINITE_UNIV_PAIR; "FINREC",FINREC; "FINREC_1_LEMMA",FINREC_1_LEMMA; "FINREC_EXISTS_LEMMA",FINREC_EXISTS_LEMMA; "FINREC_FUN",FINREC_FUN; "FINREC_FUN_LEMMA",FINREC_FUN_LEMMA; "FINREC_SUC_LEMMA",FINREC_SUC_LEMMA; "FINREC_UNIQUE_LEMMA",FINREC_UNIQUE_LEMMA; "FIRST_CARTAN_THM_DIM_1",FIRST_CARTAN_THM_DIM_1; "FIXED_POINT_INESSENTIAL_SPHERE_MAP",FIXED_POINT_INESSENTIAL_SPHERE_MAP; "FIXING_SWAPSEQ_DECREASE",FIXING_SWAPSEQ_DECREASE; "FIXPOINT_HOMOTOPIC_IDENTITY_SPHERE",FIXPOINT_HOMOTOPIC_IDENTITY_SPHERE; "FIXPOINT_OR_NEG_MAPPING_SPHERE",FIXPOINT_OR_NEG_MAPPING_SPHERE; "FL",FL; "FLATTEN_LEMMA",FLATTEN_LEMMA; "FLOOR",FLOOR; "FLOOR_CONTINUOUS_MONOTONE_FLOOR",FLOOR_CONTINUOUS_MONOTONE_FLOOR; "FLOOR_DIV_DIV",FLOOR_DIV_DIV; "FLOOR_DOUBLE",FLOOR_DOUBLE; "FLOOR_EQ_0",FLOOR_EQ_0; "FLOOR_FRAC",FLOOR_FRAC; "FLOOR_MONO",FLOOR_MONO; "FLOOR_NUM",FLOOR_NUM; "FLOOR_POS",FLOOR_POS; "FLOOR_POS_LE",FLOOR_POS_LE; "FLOOR_UNIQUE",FLOOR_UNIQUE; "FL_RESTRICT",FL_RESTRICT; "FL_RESTRICTED_SUBSET",FL_RESTRICTED_SUBSET; "FL_SUBSET",FL_SUBSET; "FL_SUC",FL_SUC; "FNIL",FNIL; "FORALL_1",FORALL_1; "FORALL_2",FORALL_2; "FORALL_3",FORALL_3; "FORALL_4",FORALL_4; "FORALL_ALL",FORALL_ALL; "FORALL_AND_THM",FORALL_AND_THM; "FORALL_BOOL_THM",FORALL_BOOL_THM; "FORALL_CNJ",FORALL_CNJ; "FORALL_COMPLEX",FORALL_COMPLEX; "FORALL_COUNTABLE_AS_IMAGE",FORALL_COUNTABLE_AS_IMAGE; "FORALL_COUNTABLE_SUBSET_IMAGE",FORALL_COUNTABLE_SUBSET_IMAGE; "FORALL_COUNTABLE_SUBSET_IMAGE_INJ",FORALL_COUNTABLE_SUBSET_IMAGE_INJ; "FORALL_CURRY",FORALL_CURRY; "FORALL_DEF",FORALL_DEF; "FORALL_DIFF",FORALL_DIFF; "FORALL_DIMINDEX_1",FORALL_DIMINDEX_1; "FORALL_DOT_EQ_0",FORALL_DOT_EQ_0; "FORALL_DROP",FORALL_DROP; "FORALL_DROP_FUN",FORALL_DROP_FUN; "FORALL_DROP_IMAGE",FORALL_DROP_IMAGE; "FORALL_EVENTUALLY",FORALL_EVENTUALLY; "FORALL_FINITE_INDEX",FORALL_FINITE_INDEX; "FORALL_FINITE_SUBSET_IMAGE",FORALL_FINITE_SUBSET_IMAGE; "FORALL_FINITE_SUBSET_IMAGE_INJ",FORALL_FINITE_SUBSET_IMAGE_INJ; "FORALL_INTEGER",FORALL_INTEGER; "FORALL_IN_CLAUSES",FORALL_IN_CLAUSES; "FORALL_IN_CLOSURE",FORALL_IN_CLOSURE; "FORALL_IN_CLOSURE_EQ",FORALL_IN_CLOSURE_EQ; "FORALL_IN_CROSS",FORALL_IN_CROSS; "FORALL_IN_DIVISION",FORALL_IN_DIVISION; "FORALL_IN_DIVISION_NONEMPTY",FORALL_IN_DIVISION_NONEMPTY; "FORALL_IN_GSPEC",FORALL_IN_GSPEC; "FORALL_IN_IMAGE",FORALL_IN_IMAGE; "FORALL_IN_IMAGE_2",FORALL_IN_IMAGE_2; "FORALL_IN_INSERT",FORALL_IN_INSERT; "FORALL_IN_INTERMEDIATE_CLOSURE",FORALL_IN_INTERMEDIATE_CLOSURE; "FORALL_IN_INTERMEDIATE_CLOSURE_EQ",FORALL_IN_INTERMEDIATE_CLOSURE_EQ; "FORALL_IN_PCROSS",FORALL_IN_PCROSS; "FORALL_IN_UNION",FORALL_IN_UNION; "FORALL_IN_UNIONS",FORALL_IN_UNIONS; "FORALL_LIFT",FORALL_LIFT; "FORALL_LIFT_FUN",FORALL_LIFT_FUN; "FORALL_LIFT_IMAGE",FORALL_LIFT_IMAGE; "FORALL_MULTIVECTOR",FORALL_MULTIVECTOR; "FORALL_NOT_THM",FORALL_NOT_THM; "FORALL_OF_DROP",FORALL_OF_DROP; "FORALL_OF_PASTECART",FORALL_OF_PASTECART; "FORALL_OPTION",FORALL_OPTION; "FORALL_PAIRED_THM",FORALL_PAIRED_THM; "FORALL_PAIR_THM",FORALL_PAIR_THM; "FORALL_PASTECART",FORALL_PASTECART; "FORALL_POS_MONO",FORALL_POS_MONO; "FORALL_POS_MONO_1",FORALL_POS_MONO_1; "FORALL_POS_MONO_1_EQ",FORALL_POS_MONO_1_EQ; "FORALL_POS_MONO_EQ",FORALL_POS_MONO_EQ; "FORALL_REAL",FORALL_REAL; "FORALL_REAL_ONE",FORALL_REAL_ONE; "FORALL_SETCODE",FORALL_SETCODE; "FORALL_SIMP",FORALL_SIMP; "FORALL_SUBSET_IMAGE",FORALL_SUBSET_IMAGE; "FORALL_SUBSET_IMAGE_INJ",FORALL_SUBSET_IMAGE_INJ; "FORALL_SUBSET_INSERT",FORALL_SUBSET_INSERT; "FORALL_SUBSET_UNION",FORALL_SUBSET_UNION; "FORALL_SUC",FORALL_SUC; "FORALL_SUM_THM",FORALL_SUM_THM; "FORALL_TRIPLED_THM",FORALL_TRIPLED_THM; "FORALL_UNCURRY",FORALL_UNCURRY; "FORALL_UNPAIR_THM",FORALL_UNPAIR_THM; "FORALL_UNWIND_THM1",FORALL_UNWIND_THM1; "FORALL_UNWIND_THM2",FORALL_UNWIND_THM2; "FORALL_VECTOR_1",FORALL_VECTOR_1; "FORALL_VECTOR_2",FORALL_VECTOR_2; "FORALL_VECTOR_3",FORALL_VECTOR_3; "FORALL_VECTOR_4",FORALL_VECTOR_4; "FRAC_DIV_MOD",FRAC_DIV_MOD; "FRAC_FLOOR",FRAC_FLOOR; "FRAC_NEG",FRAC_NEG; "FRAC_NUM",FRAC_NUM; "FRAC_UNIQUE",FRAC_UNIQUE; "FRECHET_DERIVATIVE_AT",FRECHET_DERIVATIVE_AT; "FRECHET_DERIVATIVE_CONST_AT",FRECHET_DERIVATIVE_CONST_AT; "FRECHET_DERIVATIVE_UNIQUE_AT",FRECHET_DERIVATIVE_UNIQUE_AT; "FRECHET_DERIVATIVE_UNIQUE_WITHIN",FRECHET_DERIVATIVE_UNIQUE_WITHIN; "FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; "FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL; "FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL; "FRECHET_DERIVATIVE_WORKS",FRECHET_DERIVATIVE_WORKS; "FROM_0",FROM_0; "FROM_INTER_NUMSEG",FROM_INTER_NUMSEG; "FROM_INTER_NUMSEG_GEN",FROM_INTER_NUMSEG_GEN; "FROM_INTER_NUMSEG_MAX",FROM_INTER_NUMSEG_MAX; "FRONTIER_AFFINITY",FRONTIER_AFFINITY; "FRONTIER_BALL",FRONTIER_BALL; "FRONTIER_BIJECTIVE_LINEAR_IMAGE",FRONTIER_BIJECTIVE_LINEAR_IMAGE; "FRONTIER_CBALL",FRONTIER_CBALL; "FRONTIER_CLOPEN_MAP_IMAGE",FRONTIER_CLOPEN_MAP_IMAGE; "FRONTIER_CLOPEN_MAP_IMAGE_SUBSET",FRONTIER_CLOPEN_MAP_IMAGE_SUBSET; "FRONTIER_CLOSED",FRONTIER_CLOSED; "FRONTIER_CLOSED_INTERVAL",FRONTIER_CLOSED_INTERVAL; "FRONTIER_CLOSURES",FRONTIER_CLOSURES; "FRONTIER_CLOSURE_CONVEX",FRONTIER_CLOSURE_CONVEX; "FRONTIER_CLOSURE_SUBSET",FRONTIER_CLOSURE_SUBSET; "FRONTIER_COMPLEMENT",FRONTIER_COMPLEMENT; "FRONTIER_CONVEX_HULL_CASES",FRONTIER_CONVEX_HULL_CASES; "FRONTIER_CONVEX_HULL_EXPLICIT",FRONTIER_CONVEX_HULL_EXPLICIT; "FRONTIER_DISJOINT_EQ",FRONTIER_DISJOINT_EQ; "FRONTIER_EMPTY",FRONTIER_EMPTY; "FRONTIER_EQ_EMPTY",FRONTIER_EQ_EMPTY; "FRONTIER_FRONTIER",FRONTIER_FRONTIER; "FRONTIER_FRONTIER_FRONTIER",FRONTIER_FRONTIER_FRONTIER; "FRONTIER_FRONTIER_SUBSET",FRONTIER_FRONTIER_SUBSET; "FRONTIER_HALFSPACE_COMPONENT_GE",FRONTIER_HALFSPACE_COMPONENT_GE; "FRONTIER_HALFSPACE_COMPONENT_GT",FRONTIER_HALFSPACE_COMPONENT_GT; "FRONTIER_HALFSPACE_COMPONENT_LE",FRONTIER_HALFSPACE_COMPONENT_LE; "FRONTIER_HALFSPACE_COMPONENT_LT",FRONTIER_HALFSPACE_COMPONENT_LT; "FRONTIER_HALFSPACE_GE",FRONTIER_HALFSPACE_GE; "FRONTIER_HALFSPACE_GT",FRONTIER_HALFSPACE_GT; "FRONTIER_HALFSPACE_LE",FRONTIER_HALFSPACE_LE; "FRONTIER_HALFSPACE_LT",FRONTIER_HALFSPACE_LT; "FRONTIER_INJECTIVE_LINEAR_IMAGE",FRONTIER_INJECTIVE_LINEAR_IMAGE; "FRONTIER_INSIDE_SUBSET",FRONTIER_INSIDE_SUBSET; "FRONTIER_INTER",FRONTIER_INTER; "FRONTIER_INTERIORS",FRONTIER_INTERIORS; "FRONTIER_INTERIOR_SUBSET",FRONTIER_INTERIOR_SUBSET; "FRONTIER_INTER_CLOSED",FRONTIER_INTER_CLOSED; "FRONTIER_INTER_SUBSET",FRONTIER_INTER_SUBSET; "FRONTIER_INTER_SUBSET_INTER",FRONTIER_INTER_SUBSET_INTER; "FRONTIER_MINIMAL_SEPARATING_CLOSED",FRONTIER_MINIMAL_SEPARATING_CLOSED; "FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE",FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE; "FRONTIER_NOT_EMPTY",FRONTIER_NOT_EMPTY; "FRONTIER_OF_CLOSURES",FRONTIER_OF_CLOSURES; "FRONTIER_OF_COMPLEMENT",FRONTIER_OF_COMPLEMENT; "FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT",FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; "FRONTIER_OF_COMPONENTS_SUBSET",FRONTIER_OF_COMPONENTS_SUBSET; "FRONTIER_OF_CONNECTED_COMPONENT_SUBSET",FRONTIER_OF_CONNECTED_COMPONENT_SUBSET; "FRONTIER_OF_CONVEX_CLOSED",FRONTIER_OF_CONVEX_CLOSED; "FRONTIER_OF_CONVEX_HULL",FRONTIER_OF_CONVEX_HULL; "FRONTIER_OF_DISJOINT_EQ",FRONTIER_OF_DISJOINT_EQ; "FRONTIER_OF_DISJOINT_EQ_ALT",FRONTIER_OF_DISJOINT_EQ_ALT; "FRONTIER_OF_EMPTY",FRONTIER_OF_EMPTY; "FRONTIER_OF_EQ_EMPTY",FRONTIER_OF_EQ_EMPTY; "FRONTIER_OF_FRONTIER_OF",FRONTIER_OF_FRONTIER_OF; "FRONTIER_OF_FRONTIER_OF_FRONTIER_OF",FRONTIER_OF_FRONTIER_OF_FRONTIER_OF; "FRONTIER_OF_FRONTIER_OF_SUBSET",FRONTIER_OF_FRONTIER_OF_SUBSET; "FRONTIER_OF_INJECTIVE_LINEAR_IMAGE",FRONTIER_OF_INJECTIVE_LINEAR_IMAGE; "FRONTIER_OF_INTER",FRONTIER_OF_INTER; "FRONTIER_OF_INTER_CLOSED_IN",FRONTIER_OF_INTER_CLOSED_IN; "FRONTIER_OF_INTER_SUBSET",FRONTIER_OF_INTER_SUBSET; "FRONTIER_OF_OPEN_IN",FRONTIER_OF_OPEN_IN; "FRONTIER_OF_OPEN_IN_STRADDLE_INTER",FRONTIER_OF_OPEN_IN_STRADDLE_INTER; "FRONTIER_OF_RESTRICT",FRONTIER_OF_RESTRICT; "FRONTIER_OF_SUBSET_CLOSED_IN",FRONTIER_OF_SUBSET_CLOSED_IN; "FRONTIER_OF_SUBSET_EQ",FRONTIER_OF_SUBSET_EQ; "FRONTIER_OF_SUBSET_SUBTOPOLOGY",FRONTIER_OF_SUBSET_SUBTOPOLOGY; "FRONTIER_OF_SUBSET_TOPSPACE",FRONTIER_OF_SUBSET_TOPSPACE; "FRONTIER_OF_SUBTOPOLOGY_MONO",FRONTIER_OF_SUBTOPOLOGY_MONO; "FRONTIER_OF_SUBTOPOLOGY_OPEN",FRONTIER_OF_SUBTOPOLOGY_OPEN; "FRONTIER_OF_SUBTOPOLOGY_SUBSET",FRONTIER_OF_SUBTOPOLOGY_SUBSET; "FRONTIER_OF_TOPSPACE",FRONTIER_OF_TOPSPACE; "FRONTIER_OF_TRANSLATION",FRONTIER_OF_TRANSLATION; "FRONTIER_OF_TRIANGLE",FRONTIER_OF_TRIANGLE; "FRONTIER_OF_UNIONS_SUBSET",FRONTIER_OF_UNIONS_SUBSET; "FRONTIER_OF_UNION_SUBSET",FRONTIER_OF_UNION_SUBSET; "FRONTIER_OPEN_INTERVAL",FRONTIER_OPEN_INTERVAL; "FRONTIER_OPEN_MAP_IMAGE_SUBSET",FRONTIER_OPEN_MAP_IMAGE_SUBSET; "FRONTIER_OPEN_STRADDLE_INTER",FRONTIER_OPEN_STRADDLE_INTER; "FRONTIER_OPEN_UNION",FRONTIER_OPEN_UNION; "FRONTIER_OPEN_UNIONS",FRONTIER_OPEN_UNIONS; "FRONTIER_OUTSIDE_SUBSET",FRONTIER_OUTSIDE_SUBSET; "FRONTIER_PCROSS",FRONTIER_PCROSS; "FRONTIER_PROPER_CLOPEN_MAP_IMAGE",FRONTIER_PROPER_CLOPEN_MAP_IMAGE; "FRONTIER_PROPER_HOLOMORPHIC_IMAGE",FRONTIER_PROPER_HOLOMORPHIC_IMAGE; "FRONTIER_PROPER_MAP_IMAGE_SUBSET",FRONTIER_PROPER_MAP_IMAGE_SUBSET; "FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN",FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN; "FRONTIER_PROPER_OPEN_MAP_IMAGE",FRONTIER_PROPER_OPEN_MAP_IMAGE; "FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE",FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE; "FRONTIER_SCALING",FRONTIER_SCALING; "FRONTIER_SEGMENT",FRONTIER_SEGMENT; "FRONTIER_SING",FRONTIER_SING; "FRONTIER_SPHERE",FRONTIER_SPHERE; "FRONTIER_STRADDLE",FRONTIER_STRADDLE; "FRONTIER_STRIP_COMPONENT_LE",FRONTIER_STRIP_COMPONENT_LE; "FRONTIER_STRIP_COMPONENT_LT",FRONTIER_STRIP_COMPONENT_LT; "FRONTIER_SUBSET_CLOSED",FRONTIER_SUBSET_CLOSED; "FRONTIER_SUBSET_COMPACT",FRONTIER_SUBSET_COMPACT; "FRONTIER_SUBSET_EQ",FRONTIER_SUBSET_EQ; "FRONTIER_SUBSET_RETRACTION",FRONTIER_SUBSET_RETRACTION; "FRONTIER_SURJECTIVE_LINEAR_IMAGE",FRONTIER_SURJECTIVE_LINEAR_IMAGE; "FRONTIER_TRANSLATION",FRONTIER_TRANSLATION; "FRONTIER_UNION",FRONTIER_UNION; "FRONTIER_UNIONS_SUBSET",FRONTIER_UNIONS_SUBSET; "FRONTIER_UNIONS_SUBSET_CLOSURE",FRONTIER_UNIONS_SUBSET_CLOSURE; "FRONTIER_UNION_INTERIOR",FRONTIER_UNION_INTERIOR; "FRONTIER_UNION_SUBSET",FRONTIER_UNION_SUBSET; "FRONTIER_UNIV",FRONTIER_UNIV; "FRONTIER_WITH_INSIDE_SUBSET",FRONTIER_WITH_INSIDE_SUBSET; "FRONTIER_WITH_OUTSIDE_SUBSET",FRONTIER_WITH_OUTSIDE_SUBSET; "FSIGMA_ASCENDING",FSIGMA_ASCENDING; "FSIGMA_BAIRE",FSIGMA_BAIRE; "FSIGMA_BAIRE1_PREIMAGE_OPEN",FSIGMA_BAIRE1_PREIMAGE_OPEN; "FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN",FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN; "FSIGMA_COMPLEMENT",FSIGMA_COMPLEMENT; "FSIGMA_CONTINUOUS_IMAGE",FSIGMA_CONTINUOUS_IMAGE; "FSIGMA_DIFF",FSIGMA_DIFF; "FSIGMA_EMPTY",FSIGMA_EMPTY; "FSIGMA_FSIGMA_PROJECTION",FSIGMA_FSIGMA_PROJECTION; "FSIGMA_IMP_ANALYTIC",FSIGMA_IMP_ANALYTIC; "FSIGMA_IMP_BOREL",FSIGMA_IMP_BOREL; "FSIGMA_IMP_LEBESGUE_MEASURABLE",FSIGMA_IMP_LEBESGUE_MEASURABLE; "FSIGMA_INTER",FSIGMA_INTER; "FSIGMA_INTERS",FSIGMA_INTERS; "FSIGMA_LINEAR_IMAGE",FSIGMA_LINEAR_IMAGE; "FSIGMA_LOCALLY_COMPACT",FSIGMA_LOCALLY_COMPACT; "FSIGMA_PCROSS",FSIGMA_PCROSS; "FSIGMA_PCROSS_EQ",FSIGMA_PCROSS_EQ; "FSIGMA_PREIMAGE_CARD_GE",FSIGMA_PREIMAGE_CARD_GE; "FSIGMA_PROPER_PREIMAGE",FSIGMA_PROPER_PREIMAGE; "FSIGMA_REDUCTION",FSIGMA_REDUCTION; "FSIGMA_REDUCTION_GEN",FSIGMA_REDUCTION_GEN; "FSIGMA_REDUCTION_GEN_2",FSIGMA_REDUCTION_GEN_2; "FSIGMA_REDUCTION_GEN_ALT",FSIGMA_REDUCTION_GEN_ALT; "FSIGMA_SING",FSIGMA_SING; "FSIGMA_TRANSLATION",FSIGMA_TRANSLATION; "FSIGMA_UNION",FSIGMA_UNION; "FSIGMA_UNIONS",FSIGMA_UNIONS; "FSIGMA_UNIONS_CLOPEN_CHAIN",FSIGMA_UNIONS_CLOPEN_CHAIN; "FSIGMA_UNIONS_COMPACT",FSIGMA_UNIONS_COMPACT; "FSIGMA_UNIV",FSIGMA_UNIV; "FST",FST; "FSTCART_ADD",FSTCART_ADD; "FSTCART_CMUL",FSTCART_CMUL; "FSTCART_NEG",FSTCART_NEG; "FSTCART_PASTECART",FSTCART_PASTECART; "FSTCART_SUB",FSTCART_SUB; "FSTCART_VEC",FSTCART_VEC; "FSTCART_VSUM",FSTCART_VSUM; "FST_DEF",FST_DEF; "FTA",FTA; "FUBINI_ABSOLUTELY_INTEGRABLE",FUBINI_ABSOLUTELY_INTEGRABLE; "FUBINI_ABSOLUTELY_INTEGRABLE_ALT",FUBINI_ABSOLUTELY_INTEGRABLE_ALT; "FUBINI_CLOSED_INTERVAL",FUBINI_CLOSED_INTERVAL; "FUBINI_HAS_ABSOLUTE_INTEGRAL",FUBINI_HAS_ABSOLUTE_INTEGRAL; "FUBINI_HAS_ABSOLUTE_INTEGRAL_ALT",FUBINI_HAS_ABSOLUTE_INTEGRAL_ALT; "FUBINI_INTEGRAL",FUBINI_INTEGRAL; "FUBINI_INTEGRAL_ALT",FUBINI_INTEGRAL_ALT; "FUBINI_INTEGRAL_INTERVAL",FUBINI_INTEGRAL_INTERVAL; "FUBINI_INTEGRAL_INTERVAL_ALT",FUBINI_INTEGRAL_INTERVAL_ALT; "FUBINI_LEBESGUE_MEASURABLE",FUBINI_LEBESGUE_MEASURABLE; "FUBINI_LEBESGUE_MEASURABLE_ALT",FUBINI_LEBESGUE_MEASURABLE_ALT; "FUBINI_MEASURE",FUBINI_MEASURE; "FUBINI_MEASURE_ALT",FUBINI_MEASURE_ALT; "FUBINI_NEGLIGIBLE",FUBINI_NEGLIGIBLE; "FUBINI_NEGLIGIBLE_ALT",FUBINI_NEGLIGIBLE_ALT; "FUBINI_NEGLIGIBLE_OFFSET",FUBINI_NEGLIGIBLE_OFFSET; "FUBINI_NEGLIGIBLE_REPLACEMENTS",FUBINI_NEGLIGIBLE_REPLACEMENTS; "FUBINI_NEGLIGIBLE_REPLACEMENTS_ALT",FUBINI_NEGLIGIBLE_REPLACEMENTS_ALT; "FUBINI_POLAR",FUBINI_POLAR; "FUBINI_SIMPLE",FUBINI_SIMPLE; "FUBINI_SIMPLE_ALT",FUBINI_SIMPLE_ALT; "FUBINI_SIMPLE_COMPACT",FUBINI_SIMPLE_COMPACT; "FUBINI_SIMPLE_COMPACT_STRONG",FUBINI_SIMPLE_COMPACT_STRONG; "FUBINI_SIMPLE_CONVEX",FUBINI_SIMPLE_CONVEX; "FUBINI_SIMPLE_CONVEX_STRONG",FUBINI_SIMPLE_CONVEX_STRONG; "FUBINI_SIMPLE_LEMMA",FUBINI_SIMPLE_LEMMA; "FUBINI_SIMPLE_OPEN",FUBINI_SIMPLE_OPEN; "FUBINI_SIMPLE_OPEN_STRONG",FUBINI_SIMPLE_OPEN_STRONG; "FUBINI_TONELLI",FUBINI_TONELLI; "FUBINI_TONELLI_ALT",FUBINI_TONELLI_ALT; "FUBINI_TONELLI_MEASURE",FUBINI_TONELLI_MEASURE; "FUBINI_TONELLI_MEASURE_ALT",FUBINI_TONELLI_MEASURE_ALT; "FUBINI_TONELLI_NEGLIGIBLE",FUBINI_TONELLI_NEGLIGIBLE; "FUBINI_TONELLI_NEGLIGIBLE_ALT",FUBINI_TONELLI_NEGLIGIBLE_ALT; "FUBINI_TONELLI_POLAR",FUBINI_TONELLI_POLAR; "FULL_RANK_INJECTIVE",FULL_RANK_INJECTIVE; "FULL_RANK_SURJECTIVE",FULL_RANK_SURJECTIVE; "FUNCTION_CONVERGENT_SUBSEQUENCE",FUNCTION_CONVERGENT_SUBSEQUENCE; "FUNCTION_EXTENSION_POINTWISE",FUNCTION_EXTENSION_POINTWISE; "FUNCTION_EXTENSION_POINTWISE_ALT",FUNCTION_EXTENSION_POINTWISE_ALT; "FUNCTION_FACTORS_LEFT",FUNCTION_FACTORS_LEFT; "FUNCTION_FACTORS_LEFT_GEN",FUNCTION_FACTORS_LEFT_GEN; "FUNCTION_FACTORS_RIGHT",FUNCTION_FACTORS_RIGHT; "FUNCTION_FACTORS_RIGHT_GEN",FUNCTION_FACTORS_RIGHT_GEN; "FUNDAMENTAL_GROUP_EQ_EMPTY",FUNDAMENTAL_GROUP_EQ_EMPTY; "FUNDAMENTAL_GROUP_SIMPLY_CONNECTED",FUNDAMENTAL_GROUP_SIMPLY_CONNECTED; "FUNDAMENTAL_THEOREM_OF_CALCULUS",FUNDAMENTAL_THEOREM_OF_CALCULUS; "FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS",FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS; "FUNDAMENTAL_THEOREM_OF_CALCULUS_BARTLE",FUNDAMENTAL_THEOREM_OF_CALCULUS_BARTLE; "FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR; "FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG; "FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG; "FUNSPACE",FUNSPACE; "FUNSPACE_IMP_BOUNDED",FUNSPACE_IMP_BOUNDED; "FUNSPACE_IMP_BOUNDED2",FUNSPACE_IMP_BOUNDED2; "FUNSPACE_IMP_BOUNDED_IMAGE",FUNSPACE_IMP_BOUNDED_IMAGE; "FUNSPACE_IMP_EXTENSIONAL",FUNSPACE_IMP_EXTENSIONAL; "FUNSPACE_IMP_WELLDEFINED",FUNSPACE_IMP_WELLDEFINED; "FUNSPACE_MDIST_LE",FUNSPACE_MDIST_LE; "FUN_EQ_THM",FUN_EQ_THM; "FUN_IN_IMAGE",FUN_IN_IMAGE; "F_DEF",F_DEF; "GABS_DEF",GABS_DEF; "GATEAUX_DERIVATIVE",GATEAUX_DERIVATIVE; "GATEAUX_DERIVATIVE_LIPSCHITZ",GATEAUX_DERIVATIVE_LIPSCHITZ; "GATEAUX_DERIVATIVE_WITHIN",GATEAUX_DERIVATIVE_WITHIN; "GAUGE_BALL",GAUGE_BALL; "GAUGE_BALL_DEPENDENT",GAUGE_BALL_DEPENDENT; "GAUGE_EXISTENCE_LEMMA",GAUGE_EXISTENCE_LEMMA; "GAUGE_INTER",GAUGE_INTER; "GAUGE_INTERS",GAUGE_INTERS; "GAUGE_MODIFY",GAUGE_MODIFY; "GAUGE_TRIVIAL",GAUGE_TRIVIAL; "GDELTA_BAIRE",GDELTA_BAIRE; "GDELTA_BAIRE1_PREIMAGE_CLOSED",GDELTA_BAIRE1_PREIMAGE_CLOSED; "GDELTA_COMPLEMENT",GDELTA_COMPLEMENT; "GDELTA_CONTINUOUS_FUNCTION_MINIMA",GDELTA_CONTINUOUS_FUNCTION_MINIMA; "GDELTA_DESCENDING",GDELTA_DESCENDING; "GDELTA_DIFF",GDELTA_DIFF; "GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS",GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS; "GDELTA_DOMAIN_OF_INJECTIVITY_MEASURABLE",GDELTA_DOMAIN_OF_INJECTIVITY_MEASURABLE; "GDELTA_EMPTY",GDELTA_EMPTY; "GDELTA_IMP_ANALYTIC",GDELTA_IMP_ANALYTIC; "GDELTA_IMP_BOREL",GDELTA_IMP_BOREL; "GDELTA_IMP_LEBESGUE_MEASURABLE",GDELTA_IMP_LEBESGUE_MEASURABLE; "GDELTA_INTER",GDELTA_INTER; "GDELTA_INTERS",GDELTA_INTERS; "GDELTA_INTERS_CLOPEN_CHAIN",GDELTA_INTERS_CLOPEN_CHAIN; "GDELTA_LINEAR_IMAGE",GDELTA_LINEAR_IMAGE; "GDELTA_LOCALLY_COMPACT",GDELTA_LOCALLY_COMPACT; "GDELTA_PCROSS",GDELTA_PCROSS; "GDELTA_PCROSS_EQ",GDELTA_PCROSS_EQ; "GDELTA_POINTS_OF_CONTINUITY",GDELTA_POINTS_OF_CONTINUITY; "GDELTA_POINTS_OF_CONTINUITY_WITHIN",GDELTA_POINTS_OF_CONTINUITY_WITHIN; "GDELTA_POINTS_OF_CONVERGENCE_AT",GDELTA_POINTS_OF_CONVERGENCE_AT; "GDELTA_POINTS_OF_CONVERGENCE_WITHIN",GDELTA_POINTS_OF_CONVERGENCE_WITHIN; "GDELTA_PREIMAGE_CARD_LE",GDELTA_PREIMAGE_CARD_LE; "GDELTA_SEPARATION",GDELTA_SEPARATION; "GDELTA_SEPARATION_GEN",GDELTA_SEPARATION_GEN; "GDELTA_SING",GDELTA_SING; "GDELTA_TRANSLATION",GDELTA_TRANSLATION; "GDELTA_UNION",GDELTA_UNION; "GDELTA_UNIONS",GDELTA_UNIONS; "GDELTA_UNIV",GDELTA_UNIV; "GE",GE; "GENERAL_CONNECTED_OPEN",GENERAL_CONNECTED_OPEN; "GENERAL_REDUCTION_THEOREM",GENERAL_REDUCTION_THEOREM; "GENERAL_REDUCTION_THEOREM_2",GENERAL_REDUCTION_THEOREM_2; "GEOM_ASSOC",GEOM_ASSOC; "GEOM_LADD",GEOM_LADD; "GEOM_LMUL",GEOM_LMUL; "GEOM_LNEG",GEOM_LNEG; "GEOM_LZERO",GEOM_LZERO; "GEOM_MBASIS",GEOM_MBASIS; "GEOM_MBASIS_SING",GEOM_MBASIS_SING; "GEOM_RADD",GEOM_RADD; "GEOM_RMUL",GEOM_RMUL; "GEOM_RNEG",GEOM_RNEG; "GEOM_RZERO",GEOM_RZERO; "GEQ_DEF",GEQ_DEF; "GE_C",GE_C; "GE_REFL",GE_REFL; "GRADE_ADD",GRADE_ADD; "GRADE_CMUL",GRADE_CMUL; "GRAM_SCHMIDT_STEP",GRAM_SCHMIDT_STEP; "GRAPH_EMBEDS_IN_R3",GRAPH_EMBEDS_IN_R3; "GRASSMANN_PLUCKER_2",GRASSMANN_PLUCKER_2; "GRASSMANN_PLUCKER_3",GRASSMANN_PLUCKER_3; "GRASSMANN_PLUCKER_4",GRASSMANN_PLUCKER_4; "GREAT_PICARD",GREAT_PICARD; "GREAT_PICARD_ALT",GREAT_PICARD_ALT; "GREAT_PICARD_INFINITE",GREAT_PICARD_INFINITE; "GSPEC",GSPEC; "GT",GT; "HADAMARD_INEQUALITY_COLUMN",HADAMARD_INEQUALITY_COLUMN; "HADAMARD_INEQUALITY_PSD",HADAMARD_INEQUALITY_PSD; "HADAMARD_INEQUALITY_ROW",HADAMARD_INEQUALITY_ROW; "HADAMARD_THREE_CIRCLE",HADAMARD_THREE_CIRCLE; "HADAMARD_THREE_CIRCLE_EXPLICIT",HADAMARD_THREE_CIRCLE_EXPLICIT; "HADAMARD_THREE_LINE_EXPLICIT_IM",HADAMARD_THREE_LINE_EXPLICIT_IM; "HADAMARD_THREE_LINE_EXPLICIT_RE",HADAMARD_THREE_LINE_EXPLICIT_RE; "HADAMARD_THREE_LINE_IM",HADAMARD_THREE_LINE_IM; "HADAMARD_THREE_LINE_RE",HADAMARD_THREE_LINE_RE; "HAIRY_BALL_THEOREM",HAIRY_BALL_THEOREM; "HAIRY_BALL_THEOREM_ALT",HAIRY_BALL_THEOREM_ALT; "HALFSPACE_EQ_EMPTY_GE",HALFSPACE_EQ_EMPTY_GE; "HALFSPACE_EQ_EMPTY_GT",HALFSPACE_EQ_EMPTY_GT; "HALFSPACE_EQ_EMPTY_LE",HALFSPACE_EQ_EMPTY_LE; "HALFSPACE_EQ_EMPTY_LT",HALFSPACE_EQ_EMPTY_LT; "HALF_MEASURES",HALF_MEASURES; "HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES",HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES; "HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_INVERTIBLE",HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_INVERTIBLE; "HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_LINEAR",HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_LINEAR; "HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_POLAR",HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_POLAR; "HAS_ANTIDERIVATIVE_LIMIT",HAS_ANTIDERIVATIVE_LIMIT; "HAS_ANTIDERIVATIVE_SEQUENCE",HAS_ANTIDERIVATIVE_SEQUENCE; "HAS_BOUNDED_REAL_VARIATION_AFFINITY2_EQ",HAS_BOUNDED_REAL_VARIATION_AFFINITY2_EQ; "HAS_BOUNDED_REAL_VARIATION_AFFINITY_EQ",HAS_BOUNDED_REAL_VARIATION_AFFINITY_EQ; "HAS_BOUNDED_REAL_VARIATION_COUNTABLE_DISCONTINUITIES",HAS_BOUNDED_REAL_VARIATION_COUNTABLE_DISCONTINUITIES; "HAS_BOUNDED_REAL_VARIATION_DARBOUX",HAS_BOUNDED_REAL_VARIATION_DARBOUX; "HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRICT",HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRICT; "HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRONG",HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRONG; "HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT",HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT; "HAS_BOUNDED_REAL_VARIATION_ON_ABS",HAS_BOUNDED_REAL_VARIATION_ON_ABS; "HAS_BOUNDED_REAL_VARIATION_ON_ADD",HAS_BOUNDED_REAL_VARIATION_ON_ADD; "HAS_BOUNDED_REAL_VARIATION_ON_COMBINE",HAS_BOUNDED_REAL_VARIATION_ON_COMBINE; "HAS_BOUNDED_REAL_VARIATION_ON_EMPTY",HAS_BOUNDED_REAL_VARIATION_ON_EMPTY; "HAS_BOUNDED_REAL_VARIATION_ON_EQ",HAS_BOUNDED_REAL_VARIATION_ON_EQ; "HAS_BOUNDED_REAL_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL",HAS_BOUNDED_REAL_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL; "HAS_BOUNDED_REAL_VARIATION_ON_LMUL",HAS_BOUNDED_REAL_VARIATION_ON_LMUL; "HAS_BOUNDED_REAL_VARIATION_ON_MAX",HAS_BOUNDED_REAL_VARIATION_ON_MAX; "HAS_BOUNDED_REAL_VARIATION_ON_MIN",HAS_BOUNDED_REAL_VARIATION_ON_MIN; "HAS_BOUNDED_REAL_VARIATION_ON_MUL",HAS_BOUNDED_REAL_VARIATION_ON_MUL; "HAS_BOUNDED_REAL_VARIATION_ON_NEG",HAS_BOUNDED_REAL_VARIATION_ON_NEG; "HAS_BOUNDED_REAL_VARIATION_ON_NULL",HAS_BOUNDED_REAL_VARIATION_ON_NULL; "HAS_BOUNDED_REAL_VARIATION_ON_RMUL",HAS_BOUNDED_REAL_VARIATION_ON_RMUL; "HAS_BOUNDED_REAL_VARIATION_ON_SUB",HAS_BOUNDED_REAL_VARIATION_ON_SUB; "HAS_BOUNDED_REAL_VARIATION_ON_SUBSET",HAS_BOUNDED_REAL_VARIATION_ON_SUBSET; "HAS_BOUNDED_REAL_VARIATION_REFLECT2_EQ",HAS_BOUNDED_REAL_VARIATION_REFLECT2_EQ; "HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ",HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ; "HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ_INTERVAL",HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ_INTERVAL; "HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT",HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT; "HAS_BOUNDED_REAL_VARIATION_TRANSLATION",HAS_BOUNDED_REAL_VARIATION_TRANSLATION; "HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ",HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ; "HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ",HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ; "HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ_INTERVAL",HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ_INTERVAL; "HAS_BOUNDED_SETVARIATION_COMPARISON",HAS_BOUNDED_SETVARIATION_COMPARISON; "HAS_BOUNDED_SETVARIATION_ON",HAS_BOUNDED_SETVARIATION_ON; "HAS_BOUNDED_SETVARIATION_ON_0",HAS_BOUNDED_SETVARIATION_ON_0; "HAS_BOUNDED_SETVARIATION_ON_ADD",HAS_BOUNDED_SETVARIATION_ON_ADD; "HAS_BOUNDED_SETVARIATION_ON_CMUL",HAS_BOUNDED_SETVARIATION_ON_CMUL; "HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE",HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE; "HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR; "HAS_BOUNDED_SETVARIATION_ON_DIVISION",HAS_BOUNDED_SETVARIATION_ON_DIVISION; "HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY; "HAS_BOUNDED_SETVARIATION_ON_EQ",HAS_BOUNDED_SETVARIATION_ON_EQ; "HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; "HAS_BOUNDED_SETVARIATION_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_ON_INTERVAL; "HAS_BOUNDED_SETVARIATION_ON_LIFT_ABS",HAS_BOUNDED_SETVARIATION_ON_LIFT_ABS; "HAS_BOUNDED_SETVARIATION_ON_MUL",HAS_BOUNDED_SETVARIATION_ON_MUL; "HAS_BOUNDED_SETVARIATION_ON_NEG",HAS_BOUNDED_SETVARIATION_ON_NEG; "HAS_BOUNDED_SETVARIATION_ON_NORM",HAS_BOUNDED_SETVARIATION_ON_NORM; "HAS_BOUNDED_SETVARIATION_ON_NULL",HAS_BOUNDED_SETVARIATION_ON_NULL; "HAS_BOUNDED_SETVARIATION_ON_PASTECART",HAS_BOUNDED_SETVARIATION_ON_PASTECART; "HAS_BOUNDED_SETVARIATION_ON_SUB",HAS_BOUNDED_SETVARIATION_ON_SUB; "HAS_BOUNDED_SETVARIATION_ON_SUBSET",HAS_BOUNDED_SETVARIATION_ON_SUBSET; "HAS_BOUNDED_SETVARIATION_ON_UNIV",HAS_BOUNDED_SETVARIATION_ON_UNIV; "HAS_BOUNDED_SETVARIATION_ON_VSUM",HAS_BOUNDED_SETVARIATION_ON_VSUM; "HAS_BOUNDED_SETVARIATION_REFLECT2_EQ",HAS_BOUNDED_SETVARIATION_REFLECT2_EQ; "HAS_BOUNDED_SETVARIATION_TRANSLATION",HAS_BOUNDED_SETVARIATION_TRANSLATION; "HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ",HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ; "HAS_BOUNDED_SETVARIATION_WORKS",HAS_BOUNDED_SETVARIATION_WORKS; "HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY; "HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL; "HAS_BOUNDED_SET_VARIATION",HAS_BOUNDED_SET_VARIATION; "HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE",HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE; "HAS_BOUNDED_VARIATION_AFFINITY2_EQ",HAS_BOUNDED_VARIATION_AFFINITY2_EQ; "HAS_BOUNDED_VARIATION_AFFINITY_EQ",HAS_BOUNDED_VARIATION_AFFINITY_EQ; "HAS_BOUNDED_VARIATION_COMPARISON",HAS_BOUNDED_VARIATION_COMPARISON; "HAS_BOUNDED_VARIATION_COMPOSE_DECREASING",HAS_BOUNDED_VARIATION_COMPOSE_DECREASING; "HAS_BOUNDED_VARIATION_COMPOSE_HOMEOMORPHISM",HAS_BOUNDED_VARIATION_COMPOSE_HOMEOMORPHISM; "HAS_BOUNDED_VARIATION_COMPOSE_INCREASING",HAS_BOUNDED_VARIATION_COMPOSE_INCREASING; "HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN",HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN; "HAS_BOUNDED_VARIATION_COMPOSE_INJECTIVE",HAS_BOUNDED_VARIATION_COMPOSE_INJECTIVE; "HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES",HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES; "HAS_BOUNDED_VARIATION_DARBOUX",HAS_BOUNDED_VARIATION_DARBOUX; "HAS_BOUNDED_VARIATION_DARBOUX_GEN",HAS_BOUNDED_VARIATION_DARBOUX_GEN; "HAS_BOUNDED_VARIATION_DARBOUX_STRICT",HAS_BOUNDED_VARIATION_DARBOUX_STRICT; "HAS_BOUNDED_VARIATION_DARBOUX_STRONG",HAS_BOUNDED_VARIATION_DARBOUX_STRONG; "HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE",HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE; "HAS_BOUNDED_VARIATION_ISOMETRIC",HAS_BOUNDED_VARIATION_ISOMETRIC; "HAS_BOUNDED_VARIATION_ISOMETRIC_COMPOSE",HAS_BOUNDED_VARIATION_ISOMETRIC_COMPOSE; "HAS_BOUNDED_VARIATION_LEFT_LIMIT_GEN",HAS_BOUNDED_VARIATION_LEFT_LIMIT_GEN; "HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE",HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE; "HAS_BOUNDED_VARIATION_NONTRIVIAL",HAS_BOUNDED_VARIATION_NONTRIVIAL; "HAS_BOUNDED_VARIATION_ON_ADD",HAS_BOUNDED_VARIATION_ON_ADD; "HAS_BOUNDED_VARIATION_ON_BILINEAR",HAS_BOUNDED_VARIATION_ON_BILINEAR; "HAS_BOUNDED_VARIATION_ON_CLOSURE",HAS_BOUNDED_VARIATION_ON_CLOSURE; "HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ",HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ; "HAS_BOUNDED_VARIATION_ON_CMUL",HAS_BOUNDED_VARIATION_ON_CMUL; "HAS_BOUNDED_VARIATION_ON_CMUL_EQ",HAS_BOUNDED_VARIATION_ON_CMUL_EQ; "HAS_BOUNDED_VARIATION_ON_COMBINE",HAS_BOUNDED_VARIATION_ON_COMBINE; "HAS_BOUNDED_VARIATION_ON_COMBINE_GEN",HAS_BOUNDED_VARIATION_ON_COMBINE_GEN; "HAS_BOUNDED_VARIATION_ON_COMPLEX_INV",HAS_BOUNDED_VARIATION_ON_COMPLEX_INV; "HAS_BOUNDED_VARIATION_ON_COMPLEX_MUL",HAS_BOUNDED_VARIATION_ON_COMPLEX_MUL; "HAS_BOUNDED_VARIATION_ON_COMPONENTWISE",HAS_BOUNDED_VARIATION_ON_COMPONENTWISE; "HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR; "HAS_BOUNDED_VARIATION_ON_CONST",HAS_BOUNDED_VARIATION_ON_CONST; "HAS_BOUNDED_VARIATION_ON_DARBOUX_IMP_CONTINUOUS",HAS_BOUNDED_VARIATION_ON_DARBOUX_IMP_CONTINUOUS; "HAS_BOUNDED_VARIATION_ON_DIVISION",HAS_BOUNDED_VARIATION_ON_DIVISION; "HAS_BOUNDED_VARIATION_ON_EMPTY",HAS_BOUNDED_VARIATION_ON_EMPTY; "HAS_BOUNDED_VARIATION_ON_EQ",HAS_BOUNDED_VARIATION_ON_EQ; "HAS_BOUNDED_VARIATION_ON_ID",HAS_BOUNDED_VARIATION_ON_ID; "HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED; "HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL; "HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; "HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT; "HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT; "HAS_BOUNDED_VARIATION_ON_INTERIOR",HAS_BOUNDED_VARIATION_ON_INTERIOR; "HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ",HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ; "HAS_BOUNDED_VARIATION_ON_INTERVAL",HAS_BOUNDED_VARIATION_ON_INTERVAL; "HAS_BOUNDED_VARIATION_ON_LIFT_ABS",HAS_BOUNDED_VARIATION_ON_LIFT_ABS; "HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE",HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE; "HAS_BOUNDED_VARIATION_ON_MAX",HAS_BOUNDED_VARIATION_ON_MAX; "HAS_BOUNDED_VARIATION_ON_MIN",HAS_BOUNDED_VARIATION_ON_MIN; "HAS_BOUNDED_VARIATION_ON_MUL",HAS_BOUNDED_VARIATION_ON_MUL; "HAS_BOUNDED_VARIATION_ON_NEG",HAS_BOUNDED_VARIATION_ON_NEG; "HAS_BOUNDED_VARIATION_ON_NORM",HAS_BOUNDED_VARIATION_ON_NORM; "HAS_BOUNDED_VARIATION_ON_NULL",HAS_BOUNDED_VARIATION_ON_NULL; "HAS_BOUNDED_VARIATION_ON_PASTECART",HAS_BOUNDED_VARIATION_ON_PASTECART; "HAS_BOUNDED_VARIATION_ON_REFLECT",HAS_BOUNDED_VARIATION_ON_REFLECT; "HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL",HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL; "HAS_BOUNDED_VARIATION_ON_SING",HAS_BOUNDED_VARIATION_ON_SING; "HAS_BOUNDED_VARIATION_ON_SPLIT",HAS_BOUNDED_VARIATION_ON_SPLIT; "HAS_BOUNDED_VARIATION_ON_SUB",HAS_BOUNDED_VARIATION_ON_SUB; "HAS_BOUNDED_VARIATION_ON_SUBSET",HAS_BOUNDED_VARIATION_ON_SUBSET; "HAS_BOUNDED_VARIATION_ON_TRANSLATION",HAS_BOUNDED_VARIATION_ON_TRANSLATION; "HAS_BOUNDED_VARIATION_ON_UNION",HAS_BOUNDED_VARIATION_ON_UNION; "HAS_BOUNDED_VARIATION_ON_VECTOR_VARIATION",HAS_BOUNDED_VARIATION_ON_VECTOR_VARIATION; "HAS_BOUNDED_VARIATION_ON_VMUL",HAS_BOUNDED_VARIATION_ON_VMUL; "HAS_BOUNDED_VARIATION_ON_VMUL_EQ",HAS_BOUNDED_VARIATION_ON_VMUL_EQ; "HAS_BOUNDED_VARIATION_ON_VSUM",HAS_BOUNDED_VARIATION_ON_VSUM; "HAS_BOUNDED_VARIATION_REFLECT2_EQ",HAS_BOUNDED_VARIATION_REFLECT2_EQ; "HAS_BOUNDED_VARIATION_REFLECT_EQ",HAS_BOUNDED_VARIATION_REFLECT_EQ; "HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL",HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL; "HAS_BOUNDED_VARIATION_RIGHT_LIMIT_GEN",HAS_BOUNDED_VARIATION_RIGHT_LIMIT_GEN; "HAS_BOUNDED_VARIATION_TRANSLATION",HAS_BOUNDED_VARIATION_TRANSLATION; "HAS_BOUNDED_VARIATION_TRANSLATION2_EQ",HAS_BOUNDED_VARIATION_TRANSLATION2_EQ; "HAS_BOUNDED_VARIATION_TRANSLATION_EQ",HAS_BOUNDED_VARIATION_TRANSLATION_EQ; "HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL",HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL; "HAS_BOUNDED_VARIATION_WORKS",HAS_BOUNDED_VARIATION_WORKS; "HAS_BOUNDED_VARIATION_WORKS_ON_ELEMENTARY",HAS_BOUNDED_VARIATION_WORKS_ON_ELEMENTARY; "HAS_BOUNDED_VARIATION_WORKS_ON_INTERVAL",HAS_BOUNDED_VARIATION_WORKS_ON_INTERVAL; "HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_HAS_BOUNDED_VARIATION_ON",HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_HAS_BOUNDED_VARIATION_ON; "HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_LIPSCHITZ",HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_LIPSCHITZ; "HAS_BOUNDED_VECTOR_VARIATION",HAS_BOUNDED_VECTOR_VARIATION; "HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT; "HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL",HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL; "HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL_GEN",HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL_GEN; "HAS_BOUNDED_VECTOR_VARIATION_ON_SUBINTERVALS",HAS_BOUNDED_VECTOR_VARIATION_ON_SUBINTERVALS; "HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT; "HAS_BOUNDED_VECTOR_VARIATION_UNIFORM_LIM",HAS_BOUNDED_VECTOR_VARIATION_UNIFORM_LIM; "HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL",HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL; "HAS_COMPLEX_DERIVATIVE_ADD",HAS_COMPLEX_DERIVATIVE_ADD; "HAS_COMPLEX_DERIVATIVE_AT",HAS_COMPLEX_DERIVATIVE_AT; "HAS_COMPLEX_DERIVATIVE_AT_WITHIN",HAS_COMPLEX_DERIVATIVE_AT_WITHIN; "HAS_COMPLEX_DERIVATIVE_CACS",HAS_COMPLEX_DERIVATIVE_CACS; "HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT",HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT; "HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN",HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN; "HAS_COMPLEX_DERIVATIVE_CASN",HAS_COMPLEX_DERIVATIVE_CASN; "HAS_COMPLEX_DERIVATIVE_CATN",HAS_COMPLEX_DERIVATIVE_CATN; "HAS_COMPLEX_DERIVATIVE_CCOS",HAS_COMPLEX_DERIVATIVE_CCOS; "HAS_COMPLEX_DERIVATIVE_CDIV_AT",HAS_COMPLEX_DERIVATIVE_CDIV_AT; "HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN",HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN; "HAS_COMPLEX_DERIVATIVE_CEXP",HAS_COMPLEX_DERIVATIVE_CEXP; "HAS_COMPLEX_DERIVATIVE_CHAIN",HAS_COMPLEX_DERIVATIVE_CHAIN; "HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV",HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV; "HAS_COMPLEX_DERIVATIVE_CLOG",HAS_COMPLEX_DERIVATIVE_CLOG; "HAS_COMPLEX_DERIVATIVE_CONST",HAS_COMPLEX_DERIVATIVE_CONST; "HAS_COMPLEX_DERIVATIVE_CPOW",HAS_COMPLEX_DERIVATIVE_CPOW; "HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT",HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT; "HAS_COMPLEX_DERIVATIVE_CSIN",HAS_COMPLEX_DERIVATIVE_CSIN; "HAS_COMPLEX_DERIVATIVE_CSQRT",HAS_COMPLEX_DERIVATIVE_CSQRT; "HAS_COMPLEX_DERIVATIVE_CTAN",HAS_COMPLEX_DERIVATIVE_CTAN; "HAS_COMPLEX_DERIVATIVE_DERIVATIVE",HAS_COMPLEX_DERIVATIVE_DERIVATIVE; "HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE",HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; "HAS_COMPLEX_DERIVATIVE_DIV_AT",HAS_COMPLEX_DERIVATIVE_DIV_AT; "HAS_COMPLEX_DERIVATIVE_DIV_WITHIN",HAS_COMPLEX_DERIVATIVE_DIV_WITHIN; "HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE",HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE; "HAS_COMPLEX_DERIVATIVE_ID",HAS_COMPLEX_DERIVATIVE_ID; "HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT",HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; "HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN",HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN; "HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC",HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC; "HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG",HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG; "HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X",HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X; "HAS_COMPLEX_DERIVATIVE_INV_AT",HAS_COMPLEX_DERIVATIVE_INV_AT; "HAS_COMPLEX_DERIVATIVE_INV_BASIC",HAS_COMPLEX_DERIVATIVE_INV_BASIC; "HAS_COMPLEX_DERIVATIVE_INV_WITHIN",HAS_COMPLEX_DERIVATIVE_INV_WITHIN; "HAS_COMPLEX_DERIVATIVE_ITER_1",HAS_COMPLEX_DERIVATIVE_ITER_1; "HAS_COMPLEX_DERIVATIVE_LINEAR",HAS_COMPLEX_DERIVATIVE_LINEAR; "HAS_COMPLEX_DERIVATIVE_LMUL_AT",HAS_COMPLEX_DERIVATIVE_LMUL_AT; "HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN",HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN; "HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE",HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE; "HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE",HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE; "HAS_COMPLEX_DERIVATIVE_MUL_AT",HAS_COMPLEX_DERIVATIVE_MUL_AT; "HAS_COMPLEX_DERIVATIVE_MUL_WITHIN",HAS_COMPLEX_DERIVATIVE_MUL_WITHIN; "HAS_COMPLEX_DERIVATIVE_NEG",HAS_COMPLEX_DERIVATIVE_NEG; "HAS_COMPLEX_DERIVATIVE_POW_AT",HAS_COMPLEX_DERIVATIVE_POW_AT; "HAS_COMPLEX_DERIVATIVE_POW_WITHIN",HAS_COMPLEX_DERIVATIVE_POW_WITHIN; "HAS_COMPLEX_DERIVATIVE_RMUL_AT",HAS_COMPLEX_DERIVATIVE_RMUL_AT; "HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN",HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN; "HAS_COMPLEX_DERIVATIVE_SEQUENCE",HAS_COMPLEX_DERIVATIVE_SEQUENCE; "HAS_COMPLEX_DERIVATIVE_SERIES",HAS_COMPLEX_DERIVATIVE_SERIES; "HAS_COMPLEX_DERIVATIVE_SUB",HAS_COMPLEX_DERIVATIVE_SUB; "HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT",HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT; "HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN",HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN; "HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; "HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT",HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT; "HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE",HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE; "HAS_COMPLEX_DERIVATIVE_VSUM",HAS_COMPLEX_DERIVATIVE_VSUM; "HAS_COMPLEX_DERIVATIVE_WITHIN",HAS_COMPLEX_DERIVATIVE_WITHIN; "HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN",HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; "HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET",HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET; "HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT",HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT; "HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_UNIQUE",HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_UNIQUE; "HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT",HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT; "HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE",HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE; "HAS_COMPLEX_REAL_DERIVATIVE_AT",HAS_COMPLEX_REAL_DERIVATIVE_AT; "HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN",HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN; "HAS_COMPLEX_REAL_DERIVATIVE_WITHIN",HAS_COMPLEX_REAL_DERIVATIVE_WITHIN; "HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN",HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN; "HAS_DERIVATIVE_ADD",HAS_DERIVATIVE_ADD; "HAS_DERIVATIVE_AT",HAS_DERIVATIVE_AT; "HAS_DERIVATIVE_AT_ALT",HAS_DERIVATIVE_AT_ALT; "HAS_DERIVATIVE_AT_REFLECT",HAS_DERIVATIVE_AT_REFLECT; "HAS_DERIVATIVE_AT_WITHIN",HAS_DERIVATIVE_AT_WITHIN; "HAS_DERIVATIVE_BILINEAR_AT",HAS_DERIVATIVE_BILINEAR_AT; "HAS_DERIVATIVE_BILINEAR_WITHIN",HAS_DERIVATIVE_BILINEAR_WITHIN; "HAS_DERIVATIVE_CMUL",HAS_DERIVATIVE_CMUL; "HAS_DERIVATIVE_CMUL_EQ",HAS_DERIVATIVE_CMUL_EQ; "HAS_DERIVATIVE_COMPLEX_CMUL",HAS_DERIVATIVE_COMPLEX_CMUL; "HAS_DERIVATIVE_COMPONENTWISE_AT",HAS_DERIVATIVE_COMPONENTWISE_AT; "HAS_DERIVATIVE_COMPONENTWISE_WITHIN",HAS_DERIVATIVE_COMPONENTWISE_WITHIN; "HAS_DERIVATIVE_CONST",HAS_DERIVATIVE_CONST; "HAS_DERIVATIVE_ID",HAS_DERIVATIVE_ID; "HAS_DERIVATIVE_IMP_DIFFERENTIABLE",HAS_DERIVATIVE_IMP_DIFFERENTIABLE; "HAS_DERIVATIVE_INVERSE",HAS_DERIVATIVE_INVERSE; "HAS_DERIVATIVE_INVERSE_BASIC",HAS_DERIVATIVE_INVERSE_BASIC; "HAS_DERIVATIVE_INVERSE_BASIC_X",HAS_DERIVATIVE_INVERSE_BASIC_X; "HAS_DERIVATIVE_INVERSE_DIEUDONNE",HAS_DERIVATIVE_INVERSE_DIEUDONNE; "HAS_DERIVATIVE_INVERSE_ON",HAS_DERIVATIVE_INVERSE_ON; "HAS_DERIVATIVE_INVERSE_STRONG",HAS_DERIVATIVE_INVERSE_STRONG; "HAS_DERIVATIVE_INVERSE_STRONG_X",HAS_DERIVATIVE_INVERSE_STRONG_X; "HAS_DERIVATIVE_INVERSE_WITHIN",HAS_DERIVATIVE_INVERSE_WITHIN; "HAS_DERIVATIVE_LIFT_COMPONENT",HAS_DERIVATIVE_LIFT_COMPONENT; "HAS_DERIVATIVE_LIFT_DOT",HAS_DERIVATIVE_LIFT_DOT; "HAS_DERIVATIVE_LINEAR",HAS_DERIVATIVE_LINEAR; "HAS_DERIVATIVE_LOCALLY_INJECTIVE",HAS_DERIVATIVE_LOCALLY_INJECTIVE; "HAS_DERIVATIVE_MUL_AT",HAS_DERIVATIVE_MUL_AT; "HAS_DERIVATIVE_MUL_WITHIN",HAS_DERIVATIVE_MUL_WITHIN; "HAS_DERIVATIVE_NEG",HAS_DERIVATIVE_NEG; "HAS_DERIVATIVE_NEG_EQ",HAS_DERIVATIVE_NEG_EQ; "HAS_DERIVATIVE_PASTECART",HAS_DERIVATIVE_PASTECART; "HAS_DERIVATIVE_PASTECART_EQ",HAS_DERIVATIVE_PASTECART_EQ; "HAS_DERIVATIVE_POLAR",HAS_DERIVATIVE_POLAR; "HAS_DERIVATIVE_SEQUENCE",HAS_DERIVATIVE_SEQUENCE; "HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ",HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ; "HAS_DERIVATIVE_SERIES",HAS_DERIVATIVE_SERIES; "HAS_DERIVATIVE_SQNORM_AT",HAS_DERIVATIVE_SQNORM_AT; "HAS_DERIVATIVE_SUB",HAS_DERIVATIVE_SUB; "HAS_DERIVATIVE_TRANSFORM_AT",HAS_DERIVATIVE_TRANSFORM_AT; "HAS_DERIVATIVE_TRANSFORM_WITHIN",HAS_DERIVATIVE_TRANSFORM_WITHIN; "HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN; "HAS_DERIVATIVE_VMUL_COMPONENT",HAS_DERIVATIVE_VMUL_COMPONENT; "HAS_DERIVATIVE_VMUL_DROP",HAS_DERIVATIVE_VMUL_DROP; "HAS_DERIVATIVE_VSUM",HAS_DERIVATIVE_VSUM; "HAS_DERIVATIVE_VSUM_NUMSEG",HAS_DERIVATIVE_VSUM_NUMSEG; "HAS_DERIVATIVE_WITHIN",HAS_DERIVATIVE_WITHIN; "HAS_DERIVATIVE_WITHIN_ALT",HAS_DERIVATIVE_WITHIN_ALT; "HAS_DERIVATIVE_WITHIN_OPEN",HAS_DERIVATIVE_WITHIN_OPEN; "HAS_DERIVATIVE_WITHIN_OPEN_IN",HAS_DERIVATIVE_WITHIN_OPEN_IN; "HAS_DERIVATIVE_WITHIN_REFLECT",HAS_DERIVATIVE_WITHIN_REFLECT; "HAS_DERIVATIVE_WITHIN_SUBSET",HAS_DERIVATIVE_WITHIN_SUBSET; "HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT",HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT; "HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE",HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE; "HAS_DERIVATIVE_ZERO_CONSTANT",HAS_DERIVATIVE_ZERO_CONSTANT; "HAS_DERIVATIVE_ZERO_UNIQUE",HAS_DERIVATIVE_ZERO_UNIQUE; "HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED; "HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX; "HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL; "HAS_DOUBLE_INTEGRAL_CONVOLUTION",HAS_DOUBLE_INTEGRAL_CONVOLUTION; "HAS_DOUBLE_INTEGRAL_PCROSS",HAS_DOUBLE_INTEGRAL_PCROSS; "HAS_FRECHET_DERIVATIVE_UNIQUE_AT",HAS_FRECHET_DERIVATIVE_UNIQUE_AT; "HAS_INTEGRAL",HAS_INTEGRAL; "HAS_INTEGRAL_0",HAS_INTEGRAL_0; "HAS_INTEGRAL_0_EQ",HAS_INTEGRAL_0_EQ; "HAS_INTEGRAL_ADD",HAS_INTEGRAL_ADD; "HAS_INTEGRAL_AFFINITY",HAS_INTEGRAL_AFFINITY; "HAS_INTEGRAL_ALT",HAS_INTEGRAL_ALT; "HAS_INTEGRAL_BOUND",HAS_INTEGRAL_BOUND; "HAS_INTEGRAL_CLOSURE",HAS_INTEGRAL_CLOSURE; "HAS_INTEGRAL_CMUL",HAS_INTEGRAL_CMUL; "HAS_INTEGRAL_COMBINE",HAS_INTEGRAL_COMBINE; "HAS_INTEGRAL_COMBINE_DIVISION",HAS_INTEGRAL_COMBINE_DIVISION; "HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN; "HAS_INTEGRAL_COMBINE_TAGGED_DIVISION",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION; "HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; "HAS_INTEGRAL_COMPLEX_0",HAS_INTEGRAL_COMPLEX_0; "HAS_INTEGRAL_COMPLEX_LMUL",HAS_INTEGRAL_COMPLEX_LMUL; "HAS_INTEGRAL_COMPLEX_RMUL",HAS_INTEGRAL_COMPLEX_RMUL; "HAS_INTEGRAL_COMPONENTWISE",HAS_INTEGRAL_COMPONENTWISE; "HAS_INTEGRAL_COMPONENT_LBOUND",HAS_INTEGRAL_COMPONENT_LBOUND; "HAS_INTEGRAL_COMPONENT_LE",HAS_INTEGRAL_COMPONENT_LE; "HAS_INTEGRAL_COMPONENT_LE_AE",HAS_INTEGRAL_COMPONENT_LE_AE; "HAS_INTEGRAL_COMPONENT_NEG",HAS_INTEGRAL_COMPONENT_NEG; "HAS_INTEGRAL_COMPONENT_POS",HAS_INTEGRAL_COMPONENT_POS; "HAS_INTEGRAL_COMPONENT_UBOUND",HAS_INTEGRAL_COMPONENT_UBOUND; "HAS_INTEGRAL_CONST",HAS_INTEGRAL_CONST; "HAS_INTEGRAL_CONST_GEN",HAS_INTEGRAL_CONST_GEN; "HAS_INTEGRAL_CONVOLUTION_SYM",HAS_INTEGRAL_CONVOLUTION_SYM; "HAS_INTEGRAL_DIFF",HAS_INTEGRAL_DIFF; "HAS_INTEGRAL_DROP_LE",HAS_INTEGRAL_DROP_LE; "HAS_INTEGRAL_DROP_LE_AE",HAS_INTEGRAL_DROP_LE_AE; "HAS_INTEGRAL_DROP_NEG",HAS_INTEGRAL_DROP_NEG; "HAS_INTEGRAL_DROP_POS",HAS_INTEGRAL_DROP_POS; "HAS_INTEGRAL_DROP_POS_AE",HAS_INTEGRAL_DROP_POS_AE; "HAS_INTEGRAL_EMPTY",HAS_INTEGRAL_EMPTY; "HAS_INTEGRAL_EMPTY_EQ",HAS_INTEGRAL_EMPTY_EQ; "HAS_INTEGRAL_EQ",HAS_INTEGRAL_EQ; "HAS_INTEGRAL_EQ_EQ",HAS_INTEGRAL_EQ_EQ; "HAS_INTEGRAL_FACTOR_CONTENT",HAS_INTEGRAL_FACTOR_CONTENT; "HAS_INTEGRAL_INTEGRABLE",HAS_INTEGRAL_INTEGRABLE; "HAS_INTEGRAL_INTEGRABLE_INTEGRAL",HAS_INTEGRAL_INTEGRABLE_INTEGRAL; "HAS_INTEGRAL_INTEGRAL",HAS_INTEGRAL_INTEGRAL; "HAS_INTEGRAL_INTERIOR",HAS_INTEGRAL_INTERIOR; "HAS_INTEGRAL_IS_0",HAS_INTEGRAL_IS_0; "HAS_INTEGRAL_LIM_AT_POSINFINITY",HAS_INTEGRAL_LIM_AT_POSINFINITY; "HAS_INTEGRAL_LIM_AT_POSINFINITY_GEN",HAS_INTEGRAL_LIM_AT_POSINFINITY_GEN; "HAS_INTEGRAL_LIM_SEQUENTIALLY",HAS_INTEGRAL_LIM_SEQUENTIALLY; "HAS_INTEGRAL_LINEAR",HAS_INTEGRAL_LINEAR; "HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE",HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE; "HAS_INTEGRAL_MEASURE_UNDER_CURVE",HAS_INTEGRAL_MEASURE_UNDER_CURVE; "HAS_INTEGRAL_NEG",HAS_INTEGRAL_NEG; "HAS_INTEGRAL_NEGLIGIBLE",HAS_INTEGRAL_NEGLIGIBLE; "HAS_INTEGRAL_NEGLIGIBLE_EQ",HAS_INTEGRAL_NEGLIGIBLE_EQ; "HAS_INTEGRAL_NEGLIGIBLE_EQ_AE",HAS_INTEGRAL_NEGLIGIBLE_EQ_AE; "HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; "HAS_INTEGRAL_NULL",HAS_INTEGRAL_NULL; "HAS_INTEGRAL_NULL_EQ",HAS_INTEGRAL_NULL_EQ; "HAS_INTEGRAL_ON_NEGLIGIBLE",HAS_INTEGRAL_ON_NEGLIGIBLE; "HAS_INTEGRAL_ON_SUPERSET",HAS_INTEGRAL_ON_SUPERSET; "HAS_INTEGRAL_OPEN_INTERVAL",HAS_INTEGRAL_OPEN_INTERVAL; "HAS_INTEGRAL_PASTECART_SYM",HAS_INTEGRAL_PASTECART_SYM; "HAS_INTEGRAL_PASTECART_SYM_ALT",HAS_INTEGRAL_PASTECART_SYM_ALT; "HAS_INTEGRAL_PASTECART_SYM_UNIV",HAS_INTEGRAL_PASTECART_SYM_UNIV; "HAS_INTEGRAL_PATH_INTEGRAL_SUBPATH",HAS_INTEGRAL_PATH_INTEGRAL_SUBPATH; "HAS_INTEGRAL_REFL",HAS_INTEGRAL_REFL; "HAS_INTEGRAL_REFLECT",HAS_INTEGRAL_REFLECT; "HAS_INTEGRAL_REFLECT_GEN",HAS_INTEGRAL_REFLECT_GEN; "HAS_INTEGRAL_REFLECT_LEMMA",HAS_INTEGRAL_REFLECT_LEMMA; "HAS_INTEGRAL_RESTRICT",HAS_INTEGRAL_RESTRICT; "HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL; "HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ; "HAS_INTEGRAL_RESTRICT_INTER",HAS_INTEGRAL_RESTRICT_INTER; "HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL; "HAS_INTEGRAL_RESTRICT_UNIV",HAS_INTEGRAL_RESTRICT_UNIV; "HAS_INTEGRAL_SEPARATE_SIDES",HAS_INTEGRAL_SEPARATE_SIDES; "HAS_INTEGRAL_SPIKE",HAS_INTEGRAL_SPIKE; "HAS_INTEGRAL_SPIKE_EQ",HAS_INTEGRAL_SPIKE_EQ; "HAS_INTEGRAL_SPIKE_FINITE",HAS_INTEGRAL_SPIKE_FINITE; "HAS_INTEGRAL_SPIKE_FINITE_EQ",HAS_INTEGRAL_SPIKE_FINITE_EQ; "HAS_INTEGRAL_SPIKE_INTERIOR",HAS_INTEGRAL_SPIKE_INTERIOR; "HAS_INTEGRAL_SPIKE_INTERIOR_EQ",HAS_INTEGRAL_SPIKE_INTERIOR_EQ; "HAS_INTEGRAL_SPIKE_SET",HAS_INTEGRAL_SPIKE_SET; "HAS_INTEGRAL_SPIKE_SET_EQ",HAS_INTEGRAL_SPIKE_SET_EQ; "HAS_INTEGRAL_SPLIT",HAS_INTEGRAL_SPLIT; "HAS_INTEGRAL_STRADDLE_NULL",HAS_INTEGRAL_STRADDLE_NULL; "HAS_INTEGRAL_STRETCH",HAS_INTEGRAL_STRETCH; "HAS_INTEGRAL_SUB",HAS_INTEGRAL_SUB; "HAS_INTEGRAL_SUBSET_COMPONENT_LE",HAS_INTEGRAL_SUBSET_COMPONENT_LE; "HAS_INTEGRAL_SUBSET_DROP_LE",HAS_INTEGRAL_SUBSET_DROP_LE; "HAS_INTEGRAL_SUBSTITUTION_STRONG",HAS_INTEGRAL_SUBSTITUTION_STRONG; "HAS_INTEGRAL_TRANSLATION",HAS_INTEGRAL_TRANSLATION; "HAS_INTEGRAL_TWIDDLE",HAS_INTEGRAL_TWIDDLE; "HAS_INTEGRAL_TWIDDLE_GEN",HAS_INTEGRAL_TWIDDLE_GEN; "HAS_INTEGRAL_TWIZZLE",HAS_INTEGRAL_TWIZZLE; "HAS_INTEGRAL_TWIZZLE_EQ",HAS_INTEGRAL_TWIZZLE_EQ; "HAS_INTEGRAL_TWIZZLE_INTERVAL",HAS_INTEGRAL_TWIZZLE_INTERVAL; "HAS_INTEGRAL_UNION",HAS_INTEGRAL_UNION; "HAS_INTEGRAL_UNIONS",HAS_INTEGRAL_UNIONS; "HAS_INTEGRAL_UNIONS_IMAGE",HAS_INTEGRAL_UNIONS_IMAGE; "HAS_INTEGRAL_UNIQUE",HAS_INTEGRAL_UNIQUE; "HAS_INTEGRAL_VSUM",HAS_INTEGRAL_VSUM; "HAS_MEASURE",HAS_MEASURE; "HAS_MEASURE_0",HAS_MEASURE_0; "HAS_MEASURE_AFFINITY",HAS_MEASURE_AFFINITY; "HAS_MEASURE_ALMOST",HAS_MEASURE_ALMOST; "HAS_MEASURE_ALMOST_EQ",HAS_MEASURE_ALMOST_EQ; "HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS; "HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED; "HAS_MEASURE_DIFFERENTIABLE_IMAGE",HAS_MEASURE_DIFFERENTIABLE_IMAGE; "HAS_MEASURE_DIFF_NEGLIGIBLE",HAS_MEASURE_DIFF_NEGLIGIBLE; "HAS_MEASURE_DIFF_NEGLIGIBLE_EQ",HAS_MEASURE_DIFF_NEGLIGIBLE_EQ; "HAS_MEASURE_DIFF_SUBSET",HAS_MEASURE_DIFF_SUBSET; "HAS_MEASURE_DISJOINT_UNION",HAS_MEASURE_DISJOINT_UNION; "HAS_MEASURE_DISJOINT_UNIONS",HAS_MEASURE_DISJOINT_UNIONS; "HAS_MEASURE_DISJOINT_UNIONS_IMAGE",HAS_MEASURE_DISJOINT_UNIONS_IMAGE; "HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; "HAS_MEASURE_ELEMENTARY",HAS_MEASURE_ELEMENTARY; "HAS_MEASURE_EMPTY",HAS_MEASURE_EMPTY; "HAS_MEASURE_IMAGE_STD_SIMPLEX",HAS_MEASURE_IMAGE_STD_SIMPLEX; "HAS_MEASURE_IMP_MEASURABLE",HAS_MEASURE_IMP_MEASURABLE; "HAS_MEASURE_INNER_OUTER",HAS_MEASURE_INNER_OUTER; "HAS_MEASURE_INNER_OUTER_LE",HAS_MEASURE_INNER_OUTER_LE; "HAS_MEASURE_INTERVAL",HAS_MEASURE_INTERVAL; "HAS_MEASURE_ISOMETRY",HAS_MEASURE_ISOMETRY; "HAS_MEASURE_LIMIT",HAS_MEASURE_LIMIT; "HAS_MEASURE_LINEAR_IMAGE",HAS_MEASURE_LINEAR_IMAGE; "HAS_MEASURE_LINEAR_IMAGE_ALT",HAS_MEASURE_LINEAR_IMAGE_ALT; "HAS_MEASURE_LINEAR_IMAGE_SAME",HAS_MEASURE_LINEAR_IMAGE_SAME; "HAS_MEASURE_LINEAR_SUFFICIENT",HAS_MEASURE_LINEAR_SUFFICIENT; "HAS_MEASURE_MEASURABLE_MEASURE",HAS_MEASURE_MEASURABLE_MEASURE; "HAS_MEASURE_MEASURE",HAS_MEASURE_MEASURE; "HAS_MEASURE_NEGLIGIBLE_SYMDIFF",HAS_MEASURE_NEGLIGIBLE_SYMDIFF; "HAS_MEASURE_NEGLIGIBLE_UNION",HAS_MEASURE_NEGLIGIBLE_UNION; "HAS_MEASURE_NEGLIGIBLE_UNIONS",HAS_MEASURE_NEGLIGIBLE_UNIONS; "HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE; "HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; "HAS_MEASURE_NESTED_INTERS",HAS_MEASURE_NESTED_INTERS; "HAS_MEASURE_NESTED_UNIONS",HAS_MEASURE_NESTED_UNIONS; "HAS_MEASURE_ORTHOGONAL_IMAGE",HAS_MEASURE_ORTHOGONAL_IMAGE; "HAS_MEASURE_ORTHOGONAL_IMAGE_EQ",HAS_MEASURE_ORTHOGONAL_IMAGE_EQ; "HAS_MEASURE_PCROSS",HAS_MEASURE_PCROSS; "HAS_MEASURE_POS_LE",HAS_MEASURE_POS_LE; "HAS_MEASURE_SCALING",HAS_MEASURE_SCALING; "HAS_MEASURE_SCALING_EQ",HAS_MEASURE_SCALING_EQ; "HAS_MEASURE_SHEAR_INTERVAL",HAS_MEASURE_SHEAR_INTERVAL; "HAS_MEASURE_SIMPLEX",HAS_MEASURE_SIMPLEX; "HAS_MEASURE_SIMPLEX_0",HAS_MEASURE_SIMPLEX_0; "HAS_MEASURE_STD_SIMPLEX",HAS_MEASURE_STD_SIMPLEX; "HAS_MEASURE_STRETCH",HAS_MEASURE_STRETCH; "HAS_MEASURE_SUBSET",HAS_MEASURE_SUBSET; "HAS_MEASURE_TETRAHEDRON",HAS_MEASURE_TETRAHEDRON; "HAS_MEASURE_TRANSLATION",HAS_MEASURE_TRANSLATION; "HAS_MEASURE_TRANSLATION_EQ",HAS_MEASURE_TRANSLATION_EQ; "HAS_MEASURE_TRIANGLE",HAS_MEASURE_TRIANGLE; "HAS_MEASURE_UNION_NEGLIGIBLE",HAS_MEASURE_UNION_NEGLIGIBLE; "HAS_MEASURE_UNION_NEGLIGIBLE_EQ",HAS_MEASURE_UNION_NEGLIGIBLE_EQ; "HAS_MEASURE_UNIQUE",HAS_MEASURE_UNIQUE; "HAS_PATH_INTEGRAL",HAS_PATH_INTEGRAL; "HAS_PATH_INTEGRAL_0",HAS_PATH_INTEGRAL_0; "HAS_PATH_INTEGRAL_ADD",HAS_PATH_INTEGRAL_ADD; "HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH",HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH; "HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH_STRONG",HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH_STRONG; "HAS_PATH_INTEGRAL_BOUND_LINEPATH",HAS_PATH_INTEGRAL_BOUND_LINEPATH; "HAS_PATH_INTEGRAL_BOUND_LINEPATH_STRONG",HAS_PATH_INTEGRAL_BOUND_LINEPATH_STRONG; "HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH",HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH; "HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG",HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG; "HAS_PATH_INTEGRAL_COMPLEX_DIV",HAS_PATH_INTEGRAL_COMPLEX_DIV; "HAS_PATH_INTEGRAL_COMPLEX_LMUL",HAS_PATH_INTEGRAL_COMPLEX_LMUL; "HAS_PATH_INTEGRAL_COMPLEX_RMUL",HAS_PATH_INTEGRAL_COMPLEX_RMUL; "HAS_PATH_INTEGRAL_CONST_LINEPATH",HAS_PATH_INTEGRAL_CONST_LINEPATH; "HAS_PATH_INTEGRAL_EQ",HAS_PATH_INTEGRAL_EQ; "HAS_PATH_INTEGRAL_INTEGRABLE",HAS_PATH_INTEGRAL_INTEGRABLE; "HAS_PATH_INTEGRAL_INTEGRABLE_INTEGRAL",HAS_PATH_INTEGRAL_INTEGRABLE_INTEGRAL; "HAS_PATH_INTEGRAL_INTEGRAL",HAS_PATH_INTEGRAL_INTEGRAL; "HAS_PATH_INTEGRAL_IS_0",HAS_PATH_INTEGRAL_IS_0; "HAS_PATH_INTEGRAL_JOIN",HAS_PATH_INTEGRAL_JOIN; "HAS_PATH_INTEGRAL_LINEPATH",HAS_PATH_INTEGRAL_LINEPATH; "HAS_PATH_INTEGRAL_MIDPOINT",HAS_PATH_INTEGRAL_MIDPOINT; "HAS_PATH_INTEGRAL_NEG",HAS_PATH_INTEGRAL_NEG; "HAS_PATH_INTEGRAL_REVERSEPATH",HAS_PATH_INTEGRAL_REVERSEPATH; "HAS_PATH_INTEGRAL_REVERSE_LINEPATH",HAS_PATH_INTEGRAL_REVERSE_LINEPATH; "HAS_PATH_INTEGRAL_SHIFTPATH",HAS_PATH_INTEGRAL_SHIFTPATH; "HAS_PATH_INTEGRAL_SHIFTPATH_EQ",HAS_PATH_INTEGRAL_SHIFTPATH_EQ; "HAS_PATH_INTEGRAL_SPLIT",HAS_PATH_INTEGRAL_SPLIT; "HAS_PATH_INTEGRAL_SUB",HAS_PATH_INTEGRAL_SUB; "HAS_PATH_INTEGRAL_SUBPATH",HAS_PATH_INTEGRAL_SUBPATH; "HAS_PATH_INTEGRAL_SUBPATH_REFL",HAS_PATH_INTEGRAL_SUBPATH_REFL; "HAS_PATH_INTEGRAL_TRIVIAL",HAS_PATH_INTEGRAL_TRIVIAL; "HAS_PATH_INTEGRAL_UNIQUE",HAS_PATH_INTEGRAL_UNIQUE; "HAS_PATH_INTEGRAL_VSUM",HAS_PATH_INTEGRAL_VSUM; "HAS_PATH_INTEGRAL_WINDING_NUMBER",HAS_PATH_INTEGRAL_WINDING_NUMBER; "HAS_REAL_COMPLEX_DERIVATIVE_AT",HAS_REAL_COMPLEX_DERIVATIVE_AT; "HAS_REAL_COMPLEX_DERIVATIVE_WITHIN",HAS_REAL_COMPLEX_DERIVATIVE_WITHIN; "HAS_REAL_DERIVATIVE_ACS",HAS_REAL_DERIVATIVE_ACS; "HAS_REAL_DERIVATIVE_ACS_SIN",HAS_REAL_DERIVATIVE_ACS_SIN; "HAS_REAL_DERIVATIVE_ADD",HAS_REAL_DERIVATIVE_ADD; "HAS_REAL_DERIVATIVE_ASN",HAS_REAL_DERIVATIVE_ASN; "HAS_REAL_DERIVATIVE_ASN_COS",HAS_REAL_DERIVATIVE_ASN_COS; "HAS_REAL_DERIVATIVE_ATN",HAS_REAL_DERIVATIVE_ATN; "HAS_REAL_DERIVATIVE_ATREAL",HAS_REAL_DERIVATIVE_ATREAL; "HAS_REAL_DERIVATIVE_ATREAL_WITHIN",HAS_REAL_DERIVATIVE_ATREAL_WITHIN; "HAS_REAL_DERIVATIVE_BERNOULLI",HAS_REAL_DERIVATIVE_BERNOULLI; "HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL",HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL; "HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL",HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL; "HAS_REAL_DERIVATIVE_CDIV_ATREAL",HAS_REAL_DERIVATIVE_CDIV_ATREAL; "HAS_REAL_DERIVATIVE_CDIV_WITHIN",HAS_REAL_DERIVATIVE_CDIV_WITHIN; "HAS_REAL_DERIVATIVE_CHAIN",HAS_REAL_DERIVATIVE_CHAIN; "HAS_REAL_DERIVATIVE_CHAIN_UNIV",HAS_REAL_DERIVATIVE_CHAIN_UNIV; "HAS_REAL_DERIVATIVE_CONST",HAS_REAL_DERIVATIVE_CONST; "HAS_REAL_DERIVATIVE_COS",HAS_REAL_DERIVATIVE_COS; "HAS_REAL_DERIVATIVE_DERIVATIVE",HAS_REAL_DERIVATIVE_DERIVATIVE; "HAS_REAL_DERIVATIVE_DIFFERENTIABLE",HAS_REAL_DERIVATIVE_DIFFERENTIABLE; "HAS_REAL_DERIVATIVE_DIV_ATREAL",HAS_REAL_DERIVATIVE_DIV_ATREAL; "HAS_REAL_DERIVATIVE_DIV_WITHIN",HAS_REAL_DERIVATIVE_DIV_WITHIN; "HAS_REAL_DERIVATIVE_EXP",HAS_REAL_DERIVATIVE_EXP; "HAS_REAL_DERIVATIVE_FRAC",HAS_REAL_DERIVATIVE_FRAC; "HAS_REAL_DERIVATIVE_FROM_COMPLEX_AT",HAS_REAL_DERIVATIVE_FROM_COMPLEX_AT; "HAS_REAL_DERIVATIVE_ID",HAS_REAL_DERIVATIVE_ID; "HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL",HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL; "HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL",HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL; "HAS_REAL_DERIVATIVE_INCREASING",HAS_REAL_DERIVATIVE_INCREASING; "HAS_REAL_DERIVATIVE_INCREASING_IMP",HAS_REAL_DERIVATIVE_INCREASING_IMP; "HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL",HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL; "HAS_REAL_DERIVATIVE_INVERSE_BASIC",HAS_REAL_DERIVATIVE_INVERSE_BASIC; "HAS_REAL_DERIVATIVE_INVERSE_STRONG",HAS_REAL_DERIVATIVE_INVERSE_STRONG; "HAS_REAL_DERIVATIVE_INVERSE_STRONG_X",HAS_REAL_DERIVATIVE_INVERSE_STRONG_X; "HAS_REAL_DERIVATIVE_INV_ATREAL",HAS_REAL_DERIVATIVE_INV_ATREAL; "HAS_REAL_DERIVATIVE_INV_BASIC",HAS_REAL_DERIVATIVE_INV_BASIC; "HAS_REAL_DERIVATIVE_INV_WITHIN",HAS_REAL_DERIVATIVE_INV_WITHIN; "HAS_REAL_DERIVATIVE_LMUL_ATREAL",HAS_REAL_DERIVATIVE_LMUL_ATREAL; "HAS_REAL_DERIVATIVE_LMUL_WITHIN",HAS_REAL_DERIVATIVE_LMUL_WITHIN; "HAS_REAL_DERIVATIVE_LOG",HAS_REAL_DERIVATIVE_LOG; "HAS_REAL_DERIVATIVE_MUL_ATREAL",HAS_REAL_DERIVATIVE_MUL_ATREAL; "HAS_REAL_DERIVATIVE_MUL_WITHIN",HAS_REAL_DERIVATIVE_MUL_WITHIN; "HAS_REAL_DERIVATIVE_NEG",HAS_REAL_DERIVATIVE_NEG; "HAS_REAL_DERIVATIVE_POW_ATREAL",HAS_REAL_DERIVATIVE_POW_ATREAL; "HAS_REAL_DERIVATIVE_POW_WITHIN",HAS_REAL_DERIVATIVE_POW_WITHIN; "HAS_REAL_DERIVATIVE_RMUL_ATREAL",HAS_REAL_DERIVATIVE_RMUL_ATREAL; "HAS_REAL_DERIVATIVE_RMUL_WITHIN",HAS_REAL_DERIVATIVE_RMUL_WITHIN; "HAS_REAL_DERIVATIVE_RPOW",HAS_REAL_DERIVATIVE_RPOW; "HAS_REAL_DERIVATIVE_RPOW_RIGHT",HAS_REAL_DERIVATIVE_RPOW_RIGHT; "HAS_REAL_DERIVATIVE_SEQUENCE",HAS_REAL_DERIVATIVE_SEQUENCE; "HAS_REAL_DERIVATIVE_SERIES",HAS_REAL_DERIVATIVE_SERIES; "HAS_REAL_DERIVATIVE_SIN",HAS_REAL_DERIVATIVE_SIN; "HAS_REAL_DERIVATIVE_SQRT",HAS_REAL_DERIVATIVE_SQRT; "HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP",HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP; "HAS_REAL_DERIVATIVE_SUB",HAS_REAL_DERIVATIVE_SUB; "HAS_REAL_DERIVATIVE_SUM",HAS_REAL_DERIVATIVE_SUM; "HAS_REAL_DERIVATIVE_TAN",HAS_REAL_DERIVATIVE_TAN; "HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL",HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL; "HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN",HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN; "HAS_REAL_DERIVATIVE_WITHINREAL",HAS_REAL_DERIVATIVE_WITHINREAL; "HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN",HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN; "HAS_REAL_DERIVATIVE_WITHIN_SUBSET",HAS_REAL_DERIVATIVE_WITHIN_SUBSET; "HAS_REAL_DERIVATIVE_ZERO_CONSTANT",HAS_REAL_DERIVATIVE_ZERO_CONSTANT; "HAS_REAL_DERIVATIVE_ZERO_UNIQUE",HAS_REAL_DERIVATIVE_ZERO_UNIQUE; "HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX",HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX; "HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL",HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL; "HAS_REAL_FRECHET_DERIVATIVE_AT",HAS_REAL_FRECHET_DERIVATIVE_AT; "HAS_REAL_FRECHET_DERIVATIVE_WITHIN",HAS_REAL_FRECHET_DERIVATIVE_WITHIN; "HAS_REAL_INTEGRAL",HAS_REAL_INTEGRAL; "HAS_REAL_INTEGRAL_0",HAS_REAL_INTEGRAL_0; "HAS_REAL_INTEGRAL_0_EQ",HAS_REAL_INTEGRAL_0_EQ; "HAS_REAL_INTEGRAL_ADD",HAS_REAL_INTEGRAL_ADD; "HAS_REAL_INTEGRAL_AFFINITY",HAS_REAL_INTEGRAL_AFFINITY; "HAS_REAL_INTEGRAL_ALT",HAS_REAL_INTEGRAL_ALT; "HAS_REAL_INTEGRAL_BERNOULLI",HAS_REAL_INTEGRAL_BERNOULLI; "HAS_REAL_INTEGRAL_BOUND",HAS_REAL_INTEGRAL_BOUND; "HAS_REAL_INTEGRAL_COMBINE",HAS_REAL_INTEGRAL_COMBINE; "HAS_REAL_INTEGRAL_CONST",HAS_REAL_INTEGRAL_CONST; "HAS_REAL_INTEGRAL_EMPTY",HAS_REAL_INTEGRAL_EMPTY; "HAS_REAL_INTEGRAL_EMPTY_EQ",HAS_REAL_INTEGRAL_EMPTY_EQ; "HAS_REAL_INTEGRAL_EQ",HAS_REAL_INTEGRAL_EQ; "HAS_REAL_INTEGRAL_EQ_EQ",HAS_REAL_INTEGRAL_EQ_EQ; "HAS_REAL_INTEGRAL_INTEGRABLE",HAS_REAL_INTEGRAL_INTEGRABLE; "HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL",HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL; "HAS_REAL_INTEGRAL_INTEGRAL",HAS_REAL_INTEGRAL_INTEGRAL; "HAS_REAL_INTEGRAL_ISNEG",HAS_REAL_INTEGRAL_ISNEG; "HAS_REAL_INTEGRAL_IS_0",HAS_REAL_INTEGRAL_IS_0; "HAS_REAL_INTEGRAL_LBOUND",HAS_REAL_INTEGRAL_LBOUND; "HAS_REAL_INTEGRAL_LE",HAS_REAL_INTEGRAL_LE; "HAS_REAL_INTEGRAL_LINEAR",HAS_REAL_INTEGRAL_LINEAR; "HAS_REAL_INTEGRAL_LMUL",HAS_REAL_INTEGRAL_LMUL; "HAS_REAL_INTEGRAL_NEG",HAS_REAL_INTEGRAL_NEG; "HAS_REAL_INTEGRAL_NEGLIGIBLE",HAS_REAL_INTEGRAL_NEGLIGIBLE; "HAS_REAL_INTEGRAL_NEGLIGIBLE_EQ",HAS_REAL_INTEGRAL_NEGLIGIBLE_EQ; "HAS_REAL_INTEGRAL_NULL",HAS_REAL_INTEGRAL_NULL; "HAS_REAL_INTEGRAL_NULL_EQ",HAS_REAL_INTEGRAL_NULL_EQ; "HAS_REAL_INTEGRAL_ON_SUPERSET",HAS_REAL_INTEGRAL_ON_SUPERSET; "HAS_REAL_INTEGRAL_OPEN_INTERVAL",HAS_REAL_INTEGRAL_OPEN_INTERVAL; "HAS_REAL_INTEGRAL_POS",HAS_REAL_INTEGRAL_POS; "HAS_REAL_INTEGRAL_REFL",HAS_REAL_INTEGRAL_REFL; "HAS_REAL_INTEGRAL_REFLECT",HAS_REAL_INTEGRAL_REFLECT; "HAS_REAL_INTEGRAL_REFLECT_GEN",HAS_REAL_INTEGRAL_REFLECT_GEN; "HAS_REAL_INTEGRAL_REFLECT_LEMMA",HAS_REAL_INTEGRAL_REFLECT_LEMMA; "HAS_REAL_INTEGRAL_RESTRICT",HAS_REAL_INTEGRAL_RESTRICT; "HAS_REAL_INTEGRAL_RESTRICT_INTER",HAS_REAL_INTEGRAL_RESTRICT_INTER; "HAS_REAL_INTEGRAL_RESTRICT_UNIV",HAS_REAL_INTEGRAL_RESTRICT_UNIV; "HAS_REAL_INTEGRAL_RMUL",HAS_REAL_INTEGRAL_RMUL; "HAS_REAL_INTEGRAL_SPIKE",HAS_REAL_INTEGRAL_SPIKE; "HAS_REAL_INTEGRAL_SPIKE_EQ",HAS_REAL_INTEGRAL_SPIKE_EQ; "HAS_REAL_INTEGRAL_SPIKE_FINITE",HAS_REAL_INTEGRAL_SPIKE_FINITE; "HAS_REAL_INTEGRAL_SPIKE_FINITE_EQ",HAS_REAL_INTEGRAL_SPIKE_FINITE_EQ; "HAS_REAL_INTEGRAL_SPIKE_INTERIOR",HAS_REAL_INTEGRAL_SPIKE_INTERIOR; "HAS_REAL_INTEGRAL_SPIKE_INTERIOR_EQ",HAS_REAL_INTEGRAL_SPIKE_INTERIOR_EQ; "HAS_REAL_INTEGRAL_SPIKE_SET",HAS_REAL_INTEGRAL_SPIKE_SET; "HAS_REAL_INTEGRAL_SPIKE_SET_EQ",HAS_REAL_INTEGRAL_SPIKE_SET_EQ; "HAS_REAL_INTEGRAL_STRADDLE_NULL",HAS_REAL_INTEGRAL_STRADDLE_NULL; "HAS_REAL_INTEGRAL_STRETCH",HAS_REAL_INTEGRAL_STRETCH; "HAS_REAL_INTEGRAL_SUB",HAS_REAL_INTEGRAL_SUB; "HAS_REAL_INTEGRAL_SUBSET_LE",HAS_REAL_INTEGRAL_SUBSET_LE; "HAS_REAL_INTEGRAL_SUBSTITUTION",HAS_REAL_INTEGRAL_SUBSTITUTION; "HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE",HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE; "HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG",HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG; "HAS_REAL_INTEGRAL_SUM",HAS_REAL_INTEGRAL_SUM; "HAS_REAL_INTEGRAL_UBOUND",HAS_REAL_INTEGRAL_UBOUND; "HAS_REAL_INTEGRAL_UNION",HAS_REAL_INTEGRAL_UNION; "HAS_REAL_INTEGRAL_UNIONS",HAS_REAL_INTEGRAL_UNIONS; "HAS_REAL_INTEGRAL_UNIQUE",HAS_REAL_INTEGRAL_UNIQUE; "HAS_REAL_MEASURE",HAS_REAL_MEASURE; "HAS_REAL_MEASURE_0",HAS_REAL_MEASURE_0; "HAS_REAL_MEASURE_AFFINITY",HAS_REAL_MEASURE_AFFINITY; "HAS_REAL_MEASURE_ALMOST",HAS_REAL_MEASURE_ALMOST; "HAS_REAL_MEASURE_ALMOST_EQ",HAS_REAL_MEASURE_ALMOST_EQ; "HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS",HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS; "HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS_BOUNDED",HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS_BOUNDED; "HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE",HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE; "HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE_EQ",HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE_EQ; "HAS_REAL_MEASURE_DIFF_SUBSET",HAS_REAL_MEASURE_DIFF_SUBSET; "HAS_REAL_MEASURE_DISJOINT_UNION",HAS_REAL_MEASURE_DISJOINT_UNION; "HAS_REAL_MEASURE_DISJOINT_UNIONS",HAS_REAL_MEASURE_DISJOINT_UNIONS; "HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE",HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE; "HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; "HAS_REAL_MEASURE_EMPTY",HAS_REAL_MEASURE_EMPTY; "HAS_REAL_MEASURE_HAS_MEASURE",HAS_REAL_MEASURE_HAS_MEASURE; "HAS_REAL_MEASURE_IMP_REAL_MEASURABLE",HAS_REAL_MEASURE_IMP_REAL_MEASURABLE; "HAS_REAL_MEASURE_INNER_OUTER",HAS_REAL_MEASURE_INNER_OUTER; "HAS_REAL_MEASURE_INNER_OUTER_LE",HAS_REAL_MEASURE_INNER_OUTER_LE; "HAS_REAL_MEASURE_MEASURE",HAS_REAL_MEASURE_MEASURE; "HAS_REAL_MEASURE_NESTED_UNIONS",HAS_REAL_MEASURE_NESTED_UNIONS; "HAS_REAL_MEASURE_POS_LE",HAS_REAL_MEASURE_POS_LE; "HAS_REAL_MEASURE_REAL_INTERVAL",HAS_REAL_MEASURE_REAL_INTERVAL; "HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE",HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE; "HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF; "HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION; "HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS; "HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE; "HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG; "HAS_REAL_MEASURE_SCALING",HAS_REAL_MEASURE_SCALING; "HAS_REAL_MEASURE_SCALING_EQ",HAS_REAL_MEASURE_SCALING_EQ; "HAS_REAL_MEASURE_SUBSET",HAS_REAL_MEASURE_SUBSET; "HAS_REAL_MEASURE_TRANSLATION",HAS_REAL_MEASURE_TRANSLATION; "HAS_REAL_MEASURE_TRANSLATION_EQ",HAS_REAL_MEASURE_TRANSLATION_EQ; "HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE",HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE; "HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE_EQ",HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE_EQ; "HAS_REAL_MEASURE_UNIQUE",HAS_REAL_MEASURE_UNIQUE; "HAS_REAL_VECTOR_DERIVATIVE_AT",HAS_REAL_VECTOR_DERIVATIVE_AT; "HAS_REAL_VECTOR_DERIVATIVE_WITHIN",HAS_REAL_VECTOR_DERIVATIVE_WITHIN; "HAS_RESIDUE_INTEGRAL",HAS_RESIDUE_INTEGRAL; "HAS_RESIDUE_INTEGRAL_INTEGER",HAS_RESIDUE_INTEGRAL_INTEGER; "HAS_SIZE",HAS_SIZE; "HAS_SIZE_0",HAS_SIZE_0; "HAS_SIZE_1",HAS_SIZE_1; "HAS_SIZE_1_EXISTS",HAS_SIZE_1_EXISTS; "HAS_SIZE_2",HAS_SIZE_2; "HAS_SIZE_2_EXISTS",HAS_SIZE_2_EXISTS; "HAS_SIZE_3",HAS_SIZE_3; "HAS_SIZE_4",HAS_SIZE_4; "HAS_SIZE_BOOL",HAS_SIZE_BOOL; "HAS_SIZE_CARD",HAS_SIZE_CARD; "HAS_SIZE_CART",HAS_SIZE_CART; "HAS_SIZE_CART_UNIV",HAS_SIZE_CART_UNIV; "HAS_SIZE_CLAUSES",HAS_SIZE_CLAUSES; "HAS_SIZE_COMPLEX_ROOTS_UNITY",HAS_SIZE_COMPLEX_ROOTS_UNITY; "HAS_SIZE_CROSS",HAS_SIZE_CROSS; "HAS_SIZE_DIFF",HAS_SIZE_DIFF; "HAS_SIZE_FACES_OF_SIMPLEX",HAS_SIZE_FACES_OF_SIMPLEX; "HAS_SIZE_FINITE_IMAGE",HAS_SIZE_FINITE_IMAGE; "HAS_SIZE_FUNSPACE",HAS_SIZE_FUNSPACE; "HAS_SIZE_FUNSPACE_UNIV",HAS_SIZE_FUNSPACE_UNIV; "HAS_SIZE_IMAGE_INJ",HAS_SIZE_IMAGE_INJ; "HAS_SIZE_IMAGE_INJ_EQ",HAS_SIZE_IMAGE_INJ_EQ; "HAS_SIZE_INDEX",HAS_SIZE_INDEX; "HAS_SIZE_INTER_SPHERE_1",HAS_SIZE_INTER_SPHERE_1; "HAS_SIZE_INTSEG_INT",HAS_SIZE_INTSEG_INT; "HAS_SIZE_INTSEG_NUM",HAS_SIZE_INTSEG_NUM; "HAS_SIZE_MULTIVECTOR",HAS_SIZE_MULTIVECTOR; "HAS_SIZE_NUMSEG",HAS_SIZE_NUMSEG; "HAS_SIZE_NUMSEG_1",HAS_SIZE_NUMSEG_1; "HAS_SIZE_NUMSEG_LE",HAS_SIZE_NUMSEG_LE; "HAS_SIZE_NUMSEG_LT",HAS_SIZE_NUMSEG_LT; "HAS_SIZE_PCROSS",HAS_SIZE_PCROSS; "HAS_SIZE_PERMUTATIONS",HAS_SIZE_PERMUTATIONS; "HAS_SIZE_POWERSET",HAS_SIZE_POWERSET; "HAS_SIZE_PRODUCT",HAS_SIZE_PRODUCT; "HAS_SIZE_PRODUCT_DEPENDENT",HAS_SIZE_PRODUCT_DEPENDENT; "HAS_SIZE_SET_OF_LIST",HAS_SIZE_SET_OF_LIST; "HAS_SIZE_SPHERE_1",HAS_SIZE_SPHERE_1; "HAS_SIZE_SPHERE_2",HAS_SIZE_SPHERE_2; "HAS_SIZE_STDBASIS",HAS_SIZE_STDBASIS; "HAS_SIZE_SUC",HAS_SIZE_SUC; "HAS_SIZE_UNION",HAS_SIZE_UNION; "HAS_SIZE_UNIONS",HAS_SIZE_UNIONS; "HAS_VECTOR_DERIVATIVE_ADD",HAS_VECTOR_DERIVATIVE_ADD; "HAS_VECTOR_DERIVATIVE_AT_1D",HAS_VECTOR_DERIVATIVE_AT_1D; "HAS_VECTOR_DERIVATIVE_AT_WITHIN",HAS_VECTOR_DERIVATIVE_AT_WITHIN; "HAS_VECTOR_DERIVATIVE_BILINEAR_AT",HAS_VECTOR_DERIVATIVE_BILINEAR_AT; "HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN",HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN; "HAS_VECTOR_DERIVATIVE_CIRCLEPATH",HAS_VECTOR_DERIVATIVE_CIRCLEPATH; "HAS_VECTOR_DERIVATIVE_CMUL",HAS_VECTOR_DERIVATIVE_CMUL; "HAS_VECTOR_DERIVATIVE_CMUL_EQ",HAS_VECTOR_DERIVATIVE_CMUL_EQ; "HAS_VECTOR_DERIVATIVE_CONST",HAS_VECTOR_DERIVATIVE_CONST; "HAS_VECTOR_DERIVATIVE_ID",HAS_VECTOR_DERIVATIVE_ID; "HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE",HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE; "HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL",HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL; "HAS_VECTOR_DERIVATIVE_LINEPATH_AT",HAS_VECTOR_DERIVATIVE_LINEPATH_AT; "HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN",HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN; "HAS_VECTOR_DERIVATIVE_NEG",HAS_VECTOR_DERIVATIVE_NEG; "HAS_VECTOR_DERIVATIVE_NEG_EQ",HAS_VECTOR_DERIVATIVE_NEG_EQ; "HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH",HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH; "HAS_VECTOR_DERIVATIVE_REAL_COMPLEX",HAS_VECTOR_DERIVATIVE_REAL_COMPLEX; "HAS_VECTOR_DERIVATIVE_SUB",HAS_VECTOR_DERIVATIVE_SUB; "HAS_VECTOR_DERIVATIVE_TRANSFORM_AT",HAS_VECTOR_DERIVATIVE_TRANSFORM_AT; "HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN; "HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN; "HAS_VECTOR_DERIVATIVE_UNIQUE_AT",HAS_VECTOR_DERIVATIVE_UNIQUE_AT; "HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION",HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION; "HAS_VECTOR_DERIVATIVE_WITHIN_1D",HAS_VECTOR_DERIVATIVE_WITHIN_1D; "HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET",HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET; "HAUSDIST_ALT",HAUSDIST_ALT; "HAUSDIST_BALLS",HAUSDIST_BALLS; "HAUSDIST_CLOSURE",HAUSDIST_CLOSURE; "HAUSDIST_COMPACT_EXISTS",HAUSDIST_COMPACT_EXISTS; "HAUSDIST_COMPACT_INTERS_LIMIT",HAUSDIST_COMPACT_INTERS_LIMIT; "HAUSDIST_COMPACT_NONTRIVIAL",HAUSDIST_COMPACT_NONTRIVIAL; "HAUSDIST_COMPACT_SUMS",HAUSDIST_COMPACT_SUMS; "HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT",HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT; "HAUSDIST_COMPLEMENTS_CONVEX_LE",HAUSDIST_COMPLEMENTS_CONVEX_LE; "HAUSDIST_CONVEX_HULLS",HAUSDIST_CONVEX_HULLS; "HAUSDIST_EMPTY",HAUSDIST_EMPTY; "HAUSDIST_EQ",HAUSDIST_EQ; "HAUSDIST_EQ_0",HAUSDIST_EQ_0; "HAUSDIST_FRONTIERS_CONVEX",HAUSDIST_FRONTIERS_CONVEX; "HAUSDIST_INSERT_LE",HAUSDIST_INSERT_LE; "HAUSDIST_LINEAR_IMAGE",HAUSDIST_LINEAR_IMAGE; "HAUSDIST_NONTRIVIAL",HAUSDIST_NONTRIVIAL; "HAUSDIST_NONTRIVIAL_ALT",HAUSDIST_NONTRIVIAL_ALT; "HAUSDIST_POS_LE",HAUSDIST_POS_LE; "HAUSDIST_POS_LT",HAUSDIST_POS_LT; "HAUSDIST_REFL",HAUSDIST_REFL; "HAUSDIST_RELATIVE_INTERIOR",HAUSDIST_RELATIVE_INTERIOR; "HAUSDIST_SCALING",HAUSDIST_SCALING; "HAUSDIST_SETDIST_TRIANGLE",HAUSDIST_SETDIST_TRIANGLE; "HAUSDIST_SINGS",HAUSDIST_SINGS; "HAUSDIST_STILL_INSIDE",HAUSDIST_STILL_INSIDE; "HAUSDIST_STILL_INSIDE_INTERIOR",HAUSDIST_STILL_INSIDE_INTERIOR; "HAUSDIST_STILL_NONEMPTY_INTERIOR",HAUSDIST_STILL_NONEMPTY_INTERIOR; "HAUSDIST_STILL_OUTSIDE",HAUSDIST_STILL_OUTSIDE; "HAUSDIST_STILL_SAME_PLACE",HAUSDIST_STILL_SAME_PLACE; "HAUSDIST_STILL_SAME_PLACE_CONIC_HULL",HAUSDIST_STILL_SAME_PLACE_CONIC_HULL; "HAUSDIST_STILL_SAME_PLACE_CONIC_HULL_STRONG",HAUSDIST_STILL_SAME_PLACE_CONIC_HULL_STRONG; "HAUSDIST_STILL_SAME_PLACE_STRONG",HAUSDIST_STILL_SAME_PLACE_STRONG; "HAUSDIST_SUMS",HAUSDIST_SUMS; "HAUSDIST_SUMS_LE",HAUSDIST_SUMS_LE; "HAUSDIST_SUMS_LE_LCANCEL",HAUSDIST_SUMS_LE_LCANCEL; "HAUSDIST_SUMS_LE_RCANCEL",HAUSDIST_SUMS_LE_RCANCEL; "HAUSDIST_SYM",HAUSDIST_SYM; "HAUSDIST_TRANS",HAUSDIST_TRANS; "HAUSDIST_TRANSLATION",HAUSDIST_TRANSLATION; "HAUSDIST_TRIANGLE",HAUSDIST_TRIANGLE; "HAUSDIST_UNIFORMLY_CONTINUOUS_ON",HAUSDIST_UNIFORMLY_CONTINUOUS_ON; "HAUSDIST_UNION_LE",HAUSDIST_UNION_LE; "HD",HD; "HD_APPEND",HD_APPEND; "HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS",HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS; "HEINE_BOREL_LEMMA",HEINE_BOREL_LEMMA; "HELLY",HELLY; "HELLY_ALT",HELLY_ALT; "HELLY_CLOSED",HELLY_CLOSED; "HELLY_CLOSED_ALT",HELLY_CLOSED_ALT; "HELLY_COMPACT",HELLY_COMPACT; "HELLY_COMPACT_ALT",HELLY_COMPACT_ALT; "HELLY_INDUCT",HELLY_INDUCT; "HELLY_SELECTION_INCREASING",HELLY_SELECTION_INCREASING; "HELLY_SELECTION_THEOREM",HELLY_SELECTION_THEOREM; "HENSTOCK_LEMMA",HENSTOCK_LEMMA; "HENSTOCK_LEMMA_PART1",HENSTOCK_LEMMA_PART1; "HENSTOCK_LEMMA_PART2",HENSTOCK_LEMMA_PART2; "HIGHER_COMPLEX_DERIVATIVE_1",HIGHER_COMPLEX_DERIVATIVE_1; "HIGHER_COMPLEX_DERIVATIVE_ADD",HIGHER_COMPLEX_DERIVATIVE_ADD; "HIGHER_COMPLEX_DERIVATIVE_ADD_AT",HIGHER_COMPLEX_DERIVATIVE_ADD_AT; "HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR",HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR; "HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA",HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA; "HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA",HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA; "HIGHER_COMPLEX_DERIVATIVE_CONST",HIGHER_COMPLEX_DERIVATIVE_CONST; "HIGHER_COMPLEX_DERIVATIVE_EQ_ITER",HIGHER_COMPLEX_DERIVATIVE_EQ_ITER; "HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE",HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE; "HIGHER_COMPLEX_DERIVATIVE_ID",HIGHER_COMPLEX_DERIVATIVE_ID; "HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA",HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA; "HIGHER_COMPLEX_DERIVATIVE_LINEAR",HIGHER_COMPLEX_DERIVATIVE_LINEAR; "HIGHER_COMPLEX_DERIVATIVE_MUL",HIGHER_COMPLEX_DERIVATIVE_MUL; "HIGHER_COMPLEX_DERIVATIVE_MUL_AT",HIGHER_COMPLEX_DERIVATIVE_MUL_AT; "HIGHER_COMPLEX_DERIVATIVE_NEG",HIGHER_COMPLEX_DERIVATIVE_NEG; "HIGHER_COMPLEX_DERIVATIVE_NEG_AT",HIGHER_COMPLEX_DERIVATIVE_NEG_AT; "HIGHER_COMPLEX_DERIVATIVE_POWER_SERIES",HIGHER_COMPLEX_DERIVATIVE_POWER_SERIES; "HIGHER_COMPLEX_DERIVATIVE_SUB",HIGHER_COMPLEX_DERIVATIVE_SUB; "HIGHER_COMPLEX_DERIVATIVE_SUB_AT",HIGHER_COMPLEX_DERIVATIVE_SUB_AT; "HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; "HOELDER",HOELDER; "HOLOMORPHIC_COMPLEX_DERIVATIVE",HOLOMORPHIC_COMPLEX_DERIVATIVE; "HOLOMORPHIC_CONSTANT_IM",HOLOMORPHIC_CONSTANT_IM; "HOLOMORPHIC_CONSTANT_NORM",HOLOMORPHIC_CONSTANT_NORM; "HOLOMORPHIC_CONSTANT_ON_FRONTIER",HOLOMORPHIC_CONSTANT_ON_FRONTIER; "HOLOMORPHIC_CONSTANT_ON_SPHERE_SEGMENT",HOLOMORPHIC_CONSTANT_ON_SPHERE_SEGMENT; "HOLOMORPHIC_CONSTANT_RE",HOLOMORPHIC_CONSTANT_RE; "HOLOMORPHIC_CONVEX_PRIMITIVE",HOLOMORPHIC_CONVEX_PRIMITIVE; "HOLOMORPHIC_DERIVATIVE",HOLOMORPHIC_DERIVATIVE; "HOLOMORPHIC_EQ",HOLOMORPHIC_EQ; "HOLOMORPHIC_FACTOR_ORDER_OF_ZERO",HOLOMORPHIC_FACTOR_ORDER_OF_ZERO; "HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG",HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG; "HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT",HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT; "HOLOMORPHIC_FUNCTION_ENTIRE",HOLOMORPHIC_FUNCTION_ENTIRE; "HOLOMORPHIC_FUNCTION_ENTIRE_PRODUCT",HOLOMORPHIC_FUNCTION_ENTIRE_PRODUCT; "HOLOMORPHIC_FUN_EQ_0_ON_BALL",HOLOMORPHIC_FUN_EQ_0_ON_BALL; "HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED",HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED; "HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED",HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED; "HOLOMORPHIC_FUN_EQ_ON_BALL",HOLOMORPHIC_FUN_EQ_ON_BALL; "HOLOMORPHIC_FUN_EQ_ON_CONNECTED",HOLOMORPHIC_FUN_EQ_ON_CONNECTED; "HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE",HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE; "HOLOMORPHIC_IFF_POWER_SERIES",HOLOMORPHIC_IFF_POWER_SERIES; "HOLOMORPHIC_INJECTIVE_IMP_REGULAR",HOLOMORPHIC_INJECTIVE_IMP_REGULAR; "HOLOMORPHIC_INVOLUTION_POINT",HOLOMORPHIC_INVOLUTION_POINT; "HOLOMORPHIC_LOWER_BOUND_DIFFERENCE",HOLOMORPHIC_LOWER_BOUND_DIFFERENCE; "HOLOMORPHIC_NONZERO_CONSTANT_NORM_ON_FRONTIER",HOLOMORPHIC_NONZERO_CONSTANT_NORM_ON_FRONTIER; "HOLOMORPHIC_ON_ADD",HOLOMORPHIC_ON_ADD; "HOLOMORPHIC_ON_CACS",HOLOMORPHIC_ON_CACS; "HOLOMORPHIC_ON_CASN",HOLOMORPHIC_ON_CASN; "HOLOMORPHIC_ON_CATN",HOLOMORPHIC_ON_CATN; "HOLOMORPHIC_ON_CCOS",HOLOMORPHIC_ON_CCOS; "HOLOMORPHIC_ON_CEXP",HOLOMORPHIC_ON_CEXP; "HOLOMORPHIC_ON_CLOG",HOLOMORPHIC_ON_CLOG; "HOLOMORPHIC_ON_COMPOSE",HOLOMORPHIC_ON_COMPOSE; "HOLOMORPHIC_ON_COMPOSE_GEN",HOLOMORPHIC_ON_COMPOSE_GEN; "HOLOMORPHIC_ON_CONST",HOLOMORPHIC_ON_CONST; "HOLOMORPHIC_ON_CPOW_RIGHT",HOLOMORPHIC_ON_CPOW_RIGHT; "HOLOMORPHIC_ON_CPRODUCT",HOLOMORPHIC_ON_CPRODUCT; "HOLOMORPHIC_ON_CSIN",HOLOMORPHIC_ON_CSIN; "HOLOMORPHIC_ON_CSQRT",HOLOMORPHIC_ON_CSQRT; "HOLOMORPHIC_ON_CTAN",HOLOMORPHIC_ON_CTAN; "HOLOMORPHIC_ON_DIFFERENTIABLE",HOLOMORPHIC_ON_DIFFERENTIABLE; "HOLOMORPHIC_ON_DIV",HOLOMORPHIC_ON_DIV; "HOLOMORPHIC_ON_EMPTY",HOLOMORPHIC_ON_EMPTY; "HOLOMORPHIC_ON_EXTEND_BOUNDED",HOLOMORPHIC_ON_EXTEND_BOUNDED; "HOLOMORPHIC_ON_EXTEND_LIM",HOLOMORPHIC_ON_EXTEND_LIM; "HOLOMORPHIC_ON_ID",HOLOMORPHIC_ON_ID; "HOLOMORPHIC_ON_IMP_CONTINUOUS_ON",HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; "HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT",HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; "HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN",HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN; "HOLOMORPHIC_ON_INV",HOLOMORPHIC_ON_INV; "HOLOMORPHIC_ON_INVERSE",HOLOMORPHIC_ON_INVERSE; "HOLOMORPHIC_ON_LINEAR",HOLOMORPHIC_ON_LINEAR; "HOLOMORPHIC_ON_LMUL",HOLOMORPHIC_ON_LMUL; "HOLOMORPHIC_ON_MUL",HOLOMORPHIC_ON_MUL; "HOLOMORPHIC_ON_NEG",HOLOMORPHIC_ON_NEG; "HOLOMORPHIC_ON_OPEN",HOLOMORPHIC_ON_OPEN; "HOLOMORPHIC_ON_PASTE_ACROSS_LINE",HOLOMORPHIC_ON_PASTE_ACROSS_LINE; "HOLOMORPHIC_ON_POW",HOLOMORPHIC_ON_POW; "HOLOMORPHIC_ON_RMUL",HOLOMORPHIC_ON_RMUL; "HOLOMORPHIC_ON_SUB",HOLOMORPHIC_ON_SUB; "HOLOMORPHIC_ON_SUBSET",HOLOMORPHIC_ON_SUBSET; "HOLOMORPHIC_ON_VSUM",HOLOMORPHIC_ON_VSUM; "HOLOMORPHIC_PERIODIC_FIXPOINT",HOLOMORPHIC_PERIODIC_FIXPOINT; "HOLOMORPHIC_POINT_SMALL_TRIANGLE",HOLOMORPHIC_POINT_SMALL_TRIANGLE; "HOLOMORPHIC_POWER_SERIES",HOLOMORPHIC_POWER_SERIES; "HOLOMORPHIC_STARLIKE_PRIMITIVE",HOLOMORPHIC_STARLIKE_PRIMITIVE; "HOLOMORPHIC_SUBORDINATION",HOLOMORPHIC_SUBORDINATION; "HOLOMORPHIC_TRANSFORM",HOLOMORPHIC_TRANSFORM; "HOLOMORPHIC_UNIFORM_LIMIT",HOLOMORPHIC_UNIFORM_LIMIT; "HOLOMORPHIC_UNIFORM_SEQUENCE",HOLOMORPHIC_UNIFORM_SEQUENCE; "HOMEOMORPHIC_AFFINE_SETS",HOMEOMORPHIC_AFFINE_SETS; "HOMEOMORPHIC_AFFINE_SETS_EQ",HOMEOMORPHIC_AFFINE_SETS_EQ; "HOMEOMORPHIC_AFFINITY",HOMEOMORPHIC_AFFINITY; "HOMEOMORPHIC_ANALYTICITY",HOMEOMORPHIC_ANALYTICITY; "HOMEOMORPHIC_ANRNESS",HOMEOMORPHIC_ANRNESS; "HOMEOMORPHIC_ARC_IMAGES",HOMEOMORPHIC_ARC_IMAGES; "HOMEOMORPHIC_ARC_IMAGE_INTERVAL",HOMEOMORPHIC_ARC_IMAGE_INTERVAL; "HOMEOMORPHIC_ARC_IMAGE_SEGMENT",HOMEOMORPHIC_ARC_IMAGE_SEGMENT; "HOMEOMORPHIC_ARC_IMAGE_SEGMENT_EQ",HOMEOMORPHIC_ARC_IMAGE_SEGMENT_EQ; "HOMEOMORPHIC_ARNESS",HOMEOMORPHIC_ARNESS; "HOMEOMORPHIC_BALLS",HOMEOMORPHIC_BALLS; "HOMEOMORPHIC_BALLS_EQ",HOMEOMORPHIC_BALLS_EQ; "HOMEOMORPHIC_BALL_UNIV",HOMEOMORPHIC_BALL_UNIV; "HOMEOMORPHIC_BORELNESS",HOMEOMORPHIC_BORELNESS; "HOMEOMORPHIC_BORSUKIAN",HOMEOMORPHIC_BORSUKIAN; "HOMEOMORPHIC_BORSUKIAN_EQ",HOMEOMORPHIC_BORSUKIAN_EQ; "HOMEOMORPHIC_CARD_EQ_COMPONENTS",HOMEOMORPHIC_CARD_EQ_COMPONENTS; "HOMEOMORPHIC_CARD_EQ_PATH_COMPONENTS",HOMEOMORPHIC_CARD_EQ_PATH_COMPONENTS; "HOMEOMORPHIC_CBALLS",HOMEOMORPHIC_CBALLS; "HOMEOMORPHIC_CBALLS_EQ",HOMEOMORPHIC_CBALLS_EQ; "HOMEOMORPHIC_CLOSED_INTERVALS",HOMEOMORPHIC_CLOSED_INTERVALS; "HOMEOMORPHIC_CLOSED_IN_CONVEX",HOMEOMORPHIC_CLOSED_IN_CONVEX; "HOMEOMORPHIC_COMPACT",HOMEOMORPHIC_COMPACT; "HOMEOMORPHIC_COMPACTNESS",HOMEOMORPHIC_COMPACTNESS; "HOMEOMORPHIC_COMPACT_ARNESS",HOMEOMORPHIC_COMPACT_ARNESS; "HOMEOMORPHIC_CONNECTEDNESS",HOMEOMORPHIC_CONNECTEDNESS; "HOMEOMORPHIC_CONTRACTIBLE",HOMEOMORPHIC_CONTRACTIBLE; "HOMEOMORPHIC_CONTRACTIBLE_EQ",HOMEOMORPHIC_CONTRACTIBLE_EQ; "HOMEOMORPHIC_CONVEX_COMPACT",HOMEOMORPHIC_CONVEX_COMPACT; "HOMEOMORPHIC_CONVEX_COMPACT_CBALL",HOMEOMORPHIC_CONVEX_COMPACT_CBALL; "HOMEOMORPHIC_CONVEX_COMPACT_SETS",HOMEOMORPHIC_CONVEX_COMPACT_SETS; "HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ",HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ; "HOMEOMORPHIC_CONVEX_OPEN_SETS",HOMEOMORPHIC_CONVEX_OPEN_SETS; "HOMEOMORPHIC_CONVEX_SETS",HOMEOMORPHIC_CONVEX_SETS; "HOMEOMORPHIC_COUNTABILITY",HOMEOMORPHIC_COUNTABILITY; "HOMEOMORPHIC_DIMENSION",HOMEOMORPHIC_DIMENSION; "HOMEOMORPHIC_EMPTY",HOMEOMORPHIC_EMPTY; "HOMEOMORPHIC_ENRNESS",HOMEOMORPHIC_ENRNESS; "HOMEOMORPHIC_FINITE",HOMEOMORPHIC_FINITE; "HOMEOMORPHIC_FINITENESS",HOMEOMORPHIC_FINITENESS; "HOMEOMORPHIC_FINITE_STRONG",HOMEOMORPHIC_FINITE_STRONG; "HOMEOMORPHIC_FIXPOINT_PROPERTY",HOMEOMORPHIC_FIXPOINT_PROPERTY; "HOMEOMORPHIC_FRONTIERS",HOMEOMORPHIC_FRONTIERS; "HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION",HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION; "HOMEOMORPHIC_FSIGMANESS",HOMEOMORPHIC_FSIGMANESS; "HOMEOMORPHIC_GDELTANESS",HOMEOMORPHIC_GDELTANESS; "HOMEOMORPHIC_GRAPH",HOMEOMORPHIC_GRAPH; "HOMEOMORPHIC_HAS_SIZE",HOMEOMORPHIC_HAS_SIZE; "HOMEOMORPHIC_HYPERPLANES",HOMEOMORPHIC_HYPERPLANES; "HOMEOMORPHIC_HYPERPLANES_EQ",HOMEOMORPHIC_HYPERPLANES_EQ; "HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE",HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE; "HOMEOMORPHIC_HYPERPLANE_UNIV",HOMEOMORPHIC_HYPERPLANE_UNIV; "HOMEOMORPHIC_IMP_CARD_EQ",HOMEOMORPHIC_IMP_CARD_EQ; "HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT",HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; "HOMEOMORPHIC_INFINITENESS",HOMEOMORPHIC_INFINITENESS; "HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; "HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; "HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; "HOMEOMORPHIC_INSIDE_SIMPLE_PATH_BALL",HOMEOMORPHIC_INSIDE_SIMPLE_PATH_BALL; "HOMEOMORPHIC_INTERIORS",HOMEOMORPHIC_INTERIORS; "HOMEOMORPHIC_INTERIORS_SAME_DIMENSION",HOMEOMORPHIC_INTERIORS_SAME_DIMENSION; "HOMEOMORPHIC_INTERVALS_EQ",HOMEOMORPHIC_INTERVALS_EQ; "HOMEOMORPHIC_LOCALLY",HOMEOMORPHIC_LOCALLY; "HOMEOMORPHIC_LOCAL_COMPACTNESS",HOMEOMORPHIC_LOCAL_COMPACTNESS; "HOMEOMORPHIC_LOCAL_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_CONNECTEDNESS; "HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS; "HOMEOMORPHIC_MINIMAL",HOMEOMORPHIC_MINIMAL; "HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL",HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL; "HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS",HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS; "HOMEOMORPHIC_OPEN_INTERVALS",HOMEOMORPHIC_OPEN_INTERVALS; "HOMEOMORPHIC_OPEN_INTERVALS_1",HOMEOMORPHIC_OPEN_INTERVALS_1; "HOMEOMORPHIC_OPEN_INTERVAL_UNIV",HOMEOMORPHIC_OPEN_INTERVAL_UNIV; "HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1",HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; "HOMEOMORPHIC_PATH_CONNECTEDNESS",HOMEOMORPHIC_PATH_CONNECTEDNESS; "HOMEOMORPHIC_PCROSS",HOMEOMORPHIC_PCROSS; "HOMEOMORPHIC_PCROSS_ASSOC",HOMEOMORPHIC_PCROSS_ASSOC; "HOMEOMORPHIC_PCROSS_SING",HOMEOMORPHIC_PCROSS_SING; "HOMEOMORPHIC_PCROSS_SYM",HOMEOMORPHIC_PCROSS_SYM; "HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE; "HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE; "HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN; "HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE",HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE; "HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV",HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV; "HOMEOMORPHIC_REFL",HOMEOMORPHIC_REFL; "HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS",HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS; "HOMEOMORPHIC_RELATIVE_BOUNDARIES",HOMEOMORPHIC_RELATIVE_BOUNDARIES; "HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION",HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION; "HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS",HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS; "HOMEOMORPHIC_RELATIVE_INTERIORS",HOMEOMORPHIC_RELATIVE_INTERIORS; "HOMEOMORPHIC_RELATIVE_INTERIORS_CONVEX_COMPACT_SETS",HOMEOMORPHIC_RELATIVE_INTERIORS_CONVEX_COMPACT_SETS; "HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION",HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION; "HOMEOMORPHIC_SCALING",HOMEOMORPHIC_SCALING; "HOMEOMORPHIC_SCALING_LEFT",HOMEOMORPHIC_SCALING_LEFT; "HOMEOMORPHIC_SCALING_RIGHT",HOMEOMORPHIC_SCALING_RIGHT; "HOMEOMORPHIC_SEGMENTS",HOMEOMORPHIC_SEGMENTS; "HOMEOMORPHIC_SELF_IMAGE",HOMEOMORPHIC_SELF_IMAGE; "HOMEOMORPHIC_SEPARATION",HOMEOMORPHIC_SEPARATION; "HOMEOMORPHIC_SEPARATION_SPHERE",HOMEOMORPHIC_SEPARATION_SPHERE; "HOMEOMORPHIC_SIMPLE_PATH_ARC",HOMEOMORPHIC_SIMPLE_PATH_ARC; "HOMEOMORPHIC_SIMPLE_PATH_ARC_EQ",HOMEOMORPHIC_SIMPLE_PATH_ARC_EQ; "HOMEOMORPHIC_SIMPLE_PATH_IMAGES",HOMEOMORPHIC_SIMPLE_PATH_IMAGES; "HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE",HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; "HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ",HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ; "HOMEOMORPHIC_SIMPLY_CONNECTED",HOMEOMORPHIC_SIMPLY_CONNECTED; "HOMEOMORPHIC_SIMPLY_CONNECTED_EQ",HOMEOMORPHIC_SIMPLY_CONNECTED_EQ; "HOMEOMORPHIC_SING",HOMEOMORPHIC_SING; "HOMEOMORPHIC_SPHERES",HOMEOMORPHIC_SPHERES; "HOMEOMORPHIC_SPHERES_EQ",HOMEOMORPHIC_SPHERES_EQ; "HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE",HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE; "HOMEOMORPHIC_SUBSPACES",HOMEOMORPHIC_SUBSPACES; "HOMEOMORPHIC_SUBSPACES_EQ",HOMEOMORPHIC_SUBSPACES_EQ; "HOMEOMORPHIC_SYM",HOMEOMORPHIC_SYM; "HOMEOMORPHIC_TRANS",HOMEOMORPHIC_TRANS; "HOMEOMORPHIC_TRANSLATION",HOMEOMORPHIC_TRANSLATION; "HOMEOMORPHIC_TRANSLATION_LEFT_EQ",HOMEOMORPHIC_TRANSLATION_LEFT_EQ; "HOMEOMORPHIC_TRANSLATION_RIGHT_EQ",HOMEOMORPHIC_TRANSLATION_RIGHT_EQ; "HOMEOMORPHIC_TRANSLATION_SELF",HOMEOMORPHIC_TRANSLATION_SELF; "HOMEOMORPHIC_UNICOHERENT",HOMEOMORPHIC_UNICOHERENT; "HOMEOMORPHIC_UNICOHERENT_EQ",HOMEOMORPHIC_UNICOHERENT_EQ; "HOMEOMORPHIC_UNIV_UNIV",HOMEOMORPHIC_UNIV_UNIV; "HOMEOMORPHISM",HOMEOMORPHISM; "HOMEOMORPHISM_1D_IMP_MONOTONIC",HOMEOMORPHISM_1D_IMP_MONOTONIC; "HOMEOMORPHISM_ANRNESS",HOMEOMORPHISM_ANRNESS; "HOMEOMORPHISM_ARC",HOMEOMORPHISM_ARC; "HOMEOMORPHISM_ARC_IMAGES",HOMEOMORPHISM_ARC_IMAGES; "HOMEOMORPHISM_ARNESS",HOMEOMORPHISM_ARNESS; "HOMEOMORPHISM_BORELNESS",HOMEOMORPHISM_BORELNESS; "HOMEOMORPHISM_BORSUKIANNESS",HOMEOMORPHISM_BORSUKIANNESS; "HOMEOMORPHISM_CLOSEDNESS",HOMEOMORPHISM_CLOSEDNESS; "HOMEOMORPHISM_CLOSED_IN_EQ",HOMEOMORPHISM_CLOSED_IN_EQ; "HOMEOMORPHISM_CLOSURE",HOMEOMORPHISM_CLOSURE; "HOMEOMORPHISM_CLOSURE_OF",HOMEOMORPHISM_CLOSURE_OF; "HOMEOMORPHISM_COMPACT",HOMEOMORPHISM_COMPACT; "HOMEOMORPHISM_COMPACTNESS",HOMEOMORPHISM_COMPACTNESS; "HOMEOMORPHISM_COMPONENTS",HOMEOMORPHISM_COMPONENTS; "HOMEOMORPHISM_COMPOSE",HOMEOMORPHISM_COMPOSE; "HOMEOMORPHISM_CONNECTEDNESS",HOMEOMORPHISM_CONNECTEDNESS; "HOMEOMORPHISM_CONNECTED_COMPONENT",HOMEOMORPHISM_CONNECTED_COMPONENT; "HOMEOMORPHISM_CONTRACTIBILITY",HOMEOMORPHISM_CONTRACTIBILITY; "HOMEOMORPHISM_COUNTABILITY",HOMEOMORPHISM_COUNTABILITY; "HOMEOMORPHISM_DERIVED_SET_OF",HOMEOMORPHISM_DERIVED_SET_OF; "HOMEOMORPHISM_ENRNESS",HOMEOMORPHISM_ENRNESS; "HOMEOMORPHISM_EQ",HOMEOMORPHISM_EQ; "HOMEOMORPHISM_FINITENESS",HOMEOMORPHISM_FINITENESS; "HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE; "HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE; "HOMEOMORPHISM_FRONTIER_OF",HOMEOMORPHISM_FRONTIER_OF; "HOMEOMORPHISM_FSIGMANESS",HOMEOMORPHISM_FSIGMANESS; "HOMEOMORPHISM_GDELTANESS",HOMEOMORPHISM_GDELTANESS; "HOMEOMORPHISM_GRAPH",HOMEOMORPHISM_GRAPH; "HOMEOMORPHISM_GRAPH_EXPLICIT",HOMEOMORPHISM_GRAPH_EXPLICIT; "HOMEOMORPHISM_GROUPING_POINTS_EXISTS",HOMEOMORPHISM_GROUPING_POINTS_EXISTS; "HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN",HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN; "HOMEOMORPHISM_HAS_SIZE_EQ",HOMEOMORPHISM_HAS_SIZE_EQ; "HOMEOMORPHISM_I",HOMEOMORPHISM_I; "HOMEOMORPHISM_ID",HOMEOMORPHISM_ID; "HOMEOMORPHISM_IMP_CLOSED_MAP",HOMEOMORPHISM_IMP_CLOSED_MAP; "HOMEOMORPHISM_IMP_COVERING_SPACE",HOMEOMORPHISM_IMP_COVERING_SPACE; "HOMEOMORPHISM_IMP_HOMEOMORPHIC",HOMEOMORPHISM_IMP_HOMEOMORPHIC; "HOMEOMORPHISM_IMP_OPEN_MAP",HOMEOMORPHISM_IMP_OPEN_MAP; "HOMEOMORPHISM_IMP_QUOTIENT_MAP",HOMEOMORPHISM_IMP_QUOTIENT_MAP; "HOMEOMORPHISM_INFINITENESS",HOMEOMORPHISM_INFINITENESS; "HOMEOMORPHISM_INJECTIVE_CLOSED_MAP",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP; "HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ; "HOMEOMORPHISM_INJECTIVE_OPEN_MAP",HOMEOMORPHISM_INJECTIVE_OPEN_MAP; "HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ",HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; "HOMEOMORPHISM_INTERIOR_OF",HOMEOMORPHISM_INTERIOR_OF; "HOMEOMORPHISM_INTO_1D",HOMEOMORPHISM_INTO_1D; "HOMEOMORPHISM_LOCALLY",HOMEOMORPHISM_LOCALLY; "HOMEOMORPHISM_LOCAL_COMPACTNESS",HOMEOMORPHISM_LOCAL_COMPACTNESS; "HOMEOMORPHISM_LOCAL_CONNECTEDNESS",HOMEOMORPHISM_LOCAL_CONNECTEDNESS; "HOMEOMORPHISM_LOCAL_PATH_CONNECTEDNESS",HOMEOMORPHISM_LOCAL_PATH_CONNECTEDNESS; "HOMEOMORPHISM_MOVING_DENSE_COUNTABLE_SUBSETS_EXISTS",HOMEOMORPHISM_MOVING_DENSE_COUNTABLE_SUBSETS_EXISTS; "HOMEOMORPHISM_MOVING_POINTS_EXISTS",HOMEOMORPHISM_MOVING_POINTS_EXISTS; "HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN",HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN; "HOMEOMORPHISM_MOVING_POINT_EXISTS",HOMEOMORPHISM_MOVING_POINT_EXISTS; "HOMEOMORPHISM_OF_SUBSETS",HOMEOMORPHISM_OF_SUBSETS; "HOMEOMORPHISM_OF_SUBSETS_ALT",HOMEOMORPHISM_OF_SUBSETS_ALT; "HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS",HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS; "HOMEOMORPHISM_OPENNESS",HOMEOMORPHISM_OPENNESS; "HOMEOMORPHISM_OPEN_IN_EQ",HOMEOMORPHISM_OPEN_IN_EQ; "HOMEOMORPHISM_PATH_CONNECTEDNESS",HOMEOMORPHISM_PATH_CONNECTEDNESS; "HOMEOMORPHISM_SEGMENT",HOMEOMORPHISM_SEGMENT; "HOMEOMORPHISM_SIMPLE_CONNECTEDNESS",HOMEOMORPHISM_SIMPLE_CONNECTEDNESS; "HOMEOMORPHISM_SYM",HOMEOMORPHISM_SYM; "HOMEOMORPHISM_UNICOHERENCE",HOMEOMORPHISM_UNICOHERENCE; "HOMOEOMORPHISM_PASTE",HOMOEOMORPHISM_PASTE; "HOMOGENEOUS_LINEAR_EQUATIONS_DET",HOMOGENEOUS_LINEAR_EQUATIONS_DET; "HOMOMORPHISM_REAL_TO_REAL",HOMOMORPHISM_REAL_TO_REAL; "HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; "HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; "HOMOTOPIC_ANTIPODAL_IDENTITY_MAP",HOMOTOPIC_ANTIPODAL_IDENTITY_MAP; "HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT",HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT; "HOMOTOPIC_CIRCLEMAPS_DIV",HOMOTOPIC_CIRCLEMAPS_DIV; "HOMOTOPIC_CIRCLEMAPS_DIV_1",HOMOTOPIC_CIRCLEMAPS_DIV_1; "HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS",HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS; "HOMOTOPIC_COMPOSE",HOMOTOPIC_COMPOSE; "HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT; "HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT; "HOMOTOPIC_CONSTANT_MAPS",HOMOTOPIC_CONSTANT_MAPS; "HOMOTOPIC_FROM_CONTRACTIBLE",HOMOTOPIC_FROM_CONTRACTIBLE; "HOMOTOPIC_INTO_CONTRACTIBLE",HOMOTOPIC_INTO_CONTRACTIBLE; "HOMOTOPIC_INTO_RETRACT",HOMOTOPIC_INTO_RETRACT; "HOMOTOPIC_INVERTIBLE_LINEAR_MAPS",HOMOTOPIC_INVERTIBLE_LINEAR_MAPS; "HOMOTOPIC_INVERTIBLE_LINEAR_MAPS_ALT",HOMOTOPIC_INVERTIBLE_LINEAR_MAPS_ALT; "HOMOTOPIC_JOIN_LEMMA",HOMOTOPIC_JOIN_LEMMA; "HOMOTOPIC_JOIN_SUBPATHS",HOMOTOPIC_JOIN_SUBPATHS; "HOMOTOPIC_LINEAR_MAPS",HOMOTOPIC_LINEAR_MAPS; "HOMOTOPIC_LINEAR_MAPS_ALT",HOMOTOPIC_LINEAR_MAPS_ALT; "HOMOTOPIC_LINEAR_MAPS_EQ",HOMOTOPIC_LINEAR_MAPS_EQ; "HOMOTOPIC_LINEAR_MAPS_IMP",HOMOTOPIC_LINEAR_MAPS_IMP; "HOMOTOPIC_LINEAR_POSITIVE_DEFINITE_MAPS",HOMOTOPIC_LINEAR_POSITIVE_DEFINITE_MAPS; "HOMOTOPIC_LINEAR_POSITIVE_SEMIDEFINITE_MAPS",HOMOTOPIC_LINEAR_POSITIVE_SEMIDEFINITE_MAPS; "HOMOTOPIC_LOOPS",HOMOTOPIC_LOOPS; "HOMOTOPIC_LOOPS_ADD_SYM",HOMOTOPIC_LOOPS_ADD_SYM; "HOMOTOPIC_LOOPS_CONJUGATE",HOMOTOPIC_LOOPS_CONJUGATE; "HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE",HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE; "HOMOTOPIC_LOOPS_EQ",HOMOTOPIC_LOOPS_EQ; "HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS",HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS; "HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL",HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL; "HOMOTOPIC_LOOPS_IMP_LOOP",HOMOTOPIC_LOOPS_IMP_LOOP; "HOMOTOPIC_LOOPS_IMP_PATH",HOMOTOPIC_LOOPS_IMP_PATH; "HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE",HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE; "HOMOTOPIC_LOOPS_IMP_SUBSET",HOMOTOPIC_LOOPS_IMP_SUBSET; "HOMOTOPIC_LOOPS_LINEAR",HOMOTOPIC_LOOPS_LINEAR; "HOMOTOPIC_LOOPS_NEARBY_EXPLICIT",HOMOTOPIC_LOOPS_NEARBY_EXPLICIT; "HOMOTOPIC_LOOPS_PARTCIRCLEPATH",HOMOTOPIC_LOOPS_PARTCIRCLEPATH; "HOMOTOPIC_LOOPS_REFL",HOMOTOPIC_LOOPS_REFL; "HOMOTOPIC_LOOPS_SHIFTPATH",HOMOTOPIC_LOOPS_SHIFTPATH; "HOMOTOPIC_LOOPS_SHIFTPATH_SELF",HOMOTOPIC_LOOPS_SHIFTPATH_SELF; "HOMOTOPIC_LOOPS_SUBSET",HOMOTOPIC_LOOPS_SUBSET; "HOMOTOPIC_LOOPS_SYM",HOMOTOPIC_LOOPS_SYM; "HOMOTOPIC_LOOPS_TRANS",HOMOTOPIC_LOOPS_TRANS; "HOMOTOPIC_NEARBY_LOOPS",HOMOTOPIC_NEARBY_LOOPS; "HOMOTOPIC_NEARBY_PATHS",HOMOTOPIC_NEARBY_PATHS; "HOMOTOPIC_NEIGHBOURHOOD_EXTENSION",HOMOTOPIC_NEIGHBOURHOOD_EXTENSION; "HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS",HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS; "HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS",HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS; "HOMOTOPIC_ON_CLOPEN_UNIONS",HOMOTOPIC_ON_CLOPEN_UNIONS; "HOMOTOPIC_ON_COMPONENTS",HOMOTOPIC_ON_COMPONENTS; "HOMOTOPIC_ON_COMPONENTS_EQ",HOMOTOPIC_ON_COMPONENTS_EQ; "HOMOTOPIC_ON_EMPTY",HOMOTOPIC_ON_EMPTY; "HOMOTOPIC_ON_NEIGHBOURHOOD_INTO_ANR",HOMOTOPIC_ON_NEIGHBOURHOOD_INTO_ANR; "HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS",HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS; "HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_EQ",HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_EQ; "HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP",HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP; "HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_SPHERE",HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_SPHERE; "HOMOTOPIC_PATHS",HOMOTOPIC_PATHS; "HOMOTOPIC_PATHS_ASSOC",HOMOTOPIC_PATHS_ASSOC; "HOMOTOPIC_PATHS_CONTINUOUS_IMAGE",HOMOTOPIC_PATHS_CONTINUOUS_IMAGE; "HOMOTOPIC_PATHS_EQ",HOMOTOPIC_PATHS_EQ; "HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS",HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS; "HOMOTOPIC_PATHS_IMP_PATH",HOMOTOPIC_PATHS_IMP_PATH; "HOMOTOPIC_PATHS_IMP_PATHFINISH",HOMOTOPIC_PATHS_IMP_PATHFINISH; "HOMOTOPIC_PATHS_IMP_PATHSTART",HOMOTOPIC_PATHS_IMP_PATHSTART; "HOMOTOPIC_PATHS_IMP_SUBSET",HOMOTOPIC_PATHS_IMP_SUBSET; "HOMOTOPIC_PATHS_JOIN",HOMOTOPIC_PATHS_JOIN; "HOMOTOPIC_PATHS_LCANCEL",HOMOTOPIC_PATHS_LCANCEL; "HOMOTOPIC_PATHS_LCANCEL_EQ",HOMOTOPIC_PATHS_LCANCEL_EQ; "HOMOTOPIC_PATHS_LID",HOMOTOPIC_PATHS_LID; "HOMOTOPIC_PATHS_LINEAR",HOMOTOPIC_PATHS_LINEAR; "HOMOTOPIC_PATHS_LINV",HOMOTOPIC_PATHS_LINV; "HOMOTOPIC_PATHS_LOOP_PARTS",HOMOTOPIC_PATHS_LOOP_PARTS; "HOMOTOPIC_PATHS_NEARBY_EXPLICIT",HOMOTOPIC_PATHS_NEARBY_EXPLICIT; "HOMOTOPIC_PATHS_RCANCEL",HOMOTOPIC_PATHS_RCANCEL; "HOMOTOPIC_PATHS_RCANCEL_EQ",HOMOTOPIC_PATHS_RCANCEL_EQ; "HOMOTOPIC_PATHS_REFL",HOMOTOPIC_PATHS_REFL; "HOMOTOPIC_PATHS_REPARAMETRIZE",HOMOTOPIC_PATHS_REPARAMETRIZE; "HOMOTOPIC_PATHS_REVERSEPATH",HOMOTOPIC_PATHS_REVERSEPATH; "HOMOTOPIC_PATHS_RID",HOMOTOPIC_PATHS_RID; "HOMOTOPIC_PATHS_RINV",HOMOTOPIC_PATHS_RINV; "HOMOTOPIC_PATHS_SUBSET",HOMOTOPIC_PATHS_SUBSET; "HOMOTOPIC_PATHS_SYM",HOMOTOPIC_PATHS_SYM; "HOMOTOPIC_PATHS_TRANS",HOMOTOPIC_PATHS_TRANS; "HOMOTOPIC_POINTS_EQ_PATH_COMPONENT",HOMOTOPIC_POINTS_EQ_PATH_COMPONENT; "HOMOTOPIC_RESTRICTED_LINEAR_MAPS",HOMOTOPIC_RESTRICTED_LINEAR_MAPS; "HOMOTOPIC_SPECIAL_ORTHOGONAL_TRANSFORMATIONS",HOMOTOPIC_SPECIAL_ORTHOGONAL_TRANSFORMATIONS; "HOMOTOPIC_THROUGH_CONTRACTIBLE",HOMOTOPIC_THROUGH_CONTRACTIBLE; "HOMOTOPIC_TRIVIALITY",HOMOTOPIC_TRIVIALITY; "HOMOTOPIC_WITH",HOMOTOPIC_WITH; "HOMOTOPIC_WITH_COMPOSE",HOMOTOPIC_WITH_COMPOSE; "HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT; "HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT; "HOMOTOPIC_WITH_EQ",HOMOTOPIC_WITH_EQ; "HOMOTOPIC_WITH_EQUAL",HOMOTOPIC_WITH_EQUAL; "HOMOTOPIC_WITH_IMP_CONTINUOUS",HOMOTOPIC_WITH_IMP_CONTINUOUS; "HOMOTOPIC_WITH_IMP_PATH_COMPONENT",HOMOTOPIC_WITH_IMP_PATH_COMPONENT; "HOMOTOPIC_WITH_IMP_PROPERTY",HOMOTOPIC_WITH_IMP_PROPERTY; "HOMOTOPIC_WITH_IMP_SUBSET",HOMOTOPIC_WITH_IMP_SUBSET; "HOMOTOPIC_WITH_LINEAR",HOMOTOPIC_WITH_LINEAR; "HOMOTOPIC_WITH_MONO",HOMOTOPIC_WITH_MONO; "HOMOTOPIC_WITH_PCROSS",HOMOTOPIC_WITH_PCROSS; "HOMOTOPIC_WITH_REFL",HOMOTOPIC_WITH_REFL; "HOMOTOPIC_WITH_RESTRICT",HOMOTOPIC_WITH_RESTRICT; "HOMOTOPIC_WITH_SUBSET_LEFT",HOMOTOPIC_WITH_SUBSET_LEFT; "HOMOTOPIC_WITH_SUBSET_RIGHT",HOMOTOPIC_WITH_SUBSET_RIGHT; "HOMOTOPIC_WITH_SYM",HOMOTOPIC_WITH_SYM; "HOMOTOPIC_WITH_TRANS",HOMOTOPIC_WITH_TRANS; "HOMOTOPY_DOMINATED_CONTRACTIBILITY",HOMOTOPY_DOMINATED_CONTRACTIBILITY; "HOMOTOPY_EQUIVALENT",HOMOTOPY_EQUIVALENT; "HOMOTOPY_EQUIVALENT_BORSUKIANNESS",HOMOTOPY_EQUIVALENT_BORSUKIANNESS; "HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS",HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS; "HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS",HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS; "HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY; "HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL; "HOMOTOPY_EQUIVALENT_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_CONNECTEDNESS; "HOMOTOPY_EQUIVALENT_CONTRACTIBILITY",HOMOTOPY_EQUIVALENT_CONTRACTIBILITY; "HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS",HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; "HOMOTOPY_EQUIVALENT_EMPTY",HOMOTOPY_EQUIVALENT_EMPTY; "HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY; "HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL; "HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; "HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; "HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF; "HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS; "HOMOTOPY_EQUIVALENT_PCROSS",HOMOTOPY_EQUIVALENT_PCROSS; "HOMOTOPY_EQUIVALENT_PUNCTURED_UNIV_SPHERE",HOMOTOPY_EQUIVALENT_PUNCTURED_UNIV_SPHERE; "HOMOTOPY_EQUIVALENT_REFL",HOMOTOPY_EQUIVALENT_REFL; "HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL; "HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX; "HOMOTOPY_EQUIVALENT_SEPARATION",HOMOTOPY_EQUIVALENT_SEPARATION; "HOMOTOPY_EQUIVALENT_SEPARATION_SPHERE",HOMOTOPY_EQUIVALENT_SEPARATION_SPHERE; "HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS; "HOMOTOPY_EQUIVALENT_SING",HOMOTOPY_EQUIVALENT_SING; "HOMOTOPY_EQUIVALENT_SPHERES_EQ",HOMOTOPY_EQUIVALENT_SPHERES_EQ; "HOMOTOPY_EQUIVALENT_SYM",HOMOTOPY_EQUIVALENT_SYM; "HOMOTOPY_EQUIVALENT_TRANS",HOMOTOPY_EQUIVALENT_TRANS; "HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ; "HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ; "HOMOTOPY_EQUIVALENT_TRANSLATION_SELF",HOMOTOPY_EQUIVALENT_TRANSLATION_SELF; "HOMOTOPY_INVARIANT_CARD_COMPONENTS",HOMOTOPY_INVARIANT_CARD_COMPONENTS; "HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS",HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS; "HOMOTOPY_INVARIANT_CONNECTEDNESS",HOMOTOPY_INVARIANT_CONNECTEDNESS; "HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS",HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS; "HP",HP; "HREAL_ADD_AC",HREAL_ADD_AC; "HREAL_ADD_ASSOC",HREAL_ADD_ASSOC; "HREAL_ADD_LCANCEL",HREAL_ADD_LCANCEL; "HREAL_ADD_LDISTRIB",HREAL_ADD_LDISTRIB; "HREAL_ADD_LID",HREAL_ADD_LID; "HREAL_ADD_RDISTRIB",HREAL_ADD_RDISTRIB; "HREAL_ADD_RID",HREAL_ADD_RID; "HREAL_ADD_SYM",HREAL_ADD_SYM; "HREAL_ARCH",HREAL_ARCH; "HREAL_COMPLETE",HREAL_COMPLETE; "HREAL_EQ_ADD_LCANCEL",HREAL_EQ_ADD_LCANCEL; "HREAL_EQ_ADD_RCANCEL",HREAL_EQ_ADD_RCANCEL; "HREAL_INV_0",HREAL_INV_0; "HREAL_LE_ADD",HREAL_LE_ADD; "HREAL_LE_ADD2",HREAL_LE_ADD2; "HREAL_LE_ADD_LCANCEL",HREAL_LE_ADD_LCANCEL; "HREAL_LE_ADD_RCANCEL",HREAL_LE_ADD_RCANCEL; "HREAL_LE_ANTISYM",HREAL_LE_ANTISYM; "HREAL_LE_EXISTS",HREAL_LE_EXISTS; "HREAL_LE_EXISTS_DEF",HREAL_LE_EXISTS_DEF; "HREAL_LE_MUL_RCANCEL_IMP",HREAL_LE_MUL_RCANCEL_IMP; "HREAL_LE_REFL",HREAL_LE_REFL; "HREAL_LE_TOTAL",HREAL_LE_TOTAL; "HREAL_LE_TRANS",HREAL_LE_TRANS; "HREAL_MUL_ASSOC",HREAL_MUL_ASSOC; "HREAL_MUL_LID",HREAL_MUL_LID; "HREAL_MUL_LINV",HREAL_MUL_LINV; "HREAL_MUL_LZERO",HREAL_MUL_LZERO; "HREAL_MUL_RZERO",HREAL_MUL_RZERO; "HREAL_MUL_SYM",HREAL_MUL_SYM; "HREAL_OF_NUM_ADD",HREAL_OF_NUM_ADD; "HREAL_OF_NUM_EQ",HREAL_OF_NUM_EQ; "HREAL_OF_NUM_LE",HREAL_OF_NUM_LE; "HREAL_OF_NUM_MUL",HREAL_OF_NUM_MUL; "HULLS_EQ",HULLS_EQ; "HULL_ANTIMONO",HULL_ANTIMONO; "HULL_EQ",HULL_EQ; "HULL_HULL",HULL_HULL; "HULL_IMAGE",HULL_IMAGE; "HULL_IMAGE_GALOIS",HULL_IMAGE_GALOIS; "HULL_IMAGE_SUBSET",HULL_IMAGE_SUBSET; "HULL_INC",HULL_INC; "HULL_INDUCT",HULL_INDUCT; "HULL_INSERT",HULL_INSERT; "HULL_INTERS_SUBSET",HULL_INTERS_SUBSET; "HULL_INTER_SUBSET",HULL_INTER_SUBSET; "HULL_MINIMAL",HULL_MINIMAL; "HULL_MONO",HULL_MONO; "HULL_P",HULL_P; "HULL_P_AND_Q",HULL_P_AND_Q; "HULL_REDUNDANT",HULL_REDUNDANT; "HULL_REDUNDANT_EQ",HULL_REDUNDANT_EQ; "HULL_SUBSET",HULL_SUBSET; "HULL_UNION",HULL_UNION; "HULL_UNIONS_SUBSET",HULL_UNIONS_SUBSET; "HULL_UNION_LEFT",HULL_UNION_LEFT; "HULL_UNION_RIGHT",HULL_UNION_RIGHT; "HULL_UNION_SUBSET",HULL_UNION_SUBSET; "HULL_UNIQUE",HULL_UNIQUE; "HULL_UNIV",HULL_UNIV; "HURWITZ_INJECTIVE",HURWITZ_INJECTIVE; "HURWITZ_NO_ZEROS",HURWITZ_NO_ZEROS; "HYPERPLANE_EQ_EMPTY",HYPERPLANE_EQ_EMPTY; "HYPERPLANE_EQ_UNIV",HYPERPLANE_EQ_UNIV; "HYPERPLANE_FACET_OF_HALFSPACE_GE",HYPERPLANE_FACET_OF_HALFSPACE_GE; "HYPERPLANE_FACET_OF_HALFSPACE_LE",HYPERPLANE_FACET_OF_HALFSPACE_LE; "HYPERPLANE_FACE_OF_HALFSPACE_GE",HYPERPLANE_FACE_OF_HALFSPACE_GE; "HYPERPLANE_FACE_OF_HALFSPACE_LE",HYPERPLANE_FACE_OF_HALFSPACE_LE; "IDEMPOTENT_IMP_RETRACTION",IDEMPOTENT_IMP_RETRACTION; "IDEMPOTENT_MATRIX_MUL_LINV",IDEMPOTENT_MATRIX_MUL_LINV; "IDEMPOTENT_MATRIX_MUL_RINV",IDEMPOTENT_MATRIX_MUL_RINV; "IDEMPOTENT_MATRIX_TRACE_EQ_RANK",IDEMPOTENT_MATRIX_TRACE_EQ_RANK; "II_NZ",II_NZ; "IM",IM; "IMAGE",IMAGE; "IMAGE_AFFINITY_BALL",IMAGE_AFFINITY_BALL; "IMAGE_AFFINITY_CBALL",IMAGE_AFFINITY_CBALL; "IMAGE_AFFINITY_INTERVAL",IMAGE_AFFINITY_INTERVAL; "IMAGE_AFFINITY_REAL_INTERVAL",IMAGE_AFFINITY_REAL_INTERVAL; "IMAGE_AFFINITY_SPHERE",IMAGE_AFFINITY_SPHERE; "IMAGE_CLAUSES",IMAGE_CLAUSES; "IMAGE_CLOSURE_SUBSET",IMAGE_CLOSURE_SUBSET; "IMAGE_COMPACT_IN",IMAGE_COMPACT_IN; "IMAGE_COMPOSE_PERMUTATIONS_L",IMAGE_COMPOSE_PERMUTATIONS_L; "IMAGE_COMPOSE_PERMUTATIONS_R",IMAGE_COMPOSE_PERMUTATIONS_R; "IMAGE_CONST",IMAGE_CONST; "IMAGE_CX",IMAGE_CX; "IMAGE_DELETE_INJ",IMAGE_DELETE_INJ; "IMAGE_DELETE_INJ_ALT",IMAGE_DELETE_INJ_ALT; "IMAGE_DIFF_INJ",IMAGE_DIFF_INJ; "IMAGE_DIFF_INJ_ALT",IMAGE_DIFF_INJ_ALT; "IMAGE_DROPOUT_CLOSED_INTERVAL",IMAGE_DROPOUT_CLOSED_INTERVAL; "IMAGE_DROP_INTERVAL",IMAGE_DROP_INTERVAL; "IMAGE_DROP_UNIV",IMAGE_DROP_UNIV; "IMAGE_EQ_EMPTY",IMAGE_EQ_EMPTY; "IMAGE_FSTCART_PCROSS",IMAGE_FSTCART_PCROSS; "IMAGE_FST_CROSS",IMAGE_FST_CROSS; "IMAGE_I",IMAGE_I; "IMAGE_ID",IMAGE_ID; "IMAGE_IMP_INJECTIVE",IMAGE_IMP_INJECTIVE; "IMAGE_IMP_INJECTIVE_GEN",IMAGE_IMP_INJECTIVE_GEN; "IMAGE_INJECTIVE_IMAGE_OF_SUBSET",IMAGE_INJECTIVE_IMAGE_OF_SUBSET; "IMAGE_INTERS",IMAGE_INTERS; "IMAGE_INTERS_SATURATED",IMAGE_INTERS_SATURATED; "IMAGE_INTERS_SATURATED_GEN",IMAGE_INTERS_SATURATED_GEN; "IMAGE_INTERS_SUBSET",IMAGE_INTERS_SUBSET; "IMAGE_INTER_INJ",IMAGE_INTER_INJ; "IMAGE_INTER_SATURATED",IMAGE_INTER_SATURATED; "IMAGE_INTER_SATURATED_GEN",IMAGE_INTER_SATURATED_GEN; "IMAGE_INTER_SUBSET",IMAGE_INTER_SUBSET; "IMAGE_INVERSE_PERMUTATIONS",IMAGE_INVERSE_PERMUTATIONS; "IMAGE_LIFT_DROP",IMAGE_LIFT_DROP; "IMAGE_LIFT_REAL_INTERVAL",IMAGE_LIFT_REAL_INTERVAL; "IMAGE_LIFT_REAL_SEGMENT",IMAGE_LIFT_REAL_SEGMENT; "IMAGE_LIFT_UNIV",IMAGE_LIFT_UNIV; "IMAGE_MATRIX_INV",IMAGE_MATRIX_INV; "IMAGE_RESTRICTION",IMAGE_RESTRICTION; "IMAGE_SNDCART_PCROSS",IMAGE_SNDCART_PCROSS; "IMAGE_SND_CROSS",IMAGE_SND_CROSS; "IMAGE_STRETCH_INTERVAL",IMAGE_STRETCH_INTERVAL; "IMAGE_STRETCH_REAL_INTERVAL",IMAGE_STRETCH_REAL_INTERVAL; "IMAGE_SUBSET",IMAGE_SUBSET; "IMAGE_TWIZZLE_INTERVAL",IMAGE_TWIZZLE_INTERVAL; "IMAGE_UNION",IMAGE_UNION; "IMAGE_UNIONS",IMAGE_UNIONS; "IMAGE_o",IMAGE_o; "IMP_CLAUSES",IMP_CLAUSES; "IMP_CONJ",IMP_CONJ; "IMP_CONJ_ALT",IMP_CONJ_ALT; "IMP_DEF",IMP_DEF; "IMP_IMP",IMP_IMP; "IM_ADD",IM_ADD; "IM_CCOS",IM_CCOS; "IM_CEXP",IM_CEXP; "IM_CLOG_EQ_0",IM_CLOG_EQ_0; "IM_CLOG_EQ_PI",IM_CLOG_EQ_PI; "IM_CLOG_POS_LE",IM_CLOG_POS_LE; "IM_CLOG_POS_LT",IM_CLOG_POS_LT; "IM_CLOG_POS_LT_IMP",IM_CLOG_POS_LT_IMP; "IM_CMUL",IM_CMUL; "IM_CNJ",IM_CNJ; "IM_COMPLEX_DIV_EQ_0",IM_COMPLEX_DIV_EQ_0; "IM_COMPLEX_DIV_GE_0",IM_COMPLEX_DIV_GE_0; "IM_COMPLEX_DIV_GT_0",IM_COMPLEX_DIV_GT_0; "IM_COMPLEX_DIV_LEMMA",IM_COMPLEX_DIV_LEMMA; "IM_COMPLEX_DIV_LE_0",IM_COMPLEX_DIV_LE_0; "IM_COMPLEX_DIV_LT_0",IM_COMPLEX_DIV_LT_0; "IM_COMPLEX_INV_EQ_0",IM_COMPLEX_INV_EQ_0; "IM_COMPLEX_INV_GE_0",IM_COMPLEX_INV_GE_0; "IM_COMPLEX_INV_GT_0",IM_COMPLEX_INV_GT_0; "IM_COMPLEX_INV_LE_0",IM_COMPLEX_INV_LE_0; "IM_COMPLEX_INV_LT_0",IM_COMPLEX_INV_LT_0; "IM_CSIN",IM_CSIN; "IM_CX",IM_CX; "IM_DEF",IM_DEF; "IM_DIV_CX",IM_DIV_CX; "IM_II",IM_II; "IM_LINEPATH_CX",IM_LINEPATH_CX; "IM_MUL_CX",IM_MUL_CX; "IM_MUL_II",IM_MUL_II; "IM_NEG",IM_NEG; "IM_POW_2",IM_POW_2; "IM_SUB",IM_SUB; "IM_VSUM",IM_VSUM; "IN",IN; "INCREASING_BOUNDED_REAL_VARIATION",INCREASING_BOUNDED_REAL_VARIATION; "INCREASING_BOUNDED_VARIATION",INCREASING_BOUNDED_VARIATION; "INCREASING_BOUNDED_VARIATION_GEN",INCREASING_BOUNDED_VARIATION_GEN; "INCREASING_COUNTABLE_DISCONTINUITIES",INCREASING_COUNTABLE_DISCONTINUITIES; "INCREASING_EXTENDS_FROM_DENSE",INCREASING_EXTENDS_FROM_DENSE; "INCREASING_FTC_AE_IMP_ABSOLUTELY_CONTINUOUS",INCREASING_FTC_AE_IMP_ABSOLUTELY_CONTINUOUS; "INCREASING_LEFT_LIMIT",INCREASING_LEFT_LIMIT; "INCREASING_LEFT_LIMIT_1",INCREASING_LEFT_LIMIT_1; "INCREASING_LEFT_LIMIT_1_GEN",INCREASING_LEFT_LIMIT_1_GEN; "INCREASING_REAL_VARIATION",INCREASING_REAL_VARIATION; "INCREASING_RIGHT_LIMIT",INCREASING_RIGHT_LIMIT; "INCREASING_RIGHT_LIMIT_1",INCREASING_RIGHT_LIMIT_1; "INCREASING_RIGHT_LIMIT_1_GEN",INCREASING_RIGHT_LIMIT_1_GEN; "INCREASING_VECTOR_VARIATION",INCREASING_VECTOR_VARIATION; "INDEFINITE_INTEGRAL_CONTINUOUS",INDEFINITE_INTEGRAL_CONTINUOUS; "INDEFINITE_INTEGRAL_CONTINUOUS_LEFT",INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; "INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT",INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT; "INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS; "INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT; "INDEPENDENT_2",INDEPENDENT_2; "INDEPENDENT_3",INDEPENDENT_3; "INDEPENDENT_BASIS_IMAGE",INDEPENDENT_BASIS_IMAGE; "INDEPENDENT_BOUND",INDEPENDENT_BOUND; "INDEPENDENT_BOUND_GENERAL",INDEPENDENT_BOUND_GENERAL; "INDEPENDENT_CARD_LE_DIM",INDEPENDENT_CARD_LE_DIM; "INDEPENDENT_EMPTY",INDEPENDENT_EMPTY; "INDEPENDENT_EQ_DIM_EQ_CARD",INDEPENDENT_EQ_DIM_EQ_CARD; "INDEPENDENT_EXPLICIT",INDEPENDENT_EXPLICIT; "INDEPENDENT_IMP_AFFINE_DEPENDENT_0",INDEPENDENT_IMP_AFFINE_DEPENDENT_0; "INDEPENDENT_IMP_FINITE",INDEPENDENT_IMP_FINITE; "INDEPENDENT_INJECTIVE_IMAGE",INDEPENDENT_INJECTIVE_IMAGE; "INDEPENDENT_INJECTIVE_IMAGE_GEN",INDEPENDENT_INJECTIVE_IMAGE_GEN; "INDEPENDENT_INSERT",INDEPENDENT_INSERT; "INDEPENDENT_LINEAR_IMAGE_EQ",INDEPENDENT_LINEAR_IMAGE_EQ; "INDEPENDENT_MONO",INDEPENDENT_MONO; "INDEPENDENT_NONZERO",INDEPENDENT_NONZERO; "INDEPENDENT_SING",INDEPENDENT_SING; "INDEPENDENT_SPAN_BOUND",INDEPENDENT_SPAN_BOUND; "INDEPENDENT_STDBASIS",INDEPENDENT_STDBASIS; "INDEPENDENT_SUBSPACES",INDEPENDENT_SUBSPACES; "INDEPENDENT_SUBSPACES_0",INDEPENDENT_SUBSPACES_0; "INDEPENDENT_SUBSPACES_ALT",INDEPENDENT_SUBSPACES_ALT; "INDEPENDENT_UNION",INDEPENDENT_UNION; "INDICATOR_COMPLEMENT",INDICATOR_COMPLEMENT; "INDUCT_LINEAR_ELEMENTARY",INDUCT_LINEAR_ELEMENTARY; "INDUCT_MATRIX_ELEMENTARY",INDUCT_MATRIX_ELEMENTARY; "INDUCT_MATRIX_ELEMENTARY_ALT",INDUCT_MATRIX_ELEMENTARY_ALT; "INDUCT_MATRIX_ROW_OPERATIONS",INDUCT_MATRIX_ROW_OPERATIONS; "IND_SUC_0",IND_SUC_0; "IND_SUC_0_EXISTS",IND_SUC_0_EXISTS; "IND_SUC_INJ",IND_SUC_INJ; "IND_SUC_SPEC",IND_SUC_SPEC; "INESSENTIAL_EQ_CONTINUOUS_LOGARITHM",INESSENTIAL_EQ_CONTINUOUS_LOGARITHM; "INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE",INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE; "INESSENTIAL_EQ_EXTENSIBLE",INESSENTIAL_EQ_EXTENSIBLE; "INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE",INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE; "INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM",INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM; "INESSENTIAL_ON_CLOPEN_UNIONS",INESSENTIAL_ON_CLOPEN_UNIONS; "INESSENTIAL_ON_COMPONENTS",INESSENTIAL_ON_COMPONENTS; "INESSENTIAL_ON_COMPONENTS_EQ",INESSENTIAL_ON_COMPONENTS_EQ; "INESSENTIAL_SPHEREMAP_2",INESSENTIAL_SPHEREMAP_2; "INESSENTIAL_SPHEREMAP_LOWDIM",INESSENTIAL_SPHEREMAP_LOWDIM; "INESSENTIAL_SPHEREMAP_LOWDIM_GEN",INESSENTIAL_SPHEREMAP_LOWDIM_GEN; "INF",INF; "INFINITE",INFINITE; "INFINITE_ARC_IMAGE",INFINITE_ARC_IMAGE; "INFINITE_CARD_LE",INFINITE_CARD_LE; "INFINITE_DIFF_FINITE",INFINITE_DIFF_FINITE; "INFINITE_ENUMERATE",INFINITE_ENUMERATE; "INFINITE_ENUMERATE_EQ",INFINITE_ENUMERATE_EQ; "INFINITE_ENUMERATE_EQ_ALT",INFINITE_ENUMERATE_EQ_ALT; "INFINITE_ENUMERATE_WEAK",INFINITE_ENUMERATE_WEAK; "INFINITE_FROM",INFINITE_FROM; "INFINITE_IMAGE",INFINITE_IMAGE; "INFINITE_IMAGE_INJ",INFINITE_IMAGE_INJ; "INFINITE_INTEGER",INFINITE_INTEGER; "INFINITE_IRRATIONAL_IN_RANGE",INFINITE_IRRATIONAL_IN_RANGE; "INFINITE_NONEMPTY",INFINITE_NONEMPTY; "INFINITE_OPEN_IN",INFINITE_OPEN_IN; "INFINITE_RATIONAL",INFINITE_RATIONAL; "INFINITE_RATIONAL_IN_RANGE",INFINITE_RATIONAL_IN_RANGE; "INFINITE_SIMPLE_PATH_IMAGE",INFINITE_SIMPLE_PATH_IMAGE; "INFINITE_SUPERSET",INFINITE_SUPERSET; "INFINITE_UNIV_PAIR",INFINITE_UNIV_PAIR; "INFINITY_AX",INFINITY_AX; "INFNORM_0",INFNORM_0; "INFNORM_2",INFNORM_2; "INFNORM_EQ_0",INFNORM_EQ_0; "INFNORM_EQ_1_2",INFNORM_EQ_1_2; "INFNORM_EQ_1_IMP",INFNORM_EQ_1_IMP; "INFNORM_LE_NORM",INFNORM_LE_NORM; "INFNORM_MUL",INFNORM_MUL; "INFNORM_MUL_LEMMA",INFNORM_MUL_LEMMA; "INFNORM_NEG",INFNORM_NEG; "INFNORM_POS_LE",INFNORM_POS_LE; "INFNORM_POS_LT",INFNORM_POS_LT; "INFNORM_SET_IMAGE",INFNORM_SET_IMAGE; "INFNORM_SET_LEMMA",INFNORM_SET_LEMMA; "INFNORM_SUB",INFNORM_SUB; "INFNORM_TRIANGLE",INFNORM_TRIANGLE; "INFSUM_0",INFSUM_0; "INFSUM_ADD",INFSUM_ADD; "INFSUM_CMUL",INFSUM_CMUL; "INFSUM_EQ",INFSUM_EQ; "INFSUM_EVEN",INFSUM_EVEN; "INFSUM_LINEAR",INFSUM_LINEAR; "INFSUM_NEG",INFSUM_NEG; "INFSUM_ODD",INFSUM_ODD; "INFSUM_RESTRICT",INFSUM_RESTRICT; "INFSUM_SUB",INFSUM_SUB; "INFSUM_UNIQUE",INFSUM_UNIQUE; "INF_CLOSURE",INF_CLOSURE; "INF_EQ",INF_EQ; "INF_FINITE",INF_FINITE; "INF_FINITE_LEMMA",INF_FINITE_LEMMA; "INF_INSERT",INF_INSERT; "INF_INSERT_FINITE",INF_INSERT_FINITE; "INF_INSERT_INSERT",INF_INSERT_INSERT; "INF_LE_ELEMENT",INF_LE_ELEMENT; "INF_SING",INF_SING; "INF_UNION",INF_UNION; "INF_UNIQUE",INF_UNIQUE; "INF_UNIQUE_FINITE",INF_UNIQUE_FINITE; "INJ",INJ; "INJA",INJA; "INJA_INJ",INJA_INJ; "INJECTIVE_ALT",INJECTIVE_ALT; "INJECTIVE_EQ_1D_OPEN_MAP_UNIV",INJECTIVE_EQ_1D_OPEN_MAP_UNIV; "INJECTIVE_IMAGE",INJECTIVE_IMAGE; "INJECTIVE_IMP_ISOMETRIC",INJECTIVE_IMP_ISOMETRIC; "INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM",INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM; "INJECTIVE_INTO_1D_IMP_OPEN_MAP",INJECTIVE_INTO_1D_IMP_OPEN_MAP; "INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV",INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV; "INJECTIVE_INVERSE",INJECTIVE_INVERSE; "INJECTIVE_INVERSE_o",INJECTIVE_INVERSE_o; "INJECTIVE_LEFT_INVERSE",INJECTIVE_LEFT_INVERSE; "INJECTIVE_LEFT_INVERSE_NONEMPTY",INJECTIVE_LEFT_INVERSE_NONEMPTY; "INJECTIVE_MAP",INJECTIVE_MAP; "INJECTIVE_MAP_OPEN_IFF_CLOSED",INJECTIVE_MAP_OPEN_IFF_CLOSED; "INJECTIVE_ON_ALT",INJECTIVE_ON_ALT; "INJECTIVE_ON_IMAGE",INJECTIVE_ON_IMAGE; "INJECTIVE_ON_LEFT_INVERSE",INJECTIVE_ON_LEFT_INVERSE; "INJECTIVE_ON_PREIMAGE",INJECTIVE_ON_PREIMAGE; "INJECTIVE_PREIMAGE",INJECTIVE_PREIMAGE; "INJECTIVE_SCALING",INJECTIVE_SCALING; "INJF",INJF; "INJF_INJ",INJF_INJ; "INJN",INJN; "INJN_INJ",INJN_INJ; "INJP",INJP; "INJP_INJ",INJP_INJ; "INJ_INVERSE2",INJ_INVERSE2; "INNER_LADD",INNER_LADD; "INNER_LMUL",INNER_LMUL; "INNER_LNEG",INNER_LNEG; "INNER_LZERO",INNER_LZERO; "INNER_RADD",INNER_RADD; "INNER_RMUL",INNER_RMUL; "INNER_RNEG",INNER_RNEG; "INNER_RZERO",INNER_RZERO; "INSEG_ANTISYM",INSEG_ANTISYM; "INSEG_FL_SUBSET",INSEG_FL_SUBSET; "INSEG_LINSEG",INSEG_LINSEG; "INSEG_ORDINAL",INSEG_ORDINAL; "INSEG_PROPER_SUBSET",INSEG_PROPER_SUBSET; "INSEG_PROPER_SUBSET_FL",INSEG_PROPER_SUBSET_FL; "INSEG_REFL",INSEG_REFL; "INSEG_SUBSET",INSEG_SUBSET; "INSEG_SUBSET_FL",INSEG_SUBSET_FL; "INSEG_TRANS",INSEG_TRANS; "INSEG_WOSET",INSEG_WOSET; "INSERT",INSERT; "INSERT_AC",INSERT_AC; "INSERT_COMM",INSERT_COMM; "INSERT_DEF",INSERT_DEF; "INSERT_DELETE",INSERT_DELETE; "INSERT_DIFF",INSERT_DIFF; "INSERT_INSERT",INSERT_INSERT; "INSERT_INTER",INSERT_INTER; "INSERT_SUBSET",INSERT_SUBSET; "INSERT_UNION",INSERT_UNION; "INSERT_UNION_EQ",INSERT_UNION_EQ; "INSERT_UNIV",INSERT_UNIV; "INSIDE_ARC_EMPTY",INSIDE_ARC_EMPTY; "INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY",INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY; "INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY",INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY; "INSIDE_CONNECTED_COMPONENT_LE",INSIDE_CONNECTED_COMPONENT_LE; "INSIDE_CONNECTED_COMPONENT_LT",INSIDE_CONNECTED_COMPONENT_LT; "INSIDE_CONVEX",INSIDE_CONVEX; "INSIDE_EMPTY",INSIDE_EMPTY; "INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT",INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT; "INSIDE_EQ_OUTSIDE",INSIDE_EQ_OUTSIDE; "INSIDE_FRONTIER_EQ_INTERIOR",INSIDE_FRONTIER_EQ_INTERIOR; "INSIDE_INSIDE",INSIDE_INSIDE; "INSIDE_INSIDE_COMPACT_CONNECTED",INSIDE_INSIDE_COMPACT_CONNECTED; "INSIDE_INSIDE_EQ_EMPTY",INSIDE_INSIDE_EQ_EMPTY; "INSIDE_INSIDE_SUBSET",INSIDE_INSIDE_SUBSET; "INSIDE_INTER_OUTSIDE",INSIDE_INTER_OUTSIDE; "INSIDE_IN_COMPONENTS",INSIDE_IN_COMPONENTS; "INSIDE_LINEAR_IMAGE",INSIDE_LINEAR_IMAGE; "INSIDE_MONO",INSIDE_MONO; "INSIDE_MONO_ALT",INSIDE_MONO_ALT; "INSIDE_NO_OVERLAP",INSIDE_NO_OVERLAP; "INSIDE_OF_TRIANGLE",INSIDE_OF_TRIANGLE; "INSIDE_OUTSIDE",INSIDE_OUTSIDE; "INSIDE_OUTSIDE_COMPACT_CONNECTED",INSIDE_OUTSIDE_COMPACT_CONNECTED; "INSIDE_OUTSIDE_INTERSECT_CONNECTED",INSIDE_OUTSIDE_INTERSECT_CONNECTED; "INSIDE_OUTSIDE_UNIQUE",INSIDE_OUTSIDE_UNIQUE; "INSIDE_SAME_COMPONENT",INSIDE_SAME_COMPONENT; "INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED",INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED; "INSIDE_SELF_OUTSIDE_EVERSION",INSIDE_SELF_OUTSIDE_EVERSION; "INSIDE_SIMPLE_CURVE_IMP_CLOSED",INSIDE_SIMPLE_CURVE_IMP_CLOSED; "INSIDE_SPHERE",INSIDE_SPHERE; "INSIDE_SUBSET",INSIDE_SUBSET; "INSIDE_SUBSET_CONVEX",INSIDE_SUBSET_CONVEX; "INSIDE_SUBSET_CONVEX_HULL",INSIDE_SUBSET_CONVEX_HULL; "INSIDE_SUBSET_INTERIOR_CONVEX",INSIDE_SUBSET_INTERIOR_CONVEX; "INSIDE_SUBSET_INTERIOR_CONVEX_HULL",INSIDE_SUBSET_INTERIOR_CONVEX_HULL; "INSIDE_TRANSLATION",INSIDE_TRANSLATION; "INSIDE_UNION_OUTSIDE",INSIDE_UNION_OUTSIDE; "INSIDE_UNIQUE",INSIDE_UNIQUE; "INSIDE_WITH_INSIDE",INSIDE_WITH_INSIDE; "INTEGER_ABS",INTEGER_ABS; "INTEGER_ABS_MUL_EQ_1",INTEGER_ABS_MUL_EQ_1; "INTEGER_ADD",INTEGER_ADD; "INTEGER_ADD_EQ",INTEGER_ADD_EQ; "INTEGER_CASES",INTEGER_CASES; "INTEGER_CLOSED",INTEGER_CLOSED; "INTEGER_DET",INTEGER_DET; "INTEGER_DIV",INTEGER_DIV; "INTEGER_EXISTS_BETWEEN",INTEGER_EXISTS_BETWEEN; "INTEGER_EXISTS_BETWEEN_ABS",INTEGER_EXISTS_BETWEEN_ABS; "INTEGER_EXISTS_BETWEEN_ABS_LT",INTEGER_EXISTS_BETWEEN_ABS_LT; "INTEGER_EXISTS_BETWEEN_ALT",INTEGER_EXISTS_BETWEEN_ALT; "INTEGER_EXISTS_BETWEEN_LT",INTEGER_EXISTS_BETWEEN_LT; "INTEGER_MUL",INTEGER_MUL; "INTEGER_NEG",INTEGER_NEG; "INTEGER_POS",INTEGER_POS; "INTEGER_POW",INTEGER_POW; "INTEGER_PRODUCT",INTEGER_PRODUCT; "INTEGER_REAL_OF_INT",INTEGER_REAL_OF_INT; "INTEGER_ROUND",INTEGER_ROUND; "INTEGER_SIGN",INTEGER_SIGN; "INTEGER_SUB",INTEGER_SUB; "INTEGER_SUB_EQ",INTEGER_SUB_EQ; "INTEGER_SUM",INTEGER_SUM; "INTEGER_WINDING_NUMBER",INTEGER_WINDING_NUMBER; "INTEGER_WINDING_NUMBER_EQ",INTEGER_WINDING_NUMBER_EQ; "INTEGRABLE_0",INTEGRABLE_0; "INTEGRABLE_ADD",INTEGRABLE_ADD; "INTEGRABLE_AFFINITY",INTEGRABLE_AFFINITY; "INTEGRABLE_ALT",INTEGRABLE_ALT; "INTEGRABLE_ALT_SUBSET",INTEGRABLE_ALT_SUBSET; "INTEGRABLE_BOUNDED_VARIATION",INTEGRABLE_BOUNDED_VARIATION; "INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL",INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL; "INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL",INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL; "INTEGRABLE_BOUNDED_VARIATION_COMPLEX_LMUL",INTEGRABLE_BOUNDED_VARIATION_COMPLEX_LMUL; "INTEGRABLE_BOUNDED_VARIATION_COMPLEX_RMUL",INTEGRABLE_BOUNDED_VARIATION_COMPLEX_RMUL; "INTEGRABLE_BOUNDED_VARIATION_PRODUCT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT; "INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT; "INTEGRABLE_BY_PARTS",INTEGRABLE_BY_PARTS; "INTEGRABLE_BY_PARTS_EQ",INTEGRABLE_BY_PARTS_EQ; "INTEGRABLE_CASES",INTEGRABLE_CASES; "INTEGRABLE_CAUCHY",INTEGRABLE_CAUCHY; "INTEGRABLE_CCONTINUOUS_EXPLICIT",INTEGRABLE_CCONTINUOUS_EXPLICIT; "INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC",INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC; "INTEGRABLE_CMUL",INTEGRABLE_CMUL; "INTEGRABLE_CMUL_EQ",INTEGRABLE_CMUL_EQ; "INTEGRABLE_COMBINE",INTEGRABLE_COMBINE; "INTEGRABLE_COMBINE_DIVISION",INTEGRABLE_COMBINE_DIVISION; "INTEGRABLE_COMPLEX_0",INTEGRABLE_COMPLEX_0; "INTEGRABLE_COMPLEX_LMUL",INTEGRABLE_COMPLEX_LMUL; "INTEGRABLE_COMPLEX_LMUL_EQ",INTEGRABLE_COMPLEX_LMUL_EQ; "INTEGRABLE_COMPLEX_RMUL",INTEGRABLE_COMPLEX_RMUL; "INTEGRABLE_COMPLEX_RMUL_EQ",INTEGRABLE_COMPLEX_RMUL_EQ; "INTEGRABLE_COMPONENTWISE",INTEGRABLE_COMPONENTWISE; "INTEGRABLE_CONST",INTEGRABLE_CONST; "INTEGRABLE_CONTINUOUS",INTEGRABLE_CONTINUOUS; "INTEGRABLE_CONVOLUTION_SYM",INTEGRABLE_CONVOLUTION_SYM; "INTEGRABLE_DECREASING",INTEGRABLE_DECREASING; "INTEGRABLE_DECREASING_1",INTEGRABLE_DECREASING_1; "INTEGRABLE_DECREASING_PRODUCT",INTEGRABLE_DECREASING_PRODUCT; "INTEGRABLE_DECREASING_PRODUCT_UNIV",INTEGRABLE_DECREASING_PRODUCT_UNIV; "INTEGRABLE_DIFF",INTEGRABLE_DIFF; "INTEGRABLE_EQ",INTEGRABLE_EQ; "INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE",INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE; "INTEGRABLE_IMP_MEASURABLE",INTEGRABLE_IMP_MEASURABLE; "INTEGRABLE_IMP_REAL_MEASURABLE",INTEGRABLE_IMP_REAL_MEASURABLE; "INTEGRABLE_INCREASING",INTEGRABLE_INCREASING; "INTEGRABLE_INCREASING_1",INTEGRABLE_INCREASING_1; "INTEGRABLE_INCREASING_PRODUCT",INTEGRABLE_INCREASING_PRODUCT; "INTEGRABLE_INCREASING_PRODUCT_UNIV",INTEGRABLE_INCREASING_PRODUCT_UNIV; "INTEGRABLE_INTEGRAL",INTEGRABLE_INTEGRAL; "INTEGRABLE_LINEAR",INTEGRABLE_LINEAR; "INTEGRABLE_MIN_CONST_1",INTEGRABLE_MIN_CONST_1; "INTEGRABLE_NEG",INTEGRABLE_NEG; "INTEGRABLE_NEG_EQ",INTEGRABLE_NEG_EQ; "INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND",INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND; "INTEGRABLE_ON_CONST",INTEGRABLE_ON_CONST; "INTEGRABLE_ON_EMPTY",INTEGRABLE_ON_EMPTY; "INTEGRABLE_ON_INDICATOR",INTEGRABLE_ON_INDICATOR; "INTEGRABLE_ON_LITTLE_SUBINTERVALS",INTEGRABLE_ON_LITTLE_SUBINTERVALS; "INTEGRABLE_ON_NEGLIGIBLE",INTEGRABLE_ON_NEGLIGIBLE; "INTEGRABLE_ON_NULL",INTEGRABLE_ON_NULL; "INTEGRABLE_ON_OPEN_INTERVAL",INTEGRABLE_ON_OPEN_INTERVAL; "INTEGRABLE_ON_REFL",INTEGRABLE_ON_REFL; "INTEGRABLE_ON_SUBDIVISION",INTEGRABLE_ON_SUBDIVISION; "INTEGRABLE_ON_SUBINTERVAL",INTEGRABLE_ON_SUBINTERVAL; "INTEGRABLE_ON_SUBINTERVAL_GEN",INTEGRABLE_ON_SUBINTERVAL_GEN; "INTEGRABLE_ON_SUBSET",INTEGRABLE_ON_SUBSET; "INTEGRABLE_ON_SUPERSET",INTEGRABLE_ON_SUPERSET; "INTEGRABLE_PASTECART_SYM",INTEGRABLE_PASTECART_SYM; "INTEGRABLE_PASTECART_SYM_UNIV",INTEGRABLE_PASTECART_SYM_UNIV; "INTEGRABLE_REFLECT",INTEGRABLE_REFLECT; "INTEGRABLE_REFLECT_GEN",INTEGRABLE_REFLECT_GEN; "INTEGRABLE_RESTRICT",INTEGRABLE_RESTRICT; "INTEGRABLE_RESTRICT_INTER",INTEGRABLE_RESTRICT_INTER; "INTEGRABLE_RESTRICT_UNIV",INTEGRABLE_RESTRICT_UNIV; "INTEGRABLE_SPIKE",INTEGRABLE_SPIKE; "INTEGRABLE_SPIKE_EQ",INTEGRABLE_SPIKE_EQ; "INTEGRABLE_SPIKE_FINITE",INTEGRABLE_SPIKE_FINITE; "INTEGRABLE_SPIKE_INTERIOR",INTEGRABLE_SPIKE_INTERIOR; "INTEGRABLE_SPIKE_SET",INTEGRABLE_SPIKE_SET; "INTEGRABLE_SPIKE_SET_EQ",INTEGRABLE_SPIKE_SET_EQ; "INTEGRABLE_SPLIT",INTEGRABLE_SPLIT; "INTEGRABLE_STRADDLE",INTEGRABLE_STRADDLE; "INTEGRABLE_STRADDLE_INTERVAL",INTEGRABLE_STRADDLE_INTERVAL; "INTEGRABLE_STRETCH",INTEGRABLE_STRETCH; "INTEGRABLE_SUB",INTEGRABLE_SUB; "INTEGRABLE_SUBINTERVAL",INTEGRABLE_SUBINTERVAL; "INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE",INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE; "INTEGRABLE_SUBINTERVALS_IMP_REAL_MEASURABLE",INTEGRABLE_SUBINTERVALS_IMP_REAL_MEASURABLE; "INTEGRABLE_TRANSLATION",INTEGRABLE_TRANSLATION; "INTEGRABLE_TWIZZLE_EQ",INTEGRABLE_TWIZZLE_EQ; "INTEGRABLE_UNIFORM_LIMIT",INTEGRABLE_UNIFORM_LIMIT; "INTEGRABLE_UNION",INTEGRABLE_UNION; "INTEGRABLE_UNIONS",INTEGRABLE_UNIONS; "INTEGRABLE_UNIONS_IMAGE",INTEGRABLE_UNIONS_IMAGE; "INTEGRABLE_UNION_EQ",INTEGRABLE_UNION_EQ; "INTEGRABLE_VSUM",INTEGRABLE_VSUM; "INTEGRAL_0",INTEGRAL_0; "INTEGRAL_ADD",INTEGRAL_ADD; "INTEGRAL_CHANGE_OF_VARIABLES",INTEGRAL_CHANGE_OF_VARIABLES; "INTEGRAL_CHANGE_OF_VARIABLES_LINEAR",INTEGRAL_CHANGE_OF_VARIABLES_LINEAR; "INTEGRAL_CMUL",INTEGRAL_CMUL; "INTEGRAL_COMBINE",INTEGRAL_COMBINE; "INTEGRAL_COMBINE_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_DIVISION_BOTTOMUP; "INTEGRAL_COMBINE_DIVISION_TOPDOWN",INTEGRAL_COMBINE_DIVISION_TOPDOWN; "INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP; "INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; "INTEGRAL_COMPLEX_LMUL",INTEGRAL_COMPLEX_LMUL; "INTEGRAL_COMPLEX_RMUL",INTEGRAL_COMPLEX_RMUL; "INTEGRAL_COMPONENT",INTEGRAL_COMPONENT; "INTEGRAL_COMPONENT_LBOUND",INTEGRAL_COMPONENT_LBOUND; "INTEGRAL_COMPONENT_LE",INTEGRAL_COMPONENT_LE; "INTEGRAL_COMPONENT_LE_AE",INTEGRAL_COMPONENT_LE_AE; "INTEGRAL_COMPONENT_POS",INTEGRAL_COMPONENT_POS; "INTEGRAL_COMPONENT_UBOUND",INTEGRAL_COMPONENT_UBOUND; "INTEGRAL_CONST",INTEGRAL_CONST; "INTEGRAL_CONST_GEN",INTEGRAL_CONST_GEN; "INTEGRAL_CONVOLUTION_SYM",INTEGRAL_CONVOLUTION_SYM; "INTEGRAL_COUNTABLE_UNIONS",INTEGRAL_COUNTABLE_UNIONS; "INTEGRAL_COUNTABLE_UNIONS_ALT",INTEGRAL_COUNTABLE_UNIONS_ALT; "INTEGRAL_DIFF",INTEGRAL_DIFF; "INTEGRAL_DROP_LE",INTEGRAL_DROP_LE; "INTEGRAL_DROP_LE_AE",INTEGRAL_DROP_LE_AE; "INTEGRAL_DROP_LE_MEASURABLE",INTEGRAL_DROP_LE_MEASURABLE; "INTEGRAL_DROP_POS",INTEGRAL_DROP_POS; "INTEGRAL_DROP_POS_AE",INTEGRAL_DROP_POS_AE; "INTEGRAL_EMPTY",INTEGRAL_EMPTY; "INTEGRAL_EQ",INTEGRAL_EQ; "INTEGRAL_EQ_0",INTEGRAL_EQ_0; "INTEGRAL_EQ_HAS_INTEGRAL",INTEGRAL_EQ_HAS_INTEGRAL; "INTEGRAL_HAS_VECTOR_DERIVATIVE",INTEGRAL_HAS_VECTOR_DERIVATIVE; "INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE",INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE; "INTEGRAL_INDICATOR",INTEGRAL_INDICATOR; "INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION; "INTEGRAL_INTERVALS_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION; "INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT; "INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT; "INTEGRAL_LINEAR",INTEGRAL_LINEAR; "INTEGRAL_MEASURE",INTEGRAL_MEASURE; "INTEGRAL_MEASURE_UNIV",INTEGRAL_MEASURE_UNIV; "INTEGRAL_NEG",INTEGRAL_NEG; "INTEGRAL_NORM_BOUND_INTEGRAL",INTEGRAL_NORM_BOUND_INTEGRAL; "INTEGRAL_NORM_BOUND_INTEGRAL_AE",INTEGRAL_NORM_BOUND_INTEGRAL_AE; "INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; "INTEGRAL_NULL",INTEGRAL_NULL; "INTEGRAL_ON_IMAGE_DROP_UBOUND_LE",INTEGRAL_ON_IMAGE_DROP_UBOUND_LE; "INTEGRAL_ON_NEGLIGIBLE",INTEGRAL_ON_NEGLIGIBLE; "INTEGRAL_OPEN_INTERVAL",INTEGRAL_OPEN_INTERVAL; "INTEGRAL_PASTECART_CONST",INTEGRAL_PASTECART_CONST; "INTEGRAL_PASTECART_CONTINUOUS",INTEGRAL_PASTECART_CONTINUOUS; "INTEGRAL_PASTECART_SYM",INTEGRAL_PASTECART_SYM; "INTEGRAL_PASTECART_SYM_UNIV",INTEGRAL_PASTECART_SYM_UNIV; "INTEGRAL_REFL",INTEGRAL_REFL; "INTEGRAL_REFLECT",INTEGRAL_REFLECT; "INTEGRAL_REFLECT_GEN",INTEGRAL_REFLECT_GEN; "INTEGRAL_RESTRICT",INTEGRAL_RESTRICT; "INTEGRAL_RESTRICT_INTER",INTEGRAL_RESTRICT_INTER; "INTEGRAL_RESTRICT_UNIV",INTEGRAL_RESTRICT_UNIV; "INTEGRAL_SPIKE",INTEGRAL_SPIKE; "INTEGRAL_SPIKE_SET",INTEGRAL_SPIKE_SET; "INTEGRAL_SPLIT",INTEGRAL_SPLIT; "INTEGRAL_SPLIT_SIGNED",INTEGRAL_SPLIT_SIGNED; "INTEGRAL_SUB",INTEGRAL_SUB; "INTEGRAL_SUBSET_COMPONENT_LE",INTEGRAL_SUBSET_COMPONENT_LE; "INTEGRAL_SUBSET_DROP_LE",INTEGRAL_SUBSET_DROP_LE; "INTEGRAL_SUBSET_DROP_LE_AE",INTEGRAL_SUBSET_DROP_LE_AE; "INTEGRAL_SWAP_CONTINUOUS",INTEGRAL_SWAP_CONTINUOUS; "INTEGRAL_TRANSLATION",INTEGRAL_TRANSLATION; "INTEGRAL_TWIZZLE_EQ",INTEGRAL_TWIZZLE_EQ; "INTEGRAL_UNION",INTEGRAL_UNION; "INTEGRAL_UNIQUE",INTEGRAL_UNIQUE; "INTEGRAL_VSUM",INTEGRAL_VSUM; "INTEGRAL_ZERO_ON_SUBINTERVALS_IMP_ZERO_AE",INTEGRAL_ZERO_ON_SUBINTERVALS_IMP_ZERO_AE; "INTEGRATION_BY_PARTS",INTEGRATION_BY_PARTS; "INTEGRATION_BY_PARTS_SIMPLE",INTEGRATION_BY_PARTS_SIMPLE; "INTER",INTER; "INTERIOR_AFFINITY",INTERIOR_AFFINITY; "INTERIOR_ARC_IMAGE",INTERIOR_ARC_IMAGE; "INTERIOR_BALL",INTERIOR_BALL; "INTERIOR_BIJECTIVE_LINEAR_IMAGE",INTERIOR_BIJECTIVE_LINEAR_IMAGE; "INTERIOR_CBALL",INTERIOR_CBALL; "INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER",INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER; "INTERIOR_CLOSED_INTERVAL",INTERIOR_CLOSED_INTERVAL; "INTERIOR_CLOSED_UNION_EMPTY_INTERIOR",INTERIOR_CLOSED_UNION_EMPTY_INTERIOR; "INTERIOR_CLOSURE",INTERIOR_CLOSURE; "INTERIOR_CLOSURE_IDEMP",INTERIOR_CLOSURE_IDEMP; "INTERIOR_CLOSURE_INTER_OPEN",INTERIOR_CLOSURE_INTER_OPEN; "INTERIOR_COMPLEMENT",INTERIOR_COMPLEMENT; "INTERIOR_CONVEX_HULL_3",INTERIOR_CONVEX_HULL_3; "INTERIOR_CONVEX_HULL_3_MINIMAL",INTERIOR_CONVEX_HULL_3_MINIMAL; "INTERIOR_CONVEX_HULL_EQ_EMPTY",INTERIOR_CONVEX_HULL_EQ_EMPTY; "INTERIOR_CONVEX_HULL_EXPLICIT",INTERIOR_CONVEX_HULL_EXPLICIT; "INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL",INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL; "INTERIOR_DIFF",INTERIOR_DIFF; "INTERIOR_EMPTY",INTERIOR_EMPTY; "INTERIOR_EQ",INTERIOR_EQ; "INTERIOR_EQ_EMPTY",INTERIOR_EQ_EMPTY; "INTERIOR_EQ_EMPTY_ALT",INTERIOR_EQ_EMPTY_ALT; "INTERIOR_EQ_UNIV",INTERIOR_EQ_UNIV; "INTERIOR_FINITE_INTERS",INTERIOR_FINITE_INTERS; "INTERIOR_FRONTIER",INTERIOR_FRONTIER; "INTERIOR_FRONTIER_EMPTY",INTERIOR_FRONTIER_EMPTY; "INTERIOR_HALFSPACE_COMPONENT_GE",INTERIOR_HALFSPACE_COMPONENT_GE; "INTERIOR_HALFSPACE_COMPONENT_LE",INTERIOR_HALFSPACE_COMPONENT_LE; "INTERIOR_HALFSPACE_GE",INTERIOR_HALFSPACE_GE; "INTERIOR_HALFSPACE_LE",INTERIOR_HALFSPACE_LE; "INTERIOR_HYPERPLANE",INTERIOR_HYPERPLANE; "INTERIOR_IMAGE_SUBSET",INTERIOR_IMAGE_SUBSET; "INTERIOR_INJECTIVE_LINEAR_IMAGE",INTERIOR_INJECTIVE_LINEAR_IMAGE; "INTERIOR_INSIDE_FRONTIER",INTERIOR_INSIDE_FRONTIER; "INTERIOR_INTER",INTERIOR_INTER; "INTERIOR_INTERIOR",INTERIOR_INTERIOR; "INTERIOR_INTERS_SUBSET",INTERIOR_INTERS_SUBSET; "INTERIOR_INTERVAL",INTERIOR_INTERVAL; "INTERIOR_LIMIT_POINT",INTERIOR_LIMIT_POINT; "INTERIOR_MAXIMAL",INTERIOR_MAXIMAL; "INTERIOR_MAXIMAL_EQ",INTERIOR_MAXIMAL_EQ; "INTERIOR_NEGATIONS",INTERIOR_NEGATIONS; "INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF",INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF; "INTERIOR_OF_CLOSURE_OF",INTERIOR_OF_CLOSURE_OF; "INTERIOR_OF_CLOSURE_OF_IDEMP",INTERIOR_OF_CLOSURE_OF_IDEMP; "INTERIOR_OF_COMPLEMENT",INTERIOR_OF_COMPLEMENT; "INTERIOR_OF_EMPTY",INTERIOR_OF_EMPTY; "INTERIOR_OF_EQ",INTERIOR_OF_EQ; "INTERIOR_OF_EQ_EMPTY",INTERIOR_OF_EQ_EMPTY; "INTERIOR_OF_EQ_EMPTY_ALT",INTERIOR_OF_EQ_EMPTY_ALT; "INTERIOR_OF_EQ_EMPTY_COMPLEMENT",INTERIOR_OF_EQ_EMPTY_COMPLEMENT; "INTERIOR_OF_FRONTIER_OF",INTERIOR_OF_FRONTIER_OF; "INTERIOR_OF_FRONTIER_OF_EMPTY",INTERIOR_OF_FRONTIER_OF_EMPTY; "INTERIOR_OF_INJECTIVE_LINEAR_IMAGE",INTERIOR_OF_INJECTIVE_LINEAR_IMAGE; "INTERIOR_OF_INTER",INTERIOR_OF_INTER; "INTERIOR_OF_INTERIOR_OF",INTERIOR_OF_INTERIOR_OF; "INTERIOR_OF_INTERS_SUBSET",INTERIOR_OF_INTERS_SUBSET; "INTERIOR_OF_MAXIMAL",INTERIOR_OF_MAXIMAL; "INTERIOR_OF_MAXIMAL_EQ",INTERIOR_OF_MAXIMAL_EQ; "INTERIOR_OF_MONO",INTERIOR_OF_MONO; "INTERIOR_OF_OPEN_IN",INTERIOR_OF_OPEN_IN; "INTERIOR_OF_RESTRICT",INTERIOR_OF_RESTRICT; "INTERIOR_OF_SUBSET",INTERIOR_OF_SUBSET; "INTERIOR_OF_SUBSET_CLOSURE_OF",INTERIOR_OF_SUBSET_CLOSURE_OF; "INTERIOR_OF_SUBSET_SUBTOPOLOGY",INTERIOR_OF_SUBSET_SUBTOPOLOGY; "INTERIOR_OF_SUBSET_TOPSPACE",INTERIOR_OF_SUBSET_TOPSPACE; "INTERIOR_OF_SUBTOPOLOGY_MONO",INTERIOR_OF_SUBTOPOLOGY_MONO; "INTERIOR_OF_SUBTOPOLOGY_OPEN",INTERIOR_OF_SUBTOPOLOGY_OPEN; "INTERIOR_OF_SUBTOPOLOGY_SUBSET",INTERIOR_OF_SUBTOPOLOGY_SUBSET; "INTERIOR_OF_SUBTOPOLOGY_SUBSETS",INTERIOR_OF_SUBTOPOLOGY_SUBSETS; "INTERIOR_OF_TOPSPACE",INTERIOR_OF_TOPSPACE; "INTERIOR_OF_TRANSLATION",INTERIOR_OF_TRANSLATION; "INTERIOR_OF_TRIANGLE",INTERIOR_OF_TRIANGLE; "INTERIOR_OF_UNIONS_OPEN_IN_SUBSETS",INTERIOR_OF_UNIONS_OPEN_IN_SUBSETS; "INTERIOR_OF_UNION_EQ_EMPTY",INTERIOR_OF_UNION_EQ_EMPTY; "INTERIOR_OF_UNIQUE",INTERIOR_OF_UNIQUE; "INTERIOR_OPEN",INTERIOR_OPEN; "INTERIOR_PCROSS",INTERIOR_PCROSS; "INTERIOR_REAL",INTERIOR_REAL; "INTERIOR_RECTIFIABLE_PATH_IMAGE",INTERIOR_RECTIFIABLE_PATH_IMAGE; "INTERIOR_SCALING",INTERIOR_SCALING; "INTERIOR_SEGMENT",INTERIOR_SEGMENT; "INTERIOR_SIMPLEX_NONEMPTY",INTERIOR_SIMPLEX_NONEMPTY; "INTERIOR_SIMPLE_PATH_IMAGE",INTERIOR_SIMPLE_PATH_IMAGE; "INTERIOR_SING",INTERIOR_SING; "INTERIOR_SPHERE",INTERIOR_SPHERE; "INTERIOR_STANDARD_HYPERPLANE",INTERIOR_STANDARD_HYPERPLANE; "INTERIOR_STD_SIMPLEX",INTERIOR_STD_SIMPLEX; "INTERIOR_STRIP_COMPONENT_LE",INTERIOR_STRIP_COMPONENT_LE; "INTERIOR_SUBSET",INTERIOR_SUBSET; "INTERIOR_SUBSET_RELATIVE_INTERIOR",INTERIOR_SUBSET_RELATIVE_INTERIOR; "INTERIOR_SUBSET_UNION_INTERVALS",INTERIOR_SUBSET_UNION_INTERVALS; "INTERIOR_SURJECTIVE_LINEAR_IMAGE",INTERIOR_SURJECTIVE_LINEAR_IMAGE; "INTERIOR_TRANSLATION",INTERIOR_TRANSLATION; "INTERIOR_UNIONS_OPEN_SUBSETS",INTERIOR_UNIONS_OPEN_SUBSETS; "INTERIOR_UNION_EQ_EMPTY",INTERIOR_UNION_EQ_EMPTY; "INTERIOR_UNIQUE",INTERIOR_UNIQUE; "INTERIOR_UNIV",INTERIOR_UNIV; "INTERS",INTERS; "INTERSECTION_OF",INTERSECTION_OF; "INTERSECTION_OF_INC",INTERSECTION_OF_INC; "INTERSECTION_OF_MONO",INTERSECTION_OF_MONO; "INTERS_0",INTERS_0; "INTERS_1",INTERS_1; "INTERS_2",INTERS_2; "INTERS_EQ_UNIV",INTERS_EQ_UNIV; "INTERS_FACES_FINITE_ALTBOUND",INTERS_FACES_FINITE_ALTBOUND; "INTERS_FACES_FINITE_BOUND",INTERS_FACES_FINITE_BOUND; "INTERS_GSPEC",INTERS_GSPEC; "INTERS_IMAGE",INTERS_IMAGE; "INTERS_INSERT",INTERS_INSERT; "INTERS_IN_CHAIN",INTERS_IN_CHAIN; "INTERS_OVER_UNIONS",INTERS_OVER_UNIONS; "INTERS_SUBSET",INTERS_SUBSET; "INTERS_SUBSET_STRONG",INTERS_SUBSET_STRONG; "INTERS_UNION",INTERS_UNION; "INTERS_UNIONS",INTERS_UNIONS; "INTERVAL_1",INTERVAL_1; "INTERVAL_BIJ_AFFINE",INTERVAL_BIJ_AFFINE; "INTERVAL_BIJ_BIJ",INTERVAL_BIJ_BIJ; "INTERVAL_BISECTION",INTERVAL_BISECTION; "INTERVAL_BISECTION_STEP",INTERVAL_BISECTION_STEP; "INTERVAL_BOUNDS_EMPTY_1",INTERVAL_BOUNDS_EMPTY_1; "INTERVAL_BOUNDS_NULL_1",INTERVAL_BOUNDS_NULL_1; "INTERVAL_CASES_1",INTERVAL_CASES_1; "INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD",INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD; "INTERVAL_DOUBLESPLIT",INTERVAL_DOUBLESPLIT; "INTERVAL_EQ_EMPTY",INTERVAL_EQ_EMPTY; "INTERVAL_EQ_EMPTY_1",INTERVAL_EQ_EMPTY_1; "INTERVAL_IMAGE_AFFINITY_INTERVAL",INTERVAL_IMAGE_AFFINITY_INTERVAL; "INTERVAL_IMAGE_STRETCH_INTERVAL",INTERVAL_IMAGE_STRETCH_INTERVAL; "INTERVAL_INTER_HYPERPLANE",INTERVAL_INTER_HYPERPLANE; "INTERVAL_LOWERBOUND",INTERVAL_LOWERBOUND; "INTERVAL_LOWERBOUND_1",INTERVAL_LOWERBOUND_1; "INTERVAL_LOWERBOUND_NONEMPTY",INTERVAL_LOWERBOUND_NONEMPTY; "INTERVAL_NE_EMPTY",INTERVAL_NE_EMPTY; "INTERVAL_NE_EMPTY_1",INTERVAL_NE_EMPTY_1; "INTERVAL_OPEN_SUBSET_CLOSED",INTERVAL_OPEN_SUBSET_CLOSED; "INTERVAL_REAL_INTERVAL",INTERVAL_REAL_INTERVAL; "INTERVAL_SING",INTERVAL_SING; "INTERVAL_SPLIT",INTERVAL_SPLIT; "INTERVAL_SUBDIVISION",INTERVAL_SUBDIVISION; "INTERVAL_SUBSET_IS_INTERVAL",INTERVAL_SUBSET_IS_INTERVAL; "INTERVAL_SUBSET_SEGMENT_1",INTERVAL_SUBSET_SEGMENT_1; "INTERVAL_TRANSLATION",INTERVAL_TRANSLATION; "INTERVAL_UPPERBOUND",INTERVAL_UPPERBOUND; "INTERVAL_UPPERBOUND_1",INTERVAL_UPPERBOUND_1; "INTERVAL_UPPERBOUND_NONEMPTY",INTERVAL_UPPERBOUND_NONEMPTY; "INTER_ACI",INTER_ACI; "INTER_ASSOC",INTER_ASSOC; "INTER_BALLS_EQ_EMPTY",INTER_BALLS_EQ_EMPTY; "INTER_COMM",INTER_COMM; "INTER_CONIC_HULL",INTER_CONIC_HULL; "INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER",INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER; "INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR",INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR; "INTER_CROSS",INTER_CROSS; "INTER_EMPTY",INTER_EMPTY; "INTER_IDEMPOT",INTER_IDEMPOT; "INTER_INTERIOR_UNIONS_INTERVALS",INTER_INTERIOR_UNIONS_INTERVALS; "INTER_INTERS",INTER_INTERS; "INTER_INTERVAL",INTER_INTERVAL; "INTER_INTERVAL_1",INTER_INTERVAL_1; "INTER_INTERVAL_MIXED_EQ_EMPTY",INTER_INTERVAL_MIXED_EQ_EMPTY; "INTER_NUMSEG",INTER_NUMSEG; "INTER_OVER_UNION",INTER_OVER_UNION; "INTER_PCROSS",INTER_PCROSS; "INTER_RELATIVE_FRONTIER_CONIC_HULL",INTER_RELATIVE_FRONTIER_CONIC_HULL; "INTER_RELATIVE_INTERIOR_SUBSET",INTER_RELATIVE_INTERIOR_SUBSET; "INTER_SEGMENT",INTER_SEGMENT; "INTER_SPHERE_EQ_EMPTY",INTER_SPHERE_EQ_EMPTY; "INTER_SUBSET",INTER_SUBSET; "INTER_UNIONS",INTER_UNIONS; "INTER_UNIONS_PAIRWISE_DISJOINT",INTER_UNIONS_PAIRWISE_DISJOINT; "INTER_UNIV",INTER_UNIV; "INT_ABS",INT_ABS; "INT_ABS_0",INT_ABS_0; "INT_ABS_1",INT_ABS_1; "INT_ABS_ABS",INT_ABS_ABS; "INT_ABS_BETWEEN",INT_ABS_BETWEEN; "INT_ABS_BETWEEN1",INT_ABS_BETWEEN1; "INT_ABS_BETWEEN2",INT_ABS_BETWEEN2; "INT_ABS_BOUND",INT_ABS_BOUND; "INT_ABS_CASES",INT_ABS_CASES; "INT_ABS_CIRCLE",INT_ABS_CIRCLE; "INT_ABS_LE",INT_ABS_LE; "INT_ABS_MUL",INT_ABS_MUL; "INT_ABS_MUL_1",INT_ABS_MUL_1; "INT_ABS_NEG",INT_ABS_NEG; "INT_ABS_NUM",INT_ABS_NUM; "INT_ABS_NZ",INT_ABS_NZ; "INT_ABS_POS",INT_ABS_POS; "INT_ABS_POW",INT_ABS_POW; "INT_ABS_REFL",INT_ABS_REFL; "INT_ABS_SGN",INT_ABS_SGN; "INT_ABS_SIGN",INT_ABS_SIGN; "INT_ABS_SIGN2",INT_ABS_SIGN2; "INT_ABS_STILLNZ",INT_ABS_STILLNZ; "INT_ABS_SUB",INT_ABS_SUB; "INT_ABS_SUB_ABS",INT_ABS_SUB_ABS; "INT_ABS_TRIANGLE",INT_ABS_TRIANGLE; "INT_ABS_ZERO",INT_ABS_ZERO; "INT_ADD2_SUB2",INT_ADD2_SUB2; "INT_ADD_AC",INT_ADD_AC; "INT_ADD_ASSOC",INT_ADD_ASSOC; "INT_ADD_LDISTRIB",INT_ADD_LDISTRIB; "INT_ADD_LID",INT_ADD_LID; "INT_ADD_LINV",INT_ADD_LINV; "INT_ADD_RDISTRIB",INT_ADD_RDISTRIB; "INT_ADD_RID",INT_ADD_RID; "INT_ADD_RINV",INT_ADD_RINV; "INT_ADD_SUB",INT_ADD_SUB; "INT_ADD_SUB2",INT_ADD_SUB2; "INT_ADD_SYM",INT_ADD_SYM; "INT_ARCH",INT_ARCH; "INT_BOUNDS_LE",INT_BOUNDS_LE; "INT_BOUNDS_LT",INT_BOUNDS_LT; "INT_DIFFSQ",INT_DIFFSQ; "INT_DIVISION",INT_DIVISION; "INT_DIVISION_0",INT_DIVISION_0; "INT_DIVMOD_EXIST_0",INT_DIVMOD_EXIST_0; "INT_DIVMOD_UNIQ",INT_DIVMOD_UNIQ; "INT_ENTIRE",INT_ENTIRE; "INT_EQ_ADD_LCANCEL",INT_EQ_ADD_LCANCEL; "INT_EQ_ADD_LCANCEL_0",INT_EQ_ADD_LCANCEL_0; "INT_EQ_ADD_RCANCEL",INT_EQ_ADD_RCANCEL; "INT_EQ_ADD_RCANCEL_0",INT_EQ_ADD_RCANCEL_0; "INT_EQ_IMP_LE",INT_EQ_IMP_LE; "INT_EQ_MUL_LCANCEL",INT_EQ_MUL_LCANCEL; "INT_EQ_MUL_RCANCEL",INT_EQ_MUL_RCANCEL; "INT_EQ_NEG2",INT_EQ_NEG2; "INT_EQ_SGN_ABS",INT_EQ_SGN_ABS; "INT_EQ_SQUARE_ABS",INT_EQ_SQUARE_ABS; "INT_EQ_SUB_LADD",INT_EQ_SUB_LADD; "INT_EQ_SUB_RADD",INT_EQ_SUB_RADD; "INT_EXISTS_ABS",INT_EXISTS_ABS; "INT_EXISTS_POS",INT_EXISTS_POS; "INT_FORALL_ABS",INT_FORALL_ABS; "INT_FORALL_POS",INT_FORALL_POS; "INT_GCD_EXISTS",INT_GCD_EXISTS; "INT_GCD_EXISTS_POS",INT_GCD_EXISTS_POS; "INT_GE",INT_GE; "INT_GT",INT_GT; "INT_GT_DISCRETE",INT_GT_DISCRETE; "INT_IMAGE",INT_IMAGE; "INT_LET_ADD",INT_LET_ADD; "INT_LET_ADD2",INT_LET_ADD2; "INT_LET_ANTISYM",INT_LET_ANTISYM; "INT_LET_TOTAL",INT_LET_TOTAL; "INT_LET_TRANS",INT_LET_TRANS; "INT_LE_01",INT_LE_01; "INT_LE_ADD",INT_LE_ADD; "INT_LE_ADD2",INT_LE_ADD2; "INT_LE_ADDL",INT_LE_ADDL; "INT_LE_ADDR",INT_LE_ADDR; "INT_LE_ANTISYM",INT_LE_ANTISYM; "INT_LE_DISCRETE",INT_LE_DISCRETE; "INT_LE_DOUBLE",INT_LE_DOUBLE; "INT_LE_LADD",INT_LE_LADD; "INT_LE_LADD_IMP",INT_LE_LADD_IMP; "INT_LE_LMUL",INT_LE_LMUL; "INT_LE_LNEG",INT_LE_LNEG; "INT_LE_LT",INT_LE_LT; "INT_LE_MAX",INT_LE_MAX; "INT_LE_MIN",INT_LE_MIN; "INT_LE_MUL",INT_LE_MUL; "INT_LE_MUL_EQ",INT_LE_MUL_EQ; "INT_LE_NEG",INT_LE_NEG; "INT_LE_NEG2",INT_LE_NEG2; "INT_LE_NEGL",INT_LE_NEGL; "INT_LE_NEGR",INT_LE_NEGR; "INT_LE_NEGTOTAL",INT_LE_NEGTOTAL; "INT_LE_POW2",INT_LE_POW2; "INT_LE_RADD",INT_LE_RADD; "INT_LE_REFL",INT_LE_REFL; "INT_LE_RMUL",INT_LE_RMUL; "INT_LE_RNEG",INT_LE_RNEG; "INT_LE_SQUARE",INT_LE_SQUARE; "INT_LE_SQUARE_ABS",INT_LE_SQUARE_ABS; "INT_LE_SUB_LADD",INT_LE_SUB_LADD; "INT_LE_SUB_RADD",INT_LE_SUB_RADD; "INT_LE_TOTAL",INT_LE_TOTAL; "INT_LE_TRANS",INT_LE_TRANS; "INT_LE_TRANS_LE",INT_LE_TRANS_LE; "INT_LE_TRANS_LT",INT_LE_TRANS_LT; "INT_LNEG_UNIQ",INT_LNEG_UNIQ; "INT_LT",INT_LT; "INT_LTE_ADD",INT_LTE_ADD; "INT_LTE_ADD2",INT_LTE_ADD2; "INT_LTE_ANTISYM",INT_LTE_ANTISYM; "INT_LTE_TOTAL",INT_LTE_TOTAL; "INT_LTE_TRANS",INT_LTE_TRANS; "INT_LT_01",INT_LT_01; "INT_LT_ADD",INT_LT_ADD; "INT_LT_ADD1",INT_LT_ADD1; "INT_LT_ADD2",INT_LT_ADD2; "INT_LT_ADDL",INT_LT_ADDL; "INT_LT_ADDNEG",INT_LT_ADDNEG; "INT_LT_ADDNEG2",INT_LT_ADDNEG2; "INT_LT_ADDR",INT_LT_ADDR; "INT_LT_ADD_SUB",INT_LT_ADD_SUB; "INT_LT_ANTISYM",INT_LT_ANTISYM; "INT_LT_DISCRETE",INT_LT_DISCRETE; "INT_LT_GT",INT_LT_GT; "INT_LT_IMP_LE",INT_LT_IMP_LE; "INT_LT_IMP_NE",INT_LT_IMP_NE; "INT_LT_LADD",INT_LT_LADD; "INT_LT_LE",INT_LT_LE; "INT_LT_LMUL_EQ",INT_LT_LMUL_EQ; "INT_LT_MAX",INT_LT_MAX; "INT_LT_MIN",INT_LT_MIN; "INT_LT_MUL",INT_LT_MUL; "INT_LT_MUL_EQ",INT_LT_MUL_EQ; "INT_LT_NEG",INT_LT_NEG; "INT_LT_NEG2",INT_LT_NEG2; "INT_LT_NEGTOTAL",INT_LT_NEGTOTAL; "INT_LT_POW2",INT_LT_POW2; "INT_LT_RADD",INT_LT_RADD; "INT_LT_REFL",INT_LT_REFL; "INT_LT_RMUL_EQ",INT_LT_RMUL_EQ; "INT_LT_SQUARE_ABS",INT_LT_SQUARE_ABS; "INT_LT_SUB_LADD",INT_LT_SUB_LADD; "INT_LT_SUB_RADD",INT_LT_SUB_RADD; "INT_LT_TOTAL",INT_LT_TOTAL; "INT_LT_TRANS",INT_LT_TRANS; "INT_MAX",INT_MAX; "INT_MAX_ACI",INT_MAX_ACI; "INT_MAX_ASSOC",INT_MAX_ASSOC; "INT_MAX_LE",INT_MAX_LE; "INT_MAX_LT",INT_MAX_LT; "INT_MAX_MAX",INT_MAX_MAX; "INT_MAX_MIN",INT_MAX_MIN; "INT_MAX_SYM",INT_MAX_SYM; "INT_MIN",INT_MIN; "INT_MIN_ACI",INT_MIN_ACI; "INT_MIN_ASSOC",INT_MIN_ASSOC; "INT_MIN_LE",INT_MIN_LE; "INT_MIN_LT",INT_MIN_LT; "INT_MIN_MAX",INT_MIN_MAX; "INT_MIN_MIN",INT_MIN_MIN; "INT_MIN_SYM",INT_MIN_SYM; "INT_MUL_AC",INT_MUL_AC; "INT_MUL_ASSOC",INT_MUL_ASSOC; "INT_MUL_LID",INT_MUL_LID; "INT_MUL_LNEG",INT_MUL_LNEG; "INT_MUL_LZERO",INT_MUL_LZERO; "INT_MUL_POS_LE",INT_MUL_POS_LE; "INT_MUL_POS_LT",INT_MUL_POS_LT; "INT_MUL_RID",INT_MUL_RID; "INT_MUL_RNEG",INT_MUL_RNEG; "INT_MUL_RZERO",INT_MUL_RZERO; "INT_MUL_SYM",INT_MUL_SYM; "INT_NEGNEG",INT_NEGNEG; "INT_NEG_0",INT_NEG_0; "INT_NEG_ADD",INT_NEG_ADD; "INT_NEG_EQ",INT_NEG_EQ; "INT_NEG_EQ_0",INT_NEG_EQ_0; "INT_NEG_GE0",INT_NEG_GE0; "INT_NEG_GT0",INT_NEG_GT0; "INT_NEG_LE0",INT_NEG_LE0; "INT_NEG_LMUL",INT_NEG_LMUL; "INT_NEG_LT0",INT_NEG_LT0; "INT_NEG_MINUS1",INT_NEG_MINUS1; "INT_NEG_MUL2",INT_NEG_MUL2; "INT_NEG_NEG",INT_NEG_NEG; "INT_NEG_RMUL",INT_NEG_RMUL; "INT_NEG_SUB",INT_NEG_SUB; "INT_NOT_EQ",INT_NOT_EQ; "INT_NOT_LE",INT_NOT_LE; "INT_NOT_LT",INT_NOT_LT; "INT_OF_NUM_ADD",INT_OF_NUM_ADD; "INT_OF_NUM_EQ",INT_OF_NUM_EQ; "INT_OF_NUM_EXISTS",INT_OF_NUM_EXISTS; "INT_OF_NUM_GE",INT_OF_NUM_GE; "INT_OF_NUM_GT",INT_OF_NUM_GT; "INT_OF_NUM_LE",INT_OF_NUM_LE; "INT_OF_NUM_LT",INT_OF_NUM_LT; "INT_OF_NUM_MAX",INT_OF_NUM_MAX; "INT_OF_NUM_MIN",INT_OF_NUM_MIN; "INT_OF_NUM_MUL",INT_OF_NUM_MUL; "INT_OF_NUM_OF_INT",INT_OF_NUM_OF_INT; "INT_OF_NUM_POW",INT_OF_NUM_POW; "INT_OF_NUM_SUB",INT_OF_NUM_SUB; "INT_OF_NUM_SUC",INT_OF_NUM_SUC; "INT_OF_REAL_OF_INT",INT_OF_REAL_OF_INT; "INT_POS",INT_POS; "INT_POS_NZ",INT_POS_NZ; "INT_POW",INT_POW; "INT_POW2_ABS",INT_POW2_ABS; "INT_POW_1",INT_POW_1; "INT_POW_1_LE",INT_POW_1_LE; "INT_POW_1_LT",INT_POW_1_LT; "INT_POW_2",INT_POW_2; "INT_POW_ADD",INT_POW_ADD; "INT_POW_EQ",INT_POW_EQ; "INT_POW_EQ_0",INT_POW_EQ_0; "INT_POW_EQ_ABS",INT_POW_EQ_ABS; "INT_POW_LE",INT_POW_LE; "INT_POW_LE2",INT_POW_LE2; "INT_POW_LE2_ODD",INT_POW_LE2_ODD; "INT_POW_LE2_REV",INT_POW_LE2_REV; "INT_POW_LE_1",INT_POW_LE_1; "INT_POW_LT",INT_POW_LT; "INT_POW_LT2",INT_POW_LT2; "INT_POW_LT2_REV",INT_POW_LT2_REV; "INT_POW_LT_1",INT_POW_LT_1; "INT_POW_MONO",INT_POW_MONO; "INT_POW_MONO_LT",INT_POW_MONO_LT; "INT_POW_MUL",INT_POW_MUL; "INT_POW_NEG",INT_POW_NEG; "INT_POW_NZ",INT_POW_NZ; "INT_POW_ONE",INT_POW_ONE; "INT_POW_POW",INT_POW_POW; "INT_POW_ZERO",INT_POW_ZERO; "INT_RNEG_UNIQ",INT_RNEG_UNIQ; "INT_SGN",INT_SGN; "INT_SGNS_EQ",INT_SGNS_EQ; "INT_SGNS_EQ_ALT",INT_SGNS_EQ_ALT; "INT_SGN_0",INT_SGN_0; "INT_SGN_ABS",INT_SGN_ABS; "INT_SGN_ABS_ALT",INT_SGN_ABS_ALT; "INT_SGN_CASES",INT_SGN_CASES; "INT_SGN_EQ",INT_SGN_EQ; "INT_SGN_EQ_INEQ",INT_SGN_EQ_INEQ; "INT_SGN_INEQS",INT_SGN_INEQS; "INT_SGN_INT_SGN",INT_SGN_INT_SGN; "INT_SGN_MUL",INT_SGN_MUL; "INT_SGN_NEG",INT_SGN_NEG; "INT_SGN_POW",INT_SGN_POW; "INT_SGN_POW_2",INT_SGN_POW_2; "INT_SOS_EQ_0",INT_SOS_EQ_0; "INT_SUB",INT_SUB; "INT_SUB_0",INT_SUB_0; "INT_SUB_ABS",INT_SUB_ABS; "INT_SUB_ADD",INT_SUB_ADD; "INT_SUB_ADD2",INT_SUB_ADD2; "INT_SUB_LDISTRIB",INT_SUB_LDISTRIB; "INT_SUB_LE",INT_SUB_LE; "INT_SUB_LNEG",INT_SUB_LNEG; "INT_SUB_LT",INT_SUB_LT; "INT_SUB_LZERO",INT_SUB_LZERO; "INT_SUB_NEG2",INT_SUB_NEG2; "INT_SUB_RDISTRIB",INT_SUB_RDISTRIB; "INT_SUB_REFL",INT_SUB_REFL; "INT_SUB_RNEG",INT_SUB_RNEG; "INT_SUB_RZERO",INT_SUB_RZERO; "INT_SUB_SUB",INT_SUB_SUB; "INT_SUB_SUB2",INT_SUB_SUB2; "INT_SUB_TRIANGLE",INT_SUB_TRIANGLE; "INT_WOP",INT_WOP; "INVARIANCE_OF_DIMENSION",INVARIANCE_OF_DIMENSION; "INVARIANCE_OF_DIMENSION_AFFINE_SETS",INVARIANCE_OF_DIMENSION_AFFINE_SETS; "INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN",INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN; "INVARIANCE_OF_DIMENSION_SUBSPACES",INVARIANCE_OF_DIMENSION_SUBSPACES; "INVARIANCE_OF_DOMAIN",INVARIANCE_OF_DOMAIN; "INVARIANCE_OF_DOMAIN_AFFINE_SETS",INVARIANCE_OF_DOMAIN_AFFINE_SETS; "INVARIANCE_OF_DOMAIN_GEN",INVARIANCE_OF_DOMAIN_GEN; "INVARIANCE_OF_DOMAIN_HOMEOMORPHIC",INVARIANCE_OF_DOMAIN_HOMEOMORPHIC; "INVARIANCE_OF_DOMAIN_HOMEOMORPHISM",INVARIANCE_OF_DOMAIN_HOMEOMORPHISM; "INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET",INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET; "INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN",INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN; "INVARIANCE_OF_DOMAIN_SUBSPACES",INVARIANCE_OF_DOMAIN_SUBSPACES; "INVERSE_FUNCTION_C1",INVERSE_FUNCTION_C1; "INVERSE_FUNCTION_THEOREM",INVERSE_FUNCTION_THEOREM; "INVERSE_FUNCTION_THEOREM_AFFINE",INVERSE_FUNCTION_THEOREM_AFFINE; "INVERSE_FUNCTION_THEOREM_C1_POINTWISE",INVERSE_FUNCTION_THEOREM_C1_POINTWISE; "INVERSE_FUNCTION_THEOREM_GLOBAL",INVERSE_FUNCTION_THEOREM_GLOBAL; "INVERSE_FUNCTION_THEOREM_SUBSPACE",INVERSE_FUNCTION_THEOREM_SUBSPACE; "INVERSE_I",INVERSE_I; "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION; "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT; "INVERSE_SWAP",INVERSE_SWAP; "INVERSE_UNIQUE_o",INVERSE_UNIQUE_o; "INVERTIBLE_CMUL",INVERTIBLE_CMUL; "INVERTIBLE_COFACTOR",INVERTIBLE_COFACTOR; "INVERTIBLE_COVARIANCE_RANK",INVERTIBLE_COVARIANCE_RANK; "INVERTIBLE_DET_NZ",INVERTIBLE_DET_NZ; "INVERTIBLE_DIAGONAL_MATRIX",INVERTIBLE_DIAGONAL_MATRIX; "INVERTIBLE_EIGENVALUES",INVERTIBLE_EIGENVALUES; "INVERTIBLE_EQ_INJECTIVE_AND_SURJECTIVE",INVERTIBLE_EQ_INJECTIVE_AND_SURJECTIVE; "INVERTIBLE_FIXPOINT_PROPERTY",INVERTIBLE_FIXPOINT_PROPERTY; "INVERTIBLE_I",INVERTIBLE_I; "INVERTIBLE_IMP_SQUARE_MATRIX",INVERTIBLE_IMP_SQUARE_MATRIX; "INVERTIBLE_LEFT_INVERSE",INVERTIBLE_LEFT_INVERSE; "INVERTIBLE_MAT",INVERTIBLE_MAT; "INVERTIBLE_MATRIX_INV",INVERTIBLE_MATRIX_INV; "INVERTIBLE_MATRIX_MUL",INVERTIBLE_MATRIX_MUL; "INVERTIBLE_NEARBY",INVERTIBLE_NEARBY; "INVERTIBLE_NEARBY_ONORM",INVERTIBLE_NEARBY_ONORM; "INVERTIBLE_NEG",INVERTIBLE_NEG; "INVERTIBLE_RIGHT_INVERSE",INVERTIBLE_RIGHT_INVERSE; "INVERTIBLE_TRANSP",INVERTIBLE_TRANSP; "INVOLUTION_IMP_HOMEOMORPHISM",INVOLUTION_IMP_HOMEOMORPHISM; "INVOLUTION_IMP_HOMEOMORPHISM_GEN",INVOLUTION_IMP_HOMEOMORPHISM_GEN; "IN_AFFINE_ADD_MUL",IN_AFFINE_ADD_MUL; "IN_AFFINE_ADD_MUL_DIFF",IN_AFFINE_ADD_MUL_DIFF; "IN_AFFINE_HULL_LINEAR_IMAGE",IN_AFFINE_HULL_LINEAR_IMAGE; "IN_AFFINE_MUL_DIFF_ADD",IN_AFFINE_MUL_DIFF_ADD; "IN_AFFINE_SUB_MUL_DIFF",IN_AFFINE_SUB_MUL_DIFF; "IN_BALL",IN_BALL; "IN_BALL_0",IN_BALL_0; "IN_BALL_IM",IN_BALL_IM; "IN_BALL_RE",IN_BALL_RE; "IN_CARD_ADD",IN_CARD_ADD; "IN_CARD_MUL",IN_CARD_MUL; "IN_CBALL",IN_CBALL; "IN_CBALL_0",IN_CBALL_0; "IN_CBALL_IM",IN_CBALL_IM; "IN_CBALL_RE",IN_CBALL_RE; "IN_CLOSURE_CONNECTED_COMPONENT",IN_CLOSURE_CONNECTED_COMPONENT; "IN_CLOSURE_DELETE",IN_CLOSURE_DELETE; "IN_CLOSURE_OF",IN_CLOSURE_OF; "IN_COMPONENTS",IN_COMPONENTS; "IN_COMPONENTS_CONNECTED",IN_COMPONENTS_CONNECTED; "IN_COMPONENTS_MAXIMAL",IN_COMPONENTS_MAXIMAL; "IN_COMPONENTS_MAXIMAL_ALT",IN_COMPONENTS_MAXIMAL_ALT; "IN_COMPONENTS_NONEMPTY",IN_COMPONENTS_NONEMPTY; "IN_COMPONENTS_SELF",IN_COMPONENTS_SELF; "IN_COMPONENTS_SUBSET",IN_COMPONENTS_SUBSET; "IN_COMPONENTS_UNIONS_COMPLEMENT",IN_COMPONENTS_UNIONS_COMPLEMENT; "IN_CONIC_CONVEX_HULL_ROWS",IN_CONIC_CONVEX_HULL_ROWS; "IN_CONIC_CONVEX_HULL_ROWS_QFREE",IN_CONIC_CONVEX_HULL_ROWS_QFREE; "IN_CONVEX_HULL_EXCHANGE",IN_CONVEX_HULL_EXCHANGE; "IN_CONVEX_HULL_EXCHANGE_UNIQUE",IN_CONVEX_HULL_EXCHANGE_UNIQUE; "IN_CONVEX_HULL_INTERVAL_1",IN_CONVEX_HULL_INTERVAL_1; "IN_CONVEX_HULL_LINEAR_IMAGE",IN_CONVEX_HULL_LINEAR_IMAGE; "IN_CONVEX_HULL_ROWS",IN_CONVEX_HULL_ROWS; "IN_CONVEX_HULL_SEGMENT_1",IN_CONVEX_HULL_SEGMENT_1; "IN_CONVEX_SET",IN_CONVEX_SET; "IN_CROSS",IN_CROSS; "IN_DELETE",IN_DELETE; "IN_DELETE_EQ",IN_DELETE_EQ; "IN_DERIVED_SET_OF",IN_DERIVED_SET_OF; "IN_DIFF",IN_DIFF; "IN_DIMINDEX_SWAP",IN_DIMINDEX_SWAP; "IN_DIRECTION",IN_DIRECTION; "IN_DISJOINT",IN_DISJOINT; "IN_ELIM_PAIR_THM",IN_ELIM_PAIR_THM; "IN_ELIM_PASTECART_THM",IN_ELIM_PASTECART_THM; "IN_ELIM_THM",IN_ELIM_THM; "IN_EPIGRAPH",IN_EPIGRAPH; "IN_EXTENSIONAL",IN_EXTENSIONAL; "IN_EXTENSIONAL_UNDEFINED",IN_EXTENSIONAL_UNDEFINED; "IN_FROM",IN_FROM; "IN_FRONTIER_CONVEX_HULL",IN_FRONTIER_CONVEX_HULL; "IN_IMAGE",IN_IMAGE; "IN_IMAGE_DROPOUT",IN_IMAGE_DROPOUT; "IN_IMAGE_LIFT_DROP",IN_IMAGE_LIFT_DROP; "IN_INSERT",IN_INSERT; "IN_INTER",IN_INTER; "IN_INTERIOR",IN_INTERIOR; "IN_INTERIOR_CBALL",IN_INTERIOR_CBALL; "IN_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_INTERIOR_CLOSURE_CONVEX_SEGMENT; "IN_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_INTERIOR_CLOSURE_CONVEX_SHRINK; "IN_INTERIOR_CONIC_CONVEX_HULL_ROWS_QFREE",IN_INTERIOR_CONIC_CONVEX_HULL_ROWS_QFREE; "IN_INTERIOR_CONVEX_SHRINK",IN_INTERIOR_CONVEX_SHRINK; "IN_INTERIOR_EVENTUALLY",IN_INTERIOR_EVENTUALLY; "IN_INTERIOR_LINEAR_IMAGE",IN_INTERIOR_LINEAR_IMAGE; "IN_INTERS",IN_INTERS; "IN_INTERVAL",IN_INTERVAL; "IN_INTERVAL_1",IN_INTERVAL_1; "IN_INTERVAL_INTERVAL_BIJ",IN_INTERVAL_INTERVAL_BIJ; "IN_INTERVAL_REFLECT",IN_INTERVAL_REFLECT; "IN_MBALL",IN_MBALL; "IN_MCBALL",IN_MCBALL; "IN_NUMSEG",IN_NUMSEG; "IN_NUMSEG_0",IN_NUMSEG_0; "IN_OPEN_SEGMENT",IN_OPEN_SEGMENT; "IN_OPEN_SEGMENT_ALT",IN_OPEN_SEGMENT_ALT; "IN_PATH_IMAGE_PARTCIRCLEPATH",IN_PATH_IMAGE_PARTCIRCLEPATH; "IN_REAL_INTERVAL",IN_REAL_INTERVAL; "IN_REAL_INTERVAL_REFLECT",IN_REAL_INTERVAL_REFLECT; "IN_REAL_SEGMENT",IN_REAL_SEGMENT; "IN_RELATIVE_INTERIOR",IN_RELATIVE_INTERIOR; "IN_RELATIVE_INTERIOR_CBALL",IN_RELATIVE_INTERIOR_CBALL; "IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; "IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK; "IN_RELATIVE_INTERIOR_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CONVEX_SHRINK; "IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT",IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT; "IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_EQ",IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_EQ; "IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_STRONG",IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_STRONG; "IN_RELATIVE_INTERIOR_OF_FACE",IN_RELATIVE_INTERIOR_OF_FACE; "IN_RELATIVE_INTERIOR_OF_UNIQUE_FACE",IN_RELATIVE_INTERIOR_OF_UNIQUE_FACE; "IN_REST",IN_REST; "IN_SEGMENT",IN_SEGMENT; "IN_SEGMENT_COMPONENT",IN_SEGMENT_COMPONENT; "IN_SEGMENT_CX",IN_SEGMENT_CX; "IN_SEGMENT_CX_GEN",IN_SEGMENT_CX_GEN; "IN_SET_OF_LIST",IN_SET_OF_LIST; "IN_SING",IN_SING; "IN_SLICE",IN_SLICE; "IN_SPAN_DELETE",IN_SPAN_DELETE; "IN_SPAN_DEPLETED_ROWS_QFREE",IN_SPAN_DEPLETED_ROWS_QFREE; "IN_SPAN_IMAGE_BASIS",IN_SPAN_IMAGE_BASIS; "IN_SPAN_INSERT",IN_SPAN_INSERT; "IN_SPHERE",IN_SPHERE; "IN_SPHERE_0",IN_SPHERE_0; "IN_SUPPORT",IN_SUPPORT; "IN_TRANSLATION_GALOIS",IN_TRANSLATION_GALOIS; "IN_TRANSLATION_GALOIS_ALT",IN_TRANSLATION_GALOIS_ALT; "IN_UNION",IN_UNION; "IN_UNIONS",IN_UNIONS; "IN_UNIV",IN_UNIV; "IRRATIONAL_APPROXIMATION",IRRATIONAL_APPROXIMATION; "IRRATIONAL_APPROXIMATION_ABOVE",IRRATIONAL_APPROXIMATION_ABOVE; "IRRATIONAL_APPROXIMATION_BELOW",IRRATIONAL_APPROXIMATION_BELOW; "IRRATIONAL_APPROXIMATION_STRADDLE",IRRATIONAL_APPROXIMATION_STRADDLE; "IRRATIONAL_BETWEEN",IRRATIONAL_BETWEEN; "IRRATIONAL_BETWEEN_EQ",IRRATIONAL_BETWEEN_EQ; "ISO",ISO; "ISOLATED_ZEROS",ISOLATED_ZEROS; "ISOMETRIC_HOMEOMORPHISM_AFFINE",ISOMETRIC_HOMEOMORPHISM_AFFINE; "ISOMETRIES_SUBSPACES",ISOMETRIES_SUBSPACES; "ISOMETRY_IMP_AFFINITY",ISOMETRY_IMP_AFFINITY; "ISOMETRY_IMP_EMBEDDING",ISOMETRY_IMP_EMBEDDING; "ISOMETRY_IMP_HOMEOMORPHISM_COMPACT",ISOMETRY_IMP_HOMEOMORPHISM_COMPACT; "ISOMETRY_IMP_OPEN_MAP",ISOMETRY_IMP_OPEN_MAP; "ISOMETRY_LINEAR",ISOMETRY_LINEAR; "ISOMETRY_ON_IMP_CONTINUOUS_ON",ISOMETRY_ON_IMP_CONTINUOUS_ON; "ISOMETRY_SPHERE_EXTEND",ISOMETRY_SPHERE_EXTEND; "ISOMETRY_SUBSET_SUBSPACE",ISOMETRY_SUBSET_SUBSPACE; "ISOMETRY_SUBSPACES",ISOMETRY_SUBSPACES; "ISOMETRY_UNIV_SUBSPACE",ISOMETRY_UNIV_SUBSPACE; "ISOMETRY_UNIV_SUPERSET_SUBSPACE",ISOMETRY_UNIV_SUPERSET_SUBSPACE; "ISOMETRY_UNIV_UNIV",ISOMETRY_UNIV_UNIV; "ISOMORPHISMS_UNIV_UNIV",ISOMORPHISMS_UNIV_UNIV; "ISOMORPHISM_EXPAND",ISOMORPHISM_EXPAND; "ISO_FUN",ISO_FUN; "ISO_REFL",ISO_REFL; "ISO_USAGE",ISO_USAGE; "ISTOPLOGY_SUBTOPOLOGY",ISTOPLOGY_SUBTOPOLOGY; "ISTOPOLOGY_OPEN_IN",ISTOPOLOGY_OPEN_IN; "IS_AFFINE_HULL",IS_AFFINE_HULL; "IS_CONVEX_HULL",IS_CONVEX_HULL; "IS_HULL",IS_HULL; "IS_INTERVAL_1",IS_INTERVAL_1; "IS_INTERVAL_1_CASES",IS_INTERVAL_1_CASES; "IS_INTERVAL_1_CLAUSES",IS_INTERVAL_1_CLAUSES; "IS_INTERVAL_CLOSURE",IS_INTERVAL_CLOSURE; "IS_INTERVAL_COMPACT",IS_INTERVAL_COMPACT; "IS_INTERVAL_CONNECTED",IS_INTERVAL_CONNECTED; "IS_INTERVAL_CONNECTED_1",IS_INTERVAL_CONNECTED_1; "IS_INTERVAL_CONTRACTIBLE_1",IS_INTERVAL_CONTRACTIBLE_1; "IS_INTERVAL_CONVEX",IS_INTERVAL_CONVEX; "IS_INTERVAL_CONVEX_1",IS_INTERVAL_CONVEX_1; "IS_INTERVAL_EMPTY",IS_INTERVAL_EMPTY; "IS_INTERVAL_IMP_BAIRE1_INDICATOR",IS_INTERVAL_IMP_BAIRE1_INDICATOR; "IS_INTERVAL_IMP_ENR",IS_INTERVAL_IMP_ENR; "IS_INTERVAL_IMP_FSIGMA",IS_INTERVAL_IMP_FSIGMA; "IS_INTERVAL_IMP_GDELTA",IS_INTERVAL_IMP_GDELTA; "IS_INTERVAL_IMP_LOCALLY_COMPACT",IS_INTERVAL_IMP_LOCALLY_COMPACT; "IS_INTERVAL_INTER",IS_INTERVAL_INTER; "IS_INTERVAL_INTERIOR",IS_INTERVAL_INTERIOR; "IS_INTERVAL_INTERVAL",IS_INTERVAL_INTERVAL; "IS_INTERVAL_LOCALLY_COMPACT_INTERVAL",IS_INTERVAL_LOCALLY_COMPACT_INTERVAL; "IS_INTERVAL_PATH_CONNECTED",IS_INTERVAL_PATH_CONNECTED; "IS_INTERVAL_PATH_CONNECTED_1",IS_INTERVAL_PATH_CONNECTED_1; "IS_INTERVAL_PCROSS",IS_INTERVAL_PCROSS; "IS_INTERVAL_PCROSS_EQ",IS_INTERVAL_PCROSS_EQ; "IS_INTERVAL_POINTWISE",IS_INTERVAL_POINTWISE; "IS_INTERVAL_REFLECT",IS_INTERVAL_REFLECT; "IS_INTERVAL_RELATIVE_INTERIOR",IS_INTERVAL_RELATIVE_INTERIOR; "IS_INTERVAL_SCALING",IS_INTERVAL_SCALING; "IS_INTERVAL_SCALING_EQ",IS_INTERVAL_SCALING_EQ; "IS_INTERVAL_SIMPLY_CONNECTED_1",IS_INTERVAL_SIMPLY_CONNECTED_1; "IS_INTERVAL_SING",IS_INTERVAL_SING; "IS_INTERVAL_SUMS",IS_INTERVAL_SUMS; "IS_INTERVAL_TRANSLATION",IS_INTERVAL_TRANSLATION; "IS_INTERVAL_TRANSLATION_EQ",IS_INTERVAL_TRANSLATION_EQ; "IS_INTERVAL_UNIV",IS_INTERVAL_UNIV; "IS_METRIC_SPACE_SUBSPACE",IS_METRIC_SPACE_SUBSPACE; "IS_REALINTERVAL_CLAUSES",IS_REALINTERVAL_CLAUSES; "IS_REALINTERVAL_CONNECTED",IS_REALINTERVAL_CONNECTED; "IS_REALINTERVAL_CONTAINS_SEGMENT_EQ",IS_REALINTERVAL_CONTAINS_SEGMENT_EQ; "IS_REALINTERVAL_CONTAINS_SEGMENT_IMP",IS_REALINTERVAL_CONTAINS_SEGMENT_IMP; "IS_REALINTERVAL_CONTINUOUS_IMAGE",IS_REALINTERVAL_CONTINUOUS_IMAGE; "IS_REALINTERVAL_CONVEX",IS_REALINTERVAL_CONVEX; "IS_REALINTERVAL_CONVEX_COMPLEX",IS_REALINTERVAL_CONVEX_COMPLEX; "IS_REALINTERVAL_EMPTY",IS_REALINTERVAL_EMPTY; "IS_REALINTERVAL_INTERVAL",IS_REALINTERVAL_INTERVAL; "IS_REALINTERVAL_IS_INTERVAL",IS_REALINTERVAL_IS_INTERVAL; "IS_REALINTERVAL_SEGMENT",IS_REALINTERVAL_SEGMENT; "IS_REALINTERVAL_UNION",IS_REALINTERVAL_UNION; "IS_REALINTERVAL_UNIV",IS_REALINTERVAL_UNIV; "IS_REAL_INTERVAL_CASES",IS_REAL_INTERVAL_CASES; "IS_REAL_INTERVAL_CONTAINS_SEGMENT",IS_REAL_INTERVAL_CONTAINS_SEGMENT; "IS_TOPOLOGY_METRIC_TOPOLOGY",IS_TOPOLOGY_METRIC_TOPOLOGY; "ITER",ITER; "ITERATE_AND",ITERATE_AND; "ITERATE_BIJECTION",ITERATE_BIJECTION; "ITERATE_CASES",ITERATE_CASES; "ITERATE_CLAUSES",ITERATE_CLAUSES; "ITERATE_CLAUSES_GEN",ITERATE_CLAUSES_GEN; "ITERATE_CLAUSES_NUMSEG",ITERATE_CLAUSES_NUMSEG; "ITERATE_CLOSED",ITERATE_CLOSED; "ITERATE_DELETE",ITERATE_DELETE; "ITERATE_DELTA",ITERATE_DELTA; "ITERATE_DIFF",ITERATE_DIFF; "ITERATE_DIFF_GEN",ITERATE_DIFF_GEN; "ITERATE_EQ",ITERATE_EQ; "ITERATE_EQ_GENERAL",ITERATE_EQ_GENERAL; "ITERATE_EQ_GENERAL_INVERSES",ITERATE_EQ_GENERAL_INVERSES; "ITERATE_EQ_NEUTRAL",ITERATE_EQ_NEUTRAL; "ITERATE_EXPAND_CASES",ITERATE_EXPAND_CASES; "ITERATE_IMAGE",ITERATE_IMAGE; "ITERATE_IMAGE_GEN",ITERATE_IMAGE_GEN; "ITERATE_IMAGE_NONZERO",ITERATE_IMAGE_NONZERO; "ITERATE_INCL_EXCL",ITERATE_INCL_EXCL; "ITERATE_INJECTION",ITERATE_INJECTION; "ITERATE_ITERATE_PRODUCT",ITERATE_ITERATE_PRODUCT; "ITERATE_NONZERO_IMAGE_LEMMA",ITERATE_NONZERO_IMAGE_LEMMA; "ITERATE_OP",ITERATE_OP; "ITERATE_OP_GEN",ITERATE_OP_GEN; "ITERATE_PAIR",ITERATE_PAIR; "ITERATE_PERMUTE",ITERATE_PERMUTE; "ITERATE_REFLECT",ITERATE_REFLECT; "ITERATE_RELATED",ITERATE_RELATED; "ITERATE_RESTRICT_SET",ITERATE_RESTRICT_SET; "ITERATE_SING",ITERATE_SING; "ITERATE_SOME",ITERATE_SOME; "ITERATE_SUPERSET",ITERATE_SUPERSET; "ITERATE_SUPPORT",ITERATE_SUPPORT; "ITERATE_SWAP",ITERATE_SWAP; "ITERATE_UNION",ITERATE_UNION; "ITERATE_UNION_GEN",ITERATE_UNION_GEN; "ITERATE_UNION_NONZERO",ITERATE_UNION_NONZERO; "ITERATE_UNIV",ITERATE_UNIV; "ITER_1",ITER_1; "ITER_ADD",ITER_ADD; "ITER_ADD_POINTLESS",ITER_ADD_POINTLESS; "ITER_ALT",ITER_ALT; "ITER_ALT_POINTLESS",ITER_ALT_POINTLESS; "ITER_FIXPOINT",ITER_FIXPOINT; "ITER_MUL",ITER_MUL; "ITER_POINTLESS",ITER_POINTLESS; "ITLIST",ITLIST; "ITLIST2",ITLIST2; "ITLIST2_DEF",ITLIST2_DEF; "ITLIST_APPEND",ITLIST_APPEND; "ITLIST_EXTRA",ITLIST_EXTRA; "ITSET",ITSET; "ITSET_EQ",ITSET_EQ; "IVT_DECREASING_COMPONENT_1",IVT_DECREASING_COMPONENT_1; "IVT_DECREASING_COMPONENT_ON_1",IVT_DECREASING_COMPONENT_ON_1; "IVT_DECREASING_IM",IVT_DECREASING_IM; "IVT_DECREASING_RE",IVT_DECREASING_RE; "IVT_INCREASING_COMPONENT_1",IVT_INCREASING_COMPONENT_1; "IVT_INCREASING_COMPONENT_ON_1",IVT_INCREASING_COMPONENT_ON_1; "IVT_INCREASING_IM",IVT_INCREASING_IM; "IVT_INCREASING_RE",IVT_INCREASING_RE; "I_DEF",I_DEF; "I_O_ID",I_O_ID; "I_THM",I_THM; "JACOBIAN_COMPLEX_DERIVATIVE",JACOBIAN_COMPLEX_DERIVATIVE; "JACOBIAN_SIGN_INVARIANCE",JACOBIAN_SIGN_INVARIANCE; "JACOBIAN_WORKS",JACOBIAN_WORKS; "JANISZEWSKI",JANISZEWSKI; "JANISZEWSKI_CONNECTED",JANISZEWSKI_CONNECTED; "JANISZEWSKI_DUAL",JANISZEWSKI_DUAL; "JANISZEWSKI_GEN",JANISZEWSKI_GEN; "JOINABLE_COMPONENTS_EQ",JOINABLE_COMPONENTS_EQ; "JOINABLE_CONNECTED_COMPONENT_EQ",JOINABLE_CONNECTED_COMPONENT_EQ; "JOINPATHS",JOINPATHS; "JOINPATHS_LINEAR_IMAGE",JOINPATHS_LINEAR_IMAGE; "JOINPATHS_TRANSLATION",JOINPATHS_TRANSLATION; "JOIN_PATHS_EQ",JOIN_PATHS_EQ; "JOIN_SUBPATHS_MIDDLE",JOIN_SUBPATHS_MIDDLE; "JORDAN_BROUWER_ACCESSIBILITY",JORDAN_BROUWER_ACCESSIBILITY; "JORDAN_BROUWER_FRONTIER",JORDAN_BROUWER_FRONTIER; "JORDAN_BROUWER_NONSEPARATION",JORDAN_BROUWER_NONSEPARATION; "JORDAN_BROUWER_NONSEPARATION_STRONG",JORDAN_BROUWER_NONSEPARATION_STRONG; "JORDAN_BROUWER_SEPARATION",JORDAN_BROUWER_SEPARATION; "JORDAN_COMPONENTS",JORDAN_COMPONENTS; "JORDAN_CURVE_THEOREM",JORDAN_CURVE_THEOREM; "JORDAN_DISCONNECTED",JORDAN_DISCONNECTED; "JORDAN_INSIDE_OUTSIDE",JORDAN_INSIDE_OUTSIDE; "JORDAN_SCHOENFLIES",JORDAN_SCHOENFLIES; "JORDAN_SCHOENFLIES_CIRCLE",JORDAN_SCHOENFLIES_CIRCLE; "JORDAN_SCHOENFLIES_S2",JORDAN_SCHOENFLIES_S2; "JUNG",JUNG; "KERNEL_MATRIX_INV",KERNEL_MATRIX_INV; "KIRCHBERGER",KIRCHBERGER; "KIRSZBRAUN",KIRSZBRAUN; "KL",KL; "KL_POSET_LEMMA",KL_POSET_LEMMA; "KREIN_MILMAN",KREIN_MILMAN; "KREIN_MILMAN_EQ",KREIN_MILMAN_EQ; "KREIN_MILMAN_FRONTIER",KREIN_MILMAN_FRONTIER; "KREIN_MILMAN_MINKOWSKI",KREIN_MILMAN_MINKOWSKI; "KREIN_MILMAN_POLYTOPE",KREIN_MILMAN_POLYTOPE; "KREIN_MILMAN_RELATIVE_BOUNDARY",KREIN_MILMAN_RELATIVE_BOUNDARY; "KREIN_MILMAN_RELATIVE_FRONTIER",KREIN_MILMAN_RELATIVE_FRONTIER; "L1_LE_NORM",L1_LE_NORM; "LAMBDA_ADD_GALOIS",LAMBDA_ADD_GALOIS; "LAMBDA_BETA",LAMBDA_BETA; "LAMBDA_BETA_PERM",LAMBDA_BETA_PERM; "LAMBDA_ETA",LAMBDA_ETA; "LAMBDA_PAIR",LAMBDA_PAIR; "LAMBDA_PAIR_THM",LAMBDA_PAIR_THM; "LAMBDA_SKOLEM",LAMBDA_SKOLEM; "LAMBDA_SWAP_GALOIS",LAMBDA_SWAP_GALOIS; "LAMBDA_UNIQUE",LAMBDA_UNIQUE; "LAMBDA_UNPAIR_THM",LAMBDA_UNPAIR_THM; "LANDAU_PICARD",LANDAU_PICARD; "LARGE_INDUCTIVE_DIMENSION",LARGE_INDUCTIVE_DIMENSION; "LAST",LAST; "LAST_APPEND",LAST_APPEND; "LAST_CLAUSES",LAST_CLAUSES; "LAST_EL",LAST_EL; "LAVRENTIEV",LAVRENTIEV; "LAVRENTIEV_BOREL",LAVRENTIEV_BOREL; "LAVRENTIEV_HOMEOMORPHISM",LAVRENTIEV_HOMEOMORPHISM; "LAVRENTIEV_HOMEOMORPHISM_SELF",LAVRENTIEV_HOMEOMORPHISM_SELF; "LDIV_LT_EQ",LDIV_LT_EQ; "LE",LE; "LEBESGUE_COVERING_LEMMA",LEBESGUE_COVERING_LEMMA; "LEBESGUE_COVERING_LEMMA_GEN",LEBESGUE_COVERING_LEMMA_GEN; "LEBESGUE_DENSITY_THEOREM",LEBESGUE_DENSITY_THEOREM; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_BALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_BALL; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_CBALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_CBALL; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_BALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_BALL; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_CBALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_CBALL; "LEBESGUE_DENSITY_THEOREM_LIFT_BALL",LEBESGUE_DENSITY_THEOREM_LIFT_BALL; "LEBESGUE_DENSITY_THEOREM_LIFT_CBALL",LEBESGUE_DENSITY_THEOREM_LIFT_CBALL; "LEBESGUE_DIFFERENTIATION_THEOREM",LEBESGUE_DIFFERENTIATION_THEOREM; "LEBESGUE_DIFFERENTIATION_THEOREM_ALT",LEBESGUE_DIFFERENTIATION_THEOREM_ALT; "LEBESGUE_DIFFERENTIATION_THEOREM_COMPACT",LEBESGUE_DIFFERENTIATION_THEOREM_COMPACT; "LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING",LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING; "LEBESGUE_DIFFERENTIATION_THEOREM_GEN",LEBESGUE_DIFFERENTIATION_THEOREM_GEN; "LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING",LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING; "LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE",LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE; "LEBESGUE_MEASURABLE_ALMOST_FSIGMA",LEBESGUE_MEASURABLE_ALMOST_FSIGMA; "LEBESGUE_MEASURABLE_ALMOST_GDELTA",LEBESGUE_MEASURABLE_ALMOST_GDELTA; "LEBESGUE_MEASURABLE_BALL",LEBESGUE_MEASURABLE_BALL; "LEBESGUE_MEASURABLE_CBALL",LEBESGUE_MEASURABLE_CBALL; "LEBESGUE_MEASURABLE_CLOSED",LEBESGUE_MEASURABLE_CLOSED; "LEBESGUE_MEASURABLE_CLOSED_IN",LEBESGUE_MEASURABLE_CLOSED_IN; "LEBESGUE_MEASURABLE_COMPACT",LEBESGUE_MEASURABLE_COMPACT; "LEBESGUE_MEASURABLE_COMPL",LEBESGUE_MEASURABLE_COMPL; "LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE",LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE; "LEBESGUE_MEASURABLE_CONVEX",LEBESGUE_MEASURABLE_CONVEX; "LEBESGUE_MEASURABLE_COUNTABLE_INTERS",LEBESGUE_MEASURABLE_COUNTABLE_INTERS; "LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT; "LEBESGUE_MEASURABLE_COUNTABLE_UNIONS",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS; "LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; "LEBESGUE_MEASURABLE_DELETE",LEBESGUE_MEASURABLE_DELETE; "LEBESGUE_MEASURABLE_DIFF",LEBESGUE_MEASURABLE_DIFF; "LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE",LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE; "LEBESGUE_MEASURABLE_DOMAIN_OF_INJECTIVITY",LEBESGUE_MEASURABLE_DOMAIN_OF_INJECTIVITY; "LEBESGUE_MEASURABLE_EMPTY",LEBESGUE_MEASURABLE_EMPTY; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ; "LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ; "LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ; "LEBESGUE_MEASURABLE_IFF_MEASURABLE",LEBESGUE_MEASURABLE_IFF_MEASURABLE; "LEBESGUE_MEASURABLE_INNER_CLOSED",LEBESGUE_MEASURABLE_INNER_CLOSED; "LEBESGUE_MEASURABLE_INNER_COMPACT",LEBESGUE_MEASURABLE_INNER_COMPACT; "LEBESGUE_MEASURABLE_INSERT",LEBESGUE_MEASURABLE_INSERT; "LEBESGUE_MEASURABLE_INTER",LEBESGUE_MEASURABLE_INTER; "LEBESGUE_MEASURABLE_INTERS",LEBESGUE_MEASURABLE_INTERS; "LEBESGUE_MEASURABLE_INTERVAL",LEBESGUE_MEASURABLE_INTERVAL; "LEBESGUE_MEASURABLE_JORDAN",LEBESGUE_MEASURABLE_JORDAN; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_BOREL",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_BOREL; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; "LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ; "LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN; "LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; "LEBESGUE_MEASURABLE_LIPSCHITZ_IMAGE",LEBESGUE_MEASURABLE_LIPSCHITZ_IMAGE; "LEBESGUE_MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE",LEBESGUE_MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE; "LEBESGUE_MEASURABLE_MEASURABLE_IMAGE",LEBESGUE_MEASURABLE_MEASURABLE_IMAGE; "LEBESGUE_MEASURABLE_MEASURABLE_INTER_EQ",LEBESGUE_MEASURABLE_MEASURABLE_INTER_EQ; "LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS; "LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS; "LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF",LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF; "LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ",LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ; "LEBESGUE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_ON_SUBINTERVALS; "LEBESGUE_MEASURABLE_OPEN",LEBESGUE_MEASURABLE_OPEN; "LEBESGUE_MEASURABLE_OPEN_IN",LEBESGUE_MEASURABLE_OPEN_IN; "LEBESGUE_MEASURABLE_OUTER_OPEN",LEBESGUE_MEASURABLE_OUTER_OPEN; "LEBESGUE_MEASURABLE_PCROSS",LEBESGUE_MEASURABLE_PCROSS; "LEBESGUE_MEASURABLE_POINTS_OF_CONVERGENCE",LEBESGUE_MEASURABLE_POINTS_OF_CONVERGENCE; "LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_AT",LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_AT; "LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_WITHIN",LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_WITHIN; "LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC",LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC; "LEBESGUE_MEASURABLE_PREIMAGE_BOREL",LEBESGUE_MEASURABLE_PREIMAGE_BOREL; "LEBESGUE_MEASURABLE_PREIMAGE_CARD_LE",LEBESGUE_MEASURABLE_PREIMAGE_CARD_LE; "LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; "LEBESGUE_MEASURABLE_PREIMAGE_FINITE",LEBESGUE_MEASURABLE_PREIMAGE_FINITE; "LEBESGUE_MEASURABLE_PREIMAGE_HAS_SIZE",LEBESGUE_MEASURABLE_PREIMAGE_HAS_SIZE; "LEBESGUE_MEASURABLE_PREIMAGE_INFINITE",LEBESGUE_MEASURABLE_PREIMAGE_INFINITE; "LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_PREIMAGE_OPEN; "LEBESGUE_MEASURABLE_REGULAR_INNER",LEBESGUE_MEASURABLE_REGULAR_INNER; "LEBESGUE_MEASURABLE_REGULAR_OUTER",LEBESGUE_MEASURABLE_REGULAR_OUTER; "LEBESGUE_MEASURABLE_SMALL_IMP_NEGLIGIBLE",LEBESGUE_MEASURABLE_SMALL_IMP_NEGLIGIBLE; "LEBESGUE_MEASURABLE_TRANSLATION",LEBESGUE_MEASURABLE_TRANSLATION; "LEBESGUE_MEASURABLE_UNION",LEBESGUE_MEASURABLE_UNION; "LEBESGUE_MEASURABLE_UNIONS",LEBESGUE_MEASURABLE_UNIONS; "LEBESGUE_MEASURABLE_UNIV",LEBESGUE_MEASURABLE_UNIV; "LEFT_ADD_DISTRIB",LEFT_ADD_DISTRIB; "LEFT_AND_EXISTS_THM",LEFT_AND_EXISTS_THM; "LEFT_AND_FORALL_THM",LEFT_AND_FORALL_THM; "LEFT_EXISTS_AND_THM",LEFT_EXISTS_AND_THM; "LEFT_EXISTS_IMP_THM",LEFT_EXISTS_IMP_THM; "LEFT_FORALL_IMP_THM",LEFT_FORALL_IMP_THM; "LEFT_FORALL_OR_THM",LEFT_FORALL_OR_THM; "LEFT_IMP_EXISTS_THM",LEFT_IMP_EXISTS_THM; "LEFT_IMP_FORALL_THM",LEFT_IMP_FORALL_THM; "LEFT_INVERSE_LINEAR",LEFT_INVERSE_LINEAR; "LEFT_INVERTIBLE_TRANSP",LEFT_INVERTIBLE_TRANSP; "LEFT_OR_DISTRIB",LEFT_OR_DISTRIB; "LEFT_OR_EXISTS_THM",LEFT_OR_EXISTS_THM; "LEFT_OR_FORALL_THM",LEFT_OR_FORALL_THM; "LEFT_POLAR_DECOMPOSITION",LEFT_POLAR_DECOMPOSITION; "LEFT_POLAR_DECOMPOSITION_INVERTIBLE",LEFT_POLAR_DECOMPOSITION_INVERTIBLE; "LEFT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE",LEFT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE; "LEFT_POLAR_DECOMPOSITION_UNIQUE",LEFT_POLAR_DECOMPOSITION_UNIQUE; "LEFT_RIGHT_INVERSE_EQ",LEFT_RIGHT_INVERSE_EQ; "LEFT_RIGHT_INVERSE_LINEAR",LEFT_RIGHT_INVERSE_LINEAR; "LEFT_SUB_DISTRIB",LEFT_SUB_DISTRIB; "LENGTH",LENGTH; "LENGTH_APPEND",LENGTH_APPEND; "LENGTH_EQ_CONS",LENGTH_EQ_CONS; "LENGTH_EQ_NIL",LENGTH_EQ_NIL; "LENGTH_LIST_OF_SEQ",LENGTH_LIST_OF_SEQ; "LENGTH_LIST_OF_SET",LENGTH_LIST_OF_SET; "LENGTH_MAP",LENGTH_MAP; "LENGTH_MAP2",LENGTH_MAP2; "LENGTH_REPLICATE",LENGTH_REPLICATE; "LENGTH_TL",LENGTH_TL; "LENGTH_ZIP",LENGTH_ZIP; "LET_ADD2",LET_ADD2; "LET_ANTISYM",LET_ANTISYM; "LET_CASES",LET_CASES; "LET_DEF",LET_DEF; "LET_END_DEF",LET_END_DEF; "LET_TRANS",LET_TRANS; "LE_0",LE_0; "LE_1",LE_1; "LE_ADD",LE_ADD; "LE_ADD2",LE_ADD2; "LE_ADDR",LE_ADDR; "LE_ADD_LCANCEL",LE_ADD_LCANCEL; "LE_ADD_RCANCEL",LE_ADD_RCANCEL; "LE_ANTISYM",LE_ANTISYM; "LE_C",LE_C; "LE_CASES",LE_CASES; "LE_C_IMAGE",LE_C_IMAGE; "LE_C_IMAGE_SUBSET",LE_C_IMAGE_SUBSET; "LE_EXISTS",LE_EXISTS; "LE_EXP",LE_EXP; "LE_INDUCT",LE_INDUCT; "LE_LDIV",LE_LDIV; "LE_LDIV_EQ",LE_LDIV_EQ; "LE_LT",LE_LT; "LE_MULT2",LE_MULT2; "LE_MULT_LCANCEL",LE_MULT_LCANCEL; "LE_MULT_RCANCEL",LE_MULT_RCANCEL; "LE_RDIV_EQ",LE_RDIV_EQ; "LE_REFL",LE_REFL; "LE_SQUARE_REFL",LE_SQUARE_REFL; "LE_SUC",LE_SUC; "LE_SUC_LT",LE_SUC_LT; "LE_TRANS",LE_TRANS; "LHOSPITAL",LHOSPITAL; "LIEB",LIEB; "LIFT_ADD",LIFT_ADD; "LIFT_CMUL",LIFT_CMUL; "LIFT_COMPONENT",LIFT_COMPONENT; "LIFT_DROP",LIFT_DROP; "LIFT_EQ",LIFT_EQ; "LIFT_EQ_CMUL",LIFT_EQ_CMUL; "LIFT_INTEGRAL_COMPONENT",LIFT_INTEGRAL_COMPONENT; "LIFT_IN_IMAGE_LIFT",LIFT_IN_IMAGE_LIFT; "LIFT_IN_INTERVAL",LIFT_IN_INTERVAL; "LIFT_NEG",LIFT_NEG; "LIFT_NUM",LIFT_NUM; "LIFT_SUB",LIFT_SUB; "LIFT_SUM",LIFT_SUM; "LIFT_TO_QUOTIENT_SPACE",LIFT_TO_QUOTIENT_SPACE; "LIFT_TO_QUOTIENT_SPACE_UNIQUE",LIFT_TO_QUOTIENT_SPACE_UNIQUE; "LIM",LIM; "LIMIT_EUCLIDEAN",LIMIT_EUCLIDEAN; "LIMIT_HAUSDORFF_UNIQUE",LIMIT_HAUSDORFF_UNIQUE; "LIMIT_IN_CLOSED_IN",LIMIT_IN_CLOSED_IN; "LIMIT_IN_MSPACE",LIMIT_IN_MSPACE; "LIMIT_IN_TOPSPACE",LIMIT_IN_TOPSPACE; "LIMIT_METRIC",LIMIT_METRIC; "LIMIT_METRIC_SEQUENTIALLY",LIMIT_METRIC_SEQUENTIALLY; "LIMIT_METRIC_UNIQUE",LIMIT_METRIC_UNIQUE; "LIMIT_PAIR_DROP_LE",LIMIT_PAIR_DROP_LE; "LIMIT_POINT_FINITE",LIMIT_POINT_FINITE; "LIMIT_POINT_IN_DERIVED_SET",LIMIT_POINT_IN_DERIVED_SET; "LIMIT_POINT_OF_IMAGE",LIMIT_POINT_OF_IMAGE; "LIMIT_POINT_OF_IMAGE_GEN",LIMIT_POINT_OF_IMAGE_GEN; "LIMIT_POINT_OF_LOCAL",LIMIT_POINT_OF_LOCAL; "LIMIT_POINT_OF_LOCAL_IMP",LIMIT_POINT_OF_LOCAL_IMP; "LIMIT_POINT_OF_SPHERE",LIMIT_POINT_OF_SPHERE; "LIMIT_POINT_UNION",LIMIT_POINT_UNION; "LIMIT_POINT_UNIONS",LIMIT_POINT_UNIONS; "LIMIT_SEQUENTIALLY",LIMIT_SEQUENTIALLY; "LIMIT_SEQUENTIALLY_OFFSET",LIMIT_SEQUENTIALLY_OFFSET; "LIMIT_SEQUENTIALLY_OFFSET_REV",LIMIT_SEQUENTIALLY_OFFSET_REV; "LIMIT_SUBMETRIC_IFF",LIMIT_SUBMETRIC_IFF; "LIMPT_APPROACHABLE",LIMPT_APPROACHABLE; "LIMPT_APPROACHABLE_LE",LIMPT_APPROACHABLE_LE; "LIMPT_APPROACHABLE_LIFT",LIMPT_APPROACHABLE_LIFT; "LIMPT_BALL",LIMPT_BALL; "LIMPT_DELETE",LIMPT_DELETE; "LIMPT_EMPTY",LIMPT_EMPTY; "LIMPT_INFINITE_BALL",LIMPT_INFINITE_BALL; "LIMPT_INFINITE_CBALL",LIMPT_INFINITE_CBALL; "LIMPT_INFINITE_OPEN",LIMPT_INFINITE_OPEN; "LIMPT_INJECTIVE_LINEAR_IMAGE_EQ",LIMPT_INJECTIVE_LINEAR_IMAGE_EQ; "LIMPT_INSERT",LIMPT_INSERT; "LIMPT_OF_CLOSURE",LIMPT_OF_CLOSURE; "LIMPT_OF_CONDENSATION_POINTS",LIMPT_OF_CONDENSATION_POINTS; "LIMPT_OF_CONVEX",LIMPT_OF_CONVEX; "LIMPT_OF_LIMPTS",LIMPT_OF_LIMPTS; "LIMPT_OF_OPEN",LIMPT_OF_OPEN; "LIMPT_OF_OPEN_CLOSURE",LIMPT_OF_OPEN_CLOSURE; "LIMPT_OF_OPEN_IN",LIMPT_OF_OPEN_IN; "LIMPT_OF_SEQUENCE_SUBSEQUENCE",LIMPT_OF_SEQUENCE_SUBSEQUENCE; "LIMPT_OF_UNIV",LIMPT_OF_UNIV; "LIMPT_PCROSS",LIMPT_PCROSS; "LIMPT_SEQUENTIAL",LIMPT_SEQUENTIAL; "LIMPT_SEQUENTIAL_DECREASING",LIMPT_SEQUENTIAL_DECREASING; "LIMPT_SEQUENTIAL_INJ",LIMPT_SEQUENTIAL_INJ; "LIMPT_SING",LIMPT_SING; "LIMPT_SUBSET",LIMPT_SUBSET; "LIMPT_TRANSLATION_EQ",LIMPT_TRANSLATION_EQ; "LIM_1_OVER_LOG",LIM_1_OVER_LOG; "LIM_1_OVER_N",LIM_1_OVER_N; "LIM_1_OVER_POWER",LIM_1_OVER_POWER; "LIM_ABS",LIM_ABS; "LIM_ADD",LIM_ADD; "LIM_AT",LIM_AT; "LIM_ATREAL",LIM_ATREAL; "LIM_ATREAL_AT",LIM_ATREAL_AT; "LIM_ATREAL_ATCOMPLEX",LIM_ATREAL_ATCOMPLEX; "LIM_ATREAL_WITHINREAL",LIM_ATREAL_WITHINREAL; "LIM_ATREAL_ZERO",LIM_ATREAL_ZERO; "LIM_AT_ID",LIM_AT_ID; "LIM_AT_INFINITY",LIM_AT_INFINITY; "LIM_AT_INFINITY_COMPLEX_0",LIM_AT_INFINITY_COMPLEX_0; "LIM_AT_INFINITY_POS",LIM_AT_INFINITY_POS; "LIM_AT_INFINITY_WITHIN",LIM_AT_INFINITY_WITHIN; "LIM_AT_INFINITY_WITHIN_POS",LIM_AT_INFINITY_WITHIN_POS; "LIM_AT_LE",LIM_AT_LE; "LIM_AT_NEGINFINITY",LIM_AT_NEGINFINITY; "LIM_AT_POSINFINITY",LIM_AT_POSINFINITY; "LIM_AT_REFLECT",LIM_AT_REFLECT; "LIM_AT_SEQUENTIALLY",LIM_AT_SEQUENTIALLY; "LIM_AT_WITHIN",LIM_AT_WITHIN; "LIM_AT_ZERO",LIM_AT_ZERO; "LIM_BILINEAR",LIM_BILINEAR; "LIM_BILINEAR_CONVOLUTION",LIM_BILINEAR_CONVOLUTION; "LIM_CASES_COFINITE_SEQUENTIALLY",LIM_CASES_COFINITE_SEQUENTIALLY; "LIM_CASES_FINITE_SEQUENTIALLY",LIM_CASES_FINITE_SEQUENTIALLY; "LIM_CASES_SEQUENTIALLY",LIM_CASES_SEQUENTIALLY; "LIM_CESARO",LIM_CESARO; "LIM_CEXP_MINUS_1",LIM_CEXP_MINUS_1; "LIM_CMUL",LIM_CMUL; "LIM_CMUL_EQ",LIM_CMUL_EQ; "LIM_CNJ",LIM_CNJ; "LIM_COFACTOR",LIM_COFACTOR; "LIM_COMPLEX_DIV",LIM_COMPLEX_DIV; "LIM_COMPLEX_INV",LIM_COMPLEX_INV; "LIM_COMPLEX_INV_NONDEGENERATE",LIM_COMPLEX_INV_NONDEGENERATE; "LIM_COMPLEX_LMUL",LIM_COMPLEX_LMUL; "LIM_COMPLEX_MUL",LIM_COMPLEX_MUL; "LIM_COMPLEX_POW",LIM_COMPLEX_POW; "LIM_COMPLEX_REAL",LIM_COMPLEX_REAL; "LIM_COMPLEX_REAL_0",LIM_COMPLEX_REAL_0; "LIM_COMPLEX_RMUL",LIM_COMPLEX_RMUL; "LIM_COMPONENT",LIM_COMPONENT; "LIM_COMPONENTWISE",LIM_COMPONENTWISE; "LIM_COMPONENTWISE_LIFT",LIM_COMPONENTWISE_LIFT; "LIM_COMPONENT_EQ",LIM_COMPONENT_EQ; "LIM_COMPONENT_LBOUND",LIM_COMPONENT_LBOUND; "LIM_COMPONENT_LE",LIM_COMPONENT_LE; "LIM_COMPONENT_UBOUND",LIM_COMPONENT_UBOUND; "LIM_COMPOSE_AT",LIM_COMPOSE_AT; "LIM_COMPOSE_WITHIN",LIM_COMPOSE_WITHIN; "LIM_CONG_AT",LIM_CONG_AT; "LIM_CONG_ATREAL",LIM_CONG_ATREAL; "LIM_CONG_WITHIN",LIM_CONG_WITHIN; "LIM_CONG_WITHINREAL",LIM_CONG_WITHINREAL; "LIM_CONST",LIM_CONST; "LIM_CONST_EQ",LIM_CONST_EQ; "LIM_CONTINUOUS",LIM_CONTINUOUS; "LIM_CONTINUOUS_FUNCTION",LIM_CONTINUOUS_FUNCTION; "LIM_CONTINUOUS_FUNCTION_WITHIN",LIM_CONTINUOUS_FUNCTION_WITHIN; "LIM_CONTINUOUS_SELF_AT",LIM_CONTINUOUS_SELF_AT; "LIM_CONTINUOUS_SELF_WITHIN",LIM_CONTINUOUS_SELF_WITHIN; "LIM_CSIN_OVER_X",LIM_CSIN_OVER_X; "LIM_CX_LIFT",LIM_CX_LIFT; "LIM_CX_OVER_CEXP",LIM_CX_OVER_CEXP; "LIM_DROP_LBOUND",LIM_DROP_LBOUND; "LIM_DROP_LE",LIM_DROP_LE; "LIM_DROP_UBOUND",LIM_DROP_UBOUND; "LIM_EVENTUALLY",LIM_EVENTUALLY; "LIM_EVENTUALLY_IN_OPEN",LIM_EVENTUALLY_IN_OPEN; "LIM_EVENTUALLY_IN_OPEN_IN",LIM_EVENTUALLY_IN_OPEN_IN; "LIM_IM_LBOUND",LIM_IM_LBOUND; "LIM_IM_UBOUND",LIM_IM_UBOUND; "LIM_INFINITY_POSINFINITY_CX",LIM_INFINITY_POSINFINITY_CX; "LIM_INFINITY_POSINFINITY_LIFT",LIM_INFINITY_POSINFINITY_LIFT; "LIM_INFINITY_SEQUENTIALLY_COMPLEX",LIM_INFINITY_SEQUENTIALLY_COMPLEX; "LIM_INV",LIM_INV; "LIM_INV_N",LIM_INV_N; "LIM_INV_N_OFFSET",LIM_INV_N_OFFSET; "LIM_INV_N_POW",LIM_INV_N_POW; "LIM_INV_N_POW_OFFSET",LIM_INV_N_POW_OFFSET; "LIM_INV_X",LIM_INV_X; "LIM_INV_X_OFFSET",LIM_INV_X_OFFSET; "LIM_INV_X_POW",LIM_INV_X_POW; "LIM_INV_X_POW_OFFSET",LIM_INV_X_POW_OFFSET; "LIM_INV_Z",LIM_INV_Z; "LIM_INV_Z_OFFSET",LIM_INV_Z_OFFSET; "LIM_INV_Z_POW",LIM_INV_Z_POW; "LIM_INV_Z_POW_OFFSET",LIM_INV_Z_POW_OFFSET; "LIM_IN_CLOSED_SET",LIM_IN_CLOSED_SET; "LIM_LIFT_ABS_COMPONENT",LIM_LIFT_ABS_COMPONENT; "LIM_LIFT_DET",LIM_LIFT_DET; "LIM_LIFT_DOT",LIM_LIFT_DOT; "LIM_LIFT_POW",LIM_LIFT_POW; "LIM_LIFT_PRODUCT",LIM_LIFT_PRODUCT; "LIM_LINEAR",LIM_LINEAR; "LIM_LOGPLUS1_OVER_X",LIM_LOGPLUS1_OVER_X; "LIM_LOG_OVER_N",LIM_LOG_OVER_N; "LIM_LOG_OVER_POWER",LIM_LOG_OVER_POWER; "LIM_LOG_OVER_POWER_N",LIM_LOG_OVER_POWER_N; "LIM_LOG_OVER_X",LIM_LOG_OVER_X; "LIM_LOG_OVER_Z",LIM_LOG_OVER_Z; "LIM_MATRIX_COMPONENTWISE",LIM_MATRIX_COMPONENTWISE; "LIM_MATRIX_INV",LIM_MATRIX_INV; "LIM_MATRIX_TRANSP",LIM_MATRIX_TRANSP; "LIM_MAX",LIM_MAX; "LIM_MIN",LIM_MIN; "LIM_MUL",LIM_MUL; "LIM_MUL_NORM_WITHIN",LIM_MUL_NORM_WITHIN; "LIM_NEG",LIM_NEG; "LIM_NEG_EQ",LIM_NEG_EQ; "LIM_NORM",LIM_NORM; "LIM_NORM_LBOUND",LIM_NORM_LBOUND; "LIM_NORM_UBOUND",LIM_NORM_UBOUND; "LIM_NULL",LIM_NULL; "LIM_NULL_ADD",LIM_NULL_ADD; "LIM_NULL_CMUL",LIM_NULL_CMUL; "LIM_NULL_CMUL_BOUNDED",LIM_NULL_CMUL_BOUNDED; "LIM_NULL_CMUL_EQ",LIM_NULL_CMUL_EQ; "LIM_NULL_COMPARISON",LIM_NULL_COMPARISON; "LIM_NULL_COMPARISON_COMPLEX",LIM_NULL_COMPARISON_COMPLEX; "LIM_NULL_COMPARISON_COMPLEX_RE",LIM_NULL_COMPARISON_COMPLEX_RE; "LIM_NULL_COMPLEX",LIM_NULL_COMPLEX; "LIM_NULL_COMPLEX_ADD",LIM_NULL_COMPLEX_ADD; "LIM_NULL_COMPLEX_BOUND",LIM_NULL_COMPLEX_BOUND; "LIM_NULL_COMPLEX_LMUL",LIM_NULL_COMPLEX_LMUL; "LIM_NULL_COMPLEX_LMUL_BOUNDED",LIM_NULL_COMPLEX_LMUL_BOUNDED; "LIM_NULL_COMPLEX_MUL",LIM_NULL_COMPLEX_MUL; "LIM_NULL_COMPLEX_NEG",LIM_NULL_COMPLEX_NEG; "LIM_NULL_COMPLEX_NORM",LIM_NULL_COMPLEX_NORM; "LIM_NULL_COMPLEX_POW",LIM_NULL_COMPLEX_POW; "LIM_NULL_COMPLEX_POW_EQ",LIM_NULL_COMPLEX_POW_EQ; "LIM_NULL_COMPLEX_RMUL",LIM_NULL_COMPLEX_RMUL; "LIM_NULL_COMPLEX_RMUL_BOUNDED",LIM_NULL_COMPLEX_RMUL_BOUNDED; "LIM_NULL_COMPLEX_SUB",LIM_NULL_COMPLEX_SUB; "LIM_NULL_MATRIX_ONORM",LIM_NULL_MATRIX_ONORM; "LIM_NULL_MATRIX_ONORM_COMPONENTWISE",LIM_NULL_MATRIX_ONORM_COMPONENTWISE; "LIM_NULL_NEG",LIM_NULL_NEG; "LIM_NULL_NORM",LIM_NULL_NORM; "LIM_NULL_ONORM",LIM_NULL_ONORM; "LIM_NULL_ONORM_COMPONENTWISE",LIM_NULL_ONORM_COMPONENTWISE; "LIM_NULL_RPOW",LIM_NULL_RPOW; "LIM_NULL_SUB",LIM_NULL_SUB; "LIM_NULL_VMUL",LIM_NULL_VMUL; "LIM_NULL_VMUL_BOUNDED",LIM_NULL_VMUL_BOUNDED; "LIM_NULL_VMUL_EQ",LIM_NULL_VMUL_EQ; "LIM_NULL_VSUM",LIM_NULL_VSUM; "LIM_N_MUL_SUB_CLOG",LIM_N_MUL_SUB_CLOG; "LIM_N_OVER_POWN",LIM_N_OVER_POWN; "LIM_N_TIMES_POWN",LIM_N_TIMES_POWN; "LIM_PASTECART",LIM_PASTECART; "LIM_PASTECART_EQ",LIM_PASTECART_EQ; "LIM_POSINFINITY_SEQUENTIALLY",LIM_POSINFINITY_SEQUENTIALLY; "LIM_POWN",LIM_POWN; "LIM_REAL_CONTINUOUS_FUNCTION",LIM_REAL_CONTINUOUS_FUNCTION; "LIM_RE_LBOUND",LIM_RE_LBOUND; "LIM_RE_UBOUND",LIM_RE_UBOUND; "LIM_SELF_AT",LIM_SELF_AT; "LIM_SELF_WITHIN",LIM_SELF_WITHIN; "LIM_SEQUENTIALLY",LIM_SEQUENTIALLY; "LIM_SUB",LIM_SUB; "LIM_SUBSEQUENCE",LIM_SUBSEQUENCE; "LIM_SUB_CLOG",LIM_SUB_CLOG; "LIM_TRANSFORM",LIM_TRANSFORM; "LIM_TRANSFORM_AT",LIM_TRANSFORM_AT; "LIM_TRANSFORM_AWAY_AT",LIM_TRANSFORM_AWAY_AT; "LIM_TRANSFORM_AWAY_WITHIN",LIM_TRANSFORM_AWAY_WITHIN; "LIM_TRANSFORM_BOUND",LIM_TRANSFORM_BOUND; "LIM_TRANSFORM_EQ",LIM_TRANSFORM_EQ; "LIM_TRANSFORM_EVENTUALLY",LIM_TRANSFORM_EVENTUALLY; "LIM_TRANSFORM_WITHIN",LIM_TRANSFORM_WITHIN; "LIM_TRANSFORM_WITHINREAL_SET",LIM_TRANSFORM_WITHINREAL_SET; "LIM_TRANSFORM_WITHINREAL_SET_IMP",LIM_TRANSFORM_WITHINREAL_SET_IMP; "LIM_TRANSFORM_WITHIN_OPEN",LIM_TRANSFORM_WITHIN_OPEN; "LIM_TRANSFORM_WITHIN_OPEN_IN",LIM_TRANSFORM_WITHIN_OPEN_IN; "LIM_TRANSFORM_WITHIN_SET",LIM_TRANSFORM_WITHIN_SET; "LIM_TRANSFORM_WITHIN_SET_IMP",LIM_TRANSFORM_WITHIN_SET_IMP; "LIM_UNION",LIM_UNION; "LIM_UNION_UNIV",LIM_UNION_UNIV; "LIM_UNIQUE",LIM_UNIQUE; "LIM_VMUL",LIM_VMUL; "LIM_VSUM",LIM_VSUM; "LIM_WITHIN",LIM_WITHIN; "LIM_WITHINREAL",LIM_WITHINREAL; "LIM_WITHINREAL_LE",LIM_WITHINREAL_LE; "LIM_WITHINREAL_SUBSET",LIM_WITHINREAL_SUBSET; "LIM_WITHINREAL_WITHIN",LIM_WITHINREAL_WITHIN; "LIM_WITHINREAL_WITHINCOMPLEX",LIM_WITHINREAL_WITHINCOMPLEX; "LIM_WITHIN_CLOSED_TRIVIAL",LIM_WITHIN_CLOSED_TRIVIAL; "LIM_WITHIN_DELETE",LIM_WITHIN_DELETE; "LIM_WITHIN_EMPTY",LIM_WITHIN_EMPTY; "LIM_WITHIN_ID",LIM_WITHIN_ID; "LIM_WITHIN_INTERIOR",LIM_WITHIN_INTERIOR; "LIM_WITHIN_INTERIOR_INTER",LIM_WITHIN_INTERIOR_INTER; "LIM_WITHIN_LE",LIM_WITHIN_LE; "LIM_WITHIN_OPEN",LIM_WITHIN_OPEN; "LIM_WITHIN_OPEN_IN",LIM_WITHIN_OPEN_IN; "LIM_WITHIN_REAL_OPEN",LIM_WITHIN_REAL_OPEN; "LIM_WITHIN_REFLECT",LIM_WITHIN_REFLECT; "LIM_WITHIN_SEQUENTIALLY",LIM_WITHIN_SEQUENTIALLY; "LIM_WITHIN_SEQUENTIALLY_DECREASING",LIM_WITHIN_SEQUENTIALLY_DECREASING; "LIM_WITHIN_SEQUENTIALLY_INJ",LIM_WITHIN_SEQUENTIALLY_INJ; "LIM_WITHIN_SUBSET",LIM_WITHIN_SUBSET; "LIM_WITHIN_UNION",LIM_WITHIN_UNION; "LIM_WITHIN_ZERO",LIM_WITHIN_ZERO; "LIM_ZERO_INFINITY_COMPLEX",LIM_ZERO_INFINITY_COMPLEX; "LIM_ZERO_NEGINFINITY",LIM_ZERO_NEGINFINITY; "LIM_ZERO_POSINFINITY",LIM_ZERO_POSINFINITY; "LIM_Z_TIMES_CLOG",LIM_Z_TIMES_CLOG; "LINDELOF",LINDELOF; "LINDELOF_OPEN_IN",LINDELOF_OPEN_IN; "LINEAR_0",LINEAR_0; "LINEAR_1",LINEAR_1; "LINEAR_1_GEN",LINEAR_1_GEN; "LINEAR_ADD",LINEAR_ADD; "LINEAR_BIJECTIVE_DIMINDEX_EQ",LINEAR_BIJECTIVE_DIMINDEX_EQ; "LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE",LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE; "LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ",LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ; "LINEAR_BOUNDED",LINEAR_BOUNDED; "LINEAR_BOUNDED_POS",LINEAR_BOUNDED_POS; "LINEAR_CLOSEST_POINT",LINEAR_CLOSEST_POINT; "LINEAR_CMUL",LINEAR_CMUL; "LINEAR_CNJ",LINEAR_CNJ; "LINEAR_COMPLEX_LMUL",LINEAR_COMPLEX_LMUL; "LINEAR_COMPLEX_MUL",LINEAR_COMPLEX_MUL; "LINEAR_COMPLEX_RMUL",LINEAR_COMPLEX_RMUL; "LINEAR_COMPONENTWISE",LINEAR_COMPONENTWISE; "LINEAR_COMPONENTWISE_EXPANSION",LINEAR_COMPONENTWISE_EXPANSION; "LINEAR_COMPOSE",LINEAR_COMPOSE; "LINEAR_COMPOSE_ADD",LINEAR_COMPOSE_ADD; "LINEAR_COMPOSE_CMUL",LINEAR_COMPOSE_CMUL; "LINEAR_COMPOSE_NEG",LINEAR_COMPOSE_NEG; "LINEAR_COMPOSE_NEG_EQ",LINEAR_COMPOSE_NEG_EQ; "LINEAR_COMPOSE_SUB",LINEAR_COMPOSE_SUB; "LINEAR_COMPOSE_VSUM",LINEAR_COMPOSE_VSUM; "LINEAR_CONTINUOUS_AT",LINEAR_CONTINUOUS_AT; "LINEAR_CONTINUOUS_COMPOSE",LINEAR_CONTINUOUS_COMPOSE; "LINEAR_CONTINUOUS_ON",LINEAR_CONTINUOUS_ON; "LINEAR_CONTINUOUS_ON_COMPOSE",LINEAR_CONTINUOUS_ON_COMPOSE; "LINEAR_CONTINUOUS_WITHIN",LINEAR_CONTINUOUS_WITHIN; "LINEAR_CONVEX_ON_1",LINEAR_CONVEX_ON_1; "LINEAR_CX_IM",LINEAR_CX_IM; "LINEAR_CX_RE",LINEAR_CX_RE; "LINEAR_DROPOUT",LINEAR_DROPOUT; "LINEAR_EQ",LINEAR_EQ; "LINEAR_EQ_0",LINEAR_EQ_0; "LINEAR_EQ_0_SPAN",LINEAR_EQ_0_SPAN; "LINEAR_EQ_MATRIX",LINEAR_EQ_MATRIX; "LINEAR_EQ_MBASIS",LINEAR_EQ_MBASIS; "LINEAR_EQ_STDBASIS",LINEAR_EQ_STDBASIS; "LINEAR_FRECHET_DERIVATIVE",LINEAR_FRECHET_DERIVATIVE; "LINEAR_FROM_1",LINEAR_FROM_1; "LINEAR_FROM_REALS",LINEAR_FROM_REALS; "LINEAR_FSTCART",LINEAR_FSTCART; "LINEAR_I",LINEAR_I; "LINEAR_ID",LINEAR_ID; "LINEAR_IMAGE_SUBSET_INTERIOR",LINEAR_IMAGE_SUBSET_INTERIOR; "LINEAR_IMP_CONVEX_ON",LINEAR_IMP_CONVEX_ON; "LINEAR_IMP_HAS_BOUNDED_VARIATION",LINEAR_IMP_HAS_BOUNDED_VARIATION; "LINEAR_IMP_HOMEOMORPHISM",LINEAR_IMP_HOMEOMORPHISM; "LINEAR_IMP_LIPSCHITZ",LINEAR_IMP_LIPSCHITZ; "LINEAR_INDEPENDENT_EXTEND",LINEAR_INDEPENDENT_EXTEND; "LINEAR_INDEPENDENT_EXTEND_LEMMA",LINEAR_INDEPENDENT_EXTEND_LEMMA; "LINEAR_INDEP_IMAGE_LEMMA",LINEAR_INDEP_IMAGE_LEMMA; "LINEAR_INJECTIVE_0",LINEAR_INJECTIVE_0; "LINEAR_INJECTIVE_0_SUBSPACE",LINEAR_INJECTIVE_0_SUBSPACE; "LINEAR_INJECTIVE_BOUNDED_BELOW_POS",LINEAR_INJECTIVE_BOUNDED_BELOW_POS; "LINEAR_INJECTIVE_DIMINDEX_LE",LINEAR_INJECTIVE_DIMINDEX_LE; "LINEAR_INJECTIVE_IFF_DIM",LINEAR_INJECTIVE_IFF_DIM; "LINEAR_INJECTIVE_IMP_SURJECTIVE",LINEAR_INJECTIVE_IMP_SURJECTIVE; "LINEAR_INJECTIVE_IMP_SURJECTIVE_ON",LINEAR_INJECTIVE_IMP_SURJECTIVE_ON; "LINEAR_INJECTIVE_ISOMORPHISM",LINEAR_INJECTIVE_ISOMORPHISM; "LINEAR_INJECTIVE_LEFT_INVERSE",LINEAR_INJECTIVE_LEFT_INVERSE; "LINEAR_INJECTIVE_LEFT_INVERSE_EQ",LINEAR_INJECTIVE_LEFT_INVERSE_EQ; "LINEAR_INJECTIVE_LEFT_RIGHT_INVERSE_EQ",LINEAR_INJECTIVE_LEFT_RIGHT_INVERSE_EQ; "LINEAR_INJECTIVE_ON_IFF_DIM",LINEAR_INJECTIVE_ON_IFF_DIM; "LINEAR_INTERIOR_IMAGE_SUBSET",LINEAR_INTERIOR_IMAGE_SUBSET; "LINEAR_INVERSE_LEFT",LINEAR_INVERSE_LEFT; "LINEAR_INVERTIBLE_BOUNDED_BELOW",LINEAR_INVERTIBLE_BOUNDED_BELOW; "LINEAR_INVERTIBLE_BOUNDED_BELOW_POS",LINEAR_INVERTIBLE_BOUNDED_BELOW_POS; "LINEAR_LIFT_COMPONENT",LINEAR_LIFT_COMPONENT; "LINEAR_LIFT_DOT",LINEAR_LIFT_DOT; "LINEAR_LIMIT",LINEAR_LIMIT; "LINEAR_LIM_0",LINEAR_LIM_0; "LINEAR_MATRIX_EXISTS",LINEAR_MATRIX_EXISTS; "LINEAR_NEG",LINEAR_NEG; "LINEAR_NEGATION",LINEAR_NEGATION; "LINEAR_OPEN_MAPPING",LINEAR_OPEN_MAPPING; "LINEAR_PASTECART",LINEAR_PASTECART; "LINEAR_PASTECART_EQ",LINEAR_PASTECART_EQ; "LINEAR_PROPERTY",LINEAR_PROPERTY; "LINEAR_PUSHIN",LINEAR_PUSHIN; "LINEAR_REFLECT_ALONG",LINEAR_REFLECT_ALONG; "LINEAR_ROTATE2D",LINEAR_ROTATE2D; "LINEAR_SCALING",LINEAR_SCALING; "LINEAR_SEQUENTIAL_LIMIT",LINEAR_SEQUENTIAL_LIMIT; "LINEAR_SINGULAR_IMAGE_HYPERPLANE",LINEAR_SINGULAR_IMAGE_HYPERPLANE; "LINEAR_SINGULAR_INTO_HYPERPLANE",LINEAR_SINGULAR_INTO_HYPERPLANE; "LINEAR_SNDCART",LINEAR_SNDCART; "LINEAR_SUB",LINEAR_SUB; "LINEAR_SUBSPACE_GRAPH",LINEAR_SUBSPACE_GRAPH; "LINEAR_SURJECTIVE_DIMINDEX_LE",LINEAR_SURJECTIVE_DIMINDEX_LE; "LINEAR_SURJECTIVE_IFF_DIM",LINEAR_SURJECTIVE_IFF_DIM; "LINEAR_SURJECTIVE_IFF_INJECTIVE",LINEAR_SURJECTIVE_IFF_INJECTIVE; "LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN",LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN; "LINEAR_SURJECTIVE_IFF_INJECTIVE_ON",LINEAR_SURJECTIVE_IFF_INJECTIVE_ON; "LINEAR_SURJECTIVE_IMP_INJECTIVE",LINEAR_SURJECTIVE_IMP_INJECTIVE; "LINEAR_SURJECTIVE_ISOMORPHISM",LINEAR_SURJECTIVE_ISOMORPHISM; "LINEAR_SURJECTIVE_LEFT_RIGHT_INVERSE_EQ",LINEAR_SURJECTIVE_LEFT_RIGHT_INVERSE_EQ; "LINEAR_SURJECTIVE_ON_IFF_DIM",LINEAR_SURJECTIVE_ON_IFF_DIM; "LINEAR_SURJECTIVE_RIGHT_INVERSE",LINEAR_SURJECTIVE_RIGHT_INVERSE; "LINEAR_SURJECTIVE_RIGHT_INVERSE_EQ",LINEAR_SURJECTIVE_RIGHT_INVERSE_EQ; "LINEAR_TO_1",LINEAR_TO_1; "LINEAR_TO_REALS",LINEAR_TO_REALS; "LINEAR_UNIFORMLY_CONTINUOUS_ON",LINEAR_UNIFORMLY_CONTINUOUS_ON; "LINEAR_VMUL_COMPONENT",LINEAR_VMUL_COMPONENT; "LINEAR_VMUL_DROP",LINEAR_VMUL_DROP; "LINEAR_VSUM",LINEAR_VSUM; "LINEAR_VSUM_MUL",LINEAR_VSUM_MUL; "LINEAR_ZERO",LINEAR_ZERO; "LINEPATH_CX",LINEPATH_CX; "LINEPATH_IN_PATH",LINEPATH_IN_PATH; "LINEPATH_LINEAR_IMAGE",LINEPATH_LINEAR_IMAGE; "LINEPATH_REFL",LINEPATH_REFL; "LINEPATH_TRANSLATION",LINEPATH_TRANSLATION; "LINSEG_FL",LINSEG_FL; "LINSEG_INSEG",LINSEG_INSEG; "LINSEG_WOSET",LINSEG_WOSET; "LIOUVILLE_POLYNOMIAL",LIOUVILLE_POLYNOMIAL; "LIOUVILLE_THEOREM",LIOUVILLE_THEOREM; "LIOUVILLE_WEAK",LIOUVILLE_WEAK; "LIOUVILLE_WEAK_INVERSE",LIOUVILLE_WEAK_INVERSE; "LIPSCHITZ_COEFFICIENT_POS",LIPSCHITZ_COEFFICIENT_POS; "LIPSCHITZ_CONTINUOUS_IMP_TOPCONTINUOUS",LIPSCHITZ_CONTINUOUS_IMP_TOPCONTINUOUS; "LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION",LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION; "LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT",LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT; "LIPSCHITZ_EXTENSION_EXISTS",LIPSCHITZ_EXTENSION_EXISTS; "LIPSCHITZ_IMP_ABSOLUTELY_CONTINUOUS",LIPSCHITZ_IMP_ABSOLUTELY_CONTINUOUS; "LIPSCHITZ_IMP_CONTINUOUS_ON",LIPSCHITZ_IMP_CONTINUOUS_ON; "LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION",LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION; "LIPSCHITZ_IMP_RECTIFIABLE_PATH",LIPSCHITZ_IMP_RECTIFIABLE_PATH; "LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON",LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON; "LIPSCHITZ_LIM",LIPSCHITZ_LIM; "LIPSCHITZ_ON_COMBINE",LIPSCHITZ_ON_COMBINE; "LIPSCHITZ_ON_COMPONENTWISE",LIPSCHITZ_ON_COMPONENTWISE; "LIPSCHITZ_ON_COMPOSE",LIPSCHITZ_ON_COMPOSE; "LIPSCHITZ_ON_INF",LIPSCHITZ_ON_INF; "LIPSCHITZ_ON_POS",LIPSCHITZ_ON_POS; "LIPSCHITZ_ON_SUP",LIPSCHITZ_ON_SUP; "LIPSCHITZ_ON_UNION",LIPSCHITZ_ON_UNION; "LIPSCHITZ_POS",LIPSCHITZ_POS; "LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION",LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION; "LIPSCHITZ_VECTOR_POLYNOMIAL_FUNCTION",LIPSCHITZ_VECTOR_POLYNOMIAL_FUNCTION; "LIPSCHITZ_VECTOR_VARIATION",LIPSCHITZ_VECTOR_VARIATION; "LIST_EQ",LIST_EQ; "LIST_OF_SEQ_EQ_NIL",LIST_OF_SEQ_EQ_NIL; "LIST_OF_SET_EMPTY",LIST_OF_SET_EMPTY; "LIST_OF_SET_PROPERTIES",LIST_OF_SET_PROPERTIES; "LIST_OF_SET_SING",LIST_OF_SET_SING; "LITTLE_PICARD",LITTLE_PICARD; "LOCALLY_AND_OPEN_IN",LOCALLY_AND_OPEN_IN; "LOCALLY_AND_OPEN_IN_IDEMPOT",LOCALLY_AND_OPEN_IN_IDEMPOT; "LOCALLY_AND_SMALL_LE",LOCALLY_AND_SMALL_LE; "LOCALLY_AND_SMALL_LT",LOCALLY_AND_SMALL_LT; "LOCALLY_AND_SUBSET",LOCALLY_AND_SUBSET; "LOCALLY_ANR",LOCALLY_ANR; "LOCALLY_ANR_ALT",LOCALLY_ANR_ALT; "LOCALLY_CLOSED",LOCALLY_CLOSED; "LOCALLY_CLOSED_IN",LOCALLY_CLOSED_IN; "LOCALLY_CLOSED_IN_EXPLICIT",LOCALLY_CLOSED_IN_EXPLICIT; "LOCALLY_COMPACT",LOCALLY_COMPACT; "LOCALLY_COMPACT_ALT",LOCALLY_COMPACT_ALT; "LOCALLY_COMPACT_CLOSED_DIFF",LOCALLY_COMPACT_CLOSED_DIFF; "LOCALLY_COMPACT_CLOSED_IN",LOCALLY_COMPACT_CLOSED_IN; "LOCALLY_COMPACT_CLOSED_INTER_OPEN",LOCALLY_COMPACT_CLOSED_INTER_OPEN; "LOCALLY_COMPACT_CLOSED_IN_OPEN",LOCALLY_COMPACT_CLOSED_IN_OPEN; "LOCALLY_COMPACT_CLOSED_UNION",LOCALLY_COMPACT_CLOSED_UNION; "LOCALLY_COMPACT_CLOSURE_DIFF",LOCALLY_COMPACT_CLOSURE_DIFF; "LOCALLY_COMPACT_COMPACT",LOCALLY_COMPACT_COMPACT; "LOCALLY_COMPACT_COMPACT_ALT",LOCALLY_COMPACT_COMPACT_ALT; "LOCALLY_COMPACT_COMPACT_SUBOPEN",LOCALLY_COMPACT_COMPACT_SUBOPEN; "LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED",LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED; "LOCALLY_COMPACT_DELETE",LOCALLY_COMPACT_DELETE; "LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED",LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED; "LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED",LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED; "LOCALLY_COMPACT_IMP_ANALYTIC",LOCALLY_COMPACT_IMP_ANALYTIC; "LOCALLY_COMPACT_IMP_BOREL",LOCALLY_COMPACT_IMP_BOREL; "LOCALLY_COMPACT_INTER",LOCALLY_COMPACT_INTER; "LOCALLY_COMPACT_INTER_CBALL",LOCALLY_COMPACT_INTER_CBALL; "LOCALLY_COMPACT_INTER_CBALLS",LOCALLY_COMPACT_INTER_CBALLS; "LOCALLY_COMPACT_LINEAR_IMAGE_EQ",LOCALLY_COMPACT_LINEAR_IMAGE_EQ; "LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED",LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED; "LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED",LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED; "LOCALLY_COMPACT_OPEN_IN",LOCALLY_COMPACT_OPEN_IN; "LOCALLY_COMPACT_OPEN_INTER_CLOSURE",LOCALLY_COMPACT_OPEN_INTER_CLOSURE; "LOCALLY_COMPACT_OPEN_UNION",LOCALLY_COMPACT_OPEN_UNION; "LOCALLY_COMPACT_OPEN_UNIONS",LOCALLY_COMPACT_OPEN_UNIONS; "LOCALLY_COMPACT_PATH_CONNECTED_EQ_CONNECTED",LOCALLY_COMPACT_PATH_CONNECTED_EQ_CONNECTED; "LOCALLY_COMPACT_PCROSS",LOCALLY_COMPACT_PCROSS; "LOCALLY_COMPACT_PCROSS_EQ",LOCALLY_COMPACT_PCROSS_EQ; "LOCALLY_COMPACT_PROPER_CONTINUOUS_PREIMAGE",LOCALLY_COMPACT_PROPER_CONTINUOUS_PREIMAGE; "LOCALLY_COMPACT_PROPER_IMAGE",LOCALLY_COMPACT_PROPER_IMAGE; "LOCALLY_COMPACT_PROPER_IMAGE_EQ",LOCALLY_COMPACT_PROPER_IMAGE_EQ; "LOCALLY_COMPACT_TRANSLATION_EQ",LOCALLY_COMPACT_TRANSLATION_EQ; "LOCALLY_COMPACT_UNIV",LOCALLY_COMPACT_UNIV; "LOCALLY_CONNECTED",LOCALLY_CONNECTED; "LOCALLY_CONNECTED_CLOSED_UNION",LOCALLY_CONNECTED_CLOSED_UNION; "LOCALLY_CONNECTED_CLOSED_UNIONS",LOCALLY_CONNECTED_CLOSED_UNIONS; "LOCALLY_CONNECTED_CLOSED_UNION_GEN",LOCALLY_CONNECTED_CLOSED_UNION_GEN; "LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER",LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER; "LOCALLY_CONNECTED_COMPONENTS",LOCALLY_CONNECTED_COMPONENTS; "LOCALLY_CONNECTED_CONNECTED_COMPONENT",LOCALLY_CONNECTED_CONNECTED_COMPONENT; "LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT; "LOCALLY_CONNECTED_CONTINUUM",LOCALLY_CONNECTED_CONTINUUM; "LOCALLY_CONNECTED_FROM_UNION_AND_INTER",LOCALLY_CONNECTED_FROM_UNION_AND_INTER; "LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN",LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN; "LOCALLY_CONNECTED_FRONTIER_ANR",LOCALLY_CONNECTED_FRONTIER_ANR; "LOCALLY_CONNECTED_IM_KLEINEN",LOCALLY_CONNECTED_IM_KLEINEN; "LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE; "LOCALLY_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_CONNECTED_LINEAR_IMAGE_EQ; "LOCALLY_CONNECTED_OPEN_COMPONENT",LOCALLY_CONNECTED_OPEN_COMPONENT; "LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT",LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT; "LOCALLY_CONNECTED_PATH_IMAGE",LOCALLY_CONNECTED_PATH_IMAGE; "LOCALLY_CONNECTED_PCROSS",LOCALLY_CONNECTED_PCROSS; "LOCALLY_CONNECTED_PCROSS_EQ",LOCALLY_CONNECTED_PCROSS_EQ; "LOCALLY_CONNECTED_QUOTIENT_IMAGE",LOCALLY_CONNECTED_QUOTIENT_IMAGE; "LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE; "LOCALLY_CONNECTED_SPHERE",LOCALLY_CONNECTED_SPHERE; "LOCALLY_CONNECTED_SPHERE_GEN",LOCALLY_CONNECTED_SPHERE_GEN; "LOCALLY_CONNECTED_SUBREGION",LOCALLY_CONNECTED_SUBREGION; "LOCALLY_CONNECTED_TRANSLATION_EQ",LOCALLY_CONNECTED_TRANSLATION_EQ; "LOCALLY_CONNECTED_UNIV",LOCALLY_CONNECTED_UNIV; "LOCALLY_CONSTANT",LOCALLY_CONSTANT; "LOCALLY_CONSTANT_IMP_CONSTANT",LOCALLY_CONSTANT_IMP_CONSTANT; "LOCALLY_CONTINUOUS_ON",LOCALLY_CONTINUOUS_ON; "LOCALLY_CONTINUOUS_ON_ALT",LOCALLY_CONTINUOUS_ON_ALT; "LOCALLY_CONTINUOUS_ON_EXPLICIT",LOCALLY_CONTINUOUS_ON_EXPLICIT; "LOCALLY_CONVEX",LOCALLY_CONVEX; "LOCALLY_COUNTABLE",LOCALLY_COUNTABLE; "LOCALLY_DIFF_CLOSED",LOCALLY_DIFF_CLOSED; "LOCALLY_DIMENSION_EQ",LOCALLY_DIMENSION_EQ; "LOCALLY_DIMENSION_LE",LOCALLY_DIMENSION_LE; "LOCALLY_EMPTY",LOCALLY_EMPTY; "LOCALLY_ENR",LOCALLY_ENR; "LOCALLY_ENR_ALT",LOCALLY_ENR_ALT; "LOCALLY_FCCOVERABLE",LOCALLY_FCCOVERABLE; "LOCALLY_FCCOVERABLE_ALT",LOCALLY_FCCOVERABLE_ALT; "LOCALLY_FINE_COVERING_COMPACT",LOCALLY_FINE_COVERING_COMPACT; "LOCALLY_IMP_COUNTABLE_UNION_OF",LOCALLY_IMP_COUNTABLE_UNION_OF; "LOCALLY_IMP_FINITE_UNION_OF",LOCALLY_IMP_FINITE_UNION_OF; "LOCALLY_INJECTIVE_LINEAR_IMAGE",LOCALLY_INJECTIVE_LINEAR_IMAGE; "LOCALLY_INTER",LOCALLY_INTER; "LOCALLY_INTER_OPEN",LOCALLY_INTER_OPEN; "LOCALLY_LEBESGUE_MEASURABLE",LOCALLY_LEBESGUE_MEASURABLE; "LOCALLY_LEBESGUE_MEASURABLE_ALT",LOCALLY_LEBESGUE_MEASURABLE_ALT; "LOCALLY_LIPSCHITZ",LOCALLY_LIPSCHITZ; "LOCALLY_LIPSCHITZ_GEN",LOCALLY_LIPSCHITZ_GEN; "LOCALLY_LOCALLY",LOCALLY_LOCALLY; "LOCALLY_MONO",LOCALLY_MONO; "LOCALLY_NEGLIGIBLE",LOCALLY_NEGLIGIBLE; "LOCALLY_NEGLIGIBLE_ALT",LOCALLY_NEGLIGIBLE_ALT; "LOCALLY_ON_NBDS",LOCALLY_ON_NBDS; "LOCALLY_ON_OPEN_SUBSETS",LOCALLY_ON_OPEN_SUBSETS; "LOCALLY_OPEN_AND_DIMENSION_LE",LOCALLY_OPEN_AND_DIMENSION_LE; "LOCALLY_OPEN_BASIS",LOCALLY_OPEN_BASIS; "LOCALLY_OPEN_INTER",LOCALLY_OPEN_INTER; "LOCALLY_OPEN_MAP_IMAGE",LOCALLY_OPEN_MAP_IMAGE; "LOCALLY_OPEN_SUBSET",LOCALLY_OPEN_SUBSET; "LOCALLY_PATH_CONNECTED",LOCALLY_PATH_CONNECTED; "LOCALLY_PATH_CONNECTED_CLOSURE_FROM_FRONTIER",LOCALLY_PATH_CONNECTED_CLOSURE_FROM_FRONTIER; "LOCALLY_PATH_CONNECTED_COMPONENTS",LOCALLY_PATH_CONNECTED_COMPONENTS; "LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT",LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT; "LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT; "LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER",LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER; "LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN",LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN; "LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED",LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED; "LOCALLY_PATH_CONNECTED_IM_KLEINEN",LOCALLY_PATH_CONNECTED_IM_KLEINEN; "LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE; "LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ; "LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT; "LOCALLY_PATH_CONNECTED_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_PATH_COMPONENT; "LOCALLY_PATH_CONNECTED_PATH_IMAGE",LOCALLY_PATH_CONNECTED_PATH_IMAGE; "LOCALLY_PATH_CONNECTED_PCROSS",LOCALLY_PATH_CONNECTED_PCROSS; "LOCALLY_PATH_CONNECTED_PCROSS_EQ",LOCALLY_PATH_CONNECTED_PCROSS_EQ; "LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE",LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE; "LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE; "LOCALLY_PATH_CONNECTED_SPHERE",LOCALLY_PATH_CONNECTED_SPHERE; "LOCALLY_PATH_CONNECTED_SPHERE_GEN",LOCALLY_PATH_CONNECTED_SPHERE_GEN; "LOCALLY_PATH_CONNECTED_SUBREGION",LOCALLY_PATH_CONNECTED_SUBREGION; "LOCALLY_PATH_CONNECTED_TRANSLATION_EQ",LOCALLY_PATH_CONNECTED_TRANSLATION_EQ; "LOCALLY_PATH_CONNECTED_UNIV",LOCALLY_PATH_CONNECTED_UNIV; "LOCALLY_PCROSS",LOCALLY_PCROSS; "LOCALLY_SING",LOCALLY_SING; "LOCALLY_TRANSLATION",LOCALLY_TRANSLATION; "LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP",LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP; "LOG2_APPROX_32",LOG2_APPROX_32; "LOG_1",LOG_1; "LOG_CONVEX_ADD",LOG_CONVEX_ADD; "LOG_CONVEX_CONST",LOG_CONVEX_CONST; "LOG_CONVEX_IMP_CONVEX",LOG_CONVEX_IMP_CONVEX; "LOG_CONVEX_IMP_POS",LOG_CONVEX_IMP_POS; "LOG_CONVEX_MUL",LOG_CONVEX_MUL; "LOG_CONVEX_ON",LOG_CONVEX_ON; "LOG_CONVEX_ON_CONVEX",LOG_CONVEX_ON_CONVEX; "LOG_CONVEX_ON_EMPTY",LOG_CONVEX_ON_EMPTY; "LOG_CONVEX_ON_EQ",LOG_CONVEX_ON_EQ; "LOG_CONVEX_ON_SING",LOG_CONVEX_ON_SING; "LOG_CONVEX_ON_SUBSET",LOG_CONVEX_ON_SUBSET; "LOG_CONVEX_PRODUCT",LOG_CONVEX_PRODUCT; "LOG_DIV",LOG_DIV; "LOG_EXP",LOG_EXP; "LOG_INJ",LOG_INJ; "LOG_INV",LOG_INV; "LOG_LE",LOG_LE; "LOG_LE_STRONG",LOG_LE_STRONG; "LOG_LT_X",LOG_LT_X; "LOG_MONO_LE",LOG_MONO_LE; "LOG_MONO_LE_IMP",LOG_MONO_LE_IMP; "LOG_MONO_LE_REV",LOG_MONO_LE_REV; "LOG_MONO_LT",LOG_MONO_LT; "LOG_MONO_LT_IMP",LOG_MONO_LT_IMP; "LOG_MONO_LT_REV",LOG_MONO_LT_REV; "LOG_MUL",LOG_MUL; "LOG_POS",LOG_POS; "LOG_POS_LT",LOG_POS_LT; "LOG_POW",LOG_POW; "LOG_PRODUCT",LOG_PRODUCT; "LOG_ROOT",LOG_ROOT; "LOG_RPOW",LOG_RPOW; "LOG_SQRT",LOG_SQRT; "LOWDIM_EQ_HYPERPLANE",LOWDIM_EQ_HYPERPLANE; "LOWDIM_EQ_INTER_HYPERPLANE",LOWDIM_EQ_INTER_HYPERPLANE; "LOWDIM_EXPAND_BASIS",LOWDIM_EXPAND_BASIS; "LOWDIM_EXPAND_DIMENSION",LOWDIM_EXPAND_DIMENSION; "LOWDIM_SUBSET_HYPERPLANE",LOWDIM_SUBSET_HYPERPLANE; "LOWER_BOUND_FINITE_SET",LOWER_BOUND_FINITE_SET; "LOWER_BOUND_FINITE_SET_REAL",LOWER_BOUND_FINITE_SET_REAL; "LOWER_HEMICONTINUOUS",LOWER_HEMICONTINUOUS; "LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT",LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT; "LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT",LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT; "LPC_OPEN_SIMPLE_PATH_COMPLEMENT",LPC_OPEN_SIMPLE_PATH_COMPLEMENT; "LPC_SUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE",LPC_SUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE; "LT",LT; "LTE_ADD2",LTE_ADD2; "LTE_ANTISYM",LTE_ANTISYM; "LTE_CASES",LTE_CASES; "LTE_TRANS",LTE_TRANS; "LT_0",LT_0; "LT_ADD",LT_ADD; "LT_ADD2",LT_ADD2; "LT_ADDR",LT_ADDR; "LT_ADD_LCANCEL",LT_ADD_LCANCEL; "LT_ADD_RCANCEL",LT_ADD_RCANCEL; "LT_ANTISYM",LT_ANTISYM; "LT_CASES",LT_CASES; "LT_EXISTS",LT_EXISTS; "LT_EXP",LT_EXP; "LT_IMP_LE",LT_IMP_LE; "LT_LE",LT_LE; "LT_LMULT",LT_LMULT; "LT_MULT",LT_MULT; "LT_MULT2",LT_MULT2; "LT_MULT_LCANCEL",LT_MULT_LCANCEL; "LT_MULT_RCANCEL",LT_MULT_RCANCEL; "LT_NZ",LT_NZ; "LT_POW2_REFL",LT_POW2_REFL; "LT_REFL",LT_REFL; "LT_SUC",LT_SUC; "LT_SUC_LE",LT_SUC_LE; "LT_TRANS",LT_TRANS; "LUZIN",LUZIN; "LUZIN_EQ",LUZIN_EQ; "LUZIN_EQ_ALT",LUZIN_EQ_ALT; "LUZIN_NPROPERTY_IMP_COUNTABLE_PREIMAGES",LUZIN_NPROPERTY_IMP_COUNTABLE_PREIMAGES; "LUZIN_SIGMA",LUZIN_SIGMA; "LUZIN_SIGMA_EXPLICIT",LUZIN_SIGMA_EXPLICIT; "LUZIN_SIGMA_NESTED",LUZIN_SIGMA_NESTED; "MACHIN",MACHIN; "MACHIN_EULER",MACHIN_EULER; "MACHIN_GAUSS",MACHIN_GAUSS; "MANHATTAN",MANHATTAN; "MAP",MAP; "MAP2",MAP2; "MAP2_DEF",MAP2_DEF; "MAPPING_CONNECTED_ONTO_SEGMENT",MAPPING_CONNECTED_ONTO_SEGMENT; "MAPROWS_COMPOSE",MAPROWS_COMPOSE; "MAP_APPEND",MAP_APPEND; "MAP_EQ",MAP_EQ; "MAP_EQ_ALL2",MAP_EQ_ALL2; "MAP_EQ_DEGEN",MAP_EQ_DEGEN; "MAP_EQ_NIL",MAP_EQ_NIL; "MAP_FST_ZIP",MAP_FST_ZIP; "MAP_I",MAP_I; "MAP_ID",MAP_ID; "MAP_REVERSE",MAP_REVERSE; "MAP_SND_ZIP",MAP_SND_ZIP; "MAP_o",MAP_o; "MATCH_SEQPATTERN",MATCH_SEQPATTERN; "MATRIX_0",MATRIX_0; "MATRIX_ADD",MATRIX_ADD; "MATRIX_ADD_AC",MATRIX_ADD_AC; "MATRIX_ADD_ASSOC",MATRIX_ADD_ASSOC; "MATRIX_ADD_COMPONENT",MATRIX_ADD_COMPONENT; "MATRIX_ADD_LDISTRIB",MATRIX_ADD_LDISTRIB; "MATRIX_ADD_LID",MATRIX_ADD_LID; "MATRIX_ADD_LNEG",MATRIX_ADD_LNEG; "MATRIX_ADD_RDISTRIB",MATRIX_ADD_RDISTRIB; "MATRIX_ADD_RID",MATRIX_ADD_RID; "MATRIX_ADD_RNEG",MATRIX_ADD_RNEG; "MATRIX_ADD_SYM",MATRIX_ADD_SYM; "MATRIX_ADJOINT",MATRIX_ADJOINT; "MATRIX_AUGMENTED_LINEAR_EQUATIONS",MATRIX_AUGMENTED_LINEAR_EQUATIONS; "MATRIX_CMUL",MATRIX_CMUL; "MATRIX_CMUL_ADD_LDISTRIB",MATRIX_CMUL_ADD_LDISTRIB; "MATRIX_CMUL_ADD_RDISTRIB",MATRIX_CMUL_ADD_RDISTRIB; "MATRIX_CMUL_ASSOC",MATRIX_CMUL_ASSOC; "MATRIX_CMUL_COMPONENT",MATRIX_CMUL_COMPONENT; "MATRIX_CMUL_EQ_0",MATRIX_CMUL_EQ_0; "MATRIX_CMUL_LID",MATRIX_CMUL_LID; "MATRIX_CMUL_LZERO",MATRIX_CMUL_LZERO; "MATRIX_CMUL_RZERO",MATRIX_CMUL_RZERO; "MATRIX_CMUL_SUB_LDISTRIB",MATRIX_CMUL_SUB_LDISTRIB; "MATRIX_CMUL_SUB_RDISTRIB",MATRIX_CMUL_SUB_RDISTRIB; "MATRIX_COMPONENT",MATRIX_COMPONENT; "MATRIX_COMPONENT_LE_ONORM",MATRIX_COMPONENT_LE_ONORM; "MATRIX_COMPOSE",MATRIX_COMPOSE; "MATRIX_DIAGONALIZABLE",MATRIX_DIAGONALIZABLE; "MATRIX_ENTIRE",MATRIX_ENTIRE; "MATRIX_EQ",MATRIX_EQ; "MATRIX_EQUAL_COLUMNS",MATRIX_EQUAL_COLUMNS; "MATRIX_EQUAL_ROWS",MATRIX_EQUAL_ROWS; "MATRIX_EQ_0",MATRIX_EQ_0; "MATRIX_FULL_LINEAR_EQUATIONS",MATRIX_FULL_LINEAR_EQUATIONS; "MATRIX_I",MATRIX_I; "MATRIX_ID",MATRIX_ID; "MATRIX_INJECTIVE_0",MATRIX_INJECTIVE_0; "MATRIX_INV",MATRIX_INV; "MATRIX_INVERTIBLE",MATRIX_INVERTIBLE; "MATRIX_INVERTIBLE_LEFT",MATRIX_INVERTIBLE_LEFT; "MATRIX_INVERTIBLE_LEFT_GEN",MATRIX_INVERTIBLE_LEFT_GEN; "MATRIX_INVERTIBLE_RIGHT",MATRIX_INVERTIBLE_RIGHT; "MATRIX_INVERTIBLE_RIGHT_GEN",MATRIX_INVERTIBLE_RIGHT_GEN; "MATRIX_INV_0",MATRIX_INV_0; "MATRIX_INV_CMUL",MATRIX_INV_CMUL; "MATRIX_INV_COFACTOR",MATRIX_INV_COFACTOR; "MATRIX_INV_COVARIANCE",MATRIX_INV_COVARIANCE; "MATRIX_INV_COVARIANCE_LMUL",MATRIX_INV_COVARIANCE_LMUL; "MATRIX_INV_COVARIANCE_RMUL",MATRIX_INV_COVARIANCE_RMUL; "MATRIX_INV_EQ",MATRIX_INV_EQ; "MATRIX_INV_EQ_0",MATRIX_INV_EQ_0; "MATRIX_INV_I",MATRIX_INV_I; "MATRIX_INV_IDEMPOTENT",MATRIX_INV_IDEMPOTENT; "MATRIX_INV_INV",MATRIX_INV_INV; "MATRIX_INV_LEFT",MATRIX_INV_LEFT; "MATRIX_INV_MUL",MATRIX_INV_MUL; "MATRIX_INV_MULTIPLE_TRANP_LEFT",MATRIX_INV_MULTIPLE_TRANP_LEFT; "MATRIX_INV_MULTIPLE_TRANP_RIGHT",MATRIX_INV_MULTIPLE_TRANP_RIGHT; "MATRIX_INV_MUL_INNER",MATRIX_INV_MUL_INNER; "MATRIX_INV_MUL_LINV",MATRIX_INV_MUL_LINV; "MATRIX_INV_MUL_OUTER",MATRIX_INV_MUL_OUTER; "MATRIX_INV_MUL_RINV",MATRIX_INV_MUL_RINV; "MATRIX_INV_ORTHOGONAL_LMUL",MATRIX_INV_ORTHOGONAL_LMUL; "MATRIX_INV_ORTHOGONAL_RMUL",MATRIX_INV_ORTHOGONAL_RMUL; "MATRIX_INV_PROJECTION_IMAGE",MATRIX_INV_PROJECTION_IMAGE; "MATRIX_INV_PROJECTION_IMAGE_ALT",MATRIX_INV_PROJECTION_IMAGE_ALT; "MATRIX_INV_RIGHT",MATRIX_INV_RIGHT; "MATRIX_INV_TRANSP",MATRIX_INV_TRANSP; "MATRIX_INV_UNIQUE",MATRIX_INV_UNIQUE; "MATRIX_INV_UNIQUE_LEFT",MATRIX_INV_UNIQUE_LEFT; "MATRIX_INV_UNIQUE_RIGHT",MATRIX_INV_UNIQUE_RIGHT; "MATRIX_INV_UNIQUE_STRONG",MATRIX_INV_UNIQUE_STRONG; "MATRIX_LEFT_INVERSE_COFACTOR",MATRIX_LEFT_INVERSE_COFACTOR; "MATRIX_LEFT_INVERTIBLE",MATRIX_LEFT_INVERTIBLE; "MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS",MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS; "MATRIX_LEFT_INVERTIBLE_INJECTIVE",MATRIX_LEFT_INVERTIBLE_INJECTIVE; "MATRIX_LEFT_INVERTIBLE_KER",MATRIX_LEFT_INVERTIBLE_KER; "MATRIX_LEFT_INVERTIBLE_NULLSPACE",MATRIX_LEFT_INVERTIBLE_NULLSPACE; "MATRIX_LEFT_INVERTIBLE_SPAN_ROWS",MATRIX_LEFT_INVERTIBLE_SPAN_ROWS; "MATRIX_LEFT_RIGHT_INVERSE",MATRIX_LEFT_RIGHT_INVERSE; "MATRIX_MUL_ASSOC",MATRIX_MUL_ASSOC; "MATRIX_MUL_COMPONENT",MATRIX_MUL_COMPONENT; "MATRIX_MUL_COVARIANCE_LCANCEL",MATRIX_MUL_COVARIANCE_LCANCEL; "MATRIX_MUL_COVARIANCE_RCANCEL",MATRIX_MUL_COVARIANCE_RCANCEL; "MATRIX_MUL_DIAGONAL",MATRIX_MUL_DIAGONAL; "MATRIX_MUL_DOT",MATRIX_MUL_DOT; "MATRIX_MUL_INV_EQ_0",MATRIX_MUL_INV_EQ_0; "MATRIX_MUL_LCANCEL",MATRIX_MUL_LCANCEL; "MATRIX_MUL_LEFT_COFACTOR",MATRIX_MUL_LEFT_COFACTOR; "MATRIX_MUL_LID",MATRIX_MUL_LID; "MATRIX_MUL_LINV",MATRIX_MUL_LINV; "MATRIX_MUL_LMUL",MATRIX_MUL_LMUL; "MATRIX_MUL_LNEG",MATRIX_MUL_LNEG; "MATRIX_MUL_LTRANSP_DOT_COLUMN",MATRIX_MUL_LTRANSP_DOT_COLUMN; "MATRIX_MUL_LZERO",MATRIX_MUL_LZERO; "MATRIX_MUL_RCANCEL",MATRIX_MUL_RCANCEL; "MATRIX_MUL_RID",MATRIX_MUL_RID; "MATRIX_MUL_RIGHT_COFACTOR",MATRIX_MUL_RIGHT_COFACTOR; "MATRIX_MUL_RINV",MATRIX_MUL_RINV; "MATRIX_MUL_RMUL",MATRIX_MUL_RMUL; "MATRIX_MUL_RNEG",MATRIX_MUL_RNEG; "MATRIX_MUL_RTRANSP_DOT_ROW",MATRIX_MUL_RTRANSP_DOT_ROW; "MATRIX_MUL_RZERO",MATRIX_MUL_RZERO; "MATRIX_MUL_VSUM",MATRIX_MUL_VSUM; "MATRIX_MUL_VSUM_ALT",MATRIX_MUL_VSUM_ALT; "MATRIX_NEG",MATRIX_NEG; "MATRIX_NEG_0",MATRIX_NEG_0; "MATRIX_NEG_ADD",MATRIX_NEG_ADD; "MATRIX_NEG_COMPONENT",MATRIX_NEG_COMPONENT; "MATRIX_NEG_EQ_0",MATRIX_NEG_EQ_0; "MATRIX_NEG_MINUS1",MATRIX_NEG_MINUS1; "MATRIX_NEG_NEG",MATRIX_NEG_NEG; "MATRIX_NEG_SUB",MATRIX_NEG_SUB; "MATRIX_NONFULL_LINEAR_EQUATIONS",MATRIX_NONFULL_LINEAR_EQUATIONS; "MATRIX_NONFULL_LINEAR_EQUATIONS_EQ",MATRIX_NONFULL_LINEAR_EQUATIONS_EQ; "MATRIX_OF_MATRIX_VECTOR_MUL",MATRIX_OF_MATRIX_VECTOR_MUL; "MATRIX_RATIONAL_APPROXIMATION",MATRIX_RATIONAL_APPROXIMATION; "MATRIX_REFLECT_ALONG_BASIS",MATRIX_REFLECT_ALONG_BASIS; "MATRIX_RIGHT_INVERSE_COFACTOR",MATRIX_RIGHT_INVERSE_COFACTOR; "MATRIX_RIGHT_INVERTIBLE",MATRIX_RIGHT_INVERTIBLE; "MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS",MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS; "MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS",MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS; "MATRIX_RIGHT_INVERTIBLE_SURJECTIVE",MATRIX_RIGHT_INVERTIBLE_SURJECTIVE; "MATRIX_ROTATE2D",MATRIX_ROTATE2D; "MATRIX_SELF_ADJOINT",MATRIX_SELF_ADJOINT; "MATRIX_SUB",MATRIX_SUB; "MATRIX_SUB_ADD",MATRIX_SUB_ADD; "MATRIX_SUB_ADD2",MATRIX_SUB_ADD2; "MATRIX_SUB_COMPONENT",MATRIX_SUB_COMPONENT; "MATRIX_SUB_EQ",MATRIX_SUB_EQ; "MATRIX_SUB_LDISTRIB",MATRIX_SUB_LDISTRIB; "MATRIX_SUB_LZERO",MATRIX_SUB_LZERO; "MATRIX_SUB_RDISTRIB",MATRIX_SUB_RDISTRIB; "MATRIX_SUB_REFL",MATRIX_SUB_REFL; "MATRIX_SUB_RZERO",MATRIX_SUB_RZERO; "MATRIX_TRANSP_MUL",MATRIX_TRANSP_MUL; "MATRIX_TRANSP_MULTIPLE_INV_LEFT",MATRIX_TRANSP_MULTIPLE_INV_LEFT; "MATRIX_TRANSP_MULTIPLE_INV_RIGHT",MATRIX_TRANSP_MULTIPLE_INV_RIGHT; "MATRIX_TRIVIAL_LINEAR_EQUATIONS",MATRIX_TRIVIAL_LINEAR_EQUATIONS; "MATRIX_VECTOR_COLUMN",MATRIX_VECTOR_COLUMN; "MATRIX_VECTOR_LMUL",MATRIX_VECTOR_LMUL; "MATRIX_VECTOR_MUL",MATRIX_VECTOR_MUL; "MATRIX_VECTOR_MUL_ADD_LDISTRIB",MATRIX_VECTOR_MUL_ADD_LDISTRIB; "MATRIX_VECTOR_MUL_ADD_RDISTRIB",MATRIX_VECTOR_MUL_ADD_RDISTRIB; "MATRIX_VECTOR_MUL_ASSOC",MATRIX_VECTOR_MUL_ASSOC; "MATRIX_VECTOR_MUL_BASIS",MATRIX_VECTOR_MUL_BASIS; "MATRIX_VECTOR_MUL_COMPONENT",MATRIX_VECTOR_MUL_COMPONENT; "MATRIX_VECTOR_MUL_COVARIANCE_EQ_0",MATRIX_VECTOR_MUL_COVARIANCE_EQ_0; "MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE",MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE; "MATRIX_VECTOR_MUL_INV_EQ_0",MATRIX_VECTOR_MUL_INV_EQ_0; "MATRIX_VECTOR_MUL_IN_COLUMNSPACE",MATRIX_VECTOR_MUL_IN_COLUMNSPACE; "MATRIX_VECTOR_MUL_LID",MATRIX_VECTOR_MUL_LID; "MATRIX_VECTOR_MUL_LINEAR",MATRIX_VECTOR_MUL_LINEAR; "MATRIX_VECTOR_MUL_LNEG",MATRIX_VECTOR_MUL_LNEG; "MATRIX_VECTOR_MUL_LZERO",MATRIX_VECTOR_MUL_LZERO; "MATRIX_VECTOR_MUL_RMUL",MATRIX_VECTOR_MUL_RMUL; "MATRIX_VECTOR_MUL_RNEG",MATRIX_VECTOR_MUL_RNEG; "MATRIX_VECTOR_MUL_RZERO",MATRIX_VECTOR_MUL_RZERO; "MATRIX_VECTOR_MUL_SUB_LDISTRIB",MATRIX_VECTOR_MUL_SUB_LDISTRIB; "MATRIX_VECTOR_MUL_SUB_RDISTRIB",MATRIX_VECTOR_MUL_SUB_RDISTRIB; "MATRIX_VECTOR_MUL_TRANSP",MATRIX_VECTOR_MUL_TRANSP; "MATRIX_WLOG_INVERTIBLE",MATRIX_WLOG_INVERTIBLE; "MATRIX_WORKS",MATRIX_WORKS; "MAT_0_COMPONENT",MAT_0_COMPONENT; "MAT_CMUL",MAT_CMUL; "MAT_COMPONENT",MAT_COMPONENT; "MAT_EQ",MAT_EQ; "MAX",MAX; "MAXIMAL_AFFINE_INDEPENDENT_SUBSET",MAXIMAL_AFFINE_INDEPENDENT_SUBSET; "MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE",MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE; "MAXIMAL_INDEPENDENT_SUBSET",MAXIMAL_INDEPENDENT_SUBSET; "MAXIMAL_INDEPENDENT_SUBSET_EXTEND",MAXIMAL_INDEPENDENT_SUBSET_EXTEND; "MAXIMUM_MODULUS_BOUNDED_FUNCTION",MAXIMUM_MODULUS_BOUNDED_FUNCTION; "MAXIMUM_MODULUS_FRONTIER",MAXIMUM_MODULUS_FRONTIER; "MAXIMUM_MODULUS_LIMIT_ATINFINITY",MAXIMUM_MODULUS_LIMIT_ATINFINITY; "MAXIMUM_MODULUS_PRINCIPLE",MAXIMUM_MODULUS_PRINCIPLE; "MAXIMUM_REAL_FRONTIER",MAXIMUM_REAL_FRONTIER; "MBALL_EMPTY",MBALL_EMPTY; "MBALL_EMPTY_ALT",MBALL_EMPTY_ALT; "MBALL_EQ_EMPTY",MBALL_EQ_EMPTY; "MBALL_EUCLIDEAN",MBALL_EUCLIDEAN; "MBALL_SUBMETRIC",MBALL_SUBMETRIC; "MBALL_SUBSET",MBALL_SUBSET; "MBALL_SUBSET_CONCENTRIC",MBALL_SUBSET_CONCENTRIC; "MBALL_SUBSET_MCBALL",MBALL_SUBSET_MCBALL; "MBALL_SUBSET_MSPACE",MBALL_SUBSET_MSPACE; "MBASIS_COMPONENT",MBASIS_COMPONENT; "MBASIS_EQ_0",MBASIS_EQ_0; "MBASIS_EXPANSION",MBASIS_EXPANSION; "MBASIS_EXTENSION",MBASIS_EXTENSION; "MBASIS_NONZERO",MBASIS_NONZERO; "MBASIS_SPLIT",MBASIS_SPLIT; "MBOUNDED",MBOUNDED; "MBOUNDED_EMPTY",MBOUNDED_EMPTY; "MBOUNDED_EQ_BOUNDED",MBOUNDED_EQ_BOUNDED; "MBOUNDED_IFF_FINITE_DIAMETER",MBOUNDED_IFF_FINITE_DIAMETER; "MBOUNDED_INSERT",MBOUNDED_INSERT; "MBOUNDED_INTER",MBOUNDED_INTER; "MBOUNDED_MBALL",MBOUNDED_MBALL; "MBOUNDED_MCBALL",MBOUNDED_MCBALL; "MBOUNDED_SUBMETRIC",MBOUNDED_SUBMETRIC; "MBOUNDED_SUBSET",MBOUNDED_SUBSET; "MBOUNDED_SUBSET_MSPACE",MBOUNDED_SUBSET_MSPACE; "MBOUNDED_UNION",MBOUNDED_UNION; "MCBALL_EMPTY",MCBALL_EMPTY; "MCBALL_EMPTY_ALT",MCBALL_EMPTY_ALT; "MCBALL_EUCLIDEAN",MCBALL_EUCLIDEAN; "MCBALL_SUBMETRIC",MCBALL_SUBMETRIC; "MCBALL_SUBSET",MCBALL_SUBSET; "MCBALL_SUBSET_CONCENTRIC",MCBALL_SUBSET_CONCENTRIC; "MCBALL_SUBSET_MBALL",MCBALL_SUBSET_MBALL; "MCBALL_SUBSET_MBALL_CONCENTRIC",MCBALL_SUBSET_MBALL_CONCENTRIC; "MCBALL_SUBSET_MSPACE",MCBALL_SUBSET_MSPACE; "MCOMPLETE_CFUNSPACE",MCOMPLETE_CFUNSPACE; "MCOMPLETE_EUCLIDEAN",MCOMPLETE_EUCLIDEAN; "MCOMPLETE_FUNSPACE",MCOMPLETE_FUNSPACE; "MDIST",MDIST; "MDIST_0",MDIST_0; "MDIST_CFUNSPACE_EQ_MDIST_FUNSPACE",MDIST_CFUNSPACE_EQ_MDIST_FUNSPACE; "MDIST_CFUNSPACE_IMP_MDIST_LE",MDIST_CFUNSPACE_IMP_MDIST_LE; "MDIST_CFUNSPACE_LE",MDIST_CFUNSPACE_LE; "MDIST_POS_LE",MDIST_POS_LE; "MDIST_POS_LT",MDIST_POS_LT; "MDIST_REFL",MDIST_REFL; "MDIST_REVERSE_TRIANGLE",MDIST_REVERSE_TRIANGLE; "MDIST_SYM",MDIST_SYM; "MDIST_TRIANGLE",MDIST_TRIANGLE; "MEASURABLE",MEASURABLE; "MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE",MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE; "MEASURABLE_ADDITIVE_IMP_LINEAR",MEASURABLE_ADDITIVE_IMP_LINEAR; "MEASURABLE_AFFINITY",MEASURABLE_AFFINITY; "MEASURABLE_AFFINITY_EQ",MEASURABLE_AFFINITY_EQ; "MEASURABLE_ALMOST",MEASURABLE_ALMOST; "MEASURABLE_BALL",MEASURABLE_BALL; "MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE; "MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; "MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE; "MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE; "MEASURABLE_BOUNDED_DIFFERENTIABLE_IMAGE",MEASURABLE_BOUNDED_DIFFERENTIABLE_IMAGE; "MEASURABLE_CBALL",MEASURABLE_CBALL; "MEASURABLE_CLOSED_IN",MEASURABLE_CLOSED_IN; "MEASURABLE_CLOSURE",MEASURABLE_CLOSURE; "MEASURABLE_COMPACT",MEASURABLE_COMPACT; "MEASURABLE_CONTINUOUS_COMPOSE",MEASURABLE_CONTINUOUS_COMPOSE; "MEASURABLE_CONVEX",MEASURABLE_CONVEX; "MEASURABLE_CONVEX_EQ",MEASURABLE_CONVEX_EQ; "MEASURABLE_CONVEX_HULL",MEASURABLE_CONVEX_HULL; "MEASURABLE_COUNTABLE_INTERS",MEASURABLE_COUNTABLE_INTERS; "MEASURABLE_COUNTABLE_INTERS_GEN",MEASURABLE_COUNTABLE_INTERS_GEN; "MEASURABLE_COUNTABLE_UNIONS",MEASURABLE_COUNTABLE_UNIONS; "MEASURABLE_COUNTABLE_UNIONS_BOUNDED",MEASURABLE_COUNTABLE_UNIONS_BOUNDED; "MEASURABLE_COUNTABLE_UNIONS_STRONG",MEASURABLE_COUNTABLE_UNIONS_STRONG; "MEASURABLE_DELETE",MEASURABLE_DELETE; "MEASURABLE_DIFF",MEASURABLE_DIFF; "MEASURABLE_DIFFERENTIABLE_IMAGE",MEASURABLE_DIFFERENTIABLE_IMAGE; "MEASURABLE_DIFFERENTIABLE_IMAGE_ALT",MEASURABLE_DIFFERENTIABLE_IMAGE_ALT; "MEASURABLE_DIFFERENTIABLE_IMAGE_EQ",MEASURABLE_DIFFERENTIABLE_IMAGE_EQ; "MEASURABLE_ELEMENTARY",MEASURABLE_ELEMENTARY; "MEASURABLE_EMPTY",MEASURABLE_EMPTY; "MEASURABLE_FRONTIER",MEASURABLE_FRONTIER; "MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE",MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE; "MEASURABLE_IMP_LEBESGUE_MEASURABLE",MEASURABLE_IMP_LEBESGUE_MEASURABLE; "MEASURABLE_INNER_COMPACT",MEASURABLE_INNER_COMPACT; "MEASURABLE_INNER_OUTER",MEASURABLE_INNER_OUTER; "MEASURABLE_INSERT",MEASURABLE_INSERT; "MEASURABLE_INSIDE",MEASURABLE_INSIDE; "MEASURABLE_INTEGRABLE",MEASURABLE_INTEGRABLE; "MEASURABLE_INTER",MEASURABLE_INTER; "MEASURABLE_INTERIOR",MEASURABLE_INTERIOR; "MEASURABLE_INTERVAL",MEASURABLE_INTERVAL; "MEASURABLE_INTER_HALFSPACE_GE",MEASURABLE_INTER_HALFSPACE_GE; "MEASURABLE_INTER_HALFSPACE_LE",MEASURABLE_INTER_HALFSPACE_LE; "MEASURABLE_INTER_INTERVAL",MEASURABLE_INTER_INTERVAL; "MEASURABLE_JORDAN",MEASURABLE_JORDAN; "MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE",MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; "MEASURABLE_LEBESGUE_MEASURABLE_SUBSET",MEASURABLE_LEBESGUE_MEASURABLE_SUBSET; "MEASURABLE_LINEAR_IMAGE",MEASURABLE_LINEAR_IMAGE; "MEASURABLE_LINEAR_IMAGE_EQ",MEASURABLE_LINEAR_IMAGE_EQ; "MEASURABLE_LINEAR_IMAGE_EQ_GEN",MEASURABLE_LINEAR_IMAGE_EQ_GEN; "MEASURABLE_LINEAR_IMAGE_GEN",MEASURABLE_LINEAR_IMAGE_GEN; "MEASURABLE_LINEAR_IMAGE_INTERVAL",MEASURABLE_LINEAR_IMAGE_INTERVAL; "MEASURABLE_LIPSCHITZ_IMAGE",MEASURABLE_LIPSCHITZ_IMAGE; "MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE",MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE; "MEASURABLE_MEASURABLE_DIFF_LEBESGUE_MEASURABLE",MEASURABLE_MEASURABLE_DIFF_LEBESGUE_MEASURABLE; "MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE",MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; "MEASURABLE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_MEASURABLE_PREIMAGE_CLOSED; "MEASURABLE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_MEASURABLE_PREIMAGE_OPEN; "MEASURABLE_MEASURE_EQ_0",MEASURABLE_MEASURE_EQ_0; "MEASURABLE_MEASURE_POS_LT",MEASURABLE_MEASURE_POS_LT; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONTINUOUS",MEASURABLE_MIDPOINT_CONVEX_IMP_CONTINUOUS; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_1D",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_1D; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_CBALL",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_CBALL; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_OPEN",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_OPEN; "MEASURABLE_NEGLIGIBLE_SYMDIFF",MEASURABLE_NEGLIGIBLE_SYMDIFF; "MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ",MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ; "MEASURABLE_NESTED_UNIONS",MEASURABLE_NESTED_UNIONS; "MEASURABLE_NONNEGLIGIBLE_IMP_LARGE",MEASURABLE_NONNEGLIGIBLE_IMP_LARGE; "MEASURABLE_ON_0",MEASURABLE_ON_0; "MEASURABLE_ON_ADD",MEASURABLE_ON_ADD; "MEASURABLE_ON_BANACH_INDICATRIX",MEASURABLE_ON_BANACH_INDICATRIX; "MEASURABLE_ON_BILINEAR",MEASURABLE_ON_BILINEAR; "MEASURABLE_ON_CASES",MEASURABLE_ON_CASES; "MEASURABLE_ON_CMUL",MEASURABLE_ON_CMUL; "MEASURABLE_ON_CMUL_EQ",MEASURABLE_ON_CMUL_EQ; "MEASURABLE_ON_COMBINE",MEASURABLE_ON_COMBINE; "MEASURABLE_ON_COMPLEX_DIV",MEASURABLE_ON_COMPLEX_DIV; "MEASURABLE_ON_COMPLEX_INV",MEASURABLE_ON_COMPLEX_INV; "MEASURABLE_ON_COMPLEX_MUL",MEASURABLE_ON_COMPLEX_MUL; "MEASURABLE_ON_COMPONENTWISE",MEASURABLE_ON_COMPONENTWISE; "MEASURABLE_ON_COMPOSE_ALT",MEASURABLE_ON_COMPOSE_ALT; "MEASURABLE_ON_COMPOSE_CONTINUOUS",MEASURABLE_ON_COMPOSE_CONTINUOUS; "MEASURABLE_ON_COMPOSE_CONTINUOUS_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_0; "MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET; "MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0; "MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL",MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL; "MEASURABLE_ON_COMPOSE_FSTCART",MEASURABLE_ON_COMPOSE_FSTCART; "MEASURABLE_ON_COMPOSE_GEN",MEASURABLE_ON_COMPOSE_GEN; "MEASURABLE_ON_COMPOSE_REV",MEASURABLE_ON_COMPOSE_REV; "MEASURABLE_ON_COMPOSE_SNDCART",MEASURABLE_ON_COMPOSE_SNDCART; "MEASURABLE_ON_COMPOSE_SUB",MEASURABLE_ON_COMPOSE_SUB; "MEASURABLE_ON_CONST",MEASURABLE_ON_CONST; "MEASURABLE_ON_CONST_EQ",MEASURABLE_ON_CONST_EQ; "MEASURABLE_ON_CONTINUOUS_COMPOSE",MEASURABLE_ON_CONTINUOUS_COMPOSE; "MEASURABLE_ON_CONTINUOUS_COMPOSE_REV",MEASURABLE_ON_CONTINUOUS_COMPOSE_REV; "MEASURABLE_ON_CONVOLUTION",MEASURABLE_ON_CONVOLUTION; "MEASURABLE_ON_COUNTABLE_UNIONS",MEASURABLE_ON_COUNTABLE_UNIONS; "MEASURABLE_ON_CPRODUCT",MEASURABLE_ON_CPRODUCT; "MEASURABLE_ON_DET_JACOBIAN",MEASURABLE_ON_DET_JACOBIAN; "MEASURABLE_ON_DIFF",MEASURABLE_ON_DIFF; "MEASURABLE_ON_DIFFERENTIABLE_IMAGE",MEASURABLE_ON_DIFFERENTIABLE_IMAGE; "MEASURABLE_ON_DROP_MUL",MEASURABLE_ON_DROP_MUL; "MEASURABLE_ON_EMPTY",MEASURABLE_ON_EMPTY; "MEASURABLE_ON_EQ",MEASURABLE_ON_EQ; "MEASURABLE_ON_INDICATOR",MEASURABLE_ON_INDICATOR; "MEASURABLE_ON_INDICATOR_SUBSET",MEASURABLE_ON_INDICATOR_SUBSET; "MEASURABLE_ON_INTER",MEASURABLE_ON_INTER; "MEASURABLE_ON_INVERSE_FUNCTION",MEASURABLE_ON_INVERSE_FUNCTION; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL; "MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "MEASURABLE_ON_LEFT_INVERSE",MEASURABLE_ON_LEFT_INVERSE; "MEASURABLE_ON_LIFT_ABS",MEASURABLE_ON_LIFT_ABS; "MEASURABLE_ON_LIFT_DIV",MEASURABLE_ON_LIFT_DIV; "MEASURABLE_ON_LIFT_INV",MEASURABLE_ON_LIFT_INV; "MEASURABLE_ON_LIFT_MUL",MEASURABLE_ON_LIFT_MUL; "MEASURABLE_ON_LIFT_PRODUCT",MEASURABLE_ON_LIFT_PRODUCT; "MEASURABLE_ON_LIFT_RPOW",MEASURABLE_ON_LIFT_RPOW; "MEASURABLE_ON_LIMIT",MEASURABLE_ON_LIMIT; "MEASURABLE_ON_LINEAR_IMAGE_EQ",MEASURABLE_ON_LINEAR_IMAGE_EQ; "MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN",MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN; "MEASURABLE_ON_MAX",MEASURABLE_ON_MAX; "MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED; "MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ; "MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; "MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN; "MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ; "MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL; "MEASURABLE_ON_MEASURABLE_SUBSET",MEASURABLE_ON_MEASURABLE_SUBSET; "MEASURABLE_ON_MIN",MEASURABLE_ON_MIN; "MEASURABLE_ON_MUL",MEASURABLE_ON_MUL; "MEASURABLE_ON_NEG",MEASURABLE_ON_NEG; "MEASURABLE_ON_NEG_EQ",MEASURABLE_ON_NEG_EQ; "MEASURABLE_ON_NORM",MEASURABLE_ON_NORM; "MEASURABLE_ON_PARTIAL_DERIVATIVES",MEASURABLE_ON_PARTIAL_DERIVATIVES; "MEASURABLE_ON_PASTECART",MEASURABLE_ON_PASTECART; "MEASURABLE_ON_PREIMAGE_ANALYTIC",MEASURABLE_ON_PREIMAGE_ANALYTIC; "MEASURABLE_ON_PREIMAGE_BOREL",MEASURABLE_ON_PREIMAGE_BOREL; "MEASURABLE_ON_PREIMAGE_CLOSED",MEASURABLE_ON_PREIMAGE_CLOSED; "MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; "MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE; "MEASURABLE_ON_PREIMAGE_OPEN",MEASURABLE_ON_PREIMAGE_OPEN; "MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; "MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_GE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE; "MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_GT",MEASURABLE_ON_PREIMAGE_ORTHANT_GT; "MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_LE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE; "MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_LT",MEASURABLE_ON_PREIMAGE_ORTHANT_LT; "MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE; "MEASURABLE_ON_REAL_SGN",MEASURABLE_ON_REAL_SGN; "MEASURABLE_ON_REFLECT",MEASURABLE_ON_REFLECT; "MEASURABLE_ON_RESTRICT",MEASURABLE_ON_RESTRICT; "MEASURABLE_ON_RIGHT_INVERSE",MEASURABLE_ON_RIGHT_INVERSE; "MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT; "MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING; "MEASURABLE_ON_SPIKE",MEASURABLE_ON_SPIKE; "MEASURABLE_ON_SPIKE_SET",MEASURABLE_ON_SPIKE_SET; "MEASURABLE_ON_SUB",MEASURABLE_ON_SUB; "MEASURABLE_ON_TRANSLATION",MEASURABLE_ON_TRANSLATION; "MEASURABLE_ON_TRANSLATION_EQ",MEASURABLE_ON_TRANSLATION_EQ; "MEASURABLE_ON_UNION",MEASURABLE_ON_UNION; "MEASURABLE_ON_UNIONS",MEASURABLE_ON_UNIONS; "MEASURABLE_ON_UNIV",MEASURABLE_ON_UNIV; "MEASURABLE_ON_VECTOR_DERIVATIVE",MEASURABLE_ON_VECTOR_DERIVATIVE; "MEASURABLE_ON_VECTOR_DERIVATIVE_GEN",MEASURABLE_ON_VECTOR_DERIVATIVE_GEN; "MEASURABLE_ON_VSUM",MEASURABLE_ON_VSUM; "MEASURABLE_OPEN",MEASURABLE_OPEN; "MEASURABLE_OPEN_IN",MEASURABLE_OPEN_IN; "MEASURABLE_OUTER_CLOSED_INTERVALS",MEASURABLE_OUTER_CLOSED_INTERVALS; "MEASURABLE_OUTER_INTERVALS_BOUNDED",MEASURABLE_OUTER_INTERVALS_BOUNDED; "MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL",MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL; "MEASURABLE_OUTER_OPEN",MEASURABLE_OUTER_OPEN; "MEASURABLE_OUTER_OPEN_INTERVALS",MEASURABLE_OUTER_OPEN_INTERVALS; "MEASURABLE_PCROSS",MEASURABLE_PCROSS; "MEASURABLE_SCALING",MEASURABLE_SCALING; "MEASURABLE_SCALING_EQ",MEASURABLE_SCALING_EQ; "MEASURABLE_SEGMENT",MEASURABLE_SEGMENT; "MEASURABLE_SIMPLEX",MEASURABLE_SIMPLEX; "MEASURABLE_SING",MEASURABLE_SING; "MEASURABLE_SMALL_IMP_NEGLIGIBLE",MEASURABLE_SMALL_IMP_NEGLIGIBLE; "MEASURABLE_TETRAHEDRON",MEASURABLE_TETRAHEDRON; "MEASURABLE_TRANSLATION",MEASURABLE_TRANSLATION; "MEASURABLE_TRANSLATION_EQ",MEASURABLE_TRANSLATION_EQ; "MEASURABLE_TRIANGLE",MEASURABLE_TRIANGLE; "MEASURABLE_UNION",MEASURABLE_UNION; "MEASURABLE_UNIONS",MEASURABLE_UNIONS; "MEASURE",MEASURE; "MEASURE_AFFINITY",MEASURE_AFFINITY; "MEASURE_BALL_BOUND",MEASURE_BALL_BOUND; "MEASURE_BALL_POS",MEASURE_BALL_POS; "MEASURE_BALL_SCALING",MEASURE_BALL_SCALING; "MEASURE_BOUNDED_DIFFERENTIABLE_IMAGE",MEASURE_BOUNDED_DIFFERENTIABLE_IMAGE; "MEASURE_CBALL_BOUND",MEASURE_CBALL_BOUND; "MEASURE_CBALL_POS",MEASURE_CBALL_POS; "MEASURE_CBALL_SCALING",MEASURE_CBALL_SCALING; "MEASURE_CLOSURE",MEASURE_CLOSURE; "MEASURE_CONTINUOUS_WITH_HAUSDIST",MEASURE_CONTINUOUS_WITH_HAUSDIST; "MEASURE_CONTINUOUS_WITH_HAUSDIST_EXPLICIT",MEASURE_CONTINUOUS_WITH_HAUSDIST_EXPLICIT; "MEASURE_COUNTABLE_UNIONS_APPROACHABLE",MEASURE_COUNTABLE_UNIONS_APPROACHABLE; "MEASURE_COUNTABLE_UNIONS_LE",MEASURE_COUNTABLE_UNIONS_LE; "MEASURE_COUNTABLE_UNIONS_LE_GEN",MEASURE_COUNTABLE_UNIONS_LE_GEN; "MEASURE_COUNTABLE_UNIONS_LE_STRONG",MEASURE_COUNTABLE_UNIONS_LE_STRONG; "MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN",MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN; "MEASURE_DELETE",MEASURE_DELETE; "MEASURE_DIFFERENTIABLE_IMAGE",MEASURE_DIFFERENTIABLE_IMAGE; "MEASURE_DIFFERENTIABLE_IMAGE_EQ",MEASURE_DIFFERENTIABLE_IMAGE_EQ; "MEASURE_DIFF_SUBSET",MEASURE_DIFF_SUBSET; "MEASURE_DISJOINT_UNION",MEASURE_DISJOINT_UNION; "MEASURE_DISJOINT_UNIONS",MEASURE_DISJOINT_UNIONS; "MEASURE_DISJOINT_UNIONS_IMAGE",MEASURE_DISJOINT_UNIONS_IMAGE; "MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; "MEASURE_DISJOINT_UNION_EQ",MEASURE_DISJOINT_UNION_EQ; "MEASURE_ELEMENTARY",MEASURE_ELEMENTARY; "MEASURE_EMPTY",MEASURE_EMPTY; "MEASURE_EQ_0",MEASURE_EQ_0; "MEASURE_FRONTIER",MEASURE_FRONTIER; "MEASURE_INSERT",MEASURE_INSERT; "MEASURE_INTEGRAL",MEASURE_INTEGRAL; "MEASURE_INTEGRAL_UNIV",MEASURE_INTEGRAL_UNIV; "MEASURE_INTERIOR",MEASURE_INTERIOR; "MEASURE_INTERVAL",MEASURE_INTERVAL; "MEASURE_INTERVAL_1",MEASURE_INTERVAL_1; "MEASURE_INTERVAL_1_ALT",MEASURE_INTERVAL_1_ALT; "MEASURE_INTERVAL_2",MEASURE_INTERVAL_2; "MEASURE_INTERVAL_2_ALT",MEASURE_INTERVAL_2_ALT; "MEASURE_INTERVAL_3",MEASURE_INTERVAL_3; "MEASURE_INTERVAL_3_ALT",MEASURE_INTERVAL_3_ALT; "MEASURE_INTERVAL_4",MEASURE_INTERVAL_4; "MEASURE_INTERVAL_4_ALT",MEASURE_INTERVAL_4_ALT; "MEASURE_ISOMETRY",MEASURE_ISOMETRY; "MEASURE_LE",MEASURE_LE; "MEASURE_LIMIT",MEASURE_LIMIT; "MEASURE_LINEAR_IMAGE",MEASURE_LINEAR_IMAGE; "MEASURE_LINEAR_IMAGE_SAME",MEASURE_LINEAR_IMAGE_SAME; "MEASURE_LIPSCHITZ_IMAGE",MEASURE_LIPSCHITZ_IMAGE; "MEASURE_LOCALLY_LIPSCHITZ_IMAGE",MEASURE_LOCALLY_LIPSCHITZ_IMAGE; "MEASURE_NEGLIGIBLE_SYMDIFF",MEASURE_NEGLIGIBLE_SYMDIFF; "MEASURE_NEGLIGIBLE_UNION",MEASURE_NEGLIGIBLE_UNION; "MEASURE_NEGLIGIBLE_UNIONS",MEASURE_NEGLIGIBLE_UNIONS; "MEASURE_NEGLIGIBLE_UNIONS_IMAGE",MEASURE_NEGLIGIBLE_UNIONS_IMAGE; "MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; "MEASURE_NEGLIGIBLE_UNION_EQ",MEASURE_NEGLIGIBLE_UNION_EQ; "MEASURE_OPEN_POS_LT",MEASURE_OPEN_POS_LT; "MEASURE_OPEN_POS_LT_EQ",MEASURE_OPEN_POS_LT_EQ; "MEASURE_ORTHOGONAL_IMAGE_EQ",MEASURE_ORTHOGONAL_IMAGE_EQ; "MEASURE_PCROSS",MEASURE_PCROSS; "MEASURE_POS_LE",MEASURE_POS_LE; "MEASURE_SCALING",MEASURE_SCALING; "MEASURE_SEGMENT_1",MEASURE_SEGMENT_1; "MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_BOUND",MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_BOUND; "MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_EXPLICIT",MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_EXPLICIT; "MEASURE_SIMPLEX",MEASURE_SIMPLEX; "MEASURE_SING",MEASURE_SING; "MEASURE_SUBSET",MEASURE_SUBSET; "MEASURE_SUB_LE_MEASURE_DIFF",MEASURE_SUB_LE_MEASURE_DIFF; "MEASURE_SUB_LE_MEASURE_SYMDIFF",MEASURE_SUB_LE_MEASURE_SYMDIFF; "MEASURE_TETRAHEDRON",MEASURE_TETRAHEDRON; "MEASURE_TRANSLATION",MEASURE_TRANSLATION; "MEASURE_TRIANGLE",MEASURE_TRIANGLE; "MEASURE_UNION",MEASURE_UNION; "MEASURE_UNIONS_LE",MEASURE_UNIONS_LE; "MEASURE_UNIONS_LE_IMAGE",MEASURE_UNIONS_LE_IMAGE; "MEASURE_UNION_LE",MEASURE_UNION_LE; "MEASURE_UNIQUE",MEASURE_UNIQUE; "MEM",MEM; "MEMBER_NOT_EMPTY",MEMBER_NOT_EMPTY; "MEM_APPEND",MEM_APPEND; "MEM_APPEND_DECOMPOSE",MEM_APPEND_DECOMPOSE; "MEM_APPEND_DECOMPOSE_LEFT",MEM_APPEND_DECOMPOSE_LEFT; "MEM_ASSOC",MEM_ASSOC; "MEM_EL",MEM_EL; "MEM_EXISTS_EL",MEM_EXISTS_EL; "MEM_FILTER",MEM_FILTER; "MEM_LINEAR_IMAGE",MEM_LINEAR_IMAGE; "MEM_LIST_OF_SET",MEM_LIST_OF_SET; "MEM_MAP",MEM_MAP; "MEM_TRANSLATION",MEM_TRANSLATION; "METRIC",METRIC; "METRIC_BAIRE_CATEGORY",METRIC_BAIRE_CATEGORY; "METRIC_CLOSED_IN_IFF_SEQUENTIALLY_CLOSED",METRIC_CLOSED_IN_IFF_SEQUENTIALLY_CLOSED; "METRIC_CLOSURE_OF",METRIC_CLOSURE_OF; "METRIC_DERIVED_SET_OF",METRIC_DERIVED_SET_OF; "METRIC_TOPCONTINUOUS",METRIC_TOPCONTINUOUS; "MIDPOINTS_IN_CONVEX_HULL",MIDPOINTS_IN_CONVEX_HULL; "MIDPOINT_BETWEEN",MIDPOINT_BETWEEN; "MIDPOINT_COLLINEAR",MIDPOINT_COLLINEAR; "MIDPOINT_CONVEX_DYADIC_RATIONALS",MIDPOINT_CONVEX_DYADIC_RATIONALS; "MIDPOINT_CONVEX_IMP_CONTINUOUS_OSTROWSKI",MIDPOINT_CONVEX_IMP_CONTINUOUS_OSTROWSKI; "MIDPOINT_CONVEX_IMP_CONVEX_OSTROWSKI",MIDPOINT_CONVEX_IMP_CONVEX_OSTROWSKI; "MIDPOINT_CONVEX_SET",MIDPOINT_CONVEX_SET; "MIDPOINT_EQ_ENDPOINT",MIDPOINT_EQ_ENDPOINT; "MIDPOINT_IN_CONVEX",MIDPOINT_IN_CONVEX; "MIDPOINT_IN_SEGMENT",MIDPOINT_IN_SEGMENT; "MIDPOINT_LINEAR_IMAGE",MIDPOINT_LINEAR_IMAGE; "MIDPOINT_LOG_CONVEX",MIDPOINT_LOG_CONVEX; "MIDPOINT_REAL_LOG_CONVEX",MIDPOINT_REAL_LOG_CONVEX; "MIDPOINT_REFL",MIDPOINT_REFL; "MIDPOINT_SYM",MIDPOINT_SYM; "MIN",MIN; "MINIMAL",MINIMAL; "MINIMAL_CONTINUUM",MINIMAL_CONTINUUM; "MINIMAL_IN_INSERT",MINIMAL_IN_INSERT; "MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER",MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER; "MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER_ELEMENTWISE",MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER_ELEMENTWISE; "MK_REC_INJ",MK_REC_INJ; "MOD_0",MOD_0; "MOD_1",MOD_1; "MOD_ADD_MOD",MOD_ADD_MOD; "MOD_EQ",MOD_EQ; "MOD_EQ_0",MOD_EQ_0; "MOD_EXISTS",MOD_EXISTS; "MOD_EXP_MOD",MOD_EXP_MOD; "MOD_LE",MOD_LE; "MOD_LT",MOD_LT; "MOD_MOD",MOD_MOD; "MOD_MOD_EXP_MIN",MOD_MOD_EXP_MIN; "MOD_MOD_REFL",MOD_MOD_REFL; "MOD_MULT",MOD_MULT; "MOD_MULT2",MOD_MULT2; "MOD_MULT_ADD",MOD_MULT_ADD; "MOD_MULT_LMOD",MOD_MULT_LMOD; "MOD_MULT_MOD2",MOD_MULT_MOD2; "MOD_MULT_RMOD",MOD_MULT_RMOD; "MOD_NSUM_MOD",MOD_NSUM_MOD; "MOD_NSUM_MOD_NUMSEG",MOD_NSUM_MOD_NUMSEG; "MOD_REFL",MOD_REFL; "MOD_UNIQ",MOD_UNIQ; "MOEBIUS_FUNCTION_COMPOSE",MOEBIUS_FUNCTION_COMPOSE; "MOEBIUS_FUNCTION_EQ_ZERO",MOEBIUS_FUNCTION_EQ_ZERO; "MOEBIUS_FUNCTION_HOLOMORPHIC",MOEBIUS_FUNCTION_HOLOMORPHIC; "MOEBIUS_FUNCTION_NORM_LT_1",MOEBIUS_FUNCTION_NORM_LT_1; "MOEBIUS_FUNCTION_OF_ZERO",MOEBIUS_FUNCTION_OF_ZERO; "MOEBIUS_FUNCTION_SIMPLE",MOEBIUS_FUNCTION_SIMPLE; "MONODROMY_CONTINUOUS_LOG",MONODROMY_CONTINUOUS_LOG; "MONOIDAL_AC",MONOIDAL_AC; "MONOIDAL_ADD",MONOIDAL_ADD; "MONOIDAL_AND",MONOIDAL_AND; "MONOIDAL_COMPLEX_MUL",MONOIDAL_COMPLEX_MUL; "MONOIDAL_LIFTED",MONOIDAL_LIFTED; "MONOIDAL_MUL",MONOIDAL_MUL; "MONOIDAL_REAL_ADD",MONOIDAL_REAL_ADD; "MONOIDAL_REAL_MUL",MONOIDAL_REAL_MUL; "MONOIDAL_VECTOR_ADD",MONOIDAL_VECTOR_ADD; "MONOTONE_BIGGER",MONOTONE_BIGGER; "MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP",MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP; "MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP_GEN",MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP_GEN; "MONOTONE_CONVERGENCE_DECREASING",MONOTONE_CONVERGENCE_DECREASING; "MONOTONE_CONVERGENCE_DECREASING_AE",MONOTONE_CONVERGENCE_DECREASING_AE; "MONOTONE_CONVERGENCE_INCREASING",MONOTONE_CONVERGENCE_INCREASING; "MONOTONE_CONVERGENCE_INCREASING_AE",MONOTONE_CONVERGENCE_INCREASING_AE; "MONOTONE_CONVERGENCE_INTERVAL",MONOTONE_CONVERGENCE_INTERVAL; "MONOTONE_IMP_HOMEOMORPHISM_1D",MONOTONE_IMP_HOMEOMORPHISM_1D; "MONOTONE_INTO_1D_IMP_PROPER_MAP",MONOTONE_INTO_1D_IMP_PROPER_MAP; "MONOTONE_SUBSEQUENCE",MONOTONE_SUBSEQUENCE; "MONOTONE_TOPOLOGICALLY",MONOTONE_TOPOLOGICALLY; "MONOTONE_TOPOLOGICALLY_EQ",MONOTONE_TOPOLOGICALLY_EQ; "MONOTONE_TOPOLOGICALLY_IMP",MONOTONE_TOPOLOGICALLY_IMP; "MONOTONE_TOPOLOGICALLY_INTO_1D",MONOTONE_TOPOLOGICALLY_INTO_1D; "MONOTONE_TOPOLOGICALLY_INTO_1D_EQ",MONOTONE_TOPOLOGICALLY_INTO_1D_EQ; "MONOTONE_TOPOLOGICALLY_POINTS",MONOTONE_TOPOLOGICALLY_POINTS; "MONOTONE_TOPOLOGICALLY_POINTS_IMP",MONOTONE_TOPOLOGICALLY_POINTS_IMP; "MONO_ALL",MONO_ALL; "MONO_ALL2",MONO_ALL2; "MONO_AND",MONO_AND; "MONO_COND",MONO_COND; "MONO_EXISTS",MONO_EXISTS; "MONO_FORALL",MONO_FORALL; "MONO_IMP",MONO_IMP; "MONO_NOT",MONO_NOT; "MONO_OR",MONO_OR; "MONTEL",MONTEL; "MONTEL_OMITTING",MONTEL_OMITTING; "MOORE_PENROSE_PSEUDOINVERSE",MOORE_PENROSE_PSEUDOINVERSE; "MOORE_PENROSE_PSEUDOINVERSE_UNIQUE",MOORE_PENROSE_PSEUDOINVERSE_UNIQUE; "MORERA_LOCAL_TRIANGLE",MORERA_LOCAL_TRIANGLE; "MORERA_LOCAL_TRIANGLE_GEN",MORERA_LOCAL_TRIANGLE_GEN; "MORERA_TRIANGLE",MORERA_TRIANGLE; "MSPACE",MSPACE; "MTOPOLOGY_EUCLIDEAN_METRIC",MTOPOLOGY_EUCLIDEAN_METRIC; "MTOPOLOGY_REAL_EUCLIDEAN_METRIC",MTOPOLOGY_REAL_EUCLIDEAN_METRIC; "MTOPOLOGY_SUBMETRIC",MTOPOLOGY_SUBMETRIC; "MULT",MULT; "MULTIPART_MEASURES",MULTIPART_MEASURES; "MULTIVECTOR_ADD_COMPONENT",MULTIVECTOR_ADD_COMPONENT; "MULTIVECTOR_BETA",MULTIVECTOR_BETA; "MULTIVECTOR_EQ",MULTIVECTOR_EQ; "MULTIVECTOR_ETA",MULTIVECTOR_ETA; "MULTIVECTOR_GRADE",MULTIVECTOR_GRADE; "MULTIVECTOR_IMAGE",MULTIVECTOR_IMAGE; "MULTIVECTOR_MUL_COMPONENT",MULTIVECTOR_MUL_COMPONENT; "MULTIVECTOR_UNIQUE",MULTIVECTOR_UNIQUE; "MULTIVECTOR_VEC_COMPONENT",MULTIVECTOR_VEC_COMPONENT; "MULTIVECTOR_VSUM",MULTIVECTOR_VSUM; "MULTIVECTOR_VSUM_COMPONENT",MULTIVECTOR_VSUM_COMPONENT; "MULT_0",MULT_0; "MULT_2",MULT_2; "MULT_AC",MULT_AC; "MULT_ASSOC",MULT_ASSOC; "MULT_CLAUSES",MULT_CLAUSES; "MULT_DIV_LE",MULT_DIV_LE; "MULT_EQ_0",MULT_EQ_0; "MULT_EQ_1",MULT_EQ_1; "MULT_EXP",MULT_EXP; "MULT_SUC",MULT_SUC; "MULT_SYM",MULT_SYM; "MUL_C_UNIV",MUL_C_UNIV; "MUMFORD_LEMMA",MUMFORD_LEMMA; "MVT",MVT; "MVT_GENERAL",MVT_GENERAL; "MVT_SEGMENT",MVT_SEGMENT; "MVT_SEGMENT_SIMPLE",MVT_SEGMENT_SIMPLE; "MVT_SIMPLE",MVT_SIMPLE; "MVT_VERY_SIMPLE",MVT_VERY_SIMPLE; "NADD_ADD",NADD_ADD; "NADD_ADDITIVE",NADD_ADDITIVE; "NADD_ADD_ASSOC",NADD_ADD_ASSOC; "NADD_ADD_LCANCEL",NADD_ADD_LCANCEL; "NADD_ADD_LID",NADD_ADD_LID; "NADD_ADD_SYM",NADD_ADD_SYM; "NADD_ADD_WELLDEF",NADD_ADD_WELLDEF; "NADD_ALTMUL",NADD_ALTMUL; "NADD_ARCH",NADD_ARCH; "NADD_ARCH_LEMMA",NADD_ARCH_LEMMA; "NADD_ARCH_MULT",NADD_ARCH_MULT; "NADD_ARCH_ZERO",NADD_ARCH_ZERO; "NADD_BOUND",NADD_BOUND; "NADD_CAUCHY",NADD_CAUCHY; "NADD_COMPLETE",NADD_COMPLETE; "NADD_DIST",NADD_DIST; "NADD_DIST_LEMMA",NADD_DIST_LEMMA; "NADD_EQ_IMP_LE",NADD_EQ_IMP_LE; "NADD_EQ_REFL",NADD_EQ_REFL; "NADD_EQ_SYM",NADD_EQ_SYM; "NADD_EQ_TRANS",NADD_EQ_TRANS; "NADD_INV",NADD_INV; "NADD_INV_0",NADD_INV_0; "NADD_INV_WELLDEF",NADD_INV_WELLDEF; "NADD_LBOUND",NADD_LBOUND; "NADD_LDISTRIB",NADD_LDISTRIB; "NADD_LE_0",NADD_LE_0; "NADD_LE_ADD",NADD_LE_ADD; "NADD_LE_ANTISYM",NADD_LE_ANTISYM; "NADD_LE_EXISTS",NADD_LE_EXISTS; "NADD_LE_LADD",NADD_LE_LADD; "NADD_LE_LMUL",NADD_LE_LMUL; "NADD_LE_RADD",NADD_LE_RADD; "NADD_LE_REFL",NADD_LE_REFL; "NADD_LE_RMUL",NADD_LE_RMUL; "NADD_LE_TOTAL",NADD_LE_TOTAL; "NADD_LE_TOTAL_LEMMA",NADD_LE_TOTAL_LEMMA; "NADD_LE_TRANS",NADD_LE_TRANS; "NADD_LE_WELLDEF",NADD_LE_WELLDEF; "NADD_LE_WELLDEF_LEMMA",NADD_LE_WELLDEF_LEMMA; "NADD_MUL",NADD_MUL; "NADD_MULTIPLICATIVE",NADD_MULTIPLICATIVE; "NADD_MUL_ASSOC",NADD_MUL_ASSOC; "NADD_MUL_LID",NADD_MUL_LID; "NADD_MUL_LINV",NADD_MUL_LINV; "NADD_MUL_LINV_LEMMA0",NADD_MUL_LINV_LEMMA0; "NADD_MUL_LINV_LEMMA1",NADD_MUL_LINV_LEMMA1; "NADD_MUL_LINV_LEMMA2",NADD_MUL_LINV_LEMMA2; "NADD_MUL_LINV_LEMMA3",NADD_MUL_LINV_LEMMA3; "NADD_MUL_LINV_LEMMA4",NADD_MUL_LINV_LEMMA4; "NADD_MUL_LINV_LEMMA5",NADD_MUL_LINV_LEMMA5; "NADD_MUL_LINV_LEMMA6",NADD_MUL_LINV_LEMMA6; "NADD_MUL_LINV_LEMMA7",NADD_MUL_LINV_LEMMA7; "NADD_MUL_LINV_LEMMA7a",NADD_MUL_LINV_LEMMA7a; "NADD_MUL_LINV_LEMMA8",NADD_MUL_LINV_LEMMA8; "NADD_MUL_SYM",NADD_MUL_SYM; "NADD_MUL_WELLDEF",NADD_MUL_WELLDEF; "NADD_MUL_WELLDEF_LEMMA",NADD_MUL_WELLDEF_LEMMA; "NADD_NONZERO",NADD_NONZERO; "NADD_OF_NUM",NADD_OF_NUM; "NADD_OF_NUM_ADD",NADD_OF_NUM_ADD; "NADD_OF_NUM_EQ",NADD_OF_NUM_EQ; "NADD_OF_NUM_LE",NADD_OF_NUM_LE; "NADD_OF_NUM_MUL",NADD_OF_NUM_MUL; "NADD_OF_NUM_WELLDEF",NADD_OF_NUM_WELLDEF; "NADD_RDISTRIB",NADD_RDISTRIB; "NADD_SUC",NADD_SUC; "NADD_UBOUND",NADD_UBOUND; "NEARBY_INVERTIBLE_MATRIX",NEARBY_INVERTIBLE_MATRIX; "NEARBY_INVERTIBLE_MATRIX_GEN",NEARBY_INVERTIBLE_MATRIX_GEN; "NEARBY_POSITIVE_DEFINITE_MATRIX",NEARBY_POSITIVE_DEFINITE_MATRIX; "NEARBY_POSITIVE_DEFINITE_MATRIX_GEN",NEARBY_POSITIVE_DEFINITE_MATRIX_GEN; "NEGATIONS_BALL",NEGATIONS_BALL; "NEGATIONS_CBALL",NEGATIONS_CBALL; "NEGATIONS_SPHERE",NEGATIONS_SPHERE; "NEGLIGIBLE",NEGLIGIBLE; "NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE",NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE; "NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE_LOWDIM",NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE_LOWDIM; "NEGLIGIBLE_AFFINE_HULL",NEGLIGIBLE_AFFINE_HULL; "NEGLIGIBLE_AFFINE_HULL_1",NEGLIGIBLE_AFFINE_HULL_1; "NEGLIGIBLE_AFFINE_HULL_2",NEGLIGIBLE_AFFINE_HULL_2; "NEGLIGIBLE_AFFINE_HULL_3",NEGLIGIBLE_AFFINE_HULL_3; "NEGLIGIBLE_AFFINITY",NEGLIGIBLE_AFFINITY; "NEGLIGIBLE_AFFINITY_EQ",NEGLIGIBLE_AFFINITY_EQ; "NEGLIGIBLE_ALGEBRAIC_VARIETY",NEGLIGIBLE_ALGEBRAIC_VARIETY; "NEGLIGIBLE_BOUNDED_SUBSETS",NEGLIGIBLE_BOUNDED_SUBSETS; "NEGLIGIBLE_CONVEX_FRONTIER",NEGLIGIBLE_CONVEX_FRONTIER; "NEGLIGIBLE_CONVEX_HULL",NEGLIGIBLE_CONVEX_HULL; "NEGLIGIBLE_CONVEX_HULL_1",NEGLIGIBLE_CONVEX_HULL_1; "NEGLIGIBLE_CONVEX_HULL_2",NEGLIGIBLE_CONVEX_HULL_2; "NEGLIGIBLE_CONVEX_HULL_3",NEGLIGIBLE_CONVEX_HULL_3; "NEGLIGIBLE_CONVEX_INTERIOR",NEGLIGIBLE_CONVEX_INTERIOR; "NEGLIGIBLE_COUNTABLE",NEGLIGIBLE_COUNTABLE; "NEGLIGIBLE_COUNTABLE_UNIONS",NEGLIGIBLE_COUNTABLE_UNIONS; "NEGLIGIBLE_COUNTABLE_UNIONS_GEN",NEGLIGIBLE_COUNTABLE_UNIONS_GEN; "NEGLIGIBLE_DELETE",NEGLIGIBLE_DELETE; "NEGLIGIBLE_DIFF",NEGLIGIBLE_DIFF; "NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM; "NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE; "NEGLIGIBLE_DIFFERENTIABLE_PREIMAGE",NEGLIGIBLE_DIFFERENTIABLE_PREIMAGE; "NEGLIGIBLE_DISJOINT_TRANSLATES",NEGLIGIBLE_DISJOINT_TRANSLATES; "NEGLIGIBLE_EMPTY",NEGLIGIBLE_EMPTY; "NEGLIGIBLE_EMPTY_INTERIOR",NEGLIGIBLE_EMPTY_INTERIOR; "NEGLIGIBLE_EQ_MEASURE_0",NEGLIGIBLE_EQ_MEASURE_0; "NEGLIGIBLE_EQ_ZERO_DENSITY",NEGLIGIBLE_EQ_ZERO_DENSITY; "NEGLIGIBLE_EQ_ZERO_DENSITY_ALT",NEGLIGIBLE_EQ_ZERO_DENSITY_ALT; "NEGLIGIBLE_FINITE",NEGLIGIBLE_FINITE; "NEGLIGIBLE_FRONTIER_INTERVAL",NEGLIGIBLE_FRONTIER_INTERVAL; "NEGLIGIBLE_HYPERPLANE",NEGLIGIBLE_HYPERPLANE; "NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS; "NEGLIGIBLE_IFF_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_MEASURABLE_SUBSETS; "NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL",NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL; "NEGLIGIBLE_IMAGE_INDEFINITE_INTEGRAL",NEGLIGIBLE_IMAGE_INDEFINITE_INTEGRAL; "NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE",NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE; "NEGLIGIBLE_IMP_MEASURABLE",NEGLIGIBLE_IMP_MEASURABLE; "NEGLIGIBLE_INFINITE_PREIMAGES_DIFFERENTIABLE",NEGLIGIBLE_INFINITE_PREIMAGES_DIFFERENTIABLE; "NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE",NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE; "NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE_GEN",NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE_GEN; "NEGLIGIBLE_INSERT",NEGLIGIBLE_INSERT; "NEGLIGIBLE_INTER",NEGLIGIBLE_INTER; "NEGLIGIBLE_INTERVAL",NEGLIGIBLE_INTERVAL; "NEGLIGIBLE_LINEAR_IMAGE",NEGLIGIBLE_LINEAR_IMAGE; "NEGLIGIBLE_LINEAR_IMAGE_EQ",NEGLIGIBLE_LINEAR_IMAGE_EQ; "NEGLIGIBLE_LINEAR_IMAGE_GEN",NEGLIGIBLE_LINEAR_IMAGE_GEN; "NEGLIGIBLE_LINEAR_SINGULAR_IMAGE",NEGLIGIBLE_LINEAR_SINGULAR_IMAGE; "NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV",NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV; "NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE",NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE; "NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE_LOWDIM",NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE_LOWDIM; "NEGLIGIBLE_LOWDIM",NEGLIGIBLE_LOWDIM; "NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH",NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH; "NEGLIGIBLE_ON_COUNTABLE_INTERVALS",NEGLIGIBLE_ON_COUNTABLE_INTERVALS; "NEGLIGIBLE_ON_INTERVALS",NEGLIGIBLE_ON_INTERVALS; "NEGLIGIBLE_ON_UNIV",NEGLIGIBLE_ON_UNIV; "NEGLIGIBLE_OUTER",NEGLIGIBLE_OUTER; "NEGLIGIBLE_OUTER_LE",NEGLIGIBLE_OUTER_LE; "NEGLIGIBLE_PCROSS",NEGLIGIBLE_PCROSS; "NEGLIGIBLE_POINTS_OF_AMBIGUOUS_DERIVATIVE",NEGLIGIBLE_POINTS_OF_AMBIGUOUS_DERIVATIVE; "NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE",NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE; "NEGLIGIBLE_SCALING",NEGLIGIBLE_SCALING; "NEGLIGIBLE_SCALING_EQ",NEGLIGIBLE_SCALING_EQ; "NEGLIGIBLE_SEGMENT",NEGLIGIBLE_SEGMENT; "NEGLIGIBLE_SING",NEGLIGIBLE_SING; "NEGLIGIBLE_SPHERE",NEGLIGIBLE_SPHERE; "NEGLIGIBLE_STANDARD_HYPERPLANE",NEGLIGIBLE_STANDARD_HYPERPLANE; "NEGLIGIBLE_SUBSET",NEGLIGIBLE_SUBSET; "NEGLIGIBLE_SYMDIFF_EQ",NEGLIGIBLE_SYMDIFF_EQ; "NEGLIGIBLE_TRANSLATION",NEGLIGIBLE_TRANSLATION; "NEGLIGIBLE_TRANSLATION_EQ",NEGLIGIBLE_TRANSLATION_EQ; "NEGLIGIBLE_TRANSLATION_REV",NEGLIGIBLE_TRANSLATION_REV; "NEGLIGIBLE_UNION",NEGLIGIBLE_UNION; "NEGLIGIBLE_UNIONS",NEGLIGIBLE_UNIONS; "NEGLIGIBLE_UNION_EQ",NEGLIGIBLE_UNION_EQ; "NEGLIGIBLE_VALID_PATH_IMAGE",NEGLIGIBLE_VALID_PATH_IMAGE; "NEIGHBOURHOOD_EXTENSION_INTO_ANR",NEIGHBOURHOOD_EXTENSION_INTO_ANR; "NET",NET; "NETLIMIT_AT",NETLIMIT_AT; "NETLIMIT_ATREAL",NETLIMIT_ATREAL; "NETLIMIT_WITHIN",NETLIMIT_WITHIN; "NETLIMIT_WITHINREAL",NETLIMIT_WITHINREAL; "NETLIMIT_WITHIN_INTERIOR",NETLIMIT_WITHIN_INTERIOR; "NET_DILEMMA",NET_DILEMMA; "NET_WITHIN_UNIV",NET_WITHIN_UNIV; "NEUTRAL_ADD",NEUTRAL_ADD; "NEUTRAL_AND",NEUTRAL_AND; "NEUTRAL_COMPLEX_MUL",NEUTRAL_COMPLEX_MUL; "NEUTRAL_LIFTED",NEUTRAL_LIFTED; "NEUTRAL_MUL",NEUTRAL_MUL; "NEUTRAL_OUTER",NEUTRAL_OUTER; "NEUTRAL_REAL_ADD",NEUTRAL_REAL_ADD; "NEUTRAL_REAL_MUL",NEUTRAL_REAL_MUL; "NEUTRAL_VECTOR_ADD",NEUTRAL_VECTOR_ADD; "NONBOUNDARY_IN_UNIQUE_CONIC_HULL_SIMPLEX",NONBOUNDARY_IN_UNIQUE_CONIC_HULL_SIMPLEX; "NONDECREASING_EXTENDS_FROM_DENSE",NONDECREASING_EXTENDS_FROM_DENSE; "NONDECREASING_EXTENDS_TO_CONVEX_HULL",NONDECREASING_EXTENDS_TO_CONVEX_HULL; "NONEMPTY_AFFINE_EXISTS",NONEMPTY_AFFINE_EXISTS; "NONEMPTY_SIMPLE_PATH_ENDLESS",NONEMPTY_SIMPLE_PATH_ENDLESS; "NONEMPTY_SPAN",NONEMPTY_SPAN; "NONNEGATIVE_ABSOLUTELY_INTEGRABLE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE; "NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE; "NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE",NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE; "NONNEGATIVE_INTEGER",NONNEGATIVE_INTEGER; "NONPOSITIVE_INTEGER",NONPOSITIVE_INTEGER; "NONPOSITIVE_INTEGER_ALT",NONPOSITIVE_INTEGER_ALT; "NONSEPARATION_BY_COMPONENT_EQ",NONSEPARATION_BY_COMPONENT_EQ; "NONTRIVIAL_LIMIT_WITHIN",NONTRIVIAL_LIMIT_WITHIN; "NON_EXTENSIBLE_BORSUK_MAP",NON_EXTENSIBLE_BORSUK_MAP; "NON_MEASURABLE_SET",NON_MEASURABLE_SET; "NON_TRIVIAL_LIMIT_LEFT",NON_TRIVIAL_LIMIT_LEFT; "NON_TRIVIAL_LIMIT_RIGHT",NON_TRIVIAL_LIMIT_RIGHT; "NORMAL_BIPOLAR_DECOMPOSITION",NORMAL_BIPOLAR_DECOMPOSITION; "NORMAL_LEFT_POLAR_DECOMPOSITION",NORMAL_LEFT_POLAR_DECOMPOSITION; "NORMAL_MATRIX_IFF_SAME_DOT_TRANSP",NORMAL_MATRIX_IFF_SAME_DOT_TRANSP; "NORMAL_MATRIX_IFF_SAME_NORM_TRANSP",NORMAL_MATRIX_IFF_SAME_NORM_TRANSP; "NORMAL_MATRIX_INV",NORMAL_MATRIX_INV; "NORMAL_MATRIX_KERNEL_TRANSP",NORMAL_MATRIX_KERNEL_TRANSP; "NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT",NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT; "NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP",NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP; "NORMAL_MATRIX_SAME_EIGENVECTORS_TRANSP",NORMAL_MATRIX_SAME_EIGENVECTORS_TRANSP; "NORMAL_MATRIX_SIMILAR_TRANSP",NORMAL_MATRIX_SIMILAR_TRANSP; "NORMAL_MATRIX_SIMILAR_TRANSP_ALT",NORMAL_MATRIX_SIMILAR_TRANSP_ALT; "NORMAL_RIGHT_POLAR_DECOMPOSITION",NORMAL_RIGHT_POLAR_DECOMPOSITION; "NORM_0",NORM_0; "NORM_1",NORM_1; "NORM_1_POS",NORM_1_POS; "NORM_ADD_PYTHAGOREAN",NORM_ADD_PYTHAGOREAN; "NORM_BASIS",NORM_BASIS; "NORM_BASIS_1",NORM_BASIS_1; "NORM_BOUND_COMPONENT_LE",NORM_BOUND_COMPONENT_LE; "NORM_BOUND_COMPONENT_LT",NORM_BOUND_COMPONENT_LT; "NORM_BOUND_GENERALIZE",NORM_BOUND_GENERALIZE; "NORM_CAUCHY_SCHWARZ",NORM_CAUCHY_SCHWARZ; "NORM_CAUCHY_SCHWARZ_ABS",NORM_CAUCHY_SCHWARZ_ABS; "NORM_CAUCHY_SCHWARZ_ABS_EQ",NORM_CAUCHY_SCHWARZ_ABS_EQ; "NORM_CAUCHY_SCHWARZ_DIV",NORM_CAUCHY_SCHWARZ_DIV; "NORM_CAUCHY_SCHWARZ_EQ",NORM_CAUCHY_SCHWARZ_EQ; "NORM_CAUCHY_SCHWARZ_EQUAL",NORM_CAUCHY_SCHWARZ_EQUAL; "NORM_CCOS_LE",NORM_CCOS_LE; "NORM_CCOS_PLUS1_LE",NORM_CCOS_PLUS1_LE; "NORM_CCOS_POW_2",NORM_CCOS_POW_2; "NORM_CEXP",NORM_CEXP; "NORM_CEXP_II",NORM_CEXP_II; "NORM_CEXP_IMAGINARY",NORM_CEXP_IMAGINARY; "NORM_COLUMN_LE_ONORM",NORM_COLUMN_LE_ONORM; "NORM_COSSIN",NORM_COSSIN; "NORM_CPOW",NORM_CPOW; "NORM_CPOW_REAL",NORM_CPOW_REAL; "NORM_CPOW_REAL_MONO",NORM_CPOW_REAL_MONO; "NORM_CPRODUCT",NORM_CPRODUCT; "NORM_CROSS_MULTIPLY",NORM_CROSS_MULTIPLY; "NORM_CSIN_POW_2",NORM_CSIN_POW_2; "NORM_EQ",NORM_EQ; "NORM_EQ_0",NORM_EQ_0; "NORM_EQ_0_DOT",NORM_EQ_0_DOT; "NORM_EQ_0_IMP",NORM_EQ_0_IMP; "NORM_EQ_1",NORM_EQ_1; "NORM_EQ_COMPONENTWISE",NORM_EQ_COMPONENTWISE; "NORM_EQ_SQUARE",NORM_EQ_SQUARE; "NORM_FSTCART",NORM_FSTCART; "NORM_GE_SQUARE",NORM_GE_SQUARE; "NORM_GT_SQUARE",NORM_GT_SQUARE; "NORM_INCREASES_ONLINE",NORM_INCREASES_ONLINE; "NORM_LE",NORM_LE; "NORM_LE_0",NORM_LE_0; "NORM_LE_COMPONENTWISE",NORM_LE_COMPONENTWISE; "NORM_LE_INFNORM",NORM_LE_INFNORM; "NORM_LE_L1",NORM_LE_L1; "NORM_LE_PASTECART",NORM_LE_PASTECART; "NORM_LE_SQUARE",NORM_LE_SQUARE; "NORM_LIFT",NORM_LIFT; "NORM_LT",NORM_LT; "NORM_LT_SQUARE",NORM_LT_SQUARE; "NORM_LT_SQUARE_ALT",NORM_LT_SQUARE_ALT; "NORM_MUL",NORM_MUL; "NORM_NEG",NORM_NEG; "NORM_PASTECART",NORM_PASTECART; "NORM_PASTECART_0",NORM_PASTECART_0; "NORM_PASTECART_LE",NORM_PASTECART_LE; "NORM_POS_LE",NORM_POS_LE; "NORM_POS_LT",NORM_POS_LT; "NORM_POW_2",NORM_POW_2; "NORM_REAL",NORM_REAL; "NORM_REFLECT_ALONG",NORM_REFLECT_ALONG; "NORM_ROTATE2D",NORM_ROTATE2D; "NORM_SEGMENT_LOWERBOUND",NORM_SEGMENT_LOWERBOUND; "NORM_SEGMENT_ORTHOGONAL_LOWERBOUND",NORM_SEGMENT_ORTHOGONAL_LOWERBOUND; "NORM_SNDCART",NORM_SNDCART; "NORM_SUB",NORM_SUB; "NORM_SUM_LEMMA",NORM_SUM_LEMMA; "NORM_TRIANGLE",NORM_TRIANGLE; "NORM_TRIANGLE_EQ",NORM_TRIANGLE_EQ; "NORM_TRIANGLE_LE",NORM_TRIANGLE_LE; "NORM_TRIANGLE_LT",NORM_TRIANGLE_LT; "NORM_TRIANGLE_SUB",NORM_TRIANGLE_SUB; "NORM_VECTOR_DERIVATIVES_LE_AT",NORM_VECTOR_DERIVATIVES_LE_AT; "NORM_VECTOR_DERIVATIVES_LE_WITHIN",NORM_VECTOR_DERIVATIVES_LE_WITHIN; "NORM_VSUM_PYTHAGOREAN",NORM_VSUM_PYTHAGOREAN; "NORM_VSUM_TRIVIAL_LEMMA",NORM_VSUM_TRIVIAL_LEMMA; "NOT_ABSOLUTE_RETRACT_COBOUNDED",NOT_ABSOLUTE_RETRACT_COBOUNDED; "NOT_ALL",NOT_ALL; "NOT_AR_EMPTY",NOT_AR_EMPTY; "NOT_BOUNDED_UNIV",NOT_BOUNDED_UNIV; "NOT_CLAUSES",NOT_CLAUSES; "NOT_CLAUSES_WEAK",NOT_CLAUSES_WEAK; "NOT_CONNECTED_COMPONENT_SEPARATED_UNION",NOT_CONNECTED_COMPONENT_SEPARATED_UNION; "NOT_CONS_NIL",NOT_CONS_NIL; "NOT_DEF",NOT_DEF; "NOT_EMPTY_INSERT",NOT_EMPTY_INSERT; "NOT_EQUAL_SETS",NOT_EQUAL_SETS; "NOT_EVEN",NOT_EVEN; "NOT_EVENTUALLY",NOT_EVENTUALLY; "NOT_EX",NOT_EX; "NOT_EXISTS_THM",NOT_EXISTS_THM; "NOT_FORALL_THM",NOT_FORALL_THM; "NOT_GDELTA_DENSE_COUNTABLE",NOT_GDELTA_DENSE_COUNTABLE; "NOT_IMP",NOT_IMP; "NOT_INSERT_EMPTY",NOT_INSERT_EMPTY; "NOT_INTERVAL_UNIV",NOT_INTERVAL_UNIV; "NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION",NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION; "NOT_IN_EMPTY",NOT_IN_EMPTY; "NOT_IN_INTERIOR_CONVEX_HULL",NOT_IN_INTERIOR_CONVEX_HULL; "NOT_IN_INTERIOR_CONVEX_HULL_3",NOT_IN_INTERIOR_CONVEX_HULL_3; "NOT_IN_PATH_IMAGE_JOIN",NOT_IN_PATH_IMAGE_JOIN; "NOT_LE",NOT_LE; "NOT_LT",NOT_LT; "NOT_MEASURABLE_UNIV",NOT_MEASURABLE_UNIV; "NOT_NEGLIGIBLE_UNIV",NOT_NEGLIGIBLE_UNIV; "NOT_ODD",NOT_ODD; "NOT_ON_PATH_BALL",NOT_ON_PATH_BALL; "NOT_ON_PATH_CBALL",NOT_ON_PATH_CBALL; "NOT_OPEN_SING",NOT_OPEN_SING; "NOT_OUTSIDE_CONNECTED_COMPONENT_LE",NOT_OUTSIDE_CONNECTED_COMPONENT_LE; "NOT_OUTSIDE_CONNECTED_COMPONENT_LT",NOT_OUTSIDE_CONNECTED_COMPONENT_LT; "NOT_PSUBSET_EMPTY",NOT_PSUBSET_EMPTY; "NOT_SIMPLY_CONNECTED_CIRCLE",NOT_SIMPLY_CONNECTED_CIRCLE; "NOT_SUC",NOT_SUC; "NOT_UNIV_PSUBSET",NOT_UNIV_PSUBSET; "NOWHERE_DENSE",NOWHERE_DENSE; "NOWHERE_DENSE_ALGEBRAIC_VARIETY",NOWHERE_DENSE_ALGEBRAIC_VARIETY; "NOWHERE_DENSE_COUNTABLE_UNIONS",NOWHERE_DENSE_COUNTABLE_UNIONS; "NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED",NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED; "NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN",NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN; "NOWHERE_DENSE_UNION",NOWHERE_DENSE_UNION; "NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO",NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO; "NO_BOUNDED_PATH_COMPONENT_IMP_WINDING_NUMBER_ZERO",NO_BOUNDED_PATH_COMPONENT_IMP_WINDING_NUMBER_ZERO; "NO_EMBEDDING_SPHERE_LOWDIM",NO_EMBEDDING_SPHERE_LOWDIM; "NO_ISOLATED_SINGULARITY",NO_ISOLATED_SINGULARITY; "NO_LIMIT_POINT_IMP_CLOSED",NO_LIMIT_POINT_IMP_CLOSED; "NO_RETRACTION_CBALL",NO_RETRACTION_CBALL; "NO_RETRACTION_FRONTIER_BOUNDED",NO_RETRACTION_FRONTIER_BOUNDED; "NPRODUCT_ADD_SPLIT",NPRODUCT_ADD_SPLIT; "NPRODUCT_CLAUSES",NPRODUCT_CLAUSES; "NPRODUCT_CLAUSES_LEFT",NPRODUCT_CLAUSES_LEFT; "NPRODUCT_CLAUSES_NUMSEG",NPRODUCT_CLAUSES_NUMSEG; "NPRODUCT_CLAUSES_RIGHT",NPRODUCT_CLAUSES_RIGHT; "NPRODUCT_CLOSED",NPRODUCT_CLOSED; "NPRODUCT_CONST",NPRODUCT_CONST; "NPRODUCT_CONST_NUMSEG",NPRODUCT_CONST_NUMSEG; "NPRODUCT_CONST_NUMSEG_1",NPRODUCT_CONST_NUMSEG_1; "NPRODUCT_DELETE",NPRODUCT_DELETE; "NPRODUCT_DELTA",NPRODUCT_DELTA; "NPRODUCT_EQ",NPRODUCT_EQ; "NPRODUCT_EQ_0",NPRODUCT_EQ_0; "NPRODUCT_EQ_0_NUMSEG",NPRODUCT_EQ_0_NUMSEG; "NPRODUCT_EQ_1",NPRODUCT_EQ_1; "NPRODUCT_EQ_1_NUMSEG",NPRODUCT_EQ_1_NUMSEG; "NPRODUCT_EQ_NUMSEG",NPRODUCT_EQ_NUMSEG; "NPRODUCT_FACT",NPRODUCT_FACT; "NPRODUCT_IMAGE",NPRODUCT_IMAGE; "NPRODUCT_LE",NPRODUCT_LE; "NPRODUCT_LE_NUMSEG",NPRODUCT_LE_NUMSEG; "NPRODUCT_MUL",NPRODUCT_MUL; "NPRODUCT_MUL_GEN",NPRODUCT_MUL_GEN; "NPRODUCT_MUL_NUMSEG",NPRODUCT_MUL_NUMSEG; "NPRODUCT_OFFSET",NPRODUCT_OFFSET; "NPRODUCT_ONE",NPRODUCT_ONE; "NPRODUCT_PAIR",NPRODUCT_PAIR; "NPRODUCT_POS_LT",NPRODUCT_POS_LT; "NPRODUCT_POS_LT_NUMSEG",NPRODUCT_POS_LT_NUMSEG; "NPRODUCT_REFLECT",NPRODUCT_REFLECT; "NPRODUCT_SING",NPRODUCT_SING; "NPRODUCT_SING_NUMSEG",NPRODUCT_SING_NUMSEG; "NPRODUCT_SUPERSET",NPRODUCT_SUPERSET; "NPRODUCT_SUPPORT",NPRODUCT_SUPPORT; "NPRODUCT_UNION",NPRODUCT_UNION; "NPRODUCT_UNIV",NPRODUCT_UNIV; "NSUM_0",NSUM_0; "NSUM_ADD",NSUM_ADD; "NSUM_ADD_GEN",NSUM_ADD_GEN; "NSUM_ADD_NUMSEG",NSUM_ADD_NUMSEG; "NSUM_ADD_SPLIT",NSUM_ADD_SPLIT; "NSUM_BIJECTION",NSUM_BIJECTION; "NSUM_BOUND",NSUM_BOUND; "NSUM_BOUND_GEN",NSUM_BOUND_GEN; "NSUM_BOUND_LT",NSUM_BOUND_LT; "NSUM_BOUND_LT_ALL",NSUM_BOUND_LT_ALL; "NSUM_BOUND_LT_GEN",NSUM_BOUND_LT_GEN; "NSUM_CASES",NSUM_CASES; "NSUM_CLAUSES",NSUM_CLAUSES; "NSUM_CLAUSES_LEFT",NSUM_CLAUSES_LEFT; "NSUM_CLAUSES_NUMSEG",NSUM_CLAUSES_NUMSEG; "NSUM_CLAUSES_RIGHT",NSUM_CLAUSES_RIGHT; "NSUM_CLOSED",NSUM_CLOSED; "NSUM_CONST",NSUM_CONST; "NSUM_CONST_NUMSEG",NSUM_CONST_NUMSEG; "NSUM_DEGENERATE",NSUM_DEGENERATE; "NSUM_DELETE",NSUM_DELETE; "NSUM_DELTA",NSUM_DELTA; "NSUM_DIFF",NSUM_DIFF; "NSUM_EQ",NSUM_EQ; "NSUM_EQ_0",NSUM_EQ_0; "NSUM_EQ_0_IFF",NSUM_EQ_0_IFF; "NSUM_EQ_0_IFF_NUMSEG",NSUM_EQ_0_IFF_NUMSEG; "NSUM_EQ_0_NUMSEG",NSUM_EQ_0_NUMSEG; "NSUM_EQ_GENERAL",NSUM_EQ_GENERAL; "NSUM_EQ_GENERAL_INVERSES",NSUM_EQ_GENERAL_INVERSES; "NSUM_EQ_NUMSEG",NSUM_EQ_NUMSEG; "NSUM_EQ_SUPERSET",NSUM_EQ_SUPERSET; "NSUM_GROUP",NSUM_GROUP; "NSUM_GROUP_RELATION",NSUM_GROUP_RELATION; "NSUM_IMAGE",NSUM_IMAGE; "NSUM_IMAGE_GEN",NSUM_IMAGE_GEN; "NSUM_IMAGE_NONZERO",NSUM_IMAGE_NONZERO; "NSUM_INCL_EXCL",NSUM_INCL_EXCL; "NSUM_INJECTION",NSUM_INJECTION; "NSUM_LE",NSUM_LE; "NSUM_LE_GEN",NSUM_LE_GEN; "NSUM_LE_NUMSEG",NSUM_LE_NUMSEG; "NSUM_LMUL",NSUM_LMUL; "NSUM_LT",NSUM_LT; "NSUM_LT_ALL",NSUM_LT_ALL; "NSUM_MULTICOUNT",NSUM_MULTICOUNT; "NSUM_MULTICOUNT_GEN",NSUM_MULTICOUNT_GEN; "NSUM_MUL_BOUND",NSUM_MUL_BOUND; "NSUM_NSUM_PRODUCT",NSUM_NSUM_PRODUCT; "NSUM_NSUM_RESTRICT",NSUM_NSUM_RESTRICT; "NSUM_OFFSET",NSUM_OFFSET; "NSUM_OFFSET_0",NSUM_OFFSET_0; "NSUM_PAIR",NSUM_PAIR; "NSUM_PERMUTE",NSUM_PERMUTE; "NSUM_PERMUTE_NUMSEG",NSUM_PERMUTE_NUMSEG; "NSUM_POS_BOUND",NSUM_POS_BOUND; "NSUM_POS_LT",NSUM_POS_LT; "NSUM_POS_LT_ALL",NSUM_POS_LT_ALL; "NSUM_REFLECT",NSUM_REFLECT; "NSUM_RESTRICT",NSUM_RESTRICT; "NSUM_RESTRICT_SET",NSUM_RESTRICT_SET; "NSUM_RMUL",NSUM_RMUL; "NSUM_SING",NSUM_SING; "NSUM_SING_NUMSEG",NSUM_SING_NUMSEG; "NSUM_SUBSET",NSUM_SUBSET; "NSUM_SUBSET_SIMPLE",NSUM_SUBSET_SIMPLE; "NSUM_SUPERSET",NSUM_SUPERSET; "NSUM_SUPPORT",NSUM_SUPPORT; "NSUM_SWAP",NSUM_SWAP; "NSUM_SWAP_NUMSEG",NSUM_SWAP_NUMSEG; "NSUM_TRIV_NUMSEG",NSUM_TRIV_NUMSEG; "NSUM_UNION",NSUM_UNION; "NSUM_UNIONS_NONZERO",NSUM_UNIONS_NONZERO; "NSUM_UNION_EQ",NSUM_UNION_EQ; "NSUM_UNION_LZERO",NSUM_UNION_LZERO; "NSUM_UNION_NONZERO",NSUM_UNION_NONZERO; "NSUM_UNION_RZERO",NSUM_UNION_RZERO; "NSUM_UNIV",NSUM_UNIV; "NULL",NULL; "NULLHOMOTOPIC_FROM_CONTRACTIBLE",NULLHOMOTOPIC_FROM_CONTRACTIBLE; "NULLHOMOTOPIC_FROM_SPHERE_EXTENSION",NULLHOMOTOPIC_FROM_SPHERE_EXTENSION; "NULLHOMOTOPIC_INTO_ANR_EXTENSION",NULLHOMOTOPIC_INTO_ANR_EXTENSION; "NULLHOMOTOPIC_INTO_CONTRACTIBLE",NULLHOMOTOPIC_INTO_CONTRACTIBLE; "NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION",NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION; "NULLHOMOTOPIC_INTO_SPHERE_EXTENSION",NULLHOMOTOPIC_INTO_SPHERE_EXTENSION; "NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION",NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION; "NULLHOMOTOPIC_THROUGH_CONTRACTIBLE",NULLHOMOTOPIC_THROUGH_CONTRACTIBLE; "NULLSPACE_INTER_ROWSPACE",NULLSPACE_INTER_ROWSPACE; "NUMERAL",NUMERAL; "NUMPAIR",NUMPAIR; "NUMPAIR_DEST",NUMPAIR_DEST; "NUMPAIR_INJ",NUMPAIR_INJ; "NUMPAIR_INJ_LEMMA",NUMPAIR_INJ_LEMMA; "NUMSEG_ADD_SPLIT",NUMSEG_ADD_SPLIT; "NUMSEG_CLAUSES",NUMSEG_CLAUSES; "NUMSEG_COMBINE_L",NUMSEG_COMBINE_L; "NUMSEG_COMBINE_R",NUMSEG_COMBINE_R; "NUMSEG_DIMINDEX_NONEMPTY",NUMSEG_DIMINDEX_NONEMPTY; "NUMSEG_EMPTY",NUMSEG_EMPTY; "NUMSEG_LE",NUMSEG_LE; "NUMSEG_LREC",NUMSEG_LREC; "NUMSEG_LT",NUMSEG_LT; "NUMSEG_OFFSET_IMAGE",NUMSEG_OFFSET_IMAGE; "NUMSEG_REC",NUMSEG_REC; "NUMSEG_RREC",NUMSEG_RREC; "NUMSEG_SING",NUMSEG_SING; "NUMSUM",NUMSUM; "NUMSUM_DEST",NUMSUM_DEST; "NUMSUM_INJ",NUMSUM_INJ; "NUM_COUNTABLE",NUM_COUNTABLE; "NUM_GCD",NUM_GCD; "NUM_OF_INT",NUM_OF_INT; "NUM_OF_INT_OF_NUM",NUM_OF_INT_OF_NUM; "NUM_REP_CASES",NUM_REP_CASES; "NUM_REP_INDUCT",NUM_REP_INDUCT; "NUM_REP_RULES",NUM_REP_RULES; "ODD",ODD; "ODD_ADD",ODD_ADD; "ODD_DOUBLE",ODD_DOUBLE; "ODD_EXISTS",ODD_EXISTS; "ODD_EXP",ODD_EXP; "ODD_MOD",ODD_MOD; "ODD_MULT",ODD_MULT; "ODD_SUB",ODD_SUB; "OEP",OEP; "OLDNET",OLDNET; "ONE",ONE; "ONE_ONE",ONE_ONE; "ONORM",ONORM; "ONORM_ADJOINT",ONORM_ADJOINT; "ONORM_CMUL",ONORM_CMUL; "ONORM_COMPOSE",ONORM_COMPOSE; "ONORM_COMPOSE_ADJOINT_LEFT",ONORM_COMPOSE_ADJOINT_LEFT; "ONORM_COMPOSE_ADJOINT_RIGHT",ONORM_COMPOSE_ADJOINT_RIGHT; "ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT",ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT; "ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT",ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT; "ONORM_CONST",ONORM_CONST; "ONORM_COVARIANCE",ONORM_COVARIANCE; "ONORM_COVARIANCE_ALT",ONORM_COVARIANCE_ALT; "ONORM_DERIVATIVES_LE",ONORM_DERIVATIVES_LE; "ONORM_DIAGONAL_MATRIX",ONORM_DIAGONAL_MATRIX; "ONORM_DOT",ONORM_DOT; "ONORM_EQ_0",ONORM_EQ_0; "ONORM_I",ONORM_I; "ONORM_ID",ONORM_ID; "ONORM_INVERSE_DET_LE_ONORM_POW",ONORM_INVERSE_DET_LE_ONORM_POW; "ONORM_INVERSE_DET_LE_ONORM_POW_ALT",ONORM_INVERSE_DET_LE_ONORM_POW_ALT; "ONORM_INVERSE_FUNCTION_BOUND",ONORM_INVERSE_FUNCTION_BOUND; "ONORM_LE_EQ",ONORM_LE_EQ; "ONORM_LE_EVENTUALLY",ONORM_LE_EVENTUALLY; "ONORM_LE_MATRIX_COMPONENT",ONORM_LE_MATRIX_COMPONENT; "ONORM_LE_MATRIX_COMPONENT_SUM",ONORM_LE_MATRIX_COMPONENT_SUM; "ONORM_NEG",ONORM_NEG; "ONORM_ORTHOGONAL_MATRIX",ONORM_ORTHOGONAL_MATRIX; "ONORM_ORTHOGONAL_TRANSFORMATION",ONORM_ORTHOGONAL_TRANSFORMATION; "ONORM_POS_LE",ONORM_POS_LE; "ONORM_POS_LT",ONORM_POS_LT; "ONORM_TRANSP",ONORM_TRANSP; "ONORM_TRIANGLE",ONORM_TRIANGLE; "ONORM_TRIANGLE_LE",ONORM_TRIANGLE_LE; "ONORM_TRIANGLE_LT",ONORM_TRIANGLE_LT; "ONTO",ONTO; "OPEN_AFFINITY",OPEN_AFFINITY; "OPEN_AFFINITY_EQ",OPEN_AFFINITY_EQ; "OPEN_ARG_GT",OPEN_ARG_GT; "OPEN_ARG_LTT",OPEN_ARG_LTT; "OPEN_BALL",OPEN_BALL; "OPEN_BIJECTIVE_LINEAR_IMAGE_EQ",OPEN_BIJECTIVE_LINEAR_IMAGE_EQ; "OPEN_CLOSED",OPEN_CLOSED; "OPEN_CLOSED_INTERVAL_1",OPEN_CLOSED_INTERVAL_1; "OPEN_CLOSED_INTERVAL_CONVEX",OPEN_CLOSED_INTERVAL_CONVEX; "OPEN_COMPONENTS",OPEN_COMPONENTS; "OPEN_CONIC_HULL",OPEN_CONIC_HULL; "OPEN_CONNECTED_COMPONENT",OPEN_CONNECTED_COMPONENT; "OPEN_CONTAINS_BALL",OPEN_CONTAINS_BALL; "OPEN_CONTAINS_BALL_EQ",OPEN_CONTAINS_BALL_EQ; "OPEN_CONTAINS_CBALL",OPEN_CONTAINS_CBALL; "OPEN_CONTAINS_CBALL_EQ",OPEN_CONTAINS_CBALL_EQ; "OPEN_CONTAINS_INTERVAL",OPEN_CONTAINS_INTERVAL; "OPEN_CONTAINS_OPEN_INTERVAL",OPEN_CONTAINS_OPEN_INTERVAL; "OPEN_CONVEX_HULL",OPEN_CONVEX_HULL; "OPEN_COUNTABLE_LIMIT_ELEMENTARY",OPEN_COUNTABLE_LIMIT_ELEMENTARY; "OPEN_COUNTABLE_UNION_CLOSED_INTERVALS",OPEN_COUNTABLE_UNION_CLOSED_INTERVALS; "OPEN_COUNTABLE_UNION_OPEN_INTERVALS",OPEN_COUNTABLE_UNION_OPEN_INTERVALS; "OPEN_DELETE",OPEN_DELETE; "OPEN_DIFF",OPEN_DIFF; "OPEN_EMPTY",OPEN_EMPTY; "OPEN_EXISTS",OPEN_EXISTS; "OPEN_EXISTS_IN",OPEN_EXISTS_IN; "OPEN_GENERAL_COMPONENT",OPEN_GENERAL_COMPONENT; "OPEN_HALFSPACE_COMPONENT_GT",OPEN_HALFSPACE_COMPONENT_GT; "OPEN_HALFSPACE_COMPONENT_LT",OPEN_HALFSPACE_COMPONENT_LT; "OPEN_HALFSPACE_GT",OPEN_HALFSPACE_GT; "OPEN_HALFSPACE_IM_GT",OPEN_HALFSPACE_IM_GT; "OPEN_HALFSPACE_IM_LT",OPEN_HALFSPACE_IM_LT; "OPEN_HALFSPACE_LT",OPEN_HALFSPACE_LT; "OPEN_HALFSPACE_RE_GT",OPEN_HALFSPACE_RE_GT; "OPEN_HALFSPACE_RE_LT",OPEN_HALFSPACE_RE_LT; "OPEN_IMP_ANALYTIC",OPEN_IMP_ANALYTIC; "OPEN_IMP_ANR",OPEN_IMP_ANR; "OPEN_IMP_BAIRE1_INDICATOR",OPEN_IMP_BAIRE1_INDICATOR; "OPEN_IMP_BOREL",OPEN_IMP_BOREL; "OPEN_IMP_ENR",OPEN_IMP_ENR; "OPEN_IMP_FSIGMA",OPEN_IMP_FSIGMA; "OPEN_IMP_GDELTA",OPEN_IMP_GDELTA; "OPEN_IMP_INFINITE",OPEN_IMP_INFINITE; "OPEN_IMP_LOCALLY_COMPACT",OPEN_IMP_LOCALLY_COMPACT; "OPEN_IMP_LOCALLY_CONNECTED",OPEN_IMP_LOCALLY_CONNECTED; "OPEN_IMP_LOCALLY_PATH_CONNECTED",OPEN_IMP_LOCALLY_PATH_CONNECTED; "OPEN_IN",OPEN_IN; "OPEN_INSIDE",OPEN_INSIDE; "OPEN_INTER",OPEN_INTER; "OPEN_INTERIOR",OPEN_INTERIOR; "OPEN_INTERS",OPEN_INTERS; "OPEN_INTERVAL",OPEN_INTERVAL; "OPEN_INTERVAL_EQ",OPEN_INTERVAL_EQ; "OPEN_INTERVAL_LEFT",OPEN_INTERVAL_LEFT; "OPEN_INTERVAL_LEMMA",OPEN_INTERVAL_LEMMA; "OPEN_INTERVAL_MIDPOINT",OPEN_INTERVAL_MIDPOINT; "OPEN_INTERVAL_RIGHT",OPEN_INTERVAL_RIGHT; "OPEN_INTER_CLOSURE_EQ",OPEN_INTER_CLOSURE_EQ; "OPEN_INTER_CLOSURE_EQ_EMPTY",OPEN_INTER_CLOSURE_EQ_EMPTY; "OPEN_INTER_CLOSURE_SUBSET",OPEN_INTER_CLOSURE_SUBSET; "OPEN_INVERTIBLE_LINEAR_IMAGE",OPEN_INVERTIBLE_LINEAR_IMAGE; "OPEN_IN_ANALYTIC",OPEN_IN_ANALYTIC; "OPEN_IN_BOREL",OPEN_IN_BOREL; "OPEN_IN_CLAUSES",OPEN_IN_CLAUSES; "OPEN_IN_CLOSED_IN",OPEN_IN_CLOSED_IN; "OPEN_IN_CLOSED_IN_EQ",OPEN_IN_CLOSED_IN_EQ; "OPEN_IN_COMPONENTS_LOCALLY_CONNECTED",OPEN_IN_COMPONENTS_LOCALLY_CONNECTED; "OPEN_IN_CONIC_HULL",OPEN_IN_CONIC_HULL; "OPEN_IN_CONNECTED_COMPONENT",OPEN_IN_CONNECTED_COMPONENT; "OPEN_IN_CONNECTED_COMPONENTS",OPEN_IN_CONNECTED_COMPONENTS; "OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED",OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; "OPEN_IN_CONTAINS_BALL",OPEN_IN_CONTAINS_BALL; "OPEN_IN_CONTAINS_CBALL",OPEN_IN_CONTAINS_CBALL; "OPEN_IN_CONVEX_MEETS_RELATIVE_INTERIOR",OPEN_IN_CONVEX_MEETS_RELATIVE_INTERIOR; "OPEN_IN_DELETE",OPEN_IN_DELETE; "OPEN_IN_DIFF",OPEN_IN_DIFF; "OPEN_IN_DIFF_CLOSED",OPEN_IN_DIFF_CLOSED; "OPEN_IN_EMPTY",OPEN_IN_EMPTY; "OPEN_IN_EUCLIDEAN",OPEN_IN_EUCLIDEAN; "OPEN_IN_FSIGMA",OPEN_IN_FSIGMA; "OPEN_IN_GDELTA",OPEN_IN_GDELTA; "OPEN_IN_IMP_LOCALLY_PATH_CONNECTED",OPEN_IN_IMP_LOCALLY_PATH_CONNECTED; "OPEN_IN_IMP_SUBSET",OPEN_IN_IMP_SUBSET; "OPEN_IN_INJECTIVE_LINEAR_IMAGE",OPEN_IN_INJECTIVE_LINEAR_IMAGE; "OPEN_IN_INTER",OPEN_IN_INTER; "OPEN_IN_INTERIOR_OF",OPEN_IN_INTERIOR_OF; "OPEN_IN_INTERS",OPEN_IN_INTERS; "OPEN_IN_INTER_CLOSURE_EQ_EMPTY",OPEN_IN_INTER_CLOSURE_EQ_EMPTY; "OPEN_IN_INTER_CLOSURE_OF_EQ",OPEN_IN_INTER_CLOSURE_OF_EQ; "OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY",OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY; "OPEN_IN_INTER_CLOSURE_OF_SUBSET",OPEN_IN_INTER_CLOSURE_OF_SUBSET; "OPEN_IN_INTER_OPEN",OPEN_IN_INTER_OPEN; "OPEN_IN_LOCALLY_COMPACT",OPEN_IN_LOCALLY_COMPACT; "OPEN_IN_MBALL",OPEN_IN_MBALL; "OPEN_IN_MTOPOLOGY",OPEN_IN_MTOPOLOGY; "OPEN_IN_MTOPOLOGY_MCBALL",OPEN_IN_MTOPOLOGY_MCBALL; "OPEN_IN_OPEN",OPEN_IN_OPEN; "OPEN_IN_OPEN_EQ",OPEN_IN_OPEN_EQ; "OPEN_IN_OPEN_INTER",OPEN_IN_OPEN_INTER; "OPEN_IN_OPEN_TRANS",OPEN_IN_OPEN_TRANS; "OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; "OPEN_IN_PCROSS",OPEN_IN_PCROSS; "OPEN_IN_PCROSS_EQ",OPEN_IN_PCROSS_EQ; "OPEN_IN_REFL",OPEN_IN_REFL; "OPEN_IN_RELATIVE_FRONTIER_INTERIOR_FACET",OPEN_IN_RELATIVE_FRONTIER_INTERIOR_FACET; "OPEN_IN_RELATIVE_INTERIOR",OPEN_IN_RELATIVE_INTERIOR; "OPEN_IN_RELATIVE_TO",OPEN_IN_RELATIVE_TO; "OPEN_IN_SAME_CONIC_HULL",OPEN_IN_SAME_CONIC_HULL; "OPEN_IN_SEGMENT",OPEN_IN_SEGMENT; "OPEN_IN_SEPARATED_UNION",OPEN_IN_SEPARATED_UNION; "OPEN_IN_SET_RELATIVE_INTERIOR",OPEN_IN_SET_RELATIVE_INTERIOR; "OPEN_IN_SING",OPEN_IN_SING; "OPEN_IN_SUBOPEN",OPEN_IN_SUBOPEN; "OPEN_IN_SUBSET",OPEN_IN_SUBSET; "OPEN_IN_SUBSET_RELATIVE_INTERIOR",OPEN_IN_SUBSET_RELATIVE_INTERIOR; "OPEN_IN_SUBSET_TRANS",OPEN_IN_SUBSET_TRANS; "OPEN_IN_SUBTOPOLOGY",OPEN_IN_SUBTOPOLOGY; "OPEN_IN_SUBTOPOLOGY_EMPTY",OPEN_IN_SUBTOPOLOGY_EMPTY; "OPEN_IN_SUBTOPOLOGY_INTER_SUBSET",OPEN_IN_SUBTOPOLOGY_INTER_SUBSET; "OPEN_IN_SUBTOPOLOGY_REFL",OPEN_IN_SUBTOPOLOGY_REFL; "OPEN_IN_SUBTOPOLOGY_UNION",OPEN_IN_SUBTOPOLOGY_UNION; "OPEN_IN_TOPSPACE",OPEN_IN_TOPSPACE; "OPEN_IN_TRANS",OPEN_IN_TRANS; "OPEN_IN_TRANSLATION_EQ",OPEN_IN_TRANSLATION_EQ; "OPEN_IN_TRANS_EQ",OPEN_IN_TRANS_EQ; "OPEN_IN_UNION",OPEN_IN_UNION; "OPEN_IN_UNIONS",OPEN_IN_UNIONS; "OPEN_LIFT",OPEN_LIFT; "OPEN_MAPPING_THM",OPEN_MAPPING_THM; "OPEN_MAP_CLOSED_SUPERSET_PREIMAGE",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE; "OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ; "OPEN_MAP_FROM_COMPOSITION_INJECTIVE",OPEN_MAP_FROM_COMPOSITION_INJECTIVE; "OPEN_MAP_FROM_COMPOSITION_SURJECTIVE",OPEN_MAP_FROM_COMPOSITION_SURJECTIVE; "OPEN_MAP_IFF_CLOSED_MAP_BIJECTIVE",OPEN_MAP_IFF_CLOSED_MAP_BIJECTIVE; "OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE",OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE; "OPEN_MAP_IMP_CLOSED_MAP",OPEN_MAP_IMP_CLOSED_MAP; "OPEN_MAP_IMP_QUOTIENT_MAP",OPEN_MAP_IMP_QUOTIENT_MAP; "OPEN_MAP_INTERIORS",OPEN_MAP_INTERIORS; "OPEN_MAP_RESTRICT",OPEN_MAP_RESTRICT; "OPEN_MEASURABLE_INNER_DIVISION",OPEN_MEASURABLE_INNER_DIVISION; "OPEN_NEGATIONS",OPEN_NEGATIONS; "OPEN_NON_GENERAL_COMPONENT",OPEN_NON_GENERAL_COMPONENT; "OPEN_NON_PATH_COMPONENT",OPEN_NON_PATH_COMPONENT; "OPEN_NOT_NEGLIGIBLE",OPEN_NOT_NEGLIGIBLE; "OPEN_OPEN_IN_TRANS",OPEN_OPEN_IN_TRANS; "OPEN_OPEN_LEFT_PROJECTION",OPEN_OPEN_LEFT_PROJECTION; "OPEN_OPEN_RIGHT_PROJECTION",OPEN_OPEN_RIGHT_PROJECTION; "OPEN_OUTSIDE",OPEN_OUTSIDE; "OPEN_PATH_COMPONENT",OPEN_PATH_COMPONENT; "OPEN_PATH_CONNECTED_COMPONENT",OPEN_PATH_CONNECTED_COMPONENT; "OPEN_PCROSS",OPEN_PCROSS; "OPEN_PCROSS_EQ",OPEN_PCROSS_EQ; "OPEN_POSITIVE_MULTIPLES",OPEN_POSITIVE_MULTIPLES; "OPEN_POSITIVE_ORTHANT",OPEN_POSITIVE_ORTHANT; "OPEN_RELATIVE_TO",OPEN_RELATIVE_TO; "OPEN_SCALING",OPEN_SCALING; "OPEN_SCALING_EQ",OPEN_SCALING_EQ; "OPEN_SEGMENT_1",OPEN_SEGMENT_1; "OPEN_SEGMENT_ALT",OPEN_SEGMENT_ALT; "OPEN_SEGMENT_DESCALE",OPEN_SEGMENT_DESCALE; "OPEN_SEGMENT_LINEAR_IMAGE",OPEN_SEGMENT_LINEAR_IMAGE; "OPEN_SEGMENT_SUBSET_BALL",OPEN_SEGMENT_SUBSET_BALL; "OPEN_SET_COCOUNTABLE_COORDINATES",OPEN_SET_COCOUNTABLE_COORDINATES; "OPEN_SET_COSMALL_COORDINATES",OPEN_SET_COSMALL_COORDINATES; "OPEN_SET_IRRATIONAL_COORDINATES",OPEN_SET_IRRATIONAL_COORDINATES; "OPEN_SET_RATIONAL_COORDINATES",OPEN_SET_RATIONAL_COORDINATES; "OPEN_SLICE",OPEN_SLICE; "OPEN_STRIP_COMPONENT_LT",OPEN_STRIP_COMPONENT_LT; "OPEN_SUBOPEN",OPEN_SUBOPEN; "OPEN_SUBSET",OPEN_SUBSET; "OPEN_SUMS",OPEN_SUMS; "OPEN_SURJECTIVE_LINEAR_IMAGE",OPEN_SURJECTIVE_LINEAR_IMAGE; "OPEN_TRANSLATION",OPEN_TRANSLATION; "OPEN_TRANSLATION_EQ",OPEN_TRANSLATION_EQ; "OPEN_TRANSLATION_SUBSET_PREIMAGE",OPEN_TRANSLATION_SUBSET_PREIMAGE; "OPEN_UNICOHERENT_UNIV",OPEN_UNICOHERENT_UNIV; "OPEN_UNION",OPEN_UNION; "OPEN_UNIONS",OPEN_UNIONS; "OPEN_UNION_COMPACT_SUBSETS",OPEN_UNION_COMPACT_SUBSETS; "OPEN_UNIV",OPEN_UNIV; "OPEN_WINDING_NUMBER_LEVELSETS",OPEN_WINDING_NUMBER_LEVELSETS; "OPERATIVE_1_LE",OPERATIVE_1_LE; "OPERATIVE_1_LT",OPERATIVE_1_LT; "OPERATIVE_ABSOLUTELY_CONTINUOUS_ON",OPERATIVE_ABSOLUTELY_CONTINUOUS_ON; "OPERATIVE_ABSOLUTELY_SETCONTINUOUS_ON",OPERATIVE_ABSOLUTELY_SETCONTINUOUS_ON; "OPERATIVE_APPROXIMABLE",OPERATIVE_APPROXIMABLE; "OPERATIVE_CONTENT",OPERATIVE_CONTENT; "OPERATIVE_DIVISION",OPERATIVE_DIVISION; "OPERATIVE_DIVISION_AND",OPERATIVE_DIVISION_AND; "OPERATIVE_EMPTY",OPERATIVE_EMPTY; "OPERATIVE_FUNCTION_ENDPOINT_DIFF",OPERATIVE_FUNCTION_ENDPOINT_DIFF; "OPERATIVE_HAS_BOUNDED_SETVARIATION_ON",OPERATIVE_HAS_BOUNDED_SETVARIATION_ON; "OPERATIVE_HAS_BOUNDED_VARIATION_ON",OPERATIVE_HAS_BOUNDED_VARIATION_ON; "OPERATIVE_INTEGRABLE",OPERATIVE_INTEGRABLE; "OPERATIVE_INTEGRAL",OPERATIVE_INTEGRAL; "OPERATIVE_LIFTED_SETVARIATION",OPERATIVE_LIFTED_SETVARIATION; "OPERATIVE_LIFTED_VECTOR_VARIATION",OPERATIVE_LIFTED_VECTOR_VARIATION; "OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF",OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF; "OPERATIVE_TAGGED_DIVISION",OPERATIVE_TAGGED_DIVISION; "OPERATIVE_TRIVIAL",OPERATIVE_TRIVIAL; "ORDER_EXISTENCE_CARD",ORDER_EXISTENCE_CARD; "ORDER_EXISTENCE_FINITE",ORDER_EXISTENCE_FINITE; "ORDER_EXISTENCE_GEN",ORDER_EXISTENCE_GEN; "ORDER_EXISTENCE_ITER",ORDER_EXISTENCE_ITER; "ORDINAL_CHAINED",ORDINAL_CHAINED; "ORDINAL_CHAINED_LEMMA",ORDINAL_CHAINED_LEMMA; "ORDINAL_FL_SUBSET",ORDINAL_FL_SUBSET; "ORDINAL_FL_SUBSET_EQ",ORDINAL_FL_SUBSET_EQ; "ORDINAL_FL_UNIQUE",ORDINAL_FL_UNIQUE; "ORDINAL_IMP_WOSET",ORDINAL_IMP_WOSET; "ORDINAL_SUC",ORDINAL_SUC; "ORDINAL_UNION",ORDINAL_UNION; "ORDINAL_UNION_LEMMA",ORDINAL_UNION_LEMMA; "ORDINAL_UP",ORDINAL_UP; "ORIENTING_PERTURBATION_EXISTS",ORIENTING_PERTURBATION_EXISTS; "ORTHOGONALITY_PRESERVING_EQ_SIMILARITY",ORTHOGONALITY_PRESERVING_EQ_SIMILARITY; "ORTHOGONALITY_PRESERVING_EQ_SIMILARITY_ALT",ORTHOGONALITY_PRESERVING_EQ_SIMILARITY_ALT; "ORTHOGONALITY_PRESERVING_IMP_SCALING",ORTHOGONALITY_PRESERVING_IMP_SCALING; "ORTHOGONAL_0",ORTHOGONAL_0; "ORTHOGONAL_AND_COLLINEAR",ORTHOGONAL_AND_COLLINEAR; "ORTHOGONAL_ANY_CLOSEST_POINT",ORTHOGONAL_ANY_CLOSEST_POINT; "ORTHOGONAL_BASIS",ORTHOGONAL_BASIS; "ORTHOGONAL_BASIS_BASIS",ORTHOGONAL_BASIS_BASIS; "ORTHOGONAL_BASIS_EXISTS",ORTHOGONAL_BASIS_EXISTS; "ORTHOGONAL_BASIS_SUBSPACE",ORTHOGONAL_BASIS_SUBSPACE; "ORTHOGONAL_CLAUSES",ORTHOGONAL_CLAUSES; "ORTHOGONAL_EXTENSION",ORTHOGONAL_EXTENSION; "ORTHOGONAL_EXTENSION_STRONG",ORTHOGONAL_EXTENSION_STRONG; "ORTHOGONAL_IMP_INDEPENDENT_SUBSPACES",ORTHOGONAL_IMP_INDEPENDENT_SUBSPACES; "ORTHOGONAL_LINEAR_IMAGE_EQ",ORTHOGONAL_LINEAR_IMAGE_EQ; "ORTHOGONAL_LNEG",ORTHOGONAL_LNEG; "ORTHOGONAL_LVSUM",ORTHOGONAL_LVSUM; "ORTHOGONAL_MATRIX",ORTHOGONAL_MATRIX; "ORTHOGONAL_MATRIX_1",ORTHOGONAL_MATRIX_1; "ORTHOGONAL_MATRIX_2",ORTHOGONAL_MATRIX_2; "ORTHOGONAL_MATRIX_2_ALT",ORTHOGONAL_MATRIX_2_ALT; "ORTHOGONAL_MATRIX_ALT",ORTHOGONAL_MATRIX_ALT; "ORTHOGONAL_MATRIX_EXISTS_BASIS",ORTHOGONAL_MATRIX_EXISTS_BASIS; "ORTHOGONAL_MATRIX_ID",ORTHOGONAL_MATRIX_ID; "ORTHOGONAL_MATRIX_IMP_INVERTIBLE",ORTHOGONAL_MATRIX_IMP_INVERTIBLE; "ORTHOGONAL_MATRIX_INV",ORTHOGONAL_MATRIX_INV; "ORTHOGONAL_MATRIX_INV_EQ",ORTHOGONAL_MATRIX_INV_EQ; "ORTHOGONAL_MATRIX_MATRIX",ORTHOGONAL_MATRIX_MATRIX; "ORTHOGONAL_MATRIX_MUL",ORTHOGONAL_MATRIX_MUL; "ORTHOGONAL_MATRIX_NORM",ORTHOGONAL_MATRIX_NORM; "ORTHOGONAL_MATRIX_NORM_EQ",ORTHOGONAL_MATRIX_NORM_EQ; "ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN; "ORTHOGONAL_MATRIX_TRANSFORMATION",ORTHOGONAL_MATRIX_TRANSFORMATION; "ORTHOGONAL_MATRIX_TRANSP",ORTHOGONAL_MATRIX_TRANSP; "ORTHOGONAL_MATRIX_TRANSP_LMUL",ORTHOGONAL_MATRIX_TRANSP_LMUL; "ORTHOGONAL_MATRIX_TRANSP_RMUL",ORTHOGONAL_MATRIX_TRANSP_RMUL; "ORTHOGONAL_MUL",ORTHOGONAL_MUL; "ORTHOGONAL_NULLSPACE_ROWSPACE",ORTHOGONAL_NULLSPACE_ROWSPACE; "ORTHOGONAL_ORTHOGONAL_TRANSFORMATION",ORTHOGONAL_ORTHOGONAL_TRANSFORMATION; "ORTHOGONAL_PROJECTION_ALT",ORTHOGONAL_PROJECTION_ALT; "ORTHOGONAL_PROJECTION_EQ_SELF_ADJOINT_IDEMPOTENT",ORTHOGONAL_PROJECTION_EQ_SELF_ADJOINT_IDEMPOTENT; "ORTHOGONAL_REFL",ORTHOGONAL_REFL; "ORTHOGONAL_RNEG",ORTHOGONAL_RNEG; "ORTHOGONAL_ROTATION_OR_ROTOINVERSION",ORTHOGONAL_ROTATION_OR_ROTOINVERSION; "ORTHOGONAL_RVSUM",ORTHOGONAL_RVSUM; "ORTHOGONAL_SPANNINGSET_SUBSPACE",ORTHOGONAL_SPANNINGSET_SUBSPACE; "ORTHOGONAL_SUBSPACE_DECOMP",ORTHOGONAL_SUBSPACE_DECOMP; "ORTHOGONAL_SUBSPACE_DECOMP_EXISTS",ORTHOGONAL_SUBSPACE_DECOMP_EXISTS; "ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE",ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE; "ORTHOGONAL_SYM",ORTHOGONAL_SYM; "ORTHOGONAL_TO_ORTHOGONAL_2D",ORTHOGONAL_TO_ORTHOGONAL_2D; "ORTHOGONAL_TO_SPAN",ORTHOGONAL_TO_SPAN; "ORTHOGONAL_TO_SPANS_EQ",ORTHOGONAL_TO_SPANS_EQ; "ORTHOGONAL_TO_SPAN_EQ",ORTHOGONAL_TO_SPAN_EQ; "ORTHOGONAL_TO_SUBSPACE_EXISTS",ORTHOGONAL_TO_SUBSPACE_EXISTS; "ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN",ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN; "ORTHOGONAL_TO_VECTOR_EXISTS",ORTHOGONAL_TO_VECTOR_EXISTS; "ORTHOGONAL_TRANSFORMATION",ORTHOGONAL_TRANSFORMATION; "ORTHOGONAL_TRANSFORMATION_1_GEN",ORTHOGONAL_TRANSFORMATION_1_GEN; "ORTHOGONAL_TRANSFORMATION_ADJOINT",ORTHOGONAL_TRANSFORMATION_ADJOINT; "ORTHOGONAL_TRANSFORMATION_BALL",ORTHOGONAL_TRANSFORMATION_BALL; "ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS",ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS; "ORTHOGONAL_TRANSFORMATION_CBALL",ORTHOGONAL_TRANSFORMATION_CBALL; "ORTHOGONAL_TRANSFORMATION_CNJ",ORTHOGONAL_TRANSFORMATION_CNJ; "ORTHOGONAL_TRANSFORMATION_COMPLEX_MUL",ORTHOGONAL_TRANSFORMATION_COMPLEX_MUL; "ORTHOGONAL_TRANSFORMATION_COMPOSE",ORTHOGONAL_TRANSFORMATION_COMPOSE; "ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT",ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT; "ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT",ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT; "ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_RIGHT",ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_RIGHT; "ORTHOGONAL_TRANSFORMATION_EXISTS",ORTHOGONAL_TRANSFORMATION_EXISTS; "ORTHOGONAL_TRANSFORMATION_EXISTS_1",ORTHOGONAL_TRANSFORMATION_EXISTS_1; "ORTHOGONAL_TRANSFORMATION_EXISTS_GEN",ORTHOGONAL_TRANSFORMATION_EXISTS_GEN; "ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS",ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS; "ORTHOGONAL_TRANSFORMATION_I",ORTHOGONAL_TRANSFORMATION_I; "ORTHOGONAL_TRANSFORMATION_ID",ORTHOGONAL_TRANSFORMATION_ID; "ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM",ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM; "ORTHOGONAL_TRANSFORMATION_INJECTIVE",ORTHOGONAL_TRANSFORMATION_INJECTIVE; "ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE; "ORTHOGONAL_TRANSFORMATION_INVERSE",ORTHOGONAL_TRANSFORMATION_INVERSE; "ORTHOGONAL_TRANSFORMATION_INVERSE_o",ORTHOGONAL_TRANSFORMATION_INVERSE_o; "ORTHOGONAL_TRANSFORMATION_ISOMETRY",ORTHOGONAL_TRANSFORMATION_ISOMETRY; "ORTHOGONAL_TRANSFORMATION_LINEAR",ORTHOGONAL_TRANSFORMATION_LINEAR; "ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL",ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL; "ORTHOGONAL_TRANSFORMATION_MATRIX",ORTHOGONAL_TRANSFORMATION_MATRIX; "ORTHOGONAL_TRANSFORMATION_NEG",ORTHOGONAL_TRANSFORMATION_NEG; "ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE; "ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS; "ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG",ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG; "ORTHOGONAL_TRANSFORMATION_ROTATE2D",ORTHOGONAL_TRANSFORMATION_ROTATE2D; "ORTHOGONAL_TRANSFORMATION_SPHERE",ORTHOGONAL_TRANSFORMATION_SPHERE; "ORTHOGONAL_TRANSFORMATION_SURJECTIVE",ORTHOGONAL_TRANSFORMATION_SURJECTIVE; "ORTHONORMAL_BASIS_EXPAND",ORTHONORMAL_BASIS_EXPAND; "ORTHONORMAL_BASIS_EXPAND_DOT",ORTHONORMAL_BASIS_EXPAND_DOT; "ORTHONORMAL_BASIS_EXPAND_NORM",ORTHONORMAL_BASIS_EXPAND_NORM; "ORTHONORMAL_BASIS_SUBSPACE",ORTHONORMAL_BASIS_SUBSPACE; "ORTHONORMAL_EXTENSION",ORTHONORMAL_EXTENSION; "OR_CLAUSES",OR_CLAUSES; "OR_DEF",OR_DEF; "OR_EXISTS_THM",OR_EXISTS_THM; "OSTROWSKI_THEOREM",OSTROWSKI_THEOREM; "OUTER",OUTER; "OUTERMORPHISM_MBASIS",OUTERMORPHISM_MBASIS; "OUTERMORPHISM_MBASIS_EMPTY",OUTERMORPHISM_MBASIS_EMPTY; "OUTER_ACI",OUTER_ACI; "OUTER_ASSOC",OUTER_ASSOC; "OUTER_LADD",OUTER_LADD; "OUTER_LEBESGUE_MEASURE",OUTER_LEBESGUE_MEASURE; "OUTER_LMUL",OUTER_LMUL; "OUTER_LNEG",OUTER_LNEG; "OUTER_LZERO",OUTER_LZERO; "OUTER_MBASIS",OUTER_MBASIS; "OUTER_MBASIS_LSCALAR",OUTER_MBASIS_LSCALAR; "OUTER_MBASIS_REFL",OUTER_MBASIS_REFL; "OUTER_MBASIS_RSCALAR",OUTER_MBASIS_RSCALAR; "OUTER_MBASIS_SING",OUTER_MBASIS_SING; "OUTER_MBASIS_SKEWSYM",OUTER_MBASIS_SKEWSYM; "OUTER_MEASURE",OUTER_MEASURE; "OUTER_MEASURE_EQ",OUTER_MEASURE_EQ; "OUTER_MEASURE_GEN",OUTER_MEASURE_GEN; "OUTER_RADD",OUTER_RADD; "OUTER_RMUL",OUTER_RMUL; "OUTER_RNEG",OUTER_RNEG; "OUTER_RZERO",OUTER_RZERO; "OUTL",OUTL; "OUTR",OUTR; "OUTSIDE",OUTSIDE; "OUTSIDE_BOUNDED_NONEMPTY",OUTSIDE_BOUNDED_NONEMPTY; "OUTSIDE_COMPACT_IN_OPEN",OUTSIDE_COMPACT_IN_OPEN; "OUTSIDE_CONNECTED_COMPONENT_LE",OUTSIDE_CONNECTED_COMPONENT_LE; "OUTSIDE_CONNECTED_COMPONENT_LT",OUTSIDE_CONNECTED_COMPONENT_LT; "OUTSIDE_CONVEX",OUTSIDE_CONVEX; "OUTSIDE_EMPTY",OUTSIDE_EMPTY; "OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT",OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT; "OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE",OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE; "OUTSIDE_FRONTIER_MISSES_CLOSURE",OUTSIDE_FRONTIER_MISSES_CLOSURE; "OUTSIDE_INSIDE",OUTSIDE_INSIDE; "OUTSIDE_IN_COMPONENTS",OUTSIDE_IN_COMPONENTS; "OUTSIDE_LINEAR_IMAGE",OUTSIDE_LINEAR_IMAGE; "OUTSIDE_MONO",OUTSIDE_MONO; "OUTSIDE_NO_OVERLAP",OUTSIDE_NO_OVERLAP; "OUTSIDE_SAME_COMPONENT",OUTSIDE_SAME_COMPONENT; "OUTSIDE_SPHERE",OUTSIDE_SPHERE; "OUTSIDE_SUBSET_CONVEX",OUTSIDE_SUBSET_CONVEX; "OUTSIDE_TRANSLATION",OUTSIDE_TRANSLATION; "OUTSIDE_UNION_OUTSIDE_UNION",OUTSIDE_UNION_OUTSIDE_UNION; "OUTSIDE_WITH_OUTSIDE",OUTSIDE_WITH_OUTSIDE; "PAIR",PAIR; "PAIRED_ETA_THM",PAIRED_ETA_THM; "PAIRED_EXT",PAIRED_EXT; "PAIRWISE",PAIRWISE; "PAIRWISE_AND",PAIRWISE_AND; "PAIRWISE_APPEND",PAIRWISE_APPEND; "PAIRWISE_CHAIN_UNIONS",PAIRWISE_CHAIN_UNIONS; "PAIRWISE_DISJOINT_COMPONENTS",PAIRWISE_DISJOINT_COMPONENTS; "PAIRWISE_DISJOINT_LEBESGUE_MEASURABLE_IMP_COUNTABLE",PAIRWISE_DISJOINT_LEBESGUE_MEASURABLE_IMP_COUNTABLE; "PAIRWISE_EMPTY",PAIRWISE_EMPTY; "PAIRWISE_IMAGE",PAIRWISE_IMAGE; "PAIRWISE_IMP",PAIRWISE_IMP; "PAIRWISE_IMPLIES",PAIRWISE_IMPLIES; "PAIRWISE_INSERT",PAIRWISE_INSERT; "PAIRWISE_MAP",PAIRWISE_MAP; "PAIRWISE_MONO",PAIRWISE_MONO; "PAIRWISE_ORTHOGONAL_IMP_FINITE",PAIRWISE_ORTHOGONAL_IMP_FINITE; "PAIRWISE_ORTHOGONAL_INDEPENDENT",PAIRWISE_ORTHOGONAL_INDEPENDENT; "PAIRWISE_SING",PAIRWISE_SING; "PAIRWISE_TRANSITIVE",PAIRWISE_TRANSITIVE; "PAIRWISE_UNION",PAIRWISE_UNION; "PAIR_EQ",PAIR_EQ; "PAIR_EXISTS_THM",PAIR_EXISTS_THM; "PAIR_SURJECTIVE",PAIR_SURJECTIVE; "PARACOMPACT",PARACOMPACT; "PARACOMPACT_CLOSED",PARACOMPACT_CLOSED; "PARACOMPACT_CLOSED_IN",PARACOMPACT_CLOSED_IN; "PARTIAL_DIVISION_EXTEND",PARTIAL_DIVISION_EXTEND; "PARTIAL_DIVISION_EXTEND_1",PARTIAL_DIVISION_EXTEND_1; "PARTIAL_DIVISION_EXTEND_INTERVAL",PARTIAL_DIVISION_EXTEND_INTERVAL; "PARTIAL_DIVISION_OF_TAGGED_DIVISION",PARTIAL_DIVISION_OF_TAGGED_DIVISION; "PARTIAL_SUMS_COMPONENT_LE_INFSUM",PARTIAL_SUMS_COMPONENT_LE_INFSUM; "PARTIAL_SUMS_DROP_LE_INFSUM",PARTIAL_SUMS_DROP_LE_INFSUM; "PART_MEASURES",PART_MEASURES; "PASSOC_DEF",PASSOC_DEF; "PASTECART_ADD",PASTECART_ADD; "PASTECART_AS_ORTHOGONAL_SUM",PASTECART_AS_ORTHOGONAL_SUM; "PASTECART_CMUL",PASTECART_CMUL; "PASTECART_EQ",PASTECART_EQ; "PASTECART_EQ_VEC",PASTECART_EQ_VEC; "PASTECART_FST_SND",PASTECART_FST_SND; "PASTECART_INJ",PASTECART_INJ; "PASTECART_IN_INTERIOR",PASTECART_IN_INTERIOR; "PASTECART_IN_INTERIOR_SUBTOPOLOGY",PASTECART_IN_INTERIOR_SUBTOPOLOGY; "PASTECART_IN_PCROSS",PASTECART_IN_PCROSS; "PASTECART_NEG",PASTECART_NEG; "PASTECART_SUB",PASTECART_SUB; "PASTECART_VEC",PASTECART_VEC; "PASTECART_VSUM",PASTECART_VSUM; "PASTING_LEMMA",PASTING_LEMMA; "PASTING_LEMMA_CLOSED",PASTING_LEMMA_CLOSED; "PASTING_LEMMA_EXISTS",PASTING_LEMMA_EXISTS; "PASTING_LEMMA_EXISTS_CLOSED",PASTING_LEMMA_EXISTS_CLOSED; "PASTING_LEMMA_EXISTS_LOCALLY_FINITE",PASTING_LEMMA_EXISTS_LOCALLY_FINITE; "PASTING_LEMMA_LOCALLY_FINITE",PASTING_LEMMA_LOCALLY_FINITE; "PATHFINISH_CIRCLEPATH",PATHFINISH_CIRCLEPATH; "PATHFINISH_COMPOSE",PATHFINISH_COMPOSE; "PATHFINISH_IN_PATH_IMAGE",PATHFINISH_IN_PATH_IMAGE; "PATHFINISH_JOIN",PATHFINISH_JOIN; "PATHFINISH_LINEAR_IMAGE",PATHFINISH_LINEAR_IMAGE; "PATHFINISH_LINEPATH",PATHFINISH_LINEPATH; "PATHFINISH_PARTCIRCLEPATH",PATHFINISH_PARTCIRCLEPATH; "PATHFINISH_REVERSEPATH",PATHFINISH_REVERSEPATH; "PATHFINISH_SHIFTPATH",PATHFINISH_SHIFTPATH; "PATHFINISH_SUBPATH",PATHFINISH_SUBPATH; "PATHFINISH_TRANSLATION",PATHFINISH_TRANSLATION; "PATHINTEGRAL_CONVEX_PRIMITIVE",PATHINTEGRAL_CONVEX_PRIMITIVE; "PATHSTART_CIRCLEPATH",PATHSTART_CIRCLEPATH; "PATHSTART_COMPOSE",PATHSTART_COMPOSE; "PATHSTART_IN_PATH_IMAGE",PATHSTART_IN_PATH_IMAGE; "PATHSTART_JOIN",PATHSTART_JOIN; "PATHSTART_LINEAR_IMAGE_EQ",PATHSTART_LINEAR_IMAGE_EQ; "PATHSTART_LINEPATH",PATHSTART_LINEPATH; "PATHSTART_PARTCIRCLEPATH",PATHSTART_PARTCIRCLEPATH; "PATHSTART_REVERSEPATH",PATHSTART_REVERSEPATH; "PATHSTART_SHIFTPATH",PATHSTART_SHIFTPATH; "PATHSTART_SUBPATH",PATHSTART_SUBPATH; "PATHSTART_TRANSLATION",PATHSTART_TRANSLATION; "PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION",PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION; "PATH_ASSOC",PATH_ASSOC; "PATH_CIRCLEPATH",PATH_CIRCLEPATH; "PATH_COMBINE",PATH_COMBINE; "PATH_COMPONENT",PATH_COMPONENT; "PATH_COMPONENT_DISJOINT",PATH_COMPONENT_DISJOINT; "PATH_COMPONENT_EMPTY",PATH_COMPONENT_EMPTY; "PATH_COMPONENT_EQ",PATH_COMPONENT_EQ; "PATH_COMPONENT_EQ_CONNECTED_COMPONENT",PATH_COMPONENT_EQ_CONNECTED_COMPONENT; "PATH_COMPONENT_EQ_EMPTY",PATH_COMPONENT_EQ_EMPTY; "PATH_COMPONENT_EQ_EQ",PATH_COMPONENT_EQ_EQ; "PATH_COMPONENT_IMP_CONNECTED_COMPONENT",PATH_COMPONENT_IMP_CONNECTED_COMPONENT; "PATH_COMPONENT_IMP_HOMOTOPIC_POINTS",PATH_COMPONENT_IMP_HOMOTOPIC_POINTS; "PATH_COMPONENT_IN",PATH_COMPONENT_IN; "PATH_COMPONENT_INTERMEDIATE_SUBSET",PATH_COMPONENT_INTERMEDIATE_SUBSET; "PATH_COMPONENT_LINEAR_IMAGE",PATH_COMPONENT_LINEAR_IMAGE; "PATH_COMPONENT_MAXIMAL",PATH_COMPONENT_MAXIMAL; "PATH_COMPONENT_MONO",PATH_COMPONENT_MONO; "PATH_COMPONENT_OF_SUBSET",PATH_COMPONENT_OF_SUBSET; "PATH_COMPONENT_PATH_COMPONENT",PATH_COMPONENT_PATH_COMPONENT; "PATH_COMPONENT_PATH_IMAGE_PATHSTART",PATH_COMPONENT_PATH_IMAGE_PATHSTART; "PATH_COMPONENT_PCROSS",PATH_COMPONENT_PCROSS; "PATH_COMPONENT_REFL",PATH_COMPONENT_REFL; "PATH_COMPONENT_REFL_EQ",PATH_COMPONENT_REFL_EQ; "PATH_COMPONENT_SET",PATH_COMPONENT_SET; "PATH_COMPONENT_SUBSET",PATH_COMPONENT_SUBSET; "PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT",PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; "PATH_COMPONENT_SYM",PATH_COMPONENT_SYM; "PATH_COMPONENT_SYM_EQ",PATH_COMPONENT_SYM_EQ; "PATH_COMPONENT_TRANS",PATH_COMPONENT_TRANS; "PATH_COMPONENT_TRANSLATION",PATH_COMPONENT_TRANSLATION; "PATH_COMPONENT_UNIQUE",PATH_COMPONENT_UNIQUE; "PATH_COMPONENT_UNIV",PATH_COMPONENT_UNIV; "PATH_COMPOSE_JOIN",PATH_COMPOSE_JOIN; "PATH_COMPOSE_REVERSEPATH",PATH_COMPOSE_REVERSEPATH; "PATH_CONNECTED_AFFINITY",PATH_CONNECTED_AFFINITY; "PATH_CONNECTED_AFFINITY_EQ",PATH_CONNECTED_AFFINITY_EQ; "PATH_CONNECTED_ANNULUS",PATH_CONNECTED_ANNULUS; "PATH_CONNECTED_ARCWISE",PATH_CONNECTED_ARCWISE; "PATH_CONNECTED_ARC_COMPLEMENT",PATH_CONNECTED_ARC_COMPLEMENT; "PATH_CONNECTED_CLOSURE_FROM_FRONTIER",PATH_CONNECTED_CLOSURE_FROM_FRONTIER; "PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; "PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX",PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX; "PATH_CONNECTED_COMPLEMENT_CARD_LT",PATH_CONNECTED_COMPLEMENT_CARD_LT; "PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; "PATH_CONNECTED_COMPONENT_SET",PATH_CONNECTED_COMPONENT_SET; "PATH_CONNECTED_CONNECTED_DIFF",PATH_CONNECTED_CONNECTED_DIFF; "PATH_CONNECTED_CONTINUOUS_IMAGE",PATH_CONNECTED_CONTINUOUS_IMAGE; "PATH_CONNECTED_CONVEX_DIFF_CARD_LT",PATH_CONNECTED_CONVEX_DIFF_CARD_LT; "PATH_CONNECTED_CONVEX_DIFF_COUNTABLE",PATH_CONNECTED_CONVEX_DIFF_COUNTABLE; "PATH_CONNECTED_CONVEX_DIFF_LOWDIM",PATH_CONNECTED_CONVEX_DIFF_LOWDIM; "PATH_CONNECTED_DELETE_INTERIOR_POINT",PATH_CONNECTED_DELETE_INTERIOR_POINT; "PATH_CONNECTED_DIFF_BALL",PATH_CONNECTED_DIFF_BALL; "PATH_CONNECTED_EMPTY",PATH_CONNECTED_EMPTY; "PATH_CONNECTED_EQ_CONNECTED",PATH_CONNECTED_EQ_CONNECTED; "PATH_CONNECTED_EQ_CONNECTED_LPC",PATH_CONNECTED_EQ_CONNECTED_LPC; "PATH_CONNECTED_EQ_HOMOTOPIC_POINTS",PATH_CONNECTED_EQ_HOMOTOPIC_POINTS; "PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER",PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER; "PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL",PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL; "PATH_CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL",PATH_CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL; "PATH_CONNECTED_IFF_PATH_COMPONENT",PATH_CONNECTED_IFF_PATH_COMPONENT; "PATH_CONNECTED_IMP_CONNECTED",PATH_CONNECTED_IMP_CONNECTED; "PATH_CONNECTED_IMP_PATH_COMPONENT",PATH_CONNECTED_IMP_PATH_COMPONENT; "PATH_CONNECTED_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT",PATH_CONNECTED_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT; "PATH_CONNECTED_INTERVAL",PATH_CONNECTED_INTERVAL; "PATH_CONNECTED_LINEAR_IMAGE",PATH_CONNECTED_LINEAR_IMAGE; "PATH_CONNECTED_LINEAR_IMAGE_EQ",PATH_CONNECTED_LINEAR_IMAGE_EQ; "PATH_CONNECTED_LINEPATH",PATH_CONNECTED_LINEPATH; "PATH_CONNECTED_NEGATIONS",PATH_CONNECTED_NEGATIONS; "PATH_CONNECTED_OPEN_ARC_COMPLEMENT",PATH_CONNECTED_OPEN_ARC_COMPLEMENT; "PATH_CONNECTED_OPEN_DELETE",PATH_CONNECTED_OPEN_DELETE; "PATH_CONNECTED_OPEN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_DIFF_CARD_LT; "PATH_CONNECTED_OPEN_DIFF_COUNTABLE",PATH_CONNECTED_OPEN_DIFF_COUNTABLE; "PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT; "PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM",PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM; "PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM",PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM; "PATH_CONNECTED_PATH_COMPONENT",PATH_CONNECTED_PATH_COMPONENT; "PATH_CONNECTED_PATH_IMAGE",PATH_CONNECTED_PATH_IMAGE; "PATH_CONNECTED_PCROSS",PATH_CONNECTED_PCROSS; "PATH_CONNECTED_PCROSS_EQ",PATH_CONNECTED_PCROSS_EQ; "PATH_CONNECTED_PSUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE",PATH_CONNECTED_PSUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE; "PATH_CONNECTED_PUNCTURED_BALL",PATH_CONNECTED_PUNCTURED_BALL; "PATH_CONNECTED_PUNCTURED_CBALL",PATH_CONNECTED_PUNCTURED_CBALL; "PATH_CONNECTED_PUNCTURED_CONVEX",PATH_CONNECTED_PUNCTURED_CONVEX; "PATH_CONNECTED_PUNCTURED_UNIVERSE",PATH_CONNECTED_PUNCTURED_UNIVERSE; "PATH_CONNECTED_REAL",PATH_CONNECTED_REAL; "PATH_CONNECTED_SCALING",PATH_CONNECTED_SCALING; "PATH_CONNECTED_SCALING_EQ",PATH_CONNECTED_SCALING_EQ; "PATH_CONNECTED_SEGMENT",PATH_CONNECTED_SEGMENT; "PATH_CONNECTED_SEMIOPEN_SEGMENT",PATH_CONNECTED_SEMIOPEN_SEGMENT; "PATH_CONNECTED_SING",PATH_CONNECTED_SING; "PATH_CONNECTED_SPHERE",PATH_CONNECTED_SPHERE; "PATH_CONNECTED_SPHERE_EQ",PATH_CONNECTED_SPHERE_EQ; "PATH_CONNECTED_SPHERE_GEN",PATH_CONNECTED_SPHERE_GEN; "PATH_CONNECTED_SUMS",PATH_CONNECTED_SUMS; "PATH_CONNECTED_SUPERSET_COMPLEMENT_ARC_IMAGE",PATH_CONNECTED_SUPERSET_COMPLEMENT_ARC_IMAGE; "PATH_CONNECTED_TRANSLATION",PATH_CONNECTED_TRANSLATION; "PATH_CONNECTED_TRANSLATION_EQ",PATH_CONNECTED_TRANSLATION_EQ; "PATH_CONNECTED_UNION",PATH_CONNECTED_UNION; "PATH_CONNECTED_UNIONS",PATH_CONNECTED_UNIONS; "PATH_CONNECTED_UNIV",PATH_CONNECTED_UNIV; "PATH_CONTAINS_ARC",PATH_CONTAINS_ARC; "PATH_CONTINUOUS_IMAGE",PATH_CONTINUOUS_IMAGE; "PATH_EQ",PATH_EQ; "PATH_IMAGE_CIRCLEPATH",PATH_IMAGE_CIRCLEPATH; "PATH_IMAGE_COMPOSE",PATH_IMAGE_COMPOSE; "PATH_IMAGE_CONST",PATH_IMAGE_CONST; "PATH_IMAGE_JOIN",PATH_IMAGE_JOIN; "PATH_IMAGE_JOIN_SUBSET",PATH_IMAGE_JOIN_SUBSET; "PATH_IMAGE_LINEAR_IMAGE",PATH_IMAGE_LINEAR_IMAGE; "PATH_IMAGE_LINEPATH",PATH_IMAGE_LINEPATH; "PATH_IMAGE_NONEMPTY",PATH_IMAGE_NONEMPTY; "PATH_IMAGE_PARTCIRCLEPATH",PATH_IMAGE_PARTCIRCLEPATH; "PATH_IMAGE_PARTCIRCLEPATH_SUBSET",PATH_IMAGE_PARTCIRCLEPATH_SUBSET; "PATH_IMAGE_PARTCIRCLEPATH_SUBSET_ABS",PATH_IMAGE_PARTCIRCLEPATH_SUBSET_ABS; "PATH_IMAGE_REVERSEPATH",PATH_IMAGE_REVERSEPATH; "PATH_IMAGE_SHIFTPATH",PATH_IMAGE_SHIFTPATH; "PATH_IMAGE_SUBPATH",PATH_IMAGE_SUBPATH; "PATH_IMAGE_SUBPATH_COMBINE",PATH_IMAGE_SUBPATH_COMBINE; "PATH_IMAGE_SUBPATH_GEN",PATH_IMAGE_SUBPATH_GEN; "PATH_IMAGE_SUBPATH_SUBSET",PATH_IMAGE_SUBPATH_SUBSET; "PATH_IMAGE_SYM",PATH_IMAGE_SYM; "PATH_IMAGE_TRANSLATION",PATH_IMAGE_TRANSLATION; "PATH_INTEGRABLE_ADD",PATH_INTEGRABLE_ADD; "PATH_INTEGRABLE_COMPLEX_DIV",PATH_INTEGRABLE_COMPLEX_DIV; "PATH_INTEGRABLE_COMPLEX_LMUL",PATH_INTEGRABLE_COMPLEX_LMUL; "PATH_INTEGRABLE_COMPLEX_RMUL",PATH_INTEGRABLE_COMPLEX_RMUL; "PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH",PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH; "PATH_INTEGRABLE_CONTINUOUS_LINEPATH",PATH_INTEGRABLE_CONTINUOUS_LINEPATH; "PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH",PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH; "PATH_INTEGRABLE_EQ",PATH_INTEGRABLE_EQ; "PATH_INTEGRABLE_HOLOMORPHIC",PATH_INTEGRABLE_HOLOMORPHIC; "PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE",PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE; "PATH_INTEGRABLE_INVERSEDIFF",PATH_INTEGRABLE_INVERSEDIFF; "PATH_INTEGRABLE_JOIN",PATH_INTEGRABLE_JOIN; "PATH_INTEGRABLE_NEG",PATH_INTEGRABLE_NEG; "PATH_INTEGRABLE_ON",PATH_INTEGRABLE_ON; "PATH_INTEGRABLE_REVERSEPATH",PATH_INTEGRABLE_REVERSEPATH; "PATH_INTEGRABLE_REVERSEPATH_EQ",PATH_INTEGRABLE_REVERSEPATH_EQ; "PATH_INTEGRABLE_SUB",PATH_INTEGRABLE_SUB; "PATH_INTEGRABLE_SUBPATH",PATH_INTEGRABLE_SUBPATH; "PATH_INTEGRABLE_SUBPATH_REFL",PATH_INTEGRABLE_SUBPATH_REFL; "PATH_INTEGRABLE_VSUM",PATH_INTEGRABLE_VSUM; "PATH_INTEGRAL_0",PATH_INTEGRAL_0; "PATH_INTEGRAL_ADD",PATH_INTEGRAL_ADD; "PATH_INTEGRAL_BOUND_EXISTS",PATH_INTEGRAL_BOUND_EXISTS; "PATH_INTEGRAL_BOUND_LINEPATH",PATH_INTEGRAL_BOUND_LINEPATH; "PATH_INTEGRAL_COMPLEX_DIV",PATH_INTEGRAL_COMPLEX_DIV; "PATH_INTEGRAL_COMPLEX_LMUL",PATH_INTEGRAL_COMPLEX_LMUL; "PATH_INTEGRAL_COMPLEX_RMUL",PATH_INTEGRAL_COMPLEX_RMUL; "PATH_INTEGRAL_CONST_LINEPATH",PATH_INTEGRAL_CONST_LINEPATH; "PATH_INTEGRAL_EQ",PATH_INTEGRAL_EQ; "PATH_INTEGRAL_EQ_0",PATH_INTEGRAL_EQ_0; "PATH_INTEGRAL_INTEGRAL",PATH_INTEGRAL_INTEGRAL; "PATH_INTEGRAL_JOIN",PATH_INTEGRAL_JOIN; "PATH_INTEGRAL_LOCAL_PRIMITIVE",PATH_INTEGRAL_LOCAL_PRIMITIVE; "PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY",PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY; "PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA",PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA; "PATH_INTEGRAL_MIDPOINT",PATH_INTEGRAL_MIDPOINT; "PATH_INTEGRAL_NEARBY_ENDS",PATH_INTEGRAL_NEARBY_ENDS; "PATH_INTEGRAL_NEARBY_LOOP",PATH_INTEGRAL_NEARBY_LOOP; "PATH_INTEGRAL_NEG",PATH_INTEGRAL_NEG; "PATH_INTEGRAL_PRIMITIVE",PATH_INTEGRAL_PRIMITIVE; "PATH_INTEGRAL_PRIMITIVE_LEMMA",PATH_INTEGRAL_PRIMITIVE_LEMMA; "PATH_INTEGRAL_REVERSEPATH",PATH_INTEGRAL_REVERSEPATH; "PATH_INTEGRAL_REVERSE_LINEPATH",PATH_INTEGRAL_REVERSE_LINEPATH; "PATH_INTEGRAL_SHIFTPATH",PATH_INTEGRAL_SHIFTPATH; "PATH_INTEGRAL_SPLIT",PATH_INTEGRAL_SPLIT; "PATH_INTEGRAL_SPLIT_LINEPATH",PATH_INTEGRAL_SPLIT_LINEPATH; "PATH_INTEGRAL_SUB",PATH_INTEGRAL_SUB; "PATH_INTEGRAL_SUBPATH_COMBINE",PATH_INTEGRAL_SUBPATH_COMBINE; "PATH_INTEGRAL_SUBPATH_INTEGRAL",PATH_INTEGRAL_SUBPATH_INTEGRAL; "PATH_INTEGRAL_SUBPATH_REFL",PATH_INTEGRAL_SUBPATH_REFL; "PATH_INTEGRAL_SWAP",PATH_INTEGRAL_SWAP; "PATH_INTEGRAL_TRIVIAL",PATH_INTEGRAL_TRIVIAL; "PATH_INTEGRAL_UNIFORM_LIMIT",PATH_INTEGRAL_UNIFORM_LIMIT; "PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH",PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH; "PATH_INTEGRAL_UNIQUE",PATH_INTEGRAL_UNIQUE; "PATH_INTEGRAL_VSUM",PATH_INTEGRAL_VSUM; "PATH_JOIN",PATH_JOIN; "PATH_JOIN_EQ",PATH_JOIN_EQ; "PATH_JOIN_IMP",PATH_JOIN_IMP; "PATH_JOIN_PATH_ENDS",PATH_JOIN_PATH_ENDS; "PATH_LENGTH_CIRCLEPATH",PATH_LENGTH_CIRCLEPATH; "PATH_LENGTH_COMBINE",PATH_LENGTH_COMBINE; "PATH_LENGTH_DIFFERENTIABLE",PATH_LENGTH_DIFFERENTIABLE; "PATH_LENGTH_EQ",PATH_LENGTH_EQ; "PATH_LENGTH_EQ_0",PATH_LENGTH_EQ_0; "PATH_LENGTH_EQ_LINE_SEGMENT",PATH_LENGTH_EQ_LINE_SEGMENT; "PATH_LENGTH_ISOMETRIC_IMAGE",PATH_LENGTH_ISOMETRIC_IMAGE; "PATH_LENGTH_JOIN",PATH_LENGTH_JOIN; "PATH_LENGTH_LINEAR_IMAGE",PATH_LENGTH_LINEAR_IMAGE; "PATH_LENGTH_LINEPATH",PATH_LENGTH_LINEPATH; "PATH_LENGTH_LIPSCHITZ",PATH_LENGTH_LIPSCHITZ; "PATH_LENGTH_PARTCIRCLEPATH",PATH_LENGTH_PARTCIRCLEPATH; "PATH_LENGTH_POS_LE",PATH_LENGTH_POS_LE; "PATH_LENGTH_REPARAMETRIZATION",PATH_LENGTH_REPARAMETRIZATION; "PATH_LENGTH_REVERSEPATH",PATH_LENGTH_REVERSEPATH; "PATH_LENGTH_SCALING",PATH_LENGTH_SCALING; "PATH_LENGTH_SHIFTPATH",PATH_LENGTH_SHIFTPATH; "PATH_LENGTH_SUBPATH",PATH_LENGTH_SUBPATH; "PATH_LENGTH_SUBPATH_LE",PATH_LENGTH_SUBPATH_LE; "PATH_LENGTH_TRANSLATION",PATH_LENGTH_TRANSLATION; "PATH_LENGTH_VALID_PATH",PATH_LENGTH_VALID_PATH; "PATH_LINEAR_IMAGE_EQ",PATH_LINEAR_IMAGE_EQ; "PATH_LINEPATH",PATH_LINEPATH; "PATH_PARTCIRCLEPATH",PATH_PARTCIRCLEPATH; "PATH_REVERSEPATH",PATH_REVERSEPATH; "PATH_SHIFTPATH",PATH_SHIFTPATH; "PATH_SUBPATH",PATH_SUBPATH; "PATH_SYM",PATH_SYM; "PATH_TRANSLATION_EQ",PATH_TRANSLATION_EQ; "PATH_VECTOR_POLYNOMIAL_FUNCTION",PATH_VECTOR_POLYNOMIAL_FUNCTION; "PCROSS",PCROSS; "PCROSS_AS_ORTHOGONAL_SUM",PCROSS_AS_ORTHOGONAL_SUM; "PCROSS_DIFF",PCROSS_DIFF; "PCROSS_EMPTY",PCROSS_EMPTY; "PCROSS_EQ",PCROSS_EQ; "PCROSS_EQ_EMPTY",PCROSS_EQ_EMPTY; "PCROSS_INTER",PCROSS_INTER; "PCROSS_INTERS",PCROSS_INTERS; "PCROSS_INTERS_INTERS",PCROSS_INTERS_INTERS; "PCROSS_INTERVAL",PCROSS_INTERVAL; "PCROSS_MONO",PCROSS_MONO; "PCROSS_UNION",PCROSS_UNION; "PCROSS_UNIONS",PCROSS_UNIONS; "PCROSS_UNIONS_UNIONS",PCROSS_UNIONS_UNIONS; "PERFECT_FROM_CLOSURE",PERFECT_FROM_CLOSURE; "PERMUTATION",PERMUTATION; "PERMUTATION_BIJECTIVE",PERMUTATION_BIJECTIVE; "PERMUTATION_COMPOSE",PERMUTATION_COMPOSE; "PERMUTATION_COMPOSE_EQ",PERMUTATION_COMPOSE_EQ; "PERMUTATION_COMPOSE_SWAP",PERMUTATION_COMPOSE_SWAP; "PERMUTATION_FINITE_SUPPORT",PERMUTATION_FINITE_SUPPORT; "PERMUTATION_I",PERMUTATION_I; "PERMUTATION_INVERSE",PERMUTATION_INVERSE; "PERMUTATION_INVERSE_COMPOSE",PERMUTATION_INVERSE_COMPOSE; "PERMUTATION_INVERSE_WORKS",PERMUTATION_INVERSE_WORKS; "PERMUTATION_LEMMA",PERMUTATION_LEMMA; "PERMUTATION_PERMUTES",PERMUTATION_PERMUTES; "PERMUTATION_SWAP",PERMUTATION_SWAP; "PERMUTES_BIJECTIONS",PERMUTES_BIJECTIONS; "PERMUTES_COMPOSE",PERMUTES_COMPOSE; "PERMUTES_EMPTY",PERMUTES_EMPTY; "PERMUTES_FINITE_INJECTIVE",PERMUTES_FINITE_INJECTIVE; "PERMUTES_FINITE_SURJECTIVE",PERMUTES_FINITE_SURJECTIVE; "PERMUTES_I",PERMUTES_I; "PERMUTES_ID",PERMUTES_ID; "PERMUTES_IMAGE",PERMUTES_IMAGE; "PERMUTES_INDUCT",PERMUTES_INDUCT; "PERMUTES_INJECTIVE",PERMUTES_INJECTIVE; "PERMUTES_INSERT",PERMUTES_INSERT; "PERMUTES_INSERT_LEMMA",PERMUTES_INSERT_LEMMA; "PERMUTES_INVERSE",PERMUTES_INVERSE; "PERMUTES_INVERSES",PERMUTES_INVERSES; "PERMUTES_INVERSES_o",PERMUTES_INVERSES_o; "PERMUTES_INVERSE_EQ",PERMUTES_INVERSE_EQ; "PERMUTES_INVERSE_INVERSE",PERMUTES_INVERSE_INVERSE; "PERMUTES_INVOLUTION",PERMUTES_INVOLUTION; "PERMUTES_IN_IMAGE",PERMUTES_IN_IMAGE; "PERMUTES_IN_NUMSEG",PERMUTES_IN_NUMSEG; "PERMUTES_NUMSET_GE",PERMUTES_NUMSET_GE; "PERMUTES_NUMSET_LE",PERMUTES_NUMSET_LE; "PERMUTES_SING",PERMUTES_SING; "PERMUTES_SUBSET",PERMUTES_SUBSET; "PERMUTES_SUPERSET",PERMUTES_SUPERSET; "PERMUTES_SURJECTIVE",PERMUTES_SURJECTIVE; "PERMUTES_SWAP",PERMUTES_SWAP; "PERMUTES_UNIV",PERMUTES_UNIV; "PERRON_FROBENIUS",PERRON_FROBENIUS; "PI2_BOUNDS",PI2_BOUNDS; "PICARD_LINDELOF_RIGHT",PICARD_LINDELOF_RIGHT; "PIECEWISE_DIFFERENTIABLE_ADD",PIECEWISE_DIFFERENTIABLE_ADD; "PIECEWISE_DIFFERENTIABLE_AFFINE",PIECEWISE_DIFFERENTIABLE_AFFINE; "PIECEWISE_DIFFERENTIABLE_CASES",PIECEWISE_DIFFERENTIABLE_CASES; "PIECEWISE_DIFFERENTIABLE_COMPOSE",PIECEWISE_DIFFERENTIABLE_COMPOSE; "PIECEWISE_DIFFERENTIABLE_NEG",PIECEWISE_DIFFERENTIABLE_NEG; "PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON",PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON; "PIECEWISE_DIFFERENTIABLE_ON_SUBSET",PIECEWISE_DIFFERENTIABLE_ON_SUBSET; "PIECEWISE_DIFFERENTIABLE_SUB",PIECEWISE_DIFFERENTIABLE_SUB; "PI_APPROX_32",PI_APPROX_32; "PI_NZ",PI_NZ; "PI_POS",PI_POS; "PI_POS_LE",PI_POS_LE; "PI_WORKS",PI_WORKS; "POINTS_IN_CONVEX_HULL",POINTS_IN_CONVEX_HULL; "POLE_AT_INFINITY",POLE_AT_INFINITY; "POLE_LEMMA",POLE_LEMMA; "POLE_LEMMA_OPEN",POLE_LEMMA_OPEN; "POLE_THEOREM",POLE_THEOREM; "POLE_THEOREM_0",POLE_THEOREM_0; "POLE_THEOREM_ANALYTIC",POLE_THEOREM_ANALYTIC; "POLE_THEOREM_ANALYTIC_0",POLE_THEOREM_ANALYTIC_0; "POLE_THEOREM_ANALYTIC_OPEN_SUPERSET",POLE_THEOREM_ANALYTIC_OPEN_SUPERSET; "POLE_THEOREM_ANALYTIC_OPEN_SUPERSET_0",POLE_THEOREM_ANALYTIC_OPEN_SUPERSET_0; "POLE_THEOREM_OPEN",POLE_THEOREM_OPEN; "POLE_THEOREM_OPEN_0",POLE_THEOREM_OPEN_0; "POLYHEDRAL_CONVEX_CONE",POLYHEDRAL_CONVEX_CONE; "POLYHEDRON",POLYHEDRON; "POLYHEDRON_AFFINE_HULL",POLYHEDRON_AFFINE_HULL; "POLYHEDRON_AS_CONE_PLUS_CONV",POLYHEDRON_AS_CONE_PLUS_CONV; "POLYHEDRON_CONIC_HULL_POLYTOPE",POLYHEDRON_CONIC_HULL_POLYTOPE; "POLYHEDRON_CONIC_HULL_VERTEX_IMAGE",POLYHEDRON_CONIC_HULL_VERTEX_IMAGE; "POLYHEDRON_CONVEX_CONE_HULL",POLYHEDRON_CONVEX_CONE_HULL; "POLYHEDRON_CONVEX_CONE_HULL_POLYTOPE",POLYHEDRON_CONVEX_CONE_HULL_POLYTOPE; "POLYHEDRON_CONVEX_HULL",POLYHEDRON_CONVEX_HULL; "POLYHEDRON_EMPTY",POLYHEDRON_EMPTY; "POLYHEDRON_EQ_FINITE_EXPOSED_FACES",POLYHEDRON_EQ_FINITE_EXPOSED_FACES; "POLYHEDRON_EQ_FINITE_FACES",POLYHEDRON_EQ_FINITE_FACES; "POLYHEDRON_HALFSPACE_GE",POLYHEDRON_HALFSPACE_GE; "POLYHEDRON_HALFSPACE_LE",POLYHEDRON_HALFSPACE_LE; "POLYHEDRON_HYPERPLANE",POLYHEDRON_HYPERPLANE; "POLYHEDRON_IMP_CLOSED",POLYHEDRON_IMP_CLOSED; "POLYHEDRON_IMP_CONVEX",POLYHEDRON_IMP_CONVEX; "POLYHEDRON_INTER",POLYHEDRON_INTER; "POLYHEDRON_INTERS",POLYHEDRON_INTERS; "POLYHEDRON_INTERVAL",POLYHEDRON_INTERVAL; "POLYHEDRON_INTER_AFFINE",POLYHEDRON_INTER_AFFINE; "POLYHEDRON_INTER_AFFINE_MINIMAL",POLYHEDRON_INTER_AFFINE_MINIMAL; "POLYHEDRON_INTER_AFFINE_PARALLEL",POLYHEDRON_INTER_AFFINE_PARALLEL; "POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL",POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL; "POLYHEDRON_INTER_POLYTOPE",POLYHEDRON_INTER_POLYTOPE; "POLYHEDRON_LINEAR_IMAGE",POLYHEDRON_LINEAR_IMAGE; "POLYHEDRON_LINEAR_IMAGE_EQ",POLYHEDRON_LINEAR_IMAGE_EQ; "POLYHEDRON_LINEAR_PREIMAGE",POLYHEDRON_LINEAR_PREIMAGE; "POLYHEDRON_MINIMAL_LEMMA",POLYHEDRON_MINIMAL_LEMMA; "POLYHEDRON_NEGATIONS",POLYHEDRON_NEGATIONS; "POLYHEDRON_POLYTOPE_SUMS",POLYHEDRON_POLYTOPE_SUMS; "POLYHEDRON_POSITIVE_ORTHANT",POLYHEDRON_POSITIVE_ORTHANT; "POLYHEDRON_RIDGE_TWO_FACETS",POLYHEDRON_RIDGE_TWO_FACETS; "POLYHEDRON_SUMS",POLYHEDRON_SUMS; "POLYHEDRON_TRANSLATION_EQ",POLYHEDRON_TRANSLATION_EQ; "POLYHEDRON_UNIV",POLYHEDRON_UNIV; "POLYNOMIAL_FUNCTION_ADD",POLYNOMIAL_FUNCTION_ADD; "POLYNOMIAL_FUNCTION_BERNOULLI",POLYNOMIAL_FUNCTION_BERNOULLI; "POLYNOMIAL_FUNCTION_CONST",POLYNOMIAL_FUNCTION_CONST; "POLYNOMIAL_FUNCTION_FINITE_ROOTS",POLYNOMIAL_FUNCTION_FINITE_ROOTS; "POLYNOMIAL_FUNCTION_I",POLYNOMIAL_FUNCTION_I; "POLYNOMIAL_FUNCTION_ID",POLYNOMIAL_FUNCTION_ID; "POLYNOMIAL_FUNCTION_INDUCT",POLYNOMIAL_FUNCTION_INDUCT; "POLYNOMIAL_FUNCTION_LMUL",POLYNOMIAL_FUNCTION_LMUL; "POLYNOMIAL_FUNCTION_MUL",POLYNOMIAL_FUNCTION_MUL; "POLYNOMIAL_FUNCTION_NEG",POLYNOMIAL_FUNCTION_NEG; "POLYNOMIAL_FUNCTION_POW",POLYNOMIAL_FUNCTION_POW; "POLYNOMIAL_FUNCTION_PRODUCT",POLYNOMIAL_FUNCTION_PRODUCT; "POLYNOMIAL_FUNCTION_RMUL",POLYNOMIAL_FUNCTION_RMUL; "POLYNOMIAL_FUNCTION_SUB",POLYNOMIAL_FUNCTION_SUB; "POLYNOMIAL_FUNCTION_SUM",POLYNOMIAL_FUNCTION_SUM; "POLYNOMIAL_FUNCTION_o",POLYNOMIAL_FUNCTION_o; "POLYTOPE_1",POLYTOPE_1; "POLYTOPE_AFFINITY",POLYTOPE_AFFINITY; "POLYTOPE_AFFINITY_EQ",POLYTOPE_AFFINITY_EQ; "POLYTOPE_AFF_DIM_1",POLYTOPE_AFF_DIM_1; "POLYTOPE_CONVEX_HULL",POLYTOPE_CONVEX_HULL; "POLYTOPE_EMPTY",POLYTOPE_EMPTY; "POLYTOPE_EQ_BOUNDED_POLYHEDRON",POLYTOPE_EQ_BOUNDED_POLYHEDRON; "POLYTOPE_FACET_EXISTS",POLYTOPE_FACET_EXISTS; "POLYTOPE_FACET_LOWER_BOUND",POLYTOPE_FACET_LOWER_BOUND; "POLYTOPE_IMP_BOUNDED",POLYTOPE_IMP_BOUNDED; "POLYTOPE_IMP_CLOSED",POLYTOPE_IMP_CLOSED; "POLYTOPE_IMP_COMPACT",POLYTOPE_IMP_COMPACT; "POLYTOPE_IMP_CONVEX",POLYTOPE_IMP_CONVEX; "POLYTOPE_IMP_POLYHEDRON",POLYTOPE_IMP_POLYHEDRON; "POLYTOPE_INTER",POLYTOPE_INTER; "POLYTOPE_INTERVAL",POLYTOPE_INTERVAL; "POLYTOPE_INTER_POLYHEDRON",POLYTOPE_INTER_POLYHEDRON; "POLYTOPE_LINEAR_IMAGE",POLYTOPE_LINEAR_IMAGE; "POLYTOPE_LINEAR_IMAGE_EQ",POLYTOPE_LINEAR_IMAGE_EQ; "POLYTOPE_LOWDIM_IMP_SIMPLEX",POLYTOPE_LOWDIM_IMP_SIMPLEX; "POLYTOPE_NEGATIONS",POLYTOPE_NEGATIONS; "POLYTOPE_PCROSS",POLYTOPE_PCROSS; "POLYTOPE_PCROSS_EQ",POLYTOPE_PCROSS_EQ; "POLYTOPE_SCALING",POLYTOPE_SCALING; "POLYTOPE_SCALING_EQ",POLYTOPE_SCALING_EQ; "POLYTOPE_SEGMENT",POLYTOPE_SEGMENT; "POLYTOPE_SING",POLYTOPE_SING; "POLYTOPE_SUMS",POLYTOPE_SUMS; "POLYTOPE_TRANSLATION_EQ",POLYTOPE_TRANSLATION_EQ; "POLYTOPE_UNION_CONVEX_HULL_FACETS",POLYTOPE_UNION_CONVEX_HULL_FACETS; "POLYTOPE_VERTEX_IMAGE",POLYTOPE_VERTEX_IMAGE; "POLYTOPE_VERTEX_LOWER_BOUND",POLYTOPE_VERTEX_LOWER_BOUND; "POSET_ANTISYM",POSET_ANTISYM; "POSET_FLEQ",POSET_FLEQ; "POSET_REFL",POSET_REFL; "POSET_RESTRICTED_SUBSET",POSET_RESTRICTED_SUBSET; "POSET_TRANS",POSET_TRANS; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT_GEN",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT_GEN; "POSITIVE_AE_DERIVATIVE_IMP_NONDECREASING",POSITIVE_AE_DERIVATIVE_IMP_NONDECREASING; "POSITIVE_DEFINITE_1",POSITIVE_DEFINITE_1; "POSITIVE_DEFINITE_1_GEN",POSITIVE_DEFINITE_1_GEN; "POSITIVE_DEFINITE_2",POSITIVE_DEFINITE_2; "POSITIVE_DEFINITE_2_DET",POSITIVE_DEFINITE_2_DET; "POSITIVE_DEFINITE_ADD",POSITIVE_DEFINITE_ADD; "POSITIVE_DEFINITE_CMUL",POSITIVE_DEFINITE_CMUL; "POSITIVE_DEFINITE_COFACTOR",POSITIVE_DEFINITE_COFACTOR; "POSITIVE_DEFINITE_COFACTOR_EQ",POSITIVE_DEFINITE_COFACTOR_EQ; "POSITIVE_DEFINITE_COVARIANCE",POSITIVE_DEFINITE_COVARIANCE; "POSITIVE_DEFINITE_COVARIANCE_EQ",POSITIVE_DEFINITE_COVARIANCE_EQ; "POSITIVE_DEFINITE_COVARIANCE_EQ_ALT",POSITIVE_DEFINITE_COVARIANCE_EQ_ALT; "POSITIVE_DEFINITE_DIAGONAL_MATRIX",POSITIVE_DEFINITE_DIAGONAL_MATRIX; "POSITIVE_DEFINITE_DIAGONAL_MATRIX_EQ",POSITIVE_DEFINITE_DIAGONAL_MATRIX_EQ; "POSITIVE_DEFINITE_EIGENVALUES",POSITIVE_DEFINITE_EIGENVALUES; "POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY",POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY; "POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY_ALT",POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY_ALT; "POSITIVE_DEFINITE_EVENTUALLY",POSITIVE_DEFINITE_EVENTUALLY; "POSITIVE_DEFINITE_HADAMARD_PRODUCT",POSITIVE_DEFINITE_HADAMARD_PRODUCT; "POSITIVE_DEFINITE_ID",POSITIVE_DEFINITE_ID; "POSITIVE_DEFINITE_IMP_INVERTIBLE",POSITIVE_DEFINITE_IMP_INVERTIBLE; "POSITIVE_DEFINITE_IMP_POSITIVE_SEMIDEFINITE",POSITIVE_DEFINITE_IMP_POSITIVE_SEMIDEFINITE; "POSITIVE_DEFINITE_IMP_SYMMETRIC",POSITIVE_DEFINITE_IMP_SYMMETRIC; "POSITIVE_DEFINITE_INV",POSITIVE_DEFINITE_INV; "POSITIVE_DEFINITE_MAT",POSITIVE_DEFINITE_MAT; "POSITIVE_DEFINITE_MUL",POSITIVE_DEFINITE_MUL; "POSITIVE_DEFINITE_MUL_EQ",POSITIVE_DEFINITE_MUL_EQ; "POSITIVE_DEFINITE_NEARBY",POSITIVE_DEFINITE_NEARBY; "POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE",POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; "POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE_ADD",POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE_ADD; "POSITIVE_DEFINITE_SIMILAR",POSITIVE_DEFINITE_SIMILAR; "POSITIVE_DEFINITE_SIMILAR_EQ",POSITIVE_DEFINITE_SIMILAR_EQ; "POSITIVE_DEFINITE_TRANSP",POSITIVE_DEFINITE_TRANSP; "POSITIVE_SEMIDEFINITE_1",POSITIVE_SEMIDEFINITE_1; "POSITIVE_SEMIDEFINITE_1_GEN",POSITIVE_SEMIDEFINITE_1_GEN; "POSITIVE_SEMIDEFINITE_2",POSITIVE_SEMIDEFINITE_2; "POSITIVE_SEMIDEFINITE_2_DET",POSITIVE_SEMIDEFINITE_2_DET; "POSITIVE_SEMIDEFINITE_ADD",POSITIVE_SEMIDEFINITE_ADD; "POSITIVE_SEMIDEFINITE_AND_ORTHOGONAL",POSITIVE_SEMIDEFINITE_AND_ORTHOGONAL; "POSITIVE_SEMIDEFINITE_CMUL",POSITIVE_SEMIDEFINITE_CMUL; "POSITIVE_SEMIDEFINITE_COFACTOR",POSITIVE_SEMIDEFINITE_COFACTOR; "POSITIVE_SEMIDEFINITE_COVARIANCE",POSITIVE_SEMIDEFINITE_COVARIANCE; "POSITIVE_SEMIDEFINITE_COVARIANCE_EQ",POSITIVE_SEMIDEFINITE_COVARIANCE_EQ; "POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT",POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT; "POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE",POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE; "POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY",POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY; "POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX",POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX; "POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ",POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ; "POSITIVE_SEMIDEFINITE_EIGENVALUES",POSITIVE_SEMIDEFINITE_EIGENVALUES; "POSITIVE_SEMIDEFINITE_HADAMARD_PRODUCT",POSITIVE_SEMIDEFINITE_HADAMARD_PRODUCT; "POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC",POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC; "POSITIVE_SEMIDEFINITE_INV",POSITIVE_SEMIDEFINITE_INV; "POSITIVE_SEMIDEFINITE_MAT",POSITIVE_SEMIDEFINITE_MAT; "POSITIVE_SEMIDEFINITE_MUL",POSITIVE_SEMIDEFINITE_MUL; "POSITIVE_SEMIDEFINITE_MUL_EIGENVALUES",POSITIVE_SEMIDEFINITE_MUL_EIGENVALUES; "POSITIVE_SEMIDEFINITE_MUL_EQ",POSITIVE_SEMIDEFINITE_MUL_EQ; "POSITIVE_SEMIDEFINITE_POSITIVE_DEFINITE_ADD",POSITIVE_SEMIDEFINITE_POSITIVE_DEFINITE_ADD; "POSITIVE_SEMIDEFINITE_SIMILAR",POSITIVE_SEMIDEFINITE_SIMILAR; "POSITIVE_SEMIDEFINITE_SIMILAR_EQ",POSITIVE_SEMIDEFINITE_SIMILAR_EQ; "POSITIVE_SEMIDEFINITE_SQRT",POSITIVE_SEMIDEFINITE_SQRT; "POSITIVE_SEMIDEFINITE_SQRT_EQ",POSITIVE_SEMIDEFINITE_SQRT_EQ; "POSITIVE_SEMIDEFINITE_SQRT_UNIQUE",POSITIVE_SEMIDEFINITE_SQRT_UNIQUE; "POSITIVE_SEMIDEFINITE_SUBMATRIX_2",POSITIVE_SEMIDEFINITE_SUBMATRIX_2; "POSITIVE_SEMIDEFINITE_TRACE_EQ_0",POSITIVE_SEMIDEFINITE_TRACE_EQ_0; "POSITIVE_SEMIDEFINITE_TRANSP",POSITIVE_SEMIDEFINITE_TRANSP; "POSITIVE_SEMIDEFINITE_ZERO_COLUMN",POSITIVE_SEMIDEFINITE_ZERO_COLUMN; "POSITIVE_SEMIDEFINITE_ZERO_FORM",POSITIVE_SEMIDEFINITE_ZERO_FORM; "POSITIVE_SEMIDEFINITE_ZERO_FORM_EQ",POSITIVE_SEMIDEFINITE_ZERO_FORM_EQ; "POSITIVE_SEMIDEFINITE_ZERO_ROW",POSITIVE_SEMIDEFINITE_ZERO_ROW; "POWERSET_CLAUSES",POWERSET_CLAUSES; "POWER_REAL_SERIES_CONV_IMP_ABSCONV_WEAK",POWER_REAL_SERIES_CONV_IMP_ABSCONV_WEAK; "POWER_SERIES_ANALYTIC",POWER_SERIES_ANALYTIC; "POWER_SERIES_AND_DERIVATIVE",POWER_SERIES_AND_DERIVATIVE; "POWER_SERIES_AND_DERIVATIVE_0",POWER_SERIES_AND_DERIVATIVE_0; "POWER_SERIES_CONTINUOUS",POWER_SERIES_CONTINUOUS; "POWER_SERIES_CONV_IMP_ABSCONV",POWER_SERIES_CONV_IMP_ABSCONV; "POWER_SERIES_CONV_IMP_ABSCONV_WEAK",POWER_SERIES_CONV_IMP_ABSCONV_WEAK; "POWER_SERIES_HOLOMORPHIC",POWER_SERIES_HOLOMORPHIC; "POWER_SERIES_LIMIT_POINT_OF_ZEROS",POWER_SERIES_LIMIT_POINT_OF_ZEROS; "POWER_SERIES_RADIUS_OF_CONVERGENCE",POWER_SERIES_RADIUS_OF_CONVERGENCE; "POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ",POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ; "POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1",POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1; "POWER_SERIES_UNIQUE",POWER_SERIES_UNIQUE; "POW_2_CSQRT",POW_2_CSQRT; "POW_2_SQRT",POW_2_SQRT; "POW_2_SQRT_ABS",POW_2_SQRT_ABS; "PRE",PRE; "PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE",PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE; "PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_ALT",PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_ALT; "PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN",PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN; "PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE",PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE; "PRESERVES_NEGLIGIBLE_IMAGE",PRESERVES_NEGLIGIBLE_IMAGE; "PRESERVES_NEGLIGIBLE_IMAGE_UNIV",PRESERVES_NEGLIGIBLE_IMAGE_UNIV; "PRESERVES_NORM_INJECTIVE",PRESERVES_NORM_INJECTIVE; "PRESERVES_NORM_PRESERVES_DOT",PRESERVES_NORM_PRESERVES_DOT; "PRESEVES_NORM_PRESERVES_DIST",PRESEVES_NORM_PRESERVES_DIST; "PRE_ELIM_THM",PRE_ELIM_THM; "PRE_ELIM_THM'",PRE_ELIM_THM'; "PRODUCT_1",PRODUCT_1; "PRODUCT_2",PRODUCT_2; "PRODUCT_3",PRODUCT_3; "PRODUCT_4",PRODUCT_4; "PRODUCT_ABS",PRODUCT_ABS; "PRODUCT_ADD_SPLIT",PRODUCT_ADD_SPLIT; "PRODUCT_ASSOCIATIVE",PRODUCT_ASSOCIATIVE; "PRODUCT_CLAUSES",PRODUCT_CLAUSES; "PRODUCT_CLAUSES_LEFT",PRODUCT_CLAUSES_LEFT; "PRODUCT_CLAUSES_NUMSEG",PRODUCT_CLAUSES_NUMSEG; "PRODUCT_CLAUSES_RIGHT",PRODUCT_CLAUSES_RIGHT; "PRODUCT_CLOSED",PRODUCT_CLOSED; "PRODUCT_CONST",PRODUCT_CONST; "PRODUCT_CONST_NUMSEG",PRODUCT_CONST_NUMSEG; "PRODUCT_CONST_NUMSEG_1",PRODUCT_CONST_NUMSEG_1; "PRODUCT_DELETE",PRODUCT_DELETE; "PRODUCT_DELTA",PRODUCT_DELTA; "PRODUCT_DIV",PRODUCT_DIV; "PRODUCT_DIV_NUMSEG",PRODUCT_DIV_NUMSEG; "PRODUCT_EQ",PRODUCT_EQ; "PRODUCT_EQ_0",PRODUCT_EQ_0; "PRODUCT_EQ_0_NUMSEG",PRODUCT_EQ_0_NUMSEG; "PRODUCT_EQ_1",PRODUCT_EQ_1; "PRODUCT_EQ_1_NUMSEG",PRODUCT_EQ_1_NUMSEG; "PRODUCT_EQ_NUMSEG",PRODUCT_EQ_NUMSEG; "PRODUCT_IMAGE",PRODUCT_IMAGE; "PRODUCT_INV",PRODUCT_INV; "PRODUCT_LADD",PRODUCT_LADD; "PRODUCT_LE",PRODUCT_LE; "PRODUCT_LE_1",PRODUCT_LE_1; "PRODUCT_LE_NUMSEG",PRODUCT_LE_NUMSEG; "PRODUCT_LMUL",PRODUCT_LMUL; "PRODUCT_LNEG",PRODUCT_LNEG; "PRODUCT_LZERO",PRODUCT_LZERO; "PRODUCT_MBASIS",PRODUCT_MBASIS; "PRODUCT_MBASIS_SING",PRODUCT_MBASIS_SING; "PRODUCT_MUL",PRODUCT_MUL; "PRODUCT_MUL_GEN",PRODUCT_MUL_GEN; "PRODUCT_MUL_NUMSEG",PRODUCT_MUL_NUMSEG; "PRODUCT_NEG",PRODUCT_NEG; "PRODUCT_NEG_NUMSEG",PRODUCT_NEG_NUMSEG; "PRODUCT_NEG_NUMSEG_1",PRODUCT_NEG_NUMSEG_1; "PRODUCT_OFFSET",PRODUCT_OFFSET; "PRODUCT_ONE",PRODUCT_ONE; "PRODUCT_PAIR",PRODUCT_PAIR; "PRODUCT_PERMUTE",PRODUCT_PERMUTE; "PRODUCT_PERMUTE_NUMSEG",PRODUCT_PERMUTE_NUMSEG; "PRODUCT_POS_LE",PRODUCT_POS_LE; "PRODUCT_POS_LE_NUMSEG",PRODUCT_POS_LE_NUMSEG; "PRODUCT_POS_LT",PRODUCT_POS_LT; "PRODUCT_POS_LT_NUMSEG",PRODUCT_POS_LT_NUMSEG; "PRODUCT_RADD",PRODUCT_RADD; "PRODUCT_REFLECT",PRODUCT_REFLECT; "PRODUCT_RMUL",PRODUCT_RMUL; "PRODUCT_RNEG",PRODUCT_RNEG; "PRODUCT_RZERO",PRODUCT_RZERO; "PRODUCT_SING",PRODUCT_SING; "PRODUCT_SING_NUMSEG",PRODUCT_SING_NUMSEG; "PRODUCT_SUPERSET",PRODUCT_SUPERSET; "PRODUCT_SUPPORT",PRODUCT_SUPPORT; "PRODUCT_UNION",PRODUCT_UNION; "PRODUCT_UNIV",PRODUCT_UNIV; "PROPERTY_EMPTY_INTERVAL",PROPERTY_EMPTY_INTERVAL; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM_GEN",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM_GEN; "PROPER_LOCAL_HOMEOMORPHISM_GLOBAL",PROPER_LOCAL_HOMEOMORPHISM_GLOBAL; "PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP",PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP; "PROPER_MAP",PROPER_MAP; "PROPER_MAP_COMPLEX_POLYFUN",PROPER_MAP_COMPLEX_POLYFUN; "PROPER_MAP_COMPLEX_POLYFUN_EQ",PROPER_MAP_COMPLEX_POLYFUN_EQ; "PROPER_MAP_COMPLEX_POLYFUN_UNIV",PROPER_MAP_COMPLEX_POLYFUN_UNIV; "PROPER_MAP_COMPOSE",PROPER_MAP_COMPOSE; "PROPER_MAP_EQ",PROPER_MAP_EQ; "PROPER_MAP_ESCAPES",PROPER_MAP_ESCAPES; "PROPER_MAP_ESCAPES_FROM_IMAGE",PROPER_MAP_ESCAPES_FROM_IMAGE; "PROPER_MAP_ESCAPES_IMP",PROPER_MAP_ESCAPES_IMP; "PROPER_MAP_FROM_COMPACT",PROPER_MAP_FROM_COMPACT; "PROPER_MAP_FROM_COMPACT_ALT",PROPER_MAP_FROM_COMPACT_ALT; "PROPER_MAP_FROM_COMPOSITION_LEFT",PROPER_MAP_FROM_COMPOSITION_LEFT; "PROPER_MAP_FROM_COMPOSITION_RIGHT",PROPER_MAP_FROM_COMPOSITION_RIGHT; "PROPER_MAP_FSTCART",PROPER_MAP_FSTCART; "PROPER_MAP_NORM",PROPER_MAP_NORM; "PROPER_MAP_NORM_SIMPLE",PROPER_MAP_NORM_SIMPLE; "PROPER_MAP_SEQUENTIALLY",PROPER_MAP_SEQUENTIALLY; "PROPER_MAP_SEQUENTIALLY_IMP",PROPER_MAP_SEQUENTIALLY_IMP; "PROPER_MAP_SEQUENTIALLY_REV",PROPER_MAP_SEQUENTIALLY_REV; "PROPER_MAP_SNDCART",PROPER_MAP_SNDCART; "PROPER_MAP_TO_COMPACT",PROPER_MAP_TO_COMPACT; "PSUBSET",PSUBSET; "PSUBSET_ALT",PSUBSET_ALT; "PSUBSET_INSERT_SUBSET",PSUBSET_INSERT_SUBSET; "PSUBSET_IRREFL",PSUBSET_IRREFL; "PSUBSET_MEMBER",PSUBSET_MEMBER; "PSUBSET_SUBSET_TRANS",PSUBSET_SUBSET_TRANS; "PSUBSET_TRANS",PSUBSET_TRANS; "PSUBSET_UNIONS_PAIRWISE_DISJOINT",PSUBSET_UNIONS_PAIRWISE_DISJOINT; "PSUBSET_UNIV",PSUBSET_UNIV; "PUSHIN_DROPOUT",PUSHIN_DROPOUT; "P_HULL",P_HULL; "Product_DEF",Product_DEF; "QUANTIFY_SURJECTION_HIGHER_THM",QUANTIFY_SURJECTION_HIGHER_THM; "QUANTIFY_SURJECTION_THM",QUANTIFY_SURJECTION_THM; "QUASICOMPACT_OPEN_CLOSED",QUASICOMPACT_OPEN_CLOSED; "QUOTIENT_MAP_CLOSED_MAP_EQ",QUOTIENT_MAP_CLOSED_MAP_EQ; "QUOTIENT_MAP_COMPOSE",QUOTIENT_MAP_COMPOSE; "QUOTIENT_MAP_FROM_COMPOSITION",QUOTIENT_MAP_FROM_COMPOSITION; "QUOTIENT_MAP_FROM_SUBSET",QUOTIENT_MAP_FROM_SUBSET; "QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED",QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED; "QUOTIENT_MAP_IMP_CONTINUOUS_OPEN",QUOTIENT_MAP_IMP_CONTINUOUS_OPEN; "QUOTIENT_MAP_OPEN_CLOSED",QUOTIENT_MAP_OPEN_CLOSED; "QUOTIENT_MAP_OPEN_MAP_EQ",QUOTIENT_MAP_OPEN_MAP_EQ; "QUOTIENT_MAP_RESTRICT",QUOTIENT_MAP_RESTRICT; "RADEMACHER",RADEMACHER; "RADEMACHER_GEN",RADEMACHER_GEN; "RADEMACHER_OPEN",RADEMACHER_OPEN; "RADEMACHER_UNIV",RADEMACHER_UNIV; "RADON",RADON; "RADON_EX_LEMMA",RADON_EX_LEMMA; "RADON_PARTITION",RADON_PARTITION; "RADON_S_LEMMA",RADON_S_LEMMA; "RADON_V_LEMMA",RADON_V_LEMMA; "RANK_0",RANK_0; "RANK_BOUND",RANK_BOUND; "RANK_CMUL",RANK_CMUL; "RANK_COFACTOR",RANK_COFACTOR; "RANK_COFACTOR_EQ_1",RANK_COFACTOR_EQ_1; "RANK_COFACTOR_EQ_FULL",RANK_COFACTOR_EQ_FULL; "RANK_DIAGONAL_MATRIX",RANK_DIAGONAL_MATRIX; "RANK_DIM_IM",RANK_DIM_IM; "RANK_EQ_0",RANK_EQ_0; "RANK_EQ_FULL_DET",RANK_EQ_FULL_DET; "RANK_GRAM",RANK_GRAM; "RANK_I",RANK_I; "RANK_INVERTIBLE_LMUL",RANK_INVERTIBLE_LMUL; "RANK_INVERTIBLE_RMUL",RANK_INVERTIBLE_RMUL; "RANK_MATRIX_INV",RANK_MATRIX_INV; "RANK_MATRIX_INV_LMUL",RANK_MATRIX_INV_LMUL; "RANK_MATRIX_INV_RMUL",RANK_MATRIX_INV_RMUL; "RANK_MUL_LE_LEFT",RANK_MUL_LE_LEFT; "RANK_MUL_LE_RIGHT",RANK_MUL_LE_RIGHT; "RANK_NEG",RANK_NEG; "RANK_NULLSPACE",RANK_NULLSPACE; "RANK_ROW",RANK_ROW; "RANK_SIMILAR",RANK_SIMILAR; "RANK_SYLVESTER",RANK_SYLVESTER; "RANK_TRANSP",RANK_TRANSP; "RANK_TRIANGLE",RANK_TRIANGLE; "RATIONAL_ABS",RATIONAL_ABS; "RATIONAL_ADD",RATIONAL_ADD; "RATIONAL_ALT",RATIONAL_ALT; "RATIONAL_APPROXIMATION",RATIONAL_APPROXIMATION; "RATIONAL_APPROXIMATION_ABOVE",RATIONAL_APPROXIMATION_ABOVE; "RATIONAL_APPROXIMATION_BELOW",RATIONAL_APPROXIMATION_BELOW; "RATIONAL_APPROXIMATION_STRADDLE",RATIONAL_APPROXIMATION_STRADDLE; "RATIONAL_BETWEEN",RATIONAL_BETWEEN; "RATIONAL_BETWEEN_EQ",RATIONAL_BETWEEN_EQ; "RATIONAL_CLOSED",RATIONAL_CLOSED; "RATIONAL_DIV",RATIONAL_DIV; "RATIONAL_INTEGER",RATIONAL_INTEGER; "RATIONAL_INV",RATIONAL_INV; "RATIONAL_INV_EQ",RATIONAL_INV_EQ; "RATIONAL_MUL",RATIONAL_MUL; "RATIONAL_NEG",RATIONAL_NEG; "RATIONAL_NEG_EQ",RATIONAL_NEG_EQ; "RATIONAL_NUM",RATIONAL_NUM; "RATIONAL_POW",RATIONAL_POW; "RATIONAL_SUB",RATIONAL_SUB; "RATIONAL_SUM",RATIONAL_SUM; "RAT_LEMMA1",RAT_LEMMA1; "RAT_LEMMA2",RAT_LEMMA2; "RAT_LEMMA3",RAT_LEMMA3; "RAT_LEMMA4",RAT_LEMMA4; "RAT_LEMMA5",RAT_LEMMA5; "RAY_TO_FRONTIER",RAY_TO_FRONTIER; "RAY_TO_RELATIVE_FRONTIER",RAY_TO_RELATIVE_FRONTIER; "RDIV_LT_EQ",RDIV_LT_EQ; "RE",RE; "REAL",REAL; "REALLIM",REALLIM; "REALLIM_1_OVER_LOG",REALLIM_1_OVER_LOG; "REALLIM_1_OVER_N",REALLIM_1_OVER_N; "REALLIM_1_OVER_N_OFFSET",REALLIM_1_OVER_N_OFFSET; "REALLIM_1_OVER_POW",REALLIM_1_OVER_POW; "REALLIM_ABS",REALLIM_ABS; "REALLIM_ADD",REALLIM_ADD; "REALLIM_AT",REALLIM_AT; "REALLIM_ATREAL",REALLIM_ATREAL; "REALLIM_ATREAL_AT",REALLIM_ATREAL_AT; "REALLIM_ATREAL_ID",REALLIM_ATREAL_ID; "REALLIM_ATREAL_WITHINREAL",REALLIM_ATREAL_WITHINREAL; "REALLIM_ATREAL_ZERO",REALLIM_ATREAL_ZERO; "REALLIM_AT_INFINITY",REALLIM_AT_INFINITY; "REALLIM_AT_INFINITY_COMPLEX_0",REALLIM_AT_INFINITY_COMPLEX_0; "REALLIM_AT_NEGINFINITY",REALLIM_AT_NEGINFINITY; "REALLIM_AT_POSINFINITY",REALLIM_AT_POSINFINITY; "REALLIM_AT_WITHIN",REALLIM_AT_WITHIN; "REALLIM_AT_ZERO",REALLIM_AT_ZERO; "REALLIM_COMPLEX",REALLIM_COMPLEX; "REALLIM_COMPOSE_AT",REALLIM_COMPOSE_AT; "REALLIM_COMPOSE_WITHIN",REALLIM_COMPOSE_WITHIN; "REALLIM_CONG_AT",REALLIM_CONG_AT; "REALLIM_CONG_ATREAL",REALLIM_CONG_ATREAL; "REALLIM_CONG_WITHIN",REALLIM_CONG_WITHIN; "REALLIM_CONG_WITHINREAL",REALLIM_CONG_WITHINREAL; "REALLIM_CONST",REALLIM_CONST; "REALLIM_CONST_EQ",REALLIM_CONST_EQ; "REALLIM_CONTINUOUS_FUNCTION",REALLIM_CONTINUOUS_FUNCTION; "REALLIM_DIV",REALLIM_DIV; "REALLIM_EVENTUALLY",REALLIM_EVENTUALLY; "REALLIM_IM",REALLIM_IM; "REALLIM_INV",REALLIM_INV; "REALLIM_LBOUND",REALLIM_LBOUND; "REALLIM_LE",REALLIM_LE; "REALLIM_LMUL",REALLIM_LMUL; "REALLIM_LMUL_EQ",REALLIM_LMUL_EQ; "REALLIM_LOG_OVER_N",REALLIM_LOG_OVER_N; "REALLIM_MAX",REALLIM_MAX; "REALLIM_MIN",REALLIM_MIN; "REALLIM_MUL",REALLIM_MUL; "REALLIM_NEG",REALLIM_NEG; "REALLIM_NEG_EQ",REALLIM_NEG_EQ; "REALLIM_NULL",REALLIM_NULL; "REALLIM_NULL_ABS",REALLIM_NULL_ABS; "REALLIM_NULL_ADD",REALLIM_NULL_ADD; "REALLIM_NULL_COMPARISON",REALLIM_NULL_COMPARISON; "REALLIM_NULL_LMUL",REALLIM_NULL_LMUL; "REALLIM_NULL_LMUL_EQ",REALLIM_NULL_LMUL_EQ; "REALLIM_NULL_NEG",REALLIM_NULL_NEG; "REALLIM_NULL_POW",REALLIM_NULL_POW; "REALLIM_NULL_POW_EQ",REALLIM_NULL_POW_EQ; "REALLIM_NULL_RMUL",REALLIM_NULL_RMUL; "REALLIM_NULL_RMUL_EQ",REALLIM_NULL_RMUL_EQ; "REALLIM_NULL_SUB",REALLIM_NULL_SUB; "REALLIM_NULL_SUM",REALLIM_NULL_SUM; "REALLIM_POSINFINITY_SEQUENTIALLY",REALLIM_POSINFINITY_SEQUENTIALLY; "REALLIM_POW",REALLIM_POW; "REALLIM_POWN",REALLIM_POWN; "REALLIM_RE",REALLIM_RE; "REALLIM_REAL_CONTINUOUS_FUNCTION",REALLIM_REAL_CONTINUOUS_FUNCTION; "REALLIM_RMUL",REALLIM_RMUL; "REALLIM_RMUL_EQ",REALLIM_RMUL_EQ; "REALLIM_RPOW",REALLIM_RPOW; "REALLIM_RPOW_COMPOSE",REALLIM_RPOW_COMPOSE; "REALLIM_SEQUENTIALLY",REALLIM_SEQUENTIALLY; "REALLIM_SUB",REALLIM_SUB; "REALLIM_SUM",REALLIM_SUM; "REALLIM_TRANSFORM",REALLIM_TRANSFORM; "REALLIM_TRANSFORM_BOUND",REALLIM_TRANSFORM_BOUND; "REALLIM_TRANSFORM_EQ",REALLIM_TRANSFORM_EQ; "REALLIM_TRANSFORM_EVENTUALLY",REALLIM_TRANSFORM_EVENTUALLY; "REALLIM_TRANSFORM_STRADDLE",REALLIM_TRANSFORM_STRADDLE; "REALLIM_TRANSFORM_WITHINREAL_SET",REALLIM_TRANSFORM_WITHINREAL_SET; "REALLIM_TRANSFORM_WITHINREAL_SET_IMP",REALLIM_TRANSFORM_WITHINREAL_SET_IMP; "REALLIM_TRANSFORM_WITHIN_SET",REALLIM_TRANSFORM_WITHIN_SET; "REALLIM_TRANSFORM_WITHIN_SET_IMP",REALLIM_TRANSFORM_WITHIN_SET_IMP; "REALLIM_UBOUND",REALLIM_UBOUND; "REALLIM_UNIQUE",REALLIM_UNIQUE; "REALLIM_WITHIN",REALLIM_WITHIN; "REALLIM_WITHINREAL",REALLIM_WITHINREAL; "REALLIM_WITHINREAL_ID",REALLIM_WITHINREAL_ID; "REALLIM_WITHINREAL_LE",REALLIM_WITHINREAL_LE; "REALLIM_WITHINREAL_SUBSET",REALLIM_WITHINREAL_SUBSET; "REALLIM_WITHINREAL_WITHIN",REALLIM_WITHINREAL_WITHIN; "REALLIM_WITHIN_LE",REALLIM_WITHIN_LE; "REALLIM_WITHIN_OPEN",REALLIM_WITHIN_OPEN; "REALLIM_WITHIN_REAL_OPEN",REALLIM_WITHIN_REAL_OPEN; "REALLIM_WITHIN_SUBSET",REALLIM_WITHIN_SUBSET; "REALLIM_X_TIMES_LOG",REALLIM_X_TIMES_LOG; "REALLIM_ZERO_NEGINFINITY",REALLIM_ZERO_NEGINFINITY; "REALLIM_ZERO_POSINFINITY",REALLIM_ZERO_POSINFINITY; "REAL_ABEL_LEMMA",REAL_ABEL_LEMMA; "REAL_ABEL_LIMIT_THEOREM",REAL_ABEL_LIMIT_THEOREM; "REAL_ABS_0",REAL_ABS_0; "REAL_ABS_1",REAL_ABS_1; "REAL_ABS_ABS",REAL_ABS_ABS; "REAL_ABS_BETWEEN",REAL_ABS_BETWEEN; "REAL_ABS_BETWEEN1",REAL_ABS_BETWEEN1; "REAL_ABS_BETWEEN2",REAL_ABS_BETWEEN2; "REAL_ABS_BOUND",REAL_ABS_BOUND; "REAL_ABS_BOUNDS",REAL_ABS_BOUNDS; "REAL_ABS_CASES",REAL_ABS_CASES; "REAL_ABS_CIRCLE",REAL_ABS_CIRCLE; "REAL_ABS_COS_MONO_LE_EQ",REAL_ABS_COS_MONO_LE_EQ; "REAL_ABS_DIST",REAL_ABS_DIST; "REAL_ABS_DIV",REAL_ABS_DIV; "REAL_ABS_EXP",REAL_ABS_EXP; "REAL_ABS_HAUSDIST",REAL_ABS_HAUSDIST; "REAL_ABS_INFNORM",REAL_ABS_INFNORM; "REAL_ABS_INF_LE",REAL_ABS_INF_LE; "REAL_ABS_INTEGER_LEMMA",REAL_ABS_INTEGER_LEMMA; "REAL_ABS_INV",REAL_ABS_INV; "REAL_ABS_LE",REAL_ABS_LE; "REAL_ABS_MDIST",REAL_ABS_MDIST; "REAL_ABS_MUL",REAL_ABS_MUL; "REAL_ABS_NEG",REAL_ABS_NEG; "REAL_ABS_NORM",REAL_ABS_NORM; "REAL_ABS_NUM",REAL_ABS_NUM; "REAL_ABS_NZ",REAL_ABS_NZ; "REAL_ABS_PI",REAL_ABS_PI; "REAL_ABS_POS",REAL_ABS_POS; "REAL_ABS_POW",REAL_ABS_POW; "REAL_ABS_REFL",REAL_ABS_REFL; "REAL_ABS_RPOW",REAL_ABS_RPOW; "REAL_ABS_SGN",REAL_ABS_SGN; "REAL_ABS_SIGN",REAL_ABS_SIGN; "REAL_ABS_SIGN2",REAL_ABS_SIGN2; "REAL_ABS_SIN_BOUND_LE",REAL_ABS_SIN_BOUND_LE; "REAL_ABS_SIN_BOUND_LT",REAL_ABS_SIN_BOUND_LT; "REAL_ABS_STILLNZ",REAL_ABS_STILLNZ; "REAL_ABS_SUB",REAL_ABS_SUB; "REAL_ABS_SUB_ABS",REAL_ABS_SUB_ABS; "REAL_ABS_SUB_INFNORM",REAL_ABS_SUB_INFNORM; "REAL_ABS_SUB_NORM",REAL_ABS_SUB_NORM; "REAL_ABS_SUP_LE",REAL_ABS_SUP_LE; "REAL_ABS_TRIANGLE",REAL_ABS_TRIANGLE; "REAL_ABS_TRIANGLE_LE",REAL_ABS_TRIANGLE_LE; "REAL_ABS_TRIANGLE_LT",REAL_ABS_TRIANGLE_LT; "REAL_ABS_ZERO",REAL_ABS_ZERO; "REAL_ACS",REAL_ACS; "REAL_ADD",REAL_ADD; "REAL_ADD2_SUB2",REAL_ADD2_SUB2; "REAL_ADD_AC",REAL_ADD_AC; "REAL_ADD_ARG",REAL_ADD_ARG; "REAL_ADD_ASSOC",REAL_ADD_ASSOC; "REAL_ADD_COS",REAL_ADD_COS; "REAL_ADD_LDISTRIB",REAL_ADD_LDISTRIB; "REAL_ADD_LID",REAL_ADD_LID; "REAL_ADD_LINV",REAL_ADD_LINV; "REAL_ADD_RDISTRIB",REAL_ADD_RDISTRIB; "REAL_ADD_RID",REAL_ADD_RID; "REAL_ADD_RINV",REAL_ADD_RINV; "REAL_ADD_SIN",REAL_ADD_SIN; "REAL_ADD_SUB",REAL_ADD_SUB; "REAL_ADD_SUB2",REAL_ADD_SUB2; "REAL_ADD_SYM",REAL_ADD_SYM; "REAL_ADD_TAN",REAL_ADD_TAN; "REAL_AFFINITY_EQ",REAL_AFFINITY_EQ; "REAL_AFFINITY_LE",REAL_AFFINITY_LE; "REAL_AFFINITY_LT",REAL_AFFINITY_LT; "REAL_ANTIDERIVATIVE_CONTINUOUS",REAL_ANTIDERIVATIVE_CONTINUOUS; "REAL_ANTIDERIVATIVE_INTEGRAL_CONTINUOUS",REAL_ANTIDERIVATIVE_INTEGRAL_CONTINUOUS; "REAL_ARCH",REAL_ARCH; "REAL_ARCH_INV",REAL_ARCH_INV; "REAL_ARCH_LT",REAL_ARCH_LT; "REAL_ARCH_POW",REAL_ARCH_POW; "REAL_ARCH_POW2",REAL_ARCH_POW2; "REAL_ARCH_POW_INV",REAL_ARCH_POW_INV; "REAL_ARCH_RDIV_EQ_0",REAL_ARCH_RDIV_EQ_0; "REAL_ARCH_SIMPLE",REAL_ARCH_SIMPLE; "REAL_ASN",REAL_ASN; "REAL_BEPPO_LEVI_DECREASING",REAL_BEPPO_LEVI_DECREASING; "REAL_BEPPO_LEVI_INCREASING",REAL_BEPPO_LEVI_INCREASING; "REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING",REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING; "REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING",REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING; "REAL_BINOMIAL_THEOREM",REAL_BINOMIAL_THEOREM; "REAL_BOUNDED",REAL_BOUNDED; "REAL_BOUNDED_POS",REAL_BOUNDED_POS; "REAL_BOUNDED_POS_LT",REAL_BOUNDED_POS_LT; "REAL_BOUNDED_REAL_INTERVAL",REAL_BOUNDED_REAL_INTERVAL; "REAL_BOUNDED_SUBSET",REAL_BOUNDED_SUBSET; "REAL_BOUNDED_UNION",REAL_BOUNDED_UNION; "REAL_BOUNDS_LE",REAL_BOUNDS_LE; "REAL_BOUNDS_LT",REAL_BOUNDS_LT; "REAL_CARD_INTSEG_INT",REAL_CARD_INTSEG_INT; "REAL_CLOSED",REAL_CLOSED; "REAL_CLOSED_DIFF",REAL_CLOSED_DIFF; "REAL_CLOSED_EMPTY",REAL_CLOSED_EMPTY; "REAL_CLOSED_HALFSPACE_GE",REAL_CLOSED_HALFSPACE_GE; "REAL_CLOSED_HALFSPACE_LE",REAL_CLOSED_HALFSPACE_LE; "REAL_CLOSED_IN",REAL_CLOSED_IN; "REAL_CLOSED_INTER",REAL_CLOSED_INTER; "REAL_CLOSED_INTERS",REAL_CLOSED_INTERS; "REAL_CLOSED_OPEN_INTERVAL",REAL_CLOSED_OPEN_INTERVAL; "REAL_CLOSED_REAL_INTERVAL",REAL_CLOSED_REAL_INTERVAL; "REAL_CLOSED_UNION",REAL_CLOSED_UNION; "REAL_CLOSED_UNIONS",REAL_CLOSED_UNIONS; "REAL_CLOSED_UNIV",REAL_CLOSED_UNIV; "REAL_CNJ",REAL_CNJ; "REAL_COMPACT_ATTAINS_INF",REAL_COMPACT_ATTAINS_INF; "REAL_COMPACT_ATTAINS_SUP",REAL_COMPACT_ATTAINS_SUP; "REAL_COMPACT_CONTINUOUS_IMAGE",REAL_COMPACT_CONTINUOUS_IMAGE; "REAL_COMPACT_EQ_BOUNDED_CLOSED",REAL_COMPACT_EQ_BOUNDED_CLOSED; "REAL_COMPACT_IMP_BOUNDED",REAL_COMPACT_IMP_BOUNDED; "REAL_COMPACT_IMP_CLOSED",REAL_COMPACT_IMP_CLOSED; "REAL_COMPACT_INTERVAL",REAL_COMPACT_INTERVAL; "REAL_COMPACT_UNIFORMLY_CONTINUOUS",REAL_COMPACT_UNIFORMLY_CONTINUOUS; "REAL_COMPACT_UNION",REAL_COMPACT_UNION; "REAL_COMPLETE",REAL_COMPLETE; "REAL_COMPLETE_SOMEPOS",REAL_COMPLETE_SOMEPOS; "REAL_COMPLEX_CONTINUOUS_ATREAL",REAL_COMPLEX_CONTINUOUS_ATREAL; "REAL_COMPLEX_CONTINUOUS_WITHINREAL",REAL_COMPLEX_CONTINUOUS_WITHINREAL; "REAL_COMPLEX_INTEGRAL",REAL_COMPLEX_INTEGRAL; "REAL_COMPLEX_MEASURABLE_ON",REAL_COMPLEX_MEASURABLE_ON; "REAL_CONTINUOUS_ABS",REAL_CONTINUOUS_ABS; "REAL_CONTINUOUS_ADD",REAL_CONTINUOUS_ADD; "REAL_CONTINUOUS_ADDITIVE_EXTEND",REAL_CONTINUOUS_ADDITIVE_EXTEND; "REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR",REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR; "REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL",REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL; "REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "REAL_CONTINUOUS_AT",REAL_CONTINUOUS_AT; "REAL_CONTINUOUS_ATREAL",REAL_CONTINUOUS_ATREAL; "REAL_CONTINUOUS_ATREAL_COMPOSE",REAL_CONTINUOUS_ATREAL_COMPOSE; "REAL_CONTINUOUS_ATREAL_SQRT_COMPOSE",REAL_CONTINUOUS_ATREAL_SQRT_COMPOSE; "REAL_CONTINUOUS_ATREAL_WITHINREAL",REAL_CONTINUOUS_ATREAL_WITHINREAL; "REAL_CONTINUOUS_ATTAINS_INF",REAL_CONTINUOUS_ATTAINS_INF; "REAL_CONTINUOUS_ATTAINS_SUP",REAL_CONTINUOUS_ATTAINS_SUP; "REAL_CONTINUOUS_AT_ACS",REAL_CONTINUOUS_AT_ACS; "REAL_CONTINUOUS_AT_ARG",REAL_CONTINUOUS_AT_ARG; "REAL_CONTINUOUS_AT_ASN",REAL_CONTINUOUS_AT_ASN; "REAL_CONTINUOUS_AT_ATN",REAL_CONTINUOUS_AT_ATN; "REAL_CONTINUOUS_AT_COMPONENT",REAL_CONTINUOUS_AT_COMPONENT; "REAL_CONTINUOUS_AT_COMPOSE",REAL_CONTINUOUS_AT_COMPOSE; "REAL_CONTINUOUS_AT_COS",REAL_CONTINUOUS_AT_COS; "REAL_CONTINUOUS_AT_EXP",REAL_CONTINUOUS_AT_EXP; "REAL_CONTINUOUS_AT_ID",REAL_CONTINUOUS_AT_ID; "REAL_CONTINUOUS_AT_LINEAR_IMAGE",REAL_CONTINUOUS_AT_LINEAR_IMAGE; "REAL_CONTINUOUS_AT_LOG",REAL_CONTINUOUS_AT_LOG; "REAL_CONTINUOUS_AT_RPOW",REAL_CONTINUOUS_AT_RPOW; "REAL_CONTINUOUS_AT_RPOW_RIGHT",REAL_CONTINUOUS_AT_RPOW_RIGHT; "REAL_CONTINUOUS_AT_SIN",REAL_CONTINUOUS_AT_SIN; "REAL_CONTINUOUS_AT_SQRT",REAL_CONTINUOUS_AT_SQRT; "REAL_CONTINUOUS_AT_SQRT_COMPOSE",REAL_CONTINUOUS_AT_SQRT_COMPOSE; "REAL_CONTINUOUS_AT_TAN",REAL_CONTINUOUS_AT_TAN; "REAL_CONTINUOUS_AT_TRANSLATION",REAL_CONTINUOUS_AT_TRANSLATION; "REAL_CONTINUOUS_AT_WITHIN",REAL_CONTINUOUS_AT_WITHIN; "REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT",REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; "REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN",REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN; "REAL_CONTINUOUS_CONST",REAL_CONTINUOUS_CONST; "REAL_CONTINUOUS_CONTINUOUS",REAL_CONTINUOUS_CONTINUOUS; "REAL_CONTINUOUS_CONTINUOUS1",REAL_CONTINUOUS_CONTINUOUS1; "REAL_CONTINUOUS_CONTINUOUS_ATREAL",REAL_CONTINUOUS_CONTINUOUS_ATREAL; "REAL_CONTINUOUS_CONTINUOUS_ATREAL_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_ATREAL_COMPOSE; "REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE; "REAL_CONTINUOUS_CONTINUOUS_WITHINREAL",REAL_CONTINUOUS_CONTINUOUS_WITHINREAL; "REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE; "REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE; "REAL_CONTINUOUS_DIST_AT",REAL_CONTINUOUS_DIST_AT; "REAL_CONTINUOUS_DIST_WITHIN",REAL_CONTINUOUS_DIST_WITHIN; "REAL_CONTINUOUS_DIV",REAL_CONTINUOUS_DIV; "REAL_CONTINUOUS_DIV_AT",REAL_CONTINUOUS_DIV_AT; "REAL_CONTINUOUS_DIV_ATREAL",REAL_CONTINUOUS_DIV_ATREAL; "REAL_CONTINUOUS_DIV_WITHIN",REAL_CONTINUOUS_DIV_WITHIN; "REAL_CONTINUOUS_DIV_WITHINREAL",REAL_CONTINUOUS_DIV_WITHINREAL; "REAL_CONTINUOUS_FLOOR",REAL_CONTINUOUS_FLOOR; "REAL_CONTINUOUS_FRAC",REAL_CONTINUOUS_FRAC; "REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET",REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; "REAL_CONTINUOUS_INJECTIVE_IFF_MONOTONIC",REAL_CONTINUOUS_INJECTIVE_IFF_MONOTONIC; "REAL_CONTINUOUS_INV",REAL_CONTINUOUS_INV; "REAL_CONTINUOUS_INV_AT",REAL_CONTINUOUS_INV_AT; "REAL_CONTINUOUS_INV_ATREAL",REAL_CONTINUOUS_INV_ATREAL; "REAL_CONTINUOUS_INV_WITHIN",REAL_CONTINUOUS_INV_WITHIN; "REAL_CONTINUOUS_INV_WITHINREAL",REAL_CONTINUOUS_INV_WITHINREAL; "REAL_CONTINUOUS_LMUL",REAL_CONTINUOUS_LMUL; "REAL_CONTINUOUS_MAX",REAL_CONTINUOUS_MAX; "REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE",REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE; "REAL_CONTINUOUS_MIDPOINT_CONVEX",REAL_CONTINUOUS_MIDPOINT_CONVEX; "REAL_CONTINUOUS_MIN",REAL_CONTINUOUS_MIN; "REAL_CONTINUOUS_MUL",REAL_CONTINUOUS_MUL; "REAL_CONTINUOUS_NEG",REAL_CONTINUOUS_NEG; "REAL_CONTINUOUS_NORM_AT",REAL_CONTINUOUS_NORM_AT; "REAL_CONTINUOUS_NORM_WITHIN",REAL_CONTINUOUS_NORM_WITHIN; "REAL_CONTINUOUS_ON",REAL_CONTINUOUS_ON; "REAL_CONTINUOUS_ON_ABS",REAL_CONTINUOUS_ON_ABS; "REAL_CONTINUOUS_ON_ACS",REAL_CONTINUOUS_ON_ACS; "REAL_CONTINUOUS_ON_ADD",REAL_CONTINUOUS_ON_ADD; "REAL_CONTINUOUS_ON_ASN",REAL_CONTINUOUS_ON_ASN; "REAL_CONTINUOUS_ON_ATN",REAL_CONTINUOUS_ON_ATN; "REAL_CONTINUOUS_ON_BERNOULLI",REAL_CONTINUOUS_ON_BERNOULLI; "REAL_CONTINUOUS_ON_CASES",REAL_CONTINUOUS_ON_CASES; "REAL_CONTINUOUS_ON_CASES_OPEN",REAL_CONTINUOUS_ON_CASES_OPEN; "REAL_CONTINUOUS_ON_COMPOSE",REAL_CONTINUOUS_ON_COMPOSE; "REAL_CONTINUOUS_ON_COMPOSE_FRAC",REAL_CONTINUOUS_ON_COMPOSE_FRAC; "REAL_CONTINUOUS_ON_CONST",REAL_CONTINUOUS_ON_CONST; "REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS",REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS; "REAL_CONTINUOUS_ON_COS",REAL_CONTINUOUS_ON_COS; "REAL_CONTINUOUS_ON_DIV",REAL_CONTINUOUS_ON_DIV; "REAL_CONTINUOUS_ON_EQ",REAL_CONTINUOUS_ON_EQ; "REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN",REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; "REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT",REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; "REAL_CONTINUOUS_ON_EXP",REAL_CONTINUOUS_ON_EXP; "REAL_CONTINUOUS_ON_ID",REAL_CONTINUOUS_ON_ID; "REAL_CONTINUOUS_ON_INV",REAL_CONTINUOUS_ON_INV; "REAL_CONTINUOUS_ON_INVERSE",REAL_CONTINUOUS_ON_INVERSE; "REAL_CONTINUOUS_ON_INVERSE_ALT",REAL_CONTINUOUS_ON_INVERSE_ALT; "REAL_CONTINUOUS_ON_LMUL",REAL_CONTINUOUS_ON_LMUL; "REAL_CONTINUOUS_ON_LOG",REAL_CONTINUOUS_ON_LOG; "REAL_CONTINUOUS_ON_MUL",REAL_CONTINUOUS_ON_MUL; "REAL_CONTINUOUS_ON_NEG",REAL_CONTINUOUS_ON_NEG; "REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION",REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION; "REAL_CONTINUOUS_ON_POW",REAL_CONTINUOUS_ON_POW; "REAL_CONTINUOUS_ON_PRODUCT",REAL_CONTINUOUS_ON_PRODUCT; "REAL_CONTINUOUS_ON_RMUL",REAL_CONTINUOUS_ON_RMUL; "REAL_CONTINUOUS_ON_RPOW",REAL_CONTINUOUS_ON_RPOW; "REAL_CONTINUOUS_ON_SIN",REAL_CONTINUOUS_ON_SIN; "REAL_CONTINUOUS_ON_SQRT",REAL_CONTINUOUS_ON_SQRT; "REAL_CONTINUOUS_ON_SUB",REAL_CONTINUOUS_ON_SUB; "REAL_CONTINUOUS_ON_SUBSET",REAL_CONTINUOUS_ON_SUBSET; "REAL_CONTINUOUS_ON_SUM",REAL_CONTINUOUS_ON_SUM; "REAL_CONTINUOUS_ON_TAN",REAL_CONTINUOUS_ON_TAN; "REAL_CONTINUOUS_ON_UNION",REAL_CONTINUOUS_ON_UNION; "REAL_CONTINUOUS_ON_UNION_OPEN",REAL_CONTINUOUS_ON_UNION_OPEN; "REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_ATREAL",REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_ATREAL; "REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN",REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN; "REAL_CONTINUOUS_POW",REAL_CONTINUOUS_POW; "REAL_CONTINUOUS_PRODUCT",REAL_CONTINUOUS_PRODUCT; "REAL_CONTINUOUS_REAL_CONTINUOUS_ATREAL",REAL_CONTINUOUS_REAL_CONTINUOUS_ATREAL; "REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL",REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL; "REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION",REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION; "REAL_CONTINUOUS_RMUL",REAL_CONTINUOUS_RMUL; "REAL_CONTINUOUS_RPOW_COMPOSE_WITHIN",REAL_CONTINUOUS_RPOW_COMPOSE_WITHIN; "REAL_CONTINUOUS_SUB",REAL_CONTINUOUS_SUB; "REAL_CONTINUOUS_SUM",REAL_CONTINUOUS_SUM; "REAL_CONTINUOUS_TRANSFORM_AT",REAL_CONTINUOUS_TRANSFORM_AT; "REAL_CONTINUOUS_TRANSFORM_ATREAL",REAL_CONTINUOUS_TRANSFORM_ATREAL; "REAL_CONTINUOUS_TRANSFORM_WITHIN",REAL_CONTINUOUS_TRANSFORM_WITHIN; "REAL_CONTINUOUS_TRANSFORM_WITHINREAL",REAL_CONTINUOUS_TRANSFORM_WITHINREAL; "REAL_CONTINUOUS_TRANSFORM_WITHINREAL_SET_IMP",REAL_CONTINUOUS_TRANSFORM_WITHINREAL_SET_IMP; "REAL_CONTINUOUS_TRANSFORM_WITHIN_SET_IMP",REAL_CONTINUOUS_TRANSFORM_WITHIN_SET_IMP; "REAL_CONTINUOUS_TRIVIAL_LIMIT",REAL_CONTINUOUS_TRIVIAL_LIMIT; "REAL_CONTINUOUS_WITHIN",REAL_CONTINUOUS_WITHIN; "REAL_CONTINUOUS_WITHINREAL",REAL_CONTINUOUS_WITHINREAL; "REAL_CONTINUOUS_WITHINREAL_COMPOSE",REAL_CONTINUOUS_WITHINREAL_COMPOSE; "REAL_CONTINUOUS_WITHINREAL_SQRT_COMPOSE",REAL_CONTINUOUS_WITHINREAL_SQRT_COMPOSE; "REAL_CONTINUOUS_WITHINREAL_SUBSET",REAL_CONTINUOUS_WITHINREAL_SUBSET; "REAL_CONTINUOUS_WITHIN_ACS",REAL_CONTINUOUS_WITHIN_ACS; "REAL_CONTINUOUS_WITHIN_ACS_STRONG",REAL_CONTINUOUS_WITHIN_ACS_STRONG; "REAL_CONTINUOUS_WITHIN_ASN",REAL_CONTINUOUS_WITHIN_ASN; "REAL_CONTINUOUS_WITHIN_ASN_STRONG",REAL_CONTINUOUS_WITHIN_ASN_STRONG; "REAL_CONTINUOUS_WITHIN_ATN",REAL_CONTINUOUS_WITHIN_ATN; "REAL_CONTINUOUS_WITHIN_COMPOSE",REAL_CONTINUOUS_WITHIN_COMPOSE; "REAL_CONTINUOUS_WITHIN_COS",REAL_CONTINUOUS_WITHIN_COS; "REAL_CONTINUOUS_WITHIN_EXP",REAL_CONTINUOUS_WITHIN_EXP; "REAL_CONTINUOUS_WITHIN_ID",REAL_CONTINUOUS_WITHIN_ID; "REAL_CONTINUOUS_WITHIN_LOG",REAL_CONTINUOUS_WITHIN_LOG; "REAL_CONTINUOUS_WITHIN_RPOW",REAL_CONTINUOUS_WITHIN_RPOW; "REAL_CONTINUOUS_WITHIN_SIN",REAL_CONTINUOUS_WITHIN_SIN; "REAL_CONTINUOUS_WITHIN_SQRT",REAL_CONTINUOUS_WITHIN_SQRT; "REAL_CONTINUOUS_WITHIN_SQRT_COMPOSE",REAL_CONTINUOUS_WITHIN_SQRT_COMPOSE; "REAL_CONTINUOUS_WITHIN_SQRT_STRONG",REAL_CONTINUOUS_WITHIN_SQRT_STRONG; "REAL_CONTINUOUS_WITHIN_SUBSET",REAL_CONTINUOUS_WITHIN_SUBSET; "REAL_CONTINUOUS_WITHIN_TAN",REAL_CONTINUOUS_WITHIN_TAN; "REAL_CONVERGENT_IMP_BOUNDED",REAL_CONVERGENT_IMP_BOUNDED; "REAL_CONVEX",REAL_CONVEX; "REAL_CONVEX_ADD",REAL_CONVEX_ADD; "REAL_CONVEX_ALT",REAL_CONVEX_ALT; "REAL_CONVEX_BOUND2_LT",REAL_CONVEX_BOUND2_LT; "REAL_CONVEX_BOUND_LE",REAL_CONVEX_BOUND_LE; "REAL_CONVEX_BOUND_LT",REAL_CONVEX_BOUND_LT; "REAL_CONVEX_COMPOSE",REAL_CONVEX_COMPOSE; "REAL_CONVEX_CONVEX_COMPOSE",REAL_CONVEX_CONVEX_COMPOSE; "REAL_CONVEX_DISTANCE",REAL_CONVEX_DISTANCE; "REAL_CONVEX_LMUL",REAL_CONVEX_LMUL; "REAL_CONVEX_LOCAL_GLOBAL_MINIMUM",REAL_CONVEX_LOCAL_GLOBAL_MINIMUM; "REAL_CONVEX_LOWER",REAL_CONVEX_LOWER; "REAL_CONVEX_ON",REAL_CONVEX_ON; "REAL_CONVEX_ON_ASYM",REAL_CONVEX_ON_ASYM; "REAL_CONVEX_ON_CONTINUOUS",REAL_CONVEX_ON_CONTINUOUS; "REAL_CONVEX_ON_DERIVATIVES",REAL_CONVEX_ON_DERIVATIVES; "REAL_CONVEX_ON_DERIVATIVES_IMP",REAL_CONVEX_ON_DERIVATIVES_IMP; "REAL_CONVEX_ON_DERIVATIVE_INCREASING",REAL_CONVEX_ON_DERIVATIVE_INCREASING; "REAL_CONVEX_ON_DERIVATIVE_INCREASING_IMP",REAL_CONVEX_ON_DERIVATIVE_INCREASING_IMP; "REAL_CONVEX_ON_DERIVATIVE_SECANT",REAL_CONVEX_ON_DERIVATIVE_SECANT; "REAL_CONVEX_ON_DERIVATIVE_SECANT_IMP",REAL_CONVEX_ON_DERIVATIVE_SECANT_IMP; "REAL_CONVEX_ON_EMPTY",REAL_CONVEX_ON_EMPTY; "REAL_CONVEX_ON_EQ",REAL_CONVEX_ON_EQ; "REAL_CONVEX_ON_EXP",REAL_CONVEX_ON_EXP; "REAL_CONVEX_ON_IMP_JENSEN",REAL_CONVEX_ON_IMP_JENSEN; "REAL_CONVEX_ON_JENSEN",REAL_CONVEX_ON_JENSEN; "REAL_CONVEX_ON_LEFT_SECANT",REAL_CONVEX_ON_LEFT_SECANT; "REAL_CONVEX_ON_LEFT_SECANT_MUL",REAL_CONVEX_ON_LEFT_SECANT_MUL; "REAL_CONVEX_ON_LOG",REAL_CONVEX_ON_LOG; "REAL_CONVEX_ON_RIGHT_SECANT",REAL_CONVEX_ON_RIGHT_SECANT; "REAL_CONVEX_ON_RIGHT_SECANT_MUL",REAL_CONVEX_ON_RIGHT_SECANT_MUL; "REAL_CONVEX_ON_RPOW",REAL_CONVEX_ON_RPOW; "REAL_CONVEX_ON_SECANT_DERIVATIVE",REAL_CONVEX_ON_SECANT_DERIVATIVE; "REAL_CONVEX_ON_SECANT_DERIVATIVE_IMP",REAL_CONVEX_ON_SECANT_DERIVATIVE_IMP; "REAL_CONVEX_ON_SECOND_DERIVATIVE",REAL_CONVEX_ON_SECOND_DERIVATIVE; "REAL_CONVEX_ON_SING",REAL_CONVEX_ON_SING; "REAL_CONVEX_ON_SUBSET",REAL_CONVEX_ON_SUBSET; "REAL_CONVEX_RMUL",REAL_CONVEX_RMUL; "REAL_COS",REAL_COS; "REAL_CX",REAL_CX; "REAL_DERIVATIVE_IVT_DECREASING",REAL_DERIVATIVE_IVT_DECREASING; "REAL_DERIVATIVE_IVT_INCREASING",REAL_DERIVATIVE_IVT_INCREASING; "REAL_DERIVATIVE_NEG_LEFT_MAXIMUM",REAL_DERIVATIVE_NEG_LEFT_MAXIMUM; "REAL_DERIVATIVE_NEG_RIGHT_MINIMUM",REAL_DERIVATIVE_NEG_RIGHT_MINIMUM; "REAL_DERIVATIVE_POS_LEFT_MINIMUM",REAL_DERIVATIVE_POS_LEFT_MINIMUM; "REAL_DERIVATIVE_POS_RIGHT_MAXIMUM",REAL_DERIVATIVE_POS_RIGHT_MAXIMUM; "REAL_DERIVATIVE_UNIQUE_ATREAL",REAL_DERIVATIVE_UNIQUE_ATREAL; "REAL_DERIVATIVE_ZERO_MAXMIN",REAL_DERIVATIVE_ZERO_MAXMIN; "REAL_DIFFERENTIABLE_ADD",REAL_DIFFERENTIABLE_ADD; "REAL_DIFFERENTIABLE_AT",REAL_DIFFERENTIABLE_AT; "REAL_DIFFERENTIABLE_ATREAL_WITHIN",REAL_DIFFERENTIABLE_ATREAL_WITHIN; "REAL_DIFFERENTIABLE_AT_ACS",REAL_DIFFERENTIABLE_AT_ACS; "REAL_DIFFERENTIABLE_AT_ASN",REAL_DIFFERENTIABLE_AT_ASN; "REAL_DIFFERENTIABLE_AT_ATN",REAL_DIFFERENTIABLE_AT_ATN; "REAL_DIFFERENTIABLE_AT_COS",REAL_DIFFERENTIABLE_AT_COS; "REAL_DIFFERENTIABLE_AT_EXP",REAL_DIFFERENTIABLE_AT_EXP; "REAL_DIFFERENTIABLE_AT_LOG",REAL_DIFFERENTIABLE_AT_LOG; "REAL_DIFFERENTIABLE_AT_RPOW",REAL_DIFFERENTIABLE_AT_RPOW; "REAL_DIFFERENTIABLE_AT_RPOW_RIGHT",REAL_DIFFERENTIABLE_AT_RPOW_RIGHT; "REAL_DIFFERENTIABLE_AT_SIN",REAL_DIFFERENTIABLE_AT_SIN; "REAL_DIFFERENTIABLE_AT_SQRT",REAL_DIFFERENTIABLE_AT_SQRT; "REAL_DIFFERENTIABLE_AT_TAN",REAL_DIFFERENTIABLE_AT_TAN; "REAL_DIFFERENTIABLE_BOUND",REAL_DIFFERENTIABLE_BOUND; "REAL_DIFFERENTIABLE_CARATHEODORY_ATREAL",REAL_DIFFERENTIABLE_CARATHEODORY_ATREAL; "REAL_DIFFERENTIABLE_CARATHEODORY_WITHINREAL",REAL_DIFFERENTIABLE_CARATHEODORY_WITHINREAL; "REAL_DIFFERENTIABLE_COMPOSE_ATREAL",REAL_DIFFERENTIABLE_COMPOSE_ATREAL; "REAL_DIFFERENTIABLE_COMPOSE_WITHIN",REAL_DIFFERENTIABLE_COMPOSE_WITHIN; "REAL_DIFFERENTIABLE_CONST",REAL_DIFFERENTIABLE_CONST; "REAL_DIFFERENTIABLE_DIV_ATREAL",REAL_DIFFERENTIABLE_DIV_ATREAL; "REAL_DIFFERENTIABLE_DIV_WITHIN",REAL_DIFFERENTIABLE_DIV_WITHIN; "REAL_DIFFERENTIABLE_EQ",REAL_DIFFERENTIABLE_EQ; "REAL_DIFFERENTIABLE_FRAC",REAL_DIFFERENTIABLE_FRAC; "REAL_DIFFERENTIABLE_FROM_COMPLEX_AT",REAL_DIFFERENTIABLE_FROM_COMPLEX_AT; "REAL_DIFFERENTIABLE_ID",REAL_DIFFERENTIABLE_ID; "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL",REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; "REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL",REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL; "REAL_DIFFERENTIABLE_INV_ATREAL",REAL_DIFFERENTIABLE_INV_ATREAL; "REAL_DIFFERENTIABLE_INV_WITHIN",REAL_DIFFERENTIABLE_INV_WITHIN; "REAL_DIFFERENTIABLE_MUL_ATREAL",REAL_DIFFERENTIABLE_MUL_ATREAL; "REAL_DIFFERENTIABLE_MUL_WITHIN",REAL_DIFFERENTIABLE_MUL_WITHIN; "REAL_DIFFERENTIABLE_NEG",REAL_DIFFERENTIABLE_NEG; "REAL_DIFFERENTIABLE_ON_ADD",REAL_DIFFERENTIABLE_ON_ADD; "REAL_DIFFERENTIABLE_ON_BERNOULLI",REAL_DIFFERENTIABLE_ON_BERNOULLI; "REAL_DIFFERENTIABLE_ON_COMPOSE",REAL_DIFFERENTIABLE_ON_COMPOSE; "REAL_DIFFERENTIABLE_ON_CONST",REAL_DIFFERENTIABLE_ON_CONST; "REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE",REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; "REAL_DIFFERENTIABLE_ON_DIV",REAL_DIFFERENTIABLE_ON_DIV; "REAL_DIFFERENTIABLE_ON_ID",REAL_DIFFERENTIABLE_ON_ID; "REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_ATREAL",REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_ATREAL; "REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_WITHIN",REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_WITHIN; "REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON",REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; "REAL_DIFFERENTIABLE_ON_INV",REAL_DIFFERENTIABLE_ON_INV; "REAL_DIFFERENTIABLE_ON_MUL",REAL_DIFFERENTIABLE_ON_MUL; "REAL_DIFFERENTIABLE_ON_NEG",REAL_DIFFERENTIABLE_ON_NEG; "REAL_DIFFERENTIABLE_ON_POLYNOMIAL_FUNCTION",REAL_DIFFERENTIABLE_ON_POLYNOMIAL_FUNCTION; "REAL_DIFFERENTIABLE_ON_POW",REAL_DIFFERENTIABLE_ON_POW; "REAL_DIFFERENTIABLE_ON_REAL_OPEN",REAL_DIFFERENTIABLE_ON_REAL_OPEN; "REAL_DIFFERENTIABLE_ON_SUB",REAL_DIFFERENTIABLE_ON_SUB; "REAL_DIFFERENTIABLE_ON_SUBSET",REAL_DIFFERENTIABLE_ON_SUBSET; "REAL_DIFFERENTIABLE_ON_SUM",REAL_DIFFERENTIABLE_ON_SUM; "REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL",REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL; "REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN",REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN; "REAL_DIFFERENTIABLE_POW_ATREAL",REAL_DIFFERENTIABLE_POW_ATREAL; "REAL_DIFFERENTIABLE_POW_WITHIN",REAL_DIFFERENTIABLE_POW_WITHIN; "REAL_DIFFERENTIABLE_SUB",REAL_DIFFERENTIABLE_SUB; "REAL_DIFFERENTIABLE_TRANSFORM",REAL_DIFFERENTIABLE_TRANSFORM; "REAL_DIFFERENTIABLE_TRANSFORM_ATREAL",REAL_DIFFERENTIABLE_TRANSFORM_ATREAL; "REAL_DIFFERENTIABLE_TRANSFORM_WITHIN",REAL_DIFFERENTIABLE_TRANSFORM_WITHIN; "REAL_DIFFERENTIABLE_WITHIN",REAL_DIFFERENTIABLE_WITHIN; "REAL_DIFFERENTIABLE_WITHIN_ACS",REAL_DIFFERENTIABLE_WITHIN_ACS; "REAL_DIFFERENTIABLE_WITHIN_ASN",REAL_DIFFERENTIABLE_WITHIN_ASN; "REAL_DIFFERENTIABLE_WITHIN_ATN",REAL_DIFFERENTIABLE_WITHIN_ATN; "REAL_DIFFERENTIABLE_WITHIN_COS",REAL_DIFFERENTIABLE_WITHIN_COS; "REAL_DIFFERENTIABLE_WITHIN_EXP",REAL_DIFFERENTIABLE_WITHIN_EXP; "REAL_DIFFERENTIABLE_WITHIN_LOG",REAL_DIFFERENTIABLE_WITHIN_LOG; "REAL_DIFFERENTIABLE_WITHIN_SIN",REAL_DIFFERENTIABLE_WITHIN_SIN; "REAL_DIFFERENTIABLE_WITHIN_SQRT",REAL_DIFFERENTIABLE_WITHIN_SQRT; "REAL_DIFFERENTIABLE_WITHIN_SUBSET",REAL_DIFFERENTIABLE_WITHIN_SUBSET; "REAL_DIFFERENTIABLE_WITHIN_TAN",REAL_DIFFERENTIABLE_WITHIN_TAN; "REAL_DIFFSQ",REAL_DIFFSQ; "REAL_DIFF_CHAIN_ATREAL",REAL_DIFF_CHAIN_ATREAL; "REAL_DIFF_CHAIN_WITHIN",REAL_DIFF_CHAIN_WITHIN; "REAL_DINI",REAL_DINI; "REAL_DIV",REAL_DIV; "REAL_DIV_1",REAL_DIV_1; "REAL_DIV_EQ_0",REAL_DIV_EQ_0; "REAL_DIV_LMUL",REAL_DIV_LMUL; "REAL_DIV_POW2",REAL_DIV_POW2; "REAL_DIV_POW2_ALT",REAL_DIV_POW2_ALT; "REAL_DIV_REFL",REAL_DIV_REFL; "REAL_DIV_RMUL",REAL_DIV_RMUL; "REAL_DIV_SQRT",REAL_DIV_SQRT; "REAL_DOMINATED_CONVERGENCE",REAL_DOMINATED_CONVERGENCE; "REAL_DOWN",REAL_DOWN; "REAL_DOWN2",REAL_DOWN2; "REAL_ENTIRE",REAL_ENTIRE; "REAL_EQ_ADD_LCANCEL",REAL_EQ_ADD_LCANCEL; "REAL_EQ_ADD_LCANCEL_0",REAL_EQ_ADD_LCANCEL_0; "REAL_EQ_ADD_RCANCEL",REAL_EQ_ADD_RCANCEL; "REAL_EQ_ADD_RCANCEL_0",REAL_EQ_ADD_RCANCEL_0; "REAL_EQ_AFFINITY",REAL_EQ_AFFINITY; "REAL_EQ_IMP_LE",REAL_EQ_IMP_LE; "REAL_EQ_INTEGERS",REAL_EQ_INTEGERS; "REAL_EQ_INTEGERS_IMP",REAL_EQ_INTEGERS_IMP; "REAL_EQ_INV2",REAL_EQ_INV2; "REAL_EQ_LCANCEL_IMP",REAL_EQ_LCANCEL_IMP; "REAL_EQ_LDIV_EQ",REAL_EQ_LDIV_EQ; "REAL_EQ_MUL_LCANCEL",REAL_EQ_MUL_LCANCEL; "REAL_EQ_MUL_RCANCEL",REAL_EQ_MUL_RCANCEL; "REAL_EQ_NEG2",REAL_EQ_NEG2; "REAL_EQ_RCANCEL_IMP",REAL_EQ_RCANCEL_IMP; "REAL_EQ_RDIV_EQ",REAL_EQ_RDIV_EQ; "REAL_EQ_SGN_ABS",REAL_EQ_SGN_ABS; "REAL_EQ_SQUARE_ABS",REAL_EQ_SQUARE_ABS; "REAL_EQ_SUB_LADD",REAL_EQ_SUB_LADD; "REAL_EQ_SUB_RADD",REAL_EQ_SUB_RADD; "REAL_EUCLIDEAN_METRIC",REAL_EUCLIDEAN_METRIC; "REAL_EULER_MACLAURIN",REAL_EULER_MACLAURIN; "REAL_EULER_MACLAURIN_ANTIDERIVATIVE",REAL_EULER_MACLAURIN_ANTIDERIVATIVE; "REAL_EXISTS",REAL_EXISTS; "REAL_EXP",REAL_EXP; "REAL_EXP_0",REAL_EXP_0; "REAL_EXP_ADD",REAL_EXP_ADD; "REAL_EXP_ADD_MUL",REAL_EXP_ADD_MUL; "REAL_EXP_BOUND_LEMMA",REAL_EXP_BOUND_LEMMA; "REAL_EXP_EQ_1",REAL_EXP_EQ_1; "REAL_EXP_INJ",REAL_EXP_INJ; "REAL_EXP_LE_X",REAL_EXP_LE_X; "REAL_EXP_LIMIT_RPOW_LE",REAL_EXP_LIMIT_RPOW_LE; "REAL_EXP_LIMIT_RPOW_LT",REAL_EXP_LIMIT_RPOW_LT; "REAL_EXP_LOG",REAL_EXP_LOG; "REAL_EXP_LT_1",REAL_EXP_LT_1; "REAL_EXP_MONO_IMP",REAL_EXP_MONO_IMP; "REAL_EXP_MONO_LE",REAL_EXP_MONO_LE; "REAL_EXP_MONO_LT",REAL_EXP_MONO_LT; "REAL_EXP_N",REAL_EXP_N; "REAL_EXP_NEG",REAL_EXP_NEG; "REAL_EXP_NEG_MUL",REAL_EXP_NEG_MUL; "REAL_EXP_NEG_MUL2",REAL_EXP_NEG_MUL2; "REAL_EXP_NZ",REAL_EXP_NZ; "REAL_EXP_POS_LE",REAL_EXP_POS_LE; "REAL_EXP_POS_LT",REAL_EXP_POS_LT; "REAL_EXP_SUB",REAL_EXP_SUB; "REAL_EXP_SUM",REAL_EXP_SUM; "REAL_FLOOR_ADD",REAL_FLOOR_ADD; "REAL_FLOOR_EQ",REAL_FLOOR_EQ; "REAL_FLOOR_FLOOR_DIV",REAL_FLOOR_FLOOR_DIV; "REAL_FLOOR_LE",REAL_FLOOR_LE; "REAL_FLOOR_LT",REAL_FLOOR_LT; "REAL_FLOOR_LT_REFL",REAL_FLOOR_LT_REFL; "REAL_FLOOR_NEG",REAL_FLOOR_NEG; "REAL_FLOOR_REFL",REAL_FLOOR_REFL; "REAL_FLOOR_TRIANGLE",REAL_FLOOR_TRIANGLE; "REAL_FRAC_ADD",REAL_FRAC_ADD; "REAL_FRAC_EQ",REAL_FRAC_EQ; "REAL_FRAC_EQ_0",REAL_FRAC_EQ_0; "REAL_FRAC_POS_LT",REAL_FRAC_POS_LT; "REAL_FRAC_ZERO",REAL_FRAC_ZERO; "REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS; "REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR; "REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG; "REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG; "REAL_HALF",REAL_HALF; "REAL_HAUSDIST_LE",REAL_HAUSDIST_LE; "REAL_HAUSDIST_LE_EQ",REAL_HAUSDIST_LE_EQ; "REAL_HAUSDIST_LE_SUMS",REAL_HAUSDIST_LE_SUMS; "REAL_HREAL_LEMMA1",REAL_HREAL_LEMMA1; "REAL_HREAL_LEMMA2",REAL_HREAL_LEMMA2; "REAL_IMP_CNJ",REAL_IMP_CNJ; "REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT",REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; "REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT",REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT; "REAL_INFSUM",REAL_INFSUM; "REAL_INFSUM_0",REAL_INFSUM_0; "REAL_INFSUM_ADD",REAL_INFSUM_ADD; "REAL_INFSUM_COMPLEX",REAL_INFSUM_COMPLEX; "REAL_INFSUM_EQ",REAL_INFSUM_EQ; "REAL_INFSUM_EVEN",REAL_INFSUM_EVEN; "REAL_INFSUM_LMUL",REAL_INFSUM_LMUL; "REAL_INFSUM_NEG",REAL_INFSUM_NEG; "REAL_INFSUM_ODD",REAL_INFSUM_ODD; "REAL_INFSUM_RESTRICT",REAL_INFSUM_RESTRICT; "REAL_INFSUM_RMUL",REAL_INFSUM_RMUL; "REAL_INFSUM_SUB",REAL_INFSUM_SUB; "REAL_INFSUM_UNIQUE",REAL_INFSUM_UNIQUE; "REAL_INF_ASCLOSE",REAL_INF_ASCLOSE; "REAL_INF_BOUNDS",REAL_INF_BOUNDS; "REAL_INF_LE",REAL_INF_LE; "REAL_INF_LE_FINITE",REAL_INF_LE_FINITE; "REAL_INF_LT_FINITE",REAL_INF_LT_FINITE; "REAL_INF_UNIQUE",REAL_INF_UNIQUE; "REAL_INTEGRABLE_0",REAL_INTEGRABLE_0; "REAL_INTEGRABLE_ADD",REAL_INTEGRABLE_ADD; "REAL_INTEGRABLE_AFFINITY",REAL_INTEGRABLE_AFFINITY; "REAL_INTEGRABLE_BY_PARTS",REAL_INTEGRABLE_BY_PARTS; "REAL_INTEGRABLE_BY_PARTS_EQ",REAL_INTEGRABLE_BY_PARTS_EQ; "REAL_INTEGRABLE_COMBINE",REAL_INTEGRABLE_COMBINE; "REAL_INTEGRABLE_CONST",REAL_INTEGRABLE_CONST; "REAL_INTEGRABLE_CONTINUOUS",REAL_INTEGRABLE_CONTINUOUS; "REAL_INTEGRABLE_DECREASING",REAL_INTEGRABLE_DECREASING; "REAL_INTEGRABLE_DECREASING_PRODUCT",REAL_INTEGRABLE_DECREASING_PRODUCT; "REAL_INTEGRABLE_DECREASING_PRODUCT_UNIV",REAL_INTEGRABLE_DECREASING_PRODUCT_UNIV; "REAL_INTEGRABLE_EQ",REAL_INTEGRABLE_EQ; "REAL_INTEGRABLE_INCREASING",REAL_INTEGRABLE_INCREASING; "REAL_INTEGRABLE_INCREASING_PRODUCT",REAL_INTEGRABLE_INCREASING_PRODUCT; "REAL_INTEGRABLE_INCREASING_PRODUCT_UNIV",REAL_INTEGRABLE_INCREASING_PRODUCT_UNIV; "REAL_INTEGRABLE_INTEGRAL",REAL_INTEGRABLE_INTEGRAL; "REAL_INTEGRABLE_LINEAR",REAL_INTEGRABLE_LINEAR; "REAL_INTEGRABLE_LMUL",REAL_INTEGRABLE_LMUL; "REAL_INTEGRABLE_LMUL_EQ",REAL_INTEGRABLE_LMUL_EQ; "REAL_INTEGRABLE_NEG",REAL_INTEGRABLE_NEG; "REAL_INTEGRABLE_ON",REAL_INTEGRABLE_ON; "REAL_INTEGRABLE_ON_EMPTY",REAL_INTEGRABLE_ON_EMPTY; "REAL_INTEGRABLE_ON_LITTLE_SUBINTERVALS",REAL_INTEGRABLE_ON_LITTLE_SUBINTERVALS; "REAL_INTEGRABLE_ON_NULL",REAL_INTEGRABLE_ON_NULL; "REAL_INTEGRABLE_ON_OPEN_INTERVAL",REAL_INTEGRABLE_ON_OPEN_INTERVAL; "REAL_INTEGRABLE_ON_REFL",REAL_INTEGRABLE_ON_REFL; "REAL_INTEGRABLE_ON_SUBINTERVAL",REAL_INTEGRABLE_ON_SUBINTERVAL; "REAL_INTEGRABLE_ON_SUBINTERVAL_GEN",REAL_INTEGRABLE_ON_SUBINTERVAL_GEN; "REAL_INTEGRABLE_ON_SUPERSET",REAL_INTEGRABLE_ON_SUPERSET; "REAL_INTEGRABLE_REAL_BOUNDED_VARIATION_PRODUCT",REAL_INTEGRABLE_REAL_BOUNDED_VARIATION_PRODUCT; "REAL_INTEGRABLE_REFLECT",REAL_INTEGRABLE_REFLECT; "REAL_INTEGRABLE_REFLECT_GEN",REAL_INTEGRABLE_REFLECT_GEN; "REAL_INTEGRABLE_RESTRICT_INTER",REAL_INTEGRABLE_RESTRICT_INTER; "REAL_INTEGRABLE_RESTRICT_UNIV",REAL_INTEGRABLE_RESTRICT_UNIV; "REAL_INTEGRABLE_RMUL",REAL_INTEGRABLE_RMUL; "REAL_INTEGRABLE_RMUL_EQ",REAL_INTEGRABLE_RMUL_EQ; "REAL_INTEGRABLE_SPIKE",REAL_INTEGRABLE_SPIKE; "REAL_INTEGRABLE_SPIKE_EQ",REAL_INTEGRABLE_SPIKE_EQ; "REAL_INTEGRABLE_SPIKE_FINITE",REAL_INTEGRABLE_SPIKE_FINITE; "REAL_INTEGRABLE_SPIKE_INTERIOR",REAL_INTEGRABLE_SPIKE_INTERIOR; "REAL_INTEGRABLE_SPIKE_SET",REAL_INTEGRABLE_SPIKE_SET; "REAL_INTEGRABLE_SPIKE_SET_EQ",REAL_INTEGRABLE_SPIKE_SET_EQ; "REAL_INTEGRABLE_STRADDLE",REAL_INTEGRABLE_STRADDLE; "REAL_INTEGRABLE_STRETCH",REAL_INTEGRABLE_STRETCH; "REAL_INTEGRABLE_SUB",REAL_INTEGRABLE_SUB; "REAL_INTEGRABLE_SUBINTERVAL",REAL_INTEGRABLE_SUBINTERVAL; "REAL_INTEGRABLE_SUM",REAL_INTEGRABLE_SUM; "REAL_INTEGRABLE_UNIFORM_LIMIT",REAL_INTEGRABLE_UNIFORM_LIMIT; "REAL_INTEGRAL",REAL_INTEGRAL; "REAL_INTEGRAL_0",REAL_INTEGRAL_0; "REAL_INTEGRAL_ABS_BOUND_INTEGRAL",REAL_INTEGRAL_ABS_BOUND_INTEGRAL; "REAL_INTEGRAL_ADD",REAL_INTEGRAL_ADD; "REAL_INTEGRAL_COMBINE",REAL_INTEGRAL_COMBINE; "REAL_INTEGRAL_CONST",REAL_INTEGRAL_CONST; "REAL_INTEGRAL_EMPTY",REAL_INTEGRAL_EMPTY; "REAL_INTEGRAL_EQ",REAL_INTEGRAL_EQ; "REAL_INTEGRAL_EQ_0",REAL_INTEGRAL_EQ_0; "REAL_INTEGRAL_EQ_HAS_INTEGRAL",REAL_INTEGRAL_EQ_HAS_INTEGRAL; "REAL_INTEGRAL_HAS_REAL_DERIVATIVE",REAL_INTEGRAL_HAS_REAL_DERIVATIVE; "REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE",REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE; "REAL_INTEGRAL_LBOUND",REAL_INTEGRAL_LBOUND; "REAL_INTEGRAL_LE",REAL_INTEGRAL_LE; "REAL_INTEGRAL_LINEAR",REAL_INTEGRAL_LINEAR; "REAL_INTEGRAL_LMUL",REAL_INTEGRAL_LMUL; "REAL_INTEGRAL_NEG",REAL_INTEGRAL_NEG; "REAL_INTEGRAL_NULL",REAL_INTEGRAL_NULL; "REAL_INTEGRAL_OPEN_INTERVAL",REAL_INTEGRAL_OPEN_INTERVAL; "REAL_INTEGRAL_POS",REAL_INTEGRAL_POS; "REAL_INTEGRAL_REAL_MEASURE",REAL_INTEGRAL_REAL_MEASURE; "REAL_INTEGRAL_REAL_MEASURE_UNIV",REAL_INTEGRAL_REAL_MEASURE_UNIV; "REAL_INTEGRAL_REFL",REAL_INTEGRAL_REFL; "REAL_INTEGRAL_REFLECT",REAL_INTEGRAL_REFLECT; "REAL_INTEGRAL_REFLECT_GEN",REAL_INTEGRAL_REFLECT_GEN; "REAL_INTEGRAL_RESTRICT",REAL_INTEGRAL_RESTRICT; "REAL_INTEGRAL_RESTRICT_INTER",REAL_INTEGRAL_RESTRICT_INTER; "REAL_INTEGRAL_RESTRICT_UNIV",REAL_INTEGRAL_RESTRICT_UNIV; "REAL_INTEGRAL_RMUL",REAL_INTEGRAL_RMUL; "REAL_INTEGRAL_SPIKE",REAL_INTEGRAL_SPIKE; "REAL_INTEGRAL_SPIKE_SET",REAL_INTEGRAL_SPIKE_SET; "REAL_INTEGRAL_SUB",REAL_INTEGRAL_SUB; "REAL_INTEGRAL_SUBSET_LE",REAL_INTEGRAL_SUBSET_LE; "REAL_INTEGRAL_SUBSTITUTION",REAL_INTEGRAL_SUBSTITUTION; "REAL_INTEGRAL_SUBSTITUTION_SIMPLE",REAL_INTEGRAL_SUBSTITUTION_SIMPLE; "REAL_INTEGRAL_SUM",REAL_INTEGRAL_SUM; "REAL_INTEGRAL_UBOUND",REAL_INTEGRAL_UBOUND; "REAL_INTEGRAL_UNIQUE",REAL_INTEGRAL_UNIQUE; "REAL_INTEGRATION_BY_PARTS",REAL_INTEGRATION_BY_PARTS; "REAL_INTEGRATION_BY_PARTS_SIMPLE",REAL_INTEGRATION_BY_PARTS_SIMPLE; "REAL_INTERVAL_EQ_EMPTY",REAL_INTERVAL_EQ_EMPTY; "REAL_INTERVAL_INTERVAL",REAL_INTERVAL_INTERVAL; "REAL_INTERVAL_NE_EMPTY",REAL_INTERVAL_NE_EMPTY; "REAL_INTERVAL_OPEN_SUBSET_CLOSED",REAL_INTERVAL_OPEN_SUBSET_CLOSED; "REAL_INTERVAL_SING",REAL_INTERVAL_SING; "REAL_INTERVAL_TRANSLATION",REAL_INTERVAL_TRANSLATION; "REAL_INV",REAL_INV; "REAL_INV_0",REAL_INV_0; "REAL_INV_1",REAL_INV_1; "REAL_INV_1_LE",REAL_INV_1_LE; "REAL_INV_1_LT",REAL_INV_1_LT; "REAL_INV_DIV",REAL_INV_DIV; "REAL_INV_EQ",REAL_INV_EQ; "REAL_INV_EQ_0",REAL_INV_EQ_0; "REAL_INV_EQ_1",REAL_INV_EQ_1; "REAL_INV_INV",REAL_INV_INV; "REAL_INV_LE_1",REAL_INV_LE_1; "REAL_INV_LT_1",REAL_INV_LT_1; "REAL_INV_MUL",REAL_INV_MUL; "REAL_INV_NEG",REAL_INV_NEG; "REAL_INV_POW",REAL_INV_POW; "REAL_INV_RPOW",REAL_INV_RPOW; "REAL_INV_SGN",REAL_INV_SGN; "REAL_IVT_DECREASING",REAL_IVT_DECREASING; "REAL_IVT_INCREASING",REAL_IVT_INCREASING; "REAL_LEBESGUE_DIFFERENTIATION_THEOREM",REAL_LEBESGUE_DIFFERENTIATION_THEOREM; "REAL_LEBESGUE_DIFFERENTIATION_THEOREM_ALT",REAL_LEBESGUE_DIFFERENTIATION_THEOREM_ALT; "REAL_LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING",REAL_LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING; "REAL_LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING",REAL_LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING; "REAL_LEBESGUE_MEASURABLE",REAL_LEBESGUE_MEASURABLE; "REAL_LEBESGUE_MEASURABLE_CLOSED",REAL_LEBESGUE_MEASURABLE_CLOSED; "REAL_LEBESGUE_MEASURABLE_COMPACT",REAL_LEBESGUE_MEASURABLE_COMPACT; "REAL_LEBESGUE_MEASURABLE_COMPL",REAL_LEBESGUE_MEASURABLE_COMPL; "REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS",REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS; "REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT",REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT; "REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS",REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS; "REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT",REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; "REAL_LEBESGUE_MEASURABLE_DIFF",REAL_LEBESGUE_MEASURABLE_DIFF; "REAL_LEBESGUE_MEASURABLE_EMPTY",REAL_LEBESGUE_MEASURABLE_EMPTY; "REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE",REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE; "REAL_LEBESGUE_MEASURABLE_INTER",REAL_LEBESGUE_MEASURABLE_INTER; "REAL_LEBESGUE_MEASURABLE_INTERS",REAL_LEBESGUE_MEASURABLE_INTERS; "REAL_LEBESGUE_MEASURABLE_INTERVAL",REAL_LEBESGUE_MEASURABLE_INTERVAL; "REAL_LEBESGUE_MEASURABLE_ON_SUBINTERVALS",REAL_LEBESGUE_MEASURABLE_ON_SUBINTERVALS; "REAL_LEBESGUE_MEASURABLE_OPEN",REAL_LEBESGUE_MEASURABLE_OPEN; "REAL_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",REAL_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; "REAL_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",REAL_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; "REAL_LEBESGUE_MEASURABLE_UNION",REAL_LEBESGUE_MEASURABLE_UNION; "REAL_LEBESGUE_MEASURABLE_UNIONS",REAL_LEBESGUE_MEASURABLE_UNIONS; "REAL_LEBESGUE_MEASURABLE_UNIV",REAL_LEBESGUE_MEASURABLE_UNIV; "REAL_LET_ADD",REAL_LET_ADD; "REAL_LET_ADD2",REAL_LET_ADD2; "REAL_LET_ANTISYM",REAL_LET_ANTISYM; "REAL_LET_BETWEEN",REAL_LET_BETWEEN; "REAL_LET_TOTAL",REAL_LET_TOTAL; "REAL_LET_TRANS",REAL_LET_TRANS; "REAL_LE_01",REAL_LE_01; "REAL_LE_ABS_SINH",REAL_LE_ABS_SINH; "REAL_LE_ADD",REAL_LE_ADD; "REAL_LE_ADD2",REAL_LE_ADD2; "REAL_LE_ADDL",REAL_LE_ADDL; "REAL_LE_ADDR",REAL_LE_ADDR; "REAL_LE_AFFINITY",REAL_LE_AFFINITY; "REAL_LE_ANTISYM",REAL_LE_ANTISYM; "REAL_LE_BETWEEN",REAL_LE_BETWEEN; "REAL_LE_CASES_INTEGERS",REAL_LE_CASES_INTEGERS; "REAL_LE_DIV",REAL_LE_DIV; "REAL_LE_DIV2_EQ",REAL_LE_DIV2_EQ; "REAL_LE_DOUBLE",REAL_LE_DOUBLE; "REAL_LE_FLOOR",REAL_LE_FLOOR; "REAL_LE_HAUSDIST",REAL_LE_HAUSDIST; "REAL_LE_INF",REAL_LE_INF; "REAL_LE_INF_EQ",REAL_LE_INF_EQ; "REAL_LE_INF_FINITE",REAL_LE_INF_FINITE; "REAL_LE_INF_SUBSET",REAL_LE_INF_SUBSET; "REAL_LE_INTEGERS",REAL_LE_INTEGERS; "REAL_LE_INV",REAL_LE_INV; "REAL_LE_INV2",REAL_LE_INV2; "REAL_LE_INV_EQ",REAL_LE_INV_EQ; "REAL_LE_LADD",REAL_LE_LADD; "REAL_LE_LADD_IMP",REAL_LE_LADD_IMP; "REAL_LE_LCANCEL_IMP",REAL_LE_LCANCEL_IMP; "REAL_LE_LDIV_EQ",REAL_LE_LDIV_EQ; "REAL_LE_LINV",REAL_LE_LINV; "REAL_LE_LMUL",REAL_LE_LMUL; "REAL_LE_LMUL_EQ",REAL_LE_LMUL_EQ; "REAL_LE_LNEG",REAL_LE_LNEG; "REAL_LE_LSQRT",REAL_LE_LSQRT; "REAL_LE_LT",REAL_LE_LT; "REAL_LE_MAX",REAL_LE_MAX; "REAL_LE_MIN",REAL_LE_MIN; "REAL_LE_MUL",REAL_LE_MUL; "REAL_LE_MUL2",REAL_LE_MUL2; "REAL_LE_MUL_EQ",REAL_LE_MUL_EQ; "REAL_LE_NEG",REAL_LE_NEG; "REAL_LE_NEG2",REAL_LE_NEG2; "REAL_LE_NEGL",REAL_LE_NEGL; "REAL_LE_NEGR",REAL_LE_NEGR; "REAL_LE_NEGTOTAL",REAL_LE_NEGTOTAL; "REAL_LE_NORM_MATRIX_MUL_DET",REAL_LE_NORM_MATRIX_MUL_DET; "REAL_LE_POW2",REAL_LE_POW2; "REAL_LE_POW_2",REAL_LE_POW_2; "REAL_LE_RADD",REAL_LE_RADD; "REAL_LE_RCANCEL_IMP",REAL_LE_RCANCEL_IMP; "REAL_LE_RDIV_EQ",REAL_LE_RDIV_EQ; "REAL_LE_REFL",REAL_LE_REFL; "REAL_LE_REVERSE_INTEGERS",REAL_LE_REVERSE_INTEGERS; "REAL_LE_RINV",REAL_LE_RINV; "REAL_LE_RMUL",REAL_LE_RMUL; "REAL_LE_RMUL_EQ",REAL_LE_RMUL_EQ; "REAL_LE_RNEG",REAL_LE_RNEG; "REAL_LE_ROOT",REAL_LE_ROOT; "REAL_LE_RSQRT",REAL_LE_RSQRT; "REAL_LE_SETDIST",REAL_LE_SETDIST; "REAL_LE_SETDIST_EQ",REAL_LE_SETDIST_EQ; "REAL_LE_SQUARE",REAL_LE_SQUARE; "REAL_LE_SQUARE_ABS",REAL_LE_SQUARE_ABS; "REAL_LE_SUB_LADD",REAL_LE_SUB_LADD; "REAL_LE_SUB_RADD",REAL_LE_SUB_RADD; "REAL_LE_SUP",REAL_LE_SUP; "REAL_LE_SUP_FINITE",REAL_LE_SUP_FINITE; "REAL_LE_TOTAL",REAL_LE_TOTAL; "REAL_LE_TRANS",REAL_LE_TRANS; "REAL_LE_TRANS_LE",REAL_LE_TRANS_LE; "REAL_LE_TRANS_LT",REAL_LE_TRANS_LT; "REAL_LE_TRANS_LTE",REAL_LE_TRANS_LTE; "REAL_LE_X_SINH",REAL_LE_X_SINH; "REAL_LIM",REAL_LIM; "REAL_LIM_SEQUENTIALLY",REAL_LIM_SEQUENTIALLY; "REAL_LNEG_UNIQ",REAL_LNEG_UNIQ; "REAL_LOG_CONVEX_ADD",REAL_LOG_CONVEX_ADD; "REAL_LOG_CONVEX_CONST",REAL_LOG_CONVEX_CONST; "REAL_LOG_CONVEX_IMP_CONVEX",REAL_LOG_CONVEX_IMP_CONVEX; "REAL_LOG_CONVEX_IMP_POS",REAL_LOG_CONVEX_IMP_POS; "REAL_LOG_CONVEX_LIM",REAL_LOG_CONVEX_LIM; "REAL_LOG_CONVEX_LOG_CONVEX",REAL_LOG_CONVEX_LOG_CONVEX; "REAL_LOG_CONVEX_MUL",REAL_LOG_CONVEX_MUL; "REAL_LOG_CONVEX_ON",REAL_LOG_CONVEX_ON; "REAL_LOG_CONVEX_ON_CONVEX",REAL_LOG_CONVEX_ON_CONVEX; "REAL_LOG_CONVEX_ON_EMPTY",REAL_LOG_CONVEX_ON_EMPTY; "REAL_LOG_CONVEX_ON_EQ",REAL_LOG_CONVEX_ON_EQ; "REAL_LOG_CONVEX_ON_SING",REAL_LOG_CONVEX_ON_SING; "REAL_LOG_CONVEX_ON_SUBSET",REAL_LOG_CONVEX_ON_SUBSET; "REAL_LOG_CONVEX_PRODUCT",REAL_LOG_CONVEX_PRODUCT; "REAL_LOG_CONVEX_RPOW_RIGHT",REAL_LOG_CONVEX_RPOW_RIGHT; "REAL_LSQRT_LE",REAL_LSQRT_LE; "REAL_LTE_ADD",REAL_LTE_ADD; "REAL_LTE_ADD2",REAL_LTE_ADD2; "REAL_LTE_ANTISYM",REAL_LTE_ANTISYM; "REAL_LTE_BETWEEN",REAL_LTE_BETWEEN; "REAL_LTE_TOTAL",REAL_LTE_TOTAL; "REAL_LTE_TRANS",REAL_LTE_TRANS; "REAL_LT_01",REAL_LT_01; "REAL_LT_ADD",REAL_LT_ADD; "REAL_LT_ADD1",REAL_LT_ADD1; "REAL_LT_ADD2",REAL_LT_ADD2; "REAL_LT_ADDL",REAL_LT_ADDL; "REAL_LT_ADDNEG",REAL_LT_ADDNEG; "REAL_LT_ADDNEG2",REAL_LT_ADDNEG2; "REAL_LT_ADDR",REAL_LT_ADDR; "REAL_LT_ADD_SUB",REAL_LT_ADD_SUB; "REAL_LT_AFFINITY",REAL_LT_AFFINITY; "REAL_LT_ANTISYM",REAL_LT_ANTISYM; "REAL_LT_BETWEEN",REAL_LT_BETWEEN; "REAL_LT_BETWEEN_GEN",REAL_LT_BETWEEN_GEN; "REAL_LT_DIV",REAL_LT_DIV; "REAL_LT_DIV2_EQ",REAL_LT_DIV2_EQ; "REAL_LT_FLOOR",REAL_LT_FLOOR; "REAL_LT_GT",REAL_LT_GT; "REAL_LT_HAUSDIST_POINT_EXISTS",REAL_LT_HAUSDIST_POINT_EXISTS; "REAL_LT_IMP_LE",REAL_LT_IMP_LE; "REAL_LT_IMP_NE",REAL_LT_IMP_NE; "REAL_LT_IMP_NZ",REAL_LT_IMP_NZ; "REAL_LT_INF_FINITE",REAL_LT_INF_FINITE; "REAL_LT_INTEGERS",REAL_LT_INTEGERS; "REAL_LT_INV",REAL_LT_INV; "REAL_LT_INV2",REAL_LT_INV2; "REAL_LT_INV_EQ",REAL_LT_INV_EQ; "REAL_LT_LADD",REAL_LT_LADD; "REAL_LT_LADD_IMP",REAL_LT_LADD_IMP; "REAL_LT_LCANCEL_IMP",REAL_LT_LCANCEL_IMP; "REAL_LT_LDIV_EQ",REAL_LT_LDIV_EQ; "REAL_LT_LE",REAL_LT_LE; "REAL_LT_LINV",REAL_LT_LINV; "REAL_LT_LMUL",REAL_LT_LMUL; "REAL_LT_LMUL_EQ",REAL_LT_LMUL_EQ; "REAL_LT_LNEG",REAL_LT_LNEG; "REAL_LT_LSQRT",REAL_LT_LSQRT; "REAL_LT_MAX",REAL_LT_MAX; "REAL_LT_MIN",REAL_LT_MIN; "REAL_LT_MUL",REAL_LT_MUL; "REAL_LT_MUL2",REAL_LT_MUL2; "REAL_LT_MUL_EQ",REAL_LT_MUL_EQ; "REAL_LT_NEG",REAL_LT_NEG; "REAL_LT_NEG2",REAL_LT_NEG2; "REAL_LT_NEGTOTAL",REAL_LT_NEGTOTAL; "REAL_LT_POW2",REAL_LT_POW2; "REAL_LT_POW_2",REAL_LT_POW_2; "REAL_LT_RADD",REAL_LT_RADD; "REAL_LT_RCANCEL_IMP",REAL_LT_RCANCEL_IMP; "REAL_LT_RDIV_EQ",REAL_LT_RDIV_EQ; "REAL_LT_REFL",REAL_LT_REFL; "REAL_LT_RINV",REAL_LT_RINV; "REAL_LT_RMUL",REAL_LT_RMUL; "REAL_LT_RMUL_EQ",REAL_LT_RMUL_EQ; "REAL_LT_RNEG",REAL_LT_RNEG; "REAL_LT_RSQRT",REAL_LT_RSQRT; "REAL_LT_SQUARE",REAL_LT_SQUARE; "REAL_LT_SQUARE_ABS",REAL_LT_SQUARE_ABS; "REAL_LT_SUB_LADD",REAL_LT_SUB_LADD; "REAL_LT_SUB_RADD",REAL_LT_SUB_RADD; "REAL_LT_SUP_FINITE",REAL_LT_SUP_FINITE; "REAL_LT_TOTAL",REAL_LT_TOTAL; "REAL_LT_TRANS",REAL_LT_TRANS; "REAL_MAX_ACI",REAL_MAX_ACI; "REAL_MAX_ASSOC",REAL_MAX_ASSOC; "REAL_MAX_LE",REAL_MAX_LE; "REAL_MAX_LT",REAL_MAX_LT; "REAL_MAX_MAX",REAL_MAX_MAX; "REAL_MAX_MIN",REAL_MAX_MIN; "REAL_MAX_RPOW",REAL_MAX_RPOW; "REAL_MAX_SUP",REAL_MAX_SUP; "REAL_MAX_SYM",REAL_MAX_SYM; "REAL_MEASURABLE",REAL_MEASURABLE; "REAL_MEASURABLE_ALMOST",REAL_MEASURABLE_ALMOST; "REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE",REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE; "REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE",REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; "REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE",REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE; "REAL_MEASURABLE_COMPACT",REAL_MEASURABLE_COMPACT; "REAL_MEASURABLE_COUNTABLE_INTERS",REAL_MEASURABLE_COUNTABLE_INTERS; "REAL_MEASURABLE_COUNTABLE_UNIONS",REAL_MEASURABLE_COUNTABLE_UNIONS; "REAL_MEASURABLE_COUNTABLE_UNIONS_BOUNDED",REAL_MEASURABLE_COUNTABLE_UNIONS_BOUNDED; "REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG",REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG; "REAL_MEASURABLE_DIFF",REAL_MEASURABLE_DIFF; "REAL_MEASURABLE_EMPTY",REAL_MEASURABLE_EMPTY; "REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE",REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE; "REAL_MEASURABLE_INNER_OUTER",REAL_MEASURABLE_INNER_OUTER; "REAL_MEASURABLE_INTER",REAL_MEASURABLE_INTER; "REAL_MEASURABLE_MEASURABLE",REAL_MEASURABLE_MEASURABLE; "REAL_MEASURABLE_NESTED_UNIONS",REAL_MEASURABLE_NESTED_UNIONS; "REAL_MEASURABLE_ON_0",REAL_MEASURABLE_ON_0; "REAL_MEASURABLE_ON_ABS",REAL_MEASURABLE_ON_ABS; "REAL_MEASURABLE_ON_ADD",REAL_MEASURABLE_ON_ADD; "REAL_MEASURABLE_ON_CASES",REAL_MEASURABLE_ON_CASES; "REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS; "REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0; "REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET; "REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0; "REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL; "REAL_MEASURABLE_ON_CONST",REAL_MEASURABLE_ON_CONST; "REAL_MEASURABLE_ON_DECREASING",REAL_MEASURABLE_ON_DECREASING; "REAL_MEASURABLE_ON_DECREASING_UNIV",REAL_MEASURABLE_ON_DECREASING_UNIV; "REAL_MEASURABLE_ON_DIV",REAL_MEASURABLE_ON_DIV; "REAL_MEASURABLE_ON_INCREASING",REAL_MEASURABLE_ON_INCREASING; "REAL_MEASURABLE_ON_INCREASING_UNIV",REAL_MEASURABLE_ON_INCREASING_UNIV; "REAL_MEASURABLE_ON_INV",REAL_MEASURABLE_ON_INV; "REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "REAL_MEASURABLE_ON_LIMIT",REAL_MEASURABLE_ON_LIMIT; "REAL_MEASURABLE_ON_LMUL",REAL_MEASURABLE_ON_LMUL; "REAL_MEASURABLE_ON_MAX",REAL_MEASURABLE_ON_MAX; "REAL_MEASURABLE_ON_MEASURABLE_SUBSET",REAL_MEASURABLE_ON_MEASURABLE_SUBSET; "REAL_MEASURABLE_ON_MIN",REAL_MEASURABLE_ON_MIN; "REAL_MEASURABLE_ON_MUL",REAL_MEASURABLE_ON_MUL; "REAL_MEASURABLE_ON_NEG",REAL_MEASURABLE_ON_NEG; "REAL_MEASURABLE_ON_NEG_EQ",REAL_MEASURABLE_ON_NEG_EQ; "REAL_MEASURABLE_ON_PREIMAGE_CLOSED",REAL_MEASURABLE_ON_PREIMAGE_CLOSED; "REAL_MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL",REAL_MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; "REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GE",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GE; "REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT; "REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE; "REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LT",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LT; "REAL_MEASURABLE_ON_PREIMAGE_OPEN",REAL_MEASURABLE_ON_PREIMAGE_OPEN; "REAL_MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL",REAL_MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; "REAL_MEASURABLE_ON_RESTRICT",REAL_MEASURABLE_ON_RESTRICT; "REAL_MEASURABLE_ON_RMUL",REAL_MEASURABLE_ON_RMUL; "REAL_MEASURABLE_ON_RPOW",REAL_MEASURABLE_ON_RPOW; "REAL_MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT",REAL_MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT; "REAL_MEASURABLE_ON_SPIKE_SET",REAL_MEASURABLE_ON_SPIKE_SET; "REAL_MEASURABLE_ON_SUB",REAL_MEASURABLE_ON_SUB; "REAL_MEASURABLE_ON_UNIV",REAL_MEASURABLE_ON_UNIV; "REAL_MEASURABLE_OPEN",REAL_MEASURABLE_OPEN; "REAL_MEASURABLE_REAL_INTEGRABLE",REAL_MEASURABLE_REAL_INTEGRABLE; "REAL_MEASURABLE_REAL_INTERVAL",REAL_MEASURABLE_REAL_INTERVAL; "REAL_MEASURABLE_REAL_MEASURE_EQ_0",REAL_MEASURABLE_REAL_MEASURE_EQ_0; "REAL_MEASURABLE_REAL_MEASURE_POS_LT",REAL_MEASURABLE_REAL_MEASURE_POS_LT; "REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF",REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF; "REAL_MEASURABLE_SCALING",REAL_MEASURABLE_SCALING; "REAL_MEASURABLE_SCALING_EQ",REAL_MEASURABLE_SCALING_EQ; "REAL_MEASURABLE_TRANSLATION",REAL_MEASURABLE_TRANSLATION; "REAL_MEASURABLE_UNION",REAL_MEASURABLE_UNION; "REAL_MEASURABLE_UNIONS",REAL_MEASURABLE_UNIONS; "REAL_MEASURE_DIFF_SUBSET",REAL_MEASURE_DIFF_SUBSET; "REAL_MEASURE_DISJOINT_UNION",REAL_MEASURE_DISJOINT_UNION; "REAL_MEASURE_DISJOINT_UNIONS",REAL_MEASURE_DISJOINT_UNIONS; "REAL_MEASURE_DISJOINT_UNIONS_IMAGE",REAL_MEASURE_DISJOINT_UNIONS_IMAGE; "REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; "REAL_MEASURE_EMPTY",REAL_MEASURE_EMPTY; "REAL_MEASURE_EQ_0",REAL_MEASURE_EQ_0; "REAL_MEASURE_MEASURE",REAL_MEASURE_MEASURE; "REAL_MEASURE_POS_LE",REAL_MEASURE_POS_LE; "REAL_MEASURE_REAL_INTEGRAL",REAL_MEASURE_REAL_INTEGRAL; "REAL_MEASURE_REAL_INTEGRAL_UNIV",REAL_MEASURE_REAL_INTEGRAL_UNIV; "REAL_MEASURE_REAL_INTERVAL",REAL_MEASURE_REAL_INTERVAL; "REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF",REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF; "REAL_MEASURE_REAL_NEGLIGIBLE_UNION",REAL_MEASURE_REAL_NEGLIGIBLE_UNION; "REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS",REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS; "REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE",REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE; "REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG",REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG; "REAL_MEASURE_SCALING",REAL_MEASURE_SCALING; "REAL_MEASURE_SUBSET",REAL_MEASURE_SUBSET; "REAL_MEASURE_TRANSLATION",REAL_MEASURE_TRANSLATION; "REAL_MEASURE_UNION",REAL_MEASURE_UNION; "REAL_MEASURE_UNIONS_LE",REAL_MEASURE_UNIONS_LE; "REAL_MEASURE_UNIONS_LE_IMAGE",REAL_MEASURE_UNIONS_LE_IMAGE; "REAL_MEASURE_UNION_LE",REAL_MEASURE_UNION_LE; "REAL_MEASURE_UNIQUE",REAL_MEASURE_UNIQUE; "REAL_MIDPOINT_IN_CONVEX",REAL_MIDPOINT_IN_CONVEX; "REAL_MIN_ACI",REAL_MIN_ACI; "REAL_MIN_ASSOC",REAL_MIN_ASSOC; "REAL_MIN_INF",REAL_MIN_INF; "REAL_MIN_LE",REAL_MIN_LE; "REAL_MIN_LT",REAL_MIN_LT; "REAL_MIN_MAX",REAL_MIN_MAX; "REAL_MIN_MIN",REAL_MIN_MIN; "REAL_MIN_RPOW",REAL_MIN_RPOW; "REAL_MIN_SYM",REAL_MIN_SYM; "REAL_MONOTONE_CONVERGENCE_DECREASING",REAL_MONOTONE_CONVERGENCE_DECREASING; "REAL_MONOTONE_CONVERGENCE_INCREASING",REAL_MONOTONE_CONVERGENCE_INCREASING; "REAL_MONOTONE_CONVERGENCE_INCREASING_AE",REAL_MONOTONE_CONVERGENCE_INCREASING_AE; "REAL_MUL",REAL_MUL; "REAL_MUL_2",REAL_MUL_2; "REAL_MUL_AC",REAL_MUL_AC; "REAL_MUL_ASSOC",REAL_MUL_ASSOC; "REAL_MUL_CNJ",REAL_MUL_CNJ; "REAL_MUL_COS_COS",REAL_MUL_COS_COS; "REAL_MUL_COS_SIN",REAL_MUL_COS_SIN; "REAL_MUL_CX",REAL_MUL_CX; "REAL_MUL_LID",REAL_MUL_LID; "REAL_MUL_LINV",REAL_MUL_LINV; "REAL_MUL_LINV_UNIQ",REAL_MUL_LINV_UNIQ; "REAL_MUL_LNEG",REAL_MUL_LNEG; "REAL_MUL_LZERO",REAL_MUL_LZERO; "REAL_MUL_POS_LE",REAL_MUL_POS_LE; "REAL_MUL_POS_LT",REAL_MUL_POS_LT; "REAL_MUL_RID",REAL_MUL_RID; "REAL_MUL_RINV",REAL_MUL_RINV; "REAL_MUL_RINV_UNIQ",REAL_MUL_RINV_UNIQ; "REAL_MUL_RNEG",REAL_MUL_RNEG; "REAL_MUL_RZERO",REAL_MUL_RZERO; "REAL_MUL_SIN_COS",REAL_MUL_SIN_COS; "REAL_MUL_SIN_SIN",REAL_MUL_SIN_SIN; "REAL_MUL_SUM",REAL_MUL_SUM; "REAL_MUL_SUM_NUMSEG",REAL_MUL_SUM_NUMSEG; "REAL_MUL_SYM",REAL_MUL_SYM; "REAL_MVT",REAL_MVT; "REAL_MVT_CAUCHY",REAL_MVT_CAUCHY; "REAL_MVT_SIMPLE",REAL_MVT_SIMPLE; "REAL_MVT_VERY_SIMPLE",REAL_MVT_VERY_SIMPLE; "REAL_NEG",REAL_NEG; "REAL_NEGLIGIBLE_COUNTABLE",REAL_NEGLIGIBLE_COUNTABLE; "REAL_NEGLIGIBLE_COUNTABLE_UNIONS",REAL_NEGLIGIBLE_COUNTABLE_UNIONS; "REAL_NEGLIGIBLE_DIFF",REAL_NEGLIGIBLE_DIFF; "REAL_NEGLIGIBLE_EMPTY",REAL_NEGLIGIBLE_EMPTY; "REAL_NEGLIGIBLE_FINITE",REAL_NEGLIGIBLE_FINITE; "REAL_NEGLIGIBLE_FRONTIER_INTERVAL",REAL_NEGLIGIBLE_FRONTIER_INTERVAL; "REAL_NEGLIGIBLE_INSERT",REAL_NEGLIGIBLE_INSERT; "REAL_NEGLIGIBLE_INTER",REAL_NEGLIGIBLE_INTER; "REAL_NEGLIGIBLE_ON_INTERVALS",REAL_NEGLIGIBLE_ON_INTERVALS; "REAL_NEGLIGIBLE_OUTER",REAL_NEGLIGIBLE_OUTER; "REAL_NEGLIGIBLE_OUTER_LE",REAL_NEGLIGIBLE_OUTER_LE; "REAL_NEGLIGIBLE_REAL_INTERVAL",REAL_NEGLIGIBLE_REAL_INTERVAL; "REAL_NEGLIGIBLE_SING",REAL_NEGLIGIBLE_SING; "REAL_NEGLIGIBLE_SUBSET",REAL_NEGLIGIBLE_SUBSET; "REAL_NEGLIGIBLE_TRANSLATION",REAL_NEGLIGIBLE_TRANSLATION; "REAL_NEGLIGIBLE_TRANSLATION_EQ",REAL_NEGLIGIBLE_TRANSLATION_EQ; "REAL_NEGLIGIBLE_TRANSLATION_REV",REAL_NEGLIGIBLE_TRANSLATION_REV; "REAL_NEGLIGIBLE_UNION",REAL_NEGLIGIBLE_UNION; "REAL_NEGLIGIBLE_UNIONS",REAL_NEGLIGIBLE_UNIONS; "REAL_NEGLIGIBLE_UNION_EQ",REAL_NEGLIGIBLE_UNION_EQ; "REAL_NEGNEG",REAL_NEGNEG; "REAL_NEG_0",REAL_NEG_0; "REAL_NEG_ADD",REAL_NEG_ADD; "REAL_NEG_EQ",REAL_NEG_EQ; "REAL_NEG_EQ_0",REAL_NEG_EQ_0; "REAL_NEG_GE0",REAL_NEG_GE0; "REAL_NEG_GT0",REAL_NEG_GT0; "REAL_NEG_LE0",REAL_NEG_LE0; "REAL_NEG_LMUL",REAL_NEG_LMUL; "REAL_NEG_LT0",REAL_NEG_LT0; "REAL_NEG_MINUS1",REAL_NEG_MINUS1; "REAL_NEG_MUL2",REAL_NEG_MUL2; "REAL_NEG_NEG",REAL_NEG_NEG; "REAL_NEG_RMUL",REAL_NEG_RMUL; "REAL_NEG_SUB",REAL_NEG_SUB; "REAL_NON_MONOTONE",REAL_NON_MONOTONE; "REAL_NORM",REAL_NORM; "REAL_NORM_POS",REAL_NORM_POS; "REAL_NOT_EQ",REAL_NOT_EQ; "REAL_NOT_LE",REAL_NOT_LE; "REAL_NOT_LT",REAL_NOT_LT; "REAL_OF_INT_OF_REAL",REAL_OF_INT_OF_REAL; "REAL_OF_NUM_ADD",REAL_OF_NUM_ADD; "REAL_OF_NUM_BINOM",REAL_OF_NUM_BINOM; "REAL_OF_NUM_EQ",REAL_OF_NUM_EQ; "REAL_OF_NUM_GE",REAL_OF_NUM_GE; "REAL_OF_NUM_GT",REAL_OF_NUM_GT; "REAL_OF_NUM_LE",REAL_OF_NUM_LE; "REAL_OF_NUM_LT",REAL_OF_NUM_LT; "REAL_OF_NUM_MAX",REAL_OF_NUM_MAX; "REAL_OF_NUM_MIN",REAL_OF_NUM_MIN; "REAL_OF_NUM_MUL",REAL_OF_NUM_MUL; "REAL_OF_NUM_NPRODUCT",REAL_OF_NUM_NPRODUCT; "REAL_OF_NUM_POW",REAL_OF_NUM_POW; "REAL_OF_NUM_SUB",REAL_OF_NUM_SUB; "REAL_OF_NUM_SUB_CASES",REAL_OF_NUM_SUB_CASES; "REAL_OF_NUM_SUC",REAL_OF_NUM_SUC; "REAL_OF_NUM_SUM",REAL_OF_NUM_SUM; "REAL_OF_NUM_SUM_GEN",REAL_OF_NUM_SUM_GEN; "REAL_OF_NUM_SUM_NUMSEG",REAL_OF_NUM_SUM_NUMSEG; "REAL_OPEN",REAL_OPEN; "REAL_OPEN_CLOSED_INTERVAL",REAL_OPEN_CLOSED_INTERVAL; "REAL_OPEN_DIFF",REAL_OPEN_DIFF; "REAL_OPEN_EMPTY",REAL_OPEN_EMPTY; "REAL_OPEN_EXISTS_RATIONAL",REAL_OPEN_EXISTS_RATIONAL; "REAL_OPEN_HALFSPACE_GT",REAL_OPEN_HALFSPACE_GT; "REAL_OPEN_HALFSPACE_LT",REAL_OPEN_HALFSPACE_LT; "REAL_OPEN_IN",REAL_OPEN_IN; "REAL_OPEN_INTER",REAL_OPEN_INTER; "REAL_OPEN_INTERS",REAL_OPEN_INTERS; "REAL_OPEN_RATIONAL",REAL_OPEN_RATIONAL; "REAL_OPEN_REAL_CLOSED",REAL_OPEN_REAL_CLOSED; "REAL_OPEN_REAL_INTERVAL",REAL_OPEN_REAL_INTERVAL; "REAL_OPEN_SET_EXISTS_RATIONAL",REAL_OPEN_SET_EXISTS_RATIONAL; "REAL_OPEN_SET_RATIONAL",REAL_OPEN_SET_RATIONAL; "REAL_OPEN_SUBREAL_OPEN",REAL_OPEN_SUBREAL_OPEN; "REAL_OPEN_UNION",REAL_OPEN_UNION; "REAL_OPEN_UNIONS",REAL_OPEN_UNIONS; "REAL_OPEN_UNIV",REAL_OPEN_UNIV; "REAL_PARTIAL_SUMS_LE_INFSUM",REAL_PARTIAL_SUMS_LE_INFSUM; "REAL_PARTIAL_SUMS_LE_INFSUM_GEN",REAL_PARTIAL_SUMS_LE_INFSUM_GEN; "REAL_POLYFUN_EQ_0",REAL_POLYFUN_EQ_0; "REAL_POLYFUN_EQ_CONST",REAL_POLYFUN_EQ_CONST; "REAL_POLYFUN_FINITE_ROOTS",REAL_POLYFUN_FINITE_ROOTS; "REAL_POLYFUN_ROOTBOUND",REAL_POLYFUN_ROOTBOUND; "REAL_POLYNOMIAL_FUNCTION_1",REAL_POLYNOMIAL_FUNCTION_1; "REAL_POLYNOMIAL_FUNCTION_ADD",REAL_POLYNOMIAL_FUNCTION_ADD; "REAL_POLYNOMIAL_FUNCTION_DROP",REAL_POLYNOMIAL_FUNCTION_DROP; "REAL_POLYNOMIAL_FUNCTION_EXPLICIT",REAL_POLYNOMIAL_FUNCTION_EXPLICIT; "REAL_POLYNOMIAL_FUNCTION_EXPLICIT_NZ",REAL_POLYNOMIAL_FUNCTION_EXPLICIT_NZ; "REAL_POLYNOMIAL_FUNCTION_EXPLICIT_UNIV",REAL_POLYNOMIAL_FUNCTION_EXPLICIT_UNIV; "REAL_POLYNOMIAL_FUNCTION_MUL",REAL_POLYNOMIAL_FUNCTION_MUL; "REAL_POLYNOMIAL_FUNCTION_NEG",REAL_POLYNOMIAL_FUNCTION_NEG; "REAL_POLYNOMIAL_FUNCTION_POW",REAL_POLYNOMIAL_FUNCTION_POW; "REAL_POLYNOMIAL_FUNCTION_PRODUCT",REAL_POLYNOMIAL_FUNCTION_PRODUCT; "REAL_POLYNOMIAL_FUNCTION_SUB",REAL_POLYNOMIAL_FUNCTION_SUB; "REAL_POLYNOMIAL_FUNCTION_SUM",REAL_POLYNOMIAL_FUNCTION_SUM; "REAL_POLY_CLAUSES",REAL_POLY_CLAUSES; "REAL_POLY_NEG_CLAUSES",REAL_POLY_NEG_CLAUSES; "REAL_POS",REAL_POS; "REAL_POS_NZ",REAL_POS_NZ; "REAL_POW",REAL_POW; "REAL_POW2_ABS",REAL_POW2_ABS; "REAL_POWER_SERIES_CONV_IMP_ABSCONV",REAL_POWER_SERIES_CONV_IMP_ABSCONV; "REAL_POW_1",REAL_POW_1; "REAL_POW_1_LE",REAL_POW_1_LE; "REAL_POW_1_LT",REAL_POW_1_LT; "REAL_POW_2",REAL_POW_2; "REAL_POW_ADD",REAL_POW_ADD; "REAL_POW_DIV",REAL_POW_DIV; "REAL_POW_EQ",REAL_POW_EQ; "REAL_POW_EQ_0",REAL_POW_EQ_0; "REAL_POW_EQ_1",REAL_POW_EQ_1; "REAL_POW_EQ_1_IMP",REAL_POW_EQ_1_IMP; "REAL_POW_EQ_ABS",REAL_POW_EQ_ABS; "REAL_POW_EQ_EQ",REAL_POW_EQ_EQ; "REAL_POW_EQ_ODD",REAL_POW_EQ_ODD; "REAL_POW_EQ_ODD_EQ",REAL_POW_EQ_ODD_EQ; "REAL_POW_INV",REAL_POW_INV; "REAL_POW_LBOUND",REAL_POW_LBOUND; "REAL_POW_LE",REAL_POW_LE; "REAL_POW_LE2",REAL_POW_LE2; "REAL_POW_LE2_ODD",REAL_POW_LE2_ODD; "REAL_POW_LE2_ODD_EQ",REAL_POW_LE2_ODD_EQ; "REAL_POW_LE2_REV",REAL_POW_LE2_REV; "REAL_POW_LE_1",REAL_POW_LE_1; "REAL_POW_LT",REAL_POW_LT; "REAL_POW_LT2",REAL_POW_LT2; "REAL_POW_LT2_ODD",REAL_POW_LT2_ODD; "REAL_POW_LT2_ODD_EQ",REAL_POW_LT2_ODD_EQ; "REAL_POW_LT2_REV",REAL_POW_LT2_REV; "REAL_POW_LT_1",REAL_POW_LT_1; "REAL_POW_MONO",REAL_POW_MONO; "REAL_POW_MONO_INV",REAL_POW_MONO_INV; "REAL_POW_MONO_LT",REAL_POW_MONO_LT; "REAL_POW_MUL",REAL_POW_MUL; "REAL_POW_NEG",REAL_POW_NEG; "REAL_POW_NZ",REAL_POW_NZ; "REAL_POW_ONE",REAL_POW_ONE; "REAL_POW_POW",REAL_POW_POW; "REAL_POW_ROOT",REAL_POW_ROOT; "REAL_POW_SUB",REAL_POW_SUB; "REAL_POW_ZERO",REAL_POW_ZERO; "REAL_RNEG_UNIQ",REAL_RNEG_UNIQ; "REAL_ROLLE",REAL_ROLLE; "REAL_ROLLE_SIMPLE",REAL_ROLLE_SIMPLE; "REAL_ROOT_DIV",REAL_ROOT_DIV; "REAL_ROOT_INV",REAL_ROOT_INV; "REAL_ROOT_LE",REAL_ROOT_LE; "REAL_ROOT_MUL",REAL_ROOT_MUL; "REAL_ROOT_POW",REAL_ROOT_POW; "REAL_ROOT_POW_GEN",REAL_ROOT_POW_GEN; "REAL_ROOT_RPOW",REAL_ROOT_RPOW; "REAL_RSQRT_LE",REAL_RSQRT_LE; "REAL_SECOND_MEAN_VALUE_THEOREM",REAL_SECOND_MEAN_VALUE_THEOREM; "REAL_SECOND_MEAN_VALUE_THEOREM_BONNET",REAL_SECOND_MEAN_VALUE_THEOREM_BONNET; "REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL",REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL; "REAL_SECOND_MEAN_VALUE_THEOREM_FULL",REAL_SECOND_MEAN_VALUE_THEOREM_FULL; "REAL_SECOND_MEAN_VALUE_THEOREM_GEN",REAL_SECOND_MEAN_VALUE_THEOREM_GEN; "REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL",REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL; "REAL_SEGMENT",REAL_SEGMENT; "REAL_SEGMENT_INTERVAL",REAL_SEGMENT_INTERVAL; "REAL_SEGMENT_SEGMENT",REAL_SEGMENT_SEGMENT; "REAL_SEQ_OFFSET",REAL_SEQ_OFFSET; "REAL_SEQ_OFFSET_REV",REAL_SEQ_OFFSET_REV; "REAL_SERIES",REAL_SERIES; "REAL_SERIES_0",REAL_SERIES_0; "REAL_SERIES_ABSCONV_IMP_CONV",REAL_SERIES_ABSCONV_IMP_CONV; "REAL_SERIES_ADD",REAL_SERIES_ADD; "REAL_SERIES_BOUND",REAL_SERIES_BOUND; "REAL_SERIES_CAUCHY",REAL_SERIES_CAUCHY; "REAL_SERIES_CAUCHY_UNIFORM",REAL_SERIES_CAUCHY_UNIFORM; "REAL_SERIES_COMPARISON",REAL_SERIES_COMPARISON; "REAL_SERIES_COMPARISON_BOUND",REAL_SERIES_COMPARISON_BOUND; "REAL_SERIES_COMPARISON_UNIFORM",REAL_SERIES_COMPARISON_UNIFORM; "REAL_SERIES_DIFFS",REAL_SERIES_DIFFS; "REAL_SERIES_DIRICHLET",REAL_SERIES_DIRICHLET; "REAL_SERIES_EVEN",REAL_SERIES_EVEN; "REAL_SERIES_FINITE",REAL_SERIES_FINITE; "REAL_SERIES_FINITE_SUPPORT",REAL_SERIES_FINITE_SUPPORT; "REAL_SERIES_FROM",REAL_SERIES_FROM; "REAL_SERIES_GOESTOZERO",REAL_SERIES_GOESTOZERO; "REAL_SERIES_LE",REAL_SERIES_LE; "REAL_SERIES_LMUL",REAL_SERIES_LMUL; "REAL_SERIES_MUL",REAL_SERIES_MUL; "REAL_SERIES_MUL_UNIQUE",REAL_SERIES_MUL_UNIQUE; "REAL_SERIES_NEG",REAL_SERIES_NEG; "REAL_SERIES_ODD",REAL_SERIES_ODD; "REAL_SERIES_POS",REAL_SERIES_POS; "REAL_SERIES_RATIO",REAL_SERIES_RATIO; "REAL_SERIES_RESTRICT",REAL_SERIES_RESTRICT; "REAL_SERIES_RMUL",REAL_SERIES_RMUL; "REAL_SERIES_SUB",REAL_SERIES_SUB; "REAL_SERIES_SUBSET",REAL_SERIES_SUBSET; "REAL_SERIES_SUM",REAL_SERIES_SUM; "REAL_SERIES_TERMS_TOZERO",REAL_SERIES_TERMS_TOZERO; "REAL_SERIES_TRIVIAL",REAL_SERIES_TRIVIAL; "REAL_SERIES_UNIQUE",REAL_SERIES_UNIQUE; "REAL_SETDIST_LT_EXISTS",REAL_SETDIST_LT_EXISTS; "REAL_SGN",REAL_SGN; "REAL_SGNS_EQ",REAL_SGNS_EQ; "REAL_SGNS_EQ_ALT",REAL_SGNS_EQ_ALT; "REAL_SGN_0",REAL_SGN_0; "REAL_SGN_ABS",REAL_SGN_ABS; "REAL_SGN_ABS_ALT",REAL_SGN_ABS_ALT; "REAL_SGN_CASES",REAL_SGN_CASES; "REAL_SGN_DIV",REAL_SGN_DIV; "REAL_SGN_EQ",REAL_SGN_EQ; "REAL_SGN_EQ_INEQ",REAL_SGN_EQ_INEQ; "REAL_SGN_IM_COMPLEX_DIV",REAL_SGN_IM_COMPLEX_DIV; "REAL_SGN_INEQS",REAL_SGN_INEQS; "REAL_SGN_INV",REAL_SGN_INV; "REAL_SGN_MUL",REAL_SGN_MUL; "REAL_SGN_NEG",REAL_SGN_NEG; "REAL_SGN_POW",REAL_SGN_POW; "REAL_SGN_POW_2",REAL_SGN_POW_2; "REAL_SGN_REAL_SGN",REAL_SGN_REAL_SGN; "REAL_SGN_RE_COMPLEX_DIV",REAL_SGN_RE_COMPLEX_DIV; "REAL_SGN_SIGN",REAL_SGN_SIGN; "REAL_SGN_SQRT",REAL_SGN_SQRT; "REAL_SIN",REAL_SIN; "REAL_SOS_EQ_0",REAL_SOS_EQ_0; "REAL_SQRT_POW_2",REAL_SQRT_POW_2; "REAL_STEINHAUS",REAL_STEINHAUS; "REAL_STONE_WEIERSTRASS",REAL_STONE_WEIERSTRASS; "REAL_STONE_WEIERSTRASS_ALT",REAL_STONE_WEIERSTRASS_ALT; "REAL_SUB",REAL_SUB; "REAL_SUB_0",REAL_SUB_0; "REAL_SUB_ABS",REAL_SUB_ABS; "REAL_SUB_ADD",REAL_SUB_ADD; "REAL_SUB_ADD2",REAL_SUB_ADD2; "REAL_SUB_ARG",REAL_SUB_ARG; "REAL_SUB_COS",REAL_SUB_COS; "REAL_SUB_INV",REAL_SUB_INV; "REAL_SUB_LDISTRIB",REAL_SUB_LDISTRIB; "REAL_SUB_LE",REAL_SUB_LE; "REAL_SUB_LNEG",REAL_SUB_LNEG; "REAL_SUB_LT",REAL_SUB_LT; "REAL_SUB_LZERO",REAL_SUB_LZERO; "REAL_SUB_NEG2",REAL_SUB_NEG2; "REAL_SUB_POLYFUN",REAL_SUB_POLYFUN; "REAL_SUB_POLYFUN_ALT",REAL_SUB_POLYFUN_ALT; "REAL_SUB_POW",REAL_SUB_POW; "REAL_SUB_POW_L1",REAL_SUB_POW_L1; "REAL_SUB_POW_R1",REAL_SUB_POW_R1; "REAL_SUB_RDISTRIB",REAL_SUB_RDISTRIB; "REAL_SUB_REFL",REAL_SUB_REFL; "REAL_SUB_RNEG",REAL_SUB_RNEG; "REAL_SUB_RZERO",REAL_SUB_RZERO; "REAL_SUB_SIN",REAL_SUB_SIN; "REAL_SUB_SUB",REAL_SUB_SUB; "REAL_SUB_SUB2",REAL_SUB_SUB2; "REAL_SUB_TAN",REAL_SUB_TAN; "REAL_SUB_TRIANGLE",REAL_SUB_TRIANGLE; "REAL_SUMMABLE",REAL_SUMMABLE; "REAL_SUMMABLE_0",REAL_SUMMABLE_0; "REAL_SUMMABLE_ADD",REAL_SUMMABLE_ADD; "REAL_SUMMABLE_ALTERNATING_SERIES",REAL_SUMMABLE_ALTERNATING_SERIES; "REAL_SUMMABLE_CAUCHY",REAL_SUMMABLE_CAUCHY; "REAL_SUMMABLE_COMPARISON",REAL_SUMMABLE_COMPARISON; "REAL_SUMMABLE_COMPLEX",REAL_SUMMABLE_COMPLEX; "REAL_SUMMABLE_EQ",REAL_SUMMABLE_EQ; "REAL_SUMMABLE_EQ_COFINITE",REAL_SUMMABLE_EQ_COFINITE; "REAL_SUMMABLE_EQ_EVENTUALLY",REAL_SUMMABLE_EQ_EVENTUALLY; "REAL_SUMMABLE_EVEN",REAL_SUMMABLE_EVEN; "REAL_SUMMABLE_FROM_ELSEWHERE",REAL_SUMMABLE_FROM_ELSEWHERE; "REAL_SUMMABLE_FROM_ELSEWHERE_EQ",REAL_SUMMABLE_FROM_ELSEWHERE_EQ; "REAL_SUMMABLE_GP",REAL_SUMMABLE_GP; "REAL_SUMMABLE_IFF",REAL_SUMMABLE_IFF; "REAL_SUMMABLE_IFF_COFINITE",REAL_SUMMABLE_IFF_COFINITE; "REAL_SUMMABLE_IFF_EVENTUALLY",REAL_SUMMABLE_IFF_EVENTUALLY; "REAL_SUMMABLE_IMP_BOUNDED",REAL_SUMMABLE_IMP_BOUNDED; "REAL_SUMMABLE_IMP_REAL_SUMS_BOUNDED",REAL_SUMMABLE_IMP_REAL_SUMS_BOUNDED; "REAL_SUMMABLE_IMP_TOZERO",REAL_SUMMABLE_IMP_TOZERO; "REAL_SUMMABLE_LMUL",REAL_SUMMABLE_LMUL; "REAL_SUMMABLE_MUL_LEFT",REAL_SUMMABLE_MUL_LEFT; "REAL_SUMMABLE_MUL_RIGHT",REAL_SUMMABLE_MUL_RIGHT; "REAL_SUMMABLE_NEG",REAL_SUMMABLE_NEG; "REAL_SUMMABLE_ODD",REAL_SUMMABLE_ODD; "REAL_SUMMABLE_RESTRICT",REAL_SUMMABLE_RESTRICT; "REAL_SUMMABLE_RMUL",REAL_SUMMABLE_RMUL; "REAL_SUMMABLE_SUB",REAL_SUMMABLE_SUB; "REAL_SUMMABLE_SUBSET",REAL_SUMMABLE_SUBSET; "REAL_SUMMABLE_TRIVIAL",REAL_SUMMABLE_TRIVIAL; "REAL_SUMMABLE_ZETA",REAL_SUMMABLE_ZETA; "REAL_SUMMABLE_ZETA_INTEGER",REAL_SUMMABLE_ZETA_INTEGER; "REAL_SUMS",REAL_SUMS; "REAL_SUMS_COMPLEX",REAL_SUMS_COMPLEX; "REAL_SUMS_EQ",REAL_SUMS_EQ; "REAL_SUMS_FINITE_DIFF",REAL_SUMS_FINITE_DIFF; "REAL_SUMS_FINITE_UNION",REAL_SUMS_FINITE_UNION; "REAL_SUMS_GP",REAL_SUMS_GP; "REAL_SUMS_IFF",REAL_SUMS_IFF; "REAL_SUMS_IM",REAL_SUMS_IM; "REAL_SUMS_INFSUM",REAL_SUMS_INFSUM; "REAL_SUMS_OFFSET",REAL_SUMS_OFFSET; "REAL_SUMS_OFFSET_REV",REAL_SUMS_OFFSET_REV; "REAL_SUMS_RE",REAL_SUMS_RE; "REAL_SUMS_REINDEX",REAL_SUMS_REINDEX; "REAL_SUMS_SUMMABLE",REAL_SUMS_SUMMABLE; "REAL_SUM_INTEGRAL_BOUNDS_DECREASING",REAL_SUM_INTEGRAL_BOUNDS_DECREASING; "REAL_SUM_INTEGRAL_BOUNDS_INCREASING",REAL_SUM_INTEGRAL_BOUNDS_INCREASING; "REAL_SUM_INTEGRAL_LBOUND_DECREASING",REAL_SUM_INTEGRAL_LBOUND_DECREASING; "REAL_SUM_INTEGRAL_LBOUND_INCREASING",REAL_SUM_INTEGRAL_LBOUND_INCREASING; "REAL_SUM_INTEGRAL_UBOUND_DECREASING",REAL_SUM_INTEGRAL_UBOUND_DECREASING; "REAL_SUM_INTEGRAL_UBOUND_INCREASING",REAL_SUM_INTEGRAL_UBOUND_INCREASING; "REAL_SUP_ASCLOSE",REAL_SUP_ASCLOSE; "REAL_SUP_BOUNDS",REAL_SUP_BOUNDS; "REAL_SUP_EQ_INF",REAL_SUP_EQ_INF; "REAL_SUP_LE",REAL_SUP_LE; "REAL_SUP_LE_EQ",REAL_SUP_LE_EQ; "REAL_SUP_LE_FINITE",REAL_SUP_LE_FINITE; "REAL_SUP_LE_SUBSET",REAL_SUP_LE_SUBSET; "REAL_SUP_LT_FINITE",REAL_SUP_LT_FINITE; "REAL_SUP_UNIQUE",REAL_SUP_UNIQUE; "REAL_TAN",REAL_TAN; "REAL_TAYLOR",REAL_TAYLOR; "REAL_TAYLOR_MVT_NEG",REAL_TAYLOR_MVT_NEG; "REAL_TAYLOR_MVT_POS",REAL_TAYLOR_MVT_POS; "REAL_TENDSTO",REAL_TENDSTO; "REAL_TIETZE_PERIODIC_INTERVAL",REAL_TIETZE_PERIODIC_INTERVAL; "REAL_TRUNCATE",REAL_TRUNCATE; "REAL_TRUNCATE_POS",REAL_TRUNCATE_POS; "REAL_UNIFORMLY_CONTINUOUS_IMP_REAL_CONTINUOUS",REAL_UNIFORMLY_CONTINUOUS_IMP_REAL_CONTINUOUS; "REAL_UNIFORMLY_CONTINUOUS_ON",REAL_UNIFORMLY_CONTINUOUS_ON; "REAL_UNIFORMLY_CONTINUOUS_ON_ADD",REAL_UNIFORMLY_CONTINUOUS_ON_ADD; "REAL_UNIFORMLY_CONTINUOUS_ON_COMPOSE",REAL_UNIFORMLY_CONTINUOUS_ON_COMPOSE; "REAL_UNIFORMLY_CONTINUOUS_ON_CONST",REAL_UNIFORMLY_CONTINUOUS_ON_CONST; "REAL_UNIFORMLY_CONTINUOUS_ON_ID",REAL_UNIFORMLY_CONTINUOUS_ON_ID; "REAL_UNIFORMLY_CONTINUOUS_ON_LMUL",REAL_UNIFORMLY_CONTINUOUS_ON_LMUL; "REAL_UNIFORMLY_CONTINUOUS_ON_NEG",REAL_UNIFORMLY_CONTINUOUS_ON_NEG; "REAL_UNIFORMLY_CONTINUOUS_ON_RMUL",REAL_UNIFORMLY_CONTINUOUS_ON_RMUL; "REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY",REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; "REAL_UNIFORMLY_CONTINUOUS_ON_SUB",REAL_UNIFORMLY_CONTINUOUS_ON_SUB; "REAL_UNIFORMLY_CONTINUOUS_ON_SUBSET",REAL_UNIFORMLY_CONTINUOUS_ON_SUBSET; "REAL_UNIFORMLY_CONTINUOUS_ON_SUM",REAL_UNIFORMLY_CONTINUOUS_ON_SUM; "REAL_VARIATION_AFFINITY",REAL_VARIATION_AFFINITY; "REAL_VARIATION_AFFINITY2",REAL_VARIATION_AFFINITY2; "REAL_VARIATION_COMBINE",REAL_VARIATION_COMBINE; "REAL_VARIATION_CONTINUOUS",REAL_VARIATION_CONTINUOUS; "REAL_VARIATION_CONTINUOUS_LEFT",REAL_VARIATION_CONTINUOUS_LEFT; "REAL_VARIATION_CONTINUOUS_RIGHT",REAL_VARIATION_CONTINUOUS_RIGHT; "REAL_VARIATION_GE_ABS_FUNCTION",REAL_VARIATION_GE_ABS_FUNCTION; "REAL_VARIATION_GE_FUNCTION",REAL_VARIATION_GE_FUNCTION; "REAL_VARIATION_MINUS_FUNCTION_MONOTONE",REAL_VARIATION_MINUS_FUNCTION_MONOTONE; "REAL_VARIATION_MONOTONE",REAL_VARIATION_MONOTONE; "REAL_VARIATION_NEG",REAL_VARIATION_NEG; "REAL_VARIATION_POS_LE",REAL_VARIATION_POS_LE; "REAL_VARIATION_REFLECT",REAL_VARIATION_REFLECT; "REAL_VARIATION_REFLECT2",REAL_VARIATION_REFLECT2; "REAL_VARIATION_REFLECT_INTERVAL",REAL_VARIATION_REFLECT_INTERVAL; "REAL_VARIATION_TRANSLATION",REAL_VARIATION_TRANSLATION; "REAL_VARIATION_TRANSLATION2",REAL_VARIATION_TRANSLATION2; "REAL_VARIATION_TRANSLATION_INTERVAL",REAL_VARIATION_TRANSLATION_INTERVAL; "REAL_VARIATION_TRIANGLE",REAL_VARIATION_TRIANGLE; "REAL_VECTOR_POLYNOMIAL_FUNCTION_o",REAL_VECTOR_POLYNOMIAL_FUNCTION_o; "REAL_VSUM",REAL_VSUM; "REAL_WLOG_LE",REAL_WLOG_LE; "REAL_WLOG_LT",REAL_WLOG_LT; "RECTIFIABLE_LOOP_FRONTIER_CONVEX",RECTIFIABLE_LOOP_FRONTIER_CONVEX; "RECTIFIABLE_LOOP_RELATIVE_FRONTIER_CONVEX",RECTIFIABLE_LOOP_RELATIVE_FRONTIER_CONVEX; "RECTIFIABLE_PATH_CIRCLEPATH",RECTIFIABLE_PATH_CIRCLEPATH; "RECTIFIABLE_PATH_COMBINE",RECTIFIABLE_PATH_COMBINE; "RECTIFIABLE_PATH_DIFFERENTIABLE",RECTIFIABLE_PATH_DIFFERENTIABLE; "RECTIFIABLE_PATH_EQ",RECTIFIABLE_PATH_EQ; "RECTIFIABLE_PATH_FRONTIER_CONVEX",RECTIFIABLE_PATH_FRONTIER_CONVEX; "RECTIFIABLE_PATH_IMAGE_SUBSET_CBALL",RECTIFIABLE_PATH_IMAGE_SUBSET_CBALL; "RECTIFIABLE_PATH_IMP_PATH",RECTIFIABLE_PATH_IMP_PATH; "RECTIFIABLE_PATH_JOIN",RECTIFIABLE_PATH_JOIN; "RECTIFIABLE_PATH_JOIN_EQ",RECTIFIABLE_PATH_JOIN_EQ; "RECTIFIABLE_PATH_JOIN_IMP",RECTIFIABLE_PATH_JOIN_IMP; "RECTIFIABLE_PATH_LINEAR_IMAGE_EQ",RECTIFIABLE_PATH_LINEAR_IMAGE_EQ; "RECTIFIABLE_PATH_LINEPATH",RECTIFIABLE_PATH_LINEPATH; "RECTIFIABLE_PATH_LIPSCHITZ_IMAGE",RECTIFIABLE_PATH_LIPSCHITZ_IMAGE; "RECTIFIABLE_PATH_PARTCIRCLEPATH",RECTIFIABLE_PATH_PARTCIRCLEPATH; "RECTIFIABLE_PATH_REPARAMETRIZATION",RECTIFIABLE_PATH_REPARAMETRIZATION; "RECTIFIABLE_PATH_REVERSEPATH",RECTIFIABLE_PATH_REVERSEPATH; "RECTIFIABLE_PATH_SHIFTPATH",RECTIFIABLE_PATH_SHIFTPATH; "RECTIFIABLE_PATH_SUBPATH",RECTIFIABLE_PATH_SUBPATH; "RECTIFIABLE_PATH_SUBPATH_EQ",RECTIFIABLE_PATH_SUBPATH_EQ; "RECTIFIABLE_PATH_SYM",RECTIFIABLE_PATH_SYM; "RECTIFIABLE_PATH_TRANSLATION_EQ",RECTIFIABLE_PATH_TRANSLATION_EQ; "RECTIFIABLE_PATH_VECTOR_POLYNOMIAL_FUNCTION",RECTIFIABLE_PATH_VECTOR_POLYNOMIAL_FUNCTION; "RECTIFIABLE_VALID_PATH",RECTIFIABLE_VALID_PATH; "RECURSION_CASEWISE",RECURSION_CASEWISE; "RECURSION_CASEWISE_PAIRWISE",RECURSION_CASEWISE_PAIRWISE; "RECURSION_SUPERADMISSIBLE",RECURSION_SUPERADMISSIBLE; "REFLECT_ALONG_0",REFLECT_ALONG_0; "REFLECT_ALONG_1D",REFLECT_ALONG_1D; "REFLECT_ALONG_ADD",REFLECT_ALONG_ADD; "REFLECT_ALONG_BASIS",REFLECT_ALONG_BASIS; "REFLECT_ALONG_BASIS_COMPONENT",REFLECT_ALONG_BASIS_COMPONENT; "REFLECT_ALONG_EQ",REFLECT_ALONG_EQ; "REFLECT_ALONG_EQ_0",REFLECT_ALONG_EQ_0; "REFLECT_ALONG_EQ_SELF",REFLECT_ALONG_EQ_SELF; "REFLECT_ALONG_INVOLUTION",REFLECT_ALONG_INVOLUTION; "REFLECT_ALONG_LINEAR_IMAGE",REFLECT_ALONG_LINEAR_IMAGE; "REFLECT_ALONG_MUL",REFLECT_ALONG_MUL; "REFLECT_ALONG_REFL",REFLECT_ALONG_REFL; "REFLECT_ALONG_SCALE",REFLECT_ALONG_SCALE; "REFLECT_ALONG_SURJECTIVE",REFLECT_ALONG_SURJECTIVE; "REFLECT_ALONG_ZERO",REFLECT_ALONG_ZERO; "REFLECT_INTERVAL",REFLECT_INTERVAL; "REFLECT_REAL_INTERVAL",REFLECT_REAL_INTERVAL; "REFLECT_UNIV",REFLECT_UNIV; "REFL_CLAUSE",REFL_CLAUSE; "REGULAR_CLOSED_UNION",REGULAR_CLOSED_UNION; "REGULAR_CLOSED_UNIONS",REGULAR_CLOSED_UNIONS; "REGULAR_CLOSED_UNIONS_FAT_CELLS_UNIV",REGULAR_CLOSED_UNIONS_FAT_CELLS_UNIV; "REGULAR_OPEN_INTER",REGULAR_OPEN_INTER; "REGULAR_POLYTOPE_DIST_BARYCENTRE",REGULAR_POLYTOPE_DIST_BARYCENTRE; "REGULAR_POLYTOPE_EXISTS",REGULAR_POLYTOPE_EXISTS; "REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS",REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS; "REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS_ALT",REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS_ALT; "RELATIVE_BOUNDARY_OF_CONVEX_HULL",RELATIVE_BOUNDARY_OF_CONVEX_HULL; "RELATIVE_BOUNDARY_OF_POLYHEDRON",RELATIVE_BOUNDARY_OF_POLYHEDRON; "RELATIVE_BOUNDARY_OF_TRIANGLE",RELATIVE_BOUNDARY_OF_TRIANGLE; "RELATIVE_BOUNDARY_POINT_IN_EXPOSED_FACE",RELATIVE_BOUNDARY_POINT_IN_EXPOSED_FACE; "RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE",RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE; "RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL; "RELATIVE_FRONTIER_BALL",RELATIVE_FRONTIER_BALL; "RELATIVE_FRONTIER_CBALL",RELATIVE_FRONTIER_CBALL; "RELATIVE_FRONTIER_CLOSURE",RELATIVE_FRONTIER_CLOSURE; "RELATIVE_FRONTIER_CONIC_HULL",RELATIVE_FRONTIER_CONIC_HULL; "RELATIVE_FRONTIER_CONVEX_HULL_CASES",RELATIVE_FRONTIER_CONVEX_HULL_CASES; "RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT",RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT; "RELATIVE_FRONTIER_CONVEX_INTER_AFFINE",RELATIVE_FRONTIER_CONVEX_INTER_AFFINE; "RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX",RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX; "RELATIVE_FRONTIER_EMPTY",RELATIVE_FRONTIER_EMPTY; "RELATIVE_FRONTIER_EQ_EMPTY",RELATIVE_FRONTIER_EQ_EMPTY; "RELATIVE_FRONTIER_FACIAL_PARTITION",RELATIVE_FRONTIER_FACIAL_PARTITION; "RELATIVE_FRONTIER_FACIAL_PARTITION_ALT",RELATIVE_FRONTIER_FACIAL_PARTITION_ALT; "RELATIVE_FRONTIER_FRONTIER",RELATIVE_FRONTIER_FRONTIER; "RELATIVE_FRONTIER_FRONTIER_OF",RELATIVE_FRONTIER_FRONTIER_OF; "RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE",RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE; "RELATIVE_FRONTIER_NONEMPTY_INTERIOR",RELATIVE_FRONTIER_NONEMPTY_INTERIOR; "RELATIVE_FRONTIER_NOT_SING",RELATIVE_FRONTIER_NOT_SING; "RELATIVE_FRONTIER_OF_CONVEX_CLOSED",RELATIVE_FRONTIER_OF_CONVEX_CLOSED; "RELATIVE_FRONTIER_OF_CONVEX_HULL",RELATIVE_FRONTIER_OF_CONVEX_HULL; "RELATIVE_FRONTIER_OF_POLYHEDRON",RELATIVE_FRONTIER_OF_POLYHEDRON; "RELATIVE_FRONTIER_OF_POLYHEDRON_ALT",RELATIVE_FRONTIER_OF_POLYHEDRON_ALT; "RELATIVE_FRONTIER_OF_TRIANGLE",RELATIVE_FRONTIER_OF_TRIANGLE; "RELATIVE_FRONTIER_OPEN",RELATIVE_FRONTIER_OPEN; "RELATIVE_FRONTIER_RELATIVE_INTERIOR",RELATIVE_FRONTIER_RELATIVE_INTERIOR; "RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL; "RELATIVE_FRONTIER_SING",RELATIVE_FRONTIER_SING; "RELATIVE_FRONTIER_SUBSET",RELATIVE_FRONTIER_SUBSET; "RELATIVE_FRONTIER_SUBSET_EQ",RELATIVE_FRONTIER_SUBSET_EQ; "RELATIVE_FRONTIER_SUBSET_FRONTIER",RELATIVE_FRONTIER_SUBSET_FRONTIER; "RELATIVE_FRONTIER_TRANSLATION",RELATIVE_FRONTIER_TRANSLATION; "RELATIVE_INTERIOR",RELATIVE_INTERIOR; "RELATIVE_INTERIOR_AFFINE",RELATIVE_INTERIOR_AFFINE; "RELATIVE_INTERIOR_BALL",RELATIVE_INTERIOR_BALL; "RELATIVE_INTERIOR_CBALL",RELATIVE_INTERIOR_CBALL; "RELATIVE_INTERIOR_CLOSURE_SUBSET",RELATIVE_INTERIOR_CLOSURE_SUBSET; "RELATIVE_INTERIOR_CONIC_HULL",RELATIVE_INTERIOR_CONIC_HULL; "RELATIVE_INTERIOR_CONIC_HULL_0",RELATIVE_INTERIOR_CONIC_HULL_0; "RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY",RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY; "RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT",RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT; "RELATIVE_INTERIOR_CONVEX_INTER_AFFINE",RELATIVE_INTERIOR_CONVEX_INTER_AFFINE; "RELATIVE_INTERIOR_CONVEX_INTER_OPEN",RELATIVE_INTERIOR_CONVEX_INTER_OPEN; "RELATIVE_INTERIOR_CONVEX_PROLONG",RELATIVE_INTERIOR_CONVEX_PROLONG; "RELATIVE_INTERIOR_EMPTY",RELATIVE_INTERIOR_EMPTY; "RELATIVE_INTERIOR_EQ",RELATIVE_INTERIOR_EQ; "RELATIVE_INTERIOR_EQ_CLOSURE",RELATIVE_INTERIOR_EQ_CLOSURE; "RELATIVE_INTERIOR_EQ_EMPTY",RELATIVE_INTERIOR_EQ_EMPTY; "RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE",RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE; "RELATIVE_INTERIOR_INTER",RELATIVE_INTERIOR_INTER; "RELATIVE_INTERIOR_INTERIOR",RELATIVE_INTERIOR_INTERIOR; "RELATIVE_INTERIOR_INTERIOR_OF",RELATIVE_INTERIOR_INTERIOR_OF; "RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX",RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; "RELATIVE_INTERIOR_LINEAR_PREIMAGE_CONVEX",RELATIVE_INTERIOR_LINEAR_PREIMAGE_CONVEX; "RELATIVE_INTERIOR_MAXIMAL",RELATIVE_INTERIOR_MAXIMAL; "RELATIVE_INTERIOR_NONEMPTY_INTERIOR",RELATIVE_INTERIOR_NONEMPTY_INTERIOR; "RELATIVE_INTERIOR_OF_POLYHEDRON",RELATIVE_INTERIOR_OF_POLYHEDRON; "RELATIVE_INTERIOR_OPEN",RELATIVE_INTERIOR_OPEN; "RELATIVE_INTERIOR_OPEN_IN",RELATIVE_INTERIOR_OPEN_IN; "RELATIVE_INTERIOR_PCROSS",RELATIVE_INTERIOR_PCROSS; "RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT",RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT; "RELATIVE_INTERIOR_PROLONG",RELATIVE_INTERIOR_PROLONG; "RELATIVE_INTERIOR_RELATIVE_INTERIOR",RELATIVE_INTERIOR_RELATIVE_INTERIOR; "RELATIVE_INTERIOR_SEGMENT",RELATIVE_INTERIOR_SEGMENT; "RELATIVE_INTERIOR_SING",RELATIVE_INTERIOR_SING; "RELATIVE_INTERIOR_SUBSET",RELATIVE_INTERIOR_SUBSET; "RELATIVE_INTERIOR_SUBSET_OF_PROPER_FACE",RELATIVE_INTERIOR_SUBSET_OF_PROPER_FACE; "RELATIVE_INTERIOR_SUMS",RELATIVE_INTERIOR_SUMS; "RELATIVE_INTERIOR_TRANSLATION",RELATIVE_INTERIOR_TRANSLATION; "RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY; "RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS; "RELATIVE_INTERIOR_UNIQUE",RELATIVE_INTERIOR_UNIQUE; "RELATIVE_INTERIOR_UNIV",RELATIVE_INTERIOR_UNIV; "RELATIVE_ORIENTATION",RELATIVE_ORIENTATION; "RELATIVE_ORIENTATION_COMPOSE",RELATIVE_ORIENTATION_COMPOSE; "RELATIVE_ORIENTATION_LINEAR",RELATIVE_ORIENTATION_LINEAR; "RELATIVE_ORIENTATION_NONZERO",RELATIVE_ORIENTATION_NONZERO; "RELATIVE_TO_COMPL",RELATIVE_TO_COMPL; "RELATIVE_TO_IMP_SUBSET",RELATIVE_TO_IMP_SUBSET; "RELATIVE_TO_MONO",RELATIVE_TO_MONO; "RELATIVE_TO_SUBSET",RELATIVE_TO_SUBSET; "RELATIVE_TO_SUBSET_TRANS",RELATIVE_TO_SUBSET_TRANS; "RELATIVE_TO_UNIV",RELATIVE_TO_UNIV; "REPLICATE",REPLICATE; "REP_ABS_PAIR",REP_ABS_PAIR; "REST",REST; "RESTRICTION",RESTRICTION; "RESTRICTION_COMPOSE",RESTRICTION_COMPOSE; "RESTRICTION_COMPOSE_LEFT",RESTRICTION_COMPOSE_LEFT; "RESTRICTION_COMPOSE_RIGHT",RESTRICTION_COMPOSE_RIGHT; "RESTRICTION_CONTINUOUS_ON",RESTRICTION_CONTINUOUS_ON; "RESTRICTION_DEFINED",RESTRICTION_DEFINED; "RESTRICTION_EQ",RESTRICTION_EQ; "RESTRICTION_EXTENSION",RESTRICTION_EXTENSION; "RESTRICTION_FIXPOINT",RESTRICTION_FIXPOINT; "RESTRICTION_HAS_DERIVATIVE",RESTRICTION_HAS_DERIVATIVE; "RESTRICTION_IDEMP",RESTRICTION_IDEMP; "RESTRICTION_IN_EXTENSIONAL",RESTRICTION_IN_EXTENSIONAL; "RESTRICTION_UNDEFINED",RESTRICTION_UNDEFINED; "RETRACTION",RETRACTION; "RETRACTION_ARC",RETRACTION_ARC; "RETRACTION_CLOSEST_POINT",RETRACTION_CLOSEST_POINT; "RETRACTION_IDEMPOTENT",RETRACTION_IDEMPOTENT; "RETRACTION_IMP_QUOTIENT_MAP",RETRACTION_IMP_QUOTIENT_MAP; "RETRACTION_REFL",RETRACTION_REFL; "RETRACTION_SUBSET",RETRACTION_SUBSET; "RETRACTION_o",RETRACTION_o; "RETRACT_FIXPOINT_PROPERTY",RETRACT_FIXPOINT_PROPERTY; "RETRACT_FROM_UNION_AND_INTER",RETRACT_FROM_UNION_AND_INTER; "RETRACT_OF_BORSUKIAN",RETRACT_OF_BORSUKIAN; "RETRACT_OF_CLOSED",RETRACT_OF_CLOSED; "RETRACT_OF_CLOSED_UNION",RETRACT_OF_CLOSED_UNION; "RETRACT_OF_COHOMOTOPICALLY_TRIVIAL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL; "RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL; "RETRACT_OF_COMPACT",RETRACT_OF_COMPACT; "RETRACT_OF_CONNECTED",RETRACT_OF_CONNECTED; "RETRACT_OF_CONTRACTIBLE",RETRACT_OF_CONTRACTIBLE; "RETRACT_OF_EMPTY",RETRACT_OF_EMPTY; "RETRACT_OF_HOMOTOPICALLY_TRIVIAL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL; "RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL; "RETRACT_OF_IMP_EXTENSIBLE",RETRACT_OF_IMP_EXTENSIBLE; "RETRACT_OF_IMP_SUBSET",RETRACT_OF_IMP_SUBSET; "RETRACT_OF_INJECTIVE_LINEAR_IMAGE",RETRACT_OF_INJECTIVE_LINEAR_IMAGE; "RETRACT_OF_LINEAR_IMAGE_EQ",RETRACT_OF_LINEAR_IMAGE_EQ; "RETRACT_OF_LOCALLY_COMPACT",RETRACT_OF_LOCALLY_COMPACT; "RETRACT_OF_LOCALLY_CONNECTED",RETRACT_OF_LOCALLY_CONNECTED; "RETRACT_OF_LOCALLY_PATH_CONNECTED",RETRACT_OF_LOCALLY_PATH_CONNECTED; "RETRACT_OF_OPEN_UNION",RETRACT_OF_OPEN_UNION; "RETRACT_OF_PATH_CONNECTED",RETRACT_OF_PATH_CONNECTED; "RETRACT_OF_PCROSS",RETRACT_OF_PCROSS; "RETRACT_OF_PCROSS_EQ",RETRACT_OF_PCROSS_EQ; "RETRACT_OF_REFL",RETRACT_OF_REFL; "RETRACT_OF_SEPARATED_UNION",RETRACT_OF_SEPARATED_UNION; "RETRACT_OF_SIMPLY_CONNECTED",RETRACT_OF_SIMPLY_CONNECTED; "RETRACT_OF_SING",RETRACT_OF_SING; "RETRACT_OF_SUBSET",RETRACT_OF_SUBSET; "RETRACT_OF_TRANS",RETRACT_OF_TRANS; "RETRACT_OF_TRANSLATION",RETRACT_OF_TRANSLATION; "RETRACT_OF_TRANSLATION_EQ",RETRACT_OF_TRANSLATION_EQ; "RETRACT_OF_UNIV",RETRACT_OF_UNIV; "REVERSE",REVERSE; "REVERSEPATH_JOINPATHS",REVERSEPATH_JOINPATHS; "REVERSEPATH_LINEAR_IMAGE",REVERSEPATH_LINEAR_IMAGE; "REVERSEPATH_LINEPATH",REVERSEPATH_LINEPATH; "REVERSEPATH_REVERSEPATH",REVERSEPATH_REVERSEPATH; "REVERSEPATH_SUBPATH",REVERSEPATH_SUBPATH; "REVERSEPATH_TRANSLATION",REVERSEPATH_TRANSLATION; "REVERSE_APPEND",REVERSE_APPEND; "REVERSE_REVERSE",REVERSE_REVERSE; "RE_ADD",RE_ADD; "RE_CACS",RE_CACS; "RE_CACS_BOUND",RE_CACS_BOUND; "RE_CACS_BOUNDS",RE_CACS_BOUNDS; "RE_CASN",RE_CASN; "RE_CASN_BOUND",RE_CASN_BOUND; "RE_CASN_BOUNDS",RE_CASN_BOUNDS; "RE_CATN_BOUNDS",RE_CATN_BOUNDS; "RE_CCOS",RE_CCOS; "RE_CEXP",RE_CEXP; "RE_CLOG",RE_CLOG; "RE_CLOG_POS_LE",RE_CLOG_POS_LE; "RE_CLOG_POS_LT",RE_CLOG_POS_LT; "RE_CLOG_POS_LT_IMP",RE_CLOG_POS_LT_IMP; "RE_CMUL",RE_CMUL; "RE_CNJ",RE_CNJ; "RE_COMPLEX_DIV_EQ_0",RE_COMPLEX_DIV_EQ_0; "RE_COMPLEX_DIV_GE_0",RE_COMPLEX_DIV_GE_0; "RE_COMPLEX_DIV_GT_0",RE_COMPLEX_DIV_GT_0; "RE_COMPLEX_DIV_LEMMA",RE_COMPLEX_DIV_LEMMA; "RE_COMPLEX_DIV_LE_0",RE_COMPLEX_DIV_LE_0; "RE_COMPLEX_DIV_LT_0",RE_COMPLEX_DIV_LT_0; "RE_COMPLEX_INV_GE_0",RE_COMPLEX_INV_GE_0; "RE_COMPLEX_INV_GT_0",RE_COMPLEX_INV_GT_0; "RE_CSIN",RE_CSIN; "RE_CSQRT",RE_CSQRT; "RE_CX",RE_CX; "RE_DEF",RE_DEF; "RE_DIV_CX",RE_DIV_CX; "RE_II",RE_II; "RE_LINEPATH_CX",RE_LINEPATH_CX; "RE_MUL_CX",RE_MUL_CX; "RE_MUL_II",RE_MUL_II; "RE_NEG",RE_NEG; "RE_POS_SEGMENT",RE_POS_SEGMENT; "RE_POW_2",RE_POW_2; "RE_SUB",RE_SUB; "RE_VSUM",RE_VSUM; "RE_WINDING_NUMBER",RE_WINDING_NUMBER; "RIEMANN_MAPPING_THEOREM",RIEMANN_MAPPING_THEOREM; "RIGHT_ADD_DISTRIB",RIGHT_ADD_DISTRIB; "RIGHT_AND_EXISTS_THM",RIGHT_AND_EXISTS_THM; "RIGHT_AND_FORALL_THM",RIGHT_AND_FORALL_THM; "RIGHT_EXISTS_AND_THM",RIGHT_EXISTS_AND_THM; "RIGHT_EXISTS_IMP_THM",RIGHT_EXISTS_IMP_THM; "RIGHT_FORALL_IMP_THM",RIGHT_FORALL_IMP_THM; "RIGHT_FORALL_OR_THM",RIGHT_FORALL_OR_THM; "RIGHT_IMP_EXISTS_THM",RIGHT_IMP_EXISTS_THM; "RIGHT_IMP_FORALL_THM",RIGHT_IMP_FORALL_THM; "RIGHT_INVERSE_LINEAR",RIGHT_INVERSE_LINEAR; "RIGHT_INVERTIBLE_TRANSP",RIGHT_INVERTIBLE_TRANSP; "RIGHT_OR_DISTRIB",RIGHT_OR_DISTRIB; "RIGHT_OR_EXISTS_THM",RIGHT_OR_EXISTS_THM; "RIGHT_OR_FORALL_THM",RIGHT_OR_FORALL_THM; "RIGHT_POLAR_DECOMPOSITION",RIGHT_POLAR_DECOMPOSITION; "RIGHT_POLAR_DECOMPOSITION_INVERTIBLE",RIGHT_POLAR_DECOMPOSITION_INVERTIBLE; "RIGHT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE",RIGHT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE; "RIGHT_POLAR_DECOMPOSITION_UNIQUE",RIGHT_POLAR_DECOMPOSITION_UNIQUE; "RIGHT_SUB_DISTRIB",RIGHT_SUB_DISTRIB; "RIGID_TRANSFORMATION_BETWEEN_2",RIGID_TRANSFORMATION_BETWEEN_2; "RIGID_TRANSFORMATION_BETWEEN_3",RIGID_TRANSFORMATION_BETWEEN_3; "RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS; "RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG; "ROLLE",ROLLE; "ROOT_0",ROOT_0; "ROOT_1",ROOT_1; "ROOT_2",ROOT_2; "ROOT_EQ_0",ROOT_EQ_0; "ROOT_EXP_LOG",ROOT_EXP_LOG; "ROOT_INJ",ROOT_INJ; "ROOT_LE_0",ROOT_LE_0; "ROOT_LT_0",ROOT_LT_0; "ROOT_MONO_LE",ROOT_MONO_LE; "ROOT_MONO_LE_EQ",ROOT_MONO_LE_EQ; "ROOT_MONO_LT",ROOT_MONO_LT; "ROOT_MONO_LT_EQ",ROOT_MONO_LT_EQ; "ROOT_NEG",ROOT_NEG; "ROOT_POS_LE",ROOT_POS_LE; "ROOT_POS_LT",ROOT_POS_LT; "ROOT_PRODUCT",ROOT_PRODUCT; "ROOT_UNIQUE",ROOT_UNIQUE; "ROOT_WORKS",ROOT_WORKS; "ROTATE2D_0",ROTATE2D_0; "ROTATE2D_2PI",ROTATE2D_2PI; "ROTATE2D_ADD",ROTATE2D_ADD; "ROTATE2D_ADD_VECTORS",ROTATE2D_ADD_VECTORS; "ROTATE2D_COMPLEX",ROTATE2D_COMPLEX; "ROTATE2D_EQ",ROTATE2D_EQ; "ROTATE2D_EQ_0",ROTATE2D_EQ_0; "ROTATE2D_NPI",ROTATE2D_NPI; "ROTATE2D_PI",ROTATE2D_PI; "ROTATE2D_PI2",ROTATE2D_PI2; "ROTATE2D_POLAR",ROTATE2D_POLAR; "ROTATE2D_SUB",ROTATE2D_SUB; "ROTATE2D_SUB_ARG",ROTATE2D_SUB_ARG; "ROTATE2D_ZERO",ROTATE2D_ZERO; "ROTATION_EXISTS",ROTATION_EXISTS; "ROTATION_EXISTS_1",ROTATION_EXISTS_1; "ROTATION_LOWDIM_HORIZONTAL",ROTATION_LOWDIM_HORIZONTAL; "ROTATION_MATRIX_1",ROTATION_MATRIX_1; "ROTATION_MATRIX_2",ROTATION_MATRIX_2; "ROTATION_MATRIX_EXISTS_BASIS",ROTATION_MATRIX_EXISTS_BASIS; "ROTATION_MATRIX_ROTATE2D",ROTATION_MATRIX_ROTATE2D; "ROTATION_MATRIX_ROTATE2D_EQ",ROTATION_MATRIX_ROTATE2D_EQ; "ROTATION_RIGHTWARD_LINE",ROTATION_RIGHTWARD_LINE; "ROTATION_ROTATE2D",ROTATION_ROTATE2D; "ROTATION_ROTATE2D_EXISTS",ROTATION_ROTATE2D_EXISTS; "ROTATION_ROTATE2D_EXISTS_GEN",ROTATION_ROTATE2D_EXISTS_GEN; "ROTATION_ROTATE2D_EXISTS_ORTHOGONAL",ROTATION_ROTATE2D_EXISTS_ORTHOGONAL; "ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED",ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED; "ROTATION_TO_GENERAL_POSITION_EXISTS",ROTATION_TO_GENERAL_POSITION_EXISTS; "ROTATION_TO_GENERAL_POSITION_EXISTS_GEN",ROTATION_TO_GENERAL_POSITION_EXISTS_GEN; "ROTHE",ROTHE; "ROTOINVERSION_EXISTS_GEN",ROTOINVERSION_EXISTS_GEN; "ROTOINVERSION_MATRIX_1",ROTOINVERSION_MATRIX_1; "ROTOINVERSION_MATRIX_REFLECT_ALONG",ROTOINVERSION_MATRIX_REFLECT_ALONG; "ROWS_MAPROWS",ROWS_MAPROWS; "ROWS_NONEMPTY",ROWS_NONEMPTY; "ROWS_TRANSP",ROWS_TRANSP; "ROW_0",ROW_0; "ROW_MAPROWS",ROW_MAPROWS; "ROW_MATRIX_MUL",ROW_MATRIX_MUL; "ROW_TRANSP",ROW_TRANSP; "RPOW_0",RPOW_0; "RPOW_1_LE",RPOW_1_LE; "RPOW_ADD",RPOW_ADD; "RPOW_ADD_ALT",RPOW_ADD_ALT; "RPOW_ADD_INTEGER",RPOW_ADD_INTEGER; "RPOW_DIV",RPOW_DIV; "RPOW_EQ_0",RPOW_EQ_0; "RPOW_INJ",RPOW_INJ; "RPOW_INV",RPOW_INV; "RPOW_LE2",RPOW_LE2; "RPOW_LE_1",RPOW_LE_1; "RPOW_LNEG",RPOW_LNEG; "RPOW_LT2",RPOW_LT2; "RPOW_LT_1",RPOW_LT_1; "RPOW_MINUS1_QUOTIENT_LE",RPOW_MINUS1_QUOTIENT_LE; "RPOW_MINUS1_QUOTIENT_LT",RPOW_MINUS1_QUOTIENT_LT; "RPOW_MONO_INV",RPOW_MONO_INV; "RPOW_MONO_LE",RPOW_MONO_LE; "RPOW_MONO_LE_EQ",RPOW_MONO_LE_EQ; "RPOW_MONO_LT",RPOW_MONO_LT; "RPOW_MONO_LT_EQ",RPOW_MONO_LT_EQ; "RPOW_MUL",RPOW_MUL; "RPOW_NEG",RPOW_NEG; "RPOW_ONE",RPOW_ONE; "RPOW_POS_LE",RPOW_POS_LE; "RPOW_POS_LT",RPOW_POS_LT; "RPOW_POW",RPOW_POW; "RPOW_PRODUCT",RPOW_PRODUCT; "RPOW_RPOW",RPOW_RPOW; "RPOW_SQRT",RPOW_SQRT; "RPOW_SUB",RPOW_SUB; "RPOW_SUB_ALT",RPOW_SUB_ALT; "RPOW_ZERO",RPOW_ZERO; "RSUM_BOUND",RSUM_BOUND; "RSUM_COMPONENT_LE",RSUM_COMPONENT_LE; "RSUM_DIFF_BOUND",RSUM_DIFF_BOUND; "SAME_DISTANCES_TO_AFFINE_HULL",SAME_DISTANCES_TO_AFFINE_HULL; "SAME_EIGENVALUES_MATRIX_MUL",SAME_EIGENVALUES_MATRIX_MUL; "SAME_EIGENVALUES_SIMILAR",SAME_EIGENVALUES_SIMILAR; "SAME_EIGENVALUES_TRANSP",SAME_EIGENVALUES_TRANSP; "SAME_EIGENVECTORS_MATRIX_INV",SAME_EIGENVECTORS_MATRIX_INV; "SAME_NORM_SAME_DOT",SAME_NORM_SAME_DOT; "SCALING_LINEAR",SCALING_LINEAR; "SCHAUDER",SCHAUDER; "SCHAUDER_GEN",SCHAUDER_GEN; "SCHAUDER_PROJECTION",SCHAUDER_PROJECTION; "SCHAUDER_UNIV",SCHAUDER_UNIV; "SCHOTTKY",SCHOTTKY; "SCHWARZ_LEMMA",SCHWARZ_LEMMA; "SCHWARZ_REFLECTION",SCHWARZ_REFLECTION; "SCHWARZ_REFLECTION_UNIQUE",SCHWARZ_REFLECTION_UNIQUE; "SECOND_CARTAN_THM_DIM_1",SECOND_CARTAN_THM_DIM_1; "SECOND_MEAN_VALUE_THEOREM",SECOND_MEAN_VALUE_THEOREM; "SECOND_MEAN_VALUE_THEOREM_BONNET",SECOND_MEAN_VALUE_THEOREM_BONNET; "SECOND_MEAN_VALUE_THEOREM_BONNET_FULL",SECOND_MEAN_VALUE_THEOREM_BONNET_FULL; "SECOND_MEAN_VALUE_THEOREM_FULL",SECOND_MEAN_VALUE_THEOREM_FULL; "SECOND_MEAN_VALUE_THEOREM_GEN",SECOND_MEAN_VALUE_THEOREM_GEN; "SECOND_MEAN_VALUE_THEOREM_GEN_FULL",SECOND_MEAN_VALUE_THEOREM_GEN_FULL; "SEGMENTS_SUBSET_CONVEX_HULL",SEGMENTS_SUBSET_CONVEX_HULL; "SEGMENT_1",SEGMENT_1; "SEGMENT_AS_BALL",SEGMENT_AS_BALL; "SEGMENT_BOUND",SEGMENT_BOUND; "SEGMENT_CLOSED_OPEN",SEGMENT_CLOSED_OPEN; "SEGMENT_CONVEX_HULL",SEGMENT_CONVEX_HULL; "SEGMENT_EDGE_OF",SEGMENT_EDGE_OF; "SEGMENT_EQ",SEGMENT_EQ; "SEGMENT_EQ_EMPTY",SEGMENT_EQ_EMPTY; "SEGMENT_EQ_SING",SEGMENT_EQ_SING; "SEGMENT_FACE_OF",SEGMENT_FACE_OF; "SEGMENT_FURTHEST_LE",SEGMENT_FURTHEST_LE; "SEGMENT_HORIZONTAL",SEGMENT_HORIZONTAL; "SEGMENT_IMAGE_INTERVAL",SEGMENT_IMAGE_INTERVAL; "SEGMENT_OPEN_SUBSET_CLOSED",SEGMENT_OPEN_SUBSET_CLOSED; "SEGMENT_REAL_SEGMENT",SEGMENT_REAL_SEGMENT; "SEGMENT_REFL",SEGMENT_REFL; "SEGMENT_SCALAR_MULTIPLE",SEGMENT_SCALAR_MULTIPLE; "SEGMENT_SUBSET_CONVEX",SEGMENT_SUBSET_CONVEX; "SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX",SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX; "SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX_GEN",SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX_GEN; "SEGMENT_SYM",SEGMENT_SYM; "SEGMENT_TO_CLOSEST_POINT",SEGMENT_TO_CLOSEST_POINT; "SEGMENT_TO_FRONTIER",SEGMENT_TO_FRONTIER; "SEGMENT_TO_FRONTIER_SIMPLE",SEGMENT_TO_FRONTIER_SIMPLE; "SEGMENT_TO_POINT_EXISTS",SEGMENT_TO_POINT_EXISTS; "SEGMENT_TO_RELATIVE_FRONTIER",SEGMENT_TO_RELATIVE_FRONTIER; "SEGMENT_TO_RELATIVE_FRONTIER_SIMPLE",SEGMENT_TO_RELATIVE_FRONTIER_SIMPLE; "SEGMENT_TRANSLATION",SEGMENT_TRANSLATION; "SEGMENT_VERTICAL",SEGMENT_VERTICAL; "SELECT_AX",SELECT_AX; "SELECT_REFL",SELECT_REFL; "SELECT_UNIQUE",SELECT_UNIQUE; "SELF_ADJOINT_CLOSEST_POINT",SELF_ADJOINT_CLOSEST_POINT; "SELF_ADJOINT_COMPOSE",SELF_ADJOINT_COMPOSE; "SELF_ADJOINT_HAS_EIGENVECTOR",SELF_ADJOINT_HAS_EIGENVECTOR; "SELF_ADJOINT_HAS_EIGENVECTOR_BASIS",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS; "SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE; "SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE; "SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS",SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS; "SEMI_LOCALLY_CONNECTED",SEMI_LOCALLY_CONNECTED; "SEMI_LOCALLY_CONNECTED_COMPACT",SEMI_LOCALLY_CONNECTED_COMPACT; "SEMI_LOCALLY_CONNECTED_GEN",SEMI_LOCALLY_CONNECTED_GEN; "SEPARABLE",SEPARABLE; "SEPARATE_CLOSED_COMPACT",SEPARATE_CLOSED_COMPACT; "SEPARATE_CLOSED_CONES",SEPARATE_CLOSED_CONES; "SEPARATE_COMPACT_CLOSED",SEPARATE_COMPACT_CLOSED; "SEPARATE_POINT_CLOSED",SEPARATE_POINT_CLOSED; "SEPARATING_HYPERPLANE_AFFINE_AFFINE",SEPARATING_HYPERPLANE_AFFINE_AFFINE; "SEPARATING_HYPERPLANE_AFFINE_HULLS",SEPARATING_HYPERPLANE_AFFINE_HULLS; "SEPARATING_HYPERPLANE_CLOSED_0",SEPARATING_HYPERPLANE_CLOSED_0; "SEPARATING_HYPERPLANE_CLOSED_0_INSET",SEPARATING_HYPERPLANE_CLOSED_0_INSET; "SEPARATING_HYPERPLANE_CLOSED_COMPACT",SEPARATING_HYPERPLANE_CLOSED_COMPACT; "SEPARATING_HYPERPLANE_CLOSED_POINT",SEPARATING_HYPERPLANE_CLOSED_POINT; "SEPARATING_HYPERPLANE_CLOSED_POINT_INSET",SEPARATING_HYPERPLANE_CLOSED_POINT_INSET; "SEPARATING_HYPERPLANE_COMPACT_CLOSED",SEPARATING_HYPERPLANE_COMPACT_CLOSED; "SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO",SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO; "SEPARATING_HYPERPLANE_COMPACT_COMPACT",SEPARATING_HYPERPLANE_COMPACT_COMPACT; "SEPARATING_HYPERPLANE_POLYHEDRA",SEPARATING_HYPERPLANE_POLYHEDRA; "SEPARATING_HYPERPLANE_RELATIVE_INTERIORS",SEPARATING_HYPERPLANE_RELATIVE_INTERIORS; "SEPARATING_HYPERPLANE_SETS",SEPARATING_HYPERPLANE_SETS; "SEPARATING_HYPERPLANE_SET_0",SEPARATING_HYPERPLANE_SET_0; "SEPARATING_HYPERPLANE_SET_0_INSPAN",SEPARATING_HYPERPLANE_SET_0_INSPAN; "SEPARATING_HYPERPLANE_SET_POINT_INAFF",SEPARATING_HYPERPLANE_SET_POINT_INAFF; "SEPARATION_BY_CLOSED_INTERMEDIATES",SEPARATION_BY_CLOSED_INTERMEDIATES; "SEPARATION_BY_CLOSED_INTERMEDIATES_EQ",SEPARATION_BY_CLOSED_INTERMEDIATES_EQ; "SEPARATION_BY_COMPONENT_CLOSED",SEPARATION_BY_COMPONENT_CLOSED; "SEPARATION_BY_COMPONENT_CLOSED_POINTWISE",SEPARATION_BY_COMPONENT_CLOSED_POINTWISE; "SEPARATION_BY_COMPONENT_OPEN",SEPARATION_BY_COMPONENT_OPEN; "SEPARATION_BY_UNION_CLOSED",SEPARATION_BY_UNION_CLOSED; "SEPARATION_BY_UNION_CLOSED_POINTWISE",SEPARATION_BY_UNION_CLOSED_POINTWISE; "SEPARATION_BY_UNION_OPEN",SEPARATION_BY_UNION_OPEN; "SEPARATION_CLOSED_IN_UNION",SEPARATION_CLOSED_IN_UNION; "SEPARATION_CLOSURES",SEPARATION_CLOSURES; "SEPARATION_HAUSDORFF",SEPARATION_HAUSDORFF; "SEPARATION_NORMAL",SEPARATION_NORMAL; "SEPARATION_NORMAL_CLOSURES",SEPARATION_NORMAL_CLOSURES; "SEPARATION_NORMAL_COMPACT",SEPARATION_NORMAL_COMPACT; "SEPARATION_NORMAL_LOCAL",SEPARATION_NORMAL_LOCAL; "SEPARATION_NORMAL_LOCAL_CLOSURES",SEPARATION_NORMAL_LOCAL_CLOSURES; "SEPARATION_OPEN_IN_UNION",SEPARATION_OPEN_IN_UNION; "SEPARATION_T0",SEPARATION_T0; "SEPARATION_T1",SEPARATION_T1; "SEPARATION_T2",SEPARATION_T2; "SEQITERATE_CLAUSES",SEQITERATE_CLAUSES; "SEQITERATE_ITERATE",SEQITERATE_ITERATE; "SEQUENCE_CAUCHY_WLOG",SEQUENCE_CAUCHY_WLOG; "SEQUENCE_ESCAPES",SEQUENCE_ESCAPES; "SEQUENCE_ESCAPES_ALT",SEQUENCE_ESCAPES_ALT; "SEQUENCE_INFINITE_LEMMA",SEQUENCE_INFINITE_LEMMA; "SEQUENCE_UNIQUE_LIMPT",SEQUENCE_UNIQUE_LIMPT; "SEQUENTIALLY",SEQUENTIALLY; "SEQUENTIALLY_CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE",SEQUENTIALLY_CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE; "SEQUENTIAL_LIMIT_URYSOHN",SEQUENTIAL_LIMIT_URYSOHN; "SEQ_HARMONIC",SEQ_HARMONIC; "SEQ_HARMONIC_OFFSET",SEQ_HARMONIC_OFFSET; "SEQ_HARMONIC_RATIO",SEQ_HARMONIC_RATIO; "SEQ_MONO_LEMMA",SEQ_MONO_LEMMA; "SEQ_OFFSET",SEQ_OFFSET; "SEQ_OFFSET_EQ",SEQ_OFFSET_EQ; "SEQ_OFFSET_NEG",SEQ_OFFSET_NEG; "SEQ_OFFSET_REV",SEQ_OFFSET_REV; "SERIES_0",SERIES_0; "SERIES_ABSCONV_IMP_CONV",SERIES_ABSCONV_IMP_CONV; "SERIES_ADD",SERIES_ADD; "SERIES_AND_DERIVATIVE_COMPARISON",SERIES_AND_DERIVATIVE_COMPARISON; "SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX",SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX; "SERIES_AND_DERIVATIVE_COMPARISON_LOCAL",SERIES_AND_DERIVATIVE_COMPARISON_LOCAL; "SERIES_BILINEAR",SERIES_BILINEAR; "SERIES_BILINEAR_UNIQUE",SERIES_BILINEAR_UNIQUE; "SERIES_BOUND",SERIES_BOUND; "SERIES_CAUCHY",SERIES_CAUCHY; "SERIES_CAUCHY_UNIFORM",SERIES_CAUCHY_UNIFORM; "SERIES_CMUL",SERIES_CMUL; "SERIES_COMPARISON",SERIES_COMPARISON; "SERIES_COMPARISON_BOUND",SERIES_COMPARISON_BOUND; "SERIES_COMPARISON_COMPLEX",SERIES_COMPARISON_COMPLEX; "SERIES_COMPARISON_UNIFORM",SERIES_COMPARISON_UNIFORM; "SERIES_COMPARISON_UNIFORM_COMPLEX",SERIES_COMPARISON_UNIFORM_COMPLEX; "SERIES_COMPLEX_DIV",SERIES_COMPLEX_DIV; "SERIES_COMPLEX_LMUL",SERIES_COMPLEX_LMUL; "SERIES_COMPLEX_MUL",SERIES_COMPLEX_MUL; "SERIES_COMPLEX_MUL_UNIQUE",SERIES_COMPLEX_MUL_UNIQUE; "SERIES_COMPLEX_RMUL",SERIES_COMPLEX_RMUL; "SERIES_COMPONENT",SERIES_COMPONENT; "SERIES_CX_LIFT",SERIES_CX_LIFT; "SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX",SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX; "SERIES_DIFFS",SERIES_DIFFS; "SERIES_DIRICHLET",SERIES_DIRICHLET; "SERIES_DIRICHLET_BILINEAR",SERIES_DIRICHLET_BILINEAR; "SERIES_DIRICHLET_COMPLEX",SERIES_DIRICHLET_COMPLEX; "SERIES_DIRICHLET_COMPLEX_EXPLICIT",SERIES_DIRICHLET_COMPLEX_EXPLICIT; "SERIES_DIRICHLET_COMPLEX_GEN",SERIES_DIRICHLET_COMPLEX_GEN; "SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT",SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT; "SERIES_DROP_LE",SERIES_DROP_LE; "SERIES_DROP_POS",SERIES_DROP_POS; "SERIES_EVEN",SERIES_EVEN; "SERIES_FINITE",SERIES_FINITE; "SERIES_FINITE_EQ",SERIES_FINITE_EQ; "SERIES_FINITE_SUPPORT",SERIES_FINITE_SUPPORT; "SERIES_FROM",SERIES_FROM; "SERIES_GOESTOZERO",SERIES_GOESTOZERO; "SERIES_INJECTIVE_IMAGE",SERIES_INJECTIVE_IMAGE; "SERIES_INJECTIVE_IMAGE_STRONG",SERIES_INJECTIVE_IMAGE_STRONG; "SERIES_LIFT_ABSCONV_IMP_CONV",SERIES_LIFT_ABSCONV_IMP_CONV; "SERIES_LINEAR",SERIES_LINEAR; "SERIES_NEG",SERIES_NEG; "SERIES_ODD",SERIES_ODD; "SERIES_RATIO",SERIES_RATIO; "SERIES_REARRANGE",SERIES_REARRANGE; "SERIES_REARRANGE_EQ",SERIES_REARRANGE_EQ; "SERIES_RESTRICT",SERIES_RESTRICT; "SERIES_SUB",SERIES_SUB; "SERIES_SUBSET",SERIES_SUBSET; "SERIES_TERMS_TOZERO",SERIES_TERMS_TOZERO; "SERIES_TRIVIAL",SERIES_TRIVIAL; "SERIES_UNIQUE",SERIES_UNIQUE; "SERIES_VSUM",SERIES_VSUM; "SETCODE_BOUNDS",SETCODE_BOUNDS; "SETDIST_BALLS",SETDIST_BALLS; "SETDIST_CLOSED_COMPACT",SETDIST_CLOSED_COMPACT; "SETDIST_CLOSEST_POINT",SETDIST_CLOSEST_POINT; "SETDIST_CLOSURE",SETDIST_CLOSURE; "SETDIST_COMPACT_CLOSED",SETDIST_COMPACT_CLOSED; "SETDIST_DIFFERENCES",SETDIST_DIFFERENCES; "SETDIST_EMPTY",SETDIST_EMPTY; "SETDIST_EQ_0_BOUNDED",SETDIST_EQ_0_BOUNDED; "SETDIST_EQ_0_CLOSED",SETDIST_EQ_0_CLOSED; "SETDIST_EQ_0_CLOSED_COMPACT",SETDIST_EQ_0_CLOSED_COMPACT; "SETDIST_EQ_0_CLOSED_IN",SETDIST_EQ_0_CLOSED_IN; "SETDIST_EQ_0_COMPACT_CLOSED",SETDIST_EQ_0_COMPACT_CLOSED; "SETDIST_EQ_0_SING",SETDIST_EQ_0_SING; "SETDIST_FRONTIER",SETDIST_FRONTIER; "SETDIST_FRONTIERS",SETDIST_FRONTIERS; "SETDIST_HAUSDIST_TRIANGLE",SETDIST_HAUSDIST_TRIANGLE; "SETDIST_LE_DIST",SETDIST_LE_DIST; "SETDIST_LE_HAUSDIST",SETDIST_LE_HAUSDIST; "SETDIST_LE_SING",SETDIST_LE_SING; "SETDIST_LINEAR_IMAGE",SETDIST_LINEAR_IMAGE; "SETDIST_LIPSCHITZ",SETDIST_LIPSCHITZ; "SETDIST_POS_LE",SETDIST_POS_LE; "SETDIST_POS_LT",SETDIST_POS_LT; "SETDIST_REFL",SETDIST_REFL; "SETDIST_RELATIVE_INTERIOR",SETDIST_RELATIVE_INTERIOR; "SETDIST_SCALING",SETDIST_SCALING; "SETDIST_SINGS",SETDIST_SINGS; "SETDIST_SING_FRONTIER",SETDIST_SING_FRONTIER; "SETDIST_SING_FRONTIER_CASES",SETDIST_SING_FRONTIER_CASES; "SETDIST_SING_IN_SET",SETDIST_SING_IN_SET; "SETDIST_SING_LE_HAUSDIST",SETDIST_SING_LE_HAUSDIST; "SETDIST_SING_TRIANGLE",SETDIST_SING_TRIANGLE; "SETDIST_SUBSETS_EQ",SETDIST_SUBSETS_EQ; "SETDIST_SUBSET_LEFT",SETDIST_SUBSET_LEFT; "SETDIST_SUBSET_RIGHT",SETDIST_SUBSET_RIGHT; "SETDIST_SYM",SETDIST_SYM; "SETDIST_TRANSLATION",SETDIST_TRANSLATION; "SETDIST_TRIANGLE",SETDIST_TRIANGLE; "SETDIST_UNIFORMLY_CONTINUOUS_ON",SETDIST_UNIFORMLY_CONTINUOUS_ON; "SETDIST_UNIFORMLY_CONTINUOUS_ON_ALT",SETDIST_UNIFORMLY_CONTINUOUS_ON_ALT; "SETDIST_UNIQUE",SETDIST_UNIQUE; "SETDIST_UNIV",SETDIST_UNIV; "SETDIST_ZERO",SETDIST_ZERO; "SETDIST_ZERO_STRONG",SETDIST_ZERO_STRONG; "SETSPEC",SETSPEC; "SETVARIATION_EQUAL_LEMMA",SETVARIATION_EQUAL_LEMMA; "SET_CASES",SET_CASES; "SET_DIFF_FRONTIER",SET_DIFF_FRONTIER; "SET_OF_LIST_APPEND",SET_OF_LIST_APPEND; "SET_OF_LIST_EQ_EMPTY",SET_OF_LIST_EQ_EMPTY; "SET_OF_LIST_MAP",SET_OF_LIST_MAP; "SET_OF_LIST_OF_SET",SET_OF_LIST_OF_SET; "SET_PAIR_THM",SET_PAIR_THM; "SET_PROVE_CASES",SET_PROVE_CASES; "SET_RECURSION_LEMMA",SET_RECURSION_LEMMA; "SET_VARIATION",SET_VARIATION; "SET_VARIATION_0",SET_VARIATION_0; "SET_VARIATION_CMUL",SET_VARIATION_CMUL; "SET_VARIATION_COMPARISON",SET_VARIATION_COMPARISON; "SET_VARIATION_DEGENERATES",SET_VARIATION_DEGENERATES; "SET_VARIATION_ELEMENTARY_LEMMA",SET_VARIATION_ELEMENTARY_LEMMA; "SET_VARIATION_EQ",SET_VARIATION_EQ; "SET_VARIATION_GE_FUNCTION",SET_VARIATION_GE_FUNCTION; "SET_VARIATION_INTERVAL_LEMMA",SET_VARIATION_INTERVAL_LEMMA; "SET_VARIATION_LBOUND",SET_VARIATION_LBOUND; "SET_VARIATION_LBOUND_ON_INTERVAL",SET_VARIATION_LBOUND_ON_INTERVAL; "SET_VARIATION_MONOTONE",SET_VARIATION_MONOTONE; "SET_VARIATION_ON_DIVISION",SET_VARIATION_ON_DIVISION; "SET_VARIATION_ON_ELEMENTARY",SET_VARIATION_ON_ELEMENTARY; "SET_VARIATION_ON_EMPTY",SET_VARIATION_ON_EMPTY; "SET_VARIATION_ON_INTERVAL",SET_VARIATION_ON_INTERVAL; "SET_VARIATION_ON_NULL",SET_VARIATION_ON_NULL; "SET_VARIATION_POS_LE",SET_VARIATION_POS_LE; "SET_VARIATION_REFLECT2",SET_VARIATION_REFLECT2; "SET_VARIATION_SUM_LE",SET_VARIATION_SUM_LE; "SET_VARIATION_TRANSLATION2",SET_VARIATION_TRANSLATION2; "SET_VARIATION_TRIANGLE",SET_VARIATION_TRIANGLE; "SET_VARIATION_UBOUND",SET_VARIATION_UBOUND; "SET_VARIATION_UBOUND_ON_INTERVAL",SET_VARIATION_UBOUND_ON_INTERVAL; "SET_VARIATION_WORKS_ON_INTERVAL",SET_VARIATION_WORKS_ON_INTERVAL; "SGN_RE_COMPLEX_INV",SGN_RE_COMPLEX_INV; "SHIFTPATH_CIRCLEPATH",SHIFTPATH_CIRCLEPATH; "SHIFTPATH_LINEAR_IMAGE",SHIFTPATH_LINEAR_IMAGE; "SHIFTPATH_SHIFTPATH",SHIFTPATH_SHIFTPATH; "SHIFTPATH_TRANSLATION",SHIFTPATH_TRANSLATION; "SHIFTPATH_TRIVIAL",SHIFTPATH_TRIVIAL; "SHORTEST_ARC_EXISTS",SHORTEST_ARC_EXISTS; "SHORTEST_PATH_EXISTS",SHORTEST_PATH_EXISTS; "SHORTEST_PATH_EXISTS_GEN",SHORTEST_PATH_EXISTS_GEN; "SHORTEST_PATH_EXISTS_STRADDLE",SHORTEST_PATH_EXISTS_STRADDLE; "SIGMA_COMPACT",SIGMA_COMPACT; "SIGN_COMPOSE",SIGN_COMPOSE; "SIGN_I",SIGN_I; "SIGN_IDEMPOTENT",SIGN_IDEMPOTENT; "SIGN_INVERSE",SIGN_INVERSE; "SIGN_INVOLUTION",SIGN_INVOLUTION; "SIGN_NZ",SIGN_NZ; "SIGN_SWAP",SIGN_SWAP; "SILVERMAN_STEINHAUSLIKE",SILVERMAN_STEINHAUSLIKE; "SIMPLEX",SIMPLEX; "SIMPLEX_0_NOT_IN_AFFINE_HULL",SIMPLEX_0_NOT_IN_AFFINE_HULL; "SIMPLEX_ALT",SIMPLEX_ALT; "SIMPLEX_ALT1",SIMPLEX_ALT1; "SIMPLEX_CONVEX_HULL",SIMPLEX_CONVEX_HULL; "SIMPLEX_DIM_GE",SIMPLEX_DIM_GE; "SIMPLEX_EMPTY",SIMPLEX_EMPTY; "SIMPLEX_EXPLICIT",SIMPLEX_EXPLICIT; "SIMPLEX_EXTREMAL_LE",SIMPLEX_EXTREMAL_LE; "SIMPLEX_EXTREMAL_LE_EXISTS",SIMPLEX_EXTREMAL_LE_EXISTS; "SIMPLEX_EXTREME_POINTS",SIMPLEX_EXTREME_POINTS; "SIMPLEX_EXTREME_POINTS_NONEMPTY",SIMPLEX_EXTREME_POINTS_NONEMPTY; "SIMPLEX_FACE_OF_SIMPLEX",SIMPLEX_FACE_OF_SIMPLEX; "SIMPLEX_FURTHEST_LE",SIMPLEX_FURTHEST_LE; "SIMPLEX_FURTHEST_LE_EXISTS",SIMPLEX_FURTHEST_LE_EXISTS; "SIMPLEX_FURTHEST_LT",SIMPLEX_FURTHEST_LT; "SIMPLEX_IMP_CLOSED",SIMPLEX_IMP_CLOSED; "SIMPLEX_IMP_COMPACT",SIMPLEX_IMP_COMPACT; "SIMPLEX_IMP_CONVEX",SIMPLEX_IMP_CONVEX; "SIMPLEX_IMP_POLYHEDRON",SIMPLEX_IMP_POLYHEDRON; "SIMPLEX_IMP_POLYTOPE",SIMPLEX_IMP_POLYTOPE; "SIMPLEX_INSERT",SIMPLEX_INSERT; "SIMPLEX_INSERT_DIMPLUS1",SIMPLEX_INSERT_DIMPLUS1; "SIMPLEX_LINEAR_IMAGE_EQ",SIMPLEX_LINEAR_IMAGE_EQ; "SIMPLEX_MINUS_1",SIMPLEX_MINUS_1; "SIMPLEX_ORDERING_EXISTS",SIMPLEX_ORDERING_EXISTS; "SIMPLEX_SEGMENT",SIMPLEX_SEGMENT; "SIMPLEX_SEGMENT_CASES",SIMPLEX_SEGMENT_CASES; "SIMPLEX_SING",SIMPLEX_SING; "SIMPLEX_TRANSLATION_EQ",SIMPLEX_TRANSLATION_EQ; "SIMPLEX_VERTICES_UNIQUE",SIMPLEX_VERTICES_UNIQUE; "SIMPLEX_ZERO",SIMPLEX_ZERO; "SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE",SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE; "SIMPLE_CLOSED_PATH_NORM_WINDING_NUMBER_INSIDE",SIMPLE_CLOSED_PATH_NORM_WINDING_NUMBER_INSIDE; "SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES",SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES; "SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE",SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE; "SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS",SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS; "SIMPLE_IMAGE",SIMPLE_IMAGE; "SIMPLE_IMAGE_GEN",SIMPLE_IMAGE_GEN; "SIMPLE_PATH_ASSOC",SIMPLE_PATH_ASSOC; "SIMPLE_PATH_CASES",SIMPLE_PATH_CASES; "SIMPLE_PATH_CIRCLEPATH",SIMPLE_PATH_CIRCLEPATH; "SIMPLE_PATH_CONTINUOUS_IMAGE",SIMPLE_PATH_CONTINUOUS_IMAGE; "SIMPLE_PATH_ENDLESS",SIMPLE_PATH_ENDLESS; "SIMPLE_PATH_EQ_ARC",SIMPLE_PATH_EQ_ARC; "SIMPLE_PATH_IMP_ARC",SIMPLE_PATH_IMP_ARC; "SIMPLE_PATH_IMP_PATH",SIMPLE_PATH_IMP_PATH; "SIMPLE_PATH_JOIN_IMP",SIMPLE_PATH_JOIN_IMP; "SIMPLE_PATH_JOIN_LOOP",SIMPLE_PATH_JOIN_LOOP; "SIMPLE_PATH_JOIN_LOOP_EQ",SIMPLE_PATH_JOIN_LOOP_EQ; "SIMPLE_PATH_JOIN_LOOP_EQ_ALT",SIMPLE_PATH_JOIN_LOOP_EQ_ALT; "SIMPLE_PATH_LENGTH_MINIMAL",SIMPLE_PATH_LENGTH_MINIMAL; "SIMPLE_PATH_LENGTH_UNIQUE",SIMPLE_PATH_LENGTH_UNIQUE; "SIMPLE_PATH_LINEAR_IMAGE_EQ",SIMPLE_PATH_LINEAR_IMAGE_EQ; "SIMPLE_PATH_LINEPATH",SIMPLE_PATH_LINEPATH; "SIMPLE_PATH_LINEPATH_EQ",SIMPLE_PATH_LINEPATH_EQ; "SIMPLE_PATH_PARTCIRCLEPATH",SIMPLE_PATH_PARTCIRCLEPATH; "SIMPLE_PATH_REVERSEPATH",SIMPLE_PATH_REVERSEPATH; "SIMPLE_PATH_REVERSEPATH_EQ",SIMPLE_PATH_REVERSEPATH_EQ; "SIMPLE_PATH_SHIFTPATH",SIMPLE_PATH_SHIFTPATH; "SIMPLE_PATH_SUBPATH",SIMPLE_PATH_SUBPATH; "SIMPLE_PATH_SUBPATH_EQ",SIMPLE_PATH_SUBPATH_EQ; "SIMPLE_PATH_SYM",SIMPLE_PATH_SYM; "SIMPLE_PATH_TRANSLATION_EQ",SIMPLE_PATH_TRANSLATION_EQ; "SIMPLICIAL_COMPLEX_DISJOINT_RELATIVE_INTERIORS",SIMPLICIAL_COMPLEX_DISJOINT_RELATIVE_INTERIORS; "SIMPLICIAL_COMPLEX_IMP_TRIANGULATION",SIMPLICIAL_COMPLEX_IMP_TRIANGULATION; "SIMPLICIAL_COMPLEX_LINEAR_IMAGE",SIMPLICIAL_COMPLEX_LINEAR_IMAGE; "SIMPLICIAL_COMPLEX_TRANSLATION",SIMPLICIAL_COMPLEX_TRANSLATION; "SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX",SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX; "SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX_LOWDIM",SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX_LOWDIM; "SIMPLY_CONNECTED_COMPONENT_PATH_COMPLEMENT",SIMPLY_CONNECTED_COMPONENT_PATH_COMPLEMENT; "SIMPLY_CONNECTED_CONVEX_DIFF_FINITE",SIMPLY_CONNECTED_CONVEX_DIFF_FINITE; "SIMPLY_CONNECTED_EMPTY",SIMPLY_CONNECTED_EMPTY; "SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC",SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC; "SIMPLY_CONNECTED_EQ_BORSUKIAN",SIMPLY_CONNECTED_EQ_BORSUKIAN; "SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG",SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG; "SIMPLY_CONNECTED_EQ_CONTINUOUS_SQRT",SIMPLY_CONNECTED_EQ_CONTINUOUS_SQRT; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; "SIMPLY_CONNECTED_EQ_EMPTY_INSIDE",SIMPLY_CONNECTED_EQ_EMPTY_INSIDE; "SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES",SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES; "SIMPLY_CONNECTED_EQ_GLOBAL_PRIMITIVE",SIMPLY_CONNECTED_EQ_GLOBAL_PRIMITIVE; "SIMPLY_CONNECTED_EQ_HOLOMORPHIC_LOG",SIMPLY_CONNECTED_EQ_HOLOMORPHIC_LOG; "SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT",SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT; "SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC",SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC; "SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS",SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS; "SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS",SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS; "SIMPLY_CONNECTED_EQ_INJECTIVE_HOLOMORPHIC_SQRT",SIMPLY_CONNECTED_EQ_INJECTIVE_HOLOMORPHIC_SQRT; "SIMPLY_CONNECTED_EQ_PATH_INTEGRAL_ZERO",SIMPLY_CONNECTED_EQ_PATH_INTEGRAL_ZERO; "SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS",SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS; "SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO",SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO; "SIMPLY_CONNECTED_FUNDAMENTAL_GROUP",SIMPLY_CONNECTED_FUNDAMENTAL_GROUP; "SIMPLY_CONNECTED_IFF_SIMPLE",SIMPLY_CONNECTED_IFF_SIMPLE; "SIMPLY_CONNECTED_IMP_BORSUKIAN",SIMPLY_CONNECTED_IMP_BORSUKIAN; "SIMPLY_CONNECTED_IMP_CONNECTED",SIMPLY_CONNECTED_IMP_CONNECTED; "SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG",SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG; "SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT",SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT; "SIMPLY_CONNECTED_IMP_PATH_CONNECTED",SIMPLY_CONNECTED_IMP_PATH_CONNECTED; "SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO",SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO; "SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE",SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE; "SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH",SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH; "SIMPLY_CONNECTED_INTER",SIMPLY_CONNECTED_INTER; "SIMPLY_CONNECTED_NESTED_UNIONS",SIMPLY_CONNECTED_NESTED_UNIONS; "SIMPLY_CONNECTED_PCROSS",SIMPLY_CONNECTED_PCROSS; "SIMPLY_CONNECTED_PCROSS_EQ",SIMPLY_CONNECTED_PCROSS_EQ; "SIMPLY_CONNECTED_PUNCTURED_CONVEX",SIMPLY_CONNECTED_PUNCTURED_CONVEX; "SIMPLY_CONNECTED_PUNCTURED_UNIVERSE",SIMPLY_CONNECTED_PUNCTURED_UNIVERSE; "SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ",SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ; "SIMPLY_CONNECTED_RETRACTION_GEN",SIMPLY_CONNECTED_RETRACTION_GEN; "SIMPLY_CONNECTED_SING",SIMPLY_CONNECTED_SING; "SIMPLY_CONNECTED_SPHERE",SIMPLY_CONNECTED_SPHERE; "SIMPLY_CONNECTED_SPHERE_EQ",SIMPLY_CONNECTED_SPHERE_EQ; "SIMPLY_CONNECTED_SPHERE_GEN",SIMPLY_CONNECTED_SPHERE_GEN; "SIMPLY_CONNECTED_TRANSLATION",SIMPLY_CONNECTED_TRANSLATION; "SIMPLY_CONNECTED_UNION",SIMPLY_CONNECTED_UNION; "SINCOS_PRINCIPAL_VALUE",SINCOS_PRINCIPAL_VALUE; "SINCOS_TOTAL_2PI",SINCOS_TOTAL_2PI; "SINCOS_TOTAL_PI",SINCOS_TOTAL_PI; "SINCOS_TOTAL_PI2",SINCOS_TOTAL_PI2; "SING",SING; "SING_GSPEC",SING_GSPEC; "SING_STRONG_DEFORMATION_RETRACT_OF_AR",SING_STRONG_DEFORMATION_RETRACT_OF_AR; "SING_SUBSET",SING_SUBSET; "SIN_0",SIN_0; "SIN_ACS",SIN_ACS; "SIN_ACS_NZ",SIN_ACS_NZ; "SIN_ADD",SIN_ADD; "SIN_ASN",SIN_ASN; "SIN_ATN",SIN_ATN; "SIN_BOUND",SIN_BOUND; "SIN_BOUNDS",SIN_BOUNDS; "SIN_CIRCLE",SIN_CIRCLE; "SIN_COS",SIN_COS; "SIN_COS_EQ",SIN_COS_EQ; "SIN_COS_INJ",SIN_COS_INJ; "SIN_COS_SQRT",SIN_COS_SQRT; "SIN_DOUBLE",SIN_DOUBLE; "SIN_EQ",SIN_EQ; "SIN_EQ_0",SIN_EQ_0; "SIN_EQ_0_PI",SIN_EQ_0_PI; "SIN_EQ_1",SIN_EQ_1; "SIN_EQ_MINUS1",SIN_EQ_MINUS1; "SIN_HASZERO",SIN_HASZERO; "SIN_HASZERO_MINIMAL",SIN_HASZERO_MINIMAL; "SIN_INJ_PI",SIN_INJ_PI; "SIN_INTEGER_2PI",SIN_INTEGER_2PI; "SIN_INTEGER_PI",SIN_INTEGER_PI; "SIN_MONO_LE",SIN_MONO_LE; "SIN_MONO_LE_EQ",SIN_MONO_LE_EQ; "SIN_MONO_LT",SIN_MONO_LT; "SIN_MONO_LT_EQ",SIN_MONO_LT_EQ; "SIN_NEARZERO",SIN_NEARZERO; "SIN_NEG",SIN_NEG; "SIN_NONTRIVIAL",SIN_NONTRIVIAL; "SIN_NPI",SIN_NPI; "SIN_PERIODIC",SIN_PERIODIC; "SIN_PERIODIC_PI",SIN_PERIODIC_PI; "SIN_PI",SIN_PI; "SIN_PI2",SIN_PI2; "SIN_PI3",SIN_PI3; "SIN_PI6",SIN_PI6; "SIN_PI6_STRADDLE",SIN_PI6_STRADDLE; "SIN_PIMUL_EQ_0",SIN_PIMUL_EQ_0; "SIN_POS_PI",SIN_POS_PI; "SIN_POS_PI2",SIN_POS_PI2; "SIN_POS_PI_LE",SIN_POS_PI_LE; "SIN_POS_PI_REV",SIN_POS_PI_REV; "SIN_SUB",SIN_SUB; "SIN_TAN",SIN_TAN; "SIN_TOTAL_POS",SIN_TOTAL_POS; "SIN_ZERO",SIN_ZERO; "SIN_ZERO_PI",SIN_ZERO_PI; "SKOLEM_THM",SKOLEM_THM; "SKOLEM_THM_GEN",SKOLEM_THM_GEN; "SLICE_BALL",SLICE_BALL; "SLICE_CBALL",SLICE_CBALL; "SLICE_DIFF",SLICE_DIFF; "SLICE_EMPTY",SLICE_EMPTY; "SLICE_INTER",SLICE_INTER; "SLICE_INTERVAL",SLICE_INTERVAL; "SLICE_SUBSET",SLICE_SUBSET; "SLICE_UNION",SLICE_UNION; "SLICE_UNIONS",SLICE_UNIONS; "SLICE_UNIV",SLICE_UNIV; "SMALL_IMP_DIMENSION_LE_0",SMALL_IMP_DIMENSION_LE_0; "SMALL_IMP_TOTALLY_DISCONNECTED",SMALL_IMP_TOTALLY_DISCONNECTED; "SMALL_INDUCTIVE_DIMENSION",SMALL_INDUCTIVE_DIMENSION; "SND",SND; "SNDCART_ADD",SNDCART_ADD; "SNDCART_CMUL",SNDCART_CMUL; "SNDCART_NEG",SNDCART_NEG; "SNDCART_PASTECART",SNDCART_PASTECART; "SNDCART_SUB",SNDCART_SUB; "SNDCART_VEC",SNDCART_VEC; "SNDCART_VSUM",SNDCART_VSUM; "SND_DEF",SND_DEF; "SPANNING_SUBSET_INDEPENDENT",SPANNING_SUBSET_INDEPENDENT; "SPANNING_SURJECTIVE_IMAGE",SPANNING_SURJECTIVE_IMAGE; "SPANS_IMAGE",SPANS_IMAGE; "SPAN_0",SPAN_0; "SPAN_2",SPAN_2; "SPAN_3",SPAN_3; "SPAN_ADD",SPAN_ADD; "SPAN_ADD_EQ",SPAN_ADD_EQ; "SPAN_AFFINE_HULL_INSERT",SPAN_AFFINE_HULL_INSERT; "SPAN_BREAKDOWN",SPAN_BREAKDOWN; "SPAN_BREAKDOWN_EQ",SPAN_BREAKDOWN_EQ; "SPAN_CARD_GE_DIM",SPAN_CARD_GE_DIM; "SPAN_CLAUSES",SPAN_CLAUSES; "SPAN_COLUMNSPACE",SPAN_COLUMNSPACE; "SPAN_CONIC_HULL",SPAN_CONIC_HULL; "SPAN_CONVEX_CONE_ALLSIGNS",SPAN_CONVEX_CONE_ALLSIGNS; "SPAN_CONVEX_HULL",SPAN_CONVEX_HULL; "SPAN_DELETE_0",SPAN_DELETE_0; "SPAN_EMPTY",SPAN_EMPTY; "SPAN_EQ",SPAN_EQ; "SPAN_EQ_DIM",SPAN_EQ_DIM; "SPAN_EQ_INSERT",SPAN_EQ_INSERT; "SPAN_EQ_SELF",SPAN_EQ_SELF; "SPAN_EXPLICIT",SPAN_EXPLICIT; "SPAN_FINITE",SPAN_FINITE; "SPAN_IMAGE_SCALE",SPAN_IMAGE_SCALE; "SPAN_INC",SPAN_INC; "SPAN_INDUCT",SPAN_INDUCT; "SPAN_INDUCT_ALT",SPAN_INDUCT_ALT; "SPAN_INSERT_0",SPAN_INSERT_0; "SPAN_LINEAR_IMAGE",SPAN_LINEAR_IMAGE; "SPAN_MBASIS",SPAN_MBASIS; "SPAN_MONO",SPAN_MONO; "SPAN_MUL",SPAN_MUL; "SPAN_MUL_EQ",SPAN_MUL_EQ; "SPAN_NEG",SPAN_NEG; "SPAN_NEG_EQ",SPAN_NEG_EQ; "SPAN_NOT_UNIV_ORTHOGONAL",SPAN_NOT_UNIV_ORTHOGONAL; "SPAN_NOT_UNIV_SUBSET_HYPERPLANE",SPAN_NOT_UNIV_SUBSET_HYPERPLANE; "SPAN_OF_SUBSPACE",SPAN_OF_SUBSPACE; "SPAN_OPEN",SPAN_OPEN; "SPAN_PCROSS",SPAN_PCROSS; "SPAN_PCROSS_SUBSET",SPAN_PCROSS_SUBSET; "SPAN_SING",SPAN_SING; "SPAN_SPAN",SPAN_SPAN; "SPAN_SPECIAL_SCALE",SPAN_SPECIAL_SCALE; "SPAN_STDBASIS",SPAN_STDBASIS; "SPAN_SUB",SPAN_SUB; "SPAN_SUBSET_SUBSPACE",SPAN_SUBSET_SUBSPACE; "SPAN_SUBSPACE",SPAN_SUBSPACE; "SPAN_SUMS",SPAN_SUMS; "SPAN_SUPERSET",SPAN_SUPERSET; "SPAN_TRANS",SPAN_TRANS; "SPAN_UNION",SPAN_UNION; "SPAN_UNION_SUBSET",SPAN_UNION_SUBSET; "SPAN_UNIV",SPAN_UNIV; "SPAN_VSUM",SPAN_VSUM; "SPECIAL_HYPERPLANE_SPAN",SPECIAL_HYPERPLANE_SPAN; "SPHERE_1",SPHERE_1; "SPHERE_EMPTY",SPHERE_EMPTY; "SPHERE_EQ_EMPTY",SPHERE_EQ_EMPTY; "SPHERE_EQ_SING",SPHERE_EQ_SING; "SPHERE_LINEAR_IMAGE",SPHERE_LINEAR_IMAGE; "SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE; "SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN; "SPHERE_SCALING",SPHERE_SCALING; "SPHERE_SING",SPHERE_SING; "SPHERE_SUBSET_CBALL",SPHERE_SUBSET_CBALL; "SPHERE_SUBSET_CONVEX",SPHERE_SUBSET_CONVEX; "SPHERE_TRANSLATION",SPHERE_TRANSLATION; "SPHERE_UNION_BALL",SPHERE_UNION_BALL; "SPLIT_INSIDE_SIMPLE_CLOSED_CURVE",SPLIT_INSIDE_SIMPLE_CLOSED_CURVE; "SQNORM_PASTECART",SQNORM_PASTECART; "SQRT_0",SQRT_0; "SQRT_1",SQRT_1; "SQRT_DIV",SQRT_DIV; "SQRT_EQ_0",SQRT_EQ_0; "SQRT_EVEN_POW2",SQRT_EVEN_POW2; "SQRT_INJ",SQRT_INJ; "SQRT_INV",SQRT_INV; "SQRT_LE_0",SQRT_LE_0; "SQRT_LT_0",SQRT_LT_0; "SQRT_MONO_LE",SQRT_MONO_LE; "SQRT_MONO_LE_EQ",SQRT_MONO_LE_EQ; "SQRT_MONO_LT",SQRT_MONO_LT; "SQRT_MONO_LT_EQ",SQRT_MONO_LT_EQ; "SQRT_MUL",SQRT_MUL; "SQRT_NEG",SQRT_NEG; "SQRT_POS_LE",SQRT_POS_LE; "SQRT_POS_LT",SQRT_POS_LT; "SQRT_POW2",SQRT_POW2; "SQRT_POW_2",SQRT_POW_2; "SQRT_PRODUCT",SQRT_PRODUCT; "SQRT_UNIQUE",SQRT_UNIQUE; "SQRT_UNIQUE_GEN",SQRT_UNIQUE_GEN; "SQRT_WORKS",SQRT_WORKS; "SQRT_WORKS_GEN",SQRT_WORKS_GEN; "SQUARE_BOUND_LEMMA",SQUARE_BOUND_LEMMA; "SQUARE_CONTINUOUS",SQUARE_CONTINUOUS; "SQUARE_INTEGRAL_SQUARE_INTEGRABLE_PRODUCT_LE",SQUARE_INTEGRAL_SQUARE_INTEGRABLE_PRODUCT_LE; "STARLIKE_CLOSURE",STARLIKE_CLOSURE; "STARLIKE_COMPACT_PROJECTIVE",STARLIKE_COMPACT_PROJECTIVE; "STARLIKE_CONVEX_SUBSET",STARLIKE_CONVEX_SUBSET; "STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS",STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS; "STARLIKE_IMP_BORSUKIAN",STARLIKE_IMP_BORSUKIAN; "STARLIKE_IMP_CONNECTED",STARLIKE_IMP_CONNECTED; "STARLIKE_IMP_CONTRACTIBLE",STARLIKE_IMP_CONTRACTIBLE; "STARLIKE_IMP_CONTRACTIBLE_GEN",STARLIKE_IMP_CONTRACTIBLE_GEN; "STARLIKE_IMP_PATH_CONNECTED",STARLIKE_IMP_PATH_CONNECTED; "STARLIKE_IMP_SIMPLY_CONNECTED",STARLIKE_IMP_SIMPLY_CONNECTED; "STARLIKE_LINEAR_IMAGE",STARLIKE_LINEAR_IMAGE; "STARLIKE_LINEAR_IMAGE_EQ",STARLIKE_LINEAR_IMAGE_EQ; "STARLIKE_NEGLIGIBLE",STARLIKE_NEGLIGIBLE; "STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE",STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE; "STARLIKE_NEGLIGIBLE_LEMMA",STARLIKE_NEGLIGIBLE_LEMMA; "STARLIKE_NEGLIGIBLE_STRONG",STARLIKE_NEGLIGIBLE_STRONG; "STARLIKE_PCROSS",STARLIKE_PCROSS; "STARLIKE_PCROSS_EQ",STARLIKE_PCROSS_EQ; "STARLIKE_TRANSLATION_EQ",STARLIKE_TRANSLATION_EQ; "STARLIKE_UNIV",STARLIKE_UNIV; "STD_SIMPLEX",STD_SIMPLEX; "STEINHAUS",STEINHAUS; "STEINHAUS_DIFFS",STEINHAUS_DIFFS; "STEINHAUS_LEBESGUE",STEINHAUS_LEBESGUE; "STEINHAUS_SUMS",STEINHAUS_SUMS; "STEINHAUS_TRIVIAL",STEINHAUS_TRIVIAL; "STEPANOV",STEPANOV; "STEPANOV_GEN",STEPANOV_GEN; "STEPANOV_UNIV",STEPANOV_UNIV; "STONE_WEIERSTRASS",STONE_WEIERSTRASS; "STONE_WEIERSTRASS_ALT",STONE_WEIERSTRASS_ALT; "STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION",STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION; "STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION",STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION; "STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_AFFINE",STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_AFFINE; "STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE",STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE; "STRETCH_GALOIS",STRETCH_GALOIS; "STRONG_DEFORMATION_RETRACT_OF_AR",STRONG_DEFORMATION_RETRACT_OF_AR; "SUB",SUB; "SUBADDITIVE_CONTENT_DIVISION",SUBADDITIVE_CONTENT_DIVISION; "SUBINTERVAL_MEAN_VALUE_THEOREM",SUBINTERVAL_MEAN_VALUE_THEOREM; "SUBINTERVAL_MEAN_VALUE_THEOREM_ALT",SUBINTERVAL_MEAN_VALUE_THEOREM_ALT; "SUBINTERVAL_MEAN_VALUE_THEOREM_SEQ",SUBINTERVAL_MEAN_VALUE_THEOREM_SEQ; "SUBMETRIC",SUBMETRIC; "SUBMETRIC_UNIV",SUBMETRIC_UNIV; "SUBORDINATE_PARTITION_OF_UNITY",SUBORDINATE_PARTITION_OF_UNITY; "SUBPATH_LINEAR_IMAGE",SUBPATH_LINEAR_IMAGE; "SUBPATH_REFL",SUBPATH_REFL; "SUBPATH_REVERSEPATH",SUBPATH_REVERSEPATH; "SUBPATH_SCALING_LEMMA",SUBPATH_SCALING_LEMMA; "SUBPATH_TO_FRONTIER",SUBPATH_TO_FRONTIER; "SUBPATH_TO_FRONTIER_EXPLICIT",SUBPATH_TO_FRONTIER_EXPLICIT; "SUBPATH_TO_FRONTIER_STRONG",SUBPATH_TO_FRONTIER_STRONG; "SUBPATH_TRANSLATION",SUBPATH_TRANSLATION; "SUBPATH_TRIVIAL",SUBPATH_TRIVIAL; "SUBSEQUENCE_DIAGONALIZATION_LEMMA",SUBSEQUENCE_DIAGONALIZATION_LEMMA; "SUBSEQUENCE_IMP_INJECTIVE",SUBSEQUENCE_IMP_INJECTIVE; "SUBSET",SUBSET; "SUBSET_ANTISYM",SUBSET_ANTISYM; "SUBSET_ANTISYM_EQ",SUBSET_ANTISYM_EQ; "SUBSET_BALL",SUBSET_BALL; "SUBSET_BALLS",SUBSET_BALLS; "SUBSET_CARD_EQ",SUBSET_CARD_EQ; "SUBSET_CBALL",SUBSET_CBALL; "SUBSET_CLOSURE",SUBSET_CLOSURE; "SUBSET_COMPACT_HAUSDIST_LIMIT",SUBSET_COMPACT_HAUSDIST_LIMIT; "SUBSET_CONTINUOUS_IMAGE_SEGMENT_1",SUBSET_CONTINUOUS_IMAGE_SEGMENT_1; "SUBSET_CONVEX_HULL_FRONTIER",SUBSET_CONVEX_HULL_FRONTIER; "SUBSET_CONVEX_HULL_RELATIVE_FRONTIER",SUBSET_CONVEX_HULL_RELATIVE_FRONTIER; "SUBSET_CROSS",SUBSET_CROSS; "SUBSET_DELETE",SUBSET_DELETE; "SUBSET_DIFF",SUBSET_DIFF; "SUBSET_DROP_IMAGE",SUBSET_DROP_IMAGE; "SUBSET_EMPTY",SUBSET_EMPTY; "SUBSET_FACE_OF_SIMPLEX",SUBSET_FACE_OF_SIMPLEX; "SUBSET_HALFSPACES_IMP_COLLINEAR",SUBSET_HALFSPACES_IMP_COLLINEAR; "SUBSET_HULL",SUBSET_HULL; "SUBSET_HYPERPLANES",SUBSET_HYPERPLANES; "SUBSET_IMAGE",SUBSET_IMAGE; "SUBSET_IMAGE_INJ",SUBSET_IMAGE_INJ; "SUBSET_INSERT",SUBSET_INSERT; "SUBSET_INSERT_DELETE",SUBSET_INSERT_DELETE; "SUBSET_INTER",SUBSET_INTER; "SUBSET_INTERIOR",SUBSET_INTERIOR; "SUBSET_INTERIOR_EQ",SUBSET_INTERIOR_EQ; "SUBSET_INTERIOR_OF_EQ",SUBSET_INTERIOR_OF_EQ; "SUBSET_INTERS",SUBSET_INTERS; "SUBSET_INTERVAL",SUBSET_INTERVAL; "SUBSET_INTERVAL_1",SUBSET_INTERVAL_1; "SUBSET_INTERVAL_IMP",SUBSET_INTERVAL_IMP; "SUBSET_INTER_ABSORPTION",SUBSET_INTER_ABSORPTION; "SUBSET_LE_DIM",SUBSET_LE_DIM; "SUBSET_LIFT_IMAGE",SUBSET_LIFT_IMAGE; "SUBSET_NUMSEG",SUBSET_NUMSEG; "SUBSET_OF_FACE_OF",SUBSET_OF_FACE_OF; "SUBSET_OF_FACE_OF_AFFINE_HULL",SUBSET_OF_FACE_OF_AFFINE_HULL; "SUBSET_PATH_IMAGE_JOIN",SUBSET_PATH_IMAGE_JOIN; "SUBSET_PCROSS",SUBSET_PCROSS; "SUBSET_PRED",SUBSET_PRED; "SUBSET_PSUBSET_TRANS",SUBSET_PSUBSET_TRANS; "SUBSET_REAL_INTERVAL",SUBSET_REAL_INTERVAL; "SUBSET_REFL",SUBSET_REFL; "SUBSET_RELATIVE_INTERIOR",SUBSET_RELATIVE_INTERIOR; "SUBSET_RELATIVE_INTERIOR_INTERSECTING_CONVEX",SUBSET_RELATIVE_INTERIOR_INTERSECTING_CONVEX; "SUBSET_RESTRICT",SUBSET_RESTRICT; "SUBSET_SECOND_COUNTABLE",SUBSET_SECOND_COUNTABLE; "SUBSET_SEGMENT",SUBSET_SEGMENT; "SUBSET_SEGMENT_OPEN_CLOSED",SUBSET_SEGMENT_OPEN_CLOSED; "SUBSET_SUMS_LCANCEL",SUBSET_SUMS_LCANCEL; "SUBSET_SUMS_RCANCEL",SUBSET_SUMS_RCANCEL; "SUBSET_TRANS",SUBSET_TRANS; "SUBSET_UNION",SUBSET_UNION; "SUBSET_UNIONS",SUBSET_UNIONS; "SUBSET_UNION_ABSORPTION",SUBSET_UNION_ABSORPTION; "SUBSET_UNIV",SUBSET_UNIV; "SUBSPACE_0",SUBSPACE_0; "SUBSPACE_ADD",SUBSPACE_ADD; "SUBSPACE_BOUNDED_EQ_TRIVIAL",SUBSPACE_BOUNDED_EQ_TRIVIAL; "SUBSPACE_CONVEX_CONE_SYMMETRIC",SUBSPACE_CONVEX_CONE_SYMMETRIC; "SUBSPACE_EQ_AFFINE",SUBSPACE_EQ_AFFINE; "SUBSPACE_EXISTS",SUBSPACE_EXISTS; "SUBSPACE_HYPERPLANE",SUBSPACE_HYPERPLANE; "SUBSPACE_IMP_AFFINE",SUBSPACE_IMP_AFFINE; "SUBSPACE_IMP_CONIC",SUBSPACE_IMP_CONIC; "SUBSPACE_IMP_CONVEX",SUBSPACE_IMP_CONVEX; "SUBSPACE_IMP_CONVEX_CONE",SUBSPACE_IMP_CONVEX_CONE; "SUBSPACE_IMP_NONEMPTY",SUBSPACE_IMP_NONEMPTY; "SUBSPACE_INTER",SUBSPACE_INTER; "SUBSPACE_INTERS",SUBSPACE_INTERS; "SUBSPACE_ISOMORPHISM",SUBSPACE_ISOMORPHISM; "SUBSPACE_KERNEL",SUBSPACE_KERNEL; "SUBSPACE_LINEAR_FIXED_POINTS",SUBSPACE_LINEAR_FIXED_POINTS; "SUBSPACE_LINEAR_IMAGE",SUBSPACE_LINEAR_IMAGE; "SUBSPACE_LINEAR_IMAGE_EQ",SUBSPACE_LINEAR_IMAGE_EQ; "SUBSPACE_LINEAR_PREIMAGE",SUBSPACE_LINEAR_PREIMAGE; "SUBSPACE_MUL",SUBSPACE_MUL; "SUBSPACE_NEG",SUBSPACE_NEG; "SUBSPACE_ORTHOGONAL_TO_VECTOR",SUBSPACE_ORTHOGONAL_TO_VECTOR; "SUBSPACE_ORTHOGONAL_TO_VECTORS",SUBSPACE_ORTHOGONAL_TO_VECTORS; "SUBSPACE_PCROSS",SUBSPACE_PCROSS; "SUBSPACE_PCROSS_EQ",SUBSPACE_PCROSS_EQ; "SUBSPACE_REAL",SUBSPACE_REAL; "SUBSPACE_SPAN",SUBSPACE_SPAN; "SUBSPACE_SPECIAL_HYPERPLANE",SUBSPACE_SPECIAL_HYPERPLANE; "SUBSPACE_SUB",SUBSPACE_SUB; "SUBSPACE_SUBSTANDARD",SUBSPACE_SUBSTANDARD; "SUBSPACE_SUMS",SUBSPACE_SUMS; "SUBSPACE_TRANSLATION_SELF",SUBSPACE_TRANSLATION_SELF; "SUBSPACE_TRANSLATION_SELF_EQ",SUBSPACE_TRANSLATION_SELF_EQ; "SUBSPACE_TRIVIAL",SUBSPACE_TRIVIAL; "SUBSPACE_UNION_CHAIN",SUBSPACE_UNION_CHAIN; "SUBSPACE_UNIV",SUBSPACE_UNIV; "SUBSPACE_VSUM",SUBSPACE_VSUM; "SUBTOPOLOGY_SUBTOPOLOGY",SUBTOPOLOGY_SUBTOPOLOGY; "SUBTOPOLOGY_SUPERSET",SUBTOPOLOGY_SUPERSET; "SUBTOPOLOGY_TOPSPACE",SUBTOPOLOGY_TOPSPACE; "SUBTOPOLOGY_UNIV",SUBTOPOLOGY_UNIV; "SUBWOSET_ISO_INSEG",SUBWOSET_ISO_INSEG; "SUB_0",SUB_0; "SUB_ADD",SUB_ADD; "SUB_ADD_LCANCEL",SUB_ADD_LCANCEL; "SUB_ADD_RCANCEL",SUB_ADD_RCANCEL; "SUB_ELIM_THM",SUB_ELIM_THM; "SUB_ELIM_THM'",SUB_ELIM_THM'; "SUB_EQ_0",SUB_EQ_0; "SUB_PRESUC",SUB_PRESUC; "SUB_REFL",SUB_REFL; "SUB_SUC",SUB_SUC; "SUC_DEF",SUC_DEF; "SUC_INJ",SUC_INJ; "SUC_SUB1",SUC_SUB1; "SUMMABLE_0",SUMMABLE_0; "SUMMABLE_ADD",SUMMABLE_ADD; "SUMMABLE_BILINEAR_LEFT",SUMMABLE_BILINEAR_LEFT; "SUMMABLE_BILINEAR_PARTIAL_PRE",SUMMABLE_BILINEAR_PARTIAL_PRE; "SUMMABLE_BILINEAR_RIGHT",SUMMABLE_BILINEAR_RIGHT; "SUMMABLE_CAUCHY",SUMMABLE_CAUCHY; "SUMMABLE_CMUL",SUMMABLE_CMUL; "SUMMABLE_COMPARISON",SUMMABLE_COMPARISON; "SUMMABLE_COMPLEX_DIV",SUMMABLE_COMPLEX_DIV; "SUMMABLE_COMPLEX_LMUL",SUMMABLE_COMPLEX_LMUL; "SUMMABLE_COMPLEX_MUL_LEFT",SUMMABLE_COMPLEX_MUL_LEFT; "SUMMABLE_COMPLEX_MUL_RIGHT",SUMMABLE_COMPLEX_MUL_RIGHT; "SUMMABLE_COMPLEX_RMUL",SUMMABLE_COMPLEX_RMUL; "SUMMABLE_COMPONENT",SUMMABLE_COMPONENT; "SUMMABLE_EQ",SUMMABLE_EQ; "SUMMABLE_EQ_COFINITE",SUMMABLE_EQ_COFINITE; "SUMMABLE_EQ_EVENTUALLY",SUMMABLE_EQ_EVENTUALLY; "SUMMABLE_EVEN",SUMMABLE_EVEN; "SUMMABLE_FROM_ELSEWHERE",SUMMABLE_FROM_ELSEWHERE; "SUMMABLE_FROM_ELSEWHERE_EQ",SUMMABLE_FROM_ELSEWHERE_EQ; "SUMMABLE_GP",SUMMABLE_GP; "SUMMABLE_IFF",SUMMABLE_IFF; "SUMMABLE_IFF_COFINITE",SUMMABLE_IFF_COFINITE; "SUMMABLE_IFF_EVENTUALLY",SUMMABLE_IFF_EVENTUALLY; "SUMMABLE_IMP_BOUNDED",SUMMABLE_IMP_BOUNDED; "SUMMABLE_IMP_SUMS_BOUNDED",SUMMABLE_IMP_SUMS_BOUNDED; "SUMMABLE_IMP_TOZERO",SUMMABLE_IMP_TOZERO; "SUMMABLE_LINEAR",SUMMABLE_LINEAR; "SUMMABLE_NEG",SUMMABLE_NEG; "SUMMABLE_ODD",SUMMABLE_ODD; "SUMMABLE_RATIO",SUMMABLE_RATIO; "SUMMABLE_REAL_GP",SUMMABLE_REAL_GP; "SUMMABLE_REARRANGE",SUMMABLE_REARRANGE; "SUMMABLE_REINDEX",SUMMABLE_REINDEX; "SUMMABLE_RESTRICT",SUMMABLE_RESTRICT; "SUMMABLE_SUB",SUMMABLE_SUB; "SUMMABLE_SUBSET",SUMMABLE_SUBSET; "SUMMABLE_SUBSET_ABSCONV",SUMMABLE_SUBSET_ABSCONV; "SUMMABLE_SUBSET_COMPLEX",SUMMABLE_SUBSET_COMPLEX; "SUMMABLE_TRIVIAL",SUMMABLE_TRIVIAL; "SUMMABLE_ZETA",SUMMABLE_ZETA; "SUMMABLE_ZETA_INTEGER",SUMMABLE_ZETA_INTEGER; "SUMS_0",SUMS_0; "SUMS_ASSOC",SUMS_ASSOC; "SUMS_CNJ",SUMS_CNJ; "SUMS_COMPLEX_0",SUMS_COMPLEX_0; "SUMS_EQ",SUMS_EQ; "SUMS_FINITE_DIFF",SUMS_FINITE_DIFF; "SUMS_FINITE_UNION",SUMS_FINITE_UNION; "SUMS_GP",SUMS_GP; "SUMS_IFF",SUMS_IFF; "SUMS_INFSUM",SUMS_INFSUM; "SUMS_INTERVALS",SUMS_INTERVALS; "SUMS_LIM",SUMS_LIM; "SUMS_OFFSET",SUMS_OFFSET; "SUMS_OFFSET_REV",SUMS_OFFSET_REV; "SUMS_REINDEX",SUMS_REINDEX; "SUMS_REINDEX_GEN",SUMS_REINDEX_GEN; "SUMS_SUMMABLE",SUMS_SUMMABLE; "SUMS_SYM",SUMS_SYM; "SUM_0",SUM_0; "SUM_1",SUM_1; "SUM_2",SUM_2; "SUM_3",SUM_3; "SUM_4",SUM_4; "SUM_ABS",SUM_ABS; "SUM_ABS_BOUND",SUM_ABS_BOUND; "SUM_ABS_LE",SUM_ABS_LE; "SUM_ABS_NUMSEG",SUM_ABS_NUMSEG; "SUM_ADD",SUM_ADD; "SUM_ADD_GEN",SUM_ADD_GEN; "SUM_ADD_NUMSEG",SUM_ADD_NUMSEG; "SUM_ADD_SPLIT",SUM_ADD_SPLIT; "SUM_BERNSTEIN",SUM_BERNSTEIN; "SUM_BIJECTION",SUM_BIJECTION; "SUM_BOUND",SUM_BOUND; "SUM_BOUND_GEN",SUM_BOUND_GEN; "SUM_BOUND_LT",SUM_BOUND_LT; "SUM_BOUND_LT_ALL",SUM_BOUND_LT_ALL; "SUM_BOUND_LT_GEN",SUM_BOUND_LT_GEN; "SUM_CASES",SUM_CASES; "SUM_CASES_1",SUM_CASES_1; "SUM_CLAUSES",SUM_CLAUSES; "SUM_CLAUSES_LEFT",SUM_CLAUSES_LEFT; "SUM_CLAUSES_NUMSEG",SUM_CLAUSES_NUMSEG; "SUM_CLAUSES_RIGHT",SUM_CLAUSES_RIGHT; "SUM_CLOSED",SUM_CLOSED; "SUM_COMBINE_L",SUM_COMBINE_L; "SUM_COMBINE_R",SUM_COMBINE_R; "SUM_CONST",SUM_CONST; "SUM_CONST_NUMSEG",SUM_CONST_NUMSEG; "SUM_CONTENT_AREA_OVER_THIN_DIVISION",SUM_CONTENT_AREA_OVER_THIN_DIVISION; "SUM_DEGENERATE",SUM_DEGENERATE; "SUM_DELETE",SUM_DELETE; "SUM_DELETE_CASES",SUM_DELETE_CASES; "SUM_DELTA",SUM_DELTA; "SUM_DIFF",SUM_DIFF; "SUM_DIFFS",SUM_DIFFS; "SUM_DIFFS_ALT",SUM_DIFFS_ALT; "SUM_EQ",SUM_EQ; "SUM_EQ_0",SUM_EQ_0; "SUM_EQ_0_NUMSEG",SUM_EQ_0_NUMSEG; "SUM_EQ_GENERAL",SUM_EQ_GENERAL; "SUM_EQ_GENERAL_INVERSES",SUM_EQ_GENERAL_INVERSES; "SUM_EQ_NUMSEG",SUM_EQ_NUMSEG; "SUM_EQ_SUPERSET",SUM_EQ_SUPERSET; "SUM_GP",SUM_GP; "SUM_GP_BASIC",SUM_GP_BASIC; "SUM_GP_MULTIPLIED",SUM_GP_MULTIPLIED; "SUM_GP_OFFSET",SUM_GP_OFFSET; "SUM_GROUP",SUM_GROUP; "SUM_GROUP_RELATION",SUM_GROUP_RELATION; "SUM_IMAGE",SUM_IMAGE; "SUM_IMAGE_GEN",SUM_IMAGE_GEN; "SUM_IMAGE_LE",SUM_IMAGE_LE; "SUM_IMAGE_NONZERO",SUM_IMAGE_NONZERO; "SUM_INCL_EXCL",SUM_INCL_EXCL; "SUM_INJECTION",SUM_INJECTION; "SUM_INTEGRAL_BOUNDS_DECREASING",SUM_INTEGRAL_BOUNDS_DECREASING; "SUM_INTEGRAL_BOUNDS_INCREASING",SUM_INTEGRAL_BOUNDS_INCREASING; "SUM_INTEGRAL_LBOUND_DECREASING",SUM_INTEGRAL_LBOUND_DECREASING; "SUM_INTEGRAL_LBOUND_INCREASING",SUM_INTEGRAL_LBOUND_INCREASING; "SUM_INTEGRAL_UBOUND_DECREASING",SUM_INTEGRAL_UBOUND_DECREASING; "SUM_INTEGRAL_UBOUND_INCREASING",SUM_INTEGRAL_UBOUND_INCREASING; "SUM_LE",SUM_LE; "SUM_LE_INCLUDED",SUM_LE_INCLUDED; "SUM_LE_NUMSEG",SUM_LE_NUMSEG; "SUM_LMUL",SUM_LMUL; "SUM_LT",SUM_LT; "SUM_LT_ALL",SUM_LT_ALL; "SUM_MULTICOUNT",SUM_MULTICOUNT; "SUM_MULTICOUNT_GEN",SUM_MULTICOUNT_GEN; "SUM_MUL_BOUND",SUM_MUL_BOUND; "SUM_NEG",SUM_NEG; "SUM_OFFSET",SUM_OFFSET; "SUM_OFFSET_0",SUM_OFFSET_0; "SUM_OF_POWERS",SUM_OF_POWERS; "SUM_OVER_PERMUTATIONS_INSERT",SUM_OVER_PERMUTATIONS_INSERT; "SUM_OVER_PERMUTATIONS_NUMSEG",SUM_OVER_PERMUTATIONS_NUMSEG; "SUM_OVER_TAGGED_DIVISION_LEMMA",SUM_OVER_TAGGED_DIVISION_LEMMA; "SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; "SUM_PAIR",SUM_PAIR; "SUM_PARTIAL_PRE",SUM_PARTIAL_PRE; "SUM_PARTIAL_SUC",SUM_PARTIAL_SUC; "SUM_PERMUTATIONS_COMPOSE_L",SUM_PERMUTATIONS_COMPOSE_L; "SUM_PERMUTATIONS_COMPOSE_R",SUM_PERMUTATIONS_COMPOSE_R; "SUM_PERMUTATIONS_INVERSE",SUM_PERMUTATIONS_INVERSE; "SUM_PERMUTE",SUM_PERMUTE; "SUM_PERMUTE_NUMSEG",SUM_PERMUTE_NUMSEG; "SUM_POS_BOUND",SUM_POS_BOUND; "SUM_POS_EQ_0",SUM_POS_EQ_0; "SUM_POS_EQ_0_NUMSEG",SUM_POS_EQ_0_NUMSEG; "SUM_POS_LE",SUM_POS_LE; "SUM_POS_LE_NUMSEG",SUM_POS_LE_NUMSEG; "SUM_POS_LT",SUM_POS_LT; "SUM_POS_LT_ALL",SUM_POS_LT_ALL; "SUM_REFLECT",SUM_REFLECT; "SUM_RESTRICT",SUM_RESTRICT; "SUM_RESTRICT_SET",SUM_RESTRICT_SET; "SUM_RMUL",SUM_RMUL; "SUM_SING",SUM_SING; "SUM_SING_NUMSEG",SUM_SING_NUMSEG; "SUM_SUB",SUM_SUB; "SUM_SUBSET",SUM_SUBSET; "SUM_SUBSET_SIMPLE",SUM_SUBSET_SIMPLE; "SUM_SUB_NUMSEG",SUM_SUB_NUMSEG; "SUM_SUM_PRODUCT",SUM_SUM_PRODUCT; "SUM_SUM_RESTRICT",SUM_SUM_RESTRICT; "SUM_SUPERSET",SUM_SUPERSET; "SUM_SUPPORT",SUM_SUPPORT; "SUM_SWAP",SUM_SWAP; "SUM_SWAP_NUMSEG",SUM_SWAP_NUMSEG; "SUM_TRIV_NUMSEG",SUM_TRIV_NUMSEG; "SUM_UNION",SUM_UNION; "SUM_UNIONS_NONZERO",SUM_UNIONS_NONZERO; "SUM_UNION_EQ",SUM_UNION_EQ; "SUM_UNION_LZERO",SUM_UNION_LZERO; "SUM_UNION_NONZERO",SUM_UNION_NONZERO; "SUM_UNION_RZERO",SUM_UNION_RZERO; "SUM_UNIV",SUM_UNIV; "SUM_VSUM",SUM_VSUM; "SUM_ZERO_EXISTS",SUM_ZERO_EXISTS; "SUP",SUP; "SUPERADMISSIBLE_COND",SUPERADMISSIBLE_COND; "SUPERADMISSIBLE_CONST",SUPERADMISSIBLE_CONST; "SUPERADMISSIBLE_MATCH_GUARDED_PATTERN",SUPERADMISSIBLE_MATCH_GUARDED_PATTERN; "SUPERADMISSIBLE_MATCH_SEQPATTERN",SUPERADMISSIBLE_MATCH_SEQPATTERN; "SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN",SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN; "SUPERADMISSIBLE_T",SUPERADMISSIBLE_T; "SUPERADMISSIBLE_TAIL",SUPERADMISSIBLE_TAIL; "SUPPORTING_HYPERPLANE_CLOSED_POINT",SUPPORTING_HYPERPLANE_CLOSED_POINT; "SUPPORTING_HYPERPLANE_COMPACT_POINT_INF",SUPPORTING_HYPERPLANE_COMPACT_POINT_INF; "SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP",SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP; "SUPPORTING_HYPERPLANE_FRONTIER",SUPPORTING_HYPERPLANE_FRONTIER; "SUPPORTING_HYPERPLANE_POINT",SUPPORTING_HYPERPLANE_POINT; "SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY",SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY; "SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER",SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER; "SUPPORT_CLAUSES",SUPPORT_CLAUSES; "SUPPORT_DELTA",SUPPORT_DELTA; "SUPPORT_EMPTY",SUPPORT_EMPTY; "SUPPORT_SUBSET",SUPPORT_SUBSET; "SUPPORT_SUPPORT",SUPPORT_SUPPORT; "SUP_CLOSURE",SUP_CLOSURE; "SUP_EQ",SUP_EQ; "SUP_FINITE",SUP_FINITE; "SUP_FINITE_LEMMA",SUP_FINITE_LEMMA; "SUP_INSERT",SUP_INSERT; "SUP_INSERT_FINITE",SUP_INSERT_FINITE; "SUP_INSERT_INSERT",SUP_INSERT_INSERT; "SUP_SING",SUP_SING; "SUP_UNION",SUP_UNION; "SUP_UNIQUE",SUP_UNIQUE; "SUP_UNIQUE_FINITE",SUP_UNIQUE_FINITE; "SURA_BURA",SURA_BURA; "SURA_BURA_CLOPEN_SUBSET",SURA_BURA_CLOPEN_SUBSET; "SURA_BURA_CLOPEN_SUBSET_ALT",SURA_BURA_CLOPEN_SUBSET_ALT; "SURA_BURA_COMPACT",SURA_BURA_COMPACT; "SURJ",SURJ; "SURJECTIVE_EXISTS_THM",SURJECTIVE_EXISTS_THM; "SURJECTIVE_FORALL_THM",SURJECTIVE_FORALL_THM; "SURJECTIVE_IFF_INJECTIVE",SURJECTIVE_IFF_INJECTIVE; "SURJECTIVE_IFF_INJECTIVE_GEN",SURJECTIVE_IFF_INJECTIVE_GEN; "SURJECTIVE_IMAGE",SURJECTIVE_IMAGE; "SURJECTIVE_IMAGE_EQ",SURJECTIVE_IMAGE_EQ; "SURJECTIVE_IMAGE_THM",SURJECTIVE_IMAGE_THM; "SURJECTIVE_INVERSE",SURJECTIVE_INVERSE; "SURJECTIVE_INVERSE_o",SURJECTIVE_INVERSE_o; "SURJECTIVE_MAP",SURJECTIVE_MAP; "SURJECTIVE_ON_IMAGE",SURJECTIVE_ON_IMAGE; "SURJECTIVE_ON_PREIMAGE",SURJECTIVE_ON_PREIMAGE; "SURJECTIVE_ON_RIGHT_INVERSE",SURJECTIVE_ON_RIGHT_INVERSE; "SURJECTIVE_PREIMAGE",SURJECTIVE_PREIMAGE; "SURJECTIVE_RIGHT_INVERSE",SURJECTIVE_RIGHT_INVERSE; "SURJECTIVE_SCALING",SURJECTIVE_SCALING; "SUSLIN_INC",SUSLIN_INC; "SUSLIN_INTER",SUSLIN_INTER; "SUSLIN_INTERS",SUSLIN_INTERS; "SUSLIN_LEBESGUE_MEASURABLE",SUSLIN_LEBESGUE_MEASURABLE; "SUSLIN_MONO",SUSLIN_MONO; "SUSLIN_REGULAR",SUSLIN_REGULAR; "SUSLIN_SUBSET",SUSLIN_SUBSET; "SUSLIN_SUPERSET",SUSLIN_SUPERSET; "SUSLIN_SUSLIN",SUSLIN_SUSLIN; "SUSLIN_UNION",SUSLIN_UNION; "SUSLIN_UNIONS",SUSLIN_UNIONS; "SUSSMANN_OPEN_MAPPING",SUSSMANN_OPEN_MAPPING; "SWAPSEQ_COMPOSE",SWAPSEQ_COMPOSE; "SWAPSEQ_ENDSWAP",SWAPSEQ_ENDSWAP; "SWAPSEQ_EVEN_EVEN",SWAPSEQ_EVEN_EVEN; "SWAPSEQ_I",SWAPSEQ_I; "SWAPSEQ_IDENTITY_EVEN",SWAPSEQ_IDENTITY_EVEN; "SWAPSEQ_INVERSE",SWAPSEQ_INVERSE; "SWAPSEQ_INVERSE_EXISTS",SWAPSEQ_INVERSE_EXISTS; "SWAPSEQ_SWAP",SWAPSEQ_SWAP; "SWAP_COMMON",SWAP_COMMON; "SWAP_COMMON'",SWAP_COMMON'; "SWAP_EXISTS_THM",SWAP_EXISTS_THM; "SWAP_FORALL_THM",SWAP_FORALL_THM; "SWAP_GALOIS",SWAP_GALOIS; "SWAP_GENERAL",SWAP_GENERAL; "SWAP_IDEMPOTENT",SWAP_IDEMPOTENT; "SWAP_INDEPENDENT",SWAP_INDEPENDENT; "SWAP_REFL",SWAP_REFL; "SWAP_SYM",SWAP_SYM; "SYLVESTER_DETERMINANT_IDENTITY",SYLVESTER_DETERMINANT_IDENTITY; "SYMDIFF_PARITY_LEMMA",SYMDIFF_PARITY_LEMMA; "SYMMETRIC_CLOSURE",SYMMETRIC_CLOSURE; "SYMMETRIC_INTERIOR",SYMMETRIC_INTERIOR; "SYMMETRIC_LINEAR_IMAGE",SYMMETRIC_LINEAR_IMAGE; "SYMMETRIC_MATRIX",SYMMETRIC_MATRIX; "SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT",SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT; "SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE",SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE; "SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT",SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT; "SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE",SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE; "SYMMETRIC_MATRIX_INV",SYMMETRIC_MATRIX_INV; "SYMMETRIC_MATRIX_INV_LMUL",SYMMETRIC_MATRIX_INV_LMUL; "SYMMETRIC_MATRIX_INV_RMUL",SYMMETRIC_MATRIX_INV_RMUL; "SYMMETRIC_MATRIX_MUL",SYMMETRIC_MATRIX_MUL; "SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS",SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS; "SYMMETRIC_MATRIX_SIMILAR",SYMMETRIC_MATRIX_SIMILAR; "SYMMETRY_LEMMA",SYMMETRY_LEMMA; "TAGGED_DIVISION_FINER",TAGGED_DIVISION_FINER; "TAGGED_DIVISION_OF",TAGGED_DIVISION_OF; "TAGGED_DIVISION_OF_ALT",TAGGED_DIVISION_OF_ALT; "TAGGED_DIVISION_OF_ANOTHER",TAGGED_DIVISION_OF_ANOTHER; "TAGGED_DIVISION_OF_EMPTY",TAGGED_DIVISION_OF_EMPTY; "TAGGED_DIVISION_OF_FINITE",TAGGED_DIVISION_OF_FINITE; "TAGGED_DIVISION_OF_NONTRIVIAL",TAGGED_DIVISION_OF_NONTRIVIAL; "TAGGED_DIVISION_OF_SELF",TAGGED_DIVISION_OF_SELF; "TAGGED_DIVISION_OF_TRIVIAL",TAGGED_DIVISION_OF_TRIVIAL; "TAGGED_DIVISION_OF_UNION_SELF",TAGGED_DIVISION_OF_UNION_SELF; "TAGGED_DIVISION_SPLIT_LEFT_INJ",TAGGED_DIVISION_SPLIT_LEFT_INJ; "TAGGED_DIVISION_SPLIT_RIGHT_INJ",TAGGED_DIVISION_SPLIT_RIGHT_INJ; "TAGGED_DIVISION_UNION",TAGGED_DIVISION_UNION; "TAGGED_DIVISION_UNIONS",TAGGED_DIVISION_UNIONS; "TAGGED_DIVISION_UNIONS_EXISTS",TAGGED_DIVISION_UNIONS_EXISTS; "TAGGED_DIVISION_UNION_IMAGE_SND",TAGGED_DIVISION_UNION_IMAGE_SND; "TAGGED_DIVISION_UNION_INTERVAL",TAGGED_DIVISION_UNION_INTERVAL; "TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND",TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND; "TAGGED_PARTIAL_DIVISION_COMMON_TAGS",TAGGED_PARTIAL_DIVISION_COMMON_TAGS; "TAGGED_PARTIAL_DIVISION_OF_SUBSET",TAGGED_PARTIAL_DIVISION_OF_SUBSET; "TAGGED_PARTIAL_DIVISION_OF_TRIVIAL",TAGGED_PARTIAL_DIVISION_OF_TRIVIAL; "TAGGED_PARTIAL_DIVISION_OF_UNION_SELF",TAGGED_PARTIAL_DIVISION_OF_UNION_SELF; "TAGGED_PARTIAL_DIVISION_SUBSET",TAGGED_PARTIAL_DIVISION_SUBSET; "TAG_IN_INTERVAL",TAG_IN_INTERVAL; "TAN_0",TAN_0; "TAN_ABS_GE_X",TAN_ABS_GE_X; "TAN_ADD",TAN_ADD; "TAN_ATN",TAN_ATN; "TAN_BOUND_PI2",TAN_BOUND_PI2; "TAN_COT",TAN_COT; "TAN_DOUBLE",TAN_DOUBLE; "TAN_MONO_LE",TAN_MONO_LE; "TAN_MONO_LE_EQ",TAN_MONO_LE_EQ; "TAN_MONO_LT",TAN_MONO_LT; "TAN_MONO_LT_EQ",TAN_MONO_LT_EQ; "TAN_NEG",TAN_NEG; "TAN_NPI",TAN_NPI; "TAN_PERIODIC_NPI",TAN_PERIODIC_NPI; "TAN_PERIODIC_PI",TAN_PERIODIC_PI; "TAN_PI",TAN_PI; "TAN_PI4",TAN_PI4; "TAN_POS_PI2",TAN_POS_PI2; "TAN_POS_PI2_LE",TAN_POS_PI2_LE; "TAN_SEC",TAN_SEC; "TAN_SUB",TAN_SUB; "TAN_TOTAL",TAN_TOTAL; "TAN_TOTAL_LEMMA",TAN_TOTAL_LEMMA; "TAN_TOTAL_POS",TAN_TOTAL_POS; "TARSKI_SET",TARSKI_SET; "TAYLOR_CATN",TAYLOR_CATN; "TAYLOR_CCOS",TAYLOR_CCOS; "TAYLOR_CCOS_RAW",TAYLOR_CCOS_RAW; "TAYLOR_CEXP",TAYLOR_CEXP; "TAYLOR_CLOG",TAYLOR_CLOG; "TAYLOR_CLOG_NEG",TAYLOR_CLOG_NEG; "TAYLOR_CSIN",TAYLOR_CSIN; "TAYLOR_CSIN_RAW",TAYLOR_CSIN_RAW; "TENDSTO_ALT",TENDSTO_ALT; "TENDSTO_ALT_WITHIN",TENDSTO_ALT_WITHIN; "TENDSTO_LIM",TENDSTO_LIM; "TENDSTO_REAL",TENDSTO_REAL; "THETA_CURVE_INSIDE_CASES",THETA_CURVE_INSIDE_CASES; "THIN_FRONTIER_CIC",THIN_FRONTIER_CIC; "THIN_FRONTIER_ICI",THIN_FRONTIER_ICI; "THIN_FRONTIER_OF_CIC",THIN_FRONTIER_OF_CIC; "THIN_FRONTIER_OF_ICI",THIN_FRONTIER_OF_ICI; "THIN_FRONTIER_OF_SUBSET",THIN_FRONTIER_OF_SUBSET; "THIN_FRONTIER_SUBSET",THIN_FRONTIER_SUBSET; "TIETZE",TIETZE; "TIETZE_CLOSED_INTERVAL",TIETZE_CLOSED_INTERVAL; "TIETZE_CLOSED_INTERVAL_1",TIETZE_CLOSED_INTERVAL_1; "TIETZE_OPEN_INTERVAL",TIETZE_OPEN_INTERVAL; "TIETZE_OPEN_INTERVAL_1",TIETZE_OPEN_INTERVAL_1; "TIETZE_UNBOUNDED",TIETZE_UNBOUNDED; "TINY_INDUCTIVE_DIMENSION",TINY_INDUCTIVE_DIMENSION; "TL",TL; "TOEPLITZ_BILINEAR_SERIES",TOEPLITZ_BILINEAR_SERIES; "TOEPLITZ_BILINEAR_SERIES_NULL",TOEPLITZ_BILINEAR_SERIES_NULL; "TOPCONTINUOUS_EQ_CONTINUOUS_ON",TOPCONTINUOUS_EQ_CONTINUOUS_ON; "TOPCONTINUOUS_EQ_TOPCONTINUOUS_AT",TOPCONTINUOUS_EQ_TOPCONTINUOUS_AT; "TOPCONTINUOUS_IMAGE_SUBSET_TOPSPACE",TOPCONTINUOUS_IMAGE_SUBSET_TOPSPACE; "TOPCONTINUOUS_IN_SUBTOPOLGY",TOPCONTINUOUS_IN_SUBTOPOLGY; "TOPCONTINUOUS_LIMIT",TOPCONTINUOUS_LIMIT; "TOPCONTINUOUS_TO_METRIC",TOPCONTINUOUS_TO_METRIC; "TOPOLOGICAL_SORT",TOPOLOGICAL_SORT; "TOPOLOGY_EQ",TOPOLOGY_EQ; "TOPSPACE_EUCLIDEAN",TOPSPACE_EUCLIDEAN; "TOPSPACE_EUCLIDEANREAL",TOPSPACE_EUCLIDEANREAL; "TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY",TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY; "TOPSPACE_EUCLIDEAN_SUBTOPOLOGY",TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; "TOPSPACE_MTOPOLOGY",TOPSPACE_MTOPOLOGY; "TOPSPACE_SUBTOPOLOGY",TOPSPACE_SUBTOPOLOGY; "TOPSPACE_SUBTOPOLOGY_SUBSET",TOPSPACE_SUBTOPOLOGY_SUBSET; "TORHORST_CONFORMAL_EXTENSION_THEOREM",TORHORST_CONFORMAL_EXTENSION_THEOREM; "TOSET_COFINAL_WOSET",TOSET_COFINAL_WOSET; "TOTALLY_BOUNDED_HAUSDIST",TOTALLY_BOUNDED_HAUSDIST; "TRACE_0",TRACE_0; "TRACE_ADD",TRACE_ADD; "TRACE_CMUL",TRACE_CMUL; "TRACE_COVARIANCE_CAUCHY_SCHWARZ",TRACE_COVARIANCE_CAUCHY_SCHWARZ; "TRACE_COVARIANCE_CAUCHY_SCHWARZ_ABS",TRACE_COVARIANCE_CAUCHY_SCHWARZ_ABS; "TRACE_COVARIANCE_CAUCHY_SCHWARZ_SQUARE",TRACE_COVARIANCE_CAUCHY_SCHWARZ_SQUARE; "TRACE_COVARIANCE_EQ_0",TRACE_COVARIANCE_EQ_0; "TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE",TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE; "TRACE_COVARIANCE_POS_LE",TRACE_COVARIANCE_POS_LE; "TRACE_COVARIANCE_POS_LT",TRACE_COVARIANCE_POS_LT; "TRACE_I",TRACE_I; "TRACE_LE_MUL_SQUARES",TRACE_LE_MUL_SQUARES; "TRACE_MATRIX_INV_LMUL",TRACE_MATRIX_INV_LMUL; "TRACE_MATRIX_INV_RMUL",TRACE_MATRIX_INV_RMUL; "TRACE_MUL_CYCLIC",TRACE_MUL_CYCLIC; "TRACE_MUL_POSITIVE_DEFINITE_SEMIDEFINITE_EQ_0",TRACE_MUL_POSITIVE_DEFINITE_SEMIDEFINITE_EQ_0; "TRACE_MUL_POSITIVE_SEMIDEFINITE",TRACE_MUL_POSITIVE_SEMIDEFINITE; "TRACE_MUL_POSITIVE_SEMIDEFINITE_DEFINITE_EQ_0",TRACE_MUL_POSITIVE_SEMIDEFINITE_DEFINITE_EQ_0; "TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0",TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0; "TRACE_MUL_POSITIVE_SEMIDEFINITE_LE",TRACE_MUL_POSITIVE_SEMIDEFINITE_LE; "TRACE_MUL_SYM",TRACE_MUL_SYM; "TRACE_NEG",TRACE_NEG; "TRACE_POSITIVE_DEFINITE",TRACE_POSITIVE_DEFINITE; "TRACE_POSITIVE_SEMIDEFINITE",TRACE_POSITIVE_SEMIDEFINITE; "TRACE_SIMILAR",TRACE_SIMILAR; "TRACE_SQUARE_POSITIVE_SEMIDEFINITE_LE",TRACE_SQUARE_POSITIVE_SEMIDEFINITE_LE; "TRACE_SUB",TRACE_SUB; "TRACE_TRANSP",TRACE_TRANSP; "TRANSITIVE_STEPWISE_LE",TRANSITIVE_STEPWISE_LE; "TRANSITIVE_STEPWISE_LE_EQ",TRANSITIVE_STEPWISE_LE_EQ; "TRANSITIVE_STEPWISE_LT",TRANSITIVE_STEPWISE_LT; "TRANSITIVE_STEPWISE_LT_EQ",TRANSITIVE_STEPWISE_LT_EQ; "TRANSLATION_DIFF",TRANSLATION_DIFF; "TRANSLATION_EQ_IMP",TRANSLATION_EQ_IMP; "TRANSLATION_GALOIS",TRANSLATION_GALOIS; "TRANSLATION_SUBSET_GALOIS_LEFT",TRANSLATION_SUBSET_GALOIS_LEFT; "TRANSLATION_SUBSET_GALOIS_RIGHT",TRANSLATION_SUBSET_GALOIS_RIGHT; "TRANSLATION_UNIV",TRANSLATION_UNIV; "TRANSP_COLUMNVECTOR",TRANSP_COLUMNVECTOR; "TRANSP_COMPONENT",TRANSP_COMPONENT; "TRANSP_DIAGONAL_MATRIX",TRANSP_DIAGONAL_MATRIX; "TRANSP_EQ",TRANSP_EQ; "TRANSP_EQ_0",TRANSP_EQ_0; "TRANSP_INJECTIVE",TRANSP_INJECTIVE; "TRANSP_MAT",TRANSP_MAT; "TRANSP_MATRIX_ADD",TRANSP_MATRIX_ADD; "TRANSP_MATRIX_CMUL",TRANSP_MATRIX_CMUL; "TRANSP_MATRIX_INV",TRANSP_MATRIX_INV; "TRANSP_MATRIX_NEG",TRANSP_MATRIX_NEG; "TRANSP_MATRIX_SUB",TRANSP_MATRIX_SUB; "TRANSP_ROWVECTOR",TRANSP_ROWVECTOR; "TRANSP_SURJECTIVE",TRANSP_SURJECTIVE; "TRANSP_TRANSP",TRANSP_TRANSP; "TREAL_ADD_ASSOC",TREAL_ADD_ASSOC; "TREAL_ADD_LDISTRIB",TREAL_ADD_LDISTRIB; "TREAL_ADD_LID",TREAL_ADD_LID; "TREAL_ADD_LINV",TREAL_ADD_LINV; "TREAL_ADD_SYM",TREAL_ADD_SYM; "TREAL_ADD_SYM_EQ",TREAL_ADD_SYM_EQ; "TREAL_ADD_WELLDEF",TREAL_ADD_WELLDEF; "TREAL_ADD_WELLDEFR",TREAL_ADD_WELLDEFR; "TREAL_EQ_AP",TREAL_EQ_AP; "TREAL_EQ_IMP_LE",TREAL_EQ_IMP_LE; "TREAL_EQ_REFL",TREAL_EQ_REFL; "TREAL_EQ_SYM",TREAL_EQ_SYM; "TREAL_EQ_TRANS",TREAL_EQ_TRANS; "TREAL_INV_0",TREAL_INV_0; "TREAL_INV_WELLDEF",TREAL_INV_WELLDEF; "TREAL_LE_ANTISYM",TREAL_LE_ANTISYM; "TREAL_LE_LADD_IMP",TREAL_LE_LADD_IMP; "TREAL_LE_MUL",TREAL_LE_MUL; "TREAL_LE_REFL",TREAL_LE_REFL; "TREAL_LE_TOTAL",TREAL_LE_TOTAL; "TREAL_LE_TRANS",TREAL_LE_TRANS; "TREAL_LE_WELLDEF",TREAL_LE_WELLDEF; "TREAL_MUL_ASSOC",TREAL_MUL_ASSOC; "TREAL_MUL_LID",TREAL_MUL_LID; "TREAL_MUL_LINV",TREAL_MUL_LINV; "TREAL_MUL_SYM",TREAL_MUL_SYM; "TREAL_MUL_SYM_EQ",TREAL_MUL_SYM_EQ; "TREAL_MUL_WELLDEF",TREAL_MUL_WELLDEF; "TREAL_MUL_WELLDEFR",TREAL_MUL_WELLDEFR; "TREAL_NEG_WELLDEF",TREAL_NEG_WELLDEF; "TREAL_OF_NUM_ADD",TREAL_OF_NUM_ADD; "TREAL_OF_NUM_EQ",TREAL_OF_NUM_EQ; "TREAL_OF_NUM_LE",TREAL_OF_NUM_LE; "TREAL_OF_NUM_MUL",TREAL_OF_NUM_MUL; "TREAL_OF_NUM_WELLDEF",TREAL_OF_NUM_WELLDEF; "TRIANGLE_LEMMA",TRIANGLE_LEMMA; "TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL",TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL; "TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE",TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE; "TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE",TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE; "TRIANGLE_POINTS_CLOSER",TRIANGLE_POINTS_CLOSER; "TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX",TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX; "TRIANGULATION_DISJOINT_RELATIVE_INTERIORS",TRIANGULATION_DISJOINT_RELATIVE_INTERIORS; "TRIANGULATION_INTER_SIMPLEX",TRIANGULATION_INTER_SIMPLEX; "TRIANGULATION_LINEAR_IMAGE",TRIANGULATION_LINEAR_IMAGE; "TRIANGULATION_SIMPLEX_FACES",TRIANGULATION_SIMPLEX_FACES; "TRIANGULATION_SIMPLEX_FACETS",TRIANGULATION_SIMPLEX_FACETS; "TRIANGULATION_SIMPLICIAL_COMPLEX",TRIANGULATION_SIMPLICIAL_COMPLEX; "TRIANGULATION_SUBFACES",TRIANGULATION_SUBFACES; "TRIANGULATION_SUBSET",TRIANGULATION_SUBSET; "TRIANGULATION_TRANSLATION",TRIANGULATION_TRANSLATION; "TRIANGULATION_UNION",TRIANGULATION_UNION; "TRIVIAL_LIMIT_AT",TRIVIAL_LIMIT_AT; "TRIVIAL_LIMIT_ATREAL",TRIVIAL_LIMIT_ATREAL; "TRIVIAL_LIMIT_AT_INFINITY",TRIVIAL_LIMIT_AT_INFINITY; "TRIVIAL_LIMIT_AT_NEGINFINITY",TRIVIAL_LIMIT_AT_NEGINFINITY; "TRIVIAL_LIMIT_AT_POSINFINITY",TRIVIAL_LIMIT_AT_POSINFINITY; "TRIVIAL_LIMIT_SEQUENTIALLY",TRIVIAL_LIMIT_SEQUENTIALLY; "TRIVIAL_LIMIT_WITHIN",TRIVIAL_LIMIT_WITHIN; "TRIVIAL_LIMIT_WITHINREAL_WITHIN",TRIVIAL_LIMIT_WITHINREAL_WITHIN; "TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX",TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX; "TRIVIAL_LIMIT_WITHIN_CONVEX",TRIVIAL_LIMIT_WITHIN_CONVEX; "TRIVIAL_LIMIT_WITHIN_REAL",TRIVIAL_LIMIT_WITHIN_REAL; "TRIVIAL_LIMIT_WITHIN_REALINTERVAL",TRIVIAL_LIMIT_WITHIN_REALINTERVAL; "TRIV_AND_EXISTS_THM",TRIV_AND_EXISTS_THM; "TRIV_EXISTS_AND_THM",TRIV_EXISTS_AND_THM; "TRIV_EXISTS_IMP_THM",TRIV_EXISTS_IMP_THM; "TRIV_FORALL_IMP_THM",TRIV_FORALL_IMP_THM; "TRIV_FORALL_OR_THM",TRIV_FORALL_OR_THM; "TRIV_OR_FORALL_THM",TRIV_OR_FORALL_THM; "TRUTH",TRUTH; "TUBE_LEMMA",TUBE_LEMMA; "TUBE_LEMMA_GEN",TUBE_LEMMA_GEN; "TUKEY",TUKEY; "TWO",TWO; "TWO_SIDED_LIMIT_AT",TWO_SIDED_LIMIT_AT; "TWO_SIDED_LIMIT_WITHIN",TWO_SIDED_LIMIT_WITHIN; "T_DEF",T_DEF; "ULC_IMP_LOCALLY_CONNECTED",ULC_IMP_LOCALLY_CONNECTED; "UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX",UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX; "UNBOUNDED_COMPLEMENT_CONVEX",UNBOUNDED_COMPLEMENT_CONVEX; "UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT",UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT; "UNBOUNDED_COMPONENTS_OUTSIDE",UNBOUNDED_COMPONENTS_OUTSIDE; "UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY; "UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS; "UNBOUNDED_DISJOINT_IN_OUTSIDE",UNBOUNDED_DISJOINT_IN_OUTSIDE; "UNBOUNDED_HALFSPACE_COMPONENT_GE",UNBOUNDED_HALFSPACE_COMPONENT_GE; "UNBOUNDED_HALFSPACE_COMPONENT_GT",UNBOUNDED_HALFSPACE_COMPONENT_GT; "UNBOUNDED_HALFSPACE_COMPONENT_LE",UNBOUNDED_HALFSPACE_COMPONENT_LE; "UNBOUNDED_HALFSPACE_COMPONENT_LT",UNBOUNDED_HALFSPACE_COMPONENT_LT; "UNBOUNDED_INTER_COBOUNDED",UNBOUNDED_INTER_COBOUNDED; "UNBOUNDED_OUTSIDE",UNBOUNDED_OUTSIDE; "UNBOUNDED_REAL",UNBOUNDED_REAL; "UNCOUNTABLE_CONNECTED",UNCOUNTABLE_CONNECTED; "UNCOUNTABLE_CONTAINS_LIMIT_POINT",UNCOUNTABLE_CONTAINS_LIMIT_POINT; "UNCOUNTABLE_CONVEX",UNCOUNTABLE_CONVEX; "UNCOUNTABLE_EUCLIDEAN",UNCOUNTABLE_EUCLIDEAN; "UNCOUNTABLE_HAS_CONDENSATION_POINT",UNCOUNTABLE_HAS_CONDENSATION_POINT; "UNCOUNTABLE_INTERVAL",UNCOUNTABLE_INTERVAL; "UNCOUNTABLE_NONEMPTY_INTERIOR",UNCOUNTABLE_NONEMPTY_INTERIOR; "UNCOUNTABLE_OPEN",UNCOUNTABLE_OPEN; "UNCOUNTABLE_PATH_CONNECTED",UNCOUNTABLE_PATH_CONNECTED; "UNCOUNTABLE_REAL",UNCOUNTABLE_REAL; "UNCOUNTABLE_SEGMENT",UNCOUNTABLE_SEGMENT; "UNCURRY_DEF",UNCURRY_DEF; "UNDEFINED",UNDEFINED; "UNICOHERENT_INJECTIVE_LINEAR_IMAGE",UNICOHERENT_INJECTIVE_LINEAR_IMAGE; "UNICOHERENT_MONOTONE_IMAGE_COMPACT",UNICOHERENT_MONOTONE_IMAGE_COMPACT; "UNICOHERENT_TRANSLATION",UNICOHERENT_TRANSLATION; "UNICOHERENT_UNIV",UNICOHERENT_UNIV; "UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT",UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT; "UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED",UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED; "UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE",UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE; "UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL",UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL; "UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS; "UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; "UNIFORMLY_CONTINUOUS_ON_ADD",UNIFORMLY_CONTINUOUS_ON_ADD; "UNIFORMLY_CONTINUOUS_ON_CLOSURE",UNIFORMLY_CONTINUOUS_ON_CLOSURE; "UNIFORMLY_CONTINUOUS_ON_CMUL",UNIFORMLY_CONTINUOUS_ON_CMUL; "UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL",UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL; "UNIFORMLY_CONTINUOUS_ON_COMPLEX_MUL",UNIFORMLY_CONTINUOUS_ON_COMPLEX_MUL; "UNIFORMLY_CONTINUOUS_ON_COMPLEX_RMUL",UNIFORMLY_CONTINUOUS_ON_COMPLEX_RMUL; "UNIFORMLY_CONTINUOUS_ON_COMPOSE",UNIFORMLY_CONTINUOUS_ON_COMPOSE; "UNIFORMLY_CONTINUOUS_ON_CONST",UNIFORMLY_CONTINUOUS_ON_CONST; "UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT",UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT; "UNIFORMLY_CONTINUOUS_ON_EQ",UNIFORMLY_CONTINUOUS_ON_EQ; "UNIFORMLY_CONTINUOUS_ON_ID",UNIFORMLY_CONTINUOUS_ON_ID; "UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST",UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST; "UNIFORMLY_CONTINUOUS_ON_MUL",UNIFORMLY_CONTINUOUS_ON_MUL; "UNIFORMLY_CONTINUOUS_ON_NEG",UNIFORMLY_CONTINUOUS_ON_NEG; "UNIFORMLY_CONTINUOUS_ON_RESTRICT",UNIFORMLY_CONTINUOUS_ON_RESTRICT; "UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY",UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; "UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT",UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT; "UNIFORMLY_CONTINUOUS_ON_SETDIST",UNIFORMLY_CONTINUOUS_ON_SETDIST; "UNIFORMLY_CONTINUOUS_ON_SETDIST_EQ",UNIFORMLY_CONTINUOUS_ON_SETDIST_EQ; "UNIFORMLY_CONTINUOUS_ON_SUB",UNIFORMLY_CONTINUOUS_ON_SUB; "UNIFORMLY_CONTINUOUS_ON_SUBSET",UNIFORMLY_CONTINUOUS_ON_SUBSET; "UNIFORMLY_CONTINUOUS_ON_UNION",UNIFORMLY_CONTINUOUS_ON_UNION; "UNIFORMLY_CONTINUOUS_ON_VMUL",UNIFORMLY_CONTINUOUS_ON_VMUL; "UNIFORMLY_CONTINUOUS_ON_VSUM",UNIFORMLY_CONTINUOUS_ON_VSUM; "UNIFORMLY_CONVERGENT_EQ_CAUCHY",UNIFORMLY_CONVERGENT_EQ_CAUCHY; "UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT",UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT; "UNIFORM_LIM_ADD",UNIFORM_LIM_ADD; "UNIFORM_LIM_BILINEAR",UNIFORM_LIM_BILINEAR; "UNIFORM_LIM_COMPLEX_DIV",UNIFORM_LIM_COMPLEX_DIV; "UNIFORM_LIM_COMPLEX_INV",UNIFORM_LIM_COMPLEX_INV; "UNIFORM_LIM_COMPLEX_MUL",UNIFORM_LIM_COMPLEX_MUL; "UNIFORM_LIM_SUB",UNIFORM_LIM_SUB; "UNION",UNION; "UNIONS",UNIONS; "UNIONS_0",UNIONS_0; "UNIONS_1",UNIONS_1; "UNIONS_2",UNIONS_2; "UNIONS_COMPONENTS",UNIONS_COMPONENTS; "UNIONS_CONNECTED_COMPONENT",UNIONS_CONNECTED_COMPONENT; "UNIONS_DELETE_EMPTY",UNIONS_DELETE_EMPTY; "UNIONS_DIFF",UNIONS_DIFF; "UNIONS_GSPEC",UNIONS_GSPEC; "UNIONS_IMAGE",UNIONS_IMAGE; "UNIONS_INSERT",UNIONS_INSERT; "UNIONS_INSERT_EMPTY",UNIONS_INSERT_EMPTY; "UNIONS_INTERS",UNIONS_INTERS; "UNIONS_IN_CHAIN",UNIONS_IN_CHAIN; "UNIONS_MAXIMAL_SETS",UNIONS_MAXIMAL_SETS; "UNIONS_MONO",UNIONS_MONO; "UNIONS_MONO_IMAGE",UNIONS_MONO_IMAGE; "UNIONS_OVER_INTERS",UNIONS_OVER_INTERS; "UNIONS_PATH_COMPONENT",UNIONS_PATH_COMPONENT; "UNIONS_PRED",UNIONS_PRED; "UNIONS_SUBSET",UNIONS_SUBSET; "UNIONS_UNION",UNIONS_UNION; "UNIONS_UNIV",UNIONS_UNIV; "UNION_ACI",UNION_ACI; "UNION_ASSOC",UNION_ASSOC; "UNION_COMM",UNION_COMM; "UNION_EMPTY",UNION_EMPTY; "UNION_FL",UNION_FL; "UNION_FRONTIER",UNION_FRONTIER; "UNION_IDEMPOT",UNION_IDEMPOT; "UNION_INSEG",UNION_INSEG; "UNION_INTERIOR_OF_SUBSET",UNION_INTERIOR_OF_SUBSET; "UNION_INTERIOR_SUBSET",UNION_INTERIOR_SUBSET; "UNION_INTERVAL_1",UNION_INTERVAL_1; "UNION_INTERVAL_SUBSET_INTERVAL",UNION_INTERVAL_SUBSET_INTERVAL; "UNION_LE_ADD_C",UNION_LE_ADD_C; "UNION_OF",UNION_OF; "UNION_OF_INC",UNION_OF_INC; "UNION_OF_MONO",UNION_OF_MONO; "UNION_OVER_INTER",UNION_OVER_INTER; "UNION_SEGMENT",UNION_SEGMENT; "UNION_SUBSET",UNION_SUBSET; "UNION_UNIV",UNION_UNIV; "UNION_WITH_INSIDE",UNION_WITH_INSIDE; "UNION_WITH_OUTSIDE",UNION_WITH_OUTSIDE; "UNIQUE_SKOLEM_ALT",UNIQUE_SKOLEM_ALT; "UNIQUE_SKOLEM_THM",UNIQUE_SKOLEM_THM; "UNIT_INTERVAL_CONVEX_HULL",UNIT_INTERVAL_CONVEX_HULL; "UNIT_INTERVAL_NONEMPTY",UNIT_INTERVAL_NONEMPTY; "UNIV",UNIV; "UNIVERSAL_COVERING_SPACE",UNIVERSAL_COVERING_SPACE; "UNIV_GSPEC",UNIV_GSPEC; "UNIV_NOT_EMPTY",UNIV_NOT_EMPTY; "UNIV_PCROSS_UNIV",UNIV_PCROSS_UNIV; "UNIV_SECOND_COUNTABLE",UNIV_SECOND_COUNTABLE; "UNIV_SECOND_COUNTABLE_SEQUENCE",UNIV_SECOND_COUNTABLE_SEQUENCE; "UNIV_SUBSET",UNIV_SUBSET; "UNWINDING_2PI",UNWINDING_2PI; "UNWIND_THM1",UNWIND_THM1; "UNWIND_THM2",UNWIND_THM2; "UPPER_BOUND_FINITE_SET",UPPER_BOUND_FINITE_SET; "UPPER_BOUND_FINITE_SET_REAL",UPPER_BOUND_FINITE_SET_REAL; "UPPER_HEMICONTINUOUS",UPPER_HEMICONTINUOUS; "UPPER_LOWER_HEMICONTINUOUS",UPPER_LOWER_HEMICONTINUOUS; "UPPER_LOWER_HEMICONTINUOUS_EXPLICIT",UPPER_LOWER_HEMICONTINUOUS_EXPLICIT; "URYSOHN",URYSOHN; "URYSOHN_LOCAL",URYSOHN_LOCAL; "URYSOHN_LOCAL_STRONG",URYSOHN_LOCAL_STRONG; "URYSOHN_STRONG",URYSOHN_STRONG; "VALID_PATH_CIRCLEPATH",VALID_PATH_CIRCLEPATH; "VALID_PATH_COMPOSE",VALID_PATH_COMPOSE; "VALID_PATH_EQ",VALID_PATH_EQ; "VALID_PATH_IMP_PATH",VALID_PATH_IMP_PATH; "VALID_PATH_JOIN",VALID_PATH_JOIN; "VALID_PATH_JOIN_EQ",VALID_PATH_JOIN_EQ; "VALID_PATH_LINEAR_IMAGE_EQ",VALID_PATH_LINEAR_IMAGE_EQ; "VALID_PATH_LINEPATH",VALID_PATH_LINEPATH; "VALID_PATH_PARTCIRCLEPATH",VALID_PATH_PARTCIRCLEPATH; "VALID_PATH_REVERSEPATH",VALID_PATH_REVERSEPATH; "VALID_PATH_SHIFTPATH",VALID_PATH_SHIFTPATH; "VALID_PATH_SUBPATH",VALID_PATH_SUBPATH; "VALID_PATH_SYM",VALID_PATH_SYM; "VALID_PATH_TRANSLATION_EQ",VALID_PATH_TRANSLATION_EQ; "VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION",VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION; "VARIATION_EQUAL_LEMMA",VARIATION_EQUAL_LEMMA; "VECTOR_1",VECTOR_1; "VECTOR_2",VECTOR_2; "VECTOR_3",VECTOR_3; "VECTOR_4",VECTOR_4; "VECTOR_ADD_AC",VECTOR_ADD_AC; "VECTOR_ADD_ASSOC",VECTOR_ADD_ASSOC; "VECTOR_ADD_COMPONENT",VECTOR_ADD_COMPONENT; "VECTOR_ADD_LDISTRIB",VECTOR_ADD_LDISTRIB; "VECTOR_ADD_LID",VECTOR_ADD_LID; "VECTOR_ADD_LINV",VECTOR_ADD_LINV; "VECTOR_ADD_RDISTRIB",VECTOR_ADD_RDISTRIB; "VECTOR_ADD_RID",VECTOR_ADD_RID; "VECTOR_ADD_RINV",VECTOR_ADD_RINV; "VECTOR_ADD_SUB",VECTOR_ADD_SUB; "VECTOR_ADD_SYM",VECTOR_ADD_SYM; "VECTOR_AFFINITY_EQ",VECTOR_AFFINITY_EQ; "VECTOR_CHOOSE_DIST",VECTOR_CHOOSE_DIST; "VECTOR_CHOOSE_SIZE",VECTOR_CHOOSE_SIZE; "VECTOR_COMPONENTWISE",VECTOR_COMPONENTWISE; "VECTOR_DERIVATIVE_AT",VECTOR_DERIVATIVE_AT; "VECTOR_DERIVATIVE_CIRCLEPATH",VECTOR_DERIVATIVE_CIRCLEPATH; "VECTOR_DERIVATIVE_CONST_AT",VECTOR_DERIVATIVE_CONST_AT; "VECTOR_DERIVATIVE_INCREASING_WITHIN",VECTOR_DERIVATIVE_INCREASING_WITHIN; "VECTOR_DERIVATIVE_LINEPATH_AT",VECTOR_DERIVATIVE_LINEPATH_AT; "VECTOR_DERIVATIVE_LINEPATH_WITHIN",VECTOR_DERIVATIVE_LINEPATH_WITHIN; "VECTOR_DERIVATIVE_PARTCIRCLEPATH",VECTOR_DERIVATIVE_PARTCIRCLEPATH; "VECTOR_DERIVATIVE_UNIQUE_AT",VECTOR_DERIVATIVE_UNIQUE_AT; "VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; "VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL; "VECTOR_DERIVATIVE_WITHIN_INTERIOR",VECTOR_DERIVATIVE_WITHIN_INTERIOR; "VECTOR_DERIVATIVE_WORKS",VECTOR_DERIVATIVE_WORKS; "VECTOR_DIFFERENTIABLE",VECTOR_DIFFERENTIABLE; "VECTOR_DIFFERENTIABLE_BOUND",VECTOR_DIFFERENTIABLE_BOUND; "VECTOR_DIFF_CHAIN_AT",VECTOR_DIFF_CHAIN_AT; "VECTOR_DIFF_CHAIN_WITHIN",VECTOR_DIFF_CHAIN_WITHIN; "VECTOR_EQ",VECTOR_EQ; "VECTOR_EQ_ADDR",VECTOR_EQ_ADDR; "VECTOR_EQ_AFFINITY",VECTOR_EQ_AFFINITY; "VECTOR_EQ_DOT_SPAN",VECTOR_EQ_DOT_SPAN; "VECTOR_EQ_LDOT",VECTOR_EQ_LDOT; "VECTOR_EQ_NEG2",VECTOR_EQ_NEG2; "VECTOR_EQ_RDOT",VECTOR_EQ_RDOT; "VECTOR_EXPAND_1",VECTOR_EXPAND_1; "VECTOR_EXPAND_2",VECTOR_EXPAND_2; "VECTOR_EXPAND_3",VECTOR_EXPAND_3; "VECTOR_EXPAND_4",VECTOR_EXPAND_4; "VECTOR_IN_ORTHOGONAL_BASIS",VECTOR_IN_ORTHOGONAL_BASIS; "VECTOR_IN_ORTHOGONAL_SPANNINGSET",VECTOR_IN_ORTHOGONAL_SPANNINGSET; "VECTOR_IN_ORTHONORMAL_BASIS",VECTOR_IN_ORTHONORMAL_BASIS; "VECTOR_MATRIX_MUL_TRANSP",VECTOR_MATRIX_MUL_TRANSP; "VECTOR_MUL_ASSOC",VECTOR_MUL_ASSOC; "VECTOR_MUL_COMPONENT",VECTOR_MUL_COMPONENT; "VECTOR_MUL_EQ_0",VECTOR_MUL_EQ_0; "VECTOR_MUL_LCANCEL",VECTOR_MUL_LCANCEL; "VECTOR_MUL_LCANCEL_IMP",VECTOR_MUL_LCANCEL_IMP; "VECTOR_MUL_LID",VECTOR_MUL_LID; "VECTOR_MUL_LNEG",VECTOR_MUL_LNEG; "VECTOR_MUL_LZERO",VECTOR_MUL_LZERO; "VECTOR_MUL_RCANCEL",VECTOR_MUL_RCANCEL; "VECTOR_MUL_RCANCEL_IMP",VECTOR_MUL_RCANCEL_IMP; "VECTOR_MUL_RNEG",VECTOR_MUL_RNEG; "VECTOR_MUL_RZERO",VECTOR_MUL_RZERO; "VECTOR_NEG_0",VECTOR_NEG_0; "VECTOR_NEG_COMPONENT",VECTOR_NEG_COMPONENT; "VECTOR_NEG_EQ_0",VECTOR_NEG_EQ_0; "VECTOR_NEG_MINUS1",VECTOR_NEG_MINUS1; "VECTOR_NEG_NEG",VECTOR_NEG_NEG; "VECTOR_NEG_SUB",VECTOR_NEG_SUB; "VECTOR_ONE",VECTOR_ONE; "VECTOR_POLYNOMIAL_FUNCTION_ADD",VECTOR_POLYNOMIAL_FUNCTION_ADD; "VECTOR_POLYNOMIAL_FUNCTION_CMUL",VECTOR_POLYNOMIAL_FUNCTION_CMUL; "VECTOR_POLYNOMIAL_FUNCTION_COMPONENT",VECTOR_POLYNOMIAL_FUNCTION_COMPONENT; "VECTOR_POLYNOMIAL_FUNCTION_CONST",VECTOR_POLYNOMIAL_FUNCTION_CONST; "VECTOR_POLYNOMIAL_FUNCTION_ID",VECTOR_POLYNOMIAL_FUNCTION_ID; "VECTOR_POLYNOMIAL_FUNCTION_LIFT",VECTOR_POLYNOMIAL_FUNCTION_LIFT; "VECTOR_POLYNOMIAL_FUNCTION_MUL",VECTOR_POLYNOMIAL_FUNCTION_MUL; "VECTOR_POLYNOMIAL_FUNCTION_NEG",VECTOR_POLYNOMIAL_FUNCTION_NEG; "VECTOR_POLYNOMIAL_FUNCTION_SUB",VECTOR_POLYNOMIAL_FUNCTION_SUB; "VECTOR_POLYNOMIAL_FUNCTION_VSUM",VECTOR_POLYNOMIAL_FUNCTION_VSUM; "VECTOR_POLYNOMIAL_FUNCTION_o",VECTOR_POLYNOMIAL_FUNCTION_o; "VECTOR_SUB",VECTOR_SUB; "VECTOR_SUB_ADD",VECTOR_SUB_ADD; "VECTOR_SUB_ADD2",VECTOR_SUB_ADD2; "VECTOR_SUB_COMPONENT",VECTOR_SUB_COMPONENT; "VECTOR_SUB_EQ",VECTOR_SUB_EQ; "VECTOR_SUB_LDISTRIB",VECTOR_SUB_LDISTRIB; "VECTOR_SUB_LZERO",VECTOR_SUB_LZERO; "VECTOR_SUB_PROJECT_ORTHOGONAL",VECTOR_SUB_PROJECT_ORTHOGONAL; "VECTOR_SUB_RADD",VECTOR_SUB_RADD; "VECTOR_SUB_RDISTRIB",VECTOR_SUB_RDISTRIB; "VECTOR_SUB_REFL",VECTOR_SUB_REFL; "VECTOR_SUB_RZERO",VECTOR_SUB_RZERO; "VECTOR_VARIATION_AFFINITY",VECTOR_VARIATION_AFFINITY; "VECTOR_VARIATION_AFFINITY2",VECTOR_VARIATION_AFFINITY2; "VECTOR_VARIATION_CMUL",VECTOR_VARIATION_CMUL; "VECTOR_VARIATION_COMBINE",VECTOR_VARIATION_COMBINE; "VECTOR_VARIATION_COMPARISON",VECTOR_VARIATION_COMPARISON; "VECTOR_VARIATION_COMPONENT_LE",VECTOR_VARIATION_COMPONENT_LE; "VECTOR_VARIATION_COMPOSE_DECREASING",VECTOR_VARIATION_COMPOSE_DECREASING; "VECTOR_VARIATION_COMPOSE_HOMEOMORPHISM",VECTOR_VARIATION_COMPOSE_HOMEOMORPHISM; "VECTOR_VARIATION_COMPOSE_INCREASING",VECTOR_VARIATION_COMPOSE_INCREASING; "VECTOR_VARIATION_COMPOSE_INCREASING_GEN",VECTOR_VARIATION_COMPOSE_INCREASING_GEN; "VECTOR_VARIATION_CONST",VECTOR_VARIATION_CONST; "VECTOR_VARIATION_CONST_EQ",VECTOR_VARIATION_CONST_EQ; "VECTOR_VARIATION_CONTINUOUS",VECTOR_VARIATION_CONTINUOUS; "VECTOR_VARIATION_CONTINUOUS_LEFT",VECTOR_VARIATION_CONTINUOUS_LEFT; "VECTOR_VARIATION_CONTINUOUS_RIGHT",VECTOR_VARIATION_CONTINUOUS_RIGHT; "VECTOR_VARIATION_DEGENERATES",VECTOR_VARIATION_DEGENERATES; "VECTOR_VARIATION_EQ",VECTOR_VARIATION_EQ; "VECTOR_VARIATION_GE_DROP_FUNCTION",VECTOR_VARIATION_GE_DROP_FUNCTION; "VECTOR_VARIATION_GE_NORM_FUNCTION",VECTOR_VARIATION_GE_NORM_FUNCTION; "VECTOR_VARIATION_ID",VECTOR_VARIATION_ID; "VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE; "VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_GEN",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_GEN; "VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_REV",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_REV; "VECTOR_VARIATION_ISOMETRIC",VECTOR_VARIATION_ISOMETRIC; "VECTOR_VARIATION_ISOMETRIC_COMPOSE",VECTOR_VARIATION_ISOMETRIC_COMPOSE; "VECTOR_VARIATION_LE_UNION",VECTOR_VARIATION_LE_UNION; "VECTOR_VARIATION_LIFT_ABS",VECTOR_VARIATION_LIFT_ABS; "VECTOR_VARIATION_LINEAR",VECTOR_VARIATION_LINEAR; "VECTOR_VARIATION_LIPSCHITZ",VECTOR_VARIATION_LIPSCHITZ; "VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; "VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_LEFT",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_LEFT; "VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_RIGHT",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_RIGHT; "VECTOR_VARIATION_MONOTONE",VECTOR_VARIATION_MONOTONE; "VECTOR_VARIATION_NEG",VECTOR_VARIATION_NEG; "VECTOR_VARIATION_ON_CLOSURE",VECTOR_VARIATION_ON_CLOSURE; "VECTOR_VARIATION_ON_DIVISION",VECTOR_VARIATION_ON_DIVISION; "VECTOR_VARIATION_ON_EMPTY",VECTOR_VARIATION_ON_EMPTY; "VECTOR_VARIATION_ON_INTERIOR",VECTOR_VARIATION_ON_INTERIOR; "VECTOR_VARIATION_ON_INTERVAL",VECTOR_VARIATION_ON_INTERVAL; "VECTOR_VARIATION_ON_NULL",VECTOR_VARIATION_ON_NULL; "VECTOR_VARIATION_POS_LE",VECTOR_VARIATION_POS_LE; "VECTOR_VARIATION_REFLECT",VECTOR_VARIATION_REFLECT; "VECTOR_VARIATION_REFLECT2",VECTOR_VARIATION_REFLECT2; "VECTOR_VARIATION_REFLECT_INTERVAL",VECTOR_VARIATION_REFLECT_INTERVAL; "VECTOR_VARIATION_SEGMENT_TRIANGLE",VECTOR_VARIATION_SEGMENT_TRIANGLE; "VECTOR_VARIATION_SING",VECTOR_VARIATION_SING; "VECTOR_VARIATION_SPLIT",VECTOR_VARIATION_SPLIT; "VECTOR_VARIATION_SUM_LE",VECTOR_VARIATION_SUM_LE; "VECTOR_VARIATION_TRANSLATION",VECTOR_VARIATION_TRANSLATION; "VECTOR_VARIATION_TRANSLATION2",VECTOR_VARIATION_TRANSLATION2; "VECTOR_VARIATION_TRANSLATION_ALT",VECTOR_VARIATION_TRANSLATION_ALT; "VECTOR_VARIATION_TRANSLATION_INTERVAL",VECTOR_VARIATION_TRANSLATION_INTERVAL; "VECTOR_VARIATION_TRIANGLE",VECTOR_VARIATION_TRIANGLE; "VECTOR_VARIATION_UNION_LE",VECTOR_VARIATION_UNION_LE; "VECTOR_VARIATION_VECTOR_VARIATION",VECTOR_VARIATION_VECTOR_VARIATION; "VECTOR_VARIATION_VMUL",VECTOR_VARIATION_VMUL; "VEC_COMPONENT",VEC_COMPONENT; "VEC_EQ",VEC_EQ; "VERTEX_IMAGE_LINEAR",VERTEX_IMAGE_LINEAR; "VERTEX_IMAGE_LINEAR_GEN",VERTEX_IMAGE_LINEAR_GEN; "VERTEX_IMAGE_LINEAR_POLYTOPE",VERTEX_IMAGE_LINEAR_POLYTOPE; "VERTEX_IMAGE_NONEMPTY",VERTEX_IMAGE_NONEMPTY; "VITALI_COVERING_LEMMA_BALLS",VITALI_COVERING_LEMMA_BALLS; "VITALI_COVERING_LEMMA_CBALLS",VITALI_COVERING_LEMMA_CBALLS; "VITALI_COVERING_LEMMA_CBALLS_BALLS",VITALI_COVERING_LEMMA_CBALLS_BALLS; "VITALI_COVERING_THEOREM_BALLS",VITALI_COVERING_THEOREM_BALLS; "VITALI_COVERING_THEOREM_CBALLS",VITALI_COVERING_THEOREM_CBALLS; "VSUM",VSUM; "VSUM_0",VSUM_0; "VSUM_1",VSUM_1; "VSUM_2",VSUM_2; "VSUM_3",VSUM_3; "VSUM_4",VSUM_4; "VSUM_ADD",VSUM_ADD; "VSUM_ADD_GEN",VSUM_ADD_GEN; "VSUM_ADD_NUMSEG",VSUM_ADD_NUMSEG; "VSUM_ADD_SPLIT",VSUM_ADD_SPLIT; "VSUM_BIJECTION",VSUM_BIJECTION; "VSUM_CASES",VSUM_CASES; "VSUM_CASES_1",VSUM_CASES_1; "VSUM_CLAUSES",VSUM_CLAUSES; "VSUM_CLAUSES_LEFT",VSUM_CLAUSES_LEFT; "VSUM_CLAUSES_NUMSEG",VSUM_CLAUSES_NUMSEG; "VSUM_CLAUSES_RIGHT",VSUM_CLAUSES_RIGHT; "VSUM_CMUL_NUMSEG",VSUM_CMUL_NUMSEG; "VSUM_COMBINE_L",VSUM_COMBINE_L; "VSUM_COMBINE_R",VSUM_COMBINE_R; "VSUM_COMPLEX_LMUL",VSUM_COMPLEX_LMUL; "VSUM_COMPLEX_RMUL",VSUM_COMPLEX_RMUL; "VSUM_COMPONENT",VSUM_COMPONENT; "VSUM_CONST",VSUM_CONST; "VSUM_CONST_NUMSEG",VSUM_CONST_NUMSEG; "VSUM_CONTENT_NULL",VSUM_CONTENT_NULL; "VSUM_CX",VSUM_CX; "VSUM_CX_NUMSEG",VSUM_CX_NUMSEG; "VSUM_DELETE",VSUM_DELETE; "VSUM_DELETE_CASES",VSUM_DELETE_CASES; "VSUM_DELTA",VSUM_DELTA; "VSUM_DIFF",VSUM_DIFF; "VSUM_DIFFS",VSUM_DIFFS; "VSUM_DIFFS_ALT",VSUM_DIFFS_ALT; "VSUM_DIFF_LEMMA",VSUM_DIFF_LEMMA; "VSUM_EQ",VSUM_EQ; "VSUM_EQ_0",VSUM_EQ_0; "VSUM_EQ_GENERAL",VSUM_EQ_GENERAL; "VSUM_EQ_GENERAL_INVERSES",VSUM_EQ_GENERAL_INVERSES; "VSUM_EQ_NUMSEG",VSUM_EQ_NUMSEG; "VSUM_EQ_SUPERSET",VSUM_EQ_SUPERSET; "VSUM_GP",VSUM_GP; "VSUM_GP_BASIC",VSUM_GP_BASIC; "VSUM_GP_MULTIPLIED",VSUM_GP_MULTIPLIED; "VSUM_GP_OFFSET",VSUM_GP_OFFSET; "VSUM_GROUP",VSUM_GROUP; "VSUM_GROUP_RELATION",VSUM_GROUP_RELATION; "VSUM_IMAGE",VSUM_IMAGE; "VSUM_IMAGE_GEN",VSUM_IMAGE_GEN; "VSUM_IMAGE_NONZERO",VSUM_IMAGE_NONZERO; "VSUM_INCL_EXCL",VSUM_INCL_EXCL; "VSUM_INJECTION",VSUM_INJECTION; "VSUM_LMUL",VSUM_LMUL; "VSUM_NEG",VSUM_NEG; "VSUM_NONZERO_IMAGE_LEMMA",VSUM_NONZERO_IMAGE_LEMMA; "VSUM_NORM",VSUM_NORM; "VSUM_NORM_ALLSUBSETS_BOUND",VSUM_NORM_ALLSUBSETS_BOUND; "VSUM_NORM_BOUND",VSUM_NORM_BOUND; "VSUM_NORM_LE",VSUM_NORM_LE; "VSUM_NORM_TRIANGLE",VSUM_NORM_TRIANGLE; "VSUM_OFFSET",VSUM_OFFSET; "VSUM_OFFSET_0",VSUM_OFFSET_0; "VSUM_OVER_TAGGED_DIVISION_LEMMA",VSUM_OVER_TAGGED_DIVISION_LEMMA; "VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; "VSUM_PAIR",VSUM_PAIR; "VSUM_PAIR_0",VSUM_PAIR_0; "VSUM_PARTIAL_PRE",VSUM_PARTIAL_PRE; "VSUM_PARTIAL_SUC",VSUM_PARTIAL_SUC; "VSUM_REAL",VSUM_REAL; "VSUM_REFLECT",VSUM_REFLECT; "VSUM_RESTRICT",VSUM_RESTRICT; "VSUM_RESTRICT_SET",VSUM_RESTRICT_SET; "VSUM_RMUL",VSUM_RMUL; "VSUM_SING",VSUM_SING; "VSUM_SING_NUMSEG",VSUM_SING_NUMSEG; "VSUM_SUB",VSUM_SUB; "VSUM_SUB_NUMSEG",VSUM_SUB_NUMSEG; "VSUM_SUC",VSUM_SUC; "VSUM_SUPERSET",VSUM_SUPERSET; "VSUM_SUPPORT",VSUM_SUPPORT; "VSUM_SWAP",VSUM_SWAP; "VSUM_SWAP_NUMSEG",VSUM_SWAP_NUMSEG; "VSUM_TRIV_NUMSEG",VSUM_TRIV_NUMSEG; "VSUM_UNION",VSUM_UNION; "VSUM_UNIONS_NONZERO",VSUM_UNIONS_NONZERO; "VSUM_UNION_LZERO",VSUM_UNION_LZERO; "VSUM_UNION_NONZERO",VSUM_UNION_NONZERO; "VSUM_UNION_RZERO",VSUM_UNION_RZERO; "VSUM_UNIV",VSUM_UNIV; "VSUM_VMUL",VSUM_VMUL; "VSUM_VSUM_PRODUCT",VSUM_VSUM_PRODUCT; "WEAK_LEBESGUE_POINTS_IMP_IVT",WEAK_LEBESGUE_POINTS_IMP_IVT; "WELLCHAINED_ELEMENTS",WELLCHAINED_ELEMENTS; "WELLCHAINED_INTERS",WELLCHAINED_INTERS; "WELLCHAINED_SETS",WELLCHAINED_SETS; "WF",WF; "WF_ANTISYM",WF_ANTISYM; "WF_CARD_LT",WF_CARD_LT; "WF_DCHAIN",WF_DCHAIN; "WF_EQ",WF_EQ; "WF_EREC",WF_EREC; "WF_FALSE",WF_FALSE; "WF_FINITE",WF_FINITE; "WF_IND",WF_IND; "WF_INSEG_WOSET",WF_INSEG_WOSET; "WF_INT_MEASURE",WF_INT_MEASURE; "WF_INT_MEASURE_2",WF_INT_MEASURE_2; "WF_LEX",WF_LEX; "WF_LEX_DEPENDENT",WF_LEX_DEPENDENT; "WF_MEASURE",WF_MEASURE; "WF_MEASURE_GEN",WF_MEASURE_GEN; "WF_POINTWISE",WF_POINTWISE; "WF_PSUBSET",WF_PSUBSET; "WF_REC",WF_REC; "WF_REC_CASES",WF_REC_CASES; "WF_REC_CASES'",WF_REC_CASES'; "WF_REC_EXISTS",WF_REC_EXISTS; "WF_REC_INVARIANT",WF_REC_INVARIANT; "WF_REC_TAIL",WF_REC_TAIL; "WF_REC_TAIL_GENERAL",WF_REC_TAIL_GENERAL; "WF_REC_TAIL_GENERAL'",WF_REC_TAIL_GENERAL'; "WF_REC_WF",WF_REC_WF; "WF_REC_num",WF_REC_num; "WF_REFL",WF_REFL; "WF_SUBSET",WF_SUBSET; "WF_UREC",WF_UREC; "WF_UREC_WF",WF_UREC_WF; "WF_num",WF_num; "WIENER_COVERING_LEMMA_BALLS",WIENER_COVERING_LEMMA_BALLS; "WIENER_COVERING_LEMMA_CBALLS",WIENER_COVERING_LEMMA_CBALLS; "WINDING_NUMBER",WINDING_NUMBER; "WINDING_NUMBER_AHLFORS",WINDING_NUMBER_AHLFORS; "WINDING_NUMBER_AHLFORS_FULL",WINDING_NUMBER_AHLFORS_FULL; "WINDING_NUMBER_AHLFORS_LEMMA",WINDING_NUMBER_AHLFORS_LEMMA; "WINDING_NUMBER_AROUND_INSIDE",WINDING_NUMBER_AROUND_INSIDE; "WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM",WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM; "WINDING_NUMBER_BIG_MEETS",WINDING_NUMBER_BIG_MEETS; "WINDING_NUMBER_CIRCLEPATH",WINDING_NUMBER_CIRCLEPATH; "WINDING_NUMBER_COMPOSE_CEXP",WINDING_NUMBER_COMPOSE_CEXP; "WINDING_NUMBER_CONSTANT",WINDING_NUMBER_CONSTANT; "WINDING_NUMBER_EQ",WINDING_NUMBER_EQ; "WINDING_NUMBER_EQUAL",WINDING_NUMBER_EQUAL; "WINDING_NUMBER_EQ_1",WINDING_NUMBER_EQ_1; "WINDING_NUMBER_FROM_INNERPATH",WINDING_NUMBER_FROM_INNERPATH; "WINDING_NUMBER_HOMOTOPIC_LOOPS",WINDING_NUMBER_HOMOTOPIC_LOOPS; "WINDING_NUMBER_HOMOTOPIC_LOOPS_EQ",WINDING_NUMBER_HOMOTOPIC_LOOPS_EQ; "WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ",WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ; "WINDING_NUMBER_HOMOTOPIC_PATHS",WINDING_NUMBER_HOMOTOPIC_PATHS; "WINDING_NUMBER_HOMOTOPIC_PATHS_EQ",WINDING_NUMBER_HOMOTOPIC_PATHS_EQ; "WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ",WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ; "WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ",WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ; "WINDING_NUMBER_IVT_ABS",WINDING_NUMBER_IVT_ABS; "WINDING_NUMBER_IVT_NEG",WINDING_NUMBER_IVT_NEG; "WINDING_NUMBER_IVT_POS",WINDING_NUMBER_IVT_POS; "WINDING_NUMBER_JOIN",WINDING_NUMBER_JOIN; "WINDING_NUMBER_JOIN_POS_COMBINED",WINDING_NUMBER_JOIN_POS_COMBINED; "WINDING_NUMBER_LE_HALF",WINDING_NUMBER_LE_HALF; "WINDING_NUMBER_LINEPATH_POS_LT",WINDING_NUMBER_LINEPATH_POS_LT; "WINDING_NUMBER_LOOPS_LINEAR_EQ",WINDING_NUMBER_LOOPS_LINEAR_EQ; "WINDING_NUMBER_LT_1",WINDING_NUMBER_LT_1; "WINDING_NUMBER_LT_HALF",WINDING_NUMBER_LT_HALF; "WINDING_NUMBER_LT_HALF_LINEPATH",WINDING_NUMBER_LT_HALF_LINEPATH; "WINDING_NUMBER_NEARBY_LOOPS_EQ",WINDING_NUMBER_NEARBY_LOOPS_EQ; "WINDING_NUMBER_NEARBY_PATHS_EQ",WINDING_NUMBER_NEARBY_PATHS_EQ; "WINDING_NUMBER_OFFSET",WINDING_NUMBER_OFFSET; "WINDING_NUMBER_PARTCIRCLEPATH",WINDING_NUMBER_PARTCIRCLEPATH; "WINDING_NUMBER_PARTCIRCLEPATH_POS_LT",WINDING_NUMBER_PARTCIRCLEPATH_POS_LT; "WINDING_NUMBER_PATHS_LINEAR_EQ",WINDING_NUMBER_PATHS_LINEAR_EQ; "WINDING_NUMBER_POS_LE",WINDING_NUMBER_POS_LE; "WINDING_NUMBER_POS_LT",WINDING_NUMBER_POS_LT; "WINDING_NUMBER_POS_LT_LEMMA",WINDING_NUMBER_POS_LT_LEMMA; "WINDING_NUMBER_POS_MEETS",WINDING_NUMBER_POS_MEETS; "WINDING_NUMBER_REVERSEPATH",WINDING_NUMBER_REVERSEPATH; "WINDING_NUMBER_SHIFTPATH",WINDING_NUMBER_SHIFTPATH; "WINDING_NUMBER_SPLIT_LINEPATH",WINDING_NUMBER_SPLIT_LINEPATH; "WINDING_NUMBER_STRONG",WINDING_NUMBER_STRONG; "WINDING_NUMBER_SUBPATH_COMBINE",WINDING_NUMBER_SUBPATH_COMBINE; "WINDING_NUMBER_SUBPATH_CONTINUOUS",WINDING_NUMBER_SUBPATH_CONTINUOUS; "WINDING_NUMBER_TRIANGLE",WINDING_NUMBER_TRIANGLE; "WINDING_NUMBER_TRIVIAL",WINDING_NUMBER_TRIVIAL; "WINDING_NUMBER_UNIQUE",WINDING_NUMBER_UNIQUE; "WINDING_NUMBER_UNIQUE_LOOP",WINDING_NUMBER_UNIQUE_LOOP; "WINDING_NUMBER_VALID_PATH",WINDING_NUMBER_VALID_PATH; "WINDING_NUMBER_ZERO_ATINFINITY",WINDING_NUMBER_ZERO_ATINFINITY; "WINDING_NUMBER_ZERO_IN_OUTSIDE",WINDING_NUMBER_ZERO_IN_OUTSIDE; "WINDING_NUMBER_ZERO_OUTSIDE",WINDING_NUMBER_ZERO_OUTSIDE; "WINDING_NUMBER_ZERO_POINT",WINDING_NUMBER_ZERO_POINT; "WITHIN",WITHIN; "WITHINREAL_UNIV",WITHINREAL_UNIV; "WITHIN_UNIV",WITHIN_UNIV; "WITHIN_WITHIN",WITHIN_WITHIN; "WLOG_LE",WLOG_LE; "WLOG_LINEAR_INJECTIVE_IMAGE",WLOG_LINEAR_INJECTIVE_IMAGE; "WLOG_LINEAR_INJECTIVE_IMAGE_2",WLOG_LINEAR_INJECTIVE_IMAGE_2; "WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT; "WLOG_LINEAR_INJECTIVE_IMAGE_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_ALT; "WLOG_LT",WLOG_LT; "WLOG_RELATION",WLOG_RELATION; "WO",WO; "WOSET",WOSET; "WOSET_ANTISYM",WOSET_ANTISYM; "WOSET_FINITE_TOSET",WOSET_FINITE_TOSET; "WOSET_FLEQ",WOSET_FLEQ; "WOSET_INSEG_ORDINAL",WOSET_INSEG_ORDINAL; "WOSET_POSET",WOSET_POSET; "WOSET_REFL",WOSET_REFL; "WOSET_TOTAL",WOSET_TOTAL; "WOSET_TOTAL_LE",WOSET_TOTAL_LE; "WOSET_TOTAL_LT",WOSET_TOTAL_LT; "WOSET_TRANS",WOSET_TRANS; "WOSET_TRANS_LE",WOSET_TRANS_LE; "WOSET_TRANS_LESS",WOSET_TRANS_LESS; "WOSET_WELL",WOSET_WELL; "WOSET_WELL_CONTRAPOS",WOSET_WELL_CONTRAPOS; "WOSET_WF",WOSET_WF; "WO_ORDINAL",WO_ORDINAL; "YOUNG_INEQUALITY",YOUNG_INEQUALITY; "ZBOT",ZBOT; "ZCONSTR",ZCONSTR; "ZCONSTR_ZBOT",ZCONSTR_ZBOT; "ZERO_AE_DERIVATIVE_IMP_CONSTANT",ZERO_AE_DERIVATIVE_IMP_CONSTANT; "ZERO_AE_DERIVATIVE_IMP_CONSTANT_GEN",ZERO_AE_DERIVATIVE_IMP_CONSTANT_GEN; "ZERO_DEF",ZERO_DEF; "ZIP",ZIP; "ZIP_DEF",ZIP_DEF; "ZL",ZL; "ZL_SUBSETS",ZL_SUBSETS; "ZL_SUBSETS_UNIONS",ZL_SUBSETS_UNIONS; "ZL_SUBSETS_UNIONS_NONEMPTY",ZL_SUBSETS_UNIONS_NONEMPTY; "ZRECSPACE_CASES",ZRECSPACE_CASES; "ZRECSPACE_INDUCT",ZRECSPACE_INDUCT; "ZRECSPACE_RULES",ZRECSPACE_RULES; "_FALSITY_",_FALSITY_; "_FUNCTION",_FUNCTION; "_GUARDED_PATTERN",_GUARDED_PATTERN; "_MATCH",_MATCH; "_SEQPATTERN",_SEQPATTERN; "_UNGUARDED_PATTERN",_UNGUARDED_PATTERN; "absolutely_continuous_on",absolutely_continuous_on; "absolutely_integrable_on",absolutely_integrable_on; "absolutely_real_integrable_on",absolutely_real_integrable_on; "absolutely_setcontinuous_on",absolutely_setcontinuous_on; "acs",acs; "add_c",add_c; "adjoint",adjoint; "admissible",admissible; "aff_dim",aff_dim; "affine",affine; "affine_dependent",affine_dependent; "analytic",analytic; "analytic_on",analytic_on; "arc",arc; "asn",asn; "at",at; "at_infinity",at_infinity; "at_neginfinity",at_neginfinity; "at_posinfinity",at_posinfinity; "atn",atn; "atreal",atreal; "baire",baire; "ball",ball; "barycentre",barycentre; "basis",basis; "bernoulli",bernoulli; "bernoulli_number",bernoulli_number; "bernstein",bernstein; "between",between; "bilinear",bilinear; "binarysum",binarysum; "binom",binom; "bitset",bitset; "bool_INDUCT",bool_INDUCT; "bool_RECURSION",bool_RECURSION; "borel_CASES",borel_CASES; "borel_INDUCT",borel_INDUCT; "borel_RULES",borel_RULES; "borel_measurable_CASES",borel_measurable_CASES; "borel_measurable_INDUCT",borel_measurable_INDUCT; "borel_measurable_RULES",borel_measurable_RULES; "borsukian",borsukian; "bounded",bounded; "brouwer_degree2",brouwer_degree2; "brouwer_degree3",brouwer_degree3; "cacs",cacs; "cart_tybij",cart_tybij; "casn",casn; "catn",catn; "cauchy",cauchy; "cauchy_in",cauchy_in; "cball",cball; "ccos",ccos; "cexp",cexp; "cfunspace",cfunspace; "chain",chain; "char_INDUCT",char_INDUCT; "char_RECURSION",char_RECURSION; "circlepath",circlepath; "clog",clog; "closed",closed; "closed_in",closed_in; "closed_interval",closed_interval; "closed_path",closed_path; "closed_real_interval",closed_real_interval; "closed_real_segment",closed_real_segment; "closed_segment",closed_segment; "closest_point",closest_point; "closure",closure; "closure_of",closure_of; "cnj",cnj; "codeset",codeset; "cofactor",cofactor; "collinear",collinear; "column",column; "columns",columns; "columnvector",columnvector; "compact",compact; "compact_in",compact_in; "complete",complete; "complex",complex; "complex_add",complex_add; "complex_derivative",complex_derivative; "complex_differentiable",complex_differentiable; "complex_div",complex_div; "complex_integer",complex_integer; "complex_inv",complex_inv; "complex_mul",complex_mul; "complex_neg",complex_neg; "complex_norm",complex_norm; "complex_pow",complex_pow; "complex_sub",complex_sub; "components",components; "condensation_point_of",condensation_point_of; "cong",cong; "conic",conic; "connected",connected; "connected_component",connected_component; "content",content; "continuous",continuous; "continuous_at",continuous_at; "continuous_atreal",continuous_atreal; "continuous_on",continuous_on; "continuous_within",continuous_within; "continuous_withinreal",continuous_withinreal; "contractible",contractible; "convex",convex; "convex_cone",convex_cone; "convex_on",convex_on; "coplanar",coplanar; "cos",cos; "covering_space",covering_space; "cpow",cpow; "cproduct",cproduct; "csin",csin; "csqrt",csqrt; "ctan",ctan; "dependent",dependent; "derived_set_of",derived_set_of; "dest_int_rep",dest_int_rep; "det",det; "diagonal_matrix",diagonal_matrix; "diameter",diameter; "differentiable",differentiable; "differentiable_on",differentiable_on; "dim",dim; "dimension",dimension; "dimindex",dimindex; "dist",dist; "divides",divides; "division_of",division_of; "division_points",division_points; "dot",dot; "drop",drop; "dropout",dropout; "edge_of",edge_of; "epigraph",epigraph; "eq_c",eq_c; "equiintegrable_on",equiintegrable_on; "euclidean",euclidean; "euclidean_metric",euclidean_metric; "euclideanreal",euclideanreal; "evenperm",evenperm; "eventually",eventually; "exp",exp; "exp_c",exp_c; "exposed_face_of",exposed_face_of; "extreme_point_of",extreme_point_of; "face_of",face_of; "facet_of",facet_of; "fine",fine; "finite_diff_tybij",finite_diff_tybij; "finite_image_tybij",finite_image_tybij; "finite_index",finite_index; "finite_prod_tybij",finite_prod_tybij; "finite_sum_tybij",finite_sum_tybij; "fl",fl; "frechet_derivative",frechet_derivative; "from",from; "frontier",frontier; "frontier_of",frontier_of; "fsigma",fsigma; "fstcart",fstcart; "fundamental_group",fundamental_group; "funspace",funspace; "gauge",gauge; "gdelta",gdelta; "ge_c",ge_c; "geom_mul",geom_mul; "grade",grade; "gt_c",gt_c; "has_bounded_real_variation_on",has_bounded_real_variation_on; "has_bounded_setvariation_on",has_bounded_setvariation_on; "has_bounded_variation_on",has_bounded_variation_on; "has_complex_derivative",has_complex_derivative; "has_derivative",has_derivative; "has_derivative_at",has_derivative_at; "has_derivative_within",has_derivative_within; "has_integral",has_integral; "has_integral_alt",has_integral_alt; "has_integral_compact_interval",has_integral_compact_interval; "has_integral_def",has_integral_def; "has_measure",has_measure; "has_path_integral",has_path_integral; "has_real_derivative",has_real_derivative; "has_real_integral",has_real_integral; "has_real_measure",has_real_measure; "has_vector_derivative",has_vector_derivative; "hausdist",hausdist; "higher_complex_derivative",higher_complex_derivative; "higher_complex_derivative_alt",higher_complex_derivative_alt; "higher_real_derivative",higher_real_derivative; "holomorphic_on",holomorphic_on; "homeomorphic",homeomorphic; "homeomorphism",homeomorphism; "homotopic_loops",homotopic_loops; "homotopic_paths",homotopic_paths; "homotopic_with",homotopic_with; "homotopy_equivalent",homotopy_equivalent; "hreal_add",hreal_add; "hreal_add_th",hreal_add_th; "hreal_inv",hreal_inv; "hreal_inv_th",hreal_inv_th; "hreal_le",hreal_le; "hreal_le_th",hreal_le_th; "hreal_mul",hreal_mul; "hreal_mul_th",hreal_mul_th; "hreal_of_num",hreal_of_num; "hreal_of_num_th",hreal_of_num_th; "hull",hull; "ii",ii; "in_direction",in_direction; "independent",independent; "indicator",indicator; "inf",inf; "infnorm",infnorm; "infsum",infsum; "inner",inner; "inseg",inseg; "inside",inside; "int_abs",int_abs; "int_abs_th",int_abs_th; "int_abstr",int_abstr; "int_add",int_add; "int_add_th",int_add_th; "int_congruent",int_congruent; "int_coprime",int_coprime; "int_divides",int_divides; "int_eq",int_eq; "int_gcd",int_gcd; "int_ge",int_ge; "int_gt",int_gt; "int_le",int_le; "int_lt",int_lt; "int_max",int_max; "int_max_th",int_max_th; "int_min",int_min; "int_min_th",int_min_th; "int_mod",int_mod; "int_mul",int_mul; "int_mul_th",int_mul_th; "int_neg",int_neg; "int_neg_th",int_neg_th; "int_of_num",int_of_num; "int_of_num_th",int_of_num_th; "int_pow",int_pow; "int_pow_th",int_pow_th; "int_rep",int_rep; "int_sgn",int_sgn; "int_sgn_th",int_sgn_th; "int_sub",int_sub; "int_sub_th",int_sub_th; "int_tybij",int_tybij; "integer",integer; "integrable_on",integrable_on; "integral",integral; "interior",interior; "interior_of",interior_of; "interval",interval; "interval_bij",interval_bij; "interval_lowerbound",interval_lowerbound; "interval_upperbound",interval_upperbound; "inverse",inverse; "invertible",invertible; "is_int",is_int; "is_interval",is_interval; "is_metric_space",is_metric_space; "is_nadd",is_nadd; "is_nadd_0",is_nadd_0; "is_realinterval",is_realinterval; "istopology",istopology; "iterate",iterate; "jacobian",jacobian; "joinpaths",joinpaths; "lambda",lambda; "lambdas",lambdas; "le_c",le_c; "lebesgue_measurable",lebesgue_measurable; "lemma",lemma; "less",less; "lift",lift; "lifted",lifted; "lim",lim; "limit",limit; "limit_point_of",limit_point_of; "linear",linear; "linepath",linepath; "linseg",linseg; "list_CASES",list_CASES; "list_INDUCT",list_INDUCT; "list_RECURSION",list_RECURSION; "list_of_seq",list_of_seq; "list_of_set",list_of_set; "locally",locally; "log_convex_on",log_convex_on; "log_def",log_def; "lt_c",lt_c; "manhattan",manhattan; "maprows",maprows; "mat",mat; "matrix",matrix; "matrix_add",matrix_add; "matrix_cmul",matrix_cmul; "matrix_inv",matrix_inv; "matrix_mul",matrix_mul; "matrix_neg",matrix_neg; "matrix_sub",matrix_sub; "matrix_vector_mul",matrix_vector_mul; "mball",mball; "mbasis",mbasis; "mbounded",mbounded; "mcball",mcball; "mcomplete",mcomplete; "mdist",mdist; "measurable",measurable; "measurable_on",measurable_on; "measure",measure; "metric_tybij",metric_tybij; "midpoint",midpoint; "minimal",minimal; "mk_pair_def",mk_pair_def; "moebius_function",moebius_function; "monoidal",monoidal; "mspace",mspace; "msphere",msphere; "mtopology",mtopology; "mul_c",mul_c; "multivec",multivec; "multivector",multivector; "multivector_tybij",multivector_tybij; "multivector_tybij_th",multivector_tybij_th; "nadd_abs",nadd_abs; "nadd_add",nadd_add; "nadd_eq",nadd_eq; "nadd_inv",nadd_inv; "nadd_le",nadd_le; "nadd_mul",nadd_mul; "nadd_of_num",nadd_of_num; "nadd_rep",nadd_rep; "nadd_rinv",nadd_rinv; "negligible",negligible; "net_tybij",net_tybij; "netlimit",netlimit; "neutral",neutral; "nproduct",nproduct; "nsum",nsum; "num_Axiom",num_Axiom; "num_CASES",num_CASES; "num_FINITE",num_FINITE; "num_FINITE_AVOID",num_FINITE_AVOID; "num_INDUCTION",num_INDUCTION; "num_INFINITE",num_INFINITE; "num_INFINITE_EQ",num_INFINITE_EQ; "num_MAX",num_MAX; "num_RECURSION",num_RECURSION; "num_RECURSION_STD",num_RECURSION_STD; "num_WF",num_WF; "num_WOP",num_WOP; "num_congruent",num_congruent; "num_coprime",num_coprime; "num_divides",num_divides; "num_gcd",num_gcd; "num_mod",num_mod; "num_of_int",num_of_int; "numseg",numseg; "o_ASSOC",o_ASSOC; "o_DEF",o_DEF; "o_THM",o_THM; "one",one; "one_Axiom",one_Axiom; "one_DEF",one_DEF; "one_INDUCT",one_INDUCT; "one_RECURSION",one_RECURSION; "one_axiom",one_axiom; "one_tydef",one_tydef; "onorm",onorm; "open_def",open_def; "open_in",open_in; "open_interval",open_interval; "open_real_interval",open_real_interval; "open_real_segment",open_real_segment; "open_segment",open_segment; "operative",operative; "option_INDUCT",option_INDUCT; "option_RECURSION",option_RECURSION; "ordinal",ordinal; "orthogonal",orthogonal; "orthogonal_matrix",orthogonal_matrix; "orthogonal_transformation",orthogonal_transformation; "outer",outer; "outermorphism",outermorphism; "outside",outside; "pair_INDUCT",pair_INDUCT; "pair_RECURSION",pair_RECURSION; "pairwise",pairwise; "partcirclepath",partcirclepath; "pastecart",pastecart; "path",path; "path_component",path_component; "path_connected",path_connected; "path_image",path_image; "path_integrable_on",path_integrable_on; "path_integral",path_integral; "path_length",path_length; "pathfinish",pathfinish; "pathstart",pathstart; "permutation",permutation; "permutes",permutes; "pi",pi; "piecewise_differentiable_on",piecewise_differentiable_on; "polyhedron",polyhedron; "polynomial_function",polynomial_function; "polytope",polytope; "poset",poset; "positive_definite",positive_definite; "positive_semidefinite",positive_semidefinite; "prod_tybij",prod_tybij; "product",product; "pushin",pushin; "rank",rank; "rational",rational; "real",real; "real_INFINITE",real_INFINITE; "real_abs",real_abs; "real_add",real_add; "real_add_th",real_add_th; "real_bounded",real_bounded; "real_closed",real_closed; "real_compact",real_compact; "real_continuous",real_continuous; "real_continuous_at",real_continuous_at; "real_continuous_atreal",real_continuous_atreal; "real_continuous_on",real_continuous_on; "real_continuous_within",real_continuous_within; "real_continuous_withinreal",real_continuous_withinreal; "real_convex_on",real_convex_on; "real_derivative",real_derivative; "real_differentiable",real_differentiable; "real_differentiable_on",real_differentiable_on; "real_div",real_div; "real_euclidean_metric",real_euclidean_metric; "real_ge",real_ge; "real_gt",real_gt; "real_infsum",real_infsum; "real_integrable_on",real_integrable_on; "real_integral",real_integral; "real_interval",real_interval; "real_inv",real_inv; "real_inv_th",real_inv_th; "real_le",real_le; "real_le_th",real_le_th; "real_lebesgue_measurable",real_lebesgue_measurable; "real_log_convex_on",real_log_convex_on; "real_lt",real_lt; "real_max",real_max; "real_measurable",real_measurable; "real_measurable_on",real_measurable_on; "real_measure",real_measure; "real_min",real_min; "real_mod",real_mod; "real_mul",real_mul; "real_mul_th",real_mul_th; "real_neg",real_neg; "real_neg_th",real_neg_th; "real_negligible",real_negligible; "real_of_num",real_of_num; "real_of_num_th",real_of_num_th; "real_open",real_open; "real_polynomial_function_CASES",real_polynomial_function_CASES; "real_polynomial_function_INDUCT",real_polynomial_function_INDUCT; "real_polynomial_function_RULES",real_polynomial_function_RULES; "real_pow",real_pow; "real_segment",real_segment; "real_sgn",real_sgn; "real_sub",real_sub; "real_summable",real_summable; "real_sums",real_sums; "real_uniformly_continuous_on",real_uniformly_continuous_on; "real_variation",real_variation; "reallim",reallim; "rectifiable_path",rectifiable_path; "reflect_along",reflect_along; "relative_frontier",relative_frontier; "relative_interior",relative_interior; "relative_orientation",relative_orientation; "relative_to",relative_to; "retract_of",retract_of; "retraction",retraction; "reversepath",reversepath; "reversion",reversion; "root",root; "rotate2d",rotate2d; "rotation_matrix",rotation_matrix; "rotoinversion_matrix",rotoinversion_matrix; "row",row; "rows",rows; "rowvector",rowvector; "rpow",rpow; "segment",segment; "seqiterate",seqiterate; "seqiterate_EXISTS",seqiterate_EXISTS; "sequentially",sequentially; "set_of_list",set_of_list; "set_variation",set_variation; "setcode",setcode; "setdist",setdist; "shiftpath",shiftpath; "sign",sign; "simple_path",simple_path; "simplex",simplex; "simplicial_complex",simplicial_complex; "simply_connected",simply_connected; "sin",sin; "sindex",sindex; "slice",slice; "sndcart",sndcart; "span",span; "sphere",sphere; "sqrt",sqrt; "starlike",starlike; "string_INFINITE",string_INFINITE; "submetric",submetric; "subpath",subpath; "subspace",subspace; "subtopology",subtopology; "sum",sum; "sum_CASES",sum_CASES; "sum_DISTINCT",sum_DISTINCT; "sum_INDUCT",sum_INDUCT; "sum_INJECTIVE",sum_INJECTIVE; "sum_RECURSION",sum_RECURSION; "summable",summable; "sums",sums; "sup",sup; "superadmissible",superadmissible; "support",support; "suslin",suslin; "suslin_operation",suslin_operation; "swap",swap; "swapseq_CASES",swapseq_CASES; "swapseq_INDUCT",swapseq_INDUCT; "swapseq_RULES",swapseq_RULES; "tagged_division_of",tagged_division_of; "tagged_partial_division_of",tagged_partial_division_of; "tailadmissible",tailadmissible; "tan",tan; "tan_def",tan_def; "tendsto",tendsto; "tendsto_real",tendsto_real; "topcontinuous",topcontinuous; "topcontinuous_at",topcontinuous_at; "topology_tybij",topology_tybij; "topology_tybij_th",topology_tybij_th; "topspace",topspace; "toset",toset; "trace",trace; "transp",transp; "treal_add",treal_add; "treal_eq",treal_eq; "treal_inv",treal_inv; "treal_le",treal_le; "treal_mul",treal_mul; "treal_neg",treal_neg; "treal_of_num",treal_of_num; "triangulation",triangulation; "trivial_limit",trivial_limit; "unicoherent",unicoherent; "uniformly_continuous_on",uniformly_continuous_on; "unwinding",unwinding; "valid_path",valid_path; "vec",vec; "vector",vector; "vector_add",vector_add; "vector_derivative",vector_derivative; "vector_matrix_mul",vector_matrix_mul; "vector_mul",vector_mul; "vector_neg",vector_neg; "vector_norm",vector_norm; "vector_polynomial_function",vector_polynomial_function; "vector_sub",vector_sub; "vector_variation",vector_variation; "vertex_image",vertex_image; "vsum",vsum; "winding_number",winding_number; "within",within; "woset",woset ];; hol-light/Multivariate/complexes.ml000066400000000000000000002505711303454263000177560ustar00rootroot00000000000000(* ========================================================================= *) (* The type "real^2" regarded as the complex numbers. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Valentina Bruno 2010 *) (* ========================================================================= *) needs "Multivariate/convex.ml";; new_type_abbrev("complex",`:real^2`);; let prioritize_complex() = overload_interface("--",`vector_neg:complex->complex`); overload_interface("+",`vector_add:complex->complex->complex`); overload_interface("-",`vector_sub:complex->complex->complex`); overload_interface("*",`complex_mul:complex->complex->complex`); overload_interface("/",`complex_div:complex->complex->complex`); overload_interface("pow",`complex_pow:complex->num->complex`); overload_interface("inv",`complex_inv:complex->complex`);; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* Real and imaginary parts of a number. *) (* ------------------------------------------------------------------------- *) let RE_DEF = new_definition `Re(z:complex) = z$1`;; let IM_DEF = new_definition `Im(z:complex) = z$2`;; (* ------------------------------------------------------------------------- *) (* Real injection and imaginary unit. *) (* ------------------------------------------------------------------------- *) let complex = new_definition `complex(x,y) = vector[x;y]:complex`;; let CX_DEF = new_definition `Cx(a) = complex(a,&0)`;; let ii = new_definition `ii = complex(&0,&1)`;; (* ------------------------------------------------------------------------- *) (* Complex multiplication. *) (* ------------------------------------------------------------------------- *) let complex_mul = new_definition `w * z = complex(Re(w) * Re(z) - Im(w) * Im(z), Re(w) * Im(z) + Im(w) * Re(z))`;; let complex_inv = new_definition `inv(z) = complex(Re(z) / (Re(z) pow 2 + Im(z) pow 2), --(Im(z)) / (Re(z) pow 2 + Im(z) pow 2))`;; let complex_div = new_definition `w / z = w * inv(z)`;; let complex_pow = define `(x pow 0 = Cx(&1)) /\ (!n. x pow (SUC n) = x * x pow n)`;; (* ------------------------------------------------------------------------- *) (* Various handy rewrites. *) (* ------------------------------------------------------------------------- *) let RE = prove (`(Re(complex(x,y)) = x)`, REWRITE_TAC[RE_DEF; complex; VECTOR_2]);; let IM = prove (`Im(complex(x,y)) = y`, REWRITE_TAC[IM_DEF; complex; VECTOR_2]);; let COMPLEX_EQ = prove (`!w z. (w = z) <=> (Re(w) = Re(z)) /\ (Im(w) = Im(z))`, SIMP_TAC[CART_EQ; FORALL_2; DIMINDEX_2; RE_DEF; IM_DEF]);; let COMPLEX = prove (`!z. complex(Re(z),Im(z)) = z`, REWRITE_TAC[COMPLEX_EQ; RE; IM]);; let COMPLEX_EQ_0 = prove (`z = Cx(&0) <=> Re(z) pow 2 + Im(z) pow 2 = &0`, REWRITE_TAC[COMPLEX_EQ; CX_DEF; RE; IM] THEN EQ_TAC THEN SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `!x y:real. x + y = &0 ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE]);; let FORALL_COMPLEX = prove (`(!z. P z) <=> (!x y. P(complex(x,y)))`, MESON_TAC[COMPLEX]);; let EXISTS_COMPLEX = prove (`(?z. P z) <=> (?x y. P(complex(x,y)))`, MESON_TAC[COMPLEX]);; (* ------------------------------------------------------------------------- *) (* Pseudo-definitions of other general vector concepts over R^2. *) (* ------------------------------------------------------------------------- *) let complex_neg = prove (`--z = complex(--(Re(z)),--(Im(z)))`, REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN SIMP_TAC[VECTOR_NEG_COMPONENT; DIMINDEX_2; ARITH]);; let complex_add = prove (`w + z = complex(Re(w) + Re(z),Im(w) + Im(z))`, REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; DIMINDEX_2; ARITH]);; let complex_sub = VECTOR_ARITH `(w:complex) - z = w + --z`;; let complex_norm = prove (`norm(z) = sqrt(Re(z) pow 2 + Im(z) pow 2)`, REWRITE_TAC[vector_norm; dot; RE_DEF; IM_DEF; SUM_2; DIMINDEX_2] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let COMPLEX_SQNORM = prove (`norm(z) pow 2 = Re(z) pow 2 + Im(z) pow 2`, REWRITE_TAC[NORM_POW_2; dot; RE_DEF; IM_DEF; SUM_2; DIMINDEX_2] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Crude tactic to automate very simple algebraic equivalences. *) (* ------------------------------------------------------------------------- *) let SIMPLE_COMPLEX_ARITH_TAC = REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF; complex_add; complex_neg; complex_sub; complex_mul; complex_inv; complex_div] THEN CONV_TAC REAL_FIELD;; let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Basic algebraic properties that can be proved automatically by this. *) (* ------------------------------------------------------------------------- *) let COMPLEX_ADD_SYM = prove (`!x y. x + y = y + x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_ASSOC = prove (`!x y z. x + y + z = (x + y) + z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_LID = prove (`!x. Cx(&0) + x = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_LINV = prove (`!x. --x + x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_SYM = prove (`!x y. x * y = y * x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_ASSOC = prove (`!x y z. x * y * z = (x * y) * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_LID = prove (`!x. Cx(&1) * x = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_LDISTRIB = prove (`!x y z. x * (y + z) = x * y + x * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_AC = prove (`(m + n = n + m) /\ ((m + n) + p = m + n + p) /\ (m + n + p = n + m + p)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_AC = prove (`(m * n = n * m) /\ ((m * n) * p = m * n * p) /\ (m * n * p = n * m * p)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_RID = prove (`!x. x + Cx(&0) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_RID = prove (`!x. x * Cx(&1) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_RINV = prove (`!x. x + --x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_RDISTRIB = prove (`!x y z. (x + y) * z = x * z + y * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_LCANCEL = prove (`!x y z. (x + y = x + z) <=> (y = z)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_RCANCEL = prove (`!x y z. (x + z = y + z) <=> (x = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_RZERO = prove (`!x. x * Cx(&0) = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_LZERO = prove (`!x. Cx(&0) * x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_NEG = prove (`!x. --(--x) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_RNEG = prove (`!x y. x * --y = --(x * y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_LNEG = prove (`!x y. --x * y = --(x * y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_ADD = prove (`!x y. --(x + y) = --x + --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_0 = prove (`--Cx(&0) = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_LCANCEL_0 = prove (`!x y. (x + y = x) <=> (y = Cx(&0))`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_ADD_RCANCEL_0 = prove (`!x y. (x + y = y) <=> (x = Cx(&0))`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_LNEG_UNIQ = prove (`!x y. (x + y = Cx(&0)) <=> (x = --y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_RNEG_UNIQ = prove (`!x y. (x + y = Cx(&0)) <=> (y = --x)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_LMUL = prove (`!x y. --(x * y) = --x * y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_RMUL = prove (`!x y. --(x * y) = x * --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_MUL2 = prove (`!x y. --x * --y = x * y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_ADD = prove (`!x y. x - y + y = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_ADD2 = prove (`!x y. y + x - y = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_REFL = prove (`!x. x - x = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_0 = prove (`!x y. (x - y = Cx(&0)) <=> (x = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_EQ_0 = prove (`!x. (--x = Cx(&0)) <=> (x = Cx(&0))`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_SUB = prove (`!x y. --(x - y) = y - x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_SUB = prove (`!x y. (x + y) - x = y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_EQ = prove (`!x y. (--x = y) <=> (x = --y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NEG_MINUS1 = prove (`!x. --x = --Cx(&1) * x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_SUB = prove (`!x y. x - y - x = --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD2_SUB2 = prove (`!a b c d. (a + b) - (c + d) = a - c + b - d`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_LZERO = prove (`!x. Cx(&0) - x = --x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_RZERO = prove (`!x. x - Cx(&0) = x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_LNEG = prove (`!x y. --x - y = --(x + y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_RNEG = prove (`!x y. x - --y = x + y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_NEG2 = prove (`!x y. --x - --y = y - x`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_TRIANGLE = prove (`!a b c. a - b + b - c = a - c`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_SUB_LADD = prove (`!x y z. (x = y - z) <=> (x + z = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_SUB_RADD = prove (`!x y z. (x - y = z) <=> (x = z + y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_SUB2 = prove (`!x y. x - (x - y) = y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ADD_SUB2 = prove (`!x y. x - (x + y) = --y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_DIFFSQ = prove (`!x y. (x + y) * (x - y) = x * x - y * y`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_EQ_NEG2 = prove (`!x y. (--x = --y) <=> (x = y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_LDISTRIB = prove (`!x y z. x * (y - z) = x * y - x * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_SUB_RDISTRIB = prove (`!x y z. (x - y) * z = x * z - y * z`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_2 = prove (`!x. Cx(&2) * x = x + x`, SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Sometimes here we need to tweak non-zeroness assertions. *) (* ------------------------------------------------------------------------- *) let II_NZ = prove (`~(ii = Cx(&0))`, REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_LINV = prove (`!z. ~(z = Cx(&0)) ==> (inv(z) * z = Cx(&1))`, REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_ENTIRE = prove (`!x y. (x * y = Cx(&0)) <=> (x = Cx(&0)) \/ (y = Cx(&0))`, REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_MUL_RINV = prove (`!z. ~(z = Cx(&0)) ==> (z * inv(z) = Cx(&1))`, REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_DIV_REFL = prove (`!x. ~(x = Cx(&0)) ==> (x / x = Cx(&1))`, REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_VEC_0 = prove (`vec 0 = Cx(&0)`, SIMP_TAC[CART_EQ; VEC_COMPONENT; CX_DEF; complex; DIMINDEX_2; FORALL_2; VECTOR_2]);; let COMPLEX_CMUL = prove (`!c x. c % x = Cx(c) * x`, SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; CX_DEF; complex; complex_mul; DIMINDEX_2; FORALL_2; IM_DEF; RE_DEF; VECTOR_2] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* More about powers. *) (* ------------------------------------------------------------------------- *) let COMPLEX_POW_ADD = prove (`!x m n. x pow (m + n) = x pow m * x pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_ASSOC]);; let COMPLEX_POW_POW = prove (`!x m n. (x pow m) pow n = x pow (m * n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; MULT_CLAUSES; COMPLEX_POW_ADD]);; let COMPLEX_POW_1 = prove (`!x. x pow 1 = x`, REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID]);; let COMPLEX_POW_2 = prove (`!x. x pow 2 = x * x`, REWRITE_TAC[num_CONV `2`] THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1]);; let COMPLEX_POW_NEG = prove (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; EVEN] THEN ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG]);; let COMPLEX_POW_ONE = prove (`!n. Cx(&1) pow n = Cx(&1)`, INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID]);; let COMPLEX_POW_MUL = prove (`!x y n. (x * y) pow n = (x pow n) * (y pow n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_AC]);; let COMPLEX_POW_II_2 = prove (`ii pow 2 = --Cx(&1)`, REWRITE_TAC[ii; COMPLEX_POW_2; complex_mul; CX_DEF; RE; IM; complex_neg] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let COMPLEX_POW_EQ_0 = prove (`!x n. (x pow n = Cx(&0)) <=> (x = Cx(&0)) /\ ~(n = 0)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC; complex_pow; COMPLEX_ENTIRE] THENL [SIMPLE_COMPLEX_ARITH_TAC; CONV_TAC TAUT]);; let COMPLEX_POW_ZERO = prove (`!n. Cx(&0) pow n = if n = 0 then Cx(&1) else Cx(&0)`, INDUCT_TAC THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_LZERO; NOT_SUC]);; (* ------------------------------------------------------------------------- *) (* Homomorphic embedding properties for Cx mapping. *) (* ------------------------------------------------------------------------- *) let CX_INJ = prove (`!x y. (Cx(x) = Cx(y)) <=> (x = y)`, REWRITE_TAC[CX_DEF; COMPLEX_EQ; RE; IM]);; let CX_NEG = prove (`!x. Cx(--x) = --(Cx(x))`, REWRITE_TAC[CX_DEF; complex_neg; RE; IM; REAL_NEG_0]);; let CX_ADD = prove (`!x y. Cx(x + y) = Cx(x) + Cx(y)`, REWRITE_TAC[CX_DEF; complex_add; RE; IM; REAL_ADD_LID]);; let CX_SUB = prove (`!x y. Cx(x - y) = Cx(x) - Cx(y)`, REWRITE_TAC[complex_sub; real_sub; CX_ADD; CX_NEG]);; let CX_INV = prove (`!x. Cx(inv x) = inv(Cx x)`, GEN_TAC THEN REWRITE_TAC[CX_DEF; complex_inv; RE; IM; COMPLEX_EQ] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; let CX_MUL = prove (`!x y. Cx(x * y) = Cx(x) * Cx(y)`, REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_ADD_RID]);; let CX_POW = prove (`!x n. Cx(x pow n) = Cx(x) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; real_pow; CX_MUL]);; let CX_DIV = prove (`!x y. Cx(x / y) = Cx(x) / Cx(y)`, REWRITE_TAC[complex_div; real_div; CX_MUL; CX_INV]);; let CX_ABS = prove (`!x. Cx(abs x) = Cx(norm(Cx(x)))`, REWRITE_TAC[CX_DEF; complex_norm; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);; let COMPLEX_NORM_CX = prove (`!x. norm(Cx(x)) = abs(x)`, REWRITE_TAC[GSYM CX_INJ; CX_ABS]);; let DIST_CX = prove (`!x y. dist(Cx x,Cx y) = abs(x - y)`, REWRITE_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX]);; (* ------------------------------------------------------------------------- *) (* Some "linear" things hold for Re and Im too. *) (* ------------------------------------------------------------------------- *) let RE_CX = prove (`!x. Re(Cx x) = x`, REWRITE_TAC[RE; CX_DEF]);; let RE_NEG = prove (`!x. Re(--x) = --Re(x)`, REWRITE_TAC[complex_neg; RE]);; let RE_ADD = prove (`!x y. Re(x + y) = Re(x) + Re(y)`, REWRITE_TAC[complex_add; RE]);; let RE_SUB = prove (`!x y. Re(x - y) = Re(x) - Re(y)`, REWRITE_TAC[complex_sub; real_sub; RE_ADD; RE_NEG]);; let IM_CX = prove (`!x. Im(Cx x) = &0`, REWRITE_TAC[IM; CX_DEF]);; let IM_NEG = prove (`!x. Im(--x) = --Im(x)`, REWRITE_TAC[complex_neg; IM]);; let IM_ADD = prove (`!x y. Im(x + y) = Im(x) + Im(y)`, REWRITE_TAC[complex_add; IM]);; let IM_SUB = prove (`!x y. Im(x - y) = Im(x) - Im(y)`, REWRITE_TAC[complex_sub; real_sub; IM_ADD; IM_NEG]);; (* ------------------------------------------------------------------------- *) (* An "expansion" theorem into the traditional notation. *) (* ------------------------------------------------------------------------- *) let COMPLEX_EXPAND = prove (`!z. z = Cx(Re z) + ii * Cx(Im z)`, REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_TRAD = prove (`!x y. complex(x,y) = Cx(x) + ii * Cx(y)`, REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Real and complex parts of ii and multiples. *) (* ------------------------------------------------------------------------- *) let RE_II = prove (`Re ii = &0`, REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; let IM_II = prove (`Im ii = &1`, REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; let RE_MUL_II = prove (`!z. Re(z * ii) = --(Im z) /\ Re(ii * z) = --(Im z)`, REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; let IM_MUL_II = prove (`!z. Im(z * ii) = Re z /\ Im(ii * z) = Re z`, REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_NORM_II = prove (`norm ii = &1`, REWRITE_TAC[complex_norm; RE_II; IM_II] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_1]);; (* ------------------------------------------------------------------------- *) (* Limited "multiplicative" theorems for Re and Im. *) (* ------------------------------------------------------------------------- *) let RE_CMUL = prove (`!a z. Re(a % z) = a * Re z`, SIMP_TAC[RE_DEF; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH]);; let IM_CMUL = prove (`!a z. Im(a % z) = a * Im z`, SIMP_TAC[IM_DEF; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH]);; let RE_MUL_CX = prove (`!x z. Re(Cx(x) * z) = x * Re z /\ Re(z * Cx(x)) = Re z * x`, SIMPLE_COMPLEX_ARITH_TAC);; let IM_MUL_CX = prove (`!x z. Im(Cx(x) * z) = x * Im z /\ Im(z * Cx(x)) = Im z * x`, SIMPLE_COMPLEX_ARITH_TAC);; let RE_DIV_CX = prove (`!z x. Re(z / Cx(x)) = Re(z) / x`, REWRITE_TAC[complex_div; real_div; GSYM CX_INV; RE_MUL_CX]);; let IM_DIV_CX = prove (`!z x. Im(z / Cx(x)) = Im(z) / x`, REWRITE_TAC[complex_div; real_div; GSYM CX_INV; IM_MUL_CX]);; (* ------------------------------------------------------------------------- *) (* Syntax constructors etc. for complex constants. *) (* ------------------------------------------------------------------------- *) let is_complex_const = let cx_tm = `Cx` in fun tm -> is_comb tm & let l,r = dest_comb tm in l = cx_tm && is_ratconst r;; let dest_complex_const = let cx_tm = `Cx` in fun tm -> let l,r = dest_comb tm in if l = cx_tm then rat_of_term r else failwith "dest_complex_const";; let mk_complex_const = let cx_tm = `Cx` in fun r -> mk_comb(cx_tm,term_of_rat r);; (* ------------------------------------------------------------------------- *) (* Conversions for arithmetic on complex constants. *) (* ------------------------------------------------------------------------- *) let COMPLEX_RAT_EQ_CONV = GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;; let COMPLEX_RAT_MUL_CONV = GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;; let COMPLEX_RAT_ADD_CONV = GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;; let COMPLEX_RAT_POW_CONV = let x_tm = `x:real` and n_tm = `n:num` in let pth = SYM(SPECL [x_tm; n_tm] CX_POW) in fun tm -> let lop,r = dest_comb tm in let op,bod = dest_comb lop in let th1 = INST [rand bod,x_tm; r,n_tm] pth in let tm1,tm2 = dest_comb(concl th1) in if rand tm1 <> tm then failwith "COMPLEX_RAT_POW_CONV" else let tm3,tm4 = dest_comb tm2 in TRANS th1 (AP_TERM tm3 (REAL_RAT_REDUCE_CONV tm4));; (* ------------------------------------------------------------------------- *) (* Complex polynomial normalizer. *) (* ------------------------------------------------------------------------- *) let COMPLEX_POLY_CLAUSES = prove (`(!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. Cx(&0) + x = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x y. x * y = y * x) /\ (!x. Cx(&1) * x = x) /\ (!x. Cx(&0) * x = Cx(&0)) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x. x pow 0 = Cx(&1)) /\ (!x n. x pow (SUC n) = x * x pow n)`, REWRITE_TAC[complex_pow] THEN SIMPLE_COMPLEX_ARITH_TAC) and COMPLEX_POLY_NEG_CLAUSES = prove (`(!x. --x = Cx(-- &1) * x) /\ (!x y. x - y = x + Cx(-- &1) * y)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_POLY_NEG_CONV,COMPLEX_POLY_ADD_CONV,COMPLEX_POLY_SUB_CONV, COMPLEX_POLY_MUL_CONV,COMPLEX_POLY_POW_CONV,COMPLEX_POLY_CONV = SEMIRING_NORMALIZERS_CONV COMPLEX_POLY_CLAUSES COMPLEX_POLY_NEG_CLAUSES (is_complex_const, COMPLEX_RAT_ADD_CONV,COMPLEX_RAT_MUL_CONV,COMPLEX_RAT_POW_CONV) (<);; (* ------------------------------------------------------------------------- *) (* Extend it to handle "inv" and division, by constants after normalization. *) (* ------------------------------------------------------------------------- *) let COMPLEX_RAT_INV_CONV = REWR_CONV(GSYM CX_INV) THENC RAND_CONV REAL_RAT_INV_CONV;; let COMPLEX_POLY_CONV = let neg_tm = `(--):complex->complex` and inv_tm = `inv:complex->complex` and add_tm = `(+):complex->complex->complex` and sub_tm = `(-):complex->complex->complex` and mul_tm = `(*):complex->complex->complex` and div_tm = `(/):complex->complex->complex` and pow_tm = `(pow):complex->num->complex` and div_conv = REWR_CONV complex_div in let rec COMPLEX_POLY_CONV tm = if not(is_comb tm) || is_ratconst tm then REFL tm else let lop,r = dest_comb tm in if lop = neg_tm then let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in TRANS th1 (COMPLEX_POLY_NEG_CONV (rand(concl th1))) else if lop = inv_tm then let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in TRANS th1 (TRY_CONV COMPLEX_RAT_INV_CONV (rand(concl th1))) else if not(is_comb lop) then REFL tm else let op,l = dest_comb lop in if op = pow_tm then let th1 = AP_THM (AP_TERM op (COMPLEX_POLY_CONV l)) r in TRANS th1 (TRY_CONV COMPLEX_POLY_POW_CONV (rand(concl th1))) else if op = add_tm || op = mul_tm || op = sub_tm then let th1 = MK_COMB(AP_TERM op (COMPLEX_POLY_CONV l), COMPLEX_POLY_CONV r) in let fn = if op = add_tm then COMPLEX_POLY_ADD_CONV else if op = mul_tm then COMPLEX_POLY_MUL_CONV else COMPLEX_POLY_SUB_CONV in TRANS th1 (fn (rand(concl th1))) else if op = div_tm then let th1 = div_conv tm in TRANS th1 (COMPLEX_POLY_CONV (rand(concl th1))) else REFL tm in COMPLEX_POLY_CONV;; (* ------------------------------------------------------------------------- *) (* Complex number version of usual ring procedure. *) (* ------------------------------------------------------------------------- *) let COMPLEX_RING,complex_ideal_cofactors = let COMPLEX_INTEGRAL = prove (`(!x. Cx(&0) * x = Cx(&0)) /\ (!x y z. (x + y = x + z) <=> (y = z)) /\ (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, REWRITE_TAC[COMPLEX_ENTIRE; SIMPLE_COMPLEX_ARITH `(w * y + x * z = w * z + x * y) <=> (w - x) * (y - z) = Cx(&0)`] THEN SIMPLE_COMPLEX_ARITH_TAC) and COMPLEX_RABINOWITSCH = prove (`!x y:complex. ~(x = y) <=> ?z. (x - y) * z = Cx(&1)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_SUB_0] THEN MESON_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LZERO; SIMPLE_COMPLEX_ARITH `~(Cx(&1) = Cx(&0))`]) and COMPLEX_IIII = prove (`ii * ii + Cx(&1) = Cx(&0)`, REWRITE_TAC[ii; CX_DEF; complex_mul; complex_add; RE; IM] THEN AP_TERM_TAC THEN BINOP_TAC THEN REAL_ARITH_TAC) in let ring,ideal = RING_AND_IDEAL_CONV (dest_complex_const,mk_complex_const,COMPLEX_RAT_EQ_CONV, `(--):complex->complex`,`(+):complex->complex->complex`, `(-):complex->complex->complex`,`(inv):complex->complex`, `(*):complex->complex->complex`,`(/):complex->complex->complex`, `(pow):complex->num->complex`, COMPLEX_INTEGRAL,COMPLEX_RABINOWITSCH,COMPLEX_POLY_CONV) and ii_tm = `ii` and iiii_tm = concl COMPLEX_IIII in (fun tm -> if free_in ii_tm tm then MP (ring (mk_imp(iiii_tm,tm))) COMPLEX_IIII else ring tm), ideal;; (* ------------------------------------------------------------------------- *) (* Most basic properties of inverses. *) (* ------------------------------------------------------------------------- *) let COMPLEX_INV_0 = prove (`inv(Cx(&0)) = Cx(&0)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_INV_1 = prove (`inv(Cx(&1)) = Cx(&1)`, SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_INV_MUL = prove (`!w z. inv(w * z) = inv(w) * inv(z)`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`w = Cx(&0)`; `z = Cx(&0)`] THEN ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);; let COMPLEX_POW_INV = prove (`!x n. (inv x) pow n = inv(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_INV_1; COMPLEX_INV_MUL]);; let COMPLEX_INV_INV = prove (`!x:complex. inv(inv x) = x`, GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_INV_0] THEN POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> MP_TAC(SPEC t COMPLEX_MUL_RINV)) [`x:complex`; `inv(x):complex`] THEN CONV_TAC COMPLEX_RING);; let COMPLEX_INV_DIV = prove (`!w z:complex. inv(w / z) = z / w`, REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; let COMPLEX_EQ_INV2 = prove (`!w x:complex. inv w = inv z <=> w = z`, MESON_TAC[COMPLEX_INV_INV]);; let SGN_RE_COMPLEX_INV = prove (`!z. real_sgn(Re(inv z)) = real_sgn(Re z)`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_INV_0] THEN REWRITE_TAC[RE; complex_inv; REAL_SGN_DIV] THEN SUBGOAL_THEN `real_sgn (Re z pow 2 + Im z pow 2) = &1` (fun th -> REWRITE_TAC[REAL_DIV_1; th]) THEN REWRITE_TAC[REAL_SGN_EQ; real_gt; GSYM COMPLEX_SQNORM] THEN ASM_SIMP_TAC[REAL_POW_LT; NORM_POS_LT; COMPLEX_VEC_0]);; let RE_COMPLEX_INV_GT_0 = prove (`!z. &0 < Re(inv z) <=> &0 < Re z`, REWRITE_TAC[GSYM real_gt; GSYM REAL_SGN_EQ; SGN_RE_COMPLEX_INV]);; let RE_COMPLEX_INV_GE_0 = prove (`!z. &0 <= Re(inv z) <=> &0 <= Re z`, REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[GSYM REAL_SGN_EQ; SGN_RE_COMPLEX_INV]);; (* ------------------------------------------------------------------------- *) (* And also field procedure. *) (* ------------------------------------------------------------------------- *) let COMPLEX_EQ_MUL_LCANCEL = prove (`!x y z. (x * y = x * z) <=> (x = Cx(&0)) \/ (y = z)`, CONV_TAC COMPLEX_RING);; let COMPLEX_EQ_MUL_RCANCEL = prove (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = Cx(&0))`, CONV_TAC COMPLEX_RING);; let COMPLEX_FIELD = let norm_net = itlist (net_of_thm false o SPEC_ALL) [FORALL_SIMP; EXISTS_SIMP; complex_div; COMPLEX_INV_INV; COMPLEX_INV_MUL; COMPLEX_POW_ADD] (net_of_conv `inv((x:complex) pow n)` (REWR_CONV(GSYM COMPLEX_POW_INV) o check (is_numeral o rand o rand)) empty_net) and easy_nz_conv = LAND_CONV (GEN_REWRITE_CONV TRY_CONV[MESON[COMPLEX_POW_EQ_0; REAL_OF_NUM_EQ; CX_INJ] `~(x pow n = Cx(&0)) <=> ~((x:complex) = Cx(&0)) \/ (Cx(&n) = Cx(&0)) \/ ~(x pow n = Cx(&0))`] THENC TOP_DEPTH_CONV(REWR_CONV CX_INJ THENC REAL_RAT_EQ_CONV)) THENC GEN_REWRITE_CONV TRY_CONV [TAUT `(T ==> p) <=> p`] in let prenex_conv = TOP_DEPTH_CONV BETA_CONV THENC NUM_REDUCE_CONV THENC TOP_DEPTH_CONV(REWRITES_CONV norm_net) THENC NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC PRENEX_CONV and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV and is_inv = let inv_tm = `inv:complex->complex` and is_div = is_binop `(/):complex->complex->complex` in fun tm -> (is_div tm || (is_comb tm && rator tm = inv_tm)) & not(is_ratconst(rand tm)) in let BASIC_COMPLEX_FIELD tm = let is_freeinv t = is_inv t && free_in t tm in let itms = setify(map rand (find_terms is_freeinv tm)) in let hyps = map (fun t -> CONV_RULE easy_nz_conv (SPEC t COMPLEX_MUL_RINV)) itms in let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in let th1 = setup_conv tm' in let cjs = conjuncts(rand(concl th1)) in let ths = map COMPLEX_RING cjs in let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in rev_itlist (C MP) hyps th2 in fun tm -> let th0 = prenex_conv tm in let tm0 = rand(concl th0) in let avs,bod = strip_forall tm0 in let th1 = setup_conv bod in let ths = map BASIC_COMPLEX_FIELD (conjuncts(rand(concl th1))) in EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; (* ------------------------------------------------------------------------- *) (* More trivial lemmas. *) (* ------------------------------------------------------------------------- *) let COMPLEX_DIV_1 = prove (`!z. z / Cx(&1) = z`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIV_LMUL = prove (`!x y. ~(y = Cx(&0)) ==> y * x / y = x`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIV_RMUL = prove (`!x y. ~(y = Cx(&0)) ==> x / y * y = x`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_INV_II = prove (`inv ii = --ii`, CONV_TAC COMPLEX_FIELD);; let COMPLEX_INV_EQ_0 = prove (`!x. inv x = Cx(&0) <=> x = Cx(&0)`, GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_INV_0] THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; let COMPLEX_INV_NEG = prove (`!x:complex. inv(--x) = --(inv x)`, GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_NEG_0] THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; let COMPLEX_NEG_INV = prove (`!x:complex. --(inv x) = inv(--x)`, REWRITE_TAC[COMPLEX_INV_NEG]);; let COMPLEX_INV_EQ_1 = prove (`!x. inv x = Cx(&1) <=> x = Cx(&1)`, GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_INV_0] THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIV_EQ_0 = prove (`!w z. w / z = Cx(&0) <=> w = Cx(&0) \/ z = Cx(&0)`, REWRITE_TAC[complex_div; COMPLEX_INV_EQ_0; COMPLEX_ENTIRE]);; let COMPLEX_POW_DIV = prove (`!x y n. (x / y) pow n = (x pow n) / (y pow n)`, REWRITE_TAC[complex_div; COMPLEX_POW_MUL; COMPLEX_POW_INV]);; let COMPLEX_DIV_POW = prove (`!x:complex n k:num. ~(x= Cx(&0)) /\ k <= n /\ ~(k = 0) ==> x pow (n - k) = x pow n / x pow k`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `x:complex pow (n - k) * x pow k = x pow n / x pow k * x pow k` (fun th-> ASM_MESON_TAC [th;COMPLEX_POW_EQ_0;COMPLEX_EQ_MUL_RCANCEL]) THEN ASM_SIMP_TAC[GSYM COMPLEX_POW_ADD;SUB_ADD] THEN MP_TAC (MESON [COMPLEX_POW_EQ_0;ASSUME `~(k = 0)`; ASSUME `~(x = Cx(&0))`] `~(x pow k = Cx(&0))`) THEN ASM_SIMP_TAC[COMPLEX_DIV_RMUL]);; let COMPLEX_DIV_POW2 = prove (`!z m n. ~(z = Cx(&0)) ==> z pow m / z pow n = if n <= m then z pow (m - n) else inv(z pow (n - m))`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD `~(b = Cx(&0)) /\ ~(c = Cx(&0)) ==> (a / b = inv c <=> a * c = b)`] THEN ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD `~(b = Cx(&0)) ==> (a / b = c <=> b * c = a)`] THEN REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN AP_TERM_TAC THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Norms (aka "moduli"). *) (* ------------------------------------------------------------------------- *) let COMPLEX_NORM_ZERO = prove (`!z. (norm z = &0) <=> (z = Cx(&0))`, REWRITE_TAC[NORM_EQ_0; COMPLEX_VEC_0]);; let COMPLEX_NORM_NUM = prove (`!n. norm(Cx(&n)) = &n`, REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]);; let COMPLEX_NORM_0 = prove (`norm(Cx(&0)) = &0`, MESON_TAC[COMPLEX_NORM_ZERO]);; let COMPLEX_NORM_NZ = prove (`!z. &0 < norm(z) <=> ~(z = Cx(&0))`, REWRITE_TAC[NORM_POS_LT; COMPLEX_VEC_0]);; let COMPLEX_NORM_MUL = prove (`!w z. norm(w * z) = norm(w) * norm(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm; complex_mul; RE; IM] THEN SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let COMPLEX_NORM_POW = prove (`!z n. norm(z pow n) = norm(z) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; real_pow; COMPLEX_NORM_NUM; COMPLEX_NORM_MUL]);; let COMPLEX_NORM_INV = prove (`!z. norm(inv z) = inv(norm z)`, GEN_TAC THEN REWRITE_TAC[complex_norm; complex_inv; RE; IM] THEN REWRITE_TAC[REAL_POW_2; real_div] THEN REWRITE_TAC[REAL_ARITH `(r * d) * r * d + (--i * d) * --i * d = (r * r + i * i) * d * d:real`] THEN ASM_CASES_TAC `Re z * Re z + Im z * Im z = &0` THENL [ASM_REWRITE_TAC[REAL_INV_0; SQRT_0; REAL_MUL_LZERO]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN SIMP_TAC[GSYM SQRT_MUL; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LE_ADD; REAL_LE_SQUARE] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * a * b * b:real = (a * b) * (a * b)`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; SQRT_1]);; let COMPLEX_NORM_DIV = prove (`!w z. norm(w / z) = norm(w) / norm(z)`, REWRITE_TAC[complex_div; real_div; COMPLEX_NORM_INV; COMPLEX_NORM_MUL]);; let COMPLEX_NORM_TRIANGLE_SUB = prove (`!w z. norm(w) <= norm(w + z) + norm(z)`, MESON_TAC[NORM_TRIANGLE; NORM_NEG; COMPLEX_ADD_ASSOC; COMPLEX_ADD_RINV; COMPLEX_ADD_RID]);; let COMPLEX_NORM_ABS_NORM = prove (`!w z. abs(norm w - norm z) <= norm(w - z)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a - b <= x /\ b - a <= x ==> abs(a - b) <= x:real`) THEN MESON_TAC[COMPLEX_NEG_SUB; NORM_NEG; REAL_LE_SUB_RADD; complex_sub; COMPLEX_NORM_TRIANGLE_SUB]);; let COMPLEX_POW_EQ_1 = prove (`!z n. z pow n = Cx(&1) ==> norm(z) = &1 \/ n = 0`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN SIMP_TAC[COMPLEX_NORM_POW; COMPLEX_NORM_CX; REAL_POW_EQ_1; REAL_ABS_NUM] THEN SIMP_TAC[REAL_ABS_NORM] THEN CONV_TAC TAUT);; (* ------------------------------------------------------------------------- *) (* Complex conjugate. *) (* ------------------------------------------------------------------------- *) let cnj = new_definition `cnj(z) = complex(Re(z),--(Im(z)))`;; (* ------------------------------------------------------------------------- *) (* Conjugation is an automorphism. *) (* ------------------------------------------------------------------------- *) let CNJ_INJ = prove (`!w z. (cnj(w) = cnj(z)) <=> (w = z)`, REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_EQ_NEG2]);; let CNJ_CNJ = prove (`!z. cnj(cnj z) = z`, REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_NEG_NEG]);; let CNJ_CX = prove (`!x. cnj(Cx x) = Cx x`, REWRITE_TAC[cnj; COMPLEX_EQ; CX_DEF; REAL_NEG_0; RE; IM]);; let COMPLEX_NORM_CNJ = prove (`!z. norm(cnj z) = norm(z)`, REWRITE_TAC[complex_norm; cnj; REAL_POW_2] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; RE; IM; REAL_NEG_NEG]);; let CNJ_NEG = prove (`!z. cnj(--z) = --(cnj z)`, REWRITE_TAC[cnj; complex_neg; COMPLEX_EQ; RE; IM]);; let CNJ_INV = prove (`!z. cnj(inv z) = inv(cnj z)`, REWRITE_TAC[cnj; complex_inv; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[real_div; REAL_NEG_NEG; REAL_POW_2; REAL_MUL_LNEG; REAL_MUL_RNEG]);; let CNJ_ADD = prove (`!w z. cnj(w + z) = cnj(w) + cnj(z)`, REWRITE_TAC[cnj; complex_add; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let CNJ_SUB = prove (`!w z. cnj(w - z) = cnj(w) - cnj(z)`, REWRITE_TAC[complex_sub; CNJ_ADD; CNJ_NEG]);; let CNJ_MUL = prove (`!w z. cnj(w * z) = cnj(w) * cnj(z)`, REWRITE_TAC[cnj; complex_mul; COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let CNJ_DIV = prove (`!w z. cnj(w / z) = cnj(w) / cnj(z)`, REWRITE_TAC[complex_div; CNJ_MUL; CNJ_INV]);; let CNJ_POW = prove (`!z n. cnj(z pow n) = cnj(z) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; CNJ_MUL; CNJ_CX]);; let RE_CNJ = prove (`!z. Re(cnj z) = Re z`, REWRITE_TAC[cnj; RE]);; let IM_CNJ = prove (`!z. Im(cnj z) = --Im z`, REWRITE_TAC[cnj; IM]);; let CNJ_EQ_CX = prove (`!x z. cnj z = Cx x <=> z = Cx x`, REWRITE_TAC[COMPLEX_EQ; RE_CNJ; IM_CNJ; RE_CX; IM_CX] THEN CONV_TAC REAL_RING);; let CNJ_EQ_0 = prove (`!z. cnj z = Cx(&0) <=> z = Cx(&0)`, REWRITE_TAC[CNJ_EQ_CX]);; let COMPLEX_ADD_CNJ = prove (`(!z. z + cnj z = Cx(&2 * Re z)) /\ (!z. cnj z + z = Cx(&2 * Re z))`, REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX; RE_ADD; IM_ADD; RE_CNJ; IM_CNJ] THEN REAL_ARITH_TAC);; let CNJ_II = prove (`cnj ii = --ii`, REWRITE_TAC[cnj; ii; RE; IM; complex_neg; REAL_NEG_0]);; let CX_RE_CNJ = prove (`!z. Cx(Re z) = (z + cnj z) / Cx(&2)`, REWRITE_TAC[COMPLEX_EQ; RE_DIV_CX; IM_DIV_CX; RE_CX; IM_CX] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_CNJ; IM_CNJ] THEN REAL_ARITH_TAC);; let CX_IM_CNJ = prove (`!z. Cx(Im z) = --ii * (z - cnj z) / Cx(&2)`, REWRITE_TAC[COMPLEX_EQ; RE_DIV_CX; IM_DIV_CX; RE_CX; IM_CX; COMPLEX_MUL_LNEG; RE_NEG; IM_NEG; RE_MUL_II; IM_MUL_II] THEN REWRITE_TAC[RE_SUB; IM_SUB; RE_CNJ; IM_CNJ] THEN REAL_ARITH_TAC);; let FORALL_CNJ = prove (`(!z. P(cnj z)) <=> (!z. P z)`, MESON_TAC[CNJ_CNJ]);; let EXISTS_CNJ = prove (`(?z. P(cnj z)) <=> (?z. P z)`, MESON_TAC[CNJ_CNJ]);; (* ------------------------------------------------------------------------- *) (* Slightly ad hoc theorems relating multiplication, inverse and conjugation *) (* ------------------------------------------------------------------------- *) let COMPLEX_NORM_POW_2 = prove (`!z. Cx(norm z) pow 2 = z * cnj z`, GEN_TAC THEN REWRITE_TAC [GSYM CX_POW; COMPLEX_SQNORM] THEN REWRITE_TAC [cnj; complex_mul; CX_DEF; RE; IM; COMPLEX_EQ] THEN CONV_TAC REAL_RING);; let COMPLEX_MUL_CNJ = prove (`!z. cnj z * z = Cx(norm(z)) pow 2 /\ z * cnj z = Cx(norm(z)) pow 2`, GEN_TAC THEN REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[cnj; complex_mul; RE; IM; GSYM CX_POW; COMPLEX_SQNORM] THEN REWRITE_TAC[CX_DEF] THEN AP_TERM_TAC THEN BINOP_TAC THEN CONV_TAC REAL_RING);; let COMPLEX_INV_CNJ = prove (`!z. inv z = cnj z / Cx(norm z) pow 2`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_REWRITE_TAC[CNJ_CX; complex_div; COMPLEX_INV_0; COMPLEX_MUL_LZERO]; MATCH_MP_TAC(COMPLEX_FIELD `x * y = z /\ ~(x = Cx(&0)) /\ ~(z = Cx(&0)) ==> inv x = y / z`) THEN ASM_REWRITE_TAC[COMPLEX_MUL_CNJ; GSYM CX_POW; CX_INJ; REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; ARITH]]);; let COMPLEX_DIV_CNJ = prove (`!a b. a / b = (a * cnj b) / Cx(norm b) pow 2`, REPEAT GEN_TAC THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [COMPLEX_INV_CNJ] THEN REWRITE_TAC[complex_div]);; let RE_COMPLEX_DIV_EQ_0 = prove (`!a b. Re(a / b) = &0 <=> Re(a * cnj b) = &0`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN REWRITE_TAC[RE_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; RE_CX]);; let IM_COMPLEX_DIV_EQ_0 = prove (`!a b. Im(a / b) = &0 <=> Im(a * cnj b) = &0`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN REWRITE_TAC[IM_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; IM_CX]);; let RE_COMPLEX_DIV_GT_0 = prove (`!a b. &0 < Re(a / b) <=> &0 < Re(a * cnj b)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN REWRITE_TAC[RE_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; RE_CX; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ARITH `&0 < a * x <=> &0 * x < a * x`] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_INV_EQ; REAL_POW_LT; ARITH; COMPLEX_NORM_NZ]);; let IM_COMPLEX_DIV_GT_0 = prove (`!a b. &0 < Im(a / b) <=> &0 < Im(a * cnj b)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN REWRITE_TAC[IM_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; IM_CX; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ARITH `&0 < a * x <=> &0 * x < a * x`] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_INV_EQ; REAL_POW_LT; ARITH; COMPLEX_NORM_NZ]);; let RE_COMPLEX_DIV_GE_0 = prove (`!a b. &0 <= Re(a / b) <=> &0 <= Re(a * cnj b)`, REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN REWRITE_TAC[RE_COMPLEX_DIV_GT_0; RE_COMPLEX_DIV_EQ_0]);; let IM_COMPLEX_DIV_GE_0 = prove (`!a b. &0 <= Im(a / b) <=> &0 <= Im(a * cnj b)`, REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN REWRITE_TAC[IM_COMPLEX_DIV_GT_0; IM_COMPLEX_DIV_EQ_0]);; let RE_COMPLEX_DIV_LE_0 = prove (`!a b. Re(a / b) <= &0 <=> Re(a * cnj b) <= &0`, REWRITE_TAC[GSYM REAL_NOT_LT; RE_COMPLEX_DIV_GT_0]);; let IM_COMPLEX_DIV_LE_0 = prove (`!a b. Im(a / b) <= &0 <=> Im(a * cnj b) <= &0`, REWRITE_TAC[GSYM REAL_NOT_LT; IM_COMPLEX_DIV_GT_0]);; let RE_COMPLEX_DIV_LT_0 = prove (`!a b. Re(a / b) < &0 <=> Re(a * cnj b) < &0`, REWRITE_TAC[GSYM REAL_NOT_LE; RE_COMPLEX_DIV_GE_0]);; let IM_COMPLEX_DIV_LT_0 = prove (`!a b. Im(a / b) < &0 <=> Im(a * cnj b) < &0`, REWRITE_TAC[GSYM REAL_NOT_LE; IM_COMPLEX_DIV_GE_0]);; let IM_COMPLEX_INV_GE_0 = prove (`!z. &0 <= Im(inv z) <=> Im(z) <= &0`, GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `z:complex`] IM_COMPLEX_DIV_GE_0) THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID; IM_CNJ] THEN REAL_ARITH_TAC);; let IM_COMPLEX_INV_LE_0 = prove (`!z. Im(inv z) <= &0 <=> &0 <= Im(z)`, MESON_TAC[IM_COMPLEX_INV_GE_0; COMPLEX_INV_INV]);; let IM_COMPLEX_INV_GT_0 = prove (`!z. &0 < Im(inv z) <=> Im(z) < &0`, REWRITE_TAC[REAL_ARITH `&0 < a <=> ~(a <= &0)`; IM_COMPLEX_INV_LE_0] THEN REAL_ARITH_TAC);; let IM_COMPLEX_INV_LT_0 = prove (`!z. Im(inv z) < &0 <=> &0 < Im(z)`, REWRITE_TAC[REAL_ARITH `a < &0 <=> ~(&0 <= a)`; IM_COMPLEX_INV_GE_0] THEN REAL_ARITH_TAC);; let IM_COMPLEX_INV_EQ_0 = prove (`!z. Im(inv z) = &0 <=> Im(z) = &0`, SIMP_TAC[GSYM REAL_LE_ANTISYM; IM_COMPLEX_INV_LE_0; IM_COMPLEX_INV_GE_0] THEN REAL_ARITH_TAC);; let REAL_SGN_RE_COMPLEX_DIV = prove (`!w z. real_sgn(Re(w / z)) = real_sgn(Re(w * cnj z))`, REWRITE_TAC[real_sgn; RE_COMPLEX_DIV_GT_0; RE_COMPLEX_DIV_GE_0; REAL_ARITH `x < &0 <=> ~(&0 <= x)`]);; let REAL_SGN_IM_COMPLEX_DIV = prove (`!w z. real_sgn(Im(w / z)) = real_sgn(Im(w * cnj z))`, REWRITE_TAC[real_sgn; IM_COMPLEX_DIV_GT_0; IM_COMPLEX_DIV_GE_0; REAL_ARITH `x < &0 <=> ~(&0 <= x)`]);; (* ------------------------------------------------------------------------- *) (* Norm versus components for complex numbers. *) (* ------------------------------------------------------------------------- *) let COMPLEX_NORM_GE_RE_IM = prove (`!z. abs(Re(z)) <= norm(z) /\ abs(Im(z)) <= norm(z)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN REWRITE_TAC[complex_norm] THEN CONJ_TAC THEN MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_ADDL; REAL_POW_2; REAL_LE_SQUARE]);; let COMPLEX_NORM_LE_RE_IM = prove (`!z. norm(z) <= abs(Re z) + abs(Im z)`, GEN_TAC THEN MP_TAC(ISPEC `z:complex` NORM_LE_L1) THEN REWRITE_TAC[DIMINDEX_2; SUM_2; RE_DEF; IM_DEF]);; let COMPLEX_L1_LE_NORM = prove (`!z. sqrt(&2) / &2 * (abs(Re z) + abs(Im z)) <= norm z`, GEN_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `sqrt(&2)` THEN SIMP_TAC[REAL_ARITH `x * x / &2 * y = (x pow 2) / &2 * y`; SQRT_POW_2; REAL_POS; SQRT_POS_LT; REAL_OF_NUM_LT; ARITH] THEN MP_TAC(ISPEC `z:complex` L1_LE_NORM) THEN REWRITE_TAC[DIMINDEX_2; SUM_2; RE_DEF; IM_DEF] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Complex square roots. *) (* ------------------------------------------------------------------------- *) let csqrt = new_definition `csqrt(z) = if Im(z) = &0 then if &0 <= Re(z) then complex(sqrt(Re(z)),&0) else complex(&0,sqrt(--Re(z))) else complex(sqrt((norm(z) + Re(z)) / &2), (Im(z) / abs(Im(z))) * sqrt((norm(z) - Re(z)) / &2))`;; let CSQRT = prove (`!z. csqrt(z) pow 2 = z`, GEN_TAC THEN REWRITE_TAC[COMPLEX_POW_2; csqrt] THEN COND_CASES_TAC THENL [COND_CASES_TAC THEN ASM_REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_ADD_LID; COMPLEX_EQ] THEN REWRITE_TAC[REAL_NEG_EQ; GSYM REAL_POW_2] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`]; ALL_TAC] THEN REWRITE_TAC[complex_mul; RE; IM] THEN ONCE_REWRITE_TAC[REAL_ARITH `(s * s - (i * s') * (i * s') = s * s - (i * i) * (s' * s')) /\ (s * i * s' + (i * s')* s = &2 * i * s * s')`] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN SUBGOAL_THEN `&0 <= norm(z) + Re(z) /\ &0 <= norm(z) - Re(z)` STRIP_ASSUME_TAC THENL [MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; GSYM SQRT_MUL; SQRT_POW_2] THEN REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW2_ABS; REAL_POW_EQ_0; REAL_DIV_REFL] THEN REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_ARITH `(m + r) - (m - r) = r * &2`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * a' * b = (a * a') * (b * b:real)`] THEN REWRITE_TAC[REAL_DIFFSQ] THEN REWRITE_TAC[complex_norm; GSYM REAL_POW_2] THEN SIMP_TAC[SQRT_POW_2; REAL_LE_ADD; REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE] THEN REWRITE_TAC[REAL_ADD_SUB; GSYM REAL_POW_MUL] THEN REWRITE_TAC[POW_2_SQRT_ABS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `&2 * (i * a') * a * h = i * (&2 * h) * a * a'`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID; GSYM real_div] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_ABS_ZERO; REAL_MUL_RID]);; let CX_SQRT = prove (`!x. &0 <= x ==> Cx(sqrt x) = csqrt(Cx x)`, SIMP_TAC[csqrt; IM_CX; RE_CX; COMPLEX_EQ; RE; IM]);; let CSQRT_CX = prove (`!x. &0 <= x ==> csqrt(Cx x) = Cx(sqrt x)`, SIMP_TAC[CX_SQRT]);; let CSQRT_0 = prove (`csqrt(Cx(&0)) = Cx(&0)`, SIMP_TAC[CSQRT_CX; REAL_POS; SQRT_0]);; let CSQRT_1 = prove (`csqrt(Cx(&1)) = Cx(&1)`, SIMP_TAC[CSQRT_CX; REAL_POS; SQRT_1]);; let CSQRT_PRINCIPAL = prove (`!z. &0 < Re(csqrt(z)) \/ Re(csqrt(z)) = &0 /\ &0 <= Im(csqrt(z))`, GEN_TAC THEN REWRITE_TAC[csqrt] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[RE; IM]) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP SQRT_POS_LE) THEN REAL_ARITH_TAC; DISJ2_TAC THEN REWRITE_TAC[real_ge] THEN MATCH_MP_TAC SQRT_POS_LE THEN ASM_REAL_ARITH_TAC; DISJ1_TAC THEN MATCH_MP_TAC SQRT_POS_LT THEN MATCH_MP_TAC(REAL_ARITH `abs(y) < x ==> &0 < (x + y) / &2`) THEN REWRITE_TAC[complex_norm] THEN REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LT THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LT_ADDR] THEN REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN ASM_REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]]);; let RE_CSQRT = prove (`!z. &0 <= Re(csqrt z)`, MP_TAC CSQRT_PRINCIPAL THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let CSQRT_UNIQUE = prove (`!s z. s pow 2 = z /\ (&0 < Re s \/ Re s = &0 /\ &0 <= Im s) ==> csqrt z = s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN MP_TAC(SPEC `(s:complex) pow 2` CSQRT) THEN SIMP_TAC[COMPLEX_RING `a pow 2 = b pow 2 <=> a = b \/ a = --b:complex`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_RING `--z = z <=> z = Cx(&0)`] THEN FIRST_ASSUM(MP_TAC o AP_TERM `Re`) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `Im`) THEN REWRITE_TAC[RE_NEG; IM_NEG; COMPLEX_EQ; RE_CX; IM_CX] THEN MP_TAC(SPEC `(s:complex) pow 2` CSQRT_PRINCIPAL) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let POW_2_CSQRT = prove (`!z. &0 < Re z \/ Re(z) = &0 /\ &0 <= Im(z) ==> csqrt(z pow 2) = z`, MESON_TAC[CSQRT_UNIQUE]);; let CSQRT_EQ_0 = prove (`!z. csqrt z = Cx(&0) <=> z = Cx(&0)`, GEN_TAC THEN MP_TAC (SPEC `z:complex` CSQRT) THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* A few more complex-specific cases of vector notions. *) (* ------------------------------------------------------------------------- *) let DOT_COMPLEX_MUL_CNJ = prove (`!w z. w dot z = Re(w * cnj z)`, REWRITE_TAC[cnj; complex_mul; RE; IM] THEN REWRITE_TAC[DOT_2; RE_DEF; IM_DEF] THEN REAL_ARITH_TAC);; let DOT_CNJ = prove (`!w z. cnj w dot cnj z = w dot z`, REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[cnj; RE; IM] THEN REAL_ARITH_TAC);; let LINEAR_COMPLEX_MUL = prove (`!c. linear (\x. c * x)`, REWRITE_TAC[linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; let BILINEAR_COMPLEX_MUL = prove (`bilinear( * )`, REWRITE_TAC[bilinear; linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; let LINEAR_CNJ = prove (`linear cnj`, REWRITE_TAC[linear; COMPLEX_CMUL; CNJ_ADD; CNJ_MUL; CNJ_CX]);; let ORTHOGONAL_TRANSFORMATION_CNJ = prove (`orthogonal_transformation cnj`, REWRITE_TAC[orthogonal_transformation; LINEAR_CNJ; DOT_CNJ]);; let LINEAR_COMPLEX_LMUL = prove (`!f:real^N->complex c. linear f ==> linear (\x. c * f x)`, SIMP_TAC[linear; COMPLEX_CMUL] THEN REPEAT STRIP_TAC THEN CONV_TAC COMPLEX_RING);; let LINEAR_COMPLEX_RMUL = prove (`!f:real^N->complex c. linear f ==> linear (\x. f x * c)`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[LINEAR_COMPLEX_LMUL]);; let COMPLEX_CAUCHY_SCHWARZ_EQ = prove (`!w z. (w dot z) pow 2 + ((ii * w) dot z) pow 2 = norm(w) pow 2 * norm(z) pow 2`, REWRITE_TAC[NORM_POW_2; DOT_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[ii; complex_mul; RE; IM] THEN REAL_ARITH_TAC);; let COMPLEX_BASIS = prove (`basis 1 = Cx(&1) /\ basis 2 = ii`, SIMP_TAC[CART_EQ; FORALL_2; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE_CX; IM_CX] THEN REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; let COMPLEX_LINEAR = prove (`!f:complex->complex. (?c. f = \z. c * z) <=> linear f /\ (matrix f)$1$1 = (matrix f)$2$2 /\ (matrix f)$1$2 = --((matrix f)$2$1)`, GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[LINEAR_COMPLEX_MUL] THEN SIMP_TAC[matrix; LAMBDA_BETA; DIMINDEX_2; ARITH] THEN REWRITE_TAC[COMPLEX_BASIS; GSYM RE_DEF; GSYM IM_DEF; ii] THEN SIMPLE_COMPLEX_ARITH_TAC; STRIP_TAC THEN EXISTS_TAC `complex(matrix(f:complex->complex)$1$1,matrix f$2$1)` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [MATCH_MP MATRIX_VECTOR_MUL th]) THEN ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; DIMINDEX_2; SUM_2; ARITH; FORALL_2; FUN_EQ_THM; LAMBDA_BETA] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; IM; RE; complex_mul] THEN REAL_ARITH_TAC]);; let COMPLEX_LINEAR_ALT = prove (`!f:complex->complex. (?c. f = \z. c * z) <=> linear f /\ f(ii) = ii * f(Cx(&1))`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[LINEAR_COMPLEX_MUL] THENL [SIMPLE_COMPLEX_ARITH_TAC; ASM_REWRITE_TAC[COMPLEX_LINEAR]] THEN FIRST_ASSUM(MP_TAC o SYM) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP MATRIX_VECTOR_MUL th]) THEN REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE_MUL_II; IM_MUL_II] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_COMPONENT; IM_DEF; RE_DEF] THEN SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH; DOT_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; CX_DEF; RE; IM; RE_II; IM_II] THEN REAL_ARITH_TAC);; let ORTHOGONAL_TRANSFORMATION_COMPLEX_MUL = prove (`!c. orthogonal_transformation(\z. c * z) <=> norm c = &1`, REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; LINEAR_COMPLEX_MUL] THEN GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[REAL_RING `c * v:real = v <=> c = &1 \/ v = &0`] THEN ASM_CASES_TAC `norm(c:complex) = &1` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1)`) THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC);; let COMPLEX_ORTHOGONAL_ROTATION = prove (`!f:complex->complex. orthogonal_transformation f /\ det(matrix f) = &1 <=> ?c. norm c = &1 /\ f = \z. c * z`, GEN_TAC THEN TRANS_TAC EQ_TRANS `(!z. norm(f z) = norm z) /\ (?c. f = \z:complex. c * z)` THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_LINEAR] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> (q /\ p) /\ r`] THEN REWRITE_TAC[GSYM ORTHOGONAL_TRANSFORMATION] THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[ORTHOGONAL_MATRIX_2; DET_2] THEN CONV_TAC REAL_RING; REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `c:complex` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `f:complex->complex = \z. c * z` THEN ASM_REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[REAL_RING `c * v:real = v <=> c = &1 \/ v = &0`] THEN ASM_CASES_TAC `norm(c:complex) = &1` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1)`) THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]);; let COMPLEX_ORTHOGONAL_ROTOINVERSION = prove (`!f:complex->complex. orthogonal_transformation f /\ det(matrix f) = -- &1 <=> ?c. norm c = &1 /\ f = \z. c * cnj z`, GEN_TAC THEN SUBGOAL_THEN `!c. (f = \z. c * cnj z) = (f o cnj = \z. c * z)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN MESON_TAC[CNJ_CNJ; CNJ_MUL]; REWRITE_TAC[GSYM COMPLEX_ORTHOGONAL_ROTATION]] THEN EQ_TAC THEN DISCH_TAC THENL [ALL_TAC; SUBGOAL_THEN `(f:complex->complex) = (f o cnj) o cnj` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; CNJ_CNJ]; POP_ASSUM MP_TAC THEN SPEC_TAC(`(f:complex->complex) o cnj`,`f:complex->complex`) THEN REPEAT STRIP_TAC]] THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE; MATRIX_COMPOSE; DET_MUL; ORTHOGONAL_TRANSFORMATION_CNJ; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN SIMP_TAC[DET_2; MATRIX_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[COMPLEX_BASIS; CNJ_II; CNJ_CX] THEN REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; IM; RE; CX_DEF; ii; complex_neg] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let COMPLEX_ORTHOGONAL_TRANSFORMATION = prove (`!f:complex->complex. orthogonal_transformation f <=> ?c. norm c = &1 /\ ((f = \z. c * z) \/ (f = \z. c * cnj z))`, GEN_TAC THEN REWRITE_TAC[LEFT_OR_DISTRIB; EXISTS_OR_THM] THEN REWRITE_TAC[GSYM COMPLEX_ORTHOGONAL_ROTATION; GSYM COMPLEX_ORTHOGONAL_ROTOINVERSION] THEN MESON_TAC[DET_ORTHOGONAL_MATRIX; ORTHOGONAL_TRANSFORMATION_MATRIX]);; (* ------------------------------------------------------------------------- *) (* Complex-specific theorems about sums. *) (* ------------------------------------------------------------------------- *) let RE_VSUM = prove (`!f s. FINITE s ==> Re(vsum s f) = sum s (\x. Re(f x))`, SIMP_TAC[RE_DEF; VSUM_COMPONENT; DIMINDEX_2; ARITH]);; let IM_VSUM = prove (`!f s. FINITE s ==> Im(vsum s f) = sum s (\x. Im(f x))`, SIMP_TAC[IM_DEF; VSUM_COMPONENT; DIMINDEX_2; ARITH]);; let VSUM_COMPLEX_LMUL = prove (`!c f s. FINITE(s) ==> vsum s (\x. c * f x) = c * vsum s f`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN SIMPLE_COMPLEX_ARITH_TAC);; let VSUM_COMPLEX_RMUL = prove (`!c f s. FINITE(s) ==> vsum s (\x. f x * c) = vsum s f * c`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[VSUM_COMPLEX_LMUL]);; let VSUM_CX = prove (`!f:A->real s. vsum s (\a. Cx(f a)) = Cx(sum s f)`, SIMP_TAC[CART_EQ; VSUM_COMPONENT] THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[IM_CX; SUM_0; RE_CX; ETA_AX]);; let CNJ_VSUM = prove (`!f s. FINITE s ==> cnj(vsum s f) = vsum s (\x. cnj(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; CNJ_ADD; CNJ_CX; COMPLEX_VEC_0]);; let VSUM_CX_NUMSEG = prove (`!f m n. vsum (m..n) (\a. Cx(f a)) = Cx(sum (m..n) f)`, SIMP_TAC[VSUM_CX; FINITE_NUMSEG]);; let COMPLEX_SUB_POW = prove (`!x y n. 1 <= n ==> x pow n - y pow n = (x - y) * vsum(0..n-1) (\i. x pow i * y pow (n - 1 - i))`, SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN REWRITE_TAC[COMPLEX_RING `(x - y) * (a * b):complex = (x * a) * b - a * (y * b)`] THEN SIMP_TAC[GSYM complex_pow; ADD1; ARITH_RULE `1 <= n /\ x <= n - 1 ==> n - 1 - x = n - (x + 1) /\ SUC(n - 1 - x) = n - x`] THEN REWRITE_TAC[VSUM_DIFFS_ALT; LE_0] THEN SIMP_TAC[SUB_0; SUB_ADD; SUB_REFL; complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_RID]);; let COMPLEX_SUB_POW_R1 = prove (`!x n. 1 <= n ==> x pow n - Cx(&1) = (x - Cx(&1)) * vsum(0..n-1) (\i. x pow i)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`x:complex`; `Cx(&1)`] o MATCH_MP COMPLEX_SUB_POW) THEN REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_MUL_RID]);; let COMPLEX_SUB_POW_L1 = prove (`!x n. 1 <= n ==> Cx(&1) - x pow n = (Cx(&1) - x) * vsum(0..n-1) (\i. x pow i)`, ONCE_REWRITE_TAC[GSYM COMPLEX_NEG_SUB] THEN SIMP_TAC[COMPLEX_SUB_POW_R1] THEN REWRITE_TAC[COMPLEX_MUL_LNEG]);; (* ------------------------------------------------------------------------- *) (* The complex numbers that are real (zero imaginary part). *) (* ------------------------------------------------------------------------- *) let real = new_definition `real z <=> Im z = &0`;; let REAL = prove (`!z. real z <=> Cx(Re z) = z`, REWRITE_TAC[COMPLEX_EQ; real; CX_DEF; RE; IM] THEN REAL_ARITH_TAC);; let REAL_CNJ = prove (`!z. real z <=> cnj z = z`, REWRITE_TAC[real; cnj; COMPLEX_EQ; RE; IM] THEN REAL_ARITH_TAC);; let REAL_IMP_CNJ = prove (`!z. real z ==> cnj z = z`, REWRITE_TAC[REAL_CNJ]);; let REAL_EXISTS = prove (`!z. real z <=> ?x. z = Cx x`, MESON_TAC[REAL; real; IM_CX]);; let FORALL_REAL = prove (`(!z. real z ==> P z) <=> (!x. P(Cx x))`, MESON_TAC[REAL_EXISTS]);; let EXISTS_REAL = prove (`(?z. real z /\ P z) <=> (?x. P(Cx x))`, MESON_TAC[REAL_EXISTS]);; let REAL_CX = prove (`!x. real(Cx x)`, REWRITE_TAC[REAL_CNJ; CNJ_CX]);; let REAL_MUL_CX = prove (`!x z. real(Cx x * z) <=> x = &0 \/ real z`, REWRITE_TAC[real; IM_MUL_CX; REAL_ENTIRE]);; let REAL_ADD = prove (`!w z. real w /\ real z ==> real(w + z)`, SIMP_TAC[REAL_CNJ; CNJ_ADD]);; let REAL_NEG = prove (`!z. real z ==> real(--z)`, SIMP_TAC[REAL_CNJ; CNJ_NEG]);; let REAL_SUB = prove (`!w z. real w /\ real z ==> real(w - z)`, SIMP_TAC[REAL_CNJ; CNJ_SUB]);; let REAL_MUL = prove (`!w z. real w /\ real z ==> real(w * z)`, SIMP_TAC[REAL_CNJ; CNJ_MUL]);; let REAL_POW = prove (`!z n. real z ==> real(z pow n)`, SIMP_TAC[REAL_CNJ; CNJ_POW]);; let REAL_INV = prove (`!z. real z ==> real(inv z)`, SIMP_TAC[REAL_CNJ; CNJ_INV]);; let REAL_INV_EQ = prove (`!z. real(inv z) = real z`, MESON_TAC[REAL_INV; COMPLEX_INV_INV]);; let REAL_DIV = prove (`!w z. real w /\ real z ==> real(w / z)`, SIMP_TAC[REAL_CNJ; CNJ_DIV]);; let REAL_VSUM = prove (`!f s. FINITE s /\ (!a. a IN s ==> real(f a)) ==> real(vsum s f)`, SIMP_TAC[CNJ_VSUM; REAL_CNJ]);; let REAL_MUL_CNJ = prove (`(!z. real(z * cnj z)) /\ (!z. real(cnj z * z))`, REWRITE_TAC[COMPLEX_MUL_CNJ; GSYM CX_POW; REAL_CX]);; let REAL_SEGMENT = prove (`!a b x. x IN segment[a,b] /\ real a /\ real b ==> real x`, SIMP_TAC[segment; IN_ELIM_THM; real; COMPLEX_EQ; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; IM_ADD; IM_CMUL] THEN REAL_ARITH_TAC);; let IN_SEGMENT_CX = prove (`!a b x. Cx(x) IN segment[Cx(a),Cx(b)] <=> a <= x /\ x <= b \/ b <= x /\ x <= a`, REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN REWRITE_TAC[COMPLEX_CMUL; GSYM CX_ADD; CX_INJ; GSYM CX_MUL] THEN ASM_CASES_TAC `a:real = b` THENL [ASM_REWRITE_TAC[REAL_ARITH `(&1 - u) * b + u * b = b`] THEN ASM_CASES_TAC `x:real = b` THEN ASM_REWRITE_TAC[REAL_LE_ANTISYM] THEN EXISTS_TAC `&0` THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[REAL_ARITH `a <= (&1 - u) * a + u * b <=> &0 <= u * (b - a)`; REAL_ARITH `b <= (&1 - u) * a + u * b <=> &0 <= (&1 - u) * (a - b)`; REAL_ARITH `(&1 - u) * a + u * b <= a <=> &0 <= u * (a - b)`; REAL_ARITH `(&1 - u) * a + u * b <= b <=> &0 <= (&1 - u) * (b - a)`] THEN DISJ_CASES_TAC(REAL_ARITH `a <= b \/ b <= a`) THENL [DISJ1_TAC; DISJ2_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THENL [SUBGOAL_THEN `&0 < b - a` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; EXISTS_TAC `(x - a:real) / (b - a)`]; SUBGOAL_THEN `&0 < a - b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; EXISTS_TAC `(a - x:real) / (a - b)`]] THEN (CONJ_TAC THENL [ALL_TAC; UNDISCH_TAC `~(a:real = b)` THEN CONV_TAC REAL_FIELD]) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC);; let IN_SEGMENT_CX_GEN = prove (`!a b x. x IN segment[Cx a,Cx b] <=> Im(x) = &0 /\ (a <= Re x /\ Re x <= b \/ b <= Re x /\ Re x <= a)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real] THEN ASM_CASES_TAC `real x` THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM o REWRITE_RULE[REAL]) THEN REWRITE_TAC[IN_SEGMENT_CX; REAL_CX; RE_CX] THEN REAL_ARITH_TAC; ASM_MESON_TAC[REAL_SEGMENT; REAL_CX]]);; let RE_POS_SEGMENT = prove (`!a b x. x IN segment[a,b] /\ &0 < Re a /\ &0 < Re b ==> &0 < Re x`, SIMP_TAC[segment; IN_ELIM_THM; real; COMPLEX_EQ; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; RE_ADD; RE_CMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ENTIRE] THEN ASM_REAL_ARITH_TAC);; let CONVEX_REAL = prove (`convex real`, REWRITE_TAC[convex; IN; COMPLEX_CMUL] THEN SIMP_TAC[REAL_ADD; REAL_MUL; REAL_CX]);; let IMAGE_CX = prove (`!s. IMAGE Cx s = {z | real z /\ Re(z) IN s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[RE_CX; REAL]);; let SUBSPACE_REAL = prove (`subspace real`, REWRITE_TAC[subspace] THEN SIMP_TAC[COMPLEX_CMUL; COMPLEX_VEC_0; IN; REAL_CX; REAL_ADD; REAL_MUL]);; let DIM_REAL = prove (`dim real = 1`, ONCE_REWRITE_TAC[SET_RULE `real = {x | real x}`] THEN SIMP_TAC[real; IM_DEF; DIM_SPECIAL_HYPERPLANE; DIMINDEX_2; ARITH]);; let INTERIOR_REAL = prove (`interior real = {}`, MATCH_MP_TAC EMPTY_INTERIOR_LOWDIM THEN REWRITE_TAC[DIM_REAL; DIMINDEX_2; ARITH]);; (* ------------------------------------------------------------------------- *) (* Useful bound-type theorems for real quantities. *) (* ------------------------------------------------------------------------- *) let REAL_NORM = prove (`!z. real z ==> norm(z) = abs(Re z)`, SIMP_TAC[real; complex_norm] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[POW_2_SQRT_ABS; REAL_ADD_RID]);; let REAL_NORM_POS = prove (`!z. real z /\ &0 <= Re z ==> norm(z) = Re(z)`, SIMP_TAC[REAL_NORM] THEN REAL_ARITH_TAC);; let COMPLEX_NORM_VSUM_SUM_RE = prove (`!f s. FINITE s /\ (!x. x IN s ==> real(f x) /\ &0 <= Re(f x)) ==> norm(vsum s f) = sum s (\x. Re(f x))`, SIMP_TAC[GSYM RE_VSUM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_NORM_POS THEN ASM_SIMP_TAC[REAL_VSUM; RE_VSUM; SUM_POS_LE]);; let COMPLEX_NORM_VSUM_BOUND = prove (`!s f:A->complex g:A->complex. FINITE s /\ (!x. x IN s ==> real(g x) /\ norm(f x) <= Re(g x)) ==> norm(vsum s f) <= norm(vsum s g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\x. norm((f:A->complex) x))` THEN ASM_SIMP_TAC[VSUM_NORM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\x. Re((g:A->complex) x))` THEN ASM_SIMP_TAC[SUM_LE] THEN MATCH_MP_TAC(REAL_ARITH `x:real = y ==> y <= x`) THEN MATCH_MP_TAC COMPLEX_NORM_VSUM_SUM_RE THEN ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]);; let COMPLEX_NORM_VSUM_BOUND_SUBSET = prove (`!f:A->complex g:A->complex s t. FINITE s /\ t SUBSET s /\ (!x. x IN s ==> real(g x) /\ norm(f x) <= Re(g x)) ==> norm(vsum t f) <= norm(vsum s g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum t (g:A->complex))` THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPLEX_NORM_VSUM_BOUND; SUBSET; FINITE_SUBSET];ALL_TAC] THEN SUBGOAL_THEN `norm(vsum t (g:A->complex)) = sum t (\x. Re(g x)) /\ norm(vsum s g) = sum s (\x. Re(g x))` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC COMPLEX_NORM_VSUM_SUM_RE; MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[IN_DIFF]] THEN ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE; FINITE_SUBSET; SUBSET]);; (* ------------------------------------------------------------------------- *) (* Geometric progression. *) (* ------------------------------------------------------------------------- *) let VSUM_GP_BASIC = prove (`!x n. (Cx(&1) - x) * vsum(0..n) (\i. x pow i) = Cx(&1) - x pow (SUC n)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID; LE_0] THEN ASM_REWRITE_TAC[COMPLEX_ADD_LDISTRIB; complex_pow] THEN SIMPLE_COMPLEX_ARITH_TAC);; let VSUM_GP_MULTIPLIED = prove (`!x m n. m <= n ==> ((Cx(&1) - x) * vsum(m..n) (\i. x pow i) = x pow m - x pow (SUC n))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_OFFSET_0; COMPLEX_POW_ADD; FINITE_NUMSEG; COMPLEX_MUL_ASSOC; VSUM_GP_BASIC; VSUM_COMPLEX_RMUL] THEN REWRITE_TAC[COMPLEX_SUB_RDISTRIB; GSYM COMPLEX_POW_ADD; COMPLEX_MUL_LID] THEN ASM_SIMP_TAC[ARITH_RULE `m <= n ==> (SUC(n - m) + m = SUC n)`]);; let VSUM_GP = prove (`!x m n. vsum(m..n) (\i. x pow i) = if n < m then Cx(&0) else if x = Cx(&1) then Cx(&((n + 1) - m)) else (x pow m - x pow (SUC n)) / (Cx(&1) - x)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n < m \/ ~(n < m) /\ m <= n:num`) THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; COMPLEX_VEC_0] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[COMPLEX_POW_ONE; VSUM_CONST_NUMSEG; COMPLEX_MUL_RID]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RID] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(z = Cx(&1)) /\ (Cx(&1) - z) * x = y ==> x = y / (Cx(&1) - z)`) THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_SUB_0; VSUM_GP_MULTIPLIED]);; let VSUM_GP_OFFSET = prove (`!x m n. vsum(m..m+n) (\i. x pow i) = if x = Cx(&1) then Cx(&n) + Cx(&1) else x pow m * (Cx(&1) - x pow (SUC n)) / (Cx(&1) - x)`, REPEAT GEN_TAC THEN REWRITE_TAC[VSUM_GP; ARITH_RULE `~(m + n < m:num)`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[REAL_OF_NUM_ADD; GSYM CX_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ARITH_TAC; REWRITE_TAC[complex_div; complex_pow; COMPLEX_POW_ADD] THEN SIMPLE_COMPLEX_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Basics about polynomial functions: extremal behaviour and root counts. *) (* ------------------------------------------------------------------------- *) let COMPLEX_SUB_POLYFUN = prove (`!a x y n. 1 <= n ==> vsum(0..n) (\i. a i * x pow i) - vsum(0..n) (\i. a i * y pow i) = (x - y) * vsum(0..n-1) (\j. vsum(j+1..n) (\i. a i * y pow (i - j - 1)) * x pow j)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM VSUM_SUB_NUMSEG; GSYM COMPLEX_SUB_LDISTRIB] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP VSUM_CLAUSES_LEFT (SPEC_ALL LE_0)] THEN REWRITE_TAC[COMPLEX_SUB_REFL; complex_pow; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN SIMP_TAC[COMPLEX_SUB_POW; ADD_CLAUSES] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a * x * s:complex = x * a * s`] THEN SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; GSYM VSUM_COMPLEX_RMUL; FINITE_NUMSEG; VSUM_VSUM_PRODUCT; FINITE_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN REPEAT(EXISTS_TAC `\(x:num,y:num). (y,x)`) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `a - b - c:num = a - (b + c)`; ADD_SYM] THEN REWRITE_TAC[COMPLEX_MUL_AC] THEN ARITH_TAC);; let COMPLEX_SUB_POLYFUN_ALT = prove (`!a x y n. 1 <= n ==> vsum(0..n) (\i. a i * x pow i) - vsum(0..n) (\i. a i * y pow i) = (x - y) * vsum(0..n-1) (\j. vsum(0..n-j-1) (\k. a(j+k+1) * y pow k) * x pow j)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COMPLEX_SUB_POLYFUN] THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN MAP_EVERY EXISTS_TAC [`\i. i - (j + 1)`; `\k. j + k + 1`] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN TRY(BINOP_TAC THEN AP_TERM_TAC) THEN ASM_ARITH_TAC);; let COMPLEX_POLYFUN_LINEAR_FACTOR = prove (`!a c n. ?b. !z. vsum(0..n) (\i. c(i) * z pow i) = (z - a) * vsum(0..n-1) (\i. b(i) * z pow i) + vsum(0..n) (\i. c(i) * a pow i)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM COMPLEX_EQ_SUB_RADD] THEN ASM_CASES_TAC `n = 0` THENL [EXISTS_TAC `\i:num. Cx(&0)` THEN ASM_SIMP_TAC[VSUM_SING; NUMSEG_SING; complex_pow; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_SUB_REFL; GSYM COMPLEX_VEC_0; VSUM_0] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]; ASM_SIMP_TAC[COMPLEX_SUB_POLYFUN; LE_1] THEN EXISTS_TAC `\j. vsum (j + 1..n) (\i. c i * a pow (i - j - 1))` THEN REWRITE_TAC[]]);; let COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT = prove (`!a c n. vsum(0..n) (\i. c(i) * a pow i) = Cx(&0) ==> ?b. !z. vsum(0..n) (\i. c(i) * z pow i) = (z - a) * vsum(0..n-1) (\i. b(i) * z pow i)`, MESON_TAC[COMPLEX_POLYFUN_LINEAR_FACTOR; COMPLEX_ADD_RID]);; let COMPLEX_POLYFUN_EXTREMAL_LEMMA = prove (`!c n e. &0 < e ==> ?M. !z. M <= norm(z) ==> norm(vsum(0..n) (\i. c(i) * z pow i)) <= e * norm(z) pow (n + 1)`, GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[ADD_CLAUSES; complex_pow; REAL_POW_1; COMPLEX_MUL_RID] THEN EXISTS_TAC `norm(c 0:complex) / e` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (REAL_ARITH `&0 < &1 / &2`)) THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN EXISTS_TAC `max M ((&1 / &2 + norm(c(n+1):complex)) / e)` THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `a + norm(y) <= b ==> norm(x) <= a ==> norm(x + y) <= b`) THEN SIMP_TAC[ADD1; COMPLEX_NORM_MUL; COMPLEX_NORM_POW; GSYM REAL_ADD_RDISTRIB; ARITH_RULE `(n + 1) + 1 = 1 + n + 1`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_POW_ADD] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LE; NORM_POS_LE; REAL_POW_1]);; let COMPLEX_POLYFUN_EXTREMAL = prove (`!c n. (!k. k IN 1..n ==> c(k) = Cx(&0)) \/ !B. eventually (\z. norm(vsum(0..n) (\i. c(i) * z pow i)) >= B) at_infinity`, GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; NOT_IN_EMPTY] THEN MP_TAC(ARITH_RULE `0 <= n`) THEN SIMP_TAC[GSYM NUMSEG_RREC] THEN DISCH_THEN(K ALL_TAC) THEN ASM_CASES_TAC `c(n:num) = Cx(&0)` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM NUMSEG_RREC; LE_1] THEN SIMP_TAC[IN_INSERT; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; COND_ID] THEN ASM_MESON_TAC[]; DISJ2_TAC THEN MP_TAC(ISPECL [`c:num->complex`; `n - 1`; `norm(c(n:num):complex) / &2`] COMPLEX_POLYFUN_EXTREMAL_LEMMA) THEN ASM_SIMP_TAC[SUB_ADD; LE_1] THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN SIMP_TAC[IN_INSERT; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> ~(n <= n - 1)`] THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN X_GEN_TAC `B:real` THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY] THEN EXISTS_TAC `max M (max (&1) ((abs B + &1) / (norm(c(n:num):complex) / &2)))` THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[real_ge; REAL_MAX_LE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `abs b + &1 <= norm(y) - a ==> norm(x) <= a ==> b <= norm(y + x)`) THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN REWRITE_TAC[REAL_ARITH `c * x - c / &2 * x = x * c / &2`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(z:complex) pow 1` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_POW_1]; ALL_TAC] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_SIMP_TAC[LE_1]]);; let COMPLEX_POLYFUN_ROOTBOUND = prove (`!n c. ~(!i. i IN 0..n ==> c(i) = Cx(&0)) ==> FINITE {z | vsum(0..n) (\i. c(i) * z pow i) = Cx(&0)} /\ CARD {z | vsum(0..n) (\i. c(i) * z pow i) = Cx(&0)} <= n`, REWRITE_TAC[TAUT `~a ==> b <=> a \/ b`] THEN INDUCT_TAC THEN GEN_TAC THENL [SIMP_TAC[NUMSEG_SING; VSUM_SING; IN_SING; complex_pow] THEN ASM_CASES_TAC `c 0 = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RID] THEN REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES; CARD_CLAUSES; LE_REFL]; ALL_TAC] THEN ASM_CASES_TAC `{z | vsum(0..SUC n) (\i. c(i) * z pow i) = Cx(&0)} = {}` THEN ASM_REWRITE_TAC[FINITE_RULES; CARD_CLAUSES; LE_0] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT) THEN DISCH_THEN(X_CHOOSE_TAC `b:num->complex`) THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_SUB_0; SUC_SUB1; SET_RULE `{z | z = a \/ P z} = a INSERT {z | P z}`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:num->complex`) THEN STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THENL [DISJ1_TAC; ASM_ARITH_TAC] THEN MP_TAC(SPECL [`c:num->complex`; `SUC n`] COMPLEX_POLYFUN_EXTREMAL) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN ASM_SIMP_TAC[SUC_SUB1; COMPLEX_MUL_LZERO] THEN SIMP_TAC[COMPLEX_POW_ZERO; COND_RAND; COMPLEX_MUL_RZERO] THEN ASM_SIMP_TAC[VSUM_0; GSYM COMPLEX_VEC_0; VSUM_DELTA; IN_NUMSEG; LE_0] THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO; COMPLEX_NORM_NUM] THEN REWRITE_TAC[COMPLEX_MUL_RID; real_ge; EVENTUALLY_AT_INFINITY] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM] THEN X_GEN_TAC `b:real` THEN MP_TAC(SPEC `b:real` (INST_TYPE [`:2`,`:N`] VECTOR_CHOOSE_SIZE)) THEN ASM_MESON_TAC[NORM_POS_LE; REAL_LE_TOTAL; REAL_LE_TRANS]);; let COMPLEX_POLYFUN_FINITE_ROOTS = prove (`!n c. FINITE {x | vsum(0..n) (\i. c i * x pow i) = Cx(&0)} <=> ?i. i IN 0..n /\ ~(c i = Cx(&0))`, REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `a /\ ~b <=> ~(a ==> b)`] THEN REWRITE_TAC[GSYM NOT_FORALL_THM] THEN EQ_TAC THEN SIMP_TAC[COMPLEX_POLYFUN_ROOTBOUND] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_MUL_LZERO] THEN SIMP_TAC[GSYM COMPLEX_VEC_0; VSUM_0] THEN REWRITE_TAC[SET_RULE `{x | T} = (:complex)`; GSYM INFINITE; EUCLIDEAN_SPACE_INFINITE]);; let COMPLEX_POLYFUN_EQ_0 = prove (`!n c. (!z. vsum(0..n) (\i. c i * z pow i) = Cx(&0)) <=> (!i. i IN 0..n ==> c i = Cx(&0))`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_THEN(MP_TAC o MATCH_MP COMPLEX_POLYFUN_ROOTBOUND) THEN ASM_REWRITE_TAC[EUCLIDEAN_SPACE_INFINITE; GSYM INFINITE; DE_MORGAN_THM; SET_RULE `{x | T} = (:complex)`]; ASM_SIMP_TAC[IN_NUMSEG; LE_0; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0]]);; let COMPLEX_POLYFUN_EQ_CONST = prove (`!n c k. (!z. vsum(0..n) (\i. c i * z pow i) = k) <=> c 0 = k /\ (!i. i IN 1..n ==> c i = Cx(&0))`, REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `!x. vsum(0..n) (\i. (if i = 0 then c 0 - k else c i) * x pow i) = Cx(&0)` THEN CONJ_TAC THENL [SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; complex_pow; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_RING `(c - k) + s = Cx(&0) <=> c + s = k`] THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]; REWRITE_TAC[COMPLEX_POLYFUN_EQ_0; IN_NUMSEG; LE_0] THEN GEN_REWRITE_TAC LAND_CONV [MESON[] `(!n. P n) <=> P 0 /\ (!n. ~(n = 0) ==> P n)`] THEN SIMP_TAC[LE_0; COMPLEX_SUB_0] THEN MESON_TAC[LE_1]]);; (* ------------------------------------------------------------------------- *) (* Complex products. *) (* ------------------------------------------------------------------------- *) let cproduct = new_definition `cproduct = iterate (( * ):complex->complex->complex)`;; let NEUTRAL_COMPLEX_MUL = prove (`neutral(( * ):complex->complex->complex) = Cx(&1)`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_RID]);; let MONOIDAL_COMPLEX_MUL = prove (`monoidal(( * ):complex->complex->complex)`, REWRITE_TAC[monoidal; NEUTRAL_COMPLEX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC);; let CPRODUCT_CLAUSES = prove (`(!f. cproduct {} f = Cx(&1)) /\ (!x f s. FINITE(s) ==> (cproduct (x INSERT s) f = if x IN s then cproduct s f else f(x) * cproduct s f))`, REWRITE_TAC[cproduct; GSYM NEUTRAL_COMPLEX_MUL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_COMPLEX_MUL]);; let CPRODUCT_EQ_0 = prove (`!f s. FINITE s ==> (cproduct s f = Cx(&0) <=> ?x. x IN s /\ f(x) = Cx(&0))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_ENTIRE; IN_INSERT; CX_INJ; REAL_OF_NUM_EQ; ARITH; NOT_IN_EMPTY] THEN MESON_TAC[]);; let CPRODUCT_INV = prove (`!f s. FINITE s ==> cproduct s (\x. inv(f x)) = inv(cproduct s f)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_INV_1; COMPLEX_INV_MUL]);; let CPRODUCT_MUL = prove (`!f g s. FINITE s ==> cproduct s (\x. f x * g x) = cproduct s f * cproduct s g`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_MUL_AC; COMPLEX_MUL_LID]);; let CPRODUCT_EQ_1 = prove (`!f s. (!x:A. x IN s ==> (f(x) = Cx(&1))) ==> (cproduct s f = Cx(&1))`, REWRITE_TAC[cproduct; GSYM NEUTRAL_COMPLEX_MUL] THEN SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_COMPLEX_MUL]);; let CPRODUCT_1 = prove (`!s. cproduct s (\n. Cx(&1)) = Cx(&1)`, SIMP_TAC[CPRODUCT_EQ_1]);; let CPRODUCT_POW = prove (`!f s n. FINITE s ==> cproduct s (\x. f x pow n) = (cproduct s f) pow n`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[complex_pow; CPRODUCT_MUL; CPRODUCT_1]);; let NORM_CPRODUCT = prove (`!f s. FINITE s ==> norm(cproduct s f) = product s (\x. norm(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_NORM_CX; REAL_ABS_NUM; CPRODUCT_MUL; PRODUCT_CLAUSES; COMPLEX_NORM_MUL]);; let CPRODUCT_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> cproduct s f = cproduct s g`, REWRITE_TAC[cproduct] THEN MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_COMPLEX_MUL]);; let CPRODUCT_SING = prove (`!f x. cproduct {x} f = f(x)`, SIMP_TAC[CPRODUCT_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; COMPLEX_MUL_RID]);; let CPRODUCT_CLAUSES_NUMSEG = prove (`(!m. cproduct(m..0) f = if m = 0 then f(0) else Cx(&1)) /\ (!m n. cproduct(m..SUC n) f = if m <= SUC n then cproduct(m..n) f * f(SUC n) else cproduct(m..n) f)`, REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CPRODUCT_SING; CPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; COMPLEX_MUL_AC]);; let CPRODUCT_CLAUSES_RIGHT = prove (`!f m n. 0 < n /\ m <= n ==> cproduct(m..n) f = cproduct(m..n-1) f * (f n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[LT_REFL; CPRODUCT_CLAUSES_NUMSEG; SUC_SUB1]);; let CPRODUCT_CLAUSES_LEFT = prove (`!f m n. m <= n ==> cproduct(m..n) f = f m * cproduct(m + 1..n) f`, SIMP_TAC[GSYM NUMSEG_LREC; CPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; let CPRODUCT_IMAGE = prove (`!f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> (x = y)) ==> (cproduct (IMAGE f s) g = cproduct s (g o f))`, REWRITE_TAC[cproduct; GSYM NEUTRAL_COMPLEX_MUL] THEN MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_COMPLEX_MUL]);; let CPRODUCT_OFFSET = prove (`!f m p. cproduct(m+p..n+p) f = cproduct(m..n) (\i. f(i + p))`, SIMP_TAC[NUMSEG_OFFSET_IMAGE; CPRODUCT_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[o_DEF]);; let CPRODUCT_CONST = prove (`!c s. FINITE s ==> cproduct s (\x. c) = c pow (CARD s)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; CARD_CLAUSES; complex_pow]);; let CPRODUCT_CONST_NUMSEG = prove (`!c m n. cproduct (m..n) (\x. c) = c pow ((n + 1) - m)`, SIMP_TAC[CPRODUCT_CONST; CARD_NUMSEG; FINITE_NUMSEG]);; let CPRODUCT_PAIR = prove (`!f m n. cproduct(2*m..2*n+1) f = cproduct(m..n) (\i. f(2*i) * f(2*i+1))`, MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_COMPLEX_MUL) THEN REWRITE_TAC[cproduct; NEUTRAL_COMPLEX_MUL]);; let CPRODUCT_REFLECT = prove (`!x m n. cproduct(m..n) x = if n < m then Cx(&1) else cproduct(0..n-m) (\i. x(n - i))`, REPEAT GEN_TAC THEN REWRITE_TAC[cproduct] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP ITERATE_REFLECT MONOIDAL_COMPLEX_MUL] THEN REWRITE_TAC[NEUTRAL_COMPLEX_MUL]);; let CNJ_CPRODUCT = prove (`!f s. FINITE s ==> cnj(cproduct s f) = cproduct s (\i. cnj(f i))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; CNJ_MUL; CNJ_CX]);; let CX_PRODUCT = prove (`!f s. FINITE s ==> Cx(product s f) = cproduct s (\i. Cx(f i))`, GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; PRODUCT_CLAUSES; GSYM CX_MUL]);; let th = prove (`(!f g s. (!x. x IN s ==> f(x) = g(x)) ==> cproduct s (\i. f(i)) = cproduct s g) /\ (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) ==> cproduct(a..b) (\i. f(i)) = cproduct(a..b) g) /\ (!f g p. (!x. p x ==> f x = g x) ==> cproduct {y | p y} (\i. f(i)) = cproduct {y | p y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CPRODUCT_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; hol-light/Multivariate/convex.ml000066400000000000000000032427761303454263000172740ustar00rootroot00000000000000(* ========================================================================= *) (* Convex sets, functions and related things. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Lars Schewe 2007 *) (* (c) Copyright, Valentina Bruno 2010 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "Multivariate/topology.ml";; (* ------------------------------------------------------------------------- *) (* Some miscelleneous things that are convenient to prove here. *) (* ------------------------------------------------------------------------- *) let TRANSLATION_EQ_IMP = prove (`!P:(real^N->bool)->bool. (!a s. P(IMAGE (\x. a + x) s) <=> P s) <=> (!a s. P s ==> P (IMAGE (\x. a + x) s))`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`] THEN EQ_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`--a:real^N`; `IMAGE (\x:real^N. a + x) s`]) THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; let DIM_HYPERPLANE = prove (`!a:real^N. ~(a = vec 0) ==> dim {x | a dot x = &0} = dimindex(:N) - 1`, GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; DOT_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_ENTIRE; DIM_SPECIAL_HYPERPLANE]);; let DIM_EQ_HYPERPLANE = prove (`!s. dim s = dimindex(:N) - 1 <=> ?a:real^N. ~(a = vec 0) /\ span s = {x | a dot x = &0}`, MESON_TAC[DIM_HYPERPLANE; LOWDIM_EQ_HYPERPLANE; DIM_SPAN]);; (* ------------------------------------------------------------------------- *) (* Affine set and affine hull. *) (* ------------------------------------------------------------------------- *) let affine = new_definition `affine s <=> !x y u v. x IN s /\ y IN s /\ (u + v = &1) ==> (u % x + v % y) IN s`;; let AFFINE_ALT = prove (`affine s <=> !x y u. x IN s /\ y IN s ==> ((&1 - u) % x + u % y) IN s`, REWRITE_TAC[affine] THEN MESON_TAC[REAL_ARITH `(u + v = &1) <=> (u = &1 - v)`]);; let AFFINE_SCALING = prove (`!s c. affine s ==> affine (IMAGE (\x. c % x) s)`, REWRITE_TAC[affine; IN_IMAGE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % c % x + v % c % y = c % (u % x + v % y)`] THEN ASM_MESON_TAC[]);; let AFFINE_NEGATIONS = prove (`!s. affine s ==> affine (IMAGE (--) s)`, REWRITE_TAC[affine; IN_IMAGE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % --x + v % --y = --(u % x + v % y)`] THEN ASM_MESON_TAC[]);; let AFFINE_SUMS = prove (`!s t. affine s /\ affine t ==> affine {x + y | x IN s /\ y IN t}`, REWRITE_TAC[affine; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % (a + b) + v % (c + d) = (u % a + v % c) + (u % b + v % d)`] THEN ASM_MESON_TAC[]);; let AFFINE_DIFFERENCES = prove (`!s t. affine s /\ affine t ==> affine {x - y | x IN s /\ y IN t}`, REWRITE_TAC[affine; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % (a - b) + v % (c - d) = (u % a + v % c) - (u % b + v % d)`] THEN ASM_MESON_TAC[]);; let AFFINE_TRANSLATION_EQ = prove (`!a:real^N s. affine (IMAGE (\x. a + x) s) <=> affine s`, REWRITE_TAC[AFFINE_ALT; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; UNWIND_THM1; VECTOR_ARITH `(&1 - u) % (a + x) + u % (a + y) = a + z <=> (&1 - u) % x + u % y = z`]);; add_translation_invariants [AFFINE_TRANSLATION_EQ];; let AFFINE_TRANSLATION = prove (`!s a:real^N. affine s ==> affine (IMAGE (\x. a + x) s)`, REWRITE_TAC[AFFINE_TRANSLATION_EQ]);; let AFFINE_LINEAR_IMAGE = prove (`!f s. affine s /\ linear f ==> affine(IMAGE f s)`, REWRITE_TAC[affine; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_IMAGE; linear] THEN MESON_TAC[]);; let AFFINE_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (affine (IMAGE f s) <=> affine s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE AFFINE_LINEAR_IMAGE));; add_linear_invariants [AFFINE_LINEAR_IMAGE_EQ];; let AFFINE_LINEAR_PREIMAGE = prove (`!f:real^M->real^N s. linear f /\ affine s ==> affine {x | f(x) IN s}`, REWRITE_TAC[affine; IN_ELIM_THM] THEN SIMP_TAC[LINEAR_ADD; LINEAR_CMUL]);; let AFFINE_EMPTY = prove (`affine {}`, REWRITE_TAC[affine; NOT_IN_EMPTY]);; let AFFINE_SING = prove (`!x. affine {x}`, SIMP_TAC[AFFINE_ALT; IN_SING] THEN REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[REAL_SUB_ADD; VECTOR_MUL_LID]);; let AFFINE_SCALING_EQ = prove (`!s:real^N->bool c. affine (IMAGE (\x. c % x) s) <=> c = &0 \/ affine s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[AFFINE_SING; AFFINE_EMPTY]; EQ_TAC THEN REWRITE_TAC[AFFINE_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP AFFINE_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let AFFINE_AFFINITY_EQ = prove (`!s m c:real^N. affine (IMAGE (\x. m % x + c) s) <=> m = &0 \/ affine s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; AFFINE_TRANSLATION_EQ; AFFINE_SCALING_EQ; IMAGE_o]);; let AFFINE_AFFINITY = prove (`!s m c:real^N. affine s ==> affine (IMAGE (\x. m % x + c) s)`, SIMP_TAC[AFFINE_AFFINITY_EQ]);; let AFFINE_UNIV = prove (`affine(UNIV:real^N->bool)`, REWRITE_TAC[affine; IN_UNIV]);; let AFFINE_HYPERPLANE = prove (`!a b. affine {x | a dot x = b}`, REWRITE_TAC[affine; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN CONV_TAC REAL_RING);; let AFFINE_STANDARD_HYPERPLANE = prove (`!a b k. affine {x:real^N | x$k = b}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `b:real`] AFFINE_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let AFFINE_INTERS = prove (`(!s. s IN f ==> affine s) ==> affine(INTERS f)`, REWRITE_TAC[affine; IN_INTERS] THEN MESON_TAC[]);; let AFFINE_INTER = prove (`!s t. affine s /\ affine t ==> affine(s INTER t)`, REWRITE_TAC[affine; IN_INTER] THEN MESON_TAC[]);; let AFFINE_AFFINE_HULL = prove (`!s. affine(affine hull s)`, SIMP_TAC[P_HULL; AFFINE_INTERS]);; let AFFINE_HULL_EQ = prove (`!s. (affine hull s = s) <=> affine s`, SIMP_TAC[HULL_EQ; AFFINE_INTERS]);; let IS_AFFINE_HULL = prove (`!s. affine s <=> ?t. s = affine hull t`, GEN_TAC THEN MATCH_MP_TAC IS_HULL THEN SIMP_TAC[AFFINE_INTERS]);; let AFFINE_HULL_UNIV = prove (`affine hull (:real^N) = (:real^N)`, REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_UNIV]);; let AFFINE_HULLS_EQ = prove (`!s t. s SUBSET affine hull t /\ t SUBSET affine hull s ==> affine hull s = affine hull t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HULLS_EQ THEN ASM_SIMP_TAC[AFFINE_INTERS]);; let AFFINE_HULL_TRANSLATION = prove (`!a s. affine hull (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (affine hull s)`, REWRITE_TAC[hull] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [AFFINE_HULL_TRANSLATION];; let AFFINE_HULL_LINEAR_IMAGE = prove (`!f s. linear f ==> affine hull (IMAGE f s) = IMAGE f (affine hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[FUN_IN_IMAGE; HULL_INC] THEN REWRITE_TAC[affine; IN_ELIM_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[REWRITE_RULE[affine] AFFINE_AFFINE_HULL]; ASM_SIMP_TAC[LINEAR_ADD; LINEAR_CMUL] THEN MESON_TAC[REWRITE_RULE[affine] AFFINE_AFFINE_HULL]]);; add_linear_invariants [AFFINE_HULL_LINEAR_IMAGE];; let IN_AFFINE_HULL_LINEAR_IMAGE = prove (`!f:real^M->real^N s x. linear f /\ x IN affine hull s ==> (f x) IN affine hull (IMAGE f s)`, SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN SET_TAC[]);; let SAME_DISTANCES_TO_AFFINE_HULL = prove (`!s a b:real^N. (!x. x IN s ==> dist(x,a) = dist(x,b)) ==> (!x. x IN affine hull s ==> dist(x,a) = dist(x,b))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN ASM_REWRITE_TAC[AFFINE_ALT; IN_ELIM_THM] THEN REWRITE_TAC[dist; NORM_EQ_SQUARE; NORM_POS_LE; VECTOR_ARITH `((&1 - u) % x + u % y) - a:real^N = (&1 - u) % (x - a) + u % (y - a)`] THEN REWRITE_TAC[NORM_POW_2; DOT_LMUL; DOT_RMUL; VECTOR_ARITH `(x + y) dot (x + y):real^N = (x dot x + y dot y) + &2 * x dot y`] THEN SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Some convenient lemmas about common affine combinations. *) (* ------------------------------------------------------------------------- *) let IN_AFFINE_ADD_MUL = prove (`!s a x:real^N d. affine s /\ a IN s /\ (a + x) IN s ==> (a + d % x) IN s`, REWRITE_TAC[affine] THEN REPEAT STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `a + d % x:real^N = (&1 - d) % a + d % (a + x)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let IN_AFFINE_ADD_MUL_DIFF = prove (`!s a x y z:real^N. affine s /\ x IN s /\ y IN s /\ z IN s ==> (x + a % (y - z)) IN s`, REWRITE_TAC[affine] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH `x + a % (y - z):real^N = &1 / &2 % ((&1 - &2 * a) % x + (&2 * a) % y) + &1 / &2 % ((&1 + &2 * a) % x + (-- &2 * a) % z)`] THEN FIRST_ASSUM MATCH_MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let IN_AFFINE_MUL_DIFF_ADD = prove (`!s a x y z:real^N. affine s /\ x IN s /\ y IN s /\ z IN s ==> a % (x - y) + z IN s`, ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF]);; let IN_AFFINE_SUB_MUL_DIFF = prove (`!s a x y z:real^N. affine s /\ x IN s /\ y IN s /\ z IN s ==> x - a % (y - z) IN s`, REWRITE_TAC[VECTOR_ARITH `x - a % (y - z):real^N = x + a % (z - y)`] THEN SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF]);; let AFFINE_DIFFS_SUBSPACE = prove (`!s:real^N->bool a. affine s /\ a IN s ==> subspace {x - a | x IN s}`, REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = x - a <=> x = a`; VECTOR_ARITH `x - a + y - a:real^N = z - a <=> z = (a + &1 % (x - a)) + &1 % (y - a)`; VECTOR_ARITH `c % (x - a):real^N = y - a <=> y = a + c % (x - a)`] THEN MESON_TAC[IN_AFFINE_ADD_MUL_DIFF]);; (* ------------------------------------------------------------------------- *) (* Explicit formulations for affine combinations. *) (* ------------------------------------------------------------------------- *) let AFFINE_VSUM = prove (`!s k u x:A->real^N. FINITE k /\ affine s /\ sum k u = &1 /\ (!i. i IN k ==> x i IN s) ==> vsum k (\i. u i % x i) IN s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES] THEN REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] AFFINE_DIFFS_SUBSPACE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`{x - a:real^N | x IN s}`; `(\i. u i % (x i - a)):A->real^N`; `k:A->bool`] SUBSPACE_VSUM) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ASM_SIMP_TAC[VSUM_SUB; IN_ELIM_THM; VECTOR_SUB_LDISTRIB; VSUM_RMUL] THEN REWRITE_TAC[VECTOR_ARITH `x - &1 % a:real^N = y - a <=> x = y`] THEN ASM_MESON_TAC[]]);; let AFFINE_VSUM_STRONG = prove (`!s k u x:A->real^N. affine s /\ sum k u = &1 /\ (!i. i IN k ==> u i = &0 \/ x i IN s) ==> vsum k (\i. u i % x i) IN s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `vsum k (\i. u i % (x:A->real^N) i) = vsum {i | i IN k /\ ~(u i = &0)} (\i. u i % x i)` SUBST1_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN SET_TAC[]; MATCH_MP_TAC AFFINE_VSUM THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[SUM_DEGENERATE; REAL_ARITH `~(&1 = &0)`]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM SET_TAC[]; ASM SET_TAC[]]]);; let AFFINE_INDEXED = prove (`!s:real^N->bool. affine s <=> !k u x. (!i:num. 1 <= i /\ i <= k ==> x(i) IN s) /\ (sum (1..k) u = &1) ==> vsum (1..k) (\i. u(i) % x(i)) IN s`, REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_VSUM THEN ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]; DISCH_TAC THEN REWRITE_TAC[affine] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `2`) THEN DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then u else v:real`) THEN DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then x else y:real^N`) THEN REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG; VSUM_CLAUSES_NUMSEG; NUMSEG_SING; VSUM_SING; SUM_SING] THEN REWRITE_TAC[ARITH] THEN ASM_MESON_TAC[]]);; let AFFINE_HULL_INDEXED = prove (`!s. affine hull s = {y:real^N | ?k u x. (!i. 1 <= i /\ i <= k ==> x i IN s) /\ (sum (1..k) u = &1) /\ (vsum (1..k) (\i. u i % x i) = y)}`, GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`1`; `\i:num. &1`; `\i:num. x:real^N`] THEN ASM_SIMP_TAC[FINITE_RULES; IN_SING; SUM_SING; VECTOR_MUL_LID; VSUM_SING; REAL_POS; NUMSEG_SING]; ALL_TAC; REWRITE_TAC[AFFINE_INDEXED; SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MESON_TAC[]] THEN REWRITE_TAC[affine; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:num`; `u1:num->real`; `x1:num->real^N`; `k2:num`; `u2:num->real`; `x2:num->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `k1 + k2:num` THEN EXISTS_TAC `\i:num. if i <= k1 then u * u1(i) else v * u2(i - k1):real` THEN EXISTS_TAC `\i:num. if i <= k1 then x1(i) else x2(i - k1):real^N` THEN ASM_SIMP_TAC[NUMSEG_ADD_SPLIT; ARITH_RULE `1 <= x + 1 /\ x < x + 1`; IN_NUMSEG; SUM_UNION; VSUM_UNION; FINITE_NUMSEG; DISJOINT_NUMSEG; ARITH_RULE `k1 + 1 <= i ==> ~(i <= k1)`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] NUMSEG_OFFSET_IMAGE] THEN ASM_SIMP_TAC[SUM_IMAGE; VSUM_IMAGE; EQ_ADD_LCANCEL; FINITE_NUMSEG] THEN ASM_SIMP_TAC[o_DEF; ADD_SUB2; SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC; FINITE_NUMSEG; REAL_MUL_RID] THEN ASM_MESON_TAC[REAL_LE_MUL; ARITH_RULE `i <= k1 + k2 /\ ~(i <= k1) ==> 1 <= i - k1 /\ i - k1 <= k2`]);; let AFFINE = prove (`!V:real^N->bool. affine V <=> !(s:real^N->bool) (u:real^N->real). FINITE s /\ ~(s = {}) /\ s SUBSET V /\ sum s u = &1 ==> vsum s (\x. u x % x) IN V`, GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_VSUM THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[affine] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB;VECTOR_MUL_LID];ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N,y}`) THEN DISCH_THEN(MP_TAC o SPEC `\w. if w = x:real^N then u else v:real`) THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_RULES; NUMSEG_SING; VSUM_SING; SUM_SING;SUBSET;IN_INSERT;NOT_IN_EMPTY] THEN ASM SET_TAC[]]);; let AFFINE_EXPLICIT = prove (`!s:real^N->bool. affine s <=> !t u. FINITE t /\ t SUBSET s /\ sum t u = &1 ==> vsum t (\x. u(x) % x) IN s`, GEN_TAC THEN REWRITE_TAC[AFFINE] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let AFFINE_HULL_EXPLICIT = prove (`!(p:real^N -> bool). affine hull p = {y | ?s u. FINITE s /\ ~(s = {}) /\ s SUBSET p /\ sum s u = &1 /\ vsum s (\v. u v % v) = y}`, GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET;IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`{x:real^N}`;`\v:real^N. &1:real`] THEN ASM_SIMP_TAC[FINITE_RULES;IN_SING;SUM_SING;VSUM_SING;VECTOR_MUL_LID] THEN SET_TAC[]; REWRITE_TAC[affine;IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(s UNION s'):real^N->bool` THEN EXISTS_TAC `\a:real^N. (\b:real^N.if (b IN s) then (u * (u' b)) else &0) a + (\b:real^N.if (b IN s') then v * (u'' b) else &0) a` THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[FINITE_UNION]; ASM SET_TAC[]; ASM_REWRITE_TAC[UNION_SUBSET]; ASM_SIMP_TAC[REWRITE_RULE[REAL_ARITH `a + b = c + d <=> c = a + b - d`] SUM_INCL_EXCL; GSYM SUM_RESTRICT_SET; SET_RULE `{a | a IN (s:A->bool) /\ a IN s'} = s INTER s'`; SUM_ADD;SUM_LMUL;REAL_MUL_RID; FINITE_INTER;INTER_IDEMPOT] THEN ASM_REWRITE_TAC[SET_RULE `(a INTER b) INTER a = a INTER b`; SET_RULE `(a INTER b) INTER b = a INTER b`; REAL_ARITH `(a + b) + (c + d) - (e + b) = (a + d) + c - e`; REAL_ARITH `a + b - c = a <=> b = c`] THEN AP_TERM_TAC THEN REWRITE_TAC[INTER_COMM]; ASM_SIMP_TAC[REWRITE_RULE [VECTOR_ARITH `(a:real^N) + b = c + d <=> c = a + b - d`] VSUM_INCL_EXCL;GSYM VSUM_RESTRICT_SET; SET_RULE `{a | a IN (s:A->bool) /\ a IN s'} = s INTER s'`; VSUM_ADD;FINITE_INTER;INTER_IDEMPOT;VECTOR_ADD_RDISTRIB; GSYM VECTOR_MUL_ASSOC;VSUM_LMUL; MESON[] `(if P then a else b) % (x:real^N) = (if P then a % x else b % x)`; VECTOR_MUL_LZERO;GSYM VSUM_RESTRICT_SET] THEN ASM_REWRITE_TAC[SET_RULE `(a INTER b) INTER a = a INTER b`; SET_RULE `(a INTER b) INTER b = a INTER b`; VECTOR_ARITH `((a:real^N) + b) + (c + d) - (e + b) = (a + d) + c - e`; VECTOR_ARITH `(a:real^N) + b - c = a <=> b = c`] THEN AP_TERM_TAC THEN REWRITE_TAC[INTER_COMM]]; ASM_CASES_TAC `(p:real^N->bool) = {}` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[SUBSET_EMPTY;EMPTY_SUBSET] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[AFFINE; SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN ASM SET_TAC[]]);; let AFFINE_HULL_EXPLICIT_ALT = prove (`!(p:real^N -> bool). affine hull p = {y | ?s u. FINITE s /\ s SUBSET p /\ sum s u = &1 /\ vsum s (\v. u v % v) = y}`, GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_EXPLICIT] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ]);; let AFFINE_HULL_FINITE = prove (`!s:real^N->bool. affine hull s = {y | ?u. sum s u = &1 /\ vsum s (\v. u v % v) = y}`, GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[AFFINE_HULL_EXPLICIT; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `f:real^N->real`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. if x IN t then f x else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]; X_GEN_TAC `f:real^N->real` THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN STRIP_TAC THEN EXISTS_TAC `support (+) (f:real^N->real) s` THEN EXISTS_TAC `f:real^N->real` THEN MP_TAC(ASSUME `sum s (f:real^N->real) = &1`) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sum] THEN REWRITE_TAC[iterate] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NEUTRAL_REAL_ADD; REAL_OF_NUM_EQ; ARITH] THEN DISCH_THEN(K ALL_TAC) THEN UNDISCH_TAC `sum s (f:real^N->real) = &1` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM SUM_SUPPORT] THEN ASM_CASES_TAC `support (+) (f:real^N->real) s = {}` THEN ASM_SIMP_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN DISCH_TAC THEN REWRITE_TAC[SUPPORT_SUBSET] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[SUPPORT_SUBSET] THEN REWRITE_TAC[support; IN_ELIM_THM; NEUTRAL_REAL_ADD] THEN MESON_TAC[VECTOR_MUL_LZERO]]);; let AFFINE_HULL_0_EXPLICIT = prove (`!s:real^N->bool. vec 0 IN affine hull s <=> ?t u. FINITE t /\ ~(t = {}) /\ t SUBSET s /\ ~(sum t u = &0) /\ vsum t (\x. u x % x) = vec 0`, GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_EXPLICIT; IN_ELIM_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[] THEN EQ_TAC THENL [MESON_TAC[REAL_RAT_REDUCE_CONV `&1 = &0`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^N. inv(sum t u) * u x` THEN ASM_REWRITE_TAC[SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* Stepping theorems and hence small special cases. *) (* ------------------------------------------------------------------------- *) let AFFINE_HULL_EMPTY = prove (`affine hull {} = {}`, MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[SUBSET_REFL; AFFINE_EMPTY; EMPTY_SUBSET]);; let AFFINE_HULL_EQ_EMPTY = prove (`!s. (affine hull s = {}) <=> (s = {})`, GEN_TAC THEN EQ_TAC THEN MESON_TAC[SUBSET_EMPTY; HULL_SUBSET; AFFINE_HULL_EMPTY]);; let AFFINE_HULL_FINITE_STEP_GEN = prove (`!P:real^N->real->bool. ((?u. (!x. x IN {} ==> P x (u x)) /\ sum {} u = w /\ vsum {} (\x. u(x) % x) = y) <=> w = &0 /\ y = vec 0) /\ (FINITE(s:real^N->bool) /\ (!y. a IN s /\ P a y ==> P a (y / &2)) /\ (!x y. a IN s /\ P a x /\ P a y ==> P a (x + y)) ==> ((?u. (!x. x IN (a INSERT s) ==> P x (u x)) /\ sum (a INSERT s) u = w /\ vsum (a INSERT s) (\x. u(x) % x) = y) <=> ?v u. P a v /\ (!x. x IN s ==> P x (u x)) /\ sum s u = w - v /\ vsum s (\x. u(x) % x) = y - v % a))`, GEN_TAC THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NOT_IN_EMPTY] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN EXISTS_TAC `(u:real^N->real) a / &2` THEN EXISTS_TAC `\x:real^N. if x = a then u x / &2 else u x`; MAP_EVERY X_GEN_TAC [`v:real`; `u:real^N->real`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. if x = a then u x + v else u x`] THEN ASM_SIMP_TAC[] THEN (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES; SUM_CASES] THEN ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; VSUM_DELETE] THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN REWRITE_TAC[SUM_SING; VSUM_SING] THEN (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]); EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN EXISTS_TAC `(u:real^N->real) a` THEN EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[IN_INSERT] THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]; MAP_EVERY X_GEN_TAC [`v:real`; `u:real^N->real`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. if x = a then v:real else u x` THEN ASM_SIMP_TAC[IN_INSERT] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES; SUM_CASES] THEN ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; VSUM_DELETE] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {x | x IN s /\ x = a} = {}`] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`] THEN REWRITE_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]]]);; let AFFINE_HULL_FINITE_STEP = prove (`((?u. sum {} u = w /\ vsum {} (\x. u(x) % x) = y) <=> w = &0 /\ y = vec 0) /\ (FINITE(s:real^N->bool) ==> ((?u. sum (a INSERT s) u = w /\ vsum (a INSERT s) (\x. u(x) % x) = y) <=> ?v u. sum s u = w - v /\ vsum s (\x. u(x) % x) = y - v % a))`, MATCH_ACCEPT_TAC (REWRITE_RULE[] (ISPEC `\x:real^N y:real. T` AFFINE_HULL_FINITE_STEP_GEN)));; let AFFINE_HULL_2 = prove (`!a b. affine hull {a,b} = {u % a + v % b | u + v = &1}`, SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN SIMP_TAC[AFFINE_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; let AFFINE_HULL_2_ALT = prove (`!a b. affine hull {a,b} = {a + u % (b - a) | u IN (:real)}`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_2] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; ARITH_RULE `u + v = &1 <=> v = &1 - u`; FORALL_UNWIND_THM2; UNWIND_THM2] THEN CONJ_TAC THEN X_GEN_TAC `u:real` THEN EXISTS_TAC `&1 - u` THEN VECTOR_ARITH_TAC);; let AFFINE_HULL_3 = prove (`affine hull {a,b,c} = { u % a + v % b + w % c | u + v + w = &1}`, SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN SIMP_TAC[AFFINE_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; let AFFINE_HULL_0_2_EXPLICIT = prove (`!x y:real^N. vec 0 IN affine hull {x,y} <=> ?a b. a % x + b % y = vec 0 /\ ~(a + b = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM] THEN EQ_TAC THENL [MESON_TAC[REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a / (a + b):real`; `b / (a + b):real`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; VECTOR_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_MUL_LINV]);; let AFFINE_HULL_0_3_EXPLICIT = prove (`!x y z:real^N. vec 0 IN affine hull {x,y,z} <=> ?a b c. a % x + b % y + c % z = vec 0 /\ ~(a + b + c = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM] THEN EQ_TAC THENL [MESON_TAC[REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a / (a + b + c):real`; `b / (a + b + c):real`; `c / (a + b + c):real`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; VECTOR_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_MUL_LINV]);; (* ------------------------------------------------------------------------- *) (* Some relations between affine hull and subspaces. *) (* ------------------------------------------------------------------------- *) let AFFINE_HULL_INSERT_SUBSET_SPAN = prove (`!a:real^N s. affine hull (a INSERT s) SUBSET {a + v | v | v IN span {x - a | x IN s}}`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[AFFINE_HULL_EXPLICIT; SPAN_EXPLICIT; IN_ELIM_THM] THEN REWRITE_TAC[SIMPLE_IMAGE; CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[MESON[] `(?s u. (?t. P t /\ s = f t) /\ Q s u) <=> (?t u. P t /\ Q (f t) u)`] THEN REWRITE_TAC[MESON[] `(?v. (?s u. P s /\ f s u = v) /\ (x = g a v)) <=> (?s u. ~(P s ==> ~(g a (f s u) = x)))`] THEN SIMP_TAC[VSUM_IMAGE; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN REWRITE_TAC[o_DEF] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (SUBST1_TAC o SYM)) THEN MAP_EVERY EXISTS_TAC [`t DELETE (a:real^N)`; `\x. (u:real^N->real)(x + a)`] THEN ASM_SIMP_TAC[FINITE_DELETE; VECTOR_SUB_ADD; SET_RULE `t SUBSET (a INSERT s) ==> t DELETE a SUBSET s`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `a + vsum t (\x. u x % (x - a)):real^N` THEN CONJ_TAC THENL [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN SET_TAC[]; ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; FINITE_DELETE; VSUM_SUB] THEN ASM_REWRITE_TAC[VSUM_RMUL] THEN REWRITE_TAC[VECTOR_ARITH `a + x - &1 % a:real^N = x`]]);; let AFFINE_HULL_INSERT_SPAN = prove (`!a:real^N s. ~(a IN s) ==> affine hull (a INSERT s) = {a + v | v | v IN span {x - a | x IN s}}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[AFFINE_HULL_INSERT_SUBSET_SPAN] THEN REWRITE_TAC[SUBSET] THEN REWRITE_TAC[AFFINE_HULL_EXPLICIT; SPAN_EXPLICIT; IN_ELIM_THM] THEN REWRITE_TAC[SIMPLE_IMAGE; CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[MESON[] `(?s u. (?t. P t /\ s = f t) /\ Q s u) <=> (?t u. P t /\ Q (f t) u)`] THEN REWRITE_TAC[MESON[] `(?v. (?s u. P s /\ f s u = v) /\ (x = g a v)) <=> (?s u. ~(P s ==> ~(g a (f s u) = x)))`] THEN SIMP_TAC[VSUM_IMAGE; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN REWRITE_TAC[o_DEF] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (SUBST1_TAC o SYM)) THEN MAP_EVERY EXISTS_TAC [`(a:real^N) INSERT t`; `\x. if x = a then &1 - sum t (\x. u(x - a)) else (u:real^N->real)(x - a)`] THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[FINITE_INSERT; NOT_INSERT_EMPTY; SET_RULE `s SUBSET t ==> (a INSERT s) SUBSET (a INSERT t)`] THEN SUBGOAL_THEN `!x:real^N. x IN t ==> ~(x = a)` MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC)] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; FINITE_DELETE; VSUM_SUB] THEN ASM_REWRITE_TAC[VSUM_RMUL] THEN VECTOR_ARITH_TAC);; let AFFINE_HULL_SPAN = prove (`!a:real^N s. a IN s ==> (affine hull s = {a + v | v | v IN span {x - a | x | x IN (s DELETE a)}})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N`; `s DELETE (a:real^N)`] AFFINE_HULL_INSERT_SPAN) THEN ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let DIFFS_AFFINE_HULL_SPAN = prove (`!a:real^N s. a IN s ==> {x - a | x IN affine hull s} = span {x - a | x IN s}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP AFFINE_HULL_SPAN) THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID] THEN SIMP_TAC[IMAGE_DELETE_INJ; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN REWRITE_TAC[VECTOR_SUB_REFL; SPAN_DELETE_0]);; let AFFINE_HULL_SING = prove (`!a. affine hull {a} = {a}`, SIMP_TAC[AFFINE_HULL_INSERT_SPAN; NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x | x | F} = {}`; SPAN_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`; VECTOR_ADD_RID]);; let AFFINE_HULL_EQ_SING = prove (`!s a:real^N. affine hull s = {a} <=> s = {a}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[AFFINE_HULL_SING] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET {a} ==> s = {a}`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[HULL_SUBSET]);; let AFFINE_HULL_SCALING = prove (`!s:real^N->bool c. affine hull (IMAGE (\x. c % x) s) = IMAGE (\x. c % x) (affine hull s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [ASM_SIMP_TAC[IMAGE_CONST; VECTOR_MUL_LZERO; AFFINE_HULL_EQ_EMPTY] THEN COND_CASES_TAC THEN REWRITE_TAC[AFFINE_HULL_EMPTY; AFFINE_HULL_SING]; ALL_TAC] THEN MATCH_MP_TAC HULL_IMAGE THEN ASM_SIMP_TAC[AFFINE_SCALING_EQ; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[VECTOR_ARITH `c % x = c % y <=> c % (x - y) = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN X_GEN_TAC `x:real^N` THEN EXISTS_TAC `inv c % x:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]);; let AFFINE_HULL_AFFINITY = prove (`!s a:real^N c. affine hull (IMAGE (\x. c % x + a) s) = IMAGE (\x. c % x + a) (affine hull s)`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINITY_SCALING_TRANSLATION] THEN ASM_SIMP_TAC[IMAGE_o; AFFINE_HULL_TRANSLATION; AFFINE_HULL_SCALING]);; (* ------------------------------------------------------------------------- *) (* Convexity. *) (* ------------------------------------------------------------------------- *) let convex = new_definition `convex s <=> !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) ==> (u % x + v % y) IN s`;; let CONVEX_ALT = prove (`convex s <=> !x y u. x IN s /\ y IN s /\ &0 <= u /\ u <= &1 ==> ((&1 - u) % x + u % y) IN s`, REWRITE_TAC[convex] THEN MESON_TAC[REAL_ARITH `&0 <= u /\ &0 <= v /\ (u + v = &1) ==> v <= &1 /\ (u = &1 - v)`; REAL_ARITH `u <= &1 ==> &0 <= &1 - u /\ ((&1 - u) + u = &1)`]);; let IN_CONVEX_SET = prove (`!s a b u. convex s /\ a IN s /\ b IN s /\ &0 <= u /\ u <= &1 ==> ((&1 - u) % a + u % b) IN s`, MESON_TAC[CONVEX_ALT]);; let MIDPOINT_IN_CONVEX = prove (`!s x y:real^N. convex s /\ x IN s /\ y IN s ==> midpoint(x,y) IN s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `y:real^N`; `&1 / &2`] IN_CONVEX_SET) THEN ASM_REWRITE_TAC[midpoint] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC VECTOR_ARITH);; let CONVEX_CONTAINS_SEGMENT = prove (`!s. convex s <=> !a b. a IN s /\ b IN s ==> segment[a,b] SUBSET s`, REWRITE_TAC[CONVEX_ALT; segment; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let CONVEX_CONTAINS_OPEN_SEGMENT = prove (`!s. convex s <=> !a b. a IN s /\ b IN s ==> segment(a,b) SUBSET s`, ONCE_REWRITE_TAC[segment] THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN SET_TAC[]);; let CONVEX_CONTAINS_SEGMENT_EQ = prove (`!s:real^N->bool. convex s <=> !a b. segment[a,b] SUBSET s <=> a IN s /\ b IN s`, REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET] THEN MESON_TAC[ENDS_IN_SEGMENT]);; let CONVEX_CONTAINS_SEGMENT_IMP = prove (`!s a b. convex s ==> (segment[a,b] SUBSET s <=> a IN s /\ b IN s)`, SIMP_TAC[CONVEX_CONTAINS_SEGMENT_EQ]);; let SEGMENT_SUBSET_CONVEX = prove (`!s a b:real^N. convex s /\ a IN s /\ b IN s ==> segment[a,b] SUBSET s`, MESON_TAC[CONVEX_CONTAINS_SEGMENT]);; let CONVEX_EMPTY = prove (`convex {}`, REWRITE_TAC[convex; NOT_IN_EMPTY]);; let CONVEX_SING = prove (`!a. convex {a}`, SIMP_TAC[convex; IN_SING; GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]);; let CONVEX_UNIV = prove (`convex(UNIV:real^N->bool)`, REWRITE_TAC[convex; IN_UNIV]);; let CONVEX_INTERS = prove (`(!s. s IN f ==> convex s) ==> convex(INTERS f)`, REWRITE_TAC[convex; IN_INTERS] THEN MESON_TAC[]);; let CONVEX_INTER = prove (`!s t. convex s /\ convex t ==> convex(s INTER t)`, REWRITE_TAC[convex; IN_INTER] THEN MESON_TAC[]);; let CONVEX_HALFSPACE_LE = prove (`!a b. convex {x | a dot x <= b}`, REWRITE_TAC[convex; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(u + v) * b` THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_ADD_RDISTRIB; REAL_LE_ADD2; REAL_LE_LMUL]; ASM_MESON_TAC[REAL_MUL_LID; REAL_LE_REFL]]);; let CONVEX_HALFSPACE_COMPONENT_LE = prove (`!a k. convex {x:real^N | x$k <= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_LE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CONVEX_HALFSPACE_GE = prove (`!a b. convex {x:real^N | a dot x >= b}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `{x:real^N | a dot x >= b} = {x | --a dot x <= --b}` (fun th -> REWRITE_TAC[th; CONVEX_HALFSPACE_LE]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; DOT_LNEG] THEN REAL_ARITH_TAC);; let CONVEX_HALFSPACE_COMPONENT_GE = prove (`!a k. convex {x:real^N | x$k >= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_GE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CONVEX_HYPERPLANE = prove (`!a b. convex {x:real^N | a dot x = b}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `{x:real^N | a dot x = b} = {x | a dot x <= b} INTER {x | a dot x >= b}` (fun th -> SIMP_TAC[th; CONVEX_INTER; CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE]) THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_STANDARD_HYPERPLANE = prove (`!k a. convex {x:real^N | x$k = a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CONVEX_HALFSPACE_LT = prove (`!a b. convex {x | a dot x < b}`, REWRITE_TAC[convex; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REWRITE_TAC[]);; let CONVEX_HALFSPACE_COMPONENT_LT = prove (`!a k. convex {x:real^N | x$k < a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_LT) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CONVEX_HALFSPACE_GT = prove (`!a b. convex {x | a dot x > b}`, REWRITE_TAC[REAL_ARITH `ax > b <=> --ax < --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; CONVEX_HALFSPACE_LT]);; let CONVEX_HALFSPACE_COMPONENT_GT = prove (`!a k. convex {x:real^N | x$k > a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_GT) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CONVEX_STRIP_COMPONENT_LE = prove (`!a k. convex {x:real^N | abs(x$k) <= a}`, REWRITE_TAC[REAL_ARITH `abs(x) <= a <=> x <= a /\ x >= --a`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CONVEX_HALFSPACE_COMPONENT_LE; CONVEX_HALFSPACE_COMPONENT_GE; CONVEX_INTER]);; let CONVEX_STRIP_COMPONENT_LT = prove (`!a k. convex {x:real^N | abs(x$k) < a}`, REWRITE_TAC[REAL_ARITH `abs(x) < a <=> x < a /\ x > --a`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CONVEX_HALFSPACE_COMPONENT_LT; CONVEX_HALFSPACE_COMPONENT_GT; CONVEX_INTER]);; let CONVEX_HALFSPACE_SGN = prove (`!a b. convex {x:real^N | real_sgn(a dot x) = b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[CONVEX_HYPERPLANE; REAL_SGN_EQ] THEN ASM_CASES_TAC `b = -- &1` THEN ASM_REWRITE_TAC[CONVEX_HALFSPACE_LT; REAL_SGN_EQ] THEN ASM_CASES_TAC `b = &1` THEN ASM_REWRITE_TAC[CONVEX_HALFSPACE_GT; REAL_SGN_EQ] THEN ASM_SIMP_TAC[CONVEX_EMPTY; MATCH_MP (SET_RULE `(!x. P(real_sgn x)) ==> ~(P b) ==> {x | real_sgn(f x) = b} = {}`) REAL_SGN_CASES]);; let CONVEX_HALFSPACE_COMPONENT_SGN = prove (`!a k. convex {x:real^N | real_sgn(x$k) = a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_SGN) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CONVEX_POSITIVE_ORTHANT = prove (`convex {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`, SIMP_TAC[convex; IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; REAL_LE_MUL; REAL_LE_ADD]);; let LIMPT_OF_CONVEX = prove (`!s x:real^N. convex s /\ x IN s ==> (x limit_point_of s <=> ~(s = {x}))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s = {x:real^N}` THEN ASM_REWRITE_TAC[LIMPT_SING] THEN SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ABBREV_TAC `u = min (&1 / &2) (e / &2 / norm(y - x:real^N))` THEN SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; ALL_TAC] THEN EXISTS_TAC `(&1 - u) % x + u % y:real^N` THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `(&1 - u) % x + u % y:real^N = x <=> u % (y - x) = vec 0`] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH `((&1 - u) % x + u % y) - x:real^N = u % (y - x)`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < u ==> abs u = u`] THEN MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let TRIVIAL_LIMIT_WITHIN_CONVEX = prove (`!s x:real^N. convex s /\ x IN s ==> (trivial_limit(at x within s) <=> s = {x})`, SIMP_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_OF_CONVEX]);; (* ------------------------------------------------------------------------- *) (* Some invariance theorems for convex sets. *) (* ------------------------------------------------------------------------- *) let CONVEX_TRANSLATION_EQ = prove (`!a:real^N s. convex (IMAGE (\x. a + x) s) <=> convex s`, REWRITE_TAC[CONVEX_ALT; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; UNWIND_THM1; VECTOR_ARITH `(&1 - u) % (a + x) + u % (a + y) = a + z <=> (&1 - u) % x + u % y = z`]);; add_translation_invariants [CONVEX_TRANSLATION_EQ];; let CONVEX_TRANSLATION = prove (`!s a:real^N. convex s ==> convex (IMAGE (\x. a + x) s)`, REWRITE_TAC[CONVEX_TRANSLATION_EQ]);; let CONVEX_LINEAR_IMAGE = prove (`!f s. convex s /\ linear f ==> convex(IMAGE f s)`, REWRITE_TAC[convex; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_IMAGE; linear] THEN MESON_TAC[]);; let CONVEX_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (convex (IMAGE f s) <=> convex s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONVEX_LINEAR_IMAGE));; add_linear_invariants [CONVEX_LINEAR_IMAGE_EQ];; (* ------------------------------------------------------------------------- *) (* Explicit expressions for convexity in terms of arbitrary sums. *) (* ------------------------------------------------------------------------- *) let CONVEX_VSUM = prove (`!s k u x:A->real^N. FINITE k /\ convex s /\ sum k u = &1 /\ (!i. i IN k ==> &0 <= u i /\ x i IN s) ==> vsum k (\i. u i % x i) IN s`, GEN_TAC THEN ASM_CASES_TAC `convex(s:real^N->bool)` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FORALL_IN_INSERT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN GEN_REWRITE_TAC (BINOP_CONV o DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`u:A->real`; `x:A->real^N`] THEN ASM_CASES_TAC `(u:A->real) i = &1` THENL [ASM_REWRITE_TAC[REAL_ARITH `&1 + a = &1 <=> a = &0`] THEN STRIP_TAC THEN SUBGOAL_THEN `vsum k (\i:A. u i % x(i):real^N) = vec 0` (fun th -> ASM_SIMP_TAC[th; VECTOR_ADD_RID; VECTOR_MUL_LID]) THEN MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN ASM_MESON_TAC[SUM_POS_EQ_0]; STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\j:A. u(j) / (&1 - u(i))`) THEN ASM_REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `&0 < &1 - u(i:A)` ASSUME_TAC THENL [ASM_MESON_TAC[SUM_POS_LE; REAL_ADD_SYM; REAL_ARITH `&0 <= a /\ &0 <= b /\ b + a = &1 /\ ~(a = &1) ==> &0 < &1 - a`]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_MUL_LID; REAL_EQ_SUB_LADD] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex]) THEN DISCH_THEN(MP_TAC o SPECL [`vsum k (\j. (u j / (&1 - u(i:A))) % x(j) :real^N)`; `x(i:A):real^N`; `&1 - u(i:A)`; `u(i:A):real`]) THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; VSUM_LMUL] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; REAL_ARITH_TAC] THEN ASM_MESON_TAC[REAL_ADD_SYM]]);; let CONVEX_VSUM_STRONG = prove (`!s k u x:A->real^N. convex s /\ sum k u = &1 /\ (!i. i IN k ==> &0 <= u i /\ (u i = &0 \/ x i IN s)) ==> vsum k (\i. u i % x i) IN s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `vsum k (\i. u i % (x:A->real^N) i) = vsum {i | i IN k /\ ~(u i = &0)} (\i. u i % x i)` SUBST1_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN SET_TAC[]; MATCH_MP_TAC CONVEX_VSUM THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[SUM_DEGENERATE; REAL_ARITH `~(&1 = &0)`]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM SET_TAC[]; ASM SET_TAC[]]]);; let CONVEX_INDEXED = prove (`!s:real^N->bool. convex s <=> !k u x. (!i:num. 1 <= i /\ i <= k ==> &0 <= u(i) /\ x(i) IN s) /\ (sum (1..k) u = &1) ==> vsum (1..k) (\i. u(i) % x(i)) IN s`, REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]; DISCH_TAC THEN REWRITE_TAC[convex] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `2`) THEN DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then u else v:real`) THEN DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then x else y:real^N`) THEN REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG; VSUM_CLAUSES_NUMSEG; NUMSEG_SING; VSUM_SING; SUM_SING] THEN REWRITE_TAC[ARITH] THEN ASM_MESON_TAC[]]);; let CONVEX_EXPLICIT = prove (`!s:real^N->bool. convex s <=> !t u. FINITE t /\ t SUBSET s /\ (!x. x IN t ==> &0 <= u x) /\ sum t u = &1 ==> vsum t (\x. u(x) % x) IN s`, REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; DISCH_TAC THEN REWRITE_TAC[convex] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN ASM_CASES_TAC `x:real^N = y` THENL [ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N,y}`) THEN DISCH_THEN(MP_TAC o SPEC `\z:real^N. if z = x then u else v:real`) THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_RULES; SUM_CLAUSES; VSUM_CLAUSES; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; REAL_ADD_RID; SUBSET] THEN REWRITE_TAC[VECTOR_ADD_RID] THEN ASM_MESON_TAC[]]);; let CONVEX = prove (`!V:real^N->bool. convex V <=> !(s:real^N->bool) (u:real^N->real). FINITE s /\ ~(s = {}) /\ s SUBSET V /\ (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 ==> vsum s (\x. u x % x) IN V`, GEN_TAC THEN REWRITE_TAC[CONVEX_EXPLICIT] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let CONVEX_FINITE = prove (`!s:real^N->bool. FINITE s ==> (convex s <=> !u. (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 ==> vsum s (\x. u(x) % x) IN s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONVEX_EXPLICIT] THEN EQ_TAC THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^N. if x IN t then u x else &0`) THEN ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL; GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[COND_ID; SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]);; let AFFINE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. affine s /\ affine t ==> affine(s PCROSS t)`, REWRITE_TAC[affine; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN SIMP_TAC[PASTECART_IN_PCROSS]);; let AFFINE_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. affine(s PCROSS t) <=> s = {} \/ t = {} \/ affine s /\ affine t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; AFFINE_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; AFFINE_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[AFFINE_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] AFFINE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] AFFINE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let CONVEX_PCROSS = prove (`!s:real^M->bool t:real^N->bool. convex s /\ convex t ==> convex(s PCROSS t)`, REWRITE_TAC[convex; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN SIMP_TAC[PASTECART_IN_PCROSS]);; let CONVEX_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. convex(s PCROSS t) <=> s = {} \/ t = {} \/ convex s /\ convex t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CONVEX_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CONVEX_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[CONVEX_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Conic sets and conic hull. *) (* ------------------------------------------------------------------------- *) let conic = new_definition `conic s <=> !x c. x IN s /\ &0 <= c ==> (c % x) IN s`;; let SUBSPACE_IMP_CONIC = prove (`!s. subspace s ==> conic s`, SIMP_TAC[subspace; conic]);; let CONIC_EMPTY = prove (`conic {}`, REWRITE_TAC[conic; NOT_IN_EMPTY]);; let CONIC_UNIV = prove (`conic (UNIV:real^N->bool)`, REWRITE_TAC[conic; IN_UNIV]);; let CONIC_INTERS = prove (`(!s. s IN f ==> conic s) ==> conic(INTERS f)`, REWRITE_TAC[conic; IN_INTERS] THEN MESON_TAC[]);; let CONIC_LINEAR_IMAGE = prove (`!f s. conic s /\ linear f ==> conic(IMAGE f s)`, REWRITE_TAC[conic; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LINEAR_CMUL]);; let CONIC_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (conic (IMAGE f s) <=> conic s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONIC_LINEAR_IMAGE));; add_linear_invariants [CONIC_LINEAR_IMAGE_EQ];; let CONIC_MUL = prove (`!s c x:real^N. conic s /\ x IN s /\ &0 <= c ==> (c % x) IN s`, REWRITE_TAC[conic] THEN MESON_TAC[]);; let CONIC_CONIC_HULL = prove (`!s. conic(conic hull s)`, SIMP_TAC[P_HULL; CONIC_INTERS]);; let CONIC_HULL_EQ = prove (`!s. (conic hull s = s) <=> conic s`, SIMP_TAC[HULL_EQ; CONIC_INTERS]);; let CONIC_HULL_UNIV = prove (`conic hull (:real^N) = (:real^N)`, REWRITE_TAC[HULL_UNIV]);; let CONIC_NEGATIONS = prove (`!s. conic s ==> conic (IMAGE (--) s)`, REWRITE_TAC[conic; RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; VECTOR_MUL_RNEG] THEN MESON_TAC[]);; let CONIC_SPAN = prove (`!s. conic(span s)`, SIMP_TAC[SUBSPACE_IMP_CONIC; SUBSPACE_SPAN]);; let CONIC_HULL_EXPLICIT = prove (`!s:real^N->bool. conic hull s = {c % x | &0 <= c /\ x IN s}`, GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[conic; SUBSET; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`&1`; `x:real^N`] THEN ASM_SIMP_TAC[REAL_POS; VECTOR_MUL_LID]; REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MESON_TAC[REAL_LE_MUL]; MESON_TAC[]]);; let CONIC_HULL_AS_IMAGE = prove (`!s:real^N->bool. conic hull s = IMAGE (\z. drop(fstcart z) % sndcart z) ({t | &0 <= drop t} PCROSS s)`, REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[IN_ELIM_THM; GSYM EXISTS_DROP] THEN MESON_TAC[]);; let CONIC_HULL_POINTLESS_AS_IMAGE = prove (`!s:real^N->bool. conic hull s DELETE vec 0 = IMAGE (\z. drop(fstcart z) % sndcart z) ({t | &0 < drop t} PCROSS (s DELETE vec 0))`, GEN_TAC THEN REWRITE_TAC[CONIC_HULL_AS_IMAGE; EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_IMAGE; IN_DELETE] THEN REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_DELETE; IN_ELIM_THM] THEN REWRITE_TAC[GSYM EXISTS_DROP; LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:real` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `b:real^N` THEN ASM_CASES_TAC `y:real^N = a % b` THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN REWRITE_TAC[REAL_LT_LE] THEN MESON_TAC[]);; let CONIC_HULL_LINEAR_IMAGE = prove (`!f s. linear f ==> conic hull (IMAGE f s) = IMAGE f (conic hull s)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[SET_RULE `IMAGE f {c % x | P c x} = {f(c % x) | P c x}`] THEN REWRITE_TAC[SET_RULE `{c % x | &0 <= c /\ x IN IMAGE f s} = {c % f(x) | &0 <= c /\ x IN s}`] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]));; add_linear_invariants [CONIC_HULL_LINEAR_IMAGE];; let CONIC_HULL_IMAGE_SCALE = prove (`!c s:real^N->bool. (!x. x IN s ==> &0 < c x) ==> conic hull (IMAGE (\x. c x % x) s) = conic hull s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONIC_CONIC_HULL; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[HULL_INC; CONIC_MUL; CONIC_CONIC_HULL; REAL_LT_IMP_LE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `x:real^N = inv(c x) % c x % x` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; REAL_LT_IMP_NZ]; MATCH_MP_TAC CONIC_MUL THEN ASM_SIMP_TAC[CONIC_CONIC_HULL; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]]);; let CONVEX_CONIC_HULL = prove (`!s:real^N->bool. convex s ==> convex (conic hull s)`, REWRITE_TAC[CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[CONVEX_ALT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; IMP_IMP] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`d:real`; `y:real^N`] THEN STRIP_TAC THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_CASES_TAC `(&1 - u) * c = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN ASM_MESON_TAC[REAL_LE_MUL]; ALL_TAC] THEN SUBGOAL_THEN `&0 < (&1 - u) * c + u * d` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LTE_ADD THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `(&1 - u) * c + u * d:real` THEN EXISTS_TAC `((&1 - u) * c) / ((&1 - u) * c + u * d) % x + (u * d) / ((&1 - u) * c + u * d) % y:real^N` THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_MUL; REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < u + v ==> u / (u + v) = &1 - (v / (u + v))`] THEN RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LE_MUL; REAL_MUL_LID; REAL_LE_ADDL; REAL_SUB_LE]);; let CONIC_HALFSPACE_LE = prove (`!a. conic {x | a dot x <= &0}`, REWRITE_TAC[conic; IN_ELIM_THM; DOT_RMUL] THEN REWRITE_TAC[REAL_ARITH `a <= &0 <=> &0 <= --a`] THEN SIMP_TAC[GSYM REAL_MUL_RNEG; REAL_LE_MUL]);; let CONIC_HALFSPACE_GE = prove (`!a. conic {x | a dot x >= &0}`, SIMP_TAC[conic; IN_ELIM_THM; DOT_RMUL; real_ge; REAL_LE_MUL]);; let CONIC_HULL_EMPTY = prove (`conic hull {} = {}`, MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[SUBSET_REFL; CONIC_EMPTY; EMPTY_SUBSET]);; let CONIC_CONTAINS_0 = prove (`!s:real^N->bool. conic s ==> (vec 0 IN s <=> ~(s = {}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [conic]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `&0`]) THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO]);; let CONIC_HULL_EQ_EMPTY = prove (`!s. (conic hull s = {}) <=> (s = {})`, GEN_TAC THEN EQ_TAC THEN MESON_TAC[SUBSET_EMPTY; HULL_SUBSET; CONIC_HULL_EMPTY]);; let CONIC_SUMS = prove (`!s t. conic s /\ conic t ==> conic {x + y:real^N | x IN s /\ y IN t}`, REWRITE_TAC[conic; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_LDISTRIB]);; let CONIC_PCROSS = prove (`!s:real^M->bool t:real^N->bool. conic s /\ conic t ==> conic(s PCROSS t)`, REWRITE_TAC[conic; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN SIMP_TAC[PASTECART_IN_PCROSS]);; let CONIC_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. conic(s PCROSS t) <=> s = {} \/ t = {} \/ conic s /\ conic t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CONIC_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CONIC_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[CONIC_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONIC_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONIC_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let CONIC_POSITIVE_ORTHANT = prove (`conic {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`, SIMP_TAC[conic; IN_ELIM_THM; REAL_LE_MUL; VECTOR_MUL_COMPONENT]);; let CONIC_HULL_0 = prove (`conic hull {vec 0} = {vec 0}`, REWRITE_TAC[EXTENSION; IN_SING; CONIC_HULL_EXPLICIT; IN_ELIM_THM] THEN MESON_TAC[VECTOR_MUL_RZERO; REAL_POS]);; let CONIC_HULL_CONTAINS_0 = prove (`!s:real^N->bool. vec 0 IN conic hull s <=> ~(s = {})`, SIMP_TAC[CONIC_CONTAINS_0; CONIC_HULL_EQ_EMPTY; CONIC_CONIC_HULL]);; let CONIC_HULL_EQ_SING = prove (`!s x:real^N. conic hull s = {x} <=> s = {vec 0} /\ x = vec 0`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONIC_HULL_0] THEN ASM_CASES_TAC `s SUBSET {x:real^N}` THENL [ALL_TAC; ASM_MESON_TAC[HULL_SUBSET]] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (SET_RULE `s SUBSET {a} ==> s = {} \/ s = {a}`)) THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; NOT_INSERT_EMPTY] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `{x:real^N}` CONIC_HULL_CONTAINS_0) THEN ASM_REWRITE_TAC[IN_SING; NOT_INSERT_EMPTY]);; let CONIC_HULL_INTER_AFFINE_HULL = prove (`!s f:real^N->bool. f SUBSET s /\ ~(vec 0 IN affine hull s) ==> (conic hull f) INTER (affine hull s) = f`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; HULL_SUBSET] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HULL_MONO; HULL_SUBSET; SUBSET_TRANS]] THEN REWRITE_TAC[SUBSET; IN_INTER; CONIC_HULL_EXPLICIT; IMP_CONJ; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN ASM_CASES_TAC `c = &1` THEN ASM_SIMP_TAC[VECTOR_MUL_LID] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `~((vec 0:real^N) IN affine hull s)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `vec 0:real^N = inv(&1 - c) % c % x + (&1 - inv(&1 - c)) % x` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN UNDISCH_TAC `~(c = &1)` THEN CONV_TAC REAL_FIELD; MP_TAC(ISPEC `affine hull s:real^N->bool` affine) THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[HULL_INC; SUBSET]; UNDISCH_TAC `~(c = &1)` THEN CONV_TAC REAL_FIELD]]);; let SEPARATE_CLOSED_CONES = prove (`!c d:real^N->bool. conic c /\ closed c /\ conic d /\ closed d /\ c INTER d SUBSET {vec 0} ==> ?e. &0 < e /\ !x y. x IN c /\ y IN d ==> dist(x,y) >= e * max (norm x) (norm y)`, SUBGOAL_THEN `!c d:real^N->bool. conic c /\ closed c /\ conic d /\ closed d /\ c INTER d SUBSET {vec 0} ==> ?e. &0 < e /\ !x y. x IN c /\ y IN d ==> dist(x,y) >= e * norm x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[real_ge] THEN MP_TAC(ISPECL [`c INTER sphere(vec 0:real^N,&1)`; `d:real^N->bool`] SEPARATE_COMPACT_CLOSED) THEN ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_SPHERE] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c INTER d SUBSET {a} ==> ~(a IN s) ==> (c INTER s) INTER d = {}`)) THEN REWRITE_TAC[IN_SPHERE_0; NORM_0] THEN REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DIST_POS_LE; REAL_MUL_RZERO; NORM_0] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv(norm x) % x:real^N`; `inv(norm(x:real^N)) % y:real^N`]) THEN REWRITE_TAC[dist; NORM_MUL; GSYM VECTOR_SUB_LDISTRIB] THEN REWRITE_TAC[REAL_ARITH `abs x * a = a * abs x`] THEN REWRITE_TAC[REAL_ABS_INV; GSYM real_div; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_DIV_REFL; NORM_EQ_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[conic]) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE]]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`c:real^N->bool`; `d:real^N->bool`] th) THEN MP_TAC(SPECL [`d:real^N->bool`; `c:real^N->bool`] th)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; real_ge] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[real_max] THEN COND_CASES_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `d * norm(y:real^N)` THEN ONCE_REWRITE_TAC[DIST_SYM]; EXISTS_TAC `e * norm(x:real^N)`] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN NORM_ARITH_TAC]);; let CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION = prove (`!s:real^N->bool v d:real^N->real. compact s /\ s SUBSET (v DELETE (vec 0)) /\ conic v /\ (!x k. x IN v DELETE (vec 0) ==> (&0 < k /\ (k % x) IN s <=> d x = k)) ==> (\x. d x % x) continuous_on (v DELETE (vec 0))`, let lemma = prove (`!s:real^N->real^N p srf:real^N->bool pnc. compact srf /\ srf SUBSET pnc /\ IMAGE s pnc SUBSET srf /\ (!x. x IN srf ==> s x = x) /\ p continuous_on pnc /\ (!x. x IN pnc ==> s(p x) = s x /\ p(s x) = p x) ==> s continuous_on pnc`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(s:real^N->real^N) o (p:real^N->real^N)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `IMAGE (p:real^N->real^N) pnc = IMAGE p srf` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]]) in REWRITE_TAC[conic; IN_DELETE; SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC [`\x:real^N. inv(norm x) % x`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[IN_DELETE; NORM_EQ_0; SIMP_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM]; REWRITE_TAC[IN_UNIV; IN_DELETE]] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `&1`]) THEN ASM_REWRITE_TAC[VECTOR_MUL_LID; REAL_LT_01; IN_DELETE] THEN ASM_MESON_TAC[VECTOR_MUL_LID; SUBSET; IN_DELETE]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o SPECL [`inv(norm x) % x:real^N`; `norm x * (d:real^N->real) x`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `(d:real^N->real) x`]) THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE; REAL_LT_MUL; NORM_POS_LT] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; REAL_FIELD `~(n = &0) ==> (n * d) * inv n = d`]; FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `(d:real^N->real) x`]) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[NORM_MUL; VECTOR_MUL_ASSOC; REAL_INV_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < x ==> (inv(x) * y) * x = y`]]);; (* ------------------------------------------------------------------------- *) (* Affine dependence and consequential theorems (from Lars Schewe). *) (* ------------------------------------------------------------------------- *) let affine_dependent = new_definition `affine_dependent (s:real^N -> bool) <=> ?x. x IN s /\ x IN (affine hull (s DELETE x))`;; let AFFINE_DEPENDENT_EXPLICIT = prove (`!p. affine_dependent (p:real^N -> bool) <=> (?s u. FINITE s /\ s SUBSET p /\ sum s u = &0 /\ (?v. v IN s /\ ~(u v = &0)) /\ vsum s (\v. u v % v) = (vec 0):real^N)`, X_GEN_TAC `p:real^N->bool` THEN EQ_TAC THENL [REWRITE_TAC[affine_dependent;AFFINE_HULL_EXPLICIT; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(x:real^N) INSERT s` THEN EXISTS_TAC `\v:real^N.if v = x then -- &1 else u v` THEN ASM_SIMP_TAC[FINITE_INSERT;SUM_CLAUSES;VSUM_CLAUSES;INSERT_SUBSET] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; COND_CASES_TAC THENL [ASM SET_TAC[];ALL_TAC] THEN ASM_SIMP_TAC[SUM_CASES; SUM_CLAUSES; SET_RULE `~((x:real^N) IN s) ==> {v | v IN s /\ v = x} = {} /\ {v | v IN s /\ ~(v = x)} = s`] THEN REAL_ARITH_TAC; SET_TAC[REAL_ARITH `~(-- &1 = &0)`]; MP_TAC (SET_RULE `s SUBSET p DELETE (x:real^N) ==> ~(x IN s)`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_SIMP_TAC[VECTOR_ARITH `(-- &1 % (x:real^N)) + a = vec 0 <=> a = x`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum s (\v:real^N. u v % v)` THEN CONJ_TAC THENL [ MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]; ASM_REWRITE_TAC[]]]; ALL_TAC] THEN REWRITE_TAC[affine_dependent;AFFINE_HULL_EXPLICIT;IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `v:real^N` THEN CONJ_TAC THENL [ASM SET_TAC[];ALL_TAC] THEN EXISTS_TAC `s DELETE (v:real^N)` THEN EXISTS_TAC `\x:real^N. -- (&1 / (u v)) * u x` THEN ASM_SIMP_TAC[FINITE_DELETE;SUM_DELETE;VSUM_DELETE_CASES] THEN ASM_SIMP_TAC[SUM_LMUL;GSYM VECTOR_MUL_ASSOC;VSUM_LMUL; VECTOR_MUL_RZERO;VECTOR_ARITH `vec 0 - -- a % x = a % x:real^N`; REAL_MUL_RZERO;REAL_ARITH `&0 - -- a * b = a * b`] THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> &1 / x * x = &1`; VECTOR_MUL_ASSOC;VECTOR_MUL_LID] THEN CONJ_TAC THENL [ALL_TAC;ASM SET_TAC[]] THEN ASM_SIMP_TAC[SET_RULE `v IN s ==> (s DELETE v = {} <=> s = {v})`] THEN ASM_CASES_TAC `s = {v:real^N}` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIND_ASSUM MP_TAC `sum {v:real^N} u = &0` THEN REWRITE_TAC[SUM_SING] THEN ASM_REWRITE_TAC[]);; let AFFINE_DEPENDENT_EXPLICIT_FINITE = prove (`!s. FINITE(s:real^N -> bool) ==> (affine_dependent s <=> ?u. sum s u = &0 /\ (?v. v IN s /\ ~(u v = &0)) /\ vsum s (\v. u v % v) = vec 0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFINE_DEPENDENT_EXPLICIT] THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_REFL]] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\x:real^N. if x IN t then u(x) else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN ASM SET_TAC[]);; let AFFINE_DEPENDENT_TRANSLATION_EQ = prove (`!a s. affine_dependent (IMAGE (\x. a + x) s) <=> affine_dependent s`, REWRITE_TAC[affine_dependent] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [AFFINE_DEPENDENT_TRANSLATION_EQ];; let AFFINE_DEPENDENT_TRANSLATION = prove (`!s a. affine_dependent s ==> affine_dependent (IMAGE (\x. a + x) s)`, REWRITE_TAC[AFFINE_DEPENDENT_TRANSLATION_EQ]);; let AFFINE_DEPENDENT_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (affine_dependent(IMAGE f s) <=> affine_dependent s)`, REWRITE_TAC[affine_dependent] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [AFFINE_DEPENDENT_LINEAR_IMAGE_EQ];; let AFFINE_DEPENDENT_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ affine_dependent(s) ==> affine_dependent(IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[affine_dependent; EXISTS_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s DELETE f a = IMAGE f (s DELETE a)` (fun t -> ASM_SIMP_TAC[FUN_IN_IMAGE; AFFINE_HULL_LINEAR_IMAGE; t]) THEN ASM SET_TAC[]);; let AFFINE_DEPENDENT_MONO = prove (`!s t:real^N->bool. affine_dependent s /\ s SUBSET t ==> affine_dependent t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[affine_dependent] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HULL_MONO o SPEC `x:real^N` o MATCH_MP (SET_RULE `!x. s SUBSET t ==> (s DELETE x) SUBSET (t DELETE x)`)) THEN ASM SET_TAC[]);; let AFFINE_INDEPENDENT_EMPTY = prove (`~(affine_dependent {})`, REWRITE_TAC[affine_dependent; NOT_IN_EMPTY]);; let AFFINE_INDEPENDENT_1 = prove (`!a:real^N. ~(affine_dependent {a})`, REWRITE_TAC[affine_dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{a} DELETE a = {}`; AFFINE_HULL_EMPTY; NOT_IN_EMPTY]);; let AFFINE_INDEPENDENT_2 = prove (`!a b:real^N. ~(affine_dependent {a,b})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_REWRITE_TAC[INSERT_AC; AFFINE_INDEPENDENT_1]; REWRITE_TAC[affine_dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {a,b} DELETE a = {b} /\ {a,b} DELETE b = {a}`] THEN ASM_REWRITE_TAC[AFFINE_HULL_SING; IN_SING]]);; let AFFINE_INDEPENDENT_SUBSET = prove (`!s t. ~affine_dependent t /\ s SUBSET t ==> ~affine_dependent s`, REWRITE_TAC[IMP_CONJ_ALT; CONTRAPOS_THM] THEN REWRITE_TAC[GSYM IMP_CONJ_ALT; AFFINE_DEPENDENT_MONO]);; let AFFINE_INDEPENDENT_DELETE = prove (`!s a. ~affine_dependent s ==> ~affine_dependent(s DELETE a)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_INDEPENDENT_SUBSET) THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Coplanarity, and collinearity in terms of affine hull. *) (* ------------------------------------------------------------------------- *) let coplanar = new_definition `coplanar s <=> ?u v w. s SUBSET affine hull {u,v,w}`;; let COLLINEAR_AFFINE_HULL = prove (`!s:real^N->bool. collinear s <=> ?u v. s SUBSET affine hull {u,v}`, GEN_TAC THEN REWRITE_TAC[collinear; AFFINE_HULL_2] THEN EQ_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `u + v = &1 <=> &1 - u = v`; UNWIND_THM1] THENL [X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x + u:real^N` THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN DISCH_THEN(X_CHOOSE_THEN `c:real` SUBST1_TAC) THEN EXISTS_TAC `&1 + c` THEN VECTOR_ARITH_TAC; MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN EXISTS_TAC `b - a:real^N` THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `s:real` THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `s - r:real` THEN VECTOR_ARITH_TAC]);; let COLLINEAR_IMP_COPLANAR = prove (`!s. collinear s ==> coplanar s`, REWRITE_TAC[coplanar; COLLINEAR_AFFINE_HULL] THEN MESON_TAC[INSERT_AC]);; let COPLANAR_SMALL = prove (`!s. FINITE s /\ CARD s <= 3 ==> coplanar s`, GEN_TAC THEN REWRITE_TAC[ARITH_RULE `s <= 3 <=> s <= 2 \/ s = 3`] THEN REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_SMALL] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[coplanar] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[HULL_INC; SUBSET]);; let COPLANAR_EMPTY = prove (`coplanar {}`, SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_EMPTY]);; let COPLANAR_SING = prove (`!a. coplanar {a}`, SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_SING]);; let COPLANAR_2 = prove (`!a b. coplanar {a,b}`, SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_2]);; let COPLANAR_3 = prove (`!a b c. coplanar {a,b,c}`, REPEAT GEN_TAC THEN MATCH_MP_TAC COPLANAR_SMALL THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_RULES] THEN ARITH_TAC);; let COLLINEAR_AFFINE_HULL_COLLINEAR = prove (`!s. collinear(affine hull s) <=> collinear s`, REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN MESON_TAC[HULL_HULL; HULL_MONO; HULL_INC; SUBSET]);; let COPLANAR_AFFINE_HULL_COPLANAR = prove (`!s. coplanar(affine hull s) <=> coplanar s`, REWRITE_TAC[coplanar] THEN MESON_TAC[HULL_HULL; HULL_MONO; HULL_INC; SUBSET]);; let COPLANAR_TRANSLATION_EQ = prove (`!a:real^N s. coplanar(IMAGE (\x. a + x) s) <=> coplanar s`, REWRITE_TAC[coplanar] THEN GEOM_TRANSLATE_TAC[]);; let COPLANAR_TRANSLATION = prove (`!a:real^N s. coplanar s ==> coplanar(IMAGE (\x. a + x) s)`, REWRITE_TAC[COPLANAR_TRANSLATION_EQ]);; add_translation_invariants [COPLANAR_TRANSLATION_EQ];; let COPLANAR_LINEAR_IMAGE = prove (`!f:real^M->real^N s. coplanar s /\ linear f ==> coplanar(IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[coplanar; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real^M`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(f:real^M->real^N) a`; `(f:real^M->real^N) b`; `(f:real^M->real^N) c`] THEN REWRITE_TAC[SET_RULE `{f a,f b,f c} = IMAGE f {a,b,c}`] THEN ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE; IMAGE_SUBSET]);; let COPLANAR_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (coplanar (IMAGE f s) <=> coplanar s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COPLANAR_LINEAR_IMAGE));; add_linear_invariants [COPLANAR_LINEAR_IMAGE_EQ];; let COPLANAR_SUBSET = prove (`!s t. coplanar t /\ s SUBSET t ==> coplanar s`, REWRITE_TAC[coplanar] THEN SET_TAC[]);; let AFFINE_HULL_3_IMP_COLLINEAR = prove (`!a b c. c IN affine hull {a,b} ==> collinear {a,b,c}`, ONCE_REWRITE_TAC[GSYM COLLINEAR_AFFINE_HULL_COLLINEAR] THEN SIMP_TAC[HULL_REDUNDANT_EQ; INSERT_AC] THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; COLLINEAR_2]);; let COLLINEAR_3_AFFINE_HULL = prove (`!a b c:real^N. ~(a = b) ==> (collinear {a,b,c} <=> c IN affine hull {a,b})`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[AFFINE_HULL_3_IMP_COLLINEAR] THEN REWRITE_TAC[collinear] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(fun th -> MP_TAC(SPECL [`b:real^N`; `a:real^N`] th) THEN MP_TAC(SPECL [`c:real^N`; `a:real^N`] th)) THEN REWRITE_TAC[IN_INSERT; AFFINE_HULL_2; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[VECTOR_ARITH `a - b:real^N = c <=> a = b + c`] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN X_GEN_TAC `y:real` THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`&1 - x / y`; `x / y:real`] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_DIV_RMUL] THEN VECTOR_ARITH_TAC);; let COLLINEAR_3_EQ_AFFINE_DEPENDENT = prove (`!a b c:real^N. collinear{a,b,c} <=> a = b \/ a = c \/ b = c \/ affine_dependent {a,b,c}`, REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC]) [`a:real^N = b`; `a:real^N = c`; `b:real^N = c`] THEN ASM_REWRITE_TAC[affine_dependent] THEN EQ_TAC THENL [ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN DISCH_TAC THEN EXISTS_TAC `c:real^N` THEN REWRITE_TAC[IN_INSERT]; REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,c,a}`]; ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,a,b}`]; ALL_TAC] THEN ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]);; let AFFINE_DEPENDENT_IMP_COLLINEAR_3 = prove (`!a b c:real^N. affine_dependent {a,b,c} ==> collinear{a,b,c}`, REPEAT GEN_TAC THEN REWRITE_TAC[affine_dependent] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; RIGHT_OR_DISTRIB] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2; COLLINEAR_AFFINE_HULL] THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`b:real^N`; `c:real^N`]; MAP_EVERY EXISTS_TAC [`a:real^N`; `c:real^N`]; MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`]] THEN SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; HULL_INC; IN_INSERT] THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> a IN s ==> a IN t`) THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; let COLLINEAR_3_IN_AFFINE_HULL = prove (`!v0 v1 x:real^N. ~(v1 = v0) ==> (collinear {v0,v1,x} <=> x IN affine hull {v0,v1})`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `v0:real^N` THEN REWRITE_TAC[COLLINEAR_LEMMA; AFFINE_HULL_2] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY EXISTS_TAC [`&1`; `&0`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC; MESON_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`]]);; let COLLINEAR_3_EXPLICIT = prove (`!x y z:real^N. collinear {x,y,z} <=> ?a b c. a % x + b % y + c % z = vec 0 /\ a + b + c = &0 /\ ~(a = &0 /\ b = &0 /\ c = &0)`, MATCH_MP_TAC(MESON[] `(!x y z. P x y z ==> P y z x) /\ (!x z. P x x z) /\ (!x y z. ~(x = y) /\ ~(x = z) /\ ~(y = z) ==> P x y z) ==> !x y z. P x y z`) THEN CONJ_TAC THENL [REWRITE_TAC[INSERT_AC; REAL_ADD_AC; VECTOR_ADD_AC; CONJ_ACI] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MESON_TAC[REAL_ADD_AC; VECTOR_ADD_AC]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2] THEN MAP_EVERY EXISTS_TAC [`&1`; `-- &1`; `&0`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT] THEN SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE; FINITE_INSERT; FINITE_EMPTY; SUM_CLAUSES; VSUM_CLAUSES; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID; REAL_ADD_RID] THEN EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN STRIP_TAC THEN EXISTS_TAC `(\w. if w = x then a else if w = y then b else c):real^N->real` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A general lemma. *) (* ------------------------------------------------------------------------- *) let CONVEX_CONNECTED = prove (`!s:real^N->bool. convex s ==> connected s`, REWRITE_TAC[CONVEX_ALT; connected; SUBSET; EXTENSION; IN_INTER; IN_UNION; NOT_IN_EMPTY; NOT_FORALL_THM; NOT_EXISTS_THM] THEN GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN MAP_EVERY (K(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) (1--4) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `x1:real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `x2:real^N` STRIP_ASSUME_TAC)) THEN MP_TAC(ISPECL [`\u. (&1 - u) % x1 + u % (x2:real^N)`; `&0`; `&1`; `e1:real^N->bool`; `e2:real^N->bool`] (REWRITE_RULE[GSYM open_def] CONNECTED_REAL_LEMMA)) THEN ASM_REWRITE_TAC[NOT_IMP; REAL_SUB_RZERO; VECTOR_MUL_LID; VECTOR_MUL_LZERO; REAL_SUB_REFL; VECTOR_ADD_RID; VECTOR_ADD_LID; REAL_POS] THEN REPEAT(CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[dist] THEN REWRITE_TAC[NORM_MUL; VECTOR_ARITH `((&1 - a) % x + a % y) - ((&1 - b) % x + b % y) = (a - b) % (y - x)`] THEN MP_TAC(ISPEC `(x2 - x1):real^N` NORM_POS_LE) THEN REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_MUL_RZERO; REAL_LT_01]] THEN EXISTS_TAC `e / norm((x2 - x1):real^N)` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_DIV]);; (* ------------------------------------------------------------------------- *) (* Convex functions into the reals. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("convex_on",(12,"right"));; let convex_on = new_definition `f convex_on s <=> !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) ==> f(u % x + v % y) <= u * f(x) + v * f(y)`;; let CONVEX_ON_EMPTY = prove (`!f:real^N->real. f convex_on {}`, REWRITE_TAC[convex_on; NOT_IN_EMPTY]);; let CONVEX_ON_SUBSET = prove (`!f s t. f convex_on t /\ s SUBSET t ==> f convex_on s`, REWRITE_TAC[convex_on; SUBSET] THEN MESON_TAC[]);; let CONVEX_ON_EQ = prove (`!f g s. convex s /\ (!x. x IN s ==> f x = g x) /\ f convex_on s ==> g convex_on s`, REWRITE_TAC[convex_on; convex] THEN MESON_TAC[]);; let CONVEX_ON_CONST = prove (`!s a. (\x. a) convex_on s`, SIMP_TAC[convex_on; GSYM REAL_ADD_RDISTRIB; REAL_MUL_LID; REAL_LE_REFL]);; let LINEAR_IMP_CONVEX_ON = prove (`!f s:real^N->bool. linear (lift o f) ==> f convex_on s`, REWRITE_TAC[linear; convex_on] THEN SIMP_TAC[GSYM DROP_EQ; DROP_ADD; o_DEF; LIFT_DROP; DROP_CMUL] THEN REWRITE_TAC[REAL_LE_REFL]);; let CONVEX_ON_SING = prove (`!f a:real^N. f convex_on {a}`, REPEAT GEN_TAC THEN MATCH_MP_TAC CONVEX_ON_EQ THEN EXISTS_TAC `\x:real^N. (f:real^N->real) a` THEN SIMP_TAC[IN_SING; CONVEX_SING; CONVEX_ON_CONST]);; let CONVEX_ADD = prove (`!s f g. f convex_on s /\ g convex_on s ==> (\x. f(x) + g(x)) convex_on s`, REWRITE_TAC[convex_on; AND_FORALL_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL ORELSE GEN_TAC) THEN MATCH_MP_TAC(TAUT `(b /\ c ==> d) ==> (a ==> b) /\ (a ==> c) ==> a ==> d`) THEN REAL_ARITH_TAC);; let CONVEX_ADD_EQ = prove (`!a f s:real^N->bool. (\x. a + f x) convex_on s <=> f convex_on s`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[CONVEX_ADD; CONVEX_ON_CONST] THEN DISCH_THEN(MP_TAC o ISPEC `(\x. --a):real^N->real` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONVEX_ADD)) THEN REWRITE_TAC[CONVEX_ON_CONST; ETA_AX; REAL_ARITH `--a + a + x:real = x`]);; let CONVEX_CMUL = prove (`!s c f. &0 <= c /\ f convex_on s ==> (\x. c * f(x)) convex_on s`, SIMP_TAC[convex_on; REAL_LE_LMUL; REAL_ARITH `u * c * fx + v * c * fy = c * (u * fx + v * fy)`]);; let CONVEX_MAX = prove (`!f g s. f convex_on s /\ g convex_on s ==> (\x. max (f x) (g x)) convex_on s`, REWRITE_TAC[convex_on; REAL_MAX_LE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC);; let CONVEX_ON_IMP_MIDPOINT_CONVEX = prove (`!f s x y:real^N. f convex_on s /\ x IN s /\ y IN s ==> f(midpoint(x,y)) <= (f x + f y) / &2`, REWRITE_TAC[convex_on] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[midpoint; VECTOR_ADD_LDISTRIB; REAL_ARITH `(x + y) / &2 = inv(&2) * x + inv(&2) * y`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]);; let CONVEX_LOWER = prove (`!f s x y:real^N u v. f convex_on s /\ x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) ==> f(u % x + v % y) <= max (f(x)) (f(y))`, REWRITE_TAC[convex_on] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th]) THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_TRANS THEN ASM_MESON_TAC[REAL_LE_ADD2; REAL_LE_LMUL; REAL_MAX_MAX]);; let CONVEX_LOWER_SEGMENT = prove (`!f s a b x:real^N. f convex_on s /\ a IN s /\ b IN s /\ x IN segment[a,b] ==> f(x) <= max (f a) (f b)`, REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_LOWER THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let CONVEX_LOWER_SEGMENT_LT = prove (`!f s a b x:real^N. f convex_on s /\ a IN s /\ b IN s /\ x IN segment[a,b] /\ ~(x = b) /\ f a < f b ==> f x < f b`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real` (STRIP_ASSUME_TAC o GSYM)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `&1 - u:real`; `u:real`] o GEN_REWRITE_RULE I [convex_on]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN REWRITE_TAC[REAL_ARITH `a + u * b < b <=> a < (&1 - u) * b`] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN ASM_CASES_TAC `u = &1` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN UNDISCH_TAC `~(x:real^N = b)` THEN EXPAND_TAC "x" THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[ASSUME `u = &1`] THEN VECTOR_ARITH_TAC);; let CONVEX_LOCAL_GLOBAL_MINIMUM_SEGMENT = prove (`!f s x:real^N. f convex_on s /\ x IN s /\ (!z. z IN s /\ ~(z = x) ==> ?y. y IN segment[x,z] /\ y IN s /\ ~(y = x) /\ f(x) <= f(y)) ==> !z. z IN s ==> f(x) <= f(z)`, REWRITE_TAC[IN_OPEN_SEGMENT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_CASES_TAC `z:real^N = x` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`; `z:real^N`; `x:real^N`; `y:real^N`] CONVEX_LOWER_SEGMENT_LT) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let CONVEX_LOCAL_GLOBAL_MINIMUM_GEN = prove (`!f s t x:real^N. f convex_on s /\ x IN t /\ open_in (subtopology euclidean (affine hull s)) t /\ t SUBSET s /\ (!y. y IN t ==> f(x) <= f(y)) ==> !y. y IN s ==> f(x) <= f(y)`, REWRITE_TAC[open_in] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONVEX_LOCAL_GLOBAL_MINIMUM_SEGMENT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `x + min (&1) (d / &2 / norm(z - x:real^N)) % (z - x)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `min (&1) (d / &2 / norm(z - x:real^N))` THEN REWRITE_TAC[REAL_MIN_LE; REAL_LE_MIN; REAL_LE_REFL; REAL_POS] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; REAL_POS; NORM_POS_LE] THEN VECTOR_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]); REWRITE_TAC[VECTOR_ARITH `x + a:real^N = x <=> a = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min (&1) x = &0)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ]; FIRST_X_ASSUM MATCH_MP_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF; HULL_INC; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[NORM_ARITH `dist(x + a:real^N,x) = norm a`] THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < d ==> abs(min (&1) x) < d`) THEN MATCH_MP_TAC(REAL_ARITH `&0 < x / y ==> &0 < x / &2 / y /\ x / &2 / y < x / y`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]);; let CONVEX_LOCAL_GLOBAL_MINIMUM = prove (`!f s t x:real^N. f convex_on s /\ x IN t /\ open t /\ t SUBSET s /\ (!y. y IN t ==> f(x) <= f(y)) ==> !y. y IN s ==> f(x) <= f(y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONVEX_LOCAL_GLOBAL_MINIMUM_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_SUBSET THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[HULL_SUBSET]);; let CONVEX_DISTANCE = prove (`!s a. (\x. dist(a,x)) convex_on s`, REWRITE_TAC[convex_on; dist] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM VECTOR_MUL_LID] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_ARITH `(u + v) % z - (u % x + v % y) = u % (z - x) + v % (z - y)`] THEN ASM_MESON_TAC[NORM_TRIANGLE; NORM_MUL; REAL_ABS_REFL]);; let CONVEX_NORM = prove (`!s:real^N->bool. norm convex_on s`, GEN_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`] CONVEX_DISTANCE) THEN REWRITE_TAC[DIST_0; ETA_AX]);; let CONVEX_ON_COMPOSE_LINEAR = prove (`!f g:real^M->real^N s. f convex_on (IMAGE g s) /\ linear g ==> (f o g) convex_on s`, REWRITE_TAC[convex_on; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_ADD th]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN ASM_SIMP_TAC[]);; let CONVEX_ON_TRANSLATION = prove (`!f a:real^N. f convex_on (IMAGE (\x. a + x) s) <=> (\x. f(a + x)) convex_on s`, REWRITE_TAC[convex_on; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM] THEN REWRITE_TAC[VECTOR_ARITH `u % (a + x) + v % (a + y):real^N = (u + v) % a + u % x + v % y`] THEN SIMP_TAC[VECTOR_MUL_LID]);; let LINEAR_CONVEX_ON_1 = prove (`!f:real^N->real^1. linear f <=> f(vec 0) = vec 0 /\ (drop o f) convex_on UNIV /\ ((--) o drop o f) convex_on UNIV`, GEN_TAC THEN REWRITE_TAC[convex_on; IN_UNIV; o_THM] THEN REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`; REAL_ARITH `--a <= u * --x + v * --y <=> u * x + v * y <= a`] THEN REWRITE_TAC[REAL_LE_ANTISYM] THEN REWRITE_TAC[GSYM DROP_CMUL; GSYM DROP_ADD; DROP_EQ] THEN EQ_TAC THENL [MESON_TAC[LINEAR_ADD; LINEAR_CMUL; LINEAR_0]; STRIP_TAC THEN REWRITE_TAC[linear]] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN FIRST_ASSUM(fun th -> MP_TAC(SPECL[`x:real^N`; `y:real^N`; `&1 / &2`; `&1 / &2`] th) THEN MP_TAC(SPECL[`x + y:real^N`; `vec 0:real^N`; `&1 / &2`; `&1 / &2`] th)) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC VECTOR_ARITH; DISCH_TAC] THEN SUBGOAL_THEN `!c x:real^N. &0 <= c /\ c <= &1 ==> (f:real^N->real^1)(c % x) = c % f x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `vec 0:real^N`; `c:real`; `&1 - c`]) THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!c x:real^N. &0 <= c ==> (f:real^N->real^1)(c % x) = c % f x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `c <= &1` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv c:real`; `c % x:real^N`]) THEN SUBGOAL_THEN `&1 <= c /\ ~(c = &0)` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_INV_LE_1; REAL_LE_INV_EQ] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `!x. (f:real^N->real^1) (--x) = --(f x)` ASSUME_TAC THENL [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `--x:real^N`; `inv(&2)`; `inv(&2)`]) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_ARITH `a % x + a % --x:real^N = vec 0`] THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN ASM_CASES_TAC `&0 <= c` THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `(f:real^N->real^1)(--c % x) = --c % f x` MP_TAC THENL [ASM_SIMP_TAC[REAL_ARITH `~(&0 <= c) ==> &0 <= --c`]; ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VECTOR_EQ_NEG2]]);; let CONVEX_CONCAVE_EQ_AFFINE = prove (`!f:real^N->real. f convex_on UNIV /\ ((--) o f) convex_on UNIV <=> (?a b. f = \x. a dot x + b)`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MP_TAC(ISPEC `\x. lift(--f(vec 0) + (f:real^N->real) x)` LINEAR_CONVEX_ON_1) THEN REWRITE_TAC[o_DEF; LIFT_DROP; REAL_ADD_LINV; LIFT_NUM] THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_SIMP_TAC[CONVEX_ADD; CONVEX_ON_CONST; REAL_NEG_ADD] THEN REWRITE_TAC[LINEAR_TO_1] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; LIFT_DROP] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN EXISTS_TAC `(f:real^N->real) (vec 0)` THEN REAL_ARITH_TAC; REWRITE_TAC[o_DEF; REAL_NEG_ADD; GSYM DOT_LNEG] THEN CONJ_TAC THEN MATCH_MP_TAC CONVEX_ADD THEN REWRITE_TAC[CONVEX_ON_CONST] THEN MATCH_MP_TAC LINEAR_IMP_CONVEX_ON THEN REWRITE_TAC[o_DEF; LINEAR_LIFT_DOT]]);; (* ------------------------------------------------------------------------- *) (* Open and closed balls are convex and hence connected. *) (* ------------------------------------------------------------------------- *) let CONVEX_BALL = prove (`!x:real^N e. convex(ball(x,e))`, let lemma = REWRITE_RULE[convex_on; IN_UNIV] (ISPEC `(:real^N)` CONVEX_DISTANCE) in REWRITE_TAC[convex; IN_BALL] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) lemma o lhand o snd) THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_CONVEX_BOUND_LT]);; let CONNECTED_BALL = prove (`!x:real^N e. connected(ball(x,e))`, SIMP_TAC[CONVEX_CONNECTED; CONVEX_BALL]);; let CONVEX_CBALL = prove (`!x:real^N e. convex(cball(x,e))`, REWRITE_TAC[convex; IN_CBALL; dist] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`; `y:real^N`; `z:real^N`; `u:real`; `v:real`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a - b = &1 % a - b`] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_ARITH `(a + b) % x - (a % y + b % z) = a % (x - y) + b % (x - z)`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(u % (x - y)) + norm(v % (x - z):real^N)` THEN REWRITE_TAC[NORM_TRIANGLE; NORM_MUL] THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= u /\ &0 <= v /\ (u + v = &1) ==> (abs(u) + abs(v) = &1)`]);; let CONNECTED_CBALL = prove (`!x:real^N e. connected(cball(x,e))`, SIMP_TAC[CONVEX_CONNECTED; CONVEX_CBALL]);; let CONVEX_INTERMEDIATE_BALL = prove (`!a:real^N r t. ball(a,r) SUBSET t /\ t SUBSET cball(a,r) ==> convex t`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONVEX_CONTAINS_OPEN_SEGMENT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN GEN_TAC THEN DISCH_THEN (MP_TAC o SPEC `a:real^N` o MATCH_MP DIST_DECREASES_OPEN_SEGMENT) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL] THEN ASM_MESON_TAC[REAL_LTE_TRANS]);; let FRONTIER_OF_CONNECTED_COMPONENT_SUBSET = prove (`!s c x:real^N. frontier(connected_component s x) SUBSET frontier s`, REPEAT GEN_TAC THEN REWRITE_TAC[frontier; SUBSET; IN_DIFF] THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `y IN s ==> s SUBSET t ==> y IN t`)) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `ball(y:real^N,e) SUBSET connected_component s y` ASSUME_TAC THENL [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[CONNECTED_BALL; CENTRE_IN_BALL]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSURE_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM IN_BALL)] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `e:real` THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `y:real^N`] CONNECTED_COMPONENT_OVERLAP) THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]]]);; let FRONTIER_OF_COMPONENTS_SUBSET = prove (`!s c:real^N->bool. c IN components s ==> frontier c SUBSET frontier s`, SIMP_TAC[components; FORALL_IN_GSPEC; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]);; let FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT = prove (`!s c. closed s /\ c IN components ((:real^N) DIFF s) ==> frontier c SUBSET s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN ASM_MESON_TAC[FRONTIER_SUBSET_EQ; SUBSET_TRANS]);; let CONTAINS_COMPONENT_OF_COMPACT_FRONTIER = prove (`!s:real^N->bool c. compact s /\ c IN components s ==> ?d. d IN components(frontier s) /\ d SUBSET c`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(UNIONS(components(frontier s)) INTER c:real^N->bool = {})` MP_TAC THENL [REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN MATCH_MP_TAC(SET_RULE `f SUBSET c /\ ~(f = {}) ==> f SUBSET s ==> ~(s INTER c = {})`) THEN REWRITE_TAC[FRONTIER_SUBSET_EQ; FRONTIER_EQ_EMPTY; DE_MORGAN_THM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`] COMPACT_COMPONENTS) THEN ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ASM_MESON_TAC[NOT_BOUNDED_UNIV]]; REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `frontier s:real^N->bool` THEN ASM_SIMP_TAC[FRONTIER_SUBSET_EQ; COMPACT_IMP_CLOSED] THEN ASM_MESON_TAC[IN_COMPONENTS_SUBSET]]);; let CARD_LE_COMPONENTS_FRONTIER = prove (`!s:real^N->bool. compact s ==> components s <=_c components(frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN EXISTS_TAC `\s t:real^N->bool. s SUBSET t` THEN ASM_SIMP_TAC[CONTAINS_COMPONENT_OF_COMPACT_FRONTIER] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `d:real^N->bool`; `e:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP COMPONENTS_EQ) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN SET_TAC[]);; let CONTAINS_COMPONENT_OF_CLOSURE_FRONTIER = prove (`!s:real^N->bool c. bounded s /\ c IN components(closure s) ==> ?d. d IN components(frontier s) /\ d SUBSET c`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `c:real^N->bool`] CONTAINS_COMPONENT_OF_COMPACT_FRONTIER) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_TAC THEN SUBGOAL_THEN `~(UNIONS(components(frontier s)) INTER c:real^N->bool = {})` MP_TAC THENL [REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN MP_TAC(ISPEC `s:real^N->bool` FRONTIER_CLOSURE_SUBSET) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(?d. P d) ==> (!d. P d ==> ~(d = {}) /\ d SUBSET f /\ d SUBSET c) ==> f SUBSET g ==> ~(g INTER c = {})`)) THEN MESON_TAC[IN_COMPONENTS_SUBSET; IN_COMPONENTS_NONEMPTY]; REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `closure s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `frontier s:real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; REWRITE_TAC[frontier] THEN SET_TAC[]]]);; let CARD_LE_COMPONENTS_CLOSURE_FRONTIER = prove (`!s:real^N->bool. bounded s ==> components(closure s) <=_c components(frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN EXISTS_TAC `\s t:real^N->bool. s SUBSET t` THEN ASM_SIMP_TAC[CONTAINS_COMPONENT_OF_CLOSURE_FRONTIER] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `d:real^N->bool`; `e:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP COMPONENTS_EQ) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A couple of lemmas about components (see Newman IV, 3.3 and 3.4). *) (* ------------------------------------------------------------------------- *) let CONNECTED_UNION_CLOPEN_IN_COMPLEMENT = prove (`!s t u:real^N->bool. connected s /\ connected u /\ s SUBSET u /\ open_in (subtopology euclidean (u DIFF s)) t /\ closed_in (subtopology euclidean (u DIFF s)) t ==> connected (s UNION t)`, MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `h:real^N->bool`; `s:real^N->bool`] THEN STRIP_TAC THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN MATCH_MP_TAC(MESON[] `!Q. (!x y. P x y <=> P y x) /\ (!x y. P x y ==> Q x \/ Q y) /\ (!x y. P x y /\ Q x ==> F) ==> (!x y. ~(P x y))`) THEN EXISTS_TAC `\x:real^N->bool. c SUBSET x` THEN CONJ_TAC THENL [MESON_TAC[INTER_COMM; UNION_COMM]; ALL_TAC] THEN REWRITE_TAC[] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`h1:real^N->bool`; `h2:real^N->bool`] THENL [STRIP_TAC THEN UNDISCH_TAC `connected(c:real^N->bool)` THEN REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`c INTER h1:real^N->bool`; `c INTER h2:real^N->bool`]) THEN MATCH_MP_TAC(TAUT `(p /\ q) /\ (~r ==> s) ==> ~(p /\ q /\ r) ==> s`) THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [UNDISCH_TAC `closed_in(subtopology euclidean (c UNION h)) (h1:real^N->bool)`; UNDISCH_TAC `closed_in(subtopology euclidean (c UNION h)) (h2:real^N->bool)`] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN SUBGOAL_THEN `(h2:real^N->bool) SUBSET h` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `connected(s:real^N->bool)` THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN(MP_TAC o SPEC `h2:real^N->bool`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SUBGOAL_THEN `s:real^N->bool = (s DIFF c) UNION (c UNION h)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_UNION THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(c UNION h) DIFF h2:real^N->bool = h1` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM SET_TAC[]; DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `h:real^N->bool` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `open_in(subtopology euclidean (c UNION h)) (h2:real^N->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]; MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `h:real^N->bool` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `closed_in(subtopology euclidean (c UNION h)) (h2:real^N->bool)` THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]]);; let COMPONENT_COMPLEMENT_CONNECTED = prove (`!s u c:real^N->bool. connected s /\ connected u /\ s SUBSET u /\ c IN components (u DIFF s) ==> connected(u DIFF c)`, MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `s:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN UNDISCH_TAC `connected(a:real^N->bool)` THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`h3:real^N->bool`; `h4:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a INTER h3:real^N->bool`; `a INTER h4:real^N->bool`]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN EVERY_ASSUM(fun th -> try MP_TAC(CONJUNCT1(GEN_REWRITE_RULE I [closed_in] th)) with Failure _ -> ALL_TAC) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT DISCH_TAC THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `closed_in (subtopology euclidean (s DIFF c)) (h3:real^N->bool)` THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; UNDISCH_TAC `closed_in (subtopology euclidean (s DIFF c)) (h4:real^N->bool)` THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]; DISCH_TAC THEN MP_TAC(ISPECL [`s DIFF a:real^N->bool`; `c UNION h3:real^N->bool`; `c:real^N->bool`] COMPONENTS_MAXIMAL) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONNECTED_UNION_CLOPEN_IN_COMPLEMENT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM SET_TAC[]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s DIFF c DIFF h3:real^N->bool = h4` SUBST1_TAC THEN ASM SET_TAC[]]; DISCH_TAC THEN MP_TAC(ISPECL [`s DIFF a:real^N->bool`; `c UNION h4:real^N->bool`; `c:real^N->bool`] COMPONENTS_MAXIMAL) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONNECTED_UNION_CLOPEN_IN_COMPLEMENT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM SET_TAC[]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s DIFF c DIFF h4:real^N->bool = h3` SUBST1_TAC THEN ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Condition for an open map's image to contain a ball. *) (* ------------------------------------------------------------------------- *) let BALL_SUBSET_OPEN_MAP_IMAGE = prove (`!f:real^M->real^N s a r. bounded s /\ f continuous_on closure s /\ open(IMAGE f (interior s)) /\ a IN s /\ &0 < r /\ (!z. z IN frontier s ==> r <= norm(f z - f a)) ==> ball(f(a),r) SUBSET IMAGE f s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`ball((f:real^M->real^N) a,r)`; `(:real^N) DIFF IMAGE (f:real^M->real^N) s`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_BALL] THEN MATCH_MP_TAC(SET_RULE `~(b INTER s = {}) /\ b INTER f = {} ==> (~(b INTER (UNIV DIFF s) = {}) /\ ~(b DIFF (UNIV DIFF s) = {}) ==> ~(b INTER f = {})) ==> b SUBSET s`) THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `(f:real^M->real^N) a` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM SET_TAC[]; REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN t ==> ~(x IN s)`] THEN REWRITE_TAC[IN_BALL; REAL_NOT_LT]] THEN MP_TAC(ISPECL[`frontier(IMAGE (f:real^M->real^N) s)`; `(f:real^M->real^N) a`] DISTANCE_ATTAINS_INF) THEN REWRITE_TAC[FRONTIER_CLOSED; FRONTIER_EQ_EMPTY] THEN ANTS_TAC THENL [SIMP_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV] `bounded s ==> ~(s = UNIV)`) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (closure s)` THEN SIMP_TAC[IMAGE_SUBSET; CLOSURE_SUBSET] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]; DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [frontier]) THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[CLOSURE_SEQUENTIAL] THEN DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[IN_IMAGE; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:num->real^M` THEN REWRITE_TAC[FORALL_AND_THM] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM COMPACT_CLOSURE]) THEN REWRITE_TAC[compact] THEN DISCH_THEN(MP_TAC o SPEC `z:num->real^M`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:real^M`; `r:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `(((\n. (f:real^M->real^N)(z n)) o (r:num->num)) --> w) sequentially` MP_TAC THENL [MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM o_ASSOC]] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. ((z:num->real^M) o (r:num->num)) n IN s` MP_TAC THENL [ASM_REWRITE_TAC[o_THM]; UNDISCH_THEN `((\n. (f:real^M->real^N) ((z:num->real^M) n)) --> w) sequentially` (K ALL_TAC) THEN UNDISCH_THEN `!n. (z:num->real^M) n IN s` (K ALL_TAC)] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN SPEC_TAC(`(z:num->real^M) o (r:num->num)`, `z:num->real^M`) THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `w = (f:real^M->real^N) y` SUBST_ALL_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:real^M->real^N) o (z:num->real^M)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_MESON_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(f y - (f:real^M->real^N) a)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[dist; NORM_SUB]] THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[interior; IN_ELIM_THM] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (interior s)` THEN ASM_SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Arithmetic operations on sets preserve convexity. *) (* ------------------------------------------------------------------------- *) let CONVEX_SCALING = prove (`!s c. convex s ==> convex (IMAGE (\x. c % x) s)`, REWRITE_TAC[convex; IN_IMAGE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % c % x + v % c % y = c % (u % x + v % y)`] THEN ASM_MESON_TAC[]);; let CONVEX_SCALING_EQ = prove (`!s:real^N->bool c. convex (IMAGE (\x. c % x) s) <=> c = &0 \/ convex s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[CONVEX_SING; CONVEX_EMPTY]; EQ_TAC THEN REWRITE_TAC[CONVEX_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP CONVEX_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let CONVEX_NEGATIONS = prove (`!s. convex s ==> convex (IMAGE (--) s)`, REWRITE_TAC[convex; IN_IMAGE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % --x + v % --y = --(u % x + v % y)`] THEN ASM_MESON_TAC[]);; let CONVEX_SUMS = prove (`!s t. convex s /\ convex t ==> convex {x + y | x IN s /\ y IN t}`, REWRITE_TAC[convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % (a + b) + v % (c + d) = (u % a + v % c) + (u % b + v % d)`] THEN ASM_MESON_TAC[]);; let CONVEX_DIFFERENCES = prove (`!s t. convex s /\ convex t ==> convex {x - y | x IN s /\ y IN t}`, REWRITE_TAC[convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % (a - b) + v % (c - d) = (u % a + v % c) - (u % b + v % d)`] THEN ASM_MESON_TAC[]);; let CONVEX_AFFINITY_EQ = prove (`!s m c:real^N. convex (IMAGE (\x. m % x + c) s) <=> m = &0 \/ convex s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; CONVEX_TRANSLATION_EQ; CONVEX_SCALING_EQ; IMAGE_o]);; let CONVEX_AFFINITY = prove (`!s m c:real^N. convex s ==> convex (IMAGE (\x. m % x + c) s)`, SIMP_TAC[CONVEX_AFFINITY_EQ]);; let CONVEX_LINEAR_PREIMAGE = prove (`!f:real^M->real^N. linear f /\ convex s ==> convex {x | f(x) IN s}`, REWRITE_TAC[CONVEX_ALT; IN_ELIM_THM] THEN SIMP_TAC[LINEAR_ADD; LINEAR_CMUL]);; let CONVEX_SUMS_MULTIPLES = prove (`!s:real^N->bool c d. convex s /\ &0 <= c /\ &0 <= d ==> {c % x + d % y | x IN s /\ y IN s} = IMAGE (\x. (c + d) % x) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN SUBGOAL_THEN `c = &0 /\ d = &0 \/ &0 < c + d` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; GSYM VECTOR_ADD_RDISTRIB] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `c / (c + d) % x + d / (c + d) % y:real^N` THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ]; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN UNDISCH_TAC `&0 < c + d` THEN CONV_TAC REAL_FIELD]]);; let CONVEX_TRANSLATION_SUBSET_PREIMAGE = prove (`!s t:real^N->bool. convex t ==> convex {a | IMAGE (\x. a + x) s SUBSET t}`, REPEAT GEN_TAC THEN REWRITE_TAC[CONVEX_ALT] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `u:real`] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; FORALL_IN_IMAGE] THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `((&1 - u) % a + u % b) + x:real^N = (&1 - u) % (a + x) + u % (b + x)`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; let CONVEX_TRANSLATION_SUPERSET_PREIMAGE = prove (`!s t:real^N->bool. convex t ==> convex {a | s SUBSET IMAGE (\x. a + x) t}`, REWRITE_TAC[TRANSLATION_SUBSET_GALOIS_RIGHT] THEN ASM_SIMP_TAC[VECTOR_NEG_NEG; CONVEX_NEGATIONS; CONVEX_TRANSLATION_SUBSET_PREIMAGE; SET_RULE `(!x:real^N. --(--x) = x) ==> {a:real^N | P(--a)} = IMAGE (--) {a | P a}`]);; (* ------------------------------------------------------------------------- *) (* Some interesting "cancellation" properties for sum-sets. *) (* ------------------------------------------------------------------------- *) let SUBSET_SUMS_LCANCEL = prove (`!s t u:real^N->bool. ~(s = {}) /\ bounded s /\ closed u /\ convex u /\ {x + y | x IN s /\ y IN t} SUBSET {x + z | x IN s /\ z IN u} ==> t SUBSET u`, REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!n. ?w z:real^N. w IN s /\ z IN u /\ (&n + &1) % (b - z) = w - a` MP_TAC THENL [INDUCT_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[REAL_ADD_LID; VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_ARITH `b - z:real^N = w - a <=> a + b = w + z`] THEN MESON_TAC[]; FIRST_X_ASSUM(X_CHOOSE_THEN `a':real^N` (X_CHOOSE_THEN `c':real^N` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a':real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a'':real^N`; `c'':real^N`] THEN STRIP_TAC THEN EXISTS_TAC `a'':real^N` THEN EXISTS_TAC `(&1 - &1 / (&n + &2)) % c' + &1 / (&n + &2) % c'':real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONVEX_ALT]) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &2`] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [VECTOR_ARITH `a' + b:real^N = a'' + c <=> a'' = (a' + b) - c`]) THEN REWRITE_TAC[VECTOR_ARITH `(&n + &1) % (b - c):real^N = (a' + b) - c'' - a <=> &n % b - (&n + &1) % c = (a' - c'') - a`] THEN SIMP_TAC[GSYM REAL_OF_NUM_SUC; VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_ARITH `(n + &1) + &1 = n + &2`] THEN REWRITE_TAC[VECTOR_MUL_LID; REAL_FIELD `(&n + &2) * (&1 - (&1 / (&n + &2))) = &n + &1 /\ (&n + &2) * &1 / (&n + &2) = &1`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `n % b - (n % c + d):real^N = n % (b - c) - d`] THEN CONV_TAC VECTOR_ARITH]]; FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl) THEN MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP CLOSED_APPROACHABLE th)]) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `B:real`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[REAL_MUL_LZERO] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; X_GEN_TAC `n:num`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&n + &1)` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[dist]] THEN ASM_REWRITE_TAC[GSYM NORM_MUL] THEN REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN ASM_MESON_TAC[REAL_LET_TRANS]]);; let SUBSET_SUMS_RCANCEL = prove (`!s t u:real^N->bool. closed t /\ convex t /\ bounded u /\ ~(u = {}) /\ {x + z | x IN s /\ z IN u} SUBSET {y + z | y IN t /\ z IN u} ==> s SUBSET t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_SUMS_LCANCEL THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SUMS_SYM] THEN ASM_REWRITE_TAC[]);; let EQ_SUMS_LCANCEL = prove (`!s t u. ~(s = {}) /\ bounded s /\ closed t /\ convex t /\ closed u /\ convex u /\ {x + y | x IN s /\ y IN t} = {x + z | x IN s /\ z IN u} ==> t = u`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; EMPTY_SUBSET] THEN REWRITE_TAC[SUBSET_EMPTY] THEN MESON_TAC[SUBSET_SUMS_LCANCEL]);; let EQ_SUMS_RCANCEL = prove (`!s t u. closed s /\ convex s /\ closed t /\ convex t /\ bounded u /\ ~(u = {}) /\ {x + z | x IN s /\ z IN u} = {y + z | y IN t /\ z IN u} ==> s = t`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; EMPTY_SUBSET] THEN REWRITE_TAC[SUBSET_EMPTY] THEN MESON_TAC[SUBSET_SUMS_RCANCEL]);; (* ------------------------------------------------------------------------- *) (* Convex hull. *) (* ------------------------------------------------------------------------- *) let CONVEX_CONVEX_HULL = prove (`!s. convex(convex hull s)`, SIMP_TAC[P_HULL; CONVEX_INTERS]);; let CONVEX_HULL_EQ = prove (`!s. (convex hull s = s) <=> convex s`, SIMP_TAC[HULL_EQ; CONVEX_INTERS]);; let CONVEX_HULLS_EQ = prove (`!s t. s SUBSET convex hull t /\ t SUBSET convex hull s ==> convex hull s = convex hull t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HULLS_EQ THEN ASM_SIMP_TAC[CONVEX_INTERS]);; let IS_CONVEX_HULL = prove (`!s. convex s <=> ?t. s = convex hull t`, GEN_TAC THEN MATCH_MP_TAC IS_HULL THEN SIMP_TAC[CONVEX_INTERS]);; let MIDPOINTS_IN_CONVEX_HULL = prove (`!x:real^N s. x IN convex hull s /\ y IN convex hull s ==> midpoint(x,y) IN convex hull s`, MESON_TAC[MIDPOINT_IN_CONVEX; CONVEX_CONVEX_HULL]);; let CONVEX_HULL_UNIV = prove (`convex hull (:real^N) = (:real^N)`, REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_UNIV]);; let BOUNDED_CONVEX_HULL = prove (`!s:real^N->bool. bounded s ==> bounded(convex hull s)`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [bounded] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(vec 0:real^N,B)` THEN SIMP_TAC[BOUNDED_CBALL; SUBSET_HULL; CONVEX_CBALL] THEN ASM_REWRITE_TAC[IN_CBALL; SUBSET; dist; VECTOR_SUB_LZERO; NORM_NEG]);; let BOUNDED_CONVEX_HULL_EQ = prove (`!s. bounded(convex hull s) <=> bounded s`, MESON_TAC[BOUNDED_CONVEX_HULL; HULL_SUBSET; BOUNDED_SUBSET]);; let FINITE_IMP_BOUNDED_CONVEX_HULL = prove (`!s. FINITE s ==> bounded(convex hull s)`, SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED]);; (* ------------------------------------------------------------------------- *) (* Stepping theorems for convex hulls of finite sets. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_EMPTY = prove (`convex hull {} = {}`, MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[SUBSET_REFL; CONVEX_EMPTY; EMPTY_SUBSET]);; let CONVEX_HULL_EQ_EMPTY = prove (`!s. (convex hull s = {}) <=> (s = {})`, GEN_TAC THEN EQ_TAC THEN MESON_TAC[SUBSET_EMPTY; HULL_SUBSET; CONVEX_HULL_EMPTY]);; let CONVEX_HULL_SING = prove (`!a. convex hull {a} = {a}`, REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_SING]);; let CONVEX_HULL_EQ_SING = prove (`!s a:real^N. convex hull s = {a} <=> s = {a}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONVEX_HULL_EMPTY] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_HULL_SING] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET {a} ==> s = {a}`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[HULL_SUBSET]);; let CONVEX_HULL_INSERT = prove (`!s a. ~(s = {}) ==> convex hull (a INSERT s) = {x:real^N | ?u v b. &0 <= u /\ &0 <= v /\ u + v = &1 /\ b IN (convex hull s) /\ x = u % a + v % b}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`&1`; `&0`]; MAP_EVERY EXISTS_TAC [`&0`; `&1`]] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO] THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; HULL_SUBSET; SUBSET]; ALL_TAC]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[convex] CONVEX_CONVEX_HULL) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HULL_SUBSET; SUBSET; IN_INSERT; HULL_MONO]] THEN REWRITE_TAC[convex; IN_ELIM_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`; `u1:real`; `v1:real`; `b1:real^N`; `u2:real`; `v2:real`; `b2:real^N`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`u * u1 + v * u2`; `u * v1 + v * v2`] THEN REWRITE_TAC[VECTOR_ARITH `u % (u1 % a + v1 % b1) + v % (u2 % a + v2 % b2):real^N = (u * u1 + v * u2) % a + (u * v1) % b1 + (v * v2) % b2`] THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_MUL] THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_ARITH `(u * u1 + v * u2) + (u * v1 + v * v2) = u * (u1 + v1) + v * (u2 + v2)`] THEN ASM_CASES_TAC `u * v1 + v * v2 = &0` THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `(a + b = &0) ==> &0 <= a /\ &0 <= b ==> (a = &0) /\ (b = &0)`)) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_ADD_LID; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `(u * v1) / (u * v1 + v * v2) % b1 + (v * v2) / (u * v1 + v * v2) % b2 :real^N` THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_LMUL] THEN MATCH_MP_TAC(REWRITE_RULE[convex] CONVEX_CONVEX_HULL) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_LE_ADD] THEN ASM_SIMP_TAC[real_div; GSYM REAL_ADD_RDISTRIB; REAL_MUL_RINV]);; let CONVEX_HULL_INSERT_ALT = prove (`!s a:real^N. convex hull (a INSERT s) = if s = {} then {a} else {(&1 - u) % a + u % x | &0 <= u /\ u <= &1 /\ x IN convex hull s}`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONVEX_HULL_SING] THEN ASM_SIMP_TAC[CONVEX_HULL_INSERT] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> b /\ c /\ a /\ d`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; REAL_SUB_LE; REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN SET_TAC[]);; let CONVEX_HULL_INSERT_SEGMENTS = prove (`!s a:real^N. convex hull (a INSERT s) = if s = {} then {a} else UNIONS {segment[a,x] | x IN convex hull s}`, REPEAT GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_INSERT_ALT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[UNIONS_GSPEC; IN_SEGMENT] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Explicit expressions for convex hull. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_INDEXED = prove (`!s. convex hull s = {y:real^N | ?k u x. (!i. 1 <= i /\ i <= k ==> &0 <= u i /\ x i IN s) /\ (sum (1..k) u = &1) /\ (vsum (1..k) (\i. u i % x i) = y)}`, GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`1`; `\i:num. &1`; `\i:num. x:real^N`] THEN ASM_SIMP_TAC[FINITE_RULES; IN_SING; SUM_SING; VECTOR_MUL_LID; VSUM_SING; REAL_POS; NUMSEG_SING]; ALL_TAC; REWRITE_TAC[CONVEX_INDEXED; SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MESON_TAC[]] THEN REWRITE_TAC[convex; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:num`; `u1:num->real`; `x1:num->real^N`; `k2:num`; `u2:num->real`; `x2:num->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `k1 + k2:num` THEN EXISTS_TAC `\i:num. if i <= k1 then u * u1(i) else v * u2(i - k1):real` THEN EXISTS_TAC `\i:num. if i <= k1 then x1(i) else x2(i - k1):real^N` THEN ASM_SIMP_TAC[NUMSEG_ADD_SPLIT; ARITH_RULE `1 <= x + 1 /\ x < x + 1`; IN_NUMSEG; SUM_UNION; VSUM_UNION; FINITE_NUMSEG; DISJOINT_NUMSEG; ARITH_RULE `k1 + 1 <= i ==> ~(i <= k1)`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] NUMSEG_OFFSET_IMAGE] THEN ASM_SIMP_TAC[SUM_IMAGE; VSUM_IMAGE; EQ_ADD_LCANCEL; FINITE_NUMSEG] THEN ASM_SIMP_TAC[o_DEF; ADD_SUB2; SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC; FINITE_NUMSEG; REAL_MUL_RID] THEN ASM_MESON_TAC[REAL_LE_MUL; ARITH_RULE `i <= k1 + k2 /\ ~(i <= k1) ==> 1 <= i - k1 /\ i - k1 <= k2`]);; let CONVEX_HULL_FINITE_IMAGE_EXPLICIT = prove (`!f:A->real^N k. FINITE k ==> convex hull (IMAGE f k) = {y | ?u. (!a. a IN k ==> &0 <= u a) /\ sum k u = &1 /\ vsum k (\a. u a % f a) = y}`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; CONVEX_HULL_EMPTY; ARITH_EQ; IMAGE_CLAUSES; EMPTY_GSPEC] THEN MAP_EVERY X_GEN_TAC [`b:A`; `k:A->bool`] THEN ASM_CASES_TAC `k:A->bool = {}` THENL [ASM_REWRITE_TAC[IMAGE_CLAUSES; SUM_SING; VSUM_SING; CONVEX_HULL_SING] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[MESON[] `&0 <= u /\ u = &1 /\ u % x:real^N = y <=> u = &1 /\ &0 <= &1 /\ &1 % x = y`] THEN REWRITE_TAC[REAL_POS; VECTOR_MUL_LID; LEFT_EXISTS_AND_THM] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `?u:A->real. u b = &1` (fun th -> REWRITE_TAC[th] THEN SET_TAC[]) THEN EXISTS_TAC `\a:A. &1` THEN REWRITE_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CONVEX_HULL_INSERT; IMAGE_EQ_EMPTY] THEN STRIP_TAC THEN ASM_SIMP_TAC[IN_ELIM_THM; SUM_CLAUSES; VSUM_CLAUSES] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[FORALL_IN_INSERT] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `z:real^N`; `c:A->real`] THEN STRIP_TAC THEN EXISTS_TAC `\a. if a = b then u else v * (c:A->real) a` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `~(b IN k) ==> !a. a IN k ==> ~(a = b)`)) THEN ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL; SUM_LMUL] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_MUL_RID]; X_GEN_TAC `c:A->real` THEN STRIP_TAC THEN ASM_CASES_TAC `(c:A->real) b = &1` THENL [UNDISCH_TAC `c(b:A) + sum k c = &1` THEN ASM_REWRITE_TAC[REAL_ARITH `&1 + x = &1 <=> x = &0`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] SUM_POS_EQ_0))) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`&1`; `&0`] THEN EXPAND_TAC "y" THEN REWRITE_TAC[VECTOR_ARITH `c % f + v:real^N = &1 % f + &0 % b <=> v = (&1 - c) % f`] THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0; REAL_SUB_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `d:A`) THEN EXISTS_TAC `\a:A. if a = d then &1 else &0` THEN ASM_REWRITE_TAC[SUM_DELTA] THEN MESON_TAC[REAL_POS]; MAP_EVERY EXISTS_TAC [`(c:A->real) b`; `&1 - (c:A->real) b`; `vsum k (\a. (c:A->real) a / (&1 - c b) % f a):real^N`; `\a. (c:A->real) a / (&1 - c b)`] THEN ASM_REWRITE_TAC[REAL_ARITH `x + &1 - x = &1`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL; VSUM_LMUL] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_SUB_0] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN ASM_SIMP_TAC[REAL_FIELD `~(c = &1) ==> (inv(&1 - c) * b = &1 <=> c + b = &1)`] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `c + s = &1 ==> &0 <= s ==> &0 <= &1 - c`)) THEN ASM_SIMP_TAC[SUM_POS_LE]]]);; (* ------------------------------------------------------------------------- *) (* Another formulation from Lars Schewe. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_EXPLICIT = prove (`!p. convex hull p = {y:real^N | ?s u. FINITE s /\ s SUBSET p /\ (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 /\ vsum s (\v. u v % v) = y}`, REWRITE_TAC[CONVEX_HULL_INDEXED;EXTENSION;IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`IMAGE (x':num->real^N) (1..k)`; `\v:real^N.sum {i | i IN (1..k) /\ x' i = v} u`] THEN ASM_SIMP_TAC[FINITE_IMAGE;FINITE_NUMSEG;IN_IMAGE] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM;IN_NUMSEG] THEN ASM_MESON_TAC[]; MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_NUMSEG;FINITE_RESTRICT;IN_ELIM_THM;IN_NUMSEG]; ASM_SIMP_TAC[GSYM SUM_IMAGE_GEN;FINITE_IMAGE;FINITE_NUMSEG]; FIRST_X_ASSUM (fun th -> REWRITE_TAC[GSYM th]) THEN ASM_SIMP_TAC[GSYM VSUM_IMAGE_GEN;FINITE_IMAGE; FINITE_NUMSEG;VSUM_VMUL;FINITE_RESTRICT] THEN MP_TAC (ISPECL [`x':num->real^N`;`\i:num.u i % (x' i):real^N`;`(1..k)`] (GSYM VSUM_IMAGE_GEN)) THEN ASM_SIMP_TAC[FINITE_NUMSEG]];ALL_TAC] THEN STRIP_ASSUME_TAC (ASM_REWRITE_RULE [ASSUME `FINITE (s:real^N->bool)`] (ISPEC `s:real^N->bool` FINITE_INDEX_NUMSEG)) THEN MAP_EVERY EXISTS_TAC [`CARD (s:real^N->bool)`; `(u:real^N->real) o (f:num->real^N)`; `(f:num->real^N)`] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[o_DEF] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_IMAGE;IN_NUMSEG] THEN ASM_MESON_TAC[]; MATCH_MP_TAC (REWRITE_RULE [SUBSET] (ASSUME `(s:real^N->bool) SUBSET p`)) THEN FIRST_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_IMAGE;IN_NUMSEG] THEN ASM_MESON_TAC[]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (s:real^N->bool) u` THEN CONJ_TAC THENL [ALL_TAC;ASM_REWRITE_TAC[]] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ASSUME `(s:real^N->bool) = IMAGE f (1..CARD s)`] THEN MATCH_MP_TAC (GSYM SUM_IMAGE) THEN ASM_MESON_TAC[]; REWRITE_TAC[MESON [o_THM;FUN_EQ_THM] `(\i:num. (u o f) i % f i) = (\v:real^N. u v % v) o f`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum (s:real^N->bool) (\v. u v % v)` THEN CONJ_TAC THENL [ALL_TAC;ASM_REWRITE_TAC[]] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ASSUME `(s:real^N->bool) = IMAGE f (1..CARD s)`] THEN MATCH_MP_TAC (GSYM VSUM_IMAGE) THEN ASM SET_TAC[FINITE_NUMSEG]]);; let CONVEX_HULL_FINITE = prove (`!s:real^N->bool. convex hull s = {y | ?u. (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y}`, GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `f:real^N->real`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. if x IN t then f x else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN REWRITE_TAC[REAL_LE_REFL; COND_ID]; X_GEN_TAC `f:real^N->real` THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN STRIP_TAC THEN EXISTS_TAC `support (+) (f:real^N->real) s` THEN EXISTS_TAC `f:real^N->real` THEN MP_TAC(ASSUME `sum s (f:real^N->real) = &1`) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sum] THEN REWRITE_TAC[iterate] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NEUTRAL_REAL_ADD; REAL_OF_NUM_EQ; ARITH] THEN DISCH_THEN(K ALL_TAC) THEN UNDISCH_TAC `sum s (f:real^N->real) = &1` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM SUM_SUPPORT] THEN ASM_CASES_TAC `support (+) (f:real^N->real) s = {}` THEN ASM_SIMP_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN DISCH_TAC THEN REWRITE_TAC[SUPPORT_SUBSET] THEN CONJ_TAC THENL [ASM_SIMP_TAC[support; IN_ELIM_THM]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[SUPPORT_SUBSET] THEN REWRITE_TAC[support; IN_ELIM_THM; NEUTRAL_REAL_ADD] THEN MESON_TAC[VECTOR_MUL_LZERO]]);; let CONVEX_HULL_IMAGE = prove (`!f:A->real^N k. convex hull (IMAGE f k) = {y | ?c u. FINITE c /\ c SUBSET k /\ (!a. a IN c ==> &0 <= u a) /\ sum c u = &1 /\ vsum c (\a. u a % f a) = y}`, REPEAT GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_EXPLICIT] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE_INJ] THEN X_GEN_TAC `c:A->bool` THEN STRIP_TAC THEN X_GEN_TAC `u:real^N->real` THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o lhand o lhand o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_IMAGE o lhand o rand o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`c:A->bool`; `(u:real^N->real) o (f:A->real^N)`] THEN ASM_SIMP_TAC[GSYM SUM_IMAGE; GSYM VSUM_IMAGE] THEN ASM_SIMP_TAC[o_DEF]; MAP_EVERY X_GEN_TAC [`c:A->bool`; `u:A->real`] THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:A->real^N) c` THEN EXISTS_TAC `\y. sum {a | a IN c /\ (f:A->real^N) a = y} u` THEN ASM_SIMP_TAC[GSYM SUM_IMAGE_GEN; FINITE_IMAGE; IMAGE_SUBSET] THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN ASM SET_TAC[]; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MP_TAC(GEN `g:A->real^N` (ISPECL [`f:A->real^N`; `g:A->real^N`; `c:A->bool`] VSUM_IMAGE_GEN)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[FORALL_IN_IMAGE; GSYM VSUM_RMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN SET_TAC[]]]);; let CONVEX_HULL_IMAGE_LT = prove (`!f:A->real^N k. convex hull (IMAGE f k) = {y | ?c u. FINITE c /\ c SUBSET k /\ (!a. a IN c ==> &0 < u a) /\ sum c u = &1 /\ vsum c (\a. u a % f a) = y}`, REPEAT GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_IMAGE] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL [ONCE_REWRITE_TAC[SWAP_EXISTS_THM]; MESON_TAC[REAL_LT_IMP_LE]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:A->real` THEN DISCH_THEN(X_CHOOSE_THEN `c:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{a | a IN c /\ &0 < (u:A->real) a}` THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN CONV_TAC SYM_CONV THENL [MATCH_MP_TAC SUM_SUPERSET; MATCH_MP_TAC VSUM_SUPERSET] THEN REWRITE_TAC[SUBSET_RESTRICT; IN_ELIM_THM] THEN ASM_SIMP_TAC[IMP_CONJ; REAL_LT_LE] THEN MESON_TAC[VECTOR_MUL_LZERO]);; let CONVEX_HULL_UNION_EXPLICIT = prove (`!s t:real^N->bool. convex s /\ convex t ==> convex hull (s UNION t) = s UNION t UNION {(&1 - u) % x + u % y | x IN s /\ y IN t /\ &0 <= u /\ u <= &1}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[CONVEX_HULL_EXPLICIT] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `u:real^N->bool`; `f:real^N->real`] THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBST1_TAC(SET_RULE `u:real^N->bool = (u INTER s) UNION (u DIFF s)`) THEN ASM_SIMP_TAC[SUM_UNION; VSUM_UNION; FINITE_INTER; FINITE_DIFF; SET_RULE `DISJOINT (u INTER s) (u DIFF s)`] THEN ASM_CASES_TAC `sum (u INTER s) (f:real^N->real) = &0` THENL [SUBGOAL_THEN `!x. x IN (u INTER s) ==> (f:real^N->real) x = &0` ASSUME_TAC THENL [ASM_MESON_TAC[SUM_POS_EQ_0; FINITE_INTER; IN_INTER]; ASM_SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0] THEN REWRITE_TAC[VECTOR_ADD_LID; REAL_ADD_LID] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN REWRITE_TAC[IN_UNION] THEN DISJ2_TAC THEN DISJ1_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN ASM_SIMP_TAC[FINITE_DIFF; IN_DIFF] THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `sum (u DIFF s) (f:real^N->real) = &0` THENL [SUBGOAL_THEN `!x. x IN (u DIFF s) ==> (f:real^N->real) x = &0` ASSUME_TAC THENL [ASM_MESON_TAC[SUM_POS_EQ_0; FINITE_DIFF; IN_DIFF]; ASM_SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN ASM_SIMP_TAC[FINITE_INTER; IN_INTER] THEN ASM SET_TAC[]]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`vsum(u INTER s) (\v:real^N. (f v / sum(u INTER s) f) % v)`; `sum(u DIFF s) (f:real^N->real)`; `vsum(u DIFF s) (\v:real^N. (f v / sum(u DIFF s) f) % v)`] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN ASM_SIMP_TAC[INTER_SUBSET; FINITE_INTER; SUM_POS_LE; REAL_LE_DIV; IN_INTER; real_div; SUM_RMUL; REAL_MUL_RINV]; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN ASM_SIMP_TAC[SUBSET_DIFF; FINITE_DIFF; SUM_POS_LE; REAL_LE_DIV; IN_DIFF; real_div; SUM_RMUL; REAL_MUL_RINV] THEN ASM SET_TAC[]; ASM_SIMP_TAC[SUM_POS_LE; IN_DIFF; FINITE_DIFF]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a + b = &1 ==> &0 <= a ==> b <= &1`)) THEN ASM_SIMP_TAC[SUM_POS_LE; IN_INTER; FINITE_INTER]; ASM_SIMP_TAC[GSYM VSUM_LMUL; FINITE_INTER; FINITE_DIFF] THEN SIMP_TAC[VECTOR_MUL_ASSOC; REAL_ARITH `a * b / c:real = a / c * b`] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH `a + b = &1 ==> &1 - b = a`)) THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_MUL_LID]]; REWRITE_TAC[GSYM UNION_ASSOC] THEN ONCE_REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[HULL_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real`; `y:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] CONVEX_CONVEX_HULL) THEN ASM_SIMP_TAC[HULL_INC; IN_UNION]]);; let CONVEX_HULL_UNION_NONEMPTY_EXPLICIT = prove (`!s t:real^N->bool. convex s /\ ~(s = {}) /\ convex t /\ ~(t = {}) ==> convex hull (s UNION t) = {(&1 - u) % x + u % y | x IN s /\ y IN t /\ &0 <= u /\ u <= &1}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_UNION_EXPLICIT] THEN SIMP_TAC[SET_RULE `s UNION t UNION u = u <=> s SUBSET u /\ t SUBSET u`] THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THENL [MAP_EVERY EXISTS_TAC [`z:real^N`; `&0`] THEN REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LID; REAL_POS; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN ASM SET_TAC[]; SUBGOAL_THEN `?a:real^N. a IN s` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`&1`; `z:real^N`] THEN ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN VECTOR_ARITH_TAC]);; let CONVEX_HULL_UNION_UNIONS = prove (`!f s:real^N->bool. convex(UNIONS f) /\ ~(f = {}) ==> convex hull (s UNION UNIONS f) = UNIONS {convex hull (s UNION t) | t IN f}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_SIMP_TAC[UNION_EMPTY; HULL_P; UNIONS_SUBSET] THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull u:real^N->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `UNIONS f :real^N->bool = {}` THENL [ASM_REWRITE_TAC[UNION_EMPTY] THEN SUBGOAL_THEN `?u:real^N->bool. u IN f` CHOOSE_TAC THENL [ASM_REWRITE_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull (s UNION u:real^N->bool)` THEN ASM_SIMP_TAC[HULL_MONO; SUBSET_UNION] THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [HULL_UNION_LEFT] THEN ASM_SIMP_TAC[CONVEX_HULL_UNION_NONEMPTY_EXPLICIT; CONVEX_HULL_EQ_EMPTY; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_UNIONS] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real`; `u:real^N->bool`] THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] CONVEX_CONVEX_HULL) THEN ASM_MESON_TAC[HULL_MONO; IN_UNION; SUBSET; HULL_INC]);; (* ------------------------------------------------------------------------- *) (* A stepping theorem for that expansion. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_FINITE_STEP = prove (`((?u. (!x. x IN {} ==> &0 <= u x) /\ sum {} u = w /\ vsum {} (\x. u(x) % x) = y) <=> w = &0 /\ y = vec 0) /\ (FINITE(s:real^N->bool) ==> ((?u. (!x. x IN (a INSERT s) ==> &0 <= u x) /\ sum (a INSERT s) u = w /\ vsum (a INSERT s) (\x. u(x) % x) = y) <=> ?v. &0 <= v /\ ?u. (!x. x IN s ==> &0 <= u x) /\ sum s u = w - v /\ vsum s (\x. u(x) % x) = y - v % a))`, MP_TAC(ISPEC `\x:real^N y:real. &0 <= y` AFFINE_HULL_FINITE_STEP_GEN) THEN SIMP_TAC[REAL_ARITH `&0 <= x / &2 <=> &0 <= x`; REAL_LE_ADD] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM]);; (* ------------------------------------------------------------------------- *) (* Hence some special cases. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_2 = prove (`!a b. convex hull {a,b} = {u % a + v % b | &0 <= u /\ &0 <= v /\ u + v = &1}`, SIMP_TAC[CONVEX_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN SIMP_TAC[CONVEX_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; let CONVEX_HULL_2_ALT = prove (`!a b. convex hull {a,b} = {a + u % (b - a) | &0 <= u /\ u <= &1}`, ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN REWRITE_TAC[CONVEX_HULL_2; EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[REAL_ADD_ASSOC; CONJ_ASSOC] THEN REWRITE_TAC[TAUT `(a /\ x + y = &1) /\ b <=> x + y = &1 /\ a /\ b`] THEN REWRITE_TAC[REAL_ARITH `x + y = &1 <=> y = &1 - x`; UNWIND_THM2] THEN REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN BINOP_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]);; let CONVEX_HULL_3 = prove (`convex hull {a,b,c} = { u % a + v % b + w % c | &0 <= u /\ &0 <= v /\ &0 <= w /\ u + v + w = &1}`, SIMP_TAC[CONVEX_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN SIMP_TAC[CONVEX_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; let CONVEX_HULL_3_ALT = prove (`!a b c. convex hull {a,b,c} = {a + u % (b - a) + v % (c - a) | &0 <= u /\ &0 <= v /\ u + v <= &1}`, ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,c,a}`] THEN REWRITE_TAC[CONVEX_HULL_3; EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[REAL_ADD_ASSOC; CONJ_ASSOC] THEN REWRITE_TAC[TAUT `(a /\ x + y = &1) /\ b <=> x + y = &1 /\ a /\ b`] THEN REWRITE_TAC[REAL_ARITH `x + y = &1 <=> y = &1 - x`; UNWIND_THM2] THEN REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN BINOP_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]);; let CONVEX_HULL_SUMS = prove (`!s t:real^N->bool. convex hull {x + y | x IN s /\ y IN t} = {x + y | x IN convex hull s /\ y IN convex hull t}`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[CONVEX_SUMS; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[HULL_INC]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONVEX_HULL_INDEXED] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:num`; `u1:num->real`; `x1:num->real^N`; `k2:num`; `u2:num->real`; `x2:num->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `x + y:real^N = vsum(1..k1) (\i. vsum(1..k2) (\j. u1 i % u2 j % (x1 i + x2 j)))` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD_NUMSEG] THEN ASM_SIMP_TAC[VSUM_LMUL; VSUM_RMUL; VECTOR_MUL_LID]; REWRITE_TAC[VSUM_LMUL] THEN MATCH_MP_TAC CONVEX_VSUM THEN ASM_SIMP_TAC[FINITE_NUMSEG; CONVEX_CONVEX_HULL; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN ASM_SIMP_TAC[FINITE_NUMSEG; CONVEX_CONVEX_HULL; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]]]);; let AFFINE_HULL_SUMS = prove (`!s t:real^N->bool. affine hull {x + y | x IN s /\ y IN t} = {x + y | x IN affine hull s /\ y IN affine hull t}`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[AFFINE_SUMS; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[HULL_INC]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [AFFINE_HULL_INDEXED] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:num`; `u1:num->real`; `x1:num->real^N`; `k2:num`; `u2:num->real`; `x2:num->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `x + y:real^N = vsum(1..k1) (\i. vsum(1..k2) (\j. u1 i % u2 j % (x1 i + x2 j)))` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD_NUMSEG] THEN ASM_SIMP_TAC[VSUM_LMUL; VSUM_RMUL; VECTOR_MUL_LID]; REWRITE_TAC[VSUM_LMUL] THEN MATCH_MP_TAC AFFINE_VSUM THEN ASM_SIMP_TAC[FINITE_NUMSEG; AFFINE_AFFINE_HULL; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_VSUM THEN ASM_SIMP_TAC[FINITE_NUMSEG; AFFINE_AFFINE_HULL; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]]]);; let AFFINE_HULL_PCROSS,CONVEX_HULL_PCROSS = (CONJ_PAIR o prove) (`(!s:real^M->bool t:real^N->bool. affine hull (s PCROSS t) = (affine hull s) PCROSS (affine hull t)) /\ (!s:real^M->bool t:real^N->bool. convex hull (s PCROSS t) = (convex hull s) PCROSS (convex hull t))`, let lemma1 = prove (`!u v x y:real^M z:real^N. u + v = &1 ==> pastecart z (u % x + v % y) = u % pastecart z x + v % pastecart z y /\ pastecart (u % x + v % y) z = u % pastecart x z + v % pastecart y z`, REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL] THEN SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]) and lemma2 = prove (`INTERS {{x | pastecart x y IN u} | y IN t} = {x | !y. y IN t ==> pastecart x y IN u}`, REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM] THEN SET_TAC[]) in CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[AFFINE_PCROSS; AFFINE_AFFINE_HULL; HULL_SUBSET; PCROSS_MONO]; REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `pastecart (x:real^M) (y:real^N) IN s PCROSS t` MP_TAC THENL [ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; ALL_TAC] THEN REWRITE_TAC[HULL_INC]; ALL_TAC]; REWRITE_TAC[GSYM lemma2] THEN MATCH_MP_TAC AFFINE_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC]] THEN SIMP_TAC[affine; IN_ELIM_THM; lemma1; ONCE_REWRITE_RULE[affine] AFFINE_AFFINE_HULL]]; REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[CONVEX_PCROSS; CONVEX_CONVEX_HULL; HULL_SUBSET; PCROSS_MONO]; REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `pastecart (x:real^M) (y:real^N) IN s PCROSS t` MP_TAC THENL [ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; ALL_TAC] THEN REWRITE_TAC[HULL_INC]; ALL_TAC]; REWRITE_TAC[GSYM lemma2] THEN MATCH_MP_TAC CONVEX_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC]] THEN SIMP_TAC[convex; IN_ELIM_THM; lemma1; ONCE_REWRITE_RULE[convex] CONVEX_CONVEX_HULL]]]);; (* ------------------------------------------------------------------------- *) (* Relations among closure notions and corresponding hulls. *) (* ------------------------------------------------------------------------- *) let SUBSPACE_IMP_AFFINE = prove (`!s. subspace s ==> affine s`, REWRITE_TAC[subspace; affine] THEN MESON_TAC[]);; let AFFINE_IMP_CONVEX = prove (`!s. affine s ==> convex s`, REWRITE_TAC[affine; convex] THEN MESON_TAC[]);; let SUBSPACE_IMP_CONVEX = prove (`!s. subspace s ==> convex s`, MESON_TAC[SUBSPACE_IMP_AFFINE; AFFINE_IMP_CONVEX]);; let AFFINE_HULL_SUBSET_SPAN = prove (`!s. (affine hull s) SUBSET (span s)`, GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_ANTIMONO THEN REWRITE_TAC[SUBSET; IN; SUBSPACE_IMP_AFFINE]);; let CONVEX_HULL_SUBSET_SPAN = prove (`!s. (convex hull s) SUBSET (span s)`, GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_ANTIMONO THEN REWRITE_TAC[SUBSET; IN; SUBSPACE_IMP_CONVEX]);; let CONVEX_HULL_SUBSET_AFFINE_HULL = prove (`!s. (convex hull s) SUBSET (affine hull s)`, GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_ANTIMONO THEN REWRITE_TAC[SUBSET; IN; AFFINE_IMP_CONVEX]);; let COLLINEAR_CONVEX_HULL_COLLINEAR = prove (`!s:real^N->bool. collinear(convex hull s) <=> collinear s`, MESON_TAC[COLLINEAR_SUBSET; HULL_SUBSET; SUBSET_TRANS; COLLINEAR_AFFINE_HULL_COLLINEAR; CONVEX_HULL_SUBSET_AFFINE_HULL]);; let AFFINE_SPAN = prove (`!s. affine(span s)`, SIMP_TAC[SUBSPACE_IMP_AFFINE; SUBSPACE_SPAN]);; let CONVEX_SPAN = prove (`!s. convex(span s)`, SIMP_TAC[SUBSPACE_IMP_CONVEX; SUBSPACE_SPAN]);; let SPAN_CONVEX_HULL = prove (`!s:real^N->bool. span(convex hull s) = span s`, GEN_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[SPAN_MONO; HULL_SUBSET] THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[SPAN_INC; CONVEX_SPAN]);; let DIM_CONVEX_HULL = prove (`!s:real^N->bool. dim(convex hull s) = dim s`, MESON_TAC[SPAN_CONVEX_HULL; DIM_SPAN]);; let AFFINE_EQ_SUBSPACE = prove (`!s:real^N->bool. vec 0 IN s ==> (affine s <=> subspace s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[subspace; affine] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `c % x:real^N = c % x + (&1 - c) % vec 0`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `x + y:real^N = &2 % (&1 / &2 % x + &1 / &2 % y)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; let AFFINE_IMP_SUBSPACE = prove (`!s. affine s /\ vec 0 IN s ==> subspace s`, SIMP_TAC[GSYM AFFINE_EQ_SUBSPACE]);; let SUBSPACE_EQ_AFFINE = prove (`!s:real^N->bool. subspace s <=> affine s /\ vec 0 IN s`, MESON_TAC[AFFINE_IMP_SUBSPACE; SUBSPACE_IMP_AFFINE; SUBSPACE_0]);; let AFFINE_HULL_EQ_SPAN = prove (`!s:real^N->bool. (vec 0) IN affine hull s ==> affine hull s = span s`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[AFFINE_HULL_SUBSET_SPAN] THEN REWRITE_TAC[SUBSET] THEN MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[SUBSET; subspace; IN_ELIM_THM; HULL_INC] THEN REPEAT STRIP_TAC THENL [SUBST1_TAC(VECTOR_ARITH `x + y:real^N = &2 % (&1 / &2 % x + &1 / &2 % y) + --(&1) % vec 0`) THEN MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; SUBST1_TAC(VECTOR_ARITH `c % x:real^N = c % x + (&1 - c) % vec 0`) THEN MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; let SPAN_AFFINE_HULL_INSERT = prove (`!s:real^N->bool. span s = affine hull (vec 0 INSERT s)`, SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0]);; let CLOSED_AFFINE = prove (`!s:real^N->bool. affine s ==> closed s`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CLOSED_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN SUBGOAL_THEN `affine (IMAGE (\x:real^N. --a + x) s) ==> closed (IMAGE (\x:real^N. --a + x) s)` MP_TAC THENL [DISCH_THEN(fun th -> MATCH_MP_TAC CLOSED_SUBSPACE THEN MP_TAC th) THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC AFFINE_EQ_SUBSPACE THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; REWRITE_TAC[AFFINE_TRANSLATION_EQ; CLOSED_TRANSLATION_EQ]]);; let CLOSED_AFFINE_HULL = prove (`!s. closed(affine hull s)`, SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL]);; let CLOSURE_SUBSET_AFFINE_HULL = prove (`!s. closure s SUBSET affine hull s`, GEN_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_AFFINE_HULL; HULL_SUBSET]);; let AFFINE_HULL_CLOSURE = prove (`!s:real^N->bool. affine hull (closure s) = affine hull s`, GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]);; let AFFINE_HULL_EQ_SPAN_EQ = prove (`!s:real^N->bool. (affine hull s = span s) <=> (vec 0) IN affine hull s`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPAN_0; AFFINE_HULL_EQ_SPAN]);; let AFFINE_DEPENDENT_IMP_DEPENDENT = prove (`!s. affine_dependent s ==> dependent s`, REWRITE_TAC[affine_dependent; dependent] THEN MESON_TAC[SUBSET; AFFINE_HULL_SUBSET_SPAN]);; let DEPENDENT_AFFINE_DEPENDENT_CASES = prove (`!s:real^N->bool. dependent s <=> affine_dependent s \/ (vec 0) IN affine hull s`, REWRITE_TAC[DEPENDENT_EXPLICIT; AFFINE_DEPENDENT_EXPLICIT; AFFINE_HULL_EXPLICIT_ALT; IN_ELIM_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[OR_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `t:real^N->bool` THEN ASM_CASES_TAC `FINITE(t:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC)) THENL [ASM_CASES_TAC `sum t (u:real^N->real) = &0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISJ2_TAC THEN EXISTS_TAC `\v:real^N. inv(sum t u) * u v` THEN ASM_SIMP_TAC[SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[VECTOR_MUL_RZERO; REAL_MUL_LINV]; EXISTS_TAC `u:real^N->real` THEN ASM_MESON_TAC[]; EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[SET_RULE `(?v. v IN t /\ ~p v) <=> ~(!v. v IN t ==> p v)`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x = &1 ==> x = &0 ==> F`)) THEN ASM_MESON_TAC[SUM_EQ_0]]);; let DEPENDENT_IMP_AFFINE_DEPENDENT = prove (`!a:real^N s. dependent {x - a | x IN s} /\ ~(a IN s) ==> affine_dependent(a INSERT s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[DEPENDENT_EXPLICIT; AFFINE_DEPENDENT_EXPLICIT] THEN REWRITE_TAC[SIMPLE_IMAGE; CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN REWRITE_TAC[TAUT `a /\ x = IMAGE f s /\ b <=> x = IMAGE f s /\ a /\ b`] THEN REWRITE_TAC[UNWIND_THM2; EXISTS_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` (X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o check (is_eq o concl)) THEN ASM_SIMP_TAC[VSUM_IMAGE; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN ASM_SIMP_TAC[o_DEF; VECTOR_SUB_LDISTRIB; VSUM_SUB; VSUM_RMUL] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(a:real^N) INSERT t`; `\x. if x = a then --sum t (\x. u (x - a)) else (u:real^N->real) (x - a)`] THEN ASM_REWRITE_TAC[FINITE_INSERT; SUBSET_REFL] THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x = y ==> --x + y = &0`) THEN MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[]; EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; MATCH_MP_TAC(VECTOR_ARITH `!s. s - t % a = vec 0 /\ s = u ==> --t % a + u = vec 0`) THEN EXISTS_TAC `vsum t (\x:real^N. u(x - a) % x)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; let AFFINE_DEPENDENT_BIGGERSET = prove (`!s:real^N->bool. (FINITE s ==> CARD s >= dimindex(:N) + 2) ==> affine_dependent s`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[CARD_CLAUSES; ARITH_RULE `~(0 >= n + 2)`; FINITE_RULES] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`)) THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; IN_DELETE] THEN REWRITE_TAC[ARITH_RULE `SUC x >= n + 2 <=> x > n`] THEN DISCH_TAC THEN MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC DEPENDENT_BIGGERSET THEN REWRITE_TAC[SET_RULE `{x - a:real^N | x | x IN s /\ ~(x = a)} = IMAGE (\x. x - a) (s DELETE a)`] THEN ASM_SIMP_TAC[FINITE_IMAGE_INJ_EQ; VECTOR_ARITH `x - a = y - a <=> x:real^N = y`; CARD_IMAGE_INJ]);; let AFFINE_DEPENDENT_BIGGERSET_GENERAL = prove (`!s:real^N->bool. (FINITE s ==> CARD s >= dim s + 2) ==> affine_dependent s`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[CARD_CLAUSES; ARITH_RULE `~(0 >= n + 2)`; FINITE_RULES] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`)) THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; IN_DELETE] THEN REWRITE_TAC[ARITH_RULE `SUC x >= n + 2 <=> x > n`] THEN DISCH_TAC THEN MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC DEPENDENT_BIGGERSET_GENERAL THEN REWRITE_TAC[SET_RULE `{x - a:real^N | x | x IN s /\ ~(x = a)} = IMAGE (\x. x - a) (s DELETE a)`] THEN ASM_SIMP_TAC[FINITE_IMAGE_INJ_EQ; FINITE_DELETE; VECTOR_ARITH `x - a = y - a <=> x:real^N = y`; CARD_IMAGE_INJ] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl)) THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN MATCH_MP_TAC(ARITH_RULE `c:num <= b ==> (a > b ==> a > c)`) THEN MATCH_MP_TAC SUBSET_LE_DIM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN SIMP_TAC[SPAN_SUB; SPAN_SUPERSET; IN_INSERT]);; let AFFINE_INDEPENDENT_IMP_FINITE = prove (`!s:real^N->bool. ~(affine_dependent s) ==> FINITE s`, MESON_TAC[AFFINE_DEPENDENT_BIGGERSET]);; let AFFINE_INDEPENDENT_CARD_LE = prove (`!s:real^N->bool. ~(affine_dependent s) ==> CARD s <= dimindex(:N) + 1`, REWRITE_TAC[ARITH_RULE `s <= n + 1 <=> ~(n + 2 <= s)`; CONTRAPOS_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_DEPENDENT_BIGGERSET THEN ASM_REWRITE_TAC[GE]);; let AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL = prove (`!s t:real^N->bool. ~affine_dependent s /\ t SUBSET s ==> convex hull t = affine hull t INTER convex hull s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN SUBGOAL_THEN `FINITE(t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `ct SUBSET a /\ ct SUBSET cs /\ a INTER cs SUBSET ct ==> ct = a INTER cs`) THEN ASM_SIMP_TAC[HULL_MONO; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN REWRITE_TAC[SUBSET; IN_INTER; CONVEX_HULL_FINITE; AFFINE_HULL_FINITE] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_DEPENDENT_EXPLICIT]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `\x:real^N. if x IN t then v x - u x:real else v x`]) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN REWRITE_TAC[MESON[] `(if p then a else b) % x = if p then a % x else b % x`] THEN ASM_SIMP_TAC[VSUM_CASES; SUM_CASES; SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN ASM_SIMP_TAC[GSYM DIFF; SUM_DIFF; VSUM_DIFF; VECTOR_SUB_RDISTRIB; SUM_SUB; VSUM_SUB] THEN REWRITE_TAC[REAL_ARITH `a - b + b - a = &0`; NOT_EXISTS_THM; VECTOR_ARITH `a - b + b - a:real^N = vec 0`] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[REAL_SUB_0] THEN ASM SET_TAC[]);; let DISJOINT_AFFINE_HULL = prove (`!s t u:real^N->bool. ~affine_dependent s /\ t SUBSET s /\ u SUBSET s /\ DISJOINT t u ==> DISJOINT (affine hull t) (affine hull u)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN SUBGOAL_THEN `FINITE(t:real^N->bool) /\ FINITE (u:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[IN_DISJOINT; AFFINE_HULL_FINITE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a:real^N->real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `b:real^N->real` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_DEPENDENT_EXPLICIT]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `\x:real^N. if x IN t then a x else if x IN u then --(b x) else &0`] THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN REWRITE_TAC[MESON[] `(if p then a else b) % x = if p then a % x else b % x`] THEN ASM_SIMP_TAC[SUM_CASES; SUBSET_REFL; VSUM_CASES; GSYM DIFF; SUM_DIFF; VSUM_DIFF; SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN ASM_SIMP_TAC[SUM_0; VSUM_0; VECTOR_MUL_LZERO; SUM_NEG; VSUM_NEG; VECTOR_MUL_LNEG; SET_RULE `DISJOINT t u ==> ~(x IN t /\ x IN u)`] THEN REWRITE_TAC[EMPTY_GSPEC; SUM_CLAUSES; VSUM_CLAUSES] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN UNDISCH_TAC `sum t (a:real^N->real) = &1` THEN ASM_CASES_TAC `!x:real^N. x IN t ==> a x = &0` THEN ASM_SIMP_TAC[SUM_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let AFFINE_INDEPENDENT_SPAN_EQ = prove (`!s. ~(affine_dependent s) /\ CARD s = dimindex(:N) + 1 ==> affine hull s = (:real^N)`, MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[CARD_CLAUSES; ARITH_RULE `~(0 = n + 1)`] THEN SIMP_TAC[IMP_CONJ; AFFINE_INDEPENDENT_IMP_FINITE; MESON[HAS_SIZE] `FINITE s ==> (CARD s = n <=> s HAS_SIZE n)`] THEN X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; IMP_CONJ] THEN REWRITE_TAC[ARITH_RULE `SUC n = m + 1 <=> n = m`; GSYM UNIV_SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN ASM_REWRITE_TAC[DIM_UNIV; SUBSET_UNIV; LE_REFL; independent] THEN UNDISCH_TAC `~affine_dependent((vec 0:real^N) INSERT s)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO; SET_RULE `{x | x IN s} = s`]);; let AFFINE_INDEPENDENT_SPAN_GT = prove (`!s:real^N->bool. ~(affine_dependent s) /\ dimindex(:N) < CARD s ==> affine hull s = (:real^N)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_EQ THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `s:real^N->bool` AFFINE_DEPENDENT_BIGGERSET) THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN ASM_ARITH_TAC);; let EMPTY_INTERIOR_AFFINE_HULL = prove (`!s:real^N->bool. FINITE s /\ CARD(s) <= dimindex(:N) ==> interior(affine hull s) = {}`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[AFFINE_HULL_EMPTY; INTERIOR_EMPTY] THEN SUBGOAL_THEN `!x s:real^N->bool n. ~(x IN s) /\ (x INSERT s) HAS_SIZE n /\ n <= dimindex(:N) ==> interior(affine hull(x INSERT s)) = {}` (fun th -> MESON_TAC[th; HAS_SIZE; FINITE_INSERT]) THEN X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN REWRITE_TAC[HAS_SIZE; FINITE_INSERT; IMP_CONJ] THEN SIMP_TAC[CARD_CLAUSES] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EMPTY_INTERIOR_LOWDIM THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN ASM_SIMP_TAC[DIM_LE_CARD; DIM_SPAN] THEN ASM_ARITH_TAC);; let EMPTY_INTERIOR_CONVEX_HULL = prove (`!s:real^N->bool. FINITE s /\ CARD(s) <= dimindex(:N) ==> interior(convex hull s) = {}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN EXISTS_TAC `interior(affine hull s):real^N->bool` THEN SIMP_TAC[SUBSET_INTERIOR; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN ASM_SIMP_TAC[EMPTY_INTERIOR_AFFINE_HULL]);; let AFFINE_DEPENDENT_CHOOSE = prove (`!s a:real^N. ~(affine_dependent s) ==> (affine_dependent(a INSERT s) <=> ~(a IN s) /\ a IN affine hull s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN EQ_TAC THENL [UNDISCH_TAC `~(affine_dependent(s:real^N->bool))` THEN ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE; AFFINE_HULL_FINITE; FINITE_INSERT; IN_ELIM_THM; SUM_CLAUSES; VSUM_CLAUSES] THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_IN_INSERT] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` MP_TAC) THEN ASM_CASES_TAC `(u:real^N->real) a = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[REAL_ADD_LID; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `u:real^N->real`) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[REAL_ARITH `ua + sa = &0 <=> sa = --ua`; VECTOR_ARITH `va + sa:real^N = vec 0 <=> sa = --va`] THEN STRIP_TAC THEN EXISTS_TAC `(\x. --(inv(u a)) * u x):real^N->real` THEN ASM_SIMP_TAC[SUM_LMUL; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_MUL_LNEG] THEN REWRITE_TAC[REAL_ARITH `--a * --b:real = a * b`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]]; DISCH_TAC THEN REWRITE_TAC[affine_dependent] THEN EXISTS_TAC `a:real^N` THEN ASM_SIMP_TAC[IN_INSERT; SET_RULE `~(a IN s) ==> (a INSERT s) DELETE a = s`]]);; let AFFINE_INDEPENDENT_INSERT = prove (`!s a:real^N. ~(affine_dependent s) /\ ~(a IN affine hull s) ==> ~(affine_dependent(a INSERT s))`, SIMP_TAC[AFFINE_DEPENDENT_CHOOSE]);; let AFFINE_HULL_EXPLICIT_UNIQUE = prove (`!s:real^N->bool u u'. ~(affine_dependent s) /\ sum s u = &1 /\ sum s u' = &1 /\ vsum s (\x. u x % x) = vsum s (\x. u' x % x) ==> !x. x IN s ==> u x = u' x`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN FIRST_ASSUM(MP_TAC o MATCH_MP AFFINE_DEPENDENT_EXPLICIT_FINITE) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `(\x. u x - u' x):real^N->real`) THEN ASM_SIMP_TAC[VSUM_SUB; SUM_SUB; REAL_SUB_REFL; VECTOR_SUB_RDISTRIB; VECTOR_SUB_REFL; VECTOR_SUB_EQ; REAL_SUB_0] THEN MESON_TAC[]);; let INDEPENDENT_IMP_AFFINE_DEPENDENT_0 = prove (`!s. independent s ==> ~(affine_dependent(vec 0 INSERT s))`, REWRITE_TAC[independent; DEPENDENT_AFFINE_DEPENDENT_CASES] THEN SIMP_TAC[DE_MORGAN_THM; AFFINE_INDEPENDENT_INSERT]);; let AFFINE_INDEPENDENT_STDBASIS = prove (`~(affine_dependent ((vec 0:real^N) INSERT {basis i | 1 <= i /\ i <= dimindex (:N)}))`, SIMP_TAC[INDEPENDENT_IMP_AFFINE_DEPENDENT_0; INDEPENDENT_STDBASIS]);; let SPAN_CONIC_HULL = prove (`!s:real^N->bool. span(conic hull s) = span s`, GEN_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[HULL_SUBSET; SPAN_MONO] THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN; CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[SPAN_SUPERSET; SPAN_MUL]);; let CONIC_HULLS_EQ_IMP_SPANS_EQ = prove (`!s t:real^N->bool. conic hull s = conic hull t ==> span s = span t`, MESON_TAC[SPAN_CONIC_HULL]);; let DIM_CONIC_HULL = prove (`!s:real^N->bool. dim(conic hull s) = dim s`, MESON_TAC[DIM_SPAN; SPAN_CONIC_HULL]);; let CONIC_HULL_SUBSET_SPAN = prove (`!s:real^N->bool. conic hull s SUBSET span s`, MESON_TAC[SPAN_CONIC_HULL; SPAN_INC]);; let CONIC_IMAGE_MULTIPLE_EQ = prove (`!s:real^N->bool. conic s <=> !a. &0 <= a ==> IMAGE (\x. a % x) s SUBSET s`, SIMP_TAC[conic; SUBSET; FORALL_IN_IMAGE] THEN MESON_TAC[]);; let CONIC_IMAGE_MULTIPLE = prove (`!s:real^N->bool a. conic s /\ &0 < a ==> IMAGE (\x. a % x) s = s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; CONIC_IMAGE_MULTIPLE_EQ]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE (\x:real^N. a % x) s` CONIC_IMAGE_MULTIPLE_EQ) THEN ASM_SIMP_TAC[CONIC_LINEAR_IMAGE; LINEAR_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv a:real`) THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_IMP_LE; GSYM IMAGE_o] THEN ASM_SIMP_TAC[o_DEF; VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID; IMAGE_ID]);; (* ------------------------------------------------------------------------- *) (* Nonempty affine sets are translates of (unique) subspaces. *) (* ------------------------------------------------------------------------- *) let AFFINE_TRANSLATION_SUBSPACE = prove (`!t:real^N->bool. affine t /\ ~(t = {}) <=> ?a s. subspace s /\ t = IMAGE (\x. a + x) s`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[SUBSPACE_IMP_NONEMPTY; IMAGE_EQ_EMPTY; AFFINE_TRANSLATION; SUBSPACE_IMP_AFFINE] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[TRANSLATION_GALOIS] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ; IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let AFFINE_TRANSLATION_UNIQUE_SUBSPACE = prove (`!t:real^N->bool. affine t /\ ~(t = {}) <=> ?!s. ?a. subspace s /\ t = IMAGE (\x. a + x) s`, GEN_TAC THEN REWRITE_TAC[AFFINE_TRANSLATION_SUBSPACE] THEN MATCH_MP_TAC(MESON[] `(!a a' s s'. P s a /\ P s' a' ==> s = s') ==> ((?a s. P s a) <=> (?!s. ?a. P s a))`) THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TRANSLATION_GALOIS] THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_ASSOC] THEN MATCH_MP_TAC SUBSPACE_TRANSLATION_SELF THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `--a' + a:real^N = --(a' - a)`] THEN MATCH_MP_TAC SUBSPACE_NEG THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `t = IMAGE (\x:real^N. a' + x) s'` THEN DISCH_THEN(MP_TAC o AP_TERM `\s. (a':real^N) IN s`) THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `a:real^N = a + x <=> x = vec 0`] THEN ASM_SIMP_TAC[UNWIND_THM2; SUBSPACE_0] THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `a':real^N = a + x <=> x = a' - a`] THEN REWRITE_TAC[UNWIND_THM2]);; let AFFINE_TRANSLATION_SUBSPACE_EXPLICIT = prove (`!t:real^N->bool a. affine t /\ a IN t ==> subspace {x - a | x IN t} /\ t = IMAGE (\x. a + x) {x - a | x IN t}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFFINE_DIFFS_SUBSPACE] THEN ASM_REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN REWRITE_TAC[o_DEF; VECTOR_SUB_ADD2; IMAGE_ID]);; (* ------------------------------------------------------------------------- *) (* If we take a slice out of a set, we can do it perpendicularly, *) (* with the normal vector to the slice parallel to the affine hull. *) (* ------------------------------------------------------------------------- *) let AFFINE_PARALLEL_SLICE = prove (`!s a:real^N b. affine s ==> s INTER {x | a dot x <= b} = {} \/ s SUBSET {x | a dot x <= b} \/ ?a' b'. ~(a' = vec 0) /\ s INTER {x | a' dot x <= b'} = s INTER {x | a dot x <= b} /\ s INTER {x | a' dot x = b'} = s INTER {x | a dot x = b} /\ !w. w IN s ==> (w + a') IN s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s INTER {x:real^N | a dot x = b} = {}` THENL [MATCH_MP_TAC(TAUT `~(~p /\ ~q) ==> p \/ q \/ r`) THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?u v:real^N. u IN s /\ v IN s /\ a dot u <= b /\ ~(a dot v <= b)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(a:real^N) dot u < b` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[NOT_IN_EMPTY; IN_INTER; NOT_FORALL_THM; IN_ELIM_THM] THEN EXISTS_TAC `u + (b - a dot u) / (a dot v - a dot u) % (v - u):real^N` THEN ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF] THEN REWRITE_TAC[DOT_RADD; DOT_RMUL; DOT_RSUB] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN POP_ASSUM MP_TAC THEN GEN_GEOM_ORIGIN_TAC `z:real^N` ["a"; "a'"; "b'"; "w"] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_ADD_RID; FORALL_IN_IMAGE] THEN REWRITE_TAC[DOT_RADD; REAL_ARITH `a + x <= a <=> x <= &0`] THEN SUBGOAL_THEN `subspace(s:real^N->bool) /\ span s = s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_IMP_SUBSPACE; SPAN_EQ_SELF]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; orthogonal] THEN MAP_EVERY X_GEN_TAC [`a':real^N`; `a'':real^N`] THEN ASM_CASES_TAC `a':real^N = vec 0` THENL [ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN ASM_CASES_TAC `a'':real^N = a` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL]; ALL_TAC] THEN STRIP_TAC THEN REPEAT DISJ2_TAC THEN EXISTS_TAC `a':real^N` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(a':real^N) dot z` THEN REPEAT(CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> (p x <=> q x)) ==> s INTER {x | p x} = s INTER {x | q x}`) THEN ASM_SIMP_TAC[DOT_LADD] THEN REAL_ARITH_TAC; ALL_TAC]) THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x + a':real^N` THEN ASM_SIMP_TAC[SUBSPACE_ADD; VECTOR_ADD_ASSOC]]);; (* ------------------------------------------------------------------------- *) (* Affine dimension. *) (* ------------------------------------------------------------------------- *) let MAXIMAL_AFFINE_INDEPENDENT_SUBSET = prove (`!s b:real^N->bool. b SUBSET s /\ ~(affine_dependent b) /\ (!b'. b SUBSET b' /\ b' SUBSET s /\ ~(affine_dependent b') ==> b' = b) ==> s SUBSET (affine hull b)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `(!a. a IN t /\ ~(a IN s) ==> F) ==> t SUBSET s`) THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N) INSERT b`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] HULL_INC)) THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_INSERT; INSERT_SUBSET] THEN ASM SET_TAC[]);; let MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE = prove (`!s b:real^N->bool. affine s /\ b SUBSET s /\ ~(affine_dependent b) /\ (!b'. b SUBSET b' /\ b' SUBSET s /\ ~(affine_dependent b') ==> b' = b) ==> affine hull b = s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ASM_MESON_TAC[HULL_MONO; HULL_P]; ASM_MESON_TAC[MAXIMAL_AFFINE_INDEPENDENT_SUBSET]]);; let EXTEND_TO_AFFINE_BASIS = prove (`!s u:real^N->bool. ~(affine_dependent s) /\ s SUBSET u ==> ?t. ~(affine_dependent t) /\ s SUBSET t /\ t SUBSET u /\ affine hull t = affine hull u`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\n. ?t:real^N->bool. ~(affine_dependent t) /\ s SUBSET t /\ t SUBSET u /\ CARD t = n` num_MAX) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_REFL; AFFINE_INDEPENDENT_CARD_LE]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ASM_MESON_TAC[HULL_MONO; HULL_P]; ALL_TAC] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC MAXIMAL_AFFINE_INDEPENDENT_SUBSET THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(c:real^N->bool)`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBSET_LE THEN ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);; let AFFINE_BASIS_EXISTS = prove (`!s:real^N->bool. ?b. ~(affine_dependent b) /\ b SUBSET s /\ affine hull b = affine hull s`, GEN_TAC THEN MP_TAC(ISPECL [`{}:real^N->bool`; `s:real^N->bool`] EXTEND_TO_AFFINE_BASIS) THEN REWRITE_TAC[AFFINE_INDEPENDENT_EMPTY; EMPTY_SUBSET]);; let aff_dim = new_definition `aff_dim s = @d:int. ?b. affine hull b = affine hull s /\ ~(affine_dependent b) /\ &(CARD b) = d + &1`;; let AFF_DIM = prove (`!s. ?b. affine hull b = affine hull s /\ ~(affine_dependent b) /\ aff_dim s = &(CARD b) - &1`, GEN_TAC THEN REWRITE_TAC[aff_dim; INT_ARITH `y:int = x + &1 <=> x = y - &1`] THEN CONV_TAC SELECT_CONV THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN MESON_TAC[AFFINE_BASIS_EXISTS]);; let AFF_DIM_EMPTY = prove (`aff_dim {} = -- &1`, REWRITE_TAC[aff_dim; AFFINE_HULL_EMPTY; AFFINE_HULL_EQ_EMPTY] THEN REWRITE_TAC[UNWIND_THM2; AFFINE_INDEPENDENT_EMPTY; CARD_CLAUSES] THEN REWRITE_TAC[INT_ARITH `&0 = d + &1 <=> d:int = -- &1`; SELECT_REFL]);; let AFF_DIM_AFFINE_HULL = prove (`!s. aff_dim(affine hull s) = aff_dim s`, REWRITE_TAC[aff_dim; HULL_HULL]);; let AFF_DIM_TRANSLATION_EQ = prove (`!a:real^N s. aff_dim (IMAGE (\x. a + x) s) = aff_dim s`, REWRITE_TAC[aff_dim] THEN GEOM_TRANSLATE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; CARD_IMAGE_INJ; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);; add_translation_invariants [AFF_DIM_TRANSLATION_EQ];; let AFFINE_HULL_CONIC_HULL = prove (`!s:real^N->bool. affine hull (conic hull s) = if s = {} then {} else affine hull (vec 0 INSERT s)`, GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; AFFINE_HULL_EMPTY] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; CONIC_HULL_CONTAINS_0; HULL_INC; SPAN_INSERT_0; SPAN_CONIC_HULL]);; let AFFINE_INDEPENDENT_CARD_DIM_DIFFS = prove (`!s a:real^N. ~affine_dependent s /\ a IN s ==> CARD s = dim {x - a | x IN s} + 1`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN MATCH_MP_TAC(ARITH_RULE `~(s = 0) /\ v = s - 1 ==> s = v + 1`) THEN ASM_SIMP_TAC[CARD_EQ_0] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{b - a:real^N |b| b IN (s DELETE a)}` THEN REPEAT CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[SIMPLE_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^N = a` THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL; SPAN_0]; MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]; UNDISCH_TAC `~affine_dependent(s:real^N->bool)` THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN ASM_REWRITE_TAC[IN_DELETE]; REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN SIMP_TAC[VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; CARD_DELETE]]);; let AFF_DIM_DIM_0 = prove (`!s:real^N->bool. vec 0 IN affine hull s ==> aff_dim s = &(dim s)`, let lemma = prove (`!a:real^N s. affine s /\ a IN s ==> aff_dim s = &(dim {x - a | x IN s})`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN ASM_CASES_TAC `b:real^N->bool = {}` THENL [ASM_MESON_TAC[AFFINE_HULL_EQ_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[INT_EQ_SUB_RADD; INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `dim {x - c:real^N | x IN b} + 1` THEN CONJ_TAC THENL [MATCH_MP_TAC AFFINE_INDEPENDENT_CARD_DIM_DIFFS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `dim {x - c:real^N | x IN affine hull b} + 1` THEN CONJ_TAC THENL [ASM_SIMP_TAC[DIFFS_AFFINE_HULL_SPAN; DIM_SPAN]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `affine hull s:real^N->bool = s` SUBST1_TAC THENL [ASM_MESON_TAC[AFFINE_HULL_EQ]; ALL_TAC] THEN SUBGOAL_THEN `(c:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_HULL_EQ; HULL_INC]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[VECTOR_ARITH `x - c:real^N = y - a <=> y = x + &1 % (a - c)`] THEN ASM_MESON_TAC[IN_AFFINE_ADD_MUL_DIFF]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`vec 0:real^N`; `affine hull s:real^N->bool`] lemma) THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; VECTOR_SUB_RZERO] THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL; SET_RULE `{x | x IN s} = s`] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; DIM_SPAN]);; let AFF_DIM_DIM_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> aff_dim s = &(dim s)`, MESON_TAC[AFF_DIM_DIM_0; SUBSPACE_0; HULL_INC]);; let AFF_DIM_DIM_AFFINE_DIFFS_STRONG = prove (`!a:real^N s. a IN affine hull s ==> aff_dim s = &(dim {x - a | x IN s})`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[VECTOR_SUB_RZERO; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[AFF_DIM_DIM_0]);; let AFF_DIM_DIM_AFFINE_DIFFS = prove (`!a:real^N s. a IN s ==> aff_dim s = &(dim {x - a | x IN s})`, SIMP_TAC[AFF_DIM_DIM_AFFINE_DIFFS_STRONG; HULL_INC]);; let AFF_DIM_LINEAR_IMAGE_LE = prove (`!f:real^M->real^N s. linear f ==> aff_dim(IMAGE f s) <= aff_dim s`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN MP_TAC(ISPEC `s:real^M->bool` AFFINE_AFFINE_HULL) THEN SPEC_TAC(`affine hull s:real^M->bool`,`s:real^M->bool`) THEN GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; AFF_DIM_EMPTY; INT_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN SUBGOAL_THEN `dim {x - f(a) |x| x IN IMAGE (f:real^M->real^N) s} <= dim {x - a | x IN s}` MP_TAC THENL [REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f (g x) | x IN s}`] THEN ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN BINOP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC AFF_DIM_DIM_AFFINE_DIFFS THEN ASM_SIMP_TAC[AFFINE_LINEAR_IMAGE; FUN_IN_IMAGE]]);; let AFF_DIM_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_dim(IMAGE f s) = aff_dim s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_LINEAR_IMAGE_LE]; ALL_TAC] THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim(IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; INT_LE_REFL]; MATCH_MP_TAC AFF_DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]]);; add_linear_invariants [AFF_DIM_INJECTIVE_LINEAR_IMAGE];; let AFF_DIM_AFFINE_INDEPENDENT = prove (`!b:real^N->bool. ~(affine_dependent b) ==> aff_dim b = &(CARD b) - &1`, GEN_TAC THEN ASM_CASES_TAC `b:real^N->bool = {}` THENL [ASM_REWRITE_TAC[CARD_CLAUSES; AFF_DIM_EMPTY] THEN INT_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`b:real^N->bool`; `a:real^N`] AFFINE_INDEPENDENT_CARD_DIM_DIFFS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH `(a + b) - b:int = a`] THEN MP_TAC(ISPECL [`a:real^N`; `affine hull b:real^N->bool`] AFF_DIM_DIM_AFFINE_DIFFS) THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC; AFF_DIM_AFFINE_HULL] THEN DISCH_THEN(K ALL_TAC) THEN AP_TERM_TAC THEN ASM_MESON_TAC[DIFFS_AFFINE_HULL_SPAN; DIM_SPAN]);; let AFF_DIM_UNIQUE = prove (`!s b:real^N->bool. affine hull b = affine hull s /\ ~(affine_dependent b) ==> aff_dim s = &(CARD b) - &1`, MESON_TAC[AFF_DIM_AFFINE_HULL; AFF_DIM_AFFINE_INDEPENDENT]);; let AFF_DIM_SING = prove (`!a:real^N. aff_dim {a} = &0`, GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&(CARD {a:real^N}) - &1:int` THEN CONJ_TAC THENL [MATCH_MP_TAC AFF_DIM_AFFINE_INDEPENDENT THEN REWRITE_TAC[AFFINE_INDEPENDENT_1]; SIMP_TAC[CARD_CLAUSES; FINITE_RULES; ARITH; NOT_IN_EMPTY; INT_SUB_REFL]]);; let AFF_DIM_LE_CARD = prove (`!s:real^N->bool. FINITE s ==> aff_dim s <= &(CARD s) - &1`, MATCH_MP_TAC SET_PROVE_CASES THEN SIMP_TAC[AFF_DIM_EMPTY; CARD_CLAUSES] THEN CONV_TAC INT_REDUCE_CONV THEN GEOM_ORIGIN_TAC `a:real^N` THEN SIMP_TAC[AFF_DIM_DIM_0; IN_INSERT; HULL_INC] THEN SIMP_TAC[CARD_IMAGE_INJ; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN SIMP_TAC[DIM_INSERT_0; INT_LE_SUB_LADD; CARD_CLAUSES; FINITE_INSERT] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE; ADD1; LE_ADD_RCANCEL] THEN SIMP_TAC[DIM_LE_CARD]);; let AFF_DIM_GE = prove (`!s:real^N->bool. -- &1 <= aff_dim s`, GEN_TAC THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM) THEN STRIP_TAC THEN ASM_REWRITE_TAC[INT_LE_SUB_LADD; INT_ADD_LINV; INT_POS]);; let AFF_DIM_SUBSET = prove (`!s t:real^N->bool. s SUBSET t ==> aff_dim s <= aff_dim t`, MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EMPTY] THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN t` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; IN_INSERT; HULL_INC; INT_OF_NUM_LE; DIM_SUBSET]);; let AFF_DIM_LE_DIM = prove (`!s:real^N->bool. aff_dim s <= &(dim s)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[SPAN_INC]);; let AFF_DIM_CONVEX_HULL = prove (`!s:real^N->bool. aff_dim(convex hull s) = aff_dim s`, GEN_TAC THEN MATCH_MP_TAC(INT_ARITH `!c:int. c = a /\ a <= b /\ b <= c ==> b = a`) THEN EXISTS_TAC `aff_dim(affine hull s:real^N->bool)` THEN SIMP_TAC[AFF_DIM_AFFINE_HULL; AFF_DIM_SUBSET; HULL_SUBSET; CONVEX_HULL_SUBSET_AFFINE_HULL]);; let AFF_DIM_CLOSURE = prove (`!s:real^N->bool. aff_dim(closure s) = aff_dim s`, GEN_TAC THEN MATCH_MP_TAC(INT_ARITH `!h. h = s /\ s <= c /\ c <= h ==> c:int = s`) THEN EXISTS_TAC `aff_dim(affine hull s:real^N->bool)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[AFF_DIM_AFFINE_HULL]; MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET]; MATCH_MP_TAC AFF_DIM_SUBSET THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_AFFINE_HULL; HULL_SUBSET]]);; let AFF_DIM_2 = prove (`!a b:real^N. aff_dim {a,b} = if a = b then &0 else &1`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[INSERT_AC; AFF_DIM_SING]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&(CARD {a:real^N,b}) - &1:int` THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; AFFINE_INDEPENDENT_2] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; let AFF_DIM_EQ_MINUS1 = prove (`!s:real^N->bool. aff_dim s = -- &1 <=> s = {}`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[AFF_DIM_EMPTY] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(INT_ARITH `&0:int <= n ==> ~(n = -- &1)`) THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim {a:real^N}` THEN ASM_SIMP_TAC[AFF_DIM_SUBSET; SING_SUBSET] THEN REWRITE_TAC[AFF_DIM_SING; INT_LE_REFL]);; let AFF_DIM_POS_LE = prove (`!s:real^N->bool. &0 <= aff_dim s <=> ~(s = {})`, GEN_TAC THEN REWRITE_TAC[GSYM AFF_DIM_EQ_MINUS1] THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_GE) THEN INT_ARITH_TAC);; let AFF_DIM_EQ_0 = prove (`!s:real^N->bool. aff_dim s = &0 <=> ?a. s = {a}`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[AFF_DIM_SING; LEFT_IMP_EXISTS_THM] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC(SET_RULE `(!b. ~(b = a) /\ {a,b} SUBSET s ==> F) ==> a IN s ==> s = {a}`) THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_SUBSET) THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] AFF_DIM_2) THEN ASM_SIMP_TAC[] THEN INT_ARITH_TAC);; let CONNECTED_IMP_PERFECT_AFF_DIM = prove (`!s x:real^N. connected s /\ ~(aff_dim s = &0) /\ x IN s ==> x limit_point_of s`, REWRITE_TAC[AFF_DIM_EQ_0; CONNECTED_IMP_PERFECT]);; let AFF_DIM_UNIV = prove (`aff_dim(:real^N) = &(dimindex(:N))`, SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_UNIV; DIM_UNIV]);; let AFF_DIM_EQ_AFFINE_HULL = prove (`!s t:real^N->bool. s SUBSET t /\ aff_dim t <= aff_dim s ==> affine hull s = affine hull t`, MATCH_MP_TAC SET_PROVE_CASES THEN SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; AFF_DIM_GE; INT_ARITH `a:int <= x ==> (x <= a <=> x = a)`] THEN X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN SIMP_TAC[INSERT_SUBSET; IMP_CONJ; AFF_DIM_DIM_0; IN_INSERT; DIM_EQ_SPAN; HULL_INC; AFFINE_HULL_EQ_SPAN; INT_OF_NUM_LE]);; let AFF_DIM_SUMS_INTER = prove (`!s t:real^N->bool. affine s /\ affine t /\ ~(s INTER t = {}) ==> aff_dim {x + y | x IN s /\ y IN t} = (aff_dim s + aff_dim t) - aff_dim(s INTER t)`, REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[VECTOR_ARITH `(a + x) + (a + y):real^N = &2 % a + (x + y)`] THEN ONCE_REWRITE_TAC[SET_RULE `{a + x + y:real^N | x IN s /\ y IN t} = IMAGE (\x. a + x) {x + y | x IN s /\ y IN t}`] THEN REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; IN_INTER] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN {x + y | x IN s /\ y IN t}` ASSUME_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN REPEAT(EXISTS_TAC `vec 0:real^N`) THEN ASM_REWRITE_TAC[VECTOR_ADD_LID]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; IN_INTER] THEN REWRITE_TAC[INT_EQ_SUB_LADD; INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN MATCH_MP_TAC DIM_SUMS_INTER THEN ASM_SIMP_TAC[AFFINE_IMP_SUBSPACE]);; let AFF_DIM_PSUBSET = prove (`!s t. (affine hull s) PSUBSET (affine hull t) ==> aff_dim s < aff_dim t`, ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[PSUBSET; AFF_DIM_SUBSET; INT_LT_LE] THEN MESON_TAC[INT_EQ_IMP_LE; AFF_DIM_EQ_AFFINE_HULL; HULL_HULL]);; let AFF_DIM_EQ_FULL_GEN = prove (`!s t:real^N->bool. s SUBSET t ==> (aff_dim s = aff_dim t <=> affine hull s = affine hull t)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[AFF_DIM_AFFINE_HULL]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN ASM_REWRITE_TAC[INT_LE_REFL]);; let AFF_DIM_EQ_FULL = prove (`!s. aff_dim s = &(dimindex(:N)) <=> affine hull s = (:real^N)`, SIMP_TAC[GSYM AFF_DIM_UNIV; SUBSET_UNIV; AFF_DIM_EQ_FULL_GEN] THEN REWRITE_TAC[AFFINE_HULL_UNIV]);; let AFF_DIM_LE_UNIV = prove (`!s:real^N->bool. aff_dim s <= &(dimindex(:N))`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_UNIV] THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; let AFFINE_INDEPENDENT_IFF_CARD = prove (`!s:real^N->bool. ~affine_dependent s <=> FINITE s /\ aff_dim s = &(CARD s) - &1`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; AFFINE_INDEPENDENT_IMP_FINITE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC (ISPEC `s:real^N->bool` AFFINE_BASIS_EXISTS) THEN MATCH_MP_TAC(ARITH_RULE `!b:int. a <= b - &1 /\ b < s ==> ~(a = s - &1)`) THEN EXISTS_TAC `&(CARD(b:real^N->bool)):int` THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_LE_CARD; FINITE_SUBSET; AFF_DIM_AFFINE_HULL]; REWRITE_TAC[INT_OF_NUM_LT] THEN MATCH_MP_TAC CARD_PSUBSET THEN ASM_REWRITE_TAC[PSUBSET] THEN ASM_MESON_TAC[]]);; let AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR = prove (`!s t:real^N->bool. convex s /\ ~(s INTER interior t = {}) ==> affine hull (s INTER t) = affine hull s`, REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`; `a:real^N`] THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN SIMP_TAC[SUBSET_HULL; AFFINE_AFFINE_HULL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SIMP_RULE[SUBSET] INTERIOR_SUBSET)) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INTER] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_CBALL_0] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_INTER] THEN DISCH_TAC THEN ABBREV_TAC `k = min (&1 / &2) (e / norm(x:real^N))` THEN SUBGOAL_THEN `&0 < k /\ k < &1` STRIP_ASSUME_TAC THENL [EXPAND_TAC "k" THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; NORM_POS_LT; REAL_MIN_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `x:real^N = inv k % k % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; REAL_LT_IMP_NZ]; ALL_TAC] THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[VECTOR_ARITH `k % x:real^N = (&1 - k) % vec 0 + k % x`] THEN MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "k" THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN ASM_REAL_ARITH_TAC]);; let AFFINE_HULL_CONVEX_INTER_OPEN = prove (`!s t:real^N->bool. convex s /\ open t /\ ~(s INTER t = {}) ==> affine hull (s INTER t) = affine hull s`, ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; INTERIOR_OPEN]);; let AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR = prove (`!s t:real^N->bool. affine s /\ ~(s INTER interior t = {}) ==> affine hull (s INTER t) = s`, SIMP_TAC[AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; AFFINE_IMP_CONVEX; HULL_P]);; let AFFINE_HULL_AFFINE_INTER_OPEN = prove (`!s t:real^N->bool. affine s /\ open t /\ ~(s INTER t = {}) ==> affine hull (s INTER t) = s`, SIMP_TAC[AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR; INTERIOR_OPEN]);; let CONVEX_AND_AFFINE_INTER_OPEN = prove (`!s t u:real^N->bool. convex s /\ affine t /\ open u /\ s INTER u = t INTER u /\ ~(s INTER u = {}) ==> affine hull s = t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `!u v. x = u /\ u = v /\ v = y ==> x = y`) THEN MAP_EVERY EXISTS_TAC [`affine hull (s INTER u:real^N->bool)`; `affine hull t:real^N->bool`] THEN REPEAT CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX] THEN ASM SET_TAC[]; ASM_REWRITE_TAC[AFFINE_HULL_EQ]]);; let AFFINE_HULL_CONVEX_INTER_OPEN_IN = prove (`!s t:real^N->bool. convex s /\ open_in (subtopology euclidean (affine hull s)) t /\ ~(s INTER t = {}) ==> affine hull (s INTER t) = affine hull s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t INTER u = s INTER u`; HULL_SUBSET] THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN ASM SET_TAC[]);; let AFFINE_HULL_AFFINE_INTER_OPEN_IN = prove (`!s t:real^N->bool. affine s /\ open_in (subtopology euclidean s) t /\ ~(s INTER t = {}) ==> affine hull (s INTER t) = s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`affine hull s:real^N->bool`; `t:real^N->bool`] AFFINE_HULL_CONVEX_INTER_OPEN_IN) THEN ASM_SIMP_TAC[HULL_HULL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; HULL_P]);; let AFFINE_HULL_OPEN_IN_CONVEX = prove (`!s t:real^N->bool. convex s /\ open_in (subtopology euclidean s) t /\ ~(t = {}) ==> affine hull t = affine hull s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN ASM SET_TAC[]);; let AFFINE_HULL_OPEN_IN = prove (`!s t:real^N->bool. open_in (subtopology euclidean (affine hull t)) s /\ ~(s = {}) ==> affine hull s = affine hull t`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM HULL_HULL] THEN MATCH_MP_TAC AFFINE_HULL_OPEN_IN_CONVEX THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);; let AFFINE_HULL_OPEN_IN_AFFINE = prove (`!u s:real^N->bool. affine u /\ open_in (subtopology euclidean u) s /\ ~(s = {}) ==> affine hull s = u`, MESON_TAC[AFFINE_HULL_OPEN_IN; AFFINE_HULL_EQ]);; let AFFINE_HULL_OPEN = prove (`!s. open s /\ ~(s = {}) ==> affine hull s = (:real^N)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBST1_TAC(SET_RULE `s = (:real^N) INTER s`) THEN ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_OPEN; CONVEX_UNIV] THEN REWRITE_TAC[AFFINE_HULL_UNIV]);; let AFFINE_HULL_NONEMPTY_INTERIOR = prove (`!s. ~(interior s = {}) ==> affine hull s = (:real^N)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN EXISTS_TAC `affine hull (interior s:real^N->bool)` THEN SIMP_TAC[HULL_MONO; INTERIOR_SUBSET] THEN ASM_SIMP_TAC[AFFINE_HULL_OPEN; OPEN_INTERIOR]);; let AFF_DIM_OPEN = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> aff_dim s = &(dimindex(:N))`, SIMP_TAC[AFF_DIM_EQ_FULL; AFFINE_HULL_OPEN]);; let AFF_DIM_NONEMPTY_INTERIOR = prove (`!s:real^N->bool. ~(interior s = {}) ==> aff_dim s = &(dimindex(:N))`, SIMP_TAC[AFF_DIM_EQ_FULL; AFFINE_HULL_NONEMPTY_INTERIOR]);; let EMPTY_INTERIOR_AFF_DIM = prove (`!s:real^N->bool. aff_dim s < &(dimindex(:N)) ==> interior s = {}`, MESON_TAC[AFF_DIM_NONEMPTY_INTERIOR; INT_LT_ANTISYM]);; let SPAN_OPEN = prove (`!s. open s /\ ~(s = {}) ==> span s = (:real^N)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN EXISTS_TAC `affine hull s:real^N->bool` THEN ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFFINE_HULL_SUBSET_SPAN]);; let DIM_OPEN = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> dim s = dimindex(:N)`, SIMP_TAC[DIM_EQ_FULL; SPAN_OPEN]);; let AFF_DIM_INSERT = prove (`!a:real^N s. aff_dim (a INSERT s) = if a IN affine hull s then aff_dim s else aff_dim s + &1`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC SET_PROVE_CASES THEN SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_SING; AFFINE_HULL_EMPTY; NOT_IN_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `s:real^N->bool`; `a:real^N`] THEN GEOM_ORIGIN_TAC `b:real^N` THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; AFF_DIM_DIM_0; HULL_INC; IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`] THEN DISCH_THEN(K ALL_TAC) THEN SPEC_TAC(`(vec 0:real^N) INSERT s`,`s:real^N->bool`) THEN SIMP_TAC[DIM_INSERT; INT_OF_NUM_ADD] THEN MESON_TAC[]);; let AFF_DIM_DIM = prove (`!s:real^N->bool. aff_dim s = if vec 0 IN affine hull s then &(dim s) else &(dim s) - &1`, GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[AFF_DIM_DIM_0] THEN MP_TAC(ISPECL [`vec 0:real^N`; `s:real^N->bool`] AFF_DIM_INSERT) THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; IN_INSERT; HULL_INC; DIM_INSERT_0] THEN INT_ARITH_TAC);; let AFF_DIM_CONIC_HULL_DIM = prove (`!s:real^N->bool. aff_dim (conic hull s) = if s = {} then -- &1 else &(dim s)`, GEN_TAC THEN REWRITE_TAC[AFF_DIM_DIM; AFFINE_HULL_CONIC_HULL] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; SPAN_INSERT_0; HULL_INC; IN_INSERT; SPAN_0; DIM_CONIC_HULL; NOT_IN_EMPTY; DIM_EMPTY; INT_SUB_LZERO]);; let AFFINE_BOUNDED_EQ_TRIVIAL = prove (`!s:real^N->bool. affine s ==> (bounded s <=> s = {} \/ ?a. s = {a})`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN GEOM_ORIGIN_TAC `b:real^N` THEN SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SUBSPACE_BOUNDED_EQ_TRIVIAL] THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUBSPACE_0) THEN SET_TAC[]);; let AFFINE_BOUNDED_EQ_LOWDIM = prove (`!s:real^N->bool. affine s ==> (bounded s <=> aff_dim s <= &0)`, SIMP_TAC[AFF_DIM_GE; INT_ARITH `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN SIMP_TAC[AFF_DIM_EQ_0; AFF_DIM_EQ_MINUS1; AFFINE_BOUNDED_EQ_TRIVIAL]);; let COLLINEAR_AFF_DIM = prove (`!s:real^N->bool. collinear s <=> aff_dim s <= &1`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[COLLINEAR_AFFINE_HULL; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim{u:real^N,v}` THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_SUBSET; AFF_DIM_AFFINE_HULL]; MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&(CARD{u:real^N,v}) - &1:int` THEN SIMP_TAC[AFF_DIM_LE_CARD; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[INT_ARITH `x - &1:int <= &1 <=> x <= &2`; INT_OF_NUM_LE] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC]; ONCE_REWRITE_TAC[GSYM COLLINEAR_AFFINE_HULL_COLLINEAR; GSYM AFF_DIM_AFFINE_HULL] THEN MP_TAC(ISPEC `s:real^N->bool` AFFINE_BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFFINE_INDEPENDENT_IFF_CARD]) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; AFF_DIM_AFFINE_HULL] THEN REWRITE_TAC[INT_ARITH `x - &1:int <= &1 <=> x <= &2`; INT_OF_NUM_LE] THEN ASM_SIMP_TAC[COLLINEAR_SMALL]]);; let COPLANAR_AFF_DIM = prove (`!s:real^N->bool. coplanar s <=> aff_dim s <= &2`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[coplanar; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `c:real^N`] THEN DISCH_TAC THEN TRANS_TAC INT_LE_TRANS `aff_dim(affine hull {a:real^N,b,c})` THEN ASM_SIMP_TAC[AFF_DIM_SUBSET] THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL; AFF_DIM_INSERT] THEN REWRITE_TAC[AFFINE_HULL_EMPTY; NOT_IN_EMPTY; AFF_DIM_EMPTY] THEN INT_ARITH_TAC; DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM COPLANAR_AFFINE_HULL_COPLANAR] THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) SUBST_ALL_TAC) THEN REWRITE_TAC[COPLANAR_AFFINE_HULL_COPLANAR] THEN MATCH_MP_TAC COPLANAR_SMALL THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN ASM_INT_ARITH_TAC]);; let HOMEOMORPHIC_AFFINE_SETS = prove (`!s:real^M->bool t:real^N->bool. affine s /\ affine t /\ aff_dim s = aff_dim t ==> s homeomorphic t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN SIMP_TAC[AFFINE_EQ_SUBSPACE; AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_EQ] THEN MESON_TAC[HOMEOMORPHIC_SUBSPACES]);; let AFF_DIM_OPEN_IN = prove (`!s t:real^N->bool. ~(s = {}) /\ open_in (subtopology euclidean t) s /\ affine t ==> aff_dim s = aff_dim t`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `(vec 0:real^N) IN t` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; AFFINE_EQ_SUBSPACE] THEN DISCH_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[GSYM LE_ANTISYM; DIM_SUBSET] THEN SUBGOAL_THEN `?e. &0 < e /\ cball(vec 0:real^N,e) INTER t SUBSET s` MP_TAC THENL [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_INTER; IN_CBALL_0] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_BASIS_SUBSPACE) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `IMAGE (\x:real^N. e % x) b`] INDEPENDENT_CARD_LE_DIM) THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[CARD_IMAGE_INJ; VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET]; MESON_TAC[]] THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_MUL] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC SUBSPACE_MUL] THEN ASM SET_TAC[]; MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]]);; let DIM_OPEN_IN = prove (`!s t:real^N->bool. ~(s = {}) /\ open_in (subtopology euclidean t) s /\ subspace t ==> dim s = dim t`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[GSYM LE_ANTISYM; DIM_SUBSET] THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim(s:real^N->bool)` THEN REWRITE_TAC[AFF_DIM_LE_DIM] THEN ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE] THEN MATCH_MP_TAC INT_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC AFF_DIM_OPEN_IN THEN ASM_SIMP_TAC[SUBSPACE_IMP_AFFINE]);; let AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR = prove (`!s t:real^N->bool. convex s /\ ~(s INTER interior t = {}) ==> aff_dim(s INTER t) = aff_dim s`, ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR] THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL]);; let AFF_DIM_CONVEX_INTER_OPEN = prove (`!s t:real^N->bool. convex s /\ open t /\ ~(s INTER t = {}) ==> aff_dim(s INTER t) = aff_dim s`, ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_OPEN] THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL]);; let AFF_DIM_NONEMPTY_INTERIOR_OF = prove (`!u s:real^N->bool. s SUBSET u /\ affine u /\ ~((subtopology euclidean u) interior_of s = {}) ==> aff_dim s = aff_dim u`, SIMP_TAC[GSYM INT_LE_ANTISYM; AFF_DIM_SUBSET] THEN REPEAT STRIP_TAC THEN TRANS_TAC INT_LE_TRANS `aff_dim((subtopology euclidean u) interior_of s:real^N->bool)` THEN SIMP_TAC[AFF_DIM_SUBSET; INTERIOR_OF_SUBSET] THEN MATCH_MP_TAC INT_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC AFF_DIM_OPEN_IN THEN ASM_REWRITE_TAC[OPEN_IN_INTERIOR_OF]);; let EMPTY_INTERIOR_OF_AFF_DIM = prove (`!u s:real^N->bool. affine u /\ aff_dim s < aff_dim u ==> (subtopology euclidean u) interior_of s = {}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INTERIOR_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN MP_TAC(ISPECL [`u:real^N->bool`; `u INTER s:real^N->bool`] AFF_DIM_NONEMPTY_INTERIOR_OF) THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC(TAUT `~q ==> (~p ==> q) ==> p`) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `s:int < u ==> t <= s ==> ~(t = u)`)) THEN SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET]);; let AFFINE_HULL_HALFSPACE_LT = prove (`!a b. affine hull {x | a dot x < b} = if a = vec 0 /\ b <= &0 then {} else (:real^N)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_EMPTY; HALFSPACE_EQ_EMPTY_LT; AFFINE_HULL_OPEN; OPEN_HALFSPACE_LT]);; let AFFINE_HULL_HALFSPACE_LE = prove (`!a b. affine hull {x | a dot x <= b} = if a = vec 0 /\ b < &0 then {} else (:real^N)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[AFFINE_HULL_EMPTY; AFFINE_HULL_UNIV] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[GSYM CLOSURE_HALFSPACE_LT; AFFINE_HULL_CLOSURE] THEN ASM_REWRITE_TAC[AFFINE_HULL_HALFSPACE_LT]]);; let AFFINE_HULL_HALFSPACE_GT = prove (`!a b. affine hull {x | a dot x > b} = if a = vec 0 /\ b >= &0 then {} else (:real^N)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_EMPTY; HALFSPACE_EQ_EMPTY_GT; AFFINE_HULL_OPEN; OPEN_HALFSPACE_GT]);; let AFFINE_HULL_HALFSPACE_GE = prove (`!a b. affine hull {x | a dot x >= b} = if a = vec 0 /\ b > &0 then {} else (:real^N)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `--b:real`] AFFINE_HULL_HALFSPACE_LE) THEN SIMP_TAC[real_ge; DOT_LNEG; REAL_LE_NEG2; VECTOR_NEG_EQ_0] THEN REWRITE_TAC[REAL_ARITH `--b < &0 <=> b > &0`]);; let AFF_DIM_HALFSPACE_LT = prove (`!a:real^N b. aff_dim {x | a dot x < b} = if a = vec 0 /\ b <= &0 then --(&1) else &(dimindex(:N))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[AFFINE_HULL_HALFSPACE_LT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; let AFF_DIM_HALFSPACE_LE = prove (`!a:real^N b. aff_dim {x | a dot x <= b} = if a = vec 0 /\ b < &0 then --(&1) else &(dimindex(:N))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[AFFINE_HULL_HALFSPACE_LE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; let AFF_DIM_HALFSPACE_GT = prove (`!a:real^N b. aff_dim {x | a dot x > b} = if a = vec 0 /\ b >= &0 then --(&1) else &(dimindex(:N))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[AFFINE_HULL_HALFSPACE_GT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; let AFF_DIM_HALFSPACE_GE = prove (`!a:real^N b. aff_dim {x | a dot x >= b} = if a = vec 0 /\ b > &0 then --(&1) else &(dimindex(:N))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[AFFINE_HULL_HALFSPACE_GE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; let CHOOSE_AFFINE_SUBSET = prove (`!s:real^N->bool d. affine s /\ --(&1) <= d /\ d <= aff_dim s ==> ?t. affine t /\ t SUBSET s /\ aff_dim t = d`, REPEAT GEN_TAC THEN ASM_CASES_TAC `d:int = --(&1)` THENL [STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[EMPTY_SUBSET; AFFINE_EMPTY; AFF_DIM_EMPTY]; ASM_SIMP_TAC[INT_ARITH `~(d:int = --(&1)) ==> (--(&1) <= d <=> &0 <= d)`] THEN POP_ASSUM(K ALL_TAC)] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN INT_ARITH_TAC; POP_ASSUM MP_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN SIMP_TAC[IMP_CONJ; AFF_DIM_DIM_SUBSPACE; AFFINE_EQ_SUBSPACE] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN REWRITE_TAC[INT_OF_NUM_LE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `n:num`] CHOOSE_SUBSPACE_OF_SUBSPACE) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_IMP_AFFINE]);; let NONEMPTY_AFFINE_EXISTS = prove (`!n a:real^N. &0 <= n /\ n <= &(dimindex(:N)) ==> ?s. affine s /\ a IN s /\ aff_dim s = n`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN X_GEN_TAC `n:int` THEN REWRITE_TAC[IMP_CONJ; GSYM INT_OF_NUM_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN REWRITE_TAC[INT_OF_NUM_LE] THEN STRIP_TAC THEN SUBGOAL_THEN `?s:real^N->bool. subspace s /\ dim s = m` MP_TAC THENL [ASM_SIMP_TAC[SUBSPACE_EXISTS]; MATCH_MP_TAC MONO_EXISTS] THEN SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_IMP_AFFINE; SUBSPACE_0]);; let AFFINE_EXISTS = prove (`!n. -- &1 <= n /\ n <= &(dimindex(:N)) ==> ?s:real^N->bool. affine s /\ aff_dim s = n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0:int <= n` THENL [ASM_MESON_TAC[NONEMPTY_AFFINE_EXISTS]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN REWRITE_TAC[AFFINE_EMPTY; AFF_DIM_EMPTY] THEN ASM_INT_ARITH_TAC);; let AFF_DIM_CONIC_HULL = prove (`!s:real^N->bool. aff_dim(conic hull s) = if s = {} \/ vec 0 IN affine hull s then aff_dim s else aff_dim s + &1`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN REWRITE_TAC[AFFINE_HULL_CONIC_HULL] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL; AFF_DIM_INSERT]);; let AFF_DIM_PCROSS = prove (`!s:real^M->bool t:real^N->bool. ~(s = {}) /\ ~(t = {}) ==> aff_dim(s PCROSS t) = aff_dim s + aff_dim t`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC] THEN ASM_REWRITE_TAC[INT_OF_NUM_ADD] THEN W(MP_TAC o PART_MATCH (rand o rand) DIM_PCROSS_STRONG o rand o rand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN TRANS_TAC EQ_TRANS `aff_dim(IMAGE (\z. pastecart (a:real^M) (b:real^N) + z) (s PCROSS t))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS; EXISTS_PASTECART; PASTECART_ADD; PASTECART_INJ] THEN MESON_TAC[]; REWRITE_TAC[AFF_DIM_TRANSLATION_EQ] THEN MATCH_MP_TAC AFF_DIM_DIM_0 THEN MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS]]);; let AFF_DIM_UNION = prove (`!s t:real^N->bool. affine s /\ affine t /\ ~(s INTER t = {}) ==> aff_dim(s UNION t) = (aff_dim s + aff_dim t) - aff_dim(s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN REWRITE_TAC[IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE; AFF_DIM_DIM_0; HULL_INC; IN_INTER; IN_UNION] THEN REWRITE_TAC[INT_ARITH `a:int = b - c <=> a + c = b`] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ; DIM_UNION_INTER]);; let COPLANAR_INTERSECTING_LINES = prove (`!a b c d z:real^N. collinear {a,z,b} /\ collinear {c,z,d} ==> coplanar {z,a,b,c,d}`, REWRITE_TAC[COPLANAR_AFF_DIM] THEN REPEAT STRIP_TAC THEN TRANS_TAC INT_LE_TRANS `aff_dim(affine hull {a:real^N,z,b} UNION affine hull {c,z,d})` THEN SIMP_TAC[AFF_DIM_SUBSET; INSERT_SUBSET; EMPTY_SUBSET; IN_UNION; HULL_INC; IN_INSERT] THEN W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_UNION o lhand o snd) THEN REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN SUBGOAL_THEN `z IN affine hull {a:real^N,z,b} /\ z IN affine hull {c,z,d}` STRIP_ASSUME_TAC THENL [SIMP_TAC[HULL_INC; IN_INSERT]; ALL_TAC] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(INT_ARITH `a:int <= &1 /\ b <= &1 /\ &0 <= c ==> (a + b) - c <= &2`) THEN ASM_REWRITE_TAC[GSYM COLLINEAR_AFF_DIM; AFF_DIM_POS_LE] THEN ASM SET_TAC[]);; let ISOMETRIC_HOMEOMORPHISM_AFFINE = prove (`!s:real^M->bool t:real^N->bool. affine s /\ affine t /\ aff_dim s = aff_dim t ==> ?f g. homeomorphism (s,t) (f,g) /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) /\ (!x y. x IN t /\ y IN t ==> dist(g x,g y) = dist(x,y))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; NOT_IN_EMPTY] THEN REWRITE_TAC[HOMEOMORPHIC_EMPTY; GSYM homeomorphic]; ALL_TAC] THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_MESON_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1]; STRIP_TAC] THEN MP_TAC(ISPEC `t:real^N->bool` AFFINE_TRANSLATION_SUBSPACE) THEN MP_TAC(ISPEC `s:real^M->bool` AFFINE_TRANSLATION_SUBSPACE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `s':real^M->bool`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `t':real^N->bool`] THEN STRIP_TAC THEN UNDISCH_TAC `aff_dim(s:real^M->bool) = aff_dim(t:real^N->bool)` THEN ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ] THEN ASM_SIMP_TAC[AFF_DIM_DIM_SUBSPACE; INT_OF_NUM_EQ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s':real^M->bool`; `t':real^N->bool`] ISOMETRIES_SUBSPACES) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN EXISTS_TAC `\x. b + (f:real^M->real^N) (--a + x)` THEN EXISTS_TAC `\x. a + (g:real^N->real^M) (--b + x)` THEN REWRITE_TAC[HOMEOMORPHISM; FORALL_IN_IMAGE_2; FORALL_IN_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^N = x`] THEN ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`] THEN ASM_SIMP_TAC[dist; GSYM LINEAR_SUB; SUBSPACE_SUB] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; (* ------------------------------------------------------------------------- *) (* Existence of a rigid transform between congruent sets. *) (* ------------------------------------------------------------------------- *) let RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS = prove (`!x:A->real^N y:A->real^N s. (!i j. i IN s /\ j IN s ==> dist(x i,x j) = dist(y i,y j)) ==> ?a f. orthogonal_transformation f /\ !i. i IN s ==> y i = a + f(x i)`, let lemma = prove (`!x:(real^N)^M y:(real^N)^M. (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:M) ==> dist(x$i,x$j) = dist(y$i,y$j)) ==> ?a f. orthogonal_transformation f /\ !i. 1 <= i /\ i <= dimindex(:M) ==> y$i = a + f(x$i)`, REPEAT STRIP_TAC THEN ABBREV_TAC `(X:real^M^N) = lambda i j. (x:real^N^M)$j$i - x$1$i` THEN ABBREV_TAC `(Y:real^M^N) = lambda i j. (y:real^N^M)$j$i - y$1$i` THEN SUBGOAL_THEN `transp(X:real^M^N) ** X = transp(Y:real^M^N) ** Y` ASSUME_TAC THENL [REWRITE_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN] THEN MAP_EVERY EXPAND_TAC ["X"; "Y"] THEN SIMP_TAC[CART_EQ; column; LAMBDA_BETA; dot] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM dot] THEN REWRITE_TAC[DOT_NORM_SUB; VECTOR_ARITH `(x - a) - (y - a):real^N = x - y`] THEN ASM_SIMP_TAC[GSYM dist; DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?M:real^N^N. orthogonal_matrix M /\ (Y:real^M^N) = M ** (X:real^M^N)` (CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [CART_EQ] THEN MAP_EVERY EXPAND_TAC ["X"; "Y"] THEN SIMP_TAC[LAMBDA_BETA; matrix_mul] THEN REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN STRIP_TAC THEN EXISTS_TAC `(y:real^N^M)$1 - (M:real^N^N) ** (x:real^N^M)$1` THEN EXISTS_TAC `\x:real^N. (M:real^N^N) ** x` THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR] THEN SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[REAL_SUB_LDISTRIB; SUM_SUB_NUMSEG] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH `a + y - b:real = a - z + y <=> z = b`] THEN SIMP_TAC[LAMBDA_BETA]] THEN MP_TAC(ISPEC `transp(X:real^M^N) ** X` SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`P:real^M^M`; `d:num->real`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC th THEN ASM_REWRITE_TAC[] THEN MP_TAC th) THEN REWRITE_TAC[MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [CART_EQ] THEN SIMP_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN; LAMBDA_BETA] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\i. column i ((X:real^M^N) ** (P:real^M^M))`; `\i. column i ((Y:real^M^N) ** (P:real^M^M))`; `1..dimindex(:M)`] ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS) THEN REWRITE_TAC[IN_NUMSEG] THEN ANTS_TAC THENL [ASM_SIMP_TAC[pairwise; IN_NUMSEG; NORM_EQ; orthogonal]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `matrix(f:real^N->real^N)` THEN CONJ_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]; ALL_TAC] THEN SUBGOAL_THEN `!M:real^M^N. M = M ** (P:real^M^M) ** transp P` (fun th -> GEN_REWRITE_TAC BINOP_CONV [th]) THENL [ASM_MESON_TAC[orthogonal_matrix; MATRIX_MUL_RID]; REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_EQUAL_COLUMNS] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthogonal_transformation]) THEN DISCH_THEN(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[CART_EQ; matrix_vector_mul; column; LAMBDA_BETA] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [matrix_mul] THEN ASM_SIMP_TAC[LAMBDA_BETA]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THENL [REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `\x:real^N. x`] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; ORTHOGONAL_TRANSFORMATION_ID]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `m:A`) THEN DISCH_TAC] THEN SUBGOAL_THEN `?r. IMAGE r (1..dimindex(:(N,1)finite_sum)) SUBSET s /\ affine hull (IMAGE (y o r) (1..dimindex(:(N,1)finite_sum))) = affine hull (IMAGE (y:A->real^N) s)` MP_TAC THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[IMAGE_o; TAUT `p /\ q <=> ~(p ==> ~q)`; HULL_MONO; IMAGE_SUBSET] THEN REWRITE_TAC[NOT_IMP] THEN MP_TAC(ISPEC `IMAGE (y:A->real^N) s` AFFINE_BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFFINE_INDEPENDENT_IFF_CARD]) THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `CARD(b:real^N->bool) <= dimindex(:(N,1)finite_sum)` ASSUME_TAC THENL [REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `a:int = c - &1 ==> a + &1 <= n ==> c <= n`)) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN REWRITE_TAC[INT_LE_RADD; AFF_DIM_LE_UNIV]; ALL_TAC] THEN UNDISCH_TAC `b SUBSET IMAGE (y:A->real^N) s` THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\i. if i <= CARD(b:real^N->bool) then r i else (m:A)` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN UNDISCH_THEN `affine hull b:real^N->bool = affine hull IMAGE y (s:A->bool)` (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MONO THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o] THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[LE_TRANS]; REWRITE_TAC[SUBSET; IN_NUMSEG; FORALL_IN_IMAGE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(lambda i. x(r i:A)):real^N^(N,1)finite_sum`; `(lambda i. y(r i:A)):real^N^(N,1)finite_sum`] lemma) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:A` THEN STRIP_TAC THEN SUBGOAL_THEN `!z. z IN affine hull IMAGE (y o (r:num->A)) (1..dimindex(:(N,1)finite_sum)) ==> dist(z,y k) = dist(z,a + (f:real^N->real^N)(x k))` MP_TAC THENL [MATCH_MP_TAC SAME_DISTANCES_TO_AFFINE_HULL THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `dist(x(r(j:num)),(x:A->real^N) k)` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]; REWRITE_TAC[dist] THEN ASM_SIMP_TAC[NORM_ARITH `(a + x) - (a + y):real^N = x - y`] THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION; LINEAR_SUB]]; ASM_SIMP_TAC[NORM_ARITH `a:real^N = b <=> dist(a:real^N,a) = dist(a,b)`] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC HULL_INC THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]]]);; let RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG = prove (`!x:A->real^N y:A->real^N s t. t SUBSET s /\ affine hull (IMAGE y t) = affine hull (IMAGE y s) /\ (!i j. i IN s /\ j IN t ==> dist(x i,x j) = dist(y i,y j)) ==> ?a f. orthogonal_transformation f /\ !i. i IN s ==> y i = a + f(x i)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`x:A->real^N`; `y:A->real^N`; `t:A->bool`] RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN SUBGOAL_THEN `!z. z IN affine hull (IMAGE (y:A->real^N) t) ==> dist(z,y i) = dist(z,a + (f:real^N->real^N)(x i))` MP_TAC THENL [MATCH_MP_TAC SAME_DISTANCES_TO_AFFINE_HULL THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_NUMSEG] THEN X_GEN_TAC `j:A` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `dist(a + f(x(j:A):real^N):real^N,a + f(x i))` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`] THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_ISOMETRY; DIST_SYM]; ASM_SIMP_TAC[NORM_ARITH `a:real^N = b <=> dist(a:real^N,a) = dist(a,b)`] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC HULL_INC THEN REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]]);; let RIGID_TRANSFORMATION_BETWEEN_3 = prove (`!a b c a' b' c':real^N. dist(a,b) = dist(a',b') /\ dist(b,c) = dist(b',c') /\ dist(c,a) = dist(c',a') ==> ?k f. orthogonal_transformation f /\ a' = k + f a /\ b' = k + f b /\ c' = k + f c`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`FST:real^N#real^N->real^N`; `SND:real^N#real^N->real^N`; `{(a:real^N,a':real^N), (b,b'), (c,c')}`] RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN REWRITE_TAC[NOT_IN_EMPTY; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_REFL; DIST_SYM]);; let RIGID_TRANSFORMATION_BETWEEN_2 = prove (`!a b a' b':real^N. dist(a,b) = dist(a',b') ==> ?k f. orthogonal_transformation f /\ a' = k + f a /\ b' = k + f b`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `a:real^N`; `a':real^N`; `b':real^N`; `a':real^N`] RIGID_TRANSFORMATION_BETWEEN_3) THEN ASM_MESON_TAC[DIST_EQ_0; DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Caratheodory's theorem. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_CARATHEODORY_AFF_DIM = prove (`!p. convex hull p = {y:real^N | ?s u. FINITE s /\ s SUBSET p /\ &(CARD s) <= aff_dim p + &1 /\ (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 /\ vsum s (\v. u v % v) = y}`, GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_EXPLICIT] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN MATCH_MP_TAC(TAUT `!q. (p ==> q) /\ (q ==> r) ==> (p ==> r)`) THEN EXISTS_TAC `?n s u. CARD s = n /\ FINITE s /\ s SUBSET p /\ (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 /\ vsum s (\v. u v % v) = (y:real^N)` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC I [GSYM INT_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `~(n = 0) ==> n - 1 < n`) THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `aff_dim(p:real^N->bool) + &1 < &0` THEN REWRITE_TAC[INT_ARITH `p + &1:int < &0 <=> ~(-- &1 <= p)`] THEN REWRITE_TAC[AFF_DIM_GE]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_AFFINE_INDEPENDENT) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(aff_dim(s:real^N->bool) = &n - &1)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_SUBSET) THEN UNDISCH_TAC `aff_dim(p:real^N->bool) + &1 < &n` THEN INT_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?t. (!v:real^N. v IN s ==> u(v) + t * w(v) >= &0) /\ ?a. a IN s /\ u(a) + t * w(a) = &0` STRIP_ASSUME_TAC THENL [ABBREV_TAC `i = IMAGE (\v. u(v) / --w(v)) {v:real^N | v IN s /\ w v < &0}` THEN EXISTS_TAC `inf i` THEN MP_TAC(SPEC `i:real->bool` INF_FINITE) THEN ANTS_TAC THENL [EXPAND_TAC "i" THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MP_TAC(ISPECL [`w:real^N->real`; `s:real^N->bool`] SUM_ZERO_EXISTS) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `t = inf i` THEN EXPAND_TAC "i" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) MP_TAC) THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `x < &0 ==> &0 < --x`; real_ge] THEN REWRITE_TAC[REAL_ARITH `t * --w <= u <=> &0 <= u + t * w`] THEN STRIP_TAC THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISJ_CASES_TAC(REAL_ARITH `(w:real^N->real) x < &0 \/ &0 <= w x`) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_ADD THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `w < &0 ==> &0 <= --w`) THEN ASM_REWRITE_TAC[]; EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `w(a:real^N) < &0` THEN CONV_TAC REAL_FIELD]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`s DELETE (a:real^N)`; `(\v. u(v) + t * w(v)):real^N->real`] THEN ASM_SIMP_TAC[SUM_DELETE; VSUM_DELETE; CARD_DELETE; FINITE_DELETE] THEN ASM_SIMP_TAC[SUM_ADD; VECTOR_ADD_RDISTRIB; VSUM_ADD] THEN ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL; VSUM_LMUL] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM SET_TAC[real_ge]; REAL_ARITH_TAC; VECTOR_ARITH_TAC]);; let CARATHEODORY_AFF_DIM = prove (`!p. convex hull p = {x:real^N | ?s. FINITE s /\ s SUBSET p /\ &(CARD s) <= aff_dim p + &1 /\ x IN convex hull s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONVEX_HULL_CARATHEODORY_AFF_DIM] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[HULL_SUBSET; CONVEX_EXPLICIT; CONVEX_CONVEX_HULL]; MESON_TAC[SUBSET; HULL_MONO]]);; let CONVEX_HULL_CARATHEODORY = prove (`!p. convex hull p = {y:real^N | ?s u. FINITE s /\ s SUBSET p /\ CARD(s) <= dimindex(:N) + 1 /\ (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 /\ vsum s (\v. u v % v) = y}`, GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THENL [REWRITE_TAC[CONVEX_HULL_CARATHEODORY_AFF_DIM; IN_ELIM_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_ADD] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `a:int <= x + &1 ==> x <= y ==> a <= y + &1`)) THEN REWRITE_TAC[AFF_DIM_LE_UNIV]; REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN MESON_TAC[]]);; let CARATHEODORY = prove (`!p. convex hull p = {x:real^N | ?s. FINITE s /\ s SUBSET p /\ CARD(s) <= dimindex(:N) + 1 /\ x IN convex hull s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONVEX_HULL_CARATHEODORY] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[HULL_SUBSET; CONVEX_EXPLICIT; CONVEX_CONVEX_HULL]; MESON_TAC[SUBSET; HULL_MONO]]);; (* ------------------------------------------------------------------------- *) (* Some results on decomposing convex hulls, e.g. simplicial subdivision. *) (* ------------------------------------------------------------------------- *) let AFFINE_HULL_INTER,CONVEX_HULL_INTER = (CONJ_PAIR o prove) (`(!s t:real^N->bool. ~(affine_dependent(s UNION t)) ==> affine hull s INTER affine hull t = affine hull (s INTER t)) /\ (!s t:real^N->bool. ~(affine_dependent (s UNION t)) ==> convex hull s INTER convex hull t = convex hull (s INTER t))`, CONJ_TAC THEN (REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN REWRITE_TAC[FINITE_UNION] THEN STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER] THEN SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN REWRITE_TAC[SUBSET; AFFINE_HULL_FINITE; CONVEX_HULL_FINITE; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_DEPENDENT_EXPLICIT]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `(s UNION t):real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(MP_TAC o SPEC `\x:real^N. (if x IN s then u x else &0) - (if x IN t then v x else &0)`) THEN ASM_SIMP_TAC[SUM_SUB; FINITE_UNION; VSUM_SUB; VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[MESON[] `(if p then a else b) % x = (if p then a % x else b % x)`] THEN ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; VECTOR_MUL_LZERO; FINITE_UNION] THEN ASM_REWRITE_TAC[SUM_0; VSUM_0; SET_RULE `{x | x IN (s UNION t) /\ x IN s} = s`; SET_RULE `{x | x IN (s UNION t) /\ x IN t} = t`] THEN MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC EQ_TRANS THENL [EXISTS_TAC `sum s (u:real^N->real)`; EXISTS_TAC `vsum s (\x. (u:real^N->real) x % x)`] THEN (CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM ACCEPT_TAC]) THEN CONV_TAC SYM_CONV THENL [MATCH_MP_TAC SUM_EQ_SUPERSET; MATCH_MP_TAC VSUM_EQ_SUPERSET] THEN ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN ASM SET_TAC[]));; let AFFINE_HULL_INTERS = prove (`!s:(real^N->bool)->bool. ~(affine_dependent(UNIONS s)) ==> affine hull (INTERS s) = INTERS {affine hull t | t IN s}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MP_TAC(MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE th)) THEN SPEC_TAC(`s:(real^N->bool)->bool`,`s:(real^N->bool)->bool`) THEN REWRITE_TAC[FINITE_UNIONS; IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; INTERS_0; UNIONS_INSERT; INTERS_INSERT; SET_RULE `{f x | x IN {}} = {}`; AFFINE_HULL_UNIV] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[FORALL_IN_INSERT] THEN DISCH_THEN(fun th -> STRIP_TAC THEN STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN SET_TAC[]; DISCH_TAC] THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; IN_SING] THEN REWRITE_TAC[SET_RULE `{f x | x = a} = {f a}`; INTERS_1]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rhs o rand) AFFINE_HULL_INTER o lhand o snd) THEN ANTS_TAC THENL [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN UNDISCH_TAC `~(f:(real^N->bool)->bool = {})` THEN SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[SET_RULE `{f x | x IN (a INSERT s)} = (f a) INSERT {f x | x IN s}`] THEN ASM_REWRITE_TAC[INTERS_INSERT]);; let CONVEX_HULL_INTERS = prove (`!s:(real^N->bool)->bool. ~(affine_dependent(UNIONS s)) ==> convex hull (INTERS s) = INTERS {convex hull t | t IN s}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MP_TAC(MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE th)) THEN SPEC_TAC(`s:(real^N->bool)->bool`,`s:(real^N->bool)->bool`) THEN REWRITE_TAC[FINITE_UNIONS; IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; INTERS_0; UNIONS_INSERT; INTERS_INSERT; SET_RULE `{f x | x IN {}} = {}`; CONVEX_HULL_UNIV] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[FORALL_IN_INSERT] THEN DISCH_THEN(fun th -> STRIP_TAC THEN STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN SET_TAC[]; DISCH_TAC] THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; IN_SING] THEN REWRITE_TAC[SET_RULE `{f x | x = a} = {f a}`; INTERS_1]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rhs o rand) CONVEX_HULL_INTER o lhand o snd) THEN ANTS_TAC THENL [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN UNDISCH_TAC `~(f:(real^N->bool)->bool = {})` THEN SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[SET_RULE `{f x | x IN (a INSERT s)} = (f a) INSERT {f x | x IN s}`] THEN ASM_REWRITE_TAC[INTERS_INSERT]);; let IN_CONVEX_HULL_EXCHANGE = prove (`!s a x:real^N. a IN convex hull s /\ x IN convex hull s ==> ?b. b IN s /\ x IN convex hull (a INSERT (s DELETE b))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [EXISTS_TAC `a:real^N` THEN ASM_SIMP_TAC[INSERT_DELETE]; ALL_TAC] THEN ASM_CASES_TAC `FINITE(s:real^N->bool) /\ CARD s <= dimindex(:N) + 1` THENL [ALL_TAC; UNDISCH_TAC `(x:real^N) IN convex hull s` THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CARATHEODORY] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = s` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?b:real^N. b IN s /\ ~(b IN t)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(x:real^N) IN convex hull t` THEN SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]] THEN MP_TAC(ASSUME `(a:real^N) IN convex hull s`) THEN MP_TAC(ASSUME `(x:real^N) IN convex hull s`) THEN REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->real` THEN STRIP_TAC THEN X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN ASM_CASES_TAC `?b. b IN s /\ (v:real^N->real) b = &0` THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `\x:real^N. if x = a then &0 else v x` THEN ASM_SIMP_TAC[FORALL_IN_INSERT; REAL_LE_REFL] THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_DELETE] THEN ASM_REWRITE_TAC[IN_DELETE] THEN ASM_SIMP_TAC[SUM_DELETE; VSUM_DELETE; COND_ID] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; REAL_LE_REFL; COND_ID] THEN REWRITE_TAC[VECTOR_MUL_LZERO; SUM_0; VSUM_0] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {x | x IN s /\ ~(x = a)} = s`] THEN CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (\b. (u:real^N->real) b / v b) s` SUP_FINITE) THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_MESON_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!b. b IN s ==> &0 < (v:real^N->real) b` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_LE]; ALL_TAC] THEN SUBGOAL_THEN `&0 < (u:real^N->real) b /\ &0 < v b` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_LE] THEN UNDISCH_TAC `!x. x IN s ==> (u:real^N->real) x / v x <= u b / v b` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN DISCH_TAC THEN UNDISCH_TAC `sum s (u:real^N->real) = &1` THEN MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x = &1 ==> F`) THEN ASM_SIMP_TAC[SUM_EQ_0]; ALL_TAC] THEN EXISTS_TAC `(\x. if x = a then v b / u b else v x - (v b / u b) * u x): real^N->real` THEN ASM_SIMP_TAC[FORALL_IN_INSERT; REAL_LE_DIV; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_DELETE] THEN ASM_SIMP_TAC[SUM_DELETE; VSUM_DELETE; IN_DELETE] THEN ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; FINITE_DELETE] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {x | x IN s /\ ~(x = a)} = s`; SET_RULE `~(a IN s) ==> {x | x IN s /\ x = a} = {}`] THEN REWRITE_TAC[VSUM_CLAUSES; SUM_CLAUSES] THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN ASM_SIMP_TAC[VECTOR_SUB_RDISTRIB; VSUM_SUB; SUM_SUB] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VECTOR_ADD_LID; REAL_ADD_LID] THEN ASM_SIMP_TAC[SUM_LMUL; VSUM_LMUL] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN REPEAT CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC; VECTOR_ARITH_TAC] THEN X_GEN_TAC `c:real^N` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_CASES_TAC `(u:real^N->real) c = &0` THENL [ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO]; ALL_TAC] THEN REWRITE_TAC[REAL_SUB_LE] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_LE]);; let IN_CONVEX_HULL_EXCHANGE_UNIQUE = prove (`!s t t' a x:real^N. ~(affine_dependent s) /\ a IN convex hull s /\ t SUBSET s /\ t' SUBSET s /\ x IN convex hull (a INSERT t) /\ x IN convex hull (a INSERT t') ==> x IN convex hull (a INSERT (t INTER t'))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `a INSERT (s INTER t) = (a INSERT s) INTER (a INSERT t)`] THEN W(MP_TAC o PART_MATCH (rand o rand) CONVEX_HULL_INTER o rand o snd) THEN ANTS_TAC THENL [UNDISCH_TAC `~(affine_dependent(s:real^N->bool))` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO); DISCH_THEN(SUBST1_TAC o SYM)] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `b:real^N->real` STRIP_ASSUME_TAC) MP_TAC) THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `~((a:real^N) IN t) /\ ~(a IN t')` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(t:real^N->bool) /\ FINITE(t':real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN; REAL_LE_ADD; REAL_ARITH `&0 <= a / &2 <=> &0 <= a`] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u':real`; `u:real^N->real`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`v':real`; `v:real^N->real`] THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_DEPENDENT_EXPLICIT]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(MP_TAC o SPEC `\x:real^N. (if x IN t then u x else &0) - (if x IN t' then v x else &0) + (u' - v') * b x`) THEN ASM_SIMP_TAC[SUM_ADD; VSUM_ADD; SUM_LMUL; VSUM_LMUL; VECTOR_ADD_RDISTRIB] THEN ASM_SIMP_TAC[SUM_SUB; VSUM_SUB; VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[MESON[] `(if p then a else b) % x = (if p then a % x else b % x)`] THEN ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; VECTOR_MUL_LZERO; SUM_0; VSUM_0] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN ASM_SIMP_TAC[SUM_ADD; SUM_LMUL; VSUM_ADD; VSUM_LMUL; VECTOR_ADD_RDISTRIB; GSYM VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `(!x. x IN s ==> (if x IN t then u x else &0) <= (if x IN t' then v x else &0)) \/ (!x:real^N. x IN s ==> (if x IN t' then v x else &0) <= (if x IN t then u x else &0))` (DISJ_CASES_THEN(LABEL_TAC "*")) THENL [MP_TAC(REAL_ARITH `&0 <= (u' - v') \/ &0 <= (v' - u')`) THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= c ==> a - b + c = &0 ==> a <= b`); MATCH_MP_TAC(REAL_ARITH `&0 <= --c ==> a - b + c = &0 ==> b <= a`)] THEN ASM_SIMP_TAC[REAL_LE_MUL; GSYM REAL_MUL_LNEG; REAL_NEG_SUB]; EXISTS_TAC `(\x. if x = a then u' else u x):real^N->real`; EXISTS_TAC `(\x. if x = a then v' else v x):real^N->real`] THEN ASM_SIMP_TAC[FORALL_IN_INSERT] THEN (CONJ_TAC THENL [ASM_MESON_TAC[IN_INTER]; ALL_TAC]) THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_INTER] THEN ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[REAL_ARITH `u' + u = &1 <=> u = &1 - u'`; VECTOR_ARITH `u' + u:real^N = y <=> u = y - u'`] THEN (CONJ_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN CONV_TAC SYM_CONV THENL [MATCH_MP_TAC SUM_EQ_SUPERSET; MATCH_MP_TAC VSUM_EQ_SUPERSET]) THEN ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET; IN_INTER] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM SET_TAC[]);; let CONVEX_HULL_EXCHANGE_UNION = prove (`!s a:real^N. a IN convex hull s ==> convex hull s = UNIONS {convex hull (a INSERT (s DELETE b)) |b| b IN s}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[IN_CONVEX_HULL_EXCHANGE]; REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN ASM_SIMP_TAC[SUBSET_HULL; CONVEX_CONVEX_HULL] THEN ASM_REWRITE_TAC[INSERT_SUBSET] THEN MESON_TAC[HULL_INC; SUBSET; IN_DELETE]]);; let CONVEX_HULL_EXCHANGE_INTER = prove (`!s a:real^N t t'. ~affine_dependent s /\ a IN convex hull s /\ t SUBSET s /\ t' SUBSET s ==> (convex hull (a INSERT t)) INTER (convex hull (a INSERT t')) = convex hull (a INSERT (t INTER t'))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_INTER] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_CONVEX_HULL_EXCHANGE_UNIQUE THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Representing affine hull as hyperplane or finite intersection of them. *) (* ------------------------------------------------------------------------- *) let AFF_DIM_EQ_INTER_HYPERPLANE = prove (`!s t:real^N->bool. affine s /\ affine t /\ t SUBSET s /\ aff_dim t + &1 = aff_dim s ==> ?a b. ~(a = vec 0) /\ {x | a dot x = b} INTER s = t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[AFF_DIM_EMPTY; INT_ARITH `--a + a:int = b <=> b = &0`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o last o CONJUNCTS)) THEN REWRITE_TAC[AFF_DIM_EQ_0; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN SUBST1_TAC THEN MAP_EVERY EXISTS_TAC [`basis 1:real^N`; `basis 1 dot (a:real^N) + &1`] THEN SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; REAL_ARITH `x:real = x + &1 <=> F`; IN_ELIM_THM; SET_RULE `s INTER {a} = {} <=> ~(a IN s)`]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN GEN_GEOM_ORIGIN_TAC `z:real^N` ["a"] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `(vec 0:real^N) IN s` THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE; AFF_DIM_DIM; HULL_INC] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_EQ_INTER_HYPERPLANE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[DOT_RADD] THEN EXISTS_TAC `(a:real^N) dot z` THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL_0]]);; let AFF_DIM_EQ_HYPERPLANE = prove (`!s. aff_dim s = &(dimindex(:N)) - &1 <=> ?a b. ~(a = vec 0) /\ affine hull s = {x:real^N | a dot x = b}`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[AFF_DIM_EMPTY; INT_ARITH `--a:int = b - a <=> b = &0`] THEN SIMP_TAC[INT_OF_NUM_EQ; LE_1; DIMINDEX_GE_1; AFFINE_HULL_EMPTY] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(b / (a dot a)) % a:real^N`) THEN ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N` THEN GEN_GEOM_ORIGIN_TAC `c:real^N` ["a"] THEN SIMP_TAC[AFF_DIM_DIM_0; HULL_INC] THEN SIMP_TAC[INT_OF_NUM_SUB; DIMINDEX_GE_1; INT_OF_NUM_EQ] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; DIM_EQ_HYPERPLANE] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RADD; REAL_ARITH `a + b:real = c <=> b = c - a`] THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC `(a:real^N) dot c` THEN ASM_REWRITE_TAC[REAL_SUB_REFL]; ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `\s. (vec 0:real^N) IN s`) THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM; DOT_RZERO]]]);; let AFF_DIM_HYPERPLANE = prove (`!a b. ~(a = vec 0) ==> aff_dim {x:real^N | a dot x = b} = &(dimindex(:N)) - &1`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFF_DIM_EQ_HYPERPLANE] THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM_REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_HYPERPLANE]);; let BOUNDED_HYPERPLANE_EQ_TRIVIAL = prove (`!a b. bounded {x:real^N | a dot x = b} <=> if a = vec 0 then ~(b = &0) else dimindex(:N) = 1`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL [ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; BOUNDED_EMPTY] THEN REWRITE_TAC[NOT_BOUNDED_UNIV; SET_RULE `{x | T} = UNIV`]; ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM; AFF_DIM_HYPERPLANE; AFFINE_HYPERPLANE] THEN REWRITE_TAC[INT_ARITH `a - &1:int <= &0 <=> a <= &1`; INT_OF_NUM_LE] THEN MATCH_MP_TAC(ARITH_RULE `1 <= n ==> (n <= 1 <=> n = 1)`) THEN REWRITE_TAC[DIMINDEX_GE_1]]);; let AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES = prove (`!s:real^N->bool. ?f. FINITE f /\ &(CARD f) + aff_dim s = &(dimindex(:N)) /\ affine hull s = INTERS f /\ (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x | a dot x = b})`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN MP_TAC(ISPEC `s:real^N->bool` AFFINE_BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MP_TAC(ISPECL [`b:real^N->bool`; `(:real^N)`] EXTEND_TO_AFFINE_BASIS) THEN ASM_REWRITE_TAC[SUBSET_UNIV; AFFINE_HULL_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `FINITE(c:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]; ALL_TAC] THEN REWRITE_TAC[GSYM AFF_DIM_UNIV] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; CARD_DIFF] THEN REWRITE_TAC[INT_ARITH `f + b - &1:int = c - &1 <=> f = c - b`] THEN ASM_SIMP_TAC[INT_OF_NUM_SUB; CARD_SUBSET; GSYM CARD_DIFF; INT_OF_NUM_EQ] THEN ASM_CASES_TAC `c:real^N->bool = b` THENL [EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; INTERS_0; DIFF_EQ_EMPTY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `{affine hull (c DELETE a) |a| (a:real^N) IN (c DIFF b)}` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DIFF] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_SIMP_TAC[FINITE_DIFF] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~affine_dependent(c:real^N->bool)` THEN REWRITE_TAC[affine_dependent] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN W(MP_TAC o PART_MATCH (rhs o rand) AFFINE_HULL_INTERS o rand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]; REWRITE_TAC[GSYM AFF_DIM_EQ_HYPERPLANE] THEN ASM_SIMP_TAC[IN_DIFF; AFFINE_INDEPENDENT_DELETE; AFF_DIM_AFFINE_INDEPENDENT; CARD_DELETE] THEN REWRITE_TAC[GSYM AFF_DIM_UNIV] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; CARD_DIFF] THEN REPEAT STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(GSYM INT_OF_NUM_SUB) THEN MATCH_MP_TAC(ARITH_RULE `~(c = 0) ==> 1 <= c`) THEN ASM_SIMP_TAC[CARD_EQ_0] THEN ASM SET_TAC[]]);; let AFFINE_HYPERPLANE_SUMS_EQ_UNIV = prove (`!a b s. affine s /\ ~(s INTER {v | a dot v = b} = {}) /\ ~(s DIFF {v | a dot v = b} = {}) ==> {x + y | x IN s /\ y IN {v | a dot v = b}} = (:real^N)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_REWRITE_TAC[DOT_LZERO] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N` THEN ONCE_REWRITE_TAC[SET_RULE `{x + y:real^N | x IN s /\ P y} = {z | ?x y. x IN s /\ P y /\ z = x + y}`] THEN GEOM_ORIGIN_TAC `c:real^N` THEN REPEAT GEN_TAC THEN REWRITE_TAC[DOT_RADD; REAL_ARITH `b dot c + a = d <=> a = d - b dot c`] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM; DOT_RZERO] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE; HULL_INC] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH `c + z:real^N = (c + x) + (c + y) <=> z = c + x + y`] THEN REWRITE_TAC[SET_RULE `{z | ?x y. x IN s /\ P y /\ z = c + x + y} = IMAGE (\x. c + x) {x + y:real^N | x IN s /\ y IN {v | P v}}`] THEN MATCH_MP_TAC(SET_RULE `!f. (!x. g(f x) = x) /\ s = UNIV ==> IMAGE g s = UNIV`) THEN EXISTS_TAC `\x:real^N. x - c` THEN REWRITE_TAC[VECTOR_ARITH `c + x - c:real^N = x`] THEN MATCH_MP_TAC(MESON[SPAN_EQ_SELF] `subspace s /\ span s = t ==> s = t`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUBSPACE_SUMS; SUBSPACE_HYPERPLANE]; ALL_TAC] THEN REWRITE_TAC[GSYM DIM_EQ_FULL] THEN REWRITE_TAC[GSYM LE_ANTISYM; DIM_SUBSET_UNIV] THEN MATCH_MP_TAC(ARITH_RULE `m - 1 < n ==> m <= n`) THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `dim {x:real^N | a dot x = &0}` THEN CONJ_TAC THENL [ASM_SIMP_TAC[DIM_HYPERPLANE; LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC DIM_PSUBSET THEN ASM_SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL SPAN_EQ_SELF)); SUBSPACE_SUMS; SUBSPACE_HYPERPLANE] THEN REWRITE_TAC[PSUBSET; SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_LID]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN SIMP_TAC[IN_DIFF; IN_ELIM_THM] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[DOT_RZERO; VECTOR_ADD_RID]]);; let AFF_DIM_AFFINE_INTER_HYPERPLANE = prove (`!a b s:real^N->bool. affine s ==> aff_dim(s INTER {x | a dot x = b}) = if s INTER {v | a dot v = b} = {} then -- &1 else if s SUBSET {v | a dot v = b} then aff_dim s else aff_dim s - &1`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_REWRITE_TAC[DOT_LZERO] THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; INTER_EMPTY; AFF_DIM_EMPTY] THEN SIMP_TAC[SET_RULE `{x | T} = UNIV`; IN_UNIV; INTER_UNIV; SUBSET_UNIV] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY]; STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN COND_CASES_TAC THENL [AP_TERM_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `{x:real^N | a dot x = b}`] AFF_DIM_SUMS_INTER) THEN ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN ASM_SIMP_TAC[AFFINE_HYPERPLANE_SUMS_EQ_UNIV; AFF_DIM_UNIV; SET_RULE `~(s SUBSET t) ==> ~(s DIFF t = {})`] THEN SPEC_TAC(`aff_dim (s INTER {x:real^N | a dot x = b})`,`i:int`) THEN INT_ARITH_TAC]);; let AFF_DIM_LT_FULL = prove (`!s. aff_dim s < &(dimindex(:N)) <=> ~(affine hull s = (:real^N))`, GEN_TAC THEN REWRITE_TAC[GSYM AFF_DIM_EQ_FULL] THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_LE_UNIV) THEN ARITH_TAC);; let AFF_LOWDIM_SUBSET_HYPERPLANE = prove (`!s:real^N->bool. aff_dim s < &(dimindex(:N)) ==> ?a b. ~(a = vec 0) /\ s SUBSET {x | a dot x = b}`, MATCH_MP_TAC SET_PROVE_CASES THEN CONJ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `basis 1:real^N` THEN SIMP_TAC[EMPTY_SUBSET; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; MAP_EVERY X_GEN_TAC [`c:real^N`; `s:real^N->bool`] THEN CONV_TAC(ONCE_DEPTH_CONV(GEN_ALPHA_CONV `a:real^N`)) THEN GEN_GEOM_ORIGIN_TAC `c:real^N` ["a"] THEN SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; IN_INSERT; INT_OF_NUM_LT] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN STRIP_TAC THEN EXISTS_TAC `(u:real^N) dot c` THEN ASM_REWRITE_TAC[DOT_RADD; REAL_EQ_ADD_LCANCEL_0] THEN ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]]);; let COLLINEAR_HYPERPLANE_2 = prove (`!a:real^N b. dimindex(:N) <= 2 /\ ~(a = vec 0) ==> collinear {x | a dot x = b}`, SIMP_TAC[COLLINEAR_AFF_DIM; AFF_DIM_HYPERPLANE; GSYM INT_OF_NUM_LE] THEN INT_ARITH_TAC);; let COLLINEAR_STANDARD_HYPERPLANE_2 = prove (`!k b. dimindex(:N) <= 2 ==> collinear {x:real^N | x$k = b}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `b:real`] COLLINEAR_HYPERPLANE_2) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; (* ------------------------------------------------------------------------- *) (* Existence of rotation into general position w.r.t the axes. *) (* ------------------------------------------------------------------------- *) let ROTATION_TO_GENERAL_POSITION_EXISTS_GEN = prove (`!n s:real^N->bool. n <= dimindex(:N) /\ COUNTABLE s /\ s SUBSET span(IMAGE basis (1..n)) ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ (!x. (!i. 1 <= i /\ i <= n ==> x$i = &0) ==> f x = x) /\ IMAGE f (span(IMAGE basis (1..n))) = span(IMAGE basis (1..n)) /\ pairwise (\x y. !i. 1 <= i /\ i <= n ==> ~(f x$i = f y$i)) s`, let lemma0 = prove (`!s:real^N->bool k. affine s /\ &2 <= aff_dim s /\ COUNTABLE k /\ (!a. a IN k ==> ~(s SUBSET {x | orthogonal a x})) ==> UNIONS {{x | x IN s /\ orthogonal a x} | a IN k} UNION UNIONS {{x | x IN s /\ x IN span {a}} | a IN k} PSUBSET s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_UNION] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ ~(s SUBSET t) ==> t PSUBSET s`) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; FORALL_IN_UNION; SUBSET_RESTRICT] THEN DISCH_THEN(MP_TAC o ISPEC `subtopology euclidean (s:real^N->bool)` o MATCH_MP INTERIOR_OF_MONO) THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ t = {} ==> s SUBSET t ==> F`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERIOR_OF_EQ_EMPTY_COMPLEMENT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_REWRITE_TAC[DIFF_EQ_EMPTY; CLOSURE_OF_EMPTY]; ALL_TAC] THEN MATCH_MP_TAC NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_UNION; FORALL_IN_UNION] THEN ASM_SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; CLOSED_AFFINE] THEN REWRITE_TAC[orthogonal; SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_HYPERPLANE; CLOSED_SPAN] THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `a:real^N` THEN ASM_CASES_TAC `(a:real^N) IN k` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC EMPTY_INTERIOR_OF_AFF_DIM THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE] THEN ASM_SIMP_TAC[GSYM orthogonal] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_ARITH `x - &1:int < x`] THEN REWRITE_TAC[INT_LT_LE; AFF_DIM_GE] THEN ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; TRANS_TAC INT_LET_TRANS `aff_dim(span{a:real^N})` THEN SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET] THEN SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN REWRITE_TAC[DIM_SPAN; DIM_SING] THEN COND_CASES_TAC THEN ASM_INT_ARITH_TAC]) in let lemma1 = prove (`!n s:real^N->bool. n <= dimindex(:N) /\ COUNTABLE s /\ s SUBSET span(IMAGE basis (1..n)) DELETE vec 0 ==> ?f. orthogonal_transformation f /\ (!x. (!i. 1 <= i /\ i <= n ==> x$i = &0) ==> f x = x) /\ IMAGE f (span(IMAGE basis (1..n))) = span(IMAGE basis (1..n)) /\ !x i. x IN s /\ 1 <= i /\ i <= n ==> ~(f x$i = &0)`, MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN REWRITE_TAC[IMAGE_CLAUSES; SPAN_EMPTY] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID]; X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET_DELETE] THEN STRIP_TAC] THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[IMAGE_ID; NOT_IN_EMPTY; ORTHOGONAL_TRANSFORMATION_ID]; ALL_TAC] THEN ASM_CASES_TAC `n = 0` THENL [EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID; IMAGE_ID] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_1] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN SUBGOAL_THEN `~(x:real^N = vec 0)` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CART_EQ]] THEN REWRITE_TAC[VEC_COMPONENT; IN_NUMSEG; VEC_COMPONENT] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[LE_ANTISYM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`span(IMAGE basis (1..SUC n)):real^N->bool`; `s:real^N->bool`] lemma0) THEN SIMP_TAC[SUBSPACE_IMP_AFFINE; SUBSPACE_SPAN; NONEMPTY_SPAN] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN; DIM_SPAN] THEN REWRITE_TAC[DIM_BASIS_IMAGE; INT_OF_NUM_LE] THEN REWRITE_TAC[CARD_NUMSEG_1; INTER_NUMSEG; ARITH_RULE `MAX 1 1 = 1`] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u /\ (!a. a IN s ==> ~(a IN f a)) ==> !a. a IN s ==> ~(u SUBSET f a)`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; ORTHOGONAL_REFL] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `t PSUBSET s ==> ?a. a IN s /\ ~(a IN t)`)) THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNION; DE_MORGAN_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`]] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] orthogonal] THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_MESON_TAC[DOT_LZERO; MEMBER_NOT_EMPTY]; STRIP_TAC] THEN MP_TAC(ISPECL [`span(IMAGE basis (1..SUC n)):real^N->bool`; `inv(norm a) % a:real^N`; `basis(SUC n):real^N`] ORTHOGONAL_TRANSFORMATION_EXISTS_GEN) THEN REWRITE_TAC[SUBSPACE_SPAN] THEN ANTS_TAC THENL [ASM_SIMP_TAC[SPAN_MUL; NORM_BASIS; ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0] THEN MATCH_MP_TAC SPAN_SUPERSET THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC)] THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x. x - x$(SUC n) % basis(SUC n)) (IMAGE (h:real^N->real^N) s)`) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_SUB_EQ; SET_RULE `~(a IN IMAGE f (IMAGE g s)) <=> !x. x IN s ==> ~(f(g x) = a)`] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SPEC_TAC(`(h:real^N->real^N) x$(SUC n)`,`b:real`) THEN GEN_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 3 RAND_CONV) [SYM th]) THEN ASM_SIMP_TAC[GSYM LINEAR_CMUL; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^N) IN span {a} /\ ~(a IN span {x})` MP_TAC THENL [ASM_SIMP_TAC[] THEN REWRITE_TAC[SPAN_SING; IN_ELIM_THM; IN_UNIV] THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; MP_TAC(MESON[INSERT_AC] `collinear{vec 0:real^N,a,x} <=> collinear{vec 0,x,a}`) THEN REWRITE_TAC[COLLINEAR_SPAN] THEN ASM_MESON_TAC[]]; TRANS_TAC SUBSET_TRANS `IMAGE (\x:real^N. x - x$(SUC n) % basis(SUC n)) (span (IMAGE basis (1..SUC n)))` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPAN_IMAGE_BASIS] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN X_GEN_TAC `x:real^N` THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RID] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_MUL_RZERO] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^N->real^N) o (h:real^N->real^N)` THEN ASM_SIMP_TAC[IMAGE_o; ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN ASM_REWRITE_TAC[o_THM] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `(f:real^N->real^N) x` THEN CONJ_TAC THENL [AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_BASIS; ARITH_RULE `1 <= SUC n`; LE_REFL] THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPAN_IMAGE_BASIS]) THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[orthogonal; dot] THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_MESON_TAC[REAL_ENTIRE]; ASM_MESON_TAC[ARITH_RULE `i <= n ==> i <= SUC n`]]; REWRITE_TAC[NUMSEG_CLAUSES; ARITH_RULE `1 <= SUC n`] THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = s UNION {a}`] THEN REWRITE_TAC[SPAN_UNION; IMAGE_UNION] THEN REWRITE_TAC[SET_RULE `IMAGE f {p x y | P x y} = {f(p x y) | P x y}`] THEN ASM_SIMP_TAC[LINEAR_ADD; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN MATCH_MP_TAC(SET_RULE `IMAGE f s = u /\ (!x. x IN t ==> f x = x) ==> {(f:real^N->real^N) x + f y | x IN s /\ y IN t} = {x + y | x IN u /\ y IN t}`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMAGE_CLAUSES; SPAN_SING; FORALL_IN_GSPEC; IN_UNIV] THEN ASM_SIMP_TAC[LINEAR_CMUL; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN GEN_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[BASIS_COMPONENT]] THEN SIMP_TAC[ARITH_RULE `i <= n ==> ~(i = SUC n)`]; MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN REWRITE_TAC[LE] THEN STRIP_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE [IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE]) THEN RULE_ASSUM_TAC(REWRITE_RULE [IMP_IMP; RIGHT_IMP_FORALL_THM; GSYM CONJ_ASSOC]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `i:num`]) THEN ASM_REWRITE_TAC[CONTRAPOS_THM; VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[LINEAR_SUB; ORTHOGONAL_TRANSFORMATION_LINEAR; VECTOR_SUB_COMPONENT] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(REAL_ARITH `y$i = &0 /\ (f:real^N->real^N)(y)$i = y$i ==> &0 - f(y)$i = &0`) THEN CONJ_TAC THENL [SUBGOAL_THEN `i <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC]; AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `!j. j <= n ==> j <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; REAL_MUL_RZERO; ARITH_RULE `i <= n ==> ~(i = SUC n)`]] THEN SUBGOAL_THEN `(f:real^N->real^N)(h(x:real^N)) = f(h x - h x$(SUC n) % basis(SUC n)) + h x$(SUC n) % basis(SUC n)` SUBST1_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) LINEAR_SUB o lhand o rand o snd) THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `y:real^N = z ==> x = x - y + z`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `!j. j <= n ==> j <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; REAL_MUL_RZERO; ARITH_RULE `i <= n ==> ~(i = SUC n)`]; ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[BASIS_COMPONENT; ARITH_RULE `1 <= SUC n`] THEN MATCH_MP_TAC(REAL_ARITH `x = &0 /\ ~(y = &0) ==> ~(x + y * &1 = &0)`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(SET_RULE `IMAGE f b = b ==> x IN b /\ (!y. y IN b ==> y$SUC n = &0) ==> (f:real^N->real^N) x $SUC n = &0`)) THEN REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN ASM_SIMP_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n /\ ~(SUC n <= n)`] THEN SUBGOAL_THEN `(h:real^N->real^N) x IN span(IMAGE basis (1..SUC n))` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[IN_SPAN_IMAGE_BASIS] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `j:num` THEN ASM_CASES_TAC `1 <= j` THEN ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_CASES_TAC `j <= dimindex(:N)` THEN ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; IN_NUMSEG] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_SUB_REFL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; SUBGOAL_THEN `~(h(inv(norm a) % a) dot (h:real^N->real^N) x = &0)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[DOT_BASIS; ARITH_RULE `1 <= SUC n`]] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_transformation]) THEN ASM_REWRITE_TAC[DOT_LMUL; REAL_ENTIRE; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[orthogonal]]]]]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID; MATRIX_ID; DET_I] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN REWRITE_TAC[IMAGE_CLAUSES; SPAN_EMPTY] THEN REWRITE_TAC[pairwise] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `(!f. P f /\ R f ==> ?f'. P f' /\ Q f' /\ R f') /\ (?f. P f /\ R f) ==> ?f. P f /\ Q f /\ R f`) THEN CONJ_TAC THENL [X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_MATRIX_MATRIX) THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP DET_ORTHOGONAL_MATRIX) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `reflect_along (basis 1:real^N) o (f:real^N->real^N)` THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE; ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG] THEN ASM_SIMP_TAC[MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_REFLECT_ALONG; DET_MUL] THEN SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[DET_MATRIX_REFLECT_ALONG; BASIS_NONZERO; o_THM; IMAGE_o; CART_EQ; DIMINDEX_GE_1; LE_REFL; REFLECT_ALONG_BASIS_COMPONENT] THEN DISCH_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[LE_1; LE_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[REFLECT_ALONG_INVOLUTION]; ALL_TAC] THEN REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN SIMP_TAC[REFLECT_ALONG_BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[REAL_NEG_EQ_0] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_IMP)) THEN REWRITE_TAC[] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_EQ_NEG2]]; MP_TAC(ISPECL [`n:num`; `{x - y:real^N | x IN s /\ y IN s} DELETE (vec 0)`] lemma1) THEN ASM_REWRITE_TAC[IN_DELETE] THEN ASM_SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT; COUNTABLE_DELETE] THEN ANTS_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DELETE a SUBSET t DELETE a`) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_SUB THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[VECTOR_SUB_EQ; pairwise] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_SUB o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN DISCH_THEN(fun th -> REWRITE_TAC[th; VECTOR_SUB_COMPONENT]) THEN REWRITE_TAC[REAL_SUB_0] THEN MESON_TAC[]]]);; let ROTATION_TO_GENERAL_POSITION_EXISTS = prove (`!s:real^N->bool. COUNTABLE s ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ pairwise (\x y. !i. 1 <= i /\ i <= dimindex(:N) ==> ~(f x$i = f y$i)) s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`dimindex(:N)`; `s:real^N->bool`] ROTATION_TO_GENERAL_POSITION_EXISTS_GEN) THEN ASM_REWRITE_TAC[LE_REFL] THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; IN_NUMSEG; SPAN_STDBASIS; SUBSET_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Openness and compactness are preserved by convex hull operation. *) (* ------------------------------------------------------------------------- *) let OPEN_CONVEX_HULL = prove (`!s:real^N->bool. open s ==> open(convex hull s)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_EXPLICIT; OPEN_CONTAINS_CBALL] THEN REWRITE_TAC[IN_ELIM_THM; SUBSET; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`; `u:real^N->real`] THEN STRIP_TAC THEN SUBGOAL_THEN `?b. !x:real^N. x IN t ==> &0 < b(x) /\ cball(x,b(x)) SUBSET s` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN ABBREV_TAC `i = IMAGE (b:real^N->real) t` THEN EXISTS_TAC `inf i` THEN MP_TAC(SPEC `i:real->bool` INF_FINITE) THEN EXPAND_TAC "i" THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_IMAGE] THEN ANTS_TAC THENL [EXPAND_TAC "i" THEN CONJ_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE]; ALL_TAC] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM_MESON_TAC[SUM_CLAUSES; REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_CBALL; dist] THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (\v:real^N. v + (y - a)) t` THEN EXISTS_TAC `\v. (u:real^N->real)(v - (y - a))` THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; SUM_IMAGE; VSUM_IMAGE; VECTOR_ARITH `v + a:real^N = w + a <=> v = w`] THEN ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(v + a) - a:real^N = v`] THEN ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB; ETA_AX] THEN ASM_SIMP_TAC[VSUM_ADD; VSUM_RMUL] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `z + (y - a) IN cball(z:real^N,b z)` (fun th -> ASM_MESON_TAC[th; SUBSET]) THEN REWRITE_TAC[IN_CBALL; dist; NORM_ARITH `norm(z - (z + a - y)) = norm(y - a)`] THEN ASM_MESON_TAC[REAL_LE_TRANS]);; let COMPACT_CONVEX_COMBINATIONS = prove (`!s t. compact s /\ compact t ==> compact { (&1 - u) % x + u % y :real^N | &0 <= u /\ u <= &1 /\ x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{ (&1 - u) % x + u % y :real^N | &0 <= u /\ u <= &1 /\ x IN s /\ y IN t} = IMAGE (\z. (&1 - drop(fstcart z)) % fstcart(sndcart z) + drop(fstcart z) % sndcart(sndcart z)) { pastecart u w | u IN interval[vec 0,vec 1] /\ w IN { pastecart x y | x IN s /\ y IN t} }` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; GSYM EXISTS_DROP; DROP_VEC] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_PCROSS; GSYM PCROSS; COMPACT_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `z:real^(1,(N,N)finite_sum)finite_sum` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[PCROSS] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_SUB) THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART; ETA_AX] THEN GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC LINEAR_COMPOSE THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let COMPACT_CONVEX_HULL = prove (`!s:real^N->bool. compact s ==> compact(convex hull s)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CARATHEODORY] THEN SPEC_TAC(`dimindex(:N) + 1`,`n:num`) THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{x | F} = {}`; COMPACT_EMPTY]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `w:real^N`) THEN INDUCT_TAC THENL [SUBGOAL_THEN `{x:real^N | ?t. FINITE t /\ t SUBSET s /\ CARD t <= 0 /\ x IN convex hull t} = {}` (fun th -> REWRITE_TAC[th; COMPACT_EMPTY]) THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; LE; IN_ELIM_THM] THEN MESON_TAC[CARD_EQ_0; CONVEX_HULL_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[ARITH_RULE `s <= SUC 0 <=> s = 0 \/ s = 1`] THEN UNDISCH_TAC `compact(s:real^N->bool)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[TAUT `a /\ b /\ (c \/ d) /\ e <=> (a /\ c) /\ (b /\ e) \/ (a /\ d) /\ (b /\ e)`] THEN REWRITE_TAC[GSYM HAS_SIZE; num_CONV `1`; HAS_SIZE_CLAUSES] THEN REWRITE_TAC[EXISTS_OR_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN CONV_TAC(TOP_DEPTH_CONV UNWIND_CONV) THEN REWRITE_TAC[NOT_IN_EMPTY; CONVEX_HULL_EMPTY] THEN REWRITE_TAC[CONVEX_HULL_SING] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `{x:real^N | ?t. FINITE t /\ t SUBSET s /\ CARD t <= SUC n /\ x IN convex hull t} = { (&1 - u) % x + u % y :real^N | &0 <= u /\ u <= &1 /\ x IN s /\ y IN {x | ?t. FINITE t /\ t SUBSET s /\ CARD t <= n /\ x IN convex hull t}}` (fun th -> ASM_SIMP_TAC[th; COMPACT_CONVEX_COMBINATIONS]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [ALL_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `c:real`; `v:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `(u:real^N) INSERT t` THEN ASM_REWRITE_TAC[FINITE_INSERT; INSERT_SUBSET] THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC IN_CONVEX_SET THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL] THEN CONJ_TAC THEN ASM_MESON_TAC[HULL_SUBSET; SUBSET; IN_INSERT; HULL_MONO]] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `CARD(t:real^N->bool) <= n` THENL [MAP_EVERY EXISTS_TAC [`w:real^N`; `&1`; `x:real^N`] THEN ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; VECTOR_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `(t:real^N->bool) HAS_SIZE (SUC n)` MP_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE_CLAUSES] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN UNDISCH_TAC `(x:real^N) IN convex hull (a INSERT u)` THEN RULE_ASSUM_TAC(REWRITE_RULE[FINITE_INSERT]) THEN ASM_CASES_TAC `(u:real^N->bool) = {}` THENL [ASM_REWRITE_TAC[CONVEX_HULL_SING; IN_SING] THEN DISCH_THEN SUBST_ALL_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `&1`; `a:real^N`] THEN ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `{a:real^N}` THEN SIMP_TAC[FINITE_RULES] THEN REWRITE_TAC[CONVEX_HULL_SING; IN_SING] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CONVEX_HULL_INSERT; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real`; `d:real`; `z:real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `d:real`; `z:real^N`] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH `c + d = &1 ==> c = (&1 - d)`)) THEN ASM_REWRITE_TAC[REAL_ARITH `d <= &1 <=> &0 <= &1 - d`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `CARD ((a:real^N) INSERT u) <= SUC n` THEN ASM_SIMP_TAC[CARD_CLAUSES; LE_SUC]);; let FINITE_IMP_COMPACT_CONVEX_HULL = prove (`!s:real^N->bool. FINITE s ==> compact(convex hull s)`, SIMP_TAC[FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);; let CONVEX_HULL_INTERIOR_SUBSET = prove (`!s:real^N->bool. convex hull (interior s) SUBSET interior (convex hull s)`, GEN_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[OPEN_CONVEX_HULL; OPEN_INTERIOR; HULL_MONO; INTERIOR_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Extremal points of a simplex are some vertices. *) (* ------------------------------------------------------------------------- *) let SIMPLEX_FURTHEST_LT = prove (`!a:real^N s. FINITE s ==> !x. x IN (convex hull s) /\ ~(x IN s) ==> ?y. y IN (convex hull s) /\ norm(x - a) < norm(y - a)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[CONVEX_HULL_SING; IN_SING] THEN MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CONVEX_HULL_INSERT] THEN STRIP_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `b:real^N`] THEN ASM_CASES_TAC `y:real^N IN (convex hull s)` THENL [REWRITE_TAC[IN_INSERT; DE_MORGAN_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`&0`; `&1`; `c:real^N`] THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_POS] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `u = &0` THENL [ASM_SIMP_TAC[REAL_ADD_LID; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN ASM_MESON_TAC[VECTOR_MUL_LID]; ALL_TAC] THEN ASM_CASES_TAC `v = &0` THENL [ASM_SIMP_TAC[REAL_ADD_RID; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN ASM_CASES_TAC `u = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN ASM_CASES_TAC `y = a:real^N` THEN ASM_REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INSERT; DE_MORGAN_THM] THEN STRIP_TAC THEN MP_TAC(SPECL [`u:real`; `v:real`] REAL_DOWN2) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `w:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`a:real^N`; `y:real^N`; `w % (x - b):real^N`] DIST_INCREASES_ONLINE) THEN ANTS_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `(x - y = vec 0) <=> (x = y)`] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `~(y:real^N IN convex hull s)` THEN ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]; ALL_TAC] THEN ASM_REWRITE_TAC[dist; real_gt] THEN REWRITE_TAC[VECTOR_ARITH `((u % x + v % b) + w % (x - b) = (u + w) % x + (v - w) % b) /\ ((u % x + v % b) - w % (x - b) = (u - w) % x + (v + w) % b)`] THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`(u + w) % x + (v - w) % b:real^N`; `u + w`; `v - w`; `b:real^N`]; MAP_EVERY EXISTS_TAC [`(u - w) % x + (v + w) % b:real^N`; `u - w`; `v + w`; `b:real^N`]] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_LT_IMP_LE; REAL_SUB_LE] THEN UNDISCH_TAC `u + v = &1` THEN REAL_ARITH_TAC);; let SIMPLEX_FURTHEST_LE = prove (`!a:real^N s. FINITE s /\ ~(s = {}) ==> ?y. y IN s /\ !x. x IN (convex hull s) ==> norm(x - a) <= norm(y - a)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPEC `convex hull (s:real^N->bool)` DISTANCE_ATTAINS_SUP) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL] THEN ASM_MESON_TAC[SUBSET_EMPTY; HULL_SUBSET]; ALL_TAC] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist] THEN ASM_MESON_TAC[SIMPLEX_FURTHEST_LT; REAL_NOT_LE]);; let SIMPLEX_FURTHEST_LE_EXISTS = prove (`!a:real^N s. FINITE s ==> !x. x IN (convex hull s) ==> ?y. y IN s /\ norm(x - a) <= norm(y - a)`, MESON_TAC[NOT_IN_EMPTY; CONVEX_HULL_EMPTY; SIMPLEX_FURTHEST_LE]);; let SIMPLEX_EXTREMAL_LE = prove (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> ?u v. u IN s /\ v IN s /\ !x y. x IN convex hull s /\ y IN convex hull s ==> norm(x - y) <= norm(u - v)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `convex hull (s:real^N->bool)` COMPACT_SUP_MAXDISTANCE) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL] THEN ASM_MESON_TAC[SUBSET_EMPTY; HULL_SUBSET]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN ASM_MESON_TAC[SIMPLEX_FURTHEST_LT; REAL_NOT_LE; NORM_SUB]);; let SIMPLEX_EXTREMAL_LE_EXISTS = prove (`!s:real^N->bool x y. FINITE s /\ x IN convex hull s /\ y IN convex hull s ==> ?u v. u IN s /\ v IN s /\ norm(x - y) <= norm(u - v)`, MESON_TAC[NOT_IN_EMPTY; CONVEX_HULL_EMPTY; SIMPLEX_EXTREMAL_LE]);; (* ------------------------------------------------------------------------- *) (* Closest point of a convex set is unique, with a continuous projection. *) (* ------------------------------------------------------------------------- *) let CLOSER_POINTS_LEMMA = prove (`!y:real^N z. y dot z > &0 ==> ?u. &0 < u /\ !v. &0 < v /\ v <= u ==> norm(v % z - y) < norm y`, REWRITE_TAC[NORM_LT; DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL; REAL_SUB_LDISTRIB; real_gt] THEN REPEAT GEN_TAC THEN REWRITE_TAC[REAL_ARITH `(a - b) - (c - d) < d <=> a < b + c`] THEN STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `(z:real^N) dot y = y dot z`) THEN SIMP_TAC[GSYM REAL_ADD_LDISTRIB; REAL_LT_LMUL_EQ] THEN EXISTS_TAC `(y dot (z:real^N)) / (z dot z)` THEN SUBGOAL_THEN `&0 < z dot (z:real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[DOT_POS_LT; DOT_RZERO; REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LE_RDIV_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < y /\ x <= y ==> x < y + y`; REAL_LT_MUL]);; let CLOSER_POINT_LEMMA = prove (`!x y z. (y - x) dot (z - x) > &0 ==> ?u. &0 < u /\ u <= &1 /\ dist(x + u % (z - x),y) < dist(x,y)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSER_POINTS_LEMMA) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist; NORM_LT] THEN REWRITE_TAC[VECTOR_ARITH `(y - (x + z)) dot (y - (x + z)) = (z - (y - x)) dot (z - (y - x))`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min u (&1)` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_MIN_LE; REAL_LT_01; REAL_LE_REFL]);; let ANY_CLOSEST_POINT_DOT = prove (`!s a x y:real^N. convex s /\ closed s /\ x IN s /\ y IN s /\ (!z. z IN s ==> dist(a,x) <= dist(a,z)) ==> (a - x) dot (y - x) <= &0`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `x <= &0 <=> ~(x > &0)`] THEN DISCH_THEN(MP_TAC o MATCH_MP CLOSER_POINT_LEMMA) THEN DISCH_THEN(X_CHOOSE_THEN `u:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[REAL_NOT_LT] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_ARITH `x + u % (y - x) = (&1 - u) % x + u % y`] THEN MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]);; let ANY_CLOSEST_POINT_UNIQUE = prove (`!s a x y:real^N. convex s /\ closed s /\ x IN s /\ y IN s /\ (!z. z IN s ==> dist(a,x) <= dist(a,z)) /\ (!z. z IN s ==> dist(a,y) <= dist(a,z)) ==> x = y`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM NORM_LE_0; NORM_LE_SQUARE] THEN SUBGOAL_THEN `(a - x:real^N) dot (y - x) <= &0 /\ (a - y) dot (x - y) <= &0` MP_TAC THENL [ASM_MESON_TAC[ANY_CLOSEST_POINT_DOT]; ALL_TAC] THEN REWRITE_TAC[NORM_LT; DOT_LSUB; DOT_RSUB] THEN REAL_ARITH_TAC);; let CLOSEST_POINT_UNIQUE = prove (`!s a x:real^N. convex s /\ closed s /\ x IN s /\ (!z. z IN s ==> dist(a,x) <= dist(a,z)) ==> x = closest_point s a`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ANY_CLOSEST_POINT_UNIQUE THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `a:real^N`] THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; let CLOSEST_POINT_DOT = prove (`!s a x:real^N. convex s /\ closed s /\ x IN s ==> (a - closest_point s a) dot (x - closest_point s a) <= &0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ANY_CLOSEST_POINT_DOT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; let CLOSEST_POINT_LT = prove (`!s a x. convex s /\ closed s /\ x IN s /\ ~(x = closest_point s a) ==> dist(a,closest_point s a) < dist(a,x)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM REAL_NOT_LE; CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC CLOSEST_POINT_UNIQUE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSEST_POINT_LE; REAL_LE_TRANS]);; let CLOSEST_POINT_LIPSCHITZ = prove (`!s x y:real^N. convex s /\ closed s /\ ~(s = {}) ==> dist(closest_point s x,closest_point s y) <= dist(x,y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[dist; NORM_LE] THEN SUBGOAL_THEN `(x - closest_point s x :real^N) dot (closest_point s y - closest_point s x) <= &0 /\ (y - closest_point s y) dot (closest_point s x - closest_point s y) <= &0` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC ANY_CLOSEST_POINT_DOT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS]; MP_TAC(ISPEC `(x - closest_point s x :real^N) - (y - closest_point s y)` DOT_POS_LE) THEN REWRITE_TAC[NORM_LT; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC]);; let CONTINUOUS_AT_CLOSEST_POINT = prove (`!s x. convex s /\ closed s /\ ~(s = {}) ==> (closest_point s) continuous (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at] THEN ASM_MESON_TAC[CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; let CONTINUOUS_ON_CLOSEST_POINT = prove (`!s t. convex s /\ closed s /\ ~(s = {}) ==> (closest_point s) continuous_on t`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CLOSEST_POINT]);; let CLOSEST_POINT_TRANSLATION = prove (`!s a:real^N. convex s /\ closed s /\ ~(s = {}) ==> closest_point (IMAGE (\x. a + x) s) (a + x) = a + closest_point s x`, INTRO_TAC "!s a; cvx cld nempty" THEN MATCH_MP_TAC (GSYM CLOSEST_POINT_UNIQUE) THEN ASM_SIMP_TAC[CONVEX_TRANSLATION; CLOSED_TRANSLATION; IN_IMAGE] THEN CONJ_TAC THENL [EXISTS_TAC `closest_point s (x:real^N)` THEN ASM_SIMP_TAC[CLOSEST_POINT_IN_SET]; ALL_TAC] THEN INTRO_TAC "!z; @y. zdef yhp" THEN REMOVE_THEN "zdef" SUBST1_TAC THEN SUBGOAL_THEN `dist(x:real^N,closest_point s x) <= dist(x,y)` MP_TAC THENL [ASM_SIMP_TAC[CLOSEST_POINT_LE]; ALL_TAC] THEN NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Relating closest points and orthogonality. *) (* ------------------------------------------------------------------------- *) let ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL = prove (`!s a b:real^N. affine s /\ b IN s /\ (!x. x IN s ==> dist(a,b) <= dist(a,x)) ==> (!x. x IN s ==> orthogonal (x - b) (a - b))`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `b:real^N` THEN REWRITE_TAC[DIST_0; VECTOR_SUB_RZERO; orthogonal; dist; NORM_LE] THEN REWRITE_TAC[DOT_LSUB] THEN REWRITE_TAC[DOT_RSUB] THEN REWRITE_TAC[DOT_SYM; REAL_ARITH `a <= a - y - (y - x) <=> &2 * y <= x`] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `vec 0 + --((a dot x) / (x dot x)) % (x - vec 0:real^N)` th) THEN MP_TAC(SPEC `vec 0 + (a dot x) / (x dot x) % (x - vec 0:real^N)` th)) THEN ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF] THEN REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ADD_LID; DOT_RMUL] THEN REWRITE_TAC[DOT_LMUL; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&2 * x * a <= b * c * z /\ &2 * --x * a <= --b * --c * z ==> &2 * abs(x * a) <= b * c * z`)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_NOT_LE; REAL_DIV_RMUL; DOT_EQ_0] THEN MATCH_MP_TAC(REAL_ARITH `~(x = &0) ==> x < &2 * abs x`) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DOT_EQ_0]) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; let ORTHOGONAL_ANY_CLOSEST_POINT = prove (`!s a b:real^N. b IN s /\ (!x. x IN s ==> orthogonal (x - b) (a - b)) ==> (!x. x IN s ==> dist(a,b) <= dist(a,x))`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `b:real^N` THEN REWRITE_TAC[dist; NORM_LE; orthogonal; VECTOR_SUB_RZERO] THEN SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REWRITE_TAC[DOT_POS_LE; REAL_ARITH `a <= a - &0 - (&0 - x) <=> &0 <= x`]);; let CLOSEST_POINT_AFFINE_ORTHOGONAL = prove (`!s a:real^N x. affine s /\ ~(s = {}) /\ x IN s ==> orthogonal (x - closest_point s a) (a - closest_point s a)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSEST_POINT_EXISTS THEN ASM_SIMP_TAC[CLOSED_AFFINE]);; let CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ = prove (`!s a b:real^N. affine s /\ b IN s ==> (closest_point s a = b <=> !x. x IN s ==> orthogonal (x - b) (a - b))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[CLOSEST_POINT_AFFINE_ORTHOGONAL; MEMBER_NOT_EMPTY]; DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CLOSEST_POINT_UNIQUE THEN ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_IMP_CONVEX] THEN MATCH_MP_TAC ORTHOGONAL_ANY_CLOSEST_POINT THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Using "closest_point" to give orthogonal projection onto a subspace *) (* ------------------------------------------------------------------------- *) let CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ = prove (`!s a b:real^N. subspace s ==> (closest_point s a = b <=> b IN s /\ (!x. x IN s ==> orthogonal (a - b) x))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(b:real^N) IN s` THENL [ASM_SIMP_TAC[CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ; SUBSPACE_IMP_AFFINE]; ASM_MESON_TAC[CLOSEST_POINT_IN_SET; CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY]] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ORTHOGONAL_SYM] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `b + x:real^N`); FIRST_X_ASSUM(MP_TAC o SPEC `x - b:real^N`)] THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_ADD; VECTOR_ADD_SUB]);; let CLOSEST_POINT_SUBSPACE_ORTHOGONAL = prove (`!s a b:real^N. subspace s /\ b IN s ==> orthogonal (a - closest_point s a) b`, MESON_TAC[CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ]);; let LINEAR_CLOSEST_POINT = prove (`!s:real^N->bool. subspace s ==> linear(closest_point s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ] THEN ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; CLOSEST_POINT_IN_SET; CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY] THENL [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x + y) - (a + b):real^N = (x - a) + (y - b)`] THEN MATCH_MP_TAC(el 8 (CONJUNCTS ORTHOGONAL_CLAUSES)); REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; ORTHOGONAL_MUL]] THEN ASM_MESON_TAC[CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ]);; let SELF_ADJOINT_CLOSEST_POINT = prove (`!s:real^N->bool. subspace s ==> adjoint(closest_point s) = closest_point s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `closest_point(s:real^N->bool)` ORTHOGONAL_PROJECTION_EQ_SELF_ADJOINT_IDEMPOTENT) THEN ASM_SIMP_TAC[ORTHOGONAL_PROJECTION_ALT; LINEAR_CLOSEST_POINT; ETA_AX] THEN MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`) THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN REWRITE_TAC[ORTHOGONAL_LNEG] THEN MATCH_MP_TAC CLOSEST_POINT_SUBSPACE_ORTHOGONAL THEN ASM_SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY]);; let CLOSEST_POINT_IDEMPOTENT = prove (`!s:real^N->bool. closed s ==> closest_point s o closest_point s = closest_point s`, REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[closest_point; NOT_IN_EMPTY]; ASM_SIMP_TAC[CLOSEST_POINT_SELF; CLOSEST_POINT_IN_SET]]);; let MATRIX_INV_PROJECTION_IMAGE,MATRIX_INV_PROJECTION_IMAGE_ALT = (CONJ_PAIR o prove) (`(!A:real^M^N. A ** matrix_inv A = matrix(closest_point (IMAGE (\x. A ** x) UNIV))) /\ (!A:real^M^N x. (A ** matrix_inv A) ** x = closest_point (IMAGE (\x. A ** x) UNIV) x)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; GSYM MATRIX_VECTOR_MUL_ASSOC; LINEAR_CLOSEST_POINT; MATRIX_VECTOR_MUL_LINEAR; SUBSPACE_LINEAR_IMAGE; SUBSPACE_UNIV; CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ] THEN REPEAT GEN_TAC THEN (CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[FORALL_IN_IMAGE]]) THEN REWRITE_TAC[MOORE_PENROSE_PSEUDOINVERSE]);; (* ------------------------------------------------------------------------- *) (* Stronger separating hyperplane results for affine sets / affine hulls. *) (* ------------------------------------------------------------------------- *) let SEPARATING_HYPERPLANE_AFFINE_AFFINE = prove (`!s t:real^N->bool. affine s /\ affine t /\ ~(s = {}) /\ ~(t = {}) /\ DISJOINT s t ==> ?a b c. ~(a = vec 0) /\ b < c /\ (!x. x IN s ==> a dot x = b) /\ (!x. x IN t ==> a dot x = c)`, SUBGOAL_THEN `!s t:real^N->bool. affine s /\ affine t /\ ~(s = {}) /\ ~(t = {}) /\ DISJOINT s t ==> ?a b c. ~(a = vec 0) /\ ~(b = c) /\ (!x. x IN s ==> a dot x = b) /\ (!x. x IN t ==> a dot x = c)` MP_TAC THENL [ALL_TAC; REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`;` c:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = y) ==> x < y \/ y < x`)) THENL [MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`; `c:real`]; MAP_EVERY EXISTS_TAC [`--a:real^N`; `--b:real`; `--c:real`]] THEN ASM_REWRITE_TAC[REAL_LT_NEG2; DOT_LNEG; REAL_EQ_NEG2] THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0]] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?u v. u IN s /\ v IN t /\ !x y:real^N. x IN s /\ y IN t ==> dist(u,v) <= dist(x,y)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] CLOSEST_POINT_EXISTS) THEN ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_DIFFERENCES; DIST_0] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC; dist] THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `d:real^N = u - v` THEN EXISTS_TAC `d:real^N` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [EXPAND_TAC "d" THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM SET_TAC[]; DISCH_TAC] THEN MAP_EVERY EXISTS_TAC [`(d:real^N) dot u`; `(d:real^N) dot v`] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM DOT_RSUB] THEN ASM_REWRITE_TAC[DOT_EQ_0] THEN CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N`; `u:real^N`] ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL); MP_TAC(ISPECL [`t:real^N->bool`; `u:real^N`; `v:real^N`] ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL)] THEN (ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN ASM_REWRITE_TAC[GSYM orthogonal] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ORTHOGONAL_LNEG] THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB]);; let SEPARATING_HYPERPLANE_AFFINE_HULLS = prove (`!s t:real^N->bool. ~(s = {}) /\ ~(t = {}) /\ DISJOINT (affine hull s) (affine hull t) ==> ?a b c. ~(a = vec 0) /\ b < c /\ (!x. x IN s ==> a dot x = b) /\ (!x. x IN t ==> a dot x = c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`affine hull s:real^N->bool`; `affine hull t:real^N->bool`] SEPARATING_HYPERPLANE_AFFINE_AFFINE) THEN ASM_REWRITE_TAC[AFFINE_HULL_EQ_EMPTY; AFFINE_AFFINE_HULL] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN MESON_TAC[HULL_INC]);; (* ------------------------------------------------------------------------- *) (* Various point-to-set separating/supporting hyperplane theorems. *) (* ------------------------------------------------------------------------- *) let SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP = prove (`!a c s:real^N->bool. compact s /\ ~(s = {}) ==> ?b y. y IN s /\ a dot (y - c) = b /\ (!x. x IN s ==> a dot (x - c) <= b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. a dot (x - c)`; `s:real^N->bool`] CONTINUOUS_ATTAINS_SUP) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN SUBGOAL_THEN `(\x:real^N. a dot (x - c)) = (\x. a dot x) o (\x. x - c)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_LIFT_DOT; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; let SUPPORTING_HYPERPLANE_COMPACT_POINT_INF = prove (`!a c s:real^N->bool. compact s /\ ~(s = {}) ==> ?b y. y IN s /\ a dot (y - c) = b /\ (!x. x IN s ==> a dot (x - c) >= b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `c:real^N`; `s:real^N->bool`] SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` (fun th -> EXISTS_TAC `--b:real` THEN MP_TAC th)) THEN REWRITE_TAC[DOT_LNEG; REAL_ARITH `x >= -- b <=> --x <= b`] THEN REWRITE_TAC[REAL_NEG_EQ]);; let SUPPORTING_HYPERPLANE_CLOSED_POINT = prove (`!s z:real^N. convex s /\ closed s /\ ~(s = {}) /\ ~(z IN s) ==> ?a b y. a dot z < b /\ y IN s /\ (a dot y = b) /\ (!x. x IN s ==> a dot x >= b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `y - z:real^N` THEN EXISTS_TAC `(y - z:real^N) dot y` THEN EXISTS_TAC `y:real^N` THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN ASM_REWRITE_TAC[GSYM DOT_RSUB; DOT_POS_LT; VECTOR_SUB_EQ] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!u. &0 <= u /\ u <= &1 ==> dist(z:real^N,y) <= dist(z,(&1 - u) % y + u % x)` MP_TAC THENL [ASM_MESON_TAC[CONVEX_ALT]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[real_ge; REAL_NOT_LE; NOT_FORALL_THM; NOT_IMP] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `x < y <=> y - x > &0`] THEN REWRITE_TAC[VECTOR_ARITH `(a - b) dot x - (a - b) dot y = (b - a) dot (y - x)`] THEN DISCH_THEN(MP_TAC o MATCH_MP CLOSER_POINT_LEMMA) THEN REWRITE_TAC[VECTOR_ARITH `y + u % (x - y) = (&1 - u) % y + u % x`] THEN MESON_TAC[REAL_LT_IMP_LE]);; let SEPARATING_HYPERPLANE_CLOSED_POINT_INSET = prove (`!s z:real^N. convex s /\ closed s /\ ~(s = {}) /\ ~(z IN s) ==> ?a b. a IN s /\ (a - z) dot z < b /\ (!x. x IN s ==> (a - z) dot x > b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(y - z:real^N) dot z + norm(y - z) pow 2 / &2` THEN SUBGOAL_THEN `&0 < norm(y - z:real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[NORM_POS_LT; VECTOR_SUB_EQ]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_ADDR; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[NORM_POW_2; REAL_ARITH `a > b + c <=> c < a - b`] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN REWRITE_TAC[VECTOR_ARITH `((y - z) dot x - (y - z) dot z) * &2 - (y - z) dot (y - z) = &2 * ((y - z) dot (x - y)) + (y - z) dot (y - z)`] THEN MATCH_MP_TAC(REAL_ARITH `~(--x > &0) /\ &0 < y ==> &0 < &2 * x + y`) THEN ASM_SIMP_TAC[GSYM NORM_POW_2; REAL_POW_LT] THEN REWRITE_TAC[GSYM DOT_LNEG; VECTOR_NEG_SUB] THEN DISCH_THEN(MP_TAC o MATCH_MP CLOSER_POINT_LEMMA) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[REAL_NOT_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_ARITH `y + u % (x - y) = (&1 - u) % y + u % x`] THEN ASM_MESON_TAC[CONVEX_ALT; REAL_LT_IMP_LE]);; let SEPARATING_HYPERPLANE_CLOSED_0_INSET = prove (`!s:real^N->bool. convex s /\ closed s /\ ~(s = {}) /\ ~(vec 0 IN s) ==> ?a b. a IN s /\ ~(a = vec 0) /\ &0 < b /\ (!x. x IN s ==> a dot x > b)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SEPARATING_HYPERPLANE_CLOSED_POINT_INSET) THEN REWRITE_TAC[DOT_RZERO; real_gt] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[VECTOR_SUB_RZERO] THEN ASM_MESON_TAC[]);; let SEPARATING_HYPERPLANE_CLOSED_POINT = prove (`!s z:real^N. convex s /\ closed s /\ ~(z IN s) ==> ?a b. a dot z < b /\ (!x. x IN s ==> a dot x > b)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`--z:real^N`; `&1`] THEN SIMP_TAC[DOT_LNEG; REAL_ARITH `&0 <= x ==> --x < &1`; DOT_POS_LE] THEN ASM_MESON_TAC[NOT_IN_EMPTY]; ALL_TAC] THEN ASM_MESON_TAC[SEPARATING_HYPERPLANE_CLOSED_POINT_INSET]);; let SEPARATING_HYPERPLANE_CLOSED_0 = prove (`!s:real^N->bool. convex s /\ closed s /\ ~(vec 0 IN s) ==> ?a b. ~(a = vec 0) /\ &0 < b /\ (!x. x IN s ==> a dot x > b)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `basis 1:real^N` THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01; GSYM NORM_POS_LT] THEN ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_LT_01]; FIRST_X_ASSUM(MP_TAC o MATCH_MP SEPARATING_HYPERPLANE_CLOSED_POINT) THEN REWRITE_TAC[DOT_RZERO; real_gt] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; DOT_LZERO; REAL_LT_ANTISYM]]);; (* ------------------------------------------------------------------------- *) (* Now set-to-set for closed/compact sets. *) (* ------------------------------------------------------------------------- *) let SEPARATING_HYPERPLANE_CLOSED_COMPACT = prove (`!s t. convex s /\ closed s /\ convex t /\ compact t /\ ~(t = {}) /\ DISJOINT s t ==> ?a:real^N b. (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?z:real^N. norm(z) = b + &1` CHOOSE_TAC THENL [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE; REAL_ARITH `&0 < b ==> &0 <= b + &1`]; ALL_TAC] THEN MP_TAC(SPECL [`t:real^N->bool`; `z:real^N`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM_MESON_TAC[REAL_ARITH `~(b + &1 <= b)`]; ALL_TAC] THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0 :real^N`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; CONVEX_DIFFERENCES] THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_MESON_TAC[DISJOINT; NOT_IN_EMPTY; IN_INTER; EXTENSION]; ALL_TAC] THEN SIMP_TAC[DOT_RZERO; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; DOT_RSUB] THEN REWRITE_TAC[real_gt; REAL_LT_SUB_LADD] THEN DISCH_TAC THEN EXISTS_TAC `--a:real^N` THEN MP_TAC(SPEC `IMAGE (\x:real^N. a dot x) t` SUP) THEN ABBREV_TAC `k = sup (IMAGE (\x:real^N. a dot x) t)` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ARITH `b + x < y ==> x <= y - b`; MEMBER_NOT_EMPTY]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `--(k + b / &2)` THEN REWRITE_TAC[DOT_LNEG; REAL_LT_NEG2] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_ARITH `&0 < b /\ x <= k ==> x < k + b`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `k - b / &2`) THEN ASM_SIMP_TAC[REAL_ARITH `k <= k - b2 <=> ~(&0 < b2)`; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `!b. (b2 + b2 = b) /\ b + ay < ax ==> ~(ay <= k - b2) ==> k + b2 < ax`) THEN ASM_MESON_TAC[REAL_HALF]);; let SEPARATING_HYPERPLANE_COMPACT_CLOSED = prove (`!s t. convex s /\ compact s /\ ~(s = {}) /\ convex t /\ closed t /\ DISJOINT s t ==> ?a:real^N b. (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`] SEPARATING_HYPERPLANE_CLOSED_COMPACT) THEN ANTS_TAC THENL [ASM_MESON_TAC[DISJOINT_SYM]; ALL_TAC] THEN REWRITE_TAC[real_gt] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC)) THEN MAP_EVERY EXISTS_TAC [`--a:real^N`; `--b:real`] THEN ASM_REWRITE_TAC[REAL_LT_NEG2; DOT_LNEG]);; let SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO = prove (`!s t:real^N->bool. convex s /\ compact s /\ ~(s = {}) /\ convex t /\ closed t /\ DISJOINT s t ==> ?a b. ~(a = vec 0) /\ (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN EXISTS_TAC `basis 1:real^N` THEN SUBGOAL_THEN `bounded(IMAGE (\x:real^N. lift(basis 1 dot x)) s)` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DOT]; REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_IMAGE; NORM_LIFT] THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN MESON_TAC[REAL_ARITH `abs x < b ==> x < b`]]; STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] SEPARATING_HYPERPLANE_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DOT_LZERO; real_gt] THEN ASM_MESON_TAC[REAL_LT_ANTISYM; MEMBER_NOT_EMPTY]]);; let SEPARATING_HYPERPLANE_COMPACT_COMPACT = prove (`!s t:real^N->bool. convex s /\ compact s /\ convex t /\ compact t /\ DISJOINT s t ==> ?a b. ~(a = vec 0) /\ (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN EXISTS_TAC `--basis 1:real^N` THEN SUBGOAL_THEN `bounded(IMAGE (\x:real^N. lift(basis 1 dot x)) t)` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DOT]; REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_IMAGE; NORM_LIFT] THEN SIMP_TAC[VECTOR_NEG_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `--b:real` THEN REWRITE_TAC[DOT_LNEG] THEN REWRITE_TAC[REAL_ARITH `--x > --y <=> x < y`] THEN ASM_MESON_TAC[REAL_ARITH `abs x < b ==> x < b`]]; STRIP_TAC THEN MATCH_MP_TAC SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);; (* ------------------------------------------------------------------------- *) (* General case without assuming closure and getting non-strict separation. *) (* ------------------------------------------------------------------------- *) let SEPARATING_HYPERPLANE_SET_0_INSPAN = prove (`!s:real^N->bool. convex s /\ ~(s = {}) /\ ~(vec 0 IN s) ==> ?a b. a IN span s /\ ~(a = vec 0) /\ !x. x IN s ==> &0 <= a dot x`, REPEAT STRIP_TAC THEN ABBREV_TAC `k = \c:real^N. {x | &0 <= c dot x}` THEN SUBGOAL_THEN `~((span s INTER frontier(cball(vec 0:real^N,&1))) INTER (INTERS (IMAGE k (s:real^N->bool))) = {})` MP_TAC THENL [ALL_TAC; SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_INTERS; NOT_FORALL_THM; FORALL_IN_IMAGE; FRONTIER_CBALL; REAL_LT_01] THEN EXPAND_TAC "k" THEN REWRITE_TAC[IN_SPHERE_0; IN_ELIM_THM; NORM_NEG] THEN MESON_TAC[NORM_EQ_0; REAL_ARITH `~(&1 = &0)`; DOT_SYM]] THEN MATCH_MP_TAC COMPACT_IMP_FIP THEN SIMP_TAC[COMPACT_CBALL; COMPACT_FRONTIER; FORALL_IN_IMAGE; CLOSED_INTER_COMPACT; CLOSED_SPAN] THEN CONJ_TAC THENL [EXPAND_TAC "k" THEN REWRITE_TAC[GSYM real_ge; CLOSED_HALFSPACE_GE]; ALL_TAC] THEN REWRITE_TAC[FINITE_SUBSET_IMAGE] THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` MP_TAC) THEN ASM_CASES_TAC `c:real^N->bool = {}` THENL [ASM_SIMP_TAC[INTERS_0; INTER_UNIV; IMAGE_CLAUSES] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN SUBGOAL_THEN `~(a:real^N = vec 0)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `inv(norm a) % a:real^N` THEN ASM_SIMP_TAC[IN_INTER; FRONTIER_CBALL; SPAN_CLAUSES; IN_SPHERE_0] THEN REWRITE_TAC[DIST_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `convex hull (c:real^N->bool)` SEPARATING_HYPERPLANE_CLOSED_0_INSET) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN ASM_MESON_TAC[CONVEX_CONVEX_HULL; SUBSET; SUBSET_HULL; HULL_SUBSET; FINITE_IMP_COMPACT_CONVEX_HULL; COMPACT_IMP_CLOSED]; ALL_TAC] THEN REWRITE_TAC[DOT_RZERO; real_gt] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC)) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_INTERS; FORALL_IN_IMAGE] THEN EXPAND_TAC "k" THEN SIMP_TAC[IN_ELIM_THM; FRONTIER_CBALL; REAL_LT_01] THEN REWRITE_TAC[dist; VECTOR_SUB_LZERO; NORM_NEG] THEN EXISTS_TAC `inv(norm(a)) % a:real^N` THEN REWRITE_TAC[DOT_RMUL] THEN SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; HULL_MINIMAL]; ASM_SIMP_TAC[SPAN_CLAUSES]] THEN REWRITE_TAC[IN_SPHERE_0; VECTOR_SUB_LZERO; NORM_NEG; NORM_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_EQ_LDIV_EQ; NORM_POS_LT] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS; HULL_SUBSET; SUBSET; DOT_SYM]);; let SEPARATING_HYPERPLANE_SET_POINT_INAFF = prove (`!s z:real^N. convex s /\ ~(s = {}) /\ ~(z IN s) ==> ?a b. (z + a) IN affine hull (z INSERT s) /\ ~(a = vec 0) /\ a dot z <= b /\ (!x. x IN s ==> a dot x >= b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^N. --z + x) s` SEPARATING_HYPERPLANE_SET_0_INSPAN) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; CONVEX_TRANSLATION; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --z + x <=> x = z`] THEN ASM_SIMP_TAC[UNWIND_THM2; AFFINE_HULL_INSERT_SPAN; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; VECTOR_ARITH `--x + y:real^N = y - x`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `(a:real^N) dot z` THEN REWRITE_TAC[REAL_LE_REFL] THEN ASM_REWRITE_TAC[REAL_ARITH `x >= y <=> &0 <= x - y`; GSYM DOT_RSUB]);; let SEPARATING_HYPERPLANE_SET_0 = prove (`!s:real^N->bool. convex s /\ ~(vec 0 IN s) ==> ?a b. ~(a = vec 0) /\ !x. x IN s ==> &0 <= a dot x`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; ASM_MESON_TAC[SEPARATING_HYPERPLANE_SET_0_INSPAN]]);; let SEPARATING_HYPERPLANE_SETS = prove (`!s t. convex s /\ convex t /\ ~(s = {}) /\ ~(t = {}) /\ DISJOINT s t ==> ?a:real^N b. ~(a = vec 0) /\ (!x. x IN s ==> a dot x <= b) /\ (!x. x IN t ==> a dot x >= b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{y - x:real^N | y IN t /\ x IN s}` SEPARATING_HYPERPLANE_SET_0) THEN ASM_SIMP_TAC[CONVEX_DIFFERENCES] THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_MESON_TAC[DISJOINT; NOT_IN_EMPTY; IN_INTER; EXTENSION]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; DOT_RSUB; REAL_SUB_LE] THEN DISCH_TAC THEN MP_TAC(SPEC `IMAGE (\x:real^N. a dot x) s` SUP) THEN ABBREV_TAC `k = sup (IMAGE (\x:real^N. a dot x) s)` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY; real_ge] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* More convexity generalities. *) (* ------------------------------------------------------------------------- *) let UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX = prove (`!s c:real^N->bool. convex s /\ c IN components((:real^N) DIFF s) ==> ~bounded c`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[DIFF_EMPTY; COMPONENTS_UNIV; IN_SING; NOT_BOUNDED_UNIV] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `{a:real^N}`] SEPARATING_HYPERPLANE_SETS) THEN ASM_REWRITE_TAC[CONVEX_SING; NOT_IMP] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`v:real^N`; `d:real`] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN DISCH_THEN(MP_TAC o SPEC `a INSERT {x:real^N | ~(v dot x <= d)}`) THEN REWRITE_TAC[BOUNDED_INSERT] THEN ASM_REWRITE_TAC[BOUNDED_HALFSPACE_GT; GSYM real_gt; REAL_NOT_LE] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `(:real^N) DIFF s` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[CONNECTED_INSERT; CONVEX_HALFSPACE_GT; CONVEX_CONNECTED] THEN DISJ2_TAC THEN ASM_SIMP_TAC[CLOSURE_HALFSPACE_GT] THEN ASM SET_TAC[]; ASM_REWRITE_TAC[INSERT_SUBSET; IN_DIFF; IN_UNIV] THEN ASM_REWRITE_TAC[real_gt; IN_ELIM_THM; REAL_NOT_LT; SET_RULE `s SUBSET UNIV DIFF t <=> !x. x IN t ==> ~(x IN s)`]; ASM SET_TAC[]]);; let UNBOUNDED_COMPLEMENT_CONVEX = prove (`!c. convex c /\ ~(c = (:real^N)) ==> ~bounded((:real^N) DIFF c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF c` COMPONENTS_EQ_EMPTY) THEN ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX)) THEN ASM_MESON_TAC[BOUNDED_SUBSET; IN_COMPONENTS_SUBSET]);; let COMPONENTS_CONVEX_COMPLEMENT_CONTAINS_HALFSPACE = prove (`!s c. convex s /\ c IN components((:real^N) DIFF s) ==> ?a b. ~(a = vec 0) /\ {x | a dot x <= b} SUBSET c`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_SIMP_TAC[DIFF_EMPTY; COMPONENTS_UNIV; IN_SING; SUBSET_UNIV] THEN MESON_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM MEMBER_NOT_EMPTY] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP IN_COMPONENTS_SUBSET) THEN DISCH_THEN(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`] SEPARATING_HYPERPLANE_SET_POINT_INAFF) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `b - &1` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `z INSERT {x:real^N | a dot x < b}` THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INSERT] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `(:real^N) DIFF s` THEN ASM_SIMP_TAC[CONVEX_HALFSPACE_LT; CONVEX_CONNECTED; CONNECTED_INSERT; CLOSURE_HALFSPACE_LT; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[INSERT_SUBSET; IN_UNIV; IN_DIFF] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x} SUBSET UNIV DIFF s <=> s SUBSET {x | ~P x}`] THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_ARITH `~(a < b) <=> a >= b`]);; let CARD_COMPONENTS_COMPLEMENT_CONVEX,FINITE_COMPONENTS_COMPLEMENT_CONVEX = (CONJ_PAIR o prove) (`(!s. convex s ==> CARD(components((:real^N) DIFF s)) <= 2) /\ (!s. convex s ==> FINITE(components((:real^N) DIFF s)))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN ASM_CASES_TAC `convex(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `x <= 2 <=> ~(3 <= x)`] THEN REWRITE_TAC[TAUT `~p /\ q <=> ~(q ==> p)`] THEN DISCH_THEN(MP_TAC o MATCH_MP CHOOSE_SUBSET_STRONG) THEN REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 3`] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:(real^N->bool)->bool`; `c1:real^N->bool`; `c2:real^N->bool`; `c3:real^N->bool`] THEN ASM_CASES_TAC `t = {c1:real^N->bool,c2,c3}` THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`c1:real^N->bool`; `c2:real^N->bool`] th) THEN MP_TAC(SPECL [`c2:real^N->bool`; `c3:real^N->bool`] th) THEN MP_TAC(SPECL [`c3:real^N->bool`; `c1:real^N->bool`] th)) THEN ASM_REWRITE_TAC[GSYM DISJOINT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` COMPONENTS_CONVEX_COMPLEMENT_CONTAINS_HALFSPACE) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `c3:real^N->bool` th) THEN MP_TAC(SPEC `c2:real^N->bool` th) THEN MP_TAC(SPEC `c1:real^N->bool` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a1:real^N`; `b1:real`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`a2:real^N`; `b2:real`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`a3:real^N`; `b3:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `?c. &0 < c /\ (a3:real^N = c % a1 \/ a2 = c % a1 \/ a3:real^N = c % a2)` MP_TAC THENL [MP_TAC(ISPECL [`a1:real^N`; `a3:real^N`; `b1:real`; `b3:real`] (el 6 (CONJUNCTS DISJOINT_HALFSPACES_IMP_COLLINEAR))) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`a1:real^N`; `a2:real^N`; `b1:real`; `b2:real`] (el 6 (CONJUNCTS DISJOINT_HALFSPACES_IMP_COLLINEAR))) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c2:real` THEN ASM_CASES_TAC `c2 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN X_GEN_TAC `c3:real` THEN ASM_CASES_TAC `c3 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN ASM_CASES_TAC `&0 < c2` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `&0 < c3` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `c3 / c2:real` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x / y <=> &0 < --x * --inv y`] THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[GSYM REAL_INV_NEG; REAL_LT_INV_EQ] THEN ASM_REAL_ARITH_TAC; REPEAT DISJ2_TAC THEN MAP_EVERY EXPAND_TAC ["a2"; "a3"] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(c2 = &0)` THEN CONV_TAC REAL_FIELD]; ALL_TAC] THEN STRIP_TAC THENL [SUBGOAL_THEN `DISJOINT {x:real^N | a1 dot x <= b1} {x | a3 dot x <= b3}` MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]; SUBGOAL_THEN `DISJOINT {x:real^N | a1 dot x <= b1} {x | a2 dot x <= b2}` MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]; SUBGOAL_THEN `DISJOINT {x:real^N | a2 dot x <= b2} {x | a3 dot x <= b3}` MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]] THEN REWRITE_TAC[DOT_LMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN MATCH_MP_TAC(SET_RULE `{x | f x <= min a b} SUBSET {x | f x <= a} /\ {x | f x <= min a b} SUBSET {x | f x <= b} /\ ~({x | f x <= min a b} = {}) ==> ~DISJOINT {x | f x <= a} {x | f x <= b}`) THEN ASM_REWRITE_TAC[HALFSPACE_EQ_EMPTY_LE; SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CONVEX_CLOSURE = prove (`!s:real^N->bool. convex s ==> convex(closure s)`, REWRITE_TAC[convex; CLOSURE_SEQUENTIAL] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num->real^N`) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:num->real^N`) MP_TAC) THEN STRIP_TAC THEN EXISTS_TAC `\n:num. u % a(n) + v % b(n) :real^N` THEN ASM_SIMP_TAC[LIM_ADD; LIM_CMUL]);; let CONVEX_INTERIOR = prove (`!s:real^N->bool. convex s ==> convex(interior s)`, REWRITE_TAC[CONVEX_ALT; IN_INTERIOR; SUBSET; IN_BALL; dist] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `e:real`) STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `z:real^N = (&1 - u) % (z - u % (y - x)) + u % (z + (&1 - u) % (y - x))`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[VECTOR_ARITH `x - (z - u % (y - x)) = ((&1 - u) % x + u % y) - z:real^N`; VECTOR_ARITH `y - (z + (&1 - u) % (y - x)) = ((&1 - u) % x + u % y) - z:real^N`]);; let CONVEX_HULL_CLOSURE_SUBSET = prove (`!s:real^N->bool. convex hull (closure s) SUBSET closure(convex hull s)`, GEN_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[SUBSET_CLOSURE; HULL_SUBSET; CONVEX_CLOSURE; CONVEX_CONVEX_HULL]);; let CONVEX_HULL_CLOSURE = prove (`!s. bounded s ==> convex hull (closure s) = closure(convex hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[CONVEX_HULL_CLOSURE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[HULL_MONO; CLOSURE_SUBSET] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]);; let SUPPORTING_HYPERPLANE_POINT = prove (`!s z:real^N. convex s /\ ~(s = {}) /\ ~(z IN s) ==> ?a b y. ~(a = vec 0) /\ a dot z <= b /\ y IN closure s /\ a dot y = b /\ !x. x IN closure s ==> a dot x >= b`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(z:real^N) IN closure s` THENL [MP_TAC(ISPECL [`{z:real^N}`; `s:real^N->bool`] SEPARATING_HYPERPLANE_SETS) THEN ASM_REWRITE_TAC[CONVEX_SING] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `a dot (z:real^N)`; `z:real^N`] THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ONCE_REWRITE_TAC[SET_RULE `a dot x >= b <=> x IN {x | a dot x >= b}`] THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN ASM_REWRITE_TAC[IN_ELIM_THM; CONTINUOUS_ON_ID; CLOSED_HALFSPACE_GE] THEN ASM_MESON_TAC[real_ge; REAL_LE_TRANS]; MP_TAC(ISPECL [`closure s:real^N->bool`; `z:real^N`] SUPPORTING_HYPERPLANE_CLOSED_POINT)THEN ASM_SIMP_TAC[CLOSED_CLOSURE; CONVEX_CLOSURE; CLOSURE_EQ_EMPTY] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[DOT_LZERO] THEN MESON_TAC[REAL_LT_REFL]]);; let CONVEX_ON_SETDIST = prove (`!s t:real^N->bool. convex t ==> (\x. setdist ({x},t)) convex_on s`, SUBGOAL_THEN `!s t:real^N->bool. convex t /\ closed t ==> (\x. setdist ({x},t)) convex_on s` MP_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `closure t:real^N->bool`]) THEN ASM_SIMP_TAC[CLOSED_CLOSURE; SETDIST_CLOSURE; CONVEX_CLOSURE]] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[convex_on] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[SETDIST_EMPTY; REAL_MUL_RZERO; REAL_ADD_RID; REAL_LE_REFL] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN MP_TAC(ISPECL [`{y:real^N}`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; COMPACT_SING; UNWIND_THM2; SETDIST_CLOSURE; CLOSURE_EQ_EMPTY; RIGHT_EXISTS_AND_THM; IN_SING] THEN DISCH_THEN(X_CHOOSE_THEN `y':real^N` (STRIP_ASSUME_TAC o GSYM)) THEN DISCH_THEN(X_CHOOSE_THEN `x':real^N` (STRIP_ASSUME_TAC o GSYM)) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `dist(u % x + v % y:real^N,u % x' + v % y')` THEN CONJ_TAC THENL [MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[IN_SING] THEN ASM_MESON_TAC[convex]; REWRITE_TAC[dist] THEN MATCH_MP_TAC(NORM_ARITH `norm(a - a':real^N) + norm(b - b') <= r ==> norm((a + b) - (a' + b')) <= r`) THEN ASM_REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL; dist] THEN ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Moving and scaling convex hulls. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_TRANSLATION = prove (`!a:real^N s. convex hull (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (convex hull s)`, REPEAT GEN_TAC THEN MATCH_MP_TAC HULL_IMAGE THEN REWRITE_TAC[CONVEX_TRANSLATION_EQ; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN VECTOR_ARITH_TAC);; add_translation_invariants [CONVEX_HULL_TRANSLATION];; let CONVEX_HULL_SCALING = prove (`!s:real^N->bool c. convex hull (IMAGE (\x. c % x) s) = IMAGE (\x. c % x) (convex hull s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [ASM_SIMP_TAC[IMAGE_CONST; VECTOR_MUL_LZERO; CONVEX_HULL_EQ_EMPTY] THEN COND_CASES_TAC THEN REWRITE_TAC[CONVEX_HULL_EMPTY; CONVEX_HULL_SING]; ALL_TAC] THEN MATCH_MP_TAC HULL_IMAGE THEN ASM_SIMP_TAC[CONVEX_SCALING_EQ; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[VECTOR_ARITH `c % x = c % y <=> c % (x - y) = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN X_GEN_TAC `x:real^N` THEN EXISTS_TAC `inv c % x:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]);; let CONVEX_HULL_AFFINITY = prove (`!s a:real^N c. convex hull (IMAGE (\x. c % x + a) s) = IMAGE (\x. c % x + a) (convex hull s)`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINITY_SCALING_TRANSLATION] THEN ASM_SIMP_TAC[IMAGE_o; CONVEX_HULL_TRANSLATION; CONVEX_HULL_SCALING]);; (* ------------------------------------------------------------------------- *) (* Convex set as intersection of halfspaces. *) (* ------------------------------------------------------------------------- *) let CONVEX_HALFSPACE_INTERSECTION = prove (`!s. closed(s:real^N->bool) /\ convex s ==> s = INTERS {h | s SUBSET h /\ ?a b. h = {x | a dot x <= b}}`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[MESON[] `(!t. (P t /\ ?a b. t = x a b) ==> Q t) <=> (!a b. P(x a b) ==> Q(x a b))`] THEN EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`--a:real^N`; `--b:real`]) THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; DOT_LNEG; NOT_IMP] THEN ASM_SIMP_TAC[REAL_LE_NEG2; REAL_LT_NEG2; REAL_NOT_LE; REAL_ARITH `a > b ==> b <= a`]);; (* ------------------------------------------------------------------------- *) (* Radon's theorem (from Lars Schewe). *) (* ------------------------------------------------------------------------- *) let RADON_EX_LEMMA = prove (`!(c:real^N->bool). FINITE c /\ affine_dependent c ==> (?u. sum c u = &0 /\ (?v. v IN c /\ ~(u v = &0)) /\ vsum c (\v. u v % v) = (vec 0):real^N)`, REWRITE_TAC[AFFINE_DEPENDENT_EXPLICIT] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `\v:real^N. if v IN s then u v else &0` THEN ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET] THEN ASM_SIMP_TAC[COND_RAND;COND_RATOR; VECTOR_MUL_LZERO;GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `s SUBSET c ==> {x | x IN c /\ x IN s} = s`] THEN EXISTS_TAC `v:real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let RADON_S_LEMMA = prove (`!(s:A->bool) f. FINITE s /\ sum s f = &0 ==> sum {x | x IN s /\ &0 < f x} f = -- sum {x | x IN s /\ f x < &0} f`, REWRITE_TAC[REAL_ARITH `a = --b <=> a + b = &0`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FINITE_RESTRICT;GSYM SUM_UNION; REWRITE_RULE [REAL_ARITH `&0 < f x ==> ~(f x < &0)`] (SET_RULE `(!x:A. &0 < f x ==> ~(f x < &0)) ==> DISJOINT {x | x IN s /\ &0 < f x} {x | x IN s /\ f x < &0}`)] THEN MATCH_MP_TAC (REAL_ARITH `!a b.a = &0 /\ a + b = &0 ==> b = &0`) THEN EXISTS_TAC `sum {x:A | x IN s /\ f x = &0} f` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_RESTRICT_SET] THEN REWRITE_TAC[COND_ID;SUM_0]; ALL_TAC] THEN SUBGOAL_THEN `DISJOINT {x:A | x IN s /\ f x = &0} ({x | x IN s /\ &0 < f x} UNION {x | x IN s /\ f x < &0})` ASSUME_TAC THENL [REWRITE_TAC[DISJOINT;UNION;INTER;IN_ELIM_THM;EXTENSION;NOT_IN_EMPTY] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[FINITE_UNION;FINITE_RESTRICT;GSYM SUM_UNION] THEN FIRST_X_ASSUM (SUBST1_TAC o GSYM) THEN MATCH_MP_TAC (MESON[] `a = b ==> sum a f = sum b f`) THEN REWRITE_TAC[EXTENSION;IN_ELIM_THM;UNION] THEN MESON_TAC[REAL_LT_TOTAL]);; let RADON_V_LEMMA = prove (`!(s:A->bool) f g. FINITE s /\ vsum s f = vec 0 /\ (!x. g x = &0 ==> f x = vec 0) ==> (vsum {x | x IN s /\ &0 < g x} f) :real^N = -- vsum {x | x IN s /\ g x < &0} f`, REWRITE_TAC[VECTOR_ARITH `a:real^N = --b <=> a + b = vec 0`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FINITE_RESTRICT;GSYM VSUM_UNION; REWRITE_RULE [REAL_ARITH `&0 < f x ==> ~(f x < &0)`] (SET_RULE `(!x:A. &0 < f x ==> ~(f x < &0)) ==> DISJOINT {x | x IN s /\ &0 < f x} {x | x IN s /\ f x < &0}`)] THEN MATCH_MP_TAC (VECTOR_ARITH `!a b. (a:real^N) = vec 0 /\ a + b = vec 0 ==> b = vec 0`) THEN EXISTS_TAC `(vsum {x:A | x IN s /\ g x = &0} f):real^N` THEN CONJ_TAC THENL [ASM_SIMP_TAC[VSUM_RESTRICT_SET;COND_ID;VSUM_0];ALL_TAC] THEN SUBGOAL_THEN `DISJOINT {x:A | x IN s /\ g x = &0} ({x | x IN s /\ &0 < g x} UNION {x | x IN s /\ g x < &0})` ASSUME_TAC THENL [REWRITE_TAC[DISJOINT;UNION;INTER;IN_ELIM_THM;EXTENSION;NOT_IN_EMPTY] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[FINITE_UNION;FINITE_RESTRICT;GSYM VSUM_UNION] THEN FIRST_X_ASSUM (SUBST1_TAC o GSYM) THEN MATCH_MP_TAC (MESON[] `a = b ==> vsum a f = vsum b f`) THEN REWRITE_TAC[EXTENSION;IN_ELIM_THM;UNION] THEN MESON_TAC[REAL_LT_TOTAL]);; let RADON_PARTITION = prove (`!(c:real^N->bool). FINITE c /\ affine_dependent c ==> ?(m:real^N->bool) (p:real^N->bool). (DISJOINT m p) /\ (m UNION p = c) /\ ~(DISJOINT (convex hull m) (convex hull p))`, REPEAT STRIP_TAC THEN MP_TAC (ISPEC `c:real^N->bool` RADON_EX_LEMMA) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{v:real^N | v IN c /\ u v <= &0}`; `{v:real^N | v IN c /\ u v > &0}`] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[DISJOINT;INTER; IN_ELIM_THM;REAL_ARITH `x <= &0 <=> ~(x > &0)`] THEN SET_TAC[]; REWRITE_TAC[UNION;IN_ELIM_THM;REAL_ARITH `x <= &0 <=> ~(x > &0)`] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(sum {x:real^N | x IN c /\ u x > &0} u = &0)` ASSUME_TAC THENL [MATCH_MP_TAC (REAL_ARITH `a > &0 ==> ~(a = &0)`) THEN REWRITE_TAC[REAL_ARITH `a > &0 <=> &0 < a`] THEN MATCH_MP_TAC (REWRITE_RULE[SUM_0] (ISPEC `\x. &0` SUM_LT_ALL)) THEN ASM_SIMP_TAC[FINITE_RESTRICT;IN_ELIM_THM;EXTENSION;NOT_IN_EMPTY] THEN REWRITE_TAC[MESON[]`~(!x. ~(P x /\ Q x)) = ?x. P x /\ Q x`] THEN ASM_CASES_TAC `&0 < u (v:real^N)` THENL [ASM SET_TAC[];ALL_TAC] THEN POP_ASSUM MP_TAC THEN POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP;REAL_ARITH `~(a = &0) /\ ~(&0 < a) <=> a < &0`] THEN DISCH_TAC THEN REWRITE_TAC[MESON[REAL_NOT_LT] `(?x:real^N. P x /\ &0 < u x) <=> (!x. P x ==> u x <= &0) ==> F`] THEN DISCH_TAC THEN MP_TAC (ISPECL [`u:real^N->real`;`\x:real^N. &0`;`c:real^N->bool`] SUM_LT) THEN ASM_REWRITE_TAC[SUM_0;REAL_ARITH `~(&0 < &0)`] THEN ASM_MESON_TAC[];ALL_TAC] THEN REWRITE_TAC[SET_RULE `~DISJOINT a b <=> ?y. y IN a /\ y IN b`] THEN EXISTS_TAC `&1 / (sum {x:real^N | x IN c /\ u x > &0} u) % vsum {x:real^N | x IN c /\ u x > &0} (\x. u x % x)` THEN REWRITE_TAC[CONVEX_HULL_EXPLICIT;IN_ELIM_THM] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`{v:real^N | v IN c /\ u v < &0}`; `\y:real^N. &1 / (sum {x:real^N | x IN c /\ u x > &0} u) * (--(u y))`] THEN ASM_SIMP_TAC[FINITE_RESTRICT;SUBSET;IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_NEG_GE0;REAL_LE_LT]] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_01] THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT;IN_ELIM_THM] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[FINITE_RESTRICT;SUM_LMUL] THEN MATCH_MP_TAC (REAL_FIELD `!a. ~(a = &0) /\ a * b = a * c ==> b = c`) THEN EXISTS_TAC `sum {x:real^N | x IN c /\ u x > &0} u` THEN REWRITE_TAC[SUM_LMUL] THEN ASM_SIMP_TAC[REAL_FIELD `~(a = &0) ==> a * &1 / a * b = b`] THEN REWRITE_TAC[SUM_NEG;REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `a > &0 <=> &0 < a`] THEN MATCH_MP_TAC (GSYM RADON_S_LEMMA) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC;VSUM_LMUL;VECTOR_MUL_LCANCEL] THEN REWRITE_TAC[VECTOR_MUL_LNEG;VSUM_NEG] THEN DISJ2_TAC THEN MATCH_MP_TAC (REWRITE_RULE[REAL_ARITH `&0 < a <=> a > &0`] (GSYM RADON_V_LEMMA)) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[VECTOR_MUL_LZERO];ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`{v:real^N | v IN c /\ u v > &0}`; `\y:real^N. &1 / (sum {x:real^N | x IN c /\ u x > &0} u) * (u y)`] THEN ASM_SIMP_TAC[FINITE_RESTRICT;SUBSET;IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_ARITH `a > &0 ==> &0 <= a`]] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_01] THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT;IN_ELIM_THM] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[FINITE_RESTRICT;SUM_LMUL] THEN MATCH_MP_TAC (REAL_FIELD `!a. ~(a = &0) /\ a * b = a * c ==> b = c`) THEN EXISTS_TAC `sum {x:real^N | x IN c /\ u x > &0} u` THEN REWRITE_TAC[SUM_LMUL] THEN ASM_SIMP_TAC[REAL_FIELD `~(a = &0) ==> a * &1 / a * b = b`] THEN REWRITE_TAC[SUM_NEG;REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `a > &0 <=> &0 < a`] THEN MATCH_MP_TAC (GSYM RADON_S_LEMMA) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC;VSUM_LMUL;VECTOR_MUL_LCANCEL] THEN REWRITE_TAC[VECTOR_MUL_LNEG;VSUM_NEG] THEN DISJ2_TAC THEN MATCH_MP_TAC (REWRITE_RULE[REAL_ARITH `&0 < a <=> a > &0`] (GSYM RADON_V_LEMMA)) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[VECTOR_MUL_LZERO]);; let RADON = prove (`!(c:real^N->bool). affine_dependent c ==> ?(m:real^N->bool) (p:real^N->bool). m SUBSET c /\ p SUBSET c /\ DISJOINT m p /\ ~(DISJOINT (convex hull m) (convex hull p))`, REPEAT STRIP_TAC THEN MP_TAC (ISPEC `c:real^N->bool` AFFINE_DEPENDENT_EXPLICIT) THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC (ISPEC `s:real^N->bool` RADON_PARTITION) THEN ANTS_TAC THENL [ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT] THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`;`u:real^N->real`] THEN ASM SET_TAC[];ALL_TAC] THEN DISCH_THEN STRIP_ASSUME_TAC THEN MAP_EVERY EXISTS_TAC [`m:real^N->bool`;`p:real^N->bool`] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Helly's theorem. *) (* ------------------------------------------------------------------------- *) let HELLY_INDUCT = prove (`!n f. f HAS_SIZE n /\ n >= dimindex(:N) + 1 /\ (!s:real^N->bool. s IN f ==> convex s) /\ (!t. t SUBSET f /\ CARD(t) = dimindex(:N) + 1 ==> ~(INTERS t = {})) ==> ~(INTERS f = {})`, INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(0 >= n + 1)`] THEN GEN_TAC THEN POP_ASSUM(LABEL_TAC "*") THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_SIZE_SUC]) THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `SUC n >= m + 1 ==> m = n \/ n >= m + 1`)) THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[CARD_CLAUSES; SUBSET_REFL] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?X. !s:real^N->bool. s IN f ==> X(s) IN INTERS (f DELETE s)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM SKOLEM_THM; MEMBER_NOT_EMPTY; RIGHT_EXISTS_IMP_THM] THEN GEN_TAC THEN STRIP_TAC THEN REMOVE_THEN "*" MATCH_MP_TAC THEN ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `?s t:real^N->bool. s IN f /\ t IN f /\ ~(s = t) /\ X s:real^N = X t` THENL [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `(X:(real^N->bool)->real^N) t` THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC ONCE_DEPTH_CONV [MATCH_MP (SET_RULE`~(s = t) ==> INTERS f = INTERS(f DELETE s) INTER INTERS(f DELETE t)`) th]) THEN REWRITE_TAC[IN_INTER] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE (X:(real^N->bool)->real^N) f` RADON_PARTITION) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE] THEN MATCH_MP_TAC AFFINE_DEPENDENT_BIGGERSET THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN MATCH_MP_TAC(ARITH_RULE `!f n. n >= d + 1 /\ f = SUC n /\ c = f ==> c >= d + 2`) THEN MAP_EVERY EXISTS_TAC [`CARD(f:(real^N->bool)->bool)`; `n:num`] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `P /\ m UNION p = s /\ Q <=> m SUBSET s /\ p SUBSET s /\ m UNION p = s /\ P /\ Q`] THEN REWRITE_TAC[SUBSET_IMAGE; DISJOINT] THEN REWRITE_TAC[MESON[] `(?m p. (?u. P u /\ m = t u) /\ (?u. P u /\ p = t u) /\ Q m p) ==> r <=> (!u v. P u /\ P v /\ Q (t u) (t v) ==> r)`] THEN MAP_EVERY X_GEN_TAC [`g:(real^N->bool)->bool`; `h:(real^N->bool)->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `(f:(real^N->bool)->bool) = h UNION g` SUBST1_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[SUBSET; IN_UNION] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o ISPEC `X:(real^N->bool)->real^N` o MATCH_MP FUN_IN_IMAGE) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN ONCE_REWRITE_TAC[DISJ_SYM] THEN REWRITE_TAC[IN_UNION; IN_IMAGE] THEN MATCH_MP_TAC MONO_OR THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `g SUBSET INTERS g' /\ h SUBSET INTERS h' ==> ~(g INTER h = {}) ==> ~(INTERS(g' UNION h') = {})`) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `IMAGE X s INTER IMAGE X t = {} ==> s INTER t = {}`)) THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET; CONVEX_INTERS]]) THEN REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; let HELLY = prove (`!f:(real^N->bool)->bool. FINITE f /\ CARD(f) >= dimindex(:N) + 1 /\ (!s. s IN f ==> convex s) /\ (!t. t SUBSET f /\ CARD(t) = dimindex(:N) + 1 ==> ~(INTERS t = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HELLY_INDUCT THEN ASM_REWRITE_TAC[HAS_SIZE] THEN ASM_MESON_TAC[]);; let HELLY_ALT = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> convex s) /\ (!t. t SUBSET f /\ CARD(t) <= dimindex(:N) + 1 ==> ~(INTERS t = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `CARD(f:(real^N->bool)->bool) < dimindex(:N) + 1` THEN ASM_SIMP_TAC[SUBSET_REFL; LT_IMP_LE] THEN MATCH_MP_TAC HELLY THEN ASM_SIMP_TAC[GE; GSYM NOT_LT] THEN ASM_MESON_TAC[LE_REFL]);; let HELLY_CLOSED_ALT = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> convex s /\ closed s) /\ (?s. s IN f /\ bounded s) /\ (!t. t SUBSET f /\ FINITE t /\ CARD(t) <= dimindex(:N) + 1 ==> ~(INTERS t = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC CLOSED_FIP THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `g:(real^N->bool)->bool` THEN STRIP_TAC THEN MATCH_MP_TAC HELLY_ALT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET_TRANS; FINITE_SUBSET]]);; let HELLY_COMPACT_ALT = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> convex s /\ compact s) /\ (!t. t SUBSET f /\ FINITE t /\ CARD(t) <= dimindex(:N) + 1 ==> ~(INTERS t = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; UNIV_NOT_EMPTY] THEN MATCH_MP_TAC HELLY_CLOSED_ALT THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; COMPACT_IMP_BOUNDED]);; let HELLY_CLOSED = prove (`!f:(real^N->bool)->bool. (FINITE f ==> CARD f >= dimindex (:N) + 1) /\ (!s. s IN f ==> convex s /\ closed s) /\ (?s. s IN f /\ bounded s) /\ (!t. t SUBSET f /\ FINITE t /\ CARD(t) = dimindex(:N) + 1 ==> ~(INTERS t = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN REWRITE_TAC[GE] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC HELLY_CLOSED_ALT THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `g:(real^N->bool)->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`dimindex(:N) + 1`; `g:(real^N->bool)->bool`; `f:(real^N->bool)->bool`] CHOOSE_SUBSET_BETWEEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `h:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN EXISTS_TAC `INTERS h: real^N->bool` THEN CONJ_TAC THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC] THEN ASM_MESON_TAC[HAS_SIZE]);; let HELLY_COMPACT = prove (`!f:(real^N->bool)->bool. (FINITE f ==> CARD f >= dimindex (:N) + 1) /\ (!s. s IN f ==> convex s /\ compact s) /\ (!t. t SUBSET f /\ FINITE t /\ CARD(t) = dimindex(:N) + 1 ==> ~(INTERS t = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; UNIV_NOT_EMPTY] THEN MATCH_MP_TAC HELLY_CLOSED THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; COMPACT_IMP_BOUNDED]);; (* ------------------------------------------------------------------------- *) (* Kirchberger's theorem *) (* ------------------------------------------------------------------------- *) let KIRCHBERGER = prove (`!s t:real^N->bool. compact s /\ compact t /\ (!s' t'. s' SUBSET s /\ t' SUBSET t /\ FINITE s' /\ FINITE t' /\ CARD(s') + CARD(t') <= dimindex(:N) + 2 ==> ?a b. (!x. x IN s' ==> a dot x < b) /\ (!x. x IN t' ==> a dot x > b)) ==> ?a b. ~(a = vec 0) /\ (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, let lemma = prove (`(!x. x IN convex hull s ==> a dot x < b) /\ (!x. x IN convex hull t ==> a dot x > b) <=> (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, REWRITE_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN SIMP_TAC[SUBSET_HULL; CONVEX_HALFSPACE_LT; CONVEX_HALFSPACE_GT]) and KIRCH_LEMMA = prove (`!s t:real^N->bool. FINITE s /\ FINITE t /\ (!s' t'. s' SUBSET s /\ t' SUBSET t /\ CARD(s') + CARD(t') <= dimindex(:N) + 2 ==> ?a b. (!x. x IN s' ==> a dot x < b) /\ (!x. x IN t' ==> a dot x > b)) ==> ?a b. (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (\r. {z:real^(N,1)finite_sum | fstcart z dot r < drop(sndcart z)}) s UNION IMAGE (\r. {z:real^(N,1)finite_sum | fstcart z dot r > drop(sndcart z)}) t`] HELLY_ALT) THEN REWRITE_TAC[FORALL_SUBSET_UNION; IN_UNION; IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_SUBSET_IMAGE] THEN ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE; INTERS_UNION] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_INTER; EXISTS_PASTECART; IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; FORALL_IN_IMAGE; RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; GSYM EXISTS_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`; GSYM DOT_RNEG] THEN REWRITE_TAC[convex; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN SIMP_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; IN_ELIM_PASTECART_THM] THEN SIMP_TAC[DOT_LADD; DOT_LMUL; DROP_ADD; DROP_CMUL; GSYM FORALL_DROP] THEN REWRITE_TAC[REAL_ARITH `--(a * x + b * y):real = a * --x + b * --y`] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `u + v = &1 ==> &0 <= u /\ &0 <= v ==> u = &0 /\ v = &1 \/ u = &1 /\ v = &0 \/ &0 < u /\ &0 < v`)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_ADD_LID; REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ]; REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `FINITE(u:real^N->bool) /\ FINITE(v:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) CARD_UNION o lhand o lhand o snd) THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `IMAGE f s INTER IMAGE g t = {} <=> !x y. x IN s /\ y IN t ==> ~(f x = g y)`] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN REWRITE_TAC[GSYM FORALL_DROP; DOT_LZERO] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE `a = a' /\ b = b' ==> a + b <= n + 2 ==> a' + b' <= n + 2`) THEN CONJ_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN SIMP_TAC[GSYM FORALL_DROP; real_gt; VECTOR_EQ_LDOT; MESON[REAL_LT_TOTAL; REAL_LT_REFL] `((!y:real. a < y <=> b < y) <=> a = b) /\ ((!y:real. y < a <=> y < b) <=> a = b)`]]) in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM lemma] THEN MATCH_MP_TAC SEPARATING_HYPERPLANE_COMPACT_COMPACT THEN ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY] THEN SUBGOAL_THEN `!s' t'. (s':real^N->bool) SUBSET s /\ t' SUBSET t /\ FINITE s' /\ CARD(s') <= dimindex(:N) + 1 /\ FINITE t' /\ CARD(t') <= dimindex(:N) + 1 ==> DISJOINT (convex hull s') (convex hull t')` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s':real^N->bool`; `t':real^N->bool`] KIRCH_LEMMA) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; FINITE_SUBSET]; ONCE_REWRITE_TAC[GSYM lemma] THEN SET_TAC[REAL_LT_ANTISYM; real_gt]]; POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[CARATHEODORY] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s':real^N->bool`; `t':real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Convex hull is "preserved" by a linear function. *) (* ------------------------------------------------------------------------- *) let CONVEX_HULL_LINEAR_IMAGE = prove (`!f s. linear f ==> convex hull (IMAGE f s) = IMAGE f (convex hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[FUN_IN_IMAGE; HULL_INC] THEN REWRITE_TAC[convex; IN_ELIM_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[REWRITE_RULE[convex] CONVEX_CONVEX_HULL]; ASM_SIMP_TAC[LINEAR_ADD; LINEAR_CMUL] THEN MESON_TAC[REWRITE_RULE[convex] CONVEX_CONVEX_HULL]]);; add_linear_invariants [CONVEX_HULL_LINEAR_IMAGE];; let IN_CONVEX_HULL_LINEAR_IMAGE = prove (`!f:real^M->real^N s x. linear f /\ x IN convex hull s ==> (f x) IN convex hull (IMAGE f s)`, SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE] THEN SET_TAC[]);; let CONIC_CONVEX_HULL = prove (`!s:real^N->bool. conic s ==> conic(convex hull s)`, SIMP_TAC[CONIC_IMAGE_MULTIPLE_EQ; GSYM CONVEX_HULL_LINEAR_IMAGE; LINEAR_SCALING; HULL_MONO]);; let CONIC_HULL_CONVEX_HULL = prove (`!s:real^N->bool. conic hull (convex hull s) = convex hull (conic hull s)`, GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[CONVEX_CONIC_HULL; HULL_SUBSET; CONVEX_CONVEX_HULL; HULL_MONO; CONIC_CONVEX_HULL; CONIC_CONIC_HULL]);; (* ------------------------------------------------------------------------- *) (* Convexity of general and special intervals. *) (* ------------------------------------------------------------------------- *) let IS_INTERVAL_CONVEX = prove (`!s:real^N->bool. is_interval s ==> convex s`, REWRITE_TAC[is_interval; convex] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `y:real^N`] THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN GEN_TAC THEN STRIP_TAC THEN DISJ_CASES_TAC(SPECL [`(x:real^N)$i`; `(y:real^N)$i`] REAL_LE_TOTAL) THENL [DISJ1_TAC; DISJ2_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&1 * a <= b /\ b <= &1 * c ==> a <= b /\ b <= c`) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[GSYM VECTOR_MUL_COMPONENT; VECTOR_ADD_RDISTRIB; VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_LE_LMUL; REAL_LE_LADD; REAL_LE_RADD]);; let IS_INTERVAL_CONNECTED = prove (`!s:real^N->bool. is_interval s ==> connected s`, MESON_TAC[IS_INTERVAL_CONVEX; CONVEX_CONNECTED]);; let IS_INTERVAL_CONNECTED_1 = prove (`!s:real^1->bool. is_interval s <=> connected s`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_CONNECTED] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[IS_INTERVAL_1; connected; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP; FORALL_LIFT; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `x:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{z:real^1 | basis 1 dot z < x}`; `{z:real^1 | basis 1 dot z > x}`] THEN REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN SIMP_TAC[SUBSET; EXTENSION; IN_UNION; IN_INTER; GSYM drop; NOT_FORALL_THM; real_gt; NOT_IN_EMPTY; IN_ELIM_THM; DOT_BASIS; DIMINDEX_1; ARITH] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TOTAL; LIFT_DROP]; REAL_ARITH_TAC; EXISTS_TAC `lift a`; EXISTS_TAC `lift b`] THEN ASM_REWRITE_TAC[REAL_LT_LE; LIFT_DROP] THEN ASM_MESON_TAC[]);; let CONVEX_INTERVAL = prove (`!a b:real^N. convex(interval [a,b]) /\ convex(interval (a,b))`, SIMP_TAC[IS_INTERVAL_CONVEX; IS_INTERVAL_INTERVAL]);; let CONNECTED_INTERVAL = prove (`(!a b:real^N. connected(interval[a,b])) /\ (!a b:real^N. connected(interval(a,b)))`, SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERVAL]);; let CONVEX_CONNECTED_COLLINEAR = prove (`!s:real^N->bool. collinear s ==> (convex s <=> connected s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[CONVEX_CONNECTED] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_AFFINE_HULL]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN GEOM_ORIGIN_TAC `u:real^N` THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN GEOM_BASIS_MULTIPLE_TAC 1 `v:real^N` THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[SPAN_SPECIAL_SCALE] THEN COND_CASES_TAC THENL [REWRITE_TAC[SPAN_EMPTY; SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_EMPTY; CONVEX_SING]; DISCH_TAC THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; connected; NOT_EXISTS_THM] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; SING_SUBSET] THEN REWRITE_TAC[SUBSET; IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real`] THEN MAP_EVERY ASM_CASES_TAC [`u = &0`; `u = &1`] THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_REFL; REAL_SUB_RZERO; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{y:real^N | basis 1 dot y < basis 1 dot (x:real^N)}`; `{y:real^N | basis 1 dot y > basis 1 dot (x:real^N)}`]) THEN REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN MATCH_MP_TAC(TAUT `q /\ r /\ (~p ==> s) ==> ~(p /\ q /\ r) ==> s`) THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN REWRITE_TAC[CONJ_ASSOC; REAL_ARITH `~(x:real < a /\ x > a)`]; ALL_TAC] THEN REWRITE_TAC[real_gt] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN REWRITE_TAC[GSYM DOT_RSUB; SET_RULE `~(s SUBSET {x | P x} UNION {x | Q x}) <=> ?x. x IN s /\ ~(P x \/ Q x)`] THEN SUBGOAL_THEN `!p q:real^N. p IN span {basis 1} /\ q IN span {basis 1} /\ basis 1 dot p = basis 1 dot q ==> p = q` ASSUME_TAC THENL [SIMP_TAC[SPAN_SING; IMP_CONJ; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN SIMP_TAC[DOT_RMUL; BASIS_NONZERO; DOT_BASIS_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN span {basis 1}` ASSUME_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `(a:real^N) IN s \/ b IN s ==> ~(s = {})`) THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; DOT_RADD; DOT_RMUL; VECTOR_ARITH `((&1 - u) % a + u % b) - b:real^N = (u - &1) % (b - a)`; VECTOR_ARITH `((&1 - u) % a + u % b) - a:real^N = u % (b - a)`; VECTOR_ARITH `b - ((&1 - u) % a + u % b):real^N = (u - &1) % (a - b)`; VECTOR_ARITH `a - ((&1 - u) % a + u % b):real^N = u % (a - b)`] THEN MATCH_MP_TAC(REAL_ARITH `(&0 < x ==> &0 < u * x) /\ (&0 < --x ==> &0 < (&1 - u) * --x) /\ ~(x = &0) ==> &0 < u * x \/ &0 < (u - &1) * x`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT] THEN REWRITE_TAC[DOT_RSUB; REAL_SUB_0]; REWRITE_TAC[DOT_RSUB; REAL_ARITH `~(&0 < x - y \/ &0 < y - x) <=> y = x`]] THEN ASM SET_TAC[]]);; let CONVEX_EQ_CONVEX_LINE_INTERSECTION = prove (`!s:real^N->bool. convex s <=> !a b. convex(s INTER affine hull {a,b})`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `a:real^N`; `b:real^N`]) THEN ASM_SIMP_TAC[IN_INTER; HULL_INC; IN_INSERT] THEN SET_TAC[]);; let CONVEX_EQ_CONNECTED_LINE_INTERSECTION = prove (`!s:real^N->bool. convex s <=> !a b. connected(s INTER affine hull {a,b})`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [CONVEX_EQ_CONVEX_LINE_INTERSECTION] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MATCH_MP_TAC CONVEX_CONNECTED_COLLINEAR THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `affine hull {a:real^N,b}` THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; COLLINEAR_2] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* On real^1, is_interval, convex and connected are all equivalent. *) (* ------------------------------------------------------------------------- *) let IS_INTERVAL_CONVEX_1 = prove (`!s:real^1->bool. is_interval s <=> convex s`, MESON_TAC[IS_INTERVAL_CONVEX; CONVEX_CONNECTED; IS_INTERVAL_CONNECTED_1]);; let CONVEX_CONNECTED_1 = prove (`!s:real^1->bool. convex s <=> connected s`, REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; GSYM IS_INTERVAL_CONNECTED_1]);; let CONNECTED_CONVEX_1 = prove (`!s:real^1->bool. connected s <=> convex s`, REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; GSYM IS_INTERVAL_CONNECTED_1]);; let CONNECTED_COMPACT_INTERVAL_1 = prove (`!s:real^1->bool. connected s /\ compact s <=> ?a b. s = interval[a,b]`, REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_COMPACT]);; let CONVEX_CONNECTED_1_GEN = prove (`!s:real^N->bool. dimindex(:N) = 1 ==> (convex s <=> connected s)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[GSYM DIMINDEX_1] THEN DISCH_THEN(ACCEPT_TAC o C GEOM_EQUAL_DIMENSION_RULE CONVEX_CONNECTED_1));; let CONNECTED_CONVEX_1_GEN = prove (`!s:real^N->bool. dimindex(:N) = 1 ==> (convex s <=> connected s)`, SIMP_TAC[CONVEX_CONNECTED_1_GEN]);; let COMPACT_CONVEX_COLLINEAR_SEGMENT_ALT = prove (`!s:real^N->bool. ~(s = {}) /\ compact s /\ connected s /\ collinear s ==> ?a b. s = segment[a,b]`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_AFFINE_HULL]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^N`; `w:real^N`] THEN REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN GEOM_BASIS_MULTIPLE_TAC 1 `w:real^N` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^N. lift(x$1)) s` CONNECTED_COMPACT_INTERVAL_1) THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; COMPACT_CONTINUOUS_IMAGE; LINEAR_LIFT_COMPONENT; LINEAR_CONTINUOUS_ON] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN MAP_EVERY EXISTS_TAC [`drop a % basis 1:real^N`; `drop b % basis 1:real^N`] THEN ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; REAL_ARITH `a <= b ==> (a <= x /\ x <= b \/ b <= x /\ x <= a <=> a <= x /\ x <= b)`] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `a <= x /\ x <= b <=> a <= drop(lift x) /\ drop(lift x) <= b`] THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(SET_RULE `(!x. lift(drop x) = x) /\ (!x. drop(lift x) = x) /\ (!x. x IN s ==> f(drop(g x)) = x) ==> s = {f y | lift y IN IMAGE g s}`) THEN REWRITE_TAC[LIFT_DROP] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN MATCH_MP_TAC HULL_INDUCT THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VECTOR_MUL_COMPONENT; VEC_COMPONENT; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_LZERO; BASIS_COMPONENT; REAL_MUL_RID; affine; IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_ADD_RDISTRIB; GSYM VECTOR_MUL_ASSOC]);; let COMPACT_CONVEX_COLLINEAR_SEGMENT = prove (`!s:real^N->bool. ~(s = {}) /\ compact s /\ convex s /\ collinear s ==> ?a b. s = segment[a,b]`, MESON_TAC[COMPACT_CONVEX_COLLINEAR_SEGMENT_ALT; CONVEX_CONNECTED_COLLINEAR]);; let IN_CONVEX_HULL_SEGMENT_1,IN_CONVEX_HULL_INTERVAL_1 = (CONJ_PAIR o prove) (`(!s:real^1->bool x. x IN convex hull s <=> ?a b. a IN s /\ b IN s /\ x IN segment[a,b]) /\ (!s:real^1->bool x. x IN convex hull s <=> ?a b. a IN s /\ b IN s /\ x IN interval[a,b])`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (q ==> p) /\ (p ==> r) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[SUBSET; INTERVAL_SUBSET_SEGMENT_1]; MESON_TAC[REWRITE_RULE[SUBSET] CONVEX_CONTAINS_SEGMENT; HULL_INC; CONVEX_CONVEX_HULL]; DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ p /\ q <=> (a /\ p) /\ (b /\ q)`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN ONCE_REWRITE_TAC[SET_RULE `(?x. x IN s /\ P x) <=> ~(s SUBSET {x | ~P x})`] THEN CONJ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[HULL_MONO] `s SUBSET t ==> convex hull s SUBSET convex hull t`)) THEN REWRITE_TAC[SUBSET; REAL_NOT_LE] THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `convex hull s = s /\ ~(x IN s) ==> ~(x IN convex hull s)`) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_REFL] THEN MATCH_MP_TAC HULL_P THEN REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; IS_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Jung's theorem. *) (* Proof taken from http://cstheory.wordpress.com/2010/08/07/jungs-theorem/ *) (* ------------------------------------------------------------------------- *) let JUNG = prove (`!s:real^N->bool r. bounded s /\ sqrt(&(dimindex(:N)) / &(2 * dimindex(:N) + 2)) * diameter s <= r ==> ?a. s SUBSET cball(a,r)`, let lemma = prove (`&0 < x /\ x <= y ==> (x - &1) / x <= (y - &1) / y`, SIMP_TAC[REAL_LE_LDIV_EQ] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x / y * z:real = (x * z) / y`] THEN SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LE_RDIV_EQ]] THEN ASM_REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= r` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[DIAMETER_POS_LE] THEN SIMP_TAC[SQRT_POS_LE; REAL_LE_DIV; REAL_POS]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE (\x:real^N. cball(x,r)) s` HELLY_COMPACT_ALT) THEN REWRITE_TAC[FORALL_IN_IMAGE; COMPACT_CBALL; CONVEX_CBALL] THEN REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[INTERS_IMAGE; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_ELIM_THM] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[GSYM SUBSET] THEN STRIP_TAC THEN ASM_SIMP_TAC[CARD_IMAGE_INJ; EQ_BALLS; GSYM REAL_NOT_LE] THEN UNDISCH_TAC `FINITE(t:real^N->bool)` THEN SUBGOAL_THEN `bounded(t:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET]; ALL_TAC] THEN UNDISCH_TAC `&0 <= r` THEN SUBGOAL_THEN `sqrt(&(dimindex(:N)) / &(2 * dimindex(:N) + 2)) * diameter(t:real^N->bool) <= r` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[DIAMETER_SUBSET; SQRT_POS_LE; REAL_POS; REAL_LE_DIV]; POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`t:real^N->bool`,`s:real^N->bool`) THEN REPEAT STRIP_TAC] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MP_TAC(ISPEC `{d | &0 <= d /\ ?a:real^N. s SUBSET cball(a,d)}` INF) THEN ABBREV_TAC `d = inf {d | &0 <= d /\ ?a:real^N. s SUBSET cball(a,d)}` THEN REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[BOUNDED_SUBSET_CBALL; REAL_LT_IMP_LE]; DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "P") (LABEL_TAC "M"))] THEN SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?a:real^N. s SUBSET cball(a,d)` MP_TAC THENL [SUBGOAL_THEN `!n. ?a:real^N. s SUBSET cball(a,d + inv(&n + &1))` MP_TAC THENL [X_GEN_TAC `n:num` THEN REMOVE_THEN "M" (MP_TAC o SPEC `d + inv(&n + &1)`) THEN REWRITE_TAC[REAL_ARITH `d + i <= d <=> ~(&0 < i)`] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN MESON_TAC[SUBSET_CBALL; REAL_LT_IMP_LE; SUBSET_TRANS]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN X_GEN_TAC `aa:num->real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?t. compact t /\ !n. (aa:num->real^N) n IN t` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_CBALL_0] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `cball(vec 0:real^N,B + d + &1)` THEN REWRITE_TAC[COMPACT_CBALL; IN_CBALL_0] THEN X_GEN_TAC `n:num` THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_CBALL]) THEN MATCH_MP_TAC(NORM_ARITH `(?x:real^N. norm(x) <= B /\ dist(a,x) <= d) ==> norm(a) <= B + d`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `d + inv(&n + &1)` THEN ASM_SIMP_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[compact; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `aa:num->real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN REWRITE_TAC[SUBSET; IN_CBALL] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(SPEC `(dist(a:real^N,x) - d) / &2` REAL_ARCH_INV) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `(dist(a:real^N,x) - d) / &2`) THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_HALF; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN DISCH_THEN(MP_TAC o SPECL [`(r:num->num)(N1 + N2)`; `x:real^N`]) THEN ASM_REWRITE_TAC[IN_CBALL; REAL_NOT_LE] THEN FIRST_X_ASSUM(MP_TAC o SPEC `N1 + N2:num`) THEN ASM_REWRITE_TAC[LE_ADD] THEN SUBGOAL_THEN `inv(&(r (N1 + N2:num)) + &1) < (dist(a:real^N,x) - d) / &2` MP_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N2)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_INV_EQ]; ALL_TAC] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(ARITH_RULE `N1 + N2 <= r(N1 + N2) ==> N2 <= r(N1 + N2) + 1`) THEN ASM_MESON_TAC[MONOTONE_BIGGER]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_CBALL; GSYM SUBSET] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN MATCH_MP_TAC SUBSET_CBALL THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a * s <= r ==> d <= a * s ==> d <= r`)) THEN UNDISCH_THEN `&0 <= r` (K ALL_TAC) THEN REMOVE_THEN "M" (K ALL_TAC) THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REMOVE_THEN "P" MP_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN ABBREV_TAC `n = CARD(s:real^N->bool)` THEN SUBGOAL_THEN `(s:real^N->bool) HAS_SIZE n` MP_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN UNDISCH_THEN `CARD(s:real^N->bool) = n` (K ALL_TAC) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN SPEC_TAC(`d:real`,`r:real`) THEN GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN SIMP_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ABBREV_TAC `t = {x:real^N | x IN s /\ norm(x) = r}` THEN SUBGOAL_THEN `FINITE(t:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "t" THEN ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN SUBGOAL_THEN `(vec 0:real^N) IN convex hull t` MP_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPEC `convex hull t:real^N->bool` SEPARATING_HYPERPLANE_CLOSED_0) THEN ASM_SIMP_TAC[CONVEX_CONVEX_HULL; NOT_IMP; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; COMPACT_IMP_CLOSED] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN X_GEN_TAC `v:real^N` THEN ABBREV_TAC `k = CARD(s:real^N->bool)` THEN SUBGOAL_THEN `(s:real^N->bool) HAS_SIZE k` MP_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN UNDISCH_THEN `CARD(s:real^N->bool) = k` (K ALL_TAC) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v:real^N` THEN X_GEN_TAC `m:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; REAL_LT_IMP_NZ] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN ASM_SIMP_TAC[DOT_LMUL; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[real_gt; GSYM REAL_LT_LDIV_EQ] THEN SUBGOAL_THEN `&0 < b / m` MP_TAC THENL [ASM_SIMP_TAC[REAL_LT_DIV]; UNDISCH_THEN `&0 < b` (K ALL_TAC) THEN SPEC_TAC(`b / m:real`,`b:real`)] THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!x:real^N e. &0 < e /\ e < b /\ x IN t ==> norm(x - e % basis 1) < r` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `r = norm(x:real^N)` SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[NORM_LT; dot]] THEN SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL; ARITH_RULE `2 <= n ==> 1 <= n /\ ~(n = 1)`; ARITH] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_LT_RADD] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_LT_SQUARE_ABS] THEN MATCH_MP_TAC(REAL_ARITH `!b. &0 < e /\ e < b /\ b < x ==> abs(x - e * &1) < abs x`) THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HULL_INC]; ALL_TAC] THEN SUBGOAL_THEN `?d. &0 < d /\ !x:real^N a. x IN (s DIFF t) /\ norm(a) < d ==> norm(x - a) < r` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `s DIFF t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN EXISTS_TAC `inf (IMAGE (\x:real^N. r - norm x) (s DIFF t))` THEN SUBGOAL_THEN `FINITE(s DIFF t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_DIFF]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC [NORM_ARITH `norm a < r - norm x ==> norm(x - a:real^N) < r`] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM; REAL_SUB_LT] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_CBALL_0]) THEN ASM_MESON_TAC[REAL_LT_LE]; ALL_TAC] THEN SUBGOAL_THEN `?a. !x. x IN s ==> norm(x - a:real^N) < r` STRIP_ASSUME_TAC THENL [EXISTS_TAC `min (b / &2) (d / &2) % basis 1:real^N` THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN t` THENL [MATCH_MP_TAC(ASSUME `!x:real^N e. &0 < e /\ e < b /\ x IN t ==> norm (x - e % basis 1) < r`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(ASSUME `!x:real^N a. x IN s DIFF t /\ norm a < d ==> norm (x - a) < r`) THEN ASM_SIMP_TAC[IN_DIFF; NORM_MUL; LE_REFL; NORM_BASIS; DIMINDEX_GE_1] THEN ASM_REAL_ARITH_TAC]; SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY; NORM_ARITH `norm(x:real^N) < r ==> &0 < r`]; ALL_TAC] THEN UNDISCH_THEN `!x a:real^N. &0 <= x /\ s SUBSET cball (a,x) ==> r <= x` (MP_TAC o SPECL [`max (&0) (r - inf (IMAGE (\x:real^N. r - norm(x - a)) s))`; `a:real^N`]) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> (r <= max (&0) a <=> r <= a)`] THEN REWRITE_TAC[SUBSET; IN_CBALL; REAL_ARITH `a <= max a b`] THEN REWRITE_TAC[NOT_IMP; REAL_ARITH `~(r <= r - x) <=> &0 < x`] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; REAL_SUB_LT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `d <= b ==> d <= max a b`) THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= b - c <=> c <= b - a`] THEN ASM_SIMP_TAC[REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE; ONCE_REWRITE_RULE[NORM_SUB] dist] THEN ASM_MESON_TAC[REAL_LE_REFL]]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `l:real^N->real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sqrt((&(dimindex (:N)) / &(2 * dimindex (:N) + 2)) * diameter(s:real^N->bool) pow 2)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RSQRT; ASM_SIMP_TAC[SQRT_MUL; DIAMETER_POS_LE; REAL_POW_LE; REAL_LE_DIV; REAL_POS; POW_2_SQRT; REAL_LE_REFL]] THEN SUBGOAL_THEN `sum t (\y:real^N. &2 * r pow 2) <= sum t (\y. (&1 - l y) * diameter(s:real^N->bool) pow 2)` MP_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (t DELETE x) (\x:real^N. l(x)) * diameter(s:real^N->bool) pow 2` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELETE; ETA_AX; REAL_LE_REFL]] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (t DELETE x) (\y:real^N. l y * norm(y - x) pow 2)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM SET_TAC[]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum t (\y:real^N. l y * norm (y - x) pow 2)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[IN_DELETE]] THEN SIMP_TAC[TAUT `p /\ ~(p /\ ~q) <=> p /\ q`] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN REAL_ARITH_TAC] THEN REWRITE_TAC[NORM_POW_2; VECTOR_ARITH `(y - x:real^N) dot (y - x) = (x dot x + y dot y) - &2 * x dot y`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum t (\y:real^N. l y * (&2 * r pow 2 - &2 * (x dot y)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN UNDISCH_TAC `(x:real^N) IN t` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_DELETE; IN_ELIM_THM] THEN SIMP_TAC[NORM_EQ_SQUARE; NORM_POW_2] THEN REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `x * (&2 * y - &2 * z) = &2 * (x * y - x * z)`] THEN REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN ASM_SIMP_TAC[SUM_SUB; FINITE_DELETE; SUM_RMUL] THEN REWRITE_TAC[GSYM DOT_RMUL] THEN ASM_SIMP_TAC[GSYM DOT_RSUM; DOT_RZERO] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[SUM_CONST; SUM_RMUL; SUM_SUB] THEN REWRITE_TAC[REAL_OF_NUM_MUL; MULT_CLAUSES] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN SUBGOAL_THEN `&0 < &(CARD(t:real^N->bool) * 2)` ASSUME_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT; ARITH_RULE `0 < n * 2 <=> ~(n = 0)`] THEN ASM_SIMP_TAC[CARD_EQ_0]; ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_ARITH `(a * b) / c:real = a / c * b`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN REWRITE_TAC[ARITH_RULE `2 * n + 2 = (n + 1) * 2`; GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[GSYM real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBGOAL_THEN `&(dimindex(:N)) = &(dimindex(:N) + 1) - &1` SUBST1_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; MATCH_MP_TAC lemma THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; CARD_EQ_0; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM SET_TAC[]]]]);; (* ------------------------------------------------------------------------- *) (* Kirszbraun's theorem (proof from Federer's "Geometric Measure Theory") *) (* ------------------------------------------------------------------------- *) let KIRSZBRAUN = prove (`!f:real^M->real^N s B. &0 <= B /\ (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> ?g. (!x y. norm(g x - g y) <= B * norm(x - y)) /\ (!x. x IN s ==> g x = f x)`, let lemma1 = prove (`!p Y c. compact p /\ ~(p = {}) /\ p SUBSET (:real^N) PCROSS {r | &0 < drop r} /\ (\t. {y | !a r. pastecart a r IN p ==> norm(y - a) <= drop r * t}) = Y /\ inf {t | &0 <= t /\ ~(Y t = {})} = c ==> ?b. b IN Y c /\ b IN convex hull {a | ?r. pastecart a r IN p /\ norm(b - a) = drop r * c}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!t t'. t <= t' ==> (Y:real->real^N->bool) t SUBSET Y t'` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p SUBSET s ==> (!a r. pastecart a r IN s /\ P a r ==> Q a r) ==> (!a r. pastecart a r IN p ==> P a r) ==> (!a r. pastecart a r IN p ==> Q a r)`)) THEN REPEAT GEN_TAC THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; LIFT_DROP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~({t | &0 <= t /\ ~(Y t:real^N->bool = {})} = {})` ASSUME_TAC THENL [SUBGOAL_THEN `bounded (IMAGE (\z. lift(norm(fstcart z:real^N) / drop(sndcart z))) p)` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_LIFT_NORM_COMPOSE; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN REAL_ARITH_TAC; REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `B:real` THEN REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN STRIP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `B:real` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[NORM_ARITH `norm(vec 0 - x:real^N) = norm x`] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `r:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `lift r`]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (a:real^N) (lift r)` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_ELIM_THM; NORM_LIFT] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NORM; LIFT_DROP] THEN SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`; REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE (Y:real->real^N->bool) {t | c < t}` COMPACT_CHAIN) THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TOTAL]] THEN X_GEN_TAC `t:real` THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `Y t = INTERS(IMAGE (\z.cball(fstcart z:real^N,drop(sndcart z) * t)) p)` SUBST1_TAC THENL [EXPAND_TAC "Y" THEN REWRITE_TAC[INTERS_IMAGE] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; FORALL_PASTECART; IN_CBALL] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; dist] THEN MESON_TAC[NORM_SUB]; MATCH_MP_TAC COMPACT_INTERS THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; COMPACT_CBALL]]; UNDISCH_TAC `c:real < t` THEN REWRITE_TAC[REAL_NOT_LT] THEN EXPAND_TAC "c" THEN MATCH_MP_TAC REAL_LE_INF THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_TOTAL; SUBSET_EMPTY]]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `b IN (Y:real->real^N->bool) c` ASSUME_TAC THENL [SUBGOAL_THEN `(Y:real->real^N->bool) c = INTERS (IMAGE Y {t | c < t})` SUBST1_TAC THENL [ALL_TAC; REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]] THEN REWRITE_TAC[INTERS_IMAGE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MESON[] `(!x. P x ==> !a r. Q a r ==> R a r x) <=> (!a r. Q a r ==> !x. P x ==> R a r x)`] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `r:real^1` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (a:real^N) (r:real^1)` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN DISCH_TAC THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE; NOT_IMP; NOT_FORALL_THM] THEN MESON_TAC[REAL_ARITH `a < b ==> a < (a + b) / &2 /\ (a + b) / &2 < b`]; ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `!t. t < c ==> (Y:real->real^N->bool) t = {}` ASSUME_TAC THENL [GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN ASM_CASES_TAC `&0 <= t` THENL [EXPAND_TAC "c" THEN MATCH_MP_TAC INF_LE_ELEMENT THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; UNDISCH_TAC `~((Y:real->real^N->bool) t = {})` THEN REWRITE_TAC[GSYM REAL_NOT_LT; CONTRAPOS_THM] THEN DISCH_TAC THEN EXPAND_TAC "Y" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN X_GEN_TAC `x:real^N` THEN SUBGOAL_THEN `?a:real^N r:real^1. pastecart a r IN p` MP_TAC THENL [ASM_REWRITE_TAC[GSYM EXISTS_PASTECART; MEMBER_NOT_EMPTY]; REWRITE_TAC[NOT_FORALL_THM; NOT_IMP]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC(REAL_ARITH `&0 < --x /\ &0 <= y ==> x < y`) THEN REWRITE_TAC[NORM_POS_LE; GSYM REAL_MUL_RNEG] THEN MATCH_MP_TAC REAL_LT_MUL THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (a:real^N) (r:real^1)` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= c` ASSUME_TAC THENL [EXPAND_TAC "c" THEN MATCH_MP_TAC REAL_LE_INF THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(Y:real->real^N->bool) c = {b}` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `b IN s /\ (!y z. y IN s /\ z IN s ==> y = z) ==> s = {b}`) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[REAL_MUL_RZERO; NORM_ARITH `norm(x - y:real^N) <= &0 <=> x = y`] THEN SUBGOAL_THEN `?a:real^N r:real^1. pastecart a r IN p` MP_TAC THENL [ASM_REWRITE_TAC[GSYM EXISTS_PASTECART; MEMBER_NOT_EMPTY]; SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `&0 < c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `bounded(IMAGE sndcart (p:real^(N,1)finite_sum->bool))` MP_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `B:real` THEN REWRITE_TAC[FORALL_PASTECART; SNDCART_PASTECART] THEN STRIP_TAC THEN MP_TAC(ASSUME `!t. t < c ==> (Y:real->real^N->bool) t = {}`) THEN REWRITE_TAC[NOT_FORALL_THM; GSYM MEMBER_NOT_EMPTY; NOT_IMP] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM; GSYM MEMBER_NOT_EMPTY; NOT_IMP] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `midpoint(y:real^N,z)` THEN EXPAND_TAC "Y" THEN EXISTS_TAC `sqrt(c pow 2 - dist(y:real^N,z) pow 2 / B pow 2 / &4)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_LSQRT THEN ASM_REWRITE_TAC[REAL_ARITH `x - a < x <=> &0 < a`] THEN REPEAT(MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC) THEN ASM_SIMP_TAC[REAL_POW_LT; GSYM DIST_NZ] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `r:real^1`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (a:real^N) (r:real^1)` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_ELIM_THM; NORM_LIFT] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NORM; LIFT_DROP; IN_UNIV] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[REAL_POW_DIV] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT] THEN TRANS_TAC REAL_LE_TRANS `(norm(y - a) pow 2 + norm(z - a) pow 2) / &2 - norm(y - z:real^N) pow 2 / &4` THEN CONJ_TAC THENL [REWRITE_TAC[NORM_POW_2; midpoint] THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= a * r /\ y <= a * r /\ r * w <= z ==> (x + y) / &2 - z <= (a - w) * r`) THEN ASM_REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_LE_SQUARE_ABS] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_MUL_SYM]; ALL_TAC]) THEN REWRITE_TAC[dist; REAL_ARITH `r * d / b / &4 <= d / &4 <=> d * (r / b) <= d * &1`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN REWRITE_TAC[GSYM NORM_1] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC I [SET_RULE `x IN s <=> ~(DISJOINT {x} s)`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO))) THEN REWRITE_TAC[CONVEX_SING; NOT_INSERT_EMPTY; COMPACT_SING] THEN REWRITE_TAC[CONVEX_CONVEX_HULL; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN SUBGOAL_THEN `{a | ?r. pastecart a r IN p /\ norm(b - a) = drop r * c} = IMAGE fstcart {z | z IN p /\ lift(norm(b - fstcart z:real^N) - drop(sndcart z) * c) IN {vec 0}}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_SING; GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN REWRITE_TAC[REAL_SUB_0] THEN MESON_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN EXISTS_TAC `(:real^1)` THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; CLOSED_SING] THEN REWRITE_TAC[SUBSET_UNIV; LIFT_SUB; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[CONTINUOUS_ON_MUL; CONTINUOUS_ON_CONST; o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART]]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `k:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_gt; REAL_NOT_LT] THEN MP_TAC(ISPEC `{ p INTER {z | abs(norm(b - fstcart z:real^N) - drop(sndcart z) * c) <= e} INTER {z | u dot (fstcart z) - k <= e} | &0 < e}` COMPACT_CHAIN) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_PASTECART] THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTER; IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `r:real^1` THEN REWRITE_TAC[MESON[REAL_LT_IMP_LE; REAL_LE_TRANS; REAL_ARITH `~(x <= &0) ==> &0 < x / &2 /\ ~(x <= x / &2)`] `(!e. &0 < e ==> x <= e) <=> x <= &0`] THEN REWRITE_TAC[REAL_ARITH `abs(x - y) <= &0 <=> x = y`] THEN REWRITE_TAC[REAL_ARITH `x - y <= &0 <=> x <= y`] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `&1`) STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN MATCH_MP_TAC HULL_INC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `r:real^1` THEN ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_INTER_CLOSED THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_INTER THEN CONJ_TAC THENL [REWRITE_TAC[GSYM NORM_LIFT; GSYM IN_CBALL_0] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_CBALL; LIFT_SUB; LIFT_CMUL] THEN GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN SIMP_TAC[CONTINUOUS_MUL; CONTINUOUS_CONST; o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_AT; LINEAR_SNDCART; ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; LINEAR_CONTINUOUS_AT; LINEAR_FSTCART]; ONCE_REWRITE_TAC[MESON[LIFT_DROP] `a - k = drop(lift(a - k))`] THEN ONCE_REWRITE_TAC[SET_RULE `drop x <= a <=> x IN {x | drop x <= a}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[drop; LIFT_SUB; CLOSED_HALFSPACE_COMPONENT_LE] THEN GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_LIFT_DOT2 THEN SIMP_TAC[CONTINUOUS_CONST; LINEAR_CONTINUOUS_AT; LINEAR_FSTCART]]; ALL_TAC] THEN SUBGOAL_THEN `?ee. &0 < ee /\ ee < e / norm(u:real^N) /\ ee < e / norm(u) pow 2` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_LT_MIN] THEN MATCH_MP_TAC(MESON[REAL_ARITH `&0 < y ==> &0 < y / &2 /\ y / &2 < y`] `&0 < y ==> ?x. &0 < x /\ x < y`) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_POW_LT; REAL_LT_DIV; NORM_POS_LT]; ALL_TAC] THEN SUBGOAL_THEN `~((b + ee % u:real^N) IN Y(c:real))` MP_TAC THENL [ASM_REWRITE_TAC[IN_SING; VECTOR_ARITH `b + e:real^N = b <=> e = vec 0`; VECTOR_MUL_EQ_0] THEN ASM_REAL_ARITH_TAC; EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM]] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[NOT_FORALL_THM; IMP_CONJ] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^1` THEN REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s = {a} ==> a IN s`)) THEN EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `r:real^1`]) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d < k ==> &0 < e /\ a <= b /\ u - d <= e /\ b <= a + e ==> abs(a - b) <= e /\ u - k <= e`)) THEN ASM_REWRITE_TAC[GSYM DOT_RSUB] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `b <= rc /\ ~(b' <= rc) ==> b' - b <= e /\ u <= v ==> u <= v /\ rc <= b + e`)) THEN REWRITE_TAC[VECTOR_ARITH `(b + e % u) - a:real^N = (b - a) + e % u`] THEN MATCH_MP_TAC(NORM_ARITH `norm(y) <= e /\ u <= v ==> norm(x + y:real^N) - norm(x) <= e /\ u <= v`) THEN REWRITE_TAC[NORM_MUL] THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `n <= rc /\ ~(m <= rc) ==> n < m`)) THEN REWRITE_TAC[NORM_LT; VECTOR_ARITH `(b + e % u) - a:real^N = (b - a) + e % u`] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(a + b:real^N) dot (a + b) = a dot a + b dot b + &2 * b dot a`] THEN REWRITE_TAC[REAL_ARITH `a < a + x + y <=> --y < x`] THEN REWRITE_TAC[GSYM REAL_MUL_RNEG; GSYM DOT_RNEG; VECTOR_NEG_SUB] THEN REWRITE_TAC[DOT_LMUL] THEN REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[REAL_ARITH `&2 * x < e * e * p <=> x < e * e * p / &2`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN MATCH_MP_TAC(REAL_ARITH `b <= c ==> a < b ==> a <= c`) THEN MATCH_MP_TAC(REAL_ARITH `a * b < c /\ &0 < c ==> a * b / &2 <= c`) THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; GSYM NORM_POW_2; NORM_POS_LT; REAL_POW_LT]) in let lemma2 = prove (`!f:real^M->real^N s. (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= norm(x - y)) ==> ?g. (!x y. norm(g x - g y) <= norm(x - y)) /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?g:real^M->real^N t. s SUBSET t /\ (!x. x IN s ==> g x = f x) /\ (!x y. x IN t /\ y IN t ==> norm(g x - g y) <= norm(x - y)) /\ !h u. t SUBSET u /\ (!x. x IN t ==> h x = g x) /\ (!x y. x IN u /\ y IN u ==> norm(h x - h y) <= norm(x - y)) ==> u = t` MP_TAC THENL [MP_TAC(ISPEC `\r. (!x y x' y'. r(x,y) /\ r(x',y') ==> norm(y' - y) <= norm(x' - x)) /\ (!x. x IN s ==> r(x,(f:real^M->real^N) x))` ZL_SUBSETS_UNIONS_NONEMPTY) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `\(x,y). x IN s /\ (f:real^M->real^N) x = y` THEN SIMP_TAC[] THEN ASM_MESON_TAC[]; REWRITE_TAC[UNIONS; IN_ELIM_THM; SUBSET; FORALL_PAIR_THM] THEN SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `r:real^M#real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x:real^M y z:real^N. r(x,y) /\ r(x,z) ==> y = z` ASSUME_TAC THENL [ASM_MESON_TAC[NORM_ARITH `norm(x - y:real^N) <= norm(z - z:real^M) ==> x = y`]; ALL_TAC] THEN EXISTS_TAC `\x:real^M. @y:real^N. r(x,y)` THEN EXISTS_TAC `IMAGE FST (r:real^M#real^N->bool)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM] THEN ASM SET_TAC[]; ASM_MESON_TAC[]; REWRITE_TAC[FORALL_IN_IMAGE_2; FORALL_PAIR_THM] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{(x,(h:real^M->real^N) x) | x IN u}`) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_PAIR_THM; IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN ASM SET_TAC[]] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ; SUBSET] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN ASM SET_TAC[]]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC)] THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `t = (:real^M)` THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(t = UNIV) ==> (!y. ~(y IN t) ==> F) ==> P`)) THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `?z. !x. x IN t ==> norm(z - (g:real^M->real^N) x) <= norm(y - x)` STRIP_ASSUME_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o SPECL [`\x. if x = y then z else (g:real^M->real^N) x`; `(y:real^M) INSERT t`]) THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; NOT_IMP] THEN REWRITE_TAC[FORALL_IN_INSERT; GSYM CONJ_ASSOC] THEN REWRITE_TAC[NORM_0; VECTOR_SUB_REFL; REAL_LE_REFL] THEN REPLICATE_TAC 3 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT(GEN_TAC THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN TRY CONJ_TAC) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; NORM_POS_LE; REAL_LE_REFL] THEN ASM_MESON_TAC[NORM_SUB]] THEN MP_TAC(ISPEC `IMAGE (\x. cball((g:real^M->real^N) x,norm(x - y))) t` COMPACT_FIP) THEN REWRITE_TAC[FORALL_IN_IMAGE; COMPACT_CBALL] THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_CBALL; dist] THEN MESON_TAC[NORM_SUB]] THEN X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `c:real^M->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; INTERS_0; UNIV_NOT_EMPTY] THEN MP_TAC(SPEC `IMAGE (\x. pastecart ((g:real^M->real^N) x) (lift(norm(x - y)))) c` lemma1) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMP_COMPACT; FINITE_IMAGE]; ALL_TAC] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNIV; IN_ELIM_THM; LIFT_DROP; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!y. a = y ==> p y) ==> (?y. a = y /\ p y)`)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `Y:real->real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!y. a = y ==> p y) ==> (?y. a = y /\ p y)`)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `q <= &1` ASSUME_TAC THENL [ALL_TAC; UNDISCH_TAC `b IN (Y:real->real^N->bool) q` THEN EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!a r x. P a r x) <=> (!x a r. P a r x)`] THEN REWRITE_TAC[PASTECART_INJ; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2; IN_CBALL; LIFT_DROP] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[NORM_POS_LE]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN]) THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; PASTECART_INJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(?r x. P x /\ r = f x /\ Q r x) <=> (?x. P x /\ Q (f x) x)`] THEN REWRITE_TAC[SET_RULE `{a | ?x. a = g x /\ x IN c /\ P a x} = IMAGE g {x | x IN c /\ P (g x) x}`] THEN REWRITE_TAC[LIFT_DROP] THEN REWRITE_TAC[CONVEX_HULL_IMAGE_LT; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `l:real^M->real`] THEN STRIP_TAC THEN SUBGOAL_THEN `!a:real^M. a IN d ==> &0 <= l a` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= abs(&1) ==> x <= &1`) THEN REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN REWRITE_TAC[REAL_POW_ONE] THEN SUBGOAL_THEN `&2 * q pow 2 * norm(vsum d (\x:real^M. l x % (x - y))) pow 2 + (q pow 2 - &1) * sum d (\x. sum d (\z. l x * l z * norm(x - z) pow 2)) <= &0` MP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[REAL_LE_POW_2]; MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC SUM_POS_LE] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN REWRITE_TAC[REAL_LE_POW_2] THEN ASM SET_TAC[]; REWRITE_TAC[REAL_ENTIRE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `~p /\ ~r /\ (s ==> ~q) ==> ~((p \/ q) /\ (r \/ s))`) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] SUM_POS_EQ_0))) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN REWRITE_TAC[REAL_LE_POW_2] THEN ASM SET_TAC[]; ALL_TAC] THEN DISJ_CASES_THEN MP_TAC (SET_RULE `d:real^M->bool = {} \/ ?a. a IN d`) THENL [ASM_MESON_TAC[SUM_CLAUSES; REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] SUM_POS_EQ_0))) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN REWRITE_TAC[REAL_LE_POW_2] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^M. x IN d ==> ~(l x = &0)` MP_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_NZ]; SIMP_TAC[REAL_ENTIRE]] THEN UNDISCH_TAC `(x:real^M) IN d` THEN SIMP_TAC[] THEN REWRITE_TAC[REAL_POW_EQ_0; NORM_EQ_0] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN REPLICATE_TAC 3 DISCH_TAC THEN UNDISCH_TAC `sum (d:real^M->bool) l = &1` THEN SUBGOAL_THEN `d = {x:real^M}` SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[VSUM_SING; SUM_SING]] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; DE_MORGAN_THM] THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM SET_TAC[]]] THEN REWRITE_TAC[NORM_POW_2] THEN UNDISCH_TAC `FINITE(d:real^M->bool)` THEN SIMP_TAC[DOT_LSUM] THEN SIMP_TAC[DOT_RSUM] THEN SIMP_TAC[GSYM SUM_LMUL] THEN SIMP_TAC[GSYM SUM_ADD] THEN REWRITE_TAC[GSYM NORM_POW_2] THEN REWRITE_TAC[DOT_LMUL] THEN REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[REAL_ARITH `&2 * a * x * y * z + b * x * y * w = x * y * (&2 * a * z + b * w)`] THEN REWRITE_TAC[REAL_ARITH `&2 * q pow 2 * x = &2 * q * q * x`] THEN ONCE_REWRITE_TAC[GSYM DOT_RMUL] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL] THEN REWRITE_TAC[DOT_NORM_NEG; REAL_ARITH `&2 * x / &2 = x`] THEN REWRITE_TAC[VECTOR_ARITH `q % (x - y) - q % (x' - y):real^N = q % (x - x')`] THEN REWRITE_TAC[NORM_MUL; REAL_POW_MUL; REAL_POW2_ABS] THEN REWRITE_TAC[REAL_ARITH `(a - q * y) + (q - &1) * y = a - y`] THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `sum d (\x. sum d (\y. (l x * l y) * ((norm(g x - b) pow 2 + norm(g y - b) pow 2) - norm((g:real^M->real^N) x - g y) pow 2)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC(REAL_ARITH `c' <= c /\ a' = a /\ b' = b ==> (a + b) - c <= (a' + b') - c'`) THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NORM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_LE_SQUARE_ABS] THEN CONJ_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [NORM_SUB] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x y. (g:real^M->real^N) x - g y = (g x - b) - (g y - b)` MP_TAC THENL [CONV_TAC VECTOR_ARITH; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[REAL_ARITH `(x * y) * (a - b) = &2 * (x * y * (a - b) / &2)`] THEN REWRITE_TAC[GSYM DOT_NORM_NEG] THEN ONCE_REWRITE_TAC[GSYM DOT_RMUL] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL] THEN REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &2 * x <= &0`) THEN UNDISCH_TAC `FINITE(d:real^M->bool)` THEN SIMP_TAC[GSYM DOT_RSUM] THEN SIMP_TAC[GSYM DOT_LSUM] THEN REWRITE_TAC[DOT_EQ_0; VECTOR_SUB_LDISTRIB] THEN SIMP_TAC[VSUM_SUB; VSUM_RMUL] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH) in REPEAT GEN_TAC THEN ASM_CASES_TAC `B = &0` THENL [ASM_REWRITE_TAC[REAL_LE_REFL; REAL_MUL_LZERO; NORM_ARITH `norm(x - y:real^N) <= &0 <=> x = y`] THEN REWRITE_TAC[MESON[] `(!x y. x IN s /\ y IN s ==> f x = f y) <=> (?a. !x. x IN s ==> f x = a)`] THEN DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN EXISTS_TAC `(\a. b):real^M->real^N` THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; VECTOR_SUB_REFL; NORM_0]; STRIP_TAC] THEN SUBGOAL_THEN `&0 < B` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\x. inv(B) % (f:real^M->real^N) x`; `s:real^M->bool`] lemma2) THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_MUL_SYM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. B % (g:real^M->real^N) x` THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID]);; let LIPSCHITZ_EXTENSION_EXISTS = prove (`!f:real^M->real^N s. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> ?g. (?B. !x y. norm(g x - g y) <= B * norm(x - y)) /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `abs B + &1`] KIRSZBRAUN) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_MESON_TAC[REAL_LE_RMUL; REAL_LE_TRANS; NORM_POS_LE; REAL_ARITH `&0 <= abs B + &1 /\ B <= abs B + &1`]);; (* ------------------------------------------------------------------------- *) (* The Dugundji extension theorem, and Tietze variants as corollaries. *) (* ------------------------------------------------------------------------- *) let DUGUNDJI = prove (`!f:real^M->real^N c u s. convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean u) s /\ f continuous_on s /\ IMAGE f s SUBSET c ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ !x. x IN s ==> g x = f x`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN EXISTS_TAC `(\x. y):real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`u DIFF s:real^M->bool`; `{ ball(x:real^M,setdist({x},s) / &2) |x| x IN u DIFF s}`] PARACOMPACT) THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; OPEN_BALL] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; UNIONS_GSPEC] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < x / &2`) THEN ASM_MESON_TAC[SETDIST_POS_LE; SETDIST_EQ_0_CLOSED_IN]; DISCH_THEN(X_CHOOSE_THEN `c:(real^M->bool)->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `!t. t IN c ==> ?v a:real^M. v IN u /\ ~(v IN s) /\ a IN s /\ t SUBSET ball(v,setdist({v},s) / &2) /\ dist(v,a) <= &2 * setdist({v},s)` MP_TAC THENL [X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`{v:real^M}`; `s:real^M->bool`; `&2 * setdist({v:real^M},s)`] REAL_SETDIST_LT_EXISTS) THEN ASM_SIMP_TAC[NOT_INSERT_EMPTY; SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> (x < &2 * x <=> ~(x = &0))`] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; IN_SING; SETDIST_EQ_0_CLOSED_IN]; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`vv:(real^M->bool)->real^M`; `aa:(real^M->bool)->real^M`] THEN STRIP_TAC] THEN SUBGOAL_THEN `!t v:real^M. t IN c /\ v IN t ==> setdist({vv t},s) <= &2 * setdist({v},s)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o el 3 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPEC `v:real^M`) THEN ASM_REWRITE_TAC[IN_BALL] THEN MP_TAC(ISPECL [`s:real^M->bool`; `(vv:(real^M->bool)->real^M) t`; `v:real^M`] SETDIST_SING_TRIANGLE) THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!t v a:real^M. t IN c /\ v IN t /\ a IN s ==> dist(a,aa t) <= &6 * dist(a,v)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^M->bool`; `v:real^M`]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o funpow 3 CONJUNCT2) THEN REWRITE_TAC[IMP_CONJ; SUBSET; IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `v:real^M`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`{v:real^M}`; `s:real^M->bool`; `v:real^M`; `a:real^M`] SETDIST_LE_DIST) THEN ASM_REWRITE_TAC[IN_SING] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN MP_TAC(ISPECL [`c:(real^M->bool)->bool`; `u DIFF s:real^M->bool`] SUBORDINATE_PARTITION_OF_UNITY) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:(real^M->bool)->real^M->real` THEN STRIP_TAC THEN EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else vsum c (\t:real^M->bool. h t x % f(aa t))` THEN SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONVEX_VSUM_STRONG THEN ASM SET_TAC[]] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `(a:real^M) IN s` THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN MAP_EVERY EXISTS_TAC [`\x:real^M. vsum c (\t:real^M->bool. h t x % (f:real^M->real^N) (aa t))`; `u DIFF s:real^M->bool`] THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; IN_DIFF] THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(X_CHOOSE_THEN `n:real^M->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN MAP_EVERY EXISTS_TAC [`\x. vsum {u | u IN c /\ ~(!x:real^M. x IN n ==> h u x = &0)} (\t:real^M->bool. h t x % (f:real^M->real^N) (aa t))`; `(u DIFF s) INTER n:real^M->bool`] THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; OPEN_IN_INTER_OPEN; IN_INTER; IN_DIFF] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_VSUM THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_VMUL THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT1) THEN ASM_REWRITE_TAC[IN_DIFF; ETA_AX] THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_SET THEN SUBGOAL_THEN `open_in (subtopology euclidean u) (u DIFF s:real^M->bool)` MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; ALL_TAC] THEN REWRITE_TAC[EVENTUALLY_AT; OPEN_IN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[IN_DIFF] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTER; IN_DIFF] THEN MESON_TAC[DIST_SYM]]] THEN ASM_REWRITE_TAC[CONTINUOUS_WITHIN_OPEN] THEN X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) a`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[continuous_within] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(a:real^M,d / &6)` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &6 <=> &0 < e`] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN COND_CASES_TAC THENL [REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONVEX_VSUM_STRONG THEN ASM_SIMP_TAC[CONVEX_BALL; IN_DIFF] THEN X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^M) IN t` THENL [DISJ2_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `dist(a:real^M,v) < d / &6 ==> dist(a,a') <= &6 * dist(a,v) ==> dist(a',a) < d`)) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let TIETZE = prove (`!f:real^M->real^N u s B. &0 <= B /\ closed_in (subtopology euclidean u) s /\ f continuous_on s /\ (!x. x IN s ==> norm(f x) <= B) ==> ?g. g continuous_on u /\ (!x. x IN s ==> g x = f x) /\ (!x. x IN u ==> norm(g x) <= B)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `cball(vec 0:real^N,B)`; `u:real^M->bool`; `s:real^M->bool`] DUGUNDJI) THEN ASM_REWRITE_TAC[CONVEX_CBALL; CBALL_EQ_EMPTY; REAL_NOT_LT] THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_CBALL_0] THEN MESON_TAC[]);; let TIETZE_CLOSED_INTERVAL = prove (`!f:real^M->real^N u s a b. ~(interval[a,b] = {}) /\ closed_in (subtopology euclidean u) s /\ f continuous_on s /\ (!x. x IN s ==> f x IN interval[a,b]) ==> ?g. g continuous_on u /\ (!x. x IN s ==> g x = f x) /\ (!x. x IN u ==> g(x) IN interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `interval[a:real^N,b]`; `u:real^M->bool`; `s:real^M->bool`] DUGUNDJI) THEN ASM_REWRITE_TAC[CONVEX_INTERVAL; SUBSET; FORALL_IN_IMAGE] THEN MESON_TAC[]);; let TIETZE_CLOSED_INTERVAL_1 = prove (`!f:real^N->real^1 u s a b. drop a <= drop b /\ closed_in (subtopology euclidean u) s /\ f continuous_on s /\ (!x. x IN s ==> f x IN interval[a,b]) ==> ?g. g continuous_on u /\ (!x. x IN s ==> g x = f x) /\ (!x. x IN u ==> g(x) IN interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC TIETZE_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1]);; let TIETZE_OPEN_INTERVAL = prove (`!f:real^M->real^N u s a b. ~(interval(a,b) = {}) /\ closed_in (subtopology euclidean u) s /\ f continuous_on s /\ (!x. x IN s ==> f x IN interval(a,b)) ==> ?g. g continuous_on u /\ (!x. x IN s ==> g x = f x) /\ (!x. x IN u ==> g(x) IN interval(a,b))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `interval(a:real^N,b)`; `u:real^M->bool`; `s:real^M->bool`] DUGUNDJI) THEN ASM_REWRITE_TAC[CONVEX_INTERVAL; SUBSET; FORALL_IN_IMAGE] THEN MESON_TAC[]);; let TIETZE_OPEN_INTERVAL_1 = prove (`!f:real^N->real^1 u s a b. drop a < drop b /\ closed_in (subtopology euclidean u) s /\ f continuous_on s /\ (!x. x IN s ==> f x IN interval(a,b)) ==> ?g. g continuous_on u /\ (!x. x IN s ==> g x = f x) /\ (!x. x IN u ==> g(x) IN interval(a,b))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC TIETZE_OPEN_INTERVAL THEN ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1]);; let TIETZE_UNBOUNDED = prove (`!f:real^M->real^N u s. closed_in (subtopology euclidean u) s /\ f continuous_on s ==> ?g. g continuous_on u /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^N)`; `u:real^M->bool`; `s:real^M->bool`] DUGUNDJI) THEN ASM_REWRITE_TAC[CONVEX_UNIV; UNIV_NOT_EMPTY; SUBSET_UNIV]);; (* ------------------------------------------------------------------------- *) (* Convex cones and corresponding hulls. *) (* ------------------------------------------------------------------------- *) let convex_cone = new_definition `convex_cone s <=> ~(s = {}) /\ convex s /\ conic s`;; let CONVEX_CONE = prove (`!s:real^N->bool. convex_cone s <=> vec 0 IN s /\ (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\ (!x c. x IN s /\ &0 <= c ==> (c % x) IN s)`, GEN_TAC THEN REWRITE_TAC[convex_cone; GSYM conic] THEN ASM_CASES_TAC `conic(s:real^N->bool)` THEN ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[conic]) THEN REWRITE_TAC[convex] THEN EQ_TAC THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&2 % (x:real^N)`; `&2 % (y:real^N)`; `&1 / &2`; `&1 / &2`]) THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[VECTOR_MUL_LID; REAL_POS]);; let CONVEX_CONE_ADD = prove (`!s x y. convex_cone s /\ x IN s /\ y IN s ==> (x + y) IN s`, MESON_TAC[CONVEX_CONE]);; let CONVEX_CONE_MUL = prove (`!s c x. convex_cone s /\ &0 <= c /\ x IN s ==> (c % x) IN s`, MESON_TAC[CONVEX_CONE]);; let CONVEX_CONE_NONEMPTY = prove (`!s. convex_cone s ==> ~(s = {})`, MESON_TAC[CONVEX_CONE; MEMBER_NOT_EMPTY]);; let CONVEX_CONE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. convex_cone s /\ linear f ==> convex_cone(IMAGE f s)`, SIMP_TAC[convex_cone; CONVEX_LINEAR_IMAGE; IMAGE_EQ_EMPTY; CONIC_LINEAR_IMAGE]);; let CONVEX_CONE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (convex_cone(IMAGE f s) <=> convex_cone s)`, REWRITE_TAC[convex_cone] THEN MESON_TAC[IMAGE_EQ_EMPTY; CONVEX_LINEAR_IMAGE_EQ; CONIC_LINEAR_IMAGE_EQ]);; add_linear_invariants [CONVEX_CONE_LINEAR_IMAGE_EQ];; let CONVEX_CONE_HALFSPACE_GE = prove (`!a. convex_cone {x | a dot x >= &0}`, SIMP_TAC[CONVEX_CONE; real_ge; IN_ELIM_THM; DOT_RZERO; DOT_RADD; DOT_RMUL; REAL_LE_ADD; REAL_LE_MUL; REAL_LE_REFL]);; let CONVEX_CONE_HALFSPACE_LE = prove (`!a. convex_cone {x | a dot x <= &0}`, REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`; GSYM DOT_LNEG] THEN REWRITE_TAC[GSYM real_ge; CONVEX_CONE_HALFSPACE_GE]);; let CONVEX_CONE_CONTAINS_0 = prove (`!s:real^N->bool. convex_cone s ==> vec 0 IN s`, SIMP_TAC[CONVEX_CONE]);; let CONVEX_CONE_INTERS = prove (`!f. (!s:real^N->bool. s IN f ==> convex_cone s) ==> convex_cone(INTERS f)`, SIMP_TAC[convex_cone; CONIC_INTERS; CONVEX_INTERS] THEN REWRITE_TAC[GSYM convex_cone] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_SIMP_TAC[IN_INTERS; CONVEX_CONE_CONTAINS_0]);; let CONVEX_CONE_CONVEX_CONE_HULL = prove (`!s. convex_cone(convex_cone hull s)`, SIMP_TAC[P_HULL; CONVEX_CONE_INTERS]);; let CONVEX_CONVEX_CONE_HULL = prove (`!s. convex(convex_cone hull s)`, MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; convex_cone]);; let CONIC_CONVEX_CONE_HULL = prove (`!s. conic(convex_cone hull s)`, MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; convex_cone]);; let CONVEX_CONE_HULL_NONEMPTY = prove (`!s. ~(convex_cone hull s = {})`, MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; convex_cone]);; let CONVEX_CONE_HULL_CONTAINS_0 = prove (`!s. vec 0 IN convex_cone hull s`, MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; CONVEX_CONE]);; let CONVEX_CONE_HULL_ADD = prove (`!s x y:real^N. x IN convex_cone hull s /\ y IN convex_cone hull s ==> x + y IN convex_cone hull s`, MESON_TAC[CONVEX_CONE; CONVEX_CONE_CONVEX_CONE_HULL]);; let CONVEX_CONE_HULL_MUL = prove (`!s c x:real^N. &0 <= c /\ x IN convex_cone hull s ==> (c % x) IN convex_cone hull s`, MESON_TAC[CONVEX_CONE; CONVEX_CONE_CONVEX_CONE_HULL]);; let CONVEX_CONE_SUMS = prove (`!s t. convex_cone s /\ convex_cone t ==> convex_cone {x + y:real^N | x IN s /\ y IN t}`, SIMP_TAC[convex_cone; CONIC_SUMS; CONVEX_SUMS] THEN SET_TAC[]);; let CONVEX_CONE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. convex_cone s /\ convex_cone t ==> convex_cone(s PCROSS t)`, SIMP_TAC[convex_cone; CONVEX_PCROSS; CONIC_PCROSS; PCROSS_EQ_EMPTY]);; let CONVEX_CONE_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. convex_cone(s PCROSS t) <=> convex_cone s /\ convex_cone t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_REWRITE_TAC[PCROSS_EMPTY; convex_cone]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[PCROSS_EMPTY; convex_cone]; ALL_TAC] THEN EQ_TAC THEN REWRITE_TAC[CONVEX_CONE_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_CONE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_CONE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let CONVEX_CONE_HULL_UNION = prove (`!s t. convex_cone hull(s UNION t) = {x + y:real^N | x IN convex_cone hull s /\ y IN convex_cone hull t}`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[CONVEX_CONE_SUMS; CONVEX_CONE_CONVEX_CONE_HULL] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_SIMP_TAC[HULL_INC; CONVEX_CONE_HULL_CONTAINS_0; VECTOR_ADD_RID]; MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN ASM_SIMP_TAC[HULL_INC; CONVEX_CONE_HULL_CONTAINS_0; VECTOR_ADD_LID]]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_CONE_HULL_ADD THEN ASM_MESON_TAC[HULL_MONO; SUBSET_UNION; SUBSET]]);; let CONVEX_CONE_SING = prove (`convex_cone {vec 0}`, SIMP_TAC[CONVEX_CONE; IN_SING; VECTOR_ADD_LID; VECTOR_MUL_RZERO]);; let CONVEX_HULL_SUBSET_CONVEX_CONE_HULL = prove (`!s. convex hull s SUBSET convex_cone hull s`, GEN_TAC THEN MATCH_MP_TAC HULL_ANTIMONO THEN SIMP_TAC[convex_cone; SUBSET; IN]);; let CONIC_HULL_SUBSET_CONVEX_CONE_HULL = prove (`!s. conic hull s SUBSET convex_cone hull s`, GEN_TAC THEN MATCH_MP_TAC HULL_ANTIMONO THEN SIMP_TAC[convex_cone; SUBSET; IN]);; let CONVEX_CONE_HULL_SEPARATE_NONEMPTY = prove (`!s:real^N->bool. ~(s = {}) ==> convex_cone hull s = conic hull (convex hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONIC_CONVEX_CONE_HULL; CONVEX_HULL_SUBSET_CONVEX_CONE_HULL] THEN ASM_SIMP_TAC[CONVEX_CONIC_HULL; CONVEX_CONVEX_HULL; CONIC_CONIC_HULL; convex_cone; CONIC_HULL_EQ_EMPTY; CONVEX_HULL_EQ_EMPTY] THEN ASM_MESON_TAC[HULL_SUBSET; SUBSET_REFL; SUBSET_TRANS]);; let CONVEX_CONE_HULL_EMPTY = prove (`convex_cone hull {} = {vec 0}`, MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[CONVEX_CONE_CONTAINS_0; EMPTY_SUBSET; CONVEX_CONE_SING; SET_RULE `{a} SUBSET s <=> a IN s`; CONVEX_CONE_CONTAINS_0]);; let CONVEX_CONE_HULL_SEPARATE = prove (`!s:real^N->bool. convex_cone hull s = vec 0 INSERT conic hull (convex hull s)`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_EMPTY; CONVEX_HULL_EMPTY; CONIC_HULL_EMPTY] THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY] THEN MATCH_MP_TAC(SET_RULE `a IN s ==> s = a INSERT s`) THEN ASM_SIMP_TAC[CONIC_CONTAINS_0; CONIC_CONIC_HULL] THEN ASM_REWRITE_TAC[CONIC_HULL_EQ_EMPTY; CONVEX_HULL_EQ_EMPTY]);; let CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY = prove (`!s:real^N->bool. ~(s = {}) ==> convex_cone hull s = {c % x | &0 <= c /\ x IN convex hull s}`, SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY; CONIC_HULL_EXPLICIT]);; let CONVEX_CONE_HULL_CONVEX_HULL = prove (`!s:real^N->bool. convex_cone hull s = vec 0 INSERT {c % x | &0 <= c /\ x IN convex hull s}`, REWRITE_TAC[CONVEX_CONE_HULL_SEPARATE; CONIC_HULL_EXPLICIT]);; let CONVEX_CONE_HULL_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f ==> convex_cone hull (IMAGE f s) = IMAGE f (convex_cone hull s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M-> bool = {}` THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY; IMAGE_EQ_EMPTY; CONVEX_HULL_LINEAR_IMAGE; CONIC_HULL_LINEAR_IMAGE] THEN REWRITE_TAC[IMAGE_CLAUSES; CONVEX_CONE_HULL_EMPTY] THEN MATCH_MP_TAC(SET_RULE `f x = y ==> {y} = {f x}`) THEN ASM_MESON_TAC[LINEAR_0]);; add_linear_invariants [CONVEX_CONE_HULL_LINEAR_IMAGE];; let SUBSPACE_IMP_CONVEX_CONE = prove (`!s. subspace s ==> convex_cone s`, SIMP_TAC[subspace; CONVEX_CONE]);; let CONVEX_CONE_SPAN = prove (`!s. convex_cone(span s)`, SIMP_TAC[convex_cone; CONVEX_SPAN; CONIC_SPAN; GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[SPAN_0]);; let CONVEX_CONE_NEGATIONS = prove (`!s. convex_cone s ==> convex_cone (IMAGE (--) s)`, SIMP_TAC[convex_cone; IMAGE_EQ_EMPTY; CONIC_NEGATIONS; CONVEX_NEGATIONS]);; let SUBSPACE_CONVEX_CONE_SYMMETRIC = prove (`!s:real^N->bool. subspace s <=> convex_cone s /\ (!x. x IN s ==> --x IN s)`, GEN_TAC THEN REWRITE_TAC[subspace; CONVEX_CONE] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THENL [ASM_MESON_TAC[VECTOR_ARITH `--x:real^N = -- &1 % x`]; MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN DISCH_TAC THEN DISJ_CASES_TAC(SPEC `c:real` REAL_LE_NEGTOTAL) THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_ARITH `c % x:real^N = --(--c % x)`]]);; let SPAN_CONVEX_CONE_ALLSIGNS = prove (`!s:real^N->bool. span s = convex_cone hull (s UNION IMAGE (--) s)`, GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN CONJ_TAC THENL [MESON_TAC[HULL_SUBSET; SUBSET_UNION; SUBSET_TRANS]; ALL_TAC] THEN REWRITE_TAC[SUBSPACE_CONVEX_CONE_SYMMETRIC; CONVEX_CONE_CONVEX_CONE_HULL] THEN MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION; IN_IMAGE] THEN DISCH_TAC THEN MATCH_MP_TAC HULL_INC THEN REWRITE_TAC[IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]; SUBGOAL_THEN `!s. {x:real^N | (--x) IN s} = IMAGE (--) s` (fun th -> SIMP_TAC[th; CONVEX_CONE_NEGATIONS; CONVEX_CONE_CONVEX_CONE_HULL]) THEN GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[VECTOR_NEG_NEG]]; MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONE_SPAN] THEN REWRITE_TAC[UNION_SUBSET; SPAN_INC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN MESON_TAC[SPAN_SUPERSET; SPAN_NEG]]);; (* ------------------------------------------------------------------------- *) (* Epigraphs of convex functions. *) (* ------------------------------------------------------------------------- *) let epigraph = new_definition `epigraph s (f:real^N->real) = {xy:real^((N,1)finite_sum) | fstcart xy IN s /\ f(fstcart xy) <= drop(sndcart xy)}`;; let IN_EPIGRAPH = prove (`!x y. (pastecart x (lift y)) IN epigraph s f <=> x IN s /\ f(x) <= y`, REWRITE_TAC[epigraph; IN_ELIM_THM; FSTCART_PASTECART; SNDCART_PASTECART; LIFT_DROP]);; let CONVEX_EPIGRAPH = prove (`!f s. f convex_on s /\ convex s <=> convex(epigraph s f)`, REWRITE_TAC[convex; convex_on; IN_ELIM_THM; SNDCART_ADD; SNDCART_CMUL; epigraph; FSTCART_ADD; FSTCART_CMUL; FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[GSYM FORALL_DROP; DROP_ADD; DROP_CMUL] THEN MESON_TAC[REAL_LE_REFL; REAL_LE_ADD2; REAL_LE_LMUL; REAL_LE_TRANS]);; let CONVEX_EPIGRAPH_CONVEX = prove (`!f s. convex s ==> (f convex_on s <=> convex(epigraph s f))`, REWRITE_TAC[GSYM CONVEX_EPIGRAPH] THEN CONV_TAC TAUT);; let CONVEX_ON_EPIGRAPH_SLICE_LE = prove (`!f:real^N->real s a. f convex_on s /\ convex s ==> convex {x | x IN s /\ f(x) <= a}`, SIMP_TAC[convex_on; convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REWRITE_TAC[]);; let CONVEX_ON_EPIGRAPH_SLICE_LT = prove (`!f:real^N->real s a. f convex_on s /\ convex s ==> convex {x | x IN s /\ f(x) < a}`, SIMP_TAC[convex_on; convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REWRITE_TAC[]);; let CONVEX_ON_SUP = prove (`!t:A->bool s:real^N->bool. convex s /\ (!i. i IN t ==> f i convex_on s) /\ (!x. x IN s ==> ?B. !i. i IN t ==> f i x <= B) ==> (\x. sup {f i x | i IN t}) convex_on s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:A->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; CONVEX_ON_CONST; SET_RULE `{f i x | i | F} = {}`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[CONVEX_EPIGRAPH_CONVEX] THEN DISCH_TAC THEN SUBGOAL_THEN `convex(INTERS {epigraph (s:real^N->bool) (f i) | (i:A) IN t})` MP_TAC THENL [ASM_SIMP_TAC[CONVEX_INTERS; FORALL_IN_GSPEC]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; INTERS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[epigraph; IN_ELIM_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real`] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL [CONV_TAC SYM_CONV; ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_SUP_LE_EQ o lhand o snd) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Use this to derive general bound property of convex function. *) (* ------------------------------------------------------------------------- *) let FORALL_OF_PASTECART = prove (`(!p. P (fstcart o p) (sndcart o p)) <=> (!x:A->B^M y:A->B^N. P x y)`, EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\a:A. pastecart (x a :B^M) (y a :B^N)`) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);; let FORALL_OF_DROP = prove (`(!v. P (drop o v)) <=> (!x:A->real. P x)`, EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\a:A. lift(x a)`) THEN REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);; let CONVEX_ON_JENSEN = prove (`!f:real^N->real s. convex s ==> (f convex_on s <=> !k u x. (!i:num. 1 <= i /\ i <= k ==> &0 <= u(i) /\ x(i) IN s) /\ (sum (1..k) u = &1) ==> f(vsum (1..k) (\i. u(i) % x(i))) <= sum (1..k) (\i. u(i) * f(x(i))))`, let lemma = prove (`(!x. P x ==> (Q x = R x)) ==> (!x. P x) ==> ((!x. Q x) <=> (!x. R x))`, MESON_TAC[]) in REPEAT STRIP_TAC THEN FIRST_ASSUM (fun th -> REWRITE_TAC[MATCH_MP CONVEX_EPIGRAPH_CONVEX th]) THEN REWRITE_TAC[CONVEX_INDEXED; epigraph] THEN SIMP_TAC[IN_ELIM_THM; SNDCART_ADD; SNDCART_CMUL; FINITE_NUMSEG; FSTCART_ADD; FSTCART_CMUL; FORALL_PASTECART; DROP_CMUL; FSTCART_PASTECART; SNDCART_PASTECART; FSTCART_VSUM; SNDCART_VSUM; DROP_VSUM; o_DEF] THEN REWRITE_TAC[GSYM(ISPEC `fstcart` o_THM); GSYM(ISPEC `sndcart` o_THM)] THEN REWRITE_TAC[GSYM(ISPEC `drop` o_THM)] THEN REWRITE_TAC[FORALL_OF_PASTECART; FORALL_OF_DROP] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_INDEXED]) THEN REPEAT(MATCH_MP_TAC lemma THEN GEN_TAC) THEN SIMP_TAC[] THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(K ALL_TAC) THEN EQ_TAC THEN SIMP_TAC[REAL_LE_REFL] THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LE_LMUL]);; let CONVEX_ON_IMP_JENSEN = prove (`!f:real^N->real s k:A->bool u x. f convex_on s /\ convex s /\ FINITE k /\ (!i. i IN k ==> &0 <= u i /\ x i IN s) /\ sum k u = &1 ==> f(vsum k (\i. u i % x i)) <= sum k (\i. u i * f(x i))`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ABBREV_TAC `n = CARD(k:A->bool)` THEN REWRITE_TAC[INJECTIVE_ON_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN ASM_SIMP_TAC[VSUM_IMAGE; SUM_IMAGE; FINITE_NUMSEG; IMP_CONJ; o_DEF] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`] CONVEX_ON_JENSEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Another intermediate value theorem formulation. *) (* ------------------------------------------------------------------------- *) let IVT_INCREASING_COMPONENT_ON_1 = prove (`!f:real^1->real^N a b y k. drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ f continuous_on interval[a,b] /\ f(a)$k <= y /\ y <= f(b)$k ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (f:real^1->real^N) (interval[a,b])`] CONNECTED_IVT_COMPONENT) THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONVEX_CONNECTED; CONVEX_INTERVAL] THEN EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN EXISTS_TAC `b:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]);; let IVT_INCREASING_COMPONENT_1 = prove (`!f:real^1->real^N a b y k. drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN interval[a,b] ==> f continuous at x) /\ f(a)$k <= y /\ y <= f(b)$k ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN ASM_SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; let IVT_DECREASING_COMPONENT_ON_1 = prove (`!f:real^1->real^N a b y k. drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ f continuous_on interval[a,b] /\ f(b)$k <= y /\ y <= f(a)$k ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN ASM_SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN ASM_SIMP_TAC[VECTOR_NEG_COMPONENT; CONTINUOUS_ON_NEG; REAL_LE_NEG2]);; let IVT_DECREASING_COMPONENT_1 = prove (`!f:real^1->real^N a b y k. drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN interval[a,b] ==> f continuous at x) /\ f(b)$k <= y /\ y <= f(a)$k ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_DECREASING_COMPONENT_ON_1 THEN ASM_SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; (* ------------------------------------------------------------------------- *) (* A bound within a convex hull, and so an interval. *) (* ------------------------------------------------------------------------- *) let CONVEX_ON_CONVEX_HULL_BOUND = prove (`!f s b. f convex_on (convex hull s) /\ (!x:real^N. x IN s ==> f(x) <= b) ==> !x. x IN convex hull s ==> f(x) <= b`, REPEAT GEN_TAC THEN SIMP_TAC[CONVEX_ON_JENSEN; CONVEX_CONVEX_HULL] THEN STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_INDEXED] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:num`; `u:num->real`; `v:num->real^N`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..k) (\i. u i * f(v i :real^N))` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; HULL_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..k) (\i. u i * b)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LE_LMUL]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[SUM_LMUL] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_MUL_RID]);; let CONVEX_ON_CONVEX_HULL_BOUND_EQ = prove (`!f s:real^N->bool b. f convex_on convex hull s ==> ((!x. x IN convex hull s ==> f x <= b) <=> (!x. x IN s ==> f x <= b))`, MESON_TAC[CONVEX_ON_CONVEX_HULL_BOUND; HULL_INC]);; let DIST_CONVEX_HULL_BOUND_EQ = prove (`!s a:real^N d. (!x. x IN convex hull s ==> dist(a,x) <= d) <=> (!x. x IN s ==> dist(a,x) <= d)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_ON_CONVEX_HULL_BOUND_EQ THEN REWRITE_TAC[CONVEX_DISTANCE]);; let DIST_CONVEX_HULL_BOUND_2 = prove (`!s:real^N->bool d. (!x y. x IN convex hull s /\ y IN convex hull s ==> dist(x,y) <= d) <=> (!x y. x IN s /\ y IN s ==> dist(x,y) <= d)`, MESON_TAC[DIST_CONVEX_HULL_BOUND_EQ; DIST_SYM]);; let DIAMETER_CONVEX_HULL = prove (`!s:real^N->bool. diameter(convex hull s) = diameter s`, GEN_TAC THEN REWRITE_TAC[diameter; CONVEX_HULL_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUP_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist; DIST_CONVEX_HULL_BOUND_2]);; let DIAMETER_SIMPLEX = prove (`!s:real^N->bool. ~(s = {}) ==> diameter(convex hull s) = sup { dist(x,y) | x IN s /\ y IN s}`, REWRITE_TAC[DIAMETER_CONVEX_HULL] THEN SIMP_TAC[diameter; dist]);; let UNIT_INTERVAL_CONVEX_HULL = prove (`interval [vec 0,vec 1:real^N] = convex hull {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> ((x$i = &0) \/ (x$i = &1))}`, let lemma = prove (`FINITE {i | 1 <= i /\ i <= n /\ P(i)} /\ CARD {i | 1 <= i /\ i <= n /\ P(i)} <= n`, CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..n`; GEN_REWRITE_TAC RAND_CONV [ARITH_RULE `x = (x + 1) - 1`] THEN REWRITE_TAC[GSYM CARD_NUMSEG] THEN MATCH_MP_TAC CARD_SUBSET] THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET; IN_ELIM_THM]) in MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN SIMP_TAC[VEC_COMPONENT] THEN MESON_TAC[REAL_LE_REFL; REAL_POS]] THEN SUBGOAL_THEN `!n x:real^N. x IN interval[vec 0,vec 1] /\ n <= dimindex(:N) /\ CARD {i | 1 <= i /\ i <= dimindex(:N) /\ ~(x$i = &0)} <= n ==> x IN convex hull {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> ((x$i = &0) \/ (x$i = &1))}` MP_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[LE_REFL; lemma]] THEN INDUCT_TAC THEN X_GEN_TAC `x:real^N` THENL [SIMP_TAC[LE; lemma; CARD_EQ_0] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; BETA_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN STRIP_TAC THEN SUBGOAL_THEN `x = vec 0:real^N` SUBST1_TAC THENL [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN SIMP_TAC[IN_ELIM_THM; VEC_COMPONENT]; ALL_TAC] THEN ASM_CASES_TAC `{i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)} = {}` THENL [DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; BETA_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN STRIP_TAC THEN SUBGOAL_THEN `x = vec 0:real^N` SUBST1_TAC THENL [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN SIMP_TAC[IN_ELIM_THM; VEC_COMPONENT]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE (\i. x$i) {i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)}` INF_FINITE) THEN ABBREV_TAC `xi = inf (IMAGE (\i. x$i) {i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)})` THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; lemma] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= (x:real^N)$i /\ x$i <= &1` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `x:real^N IN interval [vec 0,vec 1]` THEN ASM_SIMP_TAC[IN_INTERVAL; VEC_COMPONENT]; ALL_TAC] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `x <= &1 ==> (x = &1) \/ x < &1`)) THENL [SUBGOAL_THEN `x = lambda i. if (x:real^N)$i = &0 then &0 else &1` SUBST1_TAC THENL [UNDISCH_TAC `x:real^N IN interval [vec 0,vec 1]` THEN ASM_SIMP_TAC[CART_EQ; IN_INTERVAL; VEC_COMPONENT; LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `x:real^N = x$i % (lambda j. if x$j = &0 then &0 else &1) + (&1 - x$i) % (lambda j. if x$j = &0 then &0 else (x$j - x$i) / (&1 - x$i))` SUBST1_TAC THENL [SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA; VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; ARITH_RULE `x < &1 ==> ~(&1 - x = &0)`] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[convex] CONVEX_CONVEX_HULL) THEN ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> &0 <= &1 - x`; REAL_ARITH `x + &1 - x = &1`] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN SIMP_TAC[LAMBDA_BETA; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `SUC k <= n ==> k <= n`] THEN CONJ_TAC THENL [SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN GEN_TAC THEN STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_ARITH `x < &1 ==> &0 < &1 - x`] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_LE; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_ARITH `a - b <= &1 - b <=> a <= &1`] THEN UNDISCH_TAC `x:real^N IN interval [vec 0,vec 1]` THEN ASM_SIMP_TAC[CART_EQ; IN_INTERVAL; VEC_COMPONENT; LAMBDA_BETA]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD({i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)} DELETE i)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[lemma; FINITE_DELETE] THEN REWRITE_TAC[SUBSET; IN_DELETE; IN_ELIM_THM] THEN GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN SIMP_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO]; SIMP_TAC[lemma; CARD_DELETE] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH_RULE `x <= SUC n ==> x - 1 <= n`] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Representation of any interval as a finite convex hull. *) (* ------------------------------------------------------------------------- *) let CLOSED_INTERVAL_AS_CONVEX_HULL = prove (`!a b:real^N. ?s. FINITE s /\ interval[a,b] = convex hull s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM_MESON_TAC[CONVEX_HULL_EMPTY; FINITE_EMPTY]; ALL_TAC] THEN ASM_SIMP_TAC[CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL] THEN SUBGOAL_THEN `?s:real^N->bool. FINITE s /\ interval[vec 0,vec 1] = convex hull s` STRIP_ASSUME_TAC THENL [EXISTS_TAC `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> ((x$i = &0) \/ (x$i = &1))}` THEN REWRITE_TAC[UNIT_INTERVAL_CONVEX_HULL] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\s. (lambda i. if i IN s then &1 else &0):real^N) {t | t SUBSET (1..dimindex(:N))}` THEN ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `{i | 1 <= i /\ i <= dimindex(:N) /\ ((x:real^N)$i = &1)}` THEN SIMP_TAC[CART_EQ; IN_ELIM_THM; IN_NUMSEG; LAMBDA_BETA] THEN ASM_MESON_TAC[]; EXISTS_TAC `IMAGE (\x:real^N. a + x) (IMAGE (\x. (lambda i. ((b:real^N)$i - a$i) * x$i)) (s:real^N->bool))` THEN ASM_SIMP_TAC[FINITE_IMAGE; CONVEX_HULL_TRANSLATION] THEN AP_TERM_TAC THEN MATCH_MP_TAC(GSYM CONVEX_HULL_LINEAR_IMAGE) THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Characterizations of convex functions in terms of secants. *) (* ------------------------------------------------------------------------- *) let [CONVEX_ON_LEFT_SECANT_MUL; CONVEX_ON_RIGHT_SECANT_MUL; CONVEX_ON_MID_SECANT_MUL] = (CONJUNCTS o prove) (`(!f s:real^N->bool. f convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN segment[a,b] ==> (f x - f a) * norm(b - a) <= (f b - f a) * norm(x - a)) /\ (!f s:real^N->bool. f convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN segment[a,b] ==> (f b - f a) * norm(b - x) <= (f b - f x) * norm(b - a)) /\ (!f s:real^N->bool. f convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN segment[a,b] ==> (f x - f a) * norm (b - x) <= (f b - f x) * norm(x - a))`, REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[convex_on] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN REWRITE_TAC[] THEN REWRITE_TAC[TAUT `a /\ x = y <=> x = y /\ a`; TAUT `a /\ x = y /\ b <=> x = y /\ a /\ b`] THEN REWRITE_TAC[REAL_ARITH `v + u = &1 <=> v = &1 - u`] THEN REWRITE_TAC[FORALL_UNWIND_THM2; IMP_CONJ] THEN REWRITE_TAC[REAL_SUB_LE] THEN ASM_CASES_TAC `&0 <= u` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `u <= &1` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `((&1 - u) % a + u % b) - a:real^N = u % (b - a)`; VECTOR_ARITH `b - ((&1 - u) % a + u % b):real^N = (&1 - u) % (b - a)`] THEN REWRITE_TAC[NORM_MUL; REAL_MUL_ASSOC] THEN (ASM_CASES_TAC `b:real^N = a` THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL; REAL_SUB_REFL; VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= u /\ u <= &1 ==> abs u = u /\ abs(&1 - u) = &1 - u`] THEN REAL_ARITH_TAC]));; let [CONVEX_ON_LEFT_SECANT; CONVEX_ON_RIGHT_SECANT; CONVEX_ON_MID_SECANT] = (CONJUNCTS o prove) (`(!f s:real^N->bool. f convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN segment(a,b) ==> (f x - f a) / norm(x - a) <= (f b - f a) / norm(b - a)) /\ (!f s:real^N->bool. f convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN segment(a,b) ==> (f b - f a) / norm(b - a) <= (f b - f x) / norm(b - x)) /\ (!f s:real^N->bool. f convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN segment(a,b) ==> (f x - f a) / norm (x - a) <= (f b - f x) / norm(b - x))`, REPEAT CONJ_TAC THEN REPEAT GEN_TAC THENL [REWRITE_TAC[CONVEX_ON_LEFT_SECANT_MUL]; REWRITE_TAC[CONVEX_ON_RIGHT_SECANT_MUL]; REWRITE_TAC[CONVEX_ON_MID_SECANT_MUL]] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY; REAL_SUB_REFL; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_REFL] THEN REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2; REAL_LE_REFL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[] THEN REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MAP_EVERY ASM_CASES_TAC [`x:real^N = a`; `x:real^N = b`] THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_SUB_REFL; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let CONVEX_ON_SECANTS_1_IMP = prove (`!f s a b c d. f convex_on s /\ a IN s /\ b IN s /\ c IN s /\ d IN s /\ drop a < drop b /\ drop b <= drop c /\ drop c < drop d ==> (f b - f a) / (drop b - drop a) <= (f d - f c) / (drop d - drop c)`, REWRITE_TAC[CONVEX_ON_MID_SECANT] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `c:real^1 = b` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `drop a <= drop d` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `d:real^1`; `b:real^1`]) THEN ASM_SIMP_TAC[SEGMENT_1; NORM_1; DROP_SUB; REAL_LT_IMP_LE; real_abs; REAL_SUB_LT; IN_INTERVAL_1]; SUBGOAL_THEN `drop b < drop c` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ]; ALL_TAC]] THEN SUBGOAL_THEN `drop a <= drop c /\ drop b <= drop d` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `(f c - f b) / (drop c - drop b)` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `c:real^1`; `b:real^1`]); FIRST_X_ASSUM(MP_TAC o SPECL [`b:real^1`; `d:real^1`; `c:real^1`])] THEN ASM_SIMP_TAC[SEGMENT_1; NORM_1; DROP_SUB; REAL_LT_IMP_LE; real_abs; REAL_SUB_LT; IN_INTERVAL_1]);; let CONVEX_ON_SECANTS_1 = prove (`!f s. is_interval s ==> (f convex_on s <=> !a b c d. a IN s /\ b IN s /\ c IN s /\ d IN s /\ drop a < drop b /\ drop b <= drop c /\ drop c < drop d ==> (f b - f a) / (drop b - drop a) <= (f d - f c) / (drop d - drop c))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[CONVEX_ON_SECANTS_1_IMP]; DISCH_TAC] THEN REWRITE_TAC[CONVEX_ON_MID_SECANT] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `x:real^1`] THEN DISJ_CASES_THEN MP_TAC (REAL_ARITH `drop a = drop b \/ drop a < drop b \/ drop b < drop a`) THENL [ASM_MESON_TAC[DROP_EQ; SEGMENT_REFL; NOT_IN_EMPTY]; ALL_TAC] THEN STRIP_TAC THEN ASM_SIMP_TAC[SEGMENT_1; IN_INTERVAL_1; REAL_LT_IMP_LE; REAL_ARITH `a < b ==> ~(b <= a)`] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `x:real^1`; `x:real^1`; `b:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB; REAL_LT_IMP_LE; real_abs; REAL_SUB_LT; REAL_LE_REFL] THEN ASM_MESON_TAC[IS_INTERVAL_1; REAL_LT_IMP_LE]; FIRST_X_ASSUM(MP_TAC o SPECL [`b:real^1`; `x:real^1`; `x:real^1`; `a:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB; REAL_LT_IMP_LE; real_abs; REAL_SUB_LT; REAL_LE_REFL; REAL_SUB_LE; REAL_ARITH `a < b ==> ~(b <= a)`] THEN REWRITE_TAC[REAL_NEG_SUB] THEN ANTS_TAC THENL [ASM_MESON_TAC[IS_INTERVAL_1; REAL_LT_IMP_LE]; REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Starlike sets and more stuff about line segments. *) (* ------------------------------------------------------------------------- *) let starlike = new_definition `starlike s <=> ?a. a IN s /\ !x. x IN s ==> segment[a,x] SUBSET s`;; let CONVEX_IMP_STARLIKE = prove (`!s. convex s /\ ~(s = {}) ==> starlike s`, REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; starlike; GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[]);; let CONIC_IMP_STARLIKE = prove (`!s:real^N->bool. conic s /\ ~(s = {}) ==> starlike s`, REPEAT STRIP_TAC THEN REWRITE_TAC[starlike] THEN EXISTS_TAC `vec 0:real^N` THEN SUBGOAL_THEN `(vec 0:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[CONIC_CONTAINS_0]; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[conic]) THEN ASM_SIMP_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID]);; let SEGMENT_CONVEX_HULL = prove (`!a b. segment[a,b] = convex hull {a,b}`, REPEAT GEN_TAC THEN SIMP_TAC[CONVEX_HULL_INSERT; CONVEX_HULL_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN REWRITE_TAC[segment; EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[REAL_LE_SUB_LADD; REAL_ADD_LID] THEN MESON_TAC[]);; let CONTINUOUS_INCREASING_IMAGE_INTERVAL_1 = prove (`!f:real^1->real^1 a b. ~(interval[a,b] = {}) /\ f continuous_on interval[a,b] /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> IMAGE f (interval[a,b]) = interval[f a,f b]`, REWRITE_TAC[INTERVAL_NE_EMPTY_1; IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `segment[(f:real^1->real^1) a,f b]` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SEGMENT_1; REAL_LE_REFL; SUBSET_REFL]; ALL_TAC] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; FUN_IN_IMAGE; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; CONVEX_CONNECTED_1] THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONNECTED_INTERVAL]);; let CONTINUOUS_DECREASING_IMAGE_INTERVAL_1 = prove (`!f:real^1->real^1 a b. ~(interval[a,b] = {}) /\ f continuous_on interval[a,b] /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> IMAGE f (interval[a,b]) = interval[f b,f a]`, REWRITE_TAC[INTERVAL_NE_EMPTY_1; IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `segment[(f:real^1->real^1) b,f a]` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SEGMENT_1; REAL_LE_REFL; SUBSET_REFL]; ALL_TAC] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; FUN_IN_IMAGE; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; CONVEX_CONNECTED_1] THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONNECTED_INTERVAL]);; let SEGMENT_FURTHEST_LE = prove (`!a b x y:real^N. x IN segment[a,b] ==> norm(y - x) <= norm(y - a) \/ norm(y - x) <= norm(y - b)`, REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`y:real^N`; `{a:real^N,b}`] SIMPLEX_FURTHEST_LE) THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_MESON_TAC[NORM_SUB]);; let SEGMENT_BOUND = prove (`!a b x:real^N. x IN segment[a,b] ==> norm(x - a) <= norm(b - a) /\ norm(x - b) <= norm(b - a)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:real^N`; `b:real^N`; `x:real^N`] SEGMENT_FURTHEST_LE) THENL [DISCH_THEN(MP_TAC o SPEC `a:real^N`); DISCH_THEN(MP_TAC o SPEC `b:real^N`)] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN ASM_MESON_TAC[NORM_POS_LE; REAL_LE_TRANS; NORM_SUB]);; let BETWEEN_IN_CONVEX_HULL = prove (`!x a b:real^N. between x (a,b) <=> x IN convex hull {a,b}`, REWRITE_TAC[BETWEEN_IN_SEGMENT; SEGMENT_CONVEX_HULL]);; let STARLIKE_LINEAR_IMAGE = prove (`!f s. starlike s /\ linear f ==> starlike(IMAGE f s)`, REWRITE_TAC[starlike; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN SIMP_TAC[CLOSED_SEGMENT_LINEAR_IMAGE] THEN SET_TAC[]);; let STARLIKE_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (starlike (IMAGE f s) <=> starlike s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE STARLIKE_LINEAR_IMAGE));; add_linear_invariants [STARLIKE_LINEAR_IMAGE_EQ];; let STARLIKE_TRANSLATION_EQ = prove (`!a s. starlike (IMAGE (\x. a + x) s) <=> starlike s`, REWRITE_TAC[starlike] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [STARLIKE_TRANSLATION_EQ];; let BETWEEN_LINEAR_IMAGE_EQ = prove (`!f x y z. linear f /\ (!x y. f x = f y ==> x = y) ==> (between (f x) (f y,f z) <=> between x (y,z))`, SIMP_TAC[BETWEEN_IN_SEGMENT; CLOSED_SEGMENT_LINEAR_IMAGE] THEN SET_TAC[]);; add_linear_invariants [BETWEEN_LINEAR_IMAGE_EQ];; let STARLIKE_CLOSURE = prove (`!s:real^N->bool. starlike s ==> starlike(closure s)`, GEN_TAC THEN REWRITE_TAC[starlike; SUBSET; segment; FORALL_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN DISCH_TAC THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(&1 - u) % a + u % y:real^N` THEN ASM_SIMP_TAC[dist; NORM_MUL; VECTOR_ARITH `(v % a + u % y) - (v % a + u % z):real^N = u % (y - z)`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN REWRITE_TAC[dist; REAL_ARITH `u * n <= n <=> &0 <= n * (&1 - u)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC);; let STARLIKE_UNIV = prove (`starlike(:real^N)`, MESON_TAC[CONVEX_IMP_STARLIKE; CONVEX_UNIV; BOUNDED_EMPTY; NOT_BOUNDED_UNIV]);; let STARLIKE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. starlike s /\ starlike t ==> starlike(s PCROSS t)`, SIMP_TAC[starlike; EXISTS_IN_PCROSS; SUBSET; IN_SEGMENT] THEN REPEAT GEN_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[FORALL_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2; IMP_IMP] THEN REWRITE_TAC[GSYM PASTECART_CMUL; PASTECART_ADD] THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN MESON_TAC[]);; let STARLIKE_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. starlike(s PCROSS t) <=> starlike s /\ starlike t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_REWRITE_TAC[PCROSS_EMPTY] THEN MESON_TAC[starlike; NOT_IN_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[PCROSS_EMPTY] THEN MESON_TAC[starlike; NOT_IN_EMPTY]; ALL_TAC] THEN EQ_TAC THEN REWRITE_TAC[STARLIKE_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] STARLIKE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] STARLIKE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let BETWEEN_DIST_LT = prove (`!r a b c:real^N. dist(c,a) < r /\ dist(c,b) < r /\ between x (a,b) ==> dist(c,x) < r`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `convex hull {a,b} SUBSET ball(c:real^N,r)` MP_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[CONVEX_BALL; INSERT_SUBSET; EMPTY_SUBSET; IN_BALL]; ASM_SIMP_TAC[SUBSET; GSYM BETWEEN_IN_CONVEX_HULL; IN_BALL]]);; let BETWEEN_DIST_LE = prove (`!r a b c:real^N. dist(c,a) <= r /\ dist(c,b) <= r /\ between x (a,b) ==> dist(c,x) <= r`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `convex hull {a,b} SUBSET cball(c:real^N,r)` MP_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[CONVEX_CBALL; INSERT_SUBSET; EMPTY_SUBSET; IN_CBALL]; ASM_SIMP_TAC[SUBSET; GSYM BETWEEN_IN_CONVEX_HULL; IN_CBALL]]);; let BETWEEN_NORM_LT = prove (`!r a b x:real^N. norm a < r /\ norm b < r /\ between x (a,b) ==> norm x < r`, REWRITE_TAC[GSYM(CONJUNCT2(SPEC_ALL DIST_0)); BETWEEN_DIST_LT]);; let BETWEEN_NORM_LE = prove (`!r a b x:real^N. norm a <= r /\ norm b <= r /\ between x (a,b) ==> norm x <= r`, REWRITE_TAC[GSYM(CONJUNCT2(SPEC_ALL DIST_0)); BETWEEN_DIST_LE]);; let UNION_SEGMENT = prove (`!a b c:real^N. b IN segment[a,c] ==> segment[a,b] UNION segment[b,c] = segment[a,c]`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; UNION_IDEMPOT]; ONCE_REWRITE_TAC[UNION_COMM] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_HULL_EXCHANGE_UNION) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_2] THEN BINOP_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let CONVEX_STARCENTRES = prove (`!s:real^N->bool. convex {a | a IN s /\ !x. x IN s ==> segment[a,x] SUBSET s}`, GEN_TAC THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN X_GEN_TAC `c:real^N` THEN DISCH_THEN(DESTRUCT_TAC "a aseg b bseg c") THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `(z:real^N) IN convex hull {a,b,y}` MP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{a,b,y} = {y,b,a}`]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONVEX_HULL_INSERT_SEGMENTS] THEN REWRITE_TAC[NOT_INSERT_EMPTY; GSYM SEGMENT_CONVEX_HULL] THENL [ONCE_REWRITE_TAC[SEGMENT_SYM]; ALL_TAC] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* It might occasionally be handy to use midpoint convexity only. *) (* ------------------------------------------------------------------------- *) let MIDPOINT_CONVEX_SET = prove (`!s:real^N->bool. open s \/ closed s ==> (convex s <=> !a b. a IN s /\ b IN s ==> midpoint(a,b) IN s)`, GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN SIMP_TAC[MIDPOINT_IN_CONVEX] THEN DISCH_TAC THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_REWRITE_TAC[SEGMENT_REFL; SING_SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [SUBGOAL_THEN `?e. &0 < e /\ ball(a:real^N,e) SUBSET s /\ ball(b,e) SUBSET s` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `b:real^N` th) THEN MP_TAC(SPEC `a:real^N` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[BALL_MIN_INTER; REAL_LT_MIN] THEN ASM SET_TAC[]; ALL_TAC]; FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP CLOSED_APPROACHABLE th)]) THEN X_GEN_TAC `e:real` THEN DISCH_TAC] THEN MP_TAC(ISPECL [`inv(&2)`; `e / dist(a:real^N,b)`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; DIST_POS_LT; REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL [SUBGOAL_THEN `!n. ?c d:real^N. ball(c,e) SUBSET s /\ ball(d,e) SUBSET s /\ x IN segment[c,d] /\ dist(c,d) <= dist(a:real^N,b) / &2 pow n` (MP_TAC o SPEC `N:num`) THENL [INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_DIV_1] THENL [ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `c:real^N` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^N`; `midpoint(c:real^N,d)`; `d:real^N`] UNION_SEGMENT) THEN REWRITE_TAC[MIDPOINT_IN_SEGMENT] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN MATCH_MP_TAC(MESON[] `(x IN segment[a,b] ==> P a b) ==> x IN segment[a,b] ==> ?c d. P c d`) THEN DISCH_TAC THEN ASM_SIMP_TAC[DIST_MIDPOINT; real_div; REAL_INV_MUL] THEN (CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c + (y - midpoint(c,d)):real^N`; `d + (y - midpoint(c,d)):real^N`]) THEN REWRITE_TAC[midpoint; VECTOR_ARITH `inv(&2) % ((c + y - inv (&2) % (c + d)) + d + y - inv (&2) % (c + d)) = (y:real^N)`] THEN DISCH_THEN MATCH_MP_TAC THEN (CONJ_TAC THENL [UNDISCH_TAC `ball(c:real^N,e) SUBSET s`; UNDISCH_TAC `ball(d:real^N,e) SUBSET s`] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM midpoint; NORM_ARITH `dist(c:real^N,c + x - y) = dist(y,x)`]); REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 MATCH_MP_TAC STRIP_ASSUME_TAC)]; SUBGOAL_THEN `!n. ?c d:real^N. c IN s /\ d IN s /\ x IN segment[c,d] /\ dist(c,d) <= dist(a:real^N,b) / &2 pow n` (MP_TAC o SPEC `N:num`) THENL [INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_DIV_1] THENL [ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `c:real^N` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^N`; `midpoint(c:real^N,d)`; `d:real^N`] UNION_SEGMENT) THEN REWRITE_TAC[MIDPOINT_IN_SEGMENT] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN MATCH_MP_TAC(MESON[] `(x IN segment[a,b] ==> P a b) ==> x IN segment[a,b] ==> ?c d. P c d`) THEN DISCH_TAC THEN ASM_SIMP_TAC[DIST_MIDPOINT; real_div; REAL_INV_MUL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[]]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `dist(c,d) <= m ==> dist(c,x) <= dist(c,d) /\ m < e ==> dist(c:real^N,x) < e`)) THEN (CONJ_TAC THENL [ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM]; REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; DIST_POS_LT]]));; (* ------------------------------------------------------------------------- *) (* Eliminate scalings when 0 is not in the affine hull. *) (* ------------------------------------------------------------------------- *) let COLLINEAR_DESCALE = prove (`!a b c x y z:real^N. ~(a = &0) /\ ~(c = &0) /\ collinear {a % x,b % y,c % z} /\ ~(vec 0 IN affine hull {x,y,z}) ==> collinear {x,y,z}`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_0_3_EXPLICIT; COLLINEAR_3_EXPLICIT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ; VECTOR_MUL_ASSOC] THEN DISCH_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a':real`; `b':real`; `c':real`] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a' * a:real`; `b' * b:real`; `c' * c:real`] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a' * a:real`; `b' * b:real`; `c' * c:real`]) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o check ((=) `vec 0:real^N` o rand o concl)) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; let CLOSED_SEGMENT_DESCALE = prove (`!a b c x y z:real^N. &0 < a /\ &0 <= b /\ &0 < c /\ (b % y) IN segment[a % x,c % z] /\ ~(vec 0 IN affine hull {x,y,z}) ==> y IN segment[x,z]`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_0_3_EXPLICIT] THEN REWRITE_TAC[CONVEX_HULL_2; SEGMENT_CONVEX_HULL; IN_ELIM_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ; VECTOR_MUL_ASSOC] THEN REPLICATE_TAC 3 DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REWRITE_TAC[VECTOR_ARITH `b % y:real^N = a + c <=> a + (--b) % y + c = vec 0`] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`u * a / b:real`; `v * c / b:real`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`u * a:real`; `--b:real`; `v * c:real`]) THEN ASM_SIMP_TAC[] THEN ASM_CASES_TAC `b = &0` THENL [ASM_SIMP_TAC[REAL_NEG_0; REAL_ADD_LID; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [UNDISCH_TAC `~(b = &0)` THEN CONV_TAC REAL_FIELD; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv b):real^N->real^N`) THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RNEG; REAL_MUL_LINV] THEN REWRITE_TAC[real_div; REAL_MUL_AC] THEN CONV_TAC VECTOR_ARITH]]);; let OPEN_SEGMENT_DESCALE = prove (`!a b c x y z:real^N. &0 < a /\ &0 <= b /\ &0 < c /\ (b % y) IN segment(a % x,c % z) /\ ~(vec 0 IN affine hull {x,y,z}) /\ ~(x = y /\ z = y) ==> y IN segment(x,z)`, REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `(!a b c x y z. P a b c x y z ==> P c b a z y x) /\ (!a b c x y z. P a b c x y z /\ x = y ==> z = y) /\ (!a b c x y z. P a b c x y z /\ ~(x = y) /\ ~(z = y) ==> Q x y z) ==> !a b c x y z. P a b c x y z /\ ~(x = y /\ z = y) ==> Q x y z`) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM; INSERT_AC]; REPEAT GEN_TAC THEN ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `b % x:real^N = c % z` THEN ASM_REWRITE_TAC[ENDS_NOT_IN_SEGMENT] THEN ASM_CASES_TAC `z:real^N = x` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `{x,x,z} = {x,z}`; AFFINE_HULL_0_2_EXPLICIT] THEN REWRITE_TAC[NOT_EXISTS_THM; IN_SEGMENT] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(&1 - u) * a - b`; `u * c:real`]) THEN ASM_REWRITE_TAC[VECTOR_ARITH `(a - b) % x + z:real^N = vec 0 <=> b % x = a % x + z`] THEN CONJ_TAC THENL [CONV_TAC VECTOR_ARITH; ALL_TAC] THEN UNDISCH_TAC `~(b % x:real^N = c % z)` THEN ASM_REWRITE_TAC[CONTRAPOS_THM; VECTOR_ARITH `y + u % c % z = c % z <=> y = (&1 - u) % c % z`] THEN REWRITE_TAC[REAL_ARITH `a - b + c = &0 <=> b = a + c`] THEN DISCH_TAC THEN UNDISCH_TAC `b % x:real^N = (&1 - u) % a % x + u % c % z` THEN ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB; GSYM VECTOR_MUL_ASSOC] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ONCE_REWRITE_TAC[segment] THEN REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_SEGMENT_DESCALE]]);; (* ------------------------------------------------------------------------- *) (* Shrinking towards the interior of a convex set. *) (* ------------------------------------------------------------------------- *) let IN_INTERIOR_CONVEX_SHRINK = prove (`!s e x c:real^N. convex s /\ c IN interior s /\ x IN s /\ &0 < e /\ e <= &1 ==> x - e % (x - c) IN interior s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN REWRITE_TAC[IN_INTERIOR; SUBSET; IN_BALL; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e * d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y':real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / e) % y' - ((&1 - e) / e) % x:real^N`) THEN ANTS_TAC THENL [UNDISCH_TAC `norm (x - e % (x - c) - y':real^N) < e * d` THEN SUBGOAL_THEN `x - e % (x - c) - y':real^N = e % (c - (&1 / e % y' - (&1 - e) / e % x))` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL_EQ; real_abs; REAL_LT_IMP_LE]]; DISCH_TAC THEN SUBGOAL_THEN `y' = (&1 - (&1 - e)) % (&1 / e % y' - (&1 - e) / e % x) + (&1 - e) % x:real^N` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_ARITH `&1 - (&1 - e) = e`; VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; let IN_INTERIOR_CLOSURE_CONVEX_SHRINK = prove (`!s e x c:real^N. convex s /\ c IN interior s /\ x IN closure s /\ &0 < e /\ e <= &1 ==> x - e % (x - c) IN interior s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?y:real^N. y IN s /\ norm(y - x) * (&1 - e) < e * d` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `(x:real^N) IN s` THENL [EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[REAL_LT_MUL; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [closure]) THEN ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM; LIMPT_APPROACHABLE; dist] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `e <= &1 ==> e = &1 \/ e < &1`)) THEN ASM_SIMP_TAC[REAL_SUB_REFL; GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THENL [DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_01]; DISCH_THEN(MP_TAC o SPEC `(e * d) / (&1 - e)`)] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_SUB_LT; REAL_MUL_LZERO; REAL_LT_MUL; REAL_MUL_LID] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `z:real^N = c + ((&1 - e) / e) % (x - y)` THEN SUBGOAL_THEN `x - e % (x - c):real^N = y - e % (y - z)` SUBST1_TAC THENL [EXPAND_TAC "z" THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_ADD_LDISTRIB] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC IN_INTERIOR_CONVEX_SHRINK THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP SUBSET_INTERIOR) THEN SIMP_TAC[INTERIOR_OPEN; OPEN_BALL] THEN REWRITE_TAC[IN_BALL; dist] THEN EXPAND_TAC "z" THEN REWRITE_TAC[NORM_ARITH `norm(c - (c + x)) = norm(x)`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_SUB_LE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ] THEN ASM_MESON_TAC[REAL_MUL_SYM; NORM_SUB]);; let IN_INTERIOR_CLOSURE_CONVEX_SEGMENT = prove (`!s a b:real^N. convex s /\ a IN interior s /\ b IN closure s ==> segment(a,b) SUBSET interior s`, REWRITE_TAC[SUBSET; IN_SEGMENT] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % b:real^N = b - (&1 - u) % (b - a)`] THEN MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Relative interior of a set. *) (* ------------------------------------------------------------------------- *) let relative_interior = new_definition `relative_interior s = {x | ?t. open_in (subtopology euclidean (affine hull s)) t /\ x IN t /\ t SUBSET s}`;; let relative_frontier = new_definition `relative_frontier s = closure s DIFF relative_interior s`;; let RELATIVE_INTERIOR_INTERIOR_OF = prove (`!s:real^N->bool. relative_interior s = subtopology euclidean (affine hull s) interior_of s`, REWRITE_TAC[interior_of; relative_interior]);; let RELATIVE_FRONTIER_FRONTIER_OF = prove (`!s:real^N->bool. relative_frontier s = subtopology euclidean (affine hull s) frontier_of s`, GEN_TAC THEN REWRITE_TAC[relative_frontier] THEN REWRITE_TAC[frontier_of; RELATIVE_INTERIOR_INTERIOR_OF] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN SIMP_TAC[HULL_SUBSET; SET_RULE `s SUBSET t ==> t INTER s = s`; CLOSURE_SUBSET_AFFINE_HULL]);; let RELATIVE_INTERIOR = prove (`!s. relative_interior s = {x | x IN s /\ ?t. open t /\ x IN t /\ t INTER (affine hull s) SUBSET s}`, REWRITE_TAC[EXTENSION; relative_interior; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> b /\ a /\ c /\ d`] THEN REWRITE_TAC[UNWIND_THM2; SUBSET; IN_INTER; RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[HULL_INC]);; let RELATIVE_INTERIOR_EQ = prove (`!s. relative_interior s = s <=> open_in(subtopology euclidean (affine hull s)) s`, GEN_TAC THEN REWRITE_TAC[EXTENSION; relative_interior; IN_ELIM_THM] THEN GEN_REWRITE_TAC RAND_CONV [OPEN_IN_SUBOPEN] THEN MESON_TAC[SUBSET]);; let RELATIVE_INTERIOR_OPEN_IN = prove (`!s. open_in(subtopology euclidean (affine hull s)) s ==> relative_interior s = s`, REWRITE_TAC[RELATIVE_INTERIOR_EQ]);; let RELATIVE_INTERIOR_EMPTY = prove (`relative_interior {} = {}`, SIMP_TAC[RELATIVE_INTERIOR_OPEN_IN; OPEN_IN_EMPTY]);; let RELATIVE_FRONTIER_EMPTY = prove (`relative_frontier {} = {}`, REWRITE_TAC[relative_frontier; CLOSURE_EMPTY; EMPTY_DIFF]);; let RELATIVE_INTERIOR_AFFINE = prove (`!s:real^N->bool. affine s ==> relative_interior s = s`, SIMP_TAC[RELATIVE_INTERIOR_EQ; OPEN_IN_SUBTOPOLOGY_REFL; HULL_P] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; let RELATIVE_INTERIOR_UNIV = prove (`!s. relative_interior(affine hull s) = affine hull s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_OPEN_IN THEN REWRITE_TAC[HULL_HULL; OPEN_IN_SUBTOPOLOGY_REFL] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; let OPEN_IN_RELATIVE_INTERIOR = prove (`!s. open_in (subtopology euclidean (affine hull s)) (relative_interior s)`, GEN_TAC THEN REWRITE_TAC[relative_interior] THEN GEN_REWRITE_TAC I [OPEN_IN_SUBOPEN] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let RELATIVE_INTERIOR_SUBSET = prove (`!s. (relative_interior s) SUBSET s`, REWRITE_TAC[SUBSET; relative_interior; IN_ELIM_THM] THEN MESON_TAC[]);; let RELATIVE_FRONTIER_SUBSET = prove (`!s:real^N->bool. closed s ==> relative_frontier s SUBSET s`, REWRITE_TAC[GSYM CLOSURE_SUBSET_EQ; relative_frontier] THEN SET_TAC[]);; let RELATIVE_FRONTIER_SUBSET_EQ = prove (`!s:real^N->bool. relative_frontier s SUBSET s <=> closed s`, GEN_TAC THEN REWRITE_TAC[GSYM CLOSURE_SUBSET_EQ; relative_frontier] THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]);; let BOUNDED_RELATIVE_INTERIOR = prove (`!s:real^N->bool. bounded s ==> bounded(relative_interior s)`, MESON_TAC[BOUNDED_SUBSET; RELATIVE_INTERIOR_SUBSET]);; let OPEN_IN_SET_RELATIVE_INTERIOR = prove (`!s:real^N->bool. open_in (subtopology euclidean s) (relative_interior s)`, GEN_TAC THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `affine hull s:real^N->bool` THEN REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; RELATIVE_INTERIOR_SUBSET; HULL_SUBSET]);; let SUBSET_RELATIVE_INTERIOR = prove (`!s t. s SUBSET t /\ affine hull s = affine hull t ==> (relative_interior s) SUBSET (relative_interior t)`, REWRITE_TAC[relative_interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let RELATIVE_INTERIOR_CLOSURE_SUBSET = prove (`!s. relative_interior s SUBSET relative_interior(closure s)`, SIMP_TAC[SUBSET_RELATIVE_INTERIOR; CLOSURE_SUBSET; AFFINE_HULL_CLOSURE]);; let RELATIVE_INTERIOR_MAXIMAL = prove (`!s t. t SUBSET s /\ open_in(subtopology euclidean (affine hull s)) t ==> t SUBSET (relative_interior s)`, REWRITE_TAC[relative_interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let RELATIVE_INTERIOR_UNIQUE = prove (`!s t. t SUBSET s /\ open_in(subtopology euclidean (affine hull s)) t /\ (!t'. t' SUBSET s /\ open_in(subtopology euclidean (affine hull s)) t' ==> t' SUBSET t) ==> (relative_interior s = t)`, MESON_TAC[SUBSET_ANTISYM; RELATIVE_INTERIOR_MAXIMAL; RELATIVE_INTERIOR_SUBSET; OPEN_IN_RELATIVE_INTERIOR]);; let IN_RELATIVE_INTERIOR = prove (`!x:real^N s. x IN relative_interior s <=> x IN s /\ ?e. &0 < e /\ (ball(x,e) INTER (affine hull s)) SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[relative_interior; IN_ELIM_THM] THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> b /\ a /\ c /\ d`] THEN REWRITE_TAC[UNWIND_THM2; SUBSET; IN_INTER] THEN EQ_TAC THENL [ASM_MESON_TAC[SUBSET; OPEN_CONTAINS_BALL]; STRIP_TAC THEN EXISTS_TAC `ball(x:real^N,e)` THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; HULL_INC]]);; let IN_RELATIVE_INTERIOR_CBALL = prove (`!x:real^N s. x IN relative_interior s <=> x IN s /\ ?e. &0 < e /\ (cball(x,e) INTER affine hull s) SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:real^N,e) INTER affine hull s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; IN_CBALL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`]; EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(x:real^N,e) INTER affine hull s` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_INTER; IN_BALL; IN_CBALL; REAL_LT_IMP_LE]]);; let RELATIVE_INTERIOR_CONVEX_INTER_OPEN = prove (`!s t:real^N->bool. convex s /\ open t /\ ~(s INTER t = {}) ==> relative_interior(s INTER t) = relative_interior s INTER t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_UNIQUE THEN ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_OPEN; SUBSET_INTER; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]; MP_TAC(ISPEC `s:real^N->bool` OPEN_IN_RELATIVE_INTERIOR) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t INTER u:real^N->bool` THEN ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]; MESON_TAC[RELATIVE_INTERIOR_MAXIMAL]]);; let CONIC_HULL_EQ_SPAN,CONIC_HULL_EQ_AFFINE_HULL = (CONJ_PAIR o prove) (`(!s:real^N->bool. vec 0 IN relative_interior s ==> conic hull s = span s) /\ (!s:real^N->bool. vec 0 IN relative_interior s ==> conic hull s = affine hull s)`, SIMP_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN MATCH_MP_TAC(SET_RULE `a = s /\ c SUBSET s /\ a SUBSET c ==> c = s /\ c = a`) THEN ASM_SIMP_TAC[CONIC_HULL_SUBSET_SPAN; AFFINE_HULL_EQ_SPAN_EQ; HULL_INC] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_SIMP_TAC[HULL_INC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / norm x % x:real^N` o REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_INTER; IN_CBALL_0; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> abs e <= e`] THEN ANTS_TAC THENL [ASM_MESON_TAC[SPAN_MUL; AFFINE_HULL_EQ_SPAN; HULL_INC]; DISCH_TAC] THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`norm(x:real^N) / e`; `e / norm x % x:real^N`] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[VECTOR_MUL_LID; NORM_EQ_0; REAL_FIELD `~(x = &0) /\ &0 < e ==> x / e * e / x = &1`]);; let CONIC_HULL_EQ_SPAN_EQ = prove (`!s:real^N->bool. vec 0 IN relative_interior(conic hull s) <=> conic hull s = span s`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MP_TAC(ISPEC `conic hull s:real^N->bool` CONIC_HULL_EQ_SPAN) THEN ASM_REWRITE_TAC[SPAN_CONIC_HULL; HULL_HULL]; ASM_SIMP_TAC[RELATIVE_INTERIOR_AFFINE; AFFINE_SPAN; SPAN_0]]);; let OPEN_IN_SUBSET_RELATIVE_INTERIOR = prove (`!s t. open_in(subtopology euclidean (affine hull t)) s ==> (s SUBSET relative_interior t <=> s SUBSET t)`, MESON_TAC[RELATIVE_INTERIOR_MAXIMAL; RELATIVE_INTERIOR_SUBSET; SUBSET_TRANS]);; let RELATIVE_INTERIOR_TRANSLATION = prove (`!a:real^N s. relative_interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (relative_interior s)`, REWRITE_TAC[relative_interior; OPEN_IN_OPEN] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [RELATIVE_INTERIOR_TRANSLATION];; let RELATIVE_FRONTIER_TRANSLATION = prove (`!a:real^N s. relative_frontier (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (relative_frontier s)`, REWRITE_TAC[relative_frontier] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [RELATIVE_FRONTIER_TRANSLATION];; let RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> relative_interior(IMAGE f s) = IMAGE f (relative_interior s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[relative_interior; AFFINE_HULL_LINEAR_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> c /\ a /\ b`] THEN REWRITE_TAC[EXISTS_SUBSET_IMAGE] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_INJECTIVE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; add_linear_invariants [RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE];; let RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> relative_frontier(IMAGE f s) = IMAGE f (relative_frontier s)`, REWRITE_TAC[relative_frontier] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE];; let RELATIVE_INTERIOR_RELATIVE_INTERIOR = prove (`!s:real^N->bool. relative_interior(relative_interior s) = relative_interior s`, GEN_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; RELATIVE_INTERIOR_SUBSET] THEN REWRITE_TAC[SUBSET] THEN SIMP_TAC[IN_RELATIVE_INTERIOR] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `a' SUBSET a /\ (b INTER a SUBSET s ==> b INTER a SUBSET i) ==> b INTER a SUBSET s ==> b INTER a' SUBSET i`) THEN SIMP_TAC[HULL_MONO; RELATIVE_INTERIOR_SUBSET] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[IN_RELATIVE_INTERIOR] THEN EXISTS_TAC `e - dist(x:real^N,y)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[IN_BALL; IN_INTER; SUBSET] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN CONV_TAC NORM_ARITH);; let RELATIVE_INTERIOR_EQ_EMPTY = prove (`!s:real^N->bool. convex s ==> (relative_interior s = {} <=> s = {})`, SUBGOAL_THEN `!s:real^N->bool. vec 0 IN s /\ convex s ==> ~(relative_interior s = {})` ASSUME_TAC THENL [ALL_TAC; GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN REWRITE_TAC[CONVEX_TRANSLATION_EQ; RELATIVE_INTERIOR_TRANSLATION] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC] THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_RELATIVE_INTERIOR] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN SUBGOAL_THEN `span(s:real^N->bool) = span b` SUBST_ALL_TAC THENL [ASM_SIMP_TAC[SPAN_EQ] THEN ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ABBREV_TAC `n = dim(s:real^N->bool)` THEN SUBGOAL_THEN `!c. (!v. v IN b ==> &0 <= c(v)) /\ sum b c <= &1 ==> vsum b (\v:real^N. c(v) % v) IN s` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `vsum (vec 0 INSERT b :real^N->bool) (\v. (if v = vec 0 then &1 - sum b c else c v) % v) IN s` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN ASM_SIMP_TAC[INSERT_SUBSET; FINITE_INSERT; SUM_CLAUSES; INDEPENDENT_NONZERO; IN_INSERT] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_SUB_LE]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&1 - x + y = &1 <=> x = y`] THEN MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[INDEPENDENT_NONZERO]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[VSUM_CLAUSES; INDEPENDENT_NONZERO] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[INDEPENDENT_NONZERO]]; ALL_TAC] THEN ABBREV_TAC `a:real^N = vsum b (\v. inv(&2 * &n + &1) % v)` THEN EXISTS_TAC `a:real^N` THEN CONJ_TAC THENL [EXPAND_TAC "a" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SUM_CONST; REAL_LE_INV_EQ; REAL_ARITH `&0 < &2 * &n + &1`; GSYM real_div; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`b:real^N->bool`; `inv(&2 * &n + &1)`] BASIS_COORDINATES_CONTINUOUS) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_SIMP_TAC[SUBSET; IN_INTER; IMP_CONJ_ALT] THEN ASM_SIMP_TAC[SPAN_FINITE; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN GEN_TAC THEN X_GEN_TAC `u:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_BALL; dist] THEN EXPAND_TAC "a" THEN ASM_SIMP_TAC[GSYM VSUM_SUB] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN REWRITE_TAC[REAL_ARITH `abs(x - y) < x <=> &0 < y /\ abs(y) < &2 * x`] THEN SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(CARD(b:real^N->bool)) * &2 * inv(&2 * &n + &1)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_BOUND THEN ASM_SIMP_TAC[REAL_ARITH `abs x < a ==> x <= a`]; ASM_REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &2 * &n + &1`] THEN REAL_ARITH_TAC]);; let AFF_DIM_NONEMPTY_INTERIOR_OF_EQ = prove (`!u s:real^N->bool. convex s /\ affine u /\ s SUBSET u ==> (aff_dim s = aff_dim u <=> s = {} /\ u = {} \/ ~((subtopology euclidean u) interior_of s = {}))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_SIMP_TAC[SUBSET_EMPTY] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[AFF_DIM_NONEMPTY_INTERIOR_OF]] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_EQ_FULL_GEN; HULL_P] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM RELATIVE_INTERIOR_INTERIOR_OF] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]);; let RELATIVE_INTERIOR_INTERIOR = prove (`!s. affine hull s = (:real^N) ==> relative_interior s = interior s`, SIMP_TAC[relative_interior; interior; SUBTOPOLOGY_UNIV; OPEN_IN]);; let RELATIVE_INTERIOR_OPEN = prove (`!s:real^N->bool. open s ==> relative_interior s = s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_OPEN; INTERIOR_EQ]);; let RELATIVE_INTERIOR_NONEMPTY_INTERIOR = prove (`!s. ~(interior s = {}) ==> relative_interior s = interior s`, MESON_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_NONEMPTY_INTERIOR]);; let RELATIVE_FRONTIER_NONEMPTY_INTERIOR = prove (`!s. ~(interior s = {}) ==> relative_frontier s = frontier s`, SIMP_TAC[relative_frontier; frontier; RELATIVE_INTERIOR_NONEMPTY_INTERIOR]);; let RELATIVE_FRONTIER_FRONTIER = prove (`!s. affine hull s = (:real^N) ==> relative_frontier s = frontier s`, SIMP_TAC[relative_frontier; frontier; RELATIVE_INTERIOR_INTERIOR]);; let RELATIVE_FRONTIER_OPEN = prove (`!s:real^N->bool. open s ==> relative_frontier s = frontier s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[FRONTIER_EMPTY; RELATIVE_FRONTIER_EMPTY] THEN MATCH_MP_TAC RELATIVE_FRONTIER_NONEMPTY_INTERIOR THEN ASM_SIMP_TAC[INTERIOR_OPEN]);; let AFFINE_HULL_CONVEX_HULL = prove (`!s. affine hull (convex hull s) = affine hull s`, GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[AFFINE_AFFINE_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_MESON_TAC[SUBSET_TRANS; HULL_SUBSET]);; let INTERIOR_SIMPLEX_NONEMPTY = prove (`!s:real^N->bool. independent s /\ s HAS_SIZE (dimindex(:N)) ==> ?a. a IN interior(convex hull (vec 0 INSERT s))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `convex hull (vec 0 INSERT s):real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN ASM_SIMP_TAC[AFFINE_HULL_CONVEX_HULL] THEN REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; CONVEX_CONVEX_HULL; NOT_INSERT_EMPTY] THEN REWRITE_TAC[MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; HULL_INC] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN EXISTS_TAC `span s:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_MONO THEN MATCH_MP_TAC(SET_RULE `(a INSERT s) SUBSET P hull (a INSERT s) ==> s SUBSET P hull (a INSERT s)`) THEN REWRITE_TAC[HULL_SUBSET]; MATCH_MP_TAC(SET_RULE `UNIV SUBSET s ==> s = UNIV`) THEN MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN ASM_REWRITE_TAC[DIM_UNIV; SUBSET_UNIV] THEN ASM_MESON_TAC[LE_REFL;HAS_SIZE]]);; let INTERIOR_SUBSET_RELATIVE_INTERIOR = prove (`!s. interior s SUBSET relative_interior s`, REWRITE_TAC[SUBSET; IN_INTERIOR; IN_RELATIVE_INTERIOR; IN_INTER] THEN MESON_TAC[CENTRE_IN_BALL]);; let RELATIVE_FRONTIER_SUBSET_FRONTIER = prove (`!s:real^N->bool. relative_frontier s SUBSET frontier s`, GEN_TAC THEN REWRITE_TAC[relative_frontier; frontier] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN SET_TAC[]);; let CONVEX_RELATIVE_INTERIOR = prove (`!s:real^N->bool. convex s ==> convex(relative_interior s)`, REWRITE_TAC[CONVEX_ALT; IN_RELATIVE_INTERIOR; IN_INTER; SUBSET; IN_BALL; dist] THEN GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `(a /\ b) /\ (c /\ d) /\ e ==> f <=> a /\ c /\ e ==> b /\ d ==> f`] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(MESON[] `(!d e. P d /\ Q e ==> R(min d e)) ==> (?e. P e) /\ (?e. Q e) ==> (?e. R e)`) THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `z:real^N = (&1 - u) % (z - u % (y - x)) + u % (z + (&1 - u) % (y - x))`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(CONJUNCTS_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN DISCH_THEN MATCH_MP_TAC THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `norm x < e ==> norm x = y ==> y < e`)) THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; REWRITE_TAC[VECTOR_ARITH `a - b % c:real^N = a + --b % c`] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC]]));; let IN_RELATIVE_INTERIOR_CONVEX_SHRINK = prove (`!s e x c:real^N. convex s /\ c IN relative_interior s /\ x IN s /\ &0 < e /\ e <= &1 ==> x - e % (x - c) IN relative_interior s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN REWRITE_TAC[IN_RELATIVE_INTERIOR; SUBSET; IN_INTER; IN_BALL; dist] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `x - e % (x - c):real^N = (&1 - e) % x + e % c`] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `e * d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y':real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / e) % y' - ((&1 - e) / e) % x:real^N`) THEN ANTS_TAC THENL [CONJ_TAC THENL [UNDISCH_TAC `norm (x - e % (x - c) - y':real^N) < e * d` THEN SUBGOAL_THEN `x - e % (x - c) - y':real^N = e % (c - (&1 / e % y' - (&1 - e) / e % x))` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL_EQ; real_abs; REAL_LT_IMP_LE]]; REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `a % y - (b - c) % x:real^N = (c - b) % x + a % y`] THEN MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN ASM_SIMP_TAC[HULL_INC]]; DISCH_TAC THEN SUBGOAL_THEN `y' = (&1 - (&1 - e)) % (&1 / e % y' - (&1 - e) / e % x) + (&1 - e) % x:real^N` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_ARITH `&1 - (&1 - e) = e`; VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; let IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK = prove (`!s e x c:real^N. convex s /\ c IN relative_interior s /\ x IN closure s /\ &0 < e /\ e <= &1 ==> x - e % (x - c) IN relative_interior s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?y:real^N. y IN s /\ norm(y - x) * (&1 - e) < e * d` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `(x:real^N) IN s` THENL [EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[REAL_LT_MUL; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [closure]) THEN ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM; LIMPT_APPROACHABLE; dist] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `e <= &1 ==> e = &1 \/ e < &1`)) THEN ASM_SIMP_TAC[REAL_SUB_REFL; GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THENL [DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_01]; DISCH_THEN(MP_TAC o SPEC `(e * d) / (&1 - e)`)] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_SUB_LT; REAL_MUL_LZERO; REAL_LT_MUL; REAL_MUL_LID] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `z:real^N = c + ((&1 - e) / e) % (x - y)` THEN SUBGOAL_THEN `x - e % (x - c):real^N = y - e % (y - z)` SUBST1_TAC THENL [EXPAND_TAC "z" THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_ADD_LDISTRIB] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CONVEX_SHRINK THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `dist(c:real^N,z) < d` ASSUME_TAC THENL [EXPAND_TAC "z" THEN REWRITE_TAC[NORM_ARITH `dist(c:real^N,c + x) = norm x`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[REAL_ARITH `a / b * c:real = (c * a) / b`] THEN ASM_SIMP_TAC[real_abs; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(z:real^N) IN affine hull s` ASSUME_TAC THENL [EXPAND_TAC "z" THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC] THEN MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t = s ==> x IN s`) THEN EXISTS_TAC `closure(affine hull s):real^N->bool` THEN SIMP_TAC[CLOSURE_EQ; CLOSED_AFFINE_HULL] THEN ASM_MESON_TAC[SUBSET_CLOSURE; HULL_INC; SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_BALL; IN_INTER; SUBSET]; ALL_TAC] THEN EXISTS_TAC `d - dist(c:real^N,z)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; IN_INTER] THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN UNDISCH_TAC `dist(c:real^N,z) < d` THEN REWRITE_TAC[IN_BALL] THEN NORM_ARITH_TAC);; let IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT = prove (`!s a b:real^N. convex s /\ a IN relative_interior s /\ b IN closure s ==> segment(a,b) SUBSET relative_interior s`, REWRITE_TAC[SUBSET; IN_SEGMENT] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % b:real^N = b - (&1 - u) % (b - a)`] THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let INTER_RELATIVE_FRONTIER_CONIC_HULL = prove (`!s t:real^N->bool. convex s /\ vec 0 IN relative_interior s /\ t SUBSET relative_frontier s ==> t = relative_frontier s INTER conic hull t`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; HULL_SUBSET] THEN REWRITE_TAC[SUBSET; IN_INTER; CONIC_HULL_EXPLICIT; IMP_CONJ_ALT] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[relative_frontier; IN_DIFF; VECTOR_MUL_LZERO]; ASM_REWRITE_TAC[REAL_LE_LT]] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (ISPECL [`c:real`; `&1`] REAL_LT_TOTAL) THEN ASM_SIMP_TAC[VECTOR_MUL_LID] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN MP_TAC (ISPECL [`s:real^N->bool`; `vec 0:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(MP_TAC o SPEC `x:real^N`); DISCH_THEN(MP_TAC o SPEC `c % x:real^N`)] THEN (ANTS_TAC THENL [ASM_MESON_TAC[relative_frontier; IN_DIFF; SUBSET]; ALL_TAC]) THEN REWRITE_TAC[SUBSET; IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN MATCH_MP_TAC(MESON[] `P /\ (?u. &0 < u /\ u < &1 /\ ~Q(u % y)) ==> ~(!x. P /\ (?u. &0 < u /\ u < &1 /\ x = u % y) ==> Q x)`) THEN (CONJ_TAC THENL [ASM_MESON_TAC[relative_frontier; IN_DIFF; SUBSET]; ALL_TAC]) THENL [EXISTS_TAC `c:real`; EXISTS_TAC `inv c:real`] THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_INV_LT_1; VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_LINV] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF; SUBSET]);; let INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR = prove (`!c t s z:real^N. convex c /\ t SUBSET c /\ z IN relative_interior c /\ DISJOINT s (relative_interior c) ==> s INTER (convex hull (z INSERT t)) = s INTER (convex hull t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[HULL_MONO; SET_RULE `s SUBSET a INSERT s`; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN REWRITE_TAC[CONVEX_HULL_INSERT_SEGMENTS; SUBSET] THEN X_GEN_TAC `x:real^N` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTER; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^N->bool`; `z:real^N`; `y:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_MESON_TAC[HULL_MINIMAL; SUBSET]; REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ONCE_REWRITE_TAC[segment] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM SET_TAC[]]);; let CONVEX_OPEN_SEGMENT_CASES = prove (`!s a b:real^N. convex s /\ a IN closure s /\ b IN closure s ==> segment(a,b) SUBSET relative_frontier s \/ segment(a,b) SUBSET relative_interior s`, REPEAT STRIP_TAC THEN REWRITE_TAC[relative_frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET c /\ (!a. a IN i /\ a IN s ==> s SUBSET i) ==> s SUBSET c DIFF i \/ s SUBSET i`) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_OPEN_SEGMENT; CONVEX_CLOSURE]; X_GEN_TAC `c:real^N` THEN ONCE_REWRITE_TAC[segment]] THEN REWRITE_TAC[IN_DIFF; IN_INSERT; DE_MORGAN_THM; NOT_IN_EMPTY] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNION_SEGMENT) THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `b:real^N` th) THEN MP_TAC(SPEC `a:real^N` th)) THEN ASM_REWRITE_TAC[SEGMENT_SYM; CONJUNCT2 segment] THEN ASM SET_TAC[]);; let SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX = prove (`!s a b c:real^N. convex s /\ c IN segment(a,b) /\ {a,b,c} SUBSET relative_frontier s ==> segment[a,b] SUBSET relative_frontier s`, REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN; UNION_SUBSET] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`] CONVEX_OPEN_SEGMENT_CASES) THEN RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier; IN_DIFF]) THEN ASM SET_TAC[]);; let RELATIVE_INTERIOR_SING = prove (`!a. relative_interior {a} = {a}`, GEN_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET {a} /\ ~(s = {}) ==> s = {a}`) THEN SIMP_TAC[RELATIVE_INTERIOR_SUBSET; RELATIVE_INTERIOR_EQ_EMPTY; CONVEX_SING] THEN SET_TAC[]);; let RELATIVE_FRONTIER_SING = prove (`!a:real^N. relative_frontier {a} = {}`, REWRITE_TAC[relative_frontier; RELATIVE_INTERIOR_SING; CLOSURE_SING] THEN SET_TAC[]);; let RELATIVE_INTERIOR_CBALL = prove (`!a r. relative_interior(cball(a,r)) = if r = &0 then {a} else ball(a,r)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[REAL_LT_IMP_NE; CBALL_EMPTY; BALL_EMPTY; RELATIVE_INTERIOR_EMPTY; REAL_LT_IMP_LE] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CBALL_SING; RELATIVE_INTERIOR_SING] THEN REWRITE_TAC[GSYM INTERIOR_CBALL] THEN MATCH_MP_TAC RELATIVE_INTERIOR_NONEMPTY_INTERIOR THEN ASM_REWRITE_TAC[INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);; let RELATIVE_INTERIOR_BALL = prove (`!a r. relative_interior(ball(a,r)) = ball(a,r)`, SIMP_TAC[RELATIVE_INTERIOR_OPEN; OPEN_BALL]);; let RELATIVE_FRONTIER_CBALL = prove (`!a:real^N r. relative_frontier(cball(a,r)) = if r = &0 then {} else sphere(a,r)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CBALL_SING; RELATIVE_FRONTIER_SING] THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[CBALL_EMPTY; SPHERE_EMPTY; RELATIVE_FRONTIER_EMPTY] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR; INTERIOR_CBALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; FRONTIER_CBALL]);; let RELATIVE_FRONTIER_BALL = prove (`!a:real^N r. relative_frontier(ball(a,r)) = if r = &0 then {} else sphere(a,r)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; RELATIVE_FRONTIER_EMPTY] THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; SPHERE_EMPTY; RELATIVE_FRONTIER_EMPTY] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR; INTERIOR_OPEN; OPEN_BALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; FRONTIER_BALL]);; let DIFFERENT_NORM_3_COLLINEAR_POINTS = prove (`!a b x:real^N. ~(x IN segment(a,b) /\ norm(a) = norm(b) /\ norm(x) = norm(b))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_SIMP_TAC[SEGMENT_REFL; NOT_IN_EMPTY; OPEN_SEGMENT_ALT] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) MP_TAC) THEN ASM_REWRITE_TAC[NORM_EQ] THEN REWRITE_TAC[VECTOR_ARITH `(x + y:real^N) dot (x + y) = x dot x + &2 * x dot y + y dot y`] THEN REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN UNDISCH_TAC `~(a:real^N = b)` THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DOT_EQ_0; VECTOR_ARITH `(a - b:real^N) dot (a - b) = a dot a + b dot b - &2 * a dot b`] THEN ASM_REWRITE_TAC[REAL_RING `a + a - &2 * ab = &0 <=> ab = a`] THEN SIMP_TAC[REAL_RING `(&1 - u) * (&1 - u) * a + &2 * (&1 - u) * u * x + u * u * a = a <=> x = a \/ u = &0 \/ u = &1`] THEN ASM_REAL_ARITH_TAC);; let OPEN_SEGMENT_SUBSET_BALL = prove (`!a r u v:real^N. u IN cball(a,r) /\ v IN cball(a,r) ==> segment(u,v) SUBSET ball(a,r)`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N = v` THEN ASM_REWRITE_TAC[SEGMENT_REFL; EMPTY_SUBSET] THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[CBALL_EMPTY; NOT_IN_EMPTY] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[CBALL_SING; IN_SING] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN ASM_CASES_TAC `u IN ball(vec 0:real^N,r)` THENL [MP_TAC(ISPECL [`ball(vec 0:real^N,r)`; `u:real^N`; `v:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_SIMP_TAC[CONVEX_BALL; RELATIVE_INTERIOR_BALL; CLOSURE_BALL]; ALL_TAC] THEN ASM_CASES_TAC `v IN ball(vec 0:real^N,r)` THENL [MP_TAC(ISPECL [`ball(vec 0:real^N,r)`; `v:real^N`; `u:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_SIMP_TAC[CONVEX_BALL; RELATIVE_INTERIOR_BALL; CLOSURE_BALL] THEN REWRITE_TAC[SEGMENT_SYM]; ALL_TAC] THEN MP_TAC(ISPECL [`ball(vec 0:real^N,r)`; `u:real^N`; `v:real^N`] CONVEX_OPEN_SEGMENT_CASES) THEN ASM_SIMP_TAC[CLOSURE_BALL; CONVEX_BALL] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR_BALL; RELATIVE_FRONTIER_BALL] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `midpoint(u,v):real^N`) THEN ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT] THEN DISCH_TAC THEN MP_TAC(ISPECL [`u:real^N`; `v:real^N`; `midpoint(u,v):real^N`] DIFFERENT_NORM_3_COLLINEAR_POINTS) THEN ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_SPHERE_0; IN_BALL_0; IN_CBALL_0]) THEN ASM_REAL_ARITH_TAC);; let STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS = prove (`!s t:real^N->bool. convex s /\ ~(s = {}) /\ relative_interior s SUBSET t /\ t SUBSET closure s ==> starlike t`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; REWRITE_TAC[starlike]] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s /\ segment[a,b] DIFF {a,b} SUBSET s ==> segment[a:real^N,b] SUBSET s`) THEN ASM_REWRITE_TAC[GSYM open_segment] THEN ASM_MESON_TAC[IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; SUBSET]);; let RELATIVE_INTERIOR_PROLONG = prove (`!s x y:real^N. x IN relative_interior s /\ y IN s ==> ?t. &1 < t /\ (y + t % (x - y)) IN s`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN ASM_CASES_TAC `y:real^N = x` THENL [ASM_REWRITE_TAC[VECTOR_ARITH `y + t % (x - x):real^N = y`] THEN EXISTS_TAC `&2` THEN CONV_TAC REAL_RAT_REDUCE_CONV; EXISTS_TAC `&1 + e / norm(x - y:real^N)` THEN ASM_SIMP_TAC[REAL_LT_ADDR; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[VECTOR_ARITH `y + (&1 + e) % (x - y):real^N = x + e % (x - y)`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; IN_INTER; IN_AFFINE_ADD_MUL_DIFF; HULL_INC; IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let RELATIVE_INTERIOR_CONVEX_PROLONG = prove (`!s. convex s ==> relative_interior s = {x:real^N | x IN s /\ !y. y IN s ==> ?t. &1 < t /\ (y + t % (x - y)) IN s}`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SIMP_TAC[RELATIVE_INTERIOR_PROLONG] THEN MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; STRIP_TAC THEN SUBGOAL_THEN `?y:real^N. y IN relative_interior s` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[MEMBER_NOT_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN ASM_CASES_TAC `y:real^N = x` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `y:real^N`; `y + t % (x - y):real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_SEGMENT; IN_ELIM_THM] THEN ASM_REWRITE_TAC[VECTOR_ARITH `y:real^N = y + x <=> x = vec 0`; VECTOR_ARITH `(&1 - u) % y + u % (y + t % (x - y)):real^N = y + t % u % (x - y)`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `inv t:real` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_INV_EQ; REAL_INV_LT_1; REAL_LT_IMP_NZ; REAL_ARITH `&1 < x ==> &0 < x`] THEN VECTOR_ARITH_TAC]);; let RELATIVE_INTERIOR_EQ_CLOSURE = prove (`!s:real^N->bool. relative_interior s = closure s <=> affine s`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY; CLOSURE_EMPTY; AFFINE_EMPTY] THEN EQ_TAC THEN SIMP_TAC[RELATIVE_INTERIOR_AFFINE; CLOSURE_CLOSED; CLOSED_AFFINE] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `relative_interior s = closure s ==> relative_interior s SUBSET s /\ s SUBSET closure s ==> relative_interior s = s /\ closure s = s`)) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET; CLOSURE_SUBSET] THEN REWRITE_TAC[RELATIVE_INTERIOR_EQ; CLOSURE_EQ; GSYM AFFINE_HULL_EQ] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(s = {}) ==> s = {} \/ s = a ==> a = s`)) THEN MP_TAC(ISPEC `affine hull s:real^N->bool` CONNECTED_CLOPEN) THEN SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED; AFFINE_AFFINE_HULL] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[HULL_SUBSET]);; let RAY_TO_RELATIVE_FRONTIER = prove (`!s a l:real^N. bounded s /\ a IN relative_interior s /\ (a + l) IN affine hull s /\ ~(l = vec 0) ==> ?d. &0 < d /\ (a + d % l) IN relative_frontier s /\ !e. &0 <= e /\ e < d ==> (a + e % l) IN relative_interior s`, REPEAT STRIP_TAC THEN REWRITE_TAC[relative_frontier] THEN MP_TAC(ISPEC `{d | &0 < d /\ ~((a + d % l:real^N) IN relative_interior(s))}` INF) THEN ABBREV_TAC `d = inf {d | &0 < d /\ ~((a + d % l:real^N) IN relative_interior(s))}` THEN SUBGOAL_THEN `?e. &0 < e /\ !d. &0 <= d /\ d < e ==> (a + d % l:real^N) IN relative_interior s` (X_CHOOSE_THEN `k:real` (LABEL_TAC "0")) THENL [MP_TAC(ISPEC `s:real^N->bool` OPEN_IN_RELATIVE_INTERIOR) THEN REWRITE_TAC[open_in; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / norm(l:real^N)` THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a) = norm x`] THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN REWRITE_TAC[SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `B / norm(l:real^N)` THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [GSYM CONTRAPOS_THM]) THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "1") (LABEL_TAC "2")) THEN EXISTS_TAC `d:real` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `k:real` THEN ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_LE_LT] THEN ASM_MESON_TAC[VECTOR_ARITH `a + &0 % l:real^N = a`; REAL_NOT_LT; REAL_LT_IMP_LE]; DISCH_TAC] THEN REWRITE_TAC[IN_DIFF] THEN CONJ_TAC THENL [REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN EXISTS_TAC `a + (d - min d (x / &2 / norm(l:real^N))) % l` THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < d ==> d - min d x < d`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT]; REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = norm(x - y)`] THEN REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < y /\ &0 < d ==> abs((d - min d x) - d) < y`) THEN REWRITE_TAC[REAL_ARITH `x / &2 / y < x / y <=> &0 < x / y`] THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT]]; DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_IN_RELATIVE_INTERIOR) THEN REWRITE_TAC[open_in; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `a + d % l:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "3"))) THEN REMOVE_THEN "2" (MP_TAC o SPEC `d + e / norm(l:real^N)`) THEN ASM_SIMP_TAC[NOT_IMP; REAL_ARITH `~(d + l <= d) <=> &0 < l`; REAL_LT_DIV; NORM_POS_LT] THEN X_GEN_TAC `x:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN ASM_CASES_TAC `x < d` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REMOVE_THEN "3" MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = norm(x - y)`] THEN REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT] THEN ASM_REAL_ARITH_TAC]]]);; let RAY_TO_FRONTIER = prove (`!s a l:real^N. bounded s /\ a IN interior s /\ ~(l = vec 0) ==> ?d. &0 < d /\ (a + d % l) IN frontier s /\ !e. &0 <= e /\ e < d ==> (a + e % l) IN interior s`, REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN SUBGOAL_THEN `interior s:real^N->bool = relative_interior s` SUBST1_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM relative_frontier] THEN MATCH_MP_TAC RAY_TO_RELATIVE_FRONTIER THEN ASM_REWRITE_TAC[]] THEN ASM_MESON_TAC[NOT_IN_EMPTY; RELATIVE_INTERIOR_NONEMPTY_INTERIOR; IN_UNIV; AFFINE_HULL_NONEMPTY_INTERIOR]);; let SEGMENT_TO_RELATIVE_FRONTIER = prove (`!s x y:real^N. convex s /\ bounded s /\ x IN relative_interior s /\ y IN s /\ ~(x = y /\ s = {x}) ==> ?z. z IN relative_frontier s /\ y IN segment[x,z] /\ segment(x,z) SUBSET relative_interior s`, SUBGOAL_THEN `!s x y:real^N. convex s /\ bounded s /\ x IN relative_interior s /\ y IN s /\ ~(x = y) ==> ?z. z IN relative_frontier s /\ y IN segment[x,z] /\ segment(x,z) SUBSET relative_interior s` ASSUME_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `y:real^N`; `w:real^N`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ENDS_IN_SEGMENT]] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`s:real^N->bool`; `x:real^N`; `y - x:real^N`] RAY_TO_RELATIVE_FRONTIER) THEN ASM_REWRITE_TAC[VECTOR_ARITH `x + (y - x):real^N = y`; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[HULL_INC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `x + d % (y - x):real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF]] THEN REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `inv(d:real)` THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; REAL_LE_INV_EQ; REAL_LT_IMP_LE; VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INV_LE_1; CONV_TAC VECTOR_ARITH] THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `y:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_SIMP_TAC[NOT_IMP; REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN REWRITE_TAC[SUBSET; IN_SEGMENT] THEN DISCH_THEN(MP_TAC o SPEC `x + d % (y - x):real^N`) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF; relative_frontier]) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH);; let SEGMENT_TO_RELATIVE_FRONTIER_SIMPLE = prove (`!s x:real^N. bounded s /\ x IN s /\ ~(s = {x}) ==> ?a b. a IN relative_frontier s /\ b IN relative_frontier s /\ x IN segment[a,b]`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(vec 0:real^N) IN relative_frontier s` THENL [ASM_MESON_TAC[SEGMENT_REFL; IN_SING]; ALL_TAC] THEN UNDISCH_TAC `~((vec 0:real^N) IN relative_frontier s)` THEN ASM_SIMP_TAC[relative_frontier; IN_DIFF; CLOSURE_INC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `z:real^N`] RAY_TO_RELATIVE_FRONTIER) THEN ASM_SIMP_TAC[VECTOR_ADD_LID; HULL_INC] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u % z:real^N` THEN ASM_REWRITE_TAC[GSYM relative_frontier; GSYM IN_DIFF] THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `--z:real^N`] RAY_TO_RELATIVE_FRONTIER) THEN ASM_SIMP_TAC[VECTOR_ADD_LID; HULL_INC; VECTOR_NEG_EQ_0] THEN ANTS_TAC THENL [SUBST1_TAC(VECTOR_ARITH `--z:real^N = vec 0 - &1 % (z - vec 0)`) THEN ASM_SIMP_TAC[IN_AFFINE_SUB_MUL_DIFF; AFFINE_AFFINE_HULL; HULL_INC]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `v % (--z):real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `u:real / (u + v)` THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RNEG] THEN REWRITE_TAC[GSYM VECTOR_MUL_LNEG; GSYM VECTOR_ADD_RDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_ADD] THEN CONV_TAC(RAND_CONV(RAND_CONV SYM_CONV)) THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN MAP_EVERY UNDISCH_TAC [`&0 < u`; `&0 < v`] THEN CONV_TAC REAL_FIELD);; let SEGMENT_TO_FRONTIER_SIMPLE = prove (`!s x:real^N. bounded s /\ x IN s ==> ?a b. a IN frontier s /\ b IN frontier s /\ x IN segment[a,b]`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `x:real^N` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `s = {vec 0:real^N}` THENL [ASM_REWRITE_TAC[FRONTIER_SING; IN_SING] THEN MESON_TAC[SEGMENT_REFL; IN_SING]; REPEAT STRIP_TAC] THEN ASM_CASES_TAC `(vec 0:real^N) IN frontier s` THENL [ASM_MESON_TAC[SEGMENT_REFL; IN_SING]; ALL_TAC] THEN UNDISCH_TAC `~((vec 0:real^N) IN frontier s)` THEN ASM_SIMP_TAC[frontier; IN_DIFF; CLOSURE_INC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `z:real^N`] RAY_TO_FRONTIER) THEN ASM_SIMP_TAC[VECTOR_ADD_LID; HULL_INC] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u % z:real^N` THEN ASM_REWRITE_TAC[GSYM frontier; GSYM IN_DIFF] THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `--z:real^N`] RAY_TO_FRONTIER) THEN ASM_SIMP_TAC[VECTOR_ADD_LID; HULL_INC; VECTOR_NEG_EQ_0] THEN DISCH_THEN(X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `v % (--z):real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `u:real / (u + v)` THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RNEG] THEN REWRITE_TAC[GSYM VECTOR_MUL_LNEG; GSYM VECTOR_ADD_RDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_ADD] THEN CONV_TAC(RAND_CONV(RAND_CONV SYM_CONV)) THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN MAP_EVERY UNDISCH_TAC [`&0 < u`; `&0 < v`] THEN CONV_TAC REAL_FIELD);; let SUBSET_CONVEX_HULL_RELATIVE_FRONTIER = prove (`!s:real^N->bool. bounded s /\ ~(?a. s = {a}) ==> s SUBSET convex hull (relative_frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SEGMENT_TO_RELATIVE_FRONTIER_SIMPLE) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN SUBGOAL_THEN `segment[a:real^N,b] SUBSET convex hull (relative_frontier s)` (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CONVEX_CONVEX_HULL] THEN ASM_SIMP_TAC[HULL_INC]);; let SUBSET_CONVEX_HULL_FRONTIER = prove (`!s:real^N->bool. bounded s ==> s SUBSET convex hull (frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SEGMENT_TO_FRONTIER_SIMPLE) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN SUBGOAL_THEN `segment[a:real^N,b] SUBSET convex hull (frontier s)` (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CONVEX_CONVEX_HULL] THEN ASM_SIMP_TAC[HULL_INC]);; let AFFINE_HULL_RELATIVE_FRONTIER_BOUNDED = prove (`!s:real^N->bool. bounded s /\ ~(?a. s = {a}) ==> affine hull (relative_frontier s) = affine hull s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM AFFINE_HULL_CLOSURE] THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[relative_frontier] THEN SET_TAC[]; MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN TRANS_TAC SUBSET_TRANS `convex hull (relative_frontier s):real^N->bool` THEN REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN MATCH_MP_TAC SUBSET_CONVEX_HULL_RELATIVE_FRONTIER THEN ASM_REWRITE_TAC[]]);; let KREIN_MILMAN_RELATIVE_FRONTIER = prove (`!s:real^N->bool. convex s /\ compact s /\ ~(?a. s = {a}) ==> s = convex hull (relative_frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[SUBSET_CONVEX_HULL_RELATIVE_FRONTIER; COMPACT_IMP_BOUNDED] THEN ASM_SIMP_TAC[SUBSET_HULL] THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN SET_TAC[]);; let KREIN_MILMAN_RELATIVE_BOUNDARY = prove (`!s:real^N->bool. convex s /\ compact s /\ ~(?a. s = {a}) ==> s = convex hull (s DIFF relative_interior s)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP KREIN_MILMAN_RELATIVE_FRONTIER) THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED]);; let KREIN_MILMAN_FRONTIER = prove (`!s:real^N->bool. convex s /\ compact s ==> s = convex hull (frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[SUBSET_CONVEX_HULL_FRONTIER; COMPACT_IMP_BOUNDED] THEN ASM_SIMP_TAC[SUBSET_HULL] THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN SET_TAC[]);; let RELATIVE_FRONTIER_NOT_SING = prove (`!s a:real^N. bounded s ==> ~(relative_frontier s = {a})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[RELATIVE_FRONTIER_EMPTY; NOT_INSERT_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN ASM_CASES_TAC `s = {z:real^N}` THEN ASM_REWRITE_TAC[RELATIVE_FRONTIER_SING; NOT_INSERT_EMPTY] THEN SUBGOAL_THEN `?w:real^N. w IN s /\ ~(w = z)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN SUBGOAL_THEN `~((w:real^N) IN relative_frontier s /\ z IN relative_frontier s)` MP_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN MAP_EVERY UNDISCH_TAC [`relative_frontier s = {a:real^N}`; `bounded(s:real^N->bool)`; `~(w:real^N = z)`; `(z:real^N) IN s`; `(w:real^N) IN s`; `~((w:real^N) IN relative_frontier s /\ z IN relative_frontier s)`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[DE_MORGAN_THM] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`z:real^N`; `w:real^N`] THEN MATCH_MP_TAC(MESON[] `(!w z. Q w z <=> Q z w) /\ (!w z. P z ==> Q w z) ==> !w z. P w \/ P z ==> Q w z`) THEN CONJ_TAC THENL [MESON_TAC[]; REPEAT GEN_TAC] THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN REWRITE_TAC[relative_frontier; IN_DIFF] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]; DISCH_TAC] THEN MP_TAC(GEN `d:real` (ISPECL [`s:real^N->bool`; `z:real^N`; `d % (w - z):real^N`] RAY_TO_RELATIVE_FRONTIER)) THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL; HULL_INC; VECTOR_MUL_EQ_0] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `--(&1)` th)) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_MUL_ASSOC; VECTOR_SUB_EQ; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_REAL_ARITH_TAC);; let RELATIVE_INTERIOR_PCROSS = prove (`!s:real^M->bool t:real^N->bool. relative_interior(s PCROSS t) = relative_interior s PCROSS relative_interior t`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[PCROSS_EMPTY; RELATIVE_INTERIOR_EMPTY] THEN REWRITE_TAC[relative_interior; AFFINE_HULL_PCROSS] THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THENL [ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool` (CONJUNCTS_THEN ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (funpow 3 rand) SUBSET_PCROSS o snd) THEN ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(v:real^M->bool) PCROSS (w:real^N->bool)` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS; SUBSET_PCROSS; OPEN_IN_PCROSS]]);; let RELATIVE_FRONTIER_EQ_EMPTY = prove (`!s:real^N->bool. relative_frontier s = {} <=> affine s`, GEN_TAC THEN REWRITE_TAC[relative_frontier] THEN REWRITE_TAC[GSYM RELATIVE_INTERIOR_EQ_CLOSURE] THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let DIAMETER_BOUNDED_BOUND_LT = prove (`!s x y:real^N. bounded s /\ x IN relative_interior s /\ y IN closure s /\ ~(diameter s = &0) ==> norm(x - y) < diameter s`, let lemma = prove (`!s x y:real^N. bounded s /\ x IN relative_interior s /\ y IN s /\ ~(diameter s = &0) ==> norm(x - y) < diameter s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN ASM_SIMP_TAC[REAL_LT_LE; DIAMETER_BOUNDED_BOUND] THEN ASM_CASES_TAC `y:real^N = x` THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `x + e / norm(x - y) % (x - y):real^N`) THEN REWRITE_TAC[NOT_IMP; IN_INTER] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(x:real^M,x + y) = norm y`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_SIMP_TAC[HULL_INC; AFFINE_AFFINE_HULL]; DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x + e / norm(x - y) % (x - y):real^N`; `y:real^N`] DIAMETER_BOUNDED_BOUND) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_ARITH `(x + e % (x - y)) - y:real^N = (&1 + e) % (x - y)`] THEN SIMP_TAC[NORM_MUL; REAL_ARITH `~(a * n <= n) <=> &0 < n * (a - &1)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> &0 < abs(&1 + e) - &1`) THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `x:real^N`; `y:real^N`] lemma) THEN ASM_SIMP_TAC[DIAMETER_CLOSURE; BOUNDED_CLOSURE] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR THEN REWRITE_TAC[CLOSURE_SUBSET; AFFINE_HULL_CLOSURE]);; let DIAMETER_ATTAINED_RELATIVE_FRONTIER = prove (`!s:real^N->bool. bounded s /\ ~(diameter s = &0) ==> ?x y. x IN relative_frontier s /\ y IN relative_frontier s /\ norm(x - y) = diameter s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIAMETER_EMPTY; relative_frontier] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_COMPACT_ATTAINED) THEN ASM_SIMP_TAC[COMPACT_CLOSURE; CLOSURE_EQ_EMPTY; DIAMETER_CLOSURE] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIAMETER_BOUNDED_BOUND_LT) THENL [DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`]); DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `x:real^N`])] THEN ASM_MESON_TAC[REAL_LT_REFL; NORM_SUB]);; let DIAMETER_RELATIVE_FRONTIER = prove (`!s:real^N->bool. bounded s /\ ~(?a. s = {a}) ==> diameter(relative_frontier s) = diameter s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[RELATIVE_FRONTIER_EMPTY] THEN REWRITE_TAC[relative_frontier] THEN GEN_REWRITE_TAC RAND_CONV [GSYM DIAMETER_CLOSURE] THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_SIMP_TAC[SUBSET_DIFF; DIAMETER_SUBSET; BOUNDED_CLOSURE] THEN ASM_SIMP_TAC[DIAMETER_CLOSURE] THEN MP_TAC(ISPEC `s:real^N->bool` DIAMETER_ATTAINED_RELATIVE_FRONTIER) THEN ASM_SIMP_TAC[DIAMETER_EQ_0; relative_frontier] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_SIMP_TAC[BOUNDED_CLOSURE; BOUNDED_DIFF]);; let DIAMETER_ATTAINED_FRONTIER = prove (`!s:real^N->bool. bounded s /\ ~(diameter s = &0) ==> ?x y. x IN frontier s /\ y IN frontier s /\ norm(x - y) = diameter s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIAMETER_ATTAINED_RELATIVE_FRONTIER) THEN REWRITE_TAC[frontier; relative_frontier; IN_DIFF] THEN MESON_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR]);; let DIAMETER_FRONTIER = prove (`!s:real^N->bool. bounded s ==> diameter(frontier s) = diameter s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a:real^N. s = {a}` THENL [ASM_MESON_TAC[FRONTIER_SING]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `!r. r <= f /\ f <= s /\ r = s ==> f = s`) THEN EXISTS_TAC `diameter(closure s DIFF relative_interior s:real^N->bool)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC DIAMETER_SUBSET THEN ASM_SIMP_TAC[BOUNDED_FRONTIER] THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN SET_TAC[]; GEN_REWRITE_TAC RAND_CONV [GSYM DIAMETER_CLOSURE] THEN MATCH_MP_TAC DIAMETER_SUBSET THEN ASM_SIMP_TAC[BOUNDED_CLOSURE; frontier; SUBSET_DIFF]; ASM_SIMP_TAC[DIAMETER_RELATIVE_FRONTIER; GSYM relative_frontier]]);; let CLOSEST_POINT_IN_RELATIVE_INTERIOR = prove (`!s x:real^N. closed s /\ ~(s = {}) /\ x IN affine hull s ==> ((closest_point s x) IN relative_interior s <=> x IN relative_interior s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `closest_point s x - (min (&1) (e / norm(closest_point s x - x))) % (closest_point s x - x):real^N`] CLOSEST_POINT_LE) THEN ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL; IN_INTER] THEN CONJ_TAC THENL [REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE]; MATCH_MP_TAC IN_AFFINE_SUB_MUL_DIFF THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC]]; REWRITE_TAC[NORM_MUL; REAL_ARITH `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);; let CLOSEST_POINT_IN_RELATIVE_FRONTIER = prove (`!s x:real^N. closed s /\ ~(s = {}) /\ x IN affine hull s DIFF relative_interior s ==> closest_point s x IN relative_frontier s`, SIMP_TAC[relative_frontier; IN_DIFF; CLOSEST_POINT_IN_RELATIVE_INTERIOR] THEN MESON_TAC[CLOSURE_SUBSET; CLOSEST_POINT_IN_SET; SUBSET]);; let IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT = prove (`!s x a:real^N. convex s /\ x IN relative_interior s /\ a IN affine hull s /\ ~(x = a) ==> ?b. b IN s /\ x IN segment(a,b)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `x + d / norm(x - a) % (x - a:real^N)` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_INTER; IN_CBALL] THEN ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF; HULL_INC; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[segment] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = a + x <=> x = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ; REAL_LT_IMP_NZ] THEN ASM_REWRITE_TAC[IN_SEGMENT; VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `x:real^N = (&1 - u) % a + u % (x + v % (x - a)) <=> (&1 - u * (&1 + v)) % (x - a) = vec 0`] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; REAL_FIELD `&0 < d ==> (&1 - u * (&1 + d) = &0 <=> u = inv(&1 + d))`] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN ASM_SIMP_TAC[UNWIND_THM2; REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_ARITH `&0 < d ==> &1 <= &1 + d /\ &0 <= &1 + d`; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);; let IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_STRONG = prove (`!s x a:real^N. convex s /\ x IN relative_interior s /\ a IN affine hull s /\ ~(x = a) ==> ?b. b IN relative_interior s /\ x IN segment(a,b)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC o MATCH_MP IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT) THEN EXISTS_TAC `midpoint(x:real^N,b)` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `b:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_THEN(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT] THEN ASM_MESON_TAC[ENDS_NOT_IN_SEGMENT]; ONCE_REWRITE_TAC[segment] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT] THEN MATCH_MP_TAC BETWEEN_TRANS_2 THEN EXISTS_TAC `b:real^N` THEN REWRITE_TAC[BETWEEN_MIDPOINT] THEN ASM_MESON_TAC[BETWEEN_IN_SEGMENT; segment; IN_DIFF; SEGMENT_SYM]; CONV_TAC(RAND_CONV SYM_CONV) THEN REWRITE_TAC[MIDPOINT_EQ_ENDPOINT] THEN ASM_MESON_TAC[ENDS_NOT_IN_SEGMENT]]]);; let IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_EQ = prove (`!s x:real^N. convex s ==> (x IN relative_interior s <=> ~(s = {}) /\ !a. a IN s /\ ~(a = x) ==> ?b. b IN s /\ x IN segment(a,b))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY; NOT_IN_EMPTY] THEN EQ_TAC THEN STRIP_TAC THENL [ASM_MESON_TAC[HULL_INC; IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_CASES_TAC `x:real^N = z` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`; `y:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN ASM SET_TAC[]);; let INTER_RELATIVE_INTERIOR_SUBSET = prove (`!s t:real^N->bool. convex s /\ convex t ==> relative_interior s INTER relative_interior t SUBSET relative_interior(s INTER t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `i1 INTER i2 = {} ==> k1 SUBSET i1 /\ k2 SUBSET i2 ==> k1 INTER k2 SUBSET u`)) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET]; REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N`] THEN ASM_SIMP_TAC[IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_EQ; CONVEX_INTER] THEN ONCE_REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN REWRITE_TAC[AND_FORALL_THM; IN_INTER] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC)) (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC))) THEN MP_TAC(ISPECL [`y:real^N`; `u:real^N`; `v:real^N`; `x:real^N`] BETWEEN_RESTRICTED_CASES) THEN ANTS_TAC THENL [ASM_MESON_TAC[BETWEEN_IMP_COLLINEAR; INSERT_AC; BETWEEN_IN_SEGMENT; REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED]; REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN STRIP_TAC THENL [EXISTS_TAC `u:real^N` THEN MP_TAC(ISPEC `t:real^N->bool` CONVEX_CONTAINS_SEGMENT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `v:real^N`]) THEN ASM_REWRITE_TAC[SUBSET] THEN ASM SET_TAC[]; EXISTS_TAC `v:real^N` THEN MP_TAC(ISPEC `s:real^N->bool` CONVEX_CONTAINS_SEGMENT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `u:real^N`]) THEN ASM_REWRITE_TAC[SUBSET] THEN ASM SET_TAC[]]]);; let RELATIVE_INTERIOR_INTER = prove (`!s t:real^N->bool. convex s /\ convex t /\ ~(relative_interior s INTER relative_interior t = {}) ==> relative_interior(s INTER t) = relative_interior s INTER relative_interior t`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; INTER_RELATIVE_INTERIOR_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; SUBSET; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s INTER t:real^N->bool`; `x:real^N`; `v:real^N`] IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT) THEN ASM_CASES_TAC `x:real^N = v` THEN ASM_SIMP_TAC[CONVEX_INTER; IN_INTER] THEN ANTS_TAC THENL [MATCH_MP_TAC HULL_INC THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N`; `z:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT); MP_TAC(ISPECL [`t:real^N->bool`; `v:real^N`; `z:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT)] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN ASM SET_TAC[]]);; let SUBSET_RELATIVE_INTERIOR_INTERSECTING_CONVEX = prove (`!s t:real^N->bool. convex s /\ convex t /\ s SUBSET t /\ ~(s INTER relative_interior t = {}) ==> relative_interior s SUBSET relative_interior t`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `a:real^N`] IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT) THEN ASM_SIMP_TAC[HULL_INC] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> a IN s ==> a IN t`) THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]);; let CONVEX_HULL_SPHERE = prove (`!s:real^N r. convex hull (sphere(a,r)) = cball(a,r)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_CBALL] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC KREIN_MILMAN_FRONTIER THEN REWRITE_TAC[CONVEX_CBALL; COMPACT_CBALL]);; let SPHERE_SUBSET_CONVEX = prove (`!s a:real^N r. convex s ==> (sphere(a,r) SUBSET s <=> cball(a,r) SUBSET s)`, REWRITE_TAC[GSYM CONVEX_HULL_SPHERE] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[SUBSET_HULL]);; let DIAMETER_SPHERE = prove (`!a:real^N r. diameter(sphere(a,r)) = if r < &0 then &0 else &2 * r`, REWRITE_TAC[GSYM FRONTIER_CBALL] THEN ASM_SIMP_TAC[DIAMETER_FRONTIER; BOUNDED_CBALL; DIAMETER_CBALL]);; (* ------------------------------------------------------------------------- *) (* Small move from (relative frontier of) convex set. *) (* ------------------------------------------------------------------------- *) let CONVEX_NEARBY_IN_SCALING = prove (`!s:real^N->bool r. convex s /\ vec 0 IN relative_interior s /\ &1 < r ==> ?d. &0 < d /\ !x y. x IN s /\ y IN affine hull s /\ dist(x,y) <= d ==> y IN IMAGE (\x. r % x) s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `a * (r - &1)` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT] THEN REPEAT STRIP_TAC THEN SUBST1_TAC(REAL_ARITH `r = &1 + (r - &1)`) THEN ASM_SIMP_TAC[GSYM CONVEX_SUMS_MULTIPLES; VECTOR_MUL_LID; REAL_POS; REAL_SUB_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `inv(r - &1) % (y - x):real^N`] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL_0; IN_INTER; NORM_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[SPAN_MUL; SPAN_SUB; SPAN_SUPERSET] THEN ASM_SIMP_TAC[real_abs; REAL_SUB_LE; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN ASM_REWRITE_TAC[GSYM dist]);; let CONVEX_NEARBY_IN_SCALING_RELATIVE_INTERIOR = prove (`!s:real^N->bool r. convex s /\ vec 0 IN relative_interior s /\ &1 < r ==> ?d. &0 < d /\ !x y. x IN s /\ y IN affine hull s /\ dist(x,y) <= d ==> y IN IMAGE (\x. r % x) (relative_interior s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(r + &1) / &2`] CONVEX_NEARBY_IN_SCALING) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN SUBGOAL_THEN `(\x:real^N. (r + &1) / &2 % x) = (\x. r % x) o (\x. (r + &1) / (&2 * r) % x)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; VECTOR_MUL_ASSOC] THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&1 < r` THEN CONV_TAC REAL_FIELD; REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a % x:real^N = x - (&1 - a) % (x - vec 0)`] THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_SIMP_TAC[CLOSURE_INC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < &1 ==> &0 < &1 - x /\ &1 - x <= &1`) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_ARITH `&1 < x ==> &0 < &2 * x`] THEN ASM_REAL_ARITH_TAC);; let CONVEX_NEARBY_NOT_IN_SCALING = prove (`!s:real^N->bool r. convex s /\ vec 0 IN relative_interior s /\ &0 < r /\ r < &1 ==> ?d. &0 < d /\ !x y. x IN relative_frontier s /\ dist(x,y) <= d ==> ~(y IN IMAGE (\x. r % x) s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `inv r:real`] CONVEX_NEARBY_IN_SCALING_RELATIVE_INTERIOR) THEN ASM_SIMP_TAC[REAL_INV_1_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d * r:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[relative_frontier; IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv r % y:real^N`; `inv r % x:real^N`]) THEN ASM_REWRITE_TAC[DIST_MUL; IN_IMAGE; NOT_IMP; REAL_ABS_INV] THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; REAL_LT_INV_EQ] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; UNWIND_THM1; CONTRAPOS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] CLOSURE_SUBSET_AFFINE_HULL)) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; SPAN_MUL]);; (* ------------------------------------------------------------------------- *) (* Basic closure properties for "is_interval". *) (* ------------------------------------------------------------------------- *) let IS_INTERVAL_RELATIVE_INTERIOR = prove (`!s:real^N->bool. is_interval s ==> is_interval(relative_interior s)`, REWRITE_TAC[is_interval; IN_RELATIVE_INTERIOR_CBALL] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) ASSUME_TAC) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_METIS_TAC[]; DISCH_TAC] THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`a + (y - x):real^N`; `b + (y - x):real^N`] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `a + y - x <= y <=> a <= x`] THEN ASM_REWRITE_TAC[REAL_ARITH `y <= b + y - x <=> x <= b`] THEN CONJ_TAC THENL [UNDISCH_TAC `cball(a:real^N,d) INTER affine hull s SUBSET s`; UNDISCH_TAC `cball(b:real^N,e) INTER affine hull s SUBSET s`] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_CBALL; IN_INTER] THEN (CONJ_TAC THENL [UNDISCH_TAC `dist(x:real^N,y) <= min d e` THEN CONV_TAC NORM_ARITH; ONCE_REWRITE_TAC[VECTOR_ARITH `a + b:real^N = a + &1 % b`] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC]]));; let IS_INTERVAL_INTERIOR = prove (`!s:real^N->bool. is_interval s ==> is_interval(interior s)`, GEN_TAC THEN ASM_CASES_TAC `interior s:real^N->bool = {}` THEN ASM_REWRITE_TAC[IS_INTERVAL_EMPTY] THEN ASM_SIMP_TAC[GSYM RELATIVE_INTERIOR_NONEMPTY_INTERIOR] THEN REWRITE_TAC[IS_INTERVAL_RELATIVE_INTERIOR]);; let IS_INTERVAL_CLOSURE = prove (`!s:real^N->bool. is_interval s ==> is_interval(closure s)`, let lemma = prove (`!a b u v. (u <= x /\ x <= v \/ v <= x /\ x <= u) /\ abs(a - u) < e /\ abs(b - v) < e ==> ?y. (a <= y /\ y <= b \/ b <= y /\ y <= a) /\ abs(y - x) < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[] `!a b c. P a \/ P b \/ P c ==> ?x. P x`) THEN MAP_EVERY EXISTS_TAC [`x:real`; `a:real`; `b:real`] THEN ASM_REAL_ARITH_TAC) in REWRITE_TAC[is_interval; CLOSURE_APPROACHABLE] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN REWRITE_TAC[CONJ_ASSOC; AND_FORALL_THM] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?y. ((u:real^N)$i <= y /\ y <= (v:real^N)$i \/ v$i <= y /\ y <= u$i) /\ abs(y - (x:real^N)$i) < e / &(dimindex(:N))` MP_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC [`(a:real^N)$i`; `(b:real^N)$i`] THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN ASM_REWRITE_TAC[GSYM dist]; REWRITE_TAC[LAMBDA_SKOLEM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N`; `v:real^N`; `y:real^N`]) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]);; (* ------------------------------------------------------------------------- *) (* Shrinking space to a ball while preserving convexity. *) (* ------------------------------------------------------------------------- *) let CONVEX_PREIMAGE_CONCAVE_SCALING = prove (`!f s t:real^N->bool. convex s /\ convex t /\ vec 0 IN s /\ (\x. --f x) convex_on t /\ (!x. x IN t ==> &0 < f x) ==> convex {x | x IN t /\ (inv(f x) % x) IN s}`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `s SUBSET {x | x IN t /\ Q x} <=> s SUBSET t /\ s SUBSET {x | Q x}`] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN EXISTS_TAC `convex hull {vec 0:real^N,inv(f a) % a,inv(f b) % b}` THEN CONJ_TAC THENL [REWRITE_TAC[CONVEX_HULL_3; IN_ELIM_THM; VECTOR_MUL_RZERO] THEN REWRITE_TAC[TAUT `(p /\ q /\ r /\ s) /\ t <=> s /\ q /\ r /\ p /\ t`] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?b c a. P a b c)`] THEN REWRITE_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`; UNWIND_THM2] THEN REWRITE_TAC[VECTOR_ADD_LID; REAL_SUB_LE] THEN SUBGOAL_THEN `(x:real^N) IN t` ASSUME_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `(&1 - u) * (f:real^N->real) a / f x` THEN EXISTS_TAC `u * (f:real^N->real) b / f x` THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [REAL_LE_MUL; REAL_LE_DIV; REAL_SUB_LE; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `u * a / c + v * b / c:real = (u * a + v * b) / c`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `&1 - u`; `u:real`] o GEN_REWRITE_RULE I [convex_on]) THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; REAL_SUB_LE] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD `&0 < a ==> (u * a / b) * inv a = inv b * u`] THEN ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB]]; MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]]);; let CONVEXITY_PRESERVING_SHRINK_0 = prove (`?f g. homeomorphism ((:real^N),ball(vec 0:real^N,&1)) (f,g) /\ (!s. conic hull (IMAGE f s) = conic hull s) /\ (!s. vec 0 IN s ==> vec 0 IN IMAGE f s) /\ (!s. convex s /\ vec 0 IN s ==> convex(IMAGE f s)) /\ (!s. vec 0 IN relative_interior s ==> vec 0 IN relative_interior(IMAGE f s))`, ABBREV_TAC `f = \x:real^N. inv(&1 + norm x) % x` THEN ABBREV_TAC `g = \x:real^N. inv(&1 - norm x) % x` THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MAP_EVERY EXPAND_TAC ["f"; "g"] THEN REWRITE_TAC[NORM_MUL] THEN REWRITE_TAC[IN_BALL_0; REAL_ABS_INV; IN_UNIV] THEN SIMP_TAC[real_abs; NORM_MUL; REAL_LE_INV_EQ; REAL_SUB_LE; REAL_LT_IMP_LE; NORM_ARITH `&0 <= &1 + norm(x:real^N)`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN REWRITE_TAC[LIFT_ADD; NORM_ARITH `~(&1 + norm(x:real^N) = &0)`] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM]; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM real_div] THEN SIMP_TAC[REAL_LT_LDIV_EQ; NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[LIFT_SUB; IN_ELIM_THM; REAL_SUB_0; REAL_LT_IMP_NE] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM] THEN SIMP_TAC[IN_BALL_0; REAL_LT_IMP_NE]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN CONV_TAC REAL_FIELD; GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC(MESON[VECTOR_MUL_LID] `(P ==> a = &1) ==> P ==> a % y = y`) THEN CONV_TAC REAL_FIELD]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [X_GEN_TAC `s:real^N->bool` THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONIC_CONIC_HULL] THENL [EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN SIMP_TAC[HULL_INC; REAL_LE_INV_EQ; REWRITE_RULE[conic] CONIC_CONIC_HULL; NORM_ARITH `&0 <= &1 + norm(x:real^N)`]; EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IN_ELIM_THM; IN_IMAGE] THEN EXISTS_TAC `&1 + norm(x:real^N)` THEN EXISTS_TAC `inv(&1 + norm x) % x:real^N` THEN SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_IMP_LE; NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN ASM_MESON_TAC[]]; DISCH_TAC] THEN REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN SUBGOAL_THEN `IMAGE f s = {x | x IN ball(vec 0,&1) /\ (g:real^N->real^N) x IN s}` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN SET_TAC[]; EXPAND_TAC "g" THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_RZERO] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN STRIP_TAC] THEN MATCH_MP_TAC CONVEX_PREIMAGE_CONCAVE_SCALING THEN ASM_REWRITE_TAC[CONVEX_BALL] THEN EXPAND_TAC "g" THEN SIMP_TAC[IN_BALL_0; REAL_LT_INV_EQ; REAL_SUB_LT] THEN SIMP_TAC[convex_on; REAL_LE_LADD; REAL_ARITH `--(&1 - z) <= u * --(&1 - x) + v * --(&1 - y) <=> (u + v) + z <= &1 + (u * x + v * y)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN ASM_REWRITE_TAC[NORM_MUL; real_abs; REAL_LE_REFL]; STRIP_TAC] THEN X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN ONCE_REWRITE_TAC[GSYM SPAN_CONIC_HULL] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SPAN_CONIC_HULL] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `open_in (subtopology euclidean (ball(vec 0,&1))) (IMAGE (f:real^N->real^N) (ball(vec 0,r)))` MP_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`g:real^N->real^N`; `(:real^N)`] THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; OPEN_BALL]; SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_BALL]] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `bd SUBSET IMAGE f br ==> br INTER ss SUBSET s /\ IMAGE f br INTER ss SUBSET IMAGE f (br INTER ss) ==> bd INTER ss SUBSET IMAGE f s`)) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `IMAGE (f:real^N->real^N) (ball(vec 0,r)) INTER IMAGE f (span s)` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. f x IN ss ==> x IN ss) ==> IMAGE f br INTER ss SUBSET IMAGE f br INTER IMAGE f ss`); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN ASM SET_TAC[]] THEN X_GEN_TAC `x:real^N` THEN EXPAND_TAC "f" THEN REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `x:real^N = (&1 + norm x) % inv(&1 + norm x) % x` SUBST1_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SPAN_MUL]] THEN SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_RINV; NORM_ARITH `~(&1 + norm(x:real^N) = &0)`]);; (* ------------------------------------------------------------------------- *) (* Some convexity-related properties of Hausdorff distance *) (* ------------------------------------------------------------------------- *) let HAUSDIST_CONVEX_HULLS = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> hausdist(convex hull s,convex hull t) <= hausdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_MESON_TAC[HAUSDIST_EMPTY; CONVEX_HULL_EMPTY; REAL_LE_REFL]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_MESON_TAC[HAUSDIST_EMPTY; CONVEX_HULL_EMPTY; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN CONJ_TAC THEN MATCH_MP_TAC CONVEX_ON_CONVEX_HULL_BOUND THEN CONJ_TAC THEN SIMP_TAC[CONVEX_ON_SETDIST; CONVEX_CONVEX_HULL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; CONJ_ASSOC] THEN (CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[SETDIST_SUBSET_RIGHT; HULL_SUBSET]]) THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let HAUSDIST_SUMS = prove (`!s t:real^N->bool u. bounded s /\ bounded t /\ convex s /\ convex t /\ bounded u /\ ~(s = {}) /\ ~(t = {}) /\ ~(u = {}) ==> hausdist({x + e | x IN s /\ e IN u}, {y + e | y IN t /\ e IN u}) = hausdist(s,t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN SIMP_TAC[CLOSURE_SUMS] THEN SIMP_TAC[CLOSURE_CLOSED; CLOSED_CBALL; GSYM COMPACT_CLOSURE] THEN ONCE_REWRITE_TAC[GSYM CLOSURE_EQ_EMPTY] THEN ASM_CASES_TAC `convex(closure s:real^N->bool) /\ convex(closure t:real^N->bool)` THENL [POP_ASSUM MP_TAC; ASM_MESON_TAC[CONVEX_CLOSURE]] THEN ASM_CASES_TAC `convex(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `convex(t:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`closure u:real^N->bool`,`u:real^N->bool`) THEN SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN MAP_EVERY ABBREV_TAC [`a = hausdist(s:real^N->bool,t)`; `b = hausdist({x + e:real^N | x IN s /\ e IN u}, {y + e | y IN t /\ e IN u})`] THEN ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THENL [REWRITE_TAC[SUMS_ASSOC] THEN GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN REWRITE_TAC[GSYM SUMS_ASSOC] THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s' /\ y IN t}`) THEN EXPAND_TAC "a" THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]; CONJ_TAC THEN MATCH_MP_TAC SUBSET_SUMS_RCANCEL THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL; COMPACT_IMP_CLOSED; CONVEX_CBALL; COMPACT_IMP_BOUNDED; CONVEX_SUMS; REAL_NOT_LT] THEN REWRITE_TAC[SUMS_ASSOC] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN REWRITE_TAC[GSYM SUMS_ASSOC] THEN EXPAND_TAC "b" THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN ASM_SIMP_TAC[BOUNDED_SUMS; COMPACT_SUMS; COMPACT_CBALL; COMPACT_IMP_BOUNDED; CBALL_EQ_EMPTY; REAL_NOT_LT; SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`]]);; let HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT = prove (`!s t d x:real^N. convex s /\ bounded s /\ ~(s = {}) /\ bounded t /\ ~(x IN s) /\ hausdist(s,t) < d ==> ?y. ~(y IN t) /\ dist(x,y) < d`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SUPPORTING_HYPERPLANE_POINT) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `bb:real`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_CASES_TAC `x IN closure((:real^N) DIFF t)` THENL [ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSURE_APPROACHABLE]) THEN REWRITE_TAC[IN_UNIV; IN_DIFF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[REAL_LET_TRANS; HAUSDIST_POS_LE]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [CLOSURE_COMPLEMENT]) THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN DISCH_TAC] THEN MP_TAC(ISPECL [`t:real^N->bool`; `x:real^N`; `--a:real^N`] RAY_TO_FRONTIER) THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?w:real^N. w IN s /\ dist(x + l % --a,w) < d` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN EXISTS_TAC `closure t:real^N->bool` THEN ASM_SIMP_TAC[HAUSDIST_CLOSURE; BOUNDED_CLOSURE] THEN ASM_MESON_TAC[frontier; IN_DIFF; HAUSDIST_SYM]; ALL_TAC] THEN SUBGOAL_THEN `(x + l % --a) IN frontier((:real^N) DIFF t)` MP_TAC THENL [ASM_REWRITE_TAC[FRONTIER_COMPLEMENT]; REWRITE_TAC[frontier]] THEN REWRITE_TAC[IN_DIFF; CLOSURE_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPEC `d - dist(x:real^N,x + l % --a)` o CONJUNCT1) THEN ASM_REWRITE_TAC[IN_UNIV; REAL_SUB_LT] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[NORM_ARITH `dist(y:real^N,z) < d - dist(x,z) ==> dist(x,y) < d`]] THEN SUBGOAL_THEN `ball(x + l % --a:real^N,dist(x,x + l % --a)) INTER closure s = {}` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!y. y IN t ==> P y) ==> (!x. x IN u ==> ~P x) ==> u INTER t = {}`)) THEN X_GEN_TAC `v:real^N` THEN REWRITE_TAC[IN_BALL; REAL_NOT_LE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N`; `v - (x + l % --a):real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN REWRITE_TAC[DOT_RSUB; DOT_RADD; DOT_RNEG; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `d < l * a /\ x <= y ==> abs(v - (x + l * --a)) <= d ==> ~(v >= y)`) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LTE_TRANS `norm(a:real^N) * dist(x:real^N,x + l % --a)` THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; NORM_POS_LT; NORM_ARITH `norm(a - b:real^N) = dist(b,a)`] THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN REWRITE_TAC[DOT_RMUL; NORM_MUL; NORM_NEG; DOT_RNEG] THEN ASM_SIMP_TAC[GSYM NORM_POW_2; REAL_POW_2; REAL_MUL_AC; real_abs; REAL_LT_IMP_LE; REAL_LE_REFL]; DISCH_THEN(MP_TAC o SPEC `w:real^N` o MATCH_MP (SET_RULE `s INTER t = {} ==> !w. w IN t ==> ~(w IN s)`)) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; IN_BALL] THEN ASM_REAL_ARITH_TAC]);; let HAUSDIST_COMPLEMENTS_CONVEX_LE = prove (`!s t:real^N->bool. convex s /\ bounded s /\ convex t /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist((:real^N) DIFF s,(:real^N) DIFF t) <= hausdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(:real^N) DIFF s = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE] THEN ASM_CASES_TAC `(:real^N) DIFF t = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[REAL_NOT_LT; REAL_LT_REFL] `(!z:real. y < z ==> x < z) ==> x <= y`) THEN X_GEN_TAC `d:real` THEN DISCH_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT); MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`] HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT)] THEN DISCH_THEN(MP_TAC o SPECL [`d:real`; `x:real^N`]) THEN (ANTS_TAC THENL [ASM_MESON_TAC[HAUSDIST_SYM]; ALL_TAC]) THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* The Blaschke selection principle and related results. *) (* ------------------------------------------------------------------------- *) let CONVEX_HAUSDIST_LIMIT = prove (`!s:(num->real^N->bool) t. eventually (\n. bounded(s n) /\ convex(s n) /\ ~(s n = {})) sequentially /\ compact t /\ ((\n. lift(hausdist(s n,t))) --> vec 0) sequentially ==> convex t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONVEX_EMPTY] THEN SUBGOAL_THEN `hausdist(convex hull t:real^N->bool,t) = &0` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[HAUSDIST_EQ_0; COMPACT_IMP_CLOSED; CONVEX_HULL_EQ_EMPTY; CLOSURE_CLOSED; COMPACT_IMP_BOUNDED; COMPACT_CONVEX_HULL] THEN REWRITE_TAC[CONVEX_HULL_EQ]] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN MATCH_MP_TAC(MESON[LIM_CONST; LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY] `((\x. a) --> b) sequentially ==> a = b`) THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. hausdist(convex hull t,convex hull ((s:num->real^N->bool) n)) + hausdist(s n,t)` THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_HAUSDIST] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN SIMP_TAC[HULL_P] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_TRIANGLE THEN ASM_SIMP_TAC[COMPACT_CONVEX_HULL; COMPACT_IMP_BOUNDED]; REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC LIM_NULL_ADD THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_NULL_COMPARISON)) THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_HAUSDIST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [HAUSDIST_SYM] THEN MATCH_MP_TAC HAUSDIST_CONVEX_HULLS THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]]);; let COMPLETE_HAUSDIST_CONVEX = prove (`!f:num->(real^N->bool) c. closed c /\ (!n. bounded(f n) /\ convex(f n) /\ ~(f n = {}) /\ f n SUBSET c) /\ (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> hausdist(f m,f n) < e) ==> ?s. compact s /\ convex s /\ ~(s = {}) /\ s SUBSET c /\ ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->(real^N->bool)`; `c:real^N->bool`] COMPLETE_HAUSDIST) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_HAUSDIST_LIMIT THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY]);; let COMPLETE_HAUSDIST_CONVEX_UNIV = prove (`!f:num->(real^N->bool). (!n. bounded(f n) /\ convex(f n) /\ ~(f n = {})) /\ (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> hausdist(f m,f n) < e) ==> ?s. compact s /\ convex s /\ ~(s = {}) /\ ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->(real^N->bool)`; `(:real^N)`] COMPLETE_HAUSDIST_CONVEX) THEN ASM_REWRITE_TAC[SUBSET_UNIV; CLOSED_UNIV]);; let BLASCHKE = prove (`!f:num->(real^N->bool) c. compact c /\ (!n. convex(f n) /\ ~(f n = {}) /\ f n SUBSET c) ==> ?r s. (!m n. m < n ==> r m < r n) /\ compact s /\ convex s /\ ~(s = {}) /\ s SUBSET c /\ ((\n. lift(hausdist(f(r n),s))) --> vec 0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->(real^N->bool)`; `c:real^N->bool`] COMPACT_HAUSDIST) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_HAUSDIST_LIMIT THEN EXISTS_TAC `(f:num->real^N->bool) o (r:num->num)` THEN ASM_REWRITE_TAC[o_THM; EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]);; let BLASCHKE_UNIV = prove (`!f:num->(real^N->bool) c. bounded c /\ (!n. convex(f n) /\ ~(f n = {}) /\ f n SUBSET c) ==> ?r s. (!m n. m < n ==> r m < r n) /\ compact s /\ convex s /\ ~(s = {}) /\ ((\n. lift(hausdist(f(r n),s))) --> vec 0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->(real^N->bool)`; `closure c:real^N->bool`] BLASCHKE) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Interior, relative interior and closure interrelations. *) (* ------------------------------------------------------------------------- *) let CONVEX_CLOSURE_INTERIOR = prove (`!s:real^N->bool. convex s /\ ~(interior s = {}) ==> closure(interior s) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[SUBSET_CLOSURE; INTERIOR_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]; ALL_TAC] THEN REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `b - min (e / &2 / norm(b - a)) (&1) % (b - a):real^N` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LE_REFL; REAL_LT_01]; REWRITE_TAC[VECTOR_ARITH `b - x:real^N = b <=> x = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min x (&1) = &0)`); REWRITE_TAC[NORM_ARITH `dist(b - x:real^N,b) = norm x`] THEN REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2 / norm(b - a:real^N) * norm(b - a)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> abs(min x (&1)) <= x`); ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_POS_LT; REAL_LT_IMP_NZ; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_OF_NUM_LT; VECTOR_SUB_EQ; ARITH]);; let EMPTY_INTERIOR_SUBSET_HYPERPLANE = prove (`!s. convex s /\ interior s = {} ==> ?a:real^N b. ~(a = vec 0) /\ s SUBSET {x | a dot x = b}`, let lemma = prove (`!s. convex s /\ (vec 0) IN s /\ interior s = {} ==> ?a:real^N b. ~(a = vec 0) /\ s SUBSET {x | a dot x = b}`, GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` MP_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; MEMBER_NOT_EMPTY]; ALL_TAC] THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN ONCE_REWRITE_TAC[GSYM SPAN_UNIV] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; GSYM NOT_LT] THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN EXISTS_TAC `&0` THEN ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC]) in GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_MESON_TAC[EMPTY_SUBSET; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN MP_TAC(ISPEC `IMAGE (\x:real^N. --a + x) s` lemma) THEN ASM_REWRITE_TAC[CONVEX_TRANSLATION_EQ; INTERIOR_TRANSLATION; IMAGE_EQ_EMPTY; IN_IMAGE; UNWIND_THM2; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; DOT_RADD] THEN MESON_TAC[REAL_ARITH `a + x:real = b <=> x = b - a`]);; let CONVEX_INTERIOR_CLOSURE = prove (`!s:real^N->bool. convex s ==> interior(closure s) = interior s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interior(s:real^N->bool) = {}` THENL [MP_TAC(ISPEC `s:real^N->bool` EMPTY_INTERIOR_SUBSET_HYPERPLANE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN EXISTS_TAC `interior {x:real^N | a dot x = b}` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[INTERIOR_HYPERPLANE]] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[CLOSED_HYPERPLANE]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[SUBSET_INTERIOR; CLOSURE_SUBSET] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN MP_TAC(ASSUME `(b:real^N) IN interior(closure s)`) THEN GEN_REWRITE_TAC LAND_CONV [IN_INTERIOR_CBALL] THEN REWRITE_TAC[SUBSET; IN_CBALL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `b + e / norm(b - a) % (b - a):real^N`) THEN ASM_SIMP_TAC[NORM_ARITH `dist(b:real^N,b + e) = norm e`; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ; REAL_ARITH `&0 < e ==> abs e <= e`] THEN DISCH_TAC THEN SUBGOAL_THEN `b = (b + e / norm(b - a) % (b - a)) - e / norm(b - a) / (&1 + e / norm(b - a)) % ((b + e / norm(b - a) % (b - a)) - a):real^N` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_ARITH `b = (b + e % (b - a)) - d % ((b + e % (b - a)) - a) <=> (e - d * (&1 + e)) % (b - a) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0]; MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; REAL_ARITH `&0 < x ==> &0 < &1 + x`; REAL_ARITH `&0 < x ==> ~(&1 + x = &0)`; REAL_MUL_LID; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LE_ADDL; NORM_POS_LE; REAL_SUB_REFL]);; let FRONTIER_CLOSURE_CONVEX = prove (`!s:real^N->bool. convex s ==> frontier(closure s) = frontier s`, SIMP_TAC[frontier; CLOSURE_CLOSURE; CONVEX_INTERIOR_CLOSURE]);; let CONVEX_CLOSURE_RELATIVE_INTERIOR = prove (`!s:real^N->bool. convex s ==> closure(relative_interior s) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[SUBSET_CLOSURE; RELATIVE_INTERIOR_SUBSET] THEN ASM_CASES_TAC `relative_interior(s:real^N->bool) = {}` THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; SUBSET_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]; ALL_TAC] THEN REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `b - min (e / &2 / norm(b - a)) (&1) % (b - a):real^N` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LE_REFL; REAL_LT_01]; REWRITE_TAC[VECTOR_ARITH `b - x:real^N = b <=> x = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min x (&1) = &0)`); REWRITE_TAC[NORM_ARITH `dist(b - x:real^N,b) = norm x`] THEN REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2 / norm(b - a:real^N) * norm(b - a)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> abs(min x (&1)) <= x`); ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_POS_LT; REAL_LT_IMP_NZ; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_OF_NUM_LT; VECTOR_SUB_EQ; ARITH]);; let OPEN_IN_CONVEX_MEETS_RELATIVE_INTERIOR = prove (`!u s:real^N->bool. convex u /\ open_in (subtopology euclidean u) s /\ ~(s = {}) ==> ~(s INTER relative_interior u = {})`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC o GSYM o REWRITE_RULE[OPEN_IN_OPEN]) THEN MP_TAC(ISPECL [`v:real^N->bool`; `relative_interior u:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM_SIMP_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN MP_TAC(ISPEC `u:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);; let SETDIST_RELATIVE_INTERIOR = prove (`(!s t. convex s ==> setdist(relative_interior s,t) = setdist(s,t)) /\ (!s t. convex t ==> setdist(s,relative_interior t) = setdist(s,t))`, MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; SETDIST_CLOSURE]);; let HAUSDIST_RELATIVE_INTERIOR = prove (`(!s t. convex s ==> hausdist(relative_interior s,t) = hausdist(s,t)) /\ (!s t. convex t ==> hausdist(s,relative_interior t) = hausdist(s,t))`, MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; HAUSDIST_CLOSURE]);; let AFFINE_HULL_RELATIVE_INTERIOR = prove (`!s. convex s ==> affine hull (relative_interior s) = affine hull s`, MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; AFFINE_HULL_CLOSURE]);; let AFF_DIM_RELATIVE_INTERIOR = prove (`!s:real^N->bool. convex s ==> aff_dim(relative_interior s) = aff_dim s`, ASM_MESON_TAC[AFF_DIM_AFFINE_HULL; AFFINE_HULL_RELATIVE_INTERIOR]);; let CONVEX_RELATIVE_INTERIOR_CLOSURE = prove (`!s:real^N->bool. convex s ==> relative_interior(closure s) = relative_interior s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CLOSURE_EMPTY; RELATIVE_INTERIOR_EMPTY] THEN SUBGOAL_THEN `?a:real^N. a IN relative_interior s` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[MEMBER_NOT_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[IN_RELATIVE_INTERIOR; AFFINE_HULL_CLOSURE; SUBSET] THEN MESON_TAC[CLOSURE_SUBSET; SUBSET]] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN MP_TAC(ASSUME `(b:real^N) IN relative_interior(closure s)`) THEN GEN_REWRITE_TAC LAND_CONV [IN_RELATIVE_INTERIOR_CBALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_INTER; LEFT_IMP_EXISTS_THM; AFFINE_HULL_CLOSURE] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `b + e / norm(b - a) % (b - a):real^N`) THEN ASM_SIMP_TAC[NORM_ARITH `dist(b:real^N,b + e) = norm e`; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ; REAL_ARITH `&0 < e ==> abs e <= e`] THEN ANTS_TAC THENL [MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_MESON_TAC[SUBSET; AFFINE_AFFINE_HULL; RELATIVE_INTERIOR_SUBSET; CLOSURE_SUBSET_AFFINE_HULL; HULL_INC]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `b = (b + e / norm(b - a) % (b - a)) - e / norm(b - a) / (&1 + e / norm(b - a)) % ((b + e / norm(b - a) % (b - a)) - a):real^N` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_ARITH `b = (b + e % (b - a)) - d % ((b + e % (b - a)) - a) <=> (e - d * (&1 + e)) % (b - a) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0]; MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; REAL_ARITH `&0 < x ==> &0 < &1 + x`; REAL_ARITH `&0 < x ==> ~(&1 + x = &0)`; REAL_MUL_LID; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LE_ADDL; NORM_POS_LE; REAL_SUB_REFL]);; let RELATIVE_FRONTIER_CLOSURE = prove (`!s. convex s ==> relative_frontier(closure s) = relative_frontier s`, SIMP_TAC[relative_frontier; CLOSURE_CLOSURE; CONVEX_RELATIVE_INTERIOR_CLOSURE]);; let RELATIVE_FRONTIER_RELATIVE_INTERIOR = prove (`!s:real^N->bool. convex s ==> relative_frontier(relative_interior s) = relative_frontier s`, ASM_MESON_TAC[RELATIVE_FRONTIER_CLOSURE; CONVEX_CLOSURE_RELATIVE_INTERIOR; CONVEX_RELATIVE_INTERIOR]);; let CONNECTED_INTER_RELATIVE_FRONTIER = prove (`!s t:real^N->bool. connected s /\ s SUBSET affine hull t /\ ~(s INTER t = {}) /\ ~(s DIFF t = {}) ==> ~(s INTER relative_frontier t = {})`, REWRITE_TAC[relative_frontier] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`s INTER relative_interior t:real^N->bool`; `s DIFF closure t:real^N->bool`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `affine hull t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; OPEN_IN_SUBTOPOLOGY_REFL] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]; ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]; ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `i SUBSET t /\ t SUBSET c ==> (s INTER i) INTER (s DIFF c) = {}`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET; CLOSURE_SUBSET]; MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]]);; let CLOSED_RELATIVE_FRONTIER = prove (`!s:real^N->bool. closed(relative_frontier s)`, REPEAT GEN_TAC THEN REWRITE_TAC[relative_frontier] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `affine hull s:real^N->bool` THEN REWRITE_TAC[CLOSED_AFFINE_HULL] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure t /\ closure t = t ==> s SUBSET t`) THEN SIMP_TAC[SUBSET_CLOSURE; HULL_SUBSET; CLOSURE_EQ; CLOSED_AFFINE_HULL]);; let CLOSED_RELATIVE_BOUNDARY = prove (`!s. closed s ==> closed(s DIFF relative_interior s)`, MESON_TAC[CLOSED_RELATIVE_FRONTIER; relative_frontier; CLOSURE_CLOSED]);; let COMPACT_RELATIVE_BOUNDARY = prove (`!s. compact s ==> compact(s DIFF relative_interior s)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_RELATIVE_BOUNDARY; BOUNDED_DIFF]);; let BOUNDED_RELATIVE_FRONTIER = prove (`!s:real^N->bool. bounded s ==> bounded(relative_frontier s)`, REWRITE_TAC[relative_frontier] THEN MESON_TAC[BOUNDED_CLOSURE; BOUNDED_SUBSET; SUBSET_DIFF]);; let COMPACT_RELATIVE_FRONTIER_BOUNDED = prove (`!s:real^N->bool. bounded s ==> compact(relative_frontier s)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_RELATIVE_FRONTIER; BOUNDED_RELATIVE_FRONTIER]);; let COMPACT_RELATIVE_FRONTIER = prove (`!s:real^N->bool. compact s ==> compact(relative_frontier s)`, SIMP_TAC[COMPACT_RELATIVE_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);; let CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE = prove (`!s t. convex s /\ convex t ==> (relative_interior s = relative_interior t <=> closure s = closure t)`, MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; CONVEX_RELATIVE_INTERIOR_CLOSURE]);; let CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE = prove (`!s t. convex s /\ convex t ==> (relative_interior s = relative_interior t <=> relative_interior s SUBSET t /\ t SUBSET closure s)`, MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; CONVEX_RELATIVE_INTERIOR_CLOSURE; SUBSET_CLOSURE; SUBSET_ANTISYM; RELATIVE_INTERIOR_SUBSET; CLOSURE_SUBSET; CLOSURE_CLOSURE]);; let RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX = prove (`!f:real^M->real^N s. linear f /\ convex s ==> relative_interior(IMAGE f s) = IMAGE f (relative_interior s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [SUBGOAL_THEN `relative_interior (IMAGE f (relative_interior s)) = relative_interior (IMAGE (f:real^M->real^N) s)` (fun th -> REWRITE_TAC[SYM th; RELATIVE_INTERIOR_SUBSET]) THEN ASM_SIMP_TAC[CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE; CONVEX_RELATIVE_INTERIOR; CONVEX_LINEAR_IMAGE] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (relative_interior s)` THEN SIMP_TAC[RELATIVE_INTERIOR_SUBSET; IMAGE_SUBSET]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (closure(relative_interior s))` THEN ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN ASM_SIMP_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_CONVEX_PROLONG; CONVEX_LINEAR_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `z:real^M`; `x:real^M`] RELATIVE_INTERIOR_PROLONG) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP FUN_IN_IMAGE) THEN ASM_MESON_TAC[LINEAR_ADD; LINEAR_SUB; LINEAR_CMUL]]);; let RELATIVE_INTERIOR_LINEAR_PREIMAGE_CONVEX = prove (`!f:real^M->real^N s. linear f /\ convex s /\ ~({x | f(x) IN relative_interior s} = {}) ==> relative_interior {x | f(x) IN s} = {x | f(x) IN relative_interior s}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `IMAGE f s SUBSET t ==> s SUBSET {x | f x IN t}`) THEN ASM_SIMP_TAC[GSYM RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; CONVEX_LINEAR_PREIMAGE; CONVEX_RELATIVE_INTERIOR] THEN MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR_INTERSECTING_CONVEX THEN ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_LINEAR_PREIMAGE] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]; MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `{x | (f:real^M->real^N) x IN affine hull s}` THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `{x | f x IN relative_interior s} = {x | x IN {x | (f:real^M->real^N) x IN affine hull s} /\ f x IN relative_interior s}` SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(SET_RULE `relative_interior s SUBSET s /\ s SUBSET affine hull s ==> {x | f x IN relative_interior s} = {x | f x IN affine hull s /\ f x IN relative_interior s}`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET]; MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `affine hull s:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_RELATIVE_INTERIOR; LINEAR_CONTINUOUS_ON] THEN SET_TAC[]]; REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[AFFINE_LINEAR_PREIMAGE; AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> {x | f x IN s} SUBSET {x | f x IN t}`) THEN REWRITE_TAC[HULL_SUBSET]]]]);; let RELATIVE_INTERIOR_SUMS = prove (`!s t:real^N->bool. convex s /\ convex t ==> relative_interior {x + y | x IN s /\ y IN t} = {x + y | x IN relative_interior s /\ y IN relative_interior t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!s t. {x + y:real^N | x IN s /\ y IN t} = IMAGE (\z. fstcart z + sndcart z) (s PCROSS t)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN MESON_TAC[]; ASM_SIMP_TAC[RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; CONVEX_PCROSS; LINEAR_COMPOSE_ADD; LINEAR_FSTCART; LINEAR_SNDCART] THEN REWRITE_TAC[RELATIVE_INTERIOR_PCROSS]]);; let CLOSURE_INTERS_CONVEX = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> convex s) /\ ~(INTERS(IMAGE relative_interior f) = {}) ==> closure(INTERS f) = INTERS(IMAGE closure f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_INTERS_SUBSET] THEN REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[DIST_REFL; IN_INTERS] THEN ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN EXISTS_TAC `b - min (&1 / &2) (e / &2 / norm(b - a)) % (b - a):real^N` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[NORM_ARITH `dist(b - a:real^N,b) = norm a`; NORM_MUL] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 < x /\ x < y ==> abs(min a x) < y`) THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[IN_INTERS] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC (MESON[RELATIVE_INTERIOR_SUBSET; SUBSET] `!x. x IN relative_interior s ==> x IN s`) THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC);; let CLOSURE_INTERS_CONVEX_OPEN = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> convex s /\ open s) ==> closure(INTERS f) = if INTERS f = {} then {} else INTERS(IMAGE closure f)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CLOSURE_EMPTY] THEN MATCH_MP_TAC CLOSURE_INTERS_CONVEX THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(s = {}) ==> s = t ==> ~(t = {})`)) THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = x) ==> s = IMAGE f s`) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_OPEN; INTERIOR_EQ]);; let CLOSURE_INTER_CONVEX = prove (`!s t:real^N->bool. convex s /\ convex t /\ ~(relative_interior s INTER relative_interior t = {}) ==> closure(s INTER t) = closure(s) INTER closure(t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{s:real^N->bool,t}` CLOSURE_INTERS_CONVEX) THEN ASM_SIMP_TAC[IMAGE_CLAUSES; INTERS_2] THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let CLOSURE_INTER_CONVEX_OPEN = prove (`!s t. convex s /\ open s /\ convex t /\ open t ==> closure(s INTER t) = if s INTER t = {} then {} else closure(s) INTER closure(t)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CLOSURE_EMPTY] THEN MATCH_MP_TAC CLOSURE_INTER_CONVEX THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_OPEN]);; let CLOSURE_CONVEX_INTER_SUPERSET = prove (`!s t:real^N->bool. convex s /\ ~(interior s = {}) /\ interior s SUBSET closure t ==> closure(s INTER t) = closure s`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET; SUBSET_INTER] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure(interior s):real^N->bool` THEN CONJ_TAC THENL [ASM_SIMP_TAC[CONVEX_CLOSURE_INTERIOR; SUBSET_REFL]; ASM_SIMP_TAC[GSYM CLOSURE_OPEN_INTER_SUPERSET; OPEN_INTERIOR] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN SET_TAC[]]);; let CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET = prove (`!s:real^N->bool. convex s /\ ~(interior s = {}) ==> closure(s INTER { inv(&2 pow n) % x | n,x | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_CONVEX_INTER_SUPERSET THEN ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; let CLOSURE_RATIONALS_IN_CONVEX_SET = prove (`!s:real^N->bool. convex s /\ ~(interior s = {}) ==> closure(s INTER { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_CONVEX_INTER_SUPERSET THEN ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; SUBSET_UNIV]);; let RELATIVE_INTERIOR_CONVEX_INTER_AFFINE = prove (`!s t:real^N->bool. convex s /\ affine t /\ ~(interior s INTER t = {}) ==> relative_interior(s INTER t) = interior s INTER t`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_INTER] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `(vec 0:real^N) IN t` THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`] (ONCE_REWRITE_RULE[INTER_COMM] AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR)) THEN ASM_SIMP_TAC[SUBSPACE_IMP_AFFINE; IN_RELATIVE_INTERIOR_CBALL] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTER; IN_INTERIOR_CBALL]] THEN DISCH_THEN SUBST1_TAC THEN ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_INTER] THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE]] THEN EQ_TAC THENL [REWRITE_TAC[IN_CBALL]; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN ASM_REWRITE_TAC[SUBSET; IN_CBALL]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `(&1 + e / norm x) % x:real^N`] IN_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SUBSPACE_MUL] THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID; NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SUBSET; IN_INTERIOR_CBALL; IN_CBALL] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_SEGMENT] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `inv(&1 + e / norm(x:real^N))` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_DIV; NORM_POS_LT; VECTOR_MUL_LID; REAL_LT_INV_EQ; REAL_MUL_LINV; REAL_INV_LT_1; REAL_ARITH `&0 < x ==> &1 < &1 + x /\ &0 < &1 + x /\ ~(&1 + x = &0)`]]);; let CONNECTED_WITH_RELATIVE_INTERIOR_OPEN_IN_CONVEX = prove (`!c s:real^N->bool. convex c /\ connected s /\ open_in (subtopology euclidean c) s ==> connected(relative_interior c INTER s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`closure(relative_interior c INTER u):real^N->bool`; `closure(relative_interior c INTER v):real^N->bool`] THEN REWRITE_TAC[CLOSED_CLOSURE] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM CLOSURE_UNION] THEN TRANS_TAC SUBSET_TRANS `closure(relative_interior c INTER s):real^N->bool` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[INTER_COMM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `relative_interior c:real^N->bool`; `c:real^N->bool`] CLOSURE_OPEN_IN_INTER_CLOSURE) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN ASM_SIMP_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN TRANS_TAC SUBSET_TRANS `closure s:real^N->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MP_TAC(ISPEC `c:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]; MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]]; ALL_TAC; MP_TAC(ISPEC`relative_interior c INTER u:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; MP_TAC(ISPEC`relative_interior c INTER v:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN SUBGOAL_THEN `connected(ball(x:real^N,r) INTER relative_interior c)` MP_TAC THENL [ASM_SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTER; CONVEX_BALL; CONVEX_RELATIVE_INTERIOR]; REWRITE_TAC[connected]] THEN MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MP_TAC(ISPEC `c:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]] THEN ONCE_REWRITE_TAC[SET_RULE `u INTER b INTER i = b INTER u INTER i`] THEN MP_TAC(ISPEC `ball(x:real^N,r)` OPEN_INTER_CLOSURE_EQ_EMPTY) THEN REWRITE_TAC[OPEN_BALL] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Lemmas about extending nondecreasing functions. *) (* ------------------------------------------------------------------------- *) let NONDECREASING_EXTENDS_TO_CONVEX_HULL = prove (`!f s. (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> ?g. (!x y. x IN convex hull s /\ y IN convex hull s /\ drop x <= drop y ==> drop(g x) <= drop(g y)) /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. lift(sup {drop(f u) | u IN s /\ drop u <= drop x})` THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `(x:real^1) IN convex hull s` THEN REWRITE_TAC[IN_CONVEX_HULL_INTERVAL_1; IN_INTERVAL_1] THEN MESON_TAC[]; MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_TRANS]; UNDISCH_TAC `(y:real^1) IN convex hull s` THEN REWRITE_TAC[IN_CONVEX_HULL_INTERVAL_1; IN_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN MATCH_MP_TAC SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]]);; let NONDECREASING_EXTENDS_FROM_DENSE = prove (`!f s. closure s = (:real^1) /\ closure(IMAGE f s) = (:real^1) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> ?g. (!x y. drop x <= drop y ==> drop(g x) <= drop(g y)) /\ (!x. x IN s ==> g x = f x) /\ g continuous_on (:real^1) /\ IMAGE g (:real^1) = (:real^1)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`] NONDECREASING_EXTENDS_TO_CONVEX_HULL) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^1` THEN MP_TAC(ISPEC `s:real^1->bool` CONVEX_HULL_CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[CONVEX_HULL_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN SIMP_TAC[CONVEX_INTERIOR_CLOSURE; CONVEX_CONVEX_HULL] THEN SIMP_TAC[INTERIOR_UNIV; OPEN_UNIV; INTERIOR_MAXIMAL_EQ] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE `UNIV SUBSET s ==> s = UNIV`)) THEN ASM_REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_UNIV; continuous_at] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `closure(IMAGE (f:real^1->real^1) s) = UNIV` THEN REWRITE_TAC[EXTENSION; IN_UNIV; EXISTS_IN_IMAGE; CLOSURE_APPROACHABLE] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `g(x:real^1) + lift(e / &2)` th) THEN MP_TAC(SPEC `g(x:real^1) - lift(e / &2)` th)) THEN SIMP_TAC[DIST_1; DROP_ADD; DROP_SUB; LIFT_DROP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^1` THEN STRIP_TAC THEN X_GEN_TAC `b:real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `(f:real^1->real^1) a = g a /\ f b = g b` (CONJUNCTS_THEN SUBST_ALL_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `drop a < drop x /\ drop x < drop b` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_NOT_LE] THEN CONJ_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `min (drop x - drop a) (drop b - drop x)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `drop((g:real^1->real^1) a) <= drop(g y) /\ drop(g y) <= drop(g b)` MP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; DISCH_THEN(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONNECTED_CONTINUOUS_IMAGE)) THEN REWRITE_TAC[GSYM CONVEX_CONNECTED_1; CONVEX_UNIV] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `interior(closure s) SUBSET s /\ UNIV SUBSET interior(closure s) ==> s = UNIV`) THEN SIMP_TAC[INTERIOR_MAXIMAL_EQ; OPEN_UNIV] THEN ASM_SIMP_TAC[CONVEX_INTERIOR_CLOSURE; INTERIOR_SUBSET] THEN TRANS_TAC SUBSET_TRANS `closure(IMAGE (f:real^1->real^1) s)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUBSET_CLOSURE] THEN ASM SET_TAC[]]);; let INCREASING_EXTENDS_FROM_DENSE = prove (`!f s. closure s = (:real^1) /\ closure(IMAGE f s) = (:real^1) /\ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> drop(f x) < drop(f y)) ==> ?g. (!x y. drop(g x) < drop(g y) <=> drop x < drop y) /\ (!x. x IN s ==> g x = f x) /\ g continuous_on (:real^1) /\ IMAGE g (:real^1) = (:real^1)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`] NONDECREASING_EXTENDS_FROM_DENSE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LE_LT; DROP_EQ]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN EQ_TAC THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE; CONTRAPOS_THM] THEN REWRITE_TAC[GSYM REAL_NOT_LT; CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE; REAL_LT_IMP_LE] THEN UNDISCH_TAC `closure s = (:real^1)` THEN REWRITE_TAC[EXTENSION; IN_UNIV; CLOSURE_APPROACHABLE] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `dist(x:real^1,y) / &4`) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `y - inv(&4) % (y - x):real^1` th) THEN MP_TAC(SPEC `x + inv(&4) % (y - x):real^1` th)) THEN ASM_SIMP_TAC[GSYM DIST_NZ; GSYM DROP_EQ; REAL_LT_IMP_NE; REAL_ARITH `&0 < x / &4 <=> &0 < x`] THEN SIMP_TAC[DIST_1; DROP_SUB; DROP_ADD; LIFT_DROP; DROP_CMUL] THEN DISCH_THEN(X_CHOOSE_THEN `x':real^1` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `y':real^1` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `drop(g x) <= drop(g(x':real^1)) /\ drop(g x') < drop(g y') /\ drop(g y') <= drop(g y)` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* More basics about segments. *) (* ------------------------------------------------------------------------- *) let BOUNDED_SEGMENT = prove (`(!a b:real^N. bounded(segment[a,b])) /\ (!a b:real^N. bounded(segment(a,b)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[BOUNDED_SUBSET] `bounded s /\ t SUBSET s ==> bounded s /\ bounded t`) THEN REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN SIMP_TAC[COMPACT_INSERT; COMPACT_EMPTY]);; let SEGMENT_IMAGE_INTERVAL = prove (`(!a b. segment[a,b] = IMAGE (\u. (&1 - drop u) % a + drop u % b) (interval[vec 0,vec 1])) /\ (!a b. ~(a = b) ==> segment(a,b) = IMAGE (\u. (&1 - drop u) % a + drop u % b) (interval(vec 0,vec 1)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_SEGMENT] THEN ASM_REWRITE_TAC[GSYM EXISTS_DROP; DROP_VEC] THEN MESON_TAC[]);; let CLOSURE_SEGMENT = prove (`(!a b:real^N. closure(segment[a,b]) = segment[a,b]) /\ (!a b:real^N. closure(segment(a,b)) = if a = b then {} else segment[a,b])`, REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CLOSURE_EQ; COMPACT_IMP_CLOSED; SEGMENT_CONVEX_HULL; COMPACT_CONVEX_HULL; COMPACT_INSERT; COMPACT_EMPTY]; ALL_TAC] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL; CLOSURE_EMPTY] THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THEN ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL CLOSURE_OPEN_INTERVAL); INTERVAL_EQ_EMPTY_1; DROP_VEC; REAL_ARITH `~(&1 <= &0)`] THEN SUBGOAL_THEN `(\u. (&1 - drop u) % a + drop u % (b:real^N)) = (\x. a + x) o (\u. drop u % (b - a))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMAGE_o; CLOSURE_TRANSLATION] THEN AP_TERM_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_SUB_EQ; DROP_EQ] THEN REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; let CLOSED_SEGMENT = prove (`(!a b:real^N. closed(segment[a,b])) /\ (!a b:real^N. closed(segment(a,b)) <=> a = b)`, REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL] THEN MESON_TAC[ENDS_NOT_IN_SEGMENT; ENDS_IN_SEGMENT]);; let COMPACT_SEGMENT = prove (`(!a b:real^N. compact(segment[a,b])) /\ (!a b:real^N. compact(segment(a,b)) <=> a = b)`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_SEGMENT; BOUNDED_SEGMENT]);; let AFFINE_HULL_SEGMENT = prove (`(!a b:real^N. affine hull (segment [a,b]) = affine hull {a,b}) /\ (!a b:real^N. affine hull (segment(a,b)) = if a = b then {} else affine hull {a,b})`, REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM AFFINE_HULL_CLOSURE] THEN REWRITE_TAC[CLOSURE_SEGMENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL]);; let SEGMENT_AS_BALL = prove (`(!a b. segment[a:real^N,b] = affine hull {a,b} INTER cball(inv(&2) % (a + b),norm(b - a) / &2)) /\ (!a b. segment(a:real^N,b) = affine hull {a,b} INTER ball(inv(&2) % (a + b),norm(b - a) / &2))`, REPEAT STRIP_TAC THEN (ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[SEGMENT_REFL; VECTOR_SUB_REFL; NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[BALL_TRIVIAL; CBALL_TRIVIAL] THENL [REWRITE_TAC[INTER_EMPTY; INSERT_AC] THEN REWRITE_TAC[VECTOR_ARITH `&1 / &2 % (a + a) = a`] THEN REWRITE_TAC[SET_RULE `a = b INTER a <=> a SUBSET b`; HULL_SUBSET]; ASM_REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_INTER; AFFINE_HULL_2] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `u + v:real = &1 <=> u = &1 - v`] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `y:real^N = (&1 - u) % a + u % b` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_BALL; IN_CBALL; dist; VECTOR_ARITH `&1 / &2 % (a + b) - ((&1 - u) % a + u % b):real^N = (&1 / &2 - u) % (b - a)`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_LT_MUL_EQ; REAL_LE_MUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ; REAL_ARITH `a * n < n / &2 <=> &0 < n * (inv(&2) - a)`; REAL_ARITH `a * n <= n / &2 <=> &0 <= n * (inv(&2) - a)`] THEN REAL_ARITH_TAC]));; let CONVEX_SEGMENT = prove (`(!a b. convex(segment[a,b])) /\ (!a b. convex(segment(a,b)))`, REWRITE_TAC[SEGMENT_AS_BALL] THEN SIMP_TAC[CONVEX_INTER; CONVEX_BALL; CONVEX_CBALL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);; let RELATIVE_INTERIOR_SEGMENT = prove (`(!a b:real^N. relative_interior(segment[a,b]) = if a = b then {a} else segment(a,b)) /\ (!a b:real^N. relative_interior(segment(a,b)) = segment(a,b))`, MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_EMPTY] THEN REWRITE_TAC[RELATIVE_INTERIOR_EQ; OPEN_IN_OPEN] THEN ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN EXISTS_TAC `ball(inv(&2) % (a + b):real^N,norm(b - a) / &2)` THEN REWRITE_TAC[OPEN_BALL; SEGMENT_AS_BALL]; REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_SING] THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 CLOSURE_SEGMENT)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC CONVEX_RELATIVE_INTERIOR_CLOSURE THEN REWRITE_TAC[CONVEX_SEGMENT]]);; let OPEN_IN_SEGMENT = prove (`!s a b:real^N. segment(a,b) SUBSET s /\ s SUBSET affine hull (segment(a,b)) ==> open_in (subtopology euclidean s) (segment(a,b))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `affine hull (segment(a:real^N,b))` THEN ASM_MESON_TAC[OPEN_IN_RELATIVE_INTERIOR; RELATIVE_INTERIOR_SEGMENT]);; let AFF_DIM_SEGMENT = prove (`(!a b:real^N. aff_dim(segment[a,b]) = if a = b then &0 else &1) /\ (!a b:real^N. aff_dim(segment(a,b)) = if a = b then -- &1 else &1)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL; AFF_DIM_EMPTY; AFF_DIM_SING] THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT1 RELATIVE_INTERIOR_SEGMENT)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SIMP_TAC[AFF_DIM_RELATIVE_INTERIOR; CONVEX_SEGMENT] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL; SEGMENT_CONVEX_HULL] THEN ASM_REWRITE_TAC[AFF_DIM_2]);; let CONVEX_SEMIOPEN_SEGMENT = prove (`(!a b:real^N. convex(segment[a,b] DELETE a)) /\ (!a b:real^N. convex(segment[a,b] DELETE b))`, MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_SIMP_TAC[SEGMENT_REFL; SET_RULE `{a} DELETE a = {}`; CONVEX_EMPTY] THEN REWRITE_TAC[CONVEX_ALT; IN_DELETE] THEN SIMP_TAC[REWRITE_RULE[CONVEX_ALT] CONVEX_SEGMENT] THEN REWRITE_TAC[IN_SEGMENT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_ASSOC] THEN ASM_REWRITE_TAC[VECTOR_ARITH `x % a + y % b + z % a + w % b:real^N = a <=> (&1 - x - z) % a = (w + y) % b`] THEN ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_ARITH `&1 - (&1 - u) * (&1 - v) - u * (&1 - w) = u * w + (&1 - u) * v`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN REWRITE_TAC[REAL_ENTIRE; REAL_ARITH `&1 - x = &0 <=> x = &1`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(u = &0 \/ w = &0) /\ (u = &1 \/ v = &0) ==> u = &0 /\ v = &0 \/ u = &1 /\ w = &0 \/ v = &0 /\ w = &0`)) THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN ASM_MESON_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);; let CONNECTED_SEMIOPEN_SEGMENT = prove (`(!a b:real^N. connected(segment[a,b] DELETE a)) /\ (!a b:real^N. connected(segment[a,b] DELETE b))`, SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);; let SEGMENT_EQ_EMPTY = prove (`(!a b:real^N. ~(segment[a,b] = {})) /\ (!a b:real^N. segment(a,b) = {} <=> a = b)`, REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL] THEN ASM_MESON_TAC[NOT_IN_EMPTY; MIDPOINT_IN_SEGMENT]);; let FINITE_SEGMENT = prove (`(!a b:real^N. FINITE(segment[a,b]) <=> a = b) /\ (!a b:real^N. FINITE(segment(a,b)) <=> a = b)`, REWRITE_TAC[open_segment; SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; FINITE_SING] THEN REWRITE_TAC[SEGMENT_IMAGE_INTERVAL] THEN W(MP_TAC o PART_MATCH (lhs o rand) FINITE_IMAGE_INJ_EQ o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % b:real^N = (&1 - v) % a + v % b <=> (u - v) % (b - a) = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0; DROP_EQ]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FINITE_INTERVAL_1] THEN REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC]);; let SEGMENT_EQ_SING = prove (`(!a b c:real^N. segment[a,b] = {c} <=> a = c /\ b = c) /\ (!a b c:real^N. ~(segment(a,b) = {c}))`, REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_SING] THEN CONJ_TAC THENL [SET_TAC[]; REPEAT GEN_TAC] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; NOT_INSERT_EMPTY] THEN DISCH_TAC THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 FINITE_SEGMENT)) THEN ASM_REWRITE_TAC[FINITE_SING]);; let SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX_GEN = prove (`!s a b c:real^N. convex s /\ collinear{a,b,c} /\ ~(a = b) /\ ~(a = c) /\ ~(b = c) /\ {a,b,c} SUBSET relative_frontier s ==> convex hull {a,b,c} SUBSET relative_frontier s`, REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX) THENL [DISCH_THEN(MP_TAC o SPECL [`b:real^N`; `c:real^N`; `a:real^N`]); DISCH_THEN(MP_TAC o SPECL [`c:real^N`; `a:real^N`; `b:real^N`]); DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `c:real^N`])] THEN REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT] THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_SEGMENT] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_SEGMENT] THEN ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT]);; let SUBSET_SEGMENT_OPEN_CLOSED = prove (`!a b c d:real^N. segment(a,b) SUBSET segment(c,d) <=> a = b \/ segment[a,b] SUBSET segment[c,d]`, REPEAT GEN_TAC THEN EQ_TAC THENL [ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN ASM_REWRITE_TAC[CLOSURE_SEGMENT] THEN COND_CASES_TAC THEN REWRITE_TAC[SUBSET_EMPTY; SEGMENT_EQ_EMPTY]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN REWRITE_TAC[SEGMENT_REFL; EMPTY_SUBSET] THEN ABBREV_TAC `m:real^N = d - c` THEN POP_ASSUM MP_TAC THEN GEOM_NORMALIZE_TAC `m:real^N` THEN SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; SEGMENT_EQ_SING; SEGMENT_EQ_EMPTY; SET_RULE `s SUBSET {a} <=> s = {a} \/ s = {}`; SUBSET_REFL] THEN X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `c:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `d:real^N` THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN SUBGOAL_THEN `collinear{vec 0:real^N,&1 % basis 1,x} /\ collinear{vec 0:real^N,&1 % basis 1,y}` MP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN CONJ_TAC THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT]; ALL_TAC] THEN SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; VECTOR_ARITH `&1 % x:real^N = vec 0 <=> x = vec 0`] THEN REWRITE_TAC[IMP_CONJ; VECTOR_MUL_ASSOC; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real` THEN REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN X_GEN_TAC `b:real` THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; SET_RULE `(!x y. x % v = y % v <=> x = y) ==> ({x % v | P x} SUBSET {x % v | Q x} <=> {x | P x} SUBSET {x | Q x})`] THEN REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=> min a b <= x /\ x <= max a b`; REAL_ARITH `a < x /\ x < b \/ b < x /\ x < a <=> min a b < x /\ x < max a b`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th) [`min (a:real) b`; `max (a:real) b`]) THEN REAL_ARITH_TAC);; let SUBSET_SEGMENT = prove (`(!a b c d:real^N. segment[a,b] SUBSET segment[c,d] <=> a IN segment[c,d] /\ b IN segment[c,d]) /\ (!a b c d:real^N. segment[a,b] SUBSET segment(c,d) <=> a IN segment(c,d) /\ b IN segment(c,d)) /\ (!a b c d:real^N. segment(a,b) SUBSET segment[c,d] <=> a = b \/ a IN segment[c,d] /\ b IN segment[c,d]) /\ (!a b c d:real^N. segment(a,b) SUBSET segment(c,d) <=> a = b \/ a IN segment[c,d] /\ b IN segment[c,d])`, MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SEGMENT_CONVEX_HULL] THEN SIMP_TAC[SUBSET_HULL; CONVEX_SEGMENT] THEN SET_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_SEGMENT_OPEN_CLOSED] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `closure(segment(a:real^N,b)) SUBSET segment[c,d]` THEN CONJ_TAC THENL [SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[CLOSURE_SEGMENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_SUBSET]]);; let INTERIOR_SEGMENT = prove (`(!a b:real^N. interior(segment[a,b]) = if 2 <= dimindex(:N) then {} else segment(a,b)) /\ (!a b:real^N. interior(segment(a,b)) = if 2 <= dimindex(:N) then {} else segment(a,b))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ s = {} ==> s = {} /\ t = {}`) THEN SIMP_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SUBSET_INTERIOR] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC EMPTY_INTERIOR_CONVEX_HULL THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN FIRST_ASSUM (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS)) THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC; ASM_CASES_TAC `a:real^N = b` THEN ASM_SIMP_TAC[SEGMENT_REFL; INTERIOR_EMPTY; EMPTY_INTERIOR_FINITE; FINITE_SING] THEN SUBGOAL_THEN `affine hull (segment[a,b]) = (:real^N) /\ affine hull (segment(a,b)) = (:real^N)` (fun th -> ASM_SIMP_TAC[th; GSYM RELATIVE_INTERIOR_INTERIOR; RELATIVE_INTERIOR_SEGMENT]) THEN ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_GT THEN REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN ASM_ARITH_TAC]);; let FRONTIER_SEGMENT = prove (`(!a b:real^N. frontier(segment[a,b]) = if 2 <= dimindex(:N) then segment[a,b] else {a,b}) /\ (!a b:real^N. frontier(segment(a,b)) = if a = b then {} else if 2 <= dimindex(:N) then segment[a,b] else {a,b})`, REPEAT GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_SEGMENT; CLOSURE_SEGMENT] THEN ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[DIFF_EMPTY] THEN SIMP_TAC[SEGMENT_REFL] THEN REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL; DIFF_EMPTY]) THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_NOT_IN_SEGMENT) THEN SET_TAC[]);; let SEGMENT_EQ = prove (`(!a b c d:real^N. segment[a,b] = segment[c,d] <=> {a,b} = {c,d}) /\ (!a b c d:real^N. ~(segment[a,b] = segment(c,d))) /\ (!a b c d:real^N. ~(segment(a,b) = segment[c,d])) /\ (!a b c d:real^N. segment(a,b) = segment(c,d) <=> a = b /\ c = d \/ {a,b} = {c,d})`, MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(AP_TERM `\s:real^N->bool. s DIFF relative_interior s` th)) THEN REWRITE_TAC[RELATIVE_INTERIOR_SEGMENT] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL]) THEN SIMP_TAC[ENDS_IN_SEGMENT; open_segment; SET_RULE `a IN s /\ b IN s ==> s DIFF (s DIFF {a,b}) = {a,b}`] THEN ASM SET_TAC[SEGMENT_EQ_SING]; SIMP_TAC[SEGMENT_CONVEX_HULL]]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `closed:(real^N->bool)->bool`) THEN REWRITE_TAC[CONJUNCT1 CLOSED_SEGMENT] THEN REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[SEGMENT_EQ_EMPTY]; REWRITE_TAC[open_segment; ENDS_IN_SEGMENT; SET_RULE `s = s DIFF {a,b} <=> ~(a IN s) /\ ~(b IN s)`]]; DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = d` THEN ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL [ASM SET_TAC[]; ALL_TAC] THEN CONV_TAC(BINOP_CONV SYM_CONV)THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_SEGMENT_OPEN_CLOSED] THEN ASM_REWRITE_TAC[SUBSET_ANTISYM_EQ]]);; let COLLINEAR_SEGMENT = prove (`(!a b:real^N. collinear(segment[a,b])) /\ (!a b:real^N. collinear(segment(a,b)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COLLINEAR_SUBSET) THEN REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED]]);; let INTER_SEGMENT = prove (`!a b c:real^N. b IN segment[a,c] \/ ~collinear{a,b,c} ==> segment[a,b] INTER segment[b,c] = {b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; INTER_IDEMPOT; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN DISCH_TAC THEN MP_TAC(ISPECL [`{a:real^N,c}`; `b:real^N`; `{a:real^N}`; `{c:real^N}`] CONVEX_HULL_EXCHANGE_INTER) THEN ASM_REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INSERT_AC]] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[SET_RULE `~(a = c) ==> {a} INTER {c} = {}`] THEN REWRITE_TAC[CONVEX_HULL_SING]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(s INTER t = {b}) ==> b IN s /\ b IN t ==> ?a. ~(a = b) /\ a IN s /\ b IN s /\ a IN t /\ b IN t`)) THEN ANTS_TAC THENL [REWRITE_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real^N` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `d:real^N` THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);; let CONVEX_LINE_INTERSECTION_UNIQUE_CLOSED = prove (`!s a b:real^N. convex s /\ closed s /\ a IN relative_frontier s /\ b IN relative_frontier s /\ ~(segment(a,b) INTER relative_interior s = {}) ==> s INTER (affine hull {a,b}) = segment[a,b]`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; EMPTY_SUBSET; INTER_EMPTY] THEN STRIP_TAC THEN SUBGOAL_THEN `(a:real^N) IN s /\ (b:real^N) IN s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[RELATIVE_FRONTIER_SUBSET; SUBSET]; ALL_TAC] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER] THEN ASM_SIMP_TAC[SEGMENT_SUBSET_CONVEX] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN REWRITE_TAC[SUBSET; GSYM SEGMENT_CONVEX_HULL; IN_INTER] THEN ASM_SIMP_TAC[GSYM COLLINEAR_3_IN_AFFINE_HULL] THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`c:real^N = a`; `c:real^N = b`] THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_BETWEEN_CASES]) THEN REWRITE_TAC[BETWEEN_IN_SEGMENT; SEGMENT_CLOSED_OPEN] THEN ASM_REWRITE_TAC[IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`; `c:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_SIMP_TAC[CLOSURE_INC] THEN MATCH_MP_TAC(SET_RULE `(?a. ~(a IN t) /\ a IN s) ==> s SUBSET t ==> P`) THENL [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ENDS_NOT_IN_SEGMENT]]) THEN RULE_ASSUM_TAC(REWRITE_RULE [open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; GSYM BETWEEN_IN_SEGMENT]) THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT] THEN ASM_MESON_TAC[BETWEEN_TRANS_2; BETWEEN_SYM]);; let CONVEX_LINE_INTERSECTION_UNIQUE_OPEN = prove (`!s a b:real^N. convex s /\ open s /\ a IN relative_frontier s /\ b IN relative_frontier s /\ ~(segment(a,b) INTER s = {}) ==> s INTER (affine hull {a,b}) = segment(a,b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[SEGMENT_REFL; INTER_EMPTY] THEN STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `a:real^N`; `b:real^N`] CONVEX_LINE_INTERSECTION_UNIQUE_CLOSED) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_CLOSURE; CONVEX_RELATIVE_INTERIOR_CLOSURE; RELATIVE_INTERIOR_OPEN; CONVEX_CLOSURE; CLOSED_CLOSURE] THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `affine hull {a:real^N,b}`] RELATIVE_INTERIOR_CONVEX_INTER_AFFINE) THEN ASM_SIMP_TAC[CONVEX_CLOSURE; AFFINE_AFFINE_HULL] THEN ASM_SIMP_TAC[CONVEX_INTERIOR_CLOSURE; INTERIOR_OPEN] THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR_SEGMENT] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(SET_RULE `~(ab INTER s = {}) ==> ab SUBSET a ==> ~(s INTER a = {})`)) THEN TRANS_TAC SUBSET_TRANS `segment[a:real^N,b]` THEN REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL]);; (* ------------------------------------------------------------------------- *) (* Theorems about strips between bounds on a component. *) (* ------------------------------------------------------------------------- *) let CLOSED_STRIP_COMPONENT_LE = prove (`!a k. closed {x:real^N | abs(x$k) <= a}`, REWRITE_TAC[REAL_ARITH `abs(x) <= a <=> x <= a /\ x >= --a`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE; CLOSED_INTER]);; let OPEN_STRIP_COMPONENT_LT = prove (`!a k. open {x:real^N | abs(x$k) < a}`, REWRITE_TAC[REAL_ARITH `abs(x) < a <=> x < a /\ x > --a`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[OPEN_HALFSPACE_COMPONENT_LT; OPEN_HALFSPACE_COMPONENT_GT; OPEN_INTER]);; let INTERIOR_STRIP_COMPONENT_LE = prove (`!a k. interior {x:real^N | abs(x$k) <= a} = {x | abs(x$k) < a}`, REWRITE_TAC[REAL_ARITH `abs(x) <= a <=> x <= a /\ x >= --a`; REAL_ARITH `abs(x) < a <=> x < a /\ x > --a`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REWRITE_TAC[INTERIOR_INTER; INTERIOR_HALFSPACE_COMPONENT_LE; INTERIOR_HALFSPACE_COMPONENT_GE]);; let CLOSURE_STRIP_COMPONENT_LT = prove (`!a k. closure {x:real^N | abs(x$k) < a} = if a = &0 then {} else {x | abs(x$k) <= a}`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ARITH `~(abs x < &0)`; EMPTY_GSPEC; CLOSURE_EMPTY] THEN ASM_CASES_TAC `a < &0` THEN ASM_SIMP_TAC[REAL_ARITH `a < &0 ==> ~(abs x < a) /\ ~(abs x <= a)`; EMPTY_GSPEC; CLOSURE_EMPTY] THEN REWRITE_TAC[GSYM INTERIOR_STRIP_COMPONENT_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM(MATCH_MP CLOSURE_CLOSED (SPEC_ALL CLOSED_STRIP_COMPONENT_LE))] THEN MATCH_MP_TAC CONVEX_CLOSURE_INTERIOR THEN REWRITE_TAC[CONVEX_STRIP_COMPONENT_LE; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[INTERIOR_STRIP_COMPONENT_LE; IN_ELIM_THM] THEN EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC);; let FRONTIER_STRIP_COMPONENT_LE = prove (`!a k. frontier {x:real^N | abs(x$k) <= a} = {x | abs(x$k) = a}`, SIMP_TAC[frontier; CLOSED_STRIP_COMPONENT_LE; CLOSURE_CLOSED; INTERIOR_STRIP_COMPONENT_LE] THEN REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let FRONTIER_STRIP_COMPONENT_LT = prove (`!a k. frontier {x:real^N | abs(x$k) < a} = if a = &0 then {} else {x | abs(x$k) = a}`, SIMP_TAC[frontier; OPEN_STRIP_COMPONENT_LT; INTERIOR_OPEN; CLOSURE_STRIP_COMPONENT_LT] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_DIFF] THEN REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Lower-dimensional affine subsets are nowhere dense. *) (* ------------------------------------------------------------------------- *) let DENSE_COMPLEMENT_SUBSPACE = prove (`!s t:real^N->bool. dim t < dim s /\ subspace s ==> closure(s DIFF t) = s`, SUBGOAL_THEN `!s t:real^N->bool. dim t < dim s /\ subspace s /\ t SUBSET s ==> closure(s DIFF t) = s` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s INTER t:real^N->bool`) THEN ASM_REWRITE_TAC[SET_RULE `s DIFF (s INTER t) = s DIFF t`] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[INTER_SUBSET] THEN TRANS_TAC LET_TRANS `dim(t:real^N->bool)` THEN ASM_SIMP_TAC[DIM_SUBSET; INTER_SUBSET]] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`] ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN) THEN ASM_SIMP_TAC[PSUBSET; SPAN_MONO] THEN ANTS_TAC THENL [ASM_MESON_TAC[LT_REFL; DIM_SPAN]; ASM_SIMP_TAC[SPAN_OF_SUBSPACE]] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[CLOSED_SUBSPACE] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_DIFF; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN t` THENL [ALL_TAC; EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[DIST_REFL]] THEN EXISTS_TAC `x + e / &2 / norm(a) % a:real^N` THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(x + e / &2 / norm(a) % a) + -- &1 % x:real^N`) THEN ASM_SIMP_TAC[NOT_IMP; SPAN_ADD; SPAN_MUL; SPAN_SUPERSET] THEN REWRITE_TAC[VECTOR_ARITH `(x + a) + -- &1 % x:real^N = a`] THEN ASM_REWRITE_TAC[ORTHOGONAL_MUL; ORTHOGONAL_REFL; REAL_DIV_EQ_0; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[NORM_ARITH `dist(x + a:real^N,x) = norm a`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC]);; let DENSE_COMPLEMENT_AFFINE = prove (`!s t:real^N->bool. aff_dim t < aff_dim s /\ affine s ==> closure(s DIFF t) = s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL [REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `closure s:real^N->bool` THEN CONJ_TAC THENL [AP_TERM_TAC THEN ASM SET_TAC[]; ASM_SIMP_TAC[CLOSURE_CLOSED; CLOSED_AFFINE]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN X_GEN_TAC `z:real^N` THEN GEOM_ORIGIN_TAC `z:real^N` THEN SIMP_TAC[AFFINE_EQ_SUBSPACE; AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LT] THEN MESON_TAC[DENSE_COMPLEMENT_SUBSPACE]]);; let DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL = prove (`!s t:real^N->bool. aff_dim t < aff_dim s /\ open_in (subtopology euclidean (affine hull s)) s ==> closure(s DIFF t) = closure s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `affine hull s DIFF t:real^N->bool`; `affine hull s:real^N->bool`] CLOSURE_OPEN_IN_INTER_CLOSURE) THEN ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; SUBSET_DIFF] THEN ASM_SIMP_TAC[DENSE_COMPLEMENT_AFFINE; AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN MP_TAC(ISPECL [`affine:(real^N->bool)->bool`; `s:real^N->bool`] HULL_SUBSET) THEN SET_TAC[]);; let DENSE_COMPLEMENT_CONVEX = prove (`!s t:real^N->bool. aff_dim t < aff_dim s /\ convex s ==> closure(s DIFF t) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[SUBSET_CLOSURE; SUBSET_DIFF] THEN MP_TAC(ISPECL [`relative_interior s:real^N->bool`; `t:real^N->bool`] DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL) THEN ASM_SIMP_TAC[OPEN_IN_RELATIVE_INTERIOR; AFF_DIM_RELATIVE_INTERIOR; AFFINE_HULL_RELATIVE_INTERIOR; CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]);; let DENSE_COMPLEMENT_CONVEX_CLOSED = prove (`!s t:real^N->bool. aff_dim t < aff_dim s /\ convex s /\ closed s ==> closure(s DIFF t) = s`, ASM_SIMP_TAC[DENSE_COMPLEMENT_CONVEX; CLOSURE_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Homeomorphism of all convex compact sets with same affine dimension, and *) (* in particular all those with nonempty interior. *) (* ------------------------------------------------------------------------- *) let COMPACT_FRONTIER_LINE_LEMMA = prove (`!s x. compact s /\ (vec 0 IN s) /\ ~(x = vec 0 :real^N) ==> ?u. &0 <= u /\ (u % x) IN frontier s /\ !v. u < v ==> ~((v % x) IN s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`{y:real^N | ?u. &0 <= u /\ u <= b / norm(x) /\ (y = u % x)} INTER s`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN EXISTS_TAC `&0` THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL; REAL_LT_IMP_LE; REAL_LT_DIV; NORM_POS_LT]] THEN MATCH_MP_TAC COMPACT_INTER THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{y:real^N | ?u. &0 <= u /\ u <= b / norm(x) /\ (y = u % x)} = IMAGE (\u. drop u % x) (interval [vec 0,lambda i. b / norm(x:real^N)])` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_INTERVAL] THEN SIMP_TAC[LAMBDA_BETA] THEN SIMP_TAC[DIMINDEX_1; ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL; DROP_VEC] THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]; ALL_TAC] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> c /\ a /\ b /\ d`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_REWRITE_TAC (BINDER_CONV o ONCE_DEPTH_CONV) [SWAP_FORALL_THM] THEN SIMP_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real` THEN REWRITE_TAC[dist; VECTOR_SUB_LZERO; NORM_NEG; NORM_MUL] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[real_abs] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[FRONTIER_STRADDLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN CONJ_TAC THENL [EXISTS_TAC `u % x :real^N` THEN ASM_REWRITE_TAC[DIST_REFL]; ALL_TAC] THEN EXISTS_TAC `(u + (e / &2) / norm(x)) % x :real^N` THEN REWRITE_TAC[dist; VECTOR_ARITH `u % x - (u + a) % x = --(a % x)`] THEN ASM_SIMP_TAC[NORM_NEG; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_EQ_0; REAL_DIV_RMUL; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_ARITH `abs e < e * &2 <=> &0 < e`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u + (e / &2) / norm(x:real^N)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ &0 <= u /\ u + e <= b ==> ~(&0 <= u + e /\ u + e <= b ==> u + e <= u)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NORM_POS_LT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(u + (e / &2) / norm(x:real^N)) % x`) THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real`) THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LET_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `v % x:real^N`) THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN REAL_ARITH_TAC);; let STARLIKE_COMPACT_PROJECTIVE = prove (`!s:real^N->bool a. compact s /\ a IN relative_interior s /\ (!x. x IN s ==> segment(a,x) SUBSET relative_interior s) ==> s DIFF relative_interior s homeomorphic sphere(a,&1) INTER affine hull s /\ s homeomorphic cball(a,&1) INTER affine hull s /\ relative_interior s homeomorphic (ball(a,&1)) INTER affine hull s`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[SUBSET; IMP_IMP; RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!x:real^N u. x IN s /\ &0 <= u /\ u < &1 ==> (u % x) IN relative_interior s` ASSUME_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 <= u <=> u = &0 \/ &0 < u`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(K ALL_TAC o SPECL [`x:real^N`; `x:real^N`])] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET)) THEN ABBREV_TAC `proj = \x:real^N. inv(norm(x)) % x` THEN SUBGOAL_THEN `!x:real^N y. (proj(x) = proj(y):real^N) /\ (norm x = norm y) <=> (x = y)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_SIMP_TAC[NORM_EQ_0; NORM_0] THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_MESON_TAC[NORM_EQ_0]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN EXPAND_TAC "proj" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a % x = a % y <=> a % (x - y):real^N = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN SUBGOAL_THEN `(!x. x IN affine hull s ==> proj x IN affine hull s) /\ (!x. ~(x = vec 0) ==> norm(proj x) = &1) /\ (!x:real^N. proj x = vec 0 <=> x = vec 0)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "proj" THEN REWRITE_TAC[NORM_MUL; VECTOR_MUL_EQ_0] THEN REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0; REAL_ABS_INV; REAL_ABS_NORM] THEN SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; VECTOR_ADD_LID; HULL_INC]; ALL_TAC] THEN SUBGOAL_THEN `(proj:real^N->real^N) continuous_on (UNIV DELETE vec 0)` ASSUME_TAC THENL [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REWRITE_TAC[IN_DELETE; IN_UNIV] THEN EXPAND_TAC "proj" THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_SIMP_TAC[CONTINUOUS_AT_ID] THEN REWRITE_TAC[GSYM(ISPEC `lift` o_DEF); GSYM(ISPEC `inv:real->real` o_DEF)] THEN MATCH_MP_TAC CONTINUOUS_AT_INV THEN ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CONTINUOUS_AT_LIFT_NORM]; ALL_TAC] THEN SUBGOAL_THEN `!a x. &0 < a ==> (proj:real^N->real^N)(a % x) = proj x` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "proj" THEN REWRITE_TAC[NORM_MUL; REAL_INV_MUL; VECTOR_MUL_ASSOC] THEN SIMP_TAC[REAL_FIELD `&0 < a ==> (inv(a) * x) * a = x`; real_abs; REAL_LT_IMP_LE]; ALL_TAC] THEN ABBREV_TAC `usph = {x:real^N | x IN affine hull s /\ norm x = &1}` THEN SUBGOAL_THEN ` sphere(vec 0:real^N,&1) INTER affine hull s = usph` SUBST1_TAC THENL [EXPAND_TAC "usph" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE_0] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN affine hull s /\ ~(x = vec 0) ==> (proj:real^N->real^N) x IN usph` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?surf. homeomorphism (s DIFF relative_interior s,usph) (proj:real^N->real^N,surf)` MP_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN ASM_SIMP_TAC[COMPACT_RELATIVE_BOUNDARY] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN EXPAND_TAC "usph" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[HULL_INC]; MAP_EVERY EXPAND_TAC ["proj"; "usph"] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `x:real^N`] RAY_TO_RELATIVE_FRONTIER) THEN REWRITE_TAC[relative_frontier] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; CLOSURE_CLOSED; COMPACT_IMP_CLOSED; VECTOR_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXPAND_TAC "proj" THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `d % x:real^N` THEN ASM_REWRITE_TAC[NORM_MUL] THEN ASM_SIMP_TAC[REAL_MUL_RID; real_abs; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID]]; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `y:real^N = vec 0` THENL [ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `(proj:real^N->real^N) x = proj y` THEN EXPAND_TAC "proj" THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `norm(x:real^N) = norm(y:real^N) \/ norm x < norm y \/ norm y < norm x`) THENL [ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_INV_EQ_0; NORM_EQ_0]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `norm(x:real^N) / norm(y:real^N)`]); DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `norm(y:real^N) / norm(x:real^N)`])] THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_LDIV_EQ; NORM_POS_LT; REAL_MUL_LID] THEN ASM_REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM); ALL_TAC] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID]]; DISCH_THEN(X_CHOOSE_TAC `surf:real^N->real^N`)] THEN CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MATCH_MP_TAC(MESON[] `(?x. P x /\ Q x) ==> (?x. P x) /\ (?x. Q x)`) THEN EXISTS_TAC `\x:real^N. norm(x) % (surf:real^N->real^N)(proj(x))` THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p ==> q`] THEN GEN_REWRITE_TAC LAND_CONV [homeomorphism] THEN REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHISM_OF_SUBSETS) THEN SIMP_TAC[RELATIVE_INTERIOR_SUBSET; BALL_SUBSET_CBALL; SET_RULE `b SUBSET c ==> b INTER s SUBSET c INTER s`] THEN ONCE_REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN REWRITE_TAC[SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF {x | x IN u /\ x IN t}`] THEN ASM_REWRITE_TAC[IN_SPHERE_0] THEN MATCH_MP_TAC(SET_RULE `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ u SUBSET s /\ IMAGE f s DIFF IMAGE f u = v ==> IMAGE f (s DIFF u) = v`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [EXPAND_TAC "usph" THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INTER; IN_CBALL_0; REAL_LE_REFL]; MATCH_MP_TAC(SET_RULE `t SUBSET s /\ u = s DIFF t ==> s DIFF u = t`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN DISCH_THEN(SUBST1_TAC o SYM o el 4 o CONJUNCTS) THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN MAP_EVERY EXPAND_TAC ["usph"; "proj"] THEN SIMP_TAC[IN_ELIM_THM; REAL_INV_1; REAL_MUL_LID; VECTOR_MUL_LID]]; ALL_TAC] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN SIMP_TAC[COMPACT_INTER_CLOSED; CLOSED_AFFINE_HULL; COMPACT_CBALL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN STRIP_TAC THEN UNDISCH_THEN `(proj:real^N->real^N) continuous_on s DIFF relative_interior s` (K ALL_TAC) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `x = vec 0:real^N` THENL [ASM_REWRITE_TAC[CONTINUOUS_WITHIN; VECTOR_MUL_LZERO; NORM_0] THEN MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[LIM_WITHIN; o_THM; DIST_0; NORM_LIFT; REAL_ABS_NORM] THEN MESON_TAC[]; REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_INTER; DIST_0; NORM_POS_LT] THEN ASM SET_TAC[]]; MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `affine hull s:real^N->bool` THEN REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; CONTINUOUS_WITHIN_ID; o_DEF] THEN SUBGOAL_THEN `((surf:real^N->real^N) o (proj:real^N->real^N)) continuous_on (affine hull s DELETE vec 0)` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; IN_DELETE; IN_UNIV; FORALL_IN_IMAGE] THEN EXPAND_TAC "usph" THEN ASM_SIMP_TAC[IN_ELIM_THM]; SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[IN_DELETE] THEN REWRITE_TAC[CONTINUOUS_WITHIN; o_DEF] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_SET THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `norm(x:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE; IN_INTER; IN_CBALL; NORM_POS_LT] THEN X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `(y:real^N) IN affine hull s` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH]]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN ASM_CASES_TAC `y:real^N = vec 0` THENL [ASM_SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_EQ_0; NORM_0; NORM_EQ_0] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_EQ_0; NORM_0; NORM_EQ_0] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTER; IN_CBALL_0] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(AP_TERM `proj:real^N->real^N` th)) THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_MUL_RCANCEL] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; VECTOR_MUL_LZERO; IN_INTER] THEN REWRITE_TAC[IN_CBALL_0; REAL_LE_LT] THEN STRIP_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM SET_TAC[]; ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN ASM SET_TAC[]]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_CBALL_0; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [EXISTS_TAC `vec 0:real^N` THEN ASM_SIMP_TAC[NORM_0; VECTOR_MUL_LZERO; HULL_INC; REAL_POS]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN usph ==> ~((surf:real^N->real^N) x = vec 0)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `inv(norm(surf(proj x:real^N):real^N)) % x:real^N` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [NORM_POS_LT; REAL_LT_INV_EQ; HULL_INC; REAL_LT_MUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REAL_FIELD `~(y = &0) ==> x = (inv y * x) * y`) THEN ASM_SIMP_TAC[NORM_EQ_0; HULL_INC]; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [GSYM real_div; REAL_LE_LDIV_EQ; NORM_POS_LT; HULL_INC; REAL_MUL_LID] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `norm(surf(proj x:real^N):real^N) / norm(x:real^N)`]) THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_LDIV_EQ; NORM_POS_LT] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT; REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN SUBGOAL_THEN `norm(surf(proj x)) / norm x % x:real^N = surf(proj x:real^N)` SUBST1_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [NORM_POS_LT; REAL_LT_INV_EQ; HULL_INC; REAL_LT_MUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_ABS_DIV; REAL_LT_DIV; REAL_DIV_RMUL; NORM_EQ_0]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f s SUBSET t DIFF u ==> x IN s ==> ~(f x IN u)`)) THEN ASM_SIMP_TAC[HULL_INC]]; GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; VECTOR_ADD_LID; HULL_INC]]);; let [HOMEOMORPHIC_CONVEX_COMPACT_SETS; HOMEOMORPHIC_RELATIVE_INTERIORS_CONVEX_COMPACT_SETS; HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS] = (CONJUNCTS o prove) (`(!s:real^M->bool t:real^N->bool. convex s /\ compact s /\ convex t /\ compact t /\ aff_dim s = aff_dim t ==> s homeomorphic t) /\ (!s:real^M->bool t:real^N->bool. convex s /\ compact s /\ convex t /\ compact t /\ aff_dim s = aff_dim t ==> relative_interior s homeomorphic relative_interior t) /\ (!s:real^M->bool t:real^N->bool. convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s = aff_dim t ==> relative_frontier s homeomorphic relative_frontier t)`, let lemma = prove (`!s:real^M->bool t:real^N->bool. convex s /\ compact s /\ convex t /\ compact t /\ aff_dim s = aff_dim t ==> (s DIFF relative_interior s) homeomorphic (t DIFF relative_interior t) /\ s homeomorphic t /\ relative_interior s homeomorphic relative_interior t`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THENL [UNDISCH_TAC `relative_interior t:real^N->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; RELATIVE_INTERIOR_EMPTY; EMPTY_DIFF; HOMEOMORPHIC_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY]; FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_CASES_TAC `relative_interior s:real^M->bool = {}` THENL [UNDISCH_TAC `relative_interior s:real^M->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; RELATIVE_INTERIOR_EMPTY; EMPTY_DIFF; HOMEOMORPHIC_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY]; FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `b:real^N` THEN REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^M` THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `vec 0:real^M`] STARLIKE_COMPACT_PROJECTIVE) THEN MP_TAC(ISPECL [`t:real^N->bool`; `vec 0:real^N`] STARLIKE_COMPACT_PROJECTIVE) THEN ASM_SIMP_TAC[IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN MATCH_MP_TAC(TAUT `(p ==> q ==> r) /\ (p' ==> q' ==> r') /\ (p'' ==> q'' ==> r'') ==> p /\ p' /\ p'' ==> q /\ q' /\ q'' ==> r /\ r' /\ r''`) THEN REPEAT CONJ_TAC THEN DISCH_THEN(fun th -> MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN MP_TAC(ONCE_REWRITE_RULE[HOMEOMORPHIC_SYM] th)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_TRANS) THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET))) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; AFF_DIM_DIM_0] THEN REWRITE_TAC[INT_OF_NUM_EQ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`span s:real^M->bool`; `span t:real^N->bool`] ISOMETRIES_SUBSPACES) THEN ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; homeomorphic; HOMEOMORPHISM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_BALL_0; IN_CBALL_0; IN_SPHERE_0] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]) in SIMP_TAC[lemma; relative_frontier] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`closure s:real^M->bool`; `closure t:real^N->bool`] lemma) THEN ASM_SIMP_TAC[CONVEX_CLOSURE; COMPACT_CLOSURE; AFF_DIM_CLOSURE] THEN ASM_SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE]);; let HOMEOMORPHIC_CONVEX_COMPACT = prove (`!s:real^N->bool t:real^N->bool. convex s /\ compact s /\ ~(interior s = {}) /\ convex t /\ compact t /\ ~(interior t = {}) ==> s homeomorphic t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT_SETS THEN ASM_SIMP_TAC[AFF_DIM_NONEMPTY_INTERIOR]);; let HOMEOMORPHIC_CONVEX_COMPACT_CBALL = prove (`!s:real^N->bool b:real^N e. convex s /\ compact s /\ ~(interior s = {}) /\ &0 < e ==> s homeomorphic cball(b,e)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN ASM_REWRITE_TAC[COMPACT_CBALL; INTERIOR_CBALL; CONVEX_CBALL] THEN ASM_REWRITE_TAC[BALL_EQ_EMPTY; REAL_NOT_LE]);; let HOMEOMORPHIC_CLOSED_INTERVALS = prove (`!a b:real^N c d:real^N. ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) ==> interval[a,b] homeomorphic interval[c,d]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL] THEN ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL]);; (* ------------------------------------------------------------------------- *) (* Hence homeomorphism of convex open sets of same affine dimension. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS = prove (`!s:real^M->bool t:real^N->bool. convex s /\ open_in (subtopology euclidean (affine hull s)) s /\ convex t /\ open_in (subtopology euclidean (affine hull t)) t /\ aff_dim s = aff_dim t ==> s homeomorphic t`, let lemma = prove (`!s:real^N->bool. convex s /\ open_in (subtopology euclidean (affine hull s)) s ==> ?t:real^N->bool. convex t /\ bounded t /\ aff_dim t = aff_dim s /\ open_in (subtopology euclidean (affine hull t)) t /\ s homeomorphic t`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [STRIP_TAC THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BOUNDED_EMPTY; HOMEOMORPHIC_REFL]; POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT STRIP_TAC] THEN X_CHOOSE_THEN `f:real^N->real^N` MP_TAC CONVEXITY_PRESERVING_SHRINK_0 THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (f:real^N->real^N) s` THEN ASM_SIMP_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,&1)` THEN REWRITE_TAC[BOUNDED_BALL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN SET_TAC[]; ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN ONCE_REWRITE_TAC[GSYM SPAN_CONIC_HULL] THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `IMAGE (f:real^N->real^N) u` THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_IMP_OPEN_MAP)) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_UNIV; OPEN_BALL; SUBSET_UNIV]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET_INTER; HULL_SUBSET] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GSYM) THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN ONCE_REWRITE_TAC[GSYM SPAN_CONIC_HULL] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SPAN_CONIC_HULL] THEN MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) /\ (!x. f(x) IN v ==> x IN v) ==> v INTER u = s ==> v INTER IMAGE f u SUBSET IMAGE f s`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `conic hull (IMAGE (f:real^N->real^N) {x}) = conic hull {x}` MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IMAGE_CLAUSES] THEN REWRITE_TAC[SET_RULE `{f a x | P a /\ x IN {b}} = {f a b | P a}`] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `{c % f x | P c} = {c % x | P c} ==> P(&1) ==> ?c. &1 % x = c % f x`)) THEN REWRITE_TAC[REAL_POS; LEFT_IMP_EXISTS_THM; VECTOR_MUL_LID] THEN ASM_MESON_TAC[SPAN_MUL]]; FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN REWRITE_TAC[homeomorphism; homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^M->bool` lemma) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `s':real^M->bool` THEN STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `s':real^M->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `t:real^N->bool` lemma) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t':real^N->bool` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN TRANS_TAC HOMEOMORPHIC_TRANS `t':real^N->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`closure t':real^N->bool`; `closure s':real^M->bool`] HOMEOMORPHIC_RELATIVE_INTERIORS_CONVEX_COMPACT_SETS) THEN ASM_SIMP_TAC[CONVEX_CLOSURE; COMPACT_CLOSURE; AFF_DIM_CLOSURE] THEN ASM_SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE; RELATIVE_INTERIOR_OPEN_IN]);; let HOMEOMORPHIC_CONVEX_OPEN_SETS = prove (`!s:real^N->bool t:real^N->bool. convex s /\ open s /\ convex t /\ open t /\ (s = {} <=> t = {}) ==> s homeomorphic t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS THEN ASM_SIMP_TAC[OPEN_SUBSET; HULL_SUBSET; AFF_DIM_OPEN]);; (* ------------------------------------------------------------------------- *) (* More refined Lipschitz homeomorphisms between relative frontiers. *) (* ------------------------------------------------------------------------- *) let LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT = prove (`!r R s x y:real^N. convex s /\ &0 < r /\ vec 0 IN s /\ ball(vec 0,r) INTER affine hull s SUBSET relative_interior s /\ x IN relative_frontier s /\ y IN relative_frontier s ==> dist(inv(norm x) % x,inv(norm y) % y) <= inv r * dist(x,y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`norm(x:real^N)`; `norm(y:real^N)`; `inv(norm x) % x:real^N`; `inv(norm y) % y:real^N`] DIST_DESCALE) THEN SUBGOAL_THEN `~(x:real^N = vec 0) /\ ~(y:real^N = vec 0)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t SUBSET u ==> z IN s /\ z IN t /\ ~(x IN u) ==> ~(x = z)`)) THEN ASM_SIMP_TAC[HULL_INC; CENTRE_IN_BALL] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF]; ALL_TAC] THEN ASM_SIMP_TAC[NORM_POS_LE; NORM_MUL; VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV; NORM_EQ_0; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[VECTOR_MUL_LID; real_ge] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_MIN; NORM_POS_LT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[DIST_POS_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LE_MIN] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t SUBSET u ==> (r <= norm(z:real^N) <=> ~(z IN s)) /\ z IN t /\ ~(z IN u) ==> r <= norm z`)) THEN RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[IN_BALL_0; REAL_NOT_LT] THEN ASM_MESON_TAC[AFFINE_HULL_CLOSURE; HULL_INC]);; let LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION = prove (`!s:real^N->bool. convex s /\ vec 0 IN relative_interior s ==> ?B. !x y. x IN relative_frontier s /\ y IN relative_frontier s ==> dist(inv(norm x) % x,inv(norm y) % y) <= B * dist(x,y)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv r:real` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhand o rand) OPEN_IN_SUBSET_RELATIVE_INTERIOR o snd) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL]);; let INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT = prove (`!r R s x y:real^N. convex s /\ &0 < r /\ vec 0 IN s /\ ball(vec 0,r) INTER affine hull s SUBSET relative_interior s /\ s SUBSET cball(vec 0,R) /\ x IN relative_frontier s /\ y IN relative_frontier s ==> dist(inv(norm x) % x,inv(norm y) % y) >= r / R pow 2 * dist(x,y)`, let lemma0 = prove (`!x y:real^N. orthogonal x y ==> norm(x) <= norm(x + y)`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP NORM_ADD_PYTHAGOREAN) THEN REWRITE_TAC[NORM_LE_SQUARE] THEN ASM_REWRITE_TAC[NORM_POS_LE; GSYM NORM_POW_2] THEN REWRITE_TAC[REAL_LE_ADDR; REAL_LE_POW_2]) in let lemma1 = prove (`!a b x y:real^N. &0 <= a /\ &0 <= b /\ x dot y <= &0 ==> dist(a % x,b % y) >= min a b * dist(x,y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[dist; NORM_GE_SQUARE] THEN DISJ2_TAC THEN REWRITE_TAC[REAL_POW_MUL; NORM_POW_2] THEN REWRITE_TAC[VECTOR_ARITH `(x - y:real^N) dot (x - y) = x dot x + y dot y + &2 * --(x dot y)`] THEN REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[DOT_LMUL; real_ge] THEN REWRITE_TAC[GSYM REAL_MUL_RNEG; REAL_ADD_LDISTRIB; REAL_MUL_ASSOC] THEN REPEAT(MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[DOT_POS_LE] THEN ASM_REWRITE_TAC[REAL_NEG_GE0] THEN REWRITE_TAC[REAL_ARITH `a * &2 <= (&2 * x) * y <=> a <= x * y`] THEN REWRITE_TAC[REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC) in let lemma2 = prove (`!a b w x y:real^N. &0 <= a /\ &0 <= b /\ between w (x,y) /\ orthogonal w (x - y) ==> dist(a % x,b % y) >= min a b * dist(x,y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real`; `b:real`; `x - w:real^N`; `y - w:real^N`] lemma1) THEN ASM_REWRITE_TAC[real_ge] THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_IN_SEGMENT]) THEN SIMP_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[VECTOR_ARITH `x - ((&1 - u) % x + u % y):real^N = u % (x - y) /\ y - ((&1 - u) % x + u % y):real^N = (u - &1) % (x - y)`] THEN REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[DOT_LMUL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(u - &1) * x <= &0 <=> &0 <= (&1 - u) * x`] THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN REWRITE_TAC[DOT_POS_LE] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[NORM_ARITH `dist(x - w:real^N,y - w) = dist(x,y)`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[dist] THEN SUBST1_TAC(VECTOR_ARITH `a % x - b % y:real^N = (a % (x - w) - b % (y - w)) + (a - b) % w`) THEN MATCH_MP_TAC lemma0 THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN DISJ2_TAC THEN MATCH_MP_TAC(last(CONJUNCTS ORTHOGONAL_CLAUSES)) THEN CONJ_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN DISJ2_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_IN_SEGMENT]) THEN SIMP_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[VECTOR_ARITH `x - ((&1 - u) % x + u % y):real^N = u % (x - y) /\ y - ((&1 - u) % x + u % y):real^N = (u - &1) % (x - y)`] THEN GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[ORTHOGONAL_MUL]]) in let mainlemma_2d = prove (`collinear {z:real^2,x,x'} /\ collinear {w,x,y} /\ orthogonal (z - w) (x - y) /\ orthogonal (y - x') (z - x') /\ ~(x' = z) /\ ~(y = w) ==> dist(z,w) * dist(x,y) = dist(y,x') * dist(z,x)`, REPEAT GEN_TAC THEN REWRITE_TAC[PAIRWISE; ALL] THEN GEOM_ORIGIN_TAC `x:real^2` THEN REWRITE_TAC[GSYM DIST_EQ_0] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y /\ abs x = abs y ==> x = y`) THEN SIMP_TAC[DIST_POS_LE; REAL_LE_MUL; REAL_EQ_SQUARE_ABS; REAL_POW_MUL] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[REAL_RING `x = &0 <=> x pow 2 = &0`] THEN REWRITE_TAC[COLLINEAR_3_2D; dist; orthogonal; NORM_POW_2] THEN REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT; VEC_COMPONENT] THEN CONV_TAC REAL_RING) in let mainlemma = prove (`collinear {z:real^N,x,x'} /\ collinear {w,x,y} /\ orthogonal (z - w) (x - y) /\ orthogonal (y - x') (z - x') /\ ~(x' = z) /\ ~(y = w) ==> dist(z,w) * dist(x,y) = dist(y,x') * dist(z,x)`, ASM_CASES_TAC `dimindex(:N) <= dimindex(:2)` THENL [MP_TAC(DISCH_ALL(GEOM_DROP_DIMENSION_RULE (ASSUME `dimindex(:N) <= dimindex(:2)`) (GEN_ALL mainlemma_2d))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_ACCEPT_TAC; RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE])] THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `?f:real^2->real^N. linear f /\ span {vec 0:real^N,x,y,w,x'} SUBSET IMAGE f (:real^2) /\ (!x. norm(f x) = norm x)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC ISOMETRY_UNIV_SUPERSET_SUBSPACE THEN ASM_SIMP_TAC[LT_IMP_LE; SUBSPACE_SPAN; DIM_SPAN; DIMINDEX_2] THEN SIMP_TAC[GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_0; HULL_INC; IN_INSERT] THEN TRANS_TAC INT_LE_TRANS `aff_dim(affine hull {vec 0:real^N,x,x'} UNION affine hull {w,x,y})` THEN CONJ_TAC THENL [MATCH_MP_TAC AFF_DIM_SUBSET THEN SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_UNION; HULL_INC; IN_INSERT]; W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_UNION o lhand o snd) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC(TAUT `p /\ (p /\ q ==> r) ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN MESON_TAC[HULL_INC; IN_INSERT]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)] THEN MATCH_MP_TAC(INT_ARITH `x:int <= &1 /\ y <= &1 /\ &0 <= z ==> (x + y) - z <= &2`) THEN ASM_REWRITE_TAC[GSYM COLLINEAR_AFF_DIM; AFF_DIM_POS_LE]]; FIRST_X_ASSUM(MP_TAC o check (is_conj o concl))] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `span s SUBSET t ==> s SUBSET span s ==> s SUBSET t`)) THEN REWRITE_TAC[SPAN_INC] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!x y. (f:real^2->real^N) x = f y ==> x = y` ASSUME_TAC THENL [ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE]; ALL_TAC] THEN MP_TAC(end_itlist CONJ (mapfilter (ISPEC `f:real^2->real^N`) (!invariant_under_linear))) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBST1_TAC(SET_RULE `{} = IMAGE (f:real^2->real^N) {}`) THEN ASM_REWRITE_TAC[] THEN MATCH_ACCEPT_TAC mainlemma_2d) in REPEAT GEN_TAC THEN ASM_CASES_TAC `R < &0` THENL [ASM_SIMP_TAC[CBALL_EMPTY] THEN SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN STRIP_TAC THEN REWRITE_TAC[real_ge] THEN SUBGOAL_THEN `~(x:real^N = vec 0) /\ ~(y:real^N = vec 0)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t SUBSET u ==> z IN s /\ z IN t /\ ~(x IN u) ==> ~(x = z)`)) THEN ASM_SIMP_TAC[HULL_INC; CENTRE_IN_BALL] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF]; ALL_TAC] THEN SUBGOAL_THEN `r <= norm(x:real^N) /\ r <= norm(y:real^N)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t SUBSET u ==> (r <= norm(z:real^N) <=> ~(z IN s)) /\ z IN t /\ ~(z IN u) ==> r <= norm z`)) THEN RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[IN_BALL_0; REAL_NOT_LT] THEN ASM_MESON_TAC[AFFINE_HULL_CLOSURE; HULL_INC]; ALL_TAC] THEN SUBGOAL_THEN `norm(x:real^N) <= R /\ norm(y:real^N) <= R` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN UNDISCH_TAC `s SUBSET cball(vec 0:real^N,R)` THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN REWRITE_TAC[CLOSURE_CBALL; SUBSET; IN_CBALL_0] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF]; ALL_TAC] THEN SUBGOAL_THEN `r <= R /\ &0 < R` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `(x:real^N) dot y <= &0` THENL [W(MP_TAC o PART_MATCH (lhand o rand) lemma1 o rand o snd) THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; real_ge; NORM_POS_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[DIST_POS_LE] THEN TRANS_TAC REAL_LE_TRANS `inv R:real` THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_2] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; GSYM real_div; REAL_LE_LDIV_EQ] THEN ASM_REWRITE_TAC[REAL_MUL_LID]; REWRITE_TAC[REAL_LE_MIN] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[NORM_POS_LT]]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE])] THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[DIST_REFL; REAL_MUL_RZERO; REAL_LE_REFL] THEN MP_TAC(GEN `v:real^N` (ISPECL [`affine hull {x:real^N,y}`; `vec 0:real^N`; `v:real^N`] CLOSEST_POINT_AFFINE_ORTHOGONAL)) THEN MP_TAC(ISPECL [`affine hull {x:real^N,y}`; `vec 0:real^N`] CLOSEST_POINT_EXISTS) THEN ABBREV_TAC `w = closest_point (affine hull {x, y}) (vec 0:real^N)` THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REWRITE_TAC[CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC; IN_INSERT] THEN REWRITE_TAC[DIST_0; VECTOR_SUB_LZERO; ORTHOGONAL_RNEG] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `orthogonal (x - y:real^N) w` MP_TAC THENL [SUBST1_TAC(VECTOR_ARITH `x - y:real^N = (x - w) - (y - w)`) THEN MATCH_MP_TAC(last(CONJUNCTS ORTHOGONAL_CLAUSES)) THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT]; UNDISCH_THEN `!v:real^N. v IN affine hull {x, y} ==> orthogonal (v - w) w` (K ALL_TAC) THEN DISCH_TAC] THEN MP_TAC(fst(EQ_IMP_RULE(ISPECL [`w:real^N`; `x:real^N`; `y:real^N`] COLLINEAR_BETWEEN_CASES))) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,c,a}`] THEN MATCH_MP_TAC AFFINE_HULL_3_IMP_COLLINEAR THEN ASM_REWRITE_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (TAUT `p \/ q \/ r ==> (q /\ ~p \/ r /\ ~p) \/ p`))] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [BETWEEN_SYM] THEN DISCH_THEN(fun th -> POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN MP_TAC th) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`y:real^N`; `x:real^N`] THEN MATCH_MP_TAC(MESON[] `(!x y. R x y <=> R y x) /\ (!x y. P x y ==> R x y) ==> (!x y. P x y \/ P y x ==> R x y)`) THEN CONJ_TAC THENL [REWRITE_TAC[INSERT_AC; DIST_SYM; EQ_SYM_EQ; DOT_SYM; MESON[ORTHOGONAL_LNEG; VECTOR_NEG_SUB] `orthogonal (x - y:real^N) w <=> orthogonal (y - x) w`] THEN REWRITE_TAC[CONJ_ACI]; REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [BETWEEN_SYM] THEN ASM_CASES_TAC `w:real^N = x` THEN ASM_REWRITE_TAC[BETWEEN_REFL] THEN ASM_CASES_TAC `w:real^N = y` THEN ASM_REWRITE_TAC[BETWEEN_REFL] THEN REPEAT STRIP_TAC] THEN TRANS_TAC REAL_LE_TRANS `r / R pow 2 * dist(x:real^N,y)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[DIST_POS_LE] THEN REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `abs(inv(norm y)) * dist(norm y / norm x % x:real^N,y)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[dist; GSYM NORM_MUL; VECTOR_SUB_LDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_REFL; VECTOR_MUL_ASSOC; NORM_EQ_0; REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> inv y * y / x = inv x`]] THEN REWRITE_TAC[real_div; REAL_INV_POW] THEN REWRITE_TAC[REAL_ARITH `(r * inv(R) pow 2) * d:real = inv(R) * r / R * d`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; DIST_POS_LE] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[NORM_POS_LT] THEN UNDISCH_TAC `s SUBSET cball(vec 0:real^N,R)` THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN REWRITE_TAC[CLOSURE_CBALL; SUBSET; IN_CBALL_0] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF]; ALL_TAC] THEN ABBREV_TAC `x' = closest_point (affine hull {vec 0,x}) (y:real^N)` THEN MP_TAC(GEN `v:real^N` (ISPECL [`affine hull {vec 0:real^N,x}`; `y:real^N`; `v:real^N`] CLOSEST_POINT_AFFINE_ORTHOGONAL)) THEN MP_TAC(ISPECL [`affine hull {vec 0:real^N,x}`; `y:real^N`] CLOSEST_POINT_EXISTS) THEN SIMP_TAC[CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC; IN_INSERT] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `dist(y:real^N,x')` THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM; VECTOR_MUL_RZERO] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `norm(y:real^N) * inv(norm(x:real^N))` THEN REWRITE_TAC[VECTOR_ADD_LID; REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN REWRITE_TAC[EXISTS_REFL]] THEN ASM_CASES_TAC `R = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_MUL_LZERO; DIST_POS_LE]; SUBGOAL_THEN `&0 < R` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC]] THEN ONCE_REWRITE_TAC[REAL_ARITH `r / R * x:real = (r * x) / R`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN TRANS_TAC REAL_LE_TRANS `norm(w:real^N) * dist(x:real^N,y)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[DIST_POS_LE] THEN REWRITE_TAC[GSYM IN_BALL_0; GSYM REAL_NOT_LT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER a SUBSET r ==> w IN a /\ ~(w IN r) ==> ~(w IN b)`)) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `w IN s ==> s SUBSET t ==> w IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN ONCE_REWRITE_TAC[GSYM AFFINE_HULL_CLOSURE] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier; IN_DIFF]) THEN ASM_SIMP_TAC[HULL_INC]; DISCH_TAC THEN UNDISCH_TAC `(x:real^N) IN relative_frontier s` THEN REWRITE_TAC[relative_frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `w:real^N`; `y:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ANTS_TAC THENL [ASM_MESON_TAC[relative_frontier; IN_DIFF]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT]]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `dist(y:real^N,x') * norm(x:real^N)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[DIST_POS_LE] THEN UNDISCH_TAC `s SUBSET cball(vec 0:real^N,R)` THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN REWRITE_TAC[CLOSURE_CBALL; SUBSET; IN_CBALL_0] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF]] THEN REWRITE_TAC[NORM_ARITH `norm(w:real^N) = dist(vec 0,w)`] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC mainlemma THEN ASM_REWRITE_TAC[VECTOR_SUB_LZERO; ORTHOGONAL_LNEG; ORTHOGONAL_RNEG] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[AFFINE_HULL_3_IMP_COLLINEAR; INSERT_AC]; ASM_MESON_TAC[AFFINE_HULL_3_IMP_COLLINEAR; INSERT_AC]; ASM_MESON_TAC[ORTHOGONAL_SYM]; ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN REWRITE_TAC[ORTHOGONAL_LNEG] THEN REWRITE_TAC[VECTOR_NEG_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[HULL_INC; IN_INSERT]; DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_RZERO; orthogonal]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 < x dot y ==> x dot y = &0 ==> F`)) THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT]]; DISCH_TAC THEN MP_TAC(ISPECL [`inv(norm(x:real^N))`; `inv(norm(y:real^N))`; `w:real^N`; `x:real^N`; `y:real^N`] lemma2) THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; NORM_POS_LE; real_ge] THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[DIST_POS_LE] THEN TRANS_TAC REAL_LE_TRANS `inv R:real` THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_2] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; GSYM real_div; REAL_LE_LDIV_EQ] THEN ASM_REWRITE_TAC[REAL_MUL_LID]; REWRITE_TAC[REAL_LE_MIN] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[NORM_POS_LT]]]);; let INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION = prove (`!s:real^N->bool. convex s /\ bounded s /\ vec 0 IN relative_interior s ==> ?B. &0 < B /\ !x y. x IN relative_frontier s /\ y IN relative_frontier s ==> dist(inv(norm x) % x,inv(norm y) % y) >= B * dist(x,y)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[GSYM IN_CBALL_0; GSYM SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:real) / R pow 2` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhand o rand) OPEN_IN_SUBSET_RELATIVE_INTERIOR o snd) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL]);; let BILIPSCHITZ_HOMEOMORPHISM_SPHERICAL_PROJECTION = prove (`!s:real^N->bool. convex s /\ bounded s /\ vec 0 IN relative_interior s ==> ?g. homeomorphism (relative_frontier s,sphere(vec 0,&1) INTER affine hull s) ((\x. inv(norm x) % x),g) /\ (?B. !x y. x IN relative_frontier s /\ y IN relative_frontier s ==> norm(inv(norm x) % x - inv(norm y) % y) <= B * norm(x - y)) /\ (?B. !x y. x IN sphere(vec 0,&1) INTER affine hull s /\ y IN sphere(vec 0,&1) INTER affine hull s ==> norm(g x - g y) <= B * norm(x - y))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION) THEN ASM_REWRITE_TAC[dist; LIPSCHITZ_ON_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `s:real^N->bool` INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION) THEN ASM_REWRITE_TAC[real_ge; dist] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`relative_frontier s:real^N->bool`; `\x:real^N. inv(norm x) % x`; `sphere(vec 0:real^N,&1) INTER affine hull s`] HOMEOMORPHISM_COMPACT) THEN ASM_SIMP_TAC[COMPACT_RELATIVE_FRONTIER_BOUNDED] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_ID] THEN REWRITE_TAC[NORM_EQ_0; relative_frontier; IN_DIFF] THEN ASM_MESON_TAC[]; REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTER; IN_SPHERE_0] THEN CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[NORM_EQ_0] THEN ASM_MESON_TAC[relative_frontier; IN_DIFF]; GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN REWRITE_TAC[AFFINE_AFFINE_HULL; VECTOR_ADD_LID] THEN ASM_MESON_TAC[AFFINE_HULL_CLOSURE; relative_frontier; IN_DIFF; IN_RELATIVE_INTERIOR; HULL_INC]]; REWRITE_TAC[IN_IMAGE] THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `x:real^N`] RAY_TO_RELATIVE_FRONTIER) THEN ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN ANTS_TAC THENL [ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `a % x:real^N` THEN ASM_REWRITE_TAC[NORM_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_MUL_RID; VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID]]; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`])) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN SIMP_TAC[NORM_ARITH `norm(x - y:real^N) <= &0 <=> x = y`]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN EXISTS_TAC `inv b:real` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN REWRITE_TAC[] THEN STRIP_TAC THEN SUBST1_TAC(SYM(ASSUME `IMAGE (\x:real^N. inv (norm x) % x) (relative_frontier s) = sphere (vec 0,&1) INTER affine hull s`)) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[]]);; let BILIPSCHITZ_HOMEOMORPHISM_RELATIVE_FRONTIERS = prove (`!s:real^M->bool t:real^N->bool. convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s = aff_dim t ==> ?f g. homeomorphism (relative_frontier s,relative_frontier t) (f,g) /\ (?B. !x y. x IN relative_frontier s /\ y IN relative_frontier s ==> norm(f x - f y) <= B * norm(x - y)) /\ (?B. !x y. x IN relative_frontier t /\ y IN relative_frontier t ==> norm(g x - g y) <= B * norm(x - y))`, let lemma1 = prove (`!s:real^N->bool t:real^N->bool. convex s /\ bounded s /\ convex t /\ bounded t /\ vec 0 IN relative_interior s /\ vec 0 IN relative_interior t /\ affine hull s = affine hull t ==> ?f g. homeomorphism (relative_frontier s,relative_frontier t) (f,g) /\ (?B. !x y. x IN relative_frontier s /\ y IN relative_frontier s ==> norm(f x - f y) <= B * norm(x - y)) /\ (?B. !x y. x IN relative_frontier t /\ y IN relative_frontier t ==> norm(g x - g y) <= B * norm(x - y))`, REPEAT STRIP_TAC THEN MAP_EVERY (MP_TAC o C SPEC BILIPSCHITZ_HOMEOMORPHISM_SPHERICAL_PROJECTION) [`t:real^N->bool`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REWRITE_TAC[IMP_IMP] THEN ABBREV_TAC `n (x:real^N) = inv(norm x) % x` THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `vec 0:real^N`) THEN REWRITE_TAC[ETA_AX] THEN MAP_EVERY (fun t -> X_GEN_TAC t THEN STRIP_TAC) [`f:real^N->real^N`; `B:real`; `C:real`; `f':real^N->real^N`; `B':real`; `C':real`] THEN MAP_EVERY EXISTS_TAC [`(f':real^N->real^N) o (n:real^N->real^N)`; `(f:real^N->real^N) o (n:real^N->real^N)`] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `sphere(vec 0:real^N,&1) INTER affine hull t` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM] THEN ASM_REWRITE_TAC[]; CONJ_TAC THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIPSCHITZ_ON_COMPOSE THEN EXISTS_TAC `sphere(vec 0:real^N,&1) INTER affine hull t` THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[]]) in let lemma2 = prove (`!s:real^M->bool t:real^N->bool. convex s /\ bounded s /\ convex t /\ bounded t /\ vec 0 IN relative_interior s /\ vec 0 IN relative_interior t /\ dim s = dim t ==> ?f g. homeomorphism (relative_frontier s,relative_frontier t) (f,g) /\ (?B. !x y. x IN relative_frontier s /\ y IN relative_frontier s ==> norm(f x - f y) <= B * norm(x - y)) /\ (?B. !x y. x IN relative_frontier t /\ y IN relative_frontier t ==> norm(g x - g y) <= B * norm(x - y))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`span s:real^M->bool`; `span t:real^N->bool`] ISOMETRIES_SUBSPACES) THEN ASM_REWRITE_TAC[DIM_SPAN; SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (h:real^M->real^N) s`; `t:real^N->bool`] lemma1) THEN ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; BOUNDED_LINEAR_IMAGE; RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; AFFINE_HULL_LINEAR_IMAGE] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[LINEAR_0; FUN_IN_IMAGE]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_RELATIVE_INTERIOR]) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN SUBGOAL_THEN `relative_frontier (IMAGE h s) = IMAGE (h:real^M->real^N) (relative_frontier s)` SUBST1_TAC THENL [REWRITE_TAC[relative_frontier] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX] THEN ASM_SIMP_TAC[CLOSURE_BOUNDED_LINEAR_IMAGE] THEN MP_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^M->bool` CLOSURE_INC) THEN MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET_SPAN) THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN EXISTS_TAC `(f:real^N->real^N) o (h:real^M->real^N)` THEN EXISTS_TAC `(k:real^N->real^M) o (g:real^N->real^N)` THEN ASM_REWRITE_TAC[o_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `IMAGE (h:real^M->real^N) (relative_frontier s)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[HOMEOMORPHISM; LINEAR_CONTINUOUS_ON] THEN REWRITE_TAC[FORALL_IN_IMAGE; GSYM IMAGE_o; o_DEF; SUBSET] THEN MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET_SPAN) THEN REWRITE_TAC[relative_frontier] THEN ASM SET_TAC[]; SUBGOAL_THEN `!x y. x IN relative_frontier s /\ y IN relative_frontier s ==> norm((h:real^M->real^N) x - h y) = norm(x - y)` (fun th -> ASM_MESON_TAC[LINEAR_SUB; th]) THEN ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC SPAN_SUB THEN RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier; IN_DIFF]) THEN ASM_MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET_SPAN]; SUBGOAL_THEN `!x y. x IN relative_frontier t /\ y IN relative_frontier t ==> ((g:real^N->real^N) x - g y) IN span t` (fun th -> ASM_MESON_TAC[LINEAR_SUB; th]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN DISCH_THEN(MP_TAC o el 3 o CONJUNCTS) THEN MATCH_MP_TAC(SET_RULE `x IN s /\ t SUBSET u ==> IMAGE f s SUBSET t ==> f x IN u`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[relative_frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN REWRITE_TAC[CLOSURE_SUBSET_SPAN]]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY; HOMEOMORPHIC_EMPTY; GSYM homeomorphic]; ALL_TAC] THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_MESON_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1]; STRIP_TAC] THEN SUBGOAL_THEN `~(relative_interior(s:real^M->bool) = {}) /\ ~(relative_interior(t:real^N->bool) = {})` MP_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:real^M`) (X_CHOOSE_TAC `b:real^N`)) THEN MP_TAC(ISPECL [`IMAGE (\x:real^M. --a + x) s`; `IMAGE (\x:real^N. --b + x) t`] lemma2) THEN ASM_REWRITE_TAC[CONVEX_TRANSLATION_EQ; BOUNDED_TRANSLATION_EQ; RELATIVE_INTERIOR_TRANSLATION; AFFINE_HULL_TRANSLATION] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN ANTS_TAC THENL [MATCH_MP_TAC(MESON[INT_OF_NUM_EQ] `aff_dim s = aff_dim t /\ aff_dim s = &(dim s) /\ aff_dim t = &(dim t) ==> dim(s:real^M->bool) = dim(t:real^N->bool)`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC AFF_DIM_DIM_0 THEN MATCH_MP_TAC HULL_INC THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_RELATIVE_INTERIOR]) THEN ASM_REWRITE_TAC[UNWIND_THM2]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; RELATIVE_FRONTIER_TRANSLATION] THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN EXISTS_TAC `\x. b + (f:real^M->real^N) (--a + x)` THEN EXISTS_TAC `\x. a + (g:real^N->real^M) (--b + x)` THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN REWRITE_TAC[HOMEOMORPHISM; FORALL_IN_IMAGE; GSYM IMAGE_o] THEN SIMP_TAC[VECTOR_ARITH `--a + a + x:real^N = x`; VECTOR_ARITH `a + --a + x:real^N = x`] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN ASM_REWRITE_TAC[IMAGE_o] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; IMAGE_ID; SUBSET_REFL]; MATCH_MP_TAC CONTINUOUS_ON_ADD THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN ASM_REWRITE_TAC[IMAGE_o] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; IMAGE_ID; SUBSET_REFL]]);; (* ------------------------------------------------------------------------- *) (* More about affine dimension of special sets. *) (* ------------------------------------------------------------------------- *) let AFF_DIM_NONEMPTY_INTERIOR_EQ = prove (`!s:real^N->bool. convex s ==> (aff_dim s = &(dimindex (:N)) <=> ~(interior s = {}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[AFF_DIM_NONEMPTY_INTERIOR] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` EMPTY_INTERIOR_SUBSET_HYPERPLANE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_SUBSET) THEN ASM_SIMP_TAC[AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);; let AFF_DIM_BALL = prove (`!a:real^N r. aff_dim(ball(a,r)) = if &0 < r then &(dimindex(:N)) else --(&1)`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [MATCH_MP_TAC AFF_DIM_OPEN THEN ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT; GSYM BALL_EQ_EMPTY]) THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY]]);; let AFF_DIM_CBALL = prove (`!a:real^N r. aff_dim(cball(a,r)) = if &0 < r then &(dimindex(:N)) else if r = &0 then &0 else --(&1)`, REPEAT GEN_TAC THEN REPEAT COND_CASES_TAC THENL [MATCH_MP_TAC AFF_DIM_NONEMPTY_INTERIOR THEN ASM_REWRITE_TAC[INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[CBALL_SING; AFF_DIM_SING]; MATCH_MP_TAC(MESON[AFF_DIM_EMPTY] `s = {} ==> aff_dim s = --(&1)`) THEN REWRITE_TAC[CBALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC]);; let AFF_DIM_INTERVAL = prove (`(!a b:real^N. aff_dim(interval[a,b]) = if interval[a,b] = {} then --(&1) else &(CARD {i | 1 <= i /\ i <= dimindex(:N) /\ a$i < b$i})) /\ (!a b:real^N. aff_dim(interval(a,b)) = if interval(a,b) = {} then --(&1) else &(dimindex(:N)))`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_OPEN; OPEN_INTERVAL] THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LT_LADD] THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; ENDS_IN_INTERVAL] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{basis i:real^N | 1 <= i /\ i <= dimindex(:N) /\ &0 < (b:real^N)$i}` THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY; VEC_COMPONENT]) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `basis i:real^N = inv(b$i) % (b:real^N)$i % basis i` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID]; MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN SIMP_TAC[IN_INTERVAL; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN X_GEN_TAC `j:num` THEN REWRITE_TAC[VEC_COMPONENT] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL]]; MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN; SUBSET; IN_INTERVAL; VEC_COMPONENT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_CASES_TAC `&0 < (b:real^N)$i` THENL [MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; SUBGOAL_THEN `(x:real^N)$i = &0` (fun th -> REWRITE_TAC[th; VECTOR_MUL_LZERO; SPAN_0]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN REWRITE_TAC[SET_RULE `~(a IN {f x | P x}) <=> !x. P x ==> ~(f x = a)`] THEN SIMP_TAC[BASIS_NONZERO; pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_IN_GSPEC; BASIS_INJ_EQ; ORTHOGONAL_BASIS_BASIS]; GEN_REWRITE_TAC LAND_CONV [SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; BASIS_INJ_EQ; HAS_SIZE] THEN SIMP_TAC[CONJ_ASSOC; GSYM IN_NUMSEG; FINITE_RESTRICT; FINITE_NUMSEG]]);; (* ------------------------------------------------------------------------- *) (* A complete graph of |R|-many vertices can be embedded in R^3 with the *) (* edges as straight-line segments that intersect only at common endpoints. *) (* Basically, you just scatter the points onto the twisted cubic. *) (* ------------------------------------------------------------------------- *) let GRAPH_EMBEDS_IN_R3 = prove (`!s:A->bool. s <=_c (:real) ==> ?v:A->real^3. (!a b. a IN s /\ b IN s ==> (v a = v b <=> a = b)) /\ (!a b c d. ~({v a,v b} = {v c,v d}) ==> segment[v a,v b] INTER segment[v c,v d] SUBSET {v a,v b} INTER {v c,v d})`, SUBGOAL_THEN `?v:real->real^3. (!a b. v a = v b <=> a = b) /\ (!a b c d. ~({v a,v b} = {v c,v d}) ==> segment[v a,v b] INTER segment[v c,v d] SUBSET {v a,v b} INTER {v c,v d})` STRIP_ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `s:A->bool` THEN REWRITE_TAC[le_c; IN_UNIV; INJECTIVE_ON_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `f:A->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(v:real->real^3) o (f:A->real)` THEN ASM_REWRITE_TAC[o_THM]] THEN ABBREV_TAC `v:real->real^3 = \x. vector[x; x pow 2; x pow 3]` THEN EXISTS_TAC `v:real->real^3` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM INJECTIVE_ALT] THEN EXPAND_TAC "v" THEN SIMP_TAC[CART_EQ; FORALL_3; DIMINDEX_3; VECTOR_3]; DISCH_TAC] THEN SUBGOAL_THEN `!a b c d. PAIRWISE (\x y. ~(x = y)) [a;b;c;d] ==> aff_dim (IMAGE (v:real->real^3) {a,b,c,d}) = &3` (LABEL_TAC "COPLANAR") THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(v:real->real^3) a`; `IMAGE (v:real->real^3) {a,b,c,d}`] AFF_DIM_DIM_AFFINE_DIFFS) THEN SIMP_TAC[FUN_IN_IMAGE; IN_INSERT] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; INT_OF_NUM_EQ] THEN REWRITE_TAC[VECTOR_SUB_REFL; DIM_INSERT_0] THEN W(MP_TAC o PART_MATCH (lhand o rand o rand) INDEPENDENT_EQ_DIM_EQ_CARD o lhand o snd) THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SUBGOAL_THEN `~(det(vector[(v:real->real^3) b - (v:real->real^3) a; (v:real->real^3) c - (v:real->real^3) a; (v:real->real^3) d - (v:real->real^3) a]:real^3^3) = &0)` MP_TAC THENL [EXPAND_TAC "v" THEN REWRITE_TAC[DET_3; VECTOR_3; VECTOR_SUB_COMPONENT] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[PAIRWISE; ALL] THEN CONV_TAC REAL_RING; DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] DET_DEPENDENT_ROWS))] THEN REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM numseg; DIMINDEX_3; NUMSEG_CONV `1..3`] THEN SIMP_TAC[row; IMAGE_CLAUSES; DIMINDEX_3; LAMBDA_ETA; VECTOR_3] THEN DISCH_TAC THEN ASM_REWRITE_TAC[independent] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[VECTOR_ARITH `x - z:real^3 = y - z <=> x = y`] THEN RULE_ASSUM_TAC(REWRITE_RULE[PAIRWISE; ALL]) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `!a b c. collinear(IMAGE (v:real->real^3) {a,b,c}) ==> ~PAIRWISE (\x y. ~(x = y)) [a;b;c]` (LABEL_TAC "COLLINEAR") THENL [MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN REMOVE_THEN "COPLANAR" (MP_TAC o SPECL [`abs a + abs b + abs c + &1:real`; `a:real`; `b:real`; `c:real`]) THEN REWRITE_TAC[NOT_IMP] THEN ONCE_REWRITE_TAC[PAIRWISE] THEN ASM_REWRITE_TAC[ALL] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[IMAGE_CLAUSES] THEN REWRITE_TAC[AFF_DIM_INSERT] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_AFF_DIM]) THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(METIS[] `(!a b c d. P a b c d ==> P c d a b /\ P b a c d /\ P a b d c) /\ (!a b c d. ~(a = b) /\ ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d) /\ ~(c = d) ==> P a b c d) /\ (!a b c. P a b c c) /\ (!a b c. ~(a = b) ==> P a b b c) ==> !a b c d. P a b c d`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{a,b} = {b,a}`; SEGMENT_SYM; INTER_ACI] THEN MESON_TAC[]; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`; `d:real`] THEN STRIP_TAC THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `z:real^3` THEN STRIP_TAC THEN REMOVE_THEN "COPLANAR" (MP_TAC o SPECL [`a:real`; `b:real`; `c:real`; `d:real`]) THEN ASM_REWRITE_TAC[PAIRWISE; ALL] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN MATCH_MP_TAC(INT_ARITH `!y:int. x <= y /\ y <= &2 ==> ~(x = &3)`) THEN EXISTS_TAC `aff_dim(z INSERT IMAGE (v:real->real^3) {a,b,c,d})` THEN SIMP_TAC[AFF_DIM_SUBSET; SET_RULE `s SUBSET a INSERT s`] THEN REWRITE_TAC[IMAGE_CLAUSES; GSYM COPLANAR_AFF_DIM] THEN MATCH_MP_TAC COPLANAR_INTERSECTING_LINES THEN ASM_SIMP_TAC[BETWEEN_IMP_COLLINEAR; BETWEEN_IN_SEGMENT]; REWRITE_TAC[SET_RULE `{a,a} = {a}`; SEGMENT_REFL] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[SET_RULE `s INTER {a} SUBSET t INTER {a} <=> a IN s ==> a IN t`] THEN ASM_CASES_TAC `b:real = a` THEN ASM_SIMP_TAC[SEGMENT_REFL; IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN REMOVE_THEN "COLLINEAR" (MP_TAC o SPECL [`a:real`; `c:real`; `b:real`]) THEN ASM_SIMP_TAC[IMAGE_CLAUSES; BETWEEN_IMP_COLLINEAR; BETWEEN_IN_SEGMENT] THEN REWRITE_TAC[PAIRWISE; ALL] THEN ASM_MESON_TAC[]; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN DISCH_TAC THEN ASM_CASES_TAC `collinear {(v:real->real^3) a,v b,v c}` THENL [ALL_TAC; ASM_SIMP_TAC[INTER_SEGMENT] THEN SET_TAC[]] THEN ASM_CASES_TAC `c:real = a` THENL [ASM SET_TAC[]; DISCH_THEN(K ALL_TAC)] THEN REMOVE_THEN "COLLINEAR" (MP_TAC o SPECL [`a:real`; `b:real`; `c:real`]) THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; PAIRWISE; ALL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SEGMENT_REFL] THEN SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Deducing convexity from midpoint convexity in common cases. *) (* ------------------------------------------------------------------------- *) let MIDPOINT_CONVEX_DYADIC_RATIONALS = prove (`!f:real^N->real s. (!x y. x IN s /\ y IN s ==> midpoint(x,y) IN s /\ f(midpoint(x,y)) <= (f(x) + f(y)) / &2) ==> !n m p x y. x IN s /\ y IN s /\ m + p = 2 EXP n ==> (&m / &2 pow n % x + &p / &2 pow n % y) IN s /\ f(&m / &2 pow n % x + &p / &2 pow n % y) <= &m / &2 pow n * f x + &p / &2 pow n * f y`, REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `m + p = 2 EXP 0 <=> m = 0 /\ p = 1 \/ m = 1 /\ p = 0`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN REAL_ARITH_TAC; MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ADD_SYM; REAL_ADD_SYM; ADD_SYM] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `p:num`] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[EXP; real_pow] THEN STRIP_TAC THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * inv(&2) * y = inv(&2) * x * y`] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM VECTOR_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM VECTOR_ADD_LDISTRIB] THEN SUBGOAL_THEN `2 EXP n <= p` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&p * inv(&2 pow n) = &(p - 2 EXP n) * inv(&2 pow n) + &1` SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_SUB_RDISTRIB; REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN REAL_ARITH_TAC; REWRITE_TAC[VECTOR_ADD_RDISTRIB; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[VECTOR_MUL_LID; REAL_MUL_LID] THEN REWRITE_TAC[VECTOR_ADD_ASSOC; REAL_ADD_ASSOC] THEN REWRITE_TAC[GSYM midpoint; GSYM real_div] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o funpow 3 lhand o snd)) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[] THEN REAL_ARITH_TAC]]]);; let CONTINUOUS_MIDPOINT_CONVEX = prove (`!f:real^N->real s. (lift o f) continuous_on s /\ convex s /\ (!x y. x IN s /\ y IN s ==> f(midpoint(x,y)) <= (f(x) + f(y)) / &2) ==> f convex_on s`, REWRITE_TAC[midpoint] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[convex_on] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `u + v = &1 <=> v = &1 - u`; IMP_CONJ] THEN REWRITE_TAC[FORALL_UNWIND_THM2; REAL_SUB_LE] THEN REWRITE_TAC[FORALL_DROP; GSYM DROP_VEC; IMP_IMP; GSYM IN_INTERVAL_1] THEN MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN SIMP_TAC[CONVEX_INTERVAL; INTERIOR_CLOSED_INTERVAL; CLOSURE_CLOSED; CLOSED_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop] THEN DISCH_THEN(fun th -> SUBST1_TAC(SYM th) THEN ASSUME_TAC th) THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= b <=> a - b <= &0`] THEN MATCH_MP_TAC CONTINUOUS_LE_ON_CLOSURE THEN REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; GSYM FORALL_DROP; DROP_VEC] THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_ADD; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THENL [REPLICATE_TAC 2 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; LIFT_SUB; CONTINUOUS_ON_SUB]; MAP_EVERY X_GEN_TAC [`n:num`; `i:real`] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LT_POW2] THEN ASM_CASES_TAC `&0 <= i` THEN ASM_SIMP_TAC[INTEGER_POS] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`] MIDPOINT_CONVEX_DYADIC_RATIONALS) THEN ANTS_TAC THENL [ASM_SIMP_TAC[midpoint] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SPECL [`n:num`; `m:num`; `2 EXP n - m`; `x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < y ==> (y - x) / y = &1 - x / y`] THEN REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Slightly shaper separating/supporting hyperplane results. *) (* ------------------------------------------------------------------------- *) let SEPARATING_HYPERPLANE_RELATIVE_INTERIORS = prove (`!s t. convex s /\ convex t /\ ~(s = {} /\ t = (:real^N) \/ s = (:real^N) /\ t = {}) /\ DISJOINT (relative_interior s) (relative_interior t) ==> ?a b. ~(a = vec 0) /\ (!x. x IN s ==> a dot x <= b) /\ (!x. x IN t ==> a dot x >= b)`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIV_NOT_EMPTY; CONVEX_EMPTY; RELATIVE_INTERIOR_EMPTY] THEN STRIP_TAC THENL [EXISTS_TAC `basis 1:real^N` THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^N` o MATCH_MP (SET_RULE `~(s = UNIV) ==> ?a. ~(a IN s)`)) THEN MP_TAC(ISPECL [`t:real^N->bool`; `x:real^N`] SEPARATING_HYPERPLANE_SET_POINT_INAFF) THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^N` o MATCH_MP (SET_RULE `~(s = UNIV) ==> ?a. ~(a IN s)`)) THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SEPARATING_HYPERPLANE_SET_POINT_INAFF) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; real_ge] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`--a:real^N`; `--b:real`] THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; REAL_LE_NEG2]; MP_TAC(ISPECL [`relative_interior s:real^N->bool`; `relative_interior t:real^N->bool`] SEPARATING_HYPERPLANE_SETS) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; CONVEX_RELATIVE_INTERIOR] THEN SIMP_TAC[real_ge] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC (MESON[CONVEX_CLOSURE_RELATIVE_INTERIOR; CLOSURE_SUBSET; SUBSET] `convex s /\ (!x. x IN closure(relative_interior s) ==> P x) ==> !x. x IN s ==> P x`) THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC CONTINUOUS_LE_ON_CLOSURE; MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE] THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT]]);; let SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY = prove (`!s x:real^N. convex s /\ x IN s /\ ~(x IN relative_interior s) ==> ?a. ~(a = vec 0) /\ (!y. y IN s ==> a dot x <= a dot y) /\ (!y. y IN relative_interior s ==> a dot x < a dot y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`relative_interior s:real^N->bool`; `x:real^N`] SEPARATING_HYPERPLANE_SET_POINT_INAFF) THEN ASM_SIMP_TAC[CONVEX_SING; CONVEX_RELATIVE_INTERIOR; RELATIVE_INTERIOR_EQ_EMPTY; real_ge] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`lift o (\x:real^N. a dot x)`; `relative_interior s:real^N->bool`; `y:real^N`; `(a:real^N) dot x`; `1`] CONTINUOUS_ON_CLOSURE_COMPONENT_GE) THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT; GSYM drop; o_THM; LIFT_DROP] THEN ASM_SIMP_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN ASM_MESON_TAC[CLOSURE_SUBSET; REAL_LE_TRANS; SUBSET]; DISCH_TAC] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN DISCH_TAC THEN UNDISCH_TAC `(y:real^N) IN relative_interior s` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_INTER; IN_CBALL] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `y + --(e / norm(a)) % ((x + a) - x):real^N`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[NORM_ARITH `dist(y:real^N,y + e) = norm e`; VECTOR_ADD_SUB] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC HULL_MONO THEN ASM_REWRITE_TAC[INSERT_SUBSET; RELATIVE_INTERIOR_SUBSET]; REWRITE_TAC[VECTOR_ADD_SUB] THEN DISCH_TAC THEN UNDISCH_TAC `!y:real^N. y IN s ==> a dot x <= a dot y` THEN DISCH_THEN(MP_TAC o SPEC `y + --(e / norm(a)) % a:real^N`) THEN ASM_REWRITE_TAC[DOT_RMUL; DOT_RNEG; DOT_RADD] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x * y ==> ~(a <= a + --x * y)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]]);; let SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER = prove (`!s x:real^N. convex s /\ x IN relative_frontier s ==> ?a. ~(a = vec 0) /\ (!y. y IN closure s ==> a dot x <= a dot y) /\ (!y. y IN relative_interior s ==> a dot x < a dot y)`, REWRITE_TAC[relative_frontier; IN_DIFF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `x:real^N`] SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY) THEN ASM_SIMP_TAC[CONVEX_CLOSURE; CONVEX_RELATIVE_INTERIOR_CLOSURE]);; let SUPPORTING_HYPERPLANE_FRONTIER = prove (`!s x:real^N. convex s /\ x IN frontier s ==> ?a. ~(a = vec 0) /\ !y. y IN closure s ==> a dot x <= a dot y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interior s:real^N->bool = {}` THENL [STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` EMPTY_INTERIOR_SUBSET_HYPERPLANE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN ASM_REWRITE_TAC[SUBSET; CLOSURE_HYPERPLANE; IN_ELIM_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN ASM_SIMP_TAC[REAL_LE_REFL]; ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_NONEMPTY_INTERIOR] THEN DISCH_THEN(MP_TAC o MATCH_MP SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Containment of rays in unbounded convex sets. *) (* ------------------------------------------------------------------------- *) let UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY = prove (`!s a:real^N. convex s /\ ~bounded s /\ closed s /\ a IN s ==> ?l. ~(l = vec 0) /\ !t. &0 <= t ==> (a + t % l) IN s`, GEN_GEOM_ORIGIN_TAC `a:real^N` ["l"] THEN REWRITE_TAC[VECTOR_ADD_LID] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [BOUNDED_POS]) THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&n + &1:real`) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[REAL_NOT_LE; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:num->real^N` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!n. ~((x:num->real^N) n = vec 0)` ASSUME_TAC THENL [ASM_MESON_TAC[NORM_ARITH `~(&n + &1 < norm(vec 0:real^N))`]; ALL_TAC] THEN MP_TAC(ISPEC `sphere(vec 0:real^N,&1)` compact) THEN REWRITE_TAC[COMPACT_SPHERE] THEN DISCH_THEN(MP_TAC o SPEC `\n. inv(norm(x n)) % (x:num->real^N) n`) THEN ASM_SIMP_TAC[IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; ALL_TAC] THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN MATCH_MP_TAC CLOSED_CONTAINS_SEQUENTIAL_LIMIT THEN SUBGOAL_THEN `?N:num. !n. N <= n ==> t / norm(x n:real^N) <= &1` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT] THEN MP_TAC(SPEC `t:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; REAL_MUL_LID] THEN ASM_MESON_TAC[REAL_ARITH `t <= m /\ m <= n /\ n + &1 < x ==> t <= x`]; EXISTS_TAC `\n:num. t / norm((x:num->real^N)(r(N + n))) % x(r(N + n))` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `N + n:num` o MATCH_MP MONOTONE_BIGGER) THEN ARITH_TAC; REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC LIM_CMUL THEN ONCE_REWRITE_TAC[ADD_SYM] THEN FIRST_ASSUM(MP_TAC o SPEC `N:num` o MATCH_MP SEQ_OFFSET) THEN ASM_REWRITE_TAC[]]]);; let CONVEX_CLOSED_CONTAINS_SAME_RAY = prove (`!s a b l:real^N. convex s /\ closed s /\ b IN s /\ (!t. &0 <= t ==> (a + t % l) IN s) ==> !t. &0 <= t ==> (b + t % l) IN s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_IN_CLOSED_SET) THEN EXISTS_TAC `\n. (&1 - t / (&n + &1)) % b + t / (&n + &1) % (a + (&n + &1) % l):real^N` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(SPEC `t:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_ARITH `&0 <= &n + &1`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[VECTOR_ARITH `(&1 - u) % b + u % c:real^N = b + u % (c - b)`] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_SUB_LDISTRIB] THEN SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD `t / (&n + &1) * (&n + &1) = t`] THEN SIMP_TAC[VECTOR_ARITH `(v % a + b) - v % c:real^N = b + v % (a - c)`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[real_div; VECTOR_ARITH `(x * y) % a:real^N = y % x % a`] THEN MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN EXISTS_TAC `norm(t % (a - b):real^N)` THEN REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE; o_DEF] THEN MP_TAC(MATCH_MP SEQ_OFFSET SEQ_HARMONIC) THEN SIMP_TAC[REAL_OF_NUM_ADD]]);; let UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS = prove (`!s:real^N->bool. convex s /\ ~bounded s /\ closed s ==> ?l. ~(l = vec 0) /\ !a t. a IN s /\ &0 <= t ==> (a + t % l) IN s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY; CONVEX_CLOSED_CONTAINS_SAME_RAY]);; let RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY = prove (`!s a:real^N. convex s /\ ~bounded s /\ a IN relative_interior s ==> ?l. ~(l = vec 0) /\ !t. &0 <= t ==> (a + t % l) IN relative_interior s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `a:real^N`] UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY) THEN ASM_SIMP_TAC[CONVEX_CLOSURE; CLOSED_CLOSURE] THEN ANTS_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; SUBSET; CLOSURE_SUBSET; RELATIVE_INTERIOR_SUBSET]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a + t % l:real^N = (a + (&2 * t) % l) - inv(&2) % ((a + (&2 * t) % l) - a)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; let RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY = prove (`!s a b l:real^N. convex s /\ b IN relative_interior s /\ (!t. &0 <= t ==> (a + t % l) IN relative_interior s) ==> !t. &0 <= t ==> (b + t % l) IN relative_interior s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `a:real^N`; `b:real^N`; `l:real^N`] CONVEX_CLOSED_CONTAINS_SAME_RAY) THEN ASM_SIMP_TAC[CONVEX_CLOSURE; CLOSED_CLOSURE] THEN ANTS_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; SUBSET; CLOSURE_SUBSET; RELATIVE_INTERIOR_SUBSET]; DISCH_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a + t % l:real^N = (a + (&2 * t) % l) - inv(&2) % ((a + (&2 * t) % l) - a)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; let RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS = prove (`!s:real^N->bool. convex s /\ ~bounded s ==> ?l. ~(l = vec 0) /\ !a t. a IN relative_interior s /\ &0 <= t ==> (a + t % l) IN relative_interior s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `relative_interior s:real^N->bool = {}` THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; BOUNDED_EMPTY]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY; RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY]);; (* ------------------------------------------------------------------------- *) (* Explicit formulas for interior and relative interior of convex hull. *) (* ------------------------------------------------------------------------- *) let EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL = prove (`!s. FINITE s ==> {y:real^N | ?u. (!x. x IN s ==> &0 < u x /\ u x < &1) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y} SUBSET relative_interior(convex hull s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[EMPTY_GSPEC; EMPTY_SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN CONJ_TAC THENL [REWRITE_TAC[CONVEX_HULL_FINITE; SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[open_in; IN_ELIM_THM] THEN CONJ_TAC THENL [REWRITE_TAC[AFFINE_HULL_FINITE; SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `e = inf (IMAGE (\x:real^N. min (&1 - u x) (u x)) s)` THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [EXPAND_TAC "e" THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FORALL_IN_IMAGE]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE (\z:real^N. z - y) (affine hull s)` BASIS_EXISTS) THEN REWRITE_TAC[SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` (CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) MP_TAC)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; HAS_SIZE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[SPAN_FINITE; IN_ELIM_THM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `compo:real^N->real^N->real`) THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN SUBGOAL_THEN `!i. i IN b ==> ?u. sum s u = &0 /\ vsum s (\x:real^N. u x % x) = i` MP_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^N) IN affine hull s` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[AFFINE_HULL_FINITE; IN_ELIM_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\x. v x - u x):real^N->real` THEN ASM_SIMP_TAC[SUM_SUB; VSUM_SUB; VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_SUB_REFL; VECTOR_SUB_RZERO]; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM; TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->real^N->real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `e / B / (&1 + sum (b:real^N->bool) (\i. abs(sup(IMAGE (abs o w i) (s:real^N->bool)))))` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; SUM_POS_LE; REAL_ABS_POS] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. u x + sum (b:real^N->bool) (\i. compo (z:real^N) i * w i x)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_ADD; REAL_ARITH `&1 + x = &1 <=> x = &0`] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN ASM_SIMP_TAC[SUM_LMUL; ETA_AX; REAL_MUL_RZERO; SUM_0]; ASM_SIMP_TAC[VSUM_ADD; VECTOR_ADD_RDISTRIB] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `y + w:real^N = z <=> w = z - y`] THEN ASM_SIMP_TAC[GSYM VSUM_LMUL; GSYM VSUM_RMUL; GSYM VECTOR_MUL_ASSOC] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o lhand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[VSUM_LMUL] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum b (\v:real^N. compo (z:real^N) v % v)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[]] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) < min u (&1 - u) ==> &0 < u + x /\ u + x < &1`) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(z - y:real^N) * sum (b:real^N->bool) (\i. abs(sup(IMAGE (abs o w i) (s:real^N->bool))))` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_ABS_LE THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_ASSOC] THEN X_GEN_TAC `i:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`(compo:real^N->real^N->real) z`; `i:real^N`]) THEN ASM_SIMP_TAC[]; MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE; o_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x * (&1 + e) < d ==> x * e < d`) THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[NORM_POS_LE; GSYM REAL_LT_RDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; SUM_POS_LE; REAL_ABS_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `dist(z:real^N,y) < k ==> k <= d ==> norm(z - y) < d`)) THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; SUM_POS_LE; REAL_ABS_POS] THEN EXPAND_TAC "e" THEN ASM_SIMP_TAC[REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL = prove (`!s. FINITE s ==> {y:real^N | ?u. (!x. x IN s ==> &0 < u x) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y} SUBSET relative_interior(convex hull s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[EMPTY_GSPEC; EMPTY_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `s = {a:real^N}` THENL [ASM_REWRITE_TAC[SUM_SING; VSUM_SING; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[RELATIVE_INTERIOR_SING; CONVEX_HULL_SING] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_SING] THEN MESON_TAC[VECTOR_MUL_LID]; FIRST_ASSUM(MP_TAC o MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `w:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `sum {x,y} u <= sum s (u:real^N->real)` MP_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; REAL_LT_IMP_LE; IN_DIFF] THEN ASM SET_TAC[]; ASM_SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MATCH_MP_TAC(REAL_ARITH `&0 < y ==> x + y + &0 <= &1 ==> x < &1`) THEN ASM_SIMP_TAC[]]]);; let RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT = prove (`!s. ~(affine_dependent s) ==> relative_interior(convex hull s) = {y:real^N | ?u. (!x. x IN s ==> &0 < u x) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL] THEN ASM_CASES_TAC `?a:real^N. s = {a}` THENL [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC[SUM_SING; VSUM_SING; CONVEX_HULL_SING; RELATIVE_INTERIOR_SING] THEN REWRITE_TAC[IN_ELIM_THM; SUBSET; IN_SING] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real^N. &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID; REAL_LT_01]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `relative_interior s SUBSET s /\ (!x. x IN s /\ ~(x IN t) ==> ~(x IN relative_interior s)) ==> relative_interior s SUBSET t`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN REWRITE_TAC[AFFINE_HULL_CONVEX_HULL; IN_ELIM_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) (MP_TAC o SPEC `u:real^N->real`)) THEN ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_RELATIVE_INTERIOR; DE_MORGAN_THM; SUBSET; IN_ELIM_THM; IN_BALL; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN DISJ2_TAC THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN SUBGOAL_THEN `(u:real^N->real) a = &0` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`]; ALL_TAC] THEN SUBGOAL_THEN `?b:real^N. b IN s /\ ~(b = a)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[];ALL_TAC] THEN SUBGOAL_THEN `?d. &0 < d /\ norm(d % (a - b):real^N) < e` STRIP_ASSUME_TAC THENL [EXISTS_TAC `e / &2 / norm(a - b:real^N)` THEN ASM_SIMP_TAC[NORM_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NORM_POS_LT; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM; REAL_DIV_RMUL; REAL_LT_IMP_NZ; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `y - d % (a - b):real^N`) THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - b) = norm b`] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC IN_AFFINE_SUB_MUL_DIFF THEN ASM_SIMP_TAC[HULL_INC; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[AFFINE_HULL_FINITE; IN_ELIM_THM] THEN EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `~(affine_dependent(s:real^N->bool))` THEN ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE] THEN EXISTS_TAC `\x:real^N. (v x - u x) - (if x = a then --d else if x = b then d else &0)` THEN REWRITE_TAC[VECTOR_SUB_RDISTRIB; MESON[] `(if p then a else b) % x = (if p then a % x else b % x)`] THEN ASM_SIMP_TAC[SUM_SUB; VSUM_SUB] THEN ASM_SIMP_TAC[VSUM_CASES; SUM_CASES; FINITE_RESTRICT; IN_ELIM_THM] THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`; SET_RULE `b IN s /\ ~(b = a) ==> {x | (x IN s /\ ~(x = a)) /\ x = b} = {b}`] THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; SUM_0; VSUM_0; SUM_SING; VSUM_SING] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL = prove (`!s. FINITE s /\ affine hull s = (:real^N) ==> {y | ?u. (!x. x IN s ==> &0 < u x /\ u x < &1) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y} SUBSET interior(convex hull s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_CONVEX_HULL]);; let EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL = prove (`!s. FINITE s /\ affine hull s = (:real^N) ==> {y | ?u. (!x. x IN s ==> &0 < u x) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y} SUBSET interior(convex hull s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_CONVEX_HULL]);; let INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL = prove (`!s:real^N->bool. ~(affine_dependent s) ==> interior(convex hull s) = if CARD(s) <= dimindex(:N) then {} else {y | ?u. (!x. x IN s ==> &0 < u x) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN COND_CASES_TAC THEN ASM_SIMP_TAC[EMPTY_INTERIOR_CONVEX_HULL] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `relative_interior(convex hull s):real^N->bool` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_GT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT]]);; let INTERIOR_CONVEX_HULL_EXPLICIT = prove (`!s:real^N->bool. ~(affine_dependent s) ==> interior(convex hull s) = if CARD(s) <= dimindex(:N) then {} else {y | ?u. (!x. x IN s ==> &0 < u x /\ u x < &1) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `v:real^N` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real^N->real` THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` CHOOSE_SUBSET) THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN DISCH_THEN(MP_TAC o SPEC `2`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `~(c <= n) ==> 1 <= n ==> 2 <= c`)) THEN REWRITE_TAC[DIMINDEX_GE_1]; ALL_TAC] THEN CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `sum {x,y} u <= sum s (u:real^N->real)` MP_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; REAL_LT_IMP_LE; IN_DIFF] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MATCH_MP_TAC(REAL_ARITH `&0 < y ==> x + y + &0 <= &1 ==> x < &1`) THEN ASM_SIMP_TAC[]);; let DISJOINT_RELATIVE_INTERIOR_CONVEX_HULL = prove (`!s:real^N->bool. ~affine_dependent s /\ ~(?a. s = {a}) ==> relative_interior(convex hull s) INTER s = {}`, REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN t ==> ~(x IN s)`] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN X_GEN_TAC `z:real^N` THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN FIRST_X_ASSUM(fun th -> STRIP_ASSUME_TAC(GEN_REWRITE_RULE I [AFFINE_INDEPENDENT_IFF_CARD] th) THEN MP_TAC th) THEN ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE; CONTRAPOS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. (if x = vec 0 then -- &1 else &0) + (u:real^N->real) x` THEN ASM_SIMP_TAC[VECTOR_ADD_RDISTRIB; VSUM_ADD; SUM_ADD] THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[SUM_DELTA; VSUM_DELTA; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID] THEN MATCH_MP_TAC(MESON[] `(?x. ~(x = a) /\ q x) ==> ?x. if x = a then p x else q x`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(?a. s = {a}) ==> vec 0 IN s ==> ?b. ~(b = vec 0) /\ b IN s`)) THEN ASM_MESON_TAC[REAL_LT_IMP_NZ]);; let INTERIOR_CONVEX_HULL_3_MINIMAL = prove (`!a b c:real^2. ~collinear{a,b,c} ==> interior(convex hull {a,b,c}) = {v | ?x y z. &0 < x /\ &0 < y /\ &0 < z /\ x + y + z = &1 /\ x % a + y % b + z % c = v}`, REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN CONV_TAC(LAND_CONV(RATOR_CONV(LAND_CONV(ONCE_DEPTH_CONV(REWRITE_CONV [IN_INSERT; NOT_IN_EMPTY]))))) THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH] THEN SIMP_TAC[FINITE_INSERT; FINITE_UNION; FINITE_EMPTY; RIGHT_EXISTS_AND_THM; AFFINE_HULL_FINITE_STEP_GEN; REAL_LT_ADD; REAL_HALF] THEN REWRITE_TAC[REAL_ARITH `&1 - a - b - c = &0 <=> a + b + c = &1`; VECTOR_ARITH `y - a - b - c:real^N = vec 0 <=> a + b + c = y`]);; let INTERIOR_CONVEX_HULL_3 = prove (`!a b c:real^2. ~collinear{a,b,c} ==> interior(convex hull {a,b,c}) = {v | ?x y z. &0 < x /\ x < &1 /\ &0 < y /\ y < &1 /\ &0 < z /\ z < &1 /\ x + y + z = &1 /\ x % a + y % b + z % c = v}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3_MINIMAL] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Similar results for closure and (relative or absolute) frontier. *) (* ------------------------------------------------------------------------- *) let CLOSURE_CONVEX_HULL = prove (`!s. compact s ==> closure(convex hull s) = convex hull s`, SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL]);; let RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT = prove (`!s:real^N->bool. ~(affine_dependent s) ==> relative_frontier(convex hull s) = {y | ?u. (!x. x IN s ==> &0 <= u x) /\ (?x. x IN s /\ u x = &0) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y}`, REPEAT STRIP_TAC THEN REWRITE_TAC[relative_frontier; UNIONS_GSPEC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN ASM_SIMP_TAC[CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN ASM_SIMP_TAC[CONVEX_HULL_FINITE; RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `u:real^N->real`) THEN ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (~(&0 < x) <=> x = &0)`] THEN DISCH_TAC THEN EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN CONJ_TAC THENL [EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_DEPENDENT_EXPLICIT]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `(\x. u x - v x):real^N->real`] THEN ASM_SIMP_TAC[SUBSET_REFL; VECTOR_SUB_RDISTRIB; SUM_SUB; VSUM_SUB] THEN REWRITE_TAC[REAL_SUB_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[REAL_LT_REFL]]);; let FRONTIER_CONVEX_HULL_EXPLICIT = prove (`!s:real^N->bool. ~(affine_dependent s) ==> frontier(convex hull s) = {y | ?u. (!x. x IN s ==> &0 <= u x) /\ (dimindex(:N) < CARD s ==> ?x. x IN s /\ u x = &0) /\ sum s u = &1 /\ vsum s (\x. u x % x) = y}`, REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN DISJ_CASES_TAC (ARITH_RULE `CARD(s:real^N->bool) <= dimindex(:N) \/ dimindex(:N) < CARD(s:real^N->bool)`) THENL [ASM_SIMP_TAC[GSYM NOT_LE; INTERIOR_CONVEX_HULL_EXPLICIT] THEN ASM_SIMP_TAC[CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT; DIFF_EMPTY] THEN REWRITE_TAC[CONVEX_HULL_FINITE]; ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT] THEN REWRITE_TAC[relative_frontier] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN EXISTS_TAC `affine hull s:real^N->bool` THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_SPAN_GT; HULL_MONO; HULL_SUBSET]]);; let RELATIVE_FRONTIER_CONVEX_HULL_CASES = prove (`!s:real^N->bool. ~(affine_dependent s) ==> relative_frontier(convex hull s) = UNIONS { convex hull (s DELETE a) |a| a IN s }`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS_GSPEC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; CONVEX_HULL_FINITE] THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[IN_DELETE; SUM_DELETE; VSUM_DELETE; REAL_SUB_RZERO] THEN VECTOR_ARITH_TAC; REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC))) THEN EXISTS_TAC `(\x. if x = a then &0 else u x):real^N->real` THEN ASM_SIMP_TAC[COND_RAND; COND_RATOR; REAL_LE_REFL; COND_ID] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[GSYM DELETE; SUM_0; VSUM_0; REAL_ADD_LID; VECTOR_ADD_LID]]);; let FRONTIER_CONVEX_HULL_CASES = prove (`!s:real^N->bool. ~(affine_dependent s) ==> frontier(convex hull s) = if CARD(s) <= dimindex(:N) then convex hull s else UNIONS { convex hull (s DELETE a) |a| a IN s }`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN ASM_SIMP_TAC[frontier; CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT; DIFF_EMPTY]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_CONVEX_HULL_CASES] THEN ASM_SIMP_TAC[relative_frontier; frontier; CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE]) THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN EXISTS_TAC `affine hull s:real^N->bool` THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_SPAN_GT; HULL_MONO; HULL_SUBSET]);; let IN_FRONTIER_CONVEX_HULL = prove (`!s x:real^N. FINITE s /\ CARD s <= dimindex(:N) + 1 /\ x IN s ==> x IN frontier(convex hull s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `affine_dependent(s:real^N->bool)` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [affine_dependent]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[frontier; CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN ASM_SIMP_TAC[HULL_INC; IN_DIFF] THEN MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> ~(x IN s)`) THEN EXISTS_TAC `interior(affine hull s):real^N->bool` THEN SIMP_TAC[SUBSET_INTERIOR; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[HULL_REDUNDANT] THEN MATCH_MP_TAC EMPTY_INTERIOR_AFFINE_HULL THEN ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[FRONTIER_CONVEX_HULL_CASES] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[HULL_INC] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> ~(s = {x}) ==> ?y. y IN s /\ ~(y = x)`)) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[NOT_LT; NOT_IN_EMPTY; ARITH_SUC; DIMINDEX_GE_1]; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]]]);; let NOT_IN_INTERIOR_CONVEX_HULL = prove (`!s x:real^N. FINITE s /\ CARD s <= dimindex(:N) + 1 /\ x IN s ==> ~(x IN interior(convex hull s))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP IN_FRONTIER_CONVEX_HULL) THEN SIMP_TAC[frontier; IN_DIFF]);; let INTERIOR_CONVEX_HULL_EQ_EMPTY = prove (`!s:real^N->bool. s HAS_SIZE (dimindex(:N) + 1) ==> (interior(convex hull s) = {} <=> affine_dependent s)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN ASM_CASES_TAC `affine_dependent(s:real^N->bool)` THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [affine_dependent]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[frontier; CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN ASM_SIMP_TAC[HULL_INC; IN_DIFF] THEN MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN EXISTS_TAC `interior(affine hull s):real^N->bool` THEN SIMP_TAC[SUBSET_INTERIOR; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[HULL_REDUNDANT] THEN MATCH_MP_TAC EMPTY_INTERIOR_AFFINE_HULL THEN ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; ARITH_RULE `~(n + 1 <= n)`] THEN EXISTS_TAC `vsum s (\x:real^N. inv(&(dimindex(:N)) + &1) % x)` THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\x:real^N. inv(&(dimindex(:N)) + &1)` THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN ASM_SIMP_TAC[SUM_CONST; GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD]);; (* ------------------------------------------------------------------------- *) (* Similar things in special case (could use above as lemmas here instead). *) (* ------------------------------------------------------------------------- *) let SIMPLEX_EXPLICIT = prove (`!s:real^N->bool. FINITE s /\ ~(vec 0 IN s) ==> convex hull (vec 0 INSERT s) = { y | ?u. (!x. x IN s ==> &0 <= u x) /\ sum s u <= &1 /\ vsum s (\x. u x % x) = y}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_FINITE; FINITE_INSERT] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; IN_INSERT] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N`) THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `\x:real^N. if x = vec 0 then &1 - sum (s:real^N->bool) u else u(x)` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[REAL_SUB_LE]; MATCH_MP_TAC(REAL_ARITH `s = t ==> &1 - s + t = &1`) THEN MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[]]]);; let STD_SIMPLEX = prove (`convex hull (vec 0 INSERT { basis i | 1 <= i /\ i <= dimindex(:N)}) = {x:real^N | (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i) /\ sum (1..dimindex(:N)) (\i. x$i) <= &1 }`, W(MP_TAC o PART_MATCH (lhs o rand) SIMPLEX_EXPLICIT o lhs o snd) THEN ANTS_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE; GSYM IN_NUMSEG] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IN_IMAGE] THEN REWRITE_TAC[IN_NUMSEG] THEN MESON_TAC[BASIS_NONZERO]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION] THEN ONCE_REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IN_NUMSEG] THEN SUBGOAL_THEN `!u. sum (IMAGE (basis:num->real^N) (1..dimindex(:N))) u = sum (1..dimindex(:N)) (u o basis)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[IN_NUMSEG] THEN REWRITE_TAC[GSYM CONJ_ASSOC; BASIS_INJ]; ALL_TAC] THEN SUBGOAL_THEN `!u. vsum (IMAGE (basis:num->real^N) (1..dimindex(:N))) u = vsum (1..dimindex(:N)) ((u:real^N->real^N) o basis)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC VSUM_IMAGE THEN REWRITE_TAC[IN_NUMSEG] THEN REWRITE_TAC[GSYM CONJ_ASSOC; BASIS_INJ; FINITE_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[o_DEF; BASIS_EXPANSION_UNIQUE; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_NUMSEG] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x <= &1 ==> x = y ==> y <= &1`)) THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_NUMSEG]; STRIP_TAC THEN EXISTS_TAC `\y:real^N. y dot x` THEN ASM_SIMP_TAC[DOT_BASIS]]);; let INTERIOR_STD_SIMPLEX = prove (`interior (convex hull (vec 0 INSERT { basis i | 1 <= i /\ i <= dimindex(:N)})) = {x:real^N | (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 < x$i) /\ sum (1..dimindex(:N)) (\i. x$i) < &1 }`, REWRITE_TAC[EXTENSION; IN_INTERIOR; IN_ELIM_THM; STD_SIMPLEX] THEN REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[DIST_REFL] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN CONJ_TAC THENL [X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x - (e / &2) % basis k:real^N`) THEN REWRITE_TAC[NORM_ARITH `dist(x,x - e) = norm(e)`; NORM_MUL] THEN ASM_SIMP_TAC[NORM_BASIS; REAL_ARITH `&0 < e ==> abs(e / &2) * &1 < e`; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN DISCH_THEN(MP_TAC o SPEC `k:num` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `x + (e / &2) % basis 1:real^N`) THEN REWRITE_TAC[NORM_ARITH `dist(x,x + e) = norm(e)`; NORM_MUL] THEN ASM_SIMP_TAC[NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> abs(e / &2) * &1 < e`] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC(REAL_ARITH `x < y ==> y <= &1 ==> ~(x = &1)`) THEN MATCH_MP_TAC SUM_LT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> ~(a /\ b ==> ~c)`] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC; EXISTS_TAC `1` THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1]] THEN ASM_REAL_ARITH_TAC]; STRIP_TAC THEN EXISTS_TAC `min (inf(IMAGE (\i. (x:real^N)$i) (1..dimindex(:N)))) ((&1 - sum (1..dimindex(:N)) (\i. x$i)) / &(dimindex(:N)))` THEN ASM_SIMP_TAC[REAL_LT_MIN] THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < x <=> 1 <= x`; DIMINDEX_GE_1] THEN ASM_REWRITE_TAC[IN_NUMSEG; REAL_MUL_LZERO; REAL_SUB_LT] THEN REPEAT(POP_ASSUM(K ALL_TAC)) THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `abs(xk - yk) <= d ==> d < xk ==> &0 <= yk`); GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN MATCH_MP_TAC(REAL_ARITH `s2 <= s0 + s1 ==> s0 < &1 - s1 ==> s2 <= &1`) THEN REWRITE_TAC[GSYM SUM_ADD_NUMSEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(y - x) <= z ==> x <= z + y`)] THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist; COMPONENT_LE_NORM]]);; (* ------------------------------------------------------------------------- *) (* Barycentres. *) (* ------------------------------------------------------------------------- *) let barycentre = new_definition `barycentre s = if FINITE s then vsum s (\x. inv(&(CARD s)) % x) else vec 0`;; let BARYCENTRE_0 = prove (`barycentre {} = vec 0`, REWRITE_TAC[barycentre; FINITE_EMPTY; VSUM_CLAUSES]);; let BARYCENTRE_1 = prove (`!a:real^N. barycentre {a} = a`, REWRITE_TAC[barycentre; VSUM_SING; FINITE_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[CARD_SING; REAL_INV_1; VECTOR_MUL_LID]);; let BARYCENTRE_2 = prove (`!a b:real^N. barycentre {a,b} = midpoint(a,b)`, SIMP_TAC[barycentre; FINITE_INSERT; FINITE_EMPTY; NOT_INSERT_EMPTY; VSUM_CLAUSES; NOT_IN_EMPTY; IN_SING; midpoint] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC VECTOR_ARITH);; let BARYCENTRE_IN_RELATIVE_INTERIOR = prove (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> (barycentre s) IN relative_interior(convex hull s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL) THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\x:real^N. inv(&(CARD(s:real^N->bool)))` THEN ASM_SIMP_TAC[SUM_CONST; barycentre; REAL_LT_INV_EQ] THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN ASM_SIMP_TAC[CARD_EQ_0; REAL_OF_NUM_EQ; REAL_MUL_RINV]);; let BARYCENTRE_IN_CONVEX_HULL = prove (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> (barycentre s) IN (convex hull s)`, MESON_TAC[BARYCENTRE_IN_RELATIVE_INTERIOR; SUBSET; RELATIVE_INTERIOR_SUBSET]);; let BARYCENTRE_IN_AFFINE_HULL = prove (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> (barycentre s) IN (affine hull s)`, MESON_TAC[BARYCENTRE_IN_CONVEX_HULL; SUBSET; CONVEX_HULL_SUBSET_AFFINE_HULL]);; let BARYCENTRE_TRANSLATION = prove (`!a:real^N s. barycentre (IMAGE (\x. a + x) s) = (if FINITE s /\ ~(s = {}) then a else vec 0) + barycentre s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[BARYCENTRE_0; IMAGE_CLAUSES; VECTOR_ADD_RID] THEN REWRITE_TAC[barycentre] THEN SIMP_TAC[FINITE_IMAGE_INJ_EQ; CARD_IMAGE_INJ; VSUM_IMAGE; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THEN ASM_SIMP_TAC[o_DEF; VECTOR_ADD_LDISTRIB; VSUM_ADD; VSUM_CONST] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; CARD_EQ_0; REAL_OF_NUM_EQ; VECTOR_MUL_LID]);; add_translation_invariants [BARYCENTRE_TRANSLATION];; let BARYCENTRE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> barycentre (IMAGE f s) = f(barycentre s)`, REWRITE_TAC[INJECTIVE_ALT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[barycentre; IMAGE_EQ_EMPTY; FINITE_IMAGE_INJ_EQ; CARD_IMAGE_INJ; VSUM_IMAGE] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINEAR_0]] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF] THEN MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[LINEAR_CMUL]);; add_linear_invariants [BARYCENTRE_LINEAR_IMAGE];; let BARYCENTRE_NOT_IN_SET = prove (`!s:real^N->bool. ~affine_dependent s /\ ~(?a. s = {a}) ==> ~(barycentre s IN s)`, GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DISJOINT_RELATIVE_INTERIOR_CONVEX_HULL) THEN MATCH_MP_TAC(SET_RULE `b IN i ==> i INTER s = {} ==> ~(b IN s)`) THEN MATCH_MP_TAC BARYCENTRE_IN_RELATIVE_INTERIOR THEN ASM_MESON_TAC[AFFINE_INDEPENDENT_IFF_CARD]);; (* ------------------------------------------------------------------------- *) (* Construction of regular polyhedra with given parameters. *) (* ------------------------------------------------------------------------- *) let REGULAR_POLYTOPE_DIST_BARYCENTRE = prove (`!s:real^N->bool n r. s HAS_SIZE n /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(x,y) = r) ==> !x. x IN s ==> dist(barycentre s,x) = sqrt((&n - &1) / (&2 * &n)) * r`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= r` THENL [POP_ASSUM MP_TAC; ASM_SIMP_TAC[NORM_ARITH `~(&0 <= r) ==> ~(dist(x,y) = r)`] THEN ASM_CASES_TAC `(?a:real^N. s = {a})` THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[HAS_SIZE; CARD_SING] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[BARYCENTRE_1; IN_SING; SQRT_0; DIST_REFL; REAL_MUL_LZERO]] THEN ABBREV_TAC `z:real^N = barycentre s` THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(s:real^N->bool)` THEN ASM_REWRITE_TAC[HAS_SIZE] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_SIMP_TAC[barycentre] THEN DISCH_THEN(fun th -> DISCH_TAC THEN STRIP_TAC THEN MP_TAC th) THEN ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[CARD_EQ_0]; ALL_TAC] THEN ASM_SIMP_TAC[VSUM_LMUL; VECTOR_MUL_EQ_0; REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN s ==> sum s (\y:real^N. dist(x,y) pow 2) = (&n - &1) * r pow 2` MP_TAC THENL [REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `sum s (\y:real^N. if y = x then &0 else r pow 2)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DIST_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ASM_SIMP_TAC[SUM_CASES; GSYM DELETE; SUM_0; SUM_CONST; FINITE_DELETE; REAL_ADD_LID; CARD_DELETE; GSYM REAL_OF_NUM_SUB; LE_1]]; REWRITE_TAC[DIST_0] THEN REWRITE_TAC[dist; NORM_POW_2] THEN REWRITE_TAC[VECTOR_ARITH `(x - y:real^N) dot (x - y) = x dot x - &2 * x dot y + y dot y`] THEN ASM_SIMP_TAC[SUM_SUB; SUM_ADD; SUM_CONST; SUM_LMUL] THEN ASM_SIMP_TAC[GSYM DOT_RSUM; DOT_RZERO; REAL_ARITH `x - &2 * &0 + y = x + y`] THEN DISCH_THEN(LABEL_TAC "*")] THEN ASM_REWRITE_TAC[NORM_EQ_SQUARE] THEN SUBGOAL_THEN `sum s (\x. &n * (x dot x) + sum s (\y. y dot y)) = sum s (\x:real^N. (&n - &1) * r pow 2)` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_ADD; SUM_LMUL; SUM_CONST; REAL_OF_NUM_EQ; REAL_RING `n * s + n * s = (n - &1) * n * r <=> n = &0 \/ s = (n - &1) * r / &2`] THEN DISCH_TAC THEN REMOVE_THEN "*" MP_TAC THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `~(n = &0) ==> (n * x + a * r / &2 = a * r <=> x = (a / (&2 * n)) * r)`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_POW_MUL] THEN REWRITE_TAC[REAL_RING `x * r:real = y * r <=> y = x \/ r = &0`] THEN REWRITE_TAC[SQRT_POW2] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[SQRT_LE_0]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_POS; REAL_SUB_LE; REAL_OF_NUM_LE; LE_1]);; let REGULAR_POLYTOPE_EXISTS = prove (`!r s:real^N->bool n. &n <= aff_dim s + &1 /\ &0 < r ==> ?k. k HAS_SIZE n /\ ~affine_dependent k /\ k SUBSET affine hull s /\ (!x y. x IN k /\ y IN k /\ ~(x = y) ==> dist(x,y) = r)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[HAS_SIZE_0; UNWIND_THM2; AFFINE_INDEPENDENT_EMPTY] THEN REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY; GSYM INT_OF_NUM_SUC] THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN STRIP_ASSUME_TAC th) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `n = 0` THENL [UNDISCH_TAC `&n + &1 <= aff_dim(s:real^N->bool) + &1` THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THENL [INT_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN EXISTS_TAC `{a:real^N}` THEN ASM_SIMP_TAC[ARITH; AFFINE_INDEPENDENT_1; SING_SUBSET; HULL_INC] THEN REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 1`] THEN SET_TAC[]; ALL_TAC] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ABBREV_TAC `z:real^N = barycentre k` THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(k:real^N->bool)` THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[HAS_SIZE]] THEN ASM_CASES_TAC `k:real^N->bool = {}` THENL [ASM_REWRITE_TAC[HAS_SIZE; CARD_CLAUSES] THEN MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + v <=> x = v`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`k:real^N->bool`; `n:num`; `r:real`] REGULAR_POLYTOPE_DIST_BARYCENTRE) THEN ASM_REWRITE_TAC[DIST_0] THEN DISCH_TAC THEN MP_TAC(ISPECL [`k:real^N->bool`; `s:real^N->bool`] ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN) THEN MP_TAC(ISPEC `k:real^N->bool` BARYCENTRE_IN_AFFINE_HULL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN affine hull s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; HULL_HULL; HULL_MONO]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM AFFINE_HULL_EQ_SPAN] THEN ANTS_TAC THENL [REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[HULL_HULL; HULL_MONO]; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^N->bool)->int`) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `n + &1:int <= s + &1 ==> k <= n - &1 ==> ~(k = s)`)) THEN ASM_MESON_TAC[AFF_DIM_LE_CARD; HAS_SIZE]; DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC)] THEN ABBREV_TAC `b = (sqrt((&n + &1) / (&2 * &n)) * r) % inv(norm a) % a:real^N` THEN EXISTS_TAC `(b:real^N) INSERT k` THEN SUBGOAL_THEN `norm(b:real^N) = sqrt((&n + &1) / (&2 * &n)) * r` ASSUME_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; SQRT_LE_0] THEN SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_LE_ADD; REAL_POS]; ALL_TAC] THEN SUBGOAL_THEN `~(b:real^N = vec 0)` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM NORM_EQ_0; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN REWRITE_TAC[SQRT_EQ_0; REAL_DIV_EQ_0] THEN REWRITE_TAC[REAL_ENTIRE; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!y:real^N. y IN affine hull k ==> orthogonal b y` ASSUME_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(b:real^N) IN affine hull s` ASSUME_TAC THENL [SUBST1_TAC(VECTOR_ARITH `b:real^N = vec 0 + b`) THEN EXPAND_TAC "b" THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; VECTOR_ADD_LID]; ALL_TAC] THEN SUBGOAL_THEN `~((b:real^N) IN affine hull k)` ASSUME_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_REFL]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN ASM_MESON_TAC[HULL_INC]; MATCH_MP_TAC AFFINE_INDEPENDENT_INSERT THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[INSERT_SUBSET]; REWRITE_TAC[GSYM pairwise; PAIRWISE_INSERT] THEN ASM_REWRITE_TAC[pairwise; NORM_ARITH `dist(b:real^N,y) = r /\ dist(y,b) = r <=> dist(b,y) = r`] THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[NORM_EQ_SQUARE; dist; REAL_LT_IMP_LE; GSYM NORM_POW_2] THEN MP_TAC(ISPECL [`b:real^N`; `--c:real^N`] NORM_ADD_PYTHAGOREAN) THEN ASM_SIMP_TAC[ORTHOGONAL_CLAUSES; HULL_INC] THEN ASM_SIMP_TAC[GSYM VECTOR_SUB; NORM_NEG] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_LE_DIV; REAL_LE_MUL; REAL_POS; REAL_LE_ADD; REAL_LT_IMP_LE; REAL_POW_MUL; REAL_SUB_LE; REAL_OF_NUM_LE; LE_1] THEN UNDISCH_TAC `~(n = 0)` THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD]);; let REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS_ALT = prove (`!r s:real^N->bool a n. &n <= aff_dim s + &1 /\ &0 < r /\ a IN affine hull s /\ ~(n = 0) ==> ?k. k HAS_SIZE n /\ ~affine_dependent k /\ k SUBSET affine hull s /\ barycentre k = a /\ (!x y. x IN k /\ y IN k /\ ~(x = y) ==> dist(x,y) = r) /\ (!x. x IN k ==> dist(a,x) = sqrt((&n - &1) / (&2 * &n)) * r)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`r:real`; `s:real^N->bool`; `n:num`] REGULAR_POLYTOPE_EXISTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\x:real^N. (a - barycentre k) + x) k` THEN REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REGULAR_POLYTOPE_DIST_BARYCENTRE]] THEN ASM_REWRITE_TAC[AFFINE_DEPENDENT_TRANSLATION_EQ] THEN ASM_SIMP_TAC[HAS_SIZE_IMAGE_INJ_EQ; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_CASES_TAC `k:real^N->bool = {}` THENL [ASM_MESON_TAC[CARD_EQ_0]; ALL_TAC] THEN ASM_REWRITE_TAC[BARYCENTRE_TRANSLATION; VECTOR_ARITH `(a - b) + b:real^N = a`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_SIMP_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x - y:real^N = &1 % (x - y)`] THEN MATCH_MP_TAC IN_AFFINE_MUL_DIFF_ADD THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN ASM_MESON_TAC[BARYCENTRE_IN_AFFINE_HULL; SUBSET; HULL_MONO; HULL_HULL]);; let REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS = prove (`!r s:real^N->bool a n. &n <= aff_dim s + &1 /\ &0 < r /\ a IN affine hull s /\ 1 < n ==> ?k. k HAS_SIZE n /\ ~affine_dependent k /\ k SUBSET affine hull s /\ barycentre k = a /\ (!x. x IN k ==> dist(a,x) = r) /\ (!x y. x IN k /\ y IN k /\ ~(x = y) ==> dist(x,y) = sqrt((&2 * &n) / (&n - &1)) * r)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`sqrt((&2 * &n) / (&n - &1)) * r`; `s:real^N->bool`; `a:real^N`; `n:num`] REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS_ALT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[SQRT_LT_0] THEN MATCH_MP_TAC REAL_LT_DIV THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_RING `a * b = &1 ==> a * b * y = y`) THEN REWRITE_TAC[GSYM SQRT_MUL] THEN MATCH_MP_TAC(MESON[SQRT_1] `x = &1 ==> sqrt x = &1`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LT]) THEN CONV_TAC REAL_FIELD]);; (* ------------------------------------------------------------------------- *) (* Continuity of convex functions and related results. *) (* ------------------------------------------------------------------------- *) let CONVEX_IMP_LOCALLY_BOUNDED = prove (`!f s a:real^N. f convex_on s /\ a IN relative_interior s ==> ?e B. &0 < e /\ &0 < B /\ cball(a,e) INTER affine hull s SUBSET s /\ !x. x IN cball(a,e) INTER affine hull s ==> abs(f x) <= B`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `aff_dim(s:real^N->bool) = &0` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFF_DIM_EQ_0]) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` SUBST_ALL_TAC) THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[IN_SING] THEN REWRITE_TAC[AFFINE_HULL_SING; INTER_SUBSET; IN_INTER; IN_SING] THEN MESON_TAC[REAL_ARITH `abs x <= abs x + &1 /\ &0 < abs x + &1`]; ALL_TAC] THEN SUBGOAL_THEN `&1 <= aff_dim(s:real^N->bool)` ASSUME_TAC THENL [MATCH_MP_TAC(INT_ARITH `-- &1:int <= x /\ ~(x = &0) /\ ~(x = -- &1) ==> &1 <= x`) THEN ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN SUBGOAL_THEN `?n. aff_dim(s:real^N->bool) = &n - &1` STRIP_ASSUME_TAC THENL [REWRITE_TAC[INT_EQ_SUB_LADD; INT_OF_NUM_EXISTS] THEN REWRITE_TAC[GSYM INT_LE_SUB_RADD; AFF_DIM_GE; INT_SUB_LZERO]; ALL_TAC] THEN SUBGOAL_THEN `1 < n /\ ~(n = 0)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_LT] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`e:real`; `s:real^N->bool`; `a:real^N`; `n:num`] REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS) THEN ASM_SIMP_TAC[HULL_INC; INT_SUB_ADD; INT_LE_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^N->real`; `k:real^N->bool`] UPPER_BOUND_FINITE_SET_REAL) THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONVEX_ON_CONVEX_HULL_BOUND)) THEN SUBGOAL_THEN `(f:real^N->real) convex_on convex hull k` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONVEX_ON_SUBSET)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[CONVEX_CBALL; SUBSET; IN_CBALL; REAL_LE_REFL]; ASM_MESON_TAC[HULL_MONO; HULL_HULL; SUBSET; CONVEX_HULL_SUBSET_AFFINE_HULL]]; ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN MP_TAC(SPEC `k:real^N->bool` BARYCENTRE_IN_RELATIVE_INTERIOR) THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE; CARD_CLAUSES]; ASM_SIMP_TAC[]] THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL; AFFINE_HULL_CONVEX_HULL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `affine hull k:real^N->bool = affine hull s` ASSUME_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM HULL_HULL] THEN MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN ASM_REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN MP_TAC(ISPECL [`k:real^N->bool`; `k:real^N->bool`] AFF_DIM_UNIQUE) THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[INT_LE_REFL]; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `&1 + abs(b + &2 * abs(f(a:real^N)))` THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; SUBGOAL_THEN `convex hull k SUBSET cball(a:real^N,e)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[CONVEX_CBALL; SUBSET; IN_CBALL; REAL_LE_REFL]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN SUBGOAL_THEN `f convex_on cball(a:real^N,d) INTER affine hull s` MP_TAC THENL [ASM_MESON_TAC[CONVEX_ON_SUBSET]; SIMP_TAC[convex_on]] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `&2 % a - x:real^N`; `&1 / &2`; `&1 / &2`]) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[VECTOR_ARITH `&1 / &2 % x + &1 / &2 % (&2 % a - x):real^N = a`] THEN UNDISCH_TAC `!x:real^N. x IN convex hull k ==> f x <= b` THEN DISCH_THEN(fun th -> MP_TAC(SPEC `&2 % a - x:real^N` th) THEN MP_TAC(SPEC `x:real^N` th) THEN MP_TAC(SPEC `a:real^N` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `&2 % a - x IN cball(a:real^N,d) /\ &2 % a - x IN affine hull s` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,&2 % a - x) = dist(a,x)`] THEN ASM_REWRITE_TAC[GSYM IN_CBALL] THEN REWRITE_TAC[VECTOR_ARITH `&2 % a - x:real^N = &1 % (a - x) + a`] THEN MATCH_MP_TAC IN_AFFINE_MUL_DIFF_ADD THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN ASM_MESON_TAC[SUBSET; CONVEX_HULL_SUBSET_AFFINE_HULL]; ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; let CONVEX_IMP_LOCALLY_LIPSCHITZ = prove (`!f s a:real^N. f convex_on s /\ a IN relative_interior s ==> ?e B. &0 < e /\ &0 < B /\ cball(a,e) INTER affine hull s SUBSET s /\ !x y. x IN cball(a,e) INTER affine hull s /\ y IN cball(a,e) INTER affine hull s ==> abs(f x - f y) <= B * norm(x - y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`; `a:real^N`] CONVEX_IMP_LOCALLY_BOUNDED) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`e:real`; `B:real`] THEN STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN EXISTS_TAC `&4 * B / e` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_ARITH `&0 < &4`] THEN MP_TAC(ISPECL [`a:real^N`; `e / &2`; `e:real`] SUBSET_CBALL) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `!i. (!x y. i x y \/ i y x) /\ (!x y. P x y ==> P y x) /\ (!x y. i x y ==> P x y) ==> !x y. P x y`) THEN EXISTS_TAC `\x y. (f:real^N->real) x <= f y` THEN REWRITE_TAC[REAL_LE_TOTAL] THEN CONJ_TAC THENL [REWRITE_TAC[NORM_SUB; REAL_ABS_SUB] THEN MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[REAL_ARITH `x <= y ==> abs(x - y) = y - x`] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN SUBGOAL_THEN `?z:real^N. dist(a,z) = e /\ z IN affine hull s /\ y IN segment[x,z]` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`cball(a:real^N,e)`; `x:real^N`; `y - x:real^N`] RAY_TO_FRONTIER) THEN REWRITE_TAC[INTERIOR_CBALL; FRONTIER_CBALL] THEN ASM_REWRITE_TAC[IN_BALL; VECTOR_SUB_EQ; BOUNDED_CBALL] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER; IN_CBALL]) THEN ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `x + d % (y - x):real^N` THEN ASM_REWRITE_TAC[GSYM IN_SPHERE] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_INTER; AFFINE_AFFINE_HULL; IN_AFFINE_ADD_MUL_DIFF]; REWRITE_TAC[IN_SEGMENT]] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `y:real^N = (&1 - u) % x + u % (x + d % (y - x)) <=> (u * d - &1) % (y - x) = vec 0`] THEN EXISTS_TAC `inv(d):real` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_IMP_NZ; REAL_MUL_LINV; REAL_SUB_REFL; REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPHERE]) THEN REWRITE_TAC[dist; VECTOR_ARITH `a - (x + d % (y - x)) = --((&1 - d) % (x - a) + d % (y - a))`] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) + norm(y) < e ==> ~(norm(--(x + y)) = e)`) THEN REWRITE_TAC[NORM_MUL] THEN TRANS_TAC REAL_LET_TRANS `abs(&1 - d) * e / &2 + abs d * e / &2` THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER; IN_CBALL]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ON_LEFT_SECANT_MUL]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `z:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_MESON_TAC[SUBSET; IN_CBALL; REAL_LE_REFL; IN_INTER]; ALL_TAC] THEN SUBGOAL_THEN `e / &2 <= norm(z - x:real^N)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `dist(a:real^N,z) = e ==> dist(a,x) <= e / &2 ==> e / &2 <= norm(z - x)`)) THEN ASM_MESON_TAC[IN_INTER; IN_CBALL]; ALL_TAC] THEN ASM_CASES_TAC `z:real^N = x` THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_ARITH `(a * b) / c:real = a / c * b`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [NORM_SUB] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN TRANS_TAC REAL_LE_TRANS `(&4 * B / e) * e / &2` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_FIELD `&0 < e ==> (&4 * B / e) * e / &2 = &2 * B`] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= B /\ abs(y) <= B ==> x - y <= &2 * B`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; IN_CBALL; REAL_LE_REFL; IN_INTER]; MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE]]);; let CONVEX_ON_CONTINUOUS_ON_RELATIVE_INTERIOR = prove (`!f s:real^N->bool. f convex_on s ==> lift o f continuous_on relative_interior s`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`; `a:real^N`] CONVEX_IMP_LOCALLY_LIPSCHITZ) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:real`; `B:real`] THEN STRIP_TAC THEN EXISTS_TAC `min d (e / B)` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; o_DEF; DIST_LIFT] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_RELATIVE_INTERIOR]) THEN ASM_SIMP_TAC[IN_INTER; HULL_INC; IN_CBALL; DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `d < e ==> abs(a - b) <= d ==> abs(b - a) < e`) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN ASM_REWRITE_TAC[NORM_ARITH `norm(a - b:real^N) = dist(b,a)`]);; let CONVEX_ON_CONTINUOUS = prove (`!f s:real^N->bool. open s /\ f convex_on s ==> lift o f continuous_on s`, MESON_TAC[RELATIVE_INTERIOR_OPEN; CONVEX_ON_CONTINUOUS_ON_RELATIVE_INTERIOR]);; let CONVEX_IMP_LIPSCHITZ = prove (`!f:real^N->real s t. f convex_on t /\ compact s /\ s SUBSET relative_interior t ==> ?B. &0 < B /\ !x y. x IN s /\ y IN s ==> abs(f x - f y) <= B * norm(x - y)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN DISCH_TAC THEN SUBGOAL_THEN `?x y a b:real^N. (!n. x n IN s) /\ (!n. y n IN s) /\ a IN s /\ b IN s /\ (x --> a) sequentially /\ (y --> b) sequentially /\ (!n. abs(f(x n) - f(y n)) > &n * norm(x n - y n))` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `&n + &1:real`) THEN REWRITE_TAC[REAL_ARITH `&0 < &n + &1`; NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; GSYM CONJ_ASSOC] THEN MAP_EVERY X_GEN_TAC [`x:num->real^N`; `y:num->real^N`] THEN REWRITE_TAC[FORALL_AND_THM; REAL_NOT_LE] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:num->real^N` o GEN_REWRITE_RULE I [compact]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `r:num->num`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(y:num->real^N) o (r:num->num)` o GEN_REWRITE_RULE I [compact]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `q:num->num`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(x:num->real^N) o (r:num->num) o (q:num->num)`; `(y:num->real^N) o (r:num->num) o (q:num->num)`; `a:real^N`; `b:real^N`] THEN ASM_SIMP_TAC[o_ASSOC; o_THM; LIM_SUBSEQUENCE] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE] o SPEC `(r:num->num) ((q:num->num) n)`) THEN MATCH_MP_TAC(REAL_ARITH `b <= a ==> ~(x <= a) ==> x > b`) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= b + &1`) THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `b:real^N = a` SUBST_ALL_TAC THENL [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. (y:num->real^N) n - x n` THEN ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. abs(f(y n) - f(x n:real^N)) / &n` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL [EXISTS_TAC `1` THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[NORM_SUB; REAL_ABS_SUB] THEN ASM_SIMP_TAC[REAL_ARITH `b:real > a ==> a <= b`]; REWRITE_TAC[real_div; LIFT_CMUL] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = abs(f(b:real^N) - f a) % vec 0`) THEN MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[SEQ_HARMONIC; o_DEF] THEN REWRITE_TAC[GSYM NORM_LIFT; LIFT_SUB] THEN MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN CONJ_TAC THEN MP_TAC(ISPECL [`lift o (f:real^N->real)`; `relative_interior t:real^N->bool`] CONTINUOUS_WITHIN_SEQUENTIALLY) THEN REWRITE_TAC[o_DEF] THENL [DISCH_THEN(MP_TAC o SPEC `b:real^N`); DISCH_THEN(MP_TAC o SPEC `a:real^N`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN (ANTS_TAC THENL [ALL_TAC; DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET]]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVEX_ON_CONTINUOUS_ON_RELATIVE_INTERIOR) THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET]]; ALL_TAC] THEN MP_TAC(SPECL [`f:real^N->real`; `t:real^N->bool`; `a:real^N`] CONVEX_IMP_LOCALLY_LIPSCHITZ) THEN ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`d:real`; `B:real`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY])) THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `N1:num`) (X_CHOOSE_TAC `N2:num`)) THEN MP_TAC(SPEC `max B (max (&N1) (&N2))` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[REAL_MAX_LE; REAL_OF_NUM_LE] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(x:num->real^N) n`; `(y:num->real^N) n`]) THEN ASM_REWRITE_TAC[IN_CBALL; IN_INTER] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; HULL_INC; RELATIVE_INTERIOR_SUBSET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x > a ==> b <= a ==> ~(x <= b)`)) THEN ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE]]);; let CONVEX_BOUNDS_LEMMA = prove (`!f x:real^N e. f convex_on cball(x,e) /\ (!y. y IN cball(x,e) ==> f(y) <= b) ==> !y. y IN cball(x,e) ==> abs(f(y)) <= b + &2 * abs(f(x))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL [ALL_TAC; REWRITE_TAC[IN_CBALL] THEN ASM_MESON_TAC[DIST_POS_LE; REAL_LE_TRANS]] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex_on]) THEN DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `&2 % x - y:real^N`; `&1 / &2`; `&1 / &2`]) THEN REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN REWRITE_TAC[VECTOR_ARITH `y + x - y = x:real^N`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ABBREV_TAC `z = &2 % x - y:real^N` THEN SUBGOAL_THEN `z:real^N IN cball(x,e)` ASSUME_TAC THENL [UNDISCH_TAC `y:real^N IN cball(x,e)` THEN EXPAND_TAC "z" THEN REWRITE_TAC[dist; IN_CBALL] THEN REWRITE_TAC[VECTOR_ARITH `x - (&2 % x - y) = y - x`] THEN REWRITE_TAC[NORM_SUB]; ALL_TAC] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th) [`y:real^N`; `z:real^N`]) THEN ASM_REWRITE_TAC[CENTRE_IN_CBALL] THEN REAL_ARITH_TAC);; let CONVEX_IMP_BOUNDED_ON_INTERVAL = prove (`!f:real^1->real a b. f convex_on interval[a,b] ==> ?B. &0 < B /\ !x. x IN interval[a,b] ==> abs(f x) <= B`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL [ASM_MESON_TAC[NOT_IN_EMPTY; REAL_LT_01]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN SUBGOAL_THEN `?B. !x:real^1. x IN interval[a,b] ==> f(x) <= B` STRIP_ASSUME_TAC THENL [EXISTS_TAC `max (f(a:real^1)) (f b)` THEN MP_TAC(ISPECL [`f:real^1->real`; `{a:real^1,b}`; `max (f(a:real^1)) (f b)`] CONVEX_ON_CONVEX_HULL_BOUND) THEN ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; SEGMENT_1] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC; EXISTS_TAC `(&1 + abs B) + &2 * abs(f(midpoint(a,b):real^1))` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ASM_REWRITE_TAC[INTERVAL_1]] THEN MATCH_MP_TAC CONVEX_BOUNDS_LEMMA THEN MAP_EVERY UNDISCH_TAC [`f convex_on interval[a:real^1,b]`; `!x:real^1. x IN interval[a,b] ==> f x <= B`] THEN ASM_SIMP_TAC[INTERVAL_1; REAL_ARITH `x <= b ==> x <= &1 + abs b`]]);; (* ------------------------------------------------------------------------- *) (* A convex function on R^1 is "piecewise monotone" in this precise sense. *) (* ------------------------------------------------------------------------- *) let CONVEX_IMP_PIECEWISE_MONOTONE = prove (`!f s. f convex_on s /\ is_interval s ==> (!x y. x IN interior s /\ y IN interior s /\ drop x <= drop y ==> f x <= f y) \/ (!x y. x IN interior s /\ y IN interior s /\ drop x <= drop y ==> f y <= f x) \/ ?a. a IN interior s /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y /\ drop y <= drop a ==> f y <= f x) /\ (!x y. x IN s /\ y IN s /\ drop a <= drop x /\ drop x <= drop y ==> f x <= f y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP; DISJ_ASSOC] THEN REWRITE_TAC[REAL_NON_MONOTONE] THEN REWRITE_TAC[TAUT `~p \/ q <=> p ==> q`; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `b:real^1`; `v:real^1`] THEN STRIP_TAC THENL [MATCH_MP_TAC(TAUT `F ==> p`) THEN MP_TAC(ISPECL [`f:real^1->real`; `s:real^1->bool`; `u:real^1`; `v:real^1`; `b:real^1`] CONVEX_LOWER_SEGMENT) THEN ASM_SIMP_TAC[NOT_IMP; REWRITE_RULE[SUBSET] INTERIOR_SUBSET] THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `interval[u:real^1,v] SUBSET interior s` ASSUME_TAC THENL [ASM_MESON_TAC[INTERVAL_SUBSET_IS_INTERVAL; IS_INTERVAL_CONVEX_1; CONVEX_INTERIOR]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real`; `interval[u:real^1,v]`] CONTINUOUS_ATTAINS_INF) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN ANTS_TAC THENL [REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interior s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_ON_CONTINUOUS THEN ASM_MESON_TAC[CONVEX_ON_SUBSET; INTERIOR_SUBSET; OPEN_INTERIOR]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `!x. x IN s ==> (f:real^1->real) a <= f x` ASSUME_TAC THENL [MATCH_MP_TAC CONVEX_LOCAL_GLOBAL_MINIMUM THEN EXISTS_TAC `interval(u:real^1,v)` THEN ASM_REWRITE_TAC[OPEN_INTERVAL] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_LE; DROP_EQ] THEN ASM_MESON_TAC[REAL_LE_LT; REAL_NOT_LE]; ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; INTERIOR_SUBSET]]; ALL_TAC] THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s /\ x IN segment[a,y] ==> (f:real^1->real) x <= f y` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real`; `s:real^1->bool`; `a:real^1`; `y:real^1`; `x:real^1`] CONVEX_LOWER_SEGMENT) THEN ASM_SIMP_TAC[real_max] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);; hol-light/Multivariate/cross.ml000066400000000000000000000235511303454263000171040ustar00rootroot00000000000000(* ========================================================================= *) (* Cross products in real^3. *) (* ========================================================================= *) needs "Multivariate/topology.ml";; prioritize_vector();; (* ------------------------------------------------------------------------- *) (* The definition. *) (* ------------------------------------------------------------------------- *) parse_as_infix("cross",(20,"right"));; let cross = new_definition `(a:real^3) cross (b:real^3) = vector [a$2 * b$3 - a$3 * b$2; a$3 * b$1 - a$1 * b$3; a$1 * b$2 - a$2 * b$1] :real^3`;; (* ------------------------------------------------------------------------- *) (* Some simple automation. *) (* ------------------------------------------------------------------------- *) let VEC3_TAC = SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_3; SUM_3; DIMINDEX_3; VECTOR_3; vector_add; vec; dot; cross; orthogonal; basis; DET_3; vector_neg; vector_sub; vector_mul; ARITH] THEN CONV_TAC REAL_RING;; let VEC3_RULE tm = prove(tm,VEC3_TAC);; (* ------------------------------------------------------------------------- *) (* Basic lemmas. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_CROSS = prove (`!x y. orthogonal (x cross y) x /\ orthogonal (x cross y) y /\ orthogonal x (x cross y) /\ orthogonal y (x cross y)`, VEC3_TAC);; let CROSS_LZERO = prove (`!x. (vec 0) cross x = vec 0`, VEC3_TAC);; let CROSS_RZERO = prove (`!x. x cross (vec 0) = vec 0`, VEC3_TAC);; let CROSS_SKEW = prove (`!x y. (x cross y) = --(y cross x)`, VEC3_TAC);; let CROSS_REFL = prove (`!x. x cross x = vec 0`, VEC3_TAC);; let CROSS_LADD = prove (`!x y z. (x + y) cross z = (x cross z) + (y cross z)`, VEC3_TAC);; let CROSS_RADD = prove (`!x y z. x cross (y + z) = (x cross y) + (x cross z)`, VEC3_TAC);; let CROSS_LMUL = prove (`!c x y. (c % x) cross y = c % (x cross y)`, VEC3_TAC);; let CROSS_RMUL = prove (`!c x y. x cross (c % y) = c % (x cross y)`, VEC3_TAC);; let CROSS_LNEG = prove (`!x y. (--x) cross y = --(x cross y)`, VEC3_TAC);; let CROSS_RNEG = prove (`!x y. x cross (--y) = --(x cross y)`, VEC3_TAC);; let CROSS_LSUB = prove (`!x y z. (x - y) cross z = x cross z - y cross z`, VEC3_TAC);; let CROSS_RSUB = prove (`!x y z. x cross (y - z) = x cross y - x cross z`, VEC3_TAC);; let CROSS_JACOBI = prove (`!x y z. x cross (y cross z) + y cross (z cross x) + z cross (x cross y) = vec 0`, VEC3_TAC);; let CROSS_LAGRANGE = prove (`!x y z. x cross (y cross z) = (x dot z) % y - (x dot y) % z`, VEC3_TAC);; let CROSS_TRIPLE = prove (`!x y z. (x cross y) dot z = (y cross z) dot x`, VEC3_TAC);; let DOT_CROSS_SELF = prove (`(!x y. x dot (x cross y) = &0) /\ (!x y. x dot (y cross x) = &0) /\ (!x y. (x cross y) dot y = &0) /\ (!x y. (y cross x) dot y = &0)`, VEC3_TAC);; let CROSS_COMPONENTS = prove (`!x y. (x cross y)$1 = x$2 * y$3 - y$2 * x$3 /\ (x cross y)$2 = x$3 * y$1 - y$3 * x$1 /\ (x cross y)$3 = x$1 * y$2 - y$1 * x$2`, VEC3_TAC);; let CROSS_BASIS = prove (`(basis 1) cross (basis 2) = basis 3 /\ (basis 2) cross (basis 1) = --(basis 3) /\ (basis 2) cross (basis 3) = basis 1 /\ (basis 3) cross (basis 2) = --(basis 1) /\ (basis 3) cross (basis 1) = basis 2 /\ (basis 1) cross (basis 3) = --(basis 2)`, VEC3_TAC);; let CROSS_BASIS_NONZERO = prove (`!u. ~(u = vec 0) ==> ~(u cross basis 1 = vec 0) \/ ~(u cross basis 2 = vec 0) \/ ~(u cross basis 3 = vec 0)`, VEC3_TAC);; let CROSS_DOT_CANCEL = prove (`!x y z. x dot y = x dot z /\ x cross y = x cross z /\ ~(x = vec 0) ==> y = z`, ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DOT_EQ_0] THEN VEC3_TAC);; let NORM_CROSS_DOT = prove (`!x y. norm(x cross y) pow 2 + (x dot y) pow 2 = (norm(x) * norm y) pow 2`, REWRITE_TAC[REAL_POW_MUL; NORM_POW_2] THEN VEC3_TAC);; let DOT_CROSS_DET = prove (`!x y z. x dot (y cross z) = det(vector[x;y;z]:real^3^3)`, VEC3_TAC);; let CROSS_CROSS_DET = prove (`!w x y z. (w cross x) cross (y cross z) = det(vector[w;x;z]:real^3^3) % y - det(vector[w;x;y]:real^3^3) % z`, VEC3_TAC);; let DOT_CROSS = prove (`!w x y z. (w cross x) dot (y cross z) = (w dot y) * (x dot z) - (w dot z) * (x dot y)`, VEC3_TAC);; let NORM_CROSS = prove (`!x y. norm(x cross y) pow 2 = norm(x) pow 2 * norm(y) pow 2 - (x dot y) pow 2`, REWRITE_TAC[NORM_POW_2] THEN VEC3_TAC);; let CROSS_EQ_0 = prove (`!x y. x cross y = vec 0 <=> collinear{vec 0,x,y}`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN ONCE_REWRITE_TAC[REAL_RING `x = &0 <=> x pow 2 = &0`] THEN REWRITE_TAC[NORM_CROSS; REAL_SUB_0; GSYM REAL_POW_MUL] THEN REWRITE_TAC[GSYM REAL_EQ_SQUARE_ABS; GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN SIMP_TAC[real_abs; REAL_LE_MUL; NORM_POS_LE; EQ_SYM_EQ]);; let CROSS_0 = prove (`(!x. vec 0 cross x = vec 0) /\ (!x. x cross vec 0 = vec 0)`, VEC3_TAC);; let CROSS_EQ_SELF = prove (`(!x y. x cross y = x <=> x = vec 0) /\ (!x y. x cross y = y <=> y = vec 0)`, MESON_TAC[ORTHOGONAL_CROSS; CROSS_0; ORTHOGONAL_REFL]);; let NORM_AND_CROSS_EQ_0 = prove (`!x y. x dot y = &0 /\ x cross y = vec 0 <=> x = vec 0 \/ y = vec 0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN ASM_REWRITE_TAC[CROSS_0; DOT_LZERO] THEN ASM_CASES_TAC `y:real^3 = vec 0` THEN ASM_REWRITE_TAC[CROSS_0; DOT_RZERO] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[GSYM DOT_EQ_0; DOT_CROSS; REAL_MUL_LZERO] THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_ENTIRE; DOT_EQ_0]);; let BILINEAR_CROSS = prove (`bilinear(cross)`, REWRITE_TAC[linear; bilinear; CROSS_LADD; CROSS_RADD; CROSS_LMUL; CROSS_RMUL]);; (* ------------------------------------------------------------------------- *) (* Preservation by rotation, or other orthogonal transformation up to sign. *) (* ------------------------------------------------------------------------- *) let CROSS_MATRIX_MUL = prove (`!A x y. transp A ** ((A ** x) cross (A ** y)) = det A % (x cross y)`, SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; SUM_3; matrix_vector_mul; CROSS_COMPONENTS; LAMBDA_BETA; ARITH; transp; DET_3; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);; let CROSS_ORTHOGONAL_MATRIX = prove (`!A x y. orthogonal_matrix A ==> (A ** x) cross (A ** y) = det A % (A ** (x cross y))`, MP_TAC CROSS_MATRIX_MUL THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[orthogonal_matrix] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o AP_TERM `matrix_vector_mul (A:real^3^3)`) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL]);; let CROSS_ROTATION_MATRIX = prove (`!A x y. rotation_matrix A ==> (A ** x) cross (A ** y) = A ** (x cross y)`, SIMP_TAC[rotation_matrix; CROSS_ORTHOGONAL_MATRIX; VECTOR_MUL_LID]);; let CROSS_ROTOINVERSION_MATRIX = prove (`!A x y. rotoinversion_matrix A ==> (A ** x) cross (A ** y) = --(A ** (x cross y))`, SIMP_TAC[rotoinversion_matrix; CROSS_ORTHOGONAL_MATRIX; VECTOR_MUL_LID; VECTOR_MUL_LNEG]);; let CROSS_ORTHOGONAL_TRANSFORMATION = prove (`!f x y. orthogonal_transformation f ==> (f x) cross (f y) = det(matrix f) % f(x cross y)`, GEN_TAC THEN MP_TAC(ISPEC `matrix(f:real^3->real^3)` CROSS_ORTHOGONAL_MATRIX) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; ORTHOGONAL_TRANSFORMATION_LINEAR]; ASM_SIMP_TAC[MATRIX_WORKS; ORTHOGONAL_TRANSFORMATION_LINEAR]]);; let CROSS_LINEAR_IMAGE = prove (`!f x y. linear f /\ (!x. norm(f x) = norm x) /\ det(matrix f) = &1 ==> (f x) cross (f y) = f(x cross y)`, SIMP_TAC[ORTHOGONAL_TRANSFORMATION; CONJ_ASSOC; VECTOR_MUL_LID; CROSS_ORTHOGONAL_TRANSFORMATION]);; (* ------------------------------------------------------------------------- *) (* Continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_CROSS = prove (`!net:(A)net f g. f continuous net /\ g continuous net ==> (\x. (f x) cross (g x)) continuous net`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_COMPONENTWISE_LIFT] THEN REWRITE_TAC[cross; VECTOR_3; DIMINDEX_3; FORALL_3; LIFT_SUB] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[LIFT_CMUL] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_SIMP_TAC[o_DEF; CONTINUOUS_LIFT_COMPONENT_COMPOSE]);; let CONTINUOUS_ON_CROSS = prove (`!f:real^N->real^3 g s. f continuous_on s /\ g continuous_on s ==> (\x. (f x) cross (g x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CROSS]);; (* ------------------------------------------------------------------------- *) (* Prove a weaker variant for more convenient interface with functions *) (* intended to work in 1 dimension. *) (* ------------------------------------------------------------------------- *) let CROSS_LINEAR_IMAGE_WEAK = prove (`!f x y. linear f /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:3) ==> det(matrix f) = &1) ==> (f x) cross (f y) = f(x cross y)`, REWRITE_TAC[DIMINDEX_3; ARITH] THEN SIMP_TAC[ORTHOGONAL_TRANSFORMATION; CONJ_ASSOC; VECTOR_MUL_LID; CROSS_ORTHOGONAL_TRANSFORMATION]);; add_linear_invariants [CROSS_LINEAR_IMAGE_WEAK];; hol-light/Multivariate/cvectors.ml000077500000000000000000002434031303454263000176060ustar00rootroot00000000000000(* ========================================================================= *) (* A library for vectors of complex numbers. *) (* Much inspired from HOL-Light real vector library <"vectors.ml">. *) (* *) (* (c) Copyright, Sanaz Khan Afshar & Vincent Aravantinos 2011-13 *) (* Hardware Verification Group, *) (* Concordia University *) (* *) (* Contact: *) (* *) (* *) (* Acknowledgements: *) (* - Harsh Singhal: n-dimensional dot product, utility theorems *) (* *) (* Updated for the latest version of HOL Light (JULY 2014) *) (* *) (* Distributed under the same license as HOL Light. *) (* ========================================================================= *) needs "Multivariate/complexes.ml";; needs "Multivariate/cross.ml";; (* ========================================================================= *) (* ADDITIONS TO THE BASE LIBRARY *) (* ========================================================================= *) (* ----------------------------------------------------------------------- *) (* Additional tacticals *) (* ----------------------------------------------------------------------- *) let SINGLE f x = f [x];; let distrib fs x = map (fun f -> f x) fs;; let DISTRIB ttacs x = EVERY (distrib ttacs x);; let REWRITE_TACS = MAP_EVERY (SINGLE REWRITE_TAC);; let GCONJUNCTS thm = map GEN_ALL (CONJUNCTS (SPEC_ALL thm));; (* ----------------------------------------------------------------------- *) (* Additions to the vectors library *) (* ----------------------------------------------------------------------- *) let COMPONENT_LE_NORM_ALT = prove (`!x:real^N i. 1 <= i /\ i <= dimindex (:N) ==> x$i <= norm x`, MESON_TAC [REAL_ABS_LE;COMPONENT_LE_NORM;REAL_LE_TRANS]);; (* ----------------------------------------------------------------------- *) (* Additions to the library of complex numbers *) (* ----------------------------------------------------------------------- *) (* Lemmas *) let RE_IM_NORM = prove (`!x. Re x <= norm x /\ Im x <= norm x /\ abs(Re x) <= norm x /\ abs(Im x) <= norm x`, REWRITE_TAC[RE_DEF;IM_DEF] THEN GEN_TAC THEN REPEAT CONJ_TAC THEN ((MATCH_MP_TAC COMPONENT_LE_NORM_ALT THEN REWRITE_TAC[DIMINDEX_2] THEN ARITH_TAC) ORELSE SIMP_TAC [COMPONENT_LE_NORM]));; let [RE_NORM;IM_NORM;ABS_RE_NORM;ABS_IM_NORM] = GCONJUNCTS RE_IM_NORM;; let NORM_RE = prove (`!x. &0 <= norm x + Re x /\ &0 <= norm x - Re x`, GEN_TAC THEN MP_TAC (SPEC_ALL ABS_RE_NORM) THEN REAL_ARITH_TAC);; let [NORM_RE_ADD;NORM_RE_SUB] = GCONJUNCTS NORM_RE;; let NORM2_ADD_REAL = prove (`!x y. real x /\ real y ==> norm (x + ii * y) pow 2 = norm x pow 2 + norm y pow 2`, SIMP_TAC[real;complex_norm;RE_ADD;IM_ADD;RE_MUL_II;IM_MUL_II;REAL_NEG_0; REAL_ADD_LID;REAL_ADD_RID;REAL_POW_ZERO;ARITH_RULE `~(2=0)`;REAL_LE_POW_2; SQRT_POW_2;REAL_LE_ADD]);; let COMPLEX_EQ_RCANCEL_IMP = GEN_ALL (MATCH_MP (MESON [] `(p <=> r \/ q) ==> (p /\ ~r ==> q) `) (SPEC_ALL COMPLEX_EQ_MUL_RCANCEL));; let COMPLEX_BALANCE_DIV_MUL = prove (`!x y z t. ~(z=Cx(&0)) ==> (x = y/z * t <=> x*z = y * t)`, REPEAT STRIP_TAC THEN POP_ASSUM (fun x -> ASSUME_TAC (REWRITE_RULE[x] (SPEC_ALL COMPLEX_EQ_MUL_RCANCEL)) THEN ASSUME_TAC (REWRITE_RULE[x] (SPECL [`x:complex`;`z:complex`] COMPLEX_DIV_RMUL))) THEN SUBGOAL_THEN `x=y/z*t <=> x*z=(y/z*t)*z:complex` (SINGLE REWRITE_TAC) THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(y/z*t)*z=(y/z*z)*t:complex`] THEN ASM_REWRITE_TAC[]]);; let CSQRT_MUL_LCX_LT = prove (`!x y. &0 < x ==> csqrt(Cx x * y) = Cx(sqrt x) * csqrt y`, REWRITE_TAC[csqrt;complex_mul;IM;RE;IM_CX;REAL_MUL_LZERO;REAL_ADD_RID;RE_CX; REAL_SUB_RZERO] THEN REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN FIRST_ASSUM (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN ASM_SIMP_TAC[IM;RE;REAL_MUL_RZERO;SQRT_MUL] THENL [ REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[REAL_ENTIRE;REAL_MUL_POS_LE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SQRT_0;REAL_MUL_LZERO;REAL_MUL_RZERO]; REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE] THEN MESON_TAC [REAL_LT_IMP_NZ]; ASM_MESON_TAC [REAL_LE_MUL_EQ;REAL_ARITH `~(&0 <= y) = &0 > y`]; SIMP_TAC [REAL_NEG_RMUL] THEN REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ARITH `~(&0 <= y) = y < &0`] THEN SIMP_TAC [GSYM REAL_NEG_GT0] THEN MESON_TAC[REAL_LT_IMP_LE;SQRT_MUL]; REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE] THEN MESON_TAC [REAL_LT_IMP_NZ]; REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE] THEN SIMP_TAC [DE_MORGAN_THM]; REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE] THEN SIMP_TAC [DE_MORGAN_THM]; ALL_TAC] THENL [ SIMP_TAC [REAL_NEG_0;SQRT_0;REAL_MUL_RZERO]; ASM_MESON_TAC[REAL_ARITH `~(x csqrt(Cx x * y) = Cx(sqrt x) * csqrt y`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CSQRT_MUL_LCX_LT] THEN EXPAND_TAC "x" THEN REWRITE_TAC[COMPLEX_MUL_LZERO;SQRT_0;CSQRT_0]);; let REAL_ADD_POW_2 = prove (`!x y:real. (x+y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`, REAL_ARITH_TAC);; let COMPLEX_ADD_POW_2 = prove (`!x y:complex. (x+y) pow 2 = x pow 2 + y pow 2 + Cx(&2) * x * y`, REWRITE_TAC[COMPLEX_POW_2] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ----------------------------------------------------------------------- *) (* Additions to the topology library *) (* ----------------------------------------------------------------------- *) prioritize_vector ();; (* Lemmas *) let FINITE_INTER_ENUM = prove (`!s n. FINITE(s INTER (0..n))`, MESON_TAC[FINITE_INTER;FINITE_NUMSEG]);; let NORM_PASTECART_GE1 = prove (`!x y. norm x <= norm (pastecart x y)`, MESON_TAC[FSTCART_PASTECART;NORM_FSTCART]);; let NORM_PASTECART_GE2 = prove (`!x y. norm y <= norm (pastecart x y)`, MESON_TAC[SNDCART_PASTECART;NORM_SNDCART]);; let LIM_PASTECART_EQ = prove (`!net a b f:A->real^M g:A->real^N. (f --> a) net /\ (g --> b) net <=> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`, REWRITE_TAC[MESON[] `(a <=> b) <=> (a ==> b) /\ (b ==> a)`;LIM_PASTECART;LIM; MESON[]`(p\/q ==> (p \/ r) /\ (p \/ s)) <=> (~p /\ q ==> r /\ s)`;dist; PASTECART_SUB] THEN ASM_MESON_TAC[REAL_LET_TRANS;NORM_PASTECART_GE1;NORM_PASTECART_GE2]);; let SUMS_PASTECART = prove (`!s f1:num->real^N f2:num->real^M l1 l2. (f1 sums l1) s /\ (f2 sums l2) s <=> ((\x. pastecart (f1 x) (f2 x)) sums (pastecart l1 l2)) s`, SIMP_TAC[sums;FINITE_INTER_ENUM;GSYM PASTECART_VSUM;LIM_PASTECART_EQ]);; let LINEAR_SUMS = prove( `!s f l g. linear g ==> ((f sums l) s ==> ((g o f) sums (g l)) s)`, SIMP_TAC[sums;FINITE_INTER_ENUM;GSYM LINEAR_VSUM; REWRITE_RULE[o_DEF;CONTINUOUS_AT_SEQUENTIALLY] LINEAR_CONTINUOUS_AT]);; (* ----------------------------------------------------------------------- *) (* Embedding of reals in complex numbers *) (* ----------------------------------------------------------------------- *) let real_of_complex = new_definition `real_of_complex c = @r. c = Cx r`;; let REAL_OF_COMPLEX = prove (`!c. real c ==> Cx(real_of_complex c) = c`, MESON_TAC[REAL;real_of_complex]);; let REAL_OF_COMPLEX_RE = prove (`!c. real c ==> real_of_complex c = Re c`, MESON_TAC[RE_CX;REAL_OF_COMPLEX]);; let REAL_OF_COMPLEX_CX = prove (`!r. real_of_complex (Cx r) = r`, SIMP_TAC[REAL_CX;REAL_OF_COMPLEX_RE;RE_CX]);; let REAL_OF_COMPLEX_NORM = prove (`!c. real c ==> norm c = abs (real_of_complex c)`, MESON_TAC[REAL_NORM;REAL_OF_COMPLEX_RE]);; let REAL_OF_COMPLEX_ADD = prove (`!x y. real x /\ real y ==> real_of_complex (x+y) = real_of_complex x + real_of_complex y`, MESON_TAC[REAL_ADD;REAL_OF_COMPLEX_RE;RE_ADD]);; let REAL_MUL = prove (`!x y. real x /\ real y ==> real (x*y)`, REWRITE_TAC[real] THEN SIMPLE_COMPLEX_ARITH_TAC);; let REAL_OF_COMPLEX_MUL = prove( `!x y. real x /\ real y ==> real_of_complex (x*y) = real_of_complex x * real_of_complex y`, MESON_TAC[REAL_MUL;REAL_OF_COMPLEX;CX_MUL;REAL_OF_COMPLEX_CX]);; let REAL_OF_COMPLEX_0 = prove( `!x. real x ==> (real_of_complex x = &0 <=> x = Cx(&0))`, REWRITE_TAC[REAL_EXISTS] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_OF_COMPLEX_CX;CX_INJ]);; let REAL_COMPLEX_ADD_CNJ = prove( `!x. real(cnj x + x) /\ real(x + cnj x)`, REWRITE_TAC[COMPLEX_ADD_CNJ;REAL_CX]);; (* TODO *let RE_EQ_NORM = prove(`!x. Re x = norm x <=> real x /\ &0 <= real_of_complex x`, *) (* ----------------------------------------------------------------------- *) (* Additions to the vectors library *) (* ----------------------------------------------------------------------- *) let vector_const = new_definition `vector_const (k:A) :A^N = lambda i. k`;; let vector_map = new_definition `vector_map (f:A->B) (v:A^N) :B^N = lambda i. f(v$i)`;; let vector_map2 = new_definition `vector_map2 (f:A->B->C) (v1:A^N) (v2:B^N) :C^N = lambda i. f (v1$i) (v2$i)`;; let vector_map3 = new_definition `vector_map3 (f:A->B->C->D) (v1:A^N) (v2:B^N) (v3:C^N) :D^N = lambda i. f (v1$i) (v2$i) (v3$i)`;; let FINITE_INDEX_INRANGE_2 = prove (`!i. ?k. 1 <= k /\ k <= dimindex(:N) /\ (!x:A^N. x$i = x$k) /\ (!x:B^N. x$i = x$k) /\ (!x:C^N. x$i = x$k) /\ (!x:D^N. x$i = x$k)`, REWRITE_TAC[finite_index] THEN MESON_TAC[FINITE_INDEX_WORKS]);; let COMPONENT_TAC x = REPEAT GEN_TAC THEN CHOOSE_TAC (SPEC_ALL FINITE_INDEX_INRANGE_2) THEN ASM_SIMP_TAC[x;LAMBDA_BETA];; let VECTOR_CONST_COMPONENT = prove (`!i k. ((vector_const k):A^N)$i = k`, COMPONENT_TAC vector_const);; let VECTOR_MAP_COMPONENT = prove (`!i f:A->B v:A^N. (vector_map f v)$i = f (v$i)`, COMPONENT_TAC vector_map);; let VECTOR_MAP2_COMPONENT = prove (`!i f:A->B->C v1:A^N v2. (vector_map2 f v1 v2)$i = f (v1$i) (v2$i)`, COMPONENT_TAC vector_map2);; let VECTOR_MAP3_COMPONENT = prove( `!i f:A->B->C->D v1:A^N v2 v3. (vector_map3 f v1 v2 v3)$i = f (v1$i) (v2$i) (v3$i)`, COMPONENT_TAC vector_map3);; let COMMON_TAC = REWRITE_TAC[vector_const;vector_map;vector_map2;vector_map3] THEN ONCE_REWRITE_TAC[CART_EQ] THEN SIMP_TAC[LAMBDA_BETA;o_DEF];; let VECTOR_MAP_VECTOR_CONST = prove (`!f:A->B k. vector_map f ((vector_const k):A^N) = vector_const (f k)`, COMMON_TAC);; let VECTOR_MAP_VECTOR_MAP = prove (`!f:A->B g:C->A v:C^N. vector_map f (vector_map g v) = vector_map (f o g) v`, COMMON_TAC);; let VECTOR_MAP_VECTOR_MAP2 = prove (`!f:A->B g:C->D->A u v:D^N. vector_map f (vector_map2 g u v) = vector_map2 (\x y. f (g x y)) u v`, COMMON_TAC);; let VECTOR_MAP2_LVECTOR_CONST = prove (`!f:A->B->C k v:B^N. vector_map2 f (vector_const k) v = vector_map (f k) v`, COMMON_TAC);; let VECTOR_MAP2_RVECTOR_CONST = prove (`!f:A->B->C k v:A^N. vector_map2 f v (vector_const k) = vector_map (\x. f x k) v`, COMMON_TAC);; let VECTOR_MAP2_LVECTOR_MAP = prove (`!f:A->B->C g:D->A v1 v2:B^N. vector_map2 f (vector_map g v1) v2 = vector_map2 (f o g) v1 v2`, COMMON_TAC);; let VECTOR_MAP2_RVECTOR_MAP = prove (`!f:A->B->C g:D->B v1 v2:D^N. vector_map2 f v1 (vector_map g v2) = vector_map2 (\x y. f x (g y)) v1 v2`, COMMON_TAC);; let VECTOR_MAP2_LVECTOR_MAP2 = prove (`!f:A->B->C g:D->E->A v1 v2 v3:B^N. vector_map2 f (vector_map2 g v1 v2) v3 = vector_map3 (\x y. f (g x y)) v1 v2 v3`, COMMON_TAC);; let VECTOR_MAP2_RVECTOR_MAP2 = prove( `!f:A->B->C g:D->E->B v1 v2 v3:E^N. vector_map2 f v1 (vector_map2 g v2 v3) = vector_map3 (\x y z. f x (g y z)) v1 v2 v3`, COMMON_TAC);; let VECTOR_MAP_SIMP_TAC = REWRITE_TAC[ VECTOR_MAP_VECTOR_CONST;VECTOR_MAP2_LVECTOR_CONST; VECTOR_MAP2_RVECTOR_CONST;VECTOR_MAP_VECTOR_MAP;VECTOR_MAP2_RVECTOR_MAP; VECTOR_MAP2_LVECTOR_MAP;VECTOR_MAP2_RVECTOR_MAP2;VECTOR_MAP2_LVECTOR_MAP2; VECTOR_MAP_VECTOR_MAP2];; let VECTOR_MAP_PROPERTY_TAC fs prop = REWRITE_TAC fs THEN VECTOR_MAP_SIMP_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[VECTOR_MAP_COMPONENT;VECTOR_MAP2_COMPONENT; VECTOR_MAP3_COMPONENT;VECTOR_CONST_COMPONENT;o_DEF;prop];; let VECTOR_MAP_PROPERTY thm f prop = prove(thm,VECTOR_MAP_PROPERTY_TAC f prop);; let COMPLEX_VECTOR_MAP = prove (`!f:complex->complex g. f = vector_map g <=> !z. f z = complex (g (Re z), g (Im z))`, REWRITE_TAC[vector_map;FUN_EQ_THM;complex] THEN REPEAT (GEN_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[CART_EQ;DIMINDEX_2;FORALL_2;LAMBDA_BETA;VECTOR_2;RE_DEF;IM_DEF]);; let COMPLEX_NEG_IS_A_MAP = prove (`(--):complex->complex = vector_map ((--):real->real)`, REWRITE_TAC[COMPLEX_VECTOR_MAP;complex_neg]);; let VECTOR_NEG_IS_A_MAP = prove (`(--):real^N->real^N = vector_map ((--):real->real)`, REWRITE_TAC[FUN_EQ_THM;CART_EQ;VECTOR_NEG_COMPONENT;VECTOR_MAP_COMPONENT]);; let VECTOR_MAP_VECTOR_MAP_ALT = prove (`!f:A^N->B^N g:C^N->A^N f' g'. f = vector_map f' /\ g = vector_map g' ==> f o g = vector_map (f' o g')`, SIMP_TAC[o_DEF;FUN_EQ_THM;VECTOR_MAP_VECTOR_MAP]);; let COMPLEX_VECTOR_MAP2 = prove (`!f:complex->complex->complex g. f = vector_map2 g <=> !z1 z2. f z1 z2 = complex (g (Re z1) (Re z2), g (Im z1) (Im z2))`, REWRITE_TAC[vector_map2;FUN_EQ_THM;complex] THEN REPEAT (GEN_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[CART_EQ;DIMINDEX_2;FORALL_2;LAMBDA_BETA;VECTOR_2;RE_DEF; IM_DEF]);; let VECTOR_MAP2_RVECTOR_MAP_ALT = prove( `!f:complex->complex->complex g:complex->complex f' g'. f = vector_map2 f' /\ g = vector_map g' ==> (\x y. f x (g y)) = vector_map2 (\x y. f' x (g' y))`, SIMP_TAC[FUN_EQ_THM;VECTOR_MAP2_RVECTOR_MAP]);; let COMPLEX_ADD_IS_A_MAP = prove (`(+):complex->complex->complex = vector_map2 ((+):real->real->real)`, REWRITE_TAC[COMPLEX_VECTOR_MAP2;complex_add]);; let VECTOR_ADD_IS_A_MAP = prove (`(+):real^N->real^N->real^N = vector_map2 ((+):real->real->real)`, REWRITE_TAC[FUN_EQ_THM;CART_EQ;VECTOR_ADD_COMPONENT;VECTOR_MAP2_COMPONENT]);; let COMPLEX_SUB_IS_A_MAP = prove (`(-):complex->complex->complex = vector_map2 ((-):real->real->real)`, ONCE_REWRITE_TAC[prove(`(-) = \x y:complex. x-y`,REWRITE_TAC[FUN_EQ_THM])] THEN ONCE_REWRITE_TAC[prove(`(-) = \x y:real. x-y`,REWRITE_TAC[FUN_EQ_THM])] THEN REWRITE_TAC[complex_sub;real_sub] THEN MATCH_MP_TAC VECTOR_MAP2_RVECTOR_MAP_ALT THEN REWRITE_TAC[COMPLEX_NEG_IS_A_MAP;COMPLEX_ADD_IS_A_MAP]);; let VECTOR_SUB_IS_A_MAP = prove (`(-):real^N->real^N->real^N = vector_map2 ((-):real->real->real)`, REWRITE_TAC[FUN_EQ_THM;CART_EQ;VECTOR_SUB_COMPONENT;VECTOR_MAP2_COMPONENT]);; let COMMON_TAC x = SIMP_TAC[CART_EQ;pastecart;x;LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `1<= i-dimindex(:N) /\ i-dimindex(:N) <= dimindex(:M)` ASSUME_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REPEAT (POP_ASSUM (MP_TAC o REWRITE_RULE[DIMINDEX_FINITE_SUM])) THEN ARITH_TAC;; let PASTECART_VECTOR_MAP = prove (`!f:A->B x:A^N y:A^M. pastecart (vector_map f x) (vector_map f y) = vector_map f (pastecart x y)`, COMMON_TAC vector_map);; let PASTECART_VECTOR_MAP2 = prove (`!f:A->B->C x1:A^N x2 y1:A^M y2. pastecart (vector_map2 f x1 x2) (vector_map2 f y1 y2) = vector_map2 f (pastecart x1 y1) (pastecart x2 y2)`, COMMON_TAC vector_map2);; let vector_zip = new_definition `vector_zip (v1:A^N) (v2:B^N) : (A#B)^N = lambda i. (v1$i,v2$i)`;; let VECTOR_ZIP_COMPONENT = prove (`!i v1:A^N v2:B^N. (vector_zip v1 v2)$i = (v1$i,v2$i)`, REPEAT GEN_TAC THEN CHOOSE_TAC (INST_TYPE [`:A#B`,`:C`] (SPEC_ALL FINITE_INDEX_INRANGE_2)) THEN ASM_SIMP_TAC[vector_zip;LAMBDA_BETA]);; let vector_unzip = new_definition `vector_unzip (v:(A#B)^N):(A^N)#(B^N) = vector_map FST v,vector_map SND v`;; let VECTOR_UNZIP_COMPONENT = prove (`!i v:(A#B)^N. (FST (vector_unzip v))$i = FST (v$i) /\ (SND (vector_unzip v))$i = SND (v$i)`, REWRITE_TAC[vector_unzip;VECTOR_MAP_COMPONENT]);; let VECTOR_MAP2_AS_VECTOR_MAP = prove (`!f:A->B->C v1:A^N v2:B^N. vector_map2 f v1 v2 = vector_map (UNCURRY f) (vector_zip v1 v2)`, REWRITE_TAC[CART_EQ;VECTOR_MAP2_COMPONENT;VECTOR_MAP_COMPONENT; VECTOR_ZIP_COMPONENT;UNCURRY_DEF]);; (* ========================================================================= *) (* BASIC ARITHMETIC *) (* ========================================================================= *) make_overloadable "%" `:A-> B-> B`;; let prioritize_cvector () = overload_interface("--",`(cvector_neg):complex^N->complex^N`); overload_interface("+",`(cvector_add):complex^N->complex^N->complex^N`); overload_interface("-",`(cvector_sub):complex^N->complex^N->complex^N`); overload_interface("%",`(cvector_mul):complex->complex^N->complex^N`);; let cvector_zero = new_definition `cvector_zero:complex^N = vector_const (Cx(&0))`;; let cvector_neg = new_definition `cvector_neg :complex^N->complex^N = vector_map (--)`;; let cvector_add = new_definition `cvector_add :complex^N->complex^N->complex^N = vector_map2 (+)`;; let cvector_sub = new_definition `cvector_sub :complex^N->complex^N->complex^N = vector_map2 (-)`;; let cvector_mul = new_definition `(cvector_mul:complex->complex^N->complex^N) a = vector_map (( * ) a)`;; overload_interface("%",`(%):real->real^N->real^N`);; prioritize_cvector ();; let CVECTOR_ZERO_COMPONENT = prove (`!i. (cvector_zero:complex^N)$i = Cx(&0)`, REWRITE_TAC[cvector_zero;VECTOR_CONST_COMPONENT]);; let CVECTOR_NON_ZERO = prove (`!x:complex^N. ~(x=cvector_zero) <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ ~(x$i = Cx(&0))`, GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT] THEN MESON_TAC[]);; let CVECTOR_ADD_COMPONENT = prove (`!X Y:complex^N i. ((X + Y)$i = X$i + Y$i)`, REWRITE_TAC[cvector_add;VECTOR_MAP2_COMPONENT]);; let CVECTOR_SUB_COMPONENT = prove (`!X:complex^N Y i. ((X - Y)$i = X$i - Y$i)`, REWRITE_TAC[cvector_sub;VECTOR_MAP2_COMPONENT]);; let CVECTOR_NEG_COMPONENT = prove (`!X:complex^N i. ((--X)$i = --(X$i))`, REWRITE_TAC[cvector_neg;VECTOR_MAP_COMPONENT]);; let CVECTOR_MUL_COMPONENT = prove (`!c:complex X:complex^N i. ((c % X)$i = c * X$i)`, REWRITE_TAC[cvector_mul;VECTOR_MAP_COMPONENT]);; (* Simple generic tactic adapted from VECTOR_ARITH_TAC *) let CVECTOR_ARITH_TAC = let RENAMED_LAMBDA_BETA th = if fst(dest_fun_ty(type_of(funpow 3 rand (concl th)))) = aty then INST_TYPE [aty,bty; bty,aty] LAMBDA_BETA else LAMBDA_BETA in POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE DISCH_TAC ORELSE EQ_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN GEN_REWRITE_TAC ONCE_DEPTH_CONV [CART_EQ] THEN REWRITE_TAC[AND_FORALL_THM] THEN TRY EQ_TAC THEN TRY(MATCH_MP_TAC MONO_FORALL) THEN GEN_TAC THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`; TAUT `(a ==> b) \/ (a ==> c) <=> a ==> b \/ c`] THEN TRY(MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`)) THEN REWRITE_TAC[cvector_zero;cvector_add; cvector_sub; cvector_neg; cvector_mul; vector_map;vector_map2;vector_const] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP(RENAMED_LAMBDA_BETA th) th]) THEN SIMPLE_COMPLEX_ARITH_TAC;; let CVECTOR_ARITH tm = prove(tm,CVECTOR_ARITH_TAC);; (* ========================================================================= *) (* VECTOR SPACE AXIOMS AND ADDITIONAL BASIC RESULTS *) (* ========================================================================= *) let CVECTOR_MAP_PROPERTY thm = VECTOR_MAP_PROPERTY thm [cvector_zero;cvector_add;cvector_sub;cvector_neg; cvector_mul];; let CVECTOR_ADD_SYM = CVECTOR_MAP_PROPERTY `!x y:complex^N. x + y = y + x` COMPLEX_ADD_SYM;; let CVECTOR_ADD_ASSOC = CVECTOR_MAP_PROPERTY `!x y z:complex^N. x + (y + z) = (x + y) + z` COMPLEX_ADD_ASSOC;; let CVECTOR_ADD_ID = CVECTOR_MAP_PROPERTY `!x:complex^N. x + cvector_zero = x /\ cvector_zero + x = x` (CONJ COMPLEX_ADD_RID COMPLEX_ADD_LID);; let [CVECTOR_ADD_RID;CVECTOR_ADD_LID] = GCONJUNCTS CVECTOR_ADD_ID;; let CVECTOR_ADD_INV = CVECTOR_MAP_PROPERTY `!x:complex^N. x + -- x = cvector_zero /\ --x + x = cvector_zero` (CONJ COMPLEX_ADD_RINV COMPLEX_ADD_LINV);; let CVECTOR_MUL_ASSOC = CVECTOR_MAP_PROPERTY `!a b x:complex^N. a % (b % x) = (a * b) % x` COMPLEX_MUL_ASSOC;; let CVECTOR_SUB_LDISTRIB = CVECTOR_MAP_PROPERTY `!c x y:complex^N. c % (x - y) = c % x - c % y` COMPLEX_SUB_LDISTRIB;; let CVECTOR_SCALAR_RDIST = CVECTOR_MAP_PROPERTY `!a b x:complex^N. (a + b) % x = a % x + b % x` COMPLEX_ADD_RDISTRIB;; let CVECTOR_MUL_ID = CVECTOR_MAP_PROPERTY `!x:complex^N. Cx(&1) % x = x` COMPLEX_MUL_LID;; let CVECTOR_SUB_REFL = CVECTOR_MAP_PROPERTY `!x:complex^N. x - x = cvector_zero` COMPLEX_SUB_REFL;; let CVECTOR_SUB_RADD = CVECTOR_MAP_PROPERTY `!x y:complex^N. x - (x + y) = --y` COMPLEX_ADD_SUB2;; let CVECTOR_NEG_SUB = CVECTOR_MAP_PROPERTY `!x y:complex^N. --(x - y) = y - x` COMPLEX_NEG_SUB;; let CVECTOR_SUB_EQ = CVECTOR_MAP_PROPERTY `!x y:complex^N. (x - y = cvector_zero) <=> (x = y)` COMPLEX_SUB_0;; let CVECTOR_MUL_LZERO = CVECTOR_MAP_PROPERTY `!x. Cx(&0) % x = cvector_zero` COMPLEX_MUL_LZERO;; let CVECTOR_SUB_ADD = CVECTOR_MAP_PROPERTY `!x y:complex^N. (x - y) + y = x` COMPLEX_SUB_ADD;; let CVECTOR_SUB_ADD2 = CVECTOR_MAP_PROPERTY `!x y:complex^N. y + (x - y) = x` COMPLEX_SUB_ADD2;; let CVECTOR_ADD_LDISTRIB = CVECTOR_MAP_PROPERTY `!c x y:complex^N. c % (x + y) = c % x + c % y` COMPLEX_ADD_LDISTRIB;; let CVECTOR_ADD_RDISTRIB = CVECTOR_MAP_PROPERTY `!a b x:complex^N. (a + b) % x = a % x + b % x` COMPLEX_ADD_RDISTRIB;; let CVECTOR_SUB_RDISTRIB = CVECTOR_MAP_PROPERTY `!a b x:complex^N. (a - b) % x = a % x - b % x` COMPLEX_SUB_RDISTRIB;; let CVECTOR_ADD_SUB = CVECTOR_MAP_PROPERTY `!x y:complex^N. (x + y:complex^N) - x = y` COMPLEX_ADD_SUB;; let CVECTOR_EQ_ADDR = CVECTOR_MAP_PROPERTY `!x y:complex^N. (x + y = x) <=> (y = cvector_zero)` COMPLEX_EQ_ADD_LCANCEL_0;; let CVECTOR_SUB = CVECTOR_MAP_PROPERTY `!x y:complex^N. x - y = x + --(y:complex^N)` complex_sub;; let CVECTOR_SUB_RZERO = CVECTOR_MAP_PROPERTY `!x:complex^N. x - cvector_zero = x` COMPLEX_SUB_RZERO;; let CVECTOR_MUL_RZERO = CVECTOR_MAP_PROPERTY `!c:complex. c % cvector_zero = cvector_zero` COMPLEX_MUL_RZERO;; let CVECTOR_MUL_LZERO = CVECTOR_MAP_PROPERTY `!x:complex^N. Cx(&0) % x = cvector_zero` COMPLEX_MUL_LZERO;; let CVECTOR_MUL_EQ_0 = prove (`!a:complex x:complex^N. (a % x = cvector_zero <=> a = Cx(&0) \/ x = cvector_zero)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ ASM_CASES_TAC `a=Cx(&0)` THENL [ ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (RATOR_CONV o DEPTH_CONV) [CART_EQ] THEN ASM_REWRITE_TAC[CVECTOR_MUL_COMPONENT;CVECTOR_ZERO_COMPONENT; COMPLEX_ENTIRE] THEN GEN_REWRITE_TAC (RAND_CONV o DEPTH_CONV) [CART_EQ] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT]; ]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[CVECTOR_MUL_RZERO;CVECTOR_MUL_LZERO]; ]);; let CVECTOR_NEG_MINUS1 = CVECTOR_MAP_PROPERTY `!x:complex^N. --x = (--(Cx(&1))) % x` (GSYM COMPLEX_NEG_MINUS1);; let CVECTOR_SUB_LZERO = CVECTOR_MAP_PROPERTY `!x:complex^N. cvector_zero - x = --x` COMPLEX_SUB_LZERO;; let CVECTOR_NEG_NEG = CVECTOR_MAP_PROPERTY `!x:complex^N. --(--(x:complex^N)) = x` COMPLEX_NEG_NEG;; let CVECTOR_MUL_LNEG = CVECTOR_MAP_PROPERTY `!c x:complex^N. --c % x = --(c % x)` COMPLEX_MUL_LNEG;; let CVECTOR_MUL_RNEG = CVECTOR_MAP_PROPERTY `!c x:complex^N. c % --x = --(c % x)` COMPLEX_MUL_RNEG;; let CVECTOR_NEG_0 = CVECTOR_MAP_PROPERTY `--cvector_zero = cvector_zero` COMPLEX_NEG_0;; let CVECTOR_NEG_EQ_0 = CVECTOR_MAP_PROPERTY `!x:complex^N. --x = cvector_zero <=> x = cvector_zero` COMPLEX_NEG_EQ_0;; let CVECTOR_ADD_AC = prove (`!x y z:complex^N. (x + y = y + x) /\ ((x + y) + z = x + y + z) /\ (x + y + z = y + x + z)`, MESON_TAC[CVECTOR_ADD_SYM;CVECTOR_ADD_ASSOC]);; let CVECTOR_MUL_LCANCEL = prove (`!a x y:complex^N. a % x = a % y <=> a = Cx(&0) \/ x = y`, MESON_TAC[CVECTOR_MUL_EQ_0;CVECTOR_SUB_LDISTRIB;CVECTOR_SUB_EQ]);; let CVECTOR_MUL_RCANCEL = prove (`!a b x:complex^N. a % x = b % x <=> a = b \/ x = cvector_zero`, MESON_TAC[CVECTOR_MUL_EQ_0;CVECTOR_SUB_RDISTRIB;COMPLEX_SUB_0;CVECTOR_SUB_EQ]);; (* ========================================================================= *) (* LINEARITY *) (* ========================================================================= *) let clinear = new_definition `clinear (f:complex^M->complex^N) <=> (!x y. f(x + y) = f(x) + f(y)) /\ (!c x. f(c % x) = c % f(x))`;; let COMMON_TAC additional_thms = SIMP_TAC[clinear] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN SIMP_TAC(CVECTOR_ADD_COMPONENT::CVECTOR_MUL_COMPONENT::additional_thms) THEN SIMPLE_COMPLEX_ARITH_TAC;; let CLINEAR_COMPOSE_CMUL = prove (`!f:complex^M->complex^N c. clinear f ==> clinear (\x. c % f x)`, COMMON_TAC[]);; let CLINEAR_COMPOSE_NEG = prove (`!f:complex^M->complex^N. clinear f ==> clinear (\x. --(f x))`, COMMON_TAC[CVECTOR_NEG_COMPONENT]);; let CLINEAR_COMPOSE_ADD = prove (`!f:complex^M->complex^N g. clinear f /\ clinear g ==> clinear (\x. f x + g x)`, COMMON_TAC[]);; let CLINEAR_COMPOSE_SUB = prove (`!f:complex^M->complex^N g. clinear f /\ clinear g ==> clinear (\x. f x - g x)`, COMMON_TAC[CVECTOR_SUB_COMPONENT]);; let CLINEAR_COMPOSE = prove (`!f:complex^M->complex^N g. clinear f /\ clinear g ==> clinear (g o f)`, SIMP_TAC[clinear;o_THM]);; let CLINEAR_ID = prove (`clinear (\x:complex^N. x)`, REWRITE_TAC[clinear]);; let CLINEAR_I = prove (`clinear (I:complex^N->complex^N)`, REWRITE_TAC[I_DEF;CLINEAR_ID]);; let CLINEAR_ZERO = prove (`clinear ((\x. cvector_zero):complex^M->complex^N)`, COMMON_TAC[CVECTOR_ZERO_COMPONENT]);; let CLINEAR_NEGATION = prove (`clinear ((--):complex^N->complex^N)`, COMMON_TAC[CVECTOR_NEG_COMPONENT]);; let CLINEAR_VMUL_COMPONENT = prove (`!f:complex^M->complex^N v:complex^P k. clinear f /\ 1 <= k /\ k <= dimindex(:N) ==> clinear (\x. (f x)$k % v)`, COMMON_TAC[]);; let CLINEAR_0 = prove (`!f:complex^M->complex^N. clinear f ==> (f cvector_zero = cvector_zero)`, MESON_TAC[CVECTOR_MUL_LZERO;clinear]);; let CLINEAR_CMUL = prove (`!f:complex^M->complex^N c x. clinear f ==> (f (c % x) = c % f x)`, SIMP_TAC[clinear]);; let CLINEAR_NEG = prove (`!f:complex^M->complex^N x. clinear f ==> (f (--x) = --(f x))`, ONCE_REWRITE_TAC[CVECTOR_NEG_MINUS1] THEN SIMP_TAC[CLINEAR_CMUL]);; let CLINEAR_ADD = prove (`!f:complex^M->complex^N x y. clinear f ==> (f (x + y) = f x + f y)`, SIMP_TAC[clinear]);; let CLINEAR_SUB = prove (`!f:complex^M->complex^N x y. clinear f ==> (f(x - y) = f x - f y)`, SIMP_TAC[CVECTOR_SUB;CLINEAR_ADD;CLINEAR_NEG]);; let CLINEAR_INJECTIVE_0 = prove (`!f:complex^M->complex^N. clinear f ==> ((!x y. f x = f y ==> x = y) <=> (!x. f x = cvector_zero ==> x = cvector_zero))`, ONCE_REWRITE_TAC[GSYM CVECTOR_SUB_EQ] THEN SIMP_TAC[CVECTOR_SUB_RZERO;GSYM CLINEAR_SUB] THEN MESON_TAC[CVECTOR_SUB_RZERO]);; (* ========================================================================= *) (* PASTING COMPLEX VECTORS *) (* ========================================================================= *) let CLINEAR_FSTCART_SNDCART = prove (`clinear fstcart /\ clinear sndcart`, SIMP_TAC[clinear;fstcart;sndcart;CART_EQ;LAMBDA_BETA;CVECTOR_ADD_COMPONENT; CVECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM; ARITH_RULE `x <= a ==> x <= a + b:num`; ARITH_RULE `x <= b ==> x + a <= a + b:num`]);; let FSTCART_CLINEAR = CONJUNCT1 CLINEAR_FSTCART_SNDCART;; let SNDCART_CLINEAR = CONJUNCT2 CLINEAR_FSTCART_SNDCART;; let FSTCART_SNDCART_CVECTOR_ZERO = prove (`fstcart cvector_zero = cvector_zero /\ sndcart cvector_zero = cvector_zero`, SIMP_TAC[CVECTOR_ZERO_COMPONENT;fstcart;sndcart;LAMBDA_BETA;CART_EQ; DIMINDEX_FINITE_SUM;ARITH_RULE `x <= a ==> x <= a + b:num`; ARITH_RULE `x <= b ==> x + a <= a + b:num`]);; let FSTCART_CVECTOR_ZERO = CONJUNCT1 FSTCART_SNDCART_CVECTOR_ZERO;; let SNDCART_CVECTOR_ZERO = CONJUNCT2 FSTCART_SNDCART_CVECTOR_ZERO;; let FSTCART_SNDCART_CVECTOR_ADD = prove (`!x:complex^(M,N)finite_sum y. fstcart(x + y) = fstcart(x) + fstcart(y) /\ sndcart(x + y) = sndcart(x) + sndcart(y)`, REWRITE_TAC[REWRITE_RULE[clinear] CLINEAR_FSTCART_SNDCART]);; let FSTCART_SNDCART_CVECTOR_MUL = prove (`!x:complex^(M,N)finite_sum c. fstcart(c % x) = c % fstcart(x) /\ sndcart(c % x) = c % sndcart(x)`, REWRITE_TAC[REWRITE_RULE[clinear] CLINEAR_FSTCART_SNDCART]);; let PASTECART_TAC xs = REWRITE_TAC(PASTECART_EQ::FSTCART_PASTECART::SNDCART_PASTECART::xs);; let PASTECART_CVECTOR_ZERO = prove (`pastecart (cvector_zero:complex^N) (cvector_zero:complex^M) = cvector_zero`, PASTECART_TAC[FSTCART_SNDCART_CVECTOR_ZERO]);; let PASTECART_EQ_CVECTOR_ZERO = prove (`!x:complex^N y:complex^M. pastecart x y = cvector_zero <=> x = cvector_zero /\ y = cvector_zero`, PASTECART_TAC [FSTCART_SNDCART_CVECTOR_ZERO]);; let PASTECART_CVECTOR_ADD = prove (`!x1 y2 x2:complex^N y2:complex^M. pastecart x1 y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)`, PASTECART_TAC [FSTCART_SNDCART_CVECTOR_ADD]);; let PASTECART_CVECTOR_MUL = prove (`!x1 x2 c:complex. pastecart (c % x1) (c % y1) = c % pastecart x1 y1`, PASTECART_TAC [FSTCART_SNDCART_CVECTOR_MUL]);; (* ========================================================================= *) (* REAL AND IMAGINARY VECTORS *) (* ========================================================================= *) let cvector_re = new_definition `cvector_re :complex^N -> real^N = vector_map Re`;; let cvector_im = new_definition `cvector_im :complex^N -> real^N = vector_map Im`;; let vector_to_cvector = new_definition `vector_to_cvector :real^N -> complex^N = vector_map Cx`;; let CVECTOR_RE_COMPONENT = prove (`!x:complex^N i. (cvector_re x)$i = Re (x$i)`, REWRITE_TAC[cvector_re;VECTOR_MAP_COMPONENT]);; let CVECTOR_IM_COMPONENT = prove (`!x:complex^N i. (cvector_im x)$i = Im (x$i)`, REWRITE_TAC[cvector_im;VECTOR_MAP_COMPONENT]);; let VECTOR_TO_CVECTOR_COMPONENT = prove (`!x:real^N i. (vector_to_cvector x)$i = Cx(x$i)`, REWRITE_TAC[vector_to_cvector;VECTOR_MAP_COMPONENT]);; let VECTOR_TO_CVECTOR_ZERO = prove (`vector_to_cvector (vec 0) = cvector_zero:complex^N`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_ZERO_COMPONENT; VEC_COMPONENT]);; let VECTOR_TO_CVECTOR_ZERO_EQ = prove (`!x:real^N. vector_to_cvector x = cvector_zero <=> x = vec 0`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[VECTOR_TO_CVECTOR_ZERO] THEN ONCE_REWRITE_TAC[CART_EQ] THEN SIMP_TAC[VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_ZERO_COMPONENT; VEC_COMPONENT;CX_INJ]);; let CVECTOR_ZERO_VEC0 = prove (`!x:complex^N. x = cvector_zero <=> cvector_re x = vec 0 /\ cvector_im x = vec 0`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT;CVECTOR_RE_COMPONENT; CVECTOR_IM_COMPONENT;VEC_COMPONENT;COMPLEX_EQ;RE_CX;IM_CX] THEN MESON_TAC[]);; let VECTOR_TO_CVECTOR_MUL = prove (`!a x:real^N. vector_to_cvector (a % x) = Cx a % vector_to_cvector x`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_MUL_COMPONENT;VECTOR_MUL_COMPONENT;CX_MUL]);; let CVECTOR_EQ = prove (`!x:complex^N y z. x = vector_to_cvector y + ii % vector_to_cvector z <=> cvector_re x = y /\ cvector_im x = z`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT; CVECTOR_RE_COMPONENT;CVECTOR_IM_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT] THEN REWRITE_TAC[COMPLEX_EQ;RE_CX;IM_CX;RE_ADD;IM_ADD;RE_MUL_II;REAL_NEG_0; REAL_ADD_RID;REAL_ADD_LID;IM_MUL_II] THEN MESON_TAC[]);; let CVECTOR_RE_VECTOR_TO_CVECTOR = prove (`!x:real^N. cvector_re (vector_to_cvector x) = x`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_RE_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;RE_CX]);; let CVECTOR_IM_VECTOR_TO_CVECTOR = prove (`!x:real^N. cvector_im (vector_to_cvector x) = vec 0`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;IM_CX; VEC_COMPONENT]);; let CVECTOR_IM_VECTOR_TO_CVECTOR_IM = prove (`!x:real^N. cvector_im (ii % vector_to_cvector x) = x`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;IM_CX; VEC_COMPONENT;CVECTOR_MUL_COMPONENT;IM_MUL_II;RE_CX]);; let VECTOR_TO_CVECTOR_CVECTOR_RE_IM = prove (`!x:complex^N. vector_to_cvector (cvector_re x) + ii % vector_to_cvector (cvector_im x) = x`, GEN_TAC THEN MATCH_MP_TAC EQ_SYM THEN REWRITE_TAC[CVECTOR_EQ]);; let CVECTOR_IM_VECTOR_TO_CVECTOR_RE_IM = prove (`!x y:real^N. cvector_im (vector_to_cvector x + ii % vector_to_cvector y) = y`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;CVECTOR_ADD_COMPONENT; CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;IM_ADD;IM_CX;IM_MUL_II; RE_CX;REAL_ADD_LID]);; let CVECTOR_RE_VECTOR_TO_CVECTOR_RE_IM = prove (`!x y:real^N. cvector_re (vector_to_cvector x + ii % vector_to_cvector y)= x`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_RE_COMPONENT;CVECTOR_ADD_COMPONENT; CVECTOR_MUL_COMPONENT;RE_ADD;VECTOR_TO_CVECTOR_COMPONENT;RE_CX;RE_MUL_CX; RE_II;REAL_MUL_LZERO;REAL_ADD_RID]);; let CVECTOR_RE_ADD = prove (`!x y:complex^N. cvector_re (x+y) = cvector_re x + cvector_re y`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_RE_COMPONENT; VECTOR_ADD_COMPONENT;CVECTOR_ADD_COMPONENT;RE_ADD]);; let CVECTOR_IM_ADD = prove (`!x y:complex^N. cvector_im (x+y) = cvector_im x + cvector_im y`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_ADD_COMPONENT; CVECTOR_ADD_COMPONENT;IM_ADD]);; let CVECTOR_RE_MUL = prove (`!a x:complex^N. cvector_re (Cx a % x) = a % cvector_re x`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_RE_COMPONENT;VECTOR_MUL_COMPONENT; CVECTOR_MUL_COMPONENT;RE_MUL_CX]);; let CVECTOR_IM_MUL = prove (`!a x:complex^N. cvector_im (Cx a % x) = a % cvector_im x`, ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_MUL_COMPONENT; CVECTOR_MUL_COMPONENT;IM_MUL_CX]);; let CVECTOR_RE_VECTOR_MAP = prove (`!f v:A^N. cvector_re (vector_map f v) = vector_map (Re o f) v`, REWRITE_TAC[cvector_re;VECTOR_MAP_VECTOR_MAP]);; let CVECTOR_IM_VECTOR_MAP = prove (`!f v:A^N. cvector_im (vector_map f v) = vector_map (Im o f) v`, REWRITE_TAC[cvector_im;VECTOR_MAP_VECTOR_MAP]);; let VECTOR_MAP_CVECTOR_RE = prove (`!f:real->A v:complex^N. vector_map f (cvector_re v) = vector_map (f o Re) v`, REWRITE_TAC[cvector_re;VECTOR_MAP_VECTOR_MAP]);; let VECTOR_MAP_CVECTOR_IM = prove (`!f:real->A v:complex^N. vector_map f (cvector_im v) = vector_map (f o Im) v`, REWRITE_TAC[cvector_im;VECTOR_MAP_VECTOR_MAP]);; let CVECTOR_RE_VECTOR_MAP2 = prove (`!f v1:A^N v2:B^N. cvector_re (vector_map2 f v1 v2) = vector_map2 (\x y. Re (f x y)) v1 v2`, REWRITE_TAC[cvector_re;VECTOR_MAP_VECTOR_MAP2]);; let CVECTOR_IM_VECTOR_MAP2 = prove (`!f v1:A^N v2:B^N. cvector_im (vector_map2 f v1 v2) = vector_map2 (\x y. Im (f x y)) v1 v2`, REWRITE_TAC[cvector_im;VECTOR_MAP_VECTOR_MAP2]);; (* ========================================================================= *) (* FLATTENING COMPLEX VECTORS INTO REAL VECTORS *) (* *) (* Note: *) (* Theoretically, the following could be defined more generally for matrices *) (* instead of complex vectors, but this would require a "finite_prod" type *) (* constructor, which is not available right now, and which, at first sight, *) (* would probably require dependent types. *) (* ========================================================================= *) let cvector_flatten = new_definition `cvector_flatten (v:complex^N) :real^(N,N) finite_sum = pastecart (cvector_re v) (cvector_im v)`;; let FLATTEN_RE_IM_COMPONENT = prove (`!v:complex^N i. 1 <= i /\ i <= 2 * dimindex(:N) ==> (cvector_flatten v)$i = if i <= dimindex(:N) then (cvector_re v)$i else (cvector_im v)$(i-dimindex(:N))`, SIMP_TAC[MULT_2;GSYM DIMINDEX_FINITE_SUM;cvector_flatten;pastecart; LAMBDA_BETA]);; let complex_vector = new_definition `complex_vector (v1,v2) :complex^N = vector_map2 (\x y. Cx x + ii * Cx y) v1 v2`;; let COMPLEX_VECTOR_TRANSPOSE = prove( `!v1 v2:real^N. complex_vector (v1,v2) = vector_to_cvector v1 + ii % vector_to_cvector v2`, ONCE_REWRITE_TAC[CART_EQ] THEN SIMP_TAC[complex_vector;CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT; VECTOR_TO_CVECTOR_COMPONENT;VECTOR_MAP2_COMPONENT]);; let cvector_unflatten = new_definition `cvector_unflatten (v:real^(N,N) finite_sum) :complex^N = complex_vector (fstcart v, sndcart v)`;; let UNFLATTEN_FLATTEN = prove (`cvector_unflatten o cvector_flatten = I :complex^N -> complex^N`, REWRITE_TAC[FUN_EQ_THM;o_DEF;I_DEF;cvector_flatten;cvector_unflatten; FSTCART_PASTECART;SNDCART_PASTECART;COMPLEX_VECTOR_TRANSPOSE; VECTOR_TO_CVECTOR_CVECTOR_RE_IM]);; let FLATTEN_UNFLATTEN = prove (`cvector_flatten o cvector_unflatten = I :real^(N,N) finite_sum -> real^(N,N) finite_sum`, REWRITE_TAC[FUN_EQ_THM;o_DEF;I_DEF;cvector_flatten;cvector_unflatten; PASTECART_FST_SND;COMPLEX_VECTOR_TRANSPOSE; CVECTOR_RE_VECTOR_TO_CVECTOR_RE_IM;CVECTOR_IM_VECTOR_TO_CVECTOR_RE_IM]);; let FLATTEN_CLINEAR = prove (`!f:complex^N->complex^M. clinear f ==> linear (cvector_flatten o f o cvector_unflatten)`, REWRITE_TAC[clinear;linear;cvector_flatten;cvector_unflatten;o_DEF; FSTCART_ADD;SNDCART_ADD;PASTECART_ADD;complex_vector;GSYM PASTECART_CMUL] THEN REPEAT STRIP_TAC THEN REPEAT (AP_TERM_TAC ORELSE MK_COMB_TAC) THEN REWRITE_TAC(map GSYM [CVECTOR_RE_ADD;CVECTOR_IM_ADD;CVECTOR_RE_MUL; CVECTOR_IM_MUL]) THEN AP_TERM_TAC THEN ASSUM_LIST (REWRITE_TAC o map GSYM) THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN SIMP_TAC[VECTOR_MAP2_COMPONENT;VECTOR_ADD_COMPONENT; CVECTOR_ADD_COMPONENT;CX_ADD;VECTOR_MUL_COMPONENT;CVECTOR_MUL_COMPONENT; FSTCART_CMUL;SNDCART_CMUL;CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC);; let FLATTEN_MAP = prove (`!f g. f = vector_map g ==> !x:complex^N. cvector_flatten (vector_map f x) = vector_map g (cvector_flatten x)`, SIMP_TAC[cvector_flatten;CVECTOR_RE_VECTOR_MAP;CVECTOR_IM_VECTOR_MAP; GSYM PASTECART_VECTOR_MAP;VECTOR_MAP_CVECTOR_RE;VECTOR_MAP_CVECTOR_IM; o_DEF;IM_DEF;RE_DEF;VECTOR_MAP_COMPONENT]);; let FLATTEN_NEG = prove (`!x:complex^N. cvector_flatten (--x) = --(cvector_flatten x)`, REWRITE_TAC[cvector_neg;MATCH_MP FLATTEN_MAP COMPLEX_NEG_IS_A_MAP] THEN REWRITE_TAC[VECTOR_NEG_IS_A_MAP]);; let CVECTOR_NEG_ALT = prove (`!x:complex^N. --x = cvector_unflatten (--(cvector_flatten x))`, REWRITE_TAC[GSYM FLATTEN_NEG; REWRITE_RULE[o_DEF;FUN_EQ_THM;I_DEF] UNFLATTEN_FLATTEN]);; let FLATTEN_MAP2 = prove( `!f g. f = vector_map2 g ==> !x y:complex^N. cvector_flatten (vector_map2 f x y) = vector_map2 g (cvector_flatten x) (cvector_flatten y)`, SIMP_TAC[cvector_flatten;CVECTOR_RE_VECTOR_MAP2;CVECTOR_IM_VECTOR_MAP2; CVECTOR_RE_VECTOR_MAP2;GSYM PASTECART_VECTOR_MAP2] THEN REWRITE_TAC[cvector_re;cvector_im;VECTOR_MAP2_LVECTOR_MAP; VECTOR_MAP2_RVECTOR_MAP] THEN REPEAT MK_COMB_TAC THEN REWRITE_TAC[FUN_EQ_THM;IM_DEF;RE_DEF;VECTOR_MAP2_COMPONENT;o_DEF]);; let FLATTEN_ADD = prove (`!x y:complex^N. cvector_flatten (x+y) = cvector_flatten x + cvector_flatten y`, REWRITE_TAC[cvector_add;MATCH_MP FLATTEN_MAP2 COMPLEX_ADD_IS_A_MAP] THEN REWRITE_TAC[VECTOR_ADD_IS_A_MAP]);; let CVECTOR_ADD_ALT = prove (`!x y:complex^N. x+y = cvector_unflatten (cvector_flatten x + cvector_flatten y)`, REWRITE_TAC[GSYM FLATTEN_ADD; REWRITE_RULE[o_DEF;FUN_EQ_THM;I_DEF] UNFLATTEN_FLATTEN]);; let FLATTEN_SUB = prove (`!x y:complex^N. cvector_flatten (x-y) = cvector_flatten x - cvector_flatten y`, REWRITE_TAC[cvector_sub;MATCH_MP FLATTEN_MAP2 COMPLEX_SUB_IS_A_MAP] THEN REWRITE_TAC[VECTOR_SUB_IS_A_MAP]);; let CVECTOR_SUB_ALT = prove (`!x y:complex^N. x-y = cvector_unflatten (cvector_flatten x - cvector_flatten y)`, REWRITE_TAC[GSYM FLATTEN_SUB; REWRITE_RULE[o_DEF;FUN_EQ_THM;I_DEF] UNFLATTEN_FLATTEN]);; (* ========================================================================= *) (* CONJUGATE VECTOR. *) (* ========================================================================= *) let cvector_cnj = new_definition `cvector_cnj : complex^N->complex^N = vector_map cnj`;; let CVECTOR_MAP_PROPERTY thm = VECTOR_MAP_PROPERTY thm [cvector_zero;cvector_add;cvector_sub;cvector_neg; cvector_mul;cvector_cnj;cvector_re;cvector_im];; let CVECTOR_CNJ_ADD = CVECTOR_MAP_PROPERTY `!x y:complex^N. cvector_cnj (x+y) = cvector_cnj x + cvector_cnj y` CNJ_ADD;; let CVECTOR_CNJ_SUB = CVECTOR_MAP_PROPERTY `!x y:complex^N. cvector_cnj (x-y) = cvector_cnj x - cvector_cnj y` CNJ_SUB;; let CVECTOR_CNJ_NEG = CVECTOR_MAP_PROPERTY `!x:complex^N. cvector_cnj (--x) = --(cvector_cnj x)` CNJ_NEG;; let CVECTOR_RE_CNJ = CVECTOR_MAP_PROPERTY `!x:complex^N. cvector_re (cvector_cnj x) = cvector_re x` RE_CNJ;; let CVECTOR_IM_CNJ = prove (`!x:complex^N. cvector_im (cvector_cnj x) = --(cvector_im x)`, VECTOR_MAP_PROPERTY_TAC[cvector_im;cvector_cnj;VECTOR_NEG_IS_A_MAP] IM_CNJ);; let CVECTOR_CNJ_CNJ = CVECTOR_MAP_PROPERTY `!x:complex^N. cvector_cnj (cvector_cnj x) = x` CNJ_CNJ;; (* ========================================================================= *) (* CROSS PRODUCTS IN COMPLEX^3. *) (* ========================================================================= *) prioritize_vector();; parse_as_infix("ccross",(20,"right"));; let ccross = new_definition `((ccross):complex^3 -> complex^3 -> complex^3) x y = vector [ x$2 * y$3 - x$3 * y$2; x$3 * y$1 - x$1 * y$3; x$1 * y$2 - x$2 * y$1 ]`;; let CCROSS_COMPONENT = prove (`!x y:complex^3. (x ccross y)$1 = x$2 * y$3 - x$3 * y$2 /\ (x ccross y)$2 = x$3 * y$1 - x$1 * y$3 /\ (x ccross y)$3 = x$1 * y$2 - x$2 * y$1`, REWRITE_TAC[ccross;VECTOR_3]);; (* simple handy instantiation of CART_EQ for dimension 3*) let CART_EQ3 = prove (`!x y:complex^3. x = y <=> x$1 = y$1 /\ x$2 = y$2 /\ x$3 = y$3`, GEN_REWRITE_TAC (PATH_CONV "rbrblr") [CART_EQ] THEN REWRITE_TAC[DIMINDEX_3;FORALL_3]);; let CCROSS_TAC lemmas = REWRITE_TAC(CART_EQ3::CCROSS_COMPONENT::lemmas) THEN SIMPLE_COMPLEX_ARITH_TAC;; let CCROSS_LZERO = prove (`!x:complex^3. cvector_zero ccross x = cvector_zero`, CCROSS_TAC[CVECTOR_ZERO_COMPONENT]);; let CCROSS_RZERO = prove (`!x:complex^3. x ccross cvector_zero = cvector_zero`, CCROSS_TAC[CVECTOR_ZERO_COMPONENT]);; let CCROSS_SKEW = prove (`!x y:complex^3. (x ccross y) = --(y ccross x)`, CCROSS_TAC[CVECTOR_NEG_COMPONENT]);; let CCROSS_REFL = prove (`!x:complex^3. x ccross x = cvector_zero`, CCROSS_TAC[CVECTOR_ZERO_COMPONENT]);; let CCROSS_LADD = prove (`!x y z:complex^3. (x + y) ccross z = (x ccross z) + (y ccross z)`, CCROSS_TAC[CVECTOR_ADD_COMPONENT]);; let CCROSS_RADD = prove (`!x y z:complex^3. x ccross(y + z) = (x ccross y) + (x ccross z)`, CCROSS_TAC[CVECTOR_ADD_COMPONENT]);; let CCROSS_LMUL = prove (`!c x y:complex^3. (c % x) ccross y = c % (x ccross y)`, CCROSS_TAC[CVECTOR_MUL_COMPONENT]);; let CCROSS_RMUL = prove (`!c x y:complex^3. x ccross (c % y) = c % (x ccross y)`, CCROSS_TAC[CVECTOR_MUL_COMPONENT]);; let CCROSS_LNEG = prove (`!x y:complex^3. (--x) ccross y = --(x ccross y)`, CCROSS_TAC[CVECTOR_NEG_COMPONENT]);; let CCROSS_RNEG = prove (`!x y:complex^3. x ccross (--y) = --(x ccross y)`, CCROSS_TAC[CVECTOR_NEG_COMPONENT]);; let CCROSS_JACOBI = prove (`!(x:complex^3) y z. x ccross (y ccross z) + y ccross (z ccross x) + z ccross (x ccross y) = cvector_zero`, REWRITE_TAC[CART_EQ3] THEN REWRITE_TAC[CVECTOR_ADD_COMPONENT;CCROSS_COMPONENT; CVECTOR_ZERO_COMPONENT] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ========================================================================= *) (* DOT PRODUCTS IN COMPLEX^N *) (* *) (* Only difference with the real case: *) (* we take the conjugate of the 2nd argument *) (* ========================================================================= *) prioritize_complex();; parse_as_infix("cdot",(20,"right"));; let cdot = new_definition `(cdot) (x:complex^N) (y:complex^N) = vsum (1..dimindex(:N)) (\i. x$i * cnj(y$i))`;; (* The dot product is symmetric MODULO the conjugate *) let CDOT_SYM = prove (`!x:complex^N y. x cdot y = cnj (y cdot x)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[MATCH_MP (SPEC_ALL CNJ_VSUM) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[CNJ_MUL;CNJ_CNJ;COMPLEX_MUL_SYM]);; let REAL_CDOT_SELF = prove (`!x:complex^N. real(x cdot x)`, REWRITE_TAC[REAL_CNJ;GSYM CDOT_SYM]);; (* The following theorems are usual axioms of the hermitian dot product, they are proved later on. * let CDOT_SELF_POS = prove(`!x:complex^N. &0 <= real_of_complex (x cdot x)`, ... * let CDOT_EQ_0 = prove(`!x:complex^N. x cdot x = Cx(&0) <=> x = cvector_zero` *) let CDOT_LADD = prove (`!x:complex^N y z. (x + y) cdot z = (x cdot z) + (y cdot z)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_ADD) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`;`(y:real^2^N)$(x':num)`; `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_ADD_RDISTRIB)] THEN REWRITE_TAC[CVECTOR_ADD_COMPONENT]);; let CDOT_RADD = prove (`!x:complex^N y z. x cdot (y + z) = (x cdot y) + (x cdot z)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_ADD) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`; `cnj((y:real^2^N)$(x':num))`; `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_ADD_LDISTRIB)] THEN REWRITE_TAC[CNJ_ADD; CVECTOR_ADD_COMPONENT]);; let CDOT_LSUB = prove (`!x:complex^N y z. (x - y) cdot z = (x cdot z) - (y cdot z)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_SUB) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`; `(y:real^2^N)$(x':num)`; `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_SUB_RDISTRIB)] THEN REWRITE_TAC[CVECTOR_SUB_COMPONENT]);; let CDOT_RSUB = prove (`!x:complex^N y z. x cdot (y - z) = (x cdot y) - (x cdot z)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_SUB) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`; `cnj((y:real^2^N)$(x':num))`; `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_SUB_LDISTRIB)] THEN REWRITE_TAC[CNJ_SUB; CVECTOR_SUB_COMPONENT]);; let CDOT_LMUL = prove (`!c:complex x:complex^N y. (c % x) cdot y = c * (x cdot y)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT; GSYM COMPLEX_MUL_ASSOC]);; let CDOT_RMUL = prove (`!c:complex x:complex^N x y. x cdot (c % y) = cnj c * (x cdot y)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT; CNJ_MUL; COMPLEX_MUL_AC]);; let CDOT_LNEG = prove (`!x:complex^N y. (--x) cdot y = --(x cdot y)`, REWRITE_TAC[cdot] THEN ONCE_REWRITE_TAC[COMPLEX_NEG_MINUS1] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[CVECTOR_NEG_COMPONENT] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_NEG_MINUS1] THEN REWRITE_TAC[COMPLEX_NEG_LMUL]);; let CDOT_RNEG = prove (`!x:complex^N y. x cdot (--y) = --(x cdot y)`, REWRITE_TAC[cdot] THEN ONCE_REWRITE_TAC[COMPLEX_NEG_MINUS1] THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_NEG_MINUS1] THEN REWRITE_TAC[CVECTOR_NEG_COMPONENT; CNJ_NEG; COMPLEX_NEG_RMUL]);; let CDOT_LZERO = prove (`!x:complex^N. cvector_zero cdot x = Cx (&0)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; GSYM COMPLEX_VEC_0; VSUM_0]);; let CNJ_ZERO = prove( `cnj (Cx(&0)) = Cx(&0)`, REWRITE_TAC[cnj;RE_CX;IM_CX;CX_DEF;REAL_NEG_0]);; let CDOT_RZERO = prove( `!x:complex^N. x cdot cvector_zero = Cx (&0)`, REWRITE_TAC[cdot] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT] THEN REWRITE_TAC[CNJ_ZERO] THEN REWRITE_TAC[COMPLEX_MUL_RZERO;GSYM COMPLEX_VEC_0;VSUM_0]);; (* Cauchy Schwarz inequality: proved later on * let CDOT_CAUCHY_SCHWARZ = prove (`!x y:complex^N. norm (x cdot y) pow 2 <= cnorm2 x * cnorm2 y`, * let CDOT_CAUCHY_SCHWARZ_EQUAL = prove(`!x y:complex^N. norm (x cdot y) pow 2 = cnorm2 x * cnorm2 y <=> collinear_cvectors x y`, *) let CDOT3 = prove (`!x y:complex^3. x cdot y = (x$1 * cnj (y$1) + x$2 * cnj (y$2) + x$3 * cnj (y$3))`, REWRITE_TAC[cdot] THEN SIMP_TAC [DIMINDEX_3] THEN REWRITE_TAC[VSUM_3]);; let ADD_CDOT_SYM = prove( `!x y:complex^N. x cdot y + y cdot x = Cx(&2 * Re(x cdot y))`, MESON_TAC[CDOT_SYM;COMPLEX_ADD_CNJ]);; (* ========================================================================= *) (* RELATION WITH REAL DOT AND CROSS PRODUCTS *) (* ========================================================================= *) let CCROSS_LREAL = prove (`!r c. (vector_to_cvector r) ccross c = vector_to_cvector (r cross (cvector_re c)) + ii % (vector_to_cvector (r cross (cvector_im c)))`, REWRITE_TAC[CART_EQ3;CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT; VECTOR_TO_CVECTOR_COMPONENT;CCROSS_COMPONENT;CROSS_COMPONENTS; CVECTOR_RE_COMPONENT;CVECTOR_IM_COMPONENT;complex_mul;RE_CX;IM_CX;CX_DEF; complex_sub;complex_neg;complex_add;RE;IM;RE_II;IM_II] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN ARITH_TAC);; let CCROSS_RREAL = prove (`!r c. c ccross (vector_to_cvector r) = vector_to_cvector ((cvector_re c) cross r) + ii % (vector_to_cvector ((cvector_im c) cross r))`, REWRITE_TAC[CART_EQ3;CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT; VECTOR_TO_CVECTOR_COMPONENT;CCROSS_COMPONENT;CROSS_COMPONENTS; CVECTOR_RE_COMPONENT;CVECTOR_IM_COMPONENT;complex_mul;RE_CX;IM_CX;CX_DEF; complex_sub;complex_neg;complex_add;RE;IM;RE_II;IM_II] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN ARITH_TAC);; let CDOT_LREAL = prove (`!r c. (vector_to_cvector r) cdot c = Cx (r dot (cvector_re c)) - ii * Cx (r dot (cvector_im c))`, REWRITE_TAC[cdot; dot; VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_RE_COMPONENT; CVECTOR_IM_COMPONENT] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [COMPLEX_EXPAND] THEN REWRITE_TAC[MATCH_MP RE_VSUM (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[MATCH_MP (IM_VSUM) (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[RE_MUL_CX;RE_CNJ;IM_MUL_CX;IM_CNJ] THEN REWRITE_TAC[COMPLEX_POLY_NEG_CLAUSES] THEN REWRITE_TAC[COMPLEX_MUL_AC] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM CX_MUL] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1;GSYM REAL_MUL_RNEG]);; let CDOT_RREAL = prove (`!r c. c cdot (vector_to_cvector r) = Cx ((cvector_re c) dot r) + ii * Cx ((cvector_im c) dot r)`, REWRITE_TAC[cdot; dot; VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_RE_COMPONENT; CVECTOR_IM_COMPONENT] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [COMPLEX_EXPAND] THEN REWRITE_TAC[MATCH_MP RE_VSUM (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[MATCH_MP IM_VSUM (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))] THEN REWRITE_TAC[CNJ_CX] THEN REWRITE_TAC[RE_MUL_CX;RE_CNJ;IM_MUL_CX;IM_CNJ]);; (* ========================================================================= *) (* NORM, UNIT VECTORS. *) (* ========================================================================= *) let cnorm2 = new_definition `cnorm2 (v:complex^N) = real_of_complex (v cdot v)`;; let CX_CNORM2 = prove (`!v:complex^N. Cx(cnorm2 v) = v cdot v`, SIMP_TAC[cnorm2;REAL_CDOT_SELF;REAL_OF_COMPLEX]);; let CNORM2_CVECTOR_ZERO = prove (`cnorm2 (cvector_zero:complex^N) = &0`, REWRITE_TAC[cnorm2;CDOT_RZERO;REAL_OF_COMPLEX_CX]);; let CNORM2_MODULUS = prove (`!x:complex^N. cnorm2 x = (vector_map norm x) dot (vector_map norm x)`, REWRITE_TAC[cnorm2;cdot;COMPLEX_MUL_CNJ;COMPLEX_POW_2;GSYM CX_MUL; VSUM_CX_NUMSEG;dot;VECTOR_MAP_COMPONENT;REAL_OF_COMPLEX_CX]);; let CNORM2_EQ_0 = prove (`!x:complex^N. cnorm2 x = &0 <=> x = cvector_zero`, REWRITE_TAC[CNORM2_MODULUS;CX_INJ;DOT_EQ_0] THEN GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o DEPTH_CONV) [CART_EQ] THEN REWRITE_TAC[VEC_COMPONENT;VECTOR_MAP_COMPONENT;COMPLEX_NORM_ZERO] THEN GEN_REWRITE_TAC (RAND_CONV o DEPTH_CONV) [CART_EQ] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT]);; let CDOT_EQ_0 = prove (`!x:complex^N. x cdot x = Cx(&0) <=> x = cvector_zero`, SIMP_TAC[TAUT `(p<=>q) <=> ((p==>q) /\ (q==>p))`;CDOT_LZERO] THEN GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP (MESON[REAL_OF_COMPLEX_CX] `x = Cx y ==> real_of_complex x = y`)) THEN REWRITE_TAC[GSYM cnorm2;CNORM2_EQ_0]);; let CNORM2_POS = prove (`!x:complex^N. &0 <= cnorm2 x`, REWRITE_TAC[CNORM2_MODULUS;DOT_POS_LE]);; let CDOT_SELF_POS = prove (`!x:complex^N. &0 <= real_of_complex (x cdot x)`, REWRITE_TAC[GSYM cnorm2;CNORM2_POS]);; let CNORM2_MUL = prove (`!a x:complex^N. cnorm2 (a % x) = (norm a) pow 2 * cnorm2 x`, SIMP_TAC[cnorm2;CDOT_LMUL;CDOT_RMUL; SIMPLE_COMPLEX_ARITH `x * cnj x * y = (x * cnj x) * y`;COMPLEX_MUL_CNJ; REAL_OF_COMPLEX_CX;REAL_OF_COMPLEX_MUL;REAL_CX;REAL_CDOT_SELF; GSYM CX_POW]);; let CNORM2_NORM2_2 = prove (`!x y:real^N. cnorm2 (vector_to_cvector x + ii % vector_to_cvector y) = norm x pow 2 + norm y pow 2`, REWRITE_TAC[cnorm2;vector_norm;cdot;CVECTOR_ADD_COMPONENT; CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;CNJ_ADD;CNJ_CX;CNJ_MUL; CNJ_II;COMPLEX_ADD_RDISTRIB;COMPLEX_ADD_LDISTRIB; SIMPLE_COMPLEX_ARITH `(x*x+x*(--ii)*y)+(ii*y)*x+(ii*y)*(--ii)*y = x*x-(ii*ii)*y*y`] THEN REWRITE_TAC[GSYM COMPLEX_POW_2;COMPLEX_POW_II_2; SIMPLE_COMPLEX_ARITH `x-(--Cx(&1))*y = x+y`] THEN SIMP_TAC[MESON[CARD_NUMSEG_1;HAS_SIZE_NUMSEG_1;FINITE_HAS_SIZE] `FINITE (1..dimindex(:N))`;VSUM_ADD;GSYM CX_POW;VSUM_CX;GSYM dot; REAL_POW_2;GSYM dot] THEN SIMP_TAC[GSYM CX_ADD;REAL_OF_COMPLEX_CX;GSYM REAL_POW_2;DOT_POS_LE; SQRT_POW_2]);; let CNORM2_NORM2 = prove (`!v:complex^N. cnorm2 v = norm (cvector_re v) pow 2 + norm (cvector_im v) pow 2`, GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_TO_CVECTOR_CVECTOR_RE_IM] THEN REWRITE_TAC[CNORM2_NORM2_2]);; let CNORM2_ALT = prove (`!x:complex^N. cnorm2 x = norm (x cdot x)`, SIMP_TAC[cnorm2;REAL_OF_COMPLEX_NORM;REAL_CDOT_SELF;EQ_SYM_EQ;REAL_ABS_REFL; REWRITE_RULE[cnorm2] CNORM2_POS]);; let CNORM2_SUB = prove (`!x y:complex^N. cnorm2 (x-y) = cnorm2 (y-x)`, REWRITE_TAC[cnorm2;CDOT_LSUB;CDOT_RSUB] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN SIMPLE_COMPLEX_ARITH_TAC);; let CNORM2_VECTOR_TO_CVECTOR = prove (`!x:real^N. cnorm2 (vector_to_cvector x) = norm x pow 2`, REWRITE_TAC[CNORM2_ALT;CDOT_RREAL;CVECTOR_RE_VECTOR_TO_CVECTOR; CVECTOR_IM_VECTOR_TO_CVECTOR;DOT_LZERO;COMPLEX_MUL_RZERO;COMPLEX_ADD_RID; DOT_SQUARE_NORM;CX_POW;COMPLEX_NORM_POW;COMPLEX_NORM_CX;REAL_POW2_ABS]);; let cnorm = new_definition `cnorm :complex^N->real = sqrt o cnorm2`;; overload_interface ("norm",`cnorm:complex^N->real`);; let CNORM_CVECTOR_ZERO = prove (`norm (cvector_zero:complex^N) = &0`, REWRITE_TAC[cnorm;CNORM2_CVECTOR_ZERO;o_DEF;SQRT_0]);; let CNORM_POW_2 = prove (`!x:complex^N. norm x pow 2 = cnorm2 x`, SIMP_TAC[cnorm;o_DEF;SQRT_POW_2;CNORM2_POS]);; let CNORM_NORM_2 = prove (`!x y:real^N. norm (vector_to_cvector x + ii % vector_to_cvector y) = sqrt(norm x pow 2 + norm y pow 2)`, REWRITE_TAC[cnorm;o_DEF;CNORM2_NORM2_2]);; let CNORM_NORM = prove( `!v:complex^N. norm v = sqrt(norm (cvector_re v) pow 2 + norm (cvector_im v) pow 2)`, GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_TO_CVECTOR_CVECTOR_RE_IM] THEN REWRITE_TAC[CNORM_NORM_2]);; let CNORM_MUL = prove (`!a x:complex^N. norm (a % x) = norm a * norm x`, SIMP_TAC[cnorm;o_DEF;CNORM2_MUL;REAL_LE_POW_2;SQRT_MUL;CNORM2_POS; NORM_POS_LE;POW_2_SQRT]);; let CNORM_EQ_0 = prove (`!x:complex^N. norm x = &0 <=> x = cvector_zero`, SIMP_TAC[cnorm;o_DEF;SQRT_EQ_0;CNORM2_POS;CNORM2_EQ_0]);; let CNORM_POS = prove (`!x:complex^N. &0 <= norm x`, SIMP_TAC[cnorm;o_DEF;SQRT_POS_LE;CNORM2_POS]);; let CNORM_SUB = prove (`!x y:complex^N. norm (x-y) = norm (y-x)`, REWRITE_TAC[cnorm;o_DEF;CNORM2_SUB]);; let CNORM_VECTOR_TO_CVECTOR = prove (`!x:real^N. norm (vector_to_cvector x) = norm x`, SIMP_TAC[cnorm;o_DEF;CNORM2_VECTOR_TO_CVECTOR;POW_2_SQRT;NORM_POS_LE]);; let CNORM_BASIS = prove (`!k. 1 <= k /\ k <= dimindex(:N) ==> norm (vector_to_cvector (basis k :real^N)) = &1`, SIMP_TAC[NORM_BASIS;CNORM_VECTOR_TO_CVECTOR]);; let CNORM_BASIS_1 = prove (`norm(basis 1:real^N) = &1`, SIMP_TAC[NORM_BASIS_1;CNORM_VECTOR_TO_CVECTOR]);; let CVECTOR_CHOOSE_SIZE = prove (`!c. &0 <= c ==> ?x:complex^N. norm(x) = c`, MESON_TAC[VECTOR_CHOOSE_SIZE;CNORM_VECTOR_TO_CVECTOR]);; (* Triangle inequality. Proved later on using Cauchy Schwarz inequality. * let CNORM_TRIANGLE = prove(`!x y:complex^N. norm (x+y) <= norm x + norm y`, ... *) let cunit = new_definition `cunit (X:complex^N) = inv(Cx(norm X))% X`;; let CUNIT_CVECTOR_ZERO = prove (`cunit cvector_zero = cvector_zero:complex^N`, REWRITE_TAC[cunit;CNORM_CVECTOR_ZERO;COMPLEX_INV_0;CVECTOR_MUL_LZERO]);; let CDOT_CUNIT_MUL_CUNIT = prove (`!x:complex^N. (cunit x cdot x) % cunit x = x`, GEN_TAC THEN ASM_CASES_TAC `x = cvector_zero:complex^N` THEN ASM_REWRITE_TAC[CUNIT_CVECTOR_ZERO;CDOT_LZERO;CVECTOR_MUL_LZERO] THEN SIMP_TAC[cunit;CVECTOR_MUL_ASSOC;CDOT_LMUL; SIMPLE_COMPLEX_ARITH `(x*y)*x=(x*x)*y`;GSYM COMPLEX_INV_MUL;GSYM CX_MUL; GSYM REAL_POW_2;cnorm;o_DEF;CNORM2_POS;SQRT_POW_2] THEN ASM_SIMP_TAC[cnorm2;REAL_OF_COMPLEX;REAL_CDOT_SELF;CDOT_EQ_0; CNORM2_CVECTOR_ZERO;CVECTOR_MUL_RZERO;CNORM2_EQ_0;COMPLEX_MUL_LINV; CVECTOR_MUL_ID]);; (* ========================================================================= *) (* COLLINEARITY *) (* ========================================================================= *) (* Definition of collinearity between complex vectors. * Note: This is different from collinearity between points (which is the one defined in HOL-Light library) *) let collinear_cvectors = new_definition `collinear_cvectors x (y:complex^N) <=> ?a. y = a % x \/ x = a % y`;; let COLLINEAR_CVECTORS_SYM = prove (`!x y:complex^N. collinear_cvectors x y <=> collinear_cvectors y x`, REWRITE_TAC[collinear_cvectors] THEN MESON_TAC[]);; let COLLINEAR_CVECTORS_0 = prove (`!x:complex^N. collinear_cvectors x cvector_zero`, REWRITE_TAC[collinear_cvectors] THEN GEN_TAC THEN EXISTS_TAC `Cx(&0)` THEN REWRITE_TAC[CVECTOR_MUL_LZERO]);; let NON_NULL_COLLINEARS = prove (`!x y:complex^N. collinear_cvectors x y /\ ~(x=cvector_zero) /\ ~(y=cvector_zero) ==> ?a. ~(a=Cx(&0)) /\ y = a % x`, REWRITE_TAC[collinear_cvectors] THEN REPEAT STRIP_TAC THENL [ ASM_MESON_TAC[CVECTOR_MUL_LZERO]; SUBGOAL_THEN `~(a=Cx(&0))` ASSUME_TAC THENL [ ASM_MESON_TAC[CVECTOR_MUL_LZERO]; EXISTS_TAC `inv a :complex` THEN ASM_REWRITE_TAC[COMPLEX_INV_EQ_0;CVECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[COMPLEX_MUL_LINV;CVECTOR_MUL_ID]]]);; let COLLINEAR_LNONNULL = prove( `!x y:complex^N. collinear_cvectors x y /\ ~(x=cvector_zero) ==> ?a. y = a % x`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `y=cvector_zero:complex^N` THENL [ ASM_REWRITE_TAC[] THEN EXISTS_TAC `Cx(&0)` THEN ASM_MESON_TAC[CVECTOR_MUL_LZERO]; ASM_MESON_TAC[NON_NULL_COLLINEARS] ]);; let COLLINEAR_RNONNULL = prove( `!x y:complex^N. collinear_cvectors x y /\ ~(y=cvector_zero) ==> ?a. x = a % y`, MESON_TAC[COLLINEAR_LNONNULL;COLLINEAR_CVECTORS_SYM]);; let COLLINEAR_RUNITREAL = prove( `!x y:real^N. collinear_cvectors x (vector_to_cvector y) /\ norm y = &1 ==> x = (x cdot (vector_to_cvector y)) % vector_to_cvector y`, REPEAT STRIP_TAC THEN POP_ASSUM (DISTRIB [ASSUME_TAC; ASSUME_TAC o REWRITE_RULE[NORM_EQ_0; GSYM VECTOR_TO_CVECTOR_ZERO_EQ] o MATCH_MP (REAL_ARITH `!x. x= &1 ==> ~(x= &0)`)]) THEN FIRST_X_ASSUM (fun x -> FIRST_X_ASSUM (fun y -> CHOOSE_THEN (SINGLE ONCE_REWRITE_TAC) (MATCH_MP COLLINEAR_RNONNULL (CONJ y x)))) THEN REWRITE_TAC[CDOT_LMUL;CDOT_LREAL;CVECTOR_RE_VECTOR_TO_CVECTOR; CVECTOR_IM_VECTOR_TO_CVECTOR;DOT_RZERO;COMPLEX_MUL_RZERO;COMPLEX_SUB_RZERO] THEN POP_ASSUM ((fun x -> REWRITE_TAC[x;COMPLEX_MUL_RID]) o REWRITE_RULE[NORM_EQ_1]));; let CCROSS_COLLINEAR_CVECTORS = prove (`!x y:complex^3. x ccross y = cvector_zero <=> collinear_cvectors x y`, REWRITE_TAC[ccross;collinear_cvectors;CART_EQ3;VECTOR_3; CVECTOR_ZERO_COMPONENT;COMPLEX_SUB_0;CVECTOR_MUL_COMPONENT] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [ REPEAT (POP_ASSUM MP_TAC) THEN ASM_CASES_TAC `(x:complex^3)$1 = Cx(&0)` THENL [ ASM_CASES_TAC `(x:complex^3)$2 = Cx(&0)` THENL [ ASM_CASES_TAC `(x:complex^3)$3 = Cx(&0)` THENL [ REPEAT DISCH_TAC THEN EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_POLY_CLAUSES]; REPEAT STRIP_TAC THEN EXISTS_TAC `(y:complex^3)$3/(x:complex^3)$3` THEN ASM_SIMP_TAC[COMPLEX_BALANCE_DIV_MUL] THEN ASM_MESON_TAC[COMPLEX_MUL_AC];]; REPEAT STRIP_TAC THEN EXISTS_TAC `(y:complex^3)$2/(x:complex^3)$2` THEN ASM_SIMP_TAC[COMPLEX_BALANCE_DIV_MUL] THEN ASM_MESON_TAC[COMPLEX_MUL_AC]; ]; REPEAT STRIP_TAC THEN EXISTS_TAC `(y:complex^3)$1/(x:complex^3)$1` THEN ASM_SIMP_TAC[COMPLEX_BALANCE_DIV_MUL] THEN ASM_MESON_TAC[COMPLEX_MUL_AC];]; SIMPLE_COMPLEX_ARITH_TAC ]);; let CVECTOR_MUL_INV = prove (`!a x y:complex^N. ~(a = Cx(&0)) /\ x = a % y ==> y = inv a % x`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CVECTOR_MUL_ASSOC; MESON[] `(p\/q) <=> (~p ==> q)`;COMPLEX_MUL_LINV;CVECTOR_MUL_ID]);; let CVECTOR_MUL_INV2 = prove (`!a x y:complex^N. ~(x = cvector_zero) /\ x = a % y ==> y = inv a % x`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a=Cx(&0)` THEN ASM_MESON_TAC[CVECTOR_MUL_LZERO;CVECTOR_MUL_INV]);; let COLLINEAR_CVECTORS_VECTOR_TO_CVECTOR = prove( `!x y:real^N. collinear_cvectors (vector_to_cvector x) (vector_to_cvector y) <=> collinear {vec 0,x,y}`, REWRITE_TAC[COLLINEAR_LEMMA_ALT;collinear_cvectors] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT; VECTOR_MUL_COMPONENT;COMPLEX_EQ;RE_CX;RE_MUL_CX] THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN EXISTS_TAC `Re a` THEN ASM_SIMP_TAC[]; REWRITE_TAC[MESON[]`(p\/q) <=> (~p ==> q)`] THEN REWRITE_TAC[GSYM VECTOR_TO_CVECTOR_ZERO_EQ] THEN DISCH_TAC THEN SUBGOAL_TAC "" `vector_to_cvector (y:real^N) = inv a % vector_to_cvector x` [ASM_MESON_TAC[CVECTOR_MUL_INV2]] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT; VECTOR_MUL_COMPONENT;COMPLEX_EQ;RE_CX;RE_MUL_CX] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `Re(inv a)` THEN ASM_SIMP_TAC[]; EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[VECTOR_TO_CVECTOR_ZERO; CVECTOR_MUL_LZERO]; ASM_REWRITE_TAC[VECTOR_TO_CVECTOR_MUL] THEN EXISTS_TAC `Cx c` THEN REWRITE_TAC[]; ]);; (* ========================================================================= *) (* ORTHOGONALITY *) (* ========================================================================= *) let corthogonal = new_definition `corthogonal (x:complex^N) y <=> x cdot y = Cx(&0)`;; let CORTHOGONAL_SYM = prove( `!x y:complex^N. corthogonal x y <=> corthogonal y x`, MESON_TAC[corthogonal;CDOT_SYM;CNJ_ZERO]);; let CORTHOGONAL_0 = prove( `!x:complex^N. corthogonal cvector_zero x /\ corthogonal x cvector_zero`, REWRITE_TAC[corthogonal;CDOT_LZERO;CDOT_RZERO]);; let [CORTHOGONAL_LZERO;CORTHOGONAL_RZERO] = GCONJUNCTS CORTHOGONAL_0;; let CORTHOGONAL_COLLINEAR_CVECTORS = prove (`!x y:complex^N. collinear_cvectors x y /\ ~(x=cvector_zero) /\ ~(y=cvector_zero) ==> ~(corthogonal x y)`, REWRITE_TAC[collinear_cvectors;corthogonal] THEN REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[CDOT_RMUL;CDOT_LMUL;COMPLEX_ENTIRE;GSYM cnorm2; CDOT_EQ_0;CNJ_EQ_0] THEN ASM_MESON_TAC[CVECTOR_MUL_LZERO]);; let CORTHOGONAL_MUL_CLAUSES = prove (`!x y a. (corthogonal x y ==> corthogonal x (a%y)) /\ (corthogonal x y \/ a = Cx(&0) <=> corthogonal x (a%y)) /\ (corthogonal x y ==> corthogonal (a%x) y) /\ (corthogonal x y \/ a = Cx(&0) <=> corthogonal (a%x) y)`, SIMP_TAC[corthogonal;CDOT_RMUL;CDOT_LMUL;COMPLEX_ENTIRE;CNJ_EQ_0] THEN MESON_TAC[]);; let [CORTHOGONAL_RMUL;CORTHOGONAL_RMUL_EQ;CORTHOGONAL_LMUL; CORTHOGONAL_LMUL_EQ] = GCONJUNCTS CORTHOGONAL_MUL_CLAUSES;; let CORTHOGONAL_LRMUL_CLAUSES = prove (`!x y a b. (corthogonal x y ==> corthogonal (a%x) (b%y)) /\ (corthogonal x y \/ a = Cx(&0) \/ b = Cx(&0) <=> corthogonal (a%x) (b%y))`, MESON_TAC[CORTHOGONAL_MUL_CLAUSES]);; let [CORTHOGONAL_LRMUL;CORTHOGONAL_LRMUL_EQ] = GCONJUNCTS CORTHOGONAL_LRMUL_CLAUSES;; let CORTHOGONAL_REAL_CLAUSES = prove (`!r c. (corthogonal c (vector_to_cvector r) <=> orthogonal (cvector_re c) r /\ orthogonal (cvector_im c) r) /\ (corthogonal (vector_to_cvector r) c <=> orthogonal r (cvector_re c) /\ orthogonal r (cvector_im c))`, REWRITE_TAC[corthogonal;orthogonal;CDOT_LREAL;CDOT_RREAL;COMPLEX_SUB_0; COMPLEX_EQ;RE_CX;IM_CX;RE_SUB;IM_SUB;RE_ADD;IM_ADD] THEN REWRITE_TAC[RE_DEF;CX_DEF;IM_DEF;complex;complex_mul;VECTOR_2;ii] THEN CONV_TAC REAL_FIELD);; let [CORTHOGONAL_RREAL;CORTHOGONAL_LREAL] = GCONJUNCTS CORTHOGONAL_REAL_CLAUSES;; let CORTHOGONAL_UNIT = prove (`!x y:complex^N. (corthogonal x (cunit y) <=> corthogonal x y) /\ (corthogonal (cunit x) y <=> corthogonal x y)`, REWRITE_TAC[cunit;GSYM CORTHOGONAL_MUL_CLAUSES;COMPLEX_INV_EQ_0;CX_INJ; CNORM_EQ_0] THEN MESON_TAC[CORTHOGONAL_0]);; let [CORTHOGONAL_RUNIT;CORTHOGONAL_LUNIT] = GCONJUNCTS CORTHOGONAL_UNIT;; let CORTHOGONAL_PROJECTION = prove( `!x y:complex^N. corthogonal (x - (x cdot cunit y) % cunit y) y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `y=cvector_zero:complex^N` THEN ASM_REWRITE_TAC[corthogonal;CDOT_RZERO] THEN REWRITE_TAC[CDOT_LSUB;cunit;CVECTOR_MUL_ASSOC;GSYM cnorm2;CDOT_LMUL; CDOT_RMUL;REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX))] THEN REWRITE_TAC[COMPLEX_MUL_AC;GSYM COMPLEX_INV_MUL;GSYM COMPLEX_POW_2; cnorm;o_DEF;CSQRT] THEN SIMP_TAC[CNORM2_POS;CX_SQRT;cnorm2;REAL_CDOT_SELF;REAL_OF_COMPLEX;CSQRT] THEN ASM_SIMP_TAC[CDOT_EQ_0;COMPLEX_MUL_RINV;COMPLEX_MUL_RID; COMPLEX_SUB_REFL]);; let CDOT_PYTHAGOREAN = prove (`!x y:complex^N. corthogonal x y ==> cnorm2 (x+y) = cnorm2 x + cnorm2 y`, SIMP_TAC[corthogonal;cnorm2;CDOT_LADD;CDOT_RADD;COMPLEX_ADD_RID; COMPLEX_ADD_LID;REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF; MESON[CDOT_SYM;CNJ_ZERO] `x cdot y = Cx (&0) ==> y cdot x = Cx(&0)`]);; let CDOT_CAUCHY_SCHWARZ_POW_2 = prove (`!x y:complex^N. norm (x cdot y) pow 2 <= cnorm2 x * cnorm2 y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `y = cvector_zero:complex^N` THEN ASM_REWRITE_TAC[CNORM2_CVECTOR_ZERO;CDOT_RZERO;COMPLEX_NORM_0; REAL_POW_2;REAL_MUL_RZERO;REAL_OF_COMPLEX_CX;REAL_LE_REFL] THEN ONCE_REWRITE_TAC[MATCH_MP (MESON[CVECTOR_SUB_ADD] `(!x:complex^N y. p (x - f x y) y) ==> cnorm2 x * z = cnorm2 (x - f x y + f x y) * z`) CORTHOGONAL_PROJECTION] THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (MESON[] `(!x y. P x y ==> f x y = (g x y:real)) ==> P x y /\ a <= g x y * b ==> a <= f x y * b`) CDOT_PYTHAGOREAN)) THEN REWRITE_TAC[GSYM CORTHOGONAL_MUL_CLAUSES;CORTHOGONAL_RUNIT; CORTHOGONAL_PROJECTION] THEN SIMP_TAC[cnorm2;GSYM REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF;REAL_ADD; GSYM REAL_OF_COMPLEX_MUL] THEN REWRITE_TACS[cunit;CDOT_RMUL;CVECTOR_MUL_ASSOC;REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX));COMPLEX_MUL_AC;GSYM COMPLEX_INV_MUL; GSYM COMPLEX_POW_2;cnorm;o_DEF;CSQRT;COMPLEX_ADD_LDISTRIB;cnorm2;CDOT_RMUL; CNJ_MUL;CDOT_LMUL;GSYM cnorm2; REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX))] THEN SIMP_TAC[CX_SQRT;CNORM2_POS;CSQRT;CX_CNORM2] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x * ((y * inv x) * x) * (z * inv x') * inv x' = (y * z) * (x * inv x) * (x * inv x' * inv x'):complex`] THEN ASM_SIMP_TAC[CDOT_EQ_0;COMPLEX_MUL_RINV;COMPLEX_MUL_LID;COMPLEX_MUL_CNJ; GSYM COMPLEX_INV_MUL] THEN ONCE_REWRITE_TAC[ GSYM (MATCH_MP REAL_OF_COMPLEX (SPEC_ALL REAL_CDOT_SELF))] THEN SIMP_TAC[GSYM cnorm2;GSYM CX_SQRT;CNORM2_POS;GSYM CX_MUL; GSYM COMPLEX_POW_2;GSYM CX_POW;SQRT_POW_2;GSYM CX_INV] THEN ASM_SIMP_TAC[REAL_MUL_RINV;CNORM2_EQ_0;REAL_MUL_RID;GSYM CX_ADD; REAL_OF_COMPLEX_CX;GSYM REAL_POW_2;REAL_LE_ADDL;REAL_LE_MUL;CNORM2_POS]);; let CDOT_CAUCHY_SCHWARZ = prove (`!x y:complex^N. norm (x cdot y) <= norm x * norm y`, REPEAT GEN_TAC THEN MATCH_MP_TAC (REWRITE_RULE[REAL_LE_SQUARE_ABS] (REAL_ARITH `&0 <= x /\ &0 <= y /\ abs x <= abs y ==> x <= y`)) THEN SIMP_TAC[NORM_POS_LE;CNORM_POS;REAL_LE_MUL;REAL_POW_MUL;CNORM_POW_2; CDOT_CAUCHY_SCHWARZ_POW_2]);; let CDOT_CAUCHY_SCHWARZ_POW_2_EQUAL = prove (`!x y:complex^N. norm (x cdot y) pow 2 = cnorm2 x * cnorm2 y <=> collinear_cvectors x y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `y = cvector_zero:complex^N` THEN ASM_REWRITE_TAC[CNORM2_CVECTOR_ZERO;CDOT_RZERO;COMPLEX_NORM_0; REAL_POW_2;REAL_MUL_RZERO;REAL_OF_COMPLEX_CX;COLLINEAR_CVECTORS_0] THEN EQ_TAC THENL [ ONCE_REWRITE_TAC[MATCH_MP (MESON[CVECTOR_SUB_ADD] `(!x:complex^N y. p (x - f x y) y) ==> cnorm2 x * z = cnorm2 (x - f x y + f x y) * z`) CORTHOGONAL_PROJECTION] THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (MESON[] `(!x y. P x y ==> g x y = (f x y:real)) ==> P x y /\ (a = f x y * z ==> R) ==> (a = g x y * z ==> R)`) CDOT_PYTHAGOREAN)) THEN REWRITE_TAC[GSYM CORTHOGONAL_MUL_CLAUSES;CORTHOGONAL_RUNIT; CORTHOGONAL_PROJECTION] THEN SIMP_TAC[cnorm2;GSYM REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF;REAL_ADD; GSYM REAL_OF_COMPLEX_MUL] THEN REWRITE_TACS[cunit;CDOT_RMUL;CVECTOR_MUL_ASSOC;REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX));COMPLEX_MUL_AC; GSYM COMPLEX_INV_MUL;GSYM COMPLEX_POW_2;cnorm;o_DEF;CSQRT; COMPLEX_ADD_LDISTRIB;cnorm2;CDOT_RMUL;CNJ_MUL;CDOT_LMUL;GSYM cnorm2; REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX))] THEN SIMP_TAC[CX_SQRT;CNORM2_POS;CSQRT;CX_CNORM2] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x * ((y * inv x) * x) * (z * inv x') * inv x' = (y * z) * (x * inv x) * (x * inv x' * inv x'):complex`] THEN ONCE_REWRITE_TAC[GSYM (MATCH_MP REAL_OF_COMPLEX (SPEC_ALL REAL_CDOT_SELF))] THEN SIMP_TAC[GSYM cnorm2;GSYM CX_SQRT;CNORM2_POS;GSYM CX_MUL; GSYM COMPLEX_POW_2;GSYM CX_POW;SQRT_POW_2;GSYM CX_INV;REAL_POW_INV] THEN ASM_SIMP_TAC[REAL_MUL_RINV;CNORM2_EQ_0;REAL_MUL_RID;GSYM CX_ADD; REAL_OF_COMPLEX_CX;GSYM REAL_POW_2;REAL_LE_ADDL;REAL_LE_MUL;CNORM2_POS; GSYM CX_POW;REAL_POW_ONE;COMPLEX_MUL_RID;COMPLEX_MUL_CNJ; REAL_ARITH `x = y + x <=> y = &0`;REAL_ENTIRE;CNORM2_EQ_0; CVECTOR_SUB_EQ;collinear_cvectors] THEN MESON_TAC[]; REWRITE_TAC[collinear_cvectors] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[cnorm2;CDOT_LMUL;CDOT_RMUL;COMPLEX_NORM_MUL; COMPLEX_MUL_ASSOC] THEN SIMP_TAC[COMPLEX_MUL_CNJ;GSYM cnorm2;COMPLEX_NORM_CNJ;GSYM CX_POW; REAL_OF_COMPLEX_MUL;REAL_CX;REAL_CDOT_SELF;REAL_OF_COMPLEX_CX; GSYM CNORM2_ALT] THEN SIMPLE_COMPLEX_ARITH_TAC ]);; let CDOT_CAUCHY_SCHWARZ_EQUAL = prove (`!x y:complex^N. norm (x cdot y) = norm x * norm y <=> collinear_cvectors x y`, ONCE_REWRITE_TAC[REWRITE_RULE[REAL_EQ_SQUARE_ABS] (REAL_ARITH `x=y <=> abs x = abs y /\ (&0 <= x /\ &0 <= y \/ x < &0 /\ y < &0)`)] THEN SIMP_TAC[NORM_POS_LE;CNORM_POS;REAL_LE_MUL;REAL_POW_MUL;CNORM_POW_2; CDOT_CAUCHY_SCHWARZ_POW_2_EQUAL]);; let CNORM_TRIANGLE = prove (`!x y:complex^N. norm (x+y) <= norm x + norm y`, REPEAT GEN_TAC THEN MATCH_MP_TAC (REWRITE_RULE[REAL_LE_SQUARE_ABS] (REAL_ARITH `abs x <= abs y /\ &0 <= x /\ &0 <= y ==> x <= y`)) THEN SIMP_TAC[CNORM_POS;REAL_LE_ADD;REAL_ADD_POW_2;CNORM_POW_2;cnorm2; CDOT_LADD;CDOT_RADD;SIMPLE_COMPLEX_ARITH `(x+y)+z+t = x+(y+z)+t:complex`; ADD_CDOT_SYM;REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF;REAL_CX;REAL_ADD; REAL_OF_COMPLEX_CX;REAL_ARITH `x+ &2*y+z<=x+z+ &2*t <=> y<=t:real`] THEN MESON_TAC[CDOT_CAUCHY_SCHWARZ;RE_NORM;REAL_LE_TRANS]);; let REAL_ABS_SUB_CNORM = prove (`!x y:complex^N. abs (norm x - norm y) <= norm (x-y)`, let lemma = REWRITE_RULE[CVECTOR_SUB_ADD2;REAL_ARITH `x<=y+z <=> x-y<=z:real`] (SPECL [`x:complex^N`;`y-x:complex^N`] CNORM_TRIANGLE) in REPEAT GEN_TAC THEN MATCH_MP_TAC (MATCH_MP (MESON[] `(!x y. P x y <=> Q x y) ==> Q x y ==> P x y`) REAL_ABS_BOUNDS) THEN ONCE_REWRITE_TAC[REAL_ARITH `--x <= y <=> --y <= x`] THEN REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[lemma;ONCE_REWRITE_RULE[CNORM_SUB] lemma]);; (* ========================================================================= *) (* VSUM *) (* ========================================================================= *) let cvsum = new_definition `(cvsum:(A->bool)->(A->complex^N)->complex^N) s f = lambda i. vsum s (\x. (f x)$i)`;; (* ========================================================================= *) (* INFINITE SUM *) (* ========================================================================= *) let csummable = new_definition `csummable (s:num->bool) (f:num->complex^N) <=> summable s (cvector_re o f) /\ summable s (cvector_im o f)`;; let cinfsum = new_definition `cinfsum (s:num->bool) (f:num->complex^N) :complex^N = vector_to_cvector (infsum s (\x. cvector_re (f x))) + ii % vector_to_cvector (infsum s (\x.cvector_im (f x)))`;; let CSUMMABLE_FLATTEN_CVECTOR = prove (`!s (f:num->complex^N). csummable s f <=> summable s (cvector_flatten o f)`, REWRITE_TAC[csummable;summable;cvector_flatten;o_DEF] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ EXISTS_TAC `pastecart (l:real^N) (l':real^N)` THEN ASM_SIMP_TAC[GSYM SUMS_PASTECART]; EXISTS_TAC `fstcart (l:real^(N,N) finite_sum)` THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (TAUT `(p /\ q <=> r) ==> (r ==> p)`) (INST_TYPE [`:N`,`:M`] (SPEC_ALL SUMS_PASTECART)))) THEN EXISTS_TAC `(cvector_im o f) :num->real^N` THEN EXISTS_TAC `sndcart (l:real^(N,N) finite_sum)` THEN ASM_REWRITE_TAC[ETA_AX;o_DEF;PASTECART_FST_SND]; EXISTS_TAC `sndcart (l:real^(N,N) finite_sum)` THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (TAUT `(p /\ q <=> r) ==> (r ==> q)`) (INST_TYPE [`:N`,`:M`] (SPEC_ALL SUMS_PASTECART)))) THEN EXISTS_TAC `(cvector_re o f) :num->real^N` THEN EXISTS_TAC `fstcart (l:real^(N,N) finite_sum)` THEN ASM_REWRITE_TAC[ETA_AX;o_DEF;PASTECART_FST_SND]; ]);; let FLATTEN_CINFSUM = prove (`!s f. csummable s f ==> ((cinfsum s f):complex^N) = cvector_unflatten (infsum s (cvector_flatten o f))`, SIMP_TAC[cinfsum;cvector_unflatten;COMPLEX_VECTOR_TRANSPOSE;LINEAR_FSTCART; LINEAR_SNDCART;CSUMMABLE_FLATTEN_CVECTOR;GSYM INFSUM_LINEAR;o_DEF; cvector_flatten;FSTCART_PASTECART;SNDCART_PASTECART]);; let CSUMMABLE_LINEAR = prove (`!f h:complex^N->complex^M s. csummable s f /\ clinear h ==> csummable s (h o f)`, REWRITE_TAC[CSUMMABLE_FLATTEN_CVECTOR] THEN REPEAT STRIP_TAC THEN POP_ASSUM (ASSUME_TAC o MATCH_MP FLATTEN_CLINEAR) THEN SUBGOAL_THEN `cvector_flatten o (h:complex^N -> complex^M) o (f:num -> complex^N) = \n. (cvector_flatten o h o cvector_unflatten) (cvector_flatten (f n))` (SINGLE REWRITE_TAC) THENL [ REWRITE_TAC[o_DEF;FUN_EQ_THM] THEN GEN_TAC THEN REPEAT AP_TERM_TAC THEN REWRITE_TAC[REWRITE_RULE[o_DEF;I_DEF;FUN_EQ_THM] UNFLATTEN_FLATTEN]; MATCH_MP_TAC SUMMABLE_LINEAR THEN ASM_SIMP_TAC[GSYM o_DEF] ]);; let CINFSUM_LINEAR = prove (`!f (h:complex^M->complex^N) s. csummable s f /\ clinear h ==> cinfsum s (h o f) = h (cinfsum s f)`, REPEAT GEN_TAC THEN DISCH_THEN (fun x -> MP_TAC (CONJ (MATCH_MP CSUMMABLE_LINEAR x) x)) THEN SIMP_TAC[FLATTEN_CINFSUM;CSUMMABLE_FLATTEN_CVECTOR] THEN REPEAT STRIP_TAC THEN POP_ASSUM (ASSUME_TAC o MATCH_MP FLATTEN_CLINEAR) THEN SUBGOAL_THEN `cvector_flatten o (h:complex^M->complex^N) o (f:num->complex^M) = \n. (cvector_flatten o h o cvector_unflatten) ((cvector_flatten o f) n)` (SINGLE REWRITE_TAC) THENL [ REWRITE_TAC[o_DEF;FUN_EQ_THM] THEN GEN_TAC THEN REPEAT AP_TERM_TAC THEN REWRITE_TAC[REWRITE_RULE[o_DEF;I_DEF;FUN_EQ_THM] UNFLATTEN_FLATTEN]; FIRST_ASSUM (fun x -> FIRST_ASSUM (fun y -> REWRITE_TAC[MATCH_MP (MATCH_MP (REWRITE_RULE[IMP_CONJ] INFSUM_LINEAR) x) y])) THEN REWRITE_TAC[o_DEF;REWRITE_RULE[o_DEF;I_DEF;FUN_EQ_THM] UNFLATTEN_FLATTEN] ]);; hol-light/Multivariate/degree.ml000066400000000000000000021732031303454263000172100ustar00rootroot00000000000000(* ========================================================================= *) (* Half-baked development of Brouwer degree, enough to get some key results *) (* about homotopy of linear mappings. This roughly follows the elementary *) (* combinatorial construction (going back to Brouwer himself) in Dugundji's *) (* "Topology" book. The main differences are that we systematically use *) (* conic hulls instead of working on the surface of the sphere, and we *) (* keep the notion of orientation localized (see "relative_orientation"). *) (* *) (* (c) Copyright, John Harrison 2014 *) (* ========================================================================= *) needs "Multivariate/polytope.ml";; (* ------------------------------------------------------------------------- *) (* Somewhat general lemmas. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_1_EXISTS = prove (`!s. s HAS_SIZE 1 <=> ?!x. x IN s`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[EXTENSION; IN_SING] THEN MESON_TAC[]);; let HAS_SIZE_2_EXISTS = prove (`!s. s HAS_SIZE 2 <=> ?x y. ~(x = y) /\ !z. z IN s <=> (z = x) \/ (z = y)`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; let SIMPLEX_EXTREME_POINTS_NONEMPTY = prove (`!c. &(dimindex (:N)) - &1 simplex c ==> ~({v | v extreme_point_of c} = {})`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MATCH_MP_TAC EXTREME_POINT_EXISTS_CONVEX THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[SIMPLEX_IMP_COMPACT]; ASM_MESON_TAC[SIMPLEX_IMP_CONVEX]; DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIMPLEX_EMPTY]) THEN MATCH_MP_TAC(INT_ARITH `&1:int <= d ==> d - &1 = -- &1 ==> F`) THEN REWRITE_TAC[INT_OF_NUM_LE; DIMINDEX_GE_1]]);; (* ------------------------------------------------------------------------- *) (* Characterizing membership in our simplices via quantifier-free formulas *) (* involving determinants. *) (* ------------------------------------------------------------------------- *) let IN_SPAN_DEPLETED_ROWS_QFREE = prove (`!A:real^N^N k. 1 <= k /\ k <= dimindex(:N) /\ ~(det A = &0) ==> span {row i A | i IN 1..dimindex(:N) /\ ~(i = k)} = {x | det(lambda i. if i = k then x else A$i) = &0}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[DIM_EQ_SPAN; DIM_SPAN; SPAN_EQ_SELF] `s SUBSET t /\ subspace t /\ dim t <= dim s ==> span s = t`) THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG; IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC DET_IDENTICAL_ROWS THEN MAP_EVERY EXISTS_TAC [`i:num`; `k:num`] THEN ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA]; ALL_TAC] THEN SUBGOAL_THEN `!x. det(lambda i. if i = k then x else (A:real^N^N)$i) = cofactor(A)$k dot x` (fun th -> REWRITE_TAC[th]) THENL [X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[DOT_SYM] THEN MP_TAC(ISPECL [`(lambda i. if i = k then x else (A:real^N^N)$i):real^N^N`; `k:num`] DET_COFACTOR_EXPANSION) THEN ASM_SIMP_TAC[dot; LAMBDA_BETA; IN_NUMSEG] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSPACE_HYPERPLANE] THEN MP_TAC(ISPEC `cofactor(A:real^N^N)$k` DIM_HYPERPLANE) THEN ANTS_TAC THENL [DISCH_TAC THEN MP_TAC(SYM(ISPEC `A:real^N^N` DET_COFACTOR)) THEN SUBGOAL_THEN `det(cofactor A:real^N^N) = &0` (fun th -> ASM_REWRITE_TAC[th; REAL_POW_EQ_0]) THEN MATCH_MP_TAC DET_ZERO_ROW THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA]; DISCH_THEN SUBST1_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM RANK_EQ_FULL_DET]) THEN REWRITE_TAC[RANK_ROW] THEN MATCH_MP_TAC(ARITH_RULE `d <= a + 1 ==> d = n ==> n - 1 <= a`) THEN TRANS_TAC LE_TRANS `dim(row k (A:real^N^N) INSERT {row i A | i IN 1..dimindex(:N) /\ ~(i = k)})` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[DIM_INSERT] THEN ARITH_TAC] THEN MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[rows; IN_NUMSEG] THEN SET_TAC[]);; let IN_CONVEX_HULL_ROWS = prove (`!A:real^N^N z:real^N. z IN convex hull (rows A) <=> ?a:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= a$i) /\ sum (1..dimindex(:N)) (\i. a$i) = &1 /\ transp A ** a = z`, REPEAT STRIP_TAC THEN REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM numseg] THEN SIMP_TAC[CONVEX_HULL_FINITE_IMAGE_EXPLICIT; FINITE_NUMSEG] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[MATRIX_MUL_DOT] THEN SIMP_TAC[row; IN_NUMSEG; LAMBDA_BETA] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:num->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(lambda i. u i):real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA; transp; CART_EQ]; DISCH_THEN(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\i. (v:real^N)$i` THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[CART_EQ]] THEN EXPAND_TAC "z" THEN SIMP_TAC[VSUM_COMPONENT] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; transp; dot] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[REAL_MUL_SYM]);; let IN_CONIC_CONVEX_HULL_ROWS = prove (`!A:real^N^N z:real^N. z IN conic hull (convex hull (rows A)) <=> ?a:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= a$i) /\ transp A ** a = z`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[CONIC_HULL_EXPLICIT; IN_CONVEX_HULL_ROWS] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; IN_ELIM_THM; RIGHT_AND_EXISTS_THM] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `a:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `c % a:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_LE_MUL] THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL]; X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [MAP_EVERY EXISTS_TAC [`&0`; `transp(A:real^N^N) ** basis 1`; `basis 1:real^N`] THEN SIMP_TAC[BASIS_COMPONENT; REAL_LE_REFL] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN CONJ_TAC THENL [MESON_TAC[REAL_POS]; EXPAND_TAC "z"] THEN ASM_MESON_TAC[MATRIX_VECTOR_MUL_RZERO; VECTOR_MUL_LZERO]; MAP_EVERY EXISTS_TAC [`sum (1..dimindex(:N)) (\j. (a:real^N)$j)`; `inv(sum (1..dimindex(:N)) (\j. (a:real^N)$j)) % z:real^N`; `inv(sum (1..dimindex(:N)) (\j. a$j)) % a:real^N`] THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; SUM_LMUL] THEN ASM_SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_LE_MUL; REAL_LE_INV_EQ] THEN REWRITE_TAC[VECTOR_ARITH `z:real^N = a % b % z <=> (b * a - &1) % z = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_SUB_0] THEN MATCH_MP_TAC(TAUT `p ==> p /\ (p \/ q)`) THEN MATCH_MP_TAC REAL_MUL_LINV THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] SUM_POS_EQ_0_NUMSEG)) THEN UNDISCH_TAC `~(a:real^N = vec 0)` THEN ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT]]]);; let IN_CONIC_CONVEX_HULL_ROWS_QFREE = prove (`!A:real^N^N z:real^N. ~(det A = &0) ==> (z IN conic hull (convex hull (rows A)) <=> !k. 1 <= k /\ k <= dimindex(:N) ==> det(lambda i. if i = k then z else A$i) / det(A) >= &0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[IN_CONIC_CONVEX_HULL_ROWS] THEN ASM_SIMP_TAC[DET_TRANSP; CRAMER] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM2] THEN SIMP_TAC[LAMBDA_BETA] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [GSYM DET_TRANSP] THEN SIMP_TAC[transp; LAMBDA_BETA; real_ge] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]);; let IN_INTERIOR_CONIC_CONVEX_HULL_ROWS_QFREE = prove (`!A:real^N^N z:real^N. z IN interior(conic hull (convex hull (rows A))) <=> ~(det A = &0) /\ (!k. 1 <= k /\ k <= dimindex(:N) ==> det(lambda i. if i = k then z else A$i) / det(A) > &0)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `det(A:real^N^N) = &0` THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s = {} ==> ~(x IN s)`) THEN MATCH_MP_TAC EMPTY_INTERIOR_LOWDIM THEN REWRITE_TAC[DIM_CONIC_HULL; DIM_CONVEX_HULL; GSYM RANK_ROW] THEN ASM_REWRITE_TAC[GSYM DET_EQ_0_RANK]; ASM_REWRITE_TAC[REAL_ARITH `x > &0 <=> x >= &0 /\ ~(x = &0)`]] THEN SUBGOAL_THEN `~(vec 0 IN affine hull (rows(A:real^N^N))) /\ ~(affine_dependent(rows A))` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[DEPENDENT_AFFINE_DEPENDENT_CASES; DET_DEPENDENT_ROWS]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `(!k. P k ==> Q k /\ R k) <=> (!k. P k ==> Q k) /\ (!k. P k ==> R k)`] THEN ASM_SIMP_TAC[GSYM IN_CONIC_CONVEX_HULL_ROWS_QFREE; REAL_DIV_EQ_0] THEN ASM_CASES_TAC `z IN conic hull (convex hull (rows(A:real^N^N)))` THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]] THEN MATCH_MP_TAC(SET_RULE `(~(z IN s) <=> z IN {a | ?k. ~(P k ==> ~(a IN {z | Q k z}))}) ==> (z IN s <=> (!k. P k ==> ~Q k z))`) THEN ASM_SIMP_TAC[GSYM IN_SPAN_DEPLETED_ROWS_QFREE] THEN REWRITE_TAC[NOT_IMP; IN_ELIM_THM] THEN EQ_TAC THENL [ASM_REWRITE_TAC[GSYM SET_DIFF_FRONTIER; IN_DIFF] THEN ASM_SIMP_TAC[FRONTIER_OF_CONVEX_CLOSED; CONVEX_CONIC_HULL; FINITE_ROWS; CONVEX_CONVEX_HULL; CLOSED_CONIC_HULL_STRONG; POLYTOPE_CONVEX_HULL] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FACE_OF_CONIC_HULL_REV)) THEN ASM_REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[IN_SING; SPAN_0; LE_REFL; DIMINDEX_GE_1]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` (CONJUNCTS_THEN2 MP_TAC (SUBST_ALL_TAC o SYM))) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FACE_OF_CONVEX_HULL_SUBSET)) THEN SIMP_TAC[FINITE_IMP_COMPACT; FINITE_ROWS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> s = t \/ ?x. x IN t /\ s SUBSET t DELETE x`)) THENL [DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE LAND_CONV [AFF_DIM_CONIC_HULL_DIM]) THEN REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; ROWS_NONEMPTY; DIM_CONVEX_HULL] THEN ASM_MESON_TAC[INT_LT_REFL; RANK_ROW; RANK_EQ_FULL_DET]; REWRITE_TAC[rows; EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ONCE_REWRITE_TAC[GSYM SPAN_CONVEX_HULL] THEN ONCE_REWRITE_TAC[GSYM SPAN_CONIC_HULL] THEN MATCH_MP_TAC SPAN_SUPERSET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `z IN s ==> s SUBSET t ==> z IN t`)) THEN REPEAT(MATCH_MP_TAC HULL_MONO) THEN ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP(REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR)) THEN ASM_CASES_TAC `z:real^N = vec 0` THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_CONIC_HULL; IN_DELETE; AFFINE_HULL_CONVEX_HULL]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!s. z IN s /\ s INTER t = {} ==> z IN t ==> F`) THEN EXISTS_TAC `affine hull (conic hull(convex hull {row i (A:real^N^N) | i IN 1..dimindex (:N) /\ ~(i = k)}))` THEN CONJ_TAC THENL [REWRITE_TAC[AFFINE_HULL_CONIC_HULL; GSYM SPAN_AFFINE_HULL_INSERT] THEN REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; SPAN_CONVEX_HULL] THEN ASM_MESON_TAC[SPAN_EMPTY; IN_SING]; MATCH_MP_TAC AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR THEN SIMP_TAC[CONVEX_CONIC_HULL; CONVEX_CONVEX_HULL] THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_CONIC_HULL THEN ASM_REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN EXISTS_TAC `{row i (A:real^N^N) | i IN 1..dimindex (:N) /\ ~(i = k)}` THEN REWRITE_TAC[rows; IN_NUMSEG] THEN SET_TAC[]; DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN REWRITE_TAC[DIM_CONIC_HULL; DIM_CONVEX_HULL] THEN MATCH_MP_TAC(ARITH_RULE `d = dimindex(:N) /\ s < dimindex(:N) ==> ~(s = d)`) THEN CONJ_TAC THENL [ASM_MESON_TAC[RANK_EQ_FULL_DET; RANK_ROW]; ALL_TAC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM DELETE] THEN MAP_EVERY (fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd) THEN SIMP_TAC[FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LET_TRANS)) [DIM_LE_CARD; CARD_IMAGE_LE] THEN ASM_SIMP_TAC[CARD_DELETE; CARD_NUMSEG_1; FINITE_NUMSEG; IN_NUMSEG] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> n - 1 < n`]]]]);; (* ------------------------------------------------------------------------- *) (* Apply a function row-wise. *) (* ------------------------------------------------------------------------- *) let maprows = new_definition `maprows f (d:real^N^N) = ((lambda i. f(d$i)):real^N^N)`;; let DET_MAPROWS_LINEAR = prove (`!f:real^N->real^N d. linear f ==> det(maprows f d) = det(matrix f) * det d`, SIMP_TAC[maprows; DET_LINEAR_ROWS]);; let ROW_MAPROWS = prove (`!A:real^N^N i. 1 <= i /\ i <= dimindex(:N) ==> row i (maprows f A) = f(row i A)`, SIMP_TAC[row; maprows; LAMBDA_BETA; LAMBDA_ETA]);; let ROWS_MAPROWS = prove (`!f:real^N->real^N A:real^N^N. rows(maprows f A) = IMAGE f (rows A)`, REPEAT GEN_TAC THEN REWRITE_TAC[rows; maprows; row] THEN REWRITE_TAC[SET_RULE `IMAGE f {g x | P x} = {f(g x) | P x}`] THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN SIMP_TAC[LAMBDA_BETA; CART_EQ; LAMBDA_ETA]);; let MAPROWS_COMPOSE = prove (`!f:real^N->real^N g:real^N->real^N. maprows (f o g) = maprows f o maprows g`, REWRITE_TAC[FUN_EQ_THM; maprows; CART_EQ; o_THM] THEN SIMP_TAC[LAMBDA_BETA]);; (* ------------------------------------------------------------------------- *) (* Relative orientation of a simplex under a function. *) (* ------------------------------------------------------------------------- *) let relative_orientation = new_definition `relative_orientation (f:real^N->real^N) s = let A = @A. rows A = {v | v extreme_point_of s} in real_sgn(det(maprows f A) / det A)`;; let FINITE_SET_AS_MATRIX_ROWS = prove (`!s. FINITE s /\ ~(s = {}) /\ CARD s <= dimindex(:N) ==> ?A:real^N^N. rows A = s`, GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN ASM_SIMP_TAC[GSYM CARD_LE_CARD; FINITE_NUMSEG; LE_C_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` (SUBST1_TAC o SYM)) THEN EXISTS_TAC `(lambda i. f i):real^N^N` THEN ASM_REWRITE_TAC[rows; GSYM IN_NUMSEG; SIMPLE_IMAGE] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN SIMP_TAC[row; LAMBDA_BETA; IN_NUMSEG; LAMBDA_ETA]);; let SIMPLEX_ORDERING_EXISTS = prove (`!s:real^N->bool. (&(dimindex(:N)) - &1) simplex s ==> ?A:real^N^N. rows A = {v | v extreme_point_of s}`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[SIMPLEX_EMPTY; INT_ARITH `&1:int <= n ==> ~(n - &1 = -- &1)`; INT_OF_NUM_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[SIMPLEX_ALT1; HAS_SIZE] THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_SET_AS_MATRIX_ROWS THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; LE_REFL] THEN ASM_MESON_TAC[EXTREME_POINT_EXISTS_CONVEX]);; let DET_ORDERED_SIMPLEX_EQ_0 = prove (`!s:real^N->bool A. convex s /\ compact s /\ rows A = {v | v extreme_point_of s} ==> (det A = &0 <=> ~((&(dimindex(:N)) - &1) simplex s) \/ vec 0 IN affine hull s)`, SIMP_TAC[SIMPLEX_0_NOT_IN_AFFINE_HULL; TAUT `~p \/ q <=> ~(p /\ ~q)`] THEN REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW; independent] THEN REWRITE_TAC[DEPENDENT_EQ_DIM_LT_CARD; HAS_SIZE; FINITE_ROWS] THEN MP_TAC(ISPEC `A:real^N^N` CARD_ROWS_LE) THEN MP_TAC(ISPEC `rows(A:real^N^N)` DIM_LE_CARD) THEN SIMP_TAC[FINITE_ROWS] THEN ARITH_TAC);; let DET_ORDERED_SIMPLEX_NZ = prove (`!s:real^N->bool A. (&(dimindex(:N)) - &1) simplex s /\ ~(vec 0 IN affine hull s) /\ rows A = {v | v extreme_point_of s} ==> ~(det A = &0)`, MESON_TAC[DET_ORDERED_SIMPLEX_EQ_0; SIMPLEX_IMP_COMPACT; SIMPLEX_IMP_CONVEX]);; let RELATIVE_ORIENTATION = prove (`!A:real^N^N f s:real^N->bool. rows A = {v | v extreme_point_of s} ==> relative_orientation (f:real^N->real^N) s = real_sgn(det(maprows f A) / det A)`, REPEAT STRIP_TAC THEN REWRITE_TAC[relative_orientation] THEN ABBREV_TAC `B = @A:real^N^N. rows A = {v | v extreme_point_of s}` THEN SUBGOAL_THEN `rows(B:real^N^N) = rows(A:real^N^N)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN MP_TAC(ISPECL [`\i. row i (B:real^N^N)`; `1..dimindex(:N)`] CARD_IMAGE_EQ_INJ) THEN MP_TAC(ISPECL [`\i. row i (A:real^N^N)`; `1..dimindex(:N)`] CARD_IMAGE_EQ_INJ) THEN REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; GSYM SIMPLE_IMAGE] THEN REWRITE_TAC[REWRITE_RULE[GSYM IN_NUMSEG] (GSYM rows)] THEN ASM_CASES_TAC `CARD(rows(A:real^N^N)) = dimindex(:N)` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; MATCH_MP_TAC(MESON[] `(q ==> x = &0) /\ (p ==> y = &0) ==> p ==> q ==> x = y`) THEN CONJ_TAC THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0] THEN DISCH_THEN(fun th -> DISJ2_TAC THEN MP_TAC th) THEN REWRITE_TAC[IN_NUMSEG] THEN MESON_TAC[DET_IDENTICAL_ROWS]] THEN DISCH_THEN(fun th -> DISCH_TAC THEN ASSUME_TAC th THEN MP_TAC th) THEN MP_TAC(ISPECL [`1..dimindex(:N)`; `rows(B:real^N^N)`; `\i. row i (A:real^N^N)`] SURJECTIVE_IFF_INJECTIVE_GEN) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FINITE_ROWS; FINITE_NUMSEG; CARD_NUMSEG_1] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; rows; row; FORALL_IN_GSPEC] THEN SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; LAMBDA_ETA] THEN MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[rows; FORALL_IN_GSPEC] THEN DISCH_TAC THEN SUBGOAL_THEN `?p. p permutes 1..dimindex(:N) /\ !i. i IN 1..dimindex(:N) ==> row (p i) (A:real^N^N) = row i (B:real^N^N)` STRIP_ASSUME_TAC THENL [SIMP_TAC[PERMUTES_FINITE_INJECTIVE; FINITE_NUMSEG] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_EXISTS_THM]) THEN REWRITE_TAC[SKOLEM_THM; GSYM IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_TAC `p:num->num`) THEN EXISTS_TAC `\i. if i IN 1..dimindex(:N) then p i else i` THEN SIMP_TAC[] THEN ASM_MESON_TAC[]; MP_TAC(ISPECL [`maprows (f:real^N->real^N) A`; `p:num->num`] DET_PERMUTE_ROWS) THEN MP_TAC(ISPECL [`A:real^N^N`; `p:num->num`] DET_PERMUTE_ROWS) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING `x = p * y ==> p * p = &1 ==> y = p * x`)) THEN REWRITE_TAC[SIGN_IDEMPOTENT] THEN DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_SGN_MUL; real_div; REAL_INV_MUL; REAL_SGN_SIGN] THEN SIMP_TAC[SIGN_IDEMPOTENT; REAL_FIELD `p * p = &1 ==> (p * x) * (inv p * y) = x * y`] THEN REWRITE_TAC[GSYM real_div] THEN BINOP_TAC THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(SIMP_RULE[row; IN_NUMSEG; LAMBDA_ETA]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `IMAGE p s = s ==> !x. x IN s ==> p x IN s`)) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; maprows; IN_NUMSEG] THEN ASM_MESON_TAC[]]);; let RELATIVE_ORIENTATION_LINEAR = prove (`!f:real^N->real^N c. linear f /\ (&(dimindex(:N)) - &1) simplex c /\ ~(vec 0 IN affine hull c) ==> relative_orientation f c = real_sgn(det(matrix f))`, SIMP_TAC[relative_orientation; DET_MAPROWS_LINEAR] THEN REPEAT STRIP_TAC THEN LET_TAC THEN SUBGOAL_THEN `rows(A:real^N^N) = {v | v extreme_point_of c}` ASSUME_TAC THENL [ASM_MESON_TAC[SIMPLEX_ORDERING_EXISTS]; AP_TERM_TAC] THEN SUBGOAL_THEN `~(det(A:real^N^N) = &0)` MP_TAC THENL [ASM_MESON_TAC[DET_ORDERED_SIMPLEX_NZ]; CONV_TAC REAL_FIELD]);; (* ------------------------------------------------------------------------- *) (* Apply a function to the vertices of a simplex to get a new cell. *) (* ------------------------------------------------------------------------- *) let vertex_image = new_definition `vertex_image (f:real^N->real^N) s = convex hull (IMAGE f {v | v extreme_point_of s})`;; let VERTEX_IMAGE_LINEAR_GEN = prove (`!f:real^N->real^N s. linear f /\ convex s /\ compact s ==> vertex_image f s = IMAGE f s`, SIMP_TAC[vertex_image; CONVEX_HULL_LINEAR_IMAGE; GSYM KREIN_MILMAN_MINKOWSKI]);; let VERTEX_IMAGE_LINEAR_POLYTOPE = prove (`!f:real^N->real^N p. linear f /\ polytope p ==> vertex_image f p = IMAGE f p`, SIMP_TAC[VERTEX_IMAGE_LINEAR_GEN; POLYTOPE_IMP_COMPACT; POLYTOPE_IMP_CONVEX]);; let VERTEX_IMAGE_LINEAR = prove (`!f:real^N->real^N s. linear f /\ &(dimindex(:N)) - &1 simplex s ==> vertex_image f s = IMAGE f s`, MESON_TAC[VERTEX_IMAGE_LINEAR_POLYTOPE; SIMPLEX_IMP_POLYTOPE]);; let CONIC_HULL_VERTEX_IMAGE_LINEAR = prove (`!f:real^N->real^N c. linear f /\ &(dimindex(:N)) - &1 simplex c ==> conic hull (vertex_image f c) = IMAGE f (conic hull c)`, SIMP_TAC[VERTEX_IMAGE_LINEAR; CONIC_HULL_LINEAR_IMAGE]);; let DET_ORDERED_SIMPLEX_EQ_0_GEN = prove (`!f:real^N->real^N s A. polytope s /\ rows A = {v | v extreme_point_of s} ==> (det(maprows f A) = &0 <=> ~((&(dimindex(:N)) - &1) simplex (vertex_image f s)) \/ vec 0 IN affine hull (vertex_image f s))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FINITE_POLYHEDRON_EXTREME_POINTS o MATCH_MP POLYTOPE_IMP_POLYHEDRON) THEN REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW; ROWS_MAPROWS] THEN ASM_REWRITE_TAC[vertex_image; AFFINE_HULL_CONVEX_HULL] THEN ASM_CASES_TAC `CARD(IMAGE (f:real^N->real^N) {v | v extreme_point_of s}) < dimindex(:N)` THENL [MATCH_MP_TAC(TAUT `p /\ (~r ==> ~q) ==> (p <=> ~q \/ r)`) THEN CONJ_TAC THENL [ALL_TAC; DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP AFF_DIM_SIMPLEX) THEN ASM_REWRITE_TAC[AFF_DIM_CONVEX_HULL; AFF_DIM_DIM] THEN MATCH_MP_TAC(INT_ARITH `x:int < y ==> ~(x - &1 = y - &1)`) THEN REWRITE_TAC[INT_OF_NUM_LT]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LET_TRANS)) THEN ASM_SIMP_TAC[DIM_LE_CARD; FINITE_IMAGE]; FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(c:num < n) ==> c <= n ==> c = n`)) THEN ANTS_TAC THENL [TRANS_TAC LE_TRANS `CARD(rows(A:real^N^N))` THEN REWRITE_TAC[CARD_ROWS_LE] THEN ASM_SIMP_TAC[CARD_IMAGE_LE]; DISCH_TAC]] THEN TRANS_TAC EQ_TRANS `dependent(IMAGE (f:real^N->real^N) {v | v extreme_point_of s})` THEN CONJ_TAC THENL [ASM_SIMP_TAC[DEPENDENT_EQ_DIM_LT_CARD; FINITE_IMAGE]; REWRITE_TAC[DEPENDENT_AFFINE_DEPENDENT_CASES]] THEN ASM_CASES_TAC `vec 0 IN affine hull IMAGE (f:real^N->real^N) {v | v extreme_point_of s}` THEN ASM_REWRITE_TAC[TAUT `(p <=> ~q) <=> (~p <=> q)`] THEN EQ_TAC THEN ASM_SIMP_TAC[SIMPLEX_CONVEX_HULL; INT_SUB_ADD] THEN DISCH_THEN(MP_TAC o MATCH_MP AFF_DIM_SIMPLEX) THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IFF_CARD; AFF_DIM_CONVEX_HULL; FINITE_IMAGE]);; let VERTEX_IMAGE_NONEMPTY = prove (`!f c. &(dimindex (:N)) - &1 simplex c ==> ~(vertex_image f c = {})`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[vertex_image; CONVEX_HULL_EQ_EMPTY; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[SIMPLEX_EXTREME_POINTS_NONEMPTY]);; let POLYTOPE_VERTEX_IMAGE = prove (`!f c. &(dimindex (:N)) - &1 simplex c ==> polytope(vertex_image f c)`, REPEAT STRIP_TAC THEN REWRITE_TAC[vertex_image] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_MESON_TAC[FINITE_POLYHEDRON_EXTREME_POINTS; SIMPLEX_IMP_POLYHEDRON]);; let POLYHEDRON_CONIC_HULL_VERTEX_IMAGE = prove (`!f c. &(dimindex (:N)) - &1 simplex c ==> polyhedron(conic hull (vertex_image f c))`, SIMP_TAC[POLYHEDRON_CONIC_HULL_POLYTOPE; POLYTOPE_VERTEX_IMAGE]);; let CLOSED_CONIC_HULL_VERTEX_IMAGE = prove (`!f c. &(dimindex (:N)) - &1 simplex c ==> closed(conic hull (vertex_image f c))`, SIMP_TAC[POLYHEDRON_CONIC_HULL_VERTEX_IMAGE; POLYHEDRON_IMP_CLOSED]);; let CONVEX_CONIC_HULL_VERTEX_IMAGE = prove (`!f c. &(dimindex (:N)) - &1 simplex c ==> convex(conic hull (vertex_image f c))`, SIMP_TAC[POLYHEDRON_CONIC_HULL_VERTEX_IMAGE; POLYHEDRON_IMP_CONVEX]);; let RELATIVE_ORIENTATION_NONZERO = prove (`!f:real^N->real^N s. (&(dimindex(:N)) - &1) simplex s ==> (~(relative_orientation f s = &0) <=> (&(dimindex(:N)) - &1) simplex (vertex_image f s) /\ ~(vec 0 IN affine hull s) /\ ~(vec 0 IN affine hull (vertex_image f s)))`, REPEAT STRIP_TAC THEN FIRST_ASSUM (X_CHOOSE_TAC `A:real^N^N` o MATCH_MP SIMPLEX_ORDERING_EXISTS) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION th]) THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN ASM_MESON_TAC[DET_ORDERED_SIMPLEX_EQ_0_GEN; DET_ORDERED_SIMPLEX_EQ_0; SIMPLEX_IMP_POLYTOPE; SIMPLEX_IMP_COMPACT; SIMPLEX_IMP_CONVEX]);; let RELATIVE_ORIENTATION_COMPOSE = prove (`!f:real^N->real^N g:real^N->real^N c. &(dimindex(:N)) - &1 simplex c /\ ~(relative_orientation f c = &0) ==> relative_orientation (g o f) c = relative_orientation g (vertex_image f c) * relative_orientation f c`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLEX_ORDERING_EXISTS) THEN DISCH_THEN(X_CHOOSE_TAC `A:real^N^N`) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION th]) THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN MP_TAC(ISPECL [`maprows (f:real^N->real^N) A`; `g:real^N->real^N`; `vertex_image (f:real^N->real^N) c`] RELATIVE_ORIENTATION) THEN ANTS_TAC THENL [REWRITE_TAC[ROWS_MAPROWS; vertex_image] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXTREME_POINTS_OF_CONVEX_HULL_AFFINE_INDEPENDENT THEN REWRITE_TAC[GSYM ROWS_MAPROWS] THEN DISCH_THEN(MP_TAC o MATCH_MP AFFINE_DEPENDENT_IMP_DEPENDENT) THEN ASM_MESON_TAC[DET_DEPENDENT_ROWS]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[MAPROWS_COMPOSE; o_THM; GSYM REAL_SGN_MUL] THEN AP_TERM_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN CONV_TAC REAL_FIELD);; let ANY_IN_CONIC_HULL_SIMPLEX = prove (`!u t. convex u /\ bounded u /\ vec 0 IN interior u /\ UNIONS t = frontier u ==> !w:real^N. ?c. c IN t /\ w IN conic hull c`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!w:real^N. ~(w = vec 0) ==> ?c. c IN t /\ w IN conic hull c` MP_TAC THENL [ALL_TAC; DISCH_THEN(fun th -> X_GEN_TAC `w:real^N` THEN MP_TAC th) THEN ASM_CASES_TAC `w:real^N = vec 0` THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[CONIC_HULL_CONTAINS_0] THEN X_GEN_TAC `c:real^N->bool` THEN ASM_CASES_TAC `c:real^N->bool = {}` THEN ASM_SIMP_TAC[CONIC_HULL_EMPTY; NOT_IN_EMPTY]] THEN X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`u:real^N->bool`; `vec 0:real^N`; `w:real^N`] RAY_TO_FRONTIER) THEN ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(d % w:real^N) IN UNIONS t` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `w:real^N = inv(d) % d % w` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[conic] CONIC_CONIC_HULL) THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; HULL_INC; REAL_LT_IMP_LE]);; let NONBOUNDARY_IN_UNIQUE_CONIC_HULL_SIMPLEX = prove (`!u t w:real^N. convex u /\ bounded u /\ vec 0 IN interior u /\ triangulation t /\ UNIONS t = frontier u /\ (!c. c IN t ==> ~(w IN frontier(conic hull c))) ==> ?!c. c IN t /\ w IN conic hull c`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN CONJ_TAC THENL [ASM_MESON_TAC[ANY_IN_CONIC_HULL_SIMPLEX]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `d:real^N->bool`] THEN STRIP_TAC THEN ASM_CASES_TAC `c:real^N->bool = d` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `d:real^N->bool` th) THEN MP_TAC(SPEC `c:real^N->bool` th)) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[frontier; IN_DIFF; REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`relative_interior c:real^N->bool`; `relative_interior d:real^N->bool`; `u:real^N->bool`] INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN MP_TAC(ISPEC `u:real^N->bool` RELATIVE_FRONTIER_NONEMPTY_INTERIOR) THEN MP_TAC(ISPEC `c:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN MP_TAC(ISPEC `d:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `!a. a IN s /\ ~(a IN t) ==> s = t ==> F`)] THEN EXISTS_TAC `w:real^N` THEN SUBGOAL_THEN `~((vec 0:real^N) IN affine hull c) /\ ~((vec 0:real^N) IN affine hull d)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION; SUBSET_REFL]; ASM_SIMP_TAC[CONIC_HULL_RELATIVE_INTERIOR]] THEN ASM_CASES_TAC `relative_interior c:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[CONIC_HULL_EMPTY; NOT_IN_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY; triangulation; SIMPLEX_IMP_CONVEX]; ALL_TAC] THEN ASM_CASES_TAC `relative_interior d:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[CONIC_HULL_EMPTY; NOT_IN_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY; triangulation; SIMPLEX_IMP_CONVEX]; ALL_TAC] THEN ASM_SIMP_TAC[IN_INSERT; IN_INTER; REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN MP_TAC(ISPECL [`t:(real^N->bool)->bool`; `c:real^N->bool`; `d:real^N->bool`] TRIANGULATION_DISJOINT_RELATIVE_INTERIORS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_SING] THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(ISPEC `c:real^N->bool` RELATIVE_INTERIOR_CONIC_HULL_0) THEN ANTS_TAC THENL [ASM_MESON_TAC[triangulation; SIMPLEX_IMP_CONVEX]; ALL_TAC] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN ASM_MESON_TAC[HULL_INC; SUBSET; RELATIVE_INTERIOR_SUBSET]);; let CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS = prove (`!f t. FINITE t /\ (!c. c IN t ==> &(dimindex (:N)) - &1 simplex c) ==> closure {x | !c. c IN t ==> ~(x IN frontier(conic hull vertex_image f c))} = (:real^N)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; SET_RULE `s = UNIV <=> UNIV DIFF s = {}`; SET_RULE `UNIV DIFF {x | !c. c IN t ==> ~(x IN f c)} = UNIONS {f c | c IN t}`] THEN MATCH_MP_TAC NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMP_COUNTABLE; COUNTABLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FRONTIER_CLOSED; INTERIOR_FRONTIER_EMPTY; CLOSED_CONIC_HULL_VERTEX_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Triply parametrized degree: counting point, triangulation and function *) (* ------------------------------------------------------------------------- *) let brouwer_degree3 = new_definition `(brouwer_degree3:real^N#((real^N->bool)->bool)#(real^N->real^N)->real) (y,t,f) = sum {c | c IN t /\ y IN conic hull (vertex_image f c)} (\c. relative_orientation f c)`;; (* ------------------------------------------------------------------------- *) (* Invariance under perturbation of the function. *) (* ------------------------------------------------------------------------- *) let BROUWER_DEGREE3_PERTURB = prove (`!f:real^N->real^N t x. FINITE t /\ (!c. c IN t ==> &(dimindex(:N)) - &1 simplex c) /\ (!c. c IN t ==> ~(vec 0 IN vertex_image f c)) /\ (!c. c IN t ==> ~(x IN frontier(conic hull (vertex_image f c)))) ==> ?e. &0 < e /\ !g. (!c v. c IN t /\ v extreme_point_of c ==> norm(f v - g v) < e) ==> brouwer_degree3(x,t,g) = brouwer_degree3(x,t,f) /\ (!c. c IN t ==> ~(x IN frontier(conic hull (vertex_image g c))))`, REPEAT STRIP_TAC THEN REWRITE_TAC[brouwer_degree3] THEN ONCE_REWRITE_TAC[SUM_RESTRICT_SET] THEN REWRITE_TAC[ETA_AX] THEN SUBGOAL_THEN `!c. c IN t ==> ?e. &0 < e /\ !g. (!v. v extreme_point_of c ==> norm (f v - g v) < e) ==> ~(x IN frontier (conic hull vertex_image g c)) /\ (if x IN conic hull vertex_image (g:real^N->real^N) c then relative_orientation g c else &0) = (if x IN conic hull vertex_image f c then relative_orientation f c else &0)` MP_TAC THENL [REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [UNDISCH_TAC `~(x IN frontier (conic hull vertex_image (f:real^N->real^N) c))` THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN ASM_SIMP_TAC[CLOSED_CONIC_HULL_VERTEX_IMAGE; CLOSURE_CLOSED] THEN ASM_SIMP_TAC[CONIC_HULL_CONTAINS_0; VERTEX_IMAGE_NONEMPTY] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR)) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_CONIC_HULL_0; POLYTOPE_VERTEX_IMAGE; POLYTOPE_IMP_CONVEX] THEN ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLEX_IMP_POLYHEDRON) THEN MP_TAC(ISPECL [`vertex_image (f:real^N->real^N) c`; `x:real^N`] HAUSDIST_STILL_SAME_PLACE_CONIC_HULL_STRONG) THEN ASM_SIMP_TAC[POLYTOPE_VERTEX_IMAGE; POLYTOPE_IMP_BOUNDED; POLYTOPE_IMP_CONVEX; CLOSURE_CLOSED; POLYTOPE_IMP_CLOSED; VERTEX_IMAGE_NONEMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?e. &0 < e /\ !g. (!v. v extreme_point_of c ==> norm (f v - g v) < e) /\ x IN conic hull vertex_image (f:real^N->real^N) c ==> relative_orientation g c = relative_orientation f c` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `x IN conic hull vertex_image (f:real^N->real^N) c` THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_01]] THEN SUBGOAL_THEN `x IN interior(conic hull vertex_image (f:real^N->real^N) c)` MP_TAC THENL [ASM_SIMP_TAC[GSYM SET_DIFF_FRONTIER; IN_DIFF]; ALL_TAC] THEN MP_TAC(ISPEC `c:real^N->bool` SIMPLEX_ORDERING_EXISTS) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `A:real^N^N`) THEN REWRITE_TAC[vertex_image] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC [MATCH_MP RELATIVE_ORIENTATION th] THEN REWRITE_TAC[SYM th]) THEN REWRITE_TAC[GSYM ROWS_MAPROWS] THEN REWRITE_TAC[IN_INTERIOR_CONIC_CONVEX_HULL_ROWS_QFREE] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN REWRITE_TAC[REAL_SGN_DIV] THEN MP_TAC(ISPECL [`maprows (f:real^N->real^N) A`; `abs(det(maprows (f:real^N->real^N) A))`] CONTINUOUS_DET_EXPLICIT) THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `maprows (g:real^N->real^N) A`) THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC] THEN SIMP_TAC[maprows; LAMBDA_BETA; GSYM VECTOR_SUB_COMPONENT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x$i) <= norm x /\ norm x < d ==> abs((x:real^N)$i) < d`) THEN REWRITE_TAC[COMPONENT_LE_NORM] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[rows; row; LAMBDA_ETA]) THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `min (d / &2) e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN X_GEN_TAC `g:real^N->real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `vertex_image (g:real^N->real^N) c`) THEN ASM_SIMP_TAC[POLYTOPE_VERTEX_IMAGE; POLYTOPE_IMP_BOUNDED; POLYTOPE_IMP_CONVEX; VERTEX_IMAGE_NONEMPTY] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[vertex_image] THEN W(MP_TAC o PART_MATCH (lhand o rand) HAUSDIST_CONVEX_HULLS o lhand o snd) THEN ASM_SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_POLYHEDRON_EXTREME_POINTS] THEN MATCH_MP_TAC(REAL_ARITH `&0 < d /\ y <= d / &2 ==> x <= y ==> x < d`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_SIMP_TAC[SIMPLEX_EXTREME_POINTS_NONEMPTY; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `norm((f:real^N->real^N) v - g v)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM dist; GSYM SETDIST_SINGS] THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [SETDIST_SYM]] THEN MATCH_MP_TAC SETDIST_SUBSET_RIGHT THEN ASM SET_TAC[]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:(real^N->bool)->real` THEN STRIP_TAC THEN ASM_CASES_TAC `t:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[SUM_CLAUSES; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN EXISTS_TAC `inf(IMAGE (e:(real^N->bool)->real) t)` THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `g:real^N->real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `g:real^N->real^N`) THEN ASM_MESON_TAC[]]);; let ORIENTING_PERTURBATION_EXISTS = prove (`!f:real^N->real^N t e. FINITE t /\ (!c. c IN t ==> &(dimindex(:N)) - &1 simplex c) /\ (!c. c IN t ==> ~(vec 0 IN affine hull c)) /\ &0 < e ==> ?g. (!c v. c IN t /\ v extreme_point_of c ==> dist(f v,g v) < e) /\ !c. c IN t ==> ~(relative_orientation g c = &0)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN SUBGOAL_THEN `bounded(UNIONS t:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC BOUNDED_UNIONS THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_BOUNDED]; REWRITE_TAC[BOUNDED_POS; FORALL_IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `!c:real^N->bool. c IN t ==> ?d. &0 < d /\ !a. ~(a = &0) /\ abs(a) < d ==> ~(relative_orientation (\x. f x + a % x) c = &0)` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPEC `c:real^N->bool` SIMPLEX_ORDERING_EXISTS) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION th]) THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0] THEN MP_TAC(ISPECL [`c:real^N->bool`; `A:real^N^N`] DET_ORDERED_SIMPLEX_NZ) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`maprows (f:real^N->real^N) A`; `A:real^N^N`] NEARBY_INVERTIBLE_MATRIX_GEN) THEN ASM_REWRITE_TAC[INVERTIBLE_DET_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; maprows; LAMBDA_BETA; MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:(real^N->bool)->real` THEN STRIP_TAC THEN EXISTS_TAC `\x. (f:real^N->real^N) x + min (e / B) (inf (IMAGE (d:(real^N->bool)->real) t)) / &2 % x` THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `c:real^N->bool` THEN ASM_CASES_TAC `(c:real^N->bool) IN t` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; STRIP_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN REWRITE_TAC[NORM_MUL] THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN TRANS_TAC REAL_LTE_TRANS `e / B * norm(v:real^N)` THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ; REAL_ARITH `e / B * v:real = (e * v) / B`] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[extreme_point_of]] THEN MATCH_MP_TAC(REAL_ARITH `&0 < d /\ &0 < e ==> abs(min e d / &2) < e`); FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(REAL_ARITH `d <= c /\ &0 < d /\ &0 < e ==> ~(min e d / &2 = &0) /\ abs(min e d / &2) < c`) THEN ASM_SIMP_TAC[REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC]] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_DIV]]);; (* ------------------------------------------------------------------------- *) (* Invariance under shift of counting point. *) (* ------------------------------------------------------------------------- *) let BROUWER_DEGREE3_POINT_INDEPENDENCE = prove (`!f:real^N->real^N t u x y. 2 <= dimindex(:N) /\ convex u /\ bounded u /\ vec 0 IN interior u /\ triangulation t /\ UNIONS t = frontier u /\ (!c. c IN t ==> &(dimindex(:N)) - &1 simplex c) /\ (!c. c IN t ==> ~(vec 0 IN vertex_image f c)) /\ (!c. c IN t ==> ~(x IN frontier(conic hull (vertex_image f c)))) /\ (!c. c IN t ==> ~(y IN frontier(conic hull (vertex_image f c)))) ==> brouwer_degree3(x,t,f) = brouwer_degree3(y,t,f)`, let lemma0 = prove (`!f:A->real s. FINITE s ==> sum {t | t SUBSET s /\ t HAS_SIZE 2} (\t. sum t f) = &(CARD s - 1) * sum s f`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!P. FINITE {t:A->bool | t SUBSET s /\ P t}` ASSUME_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {y | P y} /\ Q x}`] THEN ASM_SIMP_TAC[FINITE_POWERSET; FINITE_RESTRICT]; ALL_TAC] THEN TRANS_TAC EQ_TRANS `sum s (\x:A. sum {t | t SUBSET s /\ t HAS_SIZE 2 /\ x IN t} (\t. f x))` THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) SUM_SUM_PRODUCT o lhand o snd) THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SUM_PRODUCT o rand o rand o snd) THEN SIMP_TAC[IN_ELIM_THM; HAS_SIZE] THEN ASM_REWRITE_TAC[GSYM HAS_SIZE] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN EXISTS_TAC `\(t:A->bool,x:A). (x,t)` THEN EXISTS_TAC `\(x:A,t:A->bool). (t,x)` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN SET_TAC[]; ASM_SIMP_TAC[SUM_CONST] THEN SUBGOAL_THEN `!x:A. x IN s ==> CARD {t | t SUBSET s /\ t HAS_SIZE 2 /\ x IN t} = CARD s - 1` (fun th -> ASM_SIMP_TAC[th; SUM_LMUL]) THEN X_GEN_TAC `a:A` THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `CARD(IMAGE (\x:A. {a,x}) (s DELETE a))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN X_GEN_TAC `t:A->bool` THEN REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[TAUT `p /\ (q /\ r) /\ s <=> r /\ p /\ q /\ s`] THEN SIMP_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN REWRITE_TAC[NOT_IMP; IN_INSERT; NOT_IN_EMPTY; LEFT_OR_DISTRIB] THEN REWRITE_TAC[EXISTS_OR_THM; CONJ_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SWAP_EXISTS_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[OR_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM SET_TAC[]; ASM_SIMP_TAC[CARD_IMAGE_INJ; FINITE_DELETE; CARD_DELETE; IN_DELETE; SET_RULE `{a,x} = {a,y} <=> x = y`]]]) and lemma1 = prove (`!P a:real^N->real b s z. (?t. open t /\ z IN t /\ !x y. (x IN t /\ P x) /\ (y IN t /\ P y) ==> a x = a y) /\ (?t. open t /\ z IN t /\ !x y. (x IN t /\ P x) /\ (y IN t /\ P y) ==> b x = b y) ==> ?t. open t /\ z IN t /\ !x y. (x IN t /\ P x) /\ (y IN t /\ P y) ==> a x + b x = a y + b y`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `t INTER u:real^N->bool` THEN ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]) and lemma2 = prove (`!P a:real^N->A->real k s z. FINITE k /\ (!i. i IN k ==> ?t. open t /\ z IN t /\ !x y. (x IN t /\ P x) /\ (y IN t /\ P y) ==> a x i = a y i) ==> ?t. open t /\ z IN t /\ !x y. (x IN t /\ P x) /\ (y IN t /\ P y) ==> sum k (a x) = sum k (a y)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:A->real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES] THENL [MESON_TAC[IN_UNIV; OPEN_UNIV]; ALL_TAC] THEN EXISTS_TAC `INTERS (IMAGE (u:A->real^N->bool) k)` THEN ASM_SIMP_TAC[OPEN_INTERS; FINITE_IMAGE; FORALL_IN_IMAGE; IN_INTERS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]) and main_lemma = prove (`!A:real^N^N z k. 2 <= dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ ~(det A = &0) /\ z IN relative_interior(conic hull (convex hull {row i A | i IN 1..dimindex(:N) /\ ~(i = k)})) ==> ?e. &0 < e /\ !x. x IN ball(z,e) ==> (x IN conic hull (convex hull (rows A)) <=> &0 <= det(lambda i. if i = k then x else A$i) / det A) /\ (x IN interior(conic hull (convex hull (rows A))) <=> &0 < det(lambda i. if i = k then x else A$i) / det A)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~dependent(rows(A:real^N^N))` ASSUME_TAC THENL [ASM_MESON_TAC[DET_DEPENDENT_ROWS]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DEPENDENT_AFFINE_DEPENDENT_CASES]) THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!m. 1 <= m /\ m <= dimindex(:N) ==> conic hull (convex hull {row i A | i IN 1..dimindex(:N) /\ ~(i = m)}) face_of conic hull(convex hull (rows(A:real^N^N)))` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_CONIC_HULL THEN ASM_REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN EXISTS_TAC `{row i (A:real^N^N) | i IN 1..dimindex(:N) /\ ~(i = m)}` THEN REWRITE_TAC[rows; IN_NUMSEG] THEN SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[IN_CONIC_CONVEX_HULL_ROWS_QFREE; IN_INTERIOR_CONIC_CONVEX_HULL_ROWS_QFREE] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) /\ ~(i = k) ==> ?e. &0 < e /\ !x. x IN ball(z,e) ==> &0 < det((lambda j. if j = i then x else A$j)) / det(A:real^N^N)` MP_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. lift(det((lambda j. if j = i then x else A$j)) / det(A:real^N^N))) continuous at z` MP_TAC THENL [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[o_DEF; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`p:num`; `q:num`] THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_CASES_TAC `p:num = i` THEN ASM_SIMP_TAC[CONTINUOUS_CONST; CONTINUOUS_AT_LIFT_COMPONENT]; REWRITE_TAC[continuous_at]] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[DIST_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `det((lambda j. if j = i then z else A$j)) / det(A:real^N^N)`) THEN ANTS_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> ~(x < &0) /\ ~(x = &0)`]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_BALL] THEN MESON_TAC[REAL_ARITH `abs(z - x) < z ==> &0 < x`]] THEN CONJ_TAC THENL [DISCH_TAC THEN MP_TAC(ISPECL [`A:real^N^N`; `z:real^N`] IN_CONIC_CONVEX_HULL_ROWS_QFREE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> ~(p <=> q)`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `z IN relative_interior s ==> relative_interior s SUBSET s /\ s SUBSET t ==> z IN t`)) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET; rows; IN_NUMSEG] THEN REPEAT(MATCH_MP_TAC HULL_MONO) THEN SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[real_ge; GSYM REAL_NOT_LT]]; ASM_SIMP_TAC[GSYM(REWRITE_RULE[EXTENSION; IN_ELIM_THM] IN_SPAN_DEPLETED_ROWS_QFREE); REAL_DIV_EQ_0] THEN DISCH_TAC THEN MP_TAC(ISPECL [`conic hull(convex hull (rows(A:real^N^N)))`; `conic hull(convex hull { row j (A:real^N^N) | j IN 1..dimindex(:N) /\ ~(j = i)})`; `conic hull(convex hull { row j (A:real^N^N) | j IN 1..dimindex(:N) /\ ~(j = k)})`] SUBSET_OF_FACE_OF_AFFINE_HULL) THEN ASM_SIMP_TAC[CONVEX_CONIC_HULL; CONVEX_CONVEX_HULL; NOT_IMP] THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC HULL_MONO) THEN REWRITE_TAC[rows; IN_NUMSEG] THEN SET_TAC[]; ASM_SIMP_TAC[AFFINE_HULL_CONIC_HULL; CONVEX_HULL_EQ_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x | x IN s /\ ~(x = a)} = {} <=> s SUBSET {a}`] THEN COND_CASES_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_SUBSET)) THEN SIMP_TAC[FINITE_SING; CARD_SING; CARD_NUMSEG_1] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n <= 1)`]; SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN REWRITE_TAC[SPAN_INSERT_0; SPAN_CONVEX_HULL] THEN ASM SET_TAC[]]; DISCH_THEN(MP_TAC o MATCH_MP SPAN_MONO) THEN REWRITE_TAC[SPAN_CONIC_HULL; SPAN_CONVEX_HULL] THEN SUBGOAL_THEN `row k (A:real^N^N) IN span {row j A | j IN 1..dimindex (:N) /\ ~(j = i)}` MP_TAC THENL [MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[]; REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`; GSYM INSERT_SUBSET]] THEN DISCH_THEN(MP_TAC o MATCH_MP SPAN_MONO) THEN REWRITE_TAC[SPAN_SPAN] THEN MATCH_MP_TAC(SET_RULE `!u. u SUBSET s /\ ~(u SUBSET t) ==> ~(s SUBSET t)`) THEN EXISTS_TAC `span(rows (A:real^N^N))` THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN REWRITE_TAC[SUBSET; rows; FORALL_IN_GSPEC] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_CASES_TAC `j:num = k` THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INSERT; IN_NUMSEG] THEN DISJ2_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN REWRITE_TAC[DIM_SPAN; GSYM RANK_ROW; NOT_LE] THEN SUBGOAL_THEN `rank(A:real^N^N) = dimindex(:N)` SUBST1_TAC THENL [ASM_MESON_TAC[RANK_EQ_FULL_DET]; ALL_TAC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIM_LE_CARD o lhand o snd) THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LET_TRANS) THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LET_TRANS) THEN SIMP_TAC[GSYM DELETE; CARD_DELETE; FINITE_NUMSEG] THEN ASM_REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN ASM_ARITH_TAC]]]; REWRITE_TAC[CONJ_ASSOC; GSYM IN_NUMSEG; GSYM IN_DELETE] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `ee:num->real` THEN REWRITE_TAC[FORALL_AND_THM; TAUT `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN STRIP_TAC THEN SUBGOAL_THEN `~((1..dimindex(:N)) DELETE k = {})` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `s DELETE a = {} <=> s SUBSET {a}`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_SUBSET)) THEN SIMP_TAC[FINITE_SING; CARD_SING; CARD_NUMSEG_1] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n <= 1)`]; ALL_TAC] THEN EXISTS_TAC `inf(IMAGE ee ((1..dimindex(:N)) DELETE k))` THEN ASM_SIMP_TAC[IN_BALL; REAL_LT_INF_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE; FINITE_NUMSEG; FINITE_DELETE] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; real_gt; real_ge] THEN CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[IN_NUMSEG] THEN DISCH_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_CASES_TAC `j:num = k` THEN ASM_REWRITE_TAC[] THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; IN_NUMSEG; IN_DELETE]) THEN ASM SET_TAC[]) in SUBGOAL_THEN `!f:real^N->real^N t u x y. 2 <= dimindex(:N) /\ convex u /\ bounded u /\ vec 0 IN interior u /\ triangulation t /\ UNIONS t = frontier u /\ (!c. c IN t ==> &(dimindex(:N)) - &1 simplex c) /\ (!c. c IN t ==> ~(vec 0 IN vertex_image f c)) /\ (!c. c IN t ==> ~(x IN frontier(conic hull (vertex_image f c)))) /\ (!c. c IN t ==> ~(y IN frontier(conic hull (vertex_image f c)))) /\ (!c. c IN t ==> ~(relative_orientation f c = &0)) ==> brouwer_degree3(x,t,f) = brouwer_degree3(y,t,f)` MP_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN SUBGOAL_THEN `!c:real^N->bool. c IN t ==> ~(vec 0 IN affine hull c)` ASSUME_TAC THENL [ASM_MESON_TAC[NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION; SUBSET_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^N`; `t:(real^N->bool)->bool`] BROUWER_DEGREE3_PERTURB) THEN RULE_ASSUM_TAC(REWRITE_RULE[triangulation]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `t:(real^N->bool)->bool`; `min d e`] ORIENTING_PERTURBATION_EXISTS) THEN ASM_REWRITE_TAC[REAL_LT_MIN; dist] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`g:real^N->real^N`; `t:(real^N->bool)->bool`; `u:real^N->bool`; `x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `g:real^N->real^N`)) THEN REPLICATE_TAC 2 (ANTS_TAC THENL [ASM_MESON_TAC[]; STRIP_TAC]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[RELATIVE_ORIENTATION_NONZERO; HULL_INC]] THEN ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `t:(real^N->bool)->bool`] THEN ASM_CASES_TAC `triangulation(t:(real^N->bool)->bool)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `FINITE(t:(real^N->bool)->bool)` THENL [ALL_TAC; ASM_MESON_TAC[triangulation]] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=> p /\ q /\ r /\ s ==> t ==> u`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!c:real^N->bool. c IN t ==> ~(vec 0 IN affine hull c)` ASSUME_TAC THENL [ASM_MESON_TAC[NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION; SUBSET_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!w:real^N. ?c. c IN t /\ w IN conic hull c` ASSUME_TAC THENL [MATCH_MP_TAC ANY_IN_CONIC_HULL_SIMPLEX THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. x IN (:real^N) DIFF UNIONS {frontier(conic hull (vertex_image f c)) | c IN t}`; `\x y:real^N. brouwer_degree3(x,t,f) = brouwer_degree3(y,t,f)`; `(:real^N) DIFF UNIONS {k | c,k | c IN t /\ k IN {k | k face_of conic hull vertex_image f c /\ aff_dim k <= &(dimindex (:N)) - &2}}`] CONNECTED_EQUIVALENCE_RELATION_GEN) THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(MESON[] `(Q x /\ Q y) /\ (!z. Q z ==> P z) ==> (!a b. P a /\ P b /\ Q a /\ Q b ==> brouwer_degree3(a,t,f) = brouwer_degree3(b,t,f)) ==> brouwer_degree3(x,t,f) = brouwer_degree3(y,t,f)`) THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONTRAPOS_THM; UNIONS_GSPEC; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN ASM_SIMP_TAC[FRONTIER_OF_CONVEX_CLOSED; CONVEX_CONIC_HULL_VERTEX_IMAGE; CLOSED_CONIC_HULL_VERTEX_IMAGE] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[INT_ARITH `k:int <= n - &2 ==> k < n`]] THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`!c. c IN t ==> ~((x:real^N) IN frontier (conic hull vertex_image f c))`; `!c. c IN t ==> ~((y:real^N) IN frontier (conic hull vertex_image f c))`] THEN REWRITE_TAC[EQ_SYM; EQ_TRANS] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] OPEN_IN_OPEN] THEN REWRITE_TAC[MESON[] `(!t a. (?u. t = f a u /\ P u) /\ Q a t ==> R t a) <=> (!u a. P u /\ Q a (f a u) ==> R (f a u) a)`] THEN REWRITE_TAC[MESON[] `(?x. (?y. P x y /\ R x y) /\ Q x) <=> ?y x. P x y /\ R x y /\ Q x`] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[IN_INTER; IMP_IMP; GSYM CONJ_ASSOC] THEN SIMP_TAC[IN_DIFF; IN_UNIV] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM THEN REWRITE_TAC[CONNECTED_UNIV; AFFINE_HULL_UNIV; OPEN_IN_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_RESTRICT THEN ASM_SIMP_TAC[FINITE_POLYHEDRON_FACES; POLYHEDRON_CONIC_HULL_VERTEX_IMAGE]; REWRITE_TAC[FORALL_IN_GSPEC; AFF_DIM_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN INT_ARITH_TAC]; MATCH_MP_TAC(SET_RULE `(!a u. a IN u /\ open u ==> ~((UNIV DIFF t) INTER u = {})) /\ s SUBSET t ==> !u a. open u /\ P a /\ a IN u ==> ?z. ~(z IN s) /\ z IN u /\ ~(z IN t)`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CLOSURE_NONEMPTY_OPEN_INTER; CLOSURE_COMPLEMENT] THEN REWRITE_TAC[SET_RULE `(!x. x IN UNIV DIFF s) <=> s = {}`] THEN MATCH_MP_TAC NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE; FINITE_IMP_COUNTABLE; FRONTIER_CLOSED] THEN ASM_SIMP_TAC[INTERIOR_FRONTIER_EMPTY; CLOSED_CONIC_HULL_VERTEX_IMAGE]; REWRITE_TAC[UNIONS_GSPEC; SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN ASM_SIMP_TAC[FRONTIER_OF_CONVEX_CLOSED; CONVEX_CONIC_HULL_VERTEX_IMAGE; CLOSED_CONIC_HULL_VERTEX_IMAGE] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[INT_ARITH `k:int <= n - &2 ==> k < n`]]; ALL_TAC] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[UNIONS_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN DISCH_TAC THEN REWRITE_TAC[brouwer_degree3; ETA_AX] THEN REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t /\ u <=> (q /\ t /\ p) /\ (s /\ u /\ r)`] THEN SUBGOAL_THEN `!c:real^N->bool. c IN t ==> ~(vec 0 IN affine hull (vertex_image f c))` ASSUME_TAC THENL [ASM_MESON_TAC[RELATIVE_ORIENTATION_NONZERO]; ALL_TAC] THEN ASM_CASES_TAC `z:real^N = vec 0` THENL [MATCH_MP_TAC(TAUT `F ==> p`) THEN FIRST_ASSUM(MP_TAC o GEN `c:real^N->bool` o ONCE_REWRITE_RULE[IMP_CONJ] o SPECL [`c:real^N->bool`; `{vec 0:real^N}`]) THEN ASM_SIMP_TAC[FACE_OF_SING; EXTREME_POINT_OF_CONIC_HULL; IN_SING] THEN ASM_REWRITE_TAC[AFF_DIM_SING; INT_SUB_LE; INT_OF_NUM_LE] THEN ASM_MESON_TAC[VERTEX_IMAGE_NONEMPTY]; ALL_TAC] THEN SUBGOAL_THEN `!x. sum {c | c IN t /\ x IN conic hull vertex_image f c} (relative_orientation (f:real^N->real^N)) = sum {c | c IN t /\ x IN conic hull vertex_image f c /\ ~(z IN frontier(conic hull vertex_image f c))} (relative_orientation f) + sum {k | ?c. c IN t /\ k face_of c /\ aff_dim k = &(dimindex(:N)) - &2 /\ z IN conic hull (vertex_image f k)} (\k. sum {c | c IN {c | c IN t /\ x IN conic hull vertex_image f c /\ z IN frontier(conic hull vertex_image f c)} /\ k face_of c} (relative_orientation f))` (fun th -> ONCE_REWRITE_TAC[th]) THENL [X_GEN_TAC `w:real^N` THEN TRANS_TAC EQ_TRANS `sum {c | c IN t /\ w IN conic hull vertex_image f c /\ ~(z IN frontier(conic hull vertex_image f c))} (relative_orientation f) + sum {c | c IN t /\ w IN conic hull vertex_image f c /\ z IN frontier(conic hull vertex_image f c)} (relative_orientation(f:real^N->real^N))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN SET_TAC[]; AP_TERM_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_GROUP_RELATION o rand o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN REFL_TAC] THEN ASM_SIMP_TAC[FINITE_RESTRICT; FORALL_IN_GSPEC] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?k. k face_of c /\ aff_dim k = &(dimindex (:N)) - &2 /\ z IN conic hull (vertex_image (f:real^N->real^N) k)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?k. k face_of c /\ aff_dim k < &(dimindex (:N)) - &1 /\ z IN conic hull (vertex_image (f:real^N->real^N) k)` STRIP_ASSUME_TAC THENL [ALL_TAC; MP_TAC(ISPECL [`c:real^N->bool`; `k:real^N->bool`] FACE_OF_POLYHEDRON_FACE_OF_FACET) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SIMPLEX_IMP_POLYHEDRON]; ALL_TAC] THEN CONJ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[AFF_DIM_SIMPLEX; INT_LT_REFL]] THEN UNDISCH_TAC `z IN conic hull vertex_image (f:real^N->real^N) k` THEN ASM_REWRITE_TAC[vertex_image; EXTREME_POINT_OF_EMPTY; EMPTY_GSPEC; IMAGE_CLAUSES; CONVEX_HULL_EMPTY; CONIC_HULL_EMPTY; NOT_IN_EMPTY]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N->bool` THEN SIMP_TAC[facet_of] THEN STRIP_TAC THEN REWRITE_TAC[INT_ARITH `n - &2:int = (n - &1) - &1`] THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_SIMPLEX]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `z IN s ==> s SUBSET t ==> z IN t`)) THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[vertex_image] THEN MATCH_MP_TAC HULL_MONO THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[EXTREME_POINT_OF_FACE]]] THEN UNDISCH_TAC `(z:real^N) IN frontier (conic hull vertex_image f c)` THEN ASM_SIMP_TAC[FRONTIER_OF_CONVEX_CLOSED; CONVEX_CONIC_HULL_VERTEX_IMAGE; CLOSED_CONIC_HULL_VERTEX_IMAGE] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN ASM_SIMP_TAC[FACE_OF_CONIC_HULL_EQ] THEN REWRITE_TAC[RIGHT_OR_DISTRIB; EXISTS_OR_THM] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[IN_SING]; ALL_TAC] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2; MESON[] `((p /\ x = y) /\ q) /\ r <=> y = x /\ p /\ q /\ r`] THEN DISCH_THEN(X_CHOOSE_THEN `l:real^N->bool` (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN REWRITE_TAC[vertex_image] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] FACE_OF_CONVEX_HULL_SUBSET)) THEN ANTS_TAC THENL [MATCH_MP_TAC FINITE_IMP_COMPACT THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYHEDRON]; REWRITE_TAC[EXISTS_SUBSET_IMAGE]] THEN DISCH_THEN(X_CHOOSE_THEN `e:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `convex hull e:real^N->bool` THEN SUBGOAL_THEN `{v:real^N | v extreme_point_of convex hull e} = e` SUBST1_TAC THENL [MATCH_MP_TAC EXTREME_POINTS_OF_CONVEX_HULL_AFFINE_INDEPENDENT THEN ASM_MESON_TAC[AFFINE_INDEPENDENT_SUBSET; SIMPLEX_EXTREME_POINTS]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET_FACE_OF_SIMPLEX]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN UNDISCH_TAC `aff_dim (conic hull l:real^N->bool) < &(dimindex (:N))` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `~(vec 0 IN affine hull vertex_image (f:real^N->real^N) c)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~affine_dependent(e:real^N->bool) /\ ~affine_dependent {v:real^N | v extreme_point_of c}` MP_TAC THENL [MATCH_MP_TAC(MESON[AFFINE_INDEPENDENT_SUBSET] `s SUBSET t /\ ~affine_dependent t ==> ~affine_dependent s /\ ~affine_dependent t`) THEN ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]; REWRITE_TAC[AFFINE_INDEPENDENT_IFF_CARD]] THEN SUBGOAL_THEN `aff_dim {v:real^N | v extreme_point_of c} = &(dimindex(:N)) - &1` SUBST1_TAC THENL [ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS; AFF_DIM_CONVEX_HULL; AFF_DIM_SIMPLEX]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN REWRITE_TAC[INT_ARITH `x - &1:int < y - &1 <=> x < y`] THEN REWRITE_TAC[INT_OF_NUM_LT] THEN MATCH_MP_TAC CARD_PSUBSET THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]] THEN ASM_REWRITE_TAC[PSUBSET] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [AFF_DIM_CONIC_HULL]) THEN ASM_REWRITE_TAC[GSYM vertex_image] THEN REWRITE_TAC[vertex_image] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[CONIC_HULL_EMPTY; MEMBER_NOT_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM vertex_image] THEN ASM_REWRITE_TAC[AFF_DIM_DIM; INT_SUB_ADD; INT_OF_NUM_LT] THEN MP_TAC(ISPEC `c:real^N->bool` SIMPLEX_ORDERING_EXISTS) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (ASSUME_TAC o SYM)) THEN ASM_REWRITE_TAC[vertex_image] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION (SYM th)]) THEN ASM_REWRITE_TAC[DIM_CONVEX_HULL; GSYM ROWS_MAPROWS] THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN SIMP_TAC[GSYM RANK_EQ_FULL_DET; RANK_ROW; ROWS_MAPROWS; LT_REFL]; ALL_TAC] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N->bool` THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; CONJ_ASSOC] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN PURE_ONCE_REWRITE_TAC[TAUT `p <=> ~p ==> F`] THEN DISCH_TAC THEN SUBGOAL_THEN `(k INTER l:real^N->bool) face_of c` ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_INTER]; ALL_TAC] THEN SUBGOAL_THEN `aff_dim(k INTER l:real^N->bool) < &(dimindex(:N)) - &2` ASSUME_TAC THENL [MP_TAC(ISPEC `k INTER l:real^N->bool` FACE_OF_AFF_DIM_LT) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (SET_RULE `~(l = k) ==> ~(k INTER l = k) \/ ~(k INTER l = l)`)) THENL [DISCH_THEN(MP_TAC o SPEC `k:real^N->bool`); DISCH_THEN(MP_TAC o SPEC `l:real^N->bool`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN (CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_CONVEX]; ALL_TAC]) THEN MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `c:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_INTER; INTER_SUBSET; FACE_OF_IMP_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `~(vec 0 IN affine hull (vertex_image (f:real^N->real^N) c))` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^N->bool`; `conic hull (vertex_image (f:real^N->real^N) (k INTER l))`]) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_CONIC_HULL THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[vertex_image] THEN W(MP_TAC o PART_MATCH (lhand o rand) FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT o snd) THEN REWRITE_TAC[EXISTS_SUBSET_IMAGE] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `{v:real^N | v extreme_point_of k INTER l}` THEN REWRITE_TAC[] THEN MP_TAC(ISPECL [`k INTER l:real^N->bool`; `c:real^N->bool`] EXTREME_POINT_OF_FACE) THEN ASM_REWRITE_TAC[] THEN SET_TAC[]] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] AFFINE_DEPENDENT_IMP_DEPENDENT) THEN MP_TAC(ISPEC `c:real^N->bool` SIMPLEX_ORDERING_EXISTS) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (ASSUME_TAC o SYM)) THEN ASM_REWRITE_TAC[vertex_image] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION (SYM th)]) THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN REWRITE_TAC[GSYM ROWS_MAPROWS] THEN MESON_TAC[DET_DEPENDENT_ROWS]; REWRITE_TAC[AFF_DIM_CONIC_HULL] THEN MATCH_MP_TAC(INT_ARITH `x:int < a ==> (if p then x else x + &1) <= a`) THEN TRANS_TAC INT_LET_TRANS `aff_dim(k INTER l:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[vertex_image; AFF_DIM_CONVEX_HULL] THEN W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_LE_CARD o lhand o snd) THEN SUBGOAL_THEN `FINITE {v:real^N | v extreme_point_of k INTER l}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN ASM_MESON_TAC[FACE_OF_POLYHEDRON_POLYHEDRON; SIMPLEX_IMP_POLYHEDRON]; ASM_SIMP_TAC[FINITE_IMAGE]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS) THEN REWRITE_TAC[INT_LE_SUB_RADD] THEN TRANS_TAC INT_LE_TRANS `&(CARD {v:real^N | v extreme_point_of k INTER l}):int` THEN ASM_SIMP_TAC[CARD_IMAGE_LE; INT_OF_NUM_LE] THEN MATCH_MP_TAC(INT_ARITH `n:int = c - &1 ==> c:int <= n + &1`) THEN TRANS_TAC EQ_TRANS `aff_dim(convex hull {v:real^N | v extreme_point_of k INTER l})` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_COMPACT]; ALL_TAC] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN SUBGOAL_THEN `~affine_dependent {v:real^N | v extreme_point_of k INTER l}` MP_TAC THENL [ALL_TAC; SIMP_TAC[AFFINE_INDEPENDENT_IFF_CARD] THEN INT_ARITH_TAC] THEN MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN EXISTS_TAC `{v:real^N | v extreme_point_of c}` THEN CONJ_TAC THENL [ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]; ALL_TAC] THEN MP_TAC(ISPECL [`k INTER l:real^N->bool`; `c:real^N->bool`] EXTREME_POINT_OF_FACE) THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; SUBGOAL_THEN `z IN conic hull vertex_image f k INTER conic hull vertex_image (f:real^N->real^N) l` MP_TAC THENL [ASM_REWRITE_TAC[IN_INTER]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) INTER_CONIC_HULL o rand o lhand o snd) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(z IN s) ==> t SUBSET s ==> ~(z IN t)`)) THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[UNION_SUBSET; vertex_image] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN MATCH_MP_TAC IMAGE_SUBSET THENL [MP_TAC(ISPEC `k:real^N->bool` EXTREME_POINT_OF_FACE); MP_TAC(ISPEC `l:real^N->bool` EXTREME_POINT_OF_FACE)] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_SIMP_TAC[] THEN SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN ASM_CASES_TAC `vertex_image (f:real^N->real^N) k = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `vertex_image (f:real^N->real^N) l = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> z IN s ==> z IN t`) THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[vertex_image] THEN W(MP_TAC o PART_MATCH (lhand o rand) CONVEX_HULL_INTER o lhand o snd) THEN SUBGOAL_THEN `~(affine_dependent (IMAGE (f:real^N->real^N) {v:real^N | v extreme_point_of c}))` ASSUME_TAC THENL [MATCH_MP_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] AFFINE_DEPENDENT_IMP_DEPENDENT) THEN MP_TAC(ISPEC `c:real^N->bool` SIMPLEX_ORDERING_EXISTS) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (ASSUME_TAC o SYM)) THEN ASM_REWRITE_TAC[vertex_image] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION (SYM th)]) THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN REWRITE_TAC[GSYM ROWS_MAPROWS] THEN MESON_TAC[DET_DEPENDENT_ROWS]; ALL_TAC] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] AFFINE_INDEPENDENT_SUBSET)) THEN REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THEN MATCH_MP_TAC IMAGE_SUBSET THENL [MP_TAC(ISPEC `k:real^N->bool` EXTREME_POINT_OF_FACE); MP_TAC(ISPEC `l:real^N->bool` EXTREME_POINT_OF_FACE)] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_SIMP_TAC[] THEN SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC HULL_MONO THEN MATCH_MP_TAC(SET_RULE `IMAGE f (s INTER t) SUBSET u /\ (!x y. x IN s UNION t /\ y IN s UNION t /\ f x = f y ==> x = y) ==> IMAGE f s INTER IMAGE f t SUBSET u`) THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM; EXTREME_POINT_OF_INTER]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ (!x y. x IN t /\ y IN t /\ f x = f y ==> x = y) ==> !x y. x IN s /\ y IN s /\ f x = f y ==> x = y`) THEN EXISTS_TAC `{v:real^N | v extreme_point_of c}` THEN CONJ_TAC THENL [REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL [MP_TAC(ISPEC `k:real^N->bool` EXTREME_POINT_OF_FACE); MP_TAC(ISPEC `l:real^N->bool` EXTREME_POINT_OF_FACE)] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_SIMP_TAC[] THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^N`; `{v:real^N | v extreme_point_of c}`] CARD_IMAGE_EQ_INJ) THEN ANTS_TAC THENL [ASM_MESON_TAC[FINITE_POLYHEDRON_EXTREME_POINTS; SIMPLEX_IMP_POLYHEDRON]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN TRANS_TAC EQ_TRANS `(&(dimindex(:N)) - &1) + &1:int` THEN CONJ_TAC THENL [MATCH_MP_TAC(INT_ARITH `s - &1:int = c ==> s = c + &1`); ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFFINE_INDEPENDENT_IFF_CARD]) THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_CONVEX_HULL] THEN ASM_SIMP_TAC[AFF_DIM_DIM; GSYM vertex_image] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MP_TAC(ISPEC `c:real^N->bool` SIMPLEX_ORDERING_EXISTS) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (ASSUME_TAC o SYM)) THEN ASM_REWRITE_TAC[vertex_image] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION (SYM th)]) THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN REWRITE_TAC[DIM_CONVEX_HULL; GSYM ROWS_MAPROWS] THEN SIMP_TAC[GSYM RANK_EQ_FULL_DET; RANK_ROW]]; ALL_TAC] THEN MATCH_MP_TAC lemma1 THEN CONJ_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x } = {x | x IN {x | P x /\ R x} /\ Q x}`] THEN ONCE_REWRITE_TAC[SUM_RESTRICT_SET] THEN MATCH_MP_TAC lemma2 THEN REWRITE_TAC[IN_ELIM_THM] THENL [CONJ_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o REWRITE_RULE[FRONTIER_INTERIORS])) THEN REWRITE_TAC[IN_DIFF; IN_UNIV; DE_MORGAN_THM] THEN MATCH_MP_TAC(MESON[] `(z IN s ==> P s) /\ (z IN t ==> P t) ==> z IN s \/ z IN t ==> ?u. P u`) THEN CONJ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN MESON_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET; OPEN_INTERIOR; IN_DIFF]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `UNIONS {{k:real^N->bool | k face_of c} | c IN t}` THEN REWRITE_TAC[FINITE_UNIONS] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_POLYTOPE_FACES; SIMPLEX_IMP_POLYTOPE]; ALL_TAC] THEN REWRITE_TAC[UNIONS_IMAGE; facet_of] THEN SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `k:real^N->bool` THEN REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET; ETA_AX; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN SUBGOAL_THEN `!x. {c:real^N->bool | c IN t /\ z IN frontier (conic hull vertex_image f c) /\ x IN conic hull vertex_image (f:real^N->real^N) c /\ k face_of c} = {c | (c IN t /\ k face_of c) /\ x IN conic hull vertex_image f c}` (fun th -> ONCE_REWRITE_TAC[th]) THENL [X_GEN_TAC `w:real^N` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `d:real^N->bool` THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `z IN s ==> s SUBSET t ==> z IN t`)) THEN SUBGOAL_THEN `~dependent(IMAGE (f:real^N->real^N) {v | v extreme_point_of d})` ASSUME_TAC THENL [MP_TAC(ISPEC `d:real^N->bool` SIMPLEX_ORDERING_EXISTS) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (ASSUME_TAC o SYM)) THEN ASM_REWRITE_TAC[vertex_image] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RELATIVE_ORIENTATION (SYM th)]) THEN REWRITE_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN REWRITE_TAC[GSYM ROWS_MAPROWS] THEN MESON_TAC[DET_DEPENDENT_ROWS]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DEPENDENT_AFFINE_DEPENDENT_CASES]) THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET_FRONTIER_AFF_DIM THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_CONIC_HULL THEN ASM_REWRITE_TAC[vertex_image; AFFINE_HULL_CONVEX_HULL] THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN REWRITE_TAC[EXISTS_SUBSET_IMAGE] THEN EXISTS_TAC `{v:real^N | v extreme_point_of k}` THEN MP_TAC(ISPECL [`k:real^N->bool`; `d:real^N->bool`] EXTREME_POINT_OF_FACE) THEN ASM_SIMP_TAC[] THEN SET_TAC[]; REWRITE_TAC[AFF_DIM_CONIC_HULL] THEN MATCH_MP_TAC(INT_ARITH `x <= n - &2 ==> (if p then x else x + &1):int < n`) THEN REWRITE_TAC[vertex_image; AFF_DIM_CONVEX_HULL] THEN W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_LE_CARD o lhand o snd) THEN SUBGOAL_THEN `FINITE {v:real^N | v extreme_point_of k}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN ASM_MESON_TAC[FACE_OF_POLYHEDRON_POLYHEDRON; SIMPLEX_IMP_POLYHEDRON]; ASM_SIMP_TAC[FINITE_IMAGE]] THEN MATCH_MP_TAC(INT_ARITH `b:int <= n - &1 ==> x <= b - &1 ==> x <= n - &2`) THEN TRANS_TAC INT_LE_TRANS `&(CARD {v:real^N | v extreme_point_of k}):int` THEN ASM_SIMP_TAC[CARD_IMAGE_LE; INT_OF_NUM_LE] THEN MATCH_MP_TAC(INT_ARITH `x - &1:int <= y - &2 ==> x <= y - &1`) THEN MP_TAC(ISPEC `{v:real^N | v extreme_point_of k}` AFF_DIM_AFFINE_INDEPENDENT) THEN ANTS_TAC THENL [MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN EXISTS_TAC `{v:real^N | v extreme_point_of d}` THEN CONJ_TAC THENL [ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]; MP_TAC(ISPECL [`k:real^N->bool`; `d:real^N->bool`] EXTREME_POINT_OF_FACE) THEN ASM_SIMP_TAC[] THEN SET_TAC[]]; DISCH_THEN(SUBST1_TAC o SYM)] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `x:int = n - &2 ==> x = y ==> y <= n - &2`)) THEN GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_CONVEX_HULL] THEN AP_TERM_TAC THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_COMPACT]]; ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN ONCE_REWRITE_TAC[SUM_RESTRICT_SET]] THEN SUBGOAL_THEN `?c d:real^N->bool. c IN t /\ d IN t /\ k face_of c /\ k face_of d /\ ~(c = d)` ASSUME_TAC THENL [UNDISCH_TAC `?c:real^N->bool. c IN t /\ k face_of c` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?a:real^N. a IN relative_interior (conic hull k)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[MEMBER_NOT_EMPTY] THEN W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_INTERIOR_EQ_EMPTY o rand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVEX_CONIC_HULL; face_of]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[CONIC_HULL_EQ_EMPTY] THEN ASM_REWRITE_TAC[GSYM AFF_DIM_EQ_MINUS1] THEN MATCH_MP_TAC(INT_ARITH `&2:int <= n ==> ~(n - &2 = -- &1)`) THEN ASM_REWRITE_TAC[INT_OF_NUM_LE]; ALL_TAC] THEN SUBGOAL_THEN `?d:real^N->bool. d IN t /\ ~(d = c) /\ a IN conic hull d` MP_TAC THENL [REWRITE_TAC[SET_RULE `(?d. d IN t /\ P d /\ a IN f d) <=> a IN UNIONS {f d | d IN t /\ P d}`] THEN MATCH_MP_TAC(MESON[CLOSURE_CLOSED] `closed s /\ a IN closure s ==> a IN s`) THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_CONIC_HULL_STRONG THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYTOPE]]; ALL_TAC] THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_IN_UNIONS; EXISTS_IN_GSPEC; RIGHT_EXISTS_AND_THM] THEN SUBGOAL_THEN `ball (a:real^N,e) SUBSET {a | ?c. c IN t /\ a IN conic hull c}` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(ball(a:real^N,e) SUBSET conic hull c)` MP_TAC THENL [SUBGOAL_THEN `(a:real^N) IN frontier(conic hull c)` MP_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> a IN s ==> a IN t`) THEN MATCH_MP_TAC FACE_OF_SUBSET_FRONTIER_AFF_DIM THEN ASM_SIMP_TAC[AFF_DIM_CONIC_HULL] THEN CONJ_TAC THENL [ALL_TAC; INT_ARITH_TAC] THEN MATCH_MP_TAC FACE_OF_CONIC_HULL THEN ASM_SIMP_TAC[]; REWRITE_TAC[FRONTIER_STRADDLE] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN SET_TAC[]]; ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(s SUBSET t) /\ s SUBSET u ==> ?x. x IN s /\ x IN u /\ ~(x IN t)`)) THEN REWRITE_TAC[IN_ELIM_THM; IN_BALL; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN ASM_CASES_TAC `d:real^N->bool = c` THEN ASM_REWRITE_TAC[DIST_SYM] THEN MESON_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRANS_TAC FACE_OF_TRANS `c INTER d:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[triangulation]] THEN MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `c:real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[triangulation]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `k SUBSET c /\ relative_interior k SUBSET k /\ ~DISJOINT d (relative_interior k) ==> ~DISJOINT (c INTER d) (relative_interior k)`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`d:real^N->bool`; `relative_interior k:real^N->bool`;`u:real^N->bool`] INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `relative_interior d SUBSET d /\ relative_frontier u = frontier u /\ c SUBSET frontier u /\ d SUBSET frontier u ==> c UNION relative_interior d SUBSET relative_frontier u`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC RELATIVE_FRONTIER_NONEMPTY_INTERIOR THEN ASM SET_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM SET_TAC[]]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[DISJOINT]] THEN DISCH_TAC THEN SUBGOAL_THEN `~((vec 0:real^N) IN affine hull k)` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; FACE_OF_IMP_SUBSET; HULL_MONO]; ALL_TAC] THEN UNDISCH_TAC `(a:real^N) IN relative_interior (conic hull k)` THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_CONIC_HULL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `2 <= CARD {c:real^N->bool | c IN t /\ k face_of c}` ASSUME_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `c:real^N->bool` (X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC)) THEN TRANS_TAC LE_TRANS `CARD{c:real^N->bool,d:real^N->bool}` THEN CONJ_TAC THENL [ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_SING; ARITH]; MATCH_MP_TAC CARD_SUBSET THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!f. sum {c:real^N->bool | c IN t /\ k face_of c} f = sum {u | u SUBSET {c | c IN t /\ k face_of c} /\ u HAS_SIZE 2} (\u. sum u f) / &(CARD {c | c IN t /\ k face_of c} - 1)` (fun th -> REWRITE_TAC[th]) THENL [X_GEN_TAC `f:(real^N->bool)->real` THEN W(MP_TAC o PART_MATCH (lhs o rand) lemma0 o lhand o rand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(REAL_FIELD `~(y = &0) ==> x = (y * x) / y`) THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; ARITH_RULE `2 <= n ==> ~(n - 1 = 0)`]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; ARITH_RULE `2 <= n ==> ~(n - 1 = 0)`; REAL_FIELD `~(y = &0) ==> (a / y = b / y <=> a = b)`] THEN MATCH_MP_TAC lemma2 THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {y | P y} /\ Q x}`] THEN MATCH_MP_TAC FINITE_RESTRICT THEN MATCH_MP_TAC FINITE_POWERSET THEN ASM_SIMP_TAC[FINITE_RESTRICT]; MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`?c d:real^N->bool. c IN t /\ d IN t /\ k face_of c /\ k face_of d /\ ~(c = d)`; `?c:real^N->bool. c IN t /\ k face_of c`]] THEN REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`; IN_ELIM_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!a b c. P a b c) <=> (!b c a. P a b c)`] THEN ONCE_REWRITE_TAC[TAUT `p /\ ~q /\ r ==> s <=> r ==> p /\ ~q ==> s`] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `d:real^N->bool`] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `convex hull {v:real^N | v extreme_point_of c} = c /\ convex hull {v:real^N | v extreme_point_of d} = d /\ convex hull {v:real^N | v extreme_point_of k} = k` STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN (CONJ_TAC THENL [MATCH_MP_TAC POLYTOPE_IMP_CONVEX; MATCH_MP_TAC POLYTOPE_IMP_COMPACT]) THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYTOPE; FACE_OF_POLYTOPE_POLYTOPE]; ALL_TAC] THEN SUBGOAL_THEN `?a b:real^N. ~(a IN k) /\ ~(b IN k) /\ a INSERT {v | v extreme_point_of k} = {v | v extreme_point_of c} /\ b INSERT {v | v extreme_point_of k} = {v | v extreme_point_of d}` STRIP_ASSUME_TAC THENL [REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ r) /\ (q /\ s)`] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [MP_TAC(HAS_SIZE_CONV `({v | v extreme_point_of c} DIFF {v:real^N | v extreme_point_of k}) HAS_SIZE 1`); MP_TAC(HAS_SIZE_CONV `({v | v extreme_point_of d} DIFF {v:real^N | v extreme_point_of k}) HAS_SIZE 1`)] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN (CONJ_TAC THENL [MATCH_MP_TAC(MESON[HAS_SIZE; CARD_DIFF; FINITE_DIFF] `FINITE s /\ t SUBSET s /\ CARD s - CARD t = 1 ==> (s DIFF t) HAS_SIZE 1`) THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_POLYHEDRON_EXTREME_POINTS; SIMPLEX_IMP_POLYHEDRON]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[EXTREME_POINT_OF_FACE]; DISCH_TAC] THEN MATCH_MP_TAC(ARITH_RULE `!n. x = n /\ y = n - 1 /\ 2 <= n ==> x - y = 1`) THEN EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN CONJ_TAC THEN MATCH_MP_TAC(INT_ARITH `x - &1:int = y - &1 ==> x = y`) THEN W(MP_TAC o PART_MATCH (rand o rand) AFF_DIM_AFFINE_INDEPENDENT o lhand o snd) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_CONVEX_HULL] THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS; AFF_DIM_SIMPLEX]; REWRITE_TAC[INT_ARITH `x:int = y - &1 - &1 <=> y - &2 = x`]] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s DIFF t = {a} ==> t SUBSET s ==> a INSERT t = s`)) THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[EXTREME_POINT_OF_FACE]; SIMP_TAC[]] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `(hull) convex:(real^N->bool)->real^N->bool`) THEN MATCH_MP_TAC(SET_RULE `!k. k SUBSET c /\ ~(k = c) /\ t SUBSET k ==> t = c ==> F`) THEN EXISTS_TAC `k:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_SIMPLEX; INT_ARITH `~(x - &2:int = x - &1)`]; MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[extreme_point_of; face_of]]]); ALL_TAC] THEN SUBGOAL_THEN `?A:real^N^N. rows A = {v | v extreme_point_of c} /\ {row i A | i IN 1..dimindex(:N) /\ ~(i = 1)} = {v | v extreme_point_of k}` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`{v:real^N | v extreme_point_of c}`; `a:real^N`] FINITE_INDEX_NUMSEG_SPECIAL) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]; DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` MP_TAC)] THEN SUBGOAL_THEN `CARD {v:real^N | v extreme_point_of c} = dimindex(:N)` SUBST1_TAC THENL [REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN ONCE_REWRITE_TAC[INT_ARITH `c:int = n <=> c = (n - &1) + &1`] THEN ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]; STRIP_TAC] THEN EXISTS_TAC `(lambda i. f i):real^N^N` THEN ASM_REWRITE_TAC[rows; row; LAMBDA_ETA] THEN CONJ_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE; GSYM IN_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN SIMP_TAC[LAMBDA_BETA; IN_NUMSEG]; MATCH_MP_TAC(SET_RULE `!a. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ z IN s /\ ~(a IN k) /\ a INSERT k = IMAGE f s /\ f z = a ==> {f x | x IN s /\ ~(x = z)} = k`) THEN EXISTS_TAC `a:real^N` THEN SIMP_TAC[LAMBDA_BETA; IMP_CONJ; IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN ASM_REWRITE_TAC[extreme_point_of] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN SIMP_TAC[LAMBDA_BETA; IN_NUMSEG]]; ALL_TAC] THEN ABBREV_TAC `B:real^N^N = lambda i. if i = 1 then b else (A:real^N^N)$i` THEN SUBGOAL_THEN `rows(B:real^N^N) = {v | v extreme_point_of d}` ASSUME_TAC THENL [SIMP_TAC[rows; GSYM IN_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `1 IN k /\ f 1 INSERT {f i | i IN k /\ ~(i = 1)} = s ==> {f i | i IN k} = s`) THEN EXPAND_TAC "B" THEN SIMP_TAC[row; IN_NUMSEG; LE_REFL; DIMINDEX_GE_1; LAMBDA_ETA; LAMBDA_BETA] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INSERT k = d ==> l = k ==> b INSERT l = d`)) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[IN_NUMSEG; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN SIMP_TAC[LAMBDA_BETA; row; LAMBDA_ETA]; ALL_TAC] THEN MP_TAC(ISPECL [`B:real^N^N`; `f:real^N->real^N`; `d:real^N->bool`] RELATIVE_ORIENTATION) THEN MP_TAC(ISPECL [`A:real^N^N`; `f:real^N->real^N`; `c:real^N->bool`] RELATIVE_ORIENTATION) THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 (DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `x = y ==> ~(x = &0) ==> ~(y = &0)`)) THEN ASM_SIMP_TAC[REAL_SGN_EQ; REAL_DIV_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC) THEN MP_TAC(ISPECL [`maprows (f:real^N->real^N) B`; `z:real^N`; `1`] main_lemma) THEN MP_TAC(ISPECL [`maprows (f:real^N->real^N) A`; `z:real^N`; `1`] main_lemma) THEN ASM_REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN ASM_REWRITE_TAC[ROWS_MAPROWS; GSYM vertex_image] THEN SUBGOAL_THEN `convex hull {row i (maprows (f:real^N->real^N) A) | i IN 1..dimindex (:N) /\ ~(i = 1)} = vertex_image f k /\ convex hull {row i (maprows (f:real^N->real^N) B) | i IN 1..dimindex (:N) /\ ~(i = 1)} = vertex_image f k` (CONJUNCTS_THEN SUBST1_TAC) THENL [MATCH_MP_TAC(MESON[] `x = y /\ x = a ==> x = a /\ y = a`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN EXPAND_TAC "B" THEN SIMP_TAC[LAMBDA_BETA; row; LAMBDA_ETA; maprows; IN_NUMSEG]; REWRITE_TAC[vertex_image] THEN AP_TERM_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; ROW_MAPROWS]]; ALL_TAC] THEN SUBGOAL_THEN `z IN relative_interior (conic hull vertex_image (f:real^N->real^N) k)` ASSUME_TAC THENL [MP_TAC(ISPEC `conic hull vertex_image (f:real^N->real^N) k` RELATIVE_FRONTIER_OF_POLYHEDRON_ALT) THEN ANTS_TAC THENL [MATCH_MP_TAC POLYHEDRON_CONIC_HULL_POLYTOPE THEN REWRITE_TAC[vertex_image] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN MATCH_MP_TAC FACE_OF_POLYHEDRON_POLYHEDRON THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYHEDRON]; DISCH_THEN(MP_TAC o SPEC `z:real^N` o GEN_REWRITE_RULE I [EXTENSION])] THEN ASM_SIMP_TAC[relative_frontier; REWRITE_RULE[SUBSET] CLOSURE_SUBSET; IN_DIFF] THEN MATCH_MP_TAC(TAUT `~q ==> (~p <=> q) ==> p`) THEN REWRITE_TAC[IN_UNIONS; NOT_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `f:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^N->bool`; `f:real^N->bool`]) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_TRANS THEN EXISTS_TAC `conic hull vertex_image (f:real^N->real^N) k` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_CONIC_HULL THEN SUBGOAL_THEN `~(dependent (IMAGE (f:real^N->real^N) {v | v extreme_point_of c}))` MP_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 3 RAND_CONV) [SYM th]) THEN REWRITE_TAC[GSYM ROWS_MAPROWS] THEN ASM_MESON_TAC[DET_DEPENDENT_ROWS]; REWRITE_TAC[DEPENDENT_AFFINE_DEPENDENT_CASES; DE_MORGAN_THM] THEN STRIP_TAC] THEN ASM_REWRITE_TAC[vertex_image; AFFINE_HULL_CONVEX_HULL] THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN EXISTS_TAC `IMAGE (f:real^N->real^N) {v:real^N | v extreme_point_of k}` THEN REWRITE_TAC[] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[EXTREME_POINT_OF_FACE]; MATCH_MP_TAC(INT_ARITH `!y:int. x < y /\ y <= z - &1 ==> x <= z - &2`) THEN EXISTS_TAC `aff_dim(conic hull vertex_image (f:real^N->real^N) k)` THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[vertex_image] THEN SIMP_TAC[CONVEX_CONIC_HULL; CONVEX_CONVEX_HULL]; ALL_TAC] THEN REWRITE_TAC[AFF_DIM_CONIC_HULL] THEN MATCH_MP_TAC(INT_ARITH `x:int <= n - &2 ==> (if p then x else x + &1) <= n - &1`) THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL; vertex_image] THEN SUBGOAL_THEN `FINITE {v:real^N | v extreme_point_of k}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN MATCH_MP_TAC FACE_OF_POLYHEDRON_POLYHEDRON THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYHEDRON]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_LE_CARD o lhand o snd) THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN MATCH_MP_TAC(INT_ARITH `c:int < b ==> x <= c - &1 ==> x <= b - &2`) THEN REWRITE_TAC[INT_OF_NUM_LT] THEN TRANS_TAC LET_TRANS `CARD {v:real^N | v extreme_point_of k}` THEN ASM_SIMP_TAC[CARD_IMAGE_LE] THEN REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN MATCH_MP_TAC(INT_ARITH `x - &1:int <= y - &2 ==> x < y`) THEN MP_TAC(ISPEC `{v:real^N | v extreme_point_of k}` AFF_DIM_AFFINE_INDEPENDENT) THEN ANTS_TAC THENL [MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN EXISTS_TAC `{v:real^N | v extreme_point_of d}` THEN CONJ_TAC THENL [ASM_MESON_TAC[SIMPLEX_EXTREME_POINTS]; MP_TAC(ISPECL [`k:real^N->bool`; `d:real^N->bool`] EXTREME_POINT_OF_FACE) THEN ASM_SIMP_TAC[] THEN SET_TAC[]]; DISCH_THEN(SUBST1_TAC o SYM)] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `x:int = n - &2 ==> x = y ==> y <= n - &2`)) THEN GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_CONVEX_HULL] THEN AP_TERM_TAC THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_COMPACT]]; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[IN_BALL; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e1:real` THEN STRIP_TAC THEN X_GEN_TAC `e2:real` THEN STRIP_TAC THEN EXISTS_TAC `ball(z:real^N,e1) INTER ball(z,e2)` THEN SIMP_TAC[OPEN_INTER; OPEN_BALL; IN_INTER] THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[IN_SING] THEN ASM_SIMP_TAC[] THEN MP_TAC(ISPECL [`B:real^N^N`; `f:real^N->real^N`; `d:real^N->bool`] RELATIVE_ORIENTATION) THEN MP_TAC(ISPECL [`A:real^N^N`; `f:real^N->real^N`; `c:real^N->bool`] RELATIVE_ORIENTATION) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN SUBGOAL_THEN `!w:real^N. det(lambda i. if i = 1 then w else maprows f B$i) = det(lambda i. if i = 1 then w else maprows f A$i)` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN AP_TERM_TAC THEN EXPAND_TAC "B" THEN SIMP_TAC[CART_EQ; maprows; LAMBDA_BETA; LAMBDA_ETA]; ALL_TAC] THEN SUBGOAL_THEN `~(x IN frontier(conic hull vertex_image (f:real^N->real^N) c)) /\ ~(y IN frontier(conic hull vertex_image (f:real^N->real^N) c))` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[frontier; IN_DIFF] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (SET_RULE `~(x IN closure s /\ ~(x IN t)) ==> s SUBSET closure s ==> ~(x IN s /\ ~(x IN t))`))) THEN ASM_SIMP_TAC[CLOSURE_SUBSET; IMP_IMP] THEN ASM_CASES_TAC `det(lambda i. if i = 1 then x:real^N else maprows f A$i) = &0` THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_LT_REFL; REAL_LE_REFL] THEN ASM_CASES_TAC `det(lambda i. if i = 1 then y:real^N else maprows f A$i) = &0` THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_LT_REFL; REAL_LE_REFL] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_SGN_INEQS] THEN REWRITE_TAC[REAL_SGN_DIV] THEN SUBGOAL_THEN `real_sgn(det(B:real^N^N)) / real_sgn(det(A:real^N^N)) <= &0` MP_TAC THENL [ALL_TAC; MP_TAC(SPEC `det (maprows (f:real^N->real^N) B)` REAL_SGN_CASES) THEN MP_TAC(SPEC `det (maprows (f:real^N->real^N) A)` REAL_SGN_CASES) THEN MP_TAC(SPEC `det (B:real^N^N)` REAL_SGN_CASES) THEN MP_TAC(SPEC `det (A:real^N^N)` REAL_SGN_CASES) THEN MP_TAC(SPEC `det(lambda i. if i = 1 then y else maprows (f:real^N->real^N) A$i)` REAL_SGN_CASES) THEN MP_TAC(SPEC `det(lambda i. if i = 1 then x else maprows (f:real^N->real^N) A$i)` REAL_SGN_CASES) THEN ASM_REWRITE_TAC[CONJUNCT1 REAL_SGN_EQ] THEN REPLICATE_TAC 6 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN SUBGOAL_THEN `~(relative_interior(conic hull k):real^N->bool = {})` MP_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^N->bool)->int`) THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_RELATIVE_INTERIOR o lhand o lhand o snd) THEN REWRITE_TAC[NOT_IMP] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVEX_CONIC_HULL; FACE_OF_IMP_CONVEX]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[AFF_DIM_CONIC_HULL; AFF_DIM_EMPTY] THEN MATCH_MP_TAC(INT_ARITH `&2:int <= x ==> ~((if p then x - &2 else x - &2 + &1) = -- &1)`) THEN ASM_REWRITE_TAC[INT_OF_NUM_LE]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `w:real^N`)] THEN MP_TAC(ISPECL [`B:real^N^N`; `w:real^N`; `1`] main_lemma) THEN MP_TAC(ISPECL [`A:real^N^N`; `w:real^N`; `1`] main_lemma) THEN ASM_REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN SUBGOAL_THEN `{row i (B:real^N^N) | i IN 1..dimindex(:N) /\ ~(i = 1)} = {row i (A:real^N^N) | i IN 1..dimindex(:N) /\ ~(i = 1)}` (fun th -> ASM_REWRITE_TAC[th]) THENL [MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN EXPAND_TAC "B" THEN SIMP_TAC[IN_NUMSEG; row; LAMBDA_BETA; LAMBDA_ETA]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM]] THEN MAP_EVERY X_GEN_TAC [`d1:real`; `d2:real`] THEN SUBGOAL_THEN `(w:real^N) IN frontier(interior(conic hull c))` MP_TAC THENL [REWRITE_TAC[frontier; INTERIOR_INTERIOR] THEN SUBGOAL_THEN `closure(interior(conic hull c)):real^N->bool = closure(conic hull c)` SUBST1_TAC THENL [MATCH_MP_TAC CONVEX_CLOSURE_INTERIOR THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ (p ==> q)`] THEN SIMP_TAC[GSYM AFF_DIM_NONEMPTY_INTERIOR_EQ] THEN ASM_SIMP_TAC[AFF_DIM_CONIC_HULL] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONIC_HULL; SIMPLEX_IMP_CONVEX]; DISCH_TAC] THEN SUBGOAL_THEN `aff_dim(c:real^N->bool) = &(dimindex(:N)) - &1` MP_TAC THENL [ASM_MESON_TAC[AFF_DIM_SIMPLEX]; ALL_TAC] THEN REWRITE_TAC[GSYM AFF_DIM_EQ_MINUS1] THEN UNDISCH_TAC `2 <= dimindex(:N)` THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN INT_ARITH_TAC; REWRITE_TAC[GSYM frontier] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `z IN relative_interior s ==> relative_interior s SUBSET s /\ s SUBSET t ==> z IN t`)) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN MATCH_MP_TAC FACE_OF_SUBSET_FRONTIER_AFF_DIM THEN ASM_SIMP_TAC[AFF_DIM_CONIC_HULL] THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC INT_ARITH] THEN MATCH_MP_TAC FACE_OF_CONIC_HULL THEN ASM_MESON_TAC[]]; REWRITE_TAC[frontier; IN_DIFF] THEN DISCH_THEN(MP_TAC o CONJUNCT1)] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] CLOSURE_APPROACHABLE] THEN ASM_CASES_TAC `&0 < d1` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `&0 < d2` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d1 d2:real`) THEN ASM_REWRITE_TAC[IN_BALL; LEFT_IMP_EXISTS_THM; REAL_LT_MIN] THEN X_GEN_TAC `v:real^N` THEN STRIP_TAC THEN REPEAT(DISCH_THEN(MP_TAC o SPEC `v:real^N`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC) THEN ASM_CASES_TAC `real_sgn(det(B:real^N^N)) = real_sgn(det(A:real^N^N))` THENL [ALL_TAC; MP_TAC(SPEC `det (B:real^N^N)` REAL_SGN_CASES) THEN MP_TAC(SPEC `det (A:real^N^N)` REAL_SGN_CASES) THEN ASM_REWRITE_TAC[CONJUNCT1 REAL_SGN_EQ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[]] THEN SUBGOAL_THEN `(v:real^N) IN interior(conic hull c) /\ v IN interior(conic hull d)` MP_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[REAL_SGN_INEQS] `&0 < x ==> real_sgn x = real_sgn y ==> &0 < y`)) THEN ASM_REWRITE_TAC[REAL_SGN_DIV] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN EXPAND_TAC "B" THEN SIMP_TAC[LAMBDA_BETA]; MATCH_MP_TAC(TAUT `~p ==> p ==> q`)] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `v IN interior c /\ v IN interior d ==> interior c SUBSET relative_interior c /\ interior d SUBSET relative_interior d ==> ~(relative_interior c INTER relative_interior d = {})`)) THEN REWRITE_TAC[INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_CONIC_HULL] THEN MATCH_MP_TAC(SET_RULE `s INTER t SUBSET {a} ==> (s DELETE a) INTER (t DELETE a) = {}`) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`relative_interior c:real^N->bool`; `relative_interior d:real^N->bool`; `u:real^N->bool`] INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `relative_interior c SUBSET c /\ relative_interior d SUBSET d /\ relative_frontier u = frontier u /\ c SUBSET frontier u /\ d SUBSET frontier u ==> relative_interior c UNION relative_interior d SUBSET relative_frontier u`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC RELATIVE_FRONTIER_NONEMPTY_INTERIOR THEN ASM SET_TAC[]; ASM SET_TAC[]]; DISCH_THEN SUBST1_TAC] THEN COND_CASES_TAC THEN REWRITE_TAC[EMPTY_SUBSET] THEN COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC(SET_RULE `s = {} ==> s SUBSET a`) THEN REWRITE_TAC[CONIC_HULL_EQ_EMPTY] THEN UNDISCH_TAC `~(c:real^N->bool = d)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN MP_TAC(ISPECL [`t:(real^N->bool)->bool`; `c:real^N->bool`; `d:real^N->bool`] TRIANGULATION_DISJOINT_RELATIVE_INTERIORS) THEN MAP_EVERY (MP_TAC o C ISPEC RELATIVE_INTERIOR_SUBSET) [`c:real^N->bool`; `d:real^N->bool`] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Degree of a linear mapping. *) (* ------------------------------------------------------------------------- *) let BROUWER_DEGREE3_LINEAR_GEN = prove (`!f:real^N->real^N t y. FINITE t /\ (!c. c IN t ==> &(dimindex (:N)) - &1 simplex c) /\ (!c. c IN t ==> ~(vec 0 IN affine hull c)) /\ linear f ==> brouwer_degree3(y,t,f) = real_sgn(det(matrix f)) * &(CARD {c | c IN t /\ y IN conic hull (vertex_image f c)})`, REPEAT STRIP_TAC THEN REWRITE_TAC[brouwer_degree3] THEN TRANS_TAC EQ_TRANS `sum {c | c IN t /\ y IN conic hull (vertex_image f c)} (\c:real^N->bool. real_sgn (det (matrix f)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_ORIENTATION_LINEAR THEN ASM_MESON_TAC[]; MATCH_MP_TAC(ONCE_REWRITE_RULE[REAL_MUL_SYM] SUM_CONST) THEN ASM_SIMP_TAC[FINITE_RESTRICT]]);; let BROUWER_DEGREE3_LINEAR = prove (`!f:real^N->real^N t u y. convex u /\ bounded u /\ vec 0 IN interior u /\ triangulation t /\ UNIONS t = frontier u /\ (!c. c IN t ==> &(dimindex (:N)) - &1 simplex c) /\ linear f /\ (!c. c IN t ==> ~(y IN frontier(conic hull (vertex_image f c)))) ==> brouwer_degree3(y,t,f) = real_sgn(det(matrix f))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(t:(real^N->bool)->bool)` THENL [ALL_TAC; ASM_MESON_TAC[triangulation]] THEN SUBGOAL_THEN `!c:real^N->bool. c IN t ==> ~(vec 0 IN affine hull c)` ASSUME_TAC THENL [ASM_MESON_TAC[NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION; SUBSET_REFL]; ASM_SIMP_TAC[BROUWER_DEGREE3_LINEAR_GEN]] THEN REWRITE_TAC[REAL_RING `x * a = x <=> ~(x = &0) ==> a = &1`] THEN ASM_SIMP_TAC[REAL_SGN_EQ; DET_MATRIX_EQ_0_LEFT] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^N->real^N`; `g:real^N->real^N`] LINEAR_INVERSE_LEFT) THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ] THEN DISCH_TAC THEN SUBGOAL_THEN `{c | c IN t /\ y IN conic hull vertex_image f c} = {c | c IN t /\ (g:real^N->real^N) y IN conic hull c}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N->bool` THEN ASM_CASES_TAC `(c:real^N->bool) IN t` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[CONIC_HULL_VERTEX_IMAGE_LINEAR] THEN MATCH_MP_TAC(SET_RULE `(!x. f(g x) = x) /\ (!y. g(f y) = y) ==> (y IN IMAGE f s <=> g y IN s)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[HAS_SIZE] `s HAS_SIZE 1 ==> CARD s = 1`) THEN CONV_TAC HAS_SIZE_CONV THEN REWRITE_TAC[SET_RULE `(?a. s = {a}) <=> ?!a. a IN s`; IN_ELIM_THM] THEN MATCH_MP_TAC NONBOUNDARY_IN_UNIQUE_CONIC_HULL_SIMPLEX THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `!c. c IN t ==> ~((y:real^N) IN frontier(conic hull vertex_image f c))` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N->bool` THEN ASM_CASES_TAC `(c:real^N->bool) IN t` THEN ASM_SIMP_TAC[CONTRAPOS_THM] THEN ASM_SIMP_TAC[VERTEX_IMAGE_LINEAR; CONIC_HULL_LINEAR_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) FRONTIER_BIJECTIVE_LINEAR_IMAGE o rand o snd) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Point-independent version of degree and its homotopy invariance. *) (* ------------------------------------------------------------------------- *) let brouwer_degree2 = new_definition `brouwer_degree2(t,f) = let x = @x. !c. c IN t ==> ~(x IN frontier(conic hull vertex_image f c)) in brouwer_degree3(x,t,f)`;; let BROUWER_DEGREE2_HOMOTOPY_INVARIANCE_LEMMA = prove (`!f g:real^N->real^N. 2 <= dimindex(:N) /\ homotopic_with (\x. T) ((:real^N) DELETE vec 0,(:real^N) DELETE vec 0) f g ==> ?u t. convex u /\ bounded u /\ vec 0 IN interior u /\ triangulation t /\ UNIONS t = frontier u /\ (!c. c IN t ==> &(dimindex (:N)) - &1 simplex c) /\ brouwer_degree2(t,f) = brouwer_degree2(t,g)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `vec 0:real^N` CHOOSE_SURROUNDING_SIMPLEX_FULL) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFF_DIM_SIMPLEX) THEN EXISTS_TAC `u:real^N->bool` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SIMPLEX_IMP_CONVEX]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_BOUNDED]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x:real^N. x IN frontier u ==> r <= norm(x)` ASSUME_TAC THENL [REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `(!x. ~(P x) ==> x IN i) ==> (!x. x IN c DIFF i ==> P x)`) THEN REWRITE_TAC[NORM_ARITH `~(r <= norm x) <=> dist(vec 0:real^N,x) < r`] THEN REWRITE_TAC[GSYM IN_BALL; GSYM SUBSET; GSYM INTERIOR_CBALL] THEN ASM_SIMP_TAC[SUBSET_INTERIOR]; ALL_TAC] THEN SUBGOAL_THEN `~((vec 0:real^N) IN frontier u)` ASSUME_TAC THENL [ASM_MESON_TAC[NORM_0; REAL_NOT_LT]; ALL_TAC] THEN SUBGOAL_THEN `?R. &0 < R /\ !t x. t IN interval[vec 0,vec 1] /\ x IN frontier u ==> R <= norm((h:real^(1,N)finite_sum->real^N) (pastecart t x))` STRIP_ASSUME_TAC THENL [EXISTS_TAC `setdist({vec 0},IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS frontier u))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[SETDIST_POS_LE; SETDIST_EQ_0_SING] THEN REWRITE_TAC[IMAGE_EQ_EMPTY; PCROSS_EQ_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[DE_MORGAN_THM; FRONTIER_EQ_EMPTY] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[NOT_IN_EMPTY; INTERIOR_EMPTY]; ASM_MESON_TAC[NOT_BOUNDED_UNIV]; MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> ~(h x = a)) /\ closure(IMAGE h s) = IMAGE h s ==> ~(a IN closure(IMAGE h s))`) THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS]) THEN SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_FRONTIER_BOUNDED] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]]]; REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_ARITH `norm(x:real^N) = dist(vec 0,x)`] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN SIMP_TAC[IN_SING; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(h:real^(1,N)finite_sum->real^N) uniformly_continuous_on interval[vec 0,vec 1] PCROSS frontier u` ASSUME_TAC THENL [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN ASM_SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_FRONTIER_BOUNDED] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [uniformly_continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `R / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`{f:real^N->bool | f facet_of u}`; `&(dimindex(:N)) - &1:int`; `min (&1 / &2) e`] FINE_TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN ANTS_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN FIRST_ASSUM(MP_TAC o MATCH_MP TRIANGULATION_SIMPLEX_FACETS) THEN REWRITE_TAC[triangulation; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[facet_of] THEN ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SIMPLEX_IMP_POLYTOPE]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP RELATIVE_FRONTIER_OF_POLYHEDRON o MATCH_MP SIMPLEX_IMP_POLYHEDRON) THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [AFF_DIM_EQ_FULL]) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_FRONTIER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:(real^N->bool)->bool` THEN REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_SIMPLEX; triangulation]; DISCH_TAC] THEN SUBGOAL_THEN `FINITE(t:(real^N->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[triangulation]; ALL_TAC] THEN SUBGOAL_THEN `!c a. a IN interval[vec 0,vec 1] /\ c IN t ==> ~(vec 0 IN vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart a) c)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart a) c = {})` MP_TAC THENL [ASM_MESON_TAC[VERTEX_IMAGE_NONEMPTY]; ALL_TAC] THEN REWRITE_TAC[vertex_image; CONVEX_HULL_EQ_EMPTY] THEN SIMP_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `w:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `(h:real^(1,N)finite_sum->real^N) (pastecart a w) IN vertex_image (h o pastecart a) c` MP_TAC THENL [REWRITE_TAC[vertex_image] THEN MATCH_MP_TAC HULL_INC THEN REWRITE_TAC[IN_IMAGE; o_THM; IN_ELIM_THM] THEN ASM_MESON_TAC[]; REWRITE_TAC[GSYM vertex_image]] THEN MATCH_MP_TAC(MESON[REAL_LT_REFL] `(w IN s ==> (!x. x IN s ==> dist(x,w) < dist(z,w))) ==> w IN s ==> ~(z IN s)`) THEN DISCH_TAC THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `!r. &0 < r /\ x <= r / &2 /\ r <= y ==> x < y`) THEN EXISTS_TAC `R:real` THEN ASM_REWRITE_TAC[DIST_0] THEN CONJ_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[extreme_point_of]) THEN ASM SET_TAC[]] THEN TRANS_TAC REAL_LE_TRANS `diameter(vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart a) c)` THEN CONJ_TAC THENL [REWRITE_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_MESON_TAC[POLYTOPE_VERTEX_IMAGE; POLYTOPE_IMP_BOUNDED]; ALL_TAC] THEN REWRITE_TAC[vertex_image; DIAMETER_CONVEX_HULL] THEN MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_IMP_LE] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_ELIM_THM; o_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `dist(x:real^N,y) < r ==> norm(x - y) <= r`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[DIST_PASTECART_CANCEL; PASTECART_IN_PCROSS] THEN RULE_ASSUM_TAC(REWRITE_RULE[extreme_point_of]) THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN TRANS_TAC REAL_LET_TRANS `diameter(c:real^N->bool)` THEN ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_BOUNDED]; ALL_TAC] THEN MP_TAC(ISPECL [`\t:real^1. T`; `\a b. brouwer_degree2(t,(h:real^(1,N)finite_sum->real^N) o pastecart a) = brouwer_degree2(t,(h:real^(1,N)finite_sum->real^N) o pastecart b)`; `interval[vec 0:real^1,vec 1]`] CONNECTED_EQUIVALENCE_RELATION_GEN) THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `vec 1:real^1`]) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; o_DEF; ETA_AX]] THEN REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN X_GEN_TAC `a:real^1` THEN STRIP_TAC THEN ABBREV_TAC `z = @x. !k. k IN t ==> ~(x IN frontier (conic hull vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart a) k))` THEN MP_TAC(ISPECL [`(h:real^(1,N)finite_sum->real^N) o pastecart a`; `t:(real^N->bool)->bool`; `z:real^N`] BROUWER_DEGREE3_PERTURB) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[] THEN EXPAND_TAC "z" THEN CONV_TAC SELECT_CONV THEN ONCE_REWRITE_TAC[SET_RULE `(?x. P x) <=> ~({x | P x} = {})`] THEN MATCH_MP_TAC(MESON[CLOSURE_EMPTY; UNIV_NOT_EMPTY] `closure s = (:real^N) ==> ~(s = {})`) THEN MATCH_MP_TAC CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [uniformly_continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `m:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `interval[vec 0,vec 1] INTER ball(a:real^1,d)` THEN SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER; OPEN_BALL; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN MAP_EVERY X_GEN_TAC [`b:real^1`; `c:real^1`] THEN STRIP_TAC THEN REWRITE_TAC[brouwer_degree2] THEN MAP_EVERY ABBREV_TAC [`x = @x. !k. k IN t ==> ~(x IN frontier (conic hull vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart b) k))`; `y = @x. !k. k IN t ==> ~(x IN frontier (conic hull vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart c) k))`] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN FIRST_X_ASSUM(fun th -> MP_TAC(CONJ (SPEC `(h:real^(1,N)finite_sum->real^N) o pastecart b` th) (SPEC `(h:real^(1,N)finite_sum->real^N) o pastecart c` th))) THEN MATCH_MP_TAC(TAUT `(p /\ q) /\ (r /\ s ==> t) ==> (p ==> r) /\ (q ==> s) ==> t`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[o_DEF; GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; DIST_PASTECART_CANCEL] THEN RULE_ASSUM_TAC(REWRITE_RULE[extreme_point_of]) THEN ASM SET_TAC[]; STRIP_TAC] THEN SUBGOAL_THEN `(!k. k IN t ==> ~(x IN frontier (conic hull vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart b) k))) /\ (!k. k IN t ==> ~(y IN frontier (conic hull vertex_image ((h:real^(1,N)finite_sum->real^N) o pastecart c) k)))` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [EXPAND_TAC "x"; EXPAND_TAC "y"] THEN CONV_TAC SELECT_CONV THEN ONCE_REWRITE_TAC[SET_RULE `(?x. P x) <=> ~({x | P x} = {})`] THEN MATCH_MP_TAC(MESON[CLOSURE_EMPTY; UNIV_NOT_EMPTY] `closure s = (:real^N) ==> ~(s = {})`) THEN MATCH_MP_TAC CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `!z. brouwer_degree3(z,t,f) = brouwer_degree3(z,t,g) /\ brouwer_degree3(x,t,f) = brouwer_degree3(z,t,f) /\ brouwer_degree3(y,t,g) = brouwer_degree3(z,t,g) ==> brouwer_degree3 (x,t,f) = brouwer_degree3(y,t,g)`) THEN EXISTS_TAC `z:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; CONJ_TAC] THEN MATCH_MP_TAC BROUWER_DEGREE3_POINT_INDEPENDENCE THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence the key theorem about homotopy of linear maps. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_LINEAR_MAPS_IMP = prove (`!f g:real^N->real^N. linear f /\ linear g /\ homotopic_with (\x. T) ((:real^N) DELETE vec 0,(:real^N) DELETE vec 0) f g ==> real_sgn(det(matrix f)) = real_sgn(det(matrix g))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL [MP_TAC(ISPECL [`f:real^N->real^N`; `g:real^N->real^N`] BROUWER_DEGREE2_HOMOTOPY_INVARIANCE_LEMMA) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; brouwer_degree2] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `t:(real^N->bool)->bool`] THEN MAP_EVERY ABBREV_TAC [`x = @x:real^N. !k. k IN t ==> ~(x IN frontier (conic hull vertex_image f k))`; `y = @x:real^N. !k. k IN t ==> ~(x IN frontier (conic hull vertex_image g k))`] THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN MATCH_MP_TAC BROUWER_DEGREE3_LINEAR THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR] THEN MAP_EVERY EXPAND_TAC ["x"; "y"] THEN CONV_TAC SELECT_CONV THEN ONCE_REWRITE_TAC[SET_RULE `(?x. P x) <=> ~({x | P x} = {})`] THEN MATCH_MP_TAC(MESON[CLOSURE_EMPTY; UNIV_NOT_EMPTY] `closure s = (:real^N) ==> ~(s = {})`) THEN MATCH_MP_TAC CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[triangulation]; FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(2 <= n) ==> (1 <= n ==> n = 1)`)) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`(\x. lift(x$1)) o (h:real^(1,N)finite_sum->real^N) o (\t. pastecart t (basis 1))`; `interval[vec 0:real^1,vec 1]`] CONNECTED_CONTINUOUS_IMAGE) THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN SIMP_TAC[IN_DELETE; IN_UNIV; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; ASM_SIMP_TAC[DET_1_GEN; matrix; LAMBDA_BETA; DIMINDEX_1; ARITH] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_SGN_EQ_INEQ; DE_MORGAN_THM; REAL_NOT_LT] THEN STRIP_TAC THEN REWRITE_TAC[GSYM CONVEX_CONNECTED_1; CONVEX_CONTAINS_SEGMENT] THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `vec 1:real^1`]) THEN ASM_REWRITE_TAC[o_THM; ENDS_IN_UNIT_INTERVAL] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN REWRITE_TAC[NOT_IMP; IN_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_1; LIFT_DROP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> q ==> ~p`] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; IN_DELETE] THEN DISCH_THEN(MP_TAC o SPEC `pastecart (t:real^1) (basis 1:real^N)`) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_DELETE] THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN ASM_REWRITE_TAC[CART_EQ; FORALL_1; DIMINDEX_1] THEN REWRITE_TAC[VEC_COMPONENT; o_DEF; CONTRAPOS_THM] THEN REWRITE_TAC[GSYM drop; LIFT_DROP] THEN MESON_TAC[]]]]);; let HOMOTOPIC_LINEAR_MAPS_ALT = prove (`!f g:real^N->real^N. linear f /\ linear g /\ homotopic_with (\x. T) ((:real^N) DELETE vec 0,(:real^N) DELETE vec 0) f g ==> &0 < det(matrix f) * det(matrix g)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SGN_INEQS] THEN MP_TAC(ISPECL [`f:real^N->real^N`; `g:real^N->real^N`] HOMOTOPIC_LINEAR_MAPS_IMP) THEN ASM_SIMP_TAC[REAL_SGN_MUL; GSYM REAL_POW_2; REAL_LT_POW_2] THEN DISCH_TAC THEN REWRITE_TAC[REAL_SGN_INEQS] THEN FIRST_ASSUM(MP_TAC o CONJUNCT2 o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `IMAGE f (UNIV DELETE a) SUBSET UNIV DELETE a ==> !x. f x = a ==> x = a`)) THEN ASM_SIMP_TAC[GSYM LINEAR_INJECTIVE_0; MATRIX_INVERTIBLE; GSYM INVERTIBLE_DET_NZ] THEN ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE; LINEAR_INVERSE_LEFT]);; let HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP = prove (`!f g:real^N->real^N. orthogonal_transformation f /\ orthogonal_transformation g /\ homotopic_with (\x. T) (sphere (vec 0,&1),sphere (vec 0,&1)) f g ==> det(matrix f) = det(matrix g)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [REAL_EQ_SGN_ABS] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_LINEAR_MAPS_IMP THEN ASM_SIMP_TAC[HOMOTOPIC_WITH; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN EXISTS_TAC `\z. norm(sndcart z) % (h:real^(1,N)finite_sum->real^N) (pastecart (fstcart z) (inv(norm(sndcart z)) % sndcart z))` THEN ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_SIMP_TAC[LINEAR_CMUL; IN_UNIV; IN_DELETE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_LIFT_NORM_COMPOSE; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_LIFT_NORM_COMPOSE; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_DELETE; SNDCART_PASTECART; NORM_EQ_0]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN SIMP_TAC[IN_DELETE; IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_DELETE] THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN DISCH_THEN(fun th -> REPEAT GEN_TAC THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o rand o snd)) THEN ASM_SIMP_TAC[IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0] THEN CONV_TAC NORM_ARITH]; MATCH_MP_TAC(REAL_ARITH `(x = &1 \/ x = -- &1) /\ (y = &1 \/ y = -- &1) ==> abs x = abs y`) THEN CONJ_TAC THEN MATCH_MP_TAC DET_ORTHOGONAL_MATRIX THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MATRIX]]);; (* ------------------------------------------------------------------------- *) (* Hairy ball theorem and relatives. *) (* ------------------------------------------------------------------------- *) let FIXPOINT_HOMOTOPIC_IDENTITY_SPHERE = prove (`!f:real^N->real^N. ODD(dimindex(:N)) /\ homotopic_with (\x. T) (sphere(vec 0,&1),sphere(vec 0,&1)) (\x. x) f ==> ?x. x IN sphere(vec 0,&1) /\ f x = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `\x:real^N. --x`; `sphere(vec 0:real^N,&1)`; `&1`] HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[CONTINUOUS_ON_NEG; CONTINUOUS_ON_ID]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; NORM_NEG]; ASM_MESON_TAC[VECTOR_NEG_NEG]; DISCH_THEN(MP_TAC o SPEC `\x:real^N. x` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP))) THEN SIMP_TAC[ORTHOGONAL_TRANSFORMATION_NEG; ORTHOGONAL_TRANSFORMATION_ID; MATRIX_NEG; LINEAR_ID; DET_NEG; MATRIX_ID; DET_I] THEN ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE; GSYM NOT_ODD] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let FIXPOINT_OR_NEG_MAPPING_SPHERE = prove (`!f:real^N->real^N. ODD(dimindex(:N)) /\ f continuous_on sphere(vec 0,&1) /\ IMAGE f (sphere(vec 0,&1)) SUBSET sphere(vec 0,&1) ==> ?x. x IN sphere(vec 0,&1) /\ (f x = --x \/ f x = x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[LEFT_OR_DISTRIB; EXISTS_OR_THM] THEN MATCH_MP_TAC(TAUT `(~p ==> q) ==> p \/ q`) THEN DISCH_TAC THEN MATCH_MP_TAC FIXPOINT_HOMOTOPIC_IDENTITY_SPHERE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS THEN ASM_REWRITE_TAC[IMAGE_ID; SUBSET_REFL; CONTINUOUS_ON_ID] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; let HAIRY_BALL_THEOREM_ALT,HAIRY_BALL_THEOREM = (CONJ_PAIR o prove) (`(!r. (?f. f continuous_on sphere(vec 0:real^N,r) /\ (!x. x IN sphere(vec 0,r) ==> ~(f x = vec 0) /\ orthogonal x (f x))) <=> r <= &0 \/ EVEN(dimindex(:N))) /\ (!r. (?f. f continuous_on sphere(vec 0:real^N,r) /\ IMAGE f (sphere(vec 0,r)) SUBSET sphere(vec 0,r) /\ (!x. x IN sphere(vec 0,r) ==> ~(f x = vec 0) /\ orthogonal x (f x))) <=> r < &0 \/ &0 < r /\ EVEN(dimindex(:N)))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `r:real` THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_IN_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LT_REFL] THENL [SIMP_TAC[SPHERE_SING; FORALL_IN_INSERT; NOT_IN_EMPTY; SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[IN_SING]] THEN EXISTS_TAC `(\x. basis 1):real^N->real^N` THEN SIMP_TAC[CONTINUOUS_ON_CONST; ORTHOGONAL_0; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[GSYM REAL_NOT_LT]] THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> r) /\ (q <=> r)`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; REWRITE_TAC[GSYM NOT_ODD] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. inv(norm(f(r % x))) % (f:real^N->real^N) (r % x)` FIXPOINT_OR_NEG_MAPPING_SPHERE) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE; X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM(MP_TAC o SPEC `r % x:real^N`) THEN ASM_SIMP_TAC[NORM_MUL; real_abs; REAL_LT_IMP_LE; NORM_EQ_0; IN_SPHERE_0; REAL_MUL_RID]]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[GSYM SPHERE_SCALING; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; VECTOR_MUL_RZERO; REAL_MUL_RID]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_SIMP_TAC[NORM_MUL; real_abs; REAL_LT_IMP_LE; NORM_EQ_0; IN_SPHERE_0; REAL_MUL_RID]; REWRITE_TAC[IN_SPHERE_0; VECTOR_ARITH `a:real^N = --x <=> --a = x`] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `r % x:real^N`) THEN ASM_SIMP_TAC[NORM_MUL; real_abs; REAL_LT_IMP_LE; NORM_EQ_0; IN_SPHERE_0; REAL_MUL_RID] THEN ASM_SIMP_TAC[ORTHOGONAL_MUL; REAL_LT_IMP_NZ] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN REWRITE_TAC[ORTHOGONAL_MUL; ORTHOGONAL_LNEG; ORTHOGONAL_REFL; REAL_INV_EQ_0; NORM_EQ_0] THEN CONV_TAC TAUT]; REWRITE_TAC[EVEN_EXISTS] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `(\x. lambda i. if EVEN(i) then --(x$(i-1)) else x$(i+1)): real^N->real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA; REAL_NEG_ADD; GSYM REAL_MUL_RNEG] THEN MESON_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; GSYM DOT_EQ_0] THEN SIMP_TAC[orthogonal; dot; LAMBDA_BETA; NORM_EQ_SQUARE]] THEN SUBGOAL_THEN `1..dimindex(:N) = 2*0+1..(2 * (n - 1) + 1) + 1` SUBST1_TAC THENL [BINOP_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `m = 2 * n ==> 1 <= m ==> m = (2 * (n - 1) + 1) + 1`)) THEN REWRITE_TAC[DIMINDEX_GE_1]; REWRITE_TAC[SUM_OFFSET; SUM_PAIR]] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH; ADD_SUB] THEN REWRITE_TAC[REAL_ARITH `a + --x * --y:real = x * y + a`] THEN ASM_SIMP_TAC[REAL_POW_EQ_0; REAL_LT_IMP_NZ] THEN REWRITE_TAC[REAL_ARITH `x + y * --z = x - z * y`; REAL_SUB_REFL; SUM_0]]);; let CONTINUOUS_FUNCTION_HAS_EIGENVALUES_ODD_DIM = prove (`!f:real^N->real^N. ODD(dimindex(:N)) /\ f continuous_on sphere(vec 0:real^N,&1) ==> ?v c. v IN sphere(vec 0,&1) /\ f v = c % v`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!v. norm v = &1 ==> ~((f:real^N->real^N) v = vec 0)` THENL [ALL_TAC; ASM_MESON_TAC[VECTOR_MUL_LZERO; IN_SPHERE_0]] THEN MP_TAC(ISPEC `\x. inv(norm(f x)) % (f:real^N->real^N) x` FIXPOINT_OR_NEG_MAPPING_SPHERE) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; IN_SPHERE_0]; REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (norm((f:real^N->real^N) v)):real^N->real^N`)] THEN ASM_SIMP_TAC[VECTOR_MUL_LID; VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0; REAL_MUL_LINV] THEN ASM_MESON_TAC[VECTOR_MUL_RNEG; VECTOR_MUL_LNEG]);; let EULER_ROTATION_THEOREM_GEN = prove (`!A:real^N^N. ODD(dimindex(:N)) /\ rotation_matrix A ==> ?v. norm v = &1 /\ A ** v = v`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [rotation_matrix]) THEN ASM_CASES_TAC `!v:real^N. v IN sphere (vec 0,&1) ==> ~(A ** v = v)` THENL [ALL_TAC; ASM_MESON_TAC[IN_SPHERE_0]] THEN MP_TAC(ISPECL [`\x:real^N. (A:real^N^N) ** x`; `\x:real^N. --x`; `sphere(vec 0:real^N,&1)`; `&1`] HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS) THEN ASM_REWRITE_TAC[VECTOR_NEG_NEG] THEN ANTS_TAC THENL [SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_COMPOSE_NEG; LINEAR_ID; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; NORM_NEG] THEN MATCH_MP_TAC(MESON[ORTHOGONAL_TRANSFORMATION] `orthogonal_transformation(f:real^N->real^N) ==> !x. norm x = a ==> norm(f x) = a`) THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION]; DISCH_THEN(MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP))) THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_NEG; ORTHOGONAL_TRANSFORMATION_ID; GSYM ORTHOGONAL_MATRIX_TRANSFORMATION] THEN SIMP_TAC[MATRIX_NEG; LINEAR_ID; MATRIX_OF_MATRIX_VECTOR_MUL] THEN ASM_REWRITE_TAC[MATRIX_ID; DET_NEG; DET_I; REAL_POW_NEG; GSYM NOT_ODD] THEN REWRITE_TAC[REAL_POW_ONE] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; (* ------------------------------------------------------------------------- *) (* Retractions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("retract_of",(12,"right"));; let retraction = new_definition `retraction (s,t) (r:real^N->real^N) <=> t SUBSET s /\ r continuous_on s /\ (IMAGE r s SUBSET t) /\ (!x. x IN t ==> (r x = x))`;; let retract_of = new_definition `t retract_of s <=> ?r. retraction (s,t) r`;; let RETRACTION = prove (`!s t r. retraction (s,t) r <=> t SUBSET s /\ r continuous_on s /\ IMAGE r s = t /\ (!x. x IN t ==> r x = x)`, REWRITE_TAC[retraction] THEN SET_TAC[]);; let RETRACT_OF_IMP_EXTENSIBLE = prove (`!f:real^M->real^N u s t. s retract_of t /\ f continuous_on s /\ IMAGE f s SUBSET u ==> ?g. g continuous_on t /\ IMAGE g t SUBSET u /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[RETRACTION; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN EXISTS_TAC `(f:real^M->real^N) o (r:real^M->real^M)` THEN REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN ASM_MESON_TAC[]);; let RETRACTION_IDEMPOTENT = prove (`!r s t. retraction (s,t) r ==> !x. x IN s ==> (r(r(x)) = r(x))`, REWRITE_TAC[retraction; SUBSET; FORALL_IN_IMAGE] THEN MESON_TAC[]);; let IDEMPOTENT_IMP_RETRACTION = prove (`!f:real^N->real^N s. f continuous_on s /\ IMAGE f s SUBSET s /\ (!x. x IN s ==> f(f x) = f x) ==> retraction (s,IMAGE f s) f`, REWRITE_TAC[retraction] THEN SET_TAC[]);; let RETRACTION_SUBSET = prove (`!r s s' t. retraction (s,t) r /\ t SUBSET s' /\ s' SUBSET s ==> retraction (s',t) r`, SIMP_TAC[retraction] THEN MESON_TAC[IMAGE_SUBSET; SUBSET_TRANS; CONTINUOUS_ON_SUBSET]);; let RETRACT_OF_SUBSET = prove (`!s s' t. t retract_of s /\ t SUBSET s' /\ s' SUBSET s ==> t retract_of s'`, REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; LEFT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[RETRACTION_SUBSET]);; let RETRACT_OF_TRANSLATION = prove (`!a t s:real^N->bool. t retract_of s ==> (IMAGE (\x. a + x) t) retract_of (IMAGE (\x. a + x) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\x:real^N. a + x) o r o (\x:real^N. --a + x)` THEN ASM_SIMP_TAC[IMAGE_SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]) THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; IMAGE_ID]; REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM IMAGE_o] THEN ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; IMAGE_ID]; ASM_SIMP_TAC[o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`]]);; let RETRACT_OF_TRANSLATION_EQ = prove (`!a t s:real^N->bool. (IMAGE (\x. a + x) t) retract_of (IMAGE (\x. a + x) s) <=> t retract_of s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[RETRACT_OF_TRANSLATION] THEN DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP RETRACT_OF_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; add_translation_invariants [RETRACT_OF_TRANSLATION_EQ];; let RETRACT_OF_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) /\ t retract_of s ==> (IMAGE f t) retract_of (IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[retract_of; retraction] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) o r o (g:real^N->real^M)` THEN UNDISCH_THEN `!x y. (f:real^M->real^N) x = f y ==> x = y` (K ALL_TAC) THEN ASM_SIMP_TAC[IMAGE_SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID]; REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM IMAGE_o] THEN ASM_REWRITE_TAC[o_DEF; IMAGE_ID]; ASM_SIMP_TAC[o_DEF]]);; let RETRACT_OF_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> ((IMAGE f t) retract_of (IMAGE f s) <=> t retract_of s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[RETRACT_OF_INJECTIVE_LINEAR_IMAGE]] THEN FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN SUBGOAL_THEN `!s. s = IMAGE (h:real^N->real^M) (IMAGE (f:real^M->real^N) s)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC RETRACT_OF_INJECTIVE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; add_linear_invariants [RETRACT_OF_LINEAR_IMAGE_EQ];; let RETRACTION_REFL = prove (`!s. retraction (s,s) (\x. x)`, REWRITE_TAC[retraction; IMAGE_ID; SUBSET_REFL; CONTINUOUS_ON_ID]);; let RETRACT_OF_REFL = prove (`!s. s retract_of s`, REWRITE_TAC[retract_of] THEN MESON_TAC[RETRACTION_REFL]);; let RETRACTION_CLOSEST_POINT = prove (`!s t:real^N->bool. convex t /\ closed t /\ ~(t = {}) /\ t SUBSET s ==> retraction (s,t) (closest_point t)`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[retraction] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; CLOSEST_POINT_SELF; CLOSEST_POINT_IN_SET; CONTINUOUS_ON_CLOSEST_POINT]);; let RETRACT_OF_IMP_SUBSET = prove (`!s t. s retract_of t ==> s SUBSET t`, SIMP_TAC[retract_of; retraction] THEN MESON_TAC[]);; let RETRACT_OF_EMPTY = prove (`(!s:real^N->bool. {} retract_of s <=> s = {}) /\ (!s:real^N->bool. s retract_of {} <=> s = {})`, REWRITE_TAC[retract_of; retraction; SUBSET_EMPTY; IMAGE_CLAUSES] THEN CONJ_TAC THEN X_GEN_TAC `s:real^N->bool` THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_EQ_EMPTY; CONTINUOUS_ON_EMPTY; SUBSET_REFL]);; let RETRACT_OF_SING = prove (`!s x:real^N. {x} retract_of s <=> x IN s`, REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; RETRACTION] THEN EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `(\y. x):real^N->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);; let RETRACT_OF_OPEN_UNION = prove (`!s t:real^N->bool. open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t /\ DISJOINT s t /\ (s = {} ==> t = {}) ==> s retract_of (s UNION t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[RETRACT_OF_EMPTY; UNION_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN STRIP_TAC THEN REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `\x:real^N. if x IN s then x else a` THEN SIMP_TAC[SUBSET_UNION] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `\x:real^N. x`; EXISTS_TAC `(\x. a):real^N->real^N`] THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN ASM SET_TAC[]);; let RETRACT_OF_SEPARATED_UNION = prove (`!s t:real^N->bool. s INTER closure t = {} /\ t INTER closure s = {} /\ (s = {} ==> t = {}) ==> s retract_of (s UNION t)`, REWRITE_TAC[CONJ_ASSOC; SEPARATION_OPEN_IN_UNION] THEN MESON_TAC[RETRACT_OF_OPEN_UNION]);; let RETRACT_OF_CLOSED_UNION = prove (`!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ DISJOINT s t /\ (s = {} ==> t = {}) ==> s retract_of (s UNION t)`, ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (r /\ p /\ q) /\ s`] THEN REWRITE_TAC[GSYM SEPARATION_CLOSED_IN_UNION] THEN MESON_TAC[RETRACT_OF_SEPARATED_UNION]);; let RETRACTION_o = prove (`!f g s t u:real^N->bool. retraction (s,t) f /\ retraction (t,u) g ==> retraction (s,u) (g o f)`, REPEAT GEN_TAC THEN REWRITE_TAC[retraction] THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);; let RETRACT_OF_TRANS = prove (`!s t u:real^N->bool. s retract_of t /\ t retract_of u ==> s retract_of u`, REWRITE_TAC[retract_of] THEN MESON_TAC[RETRACTION_o]);; let CLOSED_IN_RETRACT = prove (`!s t:real^N->bool. s retract_of t ==> closed_in (subtopology euclidean t) s`, REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s = {x:real^N | x IN t /\ lift(norm(r x - x)) = vec 0}` SUBST1_TAC THENL [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP; NORM_EQ_0] THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_SIMP_TAC[CONTINUOUS_ON_ID]]);; let RETRACT_OF_CONTRACTIBLE = prove (`!s t:real^N->bool. contractible t /\ s retract_of t ==> contractible s`, REPEAT GEN_TAC THEN REWRITE_TAC[contractible; retract_of] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `r:real^N->real^N`)) THEN SIMP_TAC[HOMOTOPIC_WITH; PCROSS; LEFT_IMP_EXISTS_THM] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [retraction]) THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `h:real^(1,N)finite_sum->real^N`] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(r:real^N->real^N) a`; `(r:real^N->real^N) o (h:real^(1,N)finite_sum->real^N)`] THEN ASM_SIMP_TAC[o_THM; IMAGE_o; SUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let RETRACT_OF_COMPACT = prove (`!s t:real^N->bool. compact t /\ s retract_of t ==> compact s`, REWRITE_TAC[retract_of; RETRACTION] THEN MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);; let RETRACT_OF_CLOSED = prove (`!s t. closed t /\ s retract_of t ==> closed s`, MESON_TAC[CLOSED_IN_CLOSED_EQ; CLOSED_IN_RETRACT]);; let RETRACT_OF_CONNECTED = prove (`!s t:real^N->bool. connected t /\ s retract_of t ==> connected s`, REWRITE_TAC[retract_of; RETRACTION] THEN MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);; let RETRACT_OF_PATH_CONNECTED = prove (`!s t:real^N->bool. path_connected t /\ s retract_of t ==> path_connected s`, REWRITE_TAC[retract_of; RETRACTION] THEN MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);; let RETRACT_OF_SIMPLY_CONNECTED = prove (`!s t:real^N->bool. simply_connected t /\ s retract_of t ==> simply_connected s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[IMAGE_ID; CONTINUOUS_ON_ID]);; let RETRACT_OF_HOMOTOPICALLY_TRIVIAL = prove (`!s t:real^N->bool u:real^M->bool. t retract_of s /\ (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ g continuous_on u /\ IMAGE g u SUBSET s ==> homotopic_with (\x. T) (u,s) f g) ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ g continuous_on u /\ IMAGE g u SUBSET t ==> homotopic_with (\x. T) (u,t) f g)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ q /\ T /\ r /\ s /\ T`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; let RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL = prove (`!s t:real^N->bool u:real^M->bool. t retract_of s /\ (!f. f continuous_on u /\ IMAGE f u SUBSET s ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; let RETRACT_OF_COHOMOTOPICALLY_TRIVIAL = prove (`!s t:real^N->bool u:real^M->bool. t retract_of s /\ (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ g continuous_on s /\ IMAGE g s SUBSET u ==> homotopic_with (\x. T) (s,u) f g) ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ g continuous_on t /\ IMAGE g t SUBSET u ==> homotopic_with (\x. T) (t,u) f g)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ q /\ T /\ r /\ s /\ T`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; let RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL = prove (`!s t:real^N->bool u:real^M->bool. t retract_of s /\ (!f. f continuous_on s /\ IMAGE f s SUBSET u ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; let RETRACTION_IMP_QUOTIENT_MAP = prove (`!r s t:real^N->bool. retraction (s,t) r ==> !u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ r x IN u} <=> open_in (subtopology euclidean t) u)`, REPEAT GEN_TAC THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; SUBSET_REFL; IMAGE_ID]);; let RETRACT_OF_LOCALLY_CONNECTED = prove (`!s t:real^N->bool. s retract_of t /\ locally connected t ==> locally connected s`, REPEAT GEN_TAC THEN REWRITE_TAC[retract_of] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(SUBST1_TAC o SYM o el 2 o CONJUNCTS o GEN_REWRITE_RULE I [RETRACTION]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN MATCH_MP_TAC RETRACTION_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[RETRACTION]);; let RETRACT_OF_LOCALLY_PATH_CONNECTED = prove (`!s t:real^N->bool. s retract_of t /\ locally path_connected t ==> locally path_connected s`, REPEAT GEN_TAC THEN REWRITE_TAC[retract_of] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(SUBST1_TAC o SYM o el 2 o CONJUNCTS o GEN_REWRITE_RULE I [RETRACTION]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN MATCH_MP_TAC RETRACTION_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[RETRACTION]);; let RETRACT_OF_LOCALLY_COMPACT = prove (`!s t:real^N->bool. locally compact s /\ t retract_of s ==> locally compact t`, MESON_TAC[CLOSED_IN_RETRACT; LOCALLY_COMPACT_CLOSED_IN]);; let RETRACT_OF_PCROSS = prove (`!s:real^M->bool s' t:real^N->bool t'. s retract_of s' /\ t retract_of t' ==> (s PCROSS t) retract_of (s' PCROSS t')`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN REWRITE_TAC[retract_of; retraction; SUBSET; FORALL_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:real^M->real^M` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\z. pastecart ((f:real^M->real^M) (fstcart z)) ((g:real^N->real^N) (sndcart z))` THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);; let RETRACT_OF_PCROSS_EQ = prove (`!s s':real^M->bool t t':real^N->bool. s PCROSS t retract_of s' PCROSS t' <=> (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/ s retract_of s' /\ t retract_of t'`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^M->bool = {}`; `s':real^M->bool = {}`; `t:real^N->bool = {}`; `t':real^N->bool = {}`] THEN ASM_REWRITE_TAC[PCROSS_EMPTY; RETRACT_OF_EMPTY; PCROSS_EQ_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[RETRACT_OF_PCROSS] THEN REWRITE_TAC[retract_of; retraction; SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^(M,N)finite_sum->real^(M,N)finite_sum` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [SUBGOAL_THEN `?b:real^N. b IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `\x. fstcart((r:real^(M,N)finite_sum->real^(M,N)finite_sum) (pastecart x b))` THEN ASM_SIMP_TAC[FSTCART_PASTECART] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS; MEMBER_NOT_EMPTY]]; SUBGOAL_THEN `?a:real^M. a IN s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `\x. sndcart((r:real^(M,N)finite_sum->real^(M,N)finite_sum) (pastecart a x))` THEN ASM_SIMP_TAC[SNDCART_PASTECART] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS; MEMBER_NOT_EMPTY]]]);; let HOMOTOPIC_INTO_RETRACT = prove (`!f:real^M->real^N g s t u. IMAGE f s SUBSET t /\ IMAGE g s SUBSET t /\ t retract_of u /\ homotopic_with (\x. T) (s,u) f g ==> homotopic_with (\x. T) (s,t) f g`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^(1,M)finite_sum->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN EXISTS_TAC `(r:real^N->real^N) o (h:real^(1,M)finite_sum->real^N)` THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Brouwer fixed-point theorem and related results. *) (* ------------------------------------------------------------------------- *) let CONTRACTIBLE_SPHERE = prove (`!a:real^N r. contractible(sphere(a,r)) <=> r <= &0`, GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; CONTRACTIBLE_EMPTY; REAL_LT_IMP_LE] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` (SUBST1_TAC o SYM) o MATCH_MP VECTOR_CHOOSE_SIZE) THEN REWRITE_TAC[NORM_ARITH `norm(b:real^N) <= &0 <=> b = vec 0`] THEN GEOM_NORMALIZE_TAC `b:real^N` THEN SIMP_TAC[NORM_0; SPHERE_SING; CONTRACTIBLE_SING] THEN X_GEN_TAC `b:real^N` THEN ASM_CASES_TAC `b:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_THEN(K ALL_TAC) THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(MP_TAC o ISPEC `I:real^N->real^N` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HOMOTOPIC_INTO_CONTRACTIBLE))) THEN DISCH_THEN(MP_TAC o SPECL [`reflect_along (basis 1:real^N)`; `sphere(vec 0:real^N,&1)`]) THEN REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; I_DEF; NOT_IMP] THEN SIMP_TAC[SUBSET_REFL; LINEAR_CONTINUOUS_ON; LINEAR_REFLECT_ALONG; ORTHOGONAL_TRANSFORMATION_SPHERE; ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP))) THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG; ORTHOGONAL_TRANSFORMATION_ID] THEN REWRITE_TAC[DET_MATRIX_REFLECT_ALONG; MATRIX_ID; DET_I] THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let NO_RETRACTION_CBALL = prove (`!a:real^N e. &0 < e ==> ~(sphere(a,e) retract_of cball(a,e))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] RETRACT_OF_CONTRACTIBLE)) THEN SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_CBALL; CONTRACTIBLE_SPHERE] THEN ASM_REWRITE_TAC[REAL_NOT_LE]);; let BROUWER_BALL = prove (`!f:real^N->real^N a e. &0 < e /\ f continuous_on cball(a,e) /\ IMAGE f (cball(a,e)) SUBSET cball(a,e) ==> ?x. x IN cball(a,e) /\ f x = x`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x) <=> ~(!x. P x ==> ~Q x)`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN REWRITE_TAC[retract_of; retraction; SPHERE_SUBSET_CBALL] THEN ABBREV_TAC `s = \x:real^N. &4 * ((a - x:real^N) dot (f x - x)) pow 2 + &4 * (e pow 2 - norm(a - x) pow 2) * norm(f x - x) pow 2` THEN SUBGOAL_THEN `!x:real^N. x IN cball(a,e) ==> &0 <= s x` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_CBALL; dist] THEN DISCH_TAC THEN EXPAND_TAC "s" THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS; REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN EXISTS_TAC `\x:real^N. x + (&2 * ((a - x) dot (f x - x)) - sqrt(s x)) / (&2 * ((f x - x) dot (f x - x))) % (f x - x)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; o_DEF] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_LIFT_DOT2] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_SQRT_COMPOSE THEN ASM_REWRITE_TAC[o_DEF] THEN EXPAND_TAC "s" THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_SUB; NORM_POW_2; REAL_POW_2] THEN REPEAT((MATCH_MP_TAC CONTINUOUS_ON_ADD ORELSE MATCH_MP_TAC CONTINUOUS_ON_SUB ORELSE MATCH_MP_TAC CONTINUOUS_ON_MUL) THEN CONJ_TAC THEN REWRITE_TAC[o_DEF; LIFT_SUB]); MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[REAL_ENTIRE; DOT_EQ_0; VECTOR_SUB_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_CMUL]] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_LIFT_DOT2]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_SPHERE; IN_CBALL; dist; NORM_EQ_SQUARE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[VECTOR_ARITH `a - (x + y):real^N = (a - x) - y`] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x - y:real^N) dot (x - y) = (x dot x + y dot y) - &2 * x dot y`] THEN REWRITE_TAC[DOT_LMUL] THEN REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[REAL_RING `(a + u * u * b) - &2 * u * c = d <=> b * u pow 2 - (&2 * c) * u + (a - d) = &0`] THEN SUBGOAL_THEN `sqrt(s(x:real^N)) pow 2 = s x` MP_TAC THENL [ASM_SIMP_TAC[SQRT_POW_2; IN_CBALL; dist]; ALL_TAC] THEN MATCH_MP_TAC(REAL_FIELD `~(a = &0) /\ e = b pow 2 - &4 * a * c /\ x = (b - s) / (&2 * a) ==> s pow 2 = e ==> a * x pow 2 - b * x + c = &0`) THEN ASM_SIMP_TAC[DOT_EQ_0; VECTOR_SUB_EQ; IN_CBALL; dist] THEN EXPAND_TAC "s" THEN REWRITE_TAC[NORM_POW_2] THEN REAL_ARITH_TAC; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_SPHERE; dist] THEN DISCH_TAC THEN EXPAND_TAC "s" THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[VECTOR_ARITH `x + a:real^N = x <=> a = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0] THEN REPEAT DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `&2 * a - s = &0 <=> s = &2 * a`] THEN MATCH_MP_TAC SQRT_UNIQUE THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `&0 <= &2 * x <=> &0 <= x`] THEN REWRITE_TAC[DOT_NORM_SUB; REAL_ARITH `&0 <= x / &2 <=> &0 <= x`] THEN REWRITE_TAC[VECTOR_ARITH `a - x - (y - x):real^N = a - y`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= b /\ x <= a ==> &0 <= (a + b) - x`) THEN REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2 THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL; FORALL_IN_IMAGE; NORM_POS_LE] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[dist] THEN CONV_TAC NORM_ARITH]);; let BROUWER = prove (`!f:real^N->real^N s. compact s /\ convex s /\ ~(s = {}) /\ f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ f x = x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?e. &0 < e /\ s SUBSET cball(vec 0:real^N,e)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_CBALL; NORM_ARITH `dist(vec 0,x) = norm(x)`] THEN ASM_MESON_TAC[BOUNDED_POS; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN SUBGOAL_THEN `?x:real^N. x IN cball(vec 0,e) /\ (f o closest_point s) x = x` MP_TAC THENL [MATCH_MP_TAC BROUWER_BALL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; COMPACT_IMP_CLOSED] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET])) THEN REWRITE_TAC[o_THM; IN_IMAGE] THEN EXISTS_TAC `closest_point s x:real^N` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSEST_POINT_IN_SET]] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSEST_POINT_IN_SET]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_MESON_TAC[CLOSEST_POINT_SELF; CLOSEST_POINT_IN_SET; COMPACT_IMP_CLOSED]]);; let BROUWER_WEAK = prove (`!f:real^N->real^N s. compact s /\ convex s /\ ~(interior s = {}) /\ f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ f x = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER THEN ASM_MESON_TAC[INTERIOR_EMPTY]);; let BROUWER_CUBE = prove (`!f:real^N->real^N. f continuous_on (interval [vec 0,vec 1]) /\ IMAGE f (interval [vec 0,vec 1]) SUBSET (interval [vec 0,vec 1]) ==> ?x. x IN interval[vec 0,vec 1] /\ f x = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER THEN ASM_REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; UNIT_INTERVAL_NONEMPTY]);; (* ------------------------------------------------------------------------- *) (* Now we can finally deduce what the topological dimension of R^n is. *) (* Proof following Hurewicz & Wallman's "dimension theory". *) (* ------------------------------------------------------------------------- *) let DIMENSION_EQ_AFF_DIM = prove (`!s:real^N->bool. convex s ==> dimension s = aff_dim s`, REPEAT STRIP_TAC THEN SIMP_TAC[GSYM INT_LE_ANTISYM; DIMENSION_LE_AFF_DIM] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIMENSION_EMPTY; AFF_DIM_EMPTY; INT_LE_REFL] THEN ASM_CASES_TAC `aff_dim(s:real^N->bool) = &0` THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFF_DIM_EQ_0]) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; DIMENSION_SING; INT_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= aff_dim(s:real^N->bool) /\ &1 <= aff_dim s` MP_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_GE) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM AFF_DIM_EQ_MINUS1]) THEN ASM_INT_ARITH_TAC; POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)] THEN ABBREV_TAC `nn = aff_dim(s:real^N->bool)` THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[TAUT `d ==> p ==> q /\ r ==> s <=> q ==> d /\ p /\ r ==> s`] THEN SPEC_TAC(`nn:int`,`nn:int`) THEN REWRITE_TAC[GSYM INT_FORALL_POS; INT_OF_NUM_EQ; INT_OF_NUM_LE] THEN REPEAT STRIP_TAC THEN TRANS_TAC INT_LE_TRANS `dimension(relative_interior s:real^N->bool)` THEN ASM_SIMP_TAC[DIMENSION_SUBSET; RELATIVE_INTERIOR_SUBSET] THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_IN_RELATIVE_INTERIOR) THEN FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_RELATIVE_INTERIOR) THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP AFFINE_HULL_RELATIVE_INTERIOR) THEN FIRST_ASSUM(MP_TAC o MATCH_MP RELATIVE_INTERIOR_EQ_EMPTY) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVEX_RELATIVE_INTERIOR) THEN UNDISCH_TAC `1 <= n` THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`relative_interior s:real^N->bool`,`t:real^N->bool`) THEN X_GEN_TAC `u:real^N->bool` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`u:real^N->bool`; `span(IMAGE basis (1..n)):real^N->bool`] HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS) THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; AFF_DIM_DIM_0; HULL_INC; SPAN_0] THEN ASM_REWRITE_TAC[SPAN_SPAN; OPEN_IN_REFL; CONVEX_SPAN] THEN MP_TAC(ISPEC `u:real^N->bool` AFF_DIM_LE_UNIV) THEN ASM_REWRITE_TAC[DIM_SPAN; INT_OF_NUM_EQ; INT_OF_NUM_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `dim(IMAGE basis (1..n):real^N->bool) = n` ASSUME_TAC THENL [REWRITE_TAC[DIM_BASIS_IMAGE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG] THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_DIMENSION)] THEN ABBREV_TAC `box = {x:real^N | (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i /\ x$i <= &1) /\ (!i. n < i /\ i <= dimindex(:N) ==> x$i = &0)}` THEN TRANS_TAC INT_LE_TRANS `dimension(box:real^N->bool)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC DIMENSION_SUBSET THEN EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_SPAN_IMAGE_BASIS; IN_NUMSEG; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o check (free_in `box:real^N->bool` o concl)) THEN MAP_EVERY UNDISCH_TAC [`n <= dimindex(:N)`; `1 <= n`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INT_ARITH `n:int <= d <=> ~(d <= n - &1)`] THEN DISCH_TAC THEN SUBGOAL_THEN `~(box:real^N->bool = {}) /\ convex(box:real^N->bool) /\ compact box` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [EXPAND_TAC "box" THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[VEC_COMPONENT; REAL_POS]; ALL_TAC] THEN SUBGOAL_THEN `box = interval[vec 0:real^N,vec 1] INTER span(IMAGE basis (1..n))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_SPAN_IMAGE_BASIS; IN_INTERVAL] THEN EXPAND_TAC "box" THEN REWRITE_TAC[IN_ELIM_THM; VEC_COMPONENT] THEN GEN_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN EQ_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; SIMP_TAC[CONVEX_INTER; CONVEX_INTERVAL; CONVEX_SPAN] THEN SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_INTERVAL; CLOSED_SPAN]]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`l = \i. box INTER {x:real^N | x$i = &0}`; `r = \i. box INTER {x:real^N | x$i = &1}`] THEN SUBGOAL_THEN `(!i:num. 1 <= i /\ i <= n ==> ~(l i:real^N->bool = {})) /\ (!i:num. 1 <= i /\ i <= n ==> ~(r i:real^N->bool = {}))` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["l"; "r"; "box"] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM; GSYM MEMBER_NOT_EMPTY] THEN CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THENL [EXISTS_TAC `vec 0:real^N`; EXISTS_TAC `(lambda j. if j = i then &1 else &0):real^N`] THEN SIMP_TAC[VEC_COMPONENT; REAL_POS; LAMBDA_BETA] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MESON_TAC[REAL_POS; REAL_LE_REFL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) LAMBDA_BETA o lhand o snd) THEN (ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST_ALL_TAC]) THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?b:num->real^N->bool. (!i. closed_in (subtopology euclidean box) (b i)) /\ (!i. 1 <= i /\ i <= n ==> dimension(box INTER INTERS (IMAGE b (1..i))) <= &n - &i - &1 /\ ?u v. open_in (subtopology euclidean box) u /\ open_in (subtopology euclidean box) v /\ DISJOINT u v /\ u UNION v = box DIFF b i /\ l i SUBSET u /\ r i SUBSET v)` MP_TAC THENL [SIMP_TAC[GSYM NUMSEG_RREC] THEN REWRITE_TAC[IMAGE_CLAUSES; INTERS_INSERT] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC(MATCH_MP WF_REC_EXISTS WF_num) THEN CONJ_TAC THENL [SIMP_TAC[numseg; ARITH_RULE `1 <= i ==> (x <= i - 1 <=> x < i)`] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`b:num->real^N->bool`; `i:num`] THEN DISCH_TAC THEN ASM_CASES_TAC `1 <= i /\ i <= n` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[CLOSED_IN_REFL]] THEN ONCE_REWRITE_TAC[SET_RULE `b INTER s INTER t = s INTER b INTER t`] THEN MATCH_MP_TAC DIMENSION_SEPARATION_THEOREM THEN ASM_REWRITE_TAC[INT_SUB_LE; INT_OF_NUM_LE; INTER_SUBSET] THEN CONJ_TAC THENL [ASM_CASES_TAC `i = 1` THENL [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; INTERS_0; INTER_UNIV]; FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT1)] THEN ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; INT_ARITH `n - (i - w) - w:int = n - i`] THEN ASM_SIMP_TAC[GSYM NUMSEG_RREC; ARITH_RULE `1 <= i /\ ~(i = 1) ==> 1 <= i - 1`] THEN REWRITE_TAC[IMAGE_CLAUSES; INTERS_INSERT; INTER_ACI]]; MAP_EVERY EXPAND_TAC ["l"; "r"] THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_STANDARD_HYPERPLANE] THEN MATCH_MP_TAC(SET_RULE `(!x. P x /\ Q x ==> F) ==> DISJOINT (b INTER {x | P x}) (b INTER {x | Q x})`) THEN REAL_ARITH_TAC]; REWRITE_TAC[RIGHT_AND_EXISTS_THM; SKOLEM_THM; RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`b:num->real^N->bool`; `u:num->real^N->bool`; `v:num->real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `n:num`) STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[LE_REFL; INT_ARITH `n - n - w:int = --w`] THEN REWRITE_TAC[DIMENSION_LE_MINUS1] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ ~(t = {}) ==> ~(s INTER t = {})`) THEN CONJ_TAC THENL [MATCH_MP_TAC INTERS_SUBSET THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; DISCH_TAC] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= n ==> ~(b i:real^N->bool = {})` ASSUME_TAC THENL [X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVEX_CONNECTED) THEN REWRITE_TAC[CONNECTED_OPEN_IN] THEN MAP_EVERY EXISTS_TAC [`(u:num->real^N->bool) i`; `(v:num->real^N->bool) i`] THEN ASM_SIMP_TAC[GSYM DISJOINT; DIFF_EMPTY; SUBSET_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `(f:real^N->real^N) = \x. x + lambda i. if n < i then &0 else if x IN v i then --setdist({x},b i) else setdist({x},b i)` THEN MP_TAC(ISPECL [`f:real^N->real^N`; `box:real^N->bool`] BROUWER) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN EXPAND_TAC "f" THEN SIMP_TAC[VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[LIFT_ADD] THEN REWRITE_TAC[GSYM NOT_LE] THEN ASM_CASES_TAC `m:num <= n` THEN ASM_SIMP_TAC[LIFT_NUM; VECTOR_ADD_RID; CONTINUOUS_ON_LIFT_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN REWRITE_TAC[COND_RAND] THEN SUBGOAL_THEN `box = (box DIFF (u:num->real^N->bool) m) UNION (box DIFF v m)` (fun th -> SUBST1_TAC th THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN SUBST1_TAC(SYM th)) THENL [ASM SET_TAC[]; ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]] THEN SIMP_TAC[LIFT_NEG; CONTINUOUS_ON_NEG; CONTINUOUS_ON_LIFT_SETDIST] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x IN (b:num->real^N->bool) m` THENL [ASM_SIMP_TAC[SETDIST_SING_IN_SET]; ASM SET_TAC[]] THEN REWRITE_TAC[LIFT_NUM; VECTOR_NEG_0; VECTOR_MUL_RZERO]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN EXPAND_TAC "box" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXPAND_TAC "f" THEN SUBGOAL_THEN `!i. n < i ==> 1 <= i` MP_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT]] THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN X_GEN_TAC `m:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN STRIP_TAC THEN ASM_CASES_TAC `x IN (b:num->real^N->bool) m` THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[COND_ID; REAL_ADD_RID] THEN SUBGOAL_THEN `x IN (u:num->real^N->bool) m /\ ~(x IN v m) \/ x IN v m /\ ~(x IN u m)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN (MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[SETDIST_POS_LE; REAL_LE_ADD; REAL_ARITH `x <= &1 /\ &0 <= y ==> x + --y <= &1`]; DISCH_TAC]) THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL [ABBREV_TAC `y:real^N = lambda i. if i = m then &1 else (x:real^N)$i` THEN SUBGOAL_THEN `y IN (r:num->real^N->bool) m` ASSUME_TAC THENL [UNDISCH_TAC `(x:real^N) IN box` THEN MAP_EVERY EXPAND_TAC ["y"; "r"; "box"] THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN SUBGOAL_THEN `!i. n < i ==> 1 <= i` MP_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_REFL] THEN ASM_ARITH_TAC; ALL_TAC]; ABBREV_TAC `y:real^N = lambda i. if i = m then &0 else (x:real^N)$i` THEN SUBGOAL_THEN `y IN (l:num->real^N->bool) m` ASSUME_TAC THENL [UNDISCH_TAC `(x:real^N) IN box` THEN MAP_EVERY EXPAND_TAC ["y"; "l"; "box"] THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN SUBGOAL_THEN `!i. n < i ==> 1 <= i` MP_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_REFL] THEN ASM_ARITH_TAC; ALL_TAC]] THEN (SUBGOAL_THEN `segment[x:real^N,y] SUBSET box` ASSUME_TAC THENL [MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`x:real^N`; `y:real^N`] (CONJUNCT1 CONNECTED_SEGMENT)) THEN REWRITE_TAC[CONNECTED_OPEN_IN] THEN MAP_EVERY EXISTS_TAC [`segment[x,y] INTER (u:num->real^N->bool) m`; `segment[x,y] INTER (v:num->real^N->bool) m`] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `box:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL]; ASM_SIMP_TAC[GSYM UNION_OVER_INTER]] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUBSET_INTER; SUBSET_REFL; SET_RULE `s SUBSET t DIFF u <=> s SUBSET t /\ !x y. x IN s ==> ~(x IN u)`]; MP_TAC(ISPECL [`x:real^N`; `y:real^N`] ENDS_IN_SEGMENT) THEN ASM SET_TAC[]] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `z:real^N = x` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `z:real^N = y` THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `z IN segment(x:real^N,y)` MP_TAC THENL [REWRITE_TAC[open_segment] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o CONJUNCT1 o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `setdist(b(m:num),{x:real^N})` THEN ASM_SIMP_TAC[SETDIST_LE_DIST; IN_SING] THEN EXPAND_TAC "y" THEN ONCE_REWRITE_TAC[SETDIST_SYM]) THENL [TRANS_TAC REAL_LE_TRANS `&1 - (x:real^N)$m`; TRANS_TAC REAL_LE_TRANS `(x:real^N)$m`] THEN (CONJ_TAC THENL [EXPAND_TAC "y"; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[dist] THEN REWRITE_TAC[NORM_EQ_SQUARE] THEN SIMP_TAC[dot; LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[COND_RAND] THEN SIMP_TAC[REAL_SUB_REFL; SUM_DELTA; REAL_MUL_LZERO] THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN SUBGOAL_THEN `(x:real^N) IN box` MP_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "box"] THEN REWRITE_TAC[IN_ELIM_THM; REAL_SUB_LE] THEN ASM_MESON_TAC[]); DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN EXPAND_TAC "f" THEN SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [INTERS_IMAGE]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN REWRITE_TAC[IN_NUMSEG; CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM NOT_LE; REAL_ARITH `a + (if p then --x else x) = a <=> x = &0`] THEN ASM_MESON_TAC[SETDIST_EQ_0_CLOSED_IN]]);; let AFF_DIM_DIMENSION = prove (`!s:real^N->bool. aff_dim s = dimension(affine hull s)`, SIMP_TAC[DIMENSION_EQ_AFF_DIM; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL]);; let AFF_DIM_DIMENSION_ALT = prove (`!s:real^N->bool. aff_dim s = dimension(convex hull s)`, SIMP_TAC[DIMENSION_EQ_AFF_DIM; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL]);; let DIMENSION_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> dimension s = &(dim s)`, SIMP_TAC[DIMENSION_EQ_AFF_DIM; SUBSPACE_IMP_CONVEX; AFF_DIM_DIM_SUBSPACE]);; let DIM_DIMENSION = prove (`!s:real^N->bool. &(dim s) = dimension(span s)`, SIMP_TAC[DIMENSION_SUBSPACE; DIM_SPAN; SUBSPACE_SPAN]);; let DIMENSION_OPEN_IN_CONVEX = prove (`!u s:real^N->bool. convex u /\ open_in (subtopology euclidean u) s ==> dimension s = if s = {} then -- &1 else aff_dim u`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM DIMENSION_EQ_AFF_DIM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIMENSION_SUBSET; OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`] OPEN_IN_CONVEX_MEETS_RELATIVE_INTERIOR) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN TRANS_TAC INT_LE_TRANS `dimension(affine hull u INTER ball(a:real^N,min d e))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[DIMENSION_EQ_AFF_DIM; CONVEX_INTER; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_BALL] THEN MATCH_MP_TAC INT_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX; OPEN_BALL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `a:real^N` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_MIN; HULL_INC]; MATCH_MP_TAC DIMENSION_SUBSET THEN REWRITE_TAC[BALL_MIN_INTER] THEN ASM SET_TAC[]]);; let DIMENSION_OPEN = prove (`!s:real^N->bool. open s ==> dimension s = if s = {} then -- &1 else &(dimindex(:N))`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM AFF_DIM_UNIV] THEN MATCH_MP_TAC DIMENSION_OPEN_IN_CONVEX THEN ASM_REWRITE_TAC[CONVEX_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN]);; let DIMENSION_UNIV = prove (`dimension(:real^N) = &(dimindex(:N))`, SIMP_TAC[DIMENSION_OPEN; OPEN_UNIV; UNIV_NOT_EMPTY]);; let DIMENSION_NONEMPTY_INTERIOR = prove (`!s:real^N->bool. ~(interior s = {}) ==> dimension s = &(dimindex(:N))`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN SIMP_TAC[GSYM DIMENSION_UNIV; DIMENSION_SUBSET; SUBSET_UNIV] THEN TRANS_TAC INT_LE_TRANS `dimension(interior(s:real^N->bool))` THEN SIMP_TAC[DIMENSION_SUBSET; INTERIOR_SUBSET] THEN ASM_SIMP_TAC[INT_LE_REFL; DIMENSION_OPEN; OPEN_INTERIOR; DIMENSION_UNIV]);; let DIMENSION_ATMOST_RATIONAL_COORDINATES = prove (`!n. n <= dimindex(:N) ==> dimension {x:real^N | CARD {i | i IN 1..dimindex(:N) /\ rational(x$i)} <= n} = &n`, REWRITE_TAC[GSYM INT_LE_ANTISYM; FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN CONJ_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[LE; LE_0] THEN CONJ_TAC THENL [MP_TAC(SPEC `0` DIMENSION_LE_RATIONAL_COORDINATES) THEN ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; FINITE_NUMSEG; CONJUNCT1 LE]; X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN REWRITE_TAC[LE; SET_RULE `{x | Q x \/ R x} = {x | Q x} UNION {x | R x}`] THEN W(MP_TAC o PART_MATCH lhand DIMENSION_UNION_LE_BASIC o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS) THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN MATCH_MP_TAC(INT_ARITH `x:int <= &0 /\ y <= n ==> x + y + &1 <= n + &1`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `SUC n` DIMENSION_LE_RATIONAL_COORDINATES) THEN ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; FINITE_NUMSEG]]; X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `n = dimindex(:N) - (dimindex(:N) - n)` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(ARITH_RULE `dimindex(:N) - n <= dimindex(:N)`) THEN POP_ASSUM(K ALL_TAC) THEN SPEC_TAC(`dimindex(:N) - n`,`n:num`) THEN SIMP_TAC[GSYM INT_OF_NUM_SUB] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[LE; LE_0] THEN CONJ_TAC THENL [REWRITE_TAC[INT_SUB_RZERO; SUB_0] THEN GEN_REWRITE_TAC LAND_CONV [GSYM DIMENSION_UNIV] THEN MATCH_MP_TAC INT_EQ_IMP_LE THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC CARD_SUBSET THEN SIMP_TAC[FINITE_RESTRICT; SUBSET_RESTRICT; FINITE_NUMSEG]; X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM INT_NOT_LT; CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= N ==> (a <= N - n <=> a = N - n \/ a <= N - SUC n)`] THEN REWRITE_TAC[LE; SET_RULE `{x | Q x \/ R x} = {x | Q x} UNION {x | R x}`] THEN W(MP_TAC o PART_MATCH lhand DIMENSION_UNION_LE_BASIC o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LET_TRANS) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `d2:int < n2 ==> d1 < N - n2 ==> d1 + d2 + &1 < N`)) THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `x:int < N - n - (N - (n + &1)) <=> x <= &0`] THEN MP_TAC(SPEC `dimindex(:N) - n` DIMENSION_LE_RATIONAL_COORDINATES) THEN SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; FINITE_NUMSEG; LE]]]);; let DIMENSION_COMPLEMENT_RATIONAL_COORDINATES = prove (`dimension((:real^N) DIFF { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) = &(dimindex(:N)) - &1`, MP_TAC(SPEC `dimindex(:N) - 1` DIMENSION_ATMOST_RATIONAL_COORDINATES) THEN REWRITE_TAC[ARITH_RULE `n - 1 <= n`] THEN SIMP_TAC[GSYM INT_OF_NUM_SUB; DIMINDEX_GE_1] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN REWRITE_TAC[GSYM IN_NUMSEG; SET_RULE `(!x. P x ==> Q x) <=> {x | P x /\ Q x} = {x | P x}`] THEN SIMP_TAC[GSYM SUBSET_CARD_EQ; FINITE_RESTRICT; FINITE_NUMSEG; CARD_NUMSEG_1; SUBSET_RESTRICT; SET_RULE `{x | x IN s} = s`] THEN MATCH_MP_TAC(ARITH_RULE `1 <= N /\ n <= N ==> (~(n = N) <=> n <= N - 1)`) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[SUBSET_RESTRICT; FINITE_NUMSEG]);; let DIMENSION_EQ_FULL_GEN = prove (`!s:real^N->bool. dimension s = aff_dim s <=> s = {} \/ ~(relative_interior s = {})`, let lemma1 = prove (`closure(span(IMAGE basis (1..n)) INTER {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) = span(IMAGE basis (1..n))`, MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[CLOSURE_MINIMAL; CLOSED_SPAN; INTER_SUBSET] THEN REWRITE_TAC[SUBSET; IN_SPAN_IMAGE_BASIS] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(SET_RULE `x IN (:real^N)`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM CLOSURE_RATIONAL_COORDINATES] THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_SPAN_IMAGE_BASIS] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(lambda i. if i IN 1..n then (y:real^N)$i else &0):real^N` THEN SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THENL [ASM_MESON_TAC[RATIONAL_NUM]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `dist(y:real^N,x)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN X_GEN_TAC `i:num` THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN REAL_ARITH_TAC) and lemma2 = prove (`!n. n <= dimindex(:N) ==> dimension(span(IMAGE basis (1..n)) DIFF {x:real^N | !i. i IN 1..dimindex(:N) ==> rational(x$i)}) < &n`, REPEAT STRIP_TAC THEN TRANS_TAC INT_LET_TRANS `dimension(UNIONS {{x:real^N | {i | i IN 1..dimindex (:N) /\ rational (x$i)} HAS_SIZE m} | m IN (dimindex(:N)-n)..dimindex(:N)-1})` THEN CONJ_TAC THENL [MATCH_MP_TAC DIMENSION_SUBSET THEN REWRITE_TAC[UNIONS_GSPEC; SUBSET] THEN SIMP_TAC[HAS_SIZE; FINITE_NUMSEG; FINITE_RESTRICT] THEN REWRITE_TAC[IN_SPAN_IMAGE_BASIS; IN_DIFF; IN_ELIM_THM; IN_NUMSEG] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1] THEN CONJ_TAC THENL [TRANS_TAC LE_TRANS `CARD(n+1..dimindex(:N))` THEN CONJ_TAC THENL [REWRITE_TAC[CARD_NUMSEG] THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CARD_SUBSET THEN SIMP_TAC[GSYM IN_NUMSEG; FINITE_RESTRICT; FINITE_NUMSEG] THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[RATIONAL_NUM] THEN ASM_ARITH_TAC; MATCH_MP_TAC(ARITH_RULE `c < n ==> c <= n - 1`) THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC CARD_PSUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN REWRITE_TAC[numseg] THEN ASM SET_TAC[]]; W(MP_TAC o PART_MATCH (lhand o rand) DIMENSION_LE_UNIONS_ZERODIMENSIONAL o lhand o snd) THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[FORALL_IN_IMAGE; DIMENSION_LE_RATIONAL_COORDINATES] THEN MATCH_MP_TAC(INT_ARITH `c:int <= n ==> d <= c - &1 ==> d < n`) THEN REWRITE_TAC[INT_OF_NUM_LE] THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN REWRITE_TAC[CARD_NUMSEG] THEN MATCH_MP_TAC(ARITH_RULE `1 <= N /\ n <= N ==> (N - 1 + 1) - (N - n) <= n`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1]]) in GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIMENSION_EMPTY; AFF_DIM_EMPTY] THEN EQ_TAC THEN DISCH_TAC THENL [DISCH_TAC; MP_TAC(ISPECL [`affine hull s:real^N->bool`; `relative_interior s:real^N->bool`] DIMENSION_OPEN_IN_CONVEX) THEN ASM_REWRITE_TAC[AFF_DIM_AFFINE_HULL; OPEN_IN_RELATIVE_INTERIOR] THEN SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC(INT_ARITH `i:int <= s /\ s <= u ==> i = u ==> s = u`) THEN REWRITE_TAC[DIMENSION_LE_AFF_DIM] THEN SIMP_TAC[DIMENSION_SUBSET; RELATIVE_INTERIOR_SUBSET]] THEN MP_TAC(ISPEC `affine hull s DIFF s:real^N->bool` SEPARABLE) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `closure c:real^N->bool = affine hull s` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_AFFINE_HULL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [RELATIVE_INTERIOR_INTERIOR_OF]) THEN REWRITE_TAC[INTERIOR_OF_CLOSURE_OF; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s DIFF t = {} ==> s SUBSET u`) THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET u`) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CLOSURE] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `affine hull c:real^N->bool = affine hull s` ASSUME_TAC THENL [ASM_MESON_TAC[HULL_HULL; AFFINE_HULL_CLOSURE]; ALL_TAC] THEN SUBGOAL_THEN `aff_dim c <= dimension(affine hull c DIFF c:real^N->bool)` MP_TAC THENL [TRANS_TAC INT_LE_TRANS `dimension(s:real^N->bool)` THEN CONJ_TAC THENL [ASM_MESON_TAC[INT_LE_REFL; AFF_DIM_AFFINE_HULL]; MATCH_MP_TAC DIMENSION_SUBSET THEN SUBGOAL_THEN `(s:real^N->bool) SUBSET affine hull s` MP_TAC THENL [REWRITE_TAC[HULL_SUBSET]; ASM SET_TAC[]]]; REWRITE_TAC[INT_NOT_LE] THEN SUBGOAL_THEN `closure c:real^N->bool = affine hull c` MP_TAC THENL [ASM MESON_TAC[]; UNDISCH_TAC `COUNTABLE(c:real^N->bool)`] THEN SUBGOAL_THEN `~(c:real^N->bool = {})` MP_TAC THENL [ASM_MESON_TAC[AFFINE_HULL_EQ_EMPTY]; POP_ASSUM_LIST(K ALL_TAC)]] THEN SPEC_TAC(`c:real^N->bool`,`c:real^N->bool`) THEN X_GEN_TAC `s:real^N->bool` THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM AFF_DIM_POS_LE]) THEN REWRITE_TAC[GSYM INT_OF_NUM_EXISTS] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `span(IMAGE basis (1..n)) INTER {x:real^N | !i. i IN 1..dimindex(:N) ==> rational(x$i)}`] HOMEOMORPHISM_MOVING_DENSE_COUNTABLE_SUBSETS_EXISTS) THEN ASM_SIMP_TAC[COUNTABLE_INTER; COUNTABLE_RATIONAL_COORDINATES; IN_NUMSEG] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ONCE_REWRITE_TAC[GSYM AFFINE_HULL_CLOSURE] THEN REWRITE_TAC[lemma1] THEN SIMP_TAC[HULL_P; SUBSPACE_SPAN; SUBSPACE_IMP_AFFINE] THEN SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN SIMP_TAC[DIM_SPAN; DIM_BASIS_IMAGE] THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_LE_UNIV) THEN ASM_REWRITE_TAC[INT_OF_NUM_LE] THEN DISCH_TAC THEN ASM_SIMP_TAC[SUBSET_NUMSEG; LE_REFL; CARD_NUMSEG_1; LEFT_IMP_EXISTS_THM; HULL_HULL; SET_RULE `t SUBSET s ==> s INTER t = t`] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `n:num` lemma2) THEN ASM_REWRITE_TAC[HULL_HULL] THEN MATCH_MP_TAC(INT_ARITH `d':int = d ==> d < n ==> d' < n`) THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN W(MP_TAC o PART_MATCH (lhand o rand) IMAGE_DIFF_INJ_ALT o lhand o snd) THEN REWRITE_TAC[HULL_SUBSET] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[]);; let DIMENSION_LT_FULL_GEN = prove (`!s:real^N->bool. dimension s < aff_dim s <=> ~(s = {}) /\ relative_interior s = {}`, REWRITE_TAC[INT_ARITH `s:int < a <=> s <= a /\ ~(s = a)`] THEN REWRITE_TAC[DIMENSION_EQ_FULL_GEN; DIMENSION_LE_AFF_DIM] THEN CONV_TAC TAUT);; let DIMENSION_EQ_FULL_ALT = prove (`!u s:real^N->bool. convex u /\ s SUBSET u ==> (dimension s = aff_dim u <=> s = {} /\ u = {} \/ ~(subtopology euclidean u interior_of s = {}))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; SUBSET_EMPTY; DIMENSION_EMPTY] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIMENSION_EMPTY; INTERIOR_OF_EMPTY] THENL [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; STRIP_TAC] THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `aff_dim(s:real^N->bool)` o MATCH_MP (INT_ARITH `s = u ==> !a:int. s <= a /\ a <= u ==> a = u /\ s = a`)) THEN REWRITE_TAC[DIMENSION_EQ_FULL_GEN; DIMENSION_LE_AFF_DIM] THEN ASM_SIMP_TAC[AFF_DIM_SUBSET] THEN ASM_SIMP_TAC[AFF_DIM_EQ_FULL_GEN] THEN REWRITE_TAC[RELATIVE_INTERIOR_INTERIOR_OF] THEN SIMP_TAC[IMP_CONJ] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`) THEN MATCH_MP_TAC INTERIOR_OF_SUBTOPOLOGY_MONO THEN ASM_REWRITE_TAC[HULL_SUBSET]; ASM_SIMP_TAC[GSYM DIMENSION_EQ_AFF_DIM; GSYM INT_LE_ANTISYM; DIMENSION_SUBSET] THEN TRANS_TAC INT_LE_TRANS `dimension(subtopology euclidean u interior_of s:real^N->bool)` THEN SIMP_TAC[DIMENSION_SUBSET; INTERIOR_OF_SUBSET] THEN MP_TAC(ISPECL [`u:real^N->bool`; `subtopology euclidean u interior_of s:real^N->bool`] DIMENSION_OPEN_IN_CONVEX) THEN ASM_SIMP_TAC[OPEN_IN_INTERIOR_OF; DIMENSION_LE_AFF_DIM]]);; let DIMENSION_LT_FULL_ALT = prove (`!u s:real^N->bool. convex u /\ s SUBSET u ==> (dimension s < aff_dim u <=> ~(u = {}) /\ subtopology euclidean u interior_of s = {})`, REPEAT STRIP_TAC THEN REWRITE_TAC[INT_LT_LE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIMENSION_SUBSET) THEN ASM_SIMP_TAC[DIMENSION_EQ_AFF_DIM; DIMENSION_EQ_FULL_ALT] THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; DIMENSION_LE_MINUS1]);; let DIMENSION_EQ_FULL = prove (`!s:real^N->bool. dimension s = &(dimindex(:N)) <=> ~(interior s = {})`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[DIMENSION_NONEMPTY_INTERIOR] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIMENSION_EMPTY; INT_ARITH `~(-- &1:int = &n)`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `aff_dim(s:real^N->bool)` o MATCH_MP (INT_ARITH `!a. d:int = n ==> d <= a /\ a <= n ==> a = n`)) THEN REWRITE_TAC[DIMENSION_LE_AFF_DIM; AFF_DIM_LE_UNIV] THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIMENSION_EQ_FULL_GEN) THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN ASM_REWRITE_TAC[GSYM AFF_DIM_EQ_FULL]);; let DIMENSION_LT_FULL = prove (`!s:real^N->bool. dimension s < &(dimindex(:N)) <=> interior s = {}`, REWRITE_TAC[INT_LT_LE; DIMENSION_LE_DIMINDEX; DIMENSION_EQ_FULL]);; let DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN = prove (`!u s:real^N->bool. affine u /\ open_in (subtopology euclidean u) s /\ bounded s ==> dimension(relative_frontier s) = if s = {} then -- &1 else aff_dim u - &1`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RELATIVE_FRONTIER_EMPTY; DIMENSION_EMPTY] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `u:real^N->bool`] AFF_DIM_OPEN_IN) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_CASES_TAC `aff_dim(u:real^N->bool) <= &0` THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `s:int <= &0 ==> -- &1 <= s /\ ~(s = -- &1) ==> s = &0`)) THEN ASM_REWRITE_TAC[AFF_DIM_GE] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[AFF_DIM_EQ_MINUS1] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[AFF_DIM_EQ_0]] THEN SIMP_TAC[AFF_DIM_EQ_0; LEFT_IMP_EXISTS_THM; RELATIVE_FRONTIER_SING] THEN REWRITE_TAC[DIMENSION_EMPTY; AFF_DIM_SING] THEN CONV_TAC INT_REDUCE_CONV; ALL_TAC] THEN MATCH_MP_TAC(INT_ARITH `d:int < n /\ ~(d <= n - &2) ==> d = n - &1`) THEN CONJ_TAC THENL [TRANS_TAC INT_LTE_TRANS `aff_dim(relative_frontier s:real^N->bool)` THEN CONJ_TAC THENL [REWRITE_TAC[DIMENSION_LT_FULL_GEN] THEN CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_FRONTIER_EQ_EMPTY; AFFINE_BOUNDED_EQ_LOWDIM]; ALL_TAC] THEN REWRITE_TAC[RELATIVE_INTERIOR_INTERIOR_OF] THEN ASM_SIMP_TAC[AFFINE_HULL_RELATIVE_FRONTIER_BOUNDED; GSYM AFF_DIM_EQ_0; INT_ARITH `~(u:int <= &0) ==> ~(u = &0)`] THEN REWRITE_TAC[RELATIVE_FRONTIER_FRONTIER_OF] THEN MATCH_MP_TAC INTERIOR_OF_FRONTIER_OF_EMPTY THEN DISJ1_TAC THEN ASM_MESON_TAC[AFFINE_HULL_OPEN_IN_CONVEX; AFFINE_IMP_CONVEX; HULL_P]; MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[relative_frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_AFFINE]]; DISCH_TAC] THEN SUBGOAL_THEN `relative_frontier s:real^N->bool = subtopology euclidean u frontier_of s` SUBST_ALL_TAC THENL [REWRITE_TAC[RELATIVE_FRONTIER_FRONTIER_OF] THEN ASM_MESON_TAC[AFFINE_HULL_OPEN_IN_AFFINE]; ALL_TAC] THEN MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`] DIMENSION_OPEN_IN_CONVEX) THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX] THEN MATCH_MP_TAC(INT_ARITH `x:int <= n - &1 ==> ~(x = n)`) THEN MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`; `aff_dim(u:real^N->bool) - &1`] DIMENSION_LE_EQ_GENERAL) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; DISCH_THEN SUBST1_TAC] THEN CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN u` ASSUME_TAC THENL [ASM_MESON_TAC[REWRITE_RULE[SUBSET] OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN UNDISCH_TAC `affine(u:real^N->bool)` THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN DISCH_TAC THEN SUBGOAL_THEN `?c. &0 < c /\ IMAGE (\x:real^N. c % x) (subtopology euclidean u closure_of s) SUBSET s /\ IMAGE (\x:real^N. c % x) (subtopology euclidean u closure_of s) SUBSET v` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_CLOSURE) THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CBALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC o SPEC `vec 0:real^N`) THEN MP_TAC(ISPECL [`s INTER v:real^N->bool`; `u:real^N->bool`] OPEN_IN_CONTAINS_CBALL) THEN ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `vec 0:real^N`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM SUBSET_INTER] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN EXISTS_TAC `d / r:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN TRANS_TAC SUBSET_TRANS `cball(vec 0:real^N,d) INTER u` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `IMAGE (\x. d / r % x) (cball(vec 0:real^N,r)) INTER u` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN TRANS_TAC SUBSET_TRANS `closure s:real^N->bool` THEN ASM_REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN MATCH_MP_TAC(SET_RULE `u SUBSET s ==> t INTER u SUBSET s`) THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN ASM_MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_OF_SUBSET_SUBTOPOLOGY]]; ASM_SIMP_TAC[GSYM CBALL_SCALING; REAL_LT_DIV] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; VECTOR_MUL_RZERO; SUBSET_REFL]]; ALL_TAC] THEN EXISTS_TAC `IMAGE (\x:real^N. c % x) s` THEN CONJ_TAC THENL [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO]; ALL_TAC] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `IMAGE (\x:real^N. c % x) (subtopology euclidean u closure_of s)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IMAGE_SUBSET THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_MESON_TAC[OPEN_IN_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `u = IMAGE (\x:real^N. c % x) u` (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THENL [ASM_MESON_TAC[CONIC_IMAGE_MULTIPLE; SUBSPACE_IMP_CONIC]; ALL_TAC] THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) OPEN_IN_INJECTIVE_LINEAR_IMAGE o snd) THEN ASM_REWRITE_TAC[LINEAR_SCALING] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ]; W(MP_TAC o PART_MATCH (lhand o rand) FRONTIER_OF_INJECTIVE_LINEAR_IMAGE o rand o rand o lhand o snd) THEN ASM_SIMP_TAC[LINEAR_SCALING; VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `d:int <= n - &2 ==> d' = d ==> d' <= n - &1 - &1`)) THEN ASM_SIMP_TAC[frontier_of; SET_RULE `IMAGE f c SUBSET s ==> s INTER (IMAGE f (c DIFF i)) = IMAGE f (c DIFF i)`] THEN REWRITE_TAC[GSYM frontier_of] THEN MATCH_MP_TAC DIMENSION_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_SCALING; VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ]]);; let DIMENSION_FRONTIER_BOUNDED_OPEN = prove (`!u:real^N->bool. open u /\ bounded u ==> dimension(frontier u) = if u = {} then -- &1 else &(dimindex(:N)) - &1`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `u:real^N->bool`] DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_OPEN] THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFFINE_UNIV; AFF_DIM_UNIV]);; let DIMENSION_RELATIVE_FRONTIER_NONDENSE_OPEN = prove (`!u s:real^N->bool. affine u /\ open_in (subtopology euclidean u) s /\ ~(s = {}) /\ ~(subtopology euclidean u closure_of s = u) ==> dimension(relative_frontier s) = aff_dim u - &1`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `bounded(s:real^N->bool)` THEN ASM_SIMP_TAC[DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `?z:real^N. z IN u /\ ~(z IN subtopology euclidean u closure_of s)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET u /\ ~(s = u) ==> ?x. x IN u /\ ~(x IN s)`) THEN ASM_REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY]; ALL_TAC] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `affine(u:real^N->bool)` THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`u DIFF subtopology euclidean u closure_of s:real^N->bool`; `u:real^N->bool`] OPEN_IN_CONTAINS_CBALL) THEN SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_CLOSURE_OF] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN ABBREV_TAC `i = \x:real^N. r pow 2 / norm x pow 2 % x` THEN MP_TAC(ISPECL [`i:real^N->real^N`; `u DELETE (vec 0:real^N)`] INVOLUTION_IMP_HOMEOMORPHISM) THEN ANTS_TAC THENL [EXPAND_TAC "i" THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[real_div; o_DEF; LIFT_CMUL; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN REWRITE_TAC[REAL_INV_POW] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_POW THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN REWRITE_TAC[IN_DELETE; IN_UNIV; NORM_EQ_0] THEN SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_ID]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0; NORM_EQ_0; REAL_POW_EQ_0; REAL_LT_IMP_NZ; ARITH_EQ; SUBSPACE_MUL] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NORM] THEN FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN UNDISCH_TAC `&0 < r` THEN SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN CONV_TAC REAL_FIELD]; DISCH_TAC] THEN MP_TAC(ISPECL [`u:real^N->bool`; `IMAGE (i:real^N->real^N) s`] DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN SUBGOAL_THEN `s SUBSET u DELETE (vec 0:real^N)` ASSUME_TAC THENL [ASM_REWRITE_TAC[SUBSET_DELETE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(x IN s) ==> t SUBSET s ==> ~(x IN t)`)) THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; ALL_TAC] THEN ASM_CASES_TAC `(vec 0:real^N) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean u) (IMAGE (i:real^N->real^N) s)` ASSUME_TAC THENL [TRANS_TAC OPEN_IN_TRANS `u DELETE (vec 0:real^N)` THEN SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_IMP_OPEN_MAP)) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(vec 0:real^N,r) INTER u` THEN SIMP_TAC[BOUNDED_CBALL; BOUNDED_INTER; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `x IN (:real^N) DIFF cball(vec 0,r)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER u SUBSET u DIFF c ==> c SUBSET u /\ x IN c ==> x IN UNIV DIFF b`)) THEN REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; EXPAND_TAC "i" THEN REWRITE_TAC[IN_UNIV; IN_DIFF; IN_CBALL_0]] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_NOT_LE; real_abs; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD `~(x = &0) ==> r pow 2 / x pow 2 * x = (r * r) / x`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ; NORM_POS_LT] THEN REWRITE_TAC[REAL_LT_IMP_LE]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[RELATIVE_FRONTIER_FRONTIER_OF] THEN SUBGOAL_THEN `affine hull s:real^N->bool = u` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_HULL_OPEN_IN_AFFINE; SUBSPACE_IMP_AFFINE; HULL_P]; ALL_TAC] THEN SUBGOAL_THEN `affine hull (IMAGE (i:real^N->real^N) s) = u` ASSUME_TAC THENL [MATCH_MP_TAC AFFINE_HULL_OPEN_IN_AFFINE THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY; SUBSPACE_IMP_AFFINE]; ASM_REWRITE_TAC[]] THEN FIRST_ASSUM(MP_TAC o SPECL [`subtopology euclidean u frontier_of s:real^N->bool`; `IMAGE (i:real^N->real^N) (subtopology euclidean u frontier_of s)`] o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[frontier_of] THEN SUBGOAL_THEN `subtopology euclidean u closure_of s SUBSET (u:real^N->bool)` MP_TAC THENL [REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_DIMENSION o MATCH_MP HOMEOMORPHISM_IMP_HOMEOMORPHIC)] THEN MATCH_MP_TAC(MESON[DIMENSION_INSERT] `(?a:real^N. ~(s = {}) /\ ~(t = {}) /\ (a INSERT s = a INSERT t)) ==> dimension s = dimension t`) THEN EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN SUBGOAL_THEN `connected(u:real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX; CONVEX_CONNECTED]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [CONNECTED_CLOPEN] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] CLOPEN_IN_EQ_FRONTIER_OF] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REWRITE_TAC[TAUT `~p ==> ~(q /\ r) <=> ~p /\ r ==> ~q`] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISCH_TAC THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[frontier_of; INTERIOR_OF_OPEN_IN] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> i(i x) = x) /\ t SUBSET s /\ a INSERT (IMAGE i s) = a INSERT u ==> a INSERT IMAGE i (s DIFF t) = a INSERT (u DIFF IMAGE i t)`) THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "i" THEN REWRITE_TAC[] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NORM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM NORM_EQ_0]) THEN UNDISCH_TAC `&0 < r` THEN SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_MESON_TAC[OPEN_IN_SUBSET]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s INTER (s DELETE a)`] THEN REWRITE_TAC[GSYM SUBTOPOLOGY_SUBTOPOLOGY] THEN SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY_OPEN; OPEN_IN_DELETE; OPEN_IN_REFL] THEN SIMP_TAC[SET_RULE `c SUBSET u ==> (u DELETE z) INTER c = c DELETE z`; CLOSURE_OF_SUBSET_SUBTOPOLOGY] THEN MATCH_MP_TAC(SET_RULE `z INSERT w = z INSERT y ==> w = x DELETE z ==> z INSERT y = z INSERT x`) THEN MATCH_MP_TAC(SET_RULE `i z = z ==> z INSERT IMAGE i (s DELETE z) = z INSERT IMAGE i s`) THEN EXPAND_TAC "i" THEN REWRITE_TAC[VECTOR_MUL_RZERO]);; let DIMENSION_FRONTIER_NONDENSE_OPEN = prove (`!u:real^N->bool. open u /\ ~(u = {}) /\ ~(closure u = (:real^N)) ==> dimension(frontier u) = &(dimindex(:N)) - &1`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `u:real^N->bool`] DIMENSION_RELATIVE_FRONTIER_NONDENSE_OPEN) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_OPEN] THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFFINE_UNIV; AFF_DIM_UNIV; EUCLIDEAN_CLOSURE_OF]);; let DIMENSION_RELATIVE_FRONTIER_CONVEX = prove (`!s:real^N->bool. convex s /\ bounded s /\ ~(s = {}) ==> dimension(relative_frontier s) = aff_dim s - &1`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`affine hull s:real^N->bool`; `relative_interior s:real^N->bool`] DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN) THEN REWRITE_TAC[AFFINE_AFFINE_HULL; OPEN_IN_RELATIVE_INTERIOR] THEN ASM_SIMP_TAC[BOUNDED_RELATIVE_INTERIOR; RELATIVE_FRONTIER_RELATIVE_INTERIOR; AFF_DIM_AFFINE_HULL; RELATIVE_INTERIOR_EQ_EMPTY]);; let DIMENSION_SPHERE_INTER_AFFINE = prove (`!a:real^N r t. &0 < r /\ affine t /\ a IN t ==> dimension(sphere(a,r) INTER t) = aff_dim t - &1`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM FRONTIER_CBALL] THEN W(MP_TAC o PART_MATCH (rand o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[CONVEX_CBALL; INTERIOR_CBALL; GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL]; DISCH_THEN(SUBST1_TAC o SYM)] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIMENSION_RELATIVE_FRONTIER_CONVEX o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[BOUNDED_INTER; BOUNDED_CBALL] THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CBALL; AFFINE_IMP_CONVEX] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN ASM_MESON_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE]; DISCH_THEN SUBST1_TAC THEN AP_THM_TAC THEN AP_TERM_TAC] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[HULL_P] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERIOR_CBALL; IN_INTER] THEN ASM_MESON_TAC[CENTRE_IN_BALL]);; let DIMENSION_SPHERE = prove (`!a:real^N r. dimension(sphere(a,r)) = if &0 < r then &(dimindex(:N)) - &1 else if r = &0 then &0 else -- &1`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r:real = &0` THEN ASM_SIMP_TAC[REAL_LT_REFL; SPHERE_SING; DIMENSION_SING] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DIMENSION_EQ_MINUS1; SPHERE_EQ_EMPTY] THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SET_RULE `s = s INTER UNIV`] THEN ASM_SIMP_TAC[DIMENSION_SPHERE_INTER_AFFINE; AFFINE_UNIV; IN_UNIV] THEN REWRITE_TAC[AFF_DIM_UNIV]);; (* ------------------------------------------------------------------------- *) (* Nonseparation: a "simple" set of dimension n can't be separated by sets *) (* of dimension <= n - 2. *) (* ------------------------------------------------------------------------- *) let CONNECTED_OPEN_IN_CONVEX_DIFF_LOWDIM = prove (`!c s t:real^N->bool. convex c /\ open_in (subtopology euclidean c) s /\ connected s /\ dimension t <= aff_dim c - &2 ==> connected(s DIFF t)`, let lemma1 = prove (`!u s:real^N->bool. affine u /\ dimension s <= aff_dim u - &2 ==> connected(u DIFF s)`, MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `d:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `subtopology euclidean u interior_of d:real^N->bool = {}` ASSUME_TAC THENL [ONCE_REWRITE_TAC[INTERIOR_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN MP_TAC(ISPECL [`u:real^N->bool`; `u INTER d:real^N->bool`] DIMENSION_LT_FULL_ALT) THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; INTER_SUBSET] THEN MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> r`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `d:int <= u - &2 ==> d' <= d ==> d' < u`)) THEN SIMP_TAC[DIMENSION_SUBSET; INTER_SUBSET]; ALL_TAC] THEN REWRITE_TAC[CONNECTED_SEPARATION; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u1:real^N->bool`; `u2:real^N->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (SET_RULE `u1 UNION u2 = u DIFF d ==> u INTER u1 = u1 /\ u INTER u2 = u2`)) THEN SUBGOAL_THEN `(u:real^N->bool) SUBSET closure u1 UNION closure u2` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERIOR_OF_EQ_EMPTY_COMPLEMENT]) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SUBST1_TAC(SYM(ASSUME `u1 UNION u2:real^N->bool = u DIFF d`)) THEN REWRITE_TAC[CLOSURE_OF_UNION] THEN ASM_REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `v:real^N->bool = u DIFF closure u1` THEN MP_TAC(ISPECL [`u:real^N->bool`; `v:real^N->bool`] DIMENSION_RELATIVE_FRONTIER_NONDENSE_OPEN) THEN SUBGOAL_THEN `~(v:real^N->bool = {})` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean u) (v:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "v" THEN SIMP_TAC[OPEN_IN_DIFF_CLOSED; CLOSED_CLOSURE]; ALL_TAC] THEN MP_TAC(ISPECL [`u:real^N->bool`; `v:real^N->bool`] AFFINE_HULL_OPEN_IN_AFFINE) THEN ASM_REWRITE_TAC[RELATIVE_FRONTIER_FRONTIER_OF] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t SUBSET u /\ ~(t = u) ==> ~(s = u)`) THEN EXISTS_TAC `subtopology euclidean u closure_of u2:real^N->bool` THEN REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_OF_MINIMAL THEN REWRITE_TAC[CLOSED_IN_CLOSURE_OF]; ALL_TAC] THEN ASM_REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN ASM SET_TAC[]; MATCH_MP_TAC(INT_ARITH `!x. d:int <= x /\ x < n ==> ~(d = n)`) THEN EXISTS_TAC `dimension(d:real^N->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC DIMENSION_SUBSET; ASM_INT_ARITH_TAC] THEN ASM_SIMP_TAC[frontier_of; INTERIOR_OF_OPEN_IN] THEN MP_TAC(ISPECL [`subtopology euclidean (u:real^N->bool)`; `u DIFF subtopology euclidean u closure_of u1:real^N->bool`; `subtopology euclidean u closure_of u2:real^N->bool`] CLOSURE_OF_MONO) THEN REWRITE_TAC[CLOSURE_OF_CLOSURE_OF] THEN ASM_REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN ASM_REWRITE_TAC[SET_RULE `u DIFF u INTER s = u DIFF s`] THEN ASM SET_TAC[]]) in let lemma2 = prove (`!u s t:real^N->bool. affine u /\ open_in (subtopology euclidean u) s /\ connected s /\ dimension t <= aff_dim u - &2 ==> connected(s DIFF t)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MATCH_MP_TAC CONNECTED_CONNECTED_DIFF THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `u DIFF t:real^N->bool`; `u:real^N->bool`] CLOSURE_OPEN_IN_INTER_CLOSURE) THEN ASM_REWRITE_TAC[SUBSET_DIFF] THEN MP_TAC(ISPECL [`u:real^N->bool`; `u DIFF closure(u DIFF t):real^N->bool`] DIMENSION_OPEN_IN_CONVEX) THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; OPEN_IN_DIFF_CLOSED; CLOSED_CLOSURE] THEN COND_CASES_TAC THENL [DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[SET_RULE `s SUBSET u /\ u DIFF closure(u DIFF t) = {} ==> s INTER closure (u DIFF t) = s`] THEN ASM_SIMP_TAC[SET_RULE `s SUBSET u ==> s INTER (u DIFF t) = s DIFF t`] THEN MESON_TAC[CLOSURE_SUBSET]; MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `d:int <= u - &2 ==> d' <= d ==> ~(d' = u)`)) THEN MATCH_MP_TAC DIMENSION_SUBSET THEN MP_TAC(ISPEC `u DIFF t:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^N,r) INTER u` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN CONJ_TAC THENL[ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[INTER_COMM; OPEN_BALL; OPEN_IN_OPEN_INTER; OPEN_IN_SUBSET_TRANS]; ALL_TAC] THEN MP_TAC(ISPECL [`ball(x:real^N,r) INTER u`; `u:real^N->bool`] HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS) THEN ASM_SIMP_TAC[CONVEX_BALL; CONVEX_INTER; AFFINE_IMP_CONVEX] THEN ASM_SIMP_TAC[HULL_P; OPEN_IN_REFL] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SUBGOAL_THEN `affine hull (u INTER ball(x:real^N,r)) = affine hull u` SUBST1_TAC THENL [MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; OPEN_BALL; GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM SET_TAC[]; ASM_SIMP_TAC[HULL_P; OPEN_IN_OPEN_INTER; OPEN_BALL]] THEN REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`u:real^N->bool`; `IMAGE (f:real^N->real^N) (ball(x,r) INTER u INTER t)`] lemma1) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [TRANS_TAC INT_LE_TRANS `dimension(t:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC INT_LE_TRANS `dimension(ball(x:real^N,r) INTER u INTER t)` THEN ASM_SIMP_TAC[DIMENSION_SUBSET; INTER_SUBSET; GSYM INTER_ASSOC] THEN MATCH_MP_TAC INT_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION; MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN REWRITE_TAC[INTER_SUBSET; SUBSET_DIFF; SUBSET_UNIV] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONNECTED_EMPTY; EMPTY_DIFF] THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `(relative_interior c INTER s) DIFF t:real^N->bool` THEN SUBGOAL_THEN `open_in (subtopology euclidean (affine hull c)) (relative_interior c INTER s:real^N->bool)` ASSUME_TAC THENL [TRANS_TAC OPEN_IN_TRANS `relative_interior c:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `c:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC lemma2 THEN EXISTS_TAC `affine hull s:real^N->bool` THEN REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN MP_TAC(ISPECL [`c:real^N->bool`; `s:real^N->bool`] AFFINE_HULL_OPEN_IN_CONVEX) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC CONNECTED_WITH_RELATIVE_INTERIOR_OPEN_IN_CONVEX THEN ASM_REWRITE_TAC[]; MP_TAC(ISPEC `c:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]; MP_TAC(ISPECL [`relative_interior c INTER s:real^N->bool`; `affine hull c DIFF t:real^N->bool`; `affine hull c:real^N->bool`] CLOSURE_OPEN_IN_INTER_CLOSURE) THEN ASM_REWRITE_TAC[SUBSET_DIFF] THEN MP_TAC(ISPECL [`affine hull c:real^N->bool`; `affine hull c DIFF closure(affine hull c DIFF t):real^N->bool`] DIMENSION_OPEN_IN_CONVEX) THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; OPEN_IN_DIFF_CLOSED; CLOSED_CLOSURE; AFFINE_AFFINE_HULL] THEN COND_CASES_TAC THENL [DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE `relative_interior c SUBSET c /\ c SUBSET u /\ u DIFF closure(u DIFF t) = {} ==> (relative_interior c INTER s) INTER closure (u DIFF t) = relative_interior c INTER s /\ (relative_interior c INTER s) INTER (u DIFF t) = (relative_interior c INTER s) DIFF t`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `relative_interior c:real^N->bool`; `c:real^N->bool`] CLOSURE_OPEN_IN_INTER_CLOSURE) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN ASM_SIMP_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN TRANS_TAC SUBSET_TRANS `s:real^N->bool` THEN REWRITE_TAC[SUBSET_DIFF] THEN TRANS_TAC SUBSET_TRANS `closure s:real^N->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN MATCH_MP_TAC(SET_RULE `c SUBSET closure c /\ s SUBSET c ==> s SUBSET s INTER closure c`) THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSURE_SUBSET]; MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `d:int <= u - &2 ==> d' <= d ==> ~(d' = u)`)) THEN MATCH_MP_TAC DIMENSION_SUBSET THEN MP_TAC(ISPEC `affine hull c DIFF t:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]]);; let CONNECTED_CONVEX_DIFF_LOWDIM = prove (`!s t:real^N->bool. convex s /\ dimension t <= aff_dim s - &2 ==> connected(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_OPEN_IN_CONVEX_DIFF_LOWDIM THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[CONVEX_CONNECTED; OPEN_IN_REFL]);; let CONNECTED_OPEN_IN_DIFF_LOWDIM = prove (`!s t:real^N->bool. open_in (subtopology euclidean (affine hull s)) s /\ connected s /\ dimension t <= aff_dim s - &2 ==> connected(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_OPEN_IN_CONVEX_DIFF_LOWDIM THEN EXISTS_TAC `affine hull s:real^N->bool` THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL]);; let CONNECTED_OPEN_DIFF_LOWDIM = prove (`!s t:real^N->bool. open s /\ connected s /\ dimension t <= &(dimindex(:N)) - &2 ==> connected(s DIFF t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_DIFF; CONNECTED_EMPTY] THEN MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_LOWDIM THEN ASM_SIMP_TAC[OPEN_SUBSET; HULL_SUBSET; AFF_DIM_OPEN]);; let CONNECTED_FULL_CONVEX_DIFF_LOWDIM = prove (`!s:real^N->bool t. convex s /\ ~(interior s = {}) /\ dimension t <= &(dimindex(:N)) - &2 ==> connected(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONVEX_DIFF_LOWDIM THEN ASM_SIMP_TAC[AFF_DIM_NONEMPTY_INTERIOR]);; let CONNECTED_UNIV_DIFF_LOWDIM = prove (`!s:real^N->bool. dimension s <= &(dimindex(:N)) - &2 ==> connected((:real^N) DIFF s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_FULL_CONVEX_DIFF_LOWDIM THEN ASM_REWRITE_TAC[CONVEX_UNIV; INTERIOR_UNIV; UNIV_NOT_EMPTY]);; let CONNECTED_FULL_REGULAR_DIFF_LOWDIM = prove (`!s:real^N->bool t. s SUBSET closure(interior s) /\ connected(interior s) /\ dimension t <= &(dimindex(:N)) - &2 ==> connected(s DIFF t)`, let lemma = prove (`!s t:real^N->bool. open s /\ interior t = {} ==> s SUBSET closure(s DIFF t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN ONCE_REWRITE_TAC[SET_RULE `s SUBSET t <=> s INTER t = s`] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ o lhand o snd) THEN ASM_REWRITE_TAC[CLOSURE_COMPLEMENT] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `interior s DIFF t:real^N->bool` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_OPEN_DIFF_LOWDIM THEN ASM_REWRITE_TAC[OPEN_INTERIOR]; MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN SET_TAC[]; TRANS_TAC SUBSET_TRANS `closure(interior s):real^N->bool` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC lemma THEN REWRITE_TAC[OPEN_INTERIOR] THEN MP_TAC(SPEC `t:real^N->bool` DIMENSION_NONEMPTY_INTERIOR) THEN ASM_CASES_TAC `interior t:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Absolute retracts (AR), absolute neighbourhood retracts (ANR) and also *) (* Euclidean neighbourhood retracts (ENR). We define AR and ANR by *) (* specializing the standard definitions for a set in R^n to embedding in *) (* spaces inside R^{n+1}. This turns out to be sufficient (since any set in *) (* R^n can be embedded as a closed subset of a convex subset of R^{n+1}) to *) (* derive the usual definitions, but we need to split them into two *) (* implications because of the lack of type quantifiers. Then ENR turns out *) (* to be equivalent to ANR plus local compactness. *) (* ------------------------------------------------------------------------- *) let AR = new_definition `AR(s:real^N->bool) <=> !u s':real^(N,1)finite_sum->bool. s homeomorphic s' /\ closed_in (subtopology euclidean u) s' ==> s' retract_of u`;; let ANR = new_definition `ANR(s:real^N->bool) <=> !u s':real^(N,1)finite_sum->bool. s homeomorphic s' /\ closed_in (subtopology euclidean u) s' ==> ?t. open_in (subtopology euclidean u) t /\ s' retract_of t`;; let ENR = new_definition `ENR s <=> ?u. open u /\ s retract_of u`;; (* ------------------------------------------------------------------------- *) (* First, show that we do indeed get the "usual" properties of ARs and ANRs. *) (* ------------------------------------------------------------------------- *) let AR_IMP_ABSOLUTE_EXTENSOR = prove (`!f:real^M->real^N u t s. AR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ closed_in (subtopology euclidean u) t ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\ !x. x IN t ==> g x = f x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c s':real^(N,1)finite_sum->bool. convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ (s:real^N->bool) homeomorphic s'` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AR]) THEN DISCH_THEN(MP_TAC o SPECL [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(g:real^N->real^(N,1)finite_sum) o (f:real^M->real^N)`; `c:real^(N,1)finite_sum->bool`; `u:real^M->bool`; `t:real^M->bool`] DUGUNDJI) THEN ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^(N,1)finite_sum` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^(N,1)finite_sum->real^(N,1)finite_sum` THEN STRIP_TAC THEN EXISTS_TAC `(h:real^(N,1)finite_sum->real^N) o r o (f':real^M->real^(N,1)finite_sum)` THEN ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let AR_IMP_ABSOLUTE_RETRACT = prove (`!s:real^N->bool u s':real^M->bool. AR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s' ==> s' retract_of u`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^M`; `h:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:real^M->real^N`; `u:real^M->bool`; `s':real^M->bool`; `s:real^N->bool`] AR_IMP_ABSOLUTE_EXTENSOR) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `h':real^M->real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `(g:real^N->real^M) o (h':real^M->real^N)` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let AR_IMP_ABSOLUTE_RETRACT_UNIV = prove (`!s:real^N->bool s':real^M->bool. AR s /\ s homeomorphic s' /\ closed s' ==> s' retract_of (:real^M)`, MESON_TAC[AR_IMP_ABSOLUTE_RETRACT; TOPSPACE_EUCLIDEAN; SUBTOPOLOGY_UNIV; OPEN_IN; CLOSED_IN]);; let ABSOLUTE_EXTENSOR_IMP_AR = prove (`!s:real^N->bool. (!f:real^(N,1)finite_sum->real^N u t. f continuous_on t /\ IMAGE f t SUBSET s /\ closed_in (subtopology euclidean u) t ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\ !x. x IN t ==> g x = f x) ==> AR s`, REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN MAP_EVERY X_GEN_TAC [`u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`h:real^(N,1)finite_sum->real^N`; `u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `h':real^(N,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `(g:real^N->real^(N,1)finite_sum) o (h':real^(N,1)finite_sum->real^N)` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let AR_EQ_ABSOLUTE_EXTENSOR = prove (`!s:real^N->bool. AR s <=> (!f:real^(N,1)finite_sum->real^N u t. f continuous_on t /\ IMAGE f t SUBSET s /\ closed_in (subtopology euclidean u) t ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\ !x. x IN t ==> g x = f x)`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[AR_IMP_ABSOLUTE_EXTENSOR; ABSOLUTE_EXTENSOR_IMP_AR]);; let AR_IMP_RETRACT = prove (`!s u:real^N->bool. AR s /\ closed_in (subtopology euclidean u) s ==> s retract_of u`, MESON_TAC[AR_IMP_ABSOLUTE_RETRACT; HOMEOMORPHIC_REFL]);; let HOMEOMORPHIC_ARNESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (AR s <=> AR t)`, let lemma = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ AR t ==> AR s`, REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] AR_IMP_ABSOLUTE_RETRACT)) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC HOMEOMORPHIC_TRANS `s:real^M->bool` THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]) in REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THENL [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]; ALL_TAC] THEN ASM_MESON_TAC[lemma]);; let AR_TRANSLATION = prove (`!a:real^N s. AR(IMAGE (\x. a + x) s) <=> AR s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [AR_TRANSLATION];; let AR_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (AR(IMAGE f s) <=> AR s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);; add_linear_invariants [AR_LINEAR_IMAGE_EQ];; let HOMEOMORPHISM_ARNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (AR(IMAGE f k) <=> AR k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR = prove (`!f:real^M->real^N u t s. ANR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ closed_in (subtopology euclidean u) t ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ g continuous_on v /\ IMAGE g v SUBSET s /\ !x. x IN t ==> g x = f x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c s':real^(N,1)finite_sum->bool. convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ (s:real^N->bool) homeomorphic s'` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN DISCH_THEN(MP_TAC o SPECL [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^(N,1)finite_sum->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(g:real^N->real^(N,1)finite_sum) o (f:real^M->real^N)`; `c:real^(N,1)finite_sum->bool`; `u:real^M->bool`; `t:real^M->bool`] DUGUNDJI) THEN ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^(N,1)finite_sum` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^(N,1)finite_sum->real^(N,1)finite_sum` THEN STRIP_TAC THEN EXISTS_TAC `{x | x IN u /\ (f':real^M->real^(N,1)finite_sum) x IN d}` THEN EXISTS_TAC `(h:real^(N,1)finite_sum->real^N) o r o (f':real^M->real^(N,1)finite_sum)` THEN ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_MESON_TAC[]; REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]);; let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT = prove (`!s:real^N->bool u s':real^M->bool. ANR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s' ==> ?v. open_in (subtopology euclidean u) v /\ s' retract_of v`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^M`; `h:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:real^M->real^N`; `u:real^M->bool`; `s':real^M->bool`; `s:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `h':real^M->real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `(g:real^N->real^M) o (h':real^M->real^N)` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV = prove (`!s:real^N->bool s':real^M->bool. ANR s /\ s homeomorphic s' /\ closed s' ==> ?v. open v /\ s' retract_of v`, MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; TOPSPACE_EUCLIDEAN; SUBTOPOLOGY_UNIV; OPEN_IN; CLOSED_IN]);; let ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR = prove (`!s:real^N->bool. (!f:real^(N,1)finite_sum->real^N u t. f continuous_on t /\ IMAGE f t SUBSET s /\ closed_in (subtopology euclidean u) t ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ g continuous_on v /\ IMAGE g v SUBSET s /\ !x. x IN t ==> g x = f x) ==> ANR s`, REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN MAP_EVERY X_GEN_TAC [`u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`h:real^(N,1)finite_sum->real^N`; `u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^(N,1)finite_sum->bool` THEN DISCH_THEN(X_CHOOSE_THEN `h':real^(N,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `(g:real^N->real^(N,1)finite_sum) o (h':real^(N,1)finite_sum->real^N)` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR = prove (`!s:real^N->bool. ANR s <=> (!f:real^(N,1)finite_sum->real^N u t. f continuous_on t /\ IMAGE f t SUBSET s /\ closed_in (subtopology euclidean u) t ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ g continuous_on v /\ IMAGE g v SUBSET s /\ !x. x IN t ==> g x = f x)`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR]);; let ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT = prove (`!s:real^N->bool u s':real^M->bool. ANR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s' ==> ?v w. open_in (subtopology euclidean u) v /\ closed_in (subtopology euclidean u) w /\ s' SUBSET v /\ v SUBSET w /\ s' retract_of w`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?z. open_in (subtopology euclidean u) z /\ (s':real^M->bool) retract_of z` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s':real^M->bool`; `u DIFF z:real^M->bool`; `u:real^M->bool`] SEPARATION_NORMAL_LOCAL) THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_DIFF] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `v:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u DIFF w:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] RETRACT_OF_SUBSET)) THEN ASM SET_TAC[]);; let ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR = prove (`!f:real^M->real^N u t s. ANR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ closed_in (subtopology euclidean u) t ==> ?v w g. open_in (subtopology euclidean u) v /\ closed_in (subtopology euclidean u) w /\ t SUBSET v /\ v SUBSET w /\ g continuous_on w /\ IMAGE g w SUBSET s /\ !x. x IN t ==> g x = f x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ g continuous_on v /\ IMAGE g v SUBSET s /\ !x. x IN t ==> g x = (f:real^M->real^N) x` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`t:real^M->bool`; `u DIFF v:real^M->bool`; `u:real^M->bool`] SEPARATION_NORMAL_LOCAL) THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_DIFF] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `w:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `z:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u DIFF z:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN EXISTS_TAC `g:real^M->real^N` THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let ANR_IMP_NEIGHBOURHOOD_RETRACT = prove (`!s:real^N->bool u. ANR s /\ closed_in (subtopology euclidean u) s ==> ?v. open_in (subtopology euclidean u) v /\ s retract_of v`, MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL]);; let ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT = prove (`!s:real^N->bool u. ANR s /\ closed_in (subtopology euclidean u) s ==> ?v w. open_in (subtopology euclidean u) v /\ closed_in (subtopology euclidean u) w /\ s SUBSET v /\ v SUBSET w /\ s retract_of w`, MESON_TAC[ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL]);; let HOMEOMORPHIC_ANRNESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (ANR s <=> ANR t)`, let lemma = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ ANR t ==> ANR s`, REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT)) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC HOMEOMORPHIC_TRANS `s:real^M->bool` THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]) in REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THENL [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]; ALL_TAC] THEN ASM_MESON_TAC[lemma]);; let ANR_TRANSLATION = prove (`!a:real^N s. ANR(IMAGE (\x. a + x) s) <=> ANR s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [ANR_TRANSLATION];; let ANR_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (ANR(IMAGE f s) <=> ANR s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);; add_linear_invariants [ANR_LINEAR_IMAGE_EQ];; let HOMEOMORPHISM_ANRNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (ANR(IMAGE f k) <=> ANR k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMOTOPIC_ON_NEIGHBOURHOOD_INTO_ANR = prove (`!f g:real^M->real^N s t v. ANR v /\ f continuous_on s /\ IMAGE f s SUBSET v /\ g continuous_on s /\ IMAGE g s SUBSET v /\ t SUBSET s /\ (!x. x IN t ==> f x = g x) ==> ?u. open_in (subtopology euclidean s) u /\ t SUBSET u /\ homotopic_with (\h. !x. x IN t ==> h x = f x) (u,v) f g`, REPEAT STRIP_TAC THEN ABBREV_TAC `c = {x | x IN s /\ (f:real^M->real^N) x = g x}` THEN SUBGOAL_THEN `closed_in (subtopology euclidean s) (c:real^M->bool)` ASSUME_TAC THENL [EXPAND_TAC "c" THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB]; ALL_TAC] THEN ABBREV_TAC `fg:real^(1,M)finite_sum->real^N = \x. if fstcart x = vec 1 then g(sndcart x) else f(sndcart x)` THEN MP_TAC(ISPECL [`fg:real^(1,M)finite_sum->real^N`; `(interval[vec 0,vec 1] PCROSS s):real^(1,M)finite_sum->bool`; `interval[vec 0,vec 1] PCROSS c UNION {vec 0:real^1,vec 1} PCROSS (s:real^M->bool)`; `v:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_SIMP_TAC[CLOSED_IN_PCROSS_EQ; CLOSED_IN_REFL; CLOSED_IN_INSERT; CLOSED_IN_EMPTY; ENDS_IN_UNIT_INTERVAL; CLOSED_IN_UNION] THEN ANTS_TAC THENL [CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN REWRITE_TAC[PCROSS_UNION] THEN REWRITE_TAC[GSYM UNION_ASSOC] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN EXPAND_TAC "fg" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `interval[vec 0:real^1,vec 1] PCROSS (s:real^M->bool)` THEN ASM_SIMP_TAC[CLOSED_IN_PCROSS_EQ; CLOSED_IN_REFL; CLOSED_IN_INSERT; CLOSED_IN_EMPTY; ENDS_IN_UNIT_INTERVAL; CLOSED_IN_UNION] THEN REWRITE_TAC[SUBSET_UNION] THEN REWRITE_TAC[SUBSET_PCROSS; UNION_SUBSET; UNIT_INTERVAL_NONEMPTY; INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL; NOT_INSERT_EMPTY; SUBSET_REFL] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ONCE_REWRITE_TAC[CONJ_ASSOC]] THEN CONJ_TAC THENL [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_UNION] THEN SIMP_TAC[FORALL_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNION] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `x:real^1 = vec 1` THEN ASM_REWRITE_TAC[VEC_EQ; IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM SET_TAC[]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_UNION] THEN SIMP_TAC[FORALL_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN EXPAND_TAC "fg" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u2:real^(1,M)finite_sum->bool`; `h:real^(1,M)finite_sum->real^N`] THEN REWRITE_TAC[UNION_SUBSET; FORALL_IN_UNION] THEN REWRITE_TAC[FORALL_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN STRIP_TAC THEN MP_TAC(ISPECL [`interval[vec 0:real^1,vec 1]`; `c:real^M->bool`; `s:real^M->bool`; `u2:real^(1,M)finite_sum->bool`] TUBE_LEMMA_GEN) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN EXISTS_TAC `h:real^(1,M)finite_sum->real^N` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h u2 SUBSET v ==> u SUBSET u2 ==> IMAGE h u SUBSET v`))] THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[CONJ_ASSOC]] THEN SUBGOAL_THEN `!x:real^M. x IN u ==> x IN s` MP_TAC THENL [ASM_MESON_TAC[SUBSET; OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^M. x IN t ==> x IN c` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[IN_INSERT] THEN REPEAT DISCH_TAC THEN EXPAND_TAC "fg" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Analogous properties of ENRs. *) (* ------------------------------------------------------------------------- *) let ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT = prove (`!s:real^M->bool s':real^N->bool u. ENR s /\ s homeomorphic s' /\ s' SUBSET u ==> ?t'. open_in (subtopology euclidean u) t' /\ s' retract_of t'`, REWRITE_TAC[ENR; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`X:real^M->bool`; `Y:real^N->bool`; `K:real^N->bool`; `U:real^M->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `locally compact (Y:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[RETRACT_OF_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT; HOMEOMORPHIC_LOCAL_COMPACTNESS]; ALL_TAC] THEN SUBGOAL_THEN `?W:real^N->bool. open_in (subtopology euclidean K) W /\ closed_in (subtopology euclidean W) Y` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(X_CHOOSE_THEN `W:real^N->bool` STRIP_ASSUME_TAC o MATCH_MP LOCALLY_COMPACT_CLOSED_IN_OPEN) THEN EXISTS_TAC `K INTER W:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; CLOSED_IN_CLOSED] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real^N->real^M`; `W:real^N->bool`; `Y:real^N->bool`] TIETZE_UNBOUNDED) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{x | x IN W /\ (h:real^N->real^M) x IN U}` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `W:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSET_UNIV]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; retract_of; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN EXISTS_TAC `(f:real^M->real^N) o r o (h:real^N->real^M)` THEN SUBGOAL_THEN `(W:real^N->bool) SUBSET K /\ Y SUBSET W` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV = prove (`!s:real^M->bool s':real^N->bool. ENR s /\ s homeomorphic s' ==> ?t'. open t' /\ s' retract_of t'`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN MATCH_MP_TAC ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT THEN ASM_MESON_TAC[SUBSET_UNIV]);; let HOMEOMORPHIC_ENRNESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (ENR s <=> ENR t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN REWRITE_TAC[ENR] THENL [MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`] ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV); MP_TAC(ISPECL [`t:real^N->bool`; `s:real^M->bool`] ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; let ENR_TRANSLATION = prove (`!a:real^N s. ENR(IMAGE (\x. a + x) s) <=> ENR s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ENRNESS THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [ENR_TRANSLATION];; let ENR_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (ENR(IMAGE f s) <=> ENR s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ENRNESS THEN ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);; add_linear_invariants [ENR_LINEAR_IMAGE_EQ];; let HOMEOMORPHISM_ENRNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (ENR(IMAGE f k) <=> ENR k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ENRNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some relations among the concepts. We also relate AR to being a retract *) (* of UNIV, which is often a more convenient proxy in the closed case. *) (* ------------------------------------------------------------------------- *) let AR_IMP_ANR = prove (`!s:real^N->bool. AR s ==> ANR s`, REWRITE_TAC[AR; ANR] THEN MESON_TAC[OPEN_IN_REFL; CLOSED_IN_IMP_SUBSET]);; let ENR_IMP_ANR = prove (`!s:real^N->bool. ENR s ==> ANR s`, REWRITE_TAC[ANR] THEN MESON_TAC[ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; CLOSED_IN_IMP_SUBSET]);; let ENR_ANR = prove (`!s:real^N->bool. ENR s <=> ANR s /\ locally compact s`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[ENR_IMP_ANR] THENL [ASM_MESON_TAC[ENR; RETRACT_OF_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT]; SUBGOAL_THEN `?t. closed t /\ (s:real^N->bool) homeomorphic (t:real^(N,1)finite_sum->bool)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED THEN ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN DISCH_THEN(MP_TAC o SPECL [`(:real^(N,1)finite_sum)`; `t:real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; GSYM OPEN_IN] THEN REWRITE_TAC[GSYM ENR] THEN ASM_MESON_TAC[HOMEOMORPHIC_ENRNESS]]]);; let AR_ANR = prove (`!s:real^N->bool. AR s <=> ANR s /\ contractible s /\ ~(s = {})`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[AR_IMP_ANR] THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[AR; HOMEOMORPHIC_EMPTY; RETRACT_OF_EMPTY; FORALL_UNWIND_THM2; CLOSED_IN_EMPTY; UNIV_NOT_EMPTY]] THEN SUBGOAL_THEN `?c s':real^(N,1)finite_sum->bool. convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ (s:real^N->bool) homeomorphic s'` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AR]) THEN DISCH_THEN(MP_TAC o SPECL [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM; HOMEOMORPHIC_CONTRACTIBLE; RETRACT_OF_CONTRACTIBLE; CONVEX_IMP_CONTRACTIBLE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; homotopic_with] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `h:real^(1,N)finite_sum->real^N`] THEN STRIP_TAC THEN REWRITE_TAC[AR_EQ_ABSOLUTE_EXTENSOR] THEN MAP_EVERY X_GEN_TAC [`f:real^(N,1)finite_sum->real^N`; `w:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`f:real^(N,1)finite_sum->real^N`; `w:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] o REWRITE_RULE[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^(N,1)finite_sum->bool`; `g:real^(N,1)finite_sum->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`t:real^(N,1)finite_sum->bool`; `w DIFF u:real^(N,1)finite_sum->bool`; `w:real^(N,1)finite_sum->bool`] SEPARATION_NORMAL_LOCAL) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`v:real^(N,1)finite_sum->bool`; `v':real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`t:real^(N,1)finite_sum->bool`; `w DIFF v:real^(N,1)finite_sum->bool`; `w:real^(N,1)finite_sum->bool`; `vec 0:real^1`; `vec 1:real^1`] URYSOHN_LOCAL) THEN ASM_SIMP_TAC[SEGMENT_1; CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN REWRITE_TAC[DROP_VEC; REAL_POS] THEN X_GEN_TAC `e:real^(N,1)finite_sum->real^1` THEN STRIP_TAC THEN EXISTS_TAC `\x. if (x:real^(N,1)finite_sum) IN w DIFF v then a else (h:real^(1,N)finite_sum->real^N) (pastecart (e x) (g x))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SUBGOAL_THEN `w:real^(N,1)finite_sum->bool = (w DIFF v) UNION (w DIFF v')` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [th] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REWRITE_TAC[GSYM th]) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL; CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC (REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN COND_CASES_TAC THEN ASM SET_TAC[]]);; let ANR_RETRACT_OF_ANR = prove (`!s t:real^N->bool. ANR t /\ s retract_of t ==> ANR s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `g:real^(N,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:real^N->real^N) o (g:real^(N,1)finite_sum->real^N)` THEN ASM_SIMP_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let AR_RETRACT_OF_AR = prove (`!s t:real^N->bool. AR t /\ s retract_of t ==> AR s`, REWRITE_TAC[AR_ANR] THEN MESON_TAC[ANR_RETRACT_OF_ANR; RETRACT_OF_CONTRACTIBLE; RETRACT_OF_EMPTY]);; let ENR_RETRACT_OF_ENR = prove (`!s t:real^N->bool. ENR t /\ s retract_of t ==> ENR s`, REWRITE_TAC[ENR] THEN MESON_TAC[RETRACT_OF_TRANS]);; let RETRACT_OF_UNIV = prove (`!s:real^N->bool. s retract_of (:real^N) <=> AR s /\ closed s`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC AR_RETRACT_OF_AR THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTE_EXTENSOR_IMP_AR THEN MESON_TAC[DUGUNDJI; CONVEX_UNIV; UNIV_NOT_EMPTY]; MATCH_MP_TAC RETRACT_OF_CLOSED THEN ASM_MESON_TAC[CLOSED_UNIV]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] AR_IMP_ABSOLUTE_RETRACT)) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; HOMEOMORPHIC_REFL]]);; let COMPACT_AR = prove (`!s. compact s /\ AR s <=> compact s /\ s retract_of (:real^N)`, REWRITE_TAC[RETRACT_OF_UNIV] THEN MESON_TAC[COMPACT_IMP_CLOSED]);; (* ------------------------------------------------------------------------- *) (* More properties of ARs, ANRs and ENRs. *) (* ------------------------------------------------------------------------- *) let NOT_AR_EMPTY = prove (`~(AR({}:real^N->bool))`, REWRITE_TAC[AR_ANR]);; let AR_IMP_NONEMPTY = prove (`!s:real^N->bool. AR s ==> ~(s = {})`, MESON_TAC[NOT_AR_EMPTY]);; let ENR_EMPTY = prove (`ENR {}`, REWRITE_TAC[ENR; RETRACT_OF_EMPTY] THEN MESON_TAC[OPEN_EMPTY]);; let ANR_EMPTY = prove (`ANR {}`, SIMP_TAC[ENR_EMPTY; ENR_IMP_ANR]);; let CONVEX_IMP_AR = prove (`!s:real^N->bool. convex s /\ ~(s = {}) ==> AR s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTE_EXTENSOR_IMP_AR THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DUGUNDJI THEN ASM_REWRITE_TAC[]);; let CONVEX_IMP_ANR = prove (`!s:real^N->bool. convex s ==> ANR s`, MESON_TAC[ANR_EMPTY; CONVEX_IMP_AR; AR_IMP_ANR]);; let IS_INTERVAL_IMP_ENR = prove (`!s:real^N->bool. is_interval s ==> ENR s`, SIMP_TAC[ENR_ANR; IS_INTERVAL_IMP_LOCALLY_COMPACT] THEN SIMP_TAC[CONVEX_IMP_ANR; IS_INTERVAL_CONVEX]);; let ENR_CONVEX_CLOSED = prove (`!s:real^N->bool. closed s /\ convex s ==> ENR s`, MESON_TAC[CONVEX_IMP_ANR; ENR_ANR; CLOSED_IMP_LOCALLY_COMPACT]);; let AR_UNIV = prove (`AR(:real^N)`, MESON_TAC[CONVEX_IMP_AR; CONVEX_UNIV; UNIV_NOT_EMPTY]);; let ANR_UNIV = prove (`ANR(:real^N)`, MESON_TAC[CONVEX_IMP_ANR; CONVEX_UNIV]);; let ENR_UNIV = prove (`ENR(:real^N)`, MESON_TAC[ENR_CONVEX_CLOSED; CONVEX_UNIV; CLOSED_UNIV]);; let AR_SING = prove (`!a:real^N. AR {a}`, SIMP_TAC[CONVEX_IMP_AR; CONVEX_SING; NOT_INSERT_EMPTY]);; let ANR_SING = prove (`!a:real^N. ANR {a}`, SIMP_TAC[AR_IMP_ANR; AR_SING]);; let ENR_SING = prove (`!a:real^N. ENR {a}`, SIMP_TAC[ENR_ANR; ANR_SING; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_SING]);; let ANR_OPEN_IN = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s /\ ANR t ==> ANR s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^(N,1)finite_sum->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `w:real^(N,1)finite_sum->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{x | x IN w /\ (g:real^(N,1)finite_sum->real^N) x IN s}` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `w:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_MESON_TAC[]; CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);; let ENR_OPEN_IN = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s /\ ENR t ==> ENR s`, REWRITE_TAC[ENR_ANR] THEN MESON_TAC[ANR_OPEN_IN; LOCALLY_OPEN_SUBSET]);; let ANR_NEIGHBORHOOD_RETRACT = prove (`!s t u:real^N->bool. s retract_of t /\ open_in (subtopology euclidean u) t /\ ANR u ==> ANR s`, MESON_TAC[ANR_OPEN_IN; ANR_RETRACT_OF_ANR]);; let ENR_NEIGHBORHOOD_RETRACT = prove (`!s t u:real^N->bool. s retract_of t /\ open_in (subtopology euclidean u) t /\ ENR u ==> ENR s`, MESON_TAC[ENR_OPEN_IN; ENR_RETRACT_OF_ENR]);; let ANR_RELATIVE_INTERIOR = prove (`!s. ANR(s) ==> ANR(relative_interior s)`, MESON_TAC[OPEN_IN_SET_RELATIVE_INTERIOR; ANR_OPEN_IN]);; let ANR_DELETE = prove (`!s a:real^N. ANR(s) ==> ANR(s DELETE a)`, MESON_TAC[ANR_OPEN_IN; OPEN_IN_DELETE; OPEN_IN_REFL]);; let ENR_RELATIVE_INTERIOR = prove (`!s. ENR(s) ==> ENR(relative_interior s)`, MESON_TAC[OPEN_IN_SET_RELATIVE_INTERIOR; ENR_OPEN_IN]);; let ENR_DELETE = prove (`!s a:real^N. ENR(s) ==> ENR(s DELETE a)`, MESON_TAC[ENR_OPEN_IN; OPEN_IN_DELETE; OPEN_IN_REFL]);; let OPEN_IMP_ENR = prove (`!s:real^N->bool. open s ==> ENR s`, REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN MESON_TAC[ENR_UNIV; ENR_OPEN_IN]);; let OPEN_IMP_ANR = prove (`!s:real^N->bool. open s ==> ANR s`, SIMP_TAC[OPEN_IMP_ENR; ENR_IMP_ANR]);; let ANR_BALL = prove (`!a:real^N r. ANR(ball(a,r))`, MESON_TAC[CONVEX_IMP_ANR; CONVEX_BALL]);; let ENR_BALL = prove (`!a:real^N r. ENR(ball(a,r))`, SIMP_TAC[ENR_ANR; ANR_BALL; OPEN_IMP_LOCALLY_COMPACT; OPEN_BALL]);; let AR_BALL = prove (`!a:real^N r. AR(ball(a,r)) <=> &0 < r`, SIMP_TAC[AR_ANR; BALL_EQ_EMPTY; ANR_BALL; CONVEX_BALL; CONVEX_IMP_CONTRACTIBLE; REAL_NOT_LE]);; let ANR_CBALL = prove (`!a:real^N r. ANR(cball(a,r))`, MESON_TAC[CONVEX_IMP_ANR; CONVEX_CBALL]);; let ENR_CBALL = prove (`!a:real^N r. ENR(cball(a,r))`, SIMP_TAC[ENR_ANR; ANR_CBALL; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_CBALL]);; let AR_CBALL = prove (`!a:real^N r. AR(cball(a,r)) <=> &0 <= r`, SIMP_TAC[AR_ANR; CBALL_EQ_EMPTY; ANR_CBALL; CONVEX_CBALL; CONVEX_IMP_CONTRACTIBLE; REAL_NOT_LT]);; let ANR_INTERVAL = prove (`(!a b:real^N. ANR(interval[a,b])) /\ (!a b:real^N. ANR(interval(a,b)))`, SIMP_TAC[CONVEX_IMP_ANR; CONVEX_INTERVAL; CLOSED_INTERVAL; OPEN_IMP_ANR; OPEN_INTERVAL]);; let ENR_INTERVAL = prove (`(!a b:real^N. ENR(interval[a,b])) /\ (!a b:real^N. ENR(interval(a,b)))`, SIMP_TAC[ENR_CONVEX_CLOSED; CONVEX_INTERVAL; CLOSED_INTERVAL; OPEN_IMP_ENR; OPEN_INTERVAL]);; let AR_INTERVAL = prove (`(!a b:real^N. AR(interval[a,b]) <=> ~(interval[a,b] = {})) /\ (!a b:real^N. AR(interval(a,b)) <=> ~(interval(a,b) = {}))`, SIMP_TAC[AR_ANR; ANR_INTERVAL; CONVEX_IMP_CONTRACTIBLE; CONVEX_INTERVAL]);; let ANR_INTERIOR = prove (`!s. ANR(interior s)`, SIMP_TAC[OPEN_INTERIOR; OPEN_IMP_ANR]);; let ENR_INTERIOR = prove (`!s. ENR(interior s)`, SIMP_TAC[OPEN_INTERIOR; OPEN_IMP_ENR]);; let AR_IMP_CONTRACTIBLE = prove (`!s:real^N->bool. AR s ==> contractible s`, SIMP_TAC[AR_ANR]);; let AR_IMP_PATH_CONNECTED = prove (`!s:real^N->bool. AR s ==> path_connected s`, MESON_TAC[AR_IMP_CONTRACTIBLE; CONTRACTIBLE_IMP_PATH_CONNECTED]);; let AR_IMP_CONNECTED = prove (`!s:real^N->bool. AR s ==> connected s`, MESON_TAC[AR_IMP_CONTRACTIBLE; CONTRACTIBLE_IMP_CONNECTED]);; let ENR_IMP_LOCALLY_COMPACT = prove (`!s:real^N->bool. ENR s ==> locally compact s`, SIMP_TAC[ENR_ANR]);; let ANR_IMP_LOCALLY_PATH_CONNECTED = prove (`!s:real^N->bool. ANR s ==> locally path_connected s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c s':real^(N,1)finite_sum->bool. convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ (s:real^N->bool) homeomorphic s'` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN DISCH_THEN(MP_TAC o SPECL [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM; HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS; RETRACT_OF_LOCALLY_PATH_CONNECTED; CONVEX_IMP_LOCALLY_PATH_CONNECTED; LOCALLY_OPEN_SUBSET]);; let ANR_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. ANR s ==> locally connected s`, SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; let AR_IMP_LOCALLY_PATH_CONNECTED = prove (`!s:real^N->bool. AR s ==> locally path_connected s`, SIMP_TAC[AR_IMP_ANR; ANR_IMP_LOCALLY_PATH_CONNECTED]);; let AR_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. AR s ==> locally connected s`, SIMP_TAC[AR_IMP_LOCALLY_PATH_CONNECTED; LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; let ENR_IMP_LOCALLY_PATH_CONNECTED = prove (`!s:real^N->bool. ENR s ==> locally path_connected s`, SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; ENR_IMP_ANR]);; let ENR_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. ENR s ==> locally connected s`, SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; ENR_IMP_ANR]);; let COUNTABLE_ANR_COMPONENTS = prove (`!s:real^N->bool. ANR s ==> COUNTABLE(components s)`, SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; COUNTABLE_COMPONENTS]);; let COUNTABLE_ANR_CONNECTED_COMPONENTS = prove (`!s:real^N->bool t. ANR s ==> COUNTABLE {connected_component s x | x IN t}`, SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; COUNTABLE_CONNECTED_COMPONENTS]);; let COUNTABLE_ANR_PATH_COMPONENTS = prove (`!s:real^N->bool t. ANR s ==> COUNTABLE {path_component s x | x IN t}`, SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; COUNTABLE_PATH_COMPONENTS]);; let FINITE_ANR_COMPONENTS = prove (`!s:real^N->bool. ANR s /\ compact s ==> FINITE(components s)`, SIMP_TAC[FINITE_COMPONENTS; ANR_IMP_LOCALLY_CONNECTED]);; let FINITE_ENR_COMPONENTS = prove (`!s:real^N->bool. ENR s /\ compact s ==> FINITE(components s)`, SIMP_TAC[FINITE_COMPONENTS; ENR_IMP_LOCALLY_CONNECTED]);; let ANR_PCROSS = prove (`!s:real^M->bool t:real^N->bool. ANR s /\ ANR t ==> ANR(s PCROSS t)`, REPEAT STRIP_TAC THEN SIMP_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN MAP_EVERY X_GEN_TAC [`f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum`; `u:real^((M,N)finite_sum,1)finite_sum->bool`; `c:real^((M,N)finite_sum,1)finite_sum->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`fstcart o (f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum)`; `u:real^((M,N)finite_sum,1)finite_sum->bool`; `c:real^((M,N)finite_sum,1)finite_sum->bool`; `s:real^M->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN MP_TAC(ISPECL [`sndcart o (f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum)`; `u:real^((M,N)finite_sum,1)finite_sum->bool`; `c:real^((M,N)finite_sum,1)finite_sum->bool`; `t:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; IMAGE_o] THEN RULE_ASSUM_TAC (REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; PCROSS; IN_ELIM_THM]) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[SNDCART_PASTECART]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`w2:real^((M,N)finite_sum,1)finite_sum->bool`; `h:real^((M,N)finite_sum,1)finite_sum->real^N`] THEN STRIP_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[FSTCART_PASTECART]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`w1:real^((M,N)finite_sum,1)finite_sum->bool`; `g:real^((M,N)finite_sum,1)finite_sum->real^M`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w1 INTER w2:real^((M,N)finite_sum,1)finite_sum->bool`; `\x:real^((M,N)finite_sum,1)finite_sum. pastecart (g x:real^M) (h x:real^N)`] THEN ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER; o_DEF; PASTECART_IN_PCROSS; PASTECART_FST_SND] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);; let ANR_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. ANR(s PCROSS t) <=> s = {} \/ t = {} \/ ANR s /\ ANR t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; ANR_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; ANR_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[ANR_PCROSS] THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `ANR ((s:real^M->bool) PCROSS {b:real^N})` MP_TAC THENL [ALL_TAC; MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_ANRNESS]]; UNDISCH_TAC `~(s:real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `ANR ({a:real^M} PCROSS (t:real^N->bool))` MP_TAC THENL [ALL_TAC; MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_ANRNESS]]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ANR_RETRACT_OF_ANR)) THEN REWRITE_TAC[retract_of; retraction] THENL [EXISTS_TAC`\x:real^(M,N)finite_sum. pastecart (fstcart x) (b:real^N)`; EXISTS_TAC`\x:real^(M,N)finite_sum. pastecart (a:real^M) (sndcart x)`] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE; IN_SING; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS; CONTINUOUS_ON_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST]);; let AR_PCROSS = prove (`!s:real^M->bool t:real^N->bool. AR s /\ AR t ==> AR(s PCROSS t)`, SIMP_TAC[AR_ANR; ANR_PCROSS; CONTRACTIBLE_PCROSS; PCROSS_EQ_EMPTY]);; let ENR_PCROSS = prove (`!s:real^M->bool t:real^N->bool. ENR s /\ ENR t ==> ENR(s PCROSS t)`, SIMP_TAC[ENR_ANR; ANR_PCROSS; LOCALLY_COMPACT_PCROSS]);; let ENR_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. ENR(s PCROSS t) <=> s = {} \/ t = {} \/ ENR s /\ ENR t`, REWRITE_TAC[ENR_ANR; ANR_PCROSS_EQ; LOCALLY_COMPACT_PCROSS_EQ] THEN CONV_TAC TAUT);; let AR_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. AR(s PCROSS t) <=> AR s /\ AR t /\ ~(s = {}) /\ ~(t = {})`, SIMP_TAC[AR_ANR; ANR_PCROSS_EQ; CONTRACTIBLE_PCROSS_EQ; PCROSS_EQ_EMPTY] THEN CONV_TAC TAUT);; let AR_CLOSED_UNION_LOCAL = prove (`!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ AR(s) /\ AR(t) /\ AR(s INTER t) ==> AR(s UNION t)`, let lemma = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ AR s /\ AR t /\ AR(s INTER t) ==> (s UNION t) retract_of u`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL [ASM_MESON_TAC[NOT_AR_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ t SUBSET u` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`s' = {x:real^N | x IN u /\ setdist({x},s) <= setdist({x},t)}`; `t' = {x:real^N | x IN u /\ setdist({x},t) <= setdist({x},s)}`; `w = {x:real^N | x IN u /\ setdist({x},s) = setdist({x},t)}`] THEN SUBGOAL_THEN `closed_in (subtopology euclidean u) (s':real^N->bool) /\ closed_in (subtopology euclidean u) (t':real^N->bool)` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[GSYM LIFT_DROP] THEN REWRITE_TAC[SET_RULE `a <= drop(lift x) <=> lift x IN {x | a <= drop x}`] THEN REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN SIMP_TAC[CLOSED_SING; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST; drop; CLOSED_HALFSPACE_COMPONENT_LE; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; ALL_TAC] THEN SUBGOAL_THEN `(s:real^N->bool) SUBSET s' /\ (t:real^N->bool) SUBSET t'` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; SETDIST_POS_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(s INTER t:real^N->bool) retract_of w` MP_TAC THENL [MATCH_MP_TAC AR_IMP_ABSOLUTE_RETRACT THEN EXISTS_TAC `s INTER t:real^N->bool` THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER] THEN CONJ_TAC THENL [EXPAND_TAC "w"; ASM SET_TAC[]] THEN SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; SETDIST_SING_IN_SET] THEN ASM SET_TAC[]; GEN_REWRITE_TAC LAND_CONV [retract_of] THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r0:real^N->real^N` THEN STRIP_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN w ==> (x IN s <=> x IN t)` ASSUME_TAC THENL [EXPAND_TAC "w" THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN(fun th -> EQ_TAC THEN DISCH_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `&0 = setdist p <=> setdist p = &0`] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (p <=> s = {} \/ x IN s) ==> p ==> x IN s`) THEN (CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC SETDIST_EQ_0_CLOSED_IN]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s' INTER t':real^N->bool = w` ASSUME_TAC THENL [ASM SET_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN SUBGOAL_THEN `closed_in (subtopology euclidean u) (w:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_INTER]; ALL_TAC] THEN ABBREV_TAC `r = \x:real^N. if x IN w then r0 x else x` THEN SUBGOAL_THEN `IMAGE (r:real^N->real^N) (w UNION s) SUBSET s /\ IMAGE (r:real^N->real^N) (w UNION t) SUBSET t` STRIP_ASSUME_TAC THENL [EXPAND_TAC "r" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(r:real^N->real^N) continuous_on (w UNION s UNION t)` ASSUME_TAC THENL [EXPAND_TAC "r" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_UNION] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?g:real^N->real^N. g continuous_on u /\ IMAGE g u SUBSET s /\ !x. x IN w UNION s ==> g x = r x` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC AR_IMP_ABSOLUTE_EXTENSOR THEN ASM_SIMP_TAC[CLOSED_IN_UNION] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; IN_UNION]; ALL_TAC] THEN SUBGOAL_THEN `?h:real^N->real^N. h continuous_on u /\ IMAGE h u SUBSET t /\ !x. x IN w UNION t ==> h x = r x` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC AR_IMP_ABSOLUTE_EXTENSOR THEN ASM_SIMP_TAC[CLOSED_IN_UNION] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; IN_UNION]; ALL_TAC] THEN REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `\x. if x IN s' then (g:real^N->real^N) x else h x` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNION] THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THEN ASM_SIMP_TAC[IN_UNION; COND_ID] THENL [COND_CASES_TAC THENL [EXPAND_TAC "r"; ASM SET_TAC[]]; COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN TRANS_TAC EQ_TRANS `(r:real^N->real^N) x` THEN CONJ_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "r"]] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `u:real^N->bool = s' UNION t'` (fun th -> ONCE_REWRITE_TAC[th] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REWRITE_TAC[GSYM th]) THENL [ASM SET_TAC[REAL_LE_TOTAL]; ASM_SIMP_TAC[]] THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]) THEN REWRITE_TAC[TAUT `p /\ ~p \/ q /\ p <=> p /\ q`] THEN ASM_SIMP_TAC[GSYM IN_INTER; IN_UNION]) in REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN MAP_EVERY X_GEN_TAC [`u:real^(N,1)finite_sum->bool`; `c:real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `closed_in (subtopology euclidean u) {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} /\ closed_in (subtopology euclidean u) {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t}` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `c:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]; ALL_TAC] THEN SUBGOAL_THEN `{x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} UNION {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t} = c` (fun th -> SUBST1_TAC(SYM th)) THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `AR(s:real^N->bool)`; UNDISCH_TAC `AR(t:real^N->bool)`; UNDISCH_TAC `AR(s INTER t:real^N->bool)`] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* General ANR union lemma (Kuratowski). *) (* ------------------------------------------------------------------------- *) let ANR_UNION_EXTENSION_LEMMA = prove (`!f:real^M->real^N s t u s1 s2 u1 u2. f continuous_on t /\ IMAGE f t SUBSET u /\ ANR u1 /\ ANR u2 /\ ANR(u1 INTER u2) /\ u1 UNION u2 = u /\ closed_in (subtopology euclidean s) t /\ closed_in (subtopology euclidean s) s1 /\ closed_in (subtopology euclidean s) s2 /\ s1 UNION s2 = s /\ IMAGE f (t INTER s1) SUBSET u1 /\ IMAGE f (t INTER s2) SUBSET u2 ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean s) v /\ g continuous_on v /\ IMAGE g v SUBSET u /\ !x. x IN t ==> g x = f x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?v v' h. t INTER s1 INTER s2 SUBSET v /\ v SUBSET v' /\ open_in (subtopology euclidean (s1 INTER s2)) v /\ closed_in (subtopology euclidean (s1 INTER s2)) v' /\ h continuous_on v' /\ IMAGE h v' SUBSET u1 INTER u2 /\ !x. x IN v' INTER t ==> (h:real^M->real^N) x = f x` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t INTER s1 INTER s2:real^M->bool`; `u1 INTER u2:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_SIMP_TAC[CLOSED_IN_INTER] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`t INTER s1 INTER s2:real^M->bool`; `s DIFF v:real^M->bool`; `s:real^M->bool`] SEPARATION_NORMAL_LOCAL) THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `w':real^M->bool`] THEN STRIP_TAC THEN EXISTS_TAC `(s1 INTER s2) INTER w:real^M->bool` THEN EXISTS_TAC `(s1 INTER s2) DIFF w':real^M->bool` THEN EXISTS_TAC `g:real^M->real^N` THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL] THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]; ALL_TAC] THEN ABBREV_TAC `k:real^M->bool = (s1 INTER s2) DIFF v` THEN SUBGOAL_THEN `closed_in (subtopology euclidean (s1 INTER s2)) (k:real^M->bool)` ASSUME_TAC THENL [EXPAND_TAC "k" THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]; ALL_TAC] THEN SUBGOAL_THEN `closed_in (subtopology euclidean s) (k:real^M->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_INTER]; ALL_TAC] THEN SUBGOAL_THEN `k INTER t:real^M->bool = {}` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\i. if i = 0 then (f:real^M->real^N) else h`; `\i. if i = 0 then t INTER s2:real^M->bool else v'`; `(t INTER s2) UNION v':real^M->bool`; `{0,1}`; `(:real^N)`] PASTING_LEMMA_EXISTS_CLOSED) THEN MP_TAC(ISPECL [`\i. if i = 0 then (f:real^M->real^N) else h`; `\i. if i = 0 then t INTER s1:real^M->bool else v'`; `(t INTER s1) UNION v':real^M->bool`; `{0,1}`; `(:real^N)`] PASTING_LEMMA_EXISTS_CLOSED) THEN REWRITE_TAC[SUBSET_UNIV] THEN MAP_EVERY (fun x -> REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN ANTS_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_2] THEN ASM_REWRITE_TAC[ARITH_EQ; SUBSET_REFL; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[] `u INTER s = s /\ closed_in (subtopology top u) (u INTER s) ==> closed_in (subtopology top u) s`) THEN (CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN TRY(CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_INTER; CLOSED_IN_REFL]; ALL_TAC]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ONCE_REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[ARITH_RULE `m < n /\ (m = 0 \/ m = 1) /\ (n = 0 \/ n = 1) <=> m = 0 /\ n = 1`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN ASM SET_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [FORALL_IN_INSERT; NOT_IN_EMPTY; ARITH_EQ] THEN REWRITE_TAC[SET_RULE `(s UNION t) INTER s = s /\ (s UNION t) INTER t = t`] THEN DISCH_THEN(X_CHOOSE_THEN x STRIP_ASSUME_TAC)]) [`f1:real^M->real^N`; `f2:real^M->real^N`] THEN MP_TAC(ISPECL [`f1:real^M->real^N`; `s:real^M->bool`; `t INTER s1 UNION v':real^M->bool`; `u1:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_INTER]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v1:real^M->bool`; `g1:real^M->real^N`] THEN STRIP_TAC] THEN MP_TAC(ISPECL [`f2:real^M->real^N`; `s:real^M->bool`; `t INTER s2 UNION v':real^M->bool`; `u2:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_INTER]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v2:real^M->bool`; `g2:real^M->real^N`] THEN STRIP_TAC] THEN MAP_EVERY ABBREV_TAC [`w1:real^M->bool = s1 DIFF v1`; `w2:real^M->bool = s2 DIFF v2`] THEN SUBGOAL_THEN `closed_in (subtopology euclidean s) (w1:real^M->bool) /\ closed_in (subtopology euclidean s) (w2:real^M->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_DIFF]; ALL_TAC] THEN SUBGOAL_THEN `t INTER w1 = {} /\ v' INTER w1:real^M->bool = {} /\ t INTER w2 = {} /\ v' INTER w2 = {}` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `n:real^M->bool = s DIFF (k UNION w1 UNION w2)` THEN EXISTS_TAC `n:real^M->bool` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [EXPAND_TAC "n" THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[OPEN_IN_REFL; CLOSED_IN_UNION]; DISCH_TAC] THEN MP_TAC(ISPECL [`\i. if i = 0 then (g1:real^M->real^N) else g2`; `\i. if i = 0 then s1 INTER n:real^M->bool else s2 INTER n`; `n:real^M->bool`; `{0,1}`; `(:real^N)`] PASTING_LEMMA_EXISTS_CLOSED) THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; SUBSET_UNIV] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IMP_CONJ] THEN REWRITE_TAC[ARITH_EQ; IMP_IMP; FORALL_AND_THM] THEN ANTS_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_2; GSYM CONJ_ASSOC] THEN REWRITE_TAC[ARITH_EQ] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ONCE_REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[ARITH_RULE `m < n /\ (m = 0 \/ m = 1) /\ (n = 0 \/ n = 1) <=> m = 0 /\ n = 1`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^M) IN v` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':real^M->real^N` THEN REWRITE_TAC[SET_RULE `n INTER s INTER n = n INTER s`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN (SUBGOAL_THEN `(x:real^M) IN s1 \/ x IN s2` MP_TAC THENL [ASM SET_TAC[]; STRIP_TAC THEN ASM_SIMP_TAC[IN_INTER] THEN ASM SET_TAC[]])]);; (* ------------------------------------------------------------------------- *) (* Application to closed union. *) (* ------------------------------------------------------------------------- *) let ANR_CLOSED_UNION_LOCAL = prove (`!s t:real^N->bool u. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ ANR(s) /\ ANR(t) /\ ANR(s INTER t) ==> ANR(s UNION t)`, MAP_EVERY X_GEN_TAC [`y1:real^N->bool`; `y2:real^N->bool`; `yn:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `closed_in (subtopology euclidean (y1 UNION y2)) (y1:real^N->bool) /\ closed_in (subtopology euclidean (y1 UNION y2)) (y2:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_SUBSET_TRANS; SUBSET_UNION; UNION_SUBSET; CLOSED_IN_IMP_SUBSET]; REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `yn:real^N->bool` o concl)))] THEN MATCH_MP_TAC ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR THEN MAP_EVERY X_GEN_TAC [`f:real^(N,1)finite_sum->real^N`; `s:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN ASM_CASES_TAC `IMAGE (f:real^(N,1)finite_sum->real^N) t SUBSET y1` THENL [MP_TAC(ISPECL [`f:real^(N,1)finite_sum->real^N`; `s:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`; `y1:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS) THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `IMAGE (f:real^(N,1)finite_sum->real^N) t SUBSET y2` THENL [MP_TAC(ISPECL [`f:real^(N,1)finite_sum->real^N`; `s:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`; `y2:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS) THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC ANR_UNION_EXTENSION_LEMMA THEN MAP_EVERY ABBREV_TAC [`b1 = {x | x IN s /\ setdist({x}, {x | x IN t /\ (f:real^(N,1)finite_sum->real^N) x IN y1}) <= setdist({x},{x | x IN t /\ f x IN y2})}`; `b2 = {x | x IN s /\ setdist({x}, {x | x IN t /\ (f:real^(N,1)finite_sum->real^N) x IN y2}) <= setdist({x},{x | x IN t /\ f x IN y1})}`] THEN MAP_EVERY EXISTS_TAC [`b1:real^(N,1)finite_sum->bool`; `b2:real^(N,1)finite_sum->bool`; `y1:real^N->bool`; `y2:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THENL [EXPAND_TAC "b1"; EXPAND_TAC "b2"] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP; REAL_SUB_LE] `x <= y <=> &0 <= drop(lift(y - x))`] THEN ONCE_REWRITE_TAC[SET_RULE `&0 <= drop x <=> x IN {y | &0 <= drop y}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST; CONTINUOUS_ON_CONST]; ALL_TAC] THEN CONJ_TAC THENL [MAP_EVERY EXPAND_TAC ["b1"; "b2"] THEN MP_TAC REAL_LE_TOTAL THEN SET_TAC[]; ALL_TAC] THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER] THEN MAP_EVERY EXPAND_TAC ["b1"; "b2"] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THENL [SUBGOAL_THEN `(f:real^(N,1)finite_sum->real^N) x IN y2` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `(f:real^(N,1)finite_sum->real^N) x IN y1` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LT]) THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_ELIM_THM] THEN REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[SETDIST_POS_LE] THEN MP_TAC(ISPEC `s:real^(N,1)finite_sum->bool` SETDIST_EQ_0_CLOSED_IN) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN (ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `t:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `y1 UNION y2:real^N->bool` THEN ASM_REWRITE_TAC[]);; let ENR_CLOSED_UNION_LOCAL = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ ENR(s) /\ ENR(t) /\ ENR(s INTER t) ==> ENR(s UNION t)`, REWRITE_TAC[ENR_ANR] THEN MESON_TAC[ANR_CLOSED_UNION_LOCAL; LOCALLY_COMPACT_CLOSED_UNION]);; let AR_CLOSED_UNION = prove (`!s t:real^N->bool. closed s /\ closed t /\ AR(s) /\ AR(t) /\ AR(s INTER t) ==> AR(s UNION t)`, MESON_TAC[AR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);; let ANR_CLOSED_UNION = prove (`!s t:real^N->bool. closed s /\ closed t /\ ANR(s) /\ ANR(t) /\ ANR(s INTER t) ==> ANR(s UNION t)`, MESON_TAC[ANR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);; let ENR_CLOSED_UNION = prove (`!s t:real^N->bool. closed s /\ closed t /\ ENR(s) /\ ENR(t) /\ ENR(s INTER t) ==> ENR(s UNION t)`, MESON_TAC[ENR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);; let ABSOLUTE_RETRACT_UNION = prove (`!s t. s retract_of (:real^N) /\ t retract_of (:real^N) /\ (s INTER t) retract_of (:real^N) ==> (s UNION t) retract_of (:real^N)`, SIMP_TAC[RETRACT_OF_UNIV; AR_CLOSED_UNION; CLOSED_UNION]);; let RETRACT_FROM_UNION_AND_INTER = prove (`!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ (s UNION t) retract_of u /\ (s INTER t) retract_of t ==> s retract_of u`, REPEAT STRIP_TAC THEN UNDISCH_TAC `(s UNION t) retract_of (u:real^N->bool)` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] RETRACT_OF_TRANS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; retract_of] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^N. if x IN s then x else r x` THEN SIMP_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM SET_TAC[]);; let AR_FROM_UNION_AND_INTER_LOCAL = prove (`!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ AR(s UNION t) /\ AR(s INTER t) ==> AR(s) /\ AR(t)`, SUBGOAL_THEN `!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ AR(s UNION t) /\ AR(s INTER t) ==> AR(s)` MP_TAC THENL [ALL_TAC; MESON_TAC[UNION_COMM; INTER_COMM]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC AR_RETRACT_OF_AR THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RETRACT_FROM_UNION_AND_INTER THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[RETRACT_OF_REFL] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN REWRITE_TAC[INTER_SUBSET; SUBSET_UNION] THEN MATCH_MP_TAC AR_IMP_RETRACT THEN ASM_SIMP_TAC[CLOSED_IN_INTER]);; let AR_FROM_UNION_AND_INTER = prove (`!s t:real^N->bool. closed s /\ closed t /\ AR(s UNION t) /\ AR(s INTER t) ==> AR(s) /\ AR(t)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC AR_FROM_UNION_AND_INTER_LOCAL THEN ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);; let ANR_FROM_UNION_AND_INTER_LOCAL = prove (`!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ ANR(s UNION t) /\ ANR(s INTER t) ==> ANR(s) /\ ANR(t)`, SUBGOAL_THEN `!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ ANR(s UNION t) /\ ANR(s INTER t) ==> ANR(s)` MP_TAC THENL [ALL_TAC; MESON_TAC[UNION_COMM; INTER_COMM]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_NEIGHBORHOOD_RETRACT THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s INTER t:real^N->bool`; `s UNION t:real^N->bool`] ANR_IMP_NEIGHBOURHOOD_RETRACT) THEN ASM_SIMP_TAC[CLOSED_IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN EXISTS_TAC `s UNION u:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; SUBGOAL_THEN `s UNION u:real^N->bool = ((s UNION t) DIFF t) UNION u` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[OPEN_IN_UNION; OPEN_IN_DIFF; OPEN_IN_REFL]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retract_of; retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. if x IN s then x else r x` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `s UNION u:real^N->bool = s UNION (u INTER t)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]] THEN CONJ_TAC THENL [UNDISCH_TAC `closed_in(subtopology euclidean (s UNION t)) (s:real^N->bool)`; UNDISCH_TAC `closed_in(subtopology euclidean (s UNION t)) (t:real^N->bool)`] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let ANR_FROM_UNION_AND_INTER = prove (`!s t:real^N->bool. closed s /\ closed t /\ ANR(s UNION t) /\ ANR(s INTER t) ==> ANR(s) /\ ANR(t)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC ANR_FROM_UNION_AND_INTER_LOCAL THEN ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);; let ANR_FINITE_UNIONS_CONVEX_CLOSED = prove (`!t:(real^N->bool)->bool. FINITE t /\ (!c. c IN t ==> closed c /\ convex c) ==> ANR(UNIONS t)`, GEN_TAC THEN WF_INDUCT_TAC `CARD(t:(real^N->bool)->bool)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[TAUT `p ==> q /\ r ==> s <=> q ==> p ==> r ==> s`] THEN SPEC_TAC(`t:(real^N->bool)->bool`,`t:(real^N->bool)->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; FORALL_IN_INSERT] THEN REWRITE_TAC[ANR_EMPTY] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `t:(real^N->bool)->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) STRIP_ASSUME_TAC) THEN REWRITE_TAC[IMP_IMP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_CLOSED_UNION THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN ASM_SIMP_TAC[CONVEX_IMP_ANR] THEN REWRITE_TAC[INTER_UNIONS] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN REWRITE_TAC[FORALL_IN_GSPEC; LT_SUC_LE; LE_REFL] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; CLOSED_INTER; CONVEX_INTER] THEN ASM_SIMP_TAC[CARD_IMAGE_LE]);; let FINITE_IMP_ANR = prove (`!s:real^N->bool. FINITE s ==> ANR s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s = UNIONS {{a:real^N} | a IN s}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; MATCH_MP_TAC ANR_FINITE_UNIONS_CONVEX_CLOSED THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; SIMPLE_IMAGE; FINITE_IMAGE] THEN REWRITE_TAC[CLOSED_SING; CONVEX_SING]]);; let ANR_INSERT = prove (`!s a:real^N. closed s /\ ANR s ==> ANR(a INSERT s)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN MATCH_MP_TAC ANR_CLOSED_UNION THEN ASM_MESON_TAC[CLOSED_SING; ANR_SING; ANR_EMPTY; SET_RULE `{a} INTER s = {a} \/ {a} INTER s = {}`]);; let ANR_TRIANGULATION = prove (`!tr. triangulation tr ==> ANR(UNIONS tr)`, REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_FINITE_UNIONS_CONVEX_CLOSED THEN ASM_MESON_TAC[CLOSED_SIMPLEX; CONVEX_SIMPLEX]);; let ANR_SIMPLICIAL_COMPLEX = prove (`!c. simplicial_complex c ==> ANR(UNIONS c)`, MESON_TAC[ANR_TRIANGULATION; SIMPLICIAL_COMPLEX_IMP_TRIANGULATION]);; let ANR_PATH_COMPONENT_ANR = prove (`!s x:real^N. ANR(s) ==> ANR(path_component s x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ANR_OPEN_IN)) THEN MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN ASM_SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED]);; let ANR_CONNECTED_COMPONENT_ANR = prove (`!s x:real^N. ANR(s) ==> ANR(connected_component s x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ANR_OPEN_IN)) THEN MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN ASM_SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED]);; let ANR_COMPONENT_ANR = prove (`!s:real^N->bool. ANR s /\ c IN components s ==> ANR c`, REWRITE_TAC[IN_COMPONENTS] THEN MESON_TAC[ANR_CONNECTED_COMPONENT_ANR]);; (* ------------------------------------------------------------------------- *) (* Application to open union. *) (* ------------------------------------------------------------------------- *) let ANR_OPEN_UNION = prove (`!s t u:real^N->bool. open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t /\ ANR(s) /\ ANR(t) ==> ANR(s UNION t)`, MAP_EVERY X_GEN_TAC [`u1:real^N->bool`; `u2:real^N->bool`; `un:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `open_in (subtopology euclidean (u1 UNION u2)) (u1:real^N->bool) /\ open_in (subtopology euclidean (u1 UNION u2)) (u2:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_SUBSET_TRANS; SUBSET_UNION; UNION_SUBSET; OPEN_IN_IMP_SUBSET]; REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `un:real^N->bool` o concl)))] THEN MATCH_MP_TAC ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR THEN MAP_EVERY X_GEN_TAC [`f:real^(N,1)finite_sum->real^N`; `s:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC ANR_UNION_EXTENSION_LEMMA THEN MAP_EVERY ABBREV_TAC [`t1 = {x | x IN t /\ ~((f:real^(N,1)finite_sum->real^N)(x) IN u1)}`; `t2 = {x | x IN t /\ ~((f:real^(N,1)finite_sum->real^N)(x) IN u2)}`] THEN MP_TAC(ISPECL [`t1:real^(N,1)finite_sum->bool`; `t2:real^(N,1)finite_sum->bool`; `s:real^(N,1)finite_sum->bool`; `vec 1:real^1`; `vec 0:real^1`] URYSOHN_LOCAL) THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `t:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THENL [EXPAND_TAC "t1"; EXPAND_TAC "t2"] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC [MATCH_MP (SET_RULE `IMAGE f s SUBSET t ==> {x | x IN s /\ ~(f x IN u)} = {x | x IN s /\ f x IN t DIFF u}`) th]) THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `u1 UNION u2:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]; DISCH_THEN(X_CHOOSE_THEN `l:real^(N,1)finite_sum->real^1` STRIP_ASSUME_TAC)] THEN MAP_EVERY EXISTS_TAC [`{ x:real^(N,1)finite_sum | x IN s /\ l x IN {y | drop y <= &1 / &2}}`; `{ x:real^(N,1)finite_sum | x IN s /\ l x IN {y | drop y >= &1 / &2}}`; `u1:real^N->bool`; `u2:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ANR_OPEN_IN THEN EXISTS_TAC `u1:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `u1 UNION u2:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL] THEN SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_GE]; MP_TAC(REAL_ARITH `!x. x <= &1 / &2 \/ x >= &1 / &2`) THEN SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `(x:real^(N,1)finite_sum) IN t1` THENL [ASM_SIMP_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ASM SET_TAC[]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `(x:real^(N,1)finite_sum) IN t2` THENL [ASM_SIMP_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ASM SET_TAC[]]]);; let ENR_OPEN_UNION = prove (`!s t u:real^N->bool. open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t /\ ENR(s) /\ ENR(t) ==> ENR(s UNION t)`, REWRITE_TAC[ENR_ANR] THEN ASM_MESON_TAC[ANR_OPEN_UNION; LOCALLY_COMPACT_OPEN_UNION]);; let ANR_OPEN_UNIONS = prove (`!f:(real^N->bool)->bool u. (!s. s IN f ==> ANR s) /\ (!s. s IN f ==> open_in (subtopology euclidean u) s) ==> ANR(UNIONS f)`, let lemma1 = prove (`!f:(real^N->bool)->bool. pairwise DISJOINT f /\ (!u. u IN f ==> ANR u) /\ (!u. u IN f ==> open_in (subtopology euclidean (UNIONS f)) u) ==> ANR(UNIONS f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR THEN MAP_EVERY X_GEN_TAC [`g:real^(N,1)finite_sum->real^N`; `s:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ABBREV_TAC `a = \u. {x | x IN t /\ (g:real^(N,1)finite_sum->real^N) x IN u}` THEN ASM_CASES_TAC `?u. u IN f /\ (a:(real^N->bool)->real^(N,1)finite_sum->bool) u = t` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `ANR(u:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o ISPEC `g:real^(N,1)finite_sum->real^N` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR)) THEN DISCH_THEN(MP_TAC o SPECL [`s:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [UNDISCH_TAC `(a:(real^N->bool)->real^(N,1)finite_sum->bool) u = t` THEN EXPAND_TAC "a" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM SET_TAC[]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!u. u IN f ==> closed_in (subtopology euclidean s) ((a:(real^N->bool)->real^(N,1)finite_sum->bool) u)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "a" THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `t:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `UNIONS f:real^N->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `u:real^N->bool = UNIONS f DIFF UNIONS(f DELETE u)` SUBST1_TAC THENL [ASM_SIMP_TAC[DIFF_UNIONS_PAIRWISE_DISJOINT; DELETE_SUBSET] THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM_SIMP_TAC[IN_DELETE]]; ALL_TAC] THEN SUBGOAL_THEN `pairwise (\i j. DISJOINT ((a:(real^N->bool)->real^(N,1)finite_sum->bool) i) (a j)) f` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN EXPAND_TAC "a" THEN REWRITE_TAC[pairwise] THEN SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `v = \u. if a u = {} then {} else { x:real^(N,1)finite_sum | x IN s /\ setdist({x},a(u:real^N->bool)) < setdist({x},t DIFF a u)}` THEN SUBGOAL_THEN `!u. u IN f ==> open_in (subtopology euclidean s) ((v:(real^N->bool)->real^(N,1)finite_sum->bool) u)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "v" THEN COND_CASES_TAC THEN REWRITE_TAC[OPEN_IN_EMPTY] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP; REAL_SUB_LT] `x < y <=> &0 < drop(lift(y - x))`] THEN ONCE_REWRITE_TAC[SET_RULE `&0 < drop x <=> x IN {y | &0 < drop y}`] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN REWRITE_TAC[drop; GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; ALL_TAC] THEN SUBGOAL_THEN `!u. u IN f ==> (a:(real^N->bool)->real^(N,1)finite_sum->bool) u SUBSET v u` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN SIMP_TAC[IN_ELIM_THM; SETDIST_SING_IN_SET; SUBSET] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[SETDIST_POS_LE] THEN MP_TAC(ISPEC `t:real^(N,1)finite_sum->bool` SETDIST_EQ_0_CLOSED_IN) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN EXPAND_TAC "a" THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `UNIONS f:real^N->bool` THEN ASM_SIMP_TAC[]; UNDISCH_TAC `x IN (a:(real^N->bool)->real^(N,1)finite_sum->bool) u` THEN EXPAND_TAC "a" THEN SIMP_TAC[IN_ELIM_THM]]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s = t) ==> ~(t DIFF s = {})`) THEN CONJ_TAC THENL [EXPAND_TAC "a" THEN SET_TAC[]; ASM_MESON_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `pairwise (\i j. DISJOINT ((v:(real^N->bool)->real^(N,1)finite_sum->bool) i) (v j)) f` ASSUME_TAC THENL [EXPAND_TAC "v" THEN REWRITE_TAC[pairwise] THEN MAP_EVERY X_GEN_TAC [`u1:real^N->bool`; `u2:real^N->bool`] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DISJOINT_EMPTY]) THEN STRIP_TAC THEN REWRITE_TAC[DISJOINT; EXTENSION] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY; IN_INTER] THEN ASM_CASES_TAC `(x:real^(N,1)finite_sum) IN s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `b <= c /\ d <= a ==> ~(a < b /\ c < d)`) THEN CONJ_TAC THEN MATCH_MP_TAC SETDIST_SUBSET_RIGHT THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ DISJOINT s u ==> s SUBSET t DIFF u`) THEN (CONJ_TAC THENL [EXPAND_TAC "a" THEN SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[pairwise]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!u. u IN (f:(real^N->bool)->bool) ==> ?v h. a u SUBSET v /\ open_in (subtopology euclidean s) v /\ (h:real^(N,1)finite_sum->real^N) continuous_on v /\ IMAGE h v SUBSET u /\ (!x. x IN a u ==> h x = g x)` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "a" THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; ASM SET_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`w:(real^N->bool)->real^(N,1)finite_sum->bool`; `h:(real^N->bool)->real^(N,1)finite_sum->real^N`] THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:(real^N->bool)->real^(N,1)finite_sum->real^N`; `\u. v u INTER (w:(real^N->bool)->real^(N,1)finite_sum->bool) u`; `UNIONS(IMAGE (\u. v u INTER (w:(real^N->bool)->real^(N,1)finite_sum->bool) u) f)`; `f:(real^N->bool)->bool`; `(:real^N)`] PASTING_LEMMA_EXISTS) THEN REWRITE_TAC[SIMPLE_IMAGE; SUBSET_REFL; SUBSET_UNIV] THEN ANTS_TAC THENL [CONJ_TAC THEN X_GEN_TAC `u:real^N->bool` THENL [DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^(N,1)finite_sum->bool` THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[OPEN_IN_INTER]; REWRITE_TAC[UNIONS_IMAGE] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS; INTER_SUBSET]]; X_GEN_TAC `u':real^N->bool` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN DISCH_THEN(MP_TAC o SPECL [`u:real^N->bool`; `u':real^N->bool`]) THEN ASM_CASES_TAC `u:real^N->bool = u'` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^(N,1)finite_sum->real^N` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS(IMAGE (\u. v u INTER (w:(real^N->bool)->real^(N,1)finite_sum->bool) u) f)` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g t SUBSET u ==> {x | x IN t /\ g x IN u} SUBSET x ==> t SUBSET x`)) THEN REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IN_UNIONS; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `x IN (a:(real^N->bool)->real^(N,1)finite_sum->bool) u` MP_TAC THENL [EXPAND_TAC "a" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM SET_TAC[]; ASM SET_TAC[]]; MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[OPEN_IN_INTER]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^(N,1)finite_sum`; `u:real^N->bool`]) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IN_INTER; UNIONS_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ASM SET_TAC[]]; X_GEN_TAC `x:real^(N,1)finite_sum` THEN DISCH_TAC THEN SUBGOAL_THEN `?u. u IN f /\ x IN (a:(real^N->bool)->real^(N,1)finite_sum->bool) u` STRIP_ASSUME_TAC THENL [EXPAND_TAC "a" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^(N,1)finite_sum`; `u:real^N->bool`]) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IN_INTER; UNIONS_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]; ASM SET_TAC[]]]]) in let lemma2 = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!u. u IN f ==> ANR u) /\ (!u. u IN f ==> open_in (subtopology euclidean (UNIONS f)) u) ==> ANR(UNIONS f)`, ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; ANR_EMPTY; FORALL_IN_INSERT; UNIONS_INSERT] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `f:(real^N->bool)->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC ANR_OPEN_UNION THEN EXISTS_TAC `u UNION UNIONS f:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_INSERT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u UNION UNIONS f:real^N->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]) in let lemma3 = prove (`!v:num->real^N->bool. (!n. v(n) SUBSET v(SUC n)) /\ (!n. open_in (subtopology euclidean (UNIONS(IMAGE v (:num)))) (v n)) /\ (!n. ANR(v n)) ==> ANR(UNIONS(IMAGE v (:num)))`, REPEAT STRIP_TAC THEN ABBREV_TAC `s:real^N->bool = UNIONS(IMAGE v (:num))` THEN ASM_CASES_TAC `?n:num. s:real^N->bool = v n` THENL [ASM_MESON_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM])] THEN ABBREV_TAC `w = \n:num. {x:real^N | x IN s /\ inv(&2 pow n) < setdist({x},s DIFF v n)}` THEN SUBGOAL_THEN `!n. open_in (subtopology euclidean s) ((w:num->real^N->bool) n)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "w" THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP; REAL_SUB_LT] `x < y <=> &0 < drop(lift(y - x))`] THEN ONCE_REWRITE_TAC[SET_RULE `&0 < drop x <=> x IN {y | &0 < drop y}`] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN REWRITE_TAC[drop; GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST; CONTINUOUS_ON_CONST]; ALL_TAC] THEN SUBGOAL_THEN `!n. (w:num->real^N->bool) n SUBSET v n` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "w" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> p /\ ~r ==> ~q`] THEN SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; REAL_NOT_LT; REAL_LE_INV_EQ] THEN SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_POW2]; ALL_TAC] THEN SUBGOAL_THEN `!n. ANR((w:num->real^N->bool) n)` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC ANR_OPEN_IN THEN EXISTS_TAC `(v:num->real^N->bool) n` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!n. s INTER closure(w n) SUBSET (w:num->real^N->bool)(SUC n)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "w" THEN TRANS_TAC SUBSET_TRANS `{x:real^N | x IN s /\ inv(&2 pow n) <= setdist({x},s DIFF v n)}` THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL_LOCAL THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP; REAL_SUB_LE] `x <= y <=> &0 <= drop(lift(y - x))`] THEN ONCE_REWRITE_TAC[SET_RULE `&0 <= drop x <=> x IN {y | &0 <= drop y}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST; CONTINUOUS_ON_CONST]; REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `b < a /\ x <= y ==> a <= x ==> b < y`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; MATCH_MP_TAC SETDIST_SUBSET_RIGHT THEN ASM SET_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `s:real^N->bool = UNIONS(IMAGE w (:num))` SUBST1_TAC THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE; IN_UNIV] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]] THEN EXPAND_TAC "w" THEN REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?n:num. (x:real^N) IN v n` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < setdist ({x:real^N},s DIFF v(n:num))` MP_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[SETDIST_POS_LE] THEN MP_TAC(ISPEC `s:real^N->bool` SETDIST_EQ_0_CLOSED_IN) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN DISCH_THEN SUBST1_TAC THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_ARCH_POW_INV)) THEN ANTS_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_TAC THEN EXISTS_TAC `m + n:num` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a < b ==> x <= a /\ b <= y ==> x < y`)) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; MATCH_MP_TAC SETDIST_SUBSET_RIGHT THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u DIFF t SUBSET u DIFF s`) THEN MATCH_MP_TAC(MESON[LE_ADD; ADD_SYM] `(!m n:num. m <= n ==> v m SUBSET v n) ==> v b SUBSET v(a + b)`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM SET_TAC[]]]; ALL_TAC] THEN (STRIP_ASSUME_TAC o prove_general_recursive_function_exists) `?r:num->real^N->bool. r 0 = w 0 /\ r 1 = w 1 /\ (!n. r(n + 2) = w(n + 2) DIFF (s INTER closure(w n)))` THEN SUBGOAL_THEN `!n. open_in (subtopology euclidean (w n)) ((r:num->real^N->bool) n)` ASSUME_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[ARITH; OPEN_IN_REFL] THEN X_GEN_TAC `n:num` THEN REPLICATE_TAC 2 (DISCH_THEN(K ALL_TAC)) THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC(MESON[CLOSED_IN_CLOSED_INTER] `closed u /\ s INTER t INTER u = s INTER u ==> closed_in (subtopology euclidean s) (s INTER t INTER u)`) THEN REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC (SET_RULE `s SUBSET t ==> s INTER t INTER u = s INTER u`) THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!n. open_in (subtopology euclidean s) ((r:num->real^N->bool) n)` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!n. ANR((r:num->real^N->bool) n)` ASSUME_TAC THENL [ASM_MESON_TAC[ANR_OPEN_IN]; ALL_TAC] THEN SUBGOAL_THEN `UNIONS (IMAGE w (:num)):real^N->bool = UNIONS(IMAGE r (:num))` SUBST1_TAC THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_IMAGE; IN_UNIV; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[ARITH] THEN X_GEN_TAC `n:num` THEN REPLICATE_TAC 2 (DISCH_THEN(K ALL_TAC)) THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN SIMP_TAC[IN_DIFF; IN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `SUC n` o CONJUNCT2) THEN ANTS_TAC THENL [ARITH_TAC; ASM SET_TAC[]]; MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[SUBSET_REFL] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[ARITH; SUBSET_REFL] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN SET_TAC[]]; ALL_TAC] THEN EXPAND_TAC "s" THEN SUBGOAL_THEN `(:num) = IMAGE (\n. 2 * n) (:num) UNION IMAGE (\n. 2 * n + 1) (:num)` (fun th -> ONCE_REWRITE_TAC[th] THEN ASSUME_TAC(SYM th)) THENL [REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE; IN_UNION] THEN REWRITE_TAC[GSYM EVEN_EXISTS; GSYM ADD1; GSYM ODD_EXISTS] THEN REWRITE_TAC[EVEN_OR_ODD]; REWRITE_TAC[IMAGE_UNION; GSYM IMAGE_o; o_DEF; UNIONS_UNION]] THEN MATCH_MP_TAC ANR_OPEN_UNION THEN EXISTS_TAC `UNIONS (IMAGE (\x. r (2 * x)) (:num)) UNION UNIONS (IMAGE (\x. r (2 * x + 1)) (:num)):real^N->bool` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[SUBSET_UNION] THEN ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_IMAGE; UNION_SUBSET] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC lemma1 THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN (CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `n:num` THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[UNIONS_SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]]]) THEN REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN (CONJ_TAC THENL [MESON_TAC[DISJOINT_SYM]; ALL_TAC]) THEN X_GEN_TAC `m:num` THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[CONJUNCT1 LT; ARITH_RULE `2 * SUC n = 2 * n + 2`; ARITH_RULE `(2 * n + 2) + 1 = (2 * n + 1) + 2`] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[LT_SUC_LE] THEN DISCH_TAC THEN DISCH_THEN(K ALL_TAC) THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `m <= n ==> 2 * m <= 2 * n`)) THEN SPEC_TAC(`2 * n`,`n:num`) THEN SPEC_TAC(`2 * m`,`m:num`); FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `m <= n ==> 2 * m + 1 <= 2 * n + 1`)) THEN SPEC_TAC(`2 * n + 1`,`n:num`) THEN SPEC_TAC(`2 * m + 1`,`m:num`)] THEN (REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `r m SUBSET s /\ r m SUBSET w m /\ w m SUBSET w n /\ w n SUBSET closure(w n) ==> DISJOINT (r m) (w(n + 2) DIFF s INTER closure(w n))`) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; SPEC_TAC(`m:num`,`p:num`) THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[SUBSET_REFL] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[ARITH; SUBSET_REFL] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN SET_TAC[]; UNDISCH_TAC `m:num <= n` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`n:num`;` m:num`] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[SUBSET_REFL; SUBSET_TRANS] THEN X_GEN_TAC `p:num` THEN TRANS_TAC SUBSET_TRANS `s INTER closure((w:num->real^N->bool) p)` THEN ASM_REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]])) in let lemma4 = prove (`!v:num->real^N->bool. (!n. open_in (subtopology euclidean (UNIONS(IMAGE v (:num)))) (v n)) /\ (!n. ANR(v n)) ==> ANR(UNIONS(IMAGE v (:num)))`, GEN_TAC THEN ABBREV_TAC `u:num->real^N->bool = \n. UNIONS (IMAGE v (0..n))` THEN SUBGOAL_THEN `UNIONS(IMAGE v (:num)):real^N->bool = UNIONS(IMAGE u (:num))` (fun th -> ONCE_REWRITE_TAC[th] THEN RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL [EXPAND_TAC "u" THEN REWRITE_TAC[EXTENSION; UNIONS_IMAGE; IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]; REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma3 THEN EXPAND_TAC "u" THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC; GEN_TAC THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[]; GEN_TAC THEN MATCH_MP_TAC lemma2 THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o SPEC `k:num`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_IMAGE; IN_NUMSEG; LE_0] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; IN_NUMSEG; LE_0] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_IMAGE] THEN EXPAND_TAC "u" THEN REWRITE_TAC[UNIONS_IMAGE; IN_UNIV; IN_NUMSEG; LE_0] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]]]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `u:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:(real^N->bool)->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; ANR_EMPTY] THEN MP_TAC(ISPEC `g:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:num->real^N->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC lemma4 THEN CONJ_TAC THENL [GEN_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN REWRITE_TAC[UNIONS_IMAGE] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[SUBSET; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `(h:num->real^N->bool) n`)) THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]);; let ENR_OPEN_UNIONS = prove (`!f:(real^N->bool)->bool u. (!s. s IN f ==> ENR s) /\ (!s. s IN f ==> open_in (subtopology euclidean u) s) ==> ENR(UNIONS f)`, REWRITE_TAC[ENR_ANR] THEN MESON_TAC[ANR_OPEN_UNIONS; LOCALLY_COMPACT_OPEN_UNIONS]);; let LOCALLY_ANR_ALT = prove (`!s:real^N->bool. locally ANR s <=> !v x. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ ANR u /\ x IN u /\ u SUBSET v`, GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[SUBSET_REFL]] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `v:real^N->bool` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC ANR_OPEN_IN THEN EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]);; let LOCALLY_ANR = prove (`!s:real^N->bool. locally ANR s <=> !x. x IN s ==> ?v. x IN v /\ open_in (subtopology euclidean s) v /\ ANR v`, GEN_TAC THEN REWRITE_TAC[LOCALLY_ANR_ALT] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THENL [DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC(SPEC `s:real^N->bool` th)) THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN MESON_TAC[]; DISCH_THEN(fun th -> X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN MP_TAC th) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `v INTER w:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER; INTER_SUBSET] THEN MATCH_MP_TAC ANR_OPEN_IN THEN EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[INTER_SUBSET; OPEN_IN_INTER] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]]);; let ANR_LOCALLY = prove (`!s:real^N->bool. locally ANR s <=> ANR s`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_ANR] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[OPEN_IN_REFL]] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `UNIONS (IMAGE (f:real^N->real^N->bool) s) = s` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; EXPAND_TAC "s" THEN MATCH_MP_TAC ANR_OPEN_UNIONS THEN ASM_MESON_TAC[FORALL_IN_IMAGE]]);; let LOCALLY_ENR_ALT = prove (`!s:real^N->bool. locally ENR s <=> !v x. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ ENR u /\ x IN u /\ u SUBSET v`, GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[SUBSET_REFL]] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `v:real^N->bool` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC ENR_OPEN_IN THEN EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]);; let LOCALLY_ENR = prove (`!s:real^N->bool. locally ENR s <=> !x. x IN s ==> ?v. x IN v /\ open_in (subtopology euclidean s) v /\ ENR v`, GEN_TAC THEN REWRITE_TAC[LOCALLY_ENR_ALT] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THENL [DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC(SPEC `s:real^N->bool` th)) THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN MESON_TAC[]; DISCH_THEN(fun th -> X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN MP_TAC th) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `v INTER w:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER; INTER_SUBSET] THEN MATCH_MP_TAC ENR_OPEN_IN THEN EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[INTER_SUBSET; OPEN_IN_INTER] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]]);; let ENR_LOCALLY = prove (`!s:real^N->bool. locally ENR s <=> ENR s`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_ENR] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[OPEN_IN_REFL]] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `UNIONS (IMAGE (f:real^N->real^N->bool) s) = s` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; EXPAND_TAC "s" THEN MATCH_MP_TAC ENR_OPEN_UNIONS THEN ASM_MESON_TAC[FORALL_IN_IMAGE]]);; let ANR_COVERING_SPACE_EQ = prove (`!p:real^M->real^N s c. covering_space (c,p) s ==> (ANR s <=> ANR c)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM ANR_LOCALLY] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ)) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN REWRITE_TAC[homeomorphic] THEN ASM_MESON_TAC[]);; let ANR_COVERING_SPACE = prove (`!p:real^M->real^N s c. covering_space (c,p) s /\ ANR c ==> ANR s`, MESON_TAC[ANR_COVERING_SPACE_EQ]);; let ENR_COVERING_SPACE_EQ = prove (`!p:real^M->real^N s c. covering_space (c,p) s ==> (ENR s <=> ENR c)`, REWRITE_TAC[ENR_ANR] THEN MESON_TAC[ANR_COVERING_SPACE_EQ; COVERING_SPACE_LOCALLY_COMPACT_EQ]);; let ENR_COVERING_SPACE = prove (`!p:real^M->real^N s c. covering_space (c,p) s /\ ENR c ==> ENR s`, MESON_TAC[ENR_COVERING_SPACE_EQ]);; (* ------------------------------------------------------------------------- *) (* Original ANR material, now for ENRs. Eventually more of this will be *) (* updated and generalized for AR and ANR as well. *) (* ------------------------------------------------------------------------- *) let ENR_BOUNDED = prove (`!s:real^N->bool. bounded s ==> (ENR s <=> ?u. open u /\ bounded u /\ s retract_of u)`, REPEAT STRIP_TAC THEN REWRITE_TAC[ENR] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(vec 0:real^N,r) INTER u` THEN ASM_SIMP_TAC[BOUNDED_INTER; OPEN_INTER; OPEN_BALL; BOUNDED_BALL] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ASM SET_TAC[]);; let ABSOLUTE_RETRACT_IMP_AR_GEN = prove (`!s:real^M->bool s':real^N->bool t u. s retract_of t /\ convex t /\ ~(t = {}) /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s' ==> s' retract_of u`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^M->bool`] AR_RETRACT_OF_AR) THEN ASM_SIMP_TAC[CONVEX_IMP_AR] THEN ASM_MESON_TAC[AR_IMP_ABSOLUTE_RETRACT]);; let ABSOLUTE_RETRACT_IMP_AR = prove (`!s s'. s retract_of (:real^M) /\ s homeomorphic s' /\ closed s' ==> s' retract_of (:real^N)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTE_RETRACT_IMP_AR_GEN THEN MAP_EVERY EXISTS_TAC [`s:real^M->bool`; `(:real^M)`] THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN REWRITE_TAC[CONVEX_UNIV; CLOSED_UNIV; UNIV_NOT_EMPTY]);; let HOMEOMORPHIC_COMPACT_ARNESS = prove (`!s s'. s homeomorphic s' ==> (compact s /\ s retract_of (:real^M) <=> compact s' /\ s' retract_of (:real^N))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `compact(s:real^M->bool) /\ compact(s':real^N->bool)` THENL [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS]] THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTE_RETRACT_IMP_AR) THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM; COMPACT_IMP_CLOSED]);; let EXTENSION_INTO_AR_LOCAL = prove (`!f:real^M->real^N c s t. f continuous_on c /\ IMAGE f c SUBSET t /\ t retract_of (:real^N) /\ closed_in (subtopology euclidean s) c ==> ?g. g continuous_on s /\ IMAGE g (:real^M) SUBSET t /\ !x. x IN c ==> g x = f x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`] TIETZE_UNBOUNDED) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:real^N->real^N) o (g:real^M->real^N)` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);; let EXTENSION_INTO_AR = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ t retract_of (:real^N) /\ closed s ==> ?g. g continuous_on (:real^M) /\ IMAGE g (:real^M) SUBSET t /\ !x. x IN s ==> g x = f x`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`; `t:real^N->bool`] EXTENSION_INTO_AR_LOCAL) THEN REWRITE_TAC[GSYM OPEN_IN; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV]);; let NEIGHBOURHOOD_EXTENSION_INTO_ANR = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ ANR t /\ closed s ==> ?v g. s SUBSET v /\ open v /\ g continuous_on v /\ IMAGE g v SUBSET t /\ !x. x IN s ==> g x = f x`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^M->bool`; `t:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN REWRITE_TAC[GSYM OPEN_IN; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN CONV_TAC TAUT);; let EXTENSION_FROM_COMPONENT = prove (`!f:real^M->real^N s c u. (locally connected s \/ compact s /\ ANR u) /\ c IN components s /\ f continuous_on c /\ IMAGE f c SUBSET u ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ !x. x IN c ==> g x = f x`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN SUBGOAL_THEN `?t g. open_in (subtopology euclidean s) t /\ closed_in (subtopology euclidean s) t /\ c SUBSET t /\ (g:real^M->real^N) continuous_on t /\ IMAGE g t SUBSET u /\ !x. x IN c ==> g x = f x` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL [MAP_EVERY EXISTS_TAC [`c:real^M->bool`; `f:real^M->real^N`] THEN ASM_SIMP_TAC[SUBSET_REFL; CLOSED_IN_COMPONENT; OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]; MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`; `u:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_SIMP_TAC[CLOSED_IN_COMPONENT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(ISPECL [`s:real^M->bool`; `c:real^M->bool`; `v:real^M->bool`] SURA_BURA_CLOPEN_SUBSET) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN EXISTS_TAC `g:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]]]; MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`; `t:real^M->bool`; `u:real^N->bool`] EXTENSION_FROM_CLOPEN) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN ASM SET_TAC[]]);; let ABSOLUTE_RETRACT_FROM_UNION_AND_INTER = prove (`!s t. (s UNION t) retract_of (:real^N) /\ (s INTER t) retract_of (:real^N) /\ closed s /\ closed t ==> s retract_of (:real^N)`, MESON_TAC[RETRACT_OF_UNIV; AR_FROM_UNION_AND_INTER]);; let COUNTABLE_ENR_COMPONENTS = prove (`!s:real^N->bool. ENR s ==> COUNTABLE(components s)`, SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_COMPONENTS]);; let COUNTABLE_ENR_CONNECTED_COMPONENTS = prove (`!s:real^N->bool t. ENR s ==> COUNTABLE {connected_component s x | x | x IN t}`, SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_CONNECTED_COMPONENTS]);; let COUNTABLE_ENR_PATH_COMPONENTS = prove (`!s:real^N->bool. ENR s ==> COUNTABLE {path_component s x | x | x IN s}`, SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_PATH_COMPONENTS]);; let ENR_FROM_UNION_AND_INTER_GEN = prove (`!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ ENR(s UNION t) /\ ENR(s INTER t) ==> ENR s`, REWRITE_TAC[ENR_ANR] THEN MESON_TAC[LOCALLY_COMPACT_CLOSED_IN; ANR_FROM_UNION_AND_INTER_LOCAL]);; let ENR_FROM_UNION_AND_INTER = prove (`!s t:real^N->bool. closed s /\ closed t /\ ENR(s UNION t) /\ ENR(s INTER t) ==> ENR s`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC ENR_FROM_UNION_AND_INTER_GEN THEN ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);; let ENR_CLOSURE_FROM_FRONTIER = prove (`!s:real^N->bool. ENR(frontier s) ==> ENR(closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ENR_FROM_UNION_AND_INTER THEN EXISTS_TAC `closure((:real^N) DIFF s)` THEN ASM_REWRITE_TAC[CLOSED_CLOSURE; GSYM FRONTIER_CLOSURES] THEN SUBGOAL_THEN `closure s UNION closure ((:real^N) DIFF s) = (:real^N)` (fun th -> REWRITE_TAC[th; ENR_UNIV]) THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure s /\ (:real^N) DIFF s SUBSET closure((:real^N) DIFF s) ==> closure s UNION closure ((:real^N) DIFF s) = (:real^N)`) THEN REWRITE_TAC[CLOSURE_SUBSET]);; let ANR_CLOSURE_FROM_FRONTIER = prove (`!s:real^N->bool. ANR(frontier s) ==> ANR(closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ENR_IMP_ANR THEN MATCH_MP_TAC ENR_CLOSURE_FROM_FRONTIER THEN ASM_SIMP_TAC[ENR_ANR; FRONTIER_CLOSED; CLOSED_IMP_LOCALLY_COMPACT]);; let ENR_FINITE_UNIONS_CONVEX_CLOSED = prove (`!t:(real^N->bool)->bool. FINITE t /\ (!c. c IN t ==> closed c /\ convex c) ==> ENR(UNIONS t)`, SIMP_TAC[ENR_ANR; ANR_FINITE_UNIONS_CONVEX_CLOSED] THEN SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; CLOSED_UNIONS]);; let FINITE_IMP_ENR = prove (`!s:real^N->bool. FINITE s ==> ENR s`, SIMP_TAC[FINITE_IMP_ANR; FINITE_IMP_CLOSED; ENR_ANR; CLOSED_IMP_LOCALLY_COMPACT]);; let ENR_INSERT = prove (`!s a:real^N. closed s /\ ENR s ==> ENR(a INSERT s)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN MATCH_MP_TAC ENR_CLOSED_UNION THEN ASM_MESON_TAC[CLOSED_SING; ENR_SING; ENR_EMPTY; SET_RULE `{a} INTER s = {a} \/ {a} INTER s = {}`]);; let ENR_TRIANGULATION = prove (`!tr. triangulation tr ==> ENR(UNIONS tr)`, REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ENR_FINITE_UNIONS_CONVEX_CLOSED THEN ASM_MESON_TAC[CLOSED_SIMPLEX; CONVEX_SIMPLEX]);; let ENR_SIMPLICIAL_COMPLEX = prove (`!c. simplicial_complex c ==> ENR(UNIONS c)`, MESON_TAC[ENR_TRIANGULATION; SIMPLICIAL_COMPLEX_IMP_TRIANGULATION]);; let ENR_PATH_COMPONENT_ENR = prove (`!s x:real^N. ENR(s) ==> ENR(path_component s x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ENR_OPEN_IN)) THEN MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN MATCH_MP_TAC RETRACT_OF_LOCALLY_PATH_CONNECTED THEN ASM_MESON_TAC[ENR; OPEN_IMP_LOCALLY_PATH_CONNECTED]);; let ENR_CONNECTED_COMPONENT_ENR = prove (`!s x:real^N. ENR(s) ==> ENR(connected_component s x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ENR_OPEN_IN)) THEN MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN MATCH_MP_TAC RETRACT_OF_LOCALLY_CONNECTED THEN ASM_MESON_TAC[ENR; OPEN_IMP_LOCALLY_CONNECTED]);; let ENR_COMPONENT_ENR = prove (`!s:real^N->bool. ENR s /\ c IN components s ==> ENR c`, REWRITE_TAC[IN_COMPONENTS] THEN MESON_TAC[ENR_CONNECTED_COMPONENT_ENR]);; let ENR_INTER_CLOSED_OPEN = prove (`!s:real^N->bool. ENR s ==> ?t u. closed t /\ open u /\ s = t INTER u`, GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[ENR] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_RETRACT) THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN ASM_MESON_TAC[INTER_COMM]);; let ENR_IMP_FSGIMA = prove (`!s:real^N->bool. ENR s ==> fsigma s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ENR_INTER_CLOSED_OPEN) THEN ASM_SIMP_TAC[CLOSED_IMP_FSIGMA; OPEN_IMP_FSIGMA; FSIGMA_INTER]);; let ENR_IMP_GDELTA = prove (`!s:real^N->bool. ENR s ==> gdelta s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ENR_INTER_CLOSED_OPEN) THEN ASM_SIMP_TAC[CLOSED_IMP_GDELTA; OPEN_IMP_GDELTA; GDELTA_INTER]);; let IS_INTERVAL_IMP_FSIGMA = prove (`!s:real^N->bool. is_interval s ==> fsigma s`, SIMP_TAC[IS_INTERVAL_IMP_ENR; ENR_IMP_FSGIMA]);; let IS_INTERVAL_IMP_GDELTA = prove (`!s:real^N->bool. is_interval s ==> gdelta s`, SIMP_TAC[IS_INTERVAL_IMP_ENR; ENR_IMP_GDELTA]);; let IS_INTERVAL_IMP_BAIRE1_INDICATOR = prove (`!s. is_interval s ==> baire 1 (:real^N) (indicator s)`, SIMP_TAC[BAIRE1_INDICATOR; IS_INTERVAL_IMP_FSIGMA; IS_INTERVAL_IMP_GDELTA]);; let ANR_COMPONENTWISE = prove (`!s:real^N->bool. ANR s <=> COUNTABLE(components s) /\ !c. c IN components s ==> open_in (subtopology euclidean s) c /\ ANR c`, GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> p) /\ (p ==> q) /\ (p ==> r) ==> (p <=> q /\ r)`) THEN REWRITE_TAC[COUNTABLE_ANR_COMPONENTS] THEN CONJ_TAC THENL [DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN MATCH_MP_TAC ANR_OPEN_UNIONS THEN ASM_MESON_TAC[GSYM UNIONS_COMPONENTS]; ASM_MESON_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED; ANR_IMP_LOCALLY_CONNECTED; ANR_OPEN_IN]]);; let ENR_COMPONENTWISE = prove (`!s:real^N->bool. ENR s <=> COUNTABLE(components s) /\ !c. c IN components s ==> open_in (subtopology euclidean s) c /\ ENR c`, GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> p) /\ (p ==> q) /\ (p ==> r) ==> (p <=> q /\ r)`) THEN REWRITE_TAC[COUNTABLE_ENR_COMPONENTS] THEN CONJ_TAC THENL [DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN MATCH_MP_TAC ENR_OPEN_UNIONS THEN ASM_MESON_TAC[GSYM UNIONS_COMPONENTS]; ASM_MESON_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED; ENR_IMP_LOCALLY_CONNECTED; ENR_OPEN_IN]]);; let ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT = prove (`!s:real^N->bool t u:real^M->bool. s homeomorphic u /\ ~(s = {}) /\ s SUBSET t /\ convex u /\ compact u ==> s retract_of t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`u:real^M->bool`; `t:real^N->bool`; `s:real^N->bool`] AR_IMP_ABSOLUTE_RETRACT) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[CONVEX_IMP_AR; HOMEOMORPHIC_EMPTY; HOMEOMORPHIC_SYM; CLOSED_SUBSET; COMPACT_IMP_CLOSED; HOMEOMORPHIC_COMPACTNESS]);; let ABSOLUTE_RETRACT_PATH_IMAGE_ARC = prove (`!g s:real^N->bool. arc g /\ path_image g SUBSET s ==> (path_image g) retract_of s`, REPEAT STRIP_TAC THEN MP_TAC (ISPECL [`path_image g:real^N->bool`; `s:real^N->bool`; `interval[vec 0:real^1,vec 1:real^1]`] ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN REWRITE_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `g:real^1->real^N` THEN RULE_ASSUM_TAC(REWRITE_RULE[arc; path; path_image]) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL; path_image]);; let AR_ARC_IMAGE = prove (`!g:real^1->real^N. arc g ==> AR(path_image g)`, MESON_TAC[RETRACT_OF_UNIV; SUBSET_UNIV; ABSOLUTE_RETRACT_PATH_IMAGE_ARC]);; let RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX = prove (`!s t a:real^N. convex s /\ convex t /\ bounded s /\ a IN relative_interior s /\ relative_frontier s SUBSET t /\ t SUBSET affine hull s ==> ?r. homotopic_with (\x. T) (t DELETE a,t DELETE a) (\x. x) r /\ retraction (t DELETE a,relative_frontier s) r /\ (!x. ?c. &0 < c /\ r(x) - a = c % (x - a))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] RAY_TO_RELATIVE_FRONTIER) THEN ASM_SIMP_TAC[relative_frontier; VECTOR_ADD_LID] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[REAL_LT_01] `(!x. P x ==> ?d. &0 < d /\ R d x) ==> !x. ?d. &0 < d /\ (P x ==> R d x)`)) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; retraction] THEN X_GEN_TAC `dd:real^N->real` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. a + dd(x - a) % (x - a)` THEN SUBGOAL_THEN `((\x:real^N. a + dd x % x) o (\x. x - a)) continuous_on t DELETE a` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `affine hull s DELETE (a:real^N)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN SIMP_TAC[VECTOR_ARITH `x - a:real^N = y - a <=> x = y`; VECTOR_SUB_REFL; SET_RULE `(!x y. f x = f y <=> x = y) ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a`] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION THEN EXISTS_TAC `relative_frontier (IMAGE (\x:real^N. x - a) s)` THEN ASM_SIMP_TAC[COMPACT_RELATIVE_FRONTIER_BOUNDED; VECTOR_ARITH `x - a:real^N = --a + x`; RELATIVE_FRONTIER_TRANSLATION; COMPACT_TRANSLATION_EQ] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(a IN IMAGE f s) ==> IMAGE f s SUBSET IMAGE f t DELETE a`) THEN REWRITE_TAC[IN_IMAGE; UNWIND_THM2; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN ASM_REWRITE_TAC[relative_frontier; IN_DIFF] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]; MATCH_MP_TAC SUBSPACE_IMP_CONIC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN SIMP_TAC[AFFINE_TRANSLATION; AFFINE_AFFINE_HULL; IN_IMAGE] THEN REWRITE_TAC[UNWIND_THM2; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IN_DELETE; IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`] THEN MAP_EVERY X_GEN_TAC [`k:real`; `x:real^N`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN_IMAGE; UNWIND_THM2; relative_frontier; VECTOR_ARITH `y:real^N = --a + x <=> x = a + y`] THEN EQ_TAC THENL [STRIP_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]] THEN MATCH_MP_TAC(REAL_ARITH `~(a < b) /\ ~(b < a) ==> a = b`) THEN CONJ_TAC THEN DISCH_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN c DIFF i ==> x IN i ==> F`)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; VECTOR_ARITH `a + --a + x:real^N = x`; VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `a + k % (--a + x):real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_SEGMENT; NOT_FORALL_THM] THEN EXISTS_TAC `a + dd(--a + x) % (--a + x):real^N` THEN ASM_REWRITE_TAC[VECTOR_ARITH `a:real^N = a + k % (--a + x) <=> k % (x - a) = vec 0`] THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [EXISTS_TAC `(dd:real^N->real) (--a + x) / k` THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN REWRITE_TAC[VECTOR_ARITH `a + b:real^N = (&1 - u) % a + u % c <=> b = u % (c - a)`] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_SUB; REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `a IN closure s /\ ~(a IN relative_interior s) ==> ~(a IN relative_interior s)`)] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]]; REWRITE_TAC[o_DEF] THEN STRIP_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC; IN_DELETE] THEN REPEAT(GEN_TAC THEN STRIP_TAC) THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN ASM_REWRITE_TAC[REAL_ARITH `&1 - u + u = &1`; REAL_SUB_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[relative_frontier] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + x - a:real^N = x`; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[HULL_SUBSET; RELATIVE_INTERIOR_SUBSET; SUBSET]; ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `(&1 - u) % x + u % (a + d % (x - a)):real^N = a <=> (&1 - u + u * d) % (x - a) = vec 0`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= u /\ u <= &1 /\ ~(x = &0 /\ u = &1) ==> ~(&1 - u + x = &0)`) THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_ARITH `(u = &0 \/ d = &0) /\ u = &1 <=> d = &0 /\ u = &1`] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE; MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0 /\ u = &1)`)] THEN ASM_REWRITE_TAC[]]; RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier]) THEN ASM SET_TAC[]; ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `!s t. s SUBSET t /\ IMAGE f (t DELETE a) SUBSET u ==> IMAGE f (s DELETE a) SUBSET u`) THEN EXISTS_TAC `affine hull s:real^N->bool` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `dd(x - a:real^N) = &1` (fun th -> REWRITE_TAC[th] THEN CONV_TAC VECTOR_ARITH) THEN MATCH_MP_TAC(REAL_ARITH `~(d < &1) /\ ~(&1 < d) ==> d = &1`) THEN CONJ_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THENL [DISCH_THEN(MP_TAC o SPEC `x:real^N`); DISCH_THEN(MP_TAC o SPEC `a + dd(x - a) % (x - a):real^N`)] THEN ASM_REWRITE_TAC[SUBSET; NOT_IMP; IN_SEGMENT; NOT_FORALL_THM] THENL [EXISTS_TAC `a + dd(x - a) % (x - a):real^N` THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH `a + d % (x - a):real^N = (&1 - u) % a + u % x <=> (u - d) % (x - a) = vec 0`] THEN CONJ_TAC THENL [EXISTS_TAC `(dd:real^N->real)(x - a)` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `x IN closure s DIFF relative_interior s ==> ~(x IN relative_interior s)`)] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN ASM_MESON_TAC[CLOSURE_SUBSET_AFFINE_HULL; SUBSET]; CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `x IN closure s DIFF relative_interior s ==> x IN closure s`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN ASM_MESON_TAC[CLOSURE_SUBSET_AFFINE_HULL; SUBSET]; EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; VECTOR_ARITH `a = a + d <=> d:real^N = vec 0`; VECTOR_ARITH `x:real^N = (&1 - u) % a + u % (a + d % (x - a)) <=> (u * d - &1) % (x - a) = vec 0`] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN EXISTS_TAC `inv((dd:real^N->real)(x - a))` THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_SUB_REFL; REAL_LT_INV_EQ] THEN ASM_SIMP_TAC[REAL_INV_LT_1] THEN ASM_REAL_ARITH_TAC]]; REWRITE_TAC[VECTOR_ADD_SUB] THEN EXISTS_TAC `\x. (dd:real^N->real)(x - a)` THEN ASM_REWRITE_TAC[]]);; let RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL = prove (`!s a:real^N. convex s /\ bounded s /\ a IN relative_interior s ==> relative_frontier s retract_of (affine hull s DELETE a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `affine hull s:real^N->bool`; `a:real^N`] RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX) THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; SUBSET_REFL] THEN REWRITE_TAC[retract_of] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[relative_frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]);; let RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL = prove (`!s a:real^N. convex s /\ compact s /\ a IN relative_interior s ==> (s DIFF relative_interior s) retract_of (affine hull s DELETE a)`, MP_TAC RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[relative_frontier; COMPACT_IMP_BOUNDED; COMPACT_IMP_CLOSED; CLOSURE_CLOSED]);; let PATH_CONNECTED_SPHERE_GEN = prove (`!s:real^N->bool. convex s /\ bounded s /\ ~(aff_dim s = &1) ==> path_connected(relative_frontier s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `relative_interior s:real^N->bool = {}` THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; PATH_CONNECTED_EMPTY; RELATIVE_FRONTIER_EMPTY]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC RETRACT_OF_PATH_CONNECTED THEN EXISTS_TAC `affine hull s DELETE (a:real^N)` THEN ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX; AFF_DIM_AFFINE_HULL; RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL]]);; let CONNECTED_SPHERE_GEN = prove (`!s:real^N->bool. convex s /\ bounded s /\ ~(aff_dim s = &1) ==> connected(relative_frontier s)`, SIMP_TAC[PATH_CONNECTED_SPHERE_GEN; PATH_CONNECTED_IMP_CONNECTED]);; let ENR_RELATIVE_FRONTIER_CONVEX = prove (`!s:real^N->bool. bounded s /\ convex s ==> ENR(relative_frontier s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[ENR; RELATIVE_FRONTIER_EMPTY] THENL [ASM_MESON_TAC[RETRACT_OF_REFL; OPEN_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN EXISTS_TAC `{x | x IN (:real^N) /\ closest_point (affine hull s) x IN ((:real^N) DELETE a)}` THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `(:real^N)` THEN SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL; SUBSET_UNIV; ETA_AX]; MATCH_MP_TAC RETRACT_OF_TRANS THEN EXISTS_TAC `(affine hull s) DELETE (a:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL THEN ASM_REWRITE_TAC[]; REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `closest_point (affine hull s:real^N->bool)` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_UNIV; CLOSEST_POINT_SELF; CLOSEST_POINT_IN_SET; AFFINE_HULL_EQ_EMPTY; CLOSED_AFFINE_HULL]]] THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY]);; let ANR_RELATIVE_FRONTIER_CONVEX = prove (`!s:real^N->bool. bounded s /\ convex s ==> ANR(relative_frontier s)`, SIMP_TAC[ENR_IMP_ANR; ENR_RELATIVE_FRONTIER_CONVEX]);; let FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE = prove (`!s a. convex s /\ bounded s /\ a IN interior s ==> (frontier s) retract_of ((:real^N) DELETE a)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `a IN s ==> ~(s = {})`)) THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR; RELATIVE_INTERIOR_NONEMPTY_INTERIOR; AFFINE_HULL_NONEMPTY_INTERIOR]);; let SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN = prove (`!a r b:real^N. b IN ball(a,r) ==> sphere(a,r) retract_of ((:real^N) DELETE b)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; INTERIOR_CBALL]);; let SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE = prove (`!a r. &0 < r ==> sphere(a,r) retract_of ((:real^N) DELETE a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]);; let ENR_SPHERE = prove (`!a:real^N r. ENR(sphere(a,r))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < r` THENL [REWRITE_TAC[ENR] THEN EXISTS_TAC `(:real^N) DELETE a` THEN ASM_SIMP_TAC[SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE; OPEN_DELETE; OPEN_UNIV]; ASM_MESON_TAC[FINITE_IMP_ENR; REAL_NOT_LE; FINITE_SPHERE]]);; let ANR_SPHERE = prove (`!a:real^N r. ANR(sphere(a,r))`, SIMP_TAC[ENR_SPHERE; ENR_IMP_ANR]);; let LOCALLY_PATH_CONNECTED_SPHERE_GEN = prove (`!s:real^N->bool. bounded s /\ convex s ==> locally path_connected (relative_frontier s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `relative_interior(s:real^N->bool) = {}` THENL [UNDISCH_TAC `relative_interior(s:real^N->bool) = {}` THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN REWRITE_TAC[LOCALLY_EMPTY; RELATIVE_FRONTIER_EMPTY]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN MATCH_MP_TAC RETRACT_OF_LOCALLY_PATH_CONNECTED THEN EXISTS_TAC `(affine hull s) DELETE (a:real^N)` THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `affine hull s:real^N->bool` THEN SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL] THEN SIMP_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]]);; let LOCALLY_CONNECTED_SPHERE_GEN = prove (`!s:real^N->bool. bounded s /\ convex s ==> locally connected (relative_frontier s)`, SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN; LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; let LOCALLY_PATH_CONNECTED_SPHERE = prove (`!a:real^N r. locally path_connected (sphere(a,r))`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `cball(a:real^N,r)` LOCALLY_PATH_CONNECTED_SPHERE_GEN) THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SPHERE_SING; LOCALLY_SING; PATH_CONNECTED_SING; BOUNDED_CBALL; CONVEX_CBALL]);; let LOCALLY_CONNECTED_SPHERE = prove (`!a:real^N r. locally connected(sphere(a,r))`, SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE; LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; let ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE = prove (`!s:real^N->bool t. convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t ==> ?r. retraction (t,s) r /\ !x. x IN (affine hull s) DIFF (relative_interior s) ==> r(x) IN relative_frontier s`, REPEAT STRIP_TAC THEN REWRITE_TAC[retraction] THEN EXISTS_TAC `closest_point(s:real^N->bool)` THEN ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; CLOSEST_POINT_SELF] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; CLOSEST_POINT_IN_SET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]);; let ABSOLUTE_RETRACTION_CONVEX_CLOSED = prove (`!s:real^N->bool t. convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t ==> ?r. retraction (t,s) r /\ (!x. ~(x IN s) ==> r(x) IN frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[retraction] THEN EXISTS_TAC `closest_point(s:real^N->bool)` THEN ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; CLOSEST_POINT_SELF] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; CLOSEST_POINT_IN_SET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_FRONTIER THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]);; let ABSOLUTE_RETRACT_CONVEX_CLOSED = prove (`!s:real^N->bool t. convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t ==> s retract_of t`, REWRITE_TAC[retract_of] THEN MESON_TAC[ABSOLUTE_RETRACTION_CONVEX_CLOSED]);; let ABSOLUTE_RETRACT_CONVEX = prove (`!s u:real^N->bool. convex s /\ ~(s = {}) /\ closed_in (subtopology euclidean u) s ==> s retract_of u`, REPEAT STRIP_TAC THEN REWRITE_TAC[retract_of; retraction] THEN MP_TAC(ISPECL [`\x:real^N. x`; `s:real^N->bool`; `u:real^N->bool`; `s:real^N->bool`] DUGUNDJI) THEN ASM_MESON_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL; CLOSED_IN_IMP_SUBSET]);; let ENR_PATH_IMAGE_SIMPLE_PATH = prove (`!g:real^1->real^N. simple_path g ==> ENR(path_image g)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `pathfinish g:real^N = pathstart g` THENL [MP_TAC(ISPECL [`g:real^1->real^N`; `vec 0:real^2`; `&1`] HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE) THEN ASM_REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_ENRNESS) THEN REWRITE_TAC[ENR_SPHERE]; REWRITE_TAC[ENR] THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[OPEN_UNIV] THEN MATCH_MP_TAC ABSOLUTE_RETRACT_PATH_IMAGE_ARC THEN ASM_REWRITE_TAC[ARC_SIMPLE_PATH; SUBSET_UNIV]]);; let ANR_PATH_IMAGE_SIMPLE_PATH = prove (`!g:real^1->real^N. simple_path g ==> ANR(path_image g)`, SIMP_TAC[ENR_PATH_IMAGE_SIMPLE_PATH; ENR_IMP_ANR]);; (* ------------------------------------------------------------------------- *) (* Borsuk homotopy extension thorem. It's only this late so we can use the *) (* concept of retraction, saying that the domain sets or range set are ANRs. *) (* ------------------------------------------------------------------------- *) let BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC = prove (`!f:real^M->real^N g s t u. closed_in (subtopology euclidean t) s /\ (ANR s /\ ANR t \/ ANR u) /\ f continuous_on t /\ IMAGE f t SUBSET u /\ homotopic_with (\x. T) (s,u) f g ==> ?g'. homotopic_with (\x. T) (t,u) f g' /\ g' continuous_on t /\ IMAGE g' t SUBSET u /\ !x. x IN s ==> g'(x) = g(x)`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) THEN MAP_EVERY ABBREV_TAC [`h' = \z. if sndcart z IN s then (h:real^(1,M)finite_sum->real^N) z else f(sndcart z)`; `B:real^(1,M)finite_sum->bool = {vec 0} PCROSS t UNION interval[vec 0,vec 1] PCROSS s`] THEN SUBGOAL_THEN `closed_in (subtopology euclidean (interval[vec 0:real^1,vec 1] PCROSS t)) ({vec 0} PCROSS (t:real^M->bool)) /\ closed_in (subtopology euclidean (interval[vec 0:real^1,vec 1] PCROSS t)) (interval[vec 0,vec 1] PCROSS s)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN ASM_REWRITE_TAC[CLOSED_IN_SING; CLOSED_IN_REFL; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN SUBGOAL_THEN `(h':real^(1,M)finite_sum->real^N) continuous_on B` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["h'"; "B"] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN ASM_REWRITE_TAC[SING_SUBSET; SUBSET_REFL; ENDS_IN_UNIT_INTERVAL]; ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING; SNDCART_PASTECART; TAUT `(p /\ q) /\ ~q <=> F`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON; IMAGE_SNDCART_PCROSS; NOT_INSERT_EMPTY]]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (h':real^(1,M)finite_sum->real^N) B SUBSET u` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["h'"; "B"] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_SING] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COND_ID] THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o SIMP_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN SUBGOAL_THEN `?V k:real^(1,M)finite_sum->real^N. B SUBSET V /\ open_in (subtopology euclidean (interval [vec 0,vec 1] PCROSS t)) V /\ k continuous_on V /\ IMAGE k V SUBSET u /\ (!x. x IN B ==> k x = h' x)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL [SUBGOAL_THEN `ANR(B:real^(1,M)finite_sum->bool)` MP_TAC THENL [EXPAND_TAC "B" THEN MATCH_MP_TAC ANR_CLOSED_UNION_LOCAL THEN EXISTS_TAC `{vec 0:real^1} PCROSS (t:real^M->bool) UNION interval[vec 0,vec 1] PCROSS s` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN ASM_REWRITE_TAC[SING_SUBSET; SUBSET_REFL; ENDS_IN_UNIT_INTERVAL]; ASM_SIMP_TAC[INTER_PCROSS; SET_RULE `s SUBSET t ==> t INTER s = s`; ENDS_IN_UNIT_INTERVAL; SET_RULE `a IN s ==> {a} INTER s = {a}`] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC ANR_PCROSS THEN ASM_REWRITE_TAC[ANR_INTERVAL; ANR_SING]]; DISCH_THEN(MP_TAC o SPEC `interval[vec 0:real^1,vec 1] PCROSS (t:real^M->bool)` o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] ANR_IMP_NEIGHBOURHOOD_RETRACT)) THEN ANTS_TAC THENL [EXPAND_TAC "B" THEN MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN ASM_REWRITE_TAC[CLOSED_IN_REFL; CLOSED_IN_SING; ENDS_IN_UNIT_INTERVAL]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `V:real^(1,M)finite_sum->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^(1,M)finite_sum->real^(1,M)finite_sum` THEN STRIP_TAC THEN EXISTS_TAC `(h':real^(1,M)finite_sum->real^N) o (r:real^(1,M)finite_sum->real^(1,M)finite_sum)` THEN ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]; MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "B" THEN ASM_SIMP_TAC[CLOSED_IN_UNION]]; ABBREV_TAC `s' = {x | ?u. u IN interval[vec 0,vec 1] /\ pastecart (u:real^1) (x:real^M) IN interval [vec 0,vec 1] PCROSS t DIFF V}` THEN SUBGOAL_THEN `closed_in (subtopology euclidean t) (s':real^M->bool)` ASSUME_TAC THENL [EXPAND_TAC "s'" THEN MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN REWRITE_TAC[COMPACT_INTERVAL] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^M->bool`; `s':real^M->bool`; `t:real^M->bool`; `vec 1:real^1`; `vec 0:real^1`] URYSOHN_LOCAL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [EXPAND_TAC "s'" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[NOT_IN_EMPTY; IN_DIFF; PASTECART_IN_PCROSS] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN REWRITE_TAC[SEGMENT_1; DROP_VEC; REAL_POS] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^M->real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\x. (k:real^(1,M)finite_sum->real^N) (pastecart (a x) x))` THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[HOMOTOPIC_WITH] THEN EXISTS_TAC `(k:real^(1,M)finite_sum->real^N) o (\z. pastecart (drop(fstcart z) % a(sndcart z)) (sndcart z))` THEN REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; ETA_AX] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN ASM_SIMP_TAC[IMAGE_SNDCART_PCROSS; UNIT_INTERVAL_NONEMPTY]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))]; REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k t SUBSET u ==> s SUBSET t ==> IMAGE k s SUBSET u`)); X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `pastecart (vec 0:real^1) (x:real^M) IN B` MP_TAC THENL [EXPAND_TAC "B" THEN ASM_REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_SING]; DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(h':real^(1,M)finite_sum->real^N) (pastecart (vec 0) x)` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; EXPAND_TAC "h'"] THEN ASM_REWRITE_TAC[SNDCART_PASTECART; COND_ID]]] THEN (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`p:real^1`; `x:real^M`] THEN STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_CASES_TAC `(x:real^M) IN s'` THENL [ASM_SIMP_TAC[VECTOR_MUL_RZERO] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN ASM_REWRITE_TAC[IN_SING]; UNDISCH_TAC `~((x:real^M) IN s')` THEN EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `drop p % (a:real^M->real^1) x`) THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_DIFF] THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_LMUL; REAL_ARITH `p * a <= p * &1 /\ p <= &1 ==> p * a <= &1`]]); GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]); X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(h':real^(1,M)finite_sum->real^N) (pastecart (vec 1) x)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; EXPAND_TAC "h'"] THEN ASM_REWRITE_TAC[SNDCART_PASTECART] THEN EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]] THEN (ASM_CASES_TAC `(x:real^M) IN s'` THEN ASM_SIMP_TAC[] THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; UNDISCH_TAC `~((x:real^M) IN s')` THEN EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `(a:real^M->real^1) x`) THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_DIFF] THEN ASM SET_TAC[]])]);; let BORSUK_HOMOTOPY_EXTENSION = prove (`!f:real^M->real^N g s t u. closed_in (subtopology euclidean t) s /\ (ANR s /\ ANR t \/ ANR u) /\ f continuous_on t /\ IMAGE f t SUBSET u /\ homotopic_with (\x. T) (s,u) f g ==> ?g'. g' continuous_on t /\ IMAGE g' t SUBSET u /\ !x. x IN s ==> g'(x) = g(x)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC) THEN MESON_TAC[]);; let NULLHOMOTOPIC_INTO_ANR_EXTENSION = prove (`!f:real^M->real^N s t. closed s /\ f continuous_on s /\ ~(s = {}) /\ IMAGE f s SUBSET t /\ ANR t ==> ((?c. homotopic_with (\x. T) (s,t) f (\x. c)) <=> (?g. g continuous_on (:real^M) /\ IMAGE g (:real^M) SUBSET t /\ !x. x IN s ==> g x = f x))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EXISTS_TAC `(\x. c):real^M->real^N` THEN ASM_REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN ASM SET_TAC[]; MP_TAC(ISPECL [`g:real^M->real^N`; `(:real^M)`; `t:real^N->bool`] NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC [`g:real^M->real^N`; `(\x. c):real^M->real^N`] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_SUBSET_LEFT THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]]);; let NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION = prove (`!f:real^M->real^N s t. closed s /\ f continuous_on s /\ ~(s = {}) /\ IMAGE f s SUBSET relative_frontier t /\ convex t /\ bounded t ==> ((?c. homotopic_with (\x. T) (s,relative_frontier t) f (\x. c)) <=> (?g. g continuous_on (:real^M) /\ IMAGE g (:real^M) SUBSET relative_frontier t /\ !x. x IN s ==> g x = f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NULLHOMOTOPIC_INTO_ANR_EXTENSION THEN MP_TAC(ISPEC `t:real^N->bool` ANR_RELATIVE_FRONTIER_CONVEX) THEN ASM_REWRITE_TAC[]);; let NULLHOMOTOPIC_INTO_SPHERE_EXTENSION = prove (`!f:real^M->real^N s a r. closed s /\ f continuous_on s /\ ~(s = {}) /\ IMAGE f s SUBSET sphere(a,r) ==> ((?c. homotopic_with (\x. T) (s,sphere(a,r)) f (\x. c)) <=> (?g. g continuous_on (:real^M) /\ IMAGE g (:real^M) SUBSET sphere(a,r) /\ !x. x IN s ==> g x = f x))`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL [EXISTS_TAC `a:real^N` THEN SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN EXISTS_TAC `\y:real^(1,M)finite_sum. (a:real^N)`; EXISTS_TAC `(\x. a):real^M->real^N`] THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN STRIP_TAC THEN MATCH_MP_TAC NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL]]);; let ABSOLUTE_RETRACT_CONTRACTIBLE_ANR = prove (`!s u:real^N->bool. closed_in (subtopology euclidean u) s /\ contractible s /\ ~(s = {}) /\ ANR s ==> s retract_of u`, REPEAT STRIP_TAC THEN MATCH_MP_TAC AR_IMP_RETRACT THEN ASM_SIMP_TAC[AR_ANR]);; (* ------------------------------------------------------------------------- *) (* More homotopy extension results and relations to components. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_ON_COMPONENTS = prove (`!s t f g:real^M->real^N. locally connected s /\ (!c. c IN components s ==> homotopic_with (\x. T) (c,t) f g) ==> homotopic_with (\x. T) (s,t) f g`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM UNIONS_COMPONENTS] THEN ASM_MESON_TAC[CLOSED_IN_COMPONENT; OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);; let INESSENTIAL_ON_COMPONENTS = prove (`!f:real^M->real^N s t. locally connected s /\ path_connected t /\ (!c. c IN components s ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a)) ==> ?a. homotopic_with (\x. T) (s,t) f (\x. a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `components(s:real^M->bool) = {}` THENL [RULE_ASSUM_TAC(REWRITE_RULE[COMPONENTS_EQ_EMPTY]) THEN ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `?a:real^N. a IN t` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^M->bool`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_ON_COMPONENTS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN FIRST_X_ASSUM (MATCH_MP_TAC o REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]);; let HOMOTOPIC_NEIGHBOURHOOD_EXTENSION = prove (`!f g:real^M->real^N s t u. f continuous_on s /\ IMAGE f s SUBSET u /\ g continuous_on s /\ IMAGE g s SUBSET u /\ closed_in (subtopology euclidean s) t /\ ANR u /\ homotopic_with (\x. T) (t,u) f g ==> ?v. t SUBSET v /\ open_in (subtopology euclidean s) v /\ homotopic_with (\x. T) (v,u) f g`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `h' = \z. if fstcart z IN {vec 0} then f(sndcart z) else if fstcart z IN {vec 1} then g(sndcart z) else (h:real^(1,M)finite_sum->real^N) z` THEN MP_TAC(ISPECL [`h':real^(1,M)finite_sum->real^N`; `interval[vec 0:real^1,vec 1] PCROSS (s:real^M->bool)`; `{vec 0:real^1,vec 1} PCROSS (s:real^M->bool) UNION interval[vec 0,vec 1] PCROSS t`; `u:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN ASM_SIMP_TAC[ENR_IMP_ANR] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN REWRITE_TAC[PCROSS_UNION; UNION_ASSOC] THEN EXPAND_TAC "h'" THEN REPLICATE_TAC 2 (MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPLICATE_TAC 2 (CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `interval[vec 0:real^1,vec 1] PCROSS (s:real^M->bool)` THEN REWRITE_TAC[SET_RULE `t UNION u SUBSET s UNION t UNION u`] THEN REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN TRY(MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC) THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN ASM_REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[SING_SUBSET; ENDS_IN_UNIT_INTERVAL; CLOSED_SING]; ALL_TAC]) THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN ASM_REWRITE_TAC[IMAGE_SNDCART_PCROSS; NOT_INSERT_EMPTY]; ASM_REWRITE_TAC[]; REWRITE_TAC[FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN REWRITE_TAC[FSTCART_PASTECART; IN_SING; SNDCART_PASTECART] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^M`] THEN ASM_CASES_TAC `x:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VEC_EQ; ARITH_EQ; ENDS_IN_UNIT_INTERVAL] THEN ASM_CASES_TAC `x:real^1 = vec 1` THEN ASM_REWRITE_TAC[]]); REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_SING; NOT_IN_EMPTY] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^M`] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN EXPAND_TAC "h'" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN REPEAT(COND_CASES_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]) THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f s SUBSET u ==> b IN s ==> f b IN u`)) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN ASM_REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN SIMP_TAC[CLOSED_INSERT; CLOSED_EMPTY]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`w:real^(1,M)finite_sum->bool`; `k:real^(1,M)finite_sum->real^N`] THEN STRIP_TAC] THEN MP_TAC(ISPECL [`interval[vec 0:real^1,vec 1]`; `t:real^M->bool`; `s:real^M->bool`; `w:real^(1,M)finite_sum->bool`] TUBE_LEMMA_GEN) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `t':real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[HOMOTOPIC_WITH] THEN EXISTS_TAC `k:real^(1,M)finite_sum->real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN CONJ_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhs o snd o dest_imp) th o lhs o snd)) THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_INSERT] THEN (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN EXPAND_TAC "h'" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN REWRITE_TAC[VEC_EQ; ARITH_EQ]);; let HOMOTOPIC_ON_COMPONENTS_EQ = prove (`!s t f g:real^M->real^N. (locally connected s \/ compact s /\ ANR t) ==> (homotopic_with (\x. T) (s,t) f g <=> f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on s /\ IMAGE g s SUBSET t /\ !c. c IN components s ==> homotopic_with (\x. T) (c,t) f g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> (q <=> s)) ==> (q <=> r /\ s)`) THEN CONJ_TAC THENL [MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET]; ALL_TAC] THEN STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT; IN_COMPONENTS_SUBSET]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `!c. c IN components s ==> ?u. c SUBSET u /\ closed_in (subtopology euclidean s) u /\ open_in (subtopology euclidean s) u /\ homotopic_with (\x. T) (u,t) (f:real^M->real^N) g` MP_TAC THENL [X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [EXISTS_TAC `c:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_IN_COMPONENT; SUBSET_REFL; OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]; FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`; `t:real^N->bool`] HOMOTOPIC_NEIGHBOURHOOD_EXTENSION) THEN ASM_SIMP_TAC[CLOSED_IN_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(ISPECL [`s:real^M->bool`; `c:real^M->bool`; `v:real^M->bool`] SURA_BURA_CLOPEN_SUBSET) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN SUBGOAL_THEN `s = UNIONS (IMAGE k (components(s:real^M->bool)))` (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [UNIONS_COMPONENTS] THEN MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN ASM_MESON_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]]; MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]]]);; let INESSENTIAL_ON_COMPONENTS_EQ = prove (`!s t f:real^M->real^N. (locally connected s \/ compact s /\ ANR t) /\ path_connected t ==> ((?a. homotopic_with (\x. T) (s,t) f (\x. a)) <=> f continuous_on s /\ IMAGE f s SUBSET t /\ !c. c IN components s ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a))`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> (q <=> s)) ==> (q <=> r /\ s)`) THEN CONJ_TAC THENL [MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET]; STRIP_TAC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP HOMOTOPIC_ON_COMPONENTS_EQ th]) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[COMPONENTS_EMPTY; IMAGE_CLAUSES; NOT_IN_EMPTY; EMPTY_SUBSET] THEN DISCH_TAC THEN SUBGOAL_THEN `?c:real^M->bool. c IN components s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY; COMPONENTS_EQ_EMPTY]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `d:real^M->bool`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY)) THEN ASM SET_TAC[]);; let COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS = prove (`!s:real^M->bool t:real^N->bool. (locally connected s \/ compact s /\ ANR t) ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on s /\ IMAGE g s SUBSET t ==> homotopic_with (\x. T) (s,t) f g) <=> (!c. c IN components s ==> (!f g. f continuous_on c /\ IMAGE f c SUBSET t /\ g continuous_on c /\ IMAGE g c SUBSET t ==> homotopic_with (\x. T) (c,t) f g)))`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`; `t:real^N->bool`] EXTENSION_FROM_COMPONENT) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`; `t:real^N->bool`] EXTENSION_FROM_COMPONENT) THEN ANTS_TAC THENL [ASM_MESON_TAC[ENR_IMP_ANR]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN ANTS_TAC THENL [ASM_MESON_TAC[ENR_IMP_ANR]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g':real^M->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`f':real^M->real^N`; `g':real^M->real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `c:real^M->bool` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN ASM_SIMP_TAC[IN_COMPONENTS_SUBSET] THEN MATCH_MP_TAC (ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN ASM_SIMP_TAC[]; FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP HOMOTOPIC_ON_COMPONENTS_EQ th]) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]]);; let COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL = prove (`!s:real^M->bool t:real^N->bool. (locally connected s \/ compact s /\ ANR t) /\ path_connected t ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET t ==> ?a. homotopic_with (\x. T) (s,t) f (\x. a)) <=> (!c. c IN components s ==> (!f. f continuous_on c /\ IMAGE f c SUBSET t ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a))))`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS) THEN ASM_SIMP_TAC[HOMOTOPIC_TRIVIALITY]);; let COHOMOTOPICALLY_TRIVIAL_1D = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ ANR t /\ connected t /\ (dimindex(:M) = 1 \/ ?r:real^1->bool. s homeomorphic r) ==> ?a. homotopic_with (\x. T) (s,t) f (\x. a)`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN SUBGOAL_THEN `path_connected(t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; PATH_CONNECTED_EQ_CONNECTED_LPC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (MESON[] `p \/ q ==> (p ==> q) ==> q`)) THEN ANTS_TAC THENL [REWRITE_TAC[GSYM DIMINDEX_1; GSYM DIM_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HOMEOMORPHIC_SUBSPACES))) THEN REWRITE_TAC[SUBSPACE_UNIV; homeomorphic] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^1` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^M` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (f:real^M->real^1) s` THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_TAC `r:real^1->bool`)] THEN SUBGOAL_THEN `!c. c IN components s ==> ?u. closed_in (subtopology euclidean s) u /\ open_in (subtopology euclidean s) u /\ c SUBSET u /\ ?a. homotopic_with (\x. T) (u,t) (f:real^M->real^N) (\x. a)` MP_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`; `t:real^N->bool`] NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^M->real^1`; `h:real^1->real^M`] THEN STRIP_TAC THEN SUBGOAL_THEN `contractible(IMAGE (g:real^M->real^1) c)` MP_TAC THENL [SIMP_TAC[GSYM IS_INTERVAL_CONTRACTIBLE_1; IS_INTERVAL_CONNECTED_1] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; homeomorphism]; MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`g:real^M->real^1`; `h:real^1->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_TAC `a:real^N`)] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(\x. a):real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`; `t:real^N->bool`] HOMOTOPIC_NEIGHBOURHOOD_EXTENSION) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM_SIMP_TAC[CLOSED_IN_COMPONENT] THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`s:real^M->bool`; `c:real^M->bool`; `u:real^M->bool`] COMPONENT_INTERMEDIATE_CLOPEN) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `a:real^N` THEN ASM_MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:(real^M->bool)->real^M->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `s = UNIONS (IMAGE (u:(real^M->bool)->real^M->bool) (components s))` (fun th -> SUBST1_TAC th THEN ASSUME_TAC (SYM th)) THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [UNIONS_COMPONENTS] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN ASM_SIMP_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]]; MATCH_MP_TAC INESSENTIAL_ON_CLOPEN_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]]]);; (* ------------------------------------------------------------------------- *) (* A few simple lemmas about deformation retracts. *) (* ------------------------------------------------------------------------- *) let DEFORMATION_RETRACTION_COMPOSE = prove (`!s t u r1 r2:real^N->real^N. homotopic_with (\x. T) (s,s) (\x. x) r1 /\ retraction (s,t) r1 /\ homotopic_with (\x. T) (t,t) (\x. x) r2 /\ retraction (t,u) r2 ==> homotopic_with (\x. T) (s,s) (\x. x) (r2 o r1) /\ retraction (s,u) (r2 o r1)`, REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[RETRACTION_o]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN EXISTS_TAC `(\x. x) o (r1:real^N->real^N)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF; ETA_AX]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `t:real^N->bool` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_RESTRICT)); ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[retraction]) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let DEFORMATION_RETRACT_TRANS = prove (`!s t u:real^N->bool. (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction (s,t) r) /\ (?r. homotopic_with (\x. T) (t,t) (\x. x) r /\ retraction (t,u) r) ==> ?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction (s,u) r`, MESON_TAC[DEFORMATION_RETRACTION_COMPOSE]);; let DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT = prove (`!s t:real^N->bool. (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r) ==> s homotopy_equivalent t`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN REWRITE_TAC[retraction] THEN STRIP_TAC THEN EXISTS_TAC `I:real^N->real^N` THEN REWRITE_TAC[I_O_ID] THEN ASM_REWRITE_TAC[I_DEF; CONTINUOUS_ON_ID; IMAGE_ID] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMOTOPIC_WITH_SYM]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; let DEFORMATION_RETRACT = prove (`!s t:real^N->bool. (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r) <=> t retract_of s /\ ?f. homotopic_with (\x. T) (s,s) (\x. x) f /\ IMAGE f s SUBSET t`, REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN REPEAT STRIP_TAC THEN EXISTS_TAC `r:real^N->real^N` THEN ASM_REWRITE_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) MP_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN EXISTS_TAC `r:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC HOMOTOPIC_WITH_TRANS `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC [`(r:real^N->real^N) o (f:real^N->real^N)`; `(r:real^N->real^N) o (\x. x)`] THEN ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMOTOPIC_WITH_SYM]; ASM SET_TAC[]]]);; let ANR_STRONG_DEFORMATION_RETRACTION = prove (`!s t:real^N->bool. ANR s /\ (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r) ==> ?r. homotopic_with (\h. !x. x IN t ==> h x = x) (s,s) (\x. x) r /\ retraction(s,t) r`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN ABBREV_TAC `g:real^(1,(1,N)finite_sum)finite_sum->real^N = \z. if fstcart(sndcart z) = vec 0 then (sndcart(sndcart z)) else if fstcart(sndcart z) = vec 1 then f(pastecart (vec 1 - fstcart z) (f(pastecart (vec 1) (sndcart(sndcart z))))) else f(pastecart (lift(drop(fstcart(sndcart z)) * (&1 - drop (fstcart z)))) (sndcart(sndcart z)))` THEN MP_TAC(ISPECL [`f:real^(1,N)finite_sum->real^N`; `\x. (g:real^(1,(1,N)finite_sum)finite_sum->real^N) (pastecart (vec 1) x)`; `{vec 0:real^1,vec 1} PCROSS (s:real^N->bool) UNION interval[vec 0:real^1,vec 1] PCROSS (t:real^N->bool)`; `interval[vec 0:real^1,vec 1] PCROSS (s:real^N->bool)`; `s:real^N->bool`] BORSUK_HOMOTOPY_EXTENSION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN REWRITE_TAC[CLOSED_IN_REFL] THENL [ALL_TAC; ASM_MESON_TAC[CLOSED_IN_RETRACT; retract_of]] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN REWRITE_TAC[CLOSED_IN_SING; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o snd) THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN EXISTS_TAC `g:real^(1,(1,N)finite_sum)finite_sum->real^N` THEN EXPAND_TAC "g" THEN REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[DROP_VEC; REAL_SUB_RZERO; REAL_MUL_RID; LIFT_DROP; VECTOR_SUB_RZERO; PASTECART_FST_SND; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN EXPAND_TAC "g" THEN REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[DROP_VEC; REAL_SUB_RZERO; REAL_MUL_RID; LIFT_DROP; VECTOR_SUB_RZERO; PASTECART_FST_SND; CONJ_ASSOC; PASTECART_IN_PCROSS; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`; `y:real^N`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f s SUBSET t ==> x IN s ==> f x IN t`)) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN (CONJ_TAC THENL [ALL_TAC; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN ASM SET_TAC[]]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; DROP_SUB; REAL_SUB_LE; REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC] THEN EXPAND_TAC "g" THEN REWRITE_TAC[MESON[] `(if p then x else if q then y else r) = (if p \/ q then if p then x else y else r)`] THEN REWRITE_TAC[PCROSS_UNION] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `(:real^1) PCROSS {vec 0:real^1,vec 1} PCROSS (:real^N)` THEN SIMP_TAC[CLOSED_PCROSS_EQ; CLOSED_UNIV; CLOSED_INSERT; CLOSED_EMPTY] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_INTER; EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN DISCH_THEN(MP_TAC o CONJUNCT1 o REWRITE_RULE[SUBSET]) THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]; SUBGOAL_THEN `closed_in (subtopology euclidean s) (t:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[CLOSED_IN_RETRACT; retract_of]; ALL_TAC] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(:real^1) PCROSS (:real^1) PCROSS (c:real^N->bool)` THEN ASM_REWRITE_TAC[CLOSED_PCROSS_EQ; CLOSED_UNIV] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_INTER; EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]; ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN REWRITE_TAC[PCROSS_UNION] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `(:real^1) PCROSS {vec 0:real^1} PCROSS (:real^N)` THEN ASM_REWRITE_TAC[CLOSED_PCROSS_EQ; CLOSED_UNIV] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_INTER; EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY; CLOSED_SING] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]; REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `(:real^1) PCROSS {vec 1:real^1} PCROSS (:real^N)` THEN ASM_REWRITE_TAC[CLOSED_PCROSS_EQ; CLOSED_UNIV] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_INTER; EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY; CLOSED_SING] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]; SIMP_TAC[CONTINUOUS_ON_SNDCART; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SNDCART; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [retraction]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_PASTECART; SNDCART_PASTECART] THEN SIMP_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_PASTECART; SNDCART_PASTECART; FSTCART_PASTECART] THEN SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN SIMP_TAC[REAL_ARITH `&1 - x <= &1 <=> &0 <= x`; REAL_SUB_LE] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]]; REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`; `y:real^N`] THEN ASM_CASES_TAC `v:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VEC_EQ; ARITH_EQ]]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[CONTINUOUS_ON_SNDCART; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_FSTCART; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN SIMP_TAC[LIFT_SUB; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_PASTECART; SNDCART_PASTECART; FSTCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; LIFT_DROP] THEN SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN REPEAT STRIP_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN ASM SET_TAC[]]]; REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`; `y:real^N`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INSERT; LIFT_DROP; REAL_MUL_LZERO; DROP_VEC; LIFT_NUM] THEN ASM_CASES_TAC `v:real^1 = vec 1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[DROP_VEC; REAL_MUL_LID; LIFT_SUB; LIFT_NUM; LIFT_DROP] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN ASM SET_TAC[]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(h:real^(1,N)finite_sum->real^N) o pastecart (vec 1)` THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o snd) THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN EXISTS_TAC `h:real^(1,N)finite_sum->real^N` THEN ASM_SIMP_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_INSERT; o_THM] THEN EXPAND_TAC "g" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_SUB_REFL; REAL_SUB_REFL; REAL_MUL_RZERO; LIFT_NUM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]; REWRITE_TAC[retraction; o_THM] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN SIMP_TAC[ENDS_IN_UNIT_INTERVAL]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM]; ALL_TAC] THEN ASM_SIMP_TAC[IN_UNION; IN_INSERT; PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL] THEN EXPAND_TAC "g" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SET_TAC[]]);; let DEFORMATION_RETRACT_OF_CONTRACTIBLE = prove (`!s t:real^N->bool. contractible s /\ t retract_of s ==> ?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[RETRACT_OF_EMPTY; HOMOTOPIC_ON_EMPTY] THENL [MESON_TAC[RETRACTION_REFL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DEFORMATION_RETRACT] THEN SUBGOAL_THEN `?a:real^N. a IN t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY; AR_ANR]; ALL_TAC] THEN EXISTS_TAC `(\x. a):real^N->real^N` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[RETRACT_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `(b:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS)) THEN REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; CONTRACTIBLE_IMP_PATH_CONNECTED]);; let AR_DEFORMATION_RETRACT_OF_CONTRACTIBLE = prove (`!s t:real^N->bool. contractible s /\ AR t /\ closed_in (subtopology euclidean s) t ==> ?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r`, MESON_TAC[DEFORMATION_RETRACT_OF_CONTRACTIBLE; AR_IMP_RETRACT]);; let DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING = prove (`!s a:real^N. contractible s /\ a IN s ==> ?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,{a}) r`, REPEAT STRIP_TAC THEN MATCH_MP_TAC AR_DEFORMATION_RETRACT_OF_CONTRACTIBLE THEN ASM_REWRITE_TAC[CLOSED_IN_SING; AR_SING]);; let STRONG_DEFORMATION_RETRACT_OF_AR = prove (`!s t:real^N->bool. AR s /\ t retract_of s ==> ?r. homotopic_with (\h. !x. x IN t ==> h x = x) (s,s) (\x. x) r /\ retraction(s,t) r`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_STRONG_DEFORMATION_RETRACTION THEN ASM_SIMP_TAC[AR_IMP_ANR] THEN MATCH_MP_TAC DEFORMATION_RETRACT_OF_CONTRACTIBLE THEN ASM_SIMP_TAC[AR_IMP_CONTRACTIBLE]);; let AR_STRONG_DEFORMATION_RETRACT_OF_AR = prove (`!s t:real^N->bool. AR s /\ AR t /\ closed_in (subtopology euclidean s) t ==> ?r. homotopic_with (\h. !x. x IN t ==> h x = x) (s,s) (\x. x) r /\ retraction(s,t) r`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_STRONG_DEFORMATION_RETRACTION THEN ASM_SIMP_TAC[AR_IMP_ANR] THEN MATCH_MP_TAC AR_DEFORMATION_RETRACT_OF_CONTRACTIBLE THEN ASM_SIMP_TAC[AR_IMP_CONTRACTIBLE]);; let SING_STRONG_DEFORMATION_RETRACT_OF_AR = prove (`!s a:real^N. AR s /\ a IN s ==> ?r. homotopic_with (\h. h a = a) (s,s) (\x. x) r /\ retraction(s,{a}) r`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `{a:real^N}`] AR_STRONG_DEFORMATION_RETRACT_OF_AR) THEN ASM_REWRITE_TAC[AR_SING; CLOSED_IN_SING] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX = prove (`!s t a:real^N. convex s /\ bounded s /\ a IN relative_interior s /\ convex t /\ relative_frontier s SUBSET t /\ t SUBSET affine hull s ==> (relative_frontier s) homotopy_equivalent (t DELETE a)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN MATCH_MP_TAC DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT THEN ASM_MESON_TAC[RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX]);; let HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL = prove (`!s a:real^N. convex s /\ bounded s /\ a IN relative_interior s ==> (relative_frontier s) homotopy_equivalent (affine hull s DELETE a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; SUBSET_REFL] THEN REWRITE_TAC[relative_frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]);; let HOMOTOPY_EQUIVALENT_PUNCTURED_UNIV_SPHERE = prove (`!c a:real^N r. &0 < r ==> ((:real^N) DELETE c) homotopy_equivalent sphere(a,r)`, REPEAT GEN_TAC THEN GEN_GEOM_ORIGIN_TAC `c:real^N` ["a"] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN TRANS_TAC HOMOTOPY_EQUIVALENT_TRANS `sphere(vec 0:real^N,r)` THEN ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES; HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT] THEN MP_TAC(ISPECL [`cball(vec 0:real^N,r)`; `vec 0:real^N`] HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_FRONTIER_CBALL; RELATIVE_INTERIOR_CBALL] THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_IMP_NZ; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL; BALL_EQ_EMPTY; REAL_NOT_LE]);; (* ------------------------------------------------------------------------- *) (* Preservation of fixpoints under (more general notion of) retraction. *) (* ------------------------------------------------------------------------- *) let INVERTIBLE_FIXPOINT_PROPERTY = prove (`!s:real^M->bool t:real^N->bool i r. i continuous_on t /\ IMAGE i t SUBSET s /\ r continuous_on s /\ IMAGE r s SUBSET t /\ (!y. y IN t ==> (r(i(y)) = y)) ==> (!f. f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ (f x = x)) ==> !g. g continuous_on t /\ IMAGE g t SUBSET t ==> ?y. y IN t /\ (g y = y)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(i:real^N->real^M) o (g:real^N->real^N) o (r:real^M->real^N)`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONTINUOUS_ON_COMPOSE; IMAGE_SUBSET; SUBSET_TRANS; IMAGE_o]; RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]]);; let HOMEOMORPHIC_FIXPOINT_PROPERTY = prove (`!s t. s homeomorphic t ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ (f x = x)) <=> (!g. g continuous_on t /\ IMAGE g t SUBSET t ==> ?y. y IN t /\ (g y = y)))`, REWRITE_TAC[homeomorphic; homeomorphism] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC INVERTIBLE_FIXPOINT_PROPERTY THEN ASM_MESON_TAC[SUBSET_REFL]);; let RETRACT_FIXPOINT_PROPERTY = prove (`!s t:real^N->bool. t retract_of s /\ (!f. f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ (f x = x)) ==> !g. g continuous_on t /\ IMAGE g t SUBSET t ==> ?y. y IN t /\ (g y = y)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC INVERTIBLE_FIXPOINT_PROPERTY THEN EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[retract_of] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[retraction] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);; let FRONTIER_SUBSET_RETRACTION = prove (`!s:real^N->bool t r. bounded s /\ frontier s SUBSET t /\ r continuous_on (closure s) /\ IMAGE r s SUBSET t /\ (!x. x IN t ==> r x = x) ==> s SUBSET t`, ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[SET_RULE `~(s SUBSET t) <=> ?x. x IN s /\ ~(x IN t)`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN REPLICATE_TAC 3 GEN_TAC THEN X_GEN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN ABBREV_TAC `q = \z:real^N. if z IN closure s then r(z) else z` THEN SUBGOAL_THEN `(q:real^N->real^N) continuous_on closure(s) UNION closure((:real^N) DIFF s)` MP_TAC THENL [EXPAND_TAC "q" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_REWRITE_TAC[CLOSED_CLOSURE; CONTINUOUS_ON_ID] THEN REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; frontier; IN_DIFF]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `closure(s) UNION closure((:real^N) DIFF s) = (:real^N)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET closure s /\ t SUBSET closure t /\ s UNION t = UNIV ==> closure s UNION closure t = UNIV`) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN SET_TAC[]; DISCH_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL o MATCH_MP BOUNDED_CLOSURE) THEN SUBGOAL_THEN `!x. ~((q:real^N->real^N) x = a)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "q" THEN COND_CASES_TAC THENL [ASM_CASES_TAC `(x:real^N) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN t` (fun th -> ASM_MESON_TAC[th]) THEN UNDISCH_TAC `frontier(s:real^N->bool) SUBSET t` THEN REWRITE_TAC[SUBSET; frontier; IN_DIFF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET; CLOSURE_SUBSET]]; ALL_TAC] THEN MP_TAC(ISPECL [`a:real^N`; `B:real`] NO_RETRACTION_CBALL) THEN ASM_REWRITE_TAC[retract_of; GSYM FRONTIER_CBALL] THEN EXISTS_TAC `(\y. a + B / norm(y - a) % (y - a)) o (q:real^N->real^N)` THEN REWRITE_TAC[retraction; FRONTIER_SUBSET_EQ; CLOSED_CBALL] THEN REWRITE_TAC[FRONTIER_CBALL; SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_SPHERE; DIST_0] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; NORM_EQ_0; VECTOR_SUB_EQ] THEN SUBGOAL_THEN `(\x:real^N. lift(norm(x - a))) = (lift o norm) o (\x. x - a)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM]; REWRITE_TAC[o_THM; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_ARITH `dist(a,a + b) = norm b`] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN EXPAND_TAC "q" THEN REWRITE_TAC[] THEN COND_CASES_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_BALL]) THEN ASM_MESON_TAC[REAL_LT_REFL]; REWRITE_TAC[NORM_ARITH `norm(x - a) = dist(a,x)`] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN VECTOR_ARITH_TAC]]);; let NO_RETRACTION_FRONTIER_BOUNDED = prove (`!s:real^N->bool. bounded s /\ ~(interior s = {}) ==> ~((frontier s) retract_of s)`, GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[retract_of; retraction] THEN REWRITE_TAC[FRONTIER_SUBSET_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `frontier s:real^N->bool`; `r:real^N->real^N`] FRONTIER_SUBSET_RETRACTION) THEN ASM_SIMP_TAC[CLOSURE_CLOSED; SUBSET_REFL] THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]);; let COMPACT_SUBSET_FRONTIER_RETRACTION = prove (`!f:real^N->real^N s. compact s /\ f continuous_on s /\ (!x. x IN frontier s ==> f x = x) ==> s SUBSET IMAGE f s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s UNION (IMAGE f s):real^N->bool`; `vec 0:real^N`] BOUNDED_SUBSET_BALL) THEN ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE; UNION_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `g = \x:real^N. if x IN s then f(x) else x` THEN SUBGOAL_THEN `(g:real^N->real^N) continuous_on (:real^N)` ASSUME_TAC THENL [SUBGOAL_THEN `(:real^N) = s UNION closure((:real^N) DIFF s)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `UNIV DIFF s SUBSET t ==> UNIV = s UNION t`) THEN REWRITE_TAC[CLOSURE_SUBSET]; ALL_TAC] THEN EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_CLOSURE; CONTINUOUS_ON_ID; COMPACT_IMP_CLOSED] THEN REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `p:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?h:real^N->real^N. retraction (UNIV DELETE p,sphere(vec 0,r)) h` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM retract_of] THEN MATCH_MP_TAC SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`vec 0:real^N`; `r:real`] NO_RETRACTION_CBALL) THEN ASM_REWRITE_TAC[retract_of; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `(h:real^N->real^N) o (g:real^N->real^N)`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[retraction] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN SIMP_TAC[SUBSET; IN_SPHERE; IN_CBALL; REAL_EQ_IMP_LE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; o_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN cball (vec 0,r) ==> ~((g:real^N->real^N) x = p)` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN COND_CASES_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE]; SUBGOAL_THEN `(g:real^N->real^N) x = x` (fun th -> ASM_SIMP_TAC[th]) THEN EXPAND_TAC "g" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[IN_BALL; REAL_LT_REFL; SUBSET]]);; let NOT_ABSOLUTE_RETRACT_COBOUNDED = prove (`!s. bounded s /\ ((:real^N) DIFF s) retract_of (:real^N) ==> s = {}`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> F) ==> s = {}`) THEN X_GEN_TAC `a:real^N` THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN REWRITE_TAC[] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `(:real^N)` THEN SIMP_TAC[SUBSET_UNIV; SPHERE_SUBSET_CBALL] THEN MATCH_MP_TAC RETRACT_OF_TRANS THEN EXISTS_TAC `(:real^N) DIFF s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `(:real^N) DELETE (vec 0)` THEN ASM_SIMP_TAC[SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_SPHERE; IN_DIFF; IN_UNIV] THEN MESON_TAC[REAL_LT_REFL]);; (* ------------------------------------------------------------------------- *) (* Bohl-type fixed point theorems. *) (* ------------------------------------------------------------------------- *) let BOHL = prove (`!f s a:real^N. f continuous_on s /\ convex s /\ compact s /\ a IN interior s ==> (?x. x IN s /\ f x = x) \/ (?x. x IN frontier s /\ x IN segment(a,f x))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERIOR_EMPTY] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `affine hull s:real^N->bool`; `a:real^N`] RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX) THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; COMPACT_IMP_BOUNDED] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `a IN s ==> ~(s = {})`)) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_NONEMPTY_INTERIOR; RELATIVE_FRONTIER_NONEMPTY_INTERIOR] THEN SIMP_TAC[SUBSET_REFL; frontier; CLOSURE_SUBSET_AFFINE_HULL; SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN ASM_SIMP_TAC[AFFINE_HULL_NONEMPTY_INTERIOR; GSYM frontier] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(\x. if x IN s then x else r x) o (f:real^N->real^N)`; `s:real^N->bool`] BROUWER) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `IMAGE (f:real^N->real^N) s = s INTER IMAGE f s UNION ((:real^N) DIFF interior s) INTER IMAGE f s` SUBST1_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_CLOSED; GSYM OPEN_CLOSED; OPEN_INTERIOR] THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE r t SUBSET u ==> u SUBSET s /\ y IN t ==> r y IN s`)) THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]]; REWRITE_TAC[OR_EXISTS_THM; o_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ASM_CASES_TAC `f(x:real^N) = x` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `~((f:real^N->real^N) x = a)` ASSUME_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_SEGMENT]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `c:real` MP_TAC o SPEC `(f:real^N->real^N) x`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[VECTOR_ARITH `x:real^N = (&1 - c) % a + c % y <=> x - a = c % (y - a)`] THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN UNDISCH_TAC `~((f:real^N->real^N) x IN s)` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `x:real^N`; `&1 - inv c`; `inv(c):real`]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_INV_LE_1; REAL_ARITH `(&1 - u) + u = &1`] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (VECTOR_ARITH `x - a:real^N = y ==> x = a + y`) th]) THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 <= c ==> ~(c = &0)`] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC VECTOR_ARITH]);; let BOHL_ALT = prove (`!f s a. f continuous_on s /\ convex s /\ compact s /\ a IN interior s /\ IMAGE f s SUBSET (:real^N) DELETE a ==> ?x. x IN frontier s /\ a IN segment(x,f x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. x + (a - f(x))`; `s:real^N->bool`; `a:real^N`] BOHL) THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[VECTOR_ARITH `x + a - y:real^N = x <=> y = a`] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[IN_SEGMENT; VECTOR_ARITH `a:real^N = x + a - y <=> y = x`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN CONV_TAC VECTOR_ARITH);; let BOHL_SIMPLE = prove (`!f:real^N->real^N s a. compact s /\ a IN s /\ f continuous_on s /\ IMAGE f s SUBSET (:real^N) DELETE a ==> ?x. x IN frontier s /\ ~(f x = x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] COMPACT_SUBSET_FRONTIER_RETRACTION) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some more theorems about connectivity of retract complements. *) (* ------------------------------------------------------------------------- *) let BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS = prove (`!s t c. closed s /\ s retract_of t /\ c IN components((:real^N) DIFF s) /\ bounded c ==> ~(c SUBSET t)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN SUBGOAL_THEN `frontier(c:real^N->bool) SUBSET s` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `frontier((:real^N) DIFF s)` THEN ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_SUBSET] THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `closure(c:real^N->bool) SUBSET t` ASSUME_TAC THENL [REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL [MATCH_MP_TAC FRONTIER_SUBSET_RETRACTION THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]]);; let COMPONENT_RETRACT_COMPLEMENT_MEETS = prove (`!s t c. closed s /\ s retract_of t /\ bounded t /\ c IN components((:real^N) DIFF s) ==> ~(c SUBSET t)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ASM_CASES_TAC `bounded(c:real^N->bool)` THENL [ASM_MESON_TAC[BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS]; ASM_MESON_TAC[BOUNDED_SUBSET]]);; let FINITE_COMPLEMENT_ENR_COMPONENTS = prove (`!s. compact s /\ ENR s ==> FINITE(components((:real^N) DIFF s))`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_SIMP_TAC[DIFF_EMPTY] THEN MESON_TAC[COMPONENTS_EQ_SING; CONNECTED_UNIV; UNIV_NOT_EMPTY; FINITE_SING]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[ENR_BOUNDED; COMPACT_IMP_BOUNDED] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!c. c IN components((:real^N) DIFF s) ==> ~(c SUBSET u)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC COMPONENT_RETRACT_COMPLEMENT_MEETS THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED]; ALL_TAC] THEN MP_TAC(ISPECL [`u:real^N->bool`; `vec 0:real^N`] BOUNDED_SUBSET_CBALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN MP_TAC(ISPECL [`cball(vec 0:real^N,r) DIFF u`; `(:real^N) DIFF s`] FINITE_COMPONENTS_MEETING_COMPACT_SUBSET) THEN ASM_SIMP_TAC[COMPACT_DIFF; COMPACT_CBALL; OPEN_IMP_LOCALLY_CONNECTED; GSYM closed; COMPACT_IMP_CLOSED] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC] THEN MATCH_MP_TAC(SET_RULE `(!c. c IN s ==> P c) ==> {c | c IN s /\ P c} = s`) THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `~(c INTER frontier(u:real^N->bool) = {})` MP_TAC THENL [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN ASM_SIMP_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN MATCH_MP_TAC(SET_RULE `~(t = {}) /\ t SUBSET u ==> ~(u INTER (s UNION t) = {})`) THEN ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `frontier((:real^N) DIFF s)` THEN ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_SUBSET] THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(c INTER s = {}) ==> ~(c INTER t = {})`) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t DIFF u`) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[CLOSED_CBALL]]);; let FINITE_COMPLEMENT_ANR_COMPONENTS = prove (`!s. compact s /\ ANR s ==> FINITE(components((:real^N) DIFF s))`, MESON_TAC[FINITE_COMPLEMENT_ENR_COMPONENTS; ENR_ANR; COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT]);; let CARD_LE_RETRACT_COMPLEMENT_COMPONENTS = prove (`!s t. compact s /\ s retract_of t /\ bounded t ==> components((:real^N) DIFF s) <=_c components((:real^N) DIFF t)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN MATCH_MP_TAC(ISPEC `SUBSET` CARD_LE_RELATIONAL_FULL) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`d:real^N->bool`; `c:real^N->bool`; `c':real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ) THEN ASM_SIMP_TAC[] THEN ASM_CASES_TAC `d:real^N->bool = {}` THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `~((u:real^N->bool) SUBSET t)` MP_TAC THENL [MATCH_MP_TAC COMPONENT_RETRACT_COMPLEMENT_MEETS THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `~(s SUBSET t) <=> ?p. p IN s /\ ~(p IN t)`] THEN REWRITE_TAC[components; EXISTS_IN_GSPEC; IN_UNIV; IN_DIFF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `u = connected_component ((:real^N) DIFF s) p` SUBST_ALL_TAC THENL [MP_TAC(ISPECL [`(:real^N) DIFF s`; `u:real^N->bool`] COMPONENTS_EQ) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `p:real^N` THEN ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]]);; let CONNECTED_RETRACT_COMPLEMENT = prove (`!s t. compact s /\ s retract_of t /\ bounded t /\ connected((:real^N) DIFF t) ==> connected((:real^N) DIFF s)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_TAC `u:real^N->bool`) THEN SUBGOAL_THEN `FINITE(components((:real^N) DIFF t))` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; FINITE_SING]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] CARD_LE_RETRACT_COMPLEMENT_COMPONENTS) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `FINITE(components((:real^N) DIFF s)) /\ CARD(components((:real^N) DIFF s)) <= CARD(components((:real^N) DIFF t))` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CARD_LE_CARD_IMP; CARD_LE_FINITE]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN REWRITE_TAC[EXISTS_OR_THM] THEN REWRITE_TAC[GSYM HAS_SIZE_0; GSYM(HAS_SIZE_CONV `s HAS_SIZE 1`)] THEN ASM_REWRITE_TAC[HAS_SIZE; ARITH_RULE `n = 0 \/ n = 1 <=> n <= 1`] THEN TRANS_TAC LE_TRANS `CARD{u:real^N->bool}` THEN CONJ_TAC THENL [TRANS_TAC LE_TRANS `CARD(components((:real^N) DIFF t))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[FINITE_SING]; SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* We also get fixpoint properties for suitable ANRs. *) (* ------------------------------------------------------------------------- *) let BROUWER_INESSENTIAL_ANR = prove (`!f:real^N->real^N s. compact s /\ ~(s = {}) /\ ANR s /\ f continuous_on s /\ IMAGE f s SUBSET s /\ (?a. homotopic_with (\x. T) (s,s) f (\x. a)) ==> ?x. x IN s /\ f x = x`, ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `r:real` o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL o MATCH_MP COMPACT_IMP_BOUNDED) THEN MP_TAC(ISPECL [`(\x. a):real^N->real^N`; `f:real^N->real^N`; `s:real^N->bool`; `cball(vec 0:real^N,r)`; `s:real^N->bool`] BORSUK_HOMOTOPY_EXTENSION) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SUBSET; CONTINUOUS_ON_CONST; CLOSED_CBALL] THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^N->real^N`; `cball(vec 0:real^N,r)`] BROUWER) THEN ASM_SIMP_TAC[COMPACT_CBALL; CONVEX_CBALL; CBALL_EQ_EMPTY] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN ASM SET_TAC[]);; let BROUWER_CONTRACTIBLE_ANR = prove (`!f:real^N->real^N s. compact s /\ contractible s /\ ~(s = {}) /\ ANR s /\ f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ f x = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_INESSENTIAL_ANR THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);; let FIXED_POINT_INESSENTIAL_SPHERE_MAP = prove (`!f a:real^N r c. &0 < r /\ homotopic_with (\x. T) (sphere(a,r),sphere(a,r)) f (\x. c) ==> ?x. x IN sphere(a,r) /\ f x = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_INESSENTIAL_ANR THEN REWRITE_TAC[ANR_SPHERE] THEN ASM_SIMP_TAC[SPHERE_EQ_EMPTY; COMPACT_SPHERE; OPEN_DELETE; OPEN_UNIV] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN ASM_MESON_TAC[]);; let BROUWER_AR = prove (`!f s:real^N->bool. compact s /\ AR s /\ f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ f x = x`, REWRITE_TAC[AR_ANR] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_CONTRACTIBLE_ANR THEN ASM_REWRITE_TAC[]);; let BROUWER_ABSOLUTE_RETRACT = prove (`!f s. compact s /\ s retract_of (:real^N) /\ f continuous_on s /\ IMAGE f s SUBSET s ==> ?x. x IN s /\ f x = x`, REWRITE_TAC[RETRACT_OF_UNIV; AR_ANR] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_CONTRACTIBLE_ANR THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* This interesting lemma is no longer used for Schauder but we keep it. *) (* ------------------------------------------------------------------------- *) let SCHAUDER_PROJECTION = prove (`!s:real^N->bool e. compact s /\ &0 < e ==> ?t f. FINITE t /\ t SUBSET s /\ f continuous_on s /\ IMAGE f s SUBSET (convex hull t) /\ (!x. x IN s ==> norm(f x - x) < e)`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `e:real` o MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `g = \p x:real^N. max (&0) (e - norm(x - p))` THEN SUBGOAL_THEN `!x. x IN s ==> &0 < sum t (\p. (g:real^N->real^N->real) p x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LT THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "g" THEN REWRITE_TAC[REAL_ARITH `&0 <= max (&0) b`] THEN REWRITE_TAC[REAL_ARITH `&0 < max (&0) b <=> &0 < b`; REAL_SUB_LT] THEN UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^N. ball(x,e)) t)` THEN REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_BALL; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[dist; NORM_SUB]; ALL_TAC] THEN EXISTS_TAC `(\x. inv(sum t (\p. g p x)) % vsum t (\p. g p x % p)):real^N->real^N` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; LIFT_SUM; o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_VSUM THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_ON_MUL] THEN REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN EXPAND_TAC "g" THEN (SUBGOAL_THEN `(\x. lift (max (&0) (e - norm (x - y:real^N)))) = (\x. (lambda i. max (lift(&0)$i) (lift(e - norm (x - y))$i)))` SUBST1_TAC THENL [SIMP_TAC[CART_EQ; LAMBDA_BETA; FUN_EQ_THM] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]; MATCH_MP_TAC CONTINUOUS_ON_MAX] THEN REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] (GSYM dist)] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]); REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM VSUM_LMUL; VECTOR_MUL_ASSOC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN ASM_SIMP_TAC[HULL_INC; CONVEX_CONVEX_HULL; SUM_LMUL] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN EXPAND_TAC "g" THEN REAL_ARITH_TAC; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[REWRITE_RULE[dist] (GSYM IN_BALL)] THEN REWRITE_TAC[GSYM VSUM_LMUL; VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC CONVEX_VSUM_STRONG THEN ASM_REWRITE_TAC[CONVEX_BALL; SUM_LMUL; REAL_ENTIRE] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV; REAL_LT_INV_EQ; REAL_LE_MUL_EQ] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[IN_BALL; dist; NORM_SUB] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Some other related fixed-point theorems. *) (* ------------------------------------------------------------------------- *) let BROUWER_FACTOR_THROUGH_AR = prove (`!f:real^M->real^N g:real^N->real^M s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ compact s /\ AR t ==> ?x. x IN s /\ g(f x) = x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_BOUNDED_CLOSED]) THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^M` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^M->bool`; `t:real^N->bool`] AR_IMP_ABSOLUTE_EXTENSOR) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(g:real^N->real^M) o (h:real^M->real^N)`; `a:real^M`; `r:real`] BROUWER_BALL) THEN ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV; IMAGE_SUBSET]);; let BROUWER_ABSOLUTE_RETRACT_GEN = prove (`!f s:real^N->bool. s retract_of (:real^N) /\ f continuous_on s /\ IMAGE f s SUBSET s /\ bounded(IMAGE f s) ==> ?x. x IN s /\ f x = x`, REWRITE_TAC[RETRACT_OF_UNIV] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. x`; `f:real^N->real^N`; `closure(IMAGE (f:real^N->real^N) s)`; `s:real^N->bool`] BROUWER_FACTOR_THROUGH_AR) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; COMPACT_CLOSURE; IMAGE_ID] THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC(TAUT `(p /\ q ==> r) /\ p ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CLOSURE_MINIMAL] THEN ASM_MESON_TAC[RETRACT_OF_CLOSED; CLOSED_UNIV]);; let SCHAUDER_GEN = prove (`!f s t:real^N->bool. AR s /\ f continuous_on s /\ IMAGE f s SUBSET t /\ t SUBSET s /\ compact t ==> ?x. x IN t /\ f x = x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. x`; `f:real^N->real^N`; `t:real^N->bool`; `s:real^N->bool`] BROUWER_FACTOR_THROUGH_AR) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; let SCHAUDER = prove (`!f s t:real^N->bool. convex s /\ ~(s = {}) /\ t SUBSET s /\ compact t /\ f continuous_on s /\ IMAGE f s SUBSET t ==> ?x. x IN s /\ f x = x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`; `t:real^N->bool`] SCHAUDER_GEN) THEN ASM_SIMP_TAC[CONVEX_IMP_AR] THEN ASM SET_TAC[]);; let SCHAUDER_UNIV = prove (`!f:real^N->real^N. f continuous_on (:real^N) /\ bounded (IMAGE f (:real^N)) ==> ?x. f x = x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`; `closure(IMAGE (f:real^N->real^N) (:real^N))`] SCHAUDER) THEN ASM_REWRITE_TAC[UNIV_NOT_EMPTY; CONVEX_UNIV; COMPACT_CLOSURE; IN_UNIV] THEN REWRITE_TAC[SUBSET_UNIV; CLOSURE_SUBSET]);; let ROTHE = prove (`!f s:real^N->bool. closed s /\ convex s /\ ~(s = {}) /\ f continuous_on s /\ bounded(IMAGE f s) /\ IMAGE f (frontier s) SUBSET s ==> ?x. x IN s /\ f x = x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] ABSOLUTE_RETRACTION_CONVEX_CLOSED) THEN ASM_REWRITE_TAC[retraction; SUBSET_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(r:real^N->real^N) o (f:real^N->real^N)`; `s:real^N->bool`; `IMAGE (r:real^N->real^N) (closure(IMAGE (f:real^N->real^N) s))`] SCHAUDER) THEN ANTS_TAC THENL [ASM_SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET; IMAGE_o] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Perron-Frobenius theorem. *) (* ------------------------------------------------------------------------- *) let PERRON_FROBENIUS = prove (`!A:real^N^N. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> &0 <= A$i$j) ==> ?v c. norm v = &1 /\ &0 <= c /\ A ** v = c % v`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `?v. ~(v = vec 0) /\ (A:real^N^N) ** v = vec 0` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(norm v) % v:real^N` THEN EXISTS_TAC `&0` THEN ASM_SIMP_TAC[REAL_LE_REFL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; MATRIX_VECTOR_MUL_RMUL] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN REWRITE_TAC[TAUT `~(~p /\ q) <=> q ==> p`] THEN DISCH_TAC] THEN MP_TAC(ISPECL [`\x:real^N. inv(vec 1 dot (A ** x)) % ((A:real^N^N) ** x)`; `{x:real^N | vec 1 dot x = &1} INTER {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`] BROUWER) THEN SIMP_TAC[CONVEX_INTER; CONVEX_POSITIVE_ORTHANT; CONVEX_HYPERPLANE] THEN SUBGOAL_THEN `!x. (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i) ==> !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= ((A:real^N^N) ** x)$i` ASSUME_TAC THENL [GEN_TAC THEN STRIP_TAC THEN SIMP_TAC[matrix_vector_mul; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_MESON_TAC[REAL_LE_MUL]; ALL_TAC] THEN SUBGOAL_THEN `!x. (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i) /\ vec 1 dot x = &1 ==> &0 < vec 1 dot ((A:real^N^N) ** x)` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN DISCH_TAC THEN REWRITE_TAC[dot; VEC_COMPONENT; REAL_MUL_LID] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_MESON_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] SUM_POS_EQ_0_NUMSEG)) THEN RULE_ASSUM_TAC(REWRITE_RULE[CART_EQ; VEC_COMPONENT]) THEN ASM_MESON_TAC[]]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; CLOSED_HYPERPLANE; CLOSED_POSITIVE_ORTHANT] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[vec 0:real^N,vec 1]` THEN SIMP_TAC[BOUNDED_INTERVAL; SUBSET; IN_INTER; IN_ELIM_THM; IN_INTERVAL; dot; VEC_COMPONENT; REAL_MUL_LID] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN TRANS_TAC REAL_LE_TRANS `sum {i} (\i. (x:real^N)$i)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_SING; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN REWRITE_TAC[FINITE_SING; FINITE_NUMSEG] THEN ASM_SIMP_TAC[SING_SUBSET; IN_SING; IN_DIFF; IN_NUMSEG]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `basis 1:real^N` THEN SIMP_TAC[IN_INTER; IN_ELIM_THM; BASIS_COMPONENT] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_POS]] THEN SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; VEC_COMPONENT]; MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[CONTINUOUS_ON_LIFT_DOT2; MATRIX_VECTOR_MUL_LINEAR; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_REFL]; SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[DOT_RMUL] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_MESON_TAC[REAL_LT_IMP_LE]]]; REWRITE_TAC[IN_INTER; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN EXISTS_TAC `inv(norm x) % x:real^N` THEN EXISTS_TAC `vec 1 dot ((A:real^N^N) ** x)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[NORM_EQ_0]; ASM_MESON_TAC[REAL_LT_IMP_LE]; REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM o AP_TERM `(%) (vec 1 dot ((A:real^N^N) ** x)):real^N->real^N`) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_EQ_0; VECTOR_ARITH `v:real^N = c % v <=> (c - &1) % v = vec 0`] THEN DISJ1_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN MATCH_MP_TAC REAL_MUL_RINV THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN ASM_MESON_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Bijections between intervals. *) (* ------------------------------------------------------------------------- *) let interval_bij = new_definition `interval_bij (a:real^N,b:real^N) (u:real^N,v:real^N) (x:real^N) = (lambda i. u$i + (x$i - a$i) / (b$i - a$i) * (v$i - u$i)):real^N`;; let INTERVAL_BIJ_AFFINE = prove (`interval_bij (a,b) (u,v) = \x. (lambda i. (v$i - u$i) / (b$i - a$i) * x$i) + (lambda i. u$i - (v$i - u$i) / (b$i - a$i) * a$i)`, SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA; interval_bij] THEN REAL_ARITH_TAC);; let CONTINUOUS_INTERVAL_BIJ = prove (`!a b u v x. (interval_bij (a:real^N,b:real^N) (u:real^N,v:real^N)) continuous at x`, REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_BIJ_AFFINE] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);; let CONTINUOUS_ON_INTERVAL_BIJ = prove (`!a b u v s. interval_bij (a,b) (u,v) continuous_on s`, REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REWRITE_TAC[CONTINUOUS_INTERVAL_BIJ]);; let IN_INTERVAL_INTERVAL_BIJ = prove (`!a b u v x:real^N. x IN interval[a,b] /\ ~(interval[u,v] = {}) ==> (interval_bij (a,b) (u,v) x) IN interval[u,v]`, SIMP_TAC[IN_INTERVAL; interval_bij; LAMBDA_BETA; INTERVAL_NE_EMPTY] THEN REWRITE_TAC[REAL_ARITH `u <= u + x <=> &0 <= x`; REAL_ARITH `u + x <= v <=> x <= &1 * (v - u)`] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LE_DIV) THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN ASM_MESON_TAC[REAL_LE_TRANS]; MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN SUBGOAL_THEN `(a:real^N)$i <= (b:real^N)$i` MP_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[REAL_ARITH `a <= x /\ x <= b ==> x - a <= &1 * (b - a)`]; ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_INV_0] THEN REAL_ARITH_TAC]]);; let INTERVAL_BIJ_BIJ = prove (`!a b u v x:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i /\ u$i < v$i) ==> interval_bij (a,b) (u,v) (interval_bij (u,v) (a,b) x) = x`, SIMP_TAC[interval_bij; CART_EQ; LAMBDA_BETA; REAL_ADD_SUB] THEN REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Fashoda meet theorem. *) (* ------------------------------------------------------------------------- *) let INFNORM_2 = prove (`infnorm (x:real^2) = max (abs(x$1)) (abs(x$2))`, REWRITE_TAC[infnorm; INFNORM_SET_IMAGE; NUMSEG_CONV `1..2`; DIMINDEX_2] THEN REWRITE_TAC[IMAGE_CLAUSES; GSYM REAL_MAX_SUP]);; let INFNORM_EQ_1_2 = prove (`infnorm (x:real^2) = &1 <=> abs(x$1) <= &1 /\ abs(x$2) <= &1 /\ (x$1 = -- &1 \/ x$1 = &1 \/ x$2 = -- &1 \/ x$2 = &1)`, REWRITE_TAC[INFNORM_2] THEN REAL_ARITH_TAC);; let INFNORM_EQ_1_IMP = prove (`infnorm (x:real^2) = &1 ==> abs(x$1) <= &1 /\ abs(x$2) <= &1`, SIMP_TAC[INFNORM_EQ_1_2]);; let FASHODA_UNIT = prove (`!f:real^1->real^2 g:real^1->real^2. IMAGE f (interval[--vec 1,vec 1]) SUBSET interval[--vec 1,vec 1] /\ IMAGE g (interval[--vec 1,vec 1]) SUBSET interval[--vec 1,vec 1] /\ f continuous_on interval[--vec 1,vec 1] /\ g continuous_on interval[--vec 1,vec 1] /\ f(--vec 1)$1 = -- &1 /\ f(vec 1)$1 = &1 /\ g(--vec 1)$2 = -- &1 /\ g(vec 1)$2 = &1 ==> ?s t. s IN interval[--vec 1,vec 1] /\ t IN interval[--vec 1,vec 1] /\ f(s) = g(t)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_THEN(MP_TAC o REWRITE_RULE[NOT_EXISTS_THM]) THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN DISCH_TAC THEN ABBREV_TAC `sqprojection = \z:real^2. inv(infnorm z) % z` THEN ABBREV_TAC `(negatex:real^2->real^2) = \x. vector[--(x$1); x$2]` THEN SUBGOAL_THEN `!z:real^2. infnorm(negatex z:real^2) = infnorm z` ASSUME_TAC THENL [EXPAND_TAC "negatex" THEN SIMP_TAC[VECTOR_2; INFNORM_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!z. ~(z = vec 0) ==> infnorm((sqprojection:real^2->real^2) z) = &1` ASSUME_TAC THENL [EXPAND_TAC "sqprojection" THEN REWRITE_TAC[INFNORM_MUL; REAL_ABS_INFNORM; REAL_ABS_INV] THEN SIMP_TAC[REAL_MUL_LINV; INFNORM_EQ_0]; ALL_TAC] THEN MP_TAC(ISPECL [`(\w. (negatex:real^2->real^2) (sqprojection(f(lift(w$1)) - g(lift(w$2)):real^2))) :real^2->real^2`; `interval[--vec 1,vec 1]:real^2->bool`] BROUWER_WEAK) THEN REWRITE_TAC[NOT_IMP; COMPACT_INTERVAL; CONVEX_INTERVAL] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_NE_EMPTY] THEN SIMP_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN EXPAND_TAC "negatex" THEN SIMP_TAC[linear; VECTOR_2; CART_EQ; FORALL_2; DIMINDEX_2; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; ARITH] THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; DIMINDEX_2; ARITH] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[--vec 1:real^1,vec 1]`; MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN EXPAND_TAC "sqprojection" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_INV THEN REWRITE_TAC[CONTINUOUS_AT_LIFT_INFNORM; INFNORM_EQ_0; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL])] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; REAL_BOUNDS_LE; VECTOR_NEG_COMPONENT; VEC_COMPONENT; ARITH] THEN MATCH_MP_TAC INFNORM_EQ_1_IMP THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^2` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `infnorm(x:real^2) = &1` MP_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM th]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP]; ALL_TAC] THEN SUBGOAL_THEN `(!x i. 1 <= i /\ i <= 2 /\ ~(x = vec 0) ==> (&0 < ((sqprojection:real^2->real^2) x)$i <=> &0 < x$i)) /\ (!x i. 1 <= i /\ i <= 2 /\ ~(x = vec 0) ==> ((sqprojection x)$i < &0 <=> x$i < &0))` STRIP_ASSUME_TAC THENL [EXPAND_TAC "sqprojection" THEN SIMP_TAC[VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; INFNORM_POS_LT] THEN REWRITE_TAC[REAL_MUL_LZERO]; ALL_TAC] THEN REWRITE_TAC[INFNORM_EQ_1_2; CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (REPEAT_TCL DISJ_CASES_THEN (fun th -> ASSUME_TAC th THEN MP_TAC th))) THEN MAP_EVERY EXPAND_TAC ["x"; "negatex"] THEN REWRITE_TAC[VECTOR_2] THENL [DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--x = -- &1 ==> &0 < x`)); DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--x = &1 ==> x < &0`)); DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = -- &1 ==> x < &0`)); DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = &1 ==> &0 < x`))] THEN W(fun (_,w) -> FIRST_X_ASSUM(fun th -> MP_TAC(PART_MATCH (lhs o rand) th (lhand w)))) THEN (ANTS_TAC THENL [REWRITE_TAC[VECTOR_SUB_EQ; ARITH] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC]) THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH; LIFT_NEG; LIFT_NUM] THENL [MATCH_MP_TAC(REAL_ARITH `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&0 < -- &1 - x$1)`); MATCH_MP_TAC(REAL_ARITH `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&1 - x$1 < &0)`); MATCH_MP_TAC(REAL_ARITH `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(x$2 - -- &1 < &0)`); MATCH_MP_TAC(REAL_ARITH `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&0 < x$2 - &1)`)] THEN (SUBGOAL_THEN `!z:real^2. abs(z$1) <= &1 /\ abs(z$2) <= &1 <=> z IN interval[--vec 1,vec 1]` (fun th -> REWRITE_TAC[th]) THENL [SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f s SUBSET t ==> x IN s ==> f x IN t`)) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; LIFT_DROP] THEN ASM_REWRITE_TAC[REAL_BOUNDS_LE]);; let FASHODA_UNIT_PATH = prove (`!f:real^1->real^2 g:real^1->real^2. path f /\ path g /\ path_image f SUBSET interval[--vec 1,vec 1] /\ path_image g SUBSET interval[--vec 1,vec 1] /\ (pathstart f)$1 = -- &1 /\ (pathfinish f)$1 = &1 /\ (pathstart g)$2 = -- &1 /\ (pathfinish g)$2 = &1 ==> ?z. z IN path_image f /\ z IN path_image g`, SIMP_TAC[path; path_image; pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `iscale = \z:real^1. inv(&2) % (z + vec 1)` THEN MP_TAC(ISPECL [`(f:real^1->real^2) o (iscale:real^1->real^1)`; `(g:real^1->real^2) o (iscale:real^1->real^1)`] FASHODA_UNIT) THEN SUBGOAL_THEN `IMAGE (iscale:real^1->real^1) (interval[--vec 1,vec 1]) SUBSET interval[vec 0,vec 1]` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN EXPAND_TAC "iscale" THEN REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(iscale:real^1->real^1) continuous_on interval [--vec 1,vec 1]` ASSUME_TAC THENL [EXPAND_TAC "iscale" THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST]; ALL_TAC] THEN ASM_REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL [REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REPLICATE_TAC 2 (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC]) THEN EXPAND_TAC "iscale" THEN REWRITE_TAC[o_THM] THEN ASM_REWRITE_TAC[VECTOR_ARITH `inv(&2) % (--x + x) = vec 0`; VECTOR_ARITH `inv(&2) % (x + x) = x`]; REWRITE_TAC[o_THM; LEFT_IMP_EXISTS_THM; IN_IMAGE] THEN ASM SET_TAC[]]);; let FASHODA = prove (`!f g a b:real^2. path f /\ path g /\ path_image f SUBSET interval[a,b] /\ path_image g SUBSET interval[a,b] /\ (pathstart f)$1 = a$1 /\ (pathfinish f)$1 = b$1 /\ (pathstart g)$2 = a$2 /\ (pathfinish g)$2 = b$2 ==> ?z. z IN path_image f /\ z IN path_image g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(interval[a:real^2,b] = {})` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN REWRITE_TAC[PATH_IMAGE_NONEMPTY]; ALL_TAC] THEN REWRITE_TAC[INTERVAL_NE_EMPTY; DIMINDEX_2; FORALL_2] THEN STRIP_TAC THEN MP_TAC(ASSUME `(a:real^2)$1 <= (b:real^2)$1`) THEN REWRITE_TAC[REAL_ARITH `a <= b <=> b = a \/ a < b`] THEN STRIP_TAC THENL [SUBGOAL_THEN `?z:real^2. z IN path_image g /\ z$2 = (pathstart f:real^2)$2` MP_TAC THENL [MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN MAP_EVERY EXISTS_TAC [`pathstart(g:real^1->real^2)`; `pathfinish(g:real^1->real^2)`] THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; REAL_LE_REFL; PATHFINISH_IN_PATH_IMAGE; DIMINDEX_2; ARITH] THEN UNDISCH_TAC `path_image f SUBSET interval[a:real^2,b]` THEN REWRITE_TAC[SUBSET; path_image; IN_INTERVAL_1; FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN SIMP_TAC[pathstart] THEN SIMP_TAC[DROP_VEC; REAL_POS; IN_INTERVAL; FORALL_2; DIMINDEX_2]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN ASM_REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; pathstart] THEN SUBGOAL_THEN `(z:real^2) IN interval[a,b] /\ f(vec 0:real^1) IN interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE; PATHSTART_IN_PATH_IMAGE; pathstart]; ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC]; ALL_TAC] THEN MP_TAC(ASSUME `(a:real^2)$2 <= (b:real^2)$2`) THEN REWRITE_TAC[REAL_ARITH `a <= b <=> b = a \/ a < b`] THEN STRIP_TAC THENL [SUBGOAL_THEN `?z:real^2. z IN path_image f /\ z$1 = (pathstart g:real^2)$1` MP_TAC THENL [MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN MAP_EVERY EXISTS_TAC [`pathstart(f:real^1->real^2)`; `pathfinish(f:real^1->real^2)`] THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; REAL_LE_REFL; PATHFINISH_IN_PATH_IMAGE; DIMINDEX_2; ARITH] THEN UNDISCH_TAC `path_image g SUBSET interval[a:real^2,b]` THEN REWRITE_TAC[SUBSET; path_image; IN_INTERVAL_1; FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN SIMP_TAC[pathstart] THEN SIMP_TAC[DROP_VEC; REAL_POS; IN_INTERVAL; FORALL_2; DIMINDEX_2]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN ASM_REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; pathstart] THEN SUBGOAL_THEN `(z:real^2) IN interval[a,b] /\ g(vec 0:real^1) IN interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE; PATHSTART_IN_PATH_IMAGE; pathstart]; ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC]; ALL_TAC] THEN MP_TAC(ISPECL [`interval_bij (a,b) (--vec 1,vec 1) o (f:real^1->real^2)`; `interval_bij (a,b) (--vec 1,vec 1) o (g:real^1->real^2)`] FASHODA_UNIT_PATH) THEN RULE_ASSUM_TAC(REWRITE_RULE[path; path_image; pathstart; pathfinish]) THEN ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish; o_THM] THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_INTERVAL_BIJ] THEN REWRITE_TAC[IMAGE_o] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_INTERVAL_INTERVAL_BIJ THEN SIMP_TAC[INTERVAL_NE_EMPTY; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM SET_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[interval_bij; LAMBDA_BETA; DIMINDEX_2; ARITH] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO] THEN SIMP_TAC[VECTOR_NEG_COMPONENT; VEC_COMPONENT; DIMINDEX_2; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^2` (fun th -> EXISTS_TAC `interval_bij (--vec 1,vec 1) (a,b) (z:real^2)` THEN MP_TAC th)) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> g(f(x)) = x) ==> x IN IMAGE f s ==> g x IN s`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERVAL_BIJ_BIJ THEN ASM_SIMP_TAC[FORALL_2; DIMINDEX_2; VECTOR_NEG_COMPONENT; VEC_COMPONENT; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Some slightly ad hoc lemmas I use below *) (* ------------------------------------------------------------------------- *) let SEGMENT_VERTICAL = prove (`!a:real^2 b:real^2 x:real^2. a$1 = b$1 ==> (x IN segment[a,b] <=> x$1 = a$1 /\ x$1 = b$1 /\ (a$2 <= x$2 /\ x$2 <= b$2 \/ b$2 <= x$2 /\ x$2 <= a$2))`, GEOM_ORIGIN_TAC `a:real^2` THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LE_LADD; REAL_EQ_ADD_LCANCEL] THEN REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN SUBST1_TAC(SYM(ISPEC `b:real^2` BASIS_EXPANSION)) THEN ASM_REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^2 = &0 % basis 2`) THEN REWRITE_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM; CART_EQ] THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH; REAL_MUL_RZERO; REAL_MUL_RID] THEN MESON_TAC[]);; let SEGMENT_HORIZONTAL = prove (`!a:real^2 b:real^2 x:real^2. a$2 = b$2 ==> (x IN segment[a,b] <=> x$2 = a$2 /\ x$2 = b$2 /\ (a$1 <= x$1 /\ x$1 <= b$1 \/ b$1 <= x$1 /\ x$1 <= a$1))`, GEOM_ORIGIN_TAC `a:real^2` THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LE_LADD; REAL_EQ_ADD_LCANCEL] THEN REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN SUBST1_TAC(SYM(ISPEC `b:real^2` BASIS_EXPANSION)) THEN ASM_REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^2 = &0 % basis 1`) THEN REWRITE_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM; CART_EQ] THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH; REAL_MUL_RZERO; REAL_MUL_RID] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Useful Fashoda corollary pointed out to me by Tom Hales. *) (* ------------------------------------------------------------------------- *) let FASHODA_INTERLACE = prove (`!f g a b:real^2. path f /\ path g /\ path_image f SUBSET interval[a,b] /\ path_image g SUBSET interval[a,b] /\ (pathstart f)$2 = a$2 /\ (pathfinish f)$2 = a$2 /\ (pathstart g)$2 = a$2 /\ (pathfinish g)$2 = a$2 /\ (pathstart f)$1 < (pathstart g)$1 /\ (pathstart g)$1 < (pathfinish f)$1 /\ (pathfinish f)$1 < (pathfinish g)$1 ==> ?z. z IN path_image f /\ z IN path_image g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(interval[a:real^2,b] = {})` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN REWRITE_TAC[PATH_IMAGE_NONEMPTY]; ALL_TAC] THEN SUBGOAL_THEN `pathstart (f:real^1->real^2) IN interval[a,b] /\ pathfinish f IN interval[a,b] /\ pathstart g IN interval[a,b] /\ pathfinish g IN interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`linepath(vector[a$1 - &2;a$2 - &2],vector[(pathstart f)$1;a$2 - &2]) ++ linepath(vector[(pathstart f)$1;(a:real^2)$2 - &2],pathstart f) ++ (f:real^1->real^2) ++ linepath(pathfinish f,vector[(pathfinish f)$1;a$2 - &2]) ++ linepath(vector[(pathfinish f)$1;a$2 - &2], vector[(b:real^2)$1 + &2;a$2 - &2])`; `linepath(vector[(pathstart g)$1; (pathstart g)$2 - &3],pathstart g) ++ (g:real^1->real^2) ++ linepath(pathfinish g,vector[(pathfinish g)$1;(a:real^2)$2 - &1]) ++ linepath(vector[(pathfinish g)$1;a$2 - &1],vector[b$1 + &1;a$2 - &1]) ++ linepath(vector[b$1 + &1;a$2 - &1],vector[(b:real^2)$1 + &1;b$2 + &3])`; `vector[(a:real^2)$1 - &2; a$2 - &3]:real^2`; `vector[(b:real^2)$1 + &2; b$2 + &3]:real^2`] FASHODA) THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN REWRITE_TAC[VECTOR_2] THEN ANTS_TAC THENL [CONJ_TAC THEN REPEAT(MATCH_MP_TAC (SET_RULE `s SUBSET u /\ t SUBSET u ==> (s UNION t) SUBSET u`) THEN CONJ_TAC) THEN TRY(REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN MATCH_MP_TAC(REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] (CONJUNCT1 (SPEC_ALL CONVEX_INTERVAL))) THEN ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2; VECTOR_2] THEN ASM_REAL_ARITH_TAC) THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `interval[a:real^2,b:real^2]` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN REWRITE_TAC[SUBSET_INTERVAL; FORALL_2; DIMINDEX_2; VECTOR_2] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN SUBGOAL_THEN `!f s:real^2->bool. path_image f UNION s = path_image f UNION (s DIFF {pathstart f,pathfinish f})` (fun th -> ONCE_REWRITE_TAC[th] THEN REWRITE_TAC[GSYM UNION_ASSOC] THEN ONCE_REWRITE_TAC[SET_RULE `(s UNION t) UNION u = u UNION t UNION s`] THEN ONCE_REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN REWRITE_TAC[IN_UNION; IN_DIFF; GSYM DISJ_ASSOC; LEFT_OR_DISTRIB; RIGHT_OR_DISTRIB; GSYM CONJ_ASSOC; SET_RULE `~(z IN {x,y}) <=> ~(z = x) /\ ~(z = y)`] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THEN ASM_SIMP_TAC[SEGMENT_VERTICAL; SEGMENT_HORIZONTAL; VECTOR_2] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `path_image (f:real^1->real^2) SUBSET interval [a,b]` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN UNDISCH_TAC `path_image (g:real^1->real^2) SUBSET interval [a,b]` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REPEAT(DISCH_THEN(fun th -> if is_imp(concl th) then ALL_TAC else ASSUME_TAC th)) THEN REPEAT(POP_ASSUM MP_TAC) THEN TRY REAL_ARITH_TAC THEN REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Complement in dimension N >= 2 of set homeomorphic to any interval in *) (* any dimension is (path-)connected. This naively generalizes the argument *) (* in Ryuji Maehara's paper "The Jordan curve theorem via the Brouwer *) (* fixed point theorem", American Mathematical Monthly 1984. *) (* ------------------------------------------------------------------------- *) let UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT = prove (`!s c. compact s /\ AR s /\ c IN components((:real^N) DIFF s) ==> ~bounded c`, REWRITE_TAC[CONJ_ASSOC; COMPACT_AR] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `open((:real^N) DIFF s)` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`connected_component ((:real^N) DIFF s) y`; `s:real^N->bool`; `r:real^N->real^N`] FRONTIER_SUBSET_RETRACTION) THEN ASM_SIMP_TAC[NOT_IMP; INTERIOR_OPEN; OPEN_CONNECTED_COMPONENT] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_CONNECTED_COMPONENT] THEN REWRITE_TAC[SUBSET; IN_DIFF] THEN X_GEN_TAC `z:real^N` THEN ASM_CASES_TAC `(z:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[IN_CLOSURE_CONNECTED_COMPONENT; IN_UNIV; IN_DIFF] THEN CONV_TAC TAUT; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `~(c = {}) /\ c SUBSET (:real^N) DIFF s ==> ~(c SUBSET s)`) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_EQ_EMPTY] THEN ASM_REWRITE_TAC[IN_UNIV; IN_DIFF]]);; let CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT = prove (`!s. 2 <= dimindex(:N) /\ compact s /\ AR s ==> connected((:real^N) DIFF s)`, REWRITE_TAC[COMPACT_AR] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN ASM_SIMP_TAC[COMPL_COMPL; COMPACT_IMP_BOUNDED] THEN CONJ_TAC THEN MATCH_MP_TAC UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT THEN EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[CONJ_ASSOC; COMPACT_AR] THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN ASM_MESON_TAC[]);; let PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT = prove (`!s:real^N->bool. 2 <= dimindex(:N) /\ compact s /\ AR s ==> path_connected((:real^N) DIFF s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT) THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_CONNECTED_EQ_CONNECTED THEN REWRITE_TAC[GSYM closed] THEN ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_INTERVAL; COMPACT_IMP_CLOSED]);; let CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT = prove (`!s:real^N->bool t:real^M->bool. 2 <= dimindex(:N) /\ s homeomorphic t /\ convex t /\ compact t ==> connected((:real^N) DIFF s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY; CONNECTED_UNIV] THEN MATCH_MP_TAC CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_ARNESS) THEN ASM_MESON_TAC[CONVEX_IMP_AR; HOMEOMORPHIC_EMPTY]);; let PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT = prove (`!s:real^N->bool t:real^M->bool. 2 <= dimindex(:N) /\ s homeomorphic t /\ convex t /\ compact t ==> path_connected((:real^N) DIFF s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_CONNECTED_EQ_CONNECTED THEN REWRITE_TAC[GSYM closed] THEN ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_INTERVAL; COMPACT_IMP_CLOSED]);; (* ------------------------------------------------------------------------- *) (* In particular, apply all these to the special case of an arc. *) (* ------------------------------------------------------------------------- *) let RETRACTION_ARC = prove (`!p. arc p ==> ?f. f continuous_on (:real^N) /\ IMAGE f (:real^N) SUBSET path_image p /\ (!x. x IN path_image p ==> f x = x)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTE_RETRACT_PATH_IMAGE_ARC)) THEN REWRITE_TAC[SUBSET_UNIV; retract_of; retraction]);; let PATH_CONNECTED_ARC_COMPLEMENT = prove (`!p. 2 <= dimindex(:N) /\ arc p ==> path_connected((:real^N) DIFF path_image p)`, REWRITE_TAC[arc; path] THEN REPEAT STRIP_TAC THEN SIMP_TAC[path_image] THEN MP_TAC(ISPECL [`path_image p:real^N->bool`; `interval[vec 0:real^1,vec 1]`] PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN ASM_REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; path_image] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `p:real^1->real^N` THEN ASM_REWRITE_TAC[COMPACT_INTERVAL]);; let CONNECTED_ARC_COMPLEMENT = prove (`!p. 2 <= dimindex(:N) /\ arc p ==> connected((:real^N) DIFF path_image p)`, SIMP_TAC[PATH_CONNECTED_ARC_COMPLEMENT; PATH_CONNECTED_IMP_CONNECTED]);; let INSIDE_ARC_EMPTY = prove (`!p:real^1->real^N. arc p ==> inside(path_image p) = {}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [MATCH_MP_TAC INSIDE_CONVEX THEN ASM_SIMP_TAC[CONVEX_CONNECTED_1_GEN; CONNECTED_PATH_IMAGE; ARC_IMP_PATH]; MATCH_MP_TAC INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY THEN ASM_SIMP_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH] THEN MATCH_MP_TAC CONNECTED_ARC_COMPLEMENT THEN ASM_REWRITE_TAC[ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`] THEN REWRITE_TAC[DIMINDEX_GE_1]]);; let INSIDE_SIMPLE_CURVE_IMP_CLOSED = prove (`!g x:real^N. simple_path g /\ x IN inside(path_image g) ==> pathfinish g = pathstart g`, MESON_TAC[ARC_SIMPLE_PATH; INSIDE_ARC_EMPTY; NOT_IN_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Some nice theorems giving accessibility for ANR complement components *) (* (from Hu's "Theory of Retracts", apparently originally from Borsuk). *) (* ------------------------------------------------------------------------- *) let FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC = prove (`!s p:real^N a b. compact s /\ ANR s /\ a < b ==> FINITE {c | c IN components(cball(p,b) DIFF s) /\ ~(closure c INTER cball(p,a) = {})}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] ANR_IMP_NEIGHBOURHOOD_RETRACT) THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `?d. &0 < d /\ {x + e:real^N | x IN s /\ e IN cball(vec 0,d)} SUBSET u /\ !w. w IN {x + e:real^N | x IN s /\ e IN cball(vec 0,d)} ==> dist(w,r w) <= (b - a) / &4` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?d. &0 < d /\ {x + e:real^N | x IN s /\ e IN cball(vec 0,d)} SUBSET u` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SET_RULE `{f x y | x IN {} /\ P y} SUBSET u`] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN ASM_CASES_TAC `u = (:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN EXISTS_TAC `setdist(s,(:real^N) DIFF u) / &2` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_HALF; SETDIST_POS_LT] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]; REWRITE_TAC[REAL_HALF; SUBSET; FORALL_IN_GSPEC] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[IN_CBALL_0] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < s /\ s <= e ==> ~(e <= s / &2)`) THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(NORM_ARITH `norm(e:real^N) = dist(x,x + e)`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]]; SUBGOAL_THEN `(r:real^N->real^N) uniformly_continuous_on {x + e | x IN s /\ e IN cball(vec 0,d)}` MP_TAC THENL [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN ASM_SIMP_TAC[COMPACT_SUMS; COMPACT_CBALL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[uniformly_continuous_on]] THEN DISCH_THEN(MP_TAC o SPEC `(b - a) / &8`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (min (e / &2) ((b - a) / &8))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_CBALL_0; REAL_LE_MIN] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `dist(r x,r(x + y)) < e / &8 /\ norm y <= e / &8 /\ r x = x ==> dist(x + y:real^N,r(x + y)) <= e / &4`) THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_ARITH `&0 < e /\ norm y <= e / &2 ==> dist(x:real^N,x + y) < e`] THEN REWRITE_TAC[IN_ELIM_THM; IN_CBALL_0] THEN CONJ_TAC THEN EXISTS_TAC `x:real^N` THENL [EXISTS_TAC `y:real^N`; EXISTS_TAC `vec 0:real^N`] THEN ASM_SIMP_TAC[NORM_0; VECTOR_ADD_RID; REAL_LT_IMP_LE]; FIRST_ASSUM ACCEPT_TAC; ASM_SIMP_TAC[]]]; ABBREV_TAC `sd = {x + e:real^N | x IN s /\ e IN cball(vec 0,d)}`] THEN SUBGOAL_THEN `(s:real^N->bool) SUBSET interior sd` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `{x + e:real^N | x IN s /\ e IN ball(vec 0,d)}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `vec 0 IN t /\ (!x:real^N. f x (vec 0) = x) ==> s SUBSET {f x y | x IN s /\ y IN t}`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; SIMP_TAC[INTERIOR_MAXIMAL_EQ; OPEN_SUMS; OPEN_BALL] THEN EXPAND_TAC "sd" THEN REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(s:real^N->bool) SUBSET sd` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; INTERIOR_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `compact(sd:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "sd" THEN ASM_SIMP_TAC[COMPACT_SUMS; COMPACT_CBALL]; ALL_TAC] THEN SUBGOAL_THEN `FINITE {c | c IN components(cball(p:real^N,b) DIFF s) /\ ~(c INTER (cball(p,b) DIFF interior sd) = {})}` MP_TAC THENL [MATCH_MP_TAC FINITE_COMPONENTS_MEETING_COMPACT_SUBSET THEN REPEAT CONJ_TAC THENL [SIMP_TAC[COMPACT_DIFF; COMPACT_CBALL; OPEN_INTERIOR]; MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `cball(p:real^N,b)` THEN SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; CONVEX_CBALL] THEN ASM_SIMP_TAC[OPEN_IN_DIFF_CLOSED; COMPACT_IMP_CLOSED]; ASM SET_TAC[]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM_CASES_TAC `(c:real^N->bool) SUBSET interior sd` THENL [DISCH_THEN(K ALL_TAC); ASM SET_TAC[]]] THEN SUBGOAL_THEN `closure c SUBSET (sd:real^N->bool)` ASSUME_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `frontier c SUBSET (sd:real^N->bool)` ASSUME_TAC THENL [REWRITE_TAC[frontier] THEN ASM SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `h = cball(p:real^N,a + &3 / &4 * (b - a))` THEN SUBGOAL_THEN `(h:real^N->bool) INTER frontier c SUBSET s` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN MATCH_MP_TAC(SET_RULE `h INTER g SUBSET s ==> f SUBSET g ==> h INTER f SUBSET s`) THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN W(MP_TAC o PART_MATCH lhand FRONTIER_INTER_SUBSET o rand o lhand o snd) THEN MATCH_MP_TAC(SET_RULE `h INTER g SUBSET s ==> f SUBSET g ==> h INTER f SUBSET s`) THEN REWRITE_TAC[FRONTIER_CBALL; UNION_OVER_INTER; UNION_SUBSET] THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN CONJ_TAC THENL [EXPAND_TAC "h"; SET_TAC[]] THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_INTER] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?g. g continuous_on (h UNION frontier c) /\ (!x. x IN h ==> (g:real^N->real^N) x = vec 0) /\ (!x. x IN frontier c ==> g x = r x - x)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `\x:real^N. if x IN frontier c then r x - x else vec 0` THEN SIMP_TAC[] THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_SUB_EQ] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_REWRITE_TAC RAND_CONV [UNION_COMM] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN EXPAND_TAC "h" THEN SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_CBALL; FRONTIER_CLOSED] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; SUBSET_UNION; CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `D = cball(vec 0:real^N,(b - a) / &4)` THEN SUBGOAL_THEN `IMAGE (g:real^N->real^N) (h UNION frontier c) SUBSET D` ASSUME_TAC THENL [REWRITE_TAC[IMAGE_UNION; UNION_SUBSET] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN EXPAND_TAC "D" THEN REWRITE_TAC[CENTRE_IN_CBALL] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_CBALL_0]] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^N->real^N`; `cball(p:real^N,b)`; `h UNION frontier c:real^N->bool`; `D:real^N->bool`] AR_IMP_ABSOLUTE_EXTENSOR) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "D" THEN REWRITE_TAC[AR_CBALL] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC CLOSED_SUBSET THEN EXPAND_TAC "h" THEN SIMP_TAC[CLOSED_UNION; FRONTIER_CLOSED; CLOSED_CBALL; UNION_SUBSET] THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CBALL] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g':real^N->real^N` STRIP_ASSUME_TAC)] THEN ABBREV_TAC `f:real^N->real^N = \x. r x - g' x` THEN SUBGOAL_THEN `!x:real^N. x IN frontier c ==> f x = x` (LABEL_TAC "1") THENL [EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[IN_UNION] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN closure c INTER h ==> (f:real^N->real^N) x = r x` (LABEL_TAC "2") THENL [EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[IN_UNION; IN_INTER] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN closure c ==> dist(x,f x) <= (b - a) / &2` (LABEL_TAC "3") THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "f" THEN REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `dist(x:real^N,r x) <= e / &4 /\ norm(g x) <= e / &4 ==> dist(x,r x - g x) <= e / &2`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_CBALL_0]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CBALL] THEN ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `~(closure c INTER cball(p:real^N,a) = {})` THEN PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `l:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSURE_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o SPEC `(b - a) / &5`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `setdist({q},(:real^N) DIFF h) > (b - a) / &2` ASSUME_TAC THENL [MP_TAC(ISPECL [`(:real^N) DIFF h`; `q:real^N`; `l:real^N`] SETDIST_SING_TRIANGLE) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d < (b - a) / &5 ==> &3 / &4 * (b - a) <= l ==> abs(q - l) <= d ==> q > (b - a) / &2`)) THEN MATCH_MP_TAC REAL_LE_SETDIST THEN REWRITE_TAC[NOT_INSERT_EMPTY] THEN REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`; IN_SING] THEN EXPAND_TAC "h" THEN CONJ_TAC THENL [MESON_TAC[BOUNDED_SUBSET; NOT_BOUNDED_UNIV; BOUNDED_CBALL]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN UNDISCH_TAC `l IN cball(p:real^N,a)` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_CBALL] THEN CONV_TAC NORM_ARITH]; ALL_TAC] THEN SUBGOAL_THEN `~(q IN IMAGE (f:real^N->real^N) (closure c))` (LABEL_TAC "4") THENL [REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_CASES_TAC `(x:real^N) IN h` THENL [ASM SET_TAC[]; ALL_TAC] THEN REMOVE_THEN "3" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d > e ==> d <= x ==> ~(x <= e)`)) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^N`; `closure c:real^N->bool`] COMPACT_SUBSET_FRONTIER_RETRACTION) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[COMPACT_CLOSURE] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(p:real^N,b) DIFF s` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[BOUNDED_DIFF; BOUNDED_CBALL]; EXPAND_TAC "f" THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THENL [ASM SET_TAC[]; MATCH_MP_TAC CLOSURE_MINIMAL] THEN REWRITE_TAC[CLOSED_CBALL] THEN ASM SET_TAC[]; MP_TAC(ISPEC `c:real^N->bool` FRONTIER_CLOSURE_SUBSET) THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `q:real^N`) THEN ASM_SIMP_TAC[CLOSURE_INC]]);; let ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT = prove (`!s c p:real^N b. compact s /\ ANR s /\ c IN components(b DIFF s) /\ p IN frontier c /\ p IN interior b ==> ?g. arc g /\ pathfinish g = p /\ !t. t IN interval[vec 0,vec 1] DELETE (vec 1) ==> g(t) IN c`, let lemma = prove (`!s p:real^N a b c. compact s /\ ANR s /\ &0 < a /\ cball(p,a) SUBSET b /\ c IN components(b DIFF s) /\ p IN frontier c ==> ?d. d IN components(cball(p,a) INTER c) /\ p IN frontier d`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `p:real^N`; `a / &2`; `a:real`] FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `{d | d IN components(cball(p,a) INTER c) /\ ~(closure d INTER cball(p:real^N,a / &2) = {})}` o MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `d:real^N->bool` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`b DIFF s:real^N->bool`; `cball(p:real^N,a)`; `c:real^N->bool`; `d:real^N->bool`] COMPONENTS_INTER_COMPONENTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP CLOSURE_UNIONS) THEN DISCH_THEN(MP_TAC o SPEC `p:real^N` o MATCH_MP (SET_RULE `s = t ==> !x. x IN s ==> x IN t`)) THEN ANTS_TAC THENL [SUBGOAL_THEN `p IN closure (UNIONS {d | d IN components (cball(p:real^N,a) INTER c) /\ ~(closure d INTER cball (p,a / &2) = {})} UNION UNIONS {d | d IN components (cball(p,a) INTER c) /\ closure d INTER cball (p,a / &2) = {}})` MP_TAC THENL [REWRITE_TAC[GSYM UNIONS_UNION; GSYM UNIONS_COMPONENTS; SET_RULE `{x | x IN s /\ ~P x} UNION {x | x IN s /\ P x} = s`] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN EXISTS_TAC `closure(ball(p:real^N,a) INTER c)` THEN SIMP_TAC[SUBSET_CLOSURE; BALL_SUBSET_CBALL; SET_RULE `s SUBSET t ==> s INTER c SUBSET t INTER c`] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_SUBSET o rand o snd) THEN REWRITE_TAC[OPEN_BALL] THEN MATCH_MP_TAC(SET_RULE `x IN s ==> s SUBSET t ==> x IN t`) THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL]; REWRITE_TAC[CLOSURE_UNION; IN_UNION] THEN MATCH_MP_TAC(TAUT `~p ==> q \/ p ==> q`) THEN MATCH_MP_TAC(SET_RULE `!t. ~(x IN t) /\ s SUBSET t ==> ~(x IN s)`) THEN EXISTS_TAC `(:real^N) DIFF ball(p,a / &2)` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; CENTRE_IN_BALL; REAL_HALF] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `d INTER cball(x:real^N,r) = {} ==> ball(x,r) SUBSET cball(x,r) ==> ball(x,r) INTER d = {}`)) THEN SIMP_TAC[BALL_SUBSET_CBALL; OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_BALL] THEN SET_TAC[]]; REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN UNDISCH_TAC `(p:real^N) IN frontier c` THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `d SUBSET c ==> p IN s DIFF c ==> ~(p IN d)`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN SET_TAC[]]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?u. (!n. u n IN components(cball(p:real^N,min a (inv(&2 pow n))) INTER c) /\ p IN frontier(u n)) /\ (!n. u(SUC n) SUBSET u n)` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC(ISPECL [`s:real^N->bool`; `p:real^N`; `min a (&1)`; `b:real^N->bool`; `c:real^N->bool`] lemma) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`n:num`; `d:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `p:real^N`; `min a (inv(&2 pow (SUC n)))`; `cball(p:real^N,min a (inv(&2 pow n)))`; `d:real^N->bool`] lemma) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; REAL_LT_MIN] THEN SIMP_TAC[REAL_LT_INV2; REAL_LT_INV_EQ; REAL_LT_POW2; REAL_POW_MONO_LT; REAL_ARITH `&1 < &2`; ARITH_RULE `n < SUC n`; SUBSET_BALLS; DIST_REFL; REAL_ADD_LID; REAL_ARITH `x < y ==> min a x <= min a y`] THEN ANTS_TAC THENL [MP_TAC(ISPECL [`b DIFF s:real^N->bool`; `cball(p:real^N,min a (inv(&2 pow n)))`; `c:real^N->bool`; `d:real^N->bool`] COMPONENTS_INTER_COMPONENTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`cball(p:real^N,min a (inv(&2 pow n))) INTER c`; `cball(p:real^N,min a (inv(&2 pow SUC n)))`; `d:real^N->bool`; `e:real^N->bool`] COMPONENTS_INTER_COMPONENTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CBALL_MIN_INTER] THEN MATCH_MP_TAC(SET_RULE `n SUBSET s ==> (b INTER n) INTER (b INTER s) INTER c = (b INTER n) INTER c`) THEN MATCH_MP_TAC SUBSET_CBALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]]]]; REWRITE_TAC[FORALL_AND_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `u:num->real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!n. (u:num->real^N->bool) n SUBSET c` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET_TRANS; SUBSET_INTER]; ALL_TAC] THEN SUBGOAL_THEN `!n. u n IN components(cball(p:real^N,min a (inv(&2 pow n))) DIFF s)` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`b DIFF s:real^N->bool`; `cball(p:real^N,min a (inv(&2 pow n)))`; `c:real^N->bool`; `(u:num->real^N->bool) n`] COMPONENTS_INTER_COMPONENTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~((u:num->real^N->bool) n = {})` MP_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `q:num->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n. ?f. (f:real^1->real^N) continuous_on interval[lift(inv(&2 pow (SUC n))),lift(inv(&2 pow n))] /\ IMAGE f (interval[lift(inv(&2 pow (SUC n))),lift(inv(&2 pow n))]) SUBSET u n /\ f(lift(inv(&2 pow n))) = q n /\ f(lift(inv(&2 pow (SUC n)))) = q(SUC n)` MP_TAC THENL [X_GEN_TAC `n:num` THEN SUBGOAL_THEN `path_component (u n) (q n:real^N) (q(SUC n))` MP_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) PATH_COMPONENT_EQ_CONNECTED_COMPONENT o rator o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `cball(p:real^N,min a (inv(&2 pow n))) DIFF s` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `cball(p:real^N,min a (inv(&2 pow n)))` THEN ASM_SIMP_TAC[OPEN_IN_DIFF_CLOSED; COMPACT_IMP_CLOSED] THEN SIMP_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; CONVEX_CBALL; CONVEX_IMP_LOCALLY_CONNECTED]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `(u:num->real^N->bool) n` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM SET_TAC[]]]; ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN REWRITE_TAC[path_component; path; path_image; pathstart; pathfinish] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^1->real^N) o (\x. &2 pow (SUC n) % (x - lift(inv(&2 pow (SUC n)))))` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f i SUBSET u ==> s SUBSET i ==> IMAGE f s SUBSET u`))] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; FORALL_LIFT] THEN REWRITE_TAC[LIFT_DROP; DROP_VEC; DROP_CMUL; DROP_SUB] THEN SIMP_TAC[REAL_LT_POW2; REAL_SUB_LDISTRIB; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[REAL_SUB_LE; REAL_ARITH `x - &1 <= &1 <=> x <= &2`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[REAL_LT_POW2; GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ] THEN REWRITE_TAC[real_pow; REAL_INV_MUL; real_div] THEN REAL_ARITH_TAC; REWRITE_TAC[o_THM; GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; LIFT_NUM] THEN REWRITE_TAC[real_pow; REAL_INV_MUL] THEN ASM_SIMP_TAC[REAL_LT_POW2; LIFT_NUM; REAL_FIELD `&0 < x ==> (&2 * x) * (inv x - inv(&2) * inv x) = &1`]]]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^1->real^N` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`f:num->real^1->real^N`; `\n. interval[lift(inv(&2 pow (SUC n))),lift(inv(&2 pow n))]`; `interval[vec 0:real^1,vec 1] DELETE (vec 0)`; `(:num)`; `c:real^N->bool`] PASTING_LEMMA_EXISTS_LOCALLY_FINITE) THEN REWRITE_TAC[IN_UNIV] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `drop x / &9`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `(interval[vec 0,vec 1] DELETE vec 0) INTER ball(x:real^1,inv(&2 pow n))` THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; REAL_LT_INV_EQ] THEN ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; REAL_LT_POW2] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{i | ~(interval[lift(inv(&2 pow SUC i)),lift(inv(&2 pow i))] INTER ball(x:real^1,inv(&2 pow n)) = {})}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[BALL_1; DISJOINT_INTERVAL_1] THEN REWRITE_TAC[DE_MORGAN_THM; DROP_ADD; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[REAL_NOT_LT; REAL_NOT_LE] THEN MATCH_MP_TAC(MESON[FINITE_SUBSET; FINITE_INSERT; FINITE_EMPTY] `(?a b. s SUBSET {a,b}) ==> FINITE s`) THEN MATCH_MP_TAC(SET_RULE `~(?a b c. a IN s /\ b IN s /\ c IN s /\ ~(a = b) /\ ~(a = c) /\ ~(b = c)) ==> ?a b. s SUBSET {a,b}`) THEN MATCH_MP_TAC(MESON[] `(!a b c. a IN s /\ b IN s /\ c IN s /\ ~(a = b) /\ ~(a = c) /\ ~(b = c) ==> ?x y. x IN s /\ y IN s /\ x + 2 <= y) /\ (!x y. x IN s /\ y IN s /\ x + 2 <= y ==> F) ==> ~(?a b c. a IN s /\ b IN s /\ c IN s /\ ~(a = b) /\ ~(a = c) /\ ~(b = c))`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:num`; `b:num`; `c:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `?x y. x IN {a,b,c} /\ y IN {a,b,c} /\ x + 2 <= y` MP_TAC THENL [SIMP_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN ASM_ARITH_TAC; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `r:num`] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `&2 * drop x - &2 / &2 pow n < drop x + inv(&2 pow n)` MP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN TRANS_TAC REAL_LET_TRANS `inv(&2 pow (SUC m))` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x - inv i < a ==> a <= inv(&2) * b ==> &2 * x - &2 / i <= b`)) THEN REWRITE_TAC[GSYM REAL_INV_MUL; GSYM(CONJUNCT2 real_pow)] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_DELETE] THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DIST_1; REAL_SUB_RZERO] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[real_abs] THEN STRIP_TAC THEN MP_TAC(fst(EQ_IMP_RULE(ISPEC`\n. drop y <= inv(&2 pow n)` num_MAX))) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `0` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; MP_TAC(ISPECL [`inv(&2)`; `drop y`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_TAC THEN X_GEN_TAC `m':num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE; REAL_NOT_LE] THEN DISCH_TAC THEN TRANS_TAC REAL_LT_TRANS `inv(&2 pow m)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[LIFT_DROP] THEN X_GEN_TAC `m:num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `m + 1`) THEN ASM_REWRITE_TAC[ADD1; ARITH_RULE `~(m + 1 <= m)`] THEN REAL_ARITH_TAC]; X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN REWRITE_TAC[SET_RULE `s SUBSET t DELETE a <=> ~(a IN s) /\ s SUBSET t`] THEN REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN SIMP_TAC[DE_MORGAN_THM; REAL_NOT_LE; REAL_LT_INV_EQ; REAL_LE_INV_EQ; REAL_LT_POW2; REAL_LT_IMP_LE] THEN DISJ2_TAC THEN SIMP_TAC[REAL_INV_LE_1; REAL_LE_POW2] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `(~(t = {}) ==> !x. x IN s /\ x IN t ==> P x) ==> !x. x IN s INTER t ==> P x`) THEN REWRITE_TAC[DISJOINT_INTERVAL_1; DE_MORGAN_THM; LIFT_DROP] THEN ASM_CASES_TAC `SUC m < n` THEN ASM_SIMP_TAC[REAL_LT_INV2; REAL_LT_POW2; REAL_POW_MONO_LT; REAL_ARITH `&1 < &2`] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `n = SUC m` SUBST_ALL_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_INTER; IN_DELETE; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `drop x = inv(&2 pow (SUC m))` MP_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP]] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `g = \x. if x = vec 0 then p else (h:real^1->real^N) x` THEN SUBGOAL_THEN `path g /\ pathstart g = (p:real^N) /\ (!t. t IN interval[vec 0,vec 1] DELETE vec 0 ==> g t IN c)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[pathstart; IN_DELETE] THEN SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SIMP_TAC[path; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^1 = vec 0` THEN ASM_SIMP_TAC[] THENL [REWRITE_TAC[LIM_WITHIN_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(&2 pow n)` THEN REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ; GSYM DIST_NZ] THEN EXPAND_TAC "g" THEN SIMP_TAC[] THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DIST_1; REAL_SUB_RZERO] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[real_abs] THEN STRIP_TAC THEN MP_TAC(fst(EQ_IMP_RULE(ISPEC`\n. drop y <= inv(&2 pow n)` num_MAX))) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`inv(&2)`; `drop y`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_TAC THEN X_GEN_TAC `m':num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE; REAL_NOT_LE] THEN DISCH_TAC THEN TRANS_TAC REAL_LT_TRANS `inv(&2 pow m)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `n:num` th) THEN MP_TAC(SPEC `m + 1` th)) THEN ASM_REWRITE_TAC[REAL_NOT_LE; ARITH_RULE `~(m + 1 <= m)`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `h y = (f:num->real^1->real^N) m y` SUBST1_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; IN_DELETE; IN_INTER] THEN ASM_REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; ADD1; DROP_VEC] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; TRANS_TAC REAL_LET_TRANS `inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `inv(&2 pow m)` THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_LT_INV_EQ; REAL_LT_POW2; REAL_POW_MONO; REAL_ARITH `&1 <= &2`] THEN TRANS_TAC REAL_LE_TRANS `min a (inv(&2 pow m))` THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM IN_CBALL)] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN EXISTS_TAC `cball(p:real^N,min a (inv(&2 pow m))) DIFF s` THEN REWRITE_TAC[SUBSET_DIFF] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN EXISTS_TAC `(u:num->real^N->bool) m` THEN ASM_SIMP_TAC[IN_COMPONENTS_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[ADD1; REAL_LT_IMP_LE]]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[IN_DELETE; CONTINUOUS_WITHIN] THEN REWRITE_TAC[tendsto] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_WITHIN_IMP] THEN MP_TAC(ISPECL [`(:real^1) DELETE vec 0`; `x:real^1`] EVENTUALLY_IN_OPEN) THEN ASM_SIMP_TAC[IN_DELETE; IN_UNIV; OPEN_DELETE; OPEN_UNIV] THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN EXPAND_TAC "g" THEN SIMP_TAC[IMP_CONJ]]; MP_TAC(ISPECL [`reversepath g:real^1->real^N`; `pathfinish g:real^N`; `p:real^N`] PATH_CONTAINS_ARC) THEN REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN ASM_REWRITE_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `vec 1:real^1`) THEN REWRITE_TAC[IN_DELETE; ENDS_IN_UNIT_INTERVAL; VEC_EQ; ARITH_EQ] THEN REWRITE_TAC[pathfinish] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN DISCH_THEN(MP_TAC o SPEC `p:real^N` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[FRONTIER_INTER; IN_INTER] THEN REWRITE_TAC[IN_UNION; FRONTIER_CBALL; FRONTIER_COMPLEMENT] THEN ASM_SIMP_TAC[IN_SPHERE; DIST_REFL; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[frontier; IN_DIFF; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [arc]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x y. x IN i /\ y IN i /\ f x = f y ==> x = y) ==> z IN i /\ IMAGE f i DELETE f z SUBSET c ==> (!x. x IN i DELETE z ==> f x IN c)`)) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a SUBSET g ==> g DELETE z SUBSET u ==> a DELETE z SUBSET u`)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM pathfinish] THEN ASM_REWRITE_TAC[path_image] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN i DELETE z ==> g x IN c) ==> g z = p ==> IMAGE g i DELETE p SUBSET c`)) THEN ASM_MESON_TAC[pathstart]]]);; let ACCESSIBLE_FRONTIER_ANR_COMPLEMENT_COMPONENT = prove (`!s c x y. compact s /\ ANR s /\ c IN components((:real^N) DIFF s) /\ x IN c /\ y IN frontier c ==> ?g. arc g /\ pathstart g = x /\ pathfinish g = y /\ !t. t IN interval[vec 0,vec 1] DELETE (vec 1) ==> g(t) IN c`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)) THEN ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `y:real^N`; `(:real^N)`] ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT) THEN ASM_REWRITE_TAC[INTERIOR_UNIV; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `path_component c (x:real^N) (pathstart g2)` MP_TAC THENL [ASM_SIMP_TAC[OPEN_PATH_CONNECTED_COMPONENT] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN ASM_REWRITE_TAC[SUBSET_REFL; pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; IN_DELETE; VEC_EQ; ARITH_EQ]; REWRITE_TAC[path_component] THEN DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC)] THEN ABBREV_TAC `g:real^1->real^N = g1 ++ g2` THEN SUBGOAL_THEN `pathstart g:real^N = x /\ pathfinish g = y` STRIP_ASSUME_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `path(g:real^1->real^N)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN ASM_SIMP_TAC[PATH_JOIN; ARC_IMP_PATH]; ALL_TAC] THEN SUBGOAL_THEN `!t. t IN interval[vec 0,vec 1] DELETE vec 1 ==> (g:real^1->real^N) t IN c` ASSUME_TAC THENL [X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; DROP_VEC; GSYM DROP_EQ] THEN STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; DROP_SUB; DROP_CMUL; GSYM DROP_EQ; DROP_VEC] THEN ASM_REAL_ARITH_TAC]; MP_TAC(ISPECL [`g:real^1->real^N`; `x:real^N`; `y:real^N`] PATH_CONTAINS_ARC) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM FRONTIER_DISJOINT_EQ]) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [arc])) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x y. x IN i /\ y IN i /\ f x = f y ==> x = y) ==> z IN i /\ IMAGE f i DELETE f z SUBSET c ==> (!x. x IN i DELETE z ==> f x IN c)`)) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a SUBSET g ==> g DELETE z SUBSET u ==> a DELETE z SUBSET u`)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM pathfinish] THEN ASM_REWRITE_TAC[path_image] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN i DELETE z ==> g x IN c) ==> g z = p ==> IMAGE g i DELETE p SUBSET c`)) THEN ASM_MESON_TAC[pathfinish]]]);; (* ------------------------------------------------------------------------- *) (* Some simple consequences for complement connectivity. *) (* ------------------------------------------------------------------------- *) let LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT = prove (`!s c t. compact s /\ ANR s /\ c IN components ((:real^N) DIFF s) /\ c SUBSET t /\ t SUBSET closure c ==> locally path_connected t`, let lemma = prove (`!s c u p. compact s /\ ANR s /\ c IN components((:real^N) DIFF s) /\ p IN frontier c /\ open u /\ p IN u ==> ?v. open v /\ p IN v /\ v SUBSET u /\ !y. y IN c INTER v ==> path_component ((p INSERT c) INTER u) p y`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real` THEN STRIP_TAC THEN SUBGOAL_THEN `open(c:real^N->bool)` ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM((MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)))) THEN ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `?a. &0 < a /\ a < b /\ !d x. d IN components(cball(p,b) DIFF s) /\ x IN d /\ x IN ball(p:real^N,a) ==> p IN closure d` STRIP_ASSUME_TAC THENL [EXISTS_TAC `inf ((b / &2) INSERT IMAGE (\c. setdist({p:real^N},c)) {c | c IN components (cball (p,b) DIFF s) /\ ~(closure c INTER cball (p,b / &2) = {}) /\ ~(p IN closure c)})` THEN MP_TAC(ISPECL [`s:real^N->bool`; `p:real^N`; `b / &2`; `b:real`] FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC) THEN ASM_REWRITE_TAC[REAL_ARITH `e / &2 < e <=> &0 < e`] THEN DISCH_TAC THEN REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} = {x | x IN {y | P y /\ Q y} /\ R x}`] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; NOT_INSERT_EMPTY; FINITE_INSERT; FINITE_IMAGE; FINITE_RESTRICT; REAL_INF_LT_FINITE] THEN REWRITE_TAC[EXISTS_IN_INSERT; FORALL_IN_INSERT] THEN ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `e / &2 < e <=> &0 < e`] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC] THEN SIMP_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN CONJ_TAC THENL [MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`d:real^N->bool`; `x:real^N`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> ~r ==> q) ==> r`) THEN ASM_SIMP_TAC[REAL_NOT_LT; SETDIST_LE_DIST; IN_SING] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_CBALL] THEN EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[CLOSURE_INC; REAL_LT_IMP_LE]; ALL_TAC] THEN EXISTS_TAC `ball(p:real^N,a)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `cball(p:real^N,b)` THEN ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ABBREV_TAC `d = connected_component (cball(p:real^N,b) DIFF s) x` THEN SUBGOAL_THEN `d IN components(cball(p:real^N,b) DIFF s)` ASSUME_TAC THENL [REWRITE_TAC[components; IN_ELIM_THM; IN_DIFF] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_CBALL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN d` ASSUME_TAC THENL [EXPAND_TAC "d" THEN REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_REWRITE_TAC[IN_CBALL; IN_DIFF] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(d:real^N->bool) SUBSET c` ASSUME_TAC THENL [MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `(:real^N) DIFF s` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `d:real^N->bool`; `p:real^N`; `cball(p:real^N,b)`] ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INTERIOR_CBALL; CENTRE_IN_BALL] THEN REWRITE_TAC[frontier; IN_DIFF] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN UNDISCH_TAC `(p:real^N) IN frontier c` THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `pathstart g:real^N` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN REWRITE_TAC[path_component] THEN EXISTS_TAC `g:real^1->real^N` THEN ASM_SIMP_TAC[ARC_IMP_PATH] THEN REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `r:real^1` THEN DISCH_TAC THEN ASM_CASES_TAC `r:real^1 = vec 1` THENL [RULE_ASSUM_TAC(REWRITE_RULE[pathfinish]) THEN ASM_REWRITE_TAC[IN_INTER; IN_INSERT]; FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]]; MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN EXISTS_TAC `c INTER u:real^N->bool` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[OPEN_PATH_CONNECTED_COMPONENT; OPEN_INTER] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `d:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DELETE; ENDS_IN_UNIT_INTERVAL; VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV]]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `open(c:real^N->bool)` ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM((MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)))) THEN ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED]; ALL_TAC] THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN MAP_EVERY X_GEN_TAC [`uu:real^N->bool`; `p:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[IN_INTER]) THEN SUBGOAL_THEN `(p:real^N) IN closure c` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION]] THEN STRIP_TAC THENL [MP_TAC(ISPEC `c INTER u:real^N->bool` OPEN_IMP_LOCALLY_PATH_CONNECTED) THEN ASM_SIMP_TAC[OPEN_INTER; LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN DISCH_THEN(MP_TAC o SPECL [`c INTER u:real^N->bool`; `p:real^N`]) THEN ASM_REWRITE_TAC[OPEN_IN_REFL; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_INTER] THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_SUBSET THEN ASM SET_TAC[]; REWRITE_TAC[GSYM path_component] THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `u:real^N->bool`; `p:real^N`] lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t INTER v:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN X_GEN_TAC `q:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN SUBGOAL_THEN `(q:real^N) IN closure c` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION]] THEN STRIP_TAC THENL [MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN EXISTS_TAC `(p:real^N) INSERT c INTER u` THEN ASM SET_TAC[]; MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`; `q:real^N`] lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^N->bool`; `w:real^N->bool`] FRONTIER_OPEN_STRADDLE_INTER) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(MP_TAC o CONJUNCT1)] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN X_GEN_TAC `r:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `r:real^N` THEN CONJ_TAC THEN MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THENL [EXISTS_TAC `(p:real^N) INSERT c INTER u` THEN ASM SET_TAC[]; EXISTS_TAC `(q:real^N) INSERT c INTER v` THEN ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN ASM SET_TAC[]]]]);; let LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT = prove (`!s t. compact s /\ ANR s /\ (:real^N) DIFF s SUBSET t /\ DISJOINT t (interior s) ==> locally path_connected t`, let lemma = prove (`!s u p:real^N. compact s /\ ANR s /\ p IN frontier s /\ open u /\ p IN u ==> ?v. open v /\ p IN v /\ v SUBSET u /\ !y. y IN v DIFF s ==> path_component (p INSERT (u DIFF s)) p y`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real` THEN STRIP_TAC THEN SUBGOAL_THEN `?a. &0 < a /\ a < b /\ !d x. d IN components(cball(p,b) DIFF s) /\ x IN d /\ x IN ball(p:real^N,a) ==> p IN closure d` STRIP_ASSUME_TAC THENL [EXISTS_TAC `inf ((b / &2) INSERT IMAGE (\c. setdist({p:real^N},c)) {c | c IN components (cball (p,b) DIFF s) /\ ~(closure c INTER cball (p,b / &2) = {}) /\ ~(p IN closure c)})` THEN MP_TAC(ISPECL [`s:real^N->bool`; `p:real^N`; `b / &2`; `b:real`] FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC) THEN ASM_REWRITE_TAC[REAL_ARITH `e / &2 < e <=> &0 < e`] THEN DISCH_TAC THEN REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} = {x | x IN {y | P y /\ Q y} /\ R x}`] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; NOT_INSERT_EMPTY; FINITE_INSERT; FINITE_IMAGE; FINITE_RESTRICT; REAL_INF_LT_FINITE] THEN REWRITE_TAC[EXISTS_IN_INSERT; FORALL_IN_INSERT] THEN ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `e / &2 < e <=> &0 < e`] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC] THEN SIMP_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN CONJ_TAC THENL [MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`d:real^N->bool`; `x:real^N`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> ~r ==> q) ==> r`) THEN ASM_SIMP_TAC[REAL_NOT_LT; SETDIST_LE_DIST; IN_SING] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_CBALL] THEN EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[CLOSURE_INC; REAL_LT_IMP_LE]; ALL_TAC] THEN EXISTS_TAC `ball(p:real^N,a)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `cball(p:real^N,b)` THEN ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN SUBGOAL_THEN `x IN UNIONS(components(cball(p:real^N,b) DIFF s))` MP_TAC THENL [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN b ==> b SUBSET c ==> x IN c`)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN STRIP_TAC THENL [UNDISCH_TAC `(p:real^N) IN frontier s` THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `p:real^N`; `cball(p:real^N,b)`] ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT) THEN ASM_REWRITE_TAC[INTERIOR_CBALL; CENTRE_IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN EXISTS_TAC `(p:real^N) INSERT c` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `pathstart g:real^N` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN REWRITE_TAC[path_component] THEN EXISTS_TAC `g:real^1->real^N` THEN ASM_SIMP_TAC[ARC_IMP_PATH] THEN REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `r:real^1` THEN DISCH_TAC THEN ASM_CASES_TAC `r:real^1 = vec 1` THENL [RULE_ASSUM_TAC(REWRITE_RULE[pathfinish]) THEN ASM_REWRITE_TAC[IN_INTER; IN_INSERT]; FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]]; MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN EXISTS_TAC `c:real^N->bool` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) PATH_COMPONENT_EQ_CONNECTED_COMPONENT o rator o snd) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LOCALLY_PATH_CONNECTED_COMPONENTS)) THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `cball(p:real^N,b)` THEN SIMP_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; CONVEX_CBALL] THEN ASM_SIMP_TAC[OPEN_IN_DIFF_CLOSED; COMPACT_IMP_CLOSED]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DELETE; ENDS_IN_UNIT_INTERVAL; VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV]) in REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN MAP_EVERY X_GEN_TAC [`uu:real^N->bool`; `p:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[IN_INTER]) THEN ASM_CASES_TAC `(p:real^N) IN s` THENL [ALL_TAC; MP_TAC(ISPEC `u DIFF s:real^N->bool` OPEN_IMP_LOCALLY_PATH_CONNECTED) THEN ASM_SIMP_TAC[OPEN_DIFF; COMPACT_IMP_CLOSED] THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN DISCH_THEN(MP_TAC o SPECL [`u DIFF s:real^N->bool`; `p:real^N`]) THEN ASM_REWRITE_TAC[OPEN_IN_REFL; IN_DIFF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; COMPACT_IMP_CLOSED] THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_SUBSET THEN ASM SET_TAC[]] THEN REWRITE_TAC[GSYM path_component] THEN MP_TAC(ISPECL [`s:real^N->bool`; `u:real^N->bool`; `p:real^N`] lemma) THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t INTER v:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN X_GEN_TAC `q:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_CASES_TAC `(q:real^N) IN s` THENL [MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`; `q:real^N`] lemma) THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `w:real^N->bool`] FRONTIER_OPEN_STRADDLE_INTER) THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_DIFF] THEN X_GEN_TAC `r:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `r:real^N` THEN CONJ_TAC THEN MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THENL [EXISTS_TAC `(p:real^N) INSERT (u DIFF s)` THEN ASM SET_TAC[]; EXISTS_TAC `(q:real^N) INSERT (v DIFF s)` THEN ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN ASM SET_TAC[]]; MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN EXISTS_TAC `(p:real^N) INSERT (u DIFF s)` THEN ASM SET_TAC[]]);; let LPC_SUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE = prove (`!g s:real^N->bool. 2 <= dimindex(:N) /\ simple_path g /\ (:real^N) DIFF path_image g SUBSET s ==> locally path_connected s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT THEN EXISTS_TAC `path_image g:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN ASM_SIMP_TAC[ANR_PATH_IMAGE_SIMPLE_PATH; INTERIOR_SIMPLE_PATH_IMAGE] THEN SET_TAC[]);; let LPC_OPEN_SIMPLE_PATH_COMPLEMENT = prove (`!g. simple_path g ==> locally path_connected ((:real^N) DIFF (path_image g DIFF {pathstart g,pathfinish g}))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT THEN EXISTS_TAC `path_image g:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN ASM_SIMP_TAC[ANR_PATH_IMAGE_SIMPLE_PATH] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `i SUBSET p /\ DISJOINT {a,b} i ==> DISJOINT (UNIV DIFF (p DIFF {a,b})) i`) THEN ASM_SIMP_TAC[INTERIOR_SUBSET; ENDPOINTS_NOT_IN_INTERIOR_SIMPLE_PATH_IMAGE]);; let PATH_CONNECTED_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT = prove (`!s c t. compact s /\ ANR s /\ c IN components((:real^N) DIFF s) /\ c SUBSET t /\ t SUBSET closure c ==> path_connected t`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `c:real^N->bool` THEN ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]]);; let PATH_CONNECTED_SUPERSET_COMPLEMENT_ARC_IMAGE = prove (`!g s:real^N->bool. 2 <= dimindex(:N) /\ arc g /\ (:real^N) DIFF path_image g SUBSET s ==> path_connected s`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC LPC_SUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE THEN ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `(:real^N) DIFF path_image g` THEN ASM_SIMP_TAC[CONNECTED_ARC_COMPLEMENT; CLOSURE_COMPLEMENT] THEN ASM_SIMP_TAC[INTERIOR_ARC_IMAGE] THEN SET_TAC[]]);; let PATH_CONNECTED_OPEN_ARC_COMPLEMENT = prove (`!g. 2 <= dimindex(:N) /\ arc g ==> path_connected ((:real^N) DIFF (path_image g DIFF {pathstart g,pathfinish g}))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_SUPERSET_COMPLEMENT_ARC_IMAGE THEN EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; hol-light/Multivariate/derivatives.ml000066400000000000000000010607501303454263000203030ustar00rootroot00000000000000(* ========================================================================= *) (* Multivariate calculus in Euclidean space. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "Multivariate/degree.ml";; (* ------------------------------------------------------------------------- *) (* Derivatives. The definition is slightly tricky since we make it work over *) (* nets of a particular form. This lets us prove theorems generally and use *) (* "at a" or "at a within s" for restriction to a set (1-sided on R etc.) *) (* ------------------------------------------------------------------------- *) parse_as_infix ("has_derivative",(12,"right"));; let has_derivative = new_definition `(f has_derivative f') net <=> linear f' /\ ((\y. inv(norm(y - netlimit net)) % (f(y) - (f(netlimit net) + f'(y - netlimit net)))) --> vec 0) net`;; (* ------------------------------------------------------------------------- *) (* These are the only cases we'll care about, probably. *) (* ------------------------------------------------------------------------- *) let has_derivative_within = prove (`!f:real^M->real^N f' x s. (f has_derivative f') (at x within s) <=> linear f' /\ ((\y. inv(norm(y - x)) % (f(y) - (f(x) + f'(y - x)))) --> vec 0) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative] THEN AP_TERM_TAC THEN ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; let has_derivative_at = prove (`!f:real^M->real^N f' x. (f has_derivative f') (at x) <=> linear f' /\ ((\y. inv(norm(y - x)) % (f(y) - (f(x) + f'(y - x)))) --> vec 0) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[has_derivative_within]);; (* ------------------------------------------------------------------------- *) (* More explicit epsilon-delta forms. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_WITHIN = prove (`(f has_derivative f')(at x within s) <=> linear f' /\ !e. &0 < e ==> ?d. &0 < d /\ !x'. x' IN s /\ &0 < norm(x' - x) /\ norm(x' - x) < d ==> norm(f(x') - f(x) - f'(x' - x)) / norm(x' - x) < e`, SIMP_TAC[has_derivative_within; LIM_WITHIN] THEN AP_TERM_TAC THEN REWRITE_TAC[dist; VECTOR_ARITH `(x' - (x + d)) = x' - x - d:real^N`] THEN REWRITE_TAC[real_div; VECTOR_SUB_RZERO; NORM_MUL] THEN REWRITE_TAC[REAL_MUL_AC; REAL_ABS_INV; REAL_ABS_NORM]);; let HAS_DERIVATIVE_AT = prove (`(f has_derivative f')(at x) <=> linear f' /\ !e. &0 < e ==> ?d. &0 < d /\ !x'. &0 < norm(x' - x) /\ norm(x' - x) < d ==> norm(f(x') - f(x) - f'(x' - x)) / norm(x' - x) < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_DERIVATIVE_WITHIN; IN_UNIV]);; let HAS_DERIVATIVE_AT_WITHIN = prove (`!f x s. (f has_derivative f') (at x) ==> (f has_derivative f') (at x within s)`, REWRITE_TAC[HAS_DERIVATIVE_WITHIN; HAS_DERIVATIVE_AT] THEN MESON_TAC[]);; let HAS_DERIVATIVE_WITHIN_OPEN = prove (`!f f' a s. a IN s /\ open s ==> ((f has_derivative f') (at a within s) <=> (f has_derivative f') (at a))`, SIMP_TAC[has_derivative_within; has_derivative_at; LIM_WITHIN_OPEN]);; let HAS_DERIVATIVE_WITHIN_OPEN_IN = prove (`!f:real^M->real^N f' a s u. a IN s /\ open_in (subtopology euclidean u) s ==> ((f has_derivative f') (at a within s) <=> (f has_derivative f') (at a within u))`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_derivative_within] THEN AP_TERM_TAC THEN MATCH_MP_TAC LIM_WITHIN_OPEN_IN THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Combining theorems. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_LINEAR = prove (`!f net. linear f ==> (f has_derivative f) net`, REWRITE_TAC[has_derivative; linear] THEN SIMP_TAC[VECTOR_ARITH `x - y = x + --(&1) % y`] THEN REWRITE_TAC[VECTOR_ARITH `x + --(&1) % (y + x + --(&1) % y) = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_RZERO; LIM_CONST]);; let HAS_DERIVATIVE_ID = prove (`!net. ((\x. x) has_derivative (\h. h)) net`, SIMP_TAC[HAS_DERIVATIVE_LINEAR; LINEAR_ID]);; let HAS_DERIVATIVE_CONST = prove (`!c net. ((\x. c) has_derivative (\h. vec 0)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative; linear] THEN REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_REFL; VECTOR_MUL_RZERO; LIM_CONST]);; let HAS_DERIVATIVE_LIFT_COMPONENT = prove (`!net:(real^N)net. ((\x. lift(x$i)) has_derivative (\x. lift(x$i))) net`, GEN_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[linear; VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);; let HAS_DERIVATIVE_CMUL = prove (`!f f' net c. (f has_derivative f') net ==> ((\x. c % f(x)) has_derivative (\h. c % f'(h))) net`, REPEAT GEN_TAC THEN SIMP_TAC[has_derivative; LINEAR_COMPOSE_CMUL] THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP LIM_CMUL o CONJUNCT2) THEN REWRITE_TAC[VECTOR_MUL_RZERO] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC);; let HAS_DERIVATIVE_CMUL_EQ = prove (`!f f' net c. ~(c = &0) ==> (((\x. c % f(x)) has_derivative (\h. c % f'(h))) net <=> (f has_derivative f') net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_CMUL) THENL [DISCH_THEN(MP_TAC o SPEC `inv(c):real`); DISCH_THEN(MP_TAC o SPEC `c:real`)] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; let HAS_DERIVATIVE_NEG = prove (`!f f' net. (f has_derivative f') net ==> ((\x. --(f(x))) has_derivative (\h. --(f'(h)))) net`, ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[HAS_DERIVATIVE_CMUL]);; let HAS_DERIVATIVE_NEG_EQ = prove (`!f f' net. ((\x. --(f(x))) has_derivative (\h. --(f'(h)))) net <=> (f has_derivative f') net`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_NEG) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; let HAS_DERIVATIVE_ADD = prove (`!f f' g g' net. (f has_derivative f') net /\ (g has_derivative g') net ==> ((\x. f(x) + g(x)) has_derivative (\h. f'(h) + g'(h))) net`, REPEAT GEN_TAC THEN SIMP_TAC[has_derivative; LINEAR_COMPOSE_ADD] THEN DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(a /\ b) /\ (c /\ d) ==> b /\ d`)) THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC);; let HAS_DERIVATIVE_SUB = prove (`!f f' g g' net. (f has_derivative f') net /\ (g has_derivative g') net ==> ((\x. f(x) - g(x)) has_derivative (\h. f'(h) - g'(h))) net`, SIMP_TAC[VECTOR_SUB; HAS_DERIVATIVE_ADD; HAS_DERIVATIVE_NEG]);; let HAS_DERIVATIVE_VSUM = prove (`!f net s. FINITE s /\ (!a. a IN s ==> ((f a) has_derivative (f' a)) net) ==> ((\x. vsum s (\a. f a x)) has_derivative (\h. vsum s (\a. f' a h))) net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; HAS_DERIVATIVE_CONST] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[IN_INSERT]);; let HAS_DERIVATIVE_VSUM_NUMSEG = prove (`!f net m n. (!i. m <= i /\ i <= n ==> ((f i) has_derivative (f' i)) net) ==> ((\x. vsum (m..n) (\i. f i x)) has_derivative (\h. vsum (m..n) (\i. f' i h))) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_VSUM THEN ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]);; let HAS_DERIVATIVE_COMPONENTWISE_WITHIN = prove (`!f:real^M->real^N f' a s. (f has_derivative f') (at a within s) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. lift(f(x)$i)) has_derivative (\x. lift(f'(x)$i))) (at a within s)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_derivative_within] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LINEAR_COMPONENTWISE; LIM_COMPONENTWISE_LIFT] THEN SIMP_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[GSYM LIFT_ADD; GSYM LIFT_CMUL; GSYM LIFT_SUB] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT; LIFT_NUM]);; let HAS_DERIVATIVE_COMPONENTWISE_AT = prove (`!f:real^M->real^N f' a. (f has_derivative f') (at a) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. lift(f(x)$i)) has_derivative (\x. lift(f'(x)$i))) (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MATCH_ACCEPT_TAC HAS_DERIVATIVE_COMPONENTWISE_WITHIN);; let HAS_DERIVATIVE_PASTECART_EQ = prove (`!net f:real^M->real^N g:real^M->real^P f' g'. ((\x. pastecart (f x) (g x)) has_derivative (\x. pastecart (f' x) (g' x))) net <=> (f has_derivative f') net /\ (g has_derivative g') net`, REWRITE_TAC[has_derivative; PASTECART_SUB; PASTECART_ADD] THEN REWRITE_TAC[GSYM PASTECART_CMUL; GSYM PASTECART_VEC] THEN REWRITE_TAC[LIM_PASTECART_EQ; LINEAR_PASTECART_EQ] THEN REWRITE_TAC[CONJ_ACI]);; let HAS_DERIVATIVE_PASTECART = prove (`!net f:real^M->real^N g:real^M->real^P f' g'. (f has_derivative f') net /\ (g has_derivative g') net ==> ((\x. pastecart (f x) (g x)) has_derivative (\x. pastecart (f' x) (g' x))) net`, REWRITE_TAC[HAS_DERIVATIVE_PASTECART_EQ]);; (* ------------------------------------------------------------------------- *) (* Somewhat different results for derivative of scalar multiplier. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_VMUL_COMPONENT = prove (`!c:real^M->real^N c' k v:real^P. 1 <= k /\ k <= dimindex(:N) /\ (c has_derivative c') net ==> ((\x. c(x)$k % v) has_derivative (\x. c'(x)$k % v)) net`, SIMP_TAC[has_derivative; LINEAR_VMUL_COMPONENT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN SUBST1_TAC(VECTOR_ARITH `vec 0 = &0 % (v:real^P)`) THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC LIM_VMUL THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[GSYM VECTOR_MUL_COMPONENT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM]) THEN REWRITE_TAC[LIM] THEN REWRITE_TAC[dist; LIFT_NUM; VECTOR_SUB_RZERO; o_THM; NORM_LIFT] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ABS_MUL; NORM_MUL] THEN ASM_MESON_TAC[REAL_LET_TRANS; COMPONENT_LE_NORM; REAL_LE_LMUL; REAL_ABS_POS]);; let HAS_DERIVATIVE_VMUL_DROP = prove (`!c c' v. (c has_derivative c') net ==> ((\x. drop(c(x)) % v) has_derivative (\x. drop(c'(x)) % v)) net`, SIMP_TAC[drop; LE_REFL; DIMINDEX_1; HAS_DERIVATIVE_VMUL_COMPONENT]);; let HAS_DERIVATIVE_LIFT_DOT = prove (`!f:real^M->real^N f'. (f has_derivative f') net ==> ((\x. lift(v dot f(x))) has_derivative (\t. lift(v dot (f' t)))) net`, REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative] THEN REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_ADD; GSYM LIFT_CMUL] THEN REWRITE_TAC[GSYM DOT_RADD; GSYM DOT_RSUB; GSYM DOT_RMUL] THEN SUBGOAL_THEN `(\t. lift (v dot (f':real^M->real^N) t)) = (\y. lift(v dot y)) o f'` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN SIMP_TAC[LINEAR_COMPOSE; LINEAR_LIFT_DOT] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_LIFT_DOT o CONJUNCT2) THEN SIMP_TAC[o_DEF; DOT_RZERO; LIFT_NUM]);; (* ------------------------------------------------------------------------- *) (* Limit transformation for derivatives. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_TRANSFORM_WITHIN = prove (`!f f' g x s d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ (f has_derivative f') (at x within s) ==> (g has_derivative f') (at x within s)`, REPEAT GEN_TAC THEN SIMP_TAC[has_derivative_within; IMP_CONJ] THEN REPLICATE_TAC 4 DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LIM_TRANSFORM_WITHIN) THEN EXISTS_TAC `d:real` THEN ASM_SIMP_TAC[DIST_REFL]);; let HAS_DERIVATIVE_TRANSFORM_AT = prove (`!f f' g x d. &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ (f has_derivative f') (at x) ==> (g has_derivative f') (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[HAS_DERIVATIVE_TRANSFORM_WITHIN; IN_UNIV]);; let HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove (`!f g:real^M->real^N s x. open s /\ x IN s /\ (!y. y IN s ==> f y = g y) /\ (f has_derivative f') (at x) ==> (g has_derivative f') (at x)`, REPEAT GEN_TAC THEN SIMP_TAC[has_derivative_at; IMP_CONJ] THEN REPLICATE_TAC 4 DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] LIM_TRANSFORM_WITHIN_OPEN) THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Differentiability. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("differentiable",(12,"right"));; parse_as_infix ("differentiable_on",(12,"right"));; let differentiable = new_definition `f differentiable net <=> ?f'. (f has_derivative f') net`;; let differentiable_on = new_definition `f differentiable_on s <=> !x. x IN s ==> f differentiable (at x within s)`;; let HAS_DERIVATIVE_IMP_DIFFERENTIABLE = prove (`!f f' net. (f has_derivative f') net ==> f differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[]);; let DIFFERENTIABLE_AT_WITHIN = prove (`!f s x. f differentiable (at x) ==> f differentiable (at x within s)`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_AT_WITHIN]);; let DIFFERENTIABLE_WITHIN_OPEN = prove (`!f a s. a IN s /\ open s ==> (f differentiable (at a within s) <=> (f differentiable (at a)))`, SIMP_TAC[differentiable; HAS_DERIVATIVE_WITHIN_OPEN]);; let DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON = prove (`!f s. (!x. x IN s ==> f differentiable at x) ==> f differentiable_on s`, REWRITE_TAC[differentiable_on] THEN MESON_TAC[DIFFERENTIABLE_AT_WITHIN]);; let DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT = prove (`!f s. open s ==> (f differentiable_on s <=> !x. x IN s ==> f differentiable at x)`, SIMP_TAC[differentiable_on; DIFFERENTIABLE_WITHIN_OPEN]);; let DIFFERENTIABLE_TRANSFORM_WITHIN = prove (`!f g x s d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ f differentiable (at x within s) ==> g differentiable (at x within s)`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_TRANSFORM_WITHIN]);; let DIFFERENTIABLE_TRANSFORM_AT = prove (`!f g x d. &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ f differentiable at x ==> g differentiable at x`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_TRANSFORM_AT]);; let DIFFERENTIABLE_ON_EQ = prove (`!f g:real^M->real^N s. (!x. x IN s ==> f x = g x) /\ f differentiable_on s ==> g differentiable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[differentiable_on] THEN ASM_MESON_TAC[DIFFERENTIABLE_TRANSFORM_WITHIN; REAL_LT_01]);; (* ------------------------------------------------------------------------- *) (* Frechet derivative and Jacobian matrix. *) (* ------------------------------------------------------------------------- *) let frechet_derivative = new_definition `frechet_derivative f net = @f'. (f has_derivative f') net`;; let FRECHET_DERIVATIVE_WORKS = prove (`!f net. f differentiable net <=> (f has_derivative (frechet_derivative f net)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[frechet_derivative] THEN CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[differentiable]);; let LINEAR_FRECHET_DERIVATIVE = prove (`!f net. f differentiable net ==> linear(frechet_derivative f net)`, SIMP_TAC[FRECHET_DERIVATIVE_WORKS; has_derivative]);; let jacobian = new_definition `jacobian f net = matrix(frechet_derivative f net)`;; let JACOBIAN_WORKS = prove (`!f net. f differentiable net <=> (f has_derivative (\h. jacobian f net ** h)) net`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[differentiable]] THEN REWRITE_TAC[FRECHET_DERIVATIVE_WORKS] THEN SIMP_TAC[jacobian; MATRIX_WORKS; has_derivative] THEN SIMP_TAC[ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Differentiability implies continuity. *) (* ------------------------------------------------------------------------- *) let LIM_MUL_NORM_WITHIN = prove (`!f a s. (f --> vec 0) (at a within s) ==> ((\x. norm(x - a) % f(x)) --> vec 0) (at a within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NORM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_LT_MUL2; NORM_POS_LE]);; let DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN = prove (`!f:real^M->real^N s. f differentiable (at x within s) ==> f continuous (at x within s)`, REWRITE_TAC[differentiable; has_derivative_within; CONTINUOUS_WITHIN] THEN REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` MP_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LIM_MUL_NORM_WITHIN) THEN SUBGOAL_THEN `((f':real^M->real^N) o (\y. y - x)) continuous (at x within s)` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_WITHIN_ID]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_WITHIN; o_DEF] THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; IMP_IMP; IN_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN SIMP_TAC[LIM_WITHIN; GSYM DIST_NZ; REAL_MUL_RINV; NORM_EQ_0; VECTOR_ARITH `(x - y = vec 0) <=> (x = y)`; VECTOR_MUL_LID; VECTOR_SUB_REFL] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN REWRITE_TAC[VECTOR_ARITH `(a + b - (c + a)) - (vec 0 + vec 0) = b - c`]);; let DIFFERENTIABLE_IMP_CONTINUOUS_AT = prove (`!f:real^M->real^N x. f differentiable (at x) ==> f continuous (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; let DIFFERENTIABLE_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N s. f differentiable_on s ==> f continuous_on s`, SIMP_TAC[differentiable_on; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; let HAS_DERIVATIVE_WITHIN_SUBSET = prove (`!f s t x. (f has_derivative f') (at x within s) /\ t SUBSET s ==> (f has_derivative f') (at x within t)`, REWRITE_TAC[has_derivative_within] THEN MESON_TAC[LIM_WITHIN_SUBSET]);; let DIFFERENTIABLE_WITHIN_SUBSET = prove (`!f:real^M->real^N s t. f differentiable (at x within t) /\ s SUBSET t ==> f differentiable (at x within s)`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_WITHIN_SUBSET]);; let DIFFERENTIABLE_ON_SUBSET = prove (`!f:real^M->real^N s t. f differentiable_on t /\ s SUBSET t ==> f differentiable_on s`, REWRITE_TAC[differentiable_on] THEN MESON_TAC[SUBSET; DIFFERENTIABLE_WITHIN_SUBSET]);; let DIFFERENTIABLE_ON_EMPTY = prove (`!f. f differentiable_on {}`, REWRITE_TAC[differentiable_on; NOT_IN_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Several results are easier using a "multiplied-out" variant. *) (* (I got this idea from Dieudonne's proof of the chain rule). *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_WITHIN_ALT = prove (`!f:real^M->real^N f' s x. (f has_derivative f') (at x within s) <=> linear f' /\ !e. &0 < e ==> ?d. &0 < d /\ !y. y IN s /\ norm(y - x) < d ==> norm(f(y) - f(x) - f'(y - x)) <= e * norm(y - x)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative_within; LIM_WITHIN] THEN ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN ASM_CASES_TAC `linear(f':real^M->real^N)` THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ] THEN REWRITE_TAC[VECTOR_ARITH `a - (b + c) = a - b - c :real^M`] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `&0 < norm(y - x :real^M)` THENL [ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [NORM_POS_LT]) THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; VECTOR_ARITH `vec 0 - x = --x`; NORM_NEG] THEN ASM_MESON_TAC[LINEAR_0; NORM_0; REAL_LE_REFL]; FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2 * norm(y - x :real^M)` THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC]);; let HAS_DERIVATIVE_AT_ALT = prove (`!f:real^M->real^N f' x. (f has_derivative f') (at x) <=> linear f' /\ !e. &0 < e ==> ?d. &0 < d /\ !y. norm(y - x) < d ==> norm(f(y) - f(x) - f'(y - x)) <= e * norm(y - x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* The chain rule. *) (* ------------------------------------------------------------------------- *) let DIFF_CHAIN_WITHIN = prove (`!f:real^M->real^N g:real^N->real^P f' g' x s. (f has_derivative f') (at x within s) /\ (g has_derivative g') (at (f x) within (IMAGE f s)) ==> ((g o f) has_derivative (g' o f'))(at x within s)`, REPEAT GEN_TAC THEN SIMP_TAC[HAS_DERIVATIVE_WITHIN_ALT; LINEAR_COMPOSE] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(X_CHOOSE_TAC `B1:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC th) THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> ASSUME_TAC th THEN X_CHOOSE_TAC `B2:real` (MATCH_MP LINEAR_BOUNDED_POS th)) MP_TAC) THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MP_TAC(SPEC `e / &2 / B2` th)) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / (&1 + B1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_LT_ADD] THEN DISCH_THEN(X_CHOOSE_THEN `de:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_ADD; REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d0:real`; `de / (B1 + &1)`] REAL_DOWN2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_ADD; REAL_LT_01] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN UNDISCH_TAC `!y. y IN s /\ norm(y - x) < d2 ==> norm ((f:real^M->real^N) y - f x - f'(y - x)) <= norm(y - x)` THEN DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) y`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[IN_IMAGE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(f'(y - x)) + norm((f:real^M->real^N) y - f x - f'(y - x))` THEN REWRITE_TAC[NORM_TRIANGLE_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B1 * norm(y - x) + norm(y - x :real^M)` THEN ASM_SIMP_TAC[REAL_LE_ADD2] THEN REWRITE_TAC[REAL_ARITH `a * x + x = x * (a + &1)`] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_ADD; REAL_LT_01] THEN ASM_MESON_TAC[REAL_LT_TRANS]; DISCH_TAC] THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm((g:real^N->real^P)(f(y:real^M)) - g(f x) - g'(f y - f x)) + norm((g(f y) - g(f x) - g'(f'(y - x))) - (g(f y) - g(f x) - g'(f y - f x)))` THEN REWRITE_TAC[NORM_TRIANGLE_SUB] THEN REWRITE_TAC[VECTOR_ARITH `(a - b - c1) - (a - b - c2) = c2 - c1:real^M`] THEN ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= d ==> b <= ee - d ==> a + b <= ee`)) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * norm((f:real^M->real^N) y - f x - f'(y - x))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * e / &2 / B2 * norm(y - x :real^M)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `b * ((e * h) * b') * x <= e * x - d <=> d <= e * (&1 - h * b' * b) * x`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_ADD; REAL_LT_01] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(f'(y - x)) + norm((f:real^M->real^N) y - f x - f'(y - x))` THEN REWRITE_TAC[NORM_TRIANGLE_SUB] THEN MATCH_MP_TAC(REAL_ARITH `u <= x * b /\ v <= b ==> u + v <= b * (&1 + x)`) THEN ASM_REWRITE_TAC[]);; let DIFF_CHAIN_AT = prove (`!f:real^M->real^N g:real^N->real^P f' g' x. (f has_derivative f') (at x) /\ (g has_derivative g') (at (f x)) ==> ((g o f) has_derivative (g' o f')) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN ASM_MESON_TAC[DIFF_CHAIN_WITHIN; LIM_WITHIN_SUBSET; SUBSET_UNIV; HAS_DERIVATIVE_WITHIN_SUBSET]);; let HAS_DERIVATIVE_WITHIN_REFLECT = prove (`!f:real^M->real^N f' s a. ((\x. f(--x)) has_derivative (\x. f'(--x))) (at (--a) within (IMAGE (--) s)) <=> (f has_derivative f') (at a within s)`, REWRITE_TAC[TAUT `(p <=> q) <=> (q ==> p) /\ (p ==> q)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `(--):real^M->real^M` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] DIFF_CHAIN_WITHIN)) THEN REWRITE_TAC[o_DEF; VECTOR_NEG_NEG; ETA_AX] THEN SIMP_TAC[LINEAR_NEGATION; HAS_DERIVATIVE_LINEAR]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[o_DEF; VECTOR_NEG_NEG; ETA_AX; GSYM IMAGE_o; IMAGE_ID]]);; let HAS_DERIVATIVE_AT_REFLECT = prove (`!f:real^M->real^N f' a. ((\x. f(--x)) has_derivative (\x. f'(--x))) (at (--a)) <=> (f has_derivative f') (at a)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM HAS_DERIVATIVE_WITHIN_REFLECT] THEN REWRITE_TAC[REFLECT_UNIV]);; let DIFFERENTIABLE_ON_REFLECT = prove (`!f:real^M->real^N s. (\x. f(--x)) differentiable_on (IMAGE (--) s) <=> f differentiable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[differentiable_on; differentiable; FORALL_IN_IMAGE] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN GEN_REWRITE_TAC LAND_CONV [GSYM HAS_DERIVATIVE_WITHIN_REFLECT] THEN REWRITE_TAC[o_DEF; VECTOR_NEG_NEG; ETA_AX; GSYM IMAGE_o; IMAGE_ID] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Composition rules stated just for differentiability. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_LINEAR = prove (`!net f:real^M->real^N. linear f ==> f differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_LINEAR]);; let DIFFERENTIABLE_CONST = prove (`!c net. (\z. c) differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_CONST]);; let DIFFERENTIABLE_ID = prove (`!net. (\z. z) differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_ID]);; let DIFFERENTIABLE_LIFT_COMPONENT = prove (`!net:(real^N)net. (\x. lift(x$i)) differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_LIFT_COMPONENT]);; let DIFFERENTIABLE_CMUL = prove (`!net f c. f differentiable net ==> (\x. c % f(x)) differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_CMUL]);; let DIFFERENTIABLE_NEG = prove (`!f net. f differentiable net ==> (\z. --(f z)) differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_NEG]);; let DIFFERENTIABLE_ADD = prove (`!f g net. f differentiable net /\ g differentiable net ==> (\z. f z + g z) differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_ADD]);; let DIFFERENTIABLE_SUB = prove (`!f g net. f differentiable net /\ g differentiable net ==> (\z. f z - g z) differentiable net`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_SUB]);; let DIFFERENTIABLE_VSUM = prove (`!f net s. FINITE s /\ (!a. a IN s ==> (f a) differentiable net) ==> (\x. vsum s (\a. f a x)) differentiable net`, REPEAT GEN_TAC THEN REWRITE_TAC[differentiable] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; SKOLEM_THM; RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(CHOOSE_THEN (MP_TAC o MATCH_MP HAS_DERIVATIVE_VSUM)) THEN MESON_TAC[]);; let DIFFERENTIABLE_VSUM_NUMSEG = prove (`!f net m n. FINITE s /\ (!i. m <= i /\ i <= n ==> (f i) differentiable net) ==> (\x. vsum (m..n) (\a. f a x)) differentiable net`, SIMP_TAC[DIFFERENTIABLE_VSUM; FINITE_NUMSEG; IN_NUMSEG]);; let DIFFERENTIABLE_CHAIN_AT = prove (`!f g x. f differentiable (at x) /\ g differentiable (at(f x)) ==> (g o f) differentiable (at x)`, REWRITE_TAC[differentiable] THEN MESON_TAC[DIFF_CHAIN_AT]);; let DIFFERENTIABLE_CHAIN_WITHIN = prove (`!f g x s. f differentiable (at x within s) /\ g differentiable (at(f x) within IMAGE f s) ==> (g o f) differentiable (at x within s)`, REWRITE_TAC[differentiable] THEN MESON_TAC[DIFF_CHAIN_WITHIN]);; let DIFFERENTIABLE_COMPONENTWISE_WITHIN = prove (`!f:real^M->real^N a s. f differentiable (at a within s) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift(f(x)$i)) differentiable (at a within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[differentiable] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [HAS_DERIVATIVE_COMPONENTWISE_WITHIN] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `g':real^M->real^N`) THEN EXISTS_TAC `\i x. lift((g':real^M->real^N) x$i)` THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_TAC `g':num->real^M->real^1`) THEN EXISTS_TAC `(\x. lambda i. drop((g':num->real^M->real^1) i x)) :real^M->real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]);; let DIFFERENTIABLE_COMPONENTWISE_AT = prove (`!f:real^M->real^N a. f differentiable (at a) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift(f(x)$i)) differentiable (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MATCH_ACCEPT_TAC DIFFERENTIABLE_COMPONENTWISE_WITHIN);; (* ------------------------------------------------------------------------- *) (* Similarly for "differentiable_on". *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_ON_LINEAR = prove (`!f:real^M->real^N s. linear f ==> f differentiable_on s`, SIMP_TAC[differentiable_on; DIFFERENTIABLE_LINEAR]);; let DIFFERENTIABLE_ON_CONST = prove (`!s c. (\z. c) differentiable_on s`, REWRITE_TAC[differentiable_on; DIFFERENTIABLE_CONST]);; let DIFFERENTIABLE_ON_ID = prove (`!s. (\z. z) differentiable_on s`, REWRITE_TAC[differentiable_on; DIFFERENTIABLE_ID]);; let DIFFERENTIABLE_ON_COMPOSE = prove (`!f g s. f differentiable_on s /\ g differentiable_on (IMAGE f s) ==> (g o f) differentiable_on s`, SIMP_TAC[differentiable_on; FORALL_IN_IMAGE] THEN MESON_TAC[DIFFERENTIABLE_CHAIN_WITHIN]);; let DIFFERENTIABLE_ON_NEG = prove (`!f s. f differentiable_on s ==> (\z. --(f z)) differentiable_on s`, SIMP_TAC[differentiable_on; DIFFERENTIABLE_NEG]);; let DIFFERENTIABLE_ON_ADD = prove (`!f g s. f differentiable_on s /\ g differentiable_on s ==> (\z. f z + g z) differentiable_on s`, SIMP_TAC[differentiable_on; DIFFERENTIABLE_ADD]);; let DIFFERENTIABLE_ON_SUB = prove (`!f g s. f differentiable_on s /\ g differentiable_on s ==> (\z. f z - g z) differentiable_on s`, SIMP_TAC[differentiable_on; DIFFERENTIABLE_SUB]);; (* ------------------------------------------------------------------------- *) (* Uniqueness of derivative. *) (* *) (* The general result is a bit messy because we need approachability of the *) (* limit point from any direction. But OK for nontrivial intervals etc. *) (* ------------------------------------------------------------------------- *) let FRECHET_DERIVATIVE_UNIQUE_WITHIN = prove (`!f:real^M->real^N f' f'' x s. (f has_derivative f') (at x within s) /\ (f has_derivative f'') (at x within s) /\ (!i e. 1 <= i /\ i <= dimindex(:M) /\ &0 < e ==> ?d. &0 < abs(d) /\ abs(d) < e /\ (x + d % basis i) IN s) ==> f' = f''`, REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(x:real^M) limit_point_of s` ASSUME_TAC THENL [REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`1`; `e:real`]) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1; LE_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(x:real^M) + d % basis 1` THEN ASM_REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_EQ_0; REAL_MUL_RID; DE_MORGAN_THM; REAL_ABS_NZ; BASIS_NONZERO]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN SUBGOAL_THEN `netlimit(at x within s) = x:real^M` SUBST_ALL_TAC THENL [ASM_MESON_TAC[NETLIMIT_WITHIN; TRIVIAL_LIMIT_WITHIN]; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN REWRITE_TAC[VECTOR_ARITH `fx - (fa + f'') - (fx - (fa + f')):real^M = f' - f''`] THEN DISCH_TAC THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN GEN_REWRITE_TAC I [TAUT `p = ~ ~p`] THEN PURE_REWRITE_TAC[GSYM NORM_POS_LT] THEN DISCH_TAC THEN ABBREV_TAC `e = norm((f':real^M->real^N) (basis i) - f''(basis i :real^M))` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `d:real`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^M) + c % basis i`) THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL] THEN ASM_SIMP_TAC[NORM_BASIS; REAL_MUL_RID] THEN ASM_SIMP_TAC[LINEAR_CMUL; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_ABS] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_LID; REAL_LT_REFL]);; let FRECHET_DERIVATIVE_UNIQUE_AT = prove (`!f:real^M->real^N f' f'' x. (f has_derivative f') (at x) /\ (f has_derivative f'') (at x) ==> f' = f''`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `x:real^M`; `(:real^M)`] THEN ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV] THEN MESON_TAC[REAL_ARITH `&0 < e ==> &0 < abs(e / &2) /\ abs(e / &2) < e`]);; let HAS_FRECHET_DERIVATIVE_UNIQUE_AT = prove (`!f:real^M->real^N f' x. (f has_derivative f') (at x) ==> frechet_derivative f (at x) = f'`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `x:real^M`] THEN ASM_REWRITE_TAC[frechet_derivative] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]);; let FRECHET_DERIVATIVE_CONST_AT = prove (`!c:real^N a:real^M. frechet_derivative (\x. c) (at a) = \h. vec 0`, REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_FRECHET_DERIVATIVE_UNIQUE_AT THEN REWRITE_TAC[HAS_DERIVATIVE_CONST]);; let FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL = prove (`!f:real^M->real^N f' f'' x a b. (!i. 1 <= i /\ i <= dimindex(:M) ==> a$i < b$i) /\ x IN interval[a,b] /\ (f has_derivative f') (at x within interval[a,b]) /\ (f has_derivative f'') (at x within interval[a,b]) ==> f' = f''`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `x:real^M`; `interval[a:real^M,b]`] THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`i:num`; `e:real`] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(?a. P a \/ P(--a)) ==> (?a:real. P a)`) THEN EXISTS_TAC `(min ((b:real^M)$i - (a:real^M)$i) e) / &2` THEN REWRITE_TAC[REAL_ABS_NEG; GSYM LEFT_OR_DISTRIB] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [UNDISCH_TAC `&0 < e` THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN SUBGOAL_THEN `!P. (!j. 1 <= j /\ j <= dimindex(:M) ==> P j) <=> P i /\ (!j. 1 <= j /\ j <= dimindex(:M) /\ ~(j = i) ==> P j)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN UNDISCH_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL = prove (`!f:real^M->real^N f' f'' x a b. x IN interval(a,b) /\ (f has_derivative f') (at x within interval(a,b)) /\ (f has_derivative f'') (at x within interval(a,b)) ==> f' = f''`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `x:real^M`; `interval(a:real^M,b)`] THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`i:num`; `e:real`] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(?a. P a \/ P(--a)) ==> (?a:real. P a)`) THEN EXISTS_TAC `(min ((b:real^M)$i - (a:real^M)$i) e) / &3` THEN REWRITE_TAC[REAL_ABS_NEG; GSYM LEFT_OR_DISTRIB] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [UNDISCH_TAC `&0 < e` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `(x:real^M) IN interval(a,b)` THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN SUBGOAL_THEN `!P. (!j. 1 <= j /\ j <= dimindex(:M) ==> P j) <=> P i /\ (!j. 1 <= j /\ j <= dimindex(:M) /\ ~(j = i) ==> P j)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN UNDISCH_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let FRECHET_DERIVATIVE_AT = prove (`!f:real^M->real^N f' x. (f has_derivative f') (at x) ==> (f' = frechet_derivative f (at x))`, MESON_TAC[has_derivative; FRECHET_DERIVATIVE_WORKS; differentiable; FRECHET_DERIVATIVE_UNIQUE_AT]);; let FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL = prove (`!f:real^M->real^N f' x a b. (!i. 1 <= i /\ i <= dimindex(:M) ==> a$i < b$i) /\ x IN interval[a,b] /\ (f has_derivative f') (at x within interval[a,b]) ==> frechet_derivative f (at x within interval[a,b]) = f'`, ASM_MESON_TAC[has_derivative; FRECHET_DERIVATIVE_WORKS; differentiable; FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL]);; (* ------------------------------------------------------------------------- *) (* Component of the differential must be zero if it exists at a local *) (* maximum or minimum for that corresponding component. Start with slightly *) (* sharper forms that fix the sign of the derivative on the boundary. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM = prove (`!f:real^M->real^N f' x s k e. 1 <= k /\ k <= dimindex(:N) /\ x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ &0 < e /\ (!w. w IN s INTER ball(x,e) ==> (f x)$k <= (f w)$k) ==> !y. y IN s ==> &0 <= (f'(y - x))$k`, REWRITE_TAC[has_derivative_within] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `y:real^M = x` THENL [ASM_MESON_TAC[VECTOR_SUB_REFL; LINEAR_0; VEC_COMPONENT; REAL_LE_REFL]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `--((f':real^M->real^N)(y - x)$k) / norm(y - x)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; NOT_EXISTS_THM; REAL_ARITH `&0 < --x <=> x < &0`] THEN X_GEN_TAC `d:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ABBREV_TAC `de = min (&1) ((min d e) / &2 / norm(y - x:real^M))` THEN DISCH_THEN(MP_TAC o SPEC `x + de % (y - x):real^M`) THEN REWRITE_TAC[dist; VECTOR_ADD_SUB; NOT_IMP; GSYM CONJ_ASSOC] THEN SUBGOAL_THEN `norm(de % (y - x):real^M) < min d e` MP_TAC THENL [ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN EXPAND_TAC "de" THEN MATCH_MP_TAC(REAL_ARITH `&0 < de / x ==> abs(min (&1) (de / &2 / x)) < de / x`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]; REWRITE_TAC[REAL_LT_MIN] THEN STRIP_TAC] THEN SUBGOAL_THEN `&0 < de /\ de <= &1` STRIP_ASSUME_TAC THENL [EXPAND_TAC "de" THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_01; REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `x + a % (y - x):real^N = (&1 - a) % x + a % y`] THEN MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; DISCH_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NORM_MUL] THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_ARITH `&0 < x ==> &0 < abs x`; NORM_POS_LT; VECTOR_SUB_EQ; VECTOR_SUB_RZERO] THEN MATCH_MP_TAC(NORM_ARITH `abs(y$k) <= norm(y) /\ ~(abs(y$k) < e) ==> ~(norm y < e)`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_MUL; REAL_ABS_NORM; REAL_ABS_ABS] THEN REWRITE_TAC[REAL_NOT_LT; REAL_INV_MUL; REAL_ARITH `d <= (a * inv b) * c <=> d <= (c * a) / b`] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; REAL_ARITH `&0 < x ==> &0 < abs x`] THEN MATCH_MP_TAC(REAL_ARITH `fx <= fy /\ a = --b /\ b < &0 ==> a <= abs(fy - (fx + b))`) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN ASM_SIMP_TAC[real_abs; VECTOR_MUL_COMPONENT; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * y < &0 <=> &0 < x * --y`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM_REAL_ARITH_TAC] THEN ASM_REWRITE_TAC[IN_INTER; IN_BALL; NORM_ARITH `dist(x:real^M,x + e) = norm e`]);; let DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM = prove (`!f:real^M->real^N f' x s k e. 1 <= k /\ k <= dimindex(:N) /\ x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ &0 < e /\ (!w. w IN s INTER ball(x,e) ==> (f w)$k <= (f x)$k) ==> !y. y IN s ==> (f'(y - x))$k <= &0`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. --((f:real^M->real^N) x)`; `\x. --((f':real^M->real^N) x)`; `x:real^M`; `s:real^M->bool`; `k:num`; `e:real`] DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM) THEN ASM_SIMP_TAC[HAS_DERIVATIVE_NEG] THEN ASM_SIMP_TAC[REAL_LE_NEG2; VECTOR_NEG_COMPONENT; REAL_NEG_GE0]);; let DROP_DIFFERENTIAL_POS_AT_MINIMUM = prove (`!f:real^N->real^1 f' x s e. x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ &0 < e /\ (!w. w IN s INTER ball(x,e) ==> drop(f x) <= drop(f w)) ==> !y. y IN s ==> &0 <= drop(f'(y - x))`, REPEAT GEN_TAC THEN REWRITE_TAC[drop] THEN STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `e:real`] THEN ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; let DROP_DIFFERENTIAL_NEG_AT_MAXIMUM = prove (`!f:real^N->real^1 f' x s e. x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ &0 < e /\ (!w. w IN s INTER ball(x,e) ==> drop(f w) <= drop(f x)) ==> !y. y IN s ==> drop(f'(y - x)) <= &0`, REPEAT GEN_TAC THEN REWRITE_TAC[drop] THEN STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `e:real`] THEN ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; let DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN = prove (`!f:real^M->real^N f' x s k. 1 <= k /\ k <= dimindex(:N) /\ x IN s /\ open s /\ (f has_derivative f') (at x) /\ ((!w. w IN s ==> (f w)$k <= (f x)$k) \/ (!w. w IN s ==> (f x)$k <= (f w)$k)) ==> !h. (f' h)$k = &0`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [MP_TAC(ISPECL [`f:real^M->real^N`; `f':real^M->real^N`; `x:real^M`; `cball(x:real^M,e)`; `k:num`; `e:real`] DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM); MP_TAC(ISPECL [`f:real^M->real^N`; `f':real^M->real^N`; `x:real^M`; `cball(x:real^M,e)`; `k:num`; `e:real`] DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM)] THEN ASM_SIMP_TAC[HAS_DERIVATIVE_AT_WITHIN; CENTRE_IN_CBALL; CONVEX_CBALL; REAL_LT_IMP_LE; IN_INTER] THEN DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `h:real^M` THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [has_derivative_at]) THEN (ASM_CASES_TAC `h:real^M = vec 0` THENL [ASM_MESON_TAC[LINEAR_0; VEC_COMPONENT]; ALL_TAC]) THEN REMOVE_THEN "*" (fun th -> MP_TAC(SPEC `x + e / norm h % h:real^M` th) THEN MP_TAC(SPEC `x - e / norm h % h:real^M` th)) THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(x:real^N,x - e) = norm e /\ dist(x:real^N,x + e) = norm e`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[real_abs; REAL_DIV_RMUL; NORM_EQ_0; REAL_LT_IMP_LE; REAL_LE_REFL] THEN REWRITE_TAC[VECTOR_ARITH `x - e - x:real^N = --e /\ (x + e) - x = e`] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_NEG th]) THEN REWRITE_TAC[IMP_IMP; REAL_ARITH `&0 <= --x /\ &0 <= x <=> x = &0`; VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= &0 /\ x <= &0 <=> x = &0`] THEN DISCH_THEN(MP_TAC o AP_TERM `(*) (norm(h:real^M) / e)`) THEN REWRITE_TAC[GSYM VECTOR_MUL_COMPONENT] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> x / y * y / x = &1`; NORM_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_LID]);; let DIFFERENTIAL_ZERO_MAXMIN_COMPONENT = prove (`!f:real^M->real^N x e k. 1 <= k /\ k <= dimindex(:N) /\ &0 < e /\ ((!y. y IN ball(x,e) ==> (f y)$k <= (f x)$k) \/ (!y. y IN ball(x,e) ==> (f x)$k <= (f y)$k)) /\ f differentiable (at x) ==> (jacobian f (at x) $ k = vec 0)`, REWRITE_TAC[JACOBIAN_WORKS] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `\h:real^M. jacobian (f:real^M->real^N) (at x) ** h`; `x:real^M`; `ball(x:real^M,e)`; `k:num`] DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; FORALL_DOT_EQ_0]);; let DIFFERENTIAL_ZERO_MAXMIN = prove (`!f:real^N->real^1 f' x s. x IN s /\ open s /\ (f has_derivative f') (at x) /\ ((!y. y IN s ==> drop(f y) <= drop(f x)) \/ (!y. y IN s ==> drop(f x) <= drop(f y))) ==> (f' = \v. vec 0)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^1`; `f':real^N->real^1`; `x:real^N`; `s:real^N->bool`; `1:num`] DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN) THEN ASM_REWRITE_TAC[GSYM drop; DIMINDEX_1; LE_REFL] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; FUN_EQ_THM; LIFT_DROP]);; (* ------------------------------------------------------------------------- *) (* The traditional Rolle theorem in one dimension. *) (* ------------------------------------------------------------------------- *) let ROLLE = prove (`!f:real^1->real^1 f' a b. drop a < drop b /\ (f a = f b) /\ f continuous_on interval[a,b] /\ (!x. x IN interval(a,b) ==> (f has_derivative f'(x)) (at x)) ==> ?x. x IN interval(a,b) /\ (f'(x) = \v. vec 0)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] CONTINUOUS_IVT_LOCAL_EXTREMUM) THEN ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFFERENTIAL_ZERO_MAXMIN THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^1`; `c:real^1`; `interval(a:real^1,b)`] THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; OPEN_INTERVAL]);; (* ------------------------------------------------------------------------- *) (* One-dimensional mean value theorem. *) (* ------------------------------------------------------------------------- *) let MVT = prove (`!f:real^1->real^1 f' a b. drop a < drop b /\ f continuous_on interval[a,b] /\ (!x. x IN interval(a,b) ==> (f has_derivative f'(x)) (at x)) ==> ?x. x IN interval(a,b) /\ (f(b) - f(a) = f'(x) (b - a))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. f(x) - (drop(f b - f a) / drop(b - a)) % x`; `\k:real^1 x:real^1. f'(k)(x) - (drop(f b - f a) / drop(b - a)) % x`; `a:real^1`; `b:real^1`] ROLLE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `(fa - k % a = fb - k % b) <=> (fb - fa = k % (b - a))`]; REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN ASM_SIMP_TAC[HAS_DERIVATIVE_CMUL; HAS_DERIVATIVE_ID; ETA_AX]]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b - a:real^1`))] THEN SIMP_TAC[VECTOR_SUB_EQ; GSYM DROP_EQ; DROP_SUB; DROP_CMUL] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_SUB_LT; REAL_LT_IMP_NZ]);; let MVT_SIMPLE = prove (`!f:real^1->real^1 f' a b. drop a < drop b /\ (!x. x IN interval[a,b] ==> (f has_derivative f'(x)) (at x within interval[a,b])) ==> ?x. x IN interval(a,b) /\ (f(b) - f(a) = f'(x) (b - a))`, MP_TAC MVT THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_MESON_TAC[differentiable_on; differentiable]; ASM_MESON_TAC[HAS_DERIVATIVE_WITHIN_OPEN; OPEN_INTERVAL; HAS_DERIVATIVE_WITHIN_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]]);; let MVT_VERY_SIMPLE = prove (`!f:real^1->real^1 f' a b. drop a <= drop b /\ (!x. x IN interval[a,b] ==> (f has_derivative f'(x)) (at x within interval[a,b])) ==> ?x. x IN interval[a,b] /\ (f(b) - f(a) = f'(x) (b - a))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^1 = a` THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN REWRITE_TAC[INTERVAL_SING; IN_SING; has_derivative; UNWIND_THM2] THEN MESON_TAC[LINEAR_0]; ASM_REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN DISCH_THEN(MP_TAC o MATCH_MP MVT_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED]]);; let MVT_SEGMENT = prove (`!f:real^N->real^1 f' a b. ~(a = b) /\ f continuous_on segment[a,b] /\ (!x. x IN segment(a,b) ==> (f has_derivative f' x) (at x within segment(a,b))) ==> ?c. c IN segment(a,b) /\ f(b) - f(a) = f'(c) (b - a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^N->real^1) o (\x. (&1 - drop x) % a + drop x % b)`; `\x. (f':real^N->real^N->real^1) ((&1 - drop x) % a + drop x % b) o (\x. drop x % (b - a))`; `vec 0:real^1`; `vec 1:real^1`] MVT) THEN REWRITE_TAC[DROP_VEC; REAL_LT_01; o_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[GSYM SEGMENT_IMAGE_INTERVAL] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_VMUL; o_DEF; LIFT_DROP; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; LIFT_SUB; CONTINUOUS_ON_SUB]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[HAS_DERIVATIVE_WITHIN_OPEN] `a IN s ==> open s /\ (f has_derivative f') (at a within s) ==> (f has_derivative f') (at a)`)) THEN REWRITE_TAC[OPEN_INTERVAL] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[OPEN_INTERVAL; GSYM SEGMENT_IMAGE_INTERVAL] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM VECTOR_ADD_LID] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % b:real^N = a + x % (b - a)`] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THEN ASM SET_TAC[]]]; ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL; EXISTS_IN_IMAGE] THEN REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; DROP_VEC] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_REFL] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]]);; let MVT_SEGMENT_SIMPLE = prove (`!f:real^N->real^1 f' a b. ~(a = b) /\ (!x. x IN segment[a,b] ==> (f has_derivative f' x) (at x within segment(a,b))) ==> ?c. c IN segment(a,b) /\ f(b) - f(a) = f'(c) (b - a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MVT_SEGMENT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED]] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN REWRITE_TAC[differentiable_on] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN EXISTS_TAC `(f':real^N->real^N->real^1) x` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[has_derivative_within] THEN AP_TERM_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_SET THEN REWRITE_TAC[EVENTUALLY_AT] THEN ASM_CASES_TAC `x:real^N = a \/ x:real^N = b` THENL [EXISTS_TAC `dist(a:real^N,b)` THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC); RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN EXISTS_TAC `min (dist(x:real^N,a)) (dist(x,b))`] THEN ASM_SIMP_TAC[GSYM DIST_NZ; REAL_LT_MIN; SEGMENT_CLOSED_OPEN; IN_UNION] THEN SIMP_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[DIST_SYM; REAL_LT_REFL]);; (* ------------------------------------------------------------------------- *) (* A nice generalization (see Havin's proof of 5.19 from Rudin's book). *) (* ------------------------------------------------------------------------- *) let MVT_GENERAL = prove (`!f:real^1->real^N f' a b. drop a < drop b /\ f continuous_on interval[a,b] /\ (!x. x IN interval(a,b) ==> (f has_derivative f'(x)) (at x)) ==> ?x. x IN interval(a,b) /\ norm(f(b) - f(a)) <= norm(f'(x) (b - a))`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(lift o (\y. (f(b) - f(a)) dot y)) o (f:real^1->real^N)`; `\x t. lift((f(b:real^1) - f(a)) dot ((f':real^1->real^1->real^N) x t))`; `a:real^1`; `b:real^1`] MVT) THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT; CONTINUOUS_ON_COMPOSE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC HAS_DERIVATIVE_LIFT_DOT THEN ASM_SIMP_TAC[ETA_AX]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; LIFT_EQ] THEN DISCH_TAC THEN ASM_CASES_TAC `(f:real^1->real^N) b = f a` THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; NORM_POS_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `norm((f:real^1->real^N) b - f a)` THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ; GSYM REAL_POW_2] THEN ASM_REWRITE_TAC[NORM_POW_2; NORM_CAUCHY_SCHWARZ]);; (* ------------------------------------------------------------------------- *) (* Still more general bound theorem. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_BOUND = prove (`!f:real^M->real^N f' s B. convex s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x within s)) /\ (!x. x IN s ==> onorm(f'(x)) <= B) ==> !x y. x IN s /\ y IN s ==> norm(f(x) - f(y)) <= B * norm(x - y)`, ONCE_REWRITE_TAC[NORM_SUB] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x y. x IN s ==> norm((f':real^M->real^M->real^N)(x) y) <= B * norm(y)` ASSUME_TAC THENL [ASM_MESON_TAC[ONORM; has_derivative; REAL_LE_TRANS; NORM_POS_LE; REAL_LE_RMUL]; ALL_TAC] THEN SUBGOAL_THEN `!u. u IN interval[vec 0,vec 1] ==> (x + drop u % (y - x) :real^M) IN s` ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL; FORALL_DIMINDEX_1; drop] THEN SIMP_TAC[VEC_COMPONENT; LE_REFL; DIMINDEX_1] THEN REWRITE_TAC[VECTOR_ARITH `x + u % (y - x) = (&1 - u) % x + u % y`] THEN ASM_MESON_TAC[CONVEX_ALT]; ALL_TAC] THEN SUBGOAL_THEN `!u. u IN interval(vec 0,vec 1) ==> (x + drop u % (y - x) :real^M) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]; ALL_TAC] THEN MP_TAC(SPECL [`(f:real^M->real^N) o (\u. x + drop u % (y - x))`; `\u. (f':real^M->real^M->real^N) (x + drop u % (y - x)) o (\u. vec 0 + drop u % (y - x))`; `vec 0:real^1`; `vec 1:real^1`] MVT_GENERAL) THEN REWRITE_TAC[o_THM; DROP_VEC; VECTOR_ARITH `x + &1 % (y - x) = y`; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[VECTOR_ADD_LID; REAL_LE_TRANS]] THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_VMUL; o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; differentiable; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; ALL_TAC] THEN X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `a IN interval(vec 0:real^1,vec 1) /\ open(interval(vec 0:real^1,vec 1))` MP_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL]; ALL_TAC] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP HAS_DERIVATIVE_WITHIN_OPEN th)]) THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[HAS_DERIVATIVE_ADD; HAS_DERIVATIVE_CONST; HAS_DERIVATIVE_VMUL_DROP; HAS_DERIVATIVE_ID] THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]);; (* ------------------------------------------------------------------------- *) (* A sort of converse bounding the derivatives. *) (* ------------------------------------------------------------------------- *) let ONORM_DERIVATIVES_LE = prove (`!f:real^M->real^N g:real^M->real^P f' g' x. (f has_derivative f') (at x) /\ (g has_derivative g') (at x) /\ eventually (\y. norm(f y - f x) <= norm(g y - g x)) (at x) ==> onorm f' <= onorm g'`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN ONCE_REWRITE_TAC[REAL_LE_TRANS_LTE] THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN SUBGOAL_THEN `((\y. inv(norm(y - x:real^M)) % lift((norm(f y - f x:real^N) - norm(g y - g x:real^P)) - (norm(f'(y - x):real^N) - norm(g'(y - x):real^P)))) --> vec 0) (at x)` MP_TAC THENL [FIRST_X_ASSUM(CONJUNCTS_THEN(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [has_derivative_at])) THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LIM_NULL_NORM] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NULL_ADD) THEN REWRITE_TAC[GSYM LIFT_ADD] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_NULL_COMPARISON) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[NORM_LIFT] THEN CONV_TAC NORM_ARITH; REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `b - onorm(g':real^M->real^P)`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN FIRST_ASSUM(CONJUNCTS_THEN(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [has_derivative_at])) THEN ASM_SIMP_TAC[ONORM_LE_EVENTUALLY] THEN GEN_REWRITE_TAC LAND_CONV [EVENTUALLY_AT_ZERO] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[EVENTUALLY_AT; DIST_0; VECTOR_ADD_SUB; NORM_POS_LT] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `h:real^M` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_POS_LT; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `abs g <= x * h ==> u <= v /\ abs(u - v - (f - g)) < (b - x) * h ==> f <= b * h`) THEN ASM_SIMP_TAC[REAL_ABS_NORM; ONORM]]);; (* ------------------------------------------------------------------------- *) (* In particular. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_ZERO_CONSTANT = prove (`!f:real^M->real^N s. convex s /\ (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x within s)) ==> ?c. !x. x IN s ==> f(x) = c`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(\x h. vec 0):real^M->real^M->real^N`; `s:real^M->bool`; `&0`] DIFFERENTIABLE_BOUND) THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; ONORM_CONST; NORM_0; REAL_LE_REFL] THEN SIMP_TAC[NORM_LE_0; VECTOR_SUB_EQ] THEN MESON_TAC[]);; let HAS_DERIVATIVE_ZERO_UNIQUE = prove (`!f s a c. convex s /\ a IN s /\ f a = c /\ (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x within s)) ==> !x. x IN s ==> f x = c`, MESON_TAC[HAS_DERIVATIVE_ZERO_CONSTANT]);; let HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT = prove (`!f:real^M->real^N s. open s /\ connected s /\ (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x)) ==> ?c. !x. x IN s ==> f(x) = c`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = f a}`) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [SIMP_TAC[open_in; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[SUBSET; IN_BALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `ball(x:real^M,e)`] HAS_DERIVATIVE_ZERO_CONSTANT) THEN REWRITE_TAC[IN_BALL; CONVEX_BALL] THEN ASM_MESON_TAC[HAS_DERIVATIVE_AT_WITHIN; DIST_SYM; DIST_REFL]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT] THEN ASM_MESON_TAC[differentiable]]);; let HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE = prove (`!f s a c. open s /\ connected s /\ a IN s /\ f a = c /\ (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x)) ==> !x. x IN s ==> f x = c`, MESON_TAC[HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT]);; (* ------------------------------------------------------------------------- *) (* Discreteness of point preimage sets for differentiable function. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_DISCRETE_PREIMAGES = prove (`!f f' s y:real^N. (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x. x IN s /\ f(x) = y ==> ~(det(matrix (f' x)) = &0)) ==> {l | l IN s /\ l limit_point_of {x | x IN s /\ f x = y}} = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN X_GEN_TAC `x0:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `(f:real^N->real^N) x0 = y` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_SEQUENTIAL]) THEN REWRITE_TAC[IN_DELETE; IN_ELIM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:real^N->real^N) o (x:num->real^N)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [SUBGOAL_THEN `(f:real^N->real^N) continuous_on s` MP_TAC THENL [ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; differentiable_on; differentiable]; REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ASM_REWRITE_TAC[o_DEF; LIM_CONST]]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x0:real^N`) THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_SIMP_TAC[DET_MATRIX_EQ_0] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(f':real^N->real^N->real^N) x0`; `g:real^N->real^N`] LINEAR_INVERTIBLE_BOUNDED_BELOW_POS) THEN ASM_SIMP_TAC[LINEAR_FRECHET_DERIVATIVE] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM has_derivative]) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `((f:real^N->real^N) has_derivative f' x0) (at x0 within s)` MP_TAC THENL [ASM_MESON_TAC[]; ASM_REWRITE_TAC[has_derivative_within]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[LIM_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `B:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_ARITH `c % (y - (x + d)):real^N = c % (y - x) - c % d`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; dist; NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[VECTOR_ARITH `c % (p - p) - v:real^N = --v`] THEN REWRITE_TAC[REAL_NOT_LT; NORM_NEG; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_ARITH `inv x * y:real = y / x`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ]);; let DIFFERENTIABLE_DISCRETE_PREIMAGES_CLOSED = prove (`!f f' s y:real^N. closed s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x. x IN s /\ f(x) = y ==> ~(det(matrix (f' x)) = &0)) ==> {l | l limit_point_of {x | x IN s /\ f x = y}} = {}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. {x | x IN s /\ P x} = {} /\ (!x. P x ==> x IN s) ==> {x | P x} = {}`) THEN EXISTS_TAC `s:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_DISCRETE_PREIMAGES THEN ASM_MESON_TAC[]; X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CLOSED_LIMPT]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIMPT_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT]]);; let DIFFERENTIABLE_COUNTABLE_PREIMAGES = prove (`!f f' s y:real^N. (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x. x IN s /\ f(x) = y ==> ~(det(matrix (f' x)) = &0)) ==> COUNTABLE {x | x IN s /\ f(x) = y}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN REWRITE_TAC[GSYM DISCRETE_SET; IN_ELIM_THM] THEN MATCH_MP_TAC(SET_RULE `{x | P x /\ R x} = {} ==> {x | (P x /\ Q x) /\ R x} = {}`) THEN MATCH_MP_TAC DIFFERENTIABLE_DISCRETE_PREIMAGES THEN ASM_MESON_TAC[]);; let DIFFERENTIABLE_FINITE_PREIMAGES = prove (`!f f' s y:real^N. compact s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x. x IN s /\ f(x) = y ==> ~(det(matrix (f' x)) = &0)) ==> FINITE {x | x IN s /\ f(x) = y}`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFFERENTIABLE_DISCRETE_PREIMAGES) THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC DISCRETE_EQ_FINITE_COMPACT THEN ASM_REWRITE_TAC[SUBSET_RESTRICT]);; let DIFFERENTIABLE_FINITE_PREIMAGES_GEN = prove (`!f:real^N->real^N f' s y. compact {x | x IN s /\ f x = y} /\ (!x. x IN s /\ f x = y ==> (f has_derivative f' x) (at x within s)) /\ (!x. x IN s /\ f x = y ==> ~(det (matrix (f' x)) = &0)) ==> FINITE {x | x IN s /\ f x = y}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ f x = y} = {x | x IN {x | x IN s /\ f x = y} /\ f x = y}`] THEN MATCH_MP_TAC DIFFERENTIABLE_FINITE_PREIMAGES THEN EXISTS_TAC `f':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[SUBSET_RESTRICT]);; (* ------------------------------------------------------------------------- *) (* Differentiability of inverse function (most basic form). *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_INVERSE_WITHIN = prove (`!f:real^M->real^N f' g g' s a. a IN s /\ (!x. x IN s ==> g(f x) = x) /\ (f has_derivative f') (at a within s) /\ linear g' /\ g' o f' = I /\ g continuous (at (f a) within IMAGE f s) ==> (g has_derivative g') (at (f a) within IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN ASM_REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN STRIP_TAC THEN ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN MP_TAC(ISPEC `g':real^N->real^M` LINEAR_BOUNDED_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?B k. &0 < B /\ &0 < k /\ !x. x IN s /\ norm((f:real^M->real^N) x - f a) < k ==> norm(x - a) <= B * norm(f x - f a)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `f':real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&2 / B` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &2`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `B / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; dist] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(fun th -> REPEAT DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(y - b - f':real^N) <= B / &2 * norm(x - a:real^M) ==> norm(x - a) * B <= norm f' ==> norm(y - b) >= B / &2 * norm(x - a)`)) THEN ASM_REWRITE_TAC[real_ge] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_HALF] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (B * C):real`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min k (d / B)` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV] THEN X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LET_TRANS `B * norm((f:real^M->real^N) x - f a)` THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]; DISCH_TAC] THEN TRANS_TAC REAL_LE_TRANS `norm((g':real^N->real^M)(f x - f a - ((f':real^M->real^N) (x - a))))` THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN ASM_SIMP_TAC[LINEAR_SUB] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_ARITH `(e * inv B / C) * n:real = (n / B * e) / C`] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LE_RMUL_EQ] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN ASM_MESON_TAC[REAL_MUL_SYM]);; let HAS_DERIVATIVE_INVERSE_BASIC = prove (`!f:real^M->real^N g f' g' t y. (f has_derivative f') (at (g y)) /\ linear g' /\ (g' o f' = I) /\ g continuous (at y) /\ open t /\ y IN t /\ (!z. z IN t ==> (f(g(z)) = z)) ==> (g has_derivative g') (at y)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `C:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN SUBGOAL_THEN `!e. &0 < e ==> ?d. &0 < d /\ !z. norm(z - y) < d ==> norm((g:real^N->real^M)(z) - g(y) - g'(z - y)) <= e * norm(g(z) - g(y))` ASSUME_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_DERIVATIVE_AT_ALT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / C`)) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN DISCH_THEN(X_CHOOSE_THEN `d0:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(ASSUME_TAC o GEN `z:real^N` o SPEC `(g:real^N->real^M) z`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_at]) THEN DISCH_THEN(MP_TAC o SPEC `d0:real`) THEN ASM_REWRITE_TAC[dist] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N` o GEN_REWRITE_RULE I [open_def]) THEN ASM_REWRITE_TAC[dist] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `C * (e / C) * norm((g:real^N->real^M) z - g y)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_LE_RMUL; REAL_DIV_LMUL; REAL_EQ_IMP_LE; REAL_LT_IMP_NZ; NORM_POS_LE]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `C * norm(f((g:real^N->real^M) z) - y - f'(g z - g y))` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_LMUL_EQ]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(g'(f((g:real^N->real^M) z) - y - f'(g z - g y)):real^M)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[LINEAR_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM NORM_NEG] THEN REWRITE_TAC[VECTOR_ARITH `--(gz:real^N - gy - (z - y)) = z - y - (gz - gy)`] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LT_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `?B d. &0 < B /\ &0 < d /\ !z. norm(z - y) < d ==> norm((g:real^N->real^M)(z) - g(y)) <= B * norm(z - y)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `&2 * C` THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:real^N` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `norm(dg) <= norm(dg') + norm(dg - dg') /\ ((&2 * (&1 - h)) * norm(dg) = &1 * norm(dg)) /\ norm(dg') <= c * norm(d) ==> norm(dg - dg') <= h * norm(dg) ==> norm(dg) <= (&2 * c) * norm(d)`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[NORM_TRIANGLE_SUB]; ALL_TAC] THEN REWRITE_TAC[HAS_DERIVATIVE_AT_ALT] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN DISCH_THEN(X_CHOOSE_THEN `d':real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d:real`; `d':real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e / B * norm ((g:real^N->real^M) z - g y)` THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN ASM_MESON_TAC[REAL_MUL_SYM; REAL_LT_TRANS]);; (* ------------------------------------------------------------------------- *) (* Simply rewrite that based on the domain point x. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_INVERSE_BASIC_X = prove (`!f:real^M->real^N g f' g' t x. (f has_derivative f') (at x) /\ linear g' /\ (g' o f' = I) /\ g continuous (at (f(x))) /\ (g(f(x)) = x) /\ open t /\ f(x) IN t /\ (!y. y IN t ==> (f(g(y)) = y)) ==> (g has_derivative g') (at (f(x)))`, MESON_TAC[HAS_DERIVATIVE_INVERSE_BASIC]);; (* ------------------------------------------------------------------------- *) (* This is the version in Dieudonne', assuming continuity of f and g. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_INVERSE_DIEUDONNE = prove (`!f:real^M->real^N g s. open s /\ open (IMAGE f s) /\ f continuous_on s /\ g continuous_on (IMAGE f s) /\ (!x. x IN s ==> (g(f(x)) = x)) ==> !f' g' x. x IN s /\ (f has_derivative f') (at x) /\ linear g' /\ (g' o f' = I) ==> (g has_derivative g') (at (f(x)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC_X THEN EXISTS_TAC `f':real^M->real^N` THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; IN_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Here's the simplest way of not assuming much about g. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_INVERSE = prove (`!f:real^M->real^N g f' g' s x. compact s /\ x IN s /\ f(x) IN interior(IMAGE f s) /\ f continuous_on s /\ (!x. x IN s ==> (g(f(x)) = x)) /\ (f has_derivative f') (at x) /\ linear g' /\ (g' o f' = I) ==> (g has_derivative g') (at (f(x)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC_X THEN EXISTS_TAC `f':real^M->real^N` THEN EXISTS_TAC `interior(IMAGE (f:real^M->real^N) s)` THEN ASM_MESON_TAC[CONTINUOUS_ON_INTERIOR; CONTINUOUS_ON_INVERSE; OPEN_INTERIOR; IN_IMAGE; INTERIOR_SUBSET; SUBSET]);; (* ------------------------------------------------------------------------- *) (* Proving surjectivity via Brouwer fixpoint theorem. *) (* ------------------------------------------------------------------------- *) let BROUWER_SURJECTIVE = prove (`!f:real^N->real^N s t. compact t /\ convex t /\ ~(t = {}) /\ f continuous_on t /\ (!x y. x IN s /\ y IN t ==> x + (y - f(y)) IN t) ==> !x. x IN s ==> ?y. y IN t /\ (f(y) = x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `((f:real^N->real^N)(y) = x) <=> (x + (y - f(y)) = y)`] THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB; BROUWER; SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_ID]);; let BROUWER_SURJECTIVE_CBALL = prove (`!f:real^N->real^N s a e. &0 < e /\ f continuous_on cball(a,e) /\ (!x y. x IN s /\ y IN cball(a,e) ==> x + (y - f(y)) IN cball(a,e)) ==> !x. x IN s ==> ?y. y IN cball(a,e) /\ (f(y) = x)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC BROUWER_SURJECTIVE THEN ASM_REWRITE_TAC[COMPACT_CBALL; CONVEX_CBALL] THEN ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LT_IMP_LE; REAL_NOT_LT]);; (* ------------------------------------------------------------------------- *) (* See Sussmann: "Multidifferential calculus", Theorem 2.1.1 *) (* ------------------------------------------------------------------------- *) let SUSSMANN_OPEN_MAPPING = prove (`!f:real^M->real^N f' g' s x. open s /\ f continuous_on s /\ x IN s /\ (f has_derivative f') (at x) /\ linear g' /\ (f' o g' = I) ==> !t. t SUBSET s /\ x IN interior(t) ==> f(x) IN interior(IMAGE f t)`, REWRITE_TAC[HAS_DERIVATIVE_AT_ALT] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP LINEAR_BOUNDED_POS (ASSUME `linear(g':real^N->real^M)`)) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1 / (&2 * B)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `e0:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `e1:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`e0 / B`; `e1 / B`] REAL_DOWN2) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\y. (f:real^M->real^N)(x + g'(y - f(x)))`; `cball((f:real^M->real^N) x,e / &2)`; `(f:real^M->real^N) x`; `e:real`] BROUWER_SURJECTIVE_CBALL) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(x:real^M,e1)` THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_CBALL; dist] THEN REWRITE_TAC[VECTOR_ARITH `x - (x + y) = --y:real^N`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NORM_SUB] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B * norm(y - (f:real^M->real^N) x)` THEN ASM_REWRITE_TAC[NORM_NEG] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x + g'(z - (f:real^M->real^N) x)`) THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB] THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(z - (f:real^M->real^N) x)` THEN ASM_REWRITE_TAC[NORM_NEG] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN ASM_MESON_TAC[IN_CBALL; dist; NORM_SUB; REAL_LET_TRANS]; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `a - b - (c - b) = a - c:real^N`] THEN DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `f0 - (y + z - f1) = (f1 - z) + (f0 - y):real^N`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(f(x + g'(z - (f:real^M->real^N) x)) - z) + norm(f x - y)` THEN REWRITE_TAC[NORM_TRIANGLE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x <= a ==> y <= b - a ==> x + y <= b`)) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e / &2` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_CBALL; dist]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `e / &2 <= e - x <=> x <= e / &2`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[REAL_ARITH `(&1 / &2 * b) * x <= e * &1 / &2 <=> x * b <= e`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B * norm(z - (f:real^M->real^N) x)` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_LMUL_EQ; REAL_MUL_SYM; IN_CBALL; dist; DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[IN_INTERIOR] THEN DISCH_THEN(fun th -> EXISTS_TAC `e / &2` THEN MP_TAC th) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; SUBSET] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x + g'(z - (f:real^M->real^N) x)` THEN REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_CBALL; dist; VECTOR_ARITH `x - (x + y) = --y:real^N`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B * norm(z - (f:real^M->real^N) x)` THEN ASM_REWRITE_TAC[NORM_NEG] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN ASM_MESON_TAC[IN_CBALL; dist; NORM_SUB; REAL_LT_IMP_LE; REAL_LE_TRANS]);; let DIFFERENTIABLE_IMP_OPEN_MAP_GEN = prove (`!f:real^M->real^N f' g' s. open s /\ (!x. x IN s ==> (f has_derivative f' x) (at x) /\ linear(g' x) /\ f' x o g' x = I) ==> open(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_INTERIOR_EQ; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(f':real^M->real^M->real^N) x`; `(g':real^M->real^N->real^M) x`; `s:real^M->bool`; `x:real^M`] SUSSMANN_OPEN_MAPPING) THEN ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SUBSET_REFL; INTERIOR_OPEN] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; differentiable] THEN ASM_MESON_TAC[]);; let DIFFERENTIABLE_IMP_OPEN_MAP = prove (`!f:real^N->real^N f' s. open s /\ (!x. x IN s ==> (f has_derivative f' x) (at x) /\ ~(det(matrix(f' x)) = &0)) ==> open(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_OPEN_MAP_GEN THEN EXISTS_TAC `f':real^N->real^N->real^N` THEN ASM_SIMP_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN ASM_MESON_TAC[DET_MATRIX_EQ_0_RIGHT; has_derivative]);; let DIFFERENTIABLE_IMP_OPEN_MAP_ALT = prove (`!f:real^N->real^N f' g' s t. (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\ ~(det(matrix(f' x)) = &0)) /\ open t /\ t SUBSET s ==> open(IMAGE f t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_OPEN_MAP THEN EXISTS_TAC `f':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `t:real^N->bool` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_DERIVATIVE_WITHIN_SUBSET)) THEN ASM_SIMP_TAC[HAS_DERIVATIVE_WITHIN_OPEN]);; (* ------------------------------------------------------------------------- *) (* Hence the following eccentric variant of the inverse function theorem. *) (* This has no continuity assumptions, but we do need the inverse function. *) (* We could put f' o g = I but this happens to fit with the minimal linear *) (* algebra theory I've set up so far. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_INVERSE_STRONG = prove (`!f:real^N->real^N g f' g' s x. open s /\ x IN s /\ f continuous_on s /\ (!x. x IN s ==> (g(f(x)) = x)) /\ (f has_derivative f') (at x) /\ (f' o g' = I) ==> (g has_derivative g') (at (f(x)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC_X THEN SUBGOAL_THEN `linear (g':real^N->real^N) /\ (g' o f' = I)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[has_derivative; RIGHT_INVERSE_LINEAR; LINEAR_INVERSE_LEFT]; ALL_TAC] THEN EXISTS_TAC `f':real^N->real^N` THEN EXISTS_TAC `interior (IMAGE (f:real^N->real^N) s)` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]; REWRITE_TAC[OPEN_INTERIOR]; ASM_MESON_TAC[INTERIOR_OPEN; SUSSMANN_OPEN_MAPPING; LINEAR_INVERSE_LEFT; SUBSET_REFL; has_derivative]; ASM_MESON_TAC[IN_IMAGE; SUBSET; INTERIOR_SUBSET]] THEN REWRITE_TAC[continuous_at] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `!t. t SUBSET s /\ x IN interior(t) ==> (f:real^N->real^N)(x) IN interior(IMAGE f t)` MP_TAC THENL [ASM_MESON_TAC[SUSSMANN_OPEN_MAPPING; LINEAR_INVERSE_LEFT; has_derivative]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e) INTER s`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[IN_INTER; OPEN_BALL; INTERIOR_OPEN; OPEN_INTER; INTER_SUBSET; CENTRE_IN_BALL]; ALL_TAC] THEN REWRITE_TAC[IN_INTERIOR] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL; IN_IMAGE; IN_INTER] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC MONO_IMP THEN ASM_MESON_TAC[DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* A rewrite based on the other domain. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_INVERSE_STRONG_X = prove (`!f:real^N->real^N g f' g' s y. open s /\ (g y) IN s /\ f continuous_on s /\ (!x. x IN s ==> (g(f(x)) = x)) /\ (f has_derivative f') (at (g y)) /\ (f' o g' = I) /\ f(g y) = y ==> (g has_derivative g') (at y)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN MAP_EVERY EXISTS_TAC [`f':real^N->real^N`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* On a region. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_INVERSE_ON = prove (`!f:real^N->real^N s. open s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x) /\ (g(f(x)) = x) /\ (f'(x) o g'(x) = I)) ==> !x. x IN s ==> (g has_derivative g'(x)) (at (f(x)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN EXISTS_TAC `(f':real^N->real^N->real^N) x` THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; DIFFERENTIABLE_IMP_CONTINUOUS_AT; differentiable]);; (* ------------------------------------------------------------------------- *) (* Uniformly convergent sequence of derivatives. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ = prove (`!s f:num->real^M->real^N f' g'. convex s /\ (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ (!e. &0 < e ==> ?N. !n x h. n >= N /\ x IN s ==> norm(f' n x h - g' x h) <= e * norm(h)) ==> !e. &0 < e ==> ?N. !m n x y. m >= N /\ n >= N /\ x IN s /\ y IN s ==> norm((f m x - f n x) - (f m y - f n y)) <= e * norm(x - y)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN ASM_CASES_TAC `m:num >= N` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n:num >= N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFFERENTIABLE_BOUND THEN EXISTS_TAC `\x h. (f':num->real^M->real^M->real^N) m x h - f' n x h` THEN ASM_SIMP_TAC[HAS_DERIVATIVE_SUB; ETA_AX] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `!h. norm((f':num->real^M->real^M->real^N) m x h - f' n x h) <= e * norm(h)` MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_DERIVATIVE_WITHIN_ALT]) THEN ASM_SIMP_TAC[ONORM; LINEAR_COMPOSE_SUB; ETA_AX] THEN X_GEN_TAC `h:real^M` THEN SUBST1_TAC(VECTOR_ARITH `(f':num->real^M->real^M->real^N) m x h - f' n x h = (f' m x h - g' x h) + --(f' n x h - g' x h)`) THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN ASM_SIMP_TAC[NORM_NEG; REAL_ARITH `a <= e / &2 * h /\ b <= e / &2 * h ==> a + b <= e * h`]);; let HAS_DERIVATIVE_SEQUENCE = prove (`!s f:num->real^M->real^N f' g'. convex s /\ (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ (!e. &0 < e ==> ?N. !n x h. n >= N /\ x IN s ==> norm(f' n x h - g' x h) <= e * norm(h)) /\ (?x l. x IN s /\ ((\n. f n x) --> l) sequentially) ==> ?g. !x. x IN s ==> ((\n. f n x) --> g x) sequentially /\ (g has_derivative g'(x)) (at x within s)`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "O") MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x0:real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_TAC "A" `!e. &0 < e ==> ?N. !m n x y. m >= N /\ n >= N /\ x IN s /\ y IN s ==> norm(((f:num->real^M->real^N) m x - f n x) - (f m y - f n y)) <= e * norm(x - y)` [MATCH_MP_TAC HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]] THEN SUBGOAL_THEN `?g:real^M->real^N. !x. x IN s ==> ((\n. f n x) --> g x) sequentially` MP_TAC THENL [REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN GEN_REWRITE_TAC I [CONVERGENT_EQ_CAUCHY] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN REWRITE_TAC[cauchy; dist] THEN DISCH_THEN(LABEL_TAC "B") THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^M = x0` THEN ASM_SIMP_TAC[] THEN REMOVE_THEN "B" (MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN REMOVE_THEN "A" (MP_TAC o SPEC `e / &2 / norm(x - x0:real^M)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_HALF; VECTOR_SUB_EQ] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN (STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE `m >= N1 + N2:num ==> m >= N1 /\ m >= N2`))) THEN SUBST1_TAC(VECTOR_ARITH `(f:num->real^M->real^N) m x - f n x = (f m x - f n x - (f m x0 - f n x0)) + (f m x0 - f n x0)`) THEN MATCH_MP_TAC NORM_TRIANGLE_LT THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`; `x:real^M`; `x0:real^M`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN DISCH_THEN(LABEL_TAC "B") THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN SUBGOAL_TAC "C" `!e. &0 < e ==> ?N. !n x y. n >= N /\ x IN s /\ y IN s ==> norm(((f:num->real^M->real^N) n x - f n y) - (g x - g y)) <= e * norm(x - y)` [X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "A" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `m:num` o SPECL [`m:num`; `u:real^M`; `v:real^M`]) THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\m. ((f:num->real^M->real^N) n u - f n v) - (f m u - f m v)` THEN REWRITE_TAC[eventually; TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_SIMP_TAC[SEQUENTIALLY; LIM_SUB; LIM_CONST] THEN EXISTS_TAC `N:num` THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x - y) - (u - v) = (x - u) - (y - v):real^N`] THEN ASM_MESON_TAC[GE_REFL]] THEN CONJ_TAC THENL [SUBGOAL_TAC "D" `!u. ((\n. (f':num->real^M->real^M->real^N) n x u) --> g' x u) sequentially` [REWRITE_TAC[LIM_SEQUENTIALLY; dist] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `u = vec 0:real^M` THENL [REMOVE_THEN "O" (MP_TAC o SPEC `e:real`); REMOVE_THEN "O" (MP_TAC o SPEC `e / &2 / norm(u:real^M)`)] THEN ASM_SIMP_TAC[NORM_POS_LT; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `u:real^M`]) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[GE; NORM_0; REAL_MUL_RZERO; NORM_LE_0] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC] THEN REWRITE_TAC[linear] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`]; MAP_EVERY X_GEN_TAC [`c:real`; `u:real^M`]] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THENL [EXISTS_TAC `\n. (f':num->real^M->real^M->real^N) n x (u + v) - (f' n x u + f' n x v)`; EXISTS_TAC `\n. (f':num->real^M->real^M->real^N) n x (c % u) - c % f' n x u`] THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUB; LIM_ADD; LIM_CMUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative_within; linear]) THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; LIM_CONST]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MAP_EVERY (fun s -> REMOVE_THEN s (MP_TAC o SPEC `e / &3`)) ["C"; "O"] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "C")) THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "A")) THEN REMOVE_THEN "C" (MP_TAC o GEN `y:real^M` o SPECL [`N1 + N2:num`; `x:real^M`; `y - x:real^M`]) THEN REMOVE_THEN "A" (MP_TAC o GEN `y:real^M` o SPECL [`N1 + N2:num`; `y:real^M`; `x:real^M`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`N1 + N2:num`; `x:real^M`]) THEN ASM_REWRITE_TAC[ARITH_RULE `m + n >= m:num /\ m + n >= n`] THEN REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN DISCH_THEN(MP_TAC o SPEC `e / &3` o CONJUNCT2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(LABEL_TAC "D1") THEN DISCH_THEN(LABEL_TAC "D2") THEN EXISTS_TAC `d1:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN REMOVE_THEN "D2" (MP_TAC o SPEC `y:real^M`) THEN REMOVE_THEN "D1" (MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS; NORM_SUB]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS; NORM_SUB]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `d <= a + b + c ==> a <= e / &3 * n ==> b <= e / &3 * n ==> c <= e / &3 * n ==> d <= e * n`) THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV o LAND_CONV) [NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `(norm(x + y + z) = norm(a)) /\ norm(x + y + z) <= norm(x) + norm(y + z) /\ norm(y + z) <= norm(y) + norm(z) ==> norm(a) <= norm(x) + norm(y) + norm(z)`) THEN REWRITE_TAC[NORM_TRIANGLE] THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Can choose to line up antiderivatives if we want. *) (* ------------------------------------------------------------------------- *) let HAS_ANTIDERIVATIVE_SEQUENCE = prove (`!s f:num->real^M->real^N f' g'. convex s /\ (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ (!e. &0 < e ==> ?N. !n x h. n >= N /\ x IN s ==> norm(f' n x h - g' x h) <= e * norm(h)) ==> ?g. !x. x IN s ==> (g has_derivative g'(x)) (at x within s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(s:real^M->bool) = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN MP_TAC(ISPECL [`s:real^M->bool`; `\n x. (f:num->real^M->real^N) n x + (f 0 a - f n a)`; `f':num->real^M->real^M->real^N`; `g':real^M->real^M->real^N`] HAS_DERIVATIVE_SEQUENCE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f':num->real^M->real^M->real^N) n x = \h. f' n x h + vec 0` SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN ASM_SIMP_TAC[HAS_DERIVATIVE_CONST; ETA_AX]; MAP_EVERY EXISTS_TAC [`a:real^M`; `f 0 (a:real^M) :real^N`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + b - a = b:real^N`; LIM_CONST]]);; let HAS_ANTIDERIVATIVE_LIMIT = prove (`!s g':real^M->real^M->real^N. convex s /\ (!e. &0 < e ==> ?f f'. !x. x IN s ==> (f has_derivative (f' x)) (at x within s) /\ (!h. norm(f' x h - g' x h) <= e * norm(h))) ==> ?g. !x. x IN s ==> (g has_derivative g'(x)) (at x within s)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_ANTIDERIVATIVE_SEQUENCE THEN UNDISCH_TAC `convex(s:real^M->bool)` THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':num->real^M->real^M->real^N` THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `h:real^M`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&n + &1) * norm(h:real^M)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Differentiation of a series. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_SERIES = prove (`!s f:num->real^M->real^N f' g' k. convex s /\ (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ (!e. &0 < e ==> ?N. !n x h. n >= N /\ x IN s ==> norm(vsum(k INTER (0..n)) (\i. f' i x h) - g' x h) <= e * norm(h)) /\ (?x l. x IN s /\ ((\n. f n x) sums l) k) ==> ?g. !x. x IN s ==> ((\n. f n x) sums (g x)) k /\ (g has_derivative g'(x)) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC HAS_DERIVATIVE_SEQUENCE THEN EXISTS_TAC `\n:num x:real^M h:real^M. vsum(k INTER (0..n)) (\n. f' n x h):real^N` THEN ASM_SIMP_TAC[ETA_AX; FINITE_INTER_NUMSEG; HAS_DERIVATIVE_VSUM]);; (* ------------------------------------------------------------------------- *) (* Derivative with composed bilinear function. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_BILINEAR_WITHIN = prove (`!h:real^M->real^N->real^P f g f' g' x:real^Q s. (f has_derivative f') (at x within s) /\ (g has_derivative g') (at x within s) /\ bilinear h ==> ((\x. h (f x) (g x)) has_derivative (\d. h (f x) (g' d) + h (f' d) (g x))) (at x within s)`, REPEAT STRIP_TAC THEN SUBGOAL_TAC "contg" `((g:real^Q->real^N) --> g(x)) (at x within s)` [REWRITE_TAC[GSYM CONTINUOUS_WITHIN] THEN ASM_MESON_TAC[differentiable; DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]] THEN UNDISCH_TAC `((f:real^Q->real^M) has_derivative f') (at x within s)` THEN REWRITE_TAC[has_derivative_within] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "df")) THEN SUBGOAL_TAC "contf" `((\y. (f:real^Q->real^M)(x) + f'(y - x)) --> f(x)) (at x within s)` [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN SUBGOAL_THEN `vec 0 = (f':real^Q->real^M)(x - x)` SUBST1_TAC THENL [ASM_MESON_TAC[LINEAR_0; VECTOR_SUB_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[LIM_LINEAR; LIM_SUB; LIM_CONST; LIM_WITHIN_ID]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_derivative_within]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "dg")) THEN CONJ_TAC THENL [FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [bilinear]) THEN RULE_ASSUM_TAC(REWRITE_RULE[linear]) THEN ASM_REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`at (x:real^Q) within s`; `h:real^M->real^N->real^P`] LIM_BILINEAR) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REMOVE_THEN "contg" MP_TAC THEN REMOVE_THEN "df" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REMOVE_THEN "dg" MP_TAC THEN REMOVE_THEN "contf" MP_TAC THEN ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN SUBGOAL_THEN `((\y:real^Q. inv(norm(y - x)) % (h:real^M->real^N->real^P) (f'(y - x)) (g'(y - x))) --> vec 0) (at x within s)` MP_TAC THENL [FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC (MATCH_MP LINEAR_BOUNDED_POS (ASSUME `linear (f':real^Q->real^M)`)) THEN X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC (MATCH_MP LINEAR_BOUNDED_POS (ASSUME `linear (g':real^Q->real^N)`)) THEN REWRITE_TAC[LIM_WITHIN; dist; VECTOR_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `e / (B * C * D)` THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_MUL; REAL_LT_MUL] THEN X_GEN_TAC `x':real^Q` THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; REAL_ABS_INV] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(norm(x' - x :real^Q)) * B * (C * norm(x' - x)) * (D * norm(x' - x))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE; REAL_LE_MUL2; NORM_POS_LE; REAL_LE_TRANS]; ONCE_REWRITE_TAC[AC REAL_MUL_AC `i * b * (c * x) * (d * x) = (i * x) * x * (b * c * d)`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL]]; REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN REWRITE_TAC (map (C MATCH_MP (ASSUME `bilinear(h:real^M->real^N->real^P)`)) [BILINEAR_RZERO; BILINEAR_LZERO; BILINEAR_LADD; BILINEAR_RADD; BILINEAR_LMUL; BILINEAR_RMUL; BILINEAR_LSUB; BILINEAR_RSUB]) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC]);; let HAS_DERIVATIVE_BILINEAR_AT = prove (`!h:real^M->real^N->real^P f g f' g' x:real^Q. (f has_derivative f') (at x) /\ (g has_derivative g') (at x) /\ bilinear h ==> ((\x. h (f x) (g x)) has_derivative (\d. h (f x) (g' d) + h (f' d) (g x))) (at x)`, REWRITE_TAC[has_derivative_at] THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[GSYM has_derivative_within; HAS_DERIVATIVE_BILINEAR_WITHIN]);; let BILINEAR_DIFFERENTIABLE_AT_COMPOSE = prove (`!f:real^M->real^N g:real^M->real^P h:real^N->real^P->real^Q a. f differentiable at a /\ g differentiable at a /\ bilinear h ==> (\x. h (f x) (g x)) differentiable at a`, REPEAT GEN_TAC THEN REWRITE_TAC[FRECHET_DERIVATIVE_WORKS] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_AT) THEN REWRITE_TAC[GSYM FRECHET_DERIVATIVE_WORKS; differentiable] THEN MESON_TAC[]);; let BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE = prove (`!f:real^M->real^N g:real^M->real^P h:real^N->real^P->real^Q x s. f differentiable at x within s /\ g differentiable at x within s /\ bilinear h ==> (\x. h (f x) (g x)) differentiable at x within s`, REPEAT GEN_TAC THEN REWRITE_TAC[FRECHET_DERIVATIVE_WORKS] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_WITHIN) THEN REWRITE_TAC[GSYM FRECHET_DERIVATIVE_WORKS; differentiable] THEN MESON_TAC[]);; let BILINEAR_DIFFERENTIABLE_ON_COMPOSE = prove (`!f:real^M->real^N g:real^M->real^P h:real^N->real^P->real^Q s. f differentiable_on s /\ g differentiable_on s /\ bilinear h ==> (\x. h (f x) (g x)) differentiable_on s`, REWRITE_TAC[differentiable_on] THEN MESON_TAC[BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE]);; let DIFFERENTIABLE_AT_LIFT_DOT2 = prove (`!f:real^M->real^N g x. f differentiable at x /\ g differentiable at x ==> (\x. lift(f x dot g x)) differentiable at x`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_DIFFERENTIABLE_AT_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; let DIFFERENTIABLE_WITHIN_LIFT_DOT2 = prove (`!f:real^M->real^N g x s. f differentiable (at x within s) /\ g differentiable (at x within s) ==> (\x. lift(f x dot g x)) differentiable (at x within s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; let DIFFERENTIABLE_ON_LIFT_DOT2 = prove (`!f:real^M->real^N g s. f differentiable_on s /\ g differentiable_on s ==> (\x. lift(f x dot g x)) differentiable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_DIFFERENTIABLE_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; let HAS_DERIVATIVE_MUL_WITHIN = prove (`!f f' g:real^M->real^N g' a s. ((lift o f) has_derivative (lift o f')) (at a within s) /\ (g has_derivative g') (at a within s) ==> ((\x. f x % g x) has_derivative (\h. f a % g' h + f' h % g a)) (at a within s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[BILINEAR_DROP_MUL] (ISPEC `\x y:real^M. drop x % y` HAS_DERIVATIVE_BILINEAR_WITHIN))) THEN REWRITE_TAC[o_DEF; DROP_CMUL; LIFT_DROP]);; let HAS_DERIVATIVE_MUL_AT = prove (`!f f' g:real^M->real^N g' a. ((lift o f) has_derivative (lift o f')) (at a) /\ (g has_derivative g') (at a) ==> ((\x. f x % g x) has_derivative (\h. f a % g' h + f' h % g a)) (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_DERIVATIVE_MUL_WITHIN]);; let HAS_DERIVATIVE_SQNORM_AT = prove (`!a:real^N. ((\x. lift(norm x pow 2)) has_derivative (\x. &2 % lift(a dot x))) (at a)`, GEN_TAC THEN MP_TAC(ISPECL [`\x y:real^N. lift(x dot y)`; `\x:real^N. x`; `\x:real^N. x`; `\x:real^N. x`; `\x:real^N. x`; `a:real^N`] HAS_DERIVATIVE_BILINEAR_AT) THEN REWRITE_TAC[HAS_DERIVATIVE_ID; BILINEAR_DOT; NORM_POW_2] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; DOT_SYM] THEN VECTOR_ARITH_TAC);; let DIFFERENTIABLE_MUL_WITHIN = prove (`!f g:real^M->real^N a s. (lift o f) differentiable (at a within s) /\ g differentiable (at a within s) ==> (\x. f x % g x) differentiable (at a within s)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o (f:real^M->real)`; `g:real^M->real^N`; `\x y:real^N. drop x % y`; `a:real^M`; `s:real^M->bool`] BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE) THEN REWRITE_TAC[o_DEF; LIFT_DROP; BILINEAR_DROP_MUL]);; let DIFFERENTIABLE_MUL_AT = prove (`!f g:real^M->real^N a. (lift o f) differentiable (at a) /\ g differentiable (at a) ==> (\x. f x % g x) differentiable (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[DIFFERENTIABLE_MUL_WITHIN]);; let DIFFERENTIABLE_SQNORM_AT = prove (`!a:real^N. (\x. lift(norm x pow 2)) differentiable (at a)`, REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_SQNORM_AT]);; let DIFFERENTIABLE_ON_MUL = prove (`!f g:real^M->real^N s. (lift o f) differentiable_on s /\ g differentiable_on s ==> (\x. f x % g x) differentiable_on s`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o (f:real^M->real)`; `g:real^M->real^N`; `\x y:real^N. drop x % y`; `s:real^M->bool`] BILINEAR_DIFFERENTIABLE_ON_COMPOSE) THEN REWRITE_TAC[o_DEF; LIFT_DROP; BILINEAR_DROP_MUL]);; let DIFFERENTIABLE_ON_SQNORM = prove (`!s:real^N->bool. (\x. lift(norm x pow 2)) differentiable_on s`, SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; DIFFERENTIABLE_SQNORM_AT]);; (* ------------------------------------------------------------------------- *) (* Partial derivatives and jacobians are Baire functions. *) (* ------------------------------------------------------------------------- *) let BAIRE1_PARTIAL_DERIVATIVES = prove (`!f:real^M->real^N f' s i j. (!x. x IN s ==> (f has_derivative f'(x)) (at x)) /\ open s /\ 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> baire 1 s (\x. lift(matrix(f' x)$i$j))`, REPEAT STRIP_TAC THEN ABBREV_TAC `d = \n x. (if s = UNIV then &1 else setdist({x},(:real^M) DIFF s)) / (&n + &2)` THEN SUBGOAL_THEN `!n x. x IN s ==> &0 < (d:num->real^M->real) n x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "d" THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_ARITH `&0 < &n + &2`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LT_01; SETDIST_POS_LT] THEN ASM_SIMP_TAC[SETDIST_EQ_0_SING; CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]; REWRITE_TAC[num_CONV `1`; baire]] THEN SUBGOAL_THEN `(f:real^M->real^N) continuous_on s` ASSUME_TAC THENL [ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; differentiable; DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT]; ALL_TAC] THEN EXISTS_TAC `\n:num x. inv(d n x) % lift((f(x + d n x % basis j) - (f:real^M->real^N) x)$i)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXPAND_TAC "d" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_UNIV] THEN ONCE_REWRITE_TAC[SET_RULE `x IN s <=> ~(x IN UNIV DIFF s)`] THEN DISCH_THEN(MP_TAC o SPECL [`{x:real^M}`; `x:real^M`] o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SETDIST_LE_DIST)) THEN REWRITE_TAC[IN_SING; NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; NORM_BASIS; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `abs(&n + &2) = &n + &2`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x * inv n < x * &1 ==> ~(x <= abs x / n)`) THEN REWRITE_TAC[SETDIST_POS_LE] THEN MATCH_MP_TAC REAL_LT_LMUL THEN SIMP_TAC[REAL_INV_LT_1; REAL_ARITH `&1 < &n + &2`] THEN REWRITE_TAC[SETDIST_POS_LT] THEN ASM_SIMP_TAC[SETDIST_EQ_0_SING; CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]]] THEN EXPAND_TAC "d" THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN ASM_CASES_TAC `s = (:real^M)` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF] THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[GSYM VECTOR_MUL_COMPONENT; GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[GSYM TRANSP_COMPONENT] THEN MATCH_MP_TAC LIM_COMPONENT THEN ASM_SIMP_TAC[LAMBDA_BETA; MATRIX_COMPONENT; transp; LAMBDA_ETA] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(\n. inv(d n x) % (f (x + d n x % basis j) - f x) - f' x (basis j)) = (\y. inv(norm(y - x)) % ((f:real^M->real^N) y - (f x + f' x (y - x)))) o (\n:num. x + d n x % basis j)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; VECTOR_ADD_SUB; NORM_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; NORM_BASIS] THEN SUBGOAL_THEN `!a y. (f':real^M->real^M->real^N) x (a % y) = a % f' x y` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC LINEAR_CMUL THEN ASM_MESON_TAC[has_derivative]; REWRITE_TAC[VECTOR_ARITH `x - (y + z):real^N = x - y - z`] THEN REWRITE_TAC[REAL_MUL_RID; VECTOR_SUB_LDISTRIB] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID]]; MATCH_MP_TAC LIM_COMPOSE_AT THEN EXISTS_TAC `x:real^M` THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative_at]) THEN ASM_SIMP_TAC[VECTOR_SUB_REFL] THEN REWRITE_TAC[NORM_0; REAL_INV_0; VECTOR_MUL_LZERO; EVENTUALLY_TRUE] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC LIM_NULL_VMUL THEN EXPAND_TAC "d" THEN REWRITE_TAC[LIFT_CMUL; real_div] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN REWRITE_TAC[SEQ_HARMONIC_OFFSET]]]);; let BAIRE1_DET_JACOBIAN = prove (`!f:real^N->real^N f' s. (!x. x IN s ==> (f has_derivative f'(x)) (at x)) /\ open s ==> baire 1 s (\x. lift(det(matrix(f' x))))`, REPEAT STRIP_TAC THEN REWRITE_TAC[det; LIFT_SUM; o_DEF] THEN MATCH_MP_TAC BAIRE_VSUM THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; FORALL_IN_GSPEC] THEN X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC BAIRE_CMUL THEN MATCH_MP_TAC BAIRE_PRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE1_PARTIAL_DERIVATIVES THEN EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A Frechet derivative is also a Gateaux derivative, and if the function *) (* is Lipschitz then the converse also holds. *) (* ------------------------------------------------------------------------- *) let GATEAUX_DERIVATIVE_WITHIN = prove (`!f:real^M->real^N f' s x y. (f has_derivative f') (at x within s) ==> ((\t. inv(drop t) % (f(x + drop t % y) - f(x))) --> f' y) (at (vec 0) within {t | (x + drop t % y) IN s})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `y:real^M = vec 0` THENL [DISCH_THEN(ASSUME_TAC o MATCH_MP LINEAR_0 o CONJUNCT1 o REWRITE_RULE[has_derivative]) THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_RZERO; VECTOR_ADD_RID; VECTOR_SUB_REFL; LIM_CONST]; ALL_TAC] THEN ASM_CASES_TAC `trivial_limit (at (x:real^M) within s)` THENL [DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[LIM] THEN DISJ1_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TRIVIAL_LIMIT_WITHIN]) THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o ISPEC `\r. (x:real^M) + drop r % y` o MATCH_MP(REWRITE_RULE[IMP_CONJ] LIMIT_POINT_OF_IMAGE)) THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; DROP_EQ] THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_VMUL THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_WITHIN_ID]; REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LIMPT_SUBSET) THEN SET_TAC[]]; ALL_TAC] THEN ASM_SIMP_TAC[has_derivative; NETLIMIT_WITHIN] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_0) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL) THEN ASM_CASES_TAC `y:real^M = vec 0` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; VECTOR_SUB_REFL; LIM_CONST] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN SUBGOAL_THEN `(\t. x + drop t % (y:real^M)) continuous (at (vec 0) within {t | (x + drop t % y:real^M) IN s})` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_WITHIN_ID]; REWRITE_TAC[CONTINUOUS_WITHIN; DROP_VEC; VECTOR_MUL_LZERO] THEN REWRITE_TAC[VECTOR_ADD_RID; IMP_IMP]] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> p /\ r ==> q ==> s`] LIM_COMPOSE_WITHIN)) THEN ASM_REWRITE_TAC[o_DEF; VECTOR_EQ_ADDR; VECTOR_MUL_EQ_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN SIMP_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; VECTOR_ADD_SUB; IN_ELIM_THM] THEN ANTS_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN ASM_REWRITE_TAC[NORM_MUL; REAL_INV_MUL; VECTOR_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `norm(y:real^M)` o MATCH_MP LIM_CMUL) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM REAL_MUL_ASSOC; VECTOR_MUL_RZERO] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD `~(y = &0) ==> y * x * inv y = x`] THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_WITHIN; DIST_0; NORM_POS_LT; IN_ELIM_THM] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; FORALL_LIFT; LIFT_DROP] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_ABS] THEN REWRITE_TAC[GSYM REAL_ABS_INV; GSYM NORM_MUL] THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN MATCH_MP_TAC(VECTOR_ARITH `a % y:real^N = z ==> c - a % (x + y) = c - a % x - z`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]);; let GATEAUX_DERIVATIVE = prove (`!f:real^M->real^N f' x y. (f has_derivative f') (at x) ==> ((\t. inv(drop t) % (f(x + drop t % y) - f(x))) --> f' y) (at (vec 0))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN DISCH_THEN (MP_TAC o SPEC `y:real^M` o MATCH_MP GATEAUX_DERIVATIVE_WITHIN) THEN REWRITE_TAC[IN_UNIV; UNIV_GSPEC]);; let GATEAUX_DERIVATIVE_LIPSCHITZ = prove (`!f:real^M->real^N f' x s. x IN s /\ open s /\ (?B. !u v. u IN s /\ v IN s ==> norm(f u - f v) <= B * norm(u - v)) /\ linear f' /\ (!y. ((\t. inv(drop t) % (f(x + drop t % y) - f(x))) --> f' y) (at (vec 0))) ==> (f has_derivative f') (at x)`, REWRITE_TAC[LIPSCHITZ_ON_POS] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[has_derivative_at; LIM_AT; DIST_0] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `sphere(vec 0:real^M,&1)` COMPACT_IMP_TOTALLY_BOUNDED) THEN REWRITE_TAC[COMPACT_SPHERE] THEN DISCH_THEN(MP_TAC o SPEC `e / (B + D + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; LEFT_IMP_EXISTS_THM; REAL_ARITH `&0 < B /\ &0 < D ==> &0 < B + D + &1`] THEN X_GEN_TAC `k:real^M->bool` THEN ASM_CASES_TAC `k:real^M->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; SUBSET_EMPTY; SPHERE_EQ_EMPTY] THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [LIM_AT]) THEN REWRITE_TAC[DIST_0] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / (B + D + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; LEFT_IMP_EXISTS_THM; REAL_ARITH `&0 < B /\ &0 < D ==> &0 < B + D + &1`] THEN ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `d:real^M->real` THEN STRIP_TAC THEN EXISTS_TAC `min r (inf (IMAGE (d:real^M->real) k))` THEN REWRITE_TAC[REAL_LT_MIN] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; dist; NORM_POS_LT; VECTOR_SUB_EQ] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN REWRITE_TAC[SUBSET; IN_SPHERE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `inv(norm(y - x)) % (y - x):real^M`) THEN REWRITE_TAC[DIST_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M` STRIP_ASSUME_TAC) THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN TRANS_TAC REAL_LTE_TRANS `(B + D + &1) * e / (B + D + &1) * norm(y - x:real^M)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M`; `lift(norm(y - x:real^M))`]) THEN ASM_SIMP_TAC[NORM_LIFT; REAL_ABS_NORM] THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; LIFT_DROP] THEN SUBGOAL_THEN `f' u = inv(norm(y - x:real^M)) % norm(y - x) % (f':real^M->real^N) u` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ; VECTOR_MUL_LID]; REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL]] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM; GSYM DROP_EQ; DROP_VEC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `y - x <= B * e + D * e ==> x < e ==> y < (B + D + &1) * e`) THEN MATCH_MP_TAC(NORM_ARITH `norm(y - z:real^M) <= a /\ norm(d - e) <= b ==> norm(y - (x + d)) - norm(z - x - e) <= a + b`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN ANTS_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_SPHERE_0]) THEN ASM_SIMP_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist; REAL_ABS_NORM; REAL_LT_IMP_LE; VECTOR_ADD_SUB; NORM_MUL; REAL_MUL_RID]; ALL_TAC]; ASM_SIMP_TAC[GSYM LINEAR_CMUL; GSYM LINEAR_SUB] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd))] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM REAL_ABS_INV; GSYM NORM_MUL] THEN REWRITE_TAC[NORM_NEG; VECTOR_ARITH `a % (y - (x + b % u)):real^M = --((a * b) % u - a % (y - x)) /\ a % (y - x - b % u):real^M = --((a * b) % u - a % (y - x))`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ] THEN ONCE_REWRITE_TAC[GSYM dist] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[VECTOR_MUL_LID; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Strong form of the inverse function theorem not assuming continuity of *) (* the derivative. This proof closely follows Jean Saint Raymond's paper *) (* "Local Inversion for Differentiable Functions and the Darboux Property". *) (* ------------------------------------------------------------------------- *) let INVERSE_FUNCTION_THEOREM = prove (`!f:real^N->real^N f' a s. open s /\ a IN s /\ (!x. x IN s ==> (f has_derivative f' x) (at x) /\ ~(det(matrix (f' x)) = &0)) ==> ?t u g g'. open t /\ a IN t /\ t SUBSET s /\ open u /\ f a IN u /\ homeomorphism (t,u) (f,g) /\ (!x. x IN t ==> (f has_derivative f' x) (at x) /\ f'(x) o g'(f x) = I /\ g'(f x) o f'(x) = I) /\ (!y. y IN u ==> (g has_derivative g' y) (at y) /\ f'(g y) o g' y = I /\ g' y o f'(g y) = I)`, REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. x IN s ==> ?g. linear g /\ (f':real^N->real^N->real^N) x o g = I /\ g o f' x = I` MP_TAC THENL [REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) MATRIX_INVERTIBLE o snd) THEN REWRITE_TAC[INVERTIBLE_DET_NZ] THEN ASM_MESON_TAC[has_derivative]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN X_GEN_TAC `g':real^N->real^N->real^N` THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?u. open u /\ a IN u /\ (!x y. x IN u /\ y IN u /\ (f:real^N->real^N) x = f y ==> x = y)` MP_TAC THENL [UNDISCH_TAC `(a:real^N) IN s` THEN SPEC_TAC(`a:real^N`,`x:real^N`); DISCH_THEN(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP (MESON[INTER_SUBSET] `(?t. P t) ==> !s. (!t. P t ==> P(s INTER t)) ==> ?t. t SUBSET s /\ P t`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_INTER; IN_INTER]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (f:real^N->real^N) t` THEN EXISTS_TAC `(g':real^N->real^N->real^N) o (g:real^N->real^N)` THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; SUBSET; HOMEOMORPHISM] THEN ASM_SIMP_TAC[FUN_IN_IMAGE; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUBSET_INTERIOR_EQ] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `(f':real^N->real^N->real^N) x`; `(g':real^N->real^N->real^N) x`; `s:real^N->bool`; `x:real^N`] SUSSMANN_OPEN_MAPPING) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT] THEN ASM_MESON_TAC[differentiable]; DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SUBSET; INTERIOR_OPEN]]; DISCH_TAC THEN MATCH_MP_TAC(TAUT `(p /\ (r ==> q)) /\ r ==> p /\ q /\ r`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN MAP_EVERY EXISTS_TAC [`(f':real^N->real^N->real^N) x`; `t:real^N->bool`] THEN ASM_SIMP_TAC[]] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[differentiable]]] THEN SUBGOAL_THEN `(f:real^N->real^N) continuous_on s` ASSUME_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT] THEN ASM_MESON_TAC[differentiable]; ALL_TAC] THEN SUBGOAL_THEN `!u v. bounded u /\ open u /\ closure u SUBSET s /\ open v /\ connected v /\ ~(v INTER IMAGE f u = {}) /\ v INTER IMAGE f (frontier u) = {} ==> v SUBSET IMAGE (f:real^N->real^N) u` (LABEL_TAC "L3") THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`v:real^N->bool`; `IMAGE (f:real^N->real^N) u`] CONNECTED_INTER_FRONTIER) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `v INTER s = {} ==> t SUBSET s ==> v INTER t = {}`)) THEN MATCH_MP_TAC FRONTIER_OPEN_MAP_IMAGE_SUBSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_OPEN_MAP THEN ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!e a b. &0 < e /\ a IN s /\ norm((f:real^N->real^N) a - b) <= e ==> ?h l t0 c. a IN closure c /\ (g':real^N->real^N->real^N) a (f a - b) = h /\ c IN components {x | x IN s /\ f x IN ball(b,e)} /\ &0 < l /\ &0 < t0 /\ !u t. norm(u - h) <= l /\ &0 < t /\ t < t0 ==> (a - t % u) IN c` (LABEL_TAC "L7") THENL [X_GEN_TAC `e0:real` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(!a b c d. Q a b c d ==> P a b c d) /\ (?a b c d. Q a b c d) ==> ?a b c d. P a b c d /\ Q a b c d`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`h:real^N`; `l:real`; `t0:real`; `c:real^N->bool`] THEN STRIP_TAC THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN EXISTS_TAC `a - (min (t0 / &2) (t / (norm h + &1))) % h:real^N` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF; REAL_MIN_LT] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_ARITH `&0 < norm(h:real^N) + &1`] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[NORM_ARITH `dist(a - x:real^N,a) = norm x`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < x ==> abs x = x`; REAL_LT_MIN; REAL_HALF; REAL_LT_DIV; NORM_ARITH `&0 < norm(h:real^N) + &1`] THEN TRANS_TAC REAL_LET_TRANS `(t / (norm h + &1)) * norm(h:real^N)` THEN ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; REAL_ARITH `min a b <= b`] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_ARITH `&0 < norm(h:real^N) + &1`; REAL_ARITH `x / y * z < t <=> (x * z) / y < t`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN REAL_ARITH_TAC]; ALL_TAC] THEN ASM_CASES_TAC `(f:real^N->real^N) a = b` THENL [ABBREV_TAC `c = connected_component {x | x IN s /\ (f:real^N->real^N) x IN ball(b,e0)} a` THEN SUBGOAL_THEN `open {z | z IN UNIV /\ (a - drop(fstcart z) % sndcart z:real^N) IN c}` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; OPEN_UNIV; LINEAR_FSTCART; LINEAR_SNDCART; ETA_AX] THEN EXPAND_TAC "c" THEN MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]; REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART]] THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `vec 0:real^N`]) THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN ANTS_TAC THENL [REWRITE_TAC[IN] THEN EXPAND_TAC "c" THEN MATCH_MP_TAC CONNECTED_COMPONENT_REFL THEN ASM_REWRITE_TAC[IN_ELIM_THM; CENTRE_IN_BALL]; REWRITE_TAC[PASTECART_VEC; DIST_0; FORALL_LIFT; LIFT_DROP]] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `d / &2`; `d / &2`; `c:real^N->bool`] THEN ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[VECTOR_SUB_REFL] THEN ASM_MESON_TAC[LINEAR_0]; EXPAND_TAC "c" THEN REWRITE_TAC[CONNECTED_COMPONENT_IN_COMPONENTS] THEN ASM_REWRITE_TAC[IN_ELIM_THM; CENTRE_IN_BALL]; MAP_EVERY X_GEN_TAC [`z:real^N`; `t:real`] THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN REWRITE_TAC[NORM_LIFT] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN ABBREV_TAC `e = norm((f:real^N->real^N) a - b)` THEN SUBGOAL_THEN `?h l t0 c. c IN components {x | x IN s /\ (f:real^N->real^N) x IN ball(b,e)} /\ (g':real^N->real^N->real^N) a (f a - b) = h /\ &0 < l /\ &0 < t0 /\ !u t. norm(u - h) <= l /\ &0 < t /\ t < t0 ==> (a - t % u) IN c` MP_TAC THENL [ALL_TAC; REPLICATE_TAC 3 (MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`{x | x IN s /\ (f:real^N->real^N) x IN ball(b,e0)}`; `c:real^N->bool`] EXISTS_COMPONENT_SUPERSET) THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]] THEN MATCH_MP_TAC(SET_RULE `~(c = {}) /\ c SUBSET s ==> c SUBSET s /\ ~(s = {})`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN MP_TAC(ISPECL [`b:real^N`; `e:real`; `e0:real`] SUBSET_BALL) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]] THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [EXPAND_TAC "e" THEN REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ABBREV_TAC `h = (g':real^N->real^N->real^N) a (f a - b)` THEN SUBGOAL_THEN `(f':real^N->real^N->real^N) a h = f a - b` ASSUME_TAC THENL [EXPAND_TAC "h" THEN RULE_ASSUM_TAC(REWRITE_RULE[o_THM; I_THM; FUN_EQ_THM]) THEN ASM SET_TAC[]; UNDISCH_THEN `(g':real^N->real^N->real^N) a (f a - b) = h` (K ALL_TAC) THEN EXISTS_TAC `h:real^N` THEN ASM_REWRITE_TAC[]] THEN ABBREV_TAC `p = \z. lift(norm((f:real^N->real^N) z - b) pow 2)` THEN ABBREV_TAC `p' = \z h. &2 % lift((f z - b) dot (f':real^N->real^N->real^N) z h)` THEN SUBGOAL_THEN `!z. z IN s ==> ((p:real^N->real^1) has_derivative p'(z)) (at z)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "p'" THEN REWRITE_TAC[] THEN MP_TAC(ISPECL [`\x. (f:real^N->real^N) x - b`; `\x:real^N. lift (norm x pow 2)`; `\h. (f':real^N->real^N->real^N) z h - vec 0`; `\x:real^N. &2 % lift((f(z:real^N) - b) dot x)`; `z:real^N`] DIFF_CHAIN_AT) THEN ASM_REWRITE_TAC[o_DEF; HAS_DERIVATIVE_SQNORM_AT] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[VECTOR_SUB_RZERO]] THEN MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN ASM_SIMP_TAC[HAS_DERIVATIVE_CONST; ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `open {z | z IN UNIV /\ (a - drop(fstcart z) % (h + sndcart z):real^N) IN s}` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_UNIV] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; OPEN_UNIV; CONTINUOUS_ON_ADD; LINEAR_FSTCART; LINEAR_SNDCART; ETA_AX]; REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART]] THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `vec 0:real^N`]) THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO; DROP_VEC] THEN REWRITE_TAC[PASTECART_VEC; DIST_0; FORALL_LIFT; LIFT_DROP] THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?l. &0 < l /\ !h'. norm(h' - h) <= l ==> e pow 2 <= drop((p':real^N->real^N->real^1) a h')` MP_TAC THENL [SUBGOAL_THEN `(p':real^N->real^N->real^1) a continuous_on UNIV` MP_TAC THENL [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN ASM_MESON_TAC[has_derivative]; ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N`) THEN REWRITE_TAC[continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `(e:real) pow 2`) THEN ASM_SIMP_TAC[REAL_POW_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `h':real^N` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `h':real^N`) THEN REWRITE_TAC[dist] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `h = &2 * e ==> abs(h' - h) < e ==> e <= h'`) THEN EXPAND_TAC "p'" THEN REWRITE_TAC[DROP_CMUL] THEN ASM_REWRITE_TAC[GSYM NORM_POW_2; LIFT_DROP]; DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min l (m / &2)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF]] THEN SUBGOAL_THEN `((p:real^N->real^1) has_derivative p' a) (at a)` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[HAS_DERIVATIVE_AT_ALT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e pow 2 / &2 / (norm(h:real^N) + l)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_HALF; NORM_ARITH `&0 < l ==> &0 < norm(h:real^N) + l`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN EXISTS_TAC `min (d / (norm(h:real^N) + l)) (m / &2)` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MIN; REAL_HALF; NORM_ARITH `&0 < l ==> &0 < norm(h:real^N) + l`] THEN REWRITE_TAC[SET_RULE `(!u t. P u t ==> f t u IN c) <=> {f t u | P u t} SUBSET c`] THEN MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN REWRITE_TAC[GSYM REAL_LT_MIN] THEN SUBGOAL_THEN `!x y. {a - t % u:real^N | norm(u - h) <= x /\ &0 < t /\ t < y} = IMAGE (\z. a - drop(fstcart z) % sndcart z) (interval(vec 0,lift y) PCROSS cball(h,x))` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[EXISTS_LIFT; IN_INTERVAL_1; IN_CBALL; LIFT_DROP] THEN REWRITE_TAC[DROP_VEC; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN SIMP_TAC[CONNECTED_PCROSS_EQ; CONNECTED_INTERVAL; CONNECTED_CBALL] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; OPEN_UNIV; LINEAR_FSTCART; LINEAR_SNDCART; ETA_AX]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET t ==> s SUBSET t /\ ~(t = {})`) THEN REWRITE_TAC[IMAGE_EQ_EMPTY; PCROSS_EQ_EMPTY; CBALL_EQ_EMPTY; INTERVAL_EQ_EMPTY_1] THEN REWRITE_TAC[DE_MORGAN_THM; DROP_VEC; REAL_NOT_LT; REAL_NOT_LE; REAL_LE_MIN] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; LIFT_DROP; REAL_HALF; REAL_LT_MIN] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_ARITH `&0 < l ==> &0 < norm(h:real^N) + l`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP; DROP_VEC; IN_CBALL] THEN MAP_EVERY X_GEN_TAC [`t:real`; `u:real^N`] THEN REWRITE_TAC[dist; IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL [SUBST1_TAC(VECTOR_ARITH `u:real^N = h + (u - h)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN REWRITE_TAC[NORM_LIFT] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_BALL]] THEN ASM_REWRITE_TAC[dist; NORM_LT_SQUARE; GSYM NORM_POW_2] THEN TRANS_TAC REAL_LET_TRANS `drop(p(a - t % u:real^N))` THEN CONJ_TAC THENL [EXPAND_TAC "p" THEN REWRITE_TAC[LIFT_DROP; NORM_SUB; REAL_LE_REFL]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `a - t % u:real^N`) THEN REWRITE_TAC[VECTOR_ARITH `a - t - a:real^N = --t`; NORM_NEG] THEN ANTS_TAC THENL [TRANS_TAC REAL_LET_TRANS `t * (norm(h:real^N) + l)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[NORM_MUL; REAL_LE_LMUL_EQ; REAL_ARITH `&0 < x ==> abs x = x`] THEN MATCH_MP_TAC(NORM_ARITH `norm(y - x:real^N) <= l ==> norm(x) <= norm(y) + l`) THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_ARITH `&0 < l ==> &0 < norm(h:real^N) + l`] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[NORM_1; DROP_SUB]] THEN ASM_SIMP_TAC[LINEAR_NEG; DROP_NEG] THEN MATCH_MP_TAC(REAL_ARITH `p + x < y + d ==> abs(q - p - --d) <= x ==> q < y`) THEN EXPAND_TAC "p" THEN REWRITE_TAC[LIFT_DROP] THEN ASM_REWRITE_TAC[REAL_LT_LADD] THEN ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL; DROP_CMUL] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `&0 < t ==> (a * abs t * u < x <=> t * a * u < x)`] THEN TRANS_TAC REAL_LTE_TRANS `(e:real) pow 2` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `a / &2 / b * x < a <=> a * x / b < a * &2`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_POW_LT; REAL_LT_LDIV_EQ; NORM_ARITH `&0 < l ==> &0 < norm(h:real^N) + l`] THEN UNDISCH_TAC `norm(h - u:real^N) <= min l (m / &2)` THEN UNDISCH_TAC `&0 < l` THEN CONV_TAC NORM_ARITH; FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN s ==> ?r d. &0 < r /\ &0 < d /\ cball(x,r) SUBSET s /\ !y. y IN cball(x,r) ==> d * norm(y - x) <= norm(f y - (f:real^N->real^N) x)` (LABEL_TAC "L2") THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `((f:real^N->real^N) has_derivative f'(x)) (at x)` MP_TAC THENL [ASM_SIMP_TAC[]; REWRITE_TAC[HAS_DERIVATIVE_AT_ALT]] THEN STRIP_TAC THEN MP_TAC(ISPEC `(g':real^N->real^N->real^N) x` LINEAR_BOUNDED_POS) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1 / (&2 * B)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `e0:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e1:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`min (e0 / &2) e1:real`; `&1 / (&4 * B)`] THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_ARITH `&0 < &2 /\ &0 < &4`; REAL_LT_MUL; REAL_LT_01; CBALL_MIN_INTER; IN_INTER] THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `y:real^N`] THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (NORM_ARITH `norm(x - y:real^N) <= e / &2 ==> &0 < e ==> norm(y - x) < e`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN MATCH_MP_TAC(NORM_ARITH `a + d <= norm f' ==> norm(fy - fx - f') <= d ==> a <= norm(fy - fx:real^N)`) THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH rand th o rand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < B ==> B * (&1 / (&4 * B) * x + &1 / (&2 * B) * x) = &3 / &4 * x`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!x e. &0 < e /\ x IN s ==> ?d. &0 < d /\ !b. ~((f:real^N->real^N) x = b) ==> ball(x,d) INTER {z | z IN s /\ f z = b} SUBSET ball(x + (g':real^N->real^N->real^N)(x) (b - f x), e * norm(b - f x))` (LABEL_TAC "L5") THENL [REPEAT STRIP_TAC THEN REMOVE_THEN "L2" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:real`; `d:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `linear((g':real^N->real^N->real^N) x)` MP_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS)] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(f has_derivative (f':real^N->real^N->real^N) x) (at x)` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[HAS_DERIVATIVE_AT_ALT]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `d * e / &2 / B:real`)) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `r1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN EXISTS_TAC `min p (min r1 (d * r1)):real` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; IN_ELIM_THM; REAL_LT_MIN] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN TRANS_TAC REAL_LET_TRANS `norm((g':real^N->real^N->real^N) x (b - f x - f' x (z - x)))` THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN ASM_SIMP_TAC[LINEAR_SUB] THEN AP_TERM_TAC THEN CONV_TAC VECTOR_ARITH; REMOVE_THEN "*" (MP_TAC o SPEC `z:real^N`)] THEN ANTS_TAC THENL [ASM_MESON_TAC[NORM_SUB]; ASM_REWRITE_TAC[]] THEN ABBREV_TAC `eta = b - (f:real^N->real^N) x - f' x (z - x)` THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `B * norm(eta:real^N)` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x * e /\ y <= x * e / &2 ==> y < x * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `s <= (d * e / &2 / B) * n ==> e / &2 / B * d * n <= e / &2 / B * n' ==> s <= (n' * e / &2) / B`)) THEN ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ; REAL_LT_INV_EQ; REAL_ARITH `&0 < &2`] THEN EXPAND_TAC "b" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN USE_THEN "L2" (MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`r:real`; `d:real`] THEN STRIP_TAC THEN ABBREV_TAC `w = (f:real^N->real^N) x` THEN SUBGOAL_THEN `!z. norm(z - x) = r ==> d * r <= norm((f:real^N->real^N) z - w)` ASSUME_TAC THENL [X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (rand o rand) th o rand o snd)) THEN ASM_REWRITE_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_REWRITE_TAC[REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?r'. &0 < r' /\ r' < r /\ IMAGE (f:real^N->real^N) (cball(x,r')) SUBSET ball(w,(d * r) / &3)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `{y | y IN s /\ (f:real^N->real^N) y IN ball(w,(d * r) / &3)}` OPEN_CONTAINS_CBALL) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]; DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; CENTRE_IN_BALL] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_ARITH `&0 < &3`] THEN DISCH_THEN(X_CHOOSE_THEN `r':real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min r' (r / &2)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF; CBALL_MIN_INTER] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM SET_TAC[]]]; ALL_TAC] THEN EXISTS_TAC `ball(x:real^N,r')` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MAP_EVERY X_GEN_TAC [`z1:real^N`; `z2:real^N`] THEN STRIP_TAC THEN ABBREV_TAC `b = (f:real^N->real^N) z2` THEN ASM_CASES_TAC `z1:real^N = z2` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `cball(x:real^N,r') SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; SUBSET_CBALL; REAL_LT_IMP_LE]; ALL_TAC] THEN ABBREV_TAC `e = inf { sup { norm((f:real^N->real^N) z - b) | z IN k} | compact k /\ connected k /\ z1 IN k /\ z2 IN k /\ k SUBSET cball(x,r)}` THEN MP_TAC(SPEC `{sup { norm((f:real^N->real^N) z - b) | z IN k} | compact k /\ connected k /\ z1 IN k /\ z2 IN k /\ k SUBSET cball(x,r)}` INF) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `~({f x | P x} = {}) <=> ?x. P x`] THEN EXISTS_TAC `cball(x:real^N,r')` THEN REWRITE_TAC[SUBSET_REFL; COMPACT_CBALL; CONNECTED_CBALL] THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_CBALL; REAL_LT_IMP_LE; SUBSET]; EXISTS_TAC `&0` THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_SUP THEN REWRITE_TAC[EXISTS_IN_GSPEC; FORALL_IN_GSPEC; NORM_POS_LE] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^N`; `k:real^N->bool`] COMPACT_CONTINUOUS_IMAGE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `B + norm(b:real^N)` THEN ASM_SIMP_TAC[NORM_ARITH `norm(x:real^N) <= B ==> norm(x - b) <= B + norm b`]]; FIRST_X_ASSUM(K ALL_TAC o check ((=) `e:real` o rand o concl)) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "I1") (LABEL_TAC "I2"))] THEN SUBGOAL_THEN `?k. compact k /\ connected k /\ z1 IN k /\ z2 IN k /\ k SUBSET cball(x,r) /\ sup { norm((f:real^N->real^N) z - b) | z IN k} = e` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[MESON[] `(?k. P k) <=> ~(!k. ~P k)`] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_NOT_LE] THEN REMOVE_THEN "I2" (MP_TAC o GEN `n:num` o SPEC `e + inv(&n + &1)`) THEN REWRITE_TAC[REAL_ARITH `e + i <= e <=> ~(&0 < i)`] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NOT_FORALL_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:num->real^N->bool` THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM; REAL_NOT_LE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`k:num->real^N->bool`; `cball(x:real^N,r)`] COMPACT_HAUSDIST) THEN ASM_REWRITE_TAC[COMPACT_CBALL] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[NOT_FORALL_THM]] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_HAUSDIST_LIMIT THEN EXISTS_TAC `(k:num->real^N->bool) o (q:num->num)` THEN ASM_SIMP_TAC[o_THM; COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `a IN s /\ b IN s <=> {a,b} SUBSET s`] THEN MATCH_MP_TAC SUBSET_COMPACT_HAUSDIST_LIMIT THEN EXISTS_TAC `(k:num->real^N->bool) o (q:num->num)` THEN ASM_SIMP_TAC[o_THM; COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]; REWRITE_TAC[REAL_ARITH `~(x < y) <=> y - x <= &0`] THEN ONCE_REWRITE_TAC[REAL_LE_TRANS_LTE] THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN SUBGOAL_THEN `(f:real^N->real^N) uniformly_continuous_on cball (x,r)` MP_TAC THENL [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN REWRITE_TAC[COMPACT_CBALL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[HAUSDIST_UNIFORMLY_CONTINUOUS_ON]] THEN DISCH_THEN(MP_TAC o SPEC `a / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `de:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `eventually (\n. inv(&n + &1) < a / &2 /\ dist(lift(hausdist ((k:num->real^N->bool) (q n),c)),vec 0) < de) sequentially` MP_TAC THENL [ASM_REWRITE_TAC[EVENTUALLY_AND; ARCH_EVENTUALLY_INV1; REAL_HALF] THEN UNDISCH_TAC `&0 < de` THEN SPEC_TAC(`de:real`,`e:real`) THEN ASM_REWRITE_TAC[GSYM tendsto]; REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[DIST_0; NORM_LIFT; REAL_ABS_HAUSDIST; LE_REFL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^N->bool`; `(k:num->real^N->bool)(q(n:num))`]) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN SUBGOAL_THEN `sup {norm((f:real^N->real^N) z - b) | z IN k((q:num->num)n)} < e + a / &2` MP_TAC THENL [TRANS_TAC REAL_LTE_TRANS `e + inv(&(q(n:num)) + &1)` THEN ASM_REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> y <= x ==> y <= a`)) THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_ARITH `&0 < &n + &1`; REAL_LE_RADD] THEN ASM_MESON_TAC[MONOTONE_BIGGER; REAL_OF_NUM_LE]; MATCH_MP_TAC(REAL_ARITH `abs(x - y) <= h ==> x < e + a / &2 ==> h < a / &2 ==> y <= a + e`)] THEN ONCE_REWRITE_TAC[REAL_LE_TRANS_LTE] THEN X_GEN_TAC `h:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `abs(x - y) <= e <=> x <= y + e /\ y <= x + e`] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `x1:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_SUP THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN ONCE_REWRITE_TAC[SET_RULE `(!z. z IN c ==> norm(f z - b:real^N) <= B) <=> (!z. z IN IMAGE (\x. x - b) (IMAGE f c) ==> norm z <= B)`] THEN REWRITE_TAC[GSYM bounded] THEN REWRITE_TAC[VECTOR_ARITH `x - b:real^N = --b + x`] THEN REWRITE_TAC[BOUNDED_TRANSLATION_EQ] THEN (CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`]; ASM_MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET; SUBSET_TRANS]]) THEN MATCH_MP_TAC(MESON[NORM_ARITH `dist(x:real^N,y) < a ==> norm(b + x) - norm(b + y) <= a`] `(?z. z IN c /\ dist(x:real^N,f z) < a) ==> ?z. z IN c /\ norm(b + x) - norm(b + f z) <= a`) THEN ONCE_REWRITE_TAC[SET_RULE `(?z. z IN c /\ dist(x:real^N,f z) < a) <=> (?z. z IN IMAGE f c /\ dist(x,z) < a)`] THEN MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THENL [EXISTS_TAC `IMAGE (f:real^N->real^N) (k((q:num->num) n))`; EXISTS_TAC `IMAGE (f:real^N->real^N) c` THEN ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN ASM_SIMP_TAC[FUN_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REPEAT CONJ_TAC THEN (MATCH_MP_TAC COMPACT_IMP_BOUNDED ORELSE ASM SET_TAC[]) THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]]; ALL_TAC] THEN SUBGOAL_THEN `~(k:real^N->bool = {})` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `{norm((f:real^N->real^N) z - b) | z IN k}` SUP) THEN ASM_REWRITE_TAC[NOT_IMP; EXISTS_IN_GSPEC; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[SET_RULE `(!z. z IN c ==> norm(f z - b:real^N) <= B) <=> (!z. z IN IMAGE (\x. x - b) (IMAGE f c) ==> norm z <= B)`] THEN REWRITE_TAC[GSYM bounded] THEN REWRITE_TAC[VECTOR_ARITH `x - b:real^N = --b + x`] THEN REWRITE_TAC[BOUNDED_TRANSLATION_EQ] THEN ASM_MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "S1") (LABEL_TAC "S2"))] THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [SUBGOAL_THEN `~(IMAGE (f:real^N->real^N) k SUBSET {b})` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `IMAGE f k SUBSET {b} ==> k SUBSET {x | x IN k /\ f x = b}`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[NOT_IMP; GSYM INFINITE] THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_FINITE_PREIMAGES THEN EXISTS_TAC `f':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_AT_WITHIN THEN ASM SET_TAC[]; ASM_SIMP_TAC[CONNECTED_INFINITE_IFF_CARD_EQ; CONNECTED_CARD_EQ_IFF_NONTRIVIAL] THEN ASM SET_TAC[]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_SING] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN TRANS_TAC REAL_LTE_TRANS `norm((f:real^N->real^N) z - b)` THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ]]; ALL_TAC] THEN SUBGOAL_THEN `e <= &2 / &3 * d * r` ASSUME_TAC THENL [REMOVE_THEN "I1" (MP_TAC o SPEC `cball(x:real^N,r')`) THEN ASM_SIMP_TAC[COMPACT_CBALL; CONNECTED_CBALL; SUBSET_CBALL; REAL_LT_IMP_LE; REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_SUP_LE THEN ASM_REWRITE_TAC[SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN EXPAND_TAC "b" THEN MATCH_MP_TAC(NORM_ARITH `!a. norm(a - x) < dr / &3 /\ norm(a - y) < dr / &3 ==> norm(x - y:real^N) <= &2 / &3 * dr`) THEN EXISTS_TAC `w:real^N` THEN REWRITE_TAC[GSYM dist; GSYM IN_BALL] THEN MP_TAC(ISPECL [`x:real^N`; `r':real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!c. connected c /\ ~(c INTER ball(x,r) = {}) /\ (!z. z IN c ==> norm((f:real^N->real^N) z - b) <= e) ==> c SUBSET ball(x,r)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`c:real^N->bool`; `ball(x:real^N,r)`] CONNECTED_INTER_FRONTIER) THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_SIMP_TAC[FRONTIER_BALL; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_SPHERE; dist] THEN X_GEN_TAC `z:real^N` THEN ONCE_REWRITE_TAC[NORM_SUB] THEN STRIP_TAC THEN SUBGOAL_THEN `d * r <= norm((f:real^N->real^N) z - w)` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[REAL_NOT_LE]] THEN MATCH_MP_TAC(NORM_ARITH `!fz1. e <= &2 / &3 * dr /\ norm(fz - fz1) <= e /\ dist(fx,fz1) < dr / &3 ==> norm(fz - fx:real^N) < dr`) THEN EXISTS_TAC `(f:real^N->real^N) z1` THEN ASM_SIMP_TAC[GSYM IN_BALL] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN SUBST1_TAC(SYM(ASSUME `(f:real^N->real^N) z1 = b`)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL]; ALL_TAC] THEN SUBGOAL_THEN `k SUBSET ball(x:real^N,r)` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `z1:real^N` THEN ASM_REWRITE_TAC[IN_INTER] THEN ASM_MESON_TAC[SUBSET; SUBSET_BALL; REAL_LT_IMP_LE]; ALL_TAC] THEN ABBREV_TAC `U = {c | c IN components {x | x IN s /\ (f:real^N->real^N) x IN ball(b,e)} /\ ~(c INTER ball(x,r) = {})}` THEN SUBGOAL_THEN `!u. u IN U ==> u SUBSET ball(x:real^N,r)` ASSUME_TAC THENL [EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); GSYM IN_CBALL] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!u z. u IN U /\ z IN frontier u ==> (f:real^N->real^N) z IN sphere(b,e)` ASSUME_TAC THENL [EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `closure(u:real^N->bool) SUBSET s` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,r))` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[CLOSURE_BALL]] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM CBALL_DIFF_BALL; IN_DIFF] THEN CONJ_TAC THENL [SUBGOAL_THEN `(z:real^N) IN closure u` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `IMAGE f s SUBSET t ==> z IN s ==> f z IN t`) THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REWRITE_TAC[CLOSED_CBALL] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN MP_TAC(ISPECL [`b:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN SET_TAC[]]; SUBGOAL_THEN `(z:real^N) IN s` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(z:real^N) IN closure u` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[]] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `(z:real^N) IN frontier u` THEN REWRITE_TAC[frontier] THEN SUBGOAL_THEN `z IN UNIONS(components {x | x IN s /\ (f:real^N->real^N) x IN ball (b,e)})` MP_TAC THENL [REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `u':real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `open(u:real^N->bool) /\ open(u':real^N->bool)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)) THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]; ALL_TAC] THEN ASM_CASES_TAC `u:real^N->bool = u'` THEN ASM_SIMP_TAC[INTERIOR_OPEN; IN_DIFF] THEN MP_TAC(ISPECL [`u:real^N->bool`; `u':real^N->bool`] SEPARATION_OPEN_IN_UNION) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_UNION; SUBSET_UNION] THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[DISJOINT] THEN ASM_MESON_TAC[COMPONENTS_NONOVERLAP]]; ALL_TAC] THEN SUBGOAL_THEN `!u. u IN U ==> ~(u INTER {x | x IN s /\ (f:real^N->real^N) x = b} = {})` ASSUME_TAC THENL [EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SUBGOAL_THEN `u SUBSET ball(x:real^N,r)` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `closure(u:real^N->bool) SUBSET s` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,r))` THEN ASM_SIMP_TAC[SUBSET_CLOSURE] THEN ASM_SIMP_TAC[CLOSURE_BALL]; ALL_TAC] THEN REMOVE_THEN "L3" (MP_TAC o SPECL [`u:real^N->bool`; `ball(b:real^N,e)`]) THEN ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)) THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]; ASM SET_TAC[]; REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x IN t) ==> (u DIFF t) INTER IMAGE f s = {}`) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^N->bool` THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `b:real^N`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(U:(real^N->bool)->bool)` ASSUME_TAC THENL [SUBGOAL_THEN `FINITE {z | z IN cball(x,r) /\ (f:real^N->real^N) z = b}` MP_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_FINITE_PREIMAGES THEN EXISTS_TAC `f':real^N->real^N->real^N` THEN REWRITE_TAC[COMPACT_CBALL] THEN CONJ_TAC THENL [REPEAT STRIP_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HAS_DERIVATIVE_AT_WITHIN THEN ASM SET_TAC[]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE)] THEN MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN EXISTS_TAC `(IN):real^N->(real^N->bool)->bool` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`x:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; REPEAT GEN_TAC THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(p /\ x) /\ (q /\ y) /\ r ==> (p /\ q) /\ r`)) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP COMPONENTS_NONOVERLAP) MP_TAC) THEN SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `k SUBSET UNIONS {closure u:real^N->bool | u IN U}` MP_TAC THENL [REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REMOVE_THEN "L7" (MP_TAC o SPECL [`e:real`; `a:real^N`; `b:real^N`]) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N`; `l:real`; `t0:real`; `c:real^N->bool`] THEN STRIP_TAC THEN EXPAND_TAC "U" THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MP_TAC(ISPECL [`ball(x:real^N,r)`; `c:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN REWRITE_TAC[OPEN_BALL] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `U:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[SET_RULE `{f x | x IN {}} = {}`] THEN REWRITE_TAC[UNIONS_0] THEN ASM SET_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `!u:real^N->bool. u IN U ==> ~(k SUBSET closure u)` ASSUME_TAC THENL [X_GEN_TAC `u:real^N->bool` THEN REPEAT STRIP_TAC THEN MP_TAC(ASSUME `(u:real^N->bool) IN U`) THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]; DISCH_TAC] THEN SUBGOAL_THEN `path_connected(u:real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_OPEN_PATH_CONNECTED]; REWRITE_TAC[path_connected]] THEN DISCH_THEN(MP_TAC o SPECL [`z1:real^N`; `z2:real^N`]) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [CONJ_TAC THEN REWRITE_TAC[SET_RULE `z IN u <=> (z INSERT u) SUBSET u`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM_SIMP_TAC[CONNECTED_INSERT] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN REMOVE_THEN "I1" (MP_TAC o SPEC `path_image g:real^N->bool`) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN REWRITE_TAC[GSYM CONJ_ASSOC; NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `ball(x:real^N,r)` THEN REWRITE_TAC[BALL_SUBSET_CBALL] THEN ASM SET_TAC[]; REWRITE_TAC[REAL_NOT_LE]] THEN MP_TAC(ISPECL [`IMAGE (f:real^N->real^N) (path_image g)`; `b:real^N`] DISTANCE_ATTAINS_SUP) THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY; PATH_IMAGE_NONEMPTY] THEN ANTS_TAC THENL [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^N` STRIP_ASSUME_TAC)] THEN TRANS_TAC REAL_LET_TRANS `norm((f:real^N->real^N) q - b)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_SUP_LE THEN ASM_SIMP_TAC[PATH_IMAGE_NONEMPTY; SIMPLE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE]; FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM SET_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `?a:real^N. a IN k /\ !v. ~({u | u IN U /\ a IN closure u} SUBSET {v})` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `~(pairwise (\u v:real^N->bool. DISJOINT (k INTER closure u) (k INTER closure v)) U)` MP_TAC THENL [DISCH_TAC; REWRITE_TAC[pairwise] THEN SET_TAC[]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `k SUBSET UNIONS {f u | u IN U} ==> ~(k = {}) ==> ?u. u IN U /\ ~(k INTER f u = {})`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `k:real^N->bool` CONNECTED_CLOSED) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `closure u:real^N->bool` THEN EXISTS_TAC `closure(UNIONS (U DELETE u)):real^N->bool` THEN REWRITE_TAC[CLOSED_CLOSURE; GSYM CLOSURE_UNION; GSYM UNIONS_INSERT] THEN ASM_SIMP_TAC[SET_RULE `x IN s ==> x INSERT (s DELETE x) = s`] THEN ASM_SIMP_TAC[CLOSURE_UNIONS; FINITE_DELETE; INTER_UNIONS] THEN REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC; IN_DELETE] THEN REPEAT STRIP_TAC THENL [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s INTER t INTER k = {} <=> (k INTER s) INTER (k INTER t) = {}`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[DISJOINT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ASM SET_TAC[]; UNDISCH_TAC `k SUBSET UNIONS {closure u:real^N->bool | u IN U}` THEN SUBGOAL_THEN `~((k:real^N->bool) SUBSET closure u)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `k INTER (t DIFF s) = {} ==> ~(k SUBSET s) ==> k SUBSET t ==> F`) THEN MATCH_MP_TAC(SET_RULE `k INTER UNIONS {f x | x IN s DELETE a} = {} ==> k INTER (UNIONS {f x | x IN s} DIFF f a) = {}`) THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[IN_DELETE; INTER_COMM]]; ALL_TAC] THEN REMOVE_THEN "L7" (MP_TAC o SPECL [`e:real`; `a:real^N`; `b:real^N`]) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N`; `l:real`; `t0:real`; `u0:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `(u0:real^N->bool) IN U` ASSUME_TAC THENL [EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MP_TAC(ISPECL [`ball(x:real^N,r)`; `u0:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN REWRITE_TAC[OPEN_BALL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?u1:real^N->bool. u1 IN U /\ ~(u1 = u0) /\ a IN closure u1` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `u0:real^N->bool` o MATCH_MP (SET_RULE `(!v. ~(s SUBSET {v})) ==> !u. u IN s ==> ?v. v IN s /\ ~(v = u)`)) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?t z. &0 < t /\ t < t0 /\ z IN u1 /\ norm(z - (a - t % h):real^N) < l * t` STRIP_ASSUME_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o SPECL [`inv(t) % (a - z):real^N`; `t:real`]) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `a - &1 % (a - z):real^N = z`; NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs t` THEN REWRITE_TAC[GSYM NORM_MUL; VECTOR_SUB_LDISTRIB] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`; VECTOR_MUL_LID] THEN REWRITE_TAC[NORM_ARITH `norm(a - z - h:real^N) = norm(z - (a - h))`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `z IN u1 ==> ~(u1 = u0) /\ (u0 INTER u1 = {} <=> ~(u0 = u1)) ==> ~(z IN u0)`)) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPONENTS_NONOVERLAP THEN EXISTS_TAC `{x | x IN s /\ (f:real^N->real^N) x IN ball(b,e)}` THEN ASM SET_TAC[]]] THEN SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((f:real^N->real^N) a = b)` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `(u1:real^N->bool) IN U` THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MP_TAC(ISPECL [`{x | x IN s /\ (f:real^N->real^N) x IN ball (b,e)}`; `u0:real^N->bool`; `u1:real^N->bool`] COMPONENTS_NONOVERLAP) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `a:real^N` THEN CONJ_TAC THEN REWRITE_TAC[SET_RULE `z IN u <=> (z INSERT u) SUBSET u`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN REPEAT(FIRST_X_ASSUM(fun th -> ASSUME_TAC(MATCH_MP IN_COMPONENTS_CONNECTED th) THEN ASSUME_TAC(MATCH_MP IN_COMPONENTS_NONEMPTY th) THEN ASSUME_TAC(MATCH_MP IN_COMPONENTS_SUBSET th))) THEN ASM_SIMP_TAC[CONNECTED_INSERT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!w. open w /\ a IN w ==> ?w'. open w' /\ (?t1. &0 < t1 /\ !t. &0 < t /\ t < t1 ==> (f(a) + t % (b - f a)) IN w') /\ w' SUBSET IMAGE (f:real^N->real^N) (u1 INTER w)` (LABEL_TAC "L8") THENL [X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN REMOVE_THEN "L2" (MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`rr:real`; `dd:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `?q. &0 < q /\ q < rr /\ ball(a:real^N,q) SUBSET v INTER s /\ cball(a,q) SUBSET s` MP_TAC THENL [MP_TAC(ISPEC `v:real^N->bool` OPEN_CONTAINS_CBALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[SUBSET_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:real` THEN STRIP_TAC THEN EXISTS_TAC `min q (rr / &2)` THEN ASM_REWRITE_TAC[REAL_HALF; BALL_MIN_INTER; CBALL_MIN_INTER; REAL_LT_MIN; REAL_MIN_LT; REAL_ARITH `r / &2 < r <=> &0 < r`] THEN MATCH_MP_TAC(SET_RULE `b SUBSET c /\ b' SUBSET c' /\ c' SUBSET s /\ c SUBSET v ==> (b INTER b' SUBSET v /\ b INTER b' SUBSET s) /\ c INTER c' SUBSET s`) THEN ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN TRANS_TAC SUBSET_TRANS `cball(a:real^N,rr)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_CBALL THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SUBSET_INTER; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `q:real` THEN STRIP_TAC THEN ABBREV_TAC `vv = ball(b,e) INTER ball((f:real^N->real^N) a,dd * q)` THEN EXISTS_TAC `vv:real^N->bool` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [EXPAND_TAC "vv" THEN SIMP_TAC[OPEN_BALL; OPEN_INTER]; DISCH_TAC] THEN CONJ_TAC THENL [EXPAND_TAC "vv" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN EXISTS_TAC `min (&1) ((dd * q) / norm(b - (f:real^N->real^N) a))` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_01; REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[NORM_ARITH `dist(b:real^N,a + x) = norm((b - a) - x)`] THEN REWRITE_TAC[VECTOR_ARITH `b - a - t % (b - a):real^N = (&1 - t) % (b - a)`] THEN REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `n <= e /\ x * n < &1 * n ==> x * n < e`) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < t ==> abs t = t`]]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `IMAGE (f:real^N->real^N) (ball(a,q) INTER u1)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN EXPAND_TAC "vv" THEN REMOVE_THEN "L3" MATCH_MP_TAC THEN ASM_SIMP_TAC[OPEN_BALL; OPEN_INTER; BOUNDED_BALL; BOUNDED_INTER] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_INTER THEN REWRITE_TAC[OPEN_BALL] THEN UNDISCH_TAC `(u1:real^N->bool) IN U` THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] OPEN_COMPONENTS) THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]; TRANS_TAC SUBSET_TRANS `closure(ball(a:real^N,q))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]; ASM_SIMP_TAC[CLOSURE_BALL]]; EXPAND_TAC "vv" THEN MATCH_MP_TAC CONVEX_CONNECTED THEN SIMP_TAC[CONVEX_BALL; CONVEX_INTER]; EXPAND_TAC "vv" THEN MATCH_MP_TAC(SET_RULE `(!x. x IN t2 ==> f x IN s1) /\ ~(t2 INTER {x | x IN t1 /\ f x IN s2} = {}) ==> ~((s1 INTER s2) INTER IMAGE f (t1 INTER t2) = {})`) THEN CONJ_TAC THENL [UNDISCH_TAC `(u1:real^N->bool) IN U` THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN DISCH_THEN(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CLOSURE_NONEMPTY_OPEN_INTER]) THEN ASM_SIMP_TAC[IN_ELIM_THM; CENTRE_IN_BALL; REAL_LT_MUL] THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN REWRITE_TAC[OPEN_BALL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]; REWRITE_TAC[SET_RULE `s INTER IMAGE f t = {} <=> !x. x IN t ==> ~(f x IN s)`] THEN X_GEN_TAC `z:real^N` THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] FRONTIER_INTER_SUBSET)) THEN EXPAND_TAC "vv" THEN REWRITE_TAC[IN_UNION; IN_INTER; DE_MORGAN_THM] THEN GEN_REWRITE_TAC RAND_CONV [DISJ_SYM] THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC THENL [ASM_SIMP_TAC[FRONTIER_BALL; IN_SPHERE; IN_BALL] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN SUBST1_TAC(SYM th)) THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist; REAL_NOT_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_CBALL; REAL_LT_IMP_LE]; REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]]]; ALL_TAC] THEN REMOVE_THEN "L5" (MP_TAC o SPECL [`a:real^N`; `l / norm((f:real^N->real^N) a - b)`]) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `dd:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GEN `t:real` o SPEC `(f:real^N->real^N)(a) + t % (b - f a)`) THEN REWRITE_TAC[SET_RULE `b INTER {x | x IN s /\ f x = y} SUBSET c <=> !x. x IN b /\ x IN s /\ y = f x ==> x IN c`] THEN SIMP_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!t. P t) ==> (!t. &0 < t ==> P t)`)) THEN SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH `a:real^N = a + x <=> x = vec 0`; VECTOR_SUB_EQ; REAL_LT_IMP_NZ] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a + b:real^N = c <=> c - a = b`] THEN ASM_SIMP_TAC[LINEAR_CMUL] THEN SUBST1_TAC(VECTOR_ARITH `b - (f:real^N->real^N) a = --(f a - b)`) THEN ASM_SIMP_TAC[LINEAR_NEG; VECTOR_ARITH `a + t % --h:real^N = a - t % h`] THEN REWRITE_TAC[NORM_MUL; NORM_NEG] THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; REAL_FIELD `&0 < n ==> l / n * t * n = l * t`] THEN ASM_SIMP_TAC[IN_BALL; REAL_ARITH `&0 < t ==> abs t = t`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN MATCH_MP_TAC(MESON[] `(?x t. P t /\ A t /\ B x /\ R x t) ==> (!t x. P t /\ R x t ==> Q x t) ==> (?t x. P t /\ A t /\ B x /\ Q x t)`) THEN REMOVE_THEN "L8" (MP_TAC o SPEC `ball(a:real^N,dd)`) THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[SUBSET] `(?w. open w /\ (?t0. P t0 /\ !t. R t t0 ==> f t IN w) /\ w SUBSET u) ==> ?t0. P t0 /\ !t. R t t0 ==> f t IN u`)) THEN DISCH_THEN(X_CHOOSE_THEN `t1:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `(min t0 t1) / &2`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_INTER; IN_BALL]] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN X_GEN_TAC `z:real^N` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN EXISTS_TAC `(min t0 t1) / &2` THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB; VECTOR_NEG_SUB] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN UNDISCH_TAC `(u1:real^N->bool) IN U` THEN EXPAND_TAC "U" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET o CONJUNCT1) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Sign invariance of nonvanishing Jacobian (also from Saint Raymond). *) (* ------------------------------------------------------------------------- *) let JACOBIAN_SIGN_INVARIANCE = prove (`!f:real^N->real^N f' s. open s /\ connected s /\ (!x. x IN s ==> (f has_derivative f' x) (at x) /\ ~(det(matrix (f' x)) = &0)) ==> (!x. x IN s ==> &0 < det(matrix(f' x))) \/ (!x. x IN s ==> det(matrix(f' x)) < &0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM(REWRITE_RULE[real_gt] REAL_SGN_EQ)] THEN MATCH_MP_TAC(MESON[REAL_SGN_CASES] `(!x. x IN s ==> ~(real_sgn(f x) = &0)) /\ (?c. !x. x IN s ==> real_sgn(f x) = c) ==> (!x. x IN s ==> real_sgn(f x) = &1) \/ (!x. x IN s ==> real_sgn(f x) = -- &1)`) THEN ASM_SIMP_TAC[REAL_SGN_EQ] THEN MATCH_MP_TAC LOCALLY_CONSTANT_IMP_CONSTANT THEN ASM_SIMP_TAC[OPEN_IN_OPEN_EQ] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?r. &0 < r /\ ball(a,&2 * r) SUBSET s /\ (!x y. x IN ball(a,&2 * r) /\ y IN ball(a,&2 * r) ==> ((f:real^N->real^N) x = f y <=> x = y))` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `a:real^N`; `s:real^N->bool`] INVERSE_FUNCTION_THEOREM) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`; `g:real^N->real^N`; `g':real^N->real^N->real^N`] THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` OPEN_CONTAINS_BALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `r / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN ASM SET_TAC[]; EXISTS_TAC `ball(a:real^N,r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL]] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `ball(a:real^N,&2 * r)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMOTOPIC_LINEAR_MAPS_IMP THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_MESON_TAC[has_derivative; SUBSET]; ALL_TAC] THEN SIMP_TAC[HOMOTOPIC_WITH] THEN EXISTS_TAC `\z. if fstcart z:real^1 = vec 0 then (f':real^N->real^N->real^N) a (sndcart z) else if fstcart z = vec 1 then (f':real^N->real^N->real^N) b (sndcart z) else norm(sndcart z) / (drop(fstcart z) * (&1 - drop(fstcart z)) * r) % (f((a + (&3 * drop(fstcart z) pow 2 - &2 * drop(fstcart z) pow 3) % (b - a)) + (drop(fstcart z) * (&1 - drop(fstcart z)) * r) % inv(norm(sndcart z)) % sndcart z) - f(a + (&3 * drop(fstcart z) pow 2 - &2 * drop(fstcart z) pow 3) % (b - a)))` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN SUBGOAL_THEN `!x t. ~(x = vec 0) /\ &0 <= t /\ t <= &1 /\ ~(t = &0) /\ ~(t = &1) ==> (a + (&3 * t pow 2 - &2 * t pow 3) % (b - a:real^N)) + (t * (&1 - t) * r) % inv (norm x) % x IN ball(a,&2 * r) /\ a + (&3 * t pow 2 - &2 * t pow 3) % (b - a) IN ball(a,&2 * r)` MP_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[IN_BALL] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= r /\ norm y < r ==> dist(a,(a + x) + y) < &2 * r /\ dist(a,a + x) < &2 * r`) THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_MUL_ASSOC; REAL_LT_RMUL_EQ; REAL_ARITH `&0 < r ==> (x * abs r < r <=> x * r < &1 * r)`] THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REAL_ARITH_TAC] THEN TRANS_TAC REAL_LE_TRANS `dist(a:real^N,b)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; GSYM IN_BALL] THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,b) = &1 * norm(b - a)`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `y <= x /\ &0 <= y - x + &1 ==> abs(x - y) <= &1`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_POW_LE] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `&2 * t pow 3 - &3 * t pow 2 + &1 = (&1 - t) pow 2 + &2 * t * (&1 - t) pow 2`] THEN MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; REAL_SUB_LE]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; IN_UNIV; IN_DELETE; DROP_VEC] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP; GSYM DROP_EQ; DROP_VEC] THEN MAP_EVERY X_GEN_TAC [`t:real`; `x:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `linear((f':real^N->real^N->real^N) a) /\ invertible(matrix(f' a))` MP_TAC THENL [ASM_MESON_TAC[has_derivative; INVERTIBLE_DET_NZ]; ALL_TAC] THEN SIMP_TAC[IMP_CONJ; MATRIX_INVERTIBLE; FUN_EQ_THM; o_THM; I_THM] THEN ASM_MESON_TAC[LINEAR_0]; ALL_TAC] THEN ASM_CASES_TAC `t = &1` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `linear((f':real^N->real^N->real^N) b) /\ invertible(matrix(f' b))` MP_TAC THENL [ASM_MESON_TAC[has_derivative; SUBSET; INVERTIBLE_DET_NZ]; ALL_TAC] THEN SIMP_TAC[IMP_CONJ; MATRIX_INVERTIBLE; FUN_EQ_THM; o_THM; I_THM] THEN ASM_MESON_TAC[LINEAR_0]; ALL_TAC] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0; REAL_ENTIRE] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_LT_IMP_NZ; REAL_SUB_0; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN ANTS_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[VECTOR_ARITH `x + y:real^N = x <=> y = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0; REAL_ENTIRE] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `interval(vec 0:real^1,vec 1) PCROSS ((:real^N) DELETE vec 0)` THEN CONJ_TAC THENL [REWRITE_TAC[CLOSURE_PCROSS; CLOSURE_INTERVAL; UNIT_INTERVAL_NONEMPTY; SUBSET_PCROSS; SUBSET_REFL; CLOSURE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN REWRITE_TAC[IN_DELETE; IN_UNIV] THEN STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\z. norm(sndcart z) / (drop(fstcart z) * (&1 - drop(fstcart z)) * r) % (f((a + (&3 * drop(fstcart z) pow 2 - &2 * drop(fstcart z) pow 3) % (b - a)) + (drop(fstcart z) * (&1 - drop(fstcart z)) * r) % inv(norm(sndcart z)) % sndcart z) - (f:real^N->real^N) (a + (&3 * drop(fstcart z) pow 2 - &2 * drop(fstcart z) pow 3) % (b - a)))` THEN REWRITE_TAC[EVENTUALLY_WITHIN; FSTCART_PASTECART; SNDCART_PASTECART] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; FORALL_PASTECART] THEN SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; REAL_LT_IMP_NE; IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ]; ALL_TAC] THEN GEN_REWRITE_TAC I [LIM_NULL] THEN ASM_CASES_TAC `t:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `((f:real^N->real^N) has_derivative f'(a)) (at a)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SPEC_TAC(`(f':real^N->real^N->real^N) a`,`f':real^N->real^N`) THEN SPEC_TAC(`b - a:real^N`,`v:real^N`) THEN SPEC_TAC(`a:real^N`,`a:real^N`) THEN MAP_EVERY UNDISCH_TAC [`&0 < r`; `~(x:real^N = vec 0)`]; ASM_CASES_TAC `t:real^1 = vec 1` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(MESON[I_O_ID] `!g. g o g = I /\ ((f o g o g) --> l) net ==> (f --> l) net`) THEN EXISTS_TAC `\z:real^(1,N)finite_sum. pastecart (vec 1 - fstcart z) (sndcart z)` THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; I_DEF; FUN_EQ_THM; FORALL_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[VECTOR_ARITH `x - (x - y):real^N = y`]; REWRITE_TAC[o_ASSOC]] THEN MATCH_MP_TAC LIM_COMPOSE_WITHIN THEN MAP_EVERY EXISTS_TAC [`interval(vec 0:real^1,vec 1) PCROSS ((:real^N) DELETE vec 0)`; `pastecart (vec 0:real^1) (x:real^N)`] THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; VECTOR_SUB_REFL; SNDCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_PASTECART THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART; LINEAR_SNDCART]; REWRITE_TAC[DROP_SUB; DROP_VEC; PASTECART_IN_PCROSS; PASTECART_INJ; IN_INTERVAL_1; GSYM DROP_EQ; EVENTUALLY_WITHIN; FORALL_PASTECART; o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN SIMP_TAC[REAL_LT_IMP_NE; REAL_SUB_0; REAL_SUB_LT; REAL_ARITH `&1 - x < &1 <=> &0 < x`] THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC]] THEN REWRITE_TAC[REAL_ARITH `(&1 - x) * (&1 - (&1 - x)) * r = x * (&1 - x) * r`] THEN REWRITE_TAC[REAL_ARITH `&3 * (&1 - t) pow 2 - &2 * (&1 - t) pow 3 = &1 - (&3 * t pow 2 - &2 * t pow 3)`] THEN REWRITE_TAC[VECTOR_ARITH `a + (&1 - x) % (b - a):real^N = b + x % (a - b)`] THEN SUBGOAL_THEN `((f:real^N->real^N) has_derivative f'(b)) (at b)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SPEC_TAC(`(f':real^N->real^N->real^N) b`,`f':real^N->real^N`) THEN SPEC_TAC(`a - b:real^N`,`v:real^N`) THEN SPEC_TAC(`b:real^N`,`a:real^N`) THEN MAP_EVERY UNDISCH_TAC [`&0 < r`; `~(x:real^N = vec 0)`]; MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VECTOR_SUB_REFL] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_LIFT_NORM_COMPOSE; LINEAR_SNDCART; LINEAR_CONTINUOUS_WITHIN] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN ASM_SIMP_TAC[REAL_ENTIRE; FSTCART_PASTECART; REAL_LT_IMP_NZ] THEN REWRITE_TAC[REAL_SUB_0] THEN ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN ASM_REWRITE_TAC[LIFT_CMUL; LIFT_SUB; LIFT_DROP; REAL_SUB_0] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_MUL THEN CONJ_TAC THEN REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB]) THEN SIMP_TAC[ETA_AX; CONTINUOUS_CONST; LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART; CONTINUOUS_SUB]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN (CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_LIFT_POW ORELSE MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE ORELSE ((MATCH_MP_TAC CONTINUOUS_ADD ORELSE MATCH_MP_TAC CONTINUOUS_MUL ORELSE MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) ORELSE MATCH_MP_TAC CONTINUOUS_SUB) THEN CONJ_TAC) THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_CMUL; LIFT_DROP]) THEN REWRITE_TAC[CONTINUOUS_CONST; ETA_AX] THEN SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART; LINEAR_SNDCART] THEN ASM_REWRITE_TAC[NORM_EQ_0; SNDCART_PASTECART]; ALL_TAC]) THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN MATCH_MP_TAC(MESON[DIFFERENTIABLE_IMP_CONTINUOUS_AT; differentiable] `!f'. (f has_derivative f' x) (at x) /\ ~(det(matrix(f' x)) = &0) ==> (f:real^N->real^N) continuous at x`) THEN EXISTS_TAC `(f':real^N->real^N->real^N)` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN EXISTS_TAC `ball(a:real^N,&2 * r)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN TRY(EXISTS_TAC `x:real^N`) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN ASM_REWRITE_TAC[]]] THEN (POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[has_derivative_at] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LIM_NULL; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `n * x * y * z:real = (n * y * z) * x`] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(a * b) % (x - y):real^N = a % (b % x - b % y)`] THEN SUBGOAL_THEN `(f':real^N->real^N) x = norm(x:real^N) / r % f'(r / norm x % x)` SUBST1_TAC THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD `~(x = &0) /\ &0 < r ==> x / r * r / x = &1`]; ALL_TAC] THEN MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF; LIFT_CMUL; real_div] THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIFT_CMUL; o_DEF] THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [SUBST1_TAC(GSYM REAL_INV_1) THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INV) THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC LIM_NORM] THEN MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[LIFT_SUB; LIFT_DROP; CONTINUOUS_SUB; CONTINUOUS_CONST; LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART; LINEAR_SNDCART]; ALL_TAC] THEN MP_TAC(VECTOR_ARITH `!k x y. k % (f:real^N->real^N)((a + x) + y) - k % f(a + x):real^N = k % (f((a + x) + y) - f a) - k % (f(a + x) - f a)`) THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN GEN_REWRITE_TAC LAND_CONV [VECTOR_ARITH `x:real^N = &1 % x - &0 % x`] THEN SUBGOAL_THEN `!g c. ((\y. inv(drop(fstcart y)) % (g y - a) - c % inv(norm(sndcart y)) % sndcart y) --> vec 0) (at (pastecart (vec 0) x) within interval(vec 0,vec 1) PCROSS ((:real^N) DELETE vec 0)) ==> ((\y. inv(drop(fstcart y)) % (f(g y) - f a)) --> c % (f':real^N->real^N) (inv(norm x) % x)) (at (pastecart (vec 0) x) within interval(vec 0,vec 1) PCROSS ((:real^N) DELETE vec 0))` ASSUME_TAC THENL [REPEAT GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`at (pastecart (vec 0:real^1) (x:real^N)) within (interval(vec 0,vec 1) PCROSS ((:real^N) DELETE vec 0))`; `g:real^(1,N)finite_sum->real^N`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] LIM_COMPOSE_AT))) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN SIMP_TAC[o_DEF] THEN REWRITE_TAC[VECTOR_SUB_REFL] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_MUL_RZERO; EVENTUALLY_TRUE] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[LIM_NULL] THEN FIRST_ASSUM(MP_TAC o ISPECL [`\y:real^(1,N)finite_sum. drop(fstcart y)`; `&0`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] LIM_MUL)) THEN REWRITE_TAC[o_DEF; o_DEF; LIFT_NUM; VECTOR_MUL_LZERO; LIFT_DROP] THEN ANTS_TAC THENL [MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; ETA_AX] THEN SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(g' - a' - n) - (g - a):real^N = ((g' - g) - (a' - a)) + --n`] THEN MATCH_MP_TAC LIM_NULL_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_NULL_SUB THEN CONJ_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[FORALL_IN_PCROSS; IN_INTERVAL_1; DROP_VEC; IMP_CONJ] THEN SIMP_TAC[FSTCART_PASTECART; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH; MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\x:real^(1,N)finite_sum. abs c * norm(fstcart x)` THEN REWRITE_TAC[NORM_MUL; NORM_NEG] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_WITHIN_TOPOLOGICAL] THEN EXISTS_TAC `(:real^1) PCROSS ((:real^N) DELETE vec 0)` THEN SIMP_TAC[OPEN_PCROSS; OPEN_UNIV; OPEN_DELETE] THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_DELETE; IN_UNIV] THEN REWRITE_TAC[FORALL_IN_PCROSS; IN_INTER; IMP_CONJ] THEN REWRITE_TAC[IN_DELETE; IN_UNIV; FSTCART_PASTECART] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[SNDCART_PASTECART; GSYM REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID; NORM_EQ_0] THEN REWRITE_TAC[NORM_1; REAL_MUL_SYM; REAL_LE_REFL]; REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; NORM_0; LIFT_NUM] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_WITHIN]]]]; FIRST_ASSUM(MP_TAC o SPEC `\y. inv(drop(fstcart y)) % ((g:real^(1,N)finite_sum->real^N) y - a) - c % inv(norm x) % x` o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM LIM_NULL] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NORM) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[o_DEF] LIM_MUL)) THEN REWRITE_TAC[VECTOR_MUL_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `\y. inv(norm(fstcart(y:real^(1,N)finite_sum))) % (f(g y) - f a - (f':real^N->real^N) (g y - a))` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `y:real^(1,N)finite_sum` THEN ASM_CASES_TAC `(g:real^(1,N)finite_sum->real^N) y = a` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[VECTOR_SUB_REFL] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_MUL_RZERO]; REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN BINOP_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN REWRITE_TAC[GSYM NORM_1] THEN MATCH_MP_TAC(REAL_FIELD `~(y = &0) ==> (x * y) * inv y = x`) THEN ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ]]; GEN_REWRITE_TAC LAND_CONV [LIM_NULL_NORM] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[NORM_1; GSYM REAL_ABS_INV] THEN REWRITE_TAC[GSYM NORM_MUL; GSYM LIM_NULL_NORM] THEN GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[VECTOR_ARITH `c % (x - y - z) - (c % (x - y) - d):real^N = --(c % z - d)`] THEN REWRITE_TAC[LIM_NULL_NEG; GSYM LIM_NULL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN MATCH_MP_TAC LIM_LINEAR THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM))]] THEN REWRITE_TAC[VECTOR_ARITH `(a - x) - (a - y):real^N = --(x - y)`] THEN REWRITE_TAC[LIM_NULL_NEG; GSYM VECTOR_SUB_LDISTRIB] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN REWRITE_TAC[GSYM LIM_NULL] THEN MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[SNDCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN SIMP_TAC[o_DEF; LINEAR_SNDCART; LINEAR_CONTINUOUS_WITHIN] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; LINEAR_SNDCART; LINEAR_CONTINUOUS_WITHIN] THEN ASM_REWRITE_TAC[SNDCART_PASTECART; NORM_EQ_0]]; ALL_TAC] THEN MATCH_MP_TAC LIM_SUB THEN CONJ_TAC THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LID; REAL_MUL_LZERO] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM VECTOR_ADD_ASSOC; VECTOR_ADD_SUB] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; GSYM REAL_MUL_ASSOC] THEN (SUBGOAL_THEN `!z. z IN interval(vec 0,vec 1) PCROSS ((:real^N) DELETE vec 0) ==> ~(drop(fstcart z) = &0)` MP_TAC THENL [SIMP_TAC[FORALL_IN_PCROSS; IN_INTERVAL_1; DROP_VEC; REAL_LT_IMP_NZ; FSTCART_PASTECART]; SIMP_TAC[MESON[DROP_EQ; DROP_VEC] `drop x = &0 <=> x = vec 0`; REAL_FIELD `~(y = &0) ==> inv y * y * z = z`; REAL_FIELD `~(y = &0) ==> inv y * (&3 * y pow 2 - &2 * y pow 3) = y * (&3 - &2 * y)`] THEN DISCH_THEN(K ALL_TAC)]) THENL [REWRITE_TAC[VECTOR_ARITH `(a + b) - c:real^N = (b - c) + a`] THEN MATCH_MP_TAC LIM_NULL_ADD THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `(a * x * y) % z - (x * y) % z:real^N = (a - &1) % x % y % z`] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - a - &1) % x:real^N = --(a % x)`] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\x:real^(1,N)finite_sum. abs r * norm(fstcart x)` THEN REWRITE_TAC[NORM_MUL; NORM_NEG] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_WITHIN_TOPOLOGICAL] THEN EXISTS_TAC `(:real^1) PCROSS ((:real^N) DELETE vec 0)` THEN SIMP_TAC[OPEN_PCROSS; OPEN_UNIV; OPEN_DELETE] THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_DELETE; IN_UNIV] THEN REWRITE_TAC[FORALL_IN_PCROSS; IN_INTER; IMP_CONJ] THEN REWRITE_TAC[IN_DELETE; IN_UNIV; FSTCART_PASTECART] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[SNDCART_PASTECART; GSYM REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID; NORM_EQ_0] THEN REWRITE_TAC[NORM_1; REAL_MUL_SYM; REAL_LE_REFL]; REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; NORM_0; LIFT_NUM] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_WITHIN]]; ALL_TAC]; REWRITE_TAC[REAL_MUL_LZERO; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]] THEN MATCH_MP_TAC LIM_NULL_VMUL THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\y:real^(1,N)finite_sum. lift(&3 * drop(fstcart y) - &2 * drop(fstcart y) pow 2)` THEN REWRITE_TAC[EVENTUALLY_WITHIN; FORALL_PASTECART; LIFT_EQ] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTERVAL_1; DROP_VEC] THEN SIMP_TAC[FSTCART_PASTECART; REAL_FIELD `&0 < x ==> inv x * (&3 * x pow 2 - &2 * x pow 3) = &3 * x - &2 * x pow 2`] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN (CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC LIM_CONTINUOUS_SELF_WITHIN THEN REWRITE_TAC[FSTCART_PASTECART; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_SUB; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN TRY(MATCH_MP_TAC CONTINUOUS_LIFT_POW) THEN REWRITE_TAC[LIFT_DROP; ETA_AX] THEN SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART; LINEAR_SNDCART]));; (* ------------------------------------------------------------------------- *) (* Invertible derivative continous at a point implies local injectivity. *) (* It's only for this we need continuity of the derivative, except of course *) (* if we want the fact that the inverse derivative is also continuous. So if *) (* we know for some other reason that the inverse function exists, it's OK. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_LOCALLY_INJECTIVE = prove (`!f:real^M->real^N f' g' s a. a IN s /\ open s /\ linear g' /\ (g' o f'(a) = I) /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x)) /\ (!e. &0 < e ==> ?d. &0 < d /\ !x. dist(a,x) < d ==> onorm(\v. f'(x) v - f'(a) v) < e) ==> ?t. a IN t /\ open t /\ !x x'. x IN t /\ x' IN t /\ (f x' = f x) ==> (x' = x)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < onorm(g':real^N->real^M)` ASSUME_TAC THENL [ASM_SIMP_TAC[ONORM_POS_LT] THEN ASM_MESON_TAC[VEC_EQ; ARITH_EQ]; ALL_TAC] THEN ABBREV_TAC `k = &1 / onorm(g':real^N->real^M) / &2` THEN SUBGOAL_THEN `?d. &0 < d /\ ball(a,d) SUBSET s /\ !x. x IN ball(a,d) ==> onorm(\v. (f':real^M->real^M->real^N)(x) v - f'(a) v) < k` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `k:real`) THEN EXPAND_TAC "k" THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_TAC `d2:real`) THEN EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN; IN_BALL] THEN ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN EXISTS_TAC `ball(a:real^M,d)` THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `x':real^M`] THEN STRIP_TAC THEN ABBREV_TAC `ph = \w. w - g'(f(w) - (f:real^M->real^N)(x))` THEN SUBGOAL_THEN `norm((ph:real^M->real^M) x' - ph x) <= norm(x' - x) / &2` MP_TAC THENL [ALL_TAC; EXPAND_TAC "ph" THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[VECTOR_SUB_RZERO; GSYM NORM_LE_0] THEN REAL_ARITH_TAC] THEN SUBGOAL_THEN `!u v:real^M. u IN ball(a,d) /\ v IN ball(a,d) ==> norm(ph u - ph v :real^M) <= norm(u - v) / &2` (fun th -> ASM_SIMP_TAC[th]) THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC DIFFERENTIABLE_BOUND THEN REWRITE_TAC[CONVEX_BALL; OPEN_BALL] THEN EXISTS_TAC `\x v. v - g'((f':real^M->real^M->real^N) x v)` THEN CONJ_TAC THEN X_GEN_TAC `u:real^M` THEN DISCH_TAC THEN REWRITE_TAC[] THENL [EXPAND_TAC "ph" THEN MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN REWRITE_TAC[HAS_DERIVATIVE_ID] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_SUB th]) THEN GEN_REWRITE_TAC (RATOR_CONV o BINDER_CONV) [GSYM VECTOR_SUB_RZERO] THEN MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN ONCE_REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[HAS_DERIVATIVE_LINEAR; SUBSET; HAS_DERIVATIVE_AT_WITHIN]; ALL_TAC] THEN SUBGOAL_THEN `(\w. w - g'((f':real^M->real^M->real^N) u w)) = g' o (\w. f' a w - f' u w)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[LINEAR_SUB]; ALL_TAC] THEN SUBGOAL_THEN `linear(\w. f' a w - (f':real^M->real^M->real^N) u w)` ASSUME_TAC THENL [MATCH_MP_TAC LINEAR_COMPOSE_SUB THEN ONCE_REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[has_derivative; SUBSET; CENTRE_IN_BALL]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `onorm(g':real^N->real^M) * onorm(\w. f' a w - (f':real^M->real^M->real^N) u w)` THEN ASM_SIMP_TAC[ONORM_COMPOSE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REWRITE_TAC[real_div; REAL_ARITH `inv(&2) * x = (&1 * x) * inv(&2)`] THEN ASM_REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `onorm(\w. (f':real^M->real^M->real^N) a w - f' u w) = onorm(\w. f' u w - f' a w)` (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_NEG_SUB] THEN REWRITE_TAC[ONORM_NEG]);; (* ------------------------------------------------------------------------- *) (* More conventional "C1" version of inverse function theorem. *) (* ------------------------------------------------------------------------- *) let INVERSE_FUNCTION_THEOREM_C1_POINTWISE = prove (`!f:real^N->real^N f' s a. open s /\ a IN s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x)) /\ ~(det(matrix(f' a)) = &0) /\ (!h. (\x. f' x h) continuous at a) ==> ?t u g g'. open t /\ a IN t /\ t SUBSET s /\ open u /\ f a IN u /\ homeomorphism (t,u) (f,g) /\ (!x. x IN t ==> (f has_derivative f' x) (at x) /\ f'(x) o g'(f x) = I /\ g'(f x) o f'(x) = I) /\ (!y. y IN u ==> (g has_derivative g' y) (at y) /\ f'(g y) o g' y = I /\ g' y o f'(g y) = I) /\ (!x. x IN t /\ (!h. (\y. f' y h) continuous at x) ==> (!h. (\z. g' z h) continuous at (f x)))`, REWRITE_TAC[CONTINUOUS_AT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?s'. a IN s' /\ s' SUBSET s /\ open s' /\ !x. x IN s' ==> ~(det(matrix((f':real^N->real^N->real^N) x)) = &0)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`\x. matrix((f':real^N->real^N->real^N) x)`; `matrix((f':real^N->real^N->real^N) a)`; `at(a:real^N)`] LIM_LIFT_DET) THEN REWRITE_TAC[GSYM LIM_MATRIX_COMPONENTWISE] THEN ANTS_TAC THENL [X_GEN_TAC `h:real^N` THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\a. (f':real^N->real^N->real^N) a h` THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_SIMP_TAC[MATRIX_WORKS]; REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `abs(det(matrix((f':real^N->real^N->real^N) a)))`) THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; EVENTUALLY_AT_TOPOLOGICAL] THEN REWRITE_TAC[DIST_LIFT; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `s INTER u:real^N->bool` THEN ASM_SIMP_TAC[IN_INTER; OPEN_INTER; INTER_SUBSET] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = a` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `a:real^N`; `s':real^N->bool`] INVERSE_FUNCTION_THEOREM) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) [`t:real^N->bool`; `u:real^N->bool`; `g:real^N->real^N`; `g':real^N->real^N->real^N`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN TRANS_TAC(TAUT `!q. (p ==> q) /\ (q ==> r) ==> p ==> r`) `!h:real^N. ((\y. matrix_inv(matrix ((f':real^N->real^N->real^N) y)) ** h) --> matrix_inv(matrix(f' x)) ** h) (at x)` THEN CONJ_TAC THENL [DISCH_THEN(fun th -> MATCH_MP_TAC LIM_MATRIX_INV THEN MP_TAC th) THEN MATCH_MP_TAC(TAUT `r /\ (p ==> q) ==> p ==> q /\ r`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N` THEN MATCH_MP_TAC(MESON[] `m = l /\ ((x --> l) net ==> (y --> l) net) ==> (x --> l) net ==> (y --> m) net`) THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] LIM_TRANSFORM_WITHIN_OPEN)) THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN CONV_TAC SYM_CONV] THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] MATRIX_WORKS) THEN ASM_MESON_TAC[has_derivative]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `(\z. (g':real^N->real^N->real^N) (f z) h) o (g:real^N->real^N)` THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[o_THM; CONJ_ASSOC] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPOSE_AT THEN EXISTS_TAC `x:real^N` THEN SIMP_TAC[EVENTUALLY_TRUE] THEN CONJ_TAC THENL [SUBGOAL_THEN `x = (g:real^N->real^N)(f x)` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM CONTINUOUS_AT] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN REWRITE_TAC[differentiable] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(x --> l) net ==> m = l /\ ((x --> l) net ==> (y --> l) net) ==> (y --> m) net`)) THEN CONJ_TAC THENL [CONV_TAC SYM_CONV; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] LIM_TRANSFORM_WITHIN_OPEN)) THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC] THEN W(MP_TAC o PART_MATCH (rand o rand) (REWRITE_RULE[RIGHT_IMP_FORALL_THM] MATRIX_WORKS) o rand o snd) THEN (ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; has_derivative]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_LEFT THEN W(MP_TAC o PART_MATCH (rand o rand) MATRIX_COMPOSE o lhand o snd) THEN (ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; has_derivative]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[MATRIX_I]])]]]);; let INVERSE_FUNCTION_C1 = prove (`!f:real^N->real^N f' s a. open s /\ a IN s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x) /\ ((!h. (\y. f' y h) continuous at x))) /\ ~(det(matrix(f' a)) = &0) ==> ?t u g g'. open t /\ a IN t /\ t SUBSET s /\ open u /\ f a IN u /\ homeomorphism (t,u) (f,g) /\ (!x. x IN t ==> (f has_derivative f' x) (at x) /\ f'(x) o g'(f x) = I /\ g'(f x) o f'(x) = I) /\ (!y. y IN u ==> (g has_derivative g' y) (at y) /\ f'(g y) o g' y = I /\ g' y o f'(g y) = I) /\ (!x. x IN t ==> (!h. (\z. g' z h) continuous at (f x)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `s:real^N->bool`; `a:real^N`] INVERSE_FUNCTION_THEOREM_C1_POINTWISE) THEN ASM_SIMP_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A Hadamard-style global inverse function theorem when the function is *) (* a closed (or equivalently proper) map into a simply connected set. *) (* ------------------------------------------------------------------------- *) let INVERSE_FUNCTION_THEOREM_GLOBAL = prove (`!f:real^N->real^N f' s t. open s /\ connected s /\ simply_connected t /\ (s = {} ==> t = {}) /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ (!x. x IN s ==> (f has_derivative f' x) (at x) /\ ~(det(matrix(f' x)) = &0)) ==> ?g g'. homeomorphism (s,t) (f,g) /\ (!y. y IN t ==> (g has_derivative g' y) (at y) /\ f' (g y) o g' y = I /\ g' y o f' (g y) = I) /\ (!x. x IN s ==> f' x o g' (f x) = I /\ g' (f x) o f' x = I)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `open(IMAGE (f:real^N->real^N) s)` ASSUME_TAC THENL [ASM_MESON_TAC[DIFFERENTIABLE_IMP_OPEN_MAP]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`; `t:real^N->bool`] CLOSED_LOCAL_HOMEOMORPHISM_GLOBAL) THEN ASM_SIMP_TAC[CONNECTED_OPEN_PATH_CONNECTED; OPEN_IN_OPEN_EQ] THEN ANTS_TAC THENL [X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `a:real^N`; `s:real^N->bool`] INVERSE_FUNCTION_THEOREM) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_SUBSET THEN FIRST_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN REWRITE_TAC[CLOSED_IN_REFL] THEN DISCH_THEN(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N`] THEN MATCH_MP_TAC(MESON[] `(!x. P /\ Q x ==> R x) /\ (P ==> ?x. Q x) ==> (P ==> ?x. P /\ Q x /\ R x)`) THEN CONJ_TAC THENL [REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN SET_TAC[]; REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN SIMP_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN SUBGOAL_THEN `t = IMAGE (f:real^N->real^N) s` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FORALL_IN_IMAGE]] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPEC `(f':real^N->real^N->real^N) x` MATRIX_INVERTIBLE) THEN ANTS_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN ASM_SIMP_TAC[INVERTIBLE_DET_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN MAP_EVERY EXISTS_TAC [`(f':real^N->real^N->real^N) x`; `s:real^N->bool`] THEN ASM_SIMP_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Some slightly more refined localized variants. *) (* ------------------------------------------------------------------------- *) let INVERSE_FUNCTION_THEOREM_SUBSPACE = prove (`!f:real^N->real^N f' s p a. subspace p /\ open_in (subtopology euclidean p) s /\ IMAGE f s SUBSET p /\ a IN s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within p) /\ IMAGE (f' x) p = p) ==> ?t u g g'. open_in (subtopology euclidean p) t /\ a IN t /\ t SUBSET s /\ open_in (subtopology euclidean p) u /\ f(a) IN u /\ homeomorphism (t,u) (f,g) /\ (!x. x IN t ==> (f has_derivative f' x) (at x within p) /\ (!h. h IN p ==> f' x (g' (f x) h) = h /\ g' (f x) (f' x h) = h)) /\ (!y. y IN u ==> (g has_derivative g' y) (at y within p) /\ (!h. h IN p ==> f' (g y) (g' y h) = h /\ g' y (f' (g y) h) = h))`, REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`h = \x:real^N. f(closest_point p x) + (x - closest_point p x)`; `h' = \x h. (f':real^N->real^N->real^N) (closest_point p x) (closest_point p h) + (h - closest_point p h)`] THEN MP_TAC(ISPECL [`h:real^N->real^N`; `h':real^N->real^N->real^N`; `a:real^N`; `{x | x IN (:real^N) /\ closest_point p x IN s}`] INVERSE_FUNCTION_THEOREM) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `p:real^N->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_CLOSEST_POINT] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_SET THEN ASM_SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY]; ASM_REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [SUBGOAL_THEN `closest_point p a:real^N = a` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC CLOSEST_POINT_SELF THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; DISCH_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN MATCH_MP_TAC LINEAR_COMPOSE_SUB THEN ASM_SIMP_TAC[LINEAR_ID; LINEAR_CLOSEST_POINT; ETA_AX]] THEN MP_TAC(ISPECL [`closest_point(p:real^N->bool)`; `f:real^N->real^N`; `closest_point(p:real^N->bool)`; `(f':real^N->real^N->real^N) (closest_point p x)`; `x:real^N`; `{x:real^N | closest_point p x IN s}`] DIFF_CHAIN_WITHIN) THEN ASM_SIMP_TAC[o_DEF; HAS_DERIVATIVE_LINEAR; LINEAR_CLOSEST_POINT] THEN ASM_SIMP_TAC[HAS_DERIVATIVE_WITHIN_OPEN; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `closest_point p (x:real^N)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_DERIVATIVE_WITHIN_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY]; REWRITE_TAC[GSYM INVERTIBLE_DET_NZ] THEN W(MP_TAC o PART_MATCH (lhand o rand) MATRIX_INVERTIBLE_RIGHT o snd) THEN ASM_SIMP_TAC[GSYM LINEAR_SURJECTIVE_RIGHT_INVERSE_EQ] THEN ANTS_TAC THENL [MATCH_MP_TAC LINEAR_COMPOSE_ADD THEN ASM_SIMP_TAC[LINEAR_COMPOSE_SUB; LINEAR_ID; LINEAR_CLOSEST_POINT; ETA_AX] THEN GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC LINEAR_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CLOSEST_POINT; ETA_AX] THEN FIRST_X_ASSUM(MP_TAC o SPEC `closest_point p (x:real^N)`) THEN ASM_SIMP_TAC[has_derivative]; DISCH_THEN SUBST1_TAC] THEN X_GEN_TAC `y:real^N` THEN FIRST_X_ASSUM(MP_TAC o SPEC `closest_point p (x:real^N)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s = t ==> !y. y IN t ==> ?x. x IN s /\ f x = y`) o CONJUNCT2) THEN DISCH_THEN(MP_TAC o SPEC `closest_point p (y:real^N)`) THEN ASM_SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `w + (y - closest_point p y):real^N` THEN ASM_SIMP_TAC[LINEAR_CLOSEST_POINT; LINEAR_ADD; LINEAR_SUB] THEN ASM_SIMP_TAC[CLOSEST_POINT_SELF; CLOSEST_POINT_IN_SET; CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_ADD_RID] THEN CONV_TAC VECTOR_ARITH]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`; `g:real^N->real^N`; `g':real^N->real^N->real^N`] THEN REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "*") (LABEL_TAC "+")) THEN MAP_EVERY EXISTS_TAC [`p INTER t:real^N->bool`; `p INTER u:real^N->bool`; `g:real^N->real^N`; `g':real^N->real^N->real^N`] THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MP_TAC(ISPEC `p:real^N->bool` CLOSEST_POINT_SELF) THEN ASM SET_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `!x. x IN p ==> (h:real^N->real^N) x = f x` ASSUME_TAC THENL [EXPAND_TAC "h" THEN SIMP_TAC[CLOSEST_POINT_SELF] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN SUBGOAL_THEN `!x. x IN t ==> ((h:real^N->real^N) x IN p <=> x IN p)` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[] THEN EQ_TAC THENL [DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH `x = ((f:real^N->real^N)(closest_point p x) + x - closest_point p x) - (f(closest_point p x) - closest_point p x)`) THEN REPEAT(MATCH_MP_TAC SUBSPACE_SUB THEN REPEAT CONJ_TAC) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`p:real^N->bool`; `a:real^N`] CLOSEST_POINT_IN_SET) THEN ASM_SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_IMP_NONEMPTY]; SIMP_TAC[CLOSEST_POINT_SELF; VECTOR_SUB_REFL; VECTOR_ADD_RID]] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[HOMEOMORPHISM_EQ; HOMEOMORPHISM_OF_SUBSETS] `homeomorphism(t,u) (f',g) ==> (!x. x IN t' ==> f' x = f x) /\ t' SUBSET t /\ u' SUBSET u /\ IMAGE f' t' = u' ==> homeomorphism(t',u') (f,g)`)) THEN ASM_SIMP_TAC[IN_INTER; INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `!f. (!x. x IN p ==> h x = f x) /\ IMAGE h t = u /\ IMAGE f (t INTER p) SUBSET p /\ (!x. x IN t ==> (h x IN p <=> x IN p)) ==> IMAGE h (p INTER t) = p INTER u`) THEN EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[homeomorphism]; ASM SET_TAC[]]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ALL_TAC; DISCH_TAC THEN ASM_SIMP_TAC[HAS_DERIVATIVE_AT_WITHIN] THEN SUBGOAL_THEN `u = IMAGE (h:real^N->real^N) t` SUBST1_TAC THENL [ASM_MESON_TAC[homeomorphism]; ONCE_REWRITE_TAC[IMP_CONJ_ALT]] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])) THEN ASM_SIMP_TAC[IN_INTER]] THEN MP_TAC(ASSUME `(p INTER t:real^N->bool) SUBSET s`) THEN REWRITE_TAC[SUBSET] THEN ASM_SIMP_TAC[IN_INTER] THEN DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; AND_FORALL_THM; I_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:real^N` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "h'" THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(g':real^N->real^N->real^N) (f(x:real^N)) z IN p` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[CLOSEST_POINT_SELF; VECTOR_SUB_REFL; VECTOR_ADD_RID]] THEN REMOVE_THEN "+" MP_TAC THEN SUBGOAL_THEN `u = IMAGE (h:real^N->real^N) t` SUBST1_TAC THENL [ASM_MESON_TAC[homeomorphism]; REWRITE_TAC[FORALL_IN_IMAGE]] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP GATEAUX_DERIVATIVE o CONJUNCT1) THEN DISCH_THEN(MP_TAC o SPEC `z:real^N`) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] LIM_IN_CLOSED_SET)) THEN ASM_SIMP_TAC[CLOSED_SUBSPACE; TRIVIAL_LIMIT_AT] THEN SUBGOAL_THEN `eventually (\r. ((f:real^N->real^N) x + drop r % z) IN u) (at(vec 0))` MP_TAC THENL [REWRITE_TAC[EVENTUALLY_AT_TOPOLOGICAL] THEN EXISTS_TAC `{r | r IN (:real^1) /\ ((f:real^N->real^N) x + drop r % z) IN u}` THEN REWRITE_TAC[IN_ELIM_THM; IN_DELETE; DROP_VEC; VECTOR_MUL_LID] THEN SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_UNIV] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]; RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN X_GEN_TAC `r:real` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSPACE_SUB THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(f:real^N->real^N) x IN u /\ !w. w IN u ==> ((g:real^N->real^N) w IN p <=> w IN p)` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC SUBSPACE_ADD THEN ASM_SIMP_TAC[SUBSPACE_MUL] THEN ASM SET_TAC[]]]);; let INVERSE_FUNCTION_THEOREM_AFFINE = prove (`!f:real^N->real^N f' s p a. affine p /\ open_in (subtopology euclidean p) s /\ IMAGE f s SUBSET p /\ a IN s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within p) /\ ~(det (matrix (f' x)) = &0)) ==> ?t u g g'. open_in (subtopology euclidean p) t /\ a IN t /\ t SUBSET s /\ open_in (subtopology euclidean p) u /\ f(a) IN u /\ homeomorphism (t,u) (f,g) /\ (!x. x IN t ==> (f has_derivative f' x) (at x within p) /\ f' x o g' (f x) = I /\ g' (f x) o f' x = I) /\ (!y. y IN u ==> (g has_derivative g' y) (at y within p) /\ f' (g y) o g' y = I /\ g' y o f' (g y) = I)`, W(fun (asl,w) -> SUBGOAL_THEN (subst[`subspace:(real^N->bool)->bool`, `affine:(real^N->bool)->bool`] w) ASSUME_TAC) THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `s:real^N->bool`; `p:real^N->bool`; `a:real^N`] INVERSE_FUNCTION_THEOREM_SUBSPACE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[GSYM INVERTIBLE_DET_NZ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_INJECTIVE_IMP_SURJECTIVE_ON THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[has_derivative]) THEN ASM_REWRITE_TAC[LE_REFL] THEN CONJ_TAC THENL [ALL_TAC; FIRST_ASSUM(MP_TAC o MATCH_MP MATRIX_INVERTIBLE_LEFT) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `z:real^N` o MATCH_MP GATEAUX_DERIVATIVE_WITHIN) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `(x:real^N) IN p` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; UNIV_GSPEC; WITHIN_UNIV] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] LIM_IN_CLOSED_SET)) THEN ASM_SIMP_TAC[CLOSED_SUBSPACE; TRIVIAL_LIMIT_AT] THEN SUBGOAL_THEN `eventually (\r. r IN {q | (x + drop q % z:real^N) IN s}) (at(vec 0))` MP_TAC THENL [MATCH_MP_TAC EVENTUALLY_IN_OPEN THEN ASM_REWRITE_TAC[IN_ELIM_THM; DROP_VEC; VECTOR_MUL_LZERO] THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THEN ONCE_REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x} = {x | x IN UNIV /\ P x}`] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `p:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; SUBSPACE_ADD; SUBSPACE_MUL] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP; IN_ELIM_THM] THEN X_GEN_TAC `r:real` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSPACE_SUB THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!x. x IN t ==> ?g. linear g /\ (f':real^N->real^N->real^N) x o g = I /\ g o f' x = I` MP_TAC THENL [REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) MATRIX_INVERTIBLE o snd) THEN REWRITE_TAC[INVERTIBLE_DET_NZ] THEN ASM_MESON_TAC[has_derivative; SUBSET]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g':real^N->real^N->real^N` THEN DISCH_TAC THEN EXISTS_TAC `(g':real^N->real^N->real^N) o (g:real^N->real^N)` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; SUBSET] THEN STRIP_TAC THEN SUBGOAL_THEN `u = IMAGE (f:real^N->real^N) t` SUBST1_TAC THENL [ASM_MESON_TAC[homeomorphism]; ASM_SIMP_TAC[FORALL_IN_IMAGE]] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `(f':real^N->real^N->real^N) x`; `g:real^N->real^N`; `(g':real^N->real^N->real^N) x`; `t:real^N->bool`; `x:real^N`] HAS_DERIVATIVE_INVERSE_WITHIN) THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `IMAGE (f:real^N->real^N) t = u` SUBST1_TAC THENL [ASM_MESON_TAC[homeomorphism]; ALL_TAC] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[HAS_DERIVATIVE_WITHIN_OPEN_IN]] THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_DERIVATIVE_WITHIN_OPEN_IN]; ALL_TAC] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`(\x:real^N. --a + x) o f o (\x. a + x)`; `(f':real^N->real^N->real^N) o (\x. a + x)`; `IMAGE (\x:real^N. --a + x) s`; `IMAGE (\x:real^N. --a + x) p`; `vec 0:real^N`]) THEN ASM_REWRITE_TAC[OPEN_IN_TRANSLATION_EQ] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`; GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC AFFINE_DIFFS_SUBSPACE THEN ASM_MESON_TAC[SUBSET; OPEN_IN_IMP_SUBSET]; REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN TRANS_TAC SUBSET_TRANS `IMAGE (f:real^N->real^N) s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[o_DEF; GSYM IMAGE_o; IMAGE_ID; SUBSET_REFL; VECTOR_ARITH `a + --a + x:real^N = x`]; ASM_REWRITE_TAC[IN_TRANSLATION_GALOIS; VECTOR_ARITH `vec 0 - --a:real^N = a`]; REWRITE_TAC[FORALL_IN_IMAGE; o_THM; VECTOR_ARITH `a + --a + x:real^N = x`] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; I_DEF; VECTOR_ARITH `a + --a + x:real^N = x`]; REWRITE_TAC[I_DEF]] THEN GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST; HAS_DERIVATIVE_ID]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM; VECTOR_ADD_RID]] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`; `g:real^N->real^N`; `g':real^N->real^N->real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`IMAGE (\x:real^N. a + x) t`; `IMAGE (\x:real^N. a + x) u`; `(\x:real^N. a + x) o g o (\x. --a + x)`; `(g':real^N->real^N->real^N) o (\x. --a + x)`] THEN ASM_REWRITE_TAC[IN_TRANSLATION_GALOIS; FORALL_IN_IMAGE; o_THM; VECTOR_SUB_REFL; VECTOR_ARITH `--a + a + x:real^N = x`] THEN ASM_SIMP_TAC[] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `p = IMAGE (\x:real^N. a + x) (IMAGE (\x. --a + x) p)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `a + --a + x:real^N = x`]; ASM_REWRITE_TAC[OPEN_IN_TRANSLATION_EQ]]; ASM_REWRITE_TAC[TRANSLATION_SUBSET_GALOIS_LEFT]; SUBGOAL_THEN `p = IMAGE (\x:real^N. a + x) (IMAGE (\x. --a + x) p)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `a + --a + x:real^N = x`]; ASM_REWRITE_TAC[OPEN_IN_TRANSLATION_EQ]]; ASM_REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN REWRITE_TAC[HOMEOMORPHISM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_TRANSLATION_GALOIS; VECTOR_ADD_SUB; VECTOR_ARITH `--a + a + x:real^N = x`] THEN REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`] THEN SIMP_TAC[VECTOR_ARITH `x - a:real^N = y <=> x = a + y`] THEN STRIP_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `f = (\x:real^N. a + x) o ((\x. --a + x) o f o (\x. a + x)) o (\x. --a + x)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; ETA_AX; VECTOR_ARITH `a + --a + x:real^N = x`]; ALL_TAC]; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN REWRITE_TAC[GSYM IMAGE_o] THEN GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [o_DEF] THEN ASM_REWRITE_TAC[IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `f = (\x:real^N. a + x) o ((\x. --a + x) o f o (\x. a + x)) o (\x. --a + x)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; ETA_AX; VECTOR_ARITH `a + --a + x:real^N = x`]; GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT1(SPEC_ALL I_O_ID))]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT1(SPEC_ALL I_O_ID))]] THEN (MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[I_DEF; VECTOR_ARITH `--a + a + x:real^N = x`]; REWRITE_TAC[I_DEF]] THEN GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST; HAS_DERIVATIVE_ID])]);; (* ------------------------------------------------------------------------- *) (* Considering derivative R(^1)->R^n as a vector. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("has_vector_derivative",(12,"right"));; let has_vector_derivative = new_definition `(f has_vector_derivative f') net <=> (f has_derivative (\x. drop(x) % f')) net`;; let vector_derivative = new_definition `vector_derivative (f:real^1->real^N) net = @f'. (f has_vector_derivative f') net`;; let VECTOR_DERIVATIVE_WORKS = prove (`!net f:real^1->real^N. f differentiable net <=> (f has_vector_derivative (vector_derivative f net)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[vector_derivative] THEN CONV_TAC(RAND_CONV SELECT_CONV) THEN SIMP_TAC[FRECHET_DERIVATIVE_WORKS; has_vector_derivative] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FRECHET_DERIVATIVE_WORKS; differentiable]] THEN DISCH_TAC THEN EXISTS_TAC `column 1 (jacobian (f:real^1->real^N) net)` THEN FIRST_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[jacobian] THEN MATCH_MP_TAC LINEAR_FROM_REALS THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_REWRITE_TAC[]);; let VECTOR_DIFFERENTIABLE = prove (`!f net. f differentiable net <=> (?f'. (f has_vector_derivative f') net)`, MESON_TAC[differentiable; has_vector_derivative; VECTOR_DERIVATIVE_WORKS]);; let HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE = prove (`!f f' net. (f has_vector_derivative f') net ==> f differentiable net`, MESON_TAC[VECTOR_DIFFERENTIABLE]);; let VECTOR_DERIVATIVE_UNIQUE_AT = prove (`!f:real^1->real^N x f' f''. (f has_vector_derivative f') (at x) /\ (f has_vector_derivative f'') (at x) ==> f' = f''`, REWRITE_TAC[has_vector_derivative; drop] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `\x. drop x % (f':real^N)`; `\x. drop x % (f'':real^N)`; `x:real^1`] FRECHET_DERIVATIVE_UNIQUE_AT) THEN ASM_SIMP_TAC[DIMINDEX_1; LE_ANTISYM; drop] THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH; VECTOR_MUL_LID]);; let HAS_VECTOR_DERIVATIVE_UNIQUE_AT = prove (`!f:real^1->real^N f' x. (f has_vector_derivative f') (at x) ==> vector_derivative f (at x) = f'`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^N`; `x:real^1`] THEN ASM_REWRITE_TAC[vector_derivative] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]);; let VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL = prove (`!f:real^1->real^N a b x f' f''. drop a < drop b /\ x IN interval [a,b] /\ (f has_vector_derivative f') (at x within interval [a,b]) /\ (f has_vector_derivative f'') (at x within interval [a,b]) ==> f' = f''`, REWRITE_TAC[has_vector_derivative; drop] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `\x. drop x % (f':real^N)`; `\x. drop x % (f'':real^N)`; `x:real^1`; `a:real^1`; `b:real^1`] FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL) THEN ASM_SIMP_TAC[DIMINDEX_1; LE_ANTISYM; drop] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH; VECTOR_MUL_LID]);; let VECTOR_DERIVATIVE_AT = prove (`(f has_vector_derivative f') (at x) ==> vector_derivative f (at x) = f'`, ASM_MESON_TAC[VECTOR_DERIVATIVE_UNIQUE_AT; VECTOR_DERIVATIVE_WORKS; differentiable; has_vector_derivative]);; let VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL = prove (`!f:real^1->real^N f' x a b. drop a < drop b /\ x IN interval[a,b] /\ (f has_vector_derivative f') (at x within interval [a,b]) ==> vector_derivative f (at x within interval [a,b]) = f'`, ASM_MESON_TAC[VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; VECTOR_DERIVATIVE_WORKS; differentiable; has_vector_derivative]);; let HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET = prove (`!f s t x. (f has_vector_derivative f') (at x within s) /\ t SUBSET s ==> (f has_vector_derivative f') (at x within t)`, REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN_SUBSET]);; let HAS_VECTOR_DERIVATIVE_CONST = prove (`!c net. ((\x. c) has_vector_derivative vec 0) net`, REWRITE_TAC[has_vector_derivative] THEN REWRITE_TAC[VECTOR_MUL_RZERO; HAS_DERIVATIVE_CONST]);; let VECTOR_DERIVATIVE_CONST_AT = prove (`!c:real^N a. vector_derivative (\x. c) (at a) = vec 0`, REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_UNIQUE_AT THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]);; let HAS_VECTOR_DERIVATIVE_ID = prove (`!net. ((\x. x) has_vector_derivative (vec 1)) net`, REWRITE_TAC[has_vector_derivative] THEN SUBGOAL_THEN `(\x. drop x % vec 1) = (\x. x)` (fun th -> REWRITE_TAC[HAS_DERIVATIVE_ID; th]) THEN REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN REAL_ARITH_TAC);; let HAS_VECTOR_DERIVATIVE_CMUL = prove (`!f f' net c. (f has_vector_derivative f') net ==> ((\x. c % f(x)) has_vector_derivative (c % f')) net`, SIMP_TAC[has_vector_derivative] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x = b % a % x`] THEN SIMP_TAC[HAS_DERIVATIVE_CMUL]);; let HAS_VECTOR_DERIVATIVE_CMUL_EQ = prove (`!f f' net c. ~(c = &0) ==> (((\x. c % f(x)) has_vector_derivative (c % f')) net <=> (f has_vector_derivative f') net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_VECTOR_DERIVATIVE_CMUL) THENL [DISCH_THEN(MP_TAC o SPEC `inv(c):real`); DISCH_THEN(MP_TAC o SPEC `c:real`)] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; let HAS_VECTOR_DERIVATIVE_NEG = prove (`!f f' net. (f has_vector_derivative f') net ==> ((\x. --(f(x))) has_vector_derivative (--f')) net`, SIMP_TAC[has_vector_derivative; VECTOR_MUL_RNEG; HAS_DERIVATIVE_NEG]);; let HAS_VECTOR_DERIVATIVE_NEG_EQ = prove (`!f f' net. ((\x. --(f(x))) has_vector_derivative --f') net <=> (f has_vector_derivative f') net`, SIMP_TAC[has_vector_derivative; HAS_DERIVATIVE_NEG_EQ; VECTOR_MUL_RNEG]);; let HAS_VECTOR_DERIVATIVE_ADD = prove (`!f f' g g' net. (f has_vector_derivative f') net /\ (g has_vector_derivative g') net ==> ((\x. f(x) + g(x)) has_vector_derivative (f' + g')) net`, SIMP_TAC[has_vector_derivative; VECTOR_ADD_LDISTRIB; HAS_DERIVATIVE_ADD]);; let HAS_VECTOR_DERIVATIVE_SUB = prove (`!f f' g g' net. (f has_vector_derivative f') net /\ (g has_vector_derivative g') net ==> ((\x. f(x) - g(x)) has_vector_derivative (f' - g')) net`, SIMP_TAC[has_vector_derivative; VECTOR_SUB_LDISTRIB; HAS_DERIVATIVE_SUB]);; let HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN = prove (`!h:real^M->real^N->real^P f g f' g' x s. (f has_vector_derivative f') (at x within s) /\ (g has_vector_derivative g') (at x within s) /\ bilinear h ==> ((\x. h (f x) (g x)) has_vector_derivative (h (f x) g' + h f' (g x))) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_WITHIN) THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear; linear]) THEN ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB]);; let HAS_VECTOR_DERIVATIVE_BILINEAR_AT = prove (`!h:real^M->real^N->real^P f g f' g' x. (f has_vector_derivative f') (at x) /\ (g has_vector_derivative g') (at x) /\ bilinear h ==> ((\x. h (f x) (g x)) has_vector_derivative (h (f x) g' + h f' (g x))) (at x)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_AT) THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear; linear]) THEN ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB]);; let HAS_VECTOR_DERIVATIVE_AT_WITHIN = prove (`!f x s. (f has_vector_derivative f') (at x) ==> (f has_vector_derivative f') (at x within s)`, SIMP_TAC[has_vector_derivative; HAS_DERIVATIVE_AT_WITHIN]);; let HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN = prove (`!f f' g x s d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ (f has_vector_derivative f') (at x within s) ==> (g has_vector_derivative f') (at x within s)`, REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_TRANSFORM_WITHIN]);; let HAS_VECTOR_DERIVATIVE_TRANSFORM_AT = prove (`!f f' g x d. &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ (f has_vector_derivative f') (at x) ==> (g has_vector_derivative f') (at x)`, REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_TRANSFORM_AT]);; let HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove (`!f g s x. open s /\ x IN s /\ (!y. y IN s ==> f y = g y) /\ (f has_vector_derivative f') (at x) ==> (g has_vector_derivative f') (at x)`, REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN]);; let VECTOR_DIFF_CHAIN_AT = prove (`!f g f' g' x. (f has_vector_derivative f') (at x) /\ (g has_vector_derivative g') (at (f x)) ==> ((g o f) has_vector_derivative (drop f' % g')) (at x)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_AT) THEN REWRITE_TAC[o_DEF; DROP_CMUL; GSYM VECTOR_MUL_ASSOC]);; let VECTOR_DIFF_CHAIN_WITHIN = prove (`!f g f' g' s x. (f has_vector_derivative f') (at x within s) /\ (g has_vector_derivative g') (at (f x) within IMAGE f s) ==> ((g o f) has_vector_derivative (drop f' % g')) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_WITHIN) THEN REWRITE_TAC[o_DEF; DROP_CMUL; GSYM VECTOR_MUL_ASSOC]);; let VECTOR_DIFFERENTIABLE_BOUND = prove (`!f f':real^1->real^N s B. convex s /\ (!x. x IN s ==> (f has_vector_derivative f' x) (at x within s)) /\ (!x. x IN s ==> norm (f' x) <= B) ==> (!x y. x IN s /\ y IN s ==> norm (f x - f y) <= B * norm (x - y))`, INTRO_TAC "!f f' s B; cvx diff bound; !x y; x y" THEN MP_TAC (ISPECL [`f:real^1->real^N`; `\x:real^1 h. drop h % f' x : real^N`; `s:real^1->bool`; `B:real`] DIFFERENTIABLE_BOUND) THEN ANTS_TAC THENL [HYP_TAC "diff" (REWRITE_RULE[has_vector_derivative]) THEN HYP REWRITE_TAC "cvx diff" [] THEN INTRO_TAC "![x0]; x0" THEN CLAIM_TAC "lin" `linear (\h. drop h % f' (x0:real^1):real^N)` THENL [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; VECTOR_MUL_ASSOC; VECTOR_ADD_RDISTRIB]; ALL_TAC] THEN HYP_TAC "lin -> _ onorm_le" (REWRITE_RULE[] o MATCH_MP ONORM) THEN REMOVE_THEN "onorm_le" MATCH_MP_TAC THEN FIX_TAC "[h]" THEN REWRITE_TAC[NORM_MUL; GSYM NORM_1] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN HYP SIMP_TAC "x0 bound" [REAL_LE_RMUL; NORM_POS_LE]; DISCH_THEN MATCH_MP_TAC THEN HYP REWRITE_TAC "x y" []]);; let HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_LIPSCHITZ = prove (`!f:real^1->real^N f' s. (!x. x IN s ==> (f has_vector_derivative f'(x)) (at x within s)) /\ convex s /\ bounded(IMAGE f' s) ==> ?B. &0 < B /\ !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm (x - y)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VECTOR_DIFFERENTIABLE_BOUND THEN ASM_MESON_TAC[]);; let RESTRICTION_HAS_DERIVATIVE = prove (`!f:real^1->real^N f' s x. x IN s ==> ((RESTRICTION s f has_vector_derivative f') (at x within s) <=> (f has_vector_derivative f') (at x within s))`, INTRO_TAC "!f f' s x; x" THEN EQ_TAC THENL [INTRO_TAC "hp" THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`RESTRICTION s f:real^1->real^N`; `&1`] THEN ASM_REWRITE_TAC[REAL_LT_01] THEN SIMP_TAC[RESTRICTION]; INTRO_TAC "hp" THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^N`; `&1`] THEN ASM_REWRITE_TAC[REAL_LT_01] THEN SIMP_TAC[RESTRICTION]]);; let HAS_VECTOR_DERIVATIVE_WITHIN_1D = prove (`!f:real^1->real^N s x. (f has_vector_derivative f') (at x within s) <=> ((\y. inv(drop(y - x)) % (f y - f x)) --> f') (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative; has_derivative_within] THEN SIMP_TAC[LINEAR_VMUL_DROP; LINEAR_ID] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [LIM_NULL] THEN GEN_REWRITE_TAC LAND_CONV [LIM_NULL_NORM] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[NORM_1; GSYM REAL_ABS_INV] THEN REWRITE_TAC[GSYM NORM_1; GSYM NORM_MUL] THEN REWRITE_TAC[GSYM LIM_NULL_NORM] THEN MATCH_MP_TAC LIM_TRANSFORM_EQ THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN REWRITE_TAC[GSYM DIST_NZ; VECTOR_SUB_EQ] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_SUB_LDISTRIB] THEN SIMP_TAC[VECTOR_MUL_ASSOC; DROP_SUB; DROP_EQ; REAL_MUL_LINV; REAL_SUB_0] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH);; let HAS_VECTOR_DERIVATIVE_AT_1D = prove (`!f:real^1->real^N x. (f has_vector_derivative f') (at x) <=> ((\y. inv(drop(y - x)) % (f y - f x)) --> f') (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_1D]);; let BAIRE1_VECTOR_DERIVATIVE = prove (`!f:real^1->real^N f' s. (!x. x IN s ==> (f has_vector_derivative f'(x)) (at x)) /\ open s ==> baire 1 s f'`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[BAIRE_COMPONENTWISE] THEN REWRITE_TAC[has_vector_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] BAIRE1_PARTIAL_DERIVATIVES)) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[DIMINDEX_1; FORALL_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] BAIRE_EQ) THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[GSYM drop; LIFT_DROP; matrix] THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; CART_EQ; FORALL_1; DIMINDEX_1; DROP_BASIS] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Bounds on derivatives from function properties. *) (* ------------------------------------------------------------------------- *) let VECTOR_DERIVATIVE_INCREASING_WITHIN = prove (`!f f' s a. (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ a IN s /\ a limit_point_of s /\ (f has_vector_derivative f') (at a within s) ==> &0 <= drop f'`, REWRITE_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_1D] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] LIM_DROP_LBOUND)) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; DROP_CMUL; DROP_SUB] THEN X_GEN_TAC `b:real^1` THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `drop a <= drop b \/ drop b <= drop a`) THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN SIMP_TAC[REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_SUB_LE]);; let NORM_VECTOR_DERIVATIVES_LE_WITHIN = prove (`!f:real^1->real^M g:real^1->real^N f' g' x s. x limit_point_of s /\ (f has_vector_derivative f') (at x within s) /\ (g has_vector_derivative g') (at x within s) /\ eventually (\y. norm(f y - f x) <= norm(g y - g x)) (at x within s) ==> norm f' <= norm g'`, REWRITE_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_1D] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC BINOP_CONV [GSYM LIFT_DROP] THEN MATCH_MP_TAC(ISPEC `at (x:real^1) within s` LIM_DROP_LE) THEN MAP_EVERY EXISTS_TAC [`\y. lift(norm(inv(drop(y - x)) % (f y - f x:real^M)))`; `\y. lift(norm(inv(drop(y - x)) % (g y - g x:real^N)))`] THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_WITHIN; LIM_NORM] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN SIMP_TAC[NORM_MUL; LIFT_DROP; REAL_LE_LMUL; REAL_ABS_POS]);; let NORM_VECTOR_DERIVATIVES_LE_AT = prove (`!f:real^1->real^M g:real^1->real^N f' g' x. (f has_vector_derivative f') (at x) /\ (g has_vector_derivative g') (at x) /\ eventually (\y. norm(f y - f x) <= norm(g y - g x)) (at x) ==> norm f' <= norm g'`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_VECTOR_DERIVATIVES_LE_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^M`; `g:real^1->real^N`; `x:real^1`; `(:real^1)`] THEN ASM_REWRITE_TAC[LIMPT_OF_UNIV; WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Various versions of Kachurovskii's theorem. *) (* ------------------------------------------------------------------------- *) let CONVEX_ON_DERIVATIVE_SECANT_IMP = prove (`!f f' s x y:real^N. f convex_on s /\ segment[x,y] SUBSET s /\ ((lift o f) has_derivative (lift o f')) (at x within s) ==> f'(y - x) <= f y - f x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(x:real^N) IN s /\ (y:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_derivative_within]) THEN REWRITE_TAC[LIM_WITHIN; DIST_0; o_THM] THEN REWRITE_TAC[GSYM LIFT_ADD; GSYM LIFT_SUB; GSYM LIFT_CMUL; NORM_LIFT] THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^N = x` THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_0) THEN REWRITE_TAC[o_THM; VECTOR_SUB_REFL; GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_SUB_REFL; REAL_LE_REFL; VECTOR_SUB_REFL]; ALL_TAC] THEN ABBREV_TAC `e = (f':real^N->real)(y - x) - (f y - f x)` THEN ASM_CASES_TAC `&0 < e` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / norm(y - x:real^N)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ABBREV_TAC `u = min (&1 / &2) (d / &2 / norm (y - x:real^N))` THEN SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_HALF; VECTOR_SUB_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ABBREV_TAC `z:real^N = (&1 - u) % x + u % y` THEN SUBGOAL_THEN `(z:real^N) IN segment(x,y)` MP_TAC THENL [ASM_MESON_TAC[IN_SEGMENT]; ALL_TAC] THEN SIMP_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `z:real^N`) THEN SUBGOAL_THEN `(z:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [ASM_SIMP_TAC[DIST_POS_LT] THEN EXPAND_TAC "z" THEN REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH `((&1 - u) % x + u % y) - x:real^N = u % (y - x)`] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ON_LEFT_SECANT]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`; `z:real^N`]) THEN ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN SIMP_TAC[REAL_ARITH `inv y * (z - (x + d)):real = (z - x) / y - d / y`] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `z <= y / n /\ abs(z - d) < e / n ==> d <= (y + e) / n`)) THEN SUBGOAL_THEN `(f':real^N->real)(z - x) / norm(z - x) = f'(y - x) / norm(y - x)` SUBST1_TAC THENL [EXPAND_TAC "z" THEN REWRITE_TAC[VECTOR_ARITH `((&1 - u) % x + u % y) - x:real^N = u % (y - x)`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_CMUL) THEN DISCH_THEN(MP_TAC o SPECL [`u:real`; `y - x:real^N`]) THEN ASM_REWRITE_TAC[GSYM LIFT_CMUL; o_THM; LIFT_EQ] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LE_DIV2_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let CONVEX_ON_SECANT_DERIVATIVE_IMP = prove (`!f f' s x y:real^N. f convex_on s /\ segment[x,y] SUBSET s /\ ((lift o f) has_derivative (lift o f')) (at y within s) ==> f y - f x <= f'(y - x)`, ONCE_REWRITE_TAC[SEGMENT_SYM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `f':real^N->real`; `s:real^N->bool`; `y:real^N`; `x:real^N`] CONVEX_ON_DERIVATIVE_SECANT_IMP) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN MATCH_MP_TAC(REAL_ARITH `f' = --f'' ==> f' <= x - y ==> y - x <= f''`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_NEG_SUB] THEN GEN_REWRITE_TAC I [GSYM LIFT_EQ] THEN REWRITE_TAC[LIFT_NEG] THEN SPEC_TAC(`y - x:real^N`,`z:real^N`) THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_FORALL_IMP_THM] LINEAR_NEG) THEN REWRITE_TAC[GSYM o_DEF] THEN ASM_MESON_TAC[has_derivative]);; let CONVEX_ON_DERIVATIVES_IMP = prove (`!f f'x f'y s x y:real^N. f convex_on s /\ segment[x,y] SUBSET s /\ ((lift o f) has_derivative (lift o f'x)) (at x within s) /\ ((lift o f) has_derivative (lift o f'y)) (at y within s) ==> f'x(y - x) <= f'y(y - x)`, ASM_MESON_TAC[CONVEX_ON_DERIVATIVE_SECANT_IMP; CONVEX_ON_SECANT_DERIVATIVE_IMP; SEGMENT_SYM; REAL_LE_TRANS]);; let CONVEX_ON_DERIVATIVE_SECANT,CONVEX_ON_DERIVATIVES = (CONJ_PAIR o prove) (`(!f f' s:real^N->bool. convex s /\ (!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x))) (at x within s)) ==> (f convex_on s <=> !x y. x IN s /\ y IN s ==> f'(x)(y - x) <= f y - f x)) /\ (!f f' s:real^N->bool. convex s /\ (!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x))) (at x within s)) ==> (f convex_on s <=> !x y. x IN s /\ y IN s ==> f'(x)(y - x) <= f'(y)(y - x)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (b ==> c) /\ (c ==> a) ==> (a <=> b) /\ (a <=> c)`) THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_ON_DERIVATIVE_SECANT_IMP THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[ETA_AX] THEN ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`x:real^N`; `y:real^N`] th) THEN MP_TAC(ISPECL [`y:real^N`; `x:real^N`] th)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `f''' = --f'' ==> f''' <= x - y ==> f' <= y - x ==> f' <= f''`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_NEG_SUB] THEN GEN_REWRITE_TAC I [GSYM LIFT_EQ] THEN REWRITE_TAC[LIFT_NEG] THEN SPEC_TAC(`y - x:real^N`,`z:real^N`) THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_FORALL_IMP_THM] LINEAR_NEG) THEN REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM I_DEF; I_O_ID] THEN ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[convex_on] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN REWRITE_TAC[IMP_CONJ; REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN REWRITE_TAC[FORALL_UNWIND_THM2; REAL_SUB_LE] THEN X_GEN_TAC `u:real` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `u = &0` THEN ASM_SIMP_TAC[REAL_SUB_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_LE_REFL; REAL_MUL_LZERO; REAL_MUL_LID; VECTOR_ADD_RID; REAL_ADD_RID] THEN ASM_CASES_TAC `u = &1` THEN ASM_SIMP_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_LE_REFL; REAL_MUL_LZERO; REAL_MUL_LID; VECTOR_ADD_LID; REAL_ADD_LID] THEN SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`lift o (f:real^N->real) o (\u. (&1 - drop u) % a + drop u % b)`; `\x:real^1. lift o f'((&1 - drop x) % a + drop x % b) o (\u. --(drop u) % a + drop u % b:real^N)`] MVT_VERY_SIMPLE) THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`vec 0:real^1`; `lift u`] th) THEN MP_TAC(ISPECL [`lift u`; `vec 1:real^1`] th)) THEN ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN ASM_SIMP_TAC[DROP_VEC; VECTOR_MUL_LZERO; REAL_SUB_RZERO; REAL_LT_IMP_LE; VECTOR_ADD_RID; VECTOR_MUL_LID; VECTOR_SUB_RZERO] THEN MATCH_MP_TAC(TAUT `(a1 /\ a2) /\ (b1 ==> b2 ==> c) ==> (a1 ==> b1) ==> (a2 ==> b2) ==> c`) THEN CONJ_TAC THENL [CONJ_TAC THEN X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN (REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[VECTOR_ARITH `(&1 - a) % x:real^N = x + --a % x`; VECTOR_ARITH `--u % a:real^N = vec 0 + --u % a`] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST]; ALL_TAC] THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC; MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN DISCH_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; LIFT_DROP; DROP_VEC]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]); REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ] THEN REWRITE_TAC[DROP_SUB; DROP_VEC; LIFT_DROP] THEN REWRITE_TAC[VECTOR_ARITH `--u % a + u % b:real^N = u % (b - a)`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`w:real`; `v:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> b ==> a ==> c ==> d`] THEN STRIP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o AP_TERM `(*) (u:real)`) (MP_TAC o AP_TERM `(*) (&1 - u:real)`)) THEN MATCH_MP_TAC(REAL_ARITH `f1 <= f2 /\ (xa <= xb ==> a <= b) ==> xa = f1 ==> xb = f2 ==> a <= b`) THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN SUBGOAL_THEN `((&1 - v) % a + v % b:real^N) IN s /\ ((&1 - w) % a + w % b:real^N) IN s` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `linear(lift o (f'((&1 - v) % a + v % b:real^N):real^N->real)) /\ linear(lift o (f'((&1 - w) % a + w % b:real^N):real^N->real))` MP_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LINEAR_CMUL)) THEN ASM_REWRITE_TAC[o_THM; GSYM LIFT_NEG; GSYM LIFT_CMUL; LIFT_EQ] THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `(&1 - u) * u * x = u * (&1 - u) * x`] THEN REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(&1 - v) % a + v % b:real^N`; `(&1 - w) % a + w % b:real^N`]) THEN ASM_REWRITE_TAC[VECTOR_ARITH `((&1 - v) % a + v % b) - ((&1 - w) % a + w % b):real^N = (v - w) % (b - a)`] THEN ASM_CASES_TAC `v:real = w` THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN SUBGOAL_THEN `&0 < w - v` (fun th -> SIMP_TAC[th; REAL_LE_LMUL_EQ]) THEN ASM_REAL_ARITH_TAC]);; let CONVEX_ON_SECANT_DERIVATIVE = prove (`!f f' s:real^N->bool. convex s /\ (!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x))) (at x within s)) ==> (f convex_on s <=> !x y. x IN s /\ y IN s ==> f y - f x <= f'(y)(y - x))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT) THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[] THEN MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(y:real^N) IN s`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `f' = --f'' ==> (f' <= y - x <=> x - y <= f'')`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_NEG_SUB] THEN GEN_REWRITE_TAC I [GSYM LIFT_EQ] THEN REWRITE_TAC[LIFT_NEG] THEN SPEC_TAC(`x - y:real^N`,`z:real^N`) THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_FORALL_IMP_THM] LINEAR_NEG) THEN REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM I_DEF; I_O_ID] THEN ASM_MESON_TAC[has_derivative]);; hol-light/Multivariate/determinants.ml000066400000000000000000006507611303454263000204610ustar00rootroot00000000000000(* ========================================================================= *) (* Determinant and trace of a square matrix. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* ========================================================================= *) needs "Multivariate/vectors.ml";; needs "Library/permutations.ml";; needs "Library/floor.ml";; needs "Library/products.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Trace of a matrix (this is relatively easy). *) (* ------------------------------------------------------------------------- *) let trace = new_definition `(trace:real^N^N->real) A = sum(1..dimindex(:N)) (\i. A$i$i)`;; let TRACE_0 = prove (`trace(mat 0) = &0`, SIMP_TAC[trace; mat; LAMBDA_BETA; SUM_0]);; let TRACE_I = prove (`trace(mat 1 :real^N^N) = &(dimindex(:N))`, SIMP_TAC[trace; mat; LAMBDA_BETA; SUM_CONST_NUMSEG; REAL_MUL_RID] THEN AP_TERM_TAC THEN ARITH_TAC);; let TRACE_ADD = prove (`!A B:real^N^N. trace(A + B) = trace(A) + trace(B)`, SIMP_TAC[trace; matrix_add; SUM_ADD_NUMSEG; LAMBDA_BETA]);; let TRACE_SUB = prove (`!A B:real^N^N. trace(A - B) = trace(A) - trace(B)`, SIMP_TAC[trace; matrix_sub; SUM_SUB_NUMSEG; LAMBDA_BETA]);; let TRACE_CMUL = prove (`!c A:real^N^N. trace(c %% A) = c * trace A`, REWRITE_TAC[trace; MATRIX_CMUL_COMPONENT; SUM_LMUL]);; let TRACE_NEG = prove (`!A:real^N^N. trace(--A) = --(trace A)`, REWRITE_TAC[trace; MATRIX_NEG_COMPONENT; SUM_NEG]);; let TRACE_MUL_SYM = prove (`!A B:real^N^M. trace(A ** B) = trace(B ** A)`, REPEAT GEN_TAC THEN SIMP_TAC[trace; matrix_mul; LAMBDA_BETA] THEN GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_SYM]);; let TRACE_TRANSP = prove (`!A:real^N^N. trace(transp A) = trace A`, SIMP_TAC[trace; transp; LAMBDA_BETA]);; let TRACE_SIMILAR = prove (`!A:real^N^N U:real^N^N. invertible U ==> trace(matrix_inv U ** A ** U) = trace A`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV; MATRIX_MUL_RID]);; let TRACE_MUL_CYCLIC = prove (`!A:real^P^M B C:real^M^N. trace(A ** B ** C) = trace(B ** C ** A)`, REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [TRACE_MUL_SYM] THEN REWRITE_TAC[MATRIX_MUL_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Definition of determinant. *) (* ------------------------------------------------------------------------- *) let det = new_definition `det(A:real^N^N) = sum { p | p permutes 1..dimindex(:N) } (\p. sign(p) * product (1..dimindex(:N)) (\i. A$i$(p i)))`;; (* ------------------------------------------------------------------------- *) (* A few general lemmas we need below. *) (* ------------------------------------------------------------------------- *) let IN_DIMINDEX_SWAP = prove (`!m n j. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> 1 <= swap(m,n) j /\ swap(m,n) j <= dimindex(:N)`, REWRITE_TAC[swap] THEN ARITH_TAC);; let LAMBDA_BETA_PERM = prove (`!p i. p permutes 1..dimindex(:N) /\ 1 <= i /\ i <= dimindex(:N) ==> ((lambda) g :A^N) $ p(i) = g(p i)`, ASM_MESON_TAC[LAMBDA_BETA; PERMUTES_IN_IMAGE; IN_NUMSEG]);; let PRODUCT_PERMUTE = prove (`!f p s. p permutes s ==> product s f = product s (f o p)`, REWRITE_TAC[product] THEN MATCH_MP_TAC ITERATE_PERMUTE THEN REWRITE_TAC[MONOIDAL_REAL_MUL]);; let PRODUCT_PERMUTE_NUMSEG = prove (`!f p m n. p permutes m..n ==> product(m..n) f = product(m..n) (f o p)`, MESON_TAC[PRODUCT_PERMUTE; FINITE_NUMSEG]);; let REAL_MUL_SUM = prove (`!s t f g. FINITE s /\ FINITE t ==> sum s f * sum t g = sum s (\i. sum t (\j. f(i) * g(j)))`, SIMP_TAC[SUM_LMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[SUM_LMUL]);; let REAL_MUL_SUM_NUMSEG = prove (`!m n p q. sum(m..n) f * sum(p..q) g = sum(m..n) (\i. sum(p..q) (\j. f(i) * g(j)))`, SIMP_TAC[REAL_MUL_SUM; FINITE_NUMSEG]);; (* ------------------------------------------------------------------------- *) (* Basic determinant properties. *) (* ------------------------------------------------------------------------- *) let DET_CMUL = prove (`!A:real^N^N c. det(c %% A) = c pow dimindex(:N) * det A`, REPEAT GEN_TAC THEN SIMP_TAC[det; MATRIX_CMUL_COMPONENT; PRODUCT_MUL; FINITE_NUMSEG] THEN SIMP_TAC[PRODUCT_CONST_NUMSEG_1; GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_AC]);; let DET_NEG = prove (`!A:real^N^N. det(--A) = --(&1) pow dimindex(:N) * det A`, REWRITE_TAC[MATRIX_NEG_MINUS1; DET_CMUL]);; let DET_TRANSP = prove (`!A:real^N^N. det(transp A) = det A`, GEN_TAC THEN REWRITE_TAC[det] THEN GEN_REWRITE_TAC LAND_CONV [SUM_PERMUTATIONS_INVERSE] THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN BINOP_TAC THENL [ASM_MESON_TAC[SIGN_INVERSE; PERMUTATION_PERMUTES; FINITE_NUMSEG]; ALL_TAC] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM(MATCH_MP PERMUTES_IMAGE th)]) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `product(1..dimindex(:N)) ((\i. (transp A:real^N^N)$i$inverse p(i)) o p)` THEN CONJ_TAC THENL [MATCH_MP_TAC PRODUCT_IMAGE THEN ASM_MESON_TAC[FINITE_NUMSEG; PERMUTES_INJECTIVE; PERMUTES_INVERSE]; MATCH_MP_TAC PRODUCT_EQ THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN SIMP_TAC[transp; LAMBDA_BETA; o_THM] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN SIMP_TAC[FUN_EQ_THM; I_THM; o_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[PERMUTES_IN_NUMSEG; LAMBDA_BETA_PERM; LAMBDA_BETA]]);; let DET_LOWERTRIANGULAR = prove (`!A:real^N^N. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ i < j ==> A$i$j = &0) ==> det(A) = product(1..dimindex(:N)) (\i. A$i$i)`, REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {I} (\p. sign p * product(1..dimindex(:N)) (\i. (A:real^N^N)$i$p(i)))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_SING; SIGN_I; REAL_MUL_LID; I_THM]] THEN MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[IN_SING; FINITE_RULES; SUBSET; IN_ELIM_THM; PERMUTES_I] THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_ENTIRE; SIGN_NZ] THEN MP_TAC(SPECL [`p:num->num`; `1..dimindex(:N)`] PERMUTES_NUMSET_LE) THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; NOT_LT]);; let DET_UPPERTRIANGULAR = prove (`!A:real^N^N. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ j < i ==> A$i$j = &0) ==> det(A) = product(1..dimindex(:N)) (\i. A$i$i)`, REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {I} (\p. sign p * product(1..dimindex(:N)) (\i. (A:real^N^N)$i$p(i)))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_SING; SIGN_I; REAL_MUL_LID; I_THM]] THEN MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[IN_SING; FINITE_RULES; SUBSET; IN_ELIM_THM; PERMUTES_I] THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_ENTIRE; SIGN_NZ] THEN MP_TAC(SPECL [`p:num->num`; `1..dimindex(:N)`] PERMUTES_NUMSET_GE) THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; NOT_LT]);; let DET_I = prove (`det(mat 1 :real^N^N) = &1`, MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `product(1..dimindex(:N)) (\i. (mat 1:real^N^N)$i$i)` THEN CONJ_TAC THENL [MATCH_MP_TAC DET_LOWERTRIANGULAR; MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG] THEN SIMP_TAC[mat; LAMBDA_BETA] THEN MESON_TAC[LT_REFL]);; let DET_0 = prove (`det(mat 0 :real^N^N) = &0`, MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `product(1..dimindex(:N)) (\i. (mat 0:real^N^N)$i$i)` THEN CONJ_TAC THENL [MATCH_MP_TAC DET_LOWERTRIANGULAR; REWRITE_TAC[PRODUCT_EQ_0_NUMSEG] THEN EXISTS_TAC `1`] THEN SIMP_TAC[mat; LAMBDA_BETA; COND_ID; DIMINDEX_GE_1; LE_REFL]);; let DET_PERMUTE_ROWS = prove (`!A:real^N^N p. p permutes 1..dimindex(:N) ==> det(lambda i. A$p(i)) = sign(p) * det(A)`, REWRITE_TAC[det] THEN SIMP_TAC[LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN SIMP_TAC[GSYM SUM_LMUL; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [MATCH_MP SUM_PERMUTATIONS_COMPOSE_R th]) THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `q:num->num` THEN REWRITE_TAC[IN_ELIM_THM; REAL_MUL_ASSOC] THEN DISCH_TAC THEN BINOP_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_MESON_TAC[SIGN_COMPOSE; PERMUTATION_PERMUTES; FINITE_NUMSEG]; ALL_TAC] THEN MP_TAC(MATCH_MP PERMUTES_INVERSE (ASSUME `p permutes 1..dimindex(:N)`)) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [MATCH_MP PRODUCT_PERMUTE_NUMSEG th]) THEN MATCH_MP_TAC PRODUCT_EQ THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[PERMUTES_INVERSES]);; let DET_PERMUTE_COLUMNS = prove (`!A:real^N^N p. p permutes 1..dimindex(:N) ==> det((lambda i j. A$i$p(j)):real^N^N) = sign(p) * det(A)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM DET_TRANSP] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC [GSYM(MATCH_MP DET_PERMUTE_ROWS th)]) THEN GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; LAMBDA_BETA_PERM]);; let DET_IDENTICAL_ROWS = prove (`!A:real^N^N i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) /\ row i A = row j A ==> det A = &0`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`A:real^N^N`; `swap(i:num,j:num)`] DET_PERMUTE_ROWS) THEN ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; SIGN_SWAP] THEN MATCH_MP_TAC(REAL_ARITH `a = b ==> b = -- &1 * a ==> a = &0`) THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN SIMP_TAC[row; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[swap] THEN ASM_MESON_TAC[]);; let DET_IDENTICAL_COLUMNS = prove (`!A:real^N^N i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) /\ column i A = column j A ==> det A = &0`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DET_TRANSP] THEN MATCH_MP_TAC DET_IDENTICAL_ROWS THEN ASM_MESON_TAC[ROW_TRANSP]);; let DET_ZERO_ROW = prove (`!A:real^N^N i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> det A = &0`, SIMP_TAC[det; row; CART_EQ; LAMBDA_BETA; VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN REWRITE_TAC[IN_ELIM_THM; REAL_ENTIRE; SIGN_NZ] THEN REPEAT STRIP_TAC THEN SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]);; let DET_ZERO_COLUMN = prove (`!A:real^N^N i. 1 <= i /\ i <= dimindex(:N) /\ column i A = vec 0 ==> det A = &0`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DET_TRANSP] THEN MATCH_MP_TAC DET_ZERO_ROW THEN ASM_MESON_TAC[ROW_TRANSP]);; let DET_ROW_ADD = prove (`!a b c k. 1 <= k /\ k <= dimindex(:N) ==> det((lambda i. if i = k then a + b else c i):real^N^N) = det((lambda i. if i = k then a else c i):real^N^N) + det((lambda i. if i = k then b else c i):real^N^N)`, SIMP_TAC[det; LAMBDA_BETA; GSYM SUM_ADD; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN AP_TERM_TAC THEN SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN MATCH_MP_TAC(REAL_RING `c = a + b /\ y = x:real /\ z = x ==> c * x = a * y + b * z`) THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE; FINITE_DELETE; FINITE_NUMSEG]);; let DET_ROW_MUL = prove (`!a b c k. 1 <= k /\ k <= dimindex(:N) ==> det((lambda i. if i = k then c % a else b i):real^N^N) = c * det((lambda i. if i = k then a else b i):real^N^N)`, SIMP_TAC[det; LAMBDA_BETA; GSYM SUM_LMUL; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN MATCH_MP_TAC(REAL_RING `cp = c * p /\ p1 = p2:real ==> s * cp * p1 = c * s * p * p2`) THEN REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE; FINITE_DELETE; FINITE_NUMSEG]);; let DET_ROW_OPERATION = prove (`!A:real^N^N i. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> det(lambda k. if k = i then row i A + c % row j A else row k A) = det A`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DET_ROW_ADD; DET_ROW_MUL] THEN MATCH_MP_TAC(REAL_RING `a = b /\ d = &0 ==> a + c * d = b`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ]; MATCH_MP_TAC DET_IDENTICAL_ROWS THEN MAP_EVERY EXISTS_TAC [`i:num`; `j:num`] THEN ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ]]);; let DET_ROW_SPAN = prove (`!A:real^N^N i x. 1 <= i /\ i <= dimindex(:N) /\ x IN span {row j A | 1 <= j /\ j <= dimindex(:N) /\ ~(j = i)} ==> det(lambda k. if k = i then row i A + x else row k A) = det A`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL [AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_RID] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[row; LAMBDA_BETA]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `j:num`) (SUBST_ALL_TAC o SYM)) THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a + c % x + y:real^N = (a + y) + c % x`] THEN ABBREV_TAC `z = row i (A:real^N^N) + y` THEN ASM_SIMP_TAC[DET_ROW_MUL; DET_ROW_ADD] THEN MATCH_MP_TAC(REAL_RING `d = &0 ==> a + c * d = a`) THEN MATCH_MP_TAC DET_IDENTICAL_ROWS THEN MAP_EVERY EXISTS_TAC [`i:num`; `j:num`] THEN ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ]);; (* ------------------------------------------------------------------------- *) (* May as well do this, though it's a bit unsatisfactory since it ignores *) (* exact duplicates by considering the rows/columns as a set. *) (* ------------------------------------------------------------------------- *) let DET_DEPENDENT_ROWS = prove (`!A:real^N^N. dependent(rows A) ==> det A = &0`, GEN_TAC THEN REWRITE_TAC[dependent; rows; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_CASES_TAC `?i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) /\ row i (A:real^N^N) = row j A` THENL [ASM_MESON_TAC[DET_IDENTICAL_ROWS]; ALL_TAC] THEN MP_TAC(SPECL [`A:real^N^N`; `i:num`; `--(row i (A:real^N^N))`] DET_ROW_SPAN) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_NEG THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN]) THEN MATCH_MP_TAC(TAUT `a = b ==> a ==> b`) THEN REWRITE_TAC[IN] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DELETE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DET_ZERO_ROW THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC]);; let DET_DEPENDENT_COLUMNS = prove (`!A:real^N^N. dependent(columns A) ==> det A = &0`, MESON_TAC[DET_DEPENDENT_ROWS; ROWS_TRANSP; DET_TRANSP]);; (* ------------------------------------------------------------------------- *) (* Multilinearity and the multiplication formula. *) (* ------------------------------------------------------------------------- *) let DET_LINEAR_ROW_VSUM = prove (`!a c s k. FINITE s /\ 1 <= k /\ k <= dimindex(:N) ==> det((lambda i. if i = k then vsum s a else c i):real^N^N) = sum s (\j. det((lambda i. if i = k then a(j) else c i):real^N^N))`, GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DET_ROW_ADD] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DET_ZERO_ROW THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ; VEC_COMPONENT]);; let BOUNDED_FUNCTIONS_BIJECTIONS_1 = prove (`!p. p IN {(y,g) | y IN s /\ g IN {f | (!i. 1 <= i /\ i <= k ==> f i IN s) /\ (!i. ~(1 <= i /\ i <= k) ==> f i = i)}} ==> (\(y,g) i. if i = SUC k then y else g(i)) p IN {f | (!i. 1 <= i /\ i <= SUC k ==> f i IN s) /\ (!i. ~(1 <= i /\ i <= SUC k) ==> f i = i)} /\ (\h. h(SUC k),(\i. if i = SUC k then i else h(i))) ((\(y,g) i. if i = SUC k then y else g(i)) p) = p`, REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`y:num`; `h:num->num`] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[LE]; ASM_MESON_TAC[LE; ARITH_RULE `~(1 <= i /\ i <= SUC k) ==> ~(i = SUC k)`]; REWRITE_TAC[PAIR_EQ; FUN_EQ_THM] THEN ASM_MESON_TAC[ARITH_RULE `~(SUC k <= k)`]]);; let BOUNDED_FUNCTIONS_BIJECTIONS_2 = prove (`!h. h IN {f | (!i. 1 <= i /\ i <= SUC k ==> f i IN s) /\ (!i. ~(1 <= i /\ i <= SUC k) ==> f i = i)} ==> (\h. h(SUC k),(\i. if i = SUC k then i else h(i))) h IN {(y,g) | y IN s /\ g IN {f | (!i. 1 <= i /\ i <= k ==> f i IN s) /\ (!i. ~(1 <= i /\ i <= k) ==> f i = i)}} /\ (\(y,g) i. if i = SUC k then y else g(i)) ((\h. h(SUC k),(\i. if i = SUC k then i else h(i))) h) = h`, REWRITE_TAC[IN_ELIM_PAIR_THM] THEN CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `h:num->num` THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; ASM_MESON_TAC[ARITH_RULE `i <= k ==> i <= SUC k /\ ~(i = SUC k)`]; ASM_MESON_TAC[ARITH_RULE `i <= SUC k /\ ~(i = SUC k) ==> i <= k`]; REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[LE_REFL]]);; let FINITE_BOUNDED_FUNCTIONS = prove (`!s k. FINITE s ==> FINITE {f | (!i. 1 <= i /\ i <= k ==> f(i) IN s) /\ (!i. ~(1 <= i /\ i <= k) ==> f(i) = i)}`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN SIMP_TAC[GSYM FUN_EQ_THM; SET_RULE `{x | x = y} = {y}`; FINITE_RULES]; ALL_TAC] THEN UNDISCH_TAC `FINITE(s:num->bool)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP FINITE_PRODUCT) THEN DISCH_THEN(MP_TAC o ISPEC `\(y:num,g) i. if i = SUC k then y else g(i)` o MATCH_MP FINITE_IMAGE) THEN MATCH_MP_TAC(TAUT `a = b ==> a ==> b`) THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN X_GEN_TAC `h:num->num` THEN EQ_TAC THENL [STRIP_TAC THEN ASM_SIMP_TAC[BOUNDED_FUNCTIONS_BIJECTIONS_1]; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `(\h. h(SUC k),(\i. if i = SUC k then i else h(i))) h` THEN PURE_ONCE_REWRITE_TAC[CONJ_SYM] THEN CONV_TAC (RAND_CONV SYM_CONV) THEN MATCH_MP_TAC BOUNDED_FUNCTIONS_BIJECTIONS_2 THEN ASM_REWRITE_TAC[]);; let DET_LINEAR_ROWS_VSUM_LEMMA = prove (`!s k a c. FINITE s /\ k <= dimindex(:N) ==> det((lambda i. if i <= k then vsum s (a i) else c i):real^N^N) = sum {f | (!i. 1 <= i /\ i <= k ==> f(i) IN s) /\ !i. ~(1 <= i /\ i <= k) ==> f(i) = i} (\f. det((lambda i. if i <= k then a i (f i) else c i) :real^N^N))`, let lemma = prove (`(lambda i. if i <= 0 then x(i) else y(i)) = (lambda i. y i)`, SIMP_TAC[CART_EQ; ARITH; LAMBDA_BETA; ARITH_RULE `1 <= k ==> ~(k <= 0)`]) in ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[lemma; LE_0] THEN GEN_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN REWRITE_TAC[GSYM FUN_EQ_THM; SET_RULE `{x | x = y} = {y}`] THEN REWRITE_TAC[SUM_SING]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[ARITH_RULE `SUC k <= n ==> k <= n`] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LE] THEN REWRITE_TAC[TAUT `(if a \/ b then c else d) = (if a then c else if b then c else d)`] THEN ASM_SIMP_TAC[DET_LINEAR_ROW_VSUM; ARITH_RULE `1 <= SUC k`] THEN ONCE_REWRITE_TAC[TAUT `(if a then b else if c then d else e) = (if c then (if a then b else d) else (if a then b else e))`] THEN ASM_SIMP_TAC[ARITH_RULE `i <= k ==> ~(i = SUC k)`] THEN ASM_SIMP_TAC[SUM_SUM_PRODUCT; FINITE_BOUNDED_FUNCTIONS] THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN EXISTS_TAC `\(y:num,g) i. if i = SUC k then y else g(i)` THEN EXISTS_TAC `\h. h(SUC k),(\i. if i = SUC k then i else h(i))` THEN CONJ_TAC THENL [ACCEPT_TAC BOUNDED_FUNCTIONS_BIJECTIONS_2; ALL_TAC] THEN X_GEN_TAC `p:num#(num->num)` THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP BOUNDED_FUNCTIONS_BIJECTIONS_1) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`p:num#(num->num)`,`q:num#(num->num)`) THEN REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MAP_EVERY X_GEN_TAC [`y:num`; `g:num->num`] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_MESON_TAC[LE; ARITH_RULE `~(SUC k <= k)`]);; let DET_LINEAR_ROWS_VSUM = prove (`!s a. FINITE s ==> det((lambda i. vsum s (a i)):real^N^N) = sum {f | (!i. 1 <= i /\ i <= dimindex(:N) ==> f(i) IN s) /\ !i. ~(1 <= i /\ i <= dimindex(:N)) ==> f(i) = i} (\f. det((lambda i. a i (f i)):real^N^N))`, let lemma = prove (`(lambda i. if i <= dimindex(:N) then x(i) else y(i)):real^N^N = (lambda i. x(i))`, SIMP_TAC[CART_EQ; LAMBDA_BETA]) in REPEAT STRIP_TAC THEN MP_TAC(SPECL [`s:num->bool`; `dimindex(:N)`] DET_LINEAR_ROWS_VSUM_LEMMA) THEN ASM_REWRITE_TAC[LE_REFL; lemma] THEN SIMP_TAC[]);; let MATRIX_MUL_VSUM_ALT = prove (`!A:real^N^N B:real^N^N. A ** B = lambda i. vsum (1..dimindex(:N)) (\k. A$i$k % B$k)`, SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; VSUM_COMPONENT]);; let DET_ROWS_MUL = prove (`!a c. det((lambda i. c(i) % a(i)):real^N^N) = product(1..dimindex(:N)) (\i. c(i)) * det((lambda i. a(i)):real^N^N)`, REPEAT GEN_TAC THEN SIMP_TAC[det; LAMBDA_BETA] THEN SIMP_TAC[GSYM SUM_LMUL; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_RING `b = c * d ==> s * b = c * s * d`) THEN SIMP_TAC[GSYM PRODUCT_MUL_NUMSEG] THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; VECTOR_MUL_COMPONENT]);; let DET_MUL = prove (`!A B:real^N^N. det(A ** B) = det(A) * det(B)`, REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_MUL_VSUM_ALT] THEN SIMP_TAC[DET_LINEAR_ROWS_VSUM; FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {p | p permutes 1..dimindex(:N)} (\f. det (lambda i. (A:real^N^N)$i$f i % (B:real^N^N)$f i))` THEN CONJ_TAC THENL [REWRITE_TAC[DET_ROWS_MUL] THEN MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL [MESON_TAC[permutes; IN_NUMSEG]; ALL_TAC] THEN X_GEN_TAC `f:num->num` THEN REWRITE_TAC[permutes; IN_NUMSEG] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN MATCH_MP_TAC DET_IDENTICAL_ROWS THEN MP_TAC(ISPECL [`1..dimindex(:N)`; `f:num->num`] SURJECTIVE_IFF_INJECTIVE) THEN ASM_REWRITE_TAC[SUBSET; IN_NUMSEG; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(TAUT `(~b ==> c) /\ (b ==> ~a) ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL [REWRITE_TAC[NOT_FORALL_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; row; NOT_IMP]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `!x y. (f:num->num)(x) = f(y) ==> x = y` ASSUME_TAC THENL [REPEAT GEN_TAC THEN ASM_CASES_TAC `1 <= x /\ x <= dimindex(:N)` THEN ASM_CASES_TAC `1 <= y /\ y <= dimindex(:N)` THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[det; REAL_MUL_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [MATCH_MP SUM_PERMUTATIONS_COMPOSE_R (MATCH_MP PERMUTES_INVERSE th)]) THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `q:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(p * x) * (q * y) = (p * q) * (x * y)`] THEN BINOP_TAC THENL [SUBGOAL_THEN `sign(q o inverse p) = sign(p:num->num) * sign(q:num->num)` (fun t -> SIMP_TAC[REAL_MUL_ASSOC; SIGN_IDEMPOTENT; REAL_MUL_LID; t]) THEN ASM_MESON_TAC[SIGN_COMPOSE; PERMUTES_INVERSE; PERMUTATION_PERMUTES; FINITE_NUMSEG; SIGN_INVERSE; REAL_MUL_SYM]; ALL_TAC] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MATCH_MP PRODUCT_PERMUTE_NUMSEG (ASSUME `p permutes 1..dimindex(:N)`)] THEN SIMP_TAC[GSYM PRODUCT_MUL; FINITE_NUMSEG] THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN ASM_SIMP_TAC[LAMBDA_BETA; LAMBDA_BETA_PERM; o_THM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(A:real^N^N)$i$p(i) * (B:real^N^N)$p(i)$q(i)` THEN CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_MUL_COMPONENT; PERMUTES_IN_IMAGE; IN_NUMSEG]; ASM_MESON_TAC[PERMUTES_INVERSES]]);; let DET_LINEAR_ROWS = prove (`!f:real^N->real^N A:real^N^N. linear f ==> det(lambda i. f(A$i)) = det(matrix f) * det A`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN REWRITE_TAC[GSYM DET_MUL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN GEN_REWRITE_TAC LAND_CONV [GSYM DET_TRANSP] THEN REWRITE_TAC[matrix_mul; matrix_vector_mul; transp] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);; (* ------------------------------------------------------------------------- *) (* Relation to invertibility. *) (* ------------------------------------------------------------------------- *) let INVERTIBLE_DET_NZ = prove (`!A:real^N^N. invertible(A) <=> ~(det A = &0)`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[INVERTIBLE_RIGHT_INVERSE; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `det:real^N^N->real`) THEN REWRITE_TAC[DET_MUL; DET_I] THEN CONV_TAC REAL_RING; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[INVERTIBLE_RIGHT_INVERSE] THEN REWRITE_TAC[MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:num->real`; `i:num`] THEN STRIP_TAC THEN MP_TAC(SPECL [`A:real^N^N`; `i:num`; `--(row i (A:real^N^N))`] DET_ROW_SPAN) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `--(row i (A:real^N^N)) = vsum ((1..dimindex(:N)) DELETE i) (\j. inv(c i) % c j % row j A)` SUBST1_TAC THENL [ASM_SIMP_TAC[VSUM_DELETE_CASES; FINITE_NUMSEG; IN_NUMSEG; VSUM_LMUL] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; FINITE_DELETE; IN_DELETE] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REPEAT(MATCH_MP_TAC SPAN_MUL) THEN MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DET_ZERO_ROW THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; VECTOR_ARITH `x + --x:real^N = vec 0`]);; let DET_EQ_0 = prove (`!A:real^N^N. det(A) = &0 <=> ~invertible(A)`, REWRITE_TAC[INVERTIBLE_DET_NZ]);; let DET_MATRIX_INV = prove (`!A:real^N^N. det(matrix_inv A) = inv(det A)`, GEN_TAC THEN ASM_CASES_TAC `invertible(A:real^N^N)` THENL [MATCH_MP_TAC(REAL_FIELD `a * b = &1 ==> a = inv b`) THEN ASM_SIMP_TAC[GSYM DET_MUL; MATRIX_INV; DET_I]; ASM_MESON_TAC[DET_EQ_0; INVERTIBLE_MATRIX_INV; REAL_INV_0]]);; let MATRIX_MUL_LINV = prove (`!A:real^N^N. ~(det A = &0) ==> matrix_inv A ** A = mat 1`, SIMP_TAC[MATRIX_INV; DET_EQ_0]);; let MATRIX_MUL_RINV = prove (`!A:real^N^N. ~(det A = &0) ==> A ** matrix_inv A = mat 1`, SIMP_TAC[MATRIX_INV; DET_EQ_0]);; let DET_MATRIX_EQ_0 = prove (`!f:real^N->real^N. linear f ==> (det(matrix f) = &0 <=> ~(?g. linear g /\ f o g = I /\ g o f = I))`, SIMP_TAC[DET_EQ_0; MATRIX_INVERTIBLE]);; let DET_MATRIX_EQ_0_LEFT = prove (`!f:real^N->real^N. linear f ==> (det(matrix f) = &0 <=> ~(?g. linear g /\ g o f = I))`, SIMP_TAC[DET_MATRIX_EQ_0] THEN MESON_TAC[LINEAR_INVERSE_LEFT]);; let DET_MATRIX_EQ_0_RIGHT = prove (`!f:real^N->real^N. linear f ==> (det(matrix f) = &0 <=> ~(?g. linear g /\ f o g = I))`, SIMP_TAC[DET_MATRIX_EQ_0] THEN MESON_TAC[LINEAR_INVERSE_LEFT]);; let DET_EQ_0_RANK = prove (`!A:real^N^N. det A = &0 <=> rank A < dimindex(:N)`, REWRITE_TAC[DET_EQ_0; INVERTIBLE_LEFT_INVERSE; GSYM FULL_RANK_INJECTIVE; MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN ARITH_TAC);; let RANK_EQ_FULL_DET = prove (`!A:real^N^N. rank A = dimindex(:N) <=> ~(det A = &0)`, GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN SIMP_TAC[DET_EQ_0_RANK; NOT_LT; GSYM LE_ANTISYM; ARITH_RULE `MIN n n = n`]);; let INVERTIBLE_COVARIANCE_RANK = prove (`!A:real^N^M. invertible(transp A ** A) <=> rank A = dimindex(:N)`, REWRITE_TAC[INVERTIBLE_DET_NZ; GSYM RANK_EQ_FULL_DET; RANK_GRAM]);; let HOMOGENEOUS_LINEAR_EQUATIONS_DET = prove (`!A:real^N^N. (?x. ~(x = vec 0) /\ A ** x = vec 0) <=> det A = &0`, GEN_TAC THEN REWRITE_TAC[MATRIX_NONFULL_LINEAR_EQUATIONS_EQ; DET_EQ_0_RANK] THEN MATCH_MP_TAC(ARITH_RULE `r <= MIN N N ==> (~(r = N) <=> r < N)`) THEN REWRITE_TAC[RANK_BOUND]);; let INVERTIBLE_MATRIX_MUL = prove (`!A:real^N^N B:real^N^N. invertible(A ** B) <=> invertible A /\ invertible B`, REWRITE_TAC[INVERTIBLE_DET_NZ; DET_MUL; DE_MORGAN_THM; REAL_ENTIRE]);; let MATRIX_INV_MUL = prove (`!A:real^N^N B:real^N^N. invertible A /\ invertible B ==> matrix_inv(A ** B) = matrix_inv B ** matrix_inv A`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_MUL_LINV; DET_EQ_0; MATRIX_MUL_RID; MATRIX_MUL_RINV]);; let DET_SIMILAR = prove (`!S:real^N^N A. invertible S ==> det(matrix_inv S ** A ** S) = det A`, REWRITE_TAC[INVERTIBLE_DET_NZ; DET_MUL; DET_MATRIX_INV] THEN CONV_TAC REAL_FIELD);; let INVERTIBLE_NEARBY_ONORM = prove (`!A B:real^N^N. invertible A /\ onorm(\x. (B - A) ** x) < inv(onorm(\x. matrix_inv A ** x)) ==> invertible B`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM ONORM_NEG] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_LNEG; MATRIX_NEG_SUB] THEN DISCH_TAC THEN ABBREV_TAC `S = matrix_inv(A:real^N^N) ** (A - B)` THEN SUBGOAL_THEN `B = (A:real^N^N) ** (mat 1 - S:real^N^N)` SUBST1_TAC THENL [EXPAND_TAC "S" THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB; MATRIX_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_INV; MATRIX_MUL_RID; MATRIX_MUL_LID] THEN REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_ADD] THEN REWRITE_TAC[MATRIX_ADD_RNEG; MATRIX_ADD_ASSOC; MATRIX_ADD_LID] THEN REWRITE_TAC[MATRIX_NEG_NEG]; ASM_REWRITE_TAC[INVERTIBLE_MATRIX_MUL]] THEN REWRITE_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE_NULLSPACE] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_RDISTRIB; VECTOR_SUB_EQ] THEN CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LID] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x:real^N. matrix_inv(A:real^N^N) ** x`; `\x:real^N. (A - B:real^N^N) ** x`] ONORM_COMPOSE) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; o_DEF; MATRIX_VECTOR_MUL_ASSOC] THEN REWRITE_TAC[REAL_NOT_LE] THEN TRANS_TAC REAL_LTE_TRANS `&1` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN W(MP_TAC o PART_MATCH (rand o rand) REAL_LT_RDIV_EQ o snd) THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[ONORM_POS_LT; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[GSYM MATRIX_EQ_0; MATRIX_INV_EQ_0] THEN ASM_MESON_TAC[INVERTIBLE_MAT]; MP_TAC(ISPEC `\x:real^N. (S:real^N^N) ** x` ONORM) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT]]);; let INVERTIBLE_NEARBY = prove (`!A:real^N^N. invertible A ==> ?e. &0 < e /\ !B. onorm(\x. (B - A) ** x) < e ==> invertible B`, REPEAT STRIP_TAC THEN EXISTS_TAC `inv(onorm(\x. matrix_inv(A:real^N^N) ** x))` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INVERTIBLE_NEARBY_ONORM]] THEN SIMP_TAC[REAL_LT_INV_EQ; ONORM_POS_LT; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[GSYM MATRIX_EQ_0; MATRIX_INV_EQ_0] THEN ASM_MESON_TAC[INVERTIBLE_MAT]);; (* ------------------------------------------------------------------------- *) (* Cramer's rule. *) (* ------------------------------------------------------------------------- *) let CRAMER_LEMMA_TRANSP = prove (`!A:real^N^N x:real^N. 1 <= k /\ k <= dimindex(:N) ==> det((lambda i. if i = k then vsum(1..dimindex(:N)) (\i. x$i % row i A) else row i A):real^N^N) = x$k * det A`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; FINITE_DELETE; IN_DELETE] THEN REWRITE_TAC[VECTOR_ARITH `(x:real^N)$k % row k (A:real^N^N) + s = (x$k - &1) % row k A + row k A + s`] THEN W(MP_TAC o PART_MATCH (lhs o rand) DET_ROW_ADD o lhand o snd) THEN ASM_SIMP_TAC[DET_ROW_MUL] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(REAL_RING `d = d' /\ e = d' ==> (c - &1) * d + e = c * d'`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; row]; MATCH_MP_TAC DET_ROW_SPAN THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; FINITE_DELETE; IN_DELETE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]);; let CRAMER_LEMMA = prove (`!A:real^N^N x:real^N. 1 <= k /\ k <= dimindex(:N) ==> det((lambda i j. if j = k then (A**x)$i else A$i$j):real^N^N) = x$k * det(A)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[MATRIX_MUL_VSUM] THEN FIRST_ASSUM(MP_TAC o SYM o SPECL [`transp(A:real^N^N)`; `x:real^N`] o MATCH_MP CRAMER_LEMMA_TRANSP) THEN REWRITE_TAC[DET_TRANSP] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM DET_TRANSP] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; MATRIX_MUL_VSUM; row; column; COND_COMPONENT; VECTOR_MUL_COMPONENT; VSUM_COMPONENT]);; let CRAMER = prove (`!A:real^N^N x b. ~(det(A) = &0) ==> (A ** x = b <=> x = lambda k. det((lambda i j. if j = k then b$i else A$i$j):real^N^N) / det(A))`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] `(?x. p(x)) /\ (!x. p(x) ==> x = a) ==> !x. p(x) <=> x = a`) THEN CONJ_TAC THENL [MP_TAC(SPEC `A:real^N^N` INVERTIBLE_DET_NZ) THEN ASM_MESON_TAC[invertible; MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[CART_EQ; CRAMER_LEMMA; LAMBDA_BETA; REAL_FIELD `~(z = &0) ==> (x = y / z <=> x * z = y)`]]);; (* ------------------------------------------------------------------------- *) (* Variants of Cramer's rule for matrix-matrix multiplication. *) (* ------------------------------------------------------------------------- *) let CRAMER_MATRIX_LEFT = prove (`!A:real^N^N X:real^N^N B:real^N^N. ~(det A = &0) ==> (X ** A = B <=> X = lambda k l. det((lambda i j. if j = l then B$k$i else A$j$i):real^N^N) / det A)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN ASM_SIMP_TAC[MATRIX_MUL_COMPONENT; CRAMER; DET_TRANSP] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC) THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; transp]);; let CRAMER_MATRIX_RIGHT = prove (`!A:real^N^N X:real^N^N B:real^N^N. ~(det A = &0) ==> (A ** X = B <=> X = lambda k l. det((lambda i j. if j = k then B$i$l else A$i$j):real^N^N) / det A)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM TRANSP_EQ] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ASM_SIMP_TAC[CRAMER_MATRIX_LEFT; DET_TRANSP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM TRANSP_EQ] THEN REWRITE_TAC[TRANSP_TRANSP] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; transp] THEN REPEAT(GEN_TAC THEN STRIP_TAC) THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; transp]);; let CRAMER_MATRIX_RIGHT_INVERSE = prove (`!A:real^N^N A':real^N^N. A ** A' = mat 1 <=> ~(det A = &0) /\ A' = lambda k l. det((lambda i j. if j = k then if i = l then &1 else &0 else A$i$j):real^N^N) / det A`, REPEAT GEN_TAC THEN ASM_CASES_TAC `det(A:real^N^N) = &0` THENL [ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `det:real^N^N->real`) THEN ASM_REWRITE_TAC[DET_MUL; DET_I] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[CRAMER_MATRIX_RIGHT] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT(GEN_TAC THEN STRIP_TAC) THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; mat]]);; let CRAMER_MATRIX_LEFT_INVERSE = prove (`!A:real^N^N A':real^N^N. A' ** A = mat 1 <=> ~(det A = &0) /\ A' = lambda k l. det((lambda i j. if j = l then if i = k then &1 else &0 else A$j$i):real^N^N) / det A`, REPEAT GEN_TAC THEN ASM_CASES_TAC `det(A:real^N^N) = &0` THENL [ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `det:real^N^N->real`) THEN ASM_REWRITE_TAC[DET_MUL; DET_I] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[CRAMER_MATRIX_LEFT] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT(GEN_TAC THEN STRIP_TAC) THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; mat] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Cofactors and their relationship to inverse matrices. *) (* ------------------------------------------------------------------------- *) let cofactor = new_definition `(cofactor:real^N^N->real^N^N) A = lambda i j. det((lambda k l. if k = i /\ l = j then &1 else if k = i \/ l = j then &0 else A$k$l):real^N^N)`;; let COFACTOR_TRANSP = prove (`!A:real^N^N. cofactor(transp A) = transp(cofactor A)`, SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA; transp] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN AP_TERM_TAC THEN SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA; transp] THEN MESON_TAC[]);; let COFACTOR_COLUMN = prove (`!A:real^N^N. cofactor A = lambda i j. det((lambda k l. if l = j then if k = i then &1 else &0 else A$k$l):real^N^N)`, GEN_TAC THEN CONV_TAC SYM_CONV THEN SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[det] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN AP_TERM_TAC THEN ASM_CASES_TAC `(p:num->num) i = j` THENL [MATCH_MP_TAC PRODUCT_EQ THEN X_GEN_TAC `k:num` THEN SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN STRIP_TAC THEN SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN STRIP_TAC] THEN ASM_CASES_TAC `(p:num->num) k = j` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; MATCH_MP_TAC(REAL_ARITH `s = &0 /\ t = &0 ==> s = t`) THEN ASM_SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG] THEN CONJ_TAC THEN EXISTS_TAC `inverse (p:num->num) j` THEN ASM_SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN (SUBGOAL_THEN `inverse(p:num->num) j IN 1..dimindex(:N)` MP_TAC THENL [ASM_MESON_TAC[PERMUTES_IN_IMAGE; PERMUTES_INVERSE; IN_NUMSEG]; SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN STRIP_TAC] THEN SUBGOAL_THEN `(p:num->num)(inverse p j) = j` SUBST1_TAC THENL [ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]; ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[PERMUTES_INVERSE_EQ]])]);; let COFACTOR_ROW = prove (`!A:real^N^N. cofactor A = lambda i j. det((lambda k l. if k = i then if l = j then &1 else &0 else A$k$l):real^N^N)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM TRANSP_EQ] THEN REWRITE_TAC[GSYM COFACTOR_TRANSP] THEN SIMP_TAC[COFACTOR_COLUMN; CART_EQ; LAMBDA_BETA; transp] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN AP_TERM_TAC THEN SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA; transp]);; let MATRIX_RIGHT_INVERSE_COFACTOR = prove (`!A:real^N^N A':real^N^N. A ** A' = mat 1 <=> ~(det A = &0) /\ A' = inv(det A) %% transp(cofactor A)`, REPEAT GEN_TAC THEN REWRITE_TAC[CRAMER_MATRIX_RIGHT_INVERSE] THEN ASM_CASES_TAC `det(A:real^N^N) = &0` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; MATRIX_CMUL_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[transp; COFACTOR_COLUMN; LAMBDA_BETA] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);; let MATRIX_LEFT_INVERSE_COFACTOR = prove (`!A:real^N^N A':real^N^N. A' ** A = mat 1 <=> ~(det A = &0) /\ A' = inv(det A) %% transp(cofactor A)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MATRIX_LEFT_RIGHT_INVERSE] THEN REWRITE_TAC[MATRIX_RIGHT_INVERSE_COFACTOR]);; let MATRIX_INV_COFACTOR = prove (`!A. ~(det A = &0) ==> matrix_inv A = inv(det A) %% transp(cofactor A)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP MATRIX_MUL_LINV) THEN SIMP_TAC[MATRIX_LEFT_INVERSE_COFACTOR]);; let COFACTOR_MATRIX_INV = prove (`!A:real^N^N. ~(det A = &0) ==> cofactor A = det(A) %% transp(matrix_inv A)`, SIMP_TAC[MATRIX_INV_COFACTOR; TRANSP_MATRIX_CMUL; TRANSP_TRANSP] THEN SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_RINV; MATRIX_CMUL_LID]);; let COFACTOR_I = prove (`cofactor(mat 1:real^N^N) = mat 1`, SIMP_TAC[COFACTOR_MATRIX_INV; DET_I; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[MATRIX_INV_I; MATRIX_CMUL_LID; TRANSP_MAT]);; let DET_COFACTOR_EXPANSION = prove (`!A:real^N^N i. 1 <= i /\ i <= dimindex(:N) ==> det A = sum (1..dimindex(:N)) (\j. A$i$j * (cofactor A)$i$j)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COFACTOR_COLUMN; LAMBDA_BETA; det] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o rand o snd) THEN ANTS_TAC THENL [SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a * s * p:real = s * a * p`] THEN REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (1..dimindex (:N)) (\j. (A:real^N^N)$i$j * product (inverse p j INSERT ((1..dimindex(:N)) DELETE (inverse p j))) (\k. if k = inverse p j then if k = i then &1 else &0 else A$k$(p k)))` THEN CONJ_TAC THENL [SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_PERMUTATIONS; FINITE_NUMSEG; IN_DELETE] THEN SUBGOAL_THEN `!j. inverse (p:num->num) j = i <=> j = p i` (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `x * (if p then &1 else &0) * y = if p then x * y else &0`] THEN SIMP_TAC[SUM_DELTA] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]] THEN SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_SIMP_TAC[IN_NUMSEG; SET_RULE `s = x INSERT (s DELETE x) <=> x IN s`]; SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN AP_TERM_TAC THEN MATCH_MP_TAC(MESON[PRODUCT_EQ] `s = t /\ (!x. x IN t ==> f x = g x) ==> product s f = product t g`) THEN SIMP_TAC[IN_DELETE] THEN ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]]; MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC(MESON[PRODUCT_EQ] `s = t /\ (!x. x IN t ==> f x = g x) ==> product s f = product t g`) THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = s <=> x IN s`] THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; PERMUTES_INVERSE]; X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]]]);; let MATRIX_MUL_RIGHT_COFACTOR = prove (`!A:real^N^N. A ** transp(cofactor A) = det(A) %% mat 1`, GEN_TAC THEN SIMP_TAC[CART_EQ; MATRIX_CMUL_COMPONENT; mat; matrix_mul; LAMBDA_BETA; transp] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `i':num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[GSYM DET_COFACTOR_EXPANSION; REAL_MUL_RID] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `det((lambda k l. if k = i' then (A:real^N^N)$i$l else A$k$l):real^N^N)` THEN CONJ_TAC THENL [MP_TAC(GEN `A:real^N^N` (ISPECL [`A:real^N^N`; `i':num`] DET_COFACTOR_EXPANSION)) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]; REWRITE_TAC[REAL_MUL_RZERO] THEN MATCH_MP_TAC DET_IDENTICAL_ROWS THEN MAP_EVERY EXISTS_TAC [`i:num`;` i':num`] THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row]]);; let MATRIX_MUL_LEFT_COFACTOR = prove (`!A:real^N^N. transp(cofactor A) ** A = det(A) %% mat 1`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM TRANSP_EQ] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ONCE_REWRITE_TAC[GSYM COFACTOR_TRANSP] THEN REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; TRANSP_MATRIX_CMUL] THEN REWRITE_TAC[DET_TRANSP; TRANSP_MAT]);; let COFACTOR_CMUL = prove (`!A:real^N^N c. cofactor(c %% A) = c pow (dimindex(:N) - 1) %% cofactor A`, REPEAT GEN_TAC THEN SIMP_TAC[CART_EQ; cofactor; LAMBDA_BETA; MATRIX_CMUL_COMPONENT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[det; GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = b * a * c`] THEN AP_TERM_TAC THEN SUBGOAL_THEN `1..dimindex (:N) = i INSERT ((1..dimindex (:N)) DELETE i)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_NUMSEG; IN_DELETE] THEN ASM_ARITH_TAC; SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE]] THEN SUBGOAL_THEN `1 <= (p:num->num) i /\ p i <= dimindex(:N)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN ASM SET_TAC[]; ASM_SIMP_TAC[LAMBDA_BETA]] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN SUBGOAL_THEN `dimindex(:N) - 1 = CARD((1..dimindex(:N)) DELETE i)` SUBST1_TAC THENL [ASM_SIMP_TAC[CARD_DELETE; FINITE_NUMSEG; IN_NUMSEG; CARD_NUMSEG_1]; ASM_SIMP_TAC[REAL_MUL_LID; GSYM PRODUCT_CONST; FINITE_NUMSEG; FINITE_DELETE; GSYM PRODUCT_MUL]] THEN MATCH_MP_TAC PRODUCT_EQ THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN STRIP_TAC THEN SUBGOAL_THEN `1 <= (p:num->num) k /\ p k <= dimindex(:N)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN ASM SET_TAC[]; ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]);; let COFACTOR_0 = prove (`cofactor(mat 0:real^N^N) = if dimindex(:N) = 1 then mat 1 else mat 0`, MP_TAC(ISPECL [`mat 1:real^N^N`; `&0`] COFACTOR_CMUL) THEN REWRITE_TAC[MATRIX_CMUL_LZERO; COFACTOR_I; REAL_POW_ZERO] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN COND_CASES_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; MATRIX_CMUL_LID]);; (* ------------------------------------------------------------------------- *) (* Explicit formulas for low dimensions. *) (* ------------------------------------------------------------------------- *) let PRODUCT_1 = prove (`product(1..1) f = f(1)`, REWRITE_TAC[PRODUCT_SING_NUMSEG]);; let PRODUCT_2 = prove (`!t. product(1..2) t = t(1) * t(2)`, REWRITE_TAC[num_CONV `2`; PRODUCT_CLAUSES_NUMSEG] THEN REWRITE_TAC[PRODUCT_SING_NUMSEG; ARITH; REAL_MUL_ASSOC]);; let PRODUCT_3 = prove (`!t. product(1..3) t = t(1) * t(2) * t(3)`, REWRITE_TAC[num_CONV `3`; num_CONV `2`; PRODUCT_CLAUSES_NUMSEG] THEN REWRITE_TAC[PRODUCT_SING_NUMSEG; ARITH; REAL_MUL_ASSOC]);; let PRODUCT_4 = prove (`!t. product(1..4) t = t(1) * t(2) * t(3) * t(4)`, REWRITE_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; PRODUCT_CLAUSES_NUMSEG] THEN REWRITE_TAC[PRODUCT_SING_NUMSEG; ARITH; REAL_MUL_ASSOC]);; let DET_1_GEN = prove (`!A:real^N^N. dimindex(:N) = 1 ==> det A = A$1$1`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[det; PERMUTES_SING; NUMSEG_SING] THEN REWRITE_TAC[SUM_SING; SET_RULE `{x | x = a} = {a}`; PRODUCT_SING] THEN REWRITE_TAC[SIGN_I; I_THM] THEN REAL_ARITH_TAC);; let DET_1 = prove (`!A:real^1^1. det A = A$1$1`, SIMP_TAC[DET_1_GEN; DIMINDEX_1]);; let DET_2 = prove (`!A:real^2^2. det A = A$1$1 * A$2$2 - A$1$2 * A$2$1`, GEN_TAC THEN REWRITE_TAC[det; DIMINDEX_2] THEN CONV_TAC(LAND_CONV(RATOR_CONV(ONCE_DEPTH_CONV NUMSEG_CONV))) THEN SIMP_TAC[SUM_OVER_PERMUTATIONS_INSERT; FINITE_INSERT; FINITE_EMPTY; ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[PERMUTES_EMPTY; SUM_SING; SET_RULE `{x | x = a} = {a}`] THEN REWRITE_TAC[SWAP_REFL; I_O_ID] THEN REWRITE_TAC[GSYM(NUMSEG_CONV `1..2`); SUM_2] THEN SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY; ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN SIMP_TAC[SIGN_COMPOSE; PERMUTATION_SWAP] THEN REWRITE_TAC[SIGN_SWAP; ARITH] THEN REWRITE_TAC[PRODUCT_2] THEN REWRITE_TAC[o_THM; swap; ARITH] THEN REAL_ARITH_TAC);; let DET_3 = prove (`!A:real^3^3. det(A) = A$1$1 * A$2$2 * A$3$3 + A$1$2 * A$2$3 * A$3$1 + A$1$3 * A$2$1 * A$3$2 - A$1$1 * A$2$3 * A$3$2 - A$1$2 * A$2$1 * A$3$3 - A$1$3 * A$2$2 * A$3$1`, GEN_TAC THEN REWRITE_TAC[det; DIMINDEX_3] THEN CONV_TAC(LAND_CONV(RATOR_CONV(ONCE_DEPTH_CONV NUMSEG_CONV))) THEN SIMP_TAC[SUM_OVER_PERMUTATIONS_INSERT; FINITE_INSERT; FINITE_EMPTY; ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[PERMUTES_EMPTY; SUM_SING; SET_RULE `{x | x = a} = {a}`] THEN REWRITE_TAC[SWAP_REFL; I_O_ID] THEN REWRITE_TAC[GSYM(NUMSEG_CONV `1..3`); SUM_3] THEN SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY; ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN SIMP_TAC[SIGN_COMPOSE; PERMUTATION_SWAP] THEN REWRITE_TAC[SIGN_SWAP; ARITH] THEN REWRITE_TAC[PRODUCT_3] THEN REWRITE_TAC[o_THM; swap; ARITH] THEN REAL_ARITH_TAC);; let DET_4 = prove (`!A:real^4^4. det(A) = A$1$1 * A$2$2 * A$3$3 * A$4$4 + A$1$1 * A$2$3 * A$3$4 * A$4$2 + A$1$1 * A$2$4 * A$3$2 * A$4$3 + A$1$2 * A$2$1 * A$3$4 * A$4$3 + A$1$2 * A$2$3 * A$3$1 * A$4$4 + A$1$2 * A$2$4 * A$3$3 * A$4$1 + A$1$3 * A$2$1 * A$3$2 * A$4$4 + A$1$3 * A$2$2 * A$3$4 * A$4$1 + A$1$3 * A$2$4 * A$3$1 * A$4$2 + A$1$4 * A$2$1 * A$3$3 * A$4$2 + A$1$4 * A$2$2 * A$3$1 * A$4$3 + A$1$4 * A$2$3 * A$3$2 * A$4$1 - A$1$1 * A$2$2 * A$3$4 * A$4$3 - A$1$1 * A$2$3 * A$3$2 * A$4$4 - A$1$1 * A$2$4 * A$3$3 * A$4$2 - A$1$2 * A$2$1 * A$3$3 * A$4$4 - A$1$2 * A$2$3 * A$3$4 * A$4$1 - A$1$2 * A$2$4 * A$3$1 * A$4$3 - A$1$3 * A$2$1 * A$3$4 * A$4$2 - A$1$3 * A$2$2 * A$3$1 * A$4$4 - A$1$3 * A$2$4 * A$3$2 * A$4$1 - A$1$4 * A$2$1 * A$3$2 * A$4$3 - A$1$4 * A$2$2 * A$3$3 * A$4$1 - A$1$4 * A$2$3 * A$3$1 * A$4$2`, let lemma = prove (`(sum {3,4} f = f 3 + f 4) /\ (sum {2,3,4} f = f 2 + f 3 + f 4)`, SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC) in GEN_TAC THEN REWRITE_TAC[det; DIMINDEX_4] THEN CONV_TAC(LAND_CONV(RATOR_CONV(ONCE_DEPTH_CONV NUMSEG_CONV))) THEN SIMP_TAC[SUM_OVER_PERMUTATIONS_INSERT; FINITE_INSERT; FINITE_EMPTY; ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[PERMUTES_EMPTY; SUM_SING; SET_RULE `{x | x = a} = {a}`] THEN REWRITE_TAC[SWAP_REFL; I_O_ID] THEN REWRITE_TAC[GSYM(NUMSEG_CONV `1..4`); SUM_4; lemma] THEN SIMP_TAC[SIGN_COMPOSE; PERMUTATION_SWAP; PERMUTATION_COMPOSE] THEN REWRITE_TAC[SIGN_SWAP; ARITH] THEN REWRITE_TAC[PRODUCT_4] THEN REWRITE_TAC[o_THM; swap; ARITH] THEN REAL_ARITH_TAC);; let COFACTOR_1_GEN = prove (`!A:real^N^N. dimindex(:N) = 1 ==> cofactor A = mat 1`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CART_EQ; mat; cofactor; LAMBDA_BETA; DET_1_GEN; ARITH] THEN REWRITE_TAC[LE_ANTISYM] THEN MESON_TAC[]);; let COFACTOR_1 = prove (`!A:real^1^1. cofactor A = mat 1`, SIMP_TAC[COFACTOR_1_GEN; DIMINDEX_1]);; (* ------------------------------------------------------------------------- *) (* Disjoint or subset-related halfspaces and hyperplanes are parallel. *) (* ------------------------------------------------------------------------- *) let DISJOINT_HYPERPLANES_IMP_COLLINEAR = prove (`!a b:real^N c d. DISJOINT {x | a dot x = c} {x | b dot x = d} ==> collinear {vec 0, a, b}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `DISJOINT {x:real^N | a dot x = c} {x | b dot x = d} ==> !u v. a dot (u % a + v % b) = c /\ b dot (u % a + v % b) = d ==> F`)) THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN MP_TAC(ISPECL [`vector[vector[(a:real^N) dot a; a dot b]; vector[a dot b; b dot b]]:real^2^2`; `vector[c;d]:real^2`] MATRIX_FULL_LINEAR_EQUATIONS) THEN REWRITE_TAC[RANK_EQ_FULL_DET] THEN SIMP_TAC[CART_EQ; DIMINDEX_2; MATRIX_VECTOR_MUL_COMPONENT; ARITH; VECTOR_2; FORALL_2; DOT_2; EXISTS_VECTOR_2; DET_2] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [REWRITE_TAC[CONTRAPOS_THM]; MESON_TAC[DOT_SYM; REAL_MUL_SYM]] THEN REWRITE_TAC[REAL_ARITH `a - b * b = &0 <=> b pow 2 = a`] THEN REWRITE_TAC[DOT_CAUCHY_SCHWARZ_EQUAL]);; let DISJOINT_HALFSPACES_IMP_COLLINEAR = prove (`(!a b:real^N c d. DISJOINT {x | a dot x < c} {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x < c} {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x < c} {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x < c} {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x < c} {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x <= c} {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x <= c} {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x <= c} {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x <= c} {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x <= c} {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x = c} {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x = c} {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x = c} {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x = c} {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x = c} {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x >= c} {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x >= c} {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x >= c} {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x >= c} {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x >= c} {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x > c} {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x > c} {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x > c} {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x > c} {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. DISJOINT {x | a dot x > c} {x | b dot x > d} ==> collinear {vec 0, a, b})`, let lemma = prove (`(!a b:real^N. collinear {vec 0,--a,b} <=> collinear{vec 0,a,b}) /\ (!a b:real^N. collinear {vec 0,a,--b} <=> collinear{vec 0,a,b})`, REWRITE_TAC[COLLINEAR_LEMMA_ALT; VECTOR_NEG_EQ_0] THEN REWRITE_TAC[VECTOR_ARITH `b:real^N = c % --a <=> b = --c % a`; VECTOR_ARITH `--b:real^N = c % a <=> b = --c % a`] THEN REWRITE_TAC[MESON[REAL_NEG_NEG] `(?x:real. P(--x)) <=> ?x. P x`]) in REWRITE_TAC[REAL_ARITH `x >= d <=> --x <= --d`; REAL_ARITH `x > d <=> --x < --d`] THEN REWRITE_TAC[GSYM DOT_LNEG] THEN REPEAT STRIP_TAC THEN REPLICATE_TAC 2 (TRY(FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `DISJOINT {x | a dot x <= b} t ==> (!x y. x < y ==> x <= y) ==> DISJOINT {x | a dot x < b} t`)) THEN REWRITE_TAC[REAL_LT_IMP_LE] THEN DISCH_TAC) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[DISJOINT_SYM])) THEN REPLICATE_TAC 2 (TRY(FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `DISJOINT {x | a dot x < b} t ==> b - &1 < b ==> DISJOINT {x | a dot x = b - &1} t`)) THEN REWRITE_TAC[ARITH_RULE `c - &1 < c`] THEN DISCH_TAC) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[DISJOINT_SYM])) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DISJOINT_HYPERPLANES_IMP_COLLINEAR) THEN REWRITE_TAC[lemma]);; let SUBSET_HALFSPACES_IMP_COLLINEAR = prove (`(!a b:real^N c d. {x | a dot x < c} SUBSET {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x < c} SUBSET {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x < c} SUBSET {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x < c} SUBSET {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x < c} SUBSET {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x <= c} SUBSET {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x <= c} SUBSET {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x <= c} SUBSET {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x <= c} SUBSET {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x <= c} SUBSET {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x = c} SUBSET {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x = c} SUBSET {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x = c} SUBSET {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x = c} SUBSET {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x = c} SUBSET {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x >= c} SUBSET {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x >= c} SUBSET {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x >= c} SUBSET {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x >= c} SUBSET {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x >= c} SUBSET {x | b dot x > d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x > c} SUBSET {x | b dot x < d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x > c} SUBSET {x | b dot x <= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x > c} SUBSET {x | b dot x = d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x > c} SUBSET {x | b dot x >= d} ==> collinear {vec 0, a, b}) /\ (!a b:real^N c d. {x | a dot x > c} SUBSET {x | b dot x > d} ==> collinear {vec 0, a, b})`, REWRITE_TAC[SET_RULE `s SUBSET {x | P x} <=> DISJOINT s {x | ~P x}`] THEN REWRITE_TAC[REAL_ARITH `(~(x < a) <=> x >= a) /\ (~(x <= a) <=> x > a) /\ (~(x = a) <=> x > a \/ x < a) /\ (~(x > a) <=> x <= a) /\ (~(x >= a) <=> x < a)`] THEN REWRITE_TAC[SET_RULE `DISJOINT s {x | P x \/ Q x} <=> DISJOINT s {x | P x} /\ DISJOINT s {x | Q x}`] THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN TRY(DISCH_THEN(MP_TAC o CONJUNCT1)) THEN REWRITE_TAC[DISJOINT_HALFSPACES_IMP_COLLINEAR]);; let SUBSET_HYPERPLANES = prove (`!a b a' b'. {x | a dot x = b} SUBSET {x | a' dot x = b'} <=> {x | a dot x = b} = {} \/ {x | a' dot x = b'} = (:real^N) \/ {x | a dot x = b} = {x | a' dot x = b'}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `{x:real^N | a dot x = b} = {}` THEN ASM_REWRITE_TAC[EMPTY_SUBSET] THEN ASM_CASES_TAC `{x | a' dot x = b'} = (:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN RULE_ASSUM_TAC(REWRITE_RULE [HYPERPLANE_EQ_EMPTY; HYPERPLANE_EQ_UNIV]) THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN ASM_CASES_TAC `{x:real^N | a dot x = b} SUBSET {x | a' dot x = b'}` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`a:real^N`; `a':real^N`; `b:real`; `b':real`] (el 12 (CONJUNCTS SUBSET_HALFSPACES_IMP_COLLINEAR))) THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO] THENL [SET_TAC[]; STRIP_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c:real` SUBST_ALL_TAC) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ASM_CASES_TAC `c % a:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO] THENL [SET_TAC[]; POP_ASSUM MP_TAC] THEN SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; REAL_FIELD `~(c = &0) ==> (c * a = b <=> a = b / c)`] THEN STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `(b / (a dot a)) % a:real^N`) THEN ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Existence of the characteristic polynomial. *) (* ------------------------------------------------------------------------- *) let EIGENVALUES_CHARACTERISTIC_ALT = prove (`!A:real^N^N c. (?v. ~(v = vec 0) /\ A ** v = c % v) <=> det(A - c %% mat 1) = &0`, REWRITE_TAC[GSYM HOMOGENEOUS_LINEAR_EQUATIONS_DET] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN REWRITE_TAC[MATRIX_VECTOR_LMUL; VECTOR_SUB_EQ; MATRIX_VECTOR_MUL_LID]);; let EIGENVALUES_CHARACTERISTIC = prove (`!A:real^N^N c. (?v. ~(v = vec 0) /\ A ** v = c % v) <=> det(c %% mat 1 - A) = &0`, ONCE_REWRITE_TAC[GSYM MATRIX_NEG_SUB] THEN ASM_REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT; DET_NEG] THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let INVERTIBLE_EIGENVALUES = prove (`!A:real^N^N. invertible(A) <=> !c v. A ** v = c % v /\ ~(v = vec 0) ==> ~(c = &0)`, GEN_TAC THEN REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT; INVERTIBLE_DET_NZ] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2; MATRIX_CMUL_LZERO; MATRIX_SUB_RZERO]);; let CHARACTERISTIC_POLYNOMIAL = prove (`!A:real^N^N. ?a. a(dimindex(:N)) = &1 /\ !x. det(x %% mat 1 - A) = sum (0..dimindex(:N)) (\i. a i * x pow i)`, GEN_TAC THEN REWRITE_TAC[det] THEN SUBGOAL_THEN `!p n. IMAGE p (1..dimindex(:N)) SUBSET 1..dimindex(:N) /\ n <= dimindex(:N) ==> ?a. a n = (if !i. 1 <= i /\ i <= n ==> p i = i then &1 else &0) /\ !x. product (1..n) (\i. (x %% mat 1 - A:real^N^N)$i$p i) = sum (0..n) (\i. a i * x pow i)` MP_TAC THENL [GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG] THEN REWRITE_TAC[LE_0; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THENL [EXISTS_TAC `\i. if i = 0 then &1 else &0` THEN SIMP_TAC[real_pow; REAL_MUL_LID; ARITH_RULE `1 <= i ==> ~(i <= 0)`; SUM_CLAUSES_NUMSEG]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= N ==> n <= N`] THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MATRIX_SUB_COMPONENT; MATRIX_CMUL_COMPONENT] THEN ASSUME_TAC(ARITH_RULE `1 <= SUC n`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[MAT_COMPONENT] THEN ASM_CASES_TAC `p(SUC n) = SUC n` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; EXISTS_TAC `\i. if i <= n then --((A:real^N^N)$(SUC n)$(p(SUC n))) * a i else &0` THEN SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; ARITH_RULE `~(SUC n <= n)`] THEN CONJ_TAC THENL [COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; GSYM SUM_RMUL] THEN GEN_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN EXISTS_TAC `\i. (if i = 0 then &0 else a(i - 1)) - (if i = SUC n then &0 else (A:real^N^N)$(SUC n)$(SUC n) * a i)` THEN ASM_REWRITE_TAC[NOT_SUC; LE; SUC_SUB1; REAL_SUB_RZERO] THEN CONJ_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG] THEN GEN_TAC THEN BINOP_TAC THENL [SIMP_TAC[SUM_CLAUSES_LEFT; ARITH_RULE `0 <= SUC n`] THEN REWRITE_TAC[ADD1; SUM_OFFSET; ARITH_RULE `~(i + 1 = 0)`; ADD_SUB] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_POW_ADD; REAL_POW_1; REAL_ADD_LID]; SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; REAL_MUL_LZERO; REAL_ADD_RID] THEN SIMP_TAC[ARITH_RULE `i <= n ==> ~(i = SUC n)`]] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_AC]]; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:(num->num)->num->real` THEN DISCH_TAC] THEN EXISTS_TAC `\i:num. sum {p | p permutes 1..dimindex(:N)} (\p. sign p * a p i)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`\p:num->num. sign p * a p (dimindex(:N))`; `{p | p permutes 1..dimindex(:N)}`; `I:num->num`] SUM_DELETE) THEN SIMP_TAC[IN_ELIM_THM; PERMUTES_I; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN MATCH_MP_TAC(REAL_ARITH `k = &1 /\ s' = &0 ==> s' = s - k ==> s = &1`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `I:num->num`) THEN SIMP_TAC[IMAGE_I; SUBSET_REFL; SIGN_I; I_THM; REAL_MUL_LID]; MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num->num`) THEN ANTS_TAC THENL [ASM_MESON_TAC[PERMUTES_IMAGE; SUBSET_REFL]; ALL_TAC] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_MUL_RZERO] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [permutes]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FUN_EQ_THM]) THEN REWRITE_TAC[IN_NUMSEG; I_THM] THEN ASM_MESON_TAC[]]; X_GEN_TAC `x:real` THEN REWRITE_TAC[GSYM SUM_RMUL] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o rand o snd) THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num->num`) THEN ANTS_TAC THENL [ASM_MESON_TAC[PERMUTES_IMAGE; SUBSET_REFL]; SIMP_TAC[]]]);; let FINITE_EIGENVALUES = prove (`!A:real^N^N. FINITE {c | ?v. ~(v = vec 0) /\ A ** v = c % v}`, GEN_TAC THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC] THEN MP_TAC(ISPEC `A:real^N^N` CHARACTERISTIC_POLYNOMIAL) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_POLYFUN_FINITE_ROOTS] THEN EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_0; LE_REFL] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Grassmann-Plucker relations for n = 2, n = 3 and n = 4. *) (* I have a proof of the general n case but the proof is a bit long and the *) (* result doesn't seem generally useful enough to go in the main theories. *) (* ------------------------------------------------------------------------- *) let GRASSMANN_PLUCKER_2 = prove (`!x1 x2 y1 y2:real^2. det(vector[x1;x2]) * det(vector[y1;y2]) = det(vector[y1;x2]) * det(vector[x1;y2]) + det(vector[y2;x2]) * det(vector[y1;x1])`, REWRITE_TAC[DET_2; VECTOR_2] THEN REAL_ARITH_TAC);; let GRASSMANN_PLUCKER_3 = prove (`!x1 x2 x3 y1 y2 y3:real^3. det(vector[x1;x2;x3]) * det(vector[y1;y2;y3]) = det(vector[y1;x2;x3]) * det(vector[x1;y2;y3]) + det(vector[y2;x2;x3]) * det(vector[y1;x1;y3]) + det(vector[y3;x2;x3]) * det(vector[y1;y2;x1])`, REWRITE_TAC[DET_3; VECTOR_3] THEN REAL_ARITH_TAC);; let GRASSMANN_PLUCKER_4 = prove (`!x1 x2 x3 x4:real^4 y1 y2 y3 y4:real^4. det(vector[x1;x2;x3;x4]) * det(vector[y1;y2;y3;y4]) = det(vector[y1;x2;x3;x4]) * det(vector[x1;y2;y3;y4]) + det(vector[y2;x2;x3;x4]) * det(vector[y1;x1;y3;y4]) + det(vector[y3;x2;x3;x4]) * det(vector[y1;y2;x1;y4]) + det(vector[y4;x2;x3;x4]) * det(vector[y1;y2;y3;x1])`, REWRITE_TAC[DET_4; VECTOR_4] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Determinants of integer matrices. *) (* ------------------------------------------------------------------------- *) let INTEGER_PRODUCT = prove (`!f s. (!x. x IN s ==> integer(f x)) ==> integer(product s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_CLOSED THEN ASM_REWRITE_TAC[INTEGER_CLOSED]);; let INTEGER_SIGN = prove (`!p. integer(sign p)`, SIMP_TAC[sign; COND_RAND; INTEGER_CLOSED; COND_ID]);; let INTEGER_DET = prove (`!M:real^N^N. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> integer(M$i$j)) ==> integer(det M)`, REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN MATCH_MP_TAC INTEGER_SUM THEN X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC INTEGER_MUL THEN REWRITE_TAC[INTEGER_SIGN] THEN MATCH_MP_TAC INTEGER_PRODUCT THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_NUMSEG; permutes]);; (* ------------------------------------------------------------------------- *) (* Diagonal matrices (for arbitrary rectangular matrix, not just square). *) (* ------------------------------------------------------------------------- *) let diagonal_matrix = new_definition `diagonal_matrix(A:real^N^M) <=> !i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> A$i$j = &0`;; let DIAGONAL_MATRIX = prove (`!A:real^N^N. diagonal_matrix A <=> A = (lambda i j. if i = j then A$i$j else &0)`, SIMP_TAC[CART_EQ; LAMBDA_BETA; diagonal_matrix] THEN MESON_TAC[]);; let DIAGONAL_MATRIX_MAT = prove (`!m. diagonal_matrix(mat m:real^N^N)`, SIMP_TAC[mat; diagonal_matrix; LAMBDA_BETA]);; let TRANSP_DIAGONAL_MATRIX = prove (`!A:real^N^N. diagonal_matrix A ==> transp A = A`, GEN_TAC THEN REWRITE_TAC[diagonal_matrix; CART_EQ; TRANSP_COMPONENT] THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_SIMP_TAC[]);; let DIAGONAL_MATRIX_ADD = prove (`!A B:real^N^M. diagonal_matrix A /\ diagonal_matrix B ==> diagonal_matrix(A + B)`, SIMP_TAC[diagonal_matrix; MATRIX_ADD_COMPONENT; REAL_ADD_LID; REAL_ADD_RID]);; let DIAGONAL_MATRIX_CMUL = prove (`!A:real^N^M c. diagonal_matrix A ==> diagonal_matrix(c %% A)`, SIMP_TAC[diagonal_matrix; MATRIX_CMUL_COMPONENT; REAL_MUL_RZERO]);; let DIAGONAL_MATRIX_MUL_EXPLICIT = prove (`!A:real^N^N B:real^N^N. diagonal_matrix A /\ diagonal_matrix B ==> A ** B = lambda i j. A$i$j * B$i$j`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX])) THEN SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[MESON[REAL_MUL_LZERO; REAL_MUL_RZERO] `(if p then a else &0) * (if q then b else &0) = if q then (if p then a * b else &0) else &0`] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG; COND_ID; SUM_0]);; let DIAGONAL_MATRIX_MUL_COMPONENT = prove (`!A:real^N^N B:real^N^N i j. diagonal_matrix A /\ diagonal_matrix B /\ 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (A ** B)$i$j = A$i$j * B$i$j`, ASM_SIMP_TAC[DIAGONAL_MATRIX_MUL_EXPLICIT; LAMBDA_BETA]);; let MATRIX_MUL_DIAGONAL = prove (`!A:real^N^N B:real^N^N. diagonal_matrix A /\ diagonal_matrix B ==> A ** B = lambda i j. A$i$j * B$i$j`, SIMP_TAC[CART_EQ; LAMBDA_BETA; DIAGONAL_MATRIX_MUL_COMPONENT]);; let DIAGONAL_MATRIX_MUL = prove (`!A:real^N^N B:real^N^N. diagonal_matrix A /\ diagonal_matrix B ==> diagonal_matrix(A ** B)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [diagonal_matrix] THEN SIMP_TAC[DIAGONAL_MATRIX_MUL_COMPONENT] THEN SIMP_TAC[diagonal_matrix; REAL_MUL_LZERO]);; let DIAGONAL_MATRIX_MUL_EQ = prove (`!A:real^M^N B:real^N^M. diagonal_matrix (A ** B) <=> pairwise (\i j. orthogonal (row i A) (column j B)) (1..dimindex(:N))`, REWRITE_TAC[diagonal_matrix; matrix_mul; pairwise] THEN SIMP_TAC[LAMBDA_BETA; IN_NUMSEG; orthogonal; dot; row; column] THEN REWRITE_TAC[GSYM CONJ_ASSOC]);; let DIAGONAL_MATRIX_INV_EXPLICIT = prove (`!A:real^N^N. diagonal_matrix A ==> matrix_inv A = lambda i j. inv(A$i$j)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN SUBGOAL_THEN `diagonal_matrix((lambda i j. inv((A:real^N^N)$i$j)):real^N^N)` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[diagonal_matrix]) THEN ASM_SIMP_TAC[diagonal_matrix; LAMBDA_BETA; REAL_INV_0]; ASM_SIMP_TAC[DIAGONAL_MATRIX_MUL_COMPONENT; CART_EQ; LAMBDA_BETA; TRANSP_COMPONENT; DIAGONAL_MATRIX_MUL]] THEN MP_TAC(ISPEC `A:real^N^N` DIAGONAL_MATRIX) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[LAMBDA_BETA] THEN REPEAT CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_INV_EQ_0; REAL_RING `a * b * a = a <=> b * a = &1 \/ a = &0`] THEN CONV_TAC REAL_FIELD);; let DIAGONAL_MATRIX_INV_COMPONENT = prove (`!A:real^N^N i j. diagonal_matrix A /\ 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (matrix_inv A)$i$j = inv(A$i$j)`, ASM_SIMP_TAC[DIAGONAL_MATRIX_INV_EXPLICIT; LAMBDA_BETA]);; let DIAGONAL_MATRIX_INV = prove (`!A:real^N^N. diagonal_matrix(matrix_inv A) <=> diagonal_matrix A`, SUBGOAL_THEN `!A:real^N^N. diagonal_matrix A ==> diagonal_matrix(matrix_inv A)` MP_TAC THENL [REPEAT STRIP_TAC; MESON_TAC[MATRIX_INV_INV]] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP DIAGONAL_MATRIX_INV_EXPLICIT) THEN POP_ASSUM MP_TAC THEN SIMP_TAC[diagonal_matrix; LAMBDA_BETA] THEN REWRITE_TAC[REAL_INV_0]);; let DET_DIAGONAL = prove (`!A:real^N^N. diagonal_matrix A ==> det(A) = product(1..dimindex(:N)) (\i. A$i$i)`, REWRITE_TAC[diagonal_matrix] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DET_LOWERTRIANGULAR THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LT_REFL]);; let INVERTIBLE_DIAGONAL_MATRIX = prove (`!D:real^N^N. diagonal_matrix D ==> (invertible D <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ~(D$i$i = &0))`, SIMP_TAC[INVERTIBLE_DET_NZ; DET_DIAGONAL] THEN SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG] THEN MESON_TAC[]);; let COMMUTING_WITH_DIAGONAL_MATRIX = prove (`!A D:real^N^N. diagonal_matrix D ==> (A ** D = D ** A <=> !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> A$i$j = &0 \/ D$i$i = D$j$j)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o REWRITE_RULE[DIAGONAL_MATRIX]) THEN SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN REWRITE_TAC[MESON[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_MUL_SYM] `(if a = b then x else &0) * y = (if b = a then x * y else &0) /\ y * (if a = b then x else &0) = (if a = b then x * y else &0)`] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_EQ_MUL_RCANCEL] THEN MESON_TAC[]);; let RANK_DIAGONAL_MATRIX = prove (`!A:real^N^N. diagonal_matrix A ==> rank A = CARD {i | i IN 1..dimindex(:N) /\ ~(A$i$i = &0)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[RANK_DIM_IM; GSYM SPAN_STDBASIS] THEN SIMP_TAC[GSYM SPAN_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR; DIM_SPAN] THEN REWRITE_TAC[GSYM IN_NUMSEG; SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF] THEN TRANS_TAC EQ_TRANS `dim {(A:real^N^N)$i$i % basis i:real^N | i IN 1..dimindex(:N)}` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = {g x | x IN s}`) THEN FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; IN_NUMSEG; CART_EQ] THEN ONCE_REWRITE_TAC[MESON[REAL_MUL_LZERO] `(if i = j then a else &0) * b = if j = i then a * b else &0`] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG; BASIS_COMPONENT; VECTOR_MUL_COMPONENT] THEN MESON_TAC[REAL_MUL_RZERO]; ALL_TAC] THEN TRANS_TAC EQ_TRANS `dim {(A:real^N^N)$i$i % basis i:real^N |i| i IN 1..dimindex(:N) /\ ~(A$i$i = &0)}` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[DIM_INSERT_0] `(vec 0:real^N) INSERT s = (vec 0:real^N) INSERT t ==> dim s = dim t`) THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ (!x. x IN s ==> ~(x IN t) ==> x = a) ==> a INSERT s = a INSERT t`) THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC]] THEN SIMP_TAC[VECTOR_MUL_EQ_0; IN_ELIM_THM; BASIS_NONZERO; IN_NUMSEG] THEN SET_TAC[]; ALL_TAC] THEN TRANS_TAC EQ_TRANS `dim{basis i:real^N | i IN 1..dimindex(:N) /\ ~((A:real^N^N)$i$i = &0)}` THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_EQ_DIM THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL [ALL_TAC; SUBGOAL_THEN `basis i:real^N = inv((A:real^N^N)$i$i) % A$i$i % basis i` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; ALL_TAC]] THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) DIM_EQ_CARD o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] INDEPENDENT_MONO) INDEPENDENT_STDBASIS) THEN REWRITE_TAC[IN_NUMSEG] THEN SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG; IN_ELIM_THM; IN_NUMSEG] THEN REWRITE_TAC[IMP_CONJ] THEN SIMP_TAC[BASIS_INJ_EQ]);; let ONORM_DIAGONAL_MATRIX = prove (`!A:real^N^N. diagonal_matrix A ==> onorm(\x. A ** x) = sup {abs(A$i$i) | 1 <= i /\ i <= dimindex(:N)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[onorm] THEN MATCH_MP_TAC SUP_EQ THEN X_GEN_TAC `b:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis i:real^N`) THEN ASM_SIMP_TAC[NORM_BASIS; MATRIX_VECTOR_MUL_BASIS] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[COMPONENT_LE_NORM; REAL_LE_TRANS] `norm(x) <= b ==> !i. abs(x$i) <= b`)) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[column; LAMBDA_BETA]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `norm(b % x:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN FIRST_X_ASSUM(SUBST_ALL_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN SIMP_TAC[LAMBDA_BETA; MATRIX_VECTOR_MUL_COMPONENT; dot] THEN REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN REWRITE_TAC[REAL_ABS_MUL; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `x <= b ==> x <= abs b`) THEN ASM_SIMP_TAC[]; ASM_REWRITE_TAC[NORM_MUL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `1`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Positive semidefinite matrices. *) (* ------------------------------------------------------------------------- *) let positive_semidefinite = new_definition `positive_semidefinite(A:real^N^N) <=> transp A = A /\ !x. &0 <= x dot (A ** x)`;; let POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC = prove (`!A:real^N^N. positive_semidefinite A ==> transp A = A`, SIMP_TAC[positive_semidefinite]);; let POSITIVE_SEMIDEFINITE_ADD = prove (`!A B:real^N^N. positive_semidefinite A /\ positive_semidefinite B ==> positive_semidefinite(A + B)`, SIMP_TAC[positive_semidefinite; TRANSP_MATRIX_ADD] THEN SIMP_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD; REAL_LE_ADD]);; let POSITIVE_SEMIDEFINITE_CMUL = prove (`!c A:real^N^N. positive_semidefinite A /\ &0 <= c ==> positive_semidefinite(c %% A)`, SIMP_TAC[positive_semidefinite; TRANSP_MATRIX_CMUL] THEN SIMP_TAC[MATRIX_VECTOR_LMUL; DOT_RMUL; REAL_LE_MUL]);; let POSITIVE_SEMIDEFINITE_TRANSP = prove (`!A:real^N^N. positive_semidefinite(transp A) <=> positive_semidefinite A`, REWRITE_TAC[positive_semidefinite] THEN MESON_TAC[TRANSP_TRANSP]);; let POSITIVE_SEMIDEFINITE_COVARIANCE = prove (`!A:real^N^M. positive_semidefinite(transp A ** A)`, REWRITE_TAC[positive_semidefinite; MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_TRANSP; DOT_POS_LE]);; let POSITIVE_SEMIDEFINITE_SIMILAR = prove (`!A B:real^N^M. positive_semidefinite A ==> positive_semidefinite(transp B ** A ** B)`, REWRITE_TAC[positive_semidefinite] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; GSYM MATRIX_MUL_ASSOC] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN REWRITE_TAC[GSYM DOT_LMUL_MATRIX; GSYM MATRIX_VECTOR_MUL_TRANSP] THEN ASM_REWRITE_TAC[DOT_LMUL_MATRIX]);; let POSITIVE_SEMIDEFINITE_SIMILAR_EQ = prove (`!A B:real^N^N. invertible B ==> (positive_semidefinite (transp B ** A ** B) <=> positive_semidefinite A)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_SIMILAR] THEN DISCH_THEN(MP_TAC o ISPEC `matrix_inv B:real^N^N` o MATCH_MP POSITIVE_SEMIDEFINITE_SIMILAR) THEN ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV; MATRIX_MUL_RID] THEN REWRITE_TAC[MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN ASM_SIMP_TAC[MATRIX_INV; TRANSP_MAT; MATRIX_MUL_LID]);; let POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX = prove (`!D:real^N^N. diagonal_matrix D /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= D$i$i) ==> positive_semidefinite D`, SIMP_TAC[positive_semidefinite; TRANSP_DIAGONAL_MATRIX] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; dot] THEN SIMP_TAC[COND_RATOR; COND_RAND; REAL_MUL_LZERO] THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN SIMP_TAC[SUM_DELTA] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `x * d * x:real = d * x * x`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_SQUARE]);; let POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ = prove (`!D:real^N^N. diagonal_matrix D ==> (positive_semidefinite D <=> !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= D$i$i)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX] THEN REWRITE_TAC[positive_semidefinite] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis i:real^N`) THEN ASM_SIMP_TAC[DOT_BASIS; MATRIX_VECTOR_MUL_BASIS; column; LAMBDA_BETA]);; let DIAGONAL_POSITIVE_SEMIDEFINITE = prove (`!A:real^N^N i. positive_semidefinite A /\ 1 <= i /\ i <= dimindex(:N) ==> &0 <= A$i$i`, REWRITE_TAC[positive_semidefinite] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis i:real^N`) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; DOT_BASIS; LAMBDA_BETA]);; let TRACE_POSITIVE_SEMIDEFINITE = prove (`!A:real^N^N. positive_semidefinite A ==> &0 <= trace A`, SIMP_TAC[trace; SUM_POS_LE_NUMSEG; DIAGONAL_POSITIVE_SEMIDEFINITE]);; let TRACE_LE_MUL_SQUARES = prove (`!A B:real^N^N. transp A = A /\ transp B = B ==> trace((A ** B) ** (A ** B)) <= trace((A ** A) ** (B ** B))`, REPEAT STRIP_TAC THEN MP_TAC (ISPEC `A ** B - B ** A:real^N^N` POSITIVE_SEMIDEFINITE_COVARIANCE) THEN DISCH_THEN(MP_TAC o MATCH_MP TRACE_POSITIVE_SEMIDEFINITE) THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_MATRIX_SUB; MATRIX_SUB_LDISTRIB] THEN ASM_REWRITE_TAC[MATRIX_SUB_RDISTRIB; TRACE_SUB] THEN MATCH_MP_TAC(REAL_ARITH `a = y /\ d = y /\ b = x /\ c = x ==> &0 <= a - b - (c - d) ==> x <= y`) THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN REPEAT CONJ_TAC THEN REPEAT(GEN_REWRITE_TAC LAND_CONV [TRACE_MUL_SYM] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC]));; let POSITIVE_SEMIDEFINITE_ZERO_FORM = prove (`!A:real^N^N. positive_semidefinite A /\ x dot (A ** x) = &0 ==> A ** x = vec 0`, let lemma = prove (`(!t. &0 <= a + b * t) ==> b = &0`, ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `--(a + &1) / b`) THEN ASM_SIMP_TAC[REAL_DIV_LMUL] THEN REAL_ARITH_TAC) in REWRITE_TAC[positive_semidefinite] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `t:real` o SPEC `(A:real^N^N) ** x + t % x`) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ADD_LDISTRIB; DOT_RADD] THEN REWRITE_TAC[DOT_LADD; MATRIX_VECTOR_MUL_RMUL; DOT_LMUL] THEN REWRITE_TAC[DOT_RMUL] THEN SUBGOAL_THEN `x dot (A ** A ** x) = ((A:real^N^N) ** x) dot (A ** x)` SUBST1_TAC THENL [ASM_REWRITE_TAC[GSYM DOT_LMUL_MATRIX; VECTOR_MATRIX_MUL_TRANSP]; ASM_REWRITE_TAC[REAL_ARITH `(a + t * b) + t * b + t * t * &0 = a + (&2 * b) * t`]] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN REWRITE_TAC[REAL_ENTIRE; DOT_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ]);; let POSITIVE_SEMIDEFINITE_ZERO_FORM_EQ = prove (`!A:real^N^N. positive_semidefinite A ==> (x dot (A ** x) = &0 <=> A ** x = vec 0)`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[DOT_RZERO; POSITIVE_SEMIDEFINITE_ZERO_FORM]);; let POSITIVE_SEMIDEFINITE_1_GEN = prove (`!A:real^N^N. dimindex(:N) = 1 ==> (positive_semidefinite A <=> &0 <= A$1$1)`, REPEAT STRIP_TAC THEN REWRITE_TAC[positive_semidefinite; transp; CART_EQ; dot] THEN ASM_SIMP_TAC[LAMBDA_BETA; ARITH; MATRIX_VECTOR_MUL_COMPONENT] THEN ASM_REWRITE_TAC[FORALL_1; SUM_1; dot] THEN REWRITE_TAC[REAL_ARITH `x * a * x:real = a * x pow 2`] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_MUL; REAL_LE_POW_2]] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN SIMP_TAC[BASIS_COMPONENT; ARITH; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC);; let POSITIVE_SEMIDEFINITE_1 = prove (`!A:real^1^1. positive_semidefinite A <=> &0 <= A$1$1`, GEN_TAC THEN MATCH_MP_TAC POSITIVE_SEMIDEFINITE_1_GEN THEN REWRITE_TAC[DIMINDEX_1]);; let POSITIVE_SEMIDEFINITE_SUBMATRIX_2 = prove (`!A:real^N^N i j. positive_semidefinite A /\ 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> positive_semidefinite (vector[vector[A$i$i;A$i$j]; vector[A$j$i;A$j$j]]:real^2^2)`, REWRITE_TAC[positive_semidefinite] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; DIMINDEX_2; VECTOR_2; ARITH; FORALL_2] THEN ASM_MESON_TAC[]; SIMP_TAC[DOT_2; VECTOR_2; matrix_vector_mul; DIMINDEX_2; LAMBDA_BETA; ARITH; SUM_2]] THEN ASM_CASES_TAC `j:num = i` THENL [ASM_REWRITE_TAC[REAL_ARITH `x * (a * x + a * y) + y * (a * x + a * y):real = a * (x + y) pow 2`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC DIAGONAL_POSITIVE_SEMIDEFINITE THEN ASM_REWRITE_TAC[positive_semidefinite]; FIRST_X_ASSUM(MP_TAC o SPEC `(lambda m. if m = i then (x:real^2)$1 else if m = j then (x:real^2)$2 else &0):real^N`) THEN SIMP_TAC[matrix_vector_mul; LAMBDA_BETA] THEN REPLICATE_TAC 2 (REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN SIMP_TAC[SUM_CASES; FINITE_NUMSEG; SUM_DELTA; REAL_MUL_RZERO] THEN ASM_SIMP_TAC[SET_RULE `P a ==> {x | P x /\ x = a} = {a}`; IN_NUMSEG; IN_ELIM_THM; SUM_SING] THEN SIMP_TAC[dot; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM])]);; (* ------------------------------------------------------------------------- *) (* Trace of covariance as an inner product (actually if we "flatten" the *) (* matrix into a vector, which we could do, it's the usual dot product). *) (* ------------------------------------------------------------------------- *) let TRACE_COVARIANCE_POS_LE = prove (`!A:real^M^N. &0 <= trace(transp A ** A)`, SIMP_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE; TRACE_POSITIVE_SEMIDEFINITE]);; let TRACE_COVARIANCE_EQ_0 = prove (`!A:real^M^N. trace(transp A ** A) = &0 <=> A = mat 0`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[TRACE_0; MATRIX_MUL_RZERO] THEN SIMP_TAC[trace; matrix_mul; transp; LAMBDA_BETA] THEN REPEAT (DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] SUM_POS_EQ_0_NUMSEG)) THEN SIMP_TAC[SUM_POS_LE; REAL_LE_SQUARE; REAL_ENTIRE] THEN ONCE_REWRITE_TAC[GSYM TRANSP_EQ_0] THEN REWRITE_TAC[CART_EQ; MAT_0_COMPONENT; TRANSP_COMPONENT] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[]));; let TRACE_COVARIANCE_POS_LT = prove (`!A:real^M^N. &0 < trace(transp A ** A) <=> ~(A = mat 0)`, MESON_TAC[REAL_LT_LE; TRACE_COVARIANCE_POS_LE; TRACE_COVARIANCE_EQ_0]);; let TRACE_COVARIANCE_CAUCHY_SCHWARZ = prove (`!A B:real^M^N. trace(transp A ** B) <= sqrt(trace(transp A ** A)) * sqrt(trace(transp B ** B))`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`A:real^M^N = mat 0`; `B:real^M^N = mat 0`] THEN ASM_REWRITE_TAC[MATRIX_MUL_LZERO; TRANSP_MAT; TRACE_0; SQRT_0; REAL_ABS_NUM; REAL_MUL_LZERO; REAL_LE_REFL; MATRIX_MUL_RZERO; REAL_MUL_RZERO] THEN MP_TAC(ISPEC `sqrt(trace(transp(B:real^M^N) ** B)) %% A - sqrt(trace(transp(A:real^M^N) ** A)) %% B` TRACE_COVARIANCE_POS_LE) THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB; MATRIX_SUB_RDISTRIB; TRACE_SUB; TRANSP_MATRIX_SUB; TRANSP_MATRIX_CMUL; MATRIX_MUL_LMUL; MATRIX_MUL_RMUL; TRACE_CMUL] THEN ASM_SIMP_TAC[SQRT_POW_2; TRACE_COVARIANCE_POS_LE; REAL_RING `sqrt a pow 2 = a /\ sqrt b pow 2 = b ==> sqrt b * (sqrt b * a - sqrt a * y) - sqrt a * (sqrt b * x - sqrt a * b) = sqrt a * sqrt b * (&2 * sqrt a * sqrt b - (x + y))`] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; SQRT_POS_LT; TRACE_COVARIANCE_POS_LT] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [GSYM TRACE_TRANSP] THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN REAL_ARITH_TAC);; let TRACE_COVARIANCE_CAUCHY_SCHWARZ_ABS = prove (`!A B:real^M^N. abs(trace(transp A ** B)) <= sqrt(trace(transp A ** A)) * sqrt(trace(transp B ** B))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE; TRACE_COVARIANCE_CAUCHY_SCHWARZ] THEN MP_TAC(ISPECL [`A:real^M^N`; `--B:real^M^N`] TRACE_COVARIANCE_CAUCHY_SCHWARZ) THEN REWRITE_TAC[TRANSP_MATRIX_NEG; MATRIX_MUL_LNEG; MATRIX_MUL_RNEG; MATRIX_NEG_NEG; TRACE_NEG] THEN REAL_ARITH_TAC);; let TRACE_COVARIANCE_CAUCHY_SCHWARZ_SQUARE = prove (`!A B:real^M^N. trace(transp A ** B) pow 2 <= trace(transp A ** A) * trace(transp B ** B)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_RSQRT_LE THEN SIMP_TAC[REAL_ABS_POS; REAL_LE_MUL; TRACE_COVARIANCE_POS_LE] THEN REWRITE_TAC[TRACE_COVARIANCE_CAUCHY_SCHWARZ_ABS; SQRT_MUL]);; (* ------------------------------------------------------------------------- *) (* Positive definite matrices. *) (* ------------------------------------------------------------------------- *) let positive_definite = new_definition `positive_definite(A:real^N^N) <=> transp A = A /\ !x. ~(x = vec 0) ==> &0 < x dot (A ** x)`;; let POSITIVE_DEFINITE_IMP_SYMMETRIC = prove (`!A:real^N^N. positive_definite A ==> transp A = A`, SIMP_TAC[positive_definite]);; let POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE = prove (`!A:real^N^N. positive_definite A <=> positive_semidefinite A /\ invertible A`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`; positive_definite; FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN SIMP_TAC[MESON[] `P a ==> ((!x:real^N. ~(x = a) ==> P x) <=> (!x. P x))`; DOT_LZERO; REAL_LE_REFL] THEN REWRITE_TAC[CONJ_ASSOC; GSYM positive_semidefinite] THEN ASM_CASES_TAC `positive_semidefinite(A:real^N^N)` THEN ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_ZERO_FORM_EQ] THEN REWRITE_TAC[GSYM HOMOGENEOUS_LINEAR_EQUATIONS_DET; INVERTIBLE_DET_NZ] THEN MESON_TAC[]);; let POSITIVE_DEFINITE_SIMILAR_EQ = prove (`!A B:real^N^N. positive_definite(transp B ** A ** B) <=> invertible B /\ positive_definite A`, REPEAT GEN_TAC THEN REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE] THEN REWRITE_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP] THEN MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR_EQ]);; let POSITIVE_DEFINITE_1_GEN = prove (`!A:real^N^N. dimindex(:N) = 1 ==> (positive_definite A <=> &0 < A$1$1)`, REPEAT STRIP_TAC THEN REWRITE_TAC[positive_definite; transp; CART_EQ; dot] THEN ASM_SIMP_TAC[LAMBDA_BETA; ARITH; MATRIX_VECTOR_MUL_COMPONENT] THEN ASM_REWRITE_TAC[FORALL_1; SUM_1; dot; VEC_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `x * a * x:real = a * x pow 2`] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_MUL; REAL_LT_POW_2]] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN SIMP_TAC[BASIS_COMPONENT; ARITH; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC);; let POSITIVE_DEFINITE_1 = prove (`!A:real^1^1. positive_definite A <=> &0 < A$1$1`, GEN_TAC THEN MATCH_MP_TAC POSITIVE_DEFINITE_1_GEN THEN REWRITE_TAC[DIMINDEX_1]);; let POSITIVE_DEFINITE_IMP_INVERTIBLE = prove (`!A:real^N^N. positive_definite A ==> invertible A`, SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE]);; let POSITIVE_DEFINITE_IMP_POSITIVE_SEMIDEFINITE = prove (`!A:real^N^N. positive_definite A ==> positive_semidefinite A`, SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE]);; let POSITIVE_SEMIDEFINITE_POSITIVE_DEFINITE_ADD = prove (`!A B:real^N^N. positive_semidefinite A /\ positive_definite B ==> positive_definite(A + B)`, SIMP_TAC[positive_definite; positive_semidefinite; TRANSP_MATRIX_ADD] THEN SIMP_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD; REAL_LET_ADD]);; let POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE_ADD = prove (`!A B:real^N^N. positive_definite A /\ positive_semidefinite B ==> positive_definite(A + B)`, SIMP_TAC[positive_definite; positive_semidefinite; TRANSP_MATRIX_ADD] THEN SIMP_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD; REAL_LTE_ADD]);; let POSITIVE_DEFINITE_ADD = prove (`!A B:real^N^N. positive_definite A /\ positive_definite B ==> positive_definite(A + B)`, SIMP_TAC[positive_definite; TRANSP_MATRIX_ADD] THEN SIMP_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD; REAL_LT_ADD]);; let POSITIVE_DEFINITE_CMUL = prove (`!c A:real^N^N. positive_definite A /\ &0 < c ==> positive_definite(c %% A)`, SIMP_TAC[positive_definite; TRANSP_MATRIX_CMUL] THEN SIMP_TAC[MATRIX_VECTOR_LMUL; DOT_RMUL; REAL_LT_MUL]);; let NEARBY_POSITIVE_DEFINITE_MATRIX_GEN = prove (`!A:real^N^N B x. positive_semidefinite A /\ positive_definite B /\ &0 < x ==> positive_definite(A + x %% B)`, SIMP_TAC[POSITIVE_SEMIDEFINITE_POSITIVE_DEFINITE_ADD; POSITIVE_DEFINITE_CMUL]);; let POSITIVE_DEFINITE_TRANSP = prove (`!A:real^N^N. positive_definite(transp A) <=> positive_definite A`, REWRITE_TAC[positive_definite] THEN MESON_TAC[TRANSP_TRANSP]);; let POSITIVE_DEFINITE_COVARIANCE = prove (`!A:real^N^N. positive_definite(transp A ** A) <=> invertible A`, REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; POSITIVE_SEMIDEFINITE_COVARIANCE] THEN REWRITE_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP]);; let POSITIVE_DEFINITE_SIMILAR = prove (`!A B:real^N^N. positive_definite A /\ invertible B ==> positive_definite(transp B ** A ** B)`, SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; POSITIVE_SEMIDEFINITE_SIMILAR; INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP]);; let POSITIVE_DEFINITE_DIAGONAL_MATRIX = prove (`!D:real^N^N. diagonal_matrix D /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 < D$i$i) ==> positive_definite D`, SIMP_TAC[positive_definite; TRANSP_DIAGONAL_MATRIX] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; dot] THEN SIMP_TAC[COND_RATOR; COND_RAND; REAL_MUL_LZERO] THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN SIMP_TAC[SUM_DELTA] THEN MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[REAL_ARITH `x * d * x:real = d * x * x`] THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_LE_MUL; REAL_LE_SQUARE; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[GSYM REAL_POW_2; REAL_LT_MUL; REAL_LT_POW_2]);; let POSITIVE_DEFINITE_DIAGONAL_MATRIX_EQ = prove (`!D:real^N^N. diagonal_matrix D ==> (positive_definite D <=> !i. 1 <= i /\ i <= dimindex(:N) ==> &0 < D$i$i)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[POSITIVE_DEFINITE_DIAGONAL_MATRIX] THEN REWRITE_TAC[positive_definite] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis i:real^N`) THEN ASM_SIMP_TAC[DOT_BASIS; MATRIX_VECTOR_MUL_BASIS; column; LAMBDA_BETA; BASIS_NONZERO]);; let DIAGONAL_POSITIVE_DEFINITE = prove (`!A:real^N^N i. positive_definite A /\ 1 <= i /\ i <= dimindex(:N) ==> &0 < A$i$i`, REWRITE_TAC[positive_definite] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis i:real^N`) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; DOT_BASIS; LAMBDA_BETA; BASIS_NONZERO]);; let TRACE_POSITIVE_DEFINITE = prove (`!A:real^N^N. positive_definite A ==> &0 < trace A`, SIMP_TAC[trace; SUM_POS_LT_ALL; DIAGONAL_POSITIVE_DEFINITE; IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);; let POSITIVE_DEFINITE_MAT = prove (`!m. positive_definite(mat m:real^N^N) <=> 0 < m`, SIMP_TAC[POSITIVE_DEFINITE_DIAGONAL_MATRIX_EQ; DIAGONAL_MATRIX_MAT] THEN SIMP_TAC[mat; LAMBDA_BETA; REAL_OF_NUM_LT] THEN MESON_TAC[LE_REFL; DIMINDEX_GE_1]);; let POSITIVE_DEFINITE_ID = prove (`positive_definite(mat 1:real^N^N)`, REWRITE_TAC[POSITIVE_DEFINITE_MAT; ARITH]);; let POSITIVE_SEMIDEFINITE_MAT = prove (`!m. positive_semidefinite(mat m:real^N^N)`, SIMP_TAC[POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ; DIAGONAL_MATRIX_MAT] THEN SIMP_TAC[mat; LAMBDA_BETA; REAL_POS] THEN MESON_TAC[LE_REFL; DIMINDEX_GE_1]);; let NEARBY_POSITIVE_DEFINITE_MATRIX = prove (`!A:real^N^N x. positive_semidefinite A /\ &0 < x ==> positive_definite(A + x %% mat 1)`, SIMP_TAC[NEARBY_POSITIVE_DEFINITE_MATRIX_GEN; POSITIVE_DEFINITE_ID]);; (* ------------------------------------------------------------------------- *) (* Hadamard's inequality. *) (* ------------------------------------------------------------------------- *) let HADAMARD_INEQUALITY_ROW = prove (`!A:real^N^N. abs(det A) <= product(1..dimindex(:N)) (\i. norm(row i A))`, GEN_TAC THEN ABBREV_TAC `a = \i. (A:real^N^N)$i` THEN (MP_TAC o DISCH_ALL o instantiate_casewise_recursion) `?b. !j. b j :real^N = a j - vsum(1..j-1) (\i. (a j dot b i) / (b i dot b i) % b i)` THEN ANTS_TAC THENL [EXISTS_TAC `(<):num->num->bool` THEN REWRITE_TAC[WF_num] THEN MATCH_MP_TAC ADMISSIBLE_IMP_SUPERADMISSIBLE THEN REWRITE_TAC[admissible] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_NUMSEG; ARITH_RULE `1 <= x /\ x <= y - 1 ==> x < y`]; DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN ABBREV_TAC `B:real^N^N = lambda i. b i` THEN TRANS_TAC REAL_LE_TRANS `abs(det(B:real^N^N))` THEN CONJ_TAC THENL [SUBGOAL_THEN `!n. det((lambda i. if i <= n then b i else a i):real^N^N) = det(A:real^N^N)` (MP_TAC o SPEC `dimindex(:N)`) THENL [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [AP_TERM_TAC THEN EXPAND_TAC "a" THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN SIMP_TAC[ARITH_RULE `1 <= n ==> ~(n <= 0)`]; X_GEN_TAC `n:num` THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN ASM_CASES_TAC `dimindex(:N) <= n` THENL [AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_ARITH_TAC; FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `~(n <= k) ==> SUC k <= n`))] THEN MP_TAC(ISPECL [`(lambda i. if i <= n then b i else a i):real^N^N`; `SUC n`; `--vsum (1..SUC n - 1) (\i. (a (SUC n) dot b i) / (b i dot b i) % b i):real^N`] DET_ROW_SPAN) THEN ASM_REWRITE_TAC[row; LAMBDA_ETA; ARITH_RULE `1 <= SUC n`] THEN ANTS_TAC THENL [MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `i:num` THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [CART_EQ] THEN X_GEN_TAC `k:num` THEN SIMP_TAC[LAMBDA_BETA] THEN STRIP_TAC THEN ASM_CASES_TAC `SUC n = k` THEN ASM_SIMP_TAC[LE_REFL; LAMBDA_BETA; GSYM VECTOR_SUB; ARITH_RULE `SUC n = k ==> ~(k <= n)`] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_ARITH_TAC]; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [CART_EQ] THEN EXPAND_TAC "B" THEN SIMP_TAC[LAMBDA_BETA]]; ALL_TAC] THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> orthogonal (b i:real^N) (b j)` ASSUME_TAC THENL [ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[ARITH_RULE `j < n /\ 1 <= n /\ n <= N /\ 1 <= j /\ j <= N /\ ~(n = j) <=> (1 <= n /\ n <= N) /\ (1 <= j /\ j <= N /\ j < n)`] THEN MATCH_MP_TAC num_WF THEN CONV_TAC NUM_REDUCE_CONV THEN X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `n:num`) THEN REWRITE_TAC[orthogonal; DOT_LSUB; REAL_SUB_0] THEN SIMP_TAC[DOT_LSUM; FINITE_NUMSEG; DOT_LMUL] THEN TRANS_TAC EQ_TRANS `sum(1..n-1) (\j. if j = m then (a n:real^N) dot (b m) else &0)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_DELTA; IN_NUMSEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_CASES_TAC `(b:num->real^N) m = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO] THEN ASM_SIMP_TAC[DOT_EQ_0; REAL_DIV_RMUL]; CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[GSYM orthogonal] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(m:num = n) ==> n < m \/ m < n`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[ORTHOGONAL_SYM]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> norm(b i:real^N) <= norm(a i:real^N)` ASSUME_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `i:num`) THEN REWRITE_TAC[NORM_LE; VECTOR_ARITH `(x - y:real^N) dot (x - y) = (x dot x + y dot y) - &2 * x dot y`] THEN REWRITE_TAC[REAL_ARITH `(a + b) - x <= a <=> b <= x`] THEN SIMP_TAC[DOT_RSUM; FINITE_NUMSEG; DOT_RMUL; GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x = y ==> y <= &2 * x`) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ARITH `x / y * x:real = (x * x) / y`] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_SQUARE; DOT_POS_LE]; AP_TERM_TAC] THEN TRANS_TAC EQ_TRANS `sum(1..i-1) (\k. if k = j then (a i:real^N) dot (b j) else &0)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[DOT_LSUM; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[DOT_LMUL] THEN ASM_CASES_TAC `(b:num->real^N) j = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO; COND_ID] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DOT_EQ_0; REAL_DIV_RMUL] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[GSYM orthogonal] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(m:num = n) ==> n < m \/ m < n`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[ORTHOGONAL_SYM]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `product(1..dimindex(:N)) (\i. norm(b i:real^N))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC PRODUCT_LE_NUMSEG THEN REWRITE_TAC[NORM_POS_LE; row; LAMBDA_ETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `norm((a:num->real^N) i)` THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "a" THEN REWRITE_TAC[REAL_LE_REFL]] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs x <= abs y ==> abs x <= y`) THEN SIMP_TAC[PRODUCT_POS_LE_NUMSEG; NORM_POS_LE; REAL_LE_SQUARE_ABS] THEN REWRITE_TAC[REAL_POW_2; GSYM PRODUCT_MUL_NUMSEG] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN REWRITE_TAC[GSYM DET_MUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) DET_DIAGONAL o lhand o snd) THEN SIMP_TAC[DIAGONAL_MATRIX_MUL_EQ; pairwise; GSYM ROW_TRANSP; IN_NUMSEG] THEN EXPAND_TAC "B" THEN SIMP_TAC[TRANSP_TRANSP; row; LAMBDA_ETA; LAMBDA_BETA] THEN ASM_REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN EXPAND_TAC "B" THEN REWRITE_TAC[transp; GSYM REAL_POW_2] THEN SIMP_TAC[matrix_mul; NORM_POW_2; dot; LAMBDA_BETA; dot]);; let HADAMARD_INEQUALITY_COLUMN = prove (`!A:real^N^N. abs(det A) <= product(1..dimindex(:N)) (\i. norm(column i A))`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DET_TRANSP] THEN SIMP_TAC[GSYM ROW_TRANSP; HADAMARD_INEQUALITY_ROW]);; (* ------------------------------------------------------------------------- *) (* Orthogonality of a transformation and matrix. *) (* ------------------------------------------------------------------------- *) let orthogonal_transformation = new_definition `orthogonal_transformation(f:real^N->real^N) <=> linear f /\ !v w. f(v) dot f(w) = v dot w`;; let ORTHOGONAL_TRANSFORMATION = prove (`!f. orthogonal_transformation f <=> linear f /\ !v. norm(f v) = norm(v)`, GEN_TAC THEN REWRITE_TAC[orthogonal_transformation] THEN EQ_TAC THENL [MESON_TAC[vector_norm]; SIMP_TAC[DOT_NORM] THEN MESON_TAC[LINEAR_ADD]]);; let ORTHOGONAL_ORTHOGONAL_TRANSFORMATION = prove (`!f x y:real^N. orthogonal_transformation f ==> (orthogonal (f x) (f y) <=> orthogonal x y)`, SIMP_TAC[orthogonal; orthogonal_transformation]);; let ORTHOGONAL_TRANSFORMATION_COMPOSE = prove (`!f g. orthogonal_transformation f /\ orthogonal_transformation g ==> orthogonal_transformation(f o g)`, SIMP_TAC[orthogonal_transformation; LINEAR_COMPOSE; o_THM]);; let ORTHOGONAL_TRANSFORMATION_NEG = prove (`!f:real^N->real^N. orthogonal_transformation(\x. --(f x)) <=> orthogonal_transformation f`, REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; LINEAR_COMPOSE_NEG_EQ; NORM_NEG]);; let ORTHOGONAL_TRANSFORMATION_LINEAR = prove (`!f:real^N->real^N. orthogonal_transformation f ==> linear f`, SIMP_TAC[orthogonal_transformation]);; let ORTHOGONAL_TRANSFORMATION_INJECTIVE = prove (`!f:real^N->real^N. orthogonal_transformation f ==> !x y. f x = f y ==> x = y`, SIMP_TAC[LINEAR_INJECTIVE_0; ORTHOGONAL_TRANSFORMATION; GSYM NORM_EQ_0]);; let ORTHOGONAL_TRANSFORMATION_SURJECTIVE = prove (`!f:real^N->real^N. orthogonal_transformation f ==> !y. ?x. f x = y`, MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE; ORTHOGONAL_TRANSFORMATION_INJECTIVE; orthogonal_transformation]);; let orthogonal_matrix = new_definition `orthogonal_matrix(Q:real^N^N) <=> transp(Q) ** Q = mat 1 /\ Q ** transp(Q) = mat 1`;; let ORTHOGONAL_MATRIX = prove (`orthogonal_matrix(Q:real^N^N) <=> transp(Q) ** Q = mat 1`, MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE; orthogonal_matrix]);; let ORTHOGONAL_MATRIX_ALT = prove (`!A:real^N^N. orthogonal_matrix A <=> A ** transp A = mat 1`, MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE; orthogonal_matrix]);; let ORTHOGONAL_MATRIX_TRANSP_LMUL = prove (`!P:real^N^N. orthogonal_matrix P ==> transp P ** P = mat 1`, REWRITE_TAC[ORTHOGONAL_MATRIX]);; let ORTHOGONAL_MATRIX_TRANSP_RMUL = prove (`!P:real^N^N. orthogonal_matrix P ==> P ** transp P = mat 1`, REWRITE_TAC[ORTHOGONAL_MATRIX_ALT]);; let ORTHOGONAL_MATRIX_ID = prove (`orthogonal_matrix(mat 1)`, REWRITE_TAC[orthogonal_matrix; TRANSP_MAT; MATRIX_MUL_LID]);; let ORTHOGONAL_MATRIX_MUL = prove (`!A B. orthogonal_matrix A /\ orthogonal_matrix B ==> orthogonal_matrix(A ** B)`, REWRITE_TAC[orthogonal_matrix; MATRIX_TRANSP_MUL] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID]);; let ORTHOGONAL_TRANSFORMATION_MATRIX = prove (`!f:real^N->real^N. orthogonal_transformation f <=> linear f /\ orthogonal_matrix(matrix f)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[orthogonal_transformation; ORTHOGONAL_MATRIX] THEN STRIP_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`basis i:real^N`; `basis j:real^N`]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN REWRITE_TAC[DOT_MATRIX_VECTOR_MUL] THEN ABBREV_TAC `A = transp (matrix f) ** matrix(f:real^N->real^N)` THEN ASM_SIMP_TAC[matrix_mul; columnvector; rowvector; basis; LAMBDA_BETA; SUM_DELTA; DIMINDEX_1; LE_REFL; dot; IN_NUMSEG; mat; MESON[REAL_MUL_LID; REAL_MUL_LZERO; REAL_MUL_RID; REAL_MUL_RZERO] `(if b then &1 else &0) * x = (if b then x else &0) /\ x * (if b then &1 else &0) = (if b then x else &0)`]; REWRITE_TAC[orthogonal_matrix; ORTHOGONAL_TRANSFORMATION; NORM_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN ASM_REWRITE_TAC[DOT_MATRIX_VECTOR_MUL] THEN SIMP_TAC[DOT_MATRIX_PRODUCT; MATRIX_MUL_LID]]);; let ORTHOGONAL_MATRIX_TRANSFORMATION = prove (`!A:real^N^N. orthogonal_matrix A <=> orthogonal_transformation(\x. A ** x)`, REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL]);; let ORTHOGONAL_MATRIX_MATRIX = prove (`!f:real^N->real^N. orthogonal_transformation f ==> orthogonal_matrix(matrix f)`, SIMP_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]);; let ORTHOGONAL_MATRIX_NORM_EQ = prove (`!A. orthogonal_matrix A <=> !x. norm(A ** x) = norm x`, REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSFORMATION; MATRIX_VECTOR_MUL_LINEAR; ORTHOGONAL_TRANSFORMATION]);; let ORTHOGONAL_MATRIX_NORM = prove (`!A x:real^N. orthogonal_matrix A ==> norm(A ** x) = norm x`, SIMP_TAC[ORTHOGONAL_MATRIX_TRANSFORMATION; ORTHOGONAL_TRANSFORMATION]);; let DET_ORTHOGONAL_MATRIX = prove (`!Q. orthogonal_matrix Q ==> det(Q) = &1 \/ det(Q) = -- &1`, GEN_TAC THEN REWRITE_TAC[REAL_RING `x = &1 \/ x = -- &1 <=> x * x = &1`] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN SIMP_TAC[GSYM DET_MUL; orthogonal_matrix; DET_I]);; let ORTHOGONAL_MATRIX_IMP_INVERTIBLE = prove (`!A:real^N^N. orthogonal_matrix A ==> invertible A`, GEN_TAC THEN REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_THEN(MP_TAC o MATCH_MP DET_ORTHOGONAL_MATRIX) THEN REAL_ARITH_TAC);; let ORTHOGONAL_MATRIX_TRANSP = prove (`!A:real^N^N. orthogonal_matrix(transp A) <=> orthogonal_matrix A`, REWRITE_TAC[orthogonal_matrix; TRANSP_TRANSP; CONJ_ACI]);; let MATRIX_MUL_LTRANSP_DOT_COLUMN = prove (`!A:real^N^M. transp A ** A = (lambda i j. (column i A) dot (column j A))`, SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; transp; dot; column]);; let MATRIX_MUL_RTRANSP_DOT_ROW = prove (`!A:real^N^M. A ** transp A = (lambda i j. (row i A) dot (row j A))`, SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; transp; dot; row]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS = prove (`!A:real^N^N. orthogonal_matrix A <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> orthogonal (column i A) (column j A))`, REWRITE_TAC[ORTHOGONAL_MATRIX] THEN SIMP_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN; CART_EQ; mat; LAMBDA_BETA] THEN REWRITE_TAC[orthogonal; NORM_EQ_1] THEN MESON_TAC[]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS = prove (`!A:real^N^N. orthogonal_matrix A <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> orthogonal (row i A) (row j A))`, ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS; COLUMN_TRANSP]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED = prove (`!A:real^N^N. orthogonal_matrix A <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ pairwise (\i j. orthogonal (row i A) (row j A)) (1..dimindex(:N))`, REPEAT GEN_TAC THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ALT] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; pairwise; MAT_COMPONENT] THEN SIMP_TAC[MATRIX_MUL_RTRANSP_DOT_ROW; IN_NUMSEG; LAMBDA_BETA] THEN REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[orthogonal] THEN MESON_TAC[]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE = prove (`!A:real^N^N. orthogonal_matrix A <=> CARD(rows A) = dimindex(:N) /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ pairwise orthogonal (rows A)`, REWRITE_TAC[rows; ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[PAIRWISE_IMAGE; GSYM numseg] THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r /\ s)) ==> (p /\ q <=> r /\ p /\ s)`) THEN DISCH_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[CARD_IMAGE_EQ_INJ; FINITE_NUMSEG] THEN REWRITE_TAC[pairwise; IN_NUMSEG] THEN ASM_MESON_TAC[ORTHOGONAL_REFL; NORM_ARITH `~(norm(vec 0:real^N) = &1)`]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN = prove (`!A:real^N^N. orthogonal_matrix A <=> span(rows A) = (:real^N) /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ pairwise orthogonal (rows A)`, GEN_TAC THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(SET_RULE `UNIV SUBSET s ==> s = UNIV`) THEN MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN ASM_REWRITE_TAC[DIM_UNIV; SUBSET_UNIV; LE_REFL]; CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM DIM_UNIV] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[DIM_SPAN] THEN MATCH_MP_TAC DIM_EQ_CARD] THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[rows; IN_ELIM_THM] THEN ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED = prove (`!A:real^N^N. orthogonal_matrix A <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ pairwise (\i j. orthogonal (column i A) (column j A)) (1..dimindex(:N))`, ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED] THEN SIMP_TAC[ROW_TRANSP; ROWS_TRANSP; pairwise; IN_NUMSEG]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE = prove (`!A:real^N^N. orthogonal_matrix A <=> CARD(columns A) = dimindex(:N) /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ pairwise orthogonal (columns A)`, ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE] THEN SIMP_TAC[ROW_TRANSP; ROWS_TRANSP]);; let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN = prove (`!A:real^N^N. orthogonal_matrix A <=> span(columns A) = (:real^N) /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ pairwise orthogonal (columns A)`, ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN] THEN SIMP_TAC[ROW_TRANSP; ROWS_TRANSP]);; let ORTHOGONAL_MATRIX_2 = prove (`!A:real^2^2. orthogonal_matrix A <=> A$1$1 pow 2 + A$2$1 pow 2 = &1 /\ A$1$2 pow 2 + A$2$2 pow 2 = &1 /\ A$1$1 * A$1$2 + A$2$1 * A$2$2 = &0`, SIMP_TAC[orthogonal_matrix; CART_EQ; matrix_mul; LAMBDA_BETA; TRANSP_COMPONENT; MAT_COMPONENT] THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; SUM_2] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING);; let ORTHOGONAL_MATRIX_2_ALT = prove (`!A:real^2^2. orthogonal_matrix A <=> A$1$1 pow 2 + A$2$1 pow 2 = &1 /\ (A$1$1 = A$2$2 /\ A$1$2 = --(A$2$1) \/ A$1$1 = --(A$2$2) /\ A$1$2 = A$2$1)`, REWRITE_TAC[ORTHOGONAL_MATRIX_2] THEN CONV_TAC REAL_RING);; let ORTHOGONAL_MATRIX_INV = prove (`!A:real^N^N. orthogonal_matrix A ==> matrix_inv A = transp A`, MESON_TAC[orthogonal_matrix; MATRIX_INV_UNIQUE]);; let ORTHOGONAL_MATRIX_INV_EQ = prove (`!A:real^N^N. orthogonal_matrix(matrix_inv A) <=> orthogonal_matrix A`, MATCH_MP_TAC(MESON[] `(!x. f(f x) = x) /\ (!x. P x ==> P(f x)) ==> (!x. P(f x) <=> P x)`) THEN REWRITE_TAC[MATRIX_INV_INV] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP ORTHOGONAL_MATRIX_INV) THEN ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP]);; let ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS = prove (`!f:real^N->real^N v w a b. orthogonal_transformation f /\ f v = a % v /\ f w = b % w /\ ~(a = b) ==> orthogonal v w`, REWRITE_TAC[orthogonal_transformation] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`v:real^N`; `v:real^N`] th) THEN MP_TAC(SPECL [`v:real^N`; `w:real^N`] th) THEN MP_TAC(SPECL [`w:real^N`; `w:real^N`] th)) THEN ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; orthogonal] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_RING `x * y = y <=> x = &1 \/ y = &0`] THEN REWRITE_TAC[DOT_EQ_0] THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THEN ASM_CASES_TAC `w:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN ASM_CASES_TAC `(v:real^N) dot w = &0` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(a:real = b)` THEN CONV_TAC REAL_RING);; let ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS = prove (`!A:real^N^N v w a b. orthogonal_matrix A /\ A ** v = a % v /\ A ** w = b % w /\ ~(a = b) ==> orthogonal v w`, REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSFORMATION; ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS]);; let ORTHOGONAL_TRANSFORMATION_ID = prove (`orthogonal_transformation(\x. x)`, REWRITE_TAC[orthogonal_transformation; LINEAR_ID]);; let ORTHOGONAL_TRANSFORMATION_I = prove (`orthogonal_transformation I`, REWRITE_TAC[I_DEF; ORTHOGONAL_TRANSFORMATION_ID]);; let ORTHOGONAL_TRANSFORMATION_1_GEN = prove (`!f:real^N->real^N. dimindex(:N) = 1 ==> (orthogonal_transformation f <=> f = I \/ f = (--))`, REPEAT STRIP_TAC THEN REWRITE_TAC[I_DEF] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM ETA_AX] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID; ORTHOGONAL_TRANSFORMATION_NEG] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ORTHOGONAL_TRANSFORMATION]) THEN ASM_SIMP_TAC[LINEAR_1_GEN] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[NORM_MUL] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; DIMINDEX_1] THEN REWRITE_TAC[REAL_ARITH `abs x * &1 = &1 <=> x = &1 \/ x = -- &1`] THEN MATCH_MP_TAC MONO_OR THEN SIMP_TAC[FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH);; let ORTHOGONAL_MATRIX_1 = prove (`!m:real^N^N. dimindex(:N) = 1 ==> (orthogonal_matrix m <=> m = mat 1 \/ m = --mat 1)`, REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSFORMATION] THEN SIMP_TAC[ORTHOGONAL_TRANSFORMATION_1_GEN] THEN REWRITE_TAC[MATRIX_EQ; FUN_EQ_THM] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LID; MATRIX_VECTOR_MUL_LNEG] THEN REWRITE_TAC[I_THM]);; let MATRIX_INV_ORTHOGONAL_LMUL = prove (`!U A:real^M^N. orthogonal_matrix U ==> matrix_inv(U ** A) = matrix_inv A ** matrix_inv U`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN REWRITE_TAC[MATRIX_TRANSP_MUL; GSYM MATRIX_MUL_ASSOC] THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_INV; TRANSP_TRANSP] THEN REWRITE_TAC[MESON[MATRIX_MUL_ASSOC] `(A:real^M^N) ** transp U ** U ** (B:real^P^M) = A ** (transp U ** U) ** B`] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM orthogonal_matrix]) THEN ASM_SIMP_TAC[MATRIX_MUL_LCANCEL; ORTHOGONAL_MATRIX_IMP_INVERTIBLE] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_MUL_RCANCEL; ORTHOGONAL_MATRIX_IMP_INVERTIBLE; ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; GSYM MATRIX_MUL_ASSOC] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_LMUL; SYMMETRIC_MATRIX_INV_RMUL; MATRIX_INV_MUL_INNER; MATRIX_INV_MUL_OUTER]);; let MATRIX_INV_ORTHOGONAL_RMUL = prove (`!U A:real^M^N. orthogonal_matrix U ==> matrix_inv(A ** U) = matrix_inv U ** matrix_inv A`, ONCE_REWRITE_TAC[GSYM TRANSP_EQ; GSYM ORTHOGONAL_MATRIX_TRANSP] THEN SIMP_TAC[TRANSP_MATRIX_INV; MATRIX_TRANSP_MUL; MATRIX_INV_ORTHOGONAL_LMUL]);; let ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT = prove (`!f:real^N->real^N. orthogonal_transformation f <=> linear f /\ adjoint f o f = I`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM] THEN EQ_TAC THENL [REWRITE_TAC[orthogonal_transformation] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ADJOINT_WORKS th]) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[VECTOR_EQ_LDOT]; STRIP_TAC THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN REWRITE_TAC[NORM_EQ] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ADJOINT_WORKS th]) THEN ASM_REWRITE_TAC[]]);; let ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_RIGHT = prove (`!f:real^N->real^N. orthogonal_transformation f <=> linear f /\ f o adjoint f = I`, GEN_TAC THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT] THEN MESON_TAC[ADJOINT_LINEAR; LINEAR_INVERSE_LEFT]);; let ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT = prove (`!f:real^N->real^N. orthogonal_transformation f <=> linear f /\ adjoint f o f = I /\ f o adjoint f = I`, MESON_TAC[ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT; ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_RIGHT]);; let ORTHOGONAL_TRANSFORMATION_ADJOINT = prove (`!f:real^N->real^N. orthogonal_transformation f ==> orthogonal_transformation(adjoint f)`, REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT] THEN SIMP_TAC[ADJOINT_ADJOINT; ADJOINT_LINEAR] THEN MESON_TAC[ADJOINT_LINEAR; LINEAR_INVERSE_LEFT]);; let ORTHOGONAL_TRANSFORMATION_ADJOINT_EQ = (`!f:real^N->real^N. linear f ==> (orthogonal_transformation(adjoint f) <=> orthogonal_transformation f)`, MESON_TAC[ORTHOGONAL_TRANSFORMATION_ADJOINT; ADJOINT_LINEAR; ADJOINT_ADJOINT]);; let ONORM_ORTHOGONAL_TRANSFORMATION = prove (`!f:real^N->real^N. orthogonal_transformation f ==> onorm f = &1`, SIMP_TAC[ORTHOGONAL_TRANSFORMATION; onorm] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `c:real` THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL]);; let ONORM_ORTHOGONAL_MATRIX = prove (`!A:real^N^N. orthogonal_matrix A ==> onorm(\x. A ** x) = &1`, REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSFORMATION] THEN REWRITE_TAC[ONORM_ORTHOGONAL_TRANSFORMATION]);; (* ------------------------------------------------------------------------- *) (* Linearity of scaling, and hence isometry, that preserves origin. *) (* ------------------------------------------------------------------------- *) let SCALING_LINEAR = prove (`!f:real^M->real^N c. (f(vec 0) = vec 0) /\ (!x y. dist(f x,f y) = c * dist(x,y)) ==> linear(f)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!v w. ((f:real^M->real^N) v) dot (f w) = c pow 2 * (v dot w)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o GEN `v:real^M` o SPECL [`v:real^M`; `vec 0 :real^M`]) THEN REWRITE_TAC[dist] THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN ASM_REWRITE_TAC[DOT_NORM_NEG; GSYM dist] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[linear; VECTOR_EQ] THEN ASM_REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN REAL_ARITH_TAC);; let ISOMETRY_LINEAR = prove (`!f:real^M->real^N. (f(vec 0) = vec 0) /\ (!x y. dist(f x,f y) = dist(x,y)) ==> linear(f)`, MESON_TAC[SCALING_LINEAR; REAL_MUL_LID]);; let ISOMETRY_IMP_AFFINITY = prove (`!f:real^M->real^N. (!x y. dist(f x,f y) = dist(x,y)) ==> ?h. linear h /\ !x. f(x) = f(vec 0) + h(x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. (f:real^M->real^N) x - f(vec 0)` THEN REWRITE_TAC[VECTOR_ARITH `a + (x - a):real^N = x`] THEN MATCH_MP_TAC ISOMETRY_LINEAR THEN REWRITE_TAC[VECTOR_SUB_REFL] THEN ASM_REWRITE_TAC[NORM_ARITH `dist(x - a:real^N,y - a) = dist(x,y)`]);; (* ------------------------------------------------------------------------- *) (* An orthogonality-preserving linear map is a similarity. *) (* ------------------------------------------------------------------------- *) let ORTHOGONALITY_PRESERVING_IMP_SCALING = prove (`!f:real^M->real^N. linear f /\ (!x y. orthogonal x y ==> orthogonal (f x) (f y)) ==> ?c. &0 <= c /\ !x. norm(f x) = c * norm(x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c. &0 <= c /\ !i. 1 <= i /\ i <= dimindex(:M) ==> norm((f:real^M->real^N)(basis i)) = c` MP_TAC THENL [MATCH_MP_TAC(MESON[] `(!x. A(f x)) /\ (?x. P x) /\ (!i j. P i /\ P j ==> f i = f j) ==> ?c. A c /\ !x. P x ==> f x = c`) THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [EXISTS_TAC `1` THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`basis i + basis j:real^M`; `basis i - basis j:real^M`]) THEN ASM_SIMP_TAC[orthogonal; LINEAR_ADD; LINEAR_SUB; VECTOR_ARITH `(x + y:real^M) dot (x - y) = x dot x - y dot y`] THEN ASM_SIMP_TAC[GSYM NORM_POW_2; REAL_SUB_0; NORM_BASIS] THEN REWRITE_TAC[NORM_POW_2; GSYM NORM_EQ]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN STRIP_TAC THEN ASM_SIMP_TAC[NORM_EQ_SQUARE; NORM_POS_LE; REAL_LE_MUL] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[GSYM NORM_POW_2] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG; o_DEF; LINEAR_CMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o lhand o snd) THEN REWRITE_TAC[pairwise; IN_NUMSEG; ORTHOGONAL_MUL; FINITE_NUMSEG] THEN ASM_SIMP_TAC[ORTHOGONAL_BASIS_BASIS] THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[NORM_MUL; REAL_POW_MUL; SUM_RMUL; REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2; GSYM dot; GSYM NORM_POW_2]]);; let ORTHOGONALITY_PRESERVING_EQ_SIMILARITY_ALT, ORTHOGONALITY_PRESERVING_EQ_SIMILARITY = (CONJ_PAIR o prove) (`(!f:real^N->real^N. linear f /\ (!x y. orthogonal x y ==> orthogonal (f x) (f y)) <=> ?c g. &0 <= c /\ orthogonal_transformation g /\ f = \z. c % g z) /\ (!f:real^N->real^N. linear f /\ (!x y. orthogonal x y ==> orthogonal (f x) (f y)) <=> ?c g. orthogonal_transformation g /\ f = \z. c % g z)`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; STRIP_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_COMPOSE_CMUL] THEN ASM_SIMP_TAC[ORTHOGONAL_MUL; ORTHOGONAL_ORTHOGONAL_TRANSFORMATION]; DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONALITY_PRESERVING_IMP_SCALING) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN ASM_CASES_TAC `c = &0` THENL [ASM_SIMP_TAC[REAL_MUL_LZERO; FUN_EQ_THM; NORM_EQ_0] THEN DISCH_TAC THEN EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[VECTOR_MUL_LZERO; ORTHOGONAL_TRANSFORMATION_ID]; STRIP_TAC THEN EXISTS_TAC `\x. inv(c) % (f:real^N->real^N) x` THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; FUN_EQ_THM] THEN ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; NORM_MUL; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; REAL_ABS_INV] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID]]]);; (* ------------------------------------------------------------------------- *) (* Hence another formulation of orthogonal transformation. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_TRANSFORMATION_ISOMETRY = prove (`!f:real^N->real^N. orthogonal_transformation f <=> (f(vec 0) = vec 0) /\ (!x y. dist(f x,f y) = dist(x,y))`, GEN_TAC THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN EQ_TAC THENL [MESON_TAC[LINEAR_0; LINEAR_SUB; dist]; STRIP_TAC] THEN ASM_SIMP_TAC[ISOMETRY_LINEAR] THEN X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `vec 0:real^N`]) THEN ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO]);; (* ------------------------------------------------------------------------- *) (* Can extend an isometry from unit sphere. *) (* ------------------------------------------------------------------------- *) let ISOMETRY_SPHERE_EXTEND = prove (`!f:real^N->real^N. (!x. norm(x) = &1 ==> norm(f x) = &1) /\ (!x y. norm(x) = &1 /\ norm(y) = &1 ==> dist(f x,f y) = dist(x,y)) ==> ?g. orthogonal_transformation g /\ (!x. norm(x) = &1 ==> g(x) = f(x))`, let lemma = prove (`!x:real^N y:real^N x':real^N y':real^N x0 y0 x0' y0'. x = norm(x) % x0 /\ y = norm(y) % y0 /\ x' = norm(x) % x0' /\ y' = norm(y) % y0' /\ norm(x0) = &1 /\ norm(x0') = &1 /\ norm(y0) = &1 /\ norm(y0') = &1 /\ norm(x0' - y0') = norm(x0 - y0) ==> norm(x' - y') = norm(x - y)`, REPEAT GEN_TAC THEN MAP_EVERY ABBREV_TAC [`a = norm(x:real^N)`; `b = norm(y:real^N)`] THEN REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NORM_EQ; NORM_EQ_1] THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING) in REPEAT STRIP_TAC THEN EXISTS_TAC `\x. if x = vec 0 then vec 0 else norm(x) % (f:real^N->real^N)(inv(norm x) % x)` THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ISOMETRY] THEN SIMP_TAC[VECTOR_MUL_LID; REAL_INV_1] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[NORM_0; REAL_ARITH `~(&1 = &0)`]] THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[dist; VECTOR_SUB_LZERO; VECTOR_SUB_RZERO; NORM_NEG; NORM_MUL; REAL_ABS_NORM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; NORM_POS_LT] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; NORM_EQ_0] THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0] THEN MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC [`inv(norm x) % x:real^N`; `inv(norm y) % y:real^N`; `(f:real^N->real^N) (inv (norm x) % x)`; `(f:real^N->real^N) (inv (norm y) % y)`] THEN REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV; NORM_EQ_0] THEN ASM_REWRITE_TAC[GSYM dist; VECTOR_MUL_LID] THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV; NORM_EQ_0]);; let ORTHOGONAL_TRANSFORMATION_INVERSE_o = prove (`!f:real^N->real^N. orthogonal_transformation f ==> ?g. orthogonal_transformation g /\ g o f = I /\ f o g = I`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INJECTIVE) THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `g:real^N->real^N`] LINEAR_INVERSE_LEFT) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN X_GEN_TAC `v:real^N` THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `norm((f:real^N->real^N)((g:real^N->real^N) v))` THEN CONJ_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN ASM_REWRITE_TAC[]);; let ORTHOGONAL_TRANSFORMATION_INVERSE = prove (`!f:real^N->real^N. orthogonal_transformation f ==> ?g. orthogonal_transformation g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; let ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT = prove (`!f g. orthogonal_transformation f ==> onorm(f o g) = onorm g`, SIMP_TAC[ORTHOGONAL_TRANSFORMATION; onorm; o_DEF]);; let ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT = prove (`!f g. orthogonal_transformation g ==> onorm(f o g) = onorm f`, REPEAT STRIP_TAC THEN REWRITE_TAC[onorm; o_DEF] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* We can find an orthogonal matrix taking any unit vector to any other. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_MATRIX_EXISTS_BASIS = prove (`!a:real^N. norm(a) = &1 ==> ?A. orthogonal_matrix A /\ A**(basis 1) = a`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP VECTOR_IN_ORTHONORMAL_BASIS) THEN REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] FINITE_INDEX_NUMSEG_SPECIAL) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN REWRITE_TAC[TAUT `a /\ b ==> c <=> c \/ ~a \/ ~b`] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC))) THEN EXISTS_TAC `(lambda i j. ((f j):real^N)$i):real^N^N` THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_vector_mul; BASIS_COMPONENT; IN_NUMSEG] THEN ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN ASM_REWRITE_TAC[IN_NUMSEG; REAL_MUL_RID; LE_REFL; DIMINDEX_GE_1] THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS] THEN SIMP_TAC[column; LAMBDA_BETA] THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `norm((f:num->real^N) i)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]; ASM_MESON_TAC[IN_IMAGE; IN_NUMSEG]]; MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `orthogonal ((f:num->real^N) i) (f j)` MP_TAC THENL [ASM_MESON_TAC[pairwise; IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]]);; let ORTHOGONAL_TRANSFORMATION_EXISTS_1 = prove (`!a b:real^N. norm(a) = &1 /\ norm(b) = &1 ==> ?f. orthogonal_transformation f /\ f a = b`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `b:real^N` ORTHOGONAL_MATRIX_EXISTS_BASIS) THEN MP_TAC(ISPEC `a:real^N` ORTHOGONAL_MATRIX_EXISTS_BASIS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (STRIP_ASSUME_TAC o GSYM)) THEN DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `\x:real^N. ((B:real^N^N) ** transp(A:real^N^N)) ** x` THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; MATRIX_VECTOR_MUL_LINEAR; MATRIX_OF_MATRIX_VECTOR_MUL] THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_MATRIX]) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]);; let ORTHOGONAL_TRANSFORMATION_EXISTS = prove (`!a b:real^N. norm(a) = norm(b) ==> ?f. orthogonal_transformation f /\ f a = b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = vec 0` THEN ASM_SIMP_TAC[NORM_0; NORM_EQ_0] THENL [MESON_TAC[ORTHOGONAL_TRANSFORMATION_ID]; ALL_TAC] THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_MESON_TAC[NORM_0; NORM_EQ_0]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(norm a) % a:real^N`; `inv(norm b) % b:real^N`] ORTHOGONAL_TRANSFORMATION_EXISTS_1) THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_MUL_LINV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN ASM_REWRITE_TAC[VECTOR_ARITH `a % x:real^N = a % y <=> a % (x - y) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ]);; (* ------------------------------------------------------------------------- *) (* Or indeed, taking any subspace to another of suitable dimension. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ dim s <= dim t ==> ?f. orthogonal_transformation f /\ IMAGE f s SUBSET t`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN MP_TAC(ISPEC `s:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN ASM_REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^N->bool`; `(:real^N)`] ORTHONORMAL_EXTENSION) THEN MP_TAC(ISPECL [`b:real^N->bool`; `(:real^N)`] ORTHONORMAL_EXTENSION) THEN ASM_REWRITE_TAC[UNION_UNIV; SPAN_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b':real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `independent(b UNION b':real^N->bool) /\ independent(c UNION c':real^N->bool)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[IN_UNION] THEN ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(b UNION b':real^N->bool) /\ FINITE(c UNION c':real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[PAIRWISE_ORTHOGONAL_IMP_FINITE]; REWRITE_TAC[FINITE_UNION] THEN STRIP_TAC] THEN SUBGOAL_THEN `?f:real^N->real^N. (!x y. x IN b UNION b' /\ y IN b UNION b' ==> (f x = f y <=> x = y)) /\ IMAGE f b SUBSET c /\ IMAGE f (b UNION b') SUBSET c UNION c'` (X_CHOOSE_THEN `fb:real^N->real^N` STRIP_ASSUME_TAC) THENL [MP_TAC(ISPECL [`b:real^N->bool`; `c:real^N->bool`] CARD_LE_INJ) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_ALT] THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`b':real^N->bool`; `(c UNION c') DIFF IMAGE (f:real^N->real^N) b`] CARD_LE_INJ) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_UNION; FINITE_DIFF] THEN W(MP_TAC o PART_MATCH (lhs o rand) CARD_DIFF o rand o snd) THEN ASM_REWRITE_TAC[FINITE_UNION] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(ARITH_RULE `a + b:num = c ==> a <= c - b`) THEN W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o rand o lhs o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (rhs o rand) CARD_UNION o lhs o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNION_COMM] THEN MATCH_MP_TAC(MESON[LE_ANTISYM] `(FINITE s /\ CARD s <= CARD t) /\ (FINITE t /\ CARD t <= CARD s) ==> CARD s = CARD t`) THEN CONJ_TAC THEN MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN ASM_REWRITE_TAC[FINITE_UNION; SUBSET_UNIV]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. if x IN b then (f:real^N->real^N) x else g x` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]; ALL_TAC] THEN MP_TAC(ISPECL [`fb:real^N->real^N`; `b UNION b':real^N->bool`] LINEAR_INDEPENDENT_EXTEND) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION]; REWRITE_TAC[SYM(ASSUME `span b:real^N->bool = s`)] THEN ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `!v. v IN UNIV ==> norm((f:real^N->real^N) v) = norm v` (fun th -> ASM_MESON_TAC[th; IN_UNIV]) THEN UNDISCH_THEN `span (b UNION b') = (:real^N)` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[SPAN_FINITE; FINITE_UNION; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^N`; `u:real^N->real`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM; FINITE_UNION] THEN REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN ASM_SIMP_TAC[LINEAR_CMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o rand o snd) THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES; FINITE_UNION] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN REPEAT DISJ2_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL] THEN MATCH_MP_TAC SUM_EQ THEN ASM SET_TAC[]]);; let ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ dim s = dim t ==> ?f. orthogonal_transformation f /\ IMAGE f s = t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE) THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `span(IMAGE (f:real^N->real^N) s) = span t` MP_TAC THENL [MATCH_MP_TAC DIM_EQ_SPAN THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhs o rand) DIM_INJECTIVE_LINEAR_IMAGE o rand o snd) THEN ASM_MESON_TAC[LE_REFL; orthogonal_transformation; ORTHOGONAL_TRANSFORMATION_INJECTIVE]; ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE]]);; (* ------------------------------------------------------------------------- *) (* Rotation, reflection, rotoinversion. *) (* ------------------------------------------------------------------------- *) let rotation_matrix = new_definition `rotation_matrix Q <=> orthogonal_matrix Q /\ det(Q) = &1`;; let rotoinversion_matrix = new_definition `rotoinversion_matrix Q <=> orthogonal_matrix Q /\ det(Q) = -- &1`;; let ORTHOGONAL_ROTATION_OR_ROTOINVERSION = prove (`!Q. orthogonal_matrix Q <=> rotation_matrix Q \/ rotoinversion_matrix Q`, MESON_TAC[rotation_matrix; rotoinversion_matrix; DET_ORTHOGONAL_MATRIX]);; let ROTATION_MATRIX_1 = prove (`!m:real^N^N. dimindex(:N) = 1 ==> (rotation_matrix m <=> m = mat 1)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_1; rotation_matrix] THEN ASM_CASES_TAC `m:real^N^N = mat 1` THEN ASM_REWRITE_TAC[DET_I] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[DET_NEG; REAL_POW_ONE; DET_I] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ROTOINVERSION_MATRIX_1 = prove (`!m:real^N^N. dimindex(:N) = 1 ==> (rotoinversion_matrix m <=> m = --mat 1)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_1; rotoinversion_matrix] THEN ASM_CASES_TAC `m:real^N^N = --mat 1` THEN ASM_REWRITE_TAC[DET_NEG; DET_I; REAL_POW_ONE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[DET_I] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ROTATION_MATRIX_2 = prove (`!A:real^2^2. rotation_matrix A <=> A$1$1 pow 2 + A$2$1 pow 2 = &1 /\ A$1$1 = A$2$2 /\ A$1$2 = --(A$2$1)`, REWRITE_TAC[rotation_matrix; ORTHOGONAL_MATRIX_2; DET_2] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Slightly stronger results giving rotation, but only in >= 2 dimensions. *) (* ------------------------------------------------------------------------- *) let ROTATION_MATRIX_EXISTS_BASIS = prove (`!a:real^N. 2 <= dimindex(:N) /\ norm(a) = &1 ==> ?A. rotation_matrix A /\ A**(basis 1) = a`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `A:real^N^N` STRIP_ASSUME_TAC o MATCH_MP ORTHOGONAL_MATRIX_EXISTS_BASIS) THEN FIRST_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [ORTHOGONAL_ROTATION_OR_ROTOINVERSION]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `transp(lambda i. if i = dimindex(:N) then -- &1 % transp A$i else (transp A:real^N^N)$i):real^N^N` THEN REWRITE_TAC[rotation_matrix; DET_TRANSP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP]; SIMP_TAC[DET_ROW_MUL; DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `x = -- &1 ==> -- &1 * x = &1`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [rotoinversion_matrix]) THEN DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; CART_EQ; transp; BASIS_COMPONENT] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * (if p then &1 else &0) = if p then x else &0`] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(1 = n)`; LAMBDA_BETA]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ORTHOGONAL_MATRIX_TRANSP]) THEN SPEC_TAC(`transp(A:real^N^N)`,`B:real^N^N`) THEN GEN_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> row i ((lambda i. if i = dimindex(:N) then -- &1 % B$i else (B:real^N^N)$i):real^N^N) = if i = dimindex(:N) then --(row i B) else row i B` ASSUME_TAC THENL [SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA; VECTOR_MUL_LID; VECTOR_MUL_LNEG]; ASM_SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS] THEN ASM_MESON_TAC[ORTHOGONAL_LNEG; ORTHOGONAL_RNEG; NORM_NEG]]);; let ROTATION_EXISTS_1 = prove (`!a b:real^N. 2 <= dimindex(:N) /\ norm(a) = &1 /\ norm(b) = &1 ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ f a = b`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `b:real^N` ROTATION_MATRIX_EXISTS_BASIS) THEN MP_TAC(ISPEC `a:real^N` ROTATION_MATRIX_EXISTS_BASIS) THEN ASM_REWRITE_TAC[rotation_matrix] THEN DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC (ASSUME_TAC o SYM))) THEN DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC (ASSUME_TAC o SYM))) THEN EXISTS_TAC `\x:real^N. ((B:real^N^N) ** transp(A:real^N^N)) ** x` THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; MATRIX_VECTOR_MUL_LINEAR; MATRIX_OF_MATRIX_VECTOR_MUL; DET_MUL; DET_TRANSP] THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC; REAL_MUL_LID] THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_MATRIX]) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]);; let ROTATION_EXISTS = prove (`!a b:real^N. 2 <= dimindex(:N) /\ norm(a) = norm(b) ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ f a = b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = vec 0` THEN ASM_SIMP_TAC[NORM_0; NORM_EQ_0] THENL [MESON_TAC[ORTHOGONAL_TRANSFORMATION_ID; MATRIX_ID; DET_I]; ALL_TAC] THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_ID; MATRIX_ID; DET_I; NORM_0; NORM_EQ_0]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(norm a) % a:real^N`; `inv(norm b) % b:real^N`] ROTATION_EXISTS_1) THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_MUL_LINV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN ASM_REWRITE_TAC[VECTOR_ARITH `a % x:real^N = a % y <=> a % (x - y) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ]);; let ROTATION_RIGHTWARD_LINE = prove (`!a:real^N k. 1 <= k /\ k <= dimindex(:N) ==> ?b f. orthogonal_transformation f /\ (2 <= dimindex(:N) ==> det(matrix f) = &1) /\ f(b % basis k) = a /\ &0 <= b`, REPEAT STRIP_TAC THEN EXISTS_TAC `norm(a:real^N)` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; LE_REFL; DIMINDEX_GE_1; REAL_MUL_RID; NORM_POS_LE; LT_IMP_LE; LTE_ANTISYM] THEN REWRITE_TAC[ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`; DIMINDEX_GE_1] THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC ORTHOGONAL_TRANSFORMATION_EXISTS; MATCH_MP_TAC ROTATION_EXISTS] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN REWRITE_TAC[REAL_ABS_NORM; REAL_MUL_RID] THEN MATCH_MP_TAC(ARITH_RULE `~(n = 1) /\ 1 <= n ==> 2 <= n`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1]);; (* ------------------------------------------------------------------------- *) (* In 3 dimensions, a rotation is indeed about an "axis". *) (* ------------------------------------------------------------------------- *) let EULER_ROTATION_THEOREM = prove (`!A:real^3^3. rotation_matrix A ==> ?v:real^3. ~(v = vec 0) /\ A ** v = v`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `A - mat 1:real^3^3` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_RDISTRIB; VECTOR_SUB_EQ; MATRIX_VECTOR_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[rotation_matrix; orthogonal_matrix; DET_3] THEN SIMP_TAC[CART_EQ; FORALL_3; MAT_COMPONENT; DIMINDEX_3; LAMBDA_BETA; ARITH; MATRIX_SUB_COMPONENT; MAT_COMPONENT; SUM_3; matrix_mul; transp; matrix_vector_mul] THEN CONV_TAC REAL_RING);; let EULER_ROTOINVERSION_THEOREM = prove (`!A:real^3^3. rotoinversion_matrix A ==> ?v:real^3. ~(v = vec 0) /\ A ** v = --v`, REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = --v <=> a + v = vec 0`] THEN MP_TAC(ISPEC `A + mat 1:real^3^3` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; MATRIX_VECTOR_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[rotoinversion_matrix; orthogonal_matrix; DET_3] THEN SIMP_TAC[CART_EQ; FORALL_3; MAT_COMPONENT; DIMINDEX_3; LAMBDA_BETA; ARITH; MATRIX_ADD_COMPONENT; MAT_COMPONENT; SUM_3; matrix_mul; transp; matrix_vector_mul] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* We can always rotate so that a hyperplane is "horizontal". *) (* ------------------------------------------------------------------------- *) let ROTATION_LOWDIM_HORIZONTAL = prove (`!s:real^N->bool. dim s < dimindex(:N) ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ (IMAGE f s) SUBSET {z | z$(dimindex(:N)) = &0}`, GEN_TAC THEN ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL [RULE_ASSUM_TAC(REWRITE_RULE[DIM_EQ_0]) THEN DISCH_TAC THEN EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID; MATRIX_ID; DET_I] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET {a} ==> a IN t ==> IMAGE (\x. x) s SUBSET t`)) THEN SIMP_TAC[IN_ELIM_THM; VEC_COMPONENT; LE_REFL; DIMINDEX_GE_1]; DISCH_TAC] THEN SUBGOAL_THEN `2 <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN MP_TAC(ISPECL [`a:real^N`; `norm(a:real^N) % basis(dimindex(:N)):real^N`] ROTATION_EXISTS) THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN REWRITE_TAC[REAL_ABS_NORM; REAL_MUL_RID] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(f:real^N->real^N) x dot (f a) = &0` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_transformation]) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM]; ASM_SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1; DOT_RMUL] THEN ASM_REWRITE_TAC[REAL_ENTIRE; NORM_EQ_0]]);; let ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL = prove (`!s:real^N->bool. dim s < dimindex(:N) ==> ?f. orthogonal_transformation f /\ (IMAGE f s) SUBSET {z | z$(dimindex(:N)) = &0}`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ROTATION_LOWDIM_HORIZONTAL) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);; let ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS = prove (`!v:num->real^N w k. pairwise (\i j. orthogonal (v i) (v j)) k /\ pairwise (\i j. orthogonal (w i) (w j)) k /\ (!i. i IN k ==> norm(v i) = norm(w i)) ==> ?f. orthogonal_transformation f /\ (!i. i IN k ==> f(v i) = w i)`, let lemma1 = prove (`!v:num->real^N n. pairwise (\i j. orthogonal (v i) (v j)) (1..n) /\ (!i. 1 <= i /\ i <= n ==> norm(v i) = &1) ==> ?f. orthogonal_transformation f /\ (!i. 1 <= i /\ i <= n ==> f(basis i) = v i)`, REWRITE_TAC[pairwise; IN_NUMSEG; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `pairwise orthogonal (IMAGE (v:num->real^N) (1..n))` ASSUME_TAC THENL [REWRITE_TAC[PAIRWISE_IMAGE] THEN ASM_SIMP_TAC[pairwise; IN_NUMSEG]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_ORTHOGONAL_INDEPENDENT)) THEN REWRITE_TAC[SET_RULE `~(a IN IMAGE f s) <=> !x. x IN s ==> ~(f x = a)`] THEN ANTS_TAC THENL [REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[NORM_0; REAL_ARITH `~(&1 = &0)`]; DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP INDEPENDENT_BOUND)] THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= n /\ 1 <= j /\ j <= n /\ ~(i = j) ==> ~(v i:real^N = v j)` ASSUME_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_REFL; NORM_0; REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN SUBGOAL_THEN `CARD(IMAGE (v:num->real^N) (1..n)) = n` ASSUME_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o lhs o snd) THEN ASM_REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN SUBGOAL_THEN `?w:num->real^N. pairwise (\i j. orthogonal (w i) (w j)) (1..dimindex(:N)) /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(w i) = &1) /\ (!i. 1 <= i /\ i <= n ==> w i = v i)` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `(\x. vsum(1..dimindex(:N)) (\i. x$i % w i)):real^N->real^N` THEN SIMP_TAC[BASIS_COMPONENT; IN_NUMSEG; COND_RATOR; COND_RAND] THEN REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO; VSUM_DELTA] THEN ASM_SIMP_TAC[IN_NUMSEG] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_TRANS]] THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX] THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REWRITE_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[matrix; column; ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS] THEN SIMP_TAC[LAMBDA_BETA; LAMBDA_ETA; BASIS_COMPONENT; IN_NUMSEG] THEN SIMP_TAC[COND_RATOR; COND_RAND; VECTOR_MUL_LZERO; VSUM_DELTA] THEN SIMP_TAC[IN_NUMSEG; orthogonal; dot; LAMBDA_BETA; NORM_EQ_SQUARE] THEN REWRITE_TAC[VECTOR_MUL_LID; GSYM dot; GSYM NORM_EQ_SQUARE] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise; IN_NUMSEG; orthogonal]) THEN ASM_SIMP_TAC[]] THEN FIRST_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] ORTHONORMAL_EXTENSION)) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; UNION_UNIV; SPAN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`n+1..dimindex(:N)`; `t:real^N->bool`] CARD_EQ_BIJECTION) THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_NUMSEG] THEN MP_TAC(ISPECL [`(:real^N)`; `IMAGE v (1..n) UNION t:real^N->bool`] BASIS_CARD_EQ_DIM) THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN ANTS_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[IN_UNION; DE_MORGAN_THM; IN_NUMSEG] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; SET_RULE `~(x IN s) <=> !y. y IN s ==> ~(y = x)`] THEN ASM_MESON_TAC[NORM_0; REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN ASM_SIMP_TAC[FINITE_UNION; IMP_CONJ; FINITE_IMAGE; CARD_UNION; SET_RULE `t INTER s = {} <=> DISJOINT s t`] THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[CARD_NUMSEG; DIM_UNIV] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[CONJ_ASSOC; SET_RULE `(!x. x IN s ==> f x IN t) /\ (!y. y IN t ==> ?x. x IN s /\ f x = y) <=> t = IMAGE f s`] THEN REWRITE_TAC[GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM; IN_NUMSEG] THEN X_GEN_TAC `w:num->real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN REWRITE_TAC[ARITH_RULE `n + 1 <= x <=> n < x`; CONJ_ASSOC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> p /\ ~r ==> ~q`] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN STRIP_TAC THEN REWRITE_TAC[TAUT `p /\ ~r ==> ~q <=> p /\ q ==> r`] THEN EXISTS_TAC `\i. if i <= n then (v:num->real^N) i else w i` THEN SIMP_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_NUMSEG]) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `~(i <= n) ==> n + 1 <= i`]] THEN REWRITE_TAC[pairwise] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN ASM_CASES_TAC `j:num <= n` THEN ASM_REWRITE_TAC[IN_NUMSEG] THENL [COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `i:num <= n` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN UNDISCH_TAC `pairwise orthogonal (IMAGE (v:num->real^N) (1..n) UNION IMAGE w (n+1..dimindex (:N)))` THEN REWRITE_TAC[pairwise] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `(w:num->real^N) j`) THENL [DISCH_THEN(MP_TAC o SPEC `(v:num->real^N) i`); DISCH_THEN(MP_TAC o SPEC `(w:num->real^N) i`)] THEN ASM_REWRITE_TAC[IN_UNION; IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN MATCH_MP_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `~(x <= n) ==> n + 1 <= x`]; ALL_TAC]; ASM_MESON_TAC[ARITH_RULE `~(x <= n) ==> n + 1 <= x /\ n < x`]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DISJOINT]) THEN REWRITE_TAC[SET_RULE `IMAGE w t INTER IMAGE v s = {} <=> !i j. i IN s /\ j IN t ==> ~(v i = w j)`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC) in let lemma2 = prove (`!v:num->real^N w k. pairwise (\i j. orthogonal (v i) (v j)) k /\ pairwise (\i j. orthogonal (w i) (w j)) k /\ (!i. i IN k ==> norm(v i) = norm(w i)) /\ (!i. i IN k ==> ~(v i = vec 0) /\ ~(w i = vec 0)) ==> ?f. orthogonal_transformation f /\ (!i. i IN k ==> f(v i) = w i)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `FINITE(k:num->bool)` MP_TAC THENL [SUBGOAL_THEN `pairwise orthogonal (IMAGE (v:num->real^N) k)` ASSUME_TAC THENL [REWRITE_TAC[PAIRWISE_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_ORTHOGONAL_INDEPENDENT)) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_MESON_TAC[ORTHOGONAL_REFL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num->num` MP_TAC) THEN REWRITE_TAC[IN_NUMSEG] THEN GEN_REWRITE_TAC I [IMP_CONJ] THEN DISCH_THEN(fun th -> DISCH_THEN SUBST_ALL_TAC THEN ASSUME_TAC th) THEN RULE_ASSUM_TAC(REWRITE_RULE [PAIRWISE_IMAGE; FORALL_IN_IMAGE; IN_NUMSEG]) THEN MP_TAC(ISPECL [`\i. inv(norm(w(n i))) % (w:num->real^N) ((n:num->num) i)`; `CARD(k:num->bool)`] lemma1) THEN MP_TAC(ISPECL [`\i. inv(norm(v(n i))) % (v:num->real^N) ((n:num->num) i)`; `CARD(k:num->bool)`] lemma1) THEN ASM_SIMP_TAC[NORM_MUL; REAL_MUL_LINV; NORM_EQ_0; REAL_ABS_INV; REAL_ABS_NORM; pairwise; orthogonal; IN_NUMSEG] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal; IN_NUMSEG]) THEN ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; REAL_ENTIRE; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `f:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:real^N->real^N) o (f':real^N->real^N)` THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(g:real^N->real^N) (norm((w:num->real^N)(n(i:num))) % basis i)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(!x. f'(f x) = x) ==> f x = y ==> f' y = x`)); ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_transformation]) THEN ASM_SIMP_TAC[LINEAR_CMUL; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`v:num->real^N`; `w:num->real^N`; `{i | i IN k /\ ~((v:num->real^N) i = vec 0)}`] lemma2) THEN ASM_SIMP_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[NORM_EQ_0]] THEN CONJ_TAC THEN MATCH_MP_TAC PAIRWISE_MONO THEN EXISTS_TAC `k:num->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[orthogonal_transformation] THEN GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_CASES_TAC `(v:num->real^N) i = vec 0` THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[LINEAR_0; NORM_EQ_0]]);; (* ------------------------------------------------------------------------- *) (* Reflection of a vector about 0 along a line. *) (* ------------------------------------------------------------------------- *) let reflect_along = new_definition `reflect_along v (x:real^N) = x - (&2 * (x dot v) / (v dot v)) % v`;; let REFLECT_ALONG_ADD = prove (`!v x y:real^N. reflect_along v (x + y) = reflect_along v x + reflect_along v y`, REPEAT GEN_TAC THEN REWRITE_TAC[reflect_along; VECTOR_ARITH `x - a % v + y - b % v:real^N = (x + y) - (a + b) % v`] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[DOT_LADD] THEN REAL_ARITH_TAC);; let REFLECT_ALONG_MUL = prove (`!v a x:real^N. reflect_along v (a % x) = a % reflect_along v x`, REWRITE_TAC[reflect_along; DOT_LMUL; REAL_ARITH `&2 * (a * x) / y = a * &2 * x / y`] THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC]);; let LINEAR_REFLECT_ALONG = prove (`!v:real^N. linear(reflect_along v)`, REWRITE_TAC[linear; REFLECT_ALONG_ADD; REFLECT_ALONG_MUL]);; let REFLECT_ALONG_0 = prove (`!v:real^N. reflect_along v (vec 0) = vec 0`, REWRITE_TAC[MATCH_MP LINEAR_0 (SPEC_ALL LINEAR_REFLECT_ALONG)]);; let REFLECT_ALONG_REFL = prove (`!v:real^N. reflect_along v v = --v`, GEN_TAC THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[VECTOR_NEG_0; REFLECT_ALONG_0] THEN REWRITE_TAC[reflect_along] THEN ASM_SIMP_TAC[REAL_DIV_REFL; DOT_EQ_0] THEN VECTOR_ARITH_TAC);; let REFLECT_ALONG_INVOLUTION = prove (`!v x:real^N. reflect_along v (reflect_along v x) = x`, REWRITE_TAC[reflect_along; DOT_LSUB; VECTOR_MUL_EQ_0; VECTOR_ARITH `x - a % v - b % v:real^N = x <=> (a + b) % v = vec 0`] THEN REWRITE_TAC[DOT_LMUL; GSYM DOT_EQ_0] THEN CONV_TAC REAL_FIELD);; let REFLECT_ALONG_EQ_0 = prove (`!v x:real^N. reflect_along v x = vec 0 <=> x = vec 0`, MESON_TAC[REFLECT_ALONG_0; REFLECT_ALONG_INVOLUTION]);; let ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG = prove (`!v:real^N. orthogonal_transformation(reflect_along v)`, GEN_TAC THEN ASM_CASES_TAC `v:real^N = vec 0` THENL [GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN ASM_REWRITE_TAC[reflect_along; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO; ORTHOGONAL_TRANSFORMATION_ID]; REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN REWRITE_TAC[LINEAR_REFLECT_ALONG; NORM_EQ] THEN REWRITE_TAC[reflect_along; VECTOR_ARITH `(a - b:real^N) dot (a - b) = (a dot a + b dot b) - &2 * a dot b`] THEN REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN X_GEN_TAC `w:real^N` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DOT_EQ_0]) THEN CONV_TAC REAL_FIELD]);; let REFLECT_ALONG_EQ_SELF = prove (`!v x:real^N. reflect_along v x = x <=> orthogonal v x`, REPEAT GEN_TAC THEN REWRITE_TAC[reflect_along; orthogonal] THEN REWRITE_TAC[VECTOR_ARITH `x - a:real^N = x <=> a = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO; DOT_SYM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DOT_EQ_0]) THEN CONV_TAC REAL_FIELD);; let REFLECT_ALONG_ZERO = prove (`!x:real^N. reflect_along (vec 0) = I`, REWRITE_TAC[FUN_EQ_THM; I_THM; REFLECT_ALONG_EQ_SELF; ORTHOGONAL_0]);; let REFLECT_ALONG_LINEAR_IMAGE = prove (`!f:real^M->real^N v x. linear f /\ (!x. norm(f x) = norm x) ==> reflect_along (f v) (f x) = f(reflect_along v x)`, REWRITE_TAC[reflect_along] THEN SIMP_TAC[PRESERVES_NORM_PRESERVES_DOT; LINEAR_SUB; LINEAR_CMUL]);; add_linear_invariants [REFLECT_ALONG_LINEAR_IMAGE];; let REFLECT_ALONG_SCALE = prove (`!c v x:real^N. ~(c = &0) ==> reflect_along (c % v) x = reflect_along v x`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; REFLECT_ALONG_ZERO] THEN REWRITE_TAC[reflect_along; VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[DOT_LMUL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DOT_EQ_0]) THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; let REFLECT_ALONG_1D = prove (`!v x:real^N. dimindex(:N) = 1 ==> reflect_along v x = if v = vec 0 then x else --x`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[reflect_along; dot; SUM_1; CART_EQ; FORALL_1] THEN REWRITE_TAC[VEC_COMPONENT; COND_RATOR; COND_RAND] THEN SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; REAL_MUL_RZERO] THEN CONV_TAC REAL_FIELD);; let REFLECT_ALONG_BASIS = prove (`!x:real^N k. 1 <= k /\ k <= dimindex(:N) ==> reflect_along (basis k) x = x - (&2 * x$k) % basis k`, SIMP_TAC[reflect_along; DOT_BASIS; BASIS_COMPONENT; REAL_DIV_1]);; let MATRIX_REFLECT_ALONG_BASIS = prove (`!k. 1 <= k /\ k <= dimindex(:N) ==> matrix(reflect_along (basis k)):real^N^N = lambda i j. if i = k /\ j = k then --(&1) else if i = j then &1 else &0`, SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix; REFLECT_ALONG_BASIS; VECTOR_SUB_COMPONENT; BASIS_COMPONENT; VECTOR_MUL_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC);; let ROTOINVERSION_MATRIX_REFLECT_ALONG = prove (`!v:real^N. ~(v = vec 0) ==> rotoinversion_matrix(matrix(reflect_along v))`, REPEAT STRIP_TAC THEN REWRITE_TAC[rotoinversion_matrix] THEN CONJ_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG]; ALL_TAC] THEN ABBREV_TAC `w:real^N = inv(norm v) % v` THEN SUBGOAL_THEN `reflect_along (v:real^N) = reflect_along w` SUBST1_TAC THENL [EXPAND_TAC "w" THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_SIMP_TAC[REFLECT_ALONG_SCALE; REAL_INV_EQ_0; NORM_EQ_0]; SUBGOAL_THEN `norm(w:real^N) = &1` MP_TAC THENL [EXPAND_TAC "w" THEN SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[NORM_EQ_0]; POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`w:real^N`,`v:real^N`)]] THEN X_GEN_TAC `v:real^N` THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`v:real^N`; `basis 1:real^N`] ORTHOGONAL_TRANSFORMATION_EXISTS) THEN ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `matrix(reflect_along v) = transp(matrix(f:real^N->real^N)) ** matrix(reflect_along (f v)) ** matrix f` SUBST1_TAC THENL [UNDISCH_THEN `(f:real^N->real^N) v = basis 1` (K ALL_TAC) THEN REWRITE_TAC[MATRIX_EQ; GSYM MATRIX_VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_WORKS; LINEAR_REFLECT_ALONG; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(transp(matrix(f:real^N->real^N)) ** matrix f) ** (reflect_along v x:real^N)` THEN CONJ_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_MATRIX; MATRIX_VECTOR_MUL_LID; ORTHOGONAL_TRANSFORMATION_MATRIX]; REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_WORKS; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REFLECT_ALONG_LINEAR_IMAGE THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_TRANSFORMATION]]; ASM_REWRITE_TAC[DET_MUL; DET_TRANSP] THEN MATCH_MP_TAC(REAL_RING `(x = &1 \/ x = -- &1) /\ y = a ==> x * y * x = a`) THEN CONJ_TAC THENL [ASM_MESON_TAC[DET_ORTHOGONAL_MATRIX; ORTHOGONAL_TRANSFORMATION_MATRIX]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhand o snd) THEN SIMP_TAC[MATRIX_REFLECT_ALONG_BASIS; DIMINDEX_GE_1; LE_REFL] THEN SIMP_TAC[LAMBDA_BETA; ARITH_RULE `j < i ==> ~(i = j) /\ ~(i = 1 /\ j = 1)`] THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1] THEN MATCH_MP_TAC(REAL_RING `x = &1 ==> a * x = a`) THEN MATCH_MP_TAC PRODUCT_EQ_1 THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; let DET_MATRIX_REFLECT_ALONG = prove (`!v:real^N. det(matrix(reflect_along v)) = if v = vec 0 then &1 else --(&1)`, GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REFLECT_ALONG_ZERO] THEN REWRITE_TAC[MATRIX_I; DET_I] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ROTOINVERSION_MATRIX_REFLECT_ALONG) THEN SIMP_TAC[rotoinversion_matrix]);; let REFLECT_ALONG_BASIS_COMPONENT = prove (`!x:real^N i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> reflect_along (basis i) x$j = if j = i then --(x$j) else x$j`, SIMP_TAC[REFLECT_ALONG_BASIS; VECTOR_SUB_COMPONENT] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let NORM_REFLECT_ALONG = prove (`!v x:real^N. norm(reflect_along v x) = norm x`, MESON_TAC[ORTHOGONAL_TRANSFORMATION; ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG]);; let REFLECT_ALONG_EQ = prove (`!v x y:real^N. reflect_along v x = reflect_along v y <=> x = y`, MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE; ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG]);; let REFLECT_ALONG_SURJECTIVE = prove (`!v y:real^N. ?x. reflect_along v x = y`, MESON_TAC[REFLECT_ALONG_INVOLUTION]);; let ROTOINVERSION_EXISTS_GEN = prove (`!s a b:real^N. subspace s /\ a IN s /\ b IN s /\ ~(a = b) /\ norm a = norm b ==> ?f. orthogonal_transformation f /\ IMAGE f s = s /\ (!x. orthogonal a x /\ orthogonal b x ==> f x = x) /\ det (matrix f) = -- &1 /\ f a = b /\ f b = a`, REPEAT STRIP_TAC THEN EXISTS_TAC `reflect_along (b - a:real^N)` THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG] THEN ASM_REWRITE_TAC[DET_MATRIX_REFLECT_ALONG; VECTOR_SUB_EQ] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ (!x. x IN s ==> f x IN s) ==> IMAGE f s = s`) THEN REWRITE_TAC[REFLECT_ALONG_INVOLUTION] THEN REWRITE_TAC[reflect_along] THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL]; REWRITE_TAC[ONCE_REWRITE_RULE[DOT_SYM] orthogonal] THEN SIMP_TAC[reflect_along; DOT_RSUB] THEN REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[VECTOR_ARITH `x - &0 % y:real^N = x`] THEN REWRITE_TAC[VECTOR_ARITH `(a - c % (b - a):real^N = b <=> (&1 + c) % (b - a) = vec 0) /\ (b - c % (b - a):real^N = a <=> (&1 - c) % (b - a) = vec 0)`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_FIELD `~(d = &0) /\ x + y = &0 /\ y - x = d ==> &1 + &2 * x * inv d = &0 /\ &1 - &2 * y * inv d = &0`) THEN ASM_REWRITE_TAC[GSYM DOT_RSUB; DOT_EQ_0; VECTOR_SUB_EQ] THEN ASM_REWRITE_TAC[DOT_RSUB; GSYM NORM_POW_2; DOT_LSUB] THEN REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC]);; let ORTHOGONAL_TRANSFORMATION_EXISTS_GEN = prove (`!s a b:real^N. subspace s /\ a IN s /\ b IN s /\ norm a = norm b ==> ?f. orthogonal_transformation f /\ IMAGE f s = s /\ (!x. orthogonal a x /\ orthogonal b x ==> f x = x) /\ f a = b /\ f b = a`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID; IMAGE_ID]; MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`] ROTOINVERSION_EXISTS_GEN) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* All orthogonal transformations are a composition of reflections. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS = prove (`!f:real^N->real^N n. orthogonal_transformation f /\ dimindex(:N) <= dim {x | f x = x} + n ==> ?l. LENGTH l <= n /\ ALL (\v. ~(v = vec 0)) l /\ f = ITLIST (\v h. reflect_along v o h) l I`, ONCE_REWRITE_TAC[GSYM SWAP_FORALL_THM] THEN INDUCT_TAC THENL [REWRITE_TAC[CONJUNCT1 LE; LENGTH_EQ_NIL; ADD_CLAUSES; UNWIND_THM2] THEN SIMP_TAC[DIM_SUBSET_UNIV; ARITH_RULE `a:num <= b ==> (b <= a <=> a = b)`; ITLIST; DIM_EQ_FULL; orthogonal_transformation] THEN SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_LINEAR_FIXED_POINTS; IMP_CONJ] THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_ELIM_THM] THEN SIMP_TAC[FUN_EQ_THM; I_THM; ALL]; REPEAT STRIP_TAC THEN ASM_CASES_TAC `!x:real^N. f x = x` THENL [EXISTS_TAC `[]:(real^N) list` THEN ASM_REWRITE_TAC[ITLIST; FUN_EQ_THM; I_THM; ALL; LENGTH; LE_0]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM])] THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN ABBREV_TAC `v:real^N = inv(&2) % (f a - a)` THEN FIRST_X_ASSUM (MP_TAC o SPEC `reflect_along v o (f:real^N->real^N)`) THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG; ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `a <= d + SUC n ==> d < d' ==> a <= d' + n`)) THEN MATCH_MP_TAC DIM_PSUBSET THEN REWRITE_TAC[PSUBSET_ALT] THEN SUBGOAL_THEN `!y:real^N. dist(y,f a) = dist(y,a) ==> reflect_along v y = y` ASSUME_TAC THENL [REWRITE_TAC[dist; NORM_EQ_SQUARE; NORM_POS_LE; NORM_POW_2] THEN REWRITE_TAC[VECTOR_ARITH `(y - b:real^N) dot (y - b) = (y dot y + b dot b) - &2 * y dot b`] THEN REWRITE_TAC[REAL_ARITH `(y + aa) - &2 * a = (y + bb) - &2 * b <=> a - b = inv(&2) * (aa - bb)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_transformation]) THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN EXPAND_TAC "v" THEN REWRITE_TAC[GSYM DOT_RSUB; reflect_along] THEN SIMP_TAC[DOT_RMUL; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_MONO THEN SIMP_TAC[SUBSET; IN_ELIM_THM; o_THM] THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_ISOMETRY]; ALL_TAC] THEN EXISTS_TAC `a:real^N` THEN ASM_SIMP_TAC[SUBSPACE_LINEAR_FIXED_POINTS; SPAN_OF_SUBSPACE; ORTHOGONAL_TRANSFORMATION_LINEAR; IN_ELIM_THM] THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM; o_THM] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `reflect_along (v:real^N) (midpoint(f a,a) + v)` THEN CONJ_TAC THENL [AP_TERM_TAC; REWRITE_TAC[REFLECT_ALONG_ADD] THEN ASM_SIMP_TAC[DIST_MIDPOINT; REFLECT_ALONG_REFL]] THEN EXPAND_TAC "v" THEN REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `l:(real^N)list` STRIP_ASSUME_TAC) THEN EXISTS_TAC `CONS (v:real^N) l` THEN ASM_REWRITE_TAC[ALL; LENGTH; LE_SUC; VECTOR_SUB_EQ; ITLIST] THEN EXPAND_TAC "v" THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(o)(reflect_along (v:real^N)):(real^N->real^N)->(real^N->real^N)`) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; REFLECT_ALONG_INVOLUTION]]]);; (* ------------------------------------------------------------------------- *) (* Extract scaling, translation and linear invariance theorems. *) (* For the linear case, chain through some basic consequences automatically, *) (* e.g. norm-preserving and linear implies injective. *) (* ------------------------------------------------------------------------- *) let SCALING_THEOREMS v = let th1 = UNDISCH(snd(EQ_IMP_RULE(ISPEC v NORM_POS_LT))) in let t = rand(concl th1) in end_itlist CONJ (map (C MP th1 o SPEC t) (!scaling_theorems));; let TRANSLATION_INVARIANTS x = end_itlist CONJ (mapfilter (ISPEC x) (!invariant_under_translation));; let USABLE_CONCLUSION f ths th = let ith = PURE_REWRITE_RULE[RIGHT_FORALL_IMP_THM] (ISPEC f th) in let bod = concl ith in let cjs = conjuncts(fst(dest_imp bod)) in let ths = map (fun t -> find(fun th -> aconv (concl th) t) ths) cjs in GEN_ALL(MP ith (end_itlist CONJ ths));; let LINEAR_INVARIANTS = let sths = (CONJUNCTS o prove) (`(!f:real^M->real^N. linear f /\ (!x. norm(f x) = norm x) ==> (!x y. f x = f y ==> x = y)) /\ (!f:real^N->real^N. linear f /\ (!x. norm(f x) = norm x) ==> (!y. ?x. f x = y)) /\ (!f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> (!y. ?x. f x = y)) /\ (!f:real^N->real^N. linear f /\ (!y. ?x. f x = y) ==> (!x y. f x = f y ==> x = y))`, CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN SIMP_TAC[GSYM LINEAR_SUB; GSYM NORM_EQ_0]; MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; ORTHOGONAL_TRANSFORMATION_INJECTIVE; ORTHOGONAL_TRANSFORMATION; LINEAR_SURJECTIVE_IFF_INJECTIVE]]) in fun f ths -> let ths' = ths @ mapfilter (USABLE_CONCLUSION f ths) sths in end_itlist CONJ (mapfilter (USABLE_CONCLUSION f ths') (!invariant_under_linear));; (* ------------------------------------------------------------------------- *) (* Tactic to pick WLOG a particular point as the origin. The conversion form *) (* assumes it's the outermost universal variable; the tactic is more general *) (* and allows any free or outer universally quantified variable. The list *) (* "avoid" is the points not to translate. There is also a tactic to help in *) (* proving new translation theorems, which uses similar machinery. *) (* ------------------------------------------------------------------------- *) let GEOM_ORIGIN_CONV,GEOM_TRANSLATE_CONV = let pth = prove (`!a:real^N. a = a + vec 0 /\ {} = IMAGE (\x. a + x) {} /\ {} = IMAGE (IMAGE (\x. a + x)) {} /\ (:real^N) = IMAGE (\x. a + x) (:real^N) /\ (:real^N->bool) = IMAGE (IMAGE (\x. a + x)) (:real^N->bool) /\ [] = MAP (\x. a + x) []`, REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; MAP] THEN REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN REWRITE_TAC[SURJECTIVE_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `a + y:real^N = x <=> y = x - a`; EXISTS_REFL]) and qth = prove (`!a:real^N. ((!P. (!x. P x) <=> (!x. P (a + x))) /\ (!P. (?x. P x) <=> (?x. P (a + x))) /\ (!Q. (!s. Q s) <=> (!s. Q(IMAGE (\x. a + x) s))) /\ (!Q. (?s. Q s) <=> (?s. Q(IMAGE (\x. a + x) s))) /\ (!Q. (!s. Q s) <=> (!s. Q(IMAGE (IMAGE (\x. a + x)) s))) /\ (!Q. (?s. Q s) <=> (?s. Q(IMAGE (IMAGE (\x. a + x)) s))) /\ (!P. (!g:real^1->real^N. P g) <=> (!g. P ((\x. a + x) o g))) /\ (!P. (?g:real^1->real^N. P g) <=> (?g. P ((\x. a + x) o g))) /\ (!P. (!g:num->real^N. P g) <=> (!g. P ((\x. a + x) o g))) /\ (!P. (?g:num->real^N. P g) <=> (?g. P ((\x. a + x) o g))) /\ (!Q. (!l. Q l) <=> (!l. Q(MAP (\x. a + x) l))) /\ (!Q. (?l. Q l) <=> (?l. Q(MAP (\x. a + x) l)))) /\ ((!P. {x | P x} = IMAGE (\x. a + x) {x | P(a + x)}) /\ (!Q. {s | Q s} = IMAGE (IMAGE (\x. a + x)) {s | Q(IMAGE (\x. a + x) s)}) /\ (!R. {l | R l} = IMAGE (MAP (\x. a + x)) {l | R(MAP (\x. a + x) l)}))`, GEN_TAC THEN MATCH_MP_TAC QUANTIFY_SURJECTION_HIGHER_THM THEN X_GEN_TAC `y:real^N` THEN EXISTS_TAC `y - a:real^N` THEN VECTOR_ARITH_TAC) in let GEOM_ORIGIN_CONV avoid tm = let x,tm0 = dest_forall tm in let th0 = ISPEC x pth in let x' = genvar(type_of x) in let ith = ISPEC x' qth in let th1 = PARTIAL_EXPAND_QUANTS_CONV avoid (ASSUME(concl ith)) tm0 in let th2 = CONV_RULE(RAND_CONV(SUBS_CONV(CONJUNCTS th0))) th1 in let th3 = INST[x,x'] (PROVE_HYP ith th2) in let ths = TRANSLATION_INVARIANTS x in let thr = REFL x in let th4 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [BETA_THM;ADD_ASSUM(concl thr) ths] th3 in let th5 = MK_FORALL x (PROVE_HYP thr th4) in GEN_REWRITE_RULE (RAND_CONV o TRY_CONV) [FORALL_SIMP] th5 and GEOM_TRANSLATE_CONV avoid a tm = let cth = CONJUNCT2(ISPEC a pth) and vth = ISPEC a qth in let th1 = PARTIAL_EXPAND_QUANTS_CONV avoid (ASSUME(concl vth)) tm in let th2 = CONV_RULE(RAND_CONV(SUBS_CONV(CONJUNCTS cth))) th1 in let th3 = PROVE_HYP vth th2 in let ths = TRANSLATION_INVARIANTS a in let thr = REFL a in let th4 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [BETA_THM;ADD_ASSUM(concl thr) ths] th3 in PROVE_HYP thr th4 in GEOM_ORIGIN_CONV,GEOM_TRANSLATE_CONV;; let GEN_GEOM_ORIGIN_TAC x avoid (asl,w as gl) = let avs,bod = strip_forall w and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in (MAP_EVERY X_GEN_TAC avs THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [x])) THEN SPEC_TAC(x,x) THEN CONV_TAC(GEOM_ORIGIN_CONV avoid)) gl;; let GEOM_ORIGIN_TAC x = GEN_GEOM_ORIGIN_TAC x [];; let GEOM_TRANSLATE_TAC avoid (asl,w) = let a,bod = dest_forall w in let n = length(fst(strip_forall bod)) in (X_GEN_TAC a THEN CONV_TAC(funpow n BINDER_CONV (LAND_CONV(GEOM_TRANSLATE_CONV avoid a))) THEN REWRITE_TAC[]) (asl,w);; (* ------------------------------------------------------------------------- *) (* Rename existential variables in conclusion to fresh genvars. *) (* ------------------------------------------------------------------------- *) let EXISTS_GENVAR_RULE = let rec rule vs th = match vs with [] -> th | v::ovs -> let x,bod = dest_exists(concl th) in let th1 = rule ovs (ASSUME bod) in let th2 = SIMPLE_CHOOSE x (SIMPLE_EXISTS x th1) in PROVE_HYP th (CONV_RULE (GEN_ALPHA_CONV v) th2) in fun th -> rule (map (genvar o type_of) (fst(strip_exists(concl th)))) th;; (* ------------------------------------------------------------------------- *) (* Rotate so that WLOG some point is a +ve multiple of basis vector k. *) (* For general N, it's better to use k = 1 so the side-condition can be *) (* discharged. For dimensions 1, 2 and 3 anything will work automatically. *) (* Could generalize by asking the user to prove theorem 1 <= k <= N. *) (* ------------------------------------------------------------------------- *) let GEOM_BASIS_MULTIPLE_RULE = let pth = prove (`!f. orthogonal_transformation (f:real^N->real^N) ==> (vec 0 = f(vec 0) /\ {} = IMAGE f {} /\ {} = IMAGE (IMAGE f) {} /\ (:real^N) = IMAGE f (:real^N) /\ (:real^N->bool) = IMAGE (IMAGE f) (:real^N->bool) /\ [] = MAP f []) /\ ((!P. (!x. P x) <=> (!x. P (f x))) /\ (!P. (?x. P x) <=> (?x. P (f x))) /\ (!Q. (!s. Q s) <=> (!s. Q (IMAGE f s))) /\ (!Q. (?s. Q s) <=> (?s. Q (IMAGE f s))) /\ (!Q. (!s. Q s) <=> (!s. Q (IMAGE (IMAGE f) s))) /\ (!Q. (?s. Q s) <=> (?s. Q (IMAGE (IMAGE f) s))) /\ (!P. (!g:real^1->real^N. P g) <=> (!g. P (f o g))) /\ (!P. (?g:real^1->real^N. P g) <=> (?g. P (f o g))) /\ (!P. (!g:num->real^N. P g) <=> (!g. P (f o g))) /\ (!P. (?g:num->real^N. P g) <=> (?g. P (f o g))) /\ (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\ (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\ ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\ (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\ (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_SURJECTIVE) THEN CONJ_TAC THENL [REWRITE_TAC[IMAGE_CLAUSES; MAP] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN CONJ_TAC THENL [ASM_MESON_TAC[LINEAR_0]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN ASM_REWRITE_TAC[SURJECTIVE_IMAGE]; MATCH_MP_TAC QUANTIFY_SURJECTION_HIGHER_THM THEN ASM_REWRITE_TAC[]]) and oth = prove (`!f:real^N->real^N. orthogonal_transformation f /\ (2 <= dimindex(:N) ==> det(matrix f) = &1) ==> linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:N) ==> det(matrix f) = &1)`, GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) and arithconv = REWRITE_CONV[DIMINDEX_1; DIMINDEX_2; DIMINDEX_3; ARITH_RULE `1 <= 1`; DIMINDEX_GE_1] THENC NUM_REDUCE_CONV in fun k tm -> let x,bod = dest_forall tm in let th0 = ISPECL [x; mk_small_numeral k] ROTATION_RIGHTWARD_LINE in let th1 = EXISTS_GENVAR_RULE (MP th0 (EQT_ELIM(arithconv(lhand(concl th0))))) in let [a;f],tm1 = strip_exists(concl th1) in let th_orth,th2 = CONJ_PAIR(ASSUME tm1) in let th_det,th2a = CONJ_PAIR th2 in let th_works,th_zero = CONJ_PAIR th2a in let thc,thq = CONJ_PAIR(PROVE_HYP th2 (UNDISCH(ISPEC f pth))) in let th3 = CONV_RULE(RAND_CONV(SUBS_CONV(GSYM th_works::CONJUNCTS thc))) (EXPAND_QUANTS_CONV(ASSUME(concl thq)) bod) in let th4 = PROVE_HYP thq th3 in let thps = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in let th5 = LINEAR_INVARIANTS f thps in let th6 = PROVE_HYP th_orth (GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [BETA_THM; th5] th4) in let ntm = mk_forall(a,mk_imp(concl th_zero,rand(concl th6))) in let th7 = MP(SPEC a (ASSUME ntm)) th_zero in let th8 = DISCH ntm (EQ_MP (SYM th6) th7) in if intersect (frees(concl th8)) [a;f] = [] then let th9 = PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th8) in let th10 = DISCH ntm (GEN x (UNDISCH th9)) in let a' = variant (frees(concl th10)) (mk_var(fst(dest_var x),snd(dest_var a))) in CONV_RULE(LAND_CONV (GEN_ALPHA_CONV a')) th10 else let mtm = list_mk_forall([a;f],mk_imp(hd(hyp th8),rand(concl th6))) in let th9 = EQ_MP (SYM th6) (UNDISCH(SPECL [a;f] (ASSUME mtm))) in let th10 = itlist SIMPLE_CHOOSE [a;f] (DISCH mtm th9) in let th11 = GEN x (PROVE_HYP th1 th10) in MATCH_MP MONO_FORALL th11;; let GEOM_BASIS_MULTIPLE_TAC k l (asl,w as gl) = let avs,bod = strip_forall w and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in (MAP_EVERY X_GEN_TAC avs THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [l])) THEN SPEC_TAC(l,l) THEN W(MATCH_MP_TAC o GEOM_BASIS_MULTIPLE_RULE k o snd)) gl;; (* ------------------------------------------------------------------------- *) (* Create invariance theorems automatically, in simple cases. If there are *) (* any nested quantifiers, this will need surjectivity. It's often possible *) (* to prove a stronger theorem by more delicate manual reasoning, so this *) (* isn't used nearly as often as GEOM_TRANSLATE_CONV / GEOM_TRANSLATE_TAC. *) (* As a small step, some ad-hoc rewrites analogous to FORALL_IN_IMAGE are *) (* tried if the first step doesn't finish the goal, but it's very ad hoc. *) (* ------------------------------------------------------------------------- *) let GEOM_TRANSFORM_TAC = let cth0 = prove (`!f:real^M->real^N. linear f ==> vec 0 = f(vec 0) /\ {} = IMAGE f {} /\ {} = IMAGE (IMAGE f) {}`, REWRITE_TAC[IMAGE_CLAUSES] THEN MESON_TAC[LINEAR_0]) and cth1 = prove (`!f:real^M->real^N. (!y. ?x. f x = y) ==> (:real^N) = IMAGE f (:real^M) /\ (:real^N->bool) = IMAGE (IMAGE f) (:real^M->bool)`, REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN REWRITE_TAC[SURJECTIVE_IMAGE]) and sths = (CONJUNCTS o prove) (`(!f:real^M->real^N. linear f /\ (!x. norm(f x) = norm x) ==> (!x y. f x = f y ==> x = y)) /\ (!f:real^N->real^N. linear f /\ (!x. norm(f x) = norm x) ==> (!y. ?x. f x = y)) /\ (!f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> (!y. ?x. f x = y)) /\ (!f:real^N->real^N. linear f /\ (!y. ?x. f x = y) ==> (!x y. f x = f y ==> x = y))`, CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN SIMP_TAC[GSYM LINEAR_SUB; GSYM NORM_EQ_0]; MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; ORTHOGONAL_TRANSFORMATION_INJECTIVE; ORTHOGONAL_TRANSFORMATION; LINEAR_SURJECTIVE_IFF_INJECTIVE]]) and aths = (CONJUNCTS o prove) (`(!f s P. (!y. y IN IMAGE f s ==> P y) <=> (!x. x IN s ==> P(f x))) /\ (!f s P. (!u. u IN IMAGE (IMAGE f) s ==> P u) <=> (!t. t IN s ==> P(IMAGE f t))) /\ (!f s P. (?y. y IN IMAGE f s /\ P y) <=> (?x. x IN s /\ P(f x))) /\ (!f s P. (?u. u IN IMAGE (IMAGE f) s /\ P u) <=> (?t. t IN s /\ P(IMAGE f t)))`, SET_TAC[]) in fun avoid (asl,w as gl) -> let f,wff = dest_forall w in let vs,bod = strip_forall wff in let ant,cons = dest_imp bod in let hths = CONJUNCTS(ASSUME ant) in let fths = hths @ mapfilter (USABLE_CONCLUSION f hths) sths in let cths = mapfilter (USABLE_CONCLUSION f fths) [cth0; cth1] and vconv = try let vth = USABLE_CONCLUSION f fths QUANTIFY_SURJECTION_HIGHER_THM in PROVE_HYP vth o PARTIAL_EXPAND_QUANTS_CONV avoid (ASSUME(concl vth)) with Failure _ -> ALL_CONV and bths = LINEAR_INVARIANTS f fths in (MAP_EVERY X_GEN_TAC (f::vs) THEN DISCH_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) cths THEN CONV_TAC(LAND_CONV vconv) THEN GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [bths] THEN REWRITE_TAC[] THEN REWRITE_TAC(mapfilter (ADD_ASSUM ant o ISPEC f) aths) THEN GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [bths] THEN REWRITE_TAC[]) gl;; (* ------------------------------------------------------------------------- *) (* Scale so that a chosen vector has size 1. Generates a conjunction of *) (* two formulas, one for the zero case (which one hopes is trivial) and *) (* one just like the original goal but with a norm(...) = 1 assumption. *) (* ------------------------------------------------------------------------- *) let GEOM_NORMALIZE_RULE = let pth = prove (`!a:real^N. ~(a = vec 0) ==> vec 0 = norm(a) % vec 0 /\ a = norm(a) % inv(norm a) % a /\ {} = IMAGE (\x. norm(a) % x) {} /\ {} = IMAGE (IMAGE (\x. norm(a) % x)) {} /\ (:real^N) = IMAGE (\x. norm(a) % x) (:real^N) /\ (:real^N->bool) = IMAGE (IMAGE (\x. norm(a) % x)) (:real^N->bool) /\ [] = MAP (\x. norm(a) % x) []`, REWRITE_TAC[IMAGE_CLAUSES; VECTOR_MUL_ASSOC; VECTOR_MUL_RZERO; MAP] THEN SIMP_TAC[NORM_EQ_0; REAL_MUL_RINV; VECTOR_MUL_LID] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN X_GEN_TAC `y:real^N` THEN EXISTS_TAC `inv(norm(a:real^N)) % y:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; REAL_MUL_RINV; VECTOR_MUL_LID]) and qth = prove (`!a:real^N. ~(a = vec 0) ==> ((!P. (!r:real. P r) <=> (!r. P(norm a * r))) /\ (!P. (?r:real. P r) <=> (?r. P(norm a * r))) /\ (!P. (!x:real^N. P x) <=> (!x. P (norm(a) % x))) /\ (!P. (?x:real^N. P x) <=> (?x. P (norm(a) % x))) /\ (!Q. (!s:real^N->bool. Q s) <=> (!s. Q(IMAGE (\x. norm(a) % x) s))) /\ (!Q. (?s:real^N->bool. Q s) <=> (?s. Q(IMAGE (\x. norm(a) % x) s))) /\ (!Q. (!s:(real^N->bool)->bool. Q s) <=> (!s. Q(IMAGE (IMAGE (\x. norm(a) % x)) s))) /\ (!Q. (?s:(real^N->bool)->bool. Q s) <=> (?s. Q(IMAGE (IMAGE (\x. norm(a) % x)) s))) /\ (!P. (!g:real^1->real^N. P g) <=> (!g. P ((\x. norm(a) % x) o g))) /\ (!P. (?g:real^1->real^N. P g) <=> (?g. P ((\x. norm(a) % x) o g))) /\ (!P. (!g:num->real^N. P g) <=> (!g. P ((\x. norm(a) % x) o g))) /\ (!P. (?g:num->real^N. P g) <=> (?g. P ((\x. norm(a) % x) o g))) /\ (!Q. (!l. Q l) <=> (!l. Q(MAP (\x:real^N. norm(a) % x) l))) /\ (!Q. (?l. Q l) <=> (?l. Q(MAP (\x:real^N. norm(a) % x) l)))) /\ ((!P. {x:real^N | P x} = IMAGE (\x. norm(a) % x) {x | P(norm(a) % x)}) /\ (!Q. {s:real^N->bool | Q s} = IMAGE (IMAGE (\x. norm(a) % x)) {s | Q(IMAGE (\x. norm(a) % x) s)}) /\ (!R. {l:(real^N)list | R l} = IMAGE (MAP (\x:real^N. norm(a) % x)) {l | R(MAP (\x:real^N. norm(a) % x) l)}))`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(a /\ b) /\ c /\ d ==> (a /\ b /\ c) /\ d`) THEN CONJ_TAC THENL [ASM_MESON_TAC[NORM_EQ_0; REAL_FIELD `~(x = &0) ==> x * inv x * a = a`]; MP_TAC(ISPEC `\x:real^N. norm(a:real^N) % x` (INST_TYPE [`:real^1`,`:C`] QUANTIFY_SURJECTION_HIGHER_THM)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SURJECTIVE_SCALING; NORM_EQ_0]]) and lth = prove (`(!b:real^N. ~(b = vec 0) ==> (P(b) <=> Q(inv(norm b) % b))) ==> P(vec 0) /\ (!b. norm(b) = &1 ==> Q b) ==> (!b. P b)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^N = vec 0` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]) in fun avoid tm -> let x,tm0 = dest_forall tm in let cth = UNDISCH(ISPEC x pth) and vth = UNDISCH(ISPEC x qth) in let th1 = ONCE_REWRITE_CONV[cth] tm0 in let th2 = CONV_RULE (RAND_CONV (PARTIAL_EXPAND_QUANTS_CONV avoid vth)) th1 in let th3 = SCALING_THEOREMS x in let th3' = (end_itlist CONJ (map (fun th -> let avs,_ = strip_forall(concl th) in let gvs = map (genvar o type_of) avs in GENL gvs (SPECL gvs th)) (CONJUNCTS th3))) in let th4 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [BETA_THM; th3'] th2 in MATCH_MP lth (GEN x (DISCH_ALL th4));; let GEN_GEOM_NORMALIZE_TAC x avoid (asl,w as gl) = let avs,bod = strip_forall w and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in (MAP_EVERY X_GEN_TAC avs THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [x])) THEN SPEC_TAC(x,x) THEN W(MATCH_MP_TAC o GEOM_NORMALIZE_RULE avoid o snd)) gl;; let GEOM_NORMALIZE_TAC x = GEN_GEOM_NORMALIZE_TAC x [];; (* ------------------------------------------------------------------------- *) (* Add invariance theorems for collinearity. *) (* ------------------------------------------------------------------------- *) let COLLINEAR_TRANSLATION_EQ = prove (`!a s. collinear (IMAGE (\x. a + x) s) <=> collinear s`, REWRITE_TAC[collinear] THEN GEOM_TRANSLATE_TAC["u"]);; add_translation_invariants [COLLINEAR_TRANSLATION_EQ];; let COLLINEAR_TRANSLATION = prove (`!s a. collinear s ==> collinear (IMAGE (\x. a + x) s)`, REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);; let COLLINEAR_LINEAR_IMAGE = prove (`!f s. collinear s /\ linear f ==> collinear(IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[collinear; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[LINEAR_SUB; LINEAR_CMUL]);; let COLLINEAR_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (collinear (IMAGE f s) <=> collinear s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COLLINEAR_LINEAR_IMAGE));; add_linear_invariants [COLLINEAR_LINEAR_IMAGE_EQ];; (* ------------------------------------------------------------------------- *) (* Take a theorem "th" with outer universal quantifiers involving real^N *) (* and a theorem "dth" asserting |- dimindex(:M) <= dimindex(:N) and *) (* return a theorem replacing type :N by :M in th. Neither N or M need be a *) (* type variable. *) (* ------------------------------------------------------------------------- *) let GEOM_DROP_DIMENSION_RULE = let oth = prove (`!f:real^M->real^N. linear f /\ (!x. norm(f x) = norm x) ==> linear f /\ (!x y. f x = f y ==> x = y) /\ (!x. norm(f x) = norm x)`, MESON_TAC[PRESERVES_NORM_INJECTIVE]) and cth = prove (`linear(f:real^M->real^N) ==> vec 0 = f(vec 0) /\ {} = IMAGE f {} /\ {} = IMAGE (IMAGE f) {} /\ [] = MAP f []`, REWRITE_TAC[IMAGE_CLAUSES; MAP; GSYM LINEAR_0]) in fun dth th -> let ath = GEN_ALL th and eth = MATCH_MP ISOMETRY_UNIV_UNIV dth and avoid = variables(concl th) in let f,bod = dest_exists(concl eth) in let fimage = list_mk_icomb "IMAGE" [f] and fmap = list_mk_icomb "MAP" [f] and fcompose = list_mk_icomb "o" [f] in let fimage2 = list_mk_icomb "IMAGE" [fimage] in let lin,iso = CONJ_PAIR(ASSUME bod) in let olduniv = rand(rand(concl dth)) and newuniv = rand(lhand(concl dth)) in let oldty = fst(dest_fun_ty(type_of olduniv)) and newty = fst(dest_fun_ty(type_of newuniv)) in let newvar v = let n,t = dest_var v in variant avoid (mk_var(n,tysubst[newty,oldty] t)) in let newterm v = try let v' = newvar v in tryfind (fun f -> mk_comb(f,v')) [f;fimage;fmap;fcompose;fimage2] with Failure _ -> v in let specrule th = let v = fst(dest_forall(concl th)) in SPEC (newterm v) th in let sth = SUBS(CONJUNCTS(MATCH_MP cth lin)) ath in let fth = SUBS[SYM(MATCH_MP LINEAR_0 lin)] (repeat specrule sth) in let thps = CONJUNCTS(MATCH_MP oth (ASSUME bod)) in let th5 = LINEAR_INVARIANTS f thps in let th6 = GEN_REWRITE_RULE REDEPTH_CONV [th5] fth in let th7 = PROVE_HYP eth (SIMPLE_CHOOSE f th6) in GENL (map newvar (fst(strip_forall(concl ath)))) th7;; (* ------------------------------------------------------------------------- *) (* Transfer theorems automatically between same-dimension spaces. *) (* Given dth = A |- dimindex(:M) = dimindex(:N) *) (* and a theorem th involving variables of type real^N *) (* returns a corresponding theorem mapped to type real^M with assumptions A. *) (* ------------------------------------------------------------------------- *) let GEOM_EQUAL_DIMENSION_RULE = let bth = prove (`dimindex(:M) = dimindex(:N) ==> ?f:real^M->real^N. (linear f /\ (!y. ?x. f x = y)) /\ (!x. norm(f x) = norm x)`, REWRITE_TAC[SET_RULE `(!y. ?x. f x = y) <=> IMAGE f UNIV = UNIV`] THEN DISCH_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC ISOMETRY_UNIV_SUBSPACE THEN REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV] THEN FIRST_ASSUM ACCEPT_TAC) and pth = prove (`!f:real^M->real^N. linear f /\ (!y. ?x. f x = y) ==> (vec 0 = f(vec 0) /\ {} = IMAGE f {} /\ {} = IMAGE (IMAGE f) {} /\ (:real^N) = IMAGE f (:real^M) /\ (:real^N->bool) = IMAGE (IMAGE f) (:real^M->bool) /\ [] = MAP f []) /\ ((!P. (!x. P x) <=> (!x. P (f x))) /\ (!P. (?x. P x) <=> (?x. P (f x))) /\ (!Q. (!s. Q s) <=> (!s. Q (IMAGE f s))) /\ (!Q. (?s. Q s) <=> (?s. Q (IMAGE f s))) /\ (!Q. (!s. Q s) <=> (!s. Q (IMAGE (IMAGE f) s))) /\ (!Q. (?s. Q s) <=> (?s. Q (IMAGE (IMAGE f) s))) /\ (!P. (!g:real^1->real^N. P g) <=> (!g. P (f o g))) /\ (!P. (?g:real^1->real^N. P g) <=> (?g. P (f o g))) /\ (!P. (!g:num->real^N. P g) <=> (!g. P (f o g))) /\ (!P. (?g:num->real^N. P g) <=> (?g. P (f o g))) /\ (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\ (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\ ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\ (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\ (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`, GEN_TAC THEN SIMP_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> (!y. ?x. f x = y)`; SURJECTIVE_IMAGE] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[QUANTIFY_SURJECTION_HIGHER_THM] THEN REWRITE_TAC[IMAGE_CLAUSES; MAP] THEN MESON_TAC[LINEAR_0]) in fun dth th -> let eth = EXISTS_GENVAR_RULE (MATCH_MP bth dth) in let f,bod = dest_exists(concl eth) in let lsth,neth = CONJ_PAIR(ASSUME bod) in let cth,qth = CONJ_PAIR(MATCH_MP pth lsth) in let th1 = CONV_RULE (EXPAND_QUANTS_CONV qth THENC SUBS_CONV(CONJUNCTS cth)) th in let ith = LINEAR_INVARIANTS f (neth::CONJUNCTS lsth) in let th2 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [BETA_THM;ith] th1 in let th3 = GEN f (DISCH bod th2) in MP (CONV_RULE (REWR_CONV LEFT_FORALL_IMP_THM) th3) eth;; hol-light/Multivariate/flyspeck.ml000066400000000000000000012245721303454263000176020ustar00rootroot00000000000000(* ========================================================================= *) (* Results intended for Flyspeck. *) (* ========================================================================= *) needs "Multivariate/polytope.ml";; needs "Multivariate/realanalysis.ml";; needs "Multivariate/geom.ml";; needs "Multivariate/cross.ml";; prioritize_vector();; (* ------------------------------------------------------------------------- *) (* Not really Flyspeck-specific but needs both angles and cross products. *) (* ------------------------------------------------------------------------- *) let NORM_CROSS = prove (`!x y. norm(x cross y) = norm(x) * norm(y) * sin(vector_angle x y)`, REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN SIMP_TAC[NORM_POS_LE; SIN_VECTOR_ANGLE_POS; REAL_LE_MUL; ARITH_EQ] THEN MP_TAC(SPECL [`x:real^3`; `y:real^3`] NORM_CROSS_DOT) THEN REWRITE_TAC[VECTOR_ANGLE] THEN MP_TAC(SPEC `vector_angle (x:real^3) y` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Other miscelleneous lemmas. *) (* ------------------------------------------------------------------------- *) let COPLANAR_INSERT_0_NEG = prove (`coplanar(vec 0 INSERT --x INSERT s) <=> coplanar(vec 0 INSERT x INSERT s)`, REWRITE_TAC[coplanar; INSERT_SUBSET] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a ==> ~(b /\ c))`] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; SPAN_NEG_EQ]);; let COPLANAR_IMP_NEGLIGIBLE = prove (`!s:real^3->bool. coplanar s ==> negligible s`, REWRITE_TAC[coplanar] THEN MESON_TAC[NEGLIGIBLE_AFFINE_HULL_3; NEGLIGIBLE_SUBSET]);; let NOT_COPLANAR_0_4_IMP_INDEPENDENT = prove (`!v1 v2 v3:real^N. ~coplanar {vec 0,v1,v2,v3} ==> independent {v1,v2,v3}`, REPEAT GEN_TAC THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN REWRITE_TAC[dependent] THEN SUBGOAL_THEN `!v1 v2 v3:real^N. v1 IN span {v2,v3} ==> coplanar{vec 0,v1,v2,v3}` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `v2:real^N`; `v3:real^N`] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`v1:real^N`,`v1:real^N`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM SUBST_ALL_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`v1:real^N`; `v2:real^N`; `v3:real^N`]); FIRST_X_ASSUM(MP_TAC o SPECL [`v2:real^N`; `v3:real^N`; `v1:real^N`]); FIRST_X_ASSUM(MP_TAC o SPECL [`v3:real^N`; `v1:real^N`; `v2:real^N`])] THEN REWRITE_TAC[INSERT_AC] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a IN s ==> s SUBSET t ==> a IN t`)) THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]]);; let NOT_COPLANAR_NOT_COLLINEAR = prove (`!v1 v2 v3 w:real^N. ~coplanar {v1, v2, v3, w} ==> ~collinear {v1, v2, v3}`, REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar; CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN EXISTS_TAC `w:real^N` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN EXISTS_TAC `affine hull {x:real^N,y}` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some special scaling theorems. *) (* ------------------------------------------------------------------------- *) let SUBSET_AFFINE_HULL_SPECIAL_SCALE = prove (`!a x s t. ~(a = &0) ==> (vec 0 INSERT (a % x) INSERT s SUBSET affine hull t <=> vec 0 INSERT x INSERT s SUBSET affine hull t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[INSERT_SUBSET] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; SPAN_MUL_EQ]);; let COLLINEAR_SPECIAL_SCALE = prove (`!a x y. ~(a = &0) ==> (collinear {vec 0,a % x,y} <=> collinear{vec 0,x,y})`, REPEAT STRIP_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN ASM_SIMP_TAC[SUBSET_AFFINE_HULL_SPECIAL_SCALE]);; let COLLINEAR_SCALE_ALL = prove (`!a b v w. ~(a = &0) /\ ~(b = &0) ==> (collinear {vec 0,a % v,b % w} <=> collinear {vec 0,v,w})`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE]);; let COPLANAR_SPECIAL_SCALE = prove (`!a x y z. ~(a = &0) ==> (coplanar {vec 0,a % x,y,z} <=> coplanar {vec 0,x,y,z})`, REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN ASM_SIMP_TAC[SUBSET_AFFINE_HULL_SPECIAL_SCALE]);; let COPLANAR_SCALE_ALL = prove (`!a b c x y z. ~(a = &0) /\ ~(b = &0) /\ ~(c = &0) ==> (coplanar {vec 0,a % x,b % y,c % z} <=> coplanar {vec 0,x,y,z})`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,c,d,b}`] THEN ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,c,d,b}`] THEN ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE]);; (* ------------------------------------------------------------------------- *) (* Specialized lemmas about "dropout". *) (* ------------------------------------------------------------------------- *) let DROPOUT_BASIS_3 = prove (`(dropout 3:real^3->real^2) (basis 1) = basis 1 /\ (dropout 3:real^3->real^2) (basis 2) = basis 2 /\ (dropout 3:real^3->real^2) (basis 3) = vec 0`, SIMP_TAC[LAMBDA_BETA; dropout; basis; CART_EQ; DIMINDEX_2; DIMINDEX_3; ARITH; VEC_COMPONENT; LT_IMP_LE; ARITH_RULE `i <= 2 ==> i + 1 <= 3`; ARITH_RULE `1 <= i + 1`] THEN ARITH_TAC);; let COLLINEAR_BASIS_3 = prove (`collinear {vec 0,basis 3,x} <=> (dropout 3:real^3->real^2) x = vec 0`, SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; COLLINEAR_LEMMA] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN REAL_ARITH_TAC);; let OPEN_DROPOUT_3 = prove (`!P. open {x | P x} ==> open {x | P((dropout 3:real^3->real^2) x)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`dropout 3:real^3->real^2`; `{x:real^2 | P x}`] CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN SIMP_TAC[LINEAR_DROPOUT; DIMINDEX_2; DIMINDEX_3; ARITH]);; let SLICE_DROPOUT_3 = prove (`!P t. slice 3 t {x | P((dropout 3:real^3->real^2) x)} = {x | P x}`, REPEAT GEN_TAC THEN REWRITE_TAC[slice] THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^2` THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `(pushin 3 t:real^2->real^3) y` THEN ASM_SIMP_TAC[DIMINDEX_2; DIMINDEX_3; DROPOUT_PUSHIN; ARITH] THEN SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL; DIMINDEX_3; ARITH]);; let NOT_COPLANAR_IMP_NOT_COLLINEAR_DROPOUT_3 = prove (`!x y:real^3. ~coplanar {vec 0,basis 3, x, y} ==> ~collinear {vec 0,dropout 3 x:real^2,dropout 3 y}`, REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar] THEN REWRITE_TAC[CONTRAPOS_THM; INSERT_SUBSET; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN REWRITE_TAC[EMPTY_SUBSET] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_HULL_2]) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real`;`b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `?r s. a * r + b * s = -- &1` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `a = &0` THENL [UNDISCH_TAC `a + b = &1` THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_MUL_LID; EXISTS_REFL]; ASM_SIMP_TAC[REAL_FIELD `~(a = &0) ==> (a * r + x = y <=> r = (y - x) / a)`] THEN MESON_TAC[]]; ALL_TAC] THEN EXISTS_TAC `vector[(u:real^2)$1; u$2; r]:real^3` THEN EXISTS_TAC `vector[(v:real^2)$1; v$2; s]:real^3` THEN EXISTS_TAC `basis 3:real^3` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY EXISTS_TAC [`a / &2`;`b / &2`; `&1 / &2`] THEN ASM_REWRITE_TAC[REAL_ARITH `a / &2 + b / &2 + &1 / &2 = &1 <=> a + b = &1`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_3; BASIS_COMPONENT; ARITH] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC REAL_RING; ALL_TAC] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN DISCH_TAC THEN SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN SUBGOAL_THEN `!x. (dropout 3:real^3->real^2) x IN span {u,v} ==> x IN span {vector [u$1; u$2; r], vector [v$1; v$2; s], basis 3}` (fun th -> ASM_MESON_TAC[th]) THEN GEN_TAC THEN REWRITE_TAC[SPAN_2; SPAN_3] THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV; CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; dropout; VECTOR_ADD_COMPONENT; LAMBDA_BETA; VECTOR_MUL_COMPONENT; VECTOR_3; BASIS_COMPONENT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `x = a + b + c * &1 <=> c = x - a - b`] THEN REWRITE_TAC[EXISTS_REFL]);; let SLICE_312 = prove (`!s:real^3->bool. slice 1 t s = {y:real^2 | vector[t;y$1;y$2] IN s}`, SIMP_TAC[EXTENSION; IN_SLICE; DIMINDEX_2; DIMINDEX_3; ARITH] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; pushin; LAMBDA_BETA; FORALL_3; DIMINDEX_3; ARITH; VECTOR_3]);; let SLICE_123 = prove (`!s:real^3->bool. slice 3 t s = {y:real^2 | vector[y$1;y$2;t] IN s}`, SIMP_TAC[EXTENSION; IN_SLICE; DIMINDEX_2; DIMINDEX_3; ARITH] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; pushin; LAMBDA_BETA; FORALL_3; DIMINDEX_3; ARITH; VECTOR_3]);; (* ------------------------------------------------------------------------- *) (* "Padding" injection from real^2 -> real^3 with zero last coordinate. *) (* ------------------------------------------------------------------------- *) let pad2d3d = new_definition `(pad2d3d:real^2->real^3) x = lambda i. if i < 3 then x$i else &0`;; let FORALL_PAD2D3D_THM = prove (`!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[pad2d3d] THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_3; ARITH; LT_REFL]; FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (y:real^3)$i):real^2`) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; pad2d3d; DIMINDEX_3; ARITH; LAMBDA_BETA; DIMINDEX_2; ARITH_RULE `i < 3 <=> i <= 2`] THEN REWRITE_TAC[ARITH_RULE `i <= 3 <=> i <= 2 \/ i = 3`] THEN ASM_MESON_TAC[]]);; let QUANTIFY_PAD2D3D_THM = prove (`(!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))) /\ (!P. (?y:real^3. y$3 = &0 /\ P y) <=> (?x. P(pad2d3d x)))`, REWRITE_TAC[MESON[] `(?y. P y) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[GSYM FORALL_PAD2D3D_THM] THEN MESON_TAC[]);; let LINEAR_PAD2D3D = prove (`linear pad2d3d`, REWRITE_TAC[linear; pad2d3d] THEN SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH; ARITH_RULE `i < 3 ==> i <= 2`] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REAL_ARITH_TAC);; let INJECTIVE_PAD2D3D = prove (`!x y. pad2d3d x = pad2d3d y ==> x = y`, SIMP_TAC[CART_EQ; pad2d3d; LAMBDA_BETA; DIMINDEX_3; DIMINDEX_2] THEN REWRITE_TAC[ARITH_RULE `i < 3 <=> i <= 2`] THEN MESON_TAC[ARITH_RULE `i <= 2 ==> i <= 3`]);; let NORM_PAD2D3D = prove (`!x. norm(pad2d3d x) = norm x`, SIMP_TAC[NORM_EQ; DOT_2; DOT_3; pad2d3d; LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Apply 3D->2D conversion to a goal. Take care to preserve variable names. *) (* ------------------------------------------------------------------------- *) let PAD2D3D_QUANTIFY_CONV = let gv = genvar `:real^2` in let pth = CONV_RULE (BINOP_CONV(BINDER_CONV(RAND_CONV(GEN_ALPHA_CONV gv)))) QUANTIFY_PAD2D3D_THM in let conv1 = GEN_REWRITE_CONV I [pth] and dest_quant tm = try dest_forall tm with Failure _ -> dest_exists tm in fun tm -> let th = conv1 tm in let name = fst(dest_var(fst(dest_quant tm))) in let ty = snd(dest_var(fst(dest_quant(rand(concl th))))) in CONV_RULE(RAND_CONV(GEN_ALPHA_CONV(mk_var(name,ty)))) th;; let PAD2D3D_TAC = let pad2d3d_tm = `pad2d3d` and pths = [LINEAR_PAD2D3D; INJECTIVE_PAD2D3D; NORM_PAD2D3D] and cth = prove (`{} = IMAGE pad2d3d {} /\ vec 0 = pad2d3d(vec 0)`, REWRITE_TAC[IMAGE_CLAUSES] THEN MESON_TAC[LINEAR_PAD2D3D; LINEAR_0]) in let lasttac = GEN_REWRITE_TAC REDEPTH_CONV [LINEAR_INVARIANTS pad2d3d_tm pths] in fun gl -> (GEN_REWRITE_TAC ONCE_DEPTH_CONV [cth] THEN CONV_TAC(DEPTH_CONV PAD2D3D_QUANTIFY_CONV) THEN lasttac) gl;; (* ------------------------------------------------------------------------- *) (* The notion of a plane, and using it to characterize coplanarity. *) (* ------------------------------------------------------------------------- *) let plane = new_definition `plane x = (?u v w. ~(collinear {u,v,w}) /\ x = affine hull {u,v,w})`;; let PLANE_TRANSLATION_EQ = prove (`!a:real^N s. plane(IMAGE (\x. a + x) s) <=> plane s`, REWRITE_TAC[plane] THEN GEOM_TRANSLATE_TAC[]);; let PLANE_TRANSLATION = prove (`!a:real^N s. plane s ==> plane(IMAGE (\x. a + x) s)`, REWRITE_TAC[PLANE_TRANSLATION_EQ]);; add_translation_invariants [PLANE_TRANSLATION_EQ];; let PLANE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N p. linear f /\ (!x y. f x = f y ==> x = y) ==> (plane(IMAGE f p) <=> plane p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[plane] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `?u. u IN IMAGE f (:real^M) /\ ?v. v IN IMAGE f (:real^M) /\ ?w. w IN IMAGE (f:real^M->real^N) (:real^M) /\ ~collinear {u, v, w} /\ IMAGE f p = affine hull {u, v, w}` THEN CONJ_TAC THENL [REWRITE_TAC[RIGHT_AND_EXISTS_THM; IN_IMAGE; IN_UNIV] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{u,v,w} SUBSET IMAGE (f:real^M->real^N) p` MP_TAC THENL [ASM_REWRITE_TAC[HULL_SUBSET]; SET_TAC[]]; REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[SET_RULE `{f a,f b,f c} = IMAGE f {a,b,c}`] THEN ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN BINOP_TAC THENL [ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ]; ASM SET_TAC[]]]);; let PLANE_LINEAR_IMAGE = prove (`!f:real^M->real^N p. linear f /\ plane p /\ (!x y. f x = f y ==> x = y) ==> plane(IMAGE f p)`, MESON_TAC[PLANE_LINEAR_IMAGE_EQ]);; add_linear_invariants [PLANE_LINEAR_IMAGE_EQ];; let AFFINE_PLANE = prove (`!p. plane p ==> affine p`, SIMP_TAC[plane; LEFT_IMP_EXISTS_THM; AFFINE_AFFINE_HULL]);; let ROTATION_PLANE_HORIZONTAL = prove (`!s. plane s ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ IMAGE f (IMAGE (\x. a + x) s) = {z:real^3 | z$3 = &0}`, let lemma = prove (`span {z:real^3 | z$3 = &0} = {z:real^3 | z$3 = &0}`, REWRITE_TAC[SPAN_EQ_SELF; subspace; IN_ELIM_THM] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [plane]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC]) [`a:real^3 = b`; `a:real^3 = c`; `b:real^3 = c`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN ASM_SIMP_TAC[AFFINE_HULL_INSERT_SPAN; IN_INSERT; NOT_IN_EMPTY] THEN EXISTS_TAC `--a:real^3` THEN REWRITE_TAC[SET_RULE `IMAGE (\x:real^3. --a + x) {a + x | x | x IN s} = IMAGE (\x. --a + a + x) s`] THEN REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^3 = x`; IMAGE_ID] THEN REWRITE_TAC[SET_RULE `{x - a:real^x | x = b \/ x = c} = {b - a,c - a}`] THEN MP_TAC(ISPEC `span{b - a:real^3,c - a}` ROTATION_LOWDIM_HORIZONTAL) THEN REWRITE_TAC[DIMINDEX_3] THEN ANTS_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD{b - a:real^3,c - a}` THEN SIMP_TAC[DIM_SPAN; DIM_LE_CARD; FINITE_RULES] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^3->real^3` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM lemma] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN CONJ_TAC THENL [ASM_MESON_TAC[IMAGE_SUBSET; SPAN_INC; SUBSET_TRANS]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`{z:real^3 | z$3 = &0}`; `(:real^3)`] DIM_EQ_SPAN) THEN REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3; lemma] THEN MATCH_MP_TAC(TAUT `~r /\ (~p ==> q) ==> (q ==> r) ==> p`) THEN REWRITE_TAC[ARITH_RULE `~(x <= 2) <=> 3 <= x`] THEN REWRITE_TAC[EXTENSION; SPAN_UNIV; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `vector[&0;&0;&1]:real^3`) THEN REWRITE_TAC[IN_UNIV; VECTOR_3] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim {b - a:real^3,c - a}` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL; DIM_INJECTIVE_LINEAR_IMAGE; ORTHOGONAL_TRANSFORMATION_INJECTIVE]] THEN MP_TAC(ISPEC `{b - a:real^3,c - a}` INDEPENDENT_BOUND_GENERAL) THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`; ARITH] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [SET_RULE `{a,b,c} = {b,a,c}`]) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[independent; CONTRAPOS_THM; dependent] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; RIGHT_OR_DISTRIB] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {a,b} DELETE b = {a}`; SET_RULE `~(a = b) ==> {a,b} DELETE a = {b}`; VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`] THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN ONCE_REWRITE_TAC[VECTOR_SUB_EQ] THEN MESON_TAC[COLLINEAR_LEMMA; INSERT_AC]);; let ROTATION_HORIZONTAL_PLANE = prove (`!p. plane p ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ IMAGE (\x. a + x) (IMAGE f {z:real^3 | z$3 = &0}) = p`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP ROTATION_PLANE_HORIZONTAL) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^3` (X_CHOOSE_THEN `f:real^3->real^3` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(X_CHOOSE_THEN `g:real^3->real^3` STRIP_ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE) THEN MAP_EVERY EXISTS_TAC [`--a:real^3`; `g:real^3->real^3`] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^3 = x`] THEN MATCH_MP_TAC(REAL_RING `!f. f * g = &1 /\ f = &1 ==> g = &1`) THEN EXISTS_TAC `det(matrix(f:real^3->real^3))` THEN REWRITE_TAC[GSYM DET_MUL] THEN ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN ASM_REWRITE_TAC[o_DEF; MATRIX_ID; DET_I]);; let COPLANAR = prove (`2 <= dimindex(:N) ==> !s:real^N->bool. coplanar s <=> ?x. plane x /\ s SUBSET x`, DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[coplanar; plane] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(?x u v w. p x u v w) <=> (?u v w x. p x u v w)`] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`; `w:real^N`] THEN DISCH_TAC THEN SUBGOAL_THEN `s SUBSET {u + x:real^N | x | x IN span {y - u | y IN {v,w}}}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[AFFINE_HULL_INSERT_SUBSET_SPAN]; ALL_TAC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN DISCH_THEN(MP_TAC o ISPEC `\x:real^N. x - u` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID; SIMPLE_IMAGE] THEN REWRITE_TAC[IMAGE_CLAUSES] THEN MP_TAC(ISPECL [`{v - u:real^N,w - u}`; `2`] LOWDIM_EXPAND_BASIS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD{v - u:real^N,w - u}` THEN SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_RULES] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN UNDISCH_TAC `span {v - u, w - u} SUBSET span {a:real^N, b}` THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP SUBSET_TRANS) THEN MAP_EVERY EXISTS_TAC [`u:real^N`; `u + a:real^N`; `u + b:real^N`] THEN CONJ_TAC THENL [REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA; VECTOR_ARITH `--x = vec 0 <=> x = vec 0`; VECTOR_ARITH `u - (u + a):real^N = --a`; VECTOR_ARITH `(u + b) - (u + a):real^N = b - a`] THEN REWRITE_TAC[DE_MORGAN_THM; VECTOR_SUB_EQ; VECTOR_ARITH `b - a = c % -- a <=> (c - &1) % a + &1 % b = vec 0`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_INSERT; INDEPENDENT_NONZERO]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN REWRITE_TAC[DEPENDENT_EXPLICIT] THEN MAP_EVERY EXISTS_TAC [`{a:real^N,b}`; `\x:real^N. if x = a then u - &1 else &1`] THEN REWRITE_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL] THEN CONJ_TAC THENL [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[IN_INSERT] THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_RULES] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. u + x` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; ONCE_REWRITE_RULE[VECTOR_ADD_SYM] VECTOR_SUB_ADD] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; VECTOR_ADD_SUB] THEN SET_TAC[]);; let COPLANAR_DET_EQ_0 = prove (`!v0 v1 (v2: real^3) v3. coplanar {v0,v1,v2,v3} <=> det(vector[v1 - v0; v2 - v0; v3 - v0]) = &0`, REPEAT GEN_TAC THEN REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW] THEN REWRITE_TAC[rows; row; LAMBDA_ETA] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM numseg; DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN SIMP_TAC[IMAGE_CLAUSES; coplanar; VECTOR_3] THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN W(MP_TAC o PART_MATCH lhand AFFINE_HULL_INSERT_SUBSET_SPAN o rand o lhand o snd) THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_TRANS) THEN DISCH_THEN(MP_TAC o ISPEC `\x:real^3. x - a` o MATCH_MP IMAGE_SUBSET) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID; SIMPLE_IMAGE] THEN REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM DIM_SPAN] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD {b - a:real^3,c - a}` THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_CARD_GE_DIM; SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC] THEN REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN MATCH_MP_TAC SPAN_MONO THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN MP_TAC(VECTOR_ARITH `!x y:real^3. x - y = (x - a) - (y - a)`) THEN DISCH_THEN(fun th -> REPEAT CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [th]) THEN MATCH_MP_TAC SPAN_SUB THEN ASM_REWRITE_TAC[]; DISCH_TAC THEN MP_TAC(ISPECL [`{v1 - v0,v2 - v0,v3 - v0}:real^3->bool`; `2`] LOWDIM_EXPAND_BASIS) THEN ASM_REWRITE_TAC[ARITH_RULE `n <= 2 <=> n < 3`; DIMINDEX_3; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool` (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN SIMP_TAC[COPLANAR; DIMINDEX_3; ARITH; plane] THEN MAP_EVERY EXISTS_TAC [`v0:real^3`; `v0 + a:real^3`; `v0 + b:real^3`] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; IMAGE_ID; VECTOR_ADD_SUB] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `IMAGE (\v:real^3. v0 + v) (span{v1 - v0, v2 - v0, v3 - v0})` THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_IMAGE] THEN CONJ_TAC THENL [EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[SPAN_0] THEN VECTOR_ARITH_TAC; REWRITE_TAC[VECTOR_ARITH `v1:real^N = v0 + x <=> x = v1 - v0`] THEN REWRITE_TAC[UNWIND_THM2] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INSERT]]]);; let COPLANAR_CROSS_DOT = prove (`!v w x y. coplanar {v,w,x,y} <=> ((w - v) cross (x - v)) dot (y - v) = &0`, REWRITE_TAC[COPLANAR_DET_EQ_0; GSYM DOT_CROSS_DET] THEN MESON_TAC[CROSS_TRIPLE; DOT_SYM]);; let PLANE_AFFINE_HULL_3 = prove (`!a b c:real^N. plane(affine hull {a,b,c}) <=> ~collinear{a,b,c}`, REWRITE_TAC[plane] THEN MESON_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR]);; let AFFINE_HULL_3_GENERATED = prove (`!s u v w:real^N. s SUBSET affine hull {u,v,w} /\ ~collinear s ==> affine hull {u,v,w} = affine hull s`, REWRITE_TAC[COLLINEAR_AFF_DIM; INT_NOT_LE] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN GEN_REWRITE_TAC RAND_CONV [GSYM HULL_HULL] THEN MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&2:int` THEN CONJ_TAC THENL [ALL_TAC; ASM_INT_ARITH_TAC] THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_LE_CARD o lhand o snd) THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS) THEN REWRITE_TAC[INT_LE_SUB_RADD; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Additional WLOG tactic to rotate any plane p to {z | z$3 = &0}. *) (* ------------------------------------------------------------------------- *) let GEOM_HORIZONTAL_PLANE_RULE = let ifn = MATCH_MP (TAUT `(p ==> (x <=> x')) /\ (~p ==> (x <=> T)) ==> (x' ==> x)`) and pth = prove (`!a f. orthogonal_transformation (f:real^N->real^N) ==> ((!P. (!x. P x) <=> (!x. P (a + f x))) /\ (!P. (?x. P x) <=> (?x. P (a + f x))) /\ (!Q. (!s. Q s) <=> (!s. Q (IMAGE (\x. a + x) (IMAGE f s)))) /\ (!Q. (?s. Q s) <=> (?s. Q (IMAGE (\x. a + x) (IMAGE f s))))) /\ (!P. {x | P x} = IMAGE (\x. a + x) (IMAGE f {x | P(a + f x)}))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPEC `(\x. a + x) o (f:real^N->real^N)` QUANTIFY_SURJECTION_THM) THEN REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; VECTOR_ARITH `a + (x - a:real^N) = x`]) and cth = prove (`!a f. {} = IMAGE (\x:real^3. a + x) (IMAGE f {})`, REWRITE_TAC[IMAGE_CLAUSES]) and oth = prove (`!f:real^3->real^3. orthogonal_transformation f /\ det(matrix f) = &1 ==> linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:3) ==> det(matrix f) = &1)`, GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) and fth = MESON[] `(!a f. q a f ==> (p <=> p' a f)) ==> ((?a f. q a f) ==> (p <=> !a f. q a f ==> p' a f))` in fun tm -> let x,bod = dest_forall tm in let th1 = EXISTS_GENVAR_RULE (UNDISCH(ISPEC x ROTATION_HORIZONTAL_PLANE)) in let [a;f],tm1 = strip_exists(concl th1) in let [th_orth;th_det;th_im] = CONJUNCTS(ASSUME tm1) in let th2 = PROVE_HYP th_orth (UNDISCH(ISPECL [a;f] pth)) in let th3 = (EXPAND_QUANTS_CONV(ASSUME(concl th2)) THENC SUBS_CONV[GSYM th_im; ISPECL [a;f] cth]) bod in let th4 = PROVE_HYP th2 th3 in let th5 = TRANSLATION_INVARIANTS a in let th6 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [ASSUME(concl th5)] th4 in let th7 = PROVE_HYP th5 th6 in let th8s = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in let th9 = LINEAR_INVARIANTS f th8s in let th10 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [th9] th7 in let th11 = if intersect (frees(concl th10)) [a;f] = [] then PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th10) else MP (MATCH_MP fth (GENL [a;f] (DISCH_ALL th10))) th1 in let th12 = REWRITE_CONV[ASSUME(mk_neg(hd(hyp th11)))] bod in let th13 = ifn(CONJ (DISCH_ALL th11) (DISCH_ALL th12)) in let th14 = MATCH_MP MONO_FORALL (GEN x th13) in GEN_REWRITE_RULE (TRY_CONV o LAND_CONV) [FORALL_SIMP] th14;; let GEOM_HORIZONTAL_PLANE_TAC p = W(fun (asl,w) -> let avs,bod = strip_forall w and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in let avs,bod = strip_forall w in MAP_EVERY X_GEN_TAC avs THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [p])) THEN SPEC_TAC(p,p) THEN W(MATCH_MP_TAC o GEOM_HORIZONTAL_PLANE_RULE o snd));; (* ------------------------------------------------------------------------- *) (* Affsign and its special cases, with invariance theorems. *) (* ------------------------------------------------------------------------- *) let lin_combo = new_definition `lin_combo V f = vsum V (\v. f v % (v:real^N))`;; let affsign = new_definition `affsign sgn s t (v:real^A) <=> (?f. (v = lin_combo (s UNION t) f) /\ (!w. t w ==> sgn (f w)) /\ (sum (s UNION t) f = &1))`;; let sgn_gt = new_definition `sgn_gt = (\t. (&0 < t))`;; let sgn_ge = new_definition `sgn_ge = (\t. (&0 <= t))`;; let sgn_lt = new_definition `sgn_lt = (\t. (t < &0))`;; let sgn_le = new_definition `sgn_le = (\t. (t <= &0))`;; let aff_gt_def = new_definition `aff_gt = affsign sgn_gt`;; let aff_ge_def = new_definition `aff_ge = affsign sgn_ge`;; let aff_lt_def = new_definition `aff_lt = affsign sgn_lt`;; let aff_le_def = new_definition `aff_le = affsign sgn_le`;; let AFFSIGN = prove (`affsign sgn s t = {y | ?f. y = vsum (s UNION t) (\v. f v % v) /\ (!w. w IN t ==> sgn(f w)) /\ sum (s UNION t) f = &1}`, REWRITE_TAC[FUN_EQ_THM; affsign; lin_combo; IN_ELIM_THM] THEN REWRITE_TAC[IN]);; let AFFSIGN_ALT = prove (`affsign sgn s t = {y | ?f. (!w. w IN (s UNION t) ==> w IN t ==> sgn(f w)) /\ sum (s UNION t) f = &1 /\ vsum (s UNION t) (\v. f v % v) = y}`, REWRITE_TAC[SET_RULE `(w IN (s UNION t) ==> w IN t ==> P w) <=> (w IN t ==> P w)`] THEN REWRITE_TAC[AFFSIGN; EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);; let IN_AFFSIGN = prove (`y IN affsign sgn s t <=> ?u. (!x. x IN t ==> sgn(u x)) /\ sum (s UNION t) u = &1 /\ vsum (s UNION t) (\x. u(x) % x) = y`, REWRITE_TAC[AFFSIGN; IN_ELIM_THM] THEN SET_TAC[]);; let AFFSIGN_DISJOINT_DIFF = prove (`!s t. affsign sgn s t = affsign sgn (s DIFF t) t`, REWRITE_TAC[AFFSIGN; SET_RULE `(s DIFF t) UNION t = s UNION t`]);; let AFF_GE_DISJOINT_DIFF = prove (`!s t. aff_ge s t = aff_ge (s DIFF t) t`, REWRITE_TAC[aff_ge_def] THEN MATCH_ACCEPT_TAC AFFSIGN_DISJOINT_DIFF);; let AFFSIGN_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N sgn s t v. linear f /\ (!x y. f x = f y ==> x = y) ==> (affsign sgn (IMAGE f s) (IMAGE f t) = IMAGE f (affsign sgn s t))`, let lemma0 = prove (`vsum s (\x. u x % x) = vsum {x | x IN s /\ ~(u x = &0)} (\x. u x % x)`, MATCH_MP_TAC VSUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[TAUT `p /\ ~(p /\ ~q) <=> p /\ q`] THEN SIMP_TAC[o_THM; VECTOR_MUL_LZERO]) in let lemma1 = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (sum(IMAGE f s) u = &1 /\ vsum(IMAGE f s) (\x. u x % x) = y <=> sum s (u o f) = &1 /\ f(vsum s (\x. (u o f) x % x)) = y)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o funpow 3 lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(MESON[] `(p ==> z = x) ==> (p /\ x = y <=> p /\ z = y)`) THEN DISCH_TAC THEN ONCE_REWRITE_TAC[lemma0] THEN SUBGOAL_THEN `{y | y IN IMAGE (f:real^M->real^N) s /\ ~(u y = &0)} = IMAGE f {x | x IN s /\ ~(u(f x) = &0)}` SUBST1_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN SUBGOAL_THEN `FINITE {x | x IN s /\ ~(u((f:real^M->real^N) x) = &0)}` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD; o_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; GSYM LINEAR_CMUL]]) in REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_AFFSIGN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; IN_AFFSIGN] THEN REWRITE_TAC[GSYM IMAGE_UNION] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma1 th]) THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `vsum (s UNION t) (\x. (u o (f:real^M->real^N)) x % x)` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(u:real^N->real) o (f:real^M->real^N)` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[o_THM]; MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; let AFF_GE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_ge (IMAGE f s) (IMAGE f t) = IMAGE f (aff_ge s t)`, REWRITE_TAC[aff_ge_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; let AFF_GT_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_gt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_gt s t)`, REWRITE_TAC[aff_gt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; let AFF_LE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_le (IMAGE f s) (IMAGE f t) = IMAGE f (aff_le s t)`, REWRITE_TAC[aff_le_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; let AFF_LT_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_lt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_lt s t)`, REWRITE_TAC[aff_lt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; add_linear_invariants [AFFSIGN_INJECTIVE_LINEAR_IMAGE; AFF_GE_INJECTIVE_LINEAR_IMAGE; AFF_GT_INJECTIVE_LINEAR_IMAGE; AFF_LE_INJECTIVE_LINEAR_IMAGE; AFF_LT_INJECTIVE_LINEAR_IMAGE];; let IN_AFFSIGN_TRANSLATION = prove (`!sgn s t a v:real^N. affsign sgn s t v ==> affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) (a + v)`, REPEAT GEN_TAC THEN REWRITE_TAC[affsign; lin_combo] THEN ONCE_REWRITE_TAC[SET_RULE `(!x. s x ==> p x) <=> (!x. x IN s ==> p x)`] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` (CONJUNCTS_THEN2 SUBST_ALL_TAC STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\x. (f:real^N->real)(x - a)` THEN ASM_REWRITE_TAC[GSYM IMAGE_UNION] THEN REPEAT CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[FORALL_IN_IMAGE; ETA_AX; VECTOR_ARITH `(a + x) - a:real^N = x`]; W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_REWRITE_TAC[o_DEF; VECTOR_ADD_SUB; ETA_AX]] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `a + vsum {x | x IN s UNION t /\ ~(f x = &0)} (\v:real^N. f v % v)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum (IMAGE (\x:real^N. a + x) {x | x IN s UNION t /\ ~(f x = &0)}) (\v. f(v - a) % v)` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; VECTOR_MUL_EQ_0] THEN REWRITE_TAC[VECTOR_ADD_SUB] THEN SET_TAC[]] THEN SUBGOAL_THEN `FINITE {x:real^N | x IN s UNION t /\ ~(f x = &0)}` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rhs o snd) THEN ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[o_DEF; VECTOR_ADD_SUB] THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VSUM_RMUL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[]);; let AFFSIGN_TRANSLATION = prove (`!a:real^N sgn s t. affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (affsign sgn s t)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP IN_AFFSIGN_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; IMAGE_ID] THEN DISCH_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `--a + x:real^N` THEN ASM_REWRITE_TAC[IN] THEN VECTOR_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN REWRITE_TAC[IN] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP IN_AFFSIGN_TRANSLATION) THEN REWRITE_TAC[]]);; let AFF_GE_TRANSLATION = prove (`!a:real^N s t. aff_ge (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_ge s t)`, REWRITE_TAC[aff_ge_def; AFFSIGN_TRANSLATION]);; let AFF_GT_TRANSLATION = prove (`!a:real^N s t. aff_gt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_gt s t)`, REWRITE_TAC[aff_gt_def; AFFSIGN_TRANSLATION]);; let AFF_LE_TRANSLATION = prove (`!a:real^N s t. aff_le (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_le s t)`, REWRITE_TAC[aff_le_def; AFFSIGN_TRANSLATION]);; let AFF_LT_TRANSLATION = prove (`!a:real^N s t. aff_lt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_lt s t)`, REWRITE_TAC[aff_lt_def; AFFSIGN_TRANSLATION]);; add_translation_invariants [AFFSIGN_TRANSLATION; AFF_GE_TRANSLATION; AFF_GT_TRANSLATION; AFF_LE_TRANSLATION; AFF_LT_TRANSLATION];; (* ------------------------------------------------------------------------- *) (* Automate special cases of affsign. *) (* ------------------------------------------------------------------------- *) let AFF_TAC = REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def; aff_gt_def; aff_le_def; aff_lt_def; sgn_ge; sgn_gt; sgn_le; sgn_lt; AFFSIGN_ALT] THEN REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN REWRITE_TAC[UNION_EMPTY] THEN SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; FINITE_EMPTY; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_LE_ADD; REAL_ARITH `&0 <= a / &2 <=> &0 <= a`; REAL_ARITH `&0 < a / &2 <=> &0 < a`; REAL_ARITH `a / &2 <= &0 <=> a <= &0`; REAL_ARITH `a / &2 < &0 <=> a < &0`; REAL_ARITH `a < &0 /\ b < &0 ==> a + b < &0`; REAL_ARITH `a < &0 /\ b <= &0 ==> a + b <= &0`] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; real_ge] THEN REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`; VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; REAL_ADD_RID; VECTOR_ADD_RID] THEN ONCE_REWRITE_TAC[REAL_ARITH `&1 = x <=> x = &1`] THEN REWRITE_TAC[] THEN SET_TAC[];; let AFF_GE_1_1 = prove (`!x v w. DISJOINT {x} {v} ==> aff_ge {x} {v} = {y | ?t1 t2. &0 <= t2 /\ t1 + t2 = &1 /\ y = t1 % x + t2 % v }`, AFF_TAC);; let AFF_GE_1_2 = prove (`!x v w. DISJOINT {x} {v,w} ==> aff_ge {x} {v,w} = {y | ?t1 t2 t3. &0 <= t2 /\ &0 <= t3 /\ t1 + t2 + t3 = &1 /\ y = t1 % x + t2 % v + t3 % w}`, AFF_TAC);; let AFF_GE_2_1 = prove (`!x v w. DISJOINT {x,v} {w} ==> aff_ge {x,v} {w} = {y | ?t1 t2 t3. &0 <= t3 /\ t1 + t2 + t3 = &1 /\ y = t1 % x + t2 % v + t3 % w}`, AFF_TAC);; let AFF_GT_1_1 = prove (`!x v w. DISJOINT {x} {v} ==> aff_gt {x} {v} = {y | ?t1 t2. &0 < t2 /\ t1 + t2 = &1 /\ y = t1 % x + t2 % v}`, AFF_TAC);; let AFF_GT_1_2 = prove (`!x v w. DISJOINT {x} {v,w} ==> aff_gt {x} {v,w} = {y | ?t1 t2 t3. &0 < t2 /\ &0 < t3 /\ t1 + t2 + t3 = &1 /\ y = t1 % x + t2 % v + t3 % w}`, AFF_TAC);; let AFF_GT_2_1 = prove (`!x v w. DISJOINT {x,v} {w} ==> aff_gt {x,v} {w} = {y | ?t1 t2 t3. &0 < t3 /\ t1 + t2 + t3 = &1 /\ y = t1 % x + t2 % v + t3 % w}`, AFF_TAC);; let AFF_GT_3_1 = prove (`!v w x y. DISJOINT {v,w,x} {y} ==> aff_gt {v,w,x} {y} = {z | ?t1 t2 t3 t4. &0 < t4 /\ t1 + t2 + t3 + t4 = &1 /\ z = t1 % v + t2 % w + t3 % x + t4 % y}`, AFF_TAC);; let AFF_LT_1_1 = prove (`!x v. DISJOINT {x} {v} ==> aff_lt {x} {v} = {y | ?t1 t2. t2 < &0 /\ t1 + t2 = &1 /\ y = t1 % x + t2 % v}`, AFF_TAC);; let AFF_LT_2_1 = prove (`!x v w. DISJOINT {x,v} {w} ==> aff_lt {x,v} {w} = {y | ?t1 t2 t3. t3 < &0 /\ t1 + t2 + t3 = &1 /\ y = t1 % x + t2 % v + t3 % w}`, AFF_TAC);; let AFF_GE_1_2_0 = prove (`!v w. ~(v = vec 0) /\ ~(w = vec 0) ==> aff_ge {vec 0} {v,w} = {a % v + b % w | &0 <= a /\ &0 <= b}`, SIMP_TAC[AFF_GE_1_2; SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P b c /\ Q b c /\ R a b c /\ S b c) <=> (?b c. P b c /\ Q b c /\ S b c /\ ?a. R a b c)`] THEN REWRITE_TAC[REAL_ARITH `t + s:real = &1 <=> t = &1 - s`; EXISTS_REFL] THEN SET_TAC[]);; let AFF_GE_1_1_0 = prove (`!v. ~(v = vec 0) ==> aff_ge {vec 0} {v} = {a % v | &0 <= a}`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SET_RULE `{a} = {a,a}`] THEN ASM_SIMP_TAC[AFF_GE_1_2_0; GSYM VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[REAL_LE_ADD; REAL_ARITH `&0 <= a ==> &0 <= a / &2 /\ a / &2 + a / &2 = a`]);; let AFF_GE_2_1_0 = prove (`!v w. DISJOINT {vec 0, v} {w} ==> aff_ge {vec 0, v} {w} = {s % v + t % w |s,t| &0 <= t}`, SIMP_TAC[AFF_GE_2_1; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN REWRITE_TAC[REAL_ARITH `t + u = &1 <=> t = &1 - u`; UNWIND_THM2] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Properties of affsign variants. *) (* ------------------------------------------------------------------------- *) let CONVEX_AFFSIGN = prove (`!sgn. (!x y u. sgn(x) /\ sgn(y) /\ &0 <= u /\ u <= &1 ==> sgn((&1 - u) * x + u * y)) ==> !s t:real^N->bool. convex(affsign sgn s t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; CONVEX_ALT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN X_GEN_TAC `f:real^N->real` THEN STRIP_TAC THEN X_GEN_TAC `g:real^N->real` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. (&1 - u) * f x + u * g x` THEN ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN REPEAT CONJ_TAC THENL [CONV_TAC SYM_CONV THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_ADD_GEN o lhand o snd) THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN DISCH_THEN MATCH_MP_TAC; ASM_MESON_TAC[]; W(MP_TAC o PART_MATCH (lhs o rand) SUM_ADD_GEN o lhand o snd) THEN ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_RID; REAL_SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC] THEN (CONJ_TAC THENL [MP_TAC(ASSUME `sum (s UNION t:real^N->bool) f = &1`); MP_TAC(ASSUME `sum (s UNION t:real^N->bool) g = &1`)]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sum] THEN ONCE_REWRITE_TAC[iterate] THEN REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; REAL_MUL_RZERO]);; let CONVEX_AFF_GE = prove (`!s t. convex(aff_ge s t)`, REWRITE_TAC[aff_ge_def; sgn_ge] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_SUB_LE]);; let CONVEX_AFF_LE = prove (`!s t. convex(aff_le s t)`, REWRITE_TAC[aff_le_def; sgn_le] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`; REAL_NEG_ADD; GSYM REAL_MUL_RNEG] THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_SUB_LE]);; let CONVEX_AFF_GT = prove (`!s t. convex(aff_gt s t)`, REWRITE_TAC[aff_gt_def; sgn_gt] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`; REAL_ARITH `x <= &1 <=> x = &1 \/ x < &1`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_MUL; REAL_SUB_LT]);; let CONVEX_AFF_LT = prove (`!s t. convex(aff_lt s t)`, REWRITE_TAC[aff_lt_def; sgn_lt] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`; REAL_NEG_ADD; GSYM REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`; REAL_ARITH `x <= &1 <=> x = &1 \/ x < &1`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_MUL; REAL_SUB_LT]);; let AFFSIGN_SUBSET_AFFINE_HULL = prove (`!sgn s t. (affsign sgn s t) SUBSET (affine hull (s UNION t))`, REWRITE_TAC[AFFINE_HULL_FINITE; AFFSIGN] THEN SET_TAC[]);; let AFF_GE_SUBSET_AFFINE_HULL = prove (`!s t. (aff_ge s t) SUBSET (affine hull (s UNION t))`, REWRITE_TAC[aff_ge_def; AFFSIGN_SUBSET_AFFINE_HULL]);; let AFF_LE_SUBSET_AFFINE_HULL = prove (`!s t. (aff_le s t) SUBSET (affine hull (s UNION t))`, REWRITE_TAC[aff_le_def; AFFSIGN_SUBSET_AFFINE_HULL]);; let AFF_GT_SUBSET_AFFINE_HULL = prove (`!s t. (aff_gt s t) SUBSET (affine hull (s UNION t))`, REWRITE_TAC[aff_gt_def; AFFSIGN_SUBSET_AFFINE_HULL]);; let AFF_LT_SUBSET_AFFINE_HULL = prove (`!s t. (aff_lt s t) SUBSET (affine hull (s UNION t))`, REWRITE_TAC[aff_lt_def; AFFSIGN_SUBSET_AFFINE_HULL]);; let AFFSIGN_EQ_AFFINE_HULL = prove (`!sgn s t. affsign sgn s {} = affine hull s`, REWRITE_TAC[AFFSIGN; AFFINE_HULL_FINITE] THEN REWRITE_TAC[UNION_EMPTY; NOT_IN_EMPTY] THEN SET_TAC[]);; let AFF_GE_EQ_AFFINE_HULL = prove (`!s t. aff_ge s {} = affine hull s`, REWRITE_TAC[aff_ge_def; AFFSIGN_EQ_AFFINE_HULL]);; let AFF_LE_EQ_AFFINE_HULL = prove (`!s t. aff_le s {} = affine hull s`, REWRITE_TAC[aff_le_def; AFFSIGN_EQ_AFFINE_HULL]);; let AFF_GT_EQ_AFFINE_HULL = prove (`!s t. aff_gt s {} = affine hull s`, REWRITE_TAC[aff_gt_def; AFFSIGN_EQ_AFFINE_HULL]);; let AFF_LT_EQ_AFFINE_HULL = prove (`!s t. aff_lt s {} = affine hull s`, REWRITE_TAC[aff_lt_def; AFFSIGN_EQ_AFFINE_HULL]);; let AFFSIGN_SUBSET_AFFSIGN = prove (`!sgn1 sgn2 s t. (!x. sgn1 x ==> sgn2 x) ==> affsign sgn1 s t SUBSET affsign sgn2 s t`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; let AFF_GT_SUBSET_AFF_GE = prove (`!s t. aff_gt s t SUBSET aff_ge s t`, REPEAT GEN_TAC THEN REWRITE_TAC[aff_gt_def; aff_ge_def] THEN MATCH_MP_TAC AFFSIGN_SUBSET_AFFSIGN THEN SIMP_TAC[sgn_gt; sgn_ge; REAL_LT_IMP_LE]);; let AFFSIGN_MONO_LEFT = prove (`!sgn s s' t:real^N->bool. s SUBSET s' ==> affsign sgn s t SUBSET affsign sgn s' t`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^N. if x IN s UNION t then u x else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `s SUBSET s' ==> {x | x IN s' UNION t /\ x IN s UNION t} = s UNION t`] THEN ASM SET_TAC[]);; let AFFSIGN_MONO_SHUFFLE = prove (`!sgn s t s' t'. s' UNION t' = s UNION t /\ t' SUBSET t ==> affsign sgn s t SUBSET affsign sgn s' t'`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let AFF_GT_MONO_LEFT = prove (`!s s' t. s SUBSET s' ==> aff_gt s t SUBSET aff_gt s' t`, REWRITE_TAC[aff_gt_def; AFFSIGN_MONO_LEFT]);; let AFF_GE_MONO_LEFT = prove (`!s s' t. s SUBSET s' ==> aff_ge s t SUBSET aff_ge s' t`, REWRITE_TAC[aff_ge_def; AFFSIGN_MONO_LEFT]);; let AFF_LT_MONO_LEFT = prove (`!s s' t. s SUBSET s' ==> aff_lt s t SUBSET aff_lt s' t`, REWRITE_TAC[aff_lt_def; AFFSIGN_MONO_LEFT]);; let AFF_LE_MONO_LEFT = prove (`!s s' t. s SUBSET s' ==> aff_le s t SUBSET aff_le s' t`, REWRITE_TAC[aff_le_def; AFFSIGN_MONO_LEFT]);; let AFFSIGN_MONO_RIGHT = prove (`!sgn s t t':real^N->bool. sgn(&0) /\ t SUBSET t' /\ DISJOINT s t' ==> affsign sgn s t SUBSET affsign sgn s t'`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^N. if x IN s UNION t then u x else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET t' ==> {x | x IN s UNION t' /\ x IN s UNION t} = s UNION t`] THEN ASM SET_TAC[]);; let AFF_GE_MONO_RIGHT = prove (`!s t t'. t SUBSET t' /\ DISJOINT s t' ==> aff_ge s t SUBSET aff_ge s t'`, SIMP_TAC[aff_ge_def; AFFSIGN_MONO_RIGHT; sgn_ge; REAL_POS]);; let AFF_LE_MONO_RIGHT = prove (`!s t t'. t SUBSET t' /\ DISJOINT s t' ==> aff_le s t SUBSET aff_le s t'`, SIMP_TAC[aff_le_def; AFFSIGN_MONO_RIGHT; sgn_le; REAL_LE_REFL]);; let AFFINE_HULL_SUBSET_AFFSIGN = prove (`!sgn s t:real^N->bool. sgn(&0) /\ DISJOINT s t ==> affine hull s SUBSET affsign sgn s t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `affsign sgn (s:real^N->bool) {}` THEN CONJ_TAC THENL [REWRITE_TAC[AFFSIGN_EQ_AFFINE_HULL; SUBSET_REFL]; MATCH_MP_TAC AFFSIGN_MONO_RIGHT THEN ASM SET_TAC[]]);; let AFFINE_HULL_SUBSET_AFF_GE = prove (`!s t. DISJOINT s t ==> affine hull s SUBSET aff_ge s t`, SIMP_TAC[aff_ge_def; sgn_ge; REAL_LE_REFL; AFFINE_HULL_SUBSET_AFFSIGN]);; let AFF_GE_AFF_GT_DECOMP = prove (`!s:real^N->bool. FINITE s /\ FINITE t /\ DISJOINT s t ==> aff_ge s t = aff_gt s t UNION UNIONS {aff_ge s (t DELETE a) | a | a IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `t' SUBSET t /\ (!a. a IN s ==> f(a) SUBSET t) /\ (!y. y IN t ==> y IN t' \/ ?a. a IN s /\ y IN f(a)) ==> t = t' UNION UNIONS {f a | a IN s}`) THEN REWRITE_TAC[AFF_GT_SUBSET_AFF_GE] THEN ASM_SIMP_TAC[DELETE_SUBSET; AFF_GE_MONO_RIGHT] THEN REWRITE_TAC[aff_ge_def; aff_gt_def; AFFSIGN; sgn_ge; sgn_gt] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `!x:real^N. x IN t ==> &0 < u x` THENL [DISJ1_TAC THEN EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[]; DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&0 < x <=> ~(x = &0))`] THEN REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[SET_RULE `a IN t /\ DISJOINT s t ==> s UNION (t DELETE a) = (s UNION t) DELETE a`] THEN ASM_SIMP_TAC[IN_DELETE; SUM_DELETE; VSUM_DELETE; REAL_SUB_RZERO; FINITE_UNION; IN_UNION] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]);; let AFFSIGN_SPECIAL_SCALE = prove (`!sgn s t a v. FINITE s /\ FINITE t /\ ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ (!x. sgn x ==> sgn(x / &2)) /\ (!x y. sgn x /\ sgn y ==> sgn(x + y)) /\ &0 < a ==> affsign sgn (vec 0 INSERT (a % v) INSERT s) t = affsign sgn (vec 0 INSERT v INSERT s) t`, REWRITE_TAC[EXTENSION] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN_ALT; IN_ELIM_THM; INSERT_UNION_EQ] THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN GEN_REWRITE_TAC BINOP_CONV [SWAP_EXISTS_THM] THEN GEN_REWRITE_TAC (BINOP_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[REAL_ARITH `x = &1 - v - v' <=> v = &1 - (x + v')`] THEN REWRITE_TAC[EXISTS_REFL] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL] `!a. &0 < a ==> (!y. ?x. a * x = y)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN DISCH_THEN(CONV_TAC o RAND_CONV o EXPAND_QUANTS_CONV) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM]);; let AFF_GE_SPECIAL_SCALE = prove (`!s t a v. FINITE s /\ FINITE t /\ ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ &0 < a ==> aff_ge (vec 0 INSERT (a % v) INSERT s) t = aff_ge (vec 0 INSERT v INSERT s) t`, REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN ASM_REWRITE_TAC[sgn_ge] THEN REAL_ARITH_TAC);; let AFF_LE_SPECIAL_SCALE = prove (`!s t a v. FINITE s /\ FINITE t /\ ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ &0 < a ==> aff_le (vec 0 INSERT (a % v) INSERT s) t = aff_le (vec 0 INSERT v INSERT s) t`, REPEAT STRIP_TAC THEN REWRITE_TAC[aff_le_def] THEN MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN ASM_REWRITE_TAC[sgn_le] THEN REAL_ARITH_TAC);; let AFF_GT_SPECIAL_SCALE = prove (`!s t a v. FINITE s /\ FINITE t /\ ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ &0 < a ==> aff_gt (vec 0 INSERT (a % v) INSERT s) t = aff_gt (vec 0 INSERT v INSERT s) t`, REPEAT STRIP_TAC THEN REWRITE_TAC[aff_gt_def] THEN MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN ASM_REWRITE_TAC[sgn_gt] THEN REAL_ARITH_TAC);; let AFF_LT_SPECIAL_SCALE = prove (`!s t a v. FINITE s /\ FINITE t /\ ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ &0 < a ==> aff_lt (vec 0 INSERT (a % v) INSERT s) t = aff_lt (vec 0 INSERT v INSERT s) t`, REPEAT STRIP_TAC THEN REWRITE_TAC[aff_lt_def] THEN MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN ASM_REWRITE_TAC[sgn_lt] THEN REAL_ARITH_TAC);; let AFF_GE_SCALE_LEMMA = prove (`!a u v:real^N. &0 < a /\ ~(v = vec 0) ==> aff_ge {vec 0} {a % u,v} = aff_ge {vec 0} {u,v}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:real^N = vec 0` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN ASM_SIMP_TAC[AFF_GE_1_2_0; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL [EXISTS_TAC `a * b:real`; EXISTS_TAC `b / a:real`] THEN EXISTS_TAC `c:real` THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_LT_IMP_LE] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN REPLICATE_TAC 2 (AP_THM_TAC THEN AP_TERM_TAC) THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD);; let AFFSIGN_0 = prove (`!sgn s t. FINITE s /\ FINITE t /\ (vec 0) IN (s DIFF t) ==> affsign sgn s t = { vsum (s UNION t) (\v. f v % v) |f| !x:real^N. x IN t ==> sgn(f x)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `x IN s DIFF t ==> s UNION t = x INSERT ((s UNION t) DELETE x)`)) THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_UNION; FINITE_DELETE] THEN REWRITE_TAC[IN_DELETE; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`y:real^N`; `f:real^N->real`] THEN STRIP_TAC THEN EXISTS_TAC `f:real^N->real` THEN ASM_REWRITE_TAC[]; X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN EXISTS_TAC `\x:real^N. if x = vec 0 then &1 - sum ((s UNION t) DELETE vec 0) (\x. f x) else f x` THEN MP_TAC(SET_RULE `!x:real^N. x IN (s UNION t) DELETE vec 0 ==> ~(x = vec 0)`) THEN SIMP_TAC[ETA_AX; REAL_SUB_ADD] THEN DISCH_THEN(K ALL_TAC) THEN ASM SET_TAC[]]);; let AFF_GE_0_AFFINE_MULTIPLE_CONVEX = prove (`!s t:real^N->bool. FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) /\ ~(t = {}) ==> aff_ge s t = {x + c % y | x IN affine hull (s DIFF t) /\ y IN convex hull t /\ &0 <= c}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[aff_ge_def; AFFSIGN_0; sgn_ge] THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t = (s DIFF t) UNION t`] THEN ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF; SET_RULE `DISJOINT (s DIFF t) t`] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN ASM_SIMP_TAC[SPAN_FINITE; FINITE_DIFF; CONVEX_HULL_FINITE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN EXISTS_TAC `vsum (s DIFF t) (\x:real^N. f x % x)` THEN ASM_CASES_TAC `sum t (f:real^N->real) = &0` THENL [MP_TAC(ISPECL [`f:real^N->real`; `t:real^N->bool`] SUM_POS_EQ_0) THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; REAL_MUL_LZERO; VSUM_0] THEN DISCH_TAC THEN EXISTS_TAC `&0` THEN REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [EXISTS_TAC `f:real^N->real` THEN REWRITE_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN EXISTS_TAC `\x:real^N. if x = a then &1 else &0` THEN ASM_REWRITE_TAC[SUM_DELTA] THEN MESON_TAC[REAL_POS]; EXISTS_TAC `sum t (f:real^N->real)` THEN EXISTS_TAC `inv(sum t (f:real^N->real)) % vsum t (\v. f v % v)` THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `f:real^N->real` THEN REWRITE_TAC[]; EXISTS_TAC `\x:real^N. f x / sum t (f:real^N->real)` THEN ASM_SIMP_TAC[REAL_LE_DIV; SUM_POS_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`] THEN ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL; VSUM_LMUL] THEN ASM_SIMP_TAC[REAL_MUL_LINV]; ASM_SIMP_TAC[SUM_POS_LE]; AP_TERM_TAC THEN ASM_CASES_TAC `sum t (f:real^N->real) = &0` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]; MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`; `y:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->real` (SUBST1_TAC o SYM)) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N->real`MP_TAC) ASSUME_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `(\x. if x IN t then c * v x else u x):real^N->real` THEN ASM_SIMP_TAC[REAL_LE_MUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_DIFF]]);; let AFF_GE_0_MULTIPLE_AFFINE_CONVEX = prove (`!s t:real^N->bool. FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) /\ ~(t = {}) ==> aff_ge s t = affine hull (s DIFF t) UNION {c % (x + y) | x IN affine hull (s DIFF t) /\ y IN convex hull t /\ &0 <= c}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX; AFFINE_HULL_EQ_SPAN; HULL_INC] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN ASM_CASES_TAC `c = &0` THENL [DISJ1_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID]; DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:real`; `inv(c) % x:real^N`; `y:real^N`] THEN ASM_SIMP_TAC[SPAN_MUL; VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]; REWRITE_TAC[aff_ge_def] THEN ONCE_REWRITE_TAC[AFFSIGN_DISJOINT_DIFF] THEN REWRITE_TAC[GSYM aff_ge_def] THEN MATCH_MP_TAC AFFINE_HULL_SUBSET_AFF_GE THEN SET_TAC[]; ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX; AFFINE_HULL_EQ_SPAN; HULL_INC] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`c % x:real^N`; `c:real`; `y:real^N`] THEN ASM_SIMP_TAC[SPAN_MUL; VECTOR_ADD_LDISTRIB]]);; let AFF_GE_0_AFFINE_CONVEX_CONE = prove (`!s t:real^N->bool. FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) ==> aff_ge s t = {x + y | x IN affine hull (s DIFF t) /\ y IN convex_cone hull t}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; CONVEX_CONE_HULL_EMPTY] THEN REWRITE_TAC[IN_SING; DIFF_EMPTY] THEN REWRITE_TAC[SET_RULE `{x + y:real^N | P x /\ y = a} = {x + a | P x}`] THEN REWRITE_TAC[VECTOR_ADD_RID] THEN SET_TAC[]; ASM_SIMP_TAC[CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; AFF_GE_0_AFFINE_MULTIPLE_CONVEX] THEN SET_TAC[]]);; let AFF_GE_0_N = prove (`!s:real^N->bool. FINITE s /\ ~(vec 0 IN s) ==> aff_ge {vec 0} s = {y | ?u. (!x. x IN s ==> &0 <= u x) /\ y = vsum s (\x. u x % x)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN ASM_SIMP_TAC[AFFSIGN_0; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; FINITE_INSERT; FINITE_EMPTY] THEN ASM_SIMP_TAC[EXTENSION; sgn_ge; IN_ELIM_THM; INSERT_UNION; UNION_EMPTY] THEN ASM_SIMP_TAC[VSUM_CLAUSES; VECTOR_MUL_RZERO; VECTOR_ADD_LID]);; let AFF_GE_0_CONVEX_HULL = prove (`!s:real^N->bool. FINITE s /\ ~(s = {}) /\ ~(vec 0 IN s) ==> aff_ge {vec 0} s = {t % y | &0 <= t /\ y IN convex hull s}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX; IN_DIFF; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {a} DIFF s = {a}`] THEN REWRITE_TAC[AFFINE_HULL_SING; IN_SING] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_LID]);; let AFF_GE_0_CONVEX_HULL_ALT = prove (`!s:real^N->bool. FINITE s /\ ~(vec 0 IN s) ==> aff_ge {vec 0} s = vec 0 INSERT {t % y | &0 < t /\ y IN convex hull s}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; CONVEX_HULL_EMPTY] THEN REWRITE_TAC[AFFINE_HULL_SING; NOT_IN_EMPTY] THEN SET_TAC[]; ASM_SIMP_TAC[AFF_GE_0_CONVEX_HULL; EXTENSION; IN_ELIM_THM; IN_INSERT] THEN X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO] THEN ASM_REWRITE_TAC[MEMBER_NOT_EMPTY; CONVEX_HULL_EQ_EMPTY]; AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LT_REFL] THEN ASM_REWRITE_TAC[REAL_LT_LE]]]);; let AFF_GE_0_CONVEX_CONE_NEGATIONS = prove (`!s t:real^N->bool. FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) ==> aff_ge s t = convex_cone hull (s UNION t UNION IMAGE (--) (s DIFF t))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_0_AFFINE_CONVEX_CONE] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN REWRITE_TAC[SPAN_CONVEX_CONE_ALLSIGNS; GSYM CONVEX_CONE_HULL_UNION] THEN AP_TERM_TAC THEN SET_TAC[]);; let CONVEX_HULL_AFF_GE = prove (`!s. convex hull s = aff_ge {} s`, SIMP_TAC[aff_ge_def; AFFSIGN; CONVEX_HULL_FINITE; sgn_ge; UNION_EMPTY] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; let POLYHEDRON_AFF_GE = prove (`!s t:real^N->bool. FINITE s /\ FINITE t ==> polyhedron(aff_ge s t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN ONCE_REWRITE_TAC[AFFSIGN_DISJOINT_DIFF] THEN REWRITE_TAC[GSYM aff_ge_def] THEN SUBGOAL_THEN `FINITE(s DIFF t) /\ FINITE(t:real^N->bool) /\ DISJOINT (s DIFF t) t` MP_TAC THENL [ASM_SIMP_TAC[FINITE_DIFF] THEN ASM SET_TAC[]; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`s DIFF t:real^N->bool`,`s:real^N->bool`) THEN MATCH_MP_TAC SET_PROVE_CASES THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CONVEX_HULL_AFF_GE] THEN MATCH_MP_TAC POLYTOPE_IMP_POLYHEDRON THEN REWRITE_TAC[polytope] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`] THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN ((vec 0 INSERT s) DIFF t)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_GE_0_CONVEX_CONE_NEGATIONS; FINITE_INSERT] THEN MATCH_MP_TAC POLYHEDRON_CONVEX_CONE_HULL THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; FINITE_DIFF; FINITE_IMAGE]);; let CLOSED_AFF_GE = prove (`!s t:real^N->bool. FINITE s /\ FINITE t ==> closed(aff_ge s t)`, SIMP_TAC[POLYHEDRON_AFF_GE; POLYHEDRON_IMP_CLOSED]);; let CONIC_AFF_GE_0 = prove (`!s:real^N->bool. FINITE s /\ ~(vec 0 IN s) ==> conic(aff_ge {vec 0} s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_0_N; conic] THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN X_GEN_TAC `c:real` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\v. c * (u:real^N->real) v` THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN ASM_MESON_TAC[REAL_LE_MUL]);; let ANGLES_ADD_AFF_GE = prove (`!u v w x:real^N. ~(v = u) /\ ~(w = u) /\ ~(x = u) /\ x IN aff_ge {u} {v,w} ==> angle(v,u,x) + angle(x,u,w) = angle(v,u,w)`, GEOM_ORIGIN_TAC `u:real^N` THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[AFF_GE_1_2_0] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `a = &0 /\ b = &0 \/ &0 < a + b` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`v:real^N`; `w:real^N`; `inv(a + b) % x:real^N`; `vec 0:real^N`] ANGLES_ADD_BETWEEN) THEN ASM_REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN ASM_SIMP_TAC[VECTOR_ANGLE_RMUL; VECTOR_ANGLE_LMUL; REAL_INV_EQ_0; REAL_LE_INV_EQ; REAL_LT_IMP_NZ; REAL_LT_IMP_LE] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[BETWEEN_IN_SEGMENT; CONVEX_HULL_2; SEGMENT_CONVEX_HULL] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`a / (a + b):real`; `b / (a + b):real`] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; VECTOR_ADD_LDISTRIB] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; real_div; REAL_MUL_AC] THEN UNDISCH_TAC `&0 < a + b` THEN CONV_TAC REAL_FIELD);; let AFF_GE_2_1_0_DROPOUT_3 = prove (`!w z:real^3. ~collinear{vec 0,basis 3,z} ==> (w IN aff_ge {vec 0,basis 3} {z} <=> (dropout 3 w) IN aff_ge {vec 0:real^2} {dropout 3 z})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `z:real^3 = vec 0` THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN ASM_CASES_TAC `z:real^3 = basis 3` THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN DISCH_TAC THEN ASM_SIMP_TAC[AFF_GE_2_1_0; SET_RULE `DISJOINT s {a} <=> ~(a IN s)`; IN_INSERT; NOT_IN_EMPTY; AFF_GE_1_1_0] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(MESON[] `(!t. ((?s. P s t) <=> Q t)) ==> ((?s t. P s t) <=> (?t. Q t))`) THEN X_GEN_TAC `t:real` THEN EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN VECTOR_ARITH_TAC; STRIP_TAC THEN EXISTS_TAC `(w:real^3)$3 - t * (z:real^3)$3` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN ASM_REWRITE_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH; BASIS_COMPONENT; DIMINDEX_3] THEN CONV_TAC REAL_RING]);; let AFF_GE_2_1_0_SEMIALGEBRAIC = prove (`!x y z:real^3. ~collinear {vec 0,x,y} /\ ~collinear {vec 0,x,z} ==> (z IN aff_ge {vec 0,x} {y} <=> (x cross y) cross x cross z = vec 0 /\ &0 <= (x cross z) dot (x cross y))`, let lemma0 = prove (`~(y = vec 0) ==> ((?s. x = s % y) <=> y cross x = vec 0)`, REWRITE_TAC[CROSS_EQ_0] THEN SIMP_TAC[COLLINEAR_LEMMA_ALT]) and lemma1 = prove (`!x y:real^N. ~(y = vec 0) ==> ((?t. &0 <= t /\ x = t % y) <=> (?t. x = t % y) /\ &0 <= x dot y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN ASM_CASES_TAC `x:real^N = t % y` THEN ASM_SIMP_TAC[DOT_LMUL; REAL_LE_MUL_EQ; DOT_POS_LT]) in REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC]) [`x:real^3 = vec 0`; `y:real^3 = vec 0`; `y:real^3 = x`] THEN STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_2_1_0; IN_ELIM_THM; SET_RULE `DISJOINT {a,b} {c} <=> ~(a = c) /\ ~(b = c)`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; VECTOR_ARITH `a:real^N = b + c <=> a - c = b`] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM CROSS_EQ_0]) THEN ASM_SIMP_TAC[lemma0; lemma1; CROSS_RMUL; CROSS_RSUB; VECTOR_SUB_EQ]);; (* ------------------------------------------------------------------------- *) (* Special case of aff_ge {x} {y}, i.e. rays or half-lines. *) (* ------------------------------------------------------------------------- *) let HALFLINE_REFL = prove (`!x. aff_ge {x} {x} = {x}`, ONCE_REWRITE_TAC[AFF_GE_DISJOINT_DIFF] THEN ASM_REWRITE_TAC[DIFF_EQ_EMPTY; GSYM CONVEX_HULL_AFF_GE; CONVEX_HULL_SING]);; let HALFLINE_EXPLICIT = prove (`!x y:real^N. aff_ge {x} {y} = {z | ?t1 t2. &0 <= t2 /\ t1 + t2 = &1 /\ z = t1 % x + t2 % y}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = y` THENL [ASM_REWRITE_TAC[HALFLINE_REFL]; AFF_TAC] THEN REWRITE_TAC[REAL_ARITH `x + y = &1 <=> x = &1 - y`] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - x) % v + x % v:real^N = v`; MESON[] `(?x y. P y /\ x = f y /\ Q x y) <=> (?y. P y /\ Q (f y) y)`] THEN REWRITE_TAC[IN_ELIM_THM; IN_SING; EXTENSION] THEN MESON_TAC[REAL_POS]);; let HALFLINE = prove (`!x y:real^N. aff_ge {x} {y} = {z | ?t. &0 <= t /\ z = (&1 - t) % x + t % y}`, REWRITE_TAC[HALFLINE_EXPLICIT; REAL_ARITH `x + y = &1 <=> x = &1 - y`] THEN SET_TAC[]);; let CLOSED_HALFLINE = prove (`!x y. closed(aff_ge {x} {y})`, SIMP_TAC[CLOSED_AFF_GE; FINITE_SING]);; let SEGMENT_SUBSET_HALFLINE = prove (`!x y. segment[x,y] SUBSET aff_ge {x} {y}`, REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_2; HALFLINE_EXPLICIT] THEN SET_TAC[]);; let ENDS_IN_HALFLINE = prove (`(!x y. x IN aff_ge {x} {y}) /\ (!x y. y IN aff_ge {x} {y})`, MESON_TAC[SEGMENT_SUBSET_HALFLINE; SUBSET; ENDS_IN_SEGMENT]);; let HALFLINE_SUBSET_AFFINE_HULL = prove (`!x y. aff_ge {x} {y} SUBSET affine hull {x,y}`, REWRITE_TAC[AFF_GE_SUBSET_AFFINE_HULL; SET_RULE `{x,y} = {x} UNION {y}`]);; let HALFLINE_INTER_COMPACT_SEGMENT = prove (`!s a b:real^N. compact s /\ convex s /\ a IN s ==> ?c. aff_ge {a} {b} INTER s = segment[a,c]`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[SEGMENT_REFL; HALFLINE_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?u v:real^N. aff_ge {a} {b} INTER s = segment[u,v]` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC COMPACT_CONVEX_COLLINEAR_SEGMENT THEN ASM_SIMP_TAC[CLOSED_INTER_COMPACT; CLOSED_AFF_GE; FINITE_SING] THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_AFF_GE] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN ASM_MESON_TAC[ENDS_IN_HALFLINE]; MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `affine hull {a:real^N,b}` THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; COLLINEAR_2] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> (s INTER t) SUBSET u`) THEN REWRITE_TAC[HALFLINE_SUBSET_AFFINE_HULL]]; ASM_CASES_TAC `u:real^N = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `v:real^N = a` THENL [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN SUBGOAL_THEN `u IN aff_ge {a:real^N} {b} /\ v IN aff_ge {a} {b}` MP_TAC THENL [ASM_MESON_TAC[IN_INTER; ENDS_IN_SEGMENT]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [HALFLINE; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s:real` MP_TAC) (X_CHOOSE_THEN `t:real` MP_TAC)) THEN MAP_EVERY ASM_CASES_TAC [`s = &0`; `t = &0`] THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LID; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(a:real^N) IN segment[u,v]` MP_TAC THENL [ASM_MESON_TAC[IN_INTER; ENDS_IN_HALFLINE]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[VECTOR_ARITH `a = (&1 - u) % ((&1 - s) % a + s % b) + u % ((&1 - t) % a + t % b) <=> ((&1 - u) * s + u * t) % (b - a):real^N = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Definition and properties of conv0. *) (* ------------------------------------------------------------------------- *) let conv0 = new_definition `conv0 S:real^A->bool = affsign sgn_gt {} S`;; let CONV0_INJECTIVE_LINEAR_IMAGE = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> conv0(IMAGE f s) = IMAGE f (conv0 s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP AFFSIGN_INJECTIVE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[conv0; IMAGE_CLAUSES]);; add_linear_invariants [CONV0_INJECTIVE_LINEAR_IMAGE];; let CONV0_TRANSLATION = prove (`!a s. conv0(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (conv0 s)`, REWRITE_TAC[conv0; GSYM AFFSIGN_TRANSLATION; IMAGE_CLAUSES]);; add_translation_invariants [CONV0_TRANSLATION];; let CONV0_SUBSET_CONVEX_HULL = prove (`!s. conv0 s SUBSET convex hull s`, REWRITE_TAC[conv0; AFFSIGN; sgn_gt; CONVEX_HULL_FINITE; UNION_EMPTY] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_IMP_LE]);; let CONV0_AFF_GT = prove (`!s. conv0 s = aff_gt {} s`, REWRITE_TAC[conv0; aff_gt_def]);; let CONVEX_HULL_CONV0_DECOMP = prove (`!s:real^N->bool. FINITE s ==> convex hull s = conv0 s UNION UNIONS {convex hull (s DELETE a) | a | a IN s}`, REWRITE_TAC[CONV0_AFF_GT; CONVEX_HULL_AFF_GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC AFF_GE_AFF_GT_DECOMP THEN ASM_REWRITE_TAC[FINITE_EMPTY] THEN SET_TAC[]);; let CONVEX_CONV0 = prove (`!s. convex(conv0 s)`, REWRITE_TAC[CONV0_AFF_GT; CONVEX_AFF_GT]);; let BOUNDED_CONV0 = prove (`!s:real^N->bool. bounded s ==> bounded(conv0 s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `convex hull s:real^N->bool` THEN ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; CONV0_SUBSET_CONVEX_HULL]);; let MEASURABLE_CONV0 = prove (`!s. bounded s ==> measurable(conv0 s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN ASM_SIMP_TAC[CONVEX_CONV0; BOUNDED_CONV0]);; let NEGLIGIBLE_CONVEX_HULL_DIFF_CONV0 = prove (`!s:real^N->bool. FINITE s /\ CARD s <= dimindex(:N) + 1 ==> negligible(convex hull s DIFF conv0 s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_CONV0_DECOMP] THEN REWRITE_TAC[SET_RULE `(s UNION t) DIFF s = t DIFF s`] THEN MATCH_MP_TAC NEGLIGIBLE_DIFF THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM_ARITH_TAC);; let MEASURE_CONV0_CONVEX_HULL = prove (`!s:real^N->bool. FINITE s /\ CARD s <= dimindex(:N) + 1 ==> measure(conv0 s) = measure(convex hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_SIMP_TAC[MEASURABLE_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN MATCH_MP_TAC NEGLIGIBLE_UNION THEN ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_HULL_DIFF_CONV0] THEN ASM_SIMP_TAC[CONV0_SUBSET_CONVEX_HULL; NEGLIGIBLE_EMPTY; SET_RULE `s SUBSET t ==> s DIFF t = {}`]);; (* ------------------------------------------------------------------------- *) (* Orthonormal triples of vectors in 3D. *) (* ------------------------------------------------------------------------- *) let orthonormal = new_definition `orthonormal e1 e2 e3 <=> e1 dot e1 = &1 /\ e2 dot e2 = &1 /\ e3 dot e3 = &1 /\ e1 dot e2 = &0 /\ e1 dot e3 = &0 /\ e2 dot e3 = &0 /\ &0 < (e1 cross e2) dot e3`;; let ORTHONORMAL_LINEAR_IMAGE = prove (`!f. linear(f) /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:3) ==> det(matrix f) = &1) ==> !e1 e2 e3. orthonormal (f e1) (f e2) (f e3) <=> orthonormal e1 e2 e3`, SIMP_TAC[DIMINDEX_3; ARITH; CONJ_ASSOC; GSYM ORTHOGONAL_TRANSFORMATION] THEN SIMP_TAC[orthonormal; CROSS_ORTHOGONAL_TRANSFORMATION] THEN SIMP_TAC[orthogonal_transformation; VECTOR_MUL_LID]);; add_linear_invariants [ORTHONORMAL_LINEAR_IMAGE];; let ORTHONORMAL_PERMUTE = prove (`!e1 e2 e3. orthonormal e1 e2 e3 ==> orthonormal e2 e3 e1`, REWRITE_TAC[orthonormal] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CROSS_TRIPLE] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[]);; let ORTHONORMAL_CROSS = prove (`!e1 e2 e3. orthonormal e1 e2 e3 ==> e2 cross e3 = e1 /\ e3 cross e1 = e2 /\ e1 cross e2 = e3`, SUBGOAL_THEN `!e1 e2 e3. orthonormal e1 e2 e3 ==> e3 cross e1 = e2` (fun th -> MESON_TAC[th; ORTHONORMAL_PERMUTE]) THEN GEOM_BASIS_MULTIPLE_TAC 1 `e1:real^3` THEN X_GEN_TAC `k:real` THEN REWRITE_TAC[orthonormal; DOT_LMUL; DOT_RMUL] THEN SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH; REAL_MUL_RID] THEN REWRITE_TAC[REAL_RING `k * k = &1 <=> k = &1 \/ k = -- &1`] THEN ASM_CASES_TAC `k = -- &1` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID; REAL_MUL_LID; REAL_MUL_RID] THEN SIMP_TAC[cross; DOT_3; VECTOR_3; CART_EQ; FORALL_3; DIMINDEX_3; BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_POS] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_ADD_RID; REAL_MUL_LID] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `(e2:real^3)$1 = &0` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(e3:real^3)$1 = &0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_ADD_LID] THEN REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RID] THEN MATCH_MP_TAC(REAL_ARITH `(u = &1 /\ v = &1 /\ w = &0 ==> a = b /\ --c = d \/ a = --b /\ c = d) /\ (a = --b /\ c = d ==> x <= &0) ==> (u = &1 /\ v = &1 /\ w = &0 /\ &0 < x ==> a:real = b /\ --c:real = d)`) THEN CONJ_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x * x /\ &0 <= y * y ==> --x * x + y * -- y <= &0`) THEN REWRITE_TAC[REAL_LE_SQUARE]);; let ORTHONORMAL_IMP_NONZERO = prove (`!e1 e2 e3. orthonormal e1 e2 e3 ==> ~(e1 = vec 0) /\ ~(e2 = vec 0) /\ ~(e3 = vec 0)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);; let ORTHONORMAL_IMP_DISTINCT = prove (`!e1 e2 e3. orthonormal e1 e2 e3 ==> ~(e1 = e2) /\ ~(e1 = e3) /\ ~(e2 = e3)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);; let ORTHONORMAL_IMP_INDEPENDENT = prove (`!e1 e2 e3. orthonormal e1 e2 e3 ==> independent {e1,e2,e3}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[ORTHONORMAL_IMP_NONZERO]] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN REWRITE_TAC[pairwise; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[orthogonal] THEN ASM_MESON_TAC[DOT_SYM]);; let ORTHONORMAL_IMP_SPANNING = prove (`!e1 e2 e3. orthonormal e1 e2 e3 ==> span {e1,e2,e3} = (:real^3)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^3)`; `{e1:real^3,e2,e3}`] CARD_EQ_DIM) THEN ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT; SUBSET_UNIV] THEN REWRITE_TAC[DIM_UNIV; DIMINDEX_3; HAS_SIZE; FINITE_INSERT; FINITE_EMPTY] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHONORMAL_IMP_DISTINCT) THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; ARITH] THEN SET_TAC[]);; let ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0 = prove (`!e1 e2 e3 t1 t2 t3. orthonormal e1 e2 e3 ==> (t1 % e1 + t2 % e2 + t3 % e3 = vec 0 <=> t1 = &0 /\ t2 = &0 /\ t3 = &0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_3 THEN ASM_MESON_TAC[ORTHONORMAL_IMP_INDEPENDENT; ORTHONORMAL_IMP_DISTINCT]);; let ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT = prove (`!e1 e2 e3 s1 s2 s3 t1 t2 t3. orthonormal e1 e2 e3 ==> (s1 % e1 + s2 % e2 + s3 % e3 = t1 % e1 + t2 % e2 + t3 % e3 <=> s1 = t1 /\ s2 = t2 /\ s3 = t3)`, SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0; REAL_SUB_0; VECTOR_ARITH `a % x + b % y + c % z:real^3 = a' % x + b' % y + c' % z <=> (a - a') % x + (b - b') % y + (c - c') % z = vec 0`]);; (* ------------------------------------------------------------------------- *) (* Flyspeck arcV is the same as angle even in degenerate cases. *) (* ------------------------------------------------------------------------- *) let arcV = new_definition `arcV u v w = acs (( (v - u) dot (w - u))/((norm (v-u)) * (norm (w-u))))`;; let ARCV_ANGLE = prove (`!u v w:real^N. arcV u v w = angle(v,u,w)`, REPEAT GEN_TAC THEN REWRITE_TAC[arcV; angle; vector_angle] THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_CASES_TAC `v:real^N = u` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; DOT_LZERO] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; ACS_0] THEN ASM_CASES_TAC `w:real^N = u` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; DOT_RZERO] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; ACS_0]);; let ARCV_LINEAR_IMAGE_EQ = prove (`!f a b c. linear f /\ (!x. norm(f x) = norm x) ==> arcV (f a) (f b) (f c) = arcV a b c`, REWRITE_TAC[ARCV_ANGLE; ANGLE_LINEAR_IMAGE_EQ]);; add_linear_invariants [ARCV_LINEAR_IMAGE_EQ];; let ARCV_TRANSLATION_EQ = prove (`!a b c d. arcV (a + b) (a + c) (a + d) = arcV b c d`, REWRITE_TAC[ARCV_ANGLE; ANGLE_TRANSLATION_EQ]);; add_translation_invariants [ARCV_TRANSLATION_EQ];; (* ------------------------------------------------------------------------- *) (* Azimuth angle. *) (* ------------------------------------------------------------------------- *) let AZIM_EXISTS = prove (`!v w w1 w2. ?theta. &0 <= theta /\ theta < &2 * pi /\ ?h1 h2. !e1 e2 e3. orthonormal e1 e2 e3 /\ dist(w,v) % e3 = w - v /\ ~(w = v) ==> ?psi r1 r2. w1 - v = (r1 * cos psi) % e1 + (r1 * sin psi) % e2 + h1 % (w - v) /\ w2 - v = (r2 * cos (psi + theta)) % e1 + (r2 * sin (psi + theta)) % e2 + h2 % (w - v) /\ (~collinear {v, w, w1} ==> &0 < r1) /\ (~collinear {v, w, w2} ==> &0 < r2)`, let lemma = prove (`cos(p) % e + sin(p) % rotate2d (pi / &2) e = rotate2d p e`, SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; FORALL_2; rotate2d; LAMBDA_BETA; DIMINDEX_2; ARITH; VECTOR_2] THEN REWRITE_TAC[SIN_PI2; COS_PI2] THEN REAL_ARITH_TAC) in GEN_GEOM_ORIGIN_TAC `v:real^3` ["e1"; "e2"; "e3"] THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN EXISTS_TAC `(w dot (w1:real^3)) / (w dot w)` THEN GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN EXISTS_TAC `(w dot (w2:real^3)) / (w dot w)` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= w <=> w = &0 \/ &0 < w`] THEN STRIP_TAC THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; NORM_0] THEN EXISTS_TAC `&0` THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[DOT_LMUL; NORM_MUL; DIMINDEX_3; ARITH; DOT_RMUL; DOT_BASIS; VECTOR_MUL_COMPONENT; NORM_BASIS; BASIS_COMPONENT] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < w ==> (w * x) / (w * w) * w = x`; REAL_ARITH `&0 < w ==> abs w = w`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a % x:real^3 = a % y <=> a % (x - y) = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_3; ARITH; VECTOR_SUB_EQ] THEN REWRITE_TAC[MESON[] `(!e3. p e3 /\ e3 = a ==> q e3) <=> p a ==> q a`] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^3 = a + b + c <=> x - c = a + b`] THEN REPEAT GEN_TAC THEN ABBREV_TAC `v1:real^3 = w1 - (w1$3) % basis 3` THEN ABBREV_TAC `v2:real^3 = w2 - (w2$3) % basis 3` THEN SUBGOAL_THEN `(collinear{vec 0, w % basis 3, w1} <=> w1 - w1$3 % basis 3:real^3 = vec 0) /\ (collinear{vec 0, w % basis 3, w2} <=> w2 - w2$3 % basis 3:real^3 = vec 0)` (fun th -> REWRITE_TAC[th]) THENL [ASM_SIMP_TAC[COLLINEAR_LEMMA; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN MAP_EVERY EXPAND_TAC ["v1"; "v2"] THEN SIMP_TAC[CART_EQ; VEC_COMPONENT; VECTOR_ADD_COMPONENT; FORALL_3; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3; ARITH; VECTOR_SUB_COMPONENT; REAL_MUL_RZERO; REAL_MUL_RID; REAL_SUB_RZERO] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONV_TAC(BINOP_CONV(BINOP_CONV(ONCE_DEPTH_CONV SYM_CONV))) THEN ASM_SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; EXISTS_REFL] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(v1:real^3)$3 = &0 /\ (v2:real^3)$3 = &0` MP_TAC THENL [MAP_EVERY EXPAND_TAC ["v1"; "v2"] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_EQ] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v2:real^3`; `v1:real^3`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[orthonormal] THEN SIMP_TAC[DOT_BASIS; BASIS_COMPONENT; DIMINDEX_3; ARITH] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e /\ f <=> d /\ e /\ a /\ b /\ c /\ f`] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN PAD2D3D_TAC THEN REPEAT STRIP_TAC THEN SIMP_TAC[cross; VECTOR_3; pad2d3d; LAMBDA_BETA; DIMINDEX_3; ARITH] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN ASM_CASES_TAC `v1:real^2 = vec 0` THEN ASM_REWRITE_TAC[NORM_POS_LT] THENL [MP_TAC(ISPECL [`basis 1:real^2`; `v2:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`e1:real^2`; `basis 1:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`&0`; `norm(v2:real^2)`] THEN ASM_REWRITE_TAC[NORM_POS_LT] THEN REWRITE_TAC[REAL_MUL_LZERO; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN SUBGOAL_THEN `norm(e1:real^2) = &1 /\ norm(e2:real^2) = &1` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[NORM_EQ_1]; ALL_TAC] THEN SUBGOAL_THEN `e2 = rotate2d (pi / &2) e1` SUBST1_TAC THENL [MATCH_MP_TAC ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED THEN ASM_REWRITE_TAC[NORM_EQ_1; orthogonal]; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB] THEN REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[ROTATE2D_ADD] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(basis 1:real^2)` THEN ASM_SIMP_TAC[NORM_EQ_0; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x:real^2 = b % a % x`] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM(MATCH_MP LINEAR_CMUL (SPEC_ALL LINEAR_ROTATE2D))] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D; VECTOR_MUL_LID]; MP_TAC(ISPECL [`v1:real^2`; `v2:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`e1:real^2`; `v1:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`norm(v1:real^2)`; `norm(v2:real^2)`] THEN ASM_REWRITE_TAC[NORM_POS_LT] THEN SUBGOAL_THEN `norm(e1:real^2) = &1 /\ norm(e2:real^2) = &1` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[NORM_EQ_1]; ALL_TAC] THEN SUBGOAL_THEN `e2 = rotate2d (pi / &2) e1` SUBST1_TAC THENL [MATCH_MP_TAC ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED THEN ASM_REWRITE_TAC[NORM_EQ_1; orthogonal]; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB] THEN REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[ROTATE2D_ADD] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(v1:real^2)` THEN ASM_REWRITE_TAC[NORM_EQ_0] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x:real^2 = b % a % x`] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM(MATCH_MP LINEAR_CMUL (SPEC_ALL LINEAR_ROTATE2D))] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D; VECTOR_MUL_LID]]);; let azim_spec = (REWRITE_RULE[SKOLEM_THM] (REWRITE_RULE[RIGHT_EXISTS_IMP_THM] AZIM_EXISTS));; let azim_def = new_definition `azim v w w1 w2 = if collinear {v,w,w1} \/ collinear {v,w,w2} then &0 else @theta. &0 <= theta /\ theta < &2 * pi /\ ?h1 h2. !e1 e2 e3. orthonormal e1 e2 e3 /\ dist(w,v) % e3 = w - v /\ ~(w = v) ==> ?psi r1 r2. w1 - v = (r1 * cos psi) % e1 + (r1 * sin psi) % e2 + h1 % (w - v) /\ w2 - v = (r2 * cos (psi + theta)) % e1 + (r2 * sin (psi + theta)) % e2 + h2 % (w - v) /\ &0 < r1 /\ &0 < r2`;; let azim = prove (`!v w w1 w2:real^3. &0 <= azim v w w1 w2 /\ azim v w w1 w2 < &2 * pi /\ ?h1 h2. !e1 e2 e3. orthonormal e1 e2 e3 /\ dist(w,v) % e3 = w - v /\ ~(w = v) ==> ?psi r1 r2. w1 - v = (r1 * cos psi) % e1 + (r1 * sin psi) % e2 + h1 % (w - v) /\ w2 - v = (r2 * cos (psi + azim v w w1 w2)) % e1 + (r2 * sin (psi + azim v w w1 w2)) % e2 + h2 % (w - v) /\ (~collinear {v, w, w1} ==> &0 < r1) /\ (~collinear {v, w, w2} ==> &0 < r2)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[azim_def] THEN COND_CASES_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV THEN MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] AZIM_EXISTS) THEN ASM_REWRITE_TAC[]] THEN SIMP_TAC[PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; REAL_LE_REFL] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w2:real^3`; `w1:real^3`] AZIM_EXISTS) THEN DISCH_THEN(CHOOSE_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h2:real`; `h1:real`] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`h1:real`; `h2:real`] THEN MAP_EVERY X_GEN_TAC [`e1:real^3`; `e2:real^3`; `e3:real^3`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `psi:real` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_RID] THEN MAP_EVERY X_GEN_TAC [`r2:real`; `r1:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`&0`; `r2:real`]; MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] AZIM_EXISTS) THEN DISCH_THEN(CHOOSE_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`h1:real`; `h2:real`] THEN MAP_EVERY X_GEN_TAC [`e1:real^3`; `e2:real^3`; `e3:real^3`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `psi:real` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_RID] THEN MAP_EVERY X_GEN_TAC [`r1:real`; `r2:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`r1:real`; `&0`]] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SET_RULE `{v,w,x} = {w,v,x}`]) THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN ASM_REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `(r * c) * (r * c):real = r pow 2 * c pow 2`] THEN REWRITE_TAC[REAL_ARITH `r * c + r * s + f:real = r * (s + c) + f`] THEN REWRITE_TAC[SIN_CIRCLE] THEN REWRITE_TAC[REAL_RING `(d * h * d) pow 2 = (d * d) * (r * &1 + h * d * h * d) <=> d = &0 \/ r = &0`] THEN ASM_REWRITE_TAC[DIST_EQ_0; REAL_POW_EQ_0; ARITH] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO]);; let AZIM_UNIQUE = prove (`!v w w1 w2 h1 h2 r1 r2 e1 e2 e3 psi theta. &0 <= theta /\ theta < &2 * pi /\ orthonormal e1 e2 e3 /\ dist(w,v) % e3 = w - v /\ ~(w = v) /\ &0 < r1 /\ &0 < r2 /\ w1 - v = (r1 * cos psi) % e1 + (r1 * sin psi) % e2 + h1 % (w - v) /\ w2 - v = (r2 * cos (psi + theta)) % e1 + (r2 * sin (psi + theta)) % e2 + h2 % (w - v) ==> azim v w w1 w2 = theta`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~collinear{v:real^3,w,w2} /\ ~collinear {v,w,w1}` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH `a + b + c % x:real^N = d % x <=> a + b + (c - d) % x = vec 0`] THEN ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0] THEN ASM_SIMP_TAC[CONJ_ASSOC; REAL_LT_IMP_NZ; SIN_CIRCLE; REAL_RING `s pow 2 + c pow 2 = &1 ==> (r * c = &0 /\ r * s = &0 <=> r = &0)`]; ALL_TAC] THEN SUBGOAL_THEN `(azim v w w1 w2 - theta) / (&2 * pi) = &0` MP_TAC THENL [ALL_TAC; MP_TAC PI_POS THEN CONV_TAC REAL_FIELD] THEN MATCH_MP_TAC REAL_EQ_INTEGERS_IMP THEN ASM_SIMP_TAC[REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI; REAL_LT_LDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; PI_POS; INTEGER_CLOSED; REAL_MUL_LID] THEN MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] azim) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ x < k /\ &0 <= y /\ y < k ==> abs(x - y) < k`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:real`; `k2:real`] THEN DISCH_THEN(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`phi:real`; `s1:real`; `s2:real`] THEN UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (c /\ d) /\ a /\ b`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (REAL_FIELD `r * c = r' * c' /\ r * s = r' * s' /\ u:real = v ==> s pow 2 + c pow 2 = &1 /\ s' pow 2 + c' pow 2 = &1 /\ &0 < r /\ (r pow 2 = r' pow 2 ==> r = r') ==> s = s' /\ c = c'`))) THEN ASM_REWRITE_TAC[SIN_CIRCLE; GSYM REAL_EQ_SQUARE_ABS] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ &0 < y ==> (abs x = abs y <=> x = y)`] THEN REWRITE_TAC[SIN_COS_EQ] THEN REWRITE_TAC[REAL_ARITH `psi + theta = (phi + az) + x:real <=> psi = phi + x + (az - theta)`] THEN DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[REAL_ARITH `&2 * m * pi + x = &2 * n * pi <=> x = (n - m) * &2 * pi`] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> (x * &2 * pi) / (&2 * pi) = x`; INTEGER_CLOSED]);; let AZIM_TRANSLATION = prove (`!a v w w1 w2. azim (a + v) (a + w) (a + w1) (a + w2) = azim v w w1 w2`, REPEAT GEN_TAC THEN REWRITE_TAC[azim_def] THEN REWRITE_TAC[VECTOR_ARITH `(a + w) - (a + v):real^3 = w - v`; VECTOR_ARITH `a + w:real^3 = a + v <=> w = v`; NORM_ARITH `dist(a + v,a + w) = dist(v,w)`] THEN REWRITE_TAC[SET_RULE `{a + x,a + y,a + z} = IMAGE (\x:real^3. a + x) {x,y,z}`] THEN REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);; add_translation_invariants [AZIM_TRANSLATION];; let AZIM_LINEAR_IMAGE = prove (`!f. linear f /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:3) ==> det(matrix f) = &1) ==> !v w w1 w2. azim (f v) (f w) (f w1) (f w2) = azim v w w1 w2`, REPEAT STRIP_TAC THEN REWRITE_TAC[azim_def] THEN ASM_SIMP_TAC[GSYM LINEAR_SUB; dist] THEN MP_TAC(ISPEC `f:real^3->real^3` QUANTIFY_SURJECTION_THM) THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION; ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; ALL_TAC] THEN DISCH_THEN(CONV_TAC o LAND_CONV o EXPAND_QUANTS_CONV) THEN ASM_SIMP_TAC[ORTHONORMAL_LINEAR_IMAGE] THEN ASM_SIMP_TAC[GSYM LINEAR_CMUL; GSYM LINEAR_ADD] THEN SUBGOAL_THEN `!x y. (f:real^3->real^3) x = f y <=> x = y` ASSUME_TAC THENL [ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `{f x,f y,f z} = IMAGE f {x,y,z}`] THEN ASM_SIMP_TAC[COLLINEAR_LINEAR_IMAGE_EQ]);; add_linear_invariants [AZIM_LINEAR_IMAGE];; let AZIM_DEGENERATE = prove (`(!v w w1 w2. v = w ==> azim v w w1 w2 = &0) /\ (!v w w1 w2. collinear{v,w,w1} ==> azim v w w1 w2 = &0) /\ (!v w w1 w2. collinear{v,w,w2} ==> azim v w w1 w2 = &0)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[azim_def] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2]);; let AZIM_REFL_ALT = prove (`!v x y. azim v v x y = &0`, REPEAT GEN_TAC THEN MATCH_MP_TAC(last(CONJUNCTS AZIM_DEGENERATE)) THEN REWRITE_TAC[COLLINEAR_2; INSERT_AC]);; let AZIM_SPECIAL_SCALE = prove (`!a v w1 w2. &0 < a ==> azim (vec 0) (a % v) w1 w2 = azim (vec 0) v w1 w2`, REPEAT STRIP_TAC THEN REWRITE_TAC[azim_def] THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL] `!a. &0 < a ==> (!y. ?x. a * x = y)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN DISCH_THEN(CONV_TAC o RAND_CONV o PARTIAL_EXPAND_QUANTS_CONV ["psi"; "r1"; "r2"]) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < a ==> abs a = a`] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN REWRITE_TAC[VECTOR_ARITH `a % x:real^3 = a % y <=> a % (x - y) = vec 0`] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; VECTOR_MUL_EQ_0] THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ]);; let AZIM_SCALE_ALL = prove (`!a v w1 w2. &0 < a /\ &0 < b /\ &0 < c ==> azim (vec 0) (a % v) (b % w1) (c % w2) = azim (vec 0) v w1 w2`, let lemma = MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL] `!a. &0 < a ==> (!y. ?x. a * x = y)` in let SCALE_QUANT_TAC side asm avoid = MP_TAC(MATCH_MP lemma (ASSUME asm)) THEN DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN DISCH_THEN(CONV_TAC o side o PARTIAL_EXPAND_QUANTS_CONV avoid) in REPEAT STRIP_TAC THEN ASM_SIMP_TAC[azim_def; COLLINEAR_SCALE_ALL; REAL_LT_IMP_NZ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN ASM_SIMP_TAC[DIST_0; NORM_MUL; GSYM VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; VECTOR_MUL_LCANCEL] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN SCALE_QUANT_TAC RAND_CONV `&0 < a` ["psi"; "r1"; "r2"] THEN SCALE_QUANT_TAC LAND_CONV `&0 < b` ["psi"; "h2"; "r2"] THEN SCALE_QUANT_TAC LAND_CONV `&0 < c` ["psi"; "h1"; "r1"] THEN ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; REAL_LT_MUL_EQ] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_AC]);; let AZIM_ARG = prove (`!x y:real^3. azim (vec 0) (basis 3) x y = Arg(dropout 3 y / dropout 3 x)`, let lemma = prove (`(r * cos t) % basis 1 + (r * sin t) % basis 2 = Cx r * cexp(ii * Cx t)`, REWRITE_TAC[CEXP_EULER; COMPLEX_BASIS; GSYM CX_SIN; GSYM CX_COS; COMPLEX_CMUL; CX_MUL] THEN CONV_TAC COMPLEX_RING) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `collinear {vec 0:real^3,basis 3,x}` THENL [ASM_SIMP_TAC[AZIM_DEGENERATE] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_INV_0; COMPLEX_MUL_RZERO; ARG_0]; ALL_TAC] THEN ASM_CASES_TAC `collinear {vec 0:real^3,basis 3,y}` THENL [ASM_SIMP_TAC[AZIM_DEGENERATE] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_MUL_LZERO; ARG_0]; ALL_TAC] THEN MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `x:real^3`; `y:real^3`] azim) THEN ABBREV_TAC `a = azim (vec 0) (basis 3) x (y:real^3)` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_SUB_RZERO; DIST_0] THEN MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN DISCH_THEN(MP_TAC o SPECL [`basis 1:real^3`; `basis 2:real^3`; `basis 3:real^3`]) THEN SIMP_TAC[orthonormal; DOT_BASIS_BASIS; CROSS_BASIS; DIMINDEX_3; NORM_BASIS; ARITH; VECTOR_MUL_LID; BASIS_NONZERO; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`psi:real`; `r1:real`; `r2:real`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; lemma] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL] THEN ONCE_REWRITE_TAC[COMPLEX_RING `(a * b) * (c * d):complex = (a * c) * b * d`] THEN REWRITE_TAC[GSYM complex_div; GSYM CX_DIV; GSYM CEXP_SUB] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `r2 / r1:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CX_ADD] THEN CONV_TAC COMPLEX_RING);; let REAL_CONTINUOUS_AT_AZIM_SHARP = prove (`!v w w1 w2. ~collinear{v,w,w1} /\ ~(w2 IN aff_ge {v,w} {w1}) ==> (azim v w w1) real_continuous at w2`, GEOM_ORIGIN_TAC `v:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LT; COLLINEAR_SPECIAL_SCALE] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_SPECIAL_SCALE o rand o rand o lhand o snd) THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_SING] THEN ANTS_TAC THENL [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ASM_SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN MESON_TAC[]]; DISCH_THEN SUBST1_TAC THEN DISCH_TAC] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE) THEN CONJ_TAC THENL [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST; ETA_AX] THEN SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_DROPOUT; DIMINDEX_3; DIMINDEX_2; ARITH]; ALL_TAC] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_ARG THEN MP_TAC(ISPECL [`w2:real^3`; `w1:real^3`] AFF_GE_2_1_0_DROPOUT_3) THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3])) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:real^2`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:real^2`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[CONTRAPOS_THM; COMPLEX_BASIS; COMPLEX_CMUL] THEN REWRITE_TAC[COMPLEX_MUL_RID; RE_DIV_CX; IM_DIV_CX; real] THEN ASM_SIMP_TAC[REAL_DIV_EQ_0; REAL_LE_RDIV_EQ; REAL_MUL_LZERO] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_1_1_0 o rand o snd) THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; CX_INJ] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `Re z / w` THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; COMPLEX_EQ] THEN ASM_SIMP_TAC[COMPLEX_CMUL; CX_DIV; COMPLEX_DIV_RMUL; CX_INJ] THEN REWRITE_TAC[RE_CX; IM_CX]);; let REAL_CONTINUOUS_AT_AZIM = prove (`!v w w1 w2. ~coplanar{v,w,w1,w2} ==> (azim v w w1) real_continuous at w2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_AZIM_SHARP THEN CONJ_TAC THENL [ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR; INSERT_AC]; DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] AFF_GE_SUBSET_AFFINE_HULL)) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[coplanar; CONTRAPOS_THM] THEN REWRITE_TAC[SET_RULE `{a,b} UNION {c} = {a,b,c}`] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`v:real^3`; `w:real^3`; `w1:real^3`] THEN SIMP_TAC[SET_RULE `{a,b,c,d} SUBSET s <=> {a,b,c} SUBSET s /\ d IN s`] THEN ASM_REWRITE_TAC[HULL_SUBSET]]);; let AZIM_REFL = prove (`!v0 v1 w. azim v0 v1 w w = &0`, GEOM_ORIGIN_TAC `v0:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; AZIM_DEGENERATE] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG; ARG_EQ_0] THEN X_GEN_TAC `w:real^3` THEN ASM_CASES_TAC `(dropout 3 :real^3->real^2) w = Cx(&0)` THEN ASM_SIMP_TAC[COMPLEX_DIV_REFL; REAL_CX; RE_CX; REAL_POS] THEN ASM_SIMP_TAC[complex_div; COMPLEX_MUL_LZERO; REAL_CX; RE_CX; REAL_POS]);; let AZIM_EQ = prove (`!v0 v1 w x y. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} /\ ~collinear{v0,v1,y} ==> (azim v0 v1 w x = azim v0 v1 w y <=> y IN aff_gt {v0,v1} {x})`, GEOM_ORIGIN_TAC `v0:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; REAL_LT_IMP_NZ; COLLINEAR_SPECIAL_SCALE] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o rand o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN REPEAT CONJ_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN TRY(RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN FIRST_X_ASSUM CONTR_TAC) THEN UNDISCH_TAC `~collinear {vec 0:real^3, basis 3, v1 % basis 3}` THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[AZIM_ARG] THEN CONV_TAC(LAND_CONV SYM_CONV) THEN W(MP_TAC o PART_MATCH (lhs o rand) ARG_EQ o lhand o snd) THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN ASM_REWRITE_TAC[complex_div; COMPLEX_ENTIRE; COMPLEX_INV_EQ_0] THEN ASM_REWRITE_TAC[GSYM complex_div; GSYM COMPLEX_VEC_0] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[GSYM COMPLEX_VEC_0; COMPLEX_FIELD `~(w = Cx(&0)) ==> (y / w = x * u / w <=> y = x * u)`] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN ASM_MESON_TAC[DROPOUT_BASIS_3; DROPOUT_0]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. p c /\ q a b c /\ r b c) <=> (?c. p c /\ ?b. r b c /\ ?a. q a b c)`] THEN SIMP_TAC[REAL_ARITH `a + b + c = &1 <=> a = &1 - b - c`; EXISTS_REFL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_CMUL] THEN SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; VECTOR_ADD_COMPONENT; REAL_ADD_LID; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[REAL_ARITH `y:real = t + z <=> t = y - z`; EXISTS_REFL]);; let AZIM_EQ_ALT = prove (`!v0 v1 w x y. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} /\ ~collinear{v0,v1,y} ==> (azim v0 v1 w x = azim v0 v1 w y <=> x IN aff_gt {v0,v1} {y})`, ASM_SIMP_TAC[GSYM AZIM_EQ] THEN MESON_TAC[]);; let AZIM_EQ_0 = prove (`!v0 v1 w x. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} ==> (azim v0 v1 w x = &0 <=> w IN aff_gt {v0,v1} {x})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `azim v0 v1 w x = azim v0 v1 w w` THEN CONJ_TAC THENL [REWRITE_TAC[AZIM_REFL]; ASM_SIMP_TAC[AZIM_EQ]]);; let AZIM_EQ_0_ALT = prove (`!v0 v1 w x. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} ==> (azim v0 v1 w x = &0 <=> x IN aff_gt {v0,v1} {w})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `azim v0 v1 w x = azim v0 v1 w w` THEN CONJ_TAC THENL [REWRITE_TAC[AZIM_REFL]; ASM_SIMP_TAC[AZIM_EQ_ALT]]);; let AZIM_EQ_0_GE = prove (`!v0 v1 w x. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} ==> (azim v0 v1 w x = &0 <=> w IN aff_ge {v0,v1} {x})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; STRIP_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o rand o snd) THEN ANTS_TAC THENL [SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; DISJOINT_INSERT; DISJOINT_EMPTY] THEN REWRITE_TAC[IN_SING] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_2; INSERT_AC]) THEN FIRST_ASSUM CONTR_TAC; DISCH_THEN SUBST1_TAC] THEN ASM_SIMP_TAC[AZIM_EQ_0] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_1] THEN REWRITE_TAC[SET_RULE `{x} DELETE x = {}`] THEN REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; IN_UNION] THEN ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL]);; let AZIM_COMPL_EQ_0 = prove (`!z w w1 w2. ~collinear {z,w,w1} /\ ~collinear {z,w,w2} /\ azim z w w1 w2 = &0 ==> azim z w w2 w1 = &0`, REWRITE_TAC[IMP_CONJ] THEN GEOM_ORIGIN_TAC `z:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; AZIM_ARG] THEN REWRITE_TAC[ARG_EQ_0; real; IM_COMPLEX_DIV_EQ_0; RE_COMPLEX_DIV_GE_0] THEN REWRITE_TAC[complex_mul; RE; IM; cnj] THEN REAL_ARITH_TAC);; let AZIM_COMPL = prove (`!z w w1 w2. ~collinear {z,w,w1} /\ ~collinear {z,w,w2} ==> azim z w w2 w1 = if azim z w w1 w2 = &0 then &0 else &2 * pi - azim z w w1 w2`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ASM_MESON_TAC[AZIM_COMPL_EQ_0]; ALL_TAC] THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN MP_TAC th) THEN GEOM_ORIGIN_TAC `z:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN REWRITE_TAC[ARG_EQ_0] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(dropout 3:real^3->real^2) w2 / (dropout 3:real^3->real^2) w1` ARG_INV) THEN ASM_REWRITE_TAC[COMPLEX_INV_DIV]);; let AZIM_EQ_PI_SYM = prove (`!z w w1 w2. ~collinear {z, w, w1} /\ ~collinear {z, w, w2} ==> (azim z w w1 w2 = pi <=> azim z w w2 w1 = pi)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o rand o snd) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let AZIM_EQ_0_SYM = prove (`!z w w1 w2. ~collinear {z, w, w1} /\ ~collinear {z, w, w2} ==> (azim z w w1 w2 = &0 <=> azim z w w2 w1 = &0)`, MESON_TAC[AZIM_COMPL_EQ_0]);; let AZIM_EQ_0_GE_ALT = prove (`!v0 v1 w x. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} ==> (azim v0 v1 w x = &0 <=> x IN aff_ge {v0,v1} {w})`, ASM_MESON_TAC[AZIM_EQ_0_SYM; AZIM_EQ_0_GE]);; let AZIM_EQ_PI = prove (`!v0 v1 w x. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} ==> (azim v0 v1 w x = pi <=> w IN aff_lt {v0,v1} {x})`, GEOM_ORIGIN_TAC `v0:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; REAL_LT_IMP_NZ; COLLINEAR_SPECIAL_SCALE] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_SPECIAL_SCALE o rand o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN REPEAT CONJ_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN TRY(RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN FIRST_X_ASSUM CONTR_TAC) THEN UNDISCH_TAC `~collinear {vec 0:real^3, basis 3, v1 % basis 3}` THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[AZIM_ARG] THEN CONV_TAC(LAND_CONV SYM_CONV) THEN CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[ARG_EQ_PI] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(dropout 3 (w:real^3)) IN aff_lt {vec 0:real^2} {dropout 3 (x:real^3)}` THEN CONJ_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN SPEC_TAC(`(dropout 3:real^3->real^2) x`,`y:complex`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w`,`v:complex`) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v:complex` THEN X_GEN_TAC `v:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `v = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_1_1 o rand o rand o snd) THEN ASM_REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; IN_SING] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_CMUL; IN_ELIM_THM; COMPLEX_MUL_RZERO] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; COMPLEX_ADD_LID] THEN EQ_TAC THENL [REWRITE_TAC[GSYM real; REAL] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) ASSUME_TAC) THEN EXISTS_TAC `v / Re y` THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ] THEN CONJ_TAC THENL [ALL_TAC; REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]; DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[CX_INJ; REAL_ARITH `x < &0 ==> ~(x = &0)`; COMPLEX_FIELD `~(t = Cx(&0)) ==> (v = t * y <=> y = v / t)`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM CX_DIV] THEN REWRITE_TAC[RE_CX; IM_CX]] THEN REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN ASM_REAL_ARITH_TAC; W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_2_1 o rand o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_2; INSERT_AC]) THEN FIRST_ASSUM CONTR_TAC; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_1_1 o rand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT {a} {x} <=> ~(x = a)`] THEN ASM_MESON_TAC[COLLINEAR_BASIS_3]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[REAL_ARITH `s + t = &1 <=> s = &1- t`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; RIGHT_EXISTS_AND_THM] THEN X_GEN_TAC `t:real` THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; VECTOR_ADD_COMPONENT; REAL_ADD_LID; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[REAL_ARITH `x:real = t + y <=> t = x - y`] THEN REWRITE_TAC[EXISTS_REFL]]);; let AZIM_EQ_PI_ALT = prove (`!v0 v1 w x. ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} ==> (azim v0 v1 w x = pi <=> x IN aff_lt {v0,v1} {w})`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP AZIM_EQ_PI_SYM) THEN ASM_SIMP_TAC[AZIM_EQ_PI]);; let AZIM_EQ_0_PI_IMP_COPLANAR = prove (`!v0 v1 w1 w2. azim v0 v1 w1 w2 = &0 \/ azim v0 v1 w1 w2 = pi ==> coplanar {v0,v1,w1,w2}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `collinear {v0:real^3,v1,w1}` THENL [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`] NOT_COPLANAR_NOT_COLLINEAR) THEN ASM_REWRITE_TAC[] THEN CONV_TAC TAUT; POP_ASSUM MP_TAC] THEN ASM_CASES_TAC `collinear {v0:real^3,v1,w2}` THENL [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w2:real^3`; `w1:real^3`] NOT_COPLANAR_NOT_COLLINEAR) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INSERT_AC] THEN CONV_TAC TAUT; POP_ASSUM MP_TAC] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`w2:real^3`; `w1:real^3`; `v1:real^3`; `v0:real^3`] THEN GEOM_ORIGIN_TAC `v0:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN SIMP_TAC[AZIM_SPECIAL_SCALE] THEN ASM_SIMP_TAC[AZIM_ARG; COLLINEAR_SPECIAL_SCALE] THEN REWRITE_TAC[COLLINEAR_BASIS_3; ARG_EQ_0_PI] THEN REWRITE_TAC[real; IM_COMPLEX_DIV_EQ_0] THEN REWRITE_TAC[complex_mul; cnj; IM; RE] THEN REWRITE_TAC[REAL_ARITH `x * --y + a * b = &0 <=> x * y = a * b`] THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_3; ARITH; DIMINDEX_2] THEN DISCH_TAC THEN REWRITE_TAC[coplanar] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^3`; `w % basis 3:real^3`; `w1:real^3`] THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = d INSERT {a,b,c}`] THEN ONCE_REWRITE_TAC[INSERT_SUBSET] THEN REWRITE_TAC[HULL_SUBSET] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; HULL_INC] THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; FORALL_3; dropout; LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH; VEC_COMPONENT; ARITH; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN ASM_SIMP_TAC[EXISTS_REFL; REAL_FIELD `&0 < w ==> (x - k * w * &1 - y = &0 <=> k = (x - y) / w)`] THEN SUBGOAL_THEN `~((w1:real^3)$2 = &0) \/ ~((w2:real^3)$1 = &0)` STRIP_ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING; EXISTS_TAC `(w2:real^3)$2 / (w1:real^3)$2` THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; EXISTS_TAC `(w2:real^3)$1 / (w1:real^3)$1` THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; let AZIM_SAME_WITHIN_AFF_GE = prove (`!a u v w z. v IN aff_ge {a} {u,w} /\ ~collinear{a,u,v} /\ ~collinear{a,u,w} ==> azim a u v z = azim a u w z`, GEOM_ORIGIN_TAC `a:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `u:real^3` THEN X_GEN_TAC `u:real` THEN ASM_CASES_TAC `u = &0` THEN ASM_SIMP_TAC[AZIM_DEGENERATE; VECTOR_MUL_LZERO; REAL_LE_LT] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `w:real^3 = vec 0` THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_GE_SCALE_LEMMA] THEN REWRITE_TAC[COLLINEAR_BASIS_3; AZIM_ARG] THEN ASM_SIMP_TAC[AFF_GE_1_2_0; BASIS_NONZERO; ARITH; DIMINDEX_3; SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `dropout 3:real^3->real^2`) THEN REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN DISCH_THEN SUBST1_TAC THEN REPEAT DISCH_TAC THEN REWRITE_TAC[COMPLEX_CMUL] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM CX_INV] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = b * a * c`] THEN MATCH_MP_TAC ARG_MUL_CX THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM_MESON_TAC[VECTOR_MUL_LZERO]);; let AZIM_SAME_WITHIN_AFF_GE_ALT = prove (`!a u v w z. v IN aff_ge {a} {u,w} /\ ~collinear{a,u,v} /\ ~collinear{a,u,w} ==> azim a u z v = azim a u z w`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AZIM_SAME_WITHIN_AFF_GE) THEN ASM_CASES_TAC `collinear {a:real^3,u,z}` THEN ASM_SIMP_TAC[AZIM_DEGENERATE] THEN W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o rand o snd) THEN ASM_SIMP_TAC[]);; let COLLINEAR_WITHIN_AFF_GE_COLLINEAR = prove (`!a u v w:real^N. v IN aff_ge {a} {u,w} /\ collinear{a,u,w} ==> collinear{a,v,w}`, GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `w:real^N = vec 0` THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN ASM_CASES_TAC `u:real^N = vec 0` THENL [ONCE_REWRITE_TAC[AFF_GE_DISJOINT_DIFF] THEN ASM_REWRITE_TAC[SET_RULE `{a} DIFF {a,b} = {}`] THEN REWRITE_TAC[GSYM CONVEX_HULL_AFF_GE] THEN ONCE_REWRITE_TAC[SET_RULE `{z,v,w} = {z,w,v}`] THEN ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; ONCE_REWRITE_TAC[SET_RULE `{z,v,w} = {z,w,v}`] THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `a:real`)) THEN ASM_SIMP_TAC[AFF_GE_1_2_0; SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC] THEN MESON_TAC[]]);; let AZIM_EQ_IMP = prove (`!v0 v1 w x y. ~collinear {v0, v1, w} /\ ~collinear {v0, v1, y} /\ x IN aff_gt {v0, v1} {y} ==> azim v0 v1 w x = azim v0 v1 w y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `collinear {v0:real^3,v1,x}` THENL [ALL_TAC; ASM_SIMP_TAC[AZIM_EQ_ALT]] THEN UNDISCH_TAC `collinear {v0:real^3,v1,x}` THEN MATCH_MP_TAC(TAUT `(s /\ p ==> r) ==> p ==> ~q /\ ~r /\ s ==> t`) THEN ASM_SIMP_TAC[COLLINEAR_3_IN_AFFINE_HULL] THEN ASM_CASES_TAC `y:real^3 = v0` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN ASM_CASES_TAC `y:real^3 = v1` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN ASM_SIMP_TAC[AFF_GT_2_1; SET_RULE `DISJOINT {a,b} {c} <=> ~(c = a) /\ ~(c = b)`] THEN REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t1:real`; `t2:real`; `t3:real`; `s1:real`; `s2:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv t3) :real^3->real^3`) THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_ARITH `x:real^N = y + z + &1 % w <=> w = x - (y + z)`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `inv t3 * s1 - inv t3 * t1:real` THEN EXISTS_TAC `inv t3 * s2 - inv t3 * t2:real` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_FIELD `&0 < t ==> (inv t * a - inv t * b + inv t * c - inv t * d = &1 <=> (a + c) - (b + d) = t)`] THEN ASM_REAL_ARITH_TAC; VECTOR_ARITH_TAC]);; let AZIM_EQ_0_GE_IMP = prove (`!v0 v1 w x. x IN aff_ge {v0, v1} {w} ==> azim v0 v1 w x = &0`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `collinear {v0:real^3,v1,w}` THEN ASM_SIMP_TAC[AZIM_DEGENERATE] THEN ASM_CASES_TAC `collinear {v0:real^3,v1,x}` THEN ASM_SIMP_TAC[AZIM_DEGENERATE] THEN ASM_MESON_TAC[AZIM_EQ_0_GE_ALT]);; let REAL_SGN_SIN_AZIM = prove (`!v w x y. real_sgn(sin(azim v w x y)) = real_sgn(((w - v) cross (x - v)) dot (y - v))`, GEOM_ORIGIN_TAC `v:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; CROSS_LZERO; DOT_LZERO; REAL_SGN_0; AZIM_REFL_ALT; SIN_0] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; CROSS_LMUL; DOT_LMUL] THEN REWRITE_TAC[REAL_SGN_MUL] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN ASM_REWRITE_TAC[REAL_MUL_LID; AZIM_ARG] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `real_sgn(Im(dropout 3 (y:real^3) / dropout 3 (x:real^3)))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_SGN_IM_COMPLEX_DIV] THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; cross; VECTOR_3; DOT_3; dropout; LAMBDA_BETA; ARITH; cnj; complex_mul; RE_DEF; IM_DEF; DIMINDEX_2; complex; VECTOR_2; BASIS_COMPONENT] THEN REAL_ARITH_TAC] THEN SPEC_TAC(`(dropout 3:real^3->real^2) x`,`z:complex`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) y`,`w:complex`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `z:complex` THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_MUL_RID] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[complex_div; COMPLEX_INV_0; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[ARG_0; SIN_0; IM_CX; REAL_SGN_0]; SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN ASM_SIMP_TAC[ARG_DIV_CX; IM_DIV_CX; REAL_SGN_DIV] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [real_sgn] THEN ASM_REWRITE_TAC[REAL_DIV_1] THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[IM_CX; ARG_0; SIN_0] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [ARG] THEN REWRITE_TAC[IM_MUL_CX; REAL_SGN_MUL] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ; REAL_MUL_LID] THEN REWRITE_TAC[IM_CEXP; RE_MUL_II; IM_MUL_II; RE_CX; REAL_SGN_MUL] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN REWRITE_TAC[REAL_EXP_POS_LT; REAL_MUL_LID]);; let AZIM_IN_UPPER_HALFSPACE = prove (`!v w x y. azim v w x y <= pi <=> &0 <= ((w - v) cross (x - v)) dot (y - v)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&0 <= sin(azim v w x y)` THEN CONJ_TAC THENL [EQ_TAC THEN SIMP_TAC[SIN_POS_PI_LE; azim] THEN MP_TAC(ISPEC `azim v w x y - pi` SIN_POS_PI) THEN REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI; azim; REAL_ARITH `x - pi < pi <=> x < &2 * pi`] THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[GSYM REAL_SGN_INEQS] THEN REWRITE_TAC[REAL_SGN_SIN_AZIM]]);; (* ------------------------------------------------------------------------- *) (* Dihedral angle and relation to azimuth angle. *) (* ------------------------------------------------------------------------- *) let dihV = new_definition `dihV w0 w1 w2 w3 = let va = w2 - w0 in let vb = w3 - w0 in let vc = w1 - w0 in let vap = ( vc dot vc) % va - ( va dot vc) % vc in let vbp = ( vc dot vc) % vb - ( vb dot vc) % vc in arcV (vec 0) vap vbp`;; let DIHV = prove (`dihV (w0:real^N) w1 w2 w3 = let va = w2 - w0 in let vb = w3 - w0 in let vc = w1 - w0 in let vap = (vc dot vc) % va - (va dot vc) % vc in let vbp = (vc dot vc) % vb - (vb dot vc) % vc in angle(vap,vec 0,vbp)`, REWRITE_TAC[dihV; ARCV_ANGLE]);; let DIHV_TRANSLATION_EQ = prove (`!a w0 w1 w2 w3:real^N. dihV (a + w0) (a + w1) (a + w2) (a + w3) = dihV w0 w1 w2 w3`, REWRITE_TAC[DIHV; VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; add_translation_invariants [DIHV_TRANSLATION_EQ];; let DIHV_LINEAR_IMAGE = prove (`!f:real^M->real^N w0 w1 w2 w3. linear f /\ (!x. norm(f x) = norm x) ==> dihV (f w0) (f w1) (f w2) (f w3) = dihV w0 w1 w2 w3`, REPEAT STRIP_TAC THEN REWRITE_TAC[DIHV] THEN ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_SIMP_TAC[PRESERVES_NORM_PRESERVES_DOT] THEN ASM_SIMP_TAC[GSYM LINEAR_CMUL; GSYM LINEAR_SUB] THEN REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN ASM_SIMP_TAC[VECTOR_ANGLE_LINEAR_IMAGE_EQ]);; add_linear_invariants [DIHV_LINEAR_IMAGE];; let DIHV_SPECIAL_SCALE = prove (`!a v w1 w2:real^N. ~(a = &0) ==> dihV (vec 0) (a % v) w1 w2 = dihV (vec 0) v w1 w2`, REPEAT STRIP_TAC THEN REWRITE_TAC[DIHV; VECTOR_SUB_RZERO] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[DOT_LMUL; DOT_RMUL; GSYM VECTOR_MUL_ASSOC] THEN REWRITE_TAC[VECTOR_ARITH `a % a % x - a % b % a % y:real^N = (a * a) % (x - b % y)`] THEN REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN REWRITE_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN ASM_REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]);; let DIHV_RANGE = prove (`!w0 w1 w2 w3. &0 <= dihV w0 w1 w2 w3 /\ dihV w0 w1 w2 w3 <= pi`, REWRITE_TAC[DIHV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[ANGLE_RANGE]);; let COS_AZIM_DIHV = prove (`!v w v1 v2:real^3. ~collinear {v,w,v1} /\ ~collinear {v,w,v2} ==> cos(azim v w v1 v2) = cos(dihV v w v1 v2)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `w:real^3 = v` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; POP_ASSUM MP_TAC] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN GEOM_ORIGIN_TAC `v:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; DIHV_SPECIAL_SCALE; REAL_LT_IMP_NZ; COLLINEAR_SPECIAL_SCALE; COLLINEAR_BASIS_3] THEN DISCH_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY X_GEN_TAC [`w1:real^3`; `w2:real^3`] THEN DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN REWRITE_TAC[DIHV; VECTOR_SUB_RZERO] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH] THEN SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH; VECTOR_MUL_LID] THEN MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`] azim) THEN ABBREV_TAC `a = azim (vec 0) (basis 3) w1 (w2:real^3)` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_SUB_RZERO; DIST_0] THEN MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN DISCH_THEN(MP_TAC o SPECL [`basis 1:real^3`; `basis 2:real^3`; `basis 3:real^3`]) THEN SIMP_TAC[orthonormal; DOT_BASIS_BASIS; CROSS_BASIS; DIMINDEX_3; NORM_BASIS; ARITH; VECTOR_MUL_LID; BASIS_NONZERO; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN ASM_REWRITE_TAC[COLLINEAR_BASIS_3] THEN MAP_EVERY X_GEN_TAC [`psi:real`; `r1:real`; `r2:real`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LID] THEN REWRITE_TAC[VECTOR_ARITH `(a + b + c) - c:real^N = a + b`] THEN REWRITE_TAC[COS_ANGLE; VECTOR_SUB_RZERO] THEN REWRITE_TAC[vector_norm; GSYM DOT_EQ_0; DIMINDEX_3; FORALL_3; DOT_3] THEN REWRITE_TAC[VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_ARITH `(r * c) * (r * c) + (r * s) * (r * s):real = r pow 2 * (s pow 2 + c pow 2)`] THEN ASM_SIMP_TAC[SIN_CIRCLE; REAL_MUL_RID; REAL_POW_EQ_0; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `(r1 * c1) * (r2 * c2) + (r1 * s1) * (r2 * s2):real = (r1 * r2) * (c1 * c2 + s1 * s2)`] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < r1 /\ &0 < r2 ==> ((r1 * r2) * x) / (r1 * r2) = x`] THEN ONCE_REWRITE_TAC[REAL_ARITH `a:real = b + c * d <=> b - --c * d = a`] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM COS_NEG] THEN REWRITE_TAC[GSYM SIN_NEG; GSYM COS_ADD] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let AZIM_DIHV_SAME = prove (`!v w v1 v2:real^3. ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\ azim v w v1 v2 < pi ==> azim v w v1 v2 = dihV v w v1 v2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COS_INJ_PI THEN ASM_SIMP_TAC[COS_AZIM_DIHV; azim; REAL_LT_IMP_LE; DIHV_RANGE]);; let AZIM_DIHV_COMPL = prove (`!v w v1 v2:real^3. ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\ pi <= azim v w v1 v2 ==> azim v w v1 v2 = &2 * pi - dihV v w v1 v2`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x = &2 * pi - y <=> y = &2 * pi - x`] THEN MATCH_MP_TAC COS_INJ_PI THEN REWRITE_TAC[COS_SUB; SIN_NPI; COS_NPI; REAL_MUL_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[COS_AZIM_DIHV; REAL_ADD_RID; REAL_MUL_LID] THEN ASM_REWRITE_TAC[DIHV_RANGE] THEN MATCH_MP_TAC(REAL_ARITH `p <= x /\ x < &2 * p ==> &0 <= &2 * p - x /\ &2 * p - x <= p`) THEN ASM_SIMP_TAC[azim]);; let AZIM_DIVH = prove (`!v w v1 v2:real^3. ~collinear {v,w,v1} /\ ~collinear {v,w,v2} ==> azim v w v1 v2 = if azim v w v1 v2 < pi then dihV v w v1 v2 else &2 * pi - dihV v w v1 v2`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN ASM_SIMP_TAC[AZIM_DIHV_SAME; AZIM_DIHV_COMPL]);; let AZIM_DIHV_EQ_0 = prove (`!v0 v1 w1 w2. ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> (azim v0 v1 w1 w2 = &0 <=> dihV v0 v1 w1 w2 = &0)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhs o snd) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_ARITH `a:real = p - b <=> b = p - a`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ARITH `&2 * p - (&2 * p - a) = &0 <=> a = &0`] THEN MATCH_MP_TAC(REAL_ARITH `a < &2 * pi /\ ~(a < pi) ==> (a = &0 <=> &2 * pi - a = &0)`) THEN ASM_REWRITE_TAC[azim]);; let AZIM_DIHV_EQ_PI = prove (`!v0 v1 w1 w2. ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> (azim v0 v1 w1 w2 = pi <=> dihV v0 v1 w1 w2 = pi)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhs o snd) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let AZIM_EQ_0_PI_EQ_COPLANAR = prove (`!v0 v1 w1 w2. ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> (azim v0 v1 w1 w2 = &0 \/ azim v0 v1 w1 w2 = pi <=> coplanar {v0,v1,w1,w2})`, REWRITE_TAC[TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`] THEN REWRITE_TAC[AZIM_EQ_0_PI_IMP_COPLANAR] THEN SIMP_TAC[GSYM IMP_CONJ_ALT; COPLANAR; DIMINDEX_3; ARITH] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v0:real^3`; `v1:real^3`; `v2:real^3`; `v3:real^3`; `p:real^3->bool`] THEN GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN REWRITE_TAC[INSERT_SUBSET; IN_ELIM_THM; IMP_CONJ; RIGHT_FORALL_IMP_THM; EMPTY_SUBSET] THEN SIMP_TAC[AZIM_DIHV_EQ_0; AZIM_DIHV_EQ_PI] THEN REWRITE_TAC[DIHV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN DISCH_THEN(K ALL_TAC) THEN PAD2D3D_TAC THEN REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN GEOM_ORIGIN_TAC `v0:real^2` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) COLLINEAR_VECTOR_ANGLE o snd) THEN ANTS_TAC THENL [REPEAT(POP_ASSUM MP_TAC); DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN REWRITE_TAC[DOT_2; CART_EQ; FORALL_2; DIMINDEX_2; VEC_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN CONV_TAC REAL_RING);; let DIHV_EQ_0_PI_EQ_COPLANAR = prove (`!v0 v1 w1 w2:real^3. ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> (dihV v0 v1 w1 w2 = &0 \/ dihV v0 v1 w1 w2 = pi <=> coplanar {v0,v1,w1,w2})`, SIMP_TAC[GSYM AZIM_DIHV_EQ_0; GSYM AZIM_DIHV_EQ_PI; AZIM_EQ_0_PI_EQ_COPLANAR]);; let DIHV_SYM = prove (`!v0 v1 v2 v3:real^N. dihV v0 v1 v3 v2 = dihV v0 v1 v2 v3`, REPEAT GEN_TAC THEN REWRITE_TAC[DIHV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[DOT_SYM; ANGLE_SYM]);; let DIHV_NEG = prove (`!v0 v1 v2 v3. dihV (--v0) (--v1) (--v2) (--v3) = dihV v0 v1 v2 v3`, REWRITE_TAC[DIHV; VECTOR_ARITH `--a - --b:real^N = --(a - b)`] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[DOT_RNEG; DOT_LNEG; REAL_NEG_NEG] THEN REWRITE_TAC[VECTOR_MUL_RNEG] THEN REWRITE_TAC[angle; VECTOR_ARITH `--a - --b:real^N = --(a - b)`] THEN REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ANGLE_NEG2]);; let DIHV_NEG_0 = prove (`!v1 v2 v3. dihV (vec 0) (--v1) (--v2) (--v3) = dihV (vec 0) v1 v2 v3`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM DIHV_NEG] THEN REWRITE_TAC[VECTOR_NEG_0]);; let DIHV_ARCV = prove (`!e u v w:real^N. orthogonal (e - u) (v - u) /\ orthogonal (e - u) (w - u) /\ ~(e = u) ==> dihV u e v w = arcV u v w`, GEOM_ORIGIN_TAC `u:real^N` THEN REWRITE_TAC[dihV; orthogonal; VECTOR_SUB_RZERO] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN SIMP_TAC[DOT_SYM; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN REWRITE_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN SIMP_TAC[DOT_POS_LE; DOT_EQ_0]);; let AZIM_DIHV_SAME_STRONG = prove (`!v w v1 v2:real^3. ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\ azim v w v1 v2 <= pi ==> azim v w v1 v2 = dihV v w v1 v2`, REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[AZIM_DIHV_SAME; AZIM_DIHV_EQ_PI]);; let AZIM_ARCV = prove (`!e u v w:real^3. orthogonal (e - u) (v - u) /\ orthogonal (e - u) (w - u) /\ ~collinear{u,e,v} /\ ~collinear{u,e,w} /\ azim u e v w <= pi ==> azim u e v w = arcV u v w`, REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^3 = e` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM DIHV_ARCV] THEN MATCH_MP_TAC AZIM_DIHV_SAME_STRONG THEN ASM_REWRITE_TAC[]);; let COLLINEAR_AZIM_0_OR_PI = prove (`!u e v w. collinear {u,v,w} ==> azim u e v w = &0 \/ azim u e v w = pi`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `collinear{u:real^3,e,v}` THEN ASM_SIMP_TAC[AZIM_DEGENERATE] THEN ASM_CASES_TAC `collinear{u:real^3,e,w}` THEN ASM_SIMP_TAC[AZIM_DEGENERATE] THEN ASM_SIMP_TAC[AZIM_EQ_0_PI_EQ_COPLANAR] THEN ONCE_REWRITE_TAC[SET_RULE `{u,e,v,w} = {u,v,w,e}`] THEN ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR]);; let REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE = prove (`!f:real^M->real^N g h k x s. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ f continuous (at x within s) /\ g continuous (at x within s) /\ h continuous (at x within s) /\ k continuous (at x within s) ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (at x within s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[dihV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[ARCV_ANGLE; angle; REAL_CONTINUOUS_CONTINUOUS; o_DEF] THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_CX_VECTOR_ANGLE_COMPOSE THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; GSYM COLLINEAR_3_DOT_MULTIPLES] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN ASM_SIMP_TAC[CONTINUOUS_LIFT_DOT2; o_DEF; CONTINUOUS_SUB]);; let REAL_CONTINUOUS_AT_DIHV_COMPOSE = prove (`!f:real^M->real^N g h k x. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ f continuous (at x) /\ g continuous (at x) /\ h continuous (at x) /\ k continuous (at x) ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE]);; let REAL_CONTINUOUS_WITHINREAL_DIHV_COMPOSE = prove (`!f:real->real^N g h k x s. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ f continuous (atreal x within s) /\ g continuous (atreal x within s) /\ h continuous (atreal x within s) /\ k continuous (atreal x within s) ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (atreal x within s)`, REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL; REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL] THEN SIMP_TAC[o_DEF; REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE; LIFT_DROP]);; let REAL_CONTINUOUS_ATREAL_DIHV_COMPOSE = prove (`!f:real->real^N g h k x. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ f continuous (atreal x) /\ g continuous (atreal x) /\ h continuous (atreal x) /\ k continuous (atreal x) ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL_DIHV_COMPOSE]);; let REAL_CONTINUOUS_AT_DIHV = prove (`!v w w1 w2:real^N. ~collinear {v, w, w2} ==> dihV v w w1 real_continuous at w2`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[dihV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN SIMP_TAC[CONTINUOUS_CONST; o_DEF; CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_LIFT_DOT2]; GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[ARCV_ANGLE; angle] THEN REWRITE_TAC[VECTOR_SUB_RZERO; ETA_AX] THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_VECTOR_ANGLE THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `v:real^N` THEN REWRITE_TAC[VECTOR_SUB_RZERO; CONTRAPOS_THM; VECTOR_SUB_EQ] THEN MAP_EVERY X_GEN_TAC [`z:real^N`; `w:real^N`] THEN ASM_CASES_TAC `w:real^N = vec 0` THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN DISCH_THEN(MP_TAC o AP_TERM `(%) (inv((w:real^N) dot w)):real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; DOT_EQ_0] THEN MESON_TAC[VECTOR_MUL_LID]]);; let REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE = prove (`!f:real^M->real^3 g h k x s. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ ~(k x IN aff_ge {f x,g x} {h x}) /\ f continuous (at x within s) /\ g continuous (at x within s) /\ h continuous (at x within s) /\ k continuous (at x within s) ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (at x within s)`, let lemma = prove (`!s t u f:real^M->real^N g h. (closed s /\ closed t) /\ s UNION t = UNIV /\ (g continuous_on (u INTER s) /\ h continuous_on (u INTER t)) /\ (!x. x IN u INTER s ==> g x = f x) /\ (!x. x IN u INTER t ==> h x = f x) ==> f continuous_on u`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `u:real^M->bool = (u INTER s) UNION (u INTER t)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `s:real^M->bool` THEN ASM SET_TAC[]; EXISTS_TAC `t:real^M->bool` THEN ASM SET_TAC[]; ASM_MESON_TAC[CONTINUOUS_ON_EQ]; ASM_MESON_TAC[CONTINUOUS_ON_EQ]]) in REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; o_DEF] THEN SUBGOAL_THEN `(\x:real^M. Cx(azim (f x) (g x) (h x) (k x))) = (\z. Cx(azim (vec 0) (fstcart z) (fstcart(sndcart z)) (sndcart(sndcart z)))) o (\x. pastecart (g x - f x) (pastecart (h x - f x) (k x - f x)))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN X_GEN_TAC `y:real^M` THEN SUBST1_TAC(VECTOR_ARITH `vec 0 = (f:real^M->real^3) y - f y`) THEN SIMP_TAC[ONCE_REWRITE_RULE[VECTOR_ADD_SYM] AZIM_TRANSLATION; VECTOR_SUB]; MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_PASTECART; CONTINUOUS_SUB]] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN SUBGOAL_THEN `!z. ~collinear {vec 0,fstcart z,fstcart(sndcart z)} /\ ~collinear {vec 0,fstcart z,sndcart(sndcart z)} /\ ~(sndcart(sndcart z) IN aff_ge {vec 0,fstcart z} {fstcart(sndcart z)}) ==> (\z. Cx(azim (vec 0) (fstcart z) (fstcart(sndcart z)) (sndcart(sndcart z)))) continuous (at z)` MATCH_MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; GSYM COLLINEAR_3] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[INSERT_AC]; ALL_TAC]) THEN SUBST1_TAC(VECTOR_ARITH `vec 0 = (f:real^M->real^3) x - f x`) THEN ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN REWRITE_TAC[GSYM IMAGE_UNION; SET_RULE `{a - b:real^3} = IMAGE (\x. x - b) {a}`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[VECTOR_ADD_SYM] AFF_GE_TRANSLATION; VECTOR_SUB] THEN ASM_REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `a + x:real^3 = b + x <=> a = b`; UNWIND_THM1; SET_RULE `{a} UNION {b} = {a,b}`]] THEN ONCE_REWRITE_TAC[SET_RULE `(!x. ~P x /\ ~Q x /\ ~R x ==> J x) <=> (!x. x IN UNIV DIFF (({x | P x} UNION {x | Q x}) UNION {x | R x}) ==> J x)`] THEN MATCH_MP_TAC(MESON[CONTINUOUS_ON_EQ_CONTINUOUS_AT] `open s /\ f continuous_on s ==> !z. z IN s ==> f continuous at z`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM closed] THEN MATCH_MP_TAC(MESON[] `!t'. s UNION t = s UNION t' /\ closed(s UNION t') ==> closed(s UNION t)`) THEN EXISTS_TAC `{z | (fstcart z cross fstcart(sndcart z)) cross fstcart z cross sndcart(sndcart z) = vec 0 /\ &0 <= (fstcart z cross sndcart(sndcart z)) dot (fstcart z cross fstcart(sndcart z))}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. ~(x IN s) ==> (x IN t <=> x IN t')) ==> s UNION t = s UNION t'`) THEN REWRITE_TAC[AFF_GE_2_1_0_SEMIALGEBRAIC; IN_UNION; IN_ELIM_THM; DE_MORGAN_THM]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN SIMP_TAC[SET_RULE `{x | f x = a} = {x | x IN UNIV /\ f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN SIMP_TAC[CLOSED_UNIV; CLOSED_SING; LIFT_SUB; REAL_POW_2; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN CONJ_TAC; ONCE_REWRITE_TAC[MESON[LIFT_DROP; real_ge] `&0 <= x <=> drop(lift x) >= &0`] THEN REWRITE_TAC[SET_RULE `{z | f z = vec 0 /\ drop(g z) >= &0} = {z | z IN UNIV /\ f z IN {vec 0}} INTER {z | z IN UNIV /\ g z IN {k | drop(k) >= &0}}`] THEN MATCH_MP_TAC CLOSED_INTER THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN REWRITE_TAC[CLOSED_SING; drop; CLOSED_UNIV; CLOSED_HALFSPACE_COMPONENT_GE] THEN REPEAT((MATCH_MP_TAC CONTINUOUS_ON_CROSS ORELSE MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2) THEN CONJ_TAC)] THEN TRY(GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF]) THEN SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC [`{z | z IN UNIV /\ lift((fstcart z cross (fstcart(sndcart z))) dot (sndcart(sndcart z))) IN {x | x$1 >= &0}}`; `{z | z IN UNIV /\ lift((fstcart z cross (fstcart(sndcart z))) dot (sndcart(sndcart z))) IN {x | x$1 <= &0}}`; `\z. Cx(dihV (vec 0:real^3) (fstcart z) (fstcart(sndcart z)) (sndcart(sndcart z)))`; `\z. Cx(&2 * pi - dihV (vec 0:real^3) (fstcart z) (fstcart(sndcart z)) (sndcart(sndcart z)))`] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN REWRITE_TAC[CLOSED_UNIV; CLOSED_HALFSPACE_COMPONENT_GE; CLOSED_HALFSPACE_COMPONENT_LE] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CROSS; ALL_TAC]) THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REWRITE_TAC[FORALL_PASTECART; IN_DIFF; IN_UNIV; IN_UNION; IN_INTER; FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM; DE_MORGAN_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CX_SUB] THEN TRY(MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST]) THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_DIHV_COMPOSE THEN ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN SIMP_TAC[CONTINUOUS_AT_COMPOSE; LINEAR_CONTINUOUS_AT; LINEAR_FSTCART; LINEAR_SNDCART]; ALL_TAC] THEN REWRITE_TAC[FORALL_PASTECART; IN_DIFF; IN_UNIV; IN_UNION; IN_INTER; CX_INJ; FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM; DE_MORGAN_THM] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM drop; LIFT_DROP; real_ge] THEN MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM AZIM_DIHV_SAME_STRONG) THEN ASM_REWRITE_TAC[AZIM_IN_UPPER_HALFSPACE; VECTOR_SUB_RZERO]; REWRITE_TAC[GSYM drop; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM AZIM_DIHV_COMPL) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `(x <= pi ==> x = pi) ==> pi <= x`) THEN ASM_REWRITE_TAC[AZIM_IN_UPPER_HALFSPACE; VECTOR_SUB_RZERO] THEN ASM_SIMP_TAC[REAL_ARITH `x <= &0 ==> (&0 <= x <=> x = &0)`] THEN REWRITE_TAC[REWRITE_RULE[VECTOR_SUB_RZERO] (SPEC `vec 0:real^3` (GSYM COPLANAR_CROSS_DOT))] THEN ASM_SIMP_TAC[GSYM AZIM_EQ_0_PI_EQ_COPLANAR; AZIM_EQ_0_GE_ALT]]]);; let REAL_CONTINUOUS_AT_AZIM_COMPOSE = prove (`!f:real^M->real^3 g h k x. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ ~(k x IN aff_ge {f x,g x} {h x}) /\ f continuous (at x) /\ g continuous (at x) /\ h continuous (at x) /\ k continuous (at x) ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE]);; let REAL_CONTINUOUS_WITHINREAL_AZIM_COMPOSE = prove (`!f:real->real^3 g h k x s. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ ~(k x IN aff_ge {f x,g x} {h x}) /\ f continuous (atreal x within s) /\ g continuous (atreal x within s) /\ h continuous (atreal x within s) /\ k continuous (atreal x within s) ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (atreal x within s)`, REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL; REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL] THEN SIMP_TAC[o_DEF; REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE; LIFT_DROP]);; let REAL_CONTINUOUS_ATREAL_AZIM_COMPOSE = prove (`!f:real->real^3 g h k x. ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ ~(k x IN aff_ge {f x,g x} {h x}) /\ f continuous (atreal x) /\ g continuous (atreal x) /\ h continuous (atreal x) /\ k continuous (atreal x) ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL_AZIM_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Can consider angle as defined by arcV a zenith angle. *) (* ------------------------------------------------------------------------- *) let ZENITH_EXISTS = prove (`!u v w:real^3. ~(u = v) /\ ~(w = v) ==> (?u' r phi e3. phi = arcV v u w /\ r = dist(u,v) /\ dist(w,v) % e3 = w - v /\ u' dot e3 = &0 /\ u = v + u' + (r * cos phi) % e3)`, ONCE_REWRITE_TAC[VECTOR_ARITH `u:real^3 = v + u' + x <=> u - v = u' + x`] THEN GEN_GEOM_ORIGIN_TAC `v:real^3` ["u'"; "e3"] THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `u:real^3 = u' + x <=> u - u' = x`] THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_LT] THEN DISCH_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_3; ARITH] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < w ==> abs w * &1 = w`] THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`u:real^3`; `w % basis 3:real^3`] VECTOR_ANGLE) THEN REWRITE_TAC[DOT_RMUL; NORM_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < w ==> n * ((abs w) * x) * y = w * n * x * y`] THEN ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN SIMP_TAC[NORM_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_ARITH `u - u':real^3 = x <=> u' = u - x`] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[DOT_LSUB; DOT_RMUL; DOT_LMUL] THEN SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Spherical coordinates. *) (* ------------------------------------------------------------------------- *) let SPHERICAL_COORDINATES = prove (`!u v w u' e1 e2 e3 r phi theta. ~collinear {v, w, u} /\ ~collinear {v, w, u'} /\ orthonormal e1 e2 e3 /\ dist(w,v) % e3 = w - v /\ (v + e1) IN aff_gt {v, w} {u} /\ r = dist(v,u') /\ phi = arcV v u' w /\ theta = azim v w u u' ==> u' = v + (r * cos theta * sin phi) % e1 + (r * sin theta * sin phi) % e2 + (r * cos phi) % e3`, ONCE_REWRITE_TAC[VECTOR_ARITH `u':real^3 = u + v + w <=> u' - u = v + w`] THEN GEN_GEOM_ORIGIN_TAC `v:real^3` ["e1"; "e2"; "e3"] THEN REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ADD_LID] THEN REWRITE_TAC[TRANSLATION_INVARIANTS `v:real^3`] THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^3`; `v:real^3`; `e1:real^3`; `e2:real^3`; `e3:real^3`; `r:real`; `phi:real`; `theta:real`] THEN ASM_CASES_TAC `u:real^3 = w % basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `v:real^3 = w % basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GSYM) THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_3; ARITH] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < w ==> abs w * &1 = w`] THEN ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN ASM_CASES_TAC `e3:real^3 = basis 3` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN ASM_SIMP_TAC[VECTOR_ANGLE_RMUL; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `u:real^3 = vec 0` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `v:real^3 = vec 0` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `u:real^3 = basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `v:real^3 = basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN STRIP_TAC THEN MP_TAC(ISPECL [`v:real^3`; `basis 3:real^3`] VECTOR_ANGLE) THEN ASM_SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN DISCH_TAC THEN MP_TAC(ISPECL [`vec 0:real^3`; `w % basis 3:real^3`; `u:real^3`; `e1:real^3`] AZIM_EQ_0_ALT) THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN ANTS_TAC THENL [SIMP_TAC[COLLINEAR_LEMMA; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN STRIP_TAC THEN UNDISCH_TAC `orthonormal e1 e2 (basis 3)` THEN ASM_REWRITE_TAC[orthonormal; DOT_LZERO; REAL_OF_NUM_EQ; ARITH_EQ] THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; CROSS_LZERO; DOT_LZERO; REAL_LT_REFL; DOT_LMUL; DOT_BASIS_BASIS; DIMINDEX_3; ARITH; REAL_MUL_RID]; DISCH_TAC] THEN SUBGOAL_THEN `dropout 3 (v:real^3):real^2 = norm(dropout 3 (v:real^3):real^2) % (cos theta % (dropout 3 (e1:real^3)) + sin theta % (dropout 3 (e2:real^3)))` MP_TAC THENL [ALL_TAC; SUBGOAL_THEN `norm((dropout 3:real^3->real^2) v) = r * sin phi` SUBST1_TAC THENL [REWRITE_TAC[NORM_EQ_SQUARE] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_MUL; NORM_POS_LE; SIN_VECTOR_ANGLE_POS]; ALL_TAC] THEN UNDISCH_TAC `(v:real^3)$3 = r * cos phi` THEN MATCH_MP_TAC(REAL_RING `x + a pow 2 = y + b pow 2 ==> a:real = b ==> x = y`) THEN REWRITE_TAC[REAL_POW_MUL; GSYM REAL_ADD_LDISTRIB] THEN REWRITE_TAC[SIN_CIRCLE; REAL_MUL_RID] THEN UNDISCH_THEN `norm(v:real^3) = r` (SUBST1_TAC o SYM) THEN REWRITE_TAC[NORM_POW_2; DOT_2; DOT_3] THEN SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[CART_EQ; DIMINDEX_3; DIMINDEX_2; FORALL_3; FORALL_2] THEN SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3] THEN REPEAT STRIP_TAC THEN TRY REAL_ARITH_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthonormal]) THEN SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH] THEN CONV_TAC REAL_RING] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [AZIM_ARG])) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3])) THEN SUBGOAL_THEN `norm((dropout 3:real^3->real^2) e1) = &1 /\ norm((dropout 3:real^3->real^2) e2) = &1 /\ dropout 3 (e2:real^3) / dropout 3 (e1:real^3) = ii` MP_TAC THENL [MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN CONJ_TAC THENL [REWRITE_TAC[NORM_EQ_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthonormal]) THEN SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH; dropout; LAMBDA_BETA; DOT_2; DIMINDEX_2; DOT_3] THEN CONV_TAC REAL_RING; ALL_TAC] THEN ASM_CASES_TAC `dropout 3 (e1:real^3) = Cx(&0)` THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ABS_NUM] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(x = Cx(&0)) ==> (y / x = ii <=> y = ii * x)`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_CROSS) THEN SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; cross; VECTOR_3; BASIS_COMPONENT; ARITH; dropout; LAMBDA_BETA; complex_mul; ii; complex; RE_DEF; IM_DEF; VECTOR_2] THEN CONV_TAC REAL_RING; ALL_TAC] THEN SPEC_TAC(`(dropout 3:real^3->real^2) e2`,`d2:real^2`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) e1`,`d1:real^2`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) v`,`z:real^2`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) u`,`w:real^2`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `w:real^2` THEN X_GEN_TAC `k:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `k = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `d1 = Cx(&1)` THENL [ASM_SIMP_TAC[COMPLEX_DIV_1; COMPLEX_MUL_LID] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN ASM_REWRITE_TAC[CEXP_EULER; CX_SIN; CX_COS; COMPLEX_MUL_RID] THEN CONV_TAC COMPLEX_RING; ASM_REWRITE_TAC[ARG_EQ_0] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COMPLEX_EQ]) THEN REWRITE_TAC[RE_CX; IM_CX;real] THEN ASM_CASES_TAC `Im d1 = &0` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_NORM; real] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Definition of a wedge and invariance theorems. *) (* ------------------------------------------------------------------------- *) let wedge = new_definition `wedge v0 v1 w1 w2 = {y | ~collinear {v0,v1,y} /\ &0 < azim v0 v1 w1 y /\ azim v0 v1 w1 y < azim v0 v1 w1 w2}`;; let WEDGE_ALT = prove (`!v0 v1 w1 w2. ~(v0 = v1) ==> wedge v0 v1 w1 w2 = {y | ~(y IN affine hull {v0,v1}) /\ &0 < azim v0 v1 w1 y /\ azim v0 v1 w1 y < azim v0 v1 w1 w2}`, SIMP_TAC[wedge; COLLINEAR_3_AFFINE_HULL]);; let WEDGE_TRANSLATION = prove (`!a v w w1 w2. wedge (a + v) (a + w) (a + w1) (a + w2) = IMAGE (\x. a + x) (wedge v w w1 w2)`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[VECTOR_ARITH `a + (x - a):real^3 = x`]; ALL_TAC] THEN REWRITE_TAC[wedge; IN_ELIM_THM; AZIM_TRANSLATION] THEN REWRITE_TAC[SET_RULE `{a + x,a + y,a + z} = IMAGE (\x:real^N. a + x) {x,y,z}`] THEN REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);; add_translation_invariants [WEDGE_TRANSLATION];; let WEDGE_LINEAR_IMAGE = prove (`!f. linear f /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:3) ==> det(matrix f) = &1) ==> !v w w1 w2. wedge (f v) (f w) (f w1) (f w2) = IMAGE f (wedge v w w1 w2)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; ORTHOGONAL_TRANSFORMATION]; ALL_TAC] THEN X_GEN_TAC `y:real^3` THEN REWRITE_TAC[wedge; IN_ELIM_THM] THEN BINOP_TAC THEN ASM_SIMP_TAC[AZIM_LINEAR_IMAGE] THEN SUBST1_TAC(SET_RULE `{f v,f w,f y} = IMAGE (f:real^3->real^3) {v,w,y}`) THEN ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ; PRESERVES_NORM_INJECTIVE]);; add_linear_invariants [WEDGE_LINEAR_IMAGE];; let WEDGE_SPECIAL_SCALE = prove (`!a v w1 w2. &0 < a /\ ~collinear{vec 0,a % v,w1} /\ ~collinear{vec 0,a % v,w2} ==> wedge (vec 0) (a % v) w1 w2 = wedge (vec 0) v w1 w2`, SIMP_TAC[wedge; AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ]);; let WEDGE_DEGENERATE = prove (`(!z w w1 w2. z = w ==> wedge z w w1 w2 = {}) /\ (!z w w1 w2. collinear{z,w,w1} ==> wedge z w w1 w2 = {}) /\ (!z w w1 w2. collinear{z,w,w2} ==> wedge z w w1 w2 = {})`, REWRITE_TAC[wedge] THEN SIMP_TAC[AZIM_DEGENERATE] THEN REWRITE_TAC[REAL_LT_REFL; REAL_LT_ANTISYM; EMPTY_GSPEC]);; (* ------------------------------------------------------------------------- *) (* Basic relation between wedge and aff, so Tarski-type characterization. *) (* ------------------------------------------------------------------------- *) let AFF_GT_LEMMA = prove (`!v1 v2:real^N. &0 < t1 /\ ~(v2 = vec 0) ==> aff_gt {vec 0} {t1 % basis 1, v2} = {a % basis 1 + b % v2 | &0 < a /\ &0 < b}`, REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN REWRITE_TAC[SET_RULE `{a} UNION {b,c} = {a,b,c}`] THEN REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_INSERT; VECTOR_ARITH `vec 0 = a % x <=> a % x = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `&1 - v - v' - v'' = &0 <=> v = &1 - v' - v''`] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?b c a. P a b c)`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `b:real` THEN REWRITE_TAC[VECTOR_ARITH `y - a - b:real^N = vec 0 <=> y = a + b`] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `a * t1:real`; EXISTS_TAC `a / t1:real`] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]);; let WEDGE_LUNE_GT = prove (`!v0 v1 w1 w2. ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} /\ &0 < azim v0 v1 w1 w2 /\ azim v0 v1 w1 w2 < pi ==> wedge v0 v1 w1 w2 = aff_gt {v0,v1} {w1,w2}`, let lemma = prove (`!a x:real^3. (?a. x = a % basis 3) <=> dropout 3 x:real^2 = vec 0`, SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1] THEN MESON_TAC[]) in REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `v0:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w1:real^3`; `w2:real^3`] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN STRIP_TAC THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o rand o snd) THEN SUBGOAL_THEN `~(w1:real^3 = vec 0) /\ ~(w2:real^3 = vec 0) /\ ~(w1 = basis 3) /\ ~(w2 = basis 3)` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN ASM_REWRITE_TAC[DROPOUT_BASIS_3; DROPOUT_0; DROPOUT_MUL; VECTOR_MUL_RZERO]; ALL_TAC] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(DISJ_CASES_THEN (SUBST_ALL_TAC o SYM)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN ASM_REWRITE_TAC[DROPOUT_BASIS_3; DROPOUT_0; DROPOUT_MUL; VECTOR_MUL_RZERO]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN REWRITE_TAC[SET_RULE `{a,b} UNION {c,d} = {a,b,d,c}`] THEN REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `{y | (dropout 3:real^3->real^2) y IN aff_gt {vec 0} {dropout 3 (w1:real^3),dropout 3 (w2:real^3)}}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN REWRITE_TAC[SET_RULE `{a} UNION {b,c} = {a,b,c}`] THEN REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN REWRITE_TAC[REAL_EQ_SUB_RADD; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `&1 = x + v <=> v = &1 - x`] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ d /\ a /\ b`] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c d. P a b c d) <=> (?b c d a. P a b c d)`] THEN REWRITE_TAC[UNWIND_THM2] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[VECTOR_ARITH `y - a - b - c:real^N = vec 0 <=> y - b - c = a`] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; lemma] THEN REWRITE_TAC[DROPOUT_SUB; DROPOUT_MUL] THEN REWRITE_TAC[VECTOR_ARITH `y - a - b:real^2 = vec 0 <=> y = a + b`] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]] THEN MATCH_MP_TAC(SET_RULE `{x | P x} = s ==> {y | P(dropout 3 y)} = {y | dropout 3 y IN s}`) THEN MP_TAC(CONJ (ASSUME `~((dropout 3:real^3->real^2) w1 = vec 0)`) (ASSUME `~((dropout 3:real^3->real^2) w2 = vec 0)`)) THEN UNDISCH_TAC `Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) < pi` THEN UNDISCH_TAC `&0 < Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:complex`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:complex`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN SIMP_TAC[AFF_GT_LEMMA] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN ASM_SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID; CX_INJ] THEN DISCH_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN STRIP_TAC THEN MP_TAC(SPECL [`\t. Arg(Cx t + Cx(&1 - t) * z)`; `&0`; `&1`; `Arg w`] REAL_IVT_DECREASING) THEN REWRITE_TAC[REAL_POS; REAL_SUB_REFL; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[REAL_SUB_RZERO; COMPLEX_ADD_LID; COMPLEX_MUL_LID] THEN ASM_SIMP_TAC[COMPLEX_ADD_RID; ARG_NUM; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; IN_REAL_INTERVAL] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_WITHINREAL_COMPOSE THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN REWRITE_TAC[I_DEF; REAL_CONTINUOUS_WITHIN_ID]; MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]]; MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `{z | &0 <= Im z}` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_WITHIN_UPPERHALF_ARG THEN ASM_CASES_TAC `t = &1` THENL [ASM_REWRITE_TAC[REAL_SUB_REFL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN REWRITE_TAC[IM_ADD; IM_CX; IM_MUL_CX; REAL_ADD_LID; REAL_ENTIRE] THEN ASM_REWRITE_TAC[REAL_SUB_0] THEN ASM_MESON_TAC[ARG_LT_PI; REAL_LT_IMP_NZ; REAL_LT_TRANS]; REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_REAL_INTERVAL] THEN REWRITE_TAC[IN_ELIM_THM; IM_ADD; IM_CX; IM_MUL_CX] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_LID] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[GSYM ARG_LE_PI] THEN ASM_REAL_ARITH_TAC]]; REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` MP_TAC) THEN ASM_CASES_TAC `t = &0` THENL [ASM_REWRITE_TAC[REAL_SUB_RZERO; COMPLEX_ADD_LID; COMPLEX_MUL_LID] THEN ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN ASM_CASES_TAC `t = &1` THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_ADD_RID; ARG_NUM] THEN ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_LE_LT] THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `u = Cx t + Cx(&1 - t) * z` THEN ASM_CASES_TAC `u = Cx(&0)` THENL [ASM_MESON_TAC[ARG_0; REAL_LT_REFL]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `norm(w:complex) / norm(u:complex) * t` THEN EXISTS_TAC `norm(w:complex) / norm(u:complex) * (&1 - t)` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; COMPLEX_NORM_NZ; REAL_SUB_LT] THEN SIMP_TAC[CX_MUL; GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_ADD_LDISTRIB] THEN ASM_REWRITE_TAC[CX_DIV] THEN ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD `~(nu = Cx(&0)) ==> (w = nw / nu * u <=> nu * w = nw * u)`] THEN GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV) [ARG] THEN ASM_REWRITE_TAC[COMPLEX_MUL_AC]]; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `Cx a + Cx b * z = complex(a + b * Re z,b * Im z)` SUBST1_TAC THENL [REWRITE_TAC[COMPLEX_EQ; RE; IM; RE_ADD; IM_ADD; RE_CX; IM_CX; RE_MUL_CX; IM_MUL_CX] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_EQ; IM; IM_CX] THEN SUBGOAL_THEN `&0 < Im z` ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM ARG_LT_PI]; ALL_TAC] THEN ASM_SIMP_TAC[ARG_ATAN_UPPERHALF; REAL_LT_MUL; REAL_LT_IMP_NZ; IM] THEN REWRITE_TAC[RE; REAL_SUB_LT; ATN_BOUNDS] THEN REWRITE_TAC[REAL_ARITH `pi / &2 - x < pi / &2 - y <=> y < x`] THEN REWRITE_TAC[ATN_MONO_LT_EQ] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_MUL] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < z ==> w / z * b * z = b * w`] THEN ASM_REAL_ARITH_TAC]);; let WEDGE_LUNE_GE = prove (`!v0 v1 w1 w2. ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} /\ &0 < azim v0 v1 w1 w2 /\ azim v0 v1 w1 w2 < pi ==> {x | &0 <= azim v0 v1 w1 x /\ azim v0 v1 w1 x <= azim v0 v1 w1 w2} = aff_ge {v0,v1} {w1,w2}`, REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC] THEN NO_TAC; ALL_TAC]) [`v1:real^3 = v0`; `w1:real^3 = v0`; `w2:real^3 = v0`; `w1:real^3 = v1`; `w2:real^3 = v1`] THEN ASM_CASES_TAC `w1:real^3 = w2` THEN ASM_REWRITE_TAC[AZIM_REFL; REAL_LT_REFL] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> (&0 <= x /\ x <= a <=> x = &0 \/ x = a \/ &0 < x /\ x < a)`] THEN MATCH_MP_TAC(SET_RULE `!c. c SUBSET {x | p x} /\ c SUBSET s /\ ({x | ~(~c x ==> ~p x)} UNION {x | ~(~c x ==> ~q x)} UNION ({x | ~c x /\ r x} DIFF c) = s DIFF c) ==> {x | p x \/ q x \/ r x} = s`) THEN EXISTS_TAC `{x:real^3 | collinear {v0,v1,x}}` THEN ASM_SIMP_TAC[IN_ELIM_THM; AZIM_EQ_ALT; AZIM_EQ_0_ALT; GSYM wedge; WEDGE_LUNE_GT] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; AZIM_DEGENERATE]; ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN MATCH_MP_TAC AFFINE_HULL_SUBSET_AFF_GE THEN ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; ALL_TAC] THEN REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC(SET_RULE `(!x. ~c x ==> (p x \/ q x \/ x IN t <=> x IN e)) ==> {x | ~c x /\ p x} UNION {x | ~c x /\ q x} UNION (t DIFF {x | c x}) = e DIFF {x | c x}`) THEN X_GEN_TAC `y:real^3` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[IN_UNION] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_2] THEN ASM_SIMP_TAC[SET_RULE `~(w1 = w2) ==> {w1,w2} DELETE w1 = {w2}`; SET_RULE `~(w1 = w2) ==> {w1,w2} DELETE w2 = {w1}`] THEN REWRITE_TAC[IN_UNION; DISJ_ACI] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o lhand o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o lhand o rand o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[IN_UNION] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_1] THEN REWRITE_TAC[SET_RULE `{a} DELETE a = {}`; AFF_GE_EQ_AFFINE_HULL] THEN ASM_MESON_TAC[COLLINEAR_3_AFFINE_HULL]);; let WEDGE_LUNE = prove (`!v0 v1 w1 w2. ~coplanar{v0,v1,w1,w2} /\ azim v0 v1 w1 w2 < pi ==> wedge v0 v1 w1 w2 = aff_gt {v0,v1} {w1,w2}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WEDGE_LUNE_GT THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`] NOT_COPLANAR_NOT_COLLINEAR) THEN ASM_REWRITE_TAC[]; MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w2:real^3`; `w1:real^3`] NOT_COPLANAR_NOT_COLLINEAR) THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,b,d,c}`] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[azim; REAL_LT_LE] THEN ASM_MESON_TAC[AZIM_EQ_0_PI_IMP_COPLANAR]]);; let WEDGE = prove (`wedge v1 v2 w1 w2 = if collinear{v1,v2,w1} \/ collinear{v1,v2,w2} then {} else let z = v2 - v1 in let u1 = w1 - v1 in let u2 = w2 - v1 in let n = z cross u1 in let d = n dot u2 in if w2 IN (aff_ge {v1,v2} {w1}) then {} else if w2 IN (aff_lt {v1,v2} {w1}) then aff_gt {v1,v2,w1} {v1 + n} else if d > &0 then aff_gt {v1,v2} {w1,w2} else (:real^3) DIFF aff_ge {v1,v2} {w1,w2}`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_SIMP_TAC[WEDGE_DEGENERATE]; POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC] THEN ASM_SIMP_TAC[GSYM AZIM_EQ_0_GE_ALT] THEN ASM_CASES_TAC `azim v1 v2 w1 w2 = &0` THENL [ASM_REWRITE_TAC[wedge] THEN ASM_REWRITE_TAC[REAL_LT_ANTISYM; LET_DEF; LET_END_DEF; EMPTY_GSPEC]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM AZIM_EQ_PI_ALT] THEN ASM_CASES_TAC `azim v1 v2 w1 w2 = pi` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN GEOM_ORIGIN_TAC `v1:real^3` THEN REWRITE_TAC[VECTOR_ADD_RID; TRANSLATION_INVARIANTS `v1:real^3`] THEN REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN GEOM_BASIS_MULTIPLE_TAC 3 `v2:real^3` THEN X_GEN_TAC `v2:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN (STRIP_TAC THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC]) THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ; WEDGE_SPECIAL_SCALE] THEN (REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC] THEN NO_TAC; ALL_TAC]) [`w1:real^3 = vec 0`; `w2:real^3 = vec 0`; `w1:real^3 = basis 3`; `w2:real^3 = basis 3`] THEN ASM_CASES_TAC `w1:real^3 = v2 % basis 3` THENL [ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `w2:real^3 = v2 % basis 3` THENL [ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; ALL_TAC]) THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real^3` THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(dropout 3 (y:real^3)) IN aff_gt {vec 0:real^2,dropout 3 (w1:real^3)} {rotate2d (pi / &2) (dropout 3 (w1:real^3))}` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [AZIM_ARG]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) [AZIM_ARG]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3])) THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[wedge; IN_ELIM_THM; AZIM_ARG; COLLINEAR_BASIS_3] THEN SPEC_TAC(`(dropout 3:real^3->real^2) y`,`x:real^2`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:real^2`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:real^2`) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN X_GEN_TAC `v:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `v = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[ARG_LT_PI; ROTATE2D_PI2] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o rand o snd) THEN ASM_REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; IN_SING] THEN ANTS_TAC THENL [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ] THEN DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN REWRITE_TAC[RE_MUL_II; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[COMPLEX_CMUL; IN_ELIM_THM; COMPLEX_MUL_RZERO] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?b c a. P a b c)`] THEN REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; COMPLEX_ADD_LID] THEN EQ_TAC THENL [DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`Re x / v`; `Im x / v`] THEN ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_EQ; IM_ADD; RE_ADD] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX; RE_II; IM_II] THEN UNDISCH_TAC `~(v = &0)` THEN CONV_TAC REAL_FIELD; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real`; `t:real`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_EQ; IM_ADD; RE_ADD] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX; RE_II; IM_II] THEN ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_MUL_LID; REAL_LT_MUL; REAL_ADD_LID; REAL_MUL_LZERO] THEN MAP_EVERY UNDISCH_TAC [`&0 < v`; `&0 < t`] THEN CONV_TAC REAL_FIELD]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_3_1 o rand o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT {a,b,c} {x} <=> ~(x = a) /\ ~(x = b) /\ ~(x = c)`] THEN ASM_SIMP_TAC[CROSS_EQ_0; CROSS_EQ_SELF; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_3; ARITH; COLLINEAR_SPECIAL_SCALE]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o lhand o snd) THEN REWRITE_TAC[ROTATE2D_PI2] THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_RING `ii * x = x <=> x = Cx(&0)`; COMPLEX_VEC_0; II_NZ] THEN ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM COLLINEAR_BASIS_3]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c d. P a b c d) <=> (?d c b a. P a b c d)`] THEN ONCE_REWRITE_TAC[REAL_ARITH `s + t = &1 <=> s = &1 - t`] THEN REWRITE_TAC[UNWIND_THM2; RIGHT_EXISTS_AND_THM] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN REWRITE_TAC[UNWIND_THM2; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; VECTOR_ADD_COMPONENT; cross; VECTOR_3; REWRITE_RULE[RE_DEF; IM_DEF] RE_MUL_II; REWRITE_RULE[RE_DEF; IM_DEF] IM_MUL_II; REAL_ADD_LID; REAL_MUL_LZERO; REAL_SUB_REFL; REAL_ADD_RID; REAL_SUB_LZERO; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `s:real` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN ASM_SIMP_TAC[EXISTS_REFL; REAL_FIELD `&0 < v ==> (x = a * v + b <=> a = (x - b) / v)`] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_ASSOC] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `t / v2:real`; EXISTS_TAC `t * v2:real`] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_DIV; REAL_LT_IMP_NZ; REAL_LT_MUL]; ALL_TAC] THEN REWRITE_TAC[CROSS_LMUL] THEN SIMP_TAC[cross; BASIS_COMPONENT; DIMINDEX_3; ARITH; DOT_3; VECTOR_3; VECTOR_MUL_COMPONENT; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_NEG_0; REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LID; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `(v * --x2) * y1 + (v * x1) * y2 > &0 <=> &0 < v * (x1 * y2 - x2 * y1)`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_SUB_LT] THEN REWRITE_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN STRIP_TAC THEN SUBGOAL_THEN `w1$2 * w2$1 < w1$1 * w2$2 <=> Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) < pi` SUBST1_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&0 < Im(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN CONJ_TAC THENL [REWRITE_TAC[IM_COMPLEX_DIV_GT_0] THEN REWRITE_TAC[complex_mul; cnj; RE_DEF; IM_DEF; complex] THEN SIMP_TAC[dropout; VECTOR_2; LAMBDA_BETA; DIMINDEX_3; ARITH; DIMINDEX_2] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM ARG_LT_PI] THEN ASM_MESON_TAC[ARG_LT_NZ]]; ALL_TAC] THEN COND_CASES_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o rand o snd) THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WEDGE_LUNE THEN ASM_SIMP_TAC[GSYM AZIM_EQ_0_PI_EQ_COPLANAR; COLLINEAR_BASIS_3] THEN ASM_REWRITE_TAC[AZIM_ARG]; ALL_TAC] THEN REWRITE_TAC[wedge] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [SET_RULE `{a,b} = {b,a}`] THEN W(MP_TAC o PART_MATCH (rand o rand) WEDGE_LUNE_GE o rand o rand o snd) THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ; AZIM_SPECIAL_SCALE] THEN ASM_REWRITE_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[ARG_LT_NZ] THEN ONCE_REWRITE_TAC[GSYM ARG_INV_EQ_0] THEN ASM_REWRITE_TAC[COMPLEX_INV_DIV] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN ASM_SIMP_TAC[ARG_INV; GSYM ARG_EQ_0] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM; ARG] THEN REWRITE_TAC[REAL_NOT_LE] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`w:complex`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`z:complex`) THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `x3:real^3` THEN SPEC_TAC(`(dropout 3:real^3->real^2) x3`,`x:complex`) THEN GEN_TAC THEN REWRITE_TAC[COMPLEX_VEC_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_VEC_0]) THEN ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; REAL_NOT_LT; ARG; ARG_0]; ALL_TAC] THEN ASM_REWRITE_TAC[ARG_LT_NZ] THEN MAP_EVERY UNDISCH_TAC [`~(Arg (z / w) < pi)`; `~(Arg (z / w) = pi)`; `~(Arg (z / w) = &0)`; `~(x = Cx (&0))`; `~(w = Cx (&0))`; `~(z = Cx (&0))`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN SIMP_TAC[complex_div; ARG_MUL_CX] THEN SIMP_TAC[ARG_INV; GSYM ARG_EQ_0; ARG_INV_EQ_0] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM complex_div] THEN ASM_CASES_TAC `Arg x = &0` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ARG_EQ_0]) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[complex_div; CX_INJ] THEN ASM_SIMP_TAC[ARG_MUL_CX; REAL_LT_LE] THEN ASM_SIMP_TAC[ARG_INV; GSYM ARG_EQ_0]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN SIMP_TAC[PI_POS; REAL_ARITH `&0 < pi ==> (~(z = &0) /\ ~(z = pi) /\ ~(z < pi) <=> pi < z)`] THEN STRIP_TAC THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN DISJ_CASES_TAC(REAL_ARITH `Arg z <= Arg x \/ Arg x < Arg z`) THENL [ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_SIMP_TAC[GSYM ARG_LE_DIV_SUM] THEN SIMP_TAC[ARG; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`x:complex`; `z:complex`] ARG_LE_DIV_SUM) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(x = &0) /\ y = k - z ==> k < y + x + z`) THEN ASM_REWRITE_TAC[ARG] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_INV_DIV] THEN MATCH_MP_TAC ARG_INV THEN REWRITE_TAC[REAL] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ABBREV_TAC `t = Re(z / x)` THEN UNDISCH_TAC `Arg x < Arg z` THEN UNDISCH_TAC `z / x = Cx t` THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(x = Cx(&0)) ==> (z / x = t <=> z = t * x)`] THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO] THEN ASM_SIMP_TAC[ARG_MUL_CX; REAL_LT_LE]);; let OPEN_WEDGE = prove (`!z:real^3 w w1 w2. open(wedge z w w1 w2)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `z:real^3 = w \/ collinear{z,w,w1} \/ collinear{z,w,w2}` THENL [FIRST_X_ASSUM STRIP_ASSUME_TAC THEN ASM_SIMP_TAC[WEDGE_DEGENERATE; OPEN_EMPTY]; FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM]] THEN REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `z:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN MATCH_MP_TAC OPEN_DROPOUT_3 THEN UNDISCH_TAC `~((dropout 3:real^3->real^2) w1 = vec 0)` THEN UNDISCH_TAC `~((dropout 3:real^3->real^2) w2 = vec 0)` THEN SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:complex`) THEN SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:complex`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `{x | ~(x = a) /\ P x} = {x | P x} DIFF {a}`] THEN MATCH_MP_TAC OPEN_DIFF THEN REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC OPEN_ARG_LTT THEN SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL; ARG]);; let ARG_EQ_SUBSET_HALFLINE = prove (`!a. ?b. ~(b = vec 0) /\ {z | Arg z = a} SUBSET aff_ge {vec 0} {b}`, GEN_TAC THEN ASM_CASES_TAC `{z | Arg z = a} SUBSET {vec 0}` THENL [EXISTS_TAC `basis 1:real^2` THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_2; ARITH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN SIMP_TAC[SUBSET; IN_SING; ENDS_IN_HALFLINE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s SUBSET {a}) ==> ?z. ~(a = z) /\ z IN s`)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:complex` THEN ASM_CASES_TAC `x:complex = vec 0` THEN ASM_REWRITE_TAC[ENDS_IN_HALFLINE] THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_VEC_0]) THEN ASM_SIMP_TAC[ARG_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[GSYM COMPLEX_CMUL] THEN REWRITE_TAC[HALFLINE_EXPLICIT; IN_ELIM_THM; VECTOR_MUL_RZERO] THEN MAP_EVERY EXISTS_TAC [`&1 - u`; `u:real`] THEN ASM_SIMP_TAC[VECTOR_ADD_LID; REAL_LT_IMP_LE] THEN ASM_REAL_ARITH_TAC);; let ARG_DIV_EQ_SUBSET_HALFLINE = prove (`!w a. ~(w = vec 0) ==> ?b. ~(b = vec 0) /\ {z | Arg(z / w) = a} SUBSET aff_ge {vec 0} {b}`, REPEAT GEN_TAC THEN GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_LT] THEN DISCH_TAC THEN X_GEN_TAC `a:real` THEN DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[ARG_DIV_CX; COMPLEX_CMUL; COMPLEX_BASIS; GSYM CX_MUL; REAL_MUL_RID; ARG_EQ_SUBSET_HALFLINE]);; let COPLANAR_AZIM_EQ = prove (`!v0 v1 w1 a. (collinear{v0,v1,w1} ==> ~(a = &0)) ==> coplanar {z | azim v0 v1 w1 z = a}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `collinear{v0:real^3,v1,w1}` THENL [ASM_SIMP_TAC[azim_def; EMPTY_GSPEC; COPLANAR_EMPTY]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `v0:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN X_GEN_TAC `v1:real` THEN ASM_CASES_TAC `v1 = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LT; COLLINEAR_SPECIAL_SCALE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3]) THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^2` STRIP_ASSUME_TAC o SPEC `a:real` o MATCH_MP ARG_DIV_EQ_SUBSET_HALFLINE) THEN REWRITE_TAC[coplanar] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^3`; `pushin 3 (&0) (b:real^2):real^3`; `basis 3:real^3`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[AFFINE_HULL_3; HALFLINE; SUBSET; IN_ELIM_THM] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real^3` THEN DISCH_TAC THEN MP_TAC(SPEC `(dropout 3:real^3->real^2) x` th)) THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`&1 - v - (x:real^3)$3`; `v:real`; `(x:real^3)$3`] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; LAMBDA_BETA; dropout; pushin; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; ARITH; BASIS_COMPONENT] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Volume of a tetrahedron defined by conv0. *) (* ------------------------------------------------------------------------- *) let delta_x = new_definition `delta_x x1 x2 x3 x4 x5 x6 = x1*x4*(--x1 + x2 + x3 -x4 + x5 + x6) + x2*x5*(x1 - x2 + x3 + x4 -x5 + x6) + x3*x6*(x1 + x2 - x3 + x4 + x5 - x6) -x2*x3*x4 - x1*x3*x5 - x1*x2*x6 -x4*x5*x6:real`;; let VOLUME_OF_CLOSED_TETRAHEDRON = prove (`!x1 x2 x3 x4:real^3. measure(convex hull {x1,x2,x3,x4}) = sqrt(delta_x (dist(x1,x2) pow 2) (dist(x1,x3) pow 2) (dist(x1,x4) pow 2) (dist(x3,x4) pow 2) (dist(x2,x4) pow 2) (dist(x2,x3) pow 2)) / &12`, REPEAT GEN_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN REWRITE_TAC[MEASURE_TETRAHEDRON] THEN REWRITE_TAC[REAL_ARITH `x / &6 = y / &12 <=> y = &2 * x`] THEN MATCH_MP_TAC SQRT_UNIQUE THEN SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; REAL_POS] THEN REWRITE_TAC[REAL_POW_MUL; REAL_POW2_ABS; delta_x] THEN REWRITE_TAC[dist; NORM_POW_2] THEN SIMP_TAC[DOT_3; VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH] THEN CONV_TAC REAL_RING);; let VOLUME_OF_TETRAHEDRON = prove (`!v1 v2 v3 v4:real^3. measure(conv0 {v1,v2,v3,v4}) = let x12 = dist(v1,v2) pow 2 in let x13 = dist(v1,v3) pow 2 in let x14 = dist(v1,v4) pow 2 in let x23 = dist(v2,v3) pow 2 in let x24 = dist(v2,v4) pow 2 in let x34 = dist(v3,v4) pow 2 in sqrt(delta_x x12 x13 x14 x34 x24 x23)/(&12)`, REPEAT GEN_TAC THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_SIMP_TAC[GSYM VOLUME_OF_CLOSED_TETRAHEDRON] THEN MATCH_MP_TAC MEASURE_CONV0_CONVEX_HULL THEN SIMP_TAC[DIMINDEX_3; FINITE_INSERT; FINITE_EMPTY; CARD_CLAUSES] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Circle area. Should maybe extend WLOG tactics for such scaling. *) (* ------------------------------------------------------------------------- *) let AREA_UNIT_CBALL = prove (`measure(cball(vec 0:real^2,&1)) = pi`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE[`:1`,`:M`; `:2`,`:N`] FUBINI_SIMPLE_COMPACT) THEN EXISTS_TAC `1` THEN SIMP_TAC[DIMINDEX_1; DIMINDEX_2; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN SUBGOAL_THEN `!t. abs(t) <= &1 <=> t IN real_interval[-- &1,&1]` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; BALL_1] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. &2 * sqrt(&1 - t pow 2)` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN SIMP_TAC[IN_REAL_INTERVAL; MEASURE_INTERVAL] THEN REWRITE_TAC[REAL_BOUNDS_LE; VECTOR_ADD_LID; VECTOR_SUB_LZERO] THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) CONTENT_1 o rand o snd) THEN REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[REAL_POW_ONE] THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> --x <= x`) THEN ASM_SIMP_TAC[SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. asn(x) + x * sqrt(&1 - x pow 2)`; `\x. &2 * sqrt(&1 - x pow 2)`; `-- &1`; `&1`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN REWRITE_TAC[ASN_1; ASN_NEG_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_0; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `x / &2 - --(x / &2) = x`] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN SIMP_TAC[REAL_CONTINUOUS_ON_ASN; IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_POW; REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SQRT THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN REWRITE_TAC[REAL_ARITH `&0 <= &1 - x <=> x <= &1 pow 2`] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM] THEN REAL_ARITH_TAC; REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LT] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID; REAL_POW_1; REAL_MUL_RID] THEN REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RNEG; REAL_INV_MUL] THEN ASM_REWRITE_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1] THEN MATCH_MP_TAC(REAL_FIELD `s pow 2 = &1 - x pow 2 /\ x pow 2 < &1 ==> (inv s + x * --(&2 * x) * inv (&2) * inv s + s) = &2 * s`) THEN ASM_SIMP_TAC[ABS_SQUARE_LT_1; SQRT_POW_2; REAL_SUB_LE; REAL_LT_IMP_LE]]);; let AREA_CBALL = prove (`!z:real^2 r. &0 <= r ==> measure(cball(z,r)) = pi * r pow 2`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `r = &0` THENL [ASM_SIMP_TAC[CBALL_SING; REAL_POW_2; REAL_MUL_RZERO] THEN MATCH_MP_TAC MEASURE_UNIQUE THEN REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_SING]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`cball(vec 0:real^2,&1)`; `r:real`; `z:real^2`; `pi`] HAS_MEASURE_AFFINITY) THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_CBALL; AREA_UNIT_CBALL] THEN ASM_REWRITE_TAC[real_abs; DIMINDEX_2] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_CBALL_0; IN_IMAGE] THEN REWRITE_TAC[IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(z,a + z) = norm a`; NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `abs r * x <= r <=> abs r * x <= r * &1`] THEN ASM_SIMP_TAC[real_abs; REAL_LE_LMUL; dist] THEN X_GEN_TAC `w:real^2` THEN DISCH_TAC THEN EXISTS_TAC `inv(r) % (w - z):real^2` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_REWRITE_TAC[real_abs] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[]);; let AREA_BALL = prove (`!z:real^2 r. &0 <= r ==> measure(ball(z,r)) = pi * r pow 2`, SIMP_TAC[GSYM INTERIOR_CBALL; GSYM AREA_CBALL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; (* ------------------------------------------------------------------------- *) (* Volume of a ball. *) (* ------------------------------------------------------------------------- *) let VOLUME_CBALL = prove (`!z:real^3 r. &0 <= r ==> measure(cball(z,r)) = &4 / &3 * pi * r pow 3`, GEOM_ORIGIN_TAC `z:real^3` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_COMPACT) THEN EXISTS_TAC `1` THEN SIMP_TAC[DIMINDEX_2; DIMINDEX_3; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN SUBGOAL_THEN `!t. abs(t) <= r <=> t IN real_interval[--r,r]` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`]; ALL_TAC] THEN MP_TAC(ISPECL [`\t. pi * (r pow 2 * t - &1 / &3 * t pow 3)`; `\t. pi * (r pow 2 - t pow 2)`; `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC REAL_RING]);; let VOLUME_BALL = prove (`!z:real^3 r. &0 <= r ==> measure(ball(z,r)) = &4 / &3 * pi * r pow 3`, SIMP_TAC[GSYM INTERIOR_CBALL; GSYM VOLUME_CBALL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; (* ------------------------------------------------------------------------- *) (* Frustum. *) (* ------------------------------------------------------------------------- *) let rconesgn = new_definition `rconesgn sgn v w h = {x:real^A | sgn ((x-v) dot (w-v)) (dist(x,v)*dist(w,v)*h)}`;; let rcone_gt = new_definition `rcone_gt = rconesgn ( > )`;; let rcone_ge = new_definition `rcone_ge = rconesgn ( >= )`;; let rcone_eq = new_definition `rcone_eq = rconesgn ( = )`;; let frustum = new_definition `frustum v0 v1 h1 h2 a = { y:real^N | rcone_gt v0 v1 a y /\ let d = (y - v0) dot (v1 - v0) in let n = norm(v1 - v0) in (h1*n < d /\ d < h2*n)}`;; let frustt = new_definition `frustt v0 v1 h a = frustum v0 v1 (&0) h a`;; let FRUSTUM_DEGENERATE = prove (`!v0 h1 h2 a. frustum v0 v0 h1 h2 a = {}`, REWRITE_TAC[frustum; VECTOR_SUB_REFL; NORM_0; DOT_RZERO] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL] THEN SET_TAC[]);; let CONVEX_RCONE_GT = prove (`!v0 v1:real^N a. &0 <= a ==> convex(rcone_gt v0 v1 a)`, REWRITE_TAC[rcone_gt; rconesgn] THEN GEOM_ORIGIN_TAC `v0:real^N` THEN REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN REWRITE_TAC[CONVEX_ALT; IN_ELIM_THM; real_gt; DOT_LADD; DOT_LMUL] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `t:real`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(&1 - t) * norm(x:real^N) * norm v1 * a + t * norm(y:real^N) * norm(v1:real^N) * a` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) = a /\ norm(y) = b ==> norm(x + y) <= a + b`) THEN REWRITE_TAC[NORM_MUL] THEN CONJ_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_CONVEX_BOUND2_LT THEN ASM_REAL_ARITH_TAC]);; let OPEN_RCONE_GT = prove (`!v0 v1:real^N a. open(rcone_gt v0 v1 a)`, REWRITE_TAC[rcone_gt; rconesgn] THEN GEOM_ORIGIN_TAC `v0:real^N` THEN REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN MP_TAC(ISPECL [`\x:real^N. lift(x dot v1 - norm x * norm v1 * a)`; `{x:real^1 | x$1 > &0}`] CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT] THEN REWRITE_TAC[GSYM drop] THEN REWRITE_TAC[IN_ELIM_THM; real_gt; REAL_SUB_LT; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN REWRITE_TAC[LIFT_SUB] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN ONCE_REWRITE_TAC[DOT_SYM] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]);; let RCONE_GT_NEG = prove (`!v0 v1:real^N a. rcone_gt v0 v1 (--a) = IMAGE (\x. &2 % v0 - x) ((:real^N) DIFF rcone_ge v0 v1 a)`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[VECTOR_ARITH `a - (a - b):real^N = b`]; REWRITE_TAC[rcone_gt; rconesgn; rcone_ge; IN_ELIM_THM; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[NORM_ARITH `dist(&2 % x - y,x) = dist(y,x)`] THEN REWRITE_TAC[VECTOR_ARITH `&2 % v - x - v:real^N = --(x - v)`] THEN REWRITE_TAC[DOT_LNEG] THEN REAL_ARITH_TAC]);; let VOLUME_FRUSTT_STRONG = prove (`!v0 v1:real^3 h a. &0 < a ==> bounded(frustt v0 v1 h a) /\ convex(frustt v0 v1 h a) /\ measurable(frustt v0 v1 h a) /\ measure(frustt v0 v1 h a) = if v1 = v0 \/ &1 <= a \/ h < &0 then &0 else pi * ((h / a) pow 2 - h pow 2) * h / &3`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[frustt; frustum; rcone_gt; rconesgn; IN_ELIM_THM] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:real^3` THEN X_GEN_TAC `b:real` THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `&0 <= x ==> x = &0 \/ &0 < x`)) THEN ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL; MEASURABLE_EMPTY; MEASURE_EMPTY; EMPTY_GSPEC; VECTOR_MUL_LZERO; BOUNDED_EMPTY; CONVEX_EMPTY] THEN ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `!y:real^3. ~(norm(y) * norm(b % basis 1:real^3) * a < y dot (b % basis 1))` (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY; MEASURE_EMPTY]) THEN REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN REWRITE_TAC[REAL_ARITH `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DOT_BASIS; DOT_RMUL; DIMINDEX_3; ARITH] THEN ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN REWRITE_TAC[REAL_ARITH `(&0 * x < y /\ u < v) /\ &0 < y /\ y < h <=> &0 < y /\ y < h /\ u < v`] THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^3,h / a)` THEN REWRITE_TAC[BOUNDED_BALL; IN_BALL_0; SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[NORM_LT_SQUARE] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN X_GEN_TAC `x:real^3` THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} = {x | Q x} INTER {x | P x /\ R x}`] THEN REWRITE_TAC[REAL_ARITH `&0 < y <=> y > &0`] THEN MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_LT] THEN MP_TAC(ISPECL [`vec 0:real^3`; `basis 1:real^3`; `a:real`] CONVEX_RCONE_GT) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; rcone_gt; rconesgn] THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN REWRITE_TAC[real_gt; REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN REWRITE_TAC[NORM_LT_SQUARE] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN REWRITE_TAC[REAL_MUL_LZERO]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_CONVEX_STRONG) THEN EXISTS_TAC `1` THEN REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SLICE_312; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; VECTOR_3; DOT_3; GSYM DOT_2] THEN SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; ALL_TAC] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. if &0 < t /\ t < h then pi * (inv(a pow 2) - &1) * t pow 2 else &0` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_GSPEC; CONJ_ASSOC; MEASURE_EMPTY; MEASURABLE_EMPTY] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure(ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t))` THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; SQRT_POS_LT; REAL_LT_MUL] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE; REAL_POW_MUL]; AP_TERM_TAC THEN REWRITE_TAC[IN_BALL_0; EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[NORM_LT_SQUARE] THEN ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE; REAL_LT_MUL; REAL_POW_MUL; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[REAL_INTERVAL_EQ_EMPTY; HAS_REAL_INTEGRAL_EMPTY]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN MP_TAC(ISPECL [`\t. pi / &3 * (inv (a pow 2) - &1) * t pow 3`; `\t. pi * (inv (a pow 2) - &1) * t pow 2`; `&0`; `h:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]);; let VOLUME_FRUSTT = prove (`!v0 v1:real^3 h a. &0 < a ==> measurable(frustt v0 v1 h a) /\ measure(frustt v0 v1 h a) = if v1 = v0 \/ &1 <= a \/ h < &0 then &0 else pi * ((h / a) pow 2 - h pow 2) * h / &3`, SIMP_TAC[VOLUME_FRUSTT_STRONG]);; (* ------------------------------------------------------------------------- *) (* Ellipsoid. *) (* ------------------------------------------------------------------------- *) let scale = new_definition `scale (t:real^3) (u:real^3):real^3 = vector[t$1 * u$1; t$2 * u$2; t$3 * u$3]`;; let normball = new_definition `normball x r = { y:real^A | dist(y,x) < r}`;; let ellipsoid = new_definition `ellipsoid t r = IMAGE (scale t) (normball(vec 0) r)`;; let NORMBALL_BALL = prove (`!z r. normball z r = ball(z,r)`, REWRITE_TAC[normball; ball; DIST_SYM]);; let MEASURE_SCALE = prove (`!s. measurable s ==> measurable(IMAGE (scale t) s) /\ measure(IMAGE (scale t) s) = abs(t$1 * t$2 * t$3) * measure s`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURE] THEN DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i` o MATCH_MP HAS_MEASURE_STRETCH) THEN REWRITE_TAC[DIMINDEX_3; PRODUCT_3] THEN SUBGOAL_THEN `(\x:real^3. (lambda k. t$k * x$k):real^3) = scale t` SUBST1_TAC THENL [SIMP_TAC[CART_EQ; FUN_EQ_THM; scale; LAMBDA_BETA; DIMINDEX_3; VECTOR_3; ARITH; FORALL_3]; MESON_TAC[measurable; MEASURE_UNIQUE]]);; let MEASURE_ELLIPSOID = prove (`!t r. &0 <= r ==> measurable(ellipsoid t r) /\ measure(ellipsoid t r) = abs(t$1 * t$2 * t$3) * &4 / &3 * pi * r pow 3`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `vec 0:real^3` o MATCH_MP VOLUME_BALL) THEN REWRITE_TAC[normball; ellipsoid] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM ball] THEN MATCH_MP_TAC MEASURE_SCALE THEN REWRITE_TAC[MEASURABLE_BALL]);; let MEASURABLE_ELLIPSOID = prove (`!t r. measurable(ellipsoid t r)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= r` THEN ASM_SIMP_TAC[MEASURE_ELLIPSOID] THEN REWRITE_TAC[ellipsoid; NORMBALL_BALL; IMAGE; IN_BALL_0] THEN ASM_SIMP_TAC[NORM_ARITH `~(&0 <= r) ==> ~(norm(x:real^3) < r)`] THEN REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Conic cap. *) (* ------------------------------------------------------------------------- *) let conic_cap = new_definition `conic_cap v0 v1 r a = normball v0 r INTER rcone_gt v0 v1 a`;; let CONIC_CAP_DEGENERATE = prove (`!v0 r a. conic_cap v0 v0 r a = {}`, REWRITE_TAC[conic_cap; rcone_gt; rconesgn; VECTOR_SUB_REFL] THEN REWRITE_TAC[DIST_REFL; DOT_RZERO; REAL_MUL_RZERO; REAL_MUL_LZERO] THEN REWRITE_TAC[real_gt; REAL_LT_REFL] THEN SET_TAC[]);; let BOUNDED_CONIC_CAP = prove (`!v0 v1:real^3 r a. bounded(conic_cap v0 v1 r a)`, REPEAT GEN_TAC THEN REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(v0:real^3,r)` THEN REWRITE_TAC[BOUNDED_BALL] THEN SET_TAC[]);; let MEASURABLE_CONIC_CAP = prove (`!v0 v1:real^3 r a. measurable(conic_cap v0 v1 r a)`, REPEAT GEN_TAC THEN REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN MATCH_MP_TAC MEASURABLE_OPEN THEN SIMP_TAC[OPEN_INTER; OPEN_RCONE_GT; OPEN_BALL] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(v0:real^3,r)` THEN REWRITE_TAC[BOUNDED_BALL] THEN SET_TAC[]);; let VOLUME_CONIC_CAP_STRONG = prove (`!v0 v1:real^3 r a. &0 < a ==> bounded(conic_cap v0 v1 r a) /\ convex(conic_cap v0 v1 r a) /\ measurable(conic_cap v0 v1 r a) /\ measure(conic_cap v0 v1 r a) = if v1 = v0 \/ &1 <= a \/ r < &0 then &0 else &2 / &3 * pi * (&1 - a) * r pow 3`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[conic_cap; rcone_gt; rconesgn; IN_ELIM_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] normball; GSYM ball] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:real^3` THEN X_GEN_TAC `b:real` THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `&0 <= x ==> x = &0 \/ &0 < x`)) THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; GSYM REAL_NOT_LE; DOT_RZERO] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; NORM_POS_LE] THEN REWRITE_TAC[EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY; MEASURABLE_EMPTY; CONVEX_EMPTY; BOUNDED_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `!y:real^3. ~(norm(y) * norm(b % basis 1:real^3) * a < y dot (b % basis 1))` (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY; MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]) THEN REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN REWRITE_TAC[REAL_ARITH `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_NORM; DOT_BASIS; DIMINDEX_3; ARITH; NORM_BASIS] THEN ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN REWRITE_TAC[INTER; REAL_MUL_LZERO; IN_BALL_0; IN_ELIM_THM] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; REAL_LT_IMP_NZ] THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x < r)`] THEN REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]; RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_NOT_LT])] THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c /\ d) ==> a /\ b /\ c /\ d`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^3,r)` THEN SIMP_TAC[BOUNDED_BALL; IN_BALL_0; SUBSET; IN_ELIM_THM]; ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[GSYM IN_BALL_0; CONVEX_BALL; SIMPLE_IMAGE; IMAGE_ID] THEN MP_TAC(ISPECL [`vec 0:real^3`; `basis 1:real^3`; `a:real`] CONVEX_RCONE_GT) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; rcone_gt; rconesgn] THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN REWRITE_TAC[real_gt; REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN REWRITE_TAC[NORM_LT_SQUARE] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN REWRITE_TAC[REAL_MUL_LZERO]; STRIP_TAC] THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_CONVEX_STRONG) THEN EXISTS_TAC `1` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN SIMP_TAC[SLICE_312; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; VECTOR_3; DOT_3; GSYM DOT_2] THEN SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; ALL_TAC] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. if &0 < t /\ t < r then measure {y:real^2 | norm(vector[t; y$1; y$2]:real^3) pow 2 < r pow 2 /\ (t * t + y dot y) * a pow 2 < t pow 2} else &0` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ASM_CASES_TAC `&0 < t` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY] THEN ASM_CASES_TAC `t:real < r` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[NORM_LT_SQUARE] THEN SUBGOAL_THEN `&0 < r` (fun th -> REWRITE_TAC[th; NORM_POW_2]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!y. ~(norm(vector[t; (y:real^2)$1; y$2]:real^3) < r)` (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY]) THEN ASM_REWRITE_TAC[NORM_LT_SQUARE; DOT_3; VECTOR_3] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= b /\ c <= d ==> ~(&0 < r /\ d + a + b < c)`) THEN REWRITE_TAC[REAL_LE_SQUARE] THEN REWRITE_TAC[REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN REWRITE_TAC[NORM_POW_2; DOT_3; VECTOR_3; DOT_2] THEN ONCE_REWRITE_TAC[REAL_ARITH `pi * &2 / &3 * (&1 - a) * r pow 3 = pi / &3 * (inv (a pow 2) - &1) * (a * r) pow 3 + (pi * &2 / &3 * (&1 - a) * r pow 3 - pi / &3 * (inv (a pow 2) - &1) * (a * r) pow 3)`] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN EXISTS_TAC `a * r:real` THEN REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. measure(ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t))` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN_BALL_0; NORM_LT_SQUARE_ALT] THEN ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_MUL; SQRT_POW_2; REAL_LT_IMP_LE; REAL_POW_MUL] THEN REWRITE_TAC[REAL_ARITH `x < (a - &1) * t <=> t + x < t * a`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN X_GEN_TAC `x:real^2` THEN REWRITE_TAC[DOT_2] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN MATCH_MP_TAC(REAL_ARITH `b <= a ==> (x < b <=> x < a /\ x < b)`) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; GSYM REAL_POW_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. pi * (inv(a pow 2) - &1) * t pow 2` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN ASM_SIMP_TAC[REAL_POW_MUL; REAL_LT_IMP_LE; SQRT_POS_LT; REAL_LE_MUL; SQRT_POW_2]; ALL_TAC] THEN MP_TAC(ISPECL [`\t. pi / &3 * (inv (a pow 2) - &1) * t pow 3`; `\t. pi * (inv (a pow 2) - &1) * t pow 2`; `&0`; `a * r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]; MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. measure(ball(vec 0:real^2,sqrt(r pow 2 - t pow 2)))` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN_BALL_0; NORM_LT_SQUARE_ALT] THEN SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE2] THEN X_GEN_TAC `x:real^2` THEN REWRITE_TAC[DOT_2] THEN REWRITE_TAC[REAL_ARITH `x < r - t <=> t + x < r`] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> (x < a <=> x < a /\ x < b)`) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT; GSYM REAL_POW_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_POW_LE2; REAL_LE_MUL; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE2]; ALL_TAC] THEN MP_TAC(ISPECL [`\t. pi * (r pow 2 * t - t pow 3 / &3)`; `\t. pi * (r pow 2 - t pow 2)`; `a * r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]);; let VOLUME_CONIC_CAP = prove (`!v0 v1:real^3 r a. &0 < a ==> measurable(conic_cap v0 v1 r a) /\ measure(conic_cap v0 v1 r a) = if v1 = v0 \/ &1 <= a \/ r < &0 then &0 else &2 / &3 * pi * (&1 - a) * r pow 3`, SIMP_TAC[VOLUME_CONIC_CAP_STRONG]);; (* ------------------------------------------------------------------------- *) (* Negligibility of a circular cone. *) (* This isn't exactly using the Flyspeck definition of "cone" but we use it *) (* to get that later on. Could now simplify this using WLOG tactics. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL = prove (`!c:real^N k. ~(c = vec 0) /\ ~(k = &0) /\ ~(k = pi) ==> negligible {x | vector_angle c x = k}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `(vec 0:real^N) INSERT UNIONS { {x | x IN ((:real^N) DIFF ball(vec 0,inv(&n + &1))) /\ Cx(vector_angle c x) = Cx k} | n IN (:num) }` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_INSERT; IN_UNIONS; IN_ELIM_THM; CX_INJ] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIV] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; IN_DIFF; IN_UNIV] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC(SPEC `norm(x:real^N)` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[NORM_POS_LT; IN_BALL_0; REAL_NOT_LT; REAL_LT_INV_EQ] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&n)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[NEGLIGIBLE_INSERT] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN EXISTS_TAC `c:real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN SIMP_TAC[CLOSED_DIFF; CLOSED_UNIV; OPEN_BALL] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_CX_VECTOR_ANGLE) THEN REWRITE_TAC[IN_DIFF; IN_BALL_0; NORM_0; IN_UNIV] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `x:real^N`] THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV; IN_DIFF; IN_BALL_0; REAL_NOT_LT; CX_INJ] THEN REWRITE_TAC[DE_MORGAN_THM] THEN ASM_CASES_TAC `(c + x:real^N) = vec 0` THENL [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_INV_EQ; NORM_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `c + a % x:real^N = vec 0` THENL [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_INV_EQ; NORM_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ANGLE_REFL]; ALL_TAC] THEN ASM_CASES_TAC `a = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_ANGLE_REFL]; ALL_TAC] THEN REWRITE_TAC[TAUT `~a \/ ~b <=> a ==> ~b`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`vec 0:real^N`; `c:real^N`; `c + a % x:real^N`; `vec 0:real^N`; `c:real^N`; `c + x:real^N`] CONGRUENT_TRIANGLES_ASA_FULL) THEN REWRITE_TAC[angle; VECTOR_ADD_SUB] THEN ASM_SIMP_TAC[VECTOR_SUB_RZERO] THEN REWRITE_TAC[NORM_ARITH `dist(x,x + a) = norm(a)`; NORM_MUL] THEN REWRITE_TAC[REAL_FIELD `a * x = x <=> a = &1 \/ x = &0`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= a /\ a < &1 ==> ~(abs a = &1)`] THEN ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_ANGLE_RMUL; COLLINEAR_LEMMA] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; VECTOR_MUL_LID; REAL_MUL_LINV] THEN REWRITE_TAC[VECTOR_ARITH `a % c + x = b % c <=> x = (b - a) % c`] THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_ARITH `c + a % c = (a + &1) % c`]) THEN UNDISCH_TAC `vector_angle c ((inv a * u - inv a + &1) % c:real^N) = k` THEN RULE_ASSUM_TAC(REWRITE_RULE [VECTOR_ANGLE_RMUL; VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN ASM_REWRITE_TAC[VECTOR_ANGLE_RMUL; VECTOR_ANGLE_REFL] THEN ASM_REAL_ARITH_TAC);; let NEGLIGIBLE_CIRCULAR_CONE_0 = prove (`!c:real^N k. 2 <= dimindex(:N) /\ ~(c = vec 0) ==> negligible {x | vector_angle c x = k}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `orthogonal (basis 1:real^N) (basis 2)` ASSUME_TAC THENL [ASM_SIMP_TAC[ORTHOGONAL_BASIS_BASIS; ARITH; ARITH_RULE `2 <= d ==> 1 <= d`]; ALL_TAC] THEN ASM_CASES_TAC `k = &0 \/ k = pi` THENL [ALL_TAC; ASM_MESON_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL]] THEN SUBGOAL_THEN `?b:real^N. ~(b = vec 0) /\ ~(vector_angle c b = &0) /\ ~(vector_angle c b = pi)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MESON[] `!a b. P a \/ P b ==> ?x. P x`) THEN MAP_EVERY EXISTS_TAC [`basis 1:real^N`; `basis 2:real^N`] THEN REWRITE_TAC[BASIS_EQ_0] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= d ==> 1 <= d`; IN_NUMSEG; ARITH] THEN REWRITE_TAC[GSYM DE_MORGAN_THM] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `basis 1:real^N` o MATCH_MP VECTOR_ANGLE_EQ_0_LEFT)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `basis 1:real^N` o MATCH_MP VECTOR_ANGLE_EQ_PI_LEFT)) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_ANGLE_REFL; BASIS_EQ_0] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= d ==> 1 <= d`; IN_NUMSEG; ARITH] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ORTHOGONAL_VECTOR_ANGLE]) THEN REWRITE_TAC[VECTOR_ANGLE_SYM] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k = &0 \/ k = pi` THENL [ALL_TAC; ASM_MESON_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL]] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC) THENL [EXISTS_TAC `{x:real^N | vector_angle b x = vector_angle c b}` THEN ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ANGLE_EQ_0_RIGHT; VECTOR_ANGLE_SYM]; EXISTS_TAC `{x:real^N | vector_angle b x = pi - vector_angle c b}` THEN ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL; REAL_SUB_0; REAL_ARITH `p - x = p <=> x = &0`] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; VECTOR_ANGLE_SYM]]);; let NEGLIGIBLE_CIRCULAR_CONE = prove (`!a:real^N c k. 2 <= dimindex(:N) /\ ~(c = vec 0) ==> negligible(a INSERT {x | vector_angle c (x - a) = k})`, REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_INSERT] THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN EXISTS_TAC `--a:real^N` THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | vector_angle c x = k}` THEN ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`]);; let NEGLIGIBLE_RCONE_EQ = prove (`!w z:real^3 h. ~(w = z) ==> negligible(rcone_eq z w h)`, REWRITE_TAC[rcone_eq; rconesgn] THEN GEOM_ORIGIN_TAC `z:real^3` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_0; VECTOR_SUB_RZERO] THEN ASM_CASES_TAC `abs(h) <= &1` THENL [MP_TAC(ISPECL [`w:real^3`; `acs h`] NEGLIGIBLE_CIRCULAR_CONE_0) THEN ASM_REWRITE_TAC[DIMINDEX_3; ARITH] THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_MEASURE_NEGLIGIBLE_SYMDIFF) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{vec 0:real^3}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN MATCH_MP_TAC(SET_RULE `(!x. ~(x = a) ==> (x IN s <=> x IN t)) ==> (s DIFF t) UNION (t DIFF s) SUBSET {a}`) THEN X_GEN_TAC `x:real^3` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[vector_angle] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD `~(x = &0) /\ ~(w = &0) ==> (a = x * w * b <=> a / (w * x) = b)`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [DOT_SYM] THEN MATCH_MP_TAC ACS_INJ THEN ASM_REWRITE_TAC[NORM_CAUCHY_SCHWARZ_DIV]; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{vec 0}:real^3->bool` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN REWRITE_TAC[SET_RULE `{x | P x} SUBSET {a} <=> !x. ~(x = a) ==> ~P x`] THEN X_GEN_TAC `x:real^3` THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`x:real^3`; `w:real^3`] NORM_CAUCHY_SCHWARZ_ABS) THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; REAL_ARITH `~(x * w * h <= x * w) <=> &0 < x * w * (h - &1)`] THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[NORM_POS_LT]) THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Area of sector of a circle delimited by Arg values. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_ARG_EQ = prove (`!t. negligible {z | Arg z = t}`, GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{z | cexp(ii * Cx(pi / &2 + t)) dot z = &0}` THEN SIMP_TAC[NEGLIGIBLE_HYPERPLANE; COMPLEX_VEC_0; CEXP_NZ] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM COMPLEX_CMUL; DOT_RMUL; REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[CEXP_EULER] THEN REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[GSYM CX_SIN; GSYM CX_COS; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN REWRITE_TAC[SIN_ADD; COS_ADD; SIN_PI2; COS_PI2] THEN REAL_ARITH_TAC);; let MEASURABLE_CLOSED_SECTOR_LE = prove (`!r t. measurable {z | norm(z) <= r /\ Arg z <= t}`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN REWRITE_TAC[SET_RULE `{z | P z /\ Q z} = {z | P z} INTER {z | Q z}`] THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_ARG_LE] THEN REWRITE_TAC[NORM_ARITH `norm z = dist(vec 0,z)`; GSYM cball] THEN REWRITE_TAC[COMPACT_CBALL]);; let MEASURABLE_CLOSED_SECTOR_LT = prove (`!r t. measurable {z | norm(z) <= r /\ Arg z < t}`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF THEN EXISTS_TAC `{z | norm(z) <= r /\ Arg z <= t}` THEN REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{z | Arg z = t}` THEN REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let MEASURABLE_CLOSED_SECTOR_LTE = prove (`!r s t. measurable {z | norm(z) <= r /\ s < Arg z /\ Arg z <= t}`, REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE `{z | P z /\ Q z /\ R z} = {z | P z /\ R z} DIFF {z | P z /\ ~Q z}`] THEN SIMP_TAC[MEASURABLE_DIFF; REAL_NOT_LT; MEASURABLE_CLOSED_SECTOR_LE]);; let MEASURE_CLOSED_SECTOR_LE = prove (`!t r. &0 <= r /\ &0 <= t /\ t <= &2 * pi ==> measure {x:real^2 | norm(x) <= r /\ Arg(x) <= t} = t * r pow 2 / &2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\t. measure {z:real^2 | norm(z) <= r /\ Arg(z) <= t}`; `&2 * pi`] REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPECL [`t / (&2 * pi)`; `&2 * pi`]) THEN MP_TAC(SPECL [`vec 0:real^2`; `r:real`] AREA_CBALL) THEN ASM_REWRITE_TAC[cball; NORM_ARITH `dist(vec 0,z) = norm z`] THEN SIMP_TAC[ARG; REAL_LT_IMP_LE] THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < p ==> t / (&2 * p) * p * r = t * r / &2`; REAL_FIELD `&0 < p ==> t / (&2 * p) * &2 * p = t`] THEN DISCH_THEN MATCH_MP_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN EXISTS_TAC `\t. r pow 2 * sin(t)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `pi / &2` THEN SIMP_TAC[PI_POS; REAL_LT_DIV; IN_ELIM_THM; REAL_OF_NUM_LT; ARITH] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[real_abs; MEASURE_POS_LE; MEASURABLE_CLOSED_SECTOR_LE] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(interval[vec 0,complex(r,r * sin x)])` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE; MEASURABLE_INTERVAL] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; VEC_COMPONENT] THEN REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; IM; RE] THEN SUBST1_TAC(last(CONJUNCTS(SPEC `z:complex` ARG))) THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; CEXP_EULER] THEN REWRITE_TAC[RE_ADD; GSYM CX_COS; GSYM CX_SIN; RE_CX; IM_CX; RE_MUL_II; IM_MUL_II; IM_ADD] THEN REWRITE_TAC[REAL_NEG_0; REAL_ADD_LID; REAL_ADD_RID] THEN SUBGOAL_THEN `&0 <= Arg z /\ Arg z < pi / &2 /\ Arg z <= pi / &2` STRIP_ASSUME_TAC THENL [REWRITE_TAC[ARG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC COS_POS_PI_LE THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c * &1 ==> a * b <= c`) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS; COS_BOUND]; MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC SIN_MONO_LE THEN ASM_REAL_ARITH_TAC]]; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[FORALL_2; PRODUCT_2; DIMINDEX_2; VEC_COMPONENT] THEN REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; IM; RE] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_POW_2; REAL_MUL_ASSOC] THEN SUBGOAL_THEN `&0 <= sin x` (fun th -> ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_REFL; REAL_LE_MUL; th]) THEN MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC REALLIM_ATREAL_WITHINREAL THEN SUBGOAL_THEN `(\t. r pow 2 * sin t) real_continuous atreal (&0)` MP_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_LMUL THEN REWRITE_TAC[ETA_AX; REAL_CONTINUOUS_AT_SIN]; REWRITE_TAC[REAL_CONTINUOUS_ATREAL; SIN_0; REAL_MUL_RZERO]]]; ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ &0 <= y ==> (norm z <= r /\ Arg z <= x + y <=> norm z <= r /\ Arg z <= x \/ norm z <= r /\ x < Arg z /\ Arg z <= x + y)`] THEN REWRITE_TAC[SET_RULE `{z | Q z \/ R z} = {z | Q z} UNION {z | R z}`] THEN SIMP_TAC[MEASURE_UNION; MEASURABLE_CLOSED_SECTOR_LE; MEASURABLE_CLOSED_SECTOR_LTE] THEN REWRITE_TAC[GSYM REAL_NOT_LE; SET_RULE `{z | P z /\ Q z} INTER {z | P z /\ ~Q z /\ R z} = {}`] THEN REWRITE_TAC[MEASURE_EMPTY; REAL_SUB_RZERO; REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure {z | norm z <= r /\ x < Arg z /\ Arg z < x + y}` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LTE] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{z | Arg z = x + y}` THEN REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure {z | norm z <= r /\ &0 < Arg z /\ Arg z < y}` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{z | Arg z = &0} UNION {z | Arg z = y}` THEN REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure (IMAGE (rotate2d x) {z | norm z <= r /\ &0 < Arg z /\ Arg z < y})` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[MEASURE_ORTHOGONAL_IMAGE_EQ; ORTHOGONAL_TRANSFORMATION_ROTATE2D]] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; ORTHOGONAL_TRANSFORMATION_ROTATE2D]; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_REWRITE_TAC[Arg_DEF; ROTATE2D_0] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NORM_ROTATE2D] THEN AP_TERM_TAC THEN EQ_TAC THENL [STRIP_TAC THEN SUBGOAL_THEN `z = rotate2d (--x) (rotate2d x z)` SUBST1_TAC THENL [REWRITE_TAC[GSYM ROTATE2D_ADD; REAL_ADD_LINV; ROTATE2D_ZERO]; ALL_TAC] THEN MP_TAC(ISPECL [`--x:real`; `rotate2d x z`] ARG_ROTATE2D) THEN ASM_REWRITE_TAC[ROTATE2D_EQ_0] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN ASM_REAL_ARITH_TAC; STRIP_TAC THEN MP_TAC(ISPECL [`x:real`; `z:complex`] ARG_ROTATE2D) THEN ASM_REWRITE_TAC[ROTATE2D_EQ_0] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN ASM_REAL_ARITH_TAC]]);; let HAS_MEASURE_OPEN_SECTOR_LT = prove (`!t r. &0 <= t /\ t <= &2 * pi ==> {x:real^2 | norm(x) < r /\ &0 < Arg x /\ Arg x < t} has_measure (if &0 <= r then t * r pow 2 / &2 else &0)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_ARITH `~(&0 <= r) ==> ~(norm x < r)`; EMPTY_GSPEC; HAS_MEASURE_EMPTY] THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_SYMDIFF THEN EXISTS_TAC `{x | norm x <= r /\ Arg x <= t}` THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN ASM_SIMP_TAC[MEASURE_CLOSED_SECTOR_LE; MEASURABLE_CLOSED_SECTOR_LE] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x | dist(vec 0,x) = r} UNION {z | Arg z = &0} UNION {z | Arg z = t}` THEN REWRITE_TAC[NEGLIGIBLE_ARG_EQ; REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE; NEGLIGIBLE_UNION_EQ] THEN REWRITE_TAC[DIST_0; SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let MEASURE_OPEN_SECTOR_LT = prove (`!t r. &0 <= t /\ t <= &2 * pi ==> measure {x:real^2 | norm(x) < r /\ &0 < Arg x /\ Arg x < t} = if &0 <= r then t * r pow 2 / &2 else &0`, SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_OPEN_SECTOR_LT]);; let HAS_MEASURE_OPEN_SECTOR_LT_GEN = prove (`!w z. ~(w = vec 0) ==> {x | norm(x) < r /\ &0 < Arg(x / w) /\ Arg(x / w) < Arg(z / w)} has_measure (if &0 <= r then Arg(z / w) * r pow 2 / &2 else &0)`, GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN ASM_REWRITE_TAC[CX_INJ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_OPEN_SECTOR_LT THEN SIMP_TAC[ARG; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Hence volume of a wedge of a ball. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_BALL_WEDGE = prove (`!z:real^3 w w1 w2. measurable(ball(z,r) INTER wedge z w w1 w2)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_OPEN THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_INTER THEN REWRITE_TAC[BOUNDED_BALL]; MATCH_MP_TAC OPEN_INTER THEN REWRITE_TAC[OPEN_BALL] THEN ASM_SIMP_TAC[OPEN_WEDGE]]);; let VOLUME_BALL_WEDGE = prove (`!z:real^3 w r w1 w2. &0 <= r ==> measure(ball(z,r) INTER wedge z w w1 w2) = azim z w w1 w2 * &2 * r pow 3 / &3`, REPEAT GEN_TAC THEN ASM_CASES_TAC `z:real^3 = w \/ collinear{z,w,w1} \/ collinear{z,w,w2}` THENL [FIRST_X_ASSUM STRIP_ASSUME_TAC THEN ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE; INTER_EMPTY; REAL_MUL_LZERO; MEASURE_EMPTY]; FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; DE_MORGAN_THM]] THEN REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `z:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_OPEN) THEN EXISTS_TAC `3` THEN REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN REPEAT CONJ_TAC THENL [MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_BALL]; REWRITE_TAC[GSYM wedge] THEN MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[OPEN_BALL; OPEN_WEDGE]; SIMP_TAC[SLICE_INTER; DIMINDEX_2; DIMINDEX_3; ARITH; SLICE_BALL]] THEN ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN MAP_EVERY ABBREV_TAC [`v1:real^2 = dropout 3 (w1:real^3)`; `v2:real^2 = dropout 3 (w2:real^3)`] THEN REWRITE_TAC[SLICE_DROPOUT_3; VEC_COMPONENT; REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[INTER_EMPTY] THEN REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN MAP_EVERY UNDISCH_TAC [`~(v1:complex = vec 0)`; `~(v2:complex = vec 0)`] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v2:complex`; `v1:complex`] THEN UNDISCH_TAC `&0 <= r` THEN SPEC_TAC(`r:real`,`r:real`) THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID; CX_INJ] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!t z. ~(z = Cx(&0)) /\ &0 < Arg z /\ Arg z < t <=> &0 < Arg z /\ Arg z < t` (fun th -> REWRITE_TAC[th]) THENL [MESON_TAC[ARG_0; REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[MEASURE_OPEN_SECTOR_LT; REAL_LE_REFL; ARG; REAL_LT_IMP_LE] THEN SUBGOAL_THEN `!t. abs(t) < r <=> t IN real_interval(--r,r)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. Arg v2 * (r pow 2 - t pow 2) / &2` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`]; ALL_TAC] THEN MP_TAC(ISPECL [`\t. Arg v2 * (r pow 2 * t - &1 / &3 * t pow 3) / &2`; `\t. Arg v2 * (r pow 2 - t pow 2) / &2`; `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC REAL_RING]);; (* ------------------------------------------------------------------------- *) (* Hence volume of lune. *) (* ------------------------------------------------------------------------- *) let HAS_MEASURE_LUNE = prove (`!z:real^3 w r w1 w2. &0 <= r /\ ~(w = z) /\ ~collinear {z,w,w1} /\ ~collinear {z,w,w2} /\ ~(dihV z w w1 w2 = pi) ==> (ball(z,r) INTER aff_gt {z,w} {w1,w2}) has_measure (dihV z w w1 w2 * &2 * r pow 3 / &3)`, GEOM_ORIGIN_TAC `z:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_SIMP_TAC[DIHV_SPECIAL_SCALE] THEN MP_TAC(ISPECL [`{}:real^3->bool`; `{w1:real^3,w2:real^3}`; `w:real`; `basis 3:real^3`] AFF_GT_SPECIAL_SCALE) THEN ASM_CASES_TAC `w1:real^3 = vec 0` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `w2:real^3 = vec 0` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN ASM_CASES_TAC `w1:real^3 = w % basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `w2:real^3 = w % basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN ASM_CASES_TAC `w1:real^3 = basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_CASES_TAC `w2:real^3 = basis 3` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN STRIP_TAC THEN ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 = &0` THENL [MP_TAC(ASSUME `azim (vec 0) (basis 3) w1 w2 = &0`) THEN W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhand o snd) THEN ASM_REWRITE_TAC[PI_POS] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO; HAS_MEASURE_0] THEN MATCH_MP_TAC COPLANAR_IMP_NEGLIGIBLE THEN MATCH_MP_TAC COPLANAR_SUBSET THEN EXISTS_TAC `affine hull {vec 0:real^3,basis 3,w1,w2}` THEN CONJ_TAC THENL [ASM_MESON_TAC[COPLANAR_AFFINE_HULL_COPLANAR; AZIM_EQ_0_PI_IMP_COPLANAR]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> (s INTER t) SUBSET u`) THEN SIMP_TAC[aff_gt_def; AFFSIGN; sgn_gt; AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[SET_RULE `{a,b} UNION {c,d} = {a,b,c,d}`] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < azim (vec 0) (basis 3) w1 w2` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; azim]; ALL_TAC] THEN ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 < pi` THENL [ASM_SIMP_TAC[GSYM AZIM_DIHV_SAME; GSYM WEDGE_LUNE_GT] THEN ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_BALL_WEDGE; VOLUME_BALL_WEDGE]; ALL_TAC] THEN ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 = pi` THENL [MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`] AZIM_DIVH) THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `dihV (vec 0) (basis 3) w1 w2 = azim (vec 0) (basis 3) w2 w1` SUBST1_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o rand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x:real = y - z <=> z = y - x`] THEN MATCH_MP_TAC AZIM_DIHV_COMPL THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT]; ALL_TAC] THEN SUBGOAL_THEN `&0 < azim (vec 0) (basis 3) w2 w1 /\ azim (vec 0) (basis 3) w2 w1 < pi` ASSUME_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o rand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`] azim) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBST1_TAC(SET_RULE `{w1:real^3,w2} = {w2,w1}`) THEN ASM_SIMP_TAC[GSYM AZIM_DIHV_SAME; GSYM WEDGE_LUNE_GT] THEN ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_BALL_WEDGE; VOLUME_BALL_WEDGE]);; let HAS_MEASURE_LUNE_SIMPLE = prove (`!z:real^3 w r w1 w2. &0 <= r /\ ~coplanar{z,w,w1,w2} ==> (ball(z,r) INTER aff_gt {z,w} {w1,w2}) has_measure (dihV z w w1 w2 * &2 * r pow 3 / &3)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `w:real^3 = z` THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_LUNE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR; INSERT_AC]; ALL_TAC]) THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`z:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] AZIM_DIVH) THEN ASM_REWRITE_TAC[REAL_ARITH `&2 * pi - pi = pi`; COND_ID] THEN ASM_MESON_TAC[AZIM_EQ_0_PI_IMP_COPLANAR]);; (* ------------------------------------------------------------------------- *) (* Now the volume of a solid triangle. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_BALL_AFF_GT = prove (`!z r s t. measurable(ball(z,r) INTER aff_gt s t)`, MESON_TAC[MEASURABLE_CONVEX; CONVEX_INTER; CONVEX_AFF_GT; CONVEX_BALL; BOUNDED_INTER; BOUNDED_BALL]);; let AFF_GT_SHUFFLE = prove (`!s t v:real^N. FINITE s /\ FINITE t /\ vec 0 IN s /\ ~(vec 0 IN t) /\ ~(v IN s) /\ ~(--v IN s) /\ ~(v IN t) ==> aff_gt (v INSERT s) t = aff_gt s (v INSERT t) UNION aff_gt s (--v INSERT t) UNION aff_gt s t`, REPEAT STRIP_TAC THEN REWRITE_TAC[aff_gt_def; AFFSIGN_ALT; sgn_gt] THEN REWRITE_TAC[SET_RULE `(v INSERT s) UNION t = v INSERT (s UNION t)`; SET_RULE `s UNION (v INSERT t) = v INSERT (s UNION t)`] THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN REWRITE_TAC[IN_INSERT] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> ((w IN s UNION t ==> w = a \/ w IN t ==> P w) <=> (w IN t ==> P w))`] THEN REWRITE_TAC[SET_RULE `x IN (s UNION t) ==> x IN t ==> P x <=> x IN t ==> P x`] THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `v:real` ASSUME_TAC) THEN ASM_CASES_TAC `&0 < v` THENL [DISJ1_TAC THEN EXISTS_TAC `v:real` THEN ASM_REWRITE_TAC[]; DISJ2_TAC] THEN ASM_CASES_TAC `v = &0` THENL [DISJ2_TAC THEN FIRST_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]; DISJ1_TAC] THEN EXISTS_TAC `--v:real` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^N. if x = vec 0 then f(x) + &2 * v else f(x)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; ASM_SIMP_TAC[SUM_CASES_1; FINITE_UNION; IN_UNION] THEN REAL_ARITH_TAC; REWRITE_TAC[VECTOR_ARITH `--a % --x:real^N = a % x`] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO]]; DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [DISCH_THEN(X_CHOOSE_THEN `a:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `--a:real` THEN EXISTS_TAC `\x:real^N. if x = vec 0 then &2 * a + f(vec 0) else f x` THEN ASM_SIMP_TAC[SUM_CASES_1; FINITE_UNION; IN_UNION] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `y - --a % v:real^N = y - a % --v`] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC VSUM_EQ THEN REPEAT GEN_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO]; GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN VECTOR_ARITH_TAC]]);; let MEASURE_BALL_AFF_GT_SHUFFLE_LEMMA = prove (`!r s t v:real^N. &0 <= r /\ independent(v INSERT((s DELETE vec 0) UNION t)) /\ FINITE s /\ FINITE t /\ CARD(s UNION t) <= dimindex(:N) /\ vec 0 IN s /\ ~(vec 0 IN t) /\ ~(v IN s) /\ ~(--v IN s) /\ ~(v IN t) ==> measure(ball(vec 0,r) INTER aff_gt (v INSERT s) t) = measure(ball(vec 0,r) INTER aff_gt s (v INSERT t)) + measure(ball(vec 0,r) INTER aff_gt s (--v INSERT t))`, let lemma = prove (`!s t u:real^N->bool. measurable s /\ measurable t /\ s INTER t = {} /\ negligible u ==> measure(s UNION t UNION u) = measure s + measure t`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_ASSOC] THEN ASM_SIMP_TAC[GSYM MEASURE_DISJOINT_UNION; DISJOINT] THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_SIMP_TAC[MEASURABLE_UNION] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]) in REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SHUFFLE o rand o rand o lhand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[UNION_OVER_INTER] THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[MEASURABLE_BALL_AFF_GT] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `t INTER u = {} ==> (s INTER t) INTER (s INTER u) = {}`) THEN REWRITE_TAC[aff_gt_def; AFFSIGN_ALT; sgn_gt] THEN REWRITE_TAC[SET_RULE `(v INSERT s) UNION t = v INSERT (s UNION t)`; SET_RULE `s UNION (v INSERT t) = v INSERT (s UNION t)`] THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN REWRITE_TAC[IN_INSERT] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> ((w IN s UNION t ==> w = a \/ w IN t ==> P w) <=> (w IN t ==> P w))`] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a:real` (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC))) (X_CHOOSE_THEN `b:real` (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC)))) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN REWRITE_TAC[FINITE_INSERT; FINITE_DELETE; FINITE_UNION] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `\x. if x = v then a + b else (f:real^N->real) x - g x`) THEN ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_UNION] THEN ASM_REWRITE_TAC[IN_DELETE; IN_UNION] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `v:real^N`) THEN REWRITE_TAC[IN_INSERT] THEN ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[SET_RULE `~(a IN t) ==> (s DELETE a) UNION t = (s UNION t) DELETE a`] THEN ASM_SIMP_TAC[VSUM_DELETE_CASES; FINITE_UNION; IN_UNION] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN SUBGOAL_THEN `!x:real^N. (if x = v then a + b else f x - g x) % x = (if x = v then a else f x) % x - (if x = v then --b else g x) % x` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ASM_SIMP_TAC[VSUM_SUB; FINITE_UNION]] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(a + b) % v + (y - a % v) - (y - b % --v):real^N` THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN AP_TERM_TAC THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_UNION]; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `aff_gt s t :real^N->bool` THEN REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `affine hull (s UNION t:real^N->bool)` THEN REWRITE_TAC[AFF_GT_SUBSET_AFFINE_HULL] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_UNION; HULL_INC] THEN ONCE_REWRITE_TAC[GSYM SPAN_DELETE_0] THEN MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD((s UNION t) DELETE (vec 0:real^N))` THEN ASM_SIMP_TAC[DIM_LE_CARD; FINITE_DELETE; FINITE_UNION; DIM_SPAN] THEN ASM_SIMP_TAC[CARD_DELETE; IN_UNION; FINITE_UNION] THEN MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n ==> x - 1 < n`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1]]);; let MEASURE_BALL_AFF_GT_SHUFFLE = prove (`!r s t v:real^N. &0 <= r /\ ~(v IN (s UNION t)) /\ independent(v INSERT (s UNION t)) ==> measure(ball(vec 0,r) INTER aff_gt (vec 0 INSERT v INSERT s) t) = measure(ball(vec 0,r) INTER aff_gt (vec 0 INSERT s) (v INSERT t)) + measure(ball(vec 0,r) INTER aff_gt (vec 0 INSERT s) (--v INSERT t))`, REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`r:real`; `(vec 0:real^N) INSERT s`; `t:real^N->bool`; `v:real^N`] MEASURE_BALL_AFF_GT_SHUFFLE_LEMMA) THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[INSERT_AC]] THEN ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INDEPENDENT_NONZERO) THEN REWRITE_TAC[IN_INSERT; IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INDEPENDENT_BOUND) THEN REWRITE_TAC[FINITE_INSERT; FINITE_UNION] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN REWRITE_TAC[SET_RULE `(a INSERT s) UNION t = a INSERT (s UNION t)`] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_UNION; IN_UNION; FINITE_INSERT] THEN DISCH_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INDEPENDENT_MONO)) THEN SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN REWRITE_TAC[dependent; CONTRAPOS_THM] THEN DISCH_TAC THEN EXISTS_TAC `v:real^N` THEN REWRITE_TAC[IN_INSERT] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_NEG] THEN MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM_REWRITE_TAC[IN_DELETE; VECTOR_ARITH `--v:real^N = v <=> v = vec 0`; IN_INSERT; IN_UNION]]);; let MEASURE_LUNE_DECOMPOSITION = prove (`!v1 v2 v3:real^3. &0 <= r /\ ~coplanar {vec 0, v1, v2, v3} ==> measure(ball(vec 0,r) INTER aff_gt {vec 0} {v1,v2,v3}) + measure(ball(vec 0,r) INTER aff_gt {vec 0} {--v1,v2,v3}) = dihV (vec 0) v1 v2 v3 * &2 * r pow 3 / &3`, let rec distinctpairs l = match l with x::t -> itlist (fun y a -> (x,y) :: a) t (distinctpairs t) | [] -> [] in REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC]) (map mk_eq (distinctpairs [`v3:real^3`; `v2:real^3`; `v1:real^3`; `vec 0:real^3`])) THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_LUNE_SIMPLE)] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_BALL_AFF_GT_SHUFFLE THEN ASM_REWRITE_TAC[UNION_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[NOT_COPLANAR_0_4_IMP_INDEPENDENT]);; let SOLID_TRIANGLE_CONGRUENT_NEG = prove (`!r v1 v2 v3:real^N. measure(ball(vec 0,r) INTER aff_gt {vec 0} {--v1, --v2, --v3}) = measure(ball(vec 0,r) INTER aff_gt {vec 0} {v1, v2, v3})`, REPEAT GEN_TAC THEN SUBGOAL_THEN `ball(vec 0:real^N,r) INTER aff_gt {vec 0} {--v1, --v2, --v3} = IMAGE (--) (ball(vec 0,r) INTER aff_gt {vec 0} {v1, v2, v3})` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC MEASURE_ORTHOGONAL_IMAGE_EQ THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; linear; NORM_NEG] THEN CONJ_TAC THEN VECTOR_ARITH_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[VECTOR_NEG_NEG]; ALL_TAC] THEN REWRITE_TAC[IN_INTER; IN_BALL_0; NORM_NEG] THEN REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN REWRITE_TAC[SET_RULE `{a} UNION {b,c,d} = {a,b,d,c}`] THEN REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = --x <=> vec 0 = x`] THEN REWRITE_TAC[VECTOR_ARITH `--x - a % --w:real^N = --(x - a % w)`] THEN REWRITE_TAC[VECTOR_NEG_EQ_0]);; let VOLUME_SOLID_TRIANGLE = prove (`!r v0 v1 v2 v3:real^3. &0 < r /\ ~coplanar{v0, v1, v2, v3} ==> measure(ball(v0,r) INTER aff_gt {v0} {v1,v2,v3}) = let a123 = dihV v0 v1 v2 v3 in let a231 = dihV v0 v2 v3 v1 in let a312 = dihV v0 v3 v1 v2 in (a123 + a231 + a312 - pi) * r pow 3 / &3`, let tac convl = W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_BALL_AFF_GT_SHUFFLE o convl o lhand o lhand o snd) THEN ASM_REWRITE_TAC[UNION_EMPTY; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `(a INSERT s) UNION t = a INSERT (s UNION t)`] THEN ASM_SIMP_TAC[UNION_EMPTY; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [CONJ_TAC THENL [DISCH_THEN(STRIP_THM_THEN SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[COPLANAR_3]) THEN FIRST_ASSUM CONTR_TAC; MATCH_MP_TAC NOT_COPLANAR_0_4_IMP_INDEPENDENT THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN ASM_REWRITE_TAC[INSERT_AC]]; DISCH_THEN SUBST1_TAC] in GEN_TAC THEN GEOM_ORIGIN_TAC `v0:real^3` THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `measure(ball(vec 0:real^3,r) INTER aff_gt {vec 0,v1,v2,v3} {}) = &4 / &3 * pi * r pow 3` MP_TAC THENL [MP_TAC(SPECL [`vec 0:real^3`; `r:real`] VOLUME_BALL) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `t = UNIV ==> s INTER t = s`) THEN REWRITE_TAC[AFF_GT_EQ_AFFINE_HULL] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV SUBSET s`] THEN MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN ASM_SIMP_TAC[DIM_UNIV; DIMINDEX_3; SUBSET_UNIV] THEN ASM_SIMP_TAC[NOT_COPLANAR_0_4_IMP_INDEPENDENT] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COPLANAR_3]) THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[]]) [`v3:real^3 = v2`; `v3:real^3 = v1`; `v2:real^3 = v1`] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `~(coplanar {vec 0:real^3,v1,v2,v3}) /\ ~(coplanar {vec 0,--v1,v2,v3}) /\ ~(coplanar {vec 0,v1,--v2,v3}) /\ ~(coplanar {vec 0,--v1,--v2,v3}) /\ ~(coplanar {vec 0,--v1,--v2,v3}) /\ ~(coplanar {vec 0,--v1,v2,--v3}) /\ ~(coplanar {vec 0,v1,--v2,--v3}) /\ ~(coplanar {vec 0,--v1,--v2,--v3}) /\ ~(coplanar {vec 0,--v1,--v2,--v3})` STRIP_ASSUME_TAC THENL [REPLICATE_TAC 3 (REWRITE_TAC[COPLANAR_INSERT_0_NEG] THEN ONCE_REWRITE_TAC[SET_RULE `{vec 0,a,b,c} = {vec 0,b,c,a}`]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MAP_EVERY tac [I; lhand; rand; lhand o lhand; rand o lhand; lhand o rand; rand o rand] THEN MP_TAC(ISPECL [`v1:real^3`; `v2:real^3`; `v3:real^3`] MEASURE_LUNE_DECOMPOSITION) THEN MP_TAC(ISPECL [`v2:real^3`; `v3:real^3`; `v1:real^3`] MEASURE_LUNE_DECOMPOSITION) THEN MP_TAC(ISPECL [`v3:real^3`; `v1:real^3`; `v2:real^3`] MEASURE_LUNE_DECOMPOSITION) THEN MP_TAC(ISPECL [`--v1:real^3`; `--v2:real^3`; `--v3:real^3`] MEASURE_LUNE_DECOMPOSITION) THEN MP_TAC(ISPECL [`--v2:real^3`; `--v3:real^3`; `--v1:real^3`] MEASURE_LUNE_DECOMPOSITION) THEN MP_TAC(ISPECL [`--v3:real^3`; `--v1:real^3`; `--v2:real^3`] MEASURE_LUNE_DECOMPOSITION) THEN ASM_REWRITE_TAC[VECTOR_NEG_NEG] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; INSERT_AC] THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIHV_NEG_0] THEN REWRITE_TAC[SOLID_TRIANGLE_CONGRUENT_NEG] THEN REWRITE_TAC[INSERT_AC] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Volume of wedge of a frustum. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_BOUNDED_INTER_OPEN = prove (`!s t:real^N->bool. measurable s /\ bounded s /\ open t ==> measurable(s INTER t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE `s SUBSET i ==> s INTER t = s INTER (t INTER i)`)) THEN MATCH_MP_TAC MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_OPEN THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL; BOUNDED_INTER; BOUNDED_INTERVAL]);; let SLICE_SPECIAL_WEDGE = prove (`!w1 w2. ~collinear {vec 0, basis 3, w1} /\ ~collinear {vec 0, basis 3, w2} ==> slice 3 t (wedge (vec 0) (basis 3) w1 w2) = {z | &0 < Arg(z / dropout 3 w1) /\ Arg(z / dropout 3 w1) < Arg(dropout 3 w2 / dropout 3 w1)}`, REWRITE_TAC[wedge] THEN ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN MAP_EVERY ABBREV_TAC [`v1:real^2 = dropout 3 (w1:real^3)`; `v2:real^2 = dropout 3 (w2:real^3)`] THEN REWRITE_TAC[SLICE_DROPOUT_3; VEC_COMPONENT; REAL_SUB_RZERO] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; COMPLEX_VEC_0] THEN X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; ARG_0; REAL_LT_REFL]);; let VOLUME_FRUSTT_WEDGE = prove (`!v0 v1:real^3 w1 w2 h a. &0 < a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> bounded(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) /\ measurable(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) /\ measure(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) = if &1 <= a \/ h < &0 then &0 else azim v0 v1 w1 w2 * ((h / a) pow 2 - h pow 2) * h / &6`, REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; STRIP_TAC] THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[VOLUME_FRUSTT_STRONG]; MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN ASM_SIMP_TAC[VOLUME_FRUSTT_STRONG; OPEN_WEDGE]; ALL_TAC] THEN REWRITE_TAC[frustt; frustum; rcone_gt; rconesgn; IN_ELIM_THM] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN X_GEN_TAC `b:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; WEDGE_SPECIAL_SCALE] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `!y:real^3. ~(norm(y) * norm(b % basis 3:real^3) * a < y dot (b % basis 3))` (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURABLE_EMPTY; INTER_EMPTY; MEASURE_EMPTY]) THEN REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN REWRITE_TAC[REAL_ARITH `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DOT_BASIS; DOT_RMUL; DIMINDEX_3; ARITH] THEN ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN REWRITE_TAC[REAL_ARITH `(&0 * x < y /\ u < v) /\ &0 < y /\ y < h <=> &0 < y /\ y < h /\ u < v`] THEN DISCH_TAC THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_ALT) THEN EXISTS_TAC `3` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; SLICE_INTER; DIMINDEX_2; DIMINDEX_3; ARITH] THEN SUBGOAL_THEN `!t. slice 3 t {y:real^3 | norm y * a < y$3 /\ &0 < y$3 /\ y$3 < h} = if t < h then ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t) else {}` (fun th -> ASM_SIMP_TAC[th; SLICE_SPECIAL_WEDGE]) THENL [REWRITE_TAC[EXTENSION] THEN MAP_EVERY X_GEN_TAC [`t:real`; `z:real^2`] THEN SIMP_TAC[SLICE_123; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; VECTOR_3; DOT_3; GSYM DOT_2] THEN ASM_CASES_TAC `t < h` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[IN_BALL_0; IN_DELETE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ (a < t <=> u < v) ==> (a < t /\ &0 < t <=> u < v)`) THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_MUL; SQRT_POS_LT; REAL_POW_MUL; SQRT_POW_2; REAL_LT_IMP_LE; REAL_LT_MUL_EQ] THEN ASM_SIMP_TAC[real_div; REAL_LT_MUL_EQ; REAL_LT_INV_EQ] THEN ASM_CASES_TAC `&0 < t` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DOT_3; DOT_2; VECTOR_3; REAL_INV_POW] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN REWRITE_TAC[INTER_EMPTY; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_OPEN_SECTOR_LT_GEN] THEN REWRITE_TAC[COND_ID] THEN SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; SQRT_POS_LT] THEN ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG; COLLINEAR_BASIS_3] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. if &0 < t /\ t < h then Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) / &2 * (inv(a pow 2) - &1) * t pow 2 else &0` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ASM_CASES_TAC `t < h` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `&0 <= t <=> t = &0 \/ &0 < t`] THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_RZERO; SQRT_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_POW_MUL; SQRT_POW_2; REAL_LT_IMP_LE] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[REAL_INTERVAL_EQ_EMPTY; HAS_REAL_INTEGRAL_EMPTY]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN ABBREV_TAC `g = Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN MP_TAC(ISPECL [`\t. g / &6 * (inv (a pow 2) - &1) * t pow 3`; `\t. g / &2 * (inv (a pow 2) - &1) * t pow 2`; `&0`; `h:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]);; (* ------------------------------------------------------------------------- *) (* Wedge of a conic cap. *) (* ------------------------------------------------------------------------- *) let VOLUME_CONIC_CAP_WEDGE_WEAK = prove (`!v0 v1:real^3 w1 w2 r a. &0 < a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) = if &1 <= a \/ r < &0 then &0 else azim v0 v1 w1 w2 / &3 * (&1 - a) * r pow 3`, REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; STRIP_TAC] THEN MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[VOLUME_CONIC_CAP_STRONG]; MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN ASM_SIMP_TAC[VOLUME_CONIC_CAP_STRONG; OPEN_WEDGE]; ALL_TAC] THEN REWRITE_TAC[conic_cap; rcone_gt; rconesgn; IN_ELIM_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] normball; GSYM ball] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN X_GEN_TAC `b:real` THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN SIMP_TAC[COLLINEAR_SPECIAL_SCALE; WEDGE_SPECIAL_SCALE] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `!y:real^3. ~(norm(y) * norm(b % basis 3:real^3) * a < y dot (b % basis 3))` (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY; MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]) THEN REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN REWRITE_TAC[REAL_ARITH `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_NORM; DOT_BASIS; DIMINDEX_3; ARITH; NORM_BASIS] THEN ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN REWRITE_TAC[INTER; REAL_MUL_LZERO; IN_BALL_0; IN_ELIM_THM] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; REAL_LT_IMP_NZ] THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x < r)`] THEN REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]; RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_NOT_LT])] THEN STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_ALT) THEN EXISTS_TAC `3` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE; AZIM_SPECIAL_SCALE] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ x IN s} = {x | P x} INTER s`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; SLICE_INTER; DIMINDEX_2; DIMINDEX_3; ARITH] THEN RULE_ASSUM_TAC (REWRITE_RULE[MATCH_MP COLLINEAR_SPECIAL_SCALE (ASSUME `~(b = &0)`)]) THEN SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; ALL_TAC] THEN SUBGOAL_THEN `!t. slice 3 t {y:real^3 | norm y < r /\ norm y * a < y$3} = if &0 < t /\ t < r then ball(vec 0:real^2,min (sqrt(r pow 2 - t pow 2)) (t * sqrt(inv(a pow 2) - &1))) else {}` (fun th -> ASM_SIMP_TAC[th; SLICE_SPECIAL_WEDGE]) THENL [REWRITE_TAC[EXTENSION] THEN MAP_EVERY X_GEN_TAC [`t:real`; `z:real^2`] THEN SIMP_TAC[SLICE_123; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; VECTOR_3; DOT_3; GSYM DOT_2] THEN ASM_CASES_TAC `&0 < t` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; REWRITE_TAC[NOT_IN_EMPTY; DE_MORGAN_THM] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `~(&0 < t) ==> &0 <= a ==> ~(a < t)`)) THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE]] THEN ASM_CASES_TAC `t < r` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; REWRITE_TAC[NOT_IN_EMPTY; DE_MORGAN_THM] THEN DISJ1_TAC THEN REWRITE_TAC[NORM_LT_SQUARE; DE_MORGAN_THM] THEN DISJ2_TAC THEN REWRITE_TAC[DOT_3; VECTOR_3] THEN MATCH_MP_TAC(REAL_ARITH `r <= t /\ &0 <= a /\ &0 <= b ==> ~(a + b + t < r)`) THEN REWRITE_TAC[REAL_LE_SQUARE; REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[IN_BALL_0; REAL_LT_MIN] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN REWRITE_TAC[NORM_LT_SQUARE] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `t pow 2 < r pow 2` ASSUME_TAC THENL [MATCH_MP_TAC REAL_POW_LT2 THEN REWRITE_TAC[ARITH] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_DIV; SQRT_POS_LT; REAL_LT_MUL; REAL_SUB_LT; SQRT_POW_2; REAL_LT_IMP_LE; REAL_POW_MUL] THEN REWRITE_TAC[DOT_2; DOT_3; VECTOR_3] THEN ONCE_REWRITE_TAC[REAL_ARITH `a + b + c < d <=> a + b < d - c`] THEN BINOP_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN REWRITE_TAC[INTER_EMPTY; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_OPEN_SECTOR_LT_GEN] THEN REWRITE_TAC[COND_ID] THEN ASM_SIMP_TAC[REAL_LE_MIN; SQRT_POS_LE; REAL_LT_IMP_LE; REAL_LE_MUL; REAL_POW_LE2; ARITH; REAL_SUB_LE; REAL_LT_MUL; SQRT_POS_LT] THEN REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN REWRITE_TAC[NORM_POW_2; DOT_3; VECTOR_3; DOT_2] THEN ASM_SIMP_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN ONCE_REWRITE_TAC[REAL_ARITH `(&1 - a) * az / &3 * r pow 3 = az / &6 * (inv (a pow 2) - &1) * (a * r) pow 3 + (az * &1 / &3 * (&1 - a) * r pow 3 - az / &6 * (inv (a pow 2) - &1) * (a * r) pow 3)`] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN EXISTS_TAC `a * r:real` THEN REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN ABBREV_TAC `k = Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t. k * t pow 2 * (inv(a pow 2) - &1) / &2` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `t pow 2 * (inv(a pow 2) - &1) <= r pow 2 - t pow 2` ASSUME_TAC THENL [REWRITE_TAC[REAL_ARITH `t * (a - &1) <= r - t <=> t * a <= r`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_POW_LT] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `t * sqrt(inv(a pow 2) - &1) <= sqrt(r pow 2 - t pow 2)` (fun th -> SIMP_TAC[th; REAL_ARITH `a <= b ==> min b a = a`]) THENL [MATCH_MP_TAC REAL_POW_LE2_REV THEN EXISTS_TAC `2` THEN REWRITE_TAC[ARITH] THEN SUBGOAL_THEN `&0 <= r pow 2 - t pow 2` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= x ==> &0 <= a ==> &0 <= x`)) THEN ASM_SIMP_TAC[REAL_POW_2; REAL_LE_MUL; REAL_LE_SQUARE; REAL_LT_IMP_LE]; ASM_SIMP_TAC[SQRT_POS_LE; REAL_POW_MUL; SQRT_POW_2; REAL_LT_IMP_LE]]; ASM_SIMP_TAC[REAL_POW_MUL; SQRT_POW_2; SQRT_POW_2; REAL_LT_IMP_LE] THEN REAL_ARITH_TAC]; MP_TAC(ISPECL [`\t. k / &6 * (inv (a pow 2) - &1) * t pow 3`; `\t. k * t pow 2 * (inv (a pow 2) - &1) / &2`; `&0`; `a * r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]; MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC `\t:real. k * (r pow 2 - t pow 2) / &2` THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a <= b /\ a pow 2 = x ==> x / &2 = (min a b pow 2) / &2`) THEN SUBGOAL_THEN `&0 <= r pow 2 - t pow 2` ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_SUB_LE] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2_REV THEN EXISTS_TAC `2` THEN REWRITE_TAC[ARITH] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_POW_MUL; REAL_LE_MUL; SQRT_POS_LT; REAL_LT_MUL; REAL_LT_IMP_LE; SQRT_POS_LE] THEN REWRITE_TAC[REAL_ARITH `r - t <= t * (a - &1) <=> r <= t * a`] THEN REWRITE_TAC[REAL_INV_POW; GSYM REAL_POW_MUL] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`\t. k / &2 * (r pow 2 * t - t pow 3 / &3)`; `\t. k * (r pow 2 - t pow 2) / &2`; `a * r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]]);; let BOUNDED_CONIC_CAP_WEDGE = prove (`!v0 v1:real^3 w1 w2 r a. bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2)`, REPEAT GEN_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `conic_cap (v0:real^3) v1 r a` THEN REWRITE_TAC[BOUNDED_CONIC_CAP] THEN SET_TAC[]);; let MEASURABLE_CONIC_CAP_WEDGE = prove (`!v0 v1:real^3 w1 w2 r a. measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2)`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN REWRITE_TAC[BOUNDED_CONIC_CAP; MEASURABLE_CONIC_CAP; OPEN_WEDGE]);; let VOLUME_CONIC_CAP_COMPL = prove (`!v0 v1:real^3 w1 w2 r a. &0 <= r ==> measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) + measure(conic_cap v0 v1 r (--a) INTER wedge v0 v1 w1 w2) = azim v0 v1 w1 w2 * &2 * r pow 3 / &3`, let lemma = prove (`!f:real^N->real^N s t t' u. measurable(s) /\ measurable(t) /\ measurable(u) /\ orthogonal_transformation f /\ s SUBSET u /\ t' SUBSET u /\ s INTER t' = {} /\ negligible(u DIFF (s UNION t')) /\ ((!y. ?x. f x = y) ==> IMAGE f t = t') ==> measure s + measure t = measure u`, REPEAT GEN_TAC THEN ASM_CASES_TAC `orthogonal_transformation(f:real^N->real^N)` THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure(s:real^N->bool) + measure(t':real^N->bool)` THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_ORTHOGONAL_IMAGE_EQ]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_DISJOINT_UNION o lhand o snd) THEN ASM_REWRITE_TAC[DISJOINT] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE; ORTHOGONAL_TRANSFORMATION_LINEAR]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]) in REWRITE_TAC[conic_cap; rcone_gt; NORMBALL_BALL; rconesgn] THEN GEOM_ORIGIN_TAC `v0:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0; real_gt] THEN GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_LZERO; WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM VOLUME_BALL_WEDGE] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `collinear {vec 0:real^3,v1 % basis 3,w1}` THENL [ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM VOLUME_BALL_WEDGE] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `collinear {vec 0:real^3,v1 % basis 3,w2}` THENL [ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE] THEN MAP_EVERY UNDISCH_TAC [`~collinear{vec 0:real^3,v1 % basis 3,w1}`; `~collinear{vec 0:real^3,v1 % basis 3,w2}`] THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN REPEAT DISCH_TAC THEN REWRITE_TAC[NORM_MUL; DOT_RMUL] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `&0 < v1 ==> n * (abs v1 * y) * a = v1 * n * y * a`] THEN MATCH_MP_TAC lemma THEN MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`; `r:real`; `a:real`] MEASURABLE_CONIC_CAP_WEDGE) THEN MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`; `r:real`; `--a:real`] MEASURABLE_CONIC_CAP_WEDGE) THEN REWRITE_TAC[conic_cap; rcone_gt; NORMBALL_BALL; rconesgn] THEN REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0; real_gt] THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[MEASURABLE_BALL_WEDGE] THEN SIMP_TAC[NORM_BASIS; DOT_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN EXISTS_TAC `(\x. vector[x$1; x$2; --(x$3)]):real^3->real^3` THEN EXISTS_TAC `(ball(vec 0,r) INTER {x | norm x * a > x$3}) INTER wedge (vec 0:real^3) (basis 3) w1 w2` THEN CONJ_TAC THENL [REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; linear] THEN REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3; vector_norm; DOT_3; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE AP_TERM_TAC) THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_ELIM_THM; real_gt] THEN MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `rcone_eq (vec 0:real^3) (basis 3) a` THEN SIMP_TAC[NEGLIGIBLE_RCONE_EQ; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN REWRITE_TAC[SUBSET; rcone_eq; rconesgn; VECTOR_SUB_RZERO; DIST_0] THEN SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_INTER; IN_UNION] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTER; IN_BALL_0; IN_ELIM_THM; VECTOR_3] THEN X_GEN_TAC `x:real^3` THEN SUBGOAL_THEN `norm(vector [x$1; x$2; --(x$3)]:real^3) = norm(x:real^3)` SUBST1_TAC THENL [REWRITE_TAC[NORM_EQ; DOT_3; VECTOR_3] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `n * a > --x <=> n * --a < x`] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> b')) ==> (a /\ b <=> a /\ b')`) THEN STRIP_TAC THEN REWRITE_TAC[COLLINEAR_BASIS_3; wedge; AZIM_ARG] THEN REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `(dropout 3 :real^3->real^2) (vector [x$1; x$2; --(x$3)]) = (dropout 3 :real^3->real^2) x` (fun th -> REWRITE_TAC[th]) THEN SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; dropout; LAMBDA_BETA; ARITH; DIMINDEX_3; VECTOR_3]);; let VOLUME_CONIC_CAP_WEDGE_MEDIUM = prove (`!v0 v1:real^3 w1 w2 r a. &0 <= a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) = if &1 < abs a \/ r < &0 then &0 else azim v0 v1 w1 w2 / &3 * (&1 - a) * r pow 3`, REWRITE_TAC[BOUNDED_CONIC_CAP_WEDGE; MEASURABLE_CONIC_CAP_WEDGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `&0 <= a ==> &0 < a \/ a = &0`)) THENL [ASM_SIMP_TAC[VOLUME_CONIC_CAP_WEDGE_WEAK] THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `a = &1` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THENL [REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN SUBGOAL_THEN `ball(v0:real^3,r) = {}` (fun th -> SIMP_TAC[th; INTER_EMPTY; MEASURE_EMPTY]) THEN REWRITE_TAC[BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`; `r:real`; `&0`] VOLUME_CONIC_CAP_COMPL) THEN REWRITE_TAC[REAL_NEG_0] THEN ASM_REAL_ARITH_TAC]);; let VOLUME_CONIC_CAP_WEDGE = prove (`!v0 v1:real^3 w1 w2 r a. ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) = if &1 < a \/ r < &0 then &0 else azim v0 v1 w1 w2 / &3 * (&1 - max a (-- &1)) * r pow 3`, REWRITE_TAC[BOUNDED_CONIC_CAP_WEDGE; MEASURABLE_CONIC_CAP_WEDGE] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= a` THEN ASM_SIMP_TAC[VOLUME_CONIC_CAP_WEDGE_MEDIUM; REAL_ARITH `&0 <= a ==> abs a = a /\ max a (-- &1) = a`] THEN MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`; `r:real`; `--a:real`] VOLUME_CONIC_CAP_WEDGE_MEDIUM) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`; `r:real`; `a:real`] VOLUME_CONIC_CAP_COMPL) THEN ASM_CASES_TAC `r < &0` THENL [REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN SUBGOAL_THEN `ball(v0:real^3,r) = {}` (fun th -> SIMP_TAC[th; INTER_EMPTY; MEASURE_EMPTY]) THEN REWRITE_TAC[BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_ABS_NEG] THEN ASM_SIMP_TAC[REAL_ARITH `~(&0 <= a) ==> ~(&1 < a) /\ abs a = --a`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[REAL_ARITH `&1 < --a ==> max a (-- &1) = -- &1`] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_ARITH `~(&1 < --a) ==> max a (-- &1) = a`] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Precise formulation of Flyspeck volume properties. *) (* ------------------------------------------------------------------------- *) (*** Might be preferable to switch *** *** normball z r -> ball(z,r) *** rect a b -> interval(a,b) *** *** to fit existing libraries. But I left this alone for now, *** to be absolutely sure I didn't introduce new errors. *** I also maintain *** *** NULLSET -> negligible *** vol -> measure *** *** as interface maps for the real^3 case. ***) let cone = new_definition `cone v S:real^A->bool = affsign sgn_ge {v} S`;; (*** JRH: should we exclude v for S = {}? Make it always open ***) let cone0 = new_definition `cone0 v S:real^A->bool = affsign sgn_gt {v} S`;; (*** JRH changed from cone to cone0 ***) let solid_triangle = new_definition `solid_triangle v0 S r = normball v0 r INTER cone0 v0 S`;; let rect = new_definition `rect (a:real^3) (b:real^3) = {(v:real^3) | !i. (a$i < v$i /\ v$i < b$i )}`;; let RECT_INTERVAL = prove (`!a b. rect a b = interval(a,b)`, REWRITE_TAC[rect; EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN MESON_TAC[FINITE_INDEX_INRANGE]);; let RCONE_GE_GT = prove (`rcone_ge z w h = rcone_gt z w h UNION { x | (x - z) dot (w - z) = norm(x - z) * norm(w - z) * h}`, REWRITE_TAC[rcone_ge; rcone_gt; rconesgn] THEN REWRITE_TAC[dist; EXTENSION; IN_UNION; NORM_SUB; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let RCONE_GT_GE = prove (`rcone_gt z w h = rcone_ge z w h DIFF { x | (x - z) dot (w - z) = norm(x - z) * norm(w - z) * h}`, REWRITE_TAC[rcone_ge; rcone_gt; rconesgn] THEN REWRITE_TAC[dist; EXTENSION; IN_DIFF; NORM_SUB; IN_ELIM_THM] THEN REAL_ARITH_TAC);; override_interface("NULLSET",`negligible:(real^3->bool)->bool`);; override_interface("vol",`measure:(real^3->bool)->real`);; let is_sphere= new_definition `is_sphere x=(?(v:real^3)(r:real). (r> &0)/\ (x={w:real^3 | norm (w-v)= r}))`;; let c_cone = new_definition `c_cone (v,w:real^3, r:real)= {x:real^3 | ((x-v) dot w = norm (x-v)* norm w* r)}`;; (*** JRH added the condition ~(w = 0), or the cone is all of space ***) let circular_cone =new_definition `circular_cone (V:real^3-> bool)= (? (v,w:real^3)(r:real). ~(w = vec 0) /\ V = c_cone (v,w,r))`;; let NULLSET_RULES = prove (`(!P. ((plane P)\/ (is_sphere P) \/ (circular_cone P)) ==> NULLSET P) /\ (!(s:real^3->bool) t. (NULLSET s /\ NULLSET t) ==> NULLSET (s UNION t))`, SIMP_TAC[NEGLIGIBLE_UNION] THEN X_GEN_TAC `s:real^3->bool` THEN STRIP_TAC THENL [MATCH_MP_TAC COPLANAR_IMP_NEGLIGIBLE THEN SIMP_TAC[COPLANAR; DIMINDEX_3; ARITH] THEN ASM_MESON_TAC[SUBSET_REFL]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [is_sphere]) THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM dist] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [circular_cone]) THEN REWRITE_TAC[EXISTS_PAIRED_THM; c_cone] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`w + v:real^3`; `v:real^3`; `r:real`] NEGLIGIBLE_RCONE_EQ) THEN ASM_REWRITE_TAC[rcone_eq; rconesgn] THEN REWRITE_TAC[dist; VECTOR_ARITH `(w + v) - v:real^N = w`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `w + v:real^N = v <=> w = vec 0`]]);; (*** JRH added &0 < a for frustum; otherwise it's in general unbounded ***) let primitive = new_definition `primitive (C:real^3->bool) = ((?v0 v1 v2 v3 r. (C = solid_triangle v0 {v1,v2,v3} r)) \/ (?v0 v1 v2 v3. (C = conv0 {v0,v1,v2,v3})) \/ (?v0 v1 v2 v3 h a. &0 < a /\ (C = frustt v0 v1 h a INTER wedge v0 v1 v2 v3)) \/ (?v0 v1 v2 v3 r c. (C = conic_cap v0 v1 r c INTER wedge v0 v1 v2 v3)) \/ (?a b. (C = rect a b)) \/ (?t r. (C = ellipsoid t r)) \/ (?v0 v1 v2 v3 r. (C = normball v0 r INTER wedge v0 v1 v2 v3)))`;; let MEASURABLE_RULES = prove (`(!C. primitive C ==> measurable C) /\ (!Z. NULLSET Z ==> measurable Z) /\ (!X t. measurable X ==> (measurable (IMAGE (scale t) X))) /\ (!X v. measurable X ==> (measurable (IMAGE ((+) v) X))) /\ (!(s:real^3->bool) t. (measurable s /\ measurable t) ==> measurable (s UNION t)) /\ (!(s:real^3->bool) t. (measurable s /\ measurable t) ==> measurable (s INTER t)) /\ (!(s:real^3->bool) t. (measurable s /\ measurable t) ==> measurable (s DIFF t))`, SIMP_TAC[MEASURABLE_UNION; MEASURABLE_INTER; MEASURABLE_DIFF] THEN REWRITE_TAC[REWRITE_RULE[ETA_AX] MEASURABLE_TRANSLATION] THEN SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE] THEN CONJ_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`X:real^3->bool`; `t:real^3`] THEN REWRITE_TAC[HAS_MEASURE_MEASURE] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_STRETCH) THEN DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i`) THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; scale; CART_EQ; LAMBDA_BETA; DIMINDEX_3; VECTOR_3; FORALL_3]] THEN X_GEN_TAC `C:real^3->bool` THEN REWRITE_TAC[primitive] THEN REWRITE_TAC[NORMBALL_BALL; RECT_INTERVAL] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[solid_triangle; NORMBALL_BALL; cone0; GSYM aff_gt_def] THEN REWRITE_TAC[MEASURABLE_BALL_AFF_GT]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_CONV0 THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; MAP_EVERY X_GEN_TAC [`v0:real^3`; `v1:real^3`; `v2:real^3`; `v3:real^3`; `h:real`; `a:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN ASM_CASES_TAC `collinear {v0:real^3, v1, v2}` THENL [ASM_SIMP_TAC[WEDGE_DEGENERATE; INTER_EMPTY; MEASURABLE_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `collinear {v0:real^3, v1, v3}` THENL [ASM_SIMP_TAC[WEDGE_DEGENERATE; INTER_EMPTY; MEASURABLE_EMPTY]; ALL_TAC] THEN ASM_SIMP_TAC[VOLUME_FRUSTT_WEDGE]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN REWRITE_TAC[MEASURABLE_CONIC_CAP; BOUNDED_CONIC_CAP; OPEN_WEDGE]; SIMP_TAC[MEASURABLE_INTERVAL]; SIMP_TAC[MEASURABLE_ELLIPSOID]; SIMP_TAC[MEASURABLE_BALL_WEDGE]]);; let vol_solid_triangle = new_definition `vol_solid_triangle v0 v1 v2 v3 r = let a123 = dihV v0 v1 v2 v3 in let a231 = dihV v0 v2 v3 v1 in let a312 = dihV v0 v3 v1 v2 in (a123 + a231 + a312 - pi)*(r pow 3)/(&3)`;; let vol_frustt_wedge = new_definition `vol_frustt_wedge v0 v1 v2 v3 h a = (azim v0 v1 v2 v3)*(h pow 3)*(&1/(a*a) - &1)/(&6)`;; let vol_conic_cap_wedge = new_definition `vol_conic_cap_wedge v0 v1 v2 v3 r c = (azim v0 v1 v2 v3)*(&1 - c)*(r pow 3)/(&3)`;; (*** JRH corrected delta_x x12 x13 x14 x34 x24 x34 ***) (*** to delta_x x12 x13 x14 x34 x24 x23 ***) let vol_conv = new_definition `vol_conv v1 v2 v3 v4 = let x12 = dist(v1,v2) pow 2 in let x13 = dist(v1,v3) pow 2 in let x14 = dist(v1,v4) pow 2 in let x23 = dist(v2,v3) pow 2 in let x24 = dist(v2,v4) pow 2 in let x34 = dist(v3,v4) pow 2 in sqrt(delta_x x12 x13 x14 x34 x24 x23)/(&12)`;; let vol_rect = new_definition `vol_rect a b = if (a$1 < b$1) /\ (a$2 < b$2) /\ (a$3 < b$3) then (b$3-a$3)*(b$2-a$2)*(b$1-a$1) else &0`;; let vol_ball_wedge = new_definition `vol_ball_wedge v0 v1 v2 v3 r = (azim v0 v1 v2 v3)*(&2)*(r pow 3)/(&3)`;; let SDIFF = new_definition `SDIFF X Y = (X DIFF Y) UNION (Y DIFF X)`;; (*** JRH added the hypothesis "measurable" to the first one ***) (*** Could change the definition to make this hold anyway ***) (*** JRH changed solid triangle hypothesis to ~coplanar{...} ***) (*** since the current condition is not enough in general ***) let volume_props = prove (`(!C. measurable C ==> vol C >= &0) /\ (!Z. NULLSET Z ==> (vol Z = &0)) /\ (!X Y. measurable X /\ measurable Y /\ NULLSET (SDIFF X Y) ==> (vol X = vol Y)) /\ (!X t. (measurable X) /\ (measurable (IMAGE (scale t) X)) ==> (vol (IMAGE (scale t) X) = abs(t$1 * t$2 * t$3)*vol(X))) /\ (!X v. measurable X ==> (vol (IMAGE ((+) v) X) = vol X)) /\ (!v0 v1 v2 v3 r. (r > &0) /\ ~coplanar{v0,v1,v2,v3} ==> vol (solid_triangle v0 {v1,v2,v3} r) = vol_solid_triangle v0 v1 v2 v3 r) /\ (!v0 v1 v2 v3. vol(conv0 {v0,v1,v2,v3}) = vol_conv v0 v1 v2 v3) /\ (!v0 v1 v2 v3 h a. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\ (h >= &0) /\ (a > &0) /\ (a <= &1) ==> vol(frustt v0 v1 h a INTER wedge v0 v1 v2 v3) = vol_frustt_wedge v0 v1 v2 v3 h a) /\ (!v0 v1 v2 v3 r c. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\ (r >= &0) /\ (c >= -- (&1)) /\ (c <= &1) ==> (vol(conic_cap v0 v1 r c INTER wedge v0 v1 v2 v3) = vol_conic_cap_wedge v0 v1 v2 v3 r c)) /\ (!(a:real^3) (b:real^3). vol(rect a b) = vol_rect a b) /\ (!v0 v1 v2 v3 r. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\ (r >= &0) ==> (vol(normball v0 r INTER wedge v0 v1 v2 v3) = vol_ball_wedge v0 v1 v2 v3 r))`, SIMP_TAC[MEASURE_POS_LE; real_ge; real_gt] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE]; MAP_EVERY X_GEN_TAC [`s:real^3->bool`; `t:real^3->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[SDIFF] THEN SET_TAC[]; MAP_EVERY X_GEN_TAC [`X:real^3->bool`; `t:real^3`] THEN REWRITE_TAC[HAS_MEASURE_MEASURE] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_STRETCH o CONJUNCT1) THEN DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i`) THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[DIMINDEX_3; PRODUCT_3] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; scale; CART_EQ; LAMBDA_BETA; DIMINDEX_3; VECTOR_3; FORALL_3]; REWRITE_TAC[REWRITE_RULE[ETA_AX] MEASURE_TRANSLATION]; REPEAT STRIP_TAC THEN REWRITE_TAC[solid_triangle; vol_solid_triangle; NORMBALL_BALL] THEN REWRITE_TAC[cone0; GSYM aff_gt_def] THEN MATCH_MP_TAC VOLUME_SOLID_TRIANGLE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[vol_conv; VOLUME_OF_TETRAHEDRON]; SIMP_TAC[VOLUME_FRUSTT_WEDGE; vol_frustt_wedge] THEN SIMP_TAC[REAL_ARITH `&0 <= h ==> ~(h < &0)`] THEN SIMP_TAC[REAL_ARITH `a <= &1 ==> (&1 <= a <=> a = &1)`] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; SIMP_TAC[VOLUME_CONIC_CAP_WEDGE; vol_conic_cap_wedge] THEN SIMP_TAC[REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN SIMP_TAC[REAL_ARITH `c <= &1 ==> ~(&1 < c)`] THEN ASM_SIMP_TAC[REAL_ARITH `-- &1 <= c ==> max c (-- &1) = c`] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[vol_rect; RECT_INTERVAL; MEASURE_INTERVAL] THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[DIMINDEX_3; FORALL_3; PRODUCT_3] THEN MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `(a:real^3)$1 = (b:real^3)$1` THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL; COND_ID] THEN ASM_CASES_TAC `(a:real^3)$2 = (b:real^3)$2` THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL; COND_ID] THEN ASM_CASES_TAC `(a:real^3)$3 = (b:real^3)$3` THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL; COND_ID] THEN REWRITE_TAC[REAL_MUL_AC]; SIMP_TAC[VOLUME_BALL_WEDGE; NORMBALL_BALL; vol_ball_wedge]]);; (* ------------------------------------------------------------------------- *) (* Additional results on polyhedra and relation to fans. *) (* ------------------------------------------------------------------------- *) let POLYHEDRON_COLLINEAR_FACES_STRONG = prove (`!P:real^N->bool f f' p q s t. polyhedron P /\ vec 0 IN relative_interior P /\ f face_of P /\ ~(f = P) /\ f' face_of P /\ ~(f' = P) /\ p IN f /\ q IN f' /\ s > &0 /\ t > &0 /\ s % p = t % q ==> s = t`, ONCE_REWRITE_TAC[MESON[] `(!P f f' p q s t. Q P f f' p q s t) <=> (!s t P f f' p q. Q P f f' p q s t)`] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[real_gt] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv s):real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[VECTOR_MUL_LID; GSYM real_div] THEN ABBREV_TAC `u:real = t / s` THEN SUBGOAL_THEN `&0 < u /\ &1 < u` MP_TAC THENL [EXPAND_TAC "u" THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID]; ALL_TAC] THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`s < t`; `&0 < s`; `&0 < t`; `t:real / s = u`] THEN SPEC_TAC(`u:real`,`t:real`) THEN GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN SUBGOAL_THEN `?g:real^N->bool. g facet_of P /\ f' SUBSET g` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC FACE_OF_POLYHEDRON_SUBSET_FACET THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((vec 0:real^N) IN g)` ASSUME_TAC THENL [DISCH_TAC THEN MP_TAC(ISPECL [`P:real^N->bool`; `g:real^N->bool`; `P:real^N->bool`] SUBSET_OF_FACE_OF) THEN ASM_REWRITE_TAC[SUBSET_REFL; NOT_IMP] THEN CONJ_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[facet_of]; ASM SET_TAC[]]; ASM_MESON_TAC[facet_of; FACET_OF_REFL; SUBSET_ANTISYM; FACE_OF_IMP_SUBSET]]; ALL_TAC] THEN SUBGOAL_THEN `(g:real^N->bool) face_of P` MP_TAC THENL [ASM_MESON_TAC[facet_of]; ALL_TAC] THEN REWRITE_TAC[face_of] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `t % q:real^N`; `q:real^N`]) THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN EXPAND_TAC "p" THEN REWRITE_TAC[IN_SEGMENT] THEN CONJ_TAC THENL [CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN ASM SET_TAC[]; EXISTS_TAC `inv t:real` THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_INV_LT_1] THEN EXPAND_TAC "p" THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC]);; let POLYHEDRON_COLLINEAR_FACES = prove (`!P:real^N->bool f f' p q s t. polyhedron P /\ vec 0 IN interior P /\ f face_of P /\ ~(f = P) /\ f' face_of P /\ ~(f' = P) /\ p IN f /\ q IN f' /\ s > &0 /\ t > &0 /\ s % p = t % q ==> s = t`, MESON_TAC[POLYHEDRON_COLLINEAR_FACES_STRONG; INTERIOR_SUBSET_RELATIVE_INTERIOR; SUBSET]);; let vertices = new_definition `vertices s = {x:real^N | x extreme_point_of s}`;; let edges = new_definition `edges s = {{v,w} | segment[v,w] edge_of s}`;; let VERTICES_TRANSLATION = prove (`!a s. vertices (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (vertices s)`, REWRITE_TAC[vertices] THEN GEOM_TRANSLATE_TAC[]);; let VERTICES_LINEAR_IMAGE = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> vertices(IMAGE f s) = IMAGE f (vertices s)`, REWRITE_TAC[vertices; EXTREME_POINTS_OF_LINEAR_IMAGE]);; let EDGES_TRANSLATION = prove (`!a s. edges (IMAGE (\x. a + x) s) = IMAGE (IMAGE (\x. a + x)) (edges s)`, REWRITE_TAC[edges] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);; let EDGES_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> edges(IMAGE f s) = IMAGE (IMAGE f) (edges s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[edges] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN SUBGOAL_THEN `?v w. x = (f:real^M->real^N) v /\ y = f w` MP_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT; EDGE_OF_IMP_SUBSET; SUBSET; IN_IMAGE]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC)]; MAP_EVERY X_GEN_TAC [`v:real^M`; `w:real^M`] THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`(f:real^M->real^N) v`; `(f:real^M->real^N) w`]] THEN REWRITE_TAC[IMAGE_CLAUSES] THEN ASM_MESON_TAC[EDGE_OF_LINEAR_IMAGE; CLOSED_SEGMENT_LINEAR_IMAGE]);; add_translation_invariants [VERTICES_TRANSLATION; EDGES_TRANSLATION];; add_linear_invariants [VERTICES_LINEAR_IMAGE; EDGES_LINEAR_IMAGE];; (*** Correspondence with Flypaper: Definition 4.5: IS_AFFINE_HULL affine / hull aff_dim AFF_DIM_EMPTY Definition 4.6 : IN_INTERIOR IN_RELATIVE_INTERIOR CLOSURE_APPROACHABLE (Don't have definition of relative boundary, but several theorems use closure s DIFF relative_interior s.) Definition 4.7: face_of extreme_point_of (presumably it's meant to be the point not the singleton set, which the definition literally gives) facet_of edge_of (Don't have a definition of "proper"; I just use ~(f = {}) and/or ~(f = P) as needed.) Lemma 4.18: KREIN_MILMAN_MINKOWSKI Definition 4.8: polyhedron vertices Lemma 4.19: AFFINE_IMP_POLYHEDRON Lemma 4.20 (i): FACET_OF_POLYHEDRON_EXPLICIT Lemma 4.20 (ii): Direct consequence of RELATIVE_INTERIOR_POLYHEDRON Lemma 4.20 (iii): FACE_OF_POLYHEDRON_EXPLICIT / FACE_OF_POLYHEDRON Lemma 4.20 (iv): FACE_OF_TRANS Lemma 4.20 (v): EXTREME_POINT_OF_FACE Lemma 4.20 (vi): FACE_OF_EQ Corr. 4.7: FACE_OF_POLYHEDRON_POLYHEDRON Lemma 4.21: POLYHEDRON_COLLINEAR_FACES Def 4.9: vertices edges ****) (* ------------------------------------------------------------------------- *) (* Temporary backwards-compatible fix for introduction of "sphere" and *) (* "relative_frontier". *) (* ------------------------------------------------------------------------- *) let COMPACT_SPHERE = REWRITE_RULE[sphere; NORM_ARITH `dist(a:real^N,b) = norm(b - a)`] COMPACT_SPHERE;; let FRONTIER_CBALL = REWRITE_RULE[sphere] FRONTIER_CBALL;; let NEGLIGIBLE_SPHERE = REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE;; let RELATIVE_FRONTIER_OF_POLYHEDRON = RELATIVE_BOUNDARY_OF_POLYHEDRON;; (* ------------------------------------------------------------------------- *) (* Also, the finiteness hypothesis was removed from this theorem. *) (* Put back the old version since that might break some proofs. *) (* ------------------------------------------------------------------------- *) let SUM_POS_LE = prove (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f(x)) ==> &0 <= sum s f`, REWRITE_TAC[REWRITE_RULE[SUM_0] (ISPEC `\x. &0` SUM_LE)]);; (* ------------------------------------------------------------------------- *) (* Also, the definition of sqrt was totalized, so keep old theorems *) (* that have more hypotheses than the current ones. *) (* ------------------------------------------------------------------------- *) let SQRT_MUL = prove (`!x y. &0 <= x /\ &0 <= y ==> sqrt(x * y) = sqrt x * sqrt y`, MESON_TAC[SQRT_MUL]);; let SQRT_INV = prove (`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`, MESON_TAC[SQRT_INV]);; let SQRT_DIV = prove (`!x y. &0 <= x /\ &0 <= y ==> sqrt(x / y) = sqrt x / sqrt y`, MESON_TAC[SQRT_DIV]);; let SQRT_LT_0 = prove (`!x. &0 <= x ==> (&0 < sqrt x <=> &0 < x)`, MESON_TAC[SQRT_LT_0]);; let SQRT_EQ_0 = prove (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`, MESON_TAC[SQRT_EQ_0]);; let SQRT_MONO_LT = prove (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`, MESON_TAC[SQRT_MONO_LT]);; let SQRT_MONO_LE = prove (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`, MESON_TAC[SQRT_MONO_LE]);; let SQRT_MONO_LT_EQ = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`, MESON_TAC[SQRT_MONO_LT_EQ]);; let SQRT_MONO_LE_EQ = prove (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`, MESON_TAC[SQRT_MONO_LE_EQ]);; let SQRT_INJ = prove (`!x y. &0 <= x /\ &0 <= y ==> ((sqrt(x) = sqrt(y)) <=> (x = y))`, MESON_TAC[SQRT_INJ]);; let REAL_LE_LSQRT = prove (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`, MESON_TAC[REAL_LE_LSQRT]);; let REAL_LT_LSQRT = prove (`!x y. &0 <= x /\ &0 <= y /\ x < y pow 2 ==> sqrt x < y`, MESON_TAC[REAL_LT_LSQRT]);; (* ------------------------------------------------------------------------- *) (* Fix the congruence rules as expected in Flyspeck. *) (* Should exclude 6 recent mixed real/vector limit results. *) (* ------------------------------------------------------------------------- *) let bcs = [`(p <=> p') ==> (p' ==> (q <=> q')) ==> (p ==> q <=> p' ==> q')`; `(g <=> g') ==> (g' ==> t = t') ==> (~g' ==> e = e') ==> (if g then t else e) = (if g' then t' else e')`; `(!x. p x ==> f x = g x) ==> nsum {y | p y} (\i. f i) = nsum {y | p y} g`; `(!i. a <= i /\ i <= b ==> f i = g i) ==> nsum (a..b) (\i. f i) = nsum (a..b) g`; `(!x. x IN s ==> f x = g x) ==> nsum s (\i. f i) = nsum s g`; `(!x. p x ==> f x = g x) ==> sum {y | p y} (\i. f i) = sum {y | p y} g`; `(!i. a <= i /\ i <= b ==> f i = g i) ==> sum (a..b) (\i. f i) = sum (a..b) g`; `(!x. x IN s ==> f x = g x) ==> sum s (\i. f i) = sum s g`; `(!x. p x ==> f x = g x) ==> vsum {y | p y} (\i. f i) = vsum {y | p y} g`; `(!i. a <= i /\ i <= b ==> f i = g i) ==> vsum (a..b) (\i. f i) = vsum (a..b) g`; `(!x. x IN s ==> f x = g x) ==> vsum s (\i. f i) = vsum s g`; `(!x. p x ==> f x = g x) ==> product {y | p y} (\i. f i) = product {y | p y} g`; `(!i. a <= i /\ i <= b ==> f i = g i) ==> product (a..b) (\i. f i) = product (a..b) g`; `(!x. x IN s ==> f x = g x) ==> product s (\i. f i) = product s g`; `(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (at a) <=> (g --> l) (at a))`; `(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (at a within s) <=> (g --> l) (at a within s))`] and equiv t1 t2 = can (term_match [] t1) t2 && can (term_match [] t2) t1 in let congs' = filter (fun th -> exists (equiv (concl th)) bcs) (basic_congs()) in set_basic_congs congs';; hol-light/Multivariate/gamma.ml000066400000000000000000005732441303454263000170460ustar00rootroot00000000000000(* ========================================================================= *) (* The real and complex gamma functions and Euler-Mascheroni constant. *) (* ========================================================================= *) needs "Multivariate/cauchy.ml";; (* ------------------------------------------------------------------------- *) (* Euler-Mascheroni constant. *) (* ------------------------------------------------------------------------- *) let euler_mascheroni = new_definition `euler_mascheroni = reallim sequentially (\n. sum(1..n) (\k. inv(&k)) - log(&n))`;; let EULER_MASCHERONI = prove (`((\n. sum(1..n) (\k. inv(&k)) - log(&n)) ---> euler_mascheroni) sequentially`, REWRITE_TAC[euler_mascheroni; reallim] THEN CONV_TAC SELECT_CONV THEN SUBGOAL_THEN `real_summable (from 1) (\k. inv(&k) + (log(&k) - log(&(k + 1))))` MP_TAC THENL [MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN EXISTS_TAC `\k. &2 / &k pow 2` THEN CONJ_TAC THENL [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_SUMMABLE_LMUL THEN MATCH_MP_TAC REAL_SUMMABLE_ZETA_INTEGER THEN REWRITE_TAC[LE_REFL]; EXISTS_TAC `2` THEN REWRITE_TAC[GE; IN_FROM] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a + (b - c):real = a - (c - b)`] THEN ASM_SIMP_TAC[GSYM LOG_DIV; REAL_OF_NUM_LT; LE_1; ARITH_RULE `0 < n + 1`] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1; REAL_FIELD `&0 < n ==> (n + &1) / n = &1 + inv(n)`] THEN MP_TAC(ISPECL [`1`; `Cx(inv(&n))`] TAYLOR_CLOG)]; REWRITE_TAC[real_summable; real_sums; FROM_INTER_NUMSEG] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM) THEN REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ARITH `(x + y) - (x - z):real = y + z`] THEN REWRITE_TAC[SUM_DIFFS; LOG_1; COND_RAND; COND_RATOR] THEN REWRITE_TAC[REAL_ARITH `&0 - x + y = --(x - y)`] THEN MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN EXISTS_TAC `\n. &2 / &n` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN ASM_SIMP_TAC[REAL_ABS_NEG; GSYM LOG_DIV; REAL_OF_NUM_LT; LE_1; ARITH_RULE `0 < n + 1`] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1; REAL_FIELD `&0 < n ==> (n + &1) / n = &1 + inv(n)`] THEN MP_TAC(ISPECL [`0`; `Cx(inv(&n))`] TAYLOR_CLOG); REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_N]]] THEN REWRITE_TAC[GSYM CX_ADD; VSUM_SING_NUMSEG; COMPLEX_NORM_CX] THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM; COMPLEX_DIV_1] THEN ASM_SIMP_TAC[COMPLEX_POW_1; REAL_INV_LT_1; REAL_OF_NUM_LT; ARITH_RULE `1 < n <=> 2 <= n`] THEN REWRITE_TAC[COMPLEX_POW_2; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN ASM_SIMP_TAC[COMPLEX_NEG_NEG; GSYM CX_LOG; REAL_LT_ADD; REAL_OF_NUM_LT; LE_1; ARITH; REAL_LT_INV_EQ; GSYM CX_SUB] THEN REWRITE_TAC[REAL_POW_1; VECTOR_SUB_RZERO] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_SUB] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[real_div; REAL_POW_INV] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 / &2 <= &1 - &1 / n <=> inv(n) <= inv(&2)`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Simple-minded estimation of gamma using Euler-Maclaurin summation. *) (* ------------------------------------------------------------------------- *) let LOG2_APPROX_40 = prove (`abs(log(&2) - &381061692393 / &549755813888) <= inv(&2 pow 40)`, MP_TAC(SPECL [`41`; `Cx(--inv(&2))`] TAYLOR_CLOG) THEN SIMP_TAC[GSYM CX_DIV; GSYM CX_POW; GSYM CX_NEG; GSYM CX_ADD; GSYM CX_MUL; VSUM_CX; COMPLEX_NORM_CX; GSYM CX_LOG; GSYM CX_SUB; REAL_ARITH `&0 < &1 + --inv(&2)`] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `a * b / c:real = a / c * b`] THEN CONV_TAC(ONCE_DEPTH_CONV EXPAND_SUM_CONV) THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN SIMP_TAC[LOG_INV; REAL_ARITH `&0 < &2`] THEN REAL_ARITH_TAC);; let EULER_MASCHERONI_APPROX_32 = prove (`abs(euler_mascheroni - &2479122403 / &4294967296) <= inv(&2 pow 32)`, let lemma1 = prove (`!m n. 1 <= m /\ m <= n ==> abs((sum (1..n) (\k. inv(&k)) - log(&n)) - ((sum (1..m - 1) (\k. inv(&k)) - log(&m)) + (inv(&m) + inv(&n)) / &2 + &1 / &12 * (inv(&m pow 2) - inv(&n pow 2)) + -- &1 / &120 * (inv(&m pow 4) - inv(&n pow 4)))) <= inv(&60 * &m pow 5)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\k. inv(&k)`; `1:num`; `m - 1`; `n:num`] SUM_COMBINE_R) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= m ==> m - 1 + 1 = m`] THEN MP_TAC(ISPECL [`\n x. --(&1) pow n * &(FACT n) / x pow (n + 1)`; `m:num`; `n:num`; `2`] REAL_EULER_MACLAURIN) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ANTS_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; ADD_SUB; REAL_MUL_RID; REAL_SUB_LZERO] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_POW_EQ_0; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_CASES_TAC `x = &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM real_div; REAL_POW_POW] THEN ASM_SIMP_TAC[REAL_DIV_POW2_ALT; ARITH_RULE `~((k + 1) * 2 < k)`] THEN REWRITE_TAC[ARITH_RULE `(k + 1) * 2 - k = SUC(SUC k)`; ARITH_RULE `(k + 1) + 1 = SUC(SUC k)`] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_MUL_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM ADD1; FACT; REAL_OF_NUM_MUL; MULT_AC]; DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[real_div; REAL_MUL_LID; real_pow] THEN CONV_TAC(ONCE_DEPTH_CONV EXPAND_SUM_CONV) THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV BERNOULLI_CONV) THEN REWRITE_TAC[GSYM(BERNOULLI_CONV `bernoulli 5 x`)] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID; REAL_POW_1] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN DISCH_THEN SUBST1_TAC] THEN MP_TAC(ISPECL [`\x. log x`; `\x:real. inv x`; `&m`; `&n`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ANTS_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL; GSYM REAL_OF_NUM_ADD] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE)] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &120 * abs(real_integral (real_interval[&m,&n]) (\x. bernoulli 5 (frac x) * --(&120 * inv(x pow 6))))` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `b * --(n * inv x):real = --n * b / x`] THEN SUBGOAL_THEN `(\x. bernoulli 5 (frac x) / x pow 6) real_measurable_on real_interval[&m,&n]` ASSUME_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `integer` THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN SIMP_TAC[REAL_NEGLIGIBLE_COUNTABLE; COUNTABLE_INTEGER] THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN REWRITE_TAC[IN] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REAL_DIFFERENTIABLE_TAC THEN ASM_REWRITE_TAC[REAL_POW_EQ_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\x. inv(-- &60 * x pow 5)`; `\x. inv(&12 * x pow 6)`; `&m`; `&n`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ANTS_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN SUBGOAL_THEN `~(x = &0)` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; REWRITE_TAC[REAL_INV_MUL; REAL_ARITH `inv(-- &60) * x - inv(-- &60) * y = (y - x) / &60`] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN DISCH_TAC] THEN SUBGOAL_THEN `!x. x IN real_interval[&m,&n] ==> abs(bernoulli 5 (frac x) / x pow 6) <= inv(&12 * x pow 6)` ASSUME_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_INV_MUL; real_div; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`5`; `frac x`] BERNOULLI_BOUND) THEN SIMP_TAC[IN_REAL_INTERVAL; FLOOR_FRAC; REAL_LT_IMP_LE] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[BERNOULLI_CONV `bernoulli 4 (&0)`] THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `(\x. bernoulli 5 (frac x) / x pow 6) real_integrable_on real_interval[&m,&n]` ASSUME_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x:real. inv(&12 * x pow 6)` THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN ASM_MESON_TAC[real_integrable_on]; ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; REAL_ABS_MUL; REAL_MUL_ASSOC]] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID] THEN TRANS_TAC REAL_LE_TRANS `real_integral (real_interval [&m,&n]) (\x. inv(&12 * x pow 6))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[real_integrable_on]; FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REWRITE_TAC[REAL_INV_MUL] THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `(x - y) / &60 <= inv(&60) * x <=> &0 <= y`] THEN SIMP_TAC[REAL_POW_LE; REAL_POS]]) and lemma2 = prove (`!f g l m d e k. (f ---> l) sequentially ==> (g ---> m) sequentially /\ eventually (\n. abs(f n - g n) <= d) sequentially /\ abs(m - k) <= e - d ==> abs(l - k) <= e`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `abs(l - m) <= d ==> abs (m - k) <= e - d ==> abs (l - k) <= e`) THEN REWRITE_TAC[REAL_ABS_BOUNDS] THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` REALLIM_LBOUND); MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UBOUND)] THEN EXISTS_TAC `(\n. f n - g n):num->real` THEN ASM_SIMP_TAC[REALLIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN REAL_ARITH_TAC) in MATCH_MP_TAC(MATCH_MP lemma2 EULER_MASCHERONI) THEN MATCH_MP_TAC(MESON[] `(?a b c m:num. P (a m) (b m) (c m)) ==> ?a b c. P a b c`) THEN EXISTS_TAC `\m n. (sum(1..m - 1) (\k. inv(&k)) - log(&m)) + (inv(&m) + inv(&n)) / &2 + &1 / &12 * (inv(&m pow 2) - inv(&n pow 2)) + -- &1 / &120 * (inv(&m pow 4) - inv(&n pow 4))` THEN EXISTS_TAC `\m. (sum(1..m - 1) (\k. inv(&k)) - log(&m)) + inv(&m) / &2 + &1 / &12 * inv(&m pow 2) + -- &1 / &120 * inv(&m pow 4)` THEN EXISTS_TAC `\m. inv (&60 * &m pow 5)` THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `(!n. P n) /\ (?n. Q n) ==> (?n. P n /\ Q n)`) THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN REPEAT(MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC) THEN REWRITE_TAC[REALLIM_CONST] THEN REWRITE_TAC[REAL_ARITH `x / &2 = inv(&2) * x`] THEN MATCH_MP_TAC REALLIM_LMUL THEN REWRITE_TAC[real_sub] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[REALLIM_CONST] THEN REWRITE_TAC[REALLIM_NULL_NEG] THEN REWRITE_TAC[REALLIM_1_OVER_N] THEN MATCH_MP_TAC REALLIM_1_OVER_POW THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC(MESON[] `(?a. P a a /\ Q a) ==> ?a. (?b. P a b) /\ Q a`) THEN EXISTS_TAC `64` THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `log(&64) = &6 * log(&2)` SUBST1_TAC THENL [SIMP_TAC[GSYM LOG_POW; REAL_ARITH `&0 < &2`] THEN AP_TERM_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV; CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV EXPAND_SUM_CONV) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC LOG2_APPROX_40 THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Start with the log-gamma function. It's otherwise quite tedious to repeat *) (* essentially the same argument when we want the logarithm of the gamma *) (* function, since we can't just take the usual principal value of log. *) (* ------------------------------------------------------------------------- *) let lgamma = new_definition `lgamma z = lim sequentially (\n. z * clog(Cx(&n)) - clog z - vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m))))`;; let LGAMMA,COMPLEX_DIFFERENTIABLE_AT_LGAMMA = (CONJ_PAIR o prove) (`(!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> ((\n. z * clog(Cx(&n)) - clog z - vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m)))) --> lgamma(z)) sequentially) /\ (!z. (Im z = &0 ==> &0 < Re z) ==> lgamma complex_differentiable at z)`, SUBGOAL_THEN `open {z | !n. ~(z + Cx(&n) = Cx(&0))}` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `{z | !n. P n z} = UNIV DIFF {z | ?n. ~P n z}`] THEN REWRITE_TAC[GSYM closed] THEN MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IMP_CONJ] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[COMPLEX_RING `x + y = Cx(&0) <=> x = --y`] THEN REWRITE_TAC[COMPLEX_RING `--x - --y:complex = y - x`] THEN REWRITE_TAC[COMPLEX_EQ_NEG2; CX_INJ; GSYM CX_SUB; COMPLEX_NORM_CX] THEN SIMP_TAC[GSYM REAL_EQ_INTEGERS; INTEGER_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `!y. (!n. ~(y + Cx(&n) = Cx(&0))) ==> ?d l. &0 < d /\ !e. &0 < e ==> ?N. !n z. N <= n /\ z IN cball(y,d) ==> dist(z * clog(Cx(&n)) - vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m))), l z) < e` MP_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN REWRITE_TAC[OPEN_CONTAINS_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `y:complex`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `summable (from 1) (\m. Cx(&2 * ((norm(y:complex) + d) + (norm(y) + d) pow 2)) / Cx(&m) pow 2)` MP_TAC THENL [REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN MATCH_MP_TAC SUMMABLE_ZETA_INTEGER THEN REWRITE_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[summable; SERIES_CAUCHY; GE] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` (LABEL_TAC "M")) THEN MP_TAC(SPEC `&2 * (norm(y:complex) + d) + &1` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "N")) THEN EXISTS_TAC `MAX (MAX 1 2) (MAX M N)` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `z:complex`] THEN REWRITE_TAC[GE; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m + 1`; `n:num`]) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FROM_INTER_NUMSEG_MAX; ARITH_RULE `MAX 1 (m + 1) = m + 1`] THEN REWRITE_TAC[dist] THEN SUBGOAL_THEN `!n. 1 <= n ==> z * clog(Cx(&n)) - vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m))) = vsum(1..n) (\m. z * (clog(Cx(&(m + 1) - &1)) - clog(Cx(&m - &1))) - clog((Cx(&m) + z) / Cx(&m))) + z * clog(Cx(&0))` (fun th -> ASM_SIMP_TAC[th]) THENL [REWRITE_TAC[VSUM_SUB_NUMSEG] THEN ASM_SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG; VSUM_DIFFS_ALT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`; REAL_SUB_REFL] THEN REPEAT STRIP_TAC THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN SUBGOAL_THEN `1 <= m + 1 /\ m <= n` MP_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP VSUM_COMBINE_R th)])] THEN REWRITE_TAC[COMPLEX_RING `(x + a) - ((x + y) + a):complex = --y`] THEN REWRITE_TAC[NORM_NEG] THEN MATCH_MP_TAC COMPLEX_NORM_VSUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_DIV; REAL_CX; RE_CX] THEN REWRITE_TAC[COMPLEX_RING `z * (a - b) - c:complex = --(z * (b - a) + c)`; NORM_NEG; GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN SUBGOAL_THEN `1 <= k /\ 1 < k /\ 2 <= k` STRIP_ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `clog(Cx(&k - &1)) - clog(Cx(&k)) = clog(Cx(&1) - inv(Cx(&k)))` SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LE; REAL_SUB_LT; REAL_INV_LT_1; REAL_ARITH `&2 <= x ==> &0 < x /\ &1 < x /\ &0 < x - &1`; GSYM CX_SUB; GSYM CX_INV; GSYM LOG_DIV] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `2 <= k` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN MP_TAC(ISPECL [`1`; `z / Cx(&k)`] TAYLOR_CLOG) THEN MP_TAC(ISPECL [`1`; `--inv(Cx(&k))`] TAYLOR_CLOG) THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[GSYM VECTOR_SUB; NORM_NEG] THEN REWRITE_TAC[COMPLEX_NORM_INV; COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN REWRITE_TAC[COMPLEX_POW_NEG; ARITH; REAL_ABS_NUM; COMPLEX_POW_ONE] THEN ASM_SIMP_TAC[REAL_INV_LT_1; REAL_OF_NUM_LT; COMPLEX_DIV_1] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1; COMPLEX_POW_1] THEN REWRITE_TAC[REAL_MUL_LID; COMPLEX_MUL_LID] THEN DISCH_THEN(MP_TAC o SPEC `norm(z:complex)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_LMUL)) THEN REWRITE_TAC[NORM_POS_LE; GSYM COMPLEX_NORM_MUL] THEN SUBGOAL_THEN `norm(z:complex) < &k` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN CONV_TAC NORM_ARITH; ASM_REWRITE_TAC[COMPLEX_SUB_LDISTRIB]] THEN ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_FIELD `~(k = Cx(&0)) ==> (k + z) / k = Cx(&1) + z / k`] THEN MATCH_MP_TAC(NORM_ARITH `x' = --y' /\ d + e <= f ==> norm(x - x') <= d ==> norm(y - y') <= e ==> norm(x + y) <= f`) THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[REAL_POW_DIV; REAL_POW_INV; REAL_ARITH `n * inv k / d + n pow 2 / k / e <= (&2 * (x + x pow 2)) / k <=> (n * (&1 / d + n / e)) / k <= (x * (&2 + &2 * x)) / k`] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1; REAL_POW_LT] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN SUBGOAL_THEN `norm(z:complex) <= norm(y:complex) + d` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_SUB_LE; NORM_POS_LE; REAL_POS] THEN REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1]; REWRITE_TAC[REAL_ARITH `&2 + &2 * x = &1 * &2 + x * &2`] THEN ONCE_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE; REAL_POS; REAL_LE_REFL; REAL_LE_INV_EQ] THEN REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN TRY(CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE [GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_ADD]) THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 / &2 <= &1 - x <=> x <= &1 / &2`] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN CONV_TAC NORM_ARITH; GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`dd:complex->real`; `ll:complex->complex->complex`] THEN DISCH_THEN(LABEL_TAC "*")] THEN SUBGOAL_THEN `!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> ((\n. z * clog(Cx(&n)) - vsum (1..n) (\m. clog((Cx(&m) + z) / Cx(&m)))) --> ll z z) sequentially` ASSUME_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; GSYM SKOLEM_THM] THEN MESON_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[lgamma; lim] THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC `(ll:complex->complex->complex) z z - clog z` THEN ONCE_REWRITE_TAC[COMPLEX_RING `w - z - v:complex = (w - v) - z`] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN ASM_MESON_TAC[]; DISCH_TAC] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN SUBGOAL_THEN `!n. ~(z + Cx(&n) = Cx(&0))` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `z + x = Cx(&0) <=> z = --x`] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN REWRITE_TAC[IM_NEG; RE_NEG; IM_CX; RE_CX] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\z. (ll:complex->complex->complex) z z - clog z` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; SUBSET; IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN EXISTS_TAC `\n. w * clog(Cx(&n)) - clog w - vsum(1..n) (\m. clog((Cx(&m) + w) / Cx(&m)))` THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[COMPLEX_RING `w - z - v:complex = (w - v) - z`] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_CLOG] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `(ll:complex->complex->complex) z` THEN EXISTS_TAC `min e (dd(z:complex))` THEN ASM_SIMP_TAC[REAL_LT_MIN] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. w * clog(Cx(&n)) - vsum(1..n) (\m. clog((Cx(&m) + w) / Cx(&m)))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SEQUENTIALLY] THEN CONJ_TAC THEN X_GEN_TAC `r:real` THEN STRIP_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`); REMOVE_THEN "*" (MP_TAC o SPEC `w:complex`)] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `r:real`)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[IN_CBALL; REAL_LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `open {z | Im z = &0 ==> &0 < Re z}` MP_TAC THENL [SUBGOAL_THEN `{z | Im z = &0 ==> &0 < Re z} = (:complex) DIFF ({z | Im z = &0} INTER {z | Re z <= &0})` (fun th -> SIMP_TAC[th; CLOSED_HALFSPACE_RE_LE; GSYM closed; CLOSED_HALFSPACE_IM_EQ; CLOSED_INTER]) THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_DIFF; IN_INTER; EXTENSION] THEN REAL_ARITH_TAC; REWRITE_TAC[OPEN_CONTAINS_CBALL; IN_ELIM_THM; SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `(ll:complex->complex->complex) z continuous_on cball(z,min r (dd z)) /\ ll z holomorphic_on ball(z,min r (dd z))` MP_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` HOLOMORPHIC_UNIFORM_LIMIT) THEN EXISTS_TAC `\n z. z * clog(Cx(&n)) - vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m)))` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[CBALL_MIN_INTER; IN_INTER] THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[GSYM dist] THEN ASM_MESON_TAC[]] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET] `t SUBSET s /\ f holomorphic_on s ==> f continuous_on s /\ f holomorphic_on t`) THEN REWRITE_TAC[BALL_SUBSET_CBALL; GSYM CBALL_MIN_INTER] THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN MATCH_MP_TAC HOLOMORPHIC_ON_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; complex_div; HOLOMORPHIC_ON_MUL] THEN MATCH_MP_TAC HOLOMORPHIC_ON_CLOG THEN REWRITE_TAC[FORALL_IN_IMAGE; GSYM complex_div; IMP_CONJ] THEN ASM_SIMP_TAC[RE_DIV_CX; IM_DIV_CX; REAL_DIV_EQ_0; RE_ADD; IM_ADD] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[IM_CX; RE_CX; REAL_ADD_LID] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_OF_NUM_LT; LE_1] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < &m + x`) THEN RULE_ASSUM_TAC(REWRITE_RULE[CBALL_MIN_INTER; IN_INTER]) THEN ASM_MESON_TAC[]; SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; complex_differentiable] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_MIN]]);; let LGAMMA_ALT = prove (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> ((\n. (z * clog(Cx(&n)) + clog(Cx(&(FACT n)))) - vsum(0..n) (\m. clog(Cx(&m) + z))) --> lgamma(z)) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LGAMMA) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SIMP_TAC[VECTOR_SUB_EQ; VSUM_CLAUSES_LEFT; LE_0; COMPLEX_ADD_LID] THEN MATCH_MP_TAC(COMPLEX_RING `a:complex = d - c ==> x - y - a = (x + c) - (y + d)`) THEN REWRITE_TAC[GSYM NPRODUCT_FACT; ADD_CLAUSES] THEN SIMP_TAC[REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG; GSYM CX_LOG; LOG_PRODUCT; PRODUCT_POS_LT; IN_NUMSEG; REAL_OF_NUM_LT; LE_1; GSYM VSUM_CX] THEN REWRITE_TAC[GSYM VSUM_SUB_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN REWRITE_TAC[complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN ASM_SIMP_TAC[CLOG_MUL_CX; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LE_1; GSYM CX_INV; LOG_INV; CX_NEG; GSYM complex_sub]);; let LGAMMA_ALT2 = prove (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> ((\n. vsum(1..n) (\m. z * clog(Cx(&1) + Cx(&1) / Cx(&m)) - clog(Cx(&1) + z / Cx(&m))) - clog(z)) --> lgamma(z)) sequentially`, REPEAT STRIP_TAC THEN SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_FIELD `~(m = Cx(&0)) ==> Cx(&1) + z / m = (z + m) / m`] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_DIV] THEN SIMP_TAC[GSYM CX_LOG; LOG_DIV; REAL_LT_DIV; REAL_ARITH `&0 < &1 + &m`; REAL_OF_NUM_LT; LE_1] THEN SIMP_TAC[VSUM_SUB_NUMSEG; VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN REWRITE_TAC[CX_SUB; REAL_OF_NUM_ADD; ARITH_RULE `1 + m = m + 1`] THEN REWRITE_TAC[VSUM_DIFFS_ALT; LOG_1; COMPLEX_SUB_RZERO] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LGAMMA) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE)) THEN DISCH_THEN(MP_TAC o SPEC `\r. r + 1`) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. --clog((Cx(&(n + 1)) + z) / Cx(&(n + 1)))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM ADD1; VSUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[COMPLEX_RING `Cx(&n) + z = z + Cx(&n)`] THEN SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_0] THEN CONV_TAC COMPLEX_RING; REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_NEG THEN SIMP_TAC[REAL_OF_NUM_EQ; CX_INJ; ARITH_EQ; ADD_EQ_0; COMPLEX_FIELD `~(y = Cx(&0)) ==> (y + z) / y = Cx(&1) + z / y`] THEN SUBGOAL_THEN `Cx(&0) = clog (Cx (&1) + Cx(&0))` SUBST1_TAC THENL [REWRITE_TAC[COMPLEX_ADD_RID; CLOG_1]; ALL_TAC] THEN MP_TAC(ISPECL [`\z. clog(Cx(&1) + z)`; `sequentially`] LIM_CONTINUOUS_FUNCTION) THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN COMPLEX_DIFFERENTIABLE_TAC THEN REWRITE_TAC[RE_ADD; RE_CX] THEN REWRITE_TAC[REAL_ADD_RID; REAL_LT_01]; REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] (ISPECL [`f:num->complex`; `\n. n + 1`] LIM_SUBSEQUENCE)) THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM CX_INV; REWRITE_RULE[o_DEF] (GSYM REALLIM_COMPLEX)] THEN REWRITE_TAC[REALLIM_1_OVER_N]]]);; (* ------------------------------------------------------------------------- *) (* The complex gamma function (defined using the Gauss/Euler product). *) (* Note that this totalizes it with the value zero at the poles. *) (* ------------------------------------------------------------------------- *) let cgamma = new_definition `cgamma(z) = lim sequentially (\n. (Cx(&n) cpow z * Cx(&(FACT n))) / cproduct(0..n) (\m. z + Cx(&m)))`;; let [CGAMMA;CGAMMA_EQ_0;CGAMMA_LGAMMA] = (CONJUNCTS o prove) (`(!z. ((\n. (Cx(&n) cpow z * Cx(&(FACT n))) / cproduct(0..n) (\m. z + Cx(&m))) --> cgamma(z)) sequentially) /\ (!z. cgamma(z) = Cx(&0) <=> ?n. z + Cx(&n) = Cx(&0)) /\ (!z. cgamma(z) = if ?n. z + Cx(&n) = Cx(&0) then Cx(&0) else cexp(lgamma z))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `y:complex` THEN ASM_CASES_TAC `?n. y + Cx(&n) = Cx(&0)` THENL [ASM_REWRITE_TAC[GSYM NOT_EXISTS_THM] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `N:num`) THEN REWRITE_TAC[cgamma; lim] THEN MATCH_MP_TAC(MESON[LIM_UNIQUE] `~trivial_limit net /\ (f --> a) net ==> (f --> @a. (f --> a) net) net /\ (@a. (f --> a) net) = a`) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_DIV_EQ_0; CPRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[LE_REFL]; ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM])] THEN SUBGOAL_THEN `((\n. (Cx(&n) cpow y * Cx(&(FACT n))) / cproduct(0..n) (\m. y + Cx(&m))) --> cexp(lgamma y)) sequentially` ASSUME_TAC THENL [MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. cexp(y * clog(Cx(&n)) - clog y - vsum(1..n) (\m. clog((Cx(&m) + y) / Cx(&m))))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[CEXP_SUB; cpow; CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM NPRODUCT_FACT; REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG] THEN SIMP_TAC[CX_PRODUCT; FINITE_NUMSEG; GSYM CPRODUCT_INV] THEN SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0] THEN GEN_REWRITE_TAC RAND_CONV [COMPLEX_RING `a * b * c:complex = b * a * c`] THEN REWRITE_TAC[COMPLEX_ADD_RID] THEN BINOP_TAC THENL [ASM_MESON_TAC[COMPLEX_ADD_RID; CEXP_CLOG]; ALL_TAC] THEN SIMP_TAC[ADD_CLAUSES; GSYM CPRODUCT_MUL; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM CEXP_NEG; GSYM VSUM_NEG] THEN SIMP_TAC[CEXP_VSUM; FINITE_NUMSEG] THEN MATCH_MP_TAC CPRODUCT_EQ THEN REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[CEXP_NEG] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM COMPLEX_INV_INV] THEN REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [COMPLEX_MUL_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [COMPLEX_ADD_SYM] THEN MATCH_MP_TAC CEXP_CLOG THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_INV_EQ_0] THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN ASM_SIMP_TAC[LGAMMA; CONTINUOUS_AT_CEXP]]; MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[cgamma; lim] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN ASM_MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]; SIMP_TAC[CEXP_NZ]]]);; let CGAMMA_RECURRENCE_ALT = prove (`!z. cgamma(z) = cgamma(z + Cx(&1)) / z`, GEN_TAC THEN ASM_CASES_TAC `?n. z + Cx(&n) = Cx(&0)` THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[REWRITE_RULE[GSYM CGAMMA_EQ_0] th]) THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[COMPLEX_DIV_EQ_0] THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check (is_exists o concl)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[COMPLEX_ADD_RID; CGAMMA_EQ_0] THEN REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN MESON_TAC[ADD1; ADD_SYM]; RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM])] THEN SUBGOAL_THEN `!n. ~((z + Cx(&1)) + Cx(&n) = Cx(&0))` ASSUME_TAC THENL [REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_ADD_LID]; ALL_TAC] THEN MATCH_MP_TAC(COMPLEX_FIELD `(a * b) / c = Cx(&1) /\ ~(a = Cx(&0)) /\ ~(c = Cx(&0)) ==> b = c / a`) THEN ASM_REWRITE_TAC[CGAMMA_EQ_0] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. (z * (Cx(&(n + 1)) cpow z * Cx(&(FACT(n + 1)))) / cproduct(0..n+1) (\m. z + Cx(&m))) / ((Cx(&n) cpow (z + Cx(&1)) * Cx(&(FACT n))) / cproduct(0..n) (\m. (z + Cx(&1)) + Cx(&m)))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_COMPLEX_DIV THEN ASM_REWRITE_TAC[CGAMMA; CGAMMA_EQ_0] THEN MATCH_MP_TAC LIM_COMPLEX_LMUL THEN MP_TAC(SPEC `z:complex` CGAMMA) THEN DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `1 + n = n + 1`] THEN SIMP_TAC[SYM(ISPECL [`f:num->complex`; `m:num`; `1`] CPRODUCT_OFFSET)] THEN SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN REWRITE_TAC[GSYM ADD1; FACT; CX_MUL; COMPLEX_MUL_ASSOC; GSYM REAL_OF_NUM_MUL; ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] (GSYM CPOW_SUC)] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN REWRITE_TAC[COMPLEX_ADD_RID; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `a * b * c * d * e * f * g * h:complex = (a * d) * (c * g) * (h * e) * (b * f)`] THEN ASM_SIMP_TAC[GSYM complex_div; COMPLEX_DIV_REFL; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ; COMPLEX_MUL_LID] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_LID] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC COMPLEX_DIV_REFL THEN SIMP_TAC[CPRODUCT_EQ_0; FINITE_NUMSEG] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. cexp((z + Cx(&1)) * clog(Cx(&1) + inv(Cx(&n))))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; NOT_SUC; LE_1] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CEXP_SUB] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_FIELD `~(n = Cx(&0)) ==> Cx(&1) + inv n = (n + Cx(&1)) / n`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM CX_ADD] THEN ASM_SIMP_TAC[REAL_OF_NUM_ADD; GSYM CX_DIV; GSYM CX_LOG; LE_1; LOG_DIV; REAL_OF_NUM_LT; REAL_LT_DIV; ARITH_RULE `0 < n + 1`] THEN REWRITE_TAC[CX_SUB]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CEXP_0] THEN MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\n. Cx(&2) * inv(Cx(&n))` THEN SIMP_TAC[LIM_INV_N; LIM_NULL_COMPLEX_LMUL] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN REWRITE_TAC[GE; IN_FROM] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`0`; `Cx(inv(&n))`] TAYLOR_CLOG) THEN SIMP_TAC[VSUM_CLAUSES_NUMSEG; ARITH; VECTOR_SUB_RZERO] THEN REWRITE_TAC[REAL_POW_1; GSYM CX_ADD; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_INV_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REWRITE_TAC[CX_ADD; CX_INV]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[real_div; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_INV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 / &2 <= &1 - x <=> x <= inv(&2)`] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC);; let CGAMMA_1 = prove (`cgamma(Cx(&1)) = Cx(&1)`, MP_TAC(SPEC `Cx(&1)` CGAMMA) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; TRIVIAL_LIMIT_SEQUENTIALLY] (ISPEC `sequentially` LIM_UNIQUE)) THEN REWRITE_TAC[GSYM CX_ADD; REAL_OF_NUM_ADD; ARITH_RULE `1 + n = n + 1`] THEN SIMP_TAC[SYM(ISPECL [`f:num->complex`; `m:num`; `1`] CPRODUCT_OFFSET)] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. Cx(&n / (&n + &1))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[CX_DIV] THEN ASM_SIMP_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_POW_1] THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC [GSYM COMPLEX_INV_INV] THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_INV_INV; COMPLEX_INV_MUL] THEN MATCH_MP_TAC(COMPLEX_FIELD `a * b = c /\ ~(b = Cx(&0)) ==> a = inv b * c`) THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN REWRITE_TAC[REAL_OF_NUM_SUC; REAL_OF_NUM_MUL; GSYM(CONJUNCT2 FACT)] THEN REWRITE_TAC[ADD_CLAUSES; ADD1] THEN SPEC_TAC(`n + 1`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[FACT; CPRODUCT_CLAUSES_NUMSEG; ARITH] THEN ASM_REWRITE_TAC[CX_MUL; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n`; COMPLEX_MUL_SYM]; ALL_TAC] THEN SIMP_TAC[REAL_FIELD `&n / (&n + &1) = &1 - inv(&n + &1)`] THEN SUBST1_TAC(COMPLEX_RING `Cx(&1) = Cx(&1) - Cx(&0)`) THEN REWRITE_TAC[CX_SUB] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST; REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(ISPECL [`f:num->complex`; `l:complex`; `1`] SEQ_OFFSET) THEN REWRITE_TAC[CX_INV; LIM_INV_N]);; let CGAMMA_RECURRENCE = prove (`!z. cgamma(z + Cx(&1)) = if z = Cx(&0) then Cx(&1) else z * cgamma(z)`, GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_ADD_LID; CGAMMA_1] THEN MATCH_MP_TAC(COMPLEX_FIELD `a = b / c /\ ~(c = Cx(&0)) ==> b = c * a`) THEN ASM_MESON_TAC[CGAMMA_RECURRENCE_ALT]);; let CGAMMA_FACT = prove (`!n. cgamma(Cx(&(n + 1))) = Cx(&(FACT n))`, INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; CGAMMA_1] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[CX_ADD] THEN REWRITE_TAC[CGAMMA_RECURRENCE; CX_INJ; REAL_OF_NUM_EQ; ADD_EQ_0; ARITH] THEN ASM_REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_MUL; CX_MUL]);; let CGAMMA_POLES = prove (`!n. cgamma(--(Cx(&n))) = Cx(&0)`, REWRITE_TAC[CGAMMA_EQ_0] THEN MESON_TAC[COMPLEX_ADD_LINV]);; let COMPLEX_DIFFERENTIABLE_AT_CGAMMA = prove (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> cgamma complex_differentiable at z`, let lemma = prove (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) /\ cgamma complex_differentiable at (z + Cx(&1)) ==> cgamma complex_differentiable at z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\z. cgamma(z + Cx(&1)) / z`; `&1`] THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CGAMMA_RECURRENCE_ALT]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_ID] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[COMPLEX_ADD_RID]] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN ASM_REWRITE_TAC[] THEN COMPLEX_DIFFERENTIABLE_TAC) in REPEAT STRIP_TAC THEN MP_TAC(SPEC `abs(Re z) + &1` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN SUBGOAL_THEN `!n. n <= N ==> cgamma complex_differentiable (at (z + Cx(&N) - Cx(&n)))` MP_TAC THENL [ALL_TAC; MESON_TAC[LE_REFL; COMPLEX_SUB_REFL; COMPLEX_ADD_RID]] THEN INDUCT_TAC THENL [DISCH_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\z. cexp(lgamma z)` THEN SUBGOAL_THEN `open {z | !n. ~(z + Cx(&n) = Cx(&0))}` MP_TAC THENL [REWRITE_TAC[SET_RULE `{z | !n. P n z} = UNIV DIFF {z | ?n. ~P n z}`] THEN REWRITE_TAC[GSYM closed] THEN MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IMP_CONJ] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[COMPLEX_RING `x + y = Cx(&0) <=> x = --y`] THEN REWRITE_TAC[COMPLEX_RING `--x - --y:complex = y - x`] THEN REWRITE_TAC[COMPLEX_EQ_NEG2; CX_INJ; GSYM CX_SUB; COMPLEX_NORM_CX] THEN SIMP_TAC[GSYM REAL_EQ_INTEGERS; INTEGER_CLOSED]; REWRITE_TAC[open_def; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w - Cx(&N)`) THEN ASM_SIMP_TAC[dist; COMPLEX_RING `w - n - z:complex = w - (z + n)`] THEN REWRITE_TAC[CGAMMA_LGAMMA] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `n:num`) THEN DISCH_THEN(MP_TAC o SPEC `n + N:num`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD] THEN ASM_REWRITE_TAC[COMPLEX_RING `w - N + n + N:complex = w + n`]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_AT_CEXP] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_LGAMMA THEN REWRITE_TAC[RE_ADD; RE_CX] THEN ASM_REAL_ARITH_TAC]]; DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; CX_ADD] THEN MATCH_MP_TAC lemma THEN REWRITE_TAC[COMPLEX_RING `(z + N - (n + w)) + w:complex = z + N - n`] THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN X_GEN_TAC `m:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `(N + m) - (n + 1)`) THEN SUBGOAL_THEN `n + 1 <= N + m` (fun th -> SIMP_TAC[th; GSYM REAL_OF_NUM_SUB]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD; CX_SUB] THEN CONV_TAC COMPLEX_RING]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CGAMMA = prove (`!z s. (!n. ~(z + Cx(&n) = Cx(&0))) ==> cgamma complex_differentiable at z within s`, SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CGAMMA]);; let HOLOMORPHIC_ON_CGAMMA = prove (`!s. s SUBSET {z | !n. ~(z + Cx(&n) = Cx(&0))} ==> cgamma holomorphic_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_WITHIN_CGAMMA THEN ASM SET_TAC[]);; let CONTINUOUS_AT_CGAMMA = prove (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> cgamma continuous at z`, SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT; COMPLEX_DIFFERENTIABLE_AT_CGAMMA]);; let CONTINUOUS_WITHIN_CGAMMA = prove (`!z s. (!n. ~(z + Cx(&n) = Cx(&0))) ==> cgamma continuous at z within s`, SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; COMPLEX_DIFFERENTIABLE_WITHIN_CGAMMA]);; let CONTINUOUS_ON_CGAMMA = prove (`!s. s SUBSET {z | !n. ~(z + Cx(&n) = Cx(&0))} ==> cgamma continuous_on s`, SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_CGAMMA]);; let CGAMMA_SIMPLE_POLES = prove (`!n. ((\z. (z + Cx(&n)) * cgamma z) --> --Cx(&1) pow n / Cx(&(FACT n))) (at(--Cx(&n)))`, INDUCT_TAC THENL [REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_NEG_0; FACT; complex_pow; COMPLEX_DIV_1] THEN ONCE_REWRITE_TAC[CGAMMA_RECURRENCE_ALT] THEN MATCH_MP_TAC LIM_TRANSFORM_AWAY_AT THEN MAP_EVERY EXISTS_TAC [`\z. cgamma(z + Cx(&1))`; `Cx(&1)`] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN SUBGOAL_THEN `(\z. cgamma (z + Cx(&1))) continuous at (Cx(&0))` MP_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL [CONTINUOUS_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_AT_CGAMMA THEN REWRITE_TAC[GSYM CX_ADD; CX_INJ] THEN REAL_ARITH_TAC; REWRITE_TAC[CONTINUOUS_AT; COMPLEX_ADD_LID; CGAMMA_1]]; REWRITE_TAC[FACT; CX_MUL; GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[CGAMMA_RECURRENCE_ALT] THEN REWRITE_TAC[complex_div; complex_pow; COMPLEX_INV_MUL] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(--Cx(&1) * p) * is * i = (p * i) * --is`] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o ISPECL [`at (--Cx(&(SUC n)))`; `\z. z + Cx(&1)`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] LIM_COMPOSE_AT))) THEN REWRITE_TAC[o_DEF; GSYM REAL_OF_NUM_SUC; CX_ADD] THEN REWRITE_TAC[COMPLEX_RING `(z + Cx(&1)) + w = z + (w + Cx(&1))`] THEN REWRITE_TAC[GSYM complex_div] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [LIM_TAC THEN CONV_TAC COMPLEX_RING; REWRITE_TAC[EVENTUALLY_AT; GSYM DIST_NZ] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONV_TAC COMPLEX_RING]; REWRITE_TAC[COMPLEX_NEG_INV; GSYM CONTINUOUS_AT] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_INV_AT THEN REWRITE_TAC[GSYM CX_NEG; CX_INJ; GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN REAL_ARITH_TAC]]);; let CNJ_CGAMMA = prove (`!z. cnj(cgamma z) = cgamma(cnj z)`, GEN_TAC THEN MP_TAC(SPEC `cnj z` CGAMMA) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LIM_UNIQUE) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN GEN_REWRITE_TAC I [GSYM LIM_CNJ] THEN REWRITE_TAC[CNJ_CNJ] THEN MP_TAC(SPEC `z:complex` CGAMMA) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN SIMP_TAC[CNJ_DIV; CNJ_MUL; CNJ_CX; CNJ_CPRODUCT; FINITE_NUMSEG] THEN REWRITE_TAC[CNJ_ADD; CNJ_CNJ; CNJ_CX] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[cpow; CNJ_EQ_0] THEN DISCH_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[CNJ_CX; CNJ_CEXP] THEN REWRITE_TAC[CNJ_MUL; CNJ_CNJ] THEN ASM_SIMP_TAC[CNJ_CLOG; RE_CX; REAL_OF_NUM_LT; LE_1; CNJ_CX]);; let REAL_GAMMA = prove (`!z. real z ==> real(cgamma z)`, SIMP_TAC[REAL_CNJ; CNJ_CGAMMA]);; let RE_POS_CGAMMA_REAL = prove (`!z. real z /\ &0 <= Re z ==> &0 <= Re(cgamma z)`, REWRITE_TAC[REAL_EXISTS; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN GEN_TAC THEN X_GEN_TAC `x:real` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[RE_CX] THEN DISCH_TAC THEN MP_TAC(SPEC `Cx x` CGAMMA) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> p /\ r ==> q ==> s`] LIM_RE_LBOUND) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; LE_1; GSYM CX_LOG; GSYM CX_INV; REAL_OF_NUM_LT; GSYM CX_MUL; GSYM CX_EXP; RE_MUL_CX; RE_CX; complex_div; GSYM CX_ADD; GSYM CX_PRODUCT; FINITE_NUMSEG] THEN MATCH_MP_TAC REAL_LE_MUL THEN SIMP_TAC[REAL_LE_MUL; REAL_EXP_POS_LE; REAL_POS; REAL_LE_INV_EQ] THEN MATCH_MP_TAC PRODUCT_POS_LE_NUMSEG THEN ASM_REAL_ARITH_TAC);; let CGAMMA_LEGENDRE_ALT = prove (`!z. cgamma(z) * cgamma(z + Cx(&1) / Cx(&2)) = Cx(&2) cpow (Cx(&1) - Cx(&2) * z) * cgamma(Cx(&1) / Cx(&2)) * cgamma(Cx(&2) * z)`, REWRITE_TAC[GSYM CX_DIV] THEN SUBGOAL_THEN `?f. !z. (!n. ~(Cx(&2) * z + Cx(&n) = Cx(&0))) ==> (f --> (cgamma(z) * cgamma(z + Cx(&1 / &2))) / (Cx(&2) cpow (Cx(&1) - Cx(&2) * z) * cgamma(Cx(&2) * z))) sequentially` CHOOSE_TAC THENL [EXISTS_TAC `\n. (Cx(&n) cpow Cx(&1 / &2) * inv (Cx(&2))) * (Cx(&(FACT n)) pow 2 * inv (Cx(&(FACT (2 * n))))) * Cx(&4) pow (n + 1) * inv(Cx(&(2 * n + 1)))` THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `Cx(&2) * z` CGAMMA) THEN DISCH_THEN(MP_TAC o SPEC `\n. 2 * n` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE)) THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&2) cpow (Cx(&1) - Cx(&2) * z)` o MATCH_MP LIM_COMPLEX_LMUL) THEN MP_TAC(CONJ (SPEC `z:complex` CGAMMA) (SPEC `z + Cx(&1 / &2)` CGAMMA)) THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] LIM_COMPLEX_DIV))) THEN ASM_REWRITE_TAC[COMPLEX_ENTIRE; CPOW_EQ_0; CGAMMA_EQ_0] THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN SUBGOAL_THEN `((\n. (Cx(&2) * z + Cx(&(2 * n + 1))) / Cx(&(2 * n + 1))) --> Cx(&1)) sequentially` MP_TAC THENL [SIMP_TAC[complex_div; COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; COMPLEX_ADD_RDISTRIB; ARITH_RULE `~(2 * n + 1 = 0)`] THEN ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN REWRITE_TAC[COMPLEX_RING `(a + b) - b:complex = a`] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN MP_TAC(SPEC `\n. 2 * n + 1` (MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE) LIM_INV_N)) THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC; REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL)] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[CPOW_ADD; complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; CX_MUL] THEN SIMP_TAC[CPOW_MUL_REAL; REAL_CX; RE_CX; REAL_POS] THEN REWRITE_TAC[CPOW_SUB; CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN SIMP_TAC[COMPLEX_POW_1; complex_div; COMPLEX_INV_INV; COMPLEX_INV_MUL] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `x * y * a * b * c * d * e * f * g * h * i * j * k * l * m:complex = (x * y) * (e * h) * ((a * d) * k) * ((b * f) * l) * (i * j) * (m * c * g)`] THEN REWRITE_TAC[GSYM COMPLEX_POW_2; COMPLEX_MUL_2; CPOW_ADD] THEN ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_POW_EQ_0; CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; LE_1; COMPLEX_MUL_LID] THEN REWRITE_TAC[GSYM COMPLEX_MUL_2; GSYM COMPLEX_INV_MUL] THEN SIMP_TAC[GSYM CPRODUCT_MUL; FINITE_NUMSEG] THEN REWRITE_TAC[COMPLEX_RING `(z + m) * ((z + Cx(&1 / &2)) + m) = inv(Cx(&4)) * (Cx(&2) * z + Cx(&2) * m) * (Cx(&2) * z + Cx(&2) * m + Cx(&1))`] THEN SIMP_TAC[CPRODUCT_MUL; FINITE_NUMSEG; CPRODUCT_CONST_NUMSEG] THEN SIMP_TAC[GSYM CPRODUCT_MUL; SUB_0; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM CPRODUCT_PAIR] THEN SIMP_TAC[GSYM ADD1; CPRODUCT_CLAUSES_NUMSEG] THEN REWRITE_TAC[ADD1] THEN CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[LE_0; COMPLEX_INV_MUL; COMPLEX_INV_INV; GSYM COMPLEX_POW_INV] THEN ONCE_REWRITE_TAC[COMPLEX_RING `x * a * b * c * d * e * f:complex = (c * e) * a * b * d * f * x`] THEN ASM_SIMP_TAC[COMPLEX_MUL_RINV; CPRODUCT_EQ_0; FINITE_NUMSEG] THEN REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[GSYM COMPLEX_MUL_ASSOC; COMPLEX_MUL_LINV] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `!n. ~(Cx(&2) * z + Cx(&n) = Cx(&0))` THENL [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `z:complex` th) THEN MP_TAC(SPEC `Cx(&1 / &2)` th)) THEN ASM_REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL; GSYM CX_SUB; CX_INJ] THEN ANTS_TAC THENL [REAL_ARITH_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN REWRITE_TAC[CGAMMA_1; CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID; COMPLEX_DIV_1; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] LIM_UNIQUE)) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(p = Cx(&0)) /\ ~(z2 = Cx(&0)) ==> a = (z * z') / (p * z2) ==> z * z' = p * a * z2`) THEN ASM_REWRITE_TAC[CGAMMA_EQ_0; CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]; MATCH_MP_TAC(COMPLEX_RING `z = Cx(&0) /\ ((w = Cx(&0)) \/ (y = Cx(&0))) ==> w * y = p * q * z`) THEN REWRITE_TAC[CGAMMA_EQ_0] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[OR_EXISTS_THM; GSYM COMPLEX_ADD_ASSOC] THEN ONCE_REWRITE_TAC[COMPLEX_RING `z + n = Cx(&0) <=> Cx(&2) * z + Cx(&2) * n = Cx(&0)`] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL] THEN REWRITE_TAC[REAL_ARITH `&2 * (&1 / &2 + n) = &2 * n + &1`] THEN REWRITE_TAC[REAL_OF_NUM_SUC; REAL_OF_NUM_MUL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN MP_TAC(SPEC `n:num` EVEN_OR_ODD) THEN MESON_TAC[ODD_EXISTS; EVEN_EXISTS]]);; let CGAMMA_REFLECTION = prove (`!z. cgamma(z) * cgamma(Cx(&1) - z) = Cx pi / csin(Cx pi * z)`, let lemma = prove (`!w z. (?n. integer n /\ w = Cx n) /\ (?n. integer n /\ z = Cx n) /\ dist(w,z) < &1 ==> w = z`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[DIST_CX] THEN ASM_MESON_TAC[REAL_EQ_INTEGERS_IMP]) in ABBREV_TAC `g = \z. if ?n. integer n /\ z = Cx n then Cx pi else cgamma(z) * cgamma(Cx(&1) - z) * csin(Cx pi * z)` THEN SUBGOAL_THEN `!z. g(z + Cx(&1)):complex = g(z)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "g" THEN MATCH_MP_TAC(MESON[] `(p <=> p') /\ a = a' /\ b = b' ==> (if p then a else b) = (if p' then a' else b')`) THEN REWRITE_TAC[COMPLEX_RING `z + Cx(&1) = w <=> z = w - Cx(&1)`] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CX_SUB] THEN MESON_TAC[INTEGER_CLOSED; REAL_ARITH `(n + &1) - &1 = n`]; GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [CGAMMA_RECURRENCE_ALT] THEN REWRITE_TAC[COMPLEX_RING `a - (z + a):complex = --z`] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [CGAMMA_RECURRENCE_ALT] THEN REWRITE_TAC[COMPLEX_ADD_LDISTRIB; COMPLEX_MUL_RID; CSIN_ADD] THEN REWRITE_TAC[GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN REWRITE_TAC[COMPLEX_RING `--z + Cx(&1) = Cx(&1) - z`] THEN REWRITE_TAC[complex_div; COMPLEX_INV_NEG; COMPLEX_MUL_AC; CX_NEG; COMPLEX_MUL_LID; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_NEG_NEG] THEN REWRITE_TAC[COMPLEX_MUL_AC]]; ALL_TAC] THEN SUBGOAL_THEN `!n z. integer n ==> g(z + Cx n):complex = g z` ASSUME_TAC THENL [SUBGOAL_THEN `!n z. g(z + Cx(&n)):complex = g z` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; COMPLEX_ADD_RID] THEN ASM_REWRITE_TAC[CX_ADD; COMPLEX_ADD_ASSOC]; REWRITE_TAC[integer] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `abs x = a ==> x = a \/ x = --a`)) THEN ASM_REWRITE_TAC[CX_NEG; GSYM complex_sub] THEN ASM_MESON_TAC[COMPLEX_RING `(z - w) + w:complex = z`]]; ALL_TAC] THEN SUBGOAL_THEN `!z. ~(?n. integer n /\ z = Cx n) ==> g complex_differentiable (at z)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `\z. cgamma z * cgamma(Cx(&1) - z) * csin(Cx pi * z)` THEN SUBGOAL_THEN `closed {z | ?n. integer n /\ z = Cx n}` MP_TAC THENL [MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN MESON_TAC[lemma; dist]; REWRITE_TAC[closed; OPEN_CONTAINS_BALL; IN_UNIV; IN_DIFF]] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[] THEN REPEAT(MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_MUL_AT THEN CONJ_TAC) THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN CONJ_TAC; ALL_TAC] THEN (MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_CGAMMA ORELSE COMPLEX_DIFFERENTIABLE_TAC) THEN REWRITE_TAC[COMPLEX_RING `z + a:complex = b <=> z = b - a`; COMPLEX_RING `Cx(&1) - z = a - b <=> z = b - a + Cx(&1)`] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB] THEN ASM_MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `g complex_differentiable at (Cx(&0))` ASSUME_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `{Cx(&0)}` THEN REWRITE_TAC[OPEN_BALL; FINITE_SING] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; IN_DIFF; IN_SING] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `~(z = Cx(&0))` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN MESON_TAC[INTEGER_CLOSED]] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ALL_TAC; MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `~(z = Cx(&0))` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN MESON_TAC[INTEGER_CLOSED]] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[CONTINUOUS_AT] THEN EXPAND_TAC "g" THEN REWRITE_TAC[MESON[INTEGER_CLOSED] `?n. integer n /\ Cx(&0) = Cx(n)`] THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\z. Cx pi * (z * cgamma(z)) * cgamma(Cx(&1) - z) * csin(Cx pi * z) / (Cx pi * z)` THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN CONJ_TAC THENL [X_GEN_TAC `w:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN STRIP_TAC THEN COND_CASES_TAC THENL [UNDISCH_TAC `~(w = Cx(&0))` THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN MESON_TAC[INTEGER_CLOSED]; UNDISCH_TAC `~(w = Cx(&0))` THEN MP_TAC PI_NZ THEN REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD]; GEN_REWRITE_TAC LAND_CONV [COMPLEX_RING `p = p * Cx(&1) * Cx(&1) * Cx(&1)`] THEN MATCH_MP_TAC LIM_COMPLEX_LMUL THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [MP_TAC(SPEC `0` CGAMMA_SIMPLE_POLES) THEN REWRITE_TAC[FACT; COMPLEX_DIV_1; complex_pow; COMPLEX_ADD_RID] THEN REWRITE_TAC[COMPLEX_NEG_0]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [SUBGOAL_THEN `(cgamma o (\z. Cx(&1) - z)) continuous (at (Cx(&0)))` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL [CONTINUOUS_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_AT_CGAMMA THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; CX_INJ] THEN REAL_ARITH_TAC; REWRITE_TAC[CONTINUOUS_AT; o_DEF; COMPLEX_SUB_RZERO; CGAMMA_1]]; SUBGOAL_THEN `(\z. csin(Cx pi * z) / (Cx pi * z)) = (\z. csin z / z) o (\w. Cx pi * w)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPOSE_AT THEN EXISTS_TAC `Cx(&0)` THEN REWRITE_TAC[LIM_CSIN_OVER_X] THEN SIMP_TAC[EVENTUALLY_AT; COMPLEX_ENTIRE; CX_INJ; PI_NZ; GSYM DIST_NZ] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_01]] THEN LIM_TAC THEN CONV_TAC COMPLEX_RING]]; ALL_TAC] THEN SUBGOAL_THEN `g holomorphic_on (:complex)` ASSUME_TAC THENL [REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; WITHIN_UNIV; IN_UNIV] THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `?n. integer n /\ z = Cx n` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN EXISTS_TAC `(g:complex->complex) o (\z. z - Cx n)` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[COMPLEX_RING `(z - w) + w:complex = z`]; MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN ASM_REWRITE_TAC[COMPLEX_SUB_REFL] THEN COMPLEX_DIFFERENTIABLE_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!z. g(z / Cx(&2)) * g((z + Cx(&1)) / Cx(&2)) = cgamma(Cx(&1 / &2)) pow 2 * g(z)` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ (!x. x IN s ==> P x) ==> !x. P x`) THEN EXISTS_TAC `closure {z | !n. ~(integer n /\ z = Cx n)}` THEN CONJ_TAC THENL [REWRITE_TAC[CLOSURE_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `s = {} ==> t DIFF s = t`) THEN MATCH_MP_TAC COUNTABLE_EMPTY_INTERIOR THEN MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[GSYM REAL_NOT_LT; GSYM dist; REAL_LT_01] THEN ASM_MESON_TAC[lemma]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_SING] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN TRY(GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[IN_UNIV; WITHIN_UNIV] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN CONJ_TAC THEN CONTINUOUS_TAC; ALL_TAC] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM; IN_SING; COMPLEX_SUB_0] THEN DISCH_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN REWRITE_TAC[COMPLEX_RING `z / Cx(&2) = w <=> z = Cx(&2) * w`] THEN REWRITE_TAC[COMPLEX_RING `z + Cx(&1) = w <=> z = w - Cx(&1)`] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB] THEN REPEAT(COND_CASES_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED]; ALL_TAC]) THEN REWRITE_TAC[COMPLEX_RING `(a * b * c) * (d * e * f):complex = (a * d) * (e * b) * (c * f)`] THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) - (z + Cx(&1)) / Cx(&2) = (Cx(&1) - z) / Cx(&2)`] THEN REWRITE_TAC[COMPLEX_RING `(z + Cx(&1)) / Cx(&2) = z / Cx(&2) + Cx(&1) / Cx(&2) /\ Cx(&1) - z / Cx(&2) = ((Cx(&1) - z) / Cx(&2)) + Cx(&1) / Cx(&2)`] THEN REWRITE_TAC[CGAMMA_LEGENDRE_ALT] THEN MP_TAC(ISPEC `Cx(&1 / &2) * z * Cx pi` CSIN_DOUBLE) THEN MP_TAC(SPECL [`Cx(&2)`; `z:complex`; `--z:complex`] CPOW_ADD) THEN REWRITE_TAC[COMPLEX_ADD_RINV] THEN CONV_TAC(DEPTH_BINOP_CONV `==>` (BINOP_CONV(DEPTH_BINOP_CONV `complex_mul` (RAND_CONV COMPLEX_POLY_CONV)))) THEN REWRITE_TAC[CPOW_ADD; CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN REWRITE_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; CSIN_ADD] THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2; REAL_ARITH `&1 / &2 * x = x / &2`] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN SUBGOAL_THEN `?h. h holomorphic_on (:complex) /\ !z. z IN (:complex) ==> g z = cexp(h z)` MP_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] CONTRACTIBLE_IMP_HOLOMORPHIC_LOG) THEN ASM_REWRITE_TAC[CONTRACTIBLE_UNIV; IN_UNIV] THEN X_GEN_TAC `z:complex` THEN EXPAND_TAC "g" THEN COND_CASES_TAC THEN REWRITE_TAC[CX_INJ; PI_NZ] THEN REWRITE_TAC[CGAMMA_EQ_0; CSIN_EQ_0; COMPLEX_ENTIRE] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] CX_MUL] THEN REWRITE_TAC[COMPLEX_RING `a - z + b = Cx(&0) <=> z = a + b`] THEN REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL; CX_INJ; PI_NZ] THEN REWRITE_TAC[COMPLEX_RING `z + a = Cx(&0) <=> z = --a`] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG] THEN ASM_MESON_TAC[INTEGER_CLOSED]; REWRITE_TAC[IN_UNIV] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN MP_TAC(ISPECL [`h:complex->complex`; `(:complex)`] HOLOMORPHIC_ON_OPEN) THEN ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h':complex->complex` THEN DISCH_TAC THEN SUBGOAL_THEN `!z. (h'(z / Cx(&2)) + h'((z + Cx(&1)) / Cx(&2))) / Cx(&2) = h'(z)` ASSUME_TAC THENL [X_GEN_TAC `z:complex` THEN MATCH_MP_TAC (COMPLEX_RING `!a. ~(a = Cx(&0)) /\ a * x = a * y ==> x = y`) THEN EXISTS_TAC `g(z / Cx(&2)) * g((z + Cx(&1)) / Cx(&2))` THEN REWRITE_TAC[COMPLEX_ENTIRE] THEN CONJ_TAC THENL [ASM_MESON_TAC[CEXP_NZ]; ALL_TAC] THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN EXISTS_TAC `\z. g (z / Cx(&2)) * g ((z + Cx(&1)) / Cx(&2)):complex` THEN EXISTS_TAC `z:complex` THEN CONJ_TAC THENL [REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM]) THEN REWRITE_TAC[] THEN ASM GEN_COMPLEX_DIFF_TAC [] THEN (CONJ_TAC THENL [ASM_REWRITE_TAC[]; CONV_TAC COMPLEX_RING]); ALL_TAC] THEN MP_TAC(ISPECL [`h:complex->complex`; `h':complex->complex`; `(:complex)`] HOLOMORPHIC_DERIVATIVE) THEN ASM_REWRITE_TAC[OPEN_UNIV] THEN DISCH_TAC THEN MP_TAC(ISPECL [`h':complex->complex`; `(:complex)`] HOLOMORPHIC_ON_OPEN) THEN ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h'':complex->complex` THEN DISCH_TAC THEN SUBGOAL_THEN `!z. (h''(z / Cx(&2)) + h''((z + Cx(&1)) / Cx(&2))) / Cx(&4) = h''(z)` ASSUME_TAC THENL [X_GEN_TAC `z:complex` THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN EXISTS_TAC `\z. (h'(z / Cx(&2)) + h'((z + Cx(&1)) / Cx(&2))) / Cx(&2)` THEN EXISTS_TAC `z:complex` THEN CONJ_TAC THENL [REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN ASM GEN_COMPLEX_DIFF_TAC [] THEN (CONJ_TAC THENL [ASM_REWRITE_TAC[ETA_AX]; CONV_TAC COMPLEX_RING]); ALL_TAC] THEN MP_TAC(ISPECL [`h':complex->complex`; `h'':complex->complex`; `(:complex)`] HOLOMORPHIC_DERIVATIVE) THEN ASM_REWRITE_TAC[OPEN_UNIV] THEN DISCH_TAC THEN SUBGOAL_THEN `!z. z IN (:complex) ==> h''(z) = Cx(&0)` MP_TAC THENL [MATCH_MP_TAC ANALYTIC_CONTINUATION THEN EXISTS_TAC `cball(Cx(&0),&1)` THEN EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[CONNECTED_UNIV; SUBSET_UNIV; IN_UNIV] THEN SIMP_TAC[INTERIOR_LIMIT_POINT; INTERIOR_CBALL; CENTRE_IN_BALL; OPEN_UNIV; REAL_LT_01] THEN MP_TAC(ISPECL [`\z. norm((h'':complex->complex) z)`; `cball(Cx(&0),&1)`] CONTINUOUS_ATTAINS_SUP) THEN ASM_REWRITE_TAC[COMPLEX_IN_CBALL_0; COMPACT_CBALL; CBALL_EQ_EMPTY] THEN REWRITE_TAC[o_DEF] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC(NORM_ARITH `!w:complex. norm(w) <= norm(w) / &2 /\ norm(z) <= norm(w) ==> z = vec 0`) THEN EXISTS_TAC `(h'':complex->complex) w` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN MATCH_MP_TAC(NORM_ARITH `norm(a) <= e /\ norm(b) <= e ==> norm(a + b) / &4 <= e / &2`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN UNDISCH_TAC `norm(w:complex) <= &1` THEN MP_TAC(SPEC `&1` COMPLEX_NORM_CX) THEN CONV_TAC NORM_ARITH]; REWRITE_TAC[IN_UNIV] THEN DISCH_TAC] THEN MP_TAC(ISPECL [`h':complex->complex`; `(:complex)`] HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN REWRITE_TAC[CONVEX_UNIV; IN_UNIV] THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN MP_TAC(ISPECL [`\z. (h:complex->complex) z - a * z`; `(:complex)`] HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN REWRITE_TAC[CONVEX_UNIV; IN_UNIV] THEN ANTS_TAC THENL [GEN_TAC THEN ASM GEN_COMPLEX_DIFF_TAC[] THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING; REWRITE_TAC[COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN DISCH_THEN(X_CHOOSE_TAC `b:complex`)] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&1`; `Cx(&0)`]) THEN MP_TAC(ASSUME `!z:complex. cexp (h z) = g z`) THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[ ASSUME`!x. (h:complex->complex) x = a * x + b`] THEN REWRITE_TAC[INTEGER_CLOSED; COMPLEX_ADD_LID; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[CEXP_ADD; COMPLEX_MUL_RID] THEN REWRITE_TAC[COMPLEX_RING `a * b = b <=> a = Cx(&1) \/ b = Cx(&0)`] THEN REWRITE_TAC[CEXP_NZ; CEXP_EQ_1] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC)) THEN UNDISCH_TAC `!z:complex. cexp(h z) = g z` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = &0` THENL [SUBST1_TAC(SYM(SPEC `a:complex` COMPLEX)) THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; GSYM CX_DEF] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_LID] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `?n. integer n /\ z = Cx n` THENL [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC(COMPLEX_RING `z = Cx(&0) /\ ((w = Cx(&0)) \/ (y = Cx(&0))) ==> w * y = p * z`) THEN REWRITE_TAC[CGAMMA_EQ_0; CSIN_EQ_0; COMPLEX_INV_EQ_0] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_MUL_SYM; CX_MUL]; ALL_TAC] THEN REWRITE_TAC[OR_EXISTS_THM; GSYM COMPLEX_ADD_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `c - z + n = Cx(&0) <=> z = n + c`] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `m:real` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN REWRITE_TAC[integer] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` (MP_TAC o MATCH_MP (REAL_ARITH `abs x = n ==> x = n \/ x = --n`))) THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN REWRITE_TAC[GSYM CX_ADD; CX_INJ; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; REAL_ARITH `--p + n = &0 <=> p = n`] THEN REWRITE_TAC[EXISTS_OR_THM; GSYM EXISTS_REFL] THEN REWRITE_TAC[ADD_EQ_0; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN MESON_TAC[num_CASES; ADD1]; SUBGOAL_THEN `(g:complex->complex) z = g(Cx(&0))` MP_TAC THENL [ASM_REWRITE_TAC[]; EXPAND_TAC "g"] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTEGER_CLOSED]] THEN MP_TAC PI_NZ THEN REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD]; DISCH_THEN(fun th -> MP_TAC(SPEC `Cx(inv(&4 * n))` th) THEN MP_TAC(SPEC `Cx(&0)` th)) THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN SUBGOAL_THEN `g(Cx(&0)) = Cx pi` SUBST1_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN REWRITE_TAC[CEXP_ADD] THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC(SYM(SPEC `a:complex` COMPLEX)) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV o RAND_CONV) [complex_mul] THEN REWRITE_TAC[RE; IM; REAL_MUL_LZERO; IM_CX; RE_CX] THEN REWRITE_TAC[CEXP_COMPLEX; REAL_ADD_LID] THEN ASM_SIMP_TAC[REAL_FIELD `~(n = &0) ==> (&2 * n * pi) * inv(&4 * n) = pi / &2`] THEN REWRITE_TAC[SIN_PI2; COS_PI2; GSYM ii] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_REFL; REAL_EXP_0] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN EXPAND_TAC "g" THEN ASM_SIMP_TAC[CX_INJ; REAL_FIELD `~(n = &0) ==> (inv(&4 * n) = m <=> &4 * m * n = &1)`] THEN COND_CASES_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `abs`) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN REPEAT(FIRST_X_ASSUM(CHOOSE_TAC o GEN_REWRITE_RULE I [integer])) THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; MULT_EQ_1] THEN CONV_TAC NUM_REDUCE_CONV; MATCH_MP_TAC(MESON[] `real y /\ ~real x ==> ~(x = y)`) THEN SIMP_TAC[GSYM CX_SUB; GSYM CX_MUL; REAL_CX; REAL_SIN; REAL_GAMMA; REAL_MUL; ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] REAL_MUL_CX] THEN REWRITE_TAC[PI_NZ; real; IM_II] THEN ARITH_TAC]]);; let CGAMMA_HALF = prove (`cgamma(Cx(&1) / Cx(&2)) = Cx(sqrt pi)`, MP_TAC(SPEC `Cx(&1) / Cx(&2)` CGAMMA_REFLECTION) THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) - Cx(&1) / Cx(&2) = Cx(&1) / Cx(&2)`] THEN REWRITE_TAC[GSYM CX_DIV; GSYM CX_MUL; GSYM CX_SIN] THEN REWRITE_TAC[REAL_ARITH `x * &1 / &2 = x / &2`; SIN_PI2; REAL_DIV_1] THEN SUBGOAL_THEN `Cx pi = Cx(sqrt pi) pow 2` SUBST1_TAC THENL [REWRITE_TAC[GSYM CX_POW] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[SQRT_POW2; PI_POS_LE]; REWRITE_TAC[COMPLEX_RING `a * a:complex = b pow 2 <=> a = b \/ a = --b`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `Cx(&1 / &2)` RE_POS_CGAMMA_REAL) THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; RE_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[REAL_ARITH `~(&0 <= --x) <=> &0 < x`] THEN MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]]);; let CGAMMA_LEGENDRE = prove (`!z. cgamma(z) * cgamma(z + Cx(&1) / Cx(&2)) = Cx(&2) cpow (Cx(&1) - Cx(&2) * z) * Cx(sqrt pi) * cgamma(Cx(&2) * z)`, REWRITE_TAC[CGAMMA_LEGENDRE_ALT; CGAMMA_HALF]);; (* ------------------------------------------------------------------------- *) (* Thw Weierstrass product definition. *) (* ------------------------------------------------------------------------- *) let CGAMMA_WEIERSTRASS = prove (`!z. ((\n. cexp(--(Cx euler_mascheroni) * z) / z * cproduct(1..n) (\k. cexp(z / Cx(&k)) / (Cx(&1) + z / Cx(&k)))) --> cgamma z) sequentially`, GEN_TAC THEN SIMP_TAC[complex_div; CPRODUCT_MUL; FINITE_NUMSEG] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (cexp(--Cx euler_mascheroni * z) * cproduct(1..n) (\k. cexp(z * inv(Cx(&k)))) * cexp(--Cx(log(&n)) * z)) * (Cx(&n) cpow z / z * cproduct (1..n) (\k. inv(Cx(&1) + z * inv(Cx(&k)))))` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL [EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC(COMPLEX_RING `c * c' = Cx(&1) ==> (a * b * c) * (c' * d) * e = ((a * d) * b * e)`) THEN ASM_SIMP_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; LE_1; GSYM CEXP_ADD] THEN REWRITE_TAC[GSYM CEXP_0] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LE_1] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_LID] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL [SIMP_TAC[GSYM CEXP_VSUM; FINITE_NUMSEG; GSYM CEXP_ADD] THEN REWRITE_TAC[GSYM CEXP_0] THEN MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN SIMP_TAC[CONTINUOUS_AT_CEXP; VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN REWRITE_TAC[COMPLEX_RING `--w * z + z * x + --y * z:complex = z * ((x - y) - w)`] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN REWRITE_TAC[GSYM LIM_NULL_COMPLEX] THEN REWRITE_TAC[GSYM CX_INV; VSUM_CX] THEN REWRITE_TAC[GSYM CX_SUB; REWRITE_RULE[o_DEF] (GSYM REALLIM_COMPLEX)] THEN REWRITE_TAC[EULER_MASCHERONI]; MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (Cx(&n) cpow z * Cx(&(FACT n))) / cproduct(0..n) (\m. z + Cx(&m))` THEN REWRITE_TAC[CGAMMA] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0] THEN REWRITE_TAC[COMPLEX_ADD_RID; ADD_CLAUSES] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [COMPLEX_RING `a * b * c:complex = b * a * c`] THEN AP_TERM_TAC THEN SIMP_TAC[CPRODUCT_INV; FINITE_NUMSEG] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM COMPLEX_INV_INV] THEN REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `~(z = Cx(&0)) /\ z * x = y ==> inv z * y = x`) THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN CONV_TAC SYM_CONV THEN SPEC_TAC(`n:num`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[FACT; CPRODUCT_CLAUSES_NUMSEG; ARITH] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n`; COMPLEX_MUL_LID] THEN ASM_REWRITE_TAC[CX_MUL; GSYM REAL_OF_NUM_MUL] THEN MATCH_MP_TAC(COMPLEX_RING `d * e:complex = c ==> (a * b) * c = (d * a) * b * e`) THEN MATCH_MP_TAC(COMPLEX_FIELD `~(p = Cx(&0)) ==> p * (Cx(&1) + z * inv p) = z + p`) THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; NOT_SUC]]);; (* ------------------------------------------------------------------------- *) (* Sometimes the reciprocal function is convenient, since it's entire. *) (* ------------------------------------------------------------------------- *) let COMPLEX_DIFFERENTIABLE_AT_RECIP_CGAMMA = prove (`!z. (inv o cgamma) complex_differentiable (at z)`, GEN_TAC THEN ASM_CASES_TAC `!n. ~(z + Cx(&n) = Cx(&0))` THENL [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_CGAMMA] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_INV_AT THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_ID; CGAMMA_EQ_0] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[COMPLEX_RING `z + w = Cx(&0) <=> z = --w`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN REWRITE_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_AT] THEN REWRITE_TAC[o_DEF; CGAMMA_POLES; COMPLEX_INV_0; complex_div; COMPLEX_MUL_LZERO; COMPLEX_SUB_RZERO] THEN SIMP_TAC[GSYM COMPLEX_INV_MUL; COMPLEX_RING `x - --z:complex = x + z`] THEN EXISTS_TAC `inv(--Cx(&1) pow n / Cx(&(FACT n)))` THEN MATCH_MP_TAC LIM_COMPLEX_INV THEN REWRITE_TAC[COMPLEX_DIV_EQ_0; COMPLEX_POW_EQ_0; CX_INJ] THEN REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[CGAMMA_SIMPLE_POLES] THEN CONV_TAC COMPLEX_RING]);; let COMPLEX_DIFFERENTIABLE_WITHIN_RECIP_CGAMMA = prove (`!z s. (inv o cgamma) complex_differentiable at z within s`, SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_RECIP_CGAMMA]);; let HOLOMORPHIC_ON_RECIP_CGAMMA = prove (`!s. (inv o cgamma) holomorphic_on s`, REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_WITHIN_RECIP_CGAMMA]);; let CONTINUOUS_AT_RECIP_CGAMMA = prove (`!z. (inv o cgamma) continuous at z`, SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT; COMPLEX_DIFFERENTIABLE_AT_RECIP_CGAMMA]);; let CONTINUOUS_WITHIN_RECIP_CGAMMA = prove (`!z s. (inv o cgamma) continuous at z within s`, SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; COMPLEX_DIFFERENTIABLE_WITHIN_RECIP_CGAMMA]);; let CONTINUOUS_ON_RECIP_CGAMMA = prove (`!s. (inv o cgamma) continuous_on s`, SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_RECIP_CGAMMA]);; let RECIP_CGAMMA = prove (`!z. ((\n. cproduct(0..n) (\m. z + Cx(&m)) / (Cx(&n) cpow z * Cx(&(FACT n)))) --> inv(cgamma z)) sequentially`, GEN_TAC THEN ASM_CASES_TAC `!n. ~(z + Cx(&n) = Cx(&0))` THENL [ONCE_REWRITE_TAC[GSYM COMPLEX_INV_INV] THEN MATCH_MP_TAC LIM_COMPLEX_INV THEN REWRITE_TAC[COMPLEX_INV_INV; CGAMMA; COMPLEX_INV_DIV; CGAMMA_EQ_0] THEN ASM_MESON_TAC[]; SUBGOAL_THEN `cgamma z = Cx(&0)` SUBST1_TAC THENL [ASM_MESON_TAC[CGAMMA_EQ_0]; REWRITE_TAC[COMPLEX_INV_0]] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; COMPLEX_DIV_EQ_0; COMPLEX_ENTIRE] THEN SIMP_TAC[CPRODUCT_EQ_0; IN_NUMSEG; FINITE_NUMSEG; LE_0] THEN ASM_MESON_TAC[]]);; let RECIP_CGAMMA_WEIERSTRASS = prove (`!n. ((\n. (z * cexp(Cx euler_mascheroni * z) * cproduct(1..n) (\k. (Cx(&1) + z / Cx(&k)) / cexp(z / Cx(&k))))) --> inv(cgamma z)) sequentially`, GEN_TAC THEN ASM_CASES_TAC `?n. z + Cx(&n) = Cx(&0)` THENL [FIRST_X_ASSUM(X_CHOOSE_TAC `N:num`) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN SUBGOAL_THEN `cgamma(z) = Cx(&0)` SUBST1_TAC THENL [ASM_MESON_TAC[CGAMMA_EQ_0]; REWRITE_TAC[COMPLEX_INV_0]] THEN REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_DIV_EQ_0] THEN ASM_CASES_TAC `N = 0` THENL [ASM_MESON_TAC[COMPLEX_ADD_RID]; ALL_TAC] THEN REPEAT DISJ2_TAC THEN SIMP_TAC[CPRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG] THEN EXISTS_TAC `N:num` THEN ASM_SIMP_TAC[LE_1; COMPLEX_DIV_EQ_0] THEN DISJ1_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD `x + n = Cx(&0) /\ ~(n = Cx(&0)) ==> Cx(&1) + x / n = Cx(&0)`) THEN ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ]; GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM COMPLEX_INV_INV] THEN MATCH_MP_TAC LIM_COMPLEX_INV THEN ASM_REWRITE_TAC[CGAMMA_EQ_0] THEN SIMP_TAC[COMPLEX_INV_MUL; GSYM CEXP_NEG; GSYM CPRODUCT_INV; FINITE_NUMSEG; GSYM COMPLEX_MUL_LNEG; COMPLEX_INV_DIV] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv z * a * b:complex = a / z * b`] THEN REWRITE_TAC[CGAMMA_WEIERSTRASS]]);; (* ------------------------------------------------------------------------- *) (* The real gamma function. *) (* ------------------------------------------------------------------------- *) let gamma = new_definition `gamma(x) = Re(cgamma(Cx x))`;; let CX_GAMMA = prove (`!x. Cx(gamma x) = cgamma(Cx x)`, REWRITE_TAC[gamma] THEN MESON_TAC[REAL; REAL_CX; REAL_GAMMA]);; let GAMMA = prove (`!x. ((\n. (&n rpow x * &(FACT n)) / product(0..n) (\m. x + &m)) ---> gamma(x)) sequentially`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_GAMMA; CX_DIV] THEN X_GEN_TAC `x:real` THEN MP_TAC(SPEC `Cx x` CGAMMA) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[CX_MUL; CX_PRODUCT; FINITE_NUMSEG; CX_ADD; cpow; rpow; CX_INJ; REAL_OF_NUM_EQ; REAL_OF_NUM_LT; LE_1; CX_LOG; CX_EXP]);; let GAMMA_EQ_0 = prove (`!x. gamma(x) = &0 <=> ?n. x + &n = &0`, REWRITE_TAC[GSYM CX_INJ; CX_ADD; CX_GAMMA; CGAMMA_EQ_0]);; let REAL_DIFFERENTIABLE_AT_GAMMA = prove (`!x. (!n. ~(x + &n = &0)) ==> gamma real_differentiable atreal x`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[gamma] THEN MATCH_MP_TAC (REWRITE_RULE[o_DEF] REAL_DIFFERENTIABLE_FROM_COMPLEX_AT) THEN REWRITE_TAC[REAL_GAMMA] THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_CGAMMA THEN ASM_REWRITE_TAC[GSYM CX_ADD; CX_INJ]);; let REAL_DIFFERENTIABLE_WITHIN_GAMMA = prove (`!x s. (!n. ~(x + &n = &0)) ==> gamma real_differentiable atreal x within s`, SIMP_TAC[REAL_DIFFERENTIABLE_AT_GAMMA; REAL_DIFFERENTIABLE_ATREAL_WITHIN]);; let REAL_DIFFERENTIABLE_ON_GAMMA = prove (`!s. s SUBSET {x | !n. ~(x + &n = &0)} ==> gamma real_differentiable_on s`, SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_WITHIN_GAMMA]);; let REAL_CONTINUOUS_ATREAL_GAMMA = prove (`!x. (!n. ~(x + &n = &0)) ==> gamma real_continuous atreal x`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_ATREAL] THEN REWRITE_TAC[o_DEF; CX_GAMMA] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; REWRITE_RULE[o_DEF] LINEAR_CX_RE] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC CONTINUOUS_AT_CGAMMA THEN ASM_REWRITE_TAC[GSYM CX_ADD; RE_CX; CX_INJ]);; let REAL_CONTINUOUS_WITHIN_GAMMA = prove (`!x s. (!n. ~(x + &n = &0)) ==> gamma real_continuous atreal x within s`, SIMP_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_ATREAL_GAMMA]);; let REAL_CONTINUOUS_ON_GAMMA = prove (`!s. s SUBSET {x | !n. ~(x + &n = &0)} ==> gamma real_continuous_on s`, SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_GAMMA]);; let REAL_DIFFERENTIABLE_ATREAL_RECIP_GAMMA = prove (`!x. (inv o gamma) real_differentiable (atreal x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[o_DEF; gamma] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_TRANSFORM_ATREAL THEN EXISTS_TAC `\x. Re(inv(cgamma(Cx x)))` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CX_GAMMA; GSYM CX_INV; RE_CX]; MATCH_MP_TAC (REWRITE_RULE[o_DEF] REAL_DIFFERENTIABLE_FROM_COMPLEX_AT) THEN SIMP_TAC[REAL_GAMMA; REAL_INV; GSYM o_DEF] THEN REWRITE_TAC[COMPLEX_DIFFERENTIABLE_AT_RECIP_CGAMMA]]);; let REAL_DIFFERENTIABLE_WITHIN_RECIP_GAMMA = prove (`!x s. (inv o gamma) real_differentiable atreal x within s`, SIMP_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_ATREAL_RECIP_GAMMA]);; let REAL_DIFFERENTIABLE_ON_RECIP_GAMMA = prove (`!s. (inv o gamma) real_differentiable_on s`, REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_WITHIN_RECIP_GAMMA]);; let REAL_CONTINUOUS_ATREAL_RECIP_GAMMA = prove (`!x. (inv o gamma) real_continuous atreal x`, SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; REAL_DIFFERENTIABLE_ATREAL_RECIP_GAMMA]);; let REAL_CONTINUOUS_WITHINREAL_RECIP_GAMMA = prove (`!x s. (inv o gamma) real_continuous atreal x within s`, SIMP_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_ATREAL_RECIP_GAMMA]);; let REAL_CONTINUOUS_ON_RECIP_GAMMA = prove (`!s. (inv o gamma) real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHINREAL_RECIP_GAMMA]);; let GAMMA_RECURRENCE_ALT = prove (`!x. gamma(x) = gamma(x + &1) / x`, REWRITE_TAC[GSYM CX_INJ; CX_DIV; CX_GAMMA; CX_ADD] THEN REWRITE_TAC[GSYM CGAMMA_RECURRENCE_ALT]);; let GAMMA_1 = prove (`gamma(&1) = &1`, REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CGAMMA_1]);; let GAMMA_RECURRENCE = prove (`!x. gamma(x + &1) = if x = &0 then &1 else x * gamma(x)`, REWRITE_TAC[GSYM CX_INJ; CX_GAMMA] THEN GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [COND_RAND] THEN REWRITE_TAC[CX_MUL; CX_GAMMA; CX_ADD; GSYM CGAMMA_RECURRENCE]);; let GAMMA_FACT = prove (`!n. gamma(&(n + 1)) = &(FACT n)`, REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CGAMMA_FACT]);; let GAMMA_POLES = prove (`!n. gamma(--(&n)) = &0`, REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CGAMMA_POLES; CX_NEG]);; let GAMMA_SIMPLE_POLES = prove (`!n. ((\x. (x + &n) * gamma x) ---> -- &1 pow n / &(FACT n)) (atreal(-- &n))`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; LIM_ATREAL_ATCOMPLEX] THEN GEN_TAC THEN REWRITE_TAC[CX_MUL; CX_ADD; CX_GAMMA; CX_DIV; CX_POW; CX_NEG] THEN SUBGOAL_THEN `(\z. (Cx(Re z) + Cx(&n)) * cgamma(Cx(Re z))) = (\z. (z + Cx(&n)) * cgamma z) o (Cx o Re)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPOSE_WITHIN THEN MAP_EVERY EXISTS_TAC [`(:complex)`; `--Cx(&n)`] THEN REWRITE_TAC[CGAMMA_SIMPLE_POLES; WITHIN_UNIV] THEN REWRITE_TAC[EVENTUALLY_WITHIN; o_DEF; IN_UNIV; GSYM DIST_NZ] THEN REWRITE_TAC[real; IN; GSYM CX_NEG; CX_INJ] THEN REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_01]] THEN MATCH_MP_TAC LIM_AT_WITHIN THEN LIM_TAC THEN REWRITE_TAC[RE_CX] THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[REWRITE_RULE[o_DEF] LINEAR_CX_RE]);; let GAMMA_POS_LE = prove (`!x. &0 <= x ==> &0 <= gamma x`, SIMP_TAC[gamma; RE_POS_CGAMMA_REAL; RE_CX; REAL_CX]);; let GAMMA_POS_LT = prove (`!x. &0 < x ==> &0 < gamma x`, SIMP_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`; GAMMA_POS_LE] THEN REWRITE_TAC[GAMMA_EQ_0] THEN REAL_ARITH_TAC);; let GAMMA_LEGENDRE_ALT = prove (`!x. gamma(x) * gamma(x + &1 / &2) = &2 rpow (&1 - &2 * x) * gamma(&1 / &2) * gamma(&2 * x)`, REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CX_ADD; CX_DIV; CGAMMA_LEGENDRE_ALT; CX_MUL] THEN REWRITE_TAC[cpow; rpow; CX_INJ; REAL_OF_NUM_LT; REAL_OF_NUM_EQ; ARITH] THEN SIMP_TAC[CX_MUL; CX_EXP; CX_SUB; CX_LOG; REAL_OF_NUM_LT; ARITH]);; let GAMMA_REFLECTION = prove (`!x. gamma(x) * gamma(&1 - x) = pi / sin(pi * x)`, SIMP_TAC[GSYM CX_INJ; CX_MUL; CX_DIV; CX_GAMMA; CX_SIN; CX_SUB] THEN REWRITE_TAC[CGAMMA_REFLECTION]);; let GAMMA_HALF = prove (`gamma(&1 / &2) = sqrt pi`, REWRITE_TAC[GSYM CX_INJ; CX_DIV; CX_GAMMA; CGAMMA_HALF]);; let GAMMA_LEGENDRE = prove (`!x. gamma(x) * gamma(x + &1 / &2) = &2 rpow (&1 - &2 * x) * sqrt pi * gamma(&2 * x)`, REWRITE_TAC[GAMMA_LEGENDRE_ALT; GAMMA_HALF]);; let GAMMA_WEIERSTRASS = prove (`!x. ((\n. exp(--(euler_mascheroni) * x) / x * product(1..n) (\k. exp(x / &k) / (&1 + x / &k))) ---> gamma x) sequentially`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_GAMMA; CX_DIV] THEN X_GEN_TAC `x:real` THEN MP_TAC(SPEC `Cx x` CGAMMA_WEIERSTRASS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[CX_MUL; CX_DIV; CX_EXP; CX_NEG; CX_PRODUCT; FINITE_NUMSEG; CX_ADD]);; (* ------------------------------------------------------------------------- *) (* Characterization of the real gamma function using log-convexity. *) (* ------------------------------------------------------------------------- *) let REAL_LOG_CONVEX_GAMMA = prove (`!s. (!x. x IN s ==> &0 < x) ==> gamma real_log_convex_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LOG_CONVEX_ON_SUBSET THEN EXISTS_TAC `{x | &0 < x}` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN POP_ASSUM(K ALL_TAC) THEN MATCH_MP_TAC(ISPEC `sequentially` REAL_LOG_CONVEX_LIM) THEN EXISTS_TAC `\n x. (&n rpow x * &(FACT n)) / product(0..n) (\m. x + &m)` THEN REWRITE_TAC[GAMMA; TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN REPEAT(MATCH_MP_TAC REAL_LOG_CONVEX_MUL THEN CONJ_TAC) THEN SIMP_TAC[REAL_LOG_CONVEX_CONST; REAL_POS] THEN ASM_SIMP_TAC[REAL_LOG_CONVEX_RPOW_RIGHT; REAL_OF_NUM_LT; LE_1] THEN SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG] THEN MATCH_MP_TAC REAL_LOG_CONVEX_PRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC MIDPOINT_REAL_LOG_CONVEX THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_INV_EQ; REAL_LTE_ADD; REAL_POS] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LTE_ADD; REAL_POS] THEN REWRITE_TAC[REAL_LE_POW_2; REAL_ARITH `(x + &k) * (y + &k) <= ((x + y) / &2 + &k) pow 2 <=> &0 <= (x - y) pow 2`]]);; let GAMMA_REAL_LOG_CONVEX_UNIQUE = prove (`!f:real->real. f(&1) = &1 /\ (!x. &0 < x ==> f(x + &1) = x * f(x)) /\ (!x. &0 < x ==> &0 < f x) /\ f real_log_convex_on {x | &0 < x} ==> !x. &0 < x ==> f x = gamma x`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!x. &0 < x /\ x <= &1 ==> f x = gamma x` ASSUME_TAC THENL [ALL_TAC; SUBGOAL_THEN `!y. &0 < y /\ y <= &1 ==> !n. f(&n + y) = gamma(&n + y)` ASSUME_TAC THENL [GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[REAL_ADD_LID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[REAL_ARITH `(n + &1) + x = (n + x) + &1`] THEN ASM_SIMP_TAC[GAMMA_RECURRENCE; REAL_LET_ADD; REAL_POS] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `x:real` THEN DISCH_TAC THEN MP_TAC(SPEC `x:real` FLOOR_POS) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `frac x = &0` THEN ASM_REWRITE_TAC[REAL_LT_LE] THENL [ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[REAL_ADD_RID; REAL_LT_IMP_NZ] THEN SUBGOAL_THEN `&(n - 1) + &1 = &n` (fun th -> ASM_MESON_TAC[th; REAL_LE_REFL; REAL_LT_01]) THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LE_1] THEN REAL_ARITH_TAC; STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `frac x`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]]]] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_CASES_TAC `x = &1` THEN ASM_REWRITE_TAC[GAMMA_1] THEN SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_FIELD `&0 < g /\ f / g = &1 ==> f = g`) THEN ASM_SIMP_TAC[GAMMA_POS_LT] THEN MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN EXISTS_TAC `\n. f(x) / ((&n rpow x * &(FACT n)) / product (0..n) (\m. x + &m))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_SIMP_TAC[REALLIM_DIV; REALLIM_CONST; GAMMA_POS_LT; GAMMA; REAL_LT_IMP_NZ] THEN ONCE_REWRITE_TAC[REALLIM_NULL] THEN MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN EXISTS_TAC `\n. x * inv(&n)` THEN SIMP_TAC[REALLIM_NULL_LMUL; REALLIM_1_OVER_N] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN SUBGOAL_THEN `!n. &2 <= &n ==> log(f(&n)) - log(f(&n - &1)) <= (log(f(&n + x)) - log(f(&n))) / x /\ (log(f(&n + x)) - log(f(&n))) / x <= log(f(&n + &1)) - log(f(&n))` MP_TAC THENL [MP_TAC(SPECL [`f:real->real`; `{x | &0 < x}`] REAL_LOG_CONVEX_ON) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; DISCH_TAC] THEN MAP_EVERY (MP_TAC o SPECL [`log o f:real->real`; `{x | &0 < x}`]) [REAL_CONVEX_ON_LEFT_SECANT; REAL_CONVEX_ON_RIGHT_SECANT] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "L") THEN DISCH_THEN(LABEL_TAC "R") THEN REPEAT STRIP_TAC THENL [USE_THEN "L" (MP_TAC o SPECL [`&n - &1`; `&n + x`; `&n`]) THEN USE_THEN "R" (MP_TAC o SPECL [`&n - &1`; `&n + x`; `&n`]) THEN REWRITE_TAC[IN_ELIM_THM; IN_REAL_SEGMENT; o_THM] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `abs(x - (x - &1)) = &1`; REAL_DIV_1] THEN DISCH_TAC THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs((n + x) - n) = x`] THEN ASM_REAL_ARITH_TAC; ASM_CASES_TAC `x = &1` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_DIV_1] THEN USE_THEN "R" (MP_TAC o SPECL [`&n`; `&n + &1`; `&n + x`]) THEN REWRITE_TAC[IN_ELIM_THM; IN_REAL_SEGMENT; o_THM] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `abs((n + &1) - n) = &1`; REAL_DIV_1] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs((n + x) - n) = x`] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM LOG_DIV; REAL_LT_MUL; REAL_ARITH `&2 <= x ==> &0 < x /\ &0 < x + &1 /\ &0 < x - &1`; REAL_FIELD `&0 < x ==> (n * x) / x = n`] THEN SUBGOAL_THEN `!n. &2 <= n ==> f(n - &1) = f(n) / (n - &1)` (fun th -> SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real->real) n = f((n - &1) + &1)` SUBST1_TAC THENL [AP_TERM_TAC THEN REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_ARITH `&2 <= n ==> &0 < n - &1`] THEN UNDISCH_TAC `&2 <= n` THEN CONV_TAC REAL_FIELD]; ASM_SIMP_TAC[REAL_ARITH `&2 <= x ==> &0 < x`; REAL_FIELD `&0 < x /\ &2 <= y ==> x / (x / (y - &1)) = y - &1`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ]] THEN SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN REWRITE_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD] THEN SUBGOAL_THEN `!n. 0 < n ==> f(&n) = &(FACT(n - 1))` (fun th -> SIMP_TAC[ARITH_RULE `2 <= n ==> 0 < n /\ 0 < n - 1`; th]) THENL [INDUCT_TAC THEN REWRITE_TAC[ARITH; LT_0] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_ADD_LID; FACT; ARITH] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC n - 1 = SUC(n - 1)`] THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUC; LE_1; FACT] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; MULT_SYM]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o BINOP_CONV) [GSYM REAL_EXP_MONO_LE] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[REAL_EXP_ADD; EXP_LOG; REAL_OF_NUM_LT; LE_1; FACT_NZ; ARITH_RULE `&2 <= &n /\ &0 < x ==> &0 < &n + x`] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN SUBGOAL_THEN `!n. 0 < n ==> f(&n + x) = product(0..n-1) (\k. x + &k) * f(x)` (fun th -> SIMP_TAC[ARITH_RULE `2 <= n ==> 0 < n`; th]) THENL [INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_CASES_TAC `n = 0` THENL [ASM_SIMP_TAC[REAL_ARITH `(&0 + &1) + x = x + &1`; ARITH] THEN REWRITE_TAC[PRODUCT_SING_NUMSEG; REAL_ADD_RID]; ASM_SIMP_TAC[REAL_ARITH `(n + &1) + x = (n + x) + &1`; REAL_LT_ADD; REAL_OF_NUM_LT; LE_1] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC n - 1 = SUC(n - 1)`] THEN REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; LE_0] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN REWRITE_TAC[REAL_MUL_AC; REAL_ADD_AC]]; DISCH_TAC] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x /\ x <= &1 + e ==> abs(x - &1) <= e`) THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_FIELD `&2 <= n ==> &1 + x * inv n = (x + n) / n`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN ONCE_REWRITE_TAC[REAL_ARITH `f * (r * n) * p:real = (p * f) * r * n`] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN SUBGOAL_THEN `&0 < &n rpow x * &(FACT n)` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; LE_1; FACT_NZ; RPOW_POS_LT; ARITH_RULE `2 <= x ==> 0 < x`]; ALL_TAC] THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_MUL_LID] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT1)] THEN REWRITE_TAC[ADD_SUB] THEN ASM_SIMP_TAC[rpow; REAL_OF_NUM_LE; REAL_ARITH `&2 <= x ==> &0 < x`] THEN REWRITE_TAC[REAL_MUL_AC]; ASM_SIMP_TAC[PRODUCT_CLAUSES_RIGHT; LE_0; ARITH_RULE `2 <= n ==> 0 < n`] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `a * b * c * d:real = b * (a * c) * d`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN SUBGOAL_THEN `FACT n = FACT(SUC(n - 1))` SUBST1_TAC THENL [AP_TERM_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[FACT]] THEN ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> SUC(n - 1) = n`] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN SUBGOAL_THEN `&0 < &n` MP_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; SIMP_TAC[rpow; GSYM REAL_OF_NUM_MUL; REAL_MUL_AC] THEN CONV_TAC REAL_FIELD]]);; (* ------------------------------------------------------------------------- *) (* The integral definition, the current usual one and Euler's original one. *) (* ------------------------------------------------------------------------- *) let EULER_HAS_INTEGRAL_CGAMMA = prove (`!z. &0 < Re z ==> ((\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))) has_integral cgamma(z)) {t | &0 <= drop t}`, let lemma0 = prove (`!z a b. &0 < Re z /\ &0 <= drop a ==> (\t. Cx(drop t) cpow z) continuous_on interval [a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN ASM_CASES_TAC `t:real^1 = vec 0` THENL [ASM_SIMP_TAC[CONTINUOUS_WITHIN; cpow; CX_INJ; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN ONCE_REWRITE_TAC[LIM_NULL_COMPLEX_NORM] THEN REWRITE_TAC[NORM_CEXP] THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN EXISTS_TAC `\t. Cx(exp(Re z * log(drop t)))` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DIST_0; NORM_POS_LT; GSYM DROP_EQ; LIFT_DROP; DROP_VEC] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < drop u` (fun th -> SIMP_TAC[GSYM CX_LOG; RE_MUL_CX; th]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[LIM_WITHIN; IN_INTERVAL_1; DIST_CX; REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e rpow inv(Re z)` THEN ASM_SIMP_TAC[RPOW_POS_LT; DIST_0; REAL_ABS_EXP] THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `e = exp(log e)` SUBST1_TAC THENL [ASM_MESON_TAC[EXP_LOG]; REWRITE_TAC[REAL_EXP_MONO_LT]] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`] THEN ASM_SIMP_TAC[GSYM LOG_RPOW] THEN MATCH_MP_TAC LOG_MONO_LT_IMP THEN SUBGOAL_THEN `norm u = drop u` (fun th -> ASM_MESON_TAC[th]) THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN THEN SUBGOAL_THEN `(\a. Cx(drop a) cpow z) = (\w. w cpow z) o Cx o drop` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN REWRITE_TAC[linear; o_DEF; DROP_ADD; DROP_CMUL; CX_ADD; COMPLEX_CMUL; GSYM CX_MUL]; MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE THEN COMPLEX_DIFFERENTIABLE_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[o_DEF; RE_CX] THEN ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]]) in let lemma1 = prove (`!n z. &0 < Re z ==> ((\t. Cx(drop t) cpow (z - Cx(&1)) * Cx(&1 - drop t) pow n) has_integral Cx(&(FACT n)) / cproduct (0..n) (\m. z + Cx(&m))) (interval[vec 0,vec 1])`, INDUCT_TAC THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL] THEN DISCH_TAC THENL [REWRITE_TAC[complex_pow; COMPLEX_MUL_RID; CPRODUCT_CLAUSES_NUMSEG] THEN MP_TAC(ISPECL [`\t. Cx(drop t) cpow z / z`; `\t. Cx(drop t) cpow (z - Cx(&1))`; `vec 0:real^1`; `vec 1:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN REWRITE_TAC[DROP_VEC; CPOW_1; CPOW_0; FACT; complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; COMPLEX_SUB_RZERO] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_POS] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_RMUL THEN MATCH_MP_TAC lemma0 THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS]; REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CX_SUB] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN COMPLEX_DIFF_TAC THEN ASM_REWRITE_TAC[RE_CX] THEN UNDISCH_TAC `~(z = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; FIRST_X_ASSUM(MP_TAC o SPEC `z + Cx(&1)`) THEN REWRITE_TAC[RE_ADD; RE_CX; COMPLEX_RING `(z + Cx(&1)) - Cx(&1) = z`] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN MP_TAC(ISPECL [`complex_mul`; `\t. Cx(drop t) cpow z`; `\t. Cx(&1) / Cx(&n + &1) * Cx(&1 - drop t) pow (n + 1)`; `\t. z * Cx(drop t) cpow (z - Cx(&1))`; `\t. --(Cx(&1 - drop t) pow n)`; `vec 0:real^1`; `vec 1:real^1`; `{vec 0:real^1}`; `Cx(&(FACT n)) / cproduct (0..n) (\m. (z + Cx(&1)) + Cx(&m))`] INTEGRATION_BY_PARTS) THEN REWRITE_TAC[BILINEAR_COMPLEX_MUL; DROP_VEC; REAL_POS; COUNTABLE_SING] THEN REWRITE_TAC[CPOW_0; REAL_SUB_REFL; COMPLEX_POW_ZERO; ADD_EQ_0; ARITH] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_SUB_LZERO] THEN REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_RING `--Cx(&0) - y = --y`] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_SIMP_TAC[lemma0; DROP_VEC; REAL_POS] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_POW THEN REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_SUB; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]; SIMP_TAC[IN_INTERVAL_1; DROP_VEC; IN_DIFF; IN_SING; GSYM DROP_EQ] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CX_SUB] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN COMPLEX_DIFF_TAC THEN ASM_REWRITE_TAC[RE_CX; COMPLEX_MUL_LID] THEN REWRITE_TAC[REAL_OF_NUM_ADD; ADD_SUB; COMPLEX_MUL_ASSOC] THEN MP_TAC(ARITH_RULE `~(n + 1 = 0)`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD; MATCH_MP_TAC HAS_INTEGRAL_NEG THEN ASM_REWRITE_TAC[]]; DISCH_THEN(MP_TAC o SPEC `Cx(&n + &1) / z` o MATCH_MP HAS_INTEGRAL_COMPLEX_LMUL) THEN ASM_SIMP_TAC[REAL_ARITH `~(&n + &1 = &0)`; CX_INJ; COMPLEX_FIELD `~(n = Cx(&0)) /\ ~(z = Cx(&0)) ==> n / z * (z * p) * Cx(&1) / n * q = p * q`] THEN REWRITE_TAC[GSYM ADD1] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FACT; GSYM REAL_OF_NUM_MUL; CX_MUL; GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN SIMP_TAC[CPRODUCT_CLAUSES_LEFT; ARITH_RULE `0 <= SUC n`] THEN REWRITE_TAC[ADD1; COMPLEX_INV_MUL; COMPLEX_ADD_RID] THEN REWRITE_TAC[ISPECL [`f:num->complex`; `m:num`; `1`] CPRODUCT_OFFSET] THEN REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `n + 1 = 1 + n`; COMPLEX_MUL_AC]]]) in let lemma2 = prove (`!z n. &0 < Re z ==> ((\t. if drop t <= &n then Cx(drop t) cpow (z - Cx(&1)) * Cx(&1 - drop t / &n) pow n else Cx(&0)) has_integral (Cx(&n) cpow z * Cx(&(FACT n))) / cproduct (0..n) (\m. z + Cx(&m))) {t | &0 <= drop t}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[CPOW_0; COMPLEX_MUL_LZERO; complex_div] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN MAP_EVERY EXISTS_TAC [`\t:real^1. Cx(&0)`; `{vec 0:real^1}`] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0; NEGLIGIBLE_SING] THEN REWRITE_TAC[IN_DIFF; IN_SING; GSYM DROP_EQ; DROP_VEC; IN_ELIM_THM] THEN REAL_ARITH_TAC; REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN REWRITE_TAC[HAS_INTEGRAL_RESTRICT_INTER] THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP lemma1) THEN DISCH_THEN(MP_TAC o SPECL [`inv(&n)`; `vec 0:real^1`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY)) THEN REWRITE_TAC[DIMINDEX_1; REAL_POW_1] THEN ASM_SIMP_TAC[REAL_INV_EQ_0; REAL_OF_NUM_EQ; LE_1; REAL_ABS_INV] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV; REAL_POS] THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY; VECTOR_ADD_RID; REAL_ABS_NUM] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_NEG_0; VECTOR_ADD_RID] THEN REWRITE_TAC[DROP_CMUL; COMPLEX_CMUL] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&n) cpow (z - Cx(&1))` o MATCH_MP HAS_INTEGRAL_COMPLEX_LMUL) THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM(ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] CPOW_SUC)] THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC; GSYM LIFT_EQ_CMUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] INTER; IN_ELIM_THM] THEN REWRITE_TAC[GSYM DROP_VEC; LIFT_DROP; GSYM IN_INTERVAL_1] THEN REWRITE_TAC[DROP_VEC; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[COMPLEX_RING `(z - Cx(&1)) + Cx(&1) = z`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; REAL_ARITH `inv x * y:real = y / x`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN IMP_REWRITE_TAC[GSYM CPOW_MUL_REAL] THEN ASM_SIMP_TAC[REAL_CX; RE_CX; REAL_LE_DIV; REAL_POS; GSYM CX_MUL] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; LE_1]]) in let lemma3 = prove (`f integrable_on s ==> (\x:real^N. lift(Re(f x))) integrable_on s /\ integral s (\x. lift(Re(f x))) = lift(Re(integral s f))`, SUBGOAL_THEN `!z. lift(Re z) = (lift o Re) z` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC INTEGRABLE_LINEAR; MATCH_MP_TAC INTEGRAL_LINEAR] THEN ASM_REWRITE_TAC[linear; COMPLEX_CMUL; o_THM; RE_ADD; RE_MUL_CX] THEN REWRITE_TAC[LIFT_CMUL; LIFT_ADD]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n t. if drop t <= &n then Cx(drop t) cpow (z - Cx(&1)) * Cx(&1 - drop t / &n) pow n else Cx(&0)`; `\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))`; `\t. lift(Re(Cx(drop t) cpow (Cx(Re z) - Cx(&1)) / cexp(Cx(drop t))))`; `{t | &0 <= drop t}`] DOMINATED_CONVERGENCE) THEN ASM_SIMP_TAC[REWRITE_RULE[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] lemma2] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN MESON_TAC[CGAMMA; LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY]] THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN REPEAT CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`n:num`; `t:real`] THEN DISCH_TAC THEN REWRITE_TAC[cpow; CX_INJ] THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COND_ID; RE_CX; CEXP_0; COMPLEX_DIV_1; COMPLEX_NORM_0; REAL_LE_REFL] THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_LT_LE; GSYM CX_EXP; GSYM CX_SUB; GSYM CX_MUL; RE_CX; GSYM CX_DIV; GSYM REAL_EXP_SUB] THEN COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_NORM_0; REAL_EXP_POS_LE] THEN REWRITE_TAC[COMPLEX_NORM_MUL; REAL_EXP_SUB; NORM_CEXP] THEN REWRITE_TAC[RE_MUL_CX; RE_SUB; RE_CX; COMPLEX_NORM_POW] THEN REWRITE_TAC[real_div] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_EXP_POS_LT] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN SUBGOAL_THEN `~(&n = &0)` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM real_div; REAL_OF_NUM_EQ] THEN DISCH_TAC THEN ASM_SIMP_TAC[real_abs; REAL_SUB_LE; REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LT; LE_1] THEN TRANS_TAC REAL_LE_TRANS `exp(--t / &n) pow n` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[REAL_ARITH `&1 - t / n = &1 + --t / n`; REAL_EXP_LE_X]; REWRITE_TAC[GSYM REAL_EXP_N; GSYM REAL_EXP_NEG] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; REAL_LE_REFL]]; REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\k. Cx t cpow (z - Cx(&1)) * Cx(&1 - t / &k) pow k` THEN CONJ_TAC THENL [MP_TAC(SPEC `t + &1` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; GSYM REAL_OF_NUM_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC; REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_COMPLEX_LMUL THEN REWRITE_TAC[CX_SUB; CX_DIV; GSYM CEXP_NEG] THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a - x / y:complex = a + --x / y`] THEN REWRITE_TAC[CEXP_LIMIT]]] THEN MP_TAC(ISPECL [`\n t. lift(Re(if drop t <= &n then Cx(drop t) cpow (Cx(Re z) - Cx(&1)) * Cx(&1 - drop t / &n) pow n else Cx(&0)))`; `\t. lift(Re(Cx(drop t) cpow (Cx(Re z) - Cx(&1)) / cexp(Cx(drop t))))`; `{t | &0 <= drop t}`] MONOTONE_CONVERGENCE_INCREASING) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_SIMP_TAC[lemma3; REWRITE_RULE[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] lemma2; RE_CX; bounded; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_UNIV; FORALL_LIFT; LIFT_DROP; NORM_LIFT] THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`n:num`; `t:real`] THEN DISCH_TAC THEN ASM_CASES_TAC `t = &0` THEN ASM_SIMP_TAC[CPOW_0; COMPLEX_MUL_LZERO; COND_ID; REAL_LE_REFL] THEN ASM_REWRITE_TAC[cpow; CX_INJ] THEN ASM_SIMP_TAC[cpow; CX_INJ; GSYM CX_SUB; GSYM CX_EXP; GSYM CX_LOG; REAL_LT_LE; GSYM CX_MUL; GSYM CX_DIV; RE_CX; GSYM CX_POW] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_CASES_TAC `t <= &n` THEN ASM_SIMP_TAC[REAL_ARITH `x <= n ==> x <= n + &1`] THENL [SIMP_TAC[RE_CX; REAL_LE_LMUL_EQ; REAL_EXP_POS_LT] THEN REWRITE_TAC[GSYM RPOW_POW; GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC REAL_EXP_LIMIT_RPOW_LE THEN ASM_REAL_ARITH_TAC; COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; RE_CX] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_SUB_LE] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN ASM_REAL_ARITH_TAC]; X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\k. lift(Re(Cx t cpow (Cx(Re z) - Cx(&1)) * Cx(&1 - t / &k) pow k))` THEN CONJ_TAC THENL [MP_TAC(SPEC `t + &1` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; GSYM REAL_OF_NUM_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC; REWRITE_TAC[cpow; CX_INJ] THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; complex_div; LIM_CONST] THEN ASM_SIMP_TAC[cpow; CX_INJ; GSYM CX_SUB; GSYM CX_EXP; GSYM CX_LOG; REAL_LT_LE; GSYM CX_MUL; GSYM CX_INV; RE_CX; GSYM CX_POW] THEN REWRITE_TAC[real_div; LIFT_CMUL; RE_CX] THEN MATCH_MP_TAC LIM_CMUL THEN REWRITE_TAC[REAL_ARITH `&1 - t * inv x = &1 + --t / x`] THEN REWRITE_TAC[GSYM REAL_EXP_NEG] THEN REWRITE_TAC[GSYM(REWRITE_RULE[o_DEF] TENDSTO_REAL)] THEN REWRITE_TAC[EXP_LIMIT]]; MP_TAC(MATCH_MP CONVERGENT_IMP_BOUNDED (SPEC `Cx(Re z)` CGAMMA)) THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LE_TRANS]]);; let EULER_INTEGRAL = prove (`!z. &0 < Re z ==> integral {t | &0 <= drop t} (\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))) = cgamma(z)`, MESON_TAC[INTEGRAL_UNIQUE; EULER_HAS_INTEGRAL_CGAMMA]);; let EULER_INTEGRABLE = prove (`!z. &0 < Re z ==> (\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))) integrable_on {t | &0 <= drop t}`, MESON_TAC[EULER_HAS_INTEGRAL_CGAMMA; integrable_on]);; let EULER_HAS_REAL_INTEGRAL_GAMMA = prove (`!x. &0 < x ==> ((\t. t rpow (x - &1) / exp t) has_real_integral gamma(x)) {t | &0 <= t}`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral] THEN MP_TAC(SPEC `Cx x` EULER_HAS_INTEGRAL_CGAMMA) THEN ASM_REWRITE_TAC[gamma; o_DEF; RE_CX] THEN DISCH_THEN(MP_TAC o ISPEC `lift o Re` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [REWRITE_TAC[linear; RE_ADD; LIFT_ADD; COMPLEX_CMUL; RE_MUL_CX] THEN REWRITE_TAC[LIFT_CMUL]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE lift {t | &0 <= t} = {t | &0 <= drop t}` SUBST1_TAC THENL [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE)) THEN EXISTS_TAC `{vec 0:real^1}` THEN REWRITE_TAC[NEGLIGIBLE_SING; FORALL_LIFT; IN_DIFF; IN_ELIM_THM; LIFT_DROP; IN_SING; GSYM DROP_EQ; DROP_VEC] THEN SIMP_TAC[cpow; CX_INJ; rpow; REAL_LT_LE; GSYM CX_LOG; GSYM CX_SUB; GSYM CX_EXP; GSYM CX_MUL; RE_CX; GSYM CX_DIV]);; let EULER_REAL_INTEGRAL = prove (`!x. &0 < x ==> real_integral {t | &0 <= t} (\t. t rpow (x - &1) / exp t) = gamma(x)`, MESON_TAC[REAL_INTEGRAL_UNIQUE; EULER_HAS_REAL_INTEGRAL_GAMMA]);; let EULER_REAL_INTEGRABLE = prove (`!x. &0 < x ==> (\t. t rpow (x - &1) / exp t) real_integrable_on {t | &0 <= t}`, MESON_TAC[EULER_HAS_REAL_INTEGRAL_GAMMA; real_integrable_on]);; let EULER_ORIGINAL_REAL_INTEGRABLE = prove (`!x. &0 < x ==> (\t. (--log t) rpow (x - &1)) real_integrable_on real_interval[&0,&1]`, SUBGOAL_THEN `!x. &0 < x ==> ((\t. (--log t) rpow (x - &1)) real_integrable_on real_interval[&0,&1] <=> (\t. (--log t) rpow x) real_integrable_on real_interval[&0,&1])` ASSUME_TAC THENL [GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\t. inv(x) * (--log t) rpow x`; `\t:real. t`; `\t. --(&1) / t * (--log t) rpow (x - &1)`; `\t:real. &1`; `&0`; `&1`; `{&0,&1}`] REAL_INTEGRABLE_BY_PARTS_EQ) THEN REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY; REAL_MUL_RID] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH `&0 <= x ==> &0 < x \/ x = &0`)) THENL [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN SUBGOAL_THEN `(\y. --log(y) rpow x) = (\y. y rpow x) o (\x. --x) o log` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN CONJ_TAC) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_NEG; REAL_CONTINUOUS_AT_ID; REAL_CONTINUOUS_AT_LOG] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN ASM_SIMP_TAC[REAL_LE_LT]; FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REAL_MUL_RZERO] THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\y. (--x * log(y rpow inv x) * y rpow inv x) rpow x` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN REWRITE_TAC[REAL_ARITH `&0 < abs(x - a) <=> ~(x = a)`] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LOG_RPOW; REAL_LT_INV_EQ; REAL_FIELD `~(x = &0) ==> --x * (inv x * y) * z = --y * z`] THEN ASM_SIMP_TAC[RPOW_MUL; RPOW_RPOW; REAL_MUL_LINV] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1]; SUBGOAL_THEN `&0 = &0 rpow x` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL [ASM_SIMP_TAC[rpow; REAL_LT_IMP_NZ; REAL_LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[] (ISPEC `\y. y rpow x` REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_AT_RPOW; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN SUBGOAL_THEN `(\y. log (y rpow inv x) * y rpow inv x) = (\y. log y * y) o (\y. y rpow inv x)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC REALLIM_COMPOSE_WITHIN THEN EXISTS_TAC `{x | &0 <= x}` THEN EXISTS_TAC `&0 rpow inv x` THEN ASM_REWRITE_TAC[REAL_ENTIRE; RPOW_EQ_0; REAL_INV_EQ_0] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[] (ISPEC `\y. y rpow x` REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_AT_RPOW; REAL_LT_IMP_LE; REAL_LE_INV_EQ] THEN MP_TAC(ISPEC `&0` REAL_CONTINUOUS_AT_ID) THEN SIMP_TAC[REAL_CONTINUOUS_ATREAL; REALLIM_ATREAL_WITHINREAL]; REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN SIMP_TAC[RPOW_POS_LE; IN_REAL_INTERVAL; IN_ELIM_THM] THEN MESON_TAC[REAL_LT_01]; ASM_REWRITE_TAC[RPOW_ZERO; REAL_INV_EQ_0] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REALLIM_X_TIMES_LOG]]]]; REWRITE_TAC[IN_REAL_INTERVAL; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN X_GEN_TAC `t:real` THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN CONJ_TAC THEN REAL_DIFF_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM LOG_INV; REAL_INV_1_LT; LOG_POS_LT] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]; ASM_REWRITE_TAC[REAL_INTEGRABLE_LMUL_EQ; REAL_INV_EQ_0] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_INTEGRABLE_LMUL_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_EQ THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_DIFF; IN_SING] THEN CONV_TAC REAL_FIELD]; ALL_TAC] THEN SUBGOAL_THEN `!n. (\t. --log t pow n) real_integrable_on real_interval[&0,&1]` ASSUME_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 real_pow; REAL_INTEGRABLE_CONST] THEN REWRITE_TAC[GSYM RPOW_POW] THEN X_GEN_TAC `n:num` THEN SUBGOAL_THEN `&n = &(SUC n) - &1` SUBST1_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_OF_NUM_LT; LT_0]]; ALL_TAC] THEN SUBGOAL_THEN `!x. &0 < x ==> (\t. --log t rpow x) real_integrable_on real_interval[&0,&1]` (fun th -> ASM_MESON_TAC[th]) THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\t. max (&1) (--log t pow n)` THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_MEASURABLE_ON_RPOW THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN FIRST_X_ASSUM(MP_TAC o SPEC `1`) THEN REWRITE_TAC[REAL_POW_1]; MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND THEN EXISTS_TAC `\x:real. min (--log(&0) pow n) (&0)` THEN ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `b <= c ==> min a b <= c`) THEN MATCH_MP_TAC REAL_POW_LE THEN ASM_SIMP_TAC[GSYM LOG_INV] THEN MATCH_MP_TAC LOG_POS THEN MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[IN_REAL_INTERVAL; IN_DIFF; IN_SING] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= --log t` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM LOG_INV] THEN MATCH_MP_TAC LOG_POS THEN MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[real_abs; RPOW_POS_LE]] THEN ASM_CASES_TAC `--(log t) <= &1` THENL [MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max y z`) THEN MATCH_MP_TAC RPOW_1_LE THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `x <= z ==> x <= max y z`) THEN REWRITE_TAC[GSYM RPOW_POW] THEN MATCH_MP_TAC RPOW_MONO_LE THEN ASM_REAL_ARITH_TAC]]);; let EULER_ORIGINAL_INTEGRABLE = prove (`!z. &0 < Re z ==> (\t. (--clog(Cx(drop t))) cpow (z - Cx(&1))) integrable_on interval[vec 0,vec 1]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\t. lift((--log(drop t)) rpow (Re z - &1))` THEN EXISTS_TAC `{vec 0:real^1,vec 1}` THEN REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `{vec 0:real^1,vec 1}` THEN REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY; LEBESGUE_MEASURABLE_INTERVAL] THEN SUBGOAL_THEN `(\t. --clog (Cx(drop t)) cpow (z - Cx(&1))) = ((\w. w cpow (z - Cx(&1))) o (--) o clog) o (\x. Cx(drop x))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CX_DROP; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC; o_DEF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN COMPLEX_DIFFERENTIABLE_TAC THEN ASM_SIMP_TAC[GSYM CX_LOG; RE_CX; REAL_LT_LE; RE_NEG; GSYM LOG_INV] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LT_LE] THEN MATCH_MP_TAC LOG_POS_LT THEN MATCH_MP_TAC REAL_INV_1_LT THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[INTERVAL_REAL_INTERVAL; DROP_VEC; REWRITE_RULE[o_DEF] (GSYM REAL_INTEGRABLE_ON)] THEN MATCH_MP_TAC EULER_ORIGINAL_REAL_INTEGRABLE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[FORALL_LIFT; IN_DIFF; IN_INSERT; GSYM DROP_EQ; LIFT_DROP; IN_INTERVAL_1; DROP_VEC; NOT_IN_EMPTY] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < x /\ x < &1` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; cpow; rpow; GSYM CX_NEG; REAL_LT_IMP_NZ; RE_CX; REAL_LT_IMP_LE; COMPLEX_NORM_MUL; NORM_CEXP; RE_SUB; CX_INJ; REAL_LE_REFL; RE_MUL_CX; GSYM LOG_INV; LOG_POS_LT; REAL_INV_1_LT]]);; let EULER_ORIGINAL_HAS_INTEGRAL_CGAMMA = prove (`!z. &0 < Re z ==> ((\t. (--clog(Cx(drop t))) cpow (z - Cx(&1))) has_integral cgamma(z)) (interval[vec 0,vec 1])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP EULER_ORIGINAL_INTEGRABLE) THEN FIRST_ASSUM(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONTINUOUS_WITHIN] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] LIM_UNIQUE)) THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN MATCH_MP_TAC(SET_RULE `{a,b} SUBSET interval[a,b] /\ ~(a = b) ==> ~(?x. interval[a,b] = {x})`) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN REWRITE_TAC[VEC_EQ; ARITH_EQ]; ALL_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\x. integral(interval[vec 0,lift(--log(drop x))]) (\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t)))` THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; DIST_0; NORM_POS_LT; IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; DROP_VEC; FORALL_LIFT; LIFT_DROP] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\t. (--clog(Cx(drop(--t)))) cpow (z - Cx(&1))`; `\t. --lift(exp(--drop t))`; `\t. lift(exp(--drop t))`; `vec 0:real^1`; `lift(--log x):real^1`; `--vec 1:real^1`; `vec 0:real^1`; `{vec 0:real^1,vec 1}`] HAS_INTEGRAL_SUBSTITUTION_STRONG) THEN REWRITE_TAC[LIFT_DROP; DROP_VEC; GSYM DROP_NEG] THEN REWRITE_TAC[GSYM REFLECT_INTERVAL; GSYM INTEGRAL_REFLECT_GEN] THEN REWRITE_TAC[DROP_NEG; LIFT_DROP; REAL_LE_NEG2; REAL_EXP_MONO_LE] THEN REWRITE_TAC[REAL_NEG_NEG; DROP_VEC; REAL_EXP_0; REAL_NEG_0] THEN SIMP_TAC[GSYM CX_LOG; REAL_EXP_POS_LT; LOG_EXP] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_POS; COUNTABLE_INSERT; COUNTABLE_EMPTY] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[GSYM LOG_INV; LOG_POS; REAL_INV_1_LE] THEN REWRITE_TAC[GSYM DROP_NEG; INTEGRABLE_REFLECT_GEN] THEN REWRITE_TAC[REFLECT_INTERVAL; VECTOR_NEG_NEG; VECTOR_NEG_0] THEN ASM_SIMP_TAC[EULER_ORIGINAL_INTEGRABLE] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM LIFT_NEG; DROP_NEG] THEN REWRITE_TAC[GSYM LIFT_NUM; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM REAL_CONTINUOUS_ON)] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC; FORALL_LIFT; LIFT_DROP; DROP_NEG] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `--x <= &0 <=> &0 <= x`; REAL_EXP_POS_LE] THEN REWRITE_TAC[REAL_EXP_NEG; REAL_LE_NEG2] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_0] THEN ASM_REWRITE_TAC[REAL_EXP_MONO_LE]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC; FORALL_LIFT; LIFT_DROP; DROP_NEG; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; GSYM DROP_EQ; DE_MORGAN_THM] THEN X_GEN_TAC `y:real` THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN REWRITE_TAC[GSYM LIFT_NEG; REWRITE_RULE[o_DEF] (GSYM HAS_REAL_VECTOR_DERIVATIVE_AT)] THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN SUBGOAL_THEN `(\t. --clog(Cx(--drop t)) cpow (z - Cx(&1))) = (\w. --clog w cpow (z - Cx(&1))) o (\t. Cx(drop(--t)))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; DROP_NEG]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_CX_DROP THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN SIMP_TAC[CONTINUOUS_NEG; CONTINUOUS_AT_ID]; MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN COMPLEX_DIFFERENTIABLE_TAC THEN REWRITE_TAC[RE_CX; VECTOR_NEG_NEG; LIFT_DROP] THEN SIMP_TAC[REAL_EXP_POS_LT; GSYM CX_LOG; LOG_EXP] THEN REWRITE_TAC[RE_NEG; RE_CX; REAL_NEG_NEG] THEN ASM_REAL_ARITH_TAC]]]; DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN ASM_SIMP_TAC[EXP_LOG; LIFT_NUM; COMPLEX_CMUL; CX_EXP; CEXP_NEG; CX_NEG; COMPLEX_NEG_NEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[complex_div]]; FIRST_ASSUM(MP_TAC o MATCH_MP EULER_HAS_INTEGRAL_CGAMMA) THEN GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN REWRITE_TAC[LIM_WITHIN] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `exp(--B)` THEN ASM_REWRITE_TAC[REAL_EXP_POS_LT] THEN REWRITE_TAC[REAL_LT_01; DIST_0; NORM_POS_LT; IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; DROP_VEC; FORALL_LIFT; LIFT_DROP; NORM_LIFT] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`--lift B`; `lift(--log x)`]) THEN ANTS_TAC THENL [REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_VEC] THEN REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN DISJ2_TAC THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[REAL_ADD_LID] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[REAL_EXP_NEG; EXP_LOG] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_NEG] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(NORM_ARITH `i = j ==> norm(i - g) < e ==> dist(j,g) < e`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_NEG; LIFT_DROP; DROP_VEC] THEN ASM_REAL_ARITH_TAC]]);; let EULER_ORIGINAL_INTEGRAL = prove (`!z. &0 < Re z ==> integral (interval[vec 0,vec 1]) (\t. (--clog(Cx(drop t))) cpow (z - Cx(&1))) = cgamma(z)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC EULER_ORIGINAL_HAS_INTEGRAL_CGAMMA THEN ASM_REWRITE_TAC[]);; let EULER_ORIGINAL_HAS_REAL_INTEGRAL_GAMMA = prove (`!x. &0 < x ==> ((\t. (--log t) rpow (x - &1)) has_real_integral gamma(x)) (real_interval[&0,&1])`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral] THEN MP_TAC(SPEC `Cx x` EULER_ORIGINAL_HAS_INTEGRAL_CGAMMA) THEN ASM_REWRITE_TAC[gamma; o_DEF; RE_CX] THEN DISCH_THEN(MP_TAC o ISPEC `lift o Re` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [REWRITE_TAC[linear; RE_ADD; LIFT_ADD; COMPLEX_CMUL; RE_MUL_CX] THEN REWRITE_TAC[LIFT_CMUL]; REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_NUM]] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE)) THEN EXISTS_TAC `{vec 0:real^1,vec 1}` THEN REWRITE_TAC[NEGLIGIBLE_INSERT; FORALL_LIFT; IN_INTERVAL_1; DE_MORGAN_THM; LIFT_DROP; IN_INSERT; NOT_IN_EMPTY; GSYM DROP_EQ; DROP_VEC; IN_DIFF] THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < --log y` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM LOG_INV] THEN MATCH_MP_TAC LOG_POS_LT THEN MATCH_MP_TAC REAL_INV_1_LT THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[GSYM CX_LOG; cpow; rpow; COMPLEX_NEG_EQ_0; CX_INJ; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[GSYM CX_NEG; GSYM CX_LOG; GSYM CX_SUB; GSYM CX_MUL] THEN COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM CX_EXP; RE_CX]]);; let EULER_ORIGINAL_REAL_INTEGRAL = prove (`!x. &0 < x ==> real_integral (real_interval[&0,&1]) (\t. (--log t) rpow (x - &1)) = gamma(x)`, MESON_TAC[REAL_INTEGRAL_UNIQUE; EULER_ORIGINAL_HAS_REAL_INTEGRAL_GAMMA]);; (* ------------------------------------------------------------------------- *) (* Stirling's approximation. *) (* ------------------------------------------------------------------------- *) let LGAMMA_STIRLING_INTEGRALS_EXIST,LGAMMA_STIRLING = (CONJ_PAIR o prove) (`(!z n. 1 <= n /\ (Im z = &0 ==> &0 < Re z) ==> (\t. Cx(bernoulli n (frac (drop t))) / (z + Cx(drop t)) pow n) integrable_on {t | &0 <= drop t}) /\ (!z p. (Im z = &0 ==> &0 < Re z) ==> lgamma(z) = ((z - Cx(&1) / Cx(&2)) * clog(z) - z + Cx(log(&2 * pi) / &2)) + vsum(1..p) (\k. Cx(bernoulli (2 * k) (&0) / (&4 * &k pow 2 - &2 * &k)) / z pow (2 * k - 1)) - integral {t | &0 <= drop t} (\t. Cx(bernoulli (2 * p + 1) (frac(drop t))) / (z + Cx(drop t)) pow (2 * p + 1)) / Cx(&(2 * p + 1)))`, let lemma1 = prove (`!p n z. (Im z = &0 ==> &0 < Re z) ==> (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * Cx(&(FACT(2 * p))) / (z + Cx(drop x)) pow (2 * p + 1)) integrable_on interval [lift(&0),lift(&n)] /\ vsum(0..n) (\m. clog(Cx(&m) + z)) = (z + Cx(&n) + Cx(&1) / Cx(&2)) * clog(z + Cx(&n)) - (z - Cx(&1) / Cx(&2)) * clog(z) - Cx(&n) + vsum(1..p) (\k. Cx(bernoulli (2 * k) (&0) / &(FACT(2 * k))) * (Cx(&(FACT(2 * k - 2))) / (z + Cx(&n)) pow (2 * k - 1) - Cx(&(FACT(2 * k - 2))) / z pow (2 * k - 1))) + integral (interval[lift(&0),lift(&n)]) (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * Cx(&(FACT(2 * p))) / (z + Cx(drop x)) pow (2 * p + 1)) / Cx(&(FACT(2 * p + 1)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_RING `Cx(&n) + z = z + Cx(&n)`] THEN MP_TAC(ISPECL [`\n w. if n = 0 then (z + w) * clog(z + w) - (z + w) else if n = 1 then clog(z + w) else Cx(--(&1) pow n * &(FACT(n - 2))) / (z + w) pow (n - 1)`; `0`; `n:num`; `p:num`] COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE) THEN ASM_REWRITE_TAC[ADD_EQ_0; MULT_EQ_0; MULT_EQ_1] THEN CONV_TAC NUM_REDUCE_CONV THEN ANTS_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL; LE_0] THEN MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(z + Cx x = Cx(&0))` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_EQ; IM_ADD; RE_ADD; IM_CX; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[o_THM; ARITH_RULE `k + 1 = 1 <=> k = 0`] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[] THENL [COMPLEX_DIFF_TAC THEN CONJ_TAC THENL [REWRITE_TAC[RE_ADD; IM_ADD; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC; UNDISCH_TAC `~(z + Cx x = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; ALL_TAC] THEN ASM_CASES_TAC `k = 1` THEN ASM_REWRITE_TAC[] THEN COMPLEX_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[complex_div; COMPLEX_ADD_LID; COMPLEX_MUL_LID; COMPLEX_POW_1; IM_ADD; RE_ADD; IM_CX; RE_CX] THEN (CONJ_TAC ORELSE ASM_REAL_ARITH_TAC) THEN ASM_REWRITE_TAC[COMPLEX_POW_EQ_0] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; COMPLEX_MUL_LZERO] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_RID; REAL_NEG_NEG; REAL_MUL_LNEG] THEN REWRITE_TAC[COMPLEX_MUL_RID; CX_NEG; COMPLEX_POW_POW] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; COMPLEX_SUB_LZERO; COMPLEX_NEG_NEG; COMPLEX_MUL_LNEG] THEN REWRITE_TAC[GSYM complex_div] THEN AP_TERM_TAC THEN FIRST_X_ASSUM(K ALL_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[GSYM complex_div; COMPLEX_DIV_POW2] THEN COND_CASES_TAC THENL [MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[ADD_SUB; ARITH_RULE `~(k = 0) /\ ~(k = 1) ==> (k - 1) * 2 - (k - 1 - 1) = k`] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; complex_div] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> (k + 1) - 2 = k - 1`] THEN ASM_SIMP_TAC[ARITH_RULE `~(k = 0) /\ ~(k = 1) ==> k - 1 = SUC(k - 2)`] THEN REWRITE_TAC[FACT; REAL_OF_NUM_MUL] THEN REWRITE_TAC[MULT_SYM]; REWRITE_TAC[ARITH_RULE `~(2 * p + 2 = 1)`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)] THEN SIMP_TAC[LE_1] THEN REWRITE_TAC[ARITH_RULE `(2 * p + 2) - 1 = 2 * p + 1`; ADD_SUB] THEN REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID] THEN DISCH_TAC THEN ASM_REWRITE_TAC[COMPLEX_ADD_RID] THEN CONV_TAC COMPLEX_RING) in let lemma2 = prove (`!z n. 2 <= n /\ (Im z = &0 ==> &0 < Re z) ==> (\t. inv(z + Cx(drop t)) pow n) absolutely_integrable_on {t | &0 <= drop t}`, REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_POW_INV] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\t. lift(inv(max (abs(Im z)) (Re z + drop t)) pow n)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN SIMP_TAC[CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; CONTINUOUS_ON_CX_DROP] THEN REWRITE_TAC[IN_ELIM_THM; GSYM FORALL_DROP] THEN REWRITE_TAC[COMPLEX_POW_EQ_0] THEN REWRITE_TAC[COMPLEX_EQ; RE_ADD; IM_ADD; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC LEBESGUE_MEASURABLE_CONVEX THEN MATCH_MP_TAC IS_INTERVAL_CONVEX THEN REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC]; ALL_TAC; REWRITE_TAC[FORALL_IN_GSPEC; GSYM FORALL_DROP; LIFT_DROP] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[GSYM COMPLEX_POW_INV; COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN MP_TAC(SPEC `z + Cx x` COMPLEX_NORM_GE_RE_IM) THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `max m n = if n <= m then m else n`] THEN REWRITE_TAC[COND_RAND; COND_RATOR] THEN MATCH_MP_TAC INTEGRABLE_CASES THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [SUBGOAL_THEN `{t | &0 <= drop t /\ Re z + drop t <= abs (Im z)} = interval[vec 0,lift(abs(Im z) - Re z)]` (fun th -> REWRITE_TAC[th; INTEGRABLE_CONST]) THEN SIMP_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `{t | abs(Im z) - Re z <= drop t} INTER {t | &0 <= drop t}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{lift(abs(Im z) - Re z)}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM; IN_SING; IN_INTER] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_INTER] THEN REWRITE_TAC[integrable_on] THEN ONCE_REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN SUBGOAL_THEN `!a. {t | abs(Im z) - Re z <= drop t} INTER interval[vec 0,a] = interval[lift(max (&0) (abs (Im z) - Re z)),a]` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_INTERVAL_1] THEN REWRITE_TAC[LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!b. &0 <= drop b /\ abs (Im z) - Re z <= drop b ==> ((\x. lift(inv (Re z + drop x) pow n)) has_integral lift (inv((&1 - &n) * (Re z + drop b) pow (n - 1)) - inv((&1 - &n) * (Re z + max(&0) (abs(Im z) - Re z)) pow (n - 1)))) (interval[lift(max (&0) (abs (Im z) - Re z)),b])` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. lift(inv((&1 - &n) * (Re z + drop x) pow (n - 1)))`; `\x. lift(inv(Re z + drop x) pow n)`; `lift(max (&0) (abs (Im z) - Re z))`; `b:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_MAX_LE] THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_LIFT; LIFT_DROP; INTERVAL_REAL_INTERVAL] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM HAS_REAL_VECTOR_DERIVATIVE_WITHIN)] THEN REWRITE_TAC[REAL_INV_MUL; REAL_INV_POW] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[real_div; REAL_OF_NUM_LE; REAL_FIELD `&2 <= x ==> inv(&1 - x) * (x - &1) * y * --(&0 + &1) * p = y * p`] THEN REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_INV_POW] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN AP_TERM_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[LIFT_DROP; GSYM LIFT_SUB]]; ALL_TAC] THEN EXISTS_TAC `lift(inv ((&n - &1) * (Re z + max (&0) (abs(Im z) - Re z)) pow (n - 1)))` THEN CONJ_TAC THENL [X_GEN_TAC `b:real^1` THEN ASM_CASES_TAC `&0 <= drop b /\ abs (Im z) - Re z <= drop b` THENL [ASM_MESON_TAC[integrable_on]; MATCH_MP_TAC INTEGRABLE_ON_NULL] THEN REWRITE_TAC[CONTENT_EQ_0_1; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\b. lift(inv((&1 - &n) * (Re z + b) pow (n - 1)) - inv((&1 - &n) * (Re z + max (&0) (abs(Im z) - Re z)) pow (n - 1)))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN EXISTS_TAC `max(&0) (abs(Im z) - Re z)` THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[LIFT_SUB; VECTOR_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[GSYM LIFT_NEG; GSYM REAL_INV_NEG; GSYM REAL_MUL_LNEG] THEN REWRITE_TAC[REAL_NEG_SUB; LIM_CONST] THEN REWRITE_TAC[REAL_INV_MUL; LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN REWRITE_TAC[GSYM LIFT_NUM; GSYM LIM_CX_LIFT] THEN REWRITE_TAC[CX_INV; CX_POW; GSYM COMPLEX_POW_INV; CX_ADD] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN MATCH_MP_TAC LIM_INV_X_POW_OFFSET THEN ASM_ARITH_TAC) in let lemma3 = prove (`!z n. 2 <= n /\ (Im z = &0 ==> &0 < Re z) ==> (\t. Cx(bernoulli n (frac (drop t))) / (z + Cx(drop t)) pow n) integrable_on {t | &0 <= drop t}`, REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div; GSYM COMPLEX_CMUL] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC THEN ASM_SIMP_TAC[GSYM COMPLEX_POW_INV; lemma2]) in let lemma4 = prove (`!z p. (Im z = &0 ==> &0 < Re z) /\ 1 <= p ==> ((\t. Cx(bernoulli 1 (frac(drop t))) / (z + Cx(drop t))) has_integral (integral {t | &0 <= drop t} (\t. Cx(bernoulli (2 * p + 1) (frac(drop t))) / (z + Cx(drop t)) pow (2 * p + 1)) / Cx(&(2 * p + 1)) - vsum(1..p) (\k. Cx(bernoulli (2 * k) (&0) / (&4 * &k pow 2 - &2 * &k)) / z pow (2 * k - 1)))) {t | &0 <= drop t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_LIM_SEQUENTIALLY THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP; complex_div; COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL_BOUNDED THEN EXISTS_TAC `&1 / &2` THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[BERNOULLI_CONV `bernoulli 1 x`] THEN DISJ1_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[LIM_INV_Z_OFFSET]]; ALL_TAC] THEN MP_TAC(GEN `n:num` (CONJ (SPECL [`0`; `n:num`; `z:complex`] lemma1) (SPECL [`p:num`; `n:num`; `z:complex`] lemma1))) THEN ASM_REWRITE_TAC[FORALL_AND_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a * Cx(&1) / b = a / b`] THEN REWRITE_TAC[LIFT_NUM; COMPLEX_POW_1; COMPLEX_DIV_1] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[VECTOR_ARITH `a + vec 0 + x:real^N = a + y <=> x = y`] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN GEN_REWRITE_TAC LAND_CONV [COMPLEX_RING `a - b:complex = --b + a`] THEN MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL [REWRITE_TAC[GSYM VSUM_NEG] THEN MATCH_MP_TAC LIM_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[CX_DIV; complex_div; GSYM COMPLEX_MUL_RNEG] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LIM_COMPLEX_LMUL THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv x * (y * w - y * z):complex = y / x * (w - z)`] THEN SUBGOAL_THEN `Cx(&(FACT(2 * k - 2))) / Cx(&(FACT(2 * k))) = inv(Cx(&4 * &k pow 2 - &2 * &k))` (fun th -> ONCE_REWRITE_TAC[th]) THENL [MATCH_MP_TAC(COMPLEX_FIELD `~(y = Cx(&0)) /\ ~(z = Cx(&0)) /\ x * z = y ==> x / y = inv(z)`) THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN REWRITE_TAC[REAL_ENTIRE; REAL_ARITH `&4 * x pow 2 - &2 * x = (&2 * x) * (&2 * x - &1)`] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k`; REAL_OF_NUM_SUB; REAL_OF_NUM_MUL; GSYM CX_MUL; CX_INJ; REAL_OF_NUM_EQ] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `1 <= k` THEN SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN (K ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `(2 + k) - 2 = k /\ (2 + k) - 1 = k + 1`] THEN REWRITE_TAC[ARITH_RULE `2 + k = SUC(SUC k)`; FACT] THEN ARITH_TAC; MATCH_MP_TAC LIM_COMPLEX_LMUL THEN ONCE_REWRITE_TAC[COMPLEX_RING `--z = Cx(&0) - z`] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[GSYM COMPLEX_POW_INV] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN MATCH_MP_TAC LIM_INV_N_POW_OFFSET THEN ASM_ARITH_TAC]; MP_TAC(SPECL [`z:complex`; `2 * p + 1`] lemma3) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `Cx(&(FACT(2 * p)))` o MATCH_MP INTEGRABLE_COMPLEX_LMUL) THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL] THEN REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_POSINFINITY_SEQUENTIALLY o CONJUNCT2) THEN DISCH_THEN(MP_TAC o SPEC `inv(Cx(&(FACT(2 * p + 1))))` o MATCH_MP LIM_COMPLEX_RMUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THENL [REWRITE_TAC[LIFT_NUM; FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[complex_div] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[complex_div; COMPLEX_MUL_AC]; REWRITE_TAC[complex_div] THEN MATCH_MP_TAC(COMPLEX_RING `x * y:complex = z ==> (x * i) * y = i * z`) THEN REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL; CX_MUL] THEN MATCH_MP_TAC(COMPLEX_FIELD `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> a * inv(b * a) = inv b`) THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; FACT_NZ; NOT_SUC]]]) in let lemma5 = prove (`!z n. 1 <= n /\ (Im z = &0 ==> &0 < Re z) ==> (\t. Cx(bernoulli n (frac (drop t))) / (z + Cx(drop t)) pow n) integrable_on {t | &0 <= drop t}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `1 <= n ==> n = 1 \/ 2 <= n`)) THEN ASM_SIMP_TAC[lemma3; COMPLEX_POW_1] THEN REWRITE_TAC[integrable_on] THEN ASM_MESON_TAC[LE_REFL; lemma4]) in let lemma6 = prove (`!z. (Im z = &0 ==> &0 < Re z) ==> lgamma(z) = ((z - Cx(&1) / Cx(&2)) * clog(z) - z + Cx(&1)) + (integral {t | &0 <= drop t} (\t. Cx(bernoulli 1 (frac(drop t))) / (Cx(&1) + Cx(drop t))) - integral {t | &0 <= drop t} (\t. Cx(bernoulli 1 (frac(drop t))) / (z + Cx(drop t))))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. ~(z + Cx(&n) = Cx(&0))` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_EQ; IM_ADD; RE_ADD; IM_CX; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL [ASM_MESON_TAC[COMPLEX_ADD_RID]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LGAMMA_ALT) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[TRIVIAL_LIMIT_SEQUENTIALLY] (ISPEC `sequentially` LIM_UNIQUE))) THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. z * clog (Cx(&n)) - clog (Cx(&n + &1)) + ((Cx(&1) + Cx(&n) + Cx(&1) / Cx(&2)) * clog (Cx(&1) + Cx(&n)) - (Cx(&1) - Cx(&1) / Cx(&2)) * clog (Cx(&1)) - Cx(&n) + integral (interval [lift (&0),lift (&n)]) (\x. Cx(bernoulli 1 (frac (drop x))) * Cx(&1) / (Cx(&1) + Cx(drop x)) pow 1) / Cx(&1)) - ((z + Cx(&n) + Cx(&1) / Cx(&2)) * clog (z + Cx(&n)) - (z - Cx(&1) / Cx(&2)) * clog z - Cx(&n) + integral (interval [lift (&0),lift (&n)]) (\x. Cx(bernoulli 1 (frac (drop x))) * Cx(&1) / (z + Cx(drop x)) pow 1) / Cx(&1))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `clog(Cx(&(FACT n))) = vsum(0..n) (\m. clog(Cx(&m) + Cx(&1))) - clog(Cx(&n + &1))` SUBST1_TAC THENL [REWRITE_TAC[REAL_OF_NUM_ADD; GSYM CX_ADD] THEN REWRITE_TAC[GSYM(SPEC `1` VSUM_OFFSET); ADD_CLAUSES] THEN SIMP_TAC[GSYM NPRODUCT_FACT; REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG; GSYM CX_LOG; LOG_PRODUCT; PRODUCT_POS_LT; IN_NUMSEG; REAL_OF_NUM_LT; LE_1; GSYM VSUM_CX] THEN REWRITE_TAC[GSYM ADD1; VSUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n`; REAL_OF_NUM_SUC] THEN SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_0] THEN REWRITE_TAC[COMPLEX_RING `(a + b) - b:complex = a`]; ONCE_REWRITE_TAC[COMPLEX_RING `(a + b - c) - d:complex = (a - c) + (b - d)`]] THEN MP_TAC(SPECL [`0`; `n:num`] lemma1) THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; ARITH; VECTOR_ADD_LID] THEN ASM_SIMP_TAC[RE_CX; REAL_LT_01]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_DIV_1] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a + (b - c - n + x) - (d - e - n + y):complex = (a + (b - c) - (d - e)) + (x - y)`] THEN MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL [REWRITE_TAC[CLOG_1; COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO] THEN ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[CX_ADD] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. z * (clog(Cx(&n)) - clog(z + Cx(&n))) + (Cx(&n) + Cx(&1) / Cx(&2)) * (clog(Cx(&1) + Cx(&n)) - clog(z + Cx(&n))) - (Cx(&1) - z)` THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o BINDER_CONV o LAND_CONV o RAND_CONV) [GSYM COMPLEX_ADD_LID] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[LIM_SUB_CLOG]; ONCE_REWRITE_TAC[COMPLEX_RING `(a + h) * x - y:complex = h * x + a * x - y`] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN SIMP_TAC[LIM_NULL_COMPLEX_LMUL; LIM_SUB_CLOG] THEN REWRITE_TAC[GSYM LIM_NULL_COMPLEX; LIM_N_MUL_SUB_CLOG]]; REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN REWRITE_TAC[LIFT_NUM] THEN MATCH_MP_TAC LIM_SUB THEN CONJ_TAC THEN REWRITE_TAC[GSYM LIFT_NUM] THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN REWRITE_TAC[LIFT_NUM] THEN MATCH_MP_TAC(MATCH_MP (TAUT `(p <=> q /\ r) ==> (p ==> r)`) (SPEC_ALL HAS_INTEGRAL_LIM_AT_POSINFINITY)) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL; GSYM complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_RING `z + x:complex = (z + x) pow 1`] THEN MATCH_MP_TAC lemma5 THEN ASM_REWRITE_TAC[LE_REFL; RE_CX; REAL_LT_01]]) in let lemma7 = prove (`((\y. integral {t | &0 <= drop t} (\t. Cx (bernoulli 1 (frac (drop t))) / (ii * Cx y + Cx(drop t)))) --> Cx(&0)) at_posinfinity`, MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\y. integral {t | &0 <= drop t} (\t. Cx(bernoulli 3 (frac (drop t))) / (ii * Cx y + Cx(drop t)) pow 3) / Cx(&3) - Cx(bernoulli 2 (&0) / &2) / (ii * Cx y)` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`ii * Cx y`; `1`] lemma4) THEN ASM_SIMP_TAC[IM_MUL_II; RE_CX; REAL_LT_IMP_NZ; LE_REFL] THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_POW_1] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC; ALL_TAC] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_SUB THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN REWRITE_TAC[COMPLEX_INV_MUL] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN REWRITE_TAC[LIM_INV_X]] THEN ONCE_REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\y. Cx(&1 / &2 / y) * integral {t | &0 <= drop t} (\t. inv(Cx(&1) + Cx(drop t)) pow 2)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL THEN REWRITE_TAC[real_div; CX_MUL] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN REWRITE_TAC[LIM_INV_X; CX_INV]] THEN REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN SIMP_TAC[GSYM INTEGRAL_COMPLEX_LMUL; lemma2; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ARITH; RE_CX; REAL_OF_NUM_LT] THEN MATCH_MP_TAC(REAL_ARITH `abs(Re z) <= norm z /\ x <= Re z ==> x <= norm z`) THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC lemma5 THEN REWRITE_TAC[ARITH; IM_MUL_II; RE_CX] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC lemma2 THEN REWRITE_TAC[RE_CX; REAL_LT_01] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_LIFT; IN_ELIM_THM; LIFT_DROP; GSYM RE_DEF] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_INV; GSYM CX_MUL; GSYM CX_POW] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; RE_CX] THEN REWRITE_TAC[REAL_ARITH `&1 / &2 / y * x = (&1 / &4) * (&2 / y * x)`] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; REAL_LE_INV_EQ; NORM_POS_LE] THEN CONJ_TAC THENL [MP_TAC(SPECL [`3`; `frac x`] BERNOULLI_BOUND) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[BERNOULLI_CONV `bernoulli 2 (&0)`] THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN SIMP_TAC[IN_REAL_INTERVAL; REAL_LT_IMP_LE; FLOOR_FRAC]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_INV; GSYM REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_INV_INV] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_POW; REAL_ARITH `x pow 3 = (x:real) * x pow 2`] THEN ONCE_REWRITE_TAC[REAL_ARITH `inv(&2) * y * x = y * x / &2`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL [ASM_REAL_ARITH_TAC; W(MP_TAC o PART_MATCH (rand o rand) COMPLEX_NORM_GE_RE_IM o rand o snd) THEN REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX; IM_CX] THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `&0 <= x / &2 <=> &0 <= x`] THEN MATCH_MP_TAC REAL_POW_LE THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[COMPLEX_SQNORM] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; IM_CX; RE_CX] THEN REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_NEG_0] THEN MATCH_MP_TAC(REAL_ARITH `&1 pow 2 <= y pow 2 /\ &0 <= (x - &1) pow 2 ==> (&1 + x) pow 2 / &2 <= x pow 2 + y pow 2`) THEN REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC]) in let lemma8 = prove (`integral {t | &0 <= drop t} (\t. Cx (bernoulli 1 (frac (drop t))) / (Cx(&1) + Cx(drop t))) = Cx(log(&2 * pi) / &2 - &1)`, MATCH_MP_TAC(MESON[REAL] `real z /\ Re z = y ==> z = Cx y`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_COMPLEX_INTEGRAL THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[COMPLEX_RING `z + x:complex = (z + x) pow 1`] THEN MATCH_MP_TAC lemma5 THEN ASM_REWRITE_TAC[LE_REFL; RE_CX; REAL_LT_01]; REWRITE_TAC[GSYM CX_ADD; GSYM CX_DIV; REAL_CX]]; GEN_REWRITE_TAC I [GSYM CX_INJ]] THEN MATCH_MP_TAC(ISPEC `at_posinfinity` LIM_UNIQUE) THEN EXISTS_TAC `\y:real. Cx(Re(integral {t | &0 <= drop t} (\t. Cx(bernoulli 1 (frac (drop t))) / (Cx(&1) + Cx(drop t)))))` THEN REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY; LIM_CONST] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\y. Cx(Re(lgamma(ii * Cx y) - ((ii * Cx y - Cx(&1) / Cx(&2)) * clog(ii * Cx y) - ii * Cx y + Cx(&1)) + integral {t | &0 <= drop t} (\t. Cx(bernoulli 1 (frac(drop t))) / (ii * Cx y + Cx(drop t)))))` THEN REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MP_TAC(SPEC `ii * Cx y` lemma6) THEN ASM_SIMP_TAC[IM_MUL_II; RE_CX; REAL_LT_IMP_NZ] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[COMPLEX_RING `(s + i - j) - s + j:complex = i`]; ALL_TAC] THEN REWRITE_TAC[RE_ADD; RE_SUB; CX_ADD; CX_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\y. integral {t | &0 <= drop t} (\t. Cx(bernoulli 1 (frac(drop t))) / (ii * Cx y + Cx(drop t)))` THEN REWRITE_TAC[lemma7] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_GE_RE_IM]] THEN REWRITE_TAC[RE_MUL_II; IM_CX; REAL_NEG_0; COMPLEX_SUB_RZERO; RE_CX] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\y. Cx(log(norm(cgamma(ii * Cx y)))) - (Cx(--(pi * y + log y) / &2) + Cx(&1))` THEN REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN BINOP_TAC THENL [MP_TAC(SPEC `ii * Cx y` CGAMMA_LGAMMA) THEN COND_CASES_TAC THENL [FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o AP_TERM `Im`)) THEN REWRITE_TAC[IM_ADD; IM_MUL_II; IM_CX; RE_CX] THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_CEXP; LOG_EXP]]; AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[COMPLEX_SUB_RDISTRIB; RE_SUB; GSYM CX_DIV] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; RE_MUL_II; IM_MUL_II; RE_MUL_CX; IM_MUL_CX] THEN ASM_SIMP_TAC[RE_CX; IM_CX; REAL_LT_IMP_LE; CX_INJ; REAL_LT_IMP_NZ; GSYM CX_LOG; CLOG_MUL_II] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_CX; IM_CX; RE_MUL_II; IM_MUL_II] THEN REAL_ARITH_TAC]; ALL_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\y. Cx((log(&2 * pi) - log(&1 - inv(exp(pi * y) pow 2))) / &2 - &1)` THEN REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `ii * Cx y + Cx(&1)` CGAMMA_REFLECTION) THEN REWRITE_TAC[CGAMMA_RECURRENCE; COMPLEX_ENTIRE; II_NZ; CX_INJ] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) - (z + Cx(&1)) = --z`] THEN MP_TAC(SPEC `cgamma(ii * Cx y)` COMPLEX_NORM_POW_2) THEN REWRITE_TAC[CNJ_MUL; CNJ_II; CNJ_CX; CNJ_CGAMMA] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; GSYM COMPLEX_MUL_ASSOC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COMPLEX_RING `w * (z + Cx(&1)) = w * z + w`] THEN REWRITE_TAC[CSIN_ADD; GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; CX_NEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN REWRITE_TAC[csin; COMPLEX_RING `--ii * x * ii * y = x * y`] THEN REWRITE_TAC[COMPLEX_RING `ii * x * ii * y = --(x * y)`] THEN REWRITE_TAC[complex_div; COMPLEX_INV_INV; COMPLEX_INV_MUL; COMPLEX_INV_NEG; COMPLEX_MUL_RNEG] THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD `~(y = Cx(&0)) ==> (ii * y * z = --(p * i * Cx(&2) * ii) <=> z = --(Cx(&2) * p) * inv y * i)`] THEN REWRITE_TAC[GSYM COMPLEX_INV_MUL; GSYM CX_MUL; GSYM CX_EXP; CEXP_NEG] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; GSYM COMPLEX_MUL_RNEG; COMPLEX_NEG_INV] THEN REWRITE_TAC[COMPLEX_NEG_SUB] THEN REWRITE_TAC[GSYM CX_INV; GSYM CX_SUB; GSYM CX_MUL; GSYM CX_INV] THEN REWRITE_TAC[CX_INJ; GSYM CX_POW] THEN DISCH_THEN(MP_TAC o AP_TERM `sqrt`) THEN REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_INV_MUL] THEN SUBGOAL_THEN `&0 < exp(pi * y) - inv(exp(pi * y))` ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x < &1 /\ &1 < y ==> &0 < y - x`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INV_LT_1; ALL_TAC] THEN MATCH_MP_TAC REAL_EXP_LT_1 THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[PI_POS]; ASM_SIMP_TAC[LOG_MUL; REAL_LT_INV_EQ; PI_POS; REAL_LT_MUL; REAL_ARITH `&0 < &2 * x <=> &0 < x`; LOG_SQRT; LOG_INV]] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB] THEN REWRITE_TAC[REAL_ARITH `(l2 + --l + x) / &2 - (--(py + l) / &2 + &1) = (l2 + py + x) / &2 - &1`] THEN SIMP_TAC[REAL_EXP_NZ; REAL_FIELD `~(e = &0) ==> e - inv e = e * (&1 - inv(e pow 2))`] THEN SUBGOAL_THEN `inv (exp (pi * y) pow 2) < &1` ASSUME_TAC THENL [MATCH_MP_TAC REAL_INV_LT_1 THEN MATCH_MP_TAC REAL_POW_LT_1 THEN REWRITE_TAC[ARITH] THEN MATCH_MP_TAC REAL_EXP_LT_1 THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_MUL; PI_POS]; ASM_SIMP_TAC[LOG_MUL; REAL_EXP_POS_LT; REAL_SUB_LT; LOG_EXP]] THEN REWRITE_TAC[CX_INJ] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[CX_SUB; CX_DIV] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC LIM_COMPLEX_DIV THEN REWRITE_TAC[LIM_CONST] THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN MP_TAC(ISPECL [`clog`; `at_posinfinity`; `\y. Cx(&1 - inv(exp(pi * y) pow 2))`; `Cx(&1)`] LIM_CONTINUOUS_FUNCTION) THEN REWRITE_TAC[CLOG_1] THEN ANTS_TAC THENL [SIMP_TAC[CONTINUOUS_AT_CLOG; RE_CX; REAL_LT_01; CX_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[CX_INV; CX_EXP; CX_POW; GSYM COMPLEX_POW_INV] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_POW THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[LIM_AT_POSINFINITY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `&1 + inv(e)` THEN REWRITE_TAC[dist; real_ge] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LT_LINV THEN ASM_REWRITE_TAC[NORM_CEXP; RE_CX] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&1 + e <= x ==> &1 + pi * x <= z /\ &0 <= x * (pi - &1) ==> e < z`)) THEN REWRITE_TAC[REAL_EXP_LE_X] THEN MATCH_MP_TAC REAL_LE_MUL THEN MP_TAC(SPEC `e:real` REAL_LT_INV_EQ) THEN MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(GSYM CX_LOG) THEN REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_LT_1 THEN MATCH_MP_TAC REAL_POW_LT_1 THEN REWRITE_TAC[ARITH] THEN MATCH_MP_TAC REAL_EXP_LT_1 THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_MUL; PI_POS]]) in CONJ_TAC THENL [MATCH_ACCEPT_TAC lemma5; ALL_TAC] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[lemma6] THEN REWRITE_TAC[lemma8; CX_SUB] THEN REWRITE_TAC[COMPLEX_RING `(x + Cx(&1)) + (a - Cx(&1)) - b = (x + a) - b`] THEN REWRITE_TAC[complex_sub; GSYM COMPLEX_ADD_ASSOC] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_CASES_TAC `p = 0` THENL [ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_DIV_1; VECTOR_ADD_LID]; MP_TAC(SPECL [`z:complex`; `p:num`] lemma4) THEN ASM_SIMP_TAC[LE_1] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[complex_sub; COMPLEX_NEG_ADD; VECTOR_NEG_NEG] THEN REWRITE_TAC[COMPLEX_ADD_SYM]]);; let LOG_GAMMA_STIRLING = prove (`!x p. &0 < x ==> log(gamma x) = ((x - &1 / &2) * log(x) - x + log(&2 * pi) / &2) + sum(1..p) (\k. bernoulli (2 * k) (&0) / (&4 * &k pow 2 - &2 * &k) / x pow (2 * k - 1)) - real_integral {t | &0 <= t} (\t. bernoulli (2 * p + 1) (frac t) / (x + t) pow (2 * p + 1)) / &(2 * p + 1)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM REAL_EXP_INJ] THEN ASM_SIMP_TAC[EXP_LOG; GAMMA_POS_LT] THEN GEN_REWRITE_TAC I [GSYM CX_INJ] THEN REWRITE_TAC[CX_GAMMA] THEN MP_TAC(ISPEC `Cx x` CGAMMA_LGAMMA) THEN COND_CASES_TAC THENL [FIRST_ASSUM(CHOOSE_THEN (MP_TAC o AP_TERM `Re`)) THEN REWRITE_TAC[RE_ADD; RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CX_EXP] THEN AP_TERM_TAC THEN MP_TAC(ISPECL [`Cx x`; `p:num`] LGAMMA_STIRLING) THEN ASM_REWRITE_TAC[RE_CX; CX_GAMMA] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CX_ADD; CX_SUB; CX_DIV; CX_MUL; GSYM VSUM_CX] THEN ASM_SIMP_TAC[GSYM CX_LOG; CX_POW] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_COMPONENT o lhand o snd) THEN ASM_SIMP_TAC[LGAMMA_STIRLING_INTEGRALS_EXIST; ARITH_RULE `1 <= 2 * p + 1`; RE_CX] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_POW; GSYM CX_DIV; RE_CX; IM_CX] THEN REWRITE_TAC[LIFT_NUM; INTEGRAL_0; DROP_VEC] THEN SUBGOAL_THEN `{t | &0 <= drop t} = IMAGE lift {t | &0 <= t}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]; MATCH_MP_TAC(GSYM(REWRITE_RULE[o_DEF] REAL_INTEGRAL))] THEN REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF] THEN MP_TAC(SPECL [`Cx x`; `2 * p + 1`] LGAMMA_STIRLING_INTEGRALS_EXIST) THEN ASM_REWRITE_TAC[RE_CX; ARITH_RULE `1 <= 2 * p + 1`] THEN GEN_REWRITE_TAC LAND_CONV [INTEGRABLE_COMPONENTWISE] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_POW; GSYM CX_DIV; RE_CX; GSYM RE_DEF] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; (* ------------------------------------------------------------------------- *) (* Some other mathematical facts that don't directly involve the gamma *) (* function can now be proved relatively easily: Euler's product for sin, *) (* Wallis's product for pi, and the Gaussian integral. *) (* ------------------------------------------------------------------------- *) let CSIN_PRODUCT = prove (`!z. ((\n. z * cproduct(1..n) (\m. Cx(&1) - (z / Cx(pi * &m)) pow 2)) --> csin(z)) sequentially`, GEN_TAC THEN REWRITE_TAC[CX_MUL; complex_div; COMPLEX_INV_MUL] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN ABBREV_TAC `w = z / Cx pi` THEN SUBGOAL_THEN `Cx pi * w = z` ASSUME_TAC THENL [EXPAND_TAC "w" THEN MP_TAC PI_NZ THEN REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD; EXPAND_TAC "z" THEN SUBGOAL_THEN `csin (Cx pi * w) = Cx pi * csin(Cx pi * w) / Cx pi` SUBST1_TAC THENL [MP_TAC PI_NZ THEN REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD; REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LIM_COMPLEX_LMUL THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN REWRITE_TAC[GSYM CGAMMA_REFLECTION] THEN REWRITE_TAC[COMPLEX_INV_DIV; COMPLEX_INV_MUL] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`w:complex`,`z:complex`)]] THEN X_GEN_TAC `z:complex` THEN MP_TAC(SPEC `z:complex` RECIP_CGAMMA) THEN MP_TAC(SPEC `Cx(&1) - z` RECIP_CGAMMA) THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) - z + m = (m + Cx(&1)) - z`] THEN REWRITE_TAC[GSYM CX_ADD; REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM (ISPECL [`f:num->complex`; `m:num`; `1`] CPRODUCT_OFFSET)] THEN SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0] THEN REWRITE_TAC[ADD_CLAUSES; COMPLEX_ADD_RID; GSYM IMP_CONJ_ALT] THEN SIMP_TAC[CPRODUCT_CLAUSES_RIGHT; ARITH_RULE `0 < n + 1 /\ 1 <= n + 1`] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD; ADD_SUB] THEN SUBGOAL_THEN `((\n. Cx(&n) / (Cx(&n) + Cx(&1) - z)) --> Cx(&1)) sequentially` MP_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_INV_1] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN MATCH_MP_TAC LIM_COMPLEX_INV THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN MATCH_MP_TAC LIM_ADD THEN SIMP_TAC[LIM_INV_N; LIM_NULL_COMPLEX_LMUL] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; LE_1]; REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL)] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(ISPEC `norm(z:complex)` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `MAX 1 N` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN STRIP_TAC THEN REWRITE_TAC[CPOW_SUB; CPOW_N; COMPLEX_POW_1] THEN ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING `a * b * c * d * e * f * g * h * i * j * k :complex = (a * i) * (j * e) * (h * b) * c * (d * g) * (f * k)`] THEN SUBGOAL_THEN `~((Cx(&n) + Cx(&1)) - z = Cx(&0))` ASSUME_TAC THENL [REWRITE_TAC[COMPLEX_SUB_0; GSYM CX_ADD] THEN DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[COMPLEX_RING `n + Cx(&1) - z = (n + Cx(&1)) - z`]] THEN ASM_SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; CPOW_EQ_0; LE_1] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM NPRODUCT_FACT; REAL_OF_NUM_NPRODUCT; CX_PRODUCT; FINITE_NUMSEG; GSYM CPRODUCT_INV; GSYM CPRODUCT_MUL] THEN MATCH_MP_TAC CPRODUCT_EQ THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN SUBGOAL_THEN `~(Cx(&k) = Cx(&0))` MP_TAC THENL [ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1]; CONV_TAC COMPLEX_FIELD]);; let SIN_PRODUCT = prove (`!x. ((\n. x * product(1..n) (\m. &1 - (x / (pi * &m)) pow 2)) ---> sin(x)) sequentially`, GEN_TAC THEN MP_TAC(SPEC `Cx x` CSIN_PRODUCT) THEN REWRITE_TAC[REALLIM_COMPLEX; o_DEF] THEN SIMP_TAC[CX_MUL; CX_PRODUCT; FINITE_NUMSEG; CX_SIN] THEN REWRITE_TAC[CX_SUB; CX_DIV; CX_POW; CX_MUL]);; let WALLIS_ALT = prove (`((\n. product(1..n) (\k. (&2 * &k) / (&2 * &k - &1) * (&2 * &k) / (&2 * &k + &1))) ---> pi / &2) sequentially`, ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REALLIM_INV THEN CONJ_TAC THENL [ALL_TAC; MP_TAC PI_POS THEN CONV_TAC REAL_FIELD] THEN MP_TAC(SPEC `pi / &2` SIN_PRODUCT) THEN REWRITE_TAC[SIN_PI2] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC; REAL_INV_INV] THEN DISCH_THEN(MP_TAC o SPEC `inv pi * &2` o MATCH_MP REALLIM_LMUL) THEN SIMP_TAC[REAL_MUL_RID; PI_NZ; REAL_FIELD `~(pi = &0) ==> (pi * x) * inv pi = x /\ (inv pi * &2) * (pi * inv(&2)) * y = y`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG] THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD);; let WALLIS = prove (`((\n. (&2 pow n * &(FACT n)) pow 4 / (&(FACT(2 * n)) * &(FACT(2 * n + 1)))) ---> pi / &2) sequentially`, MP_TAC WALLIS_ALT THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[GSYM ADD1; ARITH_RULE `2 * SUC n = SUC(SUC(2 * n))`] THEN REWRITE_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL] THEN MAP_EVERY (MP_TAC o C SPEC FACT_NZ) [`n:num`; `2 * n`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD);; let GAUSSIAN_INTEGRAL = prove (`((\x. exp(--(x pow 2))) has_real_integral sqrt pi) (:real)`, SUBGOAL_THEN `((\x. exp(--(x pow 2))) has_real_integral gamma(&1 / &2) / &2) {x | &0 <= x}` ASSUME_TAC THENL [ALL_TAC; SUBGOAL_THEN `(:real) = {x | &0 <= x} UNION IMAGE (--) {x | &0 <= x}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`; UNWIND_THM1] THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_ARITH `sqrt x = sqrt x / &2 + sqrt x / &2`]] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_REFLECT_GEN] THEN ASM_SIMP_TAC[REAL_POW_NEG; ARITH; GSYM GAMMA_HALF] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_ELIM_THM; SET_RULE `s INTER IMAGE f s SUBSET {a} <=> !x. x IN s /\ f x IN s ==> f x = a`] THEN REAL_ARITH_TAC] THEN MP_TAC(SPEC `&1 / &2` EULER_HAS_REAL_INTEGRAL_GAMMA) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN REWRITE_TAC[GSYM real_div] THEN ONCE_REWRITE_TAC[HAS_REAL_INTEGRAL_ALT] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_INTER; REAL_INTEGRABLE_RESTRICT_INTER; REAL_INTEGRAL_RESTRICT_INTER] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN SIMP_TAC[REAL_ARITH `&0 < B ==> --B <= B /\ ~(B <= --B)`] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; INTER; IN_REAL_INTERVAL] THEN REWRITE_TAC[IN_ELIM_THM; REAL_ARITH `&0 <= x /\ (a <= x /\ x <= b) <=> max (&0) a <= x /\ x <= b`] THEN REWRITE_TAC[GSYM real_interval] THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= --B /\ --B < B /\ B <= b <=> max (&0) a = &0 /\ &0 < B /\ a <= --B /\ B <= b`] THEN SIMP_TAC[] THEN REWRITE_TAC[REAL_ARITH `max (&0) a = &0 /\ &0 < B /\ a <= --B /\ B <= b <=> a <= --B /\ &0 < B /\ B <= b`] THEN GEN_REWRITE_TAC (BINOP_CONV o ONCE_DEPTH_CONV) [IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM] THEN REWRITE_TAC[MESON[REAL_LE_REFL] `?a. a <= B`] THEN ONCE_REWRITE_TAC[ MESON[REAL_ARITH `a <= max a b /\ (&0 <= a ==> max (&0) a = a)`] `(!a. P (max (&0) a)) <=> (!a. &0 <= a ==> P a)`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!a b. &0 <= a /\ a <= b ==> ((\x. exp(--(x pow 2))) has_real_integral real_integral (real_interval[a pow 2,b pow 2]) (\t. t rpow (-- &1 / &2) / exp t / &2)) (real_interval[a,b])` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\t. t rpow (&1 / &2 - &1) / exp t / &2`; `\x:real. x pow 2`; `\x. &2 * x`; `a:real`; `b:real`; `(a:real) pow 2`; `(b:real) pow 2`; `{&0}`] HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG) THEN REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LE_REFL; REAL_LE_POW_2; COUNTABLE_SING; REAL_POW_LE2] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN SIMP_TAC[REAL_LE_POW_2; GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THENL [REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN REAL_DIFFERENTIABLE_TAC THEN ASM_REWRITE_TAC[REAL_LT_POW_2; REAL_EXP_NZ]]]; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_REAL_INTEGRAL_SPIKE)) THEN EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; IN_DIFF; IN_SING] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 <= x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_EXP_NEG; GSYM RPOW_POW] THEN ASM_SIMP_TAC[RPOW_RPOW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[RPOW_NEG; RPOW_POW; REAL_POW_1] THEN MP_TAC(SPEC `(x:real) pow 2` REAL_EXP_NZ) THEN UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD]; FIRST_X_ASSUM(K ALL_TAC o SPECL [`a:real`; `b:real`]) THEN DISCH_THEN(LABEL_TAC "*")] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b <= a \/ a <= b`) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL] THEN REWRITE_TAC[real_integrable_on] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `&0`) THEN REWRITE_TAC[REAL_LE_REFL; HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN ONCE_REWRITE_TAC[REAL_ARITH `&0 < B /\ B <= b <=> &0 < B /\ B <= b /\ &0 <= b`] THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `max B (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MAX; REAL_MAX_LE] THEN X_GEN_TAC `b:real` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `(b:real) pow 1` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[ARITH]);; hol-light/Multivariate/geom.ml000066400000000000000000001602571303454263000167070ustar00rootroot00000000000000(* ========================================================================= *) (* Some geometric notions in real^N. *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; prioritize_vector();; (* ------------------------------------------------------------------------- *) (* Pythagoras's theorem is almost immediate. *) (* ------------------------------------------------------------------------- *) let PYTHAGORAS = prove (`!A B C:real^N. orthogonal (A - B) (C - B) ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, REWRITE_TAC[NORM_POW_2; orthogonal; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Angle between vectors (always 0 <= angle <= pi). *) (* ------------------------------------------------------------------------- *) let vector_angle = new_definition `vector_angle x y = if x = vec 0 \/ y = vec 0 then pi / &2 else acs((x dot y) / (norm x * norm y))`;; let VECTOR_ANGLE_LINEAR_IMAGE_EQ = prove (`!f x y. linear f /\ (!x. norm(f x) = norm x) ==> (vector_angle (f x) (f y) = vector_angle x y)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[vector_angle; GSYM NORM_EQ_0] THEN ASM_MESON_TAC[PRESERVES_NORM_PRESERVES_DOT]);; add_linear_invariants [VECTOR_ANGLE_LINEAR_IMAGE_EQ];; let VECTOR_ANGLE_ORTHOGONAL_TRANSFORMATION = prove (`!f x y:real^N. orthogonal_transformation f ==> vector_angle (f x) (f y) = vector_angle x y`, REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; VECTOR_ANGLE_LINEAR_IMAGE_EQ]);; (* ------------------------------------------------------------------------- *) (* Basic properties of vector angles. *) (* ------------------------------------------------------------------------- *) let VECTOR_ANGLE_REFL = prove (`!x. vector_angle x x = if x = vec 0 then pi / &2 else &0`, GEN_TAC THEN REWRITE_TAC[vector_angle; DISJ_ACI] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_POW_2] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_ENTIRE; NORM_EQ_0; ACS_1]);; let VECTOR_ANGLE_SYM = prove (`!x y. vector_angle x y = vector_angle y x`, REWRITE_TAC[vector_angle; DISJ_SYM; DOT_SYM; REAL_MUL_SYM]);; let VECTOR_ANGLE_LMUL = prove (`!a x y:real^N. vector_angle (a % x) y = if a = &0 then pi / &2 else if &0 <= a then vector_angle x y else pi - vector_angle x y`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[vector_angle; VECTOR_MUL_EQ_0] THEN ASM_CASES_TAC `x:real^N = vec 0 \/ y:real^N = vec 0` THEN ASM_REWRITE_TAC[] THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NORM_MUL; DOT_LMUL; real_div; REAL_INV_MUL; real_abs] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN ASM_SIMP_TAC[REAL_FIELD `~(a = &0) ==> (a * x) * (inv a * y) * z = x * y * z`] THEN MATCH_MP_TAC ACS_NEG THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div; NORM_CAUCHY_SCHWARZ_DIV]);; let VECTOR_ANGLE_RMUL = prove (`!a x y:real^N. vector_angle x (a % y) = if a = &0 then pi / &2 else if &0 <= a then vector_angle x y else pi - vector_angle x y`, ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN REWRITE_TAC[VECTOR_ANGLE_LMUL]);; let VECTOR_ANGLE_LNEG = prove (`!x y. vector_angle (--x) y = pi - vector_angle x y`, REWRITE_TAC[VECTOR_ARITH `--x = -- &1 % x`; VECTOR_ANGLE_LMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let VECTOR_ANGLE_RNEG = prove (`!x y. vector_angle x (--y) = pi - vector_angle x y`, ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN REWRITE_TAC[VECTOR_ANGLE_LNEG]);; let VECTOR_ANGLE_NEG2 = prove (`!x y. vector_angle (--x) (--y) = vector_angle x y`, REWRITE_TAC[VECTOR_ANGLE_LNEG; VECTOR_ANGLE_RNEG] THEN REAL_ARITH_TAC);; let SIN_VECTOR_ANGLE_LMUL = prove (`!a x y:real^N. sin(vector_angle (a % x) y) = if a = &0 then &1 else sin(vector_angle x y)`, REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_ANGLE_LMUL] THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[SIN_PI2] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI] THEN REAL_ARITH_TAC);; let SIN_VECTOR_ANGLE_RMUL = prove (`!a x y:real^N. sin(vector_angle x (a % y)) = if a = &0 then &1 else sin(vector_angle x y)`, ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN REWRITE_TAC[SIN_VECTOR_ANGLE_LMUL]);; let VECTOR_ANGLE = prove (`!x y:real^N. x dot y = norm(x) * norm(y) * cos(vector_angle x y)`, REPEAT GEN_TAC THEN REWRITE_TAC[vector_angle] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO; NORM_0; REAL_MUL_LZERO] THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO; NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c:real = c * a * b`] THEN ASM_SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT] THEN MATCH_MP_TAC(GSYM COS_ACS) THEN ASM_REWRITE_TAC[REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV]);; let VECTOR_ANGLE_RANGE = prove (`!x y:real^N. &0 <= vector_angle x y /\ vector_angle x y <= pi`, REPEAT GEN_TAC THEN REWRITE_TAC[vector_angle] THEN COND_CASES_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN MATCH_MP_TAC ACS_BOUNDS THEN ASM_REWRITE_TAC[REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV]);; let ORTHOGONAL_VECTOR_ANGLE = prove (`!x y:real^N. orthogonal x y <=> vector_angle x y = pi / &2`, REPEAT STRIP_TAC THEN REWRITE_TAC[orthogonal; vector_angle] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN EQ_TAC THENL [SIMP_TAC[real_div; REAL_MUL_LZERO] THEN DISCH_TAC THEN REWRITE_TAC[GSYM real_div; GSYM COS_PI2] THEN MATCH_MP_TAC ACS_COS THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN SIMP_TAC[COS_ACS; REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV; COS_PI2] THEN ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT; REAL_MUL_LZERO]]);; let VECTOR_ANGLE_EQ_0 = prove (`!x y:real^N. vector_angle x y = &0 <=> ~(x = vec 0) /\ ~(y = vec 0) /\ norm(x) % y = norm(y) % x`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN ASM_SIMP_TAC[vector_angle; PI_NZ; REAL_ARITH `x / &2 = &0 <=> x = &0`] THEN REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQ] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; NORM_POS_LT; REAL_LT_MUL] THEN MESON_TAC[ACS_1; COS_ACS; REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV; COS_0]);; let VECTOR_ANGLE_EQ_PI = prove (`!x y:real^N. vector_angle x y = pi <=> ~(x = vec 0) /\ ~(y = vec 0) /\ norm(x) % y + norm(y) % x = vec 0`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`x:real^N`; `--y:real^N`] VECTOR_ANGLE_EQ_0) THEN SIMP_TAC[VECTOR_ANGLE_RNEG; REAL_ARITH `pi - x = &0 <=> x = pi`] THEN STRIP_TAC THEN REWRITE_TAC[NORM_NEG; VECTOR_ARITH `--x = vec 0 <=> x = vec 0`] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; let VECTOR_ANGLE_EQ_0_DIST = prove (`!x y:real^N. vector_angle x y = &0 <=> ~(x = vec 0) /\ ~(y = vec 0) /\ norm(x + y) = norm x + norm y`, REWRITE_TAC[VECTOR_ANGLE_EQ_0; GSYM NORM_TRIANGLE_EQ]);; let VECTOR_ANGLE_EQ_PI_DIST = prove (`!x y:real^N. vector_angle x y = pi <=> ~(x = vec 0) /\ ~(y = vec 0) /\ norm(x - y) = norm x + norm y`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`x:real^N`; `--y:real^N`] VECTOR_ANGLE_EQ_0_DIST) THEN SIMP_TAC[VECTOR_ANGLE_RNEG; REAL_ARITH `pi - x = &0 <=> x = pi`] THEN STRIP_TAC THEN REWRITE_TAC[NORM_NEG] THEN NORM_ARITH_TAC);; let SIN_VECTOR_ANGLE_POS = prove (`!v w. &0 <= sin(vector_angle v w)`, SIMP_TAC[SIN_POS_PI_LE; VECTOR_ANGLE_RANGE]);; let SIN_VECTOR_ANGLE_EQ_0 = prove (`!x y. sin(vector_angle x y) = &0 <=> vector_angle x y = &0 \/ vector_angle x y = pi`, MESON_TAC[SIN_POS_PI; VECTOR_ANGLE_RANGE; REAL_LT_LE; SIN_0; SIN_PI]);; let ASN_SIN_VECTOR_ANGLE = prove (`!x y:real^N. asn(sin(vector_angle x y)) = if vector_angle x y <= pi / &2 then vector_angle x y else pi - vector_angle x y`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `asn(sin(pi - vector_angle (x:real^N) y))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI] THEN REAL_ARITH_TAC; ALL_TAC]] THEN MATCH_MP_TAC ASN_SIN THEN MP_TAC(ISPECL [`x:real^N`; `y:real^N`] VECTOR_ANGLE_RANGE) THEN ASM_REAL_ARITH_TAC);; let SIN_VECTOR_ANGLE_EQ = prove (`!x y w z. sin(vector_angle x y) = sin(vector_angle w z) <=> vector_angle x y = vector_angle w z \/ vector_angle x y = pi - vector_angle w z`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI] THENL [ALL_TAC; REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `asn`) THEN REWRITE_TAC[ASN_SIN_VECTOR_ANGLE] THEN REAL_ARITH_TAC);; let CONTINUOUS_WITHIN_CX_VECTOR_ANGLE_COMPOSE = prove (`!f:real^M->real^N g x s. ~(f x = vec 0) /\ ~(g x = vec 0) /\ f continuous (at x within s) /\ g continuous (at x within s) ==> (\x. Cx(vector_angle (f x) (g x))) continuous (at x within s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THEN ASM_SIMP_TAC[CONTINUOUS_TRIVIAL_LIMIT; vector_angle] THEN SUBGOAL_THEN `(cacs o (\x. Cx(((f x:real^N) dot g x) / (norm(f x) * norm(g x))))) continuous (at (x:real^M) within s)` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL [REWRITE_TAC[CX_DIV; CX_MUL] THEN REWRITE_TAC[WITHIN_UNIV] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV THEN ASM_SIMP_TAC[NETLIMIT_WITHIN; COMPLEX_ENTIRE; CX_INJ; NORM_EQ_0] THEN REWRITE_TAC[CONTINUOUS_CX_LIFT; GSYM CX_MUL; LIFT_CMUL] THEN ASM_SIMP_TAC[CONTINUOUS_LIFT_DOT2] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; o_DEF]; MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `{z | real z /\ abs(Re z) <= &1}` THEN REWRITE_TAC[CONTINUOUS_WITHIN_CACS_REAL] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[REAL_CX; RE_CX; NORM_CAUCHY_SCHWARZ_DIV]]; ASM_SIMP_TAC[CONTINUOUS_WITHIN; CX_ACS; o_DEF; NORM_CAUCHY_SCHWARZ_DIV] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN SUBGOAL_THEN `eventually (\y. ~((f:real^M->real^N) y = vec 0) /\ ~((g:real^M->real^N) y = vec 0)) (at x within s)` MP_TAC THENL [REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL [UNDISCH_TAC `(f:real^M->real^N) continuous (at x within s)`; UNDISCH_TAC `(g:real^M->real^N) continuous (at x within s)`] THEN REWRITE_TAC[CONTINUOUS_WITHIN; tendsto] THENL [DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x)`); DISCH_THEN(MP_TAC o SPEC `norm((g:real^M->real^N) x)`)] THEN ASM_REWRITE_TAC[NORM_POS_LT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN SIMP_TAC[CX_ACS; NORM_CAUCHY_SCHWARZ_DIV]]]);; let CONTINUOUS_AT_CX_VECTOR_ANGLE = prove (`!c x:real^N. ~(x = vec 0) ==> (Cx o vector_angle c) continuous (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[o_DEF; vector_angle] THEN ASM_CASES_TAC `c:real^N = vec 0` THEN ASM_REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\x:real^N. cacs(Cx((c dot x) / (norm c * norm x)))`; `norm(x:real^N)`] THEN ASM_REWRITE_TAC[NORM_POS_LT] THEN CONJ_TAC THENL [X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THENL [ASM_MESON_TAC[NORM_ARITH `~(dist(vec 0,x) < norm x)`]; ALL_TAC] THEN MATCH_MP_TAC(GSYM CX_ACS) THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_DIV]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_WITHIN_COMPOSE) THEN CONJ_TAC THENL [REWRITE_TAC[CX_DIV; CX_MUL] THEN REWRITE_TAC[WITHIN_UNIV] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV THEN ASM_REWRITE_TAC[NETLIMIT_AT; COMPLEX_ENTIRE; CX_INJ; NORM_EQ_0] THEN SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST; CONTINUOUS_AT_CX_NORM; CONTINUOUS_AT_CX_DOT]; MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `{z | real z /\ abs(Re z) <= &1}` THEN REWRITE_TAC[CONTINUOUS_WITHIN_CACS_REAL] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[REAL_CX; RE_CX; NORM_CAUCHY_SCHWARZ_DIV]]);; let CONTINUOUS_WITHIN_CX_VECTOR_ANGLE = prove (`!c x:real^N s. ~(x = vec 0) ==> (Cx o vector_angle c) continuous (at x within s)`, SIMP_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CX_VECTOR_ANGLE]);; let REAL_CONTINUOUS_AT_VECTOR_ANGLE = prove (`!c x:real^N. ~(x = vec 0) ==> (vector_angle c) real_continuous (at x)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; CONTINUOUS_AT_CX_VECTOR_ANGLE]);; let REAL_CONTINUOUS_WITHIN_VECTOR_ANGLE = prove (`!c s x:real^N. ~(x = vec 0) ==> (vector_angle c) real_continuous (at x within s)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; CONTINUOUS_WITHIN_CX_VECTOR_ANGLE]);; let CONTINUOUS_ON_CX_VECTOR_ANGLE = prove (`!s. ~(vec 0 IN s) ==> (Cx o vector_angle c) continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN ASM_MESON_TAC[CONTINUOUS_WITHIN_CX_VECTOR_ANGLE]);; let VECTOR_ANGLE_EQ = prove (`!u v x y. ~(u = vec 0) /\ ~(v = vec 0) /\ ~(x = vec 0) /\ ~(y = vec 0) ==> (vector_angle u v = vector_angle x y <=> (x dot y) * norm(u) * norm(v) = (u dot v) * norm(x) * norm(y))`, SIMP_TAC[vector_angle; NORM_EQ_0; REAL_FIELD `~(u = &0) /\ ~(v = &0) /\ ~(x = &0) /\ ~(y = &0) ==> (a * u * v = b * x * y <=> a / (x * y) = b / (u * v))`] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN SIMP_TAC[COS_ACS; NORM_CAUCHY_SCHWARZ_DIV; REAL_BOUNDS_LE]);; let COS_VECTOR_ANGLE_EQ = prove (`!u v x y. cos(vector_angle u v) = cos(vector_angle x y) <=> vector_angle u v = vector_angle x y`, MESON_TAC[ACS_COS; VECTOR_ANGLE_RANGE]);; let COLLINEAR_VECTOR_ANGLE = prove (`!x y. ~(x = vec 0) /\ ~(y = vec 0) ==> (collinear {vec 0,x,y} <=> vector_angle x y = &0 \/ vector_angle x y = pi)`, REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL; NORM_CAUCHY_SCHWARZ_ABS_EQ; VECTOR_ANGLE_EQ_0; VECTOR_ANGLE_EQ_PI] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; let COLLINEAR_SIN_VECTOR_ANGLE = prove (`!x y. ~(x = vec 0) /\ ~(y = vec 0) ==> (collinear {vec 0,x,y} <=> sin(vector_angle x y) = &0)`, REWRITE_TAC[SIN_VECTOR_ANGLE_EQ_0; COLLINEAR_VECTOR_ANGLE]);; let COLLINEAR_SIN_VECTOR_ANGLE_IMP = prove (`!x y. sin(vector_angle x y) = &0 ==> ~(x = vec 0) /\ ~(y = vec 0) /\ collinear {vec 0,x,y}`, MESON_TAC[COLLINEAR_SIN_VECTOR_ANGLE; SIN_VECTOR_ANGLE_EQ_0; VECTOR_ANGLE_EQ_0_DIST; VECTOR_ANGLE_EQ_PI_DIST]);; let VECTOR_ANGLE_EQ_0_RIGHT = prove (`!x y z:real^N. vector_angle x y = &0 ==> (vector_angle x z = vector_angle y z)`, REWRITE_TAC[VECTOR_ANGLE_EQ_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vector_angle (norm(x:real^N) % y) (z:real^N)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_ANGLE_LMUL; NORM_EQ_0; NORM_POS_LE]; REWRITE_TAC[VECTOR_ANGLE_LMUL] THEN ASM_REWRITE_TAC[NORM_EQ_0; NORM_POS_LE]]);; let VECTOR_ANGLE_EQ_0_LEFT = prove (`!x y z:real^N. vector_angle x y = &0 ==> (vector_angle z x = vector_angle z y)`, MESON_TAC[VECTOR_ANGLE_EQ_0_RIGHT; VECTOR_ANGLE_SYM]);; let VECTOR_ANGLE_EQ_PI_RIGHT = prove (`!x y z:real^N. vector_angle x y = pi ==> (vector_angle x z = pi - vector_angle y z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`--x:real^N`; `y:real^N`; `z:real^N`] VECTOR_ANGLE_EQ_0_RIGHT) THEN ASM_REWRITE_TAC[VECTOR_ANGLE_LNEG] THEN REAL_ARITH_TAC);; let VECTOR_ANGLE_EQ_PI_LEFT = prove (`!x y z:real^N. vector_angle x y = pi ==> (vector_angle z x = pi - vector_angle z y)`, MESON_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; VECTOR_ANGLE_SYM]);; let COS_VECTOR_ANGLE = prove (`!x y:real^N. cos(vector_angle x y) = if x = vec 0 \/ y = vec 0 then &0 else (x dot y) / (norm x * norm y)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_REWRITE_TAC[vector_angle; COS_PI2]; ALL_TAC] THEN ASM_CASES_TAC `y:real^N = vec 0` THENL [ASM_REWRITE_TAC[vector_angle; COS_PI2]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_LT_MUL; NORM_POS_LT; VECTOR_ANGLE] THEN REAL_ARITH_TAC);; let SIN_VECTOR_ANGLE = prove (`!x y:real^N. sin(vector_angle x y) = if x = vec 0 \/ y = vec 0 then &1 else sqrt(&1 - ((x dot y) / (norm x * norm y)) pow 2)`, SIMP_TAC[SIN_COS_SQRT; SIN_VECTOR_ANGLE_POS; COS_VECTOR_ANGLE] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_1]);; let SIN_SQUARED_VECTOR_ANGLE = prove (`!x y:real^N. sin(vector_angle x y) pow 2 = if x = vec 0 \/ y = vec 0 then &1 else &1 - ((x dot y) / (norm x * norm y)) pow 2`, REPEAT GEN_TAC THEN REWRITE_TAC [REWRITE_RULE [REAL_ARITH `s + c = &1 <=> s = &1 - c`] SIN_CIRCLE] THEN REWRITE_TAC[COS_VECTOR_ANGLE] THEN REAL_ARITH_TAC);; let VECTOR_ANGLE_COMPLEX_LMUL = prove (`!a. ~(a = Cx(&0)) ==> vector_angle (a * x) (a * y) = vector_angle x y`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THENL [ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; vector_angle; COMPLEX_VEC_0]; ALL_TAC] THEN ASM_CASES_TAC `y = Cx(&0)` THENL [ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; vector_angle; COMPLEX_VEC_0]; ALL_TAC] THEN MP_TAC(ISPECL [`a * x:complex`; `a * y:complex`; `x:complex`; `y:complex`] VECTOR_ANGLE_EQ) THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC(REAL_RING `a pow 2 * xy:real = d ==> xy * (a * x) * (a * y) = d * x * y`) THEN REWRITE_TAC[NORM_POW_2] THEN REWRITE_TAC[DOT_2; complex_mul; GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN REAL_ARITH_TAC);; let VECTOR_ANGLE_1 = prove (`!x. vector_angle x (Cx(&1)) = acs(Re x / norm x)`, GEN_TAC THEN SIMP_TAC[vector_angle; COMPLEX_VEC_0; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[real_div; RE_CX; ACS_0; REAL_MUL_LZERO]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_MUL_RID] THEN REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF; RE_CX; IM_CX] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let ARG_EQ_VECTOR_ANGLE_1 = prove (`!z. ~(z = Cx(&0)) /\ &0 <= Im z ==> Arg z = vector_angle z (Cx(&1))`, REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ANGLE_1] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) [ARG] THEN REWRITE_TAC[RE_MUL_CX; RE_CEXP; RE_II; IM_MUL_II; IM_CX; RE_CX] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_EXP_0; REAL_MUL_LID] THEN ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD `~(z = &0) ==> (z * x) / z = x`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ACS_COS THEN ASM_REWRITE_TAC[ARG; ARG_LE_PI]);; let VECTOR_ANGLE_ARG = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> vector_angle w z = if &0 <= Im(z / w) then Arg(z / w) else &2 * pi - Arg(z / w)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [SUBGOAL_THEN `z = w * (z / w) /\ w = w * Cx(&1)` MP_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; ALL_TAC]; SUBGOAL_THEN `w = z * (w / z) /\ z = z * Cx(&1)` MP_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; ALL_TAC]] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN ASM_SIMP_TAC[VECTOR_ANGLE_COMPLEX_LMUL] THENL [ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ARG_EQ_VECTOR_ANGLE_1 THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; MP_TAC(ISPEC `z / w:complex` ARG_INV) THEN ANTS_TAC THENL [ASM_MESON_TAC[real; REAL_LE_REFL]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[COMPLEX_INV_DIV] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ARG_EQ_VECTOR_ANGLE_1 THEN CONJ_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN REWRITE_TAC[IM_COMPLEX_INV_GE_0] THEN ASM_REAL_ARITH_TAC]]);; let VECTOR_ANGLE_PRESERVING_EQ_SIMILARITY = prove (`!f:real^N->real^N. linear f /\ (!x y. vector_angle (f x) (f y) = vector_angle x y) <=> ?c g. ~(c = &0) /\ orthogonal_transformation g /\ f = \z. c % g z`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_COMPOSE_CMUL] THEN ASM_SIMP_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN REWRITE_TAC[REAL_ARITH `pi - (pi - x) = x`; COND_ID] THEN ASM_MESON_TAC[VECTOR_ANGLE_ORTHOGONAL_TRANSFORMATION]] THEN MP_TAC(ISPEC `f:real^N->real^N` ORTHOGONALITY_PRESERVING_EQ_SIMILARITY) THEN ASM_REWRITE_TAC[ORTHOGONAL_VECTOR_ANGLE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`basis 1:real^N`; `basis 1:real^N`]) THEN ASM_REWRITE_TAC[VECTOR_ANGLE_REFL; VECTOR_MUL_LZERO] THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let VECTOR_ANGLE_PRESERVING_EQ_SIMILARITY_ALT = prove (`!f:real^N->real^N. linear f /\ (!x y. vector_angle (f x) (f y) = vector_angle x y) <=> ?c g. &0 < c /\ orthogonal_transformation g /\ f = \z. c % g z`, GEN_TAC THEN REWRITE_TAC[VECTOR_ANGLE_PRESERVING_EQ_SIMILARITY] THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; MESON_TAC[REAL_LT_REFL]] THEN MAP_EVERY X_GEN_TAC [`c:real`; `g:real^N->real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(c = &0) ==> &0 < c \/ &0 < --c`)) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`--c:real`; `\x. --((g:real^N->real^N) x)`] THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_NEG] THEN REWRITE_TAC[VECTOR_MUL_LNEG; VECTOR_MUL_RNEG; VECTOR_NEG_NEG]);; (* ------------------------------------------------------------------------- *) (* Traditional geometric notion of angle (always 0 <= theta <= pi). *) (* ------------------------------------------------------------------------- *) let angle = new_definition `angle(a,b,c) = vector_angle (a - b) (c - b)`;; let ANGLE_LINEAR_IMAGE_EQ = prove (`!f a b c. linear f /\ (!x. norm(f x) = norm x) ==> angle(f a,f b,f c) = angle(a,b,c)`, SIMP_TAC[angle; GSYM LINEAR_SUB; VECTOR_ANGLE_LINEAR_IMAGE_EQ]);; add_linear_invariants [ANGLE_LINEAR_IMAGE_EQ];; let ANGLE_TRANSLATION_EQ = prove (`!a b c d. angle(a + b,a + c,a + d) = angle(b,c,d)`, REPEAT GEN_TAC THEN REWRITE_TAC[angle] THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; add_translation_invariants [ANGLE_TRANSLATION_EQ];; let VECTOR_ANGLE_ANGLE = prove (`vector_angle x y = angle(x,vec 0,y)`, REWRITE_TAC[angle; VECTOR_SUB_RZERO]);; let ANGLE_EQ_PI_DIST = prove (`!A B C:real^N. angle(A,B,C) = pi <=> ~(A = B) /\ ~(C = B) /\ dist(A,C) = dist(A,B) + dist(B,C)`, REWRITE_TAC[angle; VECTOR_ANGLE_EQ_PI_DIST] THEN NORM_ARITH_TAC);; let SIN_ANGLE_POS = prove (`!A B C. &0 <= sin(angle(A,B,C))`, REWRITE_TAC[angle; SIN_VECTOR_ANGLE_POS]);; let ANGLE = prove (`!A B C. (A - C) dot (B - C) = dist(A,C) * dist(B,C) * cos(angle(A,C,B))`, REWRITE_TAC[angle; dist; GSYM VECTOR_ANGLE]);; let ANGLE_REFL = prove (`!A B. angle(A,A,B) = pi / &2 /\ angle(B,A,A) = pi / &2`, REWRITE_TAC[angle; vector_angle; VECTOR_SUB_REFL]);; let ANGLE_REFL_MID = prove (`!A B. ~(A = B) ==> angle(A,B,A) = &0`, SIMP_TAC[angle; vector_angle; VECTOR_SUB_EQ; GSYM NORM_POW_2; ARITH; GSYM REAL_POW_2; REAL_DIV_REFL; ACS_1; REAL_POW_EQ_0; NORM_EQ_0]);; let ANGLE_SYM = prove (`!A B C. angle(A,B,C) = angle(C,B,A)`, REWRITE_TAC[angle; vector_angle; VECTOR_SUB_EQ; DISJ_SYM; REAL_MUL_SYM; DOT_SYM]);; let ANGLE_RANGE = prove (`!A B C. &0 <= angle(A,B,C) /\ angle(A,B,C) <= pi`, REWRITE_TAC[angle; VECTOR_ANGLE_RANGE]);; let COS_ANGLE_EQ = prove (`!a b c a' b' c'. cos(angle(a,b,c)) = cos(angle(a',b',c')) <=> angle(a,b,c) = angle(a',b',c')`, REWRITE_TAC[angle; COS_VECTOR_ANGLE_EQ]);; let ANGLE_EQ = prove (`!a b c a' b' c'. ~(a = b) /\ ~(c = b) /\ ~(a' = b') /\ ~(c' = b') ==> (angle(a,b,c) = angle(a',b',c') <=> ((a' - b') dot (c' - b')) * norm (a - b) * norm (c - b) = ((a - b) dot (c - b)) * norm (a' - b') * norm (c' - b'))`, SIMP_TAC[angle; VECTOR_ANGLE_EQ; VECTOR_SUB_EQ]);; let SIN_ANGLE_EQ_0 = prove (`!A B C. sin(angle(A,B,C)) = &0 <=> angle(A,B,C) = &0 \/ angle(A,B,C) = pi`, REWRITE_TAC[angle; SIN_VECTOR_ANGLE_EQ_0]);; let SIN_ANGLE_EQ = prove (`!A B C A' B' C'. sin(angle(A,B,C)) = sin(angle(A',B',C')) <=> angle(A,B,C) = angle(A',B',C') \/ angle(A,B,C) = pi - angle(A',B',C')`, REWRITE_TAC[angle; SIN_VECTOR_ANGLE_EQ]);; let COLLINEAR_ANGLE = prove (`!A B C. ~(A = B) /\ ~(B = C) ==> (collinear {A,B,C} <=> angle(A,B,C) = &0 \/ angle(A,B,C) = pi)`, ONCE_REWRITE_TAC[COLLINEAR_3] THEN SIMP_TAC[COLLINEAR_VECTOR_ANGLE; VECTOR_SUB_EQ; angle]);; let COLLINEAR_SIN_ANGLE = prove (`!A B C. ~(A = B) /\ ~(B = C) ==> (collinear {A,B,C} <=> sin(angle(A,B,C)) = &0)`, REWRITE_TAC[SIN_ANGLE_EQ_0; COLLINEAR_ANGLE]);; let COLLINEAR_SIN_ANGLE_IMP = prove (`!A B C. sin(angle(A,B,C)) = &0 ==> ~(A = B) /\ ~(B = C) /\ collinear {A,B,C}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[angle] THEN DISCH_THEN(MP_TAC o MATCH_MP COLLINEAR_SIN_VECTOR_ANGLE_IMP) THEN SIMP_TAC[VECTOR_SUB_EQ]);; let ANGLE_EQ_0_RIGHT = prove (`!A B C. angle(A,B,C) = &0 ==> angle(A,B,D) = angle(C,B,D)`, REWRITE_TAC[VECTOR_ANGLE_EQ_0_RIGHT; angle]);; let ANGLE_EQ_0_LEFT = prove (`!A B C. angle(A,B,C) = &0 ==> angle(D,B,A) = angle(D,B,C)`, MESON_TAC[ANGLE_EQ_0_RIGHT; ANGLE_SYM]);; let ANGLE_EQ_PI_RIGHT = prove (`!A B C. angle(A,B,C) = pi ==> angle(A,B,D) = pi - angle(C,B,D)`, REWRITE_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; angle]);; let ANGLE_EQ_PI_LEFT = prove (`!A B C. angle(A,B,C) = pi ==> angle(A,B,D) = pi - angle(C,B,D)`, MESON_TAC[ANGLE_EQ_PI_RIGHT; ANGLE_SYM]);; let COS_ANGLE = prove (`!a b c. cos(angle(a,b,c)) = if a = b \/ c = b then &0 else ((a - b) dot (c - b)) / (norm(a - b) * norm(c - b))`, REWRITE_TAC[angle; COS_VECTOR_ANGLE; VECTOR_SUB_EQ]);; let SIN_ANGLE = prove (`!a b c. sin(angle(a,b,c)) = if a = b \/ c = b then &1 else sqrt(&1 - (((a - b) dot (c - b)) / (norm(a - b) * norm(c - b))) pow 2)`, REWRITE_TAC[angle; SIN_VECTOR_ANGLE; VECTOR_SUB_EQ]);; let SIN_SQUARED_ANGLE = prove (`!a b c. sin(angle(a,b,c)) pow 2 = if a = b \/ c = b then &1 else &1 - (((a - b) dot (c - b)) / (norm(a - b) * norm(c - b))) pow 2`, REWRITE_TAC[angle; SIN_SQUARED_VECTOR_ANGLE; VECTOR_SUB_EQ]);; (* ------------------------------------------------------------------------- *) (* The basic right angle triangles of elementary trigonometry. *) (* ------------------------------------------------------------------------- *) let COS_ADJACENT_HYPOTENUSE = prove (`!A B C:real^N. orthogonal (A - B) (C - B) ==> dist(A,C) * cos(angle(B,A,C)) = dist(A,B)`, GEOM_ORIGIN_TAC `A:real^N` THEN REPEAT GEN_TAC THEN REWRITE_TAC[DIST_0; angle; VECTOR_SUB_RZERO] THEN REWRITE_TAC[ORTHOGONAL_LNEG; VECTOR_SUB_LZERO] THEN DISCH_TAC THEN ASM_CASES_TAC `B:real^N = vec 0` THENL [ASM_REWRITE_TAC[vector_angle; COS_PI2; NORM_0; REAL_MUL_RZERO]; MATCH_MP_TAC(REAL_RING `~(b = &0) /\ b * x = b pow 2 ==> x = b`) THEN ASM_REWRITE_TAC[NORM_EQ_0; GSYM VECTOR_ANGLE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthogonal]) THEN REWRITE_TAC[DOT_RSUB; NORM_POW_2] THEN REAL_ARITH_TAC]);; let COS_ADJACENT_OVER_HYPOTENUSE = prove (`!A B C:real^N. orthogonal (A - B) (C - B) ==> cos(angle(B,A,C)) = dist(A,B) / dist(A,C)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^N = C` THENL [ASM_REWRITE_TAC[DIST_REFL; real_div; REAL_INV_0; angle; VECTOR_SUB_REFL; vector_angle] THEN REWRITE_TAC[GSYM real_div; COS_PI2; REAL_MUL_RZERO]; ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; DIST_POS_LT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[COS_ADJACENT_HYPOTENUSE]]);; let SIN_OPPOSITE_HYPOTENUSE = prove (`!A B C:real^N. orthogonal (A - B) (C - B) ==> dist(A,C) * sin(angle(B,A,C)) = dist(C,B)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^N = C` THEN ASM_SIMP_TAC[ORTHOGONAL_REFL; VECTOR_SUB_EQ; DIST_REFL; REAL_MUL_LZERO] THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[dist; NORM_EQ_SQUARE] THEN SIMP_TAC[REAL_LE_MUL; SIN_ANGLE_POS; NORM_POS_LE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COS_ADJACENT_HYPOTENUSE) THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING `x:real = y ==> x pow 2 = y pow 2`)) THEN REWRITE_TAC[REAL_POW_MUL; GSYM NORM_POW_2; GSYM dist] THEN MATCH_MP_TAC(REAL_RING `d + e = h /\ s + c = &1 /\ ~(h = &0) ==> h * c = d ==> e = h * s`) THEN ASM_REWRITE_TAC[SIN_CIRCLE; REAL_POW_EQ_0; DIST_EQ_0] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PYTHAGORAS) THEN REWRITE_TAC[GSYM dist; DIST_SYM] THEN REAL_ARITH_TAC);; let SIN_OPPOSITE_OVER_HYPOTENUSE = prove (`!A B C:real^N. orthogonal (A - B) (C - B) /\ ~(A = C) ==> sin(angle(B,A,C)) = dist(C,B) / dist(A,C)`, SIMP_TAC[REAL_EQ_RDIV_EQ; DIST_POS_LT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[SIN_OPPOSITE_HYPOTENUSE]);; let TAN_OPPOSITE_ADJACENT = prove (`!A B C:real^N. orthogonal (A - B) (C - B) /\ ~(A = B) ==> dist(A,B) * tan(angle(B,A,C)) = dist(C,B)`, REPEAT STRIP_TAC THEN REWRITE_TAC[tan] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COS_ADJACENT_HYPOTENUSE) THEN FIRST_ASSUM(MP_TAC o MATCH_MP SIN_OPPOSITE_HYPOTENUSE) THEN ASM_CASES_TAC `cos (angle (B:real^N,A,C)) = &0` THENL [ALL_TAC; POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; real_div; REAL_MUL_RZERO; REAL_INV_0] THEN ASM_MESON_TAC[DIST_EQ_0]);; let TAN_OPPOSITE_OVER_ADJACENT = prove (`!A B C:real^N. orthogonal (A - B) (C - B) ==> tan(angle(B,A,C)) = dist(C,B) / dist(A,B)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `A:real^N = B` THENL [ASM_REWRITE_TAC[angle; VECTOR_SUB_REFL; vector_angle] THEN REWRITE_TAC[tan; COS_PI2; DIST_REFL; real_div; REAL_INV_0; REAL_MUL_RZERO]; ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; DIST_POS_LT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[TAN_OPPOSITE_ADJACENT]]);; (* ------------------------------------------------------------------------- *) (* The law of cosines. *) (* ------------------------------------------------------------------------- *) let LAW_OF_COSINES = prove (`!A B C:real^N. dist(B,C) pow 2 = (dist(A,B) pow 2 + dist(A,C) pow 2) - &2 * dist(A,B) * dist(A,C) * cos(angle(B,A,C))`, REPEAT GEN_TAC THEN REWRITE_TAC[angle; ONCE_REWRITE_RULE[NORM_SUB] dist; GSYM VECTOR_ANGLE; NORM_POW_2] THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The law of sines. *) (* ------------------------------------------------------------------------- *) let LAW_OF_SINES = prove (`!A B C:real^N. sin(angle(A,B,C)) * dist(B,C) = sin(angle(B,A,C)) * dist(A,C)`, REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN SIMP_TAC[SIN_ANGLE_POS; DIST_POS_LE; REAL_LE_MUL; ARITH] THEN REWRITE_TAC[REAL_POW_MUL; MATCH_MP (REAL_ARITH `x + y = &1 ==> x = &1 - y`) (SPEC_ALL SIN_CIRCLE)] THEN ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[ANGLE_REFL; COS_PI2] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM VECTOR_SUB_EQ]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM NORM_EQ_0]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_RING `~(a = &0) ==> a pow 2 * x = a pow 2 * y ==> x = y`)) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM dist] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN REWRITE_TAC[REAL_RING `a * (&1 - x) * b = c * (&1 - y) * d <=> a * b - a * b * x = c * d - c * d * y`] THEN REWRITE_TAC[GSYM REAL_POW_MUL; GSYM ANGLE] THEN REWRITE_TAC[REAL_POW_MUL; dist; NORM_POW_2] THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* The sum of the angles of a triangle. *) (* ------------------------------------------------------------------------- *) let TRIANGLE_ANGLE_SUM_LEMMA = prove (`!A B C:real^N. ~(A = B) /\ ~(A = C) /\ ~(B = C) ==> cos(angle(B,A,C) + angle(A,B,C) + angle(B,C,A)) = -- &1`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`C:real^N`; `B:real^N`; `A:real^N`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_SINES) THEN MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_SINES) THEN MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `A:real^N`] LAW_OF_SINES) THEN REWRITE_TAC[COS_ADD; SIN_ADD; dist; NORM_SUB] THEN MAP_EVERY (fun t -> MP_TAC(SPEC t SIN_CIRCLE)) [`angle(B:real^N,A,C)`; `angle(A:real^N,B,C)`; `angle(B:real^N,C,A)`] THEN REWRITE_TAC[COS_ADD; SIN_ADD; ANGLE_SYM] THEN CONV_TAC REAL_RING);; let COS_MINUS1_LEMMA = prove (`!x. cos(x) = -- &1 /\ &0 <= x /\ x < &3 * pi ==> x = pi`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?n. integer n /\ x = n * pi` (X_CHOOSE_THEN `nn:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN REWRITE_TAC[GSYM SIN_EQ_0] THENL [MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RING; ALL_TAC] THEN SUBGOAL_THEN `?n. nn = &n` (X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_MUL_POS_LE]) THEN SIMP_TAC[PI_POS; REAL_ARITH `&0 < p ==> ~(p < &0) /\ ~(p = &0)`] THEN ASM_MESON_TAC[INTEGER_POS; REAL_LT_LE]; ALL_TAC] THEN MATCH_MP_TAC(REAL_RING `n = &1 ==> n * p = p`) THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC(ARITH_RULE `n < 3 /\ ~(n = 0) /\ ~(n = 2) ==> n = 1`) THEN RULE_ASSUM_TAC(SIMP_RULE[REAL_LT_RMUL_EQ; PI_POS; REAL_OF_NUM_LT]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[COS_0; REAL_MUL_LZERO; COS_NPI] THEN REAL_ARITH_TAC);; let TRIANGLE_ANGLE_SUM = prove (`!A B C:real^N. ~(A = B /\ B = C /\ A = C) ==> angle(B,A,C) + angle(A,B,C) + angle(B,C,A) = pi`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`A:real^N = B`; `B:real^N = C`; `A:real^N = C`] THEN ASM_SIMP_TAC[ANGLE_REFL_MID; ANGLE_REFL; REAL_HALF; REAL_ADD_RID] THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[REAL_ADD_LID; REAL_HALF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COS_MINUS1_LEMMA THEN ASM_SIMP_TAC[TRIANGLE_ANGLE_SUM_LEMMA; REAL_LE_ADD; ANGLE_RANGE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= p /\ &0 <= y /\ y <= p /\ &0 <= z /\ z <= p /\ ~(x = p /\ y = p /\ z = p) ==> x + y + z < &3 * p`) THEN ASM_SIMP_TAC[ANGLE_RANGE] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANGLE_EQ_PI_DIST])) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM VECTOR_SUB_EQ])) THEN REWRITE_TAC[GSYM NORM_EQ_0; dist; NORM_SUB] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A few more lemmas about angles. *) (* ------------------------------------------------------------------------- *) let ANGLE_EQ_PI_OTHERS = prove (`!A B C:real^N. angle(A,B,C) = pi ==> angle(B,C,A) = &0 /\ angle(A,C,B) = &0 /\ angle(B,A,C) = &0 /\ angle(C,A,B) = &0`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [ANGLE_EQ_PI_DIST]) THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] TRIANGLE_ANGLE_SUM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x + p + y = p ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN SIMP_TAC[ANGLE_RANGE; ANGLE_SYM]);; let ANGLE_EQ_0_DIST = prove (`!A B C:real^N. angle(A,B,C) = &0 <=> ~(A = B) /\ ~(C = B) /\ (dist(A,B) = dist(A,C) + dist(C,B) \/ dist(B,C) = dist(A,C) + dist(A,B))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^N = B` THENL [ASM_REWRITE_TAC[angle; VECTOR_ANGLE_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN ASM_CASES_TAC `B:real^N = C` THENL [ASM_REWRITE_TAC[angle; VECTOR_ANGLE_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN ASM_CASES_TAC `A:real^N = C` THENL [ASM_SIMP_TAC[ANGLE_REFL_MID; DIST_REFL; REAL_ADD_LID]; ALL_TAC] THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THENL [MP_TAC(ISPECL[`A:real^N`; `C:real^N`; `B:real^N`] ANGLE_EQ_PI_DIST); MP_TAC(ISPECL[`B:real^N`; `A:real^N`; `C:real^N`] ANGLE_EQ_PI_DIST)] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIST_SYM; REAL_ADD_AC] THEN DISCH_THEN(MP_TAC o MATCH_MP ANGLE_EQ_PI_OTHERS) THEN SIMP_TAC[]] THEN ASM_REWRITE_TAC[angle; VECTOR_ANGLE_EQ_0; VECTOR_SUB_EQ] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (ISPECL [`norm(A - B:real^N)`; `norm(C - B:real^N)`] REAL_LT_TOTAL) THENL [ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; NORM_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `c - b:real^N = a - b <=> a = c`]; ONCE_REWRITE_TAC[VECTOR_ARITH `norm(A - B) % (C - B) = norm(C - B) % (A - B) <=> (norm(C - B) - norm(A - B)) % (A - B) = norm(A - B) % (C - A)`]; ONCE_REWRITE_TAC[VECTOR_ARITH `norm(A - B) % (C - B) = norm(C - B) % (A - B) <=> (norm(A - B) - norm(C - B)) % (C - B) = norm(C - B) % (A - C)`]] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NORM_CROSS_MULTIPLY)) THEN ASM_SIMP_TAC[REAL_SUB_LT; NORM_POS_LT; VECTOR_SUB_EQ] THEN SIMP_TAC[GSYM DIST_TRIANGLE_EQ] THEN SIMP_TAC[DIST_SYM]);; let ANGLE_EQ_0_DIST_ABS = prove (`!A B C:real^N. angle(A,B,C) = &0 <=> ~(A = B) /\ ~(C = B) /\ dist(A,C) = abs(dist(A,B) - dist(C,B))`, REPEAT GEN_TAC THEN REWRITE_TAC[ANGLE_EQ_0_DIST] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MP_TAC(ISPECL [`A:real^N`; `C:real^N`] DIST_POS_LE) THEN REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some rules for congruent triangles (not necessarily in the same real^N). *) (* ------------------------------------------------------------------------- *) let CONGRUENT_TRIANGLES_SSS = prove (`!A B C:real^M A' B' C':real^N. dist(A,B) = dist(A',B') /\ dist(B,C) = dist(B',C') /\ dist(C,A) = dist(C',A') ==> angle(A,B,C) = angle(A',B',C')`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`dist(A':real^N,B') = &0`; `dist(B':real^N,C') = &0`] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_EQ_0]) THEN ASM_SIMP_TAC[ANGLE_REFL_MID; ANGLE_REFL] THEN ONCE_REWRITE_TAC[GSYM COS_ANGLE_EQ] THEN MP_TAC(ISPECL [`B:real^M`; `A:real^M`; `C:real^M`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`B':real^N`; `A':real^N`; `C':real^N`] LAW_OF_COSINES) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM DIST_EQ_0; DIST_SYM] THEN CONV_TAC REAL_FIELD);; let CONGRUENT_TRIANGLES_SAS = prove (`!A B C:real^M A' B' C':real^N. dist(A,B) = dist(A',B') /\ angle(A,B,C) = angle(A',B',C') /\ dist(B,C) = dist(B',C') ==> dist(A,C) = dist(A',C')`, REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_EQ] THEN MP_TAC(ISPECL [`B:real^M`; `A:real^M`; `C:real^M`] LAW_OF_COSINES) THEN MP_TAC(ISPECL [`B':real^N`; `A':real^N`; `C':real^N`] LAW_OF_COSINES) THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN REPEAT BINOP_TAC THEN ASM_MESON_TAC[DIST_SYM]);; let CONGRUENT_TRIANGLES_AAS = prove (`!A B C:real^M A' B' C':real^N. angle(A,B,C) = angle(A',B',C') /\ angle(B,C,A) = angle(B',C',A') /\ dist(A,B) = dist(A',B') /\ ~(collinear {A,B,C}) ==> dist(A,C) = dist(A',C') /\ dist(B,C) = dist(B',C')`, REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^M = B` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `~(A':real^N = B')` ASSUME_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN SUBGOAL_THEN `angle(C:real^M,A,B) = angle(C':real^N,A',B')` ASSUME_TAC THENL [MP_TAC(ISPECL [`A:real^M`; `B:real^M`; `C:real^M`] TRIANGLE_ANGLE_SUM) THEN MP_TAC(ISPECL [`A':real^N`; `B':real^N`; `C':real^N`] TRIANGLE_ANGLE_SUM) THEN ASM_REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[ANGLE_SYM] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MP_TAC(ISPECL [`C:real^M`; `B:real^M`; `A:real^M`] LAW_OF_SINES) THEN MP_TAC(ISPECL [`C':real^N`; `B':real^N`; `A':real^N`] LAW_OF_SINES) THEN SUBGOAL_THEN `~(sin(angle(B':real^N,C',A')) = &0)` MP_TAC THENL [ASM_MESON_TAC[COLLINEAR_SIN_ANGLE_IMP; INSERT_AC]; ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ANGLE_SYM; DIST_SYM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ANGLE_SYM; DIST_SYM] THEN CONV_TAC REAL_FIELD]; ASM_MESON_TAC[CONGRUENT_TRIANGLES_SAS; DIST_SYM; ANGLE_SYM]]);; let CONGRUENT_TRIANGLES_ASA = prove (`!A B C:real^M A' B' C':real^N. angle(A,B,C) = angle(A',B',C') /\ dist(A,B) = dist(A',B') /\ angle(B,A,C) = angle(B',A',C') /\ ~(collinear {A,B,C}) ==> dist(A,C) = dist(A',C')`, REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^M = B` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(A':real^N = B')` ASSUME_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN MP_TAC(ISPECL [`A:real^M`; `B:real^M`; `C:real^M`] TRIANGLE_ANGLE_SUM) THEN MP_TAC(ISPECL [`A':real^N`; `B':real^N`; `C':real^N`] TRIANGLE_ANGLE_SUM) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a + b + x = pi /\ a + b + y = pi ==> x = y`)) THEN ASM_MESON_TAC[CONGRUENT_TRIANGLES_AAS; DIST_SYM; ANGLE_SYM]);; (* ------------------------------------------------------------------------- *) (* Full versions where we deduce everything from the conditions. *) (* ------------------------------------------------------------------------- *) let CONGRUENT_TRIANGLES_SSS_FULL = prove (`!A B C:real^M A' B' C':real^N. dist(A,B) = dist(A',B') /\ dist(B,C) = dist(B',C') /\ dist(C,A) = dist(C',A') ==> dist(A,B) = dist(A',B') /\ dist(B,C) = dist(B',C') /\ dist(C,A) = dist(C',A') /\ angle(A,B,C) = angle(A',B',C') /\ angle(B,C,A) = angle(B',C',A') /\ angle(C,A,B) = angle(C',A',B')`, MESON_TAC[CONGRUENT_TRIANGLES_SSS; DIST_SYM; ANGLE_SYM]);; let CONGRUENT_TRIANGLES_SAS_FULL = prove (`!A B C:real^M A' B' C':real^N. dist(A,B) = dist(A',B') /\ angle(A,B,C) = angle(A',B',C') /\ dist(B,C) = dist(B',C') ==> dist(A,B) = dist(A',B') /\ dist(B,C) = dist(B',C') /\ dist(C,A) = dist(C',A') /\ angle(A,B,C) = angle(A',B',C') /\ angle(B,C,A) = angle(B',C',A') /\ angle(C,A,B) = angle(C',A',B')`, MESON_TAC[CONGRUENT_TRIANGLES_SSS; DIST_SYM; ANGLE_SYM; CONGRUENT_TRIANGLES_SAS]);; let CONGRUENT_TRIANGLES_AAS_FULL = prove (`!A B C:real^M A' B' C':real^N. angle(A,B,C) = angle(A',B',C') /\ angle(B,C,A) = angle(B',C',A') /\ dist(A,B) = dist(A',B') /\ ~(collinear {A,B,C}) ==> dist(A,B) = dist(A',B') /\ dist(B,C) = dist(B',C') /\ dist(C,A) = dist(C',A') /\ angle(A,B,C) = angle(A',B',C') /\ angle(B,C,A) = angle(B',C',A') /\ angle(C,A,B) = angle(C',A',B')`, MESON_TAC[CONGRUENT_TRIANGLES_SSS; DIST_SYM; ANGLE_SYM; CONGRUENT_TRIANGLES_AAS]);; let CONGRUENT_TRIANGLES_ASA_FULL = prove (`!A B C:real^M A' B' C':real^N. angle(A,B,C) = angle(A',B',C') /\ dist(A,B) = dist(A',B') /\ angle(B,A,C) = angle(B',A',C') /\ ~(collinear {A,B,C}) ==> dist(A,B) = dist(A',B') /\ dist(B,C) = dist(B',C') /\ dist(C,A) = dist(C',A') /\ angle(A,B,C) = angle(A',B',C') /\ angle(B,C,A) = angle(B',C',A') /\ angle(C,A,B) = angle(C',A',B')`, MESON_TAC[CONGRUENT_TRIANGLES_ASA; CONGRUENT_TRIANGLES_SAS_FULL; DIST_SYM; ANGLE_SYM]);; (* ------------------------------------------------------------------------- *) (* Between-ness. *) (* ------------------------------------------------------------------------- *) let ANGLE_BETWEEN = prove (`!a b x. angle(a,x,b) = pi <=> ~(x = a) /\ ~(x = b) /\ between x (a,b)`, REPEAT GEN_TAC THEN REWRITE_TAC[between; ANGLE_EQ_PI_DIST] THEN REWRITE_TAC[EQ_SYM_EQ]);; let BETWEEN_ANGLE = prove (`!a b x. between x (a,b) <=> x = a \/ x = b \/ angle(a,x,b) = pi`, REPEAT GEN_TAC THEN REWRITE_TAC[ANGLE_BETWEEN] THEN MESON_TAC[BETWEEN_REFL]);; let ANGLES_ALONG_LINE = prove (`!A B C D:real^N. ~(C = A) /\ ~(C = B) /\ between C (A,B) ==> angle(A,C,D) + angle(B,C,D) = pi`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM ANGLE_BETWEEN] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP ANGLE_EQ_PI_LEFT) THEN REAL_ARITH_TAC);; let ANGLES_ADD_BETWEEN = prove (`!A B C D:real^N. between C (A,B) /\ ~(D = A) /\ ~(D = B) ==> angle(A,D,C) + angle(C,D,B) = angle(A,D,B)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^N = B` THENL [ASM_SIMP_TAC[BETWEEN_REFL_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ADD_LID]; ALL_TAC] THEN ASM_CASES_TAC `C:real^N = A` THEN ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ADD_LID] THEN ASM_CASES_TAC `C:real^N = B` THEN ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ADD_RID] THEN STRIP_TAC THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`; `D:real^N`] ANGLES_ALONG_LINE) THEN MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN MP_TAC(ISPECL [`A:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `angle(C:real^N,A,D) = angle(B,A,D) /\ angle(A,B,D) = angle(C,B,D)` (CONJUNCTS_THEN SUBST1_TAC) THENL [ALL_TAC; REWRITE_TAC[ANGLE_SYM] THEN REAL_ARITH_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC ANGLE_EQ_0_RIGHT THEN ASM_MESON_TAC[ANGLE_EQ_PI_OTHERS; BETWEEN_ANGLE]);; (* ------------------------------------------------------------------------- *) (* Distance from a point to a line expressed with angles. *) (* ------------------------------------------------------------------------- *) let SETDIST_POINT_LINE = prove (`!x y z:real^N. setdist({x},affine hull {y,z}) = dist(x,y) * sin(angle(x,y,z))`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `y:real^N` THEN REPEAT GEN_TAC THEN SIMP_TAC[SETDIST_CLOSEST_POINT; CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN ABBREV_TAC `y = closest_point (affine hull {vec 0, z}) (x:real^N)` THEN MP_TAC(ISPECL [`vec 0:real^N`; `y:real^N`; `x:real^N`] SIN_OPPOSITE_HYPOTENUSE) THEN MP_TAC(ISPECL [`affine hull {vec 0:real^N, z}`; `x:real^N`; `vec 0:real^N`] CLOSEST_POINT_AFFINE_ORTHOGONAL) THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT; AFFINE_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[DIST_SYM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ANGLE_SYM] THEN MP_TAC(ISPECL [`affine hull {vec 0:real^N, z}`; `x:real^N`] CLOSEST_POINT_IN_SET) THEN ASM_SIMP_TAC[CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN SIMP_TAC[AFFINE_HULL_2; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN MAP_EVERY X_GEN_TAC [`b:real`; `a:real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`affine hull {vec 0:real^N, z}`; `x:real^N`; `z:real^N`] CLOSEST_POINT_AFFINE_ORTHOGONAL) THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT; AFFINE_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN REWRITE_TAC[angle; VECTOR_SUB_RZERO; SIN_VECTOR_ANGLE_LMUL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN SIMP_TAC[ORTHOGONAL_VECTOR_ANGLE; SIN_PI2]);; (* ------------------------------------------------------------------------- *) (* A standard formula for the area of a triangle. *) (* ------------------------------------------------------------------------- *) let AREA_TRIANGLE_SIN = prove (`!a b c:real^2. measure(convex hull {a,b,c}) = (dist(a,b) * dist(a,c) * sin(angle(b,a,c))) / &2`, GEOM_ORIGIN_TAC `a:real^2` THEN REWRITE_TAC[MEASURE_TRIANGLE; angle] THEN REWRITE_TAC[VECTOR_SUB_RZERO; VEC_COMPONENT; REAL_SUB_RZERO; DIST_0] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs x = abs y ==> abs x / &2 = y / &2`) THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; SIN_VECTOR_ANGLE_POS] THEN REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN ASM_CASES_TAC `b:real^2 = vec 0` THENL [ASM_REWRITE_TAC[VEC_COMPONENT; NORM_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `c:real^2 = vec 0` THENL [ASM_REWRITE_TAC[VEC_COMPONENT; NORM_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_POW_MUL; SIN_SQUARED_VECTOR_ANGLE] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD `~(b = &0) /\ ~(c = &0) ==> b pow 2 * c pow 2 * (&1 - (d / (b * c)) pow 2) = b pow 2 * c pow 2 - d pow 2`] THEN REWRITE_TAC[NORM_POW_2; DOT_2] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Angles satisfy the triangle law and hence vector_angle defines a metric. *) (* ------------------------------------------------------------------------- *) let ANGLE_TRIANGLE_LAW = prove (`!p u v w:real^N. angle(u,p,w) <= angle(u,p,v) + angle(v,p,w)`, let lemma0 = prove (`x1 * x1 + y1 * y1 + z1 * z1 = &1 /\ x2 * x2 + y2 * y2 + z2 * z2 = &1 ==> (x2 * x1 - (x2 * x1 + y2 * y1 + z2 * z1)) pow 2 <= (&1 - x2 pow 2) * (&1 - x1 pow 2)`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(x2 * x1 - (x2 * x1 + y2 * y1 + z2 * z1)) pow 2 <= (&1 - x2 pow 2) * (&1 - x1 pow 2) <=> &0 <= --(y1 pow 2 + z1 pow 2) * ((x2 * x2 + y2 * y2 + z2 * z2) - &1) + (x2 pow 2 - &1) * ((x1 * x1 + y1 * y1 + z1 * z1) - &1) + (y2 * z1 - y1 * z2) pow 2`] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_LID] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]) in let lemma1 = prove (`!p u v w:real^3. norm(u - p) = &1 /\ norm(v - p) = &1 /\ norm(w - p) = &1 ==> angle(u,p,w) <= angle(u,p,v) + angle(v,p,w)`, GEOM_ORIGIN_TAC `p:real^3` THEN REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN GEOM_BASIS_MULTIPLE_TAC 1 `v:real^3` THEN X_GEN_TAC `vb:real` THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN SIMP_TAC[REAL_ARITH `&0 <= vb ==> (abs(vb) * &1 = &1 <=> vb = &1)`] THEN DISCH_THEN(K ALL_TAC) THEN ASM_CASES_TAC `vb = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN POP_ASSUM(K ALL_TAC) THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `~(basis 1:real^3 = vec 0)` ASSUME_TAC THENL [ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN MAP_EVERY ASM_CASES_TAC [`u:real^3 = vec 0`; `w:real^3 = vec 0`] THEN ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi /\ &0 <= z /\ z <= pi /\ (&0 <= y + z /\ y + z <= pi ==> x <= y + z) ==> x <= y + z`) THEN REWRITE_TAC[VECTOR_ANGLE_RANGE] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) COS_MONO_LE_EQ o snd) THEN ASM_REWRITE_TAC[VECTOR_ANGLE_RANGE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[COS_ADD; COS_VECTOR_ANGLE; VECTOR_SUB_RZERO] THEN REWRITE_TAC[REAL_MUL_LID; REAL_DIV_1] THEN MATCH_MP_TAC(REAL_ARITH `abs(x - z) <= abs(y) /\ &0 <= y ==> x - y <= z`) THEN ASM_SIMP_TAC[SIN_VECTOR_ANGLE_POS; REAL_LE_MUL; REAL_LE_SQUARE_ABS] THEN ASM_REWRITE_TAC[REAL_POW_MUL; SIN_SQUARED_VECTOR_ANGLE] THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LID; REAL_DIV_1] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NORM_EQ_1])) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`u:real^3`; `w:real^3`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[FORALL_VECTOR_3] THEN SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; NORM_BASIS] THEN REWRITE_TAC[REAL_MUL_LID; REAL_DIV_1] THEN REWRITE_TAC[DOT_3; VECTOR_3] THEN SIMP_TAC[lemma0]) in let lemma2 = prove (`!p u v w:real^3. angle(u,p,w) <= angle(u,p,v) + angle(v,p,w)`, GEOM_ORIGIN_TAC `p:real^3` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^3 = vec 0` THENL [MATCH_MP_TAC(REAL_ARITH `x = pi / &2 /\ y = pi / &2 /\ &0 <= z ==> x <= y + z`) THEN REWRITE_TAC[angle; VECTOR_ANGLE_RANGE] THEN ASM_REWRITE_TAC[vector_angle; VECTOR_SUB_RZERO]; ALL_TAC] THEN ASM_CASES_TAC `v:real^3 = vec 0` THENL [MATCH_MP_TAC(REAL_ARITH `x <= pi /\ y = pi / &2 /\ z = pi / &2 ==> x <= y + z`) THEN REWRITE_TAC[angle; VECTOR_ANGLE_RANGE] THEN ASM_REWRITE_TAC[vector_angle; VECTOR_SUB_RZERO]; ALL_TAC] THEN ASM_CASES_TAC `w:real^3 = vec 0` THENL [MATCH_MP_TAC(REAL_ARITH `x = pi / &2 /\ &0 <= y /\ z = pi / &2 ==> x <= y + z`) THEN REWRITE_TAC[angle; VECTOR_ANGLE_RANGE] THEN ASM_REWRITE_TAC[vector_angle; VECTOR_SUB_RZERO]; ALL_TAC] THEN MP_TAC(ISPECL [`vec 0:real^3`; `inv(norm u) % u:real^3`; `inv(norm v) % v:real^3`; `inv(norm w) % w:real^3`] lemma1) THEN ASM_SIMP_TAC[angle; VECTOR_SUB_RZERO; NORM_MUL] THEN ASM_SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0] THEN ASM_REWRITE_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN ASM_REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0; REAL_LE_INV_EQ; NORM_POS_LE]) in DISJ_CASES_TAC(ARITH_RULE `dimindex(:3) <= dimindex(:N) \/ dimindex(:N) <= dimindex(:3)`) THENL [ALL_TAC; FIRST_ASSUM(ACCEPT_TAC o C GEOM_DROP_DIMENSION_RULE lemma2)] THEN GEOM_ORIGIN_TAC `p:real^N` THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `subspace(span{u:real^N,v,w}) /\ dim(span{u,v,w}) <= dimindex(:3) /\ dimindex(:3) <= dimindex(:N)` MP_TAC THENL [ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD{u:real^N,v,w}` THEN SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_EMPTY] THEN SIMP_TAC[DIMINDEX_3; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP ISOMETRY_UNIV_SUPERSET_SUBSPACE) THEN DISCH_THEN(X_CHOOSE_THEN `f:real^3->real^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP LINEAR_0) THEN SUBGOAL_THEN `{u:real^N,v,w} SUBSET IMAGE f (:real^3)` MP_TAC THENL [ASM_MESON_TAC[SUBSET; SPAN_INC]; ALL_TAC] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(end_itlist CONJ (mapfilter (ISPEC `f:real^3->real^N`) (!invariant_under_linear))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[lemma2]);; let VECTOR_ANGLE_TRIANGLE_LAW = prove (`!u v w:real^N. vector_angle u w <= vector_angle u v + vector_angle v w`, REWRITE_TAC[VECTOR_ANGLE_ANGLE; ANGLE_TRIANGLE_LAW]);; hol-light/Multivariate/integration.ml000066400000000000000000046776361303454263000203250ustar00rootroot00000000000000(* ========================================================================= *) (* Kurzweil-Henstock gauge integration in many dimensions. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "Library/products.ml";; needs "Library/floor.ml";; needs "Multivariate/derivatives.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Some useful lemmas about intervals. *) (* ------------------------------------------------------------------------- *) let INTERIOR_SUBSET_UNION_INTERVALS = prove (`!s i j. (?a b:real^N. i = interval[a,b]) /\ (?c d. j = interval[c,d]) /\ ~(interior j = {}) /\ i SUBSET j UNION s /\ interior(i) INTER interior(j) = {} ==> interior i SUBSET interior s`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o check (is_var o lhs o concl))) THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN REWRITE_TAC[OPEN_INTERIOR] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERIOR_CLOSED_INTERVAL]) THEN SUBGOAL_THEN `interval(a:real^N,b) INTER interval[c,d] = {}` ASSUME_TAC THENL [ASM_SIMP_TAC[INTER_INTERVAL_MIXED_EQ_EMPTY]; MP_TAC(ISPECL [`a:real^N`; `b:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]]);; let INTER_INTERIOR_UNIONS_INTERVALS = prove (`!s f. FINITE f /\ open s /\ (!t. t IN f ==> ?a b:real^N. t = interval[a,b]) /\ (!t. t IN f ==> s INTER (interior t) = {}) ==> s INTER interior(UNIONS f) = {}`, ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> ~e ==> ~d`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM MEMBER_NOT_EMPTY] THEN SIMP_TAC[OPEN_CONTAINS_BALL_EQ; OPEN_INTER; OPEN_INTERIOR] THEN SIMP_TAC[INTERIOR_MAXIMAL_EQ; OPEN_BALL; SUBSET_INTER] THEN REWRITE_TAC[GSYM SUBSET_INTER] THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_0; INTER_EMPTY; SUBSET_EMPTY] THEN MESON_TAC[CENTRE_IN_BALL; NOT_IN_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:real^N->bool`; `f:(real^N->bool)->bool`] THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_INSERT; IN_INSERT] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[RIGHT_OR_DISTRIB; FORALL_AND_THM; EXISTS_OR_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `i:real^N->bool`) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real^N` SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(r ==> s \/ p) ==> (p ==> q) ==> r ==> s \/ q`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN interval[a,b]` THENL [ALL_TAC; SUBGOAL_THEN `?d. &0 < d /\ ball(x,d) SUBSET ((:real^N) DIFF interval[a,b])` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[closed; OPEN_CONTAINS_BALL; CLOSED_INTERVAL; IN_DIFF; IN_UNIV]; ALL_TAC] THEN DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `min d e`] THEN ASM_REWRITE_TAC[REAL_LT_MIN; SUBSET] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN SIMP_TAC[IN_BALL; REAL_LT_MIN; IN_DIFF; IN_INTER; IN_UNIV; IN_UNION] THEN ASM_MESON_TAC[]] THEN ASM_CASES_TAC `(x:real^N) IN interval(a,b)` THENL [DISJ1_TAC THEN SUBGOAL_THEN `?d. &0 < d /\ ball(x:real^N,d) SUBSET interval(a,b)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_CONTAINS_BALL; OPEN_INTERVAL]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `min d e`] THEN ASM_REWRITE_TAC[REAL_LT_MIN; SUBSET] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN SIMP_TAC[IN_BALL; REAL_LT_MIN; IN_DIFF; IN_INTER; IN_UNIV; IN_UNION] THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_INTERVAL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC[REAL_LT_LE] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[GSYM REAL_LT_LE; DE_MORGAN_THM] THEN STRIP_TAC THEN DISJ2_TAC THENL [EXISTS_TAC `x + --e / &2 % basis k :real^N`; EXISTS_TAC `x + e / &2 % basis k :real^N`] THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b1 SUBSET k INTER (i UNION s) ==> b2 SUBSET b1 /\ b2 INTER i = {} ==> b2 SUBSET k INTER s`)) THEN (CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_BALL] THEN GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(d) = e / &2 ==> dist(x + d,y) < e / &2 ==> dist(x,y) < e`) THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_BALL; dist] THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN W(MP_TAC o C ISPEC COMPONENT_LE_NORM o rand o lhand o lhand o snd) THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x <= y /\ y < e ==> x < e`)) THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o SPEC `k:num`) THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* This lemma about iterations comes up in a few places. *) (* ------------------------------------------------------------------------- *) let ITERATE_NONZERO_IMAGE_LEMMA = prove (`!op s f g a. monoidal op /\ FINITE s /\ g(a) = neutral op /\ (!x y. x IN s /\ y IN s /\ f x = f y /\ ~(x = y) ==> g(f x) = neutral op) ==> iterate op {f x | x | x IN s /\ ~(f x = a)} g = iterate op s (g o f)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ITERATE_SUPPORT] THEN REWRITE_TAC[support] THEN ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = IMAGE f {x | x IN s /\ ~(f x = a)}`] THEN W(fun (asl,w) -> FIRST_ASSUM(fun th -> MP_TAC(PART_MATCH (rand o rand) (MATCH_MP ITERATE_IMAGE th) (rand w)))) THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM; o_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_SUPERSET) THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; o_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Bounds on intervals where they exist. *) (* ------------------------------------------------------------------------- *) let interval_upperbound = new_definition `(interval_upperbound:(real^M->bool)->real^M) s = lambda i. sup {a | ?x. x IN s /\ (x$i = a)}`;; let interval_lowerbound = new_definition `(interval_lowerbound:(real^M->bool)->real^M) s = lambda i. inf {a | ?x. x IN s /\ (x$i = a)}`;; let INTERVAL_UPPERBOUND = prove (`!a b:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) ==> interval_upperbound(interval[a,b]) = b`, SIMP_TAC[interval_upperbound; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_REFL]);; let INTERVAL_LOWERBOUND = prove (`!a b:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) ==> interval_lowerbound(interval[a,b]) = a`, SIMP_TAC[interval_lowerbound; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_REFL]);; let INTERVAL_UPPERBOUND_1 = prove (`!a b. drop a <= drop b ==> interval_upperbound(interval[a,b]) = b`, SIMP_TAC[INTERVAL_UPPERBOUND; DIMINDEX_1; FORALL_1; drop]);; let INTERVAL_LOWERBOUND_1 = prove (`!a b. drop a <= drop b ==> interval_lowerbound(interval[a,b]) = a`, SIMP_TAC[INTERVAL_LOWERBOUND; DIMINDEX_1; FORALL_1; drop]);; let INTERVAL_LOWERBOUND_NONEMPTY = prove (`!a b:real^N. ~(interval[a,b] = {}) ==> interval_lowerbound(interval[a,b]) = a`, SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_NE_EMPTY]);; let INTERVAL_UPPERBOUND_NONEMPTY = prove (`!a b:real^N. ~(interval[a,b] = {}) ==> interval_upperbound(interval[a,b]) = b`, SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_NE_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Content (length, area, volume...) of an interval. *) (* ------------------------------------------------------------------------- *) let content = new_definition `content(s:real^M->bool) = if s = {} then &0 else product(1..dimindex(:M)) (\i. (interval_upperbound s)$i - (interval_lowerbound s)$i)`;; let CONTENT_CLOSED_INTERVAL = prove (`!a b:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) ==> content(interval[a,b]) = product(1..dimindex(:N)) (\i. b$i - a$i)`, SIMP_TAC[content; INTERVAL_UPPERBOUND; INTERVAL_EQ_EMPTY; INTERVAL_LOWERBOUND] THEN MESON_TAC[REAL_NOT_LT]);; let CONTENT_1 = prove (`!a b. drop a <= drop b ==> content(interval[a,b]) = drop b - drop a`, SIMP_TAC[CONTENT_CLOSED_INTERVAL; FORALL_1; drop; DIMINDEX_1] THEN REWRITE_TAC[PRODUCT_SING_NUMSEG]);; let CONTENT_UNIT = prove (`content(interval[vec 0:real^N,vec 1]) = &1`, REWRITE_TAC[content] THEN COND_CASES_TAC THENL [POP_ASSUM MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_POS]; MATCH_MP_TAC PRODUCT_EQ_1 THEN SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; VEC_COMPONENT; REAL_POS; IN_NUMSEG; REAL_SUB_RZERO]]);; let CONTENT_UNIT_1 = prove (`content(interval[vec 0:real^1,vec 1]) = &1`, MATCH_ACCEPT_TAC CONTENT_UNIT);; let CONTENT_POS_LE = prove (`!a b:real^N. &0 <= content(interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC PRODUCT_POS_LE_NUMSEG THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_SUB_LE]);; let CONTENT_POS_LT = prove (`!a b:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i) ==> &0 < content(interval[a,b])`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; REAL_LT_IMP_LE] THEN MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_SUB_LT; REAL_LT_IMP_LE]);; let CONTENT_POS_LT_1 = prove (`!a b. drop a < drop b ==> &0 < content(interval[a,b])`, SIMP_TAC[CONTENT_POS_LT; FORALL_1; DIMINDEX_1; GSYM drop]);; let CONTENT_EQ_0_GEN = prove (`!s:real^N->bool. bounded s ==> (content s = &0 <=> ?i a. 1 <= i /\ i <= dimindex(:N) /\ !x. x IN s ==> x$i = a)`, REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_SUB_0] THEN DISCH_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[interval_upperbound; interval_lowerbound; LAMBDA_BETA] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_SUP_EQ_INF o lhs o snd) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; DISCH_THEN SUBST1_TAC THEN ASM SET_TAC[]]);; let CONTENT_EQ_0 = prove (`!a b:real^N. content(interval[a,b]) = &0 <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i <= a$i`, REPEAT GEN_TAC THEN REWRITE_TAC[content; INTERVAL_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_SUB_0] THEN AP_TERM_TAC THEN ABS_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN SIMP_TAC[REAL_NOT_LT; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN MESON_TAC[REAL_NOT_LE; REAL_LE_LT]);; let CONTENT_0_SUBSET_GEN = prove (`!s t:real^N->bool. s SUBSET t /\ bounded t /\ content t = &0 ==> content s = &0`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `bounded(s:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[CONTENT_EQ_0_GEN] THEN ASM SET_TAC[]);; let CONTENT_0_SUBSET = prove (`!s a b:real^N. s SUBSET interval[a,b] /\ content(interval[a,b]) = &0 ==> content s = &0`, MESON_TAC[CONTENT_0_SUBSET_GEN; BOUNDED_INTERVAL]);; let CONTENT_CLOSED_INTERVAL_CASES = prove (`!a b:real^N. content(interval[a,b]) = if !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i then product(1..dimindex(:N)) (\i. b$i - a$i) else &0`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CONTENT_EQ_0; CONTENT_CLOSED_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TOTAL]);; let CONTENT_EQ_0_INTERIOR = prove (`!a b:real^N. content(interval[a,b]) = &0 <=> interior(interval[a,b]) = {}`, REWRITE_TAC[CONTENT_EQ_0; INTERIOR_CLOSED_INTERVAL; INTERVAL_EQ_EMPTY]);; let CONTENT_EQ_0_1 = prove (`!a b:real^1. content(interval[a,b]) = &0 <=> drop b <= drop a`, REWRITE_TAC[CONTENT_EQ_0; drop; DIMINDEX_1; CONJ_ASSOC; LE_ANTISYM] THEN MESON_TAC[]);; let CONTENT_POS_LT_EQ = prove (`!a b:real^N. &0 < content(interval[a,b]) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONTENT_POS_LT] THEN REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[CONTENT_POS_LE; CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]);; let CONTENT_EMPTY = prove (`content {} = &0`, REWRITE_TAC[content]);; let CONTENT_SUBSET = prove (`!a b c d:real^N. interval[a,b] SUBSET interval[c,d] ==> content(interval[a,b]) <= content(interval[c,d])`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [content] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTENT_POS_LE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `a:real^N` th) THEN MP_TAC(SPEC `b:real^N` th)) THEN ASM_SIMP_TAC[REAL_LE_REFL; content] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `(if b then c else d) = (if ~b then d else c)`] THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS]] THEN MATCH_MP_TAC PRODUCT_LE_NUMSEG THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let CONTENT_LT_NZ = prove (`!a b. &0 < content(interval[a,b]) <=> ~(content(interval[a,b]) = &0)`, REWRITE_TAC[CONTENT_POS_LT_EQ; CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]);; let INTERVAL_BOUNDS_NULL_1 = prove (`!a b:real^1. content(interval[a,b]) = &0 ==> interval_upperbound(interval[a,b]) = interval_lowerbound(interval[a,b])`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL [ASM_REWRITE_TAC[interval_upperbound; interval_lowerbound] THEN REWRITE_TAC[sup; inf; NOT_IN_EMPTY; EMPTY_GSPEC] THEN DISCH_TAC THEN REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[REAL_ARITH `~(x <= x - &1) /\ ~(x + &1 <= x)`]; RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN REWRITE_TAC[CONTENT_EQ_0_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC]);; let INTERVAL_BOUNDS_EMPTY_1 = prove (`interval_upperbound({}:real^1->bool) = interval_lowerbound({}:real^1->bool)`, MESON_TAC[INTERVAL_BOUNDS_NULL_1; CONTENT_EMPTY; EMPTY_AS_INTERVAL]);; let CONTENT_PASTECART = prove (`!a b:real^M c d:real^N. content(interval[pastecart a c,pastecart b d]) = content(interval[a,b]) * content(interval[c,d])`, REPEAT GEN_TAC THEN SIMP_TAC[CONTENT_CLOSED_INTERVAL_CASES; LAMBDA_BETA] THEN MATCH_MP_TAC(MESON[REAL_MUL_LZERO; REAL_MUL_RZERO] `(p <=> p1 /\ p2) /\ z = x * y ==> (if p then z else &0) = (if p1 then x else &0) * (if p2 then y else &0)`) THEN CONJ_TAC THENL [EQ_TAC THEN DISCH_TAC THEN TRY CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ADD_SUB]] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[DIMINDEX_FINITE_SUM]) THEN ASM_CASES_TAC `i <= dimindex(:M)` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num` o CONJUNCT1); FIRST_X_ASSUM(MP_TAC o SPEC `i - dimindex(:M)` o CONJUNCT2)] THEN ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ARITH_RULE `i:num <= m ==> i <= m + n`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; SIMP_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `1 <= n + 1`; PRODUCT_ADD_SPLIT] THEN BINOP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[PRODUCT_OFFSET]] THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ADD_SUB; ARITH_RULE `i:num <= m ==> i <= m + n`; ARITH_RULE `i:num <= n ==> i + m <= m + n`] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The notion of a gauge --- simply an open set containing the point. *) (* ------------------------------------------------------------------------- *) let gauge = new_definition `gauge d <=> !x. x IN d(x) /\ open(d(x))`;; let GAUGE_BALL_DEPENDENT = prove (`!e. (!x. &0 < e(x)) ==> gauge(\x. ball(x,e(x)))`, SIMP_TAC[gauge; OPEN_BALL; IN_BALL; DIST_REFL]);; let GAUGE_BALL = prove (`!e. &0 < e ==> gauge (\x. ball(x,e))`, SIMP_TAC[gauge; OPEN_BALL; IN_BALL; DIST_REFL]);; let GAUGE_TRIVIAL = prove (`gauge (\x. ball(x,&1))`, SIMP_TAC[GAUGE_BALL; REAL_LT_01]);; let GAUGE_INTER = prove (`!d1 d2. gauge d1 /\ gauge d2 ==> gauge (\x. (d1 x) INTER (d2 x))`, SIMP_TAC[gauge; IN_INTER; OPEN_INTER]);; let GAUGE_INTERS = prove (`!s. FINITE s /\ (!d. d IN s ==> gauge (f d)) ==> gauge(\x. INTERS {f d x | d IN s})`, REWRITE_TAC[gauge; IN_INTERS] THEN REWRITE_TAC[SET_RULE `{f d x | d IN s} = IMAGE (\d. f d x) s`] THEN SIMP_TAC[FORALL_IN_IMAGE; OPEN_INTERS; FINITE_IMAGE]);; let GAUGE_EXISTENCE_LEMMA = prove (`(!x. ?d. p x ==> &0 < d /\ q d x) <=> (!x. ?d. &0 < d /\ (p x ==> q d x))`, MESON_TAC[REAL_LT_01]);; (* ------------------------------------------------------------------------- *) (* Divisions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("division_of",(12,"right"));; let division_of = new_definition `s division_of i <=> FINITE s /\ (!k. k IN s ==> k SUBSET i /\ ~(k = {}) /\ ?a b. k = interval[a,b]) /\ (!k1 k2. k1 IN s /\ k2 IN s /\ ~(k1 = k2) ==> interior(k1) INTER interior(k2) = {}) /\ (UNIONS s = i)`;; let DIVISION_OF = prove (`s division_of i <=> FINITE s /\ (!k. k IN s ==> ~(k = {}) /\ ?a b. k = interval[a,b]) /\ (!k1 k2. k1 IN s /\ k2 IN s /\ ~(k1 = k2) ==> interior(k1) INTER interior(k2) = {}) /\ UNIONS s = i`, REWRITE_TAC[division_of] THEN SET_TAC[]);; let DIVISION_OF_FINITE = prove (`!s i. s division_of i ==> FINITE s`, MESON_TAC[division_of]);; let DIVISION_OF_SELF = prove (`!a b. ~(interval[a,b] = {}) ==> {interval[a,b]} division_of interval[a,b]`, REWRITE_TAC[division_of; FINITE_INSERT; FINITE_RULES; IN_SING; UNIONS_1] THEN MESON_TAC[SUBSET_REFL]);; let DIVISION_OF_TRIVIAL = prove (`!s. s division_of {} <=> s = {}`, REWRITE_TAC[division_of; SUBSET_EMPTY; CONJ_ASSOC] THEN REWRITE_TAC[TAUT `~(p /\ ~p)`; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[AC CONJ_ACI `((a /\ b) /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FINITE_RULES; UNIONS_0; NOT_IN_EMPTY]);; let EMPTY_DIVISION_OF = prove (`!s. {} division_of s <=> s = {}`, REWRITE_TAC[division_of; UNIONS_0; FINITE_EMPTY; NOT_IN_EMPTY] THEN MESON_TAC[]);; let DIVISION_OF_SING = prove (`!s a. s division_of interval[a,a] <=> s = {interval[a,a]}`, let lemma = prove (`s SUBSET {{a}} /\ p /\ UNIONS s = {a} <=> s = {{a}} /\ p`, EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SET_RULE `UNIONS {a} = a`] THEN ASM SET_TAC[]) in REWRITE_TAC[division_of; INTERVAL_SING] THEN REWRITE_TAC[SET_RULE `k SUBSET {a} /\ ~(k = {}) /\ p <=> k = {a} /\ p`] THEN REWRITE_TAC[GSYM INTERVAL_SING] THEN REWRITE_TAC[MESON[] `(k = interval[a,b] /\ ?c d. k = interval[c,d]) <=> (k = interval[a,b])`] THEN REWRITE_TAC[SET_RULE `(!k. k IN s ==> k = a) <=> s SUBSET {a}`] THEN REWRITE_TAC[INTERVAL_SING; lemma] THEN MESON_TAC[FINITE_RULES; IN_SING]);; let ELEMENTARY_EMPTY = prove (`?p. p division_of {}`, REWRITE_TAC[DIVISION_OF_TRIVIAL; EXISTS_REFL]);; let ELEMENTARY_INTERVAL = prove (`!a b. ?p. p division_of interval[a,b]`, MESON_TAC[DIVISION_OF_TRIVIAL; DIVISION_OF_SELF]);; let DIVISION_CONTAINS = prove (`!s i. s division_of i ==> !x. x IN i ==> ?k. x IN k /\ k IN s`, REWRITE_TAC[division_of; EXTENSION; IN_UNIONS] THEN MESON_TAC[]);; let FORALL_IN_DIVISION = prove (`!P d i. d division_of i ==> ((!x. x IN d ==> P x) <=> (!a b. interval[a,b] IN d ==> P(interval[a,b])))`, REWRITE_TAC[division_of] THEN MESON_TAC[]);; let FORALL_IN_DIVISION_NONEMPTY = prove (`!P d i. d division_of i ==> ((!x. x IN d ==> P x) <=> (!a b. interval [a,b] IN d /\ ~(interval[a,b] = {}) ==> P (interval [a,b])))`, REWRITE_TAC[division_of] THEN MESON_TAC[]);; let DIVISION_OF_SUBSET = prove (`!p q:(real^N->bool)->bool. p division_of (UNIONS p) /\ q SUBSET p ==> q division_of (UNIONS q)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[division_of] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL [ASM_MESON_TAC[FINITE_SUBSET]; ASM SET_TAC[]; ASM SET_TAC[]]);; let DIVISION_OF_UNION_SELF = prove (`!p s. p division_of s ==> p division_of (UNIONS p)`, REWRITE_TAC[division_of] THEN MESON_TAC[]);; let DIVISION_OF_CONTENT_0 = prove (`!a b d. content(interval[a,b]) = &0 /\ d division_of interval[a,b] ==> !k. k IN d ==> content k = &0`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; CONTENT_POS_LE] THEN ASM_MESON_TAC[CONTENT_SUBSET; division_of]);; let DIVISION_INTER = prove (`!s1 s2:real^N->bool p1 p2. p1 division_of s1 /\ p2 division_of s2 ==> {k1 INTER k2 | k1 IN p1 /\ k2 IN p2 /\ ~(k1 INTER k2 = {})} division_of (s1 INTER s2)`, let lemma = prove (`{k1 INTER k2 | k1 IN p1 /\ k2 IN p2 /\ ~(k1 INTER k2 = {})} = {s | s IN IMAGE (\(k1,k2). k1 INTER k2) (p1 CROSS p2) /\ ~(s = {})}`, REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; EXISTS_PAIR_THM; IN_CROSS] THEN MESON_TAC[]) in REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_OF] THEN STRIP_TAC THEN ASM_SIMP_TAC[lemma; FINITE_RESTRICT; FINITE_CROSS; FINITE_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_CROSS] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[INTER_INTERVAL]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `(interior x1 INTER interior x2 = {} \/ interior y1 INTER interior y2 = {}) /\ interior(x1 INTER y1) SUBSET interior(x1) /\ interior(x1 INTER y1) SUBSET interior(y1) /\ interior(x2 INTER y2) SUBSET interior(x2) /\ interior(x2 INTER y2) SUBSET interior(y2) ==> interior(x1 INTER y1) INTER interior(x2 INTER y2) = {}`) THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]; REWRITE_TAC[SET_RULE `UNIONS {x | x IN s /\ ~(x = {})} = UNIONS s`] THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS; IN_INTER] THEN MESON_TAC[IN_INTER]]);; let DIVISION_INTER_1 = prove (`!d i a b:real^N. d division_of i /\ interval[a,b] SUBSET i ==> { interval[a,b] INTER k | k | k IN d /\ ~(interval[a,b] INTER k = {}) } division_of interval[a,b]`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN ASM_REWRITE_TAC[INTER_EMPTY; SET_RULE `{{} | F} = {}`; DIVISION_OF_TRIVIAL] THEN MP_TAC(ISPECL [`interval[a:real^N,b]`; `i:real^N->bool`; `{interval[a:real^N,b]}`; `d:(real^N->bool)->bool`] DIVISION_INTER) THEN ASM_SIMP_TAC[DIVISION_OF_SELF; SET_RULE `s SUBSET t ==> s INTER t = s`] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; let ELEMENTARY_INTER = prove (`!s t. (?p. p division_of s) /\ (?p. p division_of t) ==> ?p. p division_of (s INTER t)`, MESON_TAC[DIVISION_INTER]);; let ELEMENTARY_INTERS = prove (`!f:(real^N->bool)->bool. FINITE f /\ ~(f = {}) /\ (!s. s IN f ==> ?p. p division_of s) ==> ?p. p division_of (INTERS f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INTERS_INSERT] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `s:(real^N->bool)->bool`] THEN ASM_CASES_TAC `s:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[INTERS_0; INTER_UNIV; IN_SING] THEN MESON_TAC[]; REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ELEMENTARY_INTER THEN ASM_MESON_TAC[]]);; let DIVISION_DISJOINT_UNION = prove (`!s1 s2:real^N->bool p1 p2. p1 division_of s1 /\ p2 division_of s2 /\ interior s1 INTER interior s2 = {} ==> (p1 UNION p2) division_of (s1 UNION s2)`, REPEAT GEN_TAC THEN REWRITE_TAC[division_of] THEN STRIP_TAC THEN ASM_REWRITE_TAC[FINITE_UNION; IN_UNION; EXISTS_OR_THM; SET_RULE `UNIONS {x | P x \/ Q x} = UNIONS {x | P x} UNION UNIONS {x | Q x}`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ALL_TAC; ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `!s' t'. s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {} ==> s INTER t = {}`) THENL [MAP_EVERY EXISTS_TAC [`interior s1:real^N->bool`; `interior s2:real^N->bool`]; MAP_EVERY EXISTS_TAC [`interior s2:real^N->bool`; `interior s1:real^N->bool`]] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC SUBSET_INTERIOR) THEN ASM SET_TAC[]);; let PARTIAL_DIVISION_EXTEND_1 = prove (`!a b c d:real^N. interval[c,d] SUBSET interval[a,b] /\ ~(interval[c,d] = {}) ==> ?p. p division_of interval[a,b] /\ interval[c,d] IN p`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY])) THEN EXISTS_TAC `{interval [(lambda i. if i < l then (c:real^N)$i else (a:real^N)$i):real^N, (lambda i. if i < l then d$i else if i = l then c$l else b$i)] | l IN 1..(dimindex(:N)+1)} UNION {interval [(lambda i. if i < l then c$i else if i = l then d$l else a$i), (lambda i. if i < l then (d:real^N)$i else (b:real^N)$i):real^N] | l IN 1..(dimindex(:N)+1)}` THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `dimindex(:N)+1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= n + 1`] THEN AP_TERM_TAC THEN SIMP_TAC[CONS_11; PAIR_EQ; CART_EQ; LAMBDA_BETA] THEN SIMP_TAC[ARITH_RULE `i <= n ==> i < n + 1`]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN ASM_REWRITE_TAC[DIVISION_OF] THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[FINITE_UNION; FINITE_IMAGE; FINITE_NUMSEG]; REWRITE_TAC[IN_UNION; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_AND_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[IN_NUMSEG; INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN CONJ_TAC THEN X_GEN_TAC `l:num` THEN DISCH_TAC THEN (CONJ_TAC THENL [ALL_TAC; MESON_TAC[]]) THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN ASM_MESON_TAC[REAL_LE_TRANS]; REWRITE_TAC[IN_UNION; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[SET_RULE `(!y. y IN {f x | x IN s} \/ y IN {g x | x IN s} ==> P y) <=> (!x. x IN s ==> P(f x) /\ P(g x))`] THEN REWRITE_TAC[AND_FORALL_THM; IN_NUMSEG] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN REWRITE_TAC[INTER_ACI; CONJ_ACI] THEN MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`l:num`; `m:num`] THEN DISCH_TAC THEN STRIP_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `(~p ==> q) <=> (~q ==> p)`] THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. ~(x IN s /\ x IN t)`] THEN ASM_SIMP_TAC[IN_NUMSEG; INTERVAL_NE_EMPTY; LAMBDA_BETA; IN_INTERVAL; INTERIOR_CLOSED_INTERVAL] THEN REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN REWRITE_TAC[NOT_FORALL_THM] THEN REPEAT CONJ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` (LABEL_TAC "*")) THEN AP_TERM_TAC THEN SIMP_TAC[CONS_11; PAIR_EQ; CART_EQ; LAMBDA_BETA] THENL (let tac1 = UNDISCH_TAC `l:num <= m` THEN GEN_REWRITE_TAC LAND_CONV [LE_LT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `l:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[LT_REFL] THEN REAL_ARITH_TAC and tac2 = UNDISCH_TAC `l:num <= m` THEN GEN_REWRITE_TAC LAND_CONV [LE_LT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [REMOVE_THEN "*" (MP_TAC o SPEC `l:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[LT_REFL] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num = l` THEN ASM_REWRITE_TAC[LT_REFL] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `l:num`)) THEN ASM_REWRITE_TAC[LT_REFL] THEN REAL_ARITH_TAC in [tac1; tac2; tac2; tac1]); MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[IMP_CONJ; SUBSET; FORALL_IN_UNIONS; SIMPLE_IMAGE] THEN REWRITE_TAC[IN_UNIONS; IN_INSERT; IN_UNION; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM; FORALL_AND_THM; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN ASM_SIMP_TAC[IN_INTERVAL; IN_NUMSEG; LAMBDA_BETA] THEN REPEAT CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a IN s ==> (c DIFF a) SUBSET UNIONS s ==> c SUBSET UNIONS s`)) THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_INTERVAL] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[TAUT `a ==> ~(b /\ ~c) <=> a /\ b ==> c`] THEN DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_UNIONS; SIMPLE_IMAGE; EXISTS_IN_IMAGE; IN_UNION; EXISTS_OR_THM; RIGHT_OR_DISTRIB] THEN REWRITE_TAC[OR_EXISTS_THM] THEN EXISTS_TAC `l:num` THEN ASM_SIMP_TAC[IN_NUMSEG; IN_INTERVAL; LAMBDA_BETA; ARITH_RULE `x <= n ==> x <= n + 1`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[REAL_NOT_LE] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]);; let PARTIAL_DIVISION_EXTEND_INTERVAL = prove (`!p a b:real^N. p division_of (UNIONS p) /\ (UNIONS p) SUBSET interval[a,b] ==> ?q. p SUBSET q /\ q division_of interval[a,b]`, REPEAT GEN_TAC THEN ASM_CASES_TAC `p:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_SUBSET] THENL [MESON_TAC[ELEMENTARY_INTERVAL]; STRIP_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN SUBGOAL_THEN `!k:real^N->bool. k IN p ==> ?q. q division_of interval[a,b] /\ k IN q` MP_TAC THENL [X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `k:real^N->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC PARTIAL_DIVISION_EXTEND_1 THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `q:(real^N->bool)->(real^N->bool)->bool`) THEN SUBGOAL_THEN `?d. d division_of INTERS {UNIONS(q i DELETE i) | (i:real^N->bool) IN p}` MP_TAC THENL [MATCH_MP_TAC ELEMENTARY_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `(q k) DELETE (k:real^N->bool)` THEN MATCH_MP_TAC DIVISION_OF_SUBSET THEN EXISTS_TAC `(q:(real^N->bool)->(real^N->bool)->bool) k` THEN REWRITE_TAC[DELETE_SUBSET] THEN ASM_MESON_TAC[division_of]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `d:(real^N->bool)->bool`) THEN EXISTS_TAC `(d UNION p):(real^N->bool)->bool` THEN REWRITE_TAC[SUBSET_UNION] THEN SUBGOAL_THEN `interval[a:real^N,b] = INTERS {UNIONS (q i DELETE i) | i IN p} UNION UNIONS p` SUBST1_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (!i. i IN s ==> f i UNION i = t) ==> t = INTERS (IMAGE f s) UNION (UNIONS s)`) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `UNIONS k = s /\ i IN k ==> UNIONS (k DELETE i) UNION i = s`) THEN ASM_MESON_TAC[division_of]; ALL_TAC] THEN MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `!s. u SUBSET s /\ s INTER t = {} ==> u INTER t = {}`) THEN EXISTS_TAC `interior(UNIONS(q k DELETE (k:real^N->bool)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC(SET_RULE `x IN s ==> INTERS s SUBSET x`) THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN REWRITE_TAC[OPEN_INTERIOR; FINITE_DELETE; IN_DELETE] THEN ASM_MESON_TAC[division_of]);; let ELEMENTARY_BOUNDED = prove (`!s. (?p. p division_of s) ==> bounded s`, REWRITE_TAC[division_of] THEN ASM_MESON_TAC[BOUNDED_UNIONS; BOUNDED_INTERVAL]);; let ELEMENTARY_SUBSET_INTERVAL = prove (`!s. (?p. p division_of s) ==> ?a b. s SUBSET interval[a,b]`, MESON_TAC[ELEMENTARY_BOUNDED; BOUNDED_SUBSET_CLOSED_INTERVAL]);; let DIVISION_UNION_INTERVALS_EXISTS = prove (`!a b c d:real^N. ~(interval[a,b] = {}) ==> ?p. (interval[a,b] INSERT p) division_of (interval[a,b] UNION interval[c,d])`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[c:real^N,d] = {}` THENL [ASM_REWRITE_TAC[UNION_EMPTY] THEN ASM_MESON_TAC[DIVISION_OF_SELF]; ALL_TAC] THEN ASM_CASES_TAC `interval[a:real^N,b] INTER interval[c,d] = {}` THENL [EXISTS_TAC `{interval[c:real^N,d]}` THEN ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_SIMP_TAC[DIVISION_OF_SELF] THEN MATCH_MP_TAC(SET_RULE `interior s SUBSET s /\ interior t SUBSET t /\ s INTER t = {} ==> interior s INTER interior t = {}`) THEN ASM_REWRITE_TAC[INTERIOR_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `?u v:real^N. interval[a,b] INTER interval[c,d] = interval[u,v]` STRIP_ASSUME_TAC THENL [MESON_TAC[INTER_INTERVAL]; ALL_TAC] THEN MP_TAC(ISPECL [`c:real^N`; `d:real^N`; `u:real^N`; `v:real^N`] PARTIAL_DIVISION_EXTEND_1) THEN ANTS_TAC THENL [ASM_MESON_TAC[INTER_SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `p DELETE interval[u:real^N,v]` THEN SUBGOAL_THEN `interval[a:real^N,b] UNION interval[c,d] = interval[a,b] UNION UNIONS(p DELETE interval[u,v])` SUBST1_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_SIMP_TAC[DIVISION_OF_SELF] THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET THEN EXISTS_TAC `p:(real^N->bool)->bool` THEN ASM_MESON_TAC[DIVISION_OF_UNION_SELF; DELETE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[GSYM INTERIOR_INTER] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `interior(interval[u:real^N,v] INTER UNIONS (p DELETE interval[u,v]))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `!cd. p SUBSET cd /\ uv = ab INTER cd ==> (ab INTER p = uv INTER p)`) THEN EXISTS_TAC `interval[c:real^N,d]` THEN ASM_REWRITE_TAC[UNIONS_SUBSET; IN_DELETE] THEN ASM_MESON_TAC[division_of]; REWRITE_TAC[INTERIOR_INTER] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN REWRITE_TAC[IN_DELETE; OPEN_INTERIOR; FINITE_DELETE] THEN ASM_MESON_TAC[division_of]]);; let DIVISION_OF_UNIONS = prove (`!f. FINITE f /\ (!p. p IN f ==> p division_of (UNIONS p)) /\ (!k1 k2. k1 IN UNIONS f /\ k2 IN UNIONS f /\ ~(k1 = k2) ==> interior k1 INTER interior k2 = {}) ==> (UNIONS f) division_of UNIONS(UNIONS f)`, REWRITE_TAC[division_of] THEN SIMP_TAC[FINITE_UNIONS] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o el 1 o CONJUNCTS) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN SET_TAC[]);; let ELEMENTARY_UNION_INTERVAL_STRONG = prove (`!p a b:real^N. p division_of (UNIONS p) ==> ?q. p SUBSET q /\ q division_of (interval[a,b] UNION UNIONS p)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `p:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[UNIONS_0; UNION_EMPTY; EMPTY_SUBSET] THEN MESON_TAC[ELEMENTARY_INTERVAL]; ALL_TAC] THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN ASM_REWRITE_TAC[UNION_EMPTY] THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN ASM_CASES_TAC `interior(interval[a:real^N,b]) = {}` THENL [EXISTS_TAC `interval[a:real^N,b] INSERT p` THEN REWRITE_TAC[division_of] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN SIMP_TAC[FINITE_INSERT; UNIONS_INSERT] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `interval[a:real^N,b] SUBSET UNIONS p` THENL [ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s UNION t = t`] THEN ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!k:real^N->bool. k IN p ==> ?q. ~(k IN q) /\ ~(q = {}) /\ (k INSERT q) division_of (interval[a,b] UNION k)` MP_TAC THENL [X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `k:real^N->bool` o CONJUNCT1 o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN DISCH_THEN SUBST_ALL_TAC THEN ONCE_REWRITE_TAC[UNION_COMM] THEN MP_TAC(ISPECL [`c:real^N`; `d:real^N`; `a:real^N`; `b:real^N`] DIVISION_UNION_INTERVALS_EXISTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `q:(real^N->bool)->bool`) THEN EXISTS_TAC `q DELETE interval[c:real^N,d]` THEN ASM_REWRITE_TAC[IN_DELETE; SET_RULE `x INSERT (q DELETE x) = x INSERT q`] THEN DISCH_TAC THEN UNDISCH_TAC `(interval[c:real^N,d] INSERT q) division_of (interval [c,d] UNION interval [a,b])` THEN ASM_SIMP_TAC[SET_RULE `s DELETE x = {} ==> x INSERT s = {x}`] THEN REWRITE_TAC[division_of; UNIONS_1] THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `q:(real^N->bool)->(real^N->bool)->bool`) THEN MP_TAC(ISPEC `IMAGE (UNIONS o (q:(real^N->bool)->(real^N->bool)->bool)) p` ELEMENTARY_INTERS) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `(q:(real^N->bool)->(real^N->bool)->bool) k` THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC DIVISION_OF_SUBSET THEN EXISTS_TAC `(k:real^N->bool) INSERT q k` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; SET_TAC[]]; DISCH_THEN(X_CHOOSE_TAC `r:(real^N->bool)->bool`)] THEN EXISTS_TAC `p UNION r:(real^N->bool)->bool` THEN SIMP_TAC[SUBSET_UNION] THEN SUBGOAL_THEN `interval[a:real^N,b] UNION UNIONS p = UNIONS p UNION INTERS(IMAGE (UNIONS o q) p)` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_UNION] THEN ASM_CASES_TAC `(y:real^N) IN UNIONS p` THEN ASM_REWRITE_TAC[IN_INTERS] THEN REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN SUBGOAL_THEN `!k. k IN p ==> UNIONS(k INSERT q k) = interval[a:real^N,b] UNION k` MP_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[UNIONS_INSERT; o_THM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EXTENSION] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IN_UNION] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN UNDISCH_TAC `~((y:real^N) IN UNIONS p)` THEN SIMP_TAC[IN_UNIONS; NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN ASM_CASES_TAC `(y:real^N) IN interval[a,b]` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[INTERIOR_FINITE_INTERS; FINITE_IMAGE] THEN MATCH_MP_TAC(SET_RULE `(?x. x IN p /\ f x INTER s = {}) ==> INTERS (IMAGE f p) INTER s = {}`) THEN REWRITE_TAC[EXISTS_IN_IMAGE; o_THM] THEN EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[division_of; FINITE_INSERT; IN_INSERT]; ASM_MESON_TAC[division_of; FINITE_INSERT; IN_INSERT]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[division_of; IN_INSERT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; let ELEMENTARY_UNION_INTERVAL = prove (`!p a b:real^N. p division_of (UNIONS p) ==> ?q. q division_of (interval[a,b] UNION UNIONS p)`, MESON_TAC[ELEMENTARY_UNION_INTERVAL_STRONG]);; let ELEMENTARY_UNIONS_INTERVALS = prove (`!f. FINITE f /\ (!s. s IN f ==> ?a b:real^N. s = interval[a,b]) ==> (?p. p division_of (UNIONS f))`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; ELEMENTARY_EMPTY] THEN REWRITE_TAC[IN_INSERT; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `p:(real^N->bool)->bool`) THEN SUBGOAL_THEN `UNIONS f:real^N->bool = UNIONS p` SUBST1_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN MATCH_MP_TAC ELEMENTARY_UNION_INTERVAL THEN ASM_MESON_TAC[division_of]);; let ELEMENTARY_UNION = prove (`!s t:real^N->bool. (?p. p division_of s) /\ (?p. p division_of t) ==> (?p. p division_of (s UNION t))`, REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_TAC `p1:(real^N->bool)->bool`) (X_CHOOSE_TAC `p2:(real^N->bool)->bool`)) THEN SUBGOAL_THEN `s UNION t :real^N->bool = UNIONS p1 UNION UNIONS p2` SUBST1_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `UNIONS p1 UNION UNIONS p2 = UNIONS(p1 UNION p2)`] THEN MATCH_MP_TAC ELEMENTARY_UNIONS_INTERVALS THEN REWRITE_TAC[IN_UNION; FINITE_UNION] THEN ASM_MESON_TAC[division_of]);; let PARTIAL_DIVISION_EXTEND = prove (`!p q s t:real^N->bool. p division_of s /\ q division_of t /\ s SUBSET t ==> ?r. p SUBSET r /\ r division_of t`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?a b:real^N. t SUBSET interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[ELEMENTARY_SUBSET_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN SUBGOAL_THEN `?r1. p SUBSET r1 /\ r1 division_of interval[a:real^N,b]` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC PARTIAL_DIVISION_EXTEND_INTERVAL THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `?r2:(real^N->bool)->bool. r2 division_of (UNIONS(r1 DIFF p)) INTER (UNIONS q)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC ELEMENTARY_INTER THEN ASM_MESON_TAC[FINITE_DIFF; IN_DIFF; division_of; ELEMENTARY_UNIONS_INTERVALS]; ALL_TAC] THEN EXISTS_TAC `p UNION r2:(real^N->bool)->bool` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `t:real^N->bool = UNIONS p UNION (UNIONS(r1 DIFF p) INTER UNIONS q)` SUBST1_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o last o CONJUNCTS o GEN_REWRITE_RULE I [division_of])) THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!t'. t SUBSET t' /\ s INTER t' = {} ==> s INTER t = {}`) THEN EXISTS_TAC `interior(UNIONS(r1 DIFF p)):real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[IN_DIFF; FINITE_DIFF; division_of]; ALL_TAC]) THEN REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INTER_COMM]) THEN ASM_MESON_TAC[division_of; SUBSET]]);; let INTERVAL_SUBDIVISION = prove (`!a b c:real^N. c IN interval[a,b] ==> IMAGE (\s. interval[(lambda i. if i IN s then c$i else a$i), (lambda i. if i IN s then b$i else c$i)]) {s | s SUBSET 1..dimindex(:N)} division_of interval[a,b]`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN REWRITE_TAC[DIVISION_OF] THEN SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET; FINITE_NUMSEG] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_INTERVAL; INTERVAL_NE_EMPTY] THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_LE_TRANS]; X_GEN_TAC `s:num->bool` THEN DISCH_TAC THEN X_GEN_TAC `s':num->bool` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `(~p ==> s INTER t = {}) <=> (!x. x IN s /\ x IN t ==> p)`] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_CASES_TAC `s':num->bool = s` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s' = s) ==> ?x. x IN s' /\ ~(x IN s) \/ x IN s /\ ~(x IN s')`)) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; IN_NUMSEG]; REAL_ARITH_TAC]); MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN GEN_REWRITE_TAC I [SUBSET] THENL [REWRITE_TAC[FORALL_IN_UNIONS] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; GSYM SUBSET] THEN SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN EXISTS_TAC `{i | i IN 1..dimindex(:N) /\ (c:real^N)$i <= (x:real^N)$i}` THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN SIMP_TAC[LAMBDA_BETA; IN_ELIM_THM; IN_NUMSEG] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_MESON_TAC[REAL_LE_TOTAL]]]);; let DIVISION_OF_NONTRIVIAL = prove (`!s a b:real^N. s division_of interval[a,b] /\ ~(content(interval[a,b]) = &0) ==> {k | k IN s /\ ~(content k = &0)} division_of interval[a,b]`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(s:(real^N->bool)->bool)` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `{k:real^N->bool | k IN s /\ ~(content k = &0)} = s` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EXTENSION]) THEN REWRITE_TAC[IN_ELIM_THM; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ ~b <=> a) <=> a /\ b`] THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (k:real^N->bool)`) THEN ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN ASM_SIMP_TAC[CARD_EQ_0] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]] THEN REWRITE_TAC[DIVISION_OF] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [division_of]) THEN ASM_SIMP_TAC[FINITE_DELETE; IN_DELETE] THEN FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(k:real^N->bool) IN s`)) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC(SET_RULE `UNIONS s = i /\ k SUBSET UNIONS(s DELETE k) ==> UNIONS(s DELETE k) = i`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[CLOSED_LIMPT; SUBSET] `closed s /\ (!x. x IN k ==> x limit_point_of s) ==> k SUBSET s`) THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_UNIONS THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN ASM_MESON_TAC[CLOSED_INTERVAL]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN SUBGOAL_THEN `?y:real^N. y IN UNIONS s /\ ~(y IN interval[c,d]) /\ ~(y = x) /\ norm(y - x) < e` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`~(content(interval[a:real^N,b]) = &0)`; `content(interval[c:real^N,d]) = &0`] THEN REWRITE_TAC[CONTENT_EQ_0; NOT_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN UNDISCH_TAC `~(interval[c:real^N,d] = {})` THEN REWRITE_TAC[INTERVAL_EQ_EMPTY; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN ASM_SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN UNDISCH_TAC `interval[c:real^N,d] SUBSET interval[a,b]` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ASSUME `(x:real^N) IN interval[c,d]`) THEN GEN_REWRITE_TAC LAND_CONV [IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_ARITH `d = c ==> (c <= x /\ x <= d <=> x = c)`] THEN DISCH_TAC THEN MP_TAC(ASSUME `(x:real^N) IN interval[a,b]`) THEN GEN_REWRITE_TAC LAND_CONV [IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `(lambda j. if j = i then if (c:real^N)$i <= ((a:real^N)$i + (b:real^N)$i) / &2 then c$i + min e (b$i - c$i) / &2 else c$i - min e (c$i - a$i) / &2 else (x:real^N)$j):real^N` THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `j:num` THEN STRIP_TAC THEN UNDISCH_TAC `(x:real^N) IN interval[a,b]` THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[vector_norm; dot] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; GSYM REAL_POW_2] THEN REWRITE_TAC[REAL_ARITH `((if p then x else y) - y) pow 2 = if p then (x - y) pow 2 else &0`] THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; POW_2_SQRT_ABS] THEN ASM_REAL_ARITH_TAC]);; let DIVISION_OF_AFFINITY = prove (`!d s:real^N->bool m c. IMAGE (IMAGE (\x. m % x + c)) d division_of (IMAGE (\x. m % x + c) s) <=> if m = &0 then if s = {} then d = {} else ~(d = {}) /\ !k. k IN d ==> ~(k = {}) else d division_of s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; DIVISION_OF_TRIVIAL; IMAGE_EQ_EMPTY] THEN ASM_CASES_TAC `d:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; EMPTY_DIVISION_OF; UNIONS_0; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> IMAGE (\x. c) s = {c}`] THEN ASM_CASES_TAC `!k:real^N->bool. k IN d ==> ~(k = {})` THEN ASM_REWRITE_TAC[division_of] THENL [ALL_TAC; REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[IMAGE_EQ_EMPTY]] THEN SUBGOAL_THEN `IMAGE (IMAGE ((\x. c):real^N->real^N)) d = {{c}}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_IMAGE; IN_SING] THEN ASM SET_TAC[]; SIMP_TAC[UNIONS_1; FINITE_SING; IN_SING; IMP_CONJ] THEN REWRITE_TAC[SUBSET_REFL; NOT_INSERT_EMPTY] THEN MESON_TAC[INTERVAL_SING]]; REWRITE_TAC[division_of] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IMAGE_EQ_EMPTY; GSYM INTERIOR_INTER] THEN ASM_SIMP_TAC[FINITE_IMAGE_INJ_EQ; GSYM IMAGE_UNIONS; VECTOR_ARITH `x + a:real^N = y + a <=> x = y`; VECTOR_MUL_LCANCEL; SET_RULE `(!x y. f x = f y <=> x = y) ==> (IMAGE f s SUBSET IMAGE f t <=> s SUBSET t) /\ (IMAGE f s = IMAGE f t <=> s = t) /\ (IMAGE f s INTER IMAGE f t = IMAGE f (s INTER t))`] THEN AP_TERM_TAC THEN BINOP_TAC THENL [AP_TERM_TAC THEN ABS_TAC THEN REPLICATE_TAC 3 AP_TERM_TAC THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN ASM_SIMP_TAC[IMAGE_AFFINITY_INTERVAL] THENL [ALL_TAC; MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `IMAGE (\x:real^N. inv m % x + --(inv m % c))`) THEN ASM_SIMP_TAC[GSYM IMAGE_o; AFFINITY_INVERSES] THEN ASM_REWRITE_TAC[IMAGE_I; IMAGE_AFFINITY_INTERVAL] THEN MESON_TAC[]; SUBGOAL_THEN `(\x:real^N. m % x + c) = (\x. c + x) o (\x. m % x)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; REWRITE_TAC[IMAGE_o; INTERIOR_TRANSLATION] THEN ASM_SIMP_TAC[INTERIOR_INJECTIVE_LINEAR_IMAGE; LINEAR_SCALING; VECTOR_MUL_LCANCEL; IMAGE_EQ_EMPTY]]]]);; let DIVISION_OF_TRANSLATION = prove (`!d s:real^N->bool. IMAGE (IMAGE (\x. a + x)) d division_of (IMAGE (\x. a + x) s) <=> d division_of s`, ONCE_REWRITE_TAC[VECTOR_ARITH `a + x:real^N = &1 % x + a`] THEN REWRITE_TAC[DIVISION_OF_AFFINITY] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let DIVISION_OF_REFLECT = prove (`!d s:real^N->bool. IMAGE (IMAGE (--)) d division_of IMAGE (--) s <=> d division_of s`, REPEAT GEN_TAC THEN SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x + vec 0` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; REWRITE_TAC[DIVISION_OF_AFFINITY] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let ELEMENTARY_COMPACT = prove (`!s. (?d. d division_of s) ==> compact s`, REWRITE_TAC[division_of] THEN MESON_TAC[COMPACT_UNIONS; COMPACT_INTERVAL]);; let OPEN_COUNTABLE_LIMIT_ELEMENTARY = prove (`!s:real^N->bool. open s ==> ?f. (!n. ?d. d division_of f n) /\ (!n. f n SUBSET f(SUC n)) /\ UNIONS {f n | n IN (:num)} = s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `(\n. {}):num->real^N->bool` THEN REWRITE_TAC[ELEMENTARY_EMPTY; EMPTY_SUBSET; UNIONS_GSPEC] THEN ASM SET_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` MP_TAC) THEN ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:num->real^N->bool` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN EXISTS_TAC `\n. UNIONS {(f:num->real^N->bool) m | m <= n}` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC ELEMENTARY_UNIONS_INTERVALS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE] THEN ASM SET_TAC[]; GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[UNIONS_GSPEC; UNIONS_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; EXTENSION] THEN MESON_TAC[LE_REFL]]);; let DIVISION_1_SORT = prove (`!d s:real^1->bool. d division_of s /\ (!k. k IN d ==> ~(interior k = {})) ==> ?n t. IMAGE t (1..n) = d /\ !i j. i IN 1..n /\ j IN 1..n /\ i < j ==> ~(t i = t j) /\ !x y. x IN t i /\ y IN t j ==> drop x <= drop y`, REPEAT STRIP_TAC THEN EXISTS_TAC `CARD(d:(real^1->bool)->bool)` THEN MP_TAC(ISPEC `\i j:real^1->bool. i IN d /\ j IN d /\ drop(interval_lowerbound i) <= drop(interval_lowerbound j)` TOPOLOGICAL_SORT) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_TRANS]] THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM]; DISCH_THEN(MP_TAC o SPECL [`CARD(d:(real^1->bool)->bool)`; `d:(real^1->bool)->bool`]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_REWRITE_TAC[GSYM FINITE_HAS_SIZE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^1->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `!k l. k IN d /\ l IN d /\ ~(drop(interval_lowerbound l) <= drop (interval_lowerbound k)) ==> ~(k = l) /\ !x y. x IN k /\ y IN l ==> drop x <= drop y` MP_TAC THENL [ALL_TAC; DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; REPEAT GEN_TAC THEN STRIP_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM]] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; IN_INTERVAL_1] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN STRIP_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`interval[a:real^1,b]`; `interval[c:real^1,d]`] o el 2 o CONJUNCTS) THEN (SUBGOAL_THEN `~(interior(interval[a:real^1,b]) = {}) /\ ~(interior(interval[c:real^1,d]) = {})` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[EQ_INTERVAL_1; GSYM INTERIOR_INTER] THEN REWRITE_TAC[INTER_INTERVAL_1; INTERIOR_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Tagged (partial) divisions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("tagged_partial_division_of",(12,"right"));; parse_as_infix("tagged_division_of",(12,"right"));; let tagged_partial_division_of = new_definition `s tagged_partial_division_of i <=> FINITE s /\ (!x k. (x,k) IN s ==> x IN k /\ k SUBSET i /\ ?a b. k = interval[a,b]) /\ (!x1 k1 x2 k2. (x1,k1) IN s /\ (x2,k2) IN s /\ ~((x1,k1) = (x2,k2)) ==> (interior(k1) INTER interior(k2) = {}))`;; let tagged_division_of = new_definition `s tagged_division_of i <=> s tagged_partial_division_of i /\ (UNIONS {k | ?x. (x,k) IN s} = i)`;; let TAGGED_DIVISION_OF_FINITE = prove (`!s i. s tagged_division_of i ==> FINITE s`, SIMP_TAC[tagged_division_of; tagged_partial_division_of]);; let TAGGED_DIVISION_OF = prove (`s tagged_division_of i <=> FINITE s /\ (!x k. (x,k) IN s ==> x IN k /\ k SUBSET i /\ ?a b. k = interval[a,b]) /\ (!x1 k1 x2 k2. (x1,k1) IN s /\ (x2,k2) IN s /\ ~((x1,k1) = (x2,k2)) ==> (interior(k1) INTER interior(k2) = {})) /\ (UNIONS {k | ?x. (x,k) IN s} = i)`, REWRITE_TAC[tagged_division_of; tagged_partial_division_of; CONJ_ASSOC]);; let DIVISION_OF_TAGGED_DIVISION = prove (`!s i. s tagged_division_of i ==> (IMAGE SND s) division_of i`, REWRITE_TAC[TAGGED_DIVISION_OF; division_of] THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; FORALL_PAIR_THM; PAIR_EQ] THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIONS] THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN MESON_TAC[]]);; let PARTIAL_DIVISION_OF_TAGGED_DIVISION = prove (`!s i. s tagged_partial_division_of i ==> (IMAGE SND s) division_of UNIONS(IMAGE SND s)`, REWRITE_TAC[tagged_partial_division_of; division_of] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ; DE_MORGAN_THM] THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMAGE]; ALL_TAC; ASM_MESON_TAC[]] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_IMAGE; EXISTS_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN ASM SET_TAC[]);; let TAGGED_PARTIAL_DIVISION_SUBSET = prove (`!s t i. s tagged_partial_division_of i /\ t SUBSET s ==> t tagged_partial_division_of i`, REWRITE_TAC[tagged_partial_division_of] THEN MESON_TAC[FINITE_SUBSET; SUBSET]);; let VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA = prove (`!d:(real^M->bool)->real^N p i. p tagged_partial_division_of i /\ (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 ==> d(interval[u,v]) = vec 0) ==> vsum p (\(x,k). d k) = vsum (IMAGE SND p) d`, REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\(x:real^M,k:real^M->bool). d k:real^N) = d o SND` SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM; FORALL_PAIR_THM; o_THM]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[FORALL_PAIR_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:real^M->bool` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k':real^M->bool` THEN ASM_CASES_TAC `k':real^M->bool = k` THEN ASM_REWRITE_TAC[PAIR_EQ; INTER_ACI] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[]);; let VSUM_OVER_TAGGED_DIVISION_LEMMA = prove (`!d:(real^M->bool)->real^N p i. p tagged_division_of i /\ (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 ==> d(interval[u,v]) = vec 0) ==> vsum p (\(x,k). d k) = vsum (IMAGE SND p) d`, REWRITE_TAC[tagged_division_of] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA THEN EXISTS_TAC `i:real^M->bool` THEN ASM_REWRITE_TAC[]);; let SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA = prove (`!d:(real^N->bool)->real p i. p tagged_partial_division_of i /\ (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 ==> d(interval[u,v]) = &0) ==> sum p (\(x,k). d k) = sum (IMAGE SND p) d`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[tagged_partial_division_of]) THEN ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN ASM_SIMP_TAC[LIFT_SUM; FINITE_IMAGE; o_DEF; LAMBDA_PAIR_THM] THEN MATCH_MP_TAC VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_MESON_TAC[]);; let SUM_OVER_TAGGED_DIVISION_LEMMA = prove (`!d:(real^N->bool)->real p i. p tagged_division_of i /\ (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 ==> d(interval[u,v]) = &0) ==> sum p (\(x,k). d k) = sum (IMAGE SND p) d`, REWRITE_TAC[tagged_division_of] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA THEN EXISTS_TAC `i:real^N->bool` THEN ASM_REWRITE_TAC[]);; let TAG_IN_INTERVAL = prove (`!p i k. p tagged_division_of i /\ (x,k) IN p ==> x IN i`, REWRITE_TAC[TAGGED_DIVISION_OF] THEN SET_TAC[]);; let TAGGED_DIVISION_OF_EMPTY = prove (`{} tagged_division_of {}`, REWRITE_TAC[tagged_division_of; tagged_partial_division_of] THEN REWRITE_TAC[FINITE_RULES; EXTENSION; NOT_IN_EMPTY; IN_UNIONS; IN_ELIM_THM]);; let TAGGED_PARTIAL_DIVISION_OF_TRIVIAL = prove (`!p. p tagged_partial_division_of {} <=> p = {}`, REWRITE_TAC[tagged_partial_division_of; SUBSET_EMPTY; CONJ_ASSOC] THEN REWRITE_TAC[SET_RULE `x IN k /\ k = {} <=> F`] THEN REWRITE_TAC[GSYM FORALL_PAIR_THM; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[AC CONJ_ACI `(a /\ b) /\ c <=> b /\ a /\ c`] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FINITE_RULES; UNIONS_0; NOT_IN_EMPTY]);; let TAGGED_DIVISION_OF_TRIVIAL = prove (`!p. p tagged_division_of {} <=> p = {}`, REWRITE_TAC[tagged_division_of; TAGGED_PARTIAL_DIVISION_OF_TRIVIAL] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_IN_EMPTY] THEN SET_TAC[]);; let TAGGED_DIVISION_OF_SELF = prove (`!x a b. x IN interval[a,b] ==> {(x,interval[a,b])} tagged_division_of interval[a,b]`, REWRITE_TAC[TAGGED_DIVISION_OF; FINITE_INSERT; FINITE_RULES; IN_SING] THEN REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL; UNWIND_THM2; SET_RULE `{k | k = a} = {a}`] THEN REWRITE_TAC[UNIONS_1] THEN ASM_MESON_TAC[]);; let TAGGED_DIVISION_UNION = prove (`!s1 s2:real^N->bool p1 p2. p1 tagged_division_of s1 /\ p2 tagged_division_of s2 /\ interior s1 INTER interior s2 = {} ==> (p1 UNION p2) tagged_division_of (s1 UNION s2)`, REPEAT GEN_TAC THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN STRIP_TAC THEN ASM_REWRITE_TAC[FINITE_UNION; IN_UNION; EXISTS_OR_THM; SET_RULE `UNIONS {x | P x \/ Q x} = UNIONS {x | P x} UNION UNIONS {x | Q x}`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC; ONCE_REWRITE_TAC[INTER_COMM]; ASM_MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `!s' t'. s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {} ==> s INTER t = {}`) THEN MAP_EVERY EXISTS_TAC [`interior s1:real^N->bool`; `interior s2:real^N->bool`] THEN ASM_SIMP_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_MESON_TAC[]);; let TAGGED_DIVISION_UNIONS = prove (`!iset pfn. FINITE iset /\ (!i:real^M->bool. i IN iset ==> pfn(i) tagged_division_of i) /\ (!i1 i2. i1 IN iset /\ i2 IN iset /\ ~(i1 = i2) ==> (interior(i1) INTER interior(i2) = {})) ==> UNIONS(IMAGE pfn iset) tagged_division_of (UNIONS iset)`, let lemma1 = prove (`(?t. (?x. (t = f x) /\ P x) /\ Q t) <=> ?x. P x /\ Q(f x)`, MESON_TAC[]) and lemma2 = prove (`!s1 t1 s2 t2. s1 SUBSET t1 /\ s2 SUBSET t2 /\ (t1 INTER t2 = {}) ==> (s1 INTER s2 = {})`, SET_TAC[]) in REPEAT GEN_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[EXTENSION] tagged_division_of] THEN REWRITE_TAC[tagged_partial_division_of; IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIONS; IN_IMAGE] THEN SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC; ASM_MESON_TAC[]] THEN REPEAT GEN_TAC THEN REWRITE_TAC[lemma1] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`i1:real^M->bool`; `i2:real^M->bool`] THEN ASM_CASES_TAC `i1 = i2:real^M->bool` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN MAP_EVERY EXISTS_TAC [`interior(i1:real^M->bool)`; `interior(i2:real^M->bool)`] THEN ASM_MESON_TAC[SUBSET; SUBSET_INTERIOR]);; let TAGGED_PARTIAL_DIVISION_OF_UNION_SELF = prove (`!p s. p tagged_partial_division_of s ==> p tagged_division_of (UNIONS(IMAGE SND p))`, SIMP_TAC[tagged_partial_division_of; TAGGED_DIVISION_OF] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_IMAGE; EXISTS_PAIR_THM] THEN ASM_MESON_TAC[]; ASM_MESON_TAC[]; AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN MESON_TAC[]]);; let TAGGED_DIVISION_OF_UNION_SELF = prove (`!p s. p tagged_division_of s ==> p tagged_division_of (UNIONS(IMAGE SND p))`, SIMP_TAC[TAGGED_DIVISION_OF] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(c ==> a /\ b) /\ c ==> a /\ b /\ c`) THEN CONJ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN MESON_TAC[]]);; let TAGGED_DIVISION_UNION_IMAGE_SND = prove (`!p s. p tagged_division_of s ==> s = UNIONS(IMAGE SND p)`, MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF; tagged_division_of]);; let TAGGED_DIVISION_OF_ALT = prove (`!p s. p tagged_division_of s <=> p tagged_partial_division_of s /\ (!x. x IN s ==> ?t k. (t,k) IN p /\ x IN k)`, REWRITE_TAC[tagged_division_of; GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[IN_UNIONS; EXISTS_PAIR_THM; IN_ELIM_THM] THEN REWRITE_TAC[tagged_partial_division_of; SUBSET] THEN MESON_TAC[]);; let TAGGED_DIVISION_OF_ANOTHER = prove (`!p s s'. p tagged_partial_division_of s' /\ (!t k. (t,k) IN p ==> k SUBSET s) /\ (!x. x IN s ==> ?t k. (t,k) IN p /\ x IN k) ==> p tagged_division_of s`, REWRITE_TAC[TAGGED_DIVISION_OF_ALT; tagged_partial_division_of] THEN SET_TAC[]);; let TAGGED_PARTIAL_DIVISION_OF_SUBSET = prove (`!p s t. p tagged_partial_division_of s /\ s SUBSET t ==> p tagged_partial_division_of t`, REWRITE_TAC[tagged_partial_division_of] THEN SET_TAC[]);; let TAGGED_DIVISION_OF_NONTRIVIAL = prove (`!s a b:real^N. s tagged_division_of interval[a,b] /\ ~(content(interval[a,b]) = &0) ==> {(x,k) | (x,k) IN s /\ ~(content k = &0)} tagged_division_of interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[TAGGED_DIVISION_OF_ALT] THEN CONJ_TAC THENL [MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN EXISTS_TAC `s:(real^N#(real^N->bool))->bool` THEN RULE_ASSUM_TAC(REWRITE_RULE[tagged_division_of]) THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN DISCH_THEN(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] DIVISION_OF_NONTRIVIAL)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Fine-ness of a partition w.r.t. a gauge. *) (* ------------------------------------------------------------------------- *) parse_as_infix("fine",(12,"right"));; let fine = new_definition `d fine s <=> !x k. (x,k) IN s ==> k SUBSET d(x)`;; let FINE_INTER = prove (`!p d1 d2. (\x. d1(x) INTER d2(x)) fine p <=> d1 fine p /\ d2 fine p`, let lemma = prove (`s SUBSET (t INTER u) <=> s SUBSET t /\ s SUBSET u`,SET_TAC[]) in REWRITE_TAC[fine; IN_INTER; lemma] THEN MESON_TAC[]);; let FINE_INTERS = prove (`!f s p. (\x. INTERS {f d x | d IN s}) fine p <=> !d. d IN s ==> (f d) fine p`, REWRITE_TAC[fine; SET_RULE `s SUBSET INTERS u <=> !t. t IN u ==> s SUBSET t`; IN_ELIM_THM] THEN MESON_TAC[]);; let FINE_UNION = prove (`!d p1 p2. d fine p1 /\ d fine p2 ==> d fine (p1 UNION p2)`, REWRITE_TAC[fine; IN_UNION] THEN MESON_TAC[]);; let FINE_UNIONS = prove (`!d ps. (!p. p IN ps ==> d fine p) ==> d fine (UNIONS ps)`, REWRITE_TAC[fine; IN_UNIONS] THEN MESON_TAC[]);; let FINE_SUBSET = prove (`!d p q. p SUBSET q /\ d fine q ==> d fine p`, REWRITE_TAC[fine; SUBSET] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Gauge integral. Define on compact intervals first, then use a limit. *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_integral_compact_interval",(12,"right"));; parse_as_infix("has_integral",(12,"right"));; parse_as_infix("integrable_on",(12,"right"));; let has_integral_compact_interval = new_definition `(f has_integral_compact_interval y) i <=> !e. &0 < e ==> ?d. gauge d /\ !p. p tagged_division_of i /\ d fine p ==> norm(vsum p (\(x,k). content(k) % f(x)) - y) < e`;; let has_integral_def = new_definition `(f has_integral y) i <=> if ?a b. i = interval[a,b] then (f has_integral_compact_interval y) i else !e. &0 < e ==> ?B. &0 < B /\ !a b. ball(vec 0,B) SUBSET interval[a,b] ==> ?z. ((\x. if x IN i then f(x) else vec 0) has_integral_compact_interval z) (interval[a,b]) /\ norm(z - y) < e`;; let has_integral = prove (`(f has_integral y) (interval[a,b]) <=> !e. &0 < e ==> ?d. gauge d /\ !p. p tagged_division_of interval[a,b] /\ d fine p ==> norm(vsum p (\(x,k). content(k) % f(x)) - y) < e`, REWRITE_TAC[has_integral_def; has_integral_compact_interval] THEN MESON_TAC[]);; let has_integral_alt = prove (`(f has_integral y) i <=> if ?a b. i = interval[a,b] then (f has_integral y) i else !e. &0 < e ==> ?B. &0 < B /\ !a b. ball(vec 0,B) SUBSET interval[a,b] ==> ?z. ((\x. if x IN i then f(x) else vec 0) has_integral z) (interval[a,b]) /\ norm(z - y) < e`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [has_integral_def] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [POP_ASSUM(REPEAT_TCL CHOOSE_THEN SUBST1_TAC); ALL_TAC] THEN REWRITE_TAC[has_integral_compact_interval; has_integral]);; let integrable_on = new_definition `f integrable_on i <=> ?y. (f has_integral y) i`;; let integral = new_definition `integral i f = @y. (f has_integral y) i`;; let INTEGRABLE_INTEGRAL = prove (`!f i. f integrable_on i ==> (f has_integral (integral i f)) i`, REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on; integral] THEN CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);; let HAS_INTEGRAL_INTEGRABLE = prove (`!f i s. (f has_integral i) s ==> f integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[]);; let HAS_INTEGRAL_INTEGRAL = prove (`!f s. f integrable_on s <=> (f has_integral (integral s f)) s`, MESON_TAC[INTEGRABLE_INTEGRAL; HAS_INTEGRAL_INTEGRABLE]);; let VSUM_CONTENT_NULL = prove (`!f:real^M->real^N a b p. content(interval[a,b]) = &0 /\ p tagged_division_of interval[a,b] ==> vsum p (\(x,k). content k % f x) = vec 0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`p:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN DISCH_THEN(MP_TAC o SPECL [`p:real^M`; `k:real^M->bool`]) THEN ASM_MESON_TAC[CONTENT_SUBSET; CONTENT_POS_LE; REAL_ARITH `&0 <= x /\ x <= y /\ y = &0 ==> x = &0`]);; (* ------------------------------------------------------------------------- *) (* Some basic combining lemmas. *) (* ------------------------------------------------------------------------- *) let TAGGED_DIVISION_UNIONS_EXISTS = prove (`!d iset i:real^M->bool. FINITE iset /\ (!i. i IN iset ==> ?p. p tagged_division_of i /\ d fine p) /\ (!i1 i2. i1 IN iset /\ i2 IN iset /\ ~(i1 = i2) ==> (interior(i1) INTER interior(i2) = {})) /\ (UNIONS iset = i) ==> ?p. p tagged_division_of i /\ d fine p`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN EXISTS_TAC `UNIONS (IMAGE(p:(real^M->bool)->((real^M#(real^M->bool))->bool)) iset)` THEN ASM_SIMP_TAC[TAGGED_DIVISION_UNIONS] THEN ASM_MESON_TAC[FINE_UNIONS; IN_IMAGE]);; (* ------------------------------------------------------------------------- *) (* The set we're concerned with must be closed. *) (* ------------------------------------------------------------------------- *) let DIVISION_OF_CLOSED = prove (`!s i. s division_of i ==> closed i`, REWRITE_TAC[division_of] THEN MESON_TAC[CLOSED_UNIONS; CLOSED_INTERVAL]);; (* ------------------------------------------------------------------------- *) (* General bisection principle for intervals; might be useful elsewhere. *) (* ------------------------------------------------------------------------- *) let INTERVAL_BISECTION_STEP = prove (`!P. P {} /\ (!s t. P s /\ P t /\ interior(s) INTER interior(t) = {} ==> P(s UNION t)) ==> !a b:real^N. ~(P(interval[a,b])) ==> ?c d. ~(P(interval[c,d])) /\ !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ c$i <= d$i /\ d$i <= b$i /\ &2 * (d$i - c$i) <= b$i - a$i`, REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `!i. 1 <= i /\ i <= dimindex(:N) ==> (a:real^N)$i <= (b:real^N)$i` THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTERVAL_NE_EMPTY]) THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `!f. FINITE f /\ (!s:real^N->bool. s IN f ==> P s) /\ (!s:real^N->bool. s IN f ==> ?a b. s = interval[a,b]) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> interior(s) INTER interior(t) = {}) ==> P(UNIONS f)` ASSUME_TAC THENL [ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[UNIONS_0; UNIONS_INSERT; NOT_IN_EMPTY; FORALL_IN_INSERT] THEN REWRITE_TAC[IMP_IMP] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN STRIP_ASSUME_TAC th) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{ interval[c,d] | !i. 1 <= i /\ i <= dimindex(:N) ==> ((c:real^N)$i = (a:real^N)$i) /\ (d$i = (a$i + b$i) / &2) \/ (c$i = (a$i + b$i) / &2) /\ ((d:real^N)$i = (b:real^N)$i)}`) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ANTS_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\s. closed_interval [(lambda i. if i IN s then (a:real^N)$i else (a$i + b$i) / &2):real^N, (lambda i. if i IN s then (a$i + b$i) / &2 else (b:real^N)$i)]) {s | s SUBSET (1..dimindex(:N))}` THEN CONJ_TAC THENL [SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` (X_CHOOSE_THEN `d:real^N` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))) THEN EXISTS_TAC `{i | 1 <= i /\ i <= dimindex(:N) /\ ((c:real^N)$i = (a:real^N)$i)}` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]] THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_ELIM_THM] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN `i:num` o SPEC `i:num`)) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ANTS_TAC THENL [UNDISCH_TAC `~P(interval[a:real^N,b])` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2; IN_INTERVAL] THEN REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> ((a ==> b) <=> (a ==> c))`) THEN STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `(a \/ b) /\ c <=> ~(a ==> ~c) \/ ~(b ==> ~c)`] THEN SIMP_TAC[] THEN REWRITE_TAC[TAUT `~(a ==> ~b) <=> a /\ b`; GSYM CONJ_ASSOC] THEN REWRITE_TAC[EXISTS_OR_THM; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MATCH_MP_TAC(TAUT `b /\ (~a ==> e) /\ c ==> ~(a /\ b /\ c) ==> e`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> REPEAT DISCH_TAC THEN MP_TAC th) THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IMP_IMP; INTERIOR_CLOSED_INTERVAL] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`c1:real^N`; `d1:real^N`; `c2:real^N`; `d2:real^N`] THEN ASM_CASES_TAC `(c1 = c2:real^N) /\ (d1 = d2:real^N)` THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (K ALL_TAC)) THEN MP_TAC th) THEN REWRITE_TAC[IMP_IMP] THEN UNDISCH_TAC `~((c1 = c2:real^N) /\ (d1 = d2:real^N))` THEN REWRITE_TAC[CART_EQ; INTERIOR_CLOSED_INTERVAL] THEN REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN REWRITE_TAC[NOT_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `j:num` (fun th -> DISCH_THEN(MP_TAC o SPEC `j:num`) THEN MP_TAC th)) THEN REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[EXTENSION; IN_INTERVAL; NOT_IN_EMPTY; IN_INTER] THEN SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_EQ_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[ REAL_ARITH `~((a * &2 = a + b) /\ (a + b = b * &2)) <=> ~(a = b)`; REAL_ARITH `~((a + b = a * &2) /\ (b * &2 = a + b)) <=> ~(a = b)`] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN MP_TAC th) THEN REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let INTERVAL_BISECTION = prove (`!P. P {} /\ (!s t. P s /\ P t /\ interior(s) INTER interior(t) = {} ==> P(s UNION t)) ==> !a b:real^N. ~(P(interval[a,b])) ==> ?x. x IN interval[a,b] /\ !e. &0 < e ==> ?c d. x IN interval[c,d] /\ interval[c,d] SUBSET ball(x,e) /\ interval[c,d] SUBSET interval[a,b] /\ ~P(interval[c,d])`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?A B. (A(0) = a:real^N) /\ (B(0) = b) /\ !n. ~(P(interval[A(SUC n),B(SUC n)])) /\ !i. 1 <= i /\ i <= dimindex(:N) ==> A(n)$i <= A(SUC n)$i /\ A(SUC n)$i <= B(SUC n)$i /\ B(SUC n)$i <= B(n)$i /\ &2 * (B(SUC n)$i - A(SUC n)$i) <= B(n)$i - A(n)$i` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `P:(real^N->bool)->bool` INTERVAL_BISECTION_STEP) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `C:real^N->real^N->real^N` (X_CHOOSE_THEN `D:real^N->real^N->real^N` ASSUME_TAC)) THEN MP_TAC(prove_recursive_functions_exist num_RECURSION `(E 0 = a:real^N,b:real^N) /\ (!n. E(SUC n) = C (FST(E n)) (SND(E n)), D (FST(E n)) (SND(E n)))`) THEN DISCH_THEN(X_CHOOSE_THEN `E:num->real^N#real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n. FST((E:num->real^N#real^N) n)` THEN EXISTS_TAC `\n. SND((E:num->real^N#real^N) n)` THEN ASM_REWRITE_TAC[] THEN INDUCT_TAC THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!e. &0 < e ==> ?n:num. !x y. x IN interval[A(n),B(n)] /\ y IN interval[A(n),B(n)] ==> dist(x,y:real^N) < e` ASSUME_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `sum(1..dimindex(:N)) (\i. (b:real^N)$i - (a:real^N)$i) / e` REAL_ARCH_POW2) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N))(\i. abs((x - y:real^N)$i))` THEN REWRITE_TAC[dist; NORM_LE_L1] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. (B:num->real^N)(n)$i - (A:num->real^N)(n)$i)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[VECTOR_SUB_COMPONENT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `a <= x /\ x <= b /\ a <= y /\ y <= b ==> abs(x - y) <= b - a`) THEN UNDISCH_TAC `x IN interval[(A:num->real^N) n,B n]` THEN UNDISCH_TAC `y IN interval[(A:num->real^N) n,B n]` THEN REWRITE_TAC[IN_INTERVAL] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. (b:real^N)$i - (a:real^N)$i) / &2 pow n` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN SPEC_TAC(`n:num`,`m:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_DIV_1; REAL_LE_REFL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_MUL_SYM]; ALL_TAC] THEN SUBGOAL_THEN `?a:real^N. !n:num. a IN interval[A(n),B(n)]` MP_TAC THENL [MATCH_MP_TAC DECREASING_CLOSED_NEST THEN ASM_REWRITE_TAC[CLOSED_INTERVAL] THEN CONJ_TAC THENL [REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_NOT_LT; REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[LE_EXISTS] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[GSYM LEFT_IMP_EXISTS_THM; EXISTS_REFL] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; SUBSET_REFL] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `interval[A(m + d:num):real^N,B(m + d)]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x0:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN MAP_EVERY EXISTS_TAC [`(A:num->real^N) n`; `(B:num->real^N) n`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]; ALL_TAC; SPEC_TAC(`n:num`,`p:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `!m n. m <= n ==> interval[(A:num->real^N) n,B n] SUBSET interval[A m,B m]` (fun th -> ASM_MESON_TAC[SUBSET; LE_0; th]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cousin's lemma. *) (* ------------------------------------------------------------------------- *) let FINE_DIVISION_EXISTS = prove (`!g a b:real^M. gauge g ==> ?p. p tagged_division_of (interval[a,b]) /\ g fine p`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\s:real^M->bool. ?p. p tagged_division_of s /\ g fine p` INTERVAL_BISECTION) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [MESON_TAC[TAGGED_DIVISION_UNION; FINE_UNION; TAGGED_DIVISION_OF_EMPTY; fine; NOT_IN_EMPTY]; DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`])] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o REWRITE_RULE[gauge]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[OPEN_CONTAINS_BALL; NOT_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{(x:real^M,interval[c:real^M,d])}`) THEN ASM_SIMP_TAC[TAGGED_DIVISION_OF_SELF] THEN REWRITE_TAC[fine; IN_SING; PAIR_EQ] THEN ASM_MESON_TAC[SUBSET_TRANS]);; (* ------------------------------------------------------------------------- *) (* Basic theorems about integrals. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_UNIQUE = prove (`!f:real^M->real^N i k1 k2. (f has_integral k1) i /\ (f has_integral k2) i ==> k1 = k2`, REPEAT GEN_TAC THEN SUBGOAL_THEN `!f:real^M->real^N a b k1 k2. (f has_integral k1) (interval[a,b]) /\ (f has_integral k2) (interval[a,b]) ==> k1 = k2` MP_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral] THEN REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM NORM_POS_LT] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `norm(k1 - k2 :real^N) / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC)) THEN MP_TAC(ISPEC `\x. ((d1:real^M->real^M->bool) x) INTER (d2 x)` FINE_DIVISION_EXISTS) THEN ASM_SIMP_TAC[GAUGE_INTER] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_forall o concl))) THEN REWRITE_TAC[] THEN REWRITE_TAC[IMP_IMP; NOT_EXISTS_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(f0 ==> f1 /\ f2) /\ ~(n1 /\ n2) ==> (t /\ f1 ==> n1) /\ (t /\ f2 ==> n2) ==> ~(t /\ f0)`) THEN CONJ_TAC THENL [SIMP_TAC[fine; SUBSET_INTER]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `c <= a + b ==> ~(a < c / &2 /\ b < c / &2)`) THEN MESON_TAC[NORM_SUB; NORM_TRIANGLE; VECTOR_ARITH `k1 - k2:real^N = (k1 - x) + (x - k2)`]; ALL_TAC] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH `~(&0 < norm(x - y)) ==> x = y`) THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `norm(k1 - k2:real^N) / &2`)) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `ball(vec 0,B1) UNION ball(vec 0:real^M,B2)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[BOUNDED_UNION; BOUNDED_BALL; UNION_SUBSET; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `w:real^N = z:real^N` SUBST_ALL_TAC THEN ASM_MESON_TAC[NORM_ARITH `~(norm(z - k1) < norm(k1 - k2) / &2 /\ norm(z - k2) < norm(k1 - k2) / &2)`]);; let INTEGRAL_UNIQUE = prove (`!f y k. (f has_integral y) k ==> integral k f = y`, REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE]);; let HAS_INTEGRAL_INTEGRABLE_INTEGRAL = prove (`!f:real^M->real^N i s. (f has_integral i) s <=> f integrable_on s /\ integral s f = i`, MESON_TAC[INTEGRABLE_INTEGRAL; INTEGRAL_UNIQUE; integrable_on]);; let INTEGRAL_EQ_HAS_INTEGRAL = prove (`!s f y. f integrable_on s ==> (integral s f = y <=> (f has_integral y) s)`, MESON_TAC[INTEGRABLE_INTEGRAL; INTEGRAL_UNIQUE]);; let HAS_INTEGRAL_IS_0 = prove (`!f:real^M->real^N s. (!x. x IN s ==> (f(x) = vec 0)) ==> (f has_integral vec 0) s`, SUBGOAL_THEN `!f:real^M->real^N a b. (!x. x IN interval[a,b] ==> (f(x) = vec 0)) ==> (f has_integral vec 0) (interval[a,b])` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[has_integral] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real^M. ball(x,&1)` THEN SIMP_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN UNDISCH_TAC `&0 < e` THEN MATCH_MP_TAC(TAUT `(a <=> b) ==> b ==> a`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ; VECTOR_ADD_LID] THEN MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(x:real^M) IN interval[a,b]` (fun th -> ASM_SIMP_TAC[th; VECTOR_MUL_RZERO]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_division_of]) THEN REWRITE_TAC[tagged_partial_division_of; SUBSET] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; let HAS_INTEGRAL_0 = prove (`!s. ((\x. vec 0) has_integral vec 0) s`, SIMP_TAC[HAS_INTEGRAL_IS_0]);; let HAS_INTEGRAL_0_EQ = prove (`!i s. ((\x. vec 0) has_integral i) s <=> i = vec 0`, MESON_TAC[HAS_INTEGRAL_UNIQUE; HAS_INTEGRAL_0]);; let HAS_INTEGRAL_LINEAR = prove (`!f:real^M->real^N y s h:real^N->real^P. (f has_integral y) s /\ linear h ==> ((h o f) has_integral h(y)) s`, SUBGOAL_THEN `!f:real^M->real^N y a b h:real^N->real^P. (f has_integral y) (interval[a,b]) /\ linear h ==> ((h o f) has_integral h(y)) (interval[a,b])` MP_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real / B`) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN FIRST_ASSUM(fun th -> W(fun (asl,w) -> MP_TAC(PART_MATCH rand th (rand w)))) THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y <= e ==> x <= e`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[LINEAR_SUB; LINEAR_VSUM; o_DEF; LAMBDA_PAIR_THM; LINEAR_CMUL; REAL_LE_REFL]; ALL_TAC] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(h:real^N->real^P) z` THEN SUBGOAL_THEN `(\x. if x IN s then ((h:real^N->real^P) o (f:real^M->real^N)) x else vec 0) = h o (\x. if x IN s then f x else vec 0)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[LINEAR_0]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(z - y:real^N)` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);; let HAS_INTEGRAL_CMUL = prove (`!(f:real^M->real^N) k s c. (f has_integral k) s ==> ((\x. c % f(x)) has_integral (c % k)) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[o_DEF] HAS_INTEGRAL_LINEAR) THEN ASM_REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let HAS_INTEGRAL_NEG = prove (`!f k s. (f has_integral k) s ==> ((\x. --(f x)) has_integral (--k)) s`, ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN REWRITE_TAC[HAS_INTEGRAL_CMUL]);; let HAS_INTEGRAL_ADD = prove (`!f:real^M->real^N g s. (f has_integral k) s /\ (g has_integral l) s ==> ((\x. f(x) + g(x)) has_integral (k + l)) s`, SUBGOAL_THEN `!f:real^M->real^N g k l a b. (f has_integral k) (interval[a,b]) /\ (g has_integral l) (interval[a,b]) ==> ((\x. f(x) + g(x)) has_integral (k + l)) (interval[a,b])` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral; AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\x. ((d1:real^M->real^M->bool) x) INTER (d2 x)` THEN ASM_SIMP_TAC[GAUGE_INTER] THEN REWRITE_TAC[tagged_division_of; tagged_partial_division_of] THEN SIMP_TAC[VSUM_ADD; VECTOR_ADD_LDISTRIB; LAMBDA_PAIR] THEN REWRITE_TAC[GSYM LAMBDA_PAIR] THEN REWRITE_TAC[GSYM tagged_partial_division_of] THEN REWRITE_TAC[GSYM tagged_division_of; FINE_INTER] THEN SIMP_TAC[VECTOR_ARITH `(a + b) - (c + d) = (a - c) + (b - d):real^N`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_TRIANGLE_LT THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `max B1 B2:real` THEN ASM_REWRITE_TAC[REAL_LT_MAX] THEN REWRITE_TAC[BALL_MAX_UNION; UNION_SUBSET] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `w + z:real^N` THEN SUBGOAL_THEN `(\x. if x IN s then (f:real^M->real^N) x + g x else vec 0) = (\x. (if x IN s then f x else vec 0) + (if x IN s then g x else vec 0))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN NORM_ARITH_TAC);; let HAS_INTEGRAL_SUB = prove (`!f:real^M->real^N g s. (f has_integral k) s /\ (g has_integral l) s ==> ((\x. f(x) - g(x)) has_integral (k - l)) s`, SIMP_TAC[VECTOR_SUB; HAS_INTEGRAL_NEG; HAS_INTEGRAL_ADD]);; let INTEGRAL_0 = prove (`!s. integral s (\x. vec 0) = vec 0`, MESON_TAC[INTEGRAL_UNIQUE; HAS_INTEGRAL_0]);; let INTEGRAL_ADD = prove (`!f:real^M->real^N g k l s. f integrable_on s /\ g integrable_on s ==> integral s (\x. f x + g x) = integral s f + integral s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_ADD THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; let INTEGRAL_CMUL = prove (`!f:real^M->real^N c s. f integrable_on s ==> integral s (\x. c % f(x)) = c % integral s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; let INTEGRAL_NEG = prove (`!f:real^M->real^N s. f integrable_on s ==> integral s (\x. --f(x)) = --integral s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_NEG THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; let INTEGRAL_SUB = prove (`!f:real^M->real^N g k l s. f integrable_on s /\ g integrable_on s ==> integral s (\x. f x - g x) = integral s f - integral s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_SUB THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; let INTEGRABLE_0 = prove (`!s. (\x. vec 0) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_0]);; let INTEGRABLE_ADD = prove (`!f:real^M->real^N g s. f integrable_on s /\ g integrable_on s ==> (\x. f x + g x) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_ADD]);; let INTEGRABLE_CMUL = prove (`!f:real^M->real^N c s. f integrable_on s ==> (\x. c % f(x)) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_CMUL]);; let INTEGRABLE_CMUL_EQ = prove (`!f:real^M->real^N s c. (\x. c % f x) integrable_on s <=> c = &0 \/ f integrable_on s`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[INTEGRABLE_CMUL; VECTOR_MUL_LZERO; INTEGRABLE_0] THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv c:real` o MATCH_MP INTEGRABLE_CMUL) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_LINV; ETA_AX]);; let INTEGRABLE_NEG = prove (`!f:real^M->real^N s. f integrable_on s ==> (\x. --f(x)) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NEG]);; let INTEGRABLE_NEG_EQ = prove (`!f:real^M->real^N s. (\x. --f x) integrable_on s <=> f integrable_on s`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_NEG) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; let INTEGRABLE_SUB = prove (`!f:real^M->real^N g s. f integrable_on s /\ g integrable_on s ==> (\x. f x - g x) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_SUB]);; let INTEGRABLE_LINEAR = prove (`!f h s. f integrable_on s /\ linear h ==> (h o f) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_LINEAR]);; let INTEGRAL_LINEAR = prove (`!f:real^M->real^N s h:real^N->real^P. f integrable_on s /\ linear h ==> integral s (h o f) = h(integral s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC [`(h:real^N->real^P) o (f:real^M->real^N)`; `s:real^M->bool`] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_INTEGRAL_LINEAR] THEN ASM_SIMP_TAC[GSYM HAS_INTEGRAL_INTEGRAL; INTEGRABLE_LINEAR]);; let HAS_INTEGRAL_VSUM = prove (`!f:A->real^M->real^N s t. FINITE t /\ (!a. a IN t ==> ((f a) has_integral (i a)) s) ==> ((\x. vsum t (\a. f a x)) has_integral (vsum t i)) s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; HAS_INTEGRAL_0; IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_ADD THEN ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; let INTEGRAL_VSUM = prove (`!f:A->real^M->real^N s t. FINITE t /\ (!a. a IN t ==> (f a) integrable_on s) ==> integral s (\x. vsum t (\a. f a x)) = vsum t (\a. integral s (f a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_VSUM THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; let INTEGRABLE_VSUM = prove (`!f:A->real^M->real^N s t. FINITE t /\ (!a. a IN t ==> (f a) integrable_on s) ==> (\x. vsum t (\a. f a x)) integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_VSUM]);; let HAS_INTEGRAL_EQ = prove (`!f:real^M->real^N g k s. (!x. x IN s ==> (f(x) = g(x))) /\ (f has_integral k) s ==> (g has_integral k) s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP HAS_INTEGRAL_IS_0) MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN SIMP_TAC[VECTOR_ARITH `x - (x - y:real^N) = y`; ETA_AX; VECTOR_SUB_RZERO]);; let INTEGRABLE_EQ = prove (`!f:real^M->real^N g s. (!x. x IN s ==> (f(x) = g(x))) /\ f integrable_on s ==> g integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_EQ]);; let HAS_INTEGRAL_EQ_EQ = prove (`!f:real^M->real^N g k s. (!x. x IN s ==> (f(x) = g(x))) ==> ((f has_integral k) s <=> (g has_integral k) s)`, MESON_TAC[HAS_INTEGRAL_EQ]);; let HAS_INTEGRAL_NULL = prove (`!f:real^M->real^N a b. content(interval[a,b]) = &0 ==> (f has_integral vec 0) (interval[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 < e ==> x < e`) THEN ASM_REWRITE_TAC[NORM_EQ_0] THEN ASM_MESON_TAC[VSUM_CONTENT_NULL]);; let HAS_INTEGRAL_NULL_EQ = prove (`!f a b i. content(interval[a,b]) = &0 ==> ((f has_integral i) (interval[a,b]) <=> i = vec 0)`, ASM_MESON_TAC[INTEGRAL_UNIQUE; HAS_INTEGRAL_NULL]);; let INTEGRAL_NULL = prove (`!f a b. content(interval[a,b]) = &0 ==> integral(interval[a,b]) f = vec 0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_MESON_TAC[HAS_INTEGRAL_NULL]);; let INTEGRABLE_ON_NULL = prove (`!f a b. content(interval[a,b]) = &0 ==> f integrable_on interval[a,b]`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NULL]);; let HAS_INTEGRAL_EMPTY = prove (`!f. (f has_integral vec 0) {}`, MESON_TAC[HAS_INTEGRAL_NULL; CONTENT_EMPTY; EMPTY_AS_INTERVAL]);; let HAS_INTEGRAL_EMPTY_EQ = prove (`!f i. (f has_integral i) {} <=> i = vec 0`, MESON_TAC[HAS_INTEGRAL_UNIQUE; HAS_INTEGRAL_EMPTY]);; let INTEGRABLE_ON_EMPTY = prove (`!f. f integrable_on {}`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_EMPTY]);; let INTEGRAL_EMPTY = prove (`!f. integral {} f = vec 0`, MESON_TAC[EMPTY_AS_INTERVAL; INTEGRAL_UNIQUE; HAS_INTEGRAL_EMPTY]);; let HAS_INTEGRAL_REFL = prove (`!f a. (f has_integral vec 0) (interval[a,a])`, REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_NULL THEN SIMP_TAC[INTERVAL_SING; INTERIOR_CLOSED_INTERVAL; CONTENT_EQ_0_INTERIOR]);; let INTEGRABLE_ON_REFL = prove (`!f a. f integrable_on interval[a,a]`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_REFL]);; let INTEGRAL_REFL = prove (`!f a. integral (interval[a,a]) f = vec 0`, MESON_TAC[INTEGRAL_UNIQUE; HAS_INTEGRAL_REFL]);; (* ------------------------------------------------------------------------- *) (* Cauchy-type criterion for integrability. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_CAUCHY = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] <=> !e. &0 < e ==> ?d. gauge d /\ !p1 p2. p1 tagged_division_of interval[a,b] /\ d fine p1 /\ p2 tagged_division_of interval[a,b] /\ d fine p2 ==> norm(vsum p1 (\(x,k). content k % f x) - vsum p2 (\(x,k). content k % f x)) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on; has_integral] THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `y:real^N` (MP_TAC o SPEC `e / &2`)) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->real^M->real^M->bool` MP_TAC) THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN MP_TAC(GEN `n:num` (ISPECL [`\x. INTERS {(d:num->real^M->real^M->bool) i x | i IN 0..n}`; `a:real^M`; `b:real^M`] FINE_DIVISION_EXISTS)) THEN ASM_SIMP_TAC[GAUGE_INTERS; FINE_INTERS; FINITE_NUMSEG; SKOLEM_THM] THEN REWRITE_TAC[IN_NUMSEG; LE_0; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `p:num->(real^M#(real^M->bool))->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `cauchy (\n. vsum (p n) (\(x,k:real^M->bool). content k % (f:real^M->real^N) x))` MP_TAC THENL [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&m + &1)` THEN CONJ_TAC THENL [REWRITE_TAC[dist] THEN ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `(d:num->real^M->real^M->bool) (N1 + N2)` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `q:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_L THEN EXISTS_TAC `vsum (p(N1+N2:num)) (\(x,k:real^M->bool). content k % (f:real^M->real^N) x)` THEN CONJ_TAC THENL [REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&(N1 + N2) + &1)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Additivity of integral on abutting intervals. *) (* ------------------------------------------------------------------------- *) let INTERVAL_SPLIT = prove (`!a b:real^N c k. 1 <= k /\ k <= dimindex(:N) ==> interval[a,b] INTER {x | x$k <= c} = interval[a,(lambda i. if i = k then min (b$k) c else b$i)] /\ interval[a,b] INTER {x | x$k >= c} = interval[(lambda i. if i = k then max (a$k) c else a$i),b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_INTER; IN_ELIM_THM] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC(TAUT `(c ==> b) /\ (c ==> a) /\ (a /\ b ==> c) ==> (a /\ b <=> c)`) THEN (CONJ_TAC THENL [ASM_MESON_TAC[REAL_MAX_LE; REAL_LE_MIN; real_ge]; ALL_TAC]) THEN REWRITE_TAC[LEFT_AND_FORALL_THM; real_ge] THEN CONJ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN ASM_MESON_TAC[REAL_MAX_LE; REAL_LE_MIN]);; let CONTENT_SPLIT = prove (`!a b:real^N k. 1 <= k /\ k <= dimindex(:N) ==> content(interval[a,b]) = content(interval[a,b] INTER {x | x$k <= c}) + content(interval[a,b] INTER {x | x$k >= c})`, SIMP_TAC[INTERVAL_SPLIT; CONTENT_CLOSED_INTERVAL_CASES; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN REWRITE_TAC[REAL_ARITH `((a <= if p then b else c) <=> (p ==> a <= b) /\ (~p ==> a <= c)) /\ ((if p then b else c) <= a <=> (p ==> b <= a) /\ (~p ==> c <= a))`] THEN REWRITE_TAC[REAL_LE_MIN; REAL_MAX_LE] THEN REWRITE_TAC[MESON[] `(i = k ==> p i k) <=> (i = k ==> p i i)`] THEN REWRITE_TAC[TAUT `(p ==> a /\ b) /\ (~p ==> a) <=> a /\ (p ==> b)`] THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_CASES_TAC `!i. 1 <= i /\ i <= dimindex(:N) ==> (a:real^N)$i <= (b:real^N)$i` THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN REWRITE_TAC[MESON[] `(!i. P i ==> i = k ==> Q i) <=> (P k ==> Q k)`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `min b c = if c <= b then c else b`; REAL_ARITH `max a c = if a <= c then c else a`] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]) THEN REWRITE_TAC[MESON[] `(if i = k then a k else a i) = a i`] THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]] THEN SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN MATCH_MP_TAC(REAL_RING `p'' = p /\ p':real = p ==> (b - a) * p = (c - a) * p' + (b - c) * p''`) THEN CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE]);; let DIVISION_SPLIT_LEFT_INJ,DIVISION_SPLIT_RIGHT_INJ = (CONJ_PAIR o prove) (`(!d i k1 k2 k c. d division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\ k1 INTER {x | x$k <= c} = k2 INTER {x | x$k <= c} ==> content(k1 INTER {x:real^N | x$k <= c}) = &0) /\ (!d i k1 k2 k c. d division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\ k1 INTER {x | x$k >= c} = k2 INTER {x | x$k >= c} ==> content(k1 INTER {x:real^N | x$k >= c}) = &0)`, let lemma = prove (`!a b:real^N c k. 1 <= k /\ k <= dimindex(:N) ==> (content(interval[a,b] INTER {x | x$k <= c}) = &0 <=> interior(interval[a,b] INTER {x | x$k <= c}) = {}) /\ (content(interval[a,b] INTER {x | x$k >= c}) = &0 <=> interior(interval[a,b] INTER {x | x$k >= c}) = {})`, SIMP_TAC[INTERVAL_SPLIT; CONTENT_EQ_0_INTERIOR]) in REPEAT STRIP_TAC THEN REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (MP_TAC o CONJUNCT1) o CONJUNCT2) THEN DISCH_THEN(MP_TAC o SPECL [`k1:real^N->bool`; `k2:real^N->bool`]) THEN ASM_REWRITE_TAC[PAIR_EQ] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `k2:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N` (X_CHOOSE_THEN `v:real^N` SUBST_ALL_TAC)) THEN ASM_SIMP_TAC[lemma] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t = {} ==> u SUBSET s /\ u SUBSET t ==> u = {}`)) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]);; let TAGGED_DIVISION_SPLIT_LEFT_INJ = prove (`!d i x1 k1 x2 k2 k c. d tagged_division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ (x1,k1) IN d /\ (x2,k2) IN d /\ ~(k1 = k2) /\ k1 INTER {x | x$k <= c} = k2 INTER {x | x$k <= c} ==> content(k1 INTER {x:real^N | x$k <= c}) = &0`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ THEN EXISTS_TAC `IMAGE SND (d:(real^N#(real^N->bool))->bool)` THEN ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[SND]);; let TAGGED_DIVISION_SPLIT_RIGHT_INJ = prove (`!d i x1 k1 x2 k2 k c. d tagged_division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ (x1,k1) IN d /\ (x2,k2) IN d /\ ~(k1 = k2) /\ k1 INTER {x | x$k >= c} = k2 INTER {x | x$k >= c} ==> content(k1 INTER {x:real^N | x$k >= c}) = &0`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ THEN EXISTS_TAC `IMAGE SND (d:(real^N#(real^N->bool))->bool)` THEN ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[SND]);; let DIVISION_SPLIT = prove (`!p s:real^N->bool k c. p division_of s /\ 1 <= k /\ k <= dimindex(:N) ==> {l INTER {x | x$k <= c} |l| l IN p /\ ~(l INTER {x | x$k <= c} = {})} division_of (s INTER {x | x$k <= c}) /\ {l INTER {x | x$k >= c} |l| l IN p /\ ~(l INTER {x | x$k >= c} = {})} division_of (s INTER {x | x$k >= c})`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN SIMP_TAC[division_of; FINITE_IMAGE] THEN SIMP_TAC[SET_RULE `(!x. x IN {f x | P x} ==> Q x) <=> (!x. P x ==> Q (f x))`; MESON[] `(!x y. x IN s /\ y IN t /\ Q x y ==> P x y) <=> (!x. x IN s ==> !y. y IN t ==> Q x y ==> P x y)`; RIGHT_FORALL_IMP_THM] THEN REPEAT(MATCH_MP_TAC(TAUT `(a ==> a' /\ a'') /\ (b ==> b' /\ b'') ==> a /\ b ==> (a' /\ b') /\ (a'' /\ b'')`) THEN CONJ_TAC) THENL [ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = {})} = {y | y IN IMAGE f s /\ ~(y = {})}`] THEN SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE]; REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `l:real^N->bool` THEN DISCH_THEN(fun th -> CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN ASM_MESON_TAC[INTERVAL_SPLIT]); DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN (REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s' INTER t' = {} ==> s INTER t = {}`) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]); DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_UNIONS] THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS] THEN CONJ_TAC THEN GEN_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[NOT_IN_EMPTY]]);; let HAS_INTEGRAL_SPLIT = prove (`!f:real^M->real^N k a b c. (f has_integral i) (interval[a,b] INTER {x | x$k <= c}) /\ (f has_integral j) (interval[a,b] INTER {x | x$k >= c}) /\ 1 <= k /\ k <= dimindex(:M) ==> (f has_integral (i + j)) (interval[a,b])`, let lemma1 = prove (`(!x k. (x,k) IN {x,f k | P x k} ==> Q x k) <=> (!x k. P x k ==> Q x (f k))`, REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN SET_TAC[]) in let lemma2 = prove (`!f:B->B s:(A#B)->bool. FINITE s ==> FINITE {x,f k | (x,k) IN s /\ P x k}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\(x:A,k:B). x,(f k:B)) s` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; lemma1; IN_IMAGE] THEN REWRITE_TAC[EXISTS_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]) in let lemma3 = prove (`!f:real^M->real^N g:(real^M->bool)->(real^M->bool) p. FINITE p ==> vsum {x,g k |x,k| (x,k) IN p /\ ~(g k = {})} (\(x,k). content k % f x) = vsum (IMAGE (\(x,k). x,g k) p) (\(x,k). content k % f x)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM_SIMP_TAC[FINITE_IMAGE; lemma2] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; SUBSET; IN_IMAGE; EXISTS_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ; VECTOR_MUL_EQ_0] THEN MESON_TAC[CONTENT_EMPTY]) in let lemma4 = prove (`(\(x,l). content (g l) % f x) = (\(x,l). content l % f x) o (\(x,l). x,g l)`, REWRITE_TAC[FUN_EQ_THM; o_THM; FORALL_PAIR_THM]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN REWRITE_TAC[has_integral] THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN FIRST_X_ASSUM STRIP_ASSUME_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &2`) STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I2"))) THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I1"))) THEN EXISTS_TAC `\x. if x$k = c then (d1(x:real^M) INTER d2(x)):real^M->bool else ball(x,abs(x$k - c)) INTER d1(x) INTER d2(x)` THEN CONJ_TAC THENL [REWRITE_TAC[gauge] THEN GEN_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_INTER; IN_INTER; OPEN_BALL; IN_BALL] THEN ASM_REWRITE_TAC[DIST_REFL; GSYM REAL_ABS_NZ; REAL_SUB_0]; ALL_TAC] THEN X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `(!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {}) ==> x$k <= c) /\ (!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {}) ==> x$k >= c)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL; real_ge] THEN DISCH_THEN (MP_TAC o MATCH_MP (SET_RULE `k SUBSET (a INTER b) ==> k SUBSET a`)) THEN REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M` MP_TAC) THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((x - u:real^M)$k)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "I2" (MP_TAC o SPEC `{(x:real^M,kk INTER {x:real^M | x$k >= c}) |x,kk| (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {})}`) THEN REMOVE_THEN "I1" (MP_TAC o SPEC `{(x:real^M,kk INTER {x:real^M | x$k <= c}) |x,kk| (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {})}`) THEN MATCH_MP_TAC(TAUT `(a /\ b) /\ (a' /\ b' ==> c) ==> (a ==> a') ==> (b ==> b') ==> c`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN REPEAT(MATCH_MP_TAC(TAUT `(a ==> (a' /\ a'')) /\ (b ==> (b' /\ d) /\ (b'' /\ e)) ==> a /\ b ==> ((a' /\ b') /\ d) /\ ((a'' /\ b'') /\ e)`) THEN CONJ_TAC) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[lemma1] THEN REWRITE_TAC[IMP_IMP] THENL [SIMP_TAC[lemma2]; REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN DISCH_THEN(fun th -> CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN (MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[INTERVAL_SPLIT]; DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN (REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s' INTER t' = {} ==> s INTER t = {}`) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]); ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ d /\ e ==> (a ==> (b /\ d) /\ (c /\ e))`) THEN CONJ_TAC THENL [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_UNIONS] THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS] THEN X_GEN_TAC `x:real^M` THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `kk:real^M->bool` THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[NOT_IN_EMPTY]; ALL_TAC] THEN CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN REWRITE_TAC[fine; lemma1] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`)) THEN DISCH_THEN(MP_TAC o MATCH_MP NORM_TRIANGLE_LT) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_ARITH `(a - i) + (b - j) = c - (i + j) <=> a + b = c:real^N`] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum p (\(x,l). content (l INTER {x:real^M | x$k <= c}) % (f:real^M->real^N) x) + vsum p (\(x,l). content (l INTER {x:real^M | x$k >= c}) % (f:real^M->real^N) x)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[GSYM VSUM_ADD] THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM; GSYM VECTOR_ADD_RDISTRIB] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`] o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM CONTENT_SPLIT]] THEN ASM_SIMP_TAC[lemma3] THEN BINOP_TAC THEN (GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [lemma4] THEN MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[TAGGED_DIVISION_SPLIT_LEFT_INJ; VECTOR_MUL_LZERO; TAGGED_DIVISION_SPLIT_RIGHT_INJ]));; (* ------------------------------------------------------------------------- *) (* A sort of converse, integrability on subintervals. *) (* ------------------------------------------------------------------------- *) let TAGGED_DIVISION_UNION_INTERVAL = prove (`!a b:real^N p1 p2 c k. 1 <= k /\ k <= dimindex(:N) /\ p1 tagged_division_of (interval[a,b] INTER {x | x$k <= c}) /\ p2 tagged_division_of (interval[a,b] INTER {x | x$k >= c}) ==> (p1 UNION p2) tagged_division_of (interval[a,b])`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `interval[a,b] = (interval[a,b] INTER {x:real^N | x$k <= c}) UNION (interval[a,b] INTER {x:real^N | x$k >= c})` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `(t UNION u = UNIV) ==> s = (s INTER t) UNION (s INTER u)`) THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[INTERVAL_SPLIT; INTERIOR_CLOSED_INTERVAL] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_INTERVAL] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `k:num`)) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC);; let HAS_INTEGRAL_SEPARATE_SIDES = prove (`!f:real^M->real^N i a b k. (f has_integral i) (interval[a,b]) /\ 1 <= k /\ k <= dimindex(:M) ==> !e. &0 < e ==> ?d. gauge d /\ !p1 p2. p1 tagged_division_of (interval[a,b] INTER {x | x$k <= c}) /\ d fine p1 /\ p2 tagged_division_of (interval[a,b] INTER {x | x$k >= c}) /\ d fine p2 ==> norm((vsum p1 (\(x,k). content k % f x) + vsum p2 (\(x,k). content k % f x)) - i) < e`, REWRITE_TAC[has_integral] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `vsum p1 (\(x,k). content k % f x) + vsum p2 (\(x,k). content k % f x) = vsum (p1 UNION p2) (\(x,k:real^M->bool). content k % (f:real^M->real^N) x)` SUBST1_TAC THENL [ALL_TAC; ASM_MESON_TAC[TAGGED_DIVISION_UNION_INTERVAL; FINE_UNION]] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF])) THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN REWRITE_TAC[IN_INTER; VECTOR_MUL_EQ_0] THEN STRIP_TAC THEN DISJ1_TAC THEN SUBGOAL_THEN `(?a b:real^M. l = interval[a,b]) /\ l SUBSET (interval[a,b] INTER {x | x$k <= c}) /\ l SUBSET (interval[a,b] INTER {x | x$k >= c})` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[SET_RULE `s SUBSET t /\ s SUBSET u <=> s SUBSET (t INTER u)`] THEN ASM_SIMP_TAC[INTERVAL_SPLIT; INTER_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; CONTENT_EQ_0_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `t = {} ==> s SUBSET t ==> s = {}`) THEN REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC);; let INTEGRABLE_SPLIT = prove (`!f:real^M->real^N a b. f integrable_on (interval[a,b]) /\ 1 <= k /\ k <= dimindex(:M) ==> f integrable_on (interval[a,b] INTER {x | x$k <= c}) /\ f integrable_on (interval[a,b] INTER {x | x$k >= c})`, let lemma = prove (`b - a = c ==> norm(a:real^N) < e / &2 ==> norm(b) < e / &2 ==> norm(c) < e`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_L THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[dist; VECTOR_SUB_LZERO; VECTOR_SUB_RZERO; NORM_NEG]) in REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [integrable_on] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN CONJ_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT; INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `e / &2` o MATCH_MP HAS_INTEGRAL_SEPARATE_SIDES) THEN MAP_EVERY ABBREV_TAC [`b' = (lambda i. if i = k then min ((b:real^M)$k) c else b$i):real^M`; `a' = (lambda i. if i = k then max ((a:real^M)$k) c else a$i):real^M`] THEN ASM_SIMP_TAC[REAL_HALF; INTERVAL_SPLIT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THENL [DISCH_THEN(MP_TAC o SPECL [`a':real^M`; `b:real^M`]) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[SWAP_FORALL_THM]); DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b':real^M`])] THEN DISCH_THEN(X_CHOOSE_THEN `p:(real^M#(real^M->bool))->bool` STRIP_ASSUME_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`p:(real^M#(real^M->bool))->bool`; `p1:(real^M#(real^M->bool))->bool`] th) THEN MP_TAC(SPECL [`p:(real^M#(real^M->bool))->bool`; `p2:(real^M#(real^M->bool))->bool`] th)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma THEN VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Generalized notion of additivity. *) (* ------------------------------------------------------------------------- *) let operative = new_definition `operative op (f:(real^N->bool)->A) <=> (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = neutral(op)) /\ (!a b c k. 1 <= k /\ k <= dimindex(:N) ==> f(interval[a,b]) = op (f(interval[a,b] INTER {x | x$k <= c})) (f(interval[a,b] INTER {x | x$k >= c})))`;; let OPERATIVE_TRIVIAL = prove (`!op f a b. operative op f /\ content(interval[a,b]) = &0 ==> f(interval[a,b]) = neutral op`, REWRITE_TAC[operative] THEN MESON_TAC[]);; let PROPERTY_EMPTY_INTERVAL = prove (`!P. (!a b:real^N. content(interval[a,b]) = &0 ==> P(interval[a,b])) ==> P {}`, MESON_TAC[EMPTY_AS_INTERVAL; CONTENT_EMPTY]);; let OPERATIVE_EMPTY = prove (`!op f:(real^N->bool)->A. operative op f ==> f {} = neutral op`, REPEAT GEN_TAC THEN REWRITE_TAC[operative] THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP PROPERTY_EMPTY_INTERVAL o CONJUNCT1));; (* ------------------------------------------------------------------------- *) (* Using additivity of lifted function to encode definedness. *) (* ------------------------------------------------------------------------- *) let FORALL_OPTION = prove (`(!x. P x) <=> P NONE /\ !x. P(SOME x)`, MESON_TAC[cases "option"]);; let EXISTS_OPTION = prove (`(?x. P x) <=> P NONE \/ ?x. P(SOME x)`, MESON_TAC[cases "option"]);; let lifted = define `(lifted op NONE _ = NONE) /\ (lifted op _ NONE = NONE) /\ (lifted op (SOME x) (SOME y) = SOME(op x y))`;; let NEUTRAL_LIFTED = prove (`!op. monoidal op ==> neutral(lifted op) = SOME(neutral op)`, REWRITE_TAC[neutral; monoidal] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[FORALL_OPTION; lifted; distinctness "option"; injectivity "option"] THEN ASM_MESON_TAC[]);; let MONOIDAL_LIFTED = prove (`!op. monoidal op ==> monoidal(lifted op)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NEUTRAL_LIFTED; monoidal] THEN REWRITE_TAC[FORALL_OPTION; lifted; distinctness "option"; injectivity "option"] THEN ASM_MESON_TAC[monoidal]);; let ITERATE_SOME = prove (`!op. monoidal op ==> !f s. FINITE s ==> iterate (lifted op) s (\x. SOME(f x)) = SOME(iterate op s f)`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_LIFTED; NEUTRAL_LIFTED] THEN REWRITE_TAC[lifted]);; (* ------------------------------------------------------------------------- *) (* Two key instances of additivity. *) (* ------------------------------------------------------------------------- *) let OPERATIVE_CONTENT = prove (`operative(+) content`, REWRITE_TAC[operative; NEUTRAL_REAL_ADD; CONTENT_SPLIT]);; let OPERATIVE_INTEGRAL = prove (`!f:real^M->real^N. operative(lifted(+)) (\i. if f integrable_on i then SOME(integral i f) else NONE)`, SIMP_TAC[operative; NEUTRAL_LIFTED; MONOIDAL_VECTOR_ADD] THEN REWRITE_TAC[NEUTRAL_VECTOR_ADD] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[lifted; distinctness "option"; injectivity "option"] THENL [REWRITE_TAC[integral] THEN ASM_MESON_TAC[HAS_INTEGRAL_NULL_EQ]; RULE_ASSUM_TAC(REWRITE_RULE[integrable_on]) THEN ASM_MESON_TAC[HAS_INTEGRAL_NULL]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL)) THEN ASM_MESON_TAC[HAS_INTEGRAL_SPLIT; HAS_INTEGRAL_UNIQUE]; ASM_MESON_TAC[INTEGRABLE_SPLIT; integrable_on]; ASM_MESON_TAC[INTEGRABLE_SPLIT]; ASM_MESON_TAC[INTEGRABLE_SPLIT]; RULE_ASSUM_TAC(REWRITE_RULE[integrable_on]) THEN ASM_MESON_TAC[HAS_INTEGRAL_SPLIT]]);; (* ------------------------------------------------------------------------- *) (* Points of division of a partition. *) (* ------------------------------------------------------------------------- *) let division_points = new_definition `division_points (k:real^N->bool) (d:(real^N->bool)->bool) = {j,x | 1 <= j /\ j <= dimindex(:N) /\ (interval_lowerbound k)$j < x /\ x < (interval_upperbound k)$j /\ ?i. i IN d /\ ((interval_lowerbound i)$j = x \/ (interval_upperbound i)$j = x)}`;; let DIVISION_POINTS_FINITE = prove (`!d i:real^N->bool. d division_of i ==> FINITE(division_points i d)`, REWRITE_TAC[division_of; division_points] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CONJ_ASSOC; GSYM IN_NUMSEG] THEN REWRITE_TAC[IN; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(REWRITE_RULE[IN] FINITE_PRODUCT_DEPENDENT) THEN REWRITE_TAC[ETA_AX; FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN GEN_REWRITE_TAC LAND_CONV [GSYM IN] THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\i:real^N->bool. (interval_lowerbound i)$j) d UNION IMAGE (\i:real^N->bool. (interval_upperbound i)$j) d` THEN ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[IN]);; let DIVISION_POINTS_SUBSET = prove (`!a b:real^N c d k. d division_of interval[a,b] /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i) /\ 1 <= k /\ k <= dimindex(:N) /\ a$k < c /\ c < b$k ==> division_points (interval[a,b] INTER {x | x$k <= c}) {l INTER {x | x$k <= c} | l | l IN d /\ ~(l INTER {x | x$k <= c} = {})} SUBSET division_points (interval[a,b]) d /\ division_points (interval[a,b] INTER {x | x$k >= c}) {l INTER {x | x$k >= c} | l | l IN d /\ ~(l INTER {x | x$k >= c} = {})} SUBSET division_points (interval[a,b]) d`, REPEAT STRIP_TAC THEN (REWRITE_TAC[SUBSET; division_points; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`j:num`; `x:real`] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[INTERVAL_SPLIT; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; REAL_ARITH `c < b ==> min b c = c`] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; LAMBDA_BETA; REAL_LT_IMP_LE; COND_ID; TAUT `(a <= if p then x else y) <=> (if p then a <= x else a <= y)`; TAUT `(if p then x else y) <= a <=> (if p then x <= a else y <= a)`] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [DISCH_THEN(K ALL_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> (u:real^N)$i <= (v:real^N)$i` ASSUME_TAC THENL [REWRITE_TAC[GSYM INTERVAL_NE_EMPTY] THEN ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REPEAT(POP_ASSUM MP_TAC) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC));; let DIVISION_POINTS_PSUBSET = prove (`!a b:real^N c d k. d division_of interval[a,b] /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i) /\ 1 <= k /\ k <= dimindex(:N) /\ a$k < c /\ c < b$k /\ (?l. l IN d /\ (interval_lowerbound l$k = c \/ interval_upperbound l$k = c)) ==> division_points (interval[a,b] INTER {x | x$k <= c}) {l INTER {x | x$k <= c} | l | l IN d /\ ~(l INTER {x | x$k <= c} = {})} PSUBSET division_points (interval[a,b]) d /\ division_points (interval[a,b] INTER {x | x$k >= c}) {l INTER {x | x$k >= c} | l | l IN d /\ ~(l INTER {x | x$k >= c} = {})} PSUBSET division_points (interval[a,b]) d`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[PSUBSET_MEMBER; DIVISION_POINTS_SUBSET] THENL [EXISTS_TAC `k,(interval_lowerbound l:real^N)$k`; EXISTS_TAC `k,(interval_lowerbound l:real^N)$k`; EXISTS_TAC `k,(interval_upperbound l:real^N)$k`; EXISTS_TAC `k,(interval_upperbound l:real^N)$k`] THEN ASM_REWRITE_TAC[division_points; IN_ELIM_PAIR_THM] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[INTERVAL_SPLIT; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; REAL_ARITH `c < b ==> min b c = c`] THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; LAMBDA_BETA; REAL_LT_IMP_LE; COND_ID; TAUT `(a <= if p then x else y) <=> (if p then a <= x else a <= y)`; TAUT `(if p then x else y) <= a <=> (if p then x <= a else y <= a)`] THEN REWRITE_TAC[REAL_LT_REFL]);; (* ------------------------------------------------------------------------- *) (* Preservation by divisions and tagged divisions. *) (* ------------------------------------------------------------------------- *) let OPERATIVE_DIVISION = prove (`!op d a b f:(real^N->bool)->A. monoidal op /\ operative op f /\ d division_of interval[a,b] ==> iterate(op) d f = f(interval[a,b])`, REPEAT GEN_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN WF_INDUCT_TAC `CARD (division_points (interval[a,b]:real^N->bool) d)` THEN POP_ASSUM(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `content(interval[a:real^N,b]) = &0` THENL [SUBGOAL_THEN `iterate op d (f:(real^N->bool)->A) = neutral op` (fun th -> ASM_MESON_TAC[th; operative]) THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] ITERATE_EQ_NEUTRAL) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN ASM_MESON_TAC[operative; DIVISION_OF_CONTENT_0]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_CASES_TAC `division_points (interval[a,b]:real^N->bool) d = {}` THENL [DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `!i. i IN d ==> ?u v:real^N. i = interval[u,v] /\ !j. 1 <= j /\ j <= dimindex(:N) ==> u$j = (a:real^N)$j /\ v$j = a$j \/ u$j = (b:real^N)$j /\ v$j = b$j \/ u$j = a$j /\ v$j = b$j` (LABEL_TAC "*") THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`u:real^N`; `v:real^N`] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `interval[u:real^N,v]` o CONJUNCT1) THEN ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (ASSUME_TAC o CONJUNCT1)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `a <= u /\ u <= v /\ v <= b /\ ~(a < u /\ u < b \/ a < v /\ v < b) ==> u = a /\ v = a \/ u = b /\ v = b \/ u = a /\ v = b`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[division_points; NOT_IN_EMPTY; FORALL_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `interval[u:real^N,v]`) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_LT_IMP_LE] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `(u:real^N)$j` th) THEN MP_TAC(SPEC `(v:real^N)$j` th)) THEN FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `interval[a:real^N,b] IN d` MP_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_UNIONS] THEN DISCH_THEN(MP_TAC o SPEC `inv(&2) % (a + b:real^N)`) THEN MATCH_MP_TAC(TAUT `b /\ (a ==> c) ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL [SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `i:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REMOVE_THEN "*" (MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN ASM_SIMP_TAC[REAL_ARITH `a < b ==> ((u = a /\ v = a \/ u = b /\ v = b \/ u = a /\ v = b) /\ u <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= v <=> u = a /\ v = b)`] THEN ASM_MESON_TAC[CART_EQ]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE `a IN d ==> d = a INSERT (d DELETE a)`)) THEN ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_DELETE; IN_DELETE] THEN SUBGOAL_THEN `iterate op (d DELETE interval[a,b]) (f:(real^N->bool)->A) = neutral op` (fun th -> ASM_MESON_TAC[th; monoidal]) THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] ITERATE_EQ_NEUTRAL) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `l:real^N->bool` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN SUBGOAL_THEN `content(l:real^N->bool) = &0` (fun th -> ASM_MESON_TAC[th; operative]) THEN REMOVE_THEN "*" (MP_TAC o SPEC `l:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN UNDISCH_TAC `~(interval[u:real^N,v] = interval[a,b])` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN(fun th -> AP_TERM_TAC THEN MP_TAC th) THEN REWRITE_TAC[CONS_11; PAIR_EQ; CART_EQ; CONTENT_EQ_0] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `a ==> b <=> ~a \/ b`] THEN REWRITE_TAC[NOT_FORALL_THM; OR_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `j:num` THEN ASM_CASES_TAC `1 <= j /\ j <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [division_points] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`whatever:num#real`; `k:num`; `c:real`] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (K ALL_TAC)) THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `c:real`; `d:(real^N->bool)->bool`; `k:num`] DIVISION_POINTS_PSUBSET) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] CARD_PSUBSET))) THEN MP_TAC(ISPECL [`d:(real^N->bool)->bool`; `interval[a:real^N,b]`; `k:num`; `c:real`] DIVISION_SPLIT) THEN ASM_SIMP_TAC[DIVISION_POINTS_FINITE] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; REAL_ARITH `c < b ==> min b c = c`] THEN MAP_EVERY ABBREV_TAC [`d1:(real^N->bool)->bool = {l INTER {x | x$k <= c} | l | l IN d /\ ~(l INTER {x | x$k <= c} = {})}`; `d2:(real^N->bool)->bool = {l INTER {x | x$k >= c} | l | l IN d /\ ~(l INTER {x | x$k >= c} = {})}`; `cb:real^N = (lambda i. if i = k then c else (b:real^N)$i)`; `ca:real^N = (lambda i. if i = k then c else (a:real^N)$i)`] THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`a:real^N`; `cb:real^N`; `d1:(real^N->bool)->bool`] th) THEN MP_TAC(SPECL [`ca:real^N`; `b:real^N`; `d2:(real^N->bool)->bool`] th)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `op (iterate op d1 (f:(real^N->bool)->A)) (iterate op d2 (f:(real^N->bool)->A))` THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [operative]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `c:real`; `k:num`]) THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; REAL_ARITH `c < b ==> min b c = c`]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `op (iterate op d (\l. f(l INTER {x | x$k <= c}):A)) (iterate op d (\l. f(l INTER {x:real^N | x$k >= c})))` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[GSYM ITERATE_OP] THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] ITERATE_EQ) THEN ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION (ASSUME `d division_of interval[a:real^N,b]`)] THEN ASM_MESON_TAC[operative]] THEN MAP_EVERY EXPAND_TAC ["d1"; "d2"] THEN BINOP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC ITERATE_NONZERO_IMAGE_LEMMA THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [ASM_MESON_TAC[OPERATIVE_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`l:real^N->bool`; `m:real^N->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[OPERATIVE_TRIVIAL] `operative op f /\ (?a b. l = interval[a,b]) /\ content l = &0 ==> f l = neutral op`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_SPLIT_LEFT_INJ; DIVISION_SPLIT_RIGHT_INJ]] THEN SUBGOAL_THEN `?a b:real^N. m = interval[a,b]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]));; let OPERATIVE_TAGGED_DIVISION = prove (`!op d a b f:(real^N->bool)->A. monoidal op /\ operative op f /\ d tagged_division_of interval[a,b] ==> iterate(op) d (\(x,l). f l) = f(interval[a,b])`, let lemma = prove (`(\(x,l). f l) = (f o SND)`, REWRITE_TAC[FUN_EQ_THM; o_THM; FORALL_PAIR_THM]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `iterate op (IMAGE SND (d:(real^N#(real^N->bool)->bool))) f :A` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_OF_TAGGED_DIVISION; OPERATIVE_DIVISION]] THEN REWRITE_TAC[lemma] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] ITERATE_IMAGE_NONZERO) THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF_FINITE]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1 o CONJUNCT2)) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[PAIR_EQ] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[INTER_ACI] THEN ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR; OPERATIVE_TRIVIAL; TAGGED_DIVISION_OF]);; (* ------------------------------------------------------------------------- *) (* Additivity of content. *) (* ------------------------------------------------------------------------- *) let ADDITIVE_CONTENT_DIVISION = prove (`!d a b:real^N. d division_of interval[a,b] ==> sum d content = content(interval[a,b])`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] OPERATIVE_DIVISION) (CONJ MONOIDAL_REAL_ADD OPERATIVE_CONTENT))) THEN REWRITE_TAC[sum]);; let ADDITIVE_CONTENT_TAGGED_DIVISION = prove (`!d a b:real^N. d tagged_division_of interval[a,b] ==> sum d (\(x,l). content l) = content(interval[a,b])`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] OPERATIVE_TAGGED_DIVISION) (CONJ MONOIDAL_REAL_ADD OPERATIVE_CONTENT))) THEN REWRITE_TAC[sum]);; let SUBADDITIVE_CONTENT_DIVISION = prove (`!d s a b:real^M. d division_of s /\ s SUBSET interval[a,b] ==> sum d content <= content(interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`d:(real^M->bool)->bool`; `a:real^M`; `b:real^M`] PARTIAL_DIVISION_EXTEND_INTERVAL) THEN ANTS_TAC THENL [REWRITE_TAC[UNIONS_SUBSET] THEN ASM_MESON_TAC[division_of; DIVISION_OF_UNION_SELF; SUBSET_TRANS]; DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (p:(real^M->bool)->bool) content` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_MESON_TAC[division_of; CONTENT_POS_LE; IN_DIFF]; ASM_MESON_TAC[ADDITIVE_CONTENT_DIVISION; REAL_LE_REFL]]]);; (* ------------------------------------------------------------------------- *) (* Finally, the integral of a constant! *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_CONST = prove (`!a b:real^M c:real^N. ((\x. c) has_integral (content(interval[a,b]) % c)) (interval[a,b])`, REWRITE_TAC[has_integral] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP ADDITIVE_CONTENT_TAGGED_DIVISION th)]) THEN ASM_SIMP_TAC[VSUM_VMUL; GSYM VSUM_SUB] THEN REWRITE_TAC[LAMBDA_PAIR_THM; VECTOR_SUB_REFL] THEN ASM_REWRITE_TAC[GSYM LAMBDA_PAIR_THM; VSUM_0; NORM_0]);; let INTEGRABLE_CONST = prove (`!a b:real^M c:real^N. (\x. c) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN EXISTS_TAC `content(interval[a:real^M,b]) % c:real^N` THEN REWRITE_TAC[HAS_INTEGRAL_CONST]);; let INTEGRAL_CONST = prove (`!a b c. integral (interval[a,b]) (\x. c) = content(interval[a,b]) % c`, REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_INTEGRAL_CONST]);; let INTEGRAL_PASTECART_CONST = prove (`!a b:real^M c d:real^N k:real^P. integral (interval[pastecart a c,pastecart b d]) (\x. k) = integral (interval[a,b]) (\x. integral (interval[c,d]) (\y. k))`, REWRITE_TAC[INTEGRAL_CONST; CONTENT_PASTECART; VECTOR_MUL_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Bounds on the norm of Riemann sums and the integral itself. *) (* ------------------------------------------------------------------------- *) let DSUM_BOUND = prove (`!p a b:real^M c:real^N e. p division_of interval[a,b] /\ norm(c) <= e ==> norm(vsum p (\l. content l % c)) <= e * content(interval[a,b])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `y <= e ==> x <= y ==> x <= e`) THEN REWRITE_TAC[LAMBDA_PAIR_THM; NORM_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum p (\k:real^M->bool. content k * e)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN X_GEN_TAC `l:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; NORM_POS_LE] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(x) <= x`) THEN ASM_MESON_TAC[DIVISION_OF; CONTENT_POS_LE]; REWRITE_TAC[SUM_RMUL; ETA_AX] THEN ASM_MESON_TAC[ADDITIVE_CONTENT_DIVISION; REAL_LE_REFL; REAL_MUL_SYM]]);; let RSUM_BOUND = prove (`!p a b f:real^M->real^N e. p tagged_division_of interval[a,b] /\ (!x. x IN interval[a,b] ==> norm(f x) <= e) ==> norm(vsum p (\(x,k). content k % f x)) <= e * content(interval[a,b])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `y <= e ==> x <= y ==> x <= e`) THEN REWRITE_TAC[LAMBDA_PAIR_THM; NORM_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum p (\(x:real^M,k:real^M->bool). content k * e)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; NORM_POS_LE] THEN CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE; REAL_ABS_REFL; REAL_LE_REFL]; ASM_MESON_TAC[TAG_IN_INTERVAL]]; FIRST_ASSUM(fun th -> REWRITE_TAC [GSYM(MATCH_MP ADDITIVE_CONTENT_TAGGED_DIVISION th)]) THEN REWRITE_TAC[GSYM SUM_LMUL; LAMBDA_PAIR_THM] THEN REWRITE_TAC[REAL_MUL_AC; REAL_LE_REFL]]);; let RSUM_DIFF_BOUND = prove (`!p a b f g:real^M->real^N. p tagged_division_of interval[a,b] /\ (!x. x IN interval[a,b] ==> norm(f x - g x) <= e) ==> norm(vsum p (\(x,k). content k % f x) - vsum p (\(x,k). content k % g x)) <= e * content(interval[a,b])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum p (\(x,k). content(k:real^M->bool) % ((f:real^M->real^N) x - g x)))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM VSUM_SUB; VECTOR_SUB_LDISTRIB] THEN REWRITE_TAC[LAMBDA_PAIR_THM; REAL_LE_REFL]; ASM_SIMP_TAC[RSUM_BOUND]]);; let HAS_INTEGRAL_BOUND = prove (`!f:real^M->real^N a b i B. &0 <= B /\ (f has_integral i) (interval[a,b]) /\ (!x. x IN interval[a,b] ==> norm(f x) <= B) ==> norm i <= B * content(interval[a,b])`, let lemma = prove (`norm(s) <= B ==> ~(norm(s - i) < norm(i) - B)`, MATCH_MP_TAC(REAL_ARITH `n1 <= n + n2 ==> n <= B ==> ~(n2 < n1 - B)`) THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[NORM_TRIANGLE_SUB]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < content(interval[a:real^M,b])` THENL [ALL_TAC; SUBGOAL_THEN `i:real^N = vec 0` SUBST1_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_0; CONTENT_POS_LE] THEN ASM_MESON_TAC[HAS_INTEGRAL_NULL_EQ; CONTENT_LT_NZ]] THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN DISCH_THEN(MP_TAC o SPEC `norm(i:real^N) - B * content(interval[a:real^M,b])`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d:real^M->real^M->bool`; `a:real^M`; `b:real^M`] FINE_DIVISION_EXISTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `p:(real^M#(real^M->bool)->bool)` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool)->bool)`) THEN ASM_MESON_TAC[lemma; RSUM_BOUND]);; (* ------------------------------------------------------------------------- *) (* Similar theorems about relationship among components. *) (* ------------------------------------------------------------------------- *) let RSUM_COMPONENT_LE = prove (`!p a b f:real^M->real^N g:real^M->real^N. p tagged_division_of interval[a,b] /\ 1 <= i /\ i <= dimindex(:N) /\ (!x. x IN interval[a,b] ==> (f x)$i <= (g x)$i) ==> vsum p (\(x,k). content k % f x)$i <= vsum p (\(x,k). content k % g x)$i`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_COMPONENT] THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FORALL_PAIR_THM; VECTOR_MUL_COMPONENT] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN ASM_MESON_TAC[SUBSET; REAL_LE_LMUL; CONTENT_POS_LE]);; let HAS_INTEGRAL_COMPONENT_LE = prove (`!f:real^M->real^N g:real^M->real^N s i j k. 1 <= k /\ k <= dimindex(:N) /\ (f has_integral i) s /\ (g has_integral j) s /\ (!x. x IN s ==> (f x)$k <= (g x)$k) ==> i$k <= j$k`, SUBGOAL_THEN `!f:real^M->real^N g:real^M->real^N a b i j k. 1 <= k /\ k <= dimindex(:N) /\ (f has_integral i) (interval[a,b]) /\ (g has_integral j) (interval[a,b]) /\ (!x. x IN interval[a,b] ==> (f x)$k <= (g x)$k) ==> i$k <= j$k` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < i - j) ==> i <= j`) THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `((i:real^N)$k - (j:real^N)$k) / &3` o GEN_REWRITE_RULE I [has_integral])) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?p. p tagged_division_of interval[a:real^M,b] /\ d1 fine p /\ d2 fine p` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM FINE_INTER] THEN MATCH_MP_TAC FINE_DIVISION_EXISTS THEN ASM_SIMP_TAC[GAUGE_INTER]; ALL_TAC] THEN REPEAT (FIRST_X_ASSUM(MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN DISCH_THEN(MP_TAC o SPEC `k:num` o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT]) THEN SUBGOAL_THEN `vsum p (\(x,l:real^M->bool). content l % (f:real^M->real^N) x)$k <= vsum p (\(x,l). content l % (g:real^M->real^N) x)$k` MP_TAC THENL [MATCH_MP_TAC RSUM_COMPONENT_LE THEN ASM_MESON_TAC[]; UNDISCH_TAC `&0 < (i:real^N)$k - (j:real^N)$k` THEN SPEC_TAC(`vsum p (\(x:real^M,l:real^M->bool). content l % (f x):real^N)$k`, `fs:real`) THEN SPEC_TAC(`vsum p (\(x:real^M,l:real^M->bool). content l % (g x):real^N)$k`, `gs:real`) THEN REAL_ARITH_TAC]; ALL_TAC] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `((i:real^N)$k - (j:real^N)$k) / &2`)) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `ball(vec 0,B1) UNION ball(vec 0:real^M,B2)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[BOUNDED_UNION; BOUNDED_BALL; UNION_SUBSET; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(z:real^N)$k <= (w:real^N)$k` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`(\x. if x IN s then f x else vec 0):real^M->real^N`; `(\x. if x IN s then g x else vec 0):real^M->real^N`; `a:real^M`; `b:real^M`] THEN ASM_MESON_TAC[REAL_LE_REFL]; MP_TAC(ISPECL [`w - j:real^N`; `k:num`] COMPONENT_LE_NORM) THEN MP_TAC(ISPECL [`z - i:real^N`; `k:num`] COMPONENT_LE_NORM) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; ASSUME `1 <= k`; ASSUME `k <= dimindex(:N)`] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN NORM_ARITH_TAC]);; let INTEGRAL_COMPONENT_LE = prove (`!f:real^M->real^N g:real^M->real^N s k. 1 <= k /\ k <= dimindex(:N) /\ f integrable_on s /\ g integrable_on s /\ (!x. x IN s ==> (f x)$k <= (g x)$k) ==> (integral s f)$k <= (integral s g)$k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let HAS_INTEGRAL_DROP_LE = prove (`!f:real^M->real^1 g:real^M->real^1 s i j. (f has_integral i) s /\ (g has_integral j) s /\ (!x. x IN s ==> drop(f x) <= drop(g x)) ==> drop i <= drop j`, REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; let INTEGRAL_DROP_LE = prove (`!f:real^M->real^1 g:real^M->real^1 s. f integrable_on s /\ g integrable_on s /\ (!x. x IN s ==> drop(f x) <= drop(g x)) ==> drop(integral s f) <= drop(integral s g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_LE THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let HAS_INTEGRAL_COMPONENT_POS = prove (`!f:real^M->real^N s i k. 1 <= k /\ k <= dimindex(:N) /\ (f has_integral i) s /\ (!x. x IN s ==> &0 <= (f x)$k) ==> &0 <= i$k`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\x. vec 0):real^M->real^N`; `f:real^M->real^N`; `s:real^M->bool`; `vec 0:real^N`; `i:real^N`; `k:num`] HAS_INTEGRAL_COMPONENT_LE) THEN ASM_SIMP_TAC[VEC_COMPONENT; HAS_INTEGRAL_0]);; let INTEGRAL_COMPONENT_POS = prove (`!f:real^M->real^N s k. 1 <= k /\ k <= dimindex(:N) /\ f integrable_on s /\ (!x. x IN s ==> &0 <= (f x)$k) ==> &0 <= (integral s f)$k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_POS THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let HAS_INTEGRAL_DROP_POS = prove (`!f:real^M->real^1 s i. (f has_integral i) s /\ (!x. x IN s ==> &0 <= drop(f x)) ==> &0 <= drop i`, REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_POS THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; let INTEGRAL_DROP_POS = prove (`!f:real^M->real^1 s. f integrable_on s /\ (!x. x IN s ==> &0 <= drop(f x)) ==> &0 <= drop(integral s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let HAS_INTEGRAL_COMPONENT_NEG = prove (`!f:real^M->real^N s i k. 1 <= k /\ k <= dimindex(:N) /\ (f has_integral i) s /\ (!x. x IN s ==> (f x)$k <= &0) ==> i$k <= &0`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(\x. vec 0):real^M->real^N`; `s:real^M->bool`; `i:real^N`; `vec 0:real^N`; `k:num`] HAS_INTEGRAL_COMPONENT_LE) THEN ASM_SIMP_TAC[VEC_COMPONENT; HAS_INTEGRAL_0]);; let HAS_INTEGRAL_DROP_NEG = prove (`!f:real^M->real^1 s i. (f has_integral i) s /\ (!x. x IN s ==> drop(f x) <= &0) ==> drop i <= &0`, REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_NEG THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; let HAS_INTEGRAL_COMPONENT_LBOUND = prove (`!f:real^M->real^N a b i k. (f has_integral i) (interval[a,b]) /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN interval[a,b] ==> B <= f(x)$k) ==> B * content(interval[a,b]) <= i$k`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\x. lambda i. B):real^M->real^N`; `f:real^M->real^N`; `interval[a:real^M,b]`; `content(interval[a:real^M,b]) % (lambda i. B):real^N`; `i:real^N`; `k:num`] HAS_INTEGRAL_COMPONENT_LE) THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; HAS_INTEGRAL_CONST] THEN REWRITE_TAC[REAL_MUL_AC]);; let HAS_INTEGRAL_COMPONENT_UBOUND = prove (`!f:real^M->real^N a b i k. (f has_integral i) (interval[a,b]) /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN interval[a,b] ==> f(x)$k <= B) ==> i$k <= B * content(interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(\x. lambda i. B):real^M->real^N`; `interval[a:real^M,b]`; `i:real^N`; `content(interval[a:real^M,b]) % (lambda i. B):real^N`; `k:num`] HAS_INTEGRAL_COMPONENT_LE) THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; HAS_INTEGRAL_CONST] THEN REWRITE_TAC[REAL_MUL_AC]);; let INTEGRAL_COMPONENT_LBOUND = prove (`!f:real^M->real^N a b k. f integrable_on interval[a,b] /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN interval[a,b] ==> B <= f(x)$k) ==> B * content(interval[a,b]) <= (integral(interval[a,b]) f)$k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LBOUND THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; let INTEGRAL_COMPONENT_UBOUND = prove (`!f:real^M->real^N a b k. f integrable_on interval[a,b] /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN interval[a,b] ==> f(x)$k <= B) ==> (integral(interval[a,b]) f)$k <= B * content(interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_UBOUND THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; (* ------------------------------------------------------------------------- *) (* Uniform limit of integrable functions is integrable. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_UNIFORM_LIMIT = prove (`!f a b. (!e. &0 < e ==> ?g. (!x. x IN interval[a,b] ==> norm(f x - g x) <= e) /\ g integrable_on interval[a,b] ) ==> (f:real^M->real^N) integrable_on interval[a,b]`, let lemma = prove (`x <= norm(a + b) + c ==> x <= norm(a) + norm(b) + c`, MESON_TAC[REAL_ADD_AC; NORM_TRIANGLE; REAL_LE_TRANS; REAL_LE_RADD]) in let (lemma1,lemma2) = (CONJ_PAIR o prove) (`(norm(s2 - s1) <= e / &2 /\ norm(s1 - i1) < e / &4 /\ norm(s2 - i2) < e / &4 ==> norm(i1 - i2) < e) /\ (norm(sf - sg) <= e / &3 ==> norm(i - s) < e / &3 ==> norm(sg - i) < e / &3 ==> norm(sf - s) < e)`, CONJ_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `w <= x + y + z + &0 ==> (x <= e / &2 /\ y < e / &4) /\ z < e / &4 ==> w < e`); MATCH_MP_TAC(REAL_ARITH `w <= x + y + z + &0 ==> x <= e / &3 ==> y < e / &3 ==> z < e / &3 ==> w < e`)] THEN REPEAT(MATCH_MP_TAC lemma) THEN REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < content(interval[a:real^M,b])` THENL [ALL_TAC; ASM_MESON_TAC[HAS_INTEGRAL_NULL; CONTENT_LT_NZ; integrable_on]] THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM; integrable_on] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `i:num->real^N`))) THEN SUBGOAL_THEN `cauchy(i:num->real^N)` MP_TAC THENL [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &4 / content(interval[a:real^M,b])` REAL_ARCH_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [has_integral]) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `m:num` th) THEN MP_TAC(SPEC `n:num` th)) THEN DISCH_THEN(X_CHOOSE_THEN `gn:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `gm:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(\x. gm(x) INTER gn(x)):real^M->real^M->bool`; `a:real^M`; `b:real^M`] FINE_DIVISION_EXISTS) THEN ASM_SIMP_TAC[GAUGE_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`)) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[CONV_RULE(REWR_CONV FINE_INTER) th]) THEN SUBGOAL_THEN `norm(vsum p (\(x,k:real^M->bool). content k % g (n:num) x) - vsum p (\(x:real^M,k). content k % g m x :real^N)) <= e / &2` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[dist] THEN MESON_TAC[lemma1]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &N * content(interval[a:real^M,b])` THEN CONJ_TAC THENL [MATCH_MP_TAC RSUM_DIFF_BOUND; ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`n:num`; `x:real^M`] th) THEN MP_TAC(SPECL [`m:num`; `x:real^M`] th)) THEN ASM_REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [NORM_SUB] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2) THEN DISCH_THEN(MP_TAC o MATCH_MP NORM_TRIANGLE_LE) THEN MATCH_MP_TAC(REAL_ARITH `u = v /\ a <= inv(x) /\ b <= inv(x) ==> u <= a + b ==> v <= &2 / x`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^N` THEN DISCH_TAC THEN REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3` o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN ASM_SIMP_TAC[dist; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN MP_TAC(SPEC `e / &3 / content(interval[a:real^M,b])` REAL_ARCH_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [has_integral]) THEN DISCH_THEN(MP_TAC o SPECL [`N1 + N2:num`; `e / &3`]) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `N1:num <= N1 + N2`)) THEN MATCH_MP_TAC lemma2 THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&(N1 + N2) + &1) * content(interval[a:real^M,b])` THEN CONJ_TAC THENL [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> y <= x ==> y <= a`)) THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Negligible sets. *) (* ------------------------------------------------------------------------- *) let negligible = new_definition `negligible s <=> !a b. (indicator s has_integral (vec 0)) (interval[a,b])`;; (* ------------------------------------------------------------------------- *) (* Negligibility of hyperplane. *) (* ------------------------------------------------------------------------- *) let VSUM_NONZERO_IMAGE_LEMMA = prove (`!s f:A->B g:B->real^N a. FINITE s /\ g(a) = vec 0 /\ (!x y. x IN s /\ y IN s /\ f x = f y /\ ~(x = y) ==> g(f x) = vec 0) ==> vsum {f x |x| x IN s /\ ~(f x = a)} g = vsum s (g o f)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `FINITE {(f:A->B) x |x| x IN s /\ ~(f x = a)}` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (f:A->B) s` THEN ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]; ASM_SIMP_TAC[VSUM] THEN MATCH_MP_TAC ITERATE_NONZERO_IMAGE_LEMMA THEN ASM_REWRITE_TAC[NEUTRAL_VECTOR_ADD; MONOIDAL_VECTOR_ADD]]);; let INTERVAL_DOUBLESPLIT = prove (`1 <= k /\ k <= dimindex(:N) ==> interval[a,b] INTER {x:real^N | abs(x$k - c) <= e} = interval[(lambda i. if i = k then max (a$k) (c - e) else a$i), (lambda i. if i = k then min (b$k) (c + e) else b$i)]`, REWRITE_TAC[REAL_ARITH `abs(x - c) <= e <=> x >= c - e /\ x <= c + e`] THEN REWRITE_TAC[SET_RULE `s INTER {x | P x /\ Q x} = (s INTER {x | Q x}) INTER {x | P x}`] THEN SIMP_TAC[INTERVAL_SPLIT]);; let DIVISION_DOUBLESPLIT = prove (`!p a b:real^N k c e. p division_of interval[a,b] /\ 1 <= k /\ k <= dimindex(:N) ==> {l INTER {x | abs(x$k - c) <= e} |l| l IN p /\ ~(l INTER {x | abs(x$k - c) <= e} = {})} division_of (interval[a,b] INTER {x | abs(x$k - c) <= e})`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c + e:real` o MATCH_MP DIVISION_SPLIT) THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN FIRST_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(a /\ b /\ c) /\ d ==> d /\ b /\ c`)) THEN DISCH_THEN(MP_TAC o CONJUNCT2 o SPEC `c - e:real` o MATCH_MP DIVISION_SPLIT) THEN ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT; INTERVAL_SPLIT] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_ARITH `abs(x - c) <= e <=> x >= c - e /\ x <= c + e`] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN REWRITE_TAC[UNWIND_THM2] THEN AP_TERM_TAC THEN ABS_TAC THEN SET_TAC[]);; let CONTENT_DOUBLESPLIT = prove (`!a b:real^N k c e. &0 < e /\ 1 <= k /\ k <= dimindex(:N) ==> ?d. &0 < d /\ content(interval[a,b] INTER {x | abs(x$k - c) <= d}) < e`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `content(interval[a:real^N,b]) = &0` THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `content(interval[a:real^N,b])` THEN CONJ_TAC THENL [FIRST_X_ASSUM(K ALL_TAC o SYM); ASM_REWRITE_TAC[]] THEN ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT] THEN MATCH_MP_TAC CONTENT_SUBSET THEN ASM_SIMP_TAC[GSYM INTERVAL_DOUBLESPLIT] THEN SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONTENT_EQ_0]) THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < product ((1..dimindex (:N)) DELETE k) (\i. (b:real^N)$i - (a:real^N)$i)` ASSUME_TAC THENL [MATCH_MP_TAC PRODUCT_POS_LT THEN ASM_SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_DELETE; IN_NUMSEG; REAL_SUB_LT]; ALL_TAC] THEN ABBREV_TAC `d = e / &3 / product ((1..dimindex (:N)) DELETE k) (\i. (b:real^N)$i - (a:real^N)$i)` THEN EXISTS_TAC `d:real` THEN SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL [EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN ASM_SIMP_TAC[content; INTERVAL_DOUBLESPLIT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_DELETE; IN_DELETE] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE; LAMBDA_BETA; IN_DELETE; IN_NUMSEG] THEN SUBGOAL_THEN `product ((1..dimindex (:N)) DELETE k) (\j. ((lambda i. if i = k then min (b$k) (c + d) else b$i):real^N)$j - ((lambda i. if i = k then max (a$k) (c - d) else a$i):real^N)$j) = product ((1..dimindex (:N)) DELETE k) (\i. (b:real^N)$i - (a:real^N)$i)` SUBST1_TAC THENL [MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 * d` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < d /\ &3 * d <= x ==> &2 * d < x`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "d" THEN REAL_ARITH_TAC);; let NEGLIGIBLE_STANDARD_HYPERPLANE = prove (`!c k. negligible {x:real^N | x$k = c}`, MAP_EVERY X_GEN_TAC [`c:real`; `i:num`] THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !x:real^N. x$i = x$k` (X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[negligible; has_integral] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `k:num`; `c:real`; `e:real`] CONTENT_DOUBLESPLIT) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. ball(x,d)` THEN ASM_SIMP_TAC[GAUGE_BALL] THEN ABBREV_TAC `i = indicator {x:real^N | x$k = c}` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `vsum p (\(x,l). content l % i x) = vsum p (\(x,l). content(l INTER {x:real^N | abs(x$k - c) <= d}) % (i:real^N->real^1) x)` SUBST1_TAC THENL [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `l:real^N->bool`] THEN DISCH_TAC THEN EXPAND_TAC "i" THEN REWRITE_TAC[indicator] THEN REWRITE_TAC[IN_ELIM_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `l:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> l SUBSET s ==> l = l INTER t`) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM; dist] THEN UNDISCH_THEN `(x:real^N)$k = c` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(vsum p (\(x:real^N,l). content(l INTER {x:real^N | abs(x$k - c) <= d}) % vec 1:real^1))` THEN CONJ_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[VSUM_REAL; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(x) <= abs(y)`) THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM; DROP_CMUL] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE; MATCH_MP_TAC SUM_LE] THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `l:real^N->bool`] THEN STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_MUL; MATCH_MP_TAC REAL_LE_LMUL] THEN EXPAND_TAC "i" THEN REWRITE_TAC[DROP_VEC] THEN REWRITE_TAC[DROP_INDICATOR_POS_LE; DROP_INDICATOR_LE_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `l:real^N->bool`] o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT; CONTENT_POS_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`(\l. content (l INTER {x | abs (x$k - c) <= d}) % vec 1): (real^N->bool)->real^1`; `p:real^N#(real^N->bool)->bool`; `interval[a:real^N,b]`] VSUM_OVER_TAGGED_DIVISION_LEMMA) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN MATCH_MP_TAC(REAL_ARITH `!x. x = &0 /\ &0 <= y /\ y <= x ==> y = &0`) THEN EXISTS_TAC `content(interval[u:real^N,v])` THEN CONJ_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[CONTENT_POS_LE; INTERVAL_DOUBLESPLIT] THEN MATCH_MP_TAC CONTENT_SUBSET THEN ASM_SIMP_TAC[GSYM INTERVAL_DOUBLESPLIT] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(ISPECL [`IMAGE SND (p:real^N#(real^N->bool)->bool)`; `\l. l INTER {x:real^N | abs (x$k - c) <= d}`; `\l:real^N->bool. content l % vec 1 :real^1`; `{}:real^N->bool`] VSUM_NONZERO_IMAGE_LEMMA) THEN REWRITE_TAC[o_DEF] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN REWRITE_TAC[CONTENT_EMPTY; VECTOR_MUL_LZERO] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN X_GEN_TAC `m:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN SIMP_TAC[INTERVAL_DOUBLESPLIT; ASSUME `1 <= k`; ASSUME `k <= dimindex(:N)`] THEN REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN ASM_SIMP_TAC[GSYM INTERVAL_DOUBLESPLIT] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`interval[u:real^N,v]`; `m:real^N->bool`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `u SUBSET s /\ u SUBSET t ==> s INTER t = {} ==> u = {}`) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1 * content(interval[a,b] INTER {x:real^N | abs (x$k - c) <= d})` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_MUL_LID]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] DIVISION_DOUBLESPLIT)) THEN DISCH_THEN(MP_TAC o SPECL [`k:num`; `c:real`; `d:real`]) THEN ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT] THEN DISCH_TAC THEN MATCH_MP_TAC DSUM_BOUND THEN ASM_SIMP_TAC[NORM_REAL; VEC_COMPONENT; DIMINDEX_1; LE_REFL] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A technical lemma about "refinement" of division. *) (* ------------------------------------------------------------------------- *) let TAGGED_DIVISION_FINER = prove (`!p a b:real^N d. p tagged_division_of interval[a,b] /\ gauge d ==> ?q. q tagged_division_of interval[a,b] /\ d fine q /\ !x k. (x,k) IN p /\ k SUBSET d(x) ==> (x,k) IN q`, let lemma1 = prove (`{k | ?x. (x,k) IN p} = IMAGE SND p`, REWRITE_TAC[EXTENSION; EXISTS_PAIR_THM; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]) in SUBGOAL_THEN `!a b:real^N d p. FINITE p ==> p tagged_partial_division_of interval[a,b] /\ gauge d ==> ?q. q tagged_division_of (UNIONS {k | ?x. x,k IN p}) /\ d fine q /\ !x k. (x,k) IN p /\ k SUBSET d(x) ==> (x,k) IN q` ASSUME_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [tagged_division_of] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[IMP_IMP]) THEN ASM_MESON_TAC[tagged_partial_division_of]] THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[SET_RULE `UNIONS {k | ?x. x,k IN {}} = {}`] THEN EXISTS_TAC `{}:real^N#(real^N->bool)->bool` THEN REWRITE_TAC[fine; NOT_IN_EMPTY; TAGGED_DIVISION_OF_EMPTY]; ALL_TAC] THEN GEN_REWRITE_TAC I [FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `k:real^N->bool`; `p:real^N#(real^N->bool)->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN EXISTS_TAC `(x:real^N,k:real^N->bool) INSERT p` THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q1:real^N#(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `UNIONS {l:real^N->bool | ?y:real^N. (y,l) IN (x,k) INSERT p} = k UNION UNIONS {l | ?y. (y,l) IN p}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNION; IN_UNIONS] THEN REWRITE_TAC[IN_ELIM_THM; IN_INSERT; PAIR_EQ] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?u v:real^N. k = interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[IN_INSERT; tagged_partial_division_of]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN ASM_CASES_TAC `interval[u,v] SUBSET ((d:real^N->real^N->bool) x)` THENL [EXISTS_TAC `{(x:real^N,interval[u:real^N,v])} UNION q1` THEN CONJ_TAC THENL [MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC TAGGED_DIVISION_OF_SELF THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN REWRITE_TAC[IN_INSERT; PAIR_EQ] THEN MESON_TAC[]; ALL_TAC]; CONJ_TAC THENL [MATCH_MP_TAC FINE_UNION THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[fine; IN_SING; PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_INSERT; PAIR_EQ; IN_UNION; IN_SING] THEN ASM_MESON_TAC[]]; FIRST_ASSUM(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o MATCH_MP FINE_DIVISION_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `q2:real^N#(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `q2 UNION q1:real^N#(real^N->bool)->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[FINE_UNION] THEN ASM_REWRITE_TAC[IN_INSERT; PAIR_EQ; IN_UNION; IN_SING] THEN ASM_MESON_TAC[]]] THEN (MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN REWRITE_TAC[lemma1; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN REWRITE_TAC[IN_INSERT; FINITE_INSERT; PAIR_EQ] THEN STRIP_TAC THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; OPEN_INTERVAL]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]));; (* ------------------------------------------------------------------------- *) (* Hence the main theorem about negligible sets. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_NEGLIGIBLE = prove (`!f:real^M->real^N s t. negligible s /\ (!x. x IN (t DIFF s) ==> f x = vec 0) ==> (f has_integral (vec 0)) t`, let lemma = prove (`!f:B->real g:A#B->real s t. FINITE s /\ FINITE t /\ (!x y. (x,y) IN t ==> &0 <= g(x,y)) /\ (!y. y IN s ==> ?x. (x,y) IN t /\ f(y) <= g(x,y)) ==> sum s f <= sum t g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN EXISTS_TAC `SND:A#B->B` THEN REWRITE_TAC[EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN ASM_MESON_TAC[]) in SUBGOAL_THEN `!f:real^M->real^N s a b. negligible s /\ (!x. ~(x IN s) ==> f x = vec 0) ==> (f has_integral (vec 0)) (interval[a,b])` ASSUME_TAC THENL [ALL_TAC; REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_EQ THEN EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else vec 0` THEN SIMP_TAC[] THEN FIRST_X_ASSUM(CHOOSE_THEN(CHOOSE_THEN SUBST_ALL_TAC)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[NORM_0; VECTOR_SUB_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `s:real^M->bool` THEN ASM_MESON_TAC[]] THEN REWRITE_TAC[negligible; has_integral; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MAP_EVERY(fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) [`a:real^M`; `b:real^M`] THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `e / &2 / ((&n + &1) * &2 pow n)`) THEN REWRITE_TAC[real_div; REAL_MUL_POS_LT] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; FORALL_AND_THM; ARITH; REAL_ARITH `&0 < &n + &1`; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->real^M->real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. (d:num->real^M->real^M->bool) (num_of_int(int_of_real(floor(norm(f x:real^N))))) x` THEN CONJ_TAC THENL [REWRITE_TAC[gauge] THEN ASM_MESON_TAC[gauge]; ALL_TAC] THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_CASES_TAC `p:real^M#(real^M->bool)->bool = {}` THEN ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0] THEN MP_TAC(SPEC `sup(IMAGE (\(x,k:real^M->bool). norm((f:real^M->real^N) x)) p)` REAL_ARCH_SIMPLE) THEN ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MP_TAC(GEN `i:num` (ISPECL [`p:real^M#(real^M->bool)->bool`; `a:real^M`; `b:real^M`; `(d:num->real^M->real^M->bool) i`] TAGGED_DIVISION_FINER)) THEN ASM_REWRITE_TAC[SKOLEM_THM; RIGHT_IMP_EXISTS_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `q:num->real^M#(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(0..N+1) (\i. (&i + &1) * norm(vsum (q i) (\(x:real^M,k:real^M->bool). content k % indicator s x)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (0..N+1) (\i. e / &2 / &2 pow i)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div; SUM_LMUL; GSYM REAL_POW_INV] THEN REWRITE_TAC[SUM_GP; LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `(e * &1 / &2) * (&1 - x) / (&1 / &2) < e <=> &0 < e * x`] THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_POW_LT; REAL_ARITH `&0 < &1 / &2`]] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN FIRST_ASSUM(ASSUME_TAC o GEN `i:num` o MATCH_MP TAGGED_DIVISION_OF_FINITE o SPEC `i:num`) THEN ASM_SIMP_TAC[VSUM_REAL; NORM_LIFT] THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM; DROP_CMUL] THEN REWRITE_TAC[real_abs] THEN SUBGOAL_THEN `!i:num. &0 <= sum (q i) (\(x:real^M,y:real^M->bool). content y * drop (indicator s x))` ASSUME_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[DROP_INDICATOR_POS_LE] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> n <= x ==> n <= y`) THEN ASM_SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN MATCH_MP_TAC lemma THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FORALL_PAIR_THM; FINITE_NUMSEG] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL] THEN REWRITE_TAC[DROP_INDICATOR_POS_LE] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `n = num_of_int(int_of_real(floor(norm((f:real^M->real^N) x))))` THEN SUBGOAL_THEN `&n <= norm((f:real^M->real^N) x) /\ norm(f x) < &n + &1` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `&n = floor(norm((f:real^M->real^N) x))` (fun th -> MESON_TAC[th; FLOOR]) THEN EXPAND_TAC "n" THEN MP_TAC(ISPEC `norm((f:real^M->real^N) x)` FLOOR_POS) THEN REWRITE_TAC[NORM_POS_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM int_of_num; NUM_OF_INT_OF_NUM]; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm((f:real^M->real^N) x)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x <= n ==> x <= n + &1`) THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_SIMP_TAC[indicator] THEN REWRITE_TAC[DROP_VEC; REAL_MUL_RZERO; NORM_0; VECTOR_MUL_RZERO; REAL_LE_REFL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[DROP_VEC; REAL_MUL_RID; NORM_MUL] THEN SUBGOAL_THEN `&0 <= content(k:real^M->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE]; ALL_TAC] THEN ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]);; let HAS_INTEGRAL_ON_NEGLIGIBLE = prove (`!f:real^M->real^N s. negligible s ==> (f has_integral vec 0) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `s:real^M->bool` THEN ASM SET_TAC[]);; let INTEGRABLE_ON_NEGLIGIBLE = prove (`!f:real^M->real^N s. negligible s ==> f integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_ON_NEGLIGIBLE]);; let INTEGRAL_ON_NEGLIGIBLE = prove (`!f:real^M->real^N s. negligible s ==> integral s f = vec 0`, MESON_TAC[HAS_INTEGRAL_ON_NEGLIGIBLE; INTEGRAL_UNIQUE]);; let HAS_INTEGRAL_SPIKE = prove (`!f:real^M->real^N g s t. negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ (f has_integral y) t ==> (g has_integral y) t`, SUBGOAL_THEN `!f:real^M->real^N g s a b y. negligible s /\ (!x. x IN (interval[a,b] DIFF s) ==> g x = f x) ==> (f has_integral y) (interval[a,b]) ==> (g has_integral y) (interval[a,b])` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `((\x. (f:real^M->real^N)(x) + (g(x) - f(x))) has_integral (y + vec 0)) (interval[a,b])` MP_TAC THENL [ALL_TAC; REWRITE_TAC[VECTOR_ARITH `f + g - f = g /\ f + vec 0 = f`; ETA_AX]] THEN MATCH_MP_TAC HAS_INTEGRAL_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(CHOOSE_THEN(CHOOSE_THEN SUBST_ALL_TAC)) THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let HAS_INTEGRAL_SPIKE_EQ = prove (`!f:real^M->real^N g s t y. negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> ((f has_integral y) t <=> (g has_integral y) t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[NORM_SUB]);; let INTEGRABLE_SPIKE = prove (`!f:real^M->real^N g s t. negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> f integrable_on t ==> g integrable_on t`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE) THEN ASM_REWRITE_TAC[]);; let INTEGRABLE_SPIKE_EQ = prove (`!f:real^M->real^N g s t. negligible s /\ (!x. x IN t DIFF s ==> g x = f x) ==> (f integrable_on t <=> g integrable_on t)`, MESON_TAC[INTEGRABLE_SPIKE]);; let INTEGRAL_SPIKE = prove (`!f:real^M->real^N g s t y. negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> integral t f = integral t g`, REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some other trivialities about negligible sets. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_SUBSET = prove (`!s:real^N->bool t:real^N->bool. negligible s /\ t SUBSET s ==> negligible t`, REPEAT STRIP_TAC THEN REWRITE_TAC[negligible] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN MAP_EVERY EXISTS_TAC [`(\x. vec 0):real^N->real^1`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[HAS_INTEGRAL_0] THEN REWRITE_TAC[indicator] THEN ASM SET_TAC[]);; let NEGLIGIBLE_DIFF = prove (`!s t:real^N->bool. negligible s ==> negligible(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_DIFF]);; let NEGLIGIBLE_INTER = prove (`!s t. negligible s \/ negligible t ==> negligible(s INTER t)`, MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]);; let NEGLIGIBLE_UNION = prove (`!s t:real^N->bool. negligible s /\ negligible t ==> negligible (s UNION t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MP_TAC THEN REWRITE_TAC[negligible; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[indicator; IN_UNION; IN_DIFF; VECTOR_ADD_LID]);; let NEGLIGIBLE_UNION_EQ = prove (`!s t:real^N->bool. negligible (s UNION t) <=> negligible s /\ negligible t`, MESON_TAC[NEGLIGIBLE_UNION; SUBSET_UNION; NEGLIGIBLE_SUBSET]);; let NEGLIGIBLE_SING = prove (`!a:real^N. negligible {a}`, GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x | (x:real^N)$1 = (a:real^N)$1}` THEN SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; LE_REFL; DIMINDEX_GE_1] THEN SET_TAC[]);; let NEGLIGIBLE_INSERT = prove (`!a:real^N s. negligible(a INSERT s) <=> negligible s`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_SING]);; let NEGLIGIBLE_EMPTY = prove (`negligible {}`, MESON_TAC[EMPTY_SUBSET; NEGLIGIBLE_SUBSET; NEGLIGIBLE_SING]);; let NEGLIGIBLE_FINITE = prove (`!s. FINITE s ==> negligible s`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NEGLIGIBLE_EMPTY; NEGLIGIBLE_INSERT]);; let NEGLIGIBLE_UNIONS = prove (`!s. FINITE s /\ (!t. t IN s ==> negligible t) ==> negligible(UNIONS s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; NEGLIGIBLE_EMPTY; IN_INSERT] THEN SIMP_TAC[NEGLIGIBLE_UNION]);; let NEGLIGIBLE = prove (`!s:real^N->bool. negligible s <=> !t. (indicator s has_integral vec 0) t`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; REWRITE_TAC[negligible] THEN SIMP_TAC[]] THEN DISCH_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[negligible]; ALL_TAC] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `vec 0:real^1` THEN MP_TAC(ISPECL [`s:real^N->bool`; `s INTER t:real^N->bool`] NEGLIGIBLE_SUBSET) THEN ASM_REWRITE_TAC[INTER_SUBSET; negligible; VECTOR_SUB_REFL; NORM_0] THEN REWRITE_TAC[indicator; IN_INTER] THEN SIMP_TAC[TAUT `(if p /\ q then r else s) = (if q then if p then r else s else s)`]);; (* ------------------------------------------------------------------------- *) (* Finite or empty cases of the spike theorem are quite commonly needed. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_SPIKE_FINITE = prove (`!f:real^M->real^N g s t y. FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ (f has_integral y) t ==> (g has_integral y) t`, MESON_TAC[HAS_INTEGRAL_SPIKE; NEGLIGIBLE_FINITE]);; let HAS_INTEGRAL_SPIKE_FINITE_EQ = prove (`!f:real^M->real^N g s y. FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> ((f has_integral y) t <=> (g has_integral y) t)`, MESON_TAC[HAS_INTEGRAL_SPIKE_FINITE]);; let INTEGRABLE_SPIKE_FINITE = prove (`!f:real^M->real^N g s. FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> f integrable_on t ==> g integrable_on t`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE_FINITE) THEN ASM_REWRITE_TAC[]);; let INTEGRAL_EQ = prove (`!f:real^M->real^N g s. (!x. x IN s ==> f x = g x) ==> integral s f = integral s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `{}:real^M->bool` THEN ASM_SIMP_TAC[NEGLIGIBLE_EMPTY; IN_DIFF]);; let INTEGRAL_EQ_0 = prove (`!f:real^M->real^N s. (!x. x IN s ==> f x = vec 0) ==> integral s f = vec 0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `integral s ((\x. vec 0):real^M->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_EQ THEN ASM_REWRITE_TAC[]; REWRITE_TAC[INTEGRAL_0]]);; (* ------------------------------------------------------------------------- *) (* In particular, the boundary of an interval is negligible. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_FRONTIER_INTERVAL = prove (`!a b:real^N. negligible(interval[a,b] DIFF interval(a,b))`, REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE (\k. {x:real^N | x$k = (a:real^N)$k} UNION {x:real^N | x$k = (b:real^N)$k}) (1..dimindex(:N)))` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN SIMP_TAC[IN_NUMSEG; NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_STANDARD_HYPERPLANE]; REWRITE_TAC[SUBSET; IN_DIFF; IN_INTERVAL; IN_UNIONS; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_NUMSEG; IN_UNION; IN_ELIM_THM; REAL_LT_LE] THEN MESON_TAC[]]);; let HAS_INTEGRAL_SPIKE_INTERIOR = prove (`!f:real^M->real^N g a b y. (!x. x IN interval(a,b) ==> g x = f x) /\ (f has_integral y) (interval[a,b]) ==> (g has_integral y) (interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_INTEGRAL_SPIKE) THEN EXISTS_TAC `interval[a:real^M,b] DIFF interval(a,b)` THEN REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN ASM SET_TAC[]);; let HAS_INTEGRAL_SPIKE_INTERIOR_EQ = prove (`!f:real^M->real^N g a b y. (!x. x IN interval(a,b) ==> g x = f x) ==> ((f has_integral y) (interval[a,b]) <=> (g has_integral y) (interval[a,b]))`, MESON_TAC[HAS_INTEGRAL_SPIKE_INTERIOR]);; let INTEGRABLE_SPIKE_INTERIOR = prove (`!f:real^M->real^N g a b. (!x. x IN interval(a,b) ==> g x = f x) ==> f integrable_on (interval[a,b]) ==> g integrable_on (interval[a,b])`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE_INTERIOR) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Integrability of continuous functions. *) (* ------------------------------------------------------------------------- *) let NEUTRAL_AND = prove (`neutral(/\) = T`, REWRITE_TAC[neutral; FORALL_BOOL_THM] THEN MESON_TAC[]);; let MONOIDAL_AND = prove (`monoidal(/\)`, REWRITE_TAC[monoidal; NEUTRAL_AND; CONJ_ACI]);; let ITERATE_AND = prove (`!p s. FINITE s ==> (iterate(/\) s p <=> !x. x IN s ==> p x)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[MONOIDAL_AND; NEUTRAL_AND; ITERATE_CLAUSES] THEN SET_TAC[]);; let OPERATIVE_DIVISION_AND = prove (`!P d a b. operative(/\) P /\ d division_of interval[a,b] ==> ((!i. i IN d ==> P i) <=> P(interval[a,b]))`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o CONJ MONOIDAL_AND) THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_DIVISION) THEN ASM_MESON_TAC[ITERATE_AND; DIVISION_OF_FINITE]);; let OPERATIVE_APPROXIMABLE = prove (`!f:real^M->real^N e. &0 <= e ==> operative(/\) (\i. ?g. (!x. x IN i ==> norm (f x - g x) <= e) /\ g integrable_on i)`, REPEAT STRIP_TAC THEN REWRITE_TAC[operative; NEUTRAL_AND] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; integrable_on] THEN ASM_MESON_TAC[HAS_INTEGRAL_NULL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`; `c:real`; `k:num`] THEN STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[INTEGRABLE_SPLIT; IN_INTER]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `g1:real^M->real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `g2:real^M->real^N` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\x. if x$k = c then (f:real^M->real^N)(x) else if x$k <= c then g1(x) else g2(x)` THEN CONJ_TAC THENL [GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER; IN_ELIM_THM]) THEN ASM_MESON_TAC[REAL_ARITH `x <= c \/ x >= c`]; ALL_TAC] THEN SUBGOAL_THEN `(\x:real^M. if x$k = c then f x else if x$k <= c then g1 x else g2 x) integrable_on (interval[u,v] INTER {x | x$k <= c}) /\ (\x. if x$k = c then f x :real^N else if x$k <= c then g1 x else g2 x) integrable_on (interval[u,v] INTER {x | x$k >= c})` MP_TAC THENL [ALL_TAC; REWRITE_TAC[integrable_on] THEN ASM_MESON_TAC[HAS_INTEGRAL_SPLIT]] THEN CONJ_TAC THENL [UNDISCH_TAC `(g1:real^M->real^N) integrable_on (interval[u,v] INTER {x | x$k <= c})`; UNDISCH_TAC `(g2:real^M->real^N) integrable_on (interval[u,v] INTER {x | x$k >= c})` ] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN EXISTS_TAC `{x:real^M | x$k = c}` THEN ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; IN_DIFF; IN_INTER; IN_ELIM_THM; REAL_ARITH `x >= c /\ ~(x = c) ==> ~(x <= c)`] THEN EXISTS_TAC `e:real` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]);; let APPROXIMABLE_ON_DIVISION = prove (`!f:real^M->real^N d a b. &0 <= e /\ (d division_of interval[a,b]) /\ (!i. i IN d ==> ?g. (!x. x IN i ==> norm (f x - g x) <= e) /\ g integrable_on i) ==> ?g. (!x. x IN interval[a,b] ==> norm (f x - g x) <= e) /\ g integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(/\)`; `d:(real^M->bool)->bool`; `a:real^M`; `b:real^M`; `\i. ?g:real^M->real^N. (!x. x IN i ==> norm (f x - g x) <= e) /\ g integrable_on i`] OPERATIVE_DIVISION) THEN ASM_SIMP_TAC[OPERATIVE_APPROXIMABLE; MONOIDAL_AND] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[ITERATE_AND]);; let INTEGRABLE_CONTINUOUS = prove (`!f:real^M->real^N a b. f continuous_on interval[a,b] ==> f integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MATCH_MP_TAC APPROXIMABLE_ON_DIVISION THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_UNIFORMLY_CONTINUOUS)) THEN REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?p. p tagged_division_of interval[a:real^M,b] /\ (\x. ball(x,d)) fine p` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINE_DIVISION_EXISTS; GAUGE_BALL]; ALL_TAC] THEN EXISTS_TAC `IMAGE SND (p:real^M#(real^M->bool)->bool)` THEN ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN EXISTS_TAC `\y:real^M. (f:real^M->real^N) x` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`] o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[SUBSET] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN REWRITE_TAC[SUBSET; IN_BALL; dist] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; NORM_SUB]; REWRITE_TAC[integrable_on] THEN EXISTS_TAC `content(interval[a':real^M,b']) % (f:real^M->real^N) x` THEN REWRITE_TAC[HAS_INTEGRAL_CONST]]);; (* ------------------------------------------------------------------------- *) (* Specialization of additivity to one dimension. *) (* ------------------------------------------------------------------------- *) let OPERATIVE_1_LT = prove (`!op. monoidal op ==> !f. operative op f <=> (!a b. drop b <= drop a ==> f(interval[a,b]) = neutral op) /\ (!a b c. drop a < drop c /\ drop c < drop b ==> op (f(interval[a,c])) (f(interval[c,b])) = f(interval[a,b]))`, REPEAT STRIP_TAC THEN REWRITE_TAC[operative; CONTENT_EQ_0_1] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN DISCH_TAC THEN REWRITE_TAC[FORALL_1; DIMINDEX_1] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^1` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `b:real^1` THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `c:real^1` THEN FIRST_ASSUM(SUBST1_TAC o SPEC `drop c`) THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN ASM_SIMP_TAC[INTERVAL_SPLIT; DIMINDEX_1; LE_REFL; REAL_LT_IMP_LE] THEN BINOP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN SIMP_TAC[FORALL_1; CART_EQ; DIMINDEX_1; LAMBDA_BETA; LE_REFL] THEN REWRITE_TAC[GSYM drop] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `d:real` THEN ABBREV_TAC `c = lift d` THEN SUBGOAL_THEN `d = drop c` SUBST1_TAC THENL [ASM_MESON_TAC[LIFT_DROP]; ALL_TAC] THEN SIMP_TAC[INTERVAL_SPLIT; LE_REFL; drop; DIMINDEX_1] THEN REWRITE_TAC[GSYM drop] THEN DISJ_CASES_TAC(REAL_ARITH `drop c <= drop a \/ drop a < drop c`) THENL [SUBGOAL_THEN `content(interval[a:real^1, (lambda i. if i = 1 then min (drop b) (drop c) else b$i)]) = &0 /\ interval[(lambda i. if i = 1 then max (drop a) (drop c) else a$i),b] = interval[a,b]` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THENL [CONJ_TAC THENL [SIMP_TAC[CONTENT_EQ_0_1]; AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ]] THEN SIMP_TAC[drop; CART_EQ; FORALL_1; LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN UNDISCH_TAC `drop c <= drop a` THEN REWRITE_TAC[drop] THEN REAL_ARITH_TAC; REWRITE_TAC[CONTENT_EQ_0_1] THEN DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN ASM_MESON_TAC[monoidal]]; ALL_TAC] THEN DISJ_CASES_TAC(REAL_ARITH `drop b <= drop c \/ drop c < drop b`) THENL [SUBGOAL_THEN `interval[a,(lambda i. if i = 1 then min (drop b) (drop c) else b$i)] = interval[a,b] /\ content(interval [(lambda i. if i = 1 then max (drop a) (drop c) else a$i),b]) = &0` (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THENL [CONJ_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ]; SIMP_TAC[CONTENT_EQ_0_1]] THEN SIMP_TAC[drop; CART_EQ; FORALL_1; LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN UNDISCH_TAC `drop b <= drop c` THEN REWRITE_TAC[drop] THEN REAL_ARITH_TAC; REWRITE_TAC[CONTENT_EQ_0_1] THEN DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN ASM_MESON_TAC[monoidal]]; ALL_TAC] THEN SUBGOAL_THEN `(lambda i. if i = 1 then min (drop b) (drop c) else b$i) = c /\ (lambda i. if i = 1 then max (drop a) (drop c) else a$i) = c` (fun th -> REWRITE_TAC[th] THEN ASM_MESON_TAC[]) THEN SIMP_TAC[CART_EQ; FORALL_1; DIMINDEX_1; LE_REFL; LAMBDA_BETA] THEN REWRITE_TAC[GSYM drop] THEN ASM_REAL_ARITH_TAC);; let OPERATIVE_1_LE = prove (`!op. monoidal op ==> !f. operative op f <=> (!a b. drop b <= drop a ==> f(interval[a,b]) = neutral op) /\ (!a b c. drop a <= drop c /\ drop c <= drop b ==> op (f(interval[a,c])) (f(interval[c,b])) = f(interval[a,b]))`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[OPERATIVE_1_LT] THEN MESON_TAC[REAL_LT_IMP_LE]] THEN REWRITE_TAC[operative; CONTENT_EQ_0_1] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_1; DIMINDEX_1] THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) [`a:real^1`; `b:real^1`] THEN DISCH_TAC THEN X_GEN_TAC `c:real^1` THEN FIRST_ASSUM(SUBST1_TAC o SPEC `drop c`) THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LE_TRANS) THEN ASM_SIMP_TAC[INTERVAL_SPLIT; DIMINDEX_1; LE_REFL] THEN BINOP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN SIMP_TAC[FORALL_1; CART_EQ; DIMINDEX_1; LAMBDA_BETA; LE_REFL] THEN REWRITE_TAC[GSYM drop] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Additivity in R^1 for differences between function at endpoints. *) (* ------------------------------------------------------------------------- *) let ADDITIVE_DIVISION_1 = prove (`!f:real^1->real^N d a b. drop a <= drop b /\ d division_of interval[a,b] ==> vsum d (\k. f(interval_upperbound k) - f(interval_lowerbound k)) = f b - f a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(+):real^N->real^N->real^N`; `d:(real^1->bool)->bool`; `a:real^1`; `b:real^1`; `(\k. if k = {} then vec 0 else f(interval_upperbound k) - f(interval_lowerbound k)): ((real^1->bool)->real^N)`] OPERATIVE_DIVISION) THEN ASM_SIMP_TAC[MONOIDAL_VECTOR_ADD; OPERATIVE_1_LT; NEUTRAL_VECTOR_ADD; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN ANTS_TAC THENL [ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_ARITH `a <= b ==> ~(b < a)`; REAL_LT_IMP_LE; CONTENT_EQ_0_1; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN SIMP_TAC[REAL_ARITH `b <= a ==> (b < a <=> ~(b = a))`] THEN SIMP_TAC[DROP_EQ; COND_SWAP] THEN SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; REAL_LE_REFL] THEN REWRITE_TAC[VECTOR_SUB_REFL; COND_ID; EQ_SYM_EQ] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; REAL_ARITH `b < a ==> ~(a < b)`; REAL_LT_IMP_LE] THEN MESON_TAC[VECTOR_ARITH `(c - a) + (b - c):real^N = b - a`]; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; GSYM REAL_NOT_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM VSUM] THEN MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[division_of; MEMBER_NOT_EMPTY]);; let ADDITIVE_TAGGED_DIVISION_1 = prove (`!f:real^1->real^N p a b. drop a <= drop b /\ p tagged_division_of interval[a,b] ==> vsum p (\(x,k). f(interval_upperbound k) - f(interval_lowerbound k)) = f b - f a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(+):real^N->real^N->real^N`; `p:(real^1#(real^1->bool)->bool)`; `a:real^1`; `b:real^1`; `(\k. if k = {} then vec 0 else f(interval_upperbound k) - f(interval_lowerbound k)): ((real^1->bool)->real^N)`] OPERATIVE_TAGGED_DIVISION) THEN ASM_SIMP_TAC[MONOIDAL_VECTOR_ADD; OPERATIVE_1_LT; NEUTRAL_VECTOR_ADD; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN ANTS_TAC THENL [ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_ARITH `a <= b ==> ~(b < a)`; REAL_LT_IMP_LE; CONTENT_EQ_0_1; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN SIMP_TAC[REAL_ARITH `b <= a ==> (b < a <=> ~(b = a))`] THEN SIMP_TAC[DROP_EQ; COND_SWAP] THEN SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; REAL_LE_REFL] THEN REWRITE_TAC[VECTOR_SUB_REFL; COND_ID; EQ_SYM_EQ] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; REAL_ARITH `b < a ==> ~(a < b)`; REAL_LT_IMP_LE] THEN MESON_TAC[VECTOR_ARITH `(c - a) + (b - c):real^N = b - a`]; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; GSYM REAL_NOT_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM VSUM] THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF; MEMBER_NOT_EMPTY]);; (* ------------------------------------------------------------------------- *) (* A useful lemma allowing us to factor out the content size. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_FACTOR_CONTENT = prove (`!f:real^M->real^N i a b. (f has_integral i) (interval[a,b]) <=> (!e. &0 < e ==> ?d. gauge d /\ (!p. p tagged_division_of interval[a,b] /\ d fine p ==> norm (vsum p (\(x,k). content k % f x) - i) <= e * content(interval[a,b])))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THENL [MP_TAC(SPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`] VSUM_CONTENT_NULL) THEN ASM_SIMP_TAC[HAS_INTEGRAL_NULL_EQ; VECTOR_SUB_LZERO; NORM_NEG] THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; NORM_LE_0] THEN ASM_MESON_TAC[FINE_DIVISION_EXISTS; GAUGE_TRIVIAL; REAL_LT_01]; ALL_TAC] THEN REWRITE_TAC[has_integral] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `e * content(interval[a:real^M,b])`) THEN ASM_SIMP_TAC[REAL_LT_MUL; CONTENT_LT_NZ] THEN MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / content(interval[a:real^M,b])`) THEN ASM_SIMP_TAC[REAL_LT_DIV; CONTENT_LT_NZ; REAL_OF_NUM_LT; ARITH] THEN ASM_SIMP_TAC[REAL_DIV_RMUL] THEN ASM_MESON_TAC[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`]);; (* ------------------------------------------------------------------------- *) (* Attempt a systematic general set of "offset" results for components. *) (* ------------------------------------------------------------------------- *) let GAUGE_MODIFY = prove (`!f:real^M->real^N. (!s. open s ==> open {x | f(x) IN s}) ==> !d. gauge d ==> gauge (\x y. d (f x) (f y))`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN SIMP_TAC[gauge; IN] THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN]);; (* ------------------------------------------------------------------------- *) (* Integrability on subintervals. *) (* ------------------------------------------------------------------------- *) let OPERATIVE_INTEGRABLE = prove (`!f. operative (/\) (\i. f integrable_on i)`, GEN_TAC THEN REWRITE_TAC[operative; NEUTRAL_AND] THEN CONJ_TAC THENL [REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NULL_EQ]; REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[INTEGRABLE_SPLIT] THEN REWRITE_TAC[integrable_on] THEN ASM_MESON_TAC[HAS_INTEGRAL_SPLIT]]);; let INTEGRABLE_SUBINTERVAL = prove (`!f:real^M->real^N a b c d. f integrable_on interval[a,b] /\ interval[c,d] SUBSET interval[a,b] ==> f integrable_on interval[c,d]`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[c:real^M,d] = {}` THENL [ASM_REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NULL; CONTENT_EMPTY; EMPTY_AS_INTERVAL]; ASM_MESON_TAC[OPERATIVE_INTEGRABLE; OPERATIVE_DIVISION_AND; PARTIAL_DIVISION_EXTEND_1]]);; (* ------------------------------------------------------------------------- *) (* Combining adjacent intervals in 1 dimension. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_COMBINE = prove (`!f i:real^N j a b c. drop a <= drop c /\ drop c <= drop b /\ (f has_integral i) (interval[a,c]) /\ (f has_integral j) (interval[c,b]) ==> (f has_integral (i + j)) (interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC ((CONJUNCT2 o GEN_REWRITE_RULE I [MATCH_MP OPERATIVE_1_LE(MATCH_MP MONOIDAL_LIFTED MONOIDAL_VECTOR_ADD)]) (ISPEC `f:real^1->real^N` OPERATIVE_INTEGRAL)) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`; `c:real^1`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[lifted; distinctness "option"; injectivity "option"]) THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL; HAS_INTEGRAL_UNIQUE; integrable_on; INTEGRAL_UNIQUE]);; let INTEGRAL_COMBINE = prove (`!f:real^1->real^N a b c. drop a <= drop c /\ drop c <= drop b /\ f integrable_on (interval[a,b]) ==> integral(interval[a,c]) f + integral(interval[c,b]) f = integral(interval[a,b]) f`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `c:real^1` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL]);; let INTEGRABLE_COMBINE = prove (`!f a b c. drop a <= drop c /\ drop c <= drop b /\ f integrable_on interval[a,c] /\ f integrable_on interval[c,b] ==> f integrable_on interval[a,b]`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMBINE]);; (* ------------------------------------------------------------------------- *) (* Reduce integrability to "local" integrability. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_ON_LITTLE_SUBINTERVALS = prove (`!f:real^M->real^N a b. (!x. x IN interval[a,b] ==> ?d. &0 < d /\ !u v. x IN interval[u,v] /\ interval[u,v] SUBSET ball(x,d) /\ interval[u,v] SUBSET interval[a,b] ==> f integrable_on interval[u,v]) ==> f integrable_on interval[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; GAUGE_EXISTENCE_LEMMA] THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\x:real^M. ball(x,d x)`; `a:real^M`; `b:real^M`] FINE_DIVISION_EXISTS) THEN ASM_SIMP_TAC[GAUGE_BALL_DEPENDENT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] OPERATIVE_DIVISION_AND) (ISPEC `f:real^M->real^N` OPERATIVE_INTEGRABLE)) THEN DISCH_THEN(MP_TAC o SPECL [`IMAGE SND (p:real^M#(real^M->bool)->bool)`; `a:real^M`; `b:real^M`]) THEN ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET]);; (* ------------------------------------------------------------------------- *) (* Second FCT or existence of antiderivative. *) (* ------------------------------------------------------------------------- *) let INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE = prove (`!f:real^1->real^N a b x. f integrable_on interval[a,b] /\ x IN interval[a,b] /\ f continuous (at x within interval[a,b]) ==> ((\u. integral (interval [a,u]) f) has_vector_derivative f x) (at x within interval [a,b])`, REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN_ALT] THEN CONJ_TAC THENL [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN CONJ_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; dist] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN DISJ_CASES_TAC(REAL_ARITH `drop x <= drop y \/ drop y <= drop x`) THENL [ASM_SIMP_TAC[REAL_ARITH `x <= y ==> abs(y - x) = y - x`]; ONCE_REWRITE_TAC[VECTOR_ARITH `fy - fx - (x - y) % c:real^N = --(fx - fy - (y - x) % c)`] THEN ASM_SIMP_TAC[NORM_NEG; REAL_ARITH `x <= y ==> abs(x - y) = y - x`]] THEN ASM_SIMP_TAC[GSYM CONTENT_1] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN EXISTS_TAC `(\u. f(u) - f(x)):real^1->real^N` THEN (ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONJ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; NORM_REAL; DROP_SUB; GSYM drop] THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC HAS_INTEGRAL_SUB THEN REWRITE_TAC[HAS_INTEGRAL_CONST]) THENL [SUBGOAL_THEN `integral(interval[a,x]) f + integral(interval[x,y]) f = integral(interval[a,y]) f /\ ((f:real^1->real^N) has_integral integral(interval[x,y]) f) (interval[x,y])` (fun th -> MESON_TAC[th; VECTOR_ARITH `a + b = c:real^N ==> c - a = b`]); SUBGOAL_THEN `integral(interval[a,y]) f + integral(interval[y,x]) f = integral(interval[a,x]) f /\ ((f:real^1->real^N) has_integral integral(interval[y,x]) f) (interval[y,x])` (fun th -> MESON_TAC[th; VECTOR_ARITH `a + b = c:real^N ==> c - a = b`])] THEN (CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_COMBINE; MATCH_MP_TAC INTEGRABLE_INTEGRAL] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN ASM_SIMP_TAC[INTEGRABLE_CONTINUOUS; SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC));; let INTEGRAL_HAS_VECTOR_DERIVATIVE = prove (`!f:real^1->real^N a b. f continuous_on interval[a,b] ==> !x. x IN interval[a,b] ==> ((\u. integral (interval[a,u]) f) has_vector_derivative f(x)) (at x within interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE THEN ASM_MESON_TAC[INTEGRABLE_CONTINUOUS; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]);; let ANTIDERIVATIVE_CONTINUOUS = prove (`!f:real^1->real^N a b. f continuous_on interval[a,b] ==> ?g. !x. x IN interval[a,b] ==> (g has_vector_derivative f(x)) (at x within interval[a,b])`, MESON_TAC[INTEGRAL_HAS_VECTOR_DERIVATIVE]);; (* ------------------------------------------------------------------------- *) (* Integrating characteristic function of an interval. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL = prove (`!f:real^M->real^N a b c d i. (f has_integral i) (interval[c,d]) /\ interval[c,d] SUBSET interval[a,b] ==> ((\x. if x IN interval(c,d) then f x else vec 0) has_integral i) (interval[a,b])`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[c:real^M,d] = {}` THENL [FIRST_ASSUM(MP_TAC o AP_TERM `interior:(real^M->bool)->(real^M->bool)`) THEN SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_EMPTY] THEN ASM_SIMP_TAC[NOT_IN_EMPTY; HAS_INTEGRAL_0_EQ; HAS_INTEGRAL_EMPTY_EQ]; ALL_TAC] THEN ABBREV_TAC `g:real^M->real^N = \x. if x IN interval(c,d) then f x else vec 0` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o MATCH_MP PARTIAL_DIVISION_EXTEND_1) THEN DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`lifted((+):real^N->real^N->real^N)`; `p:(real^M->bool)->bool`; `a:real^M`; `b:real^M`; `\i. if (g:real^M->real^N) integrable_on i then SOME (integral i g) else NONE`] OPERATIVE_DIVISION) THEN ASM_SIMP_TAC[OPERATIVE_INTEGRAL; MONOIDAL_LIFTED; MONOIDAL_VECTOR_ADD] THEN SUBGOAL_THEN `iterate (lifted (+)) p (\i. if (g:real^M->real^N) integrable_on i then SOME (integral i g) else NONE) = SOME i` SUBST1_TAC THENL [ALL_TAC; COND_CASES_TAC THEN REWRITE_TAC[distinctness "option"; injectivity "option"] THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`)) THEN ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_LIFTED; MONOIDAL_VECTOR_ADD; FINITE_DELETE; IN_DELETE] THEN SUBGOAL_THEN `(g:real^M->real^N) integrable_on interval[c,d]` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN MATCH_MP_TAC INTEGRABLE_SPIKE_INTERIOR THEN EXPAND_TAC "g" THEN SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `iterate (lifted (+)) (p DELETE interval[c,d]) (\i. if (g:real^M->real^N) integrable_on i then SOME (integral i g) else NONE) = SOME(vec 0)` SUBST1_TAC THENL [ALL_TAC; REWRITE_TAC[lifted; VECTOR_ADD_RID] THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN EXISTS_TAC `f:real^M->real^N` THEN EXPAND_TAC "g" THEN ASM_SIMP_TAC[]] THEN SIMP_TAC[GSYM NEUTRAL_VECTOR_ADD; GSYM NEUTRAL_LIFTED; MONOIDAL_VECTOR_ADD] THEN MATCH_MP_TAC(MATCH_MP ITERATE_EQ_NEUTRAL (MATCH_MP MONOIDAL_LIFTED(SPEC_ALL MONOIDAL_VECTOR_ADD))) THEN SIMP_TAC[NEUTRAL_LIFTED; NEUTRAL_VECTOR_ADD; MONOIDAL_VECTOR_ADD] THEN X_GEN_TAC `k:real^M->bool` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN SUBGOAL_THEN `((g:real^M->real^N) has_integral (vec 0)) k` (fun th -> MESON_TAC[th; integrable_on; INTEGRAL_UNIQUE]) THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN REWRITE_TAC[HAS_INTEGRAL_0] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`interval[c:real^M,d]`; `interval[u:real^M,v]`]) THEN ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM SET_TAC[]);; let HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL = prove (`!f:real^M->real^N a b c d i. (f has_integral i) (interval[c,d]) /\ interval[c,d] SUBSET interval[a,b] ==> ((\x. if x IN interval[c,d] then f x else vec 0) has_integral i) (interval[a,b])`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_INTEGRAL_SPIKE) THEN EXISTS_TAC `interval[c:real^M,d] DIFF interval(c,d)` THEN REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN REWRITE_TAC[IN_DIFF] THEN MP_TAC(ISPECL [`c:real^M`; `d:real^M`] INTERVAL_OPEN_SUBSET_CLOSED) THEN SET_TAC[]);; let HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ = prove (`!f:real^M->real^N a b c d i. interval[c,d] SUBSET interval[a,b] ==> (((\x. if x IN interval[c,d] then f x else vec 0) has_integral i) (interval[a,b]) <=> (f has_integral i) (interval[c,d]))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[c:real^M,d] = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; HAS_INTEGRAL_0_EQ; HAS_INTEGRAL_EMPTY_EQ]; ALL_TAC] THEN EQ_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL] THEN SUBGOAL_THEN `(f:real^M->real^N) integrable_on interval[c,d]` MP_TAC THENL [MATCH_MP_TAC INTEGRABLE_EQ THEN EXISTS_TAC `\x. if x IN interval[c:real^M,d] then f x:real^N else vec 0` THEN SIMP_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN MP_TAC(ASSUME `interval[c:real^M,d] SUBSET interval[a,b]`) THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL) THEN ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE; INTEGRABLE_INTEGRAL]);; (* ------------------------------------------------------------------------- *) (* Hence we can apply the limit process uniformly to all integrals. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL = prove (`!f:real^M->real^N i s. (f has_integral i) s <=> !e. &0 < e ==> ?B. &0 < B /\ !a b. ball(vec 0,B) SUBSET interval[a,b] ==> ?z. ((\x. if x IN s then f(x) else vec 0) has_integral z) (interval[a,b]) /\ norm(z - i) < e`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [has_integral_alt] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(X_CHOOSE_THEN `a:real^M` (X_CHOOSE_THEN `b:real^M` SUBST_ALL_TAC)) THEN MP_TAC(ISPECL [`a:real^M`; `b:real^M`] (CONJUNCT1 BOUNDED_INTERVAL)) THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `B + &1` THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_01] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN DISCH_TAC THEN EXISTS_TAC `i:real^N` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MATCH_MP_TAC HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL THEN ASM_MESON_TAC[SUBSET; REAL_ARITH `n <= B ==> n < B + &1`]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `?y. ((f:real^M->real^N) has_integral y) (interval[a,b])` MP_TAC THENL [SUBGOAL_THEN `?c d. interval[a,b] SUBSET interval[c,d] /\ (\x. if x IN interval[a,b] then (f:real^M->real^N) x else vec 0) integrable_on interval[c,d]` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `c:real^M = lambda i. --(max B C)` THEN ABBREV_TAC `d:real^M = lambda i. max B C` THEN MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN MATCH_MP_TAC(REAL_ARITH `x <= B ==> x <= max B C`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^M`; `d:real^M`]) THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN MATCH_MP_TAC(REAL_ARITH `x < C ==> x <= max B C`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MESON_TAC[integrable_on]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [integrable_on]) THEN ASM_SIMP_TAC[HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN SUBGOAL_THEN `i:real^N = y` ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `~(&0 < norm(y - i)) ==> i = y`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `norm(y - i:real^N)`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `C:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN ABBREV_TAC `c:real^M = lambda i. --(max B C)` THEN ABBREV_TAC `d:real^M = lambda i. max B C` THEN MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN MATCH_MP_TAC(REAL_ARITH `x < C ==> x <= max B C`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `interval[a:real^M,b] SUBSET interval[c,d]` ASSUME_TAC THENL [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN MATCH_MP_TAC(REAL_ARITH `x <= B ==> x <= max B C`) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ] THEN ASM_MESON_TAC[REAL_LT_REFL; HAS_INTEGRAL_UNIQUE]);; (* ------------------------------------------------------------------------- *) (* Hence a general restriction property. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_RESTRICT = prove (`!f:real^M->real^N s t i. s SUBSET t ==> (((\x. if x IN s then f x else vec 0) has_integral i) t <=> (f has_integral i) s)`, REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MESON[] `(if p then if q then x else y else y) = (if q then if p then x else y else y)`] THEN ASM_SIMP_TAC[]);; let INTEGRAL_RESTRICT = prove (`!f:real^M->real^N s t. s SUBSET t ==> integral t (\x. if x IN s then f x else vec 0) = integral s f`, SIMP_TAC[integral; HAS_INTEGRAL_RESTRICT]);; let INTEGRABLE_RESTRICT = prove (`!f:real^M->real^N s t. s SUBSET t ==> ((\x. if x IN s then f x else vec 0) integrable_on t <=> f integrable_on s)`, SIMP_TAC[integrable_on; HAS_INTEGRAL_RESTRICT]);; let HAS_INTEGRAL_RESTRICT_UNIV = prove (`!f:real^M->real^N s i. ((\x. if x IN s then f x else vec 0) has_integral i) (:real^M) <=> (f has_integral i) s`, SIMP_TAC[HAS_INTEGRAL_RESTRICT; SUBSET_UNIV]);; let INTEGRAL_RESTRICT_UNIV = prove (`!f:real^M->real^N s. integral (:real^M) (\x. if x IN s then f x else vec 0) = integral s f`, REWRITE_TAC[integral; HAS_INTEGRAL_RESTRICT_UNIV]);; let INTEGRABLE_RESTRICT_UNIV = prove (`!f s. (\x. if x IN s then f x else vec 0) integrable_on (:real^M) <=> f integrable_on s`, REWRITE_TAC[integrable_on; HAS_INTEGRAL_RESTRICT_UNIV]);; let HAS_INTEGRAL_RESTRICT_INTER = prove (`!f:real^M->real^N s t. ((\x. if x IN s then f x else vec 0) has_integral i) t <=> (f has_integral i) (s INTER t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[IN_INTER] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; let INTEGRAL_RESTRICT_INTER = prove (`!f:real^M->real^N s t. integral t (\x. if x IN s then f x else vec 0) = integral (s INTER t) f`, REWRITE_TAC[integral; HAS_INTEGRAL_RESTRICT_INTER]);; let INTEGRABLE_RESTRICT_INTER = prove (`!f:real^M->real^N s t. (\x. if x IN s then f x else vec 0) integrable_on t <=> f integrable_on (s INTER t)`, REWRITE_TAC[integrable_on; HAS_INTEGRAL_RESTRICT_INTER]);; let HAS_INTEGRAL_ON_SUPERSET = prove (`!f s t. (!x. ~(x IN s) ==> f x = vec 0) /\ s SUBSET t /\ (f has_integral i) s ==> (f has_integral i) t`, REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]);; let INTEGRABLE_ON_SUPERSET = prove (`!f s t. (!x. ~(x IN s) ==> f x = vec 0) /\ s SUBSET t /\ f integrable_on s ==> f integrable_on t`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_ON_SUPERSET]);; let NEGLIGIBLE_ON_INTERVALS = prove (`!s. negligible s <=> !a b:real^N. negligible(s INTER interval[a,b])`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[negligible] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN FIRST_ASSUM(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `s INTER interval[a:real^N,b]` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[indicator; IN_DIFF; IN_INTER] THEN MESON_TAC[]);; let NEGLIGIBLE_BOUNDED_SUBSETS = prove (`!s:real^N->bool. negligible s <=> !t. bounded t /\ t SUBSET s ==> negligible t`, MESON_TAC[NEGLIGIBLE_ON_INTERVALS; INTER_SUBSET; BOUNDED_SUBSET; BOUNDED_INTERVAL; NEGLIGIBLE_SUBSET]);; let NEGLIGIBLE_ON_COUNTABLE_INTERVALS = prove (`!s:real^N->bool. negligible s <=> !n. negligible (s INTER interval[--vec n,vec n])`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [NEGLIGIBLE_ON_INTERVALS] THEN EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a b:real^N. ?n. s INTER interval[a,b] = ((s INTER interval[--vec n,vec n]) INTER interval[a,b])` (fun th -> ASM_MESON_TAC[th; NEGLIGIBLE_ON_INTERVALS]) THEN REPEAT GEN_TAC THEN MP_TAC(ISPECL [`interval[a:real^N,b]`; `vec 0:real^N`] BOUNDED_SUBSET_CBALL) THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `i SUBSET b ==> b SUBSET n ==> s INTER i = (s INTER n) INTER i`)) THEN REWRITE_TAC[SUBSET; IN_CBALL_0; IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT; GSYM REAL_ABS_BOUNDS] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);; let HAS_INTEGRAL_SPIKE_SET_EQ = prove (`!f:real^M->real^N s t y. negligible(s DIFF t UNION t DIFF s) ==> ((f has_integral y) s <=> (f has_integral y) t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN EXISTS_TAC `s DIFF t UNION t DIFF s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let HAS_INTEGRAL_SPIKE_SET = prove (`!f:real^M->real^N s t y. negligible(s DIFF t UNION t DIFF s) /\ (f has_integral y) s ==> (f has_integral y) t`, MESON_TAC[HAS_INTEGRAL_SPIKE_SET_EQ]);; let INTEGRABLE_SPIKE_SET = prove (`!f:real^M->real^N s t. negligible(s DIFF t UNION t DIFF s) ==> f integrable_on s ==> f integrable_on t`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_SPIKE_SET_EQ]);; let INTEGRABLE_SPIKE_SET_EQ = prove (`!f:real^M->real^N s t. negligible(s DIFF t UNION t DIFF s) ==> (f integrable_on s <=> f integrable_on t)`, MESON_TAC[INTEGRABLE_SPIKE_SET; UNION_COMM]);; let INTEGRAL_SPIKE_SET = prove (`!f:real^M->real^N g s t. negligible(s DIFF t UNION t DIFF s) ==> integral s f = integral t f`, REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN ASM_MESON_TAC[]);; let HAS_INTEGRAL_INTERIOR = prove (`!f:real^M->real^N y s. negligible(frontier s) ==> ((f has_integral y) (interior s) <=> (f has_integral y) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^M->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let HAS_INTEGRAL_CLOSURE = prove (`!f:real^M->real^N y s. negligible(frontier s) ==> ((f has_integral y) (closure s) <=> (f has_integral y) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^M->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let INTEGRABLE_CASES = prove (`!f g:real^M->real^N s. f integrable_on {x | x IN s /\ P x} /\ g integrable_on {x | x IN s /\ ~P x} ==> (\x. if P x then f x else g x) integrable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_ADD) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ) THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]);; (* ------------------------------------------------------------------------- *) (* General "twiddling" for interval-to-interval function image. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_TWIDDLE = prove (`!f:real^N->real^P (g:real^M->real^N) h r i a b. &0 < r /\ (!x. h(g x) = x) /\ (!x. g(h x) = x) /\ (!x. g continuous at x) /\ (!u v. ?w z. IMAGE g (interval[u,v]) = interval[w,z]) /\ (!u v. ?w z. IMAGE h (interval[u,v]) = interval[w,z]) /\ (!u v. content(IMAGE g (interval[u,v])) = r * content(interval[u,v])) /\ (f has_integral i) (interval[a,b]) ==> ((\x. f(g x)) has_integral (inv r) % i) (IMAGE h (interval[a,b]))`, let lemma0 = prove (`(!x k. (x,k) IN IMAGE (\(x,k). f x,g k) p ==> P x k) <=> (!x k. (x,k) IN p ==> P (f x) (g k))`, REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]) and lemma1 = prove (`{k | ?x. (x,k) IN p} = IMAGE SND p`, REWRITE_TAC[EXTENSION; EXISTS_PAIR_THM; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]) and lemma2 = prove (`SND o (\(x,k). f x,g k) = g o SND`, REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM; o_DEF]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_INTEGRAL_EMPTY_EQ; VECTOR_MUL_RZERO] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[has_integral] THEN ASM_REWRITE_TAC[has_integral_def; has_integral_compact_interval] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e * r:real`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x y:real^M. (d:real^N->real^N->bool) (g x) (g y)` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN SIMP_TAC[gauge; IN; FORALL_AND_THM] THEN STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN SUBGOAL_THEN `(\y:real^M. (d:real^N->real^N->bool) (g x) (g y)) = {y | g y IN (d (g x))}` SUBST1_TAC THENL [SET_TAC[]; ASM_SIMP_TAC[CONTINUOUS_OPEN_PREIMAGE_UNIV]]; ALL_TAC] THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\(x,k). (g:real^M->real^N) x, IMAGE g k) p`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN REWRITE_TAC[fine; lemma0] THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `interval[a,b] = IMAGE ((g:real^M->real^N) o h) (interval[a,b])` SUBST1_TAC THENL [SIMP_TAC[o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?u v. IMAGE (h:real^N->real^M) (interval[a,b]) = interval[u,v]` (REPEAT_TCL CHOOSE_THEN (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN REWRITE_TAC[TAGGED_DIVISION_OF; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[lemma0] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE]; ALL_TAC] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN UNDISCH_TAC `!x:real^M k. x,k IN p ==> x IN k /\ k SUBSET interval[u,v] /\ ?w z. k = interval[w,z]` THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL [SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[lemma1; GSYM IMAGE_o; lemma2] THEN REWRITE_TAC[IMAGE_o; GSYM IMAGE_UNIONS; ETA_AX]] THEN MAP_EVERY X_GEN_TAC [`x1:real^M`; `k1:real^M->bool`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x2:real^M`; `k2:real^M->bool`] THEN STRIP_TAC THEN UNDISCH_TAC `!x1:real^M k1:real^M->bool. x1,k1 IN p ==> (!x2 k2. x2,k2 IN p /\ ~(x1,k1 = x2,k2) ==> interior k1 INTER interior k2 = {})` THEN DISCH_THEN(MP_TAC o SPECL [`x1:real^M`; `k1:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`x2:real^M`; `k2:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `interior(IMAGE f s) SUBSET IMAGE f (interior s) /\ interior(IMAGE f t) SUBSET IMAGE f (interior t) /\ (!x y. f x = f y ==> x = y) ==> interior s INTER interior t = {} ==> interior(IMAGE f s) INTER interior(IMAGE f t) = {}`) THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC INTERIOR_IMAGE_SUBSET) THEN ASM_MESON_TAC[]; ALL_TAC] THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) VSUM_IMAGE (lhand(rand(lhand(lhand w)))))) THEN ANTS_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs r` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs x`] THEN REWRITE_TAC[GSYM NORM_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a * b ==> x = y ==> y < b * a`)) THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID; GSYM VSUM_LMUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM; VECTOR_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[TAGGED_DIVISION_OF]);; let HAS_INTEGRAL_TWIDDLE_GEN = prove (`!f:real^N->real^P (g:real^M->real^N) h r i s. &0 < r /\ (!x. h(g x) = x) /\ (!x. g(h x) = x) /\ (!x. g continuous at x) /\ (!b. &0 < b ==> ?b'. &0 < b' /\ ball(vec 0,b) SUBSET IMAGE g (ball(vec 0,b'))) /\ (!u v. ?w z. IMAGE g (interval[u,v]) = interval[w,z]) /\ (!u v. ?w z. IMAGE h (interval[u,v]) = interval[w,z]) /\ (!u v. content(IMAGE g (interval[u,v])) = r * content(interval[u,v])) /\ (f has_integral i) s ==> ((\x. f(g x)) has_integral (inv r) % i) (IMAGE h s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e * r:real`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `B:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B':real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN SUBGOAL_THEN `?a' b'. IMAGE (g:real^M->real^N) (interval[a,b]) = interval[a',b']` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a':real^N`; `b':real^N`]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^P` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(r) % z:real^P` THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> inv(abs r) * x = x / r`] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN MP_TAC(ISPECL [`\x. if x IN s then (f:real^N->real^P) x else vec 0`; `g:real^M->real^N`; `h:real^N->real^M`; `r:real`; `z:real^P`; `a':real^N`; `b':real^N`] HAS_INTEGRAL_TWIDDLE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN MK_COMB_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Use this for various "trivial" change-of-variables results. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_TWIZZLE_INTERVAL = prove (`!f:real^N->real^P p a b:real^M. (f has_integral y) (interval[(lambda i. a$(p i)),(lambda i. b$(p i))]) /\ dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) ==> ((\x. f(lambda i. x$p i)) has_integral y) (interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^P`; `(\x. lambda i. x$(p i)):real^M->real^N`; `(\x. lambda i. x$(inverse p i)):real^N->real^M`; `&1`; `y:real^P`; `((\x. lambda i. x$(p i)):real^M->real^N) a`; `((\x. lambda i. x$(p i)):real^M->real^N) b`] HAS_INTEGRAL_TWIDDLE) THEN REWRITE_TAC[REAL_LT_01] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PERMUTES_INVERSE) THEN MP_TAC(SPEC `inverse p:num->num` (INST_TYPE [`:N`,`:M`; `:M`,`:N`] IMAGE_TWIZZLE_INTERVAL)) THEN MP_TAC(SPEC `p:num->num` IMAGE_TWIZZLE_INTERVAL) THEN ONCE_ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 (DISCH_THEN(fun th -> REWRITE_TAC[th])) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT]; MESON_TAC[]; MESON_TAC[]; MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN SIMP_TAC[REAL_MUL_LID; CONTENT_CLOSED_INTERVAL_CASES] THEN AP_THM_TAC THEN BINOP_TAC THENL [IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; MP_TAC(MATCH_MP PRODUCT_PERMUTE (ASSUME `p permutes 1..dimindex(:N)`)) THEN ASM_REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN REWRITE_TAC[o_DEF] THEN IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[] THEN IMP_REWRITE_TAC[LAMBDA_BETA]]]; REWRITE_TAC[o_DEF; REAL_INV_1; VECTOR_MUL_LID] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[PAIR_EQ; LAMBDA_BETA; CART_EQ] THEN IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]]);; let HAS_INTEGRAL_TWIZZLE = prove (`!f:real^N->real^P s:real^M->bool y p. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) /\ (f has_integral y) (IMAGE (\x. lambda i. x$p i) s) ==> ((\x. f(lambda i. x$p i)) has_integral y) s`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(lambda i. (a:real^M)$p i):real^N`; `(lambda i. (b:real^M)$p i):real^N`]) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN SIMP_TAC[SUBSET; IN_BALL_0; IN_INTERVAL; LAMBDA_BETA] THEN ASM_REWRITE_TAC[NORM_LT_SQUARE; dot] THEN DISCH_TAC THEN ANTS_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (x:real^N)$(inverse p i)):real^M`) THEN SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> x = y ==> y < a`)) THEN FIRST_ASSUM(MP_TAC o GSYM o MATCH_MP SUM_PERMUTE o MATCH_MP PERMUTES_INVERSE) THEN ONCE_ASM_REWRITE_TAC[] THEN SIMP_TAC[o_DEF]; REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^P` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_TWIZZLE_INTERVAL)) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[]] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) ==> (f x IN IMAGE f s <=> x IN s)`) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]);; let HAS_INTEGRAL_TWIZZLE_EQ = prove (`!f:real^N->real^P s:real^M->bool y p. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) ==> ((f has_integral y) (IMAGE (\x. lambda i. x$p i) s) <=> ((\x. f(lambda i. x$p i)) has_integral y) s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[HAS_INTEGRAL_TWIZZLE]; ALL_TAC] THEN MP_TAC(ISPECL [`(f:real^N->real^P) o ((\x. lambda i. x$p i):real^M->real^N)`; `IMAGE ((\x. lambda i. x$p i):real^M->real^N) s`; `y:real^P`; `inverse p:num->num`] HAS_INTEGRAL_TWIZZLE) THEN REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[PERMUTES_INVERSE; o_DEF; GSYM IMAGE_o] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THEN MATCH_MP_TAC EQ_IMP THENL [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. f x = x) ==> s = IMAGE f s`) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]; AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; FUN_EQ_THM; LAMBDA_BETA]] THEN IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]);; let INTEGRABLE_TWIZZLE_EQ = prove (`!f:real^N->real^P s:real^M->bool p. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) ==> (f integrable_on IMAGE (\x. lambda i. x$p i) s <=> (\x. f(lambda i. x$p i)) integrable_on s)`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_TWIZZLE_EQ) THEN ASM_REWRITE_TAC[integrable_on]);; let INTEGRAL_TWIZZLE_EQ = prove (`!f:real^N->real^P s:real^M->bool p. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) ==> integral (IMAGE (\x. lambda i. x$p i) s) f = integral s (\x. f(lambda i. x$p i))`, REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_TWIZZLE_EQ THEN FIRST_X_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[]);; let HAS_INTEGRAL_PASTECART_SYM_ALT = prove (`!f:real^(M,N)finite_sum->real^P s y. ((\z. f(pastecart (sndcart z) (fstcart z))) has_integral y) s <=> (f has_integral y) (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?p. p permutes 1..dimindex(:(M,N)finite_sum) /\ !z. pastecart (sndcart z:real^M) (fstcart z:real^N) = lambda i. z$(p i)` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `\i. if 1 <= i /\ i <= dimindex(:M) then i + dimindex(:N) else if i <= dimindex(:M) + dimindex(:N) then i - dimindex(:M) else i` THEN CONJ_TAC THENL [MATCH_MP_TAC PERMUTES_BIJECTIONS THEN EXISTS_TAC `\i. if 1 <= i /\ i <= dimindex(:N) then i + dimindex(:M) else if i <= dimindex(:M) + dimindex(:N) then i - dimindex(:N) else i` THEN SIMP_TAC[IN_NUMSEG; DIMINDEX_FINITE_SUM] THEN ARITH_TAC; SIMP_TAC[FUN_EQ_THM; CART_EQ; pastecart; LAMBDA_BETA] THEN SIMP_TAC[fstcart; sndcart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ARITH_RULE `i:num <= n ==> i + m <= n + m`] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN TRY(MATCH_MP_TAC LAMBDA_BETA) THEN ASM_ARITH_TAC]; ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HAS_INTEGRAL_TWIZZLE_EQ THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM]]);; let HAS_INTEGRAL_PASTECART_SYM = prove (`!f:real^(M,N)finite_sum->real^P s y. ((\z. f(pastecart (sndcart z) (fstcart z))) has_integral y) (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) <=> (f has_integral y) s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^(M,N)finite_sum->real^P`; `IMAGE (\z. pastecart (sndcart z) (fstcart z)) (s:real^(M,N)finite_sum->bool)`; `y:real^P`] HAS_INTEGRAL_PASTECART_SYM_ALT) THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[PASTECART_FST_SND; IMAGE_ID]);; let INTEGRAL_PASTECART_SYM = prove (`!f:real^(M,N)finite_sum->real^P s y. integral (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) (\z. f(pastecart (sndcart z) (fstcart z))) = integral s f`, REWRITE_TAC[integral; HAS_INTEGRAL_PASTECART_SYM]);; let INTEGRABLE_PASTECART_SYM = prove (`!f:real^(M,N)finite_sum->real^P s y. (\z. f(pastecart (sndcart z) (fstcart z))) integrable_on (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) <=> f integrable_on s`, REWRITE_TAC[integrable_on; HAS_INTEGRAL_PASTECART_SYM]);; let INTERVAL_IMAGE_AFFINITY_INTERVAL = prove (`!a b m c. ?u v. IMAGE (\x. m % x + c) (interval[a,b]) = interval[u,v]`, REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]);; let CONTENT_IMAGE_AFFINITY_INTERVAL = prove (`!a b:real^N m c. content(IMAGE (\x. m % x + c) (interval[a,b])) = (abs m) pow (dimindex(:N)) * content(interval[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTENT_EMPTY; REAL_MUL_RZERO] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN COND_CASES_TAC THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) CONTENT_CLOSED_INTERVAL (lhs w))) THEN (ANTS_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; REAL_LE_RADD; REAL_LE_LMUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `m * b <= m * a <=> --m * a <= --m * b`] THEN ASM_SIMP_TAC[REAL_ARITH `~(&0 <= x) ==> &0 <= --x`; REAL_LE_LMUL]; ALL_TAC]) THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[GSYM PRODUCT_CONST_NUMSEG_1] THEN ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM PRODUCT_MUL_NUMSEG] THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_NUMSEG; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_REAL_ARITH_TAC);; let HAS_INTEGRAL_AFFINITY = prove (`!f:real^M->real^N i s m c. (f has_integral i) s /\ ~(m = &0) ==> ((\x. f(m % x + c)) has_integral (inv(abs(m) pow dimindex(:M)) % i)) (IMAGE (\x. inv m % x + --(inv(m) % c)) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_TWIDDLE_GEN THEN ASM_SIMP_TAC[INTERVAL_IMAGE_AFFINITY_INTERVAL; GSYM REAL_ABS_NZ; REAL_POW_LT; PRODUCT_EQ_0_NUMSEG; CONTENT_IMAGE_AFFINITY_INTERVAL] THEN ASM_SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID; CONTINUOUS_CONST; CONTINUOUS_ADD] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; VECTOR_MUL_RNEG] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV] THEN REPEAT(CONJ_TAC THENL [VECTOR_ARITH_TAC; ALL_TAC]) THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN EXISTS_TAC `(b + norm(c:real^M)) / abs m` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN MATCH_MP_TAC REAL_LTE_ADD THEN ASM_REWRITE_TAC[NORM_POS_LE]; REWRITE_TAC[SUBSET; IN_IMAGE; IN_BALL_0] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `inv(m) % (x - c):real^M` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_MUL; REAL_ABS_INV] THEN CONJ_TAC THENL [CONV_TAC VECTOR_ARITH; ALL_TAC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; GSYM REAL_ABS_NZ] THEN UNDISCH_TAC `norm(x:real^M) < b` THEN CONV_TAC NORM_ARITH]);; let INTEGRABLE_AFFINITY = prove (`!f:real^M->real^N s m c. f integrable_on s /\ ~(m = &0) ==> (\x. f(m % x + c)) integrable_on (IMAGE (\x. inv m % x + --(inv(m) % c)) s)`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_AFFINITY]);; let CONTENT_IMAGE_STRETCH_INTERVAL = prove (`!a b:real^N m. content(IMAGE (\x. lambda k. m k * x$k) (interval[a,b]):real^N->bool) = abs(product(1..dimindex(:N)) m) * content(interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[content; IMAGE_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN ASM_REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; LAMBDA_BETA; REAL_ARITH `min a b <= max a b`] THEN ASM_REWRITE_TAC[REAL_ARITH `max a b - min a b = abs(b - a)`; GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN ASM_SIMP_TAC[PRODUCT_MUL; FINITE_NUMSEG; REAL_ARITH `a <= b ==> abs(b - a) = b - a`] THEN ASM_SIMP_TAC[PRODUCT_ABS; FINITE_NUMSEG]);; let HAS_INTEGRAL_STRETCH = prove (`!f:real^M->real^N i m a b. (f has_integral i) (interval[a,b]) /\ (!k. 1 <= k /\ k <= dimindex(:M) ==> ~(m k = &0)) ==> ((\x:real^M. f(lambda k. m k * x$k)) has_integral (inv(abs(product(1..dimindex(:M)) m)) % i)) (IMAGE (\x. lambda k. inv(m k) * x$k) (interval[a,b]))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_TWIDDLE THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV; REAL_MUL_LID] THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; PRODUCT_EQ_0_NUMSEG] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN SIMP_TAC[linear; LAMBDA_BETA; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC; REWRITE_TAC[CONTENT_IMAGE_STRETCH_INTERVAL] THEN REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]]);; let INTEGRABLE_STRETCH = prove (`!f:real^M->real^N m a b. f integrable_on interval[a,b] /\ (!k. 1 <= k /\ k <= dimindex(:M) ==> ~(m k = &0)) ==> (\x:real^M. f(lambda k. m k * x$k)) integrable_on (IMAGE (\x. lambda k. inv(m k) * x$k) (interval[a,b]))`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_STRETCH]);; let HAS_INTEGRAL_REFLECT_LEMMA = prove (`!f:real^M->real^N i a b. (f has_integral i) (interval[a,b]) ==> ((\x. f(--x)) has_integral i) (interval[--b,--a])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o C CONJ (REAL_ARITH `~(-- &1 = &0)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^M`) THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_POW_ONE] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_NEG_0] THEN REWRITE_TAC[REAL_INV_NEG; REAL_INV_1] THEN REWRITE_TAC[VECTOR_ARITH `-- &1 % x + vec 0 = --x`] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN POP_ASSUM(K ALL_TAC) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN SIMP_TAC[VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);; let HAS_INTEGRAL_REFLECT = prove (`!f:real^M->real^N i a b. ((\x. f(--x)) has_integral i) (interval[--b,--a]) <=> (f has_integral i) (interval[a,b])`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_REFLECT_LEMMA) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; let INTEGRABLE_REFLECT = prove (`!f:real^M->real^N a b. (\x. f(--x)) integrable_on (interval[--b,--a]) <=> f integrable_on (interval[a,b])`, REWRITE_TAC[integrable_on; HAS_INTEGRAL_REFLECT]);; let INTEGRAL_REFLECT = prove (`!f:real^M->real^N a b. integral (interval[--b,--a]) (\x. f(--x)) = integral (interval[a,b]) f`, REWRITE_TAC[integral; HAS_INTEGRAL_REFLECT]);; let HAS_INTEGRAL_TRANSLATION = prove (`!f:real^M->real^N i s a. ((\x. f(a + x)) has_integral i) s <=> (f has_integral i) (IMAGE (\x. a + x) s)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o SPEC `&1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY)) THENL [DISCH_THEN(MP_TAC o SPEC `--a:real^M`); DISCH_THEN(MP_TAC o SPEC `a:real^M`)] THEN REWRITE_TAC[REAL_INV_1; REAL_ABS_NUM; REAL_POW_ONE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_ARITH `a + x + --a:real^N = x`; ETA_AX; GSYM IMAGE_o; VECTOR_ARITH `x + -- -- a:real^N = a + x`; o_DEF; IMAGE_ID; VECTOR_ARITH `(a + x) + --a:real^N = x`] THEN REWRITE_TAC[VECTOR_ADD_SYM]);; let INTEGRAL_TRANSLATION = prove (`!f:real^M->real^N s a. integral s (\x. f (a + x)) = integral (IMAGE (\x. a + x) s) f`, REWRITE_TAC[integral; GSYM HAS_INTEGRAL_TRANSLATION]);; let INTEGRABLE_TRANSLATION = prove (`!f:real^M->real^N s a. (\x. f(a + x)) integrable_on s <=> f integrable_on (IMAGE (\x. a + x) s)`, REWRITE_TAC[integrable_on; GSYM HAS_INTEGRAL_TRANSLATION]);; (* ------------------------------------------------------------------------- *) (* Technical lemmas about how many non-trivial intervals of a division a *) (* point can be in (we sometimes need this for bounding sums). *) (* ------------------------------------------------------------------------- *) let DIVISION_COMMON_POINT_BOUND = prove (`!d s:real^N->bool x. d division_of s ==> CARD {k | k IN d /\ ~(content k = &0) /\ x IN k} <= 2 EXP (dimindex(:N))`, let lemma = prove (`!f s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ FINITE s /\ CARD(IMAGE f s) <= n ==> CARD(s) <= n`, MESON_TAC[CARD_IMAGE_INJ]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `!k. k IN d ==> ?a b:real^N. interval[a,b] = k` MP_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`A:(real^N->bool)->real^N`; `B:(real^N->bool)->real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `\d. (lambda i. (x:real^N)$i = (A:(real^N->bool)->real^N)(d)$i):bool^N` lemma) THEN REPEAT CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[division_of]; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(:bool^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[SUBSET_UNIV] THEN SIMP_TAC[FINITE_CART_UNIV; FINITE_BOOL]; SIMP_TAC[FINITE_BOOL; CARD_CART_UNIV; CARD_BOOL; LE_REFL]]] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN SIMP_TAC[IN_ELIM_THM; CART_EQ; LAMBDA_BETA] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN MATCH_MP_TAC(TAUT `~q ==> (~p ==> q) ==> p`) THEN MAP_EVERY UNDISCH_TAC [`(x:real^N) IN k`; `(x:real^N) IN l`; `~(content(k:real^N->bool) = &0)`; `~(content(l:real^N->bool) = &0)`] THEN SUBGOAL_THEN `k = interval[A k:real^N,B k] /\ l = interval[A l,B l]` (CONJUNCTS_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[]; REWRITE_TAC[INTER_INTERVAL]] THEN REWRITE_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL] THEN SIMP_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND = prove (`!p s:real^N->bool y. p tagged_partial_division_of s ==> CARD {(x,k) | (x,k) IN p /\ y IN k /\ ~(content k = &0)} <= 2 EXP (dimindex(:N))`, let lemma = prove (`!f s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ FINITE s /\ CARD(IMAGE f s) <= n ==> CARD(s) <= n`, MESON_TAC[CARD_IMAGE_INJ]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `SND` lemma) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM; PAIR_EQ] THEN MAP_EVERY X_GEN_TAC [`x1:real^N`; `k1:real^N->bool`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x2:real^N`; `k2:real^N->bool`] THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`x1:real^N`; `k1:real^N->bool`; `x2:real^N`; `k2:real^N->bool`] o CONJUNCT2 o CONJUNCT2) THEN ASM_REWRITE_TAC[PAIR_EQ] THEN MATCH_MP_TAC(TAUT `~q ==> (~p ==> q) ==> p`) THEN REWRITE_TAC[INTER_ACI] THEN ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR; tagged_partial_division_of]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `p:real^N#(real^N->bool)->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; SET_TAC[]]; FIRST_ASSUM(MP_TAC o MATCH_MP PARTIAL_DIVISION_OF_TAGGED_DIVISION) THEN DISCH_THEN(MP_TAC o SPEC `y:real^N` o MATCH_MP DIVISION_COMMON_POINT_BOUND) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN MESON_TAC[]; MATCH_MP_TAC FINITE_RESTRICT THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_MESON_TAC[tagged_partial_division_of]]]);; let TAGGED_PARTIAL_DIVISION_COMMON_TAGS = prove (`!p s:real^N->bool x. p tagged_partial_division_of s ==> CARD {(x,k) | k | (x,k) IN p /\ ~(content k = &0)} <= 2 EXP (dimindex(:N))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN ASM_MESON_TAC[tagged_partial_division_of]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `p:real^N#(real^N->bool)->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* More lemmas that are useful later. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_DROP_POS_AE = prove (`!f:real^M->real^1 s t i. (f has_integral i) s /\ negligible t /\ (!x. x IN s DIFF t ==> &0 <= drop(f x)) ==> &0 <= drop i`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS THEN EXISTS_TAC `f:real^M->real^1` THEN EXISTS_TAC `s DIFF t:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);; let INTEGRAL_DROP_POS_AE = prove (`!f:real^M->real^1 s t. f integrable_on s /\ negligible t /\ (!x. x IN s DIFF t ==> &0 <= drop(f x)) ==> &0 <= drop(integral s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS_AE THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let HAS_INTEGRAL_SUBSET_COMPONENT_LE = prove (`!f:real^M->real^N s t i j k. s SUBSET t /\ (f has_integral i) s /\ (f has_integral j) t /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN t ==> &0 <= f(x)$k) ==> i$k <= j$k`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN MAP_EVERY EXISTS_TAC [`(\x. if x IN s then f x else vec 0):real^M->real^N`; `(\x. if x IN t then f x else vec 0):real^M->real^N`; `(:real^M)`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN ASM_SIMP_TAC[VEC_COMPONENT] THEN ASM SET_TAC[]);; let INTEGRAL_SUBSET_COMPONENT_LE = prove (`!f:real^M->real^N s t k. s SUBSET t /\ f integrable_on s /\ f integrable_on t /\ 1 <= k /\ k <= dimindex(:N) /\ (!x. x IN t ==> &0 <= f(x)$k) ==> (integral s f)$k <= (integral t f)$k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SUBSET_COMPONENT_LE THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let HAS_INTEGRAL_SUBSET_DROP_LE = prove (`!f:real^M->real^1 s t i j. s SUBSET t /\ (f has_integral i) s /\ (f has_integral j) t /\ (!x. x IN t ==> &0 <= drop(f x)) ==> drop i <= drop j`, REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SUBSET_COMPONENT_LE THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; let INTEGRAL_SUBSET_DROP_LE = prove (`!f:real^M->real^1 s t. s SUBSET t /\ f integrable_on s /\ f integrable_on t /\ (!x. x IN t ==> &0 <= drop(f(x))) ==> drop(integral s f) <= drop(integral t f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SUBSET_DROP_LE THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let INTEGRAL_SUBSET_DROP_LE_AE = prove (`!f:real^M->real^1 s t u. s SUBSET t /\ f integrable_on s /\ f integrable_on t /\ negligible u /\ (!x. x IN t DIFF u ==> &0 <= drop(f(x))) ==> drop(integral s f) <= drop(integral t f)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^1`; `s DIFF u:real^M->bool`; `t DIFF u:real^M->bool`] INTEGRAL_SUBSET_DROP_LE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; CONJ_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THENL [EXISTS_TAC `s:real^M->bool`; EXISTS_TAC `t:real^M->bool`] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);; let HAS_INTEGRAL_ALT = prove (`!f:real^M->real^N s i. (f has_integral i) s <=> (!a b. (\x. if x IN s then f x else vec 0) integrable_on interval[a,b]) /\ (!e. &0 < e ==> ?B. &0 < B /\ !a b. ball (vec 0,B) SUBSET interval[a,b] ==> norm(integral(interval[a,b]) (\x. if x IN s then f x else vec 0) - i) < e)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL] THEN SPEC_TAC(`\x. if x IN s then (f:real^M->real^N) x else vec 0`, `f:real^M->real^N`) THEN GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[INTEGRAL_UNIQUE; integrable_on]] THEN DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTEGRAL_UNIQUE]] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN POP_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN EXISTS_TAC `(lambda i. min ((a:real^M)$i) (--B)):real^M` THEN EXISTS_TAC `(lambda i. max ((b:real^M)$i) B):real^M` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`(lambda i. min ((a:real^M)$i) (--B)):real^M`; `(lambda i. max ((b:real^M)$i) B):real^M`]) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[integrable_on]]; SIMP_TAC[SUBSET; IN_INTERVAL; IN_BALL; LAMBDA_BETA; REAL_MIN_LE; REAL_LE_MAX]] THEN SIMP_TAC[SUBSET; IN_BALL; IN_INTERVAL; LAMBDA_BETA] THEN GEN_TAC THEN REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm x`] THEN DISCH_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= B ==> min a (--B) <= x /\ x <= max b B`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPONENT_LE_NORM]);; let INTEGRABLE_ALT = prove (`!f:real^M->real^N s. f integrable_on s <=> (!a b. (\x. if x IN s then f x else vec 0) integrable_on interval[a,b]) /\ (!e. &0 < e ==> ?B. &0 < B /\ !a b c d. ball(vec 0,B) SUBSET interval[a,b] /\ ball(vec 0,B) SUBSET interval[c,d] ==> norm(integral (interval[a,b]) (\x. if x IN s then f x else vec 0) - integral (interval[c,d]) (\x. if x IN s then f x else vec 0)) < e)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [integrable_on] THEN ONCE_REWRITE_TAC[HAS_INTEGRAL_ALT] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN DISCH_TAC THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN MESON_TAC[NORM_ARITH `norm(a - y) < e / &2 /\ norm(b - y) < e / &2 ==> norm(a - b) < e`]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `cauchy (\n. integral (interval[(lambda i. --(&n)),(lambda i. &n)]) (\x. if x IN s then (f:real^M->real^N) x else vec 0))` MP_TAC THENL [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `B:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN REWRITE_TAC[dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN CONJ_TAC; REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(LABEL_TAC "C") THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "C" (MP_TAC o SPEC `e / &2`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN MP_TAC(SPEC `max (&N) B` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[REAL_MAX_LE; REAL_OF_NUM_LE] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&n` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(i1 - i2) < e / &2 ==> dist(i1,i) < e / &2 ==> norm(i2 - i) < e`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(vec 0:real^M,&n)` THEN ASM_SIMP_TAC[SUBSET_BALL] THEN REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`]] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN REAL_ARITH_TAC);; let INTEGRABLE_ALT_SUBSET = prove (`!f:real^M->real^N s. f integrable_on s <=> (!a b. (\x. if x IN s then f x else vec 0) integrable_on interval[a,b]) /\ (!e. &0 < e ==> ?B. &0 < B /\ !a b c d. ball(vec 0,B) SUBSET interval[a,b] /\ interval[a,b] SUBSET interval[c,d] ==> norm(integral (interval[a,b]) (\x. if x IN s then f x else vec 0) - integral (interval[c,d]) (\x. if x IN s then f x else vec 0)) < e)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [INTEGRABLE_ALT] THEN ABBREV_TAC `g:real^M->real^N = \x. if x IN s then f x else vec 0` THEN POP_ASSUM(K ALL_TAC) THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN DISCH_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSET_TRANS]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real^M`; `d:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(lambda i. max ((a:real^M)$i) ((c:real^M)$i)):real^M`; `(lambda i. min ((b:real^M)$i) ((d:real^M)$i)):real^M`]) THEN ASM_REWRITE_TAC[GSYM INTER_INTERVAL; SUBSET_INTER] THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`a:real^M`; `b:real^M`] th) THEN MP_TAC(ISPECL [`c:real^M`; `d:real^M`] th)) THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN NORM_ARITH_TAC);; let INTEGRABLE_ON_SUBINTERVAL = prove (`!f:real^M->real^N s a b. f integrable_on s /\ interval[a,b] SUBSET s ==> f integrable_on interval[a,b]`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [INTEGRABLE_ALT] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o CONJUNCT1) ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ) THEN ASM SET_TAC[]);; let INTEGRAL_SPLIT = prove (`!f:real^M->real^N a b t k. f integrable_on interval[a,b] /\ 1 <= k /\ k <= dimindex(:M) ==> integral (interval[a,b]) f = integral(interval [a,(lambda i. if i = k then min (b$k) t else b$i)]) f + integral(interval [(lambda i. if i = k then max (a$k) t else a$i),b]) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_SPLIT THEN MAP_EVERY EXISTS_TAC [`k:num`; `t:real`] THEN ASM_SIMP_TAC[INTERVAL_SPLIT; GSYM HAS_INTEGRAL_INTEGRAL] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let INTEGRAL_SPLIT_SIGNED = prove (`!f:real^M->real^N a b t k. 1 <= k /\ k <= dimindex(:M) /\ a$k <= t /\ a$k <= b$k /\ f integrable_on interval[a,(lambda i. if i = k then max (b$k) t else b$i)] ==> integral (interval[a,b]) f = integral(interval [a,(lambda i. if i = k then t else b$i)]) f + (if b$k < t then -- &1 else &1) % integral(interval [(lambda i. if i = k then min (b$k) t else a$i), (lambda i. if i = k then max (b$k) t else b$i)]) f`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `(lambda i. if i = k then t else (b:real^M)$i):real^M`; `(b:real^M)$k`; `k:num`] INTEGRAL_SPLIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN ASM_SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `x = y /\ w = z ==> x:real^N = (y + z) + --(&1) % w`) THEN CONJ_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ; CART_EQ] THEN TRY CONJ_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]; MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `t:real`; `k:num`] INTEGRAL_SPLIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN ASM_SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ; CART_EQ] THEN TRY CONJ_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]]);; let INTEGRAL_INTERVALS_INCLUSION_EXCLUSION = prove (`!f:real^M->real^N a b c d. f integrable_on interval[a,b] /\ c IN interval[a,b] /\ d IN interval[a,b] ==> integral(interval[a,d]) f = vsum {s | s SUBSET 1..dimindex(:M)} (\s. --(&1) pow CARD {i | i IN s /\ d$i < c$i} % integral (interval[(lambda i. if i IN s then min (c$i) (d$i) else (a:real^M)$i), (lambda i. if i IN s then max (c$i) (d$i) else c$i)]) f)`, let lemma1 = prove (`!f:(num->bool)->real^N n. vsum {s | s SUBSET 1..SUC n} f = vsum {s | s SUBSET 1..n} f + vsum {s | s SUBSET 1..n} (\s. f(SUC n INSERT s))`, REPEAT STRIP_TAC THEN REWRITE_TAC[NUMSEG_CLAUSES; ARITH_RULE `1 <= SUC n`; POWERSET_CLAUSES] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhs o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET; FINITE_NUMSEG] THEN REWRITE_TAC[SET_RULE `DISJOINT s (IMAGE f t) <=> !x. x IN t ==> ~(f x IN s)`] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[IN_INSERT; IN_NUMSEG] THEN ARITH_TAC; DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] VSUM_IMAGE) THEN SIMP_TAC[FINITE_POWERSET; FINITE_NUMSEG] THEN MAP_EVERY X_GEN_TAC [`s:num->bool`; `t:num->bool`] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(SET_RULE `~(a IN i) ==> s SUBSET i /\ t SUBSET i /\ a INSERT s = a INSERT t ==> s = t`) THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC]) in let lemma2 = prove (`!f:real^M->real^N m a:real^M c:real^M d:real^M. f integrable_on (:real^M) /\ m <= dimindex(:M) /\ (!i. m < i /\ i <= dimindex(:M) ==> a$i = c$i \/ d$i = c$i) /\ (!i. m < i /\ i <= dimindex(:M) ==> a$i = c$i ==> a$i = d$i) /\ (!i. 1 <= i /\ i <= dimindex(:M) ==> a$i <= c$i /\ a$i <= d$i) ==> integral(interval[a,d]) f = vsum {s | s SUBSET 1..m} (\s. --(&1) pow CARD {i | i IN s /\ d$i < c$i} % integral (interval[(lambda i. if i IN s then min (c$i) (d$i) else (a:real^M)$i), (lambda i. if i IN s then max (c$i) (d$i) else c$i)]) f)`, GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUBSET_EMPTY; SING_GSPEC] THEN REWRITE_TAC[VSUM_SING; NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES] THEN REWRITE_TAC[real_pow; LAMBDA_ETA; VECTOR_MUL_LID] THEN REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `?k. 1 <= k /\ k <= dimindex(:M) /\ (a:real^M)$k = (c:real^M)$k` THENL [MATCH_MP_TAC(MESON[] `i = vec 0 /\ j = vec 0 ==> i:real^N = j`) THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_NULL THEN REWRITE_TAC[CONTENT_EQ_0] THEN ASM_MESON_TAC[]; SUBGOAL_THEN `d:real^M = c:real^M` (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[CART_EQ] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[lemma1] THEN SUBGOAL_THEN `!s. s SUBSET 1..m ==> --(&1) pow CARD {i | i IN SUC m INSERT s /\ d$i < c$i} = (if (d:real^M)$(SUC m) < (c:real^M)$(SUC m) then -- &1 else &1) * --(&1) pow CARD {i | i IN s /\ d$i < c$i}` (fun th -> SIMP_TAC[th; IN_ELIM_THM]) THENL [X_GEN_TAC `s:num->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `FINITE(s:num->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_NUMSEG; FINITE_SUBSET]; ALL_TAC] THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RESTRICT; SET_RULE `P a ==> {x | x IN a INSERT s /\ P x} = a INSERT {x | x IN s /\ P x}`] THEN REWRITE_TAC[IN_ELIM_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[real_pow] THEN SUBGOAL_THEN `~(SUC m IN 1..m)` (fun th -> ASM SET_TAC[th]) THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ASM_SIMP_TAC[REAL_MUL_LID; SET_RULE `~(P a) ==> {x | x IN a INSERT s /\ P x} = {x | x IN s /\ P x}`]]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `d:real^M`; `(c:real^M)$SUC m`; `SUC m`] INTEGRAL_SPLIT_SIGNED) THEN ANTS_TAC THENL [ASM_MESON_TAC[ARITH_RULE `1 <= SUC n`; INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN BINOP_TAC THENL [ALL_TAC; AP_TERM_TAC] THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `c:real^M`; `(lambda i. if i = SUC m then (c:real^M)$SUC m else (d:real^M)$i):real^M`]); FIRST_X_ASSUM(MP_TAC o SPECL [`(lambda i. if i = SUC m then min ((d:real^M)$SUC m) ((c:real^M)$SUC m) else (a:real^M)$i):real^M`; `(lambda i. if i = SUC m then max ((d:real^M)$SUC m) ((c:real^M)$SUC m) else (c:real^M)$i):real^M`; `(lambda i. if i = SUC m then max ((d:real^M)$SUC m) ((c:real^M)$SUC m) else d$i):real^M`])] THEN (ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `m < i <=> i = SUC m \/ SUC m < i`]; X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN TRY REAL_ARITH_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:num->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN BINOP_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `i IN 1..m` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN SUBGOAL_THEN `i <= dimindex(:M)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[IN_INSERT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN TRY REAL_ARITH_TAC THEN SUBGOAL_THEN `~(SUC m IN 1..m)` (fun th -> ASM SET_TAC[th]) THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC]])) in REWRITE_TAC[IN_INTERVAL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. if x IN interval[a,b] then (f:real^M->real^N) x else vec 0`; `dimindex(:M)`; `a:real^M`; `c:real^M`; `d:real^M`] lemma2) THEN ASM_SIMP_TAC[LTE_ANTISYM; INTEGRABLE_RESTRICT_UNIV; LE_REFL] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [ALL_TAC; MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:num->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN AP_TERM_TAC] THEN MATCH_MP_TAC INTEGRAL_EQ THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `i SUBSET j ==> !x. x IN i ==> (if x IN j then f x else b) = f x`) THEN ASM_SIMP_TAC[SUBSET_INTERVAL; REAL_LE_REFL; LAMBDA_BETA] THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION = prove (`!f:real^M->real^N a b c d. f integrable_on interval[a,b] /\ c IN interval[a,b] /\ d IN interval[a,b] ==> integral(interval[a,d]) f - integral(interval[a,c]) f = vsum {s | ~(s = {}) /\ s SUBSET 1..dimindex(:M)} (\s. --(&1) pow CARD {i | i IN s /\ d$i < c$i} % integral (interval[(lambda i. if i IN s then min (c$i) (d$i) else (a:real^M)$i), (lambda i. if i IN s then max (c$i) (d$i) else c$i)]) f)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_INTERVALS_INCLUSION_EXCLUSION) THEN REWRITE_TAC[SET_RULE `{s | ~(s = a) /\ P s} = {s | P s} DELETE a`] THEN SIMP_TAC[VSUM_DELETE; FINITE_POWERSET; FINITE_NUMSEG; EMPTY_SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES; LAMBDA_ETA] THEN REWRITE_TAC[real_pow; VECTOR_MUL_LID]);; let INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT = prove (`!f:real^M->real^N a b c. f integrable_on interval[a,b] /\ c IN interval[a,b] ==> integral(interval[a,c]) f = vsum {s | s SUBSET 1..dimindex (:M)} (\s. --(&1) pow CARD s % integral (interval[(lambda i. if i IN s then c$i else a$i), b]) f)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `b:real^M`; `c:real^M`] INTEGRAL_INTERVALS_INCLUSION_EXCLUSION) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; MEMBER_NOT_EMPTY]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:num->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_CASES_TAC `?k. k IN s /\ (c:real^M)$k = (b:real^M)$k` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `1 <= k /\ k <= dimindex(:M)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[IN_NUMSEG; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `a:real^N = vec 0 /\ b = vec 0 ==> a = b`) THEN CONJ_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN MATCH_MP_TAC INTEGRAL_NULL THEN REWRITE_TAC[CONTENT_EQ_0] THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN BINOP_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_LE; SUBSET; IN_NUMSEG]; AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; PAIR_EQ; LAMBDA_BETA] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; let INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT = prove (`!f:real^M->real^N a b c. f integrable_on interval[a,b] /\ c IN interval[a,b] ==> integral(interval[c,b]) f = vsum {s | s SUBSET 1..dimindex (:M)} (\s. --(&1) pow CARD s % integral (interval[a,(lambda i. if i IN s then c$i else b$i)]) f)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. (f:real^M->real^N) (--x)`; `--b:real^M`; `--a:real^M`; `--c:real^M`] INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT) THEN REWRITE_TAC[REAL_ARITH `min (--a) (--b) = --(max a b)`; REAL_ARITH `max (--a) (--b) = --(min a b)`; VECTOR_NEG_COMPONENT] THEN SUBGOAL_THEN `!P x y. (lambda i. if P i then --(x i) else --(y i)):real^M = --(lambda i. if P i then x i else y i)` (fun th -> REWRITE_TAC[th]) THENL [SIMP_TAC[CART_EQ; VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[INTEGRAL_REFLECT; INTEGRABLE_REFLECT; IN_INTERVAL_REFLECT]);; let HAS_INTEGRAL_REFLECT_GEN = prove (`!f:real^M->real^N i s. ((\x. f(--x)) has_integral i) s <=> (f has_integral i) (IMAGE (--) s)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[HAS_INTEGRAL_ALT] THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM INTEGRABLE_REFLECT; GSYM INTEGRAL_REFLECT] THEN REWRITE_TAC[IN_IMAGE; VECTOR_NEG_NEG] THEN REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `x:real^N = --y <=> --x = y`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MESON[VECTOR_NEG_NEG] `(!x:real^N y:real^N. P x y) <=> (!x y. P (--y) (--x))`] THEN REWRITE_TAC[VECTOR_NEG_NEG] THEN REWRITE_TAC[SUBSET; IN_BALL_0; GSYM REFLECT_INTERVAL; IN_IMAGE] THEN REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `x:real^N = --y <=> --x = y`] THEN ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN REWRITE_TAC[MESON[VECTOR_NEG_NEG] `(!x:real^N. P (--x)) <=> (!x. P x)`] THEN REWRITE_TAC[NORM_NEG]);; let INTEGRABLE_REFLECT_GEN = prove (`!f:real^M->real^N s. (\x. f(--x)) integrable_on s <=> f integrable_on (IMAGE (--) s)`, REWRITE_TAC[integrable_on; HAS_INTEGRAL_REFLECT_GEN]);; let INTEGRAL_REFLECT_GEN = prove (`!f:real^M->real^N s. integral s (\x. f(--x)) = integral (IMAGE (--) s) f`, REWRITE_TAC[integral; HAS_INTEGRAL_REFLECT_GEN]);; (* ------------------------------------------------------------------------- *) (* A straddling criterion for integrability. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_STRADDLE_INTERVAL = prove (`!f:real^N->real^1 a b. (!e. &0 < e ==> ?g h i j. (g has_integral i) (interval[a,b]) /\ (h has_integral j) (interval[a,b]) /\ norm(i - j) < e /\ !x. x IN interval[a,b] ==> drop(g x) <= drop(f x) /\ drop(f x) <= drop(h x)) ==> f integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^1`; `h:real^N->real^1`; `i:real^1`; `j:real^1`] THEN REWRITE_TAC[has_integral] THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN DISCH_TAC THEN EXISTS_TAC `(\x. d1 x INTER d2 x):real^N->real^N->bool` THEN ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN MAP_EVERY X_GEN_TAC [`p1:(real^N#(real^N->bool))->bool`; `p2:(real^N#(real^N->bool))->bool`] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `p1:(real^N#(real^N->bool))->bool` th) THEN MP_TAC(SPEC `p2:(real^N#(real^N->bool))->bool` th))) THEN EVERY_ASSUM(fun th -> try ASSUME_TAC(MATCH_MP TAGGED_DIVISION_OF_FINITE th) with Failure _ -> ALL_TAC) THEN ASM_SIMP_TAC[VSUM_REAL] THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM] THEN SUBST1_TAC(SYM(ISPEC `i:real^1` (CONJUNCT1 LIFT_DROP))) THEN SUBST1_TAC(SYM(ISPEC `j:real^1` (CONJUNCT1 LIFT_DROP))) THEN REWRITE_TAC[GSYM LIFT_SUB; DROP_CMUL; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `g1 - h2 <= f1 - f2 /\ f1 - f2 <= h1 - g2 /\ abs(i - j) < e / &3 ==> abs(g2 - i) < e / &3 ==> abs(g1 - i) < e / &3 ==> abs(h2 - j) < e / &3 ==> abs(h1 - j) < e / &3 ==> abs(f1 - f2) < e`) THEN ASM_REWRITE_TAC[GSYM DROP_SUB; GSYM NORM_LIFT; LIFT_DROP] THEN CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= x' /\ y' <= y ==> x - y <= x' - y'`) THEN CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE; SUBSET]);; let INTEGRABLE_STRADDLE = prove (`!f:real^N->real^1 s. (!e. &0 < e ==> ?g h i j. (g has_integral i) s /\ (h has_integral j) s /\ norm(i - j) < e /\ !x. x IN s ==> drop(g x) <= drop(f x) /\ drop(f x) <= drop(h x)) ==> f integrable_on s`, let lemma = prove (`&0 <= drop x /\ drop x <= drop y ==> norm x <= norm y`, REWRITE_TAC[NORM_REAL; GSYM drop] THEN REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a b. (\x. if x IN s then (f:real^N->real^1) x else vec 0) integrable_on interval[a,b]` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[HAS_INTEGRAL_ALT]) THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN MATCH_MP_TAC INTEGRABLE_STRADDLE_INTERVAL THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^1`; `h:real^N->real^1`; `i:real^1`; `j:real^1`] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &4`) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &4`) STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "H"))) THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G"))) THEN MAP_EVERY EXISTS_TAC [`\x. if x IN s then (g:real^N->real^1) x else vec 0`; `\x. if x IN s then (h:real^N->real^1) x else vec 0`; `integral(interval[a:real^N,b]) (\x. if x IN s then (g:real^N->real^1) x else vec 0:real^1)`; `integral(interval[a:real^N,b]) (\x. if x IN s then (h:real^N->real^1) x else vec 0:real^1)`] THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN ABBREV_TAC `c:real^N = lambda i. min ((a:real^N)$i) (--(max B1 B2))` THEN ABBREV_TAC `d:real^N = lambda i. max ((b:real^N)$i) (max B1 B2)` THEN REMOVE_THEN "H" (MP_TAC o SPECL [`c:real^N`; `d:real^N`]) THEN REMOVE_THEN "G" (MP_TAC o SPECL [`c:real^N`; `d:real^N`]) THEN MATCH_MP_TAC(TAUT `(a /\ c) /\ (b /\ d ==> e) ==> (a ==> b) ==> (c ==> d) ==> e`) THEN CONJ_TAC THENL [CONJ_TAC THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN SIMP_TAC[SUBSET; IN_BALL; IN_INTERVAL; LAMBDA_BETA] THEN GEN_TAC THEN REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm x`] THEN DISCH_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= B ==> min a (--B) <= x /\ x <= max b B`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^N)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPONENT_LE_NORM; REAL_LE_MAX]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(i - j) < e / &4 /\ norm(ah - ag) <= norm(ch - cg) ==> norm(cg - i) < e / &4 /\ norm(ch - j) < e / &4 ==> norm(ag - ah) < e`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM INTEGRAL_SUB] THEN MATCH_MP_TAC lemma THEN CONJ_TAC THENL [MATCH_MP_TAC(INST_TYPE [`:N`,`:M`] HAS_INTEGRAL_DROP_POS) THEN MAP_EVERY EXISTS_TAC [`(\x. (if x IN s then h x else vec 0) - (if x IN s then g x else vec 0)) :real^N->real^1`; `interval[a:real^N,b]`] THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL; HAS_INTEGRAL_SUB] THEN ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRABLE_INTEGRAL] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; REAL_POS] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN MATCH_MP_TAC(INST_TYPE [`:N`,`:M`] HAS_INTEGRAL_SUBSET_DROP_LE) THEN MAP_EVERY EXISTS_TAC [`(\x. (if x IN s then h x else vec 0) - (if x IN s then g x else vec 0)) :real^N->real^1`; `interval[a:real^N,b]`; `interval[c:real^N,d]`] THEN ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_TAC THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; REAL_POS] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN ONCE_REWRITE_TAC[INTEGRABLE_ALT] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; HAS_INTEGRAL_ALT] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^1`; `h:real^N->real^1`; `i:real^1`; `j:real^1`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / &3`)) THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / &3`)) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G"))) THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "H"))) THEN EXISTS_TAC `max B1 B2` THEN ASM_REWRITE_TAC[REAL_LT_MAX; BALL_MAX_UNION; UNION_SUBSET] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `c:real^N`; `d:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[ABS_DROP; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `!ga gc ha hc i j. ga <= fa /\ fa <= ha /\ gc <= fc /\ fc <= hc /\ abs(ga - i) < e / &3 /\ abs(gc - i) < e / &3 /\ abs(ha - j) < e / &3 /\ abs(hc - j) < e / &3 /\ abs(i - j) < e / &3 ==> abs(fa - fc) < e`) THEN MAP_EVERY EXISTS_TAC [`drop(integral(interval[a:real^N,b]) (\x. if x IN s then g x else vec 0))`; `drop(integral(interval[c:real^N,d]) (\x. if x IN s then g x else vec 0))`; `drop(integral(interval[a:real^N,b]) (\x. if x IN s then h x else vec 0))`; `drop(integral(interval[c:real^N,d]) (\x. if x IN s then h x else vec 0))`; `drop i`; `drop j`] THEN REWRITE_TAC[GSYM DROP_SUB; GSYM ABS_DROP] THEN ASM_SIMP_TAC[] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL]);; let HAS_INTEGRAL_STRADDLE_NULL = prove (`!f g:real^N->real^1 s. (!x. x IN s ==> &0 <= drop(f x) /\ drop(f x) <= drop(g x)) /\ (g has_integral (vec 0)) s ==> (f has_integral (vec 0)) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_STRADDLE THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`(\x. vec 0):real^N->real^1`; `g:real^N->real^1`; `vec 0:real^1`; `vec 0:real^1`] THEN ASM_REWRITE_TAC[DROP_VEC; HAS_INTEGRAL_0; VECTOR_SUB_REFL; NORM_0]; DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^N->real^1`] HAS_INTEGRAL_DROP_LE); MATCH_MP_TAC(ISPECL [`(\x. vec 0):real^N->real^1`; `f:real^N->real^1`] HAS_INTEGRAL_DROP_LE)] THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[GSYM HAS_INTEGRAL_INTEGRAL; DROP_VEC; HAS_INTEGRAL_0]]);; (* ------------------------------------------------------------------------- *) (* Adding integrals over several sets. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_UNION = prove (`!f:real^M->real^N i j s t. (f has_integral i) s /\ (f has_integral j) t /\ negligible(s INTER t) ==> (f has_integral (i + j)) (s UNION t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `(\x. if x IN (s INTER t) then &2 % f(x) else if x IN (s UNION t) then f(x) else vec 0):real^M->real^N` THEN EXISTS_TAC `s INTER t:real^M->bool` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNION; IN_INTER; IN_UNIV] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let INTEGRAL_UNION = prove (`!f:real^M->real^N s t. f integrable_on s /\ f integrable_on t /\ negligible(s INTER t) ==> integral (s UNION t) f = integral s f + integral t f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_UNION THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; let INTEGRABLE_UNION = prove (`!f:real^M->real^N s t. f integrable_on s /\ f integrable_on t /\ negligible(s INTER t) ==> f integrable_on (s UNION t)`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_UNION]);; let INTEGRABLE_UNION_EQ = prove (`!f:real^M->real^N s t. f integrable_on s /\ f integrable_on t ==> (f integrable_on (s UNION t) <=> f integrable_on (s INTER t))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP INTEGRABLE_ADD) THEN EQ_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_SUB) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[IN_INTER; IN_UNION] THEN CONV_TAC VECTOR_ARITH);; let HAS_INTEGRAL_UNIONS_IMAGE = prove (`!f:real^M->real^N k i t:A->bool. FINITE t /\ (!s. s IN t ==> (f has_integral (i s)) (k s)) /\ pairwise (\i j. negligible(k i INTER k j)) t ==> (f has_integral (vsum t i)) (UNIONS (IMAGE k t))`, REPLICATE_TAC 3 GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; UNIONS_INSERT] THEN REWRITE_TAC[HAS_INTEGRAL_EMPTY_EQ; VSUM_CLAUSES] THEN REWRITE_TAC[FORALL_IN_INSERT; PAIRWISE_INSERT] THEN MAP_EVERY X_GEN_TAC [`n:A`; `t:A->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_UNION THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]);; let HAS_INTEGRAL_UNIONS = prove (`!f:real^M->real^N i t. FINITE t /\ (!s. s IN t ==> (f has_integral (i s)) s) /\ (!s s'. s IN t /\ s' IN t /\ ~(s = s') ==> negligible(s INTER s')) ==> (f has_integral (vsum t i)) (UNIONS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM pairwise] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_UNIONS_IMAGE) THEN REWRITE_TAC[IMAGE_ID]);; let INTEGRABLE_UNIONS_IMAGE = prove (`!f:real^M->real^N k t:A->bool. FINITE t /\ (!s. s IN t ==> f integrable_on k s) /\ pairwise (\i j. negligible(k i INTER k j)) t ==> f integrable_on UNIONS (IMAGE k t)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [integrable_on] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(CHOOSE_THEN (MP_TAC o MATCH_MP HAS_INTEGRAL_UNIONS_IMAGE)) THEN REWRITE_TAC[integrable_on] THEN MESON_TAC[]);; let INTEGRABLE_UNIONS = prove (`!f:real^M->real^N u. FINITE u /\ (!s. s IN u ==> f integrable_on s) /\ pairwise (\s t. negligible(s INTER t)) u ==> f integrable_on UNIONS u`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_UNIONS_IMAGE) THEN REWRITE_TAC[IMAGE_ID]);; let HAS_INTEGRAL_DIFF = prove (`!f:real^M->real^N i j s t. (f has_integral i) s /\ (f has_integral j) t /\ negligible (t DIFF s) ==> (f has_integral (i - j)) (s DIFF t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `(\x. if x IN (t DIFF s) then --(f x) else if x IN (s DIFF t) then f x else vec 0):real^M->real^N` THEN EXISTS_TAC `t DIFF s:real^M->bool` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNION; IN_INTER; IN_UNIV] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let INTEGRAL_DIFF = prove (`!f:real^M->real^N s t. f integrable_on s /\ f integrable_on t /\ negligible(t DIFF s) ==> integral (s DIFF t) f = integral s f - integral t f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_DIFF THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; let INTEGRABLE_DIFF = prove (`!f:real^M->real^N s t. f integrable_on s /\ f integrable_on t /\ t SUBSET s ==> f integrable_on (s DIFF t)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[IN_DIFF] THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN ASM SET_TAC[]);; let INTEGRABLE_ON_SUBINTERVAL_GEN = prove (`!f:real^1->real^N s t. f integrable_on s /\ t SUBSET s /\ is_interval t ==> f integrable_on t`, REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN SUBGOAL_THEN `(\x. if x IN t then (f:real^1->real^N) x else vec 0) = (\x. if x IN t then (if x IN s then (f:real^1->real^N) x else vec 0) else vec 0)` SUBST1_TAC THENL [ASM SIMP_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INTEGRABLE_RESTRICT_UNIV]) THEN SPEC_TAC(`\x. if x IN s then (f:real^1->real^N) x else vec 0`, `f:real^1->real^N`) THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `vec 0:real^1`) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1_CASES]) THEN REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN ASM_SIMP_TAC[INTEGRABLE_ON_EMPTY] THEN SPEC_TAC(`t:real^1->bool`,`t:real^1->bool`) THEN REWRITE_TAC[FORALL_AND_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN ONCE_REWRITE_TAC[MESON[] `(!a t b. P a b t) <=> (!a b t. P a b t)`] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN MATCH_MP_TAC(TAUT `r /\ ((p ==> q) /\ (p' ==> q')) /\ (p' ==> p) /\ p' ==> p /\ p' /\ q /\ q' /\ r`) THEN CONJ_TAC THENL [REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN FIRST_ASSUM(MP_TAC o SPECL [`lift a`; `lift b`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{lift a,lift b}` THEN REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF; IN_INTERVAL_1; IN_ELIM_THM] THEN REWRITE_TAC[FORALL_LIFT; IN_INSERT; NOT_IN_EMPTY; LIFT_EQ; LIFT_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real` THEN UNDISCH_TAC `(f:real^1->real^N) integrable_on UNIV` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] INTEGRABLE_DIFF))) THEN REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real` THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{lift a}` THEN REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF; IN_INTERVAL_1; IN_ELIM_THM] THEN REWRITE_TAC[FORALL_LIFT; IN_INSERT; NOT_IN_EMPTY; LIFT_EQ; LIFT_DROP] THEN REAL_ARITH_TAC; GEN_TAC THEN POP_ASSUM MP_TAC] THEN SUBGOAL_THEN `{t | a <= drop t} = IMAGE (\x. lift a + x) {t | &0 <= drop t}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; UNWIND_THM1; DROP_SUB; LIFT_DROP; VECTOR_ARITH `x:real^N = a + y <=> x - a = y`] THEN REAL_ARITH_TAC; SUBST1_TAC(SYM(ISPEC `lift a` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM INTEGRABLE_TRANSLATION] THEN SPEC_TAC(`\x. (f:real^1->real^N) (lift a + x)`,`f:real^1->real^N`)] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_ALT] THEN ONCE_REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN REWRITE_TAC[INTER; IN_INTERVAL_1; IN_ELIM_THM] THEN REWRITE_TAC[CONJ_ASSOC; GSYM REAL_MAX_LE] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `max a b = drop(lift(max a b))`] THEN SIMP_TAC[GSYM IN_INTERVAL_1; SET_RULE `{x | x IN s} = s`] THEN CONJ_TAC THENL [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTEGRABLE_ALT]) THEN DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT2) THEN ASM_REWRITE_TAC[IN_UNIV; ETA_AX; BALL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_SUB_LZERO; LIFT_DROP; DROP_NEG] THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN SIMP_TAC[REAL_ARITH `&0 < B ==> ~(B <= --B) /\ --B < B`] THEN REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`; `w:real^1`; `x:real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `max (&0) (drop u) = &0 /\ max (&0) (drop w) = &0` (CONJUNCTS_THEN SUBST1_TAC) THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`--lift B`; `v:real^1`; `--lift B`; `x:real^1`]) THEN ASM_REWRITE_TAC[DROP_NEG; LIFT_DROP; REAL_LE_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_UNIV] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `--lift B`; `v:real^1`; `vec 0:real^1`] INTEGRAL_COMBINE) THEN MP_TAC(ISPECL [`f:real^1->real^N`; `--lift B`; `x:real^1`; `vec 0:real^1`] INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[DROP_VEC; DROP_NEG; LIFT_DROP] THEN REPEAT (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)]) THEN REWRITE_TAC[LIFT_NUM] THEN CONV_TAC VECTOR_ARITH);; let INTEGRABLE_ON_SUBSET = prove (`!f:real^1->real^N s t. f integrable_on s /\ t SUBSET s /\ FINITE(components t) ==> f integrable_on t`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN MATCH_MP_TAC INTEGRABLE_UNIONS THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL_GEN THEN REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET; SUBSET]; MP_TAC(ISPEC `t:real^1->bool` PAIRWISE_DISJOINT_COMPONENTS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] PAIRWISE_IMP) THEN SIMP_TAC[DISJOINT; NEGLIGIBLE_EMPTY]]);; (* ------------------------------------------------------------------------- *) (* In particular adding integrals over a division, maybe not of an interval. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_COMBINE_DIVISION = prove (`!f:real^M->real^N s d i. d division_of s /\ (!k. k IN d ==> (f has_integral (i k)) k) ==> (f has_integral (vsum d i)) s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN MATCH_MP_TAC HAS_INTEGRAL_UNIONS THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?u v:real^M x y:real^M. k1 = interval[u,v] /\ k2 = interval[x,y]` (REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o el 2 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`interval[u:real^M,v]`; `interval[x:real^M,y]`]) THEN ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `(interval[u,v:real^M] DIFF interval(u,v)) UNION (interval[x,y] DIFF interval(x,y))` THEN SIMP_TAC[NEGLIGIBLE_FRONTIER_INTERVAL; NEGLIGIBLE_UNION] THEN ASM SET_TAC[]);; let INTEGRAL_COMBINE_DIVISION_BOTTOMUP = prove (`!f:real^M->real^N d s. d division_of s /\ (!k. k IN d ==> f integrable_on k) ==> integral s f = vsum d (\i. integral i f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; let HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN = prove (`!f:real^M->real^N s d k. f integrable_on s /\ d division_of k /\ k SUBSET s ==> (f has_integral (vsum d (\i. integral i f))) k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]);; let INTEGRAL_COMBINE_DIVISION_TOPDOWN = prove (`!f:real^M->real^N d s. f integrable_on s /\ d division_of s ==> integral s f = vsum d (\i. integral i f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]);; let INTEGRABLE_COMBINE_DIVISION = prove (`!f d s. d division_of s /\ (!i. i IN d ==> f integrable_on i) ==> f integrable_on s`, REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMBINE_DIVISION]);; let INTEGRABLE_ON_SUBDIVISION = prove (`!f:real^M->real^N s d i. d division_of i /\ f integrable_on s /\ i SUBSET s ==> f integrable_on i`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_COMBINE_DIVISION THEN EXISTS_TAC `d:(real^M->bool)->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN ASM_MESON_TAC[division_of; UNIONS_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Also tagged divisions. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_COMBINE_TAGGED_DIVISION = prove (`!f:real^M->real^N s p i. p tagged_division_of s /\ (!x k. (x,k) IN p ==> (f has_integral (i k)) k) ==> (f has_integral (vsum p (\(x,k). i k))) s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x:real^M k:real^M->bool. (x,k) IN p ==> ((f:real^M->real^N) has_integral integral k f) k` ASSUME_TAC THENL [ASM_MESON_TAC[HAS_INTEGRAL_INTEGRAL; integrable_on]; ALL_TAC] THEN SUBGOAL_THEN `((f:real^M->real^N) has_integral (vsum (IMAGE SND (p:real^M#(real^M->bool)->bool)) (\k. integral k f))) s` MP_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum p (\(x:real^M,k:real^M->bool). integral k f:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE]; MATCH_MP_TAC VSUM_OVER_TAGGED_DIVISION_LEMMA THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[INTEGRAL_NULL]]);; let INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP = prove (`!f:real^M->real^N p a b. p tagged_division_of interval[a,b] /\ (!x k. (x,k) IN p ==> f integrable_on k) ==> integral (interval[a,b]) f = vsum p (\(x,k). integral k f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; let HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN = prove (`!f:real^M->real^N a b p. f integrable_on interval[a,b] /\ p tagged_division_of interval[a,b] ==> (f has_integral (vsum p (\(x,k). integral k f))) (interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; TAGGED_DIVISION_OF]);; let INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN = prove (`!f:real^M->real^N a b p. f integrable_on interval[a,b] /\ p tagged_division_of interval[a,b] ==> integral (interval[a,b]) f = vsum p (\(x,k). integral k f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Henstock's lemma. *) (* ------------------------------------------------------------------------- *) let HENSTOCK_LEMMA_PART1 = prove (`!f:real^M->real^N a b d e. f integrable_on interval[a,b] /\ &0 < e /\ gauge d /\ (!p. p tagged_division_of interval[a,b] /\ d fine p ==> norm (vsum p (\(x,k). content k % f x) - integral(interval[a,b]) f) < e) ==> !p. p tagged_partial_division_of interval[a,b] /\ d fine p ==> norm(vsum p (\(x,k). content k % f x - integral k f)) <= e`, let lemma = prove (`(!k. &0 < k ==> x <= e + k) ==> x <= e`, DISCH_THEN(MP_TAC o SPEC `(x - e) / &2`) THEN REAL_ARITH_TAC) in REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC lemma THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`IMAGE SND (p:(real^M#(real^M->bool))->bool)`; `a:real^M`; `b:real^M`] PARTIAL_DIVISION_EXTEND_INTERVAL) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[PARTIAL_DIVISION_OF_TAGGED_DIVISION]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN ASM_MESON_TAC[tagged_partial_division_of; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP(SET_RULE `s SUBSET t ==> t = s UNION (t DIFF s)`)) THEN ABBREV_TAC `r = q DIFF IMAGE SND (p:(real^M#(real^M->bool))->bool)` THEN SUBGOAL_THEN `IMAGE SND (p:(real^M#(real^M->bool))->bool) INTER r = {}` ASSUME_TAC THENL [EXPAND_TAC "r" THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST_ALL_TAC THEN SUBGOAL_THEN `FINITE(r:(real^M->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[division_of; FINITE_UNION]; ALL_TAC] THEN SUBGOAL_THEN `!i. i IN r ==> ?p. p tagged_division_of i /\ d fine p /\ norm(vsum p (\(x,j). content j % f x) - integral i (f:real^M->real^N)) < k / (&(CARD(r:(real^M->bool)->bool)) + &1)` MP_TAC THENL [X_GEN_TAC `i:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `(i:real^M->bool) SUBSET interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[division_of; IN_UNION]; ALL_TAC] THEN SUBGOAL_THEN `?u v:real^M. i = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[division_of; IN_UNION]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^M->real^N) integrable_on interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN REWRITE_TAC[has_integral] THEN DISCH_THEN(MP_TAC o SPEC `k / (&(CARD(r:(real^M->bool)->bool)) + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &n + &1`] THEN DISCH_THEN(X_CHOOSE_THEN `dd:real^M->real^M->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`d:real^M->real^M->bool`; `dd:real^M->real^M->bool`] GAUGE_INTER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN DISCH_THEN(MP_TAC o SPECL [`u:real^M`; `v:real^M`]) THEN REWRITE_TAC[FINE_INTER] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `q:(real^M->bool)->(real^M#(real^M->bool))->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p UNION UNIONS {q (i:real^M->bool) | i IN r} :(real^M#(real^M->bool))->bool`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC FINE_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE]] THEN FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN REWRITE_TAC[UNIONS_UNION] THEN MATCH_MP_TAC TAGGED_DIVISION_UNION THEN CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; ALL_TAC] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC TAGGED_DIVISION_UNIONS THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN SIMP_TAC[FINITE_UNION; IN_UNION] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[division_of; FINITE_UNION; IN_UNION]; ALL_TAC]) THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; OPEN_INTERIOR] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of; FINITE_IMAGE]; ALL_TAC]) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MATCH_MP_TAC o el 2 o CONJUNCTS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM] THEN ASM_REWRITE_TAC[EXISTS_PAIR_THM; IN_IMAGE; IN_INTER; IN_UNION] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `vsum (p UNION UNIONS {q i | i IN r}) (\(x,k). content k % f x) = vsum p (\(x:real^M,k:real^M->bool). content k % f x:real^N) + vsum (UNIONS {q i | (i:real^M->bool) IN r}) (\(x,k). content k % f x)` SUBST1_TAC THENL [MATCH_MP_TAC VSUM_UNION_NONZERO THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF_FINITE]; ALL_TAC] THEN REWRITE_TAC[IN_INTER] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_UNIONS; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN SUBGOAL_THEN `(l:real^M->bool) SUBSET k` ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`k:real^M->bool`; `l:real^M->bool`] o el 2 o CONJUNCTS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IN_UNION; IN_IMAGE; EXISTS_PAIR_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM] THEN ASM_REWRITE_TAC[EXISTS_PAIR_THM; IN_IMAGE; IN_INTER; IN_UNION] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUBSET_INTERIOR; SET_RULE `s SUBSET t ==> t INTER s = s`] THEN SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` (fun th -> REPEAT_TCL CHOOSE_THEN SUBST1_TAC th THEN SIMP_TAC[VECTOR_MUL_LZERO; GSYM CONTENT_EQ_0_INTERIOR]) THEN ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_UNIONS_NONZERO o rand o lhand o rand o lhand o lhand o snd) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; IN_UNION]; ALL_TAC] THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN X_GEN_TAC `l:real^M->bool` THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `m:real^M->bool`] THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN SUBGOAL_THEN `?u v:real^M. m = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; IN_UNION]; ALL_TAC] THEN REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN EXISTS_TAC `interior(k INTER l:real^M->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[SUBSET_INTER] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN REWRITE_TAC[INTERIOR_INTER] THEN DISCH_THEN(MATCH_MP_TAC o SPECL [`k:real^M->bool`; `l:real^M->bool`] o el 2 o CONJUNCTS) THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_UNION] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_IMAGE_NONZERO o rand o lhand o rand o lhand o lhand o snd) THEN ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `l:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `m:real^M->bool`] THEN DISCH_TAC THEN MP_TAC(ASSUME `!i:real^M->bool. i IN r ==> q i tagged_division_of i`) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `l:real^M->bool` th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `k:real^M->bool` th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[tagged_division_of] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `vsum p (\(x,k). content k % (f:real^M->real^N) x - integral k f) = vsum p (\(x,k). content k % f x) - vsum p (\(x,k). integral k f)` SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM VSUM_SUB; LAMBDA_PAIR_THM]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `!ir. ip + ir = i /\ norm(cr - ir) < k ==> norm((cp + cr) - i) < e ==> norm(cp - ip) <= e + k`) THEN EXISTS_TAC `vsum r (\k. integral k (f:real^M->real^N))` THEN CONJ_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum (IMAGE SND (p:(real^M#(real^M->bool))->bool) UNION r) (\k. integral k (f:real^M->real^N))` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTEGRAL_COMBINE_DIVISION_TOPDOWN]] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum (IMAGE SND (p:(real^M#(real^M->bool))->bool)) (\k. integral k (f:real^M->real^N)) + vsum r (\k. integral k f)` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN ASM_SIMP_TAC[FINITE_IMAGE; NOT_IN_EMPTY]] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `(\(x:real^M,k). integral k (f:real^M->real^N)) = (\k. integral k f) o SND` SUBST1_TAC THENL [SIMP_TAC[o_THM; FUN_EQ_THM; FORALL_PAIR_THM]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`; `y:real^M`; `m:real^M->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC o CONJUNCT2) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`; `y:real^M`; `l:real^M->bool`]) THEN ASM_REWRITE_TAC[INTER_IDEMPOT] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC o last o CONJUNCTS) THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_NULL THEN ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM VSUM_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (r:(real^M->bool)->bool) (\x. k / (&(CARD r) + &1))` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ASM_SIMP_TAC[SUM_CONST] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &x + &1`] THEN REWRITE_TAC[REAL_ARITH `a * k < k * b <=> &0 < k * (b - a)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; let HENSTOCK_LEMMA_PART2 = prove (`!f:real^M->real^N a b d e. f integrable_on interval[a,b] /\ &0 < e /\ gauge d /\ (!p. p tagged_division_of interval[a,b] /\ d fine p ==> norm (vsum p (\(x,k). content k % f x) - integral(interval[a,b]) f) < e) ==> !p. p tagged_partial_division_of interval[a,b] /\ d fine p ==> sum p (\(x,k). norm(content k % f x - integral k f)) <= &2 * &(dimindex(:N)) * e`, REPEAT STRIP_TAC THEN REWRITE_TAC[LAMBDA_PAIR] THEN MATCH_MP_TAC VSUM_NORM_ALLSUBSETS_BOUND THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN X_GEN_TAC `q:(real^M#(real^M->bool))->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] HENSTOCK_LEMMA_PART1) THEN MAP_EVERY EXISTS_TAC [`a:real^M`; `b:real^M`; `d:real^M->real^M->bool`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FINE_SUBSET; TAGGED_PARTIAL_DIVISION_SUBSET]);; let HENSTOCK_LEMMA = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] ==> !e. &0 < e ==> ?d. gauge d /\ !p. p tagged_partial_division_of interval[a,b] /\ d fine p ==> sum p (\(x,k). norm(content k % f x - integral k f)) < e`, MP_TAC HENSTOCK_LEMMA_PART2 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC th) THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN GEN_REWRITE_TAC LAND_CONV [has_integral] THEN DISCH_THEN(MP_TAC o SPEC `e / (&2 * (&(dimindex(:N)) + &1))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &2 * (&n + &1)`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`d:real^M->real^M->bool`; `e / (&2 * (&(dimindex(:N)) + &1))`]) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &2 * (&n + &1)`] THEN DISCH_THEN(fun th -> EXISTS_TAC `d:real^M->real^M->bool` THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `d < e ==> x <= d ==> x < e`) THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Monotone convergence (bounded interval first). *) (* ------------------------------------------------------------------------- *) let MONOTONE_CONVERGENCE_INTERVAL = prove (`!f:num->real^N->real^1 g a b. (!k. (f k) integrable_on interval[a,b]) /\ (!k x. x IN interval[a,b] ==> drop(f k x) <= drop(f (SUC k) x)) /\ (!x. x IN interval[a,b] ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral (interval[a,b]) (f k) | k IN (:num)} ==> g integrable_on interval[a,b] /\ ((\k. integral (interval[a,b]) (f k)) --> integral (interval[a,b]) g) sequentially`, let lemma = prove (`{(x,y) | P x y} = {p | P (FST p) (SND p)}`, REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM]) in REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `content(interval[a:real^N,b]) = &0` THENL [ASM_SIMP_TAC[INTEGRAL_NULL; INTEGRABLE_ON_NULL; LIM_CONST]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONTENT_LT_NZ])] THEN SUBGOAL_THEN `!x:real^N k:num. x IN interval[a,b] ==> drop(f k x) <= drop(g x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\k. (f:num->real^N->real^1) k x` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[REAL_LE_TRANS] THEN ASM_SIMP_TAC[REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?i. ((\k. integral (interval[a,b]) (f k:real^N->real^1)) --> i) sequentially` CHOOSE_TAC THENL [MATCH_MP_TAC BOUNDED_INCREASING_CONVERGENT THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k. drop(integral(interval[a,b]) ((f:num->real^N->real^1) k)) <= drop i` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\k. integral(interval[a,b]) ((f:num->real^N->real^1) k)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `((g:real^N->real^1) has_integral i) (interval[a,b])` ASSUME_TAC THENL [REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [HAS_INTEGRAL_INTEGRAL]) THEN REWRITE_TAC[has_integral] THEN DISCH_THEN(MP_TAC o GEN `k:num` o SPECL [`k:num`; `e / &2 pow (k + 2)`]) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC LAND_CONV [SKOLEM_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `b:num->real^N->real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?r. !k. r:num <= k ==> &0 <= drop i - drop(integral(interval[a:real^N,b]) (f k)) /\ drop i - drop(integral(interval[a,b]) (f k)) < e / &4` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[ABS_DROP; dist; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> abs(x - y) < e ==> &0 <= y - x /\ y - x < e`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN interval[a:real^N,b] ==> ?n. r:num <= n /\ !k. n <= k ==> &0 <= drop(g x) - drop(f k x) /\ drop(g x) - drop(f k x) < e / (&4 * content(interval[a,b]))` MP_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV) [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN DISCH_THEN(MP_TAC o SPEC `e / (&4 * content(interval[a:real^N,b]))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[dist; ABS_DROP; DROP_SUB] THEN ASM_SIMP_TAC[REAL_ARITH `f <= g ==> abs(f - g) = g - f`] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + r:num` THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[ARITH_RULE `N + r:num <= k ==> N <= k`]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN REWRITE_TAC[FORALL_AND_THM; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `m:real^N->num` STRIP_ASSUME_TAC) THEN ABBREV_TAC `d:real^N->real^N->bool = \x. b(m x:num) x` THEN EXISTS_TAC `d:real^N->real^N->bool` THEN CONJ_TAC THENL [EXPAND_TAC "d" THEN REWRITE_TAC[gauge] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [gauge]) THEN SIMP_TAC[]; ALL_TAC] THEN X_GEN_TAC `p:(real^N#(real^N->bool))->bool` THEN STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `!b c. norm(a - b) <= e / &4 /\ norm(b - c) < e / &2 /\ norm(c - d) < e / &4 ==> norm(a - d) < e`) THEN EXISTS_TAC `vsum p (\(x:real^N,k:real^N->bool). content k % (f:num->real^N->real^1) (m x) x)` THEN EXISTS_TAC `vsum p (\(x:real^N,k:real^N->bool). integral k ((f:num->real^N->real^1) (m x)))` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN SUBGOAL_THEN `?s:num. !t:real^N#(real^N->bool). t IN p ==> m(FST t) <= s` MP_TAC THENL [ASM_SIMP_TAC[UPPER_BOUND_FINITE_SET]; ALL_TAC] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN DISCH_THEN(X_CHOOSE_TAC `s:num`) THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[GSYM VSUM_SUB] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB] THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `y <= e ==> x <= y ==> x <= e`) THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum p (\(x:real^N,k:real^N->bool). content k * e / (&4 * content (interval[a:real^N,b])))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `k:real^N->bool`] THEN DISCH_TAC THEN REWRITE_TAC[NORM_MUL; GSYM VECTOR_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN REWRITE_TAC[ABS_DROP; DROP_SUB] THEN REWRITE_TAC[REAL_ARITH `abs(x) <= x <=> &0 <= x`] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= g - f /\ g - f < e ==> abs(g - f) <= e`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LE_REFL] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN REWRITE_TAC[LAMBDA_PAIR; SUM_RMUL] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ADDITIVE_CONTENT_TAGGED_DIVISION th]) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN UNDISCH_TAC `&0 < content(interval[a:real^N,b])` THEN CONV_TAC REAL_FIELD; ASM_SIMP_TAC[GSYM VSUM_SUB] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(vsum (0..s) (\j. vsum {(x:real^N,k:real^N->bool) | (x,k) IN p /\ m(x) = j} (\(x,k). content k % f (m x) x :real^1 - integral k (f (m x)))))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[lemma] THEN AP_TERM_TAC THEN MATCH_MP_TAC(GSYM VSUM_GROUP) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG; LE_0] THEN ASM_REWRITE_TAC[FORALL_PAIR_THM]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (0..s) (\i. e / &2 pow (i + 2))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div; GSYM REAL_POW_INV; SUM_LMUL] THEN REWRITE_TAC[REAL_POW_ADD; SUM_RMUL] THEN REWRITE_TAC[SUM_GP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; CONJUNCT1 LT] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `&0 < x * y ==> (&1 - x) * y < y`) THEN MATCH_MP_TAC REAL_LT_MUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_POW_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `t:num` THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum {x:real^N,k:real^N->bool | x,k IN p /\ m x:num = t} (\(x,k). content k % f t x - integral k (f t)):real^1)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] HENSTOCK_LEMMA_PART1) THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`; `(b(t:num)):real^N->real^N->bool`] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN CONJ_TAC THENL [MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN EXISTS_TAC `p:(real^N#(real^N->bool))->bool` THEN SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN EXPAND_TAC "d" THEN REWRITE_TAC[fine; IN_ELIM_PAIR_THM] THEN MESON_TAC[]; MP_TAC(ISPECL [`(f:num->real^N->real^1) s`; `a:real^N`; `b:real^N`; `p:(real^N#(real^N->bool))->bool`] INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN MP_TAC(ISPECL [`(f:num->real^N->real^1) r`; `a:real^N`; `b:real^N`; `p:(real^N#(real^N->bool))->bool`] INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN ASM_SIMP_TAC[ABS_DROP; DROP_SUB; DROP_VSUM; GSYM DROP_EQ] THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM] THEN MATCH_MP_TAC(REAL_ARITH `sr <= sx /\ sx <= ss /\ ks <= i /\ &0 <= i - kr /\ i - kr < e ==> kr = sr ==> ks = ss ==> abs(sx - i) < e`) THEN ASM_SIMP_TAC[LE_REFL] THEN CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `i:real^N->bool`] THEN DISCH_TAC THEN (SUBGOAL_THEN `i SUBSET interval[a:real^N,b]` ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN SUBGOAL_THEN `?u v:real^N. i = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC]) THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL]; ALL_TAC]) THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MP_TAC(ISPEC `\m n:num. drop (f m (y:real^N)) <= drop (f n y)` TRANSITIVE_STEPWISE_LE) THEN REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL] THEN (ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC]) THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN ASM_REWRITE_TAC[]);; let MONOTONE_CONVERGENCE_INCREASING = prove (`!f:num->real^N->real^1 g s. (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral s (f k) | k IN (:num)} ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, SUBGOAL_THEN `!f:num->real^N->real^1 g s. (!k x. x IN s ==> &0 <= drop(f k x)) /\ (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral s (f k) | k IN (:num)} ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially` ASSUME_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`\n x:real^N. f(SUC n) x - f 0 x:real^1`; `\x. (g:real^N->real^1) x - f 0 x`; `s:real^N->bool`]) THEN REWRITE_TAC[] THEN ANTS_TAC THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN MP_TAC(ISPEC `\m n:num. drop (f m (x:real^N)) <= drop (f n x)` TRANSITIVE_STEPWISE_LE) THEN REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL] THEN ASM_MESON_TAC[LE_0]; GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_ARITH `x - a <= y - a <=> x <= y`]; REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_SUB THEN SIMP_TAC[LIM_CONST] THEN REWRITE_TAC[ADD1] THEN MATCH_MP_TAC(ISPECL[`f:num->real^1`; `l:real^1`; `1`] SEQ_OFFSET) THEN ASM_SIMP_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX; bounded] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (fun th -> EXISTS_TAC `B + norm(integral s (f 0:real^N->real^1))` THEN X_GEN_TAC `k:num` THEN MP_TAC(SPEC `SUC k` th))) THEN NORM_ARITH_TAC; ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX; IMP_CONJ] THEN SUBGOAL_THEN `(f 0:real^N->real^1) integrable_on s` MP_TAC THENL [ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[IMP_IMP]] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_ADD) THEN REWRITE_TAC[ETA_AX; VECTOR_ARITH `f + (g - f):real^N = g`] THEN DISCH_TAC THEN ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX] THEN MP_TAC(ISPECL [`sequentially`; `integral s (f 0:real^N->real^1)`] LIM_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN REWRITE_TAC[ETA_AX; VECTOR_ARITH `f + (g - f):real^N = g`] THEN REWRITE_TAC[ADD1] THEN SIMP_TAC[ISPECL[`f:num->real^1`; `l:real^1`; `1`] SEQ_OFFSET_REV]]] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!x:real^N k:num. x IN s ==> drop(f k x) <= drop(g x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\k. (f:num->real^N->real^1) k x` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[REAL_LE_TRANS] THEN ASM_SIMP_TAC[REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?i. ((\k. integral s (f k:real^N->real^1)) --> i) sequentially` CHOOSE_TAC THENL [MATCH_MP_TAC BOUNDED_INCREASING_CONVERGENT THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k. drop(integral s ((f:num->real^N->real^1) k)) <= drop i` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\k. integral(s) ((f:num->real^N->real^1) k)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `((g:real^N->real^1) has_integral i) s` ASSUME_TAC THENL [ALL_TAC; CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[HAS_INTEGRAL_ALT] THEN MP_TAC(ISPECL [`\k x. if x IN s then (f:num->real^N->real^1) k x else vec 0`; `\x. if x IN s then (g:real^N->real^1) x else vec 0`] (MATCH_MP(MESON[] `(!a b c d. P a b c d ==> Q a b c d) ==> !a b. (!c d. P a b c d) ==> (!c d. Q a b c d)`) MONOTONE_CONVERGENCE_INTERVAL)) THEN ANTS_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [INTEGRABLE_ALT]) THEN SIMP_TAC[]; DISCH_TAC] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LIM_CONST]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[ABS_DROP] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ y <= x ==> abs(x) <= a ==> abs(y) <= a`) THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL; DROP_VEC]; ALL_TAC] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; ETA_AX] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL; DROP_VEC; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_SIMP_TAC[dist; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [HAS_INTEGRAL_INTEGRAL]) THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [HAS_INTEGRAL_ALT] THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`N:num`; `e / &4`]) THEN ASM_SIMP_TAC[dist; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `N:num <= N`)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(x - y) < e / &4 /\ norm(z - x) < e / &4 ==> norm(z - y) < e / &2`)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV) [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `e / &2`]) THEN ASM_REWRITE_TAC[dist; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M + N:num`)) THEN REWRITE_TAC[LE_ADD; ABS_DROP; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `f1 <= f2 /\ f2 <= i ==> abs(f2 - g) < e / &2 ==> abs(f1 - i) < e / &2 ==> abs(g - i) < e`) THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN MP_TAC(ISPEC `\m n:num. drop (f m (x:real^N)) <= drop (f n x)` TRANSITIVE_STEPWISE_LE) THEN REWRITE_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral s ((f:num->real^N->real^1) (M + N)))` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; ETA_AX] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL; DROP_VEC; REAL_LE_REFL]);; let MONOTONE_CONVERGENCE_DECREASING = prove (`!f:num->real^N->real^1 g s. (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f (SUC k) x) <= drop(f k x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral s (f k) | k IN (:num)} ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`(\k x. --(f k x)):num->real^N->real^1`; `(\x. --(g x)):real^N->real^1`; `s:real^N->bool`] MONOTONE_CONVERGENCE_INCREASING) THEN FIRST_ASSUM MP_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (c ==> d) ==> a ==> (b ==> c) ==> d`) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL [MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_NEG) THEN REWRITE_TAC[]; SIMP_TAC[DROP_NEG; REAL_LE_NEG2]; REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NEG THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (\x. --x) {integral s (f k:real^N->real^1) | k IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_COMPOSE_NEG; LINEAR_ID]; ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN REWRITE_TAC[SUBSET; IN_IMAGE] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC INTEGRAL_NEG THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP INTEGRABLE_NEG) (MP_TAC o MATCH_MP LIM_NEG)) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN TRY GEN_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `x:real^N = --y ==> --x = y`) THEN MATCH_MP_TAC INTEGRAL_NEG THEN ASM_REWRITE_TAC[]);; let MONOTONE_CONVERGENCE_INCREASING_AE = prove (`!f:num->real^N->real^1 g s t. (!k. (f k) integrable_on s) /\ negligible t /\ (!k x. x IN s DIFF t ==> drop(f k x) <= drop(f (SUC k) x)) /\ (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral s (f k) | k IN (:num)} ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. if x IN t then vec 0 else (f:num->real^N->real^1) n x`; `\x. if x IN t then vec 0 else (g:real^N->real^1) x`; `s:real^N->bool`] MONOTONE_CONVERGENCE_INCREASING) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `k:num` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN EXISTS_TAC `(f:num->real^N->real^1) k` THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]; REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[LIM_CONST] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]]);; let MONOTONE_CONVERGENCE_DECREASING_AE = prove (`!f:num->real^N->real^1 g s t. (!k. (f k) integrable_on s) /\ negligible t /\ (!k x. x IN s DIFF t ==> drop(f (SUC k) x) <= drop(f k x)) /\ (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral s (f k) | k IN (:num)} ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. if x IN t then vec 0 else (f:num->real^N->real^1) n x`; `\x. if x IN t then vec 0 else (g:real^N->real^1) x`; `s:real^N->bool`] MONOTONE_CONVERGENCE_DECREASING) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `k:num` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN EXISTS_TAC `(f:num->real^N->real^1) k` THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]; REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[LIM_CONST] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]]);; (* ------------------------------------------------------------------------- *) (* More lemmas about existence and bounds between integrals. *) (* ------------------------------------------------------------------------- *) let INTEGRAL_NORM_BOUND_INTEGRAL = prove (`!f:real^M->real^N g s. f integrable_on s /\ g integrable_on s /\ (!x. x IN s ==> norm(f x) <= drop(g x)) ==> norm(integral s f) <= drop(integral s g)`, let lemma = prove (`(!e. &0 < e ==> x < y + e) ==> x <= y`, DISCH_THEN(MP_TAC o SPEC `x - y:real`) THEN REAL_ARITH_TAC) in SUBGOAL_THEN `!f:real^M->real^N g a b. f integrable_on interval[a,b] /\ g integrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> norm(f x) <= drop(g x)) ==> norm(integral(interval[a,b]) f) <= drop(integral(interval[a,b]) g)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `(f:real^M->real^N) integrable_on interval[a,b]` THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN REWRITE_TAC[has_integral] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d1:real^M->real^M->bool` THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d2:real^M->real^M->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`d1:real^M->real^M->bool`; `d2:real^M->real^M->bool`] GAUGE_INTER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN REWRITE_TAC[FINE_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN ASM_REWRITE_TAC[ABS_DROP; DROP_SUB] THEN MATCH_MP_TAC(NORM_ARITH `norm(sg) <= dsa ==> abs(dsa - dia) < e / &2 ==> norm(sg - ig) < e / &2 ==> norm(ig) < dia + e`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[DROP_VSUM] THEN MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[o_DEF; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN REWRITE_TAC[NORM_MUL; DROP_CMUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN (fun th -> ASSUME_TAC(CONJUNCT1(GEN_REWRITE_RULE I [INTEGRABLE_ALT] th)) THEN MP_TAC(MATCH_MP INTEGRABLE_INTEGRAL th))) THEN ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN DISCH_THEN(LABEL_TAC "A") THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "A" (MP_TAC o SPEC `e / &2`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "F"))) THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A"))) THEN MP_TAC(ISPEC `ball(vec 0,max B1 B2):real^M->bool` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[BALL_MAX_UNION; UNION_SUBSET] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^1` (CONJUNCTS_THEN2 ASSUME_TAC (fun th -> DISCH_THEN(X_CHOOSE_THEN `w:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC th))) THEN ASM_REWRITE_TAC[ABS_DROP; DROP_SUB] THEN MATCH_MP_TAC(NORM_ARITH `norm(sg) <= dsa ==> abs(dsa - dia) < e / &2 ==> norm(sg - ig) < e / &2 ==> norm(ig) < dia + e`) THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM o MATCH_MP INTEGRAL_UNIQUE)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_LE_REFL]);; let INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT = prove (`!f:real^M->real^N g:real^M->real^P s k. 1 <= k /\ k <= dimindex(:P) /\ f integrable_on s /\ g integrable_on s /\ (!x. x IN s ==> norm(f x) <= (g x)$k) ==> norm(integral s f) <= (integral s g)$k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral s ((\y. lift(y$k)) o (g:real^M->real^P)))` THEN SUBGOAL_THEN `linear(\y:real^P. lift(y$k))` ASSUME_TAC THENL [ASM_SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LIFT_ADD; LIFT_CMUL]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_SIMP_TAC[o_THM; LIFT_DROP] THEN MATCH_MP_TAC INTEGRABLE_LINEAR THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `integral s ((\y. lift (y$k)) o (g:real^M->real^P)) = (\y. lift (y$k)) (integral s g)` SUBST1_TAC THENL [MATCH_MP_TAC INTEGRAL_LINEAR THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]]);; let HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT = prove (`!f:real^M->real^N g:real^M->real^P s i j k. 1 <= k /\ k <= dimindex(:P) /\ (f has_integral i) s /\ (g has_integral j) s /\ (!x. x IN s ==> norm(f x) <= (g x)$k) ==> norm(i) <= j$k`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(fun th -> SUBST1_TAC(SYM(MATCH_MP INTEGRAL_UNIQUE th)) THEN ASSUME_TAC(MATCH_MP HAS_INTEGRAL_INTEGRABLE th))) THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT THEN ASM_REWRITE_TAC[]);; let INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND = prove (`!f:real^M->real^N g s. (!a b. (\x. if x IN s then f x else vec 0) integrable_on interval[a,b]) /\ (!x. x IN s ==> norm(f x) <= drop(g x)) /\ g integrable_on s ==> f integrable_on s`, let lemma = prove (`!f:real^M->real^N g. (!a b. f integrable_on interval[a,b]) /\ (!x. norm(f x) <= drop(g x)) /\ g integrable_on (:real^M) ==> f integrable_on (:real^M)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[INTEGRABLE_ALT_SUBSET] THEN ASM_REWRITE_TAC[IN_UNIV; ETA_AX] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < c ==> a < c`) THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[GSYM INTEGRAL_DIFF; NEGLIGIBLE_EMPTY; SET_RULE `s SUBSET t ==> s DIFF t = {}`] THEN REWRITE_TAC[ABS_DROP] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_MESON_TAC[integrable_on; HAS_INTEGRAL_DIFF; NEGLIGIBLE_EMPTY; SET_RULE `s SUBSET t ==> s DIFF t = {}`]) in REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_POS]);; (* ------------------------------------------------------------------------- *) (* Explicit limit statement for integrals over [0,inf]. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_LIM_AT_POSINFINITY = prove (`!f l:real^N. (f has_integral l) {t | &0 <= drop t} <=> (!a. f integrable_on interval[vec 0,a]) /\ ((\a. integral (interval[vec 0,lift a]) f) --> l) at_posinfinity`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN REWRITE_TAC[INTEGRAL_RESTRICT_INTER; INTEGRABLE_RESTRICT_INTER] THEN SUBGOAL_THEN `!a b. {t | &0 <= drop t} INTER interval[a,b] = interval[lift(max (&0) (drop a)),b]` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; FORALL_LIFT; IN_INTER; IN_INTERVAL_1; LIFT_DROP; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[LIM_AT_POSINFINITY; dist; real_ge] THEN EQ_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [X_GEN_TAC `a:real^1` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `a:real^1`]) THEN REWRITE_TAC[DROP_VEC; LIFT_NUM; REAL_ARITH `max x x = x`]; X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPECL [`lift(--b)`; `lift b`]) THEN REWRITE_TAC[DROP_VEC; LIFT_NUM; LIFT_DROP] THEN SUBGOAL_THEN `max (&0) (--b) = &0` SUBST1_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[LIFT_NUM]] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^1`) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_SUBINTERVAL) THEN SIMP_TAC[SUBSET_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC; X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (LABEL_TAC "*")) THEN EXISTS_TAC `abs B + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `max (&0) (drop a) = &0` SUBST1_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[LIFT_NUM]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `drop b`) THEN REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; let HAS_INTEGRAL_LIM_AT_POSINFINITY_GEN = prove (`!f a l:real^N. (f has_integral l) {t | a <= drop t} <=> (!b. f integrable_on interval[lift a,lift b]) /\ ((\b. integral (interval[lift a,lift b]) f) --> l) at_posinfinity`, REPEAT GEN_TAC THEN SUBGOAL_THEN `{t | a <= drop t} = IMAGE (\x. lift a + x) {t | &0 <= drop t}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; DROP_ADD; LIFT_DROP; REAL_LE_ADDR] THEN MESON_TAC[VECTOR_SUB_ADD2]; REWRITE_TAC[GSYM HAS_INTEGRAL_TRANSLATION]] THEN REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN REWRITE_TAC[INTEGRABLE_TRANSLATION; INTEGRAL_TRANSLATION] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION; VECTOR_ADD_RID] THEN REWRITE_TAC[FORALL_LIFT; GSYM LIFT_ADD] THEN MP_TAC(MESON[REAL_SUB_ADD2] `!P. (!b:real. P(a + b)) <=> (!b. P b)`) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN DISCH_TAC THEN REWRITE_TAC[LIM_AT_POSINFINITY; real_ge] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN EXISTS_TAC `abs a + abs b:real` THEN X_GEN_TAC `c:real` THEN DISCH_TAC THENL [SUBST1_TAC(REAL_ARITH `c:real = a + (c - a)`) THEN REWRITE_TAC[GSYM LIFT_ADD]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; let HAS_INTEGRAL_LIM_SEQUENTIALLY = prove (`!f:real^1->real^N l. (f o lift --> vec 0) at_posinfinity /\ (!n. f integrable_on interval[vec 0,vec n]) /\ ((\n. integral (interval[vec 0,vec n]) f) --> l) sequentially ==> (f has_integral l) {t | &0 <= drop t}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [X_GEN_TAC `a:real^1` THEN MP_TAC(SPEC `drop a` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_SUBINTERVAL) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN REWRITE_TAC[LIM_AT_POSINFINITY; real_ge] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_POSINFINITY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; o_THM; real_ge; FORALL_DROP; LIFT_DROP] THEN REWRITE_TAC[DIST_0; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `max (&N) B + &1` THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN MP_TAC(SPEC `drop x` FLOOR_POS) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN SUBGOAL_THEN `integral(interval[vec 0,x]) (f:real^1->real^N) = integral(interval[vec 0,vec n]) f + integral(interval[vec n,x]) f` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[DROP_VEC] THEN MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `dist(a:real^N,l) < e / &2 /\ norm b <= e / &2 ==> dist(a + b,l) < e`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop(integral(interval[vec n:real^1,x]) (\x. lift(e / &2)))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[INTEGRABLE_CONST; IN_INTERVAL_1; LIFT_DROP] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[vec 0:real^1,x]` THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[DROP_VEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[INTEGRAL_CONST] THEN IMP_REWRITE_TAC[CONTENT_1] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_DROP; DROP_VEC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[DROP_VEC] THEN MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Interval functions of bounded variation on a set. *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_bounded_setvariation_on",(12,"right"));; let set_variation = new_definition `set_variation s (f:(real^M->bool)->real^N) = sup { sum d (\k. norm(f k)) | ?t. d division_of t /\ t SUBSET s}`;; let has_bounded_setvariation_on = new_definition `(f:(real^M->bool)->real^N) has_bounded_setvariation_on s <=> ?B. !d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= B`;; let SET_VARIATION_DEGENERATES = prove (`!f:(real^M->bool)->real^N g s. ~(f has_bounded_setvariation_on s) /\ ~(g has_bounded_setvariation_on s) ==> set_variation s f = set_variation s g`, REWRITE_TAC[has_bounded_setvariation_on; set_variation] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUP_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[]);; let HAS_BOUNDED_SETVARIATION_ON = prove (`!f:(real^M->bool)->real^N s. f has_bounded_setvariation_on s <=> ?B. &0 < B /\ !d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= B`, REWRITE_TAC[has_bounded_setvariation_on] THEN MESON_TAC[REAL_ARITH `&0 < abs B + &1 /\ (x <= B ==> x <= abs B + &1)`]);; let HAS_BOUNDED_SET_VARIATION = prove (`!f:(real^M->bool)->real^N s c. f has_bounded_setvariation_on s /\ set_variation s f <= c <=> !d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= c`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on; set_variation] THEN MATCH_MP_TAC(TAUT `(r ==> p) /\ (p ==> (q <=> r)) ==> (p /\ q <=> r)`) THEN CONJ_TAC THENL [MESON_TAC[]; DISCH_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_SUP_LE_EQ o lhand o snd) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MESON_TAC[ELEMENTARY_EMPTY; EMPTY_SUBSET]);; let HAS_BOUNDED_SETVARIATION_COMPARISON = prove (`!f:(real^M->bool)->real^N g:(real^M->bool)->real^P s. f has_bounded_setvariation_on s /\ (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s ==> norm(g(interval[a,b])) <= norm(f(interval[a,b]))) ==> g has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[has_bounded_setvariation_on] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN FIRST_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]);; let HAS_BOUNDED_SETVARIATION_ON_EQ = prove (`!f g:(real^M->bool)->real^N s. (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s ==> f(interval[a,b]) = g(interval[a,b])) /\ f has_bounded_setvariation_on s ==> g has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_SETVARIATION_COMPARISON) THEN ASM_SIMP_TAC[REAL_LE_REFL]);; let SET_VARIATION_EQ = prove (`!f g:(real^M->bool)->real^N s. (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s ==> f(interval[a,b]) = g(interval[a,b])) ==> set_variation s f = set_variation s g`, REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]);; let HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE = prove (`!f:(real^M->bool)->real^N s. f has_bounded_setvariation_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\k. lift(f k$i)) has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on; NORM_LIFT] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `B:real` THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d:(real^M->bool)->bool`; `t:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:num->real` THEN DISCH_TAC THEN EXISTS_TAC `sum (1..dimindex(:N)) B` THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (\k. sum (1..dimindex(:N)) (\i. abs(((f:(real^M->bool)->real^N) k)$i)))` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[SUM_LE; NORM_LE_L1] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN ASM_SIMP_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_MESON_TAC[]]);; let HAS_BOUNDED_SETVARIATION_ON_LIFT_ABS = prove (`!f:(real^N->bool)->real s. (\x. lift(abs(f x))) has_bounded_setvariation_on s <=> (\x. lift(f x)) has_bounded_setvariation_on s`, REWRITE_TAC[has_bounded_setvariation_on] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_ABS]);; let SETVARIATION_EQUAL_LEMMA = prove (`!mf:((real^M->bool)->real^N)->((real^M->bool)->real^N) ms ms'. (!s. ms'(ms s) = s /\ ms(ms' s) = s) /\ (!f a b. ~(interval[a,b] = {}) ==> mf f (ms (interval[a,b])) = f (interval[a,b]) /\ ?a' b'. ~(interval[a',b'] = {}) /\ ms' (interval[a,b]) = interval[a',b']) /\ (!t u. t SUBSET u ==> ms t SUBSET ms u /\ ms' t SUBSET ms' u) /\ (!d t. d division_of t ==> (IMAGE ms d) division_of ms t /\ (IMAGE ms' d) division_of ms' t) ==> (!f s. (mf f) has_bounded_setvariation_on (ms s) <=> f has_bounded_setvariation_on s) /\ (!f s. set_variation (ms s) (mf f) = set_variation s f)`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[has_bounded_setvariation_on; set_variation] THEN MATCH_MP_TAC(MESON[] `((!f s. s1 f s = s2 f s) ==> P) /\ (!f s. s1 f s = s2 f s) ==> P /\ (!f s. sup (s1 f s) = sup (s2 f s))`) THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `IMAGE (ms':(real^M->bool)->real^M->bool) d`; EXISTS_TAC `IMAGE (ms:(real^M->bool)->real^M->bool) d`] THEN (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC]) THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[o_THM] THEN FIRST_ASSUM (fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN STRIP_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `?a' b':real^M. ~(interval[a',b'] = {}) /\ ms' (interval[a:real^M,b]) = interval[a',b']` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY = prove (`!f:(real^M->bool)->real^N s. (?d. d division_of s) ==> (f has_bounded_setvariation_on s <=> ?B. !d. d division_of s ==> sum d (\k. norm(f k)) <= B)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THENL [MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `d':(real^M->bool)->bool`) THEN MP_TAC(ISPECL [`d:(real^M->bool)->bool`; `d':(real^M->bool)->bool`; `t:real^M->bool`; `s:real^M->bool`] PARTIAL_DIVISION_EXTEND) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `d'':(real^M->bool)->bool`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d'' (\k:real^M->bool. norm(f k:real^N))` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]);; let HAS_BOUNDED_SETVARIATION_ON_INTERVAL = prove (`!f:(real^M->bool)->real^N a b. f has_bounded_setvariation_on interval[a,b] <=> ?B. !d. d division_of interval[a,b] ==> sum d (\k. norm(f k)) <= B`, REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY THEN REWRITE_TAC[ELEMENTARY_INTERVAL]);; let HAS_BOUNDED_SETVARIATION_ON_UNIV = prove (`!f:(real^M->bool)->real^N. f has_bounded_setvariation_on (:real^M) <=> ?B. !d. d division_of UNIONS d ==> sum d (\k. norm(f k)) <= B`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on; SUBSET_UNIV] THEN MESON_TAC[DIVISION_OF_UNION_SELF]);; let HAS_BOUNDED_SETVARIATION_ON_SUBSET = prove (`!f:(real^M->bool)->real^N s t. f has_bounded_setvariation_on s /\ t SUBSET s ==> f has_bounded_setvariation_on t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[has_bounded_setvariation_on] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SUBSET_TRANS]);; let HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS = prove (`!f:(real^M->bool)->real^N s. f has_bounded_setvariation_on s ==> bounded { f(interval[c,d]) | interval[c,d] SUBSET s}`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on; bounded] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `max (abs B) (norm((f:(real^M->bool)->real^N) {}))` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN DISCH_TAC THEN ASM_CASES_TAC `interval[c:real^M,d] = {}` THEN ASM_REWRITE_TAC[REAL_ARITH `a <= max b a`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{interval[c:real^M,d]}`; `interval[c:real^M,d]`]) THEN ASM_SIMP_TAC[DIVISION_OF_SELF; SUM_SING] THEN REAL_ARITH_TAC);; let HAS_BOUNDED_SETVARIATION_ON_NORM = prove (`!f:(real^M->bool)->real^N s. (\x. lift(norm(f x))) has_bounded_setvariation_on s <=> f has_bounded_setvariation_on s`, REWRITE_TAC[has_bounded_setvariation_on; NORM_REAL; GSYM drop] THEN REWRITE_TAC[REAL_ABS_NORM; LIFT_DROP]);; let HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR = prove (`!f:(real^M->bool)->real^N g:real^N->real^P s. f has_bounded_setvariation_on s /\ linear g ==> (g o f) has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_TAC `C:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN EXISTS_TAC `B * C:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (\k. C * norm((f:(real^M->bool)->real^N) k))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_MESON_TAC[DIVISION_OF_FINITE]; GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN REWRITE_TAC[SUM_LMUL] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN ASM_MESON_TAC[]]);; let HAS_BOUNDED_SETVARIATION_ON_0 = prove (`!s:real^N->bool. (\x. vec 0) has_bounded_setvariation_on s`, REWRITE_TAC[has_bounded_setvariation_on; NORM_0; SUM_0] THEN MESON_TAC[REAL_LE_REFL]);; let SET_VARIATION_0 = prove (`!s:real^N->bool. set_variation s (\x. vec 0) = &0`, GEN_TAC THEN REWRITE_TAC[set_variation; NORM_0; SUM_0] THEN GEN_REWRITE_TAC RAND_CONV [GSYM SUP_SING] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN MESON_TAC[ELEMENTARY_EMPTY; EMPTY_SUBSET]);; let HAS_BOUNDED_SETVARIATION_ON_CMUL = prove (`!f:(real^M->bool)->real^N c s. f has_bounded_setvariation_on s ==> (\x. c % f x) has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; o_DEF] HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR) THEN REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);; let HAS_BOUNDED_SETVARIATION_ON_NEG = prove (`!f:(real^M->bool)->real^N s. (\x. --(f x)) has_bounded_setvariation_on s <=> f has_bounded_setvariation_on s`, REWRITE_TAC[has_bounded_setvariation_on; NORM_NEG]);; let HAS_BOUNDED_SETVARIATION_ON_ADD = prove (`!f:(real^M->bool)->real^N g s. f has_bounded_setvariation_on s /\ g has_bounded_setvariation_on s ==> (\x. f x + g x) has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `B + C:real` THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (\k. norm((f:(real^M->bool)->real^N) k)) + sum d (\k. norm((g:(real^M->bool)->real^N) k))` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_ADD2]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[NORM_TRIANGLE]);; let HAS_BOUNDED_SETVARIATION_ON_SUB = prove (`!f:(real^M->bool)->real^N g s. f has_bounded_setvariation_on s /\ g has_bounded_setvariation_on s ==> (\x. f x - g x) has_bounded_setvariation_on s`, REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --y`] THEN SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_ADD; HAS_BOUNDED_SETVARIATION_ON_NEG]);; let HAS_BOUNDED_SETVARIATION_ON_MUL = prove (`!f g:(real^M->bool)->real^N s. f has_bounded_setvariation_on s /\ g has_bounded_setvariation_on s ==> (\x. drop(f x) % g x) has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:real`) (X_CHOOSE_TAC `B2:real`)) THEN EXISTS_TAC `B1 * B2:real` THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`d:(real^M->bool)->bool`; `t:real^M->bool`])) THEN ASM_REWRITE_TAC[NORM_MUL; GSYM NORM_1; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `p /\ q /\ r /\ s ==> t <=> q /\ s ==> p /\ r ==> t`] REAL_LE_MUL2)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[SUM_POS_LE; NORM_POS_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_MUL_BOUND THEN ASM_REWRITE_TAC[NORM_POS_LE]);; let HAS_BOUNDED_SETVARIATION_ON_NULL = prove (`!f:(real^M->bool)->real^N s. (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s /\ content(interval[a,b]) = &0 ==> f(interval[a,b]) = vec 0) /\ content s = &0 /\ bounded s ==> f has_bounded_setvariation_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_COMPARISON THEN EXISTS_TAC `(\x. vec 0):(real^M->bool)->real^N` THEN REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_0; NORM_ARITH `norm(x:real^N) <= norm(vec 0:real^M) <=> x = vec 0`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]);; let SET_VARIATION_ON_EMPTY = prove (`!f:(real^M->bool)->real^N. set_variation {} f = &0`, REWRITE_TAC[set_variation; SUBSET_EMPTY; DIVISION_OF_TRIVIAL; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM2] THEN REWRITE_TAC[SET_RULE `{f x | x = a} = {f a}`; SUM_CLAUSES; SUP_SING]);; let SET_VARIATION_ELEMENTARY_LEMMA = prove (`!f:(real^M->bool)->real^N s. (?d. d division_of s) ==> ((!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= b) <=> (!d. d division_of s ==> sum d (\k. norm(f k)) <= b))`, REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `d1:(real^M->bool)->bool`) THEN EQ_TAC THENL [MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `d2:(real^M->bool)->bool` THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`d2:(real^M->bool)->bool`; `d1:(real^M->bool)->bool`; `t:real^M->bool`; `s:real^M->bool`] PARTIAL_DIVISION_EXTEND) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `d3:(real^M->bool)->bool`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d3 (\k:real^M->bool. norm(f k:real^N))` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]);; let SET_VARIATION_ON_ELEMENTARY = prove (`!f:(real^M->bool)->real^N s. (?d. d division_of s) ==> set_variation s f = sup { sum d (\k. norm(f k)) | d division_of s}`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[set_variation; sup] THEN REWRITE_TAC[FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN ASM_SIMP_TAC[SET_VARIATION_ELEMENTARY_LEMMA]);; let SET_VARIATION_ON_INTERVAL = prove (`!f:(real^M->bool)->real^N a b. set_variation (interval[a,b]) f = sup { sum d (\k. norm(f k)) | d division_of interval[a,b]}`, REPEAT GEN_TAC THEN MATCH_MP_TAC SET_VARIATION_ON_ELEMENTARY THEN REWRITE_TAC[ELEMENTARY_INTERVAL]);; let SET_VARIATION_INTERVAL_LEMMA = prove (`!f:(real^M->bool)->real^N s c. is_interval s ==> ((!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= c) <=> (!d a b. d division_of interval[a,b] /\ interval[a,b] SUBSET s ==> sum d (\k. norm(f k)) <= c))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?u v:real^M. UNIONS d SUBSET interval[u,v] /\ interval[u,v] SUBSET s` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `!k. k IN d ==> k SUBSET s /\ ?u v:real^M. k = interval[u,v]` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(d:(real^M->bool)->bool)` MP_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; UNDISCH_TAC `is_interval(s:real^M->bool)` THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN SPEC_TAC(`d:(real^M->bool)->bool`,`d:(real^M->bool)->bool`)] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_0; EMPTY_SUBSET] THEN MESON_TAC[EMPTY_AS_INTERVAL; EMPTY_SUBSET]; MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `d:(real^M->bool)->bool`] THEN REWRITE_TAC[UNIONS_INSERT; FORALL_IN_INSERT] THEN DISCH_THEN(fun th -> DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(CONJUNCT1 th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM]) THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `w:real^M` (X_CHOOSE_THEN `z:real^M` MP_TAC)) THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `w:real^M`; `z:real^M`; `u:real^M`; `v:real^M`] UNION_INTERVAL_SUBSET_INTERVAL) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]; MP_TAC(ISPECL [`u:real^M`; `v:real^M`] ELEMENTARY_INTERVAL) THEN DISCH_THEN(X_CHOOSE_TAC `d':(real^M->bool)->bool`) THEN MP_TAC(ISPECL [`d:(real^M->bool)->bool`; `d':(real^M->bool)->bool`; `t:real^M->bool`; `interval[u:real^M,v]`] PARTIAL_DIVISION_EXTEND) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d'':(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN TRANS_TAC REAL_LE_TRANS `sum d'' (\k. norm((f:(real^M->bool)->real^N) k))` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]]);; let HAS_BOUNDED_SETVARIATION_WORKS = prove (`!f:(real^M->bool)->real^N s. f has_bounded_setvariation_on s ==> (!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= set_variation s f) /\ (!B. (!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm (f k)) <= B) ==> set_variation s f <= B)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN DISCH_TAC THEN MP_TAC(ISPEC `{ sum d (\k. norm((f:(real^M->bool)->real^N) k)) | ?t. d division_of t /\ t SUBSET s}` SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[set_variation] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`&0`; `{}:(real^M->bool)->bool`] THEN REWRITE_TAC[SUM_CLAUSES] THEN EXISTS_TAC `{}:real^M->bool` THEN SIMP_TAC[division_of; EMPTY_SUBSET; NOT_IN_EMPTY; FINITE_EMPTY; UNIONS_0]);; let HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY = prove (`!f:(real^M->bool)->real^N s. f has_bounded_setvariation_on s /\ (?d. d division_of s) ==> (!d. d division_of s ==> sum d (\k. norm(f k)) <= set_variation s f) /\ (!B. (!d. d division_of s ==> sum d (\k. norm(f k)) <= B) ==> set_variation s f <= B)`, SIMP_TAC[GSYM SET_VARIATION_ELEMENTARY_LEMMA] THEN MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);; let HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL = prove (`!f:(real^M->bool)->real^N a b. f has_bounded_setvariation_on interval[a,b] ==> (!d. d division_of interval[a,b] ==> sum d (\k. norm(f k)) <= set_variation (interval[a,b]) f) /\ (!B. (!d. d division_of interval[a,b] ==> sum d (\k. norm(f k)) <= B) ==> set_variation (interval[a,b]) f <= B)`, SIMP_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY; ELEMENTARY_INTERVAL]);; let SET_VARIATION_UBOUND = prove (`!f:(real^M->bool)->real^N s B. f has_bounded_setvariation_on s /\ (!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= B) ==> set_variation s f <= B`, MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);; let SET_VARIATION_UBOUND_ON_INTERVAL = prove (`!f:(real^M->bool)->real^N a b B. f has_bounded_setvariation_on interval[a,b] /\ (!d. d division_of interval[a,b] ==> sum d (\k. norm(f k)) <= B) ==> set_variation (interval[a,b]) f <= B`, SIMP_TAC[GSYM SET_VARIATION_ELEMENTARY_LEMMA; ELEMENTARY_INTERVAL] THEN MESON_TAC[SET_VARIATION_UBOUND]);; let SET_VARIATION_LBOUND = prove (`!f:(real^M->bool)->real^N s B. f has_bounded_setvariation_on s /\ (?d t. d division_of t /\ t SUBSET s /\ B <= sum d (\k. norm(f k))) ==> B <= set_variation s f`, MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS; REAL_LE_TRANS]);; let SET_VARIATION_LBOUND_ON_INTERVAL = prove (`!f:(real^M->bool)->real^N a b B. f has_bounded_setvariation_on interval[a,b] /\ (?d. d division_of interval[a,b] /\ B <= sum d (\k. norm(f k))) ==> B <= set_variation (interval[a,b]) f`, MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL; REAL_LE_TRANS]);; let SET_VARIATION = prove (`!f:(real^M->bool)->real^N s d t. f has_bounded_setvariation_on s /\ d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= set_variation s f`, MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);; let SET_VARIATION_WORKS_ON_INTERVAL = prove (`!f:(real^M->bool)->real^N a b d. f has_bounded_setvariation_on interval[a,b] /\ d division_of interval[a,b] ==> sum d (\k. norm(f k)) <= set_variation (interval[a,b]) f`, MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL]);; let SET_VARIATION_POS_LE = prove (`!f:(real^M->bool)->real^N s. f has_bounded_setvariation_on s ==> &0 <= set_variation s f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SET_VARIATION)) THEN DISCH_THEN(MP_TAC o SPECL[`{}:(real^M->bool)->bool`; `{}:real^M->bool`]) THEN REWRITE_TAC[EMPTY_SUBSET; SUM_CLAUSES; DIVISION_OF_TRIVIAL]);; let SET_VARIATION_CMUL = prove (`!f:(real^M->bool)->real^N s c. f has_bounded_setvariation_on s ==> set_variation s (\x. c % f x) = abs c * set_variation s f`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; SET_VARIATION_0; REAL_ABS_NUM; REAL_MUL_LZERO] THEN REWRITE_TAC[has_bounded_setvariation_on; set_variation] THEN DISCH_TAC THEN REWRITE_TAC[NORM_MUL; SUM_LMUL] THEN MATCH_MP_TAC SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `r:real` THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH`&0 < abs x <=> ~(x = &0)`] THEN CONV_TAC SYM_CONV THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_SUP_LE_EQ o lhand o snd) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[ELEMENTARY_EMPTY; EMPTY_SUBSET]);; let SET_VARIATION_COMPARISON = prove (`!f:(real^M->bool)->real^N g:(real^M->bool)->real^P s. f has_bounded_setvariation_on s /\ (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s ==> norm(g(interval[a,b])) <= norm(f(interval[a,b]))) ==> set_variation s g <= set_variation s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_UBOUND THEN CONJ_TAC THENL [ASM_MESON_TAC[HAS_BOUNDED_SETVARIATION_COMPARISON]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP HAS_BOUNDED_SETVARIATION_WORKS) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN FIRST_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]);; let SET_VARIATION_GE_FUNCTION = prove (`!f:(real^M->bool)->real^N s a b. f has_bounded_setvariation_on s /\ interval[a,b] SUBSET s /\ ~(interval[a,b] = {}) ==> norm(f(interval[a,b])) <= set_variation s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_LBOUND THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `{interval[a:real^M,b]}` THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_REWRITE_TAC[SUM_SING; REAL_LE_REFL] THEN ASM_SIMP_TAC[DIVISION_OF_SELF]);; let SET_VARIATION_ON_NULL = prove (`!f:(real^M->bool)->real^N s. (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = vec 0) /\ content s = &0 /\ bounded s ==> set_variation s f = &0`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC SET_VARIATION_UBOUND THEN ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x <= &0`) THEN MATCH_MP_TAC SUM_EQ_0 THEN REWRITE_TAC[NORM_EQ_0] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]; MATCH_MP_TAC SET_VARIATION_POS_LE THEN ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL]]);; let SET_VARIATION_TRIANGLE = prove (`!f:(real^M->bool)->real^N g s. f has_bounded_setvariation_on s /\ g has_bounded_setvariation_on s ==> set_variation s (\x. f x + g x) <= set_variation s f + set_variation s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_UBOUND THEN ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_ADD] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (\k. norm((f:(real^M->bool)->real^N) k)) + sum d (\k. norm((g:(real^M->bool)->real^N) k))` THEN CONJ_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[NORM_TRIANGLE]; MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC SET_VARIATION THEN ASM_MESON_TAC[]]);; let HAS_BOUNDED_SETVARIATION_ON_VSUM,SET_VARIATION_SUM_LE = (CONJ_PAIR o prove) (`(!f:A->(real^M->bool)->real^N s k. FINITE k /\ (!i. i IN k ==> f i has_bounded_setvariation_on s) ==> (\x. vsum k (\i. f i x)) has_bounded_setvariation_on s) /\ (!f:A->(real^M->bool)->real^N s k. FINITE k /\ (!i. i IN k ==> f i has_bounded_setvariation_on s) ==> set_variation s (\x. vsum k (\i. f i x)) <= sum k (\i. set_variation s (f i)))`, REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FORALL_IN_INSERT] THEN SIMP_TAC[SET_VARIATION_0; REAL_LE_REFL; HAS_BOUNDED_SETVARIATION_ON_0; HAS_BOUNDED_SETVARIATION_ON_ADD; ETA_AX] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) SET_VARIATION_TRIANGLE o lhand o snd) THEN ASM_SIMP_TAC[ETA_AX] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LADD]);; let BOUNDED_SET_VARIATION_ON_PASTECART = prove (`!f:(real^M->bool)->real^N g:(real^M->bool)->real^P s. f has_bounded_setvariation_on s /\ g has_bounded_setvariation_on s ==> (\x. pastecart (f x) (g x)) has_bounded_setvariation_on s /\ set_variation s (\x. pastecart (f x) (g x)) <= set_variation s f + set_variation s g`, REPEAT GEN_TAC THEN STRIP_TAC THEN SIMP_TAC[HAS_BOUNDED_SET_VARIATION] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `sum d (\k. norm((f:(real^M->bool)->real^N) k) + norm((g:(real^M->bool)->real^P) k))` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[NORM_PASTECART_LE; SUM_LE] THEN ASM_SIMP_TAC[SUM_ADD] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC SET_VARIATION THEN ASM_MESON_TAC[]);; let BOUNDED_SET_VARIATION_FROM_PASTECART = prove (`!f:(real^M->bool)->real^N g:(real^M->bool)->real^P s. (\x. pastecart (f x) (g x)) has_bounded_setvariation_on s ==> (f has_bounded_setvariation_on s /\ set_variation s f <= set_variation s (\x. pastecart (f x) (g x))) /\ (g has_bounded_setvariation_on s /\ set_variation s g <= set_variation s (\x. pastecart (f x) (g x)))`, REPEAT STRIP_TAC THEN (FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (INST_TYPE [`:Q`,`:P`] HAS_BOUNDED_SETVARIATION_COMPARISON))) ORELSE FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (INST_TYPE [`:Q`,`:P`] SET_VARIATION_COMPARISON)))) THEN ASM_REWRITE_TAC[NORM_LE_PASTECART]);; let HAS_BOUNDED_SETVARIATION_ON_PASTECART = prove (`!f:(real^M->bool)->real^N g:(real^M->bool)->real^P s. (\x. pastecart (f x) (g x)) has_bounded_setvariation_on s <=> f has_bounded_setvariation_on s /\ g has_bounded_setvariation_on s`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_SET_VARIATION_ON_PASTECART] THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SET_VARIATION_FROM_PASTECART) THEN SIMP_TAC[]);; let OPERATIVE_LIFTED_SETVARIATION = prove (`!f:(real^M->bool)->real^N. operative(+) f ==> operative (lifted(+)) (\i. if f has_bounded_setvariation_on i then SOME(set_variation i f) else NONE)`, let lemma1 = prove (`!f:(real^M->bool)->real B1 B2 k a b. 1 <= k /\ k <= dimindex(:M) /\ (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = &0) /\ (!a b c. f(interval[a,b]) <= f(interval[a,b] INTER {x | x$k <= c}) + f(interval[a,b] INTER {x | x$k >= c})) /\ (!d. d division_of (interval[a,b] INTER {x | x$k <= c}) ==> sum d f <= B1) /\ (!d. d division_of (interval[a,b] INTER {x | x$k >= c}) ==> sum d f <= B2) ==> !d. d division_of interval[a,b] ==> sum d f <= B1 + B2`, REPEAT GEN_TAC THEN REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "L") (LABEL_TAC "R")) THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {l INTER {x:real^M | x$k <= c} | l | l IN d /\ ~(l INTER {x | x$k <= c} = {})} f + sum {l INTER {x | x$k >= c} | l | l IN d /\ ~(l INTER {x | x$k >= c} = {})} f` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[DIVISION_SPLIT]] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (lhand(rand w))) THEN MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (rand(rand w)))) THEN MATCH_MP_TAC(TAUT `(a1 /\ a2) /\ (b1 /\ b2 ==> c) ==> (a1 ==> b1) ==> (a2 ==> b2) ==> c`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THENL [MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ; MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ] THEN ASM_MESON_TAC[]; DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC)] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (f o (\l. l INTER {x | x$k <= c})) + sum d (f o (\l. l INTER {x:real^M | x$k >= c}))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[o_THM] THEN FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]); MATCH_MP_TAC(REAL_ARITH `x = y /\ w = z ==> x + w <= y + z`) THEN CONJ_TAC THEN MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} SUBSET s`] THEN REWRITE_TAC[SET_RULE `(x IN s /\ ~(x IN {x | x IN s /\ ~P x}) ==> Q x) <=> (x IN s ==> P x ==> Q x)`] THEN SIMP_TAC[o_THM] THEN ASM_MESON_TAC[EMPTY_AS_INTERVAL; CONTENT_EMPTY]]) and lemma2 = prove (`!f:(real^M->bool)->real B k. 1 <= k /\ k <= dimindex(:M) /\ (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = &0) /\ (!d. d division_of interval[a,b] ==> sum d f <= B) ==> !d1 d2. d1 division_of (interval[a,b] INTER {x | x$k <= c}) /\ d2 division_of (interval[a,b] INTER {x | x$k >= c}) ==> sum d1 f + sum d2 f <= B`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d1 UNION d2:(real^M->bool)->bool`) THEN ANTS_TAC THENL [SUBGOAL_THEN `interval[a,b] = (interval[a,b] INTER {x:real^M | x$k <= c}) UNION (interval[a,b] INTER {x:real^M | x$k >= c})` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. x IN t \/ x IN u) ==> (s = s INTER t UNION s INTER u)`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM INTERIOR_INTER] THEN MATCH_MP_TAC(SET_RULE `!t. interior s SUBSET interior t /\ interior t = {} ==> interior s = {}`) THEN EXISTS_TAC `{x:real^M | x$k = c}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[INTERIOR_STANDARD_HYPERPLANE]] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC]; MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= b ==> y <= b`) THEN MATCH_MP_TAC SUM_UNION_NONZERO THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC]) THEN X_GEN_TAC `k:real^M->bool` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN EXISTS_TAC `interval[a,b] INTER {x:real^M | x$k = c}` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(interval[a,b] INTER {x:real^M | x$k <= c}) INTER (interval[a,b] INTER {x:real^M | x$k >= c})` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SUBSET_INTER] THEN ASM_MESON_TAC[division_of]; REWRITE_TAC[SET_RULE `(s INTER t) INTER (s INTER u) = s INTER t INTER u`] THEN SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC]; SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN ASM_SIMP_TAC[GSYM INTER_ASSOC; INTERVAL_SPLIT] THEN REWRITE_TAC[CONTENT_EQ_0] THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]]) in REWRITE_TAC[operative; NEUTRAL_VECTOR_ADD] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL; BOUNDED_INTERVAL; MONOIDAL_REAL_ADD; SET_VARIATION_ON_NULL; NEUTRAL_LIFTED; NEUTRAL_REAL_ADD] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real`; `k:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `(f:(real^M->bool)->real^N) has_bounded_setvariation_on interval[a,b]` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `(f:(real^M->bool)->real^N) has_bounded_setvariation_on interval[a,b] INTER {x | x$k <= c} /\ (f:(real^M->bool)->real^N) has_bounded_setvariation_on interval[a,b] INTER {x | x$k >= c}` ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_SUBSET)) THEN REWRITE_TAC[INTER_SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[lifted] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] lemma1) THEN MAP_EVERY EXISTS_TAC [`k:num`; `a:real^M`; `b:real^M`] THEN ASM_SIMP_TAC[NORM_0] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH `x:real^N = y + z ==> norm(x) <= norm y + norm z`) THEN ASM_SIMP_TAC[]; FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_AND) THEN ASM_SIMP_TAC[INTERVAL_SPLIT; SET_VARIATION_WORKS_ON_INTERVAL]]; ONCE_REWRITE_TAC[REAL_ARITH `x + y <= z <=> x <= z - y`] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN X_GEN_TAC `d1:(real^M->bool)->bool` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x <= y - z <=> z <= y - x`] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN X_GEN_TAC `d2:(real^M->bool)->bool` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `x <= y - z <=> z + x <= y`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] lemma2) THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[NORM_0; SET_VARIATION_WORKS_ON_INTERVAL]]; REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[lifted]) THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] THEN EXISTS_TAC `set_variation (interval[a,b] INTER {x | x$k <= c}) (f:(real^M->bool)->real^N) + set_variation (interval[a,b] INTER {x | x$k >= c}) f` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] lemma1) THEN MAP_EVERY EXISTS_TAC [`k:num`; `a:real^M`; `b:real^M`] THEN ASM_SIMP_TAC[NORM_0] THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH `x:real^N = y + z ==> norm(x) <= norm y + norm z`) THEN ASM_SIMP_TAC[]; UNDISCH_TAC `(f:(real^M->bool)->real^N) has_bounded_setvariation_on (interval[a,b] INTER {x | x$k <= c})` THEN ASM_SIMP_TAC[INTERVAL_SPLIT; SET_VARIATION_WORKS_ON_INTERVAL]; UNDISCH_TAC `(f:(real^M->bool)->real^N) has_bounded_setvariation_on (interval[a,b] INTER {x | x$k >= c})` THEN ASM_SIMP_TAC[INTERVAL_SPLIT; SET_VARIATION_WORKS_ON_INTERVAL]]]);; let OPERATIVE_HAS_BOUNDED_SETVARIATION_ON = prove (`!f:(real^M->bool)->real^N. operative (+) f ==> operative (/\) ((has_bounded_setvariation_on) f)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP OPERATIVE_LIFTED_SETVARIATION) THEN SIMP_TAC[operative; NEUTRAL_LIFTED; NEUTRAL_AND; MONOIDAL_REAL_ADD; NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[distinctness "option"; lifted])));; let HAS_BOUNDED_SETVARIATION_ON_DIVISION = prove (`!f:(real^M->bool)->real^N a b d. operative (+) f /\ d division_of interval[a,b] ==> ((!k. k IN d ==> f has_bounded_setvariation_on k) <=> f has_bounded_setvariation_on interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC OPERATIVE_DIVISION_AND THEN ASM_REWRITE_TAC[operative; NEUTRAL_AND] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[operative; NEUTRAL_VECTOR_ADD]) THEN ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL; BOUNDED_INTERVAL]; FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_LIFTED_SETVARIATION) THEN REWRITE_TAC[operative] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[lifted; distinctness "option"])]);; let SET_VARIATION_ON_DIVISION = prove (`!f:(real^M->bool)->real^N a b d. operative (+) f /\ d division_of interval[a,b] /\ f has_bounded_setvariation_on interval[a,b] ==> sum d (\k. set_variation k f) = set_variation (interval[a,b]) f`, let lemma0 = prove (`!op x y. lifted op (SOME x) y = SOME z <=> ?w. y = SOME w /\ op x w = z`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC option_INDUCT THEN REWRITE_TAC[lifted; distinctness "option"; injectivity "option"] THEN MESON_TAC[]) in let lemma = prove (`!P op f s z. monoidal op /\ FINITE s /\ iterate(lifted op) s (\i. if P i then SOME(f i) else NONE) = SOME z ==> iterate op s f = z`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_LIFTED; NEUTRAL_LIFTED] THEN REWRITE_TAC[injectivity "option"] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[lifted; distinctness "option"] THEN ASM_MESON_TAC[lemma0]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_LIFTED_SETVARIATION) THEN DISCH_THEN(MP_TAC o SPECL[`d:(real^M->bool)->bool`; `a:real^M`; `b:real^M`] o MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] OPERATIVE_DIVISION)) THEN ASM_SIMP_TAC[MONOIDAL_LIFTED; MONOIDAL_REAL_ADD] THEN MP_TAC(ISPECL [`\k. (f:(real^M->bool)->real^N) has_bounded_setvariation_on k`; `(+):real->real->real`; `\k. set_variation k (f:(real^M->bool)->real^N)`; `d:(real^M->bool)->bool`; `set_variation (interval[a,b]) (f:(real^M->bool)->real^N)`] lemma) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_REWRITE_TAC[sum; MONOIDAL_REAL_ADD]);; let SET_VARIATION_MONOTONE = prove (`!f:(real^M->bool)->real^N s t. f has_bounded_setvariation_on s /\ t SUBSET s ==> set_variation t f <= set_variation s f`, REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`&0`; `{}:(real^M->bool)->bool`] THEN REWRITE_TAC[SUM_CLAUSES] THEN EXISTS_TAC `{}:real^M->bool` THEN REWRITE_TAC[EMPTY_SUBSET; DIVISION_OF_TRIVIAL]; MATCH_MP_TAC(SET_RULE `(!d. P d ==> Q d) ==> {f d | P d} SUBSET {f d | Q d}`) THEN ASM_MESON_TAC[SUBSET_TRANS]; REWRITE_TAC[FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN ASM_REWRITE_TAC[GSYM has_bounded_setvariation_on]]);; let HAS_BOUNDED_SETVARIATION_REFLECT2_EQ,SET_VARIATION_REFLECT2 = (CONJ_PAIR o prove) (`(!f:(real^M->bool)->real^N s. (\k. f(IMAGE (--) k)) has_bounded_setvariation_on (IMAGE (--) s) <=> f has_bounded_setvariation_on s) /\ (!f:(real^M->bool)->real^N s. set_variation (IMAGE (--) s) (\k. f(IMAGE (--) k)) = set_variation s f)`, MATCH_MP_TAC SETVARIATION_EQUAL_LEMMA THEN EXISTS_TAC `IMAGE ((--):real^M->real^M)` THEN SIMP_TAC[IMAGE_SUBSET; GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[VECTOR_NEG_NEG; IMAGE_ID; REFLECT_INTERVAL] THEN SIMP_TAC[ETA_AX; DIVISION_OF_REFLECT] THEN SIMP_TAC[EQ_INTERVAL; TAUT `~q /\ (p /\ q \/ r) <=> ~q /\ r`] THEN REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN REWRITE_TAC[UNWIND_THM1; CONTRAPOS_THM] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY; VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);; let HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ, SET_VARIATION_TRANSLATION2 = (CONJ_PAIR o prove) (`(!a f:(real^M->bool)->real^N s. (\k. f(IMAGE (\x. a + x) k)) has_bounded_setvariation_on (IMAGE (\x. --a + x) s) <=> f has_bounded_setvariation_on s) /\ (!a f:(real^M->bool)->real^N s. set_variation (IMAGE (\x. --a + x) s) (\k. f(IMAGE (\x. a + x) k)) = set_variation s f)`, GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `a:real^M` THEN MATCH_MP_TAC SETVARIATION_EQUAL_LEMMA THEN EXISTS_TAC `\s. IMAGE (\x:real^M. a + x) s` THEN SIMP_TAC[IMAGE_SUBSET; GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN SIMP_TAC[EQ_INTERVAL; TAUT `~q /\ (p /\ q \/ r) <=> ~q /\ r`] THEN REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN REWRITE_TAC[UNWIND_THM1; CONTRAPOS_THM] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY; VECTOR_ADD_COMPONENT; REAL_LT_LADD] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [ETA_AX] THEN ASM_SIMP_TAC[DIVISION_OF_TRANSLATION]);; let HAS_BOUNDED_SETVARIATION_TRANSLATION = prove (`!f:(real^M->bool)->real^N s a. f has_bounded_setvariation_on s ==> (\k. f(IMAGE (\x. a + x) k)) has_bounded_setvariation_on (IMAGE (\x. --a + x) s)`, REWRITE_TAC[HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ]);; (* ------------------------------------------------------------------------- *) (* Absolute integrability (this is the same as Lebesgue integrability). *) (* ------------------------------------------------------------------------- *) parse_as_infix("absolutely_integrable_on",(12,"right"));; let absolutely_integrable_on = new_definition `f absolutely_integrable_on s <=> f integrable_on s /\ (\x. lift(norm(f x))) integrable_on s`;; let ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE = prove (`!f s. f absolutely_integrable_on s ==> f integrable_on s`, SIMP_TAC[absolutely_integrable_on]);; let ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE = prove (`!f:real^M->real^N s. f absolutely_integrable_on s ==> (\x. lift (norm (f x))) integrable_on s`, REWRITE_TAC[absolutely_integrable_on] THEN MESON_TAC[]);; let ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV = prove (`!f s. (\x. if x IN s then f x else vec 0) absolutely_integrable_on (:real^M) <=> f absolutely_integrable_on s`, REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_RESTRICT_UNIV; COND_RAND; NORM_0; LIFT_NUM]);; let ABSOLUTELY_INTEGRABLE_RESTRICT_INTER = prove (`!f:real^M->real^N s t. (\x. if x IN s then f x else vec 0) absolutely_integrable_on t <=> f absolutely_integrable_on (s INTER t)`, REWRITE_TAC[absolutely_integrable_on; GSYM INTEGRABLE_RESTRICT_INTER] THEN REWRITE_TAC[COND_RAND; NORM_0; LIFT_NUM]);; let ABSOLUTELY_INTEGRABLE_LE = prove (`!f:real^M->real^N s. f absolutely_integrable_on s ==> norm(integral s f) <= drop(integral s (\x. lift(norm(f x))))`, REWRITE_TAC[absolutely_integrable_on] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]);; let ABSOLUTELY_INTEGRABLE_ON_NULL = prove (`!f a b. content(interval[a,b]) = &0 ==> f absolutely_integrable_on interval[a,b]`, SIMP_TAC[absolutely_integrable_on; INTEGRABLE_ON_NULL]);; let ABSOLUTELY_INTEGRABLE_ON_EMPTY = prove (`!f:real^M->real^N. f absolutely_integrable_on {}`, REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_ON_EMPTY]);; let ABSOLUTELY_INTEGRABLE_0 = prove (`!s. (\x. vec 0) absolutely_integrable_on s`, REWRITE_TAC[absolutely_integrable_on; NORM_0; LIFT_NUM; INTEGRABLE_0]);; let ABSOLUTELY_INTEGRABLE_CMUL = prove (`!f s c. f absolutely_integrable_on s ==> (\x. c % f(x)) absolutely_integrable_on s`, SIMP_TAC[absolutely_integrable_on; INTEGRABLE_CMUL; NORM_MUL; LIFT_CMUL]);; let ABSOLUTELY_INTEGRABLE_CMUL_EQ = prove (`!f:real^M->real^N s c. (\x. c % f x) absolutely_integrable_on s <=> c = &0 \/ f absolutely_integrable_on s`, REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_CMUL_EQ; NORM_MUL; LIFT_CMUL; REAL_ABS_ZERO] THEN CONV_TAC TAUT);; let ABSOLUTELY_INTEGRABLE_NEG = prove (`!f s. f absolutely_integrable_on s ==> (\x. --f(x)) absolutely_integrable_on s`, SIMP_TAC[absolutely_integrable_on; INTEGRABLE_NEG; NORM_NEG]);; let ABSOLUTELY_INTEGRABLE_NEG_EQ = prove (`!f:real^M->real^N s. (\x. --f x) absolutely_integrable_on s <=> f absolutely_integrable_on s`, REWRITE_TAC[absolutely_integrable_on; NORM_NEG; INTEGRABLE_NEG_EQ]);; let ABSOLUTELY_INTEGRABLE_NORM = prove (`!f s. f absolutely_integrable_on s ==> (\x. lift(norm(f x))) absolutely_integrable_on s`, SIMP_TAC[absolutely_integrable_on; NORM_LIFT; REAL_ABS_NORM]);; let ABSOLUTELY_INTEGRABLE_ABS_1 = prove (`!f s. f absolutely_integrable_on s ==> (\x. lift(abs(drop(f x)))) absolutely_integrable_on s`, REWRITE_TAC[GSYM NORM_LIFT; LIFT_DROP; ABSOLUTELY_INTEGRABLE_NORM]);; let ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL = prove (`!f:real^M->real^N s a b. f absolutely_integrable_on s /\ interval[a,b] SUBSET s ==> f absolutely_integrable_on interval[a,b]`, REWRITE_TAC[absolutely_integrable_on] THEN MESON_TAC[INTEGRABLE_ON_SUBINTERVAL]);; let ABSOLUTELY_INTEGRABLE_ON_NEGLIGIBLE = prove (`!f:real^M->real^N s. negligible s ==> f absolutely_integrable_on s`, SIMP_TAC[INTEGRABLE_ON_NEGLIGIBLE; absolutely_integrable_on]);; let ABSOLUTELY_INTEGRABLE_SPIKE = prove (`!f:real^M->real^N g s t. negligible s /\ (!x. x IN t DIFF s ==> g x = f x) ==> f absolutely_integrable_on t ==> g absolutely_integrable_on t`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[]);; let ABSOLUTELY_INTEGRABLE_SPIKE_EQ = prove (`!f:real^M->real^N g s t. negligible s /\ (!x. x IN t DIFF s ==> g x = f x) ==> (f absolutely_integrable_on t <=> g absolutely_integrable_on t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SPIKE THEN ASM_MESON_TAC[]);; let ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ = prove (`!f:real^M->real^N s t. negligible(s DIFF t UNION t DIFF s) ==> (f absolutely_integrable_on s <=> f absolutely_integrable_on t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SPIKE_EQ THEN EXISTS_TAC `s DIFF t UNION t DIFF s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let ABSOLUTELY_INTEGRABLE_SPIKE_SET = prove (`!f:real^M->real^N s t. negligible(s DIFF t UNION t DIFF s) ==> f absolutely_integrable_on s ==> f absolutely_integrable_on t`, MESON_TAC[ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ]);; let ABSOLUTELY_INTEGRABLE_EQ = prove (`!f:real^M->real^N g s. (!x. x IN s ==> f x = g x) /\ f absolutely_integrable_on s ==> g absolutely_integrable_on s`, REWRITE_TAC[absolutely_integrable_on] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_EQ THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))`] THEN ASM_SIMP_TAC[]);; let ABSOLUTELY_INTEGRABLE_TWIZZLE_EQ = prove (`!f:real^N->real^P s:real^M->bool p. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) ==> (f absolutely_integrable_on IMAGE (\x. lambda i. x$p i) s <=> (\x. f(lambda i. x$p i)) absolutely_integrable_on s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN BINOP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRABLE_TWIZZLE_EQ o lhand o snd) THEN FIRST_X_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[]);; let ABSOLUTELY_INTEGRABLE_AFFINITY = prove (`!f:real^M->real^N s m c. f absolutely_integrable_on s /\ ~(m = &0) ==> (\x. f(m % x + c)) absolutely_integrable_on (IMAGE (\x. inv m % x + --(inv(m) % c)) s)`, REWRITE_TAC[absolutely_integrable_on] THEN SIMP_TAC[INTEGRABLE_AFFINITY]);; let ABSOLUTELY_INTEGRABLE_TRANSLATION = prove (`!f:real^M->real^N s a. (\x. f(a + x)) absolutely_integrable_on s <=> f absolutely_integrable_on (IMAGE (\x. a + x) s)`, REWRITE_TAC[absolutely_integrable_on; GSYM INTEGRABLE_TRANSLATION]);; let ABSOLUTELY_INTEGRABLE_REFLECT_GEN = prove (`!f:real^M->real^N s. (\x. f(--x)) absolutely_integrable_on s <=> f absolutely_integrable_on (IMAGE (--) s)`, REWRITE_TAC[absolutely_integrable_on; GSYM INTEGRABLE_REFLECT_GEN]);; let ABSOLUTELY_INTEGRABLE_REFLECT = prove (`!f:real^M->real^N a b. (\x. f(--x)) absolutely_integrable_on (interval[--b,--a]) <=> f absolutely_integrable_on (interval[a,b])`, REWRITE_TAC[ABSOLUTELY_INTEGRABLE_REFLECT_GEN] THEN REWRITE_TAC[REFLECT_INTERVAL; VECTOR_NEG_NEG]);; let ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION = prove (`!f:real^M->real^N s. f absolutely_integrable_on s ==> (\k. integral k f) has_bounded_setvariation_on s`, REWRITE_TAC[has_bounded_setvariation_on] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `drop(integral (s:real^M->bool) (\x. lift(norm(f x:real^N))))` THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `(UNIONS d:real^M->bool) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; division_of]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral (UNIONS d) (\x. lift(norm((f:real^M->real^N) x))))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN EXISTS_TAC `s:real^M->bool` THEN EXISTS_TAC `d:(real^M->bool)->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_SUBSET; division_of]; ALL_TAC] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(vsum d (\i. integral i (\x:real^M. lift(norm(f x:real^N)))))` THEN CONJ_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[DROP_VSUM] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[o_THM] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `s:real^M->bool` THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_OF_UNION_SELF]] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN MAP_EVERY EXISTS_TAC [`s:real^M->bool`; `d:(real^M->bool)->bool`] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]]);; let lemma = prove (`!f:A->real^N g s e. sum s (\x. norm(f x - g x)) < e ==> FINITE s ==> abs(sum s (\x. norm(f x)) - sum s (\x. norm(g x))) < e`, REPEAT GEN_TAC THEN SIMP_TAC[GSYM SUM_SUB] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `y <= z ==> x <= y ==> x <= z`) THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN NORM_ARITH_TAC);; let BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] /\ (\k. integral k f) has_bounded_setvariation_on interval[a,b] ==> f absolutely_integrable_on interval[a,b]`, REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[absolutely_integrable_on] THEN MP_TAC(ISPEC `IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) {d | d division_of interval[a,b] }` SUP) THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ABBREV_TAC `i = sup (IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) {d | d division_of interval[a,b] })` THEN ANTS_TAC THENL [REWRITE_TAC[ELEMENTARY_INTERVAL] THEN ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift i` THEN REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i - e / &2`) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i <= i - e / &2)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN SUBGOAL_THEN `!x. ?e. &0 < e /\ !i. i IN d /\ ~(x IN i) ==> ball(x:real^M,e) INTER i = {}` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN MP_TAC(ISPECL [`UNIONS {i:real^M->bool | i IN d /\ ~(x IN i)}`; `x:real^M`] SEPARATE_POINT_CLOSED) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC CLOSED_UNIONS THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; IMP_CONJ] THEN FIRST_ASSUM(fun t -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN REWRITE_TAC[CLOSED_INTERVAL]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN SIMP_TAC[FORALL_IN_UNIONS; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_BALL] THEN REWRITE_TAC[IN_ELIM_THM; DE_MORGAN_THM; REAL_NOT_LT] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `k:real^M->real` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `e / &2` o MATCH_MP HENSTOCK_LEMMA) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^M. g(x) INTER ball(x,k x)` THEN CONJ_TAC THENL [MATCH_MP_TAC GAUGE_INTER THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[gauge; CENTRE_IN_BALL; OPEN_BALL]; ALL_TAC] THEN REWRITE_TAC[FINE_INTER] THEN X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ABBREV_TAC `p' = {(x:real^M,k:real^M->bool) | ?i l. x IN i /\ i IN d /\ (x,l) IN p /\ k = i INTER l}` THEN SUBGOAL_THEN `g fine (p':(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [EXPAND_TAC "p'" THEN MP_TAC(ASSUME `g fine (p:(real^M#(real^M->bool))->bool)`) THEN REWRITE_TAC[fine; IN_ELIM_PAIR_THM] THEN MESON_TAC[SET_RULE `k SUBSET l ==> (i INTER k) SUBSET l`]; ALL_TAC] THEN SUBGOAL_THEN `p' tagged_division_of interval[a:real^M,b]` ASSUME_TAC THENL [REWRITE_TAC[TAGGED_DIVISION_OF] THEN EXPAND_TAC "p'" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\(k,(x,l)). x,k INTER l) {k,xl | k IN (d:(real^M->bool)->bool) /\ xl IN (p:(real^M#(real^M->bool))->bool)}` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_PRODUCT] THEN EXPAND_TAC "p'" THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_PAIR_THM; IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`i:real^M->bool`; `l:real^M->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[IN_INTER] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `l SUBSET s ==> (k INTER l) SUBSET s`) THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `i:real^M->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x1:real^M`; `k1:real^M->bool`; `x2:real^M`; `k2:real^M->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `i1:real^M->bool` (X_CHOOSE_THEN `l1:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `i2:real^M->bool` (X_CHOOSE_THEN `l2:real^M->bool` STRIP_ASSUME_TAC)) ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(SET_RULE `(interior(i1) INTER interior(i2) = {} \/ interior(l1) INTER interior(l2) = {}) /\ interior(i1 INTER l1) SUBSET interior(i1) /\ interior(i2 INTER l2) SUBSET interior(i2) /\ interior(i1 INTER l1) SUBSET interior(l1) /\ interior(i2 INTER l2) SUBSET interior(l2) ==> interior(i1 INTER l1) INTER interior(i2 INTER l2) = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x1:real^M`; `l1:real^M->bool`; `x2:real^M`; `l2:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`i1:real^M->bool`; `i2:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN ASM_REWRITE_TAC[PAIR_EQ] THEN MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `i SUBSET s ==> (i INTER k) SUBSET s`) THEN ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC] THEN REWRITE_TAC[MESON[] `p /\ q /\ r /\ x = t /\ P x <=> x = t /\ p /\ q /\ r /\ P t`] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c d. P a b c d) <=> (?d b c a. P a b c d)`] THEN REWRITE_TAC[IN_INTER; UNWIND_THM2] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^M->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o last o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^M` THEN ASM_REWRITE_TAC[INTER; IN_ELIM_THM] THEN UNDISCH_TAC `(\x:real^M. ball (x,k x)) fine p` THEN REWRITE_TAC[fine; SUBSET] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `p':(real^M#(real^M->bool))->bool`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN REWRITE_TAC[LAMBDA_PAIR] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN ASM_SIMP_TAC[DROP_VSUM; o_DEF; SUM_SUB; DROP_SUB; ABS_DROP] THEN REWRITE_TAC[LAMBDA_PAIR_THM; DROP_CMUL; NORM_MUL; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `!sni. i - e / &2 < sni /\ sni' <= i /\ sni <= sni' /\ sf' = sf ==> abs(sf' - sni') < e / &2 ==> abs(sf - i) < e`) THEN EXISTS_TAC `sum d (\k. norm (integral k (f:real^M->real^N)))` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`\k. norm(integral k (f:real^M->real^N))`; `p':(real^M#(real^M->bool))->bool`; `interval[a:real^M,b]`] SUM_OVER_TAGGED_DIVISION_LEMMA) THEN ASM_SIMP_TAC[INTEGRAL_NULL; NORM_0] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIVISION_OF_TAGGED_DIVISION]; ALL_TAC] THEN SUBGOAL_THEN `p' = {x:real^M,(i INTER l:real^M->bool) | (x,l) IN p /\ i IN d /\ ~(i INTER l = {})}` (LABEL_TAC "p'") THENL [EXPAND_TAC "p'" THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN REWRITE_TAC[PAIR_EQ; GSYM CONJ_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:real^M->bool` THEN REWRITE_TAC[] THEN CONV_TAC(RAND_CONV UNWIND_CONV) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `l:real^M->bool` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `k:real^M->bool = i INTER l` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_INTER; GSYM MEMBER_NOT_EMPTY] THEN EQ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `y:real^M` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `i:real^M->bool`]) THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^M` THEN ASM_REWRITE_TAC[INTER; IN_ELIM_THM] THEN UNDISCH_TAC `(\x:real^M. ball (x,k x)) fine p` THEN REWRITE_TAC[fine; SUBSET] THEN ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`\y. norm(integral y (f:real^M->real^N))`; `p':(real^M#(real^M->bool))->bool`; `interval[a:real^M,b]`] SUM_OVER_TAGGED_DIVISION_LEMMA) THEN ASM_SIMP_TAC[INTEGRAL_NULL; NORM_0] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {i INTER l | i IN d /\ (l IN IMAGE SND (p:(real^M#(real^M->bool))->bool))} (\k. norm(integral k (f:real^M->real^N)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; PAIR_EQ; EXISTS_PAIR_THM] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`kk:real^M->bool`; `i:real^M->bool`; `l:real^M->bool`] THEN ASM_CASES_TAC `kk:real^M->bool = i INTER l` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; UNWIND_THM1] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x:real^M`)) MP_TAC) THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `x:real^M`; `i:real^M->bool`; `l:real^M->bool`]) THEN ASM_SIMP_TAC[INTEGRAL_EMPTY; NORM_0]] THEN SUBGOAL_THEN `{k INTER l | k IN d /\ l IN IMAGE SND (p:(real^M#(real^M->bool))->bool)} = IMAGE (\(k,l). k INTER l) {k,l | k IN d /\ l IN IMAGE SND p}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ] THEN CONV_TAC(REDEPTH_CONV UNWIND_CONV) THEN MESON_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o rand o snd) THEN ANTS_TAC THENL [ASSUME_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION (ASSUME `p tagged_division_of interval[a:real^M,b]`)) THEN ASM_SIMP_TAC[FINITE_PRODUCT; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`l1:real^M->bool`; `k1:real^M->bool`; `l2:real^M->bool`; `k2:real^M->bool`] THEN REWRITE_TAC[PAIR_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `interior(l2 INTER k2:real^M->bool) = {}` MP_TAC THENL [ALL_TAC; MP_TAC(ASSUME `d division_of interval[a:real^M,b]`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o SPEC `l2:real^M->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ASSUME `(IMAGE SND (p:(real^M#(real^M->bool))->bool)) division_of interval[a:real^M,b]`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL] THEN DISCH_TAC THEN REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC INTEGRAL_NULL THEN ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR]] THEN MATCH_MP_TAC(SET_RULE `(interior(k1) INTER interior(k2) = {} \/ interior(l1) INTER interior(l2) = {}) /\ interior(l1 INTER k1) SUBSET interior(k1) /\ interior(l2 INTER k2) SUBSET interior(k2) /\ interior(l1 INTER k1) SUBSET interior(l1) /\ interior(l2 INTER k2) SUBSET interior(l2) /\ interior(l1 INTER k1) = interior(l2 INTER k2) ==> interior(l2 INTER k2) = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN MP_TAC(ASSUME `d division_of interval[a:real^M,b]`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`l1:real^M->bool`; `l2:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ASSUME `(IMAGE SND (p:(real^M#(real^M->bool))->bool)) division_of interval[a:real^M,b]`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`k1:real^M->bool`; `k2:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [LAMBDA_PAIR_THM] THEN ASM_SIMP_TAC[GSYM SUM_SUM_PRODUCT; FINITE_IMAGE] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum { k INTER l | l IN IMAGE SND (p:(real^M#(real^M->bool))->bool)} (\k. norm(integral k (f:real^M->real^N)))` THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[o_DEF; REAL_LE_REFL]] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `interior(k INTER k2:real^M->bool) = {}` MP_TAC THENL [ALL_TAC; MP_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION (ASSUME `p tagged_division_of interval[a:real^M,b]`)) THEN MP_TAC(ASSUME `d division_of interval[a:real^M,b]`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o SPEC `k:real^M->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[INTER_INTERVAL; GSYM CONTENT_EQ_0_INTERIOR] THEN STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL] THEN SIMP_TAC[GSYM CONTENT_EQ_0_INTERIOR; INTEGRAL_NULL; NORM_0]] THEN MATCH_MP_TAC(SET_RULE `interior(k INTER k2) SUBSET interior(k1 INTER k2) /\ interior(k1 INTER k2) = {} ==> interior(k INTER k2) = {}`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION (ASSUME `p tagged_division_of interval[a:real^M,b]`)) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN REWRITE_TAC[INTERIOR_INTER] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN ABBREV_TAC `d' = {interval[u,v] INTER l |l| l IN IMAGE SND (p:(real^M#(real^M->bool))->bool) /\ ~(interval[u,v] INTER l = {})}` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d' (\k. norm (integral k (f:real^M->real^N)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN EXPAND_TAC "d'" THEN REWRITE_TAC[SUBSET; SET_RULE `a IN {f x |x| x IN s /\ ~(f x = b)} <=> a IN {f x | x IN s} /\ ~(a = b)`] THEN SIMP_TAC[IMP_CONJ; INTEGRAL_EMPTY; NORM_0]] THEN SUBGOAL_THEN `d' division_of interval[u:real^M,v]` ASSUME_TAC THENL [EXPAND_TAC "d'" THEN MATCH_MP_TAC DIVISION_INTER_1 THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum d' (\i. integral i (f:real^M->real^N)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL]; ALL_TAC] THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[division_of]; ALL_TAC] THEN REMOVE_THEN "p'" SUBST_ALL_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {x,i INTER l | (x,l) IN p /\ i IN d} (\(x,k:real^M->bool). abs(content k) * norm((f:real^M->real^N) x))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `i:real^M->bool`] THEN ASM_CASES_TAC `i:real^M->bool = {}` THEN ASM_SIMP_TAC[CONTENT_EMPTY; REAL_ABS_NUM; REAL_MUL_LZERO] THEN MATCH_MP_TAC(TAUT `(a <=> b) ==> a /\ ~b ==> c`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `{x,i INTER l | x,l IN (p:(real^M#(real^M->bool))->bool) /\ i IN d} = IMAGE (\((x,l),k). x,k INTER l) {m,k | m IN p /\ k IN d}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ] THEN CONV_TAC(REDEPTH_CONV UNWIND_CONV) THEN MESON_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_PRODUCT] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x1:real^M`; `l1:real^M->bool`; `k1:real^M->bool`; `x2:real^M`; `l2:real^M->bool`; `k2:real^M->bool`] THEN REWRITE_TAC[PAIR_EQ] THEN ASM_CASES_TAC `x1:real^M = x2` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN REWRITE_TAC[REAL_ABS_ZERO] THEN SUBGOAL_THEN `interior(k2 INTER l2:real^M->bool) = {}` MP_TAC THENL [ALL_TAC; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ASSUME `p tagged_division_of interval[a:real^M,b]`) THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN DISCH_THEN(MP_TAC o el 1 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`x2:real^M`; `l2:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL; CONTENT_EQ_0_INTERIOR]] THEN MATCH_MP_TAC(SET_RULE `(interior(k1) INTER interior(k2) = {} \/ interior(l1) INTER interior(l2) = {}) /\ interior(k1 INTER l1) SUBSET interior(k1) /\ interior(k2 INTER l2) SUBSET interior(k2) /\ interior(k1 INTER l1) SUBSET interior(l1) /\ interior(k2 INTER l2) SUBSET interior(l2) /\ interior(k1 INTER l1) = interior(k2 INTER l2) ==> interior(k2 INTER l2) = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`k1:real^M->bool`; `k2:real^M->bool`]) THEN MP_TAC(ASSUME `p tagged_division_of interval[a:real^M,b]`) THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`x2:real^M`; `l1:real^M->bool`; `x2:real^M`; `l2:real^M->bool`]) THEN ASM_REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [LAMBDA_PAIR_THM] THEN ASM_SIMP_TAC[GSYM SUM_SUM_PRODUCT] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN REWRITE_TAC[o_THM; SUM_RMUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum d (\k. content(k INTER interval[u:real^M,v]))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[real_abs] THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?w z:real^M. k = interval[w,z]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[INTER_INTERVAL; CONTENT_POS_LE]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {k INTER interval[u:real^M,v] | k IN d} content` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `interior(k2 INTER interval[u:real^M,v]) = {}` MP_TAC THENL [ALL_TAC; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[INTER_INTERVAL; CONTENT_EQ_0_INTERIOR]] THEN MATCH_MP_TAC(SET_RULE `interior(k2 INTER i) SUBSET interior(k1 INTER k2) /\ interior(k1 INTER k2) = {} ==> interior(k2 INTER i) = {}`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN REWRITE_TAC[INTERIOR_INTER] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {k INTER interval[u:real^M,v] |k| k IN d /\ ~(k INTER interval[u,v] = {})} content` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[SUBSET; SET_RULE `a IN {f x |x| x IN s /\ ~(f x = b)} <=> a IN {f x | x IN s} /\ ~(a = b)`] THEN SIMP_TAC[IMP_CONJ; CONTENT_EMPTY]; ALL_TAC] THEN MATCH_MP_TAC ADDITIVE_CONTENT_DIVISION THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC DIVISION_INTER_1 THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_REWRITE_TAC[]);; let BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE = prove (`!f:real^M->real^N. f integrable_on UNIV /\ (\k. integral k f) has_bounded_setvariation_on (:real^M) ==> f absolutely_integrable_on UNIV`, REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[absolutely_integrable_on] THEN MP_TAC(ISPEC `IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) {d | d division_of (UNIONS d) }` SUP) THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ABBREV_TAC `i = sup (IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) {d | d division_of (UNIONS d) })` THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN EXISTS_TAC `{}:(real^M->bool)->bool` THEN REWRITE_TAC[UNIONS_0; DIVISION_OF_TRIVIAL]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift i` THEN REWRITE_TAC[HAS_INTEGRAL_ALT; IN_UNIV] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`] (REWRITE_RULE[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL)) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_integrable_on]] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN EXISTS_TAC `B:real` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i - e`) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i <= i - e)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `bounded(UNIONS d:real^M->bool)` MP_TAC THENL [ASM_MESON_TAC[ELEMENTARY_BOUNDED]; ALL_TAC] THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `K:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `K + &1` THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_01] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN REWRITE_TAC[ABS_DROP; DROP_SUB; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `!s1. i - e < s1 /\ s1 <= s /\ s < i + e ==> abs(s - i) < e`) THEN EXISTS_TAC `sum (d:(real^M->bool)->bool) (\k. norm (integral k (f:real^M->real^N)))` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (\k. drop(integral k (\x. lift(norm((f:real^M->real^N) x)))))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN ASM_REWRITE_TAC[absolutely_integrable_on] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral (UNIONS d) (\x. lift(norm((f:real^M->real^N) x))))` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[REAL_LE_REFL; LIFT_DROP] `lift x = y ==> x <= drop y`) THEN ASM_SIMP_TAC[LIFT_SUM; o_DEF; LIFT_DROP] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_BOTTOMUP THEN FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]); ALL_TAC] THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(vec 0:real^M,K + &1)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_SIMP_TAC[NORM_ARITH `norm(x) <= K ==> dist(vec 0,x) < K + &1`]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN EXISTS_TAC `interval[a:real^M,b]` THEN EXISTS_TAC `d:(real^M->bool)->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRAL; has_integral] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`] HENSTOCK_LEMMA) THEN ANTS_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "+")) THEN SUBGOAL_THEN `?p. p tagged_division_of interval[a:real^M,b] /\ d1 fine p /\ d2 fine p` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM FINE_INTER] THEN MATCH_MP_TAC FINE_DIVISION_EXISTS THEN ASM_SIMP_TAC[GAUGE_INTER]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `p:(real^M#(real^M->bool)->bool)`) THEN REMOVE_THEN "+" (MP_TAC o SPEC `p:(real^M#(real^M->bool)->bool)`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN REWRITE_TAC[ABS_DROP; DROP_SUB] THEN REWRITE_TAC[LAMBDA_PAIR] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[DROP_VSUM; o_DEF; SUM_SUB] THEN REWRITE_TAC[LAMBDA_PAIR_THM; DROP_CMUL; NORM_MUL; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `sf' = sf /\ si <= i ==> abs(sf - si) < e / &2 ==> abs(sf' - di) < e / &2 ==> di < i + e`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM; real_abs] THEN ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF]; ALL_TAC] THEN SUBGOAL_THEN `sum p (\(x:real^M,k). norm(integral k f)) = sum (IMAGE SND p) (\k. norm(integral k (f:real^M->real^N)))` SUBST1_TAC THENL [MATCH_MP_TAC SUM_OVER_TAGGED_DIVISION_LEMMA THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[INTEGRAL_NULL; NORM_0]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC PARTIAL_DIVISION_OF_TAGGED_DIVISION THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_MESON_TAC[tagged_division_of]);; let ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ = prove (`!f:real^M->real^N. f absolutely_integrable_on (:real^M) <=> f integrable_on (:real^M) /\ (\k. integral k f) has_bounded_setvariation_on (:real^M)`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);; let ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ = prove (`!f:real^M->real^N a b. f absolutely_integrable_on interval[a,b] <=> f integrable_on interval[a,b] /\ (\k. integral k f) has_bounded_setvariation_on interval[a,b]`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);; let ABSOLUTELY_INTEGRABLE_SET_VARIATION = prove (`!f:real^M->real^N a b. f absolutely_integrable_on interval[a,b] ==> set_variation (interval[a,b]) (\k. integral k f) = drop(integral (interval[a,b]) (\x. lift(norm(f x))))`, REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN CONJ_TAC THENL [X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_THEN(X_CHOOSE_THEN `s:real^M->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral s (\x. lift(norm((f:real^M->real^N) x))))` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`\x. lift(norm((f:real^M->real^N) x))`; `d:(real^M->bool)->bool`; `s:real^M->bool`] INTEGRAL_COMBINE_DIVISION_TOPDOWN) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[DROP_VSUM] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM absolutely_integrable_on] THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL; SUBSET_TRANS]; MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_MESON_TAC[]]; X_GEN_TAC `B:real` THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN ABBREV_TAC `e = drop(integral (interval [a,b]) (\x. lift(norm((f:real^M->real^N) x)))) - B` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN DISCH_THEN(MP_TAC o SPEC `e / &2` o MATCH_MP HENSTOCK_LEMMA) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "F"))) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRAL; has_integral] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A"))) THEN MP_TAC(ISPECL [`\x. (d1:real^M->real^M->bool) x INTER d2 x`; `a:real^M`; `b:real^M`] FINE_DIVISION_EXISTS) THEN ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^M#(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN REMOVE_THEN "A" (MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN REMOVE_THEN "F" (MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. lift(norm((f:real^M->real^N) x))`; `a:real^M`; `b:real^M`; `p:real^M#(real^M->bool)->bool`] INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST_ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN DISCH_TAC THEN SUBGOAL_THEN `abs(sum p (\(x,k). content k * norm((f:real^M->real^N) x)) - sum p (\(x,k:real^M->bool). norm(integral k f))) < e / &2` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN ASM_SIMP_TAC[GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_ABS_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `x = norm u ==> abs(x - norm v) <= norm(u - v:real^N)`) THEN REWRITE_TAC[NORM_MUL; real_abs] THEN ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM NORM_LIFT] THEN ASM_SIMP_TAC[LIFT_SUB; LIFT_SUM] THEN REWRITE_TAC[LAMBDA_PAIR_THM; o_DEF; LIFT_CMUL; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(x - y:real^N) < e / &2 /\ norm(x - z) < e / &2 ==> norm(y - z) < e`)) THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN DISCH_THEN(MP_TAC o SPEC `B:real` o MATCH_MP (REAL_ARITH `!B. abs(x - y) < e ==> y - B = e ==> &0 < x - B`)) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DROP_VSUM; REAL_SUB_LT] THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM; LIFT_DROP] THEN DISCH_TAC THEN EXISTS_TAC `IMAGE SND (p:real^M#(real^M->bool)->bool)` THEN CONJ_TAC THENL [EXISTS_TAC `interval[a:real^M,b]` THEN ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION; SUBSET_REFL]; FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (rand o rand) th o rand o snd)) THEN SIMP_TAC[INTEGRAL_NULL; NORM_0] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]]]);; let ABSOLUTELY_INTEGRABLE_CONST = prove (`!a b c. (\x. c) absolutely_integrable_on interval[a,b]`, REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_CONST]);; let ABSOLUTELY_INTEGRABLE_ADD = prove (`!f:real^M->real^N g s. f absolutely_integrable_on s /\ g absolutely_integrable_on s ==> (\x. f(x) + g(x)) absolutely_integrable_on s`, SUBGOAL_THEN `!f:real^M->real^N g. f absolutely_integrable_on (:real^M) /\ g absolutely_integrable_on (:real^M) ==> (\x. f(x) + g(x)) absolutely_integrable_on (:real^M)` ASSUME_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LID]] THEN REPEAT STRIP_TAC THEN EVERY_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN ASM_SIMP_TAC[INTEGRABLE_ADD] THEN MP_TAC(ISPECL [`g:real^M->real^N`; `(:real^M)`] ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN DISCH_THEN(X_CHOOSE_TAC `B1:real`) THEN DISCH_THEN(X_CHOOSE_TAC `B2:real`) THEN EXISTS_TAC `B1 + B2:real` THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^M->bool)->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= B1 ==> x <= a + B2 ==> x <= B1 + B2`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `b <= B2 ==> x <= a + b ==> x <= a + B2`)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `x = y + z ==> norm(x) <= norm(y) + norm(z)`) THEN MATCH_MP_TAC INTEGRAL_ADD THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; let ABSOLUTELY_INTEGRABLE_SUB = prove (`!f:real^M->real^N g s. f absolutely_integrable_on s /\ g absolutely_integrable_on s ==> (\x. f(x) - g(x)) absolutely_integrable_on s`, REWRITE_TAC[VECTOR_SUB] THEN SIMP_TAC[ABSOLUTELY_INTEGRABLE_ADD; ABSOLUTELY_INTEGRABLE_NEG]);; let ABSOLUTELY_INTEGRABLE_LINEAR = prove (`!f:real^M->real^N h:real^N->real^P s. f absolutely_integrable_on s /\ linear h ==> (h o f) absolutely_integrable_on s`, SUBGOAL_THEN `!f:real^M->real^N h:real^N->real^P. f absolutely_integrable_on (:real^M) /\ linear h ==> (h o f) absolutely_integrable_on (:real^M)` ASSUME_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> ANTE_RES_THEN MP_TAC th THEN ASSUME_TAC(MATCH_MP LINEAR_0 (CONJUNCT2 th))) THEN ASM_REWRITE_TAC[o_DEF; COND_RAND]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN ASM_SIMP_TAC[INTEGRABLE_LINEAR; HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN EXISTS_TAC `B * b:real` THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B * sum d (\k. norm(integral k (f:real^M->real^N)))` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(h(integral (interval[a,b]) (f:real^M->real^N)):real^P)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_LINEAR THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; let ABSOLUTELY_INTEGRABLE_VSUM = prove (`!f:A->real^M->real^N s t. FINITE t /\ (!a. a IN t ==> (f a) absolutely_integrable_on s) ==> (\x. vsum t (\a. f a x)) absolutely_integrable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; ABSOLUTELY_INTEGRABLE_0; IN_INSERT; ABSOLUTELY_INTEGRABLE_ADD; ETA_AX]);; let ABSOLUTELY_INTEGRABLE_ABS = prove (`!f:real^M->real^N s. f absolutely_integrable_on s ==> (\x. (lambda i. abs(f(x)$i)):real^N) absolutely_integrable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. (lambda i. abs(f(x)$i))):real^M->real^N = (\x. vsum (1..dimindex(:N)) (\i. (((\y. (lambda j. if j = i then drop y else &0)) o (\x. lift(norm((lambda j. if j = i then x$i else &0):real^N))) o (f:real^M->real^N)) x)))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN GEN_REWRITE_TAC I [CART_EQ] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; VSUM_COMPONENT; o_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; LIFT_DROP] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[vector_norm; dot] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sqrt(sum (1..dimindex(:N)) (\k. if k = i then ((f:real^M->real^N) x)$i pow 2 else &0))` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG; POW_2_SQRT_ABS]; ALL_TAC] THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_POW_2]; ALL_TAC] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_VSUM THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LINEAR THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_ADD; REAL_ADD_LID; DROP_CMUL; REAL_MUL_RZERO]] THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN SUBGOAL_THEN `(\x. lambda j. if j = i then (f x:real^N)$i else &0):real^M->real^N = (\x. lambda j. if j = i then x$i else &0) o f` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LINEAR THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]);; let ABSOLUTELY_INTEGRABLE_MAX = prove (`!f:real^M->real^N g:real^M->real^N s. f absolutely_integrable_on s /\ g absolutely_integrable_on s ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) absolutely_integrable_on s`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ABS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP ABSOLUTELY_INTEGRABLE_CMUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC);; let ABSOLUTELY_INTEGRABLE_MAX_1 = prove (`!f:real^M->real g:real^M->real s. (\x. lift(f x)) absolutely_integrable_on s /\ (\x. lift(g x)) absolutely_integrable_on s ==> (\x. lift(max (f x) (g x))) absolutely_integrable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. (lambda i. max (lift(f x)$i) (lift(g x)$i)):real^1) absolutely_integrable_on (s:real^M->bool)` MP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_MAX]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; lift]);; let ABSOLUTELY_INTEGRABLE_MIN = prove (`!f:real^M->real^N g:real^M->real^N s. f absolutely_integrable_on s /\ g absolutely_integrable_on s ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) absolutely_integrable_on s`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ABS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP ABSOLUTELY_INTEGRABLE_CMUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC);; let ABSOLUTELY_INTEGRABLE_MIN_1 = prove (`!f:real^M->real g:real^M->real s. (\x. lift(f x)) absolutely_integrable_on s /\ (\x. lift(g x)) absolutely_integrable_on s ==> (\x. lift(min (f x) (g x))) absolutely_integrable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. (lambda i. min (lift(f x)$i) (lift(g x)$i)):real^1) absolutely_integrable_on (s:real^M->bool)` MP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_MIN]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; lift]);; let ABSOLUTELY_INTEGRABLE_ABS_EQ = prove (`!f:real^M->real^N s. f absolutely_integrable_on s <=> f integrable_on s /\ (\x. (lambda i. abs(f(x)$i)):real^N) integrable_on s`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[ABSOLUTELY_INTEGRABLE_ABS; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN SUBGOAL_THEN `!f:real^M->real^N. f integrable_on (:real^M) /\ (\x. (lambda i. abs(f(x)$i)):real^N) integrable_on (:real^M) ==> f absolutely_integrable_on (:real^M)` ASSUME_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; GSYM INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[CART_EQ] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; COND_COMPONENT; VEC_COMPONENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ABS_0]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN EXISTS_TAC `sum (1..dimindex(:N)) (\i. integral (:real^M) (\x. (lambda j. abs ((f:real^M->real^N) x$j)):real^N)$i)` THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (\k. sum (1..dimindex(:N)) (\i. integral k (\x. (lambda j. abs ((f:real^M->real^N) x$j)):real^N)$i))` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (1..dimindex(:N)) (\i. abs((integral (interval[a,b]) (f:real^M->real^N))$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ --x <= y ==> abs(x) <= y`) THEN ASM_SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN SUBGOAL_THEN `(f:real^M->real^N) integrable_on interval[a,b] /\ (\x. (lambda i. abs (f x$i)):real^N) integrable_on interval[a,b]` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM INTEGRAL_NEG] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_COMPONENT_LE THEN ASM_SIMP_TAC[INTEGRABLE_NEG; LAMBDA_BETA] THEN ASM_SIMP_TAC[VECTOR_NEG_COMPONENT] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(integral (UNIONS d) (\x. (lambda j. abs ((f:real^M->real^N) x$j)):real^N))$k` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM VSUM_COMPONENT] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC INTEGRAL_SUBSET_COMPONENT_LE THEN ASM_SIMP_TAC[LAMBDA_BETA; SUBSET_UNIV; REAL_ABS_POS]] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN MAP_EVERY EXISTS_TAC [`(:real^M)`; `d:(real^M->bool)->bool`] THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; let NONNEGATIVE_ABSOLUTELY_INTEGRABLE = prove (`!f:real^M->real^N s. (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> &0 <= f(x)$i) /\ f integrable_on s ==> f absolutely_integrable_on s`, SIMP_TAC[ABSOLUTELY_INTEGRABLE_ABS_EQ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_EQ THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; real_abs]);; let ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND = prove (`!f:real^M->real^N g s. (!x. x IN s ==> norm(f x) <= drop(g x)) /\ f integrable_on s /\ g integrable_on s ==> f absolutely_integrable_on s`, SUBGOAL_THEN `!f:real^M->real^N g. (!x. norm(f x) <= drop(g x)) /\ f integrable_on (:real^M) /\ g integrable_on (:real^M) ==> f absolutely_integrable_on (:real^M)` ASSUME_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV; GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL; NORM_0; DROP_VEC]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN EXISTS_TAC `drop(integral(:real^M) g)` THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d (\k. drop(integral k (g:real^M->real^1)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral (UNIONS d:real^M->bool) g)` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x = y ==> y <= x`) THEN ASM_SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_SUM; o_DEF] THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_BOTTOMUP THEN FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[NORM_ARITH `norm(x) <= y ==> &0 <= y`]] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN MAP_EVERY EXISTS_TAC [`(:real^M)`; `d:(real^M->bool)->bool`] THEN ASM_REWRITE_TAC[SUBSET_UNIV]]);; let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND = prove (`!f:real^M->real^N g:real^M->real^P s. (!x. x IN s ==> norm(f x) <= norm(g x)) /\ f integrable_on s /\ g absolutely_integrable_on s ==> f absolutely_integrable_on s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(\x. lift(norm((g:real^M->real^P) x)))`; `s:real^M->bool`] ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND) THEN ASM_REWRITE_TAC[LIFT_DROP]);; let ABSOLUTELY_INTEGRABLE_INF_1 = prove (`!fs s:real^N->bool k:A->bool. FINITE k /\ ~(k = {}) /\ (!i. i IN k ==> (\x. lift(fs x i)) absolutely_integrable_on s) ==> (\x. lift(inf (IMAGE (fs x) k))) absolutely_integrable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN_1 THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT]);; let ABSOLUTELY_INTEGRABLE_SUP_1 = prove (`!fs s:real^N->bool k:A->bool. FINITE k /\ ~(k = {}) /\ (!i. i IN k ==> (\x. lift(fs x i)) absolutely_integrable_on s) ==> (\x. lift(sup (IMAGE (fs x) k))) absolutely_integrable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT]);; let ABSOLUTELY_INTEGRABLE_CONTINUOUS = prove (`!f:real^M->real^N a b. f continuous_on interval[a,b] ==> f absolutely_integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN SUBGOAL_THEN `compact(IMAGE (f:real^M->real^N) (interval[a,b]))` MP_TAC THENL [ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; COMPACT_INTERVAL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^M. lift(B)` THEN ASM_SIMP_TAC[INTEGRABLE_CONST; LIFT_DROP; INTEGRABLE_CONTINUOUS]);; let INTEGRABLE_MIN_CONST_1 = prove (`!f s t. &0 <= t /\ (!x. x IN s ==> &0 <= f x) /\ (\x:real^N. lift(f x)) integrable_on s ==> (\x. lift(min (f x) t)) integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND THEN EXISTS_TAC `\x:real^N. lift(f x)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN MP_TAC(ISPECL [`\x:real^N. if x IN s then f x else &0`; `(\x. t):real^N->real`; `interval[a:real^N,b]`] ABSOLUTELY_INTEGRABLE_MIN_1) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [SIMP_TAC[ABSOLUTELY_INTEGRABLE_CONTINUOUS; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN REWRITE_TAC[COND_RAND; LIFT_DROP; LIFT_NUM] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; LIFT_DROP; GSYM drop]; DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]);; let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND = prove (`!f:real^M->real^N g:real^M->real^N s. (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> f(x)$i <= g(x)$i) /\ f integrable_on s /\ g absolutely_integrable_on s ==> f absolutely_integrable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. (g:real^M->real^N)(x) - (g(x) - f(x))) absolutely_integrable_on s` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[REAL_SUB_LE; VECTOR_SUB_COMPONENT] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; REWRITE_TAC[VECTOR_ARITH `x - (x - y):real^N = y`; ETA_AX]]);; let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND = prove (`!f:real^M->real^N g:real^M->real^N s. (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> f(x)$i <= g(x)$i) /\ f absolutely_integrable_on s /\ g integrable_on s ==> g absolutely_integrable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. (f:real^M->real^N)(x) + (g(x) - f(x))) absolutely_integrable_on s` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[REAL_SUB_LE; VECTOR_SUB_COMPONENT] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; REWRITE_TAC[VECTOR_ARITH `y + (x - y):real^N = x`; ETA_AX]]);; let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND = prove (`!f:real^M->real^1 g:real^M->real^1 s. (!x. x IN s ==> drop(f(x)) <= drop(g(x))) /\ f integrable_on s /\ g absolutely_integrable_on s ==> f absolutely_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN EXISTS_TAC `g:real^M->real^1` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND = prove (`!f:real^M->real^1 g:real^M->real^1 s. (!x. x IN s ==> drop(f(x)) <= drop(g(x))) /\ f absolutely_integrable_on s /\ g integrable_on s ==> g absolutely_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN EXISTS_TAC `f:real^M->real^1` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; let ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS = prove (`!f:real^N->real^1 s. (!x. x IN s ==> &0 <= drop(f x)) ==> (f absolutely_integrable_on s <=> f integrable_on s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND) THEN EXISTS_TAC `(\x. vec 0):real^N->real^1` THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_0; DROP_VEC]);; let ABSOLUTELY_INTEGRABLE_PASTECART_SYM = prove (`!f:real^(M,N)finite_sum->real^P s y. (\z. f(pastecart (sndcart z) (fstcart z))) absolutely_integrable_on (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) <=> f absolutely_integrable_on s`, REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_PASTECART_SYM]);; let [HAS_INTEGRAL_PASTECART_SYM_UNIV; INTEGRAL_PASTECART_SYM_UNIV; INTEGRABLE_PASTECART_SYM_UNIV; ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV] = (CONJUNCTS o prove) (`(!f:real^(M,N)finite_sum->real^P s y. ((\z. f(pastecart (sndcart z) (fstcart z))) has_integral y) UNIV <=> (f has_integral y) UNIV) /\ (!f:real^(M,N)finite_sum->real^P s y. integral UNIV (\z. f(pastecart (sndcart z) (fstcart z))) = integral UNIV f) /\ (!f:real^(M,N)finite_sum->real^P s y. (\z. f(pastecart (sndcart z) (fstcart z))) integrable_on UNIV <=> f integrable_on UNIV) /\ (!f:real^(M,N)finite_sum->real^P s y. (\z. f(pastecart (sndcart z) (fstcart z))) absolutely_integrable_on UNIV <=> f absolutely_integrable_on UNIV)`, REPEAT STRIP_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM HAS_INTEGRAL_PASTECART_SYM]; GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_PASTECART_SYM]; GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRABLE_PASTECART_SYM]; GEN_REWRITE_TAC RAND_CONV [GSYM ABSOLUTELY_INTEGRABLE_PASTECART_SYM]] THEN TRY AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[FORALL_PASTECART] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Relating vector integrals to integrals of components. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_COMPONENTWISE = prove (`!f:real^M->real^N s y. (f has_integral y) s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. lift((f x)$i)) has_integral (lift(y$i))) s`, REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o ISPEC `\u:real^N. lift(u$i)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LINEAR_LIFT_COMPONENT]; GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o BINDER_CONV) [GSYM BASIS_EXPANSION] THEN MATCH_MP_TAC HAS_INTEGRAL_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o ISPEC `\v. drop(v) % (basis i:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_VMUL_DROP; LINEAR_ID]]);; let INTEGRABLE_COMPONENTWISE = prove (`!f:real^M->real^N s. f integrable_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift((f x)$i)) integrable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [HAS_INTEGRAL_COMPONENTWISE] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM; GSYM EXISTS_LIFT]);; let LIFT_INTEGRAL_COMPONENT = prove (`!f:real^M->real^N. f integrable_on s ==> lift((integral s f)$k) = integral s (\x. lift((f x)$k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ !z:real^N. z$k = z$j` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_COMPONENTWISE] THEN ASM_SIMP_TAC[]);; let INTEGRAL_COMPONENT = prove (`!f:real^M->real^N. f integrable_on s ==> (integral s f)$k = drop(integral s (\x. lift((f x)$k)))`, SIMP_TAC[GSYM LIFT_INTEGRAL_COMPONENT; LIFT_DROP]);; let ABSOLUTELY_INTEGRABLE_COMPONENTWISE = prove (`!f:real^M->real^N s. f absolutely_integrable_on s <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift(f x$i)) absolutely_integrable_on s)`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN MATCH_MP_TAC(MESON[] `(p <=> !i. a i ==> P i) /\ (p /\ (!i. a i ==> P i) ==> (q <=> (!i. a i ==> Q i))) ==> (p /\ q <=> (!i. a i ==> P i /\ Q i))`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM INTEGRABLE_COMPONENTWISE]; ALL_TAC] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [SUBGOAL_THEN `(\x. lift((f:real^M->real^N) x$i)) absolutely_integrable_on s` MP_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_integrable_on]] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))` THEN ASM_SIMP_TAC[ABS_DROP; LIFT_DROP; COMPONENT_LE_NORM]; SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on s` MP_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_integrable_on]] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `\x. vsum (1..dimindex(:N)) (\i. lift(norm(lift((f:real^M->real^N)(x)$i))))` THEN ASM_SIMP_TAC[INTEGRABLE_VSUM; IN_NUMSEG; FINITE_NUMSEG] THEN SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; o_DEF; LIFT_DROP] THEN REWRITE_TAC[NORM_LIFT; NORM_LE_L1]]);; (* ------------------------------------------------------------------------- *) (* Dominated convergence. *) (* ------------------------------------------------------------------------- *) let DOMINATED_CONVERGENCE = prove (`!f:num->real^M->real^N g h s. (!k. (f k) integrable_on s) /\ h integrable_on s /\ (!k x. x IN s ==> norm(f k x) <= drop(h x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, SUBGOAL_THEN `!f:num->real^M->real^1 g h s. (!k. (f k) integrable_on s) /\ h integrable_on s /\ (!k x. x IN s ==> norm(f k x) <= drop(h x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially` ASSUME_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!j. 1 <= j /\ j <= dimindex(:N) ==> (\x. lift((g x)$j)) integrable_on s /\ ((\k. integral s (\x. lift (((f:num->real^M->real^N) k x)$j))) --> integral s (\x. lift ((g x:real^N)$j))) sequentially` STRIP_ASSUME_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [INTEGRABLE_COMPONENTWISE]) THEN ASM_SIMP_TAC[]; MAP_EVERY X_GEN_TAC [`i:num`; `x:real^M`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm((f:num->real^M->real^N) i x)` THEN ASM_SIMP_TAC[NORM_LIFT; COMPONENT_LE_NORM]; X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [LIM_COMPONENTWISE_LIFT] THEN ASM_SIMP_TAC[]]; MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [INTEGRABLE_COMPONENTWISE] THEN ASM_SIMP_TAC[]; DISCH_TAC THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT]]]] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(MATCH_MP MONO_FORALL (GEN `m:num` (ISPECL [`\k:num x:real^M. lift(inf {drop(f j x) | j IN m..(m+k)})`; `\x:real^M. lift(inf {drop(f j x) | m:num <= j})`; `s:real^M->bool`] MONOTONE_CONVERGENCE_DECREASING))) THEN REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL [X_GEN_TAC `m:num` THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN MATCH_MP_TAC LOWER_BOUND_FINITE_SET_REAL THEN REWRITE_TAC[FINITE_NUMSEG]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[dist; ABS_DROP; LIFT_DROP; DROP_SUB] THEN MP_TAC(SPEC `{drop((f:num->real^M->real^1) j x) | m <= j}` INF) THEN ABBREV_TAC `i = inf {drop((f:num->real^M->real^1) j x) | m <= j}` THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL [CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN EXISTS_TAC `--drop(h(x:real^M))` THEN X_GEN_TAC `j:num` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`j:num`; `x:real^M`]) THEN ASM_REWRITE_TAC[ABS_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `i + e:real`)) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i + e <= i)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y < i + e ==> i <= ix /\ ix <= y ==> abs(ix - i) < e`)) THEN CONJ_TAC THENL [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `i:real` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN ASM_ARITH_TAC; REWRITE_TAC[bounded] THEN EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN MATCH_MP_TAC REAL_ABS_INF_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD; GSYM ABS_DROP]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN MP_TAC(MATCH_MP MONO_FORALL (GEN `m:num` (ISPECL [`\k:num x:real^M. lift(sup {drop(f j x) | j IN m..(m+k)})`; `\x:real^M. lift(sup {drop(f j x) | m:num <= j})`; `s:real^M->bool`] MONOTONE_CONVERGENCE_INCREASING))) THEN REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL [X_GEN_TAC `m:num` THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUP_1 THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN MATCH_MP_TAC UPPER_BOUND_FINITE_SET_REAL THEN REWRITE_TAC[FINITE_NUMSEG]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[dist; ABS_DROP; LIFT_DROP; DROP_SUB] THEN MP_TAC(SPEC `{drop((f:num->real^M->real^1) j x) | m <= j}` SUP) THEN ABBREV_TAC `i = sup {drop((f:num->real^M->real^1) j x) | m <= j}` THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL [CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN EXISTS_TAC `drop(h(x:real^M))` THEN X_GEN_TAC `j:num` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`j:num`; `x:real^M`]) THEN ASM_REWRITE_TAC[ABS_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `i - e:real`)) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i <= i - e)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `i - e < y ==> ix <= i /\ y <= ix ==> abs(ix - i) < e`)) THEN CONJ_TAC THENL [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN W(MP_TAC o C SPEC SUP o rand o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `i:real` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN ASM_ARITH_TAC; REWRITE_TAC[bounded] THEN EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUP_1 THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN MATCH_MP_TAC REAL_ABS_SUP_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD; GSYM ABS_DROP]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN MP_TAC(ISPECL [`\k:num x:real^M. lift(inf {drop(f j x) | k <= j})`; `g:real^M->real^1`; `s:real^M->bool`] MONOTONE_CONVERGENCE_INCREASING) THEN ASM_REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_LE] THEN CONJ_TAC THENL [MESON_TAC[LT_REFL]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `--drop(h(x:real^M))` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> --a <= x`) THEN ASM_SIMP_TAC[GSYM ABS_DROP]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` th)) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INF_ASCLOSE THEN REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_TRANS; REAL_LT_IMP_LE]] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN MATCH_MP_TAC REAL_ABS_INF_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[GSYM ABS_DROP; IN_ELIM_THM] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN MESON_TAC[LE_REFL]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A"))] THEN MP_TAC(ISPECL [`\k:num x:real^M. lift(sup {drop(f j x) | k <= j})`; `g:real^M->real^1`; `s:real^M->bool`] MONOTONE_CONVERGENCE_DECREASING) THEN ASM_REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_LE] THEN CONJ_TAC THENL [MESON_TAC[LT_REFL]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `drop(h(x:real^M))` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN ASM_SIMP_TAC[GSYM ABS_DROP]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` th)) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_SUP_ASCLOSE THEN REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_TRANS; REAL_LT_IMP_LE]] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN MATCH_MP_TAC REAL_ABS_SUP_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[GSYM ABS_DROP; IN_ELIM_THM] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN MESON_TAC[LE_REFL]; DISCH_THEN(LABEL_TAC "B")] THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "A" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "N1")) THEN REMOVE_THEN "B" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "N2")) THEN EXISTS_TAC `N1 + N2:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REMOVE_THEN "N1" (MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N1 + N2 <= n ==> N1:num <= n`]; ALL_TAC] THEN REMOVE_THEN "N2" (MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N1 + N2 <= n ==> N2:num <= n`]; ALL_TAC] THEN REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `i0 <= i /\ i <= i1 ==> abs(i1 - g) < e ==> abs(i0 - g) < e ==> abs(i - g) < e`) THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THENL [W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN EXISTS_TAC `--drop(h(x:real^M))` THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> --a <= x`) THEN REWRITE_TAC[GSYM ABS_DROP] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[LE_REFL]]; W(MP_TAC o C SPEC SUP o rand o rand o snd) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN EXISTS_TAC `drop(h(x:real^M))` THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN REWRITE_TAC[GSYM ABS_DROP] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[LE_REFL]]]);; let DOMINATED_CONVERGENCE_INTEGRABLE = prove (`!f:num->real^M->real^N g h s. (!k. f k absolutely_integrable_on s) /\ h integrable_on s /\ (!k x. x IN s ==> norm(g x) <= drop(h x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) ==> g integrable_on s`, let lemma = prove (`!f:num->real^N->real^1 g h s. (!k. f k absolutely_integrable_on s) /\ h integrable_on s /\ (!x. x IN s ==> norm(g x) <= drop(h x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) ==> g integrable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(h:real^N->real^1) absolutely_integrable_on s` ASSUME_TAC THENL [MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[DIMINDEX_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; IMP_IMP] THEN ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`\n:num x:real^N. lift(min (max (--(drop(h x))) (drop(f n x))) (drop(h x)))`; `g:real^N->real^1`; `h:real^N->real^1`; `s:real^N->bool`] DOMINATED_CONVERGENCE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[]] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN_1 THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN ASM_SIMP_TAC[LIFT_NEG; LIFT_DROP; ETA_AX; ABSOLUTELY_INTEGRABLE_NEG]; MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP; ABS_DROP] THEN SUBGOAL_THEN `&0 <= drop((h:real^N->real^1) x)` MP_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]; REAL_ARITH_TAC]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN UNDISCH_TAC `!x. x IN s ==> ((\n. (f:num->real^N->real^1) n x) --> g x) sequentially` THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[tendsto] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN REAL_ARITH_TAC]) in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE; INTEGRABLE_COMPONENTWISE] THEN DISCH_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `\i x. lift(((f:num->real^M->real^N) i x)$k)` THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPONENT_LE_NORM; NORM_LIFT; REAL_LE_TRANS]; RULE_ASSUM_TAC(ONCE_REWRITE_RULE[LIM_COMPONENTWISE_LIFT]) THEN RULE_ASSUM_TAC BETA_RULE THEN ASM_SIMP_TAC[]]);; let DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE = prove (`!f:num->real^M->real^N g h s. (!k. f k absolutely_integrable_on s) /\ h integrable_on s /\ (!k x. x IN s ==> norm(g x) <= drop(h x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) ==> g absolutely_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN EXISTS_TAC `f:num->real^M->real^N` THEN EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]);; let DOMINATED_CONVERGENCE_AE = prove (`!f:num->real^M->real^N g h s t. (!k. (f k) integrable_on s) /\ h integrable_on s /\ negligible t /\ (!k x. x IN s DIFF t ==> norm(f k x) <= drop(h x)) /\ (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) ==> g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^M->real^N`; `g:real^M->real^N`; `h:real^M->real^1`; `s DIFF t:real^M->bool`] DOMINATED_CONVERGENCE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_SPIKE_SET; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN TRY ABS_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET]] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);; let INTEGRAL_COUNTABLE_UNIONS = prove (`!f:real^M->real^N s. (!n. f integrable_on (s n)) /\ pairwise (\i j. negligible (s i INTER s j)) (:num) /\ f absolutely_integrable_on (UNIONS {s n | n IN (:num)}) ==> ((\n. vsum(0..n) (\i. integral (s i) f)) --> integral (UNIONS {s n | n IN (:num)}) f) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(GEN `n:num` (ISPECL [`f:real^M->real^N`; `s:num->real^M->bool`; `\k:num. integral (s k) (f:real^M->real^N)`; `0..n`] HAS_INTEGRAL_UNIONS_IMAGE)) THEN ASM_REWRITE_TAC[FINITE_NUMSEG; GSYM HAS_INTEGRAL_INTEGRAL] THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL [ASM_MESON_TAC[PAIRWISE_MONO; SUBSET_UNIV]; ALL_TAC] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; FORALL_AND_THM] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `!p. p /\ q ==> q`) THEN EXISTS_TAC `(f:real^M->real^N) integrable_on UNIONS {s n | n IN (:num)}` THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV; GSYM INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC DOMINATED_CONVERGENCE THEN EXISTS_TAC `\x. if x IN UNIONS {s n | n IN (:num)} then lift(norm((f:real^M->real^N) x)) else vec 0` THEN ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN REWRITE_TAC[IN_UNIV] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN REWRITE_TAC[UNIONS_GSPEC; UNIONS_IMAGE; IN_ELIM_THM] THEN ASM_CASES_TAC `!n. ~(x IN (s:num->real^M->bool) n)` THEN ASM_REWRITE_TAC[NORM_0; DROP_VEC; REAL_LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_FORALL_THM]) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; NORM_0; NORM_POS_LE]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[UNIONS_GSPEC; UNIONS_IMAGE; IN_ELIM_THM] THEN ASM_CASES_TAC `!n. ~(x IN (s:num->real^M->bool) n)` THEN ASM_REWRITE_TAC[LIM_CONST] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DIST_REFL]) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A few more properties of negligible sets. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_ON_UNIV = prove (`!s. negligible s <=> (indicator s has_integral vec 0) (:real^N)`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[NEGLIGIBLE]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[negligible] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN SUBGOAL_THEN `indicator s integrable_on interval[a:real^N,b]` ASSUME_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^N)` THEN ASM_MESON_TAC[SUBSET_UNIV; integrable_on]; ASM_SIMP_TAC[GSYM INTEGRAL_EQ_HAS_INTEGRAL] THEN REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP INTEGRAL_UNIQUE) THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE; REWRITE_TAC[DROP_VEC] THEN MATCH_MP_TAC INTEGRAL_DROP_POS] THEN ASM_REWRITE_TAC[SUBSET_UNIV; DROP_INDICATOR_POS_LE] THEN ASM_MESON_TAC[integrable_on]]);; let NEGLIGIBLE_COUNTABLE_UNIONS = prove (`!s:num->real^N->bool. (!n. negligible(s n)) ==> negligible(UNIONS {s(n) | n IN (:num)})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n. indicator(UNIONS {(s:num->real^N->bool)(m) | m <= n})`; `indicator(UNIONS {(s:num->real^N->bool)(m) | m IN (:num)})`; `(:real^N)`] MONOTONE_CONVERGENCE_INCREASING) THEN SUBGOAL_THEN `!n. negligible(UNIONS {(s:num->real^N->bool)(m) | m <= n})` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE; FORALL_IN_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `!n:num. (indicator (UNIONS {s m | m <= n})) integrable_on (:real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_ON_UNIV; integrable_on]; ALL_TAC] THEN SUBGOAL_THEN `!n:num. integral (:real^N) (indicator (UNIONS {s m | m <= n})) = vec 0` ASSUME_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_ON_UNIV; INTEGRAL_UNIQUE]; ALL_TAC] THEN ASM_SIMP_TAC[NEGLIGIBLE_ON_UNIV; LIM_CONST_EQ; TRIVIAL_LIMIT_SEQUENTIALLY] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[INTEGRAL_EQ_HAS_INTEGRAL]] THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`k:num`; `x:real^N`] THEN DISCH_TAC THEN REWRITE_TAC[indicator] THEN SUBGOAL_THEN `x IN UNIONS {(s:num->real^N->bool) m | m <= k} ==> x IN UNIONS {s m | m <= SUC k}` MP_TAC THENL [SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[DROP_VEC; REAL_LE_REFL; REAL_POS]]; X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; indicator] THEN ASM_CASES_TAC `x IN UNIONS {(s:num->real^N->bool) m | m IN (:num)}` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_GSPEC]) THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN ASM_MESON_TAC[]; EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [UNIONS_GSPEC]) THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]; REWRITE_TAC[SET_RULE `{c | x | x IN UNIV} = {c}`; BOUNDED_INSERT; BOUNDED_EMPTY]]);; let HAS_INTEGRAL_NEGLIGIBLE_EQ = prove (`!f:real^M->real^N s. (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> &0 <= f(x)$i) ==> ((f has_integral vec 0) s <=> negligible {x | x IN s /\ ~(f x = vec 0)})`, let lemma = prove (`!f:real^N->real^1 s. (!x. x IN s ==> &0 <= drop(f x)) /\ (f has_integral vec 0) s ==> negligible {x | x IN s /\ ~(f x = vec 0)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN s /\ norm((f:real^N->real^1) x) >= &1 / (&n + &1)} | n IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[NEGLIGIBLE_ON_UNIV; indicator] THEN MATCH_MP_TAC HAS_INTEGRAL_STRADDLE_NULL THEN EXISTS_TAC `(\x. if x IN s then (&n + &1) % f(x) else vec 0): real^N->real^1` THEN CONJ_TAC THENL [REWRITE_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN X_GEN_TAC `x:real^N` THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DROP_VEC; DROP_CMUL; REAL_POS] THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a <= abs x ==> a <= x`) THEN ASM_SIMP_TAC[GSYM ABS_DROP]; COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; REAL_POS; DROP_CMUL] THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_MUL; REAL_LE_ADD]]; REWRITE_TAC[HAS_INTEGRAL_RESTRICT_UNIV] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = (&n + &1) % vec 0`) THEN MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[GSYM NORM_POS_LT] THEN ONCE_REWRITE_TAC[REAL_ARCH_INV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC)) THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LT_IMP_LE]]) in REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `{x | x IN s /\ ~((f:real^M->real^N) x = vec 0)}` THEN ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN MESON_TAC[]] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN s /\ ~(((f:real^M->real^N) x)$k = &0)} | k IN 1..dimindex(:N)}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN MATCH_MP_TAC lemma THEN ASM_SIMP_TAC[LIFT_DROP] THEN FIRST_X_ASSUM(MP_TAC o ISPEC `\y:real^N. lift(y$k)` o MATCH_MP(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN REWRITE_TAC[o_DEF; VEC_COMPONENT; LIFT_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[linear] THEN SIMP_TAC[LIFT_ADD; VECTOR_ADD_COMPONENT; LIFT_CMUL; VECTOR_MUL_COMPONENT]; REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC; CART_EQ; IN_NUMSEG] THEN REWRITE_TAC[VEC_COMPONENT; IN_ELIM_THM] THEN MESON_TAC[]]);; let INTEGRAL_ZERO_ON_SUBINTERVALS_IMP_ZERO_AE = prove (`!f:real^M->real^N a b. (!x. x IN interval[a,b] ==> (f has_integral vec 0) (interval[a,x])) ==> negligible {x | x IN interval[a,b] /\ ~(f x = vec 0)}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^M,b] = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; NEGLIGIBLE_EMPTY] THEN REWRITE_TAC[GSYM NORM_EQ_0; NORM_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN W(MP_TAC o PART_MATCH (rand o rand) HAS_INTEGRAL_NEGLIGIBLE_EQ o snd) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; DIMINDEX_1] THEN REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP; NORM_POS_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SUBGOAL_THEN `(f:real^M->real^N) integrable_on interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; integrable_on]; ALL_TAC] THEN SUBGOAL_THEN `!u v. u IN interval[a,b] /\ v IN interval[a,b] ==> ((f:real^M->real^N) has_integral (vec 0)) (interval[u,v])` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[u:real^M,v] = {}` THEN ASM_REWRITE_TAC[HAS_INTEGRAL_EMPTY] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL; INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `v:real^M`; `u:real^M`] INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT) THEN ANTS_TAC THENL [CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_INTERVAL]; REWRITE_TAC[IN_INTERVAL]] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL; INTERVAL_NE_EMPTY]) THEN ASM_MESON_TAC[REAL_LE_REFL]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC VSUM_EQ_0 THEN X_GEN_TAC `k:num->bool` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL; INTERVAL_NE_EMPTY]) THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on interval[a,b]` ASSUME_TAC THENL [ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ] THEN MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_EQ THEN EXISTS_TAC `(\x. vec 0):(real^M->bool)->real^N` THEN REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_0] THEN REWRITE_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL; INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]; ALL_TAC] THEN ASM_SIMP_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP ABSOLUTELY_INTEGRABLE_SET_VARIATION) THEN TRANS_TAC EQ_TRANS `set_variation (interval[a:real^M,b]) (\x. (vec 0:real^N))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SET_VARIATION_0]] THEN MATCH_MP_TAC SET_VARIATION_EQ THEN REWRITE_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL; INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]);; let NEGLIGIBLE_COUNTABLE = prove (`!s:real^N->bool. COUNTABLE s ==> negligible s`, let lemma = prove (`IMAGE f s = UNIONS {{f x} | x IN s}`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIONS; IN_SING; IN_ELIM_THM] THEN MESON_TAC[IN_SING]) in GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` SUBST1_TAC o MATCH_MP COUNTABLE_AS_IMAGE) THEN ONCE_REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN REWRITE_TAC[NEGLIGIBLE_SING]);; (* ------------------------------------------------------------------------- *) (* More basic "almost everywhere" variants of other theorems. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_COMPONENT_LE_AE = prove (`!f:real^M->real^N g:real^M->real^N s i j k t. 1 <= k /\ k <= dimindex(:N) /\ negligible t /\ (f has_integral i) s /\ (g has_integral j) s /\ (!x. x IN s DIFF t ==> (f x)$k <= (g x)$k) ==> i$k <= j$k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN EXISTS_TAC `\x. if x IN t then vec 0 else (f:real^M->real^N) x` THEN EXISTS_TAC `\x. if x IN t then vec 0 else (g:real^M->real^N) x` THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `f:real^M->real^N` THEN EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]; MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]; COND_CASES_TAC THEN ASM_SIMP_TAC[IN_DIFF; REAL_LE_REFL]]);; let INTEGRAL_COMPONENT_LE_AE = prove (`!f:real^M->real^N g:real^M->real^N s k t. 1 <= k /\ k <= dimindex(:N) /\ negligible t /\ f integrable_on s /\ g integrable_on s /\ (!x. x IN s DIFF t ==> (f x)$k <= (g x)$k) ==> (integral s f)$k <= (integral s g)$k`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE_AE THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let HAS_INTEGRAL_DROP_LE_AE = prove (`!f:real^M->real^1 g:real^M->real^1 s i j t. (f has_integral i) s /\ (g has_integral j) s /\ negligible t /\ (!x. x IN s DIFF t ==> drop(f x) <= drop(g x)) ==> drop i <= drop j`, REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE_AE THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; let INTEGRAL_DROP_LE_AE = prove (`!f:real^M->real^1 g:real^M->real^1 s t. f integrable_on s /\ g integrable_on s /\ negligible t /\ (!x. x IN s DIFF t ==> drop(f x) <= drop(g x)) ==> drop(integral s f) <= drop(integral s g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_LE_AE THEN ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; let NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE = prove (`!f:real^M->real^N s t. negligible t /\ (!x i. x IN s DIFF t /\ 1 <= i /\ i <= dimindex(:N) ==> &0 <= f(x)$i) /\ f integrable_on s ==> f absolutely_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE) THEN EXISTS_TAC `\x. if x IN s DIFF t then (f:real^M->real^N) x else vec 0` THEN EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_REFL; VEC_COMPONENT]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `t:real^M->bool`] THEN ASM_SIMP_TAC[]);; let INTEGRAL_NORM_BOUND_INTEGRAL_AE = prove (`!f:real^M->real^N g s t. f integrable_on s /\ g integrable_on s /\ negligible t /\ (!x. x IN s DIFF t ==> norm(f x) <= drop(g x)) ==> norm(integral s f) <= drop(integral s g)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. if x IN s DIFF t then (f:real^M->real^N) x else vec 0`; `\x. if x IN s DIFF t then (g:real^M->real^1) x else vec 0`; `s:real^M->bool`] INTEGRAL_NORM_BOUND_INTEGRAL) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN EXISTS_TAC `f:real^M->real^N`; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN EXISTS_TAC `g:real^M->real^1`; ASM_MESON_TAC[REAL_LE_REFL; NORM_0; DROP_VEC]] THEN EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[]; MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Beppo Levi theorem. *) (* ------------------------------------------------------------------------- *) let BEPPO_LEVI_INCREASING = prove (`!f:num->real^N->real^1 s. (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ bounded {integral s (f k) | k IN (:num)} ==> ?g k. negligible k /\ !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially`, SUBGOAL_THEN `!f:num->real^N->real^1 s. (!k x. x IN s ==> &0 <= drop(f k x)) /\ (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ bounded {integral s (f k) | k IN (:num)} ==> ?g k. negligible k /\ !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially` ASSUME_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`\n x:real^N. f(n:num) x - f 0 x:real^1`; `s:real^N->bool`]) THEN REWRITE_TAC[] THEN ANTS_TAC THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN MP_TAC(ISPEC `\m n:num. drop (f m (x:real^N)) <= drop (f n x)` TRANSITIVE_STEPWISE_LE) THEN REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL] THEN ASM_MESON_TAC[LE_0]; GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_ARITH `x - a <= y - a <=> x <= y`]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX; bounded] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (fun th -> EXISTS_TAC `B + norm(integral s (f 0:real^N->real^1))` THEN X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k:num` th))) THEN NORM_ARITH_TAC; ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\x. g x + f 0 x):real^N->real^1` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; dist] THEN REWRITE_TAC[VECTOR_ARITH `a - b - c:real^1 = a - (c + b)`]]] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `g = \i n:num x:real^N. lift(min (drop(f n x) / (&i + &1)) (&1))` THEN SUBGOAL_THEN `!i n. ((g:num->num->real^N->real^1) i n) integrable_on s` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN MATCH_MP_TAC INTEGRABLE_MIN_CONST_1 THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV; REAL_LE_ADD] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_SIMP_TAC[LIFT_CMUL; LIFT_DROP; INTEGRABLE_CMUL; ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `!i:num k:num x:real^N. x IN s ==> drop(g i k x) <= drop(g i (SUC k) x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> min x a <= min y a`) THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 < &n + &1`]; ALL_TAC] THEN SUBGOAL_THEN `!i:num k:num x:real^N. x IN s ==> norm(g i k x:real^1) <= &1` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[LIFT_DROP; NORM_REAL; GSYM drop] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(min x (&1)) <= &1`) THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV; REAL_LE_ADD]; ALL_TAC] THEN SUBGOAL_THEN `!i:num x:real^N. x IN s ==> ?h:real^1. ((\n. g i n x) --> h) sequentially` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n. drop(g (i:num) (n:num) (x:real^N))`; `&1`] CONVERGENT_BOUNDED_MONOTONE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[GSYM ABS_DROP] THEN DISJ1_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `l:real` (fun th -> EXISTS_TAC `lift l` THEN MP_TAC th)) THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_REAL; GSYM drop; LIFT_DROP]]; GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `h:num->real^N->real^1` THEN STRIP_TAC THEN MP_TAC(GEN `i:num `(ISPECL [`g(i:num):num->real^N->real^1`; `h(i:num):real^N->real^1`; `s:real^N->bool`] MONOTONE_CONVERGENCE_INCREASING)) THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [GEN_TAC THEN REWRITE_TAC[bounded] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `K:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC(REAL_ARITH `norm a = drop a /\ x <= drop a ==> x <= norm a`) THEN CONJ_TAC THENL [REWRITE_TAC[NORM_REAL; GSYM drop; REAL_ABS_REFL] THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_SIMP_TAC[]; MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(min x (&1)) <= y`) THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_POS; REAL_LE_DIV] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &i + &1`] THEN REWRITE_TAC[REAL_ARITH `a <= a * (x + &1) <=> &0 <= a * x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN ABBREV_TAC `Z = {x:real^N | x IN s /\ ~(?l:real^1. ((\k. f k x) --> l) sequentially)}` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `Z:real^N->bool` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "Z" THEN REWRITE_TAC[IN_ELIM_THM] THEN SET_TAC[]] THEN MP_TAC(ISPECL [`h:num->real^N->real^1`; `(\x. if x IN Z then vec 1 else vec 0):real^N->real^1`; `s:real^N->bool`] MONOTONE_CONVERGENCE_DECREASING) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!i x:real^N. x IN s ==> drop(h (SUC i) x) <= drop(h i x)` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`i:num`; `x:real^N`] THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN EXISTS_TAC `\n. (g:num->num->real^N->real^1) (SUC i) n x` THEN EXISTS_TAC `\n. (g:num->num->real^N->real^1) i n x` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> min x a <= min y a`) THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!i. norm(integral s ((h:num->real^N->real^1) i)) <= B / (&i + &1)` ASSUME_TAC THENL [X_GEN_TAC `i:num` THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\k. integral s ((g:num->num->real^N->real^1) i k)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral s (\x. inv(&i + &1) % (f:num->real^N->real^1) n x))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_SIMP_TAC[INTEGRABLE_CMUL; ETA_AX] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP; DROP_CMUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(min x (&1)) <= y`) THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_POS; REAL_LE_DIV] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[INTEGRAL_CMUL; ETA_AX; DROP_CMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_DIV2_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN ASM_REWRITE_TAC[GSYM ABS_DROP]]; ALL_TAC] THEN ANTS_TAC THENL [REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ALL_TAC; EXISTS_TAC `B:real` THEN X_GEN_TAC `i:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B / (&i + &1)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &i + &1`] THEN REWRITE_TAC[REAL_ARITH `B <= B * (i + &1) <=> &0 <= i * B`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE]] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN Z` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN UNDISCH_TAC `(x:real^N) IN Z` THEN EXPAND_TAC "Z" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(GEN `B:real` (ISPECL [`\n. drop(f (n:num) (x:real^N))`; `B:real`] CONVERGENT_BOUNDED_MONOTONE)) THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; LEFT_EXISTS_AND_THM] THEN MATCH_MP_TAC(TAUT `q /\ ~r /\ (q ==> ~p ==> s) ==> (p /\ (q \/ q') ==> r) ==> s`) THEN CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `lift l`) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIST_REAL; GSYM drop; DROP_SUB; LIFT_DROP]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM; EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; REAL_NOT_LE] THEN DISCH_TAC THEN EXISTS_TAC `0` THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(\n. (g:num->num->real^N->real^1) i n x)` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN EXPAND_TAC "g" THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o SPEC `&i + &1`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN REWRITE_TAC[REAL_ARITH `min a b = b <=> b <= a`] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &i + &1`; REAL_MUL_LID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a < abs N ==> &0 <= N /\ N <= n ==> a <= n`)) THEN ASM_SIMP_TAC[]; UNDISCH_TAC `~((x:real^N) IN Z)` THEN EXPAND_TAC "Z" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l:real^1` THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `e / C:real` REAL_ARCH_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N) * C` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `C / (&i + &1)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. (g:num->num->real^N->real^1) i n x` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> abs(min x (&1)) <= a`) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; REAL_POS] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 < &i + &1`] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN ASM_REWRITE_TAC[GSYM NORM_LIFT; LIFT_DROP]]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(MESON[LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY] `(f --> vec 0) sequentially /\ (i = vec 0 ==> p) ==> (f --> i) sequentially ==> p`) THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\i. B / (&i + &1)` THEN ASM_SIMP_TAC[ALWAYS_EVENTUALLY] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = B % vec 0`) THEN MATCH_MP_TAC LIM_CMUL THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[NORM_LIFT; GSYM drop; LIFT_DROP; REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL] THEN W(MP_TAC o PART_MATCH (lhs o rand) HAS_INTEGRAL_NEGLIGIBLE_EQ o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; REAL_POS]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN SIMP_TAC[SUBSET; IN_ELIM_THM; VEC_EQ; ARITH_EQ] THEN EXPAND_TAC "Z" THEN SIMP_TAC[IN_ELIM_THM]]]]);; let BEPPO_LEVI_DECREASING = prove (`!f:num->real^N->real^1 s. (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f (SUC k) x) <= drop(f k x)) /\ bounded {integral s (f k) | k IN (:num)} ==> ?g k. negligible k /\ !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n x. --((f:num->real^N->real^1) n x)`; `s:real^N->bool`] BEPPO_LEVI_INCREASING) THEN ASM_SIMP_TAC[INTEGRABLE_NEG; DROP_NEG; ETA_AX; REAL_LE_NEG2] THEN ANTS_TAC THENL [REWRITE_TAC[bounded] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[INTEGRAL_NEG; ETA_AX; NORM_NEG]; ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. --((g:real^N->real^1) x)` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM VECTOR_NEG_NEG] THEN ASM_SIMP_TAC[LIM_NEG_EQ]]);; let BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING = prove (`!f:num->real^N->real^1 s. (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ bounded {integral s (f k) | k IN (:num)} ==> ?g k. negligible k /\ (!x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially) /\ g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BEPPO_LEVI_INCREASING) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(g:real^N->real^1) integrable_on (s DIFF k) /\ ((\i. integral (s DIFF k) (f i)) --> integral (s DIFF k) g) sequentially` MP_TAC THENL [MATCH_MP_TAC MONOTONE_CONVERGENCE_INCREASING THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)); ALL_TAC] THEN (SUBGOAL_THEN `!f:real^N->real^1. integral (s DIFF k) f = integral s f /\ (f integrable_on (s DIFF k) <=> f integrable_on s)` (fun th -> SIMP_TAC[th; IN_DIFF]) THEN GEN_TAC THEN CONJ_TAC THEN TRY EQ_TAC THEN (MATCH_MP_TAC INTEGRABLE_SPIKE_SET ORELSE MATCH_MP_TAC INTEGRAL_SPIKE_SET) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]));; let BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING = prove (`!f:num->real^N->real^1 s. (!k. (f k) integrable_on s) /\ (!k x. x IN s ==> drop(f (SUC k) x) <= drop(f k x)) /\ bounded {integral s (f k) | k IN (:num)} ==> ?g k. negligible k /\ (!x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially) /\ g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BEPPO_LEVI_DECREASING) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(g:real^N->real^1) integrable_on (s DIFF k) /\ ((\i. integral (s DIFF k) (f i)) --> integral (s DIFF k) g) sequentially` MP_TAC THENL [MATCH_MP_TAC MONOTONE_CONVERGENCE_DECREASING THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)); ALL_TAC] THEN (SUBGOAL_THEN `!f:real^N->real^1. integral (s DIFF k) f = integral s f /\ (f integrable_on (s DIFF k) <=> f integrable_on s)` (fun th -> SIMP_TAC[th; IN_DIFF]) THEN GEN_TAC THEN CONJ_TAC THEN TRY EQ_TAC THEN (MATCH_MP_TAC INTEGRABLE_SPIKE_SET ORELSE MATCH_MP_TAC INTEGRAL_SPIKE_SET) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]));; let BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE = prove (`!f:num->real^N->real^1 s. (!k. (f k) integrable_on s) /\ (!k. ?t. negligible t /\ !x. x IN s DIFF t ==> drop(f k x) <= drop(f (SUC k) x)) /\ bounded {integral s (f k) | k IN (:num)} ==> ?g k. negligible k /\ (!x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially) /\ g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `t:num->real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\n x. if x IN UNIONS {t k | k IN (:num)} then vec 0 else (f:num->real^N->real^1) n x`; `s:real^N->bool`] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN SUBGOAL_THEN `negligible(UNIONS {t k | k IN (:num)}:real^N->bool)` ASSUME_TAC THENL [ASM_SIMP_TAC[NEGLIGIBLE_COUNTABLE_UNIONS]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `k:num` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN EXISTS_TAC `(f:num->real^N->real^1) k` THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]; REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u UNION UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(f --> l) sequentially ==> f = g ==> (g --> l) sequentially`)) THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]]);; let BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE = prove (`!f:num->real^N->real^1 s. (!k. (f k) integrable_on s) /\ (!k. ?t. negligible t /\ !x. x IN s DIFF t ==> drop(f (SUC k) x) <= drop(f k x)) /\ bounded {integral s (f k) | k IN (:num)} ==> ?g k. negligible k /\ (!x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially) /\ g integrable_on s /\ ((\k. integral s (f k)) --> integral s g) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `t:num->real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\n x. if x IN UNIONS {t k | k IN (:num)} then vec 0 else (f:num->real^N->real^1) n x`; `s:real^N->bool`] BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING) THEN SUBGOAL_THEN `negligible(UNIONS {t k | k IN (:num)}:real^N->bool)` ASSUME_TAC THENL [ASM_SIMP_TAC[NEGLIGIBLE_COUNTABLE_UNIONS]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `k:num` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN EXISTS_TAC `(f:num->real^N->real^1) k` THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]; REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u UNION UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(f --> l) sequentially ==> f = g ==> (g --> l) sequentially`)) THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN ASM_SIMP_TAC[IN_DIFF]]]);; (* ------------------------------------------------------------------------- *) (* Fatou's lemma and Lieb's extension. *) (* ------------------------------------------------------------------------- *) let FATOU = prove (`!f:num->real^N->real^1 g s t B. negligible t /\ (!n. (f n) integrable_on s) /\ (!n x. x IN s DIFF t ==> &0 <= drop(f n x)) /\ (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) /\ (!n. drop(integral s (f n)) <= B) ==> g integrable_on s /\ &0 <= drop(integral s g) /\ drop(integral s g) <= B`, REPEAT GEN_TAC THEN STRIP_TAC THEN ABBREV_TAC `h = \n x. lift(inf {drop((f:num->real^N->real^1) j x) | n <= j})` THEN MP_TAC(MATCH_MP MONO_FORALL (GEN `m:num` (ISPECL [`\k:num x:real^N. lift(inf {drop(f j x) | j IN m..(m+k)})`; `(h:num->real^N->real^1) m`; `s:real^N->bool`; `t:real^N->bool`] MONOTONE_CONVERGENCE_DECREASING_AE))) THEN ASM_REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL [X_GEN_TAC `m:num` THEN EXPAND_TAC "h" THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN MATCH_MP_TAC LOWER_BOUND_FINITE_SET_REAL THEN REWRITE_TAC[FINITE_NUMSEG]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[dist; ABS_DROP; LIFT_DROP; DROP_SUB] THEN MP_TAC(SPEC `{drop((f:num->real^N->real^1) j x) | m <= j}` INF) THEN ABBREV_TAC `i = inf {drop((f:num->real^N->real^1) j x) | m <= j}` THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `i + e:real`)) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i + e <= i)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y < i + e ==> i <= ix /\ ix <= y ==> abs(ix - i) < e`)) THEN CONJ_TAC THENL [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `i:real` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN ASM_ARITH_TAC; REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; NORM_REAL; GSYM drop] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= b ==> abs(x) <= b`) THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_POS_AE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[LIFT_DROP] THEN CONJ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD]]; TRANS_TAC REAL_LE_TRANS `drop (integral s ((f:num->real^N->real^1) m))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[REAL_INF_LE_FINITE; LIFT_DROP; SIMPLE_IMAGE; FINITE_IMAGE; IMAGE_EQ_EMPTY; FINITE_NUMSEG; IN_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD; EXISTS_IN_IMAGE] THEN MESON_TAC[REAL_LE_REFL; LE_REFL; LE_ADD]]] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN MP_TAC(ISPECL [`h:num->real^N->real^1`; `g:real^N->real^1`; `s:real^N->bool`; `t:real^N->bool`] MONOTONE_CONVERGENCE_INCREASING_AE) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!n. &0 <= drop(integral s ((h:num->real^N->real^1) n)) /\ drop(integral s ((h:num->real^N->real^1) n)) <= B` MP_TAC THENL [X_GEN_TAC `m:num` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_POS_AE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[LIFT_DROP] THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN MESON_TAC[LE_REFL]; TRANS_TAC REAL_LE_TRANS `drop (integral s ((f:num->real^N->real^1) m))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_DROP_LE_AE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN GEN_REWRITE_TAC RAND_CONV [GSYM INF_SING] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REWRITE_TAC[NOT_INSERT_EMPTY; SING_SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ASM_MESON_TAC[]] THEN MESON_TAC[LE_REFL; REAL_LE_REFL]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_GSPEC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_LE] THEN REPEAT CONJ_TAC THENL [MESON_TAC[LT_REFL]; MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; ASM_MESON_TAC[]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[DIST_REAL; GSYM drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ g - e / &2 <= h /\ h <= g + e / &2 ==> abs(h - g) < e`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC REAL_INF_BOUNDS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[SET_RULE `{f n | P n} = {} <=> !n. ~P n`] THEN CONJ_TAC THENL [MESON_TAC[LE_REFL]; GEN_TAC THEN DISCH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs(h - g) < e / &2 ==> g - e / &2 <= h /\ h <= g + e / &2`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[LE_TRANS]; REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN EXISTS_TAC `B:real` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= b ==> abs x <= b`) THEN ASM_REWRITE_TAC[]]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND); MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND)] THEN EXISTS_TAC `\n. integral s ((h:num->real^N->real^1) n)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_TRUE]]);; let LIEB = prove (`!f:num->real^M->real^N g s t. (!n. f n absolutely_integrable_on s) /\ g absolutely_integrable_on s /\ negligible t /\ (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) ==> ((\n. integral s (\x. lift(norm(f n x - g x))) - (integral s (\x. lift(norm(f n x))) - integral s (\x. lift(norm(g x))))) --> vec 0) sequentially`, (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [GSYM INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_SUB; ETA_AX; ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(norm((f:num->real^M->real^N) n x - g x) - (norm(f n x) - norm(g x)))`; `(\x. vec 0):real^M->real^1`; `\x. &2 % lift(norm((g:real^M->real^N) x))`; `s:real^M->bool`; `t:real^M->bool`] DOMINATED_CONVERGENCE_AE) THEN REWRITE_TAC[LIFT_SUB; DROP_CMUL; INTEGRAL_0; INTEGRABLE_0] THEN DISCH_THEN MATCH_MP_TAC THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [GSYM INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_SUB; ETA_AX; INTEGRABLE_CMUL; ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; LIFT_DROP] THEN CONV_TAC NORM_ARITH; REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_SUB THEN ASM_SIMP_TAC[GSYM LIM_NULL_NORM; GSYM LIM_NULL; LIM_NORM]]);; let FATOU_STRONG = prove (`!f:num->real^N->real^1 g s t B. negligible t /\ (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) /\ eventually (\n. (f n) integrable_on s) sequentially /\ eventually (\n. !x. x IN s DIFF t ==> &0 <= drop(f n x)) sequentially /\ eventually (\n. drop(integral s (f n)) <= B) sequentially ==> g absolutely_integrable_on s /\ &0 <= drop(integral s g) /\ drop(integral s g) <= B`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVENTUALLY_SEQUENTIALLY]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n. (f:num->real^N->real^1) (N + n)`; `g:real^N->real^1`; `s:real^N->bool`; `t:real^N->bool`; `B:real`] FATOU) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `\n:num. N + n` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE)) THEN REWRITE_TAC[o_DEF; LT_ADD_LCANCEL]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[DIMINDEX_1; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\n. (f:num->real^N->real^1) n x` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N:num` THEN REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ASM_SIMP_TAC[FORALL_UNWIND_THM2]]);; (* ------------------------------------------------------------------------- *) (* Fundamental theorem of calculus, starting with strong forms. *) (* ------------------------------------------------------------------------- *) let FUNDAMENTAL_THEOREM_OF_CALCULUS_BARTLE = prove (`!f:real^1->real^N f' s a b. negligible s /\ drop a <= drop b /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f'(x)) (at x within interval[a,b])) /\ (!e. &0 < e ==> ?g. gauge g /\ !p. p tagged_partial_division_of interval[a,b] /\ g fine p /\ IMAGE FST p SUBSET s ==> norm (vsum p (\(x,k). f(interval_upperbound k) - f(interval_lowerbound k))) < e) ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^1 = a` THEN ASM_REWRITE_TAC[HAS_INTEGRAL_REFL; VECTOR_SUB_REFL] THEN SUBGOAL_THEN `drop a < drop b` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ]; ALL_TAC] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `(\x. if x IN s then vec 0 else f' x):real^1->real^N` THEN EXISTS_TAC `s:real^1->bool` THEN ASM_SIMP_TAC[IN_DIFF] THEN ABBREV_TAC `g = \x. if x IN s then vec 0 else (f':real^1->real^N) x` THEN REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^1->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x. ?d. &0 < d /\ (x IN interval[a,b] DIFF s ==> !y. norm(y - x) < d /\ y IN interval[a:real^1,b] ==> norm(f y - f x - drop(y - x) % g x:real^N) <= e / &2 / (drop b - drop a) * norm(y - x))` MP_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF] THEN ASM_CASES_TAC `(x:real^1) IN interval[a,b]` THENL [ALL_TAC; EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]] THEN ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[IN_DIFF; has_vector_derivative; HAS_DERIVATIVE_WITHIN_ALT] THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / (drop b - drop a)` o CONJUNCT2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_SUB_LT; REAL_HALF] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM; IMP_IMP; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN X_GEN_TAC `d:real^1->real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(LABEL_TAC "D")] THEN EXISTS_TAC `\x. g1(x) INTER ball(x:real^1,d(x))` THEN ASM_SIMP_TAC[GAUGE_BALL_DEPENDENT; GAUGE_INTER] THEN X_GEN_TAC `p:(real^1#(real^1->bool))->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `p:(real^1#(real^1->bool))->bool`; `a:real^1`; `b:real^1`] ADDITIVE_TAGGED_DIVISION_1) THEN ASM_SIMP_TAC[CONTENT_1] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM VSUM_SUB; LAMBDA_PAIR_THM] THEN SUBGOAL_THEN `p:(real^1#(real^1->bool))->bool = {(x,k) | (x,k) IN p /\ x IN s} UNION {(x,k) | (x,k) IN p /\ ~(x IN s)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_UNION] THEN MESON_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o rand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN SIMP_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN CONJ_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `p:(real^1#(real^1->bool))->bool` THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PAIR_THM]; DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `(!P. FINITE {(x:real^1,k:real^1->bool) | (x,k) IN p /\ P x k}) /\ (!P x. FINITE {(x:real^1,k:real^1->bool) |k| (x,k) IN p /\ P x k})` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `p:real^1#(real^1->bool)->bool` THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) < e / &2 /\ norm(y) <= e / &2 ==> norm(x + y) < e`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `{(x:real^1,k:real^1->bool) | (x,k) IN p /\ x IN s}`) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_division_of]) THEN REWRITE_TAC[tagged_partial_division_of] THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN REWRITE_TAC[fine; IN_ELIM_PAIR_THM] THEN SET_TAC[]; SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC]]; MATCH_MP_TAC(NORM_ARITH `x:real^N = --y ==> norm(x) < e ==> norm(y) < e`) THEN REWRITE_TAC[GSYM VSUM_NEG] THEN MATCH_MP_TAC VSUM_EQ THEN EXPAND_TAC "g" THEN SIMP_TAC[FORALL_IN_GSPEC; VECTOR_MUL_RZERO] THEN REPEAT STRIP_TAC THEN CONV_TAC VECTOR_ARITH]; ALL_TAC] THEN SUBGOAL_THEN `e / &2 = e / &2 / (drop b - drop a) * (drop b - drop a)` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_SUB_LT; REAL_LT_IMP_NE]; ALL_TAC] THEN MP_TAC(ISPECL [`\x:real^1. x`; `p:(real^1#(real^1->bool))->bool`; `a:real^1`; `b:real^1`] ADDITIVE_TAGGED_DIVISION_1) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `drop`) THEN ASM_SIMP_TAC[DROP_VSUM; DROP_SUB] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {(x:real^1,k:real^1->bool) | (x,k) IN p /\ ~(x IN s)} (\x. e / &2 / (drop b - drop a) * (drop o (\(x,k). interval_upperbound k - interval_lowerbound k)) x)` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN SIMP_TAC[o_DEF] THEN REWRITE_TAC[NORM_ARITH `norm(a - (b - c):real^N) = norm(b - c - a)`] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_LE_TRANS th)) THEN SIMP_TAC[CONTENT_1; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN DISCH_TAC THEN REMOVE_THEN "D" (MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; IN_INTERVAL_1]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `interval[u:real^1,v]`]) THEN ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN ASM_REWRITE_TAC[dist; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_SUB] THEN DISCH_TAC THEN DISCH_TAC THEN REPEAT(ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_NE_EMPTY_1; REAL_LT_IMP_LE]; ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]]) THEN REWRITE_TAC[IMP_IMP; DROP_SUB; VECTOR_SUB_RDISTRIB] THEN MATCH_MP_TAC(NORM_ARITH `d + e <= f ==> norm((vg - xg) - (fv - fx)) <= d /\ norm((vu - xg) - (fu - fx)) <= e ==> norm((vg - vu) - (fv - fu)) <= f`) THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN ASM_SIMP_TAC[REAL_ARITH `a <= b ==> abs(a - b) = b - a`; REAL_ARITH `b <= a ==> abs(a - b) = a - b`] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_PAIR_THM]] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN REWRITE_TAC[IN_INTERVAL_1; o_THM] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN ASM_REAL_ARITH_TAC]);; let FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG = prove (`!f:real^1->real^N f' s a b. COUNTABLE s /\ drop a <= drop b /\ f continuous_on interval[a,b] /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f'(x)) (at x within interval[a,b])) ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_BARTLE THEN EXISTS_TAC `s:real^1->bool` THEN ASM_SIMP_TAC[NEGLIGIBLE_COUNTABLE] THEN SUBGOAL_THEN `?f t. s = IMAGE (f:num->real^1) t /\ (!m n. m IN t /\ n IN t /\ f m = f n ==> m = n)` MP_TAC THENL [ASM_CASES_TAC `FINITE(s:real^1->bool)` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ASM_MESON_TAC[]; MP_TAC(ISPEC `s:real^1->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN ASM_REWRITE_TAC[INFINITE] THEN MESON_TAC[IN_UNIV]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_LEFT_INVERSE] THEN MAP_EVERY X_GEN_TAC [`r:num->real^1`; `t:num->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `n:real^1->num`)] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `!x. ?d. &0 < d /\ (x IN interval[a,b] /\ x IN IMAGE (r:num->real^1) t ==> !y. norm(y - x) < d /\ y IN interval[a,b] ==> norm(f y - f x:real^N) <= e / &2 pow (4 + n x))` MP_TAC THENL [X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `(x:real^1) IN interval[a,b]` THENL [ALL_TAC; EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]] THEN ASM_CASES_TAC `x IN IMAGE (r:num->real^1) t` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; MESON_TAC[REAL_LT_01]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[dist] THEN DISCH_THEN(MP_TAC o SPEC `e / &2 pow (4 + n(x:real^1))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; NORM_POS_LT; VECTOR_SUB_EQ; REAL_LT_POW2; GSYM DROP_EQ; REAL_LT_IMP_NE] THEN MESON_TAC[REAL_LT_IMP_LE]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM; IMP_IMP; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN X_GEN_TAC `d:real^1->real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "E"))] THEN EXISTS_TAC `\x. ball(x:real^1,d(x))` THEN ASM_SIMP_TAC[GAUGE_BALL_DEPENDENT] THEN X_GEN_TAC `p:(real^1#(real^1->bool))->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[tagged_partial_division_of]) THEN SUBGOAL_THEN `(!P. FINITE {(x:real^1,k:real^1->bool) | (x,k) IN p /\ P x k}) /\ (!P x. FINITE {(x:real^1,k:real^1->bool) |k| (x,k) IN p /\ P x k})` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `p:real^1#(real^1->bool)->bool` THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(vsum {(x,k) | (x,k) IN p /\ x IN IMAGE (r:num->real^1) t /\ ~(content k = &0)} (\(x,k). --(f(interval_upperbound k) - (f:real^1->real^N)(interval_lowerbound k))))` THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `--x:real^N = y ==> norm x <= norm y`) THEN REWRITE_TAC[GSYM VSUM_NEG] THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[FORALL_PAIR_THM]] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN ASM_REWRITE_TAC[CONTENT_EQ_0_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; INTERVAL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN REWRITE_TAC[VECTOR_ARITH `--(x - y):real^N = vec 0 <=> x = y`] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum {(x,k:real^1->bool) | (x,k) IN p /\ x IN IMAGE (r:num->real^1) t /\ ~(content k = &0)} (\(x,k). e / &2 pow (3 + n x))` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN SIMP_TAC[CONTENT_EQ_0_1; REAL_NOT_LE; REAL_LT_IMP_LE; IN_INTERVAL_1; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN REPEAT STRIP_TAC THEN REMOVE_THEN "E" (MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of; SUBSET]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `interval[u:real^1,v]`]) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN DISCH_THEN(fun th -> MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN ASM_REWRITE_TAC[dist; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_SUB] THEN DISCH_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN REPEAT(ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_NE_EMPTY_1; REAL_LT_IMP_LE]; ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]]) THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN NORM_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`FST:real^1#(real^1->bool)->real^1`; `\(x:real^1,k:real^1->bool). e / &2 pow (3 + n x)`; `{(x,k:real^1->bool) | (x,k) IN p /\ x IN IMAGE (r:num->real^1) t /\ ~(content k = &0)}`; `IMAGE (r:num->real^1) t` ] SUM_GROUP) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (IMAGE (r:num->real^1) t) (\x. sum {(x,k:real^1->bool) |k| (x,k) IN p /\ ~(content k = &0)} (\yk. e / &2 pow (3 + n x)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CONST] THEN REWRITE_TAC[SUM_RMUL; NORM_1; DROP_SUB; REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `p * e * inv(&2 pow 3) * n = e / &8 * (p * n)`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; SUM_LMUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e * x <= e * &4 ==> e / &8 * x < e`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (IMAGE (r:num->real^1) t INTER IMAGE (FST:real^1#(real^1->bool)->real^1) p) (\x. &(CARD {(x,k:real^1->bool) | k | (x,k) IN p /\ ~(content k = &0)}) * inv(&2 pow n x))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[INTER_SUBSET; IMP_CONJ; FORALL_IN_IMAGE] THEN SIMP_TAC[IN_INTER; FUN_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (IMAGE (r:num->real^1) t INTER IMAGE (FST:real^1#(real^1->bool)->real^1) p) (\x. &2 / &2 pow (n x))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INTER] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS; REAL_OF_NUM_LE] THEN GEN_REWRITE_TAC RAND_CONV [ARITH_RULE `2 = 2 EXP 1`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_COMMON_TAGS THEN ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN REWRITE_TAC[real_div; SUM_LMUL; REAL_ARITH `&2 * x <= &4 <=> x <= &2`; REAL_INV_POW] THEN SUBGOAL_THEN `(\x:real^1. inv (&2) pow n x) = (\n. inv(&2) pow n) o n` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE o lhand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN SUBGOAL_THEN `?m. IMAGE (n:real^1->num) (IMAGE (r:num->real^1) t INTER IMAGE (FST:real^1#(real^1->bool)->real^1) p) SUBSET 0..m` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_NUMSEG; LE_0] THEN MATCH_MP_TAC UPPER_BOUND_FINITE_SET THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INTER]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..m) (\n. inv(&2) pow n)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN ASM SET_TAC[]; REWRITE_TAC[SUM_GP; LT; SUB_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `(&1 - x) / (&1 / &2) <= &2 <=> &0 <= x`] THEN MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG = prove (`!f:real^1->real^N f' s a b. COUNTABLE s /\ drop a <= drop b /\ f continuous_on interval[a,b] /\ (!x. x IN interval(a,b) DIFF s ==> (f has_vector_derivative f'(x)) (at x)) ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN EXISTS_TAC `(a:real^1) INSERT (b:real^1) INSERT s` THEN ASM_REWRITE_TAC[COUNTABLE_INSERT; IN_INTERVAL_1; IN_DIFF] THEN REWRITE_TAC[DE_MORGAN_THM; IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DIFF; IN_INSERT] THEN ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ]);; let FUNDAMENTAL_THEOREM_OF_CALCULUS = prove (`!f:real^1->real^N f' a b. drop a <= drop b /\ (!x. x IN interval[a,b] ==> (f has_vector_derivative f'(x)) (at x within interval[a,b])) ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN EXISTS_TAC `{}:real^1->bool` THEN ASM_REWRITE_TAC[COUNTABLE_EMPTY; DIFF_EMPTY] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN REWRITE_TAC[differentiable_on] THEN ASM_MESON_TAC[has_vector_derivative; differentiable]);; let FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR = prove (`!f:real^1->real^N f' a b. drop a <= drop b /\ f continuous_on interval[a,b] /\ (!x. x IN interval(a,b) ==> (f has_vector_derivative f'(x)) (at x)) ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN EXISTS_TAC `{}:real^1->bool` THEN ASM_REWRITE_TAC[COUNTABLE_EMPTY; DIFF_EMPTY]);; let ANTIDERIVATIVE_INTEGRAL_CONTINUOUS = prove (`!f:real^1->real^N a b. (f continuous_on interval[a,b]) ==> ?g. !u v. u IN interval[a,b] /\ v IN interval[a,b] /\ drop u <= drop v ==> (f has_integral (g(v) - g(u))) (interval[u,v])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ANTIDERIVATIVE_CONTINUOUS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* This doesn't directly involve integration, but that gives an easy proof. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL = prove (`!f:real^1->real^N a b k y. COUNTABLE k /\ f continuous_on interval[a,b] /\ f a = y /\ (!x. x IN (interval[a,b] DIFF k) ==> (f has_derivative (\h. vec 0)) (at x within interval[a,b])) ==> !x. x IN interval[a,b] ==> f x = y`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC(ISPEC `(\x. vec 0):real^1->real^N` HAS_INTEGRAL_UNIQUE) THEN EXISTS_TAC `interval[a:real^1,x]` THEN REWRITE_TAC[HAS_INTEGRAL_0] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN EXISTS_TAC `k:real^1->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REAL_ARITH_TAC; X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[IN_DIFF; IN_INTERVAL_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_DERIVATIVE_WITHIN_SUBSET)) THEN DISCH_THEN(MP_TAC o SPEC `interval(a:real^1,b)`) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN REWRITE_TAC[has_vector_derivative; VECTOR_MUL_RZERO] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_OPEN THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[OPEN_INTERVAL; IN_INTERVAL_1; IN_DIFF] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Generalize a bit to any convex set. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX = prove (`!f:real^M->real^N s k c y. convex s /\ COUNTABLE k /\ f continuous_on s /\ c IN s /\ f c = y /\ (!x. x IN (s DIFF k) ==> (f has_derivative (\h. vec 0)) (at x within s)) ==> !x. x IN s ==> f x = y`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `z:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`(f:real^M->real^N) o (\t. (&1 - drop t) % x + drop t % y)`; `vec 0:real^1`; `vec 1:real^1`; `{t | ((&1 - drop t) % (x:real^M) + drop t % y) IN k}`; `(f:real^M->real^N) x`] HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL) THEN REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0; DROP_EQ; VECTOR_ARITH `(&1 - t) % x + t % y = (&1 - u) % x + u % y <=> (t - u) % (x - y) = vec 0`]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; LIFT_SUB] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN REWRITE_TAC[DROP_VEC] THEN ASM_MESON_TAC[CONVEX_ALT]]; AP_TERM_TAC THEN REWRITE_TAC[DROP_VEC] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `(\h. vec 0) = ((\h. vec 0):real^M->real^N) o (\t. drop t % (y - x))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `t % (y - x) = ((&0 - t) % x) + t % y`] THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[GSYM DROP_NEG; GSYM DROP_VEC; GSYM DROP_SUB] THEN SIMP_TAC[HAS_DERIVATIVE_VMUL_DROP; HAS_DERIVATIVE_ID] THEN REWRITE_TAC[DROP_SUB; VECTOR_SUB_RDISTRIB] THEN MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN REWRITE_TAC[VECTOR_MUL_LZERO; DROP_VEC; HAS_DERIVATIVE_CONST] THEN SIMP_TAC[HAS_DERIVATIVE_VMUL_DROP; HAS_DERIVATIVE_ID]; ALL_TAC] THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_ALT]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DIFF]) THEN SIMP_TAC[IN_ELIM_THM; IN_DIFF] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN ASM_MESON_TAC[CONVEX_ALT]);; (* ------------------------------------------------------------------------- *) (* Also to any open connected set with finite set of exceptions. Could *) (* generalize to locally convex set with limpt-free set of exceptions. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED = prove (`!f:real^M->real^N s k c y. connected s /\ open s /\ COUNTABLE k /\ f continuous_on s /\ c IN s /\ f c = y /\ (!x. x IN (s DIFF k) ==> (f has_derivative (\h. vec 0)) (at x within s)) ==> !x. x IN s ==> f x = y`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x IN {y}}`) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE; CLOSED_SING] THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN UNDISCH_TAC `open(s:real^M->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^M` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_SING] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX THEN MAP_EVERY EXISTS_TAC [`k:real^M->bool`; `u:real^M`] THEN ASM_REWRITE_TAC[CONVEX_BALL; IN_DIFF; CENTRE_IN_BALL] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_DIFF]);; (* ------------------------------------------------------------------------- *) (* Integration by parts. *) (* ------------------------------------------------------------------------- *) let INTEGRATION_BY_PARTS = prove (`!(bop:real^M->real^N->real^P) f g f' g' a b c y. bilinear bop /\ drop a <= drop b /\ COUNTABLE c /\ (\x. bop (f x) (g x)) continuous_on interval[a,b] /\ (!x. x IN interval(a,b) DIFF c ==> (f has_vector_derivative f'(x)) (at x) /\ (g has_vector_derivative g'(x)) (at x)) /\ ((\x. bop (f x) (g' x)) has_integral ((bop (f b) (g b) - bop (f a) (g a)) - y)) (interval[a,b]) ==> ((\x. bop (f' x) (g x)) has_integral y) (interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^1. (bop:real^M->real^N->real^P) (f x) (g x)`; `\x:real^1. (bop:real^M->real^N->real^P) (f x) (g' x) + (bop:real^M->real^N->real^P) (f' x) (g x)`; `c:real^1->bool`; `a:real^1`; `b:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_BILINEAR_AT] THEN FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB)) THEN REWRITE_TAC[VECTOR_ARITH `b - a - (b - a - y):real^N = y`; VECTOR_ADD_SUB]);; let INTEGRATION_BY_PARTS_SIMPLE = prove (`!(bop:real^M->real^N->real^P) f g f' g' a b y. bilinear bop /\ drop a <= drop b /\ (!x. x IN interval[a,b] ==> (f has_vector_derivative f'(x)) (at x within interval[a,b]) /\ (g has_vector_derivative g'(x)) (at x within interval[a,b])) /\ ((\x. bop (f x) (g' x)) has_integral ((bop (f b) (g b) - bop (f a) (g a)) - y)) (interval[a,b]) ==> ((\x. bop (f' x) (g x)) has_integral y) (interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^1. (bop:real^M->real^N->real^P) (f x) (g x)`; `\x:real^1. (bop:real^M->real^N->real^P) (f x) (g' x) + (bop:real^M->real^N->real^P) (f' x) (g x)`; `a:real^1`; `b:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN] THEN FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB)) THEN REWRITE_TAC[VECTOR_ARITH `b - a - (b - a - y):real^N = y`; VECTOR_ADD_SUB]);; let INTEGRABLE_BY_PARTS = prove (`!(bop:real^M->real^N->real^P) f g f' g' a b c. bilinear bop /\ COUNTABLE c /\ (\x. bop (f x) (g x)) continuous_on interval[a,b] /\ (!x. x IN interval(a,b) DIFF c ==> (f has_vector_derivative f'(x)) (at x) /\ (g has_vector_derivative g'(x)) (at x)) /\ (\x. bop (f x) (g' x)) integrable_on interval[a,b] ==> (\x. bop (f' x) (g x)) integrable_on interval[a,b]`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `drop b <= drop a \/ drop a <= drop b`) THENL [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC INTEGRABLE_ON_NULL THEN ASM_REWRITE_TAC[CONTENT_EQ_0_1]; REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[integrable_on] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^P` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(bop ((f:real^1->real^M) b) ((g:real^1->real^N) b) - bop (f a) (g a)) - (y:real^P)` THEN MATCH_MP_TAC INTEGRATION_BY_PARTS THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^M`; `g':real^1->real^N`; `c:real^1->bool`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `b - a - ((b - a) - y):real^N = y`]]);; let INTEGRABLE_BY_PARTS_EQ = prove (`!(bop:real^M->real^N->real^P) f g f' g' a b c. bilinear bop /\ COUNTABLE c /\ (\x. bop (f x) (g x)) continuous_on interval[a,b] /\ (!x. x IN interval(a,b) DIFF c ==> (f has_vector_derivative f'(x)) (at x) /\ (g has_vector_derivative g'(x)) (at x)) ==> ((\x. bop (f x) (g' x)) integrable_on interval[a,b] <=> (\x. bop (f' x) (g x)) integrable_on interval[a,b])`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[INTEGRABLE_BY_PARTS]; DISCH_TAC] THEN MP_TAC(ISPEC `\x y. (bop:real^M->real^N->real^P) y x` INTEGRABLE_BY_PARTS) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN UNDISCH_TAC `bilinear(bop:real^M->real^N->real^P)` THEN REWRITE_TAC[bilinear] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Equiintegrability. The definition here only really makes sense for an *) (* elementary set. We just use compact intervals in applications below. *) (* ------------------------------------------------------------------------- *) parse_as_infix("equiintegrable_on",(12,"right"));; let equiintegrable_on = new_definition `fs equiintegrable_on i <=> (!f:real^M->real^N. f IN fs ==> f integrable_on i) /\ (!e. &0 < e ==> ?d. gauge d /\ !f p. f IN fs /\ p tagged_division_of i /\ d fine p ==> norm(vsum p (\(x,k). content(k) % f(x)) - integral i f) < e)`;; let EQUIINTEGRABLE_ON_SING = prove (`!f:real^M->real^N a b. {f} equiintegrable_on interval[a,b] <=> f integrable_on interval[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN ASM_CASES_TAC `(f:real^M->real^N) integrable_on interval[a,b]` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN REWRITE_TAC[has_integral; IMP_IMP]);; (* ------------------------------------------------------------------------- *) (* Basic combining theorems for the interval of integration. *) (* ------------------------------------------------------------------------- *) let EQUIINTEGRABLE_ON_NULL = prove (`!fs:(real^M->real^N)->bool a b. content(interval[a,b]) = &0 ==> fs equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[equiintegrable_on] THEN ASM_SIMP_TAC[INTEGRABLE_ON_NULL] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP (REWRITE_RULE[IMP_CONJ] VSUM_CONTENT_NULL) th]) THEN ASM_SIMP_TAC[INTEGRAL_NULL; VECTOR_SUB_REFL; NORM_0]);; let EQUIINTEGRABLE_ON_SPLIT = prove (`!fs:(real^M->real^N)->bool k a b c. fs equiintegrable_on (interval[a,b] INTER {x | x$k <= c}) /\ fs equiintegrable_on (interval[a,b] INTER {x | x$k >= c}) /\ 1 <= k /\ k <= dimindex(:M) ==> fs equiintegrable_on (interval[a,b])`, let lemma1 = prove (`(!x k. (x,k) IN {x,f k | P x k} ==> Q x k) <=> (!x k. P x k ==> Q x (f k))`, REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN SET_TAC[]) in let lemma2 = prove (`!f:B->B s:(A#B)->bool. FINITE s ==> FINITE {x,f k | (x,k) IN s /\ P x k}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\(x:A,k:B). x,(f k:B)) s` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; lemma1; IN_IMAGE] THEN REWRITE_TAC[EXISTS_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]) in let lemma3 = prove (`!f:real^M->real^N g:(real^M->bool)->(real^M->bool) p. FINITE p ==> vsum {x,g k |x,k| (x,k) IN p /\ ~(g k = {})} (\(x,k). content k % f x) = vsum (IMAGE (\(x,k). x,g k) p) (\(x,k). content k % f x)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM_SIMP_TAC[FINITE_IMAGE; lemma2] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; SUBSET; IN_IMAGE; EXISTS_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ; VECTOR_MUL_EQ_0] THEN MESON_TAC[CONTENT_EMPTY]) in let lemma4 = prove (`(\(x,l). content (g l) % f x) = (\(x,l). content l % f x) o (\(x,l). x,g l)`, REWRITE_TAC[FUN_EQ_THM; o_THM; FORALL_PAIR_THM]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[equiintegrable_on] THEN MATCH_MP_TAC(TAUT `(a /\ b ==> c) /\ (a /\ b /\ c ==> a' /\ b' ==> c') ==> (a /\ a') /\ (b /\ b') ==> c /\ c'`) THEN CONJ_TAC THENL [REWRITE_TAC[integrable_on] THEN ASM MESON_TAC[HAS_INTEGRAL_SPLIT]; STRIP_TAC] THEN SUBGOAL_THEN `!f:real^M->real^N. f IN fs ==> integral (interval[a,b]) f = integral (interval [a,b] INTER {x | x$k <= c}) f + integral (interval [a,b] INTER {x | x$k >= c}) f` (fun th -> SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_SPLIT THEN MAP_EVERY EXISTS_TAC [`k:num`; `c:real`] THEN ASM_SIMP_TAC[GSYM HAS_INTEGRAL_INTEGRAL]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &2`) STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I2"))) THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I1"))) THEN EXISTS_TAC `\x. if x$k = c then (d1(x:real^M) INTER d2(x)):real^M->bool else ball(x,abs(x$k - c)) INTER d1(x) INTER d2(x)` THEN CONJ_TAC THENL [REWRITE_TAC[gauge] THEN GEN_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_INTER; IN_INTER; OPEN_BALL; IN_BALL] THEN ASM_REWRITE_TAC[DIST_REFL; GSYM REAL_ABS_NZ; REAL_SUB_0]; ALL_TAC] THEN X_GEN_TAC `f:real^M->real^N` THEN X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `(!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {}) ==> x$k <= c) /\ (!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {}) ==> x$k >= c)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL; real_ge] THEN DISCH_THEN (MP_TAC o MATCH_MP (SET_RULE `k SUBSET (a INTER b) ==> k SUBSET a`)) THEN REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M` MP_TAC) THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((x - u:real^M)$k)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "I2" (MP_TAC o SPEC `{(x:real^M,kk INTER {x:real^M | x$k >= c}) |x,kk| (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {})}` o SPEC `f:real^M->real^N`) THEN REMOVE_THEN "I1" (MP_TAC o SPEC `{(x:real^M,kk INTER {x:real^M | x$k <= c}) |x,kk| (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {})}` o SPEC `f:real^M->real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(a /\ b) /\ (a' /\ b' ==> c) ==> (a ==> a') ==> (b ==> b') ==> c`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN REPEAT(MATCH_MP_TAC(TAUT `(a ==> (a' /\ a'')) /\ (b ==> (b' /\ d) /\ (b'' /\ e)) ==> a /\ b ==> ((a' /\ b') /\ d) /\ ((a'' /\ b'') /\ e)`) THEN CONJ_TAC) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[lemma1] THEN REWRITE_TAC[IMP_IMP] THENL [SIMP_TAC[lemma2]; REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN DISCH_THEN(fun th -> CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN (MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[INTERVAL_SPLIT]; DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN (REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s' INTER t' = {} ==> s INTER t = {}`) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]); ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ d /\ e ==> (a ==> (b /\ d) /\ (c /\ e))`) THEN CONJ_TAC THENL [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_UNIONS] THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS] THEN X_GEN_TAC `x:real^M` THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `kk:real^M->bool` THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[NOT_IN_EMPTY]; ALL_TAC] THEN CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN REWRITE_TAC[fine; lemma1] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`)) THEN DISCH_THEN(MP_TAC o MATCH_MP NORM_TRIANGLE_LT) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_ARITH `(a - i) + (b - j) = c - (i + j) <=> a + b = c:real^N`] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum p (\(x,l). content (l INTER {x:real^M | x$k <= c}) % (f:real^M->real^N) x) + vsum p (\(x,l). content (l INTER {x:real^M | x$k >= c}) % (f:real^M->real^N) x)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[GSYM VSUM_ADD] THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM; GSYM VECTOR_ADD_RDISTRIB] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`] o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM CONTENT_SPLIT]] THEN ASM_SIMP_TAC[lemma3] THEN BINOP_TAC THEN (GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [lemma4] THEN MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[TAGGED_DIVISION_SPLIT_LEFT_INJ; VECTOR_MUL_LZERO; TAGGED_DIVISION_SPLIT_RIGHT_INJ]));; let EQUIINTEGRABLE_DIVISION = prove (`!fs:(real^M->real^N)->bool d a b. d division_of interval[a,b] ==> (fs equiintegrable_on interval[a,b] <=> !i. i IN d ==> fs equiintegrable_on i)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC OPERATIVE_DIVISION_AND THEN ASM_REWRITE_TAC[operative; NEUTRAL_AND] THEN POP_ASSUM_LIST(K ALL_TAC) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN ASM_SIMP_TAC[equiintegrable_on; INTEGRABLE_ON_NULL] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `\x:real^M. ball(x,&1)` THEN ASM_SIMP_TAC[GAUGE_TRIVIAL; INTEGRAL_NULL; VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `&0 < e ==> x = vec 0 ==> norm x < e`)) THEN MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF]) THEN ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR; SUBSET_INTERIOR; SET_RULE `s = {} <=> s SUBSET {}`]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real`; `k:num`] THEN STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[EQUIINTEGRABLE_ON_SPLIT]] THEN ASM_SIMP_TAC[INTEGRABLE_SPLIT; equiintegrable_on] THEN STRIP_TAC THEN CONJ_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN (FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN ASM_CASES_TAC `gauge(d:real^M->real^M->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN ASM_CASES_TAC `(f:real^M->real^N) IN fs` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `d:real^M->real^M->bool`; `e / &2`] HENSTOCK_LEMMA_PART1) THEN ASM_SIMP_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_OF_SUBSET THEN RULE_ASSUM_TAC(REWRITE_RULE[tagged_division_of]) THEN ASM_MESON_TAC[INTER_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `&0 < e /\ x:real^N = y ==> norm(x) <= e / &2 ==> norm(y) < e`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN o rand o rand o snd) THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT; INTEGRABLE_SPLIT] THEN DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM VSUM_SUB] THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM]));; (* ------------------------------------------------------------------------- *) (* Main limit theorem for an equiintegrable sequence. *) (* ------------------------------------------------------------------------- *) let EQUIINTEGRABLE_LIMIT = prove (`!f g:real^M->real^N a b. {f n | n IN (:num)} equiintegrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> ((\n. f n x) --> g x) sequentially) ==> g integrable_on interval[a,b] /\ ((\n. integral(interval[a,b]) (f n)) --> integral(interval[a,b]) g) sequentially`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THEN ASM_SIMP_TAC[INTEGRABLE_ON_NULL; INTEGRAL_NULL; LIM_CONST] THEN SUBGOAL_THEN `cauchy (\n. integral(interval[a,b]) (f n :real^M->real^N))` MP_TAC THENL [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_UNIV] THEN DISCH_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN DISCH_THEN(X_CHOOSE_THEN `p:(real^M#(real^M->bool))->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPECL [`n:num`; `p:(real^M#(real^M->bool))->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `cauchy (\n. vsum p (\(x,k:real^M->bool). content k % (f:num->real^M->real^N) n x))` MP_TAC THENL [MATCH_MP_TAC CONVERGENT_IMP_CAUCHY THEN EXISTS_TAC `vsum p (\(x,k:real^M->bool). content k % (g:real^M->real^N) x)` THEN MATCH_MP_TAC (REWRITE_RULE[LAMBDA_PAIR_THM] (REWRITE_RULE[FORALL_PAIR_THM] (ISPECL [`sequentially`; `\(x:real^M,k:real^M->bool) (n:num). content k % (f n x:real^N)`] LIM_VSUM))) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN ASM_SIMP_TAC[SUBSET] THEN ASM_MESON_TAC[]; REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; GE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `N:num <= m /\ N <= n` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(sm - gm:real^N) < e / &3 /\ norm(sn - gn) < e / &3 ==> dist(sm,sn) < e / &3 ==> dist(gm,gn) < e`) THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN SUBGOAL_THEN `((g:real^M->real^N) has_integral l) (interval[a,b])` (fun th -> ASM_MESON_TAC[th; integrable_on; INTEGRAL_UNIQUE]) THEN REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_UNIV] THEN DISCH_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n:num. vsum p (\(x,k:real^M->bool). content k % f n x) - integral (interval [a,b]) (f n :real^M->real^N)` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; REAL_LT_IMP_LE] THEN REWRITE_TAC[EVENTUALLY_TRUE] THEN MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN MATCH_MP_TAC (REWRITE_RULE[LAMBDA_PAIR_THM] (REWRITE_RULE[FORALL_PAIR_THM] (ISPECL [`sequentially`; `\(x:real^M,k:real^M->bool) (n:num). content k % (f n x:real^N)`] LIM_VSUM))) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN ASM_SIMP_TAC[SUBSET] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Combining theorems for the set of equiintegrable functions. *) (* ------------------------------------------------------------------------- *) let EQUIINTEGRABLE_SUBSET = prove (`!fs gs s. fs equiintegrable_on s /\ gs SUBSET fs ==> gs equiintegrable_on s`, REWRITE_TAC[equiintegrable_on; SUBSET] THEN MESON_TAC[]);; let EQUIINTEGRABLE_UNION = prove (`!fs:(real^M->real^N)->bool gs s. fs equiintegrable_on s /\ gs equiintegrable_on s ==> (fs UNION gs) equiintegrable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on; IN_UNION] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `e:real`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. (d1:real^M->real^M->bool) x INTER d2 x` THEN ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);; let EQUIINTEGRABLE_EQ = prove (`!fs gs:(real^M->real^N)->bool s. fs equiintegrable_on s /\ (!g. g IN gs ==> ?f. f IN fs /\ (!x. x IN s ==> f x = g x)) ==> gs equiintegrable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (LABEL_TAC "*")) THEN CONJ_TAC THENL [X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `g:real^M->real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^M->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f:real^M->real^N`) THEN ASM_MESON_TAC[INTEGRABLE_SPIKE; IN_DIFF; NEGLIGIBLE_EMPTY]; X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`g:real^M->real^N`;`p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `g:real^M->real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^M->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`f:real^M->real^N`;`p:(real^M#(real^M->bool))->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `x:real^N = y /\ a = b ==> norm(x - a) < e ==> norm(y - b) < e`) THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF; SUBSET]) THEN ASM_MESON_TAC[]; ASM_MESON_TAC[INTEGRAL_EQ]]]);; let EQUIINTEGRABLE_CMUL = prove (`!fs:(real^M->real^N)->bool s k. fs equiintegrable_on s ==> {(\x. c % f x) | abs(c) <= k /\ f IN fs} equiintegrable_on s`, REPEAT GEN_TAC THEN SIMP_TAC[equiintegrable_on; INTEGRABLE_CMUL; FORALL_IN_GSPEC] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; INTEGRAL_CMUL; IMP_IMP] THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs(k) + &1)`) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_MUL_LZERO; REAL_ARITH `&0 < abs(k) + &1`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`c:real`; `f:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`f:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x <= c * y ==> x <= y * (c + &1)`) THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `!c. x = c * y /\ c * y <= k * y ==> x <= k * y`) THEN EXISTS_TAC `abs c:real` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM NORM_MUL; GSYM VSUM_LMUL; VECTOR_SUB_LDISTRIB] THEN REWRITE_TAC[LAMBDA_PAIR_THM; VECTOR_MUL_ASSOC; REAL_MUL_SYM]; MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC]);; let EQUIINTEGRABLE_ADD = prove (`!fs:(real^M->real^N)->bool gs s. fs equiintegrable_on s /\ gs equiintegrable_on s ==> {(\x. f x + g x) | f IN fs /\ g IN gs} equiintegrable_on s`, REPEAT GEN_TAC THEN SIMP_TAC[equiintegrable_on; INTEGRABLE_ADD; FORALL_IN_GSPEC] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "f")) (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "g"))) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; INTEGRAL_ADD; IMP_IMP] THEN REMOVE_THEN "g" (MP_TAC o SPEC `e / &2`) THEN REMOVE_THEN "f" (MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "f"))) THEN DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "g"))) THEN EXISTS_TAC `\x. (d1:real^M->real^M->bool) x INTER d2 x` THEN ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN REMOVE_THEN "g" (MP_TAC o SPECL [`g:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`]) THEN REMOVE_THEN "f" (MP_TAC o SPECL [`f:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `s + s' = t ==> norm(s - i) < e / &2 ==> norm(s' - i') < e / &2 ==> norm(t - (i + i')) < e`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM VSUM_ADD] THEN REWRITE_TAC[LAMBDA_PAIR_THM; VECTOR_ADD_LDISTRIB]);; let EQUIINTEGRABLE_NEG = prove (`!fs:(real^M->real^N)->bool s. fs equiintegrable_on s ==> {(\x. --(f x)) | f IN fs} equiintegrable_on s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&1` o MATCH_MP EQUIINTEGRABLE_CMUL) THEN MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_TAC THEN EXISTS_TAC `-- &1` THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VECTOR_MUL_LID] THEN REAL_ARITH_TAC);; let EQUIINTEGRABLE_SUB = prove (`!fs:(real^M->real^N)->bool gs s. fs equiintegrable_on s /\ gs equiintegrable_on s ==> {(\x. f x - g x) | f IN fs /\ g IN gs} equiintegrable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (MP_TAC o MATCH_MP EQUIINTEGRABLE_NEG)) THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_ADD) THEN MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN EXISTS_TAC `\x. --((g:real^M->real^N) x)` THEN ASM_REWRITE_TAC[VECTOR_SUB] THEN EXISTS_TAC `g:real^M->real^N` THEN ASM_REWRITE_TAC[]);; let EQUIINTEGRABLE_SUM = prove (`!fs:(real^M->real^N)->bool a b. fs equiintegrable_on interval[a,b] ==> {(\x. vsum t (\i. c i % f i x)) | FINITE t /\ (!i:A. i IN t ==> &0 <= c i /\ (f i) IN fs) /\ sum t c = &1} equiintegrable_on interval[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; RIGHT_IMP_FORALL_THM] THEN STRIP_TAC THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [INTEGRABLE_CMUL; INTEGRABLE_VSUM; ETA_AX; INTEGRAL_VSUM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`t:A->bool`; `c:A->real`; `f:A->real^M->real^N`; `p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `!i:A. i IN t ==> integral (interval[a,b]) (\x:real^M. c i % f i x:real^N) = vsum p (\(x:real^M,k). integral (k:real^M->bool) (\x:real^M. c i % f i x))` (fun th -> SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN ASM_SIMP_TAC[INTEGRABLE_CMUL; ETA_AX]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN SUBGOAL_THEN `vsum p (\(x,k:real^M->bool). content k % vsum t (\i. c i % f i x)) = vsum t (\i. c i % vsum p (\(x,k). content k % (f:A->real^M->real^N) i x))` SUBST1_TAC THENL [REWRITE_TAC[GSYM VSUM_LMUL] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o rand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum t (\i:A. c i * e / &2)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_RMUL; ETA_AX; REAL_MUL_LID] THEN ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[GSYM VSUM_SUB] THEN MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM VSUM_LMUL; GSYM VSUM_SUB] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(f:A->real^M->real^N) i`; `p:(real^M#(real^M->bool))->bool`]) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN DISCH_THEN(MP_TAC o SPEC `abs((c:A->real) i)` o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_LMUL)) THEN ASM_REWRITE_TAC[REAL_ABS_POS; GSYM NORM_MUL] THEN ASM_SIMP_TAC[GSYM VSUM_LMUL; VECTOR_SUB_LDISTRIB; real_abs] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= a ==> y <= a`) THEN AP_TERM_TAC THEN SUBGOAL_THEN `integral (interval[a,b]) ((f:A->real^M->real^N) i) = vsum p (\(x:real^M,k). integral (k:real^M->bool) (f i))` SUBST1_TAC THENL [MATCH_MP_TAC INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM VSUM_LMUL; GSYM VSUM_SUB] THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_CMUL THEN RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF]) THEN ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL]);; let EQUIINTEGRABLE_UNIFORM_LIMIT = prove (`!fs:(real^M->real^N)->bool a b. fs equiintegrable_on interval[a,b] ==> {g | !e. &0 < e ==> ?f. f IN fs /\ !x. x IN interval[a,b] ==> norm(g x - f x) < e} equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN REWRITE_TAC[equiintegrable_on; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[INTEGRABLE_UNIFORM_LIMIT; REAL_LT_IMP_LE]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`g:real^M->real^N`;`p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN SUBGOAL_THEN `(g:real^M->real^N) integrable_on interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[INTEGRABLE_UNIFORM_LIMIT; REAL_LT_IMP_LE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:num->real^M->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN interval[a,b] ==> ((\n. f n x) --> (g:real^M->real^N) x) sequentially` ASSUME_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN MP_TAC(SPEC `k:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,b) = norm(b - a)`] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`f:num->real^M->real^N`; `g:real^M->real^N`; `a:real^M`; `b:real^M`] EQUIINTEGRABLE_LIMIT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQUIINTEGRABLE_SUBSET THEN EXISTS_TAC `fs:(real^M->real^N)->bool` THEN ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN SUBGOAL_THEN `((\n. vsum p (\(x,k:real^M->bool). content k % (f:num->real^M->real^N) n x)) --> vsum p (\(x,k). content k % g x)) sequentially` (LABEL_TAC "+") THENL [MATCH_MP_TAC (REWRITE_RULE[LAMBDA_PAIR_THM] (REWRITE_RULE[FORALL_PAIR_THM] (ISPECL [`sequentially`; `\(x:real^M,k:real^M->bool) (n:num). content k % (f n x:real^N)`] LIM_VSUM))) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN ASM_SIMP_TAC[SUBSET] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[dist]] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "*")) THEN REMOVE_THEN "+" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[dist]] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "+")) THEN SUBGOAL_THEN `?n:num. N1 <= n /\ N2 <= n` STRIP_ASSUME_TAC THENL [EXISTS_TAC `N1 + N2:num` THEN ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN REMOVE_THEN "+" (MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(f:num->real^M->real^N) n`;`p:(real^M#(real^M->bool))->bool`]) THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let EQUIINTEGRABLE_REFLECT = prove (`!fs:(real^M->real^N)->bool a b. fs equiintegrable_on interval[a,b] ==> {(\x. f(--x)) | f IN fs} equiintegrable_on interval[--b,--a]`, let lemma = prove (`(!x k. (x,k) IN IMAGE (\(x,k). f x k,g x k) s ==> Q x k) <=> (!x k. (x,k) IN s ==> Q (f x k) (g x k))`, REWRITE_TAC[IN_IMAGE; PAIR_EQ; EXISTS_PAIR_THM] THEN SET_TAC[]) in REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[INTEGRABLE_REFLECT; INTEGRAL_REFLECT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. IMAGE (--) ((d:real^M->real^M->bool) (--x))` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN SIMP_TAC[gauge; OPEN_NEGATIONS] THEN DISCH_TAC THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_NEG] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_TAC THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f:real^M->real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\(x,k). (--x:real^M,IMAGE (--) (k:real^M->bool))) p`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN STRIP_TAC THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; lemma] THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN ASM_SIMP_TAC[VECTOR_NEG_NEG; GSYM SUBSET] THEN ASM_MESON_TAC[]; REWRITE_TAC[EXTENSION; IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = --y <=> --x = y`] THEN ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN REWRITE_TAC[UNWIND_THM1] THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]]; MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`y:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`; `y:real^M`; `l:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [MESON_TAC[PAIR_EQ]; ALL_TAC] THEN REWRITE_TAC[INTERIOR_NEGATIONS] THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) ==> s INTER t = {} ==> IMAGE f s INTER IMAGE f t = {}`) THEN REWRITE_TAC[VECTOR_NEG_NEG]; GEN_REWRITE_TAC I [EXTENSION] THEN ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MATCH_MP_TAC(MESON[] `!f. (!x. f(f x) = x) /\ (!x. P x <=> Q(f x)) ==> ((?x. P x) <=> (?x. Q x))`) THEN EXISTS_TAC `IMAGE ((--):real^M->real^M)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_NEG_NEG; IMAGE_ID]; ALL_TAC] THEN X_GEN_TAC `t:real^M->bool` THEN BINOP_TAC THENL [REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN SUBGOAL_THEN `!k:real^M->bool. IMAGE (--) (IMAGE (--) k) = k` MP_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_NEG_NEG; IMAGE_ID]; MESON_TAC[]]; MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) ==> (y IN s <=> f y IN IMAGE f s)`) THEN REWRITE_TAC[VECTOR_NEG_NEG]]]; ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN REWRITE_TAC[fine; lemma] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) ==> k SUBSET IMAGE f s ==> IMAGE f k SUBSET s`) THEN REWRITE_TAC[VECTOR_NEG_NEG]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `x:real^N = y ==> norm(x - i) < e ==> norm(y - i) < e`) THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhs o snd) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC(MESON[] `(!x. f(f x) = x) ==> !x y. x IN p /\ y IN p /\ f x = f y ==> x = y`) THEN REWRITE_TAC[FORALL_PAIR_THM; GSYM IMAGE_o; o_DEF; VECTOR_NEG_NEG; IMAGE_ID]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM; o_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `(--):real^M->real^M = (\x. --(&1) % x + vec 0)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[CONTENT_IMAGE_AFFINITY_INTERVAL; REAL_ABS_NEG] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; REAL_ABS_NUM]]]);; (* ------------------------------------------------------------------------- *) (* Some technical lemmas about minimizing a "flat" part of a sum over a *) (* division, followed by subinterval resictions for equiintegrable family. *) (* ------------------------------------------------------------------------- *) let SUM_CONTENT_AREA_OVER_THIN_DIVISION = prove (`!d a b:real^M s i c. d division_of s /\ s SUBSET interval[a,b] /\ 1 <= i /\ i <= dimindex(:M) /\ a$i <= c /\ c <= b$i /\ (!k. k IN d ==> ~(k INTER {x | x$i = c} = {})) ==> (b$i - a$i) * sum d (\k. content k / (interval_upperbound k$i - interval_lowerbound k$i)) <= &2 * content(interval[a,b])`, let lemma0 = prove (`!k:real^M->bool i. 1 <= i /\ i <= dimindex(:M) ==> content k / (interval_upperbound k$i - interval_lowerbound k$i) = if content k = &0 then &0 else product ((1..dimindex(:M)) DELETE i) (\j. interval_upperbound k$j - interval_lowerbound k$j)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[content] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[CONTENT_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `1..dimindex(:M) = i INSERT ((1..dimindex(:M)) DELETE i)` MP_TAC THENL [REWRITE_TAC[SET_RULE `s = x INSERT (s DELETE x) <=> x IN s`] THEN ASM_REWRITE_TAC[IN_NUMSEG]; DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])] THEN ASM_SIMP_TAC[PRODUCT_CLAUSES; IN_NUMSEG; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN MATCH_MP_TAC(REAL_FIELD `~(y = &0) ==> (y * x) * inv y = x`) THEN DISCH_TAC THEN UNDISCH_TAC `~(content(k:real^M->bool) = &0)` THEN ASM_REWRITE_TAC[content; PRODUCT_EQ_0_NUMSEG] THEN ASM_MESON_TAC[]) and lemma1 = prove (`!d a b:real^M s i. d division_of s /\ s SUBSET interval[a,b] /\ 1 <= i /\ i <= dimindex(:M) /\ ((!k. k IN d ==> ~(content k = &0) /\ ~(k INTER {x | x$i = a$i} = {})) \/ (!k. k IN d ==> ~(content k = &0) /\ ~(k INTER {x | x$i = b$i} = {}))) ==> (b$i - a$i) * sum d (\k. content k / (interval_upperbound k$i - interval_lowerbound k$i)) <= content(interval[a,b])`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ABBREV_TAC `extend = \k:real^M->bool. interval [(lambda j. if j = i then (a:real^M)$i else interval_lowerbound k$j):real^M, (lambda j. if j = i then (b:real^M)$i else interval_upperbound k$j)]` THEN SUBGOAL_THEN `!k. k IN d ==> k SUBSET interval[a:real^M,b]` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k:real^M->bool. k IN d ==> ~(k = {})` ASSUME_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN SUBGOAL_THEN `(!k. k IN d ==> ~((extend:(real^M->bool)->(real^M->bool)) k = {})) /\ (!k. k IN d ==> extend k SUBSET interval[a,b])` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN (DISCH_TAC THEN EXPAND_TAC "extend" THEN SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b]` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(interval[u:real^M,v] = {})` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN SIMP_TAC[SUBSET_INTERVAL; INTERVAL_NE_EMPTY; LAMBDA_BETA; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]); ALL_TAC] THEN SUBGOAL_THEN `!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) ==> interior((extend:(real^M->bool)->(real^M->bool)) k1) INTER interior(extend k2) = {}` ASSUME_TAC THENL [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^M`; `z:real^M`] THEN DISCH_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL [`interval[u:real^M,v]`; `interval[w:real^M,z]`]) THEN ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXPAND_TAC "extend" THEN SIMP_TAC[INTERIOR_CLOSED_INTERVAL; IN_INTERVAL; LAMBDA_BETA] THEN SUBGOAL_THEN `~(interval[u:real^M,v] = {}) /\ ~(interval[w:real^M,z] = {})` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN SIMP_TAC[SUBSET_INTERVAL; INTERVAL_NE_EMPTY; LAMBDA_BETA; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` MP_TAC) THEN MP_TAC(MESON[] `(!P. (!j:num. P j) <=> P i /\ (!j. ~(j = i) ==> P j))`) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN ASM_SIMP_TAC[IMP_IMP] THEN STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_THEN (fun th -> MP_TAC(SPEC `interval[u:real^M,v]` th) THEN MP_TAC(SPEC `interval[w:real^M,z]` th))) THEN ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL] THEN REWRITE_TAC[IMP_CONJ; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:real^M` THEN STRIP_TAC THEN X_GEN_TAC `r:real^M` THEN STRIP_TAC THEN X_GEN_TAC `s:real^M` THEN STRIP_TAC THEN X_GEN_TAC `t:real^M` THEN STRIP_TAC THENL [EXISTS_TAC `(lambda j. if j = i then min ((q:real^M)$i) ((s:real^M)$i) else (x:real^M)$j):real^M`; EXISTS_TAC `(lambda j. if j = i then max ((q:real^M)$i) ((s:real^M)$i) else (x:real^M)$j):real^M`] THEN (SIMP_TAC[AND_FORALL_THM; LAMBDA_BETA] THEN X_GEN_TAC `j:num` THEN ASM_CASES_TAC `j:num = i` THEN ASM_SIMP_TAC[] THEN UNDISCH_THEN `j:num = i` SUBST_ALL_TAC THEN SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b] /\ interval[w:real^M,z] SUBSET interval[a,b]` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(interval[u:real^M,v] = {}) /\ ~(interval[w:real^M,z] = {})` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC); ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (IMAGE (extend:(real^M->bool)->(real^M->bool)) d) content` THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k1:real^M->bool`; `k2:real^M->bool`]) THEN ASM_REWRITE_TAC[INTER_IDEMPOT] THEN EXPAND_TAC "extend" THEN REWRITE_TAC[CONTENT_EQ_0_INTERIOR]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THEN ASM_CASES_TAC `content(interval[u:real^M,v]) = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; o_THM] THEN EXPAND_TAC "extend" THEN REWRITE_TAC[CONTENT_POS_LE]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE; real_div; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN SUBGOAL_THEN `~((extend:(real^M->bool)->(real^M->bool)) (interval[u,v]) = {})` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN EXPAND_TAC "extend" THEN ASM_SIMP_TAC[content; o_THM] THEN ASM_SIMP_TAC[INTERVAL_NE_EMPTY; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `1..dimindex(:M) = i INSERT ((1..dimindex(:M)) DELETE i)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_DELETE] THEN ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(REAL_RING `x:real = y ==> ab * uv * x = (ab * y) * uv`) THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA]]; MATCH_MP_TAC SUBADDITIVE_CONTENT_DIVISION THEN EXISTS_TAC `UNIONS (IMAGE (extend:(real^M->bool)->(real^M->bool)) d)` THEN ASM_SIMP_TAC[UNIONS_SUBSET; division_of; FINITE_IMAGE] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN EXPAND_TAC "extend" THEN REWRITE_TAC[] THEN MESON_TAC[]; ASM_MESON_TAC[]; ASM_SIMP_TAC[]]]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THENL [MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 <= y ==> x <= &2 * y`) THEN REWRITE_TAC[CONTENT_POS_LE; REAL_ENTIRE] THEN DISJ2_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN MATCH_MP_TAC CONTENT_0_SUBSET THEN MAP_EVERY EXISTS_TAC [`a:real^M`; `b:real^M`] THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN MP_TAC(ISPECL [`{k | k IN {l INTER {x | x$i <= c} | l | l IN d /\ ~(l INTER {x:real^M | x$i <= c} = {})} /\ ~(content k = &0)}`; `a:real^M`; `(lambda j. if j = i then c else (b:real^M)$j):real^M`; `UNIONS {k | k IN {l INTER {x | x$i <= c} | l | l IN d /\ ~(l INTER {x:real^M | x$i <= c} = {})} /\ ~(content k = &0)}`; `i:num`] lemma1) THEN MP_TAC(ISPECL [`{k | k IN {l INTER {x | x$i >= c} | l | l IN d /\ ~(l INTER {x:real^M | x$i >= c} = {})} /\ ~(content k = &0)}`; `(lambda j. if j = i then c else (a:real^M)$j):real^M`; `b:real^M`; `UNIONS {k | k IN {l INTER {x | x$i >= c} | l | l IN d /\ ~(l INTER {x:real^M | x$i >= c} = {})} /\ ~(content k = &0)}`; `i:num`] lemma1) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p2 ==> q2) ==> (p1 ==> q1) ==> r`) THEN CONJ_TAC THENL [CONJ_TAC THEN (REPEAT CONJ_TAC THENL [REWRITE_TAC[division_of] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_RESTRICT THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN CONJ_TAC THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM; SUBSET; IN_UNIONS] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]]; X_GEN_TAC `k:real^M->bool` THEN REPEAT DISCH_TAC THEN X_GEN_TAC `l:real^M->bool` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`k:real^M->bool`; `l:real^M->bool`] o el 2 o CONJUNCTS) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s' INTER t' = {} ==> s INTER t = {}`) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN X_GEN_TAC `k:real^M->bool` THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `k SUBSET interval[a:real^M,b]` MP_TAC THENL [ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `i INTER h SUBSET j ==> k SUBSET i ==> k INTER h SUBSET j`) THEN ASM_SIMP_TAC[INTERVAL_SPLIT; SUBSET_INTERVAL; LAMBDA_BETA] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REAL_ARITH_TAC; ALL_TAC]) THENL [DISJ2_TAC; DISJ1_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN ASM_SIMP_TAC[LAMBDA_BETA; real_ge] THEN ASM SET_TAC[REAL_LE_REFL]; ASM_SIMP_TAC[LAMBDA_BETA]] THEN SUBGOAL_THEN `sum {k | k IN { l INTER {x | x$i <= c} | l | l IN d /\ ~(l INTER {x:real^M | x$i <= c} = {})} /\ ~(content k = &0)} (\k. content k / (interval_upperbound k$i - interval_lowerbound k$i)) = sum d ((\k. content k / (interval_upperbound k$i - interval_lowerbound k$i)) o (\k. k INTER {x | x$i <= c})) /\ sum {k | k IN { l INTER {x | x$i >= c} | l | l IN d /\ ~(l INTER {x:real^M | x$i >= c} = {})} /\ ~(content k = &0)} (\k. content k / (interval_upperbound k$i - interval_lowerbound k$i)) = sum d ((\k. content k / (interval_upperbound k$i - interval_lowerbound k$i)) o (\k. k INTER {x | x$i >= c}))` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN (W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE_NONZERO o rand o snd) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `l:real^M->bool`] THEN STRIP_TAC THEN REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN (MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ ORELSE MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ) THEN ASM_MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `x IN IMAGE f d /\ ~(x IN {x | x IN {f y |y| y IN d /\ ~(f y = a)} /\ ~P x}) ==> (!y. f y = a ==> P(f y)) ==> P x`)) THEN SIMP_TAC[CONTENT_EMPTY; real_div; REAL_MUL_LZERO]]); ALL_TAC] THEN MAP_EVERY (fun (t,tac) -> ASM_CASES_TAC t THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN DISCH_THEN(MP_TAC o tac) THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> x <= a ==> y <= b`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN PURE_REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[real_ge; SET_RULE `k INTER {x | P x} = k <=> (!x. x IN k ==> P x)`] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `x IN interval[a:real^M,b]` MP_TAC THENL [ASM_MESON_TAC[SUBSET; division_of]; ALL_TAC] THEN ASM_SIMP_TAC[IN_INTERVAL]; MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x <= y ==> x <= &2 * y`) THEN REWRITE_TAC[CONTENT_POS_LE] THEN MATCH_MP_TAC CONTENT_SUBSET THEN SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN MESON_TAC[REAL_LE_REFL]]; ALL_TAC]) [`c = (a:real^M)$i`,CONJUNCT2; `c = (b:real^M)$i`,CONJUNCT1] THEN SUBGOAL_THEN `(a:real^M)$i < c /\ c < (b:real^M)$i` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN REWRITE_TAC[REAL_ARITH `(x * &2) / y = &2 * x / y`] THEN MATCH_MP_TAC(REAL_ARITH `s <= s1 + s2 /\ c1 = c /\ c2 = c ==> s1 <= c1 /\ s2 <= c2 ==> s <= &2 * c`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[lemma0] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THEN SUBGOAL_THEN `~(interval[u:real^M,v] = {}) /\ interval[u,v] SUBSET interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC] THEN SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; IMP_CONJ] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ c1 + c2 = c /\ (~(c1 = &0) ==> x1 = x) /\ (~(c2 = &0) ==> x2 = x) ==> (if c = &0 then &0 else x) <= (if c1 = &0 then &0 else x1) + (if c2 = &0 then &0 else x2)`) THEN ASM_SIMP_TAC[GSYM CONTENT_SPLIT] THEN ASM_SIMP_TAC[INTERVAL_SPLIT; CONTENT_POS_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC PRODUCT_POS_LE THEN ASM_SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_DELETE; IN_NUMSEG; INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_SUB_LE]; REWRITE_TAC[CONTENT_EQ_0; REAL_NOT_LE; MESON[] `~(?i. P i /\ Q i /\ R i) <=> (!i. P i /\ Q i ==> ~R i)`] THEN SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_LT_IMP_LE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; IN_DELETE; IN_NUMSEG; LAMBDA_BETA]]; SUBGOAL_THEN `~(interval[a,b] = {}) /\ ~(interval[a:real^M,(lambda j. if j = i then c else b$j)] = {}) /\ ~(interval[(lambda j. if j = i then c else a$j):real^M,b] = {})` MP_TAC THENL [SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; ALL_TAC] THEN SIMP_TAC[content] THEN SIMP_TAC[INTERVAL_NE_EMPTY; INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND] THEN STRIP_TAC THEN SUBGOAL_THEN `1..dimindex(:M) = i INSERT ((1..dimindex(:M)) DELETE i)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_DELETE] THEN ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA] THEN CONJ_TAC THEN MATCH_MP_TAC(REAL_FIELD `y < x /\ z < w /\ a = b ==> ((x - y) * a) / (x - y) = ((w - z) * b) / (w - z)`) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA]]);; let BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION = prove (`!fs f:real^M->real^N a b e. fs equiintegrable_on interval[a,b] /\ f IN fs /\ (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) /\ &0 < e ==> ?d. gauge d /\ !c i p h. c IN interval[a,b] /\ 1 <= i /\ i <= dimindex(:M) /\ p tagged_partial_division_of interval[a,b] /\ d fine p /\ h IN fs /\ (!x k. (x,k) IN p ==> ~(k INTER {x | x$i = c$i} = {})) ==> sum p(\(x,k). norm(integral k h)) < e`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THENL [EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 < e ==> x = &0 ==> x < e`)) THEN MATCH_MP_TAC SUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN GEN_TAC THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v] /\ interval[u,v] SUBSET interval[a,b]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC INTEGRAL_NULL THEN ASM_MESON_TAC[CONTENT_0_SUBSET]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `?d. gauge d /\ !p h. p tagged_partial_division_of interval [a,b] /\ d fine p /\ (h:real^M->real^N) IN fs ==> sum p (\(x,k). norm(content k % h x - integral k h)) < e / &2` (X_CHOOSE_THEN `g0:real^M->real^M->bool` STRIP_ASSUME_TAC) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / &5 / (&(dimindex(:N)) + &1)`)) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &5 /\ &0 < &n + &1`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`p:(real^M#(real^M->bool))->bool`; `h:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:real^M->real^N`; `a:real^M`; `b:real^M`; `g:real^M->real^M->bool`; `e / &5 / (&(dimindex(:N)) + &1)`] HENSTOCK_LEMMA_PART2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &5 /\ &0 < &n + &1`] THEN DISCH_THEN(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> x <= a ==> x < b`) THEN REWRITE_TAC[REAL_ARITH `&2 * d * e / &5 / (d + &1) = (e * &2 / &5 * d) / (d + &1)`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ &0 < e * d ==> e * &2 / &5 * d < e / &2 * (d + &1)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; ALL_TAC] THEN ABBREV_TAC `g:real^M->real^M->bool = \x. g0(x) INTER ball(x,(e / &8 / (norm(f x:real^N) + &1)) * inf(IMAGE (\m. b$m - a$m) (1..dimindex(:M))) / content(interval[a:real^M,b]))` THEN SUBGOAL_THEN `gauge(g:real^M->real^M->bool)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN MATCH_MP_TAC GAUGE_INTER THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_ARITH `&0 < &8 /\ &0 < norm(x:real^N) + &1`] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_LT_INF_FINITE o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FINITE_RESTRICT] THEN SIMP_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; IN_NUMSEG] THEN MESON_TAC[]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[REAL_SUB_LT; IN_NUMSEG; GSYM REAL_ABS_NZ; REAL_SUB_0; IN_ELIM_THM]]; ALL_TAC] THEN EXISTS_TAC `g:real^M->real^M->bool` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `i:num`; `p:(real^M#(real^M->bool))->bool`; `h:real^M->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `interval[c:real^M,b] SUBSET interval[a,b]` ASSUME_TAC THENL [UNDISCH_TAC `c IN interval[a:real^M,b]` THEN SIMP_TAC[IN_INTERVAL; SUBSET_INTERVAL; REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN MP_TAC(ASSUME `(g:real^M->real^M->bool) fine p`) THEN EXPAND_TAC "g" THEN REWRITE_TAC[FINE_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "F")) THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN DISCH_THEN(MP_TAC o SPEC `h:real^M->real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x - y <= e / &2 ==> y < e / &2 ==> x < e`) THEN ASM_SIMP_TAC[GSYM SUM_SUB] THEN ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum p (\(x:real^M,k:real^M->bool). norm(content k % h x:real^N))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN REWRITE_TAC[NORM_ARITH `norm y - norm(x - y:real^N) <= norm x`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum p (\(x:real^M,k). e / &4 * (b$i - a$i) / content(interval[a:real^M,b]) * content(k:real^M->bool) / (interval_upperbound k$i - interval_lowerbound k$i))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN ASM_CASES_TAC `content(k:real^M->bool) = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; VECTOR_MUL_LZERO; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `a * b * content k / d = content k * (a * b) / d`; NORM_MUL] THEN SUBGOAL_THEN `&0 < content(k:real^M->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CONTENT_LT_NZ; tagged_partial_division_of]; ALL_TAC] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC(REAL_ARITH `x + &1 <= y ==> x <= y`) THEN SUBGOAL_THEN `?u v. k = interval[u:real^M,v]` MP_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN MP_TAC(ISPECL [`u:real^M`; `v:real^M`] CONTENT_POS_LT_EQ) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_LT_IMP_LE] THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_RDIV_EQ o snd) THEN ASM_SIMP_TAC[REAL_SUB_LT] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_ARITH `&0 < norm(x:real^N) + &1`] THEN REMOVE_THEN "F" MP_TAC THEN REWRITE_TAC[fine] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `interval[u:real^M,v]`]) THEN ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `v:real^M` th) THEN MP_TAC(SPEC `u:real^M` th)) THEN ASM_SIMP_TAC[INTERVAL_NE_EMPTY; REAL_LT_IMP_LE; ENDS_IN_INTERVAL] THEN REWRITE_TAC[IN_BALL; IMP_IMP] THEN MATCH_MP_TAC(NORM_ARITH `abs(vi - ui) <= norm(v - u:real^N) /\ &2 * a <= b ==> dist(x,u) < a /\ dist(x,v) < a ==> vi - ui <= b`) THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM] THEN REWRITE_TAC[REAL_ARITH `&2 * e / &8 / x * y = e / &4 * y / x`] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[REAL_ARITH `a * inv b * inv c:real = (a / c) / b`] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= e ==> x <= e`) THEN REWRITE_TAC[real_div; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN SIMP_TAC[REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; REAL_LE_INF_FINITE] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_LE_REFL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN ASM_MESON_TAC[REAL_LE_REFL]; REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x + &1 <= abs(y + &1)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[tagged_partial_division_of; SUBSET]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP TAGGED_PARTIAL_DIVISION_OF_UNION_SELF) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhs o rand) th o lhand o snd)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [SIMP_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[SUM_LMUL; REAL_ARITH `e / &4 * ba / c * s <= e / &2 <=> e * (ba * s) / c <= e * &2`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC SUM_CONTENT_AREA_OVER_THIN_DIVISION THEN EXISTS_TAC `UNIONS(IMAGE SND (p:(real^M#(real^M->bool))->bool))` THEN EXISTS_TAC `(c:real^M)$i` THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_TAGGED_DIVISION THEN ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN ASM_MESON_TAC[tagged_partial_division_of]; ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM]]);; let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE = prove (`!fs f:real^M->real^N a b. fs equiintegrable_on interval[a,b] /\ f IN fs /\ (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) ==> { (\x. if x$i <= c then h x else vec 0) | i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } equiintegrable_on interval[a,b]`, let lemma = prove (`(!x k. (x,k) IN IMAGE (\(x,k). f x k,g x k) s ==> Q x k) <=> (!x k. (x,k) IN s ==> Q (f x k) (g x k))`, REWRITE_TAC[IN_IMAGE; PAIR_EQ; EXISTS_PAIR_THM] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THEN ASM_SIMP_TAC[EQUIINTEGRABLE_ON_NULL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN REWRITE_TAC[equiintegrable_on] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_UNIV; IMP_IMP; GSYM CONJ_ASSOC; RIGHT_IMP_FORALL_THM; IN_NUMSEG] THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[equiintegrable_on]) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `x$i <= c <=> x IN {x:real^N | x$i <= c}`] THEN REWRITE_TAC[INTEGRABLE_RESTRICT_INTER] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[INTERVAL_SPLIT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_SIMP_TAC[] THEN SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA; REAL_LE_REFL] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; DISCH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`fs:(real^M->real^N)->bool`; `f:real^M->real^N`; `a:real^M`; `b:real^M`; `e / &12`] BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &12`] THEN DISCH_THEN(X_CHOOSE_THEN `g0:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?d. gauge d /\ !p h. p tagged_partial_division_of interval [a,b] /\ d fine p /\ (h:real^M->real^N) IN fs ==> sum p (\(x,k). norm(content k % h x - integral k h)) < e / &3` (X_CHOOSE_THEN `g1:real^M->real^M->bool` STRIP_ASSUME_TAC) THENL [FIRST_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[equiintegrable_on]) THEN DISCH_THEN(MP_TAC o SPEC `e / &7 / (&(dimindex(:N)) + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &7 /\ &0 < &n + &1`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`p:(real^M#(real^M->bool))->bool`; `h:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:real^M->real^N`; `a:real^M`; `b:real^M`; `d:real^M->real^M->bool`; `e / &7 / (&(dimindex(:N)) + &1)`] HENSTOCK_LEMMA_PART2) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &7 /\ &0 < &n + &1`] THEN DISCH_THEN(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> x <= a ==> x < b`) THEN REWRITE_TAC[REAL_ARITH `&2 * d * e / &7 / (d + &1) = (e * &2 / &7 * d) / (d + &1)`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ &0 < e * d ==> e * &2 / &7 * d < e / &3 * (d + &1)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; ALL_TAC] THEN EXISTS_TAC `\x. (g0:real^M->real^M->bool) x INTER g1 x` THEN ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN MP_TAC(MESON[] `!P. ((!c. (a:real^M)$i <= c /\ c <= (b:real^M)$i ==> P c) ==> (!c. P c)) /\ (!c. (a:real^M)$i <= c /\ c <= (b:real^M)$i ==> P c) ==> !c. P c`) THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `c:real` THEN ASM_CASES_TAC `(a:real^M)$i <= c /\ c <= (b:real^M)$i` THENL [REMOVE_THEN "*" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `(b:real^M)$i`) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^M->real^N` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH `x:real^N = vec 0 /\ y = vec 0 /\ &0 < e ==> norm(x - y) < e`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN SUBGOAL_THEN `(x:real^M) IN interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `integral(interval[a,b]) ((\x. vec 0):real^M->real^N)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[INTEGRAL_0]] THEN MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC(NORM_ARITH `x:real^N = y /\ w = z ==> norm(x - w) < e ==> norm(y - z) < e`) THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^M) IN interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN X_GEN_TAC `c:real` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN ABBREV_TAC `q:(real^M#(real^M->bool))->bool = {(x,k) | (x,k) IN p /\ ~(k INTER {x | x$i <= c} = {})}` THEN MP_TAC(ISPECL [`\x. if x$i <= c then (h:real^M->real^N) x else vec 0`; `a:real^M`; `b:real^M`; `p:(real^M#(real^M->bool))->bool`] INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN ASM_SIMP_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `FINITE(p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN SUBGOAL_THEN `q SUBSET (p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [EXPAND_TAC "q" THEN SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(q:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM VSUM_SUB] THEN ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[] THEN SUBGOAL_THEN `q tagged_partial_division_of interval[a:real^M,b] /\ g0 fine q /\ g1 fine q` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET; tagged_division_of; FINE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `!q. vsum p s = vsum q s /\ norm(vsum q s) < e ==> norm(vsum p s:real^N) < e`) THEN EXISTS_TAC `q:(real^M#(real^M->bool))->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(x:real^M) IN k` ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN REWRITE_TAC[IN_INTER; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_SUB_LZERO] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `integral k ((\x. vec 0):real^M->real^N)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[INTEGRAL_0]] THEN MATCH_MP_TAC INTEGRAL_EQ THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `norm(vsum q (\(x,k). content k % h x - integral k (h:real^M->real^N))) < e / &3` MP_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum q (\(x,k). norm(content k % h x - integral k (h:real^M->real^N)))` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(x - y:real^N) <= &2 * e / &3 ==> norm(x) < e / &3 ==> norm(y) < e`) THEN ASM_SIMP_TAC[GSYM VSUM_SUB] THEN ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[] THEN ABBREV_TAC `r:(real^M#(real^M->bool))->bool = {(x,k) | (x,k) IN q /\ ~(k SUBSET {x | x$i <= c})}` THEN SUBGOAL_THEN `r SUBSET (q:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [EXPAND_TAC "r" THEN SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(r:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `r tagged_partial_division_of interval[a:real^M,b] /\ g0 fine r /\ g1 fine r` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET; FINE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `!r. vsum q s = vsum r s /\ norm(vsum r s) <= e ==> norm(vsum q s:real^N) <= e`) THEN EXISTS_TAC `r:(real^M#(real^M->bool))->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN EXPAND_TAC "r" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(x:real^M) IN k` ASSUME_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `c - i - (c - j):real^N = j - i`] THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN MATCH_MP_TAC INTEGRAL_EQ THEN ASM SET_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[] THEN MAP_EVERY ABBREV_TAC [`s:(real^M#(real^M->bool))->bool = {(x,k) | (x,k) IN r /\ x IN {x | x$i <= c}}`; `t:(real^M#(real^M->bool))->bool = {(x,k) | (x,k) IN r /\ ~(x IN {x | x$i <= c})}`] THEN SUBGOAL_THEN `(s:(real^M#(real^M->bool))->bool) SUBSET r /\ (t:(real^M#(real^M->bool))->bool) SUBSET r` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["s"; "t"] THEN SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(s:(real^M#(real^M->bool))->bool) /\ FINITE(t:(real^M#(real^M->bool))->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `DISJOINT (s:(real^M#(real^M->bool))->bool) t` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["s"; "t"] THEN REWRITE_TAC[EXTENSION; DISJOINT; IN_INTER; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `r:(real^M#(real^M->bool))->bool = s UNION t` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["s"; "t"] THEN REWRITE_TAC[EXTENSION; IN_UNION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_UNION] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\(x:real^M,k). norm (integral k (h:real^M->real^N) - integral k (\x. if x$i <= c then h x else vec 0))) + sum t (\(x:real^M,k). norm ((content k % (h:real^M->real^N) x - integral k h) + integral k (\x. if x$i <= c then h x else vec 0)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN MAP_EVERY EXPAND_TAC ["s"; "t"] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(NORM_ARITH `a:real^N = --b ==> norm a = norm b`) THEN VECTOR_ARITH_TAC; AP_TERM_TAC THEN VECTOR_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `s tagged_partial_division_of interval[a:real^M,b] /\ t tagged_partial_division_of interval[a:real^M,b] /\ g0 fine s /\ g1 fine s /\ g0 fine t /\ g1 fine t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET; FINE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(sum s (\(x:real^M,k). norm(integral k (h:real^M->real^N))) + sum (IMAGE (\(x,k). (x,k INTER {x | x$i <= c})) s) (\(x:real^M,k). norm(integral k (h:real^M->real^N)))) + (sum t (\(x:real^M,k). norm(content k % h x - integral k h)) + sum t (\(x:real^M,k). norm(integral k (h:real^M->real^N))) + sum (IMAGE (\(x,k). (x,k INTER {x | x$i >= c})) t) (\(x:real^M,k). norm(integral k (h:real^M->real^N))))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o rand o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`; `y:real^M`; `l:real^M->bool`] THEN ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[PAIR_EQ] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M#(real^M->bool)->bool`; `UNIONS(IMAGE SND (s:real^M#(real^M->bool)->bool))`; `x:real^M`; `k:real^M->bool`; `y:real^M`; `l:real^M->bool`; `i:num`; `c:real`] TAGGED_DIVISION_SPLIT_LEFT_INJ) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; ALL_TAC] THEN REWRITE_TAC[NORM_EQ_0] THEN SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_SPLIT; INTEGRAL_NULL]; DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[o_THM; FORALL_PAIR_THM] THEN ONCE_REWRITE_TAC[SET_RULE `x$i <= c <=> x IN {x:real^M | x$i <= c}`] THEN REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN REWRITE_TAC[IN_ELIM_THM; INTER_COMM] THEN REWRITE_TAC[NORM_ARITH `norm(a - b:real^N) <= norm a + norm b`]]; W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o rand o rand o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`; `y:real^M`; `l:real^M->bool`] THEN ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[PAIR_EQ] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`t:real^M#(real^M->bool)->bool`; `UNIONS(IMAGE SND (t:real^M#(real^M->bool)->bool))`; `x:real^M`; `k:real^M->bool`; `y:real^M`; `l:real^M->bool`; `i:num`; `c:real`] TAGGED_DIVISION_SPLIT_RIGHT_INJ) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; ALL_TAC] THEN REWRITE_TAC[NORM_EQ_0] THEN SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_SPLIT; INTEGRAL_NULL]; DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[o_THM; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH `i = i1 + i2 ==> norm(c + i1:real^N) <= norm(c) + norm(i) + norm(i2)`) THEN ONCE_REWRITE_TAC[SET_RULE `x$i <= c <=> x IN {x:real^M | x$i <= c}`] THEN REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x} INTER s = s INTER {x | P x}`] THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MATCH_MP_TAC INTEGRAL_SPLIT THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^M,b]` THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[tagged_partial_division_of]]]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^M k. (x,k) IN r ==> ~(k INTER {x:real^M | x$i = c} = {})` ASSUME_TAC THENL [REPEAT GEN_TAC THEN MAP_EVERY EXPAND_TAC ["r"; "q"] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; SUBSET; EXTENSION; NOT_FORALL_THM] THEN REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY; IN_INTER; NOT_IMP] THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TOTAL]] THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN MATCH_MP_TAC CONVEX_CONNECTED THEN REWRITE_TAC[CONVEX_INTERVAL]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= e / &6 /\ y <= e / &2 ==> x + y <= &2 * e / &3`) THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x < e / &12 /\ y < e / &12 ==> x + y <= e / &6`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(lambda j. if j = i then c else (a:real^M)$j):real^M` THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LAMBDA_BETA; IN_INTERVAL] THENL [CONJ_TAC THENL [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN ASM_MESON_TAC[]]; REPEAT CONJ_TAC THENL [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; UNDISCH_TAC `s tagged_partial_division_of interval[a:real^M,b]`; UNDISCH_TAC `(g0:real^M->real^M->bool) fine s` THEN REWRITE_TAC[fine; FORALL_IN_IMAGE; lemma] THEN SET_TAC[]; REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `~(k INTER t = {}) /\ t SUBSET s ==> ~((k INTER s) INTER t = {})`) THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]]; MATCH_MP_TAC(REAL_ARITH `x < e / &3 /\ y < e / &12 /\ z < e / &12 ==> x + y + z <= e / &2`) THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(lambda j. if j = i then c else (a:real^M)$j):real^M` THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LAMBDA_BETA; IN_INTERVAL] THENL [CONJ_TAC THENL [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN ASM_MESON_TAC[]]; REPEAT CONJ_TAC THENL [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; UNDISCH_TAC `t tagged_partial_division_of interval[a:real^M,b]`; UNDISCH_TAC `(g0:real^M->real^M->bool) fine t` THEN REWRITE_TAC[fine; FORALL_IN_IMAGE; lemma] THEN SET_TAC[]; REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `~(k INTER t = {}) /\ t SUBSET s ==> ~((k INTER s) INTER t = {})`) THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL; real_ge] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]]] THEN REWRITE_TAC[tagged_partial_division_of] THEN (MATCH_MP_TAC MONO_AND THEN SIMP_TAC[FINITE_IMAGE] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN REWRITE_TAC[lemma] THEN CONJ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SIMP_TAC[real_ge; IN_INTER; IN_ELIM_THM] THEN ASM SET_TAC[REAL_LE_TOTAL]; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[]; STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]]]; REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[PAIR_EQ; CONTRAPOS_THM] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s' INTER t' = {} ==> s INTER t = {}`) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[INTER_SUBSET]]));; let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE = prove (`!fs f:real^M->real^N a b. fs equiintegrable_on interval[a,b] /\ f IN fs /\ (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) ==> { (\x. if x$i >= c then h x else vec 0) | i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{\x. (f:real^M->real^N) (--x) | f IN fs}`; `\x. (f:real^M->real^N)(--x)`; `--b:real^M`; `--a:real^M`] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE) THEN ASM_SIMP_TAC[EQUIINTEGRABLE_REFLECT] THEN ANTS_TAC THENL [ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN ASM_SIMP_TAC[VECTOR_NEG_NEG] THEN REWRITE_TAC[SIMPLE_IMAGE; IN_IMAGE] THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_REFLECT) THEN REWRITE_TAC[VECTOR_NEG_NEG] THEN MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `(\x. if (--x)$i >= c then (h:real^M->real^N)(--x) else vec 0)` THEN REWRITE_TAC[VECTOR_NEG_NEG] THEN MAP_EVERY EXISTS_TAC [`i:num`; `--c:real`; `\x. (h:real^M->real^N)(--x)`] THEN ASM_REWRITE_TAC[IN_UNIV; VECTOR_NEG_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `--x >= c <=> x <= --c`] THEN EXISTS_TAC `h:real^M->real^N` THEN ASM_REWRITE_TAC[]]);; let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT = prove (`!fs f:real^M->real^N a b. fs equiintegrable_on interval[a,b] /\ f IN fs /\ (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) ==> { (\x. if x$i < c then h x else vec 0) | i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`fs:(real^M->real^N)->bool`; `f:real^M->real^N`; `a:real^M`; `b:real^M`] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(fs:(real^M->real^N)->bool) equiintegrable_on interval[a,b]` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_SUB) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `h:real^M->real^N` THEN EXISTS_TAC `\x. if x$i >= c then (h:real^M->real^N) x else vec 0` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[FUN_EQ_THM; real_ge; GSYM REAL_NOT_LT] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC]);; let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT = prove (`!fs f:real^M->real^N a b. fs equiintegrable_on interval[a,b] /\ f IN fs /\ (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) ==> { (\x. if x$i > c then h x else vec 0) | i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`fs:(real^M->real^N)->bool`; `f:real^M->real^N`; `a:real^M`; `b:real^M`] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(fs:(real^M->real^N)->bool) equiintegrable_on interval[a,b]` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_SUB) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `h:real^M->real^N` THEN EXISTS_TAC `\x. if x$i <= c then (h:real^M->real^N) x else vec 0` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[FUN_EQ_THM; real_gt; GSYM REAL_NOT_LE] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC]);; let EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] ==> { (\x. if x IN interval(c,d) then f x else vec 0) | c IN (:real^M) /\ d IN (:real^M) } equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. n <= dimindex(:M) ==> f INSERT { (\x. if !i. 1 <= i /\ i <= n ==> c$i < x$i /\ x$i < d$i then (f:real^M->real^N) x else vec 0) | c IN (:real^M) /\ d IN (:real^M) } equiintegrable_on interval[a,b]` MP_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN ASM_REWRITE_TAC[ETA_AX; EQUIINTEGRABLE_ON_SING; SET_RULE `f INSERT {f |c,d| c IN UNIV /\ d IN UNIV} = {f}`] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `SUC n <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT)) THEN REWRITE_TAC[IN_INSERT] THEN ANTS_TAC THENL [REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT)) THEN ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN ANTS_TAC THENL [REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; LEFT_OR_DISTRIB] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; FORALL_AND_THM] THEN SIMP_TAC[IN_UNIV] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]); ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (x INSERT s) SUBSET ({x} UNION t)`) THEN REWRITE_TAC[SUBSET; real_gt; FORALL_IN_GSPEC; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN EXISTS_TAC `(c:real^M)$(SUC n)` THEN MATCH_MP_TAC(MESON[] `(?i c k. P i c k /\ Q (g i c k)) ==> ?h. (h = f \/ ?i c k. P i c k /\ h = g i c k) /\ Q h`) THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN EXISTS_TAC `(d:real^M)$(SUC n)` THEN EXISTS_TAC `\x. if !i. 1 <= i /\ i <= n ==> (c:real^M)$i < x$i /\ x$i < (d:real^M)$i then (f:real^M->real^N) x else vec 0` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN REWRITE_TAC[]; REWRITE_TAC[FUN_EQ_THM; LE] THEN ASM_MESON_TAC[ARITH_RULE `1 <= SUC n`]]; DISCH_THEN(MP_TAC o SPEC `dimindex(:M)`) THEN REWRITE_TAC[IN_INTERVAL; LE_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN SET_TAC[]]);; let EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] ==> { (\x. if x IN interval[c,d] then f x else vec 0) | c IN (:real^M) /\ d IN (:real^M) } equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. n <= dimindex(:M) ==> f INSERT { (\x. if !i. 1 <= i /\ i <= n ==> c$i <= x$i /\ x$i <= d$i then (f:real^M->real^N) x else vec 0) | c IN (:real^M) /\ d IN (:real^M) } equiintegrable_on interval[a,b]` MP_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN ASM_REWRITE_TAC[ETA_AX; EQUIINTEGRABLE_ON_SING; SET_RULE `f INSERT {f |c,d| c IN UNIV /\ d IN UNIV} = {f}`] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `SUC n <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE)) THEN REWRITE_TAC[IN_INSERT] THEN ANTS_TAC THENL [REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE)) THEN ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN ANTS_TAC THENL [REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; LEFT_OR_DISTRIB] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; FORALL_AND_THM] THEN SIMP_TAC[IN_UNIV] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]); ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (x INSERT s) SUBSET ({x} UNION t)`) THEN REWRITE_TAC[SUBSET; real_ge; FORALL_IN_GSPEC; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN EXISTS_TAC `(c:real^M)$(SUC n)` THEN MATCH_MP_TAC(MESON[] `(?i c k. P i c k /\ Q (g i c k)) ==> ?h. (h = f \/ ?i c k. P i c k /\ h = g i c k) /\ Q h`) THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN EXISTS_TAC `(d:real^M)$(SUC n)` THEN EXISTS_TAC `\x. if !i. 1 <= i /\ i <= n ==> (c:real^M)$i <= x$i /\ x$i <= (d:real^M)$i then (f:real^M->real^N) x else vec 0` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN REWRITE_TAC[]; REWRITE_TAC[FUN_EQ_THM; LE] THEN ASM_MESON_TAC[ARITH_RULE `1 <= SUC n`]]; DISCH_THEN(MP_TAC o SPEC `dimindex(:M)`) THEN REWRITE_TAC[IN_INTERVAL; LE_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Continuity of the indefinite integral. *) (* ------------------------------------------------------------------------- *) let INDEFINITE_INTEGRAL_CONTINUOUS = prove (`!f:real^M->real^N a b c d e. f integrable_on interval[a,b] /\ c IN interval[a,b] /\ d IN interval[a,b] /\ &0 < e ==> ?k. &0 < k /\ !c' d'. c' IN interval[a,b] /\ d' IN interval[a,b] /\ norm(c' - c) <= k /\ norm(d' - d) <= k ==> norm(integral(interval[c',d']) f - integral(interval[c,d]) f) < e`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?k. P k /\ Q k) <=> ~(!k. P k ==> ~Q k)`] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN PURE_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; SKOLEM_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LT; GSYM CONJ_ASSOC] THEN MAP_EVERY X_GEN_TAC [`u:num->real^M`; `v:num->real^M`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ABBREV_TAC `k:real^M->bool = UNIONS (IMAGE (\i. {x | x$i = (c:real^M)$i} UNION {x | x$i = (d:real^M)$i}) (1..dimindex(:M)))` THEN SUBGOAL_THEN `negligible(k:real^M->bool)` ASSUME_TAC THENL [EXPAND_TAC "k" THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_STANDARD_HYPERPLANE]; ALL_TAC] THEN MP_TAC(ISPECL [`\n:num x. if x IN interval[u n,v n] then if x IN k then vec 0 else (f:real^M->real^N) x else vec 0`; `\x. if x IN interval[c,d] then if x IN k then vec 0 else (f:real^M->real^N) x else vec 0`; `a:real^M`; `b:real^M`] EQUIINTEGRABLE_LIMIT) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `(\x. if x IN k then vec 0 else (f:real^M->real^N) x) integrable_on interval[a,b]` MP_TAC THENL [UNDISCH_TAC `(f:real^M->real^N) integrable_on interval[a,b]` THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN MAP_EVERY EXISTS_TAC [`(u:num->real^M) n`; `(v:num->real^M) n`] THEN REWRITE_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^M) IN k` THEN ASM_REWRITE_TAC[COND_ID; LIM_CONST] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(SPEC `inf (IMAGE (\i. min (abs((x:real^M)$i - (c:real^M)$i)) (abs((x:real^M)$i - (d:real^M)$i))) (1..dimindex(:M)))` REAL_ARCH_INV) THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; IN_NUMSEG] THEN UNDISCH_TAC `~((x:real^M) IN k)` THEN EXPAND_TAC "k" THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[IN_NUMSEG; SET_RULE `~(p /\ x IN (s UNION t)) <=> p ==> ~(x IN s) /\ ~(x IN t)`] THEN REWRITE_TAC[IN_ELIM_THM; REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `x IN interval[(u:num->real^M) n,v n] <=> x IN interval[c,d]` (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[IN_INTERVAL] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `!N n. abs(u - c) <= n /\ abs(v - d) <= n /\ N < abs(x - c) /\ N < abs(x - d) /\ n <= N ==> (u <= x /\ x <= v <=> c <= x /\ x <= d)`) THEN MAP_EVERY EXISTS_TAC [`inv(&N)`; `inv(&n + &1)`] THEN ASM_SIMP_TAC[] THEN REPEAT (CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; VECTOR_SUB_COMPONENT]; ALL_TAC]) THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN SUBGOAL_THEN `interval[c:real^M,d] INTER interval[a,b] = interval[c,d] /\ !n:num. interval[u n,v n] INTER interval[a,b] = interval[u n,v n]` (fun th -> SIMP_TAC[th]) THENL [REWRITE_TAC[SET_RULE `s INTER t = s <=> s SUBSET t`] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN REWRITE_TAC[LE_REFL; REAL_NOT_LT] THEN FIRST_ASSUM(fun th -> MP_TAC(SPEC `N:num` th) THEN MATCH_MP_TAC (NORM_ARITH `x = a /\ y = b ==> e <= norm(x - y) ==> e <= dist(a,b)`)) THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `k:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]]);; let INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] ==> (\x. integral (interval[a,x]) f) continuous_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `a:real^M`; `x:real^M`; `e:real`] INDEFINITE_INTEGRAL_CONTINUOUS) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[dist]] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[ENDS_IN_INTERVAL; VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN ASM SET_TAC[]);; let INDEFINITE_INTEGRAL_CONTINUOUS_LEFT = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] ==> (\x. integral(interval[x,b]) f) continuous_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `x:real^M`; `b:real^M`; `e:real`] INDEFINITE_INTEGRAL_CONTINUOUS) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[dist]] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[ENDS_IN_INTERVAL; VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN ASM SET_TAC[]);; let INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] ==> (\y. integral (interval[fstcart y,sndcart y]) f) uniformly_continuous_on interval[pastecart a a,pastecart b b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN REWRITE_TAC[COMPACT_INTERVAL; continuous_on] THEN REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; PCROSS] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `c:real^M`; `d:real^M`; `e:real`] INDEFINITE_INTEGRAL_CONTINUOUS) THEN ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[PASTECART_SUB] THEN ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LT_IMP_LE; REAL_LE_TRANS]);; let INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT = prove (`!f:real^M->real^N a b e. f integrable_on interval[a,b] /\ &0 < e ==> ?k. &0 < k /\ !c d c' d'. c IN interval[a,b] /\ d IN interval[a,b] /\ c' IN interval[a,b] /\ d' IN interval[a,b] /\ norm (c' - c) <= k /\ norm (d' - d) <= k ==> norm(integral(interval[c',d']) f - integral(interval[c,d]) f) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`] INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS) THEN ASM_REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `k / &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `c':real^M`; `d:real^M`; `d':real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`pastecart (c:real^M) (c':real^M)`; `pastecart (d:real^M) (d':real^M)`]) THEN REWRITE_TAC[GSYM PCROSS_INTERVAL; PCROSS] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[NORM_PASTECART_LE; REAL_LET_TRANS; REAL_ARITH `&0 < k /\ x <= k / &3 /\ y <= k / &3 ==> x + y < k`]);; let BOUNDED_INTEGRALS_OVER_SUBINTERVALS = prove (`!f:real^M->real^N a b. f integrable_on interval[a,b] ==> bounded { integral (interval[c,d]) f | interval[c,d] SUBSET interval[a,b]}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE)) THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; PASTECART_IN_PCROSS] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL; IS_INTERVAL_INTERVAL] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN ASM_SIMP_TAC[INTEGRAL_EMPTY; NORM_0; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Substitution. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_SUBSTITUTION_STRONG = prove (`!f:real^1->real^N g g' a b c d k. COUNTABLE k /\ f integrable_on interval[c,d] /\ g continuous_on interval[a,b] /\ IMAGE g (interval[a,b]) SUBSET interval[c,d] /\ (!x. x IN interval[a,b] DIFF k ==> (g has_vector_derivative g'(x)) (at x within interval[a,b]) /\ f continuous (at(g x)) within interval[c,d]) /\ drop a <= drop b /\ drop c <= drop d /\ drop(g a) <= drop(g b) ==> ((\x. drop(g' x) % f(g x)) has_integral integral (interval[g a,g b]) f) (interval[a,b])`, REPEAT STRIP_TAC THEN ABBREV_TAC `ff = \x. integral (interval[c,x]) (f:real^1->real^N)` THEN MP_TAC(ISPECL [`(ff:real^1->real^N) o (g:real^1->real^1)`; `\x:real^1. drop(g' x) % (f:real^1->real^N)(g x)`; `k:real^1->bool`; `a:real^1`; `b:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[c:real^1,d]` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "ff" THEN MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN ASM_REWRITE_TAC[]; X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED)) THEN SUBGOAL_THEN `(ff o g has_vector_derivative drop(g' x) % (f:real^1->real^N)(g x)) (at x within interval[a,b])` MP_TAC THENL [MATCH_MP_TAC VECTOR_DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[IN_DIFF] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `c:real^1`; `d:real^1`; `(g:real^1->real^1) x`] INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE) THEN ASM_SIMP_TAC[CONTINUOUS_AT_WITHIN; IN_DIFF] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET]; REWRITE_TAC[has_vector_derivative; has_derivative] THEN ASM_SIMP_TAC[LIM_WITHIN_INTERIOR; INTERIOR_INTERVAL; NETLIMIT_WITHIN_INTERIOR; NETLIMIT_AT]]]; EXPAND_TAC "ff" THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(VECTOR_ARITH `z + w:real^N = y ==> y - z = w`) THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_SUBINTERVAL))] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL_1; SUBSET] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]]);; (* ------------------------------------------------------------------------- *) (* Second mean value theorem and corollaries. *) (* ------------------------------------------------------------------------- *) let SECOND_MEAN_VALUE_THEOREM_FULL = prove (`!f:real^1->real^1 g a b. ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g x <= g y) ==> ?c. c IN interval [a,b] /\ ((\x. g x % f x) has_integral (g(a) % integral (interval[a,c]) f + g(b) % integral (interval[c,b]) f)) (interval[a,b])`, let lemma1 = prove (`!f:real->real s. (!x. x IN s ==> &0 <= f x /\ f x <= &1) ==> (!n x. x IN s /\ ~(n = 0) ==> abs(f x - sum(1..n) (\k. if &k / &n <= f(x) then inv(&n) else &0)) < inv(&n))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?m. floor(&n * (f:real->real) x) = &m` CHOOSE_TAC THENL [MATCH_MP_TAC FLOOR_POS THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS]; ALL_TAC] THEN SUBGOAL_THEN `!k. &k / &n <= (f:real->real) x <=> k <= m` ASSUME_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN SIMP_TAC[REAL_LE_FLOOR; INTEGER_CLOSED; REAL_MUL_SYM]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; real_div; REAL_ADD_RDISTRIB] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `y <= &1 /\ &0 < i ==> ~(&1 + i <= y)`; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LE_1; NOT_LE] THEN SIMP_TAC[IN_NUMSEG; ARITH_RULE `m < n + 1 ==> ((1 <= k /\ k <= n) /\ k <= m <=> 1 <= k /\ k <= m)`] THEN DISCH_TAC THEN REWRITE_TAC[GSYM numseg; SUM_CONST_NUMSEG; ADD_SUB] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&n)` THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_ABS_NUM; REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; REAL_SUB_LDISTRIB; GSYM real_div] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN MATCH_MP_TAC(REAL_ARITH `f <= x /\ x < f + &1 ==> abs(x - f) < &1`) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[FLOOR]) in let lemma2 = prove (`!f:real^1->real^N g a b. f integrable_on interval[a,b] /\ (!x y. drop x <= drop y ==> g(x) <= g(y)) ==> {(\x. if c <= g(x) then f x else vec 0) | c IN (:real)} equiintegrable_on interval[a,b]`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `f:real^1->real^N` (MATCH_MP (REWRITE_RULE[IMP_CONJ] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE) th)) THEN MP_TAC(SPEC `f:real^1->real^N` (MATCH_MP (REWRITE_RULE[IMP_CONJ] EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT) th)) THEN MP_TAC th) THEN SIMP_TAC[IN_SING; REAL_LE_REFL] THEN SUBGOAL_THEN `{(\x. vec 0):real^1->real^N} equiintegrable_on interval[a,b]` MP_TAC THENL [REWRITE_TAC[EQUIINTEGRABLE_ON_SING; INTEGRABLE_CONST]; ALL_TAC] THEN REPEAT(ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION)) THEN REWRITE_TAC[NUMSEG_SING; DIMINDEX_1; IN_SING] THEN REWRITE_TAC[SET_RULE `{m i c h | i = 1 /\ c IN (:real) /\ h = f} = {m 1 c f | c IN (:real)}`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `y:real` THEN ASM_CASES_TAC `!x. y <= (g:real^1->real) x` THENL [ASM_REWRITE_TAC[ETA_AX; IN_UNION; IN_SING]; ALL_TAC] THEN ASM_CASES_TAC `!x. ~(y <= (g:real^1->real) x)` THENL [ASM_REWRITE_TAC[ETA_AX; IN_UNION; IN_SING]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE drop {x | y <= (g:real^1->real) x}` INF) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]; STRIP_TAC THEN REWRITE_TAC[real_gt; real_ge]] THEN REWRITE_TAC[IN_UNION; GSYM DISJ_ASSOC] THEN ASM_CASES_TAC `y <= g(lift(inf(IMAGE drop {x | y <= g x})))` THENL [REPEAT DISJ2_TAC; REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `inf(IMAGE drop {x | y <= g x})` THEN REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> !x. (if P x then f x else b) = (if Q x then f x else b)`) THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[GSYM REAL_NOT_LE; GSYM drop] THEN ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LT_ANTISYM; REAL_LE_TRANS; LIFT_DROP]) in let lemma3 = prove (`!f:real^1->real^N g a b. f integrable_on interval[a,b] /\ (!x y. drop x <= drop y ==> g(x) <= g(y)) ==> {(\x. vsum (1..n) (\k. if &k / &n <= g x then inv(&n) % f(x) else vec 0)) | ~(n = 0)} equiintegrable_on interval[a,b]`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN DISCH_THEN(MP_TAC o MATCH_MP (INST_TYPE [`:num`,`:A`] EQUIINTEGRABLE_SUM)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`1..n`; `\k:num. inv(&n)`; `\k x. if &k / &n <= g x then (f:real^1->real^N) x else vec 0`] THEN ASM_SIMP_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN REWRITE_TAC[FINITE_NUMSEG; COND_RAND; COND_RATOR; VECTOR_MUL_RZERO] THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG; REAL_LE_INV_EQ; REAL_POS] THEN STRIP_TAC THEN EXISTS_TAC `&k / &n` THEN REWRITE_TAC[]) in let lemma4 = prove (`!f:real^1->real^1 g a b. ~(interval[a,b] = {}) /\ f integrable_on interval[a,b] /\ (!x y. drop x <= drop y ==> g(x) <= g(y)) /\ (!x. x IN interval[a,b] ==> &0 <= g x /\ g x <= &1) ==> (\x. g(x) % f(x)) integrable_on interval[a,b] /\ ?c. c IN interval[a,b] /\ integral (interval[a,b]) (\x. g(x) % f(x)) = integral (interval[c,b]) f`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `?m M. IMAGE (\x. integral (interval[x,b]) (f:real^1->real^1)) (interval[a,b]) = interval[m,M]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN ASM_SIMP_TAC[INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; CONVEX_CONNECTED; CONVEX_INTERVAL; COMPACT_INTERVAL]; ALL_TAC] THEN MP_TAC(ISPECL[`f:real^1->real^1`; `g:real^1->real`; `a:real^1`; `b:real^1`] lemma3) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. ?c. c IN interval[a,b] /\ integral (interval[c,b]) (f:real^1->real^1) = integral (interval[a,b]) (\x. vsum (1..n) (\k. if &k / &n <= g x then inv(&n) % f x else vec 0))` MP_TAC THENL [X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; ARITH_EQ; INTEGRAL_0] THEN EXISTS_TAC `b:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `g:real^1->real`; `a:real^1`; `b:real^1`] lemma2) THEN ASM_REWRITE_TAC[equiintegrable_on; FORALL_IN_GSPEC; IN_UNIV] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN REWRITE_TAC[MESON[VECTOR_MUL_RZERO] `(if p then a % x else vec 0:real^1) = a % (if p then x else vec 0)`] THEN ASM_SIMP_TAC[VSUM_LMUL; INTEGRAL_CMUL; INTEGRABLE_VSUM; ETA_AX; FINITE_NUMSEG; INTEGRAL_VSUM] THEN SUBGOAL_THEN `!y:real. ?d:real^1. d IN interval[a,b] /\ integral (interval[a,b]) (\x. if y <= g x then f x else vec 0) = integral (interval[d,b]) (f:real^1->real^1)` MP_TAC THENL [X_GEN_TAC `y:real` THEN SUBGOAL_THEN `{x | y <= g x} = {} \/ {x | y <= g x} = (:real^1) \/ (?a. {x | y <= g x} = {x | a <= drop x}) \/ (?a. {x | y <= g x} = {x | a < drop x})` MP_TAC THENL [MATCH_MP_TAC(TAUT `(~a /\ ~b ==> c \/ d) ==> a \/ b \/ c \/ d`) THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE drop {x | y <= (g:real^1->real) x}` INF) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]; STRIP_TAC] THEN ASM_CASES_TAC `y <= g(lift(inf(IMAGE drop {x | y <= g x})))` THENL [DISJ1_TAC; DISJ2_TAC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN EXISTS_TAC `inf(IMAGE drop {x | y <= g x})` THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[GSYM REAL_NOT_LE; GSYM drop] THEN ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LT_ANTISYM; REAL_LE_TRANS; LIFT_DROP]; REWRITE_TAC[EXTENSION; IN_UNIV; NOT_IN_EMPTY; IN_ELIM_THM] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL [EXISTS_TAC `b:real^1` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTEGRAL_0]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL [EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[ETA_AX; ENDS_IN_INTERVAL]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [OR_EXISTS_THM] THEN REWRITE_TAC[EXISTS_DROP] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^1` ASSUME_TAC) THEN ASM_CASES_TAC `drop d < drop a` THENL [EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[ETA_AX; ENDS_IN_INTERVAL] THEN MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; NOT_IN_EMPTY] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(y <= (g:real^1->real) x)` THEN FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `drop b < drop d` THENL [EXISTS_TAC `b:real^1` THEN SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTEGRAL_0] THEN MATCH_MP_TAC INTEGRAL_EQ_0 THEN REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `y <= (g:real^1->real) x` THEN FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `d:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[SET_RULE `~((g:real^1->real) x < y) <=> x IN {x | ~(g x < y)}`] THEN REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{d:real^1}` THEN REWRITE_TAC[NEGLIGIBLE_SING; REAL_NOT_LT; SUBSET] THEN GEN_TAC THEN REWRITE_TAC[SUBSET; IN_UNION; IN_INTER; IN_DIFF; IN_INTERVAL_1; IN_ELIM_THM; IN_SING; GSYM DROP_EQ] THEN FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o GEN `k:num` o SPEC `&k / &n`) THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num->real^1` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s = t ==> !y. y IN t ==> ?x. x IN s /\ f x = y`)) THEN REWRITE_TAC[GSYM VSUM_LMUL] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[CONVEX_INDEXED] (CONJUNCT1(SPEC_ALL CONVEX_INTERVAL))) THEN REWRITE_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_LE_INV_EQ; REAL_POS] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN ASM SET_TAC[]]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `c:num->real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN SUBGOAL_THEN `compact(interval[a:real^1,b])` MP_TAC THENL [REWRITE_TAC[COMPACT_INTERVAL]; REWRITE_TAC[compact]] THEN DISCH_THEN(MP_TAC o SPEC `c:num->real^1`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:real^1`; `s:num->num`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n:num x. vsum (1..(s n)) (\k. if &k / &(s n) <= g x then inv(&(s n)) % (f:real^1->real^1) x else vec 0)`; `\x. g x % (f:real^1->real^1) x`; `a:real^1`; `b:real^1`] EQUIINTEGRABLE_LIMIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC EQUIINTEGRABLE_SUBSET THEN EXISTS_TAC `{\x. vsum(1..0) (\k. if &k / &0 <= g x then inv(&0) % (f:real^1->real^1) x else vec 0)} UNION {\x. vsum (1..n) (\k. if &k / &n <= g x then inv (&n) % f x else vec 0) | ~(n = 0)}` THEN CONJ_TAC THENL [MATCH_MP_TAC EQUIINTEGRABLE_UNION THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EQUIINTEGRABLE_ON_SING; VSUM_CLAUSES_NUMSEG; ARITH_EQ] THEN REWRITE_TAC[INTEGRABLE_0]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV; IN_UNION] THEN REWRITE_TAC[IN_ELIM_THM; IN_SING] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `(s:num->num) n = 0` THEN ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN EXISTS_TAC `(s:num->num) n` THEN ASM_REWRITE_TAC[]]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MESON[VECTOR_MUL_LZERO] `(if p then a % x else vec 0) = (if p then a else &0) % x`] THEN REWRITE_TAC[VSUM_RMUL] THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_DEF; DIST_LIFT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n)` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`(g:real^1->real) o lift`; `IMAGE drop (interval[a,b])`] lemma1) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&((s:num->num) n))` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT]] THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP MONOTONE_BIGGER) THEN ASM_ARITH_TAC; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `d:real^1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. integral (interval [c((s:num->num) n),b]) (f:real^1->real^1)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `d:real^1`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `(c:num->real^1) o (s:num->num)`) THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[o_DEF]]) in REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `(g:real^1->real) a <= g b` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ASM_MESON_TAC[INTERVAL_EQ_EMPTY_1; REAL_LET_TOTAL]; ALL_TAC] THEN REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THENL [ALL_TAC; SUBGOAL_THEN `!x. x IN interval[a,b] ==> g(x) % (f:real^1->real^1)(x) = g(a) % f x` ASSUME_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TRANS; REAL_LE_TOTAL]; ALL_TAC] THEN EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN MATCH_MP_TAC HAS_INTEGRAL_EQ THEN EXISTS_TAC `\x. g(a:real^1) % (f:real^1->real^1) x` THEN ASM_SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL] THEN ASM_SIMP_TAC[INTEGRAL_CMUL; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `\x. if drop x < drop a then &0 else if drop b < drop x then &1 else (g(x) - g(a)) / (g(b) - g(a))`; `a:real^1`; `b:real^1`] lemma4) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL]) THEN TRY ASM_REAL_ARITH_TAC THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LE_DIV2_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_SUB_LE; REAL_ARITH `x - a <= y - a <=> x <= y`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN(MP_TAC o SPEC `(g:real^1->real) b - g a` o MATCH_MP HAS_INTEGRAL_CMUL) THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN DISCH_THEN(MP_TAC o SPEC `(g:real^1->real)(a)` o MATCH_MP HAS_INTEGRAL_CMUL) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] INTEGRAL_COMBINE) THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[VECTOR_ARITH `ga % (i1 + i2) + (gb - ga) % i2:real^N = ga % i1 + gb % i2`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM REAL_NOT_LE; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN VECTOR_ARITH_TAC);; let SECOND_MEAN_VALUE_THEOREM = prove (`!f:real^1->real^1 g a b. ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g x <= g y) ==> ?c. c IN interval [a,b] /\ integral (interval[a,b]) (\x. g x % f x) = g(a) % integral (interval[a,c]) f + g(b) % integral (interval[c,b]) f`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_FULL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; let SECOND_MEAN_VALUE_THEOREM_GEN_FULL = prove (`!f:real^1->real^1 g a b u v. ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ (!x. x IN interval(a,b) ==> u <= g x /\ g x <= v) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g x <= g y) ==> ?c. c IN interval [a,b] /\ ((\x. g x % f x) has_integral (u % integral (interval[a,c]) f + v % integral (interval[c,b]) f)) (interval[a,b])`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^1 = a` THENL [EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[INTERVAL_SING; IN_SING] THEN ASM_SIMP_TAC[GSYM INTERVAL_SING; INTEGRAL_NULL; CONTENT_EQ_0_1; VECTOR_ADD_LID; REAL_LE_REFL; VECTOR_MUL_RZERO; HAS_INTEGRAL_NULL]; ALL_TAC] THEN SUBGOAL_THEN `drop a < drop b` ASSUME_TAC THENL [ASM_MESON_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LE; DROP_EQ; REAL_LT_LE]; ALL_TAC] THEN SUBGOAL_THEN `u <= v` ASSUME_TAC THENL [ASM_MESON_TAC[INTERVAL_EQ_EMPTY_1; MEMBER_NOT_EMPTY; REAL_NOT_LT; REAL_LE_TRANS]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `\x:real^1. if x = a then u else if x = b then v else g x:real`; `a:real^1`; `b:real^1`] SECOND_MEAN_VALUE_THEOREM_FULL) THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN ASM_CASES_TAC `x:real^1 = a` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[REAL_LE_REFL; INTERVAL_CASES_1]; ALL_TAC] THEN ASM_CASES_TAC `y:real^1 = b` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[REAL_LE_REFL; INTERVAL_CASES_1]; ALL_TAC] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_INTEGRAL_SPIKE) THEN EXISTS_TAC `{a:real^1,b}` THEN SIMP_TAC[NEGLIGIBLE_EMPTY; NEGLIGIBLE_INSERT; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM]]);; let SECOND_MEAN_VALUE_THEOREM_GEN = prove (`!f:real^1->real^1 g a b u v. ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ (!x. x IN interval(a,b) ==> u <= g x /\ g x <= v) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g x <= g y) ==> ?c. c IN interval [a,b] /\ integral (interval[a,b]) (\x. g x % f x) = u % integral (interval[a,c]) f + v % integral (interval[c,b]) f`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; let SECOND_MEAN_VALUE_THEOREM_BONNET_FULL = prove (`!f:real^1->real^1 g a b. ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ (!x. x IN interval[a,b] ==> &0 <= g x) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g x <= g y) ==> ?c. c IN interval [a,b] /\ ((\x. g x % f x) has_integral (g(b) % integral (interval[c,b]) f)) (interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `g:real^1->real`; `a:real^1`; `b:real^1`; `&0`; `(g:real^1->real) b`] SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let SECOND_MEAN_VALUE_THEOREM_BONNET = prove (`!f:real^1->real^1 g a b. ~(interval[a,b] = {}) /\ f integrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> &0 <= g x) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g x <= g y) ==> ?c. c IN interval [a,b] /\ integral (interval[a,b]) (\x. g x % f x) = g(b) % integral (interval[c,b]) f`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; let INTEGRABLE_INCREASING_PRODUCT = prove (`!f:real^1->real^N g a b. f integrable_on interval[a,b] /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g(x) <= g(y)) ==> (\x. g(x) % f(x)) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY] THEN ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x. lift((f:real^1->real^N) x$i)`; `g:real^1->real`; `a:real^1`; `b:real^1`] SECOND_MEAN_VALUE_THEOREM_FULL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN ASM_SIMP_TAC[]; REWRITE_TAC[VECTOR_MUL_COMPONENT; LIFT_CMUL; integrable_on] THEN MESON_TAC[]]);; let INTEGRABLE_INCREASING_PRODUCT_UNIV = prove (`!f:real^1->real^N g B. f integrable_on (:real^1) /\ (!x y. drop x <= drop y ==> g x <= g y) /\ (!x. abs(g x) <= B) ==> (\x. g x % f x) integrable_on (:real^1)`, let lemma = prove (`!f:real^1->real^1 g B. f integrable_on (:real^1) /\ (!x y. drop x <= drop y ==> g x <= g y) /\ (!x. abs(g x) <= B) ==> (\x. g x % f x) integrable_on (:real^1)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_ALT_SUBSET] THEN REWRITE_TAC[IN_UNIV; ETA_AX] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN ASM_SIMP_TAC[]; DISCH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (&8 * abs B + &8)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &8 * abs B + &8`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `C:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(ball(vec 0:real^1,C) = {})` ASSUME_TAC THENL [ASM_REWRITE_TAC[BALL_EQ_EMPTY; REAL_NOT_LE]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `~(interval[a:real^1,b] = {}) /\ ~(interval[c:real^1,d] = {})` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL_1]) THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x. g x % (f:real^1->real^1) x`; `c:real^1`; `b:real^1`; `a:real^1`] INTEGRAL_COMBINE) THEN MP_TAC(ISPECL [`\x. g x % (f:real^1->real^1) x`; `c:real^1`; `d:real^1`; `b:real^1`] INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_NOT_LE; NORM_ARITH `norm(ab - ((ca + ab) + bd):real^1) = norm(ca + bd)`] THEN MP_TAC(ISPECL[`f:real^1->real^1`; `g:real^1->real`; `c:real^1`; `a:real^1`] SECOND_MEAN_VALUE_THEOREM) THEN ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL[`f:real^1->real^1`; `g:real^1->real`; `b:real^1`; `d:real^1`] SECOND_MEAN_VALUE_THEOREM) THEN ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^1` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!x y. drop y <= drop a ==> norm(integral (interval[x,y]) (f:real^1->real^1)) < e / (&4 * abs B + &4)` (LABEL_TAC "L") THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `drop x <= drop y` THENL [FIRST_X_ASSUM(fun th -> MP_TAC(SPECL[`a:real^1`; `b:real^1`; `y:real^1`; `b:real^1`] th) THEN MP_TAC(SPECL[`a:real^1`; `b:real^1`; `x:real^1`; `b:real^1`] th)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `b:real^1`; `y:real^1`] INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC(NORM_ARITH `&2 * d = e ==> norm(ab - (xy + yb)) < d ==> norm(ab - yb) < d ==> norm(xy:real^1) < e`) THEN CONV_TAC REAL_FIELD; SUBGOAL_THEN `interval[x:real^1,y] = {}` SUBST1_TAC THENL [REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[INTEGRAL_EMPTY; NORM_0] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `!x y. drop b <= drop x ==> norm(integral (interval[x,y]) (f:real^1->real^1)) < e / (&4 * abs B + &4)` (LABEL_TAC "R") THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `drop x <= drop y` THENL [FIRST_X_ASSUM(fun th -> MP_TAC(SPECL[`a:real^1`; `b:real^1`; `a:real^1`; `x:real^1`] th) THEN MP_TAC(SPECL[`a:real^1`; `b:real^1`; `a:real^1`; `y:real^1`] th)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `y:real^1`; `x:real^1`] INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC(NORM_ARITH `&2 * d = e ==> norm(ab - (ax + xy)) < d ==> norm(ab - ax) < d ==> norm(xy:real^1) < e`) THEN CONV_TAC REAL_FIELD; SUBGOAL_THEN `interval[x:real^1,y] = {}` SUBST1_TAC THENL [REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[INTEGRAL_EMPTY; NORM_0] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&4 * B * e / (&4 * abs B + &4)` THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `(norm a <= e /\ norm b <= e) /\ (norm c <= e /\ norm d <= e) ==> norm((a + b) + (c + d):real^1) <= &4 * e`) THEN REWRITE_TAC[NORM_MUL] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REMOVE_THEN "L" MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REMOVE_THEN "R" MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[REAL_ARITH `&4 * B * e / y < e <=> e * (&4 * B) / y < e * &1`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &4 * abs B + &4`] THEN REAL_ARITH_TAC]) in GEN_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; LIFT_CMUL] THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `B:real` THEN ASM_SIMP_TAC[]);; let INTEGRABLE_INCREASING = prove (`!f:real^1->real^N a b. (!x y i. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y /\ 1 <= i /\ i <= dimindex(:N) ==> f(x)$i <= f(y)$i) ==> f integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN REWRITE_TAC[LIFT_CMUL; LIFT_NUM] THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN ASM_SIMP_TAC[INTEGRABLE_CONST]);; let INTEGRABLE_INCREASING_1 = prove (`!f:real^1->real^1 a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> f integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; let INTEGRABLE_DECREASING_PRODUCT = prove (`!f:real^1->real^N g a b. f integrable_on interval[a,b] /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> g(y) <= g(x)) ==> (\x. g(x) % f(x)) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x % y:real^N = --(--x % y)`] THEN MATCH_MP_TAC INTEGRABLE_NEG THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN ASM_REWRITE_TAC[REAL_LE_NEG2]);; let INTEGRABLE_DECREASING_PRODUCT_UNIV = prove (`!f:real^1->real^N g B. f integrable_on (:real^1) /\ (!x y. drop x <= drop y ==> g y <= g x) /\ (!x. abs(g x) <= B) ==> (\x. g x % f x) integrable_on (:real^1)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x % y:real^N = --(--x % y)`] THEN MATCH_MP_TAC INTEGRABLE_NEG THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT_UNIV THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_ABS_NEG]);; let INTEGRABLE_DECREASING = prove (`!f:real^1->real^N a b. (!x y i. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y /\ 1 <= i /\ i <= dimindex(:N) ==> f(y)$i <= f(x)$i) ==> f integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM VECTOR_NEG_NEG] THEN MATCH_MP_TAC INTEGRABLE_NEG THEN MATCH_MP_TAC INTEGRABLE_INCREASING THEN ASM_SIMP_TAC[VECTOR_NEG_COMPONENT; REAL_LE_NEG2]);; let INTEGRABLE_DECREASING_1 = prove (`!f:real^1->real^1 a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> f integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_DECREASING THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; (* ------------------------------------------------------------------------- *) (* Bounded variation and variation function, for real^1->real^N functions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_bounded_variation_on",(12,"right"));; let has_bounded_variation_on = new_definition `(f:real^1->real^N) has_bounded_variation_on s <=> (\k. f(interval_upperbound k) - f(interval_lowerbound k)) has_bounded_setvariation_on s`;; let vector_variation = new_definition `vector_variation s (f:real^1->real^N) = set_variation s (\k. f(interval_upperbound k) - f(interval_lowerbound k))`;; let VECTOR_VARIATION_DEGENERATES = prove (`!f:real^1->real^N g s. ~(f has_bounded_variation_on s) /\ ~(g has_bounded_variation_on s) ==> vector_variation s f = vector_variation s g`, REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN REWRITE_TAC[SET_VARIATION_DEGENERATES]);; let HAS_BOUNDED_VARIATION_ON_INTERVAL = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] <=> ?B. !d. d division_of interval[a,b] ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= B`, REWRITE_TAC[has_bounded_variation_on; HAS_BOUNDED_SETVARIATION_ON_INTERVAL]);; let VECTOR_VARIATION_ON_INTERVAL = prove (`!f:real^1->real^N a b. vector_variation (interval[a,b]) f = sup {sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) | d division_of interval[a,b]}`, REPEAT GEN_TAC THEN REWRITE_TAC[vector_variation] THEN W(MP_TAC o PART_MATCH (lhand o rand) SET_VARIATION_ON_ELEMENTARY o lhand o snd) THEN REWRITE_TAC[ELEMENTARY_INTERVAL]);; let HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL = prove (`!f:real^1->real^N a b c. f has_bounded_variation_on interval[a,b] /\ vector_variation (interval[a,b]) f <= c <=> !d. d division_of interval[a,b] ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= c`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_INTERVAL; VECTOR_VARIATION_ON_INTERVAL] THEN MATCH_MP_TAC(TAUT `(r ==> p) /\ (p ==> (q <=> r)) ==> (p /\ q <=> r)`) THEN CONJ_TAC THENL [MESON_TAC[]; DISCH_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_SUP_LE_EQ o lhand o snd) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; ELEMENTARY_INTERVAL]);; let HAS_BOUNDED_VECTOR_VARIATION = prove (`!f:real^1->real^N s c. f has_bounded_variation_on s /\ vector_variation s f <= c <=> !d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= c`, REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN REWRITE_TAC[HAS_BOUNDED_SET_VARIATION]);; let HAS_BOUNDED_VARIATION_WORKS = prove (`!f:real^1->real^N s. f has_bounded_variation_on s ==> (!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= vector_variation s f) /\ (!B. (!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= B) ==> vector_variation s f <= B)`, REWRITE_TAC[has_bounded_variation_on; vector_variation; HAS_BOUNDED_SETVARIATION_WORKS]);; let HAS_BOUNDED_VARIATION_WORKS_ON_ELEMENTARY = prove (`!f:real^1->real^N s. f has_bounded_variation_on s /\ (?d. d division_of s) ==> (!d. d division_of s ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= vector_variation s f) /\ (!B. (!d. d division_of s ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= B) ==> vector_variation s f <= B)`, REWRITE_TAC[has_bounded_variation_on; vector_variation; HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY]);; let HAS_BOUNDED_VARIATION_WORKS_ON_INTERVAL = prove (`!f:real^1->real^N. f has_bounded_variation_on interval[a,b] ==> (!d. d division_of interval[a,b] ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= vector_variation (interval[a,b]) f) /\ (!B. (!d. d division_of interval[a,b] ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= B) ==> vector_variation (interval[a,b]) f <= B)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_WORKS_ON_ELEMENTARY THEN ASM_MESON_TAC[ELEMENTARY_INTERVAL]);; let HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL_GEN = prove (`!f:real^1->real^N s c. is_interval s ==> (f has_bounded_variation_on s /\ vector_variation s f <= c <=> !d a b. d division_of interval[a,b] /\ interval[a,b] SUBSET s ==> sum d (\k. norm(f(interval_upperbound k) - f(interval_lowerbound k))) <= c)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_BOUNDED_VECTOR_VARIATION] THEN MATCH_MP_TAC SET_VARIATION_INTERVAL_LEMMA THEN ASM_REWRITE_TAC[]);; let HAS_BOUNDED_VECTOR_VARIATION_ON_SUBINTERVALS = prove (`!f:real^1->real^N s c. is_interval s ==> (f has_bounded_variation_on s /\ vector_variation s f <= c <=> !a b. interval[a,b] SUBSET s ==> f has_bounded_variation_on interval[a,b] /\ vector_variation (interval[a,b]) f <= c)`, REWRITE_TAC[HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL] THEN ASM_SIMP_TAC[HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL_GEN] THEN MESON_TAC[]);; let HAS_BOUNDED_VARIATION_ON_EQ = prove (`!f g:real^1->real^N s. (!x. x IN s ==> f x = g x) /\ f has_bounded_variation_on s ==> g has_bounded_variation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[has_bounded_variation_on] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; GSYM INTERVAL_NE_EMPTY] THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]);; let VECTOR_VARIATION_EQ = prove (`!f g:real^1->real^N s. (!x. x IN s ==> f x = g x) ==> vector_variation s f = vector_variation s g`, REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN MATCH_MP_TAC SET_VARIATION_EQ THEN SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; GSYM INTERVAL_NE_EMPTY] THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]);; let HAS_BOUNDED_VARIATION_ISOMETRIC = prove (`!f g:real^1->real^N s. (!x y. dist(f x,f y) = dist(g x,g y)) ==> (f has_bounded_variation_on s <=> g has_bounded_variation_on s)`, SIMP_TAC[has_bounded_variation_on; has_bounded_setvariation_on; o_DEF; dist]);; let HAS_BOUNDED_VARIATION_ISOMETRIC_COMPOSE = prove (`!f:real^M->real^N g s. (!x y. dist(f x,f y) = dist(x,y)) ==> ((f o g) has_bounded_variation_on s <=> g has_bounded_variation_on s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ISOMETRIC THEN ASM_REWRITE_TAC[o_DEF]);; let VECTOR_VARIATION_ISOMETRIC = prove (`!f g:real^1->real^N s. (!x y. dist(f x,f y) = dist(g x,g y)) ==> vector_variation s f = vector_variation s g`, SIMP_TAC[vector_variation; set_variation; o_DEF; dist]);; let VECTOR_VARIATION_ISOMETRIC_COMPOSE = prove (`!f:real^M->real^N g s. (!x y. dist(f x,f y) = dist(x,y)) ==> vector_variation s (f o g) = vector_variation s g`, SIMP_TAC[vector_variation; set_variation; o_DEF; dist]);; let HAS_BOUNDED_VARIATION_ON_TRANSLATION = prove (`!f:real^1->real^N s a. (\x. a + f x) has_bounded_variation_on s <=> f has_bounded_variation_on s`, REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; let VECTOR_VARIATION_TRANSLATION = prove (`!f:real^1->real^N s a. vector_variation s (\x. a + f x) = vector_variation s f`, REWRITE_TAC[vector_variation] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; let HAS_BOUNDED_VARIATION_ON_COMPONENTWISE = prove (`!f:real^1->real^N s. f has_bounded_variation_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift(f x$i)) has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN GEN_REWRITE_TAC LAND_CONV [HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; LIFT_SUB]);; let VARIATION_EQUAL_LEMMA = prove (`!ms ms'. (!s. ms'(ms s) = s /\ ms(ms' s) = s) /\ (!d t. d division_of t ==> (IMAGE (IMAGE ms) d) division_of IMAGE ms t /\ (IMAGE (IMAGE ms') d) division_of IMAGE ms' t) /\ (!a b. ~(interval[a,b] = {}) ==> IMAGE ms' (interval [a,b]) = interval[ms' a,ms' b] \/ IMAGE ms' (interval [a,b]) = interval[ms' b,ms' a]) ==> (!f:real^1->real^N s. (\x. f(ms' x)) has_bounded_variation_on (IMAGE ms s) <=> f has_bounded_variation_on s) /\ (!f:real^1->real^N s. vector_variation (IMAGE ms s) (\x. f(ms' x)) = vector_variation s f)`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `f:real^1->real^N` THEN MP_TAC(ISPECL [`\f k. (f:(real^1->bool)->real^N) (IMAGE (ms':real^1->real^1) k)`; `IMAGE (ms:real^1->real^1)`; `IMAGE (ms':real^1->real^1)`] SETVARIATION_EQUAL_LEMMA) THEN ANTS_TAC THENL [ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; IMAGE_SUBSET] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [AND_FORALL_THM] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `\k. (f:real^1->real^N) (interval_upperbound k) - f (interval_lowerbound k)` th)) THEN REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `s:real^1->bool` THEN REWRITE_TAC[has_bounded_setvariation_on; set_variation] THEN CONJ_TAC THENL [REPLICATE_TAC 3 (AP_TERM_TAC THEN ABS_TAC) THEN REWRITE_TAC[TAUT `((p ==> q) <=> (p ==> r)) <=> p ==> (q <=> r)`] THEN STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN GEN_TAC THEN STRIP_TAC] THEN MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s = s' ==> ~(s = {}) ==> IMAGE f s = s' /\ ~(s' = {})`)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN NORM_ARITH_TAC);; let HAS_BOUNDED_VARIATION_COMPARISON = prove (`!f:real^1->real^M g:real^1->real^N s. f has_bounded_variation_on s /\ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> dist(g x,g y) <= dist(f x,f y)) ==> g has_bounded_variation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[has_bounded_variation_on] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_SETVARIATION_COMPARISON) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM dist] THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s ==> dist((g:real^1->real^N) x,g y) <= dist((f:real^1->real^M) x,f y)` MATCH_MP_TAC THENL [REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[DIST_REFL; REAL_LE_REFL] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]]);; let HAS_BOUNDED_VARIATION_ON_LIFT_ABS = prove (`!f:real^1->real. (\x. lift(f x)) has_bounded_variation_on s ==> (\x. lift(abs(f x))) has_bounded_variation_on s`, REPEAT GEN_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_VARIATION_COMPARISON) THEN REWRITE_TAC[DIST_LIFT] THEN REAL_ARITH_TAC);; let VECTOR_VARIATION_COMPARISON = prove (`!f:real^1->real^M g:real^1->real^N s. f has_bounded_variation_on s /\ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> dist(g x,g y) <= dist(f x,f y)) ==> vector_variation s g <= vector_variation s f`, REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN MATCH_MP_TAC SET_VARIATION_COMPARISON THEN ASM_REWRITE_TAC[GSYM has_bounded_variation_on] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM dist] THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s ==> dist((g:real^1->real^N) x,g y) <= dist((f:real^1->real^M) x,f y)` MATCH_MP_TAC THENL [REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[DIST_REFL; REAL_LE_REFL] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]]);; let VECTOR_VARIATION_COMPONENT_LE = prove (`!f:real^1->real^N s i. f has_bounded_variation_on s ==> vector_variation s (\x. lift(f x$i)) <= vector_variation s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_COMPARISON THEN ASM_REWRITE_TAC[DIST_LIFT] THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM]);; let VECTOR_VARIATION_LIFT_ABS = prove (`!f:real^1->real s. (\x. lift(f x)) has_bounded_variation_on s ==> vector_variation s (\x. lift(abs(f x))) <= vector_variation s (\x. lift(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_COMPARISON THEN ASM_REWRITE_TAC[DIST_LIFT] THEN REAL_ARITH_TAC);; let HAS_BOUNDED_VARIATION_ON_SUBSET = prove (`!f:real^1->real^N s t. f has_bounded_variation_on s /\ t SUBSET s ==> f has_bounded_variation_on t`, REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_SUBSET; has_bounded_variation_on]);; let HAS_BOUNDED_VARIATION_ON_CONST = prove (`!s c:real^N. (\x. c) has_bounded_variation_on s`, REWRITE_TAC[has_bounded_variation_on; VECTOR_SUB_REFL; HAS_BOUNDED_SETVARIATION_ON_0]);; let VECTOR_VARIATION_CONST = prove (`!s c:real^N. vector_variation s (\x. c) = &0`, REWRITE_TAC[vector_variation; VECTOR_SUB_REFL; SET_VARIATION_0]);; let HAS_BOUNDED_VARIATION_ON_CMUL = prove (`!f:real^1->real^N c s. f has_bounded_variation_on s ==> (\x. c % f x) has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; HAS_BOUNDED_SETVARIATION_ON_CMUL]);; let HAS_BOUNDED_VARIATION_ON_CMUL_EQ = prove (`!f:real^1->real^N c s. (\x. c % f x) has_bounded_variation_on s <=> c = &0 \/ f has_bounded_variation_on s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; HAS_BOUNDED_VARIATION_ON_CONST] THEN EQ_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_CMUL] THEN DISCH_THEN(MP_TAC o SPEC `inv(c:real)` o MATCH_MP HAS_BOUNDED_VARIATION_ON_CMUL) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_LINV; ETA_AX]);; let HAS_BOUNDED_VARIATION_ON_VMUL_EQ = prove (`!f s v:real^N. (\x. f(x) % v) has_bounded_variation_on s <=> v = vec 0 \/ (\x. lift(f x)) has_bounded_variation_on s`, REPEAT GEN_TAC THEN TRANS_TAC EQ_TRANS `(\x. norm(v:real^N) % lift(f x)) has_bounded_variation_on s` THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_BOUNDED_VARIATION_ISOMETRIC THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[NORM_MUL; GSYM LIFT_SUB; NORM_LIFT; REAL_ABS_NORM] THEN REWRITE_TAC[REAL_MUL_SYM]; REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_CMUL_EQ; NORM_EQ_0]]);; let HAS_BOUNDED_VARIATION_ON_VMUL = prove (`!f s v:real^N. (\x. lift(f x)) has_bounded_variation_on s ==> (\x. f(x) % v) has_bounded_variation_on s`, SIMP_TAC[HAS_BOUNDED_VARIATION_ON_VMUL_EQ]);; let VECTOR_VARIATION_CMUL = prove (`!f:real^1->real^N s c. f has_bounded_variation_on s ==> vector_variation s (\x. c % f x) = abs c * vector_variation s f`, REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; SET_VARIATION_CMUL]);; let VECTOR_VARIATION_VMUL = prove (`!f s v:real^N. (\x. lift(f x)) has_bounded_variation_on s ==> vector_variation s (\x. f(x) % v) = norm(v) * vector_variation s (\x. lift(f x))`, ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN SIMP_TAC[GSYM VECTOR_VARIATION_CMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_ISOMETRIC THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[NORM_MUL; GSYM LIFT_SUB; NORM_LIFT; REAL_ABS_NORM] THEN REWRITE_TAC[REAL_MUL_SYM]);; let HAS_BOUNDED_VARIATION_ON_NEG = prove (`!f:real^1->real^N s. f has_bounded_variation_on s ==> (\x. --f x) has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[VECTOR_ARITH `--a - --b:real^N = --(a - b)`; HAS_BOUNDED_SETVARIATION_ON_NEG]);; let HAS_BOUNDED_VARIATION_ON_ADD = prove (`!f g:real^1->real^N s. f has_bounded_variation_on s /\ g has_bounded_variation_on s ==> (\x. f x + g x) has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[VECTOR_ARITH `(f + g) - (f' + g'):real^N = (f - f') + (g - g')`; HAS_BOUNDED_SETVARIATION_ON_ADD]);; let HAS_BOUNDED_VARIATION_ON_SUB = prove (`!f g:real^1->real^N s. f has_bounded_variation_on s /\ g has_bounded_variation_on s ==> (\x. f x - g x) has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[VECTOR_ARITH `(f - g) - (f' - g'):real^N = (f - f') - (g - g')`; HAS_BOUNDED_SETVARIATION_ON_SUB]);; let HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR = prove (`!f:real^1->real^M g:real^M->real^N s. f has_bounded_variation_on s /\ linear g ==> (g o f) has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN SIMP_TAC[o_THM; GSYM LINEAR_SUB] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR) THEN REWRITE_TAC[o_DEF]);; let HAS_BOUNDED_VARIATION_ON_NULL = prove (`!f:real^1->real^N s. content s = &0 /\ bounded s ==> f has_bounded_variation_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_NULL THEN ASM_SIMP_TAC[INTERVAL_BOUNDS_NULL_1; VECTOR_SUB_REFL]);; let HAS_BOUNDED_VARIATION_ON_EMPTY = prove (`!f:real^1->real^N. f has_bounded_variation_on {}`, MESON_TAC[CONTENT_EMPTY; BOUNDED_EMPTY; HAS_BOUNDED_VARIATION_ON_NULL]);; let VECTOR_VARIATION_ON_NULL = prove (`!f s. content s = &0 /\ bounded s ==> vector_variation s f = &0`, REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN MATCH_MP_TAC SET_VARIATION_ON_NULL THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[INTERVAL_BOUNDS_NULL_1; VECTOR_SUB_REFL]);; let VECTOR_VARIATION_ON_EMPTY = prove (`!f:real^1->real^N. vector_variation {} f = &0`, REWRITE_TAC[vector_variation; SET_VARIATION_ON_EMPTY]);; let VECTOR_VARIATION_SING = prove (`!f:real^1->real^N a. vector_variation {a} f = &0`, REPEAT GEN_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_ON_NULL THEN REWRITE_TAC[BOUNDED_SING; GSYM INTERVAL_SING] THEN REWRITE_TAC[CONTENT_EQ_0_1; REAL_LE_REFL]);; let HAS_BOUNDED_VARIATION_ON_NORM = prove (`!f:real^1->real^N s. f has_bounded_variation_on s ==> (\x. lift(norm(f x))) has_bounded_variation_on s`, REWRITE_TAC[has_bounded_variation_on; has_bounded_setvariation_on] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP; DROP_SUB] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; NORM_ARITH_TAC]);; let HAS_BOUNDED_VARIATION_ON_MAX = prove (`!f g s. f has_bounded_variation_on s /\ g has_bounded_variation_on s ==> (\x. lift(max (drop(f x)) (drop(g x)))) has_bounded_variation_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `max a b = inv(&2) * (a + b + abs(a - b))`] THEN REWRITE_TAC[LIFT_CMUL; LIFT_ADD; LIFT_DROP; GSYM DROP_SUB] THEN REWRITE_TAC[drop; GSYM NORM_REAL] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CMUL THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NORM THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_REWRITE_TAC[]);; let HAS_BOUNDED_VARIATION_ON_MIN = prove (`!f g s. f has_bounded_variation_on s /\ g has_bounded_variation_on s ==> (\x. lift(min (drop(f x)) (drop(g x)))) has_bounded_variation_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `min a b = inv(&2) * ((a + b) - abs(a - b))`] THEN REWRITE_TAC[LIFT_CMUL; LIFT_ADD; LIFT_DROP; LIFT_SUB; GSYM DROP_SUB] THEN REWRITE_TAC[drop; GSYM NORM_REAL] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CMUL THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ADD] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NORM THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_REWRITE_TAC[]);; let BOUNDED_VECTOR_VARIATION_ON_PASTECART = prove (`!f:real^1->real^N g:real^1->real^P s. f has_bounded_variation_on s /\ g has_bounded_variation_on s ==> (\x. pastecart (f x) (g x)) has_bounded_variation_on s /\ vector_variation s (\x. pastecart (f x) (g x)) <= vector_variation s f + vector_variation s g`, REPEAT GEN_TAC THEN STRIP_TAC THEN SIMP_TAC[HAS_BOUNDED_VECTOR_VARIATION] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `sum d (\k. norm((f:real^1->real^N)(interval_upperbound k) - (f:real^1->real^N)(interval_lowerbound k)) + norm((g:real^1->real^P)(interval_upperbound k) - (g:real^1->real^P)(interval_lowerbound k)))` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM dist; DIST_PASTECART_LE; SUM_LE] THEN ASM_SIMP_TAC[SUM_ADD] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN REWRITE_TAC[dist] THEN ASM_MESON_TAC[HAS_BOUNDED_VARIATION_WORKS]);; let BOUNDED_VARIATION_FROM_PASTECART = prove (`!f:real^1->real^N g:real^1->real^P s. (\x. pastecart (f x) (g x)) has_bounded_variation_on s ==> (f has_bounded_variation_on s /\ vector_variation s f <= vector_variation s (\x. pastecart (f x) (g x))) /\ (g has_bounded_variation_on s /\ vector_variation s g <= vector_variation s (\x. pastecart (f x) (g x)))`, REPEAT STRIP_TAC THEN (FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (INST_TYPE [`:Q`,`:N`] HAS_BOUNDED_VARIATION_COMPARISON))) ORELSE FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (INST_TYPE [`:Q`,`:N`] VECTOR_VARIATION_COMPARISON)))) THEN ASM_REWRITE_TAC[GSYM dist; DIST_LE_PASTECART]);; let HAS_BOUNDED_VARIATION_ON_PASTECART = prove (`!f:real^1->real^N g:real^1->real^P s. (\x. pastecart (f x) (g x)) has_bounded_variation_on s <=> f has_bounded_variation_on s /\ g has_bounded_variation_on s`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_VECTOR_VARIATION_ON_PASTECART] THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_VARIATION_FROM_PASTECART) THEN SIMP_TAC[]);; let HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS = prove (`!f:real^1->real^N s. f has_bounded_variation_on s ==> bounded { f(d) - f(c) | interval[c,d] SUBSET s /\ ~(interval[c,d] = {})}`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`d:real^1`; `c:real^1`] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`c:real^1`; `d:real^1`] THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1]);; let HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED = prove (`!f:real^1->real^N s. f has_bounded_variation_on s /\ is_interval s ==> bounded (IMAGE f s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; BOUNDED_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^1`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS) THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL; LEFT_IMP_EXISTS_THM; TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN X_GEN_TAC `B:real` THEN DISCH_TAC THEN EXISTS_TAC `B + norm((f:real^1->real^N) a)` THEN X_GEN_TAC `b:real^1` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[] `(!x y. P x y /\ Q x y ==> R x y) ==> (!x y. P x y \/ P y x) /\ (!x y. (Q x y ==> R x y) <=> (Q y x ==> R y x)) ==> !x y. Q x y ==> R x y`)) THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; REAL_LE_TOTAL] THEN ANTS_TAC THENL [MESON_TAC[NORM_SUB]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; let HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> bounded(IMAGE f (interval[a,b]))`, MESON_TAC[HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED; IS_INTERVAL_INTERVAL]);; let HAS_BOUNDED_VARIATION_ON_BILINEAR = prove (`!bop:real^M->real^N->real^P f g s. bilinear bop /\ f has_bounded_variation_on s /\ g has_bounded_variation_on s /\ is_interval s ==> (\x. bop (f x) (g x)) has_bounded_variation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `bounded(IMAGE (f:real^1->real^M) s) /\ bounded(IMAGE (g:real^1->real^N) s)` MP_TAC THENL [ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED]; REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[has_bounded_variation_on; has_bounded_setvariation_on] THEN DISCH_THEN(X_CHOOSE_THEN `C2:real` (LABEL_TAC "G")) THEN DISCH_THEN(X_CHOOSE_THEN `C1:real` (LABEL_TAC "F")) THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `D * B1 * C2 + D * B2 * C1:real` THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `D * B1 * sum d (\k. norm((g:real^1->real^N)(interval_upperbound k) - g(interval_lowerbound k))) + D * B2 * sum d (\k. norm((f:real^1->real^M)(interval_upperbound k) - f(interval_lowerbound k)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_MESON_TAC[REAL_LE_LMUL_EQ]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN TRANS_TAC REAL_LE_TRANS `norm((bop:real^M->real^N->real^P) (f v) (g v) - bop (f v) (g u)) + norm(bop (f v) (g u) - bop (f(u:real^1)) (g u))` THEN CONJ_TAC THENL [CONV_TAC NORM_ARITH; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP BILINEAR_LSUB th)] THEN REWRITE_TAC[GSYM(MATCH_MP BILINEAR_RSUB th)]) THEN FIRST_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM]] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN (SUBGOAL_THEN `interval[u:real^1,v] SUBSET s` MP_TAC THENL [ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC]) THEN ASM_MESON_TAC[SUBSET; ENDS_IN_INTERVAL]);; let HAS_BOUNDED_VARIATION_ON_MUL = prove (`!f g:real^1->real^N s. f has_bounded_variation_on s /\ g has_bounded_variation_on s /\ is_interval s ==> (\x. drop(f x) % g x) has_bounded_variation_on s`, REWRITE_TAC[REWRITE_RULE[] (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_BILINEAR) BILINEAR_DROP_MUL)]);; let VECTOR_VARIATION_POS_LE = prove (`!f:real^1->real^N s. f has_bounded_variation_on s ==> &0 <= vector_variation s f`, REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN REWRITE_TAC[SET_VARIATION_POS_LE]);; let VECTOR_VARIATION_GE_NORM_FUNCTION = prove (`!f:real^1->real^N s a b. f has_bounded_variation_on s /\ segment[a,b] SUBSET s ==> norm(f b - f a) <= vector_variation s f`, REWRITE_TAC[FORALL_LIFT] THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM; NORM_SUB]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; has_bounded_variation_on] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\k. (f:real^1->real^N)(interval_upperbound k) - f(interval_lowerbound k)`; `s:real^1->bool`; `a:real^1`; `b:real^1`] SET_VARIATION_GE_FUNCTION) THEN ASM_REWRITE_TAC[vector_variation; INTERVAL_NE_EMPTY_1] THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN ASM_MESON_TAC[SEGMENT_1]);; let VECTOR_VARIATION_GE_DROP_FUNCTION = prove (`!f s a b. f has_bounded_variation_on s /\ segment[a,b] SUBSET s ==> drop(f b) - drop(f a) <= vector_variation s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm((f:real^1->real^1) b - f a)` THEN ASM_SIMP_TAC[VECTOR_VARIATION_GE_NORM_FUNCTION] THEN REWRITE_TAC[NORM_REAL; DROP_SUB; GSYM drop] THEN REAL_ARITH_TAC);; let VECTOR_VARIATION_CONST_EQ = prove (`!f:real^1->real^N s. is_interval s /\ f has_bounded_variation_on s ==> (vector_variation s f = &0 <=> ?c. !x. x IN s ==> f x = c)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN REWRITE_TAC[MESON[] `(?c. !x. P x ==> f x = c) <=> !a b. P a /\ P b ==> f a = f b`] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`; `a:real^1`; `b:real^1`] VECTOR_VARIATION_GE_NORM_FUNCTION) THEN ANTS_TAC THENL [ASM_MESON_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT]; ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH]; DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN MP_TAC(ISPECL [`f:real^1->real^N`; `(\x. c):real^1->real^N`; `s:real^1->bool`] VECTOR_VARIATION_EQ) THEN ASM_SIMP_TAC[VECTOR_VARIATION_CONST]]);; let VECTOR_VARIATION_MONOTONE = prove (`!f s t. f has_bounded_variation_on s /\ t SUBSET s ==> vector_variation t f <= vector_variation s f`, REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN REWRITE_TAC[SET_VARIATION_MONOTONE]);; let VECTOR_VARIATION_NEG = prove (`!f:real^1->real^N s. vector_variation s (\x. --(f x)) = vector_variation s f`, REPEAT GEN_TAC THEN REWRITE_TAC[vector_variation; set_variation] THEN REWRITE_TAC[NORM_ARITH `norm(--x - --y:real^N) = norm(x - y)`]);; let VECTOR_VARIATION_TRIANGLE = prove (`!f g:real^1->real^N s. f has_bounded_variation_on s /\ g has_bounded_variation_on s ==> vector_variation s (\x. f x + g x) <= vector_variation s f + vector_variation s g`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN DISCH_THEN(MP_TAC o MATCH_MP SET_VARIATION_TRIANGLE) THEN REWRITE_TAC[VECTOR_ARITH `(a + b) - (c + d):real^N = (a - c) + (b - d)`]);; let HAS_BOUNDED_VARIATION_ON_VSUM,VECTOR_VARIATION_SUM_LE = (CONJ_PAIR o prove) (`(!f:A->real^1->real^N s k. FINITE k /\ (!i. i IN k ==> f i has_bounded_variation_on s) ==> (\x. vsum k (\i. f i x)) has_bounded_variation_on s) /\ (!f:A->real^1->real^N s k. FINITE k /\ (!i. i IN k ==> f i has_bounded_variation_on s) ==> vector_variation s (\x. vsum k (\i. f i x)) <= sum k (\i. vector_variation s (f i)))`, REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FORALL_IN_INSERT] THEN SIMP_TAC[VECTOR_VARIATION_CONST; REAL_LE_REFL; HAS_BOUNDED_VARIATION_ON_CONST; HAS_BOUNDED_VARIATION_ON_ADD; ETA_AX] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_TRIANGLE o lhand o snd) THEN ASM_SIMP_TAC[ETA_AX] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LADD]);; let OPERATIVE_FUNCTION_ENDPOINT_DIFF = prove (`!f:real^1->real^N. operative (+) (\k. f (interval_upperbound k) - f (interval_lowerbound k))`, GEN_TAC THEN SIMP_TAC[operative; INTERVAL_BOUNDS_NULL_1; VECTOR_SUB_REFL] THEN REWRITE_TAC[NEUTRAL_VECTOR_ADD; DIMINDEX_1; FORALL_1; GSYM drop] THEN REWRITE_TAC[FORALL_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`] THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL [ASM_REWRITE_TAC[INTER_EMPTY; INTERVAL_BOUNDS_EMPTY_1] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `interval[a,b] INTER {x | drop x <= drop c} = {}` THENL [ASM_REWRITE_TAC[INTERVAL_BOUNDS_EMPTY_1; VECTOR_SUB_REFL] THEN SUBGOAL_THEN `interval[a,b] INTER {x | drop x >= drop c} = interval[a,b]` (fun th -> REWRITE_TAC[th; VECTOR_ADD_LID]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `i INTER s = {} ==> s UNION t = UNIV ==> i INTER t = i`)) THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `interval[a,b] INTER {x | drop x >= drop c} = {}` THENL [ASM_REWRITE_TAC[INTERVAL_BOUNDS_EMPTY_1; VECTOR_SUB_REFL] THEN SUBGOAL_THEN `interval[a,b] INTER {x | drop x <= drop c} = interval[a,b]` (fun th -> REWRITE_TAC[th; VECTOR_ADD_RID]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `i INTER s = {} ==> s UNION t = UNIV ==> i INTER t = i`)) THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SIMP_TAC[INTERVAL_SPLIT; drop; DIMINDEX_1; LE_REFL] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN SIMP_TAC[drop; LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `fx:real^N = fy ==> fb - fa = fx - fa + fb - fy`) THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; drop] THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN ASM_REAL_ARITH_TAC);; let OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF = prove (`!f:real^1->real. operative (+) (\k. f (interval_upperbound k) - f (interval_lowerbound k))`, GEN_TAC THEN MP_TAC(ISPEC `lift o (f:real^1->real)` OPERATIVE_FUNCTION_ENDPOINT_DIFF) THEN REWRITE_TAC[operative; NEUTRAL_REAL_ADD; NEUTRAL_VECTOR_ADD] THEN REWRITE_TAC[o_THM; GSYM LIFT_SUB; GSYM LIFT_ADD; GSYM LIFT_NUM] THEN REWRITE_TAC[LIFT_EQ]);; let OPERATIVE_HAS_BOUNDED_VARIATION_ON = prove (`!f:real^1->real^N. operative (/\) ((has_bounded_variation_on) f)`, GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC OPERATIVE_HAS_BOUNDED_SETVARIATION_ON THEN REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; let OPERATIVE_LIFTED_VECTOR_VARIATION = prove (`!f:real^1->real^N. operative (lifted(+)) (\i. if f has_bounded_variation_on i then SOME(vector_variation i f) else NONE)`, GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN MATCH_MP_TAC OPERATIVE_LIFTED_SETVARIATION THEN REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; let HAS_BOUNDED_VARIATION_ON_DIVISION = prove (`!f:real^1->real^N a b d. d division_of interval[a,b] ==> ((!k. k IN d ==> f has_bounded_variation_on k) <=> f has_bounded_variation_on interval[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_DIVISION THEN ASM_REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; let VECTOR_VARIATION_ON_DIVISION = prove (`!f:real^1->real^N a b d. d division_of interval[a,b] /\ f has_bounded_variation_on interval[a,b] ==> sum d (\k. vector_variation k f) = vector_variation (interval[a,b]) f`, REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN MATCH_MP_TAC SET_VARIATION_ON_DIVISION THEN ASM_REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF; GSYM has_bounded_variation_on]);; let HAS_BOUNDED_VARIATION_ON_CLOSURE = prove (`!f:real^1->real^N s. is_interval s /\ f has_bounded_variation_on s ==> f has_bounded_variation_on (closure s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP CARD_FRONTIER_INTERVAL_1) THEN SUBGOAL_THEN `bounded (IMAGE (f:real^1->real^N) (closure s))` MP_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (f:real^1->real^N) (s UNION frontier s)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IMAGE_UNION; BOUNDED_UNION] THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED] THEN ASM_SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE]; REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^1->bool` INTERIOR_SUBSET) THEN SET_TAC[]]; REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(f:real^1->real^N) has_bounded_variation_on s` THEN REWRITE_TAC[has_bounded_setvariation_on; has_bounded_variation_on] THEN DISCH_THEN(X_CHOOSE_THEN `K:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `K + &8 * B` THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `u:real^1->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN SUBGOAL_THEN `d = { k:real^1->bool | k IN d /\ k SUBSET s} UNION {k | k IN d /\ ~(k SUBSET s)}` SUBST1_TAC THENL [SET_TAC[]; ALL_TAC] THEN IMP_REWRITE_TAC[SUM_UNION] THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2; SET_TAC[]] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `UNIONS {k:real^1->bool | k IN d /\ k SUBSET s}` THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET; SET_TAC[]] THEN EXISTS_TAC `d:(real^1->bool)->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; SET_TAC[]]; ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN REWRITE_TAC[support; IN_ELIM_THM; NEUTRAL_REAL_ADD] THEN REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN MP_TAC(ISPECL [`{k | (k IN d /\ ~(k SUBSET s)) /\ ~((f:real^1->real^N)(interval_upperbound k) = f (interval_lowerbound k))}`; `\k. norm ((f:real^1->real^N) (interval_upperbound k) - f (interval_lowerbound k))`; `&2 * B`] SUM_BOUND) THEN ASM_SIMP_TAC[GSYM CONJ_ASSOC; FINITE_RESTRICT; FORALL_IN_GSPEC] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(x) <= B /\ norm(y) <= B ==> norm(y - x:real^N) <= &2 * B`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `interval[a:real^1,b]` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `u SUBSET s /\ x IN i ==> i SUBSET u /\ P x ==> x IN s`) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_LE_RMUL_EQ] THEN REWRITE_TAC[REAL_ARITH `x * &2 <= &8 <=> x <= &4`] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN TRANS_TAC LE_TRANS `CARD(UNIONS {{k | k IN d /\ ~(content k = &0) /\ x IN k} | (x:real^1) IN frontier s})` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_SUBSET THEN ASM_SIMP_TAC[FINITE_UNIONS; FORALL_IN_GSPEC; FINITE_RESTRICT] THEN ASM_SIMP_TAC[FINITE_IMAGE; SIMPLE_IMAGE; UNIONS_IMAGE] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN SIMP_TAC[INTERVAL_NE_EMPTY_1; CONTENT_1; REAL_SUB_0; DROP_EQ] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s SUBSET t) ==> s SUBSET closure t ==> ?x. x IN (closure t DIFF t) /\ x IN s`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[division_of; SUBSET]; ALL_TAC] THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^1->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]; TRANS_TAC LE_TRANS `CARD(frontier s:real^1->bool) * 2` THEN CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC CARD_UNIONS_LE THEN ASM_SIMP_TAC[GSYM FINITE_HAS_SIZE; FINITE_RESTRICT] THEN SUBST1_TAC(ARITH_RULE `2 = 2 EXP 1`) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIMINDEX_1] THEN MATCH_MP_TAC DIVISION_COMMON_POINT_BOUND THEN ASM_MESON_TAC[]]]]]);; let HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ = prove (`!f:real^1->real^N s. is_interval s ==> (f has_bounded_variation_on closure s <=> f has_bounded_variation_on s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_CLOSURE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_VARIATION_ON_SUBSET) THEN REWRITE_TAC[CLOSURE_SUBSET]);; let HAS_BOUNDED_VARIATION_ON_SING = prove (`!f a. f has_bounded_variation_on {a}`, REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NULL THEN REWRITE_TAC[GSYM INTERVAL_SING; BOUNDED_INTERVAL] THEN REWRITE_TAC[CONTENT_EQ_0_1; REAL_LE_REFL]);; let VECTOR_VARIATION_LE_UNION = prove (`!f:real^1->real^N s t. f has_bounded_variation_on (s UNION t) /\ interior s INTER interior t = {} ==> vector_variation s f + vector_variation t f <= vector_variation (s UNION t) f`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_LADD] THEN SUBGOAL_THEN `(f:real^1->real^N) has_bounded_variation_on s /\ (f:real^1->real^N) has_bounded_variation_on t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; SUBSET_UNION]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`] HAS_BOUNDED_VECTOR_VARIATION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MAP_EVERY X_GEN_TAC [`ds:(real^1->bool)->bool`; `s':real^1->bool`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= b - c <=> c <= b - a`] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `t:real^1->bool`] HAS_BOUNDED_VECTOR_VARIATION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MAP_EVERY X_GEN_TAC [`dt:(real^1->bool)->bool`; `t':real^1->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `s UNION t:real^1->bool`] HAS_BOUNDED_VARIATION_WORKS) THEN ASM_REWRITE_TAC[REAL_LE_SUB_LADD] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN DISCH_THEN(MP_TAC o SPECL [`ds UNION dt:(real^1->bool)->bool`; `s' UNION t':real^1->bool`]) THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC DIVISION_DISJOINT_UNION; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t = {} ==> s' SUBSET s /\ t' SUBSET t ==> s' INTER t' = {}`)) THEN ASM_SIMP_TAC[SUBSET_INTERIOR]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC SUM_UNION_NONZERO THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC]) THEN REWRITE_TAC[IN_INTER; IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN SIMP_TAC[INTERVAL_UPPERBOUND_NONEMPTY; INTERVAL_LOWERBOUND_NONEMPTY] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[GSYM DROP_EQ] THEN SUBGOAL_THEN `interior(interval[a:real^1,b]) = {}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t = {} ==> u SUBSET s /\ u SUBSET t ==> u = {}`)) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM]]]);; let HAS_BOUNDED_VARIATION_ON_UNION,VECTOR_VARIATION_UNION_LE = (CONJ_PAIR o prove) (`(!f:real^1->real^N s t. is_interval s /\ is_interval t /\ f has_bounded_variation_on s /\ f has_bounded_variation_on t ==> f has_bounded_variation_on (s UNION t)) /\ (!f:real^1->real^N s t. is_interval s /\ is_interval t /\ (s INTER t = {} ==> s INTER closure t = {} /\ t INTER closure s = {}) /\ f has_bounded_variation_on s /\ f has_bounded_variation_on t ==> vector_variation (s UNION t) f <= vector_variation s f + vector_variation t f)`, SUBGOAL_THEN `!f:real^1->real^N s t. is_interval s /\ is_interval t /\ (s INTER t = {} ==> s INTER closure t = {} /\ t INTER closure s = {}) /\ f has_bounded_variation_on s /\ f has_bounded_variation_on t ==> f has_bounded_variation_on (s UNION t) /\ vector_variation (s UNION t) f <= vector_variation s f + vector_variation t f` ASSUME_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC; ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`f:real^1->real^N`; `closure s:real^1->bool`; `closure t:real^1->bool`]) THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ] THEN SIMP_TAC[CLOSURE_CLOSURE] THEN RULE_ASSUM_TAC(REWRITE_RULE[IS_INTERVAL_CONVEX_1]) THEN ASM_SIMP_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CLOSURE] THEN ANTS_TAC THENL [SET_TAC[]; DISCH_THEN(MP_TAC o CONJUNCT1)] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_VARIATION_ON_SUBSET) THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s UNION t SUBSET s' UNION t'`) THEN REWRITE_TAC[CLOSURE_SUBSET]] THEN ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[UNION_EMPTY; VECTOR_VARIATION_ON_EMPTY] THEN REWRITE_TAC[REAL_ADD_LID; REAL_LE_REFL] THEN ASM_CASES_TAC `t:real^1->bool = {}` THEN ASM_REWRITE_TAC[UNION_EMPTY; VECTOR_VARIATION_ON_EMPTY] THEN REWRITE_TAC[REAL_ADD_RID; REAL_LE_REFL] THEN REWRITE_TAC[HAS_BOUNDED_VECTOR_VARIATION] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `u:real^1->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `!i. i IN d ==> ?j k. ~(j = {}) /\ ~(k = {}) /\ (?a b. j = interval[a,b]) /\ (?a b. k = interval[a,b]) /\ j SUBSET s /\ k SUBSET t /\ (j SUBSET i \/ interior j = {}) /\ (k SUBSET i \/ interior k = {}) /\ norm((f:real^1->real^N)(interval_upperbound i) - f(interval_lowerbound i)) <= norm((f(interval_upperbound j) - f(interval_lowerbound j))) + norm((f(interval_upperbound k) - f(interval_lowerbound k)))` MP_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `{a:real^1,b} SUBSET s UNION t` MP_TAC THENL [TRANS_TAC SUBSET_TRANS `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_UNION]] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:real^1->bool`; `s:real^1->bool`] THEN MATCH_MP_TAC(MESON[] `(!s t. R s t ==> R t s) /\ (!s t. P s /\ Q s ==> R s t) /\ (!s t. P s /\ Q t ==> R s t) ==> !s t. (P s \/ P t) /\ (Q s \/ Q t) ==> R s t`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[REAL_ADD_SYM; UNION_COMM; INTER_COMM]; REPEAT STRIP_TAC THEN UNDISCH_TAC `~(t:real^1->bool = {})` THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `q:real^1`) THEN EXISTS_TAC `interval[a:real^1,b]` THEN EXISTS_TAC `interval[q:real^1,q]` THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; REAL_LE_REFL; VECTOR_SUB_REFL; NORM_0; REAL_ADD_RID] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; REAL_LE_REFL] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[INTERVAL_SING; INTERIOR_SING; SING_SUBSET] THEN REWRITE_TAC[SUBSET_REFL] THEN TRANS_TAC SUBSET_TRANS `segment[a:real^1,b]` THEN REWRITE_TAC[INTERVAL_SUBSET_SEGMENT_1] THEN ASM_MESON_TAC[SEGMENT_SUBSET_CONVEX; IS_INTERVAL_CONVEX_1]; REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^1. c IN interval[a,b] /\ c IN s /\ c IN t` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `(p ==> q) ==> (~p ==> r) /\ ~q ==> r`)) THEN CONJ_TAC THENL [SIMP_TAC[LEFT_IMP_EXISTS_THM; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN X_GEN_TAC `c:real^1` THEN STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN SUBGOAL_THEN `drop a <= drop c /\ drop c <= drop b \/ drop c <= drop a \/ drop b <= drop c` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]; EXISTS_TAC `a:real^1` THEN UNDISCH_TAC `is_interval(t:real^1->bool)`; EXISTS_TAC `b:real^1` THEN UNDISCH_TAC `is_interval(s:real^1->bool)`] THEN ASM_REWRITE_TAC[IS_INTERVAL_1; REAL_LE_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[]; DISCH_TAC THEN MP_TAC(ISPEC `interval[a:real^1,b]` CONNECTED_SEPARATION) THEN REWRITE_TAC[CONNECTED_INTERVAL; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`s INTER interval[a:real^1,b]`; `t INTER interval[a:real^1,b]`]) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `b:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]; FIRST_X_ASSUM(MP_TAC o CONJUNCT1); FIRST_X_ASSUM(MP_TAC o CONJUNCT2)] THEN MATCH_MP_TAC(SET_RULE `s' SUBSET s /\ t' SUBSET t ==> s INTER t = {} ==> s' INTER t' = {}`) THEN REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[INTER_SUBSET]]; EXISTS_TAC `interval[a:real^1,c]` THEN EXISTS_TAC `interval[c:real^1,b]` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1; IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; STRIP_TAC] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN W(MP_TAC o PART_MATCH lhand INTERVAL_SUBSET_SEGMENT_1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1]; RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1; IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; SUBSET_INTER] THEN MAP_EVERY X_GEN_TAC [`l:(real^1->bool)->real^1->bool`; `r:(real^1->bool)->real^1->bool`] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN TRANS_TAC REAL_LE_TRANS `sum d (\k:real^1->bool. norm(((f:real^1->real^N)(interval_upperbound(l k)) - f(interval_lowerbound (l k)))) + norm((f(interval_upperbound(r k)) - f(interval_lowerbound (r k)))))` THEN ASM_SIMP_TAC[SUM_LE] THEN ASM_SIMP_TAC[SUM_ADD] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MP_TAC(ISPECL [`\k. norm((f:real^1->real^N)(interval_upperbound k) - f(interval_lowerbound k))`; `d:(real^1->bool)->bool`] (GEN_REWRITE_RULE BINDER_CONV [SWAP_FORALL_THM] SUM_IMAGE_NONZERO)) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (rand o rand) th o lhand o snd)) THEN REWRITE_TAC[] THEN (ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`i:real^1->bool`; `j:real^1->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o AP_TERM `interior:(real^1->bool)->real^1->bool`) THEN SUBGOAL_THEN `interior i INTER interior j:real^1->bool = {}` MP_TAC THENL [ASM_MESON_TAC[division_of]; REWRITE_TAC[IMP_IMP]] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `i INTER j = {} /\ i' = j' ==> (i' SUBSET i \/ i' = {}) /\ (j' SUBSET j \/ j' = {}) ==> i' = {}`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_INTERIOR]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (interior s = {} /\ ~(s = {}) ==> P) ==> interior s = {} ==> P`) THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:real^1->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC o CONJUNCT2 o CONJUNCT2) THEN REPEAT(FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC)) THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; NORM_EQ_0; VECTOR_SUB_EQ; INTERIOR_INTERVAL] THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)]) THEN MP_TAC(ISPEC `f:real^1->real^N` HAS_BOUNDED_VARIATION_WORKS) THENL [DISCH_THEN(MP_TAC o SPEC `s:real^1->bool`); DISCH_THEN(MP_TAC o SPEC `t:real^1->bool`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THENL [EXISTS_TAC `UNIONS(IMAGE (l:(real^1->bool)->real^1->bool) d)`; EXISTS_TAC `UNIONS(IMAGE (r:(real^1->bool)->real^1->bool) d)`] THEN (CONJ_TAC THENL [ASM_SIMP_TAC[DIVISION_OF; FINITE_IMAGE]; REWRITE_TAC[UNIONS_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]]) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `i:real^1->bool` THEN DISCH_TAC THEN X_GEN_TAC `j:real^1->bool` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [division_of]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`i:real^1->bool`; `j:real^1->bool`]) THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC(SET_RULE `(s' SUBSET s \/ s' = {}) /\ (t' SUBSET t \/ t' = {}) ==> s INTER t = {} ==> s' INTER t' = {}`) THEN ASM_MESON_TAC[SUBSET_INTERIOR]);; let HAS_BOUNDED_VARIATION_ON_SPLIT = prove (`!f:real^1->real^N s a. is_interval s ==> (f has_bounded_variation_on s <=> f has_bounded_variation_on {x | x IN s /\ drop x <= a} /\ f has_bounded_variation_on {x | x IN s /\ a <= drop x})`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT]; DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] HAS_BOUNDED_VARIATION_ON_UNION)) THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN ANTS_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_INTER THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM UNION_OVER_INTER] THEN REWRITE_TAC[UNION] THEN REWRITE_TAC[IN_ELIM_THM; REAL_LE_TOTAL; UNIV_GSPEC; INTER_UNIV]]]);; let VECTOR_VARIATION_SPLIT = prove (`!f:real^1->real^N s a. is_interval s /\ f has_bounded_variation_on s ==> vector_variation {x | x IN s /\ drop x <= a} f + vector_variation {x | x IN s /\ a <= drop x} f = vector_variation s f`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s = {x | x IN s /\ drop x <= a} UNION {x | x IN s /\ a <= drop x}` MP_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[REAL_LE_TOTAL]; DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [th])] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_LE_UNION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN SET_TAC[]; MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN EXISTS_TAC `interior {x:real^1 | x$1 <= a} INTER interior {x | x$1 >= a}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'`) THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[drop; real_ge] THEN SET_TAC[]; REWRITE_TAC[INTERIOR_HALFSPACE_COMPONENT_LE; INTERIOR_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC]]; MATCH_MP_TAC VECTOR_VARIATION_UNION_LE THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_INTER THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IS_INTERVAL_1_CASES] THEN MESON_TAC[]; CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} INTER {x | x IN s /\ Q x} = {} <=> (!x. P x /\ Q x ==> ~(x IN s))`] THEN REWRITE_TAC[REAL_LE_ANTISYM; GSYM LIFT_EQ; LIFT_DROP] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ drop x <= a} = {} \/ {x | x IN s /\ a <= drop x} = {}` (fun th -> DISJ_CASES_THEN SUBST1_TAC th THEN REWRITE_TAC[CLOSURE_EMPTY] THEN SET_TAC[]) THEN MATCH_MP_TAC(SET_RULE `(!a b. a IN s /\ b IN t ==> F) ==> s = {} \/ t = {}`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^1` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `v:real^1` THEN DISCH_THEN(MP_TAC o SPEC `lift a`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; LIFT_DROP; REAL_LE_REFL] THEN CONV_TAC TAUT; CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN SET_TAC[]]]]);; let HAS_BOUNDED_VARIATION_ON_COMBINE = prove (`!f:real^1->real^N a b c. drop a <= drop c /\ drop c <= drop b ==> (f has_bounded_variation_on interval[a,b] <=> f has_bounded_variation_on interval[a,c] /\ f has_bounded_variation_on interval[c,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `interval[a:real^1,b]`; `drop c`] HAS_BOUNDED_VARIATION_ON_SPLIT) THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN DISCH_THEN SUBST1_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let VECTOR_VARIATION_COMBINE = prove (`!f:real^1->real^N a b c. drop a <= drop c /\ drop c <= drop b /\ f has_bounded_variation_on interval[a,b] ==> vector_variation (interval[a,c]) f + vector_variation (interval[c,b]) f = vector_variation (interval[a,b]) f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `interval[a:real^1,b]`; `drop c`] VECTOR_VARIATION_SPLIT) THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_LEFT = prove (`!f s a b. f has_bounded_variation_on s /\ is_interval s /\ a IN s /\ b IN s /\ drop a <= drop b ==> vector_variation {x | x IN s /\ drop x <= drop a} f - drop(f a) <= vector_variation {x | x IN s /\ drop x <= drop b} f - drop(f b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `{x | x IN s /\ drop x <= drop b}`; `drop a`] VECTOR_VARIATION_SPLIT) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC IS_INTERVAL_INTER THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IS_INTERVAL_1_CASES] THEN REWRITE_TAC[EXISTS_DROP] THEN MESON_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN SET_TAC[]]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC] THEN ASM_SIMP_TAC[REAL_ARITH `a <= b ==> (x <= b /\ x <= a <=> x <= a)`] THEN REWRITE_TAC[REAL_ARITH `v - a <= (v + c) - b <=> b - a <= c`] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_DROP_FUNCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN SET_TAC[]; MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_LE_REFL] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ Q x /\ P x} = s INTER {x | P x /\ Q x}`] THEN MATCH_MP_TAC CONVEX_INTER THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1] THEN REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_RIGHT = prove (`!f s a b. f has_bounded_variation_on s /\ is_interval s /\ a IN s /\ b IN s /\ drop a <= drop b ==> vector_variation {x | x IN s /\ drop b <= drop x} f - drop(f b) <= vector_variation {x | x IN s /\ drop a <= drop x} f - drop(f a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `{x | x IN s /\ drop a <= drop x}`; `drop b`] VECTOR_VARIATION_SPLIT) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC IS_INTERVAL_INTER THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IS_INTERVAL_1_CASES] THEN REWRITE_TAC[EXISTS_DROP] THEN MESON_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN SET_TAC[]]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC] THEN ASM_SIMP_TAC[REAL_ARITH `a <= b ==> (a <= x /\ b <= x <=> b <= x)`] THEN REWRITE_TAC[REAL_ARITH `v - a <= (c + v) - b <=> b - a <= c`] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_DROP_FUNCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN SET_TAC[]; MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_LE_REFL] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ Q x /\ P x} = s INTER {x | P x /\ Q x}`] THEN MATCH_MP_TAC CONVEX_INTER THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1] THEN REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let VECTOR_VARIATION_SEGMENT_TRIANGLE = prove (`!f:real^1->real^N s a b c. f has_bounded_variation_on s /\ is_interval s /\ a IN s /\ b IN s /\ c IN s ==> vector_variation (segment[a,c]) f <= vector_variation (segment[a,b]) f + vector_variation (segment[b,c]) f`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `drop a <= drop b /\ drop b <= drop c \/ drop a <= drop c /\ drop c <= drop b \/ drop b <= drop a /\ drop a <= drop c \/ drop b <= drop c /\ drop c <= drop a \/ drop c <= drop a /\ drop a <= drop b \/ drop c <= drop b /\ drop b <= drop a`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LE_TRANS) THEN ASM_REWRITE_TAC[SEGMENT_1] THEN REWRITE_TAC[GSYM SEGMENT_1] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[SEGMENT_1] THEN REWRITE_TAC[GSYM SEGMENT_1] THEN FIRST_ASSUM(MP_TAC o ISPEC `f:real^1->real^N` o MATCH_MP (ONCE_REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] VECTOR_VARIATION_COMBINE)) THEN (ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN REWRITE_TAC[REAL_ADD_SYM; REAL_LE_REFL] THEN REPEAT(MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> x <= x + y`) ORELSE (MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x <= z ==> x <= y + z`) THEN CONJ_TAC)) THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL]);; let HAS_BOUNDED_VARIATION_ON_VECTOR_VARIATION, VECTOR_VARIATION_VECTOR_VARIATION = (CONJ_PAIR o prove) (`(!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> (\x. lift(vector_variation (interval [a,x]) f)) has_bounded_variation_on interval[a,b]) /\ (!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> vector_variation (interval[a,b]) (\x. lift(vector_variation (interval [a,x]) f)) = vector_variation (interval[a,b]) f)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `(f:real^1->real^N) has_bounded_variation_on interval[a,b]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(TAUT `(p /\ q) /\ (p ==> r) ==> p /\ q /\ r`) THEN CONJ_TAC THENL [REWRITE_TAC[HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL] THEN X_GEN_TAC `d:(real^1->bool)->bool` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `b:real^1`; `d:(real^1->bool)->bool`] VECTOR_VARIATION_ON_DIVISION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN STRIP_TAC THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `v:real^1`; `u:real^1`] VECTOR_VARIATION_COMBINE) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `interval[u:real^1,v]` o el 1 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1]) THEN ANTS_TAC THENL [REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]); DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs((a + x) - a) <= x`) THEN MATCH_MP_TAC VECTOR_VARIATION_POS_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; DISCH_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_COMPARISON THEN ASM_REWRITE_TAC[dist; GSYM LIFT_SUB; NORM_LIFT] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `v:real^1`; `u:real^1`] VECTOR_VARIATION_COMBINE) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ANTS_TAC THENL [REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]); DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `a <= y ==> a <= abs(x - (x + y))`) THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ASM_REWRITE_TAC[SEGMENT_1; GSYM REAL_NOT_LT; SUBSET_REFL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);; let VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE = prove (`!f a b c d. f has_bounded_variation_on interval[a,b] /\ interval[c,d] SUBSET interval[a,b] /\ ~(interval[c,d] = {}) ==> vector_variation (interval[c,d]) f - drop(f d - f c) <= vector_variation (interval[a,b]) f - drop(f b - f a)`, REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `drop(f c) - drop(f a) <= vector_variation(interval[a,c]) f /\ drop(f b) - drop(f d) <= vector_variation(interval[d,b]) f` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_GE_DROP_FUNCTION THEN ASM_REWRITE_TAC[SEGMENT_1; SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1] THEN (CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[DROP_SUB] THEN MP_TAC(ISPEC `f:real^1->real^1` VECTOR_VARIATION_COMBINE) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`a:real^1`; `b:real^1`; `d:real^1`] th) THEN MP_TAC(SPECL [`a:real^1`; `d:real^1`; `c:real^1`] th)) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]);; let HAS_BOUNDED_VARIATION_NONTRIVIAL = prove (`!f:real^1->real^N s. f has_bounded_variation_on s <=> ?B. !d t. d division_of t /\ t SUBSET s /\ (!k. k IN d ==> ~(interior k = {})) ==> sum d (\k. norm(f(interval_upperbound k) - f (interval_lowerbound k))) <= B`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[has_bounded_setvariation_on] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `B:real` THEN REWRITE_TAC[] THEN EQ_TAC THENL [MESON_TAC[]; DISCH_TAC] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN ABBREV_TAC `d' = {k:real^1->bool | k IN d /\ ~(interior k = {})}` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d':(real^1->bool)->bool`; `UNIONS d':real^1->bool`]) THEN ANTS_TAC THENL [EXPAND_TAC "d'" THEN SIMP_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET THEN EXISTS_TAC `d:(real^1->bool)->bool` THEN REWRITE_TAC[SUBSET_RESTRICT] THEN ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; TRANS_TAC SUBSET_TRANS `t:real^1->bool` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `UNIONS d:real^1->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]; ASM_MESON_TAC[division_of; SUBSET_REFL]]]; MATCH_MP_TAC(REAL_ARITH `y:real = x ==> x <= b ==> y <= b`) THEN MATCH_MP_TAC SUM_SUPERSET THEN EXPAND_TAC "d'" THEN REWRITE_TAC[SUBSET_RESTRICT; IN_ELIM_THM; TAUT `p /\ ~(p /\ ~q) ==> r <=> p ==> q ==> r`] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[INTERVAL_EQ_EMPTY_1; IMP_IMP; GSYM CONJ_ASSOC] THEN SIMP_TAC[REAL_LE_ANTISYM; DROP_EQ; VECTOR_SUB_REFL; NORM_0]]);; let INCREASING_BOUNDED_VARIATION_GEN = prove (`!f s. bounded(IMAGE f s) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> f has_bounded_variation_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_NONTRIVIAL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&2 * B` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`d:(real^1->bool)->bool`; `t:real^1->bool`] DIVISION_1_SORT) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `t:num->real^1->bool`] THEN STRIP_TAC THEN EXPAND_TAC "d" THEN IMP_REWRITE_TAC[SUM_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF]; ASM_MESON_TAC[LT_CASES]] THEN SUBGOAL_THEN `!k. k IN d ==> interval_lowerbound (k:real^1->bool) IN k INTER s /\ interval_upperbound k IN k INTER s /\ drop(interval_lowerbound k) <= drop(interval_upperbound k)` MP_TAC THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[IN_INTER] THEN ASM_MESON_TAC[division_of; ENDS_IN_INTERVAL; SUBSET; INTERVAL_NE_EMPTY_1]; EXPAND_TAC "d" THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTER] THEN STRIP_TAC] THEN SUBGOAL_THEN `!m. 1 <= m /\ m <= n ==> sum(1..m) (\i. norm(f(interval_upperbound(t i)) - (f:real^1->real^1)(interval_lowerbound(t i)))) <= drop(f(interval_upperbound(t m))) - drop(f(interval_lowerbound(t 1)))` (MP_TAC o SPEC `n:num`) THENL [MATCH_MP_TAC num_INDUCTION THEN SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH] THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[ARITH; SUM_CLAUSES_NUMSEG] THENL [DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> &0 + x <= y`) THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `y <= x ==> abs(x - y) = x - y`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_NUMSEG; LE_REFL]; DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `b + x <= y ==> s <= b ==> s + x <= y`) THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `um <= ls /\ ls <= us ==> (um - l1) + abs(us - ls) <= us - l1`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[IN_NUMSEG]] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[IN_NUMSEG; LE_1; ARITH_RULE `SUC m <= n ==> m <= n`]; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `SUC m`]) THEN REWRITE_TAC[IN_NUMSEG] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MATCH_MP_TAC o CONJUNCT2)] THEN ASM_MESON_TAC[IN_NUMSEG; LE_1; ARITH_RULE `SUC m <= n ==> m <= n`]]; ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[LE_1; LE_REFL]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC(REAL_ARITH `(norm x = abs(drop x) /\ norm y = abs(drop y)) /\ (norm(x) <= B /\ norm(y) <= B) ==> drop x - drop y <= &2 * B`) THEN CONJ_TAC THENL [REWRITE_TAC[NORM_REAL; GSYM drop]; ALL_TAC] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_NUMSEG; LE_REFL; LE_1]]);; let DECREASING_BOUNDED_VARIATION_GEN = prove (`!f s. bounded(IMAGE f s) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> f has_bounded_variation_on s`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(--) o (f:real^1->real^1)`; `s:real^1->bool`] INCREASING_BOUNDED_VARIATION_GEN) THEN ASM_REWRITE_TAC[DROP_NEG; o_THM; REAL_LE_NEG2] THEN ASM_SIMP_TAC[BOUNDED_NEGATIONS; IMAGE_o] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NEG) THEN REWRITE_TAC[o_DEF; VECTOR_NEG_NEG; ETA_AX]);; let INCREASING_BOUNDED_VARIATION = prove (`!f a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> f has_bounded_variation_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION_GEN THEN ASM_REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `max (norm((f:real^1->real^1) a)) (norm((f:real^1->real^1) b))` THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`a:real^1`; `x:real^1`] th) THEN MP_TAC(SPECL [`x:real^1`; `b:real^1`] th)) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN REAL_ARITH_TAC);; let DECREASING_BOUNDED_VARIATION = prove (`!f a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> f has_bounded_variation_on interval[a,b]`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV) [GSYM REAL_LE_NEG2] THEN REWRITE_TAC[GSYM DROP_NEG] THEN DISCH_THEN(MP_TAC o MATCH_MP INCREASING_BOUNDED_VARIATION) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NEG) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; let INCREASING_VECTOR_VARIATION = prove (`!f a b. ~(interval[a,b] = {}) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> vector_variation (interval[a,b]) f = drop(f b) - drop(f a)`, REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN REWRITE_TAC[SET_VARIATION_ON_INTERVAL] THEN SUBGOAL_THEN `{sum d (\k. norm (f (interval_upperbound k) - f (interval_lowerbound k))) | d division_of interval[a:real^1,b]} = {drop (f b) - drop(f a)}` (fun th -> SIMP_TAC[SUP_INSERT_FINITE; FINITE_EMPTY; th]) THEN MATCH_MP_TAC(SET_RULE `(?x. P x) /\ (!x. P x ==> f x = a) ==> {f x | P x} = {a}`) THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_SELF]; ALL_TAC] THEN MP_TAC(MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] OPERATIVE_DIVISION) (SPEC `drop o (f:real^1->real^1)` OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF)) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[GSYM sum; MONOIDAL_REAL_ADD] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN ASM_SIMP_TAC[o_THM; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN SUBGOAL_THEN `~(interval[u:real^1,v] = {})` ASSUME_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN ASM_SIMP_TAC[DROP_SUB; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> abs(y - x) = y - x`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[division_of]; REWRITE_TAC[SUBSET_INTERVAL_1]] THEN ASM_REAL_ARITH_TAC);; let DECREASING_VECTOR_VARIATION = prove (`!f a b. ~(interval[a,b] = {}) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> vector_variation (interval[a,b]) f = drop(f a) - drop(f b)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV) [GSYM REAL_LE_NEG2] THEN REWRITE_TAC[GSYM DROP_NEG] THEN DISCH_THEN(MP_TAC o MATCH_MP INCREASING_VECTOR_VARIATION) THEN SIMP_TAC[VECTOR_VARIATION_NEG; DROP_NEG] THEN DISCH_TAC THEN REAL_ARITH_TAC);; let VECTOR_VARIATION_ID = prove (`!a b. vector_variation (interval[a,b]) (\x. x) = if interval[a,b] = {} then &0 else drop b - drop a`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_VARIATION_ON_EMPTY] THEN W(MP_TAC o PART_MATCH (lhand o rand) INCREASING_VECTOR_VARIATION o lhand o snd) THEN ASM_SIMP_TAC[]);; let HAS_BOUNDED_VARIATION_TRANSLATION2_EQ,VECTOR_VARIATION_TRANSLATION2 = (CONJ_PAIR o prove) (`(!a f:real^1->real^N s. (\x. f(a + x)) has_bounded_variation_on (IMAGE (\x. --a + x) s) <=> f has_bounded_variation_on s) /\ (!a f:real^1->real^N s. vector_variation (IMAGE (\x. --a + x) s) (\x. f(a + x)) = vector_variation s f)`, GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `a:real^1` THEN MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN REWRITE_TAC[] THEN CONJ_TAC THENL [VECTOR_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[DIVISION_OF_TRANSLATION; GSYM INTERVAL_TRANSLATION]);; let HAS_BOUNDED_VARIATION_AFFINITY2_EQ,VECTOR_VARIATION_AFFINITY2 = (CONJ_PAIR o prove) (`(!m c f:real^1->real^N s. (\x. f (m % x + c)) has_bounded_variation_on IMAGE (\x. inv m % x + --(inv m % c)) s <=> m = &0 \/ f has_bounded_variation_on s) /\ (!m c f:real^1->real^N s. vector_variation (IMAGE (\x. inv m % x + --(inv m % c)) s) (\x. f (m % x + c)) = if m = &0 then &0 else vector_variation s f)`, GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `m:real` THEN GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `c:real^1` THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; HAS_BOUNDED_VARIATION_ON_CONST] THEN REWRITE_TAC[VECTOR_VARIATION_CONST]; MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN ASM_SIMP_TAC[REWRITE_RULE[FUN_EQ_THM; o_DEF] AFFINITY_INVERSES; I_THM] THEN ASM_SIMP_TAC[IMAGE_AFFINITY_INTERVAL] THEN ASM_REWRITE_TAC[DIVISION_OF_AFFINITY; REAL_INV_EQ_0] THEN MESON_TAC[]]);; let HAS_BOUNDED_VARIATION_AFFINITY_EQ,VECTOR_VARIATION_AFFINITY = (CONJ_PAIR o prove) (`(!m c f:real^1->real^N s. (\x. f(m % x + c)) has_bounded_variation_on s <=> m = &0 \/ f has_bounded_variation_on (IMAGE (\x. m % x + c) s)) /\ (!m c f:real^1->real^N s. vector_variation s (\x. f(m % x + c)) = if m = &0 then &0 else vector_variation (IMAGE (\x. m % x + c) s) f)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; HAS_BOUNDED_VARIATION_ON_CONST; VECTOR_VARIATION_CONST] THEN CONJ_TAC THENL [MP_TAC(ISPECL[`m:real`; `c:real^1`; `f:real^1->real^N`; `IMAGE (\x:real^1. m % x + c) s`] HAS_BOUNDED_VARIATION_AFFINITY2_EQ); MP_TAC(ISPECL[`m:real`; `c:real^1`; `f:real^1->real^N`; `IMAGE (\x:real^1. m % x + c) s`] VECTOR_VARIATION_AFFINITY2)] THEN ASM_SIMP_TAC[AFFINITY_INVERSES; GSYM IMAGE_o; IMAGE_I]);; let HAS_BOUNDED_VARIATION_TRANSLATION_EQ,VECTOR_VARIATION_TRANSLATION_ALT = (CONJ_PAIR o prove) (`(!a f:real^1->real^N s. (\x. f(a + x)) has_bounded_variation_on s <=> f has_bounded_variation_on (IMAGE (\x. a + x) s)) /\ (!a f:real^1->real^N s. vector_variation s (\x. f(a + x)) = vector_variation (IMAGE (\x. a + x) s) f)`, REPEAT STRIP_TAC THENL [MP_TAC(ISPECL[`a:real^1`; `f:real^1->real^N`; `IMAGE (\x:real^1. a + x) s`] HAS_BOUNDED_VARIATION_TRANSLATION2_EQ); MP_TAC(ISPECL[`a:real^1`; `f:real^1->real^N`; `IMAGE (\x:real^1. a + x) s`] VECTOR_VARIATION_TRANSLATION2)] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`; VECTOR_ARITH `a + --a + x:real^N = x`]);; let HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL, VECTOR_VARIATION_TRANSLATION_INTERVAL = (CONJ_PAIR o prove) (`(!a f:real^1->real^N u v. (\x. f(a + x)) has_bounded_variation_on interval[u,v] <=> f has_bounded_variation_on interval[a+u,a+v]) /\ (!a f:real^1->real^N u v. vector_variation (interval[u,v]) (\x. f(a + x)) = vector_variation (interval[a+u,a+v]) f)`, REWRITE_TAC[INTERVAL_TRANSLATION; HAS_BOUNDED_VARIATION_TRANSLATION_EQ; VECTOR_VARIATION_TRANSLATION_ALT]);; let HAS_BOUNDED_VARIATION_TRANSLATION = prove (`!f:real^1->real^N s a. f has_bounded_variation_on s ==> (\x. f(a + x)) has_bounded_variation_on (IMAGE (\x. --a + x) s)`, REWRITE_TAC[HAS_BOUNDED_VARIATION_TRANSLATION2_EQ]);; let HAS_BOUNDED_VARIATION_REFLECT2_EQ,VECTOR_VARIATION_REFLECT2 = (CONJ_PAIR o prove) (`(!f:real^1->real^N s. (\x. f(--x)) has_bounded_variation_on (IMAGE (--) s) <=> f has_bounded_variation_on s) /\ (!f:real^1->real^N s. vector_variation (IMAGE (--) s) (\x. f(--x)) = vector_variation s f)`, MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN REWRITE_TAC[] THEN CONJ_TAC THENL [VECTOR_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[DIVISION_OF_REFLECT; REFLECT_INTERVAL]);; let HAS_BOUNDED_VARIATION_REFLECT_EQ,VECTOR_VARIATION_REFLECT = (CONJ_PAIR o prove) (`(!f:real^1->real^N s. (\x. f(--x)) has_bounded_variation_on s <=> f has_bounded_variation_on (IMAGE (--) s)) /\ (!f:real^1->real^N s. vector_variation s (\x. f(--x)) = vector_variation (IMAGE (--) s) f)`, REPEAT STRIP_TAC THENL [MP_TAC(ISPECL[`f:real^1->real^N`; `IMAGE (--) (s:real^1->bool)`] HAS_BOUNDED_VARIATION_REFLECT2_EQ); MP_TAC(ISPECL[`f:real^1->real^N`; `IMAGE (--) (s:real^1->bool)`] VECTOR_VARIATION_REFLECT2)] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[IMAGE_ID; VECTOR_NEG_NEG]);; let HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL, VECTOR_VARIATION_REFLECT_INTERVAL = (CONJ_PAIR o prove) (`(!f:real^1->real^N u v. (\x. f(--x)) has_bounded_variation_on interval[u,v] <=> f has_bounded_variation_on interval[--v,--u]) /\ (!f:real^1->real^N u v. vector_variation (interval[u,v]) (\x. f(--x)) = vector_variation (interval[--v,--u]) f)`, REWRITE_TAC[GSYM REFLECT_INTERVAL; HAS_BOUNDED_VARIATION_REFLECT_EQ; VECTOR_VARIATION_REFLECT]);; let HAS_BOUNDED_VARIATION_DARBOUX_GEN = prove (`!f s. is_interval s /\ f has_bounded_variation_on s ==> ?g h. (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(g x) <= drop(g y)) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(h x) <= drop(h y)) /\ (!x. f x = g x - h x)`, REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`\x. lift(vector_variation {a | a IN s /\ drop a <= drop x} (f:real^1->real^1))`; `\x. lift(vector_variation {a | a IN s /\ drop a <= drop x} f) - f x`] THEN REWRITE_TAC[VECTOR_ARITH `a - (a - x):real^1 = x`] THEN REWRITE_TAC[LIFT_DROP; DROP_SUB] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_TRANS]]; MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_LEFT THEN ASM_REWRITE_TAC[]]);; let HAS_BOUNDED_VARIATION_DARBOUX = prove (`!f a b. f has_bounded_variation_on interval[a,b] <=> ?g h. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(g x) <= drop(g y)) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(h x) <= drop(h y)) /\ (!x. f x = g x - h x)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`\x:real^1. lift(vector_variation (interval[a,x]) (f:real^1->real^1))`; `\x:real^1. lift(vector_variation (interval[a,x]) f) - f x`] THEN REWRITE_TAC[VECTOR_ARITH `a - (a - x):real^1 = x`] THEN REWRITE_TAC[LIFT_DROP; DROP_SUB] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_MONOTONE; MATCH_MP_TAC(REAL_ARITH `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN EXISTS_TAC `drop(f(a:real^1))` THEN REWRITE_TAC[GSYM DROP_SUB] THEN MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE] THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC); GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN CONJ_TAC THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN ASM_REWRITE_TAC[]]);; let HAS_BOUNDED_VARIATION_DARBOUX_STRICT = prove (`!f a b. f has_bounded_variation_on interval[a,b] <=> ?g h. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y ==> drop(g x) < drop(g y)) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y ==> drop(h x) < drop(h y)) /\ (!x. f x = g x - h x)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`\x:real^1. g x + x`; `\x:real^1. h x + x`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `(a + x) - (b + x):real^1 = a - b`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_ADD] THEN MATCH_MP_TAC REAL_LET_ADD2 THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; MAP_EVERY EXISTS_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN ASM_REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN ASM_MESON_TAC[]]);; let HAS_BOUNDED_VARIATION_ON_REFLECT = prove (`!f:real^1->real^N s. f has_bounded_variation_on IMAGE (--) s ==> (\x. f(--x)) has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN REWRITE_TAC[has_bounded_setvariation_on] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`IMAGE (IMAGE (--)) (d:(real^1->bool)->bool)`; `IMAGE (--) (t:real^1->bool)`]) THEN ASM_SIMP_TAC[DIVISION_OF_REFLECT] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhand o lhand o snd) THEN ANTS_TAC THENL [MESON_TAC[VECTOR_ARITH `--x:real^N = --y <=> x = y`; INJECTIVE_IMAGE]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= d ==> y <= d`) THEN MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL [ASM_MESON_TAC[INTERVAL_NE_EMPTY_1; division_of]; ALL_TAC] THEN ASM_REWRITE_TAC[o_THM; REFLECT_INTERVAL] THEN ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1; DROP_NEG; REAL_LE_NEG2] THEN NORM_ARITH_TAC]);; let HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[--b,--a] ==> (\x. f(--x)) has_bounded_variation_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_REFLECT THEN ASM_REWRITE_TAC[REFLECT_INTERVAL]);; let HAS_BOUNDED_VARIATION_COMPOSE_INCREASING, VECTOR_VARIATION_COMPOSE_INCREASING = (CONJ_PAIR o prove) (`(!f g:real^1->real^N a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ g has_bounded_variation_on interval[f a,f b] ==> (g o f) has_bounded_variation_on interval[a,b]) /\ (!f g:real^1->real^N a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ g has_bounded_variation_on interval[f a,f b] ==> vector_variation (interval[a,b]) (g o f) <= vector_variation (interval[f a,f b]) g)`, REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL] THEN X_GEN_TAC `d:(real^1->bool)->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_WORKS) THEN ABBREV_TAC `D = IMAGE (\k:real^1->bool. interval[(f:real^1->real^1) (interval_lowerbound k), f(interval_upperbound k)]) d` THEN DISCH_THEN(MP_TAC o SPECL [`D:(real^1->bool)->bool`; `UNIONS D:real^1->bool`] o CONJUNCT1) THEN ANTS_TAC THENL [REWRITE_TAC[division_of; UNIONS_SUBSET; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMAGE; division_of]; ALL_TAC] THEN EXPAND_TAC "D" THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s IN t ==> s SUBSET UNIONS t`) THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `interval[u:real^1,v]` THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY]; REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[u:real^1,v]` o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[SUBSET] th)) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]; MESON_TAC[]]; FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^1) IN interval[a,b] /\ y IN interval[a,b] /\ (u:real^1) IN interval[a,b] /\ v IN interval[a,b]` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `interval[x:real^1,y]` o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[u:real^1,v]` o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[SUBSET] (CONJUNCT1 th)))) THEN ASM_MESON_TAC[ENDS_IN_INTERVAL]; FIRST_ASSUM(MP_TAC o el 2 o CONJUNCTS o REWRITE_RULE[division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`interval[u:real^1,v]`; `interval[x:real^1,y]`]) THEN ASM_REWRITE_TAC[INTERIOR_INTERVAL; DISJOINT_INTERVAL_1] THEN ASM_REWRITE_TAC[EQ_INTERVAL] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_OR THEN CONJ_TAC) THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; SUBGOAL_THEN `(u:real^1) IN interval[a,b] /\ v IN interval[a,b]` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `interval[u:real^1,v]` o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[SUBSET] th)) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]; REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN STRIP_TAC THEN DISJ2_TAC THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]; EXPAND_TAC "D" THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o lhand o lhand o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMAGE; division_of]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^1) IN interval[a,b] /\ y IN interval[a,b] /\ (u:real^1) IN interval[a,b] /\ v IN interval[a,b]` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `interval[x:real^1,y]` o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[u:real^1,v]` o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[SUBSET] (CONJUNCT1 th)))) THEN ASM_MESON_TAC[ENDS_IN_INTERVAL]; ASM_REWRITE_TAC[EQ_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_NE_EMPTY_1; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_CASES_TAC `(f:real^1->real^1) y = f x` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DROP_EQ]) THEN ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; GSYM REAL_NOT_LE; REAL_ARITH `x <= y ==> (~(y = x) <=> x < y)`] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o el 2 o CONJUNCTS o REWRITE_RULE[division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`interval[u:real^1,v]`; `interval[x:real^1,y]`]) THEN ASM_REWRITE_TAC[EQ_INTERVAL; INTERVAL_NE_EMPTY_1; DE_MORGAN_THM] THEN ASM_CASES_TAC `(f:real^1->real^1) y = f x` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INTERIOR_INTERVAL; DISJOINT_INTERVAL_1] THEN ASM_SIMP_TAC[REAL_ARITH `x <= y ==> (y <= x <=> x = y)`; DROP_EQ] THEN ASM_MESON_TAC[]]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= a ==> y <= a`) THEN MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; o_DEF] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN AP_TERM_TAC THENL [MATCH_MP_TAC INTERVAL_UPPERBOUND_1; MATCH_MP_TAC INTERVAL_LOWERBOUND_1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[u:real^1,v]` o el 1 o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o REWRITE_RULE[SUBSET] o CONJUNCT1) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]]]);; let HAS_BOUNDED_VARIATION_COMPOSE_DECREASING = prove (`!f g:real^1->real^N a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) /\ g has_bounded_variation_on interval[f b,f a] ==> (g o f) has_bounded_variation_on interval[a,b]`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[VECTOR_NEG_NEG] (ISPECL [`f:real^1->real^N`; `--b:real^1`; `--a:real^1`] HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL))) THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV) [GSYM REAL_LE_NEG2] THEN REWRITE_TAC[GSYM DROP_NEG; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_COMPOSE_INCREASING) THEN REWRITE_TAC[o_DEF; VECTOR_NEG_NEG]);; let VECTOR_VARIATION_COMPOSE_DECREASING = prove (`!f g:real^1->real^N a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) /\ g has_bounded_variation_on interval[f b,f a] ==> vector_variation (interval[a,b]) (g o f) <= vector_variation (interval[f b,f a]) g`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[VECTOR_NEG_NEG] (ISPECL [`f:real^1->real^N`; `--b:real^1`; `--a:real^1`] HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL))) THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV) [GSYM REAL_LE_NEG2] THEN REWRITE_TAC[GSYM DROP_NEG; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP VECTOR_VARIATION_COMPOSE_INCREASING) THEN REWRITE_TAC[o_DEF; VECTOR_NEG_NEG; VECTOR_VARIATION_REFLECT_INTERVAL]);; let HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN, VECTOR_VARIATION_COMPOSE_INCREASING_GEN = (CONJ_PAIR o prove) (`(!f g:real^1->real^N s t. is_interval s /\ is_interval t /\ IMAGE f s SUBSET t /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ g has_bounded_variation_on t ==> (g o f) has_bounded_variation_on s) /\ (!f g:real^1->real^N s t. is_interval s /\ is_interval t /\ IMAGE f s SUBSET t /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ g has_bounded_variation_on t ==> vector_variation s (g o f) <= vector_variation t g)`, REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[HAS_BOUNDED_VECTOR_VARIATION_ON_SUBINTERVALS] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL [ASM_REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_EMPTY; EMPTY_SUBSET] THEN REWRITE_TAC[VECTOR_VARIATION_ON_EMPTY] THEN ASM_MESON_TAC[VECTOR_VARIATION_POS_LE]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_INCREASING THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); TRANS_TAC REAL_LE_TRANS `vector_variation (interval[(f:real^1->real^1) a,f b]) (g:real^1->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_COMPOSE_INCREASING THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_REWRITE_TAC[]]] THEN MATCH_MP_TAC(MESON[INTERVAL_SUBSET_SEGMENT_1; SUBSET] `segment[a:real^1,b] SUBSET s ==> interval[a,b] SUBSET s`) THEN RULE_ASSUM_TAC (REWRITE_RULE[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> a IN s ==> a IN t`)) THEN MATCH_MP_TAC FUN_IN_IMAGE THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]);; let HAS_BOUNDED_VARIATION_COMPOSE_HOMEOMORPHISM = prove (`!f f' g:real^1->real^N s t. is_interval s /\ homeomorphism (s,t) (f,f') /\ g has_bounded_variation_on t ==> (g o f) has_bounded_variation_on s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_1D_IMP_MONOTONIC)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN THEN EXISTS_TAC `t:real^1->bool` THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_REWRITE_TAC[SUBSET_REFL; REAL_LE_LT; DROP_EQ] THEN ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE; IS_INTERVAL_CONNECTED_1]; ALL_TAC] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_EQ THEN EXISTS_TAC `((g:real^1->real^N) o (--)) o ((--) o (f:real^1->real^1))` THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; VECTOR_NEG_NEG]; ALL_TAC] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN THEN EXISTS_TAC `IMAGE (--) (t:real^1->bool)` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IS_INTERVAL_REFLECT] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE; IS_INTERVAL_CONNECTED_1]; REWRITE_TAC[IMAGE_o] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; REWRITE_TAC[o_DEF; DROP_NEG; REAL_LE_NEG2] THEN REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[HAS_BOUNDED_VARIATION_REFLECT2_EQ; o_DEF]]);; let HAS_BOUNDED_VARIATION_COMPOSE_INJECTIVE = prove (`!f g:real^1->real^N s. is_interval s /\ f continuous_on s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ g has_bounded_variation_on (IMAGE f s) ==> (g o f) has_bounded_variation_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_HOMEOMORPHISM THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `IMAGE (f:real^1->real^1) s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_INTO_1D THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_PATH_CONNECTED_1]);; let VECTOR_VARIATION_COMPOSE_HOMEOMORPHISM = prove (`!f f' g:real^1->real^N s t. is_interval s /\ homeomorphism (s,t) (f,f') /\ g has_bounded_variation_on t ==> vector_variation s (g o f) = vector_variation t g`, let lemma = prove (`!f f' g:real^1->real^N s t. is_interval s /\ homeomorphism (s,t) (f,f') /\ g has_bounded_variation_on t /\ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> drop(f x) < drop(f y)) ==> vector_variation s (g o f) = vector_variation t g`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_COMPOSE_INCREASING_GEN THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[REAL_LE_LT; DROP_EQ] THEN ASM_MESON_TAC[]] THEN ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE; IS_INTERVAL_CONNECTED_1]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `vector_variation t (((g:real^1->real^N) o f) o (f':real^1->real^1))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_SIMP_TAC[o_THM]; ALL_TAC] THEN MATCH_MP_TAC VECTOR_VARIATION_COMPOSE_INCREASING_GEN THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE; IS_INTERVAL_CONNECTED_1]; DISCH_TAC] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM homeomorphism]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_1D_IMP_MONOTONIC)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN STRIP_ASSUME_TAC th) THEN ASM_SIMP_TAC[] THENL [ASM_REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`] THEN DISCH_TAC THEN SUBGOAL_THEN `!x y:real^1. x IN s /\ y IN s ==> x = y` MP_TAC THENL [REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN ASM_MESON_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[REAL_LE_LT] THEN ASM SET_TAC[]]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN THEN EXISTS_TAC `t:real^1->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN ASM_MESON_TAC[]]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_1D_IMP_MONOTONIC)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [MATCH_MP_TAC lemma THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(--) o (f:real^1->real^1)`; `(f':real^1->real^1) o (--)`; `(g:real^1->real^N) o (--)`; `s:real^1->bool`; `IMAGE (--) t:real^1->bool`] lemma) THEN ASM_REWRITE_TAC[o_DEF; GSYM VECTOR_VARIATION_REFLECT; VECTOR_NEG_NEG; GSYM HAS_BOUNDED_VARIATION_REFLECT_EQ; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[DROP_NEG; REAL_LT_NEG2] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_SIMP_TAC[homeomorphism; VECTOR_NEG_NEG; FORALL_IN_IMAGE; GSYM IMAGE_o; o_DEF; ETA_AX; CONTINUOUS_ON_NEG] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_NEG_NEG; IMAGE_ID] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_NEGATION]);; let HAS_BOUNDED_VARIATION_ON_ID = prove (`!s:real^1->bool. bounded s ==> (\x. x) has_bounded_variation_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; has_bounded_setvariation_on] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN EXISTS_TAC `content(interval[a:real^1,b])` THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`d:(real^1->bool)->bool`; `t:real^1->bool`; `a:real^1`; `b:real^1`] SUBADDITIVE_CONTENT_DIVISION) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN FIRST_X_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN SIMP_TAC[CONTENT_1; INTERVAL_NE_EMPTY_1; NORM_1; DROP_SUB] THEN REAL_ARITH_TAC);; let LINEAR_IMP_HAS_BOUNDED_VARIATION = prove (`!f:real^1->real^N. linear f /\ bounded s ==> f has_bounded_variation_on s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `c:real^N` SUBST1_TAC o GEN_REWRITE_RULE I [LINEAR_FROM_1]) THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_VMUL THEN ASM_SIMP_TAC[LIFT_DROP; HAS_BOUNDED_VARIATION_ON_ID]);; let VECTOR_VARIATION_LINEAR = prove (`!f:real^1->real^N a b. linear f /\ drop a <= drop b ==> vector_variation(interval[a,b]) f = dist(f a,f b)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `c:real^N` SUBST1_TAC o GEN_REWRITE_RULE I [LINEAR_FROM_1]) THEN ASM_SIMP_TAC[VECTOR_VARIATION_VMUL; LIFT_DROP; HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL; VECTOR_VARIATION_ID; INTERVAL_EQ_EMPTY_1; GSYM REAL_NOT_LE; dist; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[NORM_1; REAL_ARITH `a <= b ==> abs(a - b) = b - a`] THEN REWRITE_TAC[REAL_MUL_SYM]);; let HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE = prove (`!f:real^M->real^N g s B. g has_bounded_variation_on s /\ (!x y. x IN IMAGE g s /\ y IN IMAGE g s ==> norm(f x - f y) <= B * norm(x - y)) ==> (f o g) has_bounded_variation_on s`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `\x. B % (g:real^1->real^M) x` HAS_BOUNDED_VARIATION_COMPARISON) THEN ASM_REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_CMUL; o_DEF] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC);; let LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION = prove (`!f:real^1->real^N s B. bounded s /\ (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> f has_bounded_variation_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `\x:real^1. x`; `s:real^1->bool`; `B:real`] HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE) THEN ASM_REWRITE_TAC[o_DEF; IMAGE_ID; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ID]);; let VECTOR_VARIATION_LIPSCHITZ = prove (`!f:real^1->real^N a b l. drop a <= drop b /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] ==> norm(f x - f y) <= l * norm(x - y)) ==> vector_variation (interval[a,b]) f <= l * (drop b - drop a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^1 = a` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_VARIATION_SING; INTERVAL_SING; REAL_MUL_RZERO; REAL_LE_REFL] THEN SUBGOAL_THEN `drop a < drop b` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ]; ALL_TAC] THEN SUBGOAL_THEN `&0 <= l` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(x:real^N) <= a ==> &0 <= a`)) THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ]; ALL_TAC] THEN MP_TAC(ISPECL[`\x:real^1. l % x`; `f:real^1->real^N`; `interval[a:real^1,b]`] VECTOR_VARIATION_COMPARISON) THEN ASM_SIMP_TAC[dist; HAS_BOUNDED_VARIATION_ON_CMUL; HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL; VECTOR_VARIATION_CMUL; VECTOR_VARIATION_ID] THEN ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_ARITH `a <= b ==> ~(b < a)`] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[real_abs]);; let LIPSCHITZ_VECTOR_VARIATION = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> ((!x y. x IN interval[a,b] /\ y IN interval[a,b] ==> abs(vector_variation (interval[a,x]) f - vector_variation (interval[a,y]) f) <= B * norm(x - y)) <=> (!x y. x IN interval[a,b] /\ y IN interval[a,b] ==> norm(f x - f y) <= B * norm(x - y)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN (CONJ_TAC THENL [MESON_TAC[NORM_SUB; REAL_ABS_SUB]; ALL_TAC]) THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `y:real^1`; `x:real^1`] VECTOR_VARIATION_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `a <= d ==> a <= abs(x - (x + d))`) THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ASM_REWRITE_TAC[SEGMENT_1; SUBSET_REFL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `y:real^1`; `x:real^1`] VECTOR_VARIATION_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= d /\ d <= a ==> abs(x - (x + d)) <= a`) THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[NORM_1; real_abs; DROP_SUB; REAL_SUB_LE] THEN MATCH_MP_TAC VECTOR_VARIATION_LIPSCHITZ THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]);; let HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_HAS_BOUNDED_VARIATION_ON = prove (`!f:real^1->real^N f' s. (!x. x IN s ==> (f has_vector_derivative f'(x)) (at x within s)) /\ convex s /\ bounded s /\ bounded(IMAGE f' s) ==> f has_bounded_variation_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `(?x. &0 < x /\ P x) ==> ?x. P x`) THEN MATCH_MP_TAC HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_LIPSCHITZ THEN ASM_MESON_TAC[]);; let HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE = prove (`!f:real^1->real^1 g:real^1->real^N a b. linear f /\ g has_bounded_variation_on IMAGE f (interval[a,b]) ==> (g o f) has_bounded_variation_on interval[a,b]`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LINEAR_1]) THEN DISCH_THEN(X_CHOOSE_THEN `c:real` SUBST_ALL_TAC) THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `c = &0 \/ &0 <= c /\ &0 < c \/ ~(&0 <= c) /\ &0 < --c`) THENL [ASM_REWRITE_TAC[o_DEF; VECTOR_MUL_LZERO; HAS_BOUNDED_VARIATION_ON_CONST]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_INCREASING THEN REWRITE_TAC[DROP_CMUL]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_DECREASING THEN REWRITE_TAC[DROP_CMUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `c * y <= c * x <=> --c * x <= --c * y`]] THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(MESON[] `g has_bounded_variation_on s ==> s = t ==> g has_bounded_variation_on t`)) THEN ONCE_REWRITE_TAC[VECTOR_ARITH `c % x:real^N = c % x + vec 0`] THEN ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_CMUL] THENL [ALL_TAC; ONCE_REWRITE_TAC[REAL_ARITH `c * y < c * x <=> --c * x < --c * y`]] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY_1]);; let HAS_BOUNDED_VARIATION_ON_COMBINE_GEN = prove (`!f:real^1->real^N s a. is_interval s ==> (f has_bounded_variation_on s <=> f has_bounded_variation_on {x | x IN s /\ drop x <= a} /\ f has_bounded_variation_on {x | x IN s /\ drop x >= a})`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_VARIATION_ON_SUBSET) THEN REWRITE_TAC[SUBSET_RESTRICT]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_NONTRIVIAL] THEN SUBGOAL_THEN `bounded(IMAGE (f:real^1->real^N) s)` MP_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (f:real^1->real^N) ({x | x IN s /\ drop x <= a} UNION {x | x IN s /\ drop x >= a})` THEN CONJ_TAC THENL [REWRITE_TAC[IMAGE_UNION; BOUNDED_UNION] THEN CONJ_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC IS_INTERVAL_INTER THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IS_INTERVAL_1_CASES; real_ge] THEN MESON_TAC[]; MATCH_MP_TAC IMAGE_SUBSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN REAL_ARITH_TAC]; REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[has_bounded_variation_on; has_bounded_setvariation_on] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `C:real` THEN DISCH_THEN(LABEL_TAC "R") THEN X_GEN_TAC `B:real` THEN DISCH_THEN(LABEL_TAC "L")] THEN EXISTS_TAC `&4 * D + B + C:real` THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN ABBREV_TAC `dl = {k:real^1->bool | k IN d /\ k SUBSET {x | x IN s /\ drop x <= a}}` THEN ABBREV_TAC `dr = {k:real^1->bool | k IN d /\ k SUBSET {x | x IN s /\ drop x >= a}}` THEN REMOVE_THEN "R" (MP_TAC o SPECL [`dr:(real^1->bool)->bool`; `UNIONS dr:real^1->bool`]) THEN REMOVE_THEN "L" (MP_TAC o SPECL [`dl:(real^1->bool)->bool`; `UNIONS dl:real^1->bool`]) THEN REPEAT(ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET; ASM SET_TAC[]] THEN EXISTS_TAC `d:(real^1->bool)->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; ASM SET_TAC[]]; ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN MATCH_MP_TAC(REAL_ARITH `u <= (s + t) + d ==> s <= b ==> t <= c ==> u <= d + b + c`) THEN W(MP_TAC o PART_MATCH (rand o rand) SUM_UNION_NONZERO o lhand o rand o snd) THEN ANTS_TAC THENL [MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_SIMP_TAC[FINITE_RESTRICT; IMP_CONJ] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[IMP_IMP; GSYM SUBSET_INTER; GSYM CONJ_ASSOC; SET_RULE `{x | P x /\ Q x} INTER {x | P x /\ R x} = {x | P x /\ Q x /\ R x}`] THEN REWRITE_TAC[REAL_ARITH `x <= a /\ x >= a <=> x = a`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[LIFT_EQ; NORM_EQ_0; VECTOR_SUB_EQ] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s SUBSET {x | x IN t /\ x = a} ==> s SUBSET {a}`)) THEN REWRITE_TAC[GSYM INTERVAL_SING; SUBSET_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY_1]) THEN REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC(REAL_ARITH `s - t <= b ==> s <= t + b`) THEN W(MP_TAC o PART_MATCH (rand o rand) SUM_DIFF o lhand o snd) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN SUBGOAL_THEN `FINITE(d DIFF (dl UNION dr):(real^1->bool)->bool) /\ CARD(d DIFF (dl UNION dr)) <= 2` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MESON[CARD_SUBSET; LE_TRANS; FINITE_SUBSET] `!t. s SUBSET t /\ FINITE t /\ CARD t <= 2 ==> FINITE s /\ CARD s <= 2`) THEN EXISTS_TAC `{k | k IN d /\ ~(content k = &0) /\ lift a IN k}` THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN SUBST1_TAC(MESON[EXP_1; DIMINDEX_1] `2 = 2 EXP dimindex(:1)`) THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC DIVISION_COMMON_POINT_BOUND THEN ASM_MESON_TAC[]] THEN GEN_REWRITE_TAC I [SUBSET] THEN MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN SIMP_TAC[IN_DIFF; IMP_CONJ; IN_ELIM_THM; IN_UNION] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `interval[u:real^1,v] SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[division_of; SUBSET]; ASM_REWRITE_TAC[SUBSET_INTER]] THEN REWRITE_TAC[CONTENT_EQ_0_1; IN_INTERVAL_1; SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `&(CARD(d DIFF (dl UNION dr):(real^1->bool)->bool)) * &2 * D` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_BOUND THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_DIFF; IMP_CONJ] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= d /\ norm y <= d ==> norm(x - y) <= &2 * d`) THEN ASM_MESON_TAC[division_of; SUBSET; ENDS_IN_INTERVAL]; ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_LE_RMUL_EQ] THEN REWRITE_TAC[REAL_ARITH `x * &2 <= &4 <=> x <= &2`] THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE]]);; let HAS_BOUNDED_VARIATION_ON_INTERIOR = prove (`!f:real^1->real^N s. f has_bounded_variation_on (interior s) /\ (is_interval s \/ f continuous_on s) ==> f has_bounded_variation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_CONVEX_1]) THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `interior s:real^1->bool = {}` THENL [FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_NONEMPTY_INTERIOR_EQ) THEN ASM_SIMP_TAC[AFF_DIM_LE_UNIV; INT_ARITH `d:int <= n ==> (~(d = n) <=> d <= n - &1)`] THEN REWRITE_TAC[DIMINDEX_1; INT_SUB_REFL] THEN SIMP_TAC[AFF_DIM_GE; AFF_DIM_EQ_0; AFF_DIM_EQ_MINUS1; INT_ARITH `--(&1):int <= x ==> (x <= &0 <=> x = -- &1 \/ x = &0)`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_SING; HAS_BOUNDED_VARIATION_ON_EMPTY]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `closure(interior s):real^1->bool` THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_CLOSURE; IS_INTERVAL_CONVEX_1; CONVEX_INTERIOR] THEN ASM_SIMP_TAC[CONVEX_CLOSURE_INTERIOR; CLOSURE_SUBSET]]; ALL_TAC] THEN REWRITE_TAC[has_bounded_variation_on; HAS_BOUNDED_SETVARIATION_ON] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN REWRITE_TAC[SUM_VSUM] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN EXISTS_TAC `\n. vsum d (\k. lift(norm ((f:real^1->real^N)(interval_upperbound k - inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)) - f(interval_lowerbound k + inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)))))` THEN REWRITE_TAC[o_DEF; TRIVIAL_LIMIT_SEQUENTIALLY] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_VSUM THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN SUBGOAL_THEN `interval[a:real^1,b] SUBSET s` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [SUBGOAL_THEN `(f:real^1->real^N) continuous (at b within s)` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC]; SUBGOAL_THEN `(f:real^1->real^N) continuous (at a within s)` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC]] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN (CONJ_TAC THENL [GEN_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_CMUL; REAL_ARITH `a <= b - i * (b - a) <=> &0 <= (&1 - i) * (b - a)`; REAL_ARITH `b - i * (b - a) <= b <=> &0 <= i * (b - a)`; REAL_ARITH `a + i * (b - a) <= b <=> &0 <= (&1 - i) * (b - a)`; REAL_ARITH `a <= a + i * (b - a) <=> &0 <= i * (b - a)`] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MATCH_MP_TAC REAL_POW_LE_1 THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC]) THENL [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN MATCH_MP_TAC LIM_SUB; GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC LIM_ADD] THEN REWRITE_TAC[LIM_CONST] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = &0 % (b - a)`) THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_DEF; DIST_LIFT; REAL_SUB_RZERO] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `d:real`] REAL_ARCH_POW_INV) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `inv(&2 pow N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[DROP_VSUM; o_DEF; LIFT_DROP] THEN FIRST_X_ASSUM(MP_TAC o GEN `d:(real^1->bool)->bool` o SPECL [`d:(real^1->bool)->bool`; `UNIONS d:real^1->bool`]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\k. interval[interval_lowerbound k + inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k):real^1, interval_upperbound k - inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)]) {k | k IN d /\ ~(content k = &0)}`) THEN MP_TAC(GEN `g:(real^1->bool)->real` (ISPECL [`\k. interval[interval_lowerbound k + inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k):real^1, interval_upperbound k - inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)]`; `g:(real^1->bool)->real`; `{k:real^1->bool | k IN d /\ ~(content k = &0)}`] SUM_IMAGE)) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM; RIGHT_FORALL_IMP_THM; TAUT `(p /\ q) /\ (r /\ s) /\ t ==> u <=> p ==> r ==> q /\ s /\ t ==> u`] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) MP_TAC)) THEN REWRITE_TAC[EQ_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `b - i * (b - a) < a + i * (b - a) <=> ~(&0 <= (&1 - &2 * i) * (b - a))`] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MATCH_MP_TAC(TAUT `p ==> ~p /\ q ==> r`) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING `a + n * (b - a) = c + n * (d - c) /\ b - n * (b - a) = d - n * (d - c) ==> n pow 2 = (&1 - n) pow 2 \/ a = c /\ b = d`)) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = abs(&1 - x) ==> x = inv(&2)`)) THEN MATCH_MP_TAC(REAL_ARITH `x < y ==> x = y ==> F`) THEN MATCH_MP_TAC REAL_LT_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[o_DEF]] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[SUM_RESTRICT_SET] THEN MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[REAL_SUB_0; DROP_EQ] THEN ASM_CASES_TAC `b:real^1 = a` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO; VECTOR_ADD_RID; NORM_0] THEN AP_TERM_TAC THEN BINOP_TAC THEN AP_TERM_TAC THENL [MATCH_MP_TAC INTERVAL_UPPERBOUND_NONEMPTY; MATCH_MP_TAC INTERVAL_LOWERBOUND_NONEMPTY] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1; INTERVAL_UPPERBOUND_NONEMPTY] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `~(b - a = &0) ==> a <= b ==> a < b`)) THEN ASM_REWRITE_TAC[GSYM(CONJUNCT1 INTERVAL_NE_EMPTY_1)] THEN DISCH_TAC THEN TRANS_TAC SUBSET_TRANS `interval(a:real^1,b)` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL_1] THEN DISJ2_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_CMUL; REAL_ARITH `b - i * (b - a) < b <=> &0 < i * (b - a)`; REAL_ARITH `a < a + i * (b - a) <=> &0 < i * (b - a)`; REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(CONJUNCT1 INTERIOR_INTERVAL)] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]]] THEN SIMP_TAC[division_of; SET_RULE `!x. x IN s ==> x SUBSET UNIONS s`] THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN SIMP_TAC[IMP_CONJ; IN_ELIM_THM; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN CONJ_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THENL [CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`interval[a:real^1,b]`; `interval[c:real^1,d]`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN ASM_SIMP_TAC[CONTRAPOS_THM; EQ_INTERVAL_1; GSYM INTERVAL_EQ_EMPTY_1; DROP_EQ] THEN REWRITE_TAC[GSYM INTERIOR_INTER] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'`) THEN CONJ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN DISJ2_TAC THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `b - i * (b - a) <= b <=> &0 <= i * (b - a)`; REAL_ARITH `a <= a + i * (b - a) <=> &0 <= i * (b - a)`; REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC);; let HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ = prove (`!f:real^1->real^N s. is_interval s \/ f continuous_on s ==> (f has_bounded_variation_on interior s <=> f has_bounded_variation_on s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_INTERIOR; HAS_BOUNDED_VARIATION_ON_SUBSET; INTERIOR_SUBSET]);; let CONVEX_HAS_BOUNDED_VARIATION_EQ = prove (`!f s. (drop o f) convex_on s /\ is_interval s ==> (f has_bounded_variation_on s <=> bounded(IMAGE f s))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED]; DISCH_TAC] THEN MP_TAC(ISPECL [`drop o (f:real^1->real^1)`; `s:real^1->bool`] CONVEX_IMP_PIECEWISE_MONOTONE) THEN ASM_REWRITE_TAC[o_THM] THEN STRIP_TAC THENL [MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_INTERIOR THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION_GEN; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_INTERIOR THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DECREASING_BOUNDED_VARIATION_GEN; MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`; `drop a`] HAS_BOUNDED_VARIATION_ON_COMBINE_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC DECREASING_BOUNDED_VARIATION_GEN; MATCH_MP_TAC INCREASING_BOUNDED_VARIATION_GEN] THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS]])] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET; SUBSET_RESTRICT]);; let CONVEX_HAS_BOUNDED_VARIATION = prove (`!f a b. f convex_on interval[a,b] ==> (lift o f) has_bounded_variation_on interval[a,b]`, REPEAT STRIP_TAC THEN IMP_REWRITE_TAC[CONVEX_HAS_BOUNDED_VARIATION_EQ] THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVEX_IMP_BOUNDED_ON_INTERVAL) THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; o_DEF; NORM_LIFT] THEN MESON_TAC[]; ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; let HAS_BOUNDED_VECTOR_VARIATION_UNIFORM_LIM = prove (`!f:num->real^1->real^N g s b. (!n. (f n) has_bounded_variation_on s) /\ (!n. vector_variation s (f n) <= b) /\ (!x. x IN s ==> ((\n. f n x) --> g x) sequentially) ==> g has_bounded_variation_on s /\ vector_variation s g <= b`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!e. &0 < e ==> (g:real^1->real^N) has_bounded_variation_on s /\ vector_variation s g <= b + e` (fun th -> MP_TAC(SPEC `(vector_variation s (g:real^1->real^N) - b) / &2` th) THEN REWRITE_TAC[MATCH_MP th REAL_LT_01]) THENL [X_GEN_TAC `e:real` THEN DISCH_TAC; REAL_ARITH_TAC] THEN REWRITE_TAC[HAS_BOUNDED_VECTOR_VARIATION] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN SUBGOAL_THEN `?n. !x:real^1. x IN ({interval_lowerbound k | k IN d} UNION {interval_upperbound k | k IN d}) ==> norm((f:num->real^1->real^N) n x - g x) <= e / (&(CARD(d:(real^1->bool)->bool)) + &1) / &2` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM; IMP_IMP] o GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV) [LIM_SEQUENTIALLY]) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / (&(CARD(d:(real^1->bool)->bool)) + &1) / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &n + &1`; REAL_HALF] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `M:real^1->num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`M:real^1->num`; `{interval_lowerbound k:real^1 | k IN d} UNION {interval_upperbound k | k IN d}`] UPPER_BOUND_FINITE_SET) THEN ASM_SIMP_TAC[FINITE_UNION; SIMPLE_IMAGE; FINITE_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^1` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o el 1 o CONJUNCTS o REWRITE_RULE[division_of]) THEN FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o CONJUNCT1) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL]; MP_TAC(ISPECL [`(f:num->real^1->real^N) n`; `s:real^1->bool`; `b:real`] HAS_BOUNDED_VECTOR_VARIATION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL[`d:(real^1->bool)->bool`; `t:real^1->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `t - s <= e ==> s <= b ==> t <= b + e`) THEN ASM_SIMP_TAC[GSYM SUM_SUB] THEN TRANS_TAC REAL_LE_TRANS `&(CARD(d:(real^1->bool)->bool)) * e / (&(CARD(d:(real^1->bool)->bool)) + &1)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_BOUND THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(f' - g') <= e / &2 /\ norm(f - g) <= e / &2 ==> norm(g' - g:real^N) - norm(f' - f) <= e`) THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_UNION; FORALL_IN_GSPEC]) THEN ASM_SIMP_TAC[]; REWRITE_TAC[REAL_ARITH `d * e / q:real = (e * d) / q`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC]]);; let INCREASING_LEFT_LIMIT_1 = prove (`!f a b c. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ c IN interval[a,b] ==> ?l. (f --> l) (at c within interval[a,c])`, REPEAT STRIP_TAC THEN EXISTS_TAC `lift(sup {drop(f x) | x IN interval[a,b] /\ drop x < drop c})` THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[LIM_WITHIN] THEN REWRITE_TAC[DIST_REAL; GSYM drop] THEN ASM_CASES_TAC `{x | x IN interval[a,b] /\ drop x < drop c} = {}` THENL [GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> ~b) ==> a ==> b ==> c`) THEN REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM; IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `{drop(f x) | x IN interval[a,b] /\ drop x < drop c}` SUP) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; EXISTS_TAC `drop(f(b:real^1))` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]; ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_ID] THEN ABBREV_TAC `s = sup (IMAGE (\x. drop(f x)) {x | x IN interval[a,b] /\ drop x < drop c})` THEN REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `s - e:real`)) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(s <= s - e)`; NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LE; IN_INTERVAL_1] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `drop c - drop d` THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d:real^1`; `x:real^1`]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REAL_ARITH_TAC]);; let DECREASING_LEFT_LIMIT_1 = prove (`!f a b c. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) /\ c IN interval[a,b] ==> ?l. (f --> l) (at c within interval[a,c])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. --((f:real^1->real^1) x)`; `a:real^1`; `b:real^1`; `c:real^1`] INCREASING_LEFT_LIMIT_1) THEN ASM_REWRITE_TAC[REAL_LE_NEG2; DROP_NEG] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; let INCREASING_RIGHT_LIMIT_1 = prove (`!f a b c. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ c IN interval[a,b] ==> ?l. (f --> l) (at c within interval[c,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. (f:real^1->real^1) (--x)`; `--b:real^1`; `--a:real^1`; `--c:real^1`] DECREASING_LEFT_LIMIT_1) THEN ASM_REWRITE_TAC[IN_INTERVAL_REFLECT] THEN ONCE_REWRITE_TAC[MESON[VECTOR_NEG_NEG] `(!x:real^1 y:real^1. P x y) <=> (!x y. P (--x) (--y))`] THEN REWRITE_TAC[DROP_NEG; IN_INTERVAL_REFLECT; VECTOR_NEG_NEG] THEN ASM_SIMP_TAC[REAL_LE_NEG2] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^1` THEN REWRITE_TAC[LIM_WITHIN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MESON[VECTOR_NEG_NEG] `(!x:real^1. P x) <=> (!x. P (--x))`] THEN REWRITE_TAC[IN_INTERVAL_REFLECT; VECTOR_NEG_NEG; NORM_ARITH `dist(--x:real^1,--y) = dist(x,y)`]);; let DECREASING_RIGHT_LIMIT_1 = prove (`!f a b c. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f y) <= drop(f x)) /\ c IN interval[a,b] ==> ?l. (f --> l) (at c within interval[c,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. --((f:real^1->real^1) x)`; `a:real^1`; `b:real^1`; `c:real^1`] INCREASING_RIGHT_LIMIT_1) THEN ASM_REWRITE_TAC[REAL_LE_NEG2; DROP_NEG] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; let HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT = prove (`!f:real^1->real^N a b c. f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] ==> ?l. (f --> l) (at c within interval[a,c])`, ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT; HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`\x. lift((f:real^1->real^N)x$i)`,`f:real^1->real^1`) THEN UNDISCH_TAC `(c:real^1) IN interval[a,b]` THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM EXISTS_LIFT] THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONJ_ASSOC] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `c:real^1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] INCREASING_LEFT_LIMIT_1))) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l2:real^1` THEN DISCH_TAC THEN X_GEN_TAC `l1:real^1` THEN DISCH_TAC THEN EXISTS_TAC `l1 - l2:real^1` THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN ASM_SIMP_TAC[LIM_SUB]);; let HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT = prove (`!f:real^1->real^N a b c. f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] ==> ?l. (f --> l) (at c within interval[c,b])`, ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT; HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`\x. lift((f:real^1->real^N)x$i)`,`f:real^1->real^1`) THEN UNDISCH_TAC `(c:real^1) IN interval[a,b]` THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM EXISTS_LIFT] THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONJ_ASSOC] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `c:real^1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] INCREASING_RIGHT_LIMIT_1))) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l2:real^1` THEN DISCH_TAC THEN X_GEN_TAC `l1:real^1` THEN DISCH_TAC THEN EXISTS_TAC `l1 - l2:real^1` THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN ASM_SIMP_TAC[LIM_SUB]);; let HAS_BOUNDED_VARIATION_RIGHT_LIMIT_GEN = prove (`!f:real^1->real^N s a. f has_bounded_variation_on s /\ is_interval s ==> ?l. (f --> l) (at a within {x | x IN s /\ drop a <= drop x})`, REPEAT STRIP_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^1) IN closure s` THENL [ALL_TAC; EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[LIM] THEN DISJ1_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN RULE_ASSUM_TAC(REWRITE_RULE[closure; IN_UNION]) THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[DE_MORGAN_THM]) THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; CONTRAPOS_THM; IN_ELIM_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LIMPT_SUBSET) THEN SET_TAC[]] THEN MP_TAC(ISPEC `closure s INTER cball(a:real^1,&1)` CONNECTED_COMPACT_INTERVAL_1) THEN SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL; CLOSED_CLOSURE] THEN REWRITE_TAC[CONNECTED_CONVEX_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IS_INTERVAL_CONVEX_1]) THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CLOSURE; CONVEX_CBALL] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `u:real^1`; `v:real^1`; `a:real^1`] HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT) THEN ANTS_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_CBALL; REAL_POS] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `closure s:real^1->bool` THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_CLOSURE; IS_INTERVAL_CONVEX_1] THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_WITHIN_SET_IMP) THEN REWRITE_TAC[EVENTUALLY_AT; IN_ELIM_THM] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `x:real^1` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[DIST_NZ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN SUBGOAL_THEN `x IN closure s INTER cball(a:real^1,&1)` MP_TAC THENL [REWRITE_TAC[IN_CBALL; IN_INTER] THEN ASM_SIMP_TAC[CLOSURE_INC; REAL_LT_IMP_LE]; ASM_SIMP_TAC[IN_INTERVAL_1]]]);; let HAS_BOUNDED_VARIATION_LEFT_LIMIT_GEN = prove (`!f:real^1->real^N s a. f has_bounded_variation_on s /\ is_interval s ==> ?l. (f --> l) (at a within {x | x IN s /\ drop x <= drop a})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^1) IN closure s` THENL [ALL_TAC; EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[LIM] THEN DISJ1_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN RULE_ASSUM_TAC(REWRITE_RULE[closure; IN_UNION]) THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[DE_MORGAN_THM]) THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; CONTRAPOS_THM; IN_ELIM_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LIMPT_SUBSET) THEN SET_TAC[]] THEN MP_TAC(ISPEC `closure s INTER cball(a:real^1,&1)` CONNECTED_COMPACT_INTERVAL_1) THEN SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL; CLOSED_CLOSURE] THEN REWRITE_TAC[CONNECTED_CONVEX_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IS_INTERVAL_CONVEX_1]) THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CLOSURE; CONVEX_CBALL] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `u:real^1`; `v:real^1`; `a:real^1`] HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT) THEN ANTS_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_CBALL; REAL_POS] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `closure s:real^1->bool` THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_CLOSURE; IS_INTERVAL_CONVEX_1] THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_WITHIN_SET_IMP) THEN REWRITE_TAC[EVENTUALLY_AT; IN_ELIM_THM] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `x:real^1` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[DIST_NZ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN SUBGOAL_THEN `x IN closure s INTER cball(a:real^1,&1)` MP_TAC THENL [REWRITE_TAC[IN_CBALL; IN_INTER] THEN ASM_SIMP_TAC[CLOSURE_INC; REAL_LT_IMP_LE]; ASM_SIMP_TAC[IN_INTERVAL_1]]]);; let INCREASING_LEFT_LIMIT_1_GEN = prove (`!f s a B. is_interval s /\ (!x. x IN s ==> drop(f x) <= B) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> ?l. (f --> l) (at a within {x | x IN s /\ drop x <= drop a})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `trivial_limit(at a within {x | x IN s /\ drop x <= drop a})` THENL [ASM_MESON_TAC[LIM]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [TRIVIAL_LIMIT_WITHIN]) THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?l:real^1. (f --> l) (at a within {x | x IN s INTER interval[b,a] /\ drop x <= drop a})` MP_TAC THENL [MATCH_MP_TAC HAS_BOUNDED_VARIATION_LEFT_LIMIT_GEN THEN ASM_SIMP_TAC[IS_INTERVAL_INTER; IS_INTERVAL_INTERVAL] THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION_GEN THEN ASM_SIMP_TAC[IN_INTER; bounded; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN EXISTS_TAC `max (abs(drop((f:real^1->real^1) b))) B` THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN REWRITE_TAC[NORM_1] THEN MATCH_MP_TAC(REAL_ARITH `x <= b /\ y <= x ==> abs x <= max (abs y) b`) THEN ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^1` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_WITHIN_SET_IMP) THEN SIMP_TAC[EVENTUALLY_AT; IN_ELIM_THM; IN_INTER; IN_INTERVAL_1] THEN EXISTS_TAC `drop a - drop b` THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < a - b <=> b <= a /\ ~(a = b)`] THEN ASM_REWRITE_TAC[dist; NORM_1; DROP_EQ; DROP_SUB] THEN ASM_REAL_ARITH_TAC]);; let DECREASING_LEFT_LIMIT_1_GEN = prove (`!f s a B. is_interval s /\ (!x. x IN s ==> B <= drop(f x)) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> ?l. (f --> l) (at a within {x | x IN s /\ drop x <= drop a})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. --((f:real^1->real^1) x)`; `s:real^1->bool`; `a:real^1`; `--B:real`] INCREASING_LEFT_LIMIT_1_GEN) THEN ASM_REWRITE_TAC[REAL_LE_NEG2; DROP_NEG] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; let INCREASING_RIGHT_LIMIT_1_GEN = prove (`!f s a B. is_interval s /\ (!x. x IN s ==> B <= drop(f x)) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> ?l. (f --> l) (at a within {x | x IN s /\ drop a <= drop x})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. (f:real^1->real^1) (--x)`; `IMAGE (--) (s:real^1->bool)`; `--a:real^1`; `B:real`] DECREASING_LEFT_LIMIT_1_GEN) THEN ASM_REWRITE_TAC[IS_INTERVAL_REFLECT] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; VECTOR_NEG_NEG] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[VECTOR_NEG_NEG; DROP_NEG; REAL_LE_NEG2] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^1` THEN REWRITE_TAC[LIM_WITHIN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MESON[VECTOR_NEG_NEG] `(!x:real^1. P x) <=> (!x. P (--x))`] THEN REWRITE_TAC[NORM_ARITH `dist(--x:real^1,--y) = dist(x,y)`] THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_NEG; DROP_NEG; REAL_LE_NEG2] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; let DECREASING_RIGHT_LIMIT_1_GEN = prove (`!f s a B. is_interval s /\ (!x. x IN s ==> drop(f x) <= B) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> ?l. (f --> l) (at a within {x | x IN s /\ drop a <= drop x})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. --((f:real^1->real^1) x)`; `s:real^1->bool`; `a:real^1`; `--B:real`] INCREASING_RIGHT_LIMIT_1_GEN) THEN ASM_REWRITE_TAC[REAL_LE_NEG2; DROP_NEG] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; let VECTOR_VARIATION_CONTINUOUS_LEFT = prove (`!f:real^1->real^N a b c. f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] ==> ((\x. lift(vector_variation(interval[a,x]) f)) continuous (at c within interval[a,c]) <=> f continuous (at c within interval[a,c]))`, let lemma = prove (`!f:real^1->real^1 a b c. f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] ==> ((\x. lift(vector_variation(interval[a,x]) f)) continuous (at c within interval[a,c]) <=> f continuous (at c within interval[a,c]))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[continuous_within] THEN REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN REWRITE_TAC[GSYM DROP_SUB] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `c:real^1`; `x:real^1`] VECTOR_VARIATION_COMBINE) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `abs(a - (a + b)) = abs b`] THEN REWRITE_TAC[drop; GSYM NORM_REAL] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN ASM_CASES_TAC `c limit_point_of interval[a:real^1,c]` THENL [ALL_TAC; ASM_REWRITE_TAC[CONTINUOUS_WITHIN; LIM; TRIVIAL_LIMIT_WITHIN]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] INCREASING_LEFT_LIMIT_1) THEN MP_TAC(ISPECL [`g:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] INCREASING_LEFT_LIMIT_1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `gc:real^1` THEN DISCH_TAC THEN X_GEN_TAC `hc:real^1` THEN DISCH_TAC THEN ABBREV_TAC `k = gc - (g:real^1->real^1) c` THEN SUBGOAL_THEN `hc - (h:real^1->real^1) c = k` ASSUME_TAC THENL [EXPAND_TAC "k" THEN ONCE_REWRITE_TAC[VECTOR_ARITH `hc' - hc:real^1 = gc' - gc <=> gc' - hc' = gc - hc`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_WITHIN]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LIM_UNIQUE) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN ASM_SIMP_TAC[LIM_SUB]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`g':real^1->real^1 = \x. if drop c <= drop x then g(x) + k else g(x)`; `h':real^1->real^1 = \x. if drop c <= drop x then h(x) + k else h(x)`] THEN SUBGOAL_THEN `(!x y. x IN interval[a,c] /\ y IN interval[a,c] /\ drop x <= drop y ==> drop(g' x) <= drop(g' y)) /\ (!x y. x IN interval[a,c] /\ y IN interval[a,c] /\ drop x <= drop y ==> drop(h' x) <= drop(h' y))` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN (ASM_CASES_TAC `drop c <= drop x` THENL [SUBGOAL_THEN `drop c <= drop y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[DROP_ADD; REAL_LE_RADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `y:real^1 = c` SUBST_ALL_TAC THENL [REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `gc - g c = k ==> b <= drop(g c + (gc - g c)) ==> b <= drop(g c + k)`)) THEN REWRITE_TAC[VECTOR_ARITH `a + b - a:real^1 = b`] THEN MATCH_MP_TAC(ISPEC `at c within interval[a:real^1,c]` LIM_DROP_LBOUND)) THENL [EXISTS_TAC `g:real^1->real^1`; EXISTS_TAC `h:real^1->real^1`] THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THEN EXISTS_TAC `drop c - drop x` THEN (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(g':real^1->real^1) continuous (at c within interval[a,c]) /\ (h':real^1->real^1) continuous (at c within interval[a,c])` MP_TAC THENL [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[CONTINUOUS_WITHIN; REAL_LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_ARITH `g - g':real^1 = k <=> g' + k = g`]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[LIM_WITHIN; DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN SIMP_TAC[REAL_ARITH `x <= c /\ &0 < abs(x - c) ==> ~(c <= x)`] THEN REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN REWRITE_TAC[continuous_within] THEN REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`) th) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `d:real^1` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `c:real^1`; `d:real^1`] VECTOR_VARIATION_COMBINE) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[REAL_ARITH `abs(a - (a + b)) = abs b`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < a ==> abs x < a`) THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `f:real^1->real^1 = \x. g' x - h' x` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`g':real^1->real^1`; `\x. --((h':real^1->real^1) x)`; `interval[d:real^1,c]`] VECTOR_VARIATION_TRIANGLE) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NEG] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,c]` THEN ASM_SIMP_TAC[INCREASING_BOUNDED_VARIATION; SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_SUB] THEN MATCH_MP_TAC(REAL_ARITH `y < a / &2 /\ z < a / &2 ==> x <= y + z ==> x < a`) THEN REWRITE_TAC[VECTOR_VARIATION_NEG] THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) INCREASING_VECTOR_VARIATION o lhand o snd) THEN (ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1; REAL_NOT_LT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC]) THEN MATCH_MP_TAC(REAL_ARITH `abs(x - y) < e ==> y - x < e`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]) in REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[continuous_within] THEN REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN REWRITE_TAC[GSYM DROP_SUB] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `c:real^1`; `x:real^1`] VECTOR_VARIATION_COMBINE) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `abs(a - (a + b)) = abs b`] THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN ASM_CASES_TAC `c limit_point_of interval[a:real^1,c]` THENL [ALL_TAC; ASM_REWRITE_TAC[CONTINUOUS_WITHIN; LIM; TRIVIAL_LIMIT_WITHIN]] THEN MATCH_MP_TAC(INST_TYPE [`:1`,`:P`] CONTINUOUS_WITHIN_COMPARISON) THEN EXISTS_TAC `\x. vsum (1..dimindex(:N)) (\i. lift(vector_variation (interval[a,x]) (\u. lift(((f:real^1->real^N) u)$i))))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) lemma o snd) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE; CONTINUOUS_COMPONENTWISE_LIFT]) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THEN REWRITE_TAC[dist; GSYM VSUM_SUB_NUMSEG; GSYM LIFT_SUB] THEN SUBGOAL_THEN `vector_variation(interval [a,c]) (f:real^1->real^N) = vector_variation(interval [a,x]) (f:real^1->real^N) + vector_variation(interval [x,c]) (f:real^1->real^N) /\ !i. 1 <= i /\ i <= dimindex(:N) ==> vector_variation(interval [a,c]) (\x. lift((f:real^1->real^N) x $ i)) = vector_variation(interval [a,x]) (\x. lift(f x$i)) + vector_variation(interval [x,c]) (\x. lift(f x$i))` (fun th -> ASM_SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[REAL_LE_REFL]; REWRITE_TAC[REAL_ADD_SUB]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[x:real^1,c]` o MATCH_MP(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[REAL_LE_REFL]; DISCH_TAC] THEN ASM_SIMP_TAC[NORM_LIFT; real_abs; VECTOR_VARIATION_POS_LE] THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ABS_CONV) [GSYM BASIS_EXPANSION] THEN W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_SUM_LE o lhand o snd) THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ANTS_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_VARIATION_COMPARISON); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[NORM_1; DROP_VSUM; LIFT_DROP; o_DEF] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= abs b`) THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC VECTOR_VARIATION_COMPARISON] THEN ASM_SIMP_TAC[dist; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL; NORM_BASIS] THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; REAL_MUL_RID; REAL_LE_REFL]);; let VECTOR_VARIATION_CONTINUOUS_RIGHT = prove (`!f:real^1->real^N a b c. f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] ==> ((\x. lift(vector_variation(interval[a,x]) f)) continuous (at c within interval[c,b]) <=> f continuous (at c within interval[c,b]))`, let lemma = prove (`!f:real^1->real^1 a b c. f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] ==> ((\x. lift(vector_variation(interval[a,x]) f)) continuous (at c within interval[c,b]) <=> f continuous (at c within interval[c,b]))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[continuous_within] THEN REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN REWRITE_TAC[GSYM DROP_SUB] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `x:real^1`; `c:real^1`] VECTOR_VARIATION_COMBINE) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `abs((a + b) - a) = abs b`] THEN REWRITE_TAC[drop; GSYM NORM_REAL] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN ASM_CASES_TAC `c limit_point_of interval[c:real^1,b]` THENL [ALL_TAC; ASM_REWRITE_TAC[CONTINUOUS_WITHIN; LIM; TRIVIAL_LIMIT_WITHIN]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] INCREASING_RIGHT_LIMIT_1) THEN MP_TAC(ISPECL [`g:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] INCREASING_RIGHT_LIMIT_1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `gc:real^1` THEN DISCH_TAC THEN X_GEN_TAC `hc:real^1` THEN DISCH_TAC THEN ABBREV_TAC `k = gc - (g:real^1->real^1) c` THEN SUBGOAL_THEN `hc - (h:real^1->real^1) c = k` ASSUME_TAC THENL [EXPAND_TAC "k" THEN ONCE_REWRITE_TAC[VECTOR_ARITH `hc' - hc:real^1 = gc' - gc <=> gc' - hc' = gc - hc`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_WITHIN]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT`a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LIM_UNIQUE) THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN ASM_SIMP_TAC[LIM_SUB]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`g':real^1->real^1 = \x. if drop x <= drop c then g(x) + k else g(x)`; `h':real^1->real^1 = \x. if drop x <= drop c then h(x) + k else h(x)`] THEN SUBGOAL_THEN `(!x y. x IN interval[c,b] /\ y IN interval[c,b] /\ drop x <= drop y ==> drop(g' x) <= drop(g' y)) /\ (!x y. x IN interval[c,b] /\ y IN interval[c,b] /\ drop x <= drop y ==> drop(h' x) <= drop(h' y))` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN (ASM_CASES_TAC `drop y <= drop c` THENL [SUBGOAL_THEN `drop x <= drop c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[DROP_ADD; REAL_LE_RADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `x:real^1 = c` SUBST_ALL_TAC THENL [REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `gc - g c = k ==> drop(g c + (gc - g c)) <= b ==> drop(g c + k) <= b`)) THEN REWRITE_TAC[VECTOR_ARITH `a + b - a:real^1 = b`] THEN MATCH_MP_TAC(ISPEC `at c within interval[c:real^1,b]` LIM_DROP_UBOUND)) THENL [EXISTS_TAC `g:real^1->real^1`; EXISTS_TAC `h:real^1->real^1`] THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THEN EXISTS_TAC `drop y - drop c` THEN (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(g':real^1->real^1) continuous (at c within interval[c,b]) /\ (h':real^1->real^1) continuous (at c within interval[c,b])` MP_TAC THENL [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[CONTINUOUS_WITHIN; REAL_LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_ARITH `g - g':real^1 = k <=> g' + k = g`]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[LIM_WITHIN; DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN SIMP_TAC[REAL_ARITH `c <= x /\ &0 < abs(x - c) ==> ~(x <= c)`] THEN REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN REWRITE_TAC[continuous_within] THEN REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`) th) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `d:real^1` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `d:real^1`; `c:real^1`] VECTOR_VARIATION_COMBINE) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[REAL_ARITH `(a + b) - a:real = b`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < a ==> abs x < a`) THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `f:real^1->real^1 = \x. g' x - h' x` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`g':real^1->real^1`; `\x. --((h':real^1->real^1) x)`; `interval[c:real^1,d]`] VECTOR_VARIATION_TRIANGLE) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NEG] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[c:real^1,b]` THEN ASM_SIMP_TAC[INCREASING_BOUNDED_VARIATION; SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_SUB] THEN MATCH_MP_TAC(REAL_ARITH `y < a / &2 /\ z < a / &2 ==> x <= y + z ==> x < a`) THEN REWRITE_TAC[VECTOR_VARIATION_NEG] THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) INCREASING_VECTOR_VARIATION o lhand o snd) THEN (ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1; REAL_NOT_LT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC]) THEN MATCH_MP_TAC(REAL_ARITH `abs x < e ==> x < e`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]) in REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[continuous_within] THEN REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN REWRITE_TAC[GSYM DROP_SUB] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `x:real^1`; `c:real^1`] VECTOR_VARIATION_COMBINE) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `abs((a + b) - a) = abs b`] THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN ASM_CASES_TAC `c limit_point_of interval[c:real^1,b]` THENL [ALL_TAC; ASM_REWRITE_TAC[CONTINUOUS_WITHIN; LIM; TRIVIAL_LIMIT_WITHIN]] THEN MATCH_MP_TAC(INST_TYPE [`:1`,`:P`] CONTINUOUS_WITHIN_COMPARISON) THEN EXISTS_TAC `\x. vsum (1..dimindex(:N)) (\i. lift(vector_variation (interval[a,x]) (\u. lift(((f:real^1->real^N) u)$i))))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) lemma o snd) THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE; CONTINUOUS_COMPONENTWISE_LIFT]) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THEN REWRITE_TAC[dist; GSYM VSUM_SUB_NUMSEG; GSYM LIFT_SUB] THEN SUBGOAL_THEN `vector_variation(interval [a,x]) (f:real^1->real^N) = vector_variation(interval [a,c]) (f:real^1->real^N) + vector_variation(interval [c,x]) (f:real^1->real^N) /\ !i. 1 <= i /\ i <= dimindex(:N) ==> vector_variation(interval [a,x]) (\x. lift((f:real^1->real^N) x $ i)) = vector_variation(interval [a,c]) (\x. lift(f x$i)) + vector_variation(interval [c,x]) (\x. lift(f x$i))` (fun th -> ASM_SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `a - (a + b):real = --b`]] THEN REWRITE_TAC[LIFT_NEG; VSUM_NEG; NORM_NEG] THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[c:real^1,x]` o MATCH_MP(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[REAL_LE_REFL]; DISCH_TAC] THEN ASM_SIMP_TAC[NORM_LIFT; real_abs; VECTOR_VARIATION_POS_LE] THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ABS_CONV) [GSYM BASIS_EXPANSION] THEN W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_SUM_LE o lhand o snd) THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ANTS_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HAS_BOUNDED_VARIATION_COMPARISON); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[NORM_1; DROP_VSUM; LIFT_DROP; o_DEF] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= abs b`) THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC VECTOR_VARIATION_COMPARISON] THEN ASM_SIMP_TAC[dist; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL; NORM_BASIS] THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; REAL_MUL_RID; REAL_LE_REFL]);; let VECTOR_VARIATION_CONTINUOUS = prove (`!f:real^1->real^N a b c. f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] ==> ((\x. lift(vector_variation(interval[a,x]) f)) continuous (at c within interval[a,b]) <=> f continuous (at c within interval[a,b]))`, let lemma = prove (`!f:real^1->real^N a b c. c IN interval[a,b] ==> (f continuous (at c within interval[a,b]) <=> f continuous (at c within interval[a,c]) /\ f continuous (at c within interval[c,b]))`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN EQ_TAC THENL [DISCH_THEN(ASSUME_TAC o GEN_ALL o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_WITHIN_SUBSET)) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; DISCH_THEN(MP_TAC o MATCH_MP LIM_UNION) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LIM_WITHIN_SUBSET)] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP lemma th]) THEN ASM_MESON_TAC[VECTOR_VARIATION_CONTINUOUS_LEFT; VECTOR_VARIATION_CONTINUOUS_RIGHT]);; let CONTINUOUS_ON_VECTOR_VARIATION = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] /\ f continuous_on interval[a,b] ==> (\x. lift (vector_variation (interval [a,x]) f)) continuous_on interval[a,b]`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; VECTOR_VARIATION_CONTINUOUS]);; let HAS_BOUNDED_VARIATION_DARBOUX_STRONG = prove (`!f a b. f has_bounded_variation_on interval[a,b] ==> ?g h. (!x. f x = g x - h x) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(g x) <= drop(g y)) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(h x) <= drop(h y)) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y ==> drop(g x) < drop(g y)) /\ (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y ==> drop(h x) < drop(h y)) /\ (!x. x IN interval[a,b] /\ f continuous (at x within interval[a,x]) ==> g continuous (at x within interval[a,x]) /\ h continuous (at x within interval[a,x])) /\ (!x. x IN interval[a,b] /\ f continuous (at x within interval[x,b]) ==> g continuous (at x within interval[x,b]) /\ h continuous (at x within interval[x,b])) /\ (!x. x IN interval[a,b] /\ f continuous (at x within interval[a,b]) ==> g continuous (at x within interval[a,b]) /\ h continuous (at x within interval[a,b]))`, REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`\x:real^1. x + lift(vector_variation (interval[a,x]) (f:real^1->real^1))`; `\x:real^1. x + lift(vector_variation (interval[a,x]) f) - f x`] THEN REWRITE_TAC[VECTOR_ARITH `(x + l) - (x + l - f):real^1 = f`] THEN REWRITE_TAC[LIFT_DROP; DROP_SUB; DROP_ADD] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE; MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN EXISTS_TAC `drop(f(a:real^1))` THEN REWRITE_TAC[GSYM DROP_SUB] THEN MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE; MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN EXISTS_TAC `drop(f(a:real^1))` THEN REWRITE_TAC[GSYM DROP_SUB] THEN MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] VECTOR_VARIATION_CONTINUOUS_LEFT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] VECTOR_VARIATION_CONTINUOUS_LEFT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] VECTOR_VARIATION_CONTINUOUS_RIGHT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] VECTOR_VARIATION_CONTINUOUS_RIGHT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] VECTOR_VARIATION_CONTINUOUS) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] VECTOR_VARIATION_CONTINUOUS) THEN ASM_REWRITE_TAC[]] THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC));; let INCREASING_COUNTABLE_DISCONTINUITIES = prove (`!f s. is_interval s /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> COUNTABLE {x | x IN s /\ ~(f continuous at x)}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `COUNTABLE {x | x IN frontier s /\ ~(f continuous at x)} /\ COUNTABLE {x | x IN interior s /\ ~((f:real^1->real^1) continuous at x)}` MP_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^1->bool` CLOSURE_SUBSET) THEN SET_TAC[]] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[CARD_FRONTIER_INTERVAL_1]; ALL_TAC] THEN SUBGOAL_THEN `open(interior s) /\ !x y. x IN interior s /\ y IN interior s /\ drop x <= drop y ==> drop(f x) <= drop(f y)` MP_TAC THENL [REWRITE_TAC[OPEN_INTERIOR] THEN MP_TAC(ISPEC `s:real^1->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]; POP_ASSUM_LIST(K ALL_TAC)] THEN SPEC_TAC(`interior s:real^1->bool`,`s:real^1->bool`) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^1->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:real^1->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:real^1->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN SUBGOAL_THEN `!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)` MP_TAC THENL [ASM SET_TAC[]; POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC] THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; COUNTABLE_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN ASM_SIMP_TAC[CLOSED_OPEN_INTERVAL_1] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `a INSERT b INSERT {x | x IN interval(a,b) /\ ~((f:real^1->real^1) continuous at x)}` THEN CONJ_TAC THENL [REWRITE_TAC[COUNTABLE_INSERT]; SET_TAC[]] THEN SUBGOAL_THEN `(!c:real^1. c IN interval(a,b) ==> c limit_point_of interval[a,c]) /\ (!c:real^1. c IN interval(a,b) ==> c limit_point_of interval[c,b])` STRIP_ASSUME_TAC THENL [SIMP_TAC[IN_INTERVAL_1; REAL_LE_REFL; LIMPT_OF_CONVEX; CONVEX_INTERVAL; REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM INTERVAL_SING; GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] INCREASING_LEFT_LIMIT_1) THEN ASM_REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `l:real^1->real^1` (LABEL_TAC "l")) THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] INCREASING_RIGHT_LIMIT_1) THEN ASM_REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^1` (LABEL_TAC "r")) THEN SUBGOAL_THEN `!c. c IN interval(a:real^1,b) ==> drop(l c) <= drop(f c) /\ drop(f c) <= drop(r c)` ASSUME_TAC THENL [REPEAT STRIP_TAC THENL [MATCH_MP_TAC(ISPEC `at c within interval[a:real^1,c]` LIM_DROP_UBOUND); MATCH_MP_TAC(ISPEC `at c within interval[c:real^1,b]` LIM_DROP_LBOUND)] THEN EXISTS_TAC `f:real^1->real^1` THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED; TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(!c x. c IN interval(a:real^1,b) /\ x IN interval[a,b] /\ drop x < drop c ==> drop(f x) <= drop(l c)) /\ (!c x. c IN interval(a:real^1,b) /\ x IN interval[a,b] /\ drop c < drop x ==> drop(r c) <= drop(f x))` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THENL [MATCH_MP_TAC(ISPEC `at c within interval[a:real^1,c]` LIM_DROP_LBOUND); MATCH_MP_TAC(ISPEC `at c within interval[c:real^1,b]` LIM_DROP_UBOUND)] THEN EXISTS_TAC `f:real^1->real^1` THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED; TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THENL [EXISTS_TAC `drop c - drop x`; EXISTS_TAC `drop x - drop c`] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[COUNTABLE; ge_c] THEN TRANS_TAC CARD_LE_TRANS `rational` THEN GEN_REWRITE_TAC RAND_CONV [GSYM ge_c] THEN REWRITE_TAC[COUNTABLE_RATIONAL; GSYM COUNTABLE; le_c] THEN SUBGOAL_THEN `!c. c IN interval(a,b) /\ ~((f:real^1->real^1) continuous at c) ==> drop(l(c:real^1)) < drop(r c)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN SUBGOAL_THEN `l c = (f:real^1->real^1) c /\ r c = f c` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONTINUOUS_AT]) THEN REWRITE_TAC[] THEN SUBGOAL_THEN `((f:real^1->real^1) --> f c) (at c within interval(a,b))` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[OPEN_INTERVAL; LIM_WITHIN_OPEN]] THEN MATCH_MP_TAC LIM_WITHIN_SUBSET THEN EXISTS_TAC `interval[a:real^1,c] UNION interval[c,b]` THEN REWRITE_TAC[LIM_WITHIN_UNION] THEN CONJ_TAC THENL [ASM_MESON_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED]; REWRITE_TAC[SUBSET; IN_UNION; IN_INTERVAL_1] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!c. c IN interval(a,b) /\ ~((f:real^1->real^1) continuous at c) ==> ?q. rational q /\ drop(l c) < q /\ q < drop(r c)` MP_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `drop(l(c:real^1)) < drop(r c)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(drop(l(c:real^1)) + drop(r c)) / &2`; `(drop(r c) - drop(l(c:real^1))) / &2`] RATIONAL_APPROXIMATION) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; IN_INTERVAL_1] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real` THEN SIMP_TAC[IN] THEN DISCH_THEN(LABEL_TAC "*") THEN MATCH_MP_TAC(MESON[REAL_LE_TOTAL] `(!x y. P x y ==> P y x) /\ (!x y. drop x <= drop y ==> P x y) ==> !x y. P x y`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN ASM_CASES_TAC `x:real^1 = y` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `q(x:real^1) < q(y)` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LT_REFL]] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `drop(r(x:real^1))` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(l(y:real^1))` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(f(inv(&2) % (x + y):real^1))` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_ADD] THEN ASM_REAL_ARITH_TAC);; let DECREASING_COUNTABLE_DISCONTINUITIES = prove (`!f s. is_interval s /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> COUNTABLE {x | x IN s /\ ~(f continuous at x)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(--) o (f:real^1->real^1)`; `s:real^1->bool`] INCREASING_COUNTABLE_DISCONTINUITIES) THEN ASM_REWRITE_TAC[o_THM; DROP_NEG; REAL_LE_NEG2] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT(STRIP_TAC THEN ASM_REWRITE_TAC[]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_NEG) THEN ASM_REWRITE_TAC[o_THM; VECTOR_NEG_NEG; ETA_AX]);; let HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES = prove (`!f:real^1->real^N s. f has_bounded_variation_on s /\ is_interval s ==> COUNTABLE {x | x IN s /\ ~(f continuous at x)}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_COMPONENTWISE_LIFT] THEN SUBGOAL_THEN `COUNTABLE(UNIONS {{x | x IN s /\ ~((\x. lift((f:real^1->real^N) x$i)) continuous at x)} | i IN 1..dimindex(:N)})` MP_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG] THEN SET_TAC[]] THEN SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMP_COUNTABLE; FINITE_NUMSEG; FINITE_IMAGE; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num` o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`\x. lift((f:real^1->real^N) x$i)`,`f:real^1->real^1`) THEN UNDISCH_TAC `is_interval(s:real^1->bool)` THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`] HAS_BOUNDED_VARIATION_DARBOUX_GEN) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^1`; `s:real^1->bool`] INCREASING_COUNTABLE_DISCONTINUITIES) THEN MP_TAC(ISPECL [`h:real^1->real^1`; `s:real^1->bool`] INCREASING_COUNTABLE_DISCONTINUITIES) THEN ASM_REWRITE_TAC[IMP_IMP; IS_INTERVAL_INTERVAL; GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(p /\ q ==> r) ==> a /\ ~r ==> a /\ ~p \/ a /\ ~q`) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM ETA_AX] THEN ASM_SIMP_TAC[CONTINUOUS_SUB]);; let HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE = prove (`!f:real^1->real^N s a b. COUNTABLE s /\ f continuous_on interval[a,b] /\ (!x. x IN interval[a,b] DIFF s ==> f differentiable at x) ==> (f has_bounded_variation_on interval[a,b] <=> (\x. vector_derivative f (at x)) absolutely_integrable_on interval[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ] THEN REWRITE_TAC[has_bounded_variation_on] THEN MATCH_MP_TAC(TAUT `q /\ (p <=> r) ==> (p <=> q /\ r)`) THEN CONJ_TAC THENL [ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN MP_TAC(ISPECL [`f:real^1->real^N`; `\x. vector_derivative (f:real^1->real^N) (at x)`; `s:real^1->bool`; `a:real^1`; `b:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG) THEN ASM_MESON_TAC[VECTOR_DERIVATIVE_WORKS; integrable_on; HAS_VECTOR_DERIVATIVE_AT_WITHIN]; MATCH_MP_TAC(MESON[HAS_BOUNDED_SETVARIATION_ON_EQ] `(!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s ==> f(interval[a,b]) = g(interval[a,b])) ==> (f has_bounded_setvariation_on s <=> g has_bounded_setvariation_on s)`) THEN SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; GSYM INTERVAL_NE_EMPTY] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `\x. vector_derivative (f:real^1->real^N) (at x)`; `s:real^1->bool`; `u:real^1`; `v:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG) THEN ASM_REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[INTEGRAL_UNIQUE]] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; IN_DIFF; SUBSET]; REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN ASM_SIMP_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN ASM SET_TAC[]]]);; let HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE = prove (`!f:real^1->real^N s a b. COUNTABLE s /\ f continuous_on interval[a,b] /\ (!x. x IN interval[a,b] DIFF s ==> f differentiable at x) ==> (f has_bounded_variation_on interval[a,b] <=> (\x. lift(norm(vector_derivative f (at x)))) integrable_on interval[a,b])`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN REWRITE_TAC[MATCH_MP HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE th]) THEN REWRITE_TAC[absolutely_integrable_on] THEN MATCH_MP_TAC(TAUT `p ==> (p /\ q <=> q)`) THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN MP_TAC(ISPECL [`f:real^1->real^N`; `\x. vector_derivative (f:real^1->real^N) (at x)`; `s:real^1->bool`; `a:real^1`; `b:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG) THEN ASM_MESON_TAC[VECTOR_DERIVATIVE_WORKS; integrable_on; HAS_VECTOR_DERIVATIVE_AT_WITHIN]);; let VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE = prove (`!f:real^1->real^N s a b. COUNTABLE s /\ f continuous_on interval[a,b] /\ (!x. x IN interval[a,b] DIFF s ==> f differentiable at x) /\ f has_bounded_variation_on interval[a,b] ==> vector_variation (interval[a,b]) f = drop(integral (interval[a,b]) (\x. lift(norm(vector_derivative f (at x)))))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`; `a:real^1`; `b:real^1`] HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SET_VARIATION) THEN REWRITE_TAC[vector_variation] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SET_VARIATION_EQ THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN SIMP_TAC[INTERVAL_NE_EMPTY_1; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN ASM_MESON_TAC[VECTOR_DERIVATIVE_WORKS; HAS_VECTOR_DERIVATIVE_AT_WITHIN; IN_DIFF; SUBSET]);; let INTEGRABLE_BOUNDED_VARIATION_PRODUCT = prove (`!f:real^1->real^N g a b. f integrable_on interval[a,b] /\ g has_bounded_variation_on interval[a,b] ==> (\x. drop(g x) % f x) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^1->real^1`; `k:real^1->real^1`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[DROP_SUB; VECTOR_SUB_RDISTRIB] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN ASM_REWRITE_TAC[]);; let INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT = prove (`!f:real^1->real^N g a b. f integrable_on interval[a,b] /\ (lift o g) has_bounded_variation_on interval[a,b] ==> (\x. g x % f x) integrable_on interval[a,b]`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_BOUNDED_VARIATION_PRODUCT) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL = prove (`!op:real^M->real^N->real^P f g a b. bilinear op /\ f integrable_on interval[a,b] /\ g has_bounded_variation_on interval[a,b] ==> (\x. op (g x) (f x)) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV) [GSYM BASIS_EXPANSION] THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [bilinear]) THEN FIRST_ASSUM(MP_TAC o GEN_ALL o ISPEC `1..n` o ONCE_REWRITE_RULE[SWAP_FORALL_THM] o MATCH_MP (REWRITE_RULE[IMP_CONJ] LINEAR_VSUM) o SPEC_ALL) THEN SIMP_TAC[FINITE_NUMSEG; o_DEF] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC INTEGRABLE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_CMUL o SPEC_ALL) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN ASM_SIMP_TAC[o_DEF; IN_NUMSEG] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC INTEGRABLE_LINEAR THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [bilinear]) THEN SIMP_TAC[ETA_AX]);; let INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL = prove (`!op:real^M->real^N->real^P f g a b. bilinear op /\ f integrable_on interval[a,b] /\ g has_bounded_variation_on interval[a,b] ==> (\x. op (f x) (g x)) integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x y. (op:real^M->real^N->real^P) y x`; `f:real^1->real^M`; `g:real^1->real^N`; `a:real^1`; `b:real^1`] INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL) THEN ASM_REWRITE_TAC[BILINEAR_SWAP]);; let INTEGRABLE_BOUNDED_VARIATION = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> f integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^1 y:real^N. drop x % y`; `(\x. vec 1):real^1->real^1`; `f:real^1->real^N`; `a:real^1`; `b:real^1`] INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL) THEN ASM_REWRITE_TAC[BILINEAR_DROP_MUL; DROP_VEC; INTEGRABLE_CONST] THEN REWRITE_TAC[VECTOR_MUL_LID; ETA_AX]);; let HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT = prove (`!f:real^1->real^N a b. f absolutely_integrable_on interval[a,b] ==> (\c. integral (interval[a,c]) f) has_bounded_variation_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; LIFT_EQ; INTERVAL_UPPERBOUND_NONEMPTY] THEN SIMP_TAC[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1; GSYM REAL_NOT_LE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b - c <=> c + a = b`] THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_ON_SUBINTERVAL) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT = prove (`!f:real^1->real^N a b. f absolutely_integrable_on interval[a,b] ==> (\c. integral (interval[c,b]) f) has_bounded_variation_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN ONCE_REWRITE_TAC[GSYM HAS_BOUNDED_SETVARIATION_ON_NEG] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; LIFT_EQ; INTERVAL_UPPERBOUND_NONEMPTY] THEN SIMP_TAC[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1; GSYM REAL_NOT_LE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = --(b - c) <=> a + b = c`] THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_ON_SUBINTERVAL) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS = prove (`!f:real^1->real^N s. is_interval s /\ f continuous_on s /\ f has_bounded_variation_on s ==> f uniformly_continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_CASES_TAC `vector_variation s (f:real^1->real^N) < e` THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; IS_INTERVAL_CONVEX_1]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN SUBGOAL_THEN `?a b. a IN s /\ b IN s /\ drop a < drop b /\ vector_variation s (f:real^1->real^N) - e / &2 < vector_variation (interval[a,b]) f /\ vector_variation (interval[a,b]) f <= vector_variation s f` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_WORKS) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (MP_TAC o SPEC `vector_variation s (f:real^1->real^N) - e / &2`)) THEN ASM_REWRITE_TAC[REAL_ARITH `v <= v - e / &2 <=> ~(&0 < e)`; IMP_IMP] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN ASM_CASES_TAC `?c:real^1. t SUBSET {c}` THENL [FIRST_X_ASSUM(CHOOSE_THEN (STRIP_ASSUME_TAC o MATCH_MP (SET_RULE `s SUBSET {a} ==> s = {} \/ s = {a}`))) THEN ASM_SIMP_TAC[IMP_CONJ; DIVISION_OF_TRIVIAL; SUM_CLAUSES] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM INTERVAL_SING] THEN REWRITE_TAC[DIVISION_OF_SING] THEN SIMP_TAC[SUM_SING; VECTOR_SUB_REFL; NORM_0; REAL_LE_REFL; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN MP_TAC(ISPEC `convex hull t:real^1->bool` IS_INTERVAL_COMPACT) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [REWRITE_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN ASM_MESON_TAC[ELEMENTARY_COMPACT]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^1` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^1`] THEN ASM_CASES_TAC `drop b <= drop a` THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_LE_LT]) THEN REWRITE_TAC[DROP_EQ; GSYM INTERVAL_EQ_EMPTY_1] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_HULL_EQ_SING; CONVEX_HULL_EQ_EMPTY; INTERVAL_SING] THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE])] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `convex hull (t:real^1->bool) SUBSET s` MP_TAC THENL [ASM_MESON_TAC[IS_INTERVAL_CONVEX_1; HULL_MINIMAL]; ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN REPLICATE_TAC 2 (MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_IMP_LE]; DISCH_TAC]) THEN ASM_SIMP_TAC[VECTOR_VARIATION_MONOTONE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN SUBGOAL_THEN `(f:real^1->real^N) has_bounded_variation_on interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET]; DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_WORKS)] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN EXISTS_TAC `t:real^1->bool` THEN ASM_MESON_TAC[HULL_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `interval[a:real^1,b] SUBSET s` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^1->real^N) uniformly_continuous_on interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL; CONTINUOUS_ON_SUBSET]; REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF]] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (drop b - drop a)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN SUBGOAL_THEN `!x. x IN s /\ drop b <= drop x ==> dist(f x:real^N,f b) < e / &2` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `x:real^1`; `b:real^1`] VECTOR_VARIATION_COMBINE) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `d <= bx /\ ax - e < ab ==> ab + bx = ax ==> d < e`) THEN CONJ_TAC THENL [REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[SEGMENT_1; SUBSET_REFL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `s - e < ab ==> t <= s ==> t - e < ab`)) THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN s /\ drop x <= drop a ==> dist(f x:real^N,f a) < e / &2` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `x:real^1`; `b:real^1`; `a:real^1`] VECTOR_VARIATION_COMBINE) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `d <= xa /\ xb - e < ab ==> xa + ab = xb ==> d < e`) THEN CONJ_TAC THENL [REWRITE_TAC[dist] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[SEGMENT_1; SUBSET_REFL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `s - e < ab ==> t <= s ==> t - e < ab`)) THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN ASM_REWRITE_TAC[FORALL_DROP; LIFT_DROP; DIST_REFL] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN REWRITE_TAC[DIST_REAL; GSYM drop] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(drop u <= drop a /\ drop v <= drop a \/ drop u <= drop a /\ v IN interval[a,b]) \/ u IN interval[a,b] /\ v IN interval[a,b] \/ u IN interval[a,b] /\ drop b <= drop v \/ drop b <= drop u /\ drop b <= drop v` MP_TAC THENL [REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `!a:real^N. dist(u,a) < e / &2 /\ dist(v,a) < e / &2 ==> dist(u,v) < e`) THEN EXISTS_TAC `(f:real^1->real^N) a` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `v:real^1`]) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; DIST_REAL; GSYM drop; INTERVAL_NE_EMPTY_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL [MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x < e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[DIST_REAL; GSYM drop] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[DIST_REAL; GSYM drop]; STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `!a:real^N. dist(u,a) < e / &2 /\ dist(v,a) < e / &2 ==> dist(u,v) < e`) THEN EXISTS_TAC `(f:real^1->real^N) b` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`b:real^1`; `u:real^1`]) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; DIST_REAL; GSYM drop; INTERVAL_NE_EMPTY_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]);; let HAS_BOUNDED_VARIATION_ON_DARBOUX_IMP_CONTINUOUS = prove (`!f:real^1->real^N s. is_interval s /\ f has_bounded_variation_on s /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) ==> f continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DARBOUX_AND_REGULATED_IMP_CONTINUOUS THEN ASM_REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_LEFT_LIMIT_GEN; HAS_BOUNDED_VARIATION_RIGHT_LIMIT_GEN]);; let VECTOR_VARIATION_ON_INTERIOR = prove (`!f:real^1->real^N s. is_interval s /\ f has_bounded_variation_on (interior s) /\ f continuous_on s ==> vector_variation (interior s) f = vector_variation s f`, let lemma1 = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] /\ f continuous_on interval[a,b] ==> vector_variation (interval[a,b] DELETE b) f = vector_variation(interval[a,b]) f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[EMPTY_DELETE] THEN MP_TAC(ISPECL [`\x. lift(vector_variation (interval[a,x]) (f:real^1->real^N))`; `interval[a:real^1,b] DELETE b`; `{x | drop x <= vector_variation (interval[a,b] DELETE b) (f:real^1->real^N)}`] FORALL_IN_CLOSURE) THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[CONTINUOUS_ON_VECTOR_VARIATION] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN SET_TAC[]; REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN CONJ_TAC THENL [ASM_MESON_TAC[DELETE_SUBSET; HAS_BOUNDED_VARIATION_ON_SUBSET]; REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC]]; DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN MP_TAC (ISPEC `interval[a:real^1,b]` CONNECTED_LIMIT_POINTS_EQ_CLOSURE) THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN MATCH_MP_TAC(SET_RULE `b IN s /\ (s = {b} ==> Q) /\ (P ==> Q) ==> (~(?a. s = {a}) ==> P) ==> Q`) THEN ASM_SIMP_TAC[ENDS_IN_INTERVAL; SET_RULE `{a} DELETE a = {}`] THEN REWRITE_TAC[VECTOR_VARIATION_SING; VECTOR_VARIATION_ON_EMPTY] THEN SIMP_TAC[CLOSURE_INTERVAL; EXTENSION; IN_ELIM_THM; IN_CLOSURE_DELETE] THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM] THEN DISCH_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM SET_TAC[]]) in let lemma2 = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] /\ f continuous_on interval[a,b] ==> vector_variation (interval[a,b] DELETE a) f = vector_variation(interval[a,b]) f`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_VARIATION_REFLECT2] THEN SIMP_TAC[IMAGE_DELETE_INJ; VECTOR_EQ_NEG2; REFLECT_INTERVAL] THEN MATCH_MP_TAC lemma1 THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL; VECTOR_NEG_NEG] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[REFLECT_INTERVAL; VECTOR_NEG_NEG] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN SIMP_TAC[CONTINUOUS_ON_NEG; CONTINUOUS_ON_ID]) in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ] THEN STRIP_TAC THEN ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[INTERIOR_EMPTY] THEN ASM_CASES_TAC `interior s:real^1->bool = {}` THENL [MP_TAC(ISPEC `s:real^1->bool` AFF_DIM_NONEMPTY_INTERIOR_EQ) THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1] THEN DISCH_THEN(MP_TAC o MATCH_MP (INT_ARITH `~(s:int = d) ==> ~(s = -- &1) /\ --(&1) <= s /\ s <= d /\ d = &1 ==> s = &0`)) THEN REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_LE_UNIV; AFF_DIM_GE] THEN ASM_REWRITE_TAC[DIMINDEX_1; AFF_DIM_EQ_0] THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_VARIATION_SING; VECTOR_VARIATION_ON_EMPTY]; UNDISCH_TAC `~(interior s:real^1->bool = {})`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN MP_TAC(ISPEC `f:real^1->real^N` VECTOR_VARIATION_SPLIT) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `drop a`) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `interior s:real^1->bool` th) THEN MP_TAC(SPEC `s:real^1->bool` th)) THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ; IS_INTERVAL_INTERIOR] THEN REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN BINOP_TAC THEN MATCH_MP_TAC(MESON[] `(~(s = t) ==> vector_variation s f = vector_variation t f) ==> vector_variation s f = vector_variation t f`) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~({x | x IN i /\ P x} = {x | x IN s /\ P x}) ==> i SUBSET s ==> ?b. b IN s /\ P b /\ ~(b IN i)`)) THEN REWRITE_TAC[INTERIOR_SUBSET; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^1` THEN ASM_CASES_TAC `b:real^1 = a` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_LE_LT] THEN ASM_REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL [SUBGOAL_THEN `{x | x IN interior s /\ drop x <= drop a} = interval[b,a] DELETE b /\ {x | x IN s /\ drop x <= drop a} = interval[b,a]` STRIP_ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma2 THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))] THEN ASM SET_TAC[]]; SUBGOAL_THEN `{x | x IN interior s /\ drop a <= drop x} = interval[a,b] DELETE b /\ {x | x IN s /\ drop a <= drop x} = interval[a,b]` STRIP_ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma1 THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))] THEN ASM SET_TAC[]]] THEN MATCH_MP_TAC(SET_RULE `b IN s /\ ~(b IN si) /\ si SUBSET s /\ s SUBSET i /\ i DELETE b SUBSET si ==> si = i DELETE b /\ s = i`) THEN ASM_SIMP_TAC[IN_ELIM_THM; SUBSET; REAL_LT_IMP_LE; IN_INTERVAL_1; IN_DELETE; REWRITE_RULE[SUBSET] INTERIOR_SUBSET] THEN REWRITE_TAC[GSYM DROP_EQ; REAL_ARITH `((b <= x /\ x <= a) /\ ~(x = b) <=> b < x /\ x <= a) /\ ((a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b)`] THEN (CONJ_TAC THEN X_GEN_TAC `c:real^1` THEN STRIP_TAC THENL [REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN UNDISCH_TAC `~((b:real^1) IN interior s)` THEN REWRITE_TAC[]; ASM_CASES_TAC `c:real^1 = a` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ])] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] IN_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN EXISTS_TAC `a:real^1` THENL [EXISTS_TAC `c:real^1`; EXISTS_TAC `b:real^1`] THEN ASM_SIMP_TAC[CLOSURE_INC; GSYM IS_INTERVAL_CONVEX_1] THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC));; let VECTOR_VARIATION_ON_CLOSURE = prove (`!f:real^1->real^N s. is_interval s /\ f has_bounded_variation_on s /\ f continuous_on closure s ==> vector_variation (closure s) f = vector_variation s f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `closure s:real^1->bool`] VECTOR_VARIATION_ON_INTERIOR) THEN ASM_SIMP_TAC[IS_INTERVAL_CLOSURE; HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ; HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ] THEN ASM_SIMP_TAC[CONVEX_INTERIOR_CLOSURE; GSYM IS_INTERVAL_CONVEX_1] THEN MATCH_MP_TAC(REAL_ARITH `s <= c /\ i <= s ==> i = c ==> c = s`) THEN CONJ_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_SIMP_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET; HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ]);; (* ------------------------------------------------------------------------- *) (* We can factor a BV function through its variation. Moreover the *) (* factor is Lipschitz and continuous on its domain, though without *) (* continuity of the original function that domain may not be an interval. *) (* ------------------------------------------------------------------------- *) let FACTOR_THROUGH_VARIATION = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> ?g. (!x. x IN interval[a,b] ==> f(x) = g(lift(vector_variation(interval[a,x]) f))) /\ g continuous_on { lift(vector_variation(interval[a,u]) f) |u| u IN interval[a,b]} /\ (!x y. x IN { lift(vector_variation(interval[a,u]) f) |u| u IN interval[a,b]} /\ y IN { lift(vector_variation(interval[a,u]) f) |u| u IN interval[a,b]} ==> dist(g x,g y) <= dist(x,y))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(?x. P x) /\ (!x. R x ==> Q x) /\ (!x. P x ==> R x) ==> ?x. P x /\ Q x /\ R x`) THEN REPEAT CONJ_TAC THENL [ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN REWRITE_TAC[GSYM FUNCTION_FACTORS_LEFT_GEN] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `y:real^1`; `x:real^1`] VECTOR_VARIATION_COMBINE) THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[LIFT_EQ; GSYM LIFT_ADD; REAL_ARITH `a = a + b <=> b = &0`] THEN W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_CONST_EQ o lhand o snd) THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(MESON[] `P x /\ P y ==> (?c. !x. P x ==> f x = c) ==> f x = f y`) THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; REAL_LE_REFL]]] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPECL [`g:real^1->real^N`; `\x:real^1. x`] CONTINUOUS_ON_COMPARISON) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID]; X_GEN_TAC `g:real^1->real^N` THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REWRITE_TAC[DIST_LIFT; FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[DIST_SYM; CONJ_ACI; REAL_ABS_SUB]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `y:real^1`; `x:real^1`] VECTOR_VARIATION_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `a <= d ==> a <= abs(x - (x + d))`) THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[SEGMENT_1; SUBSET_REFL]] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL]]);; let FACTOR_CONTINUOUS_THROUGH_VARIATION = prove (`!f:real^1->real^N a b l. drop a <= drop b /\ f continuous_on interval[a,b] /\ f has_bounded_variation_on interval[a,b] /\ vector_variation(interval[a,b]) f = drop l ==> ?g. (!x. x IN interval[a,b] ==> f(x) = g(lift(vector_variation(interval[a,x]) f))) /\ g continuous_on interval[vec 0,l] /\ (!u v. u IN interval[vec 0,l] /\ v IN interval[vec 0,l] ==> dist(g u,g v) <= dist(u,v)) /\ g has_bounded_variation_on interval[vec 0,l] /\ IMAGE (\x. lift(vector_variation(interval[a,x]) f)) (interval[a,b]) = interval[vec 0,l] /\ IMAGE g (interval[vec 0,l]) = IMAGE f (interval[a,b]) /\ (!x. x IN interval[vec 0,l] ==> vector_variation (interval[vec 0,x]) g = drop x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACTOR_THROUGH_VARIATION) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `IMAGE (\x. f x) s = {f x | x IN s}`] THEN SUBGOAL_THEN `{ lift(vector_variation (interval[a,u]) (f:real^1->real^N)) | u | u IN interval [a,b]} = interval[vec 0,l]` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN ASM_REWRITE_TAC[th] THEN ASSUME_TAC th) THENL [REWRITE_TAC[SIMPLE_IMAGE] THEN W(MP_TAC o PART_MATCH (lhs o rand) CONTINUOUS_INCREASING_IMAGE_INTERVAL_1 o lhand o snd) THEN ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; LIFT_DROP] THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_ON_VECTOR_VARIATION] THEN REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL]; DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN MATCH_MP_TAC VECTOR_VARIATION_ON_NULL THEN REWRITE_TAC[BOUNDED_INTERVAL; CONTENT_EQ_0_1; REAL_LE_REFL]]; MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[BOUNDED_INTERVAL; REAL_MUL_LID; GSYM dist]; DISCH_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN CONJ_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `vector_variation(interval[a,u]) ((g:real^1->real^N) o (\x. lift(vector_variation(interval[a,x]) (f:real^1->real^N))))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN X_GEN_TAC `v:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; o_DEF] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_COMPOSE_INCREASING o lhand o snd) THEN SIMP_TAC[VECTOR_VARIATION_ON_NULL; BOUNDED_INTERVAL; LIFT_DROP; CONTENT_EQ_0_1; REAL_LE_REFL; LIFT_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL; LIFT_DROP] THEN DISJ2_TAC THEN REWRITE_TAC[DROP_VEC] THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th])]] THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC])]; X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `vector_variation (interval[vec 0,u]) (\x. x)` THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_COMPARISON THEN SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[VECTOR_VARIATION_ID; INTERVAL_EQ_EMPTY_1] THEN ASM_REWRITE_TAC[DROP_VEC; GSYM REAL_NOT_LE] THEN ASM_REAL_ARITH_TAC]]]);; (* ------------------------------------------------------------------------- *) (* The Helly selection theorem. *) (* ------------------------------------------------------------------------- *) let HELLY_SELECTION_INCREASING = prove (`!f:num->real^1->real^1 s k. is_interval s /\ (!n x. x IN s ==> norm(f n x) <= k) /\ (!n x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f n x) <= drop(f n y)) ==> ?r g. (!m n. m < n ==> r m < r n) /\ (!x. x IN s ==> ((\n. f (r n) x) --> g x) sequentially) /\ (!x. x IN s ==> norm(g x) <= k) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(g x) <= drop(g y))`, REPEAT STRIP_TAC THEN ABBREV_TAC `t = (s DIFF interior s) UNION s INTER {x:real^1 | !i. 1 <= i /\ i <= dimindex(:1) ==> rational(x$i)}` THEN SUBGOAL_THEN `COUNTABLE t /\ t SUBSET s /\ closure t = closure s /\ !x. x IN s ==> ?a. a IN t /\ drop a <= drop x` STRIP_ASSUME_TAC THENL [EXPAND_TAC "t" THEN REPEAT CONJ_TAC THENL [SIMP_TAC[COUNTABLE_UNION; COUNTABLE_INTER; COUNTABLE_RATIONAL_COORDINATES] THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `frontier s:real^1->bool` THEN ASM_SIMP_TAC[CARD_FRONTIER_INTERVAL_1] THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^1->bool` CLOSURE_SUBSET) THEN SET_TAC[]; SET_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `interior s:real^1->bool = {}` THENL [REWRITE_TAC[ASSUME `interior s:real^1->bool = {}`] THEN REWRITE_TAC[SUBSET_REFL; SET_RULE `(s DIFF {}) UNION s INTER t = s`]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^1->bool` CLOSURE_RATIONALS_IN_CONVEX_SET) THEN ANTS_TAC THENL [ASM_MESON_TAC[IS_INTERVAL_CONVEX_1]; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[IN_DIFF; IN_UNION; IN_INTER; IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^1) IN interior s` THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`drop x`; `e:real`] RATIONAL_APPROXIMATION_BELOW) THEN ASM_REWRITE_TAC[EXISTS_DROP; GSYM drop] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^1` THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_BALL; DIST_1] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MP_TAC(ISPECL [`f:num->real^1->real^1`; `t:real^1->bool`; `k:real`] FUNCTION_CONVERGENT_SUBSEQUENCE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN RULE_ASSUM_TAC(REWRITE_RULE[DIMINDEX_1; FORALL_1; GSYM drop]) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^1->real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `!x y. x IN t /\ y IN t /\ drop x <= drop y ==> drop((h:real^1->real^1) x) <= drop(h y)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN EXISTS_TAC `\n:num. (f:num->real^1->real^1) (r n) x` THEN EXISTS_TAC `\n:num. (f:num->real^1->real^1) (r n) y` THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; SEQUENTIALLY] THEN REWRITE_TAC[EVENTUALLY_TRUE]; ALL_TAC] THEN ABBREV_TAC `g = \x. lift(sup {drop(h a) | a IN t /\ drop a <= drop x})` THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop((g:real^1->real^1) x) <= drop(g y)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_ELIM_THM]] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN EXISTS_TAC `k:real` THEN X_GEN_TAC `a:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN EXISTS_TAC `\n:num. (f:num->real^1->real^1) (r n) a` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(drop x) <= norm x /\ norm x <= k ==> drop x <= k`) THEN REWRITE_TAC[drop; COMPONENT_LE_NORM] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN t ==> (h:real^1->real^1) x = g x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN ABBREV_TAC `d = {x | x IN s /\ ~((g:real^1->real^1) continuous at x)}` THEN SUBGOAL_THEN `COUNTABLE(d:real^1->bool)` ASSUME_TAC THENL [EXPAND_TAC "d" THEN MATCH_MP_TAC INCREASING_COUNTABLE_DISCONTINUITIES THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN s DIFF (d UNION frontier s) ==> ((\n. (f:num->real^1->real^1) (r n) x) --> g x) sequentially` ASSUME_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN EXPAND_TAC "d" THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION; DE_MORGAN_THM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[continuous_at; LIM_SEQUENTIALLY] THEN ASM_SIMP_TAC[frontier; IN_DIFF; CLOSURE_INC] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN REWRITE_TAC[SUBSET; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d2:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`drop x`; `min d1 d2:real`] RATIONAL_APPROXIMATION_STRADDLE) THEN ASM_REWRITE_TAC[REAL_LT_MIN; LEFT_IMP_EXISTS_THM; FORALL_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `(a:real^1) IN t /\ b IN t` STRIP_ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTER; IN_UNION; IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISJ2_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL; DIST_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `((\n:num. (f:num->real^1->real^1) (r n) a) --> g a) sequentially /\ ((\n:num. (f:num->real^1->real^1) (r n) b) --> g b) sequentially` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[tendsto; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN SUBGOAL_THEN `dist((g:real^1->real^1) a,g x) < e / &2 /\ dist((g:real^1->real^1) b,g x) < e / &2` MP_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[DIST_1] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[DIST_1]] THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`(r:num->num) n`; `a:real^1`; `x:real^1`] th) THEN MP_TAC(ISPECL [`(r:num->num) n`; `x:real^1`; `b:real^1`] th)) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\n:num x. (f:num->real^1->real^1) (r n) x`; `s INTER (d UNION frontier s):real^1->bool`; `k:real`] FUNCTION_CONVERGENT_SUBSEQUENCE) THEN ASM_SIMP_TAC[IN_INTER] THEN ANTS_TAC THENL [MATCH_MP_TAC COUNTABLE_INTER THEN DISJ2_TAC THEN ASM_REWRITE_TAC[COUNTABLE_UNION] THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; CARD_FRONTIER_INTERVAL_1]; DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN ASM_SIMP_TAC[o_THM] THEN SUBGOAL_THEN `!x. x IN s ==> ?l. ((\n. (f:num->real^1->real^1) (r((q:num->num) n)) x) --> l) sequentially` MP_TAC THENL [X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^1) IN d UNION frontier s` THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `?l. ((\n. (f:num->real^1->real^1) (r n) x) --> l) sequentially` MP_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `l:real^1` THEN DISCH_THEN(MP_TAC o SPEC `q:num->num` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE)) THEN ASM_REWRITE_TAC[o_DEF]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `ff:real^1->real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN X_GEN_TAC `x:real^1` THENL [DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. (f:num->real^1->real^1) (r((q:num->num) n)) x`; X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN MAP_EVERY EXISTS_TAC [`\n. (f:num->real^1->real^1) (r((q:num->num) n)) x`; `\n. (f:num->real^1->real^1) (r((q:num->num) n)) y`]] THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_TRUE]);; let HELLY_SELECTION_THEOREM = prove (`!f:num->real^1->real^N s c d. is_interval s /\ (!n. f n has_bounded_variation_on s) /\ (!n. vector_variation s (f n) <= c) /\ (!n x. x IN s ==> norm(f n x) <= d) ==> ?r g. (!m n. m < n ==> r m < r n) /\ (!x. x IN s ==> ((\n. f (r n) x) --> g x) sequentially) /\ g has_bounded_variation_on s /\ vector_variation s g <= c`, let lemma = prove (`!f:num->real^1->real^1 s c d. is_interval s /\ (!n. f n has_bounded_variation_on s) /\ (!n. vector_variation s (f n) <= c) /\ (!n x. x IN s ==> norm(f n x) <= d) ==> ?r g. (!m n. m < n ==> r m < r n) /\ (!x. x IN s ==> ((\n. f (r n) x) --> g x) sequentially)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. ?g h. (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(g x) <= drop(g y)) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(h x) <= drop(h y)) /\ (!x. x IN s ==> norm(g x) <= c) /\ (!x. x IN s ==> norm(h x) <= c + d) /\ (!x. (f:num->real^1->real^1) n x = g x - h x)` MP_TAC THENL [GEN_TAC THEN MAP_EVERY EXISTS_TAC [`\x. lift(vector_variation {a | a IN s /\ drop a <= drop x} ((f:num->real^1->real^1) n))`; `\x. lift(vector_variation {a | a IN s /\ drop a <= drop x} (f n)) - f (n:num) x`] THEN REWRITE_TAC[VECTOR_ARITH `a - (a - x):real^1 = x`] THEN REWRITE_TAC[LIFT_DROP; DROP_SUB] THEN MATCH_MP_TAC(TAUT `p /\ q /\ r /\ (r ==> s) ==> p /\ q /\ r /\ s`) THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET) o SPEC `n:num`) THEN REWRITE_TAC[SUBSET_RESTRICT]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_TRANS]]; MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_LEFT THEN ASM_REWRITE_TAC[]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `vector_variation s ((f:num->real^1->real^1) n)` THEN ASM_REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_POS_LE; MATCH_MP_TAC VECTOR_VARIATION_MONOTONE] THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET) o SPEC `n:num`) THEN REWRITE_TAC[SUBSET_RESTRICT]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^1` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(f:real^N) <= d ==> norm(v) <= c ==> norm(v - f) <= c + d`) THEN ASM_SIMP_TAC[]]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN MAP_EVERY X_GEN_TAC [`g:num->real^1->real^1`; `h:num->real^1->real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:num->real^1->real^1`; `s:real^1->bool`; `c:real`] HELLY_SELECTION_INCREASING) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`r:num->num`; `gg:real^1->real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n:num x. (h:num->real^1->real^1) (r n) x`; `s:real^1->bool`; `c + d:real`] HELLY_SELECTION_INCREASING) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q:num->num`; `hh:real^1->real^1`] THEN STRIP_TAC THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN EXISTS_TAC `\x. (gg:real^1->real^1) x - (hh:real^1->real^1) x` THEN ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `((\n:num. (g:num->real^1->real^1) (r n) x) --> gg x) sequentially` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `q:num->num` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE)) THEN ASM_REWRITE_TAC[o_DEF]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(!r g. P r g /\ Q r g ==> R r g /\ S r g) /\ (?r g. P r g /\ Q r g) ==> ?r g. P r g /\ Q r g /\ R r g /\ S r g`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_UNIFORM_LIM THEN EXISTS_TAC `\n:num. (f:num->real^1->real^N) (r n)` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. ?r g:real^1->real^N. (!m n:num. m < n ==> r m < r n) /\ (!x i. x IN s /\ 1 <= i /\ i <= n /\ i <= dimindex(:N) ==> ((\n. lift((f:num->real^1->real^N) (r n) x$i)) --> lift(g x$i)) sequentially)` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; GSYM LIM_COMPONENTWISE_LIFT]] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 /\ i <= n <=> F`] THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`k:num`; `r:num->num`; `g:real^1->real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) <= k` THENL [MAP_EVERY EXISTS_TAC [`r:num->num`; `g:real^1->real^N`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `~(n <= k) ==> SUC k <= n`))] THEN MP_TAC(SPECL [`\n:num x. lift((f:num->real^1->real^N) (r n) x$(SUC k))`; `s:real^1->bool`; `c:real`; `d:real`] lemma) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THEN X_GEN_TAC `n:num` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] o SPEC `(r:num->num) n`) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_COMPONENT_LE o lhand o snd) THEN ASM_REWRITE_TAC[ETA_AX]; REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LIFT] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd)] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`q:num->num`; `h:real^1->real^1`] THEN STRIP_TAC THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN EXISTS_TAC `(\x. lambda i. if i <= k then (g:real^1->real^N) x$i else drop(h x)):real^1->real^N` THEN ASM_SIMP_TAC[o_THM; LAMBDA_BETA] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `i:num`] THEN REWRITE_TAC[LE] THEN STRIP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `~(SUC k <= k)`; LIFT_DROP] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `i:num`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `q:num->num` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE)) THEN ASM_REWRITE_TAC[o_DEF]);; (* ------------------------------------------------------------------------- *) (* Differentiability properties of convex functions. *) (* ------------------------------------------------------------------------- *) let CONVEX_ON_RIGHT_DIFFERENTIABLE = prove (`!f s a. f convex_on s /\ a IN interior s ==> (lift o f) differentiable (at a within {x | drop a <= drop x})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(lift o f) differentiable (at a within interval(a,a + lift e) INTER {x | drop a <= drop x})` MP_TAC THEN REWRITE_TAC[VECTOR_DIFFERENTIABLE; HAS_VECTOR_DERIVATIVE_WITHIN_1D] THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_WITHIN_SET_IMP) THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTER; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; LIFT_DROP; GSYM DIST_NZ; GSYM DROP_EQ] THEN REWRITE_TAC[DIST_REAL; GSYM drop] THEN REAL_ARITH_TAC] THEN REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN MATCH_MP_TAC INCREASING_RIGHT_LIMIT_1_GEN THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN REWRITE_TAC[DROP_CMUL; o_DEF; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN EXISTS_TAC `(f a - f(a - lift e)) / norm(a - (a - lift e))` THEN SUBGOAL_THEN `f convex_on cball(a:real^1,e)` MP_TAC THENL [ASM_MESON_TAC[CONVEX_ON_SUBSET]; ALL_TAC] THEN DISCH_THEN(fun th -> CONJ_TAC THEN X_GEN_TAC `x:real^1` THEN MP_TAC th) THENL [SIMP_TAC[CONVEX_ON_MID_SECANT; IN_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a - lift e`; `x:real^1`; `a:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB; REAL_ARITH `a < x ==> abs(x - a) = x - a`] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_CBALL; SEGMENT_1; DROP_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_ARITH `a < x /\ &0 < e ==> a - e <= x`] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; LIFT_DROP; dist; NORM_1] THEN ASM_REAL_ARITH_TAC; SIMP_TAC[CONVEX_ON_LEFT_SECANT; IN_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN DISCH_TAC THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^1 = x` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `y:real^1`; `x:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB; REAL_ARITH `a < x ==> abs(x - a) = x - a`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN REWRITE_TAC[IN_CBALL; IN_INTERVAL_1; dist; NORM_1; DROP_SUB] THEN ASM_REAL_ARITH_TAC]);; let CONVEX_ON_LEFT_DIFFERENTIABLE = prove (`!f s a. f convex_on s /\ a IN interior s ==> (lift o f) differentiable (at a within {x | drop x <= drop a})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(lift o f) differentiable (at a within interval(a - lift e,a) INTER {x | drop x <= drop a})` MP_TAC THEN REWRITE_TAC[VECTOR_DIFFERENTIABLE; HAS_VECTOR_DERIVATIVE_WITHIN_1D] THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_WITHIN_SET_IMP) THEN REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTER; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_SUB; LIFT_DROP; GSYM DIST_NZ; GSYM DROP_EQ] THEN REWRITE_TAC[DIST_REAL; GSYM drop] THEN REAL_ARITH_TAC] THEN REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN MATCH_MP_TAC INCREASING_LEFT_LIMIT_1_GEN THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN REWRITE_TAC[DROP_CMUL; o_DEF; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN EXISTS_TAC `(f(a + lift e) - f a) / norm((a + lift e) - a)` THEN SUBGOAL_THEN `f convex_on cball(a:real^1,e)` MP_TAC THENL [ASM_MESON_TAC[CONVEX_ON_SUBSET]; ALL_TAC] THEN DISCH_THEN(fun th -> CONJ_TAC THEN X_GEN_TAC `x:real^1` THEN MP_TAC th) THENL [SIMP_TAC[CONVEX_ON_MID_SECANT; IN_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `a + lift e`; `a:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB; REAL_ARITH `x < a ==> abs(a - x) = --(x - a)`] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REWRITE_TAC[REAL_ARITH `(x - y) * --inv z:real = (y - x) / z`] THEN REWRITE_TAC[GSYM real_div] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_CBALL; SEGMENT_1; DROP_ADD; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_ARITH `x < a /\ &0 < e ==> x <= a + e`] THEN SIMP_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; LIFT_DROP; dist; NORM_1] THEN ASM_REAL_ARITH_TAC; SIMP_TAC[CONVEX_ON_LEFT_SECANT; IN_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN DISCH_TAC THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^1 = x` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `x:real^1`; `y:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB; REAL_ARITH `x < a ==> abs(x - a) = --(x - a)`] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN ASM_REWRITE_TAC[SEGMENT_1; GSYM REAL_NOT_LT] THEN REWRITE_TAC[IN_CBALL; IN_INTERVAL_1; dist; NORM_1; DROP_SUB] THEN ASM_REAL_ARITH_TAC]);; let CONVEX_ON_DIRECTIONAL_DERIVATIVES = prove (`!f s a. f convex_on s /\ a IN interior s ==> ?l r. ((lift o f) has_vector_derivative l) (at a within {x | drop x <= drop a}) /\ ((lift o f) has_vector_derivative r) (at a within {x | drop a <= drop x}) /\ drop l <= drop r`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real`; `s:real^1->bool`; `a:real^1`] CONVEX_ON_RIGHT_DIFFERENTIABLE) THEN MP_TAC(ISPECL [`f:real^1->real`; `s:real^1->bool`; `a:real^1`] CONVEX_ON_LEFT_DIFFERENTIABLE) THEN ASM_REWRITE_TAC[VECTOR_DIFFERENTIABLE; IMP_IMP] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^1` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^1` THEN SIMP_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_1D] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE [TAUT `p /\ q /\ r /\ s /\ t ==> u <=> (p /\ q) /\ t ==> r /\ s ==> u`] LIMIT_PAIR_DROP_LE) THEN CONJ_TAC THENL [REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [EXISTS_TAC `a - lift(e / &2)`; EXISTS_TAC `a + lift(e / &2)`] THEN REWRITE_TAC[DIST_1; DROP_SUB; DROP_ADD; LIFT_DROP; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP EVENTUALLY_WITHIN_INTERIOR_INTER th)]) THEN GEN_REWRITE_TAC I [EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP EVENTUALLY_WITHIN_INTERIOR_INTER th)]) THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN REWRITE_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; o_DEF] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ON_MID_SECANT]) THEN DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`; `a:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; IN_DIFF; IN_INSERT] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; NOT_IN_EMPTY] THEN ASM_MESON_TAC[REAL_LT_REFL; DIST_REFL]; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_ARITH `(a - u) / e:real = (u - a) * --inv e`] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN REWRITE_TAC[real_div; GSYM REAL_INV_NEG] THEN REPEAT AP_TERM_TAC THEN ASM_REAL_ARITH_TAC]]);; let CONVEX_ON_DIRECTIONAL_DERIVATIVE_FUNCTIONS = prove (`!f s. f convex_on s /\ is_interval s /\ open s ==> ?l r. (!x. x IN s ==> ((lift o f) has_vector_derivative l(x)) (at x within {t | drop t <= drop x})) /\ (!x. x IN s ==> ((lift o f) has_vector_derivative r(x)) (at x within {t | drop x <= drop t})) /\ (!x. x IN s ==> drop(l x) <= drop(r x)) /\ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> drop(r x) <= drop(l y))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real`; `s:real^1->bool`] CONVEX_ON_DIRECTIONAL_DERIVATIVES) THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^1->real^1` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^1->real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `(f y - f x) / norm(y - x:real^1)` THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)); REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1`))] THEN ASM_REWRITE_TAC[VECTOR_DIFFERENTIABLE; HAS_VECTOR_DERIVATIVE_WITHIN_1D] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] LIM_DROP_UBOUND)) THEN SUBGOAL_THEN `(x:real^1) IN interior s` MP_TAC THENL [ASM_MESON_TAC[INTERIOR_OPEN]; ALL_TAC]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] LIM_DROP_LBOUND)) THEN SUBGOAL_THEN `(y:real^1) IN interior s` MP_TAC THENL [ASM_MESON_TAC[INTERIOR_OPEN]; ALL_TAC]] THEN REWRITE_TAC[NON_TRIVIAL_LIMIT_LEFT; NON_TRIVIAL_LIMIT_RIGHT] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP EVENTUALLY_WITHIN_INTERIOR_INTER th)]) THEN REWRITE_TAC[EVENTUALLY_WITHIN; IN_INTER; IN_ELIM_THM; DROP_CMUL] THEN EXISTS_TAC `drop y - drop x` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[o_DEF; DROP_SUB; LIFT_DROP] THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[GSYM DIST_NZ; GSYM DROP_EQ] THEN STRIP_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ON_LEFT_SECANT]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`; `z:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB; real_abs; REAL_LT_IMP_LE; REAL_SUB_LE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_1]) THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ON_RIGHT_SECANT]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`; `z:real^1`]) THEN ASM_SIMP_TAC[NORM_1; DROP_SUB] THEN ANTS_TAC THENL [ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_1]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[real_abs; REAL_SUB_LE] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_NEG_SUB] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REAL_ARITH_TAC]]);; let CONVEX_ON_COUNTABLE_NONDIFFERENTIABLE = prove (`!f s. f convex_on s /\ COUNTABLE(components s) ==> COUNTABLE {x:real^1 | x IN s /\ ~((lift o f) differentiable at x)}`, REPEAT STRIP_TAC THEN SUBST1_TAC(ISPEC `s:real^1->bool` UNIONS_COMPONENTS) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `UNIONS {{x:real^1 | x IN c /\ ~((lift o f) differentiable at x)} | c IN components s}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]] THEN MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^1->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `(f:real^1->real) convex_on c /\ connected c` MP_TAC THENL [ASM_MESON_TAC[CONVEX_ON_SUBSET; IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]; REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `frontier c UNION {x:real^1 | x IN interior c /\ ~((lift o f) differentiable at x)}` THEN CONJ_TAC THENL [ASM_SIMP_TAC[COUNTABLE_UNION; FINITE_IMP_COUNTABLE; CARD_FRONTIER_INTERVAL_1] THEN SUBGOAL_THEN `is_interval(interior c:real^1->bool)` MP_TAC THENL [ASM_MESON_TAC[IS_INTERVAL_CONVEX_1; CONVEX_INTERIOR]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^1->real) convex_on interior c` MP_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; CONVEX_ON_SUBSET]; MP_TAC(ISPEC `c:real^1->bool` OPEN_INTERIOR)] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`interior c:real^1->bool`,`c:real^1->bool`); REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `c:real^1->bool` CLOSURE_SUBSET) THEN SET_TAC[]] THEN X_GEN_TAC `s:real^1->bool` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real`; `s:real^1->bool`] CONVEX_ON_DIRECTIONAL_DERIVATIVE_FUNCTIONS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^1->real^1`; `r:real^1->real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `{x:real^1 | x IN s /\ drop(l x) < drop(r x)}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN REWRITE_TAC[CONTRAPOS_THM; VECTOR_DIFFERENTIABLE] THEN DISCH_TAC THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_AT_1D] THEN EXISTS_TAC `(r:real^1->real^1) x` THEN ONCE_REWRITE_TAC[TWO_SIDED_LIMIT_AT] THEN REWRITE_TAC[GSYM HAS_VECTOR_DERIVATIVE_WITHIN_1D] THEN ASM_SIMP_TAC[ETA_AX] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[]] THEN MP_TAC(ISPECL [`\x. interval((l:real^1->real^1) x,r x)`; `{x:real^1 | x IN s /\ drop (l x) < drop (r x)}`] COUNTABLE_IMAGE_INJ_EQ) THEN SIMP_TAC[EQ_INTERVAL; INTERVAL_EQ_EMPTY_1; IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC COUNTABLE_DISJOINT_OPEN_SUBSETS THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_INTERVAL] THEN REWRITE_TAC[PAIRWISE_IMAGE] THEN REWRITE_TAC[pairwise; IN_ELIM_THM] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; DISJOINT; DISJOINT_INTERVAL_1] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Convex functions R^1->R^1 are indefinite integrals of increasing ones. *) (* ------------------------------------------------------------------------- *) let CONVEX_ON_INDEFINITE_INTEGRAL_INCREASING = prove (`!f a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> (\x. drop(integral (interval[a,x]) f)) convex_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MIDPOINT_CONVEX THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONVEX_INTERVAL] THEN ASM_SIMP_TAC[INTEGRABLE_INCREASING_1; INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[REAL_ADD_SYM; MIDPOINT_SYM]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `integral(interval[midpoint(x,y),y]) (f:real^1->real^1)`; `interval[midpoint(x:real^1,y),y:real^1]`; `&1`; `inv(&2) % (y - x):real^1`] HAS_INTEGRAL_AFFINITY) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL; DIMINDEX_1; REAL_POW_ONE; IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN ASM_SIMP_TAC[DROP_MIDPOINT; REAL_ARITH `x <= y ==> ~(y < (x + y) / &2)`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`] INTEGRAL_COMBINE) THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`y:real^1`; `x:real^1`] th) THEN MP_TAC(ISPECL [`midpoint(x:real^1,y)`; `x:real^1`] th)) THEN MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `y:real^1`; `midpoint(x:real^1,y)`] INTEGRAL_COMBINE) THEN ASM_SIMP_TAC[DROP_MIDPOINT; REAL_ARITH `x <= (x + y) / &2 <=> x <= y`; REAL_ARITH `(x + y) / &2 <= y <=> x <= y`] THEN REPEAT(ANTS_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[INTEGRABLE_INCREASING_1; SUBSET_INTERVAL_1; DROP_MIDPOINT; INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT] THEN ASM_REAL_ARITH_TAC; TRY(DISCH_THEN(SUBST1_TAC o SYM))]) THEN REWRITE_TAC[DROP_ADD; VECTOR_MUL_LID; REAL_ARITH `a + x <= (a + a + x + y) / &2 <=> x <= y`] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN SUBGOAL_THEN `interval[midpoint(x,y) + --(&1 / &2 % (y - x)),y + --(&1 / &2 % (y - x))] = interval[x:real^1,midpoint(x,y)]` SUBST1_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ; CONS_11] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_MIDPOINT; DROP_NEG; DROP_SUB] THEN REAL_ARITH_TAC; DISCH_TAC] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[INTEGRABLE_INCREASING_1; SUBSET_INTERVAL_1; DROP_MIDPOINT; INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_MIDPOINT] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC]);; let CONVEX_ON_IS_INDEFINITE_INTEGRAL = prove (`!f s. (drop o f) convex_on s /\ is_interval s /\ open s ==> ?f'. (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f' x) <= drop(f' y)) /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> (f' has_integral (f y - f x)) (interval[x,y]))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MP_TAC(ISPECL [`(drop o f):real^1->real`; `s:real^1->bool`] CONVEX_ON_DIRECTIONAL_DERIVATIVE_FUNCTIONS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_DEF; LIFT_DROP; ETA_AX] THEN MAP_EVERY X_GEN_TAC [`l:real^1->real^1`; `r:real^1->real^1`] THEN STRIP_TAC THEN EXISTS_TAC `l:real^1->real^1` THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_LT; DROP_EQ]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN MP_TAC(ISPECL [`(drop o f):real^1->real`; `s:real^1->bool`] CONVEX_ON_COUNTABLE_NONDIFFERENTIABLE) THEN SUBGOAL_THEN `components(s:real^1->bool) = {s}` SUBST1_TAC THENL [ASM_REWRITE_TAC[COMPONENTS_EQ_SING; GSYM IS_INTERVAL_CONNECTED_1]; ASM_REWRITE_TAC[COUNTABLE_SING; o_DEF; LIFT_DROP; ETA_AX]] THEN DISCH_TAC THEN EXISTS_TAC `a INSERT b INSERT {x | x IN s /\ ~((f:real^1->real^1) differentiable at x)}` THEN ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^1->bool` THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN MP_TAC(ISPECL [`(drop o f):real^1->real`; `s:real^1->bool`] CONVEX_ON_CONTINUOUS) THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INSERT; IN_ELIM_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `(x:real^1) IN s` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL]; ASM_REWRITE_TAC[] THEN STRIP_TAC] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN FIRST_X_ASSUM(X_CHOOSE_TAC `l':real^1` o GEN_REWRITE_RULE I [VECTOR_DIFFERENTIABLE]) THEN SUBGOAL_THEN `(l:real^1->real^1) x = l'` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^1`; `a:real^1`; `x:real^1`; `x:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; GSYM DROP_EQ]) THEN ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_AT_WITHIN] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `{t | drop t <= drop x}` THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Absolute continuity, first a "set function" form. *) (* ------------------------------------------------------------------------- *) parse_as_infix("absolutely_setcontinuous_on",(12,"right"));; let absolutely_setcontinuous_on = new_definition `(f:(real^M->bool)->real^N) absolutely_setcontinuous_on s <=> !e. &0 < e ==> ?r. &0 < r /\ !d t. d division_of t /\ t SUBSET s /\ sum d content < r ==> sum d (\k. norm(f k)) < e`;; let ABSOLUTELY_SETCONTINUOUS_COMPARISON = prove (`!f:(real^M->bool)->real^N g:(real^M->bool)->real^P s. f absolutely_setcontinuous_on s /\ (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s ==> norm(g(interval[a,b])) <= norm(f(interval[a,b]))) ==> g absolutely_setcontinuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN FIRST_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]);; let ABSOLUTELY_SETCONTINUOUS_ON_EQ = prove (`!f g:(real^M->bool)->real^N s. (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s ==> f(interval[a,b]) = g(interval[a,b])) /\ f absolutely_setcontinuous_on s ==> g absolutely_setcontinuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_SETCONTINUOUS_COMPARISON) THEN ASM_SIMP_TAC[REAL_LE_REFL]);; let ABSOLUTELY_SETCONTINUOUS_ON_COMPONENTWISE = prove (`!f:(real^M->bool)->real^N s. f absolutely_setcontinuous_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\k. lift(f k$i)) absolutely_setcontinuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_setcontinuous_on; NORM_LIFT] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[COMPONENT_LE_NORM] THEN ASM_MESON_TAC[division_of]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_LT_DIV; LE_1; DIMINDEX_GE_1] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:num->real` THEN DISCH_TAC THEN EXISTS_TAC `inf (IMAGE B (1..dimindex(:N)))` THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `d:(real^M->bool)->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN TRANS_TAC REAL_LET_TRANS `sum (d:(real^M->bool)->bool) (\k. sum (1..dimindex (:N)) (\i. abs(((f:(real^M->bool)->real^N) k)$i)))` THEN ASM_SIMP_TAC[SUM_LE; NORM_LE_L1] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN ASM_MESON_TAC[]]);; let ABSOLUTELY_SETCONTINUOUS_ON_ALT = prove (`!f:(real^M->bool)->real^N s. f absolutely_setcontinuous_on s <=> !e. &0 < e ==> ?r. &0 < r /\ !d t. d division_of t /\ t SUBSET s /\ sum d content < r ==> norm(vsum d f) < e`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[absolutely_setcontinuous_on] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN MATCH_MP_TAC VSUM_NORM THEN ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[ABSOLUTELY_SETCONTINUOUS_ON_COMPONENTWISE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `d = {k | k IN d /\ &0 <= (f:(real^M->bool)->real^N) k$i} UNION {k | k IN d /\ (f:(real^M->bool)->real^N) k$i < &0}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[REAL_LET_TOTAL]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_UNION o lhand o snd) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN ANTS_TAC THENL [REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN SIMP_TAC[NORM_LIFT; real_abs; GSYM REAL_NOT_LE] THEN REWRITE_TAC[REAL_NOT_LE] THEN ASM_SIMP_TAC[GSYM VSUM_COMPONENT; GSYM VECTOR_NEG_COMPONENT] THEN CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x < a ==> x < a`) THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN ASM_SIMP_TAC[VSUM_NEG; FINITE_RESTRICT; NORM_NEG] THEN FIRST_X_ASSUM(MATCH_MP_TAC o SPECL [`d:(real^M->bool)->bool`; `UNIONS d:real^M->bool`]) THEN (REPEAT CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET THEN EXISTS_TAC `d:(real^M->bool)->bool` THEN REWRITE_TAC[SUBSET_RESTRICT] THEN ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; MATCH_MP_TAC(SET_RULE `UNIONS d SUBSET s ==> UNIONS {x | x IN d /\ P x} SUBSET s`) THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_REWRITE_TAC[]; TRANS_TAC REAL_LET_TRANS `sum (d:(real^M->bool)->bool) content` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[SUBSET_RESTRICT; IN_DIFF; IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN REWRITE_TAC[CONTENT_POS_LE]]));; let ABSOLUTELY_SETCONTINUOUS_ON_LIFT_ABS = prove (`!f:(real^N->bool)->real s. (\x. lift(abs(f x))) absolutely_setcontinuous_on s <=> (\x. lift(f x)) absolutely_setcontinuous_on s`, REWRITE_TAC[absolutely_setcontinuous_on] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_ABS]);; let ABSOLUTELY_SETCONTINUOUS_ON_SUBSET = prove (`!f:(real^M->bool)->real^N s t. f absolutely_setcontinuous_on s /\ t SUBSET s ==> f absolutely_setcontinuous_on t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN ASM_MESON_TAC[SUBSET_TRANS]);; let ABSOLUTELY_SETCONTINUOUS_ON_NORM = prove (`!f:(real^M->bool)->real^N s. (\x. lift(norm(f x))) absolutely_setcontinuous_on s <=> f absolutely_setcontinuous_on s`, REWRITE_TAC[absolutely_setcontinuous_on; NORM_REAL; GSYM drop] THEN REWRITE_TAC[REAL_ABS_NORM; LIFT_DROP]);; let ABSOLUTELY_SETCONTINUOUS_ON_COMPOSE_LINEAR = prove (`!f:(real^M->bool)->real^N g:real^N->real^P s. f absolutely_setcontinuous_on s /\ linear g ==> (g o f) absolutely_setcontinuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM SUM_RMUL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[division_of; REAL_MUL_SYM]);; let ABSOLUTELY_SETCONTINUOUS_ON_0 = prove (`!s:real^N->bool. (\x. vec 0) absolutely_setcontinuous_on s`, REWRITE_TAC[absolutely_setcontinuous_on; NORM_0; SUM_0] THEN MESON_TAC[REAL_LE_REFL]);; let ABSOLUTELY_SETCONTINUOUS_ON_CMUL = prove (`!f:(real^M->bool)->real^N c s. f absolutely_setcontinuous_on s ==> (\x. c % f x) absolutely_setcontinuous_on s`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; o_DEF] ABSOLUTELY_SETCONTINUOUS_ON_COMPOSE_LINEAR) THEN REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);; let ABSOLUTELY_SETCONTINUOUS_ON_NEG = prove (`!f:(real^M->bool)->real^N s. (\x. --(f x)) absolutely_setcontinuous_on s <=> f absolutely_setcontinuous_on s`, REWRITE_TAC[absolutely_setcontinuous_on; NORM_NEG]);; let ABSOLUTELY_SETCONTINUOUS_ON_ADD = prove (`!f:(real^M->bool)->real^N g s. f absolutely_setcontinuous_on s /\ g absolutely_setcontinuous_on s ==> (\x. f x + g x) absolutely_setcontinuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min B C:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum d (\k. norm((f:(real^M->bool)->real^N) k)) + sum d (\k. norm((g:(real^M->bool)->real^N) k))` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[NORM_TRIANGLE]; ASM_MESON_TAC[REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`]]);; let ABSOLUTELY_SETCONTINUOUS_ON_SUB = prove (`!f:(real^M->bool)->real^N g s. f absolutely_setcontinuous_on s /\ g absolutely_setcontinuous_on s ==> (\x. f x - g x) absolutely_setcontinuous_on s`, REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --y`] THEN SIMP_TAC[ABSOLUTELY_SETCONTINUOUS_ON_ADD; ABSOLUTELY_SETCONTINUOUS_ON_NEG]);; let ABSOLUTELY_SETCONTINUOUS_ON_NULL = prove (`!f:(real^M->bool)->real^N s. (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s /\ content(interval[a,b]) = &0 ==> f(interval[a,b]) = vec 0) /\ content s = &0 /\ bounded s ==> f absolutely_setcontinuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_SETCONTINUOUS_COMPARISON THEN EXISTS_TAC `(\x. vec 0):(real^M->bool)->real^N` THEN REWRITE_TAC[ABSOLUTELY_SETCONTINUOUS_ON_0; NORM_ARITH `norm(x:real^N) <= norm(vec 0:real^M) <=> x = vec 0`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]);; let ABSOLUTELY_SETCONTINUOUS_ON_VSUM = prove (`!f:A->(real^M->bool)->real^N s k. FINITE k /\ (!i. i IN k ==> f i absolutely_setcontinuous_on s) ==> (\x. vsum k (\i. f i x)) absolutely_setcontinuous_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FORALL_IN_INSERT] THEN SIMP_TAC[SET_VARIATION_0; REAL_LE_REFL; ABSOLUTELY_SETCONTINUOUS_ON_0; ABSOLUTELY_SETCONTINUOUS_ON_ADD; ETA_AX] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) SET_VARIATION_TRIANGLE o lhand o snd) THEN ASM_SIMP_TAC[ETA_AX] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LADD]);; let ABSOLUTELY_SETCONTINUOUS_ON_MUL = prove (`!f g:(real^M->bool)->real^N s. f absolutely_setcontinuous_on s /\ g absolutely_setcontinuous_on s ==> (\x. drop(f x) % g x) absolutely_setcontinuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &2`) (MP_TAC o SPEC `&2`)) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r1:real` THEN STRIP_TAC THEN X_GEN_TAC `r2:real` THEN STRIP_TAC THEN EXISTS_TAC `min r1 r2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`d:(real^M->bool)->bool`; `t:real^M->bool`])) THEN ASM_REWRITE_TAC[NORM_MUL; GSYM NORM_1; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `p /\ q /\ r /\ s ==> t <=> s /\ q ==> p /\ r ==> t`] REAL_LT_MUL2)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[SUM_POS_LE; NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `y <= x ==> x < e / &2 * &2 ==> y < e`) THEN MATCH_MP_TAC SUM_MUL_BOUND THEN ASM_REWRITE_TAC[NORM_POS_LE]);; let OPERATIVE_ABSOLUTELY_SETCONTINUOUS_ON = prove (`!f:(real^M->bool)->real^N. operative (+) f ==> operative (/\) ((absolutely_setcontinuous_on) f)`, REWRITE_TAC[operative; NEUTRAL_AND; NEUTRAL_VECTOR_ADD] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[ABSOLUTELY_SETCONTINUOUS_ON_NULL; BOUNDED_INTERVAL; MONOIDAL_REAL_ADD; SET_VARIATION_ON_NULL; NEUTRAL_LIFTED; NEUTRAL_REAL_ADD] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real`; `k:num`] THEN STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_SETCONTINUOUS_ON_SUBSET) THEN REWRITE_TAC[INTER_SUBSET]; ALL_TAC] THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r1:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "L")) THEN X_GEN_TAC `r2:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "R")) THEN EXISTS_TAC `min r1 r2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum {l INTER {x:real^M | x$k <= c} | l | l IN d /\ ~(l INTER {x | x$k <= c} = {})} (\k. norm((f:(real^M->bool)->real^N) k)) + sum {l INTER {x | x$k >= c} | l | l IN d /\ ~(l INTER {x | x$k >= c} = {})} (\k. norm((f:(real^M->bool)->real^N) k))` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN W(fun (asl,w) -> MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (lhand(rand w))) THEN MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (rand(rand w)))) THEN MATCH_MP_TAC(TAUT `(a1 /\ a2) /\ (b1 /\ b2 ==> c) ==> (a1 ==> b1) ==> (a2 ==> b2) ==> c`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT; NORM_EQ_0] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THENL [MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ; MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ] THEN ASM_MESON_TAC[]; DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC)] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum d ((\x. norm(((f:(real^M->bool)->real^N) x))) o (\l. l INTER {x | x$k <= c})) + sum d ((\x. norm(((f:(real^M->bool)->real^N) x))) o (\l. l INTER {x:real^M | x$k >= c}))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[o_THM] THEN FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN ASM_MESON_TAC[NORM_ARITH `a + b:real^N = c ==> norm(c) <= norm a + norm b`]; MATCH_MP_TAC(REAL_ARITH `x = y /\ w = z ==> x + w <= y + z`) THEN CONJ_TAC THEN MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[SUBSET_RESTRICT; o_DEF; NORM_EQ_0] THEN REWRITE_TAC[SET_RULE `(x IN s /\ ~(x IN {x | x IN s /\ ~P x}) ==> Q x) <=> (x IN s ==> P x ==> Q x)`] THEN SIMP_TAC[o_THM] THEN ASM_MESON_TAC[EMPTY_AS_INTERVAL; CONTENT_EMPTY]]; MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN CONJ_TAC THENL [REMOVE_THEN "R" MATCH_MP_TAC THEN EXISTS_TAC `t INTER {x:real^M | x$k <= c}`; REMOVE_THEN "L" MATCH_MP_TAC THEN EXISTS_TAC `t INTER {x:real^M | x$k >= c}`] THEN ASM_SIMP_TAC[DIVISION_SPLIT] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `sum (IMAGE (\l. l INTER {x:real^M | x$k <= c}) d) content`; EXISTS_TAC `sum (IMAGE (\l. l INTER {x:real^M | x$k >= c}) d) content`] THEN (CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[division_of; FINITE_IMAGE]; SET_TAC[]; REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; IN_DIFF] THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN ASM_SIMP_TAC[INTERVAL_SPLIT; CONTENT_POS_LE]]; W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[DIVISION_SPLIT_LEFT_INJ; DIVISION_OF_FINITE; DIVISION_SPLIT_RIGHT_INJ]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN ASM_SIMP_TAC[o_DEF; INTERVAL_SPLIT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTENT_SUBSET THEN SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC])]);; let ABSOLUTELY_SETCONTINUOUS_ON_DIVISION = prove (`!f:(real^M->bool)->real^N a b d. operative (+) f /\ d division_of interval[a,b] ==> ((!k. k IN d ==> f absolutely_setcontinuous_on k) <=> f absolutely_setcontinuous_on interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC OPERATIVE_DIVISION_AND THEN ASM_SIMP_TAC[OPERATIVE_ABSOLUTELY_SETCONTINUOUS_ON]);; let ABSOLUTELY_SETCONTINUOUS_ON_IMP_HAS_BOUNDED_SETVARIATION_ON = prove (`!f:(real^M->bool)->real^N s. operative (+) f /\ f absolutely_setcontinuous_on s /\ bounded s ==> f has_bounded_setvariation_on s`, REWRITE_TAC[absolutely_setcontinuous_on] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x. interval(x - (min r (&1)) / &3 % vec 1:real^M, x + (min r (&1)) / &3 % vec 1)`; `a:real^M`; `b:real^M`] FINE_DIVISION_EXISTS) THEN ASM_REWRITE_TAC[gauge; OPEN_INTERVAL; IN_INTERVAL] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:(real^M#(real^M->bool))->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN ABBREV_TAC `D = IMAGE SND (p:(real^M#(real^M->bool))->bool)` THEN STRIP_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN EXISTS_TAC `&(CARD(D:(real^M->bool)->bool)) * &1:real` THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `sum d (\k. sum D (\l. norm((f:(real^M->bool)->real^N) (k INTER l))))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; REWRITE_TAC[]] THEN FIRST_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) VSUM_NORM o rand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[division_of]; REWRITE_TAC[]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] OPERATIVE_DIVISION)) THEN DISCH_THEN(MP_TAC o SPECL [`{ k1 INTER k2 | k1 IN {interval[c:real^M,d]} /\ k2 IN D /\ ~(k1 INTER k2 = {})}`; `c:real^M`; `d:real^M`]) THEN REWRITE_TAC[MONOIDAL_VECTOR_ADD] THEN ANTS_TAC THENL [MP_TAC(ISPECL [`interval[c:real^M,d]`; `interval[a:real^M,b]`; `{interval[c:real^M,d]}`; `D:(real^M->bool)->bool`] DIVISION_INTER) THEN ASM_SIMP_TAC[DIVISION_OF_SELF] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[SET_RULE `{f x y |x,y| x IN {a} /\ y IN s /\ P x y} = {f a y |y| y IN s /\ P a y}`] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) VSUM o lhand o snd) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[division_of]; DISCH_THEN(SUBST1_TAC o SYM)] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN W(MP_TAC o PART_MATCH (rand o rand) VSUM_IMAGE_NONZERO o rand o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`w:real^M`; `x:real^M`] THEN STRIP_TAC THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `D division_of interval[a:real^M,b]` THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o SPECL [`interval[u:real^M,v]`;`interval[w:real^M,x]`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN DISCH_TAC THEN REWRITE_TAC[INTER_INTERVAL] THEN MATCH_MP_TAC(MESON[operative; NEUTRAL_VECTOR_ADD] `operative (+) f /\ content(interval[a,b]) = &0 ==> (f:(real^M->bool)->real^N) (interval[a,b]) = vec 0`) THEN ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN REWRITE_TAC[GSYM INTER_INTERVAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `interior s = {} ==> interior t SUBSET interior s ==> interior t = {}`)) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[division_of]; SET_TAC[]; MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ ~P x ==> Q x) ==> !x. x IN s ==> ~(f x IN {f y | y IN s /\ P y}) ==> Q x`) THEN SIMP_TAC[] THEN ASM_MESON_TAC[OPERATIVE_EMPTY; NEUTRAL_VECTOR_ADD]]]; W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[division_of]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC SUM_BOUND THEN CONJ_TAC THENL [ASM_MESON_TAC[division_of]; REWRITE_TAC[]] THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{ k1 INTER k2 | k1 IN d /\ k2 IN {interval[u:real^M,v]} /\ ~(k1 INTER k2 = {})}`; `t INTER interval[u:real^M,v]`]) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC DIVISION_INTER THEN ASM_SIMP_TAC[DIVISION_OF_SELF]; ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`{ k1 INTER k2 | k1 IN d /\ k2 IN {interval[u:real^M,v]} /\ ~(k1 INTER k2 = {})}`; `t INTER interval[u:real^M,v]`; `u:real^M`; `v:real^M`] SUBADDITIVE_CONTENT_DIVISION) THEN REWRITE_TAC[INTER_SUBSET] THEN ANTS_TAC THENL [MATCH_MP_TAC DIVISION_INTER THEN ASM_SIMP_TAC[DIVISION_OF_SELF]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN SUBGOAL_THEN `interval[u,v] IN IMAGE SND (p:(real^M#(real^M->bool))->bool)` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_TRANS] `s SUBSET interval(a,b) ==> s SUBSET interval[a,b]`)) THEN DISCH_THEN(MP_TAC o MATCH_MP CONTENT_SUBSET) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> x - min r (&1) / &3 * &1 <= x + min r (&1) / &3 * &1`] THEN REWRITE_TAC[REAL_ARITH `(x + a) - (x - a):real = &2 * a`] THEN SIMP_TAC[PRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1; REAL_MUL_RID] THEN TRANS_TAC REAL_LET_TRANS `(&2 * min r (&1) / &3) pow 1` THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN REWRITE_TAC[DIMINDEX_GE_1] THEN ASM_REAL_ARITH_TAC; DISCH_TAC THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [GSYM o_DEF] THEN REWRITE_TAC[o_ASSOC] THEN W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`w:real^M`; `x:real^M`] THEN STRIP_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN FIRST_ASSUM (fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`y:real^M`; `z:real^M`] THEN STRIP_TAC THEN REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM; NORM_EQ_0] THEN UNDISCH_TAC `d division_of (t:real^M->bool)` THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o SPECL [`interval[w:real^M,x]`;`interval[y:real^M,z]`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN DISCH_TAC THEN REWRITE_TAC[INTER_INTERVAL] THEN MATCH_MP_TAC(MESON[operative; NEUTRAL_VECTOR_ADD] `operative (+) f /\ content(interval[a,b]) = &0 ==> (f:(real^M->bool)->real^N) (interval[a,b]) = vec 0`) THEN ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN REWRITE_TAC[GSYM INTER_INTERVAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `interior s = {} ==> interior t SUBSET interior s ==> interior t = {}`)) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < &1 ==> x = y ==> y <= &1`)) THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; NORM_EQ_0] THEN X_GEN_TAC `k:real^M->bool` THEN ASM_CASES_TAC `k INTER interval[u:real^M,v] = {}` THENL [ASM_MESON_TAC[OPERATIVE_EMPTY; NEUTRAL_VECTOR_ADD]; ASM SET_TAC[]]]]]);; (* ------------------------------------------------------------------------- *) (* Now the standard notion of absolute continuity for a function R^1->R^n. *) (* ------------------------------------------------------------------------- *) parse_as_infix("absolutely_continuous_on",(12,"right"));; let absolutely_continuous_on = new_definition `(f:real^1->real^N) absolutely_continuous_on s <=> (\k. f(interval_upperbound k) - f(interval_lowerbound k)) absolutely_setcontinuous_on s`;; let ABSOLUTELY_CONTINUOUS_ON_EQ = prove (`!f g:real^1->real^N s. (!x. x IN s ==> f x = g x) /\ f absolutely_continuous_on s ==> g absolutely_continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[absolutely_continuous_on] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ABSOLUTELY_SETCONTINUOUS_ON_EQ) THEN SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; GSYM INTERVAL_NE_EMPTY] THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]);; let ABSOLUTELY_CONTINUOUS_ISOMETRIC = prove (`!f g:real^1->real^N s. (!x y. dist(f x,f y) = dist(g x,g y)) ==> (f absolutely_continuous_on s <=> g absolutely_continuous_on s)`, SIMP_TAC[absolutely_continuous_on; absolutely_setcontinuous_on; o_DEF; dist]);; let ABSOLUTELY_CONTINUOUS_ISOMETRIC_COMPOSE = prove (`!f:real^M->real^N g s. (!x y. dist(f x,f y) = dist(x,y)) ==> ((f o g) absolutely_continuous_on s <=> g absolutely_continuous_on s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ISOMETRIC THEN ASM_REWRITE_TAC[o_DEF]);; let ABSOLUTELY_CONTINUOUS_ON_TRANSLATION = prove (`!f:real^1->real^N s a. (\x. a + f x) absolutely_continuous_on s <=> f absolutely_continuous_on s`, REWRITE_TAC[absolutely_continuous_on] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; let ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE = prove (`!f:real^1->real^N s. f absolutely_continuous_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift(f x$i)) absolutely_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN GEN_REWRITE_TAC LAND_CONV [ABSOLUTELY_SETCONTINUOUS_ON_COMPONENTWISE] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; LIFT_SUB]);; let ABSOLUTELY_CONTINUOUS_COMPARISON = prove (`!f:real^1->real^M g:real^1->real^N s. f absolutely_continuous_on s /\ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> dist(g x,g y) <= dist(f x,f y)) ==> g absolutely_continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[absolutely_continuous_on] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_SETCONTINUOUS_COMPARISON) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM dist] THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s ==> dist((g:real^1->real^N) x,g y) <= dist((f:real^1->real^M) x,f y)` MATCH_MP_TAC THENL [REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[DIST_REFL; REAL_LE_REFL] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]]);; let ABSOLUTELY_CONTINUOUS_ON_LIFT_ABS = prove (`!f:real^1->real. (\x. lift(f x)) absolutely_continuous_on s ==> (\x. lift(abs(f x))) absolutely_continuous_on s`, REPEAT GEN_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_CONTINUOUS_COMPARISON) THEN REWRITE_TAC[DIST_LIFT] THEN REAL_ARITH_TAC);; let ABSOLUTELY_CONTINUOUS_ON_SUBSET = prove (`!f:real^1->real^N s t. f absolutely_continuous_on s /\ t SUBSET s ==> f absolutely_continuous_on t`, REWRITE_TAC[ABSOLUTELY_SETCONTINUOUS_ON_SUBSET; absolutely_continuous_on]);; let ABSOLUTELY_CONTINUOUS_ON_CONST = prove (`!s c:real^N. (\x. c) absolutely_continuous_on s`, REWRITE_TAC[absolutely_continuous_on; VECTOR_SUB_REFL; ABSOLUTELY_SETCONTINUOUS_ON_0]);; let ABSOLUTELY_CONTINUOUS_ON_CMUL = prove (`!f:real^1->real^N c s. f absolutely_continuous_on s ==> (\x. c % f x) absolutely_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; ABSOLUTELY_SETCONTINUOUS_ON_CMUL]);; let ABSOLUTELY_CONTINUOUS_ON_CMUL_EQ = prove (`!f:real^1->real^N c s. (\x. c % f x) absolutely_continuous_on s <=> c = &0 \/ f absolutely_continuous_on s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; ABSOLUTELY_CONTINUOUS_ON_CONST] THEN EQ_TAC THEN REWRITE_TAC[ABSOLUTELY_CONTINUOUS_ON_CMUL] THEN DISCH_THEN(MP_TAC o SPEC `inv(c:real)` o MATCH_MP ABSOLUTELY_CONTINUOUS_ON_CMUL) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_LINV; ETA_AX]);; let ABSOLUTELY_CONTINUOUS_ON_VMUL_EQ = prove (`!f s v:real^N. (\x. f(x) % v) absolutely_continuous_on s <=> v = vec 0 \/ (\x. lift(f x)) absolutely_continuous_on s`, REPEAT GEN_TAC THEN TRANS_TAC EQ_TRANS `(\x. norm(v:real^N) % lift(f x)) absolutely_continuous_on s` THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ISOMETRIC THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[NORM_MUL; GSYM LIFT_SUB; NORM_LIFT; REAL_ABS_NORM] THEN REWRITE_TAC[REAL_MUL_SYM]; REWRITE_TAC[ABSOLUTELY_CONTINUOUS_ON_CMUL_EQ; NORM_EQ_0]]);; let ABSOLUTELY_CONTINUOUS_ON_VMUL = prove (`!f s v:real^N. (\x. lift(f x)) absolutely_continuous_on s ==> (\x. f(x) % v) absolutely_continuous_on s`, SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_VMUL_EQ]);; let ABSOLUTELY_CONTINUOUS_ON_NEG = prove (`!f:real^1->real^N s. f absolutely_continuous_on s ==> (\x. --f x) absolutely_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN REWRITE_TAC[VECTOR_ARITH `--a - --b:real^N = --(a - b)`; ABSOLUTELY_SETCONTINUOUS_ON_NEG]);; let ABSOLUTELY_CONTINUOUS_ON_ADD = prove (`!f g:real^1->real^N s. f absolutely_continuous_on s /\ g absolutely_continuous_on s ==> (\x. f x + g x) absolutely_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN REWRITE_TAC[VECTOR_ARITH `(f + g) - (f' + g'):real^N = (f - f') + (g - g')`; ABSOLUTELY_SETCONTINUOUS_ON_ADD]);; let ABSOLUTELY_CONTINUOUS_ON_SUB = prove (`!f g:real^1->real^N s. f absolutely_continuous_on s /\ g absolutely_continuous_on s ==> (\x. f x - g x) absolutely_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN REWRITE_TAC[VECTOR_ARITH `(f - g) - (f' - g'):real^N = (f - f') - (g - g')`; ABSOLUTELY_SETCONTINUOUS_ON_SUB]);; let ABSOLUTELY_CONTINUOUS_ON_COMPOSE_LINEAR = prove (`!f:real^1->real^M g:real^M->real^N s. f absolutely_continuous_on s /\ linear g ==> (g o f) absolutely_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN SIMP_TAC[o_THM; GSYM LINEAR_SUB] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_SETCONTINUOUS_ON_COMPOSE_LINEAR) THEN REWRITE_TAC[o_DEF]);; let ABSOLUTELY_CONTINUOUS_ON_NULL = prove (`!f:real^1->real^N s. content s = &0 /\ bounded s ==> f absolutely_continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN MATCH_MP_TAC ABSOLUTELY_SETCONTINUOUS_ON_NULL THEN ASM_SIMP_TAC[INTERVAL_BOUNDS_NULL_1; VECTOR_SUB_REFL]);; let ABSOLUTELY_CONTINUOUS_ON_EMPTY = prove (`!f:real^1->real^N. f absolutely_continuous_on {}`, MESON_TAC[CONTENT_EMPTY; BOUNDED_EMPTY; ABSOLUTELY_CONTINUOUS_ON_NULL]);; let ABSOLUTELY_CONTINUOUS_ON_NORM = prove (`!f:real^1->real^N s. f absolutely_continuous_on s ==> (\x. lift(norm(f x))) absolutely_continuous_on s`, REPEAT GEN_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_CONTINUOUS_COMPARISON) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_LIFT] THEN CONV_TAC NORM_ARITH);; let ABSOLUTELY_CONTINUOUS_ON_MAX = prove (`!f g s. f absolutely_continuous_on s /\ g absolutely_continuous_on s ==> (\x. lift(max (drop(f x)) (drop(g x)))) absolutely_continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `max a b = inv(&2) * (a + b + abs(a - b))`] THEN REWRITE_TAC[LIFT_CMUL; LIFT_ADD; LIFT_DROP; GSYM DROP_SUB] THEN REWRITE_TAC[drop; GSYM NORM_REAL] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_ADD THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_NORM THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_SUB THEN ASM_REWRITE_TAC[]);; let ABSOLUTELY_CONTINUOUS_ON_MIN = prove (`!f g s. f absolutely_continuous_on s /\ g absolutely_continuous_on s ==> (\x. lift(min (drop(f x)) (drop(g x)))) absolutely_continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `min a b = inv(&2) * ((a + b) - abs(a - b))`] THEN REWRITE_TAC[LIFT_CMUL; LIFT_ADD; LIFT_DROP; LIFT_SUB; GSYM DROP_SUB] THEN REWRITE_TAC[drop; GSYM NORM_REAL] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_SUB THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_ADD] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_NORM THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_SUB THEN ASM_REWRITE_TAC[]);; let ABSOLUTELY_CONTINUOUS_LIPSCHITZ_COMPOSE = prove (`!f:real^M->real^N g s B. g absolutely_continuous_on s /\ (!x y. x IN IMAGE g s /\ y IN IMAGE g s ==> norm(f x - f y) <= B * norm(x - y)) ==> (f o g) absolutely_continuous_on s`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `\x. B % (g:real^1->real^M) x` ABSOLUTELY_CONTINUOUS_COMPARISON) THEN ASM_REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_CMUL; o_DEF] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC);; let ABSOLUTELY_CONTINUOUS_ON_ID = prove (`!s:real^1->bool. (\x. x) absolutely_continuous_on s`, GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on; absolutely_setcontinuous_on] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN SIMP_TAC[CONTENT_1; INTERVAL_NE_EMPTY_1; NORM_1; DROP_SUB] THEN REAL_ARITH_TAC);; let LIPSCHITZ_IMP_ABSOLUTELY_CONTINUOUS = prove (`!f:real^1->real^N s B. bounded s /\ (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> f absolutely_continuous_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `\x:real^1. x`; `s:real^1->bool`; `B:real`] ABSOLUTELY_CONTINUOUS_LIPSCHITZ_COMPOSE) THEN ASM_REWRITE_TAC[o_DEF; IMAGE_ID; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_ID]);; let ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS = prove (`!f:real^1->real^N s. f absolutely_continuous_on s /\ is_interval s ==> f uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on; uniformly_continuous_on; absolutely_setcontinuous_on; IS_INTERVAL_1] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{interval[a:real^1,b]}`; `interval[a:real^1,b]`]) THEN ASM_SIMP_TAC[DIVISION_OF_SELF; INTERVAL_NE_EMPTY_1; SUM_SING; dist; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; CONTENT_1] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [DIST_REAL]) THEN REWRITE_TAC[drop] THEN REAL_ARITH_TAC]);; let ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS = prove (`!f s. f absolutely_continuous_on s /\ is_interval s ==> f continuous_on s`, MESON_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS]);; let ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON = prove (`!f:real^1->real^N s. f absolutely_continuous_on s /\ bounded s ==> f has_bounded_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_continuous_on; has_bounded_variation_on] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_SETCONTINUOUS_ON_IMP_HAS_BOUNDED_SETVARIATION_ON) THEN REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; let ABSOLUTELY_CONTINUOUS_ON_BILINEAR = prove (`!bop:real^M->real^N->real^P f g s. bilinear bop /\ f absolutely_continuous_on s /\ g absolutely_continuous_on s /\ is_interval s /\ bounded s ==> (\x. bop (f x) (g x)) absolutely_continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `bounded(IMAGE (f:real^1->real^M) s) /\ bounded(IMAGE (g:real^1->real^N) s)` MP_TAC THENL [ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED; ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON]; REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[absolutely_continuous_on; absolutely_setcontinuous_on] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &2 / B1 / D:real`) (MP_TAC o SPEC `e / &2 / B2 / D:real`)) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r1:real` THEN STRIP_TAC THEN X_GEN_TAC `r2:real` THEN STRIP_TAC THEN EXISTS_TAC `min r1 r2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN TRANS_TAC REAL_LTE_TRANS `D * B1 * e / &2 / B1 / D + D * B2 * e / &2 / B2 / D` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_LT_IMP_NZ)) THEN CONV_TAC REAL_FIELD] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `D * B1 * sum d (\k. norm((g:real^1->real^N)(interval_upperbound k) - g(interval_lowerbound k))) + D * B2 * sum d (\k. norm((f:real^1->real^M)(interval_upperbound k) - f(interval_lowerbound k)))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_MESON_TAC[REAL_LT_LMUL_EQ]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN TRANS_TAC REAL_LE_TRANS `norm((bop:real^M->real^N->real^P) (f v) (g v) - bop (f v) (g u)) + norm(bop (f v) (g u) - bop (f(u:real^1)) (g u))` THEN CONJ_TAC THENL [CONV_TAC NORM_ARITH; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP BILINEAR_LSUB th)] THEN REWRITE_TAC[GSYM(MATCH_MP BILINEAR_RSUB th)]) THEN FIRST_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM]] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN (SUBGOAL_THEN `interval[u:real^1,v] SUBSET s` MP_TAC THENL [ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC]) THEN ASM_MESON_TAC[SUBSET; ENDS_IN_INTERVAL]);; let ABSOLUTELY_CONTINUOUS_ON_MUL = prove (`!f g:real^1->real^N s. f absolutely_continuous_on s /\ g absolutely_continuous_on s /\ is_interval s /\ bounded s ==> (\x. drop(f x) % g x) absolutely_continuous_on s`, REWRITE_TAC[REWRITE_RULE[] (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_ON_BILINEAR) BILINEAR_DROP_MUL)]);; let ABSOLUTELY_CONTINUOUS_ON_VSUM = prove (`!f:A->real^1->real^N s k. FINITE k /\ (!i. i IN k ==> f i absolutely_continuous_on s) ==> (\x. vsum k (\i. f i x)) absolutely_continuous_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FORALL_IN_INSERT] THEN SIMP_TAC[REAL_LE_REFL; ABSOLUTELY_CONTINUOUS_ON_CONST; ABSOLUTELY_CONTINUOUS_ON_ADD; ETA_AX; NOT_IN_EMPTY]);; let OPERATIVE_ABSOLUTELY_CONTINUOUS_ON = prove (`!f:real^1->real^N. operative (/\) ((absolutely_continuous_on) f)`, GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[absolutely_continuous_on] THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC OPERATIVE_ABSOLUTELY_SETCONTINUOUS_ON THEN REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; let ABSOLUTELY_CONTINUOUS_ON_DIVISION = prove (`!f:real^1->real^N a b d. d division_of interval[a,b] ==> ((!k. k IN d ==> f absolutely_continuous_on k) <=> f absolutely_continuous_on interval[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN MATCH_MP_TAC ABSOLUTELY_SETCONTINUOUS_ON_DIVISION THEN ASM_REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; let ABSOLUTELY_CONTINUOUS_ON_COMBINE = prove (`!f:real^1->real^N a b c. drop a <= drop c /\ drop c <= drop b ==> (f absolutely_continuous_on interval[a,b] <=> f absolutely_continuous_on interval[a,c] /\ f absolutely_continuous_on interval[c,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:real^1->real^N` OPERATIVE_ABSOLUTELY_CONTINUOUS_ON) THEN REWRITE_TAC[operative] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`; `drop c`; `1`] o CONJUNCT2) THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN SIMP_TAC[EXTENSION; IN_INTER; GSYM drop; IN_INTERVAL_1; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC);; let ABSOLUTELY_CONTINUOUS_ON_SING = prove (`!f a. f absolutely_continuous_on {a}`, REPEAT GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_NULL THEN REWRITE_TAC[GSYM INTERVAL_SING; BOUNDED_INTERVAL] THEN REWRITE_TAC[CONTENT_EQ_0_1; REAL_LE_REFL]);; let ABSOLUTELY_CONTINUOUS_ON_INTERIOR = prove (`!f:real^1->real^N s. f absolutely_continuous_on (interior s) /\ f continuous_on s ==> f absolutely_continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[absolutely_continuous_on; absolutely_setcontinuous_on] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUM_VSUM] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN EXISTS_TAC `\n. vsum d (\k. lift(norm ((f:real^1->real^N)(interval_upperbound k - inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)) - f(interval_lowerbound k + inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)))))` THEN REWRITE_TAC[o_DEF; TRIVIAL_LIMIT_SEQUENTIALLY] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_VSUM THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN SUBGOAL_THEN `interval[a:real^1,b] SUBSET s` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [SUBGOAL_THEN `(f:real^1->real^N) continuous (at b within s)` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC]; SUBGOAL_THEN `(f:real^1->real^N) continuous (at a within s)` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC]] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN (CONJ_TAC THENL [GEN_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_CMUL; REAL_ARITH `a <= b - i * (b - a) <=> &0 <= (&1 - i) * (b - a)`; REAL_ARITH `b - i * (b - a) <= b <=> &0 <= i * (b - a)`; REAL_ARITH `a + i * (b - a) <= b <=> &0 <= (&1 - i) * (b - a)`; REAL_ARITH `a <= a + i * (b - a) <=> &0 <= i * (b - a)`] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MATCH_MP_TAC REAL_POW_LE_1 THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC]) THENL [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN MATCH_MP_TAC LIM_SUB; GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC LIM_ADD] THEN REWRITE_TAC[LIM_CONST] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = &0 % (b - a)`) THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_DEF; DIST_LIFT; REAL_SUB_RZERO] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `d:real`] REAL_ARCH_POW_INV) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `inv(&2 pow N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[DROP_VSUM; o_DEF; LIFT_DROP] THEN FIRST_X_ASSUM(MP_TAC o GEN `d:(real^1->bool)->bool` o SPECL [`d:(real^1->bool)->bool`; `UNIONS d:real^1->bool`]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\k. interval[interval_lowerbound k + inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k):real^1, interval_upperbound k - inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)]) {k | k IN d /\ ~(content k = &0)}`) THEN MP_TAC(GEN `g:(real^1->bool)->real` (ISPECL [`\k. interval[interval_lowerbound k + inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k):real^1, interval_upperbound k - inv(&2 pow n) % (interval_upperbound k - interval_lowerbound k)]`; `g:(real^1->bool)->real`; `{k:real^1->bool | k IN d /\ ~(content k = &0)}`] SUM_IMAGE)) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM; RIGHT_FORALL_IMP_THM; TAUT `(p /\ q) /\ (r /\ s) /\ t ==> u <=> p ==> r ==> q /\ s /\ t ==> u`] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) MP_TAC)) THEN REWRITE_TAC[EQ_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `b - i * (b - a) < a + i * (b - a) <=> ~(&0 <= (&1 - &2 * i) * (b - a))`] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MATCH_MP_TAC(TAUT `p ==> ~p /\ q ==> r`) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING `a + n * (b - a) = c + n * (d - c) /\ b - n * (b - a) = d - n * (d - c) ==> n pow 2 = (&1 - n) pow 2 \/ a = c /\ b = d`)) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = abs(&1 - x) ==> x = inv(&2)`)) THEN MATCH_MP_TAC(REAL_ARITH `x < y ==> x = y ==> F`) THEN MATCH_MP_TAC REAL_LT_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[o_DEF]] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `a = b ==> a < e / &2 ==> b <= e / &2`) THEN REWRITE_TAC[SUM_RESTRICT_SET] THEN MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1; INTERVAL_UPPERBOUND_NONEMPTY] THEN REWRITE_TAC[REAL_SUB_0; DROP_EQ] THEN ASM_CASES_TAC `b:real^1 = a` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO; VECTOR_ADD_RID; NORM_0] THEN AP_TERM_TAC THEN BINOP_TAC THEN AP_TERM_TAC THENL [MATCH_MP_TAC INTERVAL_UPPERBOUND_NONEMPTY; MATCH_MP_TAC INTERVAL_LOWERBOUND_NONEMPTY] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC] THEN REPEAT CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1; INTERVAL_UPPERBOUND_NONEMPTY] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `~(b - a = &0) ==> a <= b ==> a < b`)) THEN ASM_REWRITE_TAC[GSYM(CONJUNCT1 INTERVAL_NE_EMPTY_1)] THEN DISCH_TAC THEN TRANS_TAC SUBSET_TRANS `interval(a:real^1,b)` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL_1] THEN DISJ2_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_CMUL; REAL_ARITH `b - i * (b - a) < b <=> &0 < i * (b - a)`; REAL_ARITH `a < a + i * (b - a) <=> &0 < i * (b - a)`; REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; REWRITE_TAC[GSYM(CONJUNCT1 INTERIOR_INTERVAL)] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN REWRITE_TAC[SUM_RESTRICT_SET] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; REAL_SUB_0; GSYM INTERVAL_NE_EMPTY_1; INTERVAL_UPPERBOUND_NONEMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1; CONTENT_POS_LE] THEN MATCH_MP_TAC CONTENT_SUBSET THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN DISJ2_TAC THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `b - i * (b - a) <= b <=> &0 <= i * (b - a)`; REAL_ARITH `a <= a + i * (b - a) <=> &0 <= i * (b - a)`; REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC] THEN SIMP_TAC[division_of; SET_RULE `!x. x IN s ==> x SUBSET UNIONS s`] THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN SIMP_TAC[IMP_CONJ; IN_ELIM_THM; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN CONJ_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THENL [CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; CONTENT_1; GSYM INTERVAL_NE_EMPTY_1] THEN REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPECL [`interval[a:real^1,b]`; `interval[c:real^1,d]`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN ASM_SIMP_TAC[CONTRAPOS_THM; EQ_INTERVAL_1; GSYM INTERVAL_EQ_EMPTY_1; DROP_EQ] THEN REWRITE_TAC[GSYM INTERIOR_INTER] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'`) THEN CONJ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN DISJ2_TAC THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `b - i * (b - a) <= b <=> &0 <= i * (b - a)`; REAL_ARITH `a <= a + i * (b - a) <=> &0 <= i * (b - a)`; REAL_ARITH `a + i * (b - a) <= b - i * (b - a) <=> &0 <= (&1 - &2 * i) * (b - a)`] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `&2 <= &1 * x <=> &2 pow 1 <= x`] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC);; let ABSOLUTELY_CONTINUOUS_ON_INTERIOR_EQ = prove (`!f:real^1->real^N s. f continuous_on s ==> (f absolutely_continuous_on interior s <=> f absolutely_continuous_on s)`, MESON_TAC[ABSOLUTELY_CONTINUOUS_ON_INTERIOR; ABSOLUTELY_CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]);; let ABSOLUTELY_CONTINUOUS_ON_CLOSURE = prove (`!f:real^1->real^N s. is_interval s /\ f continuous_on closure s /\ f absolutely_continuous_on interior s ==> f absolutely_continuous_on closure s`, REWRITE_TAC[IS_INTERVAL_CONVEX_1] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_INTERIOR THEN ASM_SIMP_TAC[CONVEX_INTERIOR_CLOSURE]);; let ABSOLUTELY_CONTINUOUS_ON_CLOSURE_EQ = prove (`!f:real^1->real^N s. is_interval s /\ f continuous_on closure s ==> (f absolutely_continuous_on closure s <=> f absolutely_continuous_on s)`, MESON_TAC[ABSOLUTELY_CONTINUOUS_ON_CLOSURE; CLOSURE_SUBSET; ABSOLUTELY_CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]);; let ABSOLUTELY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove (`!f:real^1->real^N s. f absolutely_continuous_on s /\ is_interval s ==> ?g. g absolutely_continuous_on (closure s) /\ !x. x IN s ==> g x = f x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_INTERIOR THEN ASM_SIMP_TAC[UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^1->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[ABSOLUTELY_CONTINUOUS_ON_EQ]; ASM_MESON_TAC[CONVEX_INTERIOR_CLOSURE; INTERIOR_SUBSET; IS_INTERVAL_CONVEX_1]]);; (* ------------------------------------------------------------------------- *) (* Rectifiable paths and path length defined using variation. *) (* ------------------------------------------------------------------------- *) let rectifiable_path = new_definition `rectifiable_path (g:real^1->real^N) <=> path g /\ g has_bounded_variation_on interval[vec 0,vec 1]`;; let path_length = new_definition `path_length (g:real^1->real^N) = vector_variation (interval[vec 0,vec 1]) g`;; let RECTIFIABLE_PATH_LIPSCHITZ_IMAGE = prove (`!f:real^M->real^N g. rectifiable_path g /\ (?B. !x y. x IN path_image g /\ y IN path_image g ==> norm(f x - f y) <= B * norm(x - y)) ==> rectifiable_path(f o g)`, REWRITE_TAC[rectifiable_path] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[LIPSCHITZ_IMP_CONTINUOUS_ON]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE THEN ASM_REWRITE_TAC[GSYM path_image] THEN ASM_MESON_TAC[]]);; let RECTIFIABLE_PATH_TRANSLATION_EQ = prove (`!a:real^N g. rectifiable_path((\x. a + x) o g) <=> rectifiable_path g`, REWRITE_TAC[rectifiable_path; has_bounded_variation_on; o_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[PATH_TRANSLATION_EQ] THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; add_translation_invariants [RECTIFIABLE_PATH_TRANSLATION_EQ];; let RECTIFIABLE_PATH_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N g. linear f /\ (!x y. f x = f y ==> x = y) ==> (rectifiable_path(f o g) <=> rectifiable_path g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[rectifiable_path] THEN BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `g:real^1->real^M = h o (f:real^M->real^N) o g` SUBST1_TAC THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC]; ALL_TAC] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR THEN ASM_REWRITE_TAC[]);; add_linear_invariants [RECTIFIABLE_PATH_LINEAR_IMAGE_EQ];; let PATH_LENGTH_TRANSLATION = prove (`!a g:real^1->real^N. path_length((\x. a + x) o g) = path_length g`, REWRITE_TAC[path_length; vector_variation; o_THM] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; add_translation_invariants [PATH_LENGTH_TRANSLATION];; let PATH_LENGTH_ISOMETRIC_IMAGE = prove (`!f:real^M->real^N g. (!x y. dist(f x,f y) = dist(x,y)) ==> path_length(f o g) = path_length g`, SIMP_TAC[path_length; vector_variation; set_variation; o_THM; dist]);; let PATH_LENGTH_LINEAR_IMAGE = prove (`!f:real^M->real^N g. linear f /\ (!x. norm(f x) = norm x) ==> path_length(f o g) = path_length g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_LENGTH_ISOMETRIC_IMAGE THEN ASM_MESON_TAC[PRESEVES_NORM_PRESERVES_DIST]);; add_linear_invariants [PATH_LENGTH_LINEAR_IMAGE];; let RECTIFIABLE_PATH_EQ = prove (`!p q:real^1->real^N. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ rectifiable_path p ==> rectifiable_path q`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[rectifiable_path] THEN ASM_MESON_TAC[PATH_EQ; HAS_BOUNDED_VARIATION_ON_EQ]);; let PATH_LENGTH_EQ = prove (`!p q:real^1->real^N. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) ==> path_length p = path_length q`, REWRITE_TAC[path_length] THEN MESON_TAC[VECTOR_VARIATION_EQ]);; let PATH_LENGTH_SCALING = prove (`!g:real^1->real^N c. rectifiable_path g ==> path_length ((\x. c % x) o g) = abs c * path_length g`, REWRITE_TAC[rectifiable_path; path_length; o_THM] THEN REWRITE_TAC[IMP_CONJ; o_DEF; VECTOR_VARIATION_CMUL]);; let BOUNDED_RECTIFIABLE_PATH_IMAGE = prove (`!g:real^1->real^N. rectifiable_path g ==> bounded(path_image g)`, SIMP_TAC[rectifiable_path; BOUNDED_PATH_IMAGE]);; let RECTIFIABLE_PATH_IMP_PATH = prove (`!g:real^1->real^N. rectifiable_path g ==> path g`, SIMP_TAC[rectifiable_path]);; let RECTIFIABLE_PATH_LINEPATH = prove (`!a b:real^N. rectifiable_path(linepath(a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[rectifiable_path; PATH_LINEPATH] THEN REWRITE_TAC[linepath] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN REWRITE_TAC[GSYM DROP_VEC; GSYM DROP_SUB] THEN CONJ_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_MUL THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_CONST] THEN SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_CONST] THEN SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL]);; let RECTIFIABLE_PATH_REVERSEPATH = prove (`!g:real^1->real^N. rectifiable_path(reversepath g) <=> rectifiable_path g`, SUBGOAL_THEN `!g:real^1->real^N. rectifiable_path g ==> rectifiable_path(reversepath g)` (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN GEN_TAC THEN REWRITE_TAC[rectifiable_path] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[PATH_REVERSEPATH] THEN REWRITE_TAC[reversepath] THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_DECREASING THEN ASM_REWRITE_TAC[DROP_SUB; VECTOR_SUB_RZERO; VECTOR_SUB_REFL] THEN REAL_ARITH_TAC);; let PATH_LENGTH_REVERSEPATH = prove (`!g:real^1->real^N. path_length(reversepath g) = path_length g`, GEN_TAC THEN REWRITE_TAC[path_length; reversepath] THEN REWRITE_TAC[VECTOR_SUB; VECTOR_VARIATION_REFLECT] THEN REWRITE_TAC[VECTOR_VARIATION_TRANSLATION_ALT] THEN REWRITE_TAC[REFLECT_INTERVAL; GSYM INTERVAL_TRANSLATION] THEN REWRITE_TAC[GSYM VECTOR_SUB; VECTOR_SUB_REFL; VECTOR_SUB_RZERO]);; let RECTIFIABLE_PATH_SUBPATH_EQ = prove (`!g:real^1->real^N s t. rectifiable_path(subpath s t g) <=> path(subpath s t g) /\ g has_bounded_variation_on segment[s,t]`, REPEAT GEN_TAC THEN REWRITE_TAC[rectifiable_path] THEN AP_TERM_TAC THEN REWRITE_TAC[subpath] THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_AFFINITY_EQ; IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[DROP_SUB; REAL_SUB_0; DROP_EQ] THEN ASM_CASES_TAC `s:real^1 = t` THEN ASM_REWRITE_TAC[SEGMENT_REFL; HAS_BOUNDED_VARIATION_ON_SING] THEN REWRITE_TAC[SEGMENT_1; REAL_SUB_LE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ; GSYM DROP_EQ] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; let PATH_LENGTH_SUBPATH = prove (`!g:real^1->real^N s t. path_length(subpath s t g) = vector_variation (segment[s,t]) g`, REPEAT GEN_TAC THEN REWRITE_TAC[path_length; subpath] THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN REWRITE_TAC[VECTOR_VARIATION_AFFINITY; IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[DROP_SUB; REAL_SUB_0; DROP_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL; VECTOR_VARIATION_SING] THEN REWRITE_TAC[SEGMENT_1; REAL_SUB_LE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ; GSYM DROP_EQ] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; let RECTIFIABLE_PATH_SUBPATH = prove (`!u v g:real^1->real^N. rectifiable_path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] ==> rectifiable_path(subpath u v g)`, REPEAT GEN_TAC THEN SIMP_TAC[PATH_SUBPATH; rectifiable_path] THEN STRIP_TAC THEN REWRITE_TAC[subpath] THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_AFFINITY_EQ; IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY; DROP_SUB; REAL_SUB_LE; REAL_SUB_0] THEN DISJ2_TAC THEN COND_CASES_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC);; let RECTIFIABLE_PATH_JOIN = prove (`!g1 g2:real^1->real^N. pathfinish g1 = pathstart g2 ==> (rectifiable_path(g1 ++ g2) <=> rectifiable_path g1 /\ rectifiable_path g2)`, REPEAT GEN_TAC THEN SIMP_TAC[rectifiable_path; PATH_JOIN] THEN REWRITE_TAC[pathfinish; pathstart] THEN DISCH_TAC THEN ASM_CASES_TAC `path(g1:real^1->real^N)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `path(g2:real^1->real^N)` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`g1 ++ g2:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; `lift(&1 / &2)`] HAS_BOUNDED_VARIATION_ON_COMBINE) THEN REWRITE_TAC[DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[joinpaths] THEN BINOP_TAC THEN MATCH_MP_TAC EQ_TRANS THENL [EXISTS_TAC `(\x. (g1:real^1->real^N)(&2 % x)) has_bounded_variation_on interval [vec 0,lift(&1 / &2)]` THEN ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x:real^N = &2 % x + vec 0`]; EXISTS_TAC `(\x. (g2:real^1->real^N)(&2 % x - vec 1)) has_bounded_variation_on interval [lift (&1 / &2),vec 1]` THEN ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x - v:real^N = &2 % x + --v`]] THEN (CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[HAS_BOUNDED_VARIATION_AFFINITY_EQ] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN REWRITE_TAC[DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ; GSYM DROP_EQ] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP; DROP_VEC; DROP_NEG] THEN REAL_ARITH_TAC]) THEN MATCH_MP_TAC(MESON[HAS_BOUNDED_VARIATION_ON_EQ] `(!x. x IN s ==> f x = g x) ==> (f has_bounded_variation_on s <=> g has_bounded_variation_on s)`) THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN X_GEN_TAC `x:real^1` THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `&2 % x + --vec 1:real^1 = vec 0 /\ &2 % x = vec 1` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[VECTOR_SUB_EQ; GSYM VECTOR_SUB] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN ASM_REAL_ARITH_TAC);; let RECTIFIABLE_PATH_JOIN_IMP = prove (`!g1 g2:real^1->real^N. rectifiable_path g1 /\ rectifiable_path g2 /\ pathfinish g1 = pathstart g2 ==> rectifiable_path(g1 ++ g2)`, SIMP_TAC[RECTIFIABLE_PATH_JOIN]);; let RECTIFIABLE_PATH_JOIN_EQ = prove (`!g1 g2:real^1->real^N. rectifiable_path g1 /\ rectifiable_path g2 ==> (rectifiable_path (g1 ++ g2) <=> pathfinish g1 = pathstart g2)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[RECTIFIABLE_PATH_JOIN_IMP] THEN DISCH_TAC THEN MATCH_MP_TAC PATH_JOIN_PATH_ENDS THEN ASM_SIMP_TAC[RECTIFIABLE_PATH_IMP_PATH]);; let RECTIFIABLE_PATH_SYM = prove (`!p q:real^1->real^N. pathfinish p = pathstart q /\ pathfinish q = pathstart p ==> (rectifiable_path(p ++ q) <=> rectifiable_path(q ++ p))`, SIMP_TAC[RECTIFIABLE_PATH_JOIN] THEN CONV_TAC TAUT);; let RECTIFIABLE_PATH_SHIFTPATH = prove (`!g:real^1->real^N a. rectifiable_path g /\ pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> rectifiable_path(shiftpath a g)`, SIMP_TAC[rectifiable_path; PATH_SHIFTPATH] THEN REWRITE_TAC[IN_INTERVAL_1; shiftpath; DROP_ADD; DROP_VEC] THEN REPEAT STRIP_TAC THEN MP_TAC(GEN `f:real^1->real^N` (ISPECL [`f:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; `vec 1 - a:real^1`] HAS_BOUNDED_VARIATION_ON_COMBINE)) THEN REWRITE_TAC[DROP_SUB; DROP_VEC; RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN CONJ_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_EQ THENL [EXISTS_TAC `\x. (g:real^1->real^N) (a + x)`; EXISTS_TAC `\x. (g:real^1->real^N) (a + x - vec 1)`] THEN (CONJ_TAC THENL [SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; REAL_ARITH `x <= &1 - a <=> a + x <= &1`]; MATCH_MP_TAC(REWRITE_RULE[o_DEF] HAS_BOUNDED_VARIATION_COMPOSE_INCREASING) THEN SIMP_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC]) THEN X_GEN_TAC `x:real^1` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM o GEN_REWRITE_RULE RAND_CONV [pathstart]) THEN REWRITE_TAC[pathfinish] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC);; let PATH_LENGTH_SHIFTPATH = prove (`!g:real^1->real^N a. rectifiable_path g /\ pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> path_length(shiftpath a g) = path_length g`, REWRITE_TAC[rectifiable_path] THEN REWRITE_TAC[IN_INTERVAL_1; shiftpath; path_length; DROP_ADD; DROP_VEC] THEN REPEAT STRIP_TAC THEN MP_TAC(GEN `f:real^1->real^N` (ISPECL [`f:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; `vec 1 - a:real^1`] VECTOR_VARIATION_COMBINE)) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (rand o rand) th o lhand o snd)) THEN ANTS_TAC THENL [REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MP_TAC(ISPECL [`g:real^1->real^N`; `a:real^1`] RECTIFIABLE_PATH_SHIFTPATH) THEN ASM_SIMP_TAC[rectifiable_path; shiftpath; DROP_ADD; IN_INTERVAL_1; DROP_VEC]; DISCH_THEN(SUBST1_TAC o SYM)] THEN TRANS_TAC EQ_TRANS `vector_variation (interval[vec 0,vec 1 - a]) (\x. (g:real^1->real^N) (a + x)) + vector_variation (interval[vec 1 - a,vec 1]) (\x. g (a + x - vec 1))` THEN CONJ_TAC THENL [BINOP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; REAL_ARITH `x <= &1 - a <=> a + x <= &1`] THEN X_GEN_TAC `x:real^1` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [pathstart]) THEN REWRITE_TAC[pathfinish] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `a + x - vec 1:real^1 = (a - vec 1) + x`] THEN REWRITE_TAC[VECTOR_VARIATION_TRANSLATION_INTERVAL] THEN REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ARITH `a + x - a:real^1 = x`] THEN REWRITE_TAC[VECTOR_ARITH `a - x + x:real^N = a`] THEN REWRITE_TAC[VECTOR_ARITH `a - x + x - a:real^N = vec 0`] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC]);; let PATH_LENGTH_POS_LE = prove (`!g:real^1->real^N. rectifiable_path g ==> &0 <= path_length g`, SIMP_TAC[rectifiable_path; path_length; VECTOR_VARIATION_POS_LE]);; let PATH_LENGTH_EQ_0 = prove (`!g:real^1->real^N. rectifiable_path g ==> (path_length g = &0 <=> ?c. !t. t IN interval[vec 0,vec 1] ==> g t = c)`, SIMP_TAC[VECTOR_VARIATION_CONST_EQ; rectifiable_path; path_length; IS_INTERVAL_INTERVAL]);; let PATH_LENGTH_JOIN = prove (`!g1 g2:real^1->real^N. rectifiable_path g1 /\ rectifiable_path g2 /\ pathfinish g1 = pathstart g2 ==> path_length(g1 ++ g2) = path_length g1 + path_length g2`, REPEAT STRIP_TAC THEN REWRITE_TAC[path_length] THEN MP_TAC(ISPECL [`g1 ++ g2:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; `lift(&1 / &2)`] VECTOR_VARIATION_COMBINE) THEN REWRITE_TAC[DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL [ASM_MESON_TAC[rectifiable_path; RECTIFIABLE_PATH_JOIN_IMP]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vector_variation (interval [vec 0,lift (&1 / &2)]) (\x. (g1:real^1->real^N)(&2 % x)) + vector_variation (interval [lift (&1 / &2),vec 1]) (\x. (g2:real^1->real^N)(&2 % x - vec 1))` THEN CONJ_TAC THENL [BINOP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; joinpaths] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathfinish; pathstart]) THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `&2 % x - vec 1:real^1 = vec 0 /\ &2 % x = vec 1` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x:real^N = &2 % x + vec 0`] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(&2 % x + vec 0) - v:real^N = &2 % x + --v`] THEN REWRITE_TAC[VECTOR_VARIATION_AFFINITY; IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ; GSYM DROP_EQ] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP; DROP_VEC; DROP_NEG] THEN REAL_ARITH_TAC]);; let PATH_LENGTH_COMBINE = prove (`!g:real^1->real^N t. rectifiable_path g /\ t IN interval[vec 0,vec 1] ==> path_length(subpath (vec 0) t g) + path_length(subpath t (vec 1) g) = path_length g`, REWRITE_TAC[PATH_LENGTH_SUBPATH] THEN SIMP_TAC[IN_INTERVAL_1; SEGMENT_1; path_length] THEN SIMP_TAC[rectifiable_path; VECTOR_VARIATION_COMBINE]);; let RECTIFIABLE_PATH_COMBINE = prove (`!g:real^1->real^N t. t IN interval[vec 0,vec 1] ==> (rectifiable_path g <=> rectifiable_path(subpath (vec 0) t g) /\ rectifiable_path(subpath t (vec 1) g))`, REPEAT STRIP_TAC THEN REWRITE_TAC[RECTIFIABLE_PATH_SUBPATH_EQ] THEN REWRITE_TAC[rectifiable_path] THEN MATCH_MP_TAC(TAUT `(p <=> p0 /\ p1) /\ (g <=> g0 /\ g1) ==> (p /\ g <=> (p0 /\ g0) /\ (p1 /\ g1))`) THEN ASM_SIMP_TAC[GSYM PATH_COMBINE] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[SEGMENT_1; DROP_VEC] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_COMBINE THEN ASM_REWRITE_TAC[DROP_VEC]);; let LIPSCHITZ_IMP_RECTIFIABLE_PATH = prove (`!g:real^1->real^N b. (!x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] ==> norm(g x - g y) <= b * norm(x - y)) ==> rectifiable_path g`, REPEAT STRIP_TAC THEN REWRITE_TAC[rectifiable_path] THEN CONJ_TAC THENL [REWRITE_TAC[path] THEN ASM_MESON_TAC[LIPSCHITZ_IMP_CONTINUOUS_ON]; ASM_MESON_TAC[LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION; BOUNDED_INTERVAL]]);; let PATH_LENGTH_LIPSCHITZ = prove (`!g:real^1->real^N b. (!x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] ==> norm(g x - g y) <= b * norm(x - y)) ==> path_length g <= b`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] VECTOR_VARIATION_LIPSCHITZ)) THEN REWRITE_TAC[path_length; DROP_VEC] THEN REAL_ARITH_TAC);; let DIST_POINTS_LE_PATH_LENGTH = prove (`!g:real^1->real^N a b. rectifiable_path g /\ a IN interval[vec 0,vec 1] /\ b IN interval[vec 0,vec 1] ==> dist (g a,g b) <= path_length g`, REWRITE_TAC[rectifiable_path] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[dist; path_length] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; CONVEX_INTERVAL; EMPTY_SUBSET]);; let DIST_ENDPOINTS_LE_PATH_LENGTH = prove (`!g:real^1->real^N. rectifiable_path g ==> dist(pathstart g,pathfinish g) <= path_length g`, REPEAT STRIP_TAC THEN REWRITE_TAC[pathstart; pathfinish] THEN MATCH_MP_TAC DIST_POINTS_LE_PATH_LENGTH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]);; let PATH_LENGTH_EQ_LINE_SEGMENT = prove (`!g:real^1->real^N. rectifiable_path g /\ path_length g = dist(pathstart g,pathfinish g) ==> path_image g = segment[pathstart g,pathfinish g]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(s SUBSET t ==> s = t) /\ s SUBSET t ==> s = t`) THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CONNECTED_SUBSET_SEGMENT THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; RECTIFIABLE_PATH_IMP_PATH]; ALL_TAC] THEN REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; `t:real^1`] VECTOR_VARIATION_COMBINE) THEN RULE_ASSUM_TAC(REWRITE_RULE[rectifiable_path; path_length]) THEN ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->real^N`; `interval[vec 0:real^1,t]`; `vec 0:real^1`; `t:real^1`] VECTOR_VARIATION_GE_NORM_FUNCTION) THEN ASM_REWRITE_TAC[SEGMENT_1; pathstart; pathfinish; SUBSET_REFL] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^1->real^N`; `interval[t:real^1,vec 1]`; `t:real^1`; `vec 1:real^1`] VECTOR_VARIATION_GE_NORM_FUNCTION) THEN ASM_REWRITE_TAC[SEGMENT_1; pathstart; pathfinish; SUBSET_REFL] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL]; CONV_TAC NORM_ARITH]);; let PATH_LENGTH_SUBPATH_LE = prove (`!g:real^1->real^N s t. rectifiable_path g /\ s IN interval[vec 0,vec 1] /\ t IN interval[vec 0,vec 1] ==> path_length (subpath s t g) <= path_length g`, REWRITE_TAC[path_length; rectifiable_path; subpath; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN DISJ_CASES_TAC(REAL_ARITH `drop s <= drop t \/ drop t <= drop s`) THENL [W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_COMPOSE_INCREASING o lhand o snd); W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_COMPOSE_DECREASING o lhand o snd)] THEN ASM_REWRITE_TAC[o_DEF; DROP_ADD; DROP_CMUL; DROP_SUB; LIFT_SUB; LIFT_DROP; VECTOR_MUL_RZERO; VECTOR_ADD_RID; GSYM LIFT_EQ_CMUL] THEN ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_LMUL; REAL_SUB_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `(t - s) * y <= (t - s) * x <=> (s - t) * x <= (s - t) * y`] THEN ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_LMUL; REAL_SUB_LE] THEN REWRITE_TAC[VECTOR_ARITH `s + t - s:real^N = t`] THEN (ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL; LIFT_DROP; DROP_VEC]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)]) THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL; LIFT_DROP; DROP_VEC]);; let RECTIFIABLE_PATH_IMAGE_SUBSET_CBALL = prove (`!g:real^1->real^N. rectifiable_path g ==> path_image g SUBSET cball(pathstart g,path_length g)`, GEN_TAC THEN REWRITE_TAC[pathstart; path_length] THEN REWRITE_TAC[rectifiable_path; path_image; FORALL_IN_IMAGE; SUBSET] THEN STRIP_TAC THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; IN_CBALL; DROP_VEC] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `vector_variation(interval[vec 0,t]) (g:real^1->real^N)` THEN CONJ_TAC THENL [REWRITE_TAC[dist] THEN MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL; LIFT_DROP; DROP_VEC]; REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL; LIFT_DROP; DROP_VEC]]; MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; REAL_LE_REFL]]);; let PATH_LENGTH_LINEPATH = prove (`!a b:real^N. path_length(linepath(a,b)) = dist(a,b)`, REWRITE_TAC[path_length; linepath] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % b:real^N = a + x % (b - a)`; VECTOR_VARIATION_TRANSLATION] THEN SIMP_TAC[VECTOR_VARIATION_VMUL; LIFT_DROP; HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL; VECTOR_VARIATION_ID] THEN REWRITE_TAC[dist; UNIT_INTERVAL_NONEMPTY; DROP_VEC] THEN REWRITE_TAC[NORM_SUB] THEN REAL_ARITH_TAC);; let RECTIFIABLE_PATH_REPARAMETRIZATION = prove (`!g:real^1->real^N h h'. rectifiable_path g /\ homeomorphism (interval[vec 0,vec 1],interval[vec 0,vec 1]) (h,h') ==> rectifiable_path(g o h)`, REWRITE_TAC[rectifiable_path] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; path]) THEN ASM_MESON_TAC[]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_HOMEOMORPHISM THEN EXISTS_TAC `h':real^1->real^1` THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL]]);; let PATH_LENGTH_REPARAMETRIZATION = prove (`!g:real^1->real^N h h'. rectifiable_path g /\ homeomorphism (interval[vec 0,vec 1],interval[vec 0,vec 1]) (h,h') ==> path_length (g o h) = path_length g`, REWRITE_TAC[rectifiable_path; path_length] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_COMPOSE_HOMEOMORPHISM THEN EXISTS_TAC `h':real^1->real^1` THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL]);; let ARC_LENGTH_UNIQUE = prove (`!g h:real^1->real^N. rectifiable_path g /\ arc g /\ rectifiable_path h /\ arc h /\ path_image g = path_image h ==> path_length g = path_length h`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHISM_ARC) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h':real^N->real^1` THEN DISCH_TAC THEN MP_TAC(ISPEC `g:real^1->real^N` HOMEOMORPHISM_ARC) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g':real^N->real^1` THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `path_length((g:real^1->real^N) o g' o (h:real^1->real^N))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_LENGTH_REPARAMETRIZATION THEN EXISTS_TAC `(h':real^N->real^1) o (g:real^1->real^N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; MATCH_MP_TAC PATH_LENGTH_EQ THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; path_image]) THEN REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);; let CONTINUOUS_ON_PATH_LENGTH_SUBPATH_RIGHT = prove (`!g:real^1->real^N a. rectifiable_path g /\ a IN interval[vec 0,vec 1] ==> (\x. lift(path_length(subpath a x g))) continuous_on interval[vec 0,vec 1]`, REWRITE_TAC[rectifiable_path] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\x. lift(abs(path_length(subpath (vec 0) x (g:real^1->real^N)) - path_length(subpath (vec 0) a g)))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `b:real^1` THEN DISCH_TAC THEN REWRITE_TAC[PATH_LENGTH_SUBPATH] THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[SEGMENT_1; DROP_VEC] THEN COND_CASES_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= c /\ a + c = b ==> abs(b - a) = c`); MATCH_MP_TAC(REAL_ARITH `&0 <= c /\ a + c = b ==> abs(a - b) = c`)] THEN (CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_POS_LE; MATCH_MP_TAC VECTOR_VARIATION_COMBINE]) THEN ASM_SIMP_TAC[DROP_VEC; REAL_ARITH `~(a <= b) ==> b <= a`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_ABS THEN REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST; PATH_LENGTH_SUBPATH] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `b:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN EXISTS_TAC `\x. lift (vector_variation(interval[vec 0,x]) (g:real^1->real^N))` THEN EXISTS_TAC `&1` THEN SIMP_TAC[SEGMENT_1; IN_INTERVAL_1; REAL_LT_01] THEN ASM_REWRITE_TAC[GSYM IN_INTERVAL_1] THEN ASM_SIMP_TAC[VECTOR_VARIATION_CONTINUOUS] THEN RULE_ASSUM_TAC(REWRITE_RULE[path; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN ASM_SIMP_TAC[]);; let CONTINUOUS_ON_PATH_LENGTH_SUBPATH_LEFT = prove (`!g:real^1->real^N a. rectifiable_path g /\ a IN interval[vec 0,vec 1] ==> (\x. lift(path_length(subpath x a g))) continuous_on interval[vec 0,vec 1]`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REVERSEPATH_SUBPATH] THEN ONCE_REWRITE_TAC[PATH_LENGTH_REVERSEPATH] THEN ASM_SIMP_TAC[CONTINUOUS_ON_PATH_LENGTH_SUBPATH_RIGHT]);; (* ------------------------------------------------------------------------- *) (* Arc length reparametrization, and existence of shortest paths. *) (* ------------------------------------------------------------------------- *) let ARC_LENGTH_REPARAMETRIZATION = prove (`!g:real^1->real^N. rectifiable_path g ==> ?h. rectifiable_path h /\ path_image h = path_image g /\ pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ path_length h = path_length g /\ (arc g ==> arc h) /\ (simple_path g ==> simple_path h) /\ (!t. t IN interval[vec 0,vec 1] ==> path_length(subpath (vec 0) t h) = path_length g * drop t) /\ (!x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] ==> dist(h x,h y) <= path_length g * dist(x,y))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; `lift(path_length(g:real^1->real^N))`] FACTOR_CONTINUOUS_THROUGH_VARIATION) THEN REWRITE_TAC[LIFT_DROP; DROP_VEC; REAL_POS] THEN ANTS_TAC THENL [REWRITE_TAC[path_length] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [rectifiable_path]) THEN SIMP_TAC[path]; DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) STRIP_ASSUME_TAC)] THEN ABBREV_TAC `l = path_length(g:real^1->real^N)` THEN SUBGOAL_THEN `&0 <= l` ASSUME_TAC THENL [ASM_MESON_TAC[PATH_LENGTH_POS_LE]; ALL_TAC] THEN EXISTS_TAC `(h:real^1->real^N) o (\x. l % x)` THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[rectifiable_path] THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN SIMP_TAC[path; path_image; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_LIFT] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `l * x <= l <=> l * x <= l * &1`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_LMUL]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_INCREASING THEN ASM_SIMP_TAC[DROP_CMUL; REAL_LE_LMUL] THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO] THEN MATCH_MP_TAC LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION THEN EXISTS_TAC `&1` THEN REWRITE_TAC[BOUNDED_INTERVAL; REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM dist]]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[path_image; IMAGE_o] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) CONTINUOUS_INCREASING_IMAGE_INTERVAL_1 o lhand o snd) THEN ASM_SIMP_TAC[DROP_CMUL; REAL_LE_LMUL; UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]; DISCH_TAC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[pathstart; pathfinish; o_DEF; VECTOR_MUL_RZERO] THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (rand o rand) th o rand o snd)) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[GSYM path_length; GSYM LIFT_EQ_CMUL] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN MATCH_MP_TAC VECTOR_VARIATION_ON_NULL THEN REWRITE_TAC[BOUNDED_INTERVAL; CONTENT_EQ_0_1; REAL_LE_REFL]; STRIP_TAC] THEN MATCH_MP_TAC(TAUT `(s ==> a) /\ s /\ (q ==> p) /\ r /\ q ==> p /\ a /\ s /\ q /\ r`) THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[ARC_SIMPLE_PATH]; REWRITE_TAC[simple_path] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[rectifiable_path]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `~(l = &0)` ASSUME_TAC THENL [EXPAND_TAC "l" THEN ASM_SIMP_TAC[PATH_LENGTH_EQ_0] THEN DISCH_THEN(CHOOSE_THEN (fun th -> FIRST_X_ASSUM(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]) THEN MP_TAC(SPEC `lift(&0)` th) THEN MP_TAC(SPEC `lift(&1 / &2)` th))) THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN SIMP_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(l % x) IN interval[vec 0:real^1,lift l] /\ (l % y) IN interval[vec 0:real^1,lift l]` MP_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; LIFT_DROP; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]); FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[IN_IMAGE; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x':real^1` THEN REPEAT DISCH_TAC THEN X_GEN_TAC `y':real^1` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x':real^1`; `y':real^1`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `l:real` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_OR THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `l:real` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; GSYM path_length; LIFT_EQ_CMUL] THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_ON_NULL THEN REWRITE_TAC[BOUNDED_INTERVAL; CONTENT_EQ_0_1; REAL_LE_REFL]]]; DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; SUBPATH_TRIVIAL] THEN REWRITE_TAC[DROP_VEC; REAL_MUL_RID]; MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`l % x:real^1`; `l % y:real^1`]) THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; IN_INTERVAL_1; DROP_VEC] THEN ASM_REWRITE_TAC[DROP_CMUL; LIFT_DROP; NORM_MUL; real_abs] THEN DISCH_THEN MATCH_MP_TAC; X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; o_DEF] THEN STRIP_TAC THEN REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN REWRITE_TAC[path_length; VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a % x:real^N = a % x + vec 0`] THEN REWRITE_TAC[VECTOR_VARIATION_AFFINITY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN ASM_SIMP_TAC[UNIT_INTERVAL_NONEMPTY; REAL_LE_MUL] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; GSYM LIFT_EQ_CMUL] THEN REWRITE_TAC[LIFT_CMUL; LIFT_DROP; GSYM DROP_CMUL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; LIFT_DROP; DROP_VEC]] THEN ASM_SIMP_TAC[REAL_LE_MUL] THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `l * x <= l <=> l * x <= l * &1`]);; let SHORTEST_PATH_EXISTS_GEN = prove (`!P. (!h g. (!n. rectifiable_path(h n) /\ P (path_image(h n)) (pathstart(h n)) (pathfinish(h n))) /\ (!e. &0 < e ==> ?N. !n:num x. n >= N /\ x IN interval[vec 0,vec 1] ==> norm (h n x - g x) < e) ==> P(path_image g) (pathstart g) (pathfinish g)) /\ (?t. bounded t /\ !g. rectifiable_path g /\ P (path_image g) (pathstart g) (pathfinish g) ==> ~DISJOINT t (convex hull (path_image g))) /\ (?g. rectifiable_path g /\ P (path_image g) (pathstart g) (pathfinish g)) ==> ?g. rectifiable_path g /\ P (path_image g) (pathstart g) (pathfinish g) /\ !h. rectifiable_path h /\ P (path_image h) (pathstart h) (pathfinish h) ==> path_length(g:real^1->real^N) <= path_length h`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(SPEC `{path_length g | rectifiable_path g /\ P (path_image(g:real^1->real^N)) (pathstart g) (pathfinish g)}` INF) THEN ABBREV_TAC `l = inf{path_length g | rectifiable_path g /\ P (path_image(g:real^1->real^N)) (pathstart g) (pathfinish g)}` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; FORALL_IN_GSPEC] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [ASM_MESON_TAC[PATH_LENGTH_POS_LE]; STRIP_TAC] THEN SUBGOAL_THEN `&0 <= l` ASSUME_TAC THENL [ASM_MESON_TAC[PATH_LENGTH_POS_LE]; ALL_TAC] THEN SUBGOAL_THEN `!n. ?g. rectifiable_path g /\ P (path_image(g:real^1->real^N)) (pathstart g) (pathfinish g) /\ path_length g < l + inv(&n + &1) /\ !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] ==> dist(g x,g y) <= (l + &1) * dist(x,y)` MP_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `l + inv(&n + &1)`) THEN REWRITE_TAC[REAL_ARITH `l + i <= l <=> ~(&0 < i)`; REAL_LT_INV_EQ] THEN REWRITE_TAC[ARITH_RULE `&0 < &n + &1`; NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `g:real^1->real^N` ARC_LENGTH_REPARAMETRIZATION) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[DIST_POS_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `g < l + i ==> i <= &1 ==> g <= l + &1`)) THEN MATCH_MP_TAC REAL_LE_LINV THEN REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `h:num->real^1->real^N` THEN STRIP_TAC] THEN SUBGOAL_THEN `?B. !n x. x IN interval[vec 0,vec 1] ==> norm((h:num->real^1->real^N) n x) <= B` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "!")) THEN REWRITE_TAC[bounded; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN DISCH_TAC THEN EXISTS_TAC `B + l + &1` THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN DISCH_TAC THEN REMOVE_THEN "!" (MP_TAC o SPEC `(h:num->real^1->real^N) n`) THEN ASM_REWRITE_TAC[SET_RULE `~DISJOINT s t <=> ?x. x IN s /\ x IN t`] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `y IN cball((h:num->real^1->real^N) n x,l + &1)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a IN s ==> s SUBSET t ==> a IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CBALL; SUBSET; IN_CBALL] THEN REWRITE_TAC[path_image; FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^1`; `z:real^1`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[DIST_REAL; GSYM drop] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_CBALL] THEN MATCH_MP_TAC(NORM_ARITH `norm(y:real^N) <= B ==> dist(x,y) <= l ==> norm(x) <= B + l`) THEN ASM_SIMP_TAC[]]; ALL_TAC] THEN MP_TAC(ISPECL [`h:num->real^1->real^N`; `interval[vec 0:real^1,vec 1]`; `B:real`] ARZELA_ASCOLI) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `e:real`] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN EXISTS_TAC `e / (l + &1)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^1`; `y:real^1`]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; dist] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ARITH `&0 <= l ==> &0 < l + &1`]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC))] THEN SUBGOAL_THEN `!n. (g:real^1->real^N) has_bounded_variation_on interval[vec 0,vec 1] /\ vector_variation (interval[vec 0,vec 1]) g <= l + inv(&n + &1)` MP_TAC THENL [X_GEN_TAC `N:num` THEN MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_UNIFORM_LIM THEN EXISTS_TAC `\n:num. (h:num->real^1->real^N) (r(N + n))` THEN RULE_ASSUM_TAC(REWRITE_RULE[rectifiable_path]) THEN ASM_REWRITE_TAC[GSYM path_length] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN TRANS_TAC REAL_LE_TRANS `l + inv(&((r:num->num)(N + n)) + &1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[REAL_LE_RADD]] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN TRANS_TAC LE_TRANS `N + n:num` THEN REWRITE_TAC[LE_ADD] THEN ASM_SIMP_TAC[MONOTONE_BIGGER]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(\n:num. (h:num->real^1->real^N) (r(N + n)) x) = (\n. h (r n) x) o (\n. N + n)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_DEF]; ALL_TAC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN REWRITE_TAC[LT_ADD_LCANCEL; LIM_SEQUENTIALLY; dist] THEN ASM_MESON_TAC[GE]]; REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[rectifiable_path; path]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n:num. (h:num->real^1->real^N) (r n)` THEN ASM_REWRITE_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `path_length(g:real^1->real^N) = l` (fun th -> ASM_SIMP_TAC[th]) THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM] THEN REWRITE_TAC[REAL_ARITH `g <= l <=> ~(&0 < g - l)`] THEN ONCE_REWRITE_TAC[REAL_ARCH_INV] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC; REAL_LT_INV_EQ] THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; LT_0; path_length; GSYM REAL_OF_NUM_SUC; ARITH_RULE `i < p - l <=> ~(p <= l + i)`]);; let SHORTEST_PATH_EXISTS_STRADDLE = prove (`!s t a b:real^N->bool. closed s /\ compact a /\ compact b /\ (?g. rectifiable_path g /\ t SUBSET path_image g /\ path_image g SUBSET s /\ pathstart g IN a /\ pathfinish g IN b) ==> ?g. rectifiable_path g /\ t SUBSET path_image g /\ path_image g SUBSET s /\ pathstart g IN a /\ pathfinish g IN b /\ !h. rectifiable_path h /\ t SUBSET path_image h /\ path_image h SUBSET s /\ pathstart h IN a /\ pathfinish h IN b ==> path_length g <= path_length h`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t /\ u <=> p /\ (q /\ r /\ s /\ t) /\ u`] THEN MATCH_MP_TAC SHORTEST_PATH_EXISTS_GEN THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!n. ?t. t IN interval[vec 0,vec 1] /\ (h:num->real^1->real^N) n t = y` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `x:num->real^1` THEN STRIP_TAC THEN MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]` compact) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^1`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^1`; `r:num->num`] THEN STRIP_TAC THEN REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `l:real^1` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (h:num->real^1->real^N) (r n) (x(r n)) - g(x(r n))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST] THEN SUBGOAL_THEN `(g:real^1->real^N) continuous (at l within interval[vec 0,vec 1])` MP_TAC THENL [SUBGOAL_THEN `(g:real^1->real^N) continuous_on interval[vec 0,vec 1]` MP_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN EXISTS_TAC `h:num->real^1->real^N` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[rectifiable_path; path; GE]; ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]]; REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `(x:num->real^1) o (r:num->num)`) THEN ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[o_DEF]]; REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE] THEN TRANS_TAC LE_TRANS `n:num` THEN ASM_MESON_TAC[MONOTONE_BIGGER]]; REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM CLOSURE_EQ]) THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `&0 < e`)) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[GE; LE_REFL; dist] THEN DISCH_TAC THEN EXISTS_TAC `(h:num->real^1->real^N) n x` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; path_image; FORALL_IN_IMAGE]) THEN ASM_SIMP_TAC[]; MATCH_MP_TAC(ISPEC `sequentially` LIM_IN_CLOSED_SET) THEN EXISTS_TAC `\n. (h:num->real^1->real^N) n (vec 0)` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_MESON_TAC[pathstart]; REWRITE_TAC[pathstart; tendsto]] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; dist; GSYM GE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]; MATCH_MP_TAC(ISPEC `sequentially` LIM_IN_CLOSED_SET) THEN EXISTS_TAC `\n. (h:num->real^1->real^N) n (vec 1)` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_MESON_TAC[pathfinish]; REWRITE_TAC[pathfinish; tendsto]] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; dist; GSYM GE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]; EXISTS_TAC `a:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a IN t ==> s SUBSET convex hull s /\ a IN s ==> ~DISJOINT t (convex hull s)`)) THEN REWRITE_TAC[HULL_SUBSET] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; RECTIFIABLE_PATH_IMP_PATH]]);; let SHORTEST_PATH_EXISTS = prove (`!s a b:real^N->bool. closed s /\ compact a /\ compact b /\ (?g. rectifiable_path g /\ path_image g SUBSET s /\ pathstart g IN a /\ pathfinish g IN b) ==> ?g. rectifiable_path g /\ path_image g SUBSET s /\ pathstart g IN a /\ pathfinish g IN b /\ !h. rectifiable_path h /\ path_image h SUBSET s /\ pathstart h IN a /\ pathfinish h IN b ==> path_length g <= path_length h`, ONCE_REWRITE_TAC[SET_RULE `s SUBSET t <=> {} SUBSET s /\ s SUBSET t`] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN REWRITE_TAC[SHORTEST_PATH_EXISTS_STRADDLE]);; let SHORTEST_ARC_EXISTS = prove (`!s a b:real^N. closed s /\ ~(a = b) /\ (?g. rectifiable_path g /\ path_image g SUBSET s /\ pathstart g = a /\ pathfinish g = b) ==> ?g. rectifiable_path g /\ arc g /\ path_image g SUBSET s /\ pathstart g = a /\ pathfinish g = b /\ !h. rectifiable_path h /\ path_image h SUBSET s /\ pathstart h = a /\ pathfinish h = b ==> path_length g <= path_length h`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `{a:real^N}`; `{b:real^N}`] SHORTEST_PATH_EXISTS) THEN ASM_REWRITE_TAC[COMPACT_SING; IN_SING] THEN FIRST_X_ASSUM(K ALL_TAC o check is_exists o concl) THEN DISCH_THEN(X_CHOOSE_THEN `f:real^1->real^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ARC_LENGTH_REPARAMETRIZATION) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[arc; RECTIFIABLE_PATH_IMP_PATH] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `subpath (vec 0) a (g:real^1->real^N) ++ subpath b (vec 1) g`) THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> q) ==> r`) THEN REWRITE_TAC[REAL_NOT_LE] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[RECTIFIABLE_PATH_JOIN; PATHFINISH_SUBPATH; PATHSTART_SUBPATH] THEN CONJ_TAC THEN MATCH_MP_TAC RECTIFIABLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC THEN TRANS_TAC SUBSET_TRANS `path_image (g:real^1->real^N)` THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN ASM_SIMP_TAC[RECTIFIABLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL]; REWRITE_TAC[PATHSTART_JOIN; PATHSTART_SUBPATH] THEN ASM_MESON_TAC[pathstart]; REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_SUBPATH] THEN ASM_MESON_TAC[pathfinish]; MP_TAC(ISPECL [`g:real^1->real^N`; `b:real^1`] PATH_LENGTH_COMBINE) THEN ASM_SIMP_TAC[PATH_LENGTH_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; RECTIFIABLE_PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[REAL_LT_RADD] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_SIMP_TAC[REAL_LT_LE; PATH_LENGTH_POS_LE] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_SIMP_TAC[PATH_LENGTH_EQ_0] THEN DISCH_THEN(CHOOSE_THEN (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th))) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[pathstart; pathfinish]]);; let ARC_LENGTH_MINIMAL = prove (`!g h:real^1->real^N. rectifiable_path g /\ arc g /\ rectifiable_path h /\ path_image g = path_image h ==> path_length g <= path_length h`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`path_image g:real^N->bool`; `pathstart g:real^N`; `pathfinish g:real^N`] SHORTEST_ARC_EXISTS) THEN ASM_SIMP_TAC[CLOSED_PATH_IMAGE; RECTIFIABLE_PATH_IMP_PATH] THEN ASM_SIMP_TAC[ARC_DISTINCT_ENDS] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^1->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`k:real^1->real^N`; `g:real^1->real^N`] ARC_IMAGE_UNIQUE) THEN ANTS_TAC THENL [ASM_MESON_TAC[ARC_IMP_PATH; SUBSET_REFL]; DISCH_TAC] THEN MP_TAC(ISPECL [`g:real^1->real^N`; `k:real^1->real^N`] ARC_LENGTH_UNIQUE) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `(pathstart g:real^N) IN path_image h /\ pathfinish g IN path_image h` MP_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; RECTIFIABLE_PATH_IMP_PATH]; REWRITE_TAC[path_image; IN_IMAGE; IMP_CONJ; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `s:real^1` THEN REPEAT DISCH_TAC THEN X_GEN_TAC `t:real^1` THEN REPEAT DISCH_TAC THEN DISJ_CASES_TAC(REAL_ARITH `drop s <= drop t \/ drop t <= drop s`) THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `path_length(subpath s t (h:real^1->real^N))`; EXISTS_TAC `path_length(subpath t s (h:real^1->real^N))`] THEN ASM_SIMP_TAC[PATH_LENGTH_SUBPATH_LE] THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [GSYM PATH_LENGTH_REVERSEPATH] THEN REWRITE_TAC[REVERSEPATH_SUBPATH]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; RECTIFIABLE_PATH_IMP_PATH; RECTIFIABLE_PATH_SUBPATH]);; let SIMPLE_PATH_LENGTH_MINIMAL = prove (`!g h:real^1->real^N. rectifiable_path g /\ simple_path g /\ rectifiable_path h /\ path_image g = path_image h ==> path_length g <= path_length h`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `pathfinish g:real^N = pathstart g` THEN ASM_SIMP_TAC[ARC_LENGTH_MINIMAL; ARC_SIMPLE_PATH] THEN MP_TAC(ISPECL [`path_image g:real^N->bool`; `path_image g:real^N->bool`; `path_image g:real^N->bool`; `path_image g:real^N->bool`] SHORTEST_PATH_EXISTS_STRADDLE) THEN REWRITE_TAC[SET_RULE `s SUBSET t /\ t SUBSET s /\ p <=> t = s /\ p`] THEN ASM_SIMP_TAC[CLOSED_PATH_IMAGE; RECTIFIABLE_PATH_IMP_PATH; COMPACT_PATH_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; REWRITE_TAC[MESON[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE] `rectifiable_path k /\ path_image k = path_image h /\ pathstart k IN path_image h /\ pathfinish k IN path_image h <=> rectifiable_path k /\ path_image k = path_image h`] THEN DISCH_THEN(X_CHOOSE_THEN `h':real^1->real^N` STRIP_ASSUME_TAC)] THEN TRANS_TAC REAL_LE_TRANS `path_length(h':real^1->real^N)` THEN ASM_SIMP_TAC[] THEN UNDISCH_THEN `path_image(g:real^1->real^N) = path_image h` (SUBST_ALL_TAC o SYM) THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `h:real^1->real^N`) o concl)) THEN MP_TAC(ISPEC `h':real^1->real^N` ARC_LENGTH_REPARAMETRIZATION) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT(POP_ASSUM MP_TAC) THEN REPEAT DISCH_TAC THEN X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN UNDISCH_THEN `path_length(h:real^1->real^N) = path_length(h':real^1->real^N)` (SUBST_ALL_TAC o SYM) THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `h':real^1->real^N`) o concl)) THEN SUBGOAL_THEN `(h:real^1->real^N) (vec 1) IN path_image h` MP_TAC THENL [REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image; IN_IMAGE; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN ABBREV_TAC `g':real^1->real^N = shiftpath (lift(&1 / &2)) (shiftpath t g)` THEN SUBGOAL_THEN `g'(lift(&1 / &2)) = (h:real^1->real^N)(vec 1)` ASSUME_TAC THENL [EXPAND_TAC "g'" THEN REWRITE_TAC[shiftpath; DROP_ADD; LIFT_DROP; DROP_SUB; DROP_VEC] THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= t ==> (t + &1 <= &1 <=> t = &0)`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_ADD; GSYM LIFT_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM; VECTOR_ADD_RID] THEN ASM_MESON_TAC[pathstart; pathfinish]; ALL_TAC] THEN SUBGOAL_THEN `rectifiable_path(g':real^1->real^N)` ASSUME_TAC THENL [EXPAND_TAC "g'" THEN MATCH_MP_TAC RECTIFIABLE_PATH_SHIFTPATH THEN ASM_SIMP_TAC[CLOSED_SHIFTPATH; RECTIFIABLE_PATH_SHIFTPATH] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `simple_path(g':real^1->real^N)` ASSUME_TAC THENL [EXPAND_TAC "g'" THEN MATCH_MP_TAC SIMPLE_PATH_SHIFTPATH THEN ASM_SIMP_TAC[CLOSED_SHIFTPATH; SIMPLE_PATH_SHIFTPATH] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `pathfinish g':real^N = pathstart g'` ASSUME_TAC THENL [EXPAND_TAC "g'" THEN MATCH_MP_TAC CLOSED_SHIFTPATH THEN ASM_SIMP_TAC[CLOSED_SHIFTPATH] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `path_image g':real^N->bool = path_image g` (SUBST_ALL_TAC o SYM) THENL [EXPAND_TAC "g'" THEN W(MP_TAC o PART_MATCH (lhand o rand) PATH_IMAGE_SHIFTPATH o lhand o snd) THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; CLOSED_SHIFTPATH]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `path_length(g':real^1->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN EXPAND_TAC "g'" THEN W(MP_TAC o PART_MATCH (lhand o rand) PATH_LENGTH_SHIFTPATH o lhand o snd) THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[RECTIFIABLE_PATH_SHIFTPATH; CLOSED_SHIFTPATH] THEN ASM_SIMP_TAC[PATH_LENGTH_SHIFTPATH]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `g:real^1->real^N`) o concl)) THEN REPEAT(POP_ASSUM MP_TAC) THEN SPEC_TAC(`g':real^1->real^N`,`g:real^1->real^N`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `(a < b ==> b <= a) ==> b <= a`) THEN DISCH_TAC THEN SUBGOAL_THEN `!e. &0 < e ==> ?d. &0 < d /\ !a. a IN interval[vec 0,vec 1] /\ dist(g a,(h:real^1->real^N)(vec 1)) < d ==> dist(a,lift(&1 / &2)) < e` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x y. x IN interval[lift(&1 / &4),lift(&3 / &4)] /\ y IN interval[lift(&1 / &4),lift(&3 / &4)] /\ (g:real^1->real^N) x = g y ==> x = y` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^1` THEN ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC; REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE]] THEN DISCH_THEN(X_CHOOSE_TAC `g':real^N->real^1`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] CONTINUOUS_ON_INVERSE))) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path; RECTIFIABLE_PATH_IMP_PATH] THEN REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[continuous_on; FORALL_IN_IMAGE; IMP_CONJ] THEN DISCH_THEN(MP_TAC o SPEC `lift(&1 / &2)`) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV; DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[IMP_IMP]] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?d2. &0 < d2 /\ !x. x IN IMAGE (g:real^1->real^N) (interval[vec 0,lift(&1 / &4)] UNION interval[lift(&3 / &4),vec 1]) ==> d2 <= dist(x,g(lift(&1 / &2)))` MP_TAC THENL [ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC SEPARATE_POINT_CLOSED THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN SIMP_TAC[COMPACT_INTERVAL; COMPACT_UNION] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path; RECTIFIABLE_PATH_IMP_PATH] THEN SIMP_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN X_GEN_TAC `x:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `lift(&1 / &2)`]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTERVAL_1; IN_UNION; GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC]; ASM_REWRITE_TAC[FORALL_IN_IMAGE]] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `x IN interval[lift(&1 / &4),lift(&3 / &4)]` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_UNION; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; LIFT_DROP; DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?d. &0 < d /\ !a b. a IN interval[vec 0,vec 1] /\ b IN interval[vec 0,vec 1] /\ path_image(subpath a b g) SUBSET ball(h(vec 1:real^1),d) ==> path_length(subpath a b (g:real^1->real^N)) < (path_length g - path_length h) / &4` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`g:real^1->real^N`; `lift(&1 / &2)`] CONTINUOUS_ON_PATH_LENGTH_SUBPATH_RIGHT) THEN ASM_REWRITE_TAC[NOT_IMP] THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; REWRITE_TAC[CONTINUOUS_ON; LIM_SELF_WITHIN]] THEN DISCH_THEN(MP_TAC o SPEC `lift(&1 / &2)`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[PATH_LENGTH_SUBPATH; SEGMENT_REFL; VECTOR_VARIATION_SING] THEN REWRITE_TAC[GSYM PATH_LENGTH_SUBPATH; DIST_LIFT; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `(path_length(g:real^1->real^N) - path_length(h:real^1->real^N)) / &8`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < x / &8 <=> &0 < x`; REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REMOVE_THEN "*" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN TRANS_TAC REAL_LET_TRANS `path_length (subpath (lift(&1 / &2)) a (g:real^1->real^N)) + path_length (subpath (lift(&1 / &2)) b g)` THEN CONJ_TAC THENL [REWRITE_TAC[PATH_LENGTH_SUBPATH] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SEGMENT_SYM] THEN MATCH_MP_TAC VECTOR_VARIATION_SEGMENT_TRIANGLE THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[rectifiable_path]; MATCH_MP_TAC(REAL_ARITH `abs x < e / &8 /\ abs y < e / &8 ==> x + y < e / &4`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_BALL]) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[ENDS_IN_SEGMENT]]; ALL_TAC] THEN SUBGOAL_THEN `?q:real^1. q IN interval(vec 0,vec 1) /\ (!x. x IN interval[q,vec 1] ==> dist((h:real^1->real^N)(vec 1),h x) < d) /\ (!x y. x IN interval[vec 0,vec 1] /\ y IN interval[q,vec 1] /\ g x = h y ==> dist(x,lift(&1 / &2)) < &1 / &8)` STRIP_ASSUME_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `&1 / &8`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `path(h:real^1->real^N)` MP_TAC THENL [ASM_MESON_TAC[rectifiable_path]; REWRITE_TAC[path]] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; continuous_within] THEN DISCH_THEN(MP_TAC o SPEC `min d1 d:real`) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `vec 1 - lift(min d2 (&1) / &2)` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; LIFT_DROP] THEN REPEAT CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC(REAL_ARITH `x < d1 /\ x < d2 ==> x < d2`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DIST_1] THEN ASM_REAL_ARITH_TAC; MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN MATCH_MP_TAC(REAL_ARITH `x < d1 /\ x < d ==> x < d1`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DIST_1] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `q IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]; ALL_TAC] THEN ASM_CASES_TAC `path_length(h:real^1->real^N) = &0` THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH `h = &0 ==> (h = &0 ==> g = &0) ==> g <= h`)) THEN ASM_SIMP_TAC[PATH_LENGTH_EQ_0] THEN SIMP_TAC[UNIT_INTERVAL_NONEMPTY; SET_RULE `~(k = {}) ==> ((!t. t IN k ==> g t = a) <=> IMAGE g k = {a})`; GSYM path_image] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < path_length(h:real^1->real^N)` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_LE; PATH_LENGTH_POS_LE]; ALL_TAC] THEN SUBGOAL_THEN `path_image(subpath (vec 0) q (h:real^1->real^N)) PSUBSET path_image g` MP_TAC THENL [REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[PATH_IMAGE_SUBPATH_SUBSET; ENDS_IN_UNIT_INTERVAL; RECTIFIABLE_PATH_IMP_PATH]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `subpath (vec 0) q h:real^1->real^N`) THEN ASM_SIMP_TAC[RECTIFIABLE_PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL; RECTIFIABLE_PATH_IMP_PATH] THEN MATCH_MP_TAC(REAL_ARITH `h * q < h * &1 ==> ~(h <= h * q)`) THEN ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LT_LMUL_EQ]; REWRITE_TAC[PSUBSET_ALT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[path_image; EXISTS_IN_IMAGE] THEN REWRITE_TAC[GSYM path_image]] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1` STRIP_ASSUME_TAC) THEN ABBREV_TAC `k:real^1->real^N = shiftpath p g` THEN SUBGOAL_THEN `(g:real^1->real^N) p = pathstart k` SUBST_ALL_TAC THENL [ASM_MESON_TAC[PATHSTART_SHIFTPATH; IN_INTERVAL_1; DROP_VEC]; ALL_TAC] THEN SUBGOAL_THEN `pathfinish k:real^N = pathstart k` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_SHIFTPATH]; ALL_TAC] THEN SUBGOAL_THEN `simple_path(k:real^1->real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[SIMPLE_PATH_SHIFTPATH]; ALL_TAC] THEN SUBGOAL_THEN `rectifiable_path(k:real^1->real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[RECTIFIABLE_PATH_SHIFTPATH]; ALL_TAC] THEN SUBGOAL_THEN `path_length(k:real^1->real^N) = path_length(g:real^1->real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[PATH_LENGTH_SHIFTPATH]; ALL_TAC] THEN SUBGOAL_THEN `path_image(k:real^1->real^N) = path_image(g:real^1->real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[PATH_IMAGE_SHIFTPATH]; ALL_TAC] THEN MP_TAC(SPEC `{r | r IN interval[vec 0,vec 1] /\ (k:real^1->real^N) r IN path_image (subpath (vec 0) q h)}` CONNECTED_COMPACT_INTERVAL_1) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV; COMPACT_INTERVAL; SUBTOPOLOGY_UNIV] THEN ASM_SIMP_TAC[GSYM path; RECTIFIABLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL; GSYM CLOSED_IN; CLOSED_PATH_IMAGE; PATH_SUBPATH]; DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o ISPEC `k:real^1->real^N` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_COMPACT)) THEN DISCH_THEN(MP_TAC o SPEC `path_image (subpath (vec 0) q h):real^N->bool`) THEN REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path; RECTIFIABLE_PATH_IMP_PATH; SUBSET_RESTRICT]; MATCH_MP_TAC(SET_RULE `t SUBSET IMAGE f s ==> IMAGE f {x | x IN s /\ f x IN t} = t`) THEN ASM_REWRITE_TAC[GSYM path_image]; UNDISCH_TAC `simple_path(k:real^1->real^N)` THEN DISCH_THEN(MP_TAC o CONJUNCT2 o REWRITE_RULE[simple_path]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^1` THEN ASM_CASES_TAC `(k:real^1->real^N) x = k y` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_MESON_TAC[pathstart; pathfinish]]; DISCH_THEN(MP_TAC o MATCH_MP (MESON[homeomorphic] `(?g. homeomorphism (s,t) (f,g)) ==> s homeomorphic t`)) THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_CONNECTEDNESS) THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; RECTIFIABLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL; PATH_SUBPATH]]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `{r | r IN k /\ g r IN t} = i ==> ~(t = {}) /\ t SUBSET IMAGE g k ==> i SUBSET k /\ ~(i = {}) /\ t = IMAGE g i`)) THEN ASM_REWRITE_TAC[GSYM path_image; PATH_IMAGE_NONEMPTY] THEN STRIP_TAC THEN SUBGOAL_THEN `x IN interval[vec 0:real^1,vec 1] /\ y IN interval[vec 0:real^1,vec 1]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN RULE_ASSUM_TAC (REWRITE_RULE[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `x:real^1 = vec 0 \/ y:real^1 = vec 1` THENL [UNDISCH_TAC `path_image (subpath (vec 0) q h) = IMAGE (k:real^1->real^N) (interval [x,y])` THEN FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN MATCH_MP_TAC(SET_RULE `z IN i /\ ~(k a IN p) ==> z = a ==> p = IMAGE k i ==> Q`) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ASM_MESON_TAC[pathstart; pathfinish]; RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC)] THEN MATCH_MP_TAC(REAL_ARITH `(h < g ==> g <= h) ==> g <= h`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`subpath x y (k:real^1->real^N)`; `subpath (vec 0) q (h:real^1->real^N)`] ARC_LENGTH_MINIMAL) THEN ANTS_TAC THENL [ASM_SIMP_TAC[RECTIFIABLE_PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE [INTERVAL_NE_EMPTY_1; IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC] THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN CONJ_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN SUBGOAL_THEN `path_length (subpath (vec 0) q h:real^1->real^N) = &0` MP_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) PATH_LENGTH_EQ_0 o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[RECTIFIABLE_PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; REAL_POS]; DISCH_THEN SUBST1_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_SING; path_image]) THEN ASM SET_TAC[]; ASM_SIMP_TAC[REAL_ENTIRE] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ; DROP_VEC]) THEN ASM_REAL_ARITH_TAC]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `h < g ==> h' <= h /\ g < k + (g - h) ==> k <= h' ==> g <= h`)) THEN ASM_SIMP_TAC[PATH_LENGTH_SUBPATH_LE; ENDS_IN_UNIT_INTERVAL]] THEN TRANS_TAC REAL_LET_TRANS `path_length(subpath (vec 0) x k:real^1->real^N) + path_length(subpath x y k) + path_length(subpath y (vec 1) k)` THEN CONJ_TAC THENL [REWRITE_TAC[PATH_LENGTH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; INTERVAL_NE_EMPTY_1]) THEN ASM_REWRITE_TAC[SEGMENT_1] THEN W(MP_TAC o PART_MATCH (lhand o rand) VECTOR_VARIATION_COMBINE o rand o rand o snd) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ASM_MESON_TAC[rectifiable_path]; REWRITE_TAC[SUBSET_INTERVAL_1]] THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `k = g ==> a + b:real = k ==> g <= a + b`)) THEN REWRITE_TAC[path_length] THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[rectifiable_path]; MATCH_MP_TAC(REAL_ARITH `a + b:real < c ==> a + x + b < x + c`)] THEN SUBGOAL_THEN `abs(drop p - &1 / &2) < &1 / &8` ASSUME_TAC THENL [REWRITE_TAC[MESON[DIST_LIFT; LIFT_DROP] `abs(drop x - y) = dist(x,lift y)`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `~((pathstart k:real^N) IN path_image (subpath (vec 0) q h))` THEN EXPAND_TAC "k" THEN W(MP_TAC o PART_MATCH (lhs o rand) PATH_IMAGE_SUBPATH o rand o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; DISCH_THEN SUBST1_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATHSTART_SHIFTPATH] THEN MATCH_MP_TAC(SET_RULE `P /\ y IN IMAGE h (t UNION s) ==> ~(y IN IMAGE h t) ==> ?x. P /\ x IN s /\ y = h x`) THEN ASM_SIMP_TAC[UNION_INTERVAL_1; IN_INTERVAL_1; DROP_VEC] THEN ASM_REWRITE_TAC[GSYM path_image] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN ASM_SIMP_TAC[PATH_LENGTH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[SEGMENT_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM IN_INTERVAL_1]) THEN CONJ_TAC THENL [ASM_CASES_TAC `drop(p + x) <= &1` THENL [TRANS_TAC REAL_LET_TRANS `path_length(subpath p (p + x) (g:real^1->real^N))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[PATH_LENGTH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[SEGMENT_1; DROP_ADD; DROP_SUB; GSYM DROP_VEC; REAL_LE_ADDR; REAL_ARITH `p + y - n <= p <=> y <= n`] THEN SUBST1_TAC(MESON[VECTOR_ADD_RID] `p:real^1,p + x = p + vec 0,p + x`) THEN REWRITE_TAC[GSYM VECTOR_VARIATION_TRANSLATION_INTERVAL] THEN EXPAND_TAC "k" THEN REWRITE_TAC[shiftpath] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; DROP_ADD]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x < e / &4 ==> x < e / &2`) THEN ASM_REWRITE_TAC[REAL_SUB_LT]]; TRANS_TAC REAL_LET_TRANS `vector_variation (interval[vec 0,vec 1 - p]) (k:real^1->real^N) + vector_variation (interval[vec 1 - p,x]) (k:real^1->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x + y = z ==> z <= x + y`) THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_ADD; DROP_VEC; INTERVAL_NE_EMPTY_1]) THEN REWRITE_TAC[CONJ_ASSOC; DROP_VEC; DROP_SUB] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ASM_MESON_TAC[rectifiable_path]; ALL_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `path_length(subpath p (vec 1) (g:real^1->real^N)) + path_length(subpath (vec 0) (x + p - vec 1) g)` THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_ADD; DROP_VEC; INTERVAL_NE_EMPTY_1]) THEN ASM_SIMP_TAC[PATH_LENGTH_SUBPATH; SEGMENT_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THENL [SUBGOAL_THEN `p:real^1,vec 1 = p + vec 0,p + (vec 1 - p)` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_VARIATION_TRANSLATION_INTERVAL] THEN EXPAND_TAC "k" THEN REWRITE_TAC[shiftpath] THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; DROP_ADD]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `p + z - vec 1:real^1 = (p - vec 1) + z`] THEN ASM_REAL_ARITH_TAC; SUBGOAL_THEN `vec 0,x + p - vec 1 = (p - vec 1) + (vec 1 - p):real^1, (p - vec 1) + x` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_VARIATION_TRANSLATION_INTERVAL] THEN EXPAND_TAC "k" THEN REWRITE_TAC[shiftpath] THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; DROP_ADD]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `p + z - vec 1:real^1 = (p - vec 1) + z`] THEN ASM_SIMP_TAC[REAL_ARITH `p + z <= &1 ==> (&1 - p <= z <=> z = &1 - p)`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT1) THEN UNDISCH_TAC `pathfinish g:real^N = pathstart g` THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN REWRITE_TAC[pathstart; pathfinish] THEN AP_TERM_TAC THEN CONV_TAC VECTOR_ARITH]; MATCH_MP_TAC(REAL_ARITH `x < e / &4 /\ y < e / &4 ==> x + y < e / &2`) THEN CONJ_TAC]]; ASM_CASES_TAC `drop(p + y) < &1` THENL [TRANS_TAC REAL_LET_TRANS `vector_variation (interval[y,vec 1 - p]) (k:real^1->real^N) + vector_variation (interval[vec 1 - p,vec 1]) (k:real^1->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x + y = z ==> z <= x + y`) THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_ADD; DROP_VEC; INTERVAL_NE_EMPTY_1]) THEN REWRITE_TAC[CONJ_ASSOC; DROP_VEC; DROP_SUB] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ASM_MESON_TAC[rectifiable_path]; ALL_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `path_length(subpath (p + y) (vec 1) (g:real^1->real^N)) + path_length(subpath (vec 0) p g)` THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_ADD; DROP_VEC; INTERVAL_NE_EMPTY_1]) THEN ASM_SIMP_TAC[PATH_LENGTH_SUBPATH; SEGMENT_1; DROP_VEC; DROP_ADD; DROP_SUB; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THENL [SUBGOAL_THEN `p + y:real^1,vec 1 = p + y,p + (vec 1 - p)` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_VARIATION_TRANSLATION_INTERVAL] THEN EXPAND_TAC "k" THEN REWRITE_TAC[shiftpath] THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; DROP_ADD]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `p + z - vec 1:real^1 = (p - vec 1) + z`] THEN ASM_REAL_ARITH_TAC; SUBGOAL_THEN `vec 0,p = (p - vec 1) + (vec 1 - p):real^1, (p - vec 1) + vec 1` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_VARIATION_TRANSLATION_INTERVAL] THEN EXPAND_TAC "k" THEN REWRITE_TAC[shiftpath] THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; DROP_ADD]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `p + z - vec 1:real^1 = (p - vec 1) + z`] THEN ASM_SIMP_TAC[REAL_ARITH `p + z <= &1 ==> (&1 - p <= z <=> z = &1 - p)`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT1) THEN UNDISCH_TAC `pathfinish g:real^N = pathstart g` THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN REWRITE_TAC[pathstart; pathfinish] THEN AP_TERM_TAC THEN CONV_TAC VECTOR_ARITH]; MATCH_MP_TAC(REAL_ARITH `x < e / &4 /\ y < e / &4 ==> x + y < e / &2`) THEN CONJ_TAC]; TRANS_TAC REAL_LET_TRANS `path_length(subpath (y + p - vec 1) p (g:real^1->real^N))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[PATH_LENGTH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[SEGMENT_1; DROP_ADD; DROP_SUB; GSYM DROP_VEC; REAL_LE_ADDR; REAL_ARITH `p + y - n <= p <=> y <= n`] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `y + p - vec 1:real^1,p = (p - vec 1) + y,(p - vec 1) + vec 1` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_VARIATION_TRANSLATION_INTERVAL] THEN EXPAND_TAC "k" THEN REWRITE_TAC[shiftpath] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; DROP_ADD]) THEN COND_CASES_TAC THEN REWRITE_TAC[VECTOR_ARITH `p + z - vec 1:real^1 = (p - vec 1) + z`] THEN STRIP_TAC THEN SUBGOAL_THEN `z:real^1 = vec 1 - p` SUBST1_TAC THENL [REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; GSYM DROP_EQ; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC; UNDISCH_TAC `pathfinish g:real^N = pathstart g` THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN REWRITE_TAC[pathstart; pathfinish] THEN AP_TERM_TAC THEN CONV_TAC VECTOR_ARITH]; MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x < e / &4 ==> x < e / &2`) THEN ASM_REWRITE_TAC[REAL_SUB_LT]]]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; INTERVAL_NE_EMPTY_1]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_VEC; CONJ_ASSOC] THEN (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN TRANS_TAC SUBSET_TRANS `path_image(subpath q (vec 1) h:real^1->real^N)` THEN (CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SEGMENT_1] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; IN_INTERVAL_1; DROP_VEC]; RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC]]) THEN MATCH_MP_TAC(MESON[SUBSET_TRANS] `path_image (subpath a b g) SUBSET IMAGE g (closure(interval(a,b))) /\ IMAGE g (closure(interval(a,b))) SUBSET t ==> path_image (subpath a b g) SUBSET t`) THEN (CONJ_TAC THENL [REWRITE_TAC[CLOSURE_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN COND_CASES_TAC THENL [ALL_TAC; REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SEGMENT_1] THEN COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL]] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; GSYM DROP_EQ; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN (REPEAT CONJ_TAC THENL [REWRITE_TAC[CLOSURE_INTERVAL] THEN COND_CASES_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EMPTY] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path; RECTIFIABLE_PATH_IMP_PATH] THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; GSYM DROP_EQ; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CLOSED_PATH_IMAGE THEN MATCH_MP_TAC PATH_SUBPATH THEN ASM_SIMP_TAC[RECTIFIABLE_PATH_IMP_PATH] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; GSYM DROP_EQ; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[] THENL [SUBGOAL_THEN `p:real^1,p + x = p + vec 0,p + x` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC]; SUBGOAL_THEN `p:real^1,vec 1 = p + vec 0,p + (vec 1 - p)` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC]; SUBGOAL_THEN `vec 0,x + p - vec 1 = (p - vec 1) + (vec 1 - p):real^1,(p - vec 1) + x` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC]; SUBGOAL_THEN `p + y:real^1,vec 1 = p + y,p + (vec 1 - p)` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC]; SUBGOAL_THEN `vec 0:real^1,p = (p - vec 1) + (vec 1 - p),(p - vec 1) + vec 1` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC]; SUBGOAL_THEN `y + p - vec 1:real^1,p = (p - vec 1) + y,(p - vec 1) + vec 1` SUBST1_TAC THENL [REWRITE_TAC[PAIR_EQ] THEN CONV_TAC VECTOR_ARITH; ALL_TAC]] THEN REWRITE_TAC[INTERVAL_TRANSLATION; GSYM IMAGE_o; o_DEF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p = IMAGE k x1 ==> (!a. a IN x0 ==> k' a = k a) /\ IMAGE k x0 SUBSET (p UNION t) /\ (!x y. x IN x0 /\ y IN x1 ==> ~(k x = k y)) ==> IMAGE k' x0 SUBSET t`)) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_COMBINE; RECTIFIABLE_PATH_IMP_PATH; IN_INTERVAL_1; DROP_VEC] THEN (REPEAT CONJ_TAC THENL [EXPAND_TAC "k" THEN REWRITE_TAC[shiftpath] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[VECTOR_ARITH `p + a - vec 1:real^1 = p - vec 1 + a`] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; GSYM DROP_EQ; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; GSYM DROP_EQ; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN UNDISCH_TAC `simple_path(k:real^1->real^N)` THEN REWRITE_TAC[simple_path] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^1` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^1` THEN ASM_CASES_TAC `(k:real^1->real^N) s = k u` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB; GSYM DROP_EQ; INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC);; let SIMPLE_PATH_LENGTH_UNIQUE = prove (`!g h:real^1->real^N. rectifiable_path g /\ simple_path g /\ rectifiable_path h /\ simple_path h /\ path_image g = path_image h ==> path_length g = path_length h`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_LENGTH_MINIMAL THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Useful equivalent formulations where the path is differentiable. *) (* ------------------------------------------------------------------------- *) let RECTIFIABLE_PATH_DIFFERENTIABLE = prove (`!g:real^1->real^N s. COUNTABLE s /\ path g /\ (!t. t IN interval[vec 0,vec 1] DIFF s ==> g differentiable at t) ==> (rectifiable_path g <=> (\t. vector_derivative g (at t)) absolutely_integrable_on interval[vec 0,vec 1])`, SIMP_TAC[rectifiable_path] THEN REWRITE_TAC[path] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[]);; let PATH_LENGTH_DIFFERENTIABLE = prove (`!g:real^1->real^N s. COUNTABLE s /\ rectifiable_path g /\ (!t. t IN interval[vec 0,vec 1] DIFF s ==> g differentiable at t) ==> path_length g = drop(integral (interval[vec 0,vec 1]) (\t. lift(norm(vector_derivative g (at t)))))`, REWRITE_TAC[rectifiable_path; path_length; path] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Solutions to differential equations: the Picard-Lindelof theorem. *) (* ------------------------------------------------------------------------- *) let PICARD_LINDELOF_RIGHT = prove (`!s (f:real^(1,N)finite_sum->real^N) t0 u0 r0 r1 B c. open s /\ f continuous_on s /\ &0 < r0 /\ &0 < r1 /\ B * r0 < r1 /\ c * r0 < &1 /\ interval[t0,t0 + lift r0] PCROSS cball(u0,r1) SUBSET s /\ (!x. x IN s ==> norm(f x) <= B) /\ (!t v w. t IN interval[t0,t0 + lift r0] /\ v IN cball(u0,r1) /\ w IN cball(u0,r1) ==> norm(f(pastecart t v) - f(pastecart t w)) <= c * norm(v - w)) ==> ?u. u t0 = u0 /\ (!t. t IN interval[t0,t0 + lift r0] ==> (u has_vector_derivative f(pastecart t (u t))) (at t within interval[t0,t0 + lift r0])) /\ (!v. (!t. t IN interval[t0,t0 + lift r0] ==> pastecart t (v t) IN s) /\ v t0 = u0 /\ (!t. t IN interval[t0,t0 + lift r0] ==> (v has_vector_derivative f(pastecart t (v t))) (at t within interval[t0,t0 + lift r0])) ==> (!t. t IN interval[t0,t0 + lift r0] ==> v t = u t))`, REPEAT GEN_TAC THEN INTRO_TAC "open fcont r0pos r1pos r0lt1 r0lt2 subs bound c" THEN LABEL_ABBREV_TAC `X = cfunspace (subtopology euclidean (interval[t0:real^1,t0 + lift r0])) (submetric euclidean_metric (cball(u0:real^N,r1)))` THEN CLAIM_TAC "X_complete" `mcomplete (X:(real^1->real^N)metric)` THENL [EXPAND_TAC "X" THEN MATCH_MP_TAC MCOMPLETE_CFUNSPACE THEN MATCH_MP_TAC CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE THEN REWRITE_TAC[MTOPOLOGY_EUCLIDEAN_METRIC; MCOMPLETE_EUCLIDEAN; GSYM CLOSED_IN; CLOSED_CBALL]; ALL_TAC] THEN LABEL_ABBREV_TAC `H (v:real^1->real^N) = RESTRICTION (interval[t0,t0 + lift r0]) (\t. u0 + integral (interval[t0,t]) (\t. f(pastecart t (v t))):real^N)` THEN CLAIM_TAC "mspaceX" `!u:real^1->real^N. u IN mspace X <=> u IN EXTENSIONAL (interval[t0,t0 + lift r0]) /\ u continuous_on interval[t0,t0 + lift r0] /\ (!t. t IN interval[t0,t0 + lift r0] ==> u t IN cball(u0,r1))` THENL [GEN_TAC THEN EXPAND_TAC "X" THEN REWRITE_TAC[CFUNSPACE] THEN REWRITE_TAC[IN_ELIM_THM; SUBMETRIC; TOPSPACE_SUBTOPOLOGY; MTOPOLOGY_SUBMETRIC; EUCLIDEAN_METRIC; MTOPOLOGY_EUCLIDEAN_METRIC; TOPSPACE_EUCLIDEAN; MBOUNDED_SUBMETRIC; MBOUNDED_EQ_BOUNDED; TOPCONTINUOUS_IN_SUBTOPOLGY; TOPCONTINUOUS_EQ_CONTINUOUS_ON; INTER_UNIV; IN_INTER; SET_RULE `IMAGE (u:real^1->real^N) s SUBSET t <=> !x. x IN s ==> u x IN t`] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball (u0:real^N,r1)` THEN REWRITE_TAC[BOUNDED_CBALL; INTER_SUBSET]; ALL_TAC] THEN CLAIM_TAC "Bpos" `&0 <= B` THENL [TRANS_TAC REAL_LE_TRANS `norm (f(pastecart (t0:real^1) (u0:real^N)):real^N)` THEN REWRITE_TAC[NORM_POS_LE] THEN REMOVE_THEN "bound" MATCH_MP_TAC THEN CUT_TAC `pastecart t0 (u0:real^N) IN interval [t0,t0 + lift r0] PCROSS cball (u0,r1)` THENL [HYP SET_TAC "subs" []; ALL_TAC] THEN REWRITE_TAC[PASTECART_IN_PCROSS; CENTRE_IN_CBALL] THEN HYP SIMP_TAC "r1pos" [REAL_LT_IMP_LE] THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL; DROP_ADD; LIFT_DROP] THEN REMOVE_THEN "r0pos" MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN CLAIM_TAC "cpos" `&0 <= c` THENL [REMOVE_THEN "c" (MP_TAC o SPECL[`t0:real^1`;`u0:real^N`;`u0 + r1 % basis 1:real^N`]) THEN REWRITE_TAC[IN_INTERVAL_1; CENTRE_IN_CBALL; REAL_LE_REFL; REAL_LE_ADDR; DROP_ADD; LIFT_DROP] THEN HYP SIMP_TAC "r0pos r1pos" [REAL_LT_IMP_LE] THEN REWRITE_TAC[IN_CBALL; dist; VECTOR_SUB_RADD; NORM_NEG; NORM_MUL; NORM_BASIS_1; REAL_MUL_RID] THEN HYP SIMP_TAC "r1pos" [REAL_ARITH `&0 < r1 ==> abs r1 = r1`; REAL_LE_REFL] THEN INTRO_TAC "hp" THEN TRANS_TAC REAL_LE_TRANS `norm (f (pastecart (t0:real^1) (u0:real^N)) - f (pastecart t0 (u0 + r1 % basis 1)):real^N) / r1` THEN HYP SIMP_TAC "hp r1pos" [REAL_LE_LDIV_EQ] THEN MATCH_MP_TAC REAL_LE_DIV THEN HYP SIMP_TAC "r1pos" [REAL_LT_IMP_LE; NORM_POS_LE]; ALL_TAC] THEN CLAIM_TAC "fu_cont" `!u:real^1->real^N. u IN mspace X ==> (\t. f (pastecart t (u t)):real^N) continuous_on interval[t0,t0 + lift r0]` THENL [HYP REWRITE_TAC "mspaceX" [] THEN INTRO_TAC "!u; ext ucont wd" THEN SUBGOAL_THEN `(\t:real^1. f (pastecart t (u t:real^N)):real^N) = f o (\t. pastecart t (u t))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN HYP SIMP_TAC "ucont" [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^(1,N)finite_sum->bool` THEN HYP REWRITE_TAC "fcont" [] THEN TRANS_TAC SUBSET_TRANS `interval [t0,t0 + lift r0] PCROSS cball (u0:real^N,r1)` THEN HYP REWRITE_TAC "subs" [] THEN REWRITE_TAC[SUBSET; IN_IMAGE] THEN INTRO_TAC "!x; @t. xeq t" THEN REMOVE_THEN "xeq" SUBST_VAR_TAC THEN HYP SIMP_TAC "t wd" [PASTECART_IN_PCROSS]; ALL_TAC] THEN CLAIM_TAC "fixpoint" `?!u:real^1->real^N. u IN mspace X /\ H u = u` THENL [MATCH_MP_TAC BANACH_FIXPOINT_THM THEN EXISTS_TAC `c * r0` THEN HYP REWRITE_TAC "r0lt2 X_complete" [] THEN SUBGOAL_THEN `~(mspace X = {}:(real^1->real^N)->bool)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `RESTRICTION (interval[t0,t0 + lift r0]) (\t:real^1. u0:real^N)` THEN HYP REWRITE_TAC "mspaceX" [RESTRICTION_IN_EXTENSIONAL] THEN SIMP_TAC[RESTRICTION_CONTINUOUS_ON; SUBSET_REFL; CONTINUOUS_ON_CONST] THEN HYP SIMP_TAC "r1pos" [RESTRICTION; CENTRE_IN_CBALL; REAL_LT_IMP_LE]; ALL_TAC] THEN CLAIM_TAC "fu_intgr" `!u:real^1->real^N. u IN mspace X ==> (\t. f (pastecart t (u t)):real^N) integrable_on interval[t0,t0 + lift r0]` THENL [HYP SIMP_TAC "fu_cont" [INTEGRABLE_CONTINUOUS]; ALL_TAC] THEN CLAIM_TAC "fu_intgr'" `!u:real^1->real^N t. u IN mspace X /\ t IN interval[t0,t0 + lift r0] ==> (\t. f (pastecart t (u t)):real^N) integrable_on interval[t0,t]` THENL [INTRO_TAC "!u t; u t" THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[t0:real^1,t0 + lift r0]` THEN HYP SIMP_TAC "fu_intgr u" [] THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN CLAIM_TAC "fu_aintgr" `!u:real^1->real^N. u IN mspace X ==> (\t. f (pastecart t (u t)):real^N) absolutely_integrable_on interval[t0,t0 + lift r0]` THENL [INTRO_TAC "!u; u" THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `\t:real^1. lift B` THEN REWRITE_TAC[LIFT_DROP; INTEGRABLE_CONST] THEN CONJ_TAC THENL [INTRO_TAC "![t]; t" THEN REMOVE_THEN "bound" MATCH_MP_TAC THEN CUT_TAC `pastecart (t:real^1) (u t:real^N) IN interval [t0,t0 + lift r0] PCROSS cball (u0,r1)` THENL [HYP SET_TAC "subs" []; ALL_TAC] THEN HYP REWRITE_TAC "t" [PASTECART_IN_PCROSS] THEN USE_THEN "mspaceX" (fun th -> HYP_TAC "u -> _ _ u'" (REWRITE_RULE[th])) THEN HYP SIMP_TAC "u' t" []; ALL_TAC] THEN HYP SIMP_TAC "fu_intgr u" []; ALL_TAC] THEN CLAIM_TAC "fu_aintgr'" `!u:real^1->real^N t. u IN mspace X /\ t IN interval[t0,t0 + lift r0] ==> (\t. f (pastecart t (u t)):real^N) absolutely_integrable_on interval[t0,t]` THENL [INTRO_TAC "!u t; u t" THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[t0,t0 + lift r0]` THEN HYP SIMP_TAC "fu_aintgr u" [] THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[SUBSET; IN_INTERVAL_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN CLAIM_TAC "H_in_X" `!u:real^1->real^N. u IN mspace X ==> H u IN mspace X` THENL [INTRO_TAC "!u; u" THEN REMOVE_THEN "H" (fun th -> REWRITE_TAC[GSYM th]) THEN HYP REWRITE_TAC "mspaceX" [RESTRICTION_IN_EXTENSIONAL] THEN SIMP_TAC[RESTRICTION_CONTINUOUS_ON; SUBSET_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN HYP SIMP_TAC "u fu_intgr" [INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT]; ALL_TAC] THEN INTRO_TAC "!t; t" THEN HYP REWRITE_TAC "t" [RESTRICTION] THEN CUT_TAC `norm(integral (interval [t0:real^1,t]) (\t. f (pastecart t (u t:real^N))):real^N) <= r1` THENL [REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[t0:real^1,t]) (\t. lift(norm (f (pastecart t (u t:real^N)):real^N))))` THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN HYP SIMP_TAC "fu_aintgr' u t" []; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop (integral (interval[t0,t]) (\t:real^1. lift B))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_LE THEN REWRITE_TAC[INTEGRABLE_CONST; LIFT_DROP] THEN CONJ_TAC THENL [CUT_TAC `(\t:real^1. f (pastecart t (u t:real^N)):real^N) absolutely_integrable_on interval [t0,t]` THENL [REWRITE_TAC[absolutely_integrable_on] THEN MESON_TAC[]; HYP SIMP_TAC "fu_aintgr' u t" []]; INTRO_TAC "!x; x" THEN REMOVE_THEN "bound" MATCH_MP_TAC THEN CUT_TAC `pastecart (x:real^1) (u x:real^N) IN interval [t0,t0 + lift r0] PCROSS cball (u0,r1)` THENL [HYP SET_TAC "subs" []; ALL_TAC] THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN CLAIM_TAC "t'" `x IN interval[t0,t0 + lift r0]` THENL [REMOVE_THEN "x" MP_TAC THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1] THEN REAL_ARITH_TAC; USE_THEN "mspaceX" (fun th -> HYP_TAC "u -> _ _ u'" (REWRITE_RULE[th])) THEN HYP SIMP_TAC "u' t'" []]]; REWRITE_TAC[INTEGRAL_CONST] THEN SUBGOAL_THEN `content(interval [t0:real^1,t]) = drop t - drop t0` SUBST1_TAC THENL [MATCH_MP_TAC CONTENT_1 THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1]; ALL_TAC] THEN REWRITE_TAC[GSYM LIFT_CMUL; DROP_SUB; LIFT_DROP] THEN TRANS_TAC REAL_LE_TRANS `B * r0` THEN HYP SIMP_TAC "r0lt1" [REAL_LT_IMP_LE] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN HYP REWRITE_TAC "Bpos" [] THEN REMOVE_THEN "t" MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; HYP REWRITE_TAC "H_in_X" []] THEN CLAIM_TAC "mdistX" `!u v. mdist X (u,v) = sup{dist(u t,v t:real^N) | t IN interval[t0,t0 + lift r0]}` THENL [REPEAT GEN_TAC THEN HYP REWRITE_TAC "mspaceX" [] THEN EXPAND_TAC "X" THEN REWRITE_TAC[CFUNSPACE; TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN; SUBMETRIC; EUCLIDEAN_METRIC; INTER_UNIV; INTERVAL_EQ_EMPTY_1; DROP_ADD; LIFT_DROP] THEN HYP SIMP_TAC "r0pos" [REAL_ARITH `&0 < y ==> ~(x + y < x)`]; ALL_TAC] THEN INTRO_TAC "!u [v]; u v" THEN REMOVE_THEN "H" (fun th -> REWRITE_TAC[GSYM th]) THEN SUBGOAL_THEN `!p q:real^1->real^N. mdist X (RESTRICTION (interval [t0,t0 + lift r0]) p, RESTRICTION (interval [t0,t0 + lift r0]) q) = mdist X (p,q)` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN HYP REWRITE_TAC "mdistX" [] THEN AP_TERM_TAC THEN CUT_TAC `!r x. x IN interval [t0,t0 + lift r0] ==> RESTRICTION (interval [t0,t0 + lift r0]) r x = r x:real^N` THENL [SET_TAC[]; SIMP_TAC[RESTRICTION]]; ALL_TAC] THEN EXPAND_TAC "X" THEN MATCH_MP_TAC MDIST_CFUNSPACE_LE THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN HYP SIMP_TAC "cpos r0pos" [REAL_LE_MUL; REAL_LT_IMP_LE] THEN HYP SIMP_TAC "X u v" [MDIST_POS_LE]; ALL_TAC] THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN; SUBMETRIC; EUCLIDEAN_METRIC; IN_INTER; IN_UNIV] THEN INTRO_TAC "![t]; t" THEN REWRITE_TAC[NORM_ARITH `dist(u0 + u:real^N,u0 + v) = dist(u,v)`] THEN HYP SIMP_TAC "u v t fu_intgr'" [dist; GSYM INTEGRAL_SUB] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[t0:real^1,t]) (\s. lift(norm(f(pastecart s (u s:real^N)) - f(pastecart s (v s)):real^N))))` THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN HYP SIMP_TAC "fu_aintgr' u v t" [ABSOLUTELY_INTEGRABLE_SUB]; ALL_TAC] THEN CLAIM_TAC "uv_ai" `(\s:real^1. u s - v s:real^N) absolutely_integrable_on interval[t0,t]` THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN USE_THEN "mspaceX" (fun th -> HYP_TAC "u: _ ucont _" (REWRITE_RULE[th])) THEN USE_THEN "mspaceX" (fun th -> HYP_TAC "v: _ vcont _" (REWRITE_RULE[th])) THEN CUT_TAC `interval[t0:real^1,t] SUBSET interval[t0,t0 + lift r0]` THENL [HYP MESON_TAC "ucont vcont" [CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `c * drop (integral (interval[t0:real^1,t]) (\s. lift(norm (u s - v s:real^N))))` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM DROP_CMUL] THEN SUBGOAL_THEN `c % integral (interval[t0:real^1,t]) (\s. lift (norm (u s - v s:real^N))) = integral (interval[t0,t]) (\s. c % lift(norm (u s - v s)))` SUBST1_TAC THENL [MATCH_MP_TAC (GSYM INTEGRAL_CMUL) THEN HYP_TAC "uv_ai: _ +" (REWRITE_RULE[absolutely_integrable_on]) THEN REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN HYP SIMP_TAC "fu_aintgr' u v t" []; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CLAIM_TAC "hp" `interval[t0,t] SUBSET interval[t0,t0 + lift r0]` THENL [REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1; REAL_LE_REFL; DROP_ADD; LIFT_DROP]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONTINUOUS THENL [USE_THEN "mspaceX" (fun th -> HYP_TAC "u: _ + _" (REWRITE_RULE[th])); USE_THEN "mspaceX" (fun th -> HYP_TAC "v: _ + _" (REWRITE_RULE[th]))] THEN HYP MESON_TAC "hp" [CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN INTRO_TAC "!x; x" THEN REWRITE_TAC[GSYM LIFT_CMUL; LIFT_DROP] THEN USE_THEN "c" MATCH_MP_TAC THEN CONJ_TAC THENL [REMOVE_THEN "x" MP_TAC THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REMOVE_THEN "mspaceX" (fun th -> HYP_TAC "u -> _ _ hp" (REWRITE_RULE[th])) THEN REMOVE_THEN "hp" MATCH_MP_TAC THEN REMOVE_THEN "x" MP_TAC THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1] THEN REAL_ARITH_TAC; REMOVE_THEN "mspaceX" (fun th -> HYP_TAC "v -> _ _ hp" (REWRITE_RULE[th])) THEN REMOVE_THEN "hp" MATCH_MP_TAC THEN REMOVE_THEN "x" MP_TAC THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1] THEN REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN HYP REWRITE_TAC "cpos X" [] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[t0,t]) (\s:real^1. lift(mdist X (u:real^1->real^N,v))))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_LE THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[t0,t0 + lift r0]` THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN USE_THEN "mspaceX" (fun th -> HYP_TAC "u -> _ ucont _" (REWRITE_RULE[th])) THEN USE_THEN "mspaceX" (fun th -> HYP_TAC "v -> _ vcont _" (REWRITE_RULE[th])) THEN HYP SIMP_TAC "ucont vcont" [ABSOLUTELY_INTEGRABLE_CONTINUOUS]; REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1] THEN REAL_ARITH_TAC]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN REWRITE_TAC[CONTINUOUS_ON_CONST]; ALL_TAC] THEN INTRO_TAC "!x; x" THEN REWRITE_TAC[LIFT_DROP] THEN SUBGOAL_THEN `norm(u (x:real^1):real^N - v x) = mdist (submetric euclidean_metric (cball (u0,r1))) (u x, v x)` SUBST1_TAC THENL [REWRITE_TAC[SUBMETRIC; EUCLIDEAN_METRIC; dist]; ALL_TAC] THEN MATCH_MP_TAC MDIST_CFUNSPACE_IMP_MDIST_LE THEN EXISTS_TAC `subtopology euclidean (interval [t0,t0 + lift r0])` THEN HYP REWRITE_TAC "X u v" [REAL_LE_REFL] THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN; INTER_UNIV] THEN REMOVE_THEN "x" MP_TAC THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[INTEGRAL_CONST; DROP_CMUL; LIFT_DROP] THEN MATCH_MP_TAC REAL_LE_RMUL THEN HYP SIMP_TAC "u v" [MDIST_POS_LE] THEN CUT_TAC `drop t0 <= drop t` THENL [REMOVE_THEN "t" MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN SIMP_TAC[CONTENT_1] THEN REAL_ARITH_TAC; REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1]]; ALL_TAC] THEN HYP_TAC "fixpoint: @u. (u fix) uniq" (REWRITE_RULE[EXISTS_UNIQUE]) THEN EXISTS_TAC `u:real^1->real^N` THEN CONJ_TAC THENL [REMOVE_THEN "fix" (SUBST1_TAC o GSYM) THEN REMOVE_THEN "H" (fun th -> REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[RESTRICTION; ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN HYP SIMP_TAC "r0pos" [DROP_ADD; LIFT_DROP; REAL_ARITH `&0 < b ==> ~(a + b < a)`] THEN REWRITE_TAC[INTEGRAL_REFL; VECTOR_ADD_RID]; ALL_TAC] THEN CONJ_TAC THENL [INTRO_TAC "!t; t" THEN REMOVE_THEN "fix" (fun th -> GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM th]) THEN REMOVE_THEN "H" (fun th -> REWRITE_TAC[GSYM th]) THEN HYP SIMP_TAC "t" [RESTRICTION_HAS_DERIVATIVE] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [VECTOR_ARITH `x = vec 0 + x:real^N`] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN MP_TAC (ISPECL[`\t:real^1. f (pastecart t (u t:real^N)):real^N`; `t0:real^1`; `t0 + lift r0`] INTEGRAL_HAS_VECTOR_DERIVATIVE) THEN HYP SIMP_TAC "fu_cont u t" []; ALL_TAC] THEN INTRO_TAC "!v; vINs v0 v" THEN SUBGOAL_THEN `RESTRICTION (interval[t0:real^1, t0 + lift r0]) v = u:real^1->real^N` (SUBST1_TAC o GSYM) THENL [ALL_TAC; SIMP_TAC[RESTRICTION]] THEN REMOVE_THEN "uniq" MATCH_MP_TAC THEN CONJ_TAC THENL [HYP REWRITE_TAC "mspaceX" [] THEN REWRITE_TAC[RESTRICTION_IN_EXTENSIONAL] THEN CONJ_TAC THENL [SIMP_TAC[RESTRICTION_CONTINUOUS_ON; SUBSET_REFL] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN REWRITE_TAC[differentiable_on; differentiable] THEN REMOVE_THEN "v" (MP_TAC o REWRITE_RULE[has_vector_derivative]) THEN MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[RESTRICTION] THEN REFUTE_THEN (LABEL_TAC "contra") THEN HYP_TAC "contra: @t1. t1 contra" (REWRITE_RULE[NOT_FORALL_THM; NOT_IMP]) THEN HYP_TAC "contra" (REWRITE_RULE[IN_CBALL; REAL_NOT_LE]) THEN CUT_TAC `r1 < r1` THENL [REWRITE_TAC[REAL_LT_REFL]; ALL_TAC] THEN TRANS_TAC REAL_LTE_TRANS `norm(u0 - v (t1:real^1):real^N)` THEN CONJ_TAC THENL [HYP REWRITE_TAC "contra" [GSYM dist]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `B * norm (t0 - t1:real^1)` THEN CONJ_TAC THENL [ALL_TAC; TRANS_TAC REAL_LE_TRANS `B * r0` THEN HYP SIMP_TAC "r0lt1" [REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_LMUL THEN HYP REWRITE_TAC "Bpos" [] THEN REMOVE_THEN "t1" MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; NORM_1; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC] THEN REMOVE_THEN "v0" (SUBST1_TAC o GSYM) THEN MATCH_MP_TAC (REWRITE_RULE [IMP_IMP; GSYM RIGHT_FORALL_IMP_THM] VECTOR_DIFFERENTIABLE_BOUND) THEN EXISTS_TAC `\t:real^1. f(pastecart t (v t:real^N)):real^N` THEN EXISTS_TAC `interval[t0,t0 + lift r0]` THEN HYP REWRITE_TAC "t1 v" [CONVEX_INTERVAL; ENDS_IN_INTERVAL] THEN CONJ_TAC THENL [INTRO_TAC "!x; x" THEN REMOVE_THEN "bound" MATCH_MP_TAC THEN HYP SIMP_TAC "vINs x" []; REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_ADD; LIFT_DROP] THEN REMOVE_THEN "r0pos" MP_TAC THEN REAL_ARITH_TAC]; ALL_TAC] THEN REMOVE_THEN "H" (fun th -> REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[RESTRICTION_EXTENSION] THEN INTRO_TAC "![t]; t" THEN REWRITE_TAC[VECTOR_ARITH `u0 + p = q:real^N <=> p = q - u0`] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN REMOVE_THEN "v0" (SUBST1_TAC o GSYM) THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS THEN CONJ_TAC THENL [REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1]; ALL_TAC] THEN INTRO_TAC "!x; x" THEN CLAIM_TAC "x'" `x IN interval [t0,t0 + lift r0]` THENL [REMOVE_THEN "x" MP_TAC THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN HYP REWRITE_TAC "x'" [RESTRICTION] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `interval[t0,t0 + lift r0]` THEN HYP SIMP_TAC "v x'" [] THEN REMOVE_THEN "t" MP_TAC THEN SIMP_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1; REAL_LE_REFL]);; hol-light/Multivariate/lpspaces.ml000066400000000000000000001646151303454263000175740ustar00rootroot00000000000000(* ========================================================================= *) (* L_p spaces for functions R^m->R^n based on an arbitrary set. *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* The space L_p of measurable functions f with |f|^p integrable (on s). *) (* ------------------------------------------------------------------------- *) let lspace = new_definition `lspace s p = {f:real^M->real^N | f measurable_on s /\ (\x. lift(norm(f x) rpow p)) integrable_on s}`;; let LSPACE_ZERO = prove (`!s. lspace s (&0) = if measurable s then {f:real^M->real^N | f measurable_on s} else {}`, REWRITE_TAC[lspace; RPOW_POW; real_pow; NORM_0; LIFT_NUM] THEN GEN_TAC THEN REWRITE_TAC[INTEGRABLE_ON_CONST; VEC_EQ; ARITH_EQ] THEN ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let LSPACE_CONST = prove (`!s p c. measurable s ==> (\x. c) IN lspace s p`, SIMP_TAC[lspace; IN_ELIM_THM; INTEGRABLE_ON_CONST; INTEGRABLE_IMP_MEASURABLE]);; let LSPACE_0 = prove (`!s p. ~(p = &0) ==> (\x. vec 0) IN lspace s p`, SIMP_TAC[lspace; IN_ELIM_THM; NORM_0; RPOW_ZERO; LIFT_NUM] THEN SIMP_TAC[INTEGRABLE_IMP_MEASURABLE; INTEGRABLE_0]);; let LSPACE_CMUL = prove (`!s p c f:real^M->real^N. f IN lspace s p ==> (\x. c % f x) IN lspace s p`, REPEAT GEN_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN SIMP_TAC[NORM_MUL; RPOW_MUL; NORM_POS_LE; LIFT_CMUL] THEN SIMP_TAC[MEASURABLE_ON_CMUL; INTEGRABLE_CMUL]);; let LSPACE_NEG = prove (`!s p f:real^M->real^N. f IN lspace s p ==> (\x. --(f x)) IN lspace s p`, REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`; LSPACE_CMUL]);; let LSPACE_ADD = prove (`!s p f g:real^M->real^N. &0 <= p /\ f IN lspace s p /\ g IN lspace s p ==> (\x. f(x) + g(x)) IN lspace s p`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `p = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[LSPACE_ZERO] THEN ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM; MEASURABLE_ON_ADD]; ALL_TAC] THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_ON_ADD] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. lift(&2 rpow p * (norm((f:real^M->real^N) x) rpow p + norm((g:real^M->real^N) x) rpow p))` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `(\x:real^M. lift(norm(f x + g x:real^N) rpow p)) = (lift o (\y. y rpow p) o drop) o (\x. lift(norm(f x + g x)))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_NORM THEN MATCH_MP_TAC MEASURABLE_ON_ADD THEN ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_ON] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ] THEN REWRITE_TAC[LIFT_NUM]]; REWRITE_TAC[LIFT_CMUL; LIFT_ADD] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `(&0 <= norm(f + g:real^N) rpow p /\ &0 <= norm f /\ &0 <= norm g /\ norm(f + g) rpow p <= (norm f + norm g) rpow p) /\ (&0 <= norm f /\ &0 <= norm g ==> (norm f + norm g) rpow p <= e) ==> abs(norm(f + g) rpow p) <= e`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[NORM_POS_LE; RPOW_POS_LE; RPOW_LE2; NORM_TRIANGLE; RPOW_LE2; REAL_LT_IMP_LE]; SPEC_TAC(`norm((g:real^M->real^N) x)`,`z:real`) THEN SPEC_TAC(`norm((f:real^M->real^N) x)`,`w:real`) THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[REAL_ADD_SYM]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&2 * z) rpow p` THEN CONJ_TAC THENL [MATCH_MP_TAC RPOW_LE2 THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[RPOW_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_ADDL; RPOW_POS_LE; REAL_POS]]]]);; let LSPACE_SUB = prove (`!s p f g:real^M->real^N. &0 <= p /\ f IN lspace s p /\ g IN lspace s p ==> (\x. f(x) - g(x)) IN lspace s p`, SIMP_TAC[VECTOR_SUB; LSPACE_ADD; LSPACE_NEG]);; let LSPACE_IMP_INTEGRABLE = prove (`!s p f. f IN lspace s p ==> (\x. lift(norm(f x) rpow p)) integrable_on s`, SIMP_TAC[lspace; IN_ELIM_THM]);; let LSPACE_NORM = prove (`!s p f. f IN lspace s p ==> (\x. lift(norm(f x))) IN lspace s p`, REWRITE_TAC[lspace; IN_ELIM_THM] THEN SIMP_TAC[NORM_LIFT; REAL_ABS_NORM; MEASURABLE_ON_NORM]);; let LSPACE_VSUM = prove (`!s p f:A->real^M->real^N t. &0 < p /\ FINITE t /\ (!i. i IN t ==> (f i) IN lspace s p) ==> (\x. vsum t (\i. f i x)) IN lspace s p`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; LSPACE_0; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[LSPACE_ADD; REAL_LT_IMP_LE; ETA_AX; IN_INSERT]);; let LSPACE_MAX = prove (`!s p k f:real^M->real^N g:real^M->real^N. f IN lspace s p /\ g IN lspace s p /\ &0 < p ==> ((\x. lambda i. max (f x$i) (g x$i)):real^M->real^N) IN lspace s p`, REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_ON_MAX] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. lift(&(dimindex(:N)) rpow p * max (norm((f:real^M->real^N) x) rpow p) (norm((g:real^M->real^N) x) rpow p))` THEN ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM; MEASURABLE_ON_MAX] THEN CONJ_TAC THENL [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN SIMP_TAC[RPOW_POS_LE; NORM_POS_LE]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_MAX_RPOW; NORM_POS_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM RPOW_MUL; NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= y /\ abs(x') <= y' ==> abs(max x x') <= max y y'`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM]]);; let LSPACE_MIN = prove (`!s p k f:real^M->real^N g:real^M->real^N. f IN lspace s p /\ g IN lspace s p /\ &0 < p ==> ((\x. lambda i. min (f x$i) (g x$i)):real^M->real^N) IN lspace s p`, REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_ON_MIN] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. lift(&(dimindex(:N)) rpow p * max (norm((f:real^M->real^N) x) rpow p) (norm((g:real^M->real^N) x) rpow p))` THEN ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM; MEASURABLE_ON_MIN] THEN CONJ_TAC THENL [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN SIMP_TAC[RPOW_POS_LE; NORM_POS_LE]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_MAX_RPOW; NORM_POS_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM RPOW_MUL; NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= y /\ abs(x') <= y' ==> abs(min x x') <= max y y'`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM]]);; let LSPACE_BOUNDED_MEASURABLE = prove (`!s p f:real^M->real^N g:real^M->real^N. &0 < p /\ f measurable_on s /\ g IN lspace s p /\ (!x. x IN s ==> norm(f x) <= norm(g x)) ==> f IN lspace s p`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[lspace; IN_ELIM_THM] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. lift(norm((g:real^M->real^N) x) rpow p)` THEN ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE] THEN ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN REWRITE_TAC[REAL_ABS_RPOW; REAL_ABS_NORM] THEN ASM_SIMP_TAC[RPOW_LE2; REAL_LT_IMP_LE; NORM_POS_LE]);; let LSPACE_INTEGRABLE_PRODUCT = prove (`!s p q f:real^M->real^N g:real^M->real^N. &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\ f IN lspace s p /\ g IN lspace s q ==> (\x. lift(norm(f x) * norm(g x))) integrable_on s`, REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x) rpow p / p) + lift(norm((g:real^M->real^N) x) rpow q / q)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[LIFT_CMUL] THEN GEN_REWRITE_TAC (LAND_CONV o ABS_CONV o LAND_CONV) [GSYM LIFT_DROP] THEN MATCH_MP_TAC MEASURABLE_ON_DROP_MUL THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_NORM THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC INTEGRABLE_ADD THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[LIFT_CMUL] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; REWRITE_TAC[NORM_LIFT; REAL_ABS_MUL; REAL_ABS_NORM; LIFT_DROP; DROP_ADD] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC YOUNG_INEQUALITY THEN ASM_REWRITE_TAC[NORM_POS_LE]]);; let LSPACE_1 = prove (`!f:real^M->real^N s. f IN lspace s (&1) <=> f absolutely_integrable_on s`, REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE; lspace; IN_ELIM_THM] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1]);; let LSPACE_MONO = prove (`!f:real^M->real^N s p q. f IN lspace s q /\ measurable s /\ &0 < p /\ p <= q ==> f IN lspace s p`, REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. lift(max (&1) (norm((f:real^M->real^N) x) rpow q))` THEN ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM] THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; INTEGRABLE_ON_CONST] THEN REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN SIMP_TAC[RPOW_POS_LE; NORM_POS_LE; REAL_POS]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP; REAL_ABS_RPOW; REAL_ABS_NORM] THEN DISJ_CASES_TAC(ISPECL [`&1`; `norm((f:real^M->real^N) x)`] REAL_LE_TOTAL) THENL [MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max z y`) THEN MATCH_MP_TAC RPOW_MONO_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max y z`) THEN MATCH_MP_TAC RPOW_1_LE THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC]]);; let LSPACE_INCLUSION = prove (`!s p q. measurable s /\ &0 < p /\ p <= q ==> (lspace s q :(real^M->real^N)->bool) SUBSET (lspace s p)`, REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LSPACE_MONO THEN EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* The corresponding seminorm; Hoelder and Minkowski inequalities. *) (* ------------------------------------------------------------------------- *) let lnorm = new_definition `lnorm s p f = drop(integral s (\x. lift(norm(f x) rpow p))) rpow (inv p)`;; let LNORM_0 = prove (`!s p. ~(p = &0) ==> lnorm s p (\x. vec 0) = &0`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[lnorm; NORM_0; RPOW_ZERO] THEN ASM_REWRITE_TAC[LIFT_NUM; INTEGRAL_0; DROP_VEC; RPOW_ZERO; REAL_INV_EQ_0]);; let LNORM_NEG = prove (`!s p f:real^M->real^N. lnorm s p (\x. --(f x)) = lnorm s p f`, REWRITE_TAC[lnorm; NORM_NEG]);; let LNORM_MUL = prove (`!s p f c. f IN lspace s p /\ ~(p = &0) ==> lnorm s p (\x. c % f x) = abs(c) * lnorm s p f`, REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm; NORM_MUL; RPOW_MUL; LIFT_CMUL] THEN ASM_SIMP_TAC[INTEGRAL_CMUL; LSPACE_IMP_INTEGRABLE] THEN REWRITE_TAC[DROP_CMUL; RPOW_MUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[RPOW_RPOW; REAL_ABS_POS; REAL_MUL_RINV] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1]);; let LNORM_EQ_0 = prove (`!s p f. ~(p = &0) /\ f IN lspace s p ==> (lnorm s p f = &0 <=> negligible {x | x IN s /\ ~(f x = vec 0)})`, REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[lnorm; RPOW_EQ_0; REAL_INV_EQ_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL] THEN SIMP_TAC[HAS_INTEGRAL_NEGLIGIBLE_EQ; lift; LAMBDA_BETA; NORM_POS_LE; RPOW_POS_LE] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN SIMP_TAC[IN_ELIM_THM; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[FORALL_1; DIMINDEX_1; VEC_COMPONENT] THEN ASM_REWRITE_TAC[RPOW_EQ_0; NORM_EQ_0; CART_EQ; VEC_COMPONENT]);; let LNORM_POS_LE = prove (`!s p f. f IN lspace s p ==> &0 <= lnorm s p f`, SIMP_TAC[lspace; IN_ELIM_THM; lnorm] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC RPOW_POS_LE THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_SIMP_TAC[LIFT_DROP; NORM_POS_LE; RPOW_POS_LE]);; let LNORM_NORM = prove (`!s p f. lnorm s p (\x. lift(norm(f x))) = lnorm s p f`, REWRITE_TAC[lnorm; NORM_LIFT; REAL_ABS_NORM]);; let LNORM_RPOW = prove (`!s p f:real^M->real^N. f IN lspace s p /\ ~(p = &0) ==> (lnorm s p f) rpow p = drop(integral s (\x. lift(norm(f x) rpow p)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm] THEN ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE; RPOW_RPOW; LSPACE_IMP_INTEGRABLE; RPOW_POS_LE] THEN ASM_SIMP_TAC[REAL_MUL_LINV; RPOW_POW; REAL_POW_1]);; let INTEGRAL_LNORM_RPOW = prove (`!s p f:real^M->real^N. f IN lspace s p /\ ~(p = &0) ==> integral s (\x. lift(norm(f x) rpow p)) = lift((lnorm s p f) rpow p)`, SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; LNORM_RPOW]);; let HOELDER_INEQUALITY = prove (`!s p q f:real^M->real^N g:real^M->real^N. &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\ f IN lspace s p /\ g IN lspace s q ==> drop(integral s (\x. lift(norm(f x) * norm(g x)))) <= lnorm s p f * lnorm s q g`, MP_TAC LSPACE_INTEGRABLE_PRODUCT THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 <= lnorm s p (f:real^M->real^N) /\ &0 <= lnorm s q (g:real^M->real^N)` MP_TAC THENL [ASM_SIMP_TAC[LNORM_POS_LE]; REWRITE_TAC[IMP_CONJ]] THEN REPEAT (GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN DISCH_THEN(DISJ_CASES_THEN2 MP_TAC ASSUME_TAC) THENL [ASM_SIMP_TAC[LNORM_EQ_0; REAL_LT_IMP_NZ] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = &0 ==> x <= y`) THEN ASM_SIMP_TAC[REAL_LE_MUL; LNORM_POS_LE; GSYM LIFT_EQ; LIFT_DROP] THEN ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL; LIFT_NUM] THEN SIMP_TAC[HAS_INTEGRAL_NEGLIGIBLE_EQ; lift; LAMBDA_BETA; NORM_POS_LE; REAL_LE_MUL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SIMP_TAC[CART_EQ; SUBSET; IN_ELIM_THM; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT] THEN REWRITE_TAC[REAL_ENTIRE; CART_EQ; NORM_EQ_0; VEC_COMPONENT] THEN MESON_TAC[]; ALL_TAC]) THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[GSYM DROP_CMUL] THEN ASM_SIMP_TAC[GSYM INTEGRAL_CMUL] THEN REWRITE_TAC[REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(integral s (\x. lift(norm(inv(lnorm s p f) % (f:real^M->real^N) x) rpow p / p + norm(inv(lnorm s q g) % (g:real^M->real^N) x) rpow q / q)))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[LIFT_DROP; INTEGRABLE_CMUL] THEN CONJ_TAC THENL [REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC INTEGRABLE_ADD THEN REWRITE_TAC[NORM_MUL; RPOW_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; INTEGRABLE_CMUL; LIFT_CMUL]; REWRITE_TAC[DROP_CMUL; LIFT_DROP; NORM_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[real_abs; LNORM_POS_LE; REAL_LT_IMP_NZ] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * (c * d:real) = (a * c) * (b * d)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC YOUNG_INEQUALITY THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; LNORM_POS_LE; REAL_LE_INV_EQ]]; REWRITE_TAC[LIFT_ADD; NORM_MUL; LIFT_CMUL; RPOW_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[LIFT_CMUL; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[INTEGRAL_ADD; INTEGRABLE_CMUL; INTEGRAL_CMUL; LSPACE_IMP_INTEGRABLE; REAL_ABS_INV] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`; RPOW_INV] THEN ASM_SIMP_TAC[INTEGRAL_LNORM_RPOW; REAL_LT_IMP_NZ] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP] THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; RPOW_POS_LT] THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]]);; let HOELDER_INEQUALITY_FULL = prove (`!s p q f:real^M->real^N g:real^M->real^N. &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\ f IN lspace s p /\ g IN lspace s q ==> (\x. lift(norm(f x) * norm(g x))) integrable_on s /\ drop(integral s (\x. lift(norm(f x) * norm(g x)))) <= lnorm s p f * lnorm s q g`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LSPACE_INTEGRABLE_PRODUCT) THEN ASM_SIMP_TAC[HOELDER_INEQUALITY]);; let LNORM_TRIANGLE = prove (`!s p f:real^M->real^N g:real^M->real^N. f IN lspace s p /\ g IN lspace s p /\ &1 <= p ==> lnorm s p (\x. f x + g x) <= lnorm s p f + lnorm s p g`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `p = &1` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[lnorm; MESON[RPOW_POW; REAL_POW_1; REAL_INV_1] `x rpow (inv(&1)) = x`; GSYM DROP_ADD; GSYM INTEGRAL_ADD; LSPACE_IMP_INTEGRABLE] THEN MATCH_MP_TAC INTEGRAL_DROP_LE_MEASURABLE THEN ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; INTEGRABLE_ADD] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1; LIFT_DROP; DROP_ADD] THEN REWRITE_TAC[NORM_POS_LE; NORM_TRIANGLE] THEN MATCH_MP_TAC MEASURABLE_ON_NORM THEN MATCH_MP_TAC MEASURABLE_ON_ADD THEN RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&1 < p` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 <= lnorm s p (\x. (f:real^M->real^N) x + g x)` MP_TAC THENL [ASM_SIMP_TAC[LNORM_POS_LE; LSPACE_ADD; REAL_ARITH `&1 <= p ==> &0 <= p`]; GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LNORM_POS_LE; REAL_LE_ADD]] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `lnorm s p (\x. (f:real^M->real^N) x + g x) rpow (p - &1)` THEN ASM_SIMP_TAC[RPOW_POS_LT] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_POW_1] THEN ASM_SIMP_TAC[GSYM RPOW_POW; GSYM RPOW_ADD] THEN ASM_SIMP_TAC[LSPACE_ADD; LNORM_RPOW; REAL_ARITH `p - &1 + &1 = p`; REAL_ARITH `&1 <= p ==> &0 <= p /\ ~(p = &0)`] THEN CONV_TAC(LAND_CONV(SUBS_CONV[REAL_ARITH `p = &1 + (p - &1)`])) THEN ASM_SIMP_TAC[RPOW_ADD_ALT; NORM_POS_LE; REAL_ARITH `&1 <= p ==> &1 + p - &1 = &0 ==> p - &1 = &0`] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1] THEN MP_TAC(ISPECL [`s:real^M->bool`; `p:real`; `p / (p - &1)`; `\x. lift(norm((g:real^M->real^N) x))`; `\x. lift(norm((f:real^M->real^N)(x) + g(x)) rpow (p - &1))`] HOELDER_INEQUALITY_FULL) THEN MP_TAC(ISPECL [`s:real^M->bool`; `p:real`; `p / (p - &1)`; `\x. lift(norm((f:real^M->real^N) x))`; `\x. lift(norm((f:real^M->real^N)(x) + g(x)) rpow (p - &1))`] HOELDER_INEQUALITY_FULL) THEN ASM_SIMP_TAC[LSPACE_NORM; REAL_LT_DIV; REAL_SUB_LT; REAL_ARITH `&1 < p ==> &0 < p`; REAL_FIELD `&1 < p ==> inv(p) + inv(p / (p - &1)) = &1`] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r ==> s) ==> (p ==> q) ==> (p ==> r) ==> s`) THEN CONJ_TAC THENL [SIMP_TAC[lspace; IN_ELIM_THM; NORM_LIFT; REAL_ABS_NORM; REAL_ABS_RPOW; RPOW_RPOW; NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_FIELD `&1 < p ==> (p - &1) * p / (p - &1) = p`] THEN ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`] THEN MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `((\x. f x + g x):real^M->real^N) IN lspace s p` MP_TAC THENL [ASM_SIMP_TAC[LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`]; SIMP_TAC[lspace; IN_ELIM_THM; MEASURABLE_ON_NORM]]; ALL_TAC] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LNORM_NORM; REAL_ABS_RPOW] THEN MATCH_MP_TAC(TAUT `(p1 /\ p2 ==> b1 /\ b2 ==> c) ==> p1 /\ b1 ==> p2 /\ b2 ==> c`) THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2) THEN ASM_SIMP_TAC[GSYM DROP_ADD; GSYM INTEGRAL_ADD] THEN SUBGOAL_THEN `lnorm s (p / (p - &1)) (\x. lift(norm (f x + g x) rpow (p - &1))) = lnorm s p (\x. (f:real^M->real^N) x + g x) rpow (p - &1)` SUBST1_TAC THENL [REWRITE_TAC[lnorm] THEN ASM_SIMP_TAC[RPOW_RPOW; INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE; NORM_LIFT; REAL_ABS_NORM; REAL_ABS_RPOW] THEN ASM_SIMP_TAC[REAL_FIELD `&1 < p ==> (p - &1) * p / (p - &1) = p`] THEN REWRITE_TAC[REAL_INV_DIV] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC(GSYM RPOW_RPOW) THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_SIMP_TAC[LIFT_DROP; RPOW_POS_LE; NORM_POS_LE; LSPACE_IMP_INTEGRABLE; LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `i2 <= i1 ==> i1 <= f * y + g * y ==> i2 <= y * (f + g)`) THEN MATCH_MP_TAC INTEGRAL_DROP_LE_MEASURABLE THEN ASM_SIMP_TAC[INTEGRABLE_ADD] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]] THEN (SUBGOAL_THEN `((\x. f x + g x):real^M->real^N) IN lspace s p` MP_TAC THENL [ASM_SIMP_TAC[LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`]; SIMP_TAC[lspace; IN_ELIM_THM; MEASURABLE_ON_NORM]]); REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; LIFT_DROP; DROP_ADD] THEN SIMP_TAC[NORM_TRIANGLE; REAL_LE_RMUL; NORM_POS_LE; RPOW_POS_LE; REAL_LE_MUL]]);; let VSUM_LNORM = prove (`!s p f:A->real^M->real^N t. &1 <= p /\ FINITE t /\ (!i. i IN t ==> (f i) IN lspace s p) ==> lnorm s p (\x. vsum t (\i. f i x)) <= sum t (\i. lnorm s p (f i))`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; LNORM_0; REAL_LE_REFL; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN MAP_EVERY X_GEN_TAC [`i:A`; `u:A->bool`] THEN REWRITE_TAC[IN_INSERT] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(REAL_ARITH `a <= x + y ==> y <= z ==> a <= x + z`) THEN W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN ASM_SIMP_TAC[ETA_AX; LSPACE_VSUM; REAL_ARITH `&1 <= p ==> &0 < p`]);; (* ------------------------------------------------------------------------- *) (* Completeness (Riesz-Fischer). *) (* ------------------------------------------------------------------------- *) let LSPACE_SUMMABLE_UNIV = prove (`!f:num->real^M->real^N p s. &1 <= p /\ (!i. f i IN lspace s p) /\ real_summable (:num) (\i. lnorm s p (f i)) ==> ?g. g IN lspace s p /\ !e. &0 < e ==> eventually (\n. lnorm s p (\x. vsum (0..n) (\i. f i x) - g(x)) < e) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_SUMS_INFSUM]) THEN ABBREV_TAC `M = real_infsum (:num) (\i. lnorm s p (f i:real^M->real^N))` THEN DISCH_TAC THEN ABBREV_TAC `g = \n x:real^M. vsum(0..n) (\i. lift(norm(f i x:real^N)))` THEN SUBGOAL_THEN `!n:num. lnorm s p (g n:real^M->real^1) <= M` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "g" THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_LNORM o lhand o snd) THEN ASM_SIMP_TAC[FINITE_NUMSEG; LSPACE_NORM; ETA_AX] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[LNORM_NORM] THEN EXPAND_TAC "M" THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SET_RULE `s = UNIV INTER s`] THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC REAL_PARTIAL_SUMS_LE_INFSUM THEN ASM_SIMP_TAC[LNORM_POS_LE]; ALL_TAC] THEN SUBGOAL_THEN `!n:num. (g n:real^M->real^1) IN lspace s p` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN MATCH_MP_TAC LSPACE_VSUM THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[FINITE_NUMSEG]] THEN ASM_SIMP_TAC[LSPACE_NORM; ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `!n:num x:real^M. &0 <= drop(g n x)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; LIFT_DROP] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`\i:num x:real^M. lift(drop(g i x) rpow p)`; `s:real^M->bool`] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL [MATCH_MP_TAC(TAUT `b /\ a /\ c ==> a /\ b /\ c`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN SIMP_TAC[DROP_VSUM; FINITE_NUMSEG] THEN MATCH_MP_TAC RPOW_LE2 THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE]; SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; REAL_LE_ADDR] THEN REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE]; ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!k x. drop((g:num->real^M->real^1) k x) = norm(g k x)` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REWRITE_TAC[real_abs]; ALL_TAC] THEN ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; ETA_AX] THEN REWRITE_TAC[bounded] THEN EXISTS_TAC `M rpow p` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[INTEGRAL_LNORM_RPOW; ETA_AX; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW] THEN MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[REAL_ARITH `&1 <= p ==> &0 <= p`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> &0 <= abs x /\ abs x <= a`) THEN ASM_SIMP_TAC[LNORM_POS_LE]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`hp:real^M->real^1`; `k:real^M->bool`] THEN STRIP_TAC THEN ABBREV_TAC `h:real^M->real^1 = \x. lift(drop(hp x) rpow (inv p))` THEN SUBGOAL_THEN `!x. x IN s DIFF k ==> ((\i. g i x) --> ((h:real^M->real^1) x)) sequentially` ASSUME_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MP_TAC(ISPECL [`lift o (\x. x rpow (inv p)) o drop`; `sequentially`; `\i. lift(drop((g:num->real^M->real^1) i x) rpow p)`; `(hp:real^M->real^1) x`] LIM_CONTINUOUS_FUNCTION) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXPAND_TAC "h" THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN ASM_SIMP_TAC[RPOW_RPOW; REAL_MUL_RINV; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1; LIFT_DROP; ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN s DIFF k ==> summable (:num) (\i. (f:num->real^M->real^N) i x)` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_LIFT_ABSCONV_IMP_CONV THEN REWRITE_TAC[summable] THEN EXISTS_TAC `(h:real^M->real^1) x` THEN REWRITE_TAC[sums; INTER_UNIV] THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[summable] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^M->real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!n x. x IN s DIFF k ==> norm(vsum (0..n) (\i. (f:num->real^M->real^N) i x)) <= drop(h x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN GEN_REWRITE_TAC LAND_CONV [GSYM LIFT_DROP] THEN SIMP_TAC[LIFT_SUM; FINITE_NUMSEG] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\n. vsum (0..n) (\i. lift(norm((f:num->real^M->real^N) i x)))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_SIMP_TAC[IN_DIFF]; REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; o_DEF; LIFT_DROP] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN REWRITE_TAC[SUBSET; IN_NUMSEG; NORM_POS_LE; FINITE_NUMSEG] THEN UNDISCH_TAC `n:num <= m` THEN ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN s DIFF k ==> norm((l:real^M->real^N) x) <= drop(h x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. vsum ((:num) INTER (0..n)) (\i. (f:num->real^M->real^N) i x)` THEN ASM_SIMP_TAC[IN_DIFF; GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[INTER_UNIV]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[lspace; IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN EXISTS_TAC `\n x. vsum (0..n) (\i. (f:num->real^M->real^N) i x)` THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `0..n = UNIV INTER (0..n)`] THEN ASM_REWRITE_TAC[GSYM sums] THEN GEN_TAC THEN REWRITE_TAC[INTER_UNIV] THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[FINITE_NUMSEG]; DISCH_TAC] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. if x IN k then lift(norm(l x:real^N) rpow p) else (hp:real^M->real^1) x` THEN ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM; ETA_AX; REAL_ARITH `&1 <= p ==> &0 < p`] THEN CONJ_TAC THENL [UNDISCH_TAC `(hp:real^M->real^1) integrable_on s` THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `k:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]; REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(h(x:real^M)) rpow p` THEN CONJ_TAC THENL [MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; IN_DIFF] THEN ASM_REAL_ARITH_TAC; EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `x = y pow 1 ==> x <= y`) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `drop(hp(x:real^M)) rpow (inv p * p)` THEN CONJ_TAC THENL [MATCH_MP_TAC RPOW_RPOW THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\k. lift(drop((g:num->real^M->real^1) k x) rpow p)` THEN ASM_SIMP_TAC[IN_DIFF; TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_SIMP_TAC[LIFT_DROP; RPOW_POS_LE; EVENTUALLY_TRUE]; ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN REWRITE_TAC[RPOW_POW]]]]; DISCH_TAC] THEN SUBGOAL_THEN `!x:real^M. x IN s DIFF k ==> &0 <= drop(h x)` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^M. x IN s DIFF k ==> &0 <= drop(hp x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN EXISTS_TAC `\k. lift(drop((g:num->real^M->real^1) k x) rpow p)` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; RPOW_POS_LE] THEN REWRITE_TAC[EVENTUALLY_TRUE]; ALL_TAC] THEN MP_TAC(ISPECL [`\n x. lift(norm(vsum (0..n) (\i. (f:num->real^M->real^N) i x) - l x) rpow p)`; `(\x. vec 0):real^M->real^1`; `\x:real^M. &2 rpow p % lift(drop(h x) rpow p)`; `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN REWRITE_TAC[lnorm; INTEGRAL_0; REAL_INTEGRAL_0; INTEGRABLE_0] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; MATCH_MP_TAC LSPACE_IMP_INTEGRABLE THEN MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LSPACE_VSUM THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC INTEGRABLE_CMUL THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN EXISTS_TAC `hp:real^M->real^1` THEN EXISTS_TAC `{}:real^M->bool` THEN ASM_SIMP_TAC[DIFF_EMPTY; NEGLIGIBLE_EMPTY; RPOW_RPOW] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN REWRITE_TAC[LIFT_DROP; RPOW_POW; REAL_POW_1] THEN UNDISCH_TAC `(hp:real^M->real^1) integrable_on s` THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; REWRITE_TAC[DROP_CMUL; GSYM RPOW_MUL; LIFT_DROP] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN REWRITE_TAC[REAL_ABS_NORM; LIFT_DROP; REAL_ABS_RPOW] THEN MATCH_MP_TAC RPOW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= a /\ norm(y) <= a ==> norm(x - y) <= &2 * a`) THEN ASM_SIMP_TAC[]; X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_RPOW THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF]; ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[GSYM LIM_NULL_NORM] THEN REWRITE_TAC[GSYM LIM_NULL] THEN RULE_ASSUM_TAC(REWRITE_RULE[sums; INTER_UNIV]) THEN ASM_SIMP_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ; o_DEF] LIM_NULL_RPOW)) THEN DISCH_THEN(MP_TAC o SPEC `inv p:real`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[tendsto; DIST_0; NORM_REAL; GSYM drop; LIFT_DROP] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN SUBGOAL_THEN `!f:real^M->real^1. integral (s DIFF k) f = integral s f` MP_TAC THENL [ALL_TAC; SIMP_TAC[REAL_ARITH `abs(x) < e ==> x < e`]] THEN GEN_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]);; let LSPACE_SUMMABLE = prove (`!f:num->real^M->real^N p s t. &1 <= p /\ (!i. i IN t ==> f i IN lspace s p) /\ real_summable t (\i. lnorm s p (f i)) ==> ?g. g IN lspace s p /\ ((\n. lnorm s p (\x. vsum (t INTER (0..n)) (\i. f i x) - g x)) ---> &0) sequentially`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUMMABLE_RESTRICT] THEN REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(\n:num x. if n IN t then f n x else vec 0):num->real^M->real^N`; `p:real`; `s:real^M->bool`] LSPACE_SUMMABLE_UNIV) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN t` THEN ASM_SIMP_TAC[LSPACE_0; ETA_AX; REAL_ARITH `&1 <= p ==> ~(p = &0)`]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_summable]) THEN REWRITE_TAC[real_summable] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ETA_AX; LNORM_0; REAL_ARITH `&1 <= p ==> ~(p = &0)`]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN ASM_CASES_TAC `(g:real^M->real^N) IN lspace s p` THEN ASM_REWRITE_TAC[tendsto_real] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x = y ==> x < e ==> abs y < e`) THEN CONJ_TAC THENL [MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC LSPACE_SUB THEN ASM_SIMP_TAC[REAL_ARITH `&1 <= p ==> &0 <= p`] THEN MATCH_MP_TAC LSPACE_VSUM THEN ASM_SIMP_TAC[FINITE_NUMSEG; REAL_ARITH `&1 <= p ==> &0 < p`] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN t` THEN ASM_SIMP_TAC[ETA_AX; LSPACE_0; REAL_ARITH `&1 <= p ==> ~(p = &0)`]; AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN REWRITE_TAC[SET_RULE `s INTER t = {x | x IN t /\ x IN s}`]]]);; let RIESZ_FISCHER = prove (`!f:num->real^M->real^N p s. &1 <= p /\ (!n. (f n) IN lspace s p) /\ (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> lnorm s p (\x. f m x - f n x) < e) ==> ?g. g IN lspace s p /\ !e. &0 < e ==> ?N. !n. n >= N ==> lnorm s p (\x. f n x - g x) < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?k:num->num. (!n. k n < k (SUC n)) /\ (!n. lnorm s p ((\x. f (k(SUC n)) x - f (k n) x):real^M->real^N) < inv(&2 pow n))` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `N:num->num`) THEN MP_TAC(prove_recursive_functions_exist num_RECURSION `k 0 = N 0 /\ !n. k(SUC n) = MAX (k n + 1) (MAX (N n) (N(SUC n)))`) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n < MAX (n + 1) m`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ARITH_TAC; SPEC_TAC(`n:num`,`n:num`)] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\n x. f (k(SUC n)) x - (f:num->real^M->real^N) (k n) x`; `p:real`; `s:real^M->bool`] LSPACE_SUMMABLE_UNIV) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[LSPACE_SUB; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`] THEN MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN EXISTS_TAC `\n. inv(&2) pow n` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_SUMMABLE_GP THEN CONV_TAC REAL_RAT_REDUCE_CONV; EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM REAL_INV_POW] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < y ==> abs x <= y`) THEN ASM_SIMP_TAC[LNORM_POS_LE; LSPACE_SUB; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`]]; DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN EXISTS_TAC `\x. (g:real^M->real^N) x + f (k 0:num) x` THEN ASM_SIMP_TAC[LSPACE_ADD; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[ADD1; VSUM_DIFFS_ALT; LE_0] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "+")) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GE] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[ARITH_RULE `MAX N1 N2 <= n <=> N1 <= n /\ N2 <= n`] THEN STRIP_TAC THEN REMOVE_THEN "+" (MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k(n + 1):num`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n + 1` THEN CONJ_TAC THENL [ASM_ARITH_TAC; SPEC_TAC(`n + 1`,`m:num`)] THEN INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN MATCH_MP_TAC(ARITH_RULE `m <= k m /\ k m < k(SUC m) ==> SUC m <= k(SUC m)`) THEN ASM_REWRITE_TAC[]; REPEAT DISCH_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `f n x - (g x + f (k 0) x):real^N = (f (k (n + 1)) x - f (k 0) x - g x) + --(f (k (n + 1)) x - f n x)`] THEN W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN ASM_SIMP_TAC[LSPACE_SUB; LSPACE_NEG; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> z <= x + y ==> z < e`) THEN ASM_SIMP_TAC[LNORM_NEG; LSPACE_SUB; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`]]]);; (* ------------------------------------------------------------------------- *) (* A sort of dominated convergence theorem for L_p spaces. *) (* ------------------------------------------------------------------------- *) let LSPACE_DOMINATED_CONVERGENCE = prove (`!f:num->real^M->real^N g h:real^M->real^N s p k. &0 < p /\ (!n. (f n) IN lspace s p) /\ h IN lspace s p /\ (!n x. x IN s ==> norm(f n x) <= norm(h x)) /\ negligible k /\ (!x. x IN s DIFF k ==> ((\n. f n x) --> g(x)) sequentially) ==> g IN lspace s p /\ ((\n. lnorm s p (\x. f n x - g x)) ---> &0) sequentially`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(norm((f:num->real^M->real^N) n x) rpow p)`; `\x. lift(norm((g:real^M->real^N) x) rpow p)`; `\x. lift(norm((h:real^M->real^N) x) rpow p)`; `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `k:num` THEN FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE o SPEC `k:num`) THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; MAP_EVERY X_GEN_TAC [`k:num`; `x:real^M`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM; LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o ISPEC `(lift o (\x. x rpow p) o drop) o (lift o (norm:real^N->real))` o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN REWRITE_TAC[CONTINUOUS_AT_LIFT_NORM] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC]; STRIP_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN EXISTS_TAC `f:num->real^M->real^N` THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [TAUT `a ==> b ==> c <=> b ==> a ==> c`] INTEGRABLE_SPIKE_SET)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]; DISCH_TAC] THEN SUBGOAL_THEN `!x. x IN s DIFF k ==> norm((g:real^M->real^N) x) <= norm((h:real^M->real^N) x)` ASSUME_TAC THENL [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\n x. lift(norm((f:num->real^M->real^N) n x - g x) rpow p)`; `(\x. vec 0):real^M->real^1`; `\x. lift(norm(&2 % (h:real^M->real^N) x) rpow p)`; `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `k:num` THEN SUBGOAL_THEN `(\x. (f:num->real^M->real^N) k x - g x) IN lspace s p` MP_TAC THENL [ASM_SIMP_TAC[LSPACE_SUB; REAL_LT_IMP_LE; ETA_AX]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; REWRITE_TAC[NORM_MUL; RPOW_MUL; LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN UNDISCH_TAC `(h:real^M->real^N) IN lspace s p` THEN DISCH_THEN(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; MAP_EVERY X_GEN_TAC [`k:num`; `x:real^M`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM; LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= norm(z) /\ norm(y) <= norm z ==> norm(x - y) <= norm(&2 % z:real^N)`) THEN ASM_SIMP_TAC[IN_DIFF]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN UNDISCH_TAC `!x. x IN s DIFF k ==> ((\n. (f:num->real^M->real^N) n x) --> g x) sequentially` THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [LIM_NULL] THEN DISCH_THEN(MP_TAC o ISPEC `(lift o (\x. x rpow p) o drop) o (lift o (norm:real^N->real))` o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN ASM_SIMP_TAC[NORM_0; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_DROP; LIFT_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN REWRITE_TAC[CONTINUOUS_AT_LIFT_NORM] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN REWRITE_TAC[INTEGRAL_0; TENDSTO_REAL; lnorm; o_DEF; LIFT_DROP; LIFT_NUM] THEN DISCH_THEN(MP_TAC o ISPEC `lift o (\x. x rpow inv p) o drop` o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN ASM_SIMP_TAC[REAL_INV_EQ_0; REAL_LT_IMP_NZ; LIFT_NUM] THEN ANTS_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Approximation of functions in L_p by bounded ones and continuous ones. *) (* ------------------------------------------------------------------------- *) let LSPACE_APPROXIMATE_BOUNDED = prove (`!f:real^M->real^N s p e. &0 < p /\ measurable s /\ f IN lspace s p /\ &0 < e ==> ?g. g IN lspace s p /\ bounded (IMAGE g s) /\ lnorm s p (\x. f x - g x) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\n x. (lambda i. max (--(&n)) (min (&n) ((f:real^M->real^N)(x)$i)))) :num->real^M->real^N`; `f:real^M->real^N`; `f:real^M->real^N`; `s:real^M->bool`; `p:real`; `{}:real^M->bool`] LSPACE_DOMINATED_CONVERGENCE) THEN ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN MATCH_MP_TAC(TAUT `b /\ c /\ a /\ (a /\ d ==> e) ==> (a /\ b /\ c ==> d) ==> e`) THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[DIFF_EMPTY] THEN DISCH_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(ISPEC `sup(IMAGE (\i. abs((f:real^M->real^N) x$i)) (1..dimindex(:N)))` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG; CART_EQ; LAMBDA_BETA] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= n ==> max (--n) (min n x) = x`) THEN ASM_MESON_TAC[REAL_OF_NUM_LE; REAL_LE_TRANS]; X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`s:real^M->bool`; `p:real`; `vec n:real^N`] LSPACE_CONST) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(f:real^M->real^N) IN lspace s p` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LSPACE_MIN)) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real^M->bool`; `p:real`; `--vec n:real^N`] LSPACE_CONST) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LSPACE_MAX)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `x = y ==> x IN s ==> y IN s`) THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; REAL_SUB_RZERO] THEN DISCH_TAC THEN EXISTS_TAC `(\x. (lambda i. max (-- &n) (min (&n) ((f:real^M->real^N) x$i)))) :real^M->real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&(dimindex(:N)) * &n` THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `abs(x) < e ==> x < e`) THEN ONCE_REWRITE_TAC[GSYM LNORM_NEG] THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB]]]);; let LSPACE_APPROXIMATE_CONTINUOUS = prove (`!f:real^M->real^N s p e. &1 <= p /\ measurable s /\ f IN lspace s p /\ &0 < e ==> ?g. g continuous_on (:real^M) /\ g IN lspace s p /\ lnorm s p (\x. f x - g x) < e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 <= p ==> &0 < p`)) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `p:real`; `e / &2`] LSPACE_APPROXIMATE_BOUNDED) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?k g. negligible k /\ (!n. g n continuous_on (:real^M)) /\ (!n x. x IN s ==> norm(g n x:real^N) <= norm(B % vec 1:real^N)) /\ (!x. x IN (s DIFF k) ==> ((\n. g n x) --> h x) sequentially)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `(h:real^M->real^N) measurable_on s` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[measurable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\n x. lambda i. max (--B) (min B (((g n x):real^N)$i))): num->real^M->real^N` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN MP_TAC(ISPECL [`(:real^M)`; `(lambda i. B):real^N`] CONTINUOUS_ON_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN MP_TAC(ISPECL [`(:real^M)`; `(lambda i. --B):real^N`] CONTINUOUS_ON_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA]; REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `ee:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(c - a:real^N) <= norm(b - a) ==> dist(b,a) < ee ==> dist(c,a) < ee`) THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!n. ((g:num->real^M->real^N) n) IN lspace s p` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC LSPACE_BOUNDED_MEASURABLE THEN EXISTS_TAC `(\x. B % vec 1):real^M->real^N` THEN ASM_SIMP_TAC[LSPACE_CONST] THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN MATCH_MP_TAC(REWRITE_RULE[lebesgue_measurable; indicator] MEASURABLE_ON_RESTRICT) THEN ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN ASM_REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE]; ALL_TAC] THEN MP_TAC(ISPECL [`g:num->real^M->real^N`; `h:real^M->real^N`; `(\x. B % vec 1):real^M->real^N`; `s:real^M->bool`; `p:real`; `k:real^M->bool`] LSPACE_DOMINATED_CONVERGENCE) THEN ASM_SIMP_TAC[LSPACE_CONST] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN EXISTS_TAC `(g:num->real^M->real^N) n` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\x. f x - (g:num->real^M->real^N) n x) = (\x. (f x - h x) + --(g n x - h x))` SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN ASM_SIMP_TAC[LSPACE_SUB; ETA_AX; REAL_LT_IMP_LE; LSPACE_NEG] THEN MATCH_MP_TAC(REAL_ARITH `y < e / &2 /\ z < e / &2 ==> x <= y + z ==> x < e`) THEN ASM_SIMP_TAC[LNORM_NEG; REAL_ARITH `abs x < e ==> x < e`]);; hol-light/Multivariate/make.ml000066400000000000000000000042231303454263000166630ustar00rootroot00000000000000(* ========================================================================= *) (* Theory of multivariate calculus in Euclidean space. *) (* ========================================================================= *) loadt "Library/card.ml";; (* For countable set theorems. *) loadt "Library/permutations.ml";; (* For determinants *) loadt "Library/products.ml";; (* For determinants and integrals *) loadt "Library/floor.ml";; (* Useful here and there *) loadt "Multivariate/misc.ml";; (* Background stuff *) loadt "Library/iter.ml";; (* n-fold iteration of function *) (* ------------------------------------------------------------------------- *) (* The main core theory. *) (* ------------------------------------------------------------------------- *) loadt "Multivariate/metric.ml";; (* General topology, metric spaces *) loadt "Multivariate/vectors.ml";; (* Basic vectors, linear algebra *) loadt "Multivariate/determinants.ml";; (* Determinant and trace *) loadt "Multivariate/topology.ml";; (* Topology of R^n and much else *) loadt "Multivariate/convex.ml";; (* Convex sets and functions *) loadt "Multivariate/paths.ml";; (* Paths, simple connectedness etc. *) loadt "Multivariate/polytope.ml";; (* Faces, polytopes, polyhedra etc. *) loadt "Multivariate/degree.ml";; (* Brouwer degree, retracts etc. *) loadt "Multivariate/derivatives.ml";; (* Derivatives *) loadt "Multivariate/clifford.ml";; (* Geometric (Clifford) algebra *) loadt "Multivariate/integration.ml";; (* Integration, bounded variation *) loadt "Multivariate/measure.ml";; (* Lebesgue measure *) (* ------------------------------------------------------------------------- *) (* Updated database, for convenience where dynamic updating doesn't work. *) (* ------------------------------------------------------------------------- *) loadt "Multivariate/multivariate_database.ml";; hol-light/Multivariate/make_complex.ml000066400000000000000000000056511303454263000204200ustar00rootroot00000000000000(* ========================================================================= *) (* Theory of multivariate calculus in Euclidean space. *) (* ========================================================================= *) loadt "Library/card.ml";; (* For countable set theorems. *) loadt "Library/permutations.ml";; (* For determinants *) loadt "Library/products.ml";; (* For determinants and integrals *) loadt "Library/floor.ml";; (* Useful here and there *) loadt "Multivariate/misc.ml";; (* Background stuff *) loadt "Library/iter.ml";; (* n-fold iteration of function *) loadt "Library/binomial.ml";; (* For Leibniz deriv formula etc. *) (* ------------------------------------------------------------------------- *) (* The main core theory. *) (* ------------------------------------------------------------------------- *) loadt "Multivariate/metric.ml";; (* General topology, metric spaces *) loadt "Multivariate/vectors.ml";; (* Basic vectors, linear algebra *) loadt "Multivariate/determinants.ml";; (* Determinant and trace *) loadt "Multivariate/topology.ml";; (* Topology of R^n and much else *) loadt "Multivariate/convex.ml";; (* Convex sets and functions *) loadt "Multivariate/paths.ml";; (* Paths, simple connectedness etc. *) loadt "Multivariate/polytope.ml";; (* Faces, polytopes, polyhedra etc. *) loadt "Multivariate/degree.ml";; (* Brouwer degree, retracts etc. *) loadt "Multivariate/derivatives.ml";; (* Derivatives *) loadt "Multivariate/clifford.ml";; (* Geometric (Clifford) algebra *) loadt "Multivariate/integration.ml";; (* Integration, bounded variation *) loadt "Multivariate/measure.ml";; (* Lebesgue measure *) (* ------------------------------------------------------------------------- *) (* Complex numbers (as R^2), complex analysis and some more topology. *) (* ------------------------------------------------------------------------- *) loadt "Multivariate/complexes.ml";; (* Complex numbers *) loadt "Multivariate/canal.ml";; (* Complex analysis *) loadt "Multivariate/transcendentals.ml";; (* Real & complex transcendentals *) loadt "Multivariate/realanalysis.ml";; (* Some analytical stuff on R *) loadt "Multivariate/moretop.ml";; (* Further topological results *) loadt "Multivariate/cauchy.ml";; (* Complex line integrals *) (* ------------------------------------------------------------------------- *) (* Updated database, for convenience where dynamic updating doesn't work. *) (* ------------------------------------------------------------------------- *) loadt "Multivariate/complex_database.ml";; hol-light/Multivariate/measure.ml000066400000000000000000055617201303454263000174260ustar00rootroot00000000000000(* ========================================================================= *) (* Lebesgue measure, measurable functions (defined via the gauge integral). *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* ========================================================================= *) needs "Library/card.ml";; needs "Library/permutations.ml";; needs "Multivariate/integration.ml";; needs "Multivariate/determinants.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Lebesgue measure in the case where the measure is finite. This is our *) (* default notion of "measurable", but we also define "lebesgue_measurable" *) (* further down. Note that in neither case do we assume the set is bounded. *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_measure",(12,"right"));; let has_measure = new_definition `s has_measure m <=> ((\x. vec 1) has_integral (lift m)) s`;; let measurable = new_definition `measurable s <=> ?m. s has_measure m`;; let measure = new_definition `measure s = @m. s has_measure m`;; let HAS_MEASURE_MEASURE = prove (`!s. measurable s <=> s has_measure (measure s)`, REWRITE_TAC[measure; measurable] THEN MESON_TAC[]);; let HAS_MEASURE_UNIQUE = prove (`!s m1 m2. s has_measure m1 /\ s has_measure m2 ==> m1 = m2`, REWRITE_TAC[has_measure; GSYM LIFT_EQ] THEN MESON_TAC[HAS_INTEGRAL_UNIQUE]);; let MEASURE_UNIQUE = prove (`!s m. s has_measure m ==> measure s = m`, MESON_TAC[HAS_MEASURE_UNIQUE; HAS_MEASURE_MEASURE; measurable]);; let HAS_MEASURE_MEASURABLE_MEASURE = prove (`!s m. s has_measure m <=> measurable s /\ measure s = m`, REWRITE_TAC[HAS_MEASURE_MEASURE] THEN MESON_TAC[MEASURE_UNIQUE]);; let HAS_MEASURE_IMP_MEASURABLE = prove (`!s m. s has_measure m ==> measurable s`, REWRITE_TAC[measurable] THEN MESON_TAC[]);; let HAS_MEASURE = prove (`!s m. s has_measure m <=> ((\x. if x IN s then vec 1 else vec 0) has_integral (lift m)) (:real^N)`, SIMP_TAC[HAS_INTEGRAL_RESTRICT_UNIV; has_measure]);; let MEASURABLE = prove (`!s. measurable s <=> (\x. vec 1:real^1) integrable_on s`, REWRITE_TAC[measurable; integrable_on; has_measure; EXISTS_DROP; LIFT_DROP]);; let MEASURABLE_INTEGRABLE = prove (`measurable s <=> (\x. if x IN s then vec 1 else vec 0:real^1) integrable_on UNIV`, REWRITE_TAC[measurable; integrable_on; HAS_MEASURE; EXISTS_DROP; LIFT_DROP]);; let MEASURE_INTEGRAL = prove (`!s. measurable s ==> measure s = drop (integral s (\x. vec 1))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[GSYM has_measure; GSYM HAS_MEASURE_MEASURE]);; let MEASURE_INTEGRAL_UNIV = prove (`!s. measurable s ==> measure s = drop(integral UNIV (\x. if x IN s then vec 1 else vec 0))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[GSYM HAS_MEASURE; GSYM HAS_MEASURE_MEASURE]);; let INTEGRAL_MEASURE = prove (`!s. measurable s ==> integral s (\x. vec 1) = lift(measure s)`, SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; MEASURE_INTEGRAL]);; let INTEGRAL_MEASURE_UNIV = prove (`!s. measurable s ==> integral UNIV (\x. if x IN s then vec 1 else vec 0) = lift(measure s)`, SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; MEASURE_INTEGRAL_UNIV]);; let INTEGRABLE_ON_INDICATOR = prove (`!s t:real^N->bool. indicator s integrable_on t <=> measurable(s INTER t)`, ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[MEASURABLE_INTEGRABLE; GSYM indicator] THEN REPEAT GEN_TAC THEN REWRITE_TAC[indicator; IN_INTER] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[VEC_EQ; ARITH_EQ]));; let ABSOLUTELY_INTEGRABLE_ON_INDICATOR = prove (`!s t:real^N->bool. indicator s absolutely_integrable_on t <=> measurable(s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INTEGRABLE_ON_INDICATOR] THEN REWRITE_TAC[absolutely_integrable_on; indicator; COND_RAND] THEN REWRITE_TAC[NORM_1; DROP_VEC; REAL_ABS_NUM; LIFT_NUM]);; let INTEGRAL_INDICATOR = prove (`!s t:real^M->bool. measurable(s INTER t) ==> integral t (indicator s) = lift(measure(s INTER t))`, SIMP_TAC[MEASURE_INTEGRAL; LIFT_DROP; indicator; INTEGRAL_RESTRICT_INTER]);; let HAS_MEASURE_INTERVAL = prove (`(!a b:real^N. interval[a,b] has_measure content(interval[a,b])) /\ (!a b:real^N. interval(a,b) has_measure content(interval[a,b]))`, MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[has_measure] THEN ONCE_REWRITE_TAC[LIFT_EQ_CMUL] THEN REWRITE_TAC[HAS_INTEGRAL_CONST]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN SIMP_TAC[HAS_MEASURE] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_INTEGRAL_SPIKE) THEN EXISTS_TAC `interval[a:real^N,b] DIFF interval(a,b)` THEN REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN SET_TAC[]);; let MEASURABLE_INTERVAL = prove (`(!a b:real^N. measurable (interval[a,b])) /\ (!a b:real^N. measurable (interval(a,b)))`, REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_INTERVAL]);; let MEASURE_INTERVAL = prove (`(!a b:real^N. measure(interval[a,b]) = content(interval[a,b])) /\ (!a b:real^N. measure(interval(a,b)) = content(interval[a,b]))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN REWRITE_TAC[HAS_MEASURE_INTERVAL]);; let MEASURE_INTERVAL_1 = prove (`(!a b:real^1. measure(interval[a,b]) = if drop a <= drop b then drop b - drop a else &0) /\ (!a b:real^1. measure(interval(a,b)) = if drop a <= drop b then drop b - drop a else &0)`, REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; PRODUCT_1; drop]);; let MEASURE_INTERVAL_1_ALT = prove (`(!a b:real^1. measure(interval[a,b]) = if drop a < drop b then drop b - drop a else &0) /\ (!a b:real^1. measure(interval(a,b)) = if drop a < drop b then drop b - drop a else &0)`, REWRITE_TAC[MEASURE_INTERVAL_1] THEN REAL_ARITH_TAC);; let MEASURE_INTERVAL_2 = prove (`(!a b:real^2. measure(interval[a,b]) = if a$1 <= b$1 /\ a$2 <= b$2 then (b$1 - a$1) * (b$2 - a$2) else &0) /\ (!a b:real^2. measure(interval(a,b)) = if a$1 <= b$1 /\ a$2 <= b$2 then (b$1 - a$1) * (b$2 - a$2) else &0)`, REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; PRODUCT_2]);; let MEASURE_INTERVAL_2_ALT = prove (`(!a b:real^2. measure(interval[a,b]) = if a$1 < b$1 /\ a$2 < b$2 then (b$1 - a$1) * (b$2 - a$2) else &0) /\ (!a b:real^2. measure(interval(a,b)) = if a$1 < b$1 /\ a$2 < b$2 then (b$1 - a$1) * (b$2 - a$2) else &0)`, REWRITE_TAC[MEASURE_INTERVAL_2] THEN REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`(a:real^2)$1 = (b:real^2)$1`; `(a:real^2)$2 = (b:real^2)$2`] THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN ASM_REWRITE_TAC[REAL_LT_LE]);; let MEASURE_INTERVAL_3 = prove (`(!a b:real^3. measure(interval[a,b]) = if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) else &0) /\ (!a b:real^3. measure(interval(a,b)) = if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) else &0)`, REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[DIMINDEX_3; FORALL_3; PRODUCT_3]);; let MEASURE_INTERVAL_3_ALT = prove (`(!a b:real^3. measure(interval[a,b]) = if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) else &0) /\ (!a b:real^3. measure(interval(a,b)) = if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) else &0)`, REWRITE_TAC[MEASURE_INTERVAL_3] THEN REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`(a:real^3)$1 = (b:real^3)$1`; `(a:real^3)$2 = (b:real^3)$2`; `(a:real^3)$3 = (b:real^3)$3`] THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN ASM_REWRITE_TAC[REAL_LT_LE]);; let MEASURE_INTERVAL_4 = prove (`(!a b:real^4. measure(interval[a,b]) = if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 /\ a$4 <= b$4 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) else &0) /\ (!a b:real^4. measure(interval(a,b)) = if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 /\ a$4 <= b$4 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) else &0)`, REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[DIMINDEX_4; FORALL_4; PRODUCT_4]);; let MEASURE_INTERVAL_4_ALT = prove (`(!a b:real^4. measure(interval[a,b]) = if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 /\ a$4 < b$4 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) else &0) /\ (!a b:real^4. measure(interval(a,b)) = if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 /\ a$4 < b$4 then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) else &0)`, REWRITE_TAC[MEASURE_INTERVAL_4] THEN REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`(a:real^4)$1 = (b:real^4)$1`; `(a:real^4)$2 = (b:real^4)$2`; `(a:real^4)$3 = (b:real^4)$3`; `(a:real^4)$4 = (b:real^4)$4`] THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN ASM_REWRITE_TAC[REAL_LT_LE]);; let MEASURABLE_INTER = prove (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s INTER t)`, REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN SUBGOAL_THEN `(\x. if x IN s INTER t then vec 1 else vec 0):real^N->real^1 = (\x. lambda i. min (((if x IN s then vec 1 else vec 0):real^1)$i) (((if x IN t then vec 1 else vec 0):real^1)$i))` SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN ASM_SIMP_TAC[IN_INTER; VEC_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN THEN CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS]);; let MEASURABLE_UNION = prove (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s UNION t)`, REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN SUBGOAL_THEN `(\x. if x IN s UNION t then vec 1 else vec 0):real^N->real^1 = (\x. lambda i. max (((if x IN s then vec 1 else vec 0):real^1)$i) (((if x IN t then vec 1 else vec 0):real^1)$i))` SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN ASM_SIMP_TAC[IN_UNION; VEC_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX THEN CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS]);; let HAS_MEASURE_DISJOINT_UNION = prove (`!s1 s2 m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ DISJOINT s1 s2 ==> (s1 UNION s2) has_measure (m1 + m2)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_MEASURE; CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REPEAT(COND_CASES_TAC THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]) THEN ASM SET_TAC[]);; let MEASURE_DISJOINT_UNION = prove (`!s t. measurable s /\ measurable t /\ DISJOINT s t ==> measure(s UNION t) = measure s + measure t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNION; GSYM HAS_MEASURE_MEASURE]);; let MEASURE_DISJOINT_UNION_EQ = prove (`!s t u. measurable s /\ measurable t /\ s UNION t = u /\ DISJOINT s t ==> measure s + measure t = measure u`, MESON_TAC[MEASURE_DISJOINT_UNION]);; let HAS_MEASURE_POS_LE = prove (`!m s:real^N->bool. s has_measure m ==> &0 <= m`, REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC(ISPEC `(\x. if x IN s then vec 1 else vec 0):real^N->real^1` HAS_INTEGRAL_COMPONENT_POS) THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[DIMINDEX_1; ARITH; IN_UNIV] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[GSYM drop; DROP_VEC; REAL_POS]);; let MEASURE_POS_LE = prove (`!s. measurable s ==> &0 <= measure s`, REWRITE_TAC[HAS_MEASURE_MEASURE; HAS_MEASURE_POS_LE]);; let HAS_MEASURE_SUBSET = prove (`!s1 s2:real^N->bool m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ s1 SUBSET s2 ==> m1 <= m2`, REPEAT GEN_TAC THEN REWRITE_TAC[has_measure] THEN STRIP_TAC THEN GEN_REWRITE_TAC BINOP_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN MATCH_MP_TAC(ISPEC `(\x. vec 1):real^N->real^1` HAS_INTEGRAL_SUBSET_DROP_LE) THEN MAP_EVERY EXISTS_TAC [`s1:real^N->bool`; `s2:real^N->bool`] THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS]);; let MEASURE_SUBSET = prove (`!s t. measurable s /\ measurable t /\ s SUBSET t ==> measure s <= measure t`, REWRITE_TAC[HAS_MEASURE_MEASURE] THEN MESON_TAC[HAS_MEASURE_SUBSET]);; let HAS_MEASURE_0 = prove (`!s:real^N->bool. s has_measure &0 <=> negligible s`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; REWRITE_TAC[NEGLIGIBLE; has_measure] THEN DISCH_THEN(MP_TAC o SPEC `(:real^N)`) THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[IN_UNIV; indicator; LIFT_NUM]] THEN REWRITE_TAC[negligible] THEN REWRITE_TAC[has_measure] THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[LIFT_NUM] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [HAS_INTEGRAL_ALT]) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[integrable_on; IN_UNIV] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[indicator] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN SUBGOAL_THEN `y:real^1 = vec 0` (fun th -> ASM_MESON_TAC[th]) THEN REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPEC `(\x. if x IN interval [a,b] then if x IN s then vec 1 else vec 0 else vec 0):real^N->real^1` HAS_INTEGRAL_DROP_LE) THEN EXISTS_TAC `(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; REWRITE_TAC[DROP_VEC] THEN MATCH_MP_TAC(ISPEC `(\x. if x IN interval [a,b] then if x IN s then vec 1 else vec 0 else vec 0):real^N->real^1` HAS_INTEGRAL_DROP_POS)] THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);; let MEASURE_EQ_0 = prove (`!s. negligible s ==> measure s = &0`, MESON_TAC[MEASURE_UNIQUE; HAS_MEASURE_0]);; let NEGLIGIBLE_IMP_MEASURABLE = prove (`!s:real^N->bool. negligible s ==> measurable s`, MESON_TAC[HAS_MEASURE_0; measurable]);; let HAS_MEASURE_EMPTY = prove (`{} has_measure &0`, REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_EMPTY]);; let MEASURE_EMPTY = prove (`measure {} = &0`, SIMP_TAC[MEASURE_EQ_0; NEGLIGIBLE_EMPTY]);; let MEASURABLE_EMPTY = prove (`measurable {}`, REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_EMPTY]);; let MEASURABLE_SING = prove (`!a:real^N. measurable {a}`, MESON_TAC[NEGLIGIBLE_IMP_MEASURABLE; NEGLIGIBLE_SING]);; let MEASURABLE_MEASURE_EQ_0 = prove (`!s. measurable s ==> (measure s = &0 <=> negligible s)`, REWRITE_TAC[HAS_MEASURE_MEASURE; GSYM HAS_MEASURE_0] THEN MESON_TAC[MEASURE_UNIQUE]);; let NEGLIGIBLE_EQ_MEASURE_0 = prove (`!s:real^N->bool. negligible s <=> measurable s /\ measure s = &0`, MESON_TAC[NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_MEASURE_EQ_0]);; let MEASURE_SING = prove (`!a:real^N. measure {a} = &0`, MESON_TAC[NEGLIGIBLE_EQ_MEASURE_0; NEGLIGIBLE_SING]);; let MEASURABLE_MEASURE_POS_LT = prove (`!s. measurable s ==> (&0 < measure s <=> ~negligible s)`, SIMP_TAC[REAL_LT_LE; MEASURE_POS_LE; GSYM MEASURABLE_MEASURE_EQ_0] THEN REWRITE_TAC[EQ_SYM_EQ]);; let NEGLIGIBLE_INTERVAL = prove (`(!a b. negligible(interval[a,b]) <=> interval(a,b) = {}) /\ (!a b. negligible(interval(a,b)) <=> interval(a,b) = {})`, REWRITE_TAC[GSYM HAS_MEASURE_0] THEN MESON_TAC[HAS_MEASURE_INTERVAL; CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL; HAS_MEASURE_UNIQUE]);; let MEASURABLE_UNIONS = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> measurable s) ==> measurable (UNIONS f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[UNIONS_0; UNIONS_INSERT; MEASURABLE_EMPTY] THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_UNION THEN ASM_SIMP_TAC[]);; let HAS_MEASURE_DIFF_SUBSET = prove (`!s1 s2 m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ s2 SUBSET s1 ==> (s1 DIFF s2) has_measure (m1 - m2)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_MEASURE; CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN ASM SET_TAC[]);; let MEASURABLE_DIFF = prove (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s DIFF t)`, SUBGOAL_THEN `!s t:real^N->bool. measurable s /\ measurable t /\ t SUBSET s ==> measurable (s DIFF t)` ASSUME_TAC THENL [REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_DIFF_SUBSET]; ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_INTER] THEN SET_TAC[]]);; let MEASURE_DIFF_SUBSET = prove (`!s t. measurable s /\ measurable t /\ t SUBSET s ==> measure(s DIFF t) = measure s - measure t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_DIFF_SUBSET; GSYM HAS_MEASURE_MEASURE]);; let HAS_MEASURE_UNION_NEGLIGIBLE = prove (`!s t:real^N->bool m. s has_measure m /\ negligible t ==> (s UNION t) has_measure m`, REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN MAP_EVERY EXISTS_TAC [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; `t:real^N->bool`] THEN ASM_SIMP_TAC[IN_DIFF; IN_UNIV; IN_UNION]);; let HAS_MEASURE_DIFF_NEGLIGIBLE = prove (`!s t:real^N->bool m. s has_measure m /\ negligible t ==> (s DIFF t) has_measure m`, REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN MAP_EVERY EXISTS_TAC [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; `t:real^N->bool`] THEN ASM_SIMP_TAC[IN_DIFF; IN_UNIV; IN_UNION]);; let HAS_MEASURE_UNION_NEGLIGIBLE_EQ = prove (`!s t:real^N->bool m. negligible t ==> ((s UNION t) has_measure m <=> s has_measure m)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[HAS_MEASURE_UNION_NEGLIGIBLE] THEN SUBST1_TAC(SET_RULE `s:real^N->bool = (s UNION t) DIFF (t DIFF s)`) THEN MATCH_MP_TAC HAS_MEASURE_DIFF_NEGLIGIBLE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_DIFF THEN ASM_REWRITE_TAC[]);; let HAS_MEASURE_DIFF_NEGLIGIBLE_EQ = prove (`!s t:real^N->bool m. negligible t ==> ((s DIFF t) has_measure m <=> s has_measure m)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE] THEN SUBST1_TAC(SET_RULE `s:real^N->bool = (s DIFF t) UNION (t INTER s)`) THEN MATCH_MP_TAC HAS_MEASURE_UNION_NEGLIGIBLE THEN ASM_SIMP_TAC[NEGLIGIBLE_INTER]);; let HAS_MEASURE_ALMOST = prove (`!s s' t m. s has_measure m /\ negligible t /\ s UNION t = s' UNION t ==> s' has_measure m`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `s UNION t = s' UNION t ==> s' = (s UNION t) DIFF (t DIFF s')`)) THEN ASM_SIMP_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE; HAS_MEASURE_UNION_NEGLIGIBLE; NEGLIGIBLE_DIFF]);; let HAS_MEASURE_ALMOST_EQ = prove (`!s s' t. negligible t /\ s UNION t = s' UNION t ==> (s has_measure m <=> s' has_measure m)`, MESON_TAC[HAS_MEASURE_ALMOST]);; let MEASURABLE_ALMOST = prove (`!s s' t. measurable s /\ negligible t /\ s UNION t = s' UNION t ==> measurable s'`, REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_ALMOST]);; let HAS_MEASURE_NEGLIGIBLE_UNION = prove (`!s1 s2:real^N->bool m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ negligible(s1 INTER s2) ==> (s1 UNION s2) has_measure (m1 + m2)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN MAP_EVERY EXISTS_TAC [`(s1 DIFF (s1 INTER s2)) UNION (s2 DIFF (s1 INTER s2)):real^N->bool`; `s1 INTER s2:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC HAS_MEASURE_DISJOINT_UNION THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HAS_MEASURE_ALMOST THEN EXISTS_TAC `s1:real^N->bool`; MATCH_MP_TAC HAS_MEASURE_ALMOST THEN EXISTS_TAC `s2:real^N->bool`; SET_TAC[]] THEN EXISTS_TAC `s1 INTER s2:real^N->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let MEASURE_NEGLIGIBLE_UNION = prove (`!s t. measurable s /\ measurable t /\ negligible(s INTER t) ==> measure(s UNION t) = measure s + measure t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNION; GSYM HAS_MEASURE_MEASURE]);; let MEASURE_NEGLIGIBLE_UNION_EQ = prove (`!s t u. measurable s /\ measurable t /\ s UNION t = u /\ negligible(s INTER t) ==> measure s + measure t = measure u`, MESON_TAC[MEASURE_NEGLIGIBLE_UNION]);; let HAS_MEASURE_NEGLIGIBLE_SYMDIFF = prove (`!s t:real^N->bool m. s has_measure m /\ negligible((s DIFF t) UNION (t DIFF s)) ==> t has_measure m`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `(s DIFF t) UNION (t DIFF s):real^N->bool`] THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let MEASURABLE_NEGLIGIBLE_SYMDIFF = prove (`!s t:real^N->bool. measurable s /\ negligible((s DIFF t) UNION (t DIFF s)) ==> measurable t`, REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_NEGLIGIBLE_SYMDIFF]);; let MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ = prove (`!s t:real^N->bool. negligible(s DIFF t UNION t DIFF s) ==> (measurable s <=> measurable t)`, MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF; UNION_COMM]);; let MEASURE_NEGLIGIBLE_SYMDIFF = prove (`!s t:real^N->bool. negligible(s DIFF t UNION t DIFF s) ==> measure s = measure t`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`measurable(s:real^N->bool)`; `measurable(t:real^N->bool)`] THENL [ASM_MESON_TAC[HAS_MEASURE_NEGLIGIBLE_SYMDIFF; MEASURE_UNIQUE; HAS_MEASURE_MEASURE]; ASM_MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ]; ASM_MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ]; REWRITE_TAC[measure] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[measurable]]);; let NEGLIGIBLE_SYMDIFF_EQ = prove (`!s t:real^N->bool. negligible (s DIFF t UNION t DIFF s) ==> (negligible s <=> negligible t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN SET_TAC[]);; let NEGLIGIBLE_DELETE = prove (`!a:real^N. negligible(s DELETE a) <=> negligible s`, GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{a:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; let HAS_MEASURE_NEGLIGIBLE_UNIONS = prove (`!m f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> s has_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> negligible(s INTER t)) ==> (UNIONS f) has_measure (sum f m)`, GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; UNIONS_0; UNIONS_INSERT; HAS_MEASURE_EMPTY] THEN REWRITE_TAC[IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN STRIP_TAC THEN STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNION THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; let MEASURE_NEGLIGIBLE_UNIONS = prove (`!m f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> s has_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> negligible(s INTER t)) ==> measure(UNIONS f) = sum f m`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS]);; let HAS_MEASURE_DISJOINT_UNIONS = prove (`!m f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> s has_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) ==> (UNIONS f) has_measure (sum f m)`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; let MEASURE_DISJOINT_UNIONS = prove (`!m f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> s has_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) ==> measure(UNIONS f) = sum f m`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS]);; let HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE = prove (`!f:A->real^N->bool s. FINITE s /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `sum s (\x. measure(f x)) = sum (IMAGE (f:A->real^N->bool) s) measure` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`]) THEN ASM_SIMP_TAC[INTER_ACI; MEASURABLE_MEASURE_EQ_0]; MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[FINITE_IMAGE; HAS_MEASURE_MEASURE]]);; let MEASURE_NEGLIGIBLE_UNIONS_IMAGE = prove (`!f:A->real^N->bool s. FINITE s /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE]);; let HAS_MEASURE_DISJOINT_UNIONS_IMAGE = prove (`!f:A->real^N->bool s. FINITE s /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; let MEASURE_DISJOINT_UNIONS_IMAGE = prove (`!f:A->real^N->bool s. FINITE s /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS_IMAGE]);; let HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove (`!f:A->real^N->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:A->real^N->bool`; `{x | x IN s /\ ~((f:A->real^N->bool) x = {})}`] HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[NOT_IN_EMPTY]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN REWRITE_TAC[MEASURE_EMPTY]]);; let MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove (`!f:A->real^N->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);; let HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove (`!f:A->real^N->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; let MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove (`!f:A->real^N->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);; let MEASURE_UNION = prove (`!s t:real^N->bool. measurable s /\ measurable t ==> measure(s UNION t) = measure(s) + measure(t) - measure(s INTER t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t = (s INTER t) UNION (s DIFF t) UNION (t DIFF s)`] THEN ONCE_REWRITE_TAC[REAL_ARITH `a + b - c:real = c + (a - c) + (b - c)`] THEN MP_TAC(ISPECL [`s DIFF t:real^N->bool`; `t DIFF s:real^N->bool`] MEASURE_DISJOINT_UNION) THEN ASM_SIMP_TAC[MEASURABLE_DIFF] THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s INTER t:real^N->bool`; `(s DIFF t) UNION (t DIFF s):real^N->bool`] MEASURE_DISJOINT_UNION) THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_INTER] THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL [EXISTS_TAC `measure((s DIFF t) UNION (s INTER t):real^N->bool)`; EXISTS_TAC `measure((t DIFF s) UNION (s INTER t):real^N->bool)`] THEN (CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTER]; AP_TERM_TAC] THEN SET_TAC[]));; let MEASURE_UNION_LE = prove (`!s t:real^N->bool. measurable s /\ measurable t ==> measure(s UNION t) <= measure s + measure t`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURE_UNION] THEN REWRITE_TAC[REAL_ARITH `a + b - c <= a + b <=> &0 <= c`] THEN MATCH_MP_TAC MEASURE_POS_LE THEN ASM_SIMP_TAC[MEASURABLE_INTER]);; let MEASURE_UNIONS_LE = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> measurable s) ==> measure(UNIONS f) <= sum f (\s. measure s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN REWRITE_TAC[MEASURE_EMPTY; REAL_LE_REFL] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(s:real^N->bool) + measure(UNIONS f:real^N->bool)` THEN ASM_SIMP_TAC[MEASURE_UNION_LE; MEASURABLE_UNIONS] THEN REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; let MEASURABLE_INSERT = prove (`!x s:real^N->bool. measurable(x INSERT s) <=> measurable s`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; let MEASURABLE_DELETE = prove (`!x s:real^N->bool. measurable(s DELETE x) <=> measurable s`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; let MEASURE_INSERT = prove (`!x s:real^N->bool. measure(x INSERT s) = measure s`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; let MEASURE_DELETE = prove (`!x s:real^N->bool. measure(s DELETE x) = measure s`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; let MEASURE_UNIONS_LE_IMAGE = prove (`!f:A->bool s:A->(real^N->bool). FINITE f /\ (!a. a IN f ==> measurable(s a)) ==> measure(UNIONS (IMAGE s f)) <= sum f (\a. measure(s a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\k:real^N->bool. measure k)` THEN ASM_SIMP_TAC[MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN ASM_SIMP_TAC[MEASURE_POS_LE]);; let MEASURE_SUB_LE_MEASURE_DIFF = prove (`!s t:real^N->bool. measurable s /\ measurable t ==> measure s - measure t <= measure(s DIFF t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN TRANS_TAC REAL_LE_TRANS `measure((s DIFF t) UNION t:real^N->bool)` THEN ASM_SIMP_TAC[MEASURE_UNION_LE; MEASURABLE_DIFF] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNION; MEASURABLE_DIFF] THEN SET_TAC[]);; let MEASURE_SUB_LE_MEASURE_SYMDIFF = prove (`!s t:real^N->bool. measurable s /\ measurable t ==> abs(measure s - measure t) <= measure((s DIFF t) UNION (t DIFF s))`, REWRITE_TAC[REAL_ARITH `abs(s - t) <= e <=> s - t <= e /\ t - s <= e`] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_SUB_LE_MEASURE_DIFF o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNION; MEASURABLE_DIFF] THEN SET_TAC[]);; let MEASURABLE_INNER_OUTER = prove (`!s:real^N->bool. measurable s <=> !e. &0 < e ==> ?t u. t SUBSET s /\ s SUBSET u /\ measurable t /\ measurable u /\ abs(measure t - measure u) < e`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM]; ALL_TAC] THEN REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(\x. if x IN t then vec 1 else vec 0):real^N->real^1`; `(\x. if x IN u then vec 1 else vec 0):real^N->real^1`; `lift(measure(t:real^N->bool))`; `lift(measure(u:real^N->bool))`] THEN ASM_REWRITE_TAC[GSYM HAS_MEASURE; GSYM HAS_MEASURE_MEASURE] THEN ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN ASM SET_TAC[]);; let HAS_MEASURE_INNER_OUTER = prove (`!s:real^N->bool m. s has_measure m <=> (!e. &0 < e ==> ?t. t SUBSET s /\ measurable t /\ m - e < measure t) /\ (!e. &0 < e ==> ?u. s SUBSET u /\ measurable u /\ measure u < m + e)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURABLE_MEASURE] THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [MEASURABLE_INNER_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "u" (MP_TAC o SPEC `e / &2`) THEN REMOVE_THEN "t" (MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ t <= u /\ m - e / &2 < t /\ u < m + e / &2 ==> abs(t - u) < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < x - y) /\ ~(&0 < y - x) ==> x = y`) THEN CONJ_TAC THEN DISCH_TAC THENL [REMOVE_THEN "u" (MP_TAC o SPEC `measure(s:real^N->bool) - m`) THEN ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE]; REMOVE_THEN "t" (MP_TAC o SPEC `m - measure(s:real^N->bool)`) THEN ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN ASM_MESON_TAC[MEASURE_SUBSET]]);; let HAS_MEASURE_INNER_OUTER_LE = prove (`!s:real^N->bool m. s has_measure m <=> (!e. &0 < e ==> ?t. t SUBSET s /\ measurable t /\ m - e <= measure t) /\ (!e. &0 < e ==> ?u. s SUBSET u /\ measurable u /\ measure u <= m + e)`, REWRITE_TAC[HAS_MEASURE_INNER_OUTER] THEN MESON_TAC[REAL_ARITH `&0 < e /\ m - e / &2 <= t ==> m - e < t`; REAL_ARITH `&0 < e /\ u <= m + e / &2 ==> u < m + e`; REAL_ARITH `&0 < e <=> &0 < e / &2`; REAL_LT_IMP_LE]);; let NEGLIGIBLE_OUTER = prove (`!s:real^N->bool. negligible s <=> !e. &0 < e ==> ?t. s SUBSET t /\ measurable t /\ measure t < e`, GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_INNER_OUTER] THEN REWRITE_TAC[REAL_ADD_LID] THEN MATCH_MP_TAC(TAUT `a ==> (a /\ b <=> b)`) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN REWRITE_TAC[EMPTY_SUBSET; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN ASM_REAL_ARITH_TAC);; let NEGLIGIBLE_OUTER_LE = prove (`!s:real^N->bool. negligible s <=> !e. &0 < e ==> ?t. s SUBSET t /\ measurable t /\ measure t <= e`, REWRITE_TAC[NEGLIGIBLE_OUTER] THEN MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `&0 < e ==> &0 < e / &2 /\ (x <= e / &2 ==> x < e)`]);; let HAS_MEASURE_LIMIT = prove (`!s. s has_measure m <=> !e. &0 < e ==> ?B. &0 < B /\ !a b. ball(vec 0,B) SUBSET interval[a,b] ==> ?z. (s INTER interval[a,b]) has_measure z /\ abs(z - m) < e`, GEN_TAC THEN REWRITE_TAC[HAS_MEASURE] THEN GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[MESON[IN_INTER] `(if x IN k INTER s then a else b) = (if x IN s then if x IN k then a else b else b)`] THEN REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; NORM_LIFT]);; let MEASURE_LIMIT = prove (`!s:real^N->bool e. measurable s /\ &0 < e ==> ?B. &0 < B /\ !a b. ball(vec 0,B) SUBSET interval[a,b] ==> abs(measure(s INTER interval[a,b]) - measure s) < e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MEASURE_UNIQUE]);; let INTEGRABLE_ON_CONST = prove (`!c:real^N. (\x:real^M. c) integrable_on s <=> c = vec 0 \/ measurable s`, GEN_TAC THEN ASM_CASES_TAC `c:real^N = vec 0` THEN ASM_REWRITE_TAC[INTEGRABLE_0; MEASURABLE] THEN EQ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o ISPEC `(\y. lambda i. y$k / (c:real^N)$k):real^N->real^1` o MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_LINEAR)) THEN ASM_SIMP_TAC[vec; o_DEF; REAL_DIV_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o ISPEC `(\y. lambda i. (c:real^N)$i * y$i):real^1->real^N` o MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_LINEAR)) THEN ANTS_TAC THENL [SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; o_THM; LAMBDA_BETA; VEC_COMPONENT] THEN REWRITE_TAC[REAL_MUL_RID]]]);; let ABSOLUTELY_INTEGRABLE_ON_CONST = prove (`!c. (\x. c) absolutely_integrable_on s <=> c = vec 0 \/ measurable s`, REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_ON_CONST] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC; NORM_EQ_0]);; let HAS_INTEGRAL_CONST_GEN = prove (`!s c. measurable s ==> (((\x. c):real^M->real^N) has_integral (measure s % c)) s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\x. vec 1):real^M->real^1`; `integral s ((\x. vec 1):real^M->real^1)`; `s:real^M->bool`; `\v. drop v % (c:real^N)`] HAS_INTEGRAL_LINEAR) THEN ASM_SIMP_TAC[o_DEF; DROP_VEC; VECTOR_MUL_LID; GSYM MEASURE_INTEGRAL] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[LINEAR_VMUL_DROP; LINEAR_ID; GSYM HAS_INTEGRAL_INTEGRAL] THEN ASM_REWRITE_TAC[INTEGRABLE_ON_CONST]);; let INTEGRAL_CONST_GEN = prove (`!s c. measurable s ==> integral s ((\x. c):real^M->real^N) = measure s % c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_CONST_GEN THEN ASM_REWRITE_TAC[]);; let OPEN_NOT_NEGLIGIBLE = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(negligible s)`, GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN SUBGOAL_THEN `negligible(interval[a - e / (&(dimindex(:N))) % vec 1:real^N, a + e / (&(dimindex(:N))) % vec 1])` MP_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `cball(a:real^N,e)` THEN CONJ_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID; REAL_ARITH `a - e <= x /\ x <= a + e <=> abs(x - a) <= e`; dist] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY; NOT_LT] THEN REWRITE_TAC[IN_NUMSEG; VECTOR_SUB_COMPONENT; DIMINDEX_GE_1] THEN ASM_MESON_TAC[REAL_ABS_SUB]; REWRITE_TAC[NEGLIGIBLE_INTERVAL; INTERVAL_NE_EMPTY] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_MUL_RID; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `a - e < a + e <=> &0 < e`] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]]);; let NOT_NEGLIGIBLE_UNIV = prove (`~negligible(:real^N)`, SIMP_TAC[OPEN_NOT_NEGLIGIBLE; OPEN_UNIV; UNIV_NOT_EMPTY]);; let NEGLIGIBLE_EMPTY_INTERIOR = prove (`!s:real^N->bool. negligible s ==> interior s = {}`, MESON_TAC[OPEN_NOT_NEGLIGIBLE; INTERIOR_SUBSET; OPEN_INTERIOR; NEGLIGIBLE_SUBSET]);; let HAS_INTEGRAL_NEGLIGIBLE_EQ_AE = prove (`!f:real^M->real^N s t. negligible t /\ (!x i. x IN s DIFF t /\ 1 <= i /\ i <= dimindex (:N) ==> &0 <= f x$i) ==> ((f has_integral vec 0) s <=> negligible {x | x IN s /\ ~(f x = vec 0)})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. if x IN t then vec 0 else (f:real^M->real^N) x`; `s:real^M->bool`] HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[VEC_COMPONENT; IN_DIFF; REAL_LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ; MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET] THEN EXISTS_TAC `t:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Properties of measure under simple affine transformations. *) (* ------------------------------------------------------------------------- *) let HAS_MEASURE_AFFINITY = prove (`!s m c y. s has_measure y ==> (IMAGE (\x:real^N. m % x + c) s) has_measure abs(m) pow (dimindex(:N)) * y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `m = &0` THENL [ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(x = 0) ==> x = SUC(x - 1)`) (SPEC_ALL DIMINDEX_NONZERO)] THEN DISCH_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; HAS_MEASURE_0] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{c:real^N}` THEN SIMP_TAC[NEGLIGIBLE_FINITE; FINITE_RULES] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[HAS_MEASURE] THEN ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(m) pow dimindex(:N)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `abs(m) * B + norm(c:real^N)` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < B /\ &0 <= x ==> &0 < B + x`; NORM_POS_LE; REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; UNWIND_THM1] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`if &0 <= m then inv m % u + --(inv m % c):real^N else inv m % v + --(inv m % c)`; `if &0 <= m then inv m % v + --(inv m % c):real^N else inv m % u + --(inv m % c)`]) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `m % x + c:real^N`) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[IN_BALL; IN_INTERVAL] THEN CONJ_TAC THENL [REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm(x:real^N)`] THEN DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) < a ==> norm(x + y) < a + norm(y)`) THEN ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL; GSYM REAL_ABS_NZ]; ALL_TAC] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT; COND_COMPONENT] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_ARITH `m * u + --(m * c):real = (u - c) * m`] THEN SUBST1_TAC(REAL_ARITH `inv(m) = if &0 <= inv(m) then abs(inv m) else --(abs(inv m))`) THEN SIMP_TAC[REAL_LE_INV_EQ] THEN REWRITE_TAC[REAL_ARITH `(x - y:real) * --z = (y - x) * z`] THEN REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN ASM_REWRITE_TAC[real_abs] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_TAC THEN DISCH_THEN(X_CHOOSE_THEN `z:real^1` (fun th -> EXISTS_TAC `(abs m pow dimindex (:N)) % z:real^1` THEN MP_TAC th)) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_FIELD `~(x = &0) ==> ~(inv x = &0)`)) THEN REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN DISCH_THEN(MP_TAC o SPEC `--(inv m % c):real^N` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV] THEN SIMP_TAC[COND_ID] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; VECTOR_MUL_LNEG; VECTOR_MUL_RNEG] THEN ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_NEG_NEG] THEN REWRITE_TAC[VECTOR_ARITH `(u + --c) + c:real^N = u`] THEN REWRITE_TAC[REAL_ABS_INV; REAL_INV_INV; GSYM REAL_POW_INV] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[LIFT_CMUL; GSYM VECTOR_SUB_LDISTRIB] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_POW; REAL_ABS_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_POW_LT; GSYM REAL_ABS_NZ]);; let STRETCH_GALOIS = prove (`!x:real^N y:real^N m. (!k. 1 <= k /\ k <= dimindex(:N) ==> ~(m k = &0)) ==> ((y = (lambda k. m k * x$k)) <=> (lambda k. inv(m k) * y$k) = x)`, REPEAT GEN_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MATCH_MP_TAC(MESON[] `(!x. p x ==> (q x <=> r x)) ==> (!x. p x) ==> ((!x. q x) <=> (!x. r x))`) THEN GEN_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);; let HAS_MEASURE_STRETCH = prove (`!s m y. s has_measure y ==> (IMAGE (\x:real^N. lambda k. m k * x$k) s :real^N->bool) has_measure abs(product (1..dimindex(:N)) m) * y`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!k. 1 <= k /\ k <= dimindex(:N) ==> ~(m k = &0)` THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN SUBGOAL_THEN `product(1..dimindex (:N)) m = &0` SUBST1_TAC THENL [ASM_MESON_TAC[PRODUCT_EQ_0_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO; HAS_MEASURE_0] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | x$k = &0}` THEN ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; REAL_MUL_LZERO]] THEN UNDISCH_TAC `(s:real^N->bool) has_measure y` THEN REWRITE_TAC[HAS_MEASURE] THEN ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < abs(product(1..dimindex(:N)) m)` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_ABS_NZ; REAL_LT_DIV; PRODUCT_EQ_0_NUMSEG]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(product(1..dimindex(:N)) m)`) THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `sup(IMAGE (\k. abs(m k) * B) (1..dimindex(:N)))` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; NUMSEG_EMPTY; FINITE_NUMSEG; IN_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE] THEN ASM_MESON_TAC[IN_NUMSEG; DIMINDEX_GE_1; LE_REFL; REAL_LT_MUL; REAL_ABS_NZ]; DISCH_TAC] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN ASM_SIMP_TAC[IN_IMAGE; STRETCH_GALOIS; UNWIND_THM1] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(lambda k. min (inv(m k) * (u:real^N)$k) (inv(m k) * (v:real^N)$k)):real^N`; `(lambda k. max (inv(m k) * (u:real^N)$k) (inv(m k) * (v:real^N)$k)):real^N`]) THEN MATCH_MP_TAC(TAUT `a /\ (b ==> a ==> c) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN SUBGOAL_THEN `!k. 1 <= k /\ k <= dimindex (:N) ==> ~(inv(m k) = &0)` MP_TAC THENL [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_STRETCH)] THEN (MP_TAC(ISPECL [`u:real^N`; `v:real^N`; `\i:num. inv(m i:real)`] IMAGE_STRETCH_INTERVAL) THEN SUBGOAL_THEN `~(interval[u:real^N,v] = {})` ASSUME_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN ASM_REWRITE_TAC[BALL_EQ_EMPTY; GSYM REAL_NOT_LT]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM)) THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b SUBSET s ==> b' SUBSET IMAGE f b ==> b' SUBSET IMAGE f s`)) THEN REWRITE_TAC[IN_BALL; SUBSET; NORM_ARITH `dist(vec 0:real^N,x) = norm x`; IN_IMAGE] THEN ASM_SIMP_TAC[STRETCH_GALOIS; REAL_INV_EQ_0; UNWIND_THM1; REAL_INV_INV] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) % x:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; REAL_ABS_MUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))) * B` THEN SUBGOAL_THEN `&0 < sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[EXISTS_IN_IMAGE; GSYM REAL_ABS_NZ; IN_NUMSEG] THEN ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) * B` THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `&0 < x ==> abs x <= x`] THEN ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN ASM_SIMP_TAC[EXISTS_IN_IMAGE; REAL_LE_RMUL_EQ] THEN ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN MP_TAC(ISPEC `IMAGE (\k. abs (m k)) (1..dimindex(:N))` SUP_FINITE) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]; MATCH_MP_TAC(MESON[] `s = t /\ P z ==> (f has_integral z) s ==> Q ==> ?w. (f has_integral w) t /\ P w`) THEN SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG; GSYM REAL_ABS_INV] THEN REWRITE_TAC[REAL_INV_INV] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. f x = x) ==> IMAGE f s = s`) THEN SIMP_TAC[o_THM; LAMBDA_BETA; CART_EQ] THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID]; REWRITE_TAC[ABS_DROP; DROP_SUB; LIFT_DROP; DROP_CMUL] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; ETA_AX] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN ASM_MESON_TAC[ABS_DROP; DROP_SUB; LIFT_DROP]]]);; let HAS_MEASURE_TRANSLATION = prove (`!s m a. s has_measure m ==> (IMAGE (\x:real^N. a + x) s) has_measure m`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `&1`; `a:real^N`; `m:real`] HAS_MEASURE_AFFINITY) THEN REWRITE_TAC[VECTOR_MUL_LID; REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN REWRITE_TAC[VECTOR_ADD_SYM]);; let NEGLIGIBLE_TRANSLATION = prove (`!s a. negligible s ==> negligible (IMAGE (\x:real^N. a + x) s)`, SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION]);; let HAS_MEASURE_TRANSLATION_EQ = prove (`!a s m. (IMAGE (\x:real^N. a + x) s) has_measure m <=> s has_measure m`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_TRANSLATION] THEN DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP HAS_MEASURE_TRANSLATION) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + b:real^N = b`] THEN SET_TAC[]);; add_translation_invariants [HAS_MEASURE_TRANSLATION_EQ];; let MEASURE_TRANSLATION = prove (`!a s. measure(IMAGE (\x:real^N. a + x) s) = measure s`, REWRITE_TAC[measure; HAS_MEASURE_TRANSLATION_EQ]);; add_translation_invariants [MEASURE_TRANSLATION];; let NEGLIGIBLE_TRANSLATION_REV = prove (`!s a. negligible (IMAGE (\x:real^N. a + x) s) ==> negligible s`, SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);; let NEGLIGIBLE_TRANSLATION_EQ = prove (`!a s. negligible (IMAGE (\x:real^N. a + x) s) <=> negligible s`, SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);; add_translation_invariants [NEGLIGIBLE_TRANSLATION_EQ];; let MEASURABLE_TRANSLATION_EQ = prove (`!a:real^N s. measurable (IMAGE (\x. a + x) s) <=> measurable s`, REWRITE_TAC[measurable; HAS_MEASURE_TRANSLATION_EQ]);; add_translation_invariants [MEASURABLE_TRANSLATION_EQ];; let MEASURABLE_TRANSLATION = prove (`!s a:real^N. measurable s ==> measurable (IMAGE (\x. a + x) s)`, REWRITE_TAC[MEASURABLE_TRANSLATION_EQ]);; let HAS_MEASURE_SCALING = prove (`!s m c. s has_measure m ==> (IMAGE (\x:real^N. c % x) s) has_measure (abs(c) pow dimindex(:N)) * m`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real`; `vec 0:real^N`; `m:real`] HAS_MEASURE_AFFINITY) THEN REWRITE_TAC[VECTOR_ADD_RID]);; let HAS_MEASURE_SCALING_EQ = prove (`!s m c. ~(c = &0) ==> (IMAGE (\x:real^N. c % x) s has_measure (abs(c) pow dimindex(:N)) * m <=> s has_measure m)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP HAS_MEASURE_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN REWRITE_TAC[GSYM REAL_POW_MUL; VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID; VECTOR_MUL_LID] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; let MEASURABLE_SCALING = prove (`!s c. measurable s ==> measurable (IMAGE (\x:real^N. c % x) s)`, REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_SCALING]);; let MEASURABLE_SCALING_EQ = prove (`!s:real^N->bool c. measurable (IMAGE (\x. c % x) s) <=> c = &0 \/ measurable s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[MEASURABLE_SING; MEASURABLE_EMPTY]; EQ_TAC THEN REWRITE_TAC[MEASURABLE_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP MEASURABLE_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let MEASURABLE_AFFINITY_EQ = prove (`!s m c:real^N. measurable (IMAGE (\x. m % x + c) s) <=> m = &0 \/ measurable s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; MEASURABLE_TRANSLATION_EQ; MEASURABLE_SCALING_EQ; IMAGE_o]);; let MEASURABLE_AFFINITY = prove (`!s m c:real^N. measurable s ==> measurable (IMAGE (\x. m % x + c) s)`, SIMP_TAC[MEASURABLE_AFFINITY_EQ]);; let MEASURE_SCALING = prove (`!s c. measurable s ==> measure(IMAGE (\x:real^N. c % x) s) = (abs(c) pow dimindex(:N)) * measure s`, REWRITE_TAC[HAS_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_SCALING]);; let MEASURE_AFFINITY = prove (`!s m c:real^N. measurable s ==> measure(IMAGE (\x. m % x + c) s) = abs m pow dimindex (:N) * measure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN MATCH_MP_TAC HAS_MEASURE_AFFINITY THEN ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE]);; let NEGLIGIBLE_SCALING = prove (`!s c. negligible s ==> negligible (IMAGE (\x:real^N. c % x) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_MEASURE_SCALING) THEN REWRITE_TAC[REAL_MUL_RZERO]);; let NEGLIGIBLE_SCALING_EQ = prove (`!s:real^N->bool c. negligible (IMAGE (\x. c % x) s) <=> c = &0 \/ negligible s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[NEGLIGIBLE_SING; NEGLIGIBLE_EMPTY]; EQ_TAC THEN REWRITE_TAC[NEGLIGIBLE_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP NEGLIGIBLE_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let NEGLIGIBLE_AFFINITY_EQ = prove (`!s m c:real^N. negligible (IMAGE (\x. m % x + c) s) <=> m = &0 \/ negligible s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; NEGLIGIBLE_TRANSLATION_EQ; NEGLIGIBLE_SCALING_EQ; IMAGE_o]);; let NEGLIGIBLE_AFFINITY = prove (`!s m c:real^N. negligible s ==> negligible (IMAGE (\x. m % x + c) s)`, SIMP_TAC[NEGLIGIBLE_AFFINITY_EQ]);; let NOT_MEASURABLE_UNIV = prove (`~measurable(:real^N)`, DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&2` o MATCH_MP MEASURE_SCALING) THEN MATCH_MP_TAC(REAL_RING `a = b /\ ~(b = &0) /\ ~(c = &1) ==> a = c * b ==> F`) THEN REWRITE_TAC[REAL_POW_EQ_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[MEASURABLE_MEASURE_EQ_0; NOT_NEGLIGIBLE_UNIV] THEN SIMP_TAC[DIMINDEX_GE_1; LE_1] THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN EXISTS_TAC `inv(&2) % x:real^N` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Measurability of countable unions and intersections of various kinds. *) (* ------------------------------------------------------------------------- *) let HAS_MEASURE_NESTED_UNIONS = prove (`!s:num->real^N->bool B. (!n. measurable(s n)) /\ (!n. measure(s n) <= B) /\ (!n. s(n) SUBSET s(SUC n)) ==> measurable(UNIONS { s(n) | n IN (:num) }) /\ ((\n. lift(measure(s n))) --> lift(measure(UNIONS { s(n) | n IN (:num) }))) sequentially`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b /\ (b ==> c))`] THEN SIMP_TAC[MEASURE_INTEGRAL_UNIV; LIFT_DROP] THEN REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `b /\ c ==> b /\ (b ==> c)`) THEN MATCH_MP_TAC MONOTONE_CONVERGENCE_INCREASING THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL] THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o PART_MATCH (rand o rand) TRANSITIVE_STEPWISE_LE_EQ o concl) THEN ASM_REWRITE_TAC[SUBSET_TRANS; SUBSET_REFL] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN SIMP_TAC[NOT_EXISTS_THM; IN_UNIV; LIM_CONST]]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEASURABLE_INTEGRABLE]) THEN ASM_SIMP_TAC[INTEGRAL_MEASURE_UNIV] THEN REWRITE_TAC[bounded; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN EXISTS_TAC `B:real` THEN REWRITE_TAC[IN_UNIV; NORM_LIFT] THEN REWRITE_TAC[real_abs] THEN ASM_MESON_TAC[MEASURE_POS_LE]]);; let MEASURABLE_NESTED_UNIONS = prove (`!s:num->real^N->bool B. (!n. measurable(s n)) /\ (!n. measure(s n) <= B) /\ (!n. s(n) SUBSET s(SUC n)) ==> measurable(UNIONS { s(n) | n IN (:num) })`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_NESTED_UNIONS) THEN SIMP_TAC[]);; let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS = prove (`!s:num->real^N->bool B. (!n. measurable(s n)) /\ (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\ (!n. sum (0..n) (\k. measure(s k)) <= B) ==> measurable(UNIONS { s(n) | n IN (:num) }) /\ ((\n. lift(measure(s n))) sums lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real^N->bool`; `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN SUBGOAL_THEN `!n. (UNIONS (IMAGE s (0..n)):real^N->bool) has_measure (sum(0..n) (\k. measure(s k)))` MP_TAC THENL [GEN_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN ASM_SIMP_TAC[FINITE_NUMSEG]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN ASSUME_TAC(GEN `n:num` (MATCH_MP MEASURE_UNIQUE (SPEC `n:num` th)))) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN SUBGOAL_THEN `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real^N->bool = UNIONS (IMAGE s (:num))` (fun th -> REWRITE_TAC[th] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[]) THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]);; let NEGLIGIBLE_COUNTABLE_UNIONS_GEN = prove (`!f. COUNTABLE f /\ (!s:real^N->bool. s IN f ==> negligible s) ==> negligible(UNIONS f)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; NEGLIGIBLE_EMPTY] THEN MP_TAC(ISPEC `f:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN ASM_REWRITE_TAC[]);; let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED = prove (`!s:num->real^N->bool. (!n. measurable(s n)) /\ (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\ bounded(UNIONS { s(n) | n IN (:num) }) ==> measurable(UNIONS { s(n) | n IN (:num) }) /\ ((\n. lift(measure(s n))) sums lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS THEN EXISTS_TAC `measure(interval[a:real^N,b])` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(UNIONS (IMAGE (s:num->real^N->bool) (0..n)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN ASM_SIMP_TAC[FINITE_NUMSEG]; MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE]; ASM SET_TAC[]]]);; let MEASURABLE_COUNTABLE_UNIONS_BOUNDED = prove (`!s:num->real^N->bool. (!n. measurable(s n)) /\ bounded(UNIONS { s(n) | n IN (:num) }) ==> measurable(UNIONS { s(n) | n IN (:num) })`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `UNIONS { s(n):real^N->bool | n IN (:num) } = UNIONS { UNIONS {s(m) | m IN 0..n} | n IN (:num)}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[IN_NUMSEG; IN_UNIV; LE_0] THEN MESON_TAC[LE_REFL]; MATCH_MP_TAC MEASURABLE_NESTED_UNIONS THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN EXISTS_TAC `measure(interval[a:real^N,b])` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG]; DISCH_TAC] THEN CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[MEASURABLE_INTERVAL] THEN ASM SET_TAC[]; GEN_TAC THEN REWRITE_TAC[NUMSEG_CLAUSES; LE_0] THEN SET_TAC[]]]);; let MEASURE_COUNTABLE_UNIONS_LE_STRONG = prove (`!d:num->(real^N->bool) B. (!n. measurable(d n)) /\ (!n. measure(UNIONS {d k | k <= n}) <= B) ==> measurable(UNIONS {d n | n IN (:num)}) /\ measure(UNIONS {d n | n IN (:num)}) <= B`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n. UNIONS {(d:num->(real^N->bool)) k | k IN (0..n)}`; `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN REWRITE_TAC[] THEN SUBGOAL_THEN `UNIONS {UNIONS {d k | k IN (0..n)} | n IN (:num)} = UNIONS {d n:real^N->bool | n IN (:num)}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE]; ASM_REWRITE_TAC[IN_NUMSEG; LE_0]; GEN_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN EXISTS_TAC `\n. lift(measure(UNIONS {d k | k IN 0..n} :real^N->bool))` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[LIFT_DROP; IN_NUMSEG; LE_0]]);; let MEASURE_COUNTABLE_UNIONS_LE = prove (`!d:num->(real^N->bool) B. (!n. measurable(d n)) /\ (!n. sum(0..n) (\k. measure(d k)) <= B) ==> measurable(UNIONS {d n | n IN (:num)}) /\ measure(UNIONS {d n | n IN (:num)}) <= B`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`0..n`;`d:num->real^N->bool`] MEASURE_UNIONS_LE_IMAGE) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; numseg; LE_0; IN_ELIM_THM] THEN MESON_TAC[REAL_LE_TRANS]);; let MEASURABLE_COUNTABLE_UNIONS_STRONG = prove (`!s:num->real^N->bool B. (!n. measurable(s n)) /\ (!n. measure(UNIONS {s k | k <= n}) <= B) ==> measurable(UNIONS { s(n) | n IN (:num) })`, MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE_STRONG; REAL_LE_REFL]);; let MEASURABLE_COUNTABLE_UNIONS = prove (`!s:num->real^N->bool B. (!n. measurable(s n)) /\ (!n. sum (0..n) (\k. measure(s k)) <= B) ==> measurable(UNIONS { s(n) | n IN (:num) })`, MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE; REAL_LE_REFL]);; let MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN = prove (`!D B. COUNTABLE D /\ (!d:real^N->bool. d IN D ==> measurable d) /\ (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B) ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`, REPEAT GEN_TAC THEN ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL [ASM_SIMP_TAC[UNIONS_0; MEASURABLE_EMPTY; SUBSET_EMPTY] THEN MESON_TAC[FINITE_EMPTY]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_SUBSET_IMAGE] THEN REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `{k:num | k <= n}`) THEN SIMP_TAC[FINITE_NUMSEG_LE; FINITE_IMAGE] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN REPLICATE_TAC 3 AP_TERM_TAC THEN SET_TAC[]]);; let MEASURE_COUNTABLE_UNIONS_LE_GEN = prove (`!D B. COUNTABLE D /\ (!d:real^N->bool. d IN D ==> measurable d) /\ (!D'. D' SUBSET D /\ FINITE D' ==> sum D' (\d. measure d) <= B) ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `D':(real^N->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `D':(real^N->bool)->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC MEASURE_UNIONS_LE THEN ASM SET_TAC[]);; let MEASURABLE_COUNTABLE_INTERS = prove (`!s:num->real^N->bool. (!n. measurable(s n)) ==> measurable(INTERS { s(n) | n IN (:num) })`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `INTERS { s(n):real^N->bool | n IN (:num) } = s 0 DIFF (UNIONS {s 0 DIFF s n | n IN (:num)})` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_COUNTABLE_UNIONS_STRONG THEN EXISTS_TAC `measure(s 0:real^N->bool)` THEN ASM_SIMP_TAC[MEASURABLE_DIFF; LE_0] THEN GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN MESON_TAC[IN_DIFF]] THEN ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; MEASURABLE_DIFF; MEASURABLE_UNIONS]);; let MEASURABLE_COUNTABLE_INTERS_GEN = prove (`!D. COUNTABLE D /\ ~(D = {}) /\ (!d:real^N->bool. d IN D ==> measurable d) ==> measurable(INTERS D)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN ASM SET_TAC[]);; let MEASURE_COUNTABLE_UNIONS_APPROACHABLE = prove (`!D B e. COUNTABLE D /\ (!d. d IN D ==> measurable d) /\ (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B) /\ &0 < e ==> ?D'. D' SUBSET D /\ FINITE D' /\ measure(UNIONS D) - e < measure(UNIONS D':real^N->bool)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL [DISCH_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[EMPTY_SUBSET; FINITE_EMPTY; UNIONS_0; MEASURE_EMPTY] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; FORALL_SUBSET_IMAGE] THEN REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`\n. UNIONS(IMAGE (d:num->real^N->bool) {k | k <= n})`; `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG_LE; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `UNIONS {UNIONS (IMAGE d {k | k <= n}) | n IN (:num)}:real^N->bool = UNIONS (IMAGE d (:num))` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_IMAGE] THEN REWRITE_TAC[UNIONS_GSPEC] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EXTENSION] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_REAL; GSYM drop; LIFT_DROP] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN EXISTS_TAC `{k:num | k <= n}` THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE] THEN ASM_SIMP_TAC[REAL_ARITH `abs(x - u) < e /\ &0 < e ==> u - e < x`]]);; let HAS_MEASURE_NESTED_INTERS = prove (`!s:num->real^N->bool. (!n. measurable(s n)) /\ (!n. s(SUC n) SUBSET s(n)) ==> measurable(INTERS {s n | n IN (:num)}) /\ ((\n. lift(measure (s n))) --> lift(measure (INTERS {s n | n IN (:num)}))) sequentially`, GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n. (s:num->real^N->bool) 0 DIFF s n`; `measure(s 0:real^N->bool)`] HAS_MEASURE_NESTED_UNIONS) THEN ASM_SIMP_TAC[MEASURABLE_DIFF] THEN ANTS_TAC THENL [CONJ_TAC THEN X_GEN_TAC `n:num` THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_DIFF; SUBSET_DIFF] THEN SET_TAC[]; REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN SET_TAC[]]; SUBGOAL_THEN `UNIONS {s 0 DIFF s n | n IN (:num)} = s 0 DIFF INTERS {s n :real^N->bool | n IN (:num)}` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[DIFF_INTERS] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN SUBGOAL_THEN `measurable(s 0 DIFF (s 0 DIFF INTERS {s n | n IN (:num)}) :real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[MEASURABLE_DIFF]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> s DIFF (s DIFF t) = t`) THEN REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM] THEN SET_TAC[]; MP_TAC(ISPECL [`sequentially`; `lift(measure(s 0:real^N->bool))`] LIM_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REWRITE_TAC[GSYM LIFT_SUB] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[LIFT_EQ; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[REAL_ARITH `s - m:real = n <=> m = s - n`] THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS] THENL [ALL_TAC; SET_TAC[]] THEN MP_TAC(ISPEC `\m n:num. (s n :real^N->bool) SUBSET (s m)` TRANSITIVE_STEPWISE_LE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [SET_TAC[]; MESON_TAC[LE_0]]]]);; (* ------------------------------------------------------------------------- *) (* Measurability of compact and bounded open sets. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_COMPACT = prove (`!s:real^N->bool. compact s ==> measurable s`, let lemma = prove (`!f s:real^N->bool. (!n. FINITE(f n)) /\ (!n. s SUBSET UNIONS(f n)) /\ (!x. ~(x IN s) ==> ?n. ~(x IN UNIONS(f n))) /\ (!n a. a IN f(SUC n) ==> ?b. b IN f(n) /\ a SUBSET b) /\ (!n a. a IN f(n) ==> measurable a) ==> measurable s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. UNIONS(f(SUC n):(real^N->bool)->bool) SUBSET UNIONS(f n)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s = INTERS { UNIONS(f n) | n IN (:num) }:real^N->bool` SUBST1_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[IN_IMAGE] THEN ASM SET_TAC[]; MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_MESON_TAC[]]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `\n. { k | ?u:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ k = { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> u$i / &2 pow n <= x$i /\ x$i < (u$i + &1) / &2 pow n } /\ ~(s INTER k = {})}` THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN SUBGOAL_THEN `?N. !x:real^N i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> abs(x$i * &2 pow n) < &N` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN MP_TAC(SPEC `B * &2 pow n` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS]; ALL_TAC] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\u. {x | !i. 1 <= i /\ i <= dimindex(:N) ==> (u:real^N)$i <= (x:real^N)$i * &2 pow n /\ x$i * &2 pow n < u$i + &1}) {u | !i. 1 <= i /\ i <= dimindex(:N) ==> integer (u$i) /\ abs(u$i) <= &N}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN X_GEN_TAC `l:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` MP_TAC) THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `k:num`]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[LAMBDA_BETA; FLOOR] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_SYM; FLOOR]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN REWRITE_TAC[closed; open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; ARITH_RULE `0 < x <=> 1 <= x`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `u:real^N` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o CONJUNCT2) THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d < e ==> x <= d ==> x < e`)) THEN REWRITE_TAC[dist] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM CARD_NUMSEG_1] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC SUM_BOUND THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_LID; GSYM REAL_POW_INV] THEN REAL_ARITH_TAC; MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN REWRITE_TAC[UNWIND_THM2] THEN EXISTS_TAC `(lambda i. floor((u:real^N)$i / &2)):real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; FLOOR] THEN MATCH_MP_TAC(SET_RULE `~(s INTER a = {}) /\ a SUBSET b ==> ~(s INTER b = {}) /\ a SUBSET b`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "a" THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN MP_TAC(SPEC `(u:real^N)$k / &2` FLOOR) THEN REWRITE_TAC[REAL_ARITH `u / &2 < floor(u / &2) + &1 <=> u < &2 * floor(u / &2) + &2`] THEN ASM_SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; FLOOR_FRAC] THEN REAL_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`; `u:real^N`] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT1 o CONJUNCT2) THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `interval(inv(&2 pow n) % u:real^N, inv(&2 pow n) % (u + vec 1))` THEN EXISTS_TAC `interval[inv(&2 pow n) % u:real^N, inv(&2 pow n) % (u + vec 1)]` THEN REWRITE_TAC[MEASURABLE_INTERVAL; MEASURE_INTERVAL] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC]);; let MEASURABLE_OPEN = prove (`!s:real^N->bool. bounded s /\ open s ==> measurable s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> s = t DIFF (t DIFF s)`)) THEN MATCH_MP_TAC MEASURABLE_DIFF THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_DIFF; BOUNDED_INTERVAL] THEN MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[CLOSED_INTERVAL]);; let MEASURE_OPEN_POS_LT = prove (`!s. open s /\ bounded s /\ ~(s = {}) ==> &0 < measure s`, MESON_TAC[OPEN_NOT_NEGLIGIBLE; MEASURABLE_MEASURE_POS_LT; MEASURABLE_OPEN]);; let MEASURE_OPEN_POS_LT_EQ = prove (`!s. open s /\ bounded s ==> (&0 < measure s <=> ~(s = {}))`, MESON_TAC[MEASURE_OPEN_POS_LT; MEASURE_EMPTY; REAL_LT_REFL]);; let MEASURABLE_CLOSURE = prove (`!s. bounded s ==> measurable(closure s)`, SIMP_TAC[MEASURABLE_COMPACT; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; BOUNDED_CLOSURE]);; let MEASURABLE_INTERIOR = prove (`!s. bounded s ==> measurable(interior s)`, SIMP_TAC[MEASURABLE_OPEN; OPEN_INTERIOR; BOUNDED_INTERIOR]);; let MEASURABLE_FRONTIER = prove (`!s:real^N->bool. bounded s ==> measurable(frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; let MEASURE_FRONTIER = prove (`!s:real^N->bool. bounded s ==> measure(frontier s) = measure(closure s) - measure(interior s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; let MEASURE_CLOSURE = prove (`!s:real^N->bool. bounded s /\ negligible(frontier s) ==> measure(closure s) = measure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_SIMP_TAC[MEASURABLE_CLOSURE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN REWRITE_TAC[frontier] THEN SET_TAC[]);; let MEASURE_INTERIOR = prove (`!s:real^N->bool. bounded s /\ negligible(frontier s) ==> measure(interior s) = measure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_SIMP_TAC[MEASURABLE_INTERIOR] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN REWRITE_TAC[frontier] THEN SET_TAC[]);; let MEASURABLE_JORDAN = prove (`!s:real^N->bool. bounded s /\ negligible(frontier s) ==> measurable s`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `interior(s):real^N->bool` THEN EXISTS_TAC `closure(s):real^N->bool` THEN ASM_SIMP_TAC[MEASURABLE_INTERIOR; MEASURABLE_CLOSURE] THEN REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN ASM_SIMP_TAC[GSYM MEASURE_FRONTIER; REAL_ABS_NUM; MEASURE_EQ_0]);; let HAS_MEASURE_ELEMENTARY = prove (`!d s. d division_of s ==> s has_measure (sum d content)`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_measure] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ASM_SIMP_TAC[LIFT_SUM] THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM has_measure] THEN ASM_MESON_TAC[HAS_MEASURE_INTERVAL; division_of]);; let MEASURABLE_ELEMENTARY = prove (`!d s. d division_of s ==> measurable s`, REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_ELEMENTARY]);; let MEASURE_ELEMENTARY = prove (`!d s. d division_of s ==> measure s = sum d content`, MESON_TAC[HAS_MEASURE_ELEMENTARY; MEASURE_UNIQUE]);; let MEASURABLE_INTER_INTERVAL = prove (`!s a b:real^N. measurable s ==> measurable (s INTER interval[a,b])`, SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL]);; let MEASURABLE_INSIDE = prove (`!s:real^N->bool. compact s ==> measurable(inside s)`, SIMP_TAC[MEASURABLE_OPEN; BOUNDED_INSIDE; COMPACT_IMP_CLOSED; OPEN_INSIDE; COMPACT_IMP_BOUNDED]);; (* ------------------------------------------------------------------------- *) (* We can split off part of a measurable set of chosen size. *) (* ------------------------------------------------------------------------- *) let PART_MEASURES = prove (`!s:real^N->bool m. measurable s /\ &0 <= m /\ m <= measure s ==> ?t u. DISJOINT t u /\ t UNION u = s /\ measurable t /\ measure t = m /\ measurable u /\ measure u = measure s - m`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_POS_LE) THEN ASM_CASES_TAC `measure(s:real^N->bool) = m` THENL [MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `{}:real^N->bool`] THEN ASM_REWRITE_TAC[UNION_EMPTY; DISJOINT_EMPTY; MEASURE_EMPTY] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[MEASURABLE_EMPTY] THEN REWRITE_TAC[REAL_SUB_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) - m`] MEASURE_LIMIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\x. lift(measure(s INTER interval[--(lambda i. drop x):real^N,(lambda i. drop x)]))`; `vec 0:real^1`; `lift B`; `m:real`; `1`] IVT_INCREASING_COMPONENT_ON_1) THEN ASM_REWRITE_TAC[GSYM drop; LIFT_DROP; DIMINDEX_1; LE_REFL; DROP_VEC] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; GSYM EXISTS_DROP] THEN DISCH_THEN(X_CHOOSE_THEN `b:real` MP_TAC) THEN ABBREV_TAC `c:real^N = lambda i. b` THEN STRIP_TAC THEN EXISTS_TAC `s INTER interval[--c:real^N,c]` THEN EXISTS_TAC `s DIFF interval[--c:real^N,c]` THEN REPLICATE_TAC 2 (MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [SET_TAC[]; DISCH_TAC]) THEN MP_TAC(ISPECL [`s INTER interval[--c:real^N,c]`; `s DIFF interval[--c:real^N,c]`] MEASURE_DISJOINT_UNION) THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN REAL_ARITH_TAC] THEN REPEAT CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[INTERVAL_SING; GSYM vec; VECTOR_NEG_0] THEN TRANS_TAC REAL_LE_TRANS `measure {vec 0:real^N}` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_SING; MEASURE_SING] THEN REWRITE_TAC[INTER_SUBSET]; REWRITE_TAC[MEASURE_SING] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC(REAL_ARITH `abs(measure (s INTER i) - measure s) < measure s - m ==> m <= measure(s INTER i:real^N->bool)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[SUBSET; IN_BALL_0; IN_INTERVAL; LAMBDA_BETA; VECTOR_NEG_COMPONENT; GSYM REAL_ABS_BOUNDS] THEN MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LT_IMP_LE]] THEN MATCH_MP_TAC(INST_TYPE [`:N`,`:P`] CONTINUOUS_ON_COMPARISON) THEN EXISTS_TAC `\x. lift(measure(interval[--(lambda i. drop x):real^N, (lambda i. drop x)]))` THEN CONJ_TAC THENL [REWRITE_TAC[MEASURE_INTERVAL; continuous_on] THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_NEG_COMPONENT] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN SIMP_TAC[REAL_ARITH `--x <= x <=> &0 <= x`; LIFT_DROP] THEN SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG_1; REAL_ARITH `x - --x = &2 * x`; FINITE_NUMSEG] THEN SUBGOAL_THEN `(\x. lift((&2 * drop x) pow (dimindex(:N)))) continuous_on (:real^1)` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_POW THEN SIMP_TAC[LIFT_CMUL; LIFT_DROP; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]; REWRITE_TAC[continuous_on; IN_UNIV] THEN MESON_TAC[]]; REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[LIFT_DROP; IN_INTERVAL_1; DROP_VEC; DIST_LIFT] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DIFF_SUBSET o rand o lhand o snd) THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DIFF_SUBSET o funpow 3 rand o snd) THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN ASM_SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; LAMBDA_BETA; REAL_LE_NEG2; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN ASM_SIMP_TAC[real_abs; MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN SET_TAC[]]);; let HALF_MEASURES = prove (`!s:real^N->bool. measurable s ==> ?t u. DISJOINT t u /\ t UNION u = s /\ measurable t /\ measure t = measure s / &2 /\ measurable u /\ measure u = measure s / &2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &2`] PART_MEASURES) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_POS_LE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let MULTIPART_MEASURES = prove (`!s:real^N->bool n. measurable s /\ ~(n = 0) ==> ?f. FINITE f /\ CARD f <= n /\ pairwise DISJOINT f /\ UNIONS f = s /\ !t. t IN f ==> t SUBSET s /\ measurable t /\ measure t = measure s / &n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?k:num->real^N->bool. !m. k m = @t. t SUBSET s DIFF UNIONS {k i | i < m} /\ measurable t /\ measure t = measure s / &n` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[UNIONS_GSPEC; MESON[] `(?m:num. m < n /\ a IN f m) <=> ~(!m. m < n ==> ~(a IN f m))`] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m. m < n - 1 ==> k m SUBSET s DIFF UNIONS {k i | i < m} /\ measurable(k m) /\ measure((k:num->real^N->bool) m) = measure(s:real^N->bool) / &n` MP_TAC THENL [MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN FIRST_X_ASSUM(SUBST1_TAC o SPEC `m:num`) THEN REWRITE_TAC[IMP_IMP] THEN STRIP_TAC THEN CONV_TAC SELECT_CONV THEN MP_TAC(ISPECL [`s DIFF UNIONS {(k:num->real^N->bool) i | i < m}`; `measure(s:real^N->bool) / &n`] PART_MEASURES) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; MEASURE_POS_LE]; MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN ASM SET_TAC[]] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; FORALL_IN_IMAGE] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ASM SET_TAC[]]; W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_DIFF_SUBSET o rand o snd) THEN ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; FORALL_IN_IMAGE]; REWRITE_TAC[FORALL_IN_GSPEC]] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN (ANTS_TAC THENL [ASM_ARITH_TAC; ASM SET_TAC[]]); DISCH_THEN SUBST1_TAC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN W(MP_TAC o PART_MATCH(lhand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o rand o rand o snd) THEN REWRITE_TAC[FINITE_NUMSEG_LT; FORALL_IN_GSPEC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[LT_TRANS] `(!i. i < m /\ i < n - 1 ==> P i) ==> m < n - 1 ==> (!i. i < m ==> P i)`)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN ANTS_TAC THENL [REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN SIMP_TAC[SUM_CONST; FINITE_NUMSEG_LT; CARD_NUMSEG_LT] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_SUB_RDISTRIB; REAL_DIV_RMUL; REAL_LT_IMP_NZ; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `s <= s * a - b * s <=> &0 <= s * (a - b - &1)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[MEASURE_POS_LE] THEN REWRITE_TAC[REAL_LE_SUB_LADD] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]; FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN DISCH_TAC THEN EXISTS_TAC `(s DIFF UNIONS(IMAGE k {m | m < n - 1})) INSERT (IMAGE (k:num->real^N->bool) {m | m < n - 1})` THEN REWRITE_TAC[FORALL_IN_INSERT; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; FINITE_NUMSEG_LT] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[CARD_CLAUSES; FINITE_IMAGE; FINITE_NUMSEG_LT] THEN MATCH_MP_TAC(ARITH_RULE `~(n = 0) /\ m <= n - 1 ==> (if p then m else SUC m) <= n`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_LT] THEN MATCH_MP_TAC CARD_IMAGE_LE THEN REWRITE_TAC[FINITE_NUMSEG_LT]; REWRITE_TAC[PAIRWISE_INSERT] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[PAIRWISE_IMAGE] THEN REWRITE_TAC[pairwise; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_INSERT] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> (s DIFF t) UNION t = s`) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET_DIFF]; MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH(lhand o rand) MEASURE_DIFF_SUBSET o lhand o snd) THEN ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[REAL_ARITH `s - t = s / a <=> t = (&1 - inv a) * s`] THEN W(MP_TAC o PART_MATCH(lhand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN ASM_SIMP_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN ANTS_TAC THENL [MATCH_MP_TAC WLOG_LT THEN RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_GSPEC]) THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN SIMP_TAC[SUM_CONST; CARD_NUMSEG_LT; FINITE_NUMSEG_LT] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LE_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN CONV_TAC REAL_FIELD; ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* A nice lemma for negligibility proofs. *) (* ------------------------------------------------------------------------- *) let STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE = prove (`!s. measurable s /\ bounded s /\ (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1) ==> negligible s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(&0 < measure(s:real^N->bool))` (fun th -> ASM_MESON_TAC[th; MEASURABLE_MEASURE_POS_LT]) THEN DISCH_TAC THEN MP_TAC(SPEC `(vec 0:real^N) INSERT s` BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN ASM_SIMP_TAC[BOUNDED_INSERT; COMPACT_IMP_BOUNDED; NOT_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN SUBGOAL_THEN `?N. EVEN N /\ &0 < &N /\ measure(interval[--a:real^N,a]) < (&N * measure(s:real^N->bool)) / &4 pow dimindex (:N)` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `measure(interval[--a:real^N,a]) * &4 pow (dimindex(:N))` o MATCH_MP REAL_ARCH) THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN SIMP_TAC[GSYM REAL_LT_LDIV_EQ; ASSUME `&0 < measure(s:real^N->bool)`] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `2 * (N DIV 2 + 1)` THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> a <= b ==> x < b`)) THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`UNIONS (IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s) (1..N))`; `interval[--a:real^N,a]`] MEASURE_SUBSET) THEN MP_TAC(ISPECL [`measure:(real^N->bool)->real`; `IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s) (1..N)`] HAS_MEASURE_DISJOINT_UNIONS) THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN MATCH_MP_TAC MEASURABLE_SCALING THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ ~c ==> d <=> a /\ b /\ ~d ==> c`] THEN SUBGOAL_THEN `!m n. m IN 1..N /\ n IN 1..N /\ ~(DISJOINT (IMAGE (\x:real^N. &m / &N % x) s) (IMAGE (\x. &n / &N % x) s)) ==> m = n` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(MP_TAC o AP_TERM `(%) (&N / &m) :real^N->real^N`) THEN SUBGOAL_THEN `~(&N = &0) /\ ~(&m = &0)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[REAL_OF_NUM_EQ] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG])) THEN ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV) [GSYM CONTRAPOS_THM]) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> x / y * y / x = &1`] THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> x / y * z / x = z / y`] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&n / &m`; `y:real^N`]) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_FIELD `~(y = &0) ==> (x / y = &1 <=> x = y)`] THEN REWRITE_TAC[REAL_OF_NUM_EQ; EQ_SYM_EQ]; ALL_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[measurable] THEN ASM_MESON_TAC[]; REWRITE_TAC[MEASURABLE_INTERVAL]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `a:real^N`] CONVEX_INTERVAL) THEN DISCH_THEN(MP_TAC o REWRITE_RULE[CONVEX_ALT] o CONJUNCT1) THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `x:real^N`; `&n / &N`]) THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `1 <= n /\ n <= N ==> 0 < N /\ n <= N`)) THEN SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT; REAL_LE_LDIV_EQ] THEN SIMP_TAC[REAL_MUL_LID]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN ASM_SIMP_TAC[MEASURE_SCALING; REAL_NOT_LE] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `&0`) THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `sum (1..N) (measure o (\m. IMAGE (\x:real^N. &m / &N % x) s))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SET_RULE `DISJOINT s s <=> s = {}`; IMAGE_EQ_EMPTY] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LT_REFL; MEASURE_EMPTY]] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN ASM_SIMP_TAC[o_DEF; MEASURE_SCALING; SUM_RMUL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> a <= b ==> x < b`)) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `M:num` SUBST_ALL_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_MUL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `&0 < &2 * x <=> &0 < x`]) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < y ==> x / (&2 * y) * &4 = x * &2 / y`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(M..(2*M)) (\i. (&i * &2 / &M) pow dimindex (:N))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_DIV; REAL_POS] THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG; SUBSET] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_OF_NUM_LT]) THEN ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(M..(2*M)) (\i. &2)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_CONST_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `(2 * M + 1) - M = M + 1`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow (dimindex(:N))` THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[DIMINDEX_GE_1] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_POS; ARITH; real_div; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN UNDISCH_TAC `M:num <= n` THEN ARITH_TAC);; let STARLIKE_NEGLIGIBLE_LEMMA = prove (`!s. compact s /\ (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1) ==> negligible s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE THEN ASM_MESON_TAC[MEASURABLE_COMPACT; COMPACT_IMP_BOUNDED]);; let STARLIKE_NEGLIGIBLE = prove (`!s a. closed s /\ (!c x:real^N. &0 <= c /\ (a + x) IN s /\ (a + c % x) IN s ==> c = &1) ==> negligible s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN EXISTS_TAC `--a:real^N` THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE_LEMMA THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_INTER_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN ASM_SIMP_TAC[CLOSED_TRANSLATION]; REWRITE_TAC[IN_IMAGE; IN_INTER] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> y = a + x`] THEN REWRITE_TAC[UNWIND_THM2] THEN ASM MESON_TAC[]]);; let STARLIKE_NEGLIGIBLE_STRONG = prove (`!s a. closed s /\ (!c x:real^N. &0 <= c /\ c < &1 /\ (a + x) IN s ==> ~((a + c % x) IN s)) ==> negligible s`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `~(x < y) /\ ~(y < x) ==> x = y`) THEN STRIP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv c:real`; `c % x:real^N`]) THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < c ==> ~(c = &0)`] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; (* ------------------------------------------------------------------------- *) (* In particular. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_HYPERPLANE = prove (`!a b. ~(a = vec 0 /\ b = &0) ==> negligible {x:real^N | a dot x = b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | F} = {}`; NEGLIGIBLE_EMPTY] THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN SUBGOAL_THEN `?x:real^N. ~(a dot x = b)` MP_TAC THENL [MATCH_MP_TAC(MESON[] `!a:real^N. P a \/ P(--a) ==> ?x. P x`) THEN EXISTS_TAC `a:real^N` THEN REWRITE_TAC[DOT_RNEG] THEN MATCH_MP_TAC(REAL_ARITH `~(a = &0) ==> ~(a = b) \/ ~(--a = b)`) THEN ASM_REWRITE_TAC[DOT_EQ_0]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN REWRITE_TAC[CLOSED_HYPERPLANE; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN MAP_EVERY X_GEN_TAC [`t:real`; `y:real^N`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&0 <= t /\ ac + ay = b /\ ac + t * ay = b ==> ((ay = &0 ==> ac = b) /\ (t - &1) * ay = &0)`)) THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0] THEN CONV_TAC TAUT);; let NEGLIGIBLE_LOWDIM = prove (`!s:real^N->bool. dim(s) < dimindex(:N) ==> negligible s`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `span(s):real^N->bool` THEN REWRITE_TAC[SPAN_INC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | a dot x = &0}` THEN ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; let NEGLIGIBLE_AFFINE_HULL = prove (`!s:real^N->bool. FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(affine hull s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[AFFINE_HULL_EMPTY; NEGLIGIBLE_EMPTY] THEN SUBGOAL_THEN `!x s:real^N->bool n. ~(x IN s) /\ (x INSERT s) HAS_SIZE n /\ n <= dimindex(:N) ==> negligible(affine hull(x INSERT s))` (fun th -> MESON_TAC[th; HAS_SIZE; FINITE_INSERT]) THEN X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN REWRITE_TAC[HAS_SIZE; FINITE_INSERT; IMP_CONJ] THEN SIMP_TAC[CARD_CLAUSES] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN ASM_SIMP_TAC[DIM_LE_CARD; DIM_SPAN] THEN ASM_ARITH_TAC);; let NEGLIGIBLE_AFFINE_HULL_1 = prove (`!a:real^1. negligible (affine hull {a})`, REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN ARITH_TAC);; let NEGLIGIBLE_AFFINE_HULL_2 = prove (`!a b:real^2. negligible (affine hull {a,b})`, REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN ARITH_TAC);; let NEGLIGIBLE_AFFINE_HULL_3 = prove (`!a b c:real^3. negligible (affine hull {a,b,c})`, REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN ARITH_TAC);; let NEGLIGIBLE_CONVEX_HULL = prove (`!s:real^N->bool. FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(convex hull s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NEGLIGIBLE_AFFINE_HULL) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL]);; let NEGLIGIBLE_CONVEX_HULL_1 = prove (`!a:real^1. negligible (convex hull {a})`, REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN ARITH_TAC);; let NEGLIGIBLE_CONVEX_HULL_2 = prove (`!a b:real^2. negligible (convex hull {a,b})`, REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN ARITH_TAC);; let NEGLIGIBLE_CONVEX_HULL_3 = prove (`!a b c:real^3. negligible (convex hull {a,b,c})`, REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Measurability of bounded convex sets. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_CONVEX_FRONTIER = prove (`!s:real^N->bool. convex s ==> negligible(frontier s)`, SUBGOAL_THEN `!s:real^N->bool. convex s /\ (vec 0) IN s ==> negligible(frontier s)` ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[FRONTIER_EMPTY; NEGLIGIBLE_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN ASM_SIMP_TAC[CONVEX_TRANSLATION; IN_IMAGE] THEN ASM_REWRITE_TAC[UNWIND_THM2; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN REWRITE_TAC[FRONTIER_TRANSLATION; NEGLIGIBLE_TRANSLATION_EQ]] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIM_SUBSET_UNIV) THEN REWRITE_TAC[ARITH_RULE `d:num <= e <=> d < e \/ d = e`] THEN STRIP_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `closure s:real^N->bool` THEN REWRITE_TAC[frontier; SUBSET_DIFF] THEN MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_REWRITE_TAC[DIM_CLOSURE]; ALL_TAC] THEN SUBGOAL_THEN `?a:real^N. a IN interior s` CHOOSE_TAC THENL [X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MP_TAC(ISPEC `b:real^N->bool` INTERIOR_SIMPLEX_NONEMPTY) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN EXISTS_TAC `a:real^N` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN SIMP_TAC[VECTOR_ARITH `a + c % x:real^N = (a + x) - (&1 - c) % ((a + x) - a)`] THEN MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let MEASURABLE_CONVEX = prove (`!s:real^N->bool. convex s /\ bounded s ==> measurable s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_JORDAN THEN ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER]);; let NEGLIGIBLE_CONVEX_INTERIOR = prove (`!s:real^N->bool. convex s ==> (negligible s <=> interior s = {})`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[OPEN_NOT_NEGLIGIBLE; INTERIOR_SUBSET; OPEN_INTERIOR; NEGLIGIBLE_SUBSET]; DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `frontier s:real^N->bool` THEN ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER] THEN ASM_REWRITE_TAC[frontier; DIFF_EMPTY; CLOSURE_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Various special cases. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_SPHERE = prove (`!a:real^N r. negligible (sphere(a,e))`, REWRITE_TAC[GSYM FRONTIER_CBALL] THEN SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; let MEASURABLE_BALL = prove (`!a r. measurable(ball(a,r))`, SIMP_TAC[MEASURABLE_OPEN; BOUNDED_BALL; OPEN_BALL]);; let MEASURABLE_CBALL = prove (`!a r. measurable(cball(a,r))`, SIMP_TAC[MEASURABLE_COMPACT; COMPACT_CBALL]);; let MEASURE_BALL_POS = prove (`!x:real^N e. &0 < measure(ball(x,e)) <=> &0 < e`, SIMP_TAC[MEASURE_OPEN_POS_LT_EQ; OPEN_BALL; BOUNDED_BALL; BALL_EQ_EMPTY] THEN REAL_ARITH_TAC);; let MEASURE_CBALL_POS = prove (`!x:real^N e. &0 < measure(cball(x,e)) <=> &0 < e`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM MEASURE_BALL_POS] THEN AP_TERM_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `sphere(x:real^N,e)` THEN REWRITE_TAC[GSYM SPHERE_UNION_BALL; NEGLIGIBLE_SPHERE] THEN SET_TAC[]);; let HAS_INTEGRAL_OPEN_INTERVAL = prove (`!f a b y. (f has_integral y) (interval(a,b)) <=> (f has_integral y) (interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INTERIOR_CLOSED_INTERVAL] THEN MATCH_MP_TAC HAS_INTEGRAL_INTERIOR THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN REWRITE_TAC[CONVEX_INTERVAL]);; let INTEGRABLE_ON_OPEN_INTERVAL = prove (`!f a b. f integrable_on interval(a,b) <=> f integrable_on interval[a,b]`, REWRITE_TAC[integrable_on; HAS_INTEGRAL_OPEN_INTERVAL]);; let INTEGRAL_OPEN_INTERVAL = prove (`!f a b. integral(interval(a,b)) f = integral(interval[a,b]) f`, REWRITE_TAC[integral; HAS_INTEGRAL_OPEN_INTERVAL]);; let MEASURABLE_SEGMENT = prove (`(!a b:real^N. measurable(segment[a,b])) /\ (!a b:real^N. measurable(segment(a,b)))`, SIMP_TAC[MEASURABLE_CONVEX; CONVEX_SEGMENT; BOUNDED_SEGMENT]);; let MEASURE_SEGMENT_1 = prove (`(!a b:real^1. measure(segment[a,b]) = norm(b - a)) /\ (!a b:real^1. measure(segment(a,b)) = norm(b - a))`, REWRITE_TAC[SEGMENT_1] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MEASURE_INTERVAL_1] THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN ASM_REAL_ARITH_TAC);; let NEGLIGIBLE_SEGMENT = prove (`(!a b:real^N. negligible(segment[a,b]) <=> 2 <= dimindex(:N) \/ a = b) /\ (!a b:real^N. negligible(segment(a,b)) <=> 2 <= dimindex(:N) \/ a = b)`, SIMP_TAC[NEGLIGIBLE_CONVEX_INTERIOR; CONVEX_SEGMENT] THEN REWRITE_TAC[INTERIOR_SEGMENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY]);; let MEASURE_BALL_SCALING = prove (`!a:real^N c r. &0 <= c ==> measure(ball(a,c * r)) = c pow dimindex(:N) * measure(ball(a,r))`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[REAL_MUL_LZERO; BALL_EMPTY; REAL_LE_REFL; MEASURE_EMPTY; REAL_POW_ZERO; DIMINDEX_NONZERO] THEN SUBGOAL_THEN `&0 < c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = c % vec 0`) THEN ASM_SIMP_TAC[BALL_SCALING; MEASURE_SCALING; MEASURABLE_BALL] THEN ASM_REWRITE_TAC[real_abs; VECTOR_MUL_RZERO]);; let MEASURE_CBALL_SCALING = prove (`!a:real^N c r. &0 <= c ==> measure(cball(a,c * r)) = c pow dimindex(:N) * measure(cball(a,r))`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[REAL_MUL_LZERO; CBALL_SING; REAL_LE_REFL; MEASURE_SING; REAL_POW_ZERO; DIMINDEX_NONZERO] THEN SUBGOAL_THEN `&0 < c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = c % vec 0`) THEN ASM_SIMP_TAC[CBALL_SCALING; MEASURE_SCALING; MEASURABLE_CBALL] THEN ASM_REWRITE_TAC[real_abs; VECTOR_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* An existence theorem for "improper" integrals. Hake's theorem implies *) (* that if the integrals over subintervals have a limit then the integral *) (* exists. This is incomparable: we only need a priori to assume that *) (* the integrals are bounded, and we get absolute integrability, but we *) (* also need a (rather weak) bound assumption on the function. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_INTEGRABLE_IMPROPER = prove (`!net:A net f:real^M->real^N a b. (!c d. interval[c,d] SUBSET interval(a,b) ==> f integrable_on interval[c,d]) /\ bounded { integral (interval[c,d]) f | interval[c,d] SUBSET interval(a,b)} /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> ?g. g absolutely_integrable_on interval[a,b] /\ ((!x. x IN interval[a,b] ==> (f x)$i <= drop(g x)) \/ (!x. x IN interval[a,b] ==> (f x)$i >= drop(g x)))) ==> f absolutely_integrable_on interval[a,b]`, REPEAT GEN_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_NULL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONTENT_LT_NZ; CONTENT_POS_LT_EQ]) THEN STRIP_TAC THEN ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[real_ge] THEN SUBGOAL_THEN `(!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET interval(a:real^M,b)) /\ (!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET interval[a:real^M,b])` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ t SUBSET u ==> s SUBSET t /\ s SUBSET u`) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `a < a + x <=> &0 < x`; REAL_ARITH `b - x < b <=> &0 < x`; REAL_LT_MUL; REAL_SUB_LT; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`]; ALL_TAC] THEN SUBGOAL_THEN `!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET interval[a + inv(&(SUC n) + &1) % (b - a):real^M, b - inv(&(SUC n) + &1) % (b - a)]` ASSUME_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL] THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `a + x * y <= a + w * y <=> &0 <= (w - x) * y`; REAL_ARITH `b - w * y <= b - x * y <=> &0 <= (w - x) * y`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE; GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^1` STRIP_ASSUME_TAC) THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN EXISTS_TAC `g:real^M->real^1` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; DIMINDEX_1] THEN ASM_REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP] THEN SUBGOAL_THEN `(\x. lift((f:real^M->real^N) x$i)) = (\x. g x - (g x - lift(f x$i)))` SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN MP_TAC(ISPECL [`\n x. if x IN interval[a + inv(&n + &1) % (b - a), b - inv(&n + &1) % (b - a)] then g x - lift((f:real^M->real^N) x $i) else vec 0`; `\x. g x - lift((f:real^M->real^N) x$i)`; `interval(a:real^M,b)`] MONOTONE_CONVERGENCE_INCREASING) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[INTEGRABLE_ON_OPEN_INTERVAL]] THEN REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN ASM_MESON_TAC[]]; ALL_TAC]; MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN EXISTS_TAC `g:real^M->real^1` THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; DIMINDEX_1] THEN ASM_REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP] THEN SUBGOAL_THEN `(\x. lift((f:real^M->real^N) x$i)) = (\x. (lift(f x$i) - g x) + g x)` SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN MP_TAC(ISPECL [`\n x. if x IN interval[a + inv(&n + &1) % (b - a), b - inv(&n + &1) % (b - a)] then lift((f:real^M->real^N) x $i) - g x else vec 0`; `\x. lift((f:real^M->real^N) x$i) - g x`; `interval(a:real^M,b)`] MONOTONE_CONVERGENCE_INCREASING) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[INTEGRABLE_ON_OPEN_INTERVAL]] THEN REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN ASM_MESON_TAC[]; ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]; ALL_TAC]] THEN (REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN ASM_SIMP_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; LIFT_DROP] THEN ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MP_TAC(SPEC `inf({(x - a:real^M)$i / (b - a)$i | i IN 1..dimindex(:M)} UNION {(b - x:real^M)$i / (b - a)$i | i IN 1..dimindex(:M)})` REAL_ARCH_INV) THEN SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; FINITE_UNION; IMAGE_UNION; EMPTY_UNION] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_IMAGE] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; IN_NUMSEG; EVENTUALLY_SEQUENTIALLY] THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_RDIV_EQ; REAL_MUL_LZERO] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN MATCH_MP_TAC(MESON[] `(!x. ~P x) ==> (?x. P x) ==> Q`) THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; REAL_ARITH `a + y <= x /\ x <= b - y <=> y <= x - a /\ y <= b - x`] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1] THEN ASM_ARITH_TAC; FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_INTEGRALS_OVER_SUBINTERVALS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `B + C:real` THEN ASM_SIMP_TAC[REAL_LT_ADD] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN GEN_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) INTEGRAL_SUB o rand o lhand o snd) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; DISCH_THEN SUBST1_TAC]]) THENL [MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= c /\ norm(y) <= b ==> norm(x - y) <= b + c`); MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= c /\ norm(y) <= b ==> norm(x - y) <= c + b`)] THEN ASM_SIMP_TAC[] THEN IMP_REWRITE_TAC[GSYM LIFT_INTEGRAL_COMPONENT] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTEGRABLE_COMPONENTWISE]) THEN ASM_SIMP_TAC[NORM_LIFT] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Crude upper bounds for measure of balls. *) (* ------------------------------------------------------------------------- *) let MEASURE_CBALL_BOUND = prove (`!x:real^N d. &0 <= d ==> measure(cball(x,d)) <= (&2 * d) pow (dimindex(:N))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(interval[x - d % vec 1:real^N,x + d % vec 1])` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_CBALL; MEASURABLE_INTERVAL] THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; dist] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`x - y:real^N`; `i:num`] COMPONENT_LE_NORM) THEN ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC; SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_POS] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `(x + a) - (x - a):real = &2 * a`] THEN REWRITE_TAC[PRODUCT_CONST_NUMSEG; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN REWRITE_TAC[REAL_MUL_RID; ADD_SUB; REAL_LE_REFL]]);; let MEASURE_BALL_BOUND = prove (`!x:real^N d. &0 <= d ==> measure(ball(x,d)) <= (&2 * d) pow (dimindex(:N))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(cball(x:real^N,d))` THEN ASM_SIMP_TAC[MEASURE_CBALL_BOUND] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[BALL_SUBSET_CBALL; MEASURABLE_BALL; MEASURABLE_CBALL]);; (* ------------------------------------------------------------------------- *) (* Negligibility of image under non-injective linear map. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_LINEAR_SINGULAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ ~(!x y. f(x) = f(y) ==> x = y) ==> negligible(IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LINEAR_SINGULAR_IMAGE_HYPERPLANE) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | a dot x = &0}` THEN ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; (* ------------------------------------------------------------------------- *) (* Some technical lemmas used in the approximation results that follow. *) (* Proof of the covering lemma is an obvious multidimensional generalization *) (* of Lemma 3, p65 of Swartz's "Introduction to Gauge Integrals". *) (* ------------------------------------------------------------------------- *) let COVERING_LEMMA = prove (`!a b:real^N s g. s SUBSET interval[a,b] /\ ~(interval(a,b) = {}) /\ gauge g ==> ?d. COUNTABLE d /\ (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\ (?c d. k = interval[c,d])) /\ (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) ==> interior k1 INTER interior k2 = {}) /\ (!k. k IN d ==> ?x. x IN (s INTER k) /\ k SUBSET g(x)) /\ (!u v. interval[u,v] IN d ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ s SUBSET UNIONS d`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?d. COUNTABLE d /\ (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\ (?c d:real^N. k = interval[c,d])) /\ (!k1 k2. k1 IN d /\ k2 IN d ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/ interior k1 INTER interior k2 = {}) /\ (!x. x IN s ==> ?k. k IN d /\ x IN k /\ k SUBSET g(x)) /\ (!u v. interval[u,v] IN d ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l})` ASSUME_TAC THENL [EXISTS_TAC `IMAGE (\(n,v). interval[(lambda i. a$i + &(v$i) / &2 pow n * ((b:real^N)$i - (a:real^N)$i)):real^N, (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))]) {n,v | n IN (:num) /\ v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N) ==> v$i < 2 EXP n}}` THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[NUM_COUNTABLE; IN_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; LAMBDA_BETA] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LE_MUL_EQ; REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_LE_ADDR; REAL_ARITH `a + x * (b - a) <= b <=> &0 <= (&1 - x) * (b - a)`] THEN SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_DIV2_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `x <= x + &1 /\ x < x + &1`] THEN REWRITE_TAC[REAL_SUB_LE] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID] THEN SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[ARITH_RULE `x + 1 <= y <=> x < y`; REAL_LT_IMP_LE]; ALL_TAC] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_ELIM_PAIR_THM; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`v:num^N`; `w:num^N`] THEN REPEAT DISCH_TAC THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; SUBSET_INTERVAL] THEN SIMP_TAC[DISJOINT_INTERVAL; LAMBDA_BETA] THEN MATCH_MP_TAC(TAUT `p \/ q \/ r ==> (a ==> p) \/ (b ==> q) \/ r`) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; LAMBDA_BETA] THEN REWRITE_TAC[NOT_IMP; REAL_LE_LADD] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `~(x + &1 <= x)`] THEN DISJ2_TAC THEN MATCH_MP_TAC(MESON[] `(!i. ~P i ==> Q i) ==> (!i. Q i) \/ (?i. P i)`) THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN UNDISCH_TAC `m:num <= n` THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2; REAL_LT_DIV2_EQ] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?e. &0 < e /\ !y. (!i. 1 <= i /\ i <= dimindex(:N) ==> abs((x:real^N)$i - (y:real^N)$i) <= e) ==> y IN g(x)` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [gauge]) THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / &2 / &(dimindex(:N))` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; ARITH] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[IN_BALL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; VECTOR_SUB_COMPONENT; CARD_NUMSEG_1]; ALL_TAC] THEN REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN MP_TAC(SPECL [`&1 / &2`; `e / norm(b - a:real^N)`] REAL_ARCH_POW_INV) THEN SUBGOAL_THEN `&0 < norm(b - a:real^N)` ASSUME_TAC THENL [ASM_MESON_TAC[VECTOR_SUB_EQ; NORM_POS_LT; INTERVAL_SING]; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN DISCH_TAC THEN SIMP_TAC[IN_ELIM_THM; IN_INTERVAL; SUBSET; LAMBDA_BETA] THEN MATCH_MP_TAC(MESON[] `(!x. Q x ==> R x) /\ (?x. P x /\ Q x) ==> ?x. P x /\ Q x /\ R x`) THEN CONJ_TAC THENL [REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`w:num^N`; `y:real^N`] THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(a + n <= x /\ x <= a + m) /\ (a + n <= y /\ y <= a + m) ==> abs(x - y) <= m - n`)) THEN MATCH_MP_TAC(REAL_ARITH `y * z <= e ==> a <= ((x + &1) * y) * z - ((x * y) * z) ==> a <= e`) THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n < e * x ==> &0 <= e * (inv y - x) ==> n <= e / y`)) THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_SUB_LT] THEN MP_TAC(SPECL [`b - a:real^N`; `i:num`] COMPONENT_LE_NORM) THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_UNIV; AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(a ==> c) /\ (a ==> b) <=> a ==> b /\ c`] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^N) IN interval[a,b]` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN STRIP_TAC THEN DISJ_CASES_TAC(MATCH_MP (REAL_ARITH `x <= y ==> x = y \/ x < y`) (ASSUME `(x:real^N)$i <= (b:real^N)$i`)) THENL [EXISTS_TAC `2 EXP n - 1` THEN SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_LT; EXP_LT_0; LE_1; ARITH] THEN ASM_REWRITE_TAC[REAL_SUB_ADD; REAL_ARITH `a - &1 < a`] THEN MATCH_MP_TAC(REAL_ARITH `&1 * (b - a) = x /\ y <= x ==> a + y <= b /\ b <= a + x`) THEN ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_MUL_RINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `&2 pow n * ((x:real^N)$i - (a:real^N)$i) / ((b:real^N)$i - (a:real^N)$i)` FLOOR_POS) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_MUL; REAL_POW_LE; REAL_POS; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_DIV]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[REAL_ARITH `a + b * c <= x /\ x <= a + b' * c <=> b * c <= x - a /\ x - a <= b' * c`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT; GSYM real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN SIMP_TAC[FLOOR; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `((x:real^N)$i - (a:real^N)$i) / ((b:real^N)$i - (a:real^N)$i) * &2 pow n` THEN REWRITE_TAC[FLOOR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_SUB_LT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN REWRITE_TAC[EQ_INTERVAL; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY; IN_UNIV; IN_ELIM_THM] THEN SIMP_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`; LAMBDA_BETA] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_SUB_LT; REAL_LT_DIV2_EQ; REAL_LT_POW2; REAL_ARITH `~(v + &1 < v)`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\(n,v). interval[(lambda i. a$i + &(v$i) / &2 pow n * ((b:real^N)$i - (a:real^N)$i)):real^N, (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))]) {m,v | m IN 0..n /\ v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N) ==> v$i < 2 EXP m}}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT]; ALL_TAC] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `w:num^N`] THEN DISCH_TAC THEN DISCH_TAC THEN SIMP_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN MAP_EVERY EXISTS_TAC [`m:num`; `w:num^N`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_NUMSEG; GSYM NOT_LT; LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN SIMP_TAC[NOT_IMP; LAMBDA_BETA] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `x <= x + &1`] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `w / m <= v / n /\ (v + &1) / n <= (w + &1) / m ==> inv n <= inv m`)) THEN REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `?d. COUNTABLE d /\ (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\ (?c d:real^N. k = interval[c,d])) /\ (!k1 k2. k1 IN d /\ k2 IN d ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/ interior k1 INTER interior k2 = {}) /\ (!k. k IN d ==> (?x. x IN s INTER k /\ k SUBSET g x)) /\ (!u v. interval[u,v] IN d ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l}) /\ s SUBSET UNIONS d` MP_TAC THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{k:real^N->bool | k IN d /\ ?x. x IN (s INTER k) /\ k SUBSET g x}` THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `d:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; X_GEN_TAC `k:real^N->bool` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{l:real^N->bool | l IN d /\ k SUBSET l}` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ASM SET_TAC[]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{k:real^N->bool | k IN d /\ !k'. k' IN d /\ ~(k = k') ==> ~(k SUBSET k')}` THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `d:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `x:real^N`] THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MP_TAC(ISPEC `\k l:real^N->bool. k IN d /\ l IN d /\ l SUBSET k /\ ~(k = l)` WF_FINITE) THEN REWRITE_TAC[WF] THEN ANTS_TAC THENL [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N->bool` THEN ASM_CASES_TAC `(l:real^N->bool) IN d` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{m:real^N->bool | m IN d /\ l SUBSET m}` THEN ASM_SIMP_TAC[] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `\l:real^N->bool. l IN d /\ x IN l`) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let COUNTABLE_ELEMENTARY_DIVISION = prove (`!d. COUNTABLE d /\ (!k. k IN d ==> ?a b:real^N. k = interval[a,b]) ==> ?d'. COUNTABLE d' /\ (!k. k IN d' ==> ~(k = {}) /\ ?a b. k = interval[a,b]) /\ (!k l. k IN d' /\ l IN d' /\ ~(k = l) ==> interior k INTER interior l = {}) /\ UNIONS d' = UNIONS d`, let lemma = prove (`!s. UNIONS(s DELETE {}) = UNIONS s`, REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN MESON_TAC[NOT_IN_EMPTY]) in REWRITE_TAC[IMP_CONJ; FORALL_COUNTABLE_AS_IMAGE] THEN REWRITE_TAC[UNIONS_0; EMPTY_UNIONS] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN REWRITE_TAC[NOT_IN_EMPTY; COUNTABLE_EMPTY]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->real^N->bool`; `a:num->real^N`; `b:num->real^N`] THEN DISCH_TAC THEN (CHOOSE_THEN MP_TAC o prove_recursive_functions_exist num_RECURSION) `x 0 = ({}:(real^N->bool)->bool) /\ (!n. x(SUC n) = @q. (x n) SUBSET q /\ q division_of (d n) UNION UNIONS(x n))` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `!n:num. (x n) division_of UNIONS {d k:real^N->bool | k < n}` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[LT; SET_RULE `UNIONS {f x |x| F} = {}`; DIVISION_OF_TRIVIAL] THEN FIRST_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o MATCH_MP DIVISION_OF_UNION_SELF) THEN DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN REWRITE_TAC[SET_RULE `{f x | x = a \/ q x} = f a INSERT {f x | q x}`] THEN REWRITE_TAC[UNIONS_INSERT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM o last o CONJUNCTS) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m <= n ==> (x:num->(real^N->bool)->bool) m SUBSET x n` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o MATCH_MP DIVISION_OF_UNION_SELF o SPEC `n:num`) THEN DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EXISTS_TAC `UNIONS(IMAGE x (:num)) DELETE ({}:real^N->bool)` THEN REWRITE_TAC[COUNTABLE_DELETE; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN ASM_MESON_TAC[DIVISION_OF_FINITE]; MAP_EVERY X_GEN_TAC [`n:num`; `k:real^N->bool`] THEN ASM_MESON_TAC[division_of]; REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o SPEC `n:num`) THEN ASM SET_TAC[]; REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV; FORALL_IN_UNIONS; SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THENL [X_GEN_TAC `k:real^N->bool` THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o SPEC `n:num`) THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`n:num`; `y:real^N`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o SPEC `SUC n`) THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_MESON_TAC[ARITH_RULE `n < SUC n`]]]);; let EXPAND_CLOSED_OPEN_INTERVAL = prove (`!a b:real^N e. &0 < e ==> ?c d. interval[a,b] SUBSET interval(c,d) /\ measure(interval(c,d)) <= measure(interval[a,b]) + e`, let lemma = prove (`!f n. (\x. lift(product(1..n) (\i. f i + drop x))) continuous at (vec 0)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH_EQ; CONTINUOUS_CONST] THEN REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_CONST]) in REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = midpoint(a,b)` THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `m:real^N` THEN REWRITE_TAC[midpoint; VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `interval[--b:real^N,b] = {}` THENL [MAP_EVERY EXISTS_TAC [`--b:real^N`; `b:real^N`] THEN REWRITE_TAC[MEASURE_INTERVAL] THEN ASM_REWRITE_TAC[CONTENT_EMPTY; EMPTY_SUBSET] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= x <=> &0 <= x`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\i. &2 * (b:real^N)$i`; `dimindex(:N)`] lemma) THEN REWRITE_TAC[continuous_at; DIST_LIFT; FORALL_LIFT; DIST_0; DROP_VEC] THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP; REAL_ADD_RID] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`--(b + k / &4 % vec 1:real^N)`; `b + k / &4 % vec 1:real^N`] THEN REWRITE_TAC[MEASURE_INTERVAL; SUBSET_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ARITH `--x <= x <=> &0 <= x`; REAL_LT_ADDR; REAL_ARITH `&0 < k / &4 <=> &0 < k`; REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < b`; REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < --b`; REAL_ARITH `&0 <= b /\ &0 < k ==> &0 <= b + k`] THEN REWRITE_TAC[REAL_ARITH `b - --b = &2 * b`; REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC(REAL_ARITH `abs(a - b) < e ==> a <= b + e`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Outer and inner approximation of measurable set by well-behaved sets. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_OUTER_INTERVALS_BOUNDED = prove (`!s a b:real^N e. measurable s /\ s SUBSET interval[a,b] /\ &0 < e ==> ?d. COUNTABLE d /\ (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\ (?c d. k = interval[c,d])) /\ (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) ==> interior k1 INTER interior k2 = {}) /\ (!u v. interval[u,v] IN d ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ (!k. k IN d /\ ~(interval(a,b) = {}) ==> ~(interior k = {})) /\ s SUBSET UNIONS d /\ measurable (UNIONS d) /\ measure (UNIONS d) <= measure s + e`, let lemma = prove (`(!x y. (x,y) IN IMAGE (\z. f z,g z) s ==> P x y) <=> (!z. z IN s ==> P (f z) (g z))`, REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN MESON_TAC[]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN STRIP_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0; MEASURE_EMPTY; REAL_ADD_LID; SUBSET_REFL; COUNTABLE_EMPTY; MEASURABLE_EMPTY] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN STRIP_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `{interval[a:real^N,b]}` THEN REWRITE_TAC[UNIONS_1; COUNTABLE_SING] THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT; NOT_IN_EMPTY; SUBSET_REFL; MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_SING; EQ_INTERVAL] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[real_pow; REAL_DIV_1]; SUBGOAL_THEN `measure(interval[a:real^N,b]) = &0 /\ measure(s:real^N->bool) = &0` (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE; REAL_ADD_LID]) THEN SUBGOAL_THEN `interval[a:real^N,b] has_measure &0 /\ (s:real^N->bool) has_measure &0` (fun th -> MESON_TAC[th; MEASURE_UNIQUE]) THEN REWRITE_TAC[HAS_MEASURE_0] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[NEGLIGIBLE_INTERVAL]; ASM_MESON_TAC[NEGLIGIBLE_SUBSET]]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN DISCH_THEN(X_CHOOSE_TAC `m:real`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_UNIQUE) THEN SUBGOAL_THEN `((\x:real^N. if x IN s then vec 1 else vec 0) has_integral (lift m)) (interval[a,b])` ASSUME_TAC THENL [ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`a:real^N`; `b:real^N`; `s:real^N->bool`; `g:real^N->real^N->bool`] COVERING_LEMMA) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_EMPTY]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; `a:real^N`; `b:real^N`; `g:real^N->real^N->bool`; `e:real`] HENSTOCK_LEMMA_PART1) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN SUBGOAL_THEN `!k l:real^N->bool. k IN d /\ l IN d /\ ~(k = l) ==> negligible(k INTER l)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`]) THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `?x y:real^N u v:real^N. k = interval[x,y] /\ l = interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `(interval[x:real^N,y] DIFF interval(x,y)) UNION (interval[u:real^N,v] DIFF interval(u,v)) UNION (interval (x,y) INTER interval (u,v))` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN ASM_REWRITE_TAC[UNION_EMPTY] THEN SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_FRONTIER_INTERVAL]; ALL_TAC] THEN SUBGOAL_THEN `!D. FINITE D /\ D SUBSET d ==> measurable(UNIONS D :real^N->bool) /\ measure(UNIONS D) <= m + e` ASSUME_TAC THENL [GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `?t:(real^N->bool)->real^N. !k. k IN D ==> t(k) IN (s INTER k) /\ k SUBSET (g(t k))` (CHOOSE_THEN (LABEL_TAC "+")) THENL [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `IMAGE (\k. (t:(real^N->bool)->real^N) k,k) D`) THEN ASM_SIMP_TAC[VSUM_IMAGE; PAIR_EQ] THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [REWRITE_TAC[tagged_partial_division_of; fine] THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[lemma; RIGHT_FORALL_IMP_THM; IMP_CONJ; PAIR_EQ] THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET]]; ALL_TAC] THEN USE_THEN "+" (MP_TAC o REWRITE_RULE[IN_INTER]) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[VSUM_SUB] THEN SUBGOAL_THEN `D division_of (UNIONS D:real^N->bool)` ASSUME_TAC THENL [REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_ELEMENTARY) THEN SUBGOAL_THEN `vsum D (\k:real^N->bool. content k % vec 1) = lift(measure(UNIONS D))` SUBST1_TAC THENL [ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN ASM_SIMP_TAC[LIFT_DROP; DROP_VSUM; o_DEF; DROP_CMUL; DROP_VEC] THEN SIMP_TAC[REAL_MUL_RID; ETA_AX] THEN ASM_MESON_TAC[MEASURE_ELEMENTARY]; ALL_TAC] THEN SUBGOAL_THEN `vsum D (\k. integral k (\x:real^N. if x IN s then vec 1 else vec 0)) = lift(sum D (\k. measure(k INTER s)))` SUBST1_TAC THENL [ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `measurable(k:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM INTEGRAL_MEASURE_UNIV; MEASURABLE_INTER] THEN REWRITE_TAC[MESON[IN_INTER] `(if x IN k INTER s then a else b) = (if x IN k then if x IN s then a else b else b)`] THEN REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `y <= m ==> abs(x - y) <= e ==> x <= m + e`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(UNIONS D INTER s:real^N->bool)` THEN CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "m" THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_INTER THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_INTER]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k INTER l:real^N->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN ASM_REWRITE_TAC[INFINITE] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool` (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN MP_TAC(ISPECL [`s:num->real^N->bool`; `m + e:real`] HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN MATCH_MP_TAC(TAUT `a /\ (a /\ b ==> c) ==> (a ==> b) ==> c`) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; MEASURABLE_INTER]; ASM_MESON_TAC[]; X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (s:num->real^N->bool) (0..n)`) THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_SUBSET; SUBSET_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= e ==> y <= e`) THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN ASM_MESON_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL]; ALL_TAC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_UBOUND) THEN EXISTS_TAC `\n. vsum(from 0 INTER (0..n)) (\n. lift(measure(s n:real^N->bool)))` THEN ASM_REWRITE_TAC[GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[DIMINDEX_1; ARITH; EVENTUALLY_SEQUENTIALLY] THEN SIMP_TAC[VSUM_COMPONENT; ARITH; DIMINDEX_1] THEN ASM_REWRITE_TAC[GSYM drop; LIFT_DROP; FROM_INTER_NUMSEG]);; let MEASURABLE_OUTER_CLOSED_INTERVALS = prove (`!s:real^N->bool e. measurable s /\ &0 < e ==> ?d. COUNTABLE d /\ (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval[a,b])) /\ (!k l. k IN d /\ l IN d /\ ~(k = l) ==> interior k INTER interior l = {}) /\ s SUBSET UNIONS d /\ measurable (UNIONS d) /\ measure (UNIONS d) <= measure s + e`, let lemma = prove (`UNIONS (UNIONS {d n | n IN (:num)}) = UNIONS {UNIONS(d n) | n IN (:num)}`, REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `?d. COUNTABLE d /\ (!k. k IN d ==> ?a b:real^N. k = interval[a,b]) /\ s SUBSET UNIONS d /\ measurable (UNIONS d) /\ measure (UNIONS d) <= measure s + e` MP_TAC THENL [ALL_TAC; DISCH_THEN(X_CHOOSE_THEN `d1:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `d1:(real^N->bool)->bool` COUNTABLE_ELEMENTARY_DIVISION) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_REWRITE_TAC[]] THEN MP_TAC(ISPECL [`\n. s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`; `measure(s:real^N->bool)`] HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN SUBGOAL_THEN `!m n. ~(m = n) ==> (s INTER (ball(vec 0,&m + &1) DIFF ball(vec 0,&m))) INTER (s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n))) = ({}:real^N->bool)` ASSUME_TAC THENL [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `m1 SUBSET n ==> (s INTER (m1 DIFF m)) INTER (s INTER (n1 DIFF n)) = {}`) THEN MATCH_MP_TAC SUBSET_BALL THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN ANTS_TAC THENL [ASM_SIMP_TAC[NEGLIGIBLE_EMPTY] THEN X_GEN_TAC `n:num` THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN ASM_SIMP_TAC[FINITE_NUMSEG; DISJOINT] THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN SIMP_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM; IN_INTER] THEN ASM_SIMP_TAC[MEASURABLE_UNIONS; FINITE_NUMSEG; FORALL_IN_IMAGE; FINITE_IMAGE; MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL]; ALL_TAC] THEN SUBGOAL_THEN `UNIONS {s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n)) | n IN (:num)} = (s:real^N->bool)` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?n. (x:real^N) IN ball(vec 0,&n)` MP_TAC THENL [REWRITE_TAC[IN_BALL_0; REAL_ARCH_LT]; GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[IN_BALL_0; GSYM REAL_NOT_LE; NORM_POS_LE]; STRIP_TAC THEN EXISTS_TAC `n - 1` THEN REWRITE_TAC[IN_DIFF] THEN ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN MP_TAC(MATCH_MP MONO_FORALL (GEN `n:num` (ISPECL [`s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`; `--(vec(n + 1)):real^N`; `vec(n + 1):real^N`; `e / &2 / &2 pow n`] MEASURABLE_OUTER_INTERVALS_BOUNDED))) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; REAL_LT_POW2] THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_INTERVAL; IN_BALL_0; IN_DIFF; REAL_NOT_LT; REAL_OF_NUM_ADD; VECTOR_NEG_COMPONENT; VEC_COMPONENT; REAL_BOUNDS_LE] THEN MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; REAL_LT_IMP_LE]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN X_GEN_TAC `d:num->(real^N->bool)->bool` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS {d n | n IN (:num)} :(real^N->bool)->bool` THEN REWRITE_TAC[lemma] THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IN_UNIONS] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..n) (\k. measure(s INTER (ball(vec 0:real^N,&k + &1) DIFF ball(vec 0,&k))) + e / &2 / &2 pow k)` THEN ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN ASM_SIMP_TAC[DISJOINT; FINITE_NUMSEG; MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_BALL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_NUMSEG; FINITE_IMAGE; MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_BALL] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]; REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP; LT] THEN REWRITE_TAC[GSYM real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `e / &2 * (&1 - x) / (&1 / &2) <= e <=> &0 <= e * x`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let MEASURABLE_OUTER_OPEN_INTERVALS = prove (`!s:real^N->bool e. measurable s /\ &0 < e ==> ?d. COUNTABLE d /\ (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval(a,b))) /\ s SUBSET UNIONS d /\ measurable (UNIONS d) /\ measure (UNIONS d) <= measure s + e`, let lemma = prove (`!s. UNIONS(s DELETE {}) = UNIONS s`, REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN MESON_TAC[NOT_IN_EMPTY]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURABLE_OUTER_CLOSED_INTERVALS) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `dset:(real^N->bool)->bool` THEN ASM_CASES_TAC `dset:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[UNIONS_0; SUBSET_EMPTY] THEN STRIP_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY; MEASURE_EMPTY; SUBSET_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `?f. dset = IMAGE (f:num->(real^N->bool)) (:num) DELETE {} /\ (!m n. f m = f n ==> m = n \/ f n = {})` MP_TAC THENL [ASM_CASES_TAC `FINITE(dset:(real^N->bool)->bool)` THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_HAS_SIZE]) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_INDEX) THEN ABBREV_TAC `m = CARD(dset:(real^N->bool)->bool)` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\i. if i < m then (f:num->real^N->bool) i else {}` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_DELETE; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[]; MP_TAC(ISPEC `dset:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[SET_RULE `s = s DELETE a <=> ~(a IN s)`] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num->real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; FORALL_AND_THM; SKOLEM_THM; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_DELETE; lemma] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!x. ~(P x) ==> ~(P x) /\ Q x) ==> (!x. P x ==> Q x) ==> !x. Q x`)) THEN ANTS_TAC THENL [MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN GEN_REWRITE_TAC I [IMP_CONJ] THEN DISCH_THEN(MP_TAC o MATCH_MP(MESON[] `(!x y. ~(P x) /\ ~(P y) /\ ~(f x = f y) ==> Q x y) ==> (!x y. P x ==> Q x y) /\ (!x y. P y ==> Q x y) ==> (!x y. ~(f x = f y) ==> Q x y)`)) THEN SIMP_TAC[INTERIOR_EMPTY; INTER_EMPTY] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?d. COUNTABLE d /\ (!k. k IN d ==> ?a b:real^N. k = interval(a,b)) /\ s SUBSET UNIONS d /\ measurable (UNIONS d) /\ measure (UNIONS d) <= measure s + e` MP_TAC THENL [ALL_TAC; DISCH_THEN(X_CHOOSE_TAC `d:(real^N->bool)->bool`) THEN EXISTS_TAC `d DELETE ({}:real^N->bool)` THEN ASM_SIMP_TAC[lemma; COUNTABLE_DELETE; IN_DELETE]] THEN MP_TAC(GEN `n:num` (ISPECL [`(a:num->real^N) n`; `(b:num->real^N) n`; `e / &2 pow (n + 2)`] EXPAND_CLOSED_OPEN_INTERVAL)) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; SKOLEM_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`A:num->real^N`; `B:num->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (\n. interval(A n:real^N,B n)) (:num)` THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN ASM_REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; IN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..n) (\i. measure(interval[a i:real^N,b i]) + e / &2 pow (i + 2))` THEN ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN REWRITE_TAC[real_div; REAL_INV_MUL; SUM_LMUL; REAL_POW_ADD; SUM_RMUL] THEN REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `s <= m + e / &2 /\ &0 <= e * x ==> s + e * (&1 - x) / (&1 / &2) * &1 / &4 <= m + e`) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_LT_IMP_LE; REAL_LE_DIV; REAL_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o lhand o snd) THEN REWRITE_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `interval[(a:num->real^N) i,b i] = interval[a j,b j]` THENL [UNDISCH_TAC `!m n. (d:num->real^N->bool) m = d n ==> m = n \/ d n = {}` THEN DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV o RAND_CONV o LAND_CONV) [GSYM INTERIOR_INTER]) THEN DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE] THEN SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN MATCH_MP_TAC(MESON[MEASURE_EMPTY] `measure(interior s) = measure s ==> interior s = {} ==> measure s = &0`) THEN MATCH_MP_TAC MEASURE_INTERIOR THEN SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_INTER; CONVEX_INTERVAL]]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL; FINITE_NUMSEG]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_UNIONS THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]]);; let MEASURABLE_OUTER_OPEN = prove (`!s:real^N->bool e. measurable s /\ &0 < e ==> ?t. open t /\ s SUBSET t /\ measurable t /\ measure t < measure s + e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURABLE_OUTER_OPEN_INTERVALS) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS d :real^N->bool` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ m <= s + e / &2 ==> m < s + e`] THEN MATCH_MP_TAC OPEN_UNIONS THEN ASM_MESON_TAC[OPEN_INTERVAL]);; let MEASURABLE_INNER_COMPACT = prove (`!s:real^N->bool e. measurable s /\ &0 < e ==> ?t. compact t /\ t SUBSET s /\ measurable t /\ measure s < measure t + e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`interval[a:real^N,b] DIFF s`; `e/ &4`] MEASURABLE_OUTER_OPEN) THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL; REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `interval[a:real^N,b] DIFF t` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_SIMP_TAC[CLOSED_DIFF; CLOSED_INTERVAL; BOUNDED_DIFF; BOUNDED_INTERVAL]; ASM SET_TAC[]; ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL]; MATCH_MP_TAC(REAL_ARITH `&0 < e /\ measure(s) < measure(interval[a,b] INTER s) + e / &4 /\ measure(t) < measure(interval[a,b] DIFF s) + e / &4 /\ measure(interval[a,b] INTER s) + measure(interval[a,b] DIFF s) = measure(interval[a,b]) /\ measure(interval[a,b] INTER t) + measure(interval[a,b] DIFF t) = measure(interval[a,b]) /\ measure(interval[a,b] INTER t) <= measure t ==> measure s < measure(interval[a,b] DIFF t) + e`) THEN ASM_SIMP_TAC[MEASURE_SUBSET; INTER_SUBSET; MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [FIRST_ASSUM(SUBST_ALL_TAC o SYM o MATCH_MP MEASURE_UNIQUE) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REAL_ARITH_TAC; CONJ_TAC THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION_EQ THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN SET_TAC[]]]);; let OPEN_MEASURABLE_INNER_DIVISION = prove (`!s:real^N->bool e. open s /\ measurable s /\ &0 < e ==> ?D. D division_of UNIONS D /\ UNIONS D SUBSET s /\ measure s < measure(UNIONS D) + e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURE_LIMIT) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN ASM_REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `s INTER interval(a - vec 1:real^N,b + vec 1)` OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL; SUBSET_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`D:(real^N->bool)->bool`; `measure(s:real^N->bool)`; `e / &2`] MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(UNIONS D :real^N->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL]; ASM_SIMP_TAC[SUBSET_UNIONS]]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET]]; DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `d:(real^N->bool)->bool` ELEMENTARY_UNIONS_INTERVALS) THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:(real^N->bool)->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `UNIONS p :real^N->bool = UNIONS d` SUBST1_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `UNIONS D :real^N->bool` THEN ASM_SIMP_TAC[SUBSET_UNIONS; INTER_SUBSET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `ms' - e / &2 < mud ==> ms < ms' + e / &2 ==> ms < mud + e`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(sc - s) < e / &2 ==> sc <= so /\ sc <= s ==> s < so + e / &2`)) THEN CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN REWRITE_TAC[SUBSET_INTERVAL; VECTOR_SUB_COMPONENT; VEC_COMPONENT; VECTOR_ADD_COMPONENT] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]]);; let OUTER_MEASURE = prove (`!s:real^N->bool. bounded s ==> ?t. s SUBSET t /\ measurable t /\ !t'. s SUBSET t' /\ measurable t' ==> negligible(t DIFF t')`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE measure {u:real^N->bool | s SUBSET u /\ measurable u /\ open u}` INF) THEN REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_GSPEC] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[BOUNDED_SUBSET_BALL; OPEN_BALL; BOUNDED_BALL; MEASURABLE_OPEN; MEASURE_POS_LE]; ALL_TAC] THEN ABBREV_TAC `b = inf(IMAGE measure { u:real^N->bool | s SUBSET u /\ measurable u /\ open u})` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC(GEN `n:num` (SPEC `b + inv(&n + &1)` th)) THEN MP_TAC(SPEC `&0` th)) THEN SIMP_TAC[MEASURE_POS_LE; MEASURABLE_OPEN] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `b + x <= b <=> ~(&0 < x)`] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:num->real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `INTERS {u n | n IN (:num)} : real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS; MEASURABLE_OPEN] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (funpow 3 rand) MEASURABLE_MEASURE_POS_LT o snd) THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_COUNTABLE_INTERS; MEASURABLE_OPEN] THEN MATCH_MP_TAC(TAUT `~p ==> (p <=> ~q) ==> q`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`INTERS {u n | n IN (:num)} INTER t:real^N->bool`; `measure(INTERS {u n | n IN (:num)} DIFF t:real^N->bool)`] MEASURABLE_OUTER_OPEN) THEN ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS; MEASURABLE_INTER] THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[REAL_NOT_LT] THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNION o lhand o snd) THEN ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS; MEASURABLE_INTER; MEASURABLE_DIFF; SET_RULE `DISJOINT (s INTER t) (s DIFF t)`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `(s INTER t) UNION (s DIFF t) = s`] THEN TRANS_TAC REAL_LE_TRANS `b:real` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x - y <= &0`] THEN ONCE_REWRITE_TAC[REAL_LE_TRANS_LTE] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [REAL_ARITH_TAC; X_GEN_TAC `n:num`] THEN REWRITE_TAC[REAL_ARITH `x - y <= z <=> x <= y + z`] THEN TRANS_TAC REAL_LE_TRANS `measure((u:num->real^N->bool) n)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS] THEN SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Transformation of measure by linear maps. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_LINEAR_IMAGE_INTERVAL = prove (`!f a b. linear f ==> measurable(IMAGE f (interval[a,b]))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_MESON_TAC[CONVEX_INTERVAL]; MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_MESON_TAC[BOUNDED_INTERVAL]]);; let HAS_MEASURE_LINEAR_SUFFICIENT = prove (`!f:real^N->real^N m. linear f /\ (!a b. IMAGE f (interval[a,b]) has_measure (m * measure(interval[a,b]))) ==> !s. measurable s ==> (IMAGE f s) has_measure (m * measure s)`, REPEAT GEN_TAC THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `m < &0 \/ &0 <= m`) THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_POS_LE) THEN MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN MATCH_MP_TAC(REAL_ARITH `&0 < --m * x ==> ~(&0 <= m * x)`) THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_NEG_GT0] THEN REWRITE_TAC[MEASURE_INTERVAL] THEN MATCH_MP_TAC CONTENT_POS_LT THEN SIMP_TAC[VEC_COMPONENT; REAL_LT_01]; ALL_TAC] THEN ASM_CASES_TAC `!x y. (f:real^N->real^N) x = f y ==> x = y` THENL [ALL_TAC; SUBGOAL_THEN `!s. negligible(IMAGE (f:real^N->real^N) s)` ASSUME_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `m * measure(interval[vec 0:real^N,vec 1]) = &0` MP_TAC THENL [MATCH_MP_TAC(ISPEC `IMAGE (f:real^N->real^N) (interval[vec 0,vec 1])` HAS_MEASURE_UNIQUE) THEN ASM_REWRITE_TAC[HAS_MEASURE_0]; REWRITE_TAC[REAL_ENTIRE; MEASURE_INTERVAL] THEN MATCH_MP_TAC(TAUT `~b /\ (a ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL [SIMP_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL; INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01]; ASM_SIMP_TAC[REAL_MUL_LZERO; HAS_MEASURE_0]]]] THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_ISOMORPHISM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN UNDISCH_THEN `!x y. (f:real^N->real^N) x = f y ==> x = y` (K ALL_TAC) THEN SUBGOAL_THEN `!s. bounded s /\ measurable s ==> (IMAGE (f:real^N->real^N) s) has_measure (m * measure s)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN SUBGOAL_THEN `!d. COUNTABLE d /\ (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\ (?c d. k = interval[c,d])) /\ (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) ==> interior k1 INTER interior k2 = {}) ==> IMAGE (f:real^N->real^N) (UNIONS d) has_measure (m * measure(UNIONS d))` ASSUME_TAC THENL [REWRITE_TAC[IMAGE_UNIONS] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!g:real^N->real^N. linear g ==> !k l. k IN d /\ l IN d /\ ~(k = l) ==> negligible((IMAGE g k) INTER (IMAGE g l))` MP_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `!x y. (g:real^N->real^N) x = g y ==> x = y` THENL [ALL_TAC; ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE; NEGLIGIBLE_INTER]] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `frontier(IMAGE (g:real^N->real^N) k INTER IMAGE g l) UNION interior(IMAGE g k INTER IMAGE g l)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s SUBSET (t DIFF u) UNION u`) THEN REWRITE_TAC[CLOSURE_SUBSET]] THEN MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THEN MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_MESON_TAC[CONVEX_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[INTERIOR_INTER] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^N->real^N) (interior k) INTER IMAGE g (interior l)` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^N->real^N) (interior k INTER interior l)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]; ASM SET_TAC[]]; MATCH_MP_TAC(SET_RULE `s SUBSET u /\ t SUBSET v ==> (s INTER t) SUBSET (u INTER v)`) THEN CONJ_TAC THEN MATCH_MP_TAC INTERIOR_IMAGE_SUBSET THEN ASM_MESON_TAC[LINEAR_CONTINUOUS_AT]]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `f:real^N->real^N` th) THEN MP_TAC(SPEC `\x:real^N. x` th)) THEN ASM_REWRITE_TAC[LINEAR_ID; SET_RULE `IMAGE (\x. x) s = s`] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL [MP_TAC(ISPECL [`IMAGE (f:real^N->real^N)`; `d:(real^N->bool)->bool`] HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum d (\k:real^N->bool. m * measure k)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS THEN ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN ASM_REWRITE_TAC[INFINITE] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool` (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN MP_TAC(ISPEC `s:num->real^N->bool` HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN MP_TAC(ISPEC `\n:num. IMAGE (f:real^N->real^N) (s n)` HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_INTERVAL]; ASM_MESON_TAC[]; ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM IMAGE_UNIONS; IMAGE_o] THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN EXISTS_TAC `interval[a:real^N,b]` THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]]; ALL_TAC] THEN STRIP_TAC THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ASM_MESON_TAC[]; MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN EXISTS_TAC `interval[a:real^N,b]` THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN SUBGOAL_THEN `m * measure (UNIONS (IMAGE s (:num)):real^N->bool) = measure(UNIONS (IMAGE (\x. IMAGE f (s x)) (:num)):real^N->bool)` (fun th -> ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE; th]) THEN ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC `\n:num. lift(measure(IMAGE (f:real^N->real^N) (s n)))` THEN EXISTS_TAC `from 0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n:num. m % lift(measure(s n:real^N->bool))` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_EQ] THEN ASM_MESON_TAC[MEASURE_UNIQUE]; REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[HAS_MEASURE_INNER_OUTER_LE] THEN CONJ_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [MP_TAC(ISPECL [`interval[a,b] DIFF s:real^N->bool`; `a:real^N`; `b:real^N`; `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN ANTS_TAC THENL [ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < &1 + abs x`; REAL_LT_DIV] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE f (interval[a,b]) DIFF IMAGE (f:real^N->real^N) (UNIONS d)` THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_DIFF; measurable]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(IMAGE f (interval[a,b])) - measure(IMAGE (f:real^N->real^N) (UNIONS d))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC]) THEN MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[UNIONS_SUBSET]] THEN UNDISCH_TAC `!a b. IMAGE (f:real^N->real^N) (interval [a,b]) has_measure m * measure (interval [a,b])` THEN DISCH_THEN(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE)) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `m * measure(s:real^N->bool) - m * e / (&1 + abs m)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d <= a + e ==> a = i - s ==> s - e <= i - d`)) THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM_REWRITE_TAC[MEASURABLE_INTERVAL]; MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`; `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (f:real^N->real^N) (UNIONS d)` THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `m * measure(s:real^N->bool) + m * e / (&1 + abs m)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_LMUL]; REWRITE_TAC[REAL_LE_LADD] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC]]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_MEASURE_LIMIT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN DISCH_THEN(MP_TAC o SPEC `e / (&1 + abs m)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN REMOVE_THEN "*" MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`interval[c:real^N,d]`; `vec 0:real^N`] BOUNDED_SUBSET_BALL) THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_BOUNDED_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `D * C:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s INTER (IMAGE (h:real^N->real^N) (interval[a,b]))`) THEN SUBGOAL_THEN `IMAGE (f:real^N->real^N) (s INTER IMAGE h (interval [a,b])) = (IMAGE f s) INTER interval[a,b]` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL]; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `m * measure(s INTER (IMAGE (h:real^N->real^N) (interval[a,b])))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `m * e / (&1 + abs m)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN REAL_ARITH_TAC] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [real_abs] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(z - m) < e ==> z <= w /\ w <= m ==> abs(w - m) <= e`)) THEN SUBST1_TAC(SYM(MATCH_MP MEASURE_UNIQUE (ASSUME `s INTER interval [c:real^N,d] has_measure z`))) THEN CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL; MEASURABLE_INTERVAL; INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `!v. t SUBSET v /\ v SUBSET u ==> s INTER t SUBSET s INTER u`) THEN EXISTS_TAC `ball(vec 0:real^N,D)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `!f. (!x. h(f x) = x) /\ IMAGE f s SUBSET t ==> s SUBSET IMAGE h t`) THEN EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(vec 0:real^N,D * C)` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `C * norm(x:real^N)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ]);; let INDUCT_MATRIX_ROW_OPERATIONS = prove (`!P:real^N^N->bool. (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\ (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> A$i$j = &0) ==> P A) /\ (!A m n. P A /\ 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(lambda i j. A$i$(swap(m,n) j))) /\ (!A m n c. P A /\ 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(lambda i. if i = m then row m A + c % row n A else row i A)) ==> !A. P A`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "zero_row") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "diagonal") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "swap_cols") (LABEL_TAC "row_op")) THEN SUBGOAL_THEN `!k A:real^N^N. (!i j. 1 <= i /\ i <= dimindex(:N) /\ k <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> A$i$j = &0) ==> P A` (fun th -> GEN_TAC THEN MATCH_MP_TAC th THEN EXISTS_TAC `dimindex(:N) + 1` THEN ARITH_TAC) THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN USE_THEN "diagonal" MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LE_0]; ALL_TAC] THEN X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "ind_hyp") THEN DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC (ARITH_RULE `k = 0 \/ 1 <= k`) THEN ASM_REWRITE_TAC[ARITH] THEN ASM_CASES_TAC `k <= dimindex(:N)` THENL [ALL_TAC; REPEAT STRIP_TAC THEN REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN SUBGOAL_THEN `!A:real^N^N. ~(A$k$k = &0) /\ (!i j. 1 <= i /\ i <= dimindex (:N) /\ SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j) ==> A$i$j = &0) ==> P A` (LABEL_TAC "nonzero_hyp") THENL [ALL_TAC; X_GEN_TAC `A:real^N^N` THEN DISCH_TAC THEN ASM_CASES_TAC `row k (A:real^N^N) = vec 0` THENL [REMOVE_THEN "zero_row" MATCH_MP_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN SIMP_TAC[VEC_COMPONENT; row; LAMBDA_BETA] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN ASM_CASES_TAC `l:num = k` THENL [REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN REMOVE_THEN "swap_cols" (MP_TAC o SPECL [`(lambda i j. (A:real^N^N)$i$swap(k,l) j):real^N^N`; `k:num`; `l:num`]) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])] THEN REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= i <=> 1 <= i /\ SUC k <= i`] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[swap] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `l:num <= k` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC] THEN SUBGOAL_THEN `!l A:real^N^N. ~(A$k$k = &0) /\ (!i j. 1 <= i /\ i <= dimindex (:N) /\ SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j) ==> A$i$j = &0) /\ (!i. l <= i /\ i <= dimindex(:N) /\ ~(i = k) ==> A$i$k = &0) ==> P A` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `~(n + 1 <= i /\ i <= n)`]] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN USE_THEN "ind_hyp" MATCH_MP_TAC THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `j:num = k` THENL [ASM_REWRITE_TAC[] THEN USE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC; REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN X_GEN_TAC `l:num` THEN DISCH_THEN(LABEL_TAC "inner_hyp") THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN ASM_CASES_TAC `l:num = k` THENL [REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN DISJ_CASES_TAC(ARITH_RULE `l = 0 \/ 1 <= l`) THENL [REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `j:num = k` THENL [ASM_REWRITE_TAC[] THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC; REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN ASM_CASES_TAC `l <= dimindex(:N)` THENL [ALL_TAC; REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC] THEN REMOVE_THEN "inner_hyp" (MP_TAC o SPECL [`(lambda i. if i = l then row l (A:real^N^N) + --(A$l$k/A$k$k) % row k A else row i A):real^N^N`]) THEN ANTS_TAC THENL [SUBGOAL_THEN `!i. l <= i ==> 1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= j <=> 1 <= j /\ SUC k <= j`] THEN ASM_SIMP_TAC[LAMBDA_BETA; row; COND_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> x + --(x / y) * y = &0`] THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num = l` THEN ASM_REWRITE_TAC[] THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_RING `x = &0 /\ y = &0 ==> x + z * y = &0`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN DISCH_TAC THEN REMOVE_THEN "row_op" (MP_TAC o SPECL [`(lambda i. if i = l then row l A + --(A$l$k / A$k$k) % row k A else row i (A:real^N^N)):real^N^N`; `l:num`; `k:num`; `(A:real^N^N)$l$k / A$k$k`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; row; COND_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let INDUCT_MATRIX_ELEMENTARY = prove (`!P:real^N^N->bool. (!A B. P A /\ P B ==> P(A ** B)) /\ (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\ (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> A$i$j = &0) ==> P A) /\ (!m n. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\ (!m n c. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(lambda i j. if i = m /\ j = n then c else if i = j then &1 else &0)) ==> !A. P A`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MATCH_MP_TAC INDUCT_MATRIX_ROW_OPERATIONS THEN MP_TAC th) THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN DISCH_THEN(fun th -> X_GEN_TAC `A:real^N^N` THEN MP_TAC th) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(P:real^N^N->bool) A` THENL [REWRITE_TAC[GSYM IMP_CONJ]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul; row] THENL [ASM_SIMP_TAC[mat; IN_DIMINDEX_SWAP; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; REAL_MUL_RID] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[swap; IN_NUMSEG]) THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[REAL_MUL_LZERO] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_SIMP_TAC[SUM_DELTA; LAMBDA_BETA; IN_NUMSEG; REAL_MUL_LID]] THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {m,n} (\k. (if k = n then c else if m = k then &1 else &0) * (A:real^N^N)$k$j)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUPERSET THEN ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; IN_NUMSEG; REAL_MUL_LZERO] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC]);; let INDUCT_MATRIX_ELEMENTARY_ALT = prove (`!P:real^N^N->bool. (!A B. P A /\ P B ==> P(A ** B)) /\ (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\ (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> A$i$j = &0) ==> P A) /\ (!m n. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\ (!m n. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(lambda i j. if i = m /\ j = n \/ i = j then &1 else &0)) ==> !A. P A`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC INDUCT_MATRIX_ELEMENTARY THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `c = &0` THENL [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN ASM_SIMP_TAC[LAMBDA_BETA; COND_ID]; ALL_TAC] THEN SUBGOAL_THEN `(lambda i j. if i = m /\ j = n then c else if i = j then &1 else &0) = ((lambda i j. if i = j then if j = n then inv c else &1 else &0):real^N^N) ** ((lambda i j. if i = m /\ j = n \/ i = j then &1 else &0):real^N^N) ** ((lambda i j. if i = j then if j = n then c else &1 else &0):real^N^N)` SUBST1_TAC THENL [ALL_TAC; REPEAT(MATCH_MP_TAC(ASSUME `!A B:real^N^N. P A /\ P B ==> P(A ** B)`) THEN CONJ_TAC) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN ASM_SIMP_TAC[LAMBDA_BETA]] THEN SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_ARITH `(if p then &1 else &0) * (if q then c else &0) = if q then if p then c else &0 else &0`] THEN REWRITE_TAC[REAL_ARITH `(if p then x else &0) * y = (if p then x * y else &0)`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `j:num = n` THEN ASM_REWRITE_TAC[REAL_MUL_LID; EQ_SYM_EQ] THEN ASM_CASES_TAC `i:num = n` THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID; REAL_MUL_RZERO]);; let INDUCT_LINEAR_ELEMENTARY = prove (`!P. (!f g. linear f /\ linear g /\ P f /\ P g ==> P(f o g)) /\ (!f i. linear f /\ 1 <= i /\ i <= dimindex(:N) /\ (!x. (f x)$i = &0) ==> P f) /\ (!c. P(\x. lambda i. c i * x$i)) /\ (!m n. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(\x. lambda i. x$swap(m,n) i)) /\ (!m n. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> P(\x. lambda i. if i = m then x$m + x$n else x$i)) ==> !f:real^N->real^N. linear f ==> P f`, GEN_TAC THEN MP_TAC(ISPEC `\A:real^N^N. P(\x:real^N. A ** x):bool` INDUCT_MATRIX_ELEMENTARY_ALT) THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [ALL_TAC; DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `matrix(f:real^N->real^N)`) THEN ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX]] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `B:real^N^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\x:real^N. (A:real^N^N) ** x`; `\x:real^N. (B:real^N^N) ** x`]) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `m:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\x:real^N. (A:real^N^N) ** x`; `m:num`]) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `row m (A:real^N^N) = vec 0` THEN ASM_SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT; matrix_vector_mul; REAL_MUL_LZERO; SUM_0]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `A:real^N^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\i. (A:real^N^N)$i$i`) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\j. if j = i then (A:real^N^N)$i$j * (x:real^N)$j else &0)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA; mat; IN_DIMINDEX_SWAP] THENL [ONCE_REWRITE_TAC[SWAP_GALOIS] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_LID; REAL_MUL_LZERO; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_MUL_LID; IN_NUMSEG] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {m,n} (\j. if n = j \/ j = m then (x:real^N)$j else &0)` THEN CONJ_TAC THENL [SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[REAL_ADD_RID]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; IN_NUMSEG; REAL_MUL_LZERO] THEN ASM_ARITH_TAC]]);; let LAMBDA_SWAP_GALOIS = prove (`!x:real^N y:real^N. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) ==> (x = (lambda i. y$swap(m,n) i) <=> (lambda i. x$swap(m,n) i) = y)`, SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]);; let LAMBDA_ADD_GALOIS = prove (`!x:real^N y:real^N. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) ==> (x = (lambda i. if i = m then y$m + y$n else y$i) <=> (lambda i. if i = m then x$m - x$n else x$i) = y)`, SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let HAS_MEASURE_SHEAR_INTERVAL = prove (`!a b:real^N m n. 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) /\ ~(interval[a,b] = {}) /\ &0 <= a$n ==> (IMAGE (\x. (lambda i. if i = m then x$m + x$n else x$i)) (interval[a,b]):real^N->bool) has_measure measure (interval [a,b])`, let lemma = prove (`!s t u v:real^N->bool. measurable s /\ measurable t /\ measurable u /\ negligible(s INTER t) /\ negligible(s INTER u) /\ negligible(t INTER u) /\ s UNION t UNION u = v ==> v has_measure (measure s) + (measure t) + (measure u)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_UNION] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_UNION] THEN ASM_SIMP_TAC[MEASURE_EQ_0; UNION_OVER_INTER; MEASURE_UNION; MEASURABLE_UNION; NEGLIGIBLE_INTER; MEASURABLE_INTER] THEN REAL_ARITH_TAC) and lemma' = prove (`!s t u a:real^N. measurable s /\ measurable t /\ s UNION (IMAGE (\x. a + x) t) = u /\ negligible(s INTER (IMAGE (\x. a + x) t)) ==> measure s + measure t = measure u`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[MEASURE_NEGLIGIBLE_UNION; MEASURABLE_TRANSLATION_EQ; MEASURE_TRANSLATION]) in REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `linear((\x. lambda i. if i = m then x$m + x$n else x$i):real^N->real^N)` ASSUME_TAC THENL [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i) (interval[a:real^N,b]):real^N->bool`; `interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER {x:real^N | (basis m - basis n) dot x <= a$m}`; `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`; `interval[a:real^N, (lambda i. if i = m then (b:real^N)$m + b$n else b$i)]`] lemma) THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL; CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE; CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN REWRITE_TAC[INTER] THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN ASM_SIMP_TAC[LAMBDA_ADD_GALOIS; UNWIND_THM1] THEN ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; DOT_LSUB] THEN ONCE_REWRITE_TAC[MESON[] `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[TAUT `(p /\ x) /\ (q /\ x) /\ r <=> x /\ p /\ q /\ r`; TAUT `(p /\ x) /\ q /\ (r /\ x) <=> x /\ p /\ q /\ r`; TAUT `((p /\ x) /\ q) /\ (r /\ x) /\ s <=> x /\ p /\ q /\ r /\ s`; TAUT `(a /\ x \/ (b /\ x) /\ c \/ (d /\ x) /\ e <=> f /\ x) <=> x ==> (a \/ b /\ c \/ d /\ e <=> f)`] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THENL [EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`; EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`; EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`] THEN (CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_MESON_TAC[BASIS_INJ]; ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM; NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]); ALL_TAC] THEN ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_LINEAR_IMAGE_INTERVAL; MEASURABLE_INTERVAL] THEN MP_TAC(ISPECL [`interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER {x:real^N | (basis m - basis n) dot x <= a$m}`; `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`; `interval[a:real^N, (lambda i. if i = m then (a:real^N)$m + b$n else (b:real^N)$i)]`; `(lambda i. if i = m then (a:real^N)$m - (b:real^N)$m else &0):real^N`] lemma') THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL; CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE; CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN REWRITE_TAC[INTER] THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = (lambda i. p i) + y <=> x - (lambda i. p i) = y`] THEN ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; DOT_LSUB; UNWIND_THM1; VECTOR_SUB_COMPONENT] THEN ONCE_REWRITE_TAC[MESON[] `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN ASM_SIMP_TAC[REAL_SUB_RZERO] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `!i. ~(i = m) ==> 1 <= i /\ i <= dimindex (:N) ==> (a:real^N)$i <= (x:real^N)$i /\ x$i <= (b:real^N)$i` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[TAUT `((a /\ b) /\ c) /\ (d /\ e) /\ f <=> (b /\ e) /\ a /\ c /\ d /\ f`] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_MESON_TAC[BASIS_INJ]; ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM; NOT_IN_EMPTY] THEN FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `a:real = b + c ==> a = x + b ==> x = c`) THEN ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES; LAMBDA_BETA] THEN REPEAT(COND_CASES_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) THEN SUBGOAL_THEN `1..dimindex(:N) = m INSERT ((1..dimindex(:N)) DELETE m)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG] THEN ASM_SIMP_TAC[IN_DELETE] THEN MATCH_MP_TAC(REAL_RING `s1:real = s3 /\ s2 = s3 ==> ((bm + bn) - am) * s1 = ((am + bn) - am) * s2 + (bm - am) * s3`) THEN CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE] THEN REAL_ARITH_TAC);; let HAS_MEASURE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ measurable s ==> (IMAGE f s) has_measure (abs(det(matrix f)) * measure s)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC INDUCT_LINEAR_ELEMENTARY THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `IMAGE (g:real^N->real^N) s`) (MP_TAC o SPEC `s:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_COMPOSE; DET_MUL; REAL_ABS_MUL] THEN REWRITE_TAC[IMAGE_o; GSYM REAL_MUL_ASSOC]; MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `m:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `~(!x y. (f:real^N->real^N) x = f y ==> x = y)` ASSUME_TAC THENL [ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN EXISTS_TAC `basis m:real^N` THEN ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS]; ALL_TAC] THEN MP_TAC(ISPEC `matrix f:real^N^N` INVERTIBLE_DET_NZ) THEN ASM_SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE_INJECTIVE; MATRIX_WORKS; REAL_ABS_NUM; REAL_MUL_LZERO] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[HAS_MEASURE_0] THEN ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; MAP_EVERY X_GEN_TAC [`c:num->real`; `s:real^N->bool`] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[HAS_MEASURE_MEASURE]) THEN FIRST_ASSUM(MP_TAC o SPEC `c:num->real` o MATCH_MP HAS_MEASURE_STRETCH) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[matrix; LAMBDA_BETA] THEN W(MP_TAC o PART_MATCH (lhs o rand) DET_DIAGONAL o rand o snd) THEN REWRITE_TAC[diagonal_matrix] THEN SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; REAL_MUL_RZERO] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN REWRITE_TAC[REAL_MUL_RID]; MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN ASM_SIMP_TAC[linear; LAMBDA_BETA; IN_DIMINDEX_SWAP; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; CART_EQ] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN SUBGOAL_THEN `matrix (\x:real^N. lambda i. x$swap (m,n) i):real^N^N = transp(lambda i j. (mat 1:real^N^N)$i$swap (m,n) j)` SUBST1_TAC THENL [ASM_SIMP_TAC[MATRIX_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP; matrix_vector_mul; CART_EQ; matrix; mat; basis; COND_COMPONENT; transp] THEN REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN REWRITE_TAC[DET_TRANSP] THEN W(MP_TAC o PART_MATCH (lhs o rand) DET_PERMUTE_COLUMNS o rand o lhand o rand o snd) THEN ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; ETA_AX] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[DET_I; REAL_ABS_SIGN; REAL_MUL_RID; REAL_MUL_LID] THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `~(IMAGE (\x:real^N. lambda i. x$swap (m,n) i) (interval[a,b]):real^N->bool = {})` MP_TAC THENL [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (\x:real^N. lambda i. x$swap (m,n) i) (interval[a,b]):real^N->bool = interval[(lambda i. a$swap (m,n) i), (lambda i. b$swap (m,n) i)]` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_IMAGE] THEN ASM_SIMP_TAC[LAMBDA_SWAP_GALOIS; UNWIND_THM1] THEN SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]; ALL_TAC] THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_INTERVAL] THEN REWRITE_TAC[MEASURE_INTERVAL] THEN ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM INTERVAL_NE_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; IN_DIMINDEX_SWAP] THEN MP_TAC(ISPECL [`\i. (b - a:real^N)$i`; `swap(m:num,n)`; `1..dimindex(:N)`] (GSYM PRODUCT_PERMUTE)) THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG]; MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC; DISCH_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN SUBGOAL_THEN `det(matrix(\x. lambda i. if i = m then (x:real^N)$m + x$n else x$i):real^N^N) = &1` SUBST1_TAC THENL [ASM_SIMP_TAC[matrix; basis; COND_COMPONENT; LAMBDA_BETA] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(m:num = n) ==> m < n \/ n < m`)) THENL [W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhs o snd); W(MP_TAC o PART_MATCH (lhs o rand) DET_LOWERTRIANGULAR o lhs o snd)] THEN ASM_SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT; matrix; REAL_ADD_RID; COND_ID; PRODUCT_CONST_NUMSEG; REAL_POW_ONE] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i) (interval [a,b]) = IMAGE (\x:real^N. (lambda i. if i = m \/ i = n then a$n else &0) + x) (IMAGE (\x:real^N. lambda i. if i = m then x$m + x$n else x$i) (IMAGE (\x. (lambda i. if i = n then --(a$n) else &0) + x) (interval[a,b])))` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[FUN_EQ_THM; o_THM; VECTOR_ADD_COMPONENT; LAMBDA_BETA; CART_EQ] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i:num = n` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC HAS_MEASURE_TRANSLATION THEN SUBGOAL_THEN `measure(interval[a,b]) = measure(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x) (interval[a,b]):real^N->bool)` SUBST1_TAC THENL [REWRITE_TAC[MEASURE_TRANSLATION]; ALL_TAC] THEN SUBGOAL_THEN `~(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x) (interval[a,b]):real^N->bool = {})` MP_TAC THENL [ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `c + x:real^N = &1 % x + c`] THEN ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_MEASURE_SHEAR_INTERVAL THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC]);; let MEASURABLE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ measurable s ==> measurable(IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);; let MEASURE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ measurable s ==> measure(IMAGE f s) = abs(det(matrix f)) * measure s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);; let HAS_MEASURE_LINEAR_IMAGE_ALT = prove (`!f:real^N->real^N s m. linear f /\ s has_measure m ==> (IMAGE f s) has_measure (abs(det(matrix f)) * m)`, MESON_TAC[MEASURE_UNIQUE; measurable; HAS_MEASURE_LINEAR_IMAGE]);; let HAS_MEASURE_LINEAR_IMAGE_SAME = prove (`!f s. linear f /\ measurable s /\ abs(det(matrix f)) = &1 ==> (IMAGE f s) has_measure (measure s)`, MESON_TAC[HAS_MEASURE_LINEAR_IMAGE; REAL_MUL_LID]);; let MEASURE_LINEAR_IMAGE_SAME = prove (`!f:real^N->real^N s. linear f /\ measurable s /\ abs(det(matrix f)) = &1 ==> measure(IMAGE f s) = measure s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_SAME) THEN SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);; let MEASURABLE_LINEAR_IMAGE_EQ = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (measurable (IMAGE f s) <=> measurable s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE MEASURABLE_LINEAR_IMAGE));; add_linear_invariants [MEASURABLE_LINEAR_IMAGE_EQ];; let NEGLIGIBLE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ negligible s ==> negligible(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN REWRITE_TAC[REAL_MUL_RZERO]);; let NEGLIGIBLE_LINEAR_IMAGE_EQ = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (negligible (IMAGE f s) <=> negligible s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE NEGLIGIBLE_LINEAR_IMAGE));; add_linear_invariants [NEGLIGIBLE_LINEAR_IMAGE_EQ];; let HAS_MEASURE_ORTHOGONAL_IMAGE = prove (`!f:real^N->real^N s m. orthogonal_transformation f /\ s has_measure m ==> (IMAGE f s) has_measure m`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(REAL_RING `x = &1 ==> x * m = m`) THEN REWRITE_TAC[REAL_ARITH `abs x = &1 <=> x = &1 \/ x = -- &1`] THEN MATCH_MP_TAC DET_ORTHOGONAL_MATRIX THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]);; let HAS_MEASURE_ORTHOGONAL_IMAGE_EQ = prove (`!f:real^N->real^N s m. orthogonal_transformation f ==> ((IMAGE f s) has_measure m <=> s has_measure m)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[HAS_MEASURE_ORTHOGONAL_IMAGE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_ORTHOGONAL_IMAGE) THEN ASM_SIMP_TAC[GSYM IMAGE_o; IMAGE_I]);; add_linear_invariants [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] HAS_MEASURE_ORTHOGONAL_IMAGE_EQ];; let MEASURE_ORTHOGONAL_IMAGE_EQ = prove (`!f:real^N->real^N s. orthogonal_transformation f ==> measure(IMAGE f s) = measure s`, SIMP_TAC[measure; HAS_MEASURE_ORTHOGONAL_IMAGE_EQ]);; add_linear_invariants [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] MEASURE_ORTHOGONAL_IMAGE_EQ];; let HAS_MEASURE_ISOMETRY = prove (`!f:real^M->real^N s m. dimindex(:M) = dimindex(:N) /\ linear f /\ (!x. norm(f x) = norm x) ==> (IMAGE f s has_measure m <=> s has_measure m)`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `IMAGE ((\x. lambda i. x$i):real^N->real^M) (IMAGE (f:real^M->real^N) s) has_measure m` THEN CONJ_TAC THENL [SPEC_TAC(`IMAGE (f:real^M->real^N) s`,`s:real^N->bool`) THEN GEN_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[has_measure] THEN W(MP_TAC o PART_MATCH (lhand o rand) HAS_INTEGRAL_TWIZZLE_EQ o lhand o snd) THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM I_DEF; PERMUTES_I]; REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC HAS_MEASURE_ORTHOGONAL_IMAGE_EQ THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; o_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_COMPOSE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; X_GEN_TAC `x:real^M` THEN TRANS_TAC EQ_TRANS `norm((f:real^M->real^N) x)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN SIMP_TAC[NORM_EQ; dot; LAMBDA_BETA] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[LAMBDA_BETA]]]);; let MEASURABLE_LINEAR_IMAGE_EQ_GEN = prove (`!f:real^M->real^N s. dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y) ==> (measurable(IMAGE f s) <=> measurable s)`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `measurable(IMAGE ((\x. lambda i. x$i):real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN REWRITE_TAC[measurable] THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_MEASURE_ISOMETRY THEN ONCE_ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; SIMP_TAC[NORM_EQ; dot; LAMBDA_BETA] THEN ASM_MESON_TAC[]]; REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC MEASURABLE_LINEAR_IMAGE_EQ THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_COMPOSE THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; SIMP_TAC[CART_EQ; LAMBDA_BETA; o_DEF] THEN ASM_MESON_TAC[CART_EQ]]]);; let MEASURE_ISOMETRY = prove (`!f:real^M->real^N s. dimindex(:M) = dimindex(:N) /\ linear f /\ (!x. norm(f x) = norm x) ==> measure (IMAGE f s) = measure s`, REPEAT GEN_TAC THEN REWRITE_TAC[measure] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP HAS_MEASURE_ISOMETRY th]));; let MEASURABLE_CONVEX_EQ = prove (`!s:real^N->bool. convex s ==> (measurable s <=> bounded s \/ interior s = {})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interior s:real^N->bool = {}` THENL [ASM_MESON_TAC[NEGLIGIBLE_CONVEX_INTERIOR; NEGLIGIBLE_IMP_MEASURABLE]; EQ_TAC THEN ASM_SIMP_TAC[MEASURABLE_CONVEX]] THEN DISCH_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; RELATIVE_INTERIOR_NONEMPTY_INTERIOR] THEN DISCH_THEN(X_CHOOSE_THEN `l:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REPEAT(POP_ASSUM MP_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `l:real^N` THEN X_GEN_TAC `l:real` THEN ASM_CASES_TAC `l = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN MP_TAC(ISPEC `interior s:real^N->bool` OPEN_CONTAINS_INTERVAL) THEN REWRITE_TAC[OPEN_INTERIOR] THEN DISCH_THEN(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN GEN_GEOM_ORIGIN_TAC `u:real^N` ["l"] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!t. &0 <= t ==> measure(interval[vec 0:real^N, (lambda i. if i = 1 then t else (v:real^N)$i)]) <= measure(s:real^N->bool)` MP_TAC THENL [X_GEN_TAC `t:real` THEN STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[MEASURABLE_INTERVAL] THEN TRANS_TAC SUBSET_TRANS `interior(s:real^N->bool)` THEN REWRITE_TAC[INTERIOR_SUBSET] THEN SIMP_TAC[SUBSET; IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(lambda i. if i = 1 then &0 else (x:real^N)$i):real^N`; `(x:real^N)$1 / l:real`]) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; DIMINDEX_GE_1; LE_REFL] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[VEC_COMPONENT] THEN REAL_ARITH_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; REAL_FIELD `&0 < l ==> x / l * l * y = x * y`] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o SPEC `v$1 * (measure(s:real^N->bool) + &1) / measure(interval[vec 0:real^N,v])`) THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> &0 < (v:real^N)$i` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[VEC_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT] THEN REWRITE_TAC[MESON[] `(&0 <= if p then x else y) <=> if p then &0 <= x else &0 <= y`] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [REAL_LE_DIV; REAL_LE_ADD; REAL_POS; MEASURE_POS_LE; REAL_LE_MUL; REAL_LE_MUL; MEASURABLE_INTERVAL; DIMINDEX_GE_1; LE_REFL; LAMBDA_BETA; VEC_COMPONENT; REAL_LT_IMP_LE; PRODUCT_POS_LE_NUMSEG; REAL_SUB_RZERO] THEN SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1; COND_ID] THEN SIMP_TAC[ARITH; ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN MATCH_MP_TAC(REAL_ARITH `x = y + &1 ==> ~(x <= y)`) THEN MATCH_MP_TAC(REAL_FIELD `&0 < v /\ &0 < p ==> (v * m / (v * p)) * p = m`) THEN ASM_SIMP_TAC[DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Measure of a standard simplex. *) (* ------------------------------------------------------------------------- *) let CONGRUENT_IMAGE_STD_SIMPLEX = prove (`!p. p permutes 1..dimindex(:N) ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\ (!i. 1 <= i /\ i < dimindex(:N) ==> x$(p i) <= x$(p(i + 1)))} = IMAGE (\x:real^N. lambda i. sum(1..inverse p(i)) (\j. x$j)) {x | (!i. 1 <= i /\ i <= dimindex (:N) ==> &0 <= x$i) /\ sum (1..dimindex (:N)) (\i. x$i) <= &1}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL; ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`; ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN ASM_SIMP_TAC[SUM_SING_NUMSEG; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN ASM_SIMP_TAC[REAL_LE_ADDR] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN EXISTS_TAC `(lambda i. if i = 1 then x$(p 1) else (x:real^N)$p(i) - x$p(i - 1)):real^N` THEN ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL; ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`; ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1; CART_EQ] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `1 <= inverse (p:num->num) i /\ !x. x <= inverse p i ==> x <= dimindex(:N)` ASSUME_TAC THENL [ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE]; ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH]] THEN SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV) [GSYM REAL_MUL_LID] THEN ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `1 <= p ==> p = 1 \/ 2 <= p`) o CONJUNCT1) THEN ASM_SIMP_TAC[ARITH] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN REWRITE_TAC[REAL_ADD_RID] THEN TRY REAL_ARITH_TAC THEN ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE]; X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN ASM_SIMP_TAC[SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH; ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o BINDER_CONV) [GSYM REAL_MUL_LID] THEN ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ADD_RID] THEN ASM_REWRITE_TAC[REAL_ARITH `x + y - x:real = y`] THEN ASM_MESON_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n /\ ~(2 <= n) ==> n = 1`]]);; let HAS_MEASURE_IMAGE_STD_SIMPLEX = prove (`!p. p permutes 1..dimindex(:N) ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\ (!i. 1 <= i /\ i < dimindex(:N) ==> x$(p i) <= x$(p(i + 1)))} has_measure (measure (convex hull (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONGRUENT_IMAGE_STD_SIMPLEX] THEN ASM_SIMP_TAC[GSYM STD_SIMPLEX] THEN MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE_SAME THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[linear; CART_EQ] THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[]; MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `abs(det ((lambda i. ((lambda i j. if j <= i then &1 else &0):real^N^N) $inverse p i) :real^N^N))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN ASM_SIMP_TAC[matrix; LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT; LAMBDA_BETA_PERM; PERMUTES_INVERSE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (1..inverse (p:num->num) i) (\k. if k = j then &1 else &0)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_NUMSEG; PERMUTES_IN_IMAGE; basis] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LAMBDA_BETA THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; LE_TRANS; PERMUTES_INVERSE]; ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]]; ALL_TAC] THEN ASM_SIMP_TAC[PERMUTES_INVERSE; DET_PERMUTE_ROWS; ETA_AX] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SIGN; REAL_MUL_LID] THEN MATCH_MP_TAC(REAL_ARITH `x = &1 ==> abs x = &1`) THEN ASM_SIMP_TAC[DET_LOWERTRIANGULAR; GSYM NOT_LT; LAMBDA_BETA] THEN REWRITE_TAC[LT_REFL; PRODUCT_CONST_NUMSEG; REAL_POW_ONE]]);; let HAS_MEASURE_STD_SIMPLEX = prove (`(convex hull (vec 0:real^N INSERT {basis i | 1 <= i /\ i <= dimindex(:N)})) has_measure inv(&(FACT(dimindex(:N))))`, let lemma = prove (`!f:num->real. (!i. 1 <= i /\ i < n ==> f i <= f(i + 1)) <=> (!i j. 1 <= i /\ i <= j /\ j <= n ==> f i <= f j)`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[LE; REAL_LE_REFL] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) j` THEN ASM_SIMP_TAC[ARITH_RULE `SUC x <= y ==> x <= y`] THEN REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]) in MP_TAC(ISPECL [`\p. {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\ (!i. 1 <= i /\ i < dimindex(:N) ==> x$(p i) <= x$(p(i + 1)))}`; `{p | p permutes 1..dimindex(:N)}`] HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_IMAGE_STD_SIMPLEX; IN_ELIM_THM] THEN ASM_SIMP_TAC[SUM_CONST; FINITE_PERMUTATIONS; FINITE_NUMSEG; CARD_PERMUTATIONS; CARD_NUMSEG_1] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`p:num->num`; `q:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `?i. i IN 1..dimindex(:N) /\ ~(p i:num = q i)` MP_TAC THENL [ASM_MESON_TAC[permutes; FUN_EQ_THM]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[TAUT `a ==> ~(b /\ ~c) <=> a /\ b ==> c`] THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N | (basis(p(k:num)) - basis(q k)) dot x = &0}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN MATCH_MP_TAC BASIS_NE THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM; DOT_LSUB; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[DOT_BASIS; GSYM IN_NUMSEG; PERMUTES_IN_IMAGE] THEN SUBGOAL_THEN `?l. (q:num->num) l = p(k:num)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[permutes]; ALL_TAC] THEN SUBGOAL_THEN `1 <= l /\ l <= dimindex(:N)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN SUBGOAL_THEN `k:num < l` ASSUME_TAC THENL [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG]; ALL_TAC] THEN SUBGOAL_THEN `?m. (p:num->num) m = q(k:num)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[permutes]; ALL_TAC] THEN SUBGOAL_THEN `1 <= m /\ m <= dimindex(:N)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN SUBGOAL_THEN `k:num < m` ASSUME_TAC THENL [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[lemma] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN ASM_SIMP_TAC[LT_IMP_LE; IMP_IMP; REAL_LE_ANTISYM; REAL_SUB_0] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; DOT_BASIS]; ALL_TAC] THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> (x = inv y <=> y * x = &1)`; REAL_OF_NUM_EQ; FACT_NZ] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `measure(interval[vec 0:real^N,vec 1])` THEN CONJ_TAC THENL [AP_TERM_TAC; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_UNIT]] THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN SIMP_TAC[IMP_IMP; IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `(x:real^N)$(p 1)`; EXISTS_TAC `(x:real^N)$(p(dimindex(:N)))`] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `i:num` o MATCH_MP PERMUTES_SURJECTIVE) THEN ASM_MESON_TAC[LE_REFL; PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIONS(IMAGE f t) <=> !x. x IN s ==> ?y. y IN t /\ x IN f y`] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; IN_ELIM_THM] THEN SIMP_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN MP_TAC(ISPEC `\i j. ~((x:real^N)$j <= x$i)` TOPOLOGICAL_SORT) THEN REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)`; `1..dimindex(:N)`]) THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->num` (CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) ASSUME_TAC)) THEN EXISTS_TAC `\i. if i IN 1..dimindex(:N) then f(i) else i` THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= j /\ j <= n <=> 1 <= i /\ 1 <= j /\ i <= n /\ j <= n /\ i <= j`] THEN ASM_SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL; DIMINDEX_GE_1; LE_LT; REAL_LE_LT]] THEN SIMP_TAC[PERMUTES_FINITE_SURJECTIVE; FINITE_NUMSEG] THEN SIMP_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence the measure of a general simplex. *) (* ------------------------------------------------------------------------- *) let HAS_MEASURE_SIMPLEX_0 = prove (`!l:(real^N)list. LENGTH l = dimindex(:N) ==> (convex hull (vec 0 INSERT set_of_list l)) has_measure abs(det(vector l)) / &(FACT(dimindex(:N)))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `vec 0 INSERT (set_of_list l) = IMAGE (\x:real^N. transp(vector l:real^N^N) ** x) (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})` SUBST1_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO] THEN AP_TERM_TAC THEN SIMP_TAC[matrix_vector_mul; vector; transp; LAMBDA_BETA; basis] THEN ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(b /\ c ==> ~a)`] THEN X_GEN_TAC `y:real^N` THEN SIMP_TAC[LAMBDA_BETA; REAL_MUL_RID] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[NOT_IMP; REAL_MUL_RID; GSYM CART_EQ] THEN ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `SUC i`; EXISTS_TAC `i - 1`] THEN ASM_REWRITE_TAC[SUC_SUB1] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN SUBGOAL_THEN `det(vector l:real^N^N) = det(matrix(\x:real^N. transp(vector l) ** x))` SUBST1_TAC THENL [REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; DET_TRANSP]; ALL_TAC] THEN REWRITE_TAC[real_div] THEN ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_STD_SIMPLEX)] THEN MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]);; let HAS_MEASURE_SIMPLEX = prove (`!a l:(real^N)list. LENGTH l = dimindex(:N) ==> (convex hull (set_of_list(CONS a l))) has_measure abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `MAP (\x:real^N. x - a) l` HAS_MEASURE_SIMPLEX_0) THEN ASM_REWRITE_TAC[LENGTH_MAP; set_of_list] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP HAS_MEASURE_TRANSLATION) THEN REWRITE_TAC[GSYM CONVEX_HULL_TRANSLATION] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; SET_OF_LIST_MAP] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `a + x - a:real^N = x`; SET_RULE `IMAGE (\x. x) s = s`]);; let MEASURABLE_CONVEX_HULL = prove (`!s. bounded s ==> measurable(convex hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN ASM_SIMP_TAC[CONVEX_CONVEX_HULL; BOUNDED_CONVEX_HULL]);; let MEASURABLE_SIMPLEX = prove (`!l. measurable(convex hull (set_of_list l))`, GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_SET_OF_LIST]);; let MEASURE_SIMPLEX = prove (`!a l:(real^N)list. LENGTH l = dimindex(:N) ==> measure(convex hull (set_of_list(CONS a l))) = abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`, MESON_TAC[HAS_MEASURE_SIMPLEX; HAS_MEASURE_MEASURABLE_MEASURE]);; (* ------------------------------------------------------------------------- *) (* Area of a triangle. *) (* ------------------------------------------------------------------------- *) let HAS_MEASURE_TRIANGLE = prove (`!a b c:real^2. convex hull {a,b,c} has_measure abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real^2`; `[b;c]:(real^2)list`] HAS_MEASURE_SIMPLEX) THEN REWRITE_TAC[LENGTH; DIMINDEX_2; ARITH; set_of_list; MAP] THEN CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_2; VECTOR_2] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH]);; let MEASURABLE_TRIANGLE = prove (`!a b c:real^N. measurable(convex hull {a,b,c})`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; let MEASURE_TRIANGLE = prove (`!a b c:real^2. measure(convex hull {a,b,c}) = abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`, REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_TRIANGLE]);; (* ------------------------------------------------------------------------- *) (* Volume of a tetrahedron. *) (* ------------------------------------------------------------------------- *) let HAS_MEASURE_TETRAHEDRON = prove (`!a b c d:real^3. convex hull {a,b,c,d} has_measure abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) + (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) + (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) - (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) - (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) - (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / &6`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real^3`; `[b;c;d]:(real^3)list`] HAS_MEASURE_SIMPLEX) THEN REWRITE_TAC[LENGTH; DIMINDEX_3; ARITH; set_of_list; MAP] THEN CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_3; VECTOR_3] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH]);; let MEASURABLE_TETRAHEDRON = prove (`!a b c d:real^N. measurable(convex hull {a,b,c,d})`, REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; let MEASURE_TETRAHEDRON = prove (`!a b c d:real^3. measure(convex hull {a,b,c,d}) = abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) + (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) + (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) - (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) - (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) - (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / &6`, REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] HAS_MEASURE_TETRAHEDRON]);; (* ------------------------------------------------------------------------- *) (* Measure is continuous with Hausdorff distance: several formulations. *) (* ------------------------------------------------------------------------- *) let MEASURE_CONTINUOUS_WITH_HAUSDIST = prove (`!s:real^N->bool e. bounded s /\ convex s /\ ~(s = {}) /\ &0 < e ==> ?d. &0 < d /\ !t. bounded t /\ convex t /\ ~(t = {}) /\ hausdist(s,t) < d ==> abs(measure(t) - measure(s)) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`frontier s:real^N->bool`; `e:real`] MEASURABLE_OUTER_OPEN) THEN FIRST_ASSUM(MP_TAC o MATCH_MP NEGLIGIBLE_CONVEX_FRONTIER) THEN REWRITE_TAC[NEGLIGIBLE_EQ_MEASURE_0] THEN STRIP_TAC THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_LID] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `setdist(frontier s,(:real^N) DIFF u)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_FRONTIER_BOUNDED; GSYM OPEN_CLOSED; SETDIST_POS_LE; FRONTIER_EQ_EMPTY] THEN REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[NOT_BOUNDED_UNIV]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[NOT_MEASURABLE_UNIV]; ASM SET_TAC[]]; X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `u < e ==> a <= u ==> a < e`)) THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_SUB_LE_MEASURE_SYMDIFF o lhand o snd) THEN ASM_SIMP_TAC[MEASURABLE_CONVEX] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNION; MEASURABLE_DIFF; MEASURABLE_CONVEX] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `setdist(frontier s,(:real^N) DIFF u)`] CONVEX_SYMDIFF_CLOSE_TO_FRONTIER) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_BALL_0] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[NORM_ARITH `~(norm(y:real^N) < e) = e <= dist(x,x + y)`] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]]);; let MEASURE_CONTINUOUS_WITH_HAUSDIST_EXPLICIT = prove (`!s:real^N->bool e. bounded s /\ convex s /\ &0 < e ==> ?d. &0 < d /\ !t. convex t /\ (!y. y IN s ==> ?x. x IN t /\ dist(x,y) < d) /\ (!y. y IN t ==> ?x. x IN s /\ dist(x,y) < d) ==> abs(measure(t) - measure(s)) < e`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN EXISTS_TAC `&1` THEN SIMP_TAC[MEASURE_EMPTY] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `e:real`] MEASURE_CONTINUOUS_WITH_HAUSDIST) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `t:real^N->bool` THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN EXISTS_TAC `&1` THEN SIMP_TAC[MEASURE_EMPTY] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{a + b:real^N | a IN s /\ b IN ball(vec 0,d / &2)}` THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_BALL_0; VECTOR_ARITH `x:real^N = a + b <=> b = x - a`] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN ASM_MESON_TAC[dist; DIST_SYM]; DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < d /\ x <= d / &2 ==> x < d`) THEN ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS; SETDIST_LE_DIST; IN_SING; DIST_SYM; SETDIST_SYM]]);; let MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_EXPLICIT = prove (`!s:real^N->bool e. bounded s /\ negligible(frontier s) /\ &0 < e ==> ?d. &0 < d /\ !s'. measurable s' /\ (!y. y IN s' ==> ?x. x IN s /\ dist(x,y) < d) ==> measure(s') < measure(s) + e`, REWRITE_TAC[NEGLIGIBLE_EQ_MEASURE_0] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN EXISTS_TAC `&1` THEN SIMP_TAC[MEASURE_EMPTY] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`frontier s:real^N->bool`; `e:real`] MEASURABLE_OUTER_OPEN) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_LID] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `setdist(frontier s,(:real^N) DIFF u)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_FRONTIER_BOUNDED; GSYM OPEN_CLOSED; SETDIST_POS_LE; FRONTIER_EQ_EMPTY] THEN REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[NOT_BOUNDED_UNIV]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[NOT_MEASURABLE_UNIV]; ASM SET_TAC[]]; X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `u < e ==> t - s <= u ==> t < s + e`)) THEN TRANS_TAC REAL_LE_TRANS `measure(t DIFF s:real^N->bool)` THEN ASM_SIMP_TAC[MEASURE_SUB_LE_MEASURE_DIFF; MEASURABLE_JORDAN; NEGLIGIBLE_EQ_MEASURE_0] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_JORDAN; MEASURABLE_DIFF; NEGLIGIBLE_EQ_MEASURE_0] THEN REWRITE_TAC[SUBSET; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`segment[x:real^N,y]`; `s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_SEGMENT] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `y:real^N`; EXISTS_TAC `x:real^N`] THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT]; DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `dist(x:real^N,z) < setdist(frontier s,(:real^N) DIFF u)` MP_TAC THENL [ASM_MESON_TAC[REAL_LET_TRANS; DIST_IN_CLOSED_SEGMENT; DIST_SYM]; GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]]]);; let MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_BOUND = prove (`!s s' r e a:real^N. bounded s /\ convex s /\ ball(a,r) SUBSET s /\ &0 < r /\ bounded s' /\ measurable s' /\ hausdist(s,s') <= e * r /\ &0 < e ==> measure(s') <= measure(s) * (&1 + e) pow dimindex(:N)`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s':real^N->bool`; `closure s:real^N->bool`] HAUSDIST_COMPACT_SUMS) THEN ASM_REWRITE_TAC[HAUSDIST_CLOSURE; COMPACT_CLOSURE; CLOSURE_EQ_EMPTY] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_NOT_LE; BALL_EQ_EMPTY; SUBSET_EMPTY]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] MEASURE_SUBSET))) THEN ASM_SIMP_TAC[MEASURABLE_COMPACT; COMPACT_SUMS; COMPACT_CLOSURE; COMPACT_CBALL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN TRANS_TAC REAL_LE_TRANS `measure {&1 % y + e % z:real^N | y IN closure s /\ z IN closure s}` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_COMPACT; COMPACT_SUMS; COMPACT_CLOSURE; COMPACT_CBALL] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{a % x + b % y:real^N | x IN s /\ y IN t} = {x + y | x IN IMAGE (\x. a % x) s /\ y IN IMAGE (\x. b % x) t}`] THEN ASM_SIMP_TAC[MEASURABLE_COMPACT; COMPACT_SUMS; COMPACT_CLOSURE; COMPACT_CBALL; COMPACT_SCALING]; REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC(SET_RULE `t SUBSET IMAGE (\x. e % x) u ==> {y + z:real^N | y IN s /\ z IN t} SUBSET {y + e % z | y IN s /\ z IN u}`) THEN TRANS_TAC SUBSET_TRANS `IMAGE (\x:real^N. e % x) (cball(vec 0,r))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM CBALL_SCALING; VECTOR_MUL_RZERO] THEN MATCH_MP_TAC SUBSET_CBALL THEN ASM_MESON_TAC[HAUSDIST_SYM]; MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[GSYM CLOSURE_BALL; SUBSET_CLOSURE]]]; ASM_SIMP_TAC[CONVEX_SUMS_MULTIPLES; REAL_POS; REAL_LT_IMP_LE; CONVEX_CLOSURE] THEN ASM_SIMP_TAC[MEASURE_SCALING; COMPACT_CLOSURE; MEASURABLE_COMPACT] THEN ASM_SIMP_TAC[MEASURE_CLOSURE; NEGLIGIBLE_CONVEX_FRONTIER] THEN MATCH_MP_TAC(REAL_ARITH `y * x = a ==> x * y <= a`) THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Steinhaus's theorem. (Stromberg's proof as given on Wikipedia.) *) (* ------------------------------------------------------------------------- *) let STEINHAUS = prove (`!s:real^N->bool. measurable s /\ &0 < measure s ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`] MEASURABLE_INNER_COMPACT) THEN MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`] MEASURABLE_OUTER_OPEN) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < x / &3 <=> &0 < x`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`k:real^N->bool`; `(:real^N) DIFF u`] SEPARATE_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL_0; IN_ELIM_THM] THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `~((IMAGE (\x:real^N. v + x) k) INTER k = {})` MP_TAC THENL [DISCH_TAC THEN MP_TAC(ISPECL [`IMAGE (\x:real^N. v + x) k`; `k:real^N->bool`] MEASURE_UNION) THEN ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ; MEASURE_EMPTY] THEN REWRITE_TAC[MEASURE_TRANSLATION; REAL_SUB_RZERO] THEN MATCH_MP_TAC(REAL_ARITH `!s:real^N->bool u:real^N->bool. measure u < measure s + measure s / &3 /\ measure s < measure k + measure s / &3 /\ measure x <= measure u ==> ~(measure x = measure k + measure k)`) THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_UNION] THEN ASM_REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `v + x:real^N`]) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; NORM_ARITH `d <= dist(x:real^N,v + x) <=> ~(norm v < d)`]; REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `v:real^N = x - y <=> x = v + y`] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A measurable set with cardinality less than c is negligible. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_NONNEGLIGIBLE_IMP_LARGE = prove (`!s:real^N->bool. measurable s /\ &0 < measure s ==> s =_c (:real)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(s:real^N->bool)` THENL [ASM_MESON_TAC[NEGLIGIBLE_FINITE; MEASURABLE_MEASURE_POS_LT]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL [MESON_TAC[CARD_EQ_EUCLIDEAN; CARD_EQ_SYM; CARD_EQ_IMP_LE]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `interval(vec 0:real^N,vec 1)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVAL_UNIV THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^N,vec 1]` THEN SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CARD_LE_SUBSET] THEN TRANS_TAC CARD_LE_TRANS `cball(vec 0:real^N,d / &2)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; INTERIOR_CLOSED_INTERVAL; CONVEX_CBALL; COMPACT_CBALL; UNIT_INTERVAL_NONEMPTY; INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `ball(vec 0:real^N,d)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `IMAGE (\(x:real^N,y). x - y) (s *_c s)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[mul_c; CARD_LE_SUBSET; SET_RULE `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `((s:real^N->bool) *_c s)` THEN REWRITE_TAC[CARD_LE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_SQUARE_INFINITE THEN ASM_REWRITE_TAC[INFINITE]);; let MEASURABLE_SMALL_IMP_NEGLIGIBLE = prove (`!s:real^N->bool. measurable s /\ s <_c (:real) ==> negligible s`, GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> ~c ==> ~b`] THEN SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_NONNEGLIGIBLE_IMP_LARGE) THEN REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);; (* ------------------------------------------------------------------------- *) (* Austin's Lemma. *) (* ------------------------------------------------------------------------- *) let AUSTIN_LEMMA = prove (`!D. FINITE D /\ (!d. d IN D ==> ?k a b. d = interval[a:real^N,b] /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> b$i - a$i = k)) ==> ?D'. D' SUBSET D /\ pairwise DISJOINT D' /\ measure(UNIONS D') >= measure(UNIONS D) / &3 pow (dimindex(:N))`, GEN_TAC THEN WF_INDUCT_TAC `CARD(D:(real^N->bool)->bool)` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[SUBSET_EMPTY; UNWIND_THM2; PAIRWISE_EMPTY] THEN REWRITE_TAC[UNIONS_0; real_ge; MEASURE_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?d:real^N->bool. d IN D /\ !d'. d' IN D ==> measure d' <= measure d` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `IMAGE measure (D:(real^N->bool)->bool)` SUP_FINITE) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{c:real^N->bool | c IN (D DELETE d) /\ c INTER d = {}}`) THEN ANTS_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[FINITE_DELETE; FINITE_RESTRICT; IN_ELIM_THM; real_ge] THEN ANTS_TAC THENL [ASM_SIMP_TAC[IN_DELETE]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `D':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(d:real^N->bool) INSERT D'` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[pairwise; IN_INSERT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?a3 b3:real^N. measure(interval[a3,b3]) = &3 pow dimindex(:N) * measure d /\ !c. c IN D /\ ~(c INTER d = {}) ==> c SUBSET interval[a3,b3]` STRIP_ASSUME_TAC THENL [USE_THEN "*" (MP_TAC o SPEC `d:real^N->bool`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real`; `a:real^N`; `b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN EXISTS_TAC `inv(&2) % (a + b) - &3 / &2 % (b - a):real^N` THEN EXISTS_TAC `inv(&2) % (a + b) + &3 / &2 % (b - a):real^N` THEN CONJ_TAC THENL [REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `(x + &3 / &2 * a) - (x - &3 / &2 * a) = &3 * a`; REAL_ARITH `x - a <= x + a <=> &0 <= a`] THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= &3 / &2 * x - &0 <=> &0 <= x`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN SIMP_TAC[PRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1; REAL_POW_MUL]; X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k':real`; `a':real^N`; `b':real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DISJOINT_INTERVAL]) THEN REWRITE_TAC[NOT_EXISTS_THM; SUBSET_INTERVAL] THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[a':real^N,b']`) THEN ASM_REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT] THEN REWRITE_TAC[REAL_ARITH `a$k <= b$k <=> &0 <= b$k - a$k`] THEN ASM_SIMP_TAC[IN_NUMSEG] THEN ASM_CASES_TAC `&0 <= k` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `&0 <= k'` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(fun th -> SIMP_TAC[th] THEN MP_TAC(ISPEC `i:num` th))) THEN ASM_SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG] THEN DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] REAL_POW_LE2_REV)) THEN ASM_SIMP_TAC[DIMINDEX_GE_1; LE_1] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[UNIONS_INSERT] THEN SUBGOAL_THEN `!d:real^N->bool. d IN D ==> measurable d` ASSUME_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_DISJOINT_UNION o rand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_DELETE]; DISCH_THEN SUBST1_TAC] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(interval[a3:real^N,b3]) + measure(UNIONS D DIFF interval[a3,b3])` THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNION o rand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[MEASURABLE_UNIONS]; ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF; MEASURABLE_INTERVAL; MEASURABLE_UNION]; SET_TAC[]]]; ASM_REWRITE_TAC[REAL_ARITH `a * x + y <= (x + z) * a <=> y <= z * a`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y <= a ==> x <= y ==> x <= a`)) THEN SIMP_TAC[REAL_LE_DIV2_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNIONS; MEASURABLE_INTERVAL; IN_ELIM_THM; IN_DELETE; FINITE_DELETE; FINITE_RESTRICT] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Some differentiability-like properties of the indefinite integral. *) (* The first two proofs are minor variants of each other, but it was more *) (* work to derive one from the other. *) (* ------------------------------------------------------------------------- *) let INTEGRABLE_CCONTINUOUS_EXPLICIT = prove (`!f:real^M->real^N. (!a b. f integrable_on interval[a,b]) ==> ?k. negligible k /\ !x e. ~(x IN k) /\ &0 < e ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> norm(inv(content(interval[x,x + h % vec 1])) % integral (interval[x,x + h % vec 1]) f - f(x)) < e`, REPEAT STRIP_TAC THEN REWRITE_TAC[IN_UNIV] THEN MAP_EVERY ABBREV_TAC [`box = \h x. interval[x:real^M,x + h % vec 1]`; `box2 = \h x. interval[x:real^M - h % vec 1,x + h % vec 1]`; `i = \h:real x:real^M. inv(content(box h x)) % integral (box h x) (f:real^M->real^N)`] THEN SUBGOAL_THEN `?k. negligible k /\ !x e. ~(x IN k) /\ &0 < e ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> norm(i h x - (f:real^M->real^N) x) < e` MP_TAC THENL [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN EXISTS_TAC `{x | ~(!e. &0 < e ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN SIMP_TAC[IN_ELIM_THM] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | !d. &0 < d ==> ?h. &0 < h /\ h < d /\ inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)} | k IN (:num)}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `jj:num` THEN SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`] HENSTOCK_LEMMA) THEN ANTS_TAC THENL [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &6 pow (dimindex(:M))`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN ABBREV_TAC `E = {x | x IN interval[a,b] /\ !d. &0 < d ==> ?h. &0 < h /\ h < d /\ mu <= dist(i h x,(f:real^M->real^N) x)}` THEN SUBGOAL_THEN `!x. x IN E ==> ?h. &0 < h /\ (box h x:real^M->bool) SUBSET (g x) /\ (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\ mu <= dist(i h x,(f:real^M->real^N) x)` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uv:real^M->real` THEN REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`; `\x:real^M. if x IN E then ball(x,uv x) else g(x)`] COVERING_LEMMA) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[gauge] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `measurable(UNIONS D:real^M->bool) /\ measure(UNIONS D) <= measure(interval[a:real^M,b])` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?d. d SUBSET D /\ FINITE d /\ measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL [EXISTS_TAC `{}:(real^M->bool)->bool` THEN ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV; MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`; `measure(UNIONS D:real^M->bool) / &2`] MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS]; ALL_TAC]) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN MP_TAC(ISPEC `IMAGE (\k:real^M->bool. (box2:real->real^M->real^M->bool) (uv(tag k):real) ((tag k:real^M))) d` AUSTIN_LEMMA) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box2" THEN EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN EXPAND_TAC "box2" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN EXPAND_TAC "box2" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(UNIONS (IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool) (uv(tag k):real) ((tag k:real^M))) p)) * &6 pow dimindex (:M)` THEN CONJ_TAC THENL [SUBGOAL_THEN `!box. IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool) (uv(tag k):real) ((tag k:real^M))) p = IMAGE (\t. box (uv t) t) (IMAGE tag p)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o lhand o rand o snd) THEN W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o lhand o lhand o rand o snd) THEN MATCH_MP_TAC(TAUT `fp /\ (mb /\ mb') /\ (db /\ db') /\ (m1 /\ m2 ==> p) ==> (fp /\ mb /\ db ==> m1) ==> (fp /\ mb' /\ db' ==> m2) ==> p`) THEN SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ASM_SIMP_TAC[FINITE_IMAGE]] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN REWRITE_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (p ==> q) ==> (p ==> q) /\ (p ==> r)`) THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> (s INTER t) SUBSET (s' INTER t')`) THEN CONJ_TAC THEN MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `k1:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\ &0 <= uv((tag:(real^M->bool)->real^M) k2)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; SET_TAC[]]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `t:real^M` THEN DISCH_THEN(K ALL_TAC) THEN SUBST1_TAC(REAL_ARITH `&6 = &2 * &3`) THEN REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`; REAL_ARITH `a - x <= a + x <=> &0 <= x`] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ARITH `(t + h) - (t - h):real = &2 * h`; REAL_ARITH `(t + h) - t:real = h`] THEN REWRITE_TAC[PRODUCT_MUL_NUMSEG; PRODUCT_CONST_NUMSEG] THEN REWRITE_TAC[ADD_SUB; REAL_MUL_AC]; ALL_TAC] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\k. (tag:(real^M->bool)->real^M) k, (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN ANTS_TAC THENL [REWRITE_TAC[tagged_partial_division_of; fine] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN REWRITE_TAC[MESON[] `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=> (!k. k IN d ==> P (tag k) (g k))`] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < u ==> x <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET]; ASM_MESON_TAC[SUBSET]; EXPAND_TAC "box" THEN MESON_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\ &0 <= uv((tag:(real^M->bool)->real^M) k2)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `i1 SUBSET s1 /\ i2 SUBSET s2 ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[INTERIOR_SUBSET; SUBSET_TRANS] `s SUBSET t ==> interior s SUBSET t`) THEN MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; ASM_MESON_TAC[SUBSET]]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag k):real^M->bool)` MP_TAC THENL [EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a <= a + x`] THEN MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN ASSUME_TAC th) THEN REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN SUBGOAL_THEN `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N, f(tag k))` MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN UNDISCH_TAC `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag k):real^M->bool)` THEN EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN REWRITE_TAC[VECTOR_MUL_LID]);; let INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC = prove (`!f:real^M->real^N. (!a b. f integrable_on interval[a,b]) ==> ?k. negligible k /\ !x e. ~(x IN k) /\ &0 < e ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> norm(inv(content(interval[x - h % vec 1,x + h % vec 1])) % integral (interval[x - h % vec 1,x + h % vec 1]) f - f(x)) < e`, REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`box = \h x. interval[x - h % vec 1:real^M,x + h % vec 1]`; `i = \h:real x:real^M. inv(content(box h x)) % integral (box h x) (f:real^M->real^N)`] THEN SUBGOAL_THEN `?k. negligible k /\ !x e. ~(x IN k) /\ &0 < e ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> norm(i h x - (f:real^M->real^N) x) < e` MP_TAC THENL [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN EXISTS_TAC `{x | ~(!e. &0 < e ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN SIMP_TAC[IN_ELIM_THM] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | !d. &0 < d ==> ?h. &0 < h /\ h < d /\ inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)} | k IN (:num)}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `jj:num` THEN SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`] HENSTOCK_LEMMA) THEN ANTS_TAC THENL [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &3 pow (dimindex(:M))`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN ABBREV_TAC `E = {x | x IN interval[a,b] /\ !d. &0 < d ==> ?h. &0 < h /\ h < d /\ mu <= dist(i h x,(f:real^M->real^N) x)}` THEN SUBGOAL_THEN `!x. x IN E ==> ?h. &0 < h /\ (box h x:real^M->bool) SUBSET (g x) /\ (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\ mu <= dist(i h x,(f:real^M->real^N) x)` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN ASM_MESON_TAC[REAL_LET_TRANS]; UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uv:real^M->real` THEN REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`; `\x:real^M. if x IN E then ball(x,uv x) else g(x)`] COVERING_LEMMA) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[gauge] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `measurable(UNIONS D:real^M->bool) /\ measure(UNIONS D) <= measure(interval[a:real^M,b])` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?d. d SUBSET D /\ FINITE d /\ measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL [EXISTS_TAC `{}:(real^M->bool)->bool` THEN ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV; MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`; `measure(UNIONS D:real^M->bool) / &2`] MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS]; ALL_TAC]) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN MP_TAC(ISPEC `IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool) (uv(tag k):real) ((tag k:real^M))) d` AUSTIN_LEMMA) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box" THEN EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]]; ALL_TAC] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\k. (tag:(real^M->bool)->real^M) k, (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN ANTS_TAC THENL [REWRITE_TAC[tagged_partial_division_of; fine] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN REWRITE_TAC[MESON[] `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=> (!k. k IN d ==> P (tag k) (g k))`] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < u ==> x - u <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET]; ASM_MESON_TAC[SUBSET]; EXPAND_TAC "box" THEN MESON_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [EXPAND_TAC "box" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\ &0 <= uv((tag:(real^M->bool)->real^M) k2)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `i1 SUBSET s1 /\ i2 SUBSET s2 ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN REWRITE_TAC[INTERIOR_SUBSET]]; ASM_MESON_TAC[SUBSET]]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag k):real^M->bool)` MP_TAC THENL [EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a - x <= a + x`] THEN MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN ASSUME_TAC th) THEN REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN SUBGOAL_THEN `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N, f(tag k))` MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN UNDISCH_TAC `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag k):real^M->bool)` THEN EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN REWRITE_TAC[VECTOR_MUL_LID]);; let HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL = prove (`!f:real^1->real^N a b. f integrable_on interval[a,b] ==> ?k. negligible k /\ !x. x IN interval[a,b] DIFF k ==> ((\x. integral(interval[a,x]) f) has_vector_derivative f(x)) (at x within interval[a,b])`, SUBGOAL_THEN `!f:real^1->real^N a b. f integrable_on interval[a,b] ==> ?k. negligible k /\ !x e. x IN interval[a,b] DIFF k /\ &0 < e ==> ?d. &0 < d /\ !x'. x' IN interval[a,b] /\ drop x < drop x' /\ drop x' < drop x + d ==> norm(integral(interval[x,x']) f - drop(x' - x) % f x) / norm(x' - x) < e` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(\x. if x IN interval[a,b] then f x else vec 0):real^1->real^N` INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^1)` THEN ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; SUBSET_UNIV]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `e:real`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `drop y - drop x`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `x + (drop y - drop x) % vec 1 = y` SUBST1_TAC THENL [REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CONTENT_1; REAL_LT_IMP_LE] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ; GSYM DROP_EQ; REAL_LT_IMP_NE] THEN SUBGOAL_THEN `norm(y - x) = abs(drop y - drop x)` SUBST1_TAC THENL [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB]; ALL_TAC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM NORM_MUL)] THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_FIELD `x < y ==> (y - x) * inv(y - x) = &1`] THEN AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[DIFF_EMPTY] THEN DISCH_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `b:real^1`] th) THEN MP_TAC(ISPECL [`\x. (f:real^1->real^N) (--x)`; `--b:real^1`; `--a:real^1`] th)) THEN ASM_REWRITE_TAC[INTEGRABLE_REFLECT] THEN DISCH_THEN(X_CHOOSE_THEN `k2:real^1->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN DISCH_THEN(X_CHOOSE_THEN `k1:real^1->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN EXISTS_TAC `k1 UNION IMAGE (--) k2:real^1->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `x:real^1 = --x' <=> --x = x'`] THEN REWRITE_TAC[UNWIND_THM1] THEN STRIP_TAC THEN REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN] THEN CONJ_TAC THENL [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "2" (MP_TAC o SPECL [`--x:real^1`; `e:real`]) THEN REMOVE_THEN "1" (MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_REFLECT] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN STRIP_TAC THEN SUBGOAL_THEN `drop x < drop y \/ drop y < drop x` DISJ_CASES_TAC THENL [ASM_REAL_ARITH_TAC; REMOVE_THEN "1" (MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `c + a:real^N = b ==> a = b - c`) THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; REMOVE_THEN "2" (MP_TAC o SPEC `--y:real^1`) THEN ANTS_TAC THENL [SIMP_TAC[DROP_NEG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `norm(--y - --x) = abs(drop y - drop x)` SUBST1_TAC THENL [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; DROP_NEG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[INTEGRAL_REFLECT] THEN REWRITE_TAC[VECTOR_NEG_NEG; DROP_SUB; DROP_NEG] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x - (--a - --b) % y:real^N = --(--x - (a - b) % y)`] THEN REWRITE_TAC[NORM_NEG] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(VECTOR_ARITH `b + a = c ==> --a:real^N = b - c`) THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);; let ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS = prove (`!f:real^M->real^N. (!a b. f absolutely_integrable_on interval[a,b]) ==> ?k. negligible k /\ !x e. ~(x IN k) /\ &0 < e ==> ?d. &0 < d /\ !h. &0 < h /\ h < d ==> norm(inv(content(interval[x - h % vec 1, x + h % vec 1])) % integral (interval[x - h % vec 1, x + h % vec 1]) (\t. lift(norm(f t - f x)))) < e`, REPEAT STRIP_TAC THEN MP_TAC(GEN `r:real^N` (ISPEC `\t. lift(norm((f:real^M->real^N) t - r))` INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC)) THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `k:real^N->real^M->bool` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS (IMAGE (k:real^N->real^M->bool) {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)})` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RATIONAL_COORDINATES] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN STRIP_TAC THEN MP_TAC(SET_RULE `(f:real^M->real^N) x IN (:real^N)`) THEN REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`r:real^N`; `x:real^M`; `e / &3`]) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(y1:real^N) < e / &3 /\ norm(i1 - i2) <= e / &3 ==> norm(i1 - y1) < e / &3 ==> norm(i2) < e`) THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN CONJ_TAC THENL [ASM_MESON_TAC[dist; DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(inv(content(interval[x - h % vec 1,x + h % vec 1]))) * drop(integral (interval[x - h % vec 1,x + h % vec 1]) (\x:real^M. lift(e / &3)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN ANTS_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST]; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST]; X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP; GSYM LIFT_SUB] THEN ASM_MESON_TAC[NORM_ARITH `dist(r,x) < e / &3 ==> abs(norm(y - r:real^N) - norm(y - x)) <= e / &3`]]]; ASM_CASES_TAC `content(interval[x - h % vec 1:real^M,x + h % vec 1]) = &0` THENL [ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_NUM; REAL_MUL_LZERO] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ABS_INV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ] THEN REWRITE_TAC[INTEGRAL_CONST; DROP_CMUL; LIFT_DROP] THEN SIMP_TAC[real_abs; CONTENT_POS_LE; REAL_MUL_SYM; REAL_LE_REFL]]]);; (* ------------------------------------------------------------------------- *) (* Measurability of a function on a set (not necessarily itself measurable). *) (* ------------------------------------------------------------------------- *) parse_as_infix("measurable_on",(12,"right"));; let measurable_on = new_definition `(f:real^M->real^N) measurable_on s <=> ?k g. negligible k /\ (!n. (g n) continuous_on (:real^M)) /\ (!x. ~(x IN k) ==> ((\n. g n x) --> if x IN s then f(x) else vec 0) sequentially)`;; let MEASURABLE_ON_UNIV = prove (`(\x. if x IN s then f(x) else vec 0) measurable_on (:real^M) <=> f measurable_on s`, REWRITE_TAC[measurable_on; IN_UNIV; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Lebesgue measurability (like "measurable" but allowing infinite measure) *) (* ------------------------------------------------------------------------- *) let lebesgue_measurable = new_definition `lebesgue_measurable s <=> (indicator s) measurable_on (:real^N)`;; (* ------------------------------------------------------------------------- *) (* Relation between measurability and integrability. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE = prove (`!f:real^M->real^N g s. f measurable_on s /\ g integrable_on s /\ (!x. x IN s ==> norm(f x) <= drop(g x)) ==> f integrable_on s`, let lemma = prove (`!f:real^M->real^N g a b. f measurable_on (:real^M) /\ g integrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> norm(f x) <= drop(g x)) ==> f integrable_on interval[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `h:num->real^M->real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN MAP_EVERY EXISTS_TAC [`h:num->real^M->real^N`; `g:real^M->real^1`] THEN ASM_SIMP_TAC[IN_DIFF] THEN REWRITE_TAC[LEFT_AND_FORALL_THM] THEN X_GEN_TAC `n:num` THEN UNDISCH_TAC `(g:real^M->real^1) integrable_on interval [a,b]` THEN SUBGOAL_THEN `(h:num->real^M->real^N) n absolutely_integrable_on interval[a,b]` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONTINUOUS THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; REWRITE_TAC[IMP_IMP; absolutely_integrable_on; GSYM CONJ_ASSOC] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]) in ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND THEN EXISTS_TAC `g:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_ALT]) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_POS]);; let MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE = prove (`!f:real^M->real^N g s k. f measurable_on s /\ g integrable_on s /\ negligible k /\ (!x. x IN s DIFF k ==> norm(f x) <= drop(g x)) ==> f integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. if x IN k then lift(norm((f:real^M->real^N) x)) else g x` THEN ASM_SIMP_TAC[COND_RAND; IN_DIFF; LIFT_DROP; REAL_LE_REFL; COND_ID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN MAP_EVERY EXISTS_TAC [`g:real^M->real^1`; `k:real^M->bool`] THEN ASM_SIMP_TAC[IN_DIFF]);; let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove (`!f:real^M->real^N g s. f measurable_on s /\ g integrable_on s /\ (!x. x IN s ==> norm(f x) <= drop(g x)) ==> f absolutely_integrable_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^1`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND) THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_MESON_TAC[REAL_ABS_LE; REAL_LE_TRANS]; ASM_MESON_TAC[MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE]; MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop] THEN ASM_MESON_TAC[NORM_ARITH `norm(x) <= a ==> &0 <= a`]]);; let INTEGRAL_DROP_LE_MEASURABLE = prove (`!f g s:real^N->bool. f measurable_on s /\ g integrable_on s /\ (!x. x IN s ==> &0 <= drop(f x) /\ drop(f x) <= drop(g x)) ==> drop(integral s f) <= drop(integral s g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `g:real^N->real^1` THEN ASM_SIMP_TAC[NORM_REAL; GSYM drop; real_abs]);; let INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE = prove (`!f:real^M->real^N. (!a b. f integrable_on interval[a,b]) ==> f measurable_on (:real^M)`, REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN MAP_EVERY ABBREV_TAC [`box = \h x. interval[x:real^M,x + h % vec 1]`; `i = \h:real x:real^M. inv(content(box h x)) % integral (box h x) (f:real^M->real^N)`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `(\n x. i (inv(&n + &1)) x):num->real^M->real^N` THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [REWRITE_TAC[continuous_on; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`; `e:real`] THEN DISCH_TAC THEN EXPAND_TAC "i" THEN EXPAND_TAC "box" THEN MP_TAC(ISPECL [`f:real^M->real^N`; `x - &2 % vec 1:real^M`; `x + &2 % vec 1:real^M`; `x:real^M`; `x + inv(&n + &1) % vec 1:real^M`; `e * (&1 / (&n + &1)) pow dimindex(:M)`] INDEFINITE_INTEGRAL_CONTINUOUS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [SUBGOAL_THEN `&0 <= inv(&n + &1) /\ inv(&n + &1) <= &1` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC REAL_LT_DIV THEN REAL_ARITH_TAC]; DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min k (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN ASM_REWRITE_TAC[dist] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`] THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN REWRITE_TAC[REAL_ARITH `(x + inv y) - x = &1 / y`] THEN REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_DIV] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_POW_LT; REAL_ARITH `&0 < &1 /\ &0 < &n + &1`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_ARITH `(y + i) - (x + i):real^N = y - x`; VECTOR_ARITH `(y - i) - (x - i):real^N = y - x`] THEN ASM_SIMP_TAC[IN_INTERVAL; REAL_LT_IMP_LE] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= i /\ i <= &1 /\ abs(x - y) <= &1 ==> (x - &2 <= y /\ y <= x + &2) /\ (x - &2 <= y + i /\ y + i <= x + &2)`) THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_ARITH `&0 <= &n + &1 /\ &1 <= &n + &1`] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; NORM_SUB; REAL_LE_TRANS]]; FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN ASM_CASES_TAC `negligible(k:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; let INTEGRABLE_IMP_MEASURABLE = prove (`!f:real^M->real^N s. f integrable_on s ==> f measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV; GSYM MEASURABLE_ON_UNIV] THEN SPEC_TAC(`\x. if x IN s then (f:real^M->real^N) x else vec 0`, `f:real^M->real^N`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; let ABSOLUTELY_INTEGRABLE_MEASURABLE = prove (`!f:real^M->real^N s. f absolutely_integrable_on s <=> f measurable_on s /\ (\x. lift(norm(f x))) integrable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (b /\ c ==> a) ==> (a /\ c <=> b /\ c)`) THEN REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))` THEN ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Composing continuous and measurable functions; a few variants. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_COMPOSE_CONTINUOUS = prove (`!f:real^M->real^N g:real^N->real^P. f measurable_on (:real^M) /\ g continuous_on (:real^N) ==> (g o f) measurable_on (:real^M)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n x. (g:real^N->real^P) ((h:num->real^M->real^N) n x)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_SEQUENTIALLY]) THEN ASM_SIMP_TAC[o_DEF; IN_UNIV]]);; let MEASURABLE_ON_COMPOSE_CONTINUOUS_0 = prove (`!f:real^M->real^N g:real^N->real^P s. f measurable_on s /\ g continuous_on (:real^N) /\ g(vec 0) = vec 0 ==> (g o f) measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_MESON_TAC[]);; let MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL = prove (`!f:real^M->real^N g:real^N->real^P a b. f measurable_on (:real^M) /\ (!x. f(x) IN interval(a,b)) /\ g continuous_on interval(a,b) ==> (g o f) measurable_on (:real^M)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\n x. (g:real^N->real^P) (lambda i. max ((a:real^N)$i + (b$i - a$i) / (&n + &2)) (min ((h n x:real^N)$i) ((b:real^N)$i - (b$i - a$i) / (&n + &2))))) :num->real^M->real^P` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MP_TAC(ISPECL [`(:real^M)`; `(lambda i. (b:real^N)$i - (b$i - (a:real^N)$i) / (&n + &2)):real^N`] CONTINUOUS_ON_CONST) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN MP_TAC(ISPECL [`(:real^M)`; `(lambda i. (a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2)):real^N`] CONTINUOUS_ON_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA]; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval(a:real^N,b)` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M` o CONJUNCT1) THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < ((b:real^N)$i - (a:real^N)$i) / (&n + &2) /\ ((b:real^N)$i - (a:real^N)$i) / (&n + &2) <= (b$i - a$i) / &2` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &2`] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[real_div]] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC]]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_INTERVAL]; ALL_TAC] THEN SUBGOAL_THEN `((\n. (lambda i. ((a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2)))) --> a) sequentially /\ ((\n. (lambda i. ((b:real^N)$i - ((b:real^N)$i - a$i) / (&n + &2)))) --> b) sequentially` MP_TAC THENL [ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[real_sub] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST; LIFT_NEG; real_div; LIFT_CMUL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_0] THEN TRY(MATCH_MP_TAC LIM_NEG) THEN REWRITE_TAC[VECTOR_NEG_0] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = ((b:real^N)$j + --((a:real^N)$j)) % vec 0`) THEN MATCH_MP_TAC LIM_CMUL THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0; NORM_LIFT] THEN X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_LE; REAL_ABS_NUM] THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> a /\ c ==> b ==> d`] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_MIN) THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_MAX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; FUN_EQ_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_MESON_TAC[REAL_ARITH `a < x /\ x < b ==> max a (min x b) = x`]]);; let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET = prove (`!f:real^M->real^N g:real^N->real^P s. closed s /\ f measurable_on (:real^M) /\ (!x. f(x) IN s) /\ g continuous_on s ==> (g o f) measurable_on (:real^M)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^N->real^P`; `(:real^N)`; `s:real^N->bool`] TIETZE_UNBOUNDED) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^P` THEN DISCH_TAC THEN SUBGOAL_THEN `(g:real^N->real^P) o (f:real^M->real^N) = h o f` SUBST1_TAC THENL [ASM_SIMP_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN ASM_REWRITE_TAC[]);; let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0 = prove (`!f:real^M->real^N g:real^N->real^P s t. closed s /\ f measurable_on t /\ (!x. f(x) IN s) /\ g continuous_on s /\ vec 0 IN s /\ g(vec 0) = vec 0 ==> (g o f) measurable_on t`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN MP_TAC(ISPECL [`(\x. if x IN t then f x else vec 0):real^M->real^N`; `g:real^N->real^P`; `s:real^N->bool`] MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[MEASURABLE_ON_UNIV] THEN ASM_MESON_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Basic closure properties of measurable functions. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_IMP_MEASURABLE_ON = prove (`!f:real^M->real^N. f continuous_on (:real^M) ==> f measurable_on (:real^M)`, REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN EXISTS_TAC `{}:real^M->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN EXISTS_TAC `\n:num. (f:real^M->real^N)` THEN ASM_REWRITE_TAC[LIM_CONST]);; let MEASURABLE_ON_CONST = prove (`!k:real^N. (\x. k) measurable_on (:real^M)`, SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; CONTINUOUS_ON_CONST]);; let MEASURABLE_ON_0 = prove (`!s. (\x. vec 0) measurable_on s`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_CONST; COND_ID]);; let MEASURABLE_ON_CMUL = prove (`!c f:real^M->real^N s. f measurable_on s ==> (\x. c % f x) measurable_on s`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);; let MEASURABLE_ON_CMUL_EQ = prove (`!f:real^M->real^N s c. (\x. c % f x) measurable_on s <=> c = &0 \/ f measurable_on s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; MEASURABLE_ON_0] THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_ON_CMUL] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP MEASURABLE_ON_CMUL) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN REWRITE_TAC[VECTOR_MUL_LID; ETA_AX]);; let MEASURABLE_ON_NEG = prove (`!f:real^M->real^N s. f measurable_on s ==> (\x. --(f x)) measurable_on s`, REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`; MEASURABLE_ON_CMUL]);; let MEASURABLE_ON_NEG_EQ = prove (`!f:real^M->real^N s. (\x. --(f x)) measurable_on s <=> f measurable_on s`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; let MEASURABLE_ON_NORM = prove (`!f:real^M->real^N s. f measurable_on s ==> (\x. lift(norm(f x))) measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o ISPEC `\x:real^N. lift(norm x)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS_0)) THEN REWRITE_TAC[o_DEF; NORM_0; LIFT_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[continuous_on; IN_UNIV; DIST_LIFT] THEN GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let MEASURABLE_ON_LIFT_ABS = prove (`!f:real^N->real s. (\x. lift(f x)) measurable_on s ==> (\x. lift(abs(f x))) measurable_on s`, REWRITE_TAC[GSYM NORM_LIFT; MEASURABLE_ON_NORM]);; let MEASURABLE_ON_PASTECART = prove (`!f:real^M->real^N g:real^M->real^P s. f measurable_on s /\ g measurable_on s ==> (\x. pastecart (f x) (g x)) measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `k1:real^M->bool` MP_TAC) (X_CHOOSE_THEN `k2:real^M->bool` MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `g2:num->real^M->real^P` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g1:num->real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `k1 UNION k2:real^M->bool` THEN ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN EXISTS_TAC `(\n x. pastecart (g1 n x) (g2 n x)) :num->real^M->real^(N,P)finite_sum` THEN ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX; IN_UNION; DE_MORGAN_THM] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_CASES_TAC `(x:real^M) IN s` THEN REWRITE_TAC[GSYM PASTECART_VEC] THEN ASM_SIMP_TAC[LIM_PASTECART]);; let MEASURABLE_ON_COMBINE = prove (`!h:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P s. f measurable_on s /\ g measurable_on s /\ (\x. h (fstcart x) (sndcart x)) continuous_on UNIV /\ h (vec 0) (vec 0) = vec 0 ==> (\x. h (f x) (g x)) measurable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^M. (h:real^N->real^P->real^Q) (f x) (g x)) = (\x. h (fstcart x) (sndcart x)) o (\x. pastecart (f x) (g x))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; FSTCART_PASTECART; SNDCART_PASTECART; o_THM]; MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN ASM_SIMP_TAC[MEASURABLE_ON_PASTECART; FSTCART_VEC; SNDCART_VEC]]);; let MEASURABLE_ON_ADD = prove (`!f:real^M->real^N g:real^M->real^N s. f measurable_on s /\ g measurable_on s ==> (\x. f x + g x) measurable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let MEASURABLE_ON_SUB = prove (`!f:real^M->real^N g:real^M->real^N s. f measurable_on s /\ g measurable_on s ==> (\x. f x - g x) measurable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let MEASURABLE_ON_MAX = prove (`!f:real^M->real^N g:real^M->real^N s. f measurable_on s /\ g measurable_on s ==> (\x. (lambda i. max ((f x)$i) ((g x)$i)):real^N) measurable_on s`, let lemma = REWRITE_RULE[] (ISPEC `(\x y. lambda i. max (x$i) (y$i)):real^N->real^N->real^N` MEASURABLE_ON_COMBINE) in REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN REWRITE_TAC[REAL_ARITH `max x x = x`; LAMBDA_ETA] THEN SIMP_TAC[continuous_on; LAMBDA_BETA; IN_UNIV; DIST_LIFT] THEN GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^(N,N)finite_sum`; `e:real`] THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[dist] THEN X_GEN_TAC `y:real^(N,N)finite_sum` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x - y) < e /\ abs(x' - y') < e ==> abs(max x x' - max y y') < e`) THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH `norm(x) < e /\ abs(x$i) <= norm x ==> abs(x$i) < e`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM FSTCART_SUB; GSYM SNDCART_SUB] THEN ASM_MESON_TAC[REAL_LET_TRANS; NORM_FSTCART; NORM_SNDCART]);; let MEASURABLE_ON_MIN = prove (`!f:real^M->real^N g:real^M->real^N s. f measurable_on s /\ g measurable_on s ==> (\x. (lambda i. min ((f x)$i) ((g x)$i)):real^N) measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG)) THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MAX) THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN SIMP_TAC[CART_EQ; VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);; let MEASURABLE_ON_DROP_MUL = prove (`!f g:real^M->real^N s. f measurable_on s /\ g measurable_on s ==> (\x. drop(f x) % g x) measurable_on s`, let lemma = REWRITE_RULE[] (ISPEC `\x y. drop x % y :real^N` MEASURABLE_ON_COMBINE) in REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; ETA_AX; LIFT_DROP] THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let MEASURABLE_ON_LIFT_MUL = prove (`!f g s. (\x. lift(f x)) measurable_on s /\ (\x. lift(g x)) measurable_on s ==> (\x. lift(f x * g x)) measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN REWRITE_TAC[LIFT_CMUL; LIFT_DROP]);; let MEASURABLE_ON_MUL = prove (`!f g s. (\x. lift(f x)) measurable_on s /\ g measurable_on s ==> (\x. f x % g x) measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN REWRITE_TAC[LIFT_DROP]);; let MEASURABLE_ON_VSUM = prove (`!f:A->real^M->real^N s t. FINITE t /\ (!i. i IN t ==> (f i) measurable_on s) ==> (\x. vsum t (\i. f i x)) measurable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; MEASURABLE_ON_0; MEASURABLE_ON_ADD; IN_INSERT; ETA_AX]);; let MEASURABLE_ON_COMPONENTWISE = prove (`!f:real^M->real^N s. f measurable_on s <=> (!i. 1 <= i /\ i <= dimindex (:N) ==> (\x. lift (f x$i)) measurable_on s)`, let lemma = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift(f x$i)) measurable_on (:real^M))`, REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. lift(x$i)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF]; ALL_TAC] THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `g:num->num->real^M->real^1`] THEN DISCH_TAC THEN EXISTS_TAC `UNIONS(IMAGE k (1..dimindex(:N))):real^M->bool` THEN EXISTS_TAC `(\n x. lambda i. drop(g i n x)):num->real^M->real^N` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; FORALL_IN_IMAGE; FINITE_IMAGE]; GEN_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]) in REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN GEN_REWRITE_TAC LAND_CONV [lemma] THEN REWRITE_TAC[COND_RAND; COND_RATOR; VEC_COMPONENT; LIFT_NUM]);; let MEASURABLE_ON_CONST_EQ = prove (`!s:real^M->bool c:real^N. (\x. c) measurable_on s <=> c = vec 0 \/ lebesgue_measurable s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = vec 0` THEN ASM_REWRITE_TAC[MEASURABLE_ON_0] THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN EQ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[VEC_COMPONENT] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `inv((c:real^N)$i)` o MATCH_MP MEASURABLE_ON_CMUL) THEN ASM_SIMP_TAC[GSYM LIFT_CMUL; REAL_MUL_LINV; LIFT_NUM] THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[lebesgue_measurable; indicator]; REWRITE_TAC[lebesgue_measurable; indicator; MEASURABLE_ON_UNIV] THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(c:real^N)$i` o MATCH_MP MEASURABLE_ON_CMUL) THEN REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID]]);; let MEASURABLE_ON_LIFT_PRODUCT = prove (`!f:A->real^N->real s t. FINITE t /\ (t = {} ==> lebesgue_measurable s) /\ (!i. i IN t ==> (\x. lift(f i x)) measurable_on s) ==> (\x. lift(product t (\i. f i x))) measurable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; MEASURABLE_ON_CONST_EQ] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_INSERT_EMPTY] THEN MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN REWRITE_TAC[IMP_IMP] THEN STRIP_TAC THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_SIMP_TAC[PRODUCT_CLAUSES; REAL_MUL_RID; ETA_AX] THEN MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN ASM_REWRITE_TAC[ETA_AX] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let MEASURABLE_ON_SPIKE = prove (`!f:real^M->real^N g s t. negligible s /\ (!x. x IN t DIFF s ==> g x = f x) ==> f measurable_on t ==> g measurable_on t`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN REWRITE_TAC[measurable_on] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s UNION k:real^M->bool` THEN ASM_SIMP_TAC[DE_MORGAN_THM; IN_UNION; NEGLIGIBLE_UNION]);; let MEASURABLE_ON_SPIKE_SET = prove (`!f:real^M->real^N s t. negligible (s DIFF t UNION t DIFF s) ==> f measurable_on s ==> f measurable_on t`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[measurable_on] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:num->real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `k UNION (s DIFF t UNION t DIFF s):real^M->bool` THEN ASM_SIMP_TAC[NEGLIGIBLE_UNION; IN_UNION; DE_MORGAN_THM] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let MEASURABLE_ON_EQ = prove (`!f g:real^M->real^N s. (!x. x IN s ==> f x = g x) /\ f measurable_on s ==> g measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MEASURABLE_ON_SPIKE THEN EXISTS_TAC `{}:real^M->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN ASM SET_TAC[]);; let MEASURABLE_ON_RESTRICT = prove (`!f:real^M->real^N s. f measurable_on (:real^M) /\ lebesgue_measurable s ==> (\x. if x IN s then f(x) else vec 0) measurable_on (:real^M)`, REPEAT GEN_TAC THEN REWRITE_TAC[lebesgue_measurable; indicator] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN VECTOR_ARITH_TAC);; let MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove (`!f s t. s SUBSET t /\ f measurable_on t /\ lebesgue_measurable s ==> f measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_RESTRICT) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);; let MEASURABLE_ON_CASES = prove (`!P f g:real^M->real^N s. lebesgue_measurable {x | P x} /\ f measurable_on s /\ g measurable_on s ==> (\x. if P x then f x else g x) measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. (if x IN s then if P x then (f:real^M->real^N) x else g x else vec 0) = (if x IN {x | P x} then if x IN s then f x else vec 0 else vec 0) + (if x IN (:real^M) DIFF {x | P x} then if x IN s then g x else vec 0 else vec 0)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN MESON_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]; MATCH_MP_TAC MEASURABLE_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [lebesgue_measurable]) THEN REWRITE_TAC[lebesgue_measurable] THEN SUBGOAL_THEN `((\x. vec 1):real^M->real^1) measurable_on (:real^M)` MP_TAC THENL [REWRITE_TAC[MEASURABLE_ON_CONST]; REWRITE_TAC[IMP_IMP]] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[indicator; IN_DIFF; IN_UNIV; IN_ELIM_THM; FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(P:real^M->bool) x` THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH]);; let MEASURABLE_ON_LIMIT = prove (`!f:num->real^M->real^N g s k. (!n. (f n) measurable_on s) /\ negligible k /\ (!x. x IN s DIFF k ==> ((\n. f n x) --> g x) sequentially) ==> g measurable_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`vec 0:real^N`; `vec 1:real^N`] HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN REWRITE_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01] THEN REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h':real^N->real^N`; `h:real^N->real^N`] THEN REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN SUBGOAL_THEN `((h':real^N->real^N) o (h:real^N->real^N) o (\x. if x IN s then g x else vec 0)) measurable_on (:real^M)` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_DEF; MEASURABLE_ON_UNIV]] THEN SUBGOAL_THEN `!y:real^N. norm(h y:real^N) <= &(dimindex(:N))` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h UNIV = s ==> (!z. z IN s ==> P z) ==> !y. P(h y)`)) THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTERVAL] THEN REWRITE_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((y:real^N)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) <= &1`]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `vec 1:real^N`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN MAP_EVERY EXISTS_TAC [`(\n x. h(if x IN s then f n x else vec 0:real^N)):num->real^M->real^N`; `(\x. vec(dimindex(:N))):real^M->real^1`] THEN REWRITE_TAC[o_DEF; INTEGRABLE_CONST] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `(\x. vec(dimindex(:N))):real^M->real^1` THEN ASM_REWRITE_TAC[ETA_AX; INTEGRABLE_CONST] THEN ASM_SIMP_TAC[DROP_VEC] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN EXISTS_TAC `interval[a:real^M,b:real^M]` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN MATCH_MP_TAC(REWRITE_RULE[indicator; lebesgue_measurable] MEASURABLE_ON_RESTRICT) THEN REWRITE_TAC[MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`(\x. if x IN s then f (n:num) x else vec 0):real^M->real^N`; `h:real^N->real^N`] MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[MEASURABLE_ON_UNIV; ETA_AX]; MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN REWRITE_TAC[INTEGRABLE_CONST]]; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `interval[a:real^M,b:real^M]` THEN REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `interval[a:real^M,b:real^M]` THEN REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ASM_SIMP_TAC[DROP_VEC]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]]; REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);; let MEASURABLE_ON_BILINEAR = prove (`!op:real^N->real^P->real^Q f g s:real^M->bool. bilinear op /\ f measurable_on s /\ g measurable_on s ==> (\x. op (f x) (g x)) measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `ff:num->real^M->real^N`] THEN REPLICATE_TAC 3 DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`k':real^M->bool`; `gg:num->real^M->real^P`] THEN REPLICATE_TAC 3 DISCH_TAC THEN EXISTS_TAC `k UNION k':real^M->bool` THEN EXISTS_TAC `\n:num x:real^M. (op:real^N->real^P->real^Q) (ff n x) (gg n x)` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL [GEN_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_CONTINUOUS_ON_COMPOSE)) THEN ASM_REWRITE_TAC[ETA_AX]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `(if x IN s then (op:real^N->real^P->real^Q) (f x) (g x) else vec 0) = op (if x IN s then f(x:real^M) else vec 0) (if x IN s then g(x:real^M) else vec 0)` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bilinear]) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o GEN `y:real^N` o MATCH_MP LINEAR_0 o SPEC `y:real^N`) (MP_TAC o GEN `z:real^P` o MATCH_MP LINEAR_0 o SPEC `z:real^P`)) THEN MESON_TAC[]; REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] LIM_BILINEAR)) THEN ASM_SIMP_TAC[]]]);; let ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT = prove (`!op:real^N->real^P->real^Q f g s:real^M->bool. bilinear op /\ f measurable_on s /\ bounded (IMAGE f s) /\ g absolutely_integrable_on s ==> (\x. op (f x) (g x)) absolutely_integrable_on s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\x:real^M. lift(B * C * norm((g:real^M->real^P) x))` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_BILINEAR)) THEN ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE]; REWRITE_TAC[LIFT_CMUL] THEN REPEAT(MATCH_MP_TAC INTEGRABLE_CMUL) THEN RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN ASM_REWRITE_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP] THEN TRANS_TAC REAL_LE_TRANS `B * norm((f:real^M->real^N) x) * norm(g x:real^P)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[NORM_POS_LE]]);; let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE = prove (`!f:real^M->real^N g s t. f measurable_on s /\ g integrable_on s /\ negligible t /\ (!x. x IN s DIFF t ==> norm(f x) <= drop(g x)) ==> f absolutely_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE) THEN MAP_EVERY EXISTS_TAC [`\x. if x IN s DIFF t then (f:real^M->real^N) x else vec 0`; `t:real^M->bool`] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\x. if x IN s DIFF t then (g:real^M->real^1) x else vec 0` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p ==> q ==> r <=> q ==> p ==> r`] MEASURABLE_ON_SPIKE)); FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p ==> q ==> r <=> q ==> p ==> r`] INTEGRABLE_SPIKE)); ASM_MESON_TAC[REAL_LE_REFL; NORM_0; DROP_VEC]] THEN EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some handy lemmas about square integrable functions. These exist in *) (* far more generality in "Multivariate/lpspaces.ml" *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_INTEGRABLE_SQUARE_INTEGRABLE_PRODUCT = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P s. bilinear bop /\ f measurable_on s /\ (\x. lift(norm(f x) pow 2)) integrable_on s /\ g measurable_on s /\ (\x. lift(norm(g x) pow 2)) integrable_on s ==> (\x. bop (f x) (g x)) absolutely_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN ASM_SIMP_TAC[MEASURABLE_ON_BILINEAR] THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. B / &2 % lift(norm((f:real^M->real^N) x) pow 2 + norm((g:real^M->real^P) x) pow 2)` THEN ASM_SIMP_TAC[LIFT_ADD; INTEGRABLE_ADD; INTEGRABLE_CMUL] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[DROP_CMUL; LIFT_DROP; DROP_ADD; REAL_ARITH `B * x * y <= B / &2 * (x pow 2 + y pow 2) <=> &0 <= B * (x - y) pow 2`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_POW_2; REAL_LT_IMP_LE]);; let SQUARE_INTEGRAL_SQUARE_INTEGRABLE_PRODUCT_LE = prove (`!f:real^M->real^N g:real^M->real^P s. f measurable_on s /\ (\x. lift(norm(f x) pow 2)) integrable_on s /\ g measurable_on s /\ (\x. lift(norm(g x) pow 2)) integrable_on s ==> drop(integral s (\x. lift(norm(f x) * norm(g x)))) pow 2 <= drop(integral s (\x. lift(norm(f x) pow 2))) * drop(integral s (\x. lift(norm(g x) pow 2)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x y. lift(drop x * drop y)`; `\x. lift(norm((f:real^M->real^N) x))`; `\x. lift(norm((g:real^M->real^P) x))`; `s:real^M->bool`] ABSOLUTELY_INTEGRABLE_SQUARE_INTEGRABLE_PRODUCT) THEN ASM_SIMP_TAC[LIFT_DROP; NORM_LIFT; REAL_ABS_NORM; MEASURABLE_ON_NORM] THEN REWRITE_TAC[BILINEAR_LIFT_MUL] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN MAP_EVERY ABBREV_TAC [`a = sqrt(drop(integral s (\x. lift(norm((f:real^M->real^N) x) pow 2))))`; `b = sqrt(drop(integral s (\x. lift(norm((g:real^M->real^P) x) pow 2))))`] THEN ASM_CASES_TAC `a = &0` THENL [UNDISCH_TAC `a = &0` THEN EXPAND_TAC "a" THEN REWRITE_TAC[SQRT_EQ_0] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x. lift(norm((f:real^M->real^N) x) pow 2)`; `s:real^M->bool`] HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p ==> q /\ r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_1; DIMINDEX_1] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_LE_POW_2] THEN ASM_SIMP_TAC[GSYM INTEGRAL_EQ_HAS_INTEGRAL] THEN ASM_REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC; NORM_EQ_0; REAL_RING `x pow 2 = &0 <=> x = &0`] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x <= &0 * y`) THEN REWRITE_TAC[REAL_RING `x pow 2 = &0 <=> x = &0`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `{x | x IN s /\ ~((f:real^M->real^N) x = vec 0)}` THEN ASM_SIMP_TAC[NORM_0; REAL_MUL_LZERO; LIFT_NUM; SET_RULE `x IN s DIFF {x | x IN s /\ ~P x} <=> x IN s /\ P x`]; ALL_TAC] THEN ASM_CASES_TAC `b = &0` THENL [UNDISCH_TAC `b = &0` THEN EXPAND_TAC "b" THEN REWRITE_TAC[SQRT_EQ_0] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x. lift(norm((g:real^M->real^P) x) pow 2)`; `s:real^M->bool`] HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p ==> q /\ r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_1; DIMINDEX_1] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_LE_POW_2] THEN ASM_SIMP_TAC[GSYM INTEGRAL_EQ_HAS_INTEGRAL] THEN ASM_REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC; NORM_EQ_0; REAL_RING `x pow 2 = &0 <=> x = &0`] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x <= y * &0`) THEN REWRITE_TAC[REAL_RING `x pow 2 = &0 <=> x = &0`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `{x | x IN s /\ ~((g:real^M->real^P) x = vec 0)}` THEN ASM_SIMP_TAC[NORM_0; REAL_MUL_RZERO; LIFT_NUM; SET_RULE `x IN s DIFF {x | x IN s /\ ~P x} <=> x IN s /\ P x`]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. lift((a * norm((g:real^M->real^P) x) - b * norm((f:real^M->real^N) x)) pow 2)`; `s:real^M->bool`] INTEGRAL_DROP_POS) THEN REWRITE_TAC[LIFT_DROP; REAL_LE_POW_2] THEN REWRITE_TAC[REAL_ARITH `(a * g - b * f:real) pow 2 = (a pow 2 * g pow 2 + b pow 2 * f pow 2) - (&2 * a * b) * (f * g)`] THEN REWRITE_TAC[LIFT_ADD; LIFT_SUB] THEN ONCE_REWRITE_TAC[LIFT_CMUL] THEN ASM_SIMP_TAC[INTEGRABLE_ADD; INTEGRABLE_SUB; INTEGRABLE_CMUL; INTEGRAL_ADD; INTEGRAL_SUB; INTEGRAL_CMUL] THEN REWRITE_TAC[DROP_SUB; DROP_ADD; DROP_CMUL] THEN SUBGOAL_THEN `drop(integral s (\x. lift(norm((f:real^M->real^N) x) pow 2))) = a pow 2 /\ drop(integral s (\x. lift(norm((g:real^M->real^P) x) pow 2))) = b pow 2` (CONJUNCTS_THEN SUBST1_TAC) THENL [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN REWRITE_TAC[REAL_SQRT_POW_2; REAL_ARITH `x = abs x <=> &0 <= x`] THEN ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; REAL_LE_POW_2]; REWRITE_TAC[REAL_ARITH `&0 <= (a pow 2 * b pow 2 + b pow 2 * a pow 2) - (&2 * a * b) * i <=> (a * b) * i <= (a * b) pow 2`]] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x <= y ==> &0 <= x ==> abs x <= abs y`)) THEN SUBGOAL_THEN `&0 <= a /\ &0 <= b` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN CONJ_TAC THEN MATCH_MP_TAC SQRT_POS_LE THEN ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; REAL_LE_POW_2]; ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; REAL_LE_MUL; NORM_POS_LE]] THEN REWRITE_TAC[REAL_LE_SQUARE_ABS; REAL_ARITH `((a * b) * i) pow 2 <= (a * b) pow 2 pow 2 <=> &0 <= (a * b) pow 2 * ((a pow 2 * b pow 2) - i pow 2)`] THEN SUBGOAL_THEN `&0 < a * b` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_POW_LT]] THEN REWRITE_TAC[LIFT_CMUL] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Natural closure properties of measurable functions; the intersection *) (* one is actually quite tedious since we end up reinventing cube roots *) (* before they actually get introduced in transcendentals.ml *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_EMPTY = prove (`!f:real^M->real^N. f measurable_on {}`, ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[NOT_IN_EMPTY; MEASURABLE_ON_CONST]);; let MEASURABLE_ON_INTER = prove (`!f:real^M->real^N s t. f measurable_on s /\ f measurable_on t ==> f measurable_on (s INTER t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> p /\ p ==> q ==> r`] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[VEC_COMPONENT; REAL_ARITH `(if p then x else &0) * (if q then y else &0) = if p /\ q then x * y else &0`] THEN SUBGOAL_THEN `!s. (\x. lift (drop x pow 3)) continuous_on s` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[REAL_ARITH `(x:real) pow 3 = x * x * x`] THEN REWRITE_TAC[LIFT_CMUL] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]); ALL_TAC] THEN SUBGOAL_THEN `?r. !x. lift(drop(r x) pow 3) = x` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM SKOLEM_THM; FORALL_LIFT; GSYM EXISTS_DROP; LIFT_EQ] THEN X_GEN_TAC `x:real` THEN MP_TAC(ISPECL [`\x. lift (drop x pow 3)`; `lift(--(abs x + &1))`; `lift(abs x + &1)`;`x:real`; `1`] IVT_INCREASING_COMPONENT_1) THEN REWRITE_TAC[GSYM drop; LIFT_DROP; EXISTS_DROP] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `(:real^1)`) THEN ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; REWRITE_TAC[REAL_BOUNDS_LE; REAL_POW_NEG; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= x pow 2 /\ &0 <= x pow 3 ==> x <= (x + &1) pow 3`) THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS]]; ALL_TAC] THEN SUBGOAL_THEN `!x. r(lift(x pow 3)) = lift x` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN GEN_TAC THEN MATCH_MP_TAC REAL_POW_EQ_ODD THEN EXISTS_TAC `3` THEN ASM_REWRITE_TAC[ARITH; GSYM LIFT_EQ; LIFT_DROP]; ALL_TAC] THEN SUBGOAL_THEN `(r:real^1->real^1) continuous_on (:real^1)` ASSUME_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`\x. lift(drop x pow 3)`; `(:real^1)`] THEN ASM_REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN SUBST1_TAC(SYM th)) THEN MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN ASM_REWRITE_TAC[PATH_CONNECTED_UNIV; LIFT_EQ] THEN SIMP_TAC[REAL_POW_EQ_ODD_EQ; ARITH; DROP_EQ]; ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 pow 3`] THEN REWRITE_TAC[REAL_ARITH `(x * x) * x:real = x pow 3`; IN_INTER] THEN REWRITE_TAC[MESON[] `(if p then x pow 3 else y pow 3) = (if p then x else y:real) pow 3`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o ISPEC `r:real^1->real^1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN ASM_REWRITE_TAC[o_DEF]]);; let MEASURABLE_ON_DIFF = prove (`!f:real^M->real^N s t. f measurable_on s /\ f measurable_on t ==> f measurable_on (s DIFF t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_DIFF; IN_INTER] THEN X_GEN_TAC `x:real^M` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let MEASURABLE_ON_UNION = prove (`!f:real^M->real^N s t. f measurable_on s /\ f measurable_on t ==> f measurable_on (s UNION t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_ADD) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_UNION; IN_INTER] THEN X_GEN_TAC `x:real^M` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let MEASURABLE_ON_UNIONS = prove (`!f:real^M->real^N k. FINITE k /\ (!s. s IN k ==> f measurable_on s) ==> f measurable_on (UNIONS k)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY; UNIONS_INSERT] THEN SIMP_TAC[FORALL_IN_INSERT; MEASURABLE_ON_UNION]);; let MEASURABLE_ON_COUNTABLE_UNIONS = prove (`!f:real^M->real^N k. COUNTABLE k /\ (!s. s IN k ==> f measurable_on s) ==> f measurable_on (UNIONS k)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `k:(real^M->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY] THEN MP_TAC(ISPEC `k:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN EXISTS_TAC `(\n x. if x IN UNIONS (IMAGE d (0..n)) then f x else vec 0): num->real^M->real^N` THEN EXISTS_TAC `{}:real^M->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY; MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_UNIONS THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FORALL_IN_IMAGE]) THEN SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV; FINITE_IMAGE; FINITE_NUMSEG]; X_GEN_TAC `x:real^M` THEN DISCH_THEN(K ALL_TAC) THEN ASM_CASES_TAC `(x:real^M) IN UNIONS (IMAGE d (:num))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV; EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[]; MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Negligibility of a Lipschitz image of a negligible set. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE = prove (`!f:real^M->real^N s. dimindex(:M) <= dimindex(:N) /\ negligible s /\ (!x. x IN s ==> ?t b. open t /\ x IN t /\ !y. y IN s INTER t ==> norm(f y - f x) <= b * norm(y - x)) ==> negligible(IMAGE f s)`, let lemma = prove (`!f:real^M->real^N s B. dimindex(:M) <= dimindex(:N) /\ bounded s /\ negligible s /\ &0 < B /\ (!x. x IN s ==> ?t. open t /\ x IN t /\ !y. y IN s INTER t ==> norm(f y - f x) <= B * norm(y - x)) ==> negligible(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `e / &2 / (&2 * B * &(dimindex(:M))) pow (dimindex(:N))`] MEASURABLE_OUTER_OPEN) THEN ANTS_TAC THENL [ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC REAL_POW_LT THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN ASM_SIMP_TAC[DIMINDEX_GE_1; REAL_OF_NUM_LT; ARITH; LE_1]; ALL_TAC] THEN ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_HALF; MEASURE_EQ_0] THEN REWRITE_TAC[REAL_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x. ?r. &0 < r /\ r <= &1 / &2 /\ (x IN s ==> !y. norm(y - x:real^M) < r ==> y IN t /\ (y IN s ==> norm(f y - f x:real^N) <= B * norm(y - x)))` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `t INTER u :real^M->bool` open_def) THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTER; dist]] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min (&1 / &2) r` THEN ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN X_GEN_TAC `r:real^M->real` THEN STRIP_TAC] THEN SUBGOAL_THEN `?c. s SUBSET interval[--(vec c):real^M,vec c] /\ ~(interval(--(vec c):real^M,vec c) = {})` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`; `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!k. k IN D ==> ?u v z. k = interval[u,v] /\ ~(interval(u,v) = {}) /\ z IN s /\ z IN interval[u,v] /\ interval[u:real^M,v] SUBSET ball(z,r z)` MP_TAC THENL [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^M. d = interval[u,v]` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M` THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[SUBSET; INTERIOR_CLOSED_INTERVAL; IN_INTER]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:(real^M->bool)->real^M`; `v:(real^M->bool)->real^M`; `z:(real^M->bool)->real^M`] THEN DISCH_THEN(LABEL_TAC "*") THEN EXISTS_TAC `UNIONS(IMAGE (\d:real^M->bool. interval[(f:real^M->real^N)(z d) - (B * &(dimindex(:M)) * ((v(d):real^M)$1 - (u(d):real^M)$1)) % vec 1:real^N, f(z d) + (B * &(dimindex(:M)) * (v(d)$1 - u(d)$1)) % vec 1]) D)` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `(y:real^M) IN UNIONS D` MP_TAC THENL [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[UNIONS_IMAGE]] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(y:real^M) IN ball(z(d:real^M->bool),r(z d))` MP_TAC THENL [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[IN_BALL; dist]] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN DISCH_TAC THEN SUBGOAL_THEN `y IN t /\ norm((f:real^M->real^N) y - f(z d)) <= B * norm(y - z(d:real^M->bool))` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `z - b <= y /\ y <= z + b <=> abs(y - z) <= b`] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `((v:(real^M->bool)->real^M) d - u d)$j` THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN CONJ_TAC THENL [SUBGOAL_THEN `y IN interval[(u:(real^M->bool)->real^M) d,v d] /\ (z d) IN interval[u d,v d]` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `j:num`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `(x <= e / &2 ==> x < e) /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow (dimindex(:N)) * sum D' (\d:real^M->bool. measure d)` THEN SUBGOAL_THEN `FINITE(D':(real^M->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[MEASURE_INTERVAL] THEN X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; REAL_ARITH `(a - x <= a + x <=> &0 <= x) /\ (a + x) - (a - x) = &2 * x`] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN SUBGOAL_THEN `d = interval[u d:real^M,v d]` (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:M) ==> ((u:(real^M->bool)->real^M) d)$i <= (v d:real^M)$i` MP_TAC THENL [ASM_MESON_TAC[SUBSET; INTERVAL_NE_EMPTY; REAL_LT_IMP_LE]; ALL_TAC] THEN SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN DISCH_TAC THEN REWRITE_TAC[PRODUCT_CONST_NUMSEG; REAL_POW_MUL] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH; GSYM REAL_MUL_ASSOC; ADD_SUB; DIMINDEX_GE_1; LE_1] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `((v d:real^M)$1 - ((u:(real^M->bool)->real^M) d)$1) pow (dimindex(:M))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN REWRITE_TAC[DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC(NORM_ARITH `!z r. norm(z - u) < r /\ norm(z - v) < r /\ r <= &1 / &2 ==> norm(v - u:real^M) <= &1`) THEN MAP_EVERY EXISTS_TAC [`(z:(real^M->bool)->real^M) d`; `r((z:(real^M->bool)->real^M) d):real`] THEN ASM_REWRITE_TAC[GSYM dist; GSYM IN_BALL] THEN SUBGOAL_THEN `(u:(real^M->bool)->real^M) d IN interval[u d,v d] /\ (v:(real^M->bool)->real^M) d IN interval[u d,v d]` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[GSYM PRODUCT_CONST; FINITE_NUMSEG] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL; SUBSET]]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow dimindex(:N) * measure(t:real^M->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE; ALL_TAC]; MATCH_MP_TAC REAL_LT_IMP_LE THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN W(MP_TAC o PART_MATCH (rand o rand) REAL_LT_RDIV_EQ o snd)] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_MUL; LE_1; DIMINDEX_GE_1; REAL_ARITH `&0 < &2 * B <=> &0 < B`; REAL_OF_NUM_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(UNIONS D':real^M->bool)` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`] MEASURE_ELEMENTARY) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[division_of] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]]; MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_SIMP_TAC[SUBSET_UNIONS] THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN X_GEN_TAC `d:real^M->bool` THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN SUBGOAL_THEN `d SUBSET ball(z d:real^M,r(z d))` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[SUBSET; IN_BALL; dist] THEN ASM_MESON_TAC[NORM_SUB]]]]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `s = UNIONS {{x | x IN s /\ norm(x:real^M) <= &n /\ ?t. open t /\ x IN t /\ !y. y IN s INTER t ==> norm(f y - f x:real^N) <= (&n + &1) * norm(y - x)} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `max (norm(x:real^M)) b` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MAX_LE] THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b * norm(y - x:real^M)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IMAGE_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `&n + &1` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(vec 0:real^M,&n)` THEN SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM]; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN MESON_TAC[]]]);; let NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE_LOWDIM = prove (`!f:real^M->real^N s. dimindex(:M) < dimindex(:N) /\ (!x. x IN s ==> ?t b. open t /\ x IN t /\ !y. y IN s INTER t ==> norm(f y - f x) <= b * norm(y - x)) ==> negligible(IMAGE f s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^M->real^N) o (sndcart:real^(1,M)finite_sum->real^M)`; `IMAGE (pastecart (vec 0:real^1)) (s:real^M->bool)`] NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; SNDCART_PASTECART; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_REWRITE_TAC[ARITH_RULE `1 + m <= n <=> m < n`] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^(1,M)finite_sum | x$1 = &0}` THEN SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_ELIM_THM] THEN SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_1; LE_REFL; VEC_COMPONENT; DIMINDEX_FINITE_SUM; ARITH_RULE `1 <= 1 + n`]; REWRITE_TAC[IN_INTER; IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[GSYM dist; DIST_PASTECART_CANCEL; SNDCART_PASTECART] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `b:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(:real^1) PCROSS (u:real^M->bool)`; `b:real`] THEN ASM_SIMP_TAC[OPEN_PCROSS; OPEN_UNIV; PASTECART_IN_PCROSS; IN_UNIV] THEN ASM_SIMP_TAC[dist]]);; let NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV = prove (`!f:real^N->real^N s B. negligible s /\ (!x y. norm(f x - f y) <= B * norm(x - y)) ==> negligible(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM_REWRITE_TAC[LE_REFL] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`interval(a - vec 1:real^N,a + vec 1)`; `B:real`] THEN ASM_REWRITE_TAC[OPEN_INTERVAL; IN_INTERVAL] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC);; let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE = prove (`!f:real^M->real^N s. dimindex(:M) <= dimindex(:N) /\ negligible s /\ f differentiable_on s ==> negligible(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM_REWRITE_TAC[IN_INTER] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[differentiable; HAS_DERIVATIVE_WITHIN_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_RID] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^M,d)` THEN EXISTS_TAC `B + &1` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN REWRITE_TAC[IN_BALL; dist; REAL_ADD_RDISTRIB] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `!d. norm(y - x - d:real^N) <= z /\ norm(d) <= b ==> norm(y - x) <= b + z`) THEN EXISTS_TAC `(f':real^M->real^N)(y - x)` THEN ASM_MESON_TAC[NORM_SUB]);; let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM = prove (`!f:real^M->real^N s. dimindex(:M) < dimindex(:N) /\ f differentiable_on s ==> negligible(IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `m < n ==> !x:num. x <= m ==> x <= n`)) THEN SUBGOAL_THEN `(f:real^M->real^N) = (f o ((\x. lambda i. x$i):real^N->real^M)) o ((\x. lambda i. if i <= dimindex(:M) then x$i else &0):real^M->real^N)` SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]; ONCE_REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN REWRITE_TAC[LE_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{y:real^N | y$(dimindex(:N)) = &0}` THEN SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; LE_REFL; DIMINDEX_GE_1] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_GE_1] THEN ASM_REWRITE_TAC[GSYM NOT_LT]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN REWRITE_TAC[differentiable_on; FORALL_IN_IMAGE] THEN STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN SIMP_TAC[linear; LAMBDA_BETA; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THENL [AP_TERM_TAC; MATCH_MP_TAC(SET_RULE `(!x. f(g x) = x) ==> s = IMAGE f (IMAGE g s)`)] THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]]]]);; (* ------------------------------------------------------------------------- *) (* Simplest case of Sard's theorem (we don't need continuity of derivative). *) (* ------------------------------------------------------------------------- *) let BABY_SARD = prove (`!f:real^M->real^N f' s. dimindex(:M) <= dimindex(:N) /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\ rank(matrix(f' x)) < dimindex(:N)) ==> negligible(IMAGE f s)`, let lemma = prove (`!p w e m. dim p < dimindex(:N) /\ &0 <= m /\ &0 <= e ==> ?s. measurable s /\ {z:real^N | norm(z - w) <= m /\ ?t. t IN p /\ norm(z - w - t) <= e} SUBSET s /\ measure s <= (&2 * e) * (&2 * m) pow (dimindex(:N) - 1)`, REPEAT GEN_TAC THEN GEN_GEOM_ORIGIN_TAC `w:real^N` ["t"; "p"] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN REWRITE_TAC[VECTOR_SUB_RZERO; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN X_GEN_TAC `a:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `interval[--(lambda i. if i = 1 then e else m):real^N, (lambda i. if i = 1 then e else m)]` THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL] THEN SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM; DOT_BASIS; DOT_LMUL; DIMINDEX_GE_1; LE_REFL; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN MP_TAC(ISPECL [`x - y:real^N`; `1`] COMPONENT_LE_NORM) THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; ARITH; DIMINDEX_GE_1] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_POS] THEN REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN SIMP_TAC[ARITH; ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN SIMP_TAC[PRODUCT_CONST_NUMSEG; DIMINDEX_GE_1; REAL_LE_REFL; ARITH_RULE `1 <= n ==> (n + 1) - 2 = n - 1`]]) in let semma = prove (`!f:real^M->real^N f' s B. dimindex(:M) <= dimindex(:N) /\ &0 < B /\ bounded s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\ rank(matrix(f' x)) < dimindex(:N) /\ onorm(f' x) <= B) ==> negligible(IMAGE f s)`, REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. x IN s ==> linear((f':real^M->real^M->real^N) x)` ASSUME_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?c. s SUBSET interval(--(vec c):real^M,vec c) /\ ~(interval(--(vec c):real^M,vec c) = {})` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LT] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[VEC_COMPONENT; DIMINDEX_GE_1; LE_REFL; VECTOR_NEG_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `--x < x <=> &0 < &2 * x`; REAL_OF_NUM_MUL] THEN DISCH_TAC THEN SUBGOAL_THEN `?d. &0 < d /\ d <= B /\ (d * &2) * (&4 * B) pow (dimindex(:N) - 1) <= e / &(2 * c) pow dimindex(:M) / &(dimindex(:M)) pow dimindex(:M)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `min B (e / &(2 * c) pow dimindex(:M) / &(dimindex(:M)) pow dimindex(:M) / (&4 * B) pow (dimindex(:N) - 1) / &2)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_ARITH `min x y <= x`] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC) THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1; REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH]; ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!x. ?r. &0 < r /\ r <= &1 / &2 /\ (x IN s ==> !y. y IN s /\ norm(y - x) < r ==> norm((f:real^M->real^N) y - f x - f' x (y - x)) <= d * norm(y - x))` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN UNDISCH_THEN `!x. x IN s ==> ((f:real^M->real^N) has_derivative f' x) (at x within s)` (MP_TAC o REWRITE_RULE[HAS_DERIVATIVE_WITHIN_ALT]) THEN ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `d:real`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min r (&1 / &2)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LE; REAL_LE_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `r:real^M->real` THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(LABEL_TAC "*")] THEN MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`; `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; ALL_TAC] THEN REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!k:real^M->bool. k IN D ==> ?t. measurable(t) /\ IMAGE (f:real^M->real^N) (k INTER s) SUBSET t /\ measure t <= e / &(2 * c) pow (dimindex(:M)) * measure(k)` MP_TAC THENL [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?x:real^M. x IN (s INTER interval[u,v]) /\ interval[u,v] SUBSET ball(x,r x)` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTER]] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`IMAGE ((f':real^M->real^M->real^N) x) (:real^M)`; `(f:real^M->real^N) x`; `d * norm(v - u:real^M)`; `(&2 * B) * norm(v - u:real^M)`] lemma) THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN MP_TAC(ISPEC `matrix ((f':real^M->real^M->real^N) x)` RANK_DIM_IM) THEN ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_INTER; EXISTS_IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_BALL; SUBSET; NORM_SUB; dist]; ALL_TAC] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC(NORM_ARITH `norm(z) <= B /\ d <= B ==> norm(y - x - z:real^N) <= d ==> norm(y - x) <= &2 * B`) THEN CONJ_TAC THENL [MP_TAC(ISPEC `(f':real^M->real^M->real^N) x` ONORM) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `y - x:real^M` o CONJUNCT1) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[ONORM_POS_LE; NORM_POS_LE]; MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]]; DISCH_THEN(fun th -> EXISTS_TAC `y - x:real^M` THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ]] THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL])) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_ARITH `&2 * (&2 * B) * n = (&4 * B) * n`] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_POW_MUL] THEN SIMP_TAC[REAL_ARITH `(&2 * d * n) * a * b = d * &2 * a * (n * b)`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e / &(2 * c) pow (dimindex(:M)) / (&(dimindex(:M)) pow dimindex(:M)) * norm(v - u:real^M) pow dimindex(:N)` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(v - u:real^M) pow dimindex(:M)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN SUBGOAL_THEN `u IN ball(x:real^M,r x) /\ v IN ball(x,r x)` MP_TAC THENL [ASM_MESON_TAC[SUBSET; ENDS_IN_INTERVAL; INTERIOR_EMPTY]; REWRITE_TAC[IN_BALL] THEN SUBGOAL_THEN `(r:real^M->real) x <= &1 / &2` MP_TAC THENL [ASM_REWRITE_TAC[]; CONV_TAC NORM_ARITH]]; REMOVE_THEN "*" (K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M`; `v:real^M`]) THEN ASM_REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_OF_NUM_MUL] THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(sum(1..dimindex(:M)) (\i. abs((v - u:real^M)$i))) pow (dimindex(:M))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE2 THEN SIMP_TAC[NORM_POS_LE; NORM_LE_L1]; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2] THEN ASM_SIMP_TAC[SUM_CONST_NUMSEG; PRODUCT_CONST_NUMSEG; VECTOR_SUB_COMPONENT; ADD_SUB] THEN REWRITE_TAC[REAL_POW_MUL; REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[REAL_ABS_REFL] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2]]]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:(real^M->bool)->(real^N->bool)` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (g:(real^M->bool)->(real^N->bool)) D)` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum D' (\k:real^M->bool. e / &(2 * c) pow (dimindex(:M)) * measure k)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUM_LMUL] THEN REWRITE_TAC[REAL_ARITH `e / b * x:real = (e * x) / b`] THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ] THEN MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`] MEASURE_ELEMENTARY) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[division_of] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `y = z /\ x <= e ==> x = y ==> z <= e`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(interval[--(vec c):real^M,vec c])` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS; ASM SET_TAC[]] THEN ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT; REAL_ARITH `x - --x = &2 * x /\ (--x <= x <=> &0 <= &2 * x)`] THEN ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_LT_IMP_LE] THEN REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB; REAL_LE_REFL]]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `s = UNIONS {{x | x IN s /\ norm(x:real^M) <= &n /\ onorm((f':real^M->real^M->real^N) x) <= &n} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_MAX_LE; REAL_ARCH_SIMPLE]; REWRITE_TAC[IMAGE_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC semma THEN MAP_EVERY EXISTS_TAC [`f':real^M->real^M->real^N`; `&n + &1:real`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(vec 0:real^M,&n)` THEN SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `x <= n ==> x <= n + &1`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_DERIVATIVE_WITHIN_SUBSET)) THEN SET_TAC[]]]);; let BABY_SARD_ALT = prove (`!f:real^M->real^N s. dimindex(:M) <= dimindex(:N) /\ (!x. x IN s ==> ?f'. (f has_derivative f') (at x within s) /\ rank(matrix f') < dimindex (:N)) ==> negligible(IMAGE f s)`, REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BABY_SARD THEN ASM_MESON_TAC[]);; let NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE_GEN = prove (`!f:real^N->real^N s. (!y. compact {x | x IN s /\ f x = y}) /\ negligible (IMAGE f {x | x IN s /\ ~(f differentiable (at x within s))}) ==> negligible {y | INFINITE {x | x IN s /\ f x = y}}`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`f:real^N->real^N`; `{x | x IN s /\ ?f'. (f has_derivative f') (at x within s) /\ ~invertible(matrix f':real^N^N)}`] BABY_SARD_ALT) THEN REWRITE_TAC[IN_ELIM_THM; LE_REFL] THEN ANTS_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM DET_EQ_0_RANK; INVERTIBLE_DET_NZ] THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_DERIVATIVE_WITHIN_SUBSET) THEN REWRITE_TAC[SUBSET_RESTRICT]; REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; INFINITE] THEN X_GEN_TAC `y:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM; IN_UNION; SET_RULE `~(y IN IMAGE f s) <=> (!x. f x = y ==> ~(x IN s))`] THEN REWRITE_TAC[IN_ELIM_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN REWRITE_TAC[GSYM IMP_CONJ_ALT; differentiable] THEN REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[MESON[] `~(?x. P x /\ Q x) /\ (?x. P x) <=> (?x. P x /\ ~Q x) /\ (!x. P x ==> ~Q x)`] THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; RIGHT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f':real^N->real^N->real^N` THEN STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_FINITE_PREIMAGES_GEN THEN EXISTS_TAC `f':real^N->real^N->real^N` THEN ASM_SIMP_TAC[GSYM INVERTIBLE_DET_NZ]);; let NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE = prove (`!f:real^N->real^N s. f continuous_on s /\ compact s /\ negligible (IMAGE f {x | x IN s /\ ~(f differentiable (at x within s))}) ==> negligible {y | INFINITE {x | x IN s /\ f x = y}}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE_GEN THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CLOSED_IN_COMPACT)) THEN ONCE_REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_SING]);; let NEGLIGIBLE_INFINITE_PREIMAGES_DIFFERENTIABLE = prove (`!f:real^N->real^N s. compact s /\ f differentiable_on s ==> negligible {y | INFINITE {x | x IN s /\ f(x) = y}}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE THEN ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN RULE_ASSUM_TAC(REWRITE_RULE[differentiable_on]) THEN REWRITE_TAC[TAUT `p /\ ~q <=> ~(p ==> q)`] THEN ASM_REWRITE_TAC[EMPTY_GSPEC; IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Also negligibility of BV low-dimensional image. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL = prove (`!f:real^1->real^N s. 2 <= dimindex(:N) /\ f has_bounded_variation_on s /\ is_interval s ==> negligible(IMAGE f s)`, let lemma = prove (`!f:real^1->real^N a b. 2 <= dimindex(:N) /\ f has_bounded_variation_on interval[a,b] ==> negligible(IMAGE f (interval[a,b]))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACTOR_THROUGH_VARIATION) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `IMAGE (f:real^1->real^N) (interval[a,b]) = IMAGE g { lift(vector_variation (interval[a,u]) f) | u | u IN interval[a,b]}` SUBST1_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE_LOWDIM THEN ASM_REWRITE_TAC[DIMINDEX_1; ARITH_RULE `1 < n <=> 2 <= n`] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`(:real^1)`; `&1`] THEN ASM_SIMP_TAC[GSYM dist; REAL_MUL_LID; IN_INTER; IN_UNIV; OPEN_UNIV]]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^1->real^N) (closure s INTER UNIONS {interval[--vec n,vec n] | n IN (:num)})` THEN CONJ_TAC THENL [REWRITE_TAC[INTER_UNIONS; IMAGE_UNIONS] THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; o_THM] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(ISPEC `closure s INTER interval[--vec n:real^1,vec n]` IS_INTERVAL_COMPACT) THEN SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_INTERVAL; CLOSED_CLOSURE] THEN RULE_ASSUM_TAC(REWRITE_RULE[IS_INTERVAL_CONVEX_1]) THEN ASM_SIMP_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CLOSURE; CONVEX_INTER; CONVEX_INTERVAL; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN EXISTS_TAC `closure s:real^1->bool` THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_CLOSURE; IS_INTERVAL_CONVEX_1] THEN ASM SET_TAC[]; MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN MATCH_MP_TAC(SET_RULE `(!x. ?n. x IN f n) ==> s SUBSET UNIONS {f n | n IN UNIV}`) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; GSYM REAL_ABS_BOUNDS] THEN REWRITE_TAC[GSYM FORALL_DROP; DROP_VEC; REAL_ARCH_SIMPLE]]);; let NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE_LOWDIM = prove (`!f:real^1->real^N s. 2 <= dimindex(:N) /\ f absolutely_continuous_on s /\ is_interval s ==> negligible(IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_EXTENDS_TO_CLOSURE)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^1->real^N) (closure s INTER UNIONS {interval[--vec n,vec n] | n IN (:num)})` THEN CONJ_TAC THENL [REWRITE_TAC[INTER_UNIONS; IMAGE_UNIONS] THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; o_THM] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(ISPEC `closure s INTER interval[--vec n:real^1,vec n]` IS_INTERVAL_COMPACT) THEN SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_INTERVAL; CLOSED_CLOSURE] THEN RULE_ASSUM_TAC(REWRITE_RULE[IS_INTERVAL_CONVEX_1]) THEN ASM_SIMP_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CLOSURE; CONVEX_INTER; CONVEX_INTERVAL; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `closure s:real^1->bool` THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> g x = f x) /\ s SUBSET c /\ u = UNIV ==> IMAGE f s SUBSET IMAGE g (c INTER u)`) THEN ASM_REWRITE_TAC[CLOSURE_SUBSET; UNIONS_GSPEC; EXTENSION] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; GSYM REAL_ABS_BOUNDS] THEN REWRITE_TAC[GSYM FORALL_DROP; DROP_VEC; REAL_ARCH_SIMPLE]]);; let NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE = prove (`!g:real^1->real^N. 2 <= dimindex(:N) /\ rectifiable_path g ==> negligible(path_image g)`, REWRITE_TAC[rectifiable_path; path_image] THEN SIMP_TAC[NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL; IS_INTERVAL_INTERVAL]);; let INTERIOR_RECTIFIABLE_PATH_IMAGE = prove (`!g:real^1->real^N. 2 <= dimindex(:N) /\ rectifiable_path g ==> interior(path_image g) = {}`, MESON_TAC[NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE; NEGLIGIBLE_EMPTY_INTERIOR]);; (* ------------------------------------------------------------------------- *) (* Properties of Lebesgue measurable sets. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_INDICATOR = prove (`!s t. indicator t measurable_on s <=> lebesgue_measurable(s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[lebesgue_measurable] THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[indicator; IN_UNIV; IN_INTER] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]);; let MEASURABLE_ON_INDICATOR_SUBSET = prove (`!s t:real^N->bool. t SUBSET s ==> (indicator t measurable_on s <=> lebesgue_measurable t)`, SIMP_TAC[MEASURABLE_ON_INDICATOR; SET_RULE `t SUBSET s ==> s INTER t = t`]);; let MEASURABLE_IMP_LEBESGUE_MEASURABLE = prove (`!s:real^N->bool. measurable s ==> lebesgue_measurable s`, REPEAT STRIP_TAC THEN REWRITE_TAC[lebesgue_measurable] THEN MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN ASM_REWRITE_TAC[indicator; GSYM MEASURABLE_INTEGRABLE]);; let NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE = prove (`!s:real^N->bool. negligible s ==> lebesgue_measurable s`, SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; let LEBESGUE_MEASURABLE_EMPTY = prove (`lebesgue_measurable {}`, SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_EMPTY]);; let LEBESGUE_MEASURABLE_UNIV = prove (`lebesgue_measurable (:real^N)`, REWRITE_TAC[lebesgue_measurable; indicator; IN_UNIV; MEASURABLE_ON_CONST]);; let LEBESGUE_MEASURABLE_COMPACT = prove (`!s:real^N->bool. compact s ==> lebesgue_measurable s`, SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_COMPACT]);; let LEBESGUE_MEASURABLE_BALL = prove (`!a:real^N r. lebesgue_measurable(ball(a,r))`, SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_BALL]);; let LEBESGUE_MEASURABLE_CBALL = prove (`!a:real^N r. lebesgue_measurable(cball(a,r))`, SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_CBALL]);; let LEBESGUE_MEASURABLE_INTERVAL = prove (`(!a b:real^N. lebesgue_measurable(interval[a,b])) /\ (!a b:real^N. lebesgue_measurable(interval(a,b)))`, SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_INTERVAL]);; let LEBESGUE_MEASURABLE_INTER = prove (`!s t:real^N->bool. lebesgue_measurable s /\ lebesgue_measurable t ==> lebesgue_measurable(s INTER t)`, REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_INTER]);; let LEBESGUE_MEASURABLE_UNION = prove (`!s t:real^N->bool. lebesgue_measurable s /\ lebesgue_measurable t ==> lebesgue_measurable(s UNION t)`, REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_UNION]);; let LEBESGUE_MEASURABLE_DIFF = prove (`!s t:real^N->bool. lebesgue_measurable s /\ lebesgue_measurable t ==> lebesgue_measurable(s DIFF t)`, REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_DIFF]);; let LEBESGUE_MEASURABLE_COMPL = prove (`!s. lebesgue_measurable((:real^N) DIFF s) <=> lebesgue_measurable s`, MESON_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_UNIV; COMPL_COMPL]);; let LEBESGUE_MEASURABLE_ON_SUBINTERVALS = prove (`!s. lebesgue_measurable s <=> !a b:real^N. lebesgue_measurable(s INTER interval[a,b])`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_INTER] THEN REWRITE_TAC[lebesgue_measurable] THEN DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; indicator; IN_INTER] THEN MESON_TAC[]; REPEAT STRIP_TAC THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop] THEN REAL_ARITH_TAC]);; let LEBESGUE_MEASURABLE_CLOSED = prove (`!s:real^N->bool. closed s ==> lebesgue_measurable s`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN ASM_SIMP_TAC[CLOSED_INTER_COMPACT; LEBESGUE_MEASURABLE_COMPACT; COMPACT_INTERVAL]);; let LEBESGUE_MEASURABLE_OPEN = prove (`!s:real^N->bool. open s ==> lebesgue_measurable s`, REWRITE_TAC[OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED]);; let LEBESGUE_MEASURABLE_OPEN_IN = prove (`!s t:real^N->bool. open_in (subtopology euclidean s) t /\ lebesgue_measurable s ==> lebesgue_measurable t`, MESON_TAC[OPEN_IN_OPEN; LEBESGUE_MEASURABLE_OPEN; LEBESGUE_MEASURABLE_INTER]);; let LEBESGUE_MEASURABLE_CLOSED_IN = prove (`!s t:real^N->bool. closed_in (subtopology euclidean s) t /\ lebesgue_measurable s ==> lebesgue_measurable t`, MESON_TAC[CLOSED_IN_CLOSED; LEBESGUE_MEASURABLE_CLOSED; LEBESGUE_MEASURABLE_INTER]);; let LEBESGUE_MEASURABLE_UNIONS = prove (`!f. FINITE f /\ (!s. s IN f ==> lebesgue_measurable s) ==> lebesgue_measurable (UNIONS f)`, REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_UNIONS]);; let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS = prove (`!f:(real^N->bool)->bool. COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s) ==> lebesgue_measurable (UNIONS f)`, REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_COUNTABLE_UNIONS]);; let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT = prove (`!s:num->real^N->bool. (!n. lebesgue_measurable(s n)) ==> lebesgue_measurable(UNIONS {s n | n IN (:num)})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV; NUM_COUNTABLE]);; let LEBESGUE_MEASURABLE_COUNTABLE_INTERS = prove (`!f:(real^N->bool)->bool. COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s) ==> lebesgue_measurable (INTERS f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERS_UNIONS; LEBESGUE_MEASURABLE_COMPL] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; LEBESGUE_MEASURABLE_COMPL]);; let LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT = prove (`!s:num->real^N->bool. (!n. lebesgue_measurable(s n)) ==> lebesgue_measurable(INTERS {s n | n IN (:num)})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]);; let LEBESGUE_MEASURABLE_INTERS = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> lebesgue_measurable s) ==> lebesgue_measurable (INTERS f)`, SIMP_TAC[LEBESGUE_MEASURABLE_COUNTABLE_INTERS; FINITE_IMP_COUNTABLE]);; let GDELTA_IMP_LEBESGUE_MEASURABLE = prove (`!s:real^N->bool. gdelta s ==> lebesgue_measurable s`, GEN_TAC THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_OPEN]);; let FSIGMA_IMP_LEBESGUE_MEASURABLE = prove (`!s:real^N->bool. fsigma s ==> lebesgue_measurable s`, GEN_TAC THEN REWRITE_TAC[fsigma; UNION_OF] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED]);; let BOREL_IMP_LEBESGUE_MEASURABLE = prove (`!s:real^N->bool. borel s ==> lebesgue_measurable s`, MATCH_MP_TAC borel_INDUCT THEN REWRITE_TAC[LEBESGUE_MEASURABLE_OPEN; LEBESGUE_MEASURABLE_COMPL] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COUNTABLE_UNIONS]);; let LEBESGUE_MEASURABLE_IFF_MEASURABLE = prove (`!s:real^N->bool. bounded s ==> (lebesgue_measurable s <=> measurable s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN REWRITE_TAC[lebesgue_measurable; indicator; MEASURABLE_INTEGRABLE] THEN SUBGOAL_THEN `?a b:real^N. s = s INTER interval[a,b]` (REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THENL [REWRITE_TAC[SET_RULE `s = s INTER t <=> s SUBSET t`] THEN ASM_MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[IN_INTER; MESON[] `(if P x /\ Q x then a else b) = (if Q x then if P x then a else b else b)`] THEN REWRITE_TAC[MEASURABLE_ON_UNIV; INTEGRABLE_RESTRICT_UNIV] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN ASM_REWRITE_TAC[INTEGRABLE_CONST; NORM_REAL; DROP_VEC; GSYM drop] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN SIMP_TAC[DROP_VEC] THEN REAL_ARITH_TAC);; let LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS = prove (`!s:real^N->bool. lebesgue_measurable s <=> (!a b. measurable(s INTER interval[a,b]))`, MESON_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS; LEBESGUE_MEASURABLE_IFF_MEASURABLE; BOUNDED_INTER; BOUNDED_INTERVAL]);; let LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS = prove (`!s:real^N->bool. lebesgue_measurable s <=> (!n. measurable(s INTER interval[--vec n,vec n]))`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS] THEN EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a b:real^N. ?n. s INTER interval[a,b] = ((s INTER interval[--vec n,vec n]) INTER interval[a,b])` (fun th -> ASM_MESON_TAC[th; MEASURABLE_INTERVAL; MEASURABLE_INTER]) THEN REPEAT GEN_TAC THEN MP_TAC(ISPECL [`interval[a:real^N,b]`; `vec 0:real^N`] BOUNDED_SUBSET_CBALL) THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `i SUBSET b ==> b SUBSET n ==> s INTER i = (s INTER n) INTER i`)) THEN REWRITE_TAC[SUBSET; IN_CBALL_0; IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT; GSYM REAL_ABS_BOUNDS] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);; let MEASURABLE_ON_MEASURABLE_SUBSET = prove (`!f s t. s SUBSET t /\ f measurable_on t /\ measurable s ==> f measurable_on s`, MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; let LEBESGUE_MEASURABLE_JORDAN = prove (`!s:real^N->bool. negligible(frontier s) ==> lebesgue_measurable s`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN MATCH_MP_TAC MEASURABLE_JORDAN THEN SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `frontier s UNION frontier(interval[a:real^N,b])` THEN ASM_REWRITE_TAC[FRONTIER_INTER_SUBSET; NEGLIGIBLE_UNION_EQ] THEN SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_INTERVAL]);; let LEBESGUE_MEASURABLE_CONVEX = prove (`!s:real^N->bool. convex s ==> lebesgue_measurable s`, SIMP_TAC[LEBESGUE_MEASURABLE_JORDAN; NEGLIGIBLE_CONVEX_FRONTIER]);; let LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF = prove (`!s t:real^N->bool. lebesgue_measurable s /\ negligible((s DIFF t) UNION (t DIFF s)) ==> lebesgue_measurable t`, REPEAT STRIP_TAC THEN SUBST1_TAC(SET_RULE `t:real^N->bool = (s DIFF (s DIFF t)) UNION (t DIFF s)`) THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN CONJ_TAC THENL [MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);; let LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ = prove (`!s t:real^N->bool. negligible(s DIFF t UNION t DIFF s) ==> (lebesgue_measurable s <=> lebesgue_measurable t)`, MESON_TAC[LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF; UNION_COMM]);; let LEBESGUE_MEASURABLE_INSERT = prove (`!s a:real^N. lebesgue_measurable(a INSERT s) <=> lebesgue_measurable s`, REPEAT GEN_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{a:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; let LEBESGUE_MEASURABLE_DELETE = prove (`!s a:real^N. lebesgue_measurable(s DELETE a) <=> lebesgue_measurable s`, REPEAT GEN_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{a:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; let ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER = prove (`!f:real^M->real^N s t. f absolutely_integrable_on s /\ lebesgue_measurable t ==> f absolutely_integrable_on (s INTER t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\x. lift(norm(if x IN s then (f:real^M->real^N) x else vec 0))` THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; IN_UNIV; IN_INTER; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[MESON[] `(if p /\ q then x else y) = if q then if p then x else y else y`] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_CASES THEN ASM_REWRITE_TAC[SET_RULE `{x | x IN s} = s`; MEASURABLE_ON_0] THEN ASM_SIMP_TAC[INTEGRABLE_IMP_MEASURABLE; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_REWRITE_TAC[REAL_LE_REFL; LIFT_DROP; NORM_0; NORM_POS_LE]]);; let ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove (`!f:real^M->real^N s t. f absolutely_integrable_on s /\ t SUBSET s /\ lebesgue_measurable t ==> f absolutely_integrable_on t`, MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER; SET_RULE `s SUBSET t ==> s = t INTER s`]);; (* ------------------------------------------------------------------------- *) (* Invariance theorems for Lebesgue measurability. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_TRANSLATION = prove (`!f:real^M->real^N s a. f measurable_on (IMAGE (\x. a + x) s) ==> (\x. f(a + x)) measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:num->real^M->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (\x:real^M. --a + x) k` THEN EXISTS_TAC `\n. (g:num->real^M->real^N) n o (\x. a + x)` THEN ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; X_GEN_TAC `x:real^M` THEN FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN REWRITE_TAC[o_DEF; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> a + x = y`] THEN REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]);; let MEASURABLE_ON_TRANSLATION_EQ = prove (`!f:real^M->real^N s a. (\x. f(a + x)) measurable_on s <=> f measurable_on (IMAGE (\x. a + x) s)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_ON_TRANSLATION] THEN MP_TAC(ISPECL [`\x. (f:real^M->real^N) (a + x)`; `IMAGE (\x:real^M. a + x) s`; `--a:real^M`] MEASURABLE_ON_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; ETA_AX; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x /\ a + --a + x = x`]);; let NEGLIGIBLE_LINEAR_IMAGE_GEN = prove (`!f:real^M->real^N s. linear f /\ negligible s /\ dimindex(:M) <= dimindex(:N) ==> negligible (IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]);; let MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN = prove (`!f:real^M->real^N h:real^N->real^P s. dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y) ==> ((h o f) measurable_on s <=> h measurable_on (IMAGE f s))`, let lemma = prove (`!f:real^N->real^P g:real^M->real^N h s. dimindex(:M) = dimindex(:N) /\ linear g /\ linear h /\ (!x. h(g x) = x) /\ (!x. g(h x) = x) ==> (f o g) measurable_on s ==> f measurable_on (IMAGE g s)`, REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` (X_CHOOSE_THEN `G:num->real^M->real^P` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `IMAGE (g:real^M->real^N) k` THEN EXISTS_TAC `\n x. (G:num->real^M->real^P) n ((h:real^N->real^M) x)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_GEN THEN ASM_MESON_TAC[LE_REFL]; GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^N->real^M) y`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[o_THM] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]) in REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; FUN_EQ_THM; o_THM; I_THM] THEN X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `!y:real^N. (f:real^M->real^N) ((g:real^N->real^M) y) = y` ASSUME_TAC THENL [SUBGOAL_THEN `IMAGE (f:real^M->real^N) UNIV = UNIV` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN]; ALL_TAC] THEN EQ_TAC THENL [ASM_MESON_TAC[lemma]; DISCH_TAC] THEN MP_TAC(ISPECL [`(h:real^N->real^P) o (f:real^M->real^N)`; `g:real^N->real^M`; `f:real^M->real^N`; `IMAGE (f:real^M->real^N) s`] lemma) THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[]);; let MEASURABLE_ON_LINEAR_IMAGE_EQ = prove (`!f:real^N->real^N h:real^N->real^P s. linear f /\ (!x y. f x = f y ==> x = y) ==> ((h o f) measurable_on s <=> h measurable_on (IMAGE f s))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN THEN ASM_MESON_TAC[]);; let LEBESGUE_MEASURABLE_TRANSLATION = prove (`!a:real^N s. lebesgue_measurable (IMAGE (\x. a + x) s) <=> lebesgue_measurable s`, ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN SIMP_TAC[LEBESGUE_MEASURABLE_IFF_MEASURABLE; BOUNDED_INTER; BOUNDED_INTERVAL] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [LEBESGUE_MEASURABLE_TRANSLATION];; let LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (lebesgue_measurable (IMAGE f s) <=> lebesgue_measurable s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN REWRITE_TAC[lebesgue_measurable] THEN MP_TAC(ISPECL [`g:real^N->real^N`; `indicator(s:real^N->bool)`; `(:real^N)`] MEASURABLE_ON_LINEAR_IMAGE_EQ) THEN ASM_REWRITE_TAC[indicator; o_DEF] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC EQ_IMP] THEN BINOP_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; AP_TERM_TAC THEN ASM SET_TAC[]]);; add_linear_invariants [LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ];; let MEASURABLE_ON_REFLECT = prove (`!f:real^M->real^N s. (\x. f(--x)) measurable_on s <=> f measurable_on (IMAGE (--) s)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC MEASURABLE_ON_LINEAR_IMAGE_EQ THEN REWRITE_TAC[linear] THEN CONV_TAC VECTOR_ARITH);; (* ------------------------------------------------------------------------- *) (* Various common equivalent forms of function measurability. *) (* ------------------------------------------------------------------------- *) let (MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT, MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT) = (CONJ_PAIR o prove) (`(!f:real^M->real^N. f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | f(x)$k < a}) /\ (!f:real^M->real^N. f measurable_on (:real^M) <=> ?g. (!n. (g n) measurable_on (:real^M)) /\ (!n. FINITE(IMAGE (g n) (:real^M))) /\ (!x. ((\n. g n x) --> f x) sequentially))`, let lemma0 = prove (`!f:real^M->real^1 n m. integer m /\ m / &2 pow n <= drop(f x) /\ drop(f x) < (m + &1) / &2 pow n /\ abs(m) <= &2 pow (2 * n) ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x) = lift(m / &2 pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum {m} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x)` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in let lemma1 = prove (`!f:real^M->real^1. (!a b. lebesgue_measurable {x | a <= drop(f x) /\ drop(f x) < b}) ==> ?g. (!n. (g n) measurable_on (:real^M)) /\ (!n. FINITE(IMAGE (g n) (:real^M))) /\ (!x. ((\n. g n x) --> f x) sequentially)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN ASM_REWRITE_TAC[GSYM lebesgue_measurable; ETA_AX]; X_GEN_TAC `n:num` THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\k. lift(k / &2 pow n)) {k | integer k /\ abs(k) <= &2 pow (2 * n)}` THEN CONJ_TAC THENL [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_IMAGE] THEN ASM_CASES_TAC `?k. integer k /\ abs k <= &2 pow (2 * n) /\ k / &2 pow n <= drop(f(x:real^M)) /\ drop(f x) < (k + &1) / &2 pow n` THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC lemma0 THEN ASM_REWRITE_TAC[]; EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[IN_ELIM_THM; INTEGER_CLOSED; REAL_ABS_NUM] THEN SIMP_TAC[REAL_POW_LE; REAL_POS; real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[LIFT_NUM; GSYM real_div] THEN MATCH_MP_TAC VSUM_EQ_0 THEN X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN REWRITE_TAC[indicator; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MP_TAC(ISPECL [`&2`; `abs(drop((f:real^M->real^1) x))`] REAL_ARCH_POW) THEN ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN REWRITE_TAC[REAL_POW_INV] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^M)))` THEN SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^M->real^1) x) < e` MP_TAC THENL [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ; REAL_OF_NUM_EQ; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e * &2 pow N2` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; MATCH_MP_TAC(NORM_ARITH `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN MATCH_MP_TAC lemma0 THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE; INTEGER_CLOSED] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> e <= d ==> x <= d`))] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC]) in MATCH_MP_TAC(MESON[] `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f) ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN ABBREV_TAC `f:real^M->real^N = \x. --(g x)` THEN SUBGOAL_THEN `(f:real^M->real^N) measurable_on (:real^M)` ASSUME_TAC THENL [EXPAND_TAC "f" THEN MATCH_MP_TAC MEASURABLE_ON_NEG THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG2] THEN X_GEN_TAC `a:real` THEN SPEC_TAC(`--a:real`,`a:real`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN DISCH_THEN(K ALL_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o GEN_REWRITE_RULE I [MEASURABLE_ON_COMPONENTWISE]) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC(GEN `d:real` (ISPECL [`\x. lift ((f:real^M->real^N) x$k)`; `(\x. lift a + (lambda i. d)):real^M->real^1`; `(:real^M)`] MEASURABLE_ON_MIN)) THEN ASM_REWRITE_TAC[MEASURABLE_ON_CONST] THEN DISCH_THEN(fun th -> MP_TAC(GEN `n:num` (ISPEC `&n + &1` (MATCH_MP MEASURABLE_ON_CMUL (MATCH_MP MEASURABLE_ON_SUB (CONJ (SPEC `inv(&n + &1)` th) (SPEC `&0` th))))))) THEN REWRITE_TAC[lebesgue_measurable; indicator] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_LIMIT)) THEN EXISTS_TAC `{}:real^M->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY; IN_DIFF; IN_UNIV; NOT_IN_EMPTY] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[LIM_SEQUENTIALLY; DIST_REAL; VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; LAMBDA_BETA; DIMINDEX_1; ARITH] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_ADD_RID] THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; REAL_ARITH `&0 < d ==> (min x (a + d) - min x a = if x <= a then &0 else if x <= a + d then x - a else d)`] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_CASES_TAC `a < (f:real^M->real^N) x $k` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[REAL_ARITH `(x:real^N)$k <= a <=> ~(a < x$k)`] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN MP_TAC(SPEC `((f:real^M->real^N) x)$k - a` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `a + inv(&n + &1) < ((f:real^M->real^N) x)$k` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `N < f - a ==> n <= N ==> a + n < f`)) THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ARITH `~(&n + &1 = &0)`] THEN ASM_REAL_ARITH_TAC]; REPEAT STRIP_TAC THEN SUBGOAL_THEN `!k. 1 <= k /\ k <= dimindex(:N) ==> ?g. (!n. (g n) measurable_on (:real^M)) /\ (!n. FINITE(IMAGE (g n) (:real^M))) /\ (!x. ((\n. g n x) --> lift((f x:real^N)$k)) sequentially)` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN ASM_SIMP_TAC[LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | Q x} DIFF {x | ~P x}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN ASM_SIMP_TAC[REAL_NOT_LE]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->num->real^M->real^1` MP_TAC) THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN EXISTS_TAC `\n x. (lambda k. drop((g:num->num->real^M->real^1) k n x)):real^N` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]; X_GEN_TAC `n:num` THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> lift(x$i) IN IMAGE (g i (n:num)) (:real^M)}` THEN ASM_SIMP_TAC[GSYM IN_IMAGE_LIFT_DROP; SET_RULE `{x | x IN s} = s`; FINITE_IMAGE; FINITE_CART] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN SIMP_TAC[IN_IMAGE; IN_UNIV; LAMBDA_BETA; DROP_EQ] THEN MESON_TAC[]; X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]; X_GEN_TAC `f:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC [`g:num->real^M->real^N`; `{}:real^M->bool`] THEN ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY]]);; let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | f(x)$k >= a}`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x >= a <=> ~(x < a)`] THEN REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]);; let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | f(x)$k > a}`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN GEN_REWRITE_TAC LAND_CONV [MESON[REAL_NEG_NEG] `(!x. P x) <=> (!x:real. P(--x))`] THEN REWRITE_TAC[real_gt; VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);; let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | f(x)$k <= a}`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x <= a <=> ~(x > a)`] THEN REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]);; let (MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL, MEASURABLE_ON_PREIMAGE_OPEN) = (CONJ_PAIR o prove) (`(!f:real^M->real^N. f measurable_on (:real^M) <=> !a b. lebesgue_measurable {x | f(x) IN interval(a,b)}) /\ (!f:real^M->real^N. f measurable_on (:real^M) <=> !t. open t ==> lebesgue_measurable {x | f(x) IN t})`, let ulemma = prove (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in MATCH_MP_TAC(MESON[] `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f) ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x | (f:real^M->real^N) x IN interval(a,b)} = INTERS {{x | a$k < f(x)$k} | k IN 1..dimindex(:N)} INTER INTERS {{x | (--b)$k < --(f(x))$k} | k IN 1..dimindex(:N)}` SUBST1_TAC THENL [REWRITE_TAC[IN_INTERVAL; GSYM IN_NUMSEG] THEN REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_LT_NEG2] THEN REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]; MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]); FIRST_X_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]] THEN ASM_SIMP_TAC[real_gt]]; REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_OPEN_INTERVALS) THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM]; REPEAT STRIP_TAC THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x:real^M | (f x)$k < a} = {x | f x IN {y:real^N | y$k < a}}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]]);; let MEASURABLE_ON_PREIMAGE_CLOSED = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !t. closed t ==> lebesgue_measurable {x | f(x) IN t}`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL; closed] THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | f x IN t} = {x | f x IN (UNIV DIFF t)}`] THEN REWRITE_TAC[MESON[COMPL_COMPL] `(!s. P(UNIV DIFF s)) <=> (!s. P s)`] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);; let MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a b. lebesgue_measurable {x | f(x) IN interval[a,b]}`, let ulemma = prove (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED; CLOSED_INTERVAL]; DISCH_TAC] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM]);; let MEASURABLE_ON_PREIMAGE_BOREL = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !t. borel t ==> lebesgue_measurable {x | f x IN t}`, let lemma = prove (`{x | f x IN UNIONS u} = UNIONS {{x | f x IN t} | t IN u}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in GEN_TAC THEN EQ_TAC THENL [DISCH_TAC; MESON_TAC[MEASURABLE_ON_PREIMAGE_OPEN; OPEN_IMP_BOREL]] THEN MATCH_MP_TAC borel_INDUCT THEN ASM_REWRITE_TAC[GSYM MEASURABLE_ON_PREIMAGE_OPEN] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL; lemma; SET_RULE `{x | f x IN UNIV DIFF t} = UNIV DIFF {x | f x IN t}`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE]);; let LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove (`!f:real^M->real^N t. f measurable_on (:real^M) /\ open t ==> lebesgue_measurable {x | f(x) IN t}`, SIMP_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);; let LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove (`!f:real^M->real^N t. f measurable_on (:real^M) /\ closed t ==> lebesgue_measurable {x | f(x) IN t}`, SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED]);; let LEBESGUE_MEASURABLE_PREIMAGE_BOREL = prove (`!f:real^M->real^N t. f measurable_on (:real^M) /\ borel t ==> lebesgue_measurable {x | f(x) IN t}`, SIMP_TAC[MEASURABLE_ON_PREIMAGE_BOREL]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_LE = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k <= (a:real^N)$k}`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | !k. P k ==> f x$k <= a k} = {x | f(x) IN {y | !k. P k ==> y$k <= a k}}`] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_CLOSED]) THEN REWRITE_TAC[CLOSED_INTERVAL_LEFT]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `{x | (f:real^M->real^N) x$k <= a} = UNIONS {{x | !j. 1 <= j /\ j <= dimindex(:N) ==> f x$j <= ((lambda i. if i = k then a else &n):real^N)$j} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN SIMP_TAC[LAMBDA_BETA] THEN SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN GEN_TAC THEN ASM_CASES_TAC `(y:real^N)$k <= a` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `sup {(y:real^N)$j | j IN 1..dimindex(:N)}` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REAL_SUP_LE_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE]]]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_GE = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k >= (a:real^N)$k}`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_ORTHANT_LE] THEN GEN_REWRITE_TAC LAND_CONV [MESON[VECTOR_NEG_NEG] `(!x:real^N. P x) <=> (!x. P(--x))`] THEN REWRITE_TAC[REAL_ARITH `--x <= --y <=> x >= y`; VECTOR_NEG_COMPONENT]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_LT = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k < (a:real^N)$k}`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | !k. P k ==> f x$k < a k} = {x | f(x) IN {y | !k. P k ==> y$k < a k}}`] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_OPEN]) THEN REWRITE_TAC[OPEN_INTERVAL_LEFT]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `{x | (f:real^M->real^N) x$k < a} = UNIONS {{x | !j. 1 <= j /\ j <= dimindex(:N) ==> f x$j < ((lambda i. if i = k then a else &n):real^N)$j} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN SIMP_TAC[LAMBDA_BETA] THEN SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN GEN_TAC THEN ASM_CASES_TAC `(y:real^N)$k < a` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `&1 + sup {(y:real^N)$j | j IN 1..dimindex(:N)}` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_ARITH `&1 + x <= y <=> x <= y - &1`] THEN SIMP_TAC[REAL_SUP_LE_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[REAL_ARITH `x <= y - &1 ==> x < y`]; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE]]]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_GT = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k > (a:real^N)$k}`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_ORTHANT_LT] THEN GEN_REWRITE_TAC LAND_CONV [MESON[VECTOR_NEG_NEG] `(!x:real^N. P x) <=> (!x. P(--x))`] THEN REWRITE_TAC[REAL_ARITH `--x < --y <=> x > y`; VECTOR_NEG_COMPONENT]);; let MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING = prove (`!f:real^N->real^1. f measurable_on (:real^N) /\ (!x. &0 <= drop(f x)) <=> ?g. (!n x. &0 <= drop(g n x) /\ drop(g n x) <= drop(f x)) /\ (!n x. drop(g n x) <= drop(g(SUC n) x)) /\ (!n. (g n) measurable_on (:real^N)) /\ (!n. FINITE(IMAGE (g n) (:real^N))) /\ (!x. ((\n. g n x) --> f x) sequentially)`, let lemma = prove (`!f:real^M->real^1 n m. integer m /\ m / &2 pow n <= drop(f x) /\ drop(f x) < (m + &1) / &2 pow n /\ abs(m) <= &2 pow (2 * n) ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x) = lift(m / &2 pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum {m} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x)` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in REPEAT STRIP_TAC THEN EQ_TAC THENL [STRIP_TAC; DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [GEN_REWRITE_TAC RAND_CONV [MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; MESON_TAC[REAL_LE_TRANS]]] THEN SUBGOAL_THEN `!a b. lebesgue_measurable {x:real^N | a <= drop(f x) /\ drop(f x) < b}` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | Q x} DIFF {x | ~P x}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN REWRITE_TAC[REAL_NOT_LE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]) THEN SIMP_TAC[drop; FORALL_1; DIMINDEX_1]; FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [measurable_on])] THEN REWRITE_TAC[FORALL_AND_THM; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `(!x. P x /\ R x ==> Q x) /\ (?x. P x /\ R x) ==> (?x. P x /\ Q x /\ R x)`) THEN CONJ_TAC THENL [X_GEN_TAC `g:num->real^N->real^1` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY] o SPEC `x:real^N`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `drop((g:num->real^N->real^1) n x - f x)`) THEN ASM_REWRITE_TAC[DROP_SUB; REAL_SUB_LT; NOT_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN DISCH_THEN(MP_TAC o SPEC `N + n:num`) THEN REWRITE_TAC[LE_ADD; DIST_REAL; GSYM drop] THEN MATCH_MP_TAC(REAL_ARITH `f < g /\ g <= g' ==> ~(abs(g' - f) < g - f)`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ARITH_RULE `n:num <= N + n`) THEN SPEC_TAC(`N + n:num`,`m:num`) THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} (\k. k / &2 pow n % indicator {y:real^N | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x)` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!n. FINITE {k | integer k /\ abs k <= &2 pow (2 * n)}` ASSUME_TAC THENL [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[VSUM_REAL; LIFT_DROP; o_DEF] THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN REWRITE_TAC[DROP_CMUL] THEN ASM_CASES_TAC `&0 <= k` THENL [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN REWRITE_TAC[DROP_INDICATOR_POS_LE]; MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &0 <= x`) THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; REAL_MUL_LZERO; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC]; REPEAT GEN_TAC THEN SIMP_TAC[VSUM_REAL; LIFT_DROP; o_DEF; DROP_CMUL] THEN TRANS_TAC REAL_LE_TRANS `sum {k | integer k /\ abs(k) <= &2 pow (2 * n)} (\k. k / &2 pow n * (drop(indicator {y:real^N | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1 / &2) / &2 pow n} x) + drop(indicator {y:real^N | (k + &1 / &2) / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[indicator; IN_ELIM_THM] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `x / y = (&2 * x) * inv(&2) * inv(y)`] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow); REAL_ARITH `&2 * (k + &1 / &2) = &2 * k + &1`; REAL_ARITH `&2 * (k + &1) = (&2 * k + &1) + &1`] THEN ASM_SIMP_TAC[REAL_ADD_LDISTRIB; SUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `!g. sum s f <= sum s g /\ a + sum s g <= b ==> a + sum s f <= b`) THEN EXISTS_TAC `\k. (&2 * k + &1) / &2 pow SUC n * drop (indicator {y | (&2 * k + &1) / &2 pow SUC n <= drop ((f:real^N->real^1) y) /\ drop (f y) < ((&2 * k + &1) + &1) / &2 pow SUC n} x)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[DROP_INDICATOR_POS_LE; REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `\x. &2 * x` SUM_IMAGE) THEN MP_TAC(ISPEC `\x. &2 * x + &1` SUM_IMAGE) THEN REWRITE_TAC[REAL_EQ_ADD_RCANCEL; REAL_EQ_MUL_LCANCEL] THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH; IMP_CONJ; o_DEF] THEN REPEAT(DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th])) THEN W(MP_TAC o PART_MATCH (rand o rand) SUM_UNION o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE; SET_RULE `DISJOINT (IMAGE f s) (IMAGE g s) <=> !x. x IN s ==> !y. y IN s ==> ~(f x = g y)`] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `i:real` THEN STRIP_TAC THEN X_GEN_TAC `j:real` THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&2 * x = &2 * y + &1 ==> &2 * abs(x - y) = &1`)) THEN SUBGOAL_THEN `integer(i - j)` MP_TAC THENL [ASM_SIMP_TAC[INTEGER_CLOSED]; REWRITE_TAC[integer]] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; ARITH]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> x IN u) /\ (!x. x IN t ==> x IN u) ==> !x. x IN (s UNION t) DIFF u ==> P x`) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN SIMP_TAC[INTEGER_CLOSED; ARITH_RULE `2 * SUC n = 2 + 2 * n`] THEN REWRITE_TAC[REAL_POW_ADD] THEN CONJ_TAC THENL [REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= n /\ &1 <= n ==> abs(&2 * x + &1) <= &2 pow 2 * n`) THEN ASM_REWRITE_TAC[REAL_LE_POW2]; X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_DIFF] THEN STRIP_TAC THEN REWRITE_TAC[DROP_CMUL] THEN ASM_CASES_TAC `&0 <= k` THENL [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN REWRITE_TAC[DROP_INDICATOR_POS_LE]; MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &0 <= x`) THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; REAL_MUL_LZERO; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC]]; X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN ASM_REWRITE_TAC[GSYM lebesgue_measurable; ETA_AX]; X_GEN_TAC `n:num` THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\k. lift(k / &2 pow n)) {k | integer k /\ abs(k) <= &2 pow (2 * n)}` THEN CONJ_TAC THENL [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_IMAGE] THEN ASM_CASES_TAC `?k. integer k /\ abs k <= &2 pow (2 * n) /\ k / &2 pow n <= drop(f(x:real^N)) /\ drop(f x) < (k + &1) / &2 pow n` THENL [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[]; EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[IN_ELIM_THM; INTEGER_CLOSED; REAL_ABS_NUM] THEN SIMP_TAC[REAL_POW_LE; REAL_POS; real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[LIFT_NUM; GSYM real_div] THEN MATCH_MP_TAC VSUM_EQ_0 THEN X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN REWRITE_TAC[indicator; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MP_TAC(ISPECL [`&2`; `abs(drop((f:real^N->real^1) x))`] REAL_ARCH_POW) THEN ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN REWRITE_TAC[REAL_POW_INV] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^N)))` THEN SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^N->real^1) x) < e` MP_TAC THENL [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ; REAL_OF_NUM_EQ; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e * &2 pow N2` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; MATCH_MP_TAC(NORM_ARITH `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN MATCH_MP_TAC lemma THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE; INTEGER_CLOSED] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> e <= d ==> x <= d`))] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Some "iff" variants of integrability on subsets. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ, ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ = (CONJ_PAIR o prove) (`(!f:real^M->real^N s. f absolutely_integrable_on s <=> f measurable_on s /\ !t. t SUBSET s /\ lebesgue_measurable t ==> f integrable_on t) /\ (!f:real^M->real^N s. f absolutely_integrable_on s <=> f measurable_on s /\ !g. g measurable_on s /\ bounded(IMAGE g s) ==> (\x. drop(g x) % f x) integrable_on s)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV o LAND_CONV) [MEASURABLE_ON_COMPONENTWISE] THEN ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE; INTEGRABLE_COMPONENTWISE] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC(MESON[] `(!i. P i ==> R i) /\ (!i. R i ==> Q i) /\ (!i. Q i ==> P i) ==> ((!i. P i) <=> (!i. Q i)) /\ ((!i. P i) <=> (!i. R i))`) THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; LIFT_CMUL] THEN ABBREV_TAC `h x = lift((f:real^M->real^N) x$i)` THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[ETA_AX] THEN SPEC_TAC(`h:real^M->real^1`,`f:real^M->real^1`) THEN GEN_TAC THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE] THEN ASM_CASES_TAC `(f:real^M->real^1) measurable_on s` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. B % lift(norm((f:real^M->real^1) x))` THEN REWRITE_TAC[NORM_MUL; GSYM NORM_1; DROP_CMUL; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE] THEN ASM_SIMP_TAC[INTEGRABLE_CMUL; MEASURABLE_ON_MUL; LIFT_DROP; ETA_AX]; FIRST_X_ASSUM(MP_TAC o SPEC `indicator(t:real^M->bool)`) THEN ASM_SIMP_TAC[MEASURABLE_ON_INDICATOR_SUBSET] THEN ANTS_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{vec 0:real^1,vec 1}` THEN REWRITE_TAC[BOUNDED_INSERT; BOUNDED_EMPTY] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INSERT; indicator] THEN MESON_TAC[]; ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[indicator] THEN ASM_MESON_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID; SUBSET]]; FIRST_ASSUM(fun th -> MP_TAC(SPEC `{x:real^M | (if x IN s then f x else vec 0:real^1)$1 > &0}` th) THEN MP_TAC(SPEC `{x:real^M | (if x IN s then f x else vec 0:real^1)$1 < &0}` th)) THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM MEASURABLE_ON_UNIV]) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]) THEN SIMP_TAC[DIMINDEX_1; ARITH] THEN REPLICATE_TAC 2 (DISCH_THEN(K ALL_TAC)) THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[real_gt; VEC_COMPONENT; REAL_LT_REFL] THEN REWRITE_TAC[SUBSET_RESTRICT; SET_RULE `{x | if x IN s then Q x else F} = {x | x IN s /\ Q x}`] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_NEG) THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[IN_ELIM_THM; GSYM drop; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_ADD) THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN REWRITE_TAC[NORM_1; GSYM DROP_EQ; LIFT_DROP; DROP_ADD] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC; DROP_NEG]) THEN ASM_REAL_ARITH_TAC]);; let ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ_ALT = prove (`!f:real^M->real^N s. lebesgue_measurable s ==> (f absolutely_integrable_on s <=> !g. g measurable_on s /\ bounded(IMAGE g s) ==> (\x. drop(g x) % f x) integrable_on s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ] THEN REWRITE_TAC[TAUT `(p /\ q <=> q) <=> q ==> p`] THEN DISCH_THEN(MP_TAC o SPEC `(\x. vec 1):real^M->real^1`) THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; MEASURABLE_ON_CONST_EQ] THEN REWRITE_TAC[VECTOR_MUL_LID; ETA_AX] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE]] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{vec 1:real^1}` THEN REWRITE_TAC[BOUNDED_SING] THEN SET_TAC[]);; let ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ_ALT = prove (`!f:real^M->real^N s. lebesgue_measurable s ==> (f absolutely_integrable_on s <=> !t. t SUBSET s /\ lebesgue_measurable t ==> f integrable_on t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ] THEN ASM_MESON_TAC[SUBSET_REFL; INTEGRABLE_IMP_MEASURABLE]);; (* ------------------------------------------------------------------------- *) (* More connections with measure where Lebesgue measurability is useful. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_LEBESGUE_MEASURABLE_SUBSET = prove (`!s t:real^N->bool. lebesgue_measurable s /\ measurable t /\ s SUBSET t ==> measurable s`, REWRITE_TAC[lebesgue_measurable; MEASURABLE_INTEGRABLE] THEN REWRITE_TAC[indicator] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `(\x. if x IN t then vec 1 else vec 0):real^N->real^1` THEN ASM_REWRITE_TAC[IN_UNIV] THEN GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop]) THEN REWRITE_TAC[REAL_ABS_NUM; REAL_LE_REFL; REAL_POS] THEN ASM SET_TAC[]);; let MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE = prove (`!s t:real^N->bool. lebesgue_measurable s /\ measurable t ==> measurable(s INTER t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_INTER; MEASURABLE_IMP_LEBESGUE_MEASURABLE; INTER_SUBSET]);; let MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE = prove (`!s t:real^N->bool. measurable s /\ lebesgue_measurable t ==> measurable(s INTER t)`, MESON_TAC[INTER_COMM; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE]);; let LEBESGUE_MEASURABLE_MEASURABLE_INTER_EQ = prove (`!s:real^N->bool. lebesgue_measurable s <=> !t. measurable t ==> measurable(s INTER t)`, MESON_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS; MEASURABLE_INTERVAL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE]);; let MEASURABLE_INTER_HALFSPACE_LE = prove (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i <= a})`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE THEN ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_LE; LEBESGUE_MEASURABLE_CLOSED]);; let MEASURABLE_INTER_HALFSPACE_GE = prove (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i >= a})`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE THEN ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_GE; LEBESGUE_MEASURABLE_CLOSED]);; let MEASURABLE_MEASURABLE_DIFF_LEBESGUE_MEASURABLE = prove (`!s t. measurable s /\ lebesgue_measurable t ==> measurable(s DIFF t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; LEBESGUE_MEASURABLE_COMPL]);; let MEASURABLE_OPEN_IN = prove (`!s t:real^N->bool. open_in (subtopology euclidean s) t /\ measurable s ==> measurable t`, MESON_TAC[MEASURABLE_LEBESGUE_MEASURABLE_SUBSET; OPEN_IN_IMP_SUBSET; LEBESGUE_MEASURABLE_OPEN_IN; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; let MEASURABLE_CLOSED_IN = prove (`!s t:real^N->bool. closed_in (subtopology euclidean s) t /\ measurable s ==> measurable t`, MESON_TAC[MEASURABLE_LEBESGUE_MEASURABLE_SUBSET; CLOSED_IN_IMP_SUBSET; LEBESGUE_MEASURABLE_CLOSED_IN; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; let MEASURABLE_ON_REAL_SGN = prove (`!f:real^N->real s. (\x. lift(f x)) measurable_on s ==> (\x. lift(real_sgn(f x))) measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[real_sgn; MESON[DROP_VEC; REAL_LT_REFL; LIFT_DROP] `(if P x then lift(if &0 < f x then &1 else if f x < &0 then -- &1 else &0) else vec 0) = if (&0 < (if P x then f x else &0)) then lift(&1) else if ((if P x then f x else &0) < &0) then lift(-- &1) else lift(&0)`] THEN REWRITE_TAC[MESON[LIFT_NUM] `(if P then lift(f x) else vec 0) = lift(if P then f x else &0)`] THEN ABBREV_TAC `h x = if x IN s then (f:real^N->real) x else &0` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CASES THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]); REWRITE_TAC[MEASURABLE_ON_CONST] THEN MATCH_MP_TAC MEASURABLE_ON_CASES THEN REWRITE_TAC[MEASURABLE_ON_CONST] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT])] THEN REWRITE_TAC[real_gt; DIMINDEX_1; FORALL_1] THEN SIMP_TAC[GSYM drop; LIFT_DROP]);; let LEBESGUE_MEASURABLE_INNER_COMPACT = prove (`!s:real^N->bool. lebesgue_measurable s /\ ~negligible s ==> ?k. k SUBSET s /\ compact k /\ &0 < measure k`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?a b:real^N. ~(negligible(s INTER interval[a,b]))` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_ON_INTERVALS]; ALL_TAC] THEN MP_TAC(ISPECL [`s INTER interval[a:real^N,b]`; `measure(s INTER interval[a:real^N,b])`] MEASURABLE_INNER_COMPACT) THEN ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN SIMP_TAC[SUBSET_INTER; REAL_LT_ADDL]);; let CHOOSE_LARGE_MEASURABLE_SUBSET = prove (`!s:real^N->bool B. lebesgue_measurable s /\ ~measurable s ==> ?t. t SUBSET s /\ measurable t /\ B <= measure t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n. s INTER interval[--vec n:real^N,vec n]`; `B:real`] MEASURABLE_NESTED_UNIONS) THEN ASM_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS] THEN MATCH_MP_TAC(TAUT `(~p ==> s) /\ q /\ ~r ==> (p /\ q ==> r) ==> s`) THEN REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN REPEAT CONJ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `s INTER interval[--vec n:real^N,vec n]` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; INTER_SUBSET] THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_INTERVAL]; GEN_TAC THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN REWRITE_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `~measurable s ==> t = s ==> ~measurable t`)) THEN ONCE_REWRITE_TAC[SET_RULE `{s INTER f n | n IN (:num)} = {s INTER t | t IN IMAGE f (:num)}`] THEN REWRITE_TAC[GSYM INTER_UNIONS] THEN MATCH_MP_TAC(SET_RULE `u = UNIV ==> s INTER u = s`) THEN REWRITE_TAC[UNIONS_IMAGE; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN MP_TAC(ISPEC `norm(x:real^N)` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT] THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS; VEC_COMPONENT] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]]);; let CHOOSE_LARGE_COMPACT_SUBSET = prove (`!s:real^N->bool B. lebesgue_measurable s /\ ~measurable s ==> ?t. t SUBSET s /\ compact t /\ B <= measure t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `B + &1`] CHOOSE_LARGE_MEASURABLE_SUBSET) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`u:real^N->bool`; `&1`] MEASURABLE_INNER_COMPACT) THEN ASM_REWRITE_TAC[REAL_LT_01] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; ASM_REAL_ARITH_TAC]);; let OUTER_LEBESGUE_MEASURE = prove (`!s:real^N->bool. ?t. s SUBSET t /\ lebesgue_measurable t /\ !t'. s SUBSET t' /\ lebesgue_measurable t' ==> negligible(t DIFF t')`, GEN_TAC THEN MP_TAC (GEN `n:num` (SPEC `s INTER cball(vec 0:real^N,&n)` OUTER_MEASURE)) THEN SIMP_TAC[BOUNDED_INTER; BOUNDED_CBALL; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:num->real^N->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN EXISTS_TAC `UNIONS {u n | n IN (:num)}:real^N->bool` THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(SPEC `norm(x:real^N)` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[GSYM IN_CBALL_0] THEN ASM SET_TAC[]; X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[UNIONS_DIFF; SET_RULE `{f x | x IN {g y | y IN s}} = {f(g x) | x IN s}`] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE] THEN ASM SET_TAC[]]);; let OUTER_MEASURE_GEN = prove (`!s u:real^N->bool. s SUBSET u /\ measurable u ==> ?t. s SUBSET t /\ measurable t /\ !t'. s SUBSET t' /\ lebesgue_measurable t' ==> negligible(t DIFF t')`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OUTER_LEBESGUE_MEASURE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `u UNION (t DIFF u):real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; let OUTER_MEASURE_EQ = prove (`!s:real^N->bool. (?t. s SUBSET t /\ measurable t) <=> (?t. s SUBSET t /\ measurable t /\ !t'. s SUBSET t' /\ lebesgue_measurable t' ==> negligible(t DIFF t'))`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; OUTER_MEASURE_GEN]);; (* ------------------------------------------------------------------------- *) (* Negigibility of set with uncountably many disjoint translates. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_DISJOINT_TRANSLATES = prove (`!s:real^N->bool k z. lebesgue_measurable s /\ z limit_point_of k /\ pairwise (\a b. DISJOINT (IMAGE (\x. a + x) s) (IMAGE (\x. b + x) s)) k ==> negligible s`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN ABBREV_TAC `t = s INTER interval[a:real^N,b]` THEN SUBGOAL_THEN `measurable(t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_INTERVAL; INTER_COMM]; ALL_TAC] THEN SUBGOAL_THEN `bounded(t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[BOUNDED_INTER; BOUNDED_INTERVAL]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN ASM_SIMP_TAC[MEASURE_POS_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1` o GEN_REWRITE_RULE I [LIMPT_INFINITE_CBALL]) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `measure(IMAGE (\x:real^N. z + x) (interval[a - vec 1,b + vec 1]))` o MATCH_MP REAL_ARCH) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN MP_TAC(ISPECL [`n:num`; `k INTER cball(z:real^N,&1)`] CHOOSE_SUBSET_STRONG) THEN ANTS_TAC THENL [ASM_MESON_TAC[INFINITE]; ALL_TAC] THEN REWRITE_TAC[SUBSET_INTER; LEFT_IMP_EXISTS_THM; REAL_NOT_LT] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `measure(UNIONS(IMAGE (\a. IMAGE (\x:real^N. a + x) t) u))` THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN SUBGOAL_THEN `UNIONS(IMAGE (\a. IMAGE (\x:real^N. a + x) t) u) has_measure &n * measure(t:real^N->bool)` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\a. IMAGE (\x:real^N. a + x) t`; `u:real^N->bool`] HAS_MEASURE_DISJOINT_UNIONS_IMAGE) THEN ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURE_TRANSLATION; SUM_CONST] THEN DISCH_THEN MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_LE_REFL]; MATCH_MP_TAC MEASURE_SUBSET] THEN ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_INTERVAL] THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `e:real^N` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE; UNWIND_THM1; VECTOR_ARITH `d + e:real^N = z + y <=> e + d - z = y`] THEN SUBGOAL_THEN `x IN interval[a:real^N,b]` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[VEC_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH `abs(d) <= &1 ==> a <= x /\ x <= b ==> a - &1 <= x + d /\ x + d <= b + &1`) THEN SUBGOAL_THEN `e IN cball(z:real^N,&1)` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_CBALL]] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM]);; (* ------------------------------------------------------------------------- *) (* Sometimes convenient to restrict the sets in "preimage" characterization *) (* of measurable functions to choose points from a dense set. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE = prove (`!f:real^M->real^N r. closure (IMAGE lift r) = (:real^1) ==> (f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r ==> lebesgue_measurable {x | f(x)$k <= a})`, REPEAT STRIP_TAC THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `!n. ?x. x IN r /\ a < x /\ x < a + inv(&n + &1)` MP_TAC THENL [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[IN_UNIV; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPECL [`lift(a + inv(&n + &1) / &2)`; `inv(&n + &1) / &2`]) THEN REWRITE_TAC[REAL_HALF; DIST_LIFT; REAL_LT_INV_EQ] THEN ANTS_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN SIMP_TAC[] THEN REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `t:num->real` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | (f:real^M->real^N) x$k <= a} = INTERS {{x | (f x)$k <= t n} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN EQ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `i < f - a ==> !j. j <= i /\ a < t /\ t < a + j ==> &0 < f - t`)) THEN EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE = prove (`!f:real^M->real^N r. closure (IMAGE lift r) = (:real^1) ==> (f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r ==> lebesgue_measurable {x | f(x)$k >= a})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) r:real->bool`] MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_NEG] THEN ASM_REWRITE_TAC[GSYM o_DEF; IMAGE_o; CLOSURE_NEGATIONS] THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_NEG_NEG]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IMP_CONJ] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= --y <=> x >= y`]]);; let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE = prove (`!f:real^M->real^N r. closure (IMAGE lift r) = (:real^1) ==> (f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r ==> lebesgue_measurable {x | f(x)$k < a})`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`] THEN REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN SIMP_TAC[GSYM MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE]);; let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE = prove (`!f:real^M->real^N r. closure (IMAGE lift r) = (:real^1) ==> (f measurable_on (:real^M) <=> !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r ==> lebesgue_measurable {x | f(x)$k > a})`, GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`] THEN REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN SIMP_TAC[GSYM MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE]);; let MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE = prove (`!f:real^M->real^N t. closure t = (:real^N) ==> (f measurable_on (:real^M) <=> !a b. a IN t /\ b IN t ==> lebesgue_measurable {x | f(x) IN interval[a,b]})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL] THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN SUBGOAL_THEN `!n. ?u v:real^N. (u IN t /\ u IN interval[(a - lambda i. inv(&n + &1)),a]) /\ (v IN t /\ v IN interval[b,(b + lambda i. inv(&n + &1))])` MP_TAC THENL [GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `~(interior s INTER t = {}) /\ interior s SUBSET s ==> ?x. x IN t /\ x IN s`) THEN REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `a - i < a <=> &0 < i`; REAL_ARITH `b < b + i <=> &0 < i`] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:num->real^N`; `v:num->real^N`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN STRIP_TAC THEN SUBGOAL_THEN `{x | (f:real^M->real^N) x IN interval[a,b]} = INTERS {{x | f x IN interval[u n,v n]} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN REWRITE_TAC[DE_MORGAN_THM; EXISTS_OR_THM; REAL_NOT_LE] THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `!a i j. i < a - f /\ j <= i /\ a - j <= t /\ t <= a ==> &0 < t - f`) THEN EXISTS_TAC `(a:real^N)$k`; MATCH_MP_TAC(REAL_ARITH `!a i j. i < f - a /\ j <= i /\ a <= t /\ t <= a + j ==> &0 < f - t`) THEN EXISTS_TAC `(b:real^N)$k`] THEN MAP_EVERY EXISTS_TAC [`inv(&n)`; `inv(&n + &1)`] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; let MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE = prove (`!f:real^M->real^N t. closure t = (:real^N) ==> (f measurable_on (:real^M) <=> !a b. a IN t /\ b IN t ==> lebesgue_measurable {x | f(x) IN interval(a,b)})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL] THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN SUBGOAL_THEN `!n. ?u v:real^N. (u IN t /\ u IN interval[a,(a + lambda i. inv(&n + &1))]) /\ (v IN t /\ v IN interval[(b - lambda i. inv(&n + &1)),b])` MP_TAC THENL [GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `~(interior s INTER t = {}) /\ interior s SUBSET s ==> ?x. x IN t /\ x IN s`) THEN REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `a - i < a <=> &0 < i`; REAL_ARITH `b < b + i <=> &0 < i`] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:num->real^N`; `v:num->real^N`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN STRIP_TAC THEN SUBGOAL_THEN `{x | (f:real^M->real^N) x IN interval(a,b)} = UNIONS {{x | f x IN interval(u n,v n)} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]] THEN SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < inf { min ((y - a:real^N)$i) ((b - y:real^N)$i) | i IN 1..dimindex(:N)}` MP_TAC THENL [SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; REAL_SUB_LT; VECTOR_SUB_COMPONENT; IN_NUMSEG]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[FORALL_IN_IMAGE; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `k:num`])) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE = prove (`!f:real^M->real^N t. closure t = (:real^N) ==> (f measurable_on (:real^M) <=> !a. a IN t ==> lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k <= (a:real^N)$k})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_ORTHANT_LE] THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN SUBGOAL_THEN `!n. ?u:real^N. u IN t /\ u IN interval[a,(a + lambda i. inv(&n + &1))]` MP_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(SET_RULE `~(interior s INTER t = {}) /\ interior s SUBSET s ==> ?x. x IN t /\ x IN s`) THEN REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `b < b + i <=> &0 < i`] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:num->real^N` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN STRIP_TAC THEN SUBGOAL_THEN `{x | !i. 1 <= i /\ i <= dimindex(:N) ==> (f:real^M->real^N) x$i <= (a:real^N)$i} = INTERS {{x | !i. 1 <= i /\ i <= dimindex(:N) ==> (f:real^M->real^N) x$i <= (u n:real^N)$i} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!a i j. i < f - a /\ j <= i /\ a <= t /\ t <= a + j ==> &0 < f - t`) THEN EXISTS_TAC `(a:real^N)$k` THEN MAP_EVERY EXISTS_TAC [`inv(&n)`; `inv(&n + &1)`] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE = prove (`!f:real^M->real^N t. closure t = (:real^N) ==> (f measurable_on (:real^M) <=> !a. a IN t ==> lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k >= (a:real^N)$k})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) t:real^N->bool`] MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE) THEN ASM_REWRITE_TAC[CLOSURE_NEGATIONS; FORALL_IN_IMAGE] THEN REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= --y <=> x >= y`] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_NEG_NEG]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE = prove (`!f:real^M->real^N t. closure t = (:real^N) ==> (f measurable_on (:real^M) <=> !a. a IN t ==> lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k < (a:real^N)$k})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_ORTHANT_LT] THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN SUBGOAL_THEN `!n. ?u:real^N. u IN t /\ u IN interval[(a - lambda i. inv(&n + &1)):real^N,a]` MP_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(SET_RULE `~(interior s INTER t = {}) /\ interior s SUBSET s ==> ?x. x IN t /\ x IN s`) THEN REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `b - i < b <=> &0 < i`] THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:num->real^N` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN STRIP_TAC THEN SUBGOAL_THEN `{x | !i. 1 <= i /\ i <= dimindex(:N) ==> (f:real^M->real^N) x$i < (a:real^N)$i} = UNIONS {{x | !i. 1 <= i /\ i <= dimindex(:N) ==> (f:real^M->real^N) x$i < (u n:real^N)$i} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]] THEN SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < inf { (a - y:real^N)$i | i IN 1..dimindex(:N)}` MP_TAC THENL [SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; REAL_SUB_LT; VECTOR_SUB_COMPONENT; IN_NUMSEG]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[FORALL_IN_IMAGE; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `k:num`])) THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; let MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE = prove (`!f:real^M->real^N t. closure t = (:real^N) ==> (f measurable_on (:real^M) <=> !a. a IN t ==> lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) ==> f(x)$k > (a:real^N)$k})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) t:real^N->bool`] MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE) THEN ASM_REWRITE_TAC[CLOSURE_NEGATIONS; FORALL_IN_IMAGE] THEN REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x < --y <=> x > y`] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_NEG_NEG]);; (* ------------------------------------------------------------------------- *) (* Localized variants of function measurability equivalents. *) (* ------------------------------------------------------------------------- *) let [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL; MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL] = (CONJUNCTS o prove) (`(!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !t. closed t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !a b. lebesgue_measurable {x | x IN s /\ f x IN interval[a,b]})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !t. open t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | x IN s /\ (f x)$k >= a})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | x IN s /\ (f x)$k > a})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | x IN s /\ (f x)$k <= a})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {x | x IN s /\ (f x)$k < a})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !a b. lebesgue_measurable {x | x IN s /\ f x IN interval(a,b)})) /\ (!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !t. borel t ==> lebesgue_measurable {x | x IN s /\ f x IN t}))`, let lemma = prove (`!f s P. {x | P(if x IN s then f x else vec 0)} = if P(vec 0) then s INTER {x | P(f x)} UNION ((:real^M) DIFF s) else {x | x IN s /\ P(f x)}`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]) in ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_BOREL]] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] lemma) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN TRY(MATCH_MP_TAC(TAUT `(q <=> q') ==> (p ==> q <=> p ==> q')`)) THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN EQ_TAC THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_UNION; LEBESGUE_MEASURABLE_COMPL] THEN UNDISCH_TAC `lebesgue_measurable(s:real^M->bool)` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_INTER) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove (`!f:real^M->real^N s t. f measurable_on s /\ lebesgue_measurable s /\ open t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);; let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove (`!f:real^M->real^N s t. f measurable_on s /\ lebesgue_measurable s /\ closed t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);; let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ = prove (`!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s <=> !t. open t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);; let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ = prove (`!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s <=> !t. closed t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);; let [MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED; MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN; MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL] = (CONJUNCTS o prove) (`(!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !t. closed t ==> measurable {x | x IN s /\ f x IN t})) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !a b. measurable {x | x IN s /\ f x IN interval[a,b]})) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !t. open t ==> measurable {x | x IN s /\ f x IN t})) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> measurable {x | x IN s /\ (f x)$k >= a})) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> measurable {x | x IN s /\ (f x)$k > a})) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> measurable {x | x IN s /\ (f x)$k <= a})) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !a k. 1 <= k /\ k <= dimindex(:N) ==> measurable {x | x IN s /\ (f x)$k < a})) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !a b. measurable {x | x IN s /\ f x IN interval(a,b)}))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_IMP_LEBESGUE_MEASURABLE) THENL [ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]; ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL]; ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]; ASM_SIMP_TAC [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE]; ASM_SIMP_TAC [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT]; ASM_SIMP_TAC [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE]; ASM_SIMP_TAC [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT]; ASM_SIMP_TAC [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL]] THEN EQ_TAC THEN SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[]);; let MEASURABLE_MEASURABLE_PREIMAGE_OPEN = prove (`!f:real^M->real^N s t. f measurable_on s /\ measurable s /\ open t ==> measurable {x | x IN s /\ f(x) IN t}`, MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);; let MEASURABLE_MEASURABLE_PREIMAGE_CLOSED = prove (`!f:real^M->real^N s t. f measurable_on s /\ measurable s /\ closed t ==> measurable {x | x IN s /\ f(x) IN t}`, MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);; let MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ = prove (`!f:real^M->real^N s. f measurable_on s /\ measurable s <=> !t. open t ==> measurable {x | x IN s /\ f(x) IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_OPEN] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);; let MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ = prove (`!f:real^M->real^N s. f measurable_on s /\ measurable s <=> !t. closed t ==> measurable {x | x IN s /\ f(x) IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_CLOSED] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);; let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_BOREL = prove (`!f:real^M->real^N s t. f measurable_on s /\ lebesgue_measurable s /\ borel t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL]);; let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL_EQ = prove (`!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s <=> !t. borel t ==> lebesgue_measurable {x | x IN s /\ f x IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_BOREL] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN REWRITE_TAC[BOREL_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL]);; (* ------------------------------------------------------------------------- *) (* Measurability of analytic sets and related results. *) (* ------------------------------------------------------------------------- *) let SUSLIN_LEBESGUE_MEASURABLE = prove (`suslin lebesgue_measurable:(real^N->bool)->bool = lebesgue_measurable`, let lemma = prove (`!l m a b:A. APPEND l [a] = APPEND m [b] <=> l = m /\ a = b`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(AP_TERM `BUTLAST:A list->A list` th) THEN MP_TAC(AP_TERM `LAST:A list->A` th)) THEN REWRITE_TAC[LAST_APPEND; BUTLAST_APPEND; NOT_CONS_NIL] THEN SIMP_TAC[LAST; BUTLAST; APPEND_NIL]) in REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUSLIN_SUPERSET] THEN REWRITE_TAC[SUBSET; suslin; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN] THEN SUBGOAL_THEN `!e. (!l:num list. lebesgue_measurable(e l)) /\ e [] = (:real^N) ==> lebesgue_measurable(suslin_operation e)` MP_TAC THENL [X_GEN_TAC `e:num list->real^N->bool` THEN STRIP_TAC; DISCH_TAC THEN X_GEN_TAC `e:num list->real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\l:num list. if l = [] then (:real^N) else e l`) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[LEBESGUE_MEASURABLE_UNIV]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SIMP_TAC[suslin_operation] THEN REPEAT(AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN REPEAT STRIP_TAC) THEN ASM_SIMP_TAC[LIST_OF_SEQ_EQ_NIL; LE_1]] THEN ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_MEASURABLE_INTER_EQ] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN ABBREV_TAC `f = \l. UNIONS { INTERS { (e:num list->real^N->bool)(list_of_seq s n) | 1 <= n} | list_of_seq s (LENGTH l) = l}` THEN SUBGOAL_THEN `!l. (f:num list->real^N->bool) l SUBSET e l` ASSUME_TAC THENL [X_GEN_TAC `l:num list` THEN ASM_CASES_TAC `l:num list = []` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN EXPAND_TAC "f" THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `s:num->num` THEN DISCH_TAC THEN MATCH_MP_TAC INTERS_SUBSET_STRONG THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `LENGTH(l:num list)` THEN ASM_SIMP_TAC[LE_1; LENGTH_EQ_NIL; SUBSET_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!l. ?u. f l INTER t SUBSET u /\ u SUBSET e l /\ u SUBSET t /\ measurable u /\ !v. (f:num list->real^N->bool) l INTER t SUBSET v /\ lebesgue_measurable v ==> negligible(u DIFF v)` MP_TAC THENL [X_GEN_TAC `l:num list` THEN MP_TAC(ISPECL [`(f:num list->real^N->bool) l INTER t`; `t:real^N->bool`] OUTER_MEASURE_GEN) THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u INTER t INTER e(l:num list):real^N->bool` THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; MEASURABLE_INTER] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN SET_TAC[]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN X_GEN_TAC `g:num list->real^N->bool` THEN STRIP_TAC THEN ABBREV_TAC `h = \l. (g l:real^N->bool) DIFF UNIONS {g(APPEND l [i]) | i IN (:num)}` THEN SUBGOAL_THEN `!l. negligible((h:num list->real^N->bool) l)` ASSUME_TAC THENL [X_GEN_TAC `l:num list` THEN EXPAND_TAC "h" THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; FORALL_IN_GSPEC; MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN SUBGOAL_THEN `f l:real^N->bool = UNIONS {f (APPEND l [i]) | i IN (:num)}` SUBST1_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[LENGTH_APPEND; LENGTH; ADD_CLAUSES] THEN REWRITE_TAC[list_of_seq; lemma] THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC] THEN SET_TAC[]; REWRITE_TAC[INTER_UNIONS] THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN ASM_REWRITE_TAC[o_THM; IN_UNIV]]; ALL_TAC] THEN ABBREV_TAC `H:real^N->bool = UNIONS {h l | l IN (:num list)}` THEN SUBGOAL_THEN `negligible(H:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "H" THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[COUNTABLE_LIST; NUM_COUNTABLE; COUNTABLE_IMAGE]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF THEN EXISTS_TAC `(g:num list->real^N->bool) []` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `H:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `e SUBSET g /\ g DIFF h SUBSET e ==> (g DIFF e) UNION (e DIFF g) SUBSET h`) THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `(f:num list->real^N->bool) [] INTER t` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "f" THEN REWRITE_TAC[suslin_operation; LENGTH; LIST_OF_SEQ_EQ_NIL; IN_UNIV] THEN REWRITE_TAC[SUBSET_REFL]; ALL_TAC] THEN EXPAND_TAC "H" THEN REWRITE_TAC[SUBSET; IN_DIFF; UNIONS_GSPEC; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN STRIP_TAC THEN REWRITE_TAC[suslin_operation; IN_INTER; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN SUBGOAL_THEN `?l:num->num list. (!n. LENGTH(l n) = n /\ (x:real^N) IN g(l n)) /\ (!n m. m < n ==> EL m (l(SUC n)) = EL m (l n))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [ASM_MESON_TAC[LENGTH]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `l:num list`] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(?t h. P(APPEND t [h])) ==> (?l. P l)`) THEN EXISTS_TAC `l:num list` THEN ASM_SIMP_TAC[LENGTH; LENGTH_APPEND; EL_APPEND; ADD_CLAUSES] THEN SUBGOAL_THEN `~(x IN (h:num list->real^N->bool) l)` MP_TAC THENL [ASM_REWRITE_TAC[]; EXPAND_TAC "h" THEN REWRITE_TAC[UNIONS_GSPEC]] THEN ASM SET_TAC[]; EXISTS_TAC `(\n. EL n (l(SUC n))):num->num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `list_of_seq (\n. EL n (l (SUC n))) n :num list = l n` SUBST1_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_SIMP_TAC[LIST_EQ; LENGTH_LIST_OF_SEQ; EL_LIST_OF_SEQ] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GSYM LE_SUC_LT] THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(K ALL_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD_CLAUSES; ARITH_RULE `m < SUC(m + d)`]]);; let ANALYTIC_IMP_LEBESGUE_MEASURABLE = prove (`!s:real^N->bool. analytic s ==> lebesgue_measurable s`, ONCE_REWRITE_TAC[GSYM SUSLIN_LEBESGUE_MEASURABLE] THEN REWRITE_TAC[analytic] THEN GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUSLIN_MONO) THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COMPACT]);; let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC = prove (`!f:real^M->real^N s t. f measurable_on s /\ lebesgue_measurable s /\ analytic t ==> lebesgue_measurable {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUSLIN_LEBESGUE_MEASURABLE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [analytic]) THEN REWRITE_TAC[suslin; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:num list->real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN EXISTS_TAC `\l:num list. {x | x IN s /\ (f:real^M->real^N) x IN g l}` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `l:num list` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[IN] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_BOREL THEN ASM_SIMP_TAC[COMPACT_IMP_BOREL]; REWRITE_TAC[suslin_operation; UNIONS_GSPEC; INTERS_GSPEC] THEN MP_TAC LE_REFL THEN SET_TAC[]]);; let LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC = prove (`!f:real^M->real^N t. f measurable_on (:real^M) /\ analytic t ==> lebesgue_measurable {x | f x IN t}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x} = {x | x IN UNIV /\ P x}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV]);; let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC_EQ = prove (`!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s <=> !t. analytic t ==> lebesgue_measurable {x | x IN s /\ f x IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC] THEN REWRITE_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL_EQ] THEN SIMP_TAC[BOREL_IMP_ANALYTIC]);; let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC = prove (`!f:real^M->real^N s. lebesgue_measurable s ==> (f measurable_on s <=> !t. analytic t ==> lebesgue_measurable {x | x IN s /\ f x IN t})`, SIMP_TAC[GSYM MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC_EQ]);; let MEASURABLE_ON_PREIMAGE_ANALYTIC = prove (`!f:real^M->real^N. f measurable_on (:real^M) <=> !t. analytic t ==> lebesgue_measurable {x | f x IN t}`, SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC; LEBESGUE_MEASURABLE_UNIV; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Some additional lemmas about measurability and absolute integrals. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_LIFT_INV = prove (`!f:real^N->real s. (\x. lift(f x)) measurable_on s /\ negligible {x | x IN s /\ f x = &0} ==> (\x. lift(inv(f x))) measurable_on s`, let lemma = prove (`!f:real^N->real s. (\x. lift(f x)) measurable_on s /\ (!x. x IN s ==> ~(f x = &0)) ==> (\x. lift(inv(f x))) measurable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `lebesgue_measurable(s:real^N->bool)` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEASURABLE_ON_UNIV]) THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `(:real^1) DELETE vec 0`) THEN SIMP_TAC[OPEN_UNIV; OPEN_DELETE; IN_DELETE; IN_UNIV] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[MESON[] `~(if p then F else T) <=> p`] THEN REWRITE_TAC[SET_RULE `{x | x IN s} = s`]; UNDISCH_TAC `(\x:real^N. lift(f x)) measurable_on s` THEN ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN] THEN DISCH_TAC THEN X_GEN_TAC `u:real^1->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (lift o inv o drop) (u DELETE vec 0)`) THEN ANTS_TAC THENL [MATCH_MP_TAC OPEN_IN_OPEN_TRANS THEN EXISTS_TAC `(:real^1) DELETE vec 0` THEN SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`lift o inv o drop`; `(:real^1) DELETE vec 0`] THEN CONJ_TAC THENL [REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; o_THM; FORALL_LIFT; LIFT_DROP] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[REAL_INV_INV; REAL_INV_EQ_0] THEN MATCH_MP_TAC CONTINUOUS_ON_INV THEN REWRITE_TAC[IN_DELETE; o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN SIMP_TAC[GSYM DROP_EQ; DROP_VEC]; MATCH_MP_TAC OPEN_SUBSET THEN ASM_SIMP_TAC[OPEN_DELETE] THEN SET_TAC[]]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; o_THM; LIFT_DROP; IN_ELIM_THM] THEN REWRITE_TAC[LIFT_EQ; EXISTS_LIFT; LIFT_DROP; IN_DELETE; GSYM LIFT_NUM] THEN ASM_MESON_TAC[REAL_INV_INV; REAL_INV_EQ_0]]]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN EXISTS_TAC `{x:real^N | x IN s /\ ~(f x = &0)}` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC lemma THEN SIMP_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);; let MEASURABLE_ON_LIFT_DIV = prove (`!f:real^N->real g s. (\x. lift(f x)) measurable_on s /\ (\x. lift(g x)) measurable_on s /\ negligible {x | x IN s /\ g x = &0} ==> (\x. lift(f x / g x)) measurable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN ASM_SIMP_TAC[MEASURABLE_ON_LIFT_INV]);; let ABSOLUTELY_INTEGRABLE_UNION = prove (`!f:real^M->real^N s t. f absolutely_integrable_on s /\ f absolutely_integrable_on t ==> f absolutely_integrable_on (s UNION t)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on ({x | x IN s /\ ~(f x = vec 0)} INTER {x | x IN t /\ ~(f x = vec 0)})` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL [UNDISCH_TAC `(f:real^M->real^N) absolutely_integrable_on s`; UNDISCH_TAC `(f:real^M->real^N) absolutely_integrable_on t`] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `(:real^N) DELETE (vec 0)`) THEN SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]; ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV])) THEN ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[IN_INTER; IN_UNION; IN_ELIM_THM] THEN ASM_CASES_TAC `(f:real^M->real^N) x = vec 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH]);; let ABSOLUTELY_INTEGRABLE_DIFF = prove (`!f:real^M->real^N s t. f absolutely_integrable_on s /\ f absolutely_integrable_on t ==> f absolutely_integrable_on (s DIFF t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_UNION) THEN FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNION] THEN CONV_TAC VECTOR_ARITH);; let ABSOLUTELY_INTEGRABLE_INTER = prove (`!f:real^M->real^N s t. f absolutely_integrable_on s /\ f absolutely_integrable_on t ==> f absolutely_integrable_on (s INTER t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_UNION) THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN ASM_REWRITE_TAC[IN_INTER; IN_UNION] THEN CONV_TAC VECTOR_ARITH);; let INTEGRAL_COUNTABLE_UNIONS_ALT = prove (`!f:real^M->real^N s. f absolutely_integrable_on (UNIONS {s m | m IN (:num)}) /\ (!m. lebesgue_measurable(s m)) ==> (!n. f absolutely_integrable_on UNIONS {s m | m IN 0..n}) /\ ((\n. integral (UNIONS {s m | m IN 0..n}) f) --> integral (UNIONS {s m | m IN (:num)}) f) sequentially`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET)) THEN CONJ_TAC THENL [SET_TAC[]; MATCH_MP_TAC LEBESGUE_MEASURABLE_UNIONS] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; SIMPLE_IMAGE] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG]; DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN MATCH_MP_TAC(TAUT `p /\ q ==> p ==> q`) THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV; GSYM INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC DOMINATED_CONVERGENCE THEN EXISTS_TAC `\x. if x IN UNIONS {s m | m IN (:num)} then lift(norm((f:real^M->real^N) x)) else vec 0` THEN REWRITE_TAC[INTEGRAL_RESTRICT_UNIV; INTEGRABLE_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN REWRITE_TAC[IN_UNIV] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL; LIFT_DROP; REAL_LE_REFL; NORM_0; DROP_VEC; NORM_POS_LE]) THEN ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN COND_CASES_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN MESON_TAC[]; MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Regularity properties and Steinhaus, this time for Lebesgue measure. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_MEASURABLE_OUTER_OPEN = prove (`!s:real^N->bool e. lebesgue_measurable s /\ &0 < e ==> ?t. open t /\ s SUBSET t /\ measurable(t DIFF s) /\ measure(t DIFF s) < e`, REPEAT STRIP_TAC THEN MP_TAC(GEN `n:num` (ISPECL [`s INTER ball(vec 0:real^N,&2 pow n)`; `e / &4 / &2 pow n`] MEASURABLE_OUTER_OPEN)) THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; REAL_LT_DIV; MEASURABLE_BALL; REAL_LT_INV_EQ; REAL_LT_POW2; REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `t:num->real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS(IMAGE t (:num)):real^N->bool` THEN ASM_SIMP_TAC[OPEN_UNIONS; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPEC `norm(x:real^N)` REAL_ARCH_POW2) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_BALL_0; IN_INTER]; REWRITE_TAC[UNIONS_DIFF; SET_RULE `{f x | x IN IMAGE g s} = {f(g(x)) | x IN s}`] THEN MATCH_MP_TAC(MESON[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`] `&0 < e /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEBESGUE_MEASURABLE] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(t i DIFF (s INTER ball(vec 0:real^N,&2 pow i)))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEBESGUE_MEASURABLE; MEASURABLE_INTER; MEASURABLE_BALL; LEBESGUE_MEASURABLE_INTER; MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN SET_TAC[]; ASM_SIMP_TAC[MEASURE_DIFF_SUBSET; MEASURABLE_DIFF; MEASURABLE_BALL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE] THEN ASM_SIMP_TAC[REAL_ARITH `t < s + e ==> t - s <= e`]]; REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 LT] THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN REWRITE_TAC[REAL_ARITH `&1 / &4 * (&1 - x) * &2 <= &1 / &2 <=> &0 <= x`] THEN MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]]);; let LEBESGUE_MEASURABLE_INNER_CLOSED = prove (`!s:real^N->bool e. lebesgue_measurable s /\ &0 < e ==> ?t. closed t /\ t SUBSET s /\ measurable(s DIFF t) /\ measure(s DIFF t) < e`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN DISCH_THEN(X_CHOOSE_TAC `t:real^N->bool` o MATCH_MP LEBESGUE_MEASURABLE_OUTER_OPEN) THEN EXISTS_TAC `(:real^N) DIFF t` THEN POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[GSYM OPEN_CLOSED] THENL [SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC] THEN SET_TAC[]);; let STEINHAUS_LEBESGUE = prove (`!s:real^N->bool. lebesgue_measurable s /\ ~negligible s ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN MP_TAC(ISPEC `s INTER interval[a:real^N,b]` STEINHAUS) THEN ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE] THEN SET_TAC[]);; let LEBESGUE_MEASURABLE_REGULAR_OUTER = prove (`!s:real^N->bool. lebesgue_measurable s ==> ?k c. negligible k /\ (!n. open(c n)) /\ s = INTERS {c n | n IN (:num)} DIFF k`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LEBESGUE_MEASURABLE_OUTER_OPEN)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `INTERS {c n | n IN (:num)} DIFF s:real^N->bool` THEN EXISTS_TAC `c:num->real^N->bool` THEN ASM_REWRITE_TAC[SET_RULE `s = t DIFF (t DIFF s) <=> s SUBSET t`] THEN ASM_REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC] THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `(c:num->real^N->bool) n DIFF s` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]);; let LEBESGUE_MEASURABLE_REGULAR_INNER = prove (`!s:real^N->bool. lebesgue_measurable s ==> ?k c. negligible k /\ (!n. compact(c n)) /\ s = UNIONS {c n | n IN (:num)} UNION k`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LEBESGUE_MEASURABLE_INNER_CLOSED)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `s DIFF UNIONS {c n | n IN (:num)}:real^N->bool` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `s DIFF (c:num->real^N->bool) n` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]; SUBGOAL_THEN `?d. (!n. compact(d n:real^N->bool)) /\ UNIONS {d n | n IN (:num)} = UNIONS {c n | n IN (:num)}` MP_TAC THENL [MP_TAC(GEN `n:num` (ISPEC `(c:num->real^N->bool) n` CLOSED_UNION_COMPACT_SUBSETS)) THEN ASM_REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN (X_CHOOSE_THEN `d:num->num->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `COUNTABLE {d n m:real^N->bool | n IN (:num) /\ m IN (:num)}` MP_TAC THENL [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[NUM_COUNTABLE]; DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COUNTABLE_AS_IMAGE)) THEN ANTS_TAC THENL [SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC]]]);; let LEBESGUE_MEASURABLE_SMALL_IMP_NEGLIGIBLE = prove (`!s:real^N->bool. lebesgue_measurable s /\ s <_c (:real) ==> negligible s`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[TAUT `p ==> q <=> ~(p /\ ~q)`] THEN DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS_LEBESGUE) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`; `(:real)`] CARD_MUL_LT_INFINITE) THEN ASM_REWRITE_TAC[real_INFINITE; mul_c; CARD_NOT_LT] THEN TRANS_TAC CARD_LE_TRANS `ball(vec 0:real^N,r)` THEN CONJ_TAC THENL [ASM_MESON_TAC[CARD_EQ_BALL; CARD_EQ_SYM; CARD_EQ_IMP_LE]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `{x - y:real^N | x IN s /\ y IN s}` THEN ASM_SIMP_TAC[CARD_LE_SUBSET] THEN SUBGOAL_THEN `{x - y:real^N | x IN s /\ y IN s} = IMAGE (\z. FST z - SND z) {x,y | x IN s /\ y IN s}` (fun th -> REWRITE_TAC[th; CARD_LE_IMAGE]) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A Lebesgue measurable set is almost an F_sigma or G_delta. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_MEASURABLE_ALMOST_FSIGMA = prove (`!s:real^N->bool. lebesgue_measurable s ==> ?c t. fsigma c /\ negligible t /\ c UNION t = s /\ DISJOINT c t`, REPEAT STRIP_TAC THEN REWRITE_TAC[fsigma; UNION_OF; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN REWRITE_TAC[TAUT `(p /\ q /\ r) /\ s /\ t /\ u <=> r /\ t /\ u /\ p /\ q /\ s`] THEN REWRITE_TAC[UNWIND_THM1] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LEBESGUE_MEASURABLE_INNER_CLOSED)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM] THEN X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:num->real^N->bool) (:num)` THEN EXISTS_TAC `s DIFF UNIONS (IMAGE (f:num->real^N->bool) (:num))` THEN ASM_SIMP_TAC[SET_RULE `DISJOINT s (u DIFF s)`; COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV; UNIONS_SUBSET; SET_RULE `s UNION (u DIFF s) = u <=> s SUBSET u`] THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s DIFF (f:num->real^N->bool) n` THEN ASM_REWRITE_TAC[UNIONS_IMAGE] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `inv(&n + &1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN TRANS_TAC REAL_LE_TRANS `inv(&n)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC);; let LEBESGUE_MEASURABLE_ALMOST_GDELTA = prove (`!s:real^N->bool. lebesgue_measurable s ==> ?c t. gdelta c /\ negligible t /\ s UNION t = c /\ DISJOINT t s`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM LEBESGUE_MEASURABLE_COMPL] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_ALMOST_FSIGMA) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(:real^N) DIFF c`; `t:real^N->bool`] THEN ASM_REWRITE_TAC[GDELTA_COMPLEMENT] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Existence of nonmeasurable subsets of any set of positive measure. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS = prove (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> lebesgue_measurable t`, let lemma = prove (`!s:real^N->bool. lebesgue_measurable s /\ (!x y q. x IN s /\ y IN s /\ rational q /\ y = q % basis 1 + x ==> y = x) ==> negligible s`, SIMP_TAC[VECTOR_ARITH `q + x:real^N = x <=> q = vec 0`; VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` STEINHAUS_LEBESGUE) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `q:real` o MATCH_MP RATIONAL_BETWEEN) THEN FIRST_X_ASSUM (MP_TAC o SPEC `q % basis 1:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN SIMP_TAC[IN_BALL_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; ARITH; NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN ASM_REWRITE_TAC[REAL_MUL_RID; IN_ELIM_THM; NOT_EXISTS_THM; VECTOR_ARITH `q:real^N = x - y <=> x = q + y`] THEN ASM_CASES_TAC `q = &0` THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]) in GEN_TAC THEN EQ_TAC THENL [MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; DISCH_TAC] THEN ABBREV_TAC `(canonize:real^N->real^N) = \x. @y. y IN s /\ ?q. rational q /\ q % basis 1 + y = x` THEN SUBGOAL_THEN `!x:real^N. x IN s ==> canonize x IN s /\ ?q. rational q /\ q % basis 1 + canonize x = x` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "canonize" THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `&0` THEN REWRITE_TAC[RATIONAL_CLOSED] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `v = IMAGE (canonize:real^N->real^N) s` THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE (\q. IMAGE (\x:real^N. q % basis 1 + x) v) rational)` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN SIMP_TAC[COUNTABLE_RATIONAL; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC lemma THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN EXPAND_TAC "v" THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN X_GEN_TAC `q:real` THEN REPEAT DISCH_TAC THEN EXPAND_TAC "canonize" THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^N` THEN AP_TERM_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN ASM_REWRITE_TAC[VECTOR_ARITH `q % b + x:real^N = y <=> x = y - q % b`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `x - q % b:real^N = y - r % b - s % b <=> y + (q - r - s) % b = x /\ x + (r + s - q) % b = y`] THEN STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; ARITH; VECTOR_ARITH `y - q % b:real^N = (y + r % b) - s % b <=> (q + r - s) % b = vec 0`] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[REAL_ARITH `a + b - c = &0 <=> c = a + b`; UNWIND_THM2] THEN ASM_SIMP_TAC[RATIONAL_CLOSED]);; let NEGLIGIBLE_IFF_MEASURABLE_SUBSETS = prove (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> measurable t`, MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_IMP_LEBESGUE_MEASURABLE; NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS]);; let NON_MEASURABLE_SET = prove (`?s:real^N->bool. ~lebesgue_measurable s`, MP_TAC(ISPEC `(:real^N)` NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS) THEN REWRITE_TAC[NOT_NEGLIGIBLE_UNIV] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Preserving Lebesgue measurability vs. preserving negligibility. *) (* ------------------------------------------------------------------------- *) let PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE = prove (`!f s:real^N->bool. (!t. negligible t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t)) ==> (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t))`, REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS] THEN REWRITE_TAC[FORALL_SUBSET_IMAGE] THEN ASM_MESON_TAC[NEGLIGIBLE_SUBSET; SUBSET_TRANS]);; let PRESERVES_NEGLIGIBLE_IMAGE = prove (`!f:real^M->real^N s. (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t)) <=> (!t. negligible t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t))`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE] THEN MESON_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]);; let PRESERVES_NEGLIGIBLE_IMAGE_UNIV = prove (`!f:real^M->real^N. (!t. negligible t ==> negligible(IMAGE f t)) <=> (!t. negligible t ==> lebesgue_measurable(IMAGE f t))`, MESON_TAC[PRESERVES_NEGLIGIBLE_IMAGE; SUBSET_UNIV]);; let LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t)) ==> !t. lebesgue_measurable t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP LEBESGUE_MEASURABLE_REGULAR_INNER) THEN ASM_REWRITE_TAC[IMAGE_UNION; IMAGE_UNIONS] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN SUBGOAL_THEN `(k:real^M->bool) SUBSET s` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; FORALL_IN_IMAGE] THEN SIMP_TAC[IN_UNIV; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN GEN_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE = prove (`!f:real^M->real^N s. f continuous_on s ==> ((!t. lebesgue_measurable t /\ t SUBSET s ==> lebesgue_measurable (IMAGE f t)) <=> (!t. negligible t /\ t SUBSET s ==> negligible (IMAGE f t)))`, MESON_TAC[LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE; PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]);; let PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_ALT = prove (`!f:real^M->real^N. f continuous_on s ==> ((!t. lebesgue_measurable t /\ t SUBSET s ==> lebesgue_measurable (IMAGE f t)) <=> (!t. negligible t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t)))`, SIMP_TAC[PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE] THEN MESON_TAC[PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]);; let LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE = prove (`!f:real^M->real^N s. dimindex(:M) <= dimindex(:N) /\ f differentiable_on s /\ lebesgue_measurable s ==> lebesgue_measurable(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE) THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[SUBSET_REFL; DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN ASM_MESON_TAC[DIFFERENTIABLE_ON_SUBSET]);; let LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN = prove (`!f:real^M->real^N s. linear f /\ lebesgue_measurable s /\ dimindex(:M) <= dimindex(:N) ==> lebesgue_measurable(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]);; let MEASURABLE_LINEAR_IMAGE_GEN = prove (`!f:real^M->real^N s. linear f /\ measurable s /\ dimindex(:M) <= dimindex(:N) ==> measurable(IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `m:num <= n ==> m < n \/ m = n`)) THENL [MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]; ASM_CASES_TAC `!x y. (f:real^M->real^N) x = f y ==> x = y` THENL [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_EQ_GEN]; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] DIM_IMAGE_KERNEL_GEN) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV] THEN ONCE_ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(ARITH_RULE `x <= y /\ ~(d = 0) ==> x < y + d`) THEN SIMP_TAC[DIM_SUBSET; IMAGE_SUBSET; SUBSET_UNIV] THEN REWRITE_TAC[IN_UNIV; DIM_EQ_0] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_0) THEN ASM SET_TAC[]]);; let LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN = prove (`!f:real^M->real^N s. dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y) ==> (lebesgue_measurable(IMAGE f s) <=> lebesgue_measurable s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!y. f((g:real^N->real^M) y) = y` ASSUME_TAC THENL [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN) THEN ASM_MESON_TAC[]; ALL_TAC] THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LE_REFL]] THEN DISCH_TAC THEN SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) (IMAGE f s)` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Lebesgue-Lebesgue measurability (preimage of measurable is measurable). *) (* ------------------------------------------------------------------------- *) let DOUBLE_LEBESGUE_MEASURABLE = prove (`!f:real^M->real^N. (!t. lebesgue_measurable t ==> lebesgue_measurable {x | f x IN t}) <=> f measurable_on (:real^M) /\ (!t. negligible t ==> lebesgue_measurable {x | f x IN t})`, GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[MEASURABLE_ON_PREIMAGE_BOREL; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE; BOREL_IMP_LEBESGUE_MEASURABLE] THEN STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_ALMOST_FSIGMA) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real^N->bool`; `n:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[SET_RULE `{x | f x IN s UNION t} = {x | f x IN s} UNION {x | f x IN t}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN ASM_SIMP_TAC[FSIGMA_IMP_BOREL]);; let DOUBLE_LEBESGUE_MEASURABLE_ON = prove (`!f:real^M->real^N s t. lebesgue_measurable s /\ lebesgue_measurable t /\ IMAGE f s SUBSET t ==> ((!u. lebesgue_measurable u /\ u SUBSET t ==> lebesgue_measurable {x | x IN s /\ f x IN u}) <=> f measurable_on s /\ (!u. negligible u /\ u SUBSET t ==> lebesgue_measurable {x | x IN s /\ f x IN u}))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL] THEN EQ_TAC THENL [SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE] THEN DISCH_TAC THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t INTER v:real^N->bool`) THEN ASM_SIMP_TAC[INTER_SUBSET; LEBESGUE_MEASURABLE_INTER; BOREL_IMP_LEBESGUE_MEASURABLE] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "B") (LABEL_TAC "N")) THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_ALMOST_FSIGMA) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real^N->bool`; `n:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[SET_RULE `{x | x IN a /\ f x IN s UNION t} = {x | x IN a /\ f x IN s} UNION {x | x IN a /\ f x IN t}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN CONJ_TAC THENL [REMOVE_THEN "B" MATCH_MP_TAC; REMOVE_THEN "N" MATCH_MP_TAC] THEN ASM_SIMP_TAC[FSIGMA_IMP_BOREL] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Measurability of continuous functions. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove (`!f:real^M->real^N s. f continuous_on s /\ lebesgue_measurable s ==> f measurable_on s`, let lemma = prove (`!s. lebesgue_measurable s ==> ?u:num->real^M->bool. (!n. closed(u n)) /\ (!n. u n SUBSET s) /\ (!n. measurable(s DIFF u n) /\ measure(s DIFF u n) < inv(&n + &1)) /\ (!n. u(n) SUBSET u(SUC n))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n t. closed t /\ t SUBSET s ==> ?u:real^M->bool. closed u /\ t SUBSET u /\ u SUBSET s /\ measurable(s DIFF u) /\ measure(s DIFF u) < inv(&n + &1)` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s DIFF t:real^M->bool`; `inv(&n + &1)`] LEBESGUE_MEASURABLE_INNER_CLOSED) THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_CLOSED] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t UNION u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNION] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = s DIFF t DIFF u`]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:num->(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN MP_TAC(prove_recursive_functions_exist num_RECURSION `(u:num->real^M->bool) 0 = v 0 {} /\ (!n. u(SUC n) = v (SUC n) (u n))`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->real^M->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!n. closed(u n) /\ (u:num->real^M->bool) n SUBSET s` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET]; ASM_SIMP_TAC[]] THEN INDUCT_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET]]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `u:num->real^M->bool` STRIP_ASSUME_TAC o MATCH_MP lemma) THEN SUBGOAL_THEN `lebesgue_measurable((:real^M) DIFF s)` MP_TAC THENL [ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC o MATCH_MP lemma) THEN REWRITE_TAC[measurable_on] THEN EXISTS_TAC `(:real^M) DIFF (UNIONS {u n | n IN (:num)} UNION UNIONS {v n | n IN (:num)})` THEN SUBGOAL_THEN `!n. ?g. g continuous_on (:real^M) /\ (!x. x IN u(n) UNION v(n:num) ==> g x = if x IN s then (f:real^M->real^N)(x) else vec 0)` MP_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN ASM_SIMP_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; CLOSED_UNION] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `g:num->real^M->real^N` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `(s DIFF UNIONS {u n | n IN (:num)}) UNION ((:real^M) DIFF s DIFF UNIONS {v n | n IN (:num)})` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `s DIFF u(n:num):real^M->bool`; EXISTS_TAC `(:real^M) DIFF s DIFF v(n:num):real^M->bool`] THEN (CONJ_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN CONJ_TAC THENL [ASM_ARITH_TAC; REAL_ARITH_TAC]); X_GEN_TAC `x:real^M` THEN REWRITE_TAC[SET_RULE `~(x IN (UNIV DIFF (s UNION t))) <=> x IN s \/ x IN t`] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[OR_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_UNION] THEN SUBGOAL_THEN `!i j. i <= j ==> (u:num->real^M->bool)(i) SUBSET u(j) /\ (v:num->real^M->bool)(i) SUBSET v(j)` (fun th -> ASM_MESON_TAC[SUBSET; th]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]);; let CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET = prove (`!f:real^M->real^N s. f continuous_on s /\ closed s ==> f measurable_on s`, SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; LEBESGUE_MEASURABLE_CLOSED]);; let CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove (`!f:real^M->real^N s m. f continuous_on (s DIFF m) /\ lebesgue_measurable s /\ negligible m ==> f measurable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) measurable_on (s DIFF m)` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; MATCH_MP_TAC MEASURABLE_ON_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]);; let MEASURABLE_CONTINUOUS_COMPOSE = prove (`!f:real^N->real^P g:real^M->real^N. f measurable_on UNIV /\ g continuous_on UNIV /\ (!k. negligible k ==> negligible {x | g x IN k}) ==> (f o g) measurable_on UNIV`, REWRITE_TAC[measurable_on; IN_UNIV] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `h:num->real^N->real^P`] THEN STRIP_TAC THEN EXISTS_TAC `{x | (g:real^M->real^N) x IN k}` THEN EXISTS_TAC `\n x:real^M. (h:num->real^N->real^P) n (g x)` THEN ASM_SIMP_TAC[IN_ELIM_THM; o_DEF] THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]);; let MEASURABLE_ON_COMPOSE_REV = prove (`!f:real^N->real^P g:real^M->real^N s t. lebesgue_measurable s /\ IMAGE g s = t /\ (!k. lebesgue_measurable k /\ k SUBSET s ==> lebesgue_measurable (IMAGE g k)) /\ (f o g) measurable_on s ==> f measurable_on t`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `lebesgue_measurable(t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^P->bool` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[o_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN s /\ (f:real^N->real^P) (g(x:real^M)) IN u}`) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let MEASURABLE_ON_CONTINUOUS_COMPOSE_REV = prove (`!f:real^N->real^P g:real^M->real^N s t. lebesgue_measurable s /\ IMAGE g s = t /\ (!k. negligible k /\ k SUBSET s ==> lebesgue_measurable (IMAGE g k)) /\ g continuous_on s /\ (f o g) measurable_on s ==> f measurable_on t`, REPEAT GEN_TAC THEN REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] MEASURABLE_ON_COMPOSE_REV)) THEN ASM_MESON_TAC[PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_ALT]);; let MEASURABLE_ON_COMPOSE_GEN = prove (`!f:real^N->real^P g:real^M->real^N s t. lebesgue_measurable t /\ IMAGE g s SUBSET t /\ (!k. lebesgue_measurable k /\ k SUBSET t ==> lebesgue_measurable {x | x IN s /\ g x IN k}) /\ f measurable_on t ==> (f o g) measurable_on s`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `lebesgue_measurable(s:real^M->bool)` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^P->bool` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[o_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (f:real^N->real^P) x IN u}`) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let MEASURABLE_ON_COMPOSE_ALT = prove (`!f:real^N->real^P g:real^M->real^N s t. lebesgue_measurable s /\ lebesgue_measurable t /\ IMAGE g s SUBSET t /\ (!k. negligible k /\ k SUBSET t ==> lebesgue_measurable {x | x IN s /\ g x IN k}) /\ g measurable_on s /\ f measurable_on t ==> (f o g) measurable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DOUBLE_LEBESGUE_MEASURABLE_ON]);; let MEASURABLE_ON_CONTINUOUS_COMPOSE = prove (`!f:real^N->real^P g:real^M->real^N s t. lebesgue_measurable s /\ lebesgue_measurable t /\ IMAGE g s SUBSET t /\ f measurable_on t /\ g continuous_on s /\ (!k. negligible k /\ k SUBSET t ==> lebesgue_measurable {x | x IN s /\ g x IN k}) ==> (f o g) measurable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_ALT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET]);; let MEASURABLE_ON_DIFFERENTIABLE_IMAGE = prove (`!f:real^N->real^P g:real^M->real^N s. dimindex(:M) <= dimindex(:N) /\ lebesgue_measurable s /\ g differentiable_on s /\ (f o g) measurable_on s ==> f measurable_on (IMAGE g s)`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] MEASURABLE_ON_CONTINUOUS_COMPOSE_REV)) THEN ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_MESON_TAC[DIFFERENTIABLE_ON_SUBSET; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]);; let BOREL_MEASURABLE_IMP_MEASURABLE_ON = prove (`!f:real^M->real^N s. f borel_measurable_on s /\ lebesgue_measurable s ==> f measurable_on s`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL [MESON_TAC[CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET]; REPEAT GEN_TAC THEN ASM_CASES_TAC `lebesgue_measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC [`f:num->real^M->real^N`; `{}:real^M->bool`] THEN ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY]]);; (* ------------------------------------------------------------------------- *) (* Versions of the Lebesgue density theorem, both integral and measure *) (* forms. Later we have cosmetically nicer ones using real limits. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_CBALL = prove (`!f:real^M->real^N. (!a b. f absolutely_integrable_on interval[a,b]) ==> ?k. negligible k /\ !x. ~(x IN k) ==> ((\e. inv(measure(cball(x,drop e))) % integral (cball(x,drop e)) (\y. lift(norm(f y - f x)))) --> vec 0) (at (vec 0) within {t | &0 < drop t})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[LIM_WITHIN; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &(dimindex(:M)) pow dimindex(:M)`]) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; DIST_0; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_LIFT; NORM_LIFT; LIFT_DROP] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN REWRITE_TAC[REAL_ABS_MUL; NORM_MUL] THEN ONCE_REWRITE_TAC [REAL_ARITH `x <= (abs a * b) * c <=> x <= (abs(a) * c) * b`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL [SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN REWRITE_TAC[REAL_ABS_INV; real_div; GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_ABS_NZ; CONTENT_EQ_0] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC; SIMP_TAC[real_abs; CONTENT_POS_LE; MEASURE_POS_LE; MEASURABLE_CBALL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(interval[x - h / &(dimindex(:M)) % vec 1:real^M, x + h / &(dimindex(:M)) % vec 1]) * &(dimindex (:M)) pow dimindex (:M)` THEN CONJ_TAC THENL [REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ARITH `x - h <= x + h <=> &0 <= h`; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `(x + h) - (x - h) = &2 * h`; PRODUCT_CONST_NUMSEG_1; REAL_POW_DIV; REAL_POW_MUL] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> y <= x`) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN REWRITE_TAC[REAL_POW_EQ_0; REAL_OF_NUM_EQ; DIMINDEX_NONZERO]; MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POS; REAL_POW_LE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_CBALL] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT; REAL_MUL_RID; REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN STRIP_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN ASM_REWRITE_TAC[CARD_NUMSEG_1; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]]; REWRITE_TAC[NORM_POS_LE] THEN SUBGOAL_THEN `cball(x:real^M,h) SUBSET interval[x - h % vec 1,x + h % vec 1]` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT; REAL_MUL_RID; REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on cball(x,h)` ASSUME_TAC THENL [ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET; LEBESGUE_MEASURABLE_CBALL]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[NORM_1] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= abs b`) THEN REWRITE_TAC[GSYM NORM_1] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB; ABSOLUTELY_INTEGRABLE_ON_CONST; MEASURABLE_CBALL; MEASURABLE_INTERVAL; IN_UNIV] THEN GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP; NORM_0; DROP_VEC; NORM_POS_LE; REAL_LE_REFL]) THEN ASM SET_TAC[]]);; let LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_BALL = prove (`!f:real^M->real^N. (!a b. f absolutely_integrable_on interval[a,b]) ==> ?k. negligible k /\ !x. ~(x IN k) ==> ((\e. inv(measure(ball(x,drop e))) % integral (ball(x,drop e)) (\y. lift(norm(f y - f x)))) --> vec 0) (at (vec 0) within {t | &0 < drop t})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_CBALL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_WITHIN; IN_ELIM_THM; FORALL_LIFT; LIFT_DROP] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[DIST_0; NORM_LIFT; REAL_LT_01] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM CLOSURE_BALL; MEASURE_CLOSURE; BOUNDED_BALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_BALL] THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN ASM_SIMP_TAC[CLOSURE_BALL] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `sphere(x:real^M,e)` THEN REWRITE_TAC[NEGLIGIBLE_SPHERE] THEN REWRITE_TAC[GSYM SPHERE_UNION_BALL] THEN SET_TAC[]);; let LEBESGUE_DENSITY_THEOREM_INTEGRAL_CBALL = prove (`!f:real^M->real^N s. (!a b. f absolutely_integrable_on (s INTER interval[a,b])) ==> ?k. negligible k /\ !x. ~(x IN k) ==> ((\e. inv(measure(cball(x,drop e))) % integral (s INTER cball(x,drop e)) f) --> (if x IN s then f x else vec 0)) (at (vec 0) within {t | &0 < drop t})`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_INTER] THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_INTER] THEN ABBREV_TAC `g:real^M->real^N = \x. if x IN s then f x else vec 0` THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`g:real^M->real^N`,`f:real^M->real^N`) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_CBALL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [LIM_NULL] THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_NULL_COMPARISON) THEN REWRITE_TAC[EVENTUALLY_WITHIN; IN_ELIM_THM; DIST_0; FORALL_LIFT] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[LIFT_DROP; NORM_LIFT; REAL_LT_01] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[DROP_CMUL] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div); REAL_LE_RDIV_EQ; MEASURE_CBALL_POS] THEN MATCH_MP_TAC(REAL_ARITH `abs(x * y) <= z ==> y * x <= z`) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_MUL] THEN ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ; MEASURE_CBALL_POS] THEN SIMP_TAC[GSYM INTEGRAL_CONST_GEN; MEASURABLE_CBALL; VECTOR_MUL_LID] THEN SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on cball(x,e)` ASSUME_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `interval[x - e % vec 1:real^M,x + e % vec 1]` THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_CBALL] THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT; REAL_MUL_RID; REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM]; ASM_SIMP_TAC[GSYM INTEGRAL_SUB; INTEGRABLE_ON_CONST; MEASURABLE_CBALL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB; ABSOLUTELY_INTEGRABLE_ON_CONST; MEASURABLE_CBALL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]);; let LEBESGUE_DENSITY_THEOREM_INTEGRAL_BALL = prove (`!f:real^M->real^N s. (!a b. f absolutely_integrable_on (s INTER interval[a,b])) ==> ?k. negligible k /\ !x. ~(x IN k) ==> ((\e. inv(measure(ball(x,drop e))) % integral (s INTER ball(x,drop e)) f) --> (if x IN s then f x else vec 0)) (at (vec 0) within {t | &0 < drop t})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_DENSITY_THEOREM_INTEGRAL_CBALL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_WITHIN; IN_ELIM_THM; FORALL_LIFT; LIFT_DROP] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[DIST_0; NORM_LIFT; REAL_LT_01] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM CLOSURE_BALL; MEASURE_CLOSURE; BOUNDED_BALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_BALL] THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN ASM_SIMP_TAC[CLOSURE_BALL] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `sphere(x:real^M,e)` THEN REWRITE_TAC[NEGLIGIBLE_SPHERE] THEN REWRITE_TAC[GSYM SPHERE_UNION_BALL] THEN SET_TAC[]);; let LEBESGUE_DENSITY_THEOREM_LIFT_CBALL = prove (`!s:real^N->bool. lebesgue_measurable s ==> ?k. negligible k /\ !x. ~(x IN k) ==> ((\e. lift(measure(s INTER cball(x,drop e)) / measure(cball(x,drop e)))) --> (if x IN s then vec 1 else vec 0)) (at (vec 0) within {t | &0 < drop t})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`indicator(s:real^N->bool)`; `(:real^N)`] LEBESGUE_DENSITY_THEOREM_INTEGRAL_CBALL) THEN REWRITE_TAC[IN_UNIV; INTER_UNIV] THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_INDICATOR] THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_INTERVAL] THEN REWRITE_TAC[indicator; INTEGRAL_RESTRICT_INTER] THEN ASM_SIMP_TAC[INTEGRAL_CONST_GEN; MEASURABLE_CBALL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE] THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL]);; let LEBESGUE_DENSITY_THEOREM_LIFT_BALL = prove (`!s:real^N->bool. lebesgue_measurable s ==> ?k. negligible k /\ !x. ~(x IN k) ==> ((\e. lift(measure(s INTER ball(x,drop e)) / measure(ball(x,drop e)))) --> (if x IN s then vec 1 else vec 0)) (at (vec 0) within {t | &0 < drop t})`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_DENSITY_THEOREM_LIFT_CBALL) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN X_GEN_TAC `e:real` THEN AP_TERM_TAC THEN BINOP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `sphere(x:real^N,e)` THEN REWRITE_TAC[NEGLIGIBLE_SPHERE] THEN REWRITE_TAC[GSYM SPHERE_UNION_BALL] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* More refined form of "derivative is zero at a maximum or minimum" *) (* where we only need the derivative to hold w.r.t. a Lebesgue measurable *) (* set based at a point of density 1 (actually this could be further *) (* sharpened to density > 1/2, but it hardly seems worth it). *) (* ------------------------------------------------------------------------- *) let DIFFERENTIAL_ZERO_MAXMIN_DENSITY = prove (`!f f' s a:real^N. (f has_derivative f') (at a within s) /\ (eventually (\x. drop(f a) <= drop(f x)) (at a within s) \/ eventually (\x. drop(f x) <= drop(f a)) (at a within s)) /\ lebesgue_measurable s /\ ((\e. lift(measure(s INTER ball(a,drop e)) / measure(ball(a,drop e)))) --> vec 1) (at (vec 0) within {t | &0 < drop t}) ==> f' = \v. vec 0`, let lemma = prove (`!k a d:real^N. &0 < k /\ k < &1 /\ ~(d = vec 0) ==> ?e. &0 < e /\ !r. &0 < r ==> measurable({x | d dot (x - a) > k * norm d * norm(x - a)} INTER ball(a,r)) /\ e * measure(ball(a,r)) <= measure({x | d dot (x - a) > k * norm d * norm(x - a)} INTER ball(a,r))`, REPEAT GEN_TAC THEN GEN_GEOM_ORIGIN_TAC `a:real^N` ["d"] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN EXISTS_TAC `measure({x:real^N | d dot x > k * norm d * norm x} INTER ball(vec 0,&1)) / measure(ball(vec 0:real^N,&1))` THEN ONCE_REWRITE_TAC[REAL_ARITH `(a / b) * c:real = (a * c) / b`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_01; MEASURE_BALL_POS] THEN SUBGOAL_THEN `open({x:real^N | d dot x > k * norm d * norm x} INTER ball(vec 0,&1))` ASSUME_TAC THENL [MATCH_MP_TAC OPEN_INTER THEN REWRITE_TAC[OPEN_BALL; real_gt] THEN ONCE_REWRITE_TAC[MESON[REAL_SUB_LT; LIFT_DROP] `x < y <=> &0 < drop(lift(y - x))`] THEN ONCE_REWRITE_TAC[SET_RULE `{x | &0 < drop(f x)} = {x | f x IN {y | &0 < drop y}}`] THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN REWRITE_TAC[drop; REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN REWRITE_TAC[LIFT_SUB; LIFT_CMUL] THEN GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_CMUL) THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC MEASURE_OPEN_POS_LT THEN ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_BALL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `(k + &1) / &2 % inv(norm d) % d:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_BALL_0; DOT_RMUL] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `e * inv d * p > k * d * q <=> q * k * d < (e * p) / d`] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; NORM_POS_LT; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_POW_2; NORM_POW_2] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_MUL_ASSOC; DOT_POS_LT] THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_ARITH `&0 < k ==> abs((k + &1) / &2) = (k + &1) / &2`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `r:real` THEN DISCH_TAC THEN SUBGOAL_THEN `ball(vec 0:real^N,r) = ball(r % vec 0,r * &1)` SUBST1_TAC THENL [SIMP_TAC[VECTOR_MUL_RZERO; REAL_MUL_RID]; ALL_TAC] THEN ASM_SIMP_TAC[BALL_SCALING; MEASURE_SCALING; MEASURABLE_BALL] THEN SUBGOAL_THEN `{x:real^N | d dot x > k * norm d * norm x} INTER IMAGE (\x. r % x) (ball (vec 0,&1)) = IMAGE (\x. r % x) ({x:real^N | d dot x > k * norm d * norm x} INTER ball(vec 0,&1))` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) /\ (!x. f x IN s <=> x IN s) ==> s INTER IMAGE f t = IMAGE f (s INTER t)`) THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; IN_ELIM_THM] THEN ASM_SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_LT_LMUL_EQ; REAL_ARITH `&0 < r ==> (r * d > g * e * abs r * f <=> r * g * e * f < r * d)`] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[MEASURABLE_SCALING; MEASURE_SCALING; MEASURABLE_OPEN; BOUNDED_INTER; BOUNDED_BALL] THEN REWRITE_TAC[REAL_MUL_AC; REAL_LE_REFL]]) in SUBGOAL_THEN `!f f' s a:real^N. (f has_derivative f') (at a within s) /\ eventually (\x. drop(f x) <= drop(f a)) (at a within s) /\ lebesgue_measurable s /\ ((\e. lift(measure(s INTER ball(a,drop e)) / measure(ball(a,drop e)))) --> vec 1) (at (vec 0) within {t | &0 < drop t}) ==> f' = \v. vec 0` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`(--) o (f:real^N->real^1)`; `(--) o (f':real^N->real^1)`]); FIRST_X_ASSUM(MP_TAC o SPECL [`f:real^N->real^1`; `f':real^N->real^1`])] THEN DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `a:real^N`]) THEN ASM_SIMP_TAC[HAS_DERIVATIVE_NEG; o_DEF; DROP_NEG; REAL_LE_NEG2] THEN REWRITE_TAC[FUN_EQ_THM; VECTOR_NEG_EQ_0]] THEN REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative_within; GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!e. &0 < e ==> P e) /\ Q ==> !e. &0 < e ==> P e /\ Q`)) THEN REWRITE_TAC[GSYM EVENTUALLY_AND; DIST_0; NORM_MUL; REAL_ABS_INV] THEN REWRITE_TAC[REAL_ABS_NORM] THEN DISCH_TAC THEN SUBGOAL_THEN `!e. &0 < e ==> eventually (\x. drop(f'(x - a:real^N)) <= e * norm(x - a)) (at a within s)` MP_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_CASES_TAC `x:real^N = a` THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN REWRITE_TAC[DROP_VEC; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL]; ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[NORM_1; DROP_SUB; DROP_ADD] THEN REAL_ARITH_TAC]; FIRST_X_ASSUM(K ALL_TAC o SPEC `&0:real`)] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_TO_REALS) THEN ABBREV_TAC `d = row 1 (matrix(f':real^N->real^1))` THEN DISCH_THEN SUBST1_TAC THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `f':real^N->real^1`) o concl)) THEN REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[FORALL_DOT_EQ_0] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o GEN `e:real` o SPEC `e * norm(d:real^N)`) THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; NORM_POS_LT] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &2`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC(ISPECL [`&1 / &2`; `a:real^N`; `d:real^N`] lemma) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; FORALL_LIFT; LIFT_DROP; DIST_0] THEN REWRITE_TAC[DIST_LIFT; GSYM LIFT_NUM; NORM_LIFT] THEN DISCH_THEN(X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `r = min R k / &2` THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `r:real`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `m <= &1 - e ==> abs(m - &1) < e ==> F`) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; MEASURE_BALL_POS] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `y <= m - x ==> e * m <= x ==> y <= (&1 - e) * m`) THEN ASM_SIMP_TAC[GSYM MEASURE_DIFF_SUBSET; MEASURABLE_BALL; INTER_SUBSET] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_BALL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE] THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_BALL] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN b ==> ~(x IN h)) ==> s INTER b SUBSET b DIFF (h INTER b)`) THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = a` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO; NORM_0; real_gt] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC);; let DIFFERENTIAL_ZERO_LEVELSET_DENSITY = prove (`!f:real^M->real^N f' s a c. (f has_derivative f') (at a within s) /\ eventually (\x. f x = c) (at a within s) /\ lebesgue_measurable s /\ ((\e. lift (measure (s INTER ball (a,drop e)) / measure (ball (a,drop e)))) --> vec 1) (at (vec 0) within {t | &0 < drop t}) ==> f' = \h. vec 0`, ONCE_REWRITE_TAC[HAS_DERIVATIVE_COMPONENTWISE_WITHIN] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift((f':real^M->real^N) x$i)) = (\x. vec 0)` MP_TAC THENL [ALL_TAC; SIMP_TAC[FUN_EQ_THM; GSYM DROP_EQ; LIFT_DROP; DROP_VEC] THEN SIMP_TAC[CART_EQ; VEC_COMPONENT]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIAL_ZERO_MAXMIN_DENSITY THEN MAP_EVERY EXISTS_TAC [`\x. lift((f:real^M->real^N) x$i)`; `s:real^M->bool`; `a:real^M`] THEN ASM_SIMP_TAC[LIFT_DROP] THEN ASM_CASES_TAC `(c:real^N)$i <= (f:real^M->real^N) a$i` THENL [DISJ2_TAC; DISJ1_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; let NEGLIGIBLE_POINTS_OF_AMBIGUOUS_DERIVATIVE = prove (`!f:real^M->real^N s. lebesgue_measurable s ==> negligible {x | x IN s /\ ?y z. (f has_derivative y) (at x within s) /\ (f has_derivative z) (at x within s) /\ ~(y = z)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^M | x IN s /\ ~(((\e. lift(measure(s INTER ball(x,drop e)) / measure(ball(x,drop e)))) --> vec 1) (at (vec 0) within {t | &0 < drop t}))}` THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_DENSITY_THEOREM_LIFT_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p ==> ~r ==> q`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC(TAUT `(p ==> r ==> ~q) ==> p /\ q ==> p /\ ~r`) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`f':real^M->real^N`; `f'':real^M->real^N`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[FUN_EQ_THM] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN GEN_REWRITE_TAC I [GSYM FUN_EQ_THM] THEN MATCH_MP_TAC DIFFERENTIAL_ZERO_LEVELSET_DENSITY THEN MAP_EVERY EXISTS_TAC [`\x. (f:real^M->real^N) x - f x`; `s:real^M->bool`; `x:real^M`; `vec 0:real^N`] THEN ASM_SIMP_TAC[HAS_DERIVATIVE_SUB] THEN REWRITE_TAC[VECTOR_SUB_REFL; EVENTUALLY_TRUE]]);; (* ------------------------------------------------------------------------- *) (* Can only have countably many disjoint sets of positive measure. *) (* ------------------------------------------------------------------------- *) let PAIRWISE_DISJOINT_LEBESGUE_MEASURABLE_IMP_COUNTABLE = prove (`!f:(real^N->bool)->bool. pairwise (\s t. negligible (s INTER t)) f /\ (!s. s IN f ==> lebesgue_measurable s /\ ~negligible s) ==> COUNTABLE f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE (\(m,n). {s | s IN f /\ inv(&m + &1) < measure(s INTER interval[--vec n:real^N,vec n])}) ((:num) CROSS (:num)))` THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; NUM_COUNTABLE] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_CROSS; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN MATCH_MP_TAC(MESON[] `!n. ~(FINITE s ==> n <= CARD s) ==> FINITE s`) THEN EXISTS_TAC `1 + (m + 1) * (2 * n) EXP dimindex(:N)` THEN MATCH_MP_TAC(ONCE_REWRITE_RULE [GSYM CONTRAPOS_THM] CHOOSE_SUBSET_STRONG) THEN REWRITE_TAC[NOT_EXISTS_THM; SUBSET; HAS_SIZE; IN_ELIM_THM] THEN X_GEN_TAC `t:(real^N->bool)->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\s. s INTER interval[--vec n:real^N,vec n]`; `t:(real^N->bool)->bool`] MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_INTERVAL; NOT_IMP] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN SET_TAC[]; MATCH_MP_TAC(REAL_ARITH `!z. x <= z /\ z < y ==> ~(x = y)`) THEN EXISTS_TAC `measure(interval[--vec n:real^N,vec n])` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_INTERVAL]; TRANS_TAC REAL_LET_TRANS `sum (t:(real^N->bool)->bool) (\s. inv(&m + &1))` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_CONST; MEASURE_INTERVAL; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `-- &n <= &n /\ x - --x = &2 * x`] THEN SIMP_TAC[REAL_FIELD `(&1 + (&m + &1) * x) * inv(&m + &1) = x + inv(&m + &1)`] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ &0 <= z ==> x <= y + z`) THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &m + &1`] THEN REWRITE_TAC[PRODUCT_CONST_NUMSEG; REAL_OF_NUM_MUL; REAL_OF_NUM_POW; REAL_OF_NUM_LE; ADD_SUB; LE_REFL]; MATCH_MP_TAC SUM_LT_ALL THEN ASM_SIMP_TAC[GSYM CARD_EQ_0] THEN REWRITE_TAC[MULT_EQ_0; EXP_EQ_0; ARITH_EQ; ADD_EQ_0]]]]; REWRITE_TAC[SUBSET; UNIONS_IMAGE] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_PAIR_THM; IN_CROSS; IN_UNIV; IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [NEGLIGIBLE_ON_COUNTABLE_INTERVALS]) THEN REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ARCH_EVENTUALLY_INV1] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Various Vitali-type covering lemmas. *) (* ------------------------------------------------------------------------- *) let WIENER_COVERING_LEMMA_BALLS = prove (`!k a:A->real^N r s. FINITE k /\ s SUBSET UNIONS(IMAGE (\i. ball(a i,r i)) k) ==> ?c. c SUBSET k /\ pairwise (\i j. DISJOINT (ball(a i,r i)) (ball(a j,r j))) c /\ s SUBSET UNIONS(IMAGE (\i. ball(a i,&3 * r i)) c)`, REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `CARD(k:A->bool)` THEN X_GEN_TAC `s:real^N->bool` THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[PAIRWISE_EMPTY; SUBSET_EMPTY; IMAGE_CLAUSES; FINITE_EMPTY; UNWIND_THM2] THEN STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (r:A->real) k` SUP_FINITE) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:A` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_CASES_TAC `(r:A->real) n <= &0` THENL [EXISTS_TAC `{}:A->bool` THEN ASM_REWRITE_TAC[PAIRWISE_EMPTY; EMPTY_SUBSET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET u ==> u = {} ==> s SUBSET t`)) THEN REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_IMAGE; BALL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{i | i IN k /\ DISJOINT (ball((a:A->real^N) i,r i)) (ball(a n,r n))}`) THEN ANTS_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `i IN s ==> ~P i ==> {j | j IN s /\ P j} PSUBSET s`)) THEN ASM_REWRITE_TAC[GSYM DISJOINT_EMPTY_REFL; BALL_EQ_EMPTY]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `s DIFF ball((a:A->real^N) n,&3 * r n)`) THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET UNIONS(IMAGE h f) ==> g SUBSET f /\ (!i. i IN f DIFF g ==> h i SUBSET b) ==> s DIFF b SUBSET UNIONS(IMAGE h g)`)) THEN REWRITE_TAC[SUBSET_RESTRICT; SET_RULE `i IN k DIFF {x | x IN k /\ P x} <=> i IN k /\ ~P i`] THEN X_GEN_TAC `m:A` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:A`) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[DISJOINT; EXTENSION; SUBSET; NOT_IN_EMPTY; IN_BALL; IN_INTER] THEN CONV_TAC NORM_ARITH; DISCH_THEN(X_CHOOSE_THEN `c:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(n:A) INSERT c` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[PAIRWISE_INSERT; IMAGE_CLAUSES; UNIONS_INSERT] THEN ASM SET_TAC[]]);; let WIENER_COVERING_LEMMA_CBALLS = prove (`!k a:A->real^N r s. FINITE k /\ s SUBSET UNIONS(IMAGE (\i. cball(a i,r i)) k) ==> ?c. c SUBSET k /\ pairwise (\i j. DISJOINT (cball(a i,r i)) (cball(a j,r j))) c /\ s SUBSET UNIONS(IMAGE (\i. cball(a i,&3 * r i)) c)`, REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `CARD(k:A->bool)` THEN X_GEN_TAC `s:real^N->bool` THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[PAIRWISE_EMPTY; SUBSET_EMPTY; IMAGE_CLAUSES; FINITE_EMPTY; UNWIND_THM2] THEN STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (r:A->real) k` SUP_FINITE) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:A` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_CASES_TAC `(r:A->real) n < &0` THENL [EXISTS_TAC `{}:A->bool` THEN ASM_REWRITE_TAC[PAIRWISE_EMPTY; EMPTY_SUBSET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET u ==> u = {} ==> s SUBSET t`)) THEN REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_IMAGE; CBALL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_LET_TRANS]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{i | i IN k /\ DISJOINT (cball((a:A->real^N) i,r i)) (cball(a n,r n))}`) THEN ANTS_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `i IN s ==> ~P i ==> {j | j IN s /\ P j} PSUBSET s`)) THEN ASM_REWRITE_TAC[GSYM DISJOINT_EMPTY_REFL; CBALL_EQ_EMPTY]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `s DIFF cball((a:A->real^N) n,&3 * r n)`) THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET UNIONS(IMAGE h f) ==> g SUBSET f /\ (!i. i IN f DIFF g ==> h i SUBSET b) ==> s DIFF b SUBSET UNIONS(IMAGE h g)`)) THEN REWRITE_TAC[SUBSET_RESTRICT; SET_RULE `i IN k DIFF {x | x IN k /\ P x} <=> i IN k /\ ~P i`] THEN X_GEN_TAC `m:A` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:A`) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[DISJOINT; EXTENSION; SUBSET; NOT_IN_EMPTY; IN_CBALL; IN_INTER] THEN CONV_TAC NORM_ARITH; DISCH_THEN(X_CHOOSE_THEN `c:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(n:A) INSERT c` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[PAIRWISE_INSERT; IMAGE_CLAUSES; UNIONS_INSERT] THEN ASM SET_TAC[]]);; let VITALI_COVERING_LEMMA_CBALLS_BALLS = prove (`!a:A->real^N r k B. (!i. i IN k ==> &0 < r i /\ r i <= B) ==> ?c. COUNTABLE c /\ c SUBSET k /\ pairwise (\i j. DISJOINT (cball(a i,r i)) (cball(a j,r j))) c /\ !i. i IN k ==> ?j. j IN c /\ ~DISJOINT (cball(a i,r i)) (cball(a j,r j)) /\ cball(a i,r i) SUBSET ball(a j,&5 * r j)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c. (!n. c n SUBSET k /\ (!i:A. i IN c n ==> B / &2 pow n <= r i) /\ pairwise (\i j. DISJOINT (cball(a i,r i)) (cball(a j,r j))) (c n) /\ !i. i IN k /\ B / &2 pow n < r i ==> ?j. j IN c n /\ ~DISJOINT (cball(a i:real^N,r i)) (cball(a j,r j)) /\ cball(a i,r i) SUBSET ball(a j,&5 * r j)) /\ (!n. c n SUBSET c(SUC n))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [EXISTS_TAC `{}:A->bool` THEN REWRITE_TAC[EMPTY_SUBSET] THEN REWRITE_TAC[PAIRWISE_EMPTY; NOT_IN_EMPTY; real_pow; REAL_DIV_1] THEN ASM_MESON_TAC[REAL_LET_ANTISYM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `c:A->bool`] THEN STRIP_TAC THEN ABBREV_TAC `d = {i | i IN k /\ B / &2 pow SUC n < r i /\ cball((a:A->real^N) i,r i) INTER UNIONS (IMAGE (\j. cball(a j,r j)) c) = {}}` THEN MP_TAC(ISPEC `\c. c SUBSET d /\ pairwise (\i j. DISJOINT (cball((a:A->real^N) i,r i)) (cball(a j,r j))) c` ZL_SUBSETS_UNIONS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `f:(A->bool)->bool` THEN SIMP_TAC[UNIONS_SUBSET; pairwise] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `c UNION e:A->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION; PAIRWISE_UNION] THEN REWRITE_TAC[FORALL_IN_UNION] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `i:A` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `B / &2 pow n` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [SUBGOAL_THEN `&0 < r(i:A) /\ r i <= B` MP_TAC THENL [ASM SET_TAC[]; REAL_ARITH_TAC]; REWRITE_TAC[REAL_INV_POW] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ARITH_TAC]; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `i:A` THEN STRIP_TAC THEN ASM_CASES_TAC `B / &2 pow n < r(i:A)` THENL [ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN MATCH_MP_TAC(MESON[] `(!j. P j ==> Q j ==> R j) /\ (?j. P j /\ Q j) ==> (?j. P j /\ Q j /\ R j)`) THEN CONJ_TAC THENL [X_GEN_TAC `j:A` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THEN REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER; SUBSET; IN_BALL; IN_CBALL] THEN MATCH_MP_TAC(NORM_ARITH `r < &2 * s ==> (?x. dist(i:real^N,x) <= r /\ dist(j,x) <= s) ==> !z. dist(i,z) <= r ==> dist(j,z) < &5 * s`) THEN TRANS_TAC REAL_LET_TRANS `B / &2 pow n` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(REAL_ARITH `&0 < j /\ a <= j ==> a < &2 * j`) THEN ASM SET_TAC[]; REWRITE_TAC[REAL_ARITH `a / b < &2 * c <=> a / &2 / b < c`] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div; GSYM(CONJUNCT2 real_pow)] THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `(i:A) IN d` THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(i:A) INSERT e`) THEN ASM_REWRITE_TAC[INSERT_SUBSET; SET_RULE `s SUBSET x INSERT s`] THEN ASM_REWRITE_TAC[PAIRWISE_INSERT; SET_RULE `s = x INSERT s <=> x IN s`] THEN ASM_CASES_TAC `(i:A) IN e` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[UNIONS_UNION; IMAGE_UNION] THEN SUBGOAL_THEN `~(cball((a:A->real^N) i,r i) = {})` MP_TAC THENL [ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT]; ASM SET_TAC[]] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:num->A->bool` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS (IMAGE (c:num->A->bool) (:num))` THEN MATCH_MP_TAC(TAUT `q /\ (q /\ r ==> p) /\ r /\ s ==> p /\ q /\ r /\ s`) THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; SPEC_TAC(`UNIONS (IMAGE (c:num->A->bool) (:num))`,`q:A->bool`) THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\i. cball((a:A->real^N) i,r i)`; `q:A->bool`] COUNTABLE_IMAGE_INJ_EQ) THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`i:A`; `j:A`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ DISJOINT s t ==> ~(s = t)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[CBALL_EQ_EMPTY] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x < &0)`) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC COUNTABLE_DISJOINT_NONEMPTY_INTERIOR_SUBSETS THEN SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; INTERIOR_CBALL; BALL_EQ_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN REWRITE_TAC[GSYM REAL_NOT_LT; pairwise] THEN ASM SET_TAC[]; MATCH_MP_TAC PAIRWISE_CHAIN_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_IMAGE_2; IN_UNIV] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `(!x y. P x y ==> Q x y) ==> (!x y. P x y ==> Q x y \/ R x y)`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM SET_TAC[]; X_GEN_TAC `i:A` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `(r:A->real) i / B`] REAL_ARCH_POW_INV) THEN SUBGOAL_THEN `&0 < (r:A->real) i /\ r i <= B` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < B` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM REAL_INV_POW] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[UNIONS_IMAGE; IN_UNIV; IN_ELIM_THM] THEN ASM SET_TAC[]]]);; let VITALI_COVERING_LEMMA_CBALLS = prove (`!s a:A->real^N r k B. s SUBSET UNIONS (IMAGE (\i. cball(a i,r i)) k) /\ (!i. i IN k ==> &0 < r i /\ r i <= B) ==> ?c. COUNTABLE c /\ c SUBSET k /\ pairwise (\i j. DISJOINT (cball(a i,r i)) (cball(a j,r j))) c /\ s SUBSET UNIONS (IMAGE (\i. cball(a i,&5 * r i)) c)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `a:A->real^N` o MATCH_MP VITALI_COVERING_LEMMA_CBALLS_BALLS) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN TRANS_TAC SUBSET_TRANS `UNIONS(IMAGE(\i. ball((a:A->real^N) i,&5 * r i)) c)` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[BALL_SUBSET_CBALL]);; let VITALI_COVERING_LEMMA_BALLS = prove (`!s a:A->real^N r k B. s SUBSET UNIONS (IMAGE (\i. ball(a i,r i)) k) /\ (!i. i IN k ==> &0 < r i /\ r i <= B) ==> ?c. COUNTABLE c /\ c SUBSET k /\ pairwise (\i j. DISJOINT (ball(a i,r i)) (ball(a j,r j))) c /\ s SUBSET UNIONS (IMAGE (\i. ball(a i,&5 * r i)) c)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `a:A->real^N` o MATCH_MP VITALI_COVERING_LEMMA_CBALLS_BALLS) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_IMP)) THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; SET_RULE `s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' ==> DISJOINT s t`]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN TRANS_TAC SUBSET_TRANS `UNIONS(IMAGE(\i. cball((a:A->real^N) i,r i)) k)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[BALL_SUBSET_CBALL]]);; let VITALI_COVERING_THEOREM_CBALLS = prove (`!k a:A->real^N r s. (!i. i IN k ==> &0 < r i) /\ (!x d. x IN s /\ &0 < d ==> ?i. i IN k /\ x IN cball(a i,r i) /\ r i < d) ==> ?c. COUNTABLE c /\ c SUBSET k /\ pairwise (\i j. DISJOINT (cball(a i,r i)) (cball(a j,r j))) c /\ negligible(s DIFF UNIONS {cball(a i,r i) | i IN c})`, SUBGOAL_THEN `!k a:A->real^N r s. (!i. i IN k ==> &0 < r i /\ r i <= &1) /\ (!x d. x IN s /\ &0 < d ==> ?i. i IN k /\ x IN cball(a i,r i) /\ r i < d) ==> ?c. COUNTABLE c /\ c SUBSET k /\ pairwise (\i j. DISJOINT (cball(a i,r i)) (cball(a j,r j))) c /\ negligible(s DIFF UNIONS {cball(a i,r i) | i IN c})` MP_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN ABBREV_TAC `k' = {i | i IN k /\ (r:A->real) i <= &1}` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k':A->bool`; `a:A->real^N`; `r:A->real`; `s:real^N->bool`]) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_ARITH `&0 < d ==> &0 < min d (&1) /\ (x < min d (&1) ==> x < d /\ x <= &1)`]] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:A->real^N`; `r:A->real`; `k:A->bool`; `&1`] VITALI_COVERING_LEMMA_CBALLS_BALLS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:A->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `u:real^N`] THEN ONCE_REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ABBREV_TAC `d = {i | i IN c /\ ~DISJOINT (ball((a:A->real^N) i,&5 * r i)) (interval[l,u])}` THEN SUBGOAL_THEN `COUNTABLE(d:A->bool)` ASSUME_TAC THENL [EXPAND_TAC "d" THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COUNTABLE_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT]; ALL_TAC] THEN SUBGOAL_THEN `measurable(UNIONS(IMAGE (\i. cball((a:A->real^N) i,r i)) d))` ASSUME_TAC THENL [MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `interval[l - vec 6:real^N,u + vec 6]` THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_COUNTABLE_UNIONS; FORALL_IN_IMAGE; LEBESGUE_MEASURABLE_CBALL; COUNTABLE_IMAGE] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN EXPAND_TAC "d" THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `i:A` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SIMP_TAC[SUBSET; SET_RULE `~DISJOINT s t <=> ?x. x IN s /\ x IN t`] THEN REWRITE_TAC[IN_CBALL; IN_BALL; IN_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[VEC_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH `abs(y - x) <= &6 * &1 ==> l <= x /\ x <= u ==> l - &6 <= y /\ y <= u + &6`) THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&6 * (r:A->real) i` THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [dist])) THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN ASM SET_TAC[]]; ALL_TAC] THEN MP_TAC(ISPECL [`IMAGE (\i. cball((a:A->real^N) i,r i)) d`; `measure(UNIONS(IMAGE (\i. cball((a:A->real^N) i,r i)) d))`; `e / &5 pow (dimindex(:N))`] MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_CBALL] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_ARITH `&0 < &5`; CONJ_ASSOC] THEN ONCE_REWRITE_TAC[TAUT `p /\ FINITE s <=> FINITE s /\ p`] THEN REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; MEASURABLE_CBALL; FINITE_IMAGE] THEN ASM SET_TAC[]; REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE]] THEN DISCH_THEN(X_CHOOSE_THEN `d1:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `UNIONS(IMAGE (\i. ball((a:A->real^N) i,&5 * r i)) (d DIFF d1))` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_DIFF; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF UNIONS (IMAGE (\i:A. cball(a i,r i)) d1)` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[GSYM closed; CLOSED_UNIONS; CLOSED_CBALL; FINITE_IMAGE; FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> DISJOINT s t`] THEN DISCH_THEN(X_CHOOSE_THEN `q:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `q / &2`]) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `i:A` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `j:A` STRIP_ASSUME_TAC) THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `j:A` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[IN_DIFF] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT s (UNIONS (IMAGE f k)) ==> (?x. x IN s /\ x IN f i) ==> ~(i IN k)`)) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~DISJOINT s t ==> ?x. x IN s /\ x IN t`)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN REWRITE_TAC[IN_CBALL; IN_BALL] THEN UNDISCH_TAC `(r:A->real) i < q / &2` THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_IMAGE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COUNTABLE_SUBSET)) THEN SET_TAC[]; REWRITE_TAC[FORALL_IN_IMAGE; MEASURABLE_BALL]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `d2:A->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN ASM_SIMP_TAC[MEASURABLE_BALL; MEASURE_POS_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[o_DEF] THEN TRANS_TAC REAL_LE_TRANS `sum d2 (\i. &5 pow dimindex(:N) * measure(ball((a:A->real^N) i,r i)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC MEASURE_BALL_SCALING THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[SUM_LMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_ARITH `&0 < &5`] THEN REWRITE_TAC[GSYM INTERIOR_CBALL] THEN SIMP_TAC[MEASURE_INTERIOR; BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL] THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN ASM_REWRITE_TAC[MEASURABLE_CBALL] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n - e < m ==> m + p <= n ==> p <= e`)) THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNION o lhand o snd) THEN ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; MEASURABLE_CBALL; FINITE_IMAGE] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNION; MEASURABLE_UNIONS; FORALL_IN_IMAGE; MEASURABLE_CBALL; FINITE_IMAGE] THEN ASM SET_TAC[]]);; let VITALI_COVERING_THEOREM_BALLS = prove (`!k a:A->real^N r s. (!x d. x IN s /\ &0 < d ==> ?i. i IN k /\ x IN ball(a i,r i) /\ r i < d) ==> ?c. COUNTABLE c /\ c SUBSET k /\ pairwise (\i j. DISJOINT (ball(a i,r i)) (ball(a j,r j))) c /\ negligible(s DIFF UNIONS {ball(a i,r i) | i IN c})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{i | i IN k /\ &0 < (r:A->real) i}`; `a:A->real^N`; `r:A->real`; `s:real^N->bool`] VITALI_COVERING_THEOREM_CBALLS) THEN SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `d:real`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:A` THEN ASM_CASES_TAC `(r:A->real) i <= &0` THEN ASM_SIMP_TAC[BALL_EMPTY; NOT_IN_EMPTY] THEN SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:A->bool` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_IMP)) THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; SET_RULE `s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' ==> DISJOINT s t`]; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s DIFF UNIONS {cball((a:A->real^N) i,r i) | i IN c} UNION UNIONS {sphere(a i,r i) | i IN c}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN REWRITE_TAC[GSYM BALL_UNION_SPHERE; SIMPLE_IMAGE] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; NEGLIGIBLE_SPHERE]; REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[]]]]);; (* ------------------------------------------------------------------------- *) (* Negligibility is a local property (we actually use the topological *) (* notion, which looks iconoclastic but is perfectly sensible). More *) (* interestingly, it is equivalent, to localized zero density. *) (* ------------------------------------------------------------------------- *) let LOCALLY_NEGLIGIBLE_ALT = prove (`!s:real^N->bool. negligible s <=> !x. x IN s ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ negligible u`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[OPEN_IN_REFL]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE (u:real^N->real^N->bool) s)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC(ISPECL[`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; let LOCALLY_NEGLIGIBLE = prove (`!s:real^N->bool. locally negligible s <=> negligible s`, GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [LOCALLY_NEGLIGIBLE_ALT] THEN MESON_TAC[OPEN_IN_REFL; SUBSET_REFL; NEGLIGIBLE_SUBSET]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `w INTER s:real^N->bool`) THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; INTER_SUBSET; SUBSET_REFL] THEN ASM_MESON_TAC[SUBSET; IN_INTER; OPEN_IN_IMP_SUBSET; NEGLIGIBLE_SUBSET]]);; let LOCALLY_LEBESGUE_MEASURABLE_ALT = prove (`!s:real^N->bool. lebesgue_measurable s <=> !x. x IN s ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ lebesgue_measurable u`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[OPEN_IN_REFL]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `s = UNIONS (IMAGE (u:real^N->real^N->bool) s)` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL[`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; let LOCALLY_LEBESGUE_MEASURABLE = prove (`!s:real^N->bool. locally lebesgue_measurable s <=> lebesgue_measurable s`, GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL [DISCH_TAC THEN ONCE_REWRITE_TAC[LOCALLY_LEBESGUE_MEASURABLE_ALT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_MESON_TAC[LEBESGUE_MEASURABLE_OPEN_IN; OPEN_IN_SUBSET_TRANS]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `w INTER s:real^N->bool`) THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; INTER_SUBSET; SUBSET_REFL] THEN ASM_MESON_TAC[SUBSET; IN_INTER; OPEN_IN_IMP_SUBSET; LEBESGUE_MEASURABLE_OPEN_IN; LEBESGUE_MEASURABLE_INTER]]);; let NEGLIGIBLE_EQ_ZERO_DENSITY_ALT = prove (`!s:real^N->bool. negligible s <=> !x e. x IN s /\ &0 < e ==> ?d u. &0 < d /\ d <= e /\ s INTER ball(x,d) SUBSET u /\ measurable u /\ measure u < e * measure(ball(x,d))`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `e:real` THEN EXISTS_TAC `s INTER ball(x:real^N,e)` THEN ASM_SIMP_TAC[SUBSET_REFL; MEASURABLE_INTER; MEASURABLE_BALL; NEGLIGIBLE_IMP_MEASURABLE; REAL_LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 < y ==> x < y`) THEN ASM_SIMP_TAC[MEASURE_BALL_POS; REAL_LT_MUL] THEN ASM_MESON_TAC[MEASURE_EQ_0; NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN ONCE_REWRITE_TAC[LOCALLY_NEGLIGIBLE_ALT] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN EXISTS_TAC `s INTER ball(z:real^N,&1)` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER] THEN REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`{(x:real^N,d) | x IN s /\ &0 < d /\ ball(x,d) SUBSET ball(z,&1) /\ ?u. s INTER ball(x,d) SUBSET u /\ measurable u /\ measure u < e / measure(ball(z:real^N,&1)) * measure(ball(x,d))}`; `FST:real^N#real->real^N`; `SND:real^N#real->real`; `s INTER ball(z:real^N,&1)`] VITALI_COVERING_THEOREM_BALLS) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real`] THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN EXISTS_TAC `x:real^N` THEN MP_TAC(ISPEC `ball(z:real^N,&1)` OPEN_CONTAINS_BALL) THEN REWRITE_TAC[OPEN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `min (e / measure(ball(z:real^N,&1)) / &2) (min (d / &2) k)`]) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_HALF; REAL_LT_DIV; MEASURE_BALL_POS; REAL_LT_01] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN REPEAT CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `ball(x:real^N,k)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[MEASURE_POS_LE; MEASURABLE_BALL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> min (x / &2) y <= x`) THEN ASM_SIMP_TAC[REAL_LT_DIV; MEASURE_BALL_POS; REAL_LT_01]; ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N#real->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!p. p IN c ==> ?u. s INTER ball p SUBSET u /\ measurable(u:real^N->bool) /\ measure u < e / measure (ball(z:real^N,&1)) * measure(ball p)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MESON_TAC[]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N#real->real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `((s INTER ball(z:real^N,&1)) DIFF UNIONS (IMAGE ball c)) UNION UNIONS(IMAGE u c)` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `measurable(UNIONS(IMAGE (u:real^N#real->real^N->bool) c)) /\ measure(UNIONS(IMAGE u c)) <= e` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] MEASURABLE_NEGLIGIBLE_SYMDIFF); MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= e ==> y <= e`) THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `d:real^N#real->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN TRANS_TAC REAL_LE_TRANS `sum d (\p:real^N#real. e / measure(ball(z:real^N,&1)) * measure(ball p))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUM_LMUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `a / b * c:real = (a * c) / b`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; MEASURE_BALL_POS; REAL_LT_01] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN TRANS_TAC REAL_LE_TRANS `measure(UNIONS (IMAGE ball d):real^N->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_DISJOINT_UNIONS_IMAGE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; MEASURABLE_BALL]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_BALL; UNIONS_SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; MEASURABLE_BALL; FINITE_IMAGE]]);; let NEGLIGIBLE_EQ_ZERO_DENSITY = prove (`!s:real^N->bool. negligible s <=> !x r e. x IN s /\ &0 < e /\ &0 < r ==> ?d u. &0 < d /\ d <= r /\ s INTER ball(x,d) SUBSET u /\ measurable u /\ measure u < e * measure(ball(x,d))`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [NEGLIGIBLE_EQ_ZERO_DENSITY_ALT] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL [MAP_EVERY X_GEN_TAC [`r:real`; `e:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min r e:real`) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LE_MIN] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; MEASURE_BALL_POS] THEN REAL_ARITH_TAC; X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`e:real`; `e:real`]) THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A handy but by no means optimal measurability lemma. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_MEASURABLE_POINTS_OF_CONVERGENCE = prove (`!f:real^M->real^N->real^P g s. lebesgue_measurable s /\ (!y. (\x. f x y) continuous_on s) /\ g continuous_on s ==> lebesgue_measurable {x | x IN s /\ ?l. (f x --> l) (at (g x))}`, let lemma = prove (`x IN s /\ x IN INTERS f <=> x IN s /\ x IN INTERS {s INTER t | t IN f}`, REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY_AT] THEN MATCH_MP_TAC(MESON[] `!t. s = t /\ lebesgue_measurable t ==> lebesgue_measurable s`) THEN EXISTS_TAC `INTERS { UNIONS { {z | (z:real^M) IN s /\ z IN INTERS { {z | &0 < dist (x,g z) /\ dist(x,g z) < inv(&n + &1) /\ &0 < dist (y,g z) /\ dist(y,g z) < inv(&n + &1) ==> dist((f:real^M->real^N->real^P) z x,f z y) <= inv(&m + &1) } | x IN UNIV /\ y IN UNIV}} | n IN (:num) } | m IN (:num) }` THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_UNIV] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `z:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `(z:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhand o rand) FORALL_POS_MONO_1_EQ o lhand o snd) THEN ANTS_TAC THENL [MESON_TAC[REAL_LT_TRANS]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(MESON[] `(!n. P n ==> Q n) /\ (!n. Q(n + 1) ==> P n) ==> ((!n. P n) <=> (!n. Q n))`) THEN CONJ_TAC THEN X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THENL [W(MP_TAC o PART_MATCH (lhand o rand) FORALL_POS_MONO_1_EQ o rand o snd); W(MP_TAC o PART_MATCH (lhand o rand) FORALL_POS_MONO_1_EQ o lhand o snd)] THEN (ANTS_TAC THENL [MESON_TAC[REAL_LT_TRANS]; DISCH_THEN SUBST1_TAC]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[CONTRAPOS_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `m:num` THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED_IN THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[GSYM INTER] THEN MATCH_MP_TAC(SET_RULE `(f = {} ==> closed_in top (s INTER INTERS f)) /\ (~(f = {}) ==> closed_in top (s INTER INTERS f)) ==> closed_in top (s INTER INTERS f)`) THEN SIMP_TAC[INTERS_0; INTER_UNIV; CLOSED_IN_REFL] THEN DISCH_TAC THEN MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[SET_RULE `s INTER {z | P z ==> Q z} = s DIFF {z | P z} UNION s INTER {z | Q z}`] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IN_BALL; GSYM DIST_NZ] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN REWRITE_TAC[SET_RULE `~(a = z) /\ z IN s <=> z IN s DELETE a`] THEN REWRITE_TAC[SET_RULE `s DIFF {x | P x /\ Q x} = {x | x IN s /\ ~P x} UNION {x | x IN s /\ ~Q x}`] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC THEN REWRITE_TAC[SET_RULE `~(x IN s DELETE a) <=> x IN a INSERT (UNIV DIFF s)`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_INSERT THEN REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL]; REWRITE_TAC[dist; SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN REWRITE_TAC[GSYM IN_CBALL_0] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_SIMP_TAC[CLOSED_CBALL; CONTINUOUS_ON_SUB]]);; (* ------------------------------------------------------------------------- *) (* Measurability of the set of points of differentiability and of the *) (* partial derivatives and vector derivatives. These proofs are both *) (* similar and have some technicalities to handle the extra generality *) (* of "within s" (we show that the set of points where this makes the *) (* limit ill-defined is negligible). In the unrestricted case, the same *) (* idea works and shows the set of points of differentiability is Borel. *) (* ------------------------------------------------------------------------- *) let BOREL_POINTS_OF_DIFFERENTIABILITY = prove (`!f:real^M->real^N. borel {x | f differentiable at x}`, let lemur = prove (`!f:real^M->real^N x. f differentiable (at x) <=> !e. &0 < e ==> ?d A. &0 < d /\ (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> rational(A$i$j)) /\ !y. norm(y - x) < d ==> norm(f y - f x - A ** (y - x)) <= e * norm(y - x)`, REPEAT GEN_TAC THEN REWRITE_TAC[differentiable; HAS_DERIVATIVE_AT_ALT] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC (ISPEC `matrix(f':real^M->real^N)` MATRIX_RATIONAL_APPROXIMATION) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real^M^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `x / &2 * y = (x * y) / &2`] THEN MATCH_MP_TAC(NORM_ARITH `norm(d' - d:real^N) <= e / &2 ==> norm(y - x - d') <= e / &2 ==> norm(y - x - d) <= e`) THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN TRANS_TAC REAL_LE_TRANS `onorm(\x. (matrix(f':real^M->real^N) - B) ** x) * norm(y - x:real^M)` THEN ASM_SIMP_TAC[ONORM; LINEAR_COMPOSE_SUB; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[REAL_ARITH `(e * x) / &2 = e / &2 * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `A:num->real^M^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> ?a. ((\n. lift((A n:real^M^N)$i$j)) --> a) sequentially` MP_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN REWRITE_TAC[GE] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN ABBREV_TAC `y:real^M = x + min ((d:num->real) m) (d n) / &2 % basis j` THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`m:num`; `y:real^M`] th) THEN MP_TAC(SPECL [`n:num`; `y:real^M`] th)) THEN MATCH_MP_TAC(TAUT `(q /\ p) /\ (r /\ s ==> t) ==> (p ==> r) ==> (q ==> s) ==> t`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_LT_MIN] THEN EXPAND_TAC "y" THEN REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL] THEN ASM_SIMP_TAC[NORM_BASIS; REAL_MUL_RID] THEN MATCH_MP_TAC(REAL_ARITH `&0 < d ==> abs(d / &2) < d`) THEN ASM_REWRITE_TAC[REAL_LT_MIN]; DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(y - x - d) <= a /\ norm(y - x - e) <= b ==> norm(d - e:real^N) <= a + b`)) THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN EXPAND_TAC "y" THEN REWRITE_TAC[VECTOR_ADD_SUB] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; NORM_MUL] THEN ASM_SIMP_TAC[NORM_BASIS; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `a * x <= n * a + m * a <=> a * x <= a * (n + m)`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_HALF; REAL_LT_MIN] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[COMPONENT_LE_NORM; REAL_LE_TRANS] `norm(x:real^N) <= a ==> !i. abs(x$i) <= a`)) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[DIST_LIFT; LAMBDA_BETA; MATRIX_SUB_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> abs(a - b) <= x + y ==> abs(b - a) < e`) THEN CONJ_TAC THEN TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[EXISTS_LIFT] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; LAMBDA_SKOLEM] THEN DISCH_THEN(X_CHOOSE_THEN `B:real^M^N` (LABEL_TAC "*")) THEN EXISTS_TAC `\x. (B:real^M^N) ** x` THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o REWRITE_RULE[tendsto]) THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!i. P i ==> !j. Q j ==> !e. R i j e) ==> !e i. P i ==> !j. Q j ==> R i j e`)) THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / &(dimindex(:N)) / &(dimindex(:M))`) THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_SIMP_TAC[CONV_RULE (RAND_CONV SYM_CONV) (SPEC_ALL EVENTUALLY_FORALL); FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; REAL_LT_DIV; LE_1; REAL_HALF; REAL_OF_NUM_LT] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; LEFT_IMP_EXISTS_THM] THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_THEN(MP_TAC o SPEC `n + m:num`) THEN REWRITE_TAC[LE_ADD; RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN EXISTS_TAC `(d:num->real) (n + m)` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n + m:num`; `y:real^M`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(d' - d:real^N) <= e' - e ==> norm(y - x - d') <= e ==> norm(y - x - d) <= e'`) THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN TRANS_TAC REAL_LE_TRANS `onorm(\x. ((A:num->real^M^N) (n + m) - B) ** x) * norm(y - x:real^M)` THEN SIMP_TAC[ONORM; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `d <= e / &2 /\ x <= e / &2 ==> x <= e - d`) THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `inv(&m)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; TRANS_TAC REAL_LE_TRANS `&(dimindex(:N)) * &(dimindex(:M)) * e / &2 / &(dimindex(:N)) / &(dimindex(:M))` THEN CONJ_TAC THENL [MATCH_MP_TAC ONORM_LE_MATRIX_COMPONENT THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_LIFT]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; MATRIX_SUB_COMPONENT]; SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; DIMINDEX_NONZERO] THEN ASM_REAL_ARITH_TAC]]) in GEN_TAC THEN SUBGOAL_THEN `{x | (f:real^M->real^N) differentiable at x} = {x | f continuous at x} INTER INTERS { UNIONS { UNIONS { {x | f continuous at x} INTER INTERS {{x | f continuous at x /\ (norm(y - x) < d ==> norm(f y - f x - A ** (y - x)) <= e * norm(y - x))} |y| y IN UNIV} |d| d IN {d | d IN rational /\ &0 < d}} |A| A IN {A | !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> rational (A$i$j)}} |e| e IN {e | e IN rational /\ &0 < e}}` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. P x ==> Q x) /\ (!x. Q x ==> (P x <=> x IN s)) ==> {x | P x} = {x | Q x} INTER s`) THEN REWRITE_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_AT] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[lemur] THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_INTER] THEN REWRITE_TAC[SET_RULE `x IN rational <=> rational x`] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP RATIONAL_BETWEEN) THEN DISCH_THEN(X_CHOOSE_THEN `e':real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e':real`) THEN ASM_REWRITE_TAC[IN_UNIV] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `A:real^M^N` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP RATIONAL_BETWEEN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d':real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC BOREL_INTER THEN SIMP_TAC[GDELTA_IMP_BOREL; GDELTA_POINTS_OF_CONTINUITY] THEN MATCH_MP_TAC BOREL_INTERS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `e:real` THEN STRIP_TAC] THEN MATCH_MP_TAC BOREL_UNIONS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC COUNTABLE_CART THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | s x} = s`]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `A:real^M^N` THEN STRIP_TAC] THEN MATCH_MP_TAC BOREL_UNIONS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `d:real` THEN STRIP_TAC] THEN MATCH_MP_TAC CLOSED_IN_BOREL THEN EXISTS_TAC `{x | (f:real^M->real^N) continuous at x}` THEN SIMP_TAC[GDELTA_IMP_BOREL; GDELTA_POINTS_OF_CONTINUITY] THEN MATCH_MP_TAC(MESON[SET_RULE `s INTER INTERS {} = s`; CLOSED_IN_REFL] `(~(u = {}) ==> closed_in (subtopology euclidean s) (s INTER INTERS u)) ==> closed_in (subtopology euclidean s) (s INTER INTERS u)`) THEN DISCH_TAC THEN MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[SET_RULE `{x | P x /\ (Q x ==> R x)} = {x | x IN {x | P x} /\ ~Q x} UNION {x | x IN {x | P x} /\ R x}`] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN REWRITE_TAC[REAL_NOT_LT] THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 <= d <=> &0 <= drop(lift d)`] THEN ONCE_REWRITE_TAC[SET_RULE `&0 <= drop x <=> x IN {x | &0 <= drop x}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE; drop] THEN REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_CMUL) THEN REWRITE_TAC[CONTINUOUS_ON_CONST; dist] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN CONJ_TAC THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; LINEAR_CONTINUOUS_ON] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN SET_TAC[]);; let LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_WITHIN = prove (`!f:real^M->real^N s. lebesgue_measurable s ==> lebesgue_measurable {x | x IN s /\ f differentiable (at x within s)}`, let lemma = prove (`!f:real^M->real^N x s. (!n. ~(n = vec 0) ==> ?k. &0 < k /\ !e. &0 < e ==> ?y. y IN s DELETE x /\ dist(x,y) < e /\ k * norm(y - x) <= abs(n dot (y - x))) ==> (f differentiable (at x within s) <=> !e. &0 < e ==> ?d A. &0 < d /\ (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> rational(A$i$j)) /\ !y. y IN s /\ norm(y - x) < d ==> norm(f y - f x - A ** (y - x)) <= e * norm (y - x))`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `trivial_limit (at (x:real^M) within s)` THENL [ASM_REWRITE_TAC[LIM; differentiable; has_derivative] THEN MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL [MESON_TAC[LINEAR_ZERO]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TRIVIAL_LIMIT_WITHIN]) THEN REWRITE_TAC[LIMPT_APPROACHABLE; NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q /\ r) <=> p /\ r ==> ~q`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `mat 0:real^M^N` THEN SIMP_TAC[MAT_COMPONENT; MATRIX_VECTOR_MUL_LZERO] THEN REWRITE_TAC[COND_ID; RATIONAL_NUM; VECTOR_SUB_RZERO] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL]; RULE_ASSUM_TAC(REWRITE_RULE[TRIVIAL_LIMIT_WITHIN])] THEN REWRITE_TAC[differentiable; HAS_DERIVATIVE_WITHIN_ALT] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC (ISPEC `matrix(f':real^M->real^N)` MATRIX_RATIONAL_APPROXIMATION) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real^M^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `x / &2 * y = (x * y) / &2`] THEN MATCH_MP_TAC(NORM_ARITH `norm(d' - d:real^N) <= e / &2 ==> norm(y - x - d') <= e / &2 ==> norm(y - x - d) <= e`) THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN TRANS_TAC REAL_LE_TRANS `onorm(\x. (matrix(f':real^M->real^N) - B) ** x) * norm(y - x:real^M)` THEN ASM_SIMP_TAC[ONORM; LINEAR_COMPOSE_SUB; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[REAL_ARITH `(e * x) / &2 = e / &2 * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `A:num->real^M^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> ?a. ((\n. lift((A n:real^M^N)$i$j)) --> a) sequentially` MP_TAC THENL [ALL_TAC; REWRITE_TAC[EXISTS_LIFT] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; LAMBDA_SKOLEM] THEN DISCH_THEN(X_CHOOSE_THEN `B:real^M^N` (LABEL_TAC "*")) THEN EXISTS_TAC `\x. (B:real^M^N) ** x` THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o REWRITE_RULE[tendsto]) THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!i. P i ==> !j. Q j ==> !e. R i j e) ==> !e i. P i ==> !j. Q j ==> R i j e`)) THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / &(dimindex(:N)) / &(dimindex(:M))`) THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_SIMP_TAC[CONV_RULE (RAND_CONV SYM_CONV) (SPEC_ALL EVENTUALLY_FORALL); FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; REAL_LT_DIV; LE_1; REAL_HALF; REAL_OF_NUM_LT] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; LEFT_IMP_EXISTS_THM] THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_THEN(MP_TAC o SPEC `n + m:num`) THEN REWRITE_TAC[LE_ADD; RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN EXISTS_TAC `(d:num->real) (n + m)` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n + m:num`; `y:real^M`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(d' - d:real^N) <= e' - e ==> norm(y - x - d') <= e ==> norm(y - x - d) <= e'`) THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN TRANS_TAC REAL_LE_TRANS `onorm(\x. ((A:num->real^M^N) (n + m) - B) ** x) * norm(y - x:real^M)` THEN SIMP_TAC[ONORM; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `d <= e / &2 /\ x <= e / &2 ==> x <= e - d`) THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `inv(&m)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; TRANS_TAC REAL_LE_TRANS `&(dimindex(:N)) * &(dimindex(:M)) * e / &2 / &(dimindex(:N)) / &(dimindex(:M))` THEN CONJ_TAC THENL [MATCH_MP_TAC ONORM_LE_MATRIX_COMPONENT THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_LIFT]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; MATRIX_SUB_COMPONENT]; SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; DIMINDEX_NONZERO] THEN ASM_REAL_ARITH_TAC]]] THEN SUBGOAL_THEN `{x | cauchy (\n. (A n:real^M^N) ** x)} = (:real^M)` ASSUME_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis j:real^M` o MATCH_MP (SET_RULE `s = UNIV ==> !x. x IN s`)) THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `l:real^N` MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `i:num` o MATCH_MP LIM_COMPONENT) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; LAMBDA_BETA] THEN MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `span s = s /\ span s = UNIV ==> s = UNIV`) THEN CONJ_TAC THENL [REWRITE_TAC[SPAN_EQ_SELF; GSYM CONVERGENT_EQ_CAUCHY] THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ADD_LDISTRIB; MATRIX_VECTOR_MUL_RZERO] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL] THEN CONJ_TAC THENL [EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[LIM_CONST]; REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD); DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL)] THEN REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM DIM_EQ_FULL] THEN MATCH_MP_TAC(ARITH_RULE `n:num <= N /\ ~(n < N) ==> n = N`) THEN REWRITE_TAC[DIM_SUBSET_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M` MP_TAC o MATCH_MP ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN REWRITE_TAC[FORALL_IN_GSPEC; orthogonal] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `~(d:real^M = vec 0)`)) THEN REWRITE_TAC[IN_DELETE; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?y:num->real^M z. (!n. y n IN s) /\ (!n. ~(y n = x)) /\ (!n. k * norm(y n - x) <= abs(d dot (y n - x))) /\ (y --> x) sequentially /\ ((\n. inv(norm(y n - x)) % (y n - x)) --> z) sequentially` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?y:num->real^M. (!n. y n IN s /\ ~(y n = x) /\ k * norm(y n - x) <= abs(d dot (y n - x)) /\ norm(y n - x) < inv(&n + &1)) /\ (!n. norm(y(SUC n) - x) < norm(y n - x))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (norm(y:real^M - x)) (inv(&(SUC n) + &1))`) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ANTS_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPEC `sphere(vec 0:real^M,&1)` compact) THEN REWRITE_TAC[COMPACT_SPHERE; IN_SPHERE_0] THEN DISCH_THEN(MP_TAC o SPEC `\n:num. inv(norm(y n - x:real^M)) % (y n - x)`) THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(y:num->real^M) o (r:num->num)` THEN ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; dist] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LTE_TRANS `inv(&m + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `k <= abs((d:real^M) dot z)` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o ISPEC `\x:real^M. lift(abs(d dot x) - k)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN ANTS_TAC THENL [REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `abs x = abs(drop(lift x))`] THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC CONTINUOUS_LIFT_ABS_COMPONENT THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT]; DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_DROP_LBOUND)) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; REAL_SUB_LE] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[o_DEF] THEN REWRITE_TAC[DOT_RMUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_ABS_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ]]; MATCH_MP_TAC(REAL_ARITH `&0 < k /\ x = &0 ==> k <= abs x ==> F`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN REWRITE_TAC[dist; GE] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e / &2 ==> a <= &2 * x ==> a < e`)) THEN FIRST_X_ASSUM(MP_TAC o ISPEC `\x:real^M. lift(norm((A:num->real^M^N) m ** x - A n ** x) - &2 / &N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_DROP_UBOUND)) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; REAL_SUB_LE] THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tendsto]) THEN DISCH_THEN(MP_TAC o SPEC `min ((d:num->real) m) (d n)`) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`m:num`; `(y:num->real^M) p`] th) THEN MP_TAC(ISPECL [`n:num`; `(y:num->real^M) p`] th)) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(y - x - a:real^N) <= d /\ norm(y - x - b) <= e ==> norm(b - a) <= d + e`)) THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; MATRIX_VECTOR_MUL_RMUL] THEN REWRITE_TAC[REAL_ARITH `a - b <= &0 <=> a <= b`; NORM_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM; GSYM REAL_ADD_RDISTRIB] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div); REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `a <= inv c /\ b <= inv c ==> a + b <= &2 / c`) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC) in REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) continuous (at x within s)} INTER {x | !e. &0 < e ==> ?d A. &0 < d /\ (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> rational(A$i$j)) /\ !y. y IN s /\ norm(y - x) < d ==> norm(f y - f x - A ** (y - x)) <= e * norm (y - x)}` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `!s. t = s /\ lebesgue_measurable s ==> lebesgue_measurable t`) THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) continuous (at x within s)} INTER INTERS { UNIONS { UNIONS { {x | x IN s /\ f continuous (at x within s)} INTER INTERS {{x | x IN s /\ f continuous (at x within s) /\ (norm(y - x) < d ==> norm(f y - f x - A ** (y - x)) <= e * norm(y - x))} |y| y IN s} |d| d IN {d | d IN rational /\ &0 < d}} |A| A IN {A | !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> rational (A$i$j)}} |e| e IN {e | e IN rational /\ &0 < e}}` THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM; INTERS_GSPEC; UNIONS_GSPEC] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(f:real^M->real^N) continuous (at x within s)` THEN ASM_REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_INTER] THEN REWRITE_TAC[SET_RULE `x IN rational <=> rational x`] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP RATIONAL_BETWEEN) THEN DISCH_THEN(X_CHOOSE_THEN `e':real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e':real`) THEN ASM_REWRITE_TAC[IN_UNIV] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `A:real^M^N` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP RATIONAL_BETWEEN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d':real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL [MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] GDELTA_POINTS_OF_CONTINUITY_WITHIN) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GDELTA_IMP_LEBESGUE_MEASURABLE; LEBESGUE_MEASURABLE_INTER]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `e:real` THEN STRIP_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC COUNTABLE_CART THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | s x} = s`]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `A:real^M^N` THEN STRIP_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `d:real` THEN STRIP_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED_IN THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) continuous (at x within s)}` THEN CONJ_TAC THENL [ALL_TAC; MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] GDELTA_POINTS_OF_CONTINUITY_WITHIN) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GDELTA_IMP_LEBESGUE_MEASURABLE; LEBESGUE_MEASURABLE_INTER]] THEN MATCH_MP_TAC(MESON[SET_RULE `s INTER INTERS {} = s`; CLOSED_IN_REFL] `(~(u = {}) ==> closed_in (subtopology euclidean s) (s INTER INTERS u)) ==> closed_in (subtopology euclidean s) (s INTER INTERS u)`) THEN DISCH_TAC THEN MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN REWRITE_TAC[SET_RULE `{x | P x /\ (Q x ==> R x)} = {x | x IN {x | P x} /\ ~Q x} UNION {x | x IN {x | P x} /\ R x}`] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN REWRITE_TAC[REAL_NOT_LT] THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 <= d <=> &0 <= drop(lift d)`] THEN ONCE_REWRITE_TAC[SET_RULE `&0 <= drop x <=> x IN {x | &0 <= drop x}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE; drop] THEN REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_CMUL) THEN REWRITE_TAC[CONTINUOUS_ON_CONST; dist] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN CONJ_TAC THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; LINEAR_CONTINUOUS_ON] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_WITHIN_SUBSET) THEN REWRITE_TAC[SUBSET_RESTRICT]; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x | x IN s /\ ~(!n. ~(n:real^M = vec 0) ==> (?k. &0 < k /\ (!e. &0 < e ==> (?y. y IN s DELETE x /\ dist (x,y) < e /\ k * norm (y - x) <= abs (n dot (y - x))))))}` THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `x:real^M` THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER; IN_UNION; IN_DIFF] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM (MATCH_MP lemma th)]) THEN MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]] THEN GEN_REWRITE_TAC I [NEGLIGIBLE_EQ_ZERO_DENSITY] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `r:real`; `e:real`] THEN REWRITE_TAC[IN_ELIM_THM; SUBSET; NOT_FORALL_THM; NOT_IMP; IN_INTER; IN_DELETE; GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `n:real^M` MP_TAC) MP_TAC) THEN POP_ASSUM MP_TAC THEN GEOM_BASIS_MULTIPLE_TAC 1 `n:real^M` THEN REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_EXISTS_THM; MESON[] `(!k. ~(&0 < k /\ !e. &0 < e ==> P e k)) <=> (!k. &0 < k ==> ?e. &0 < e /\ ~P e k)`] THEN SIMP_TAC[DOT_LMUL; DOT_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < n ==> abs n * a = a * n`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_ARITH `(a * b) / c:real = a / c * b`] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; REAL_NOT_LE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(n * e / &2) / &(dimindex(:M)) pow dimindex(:M)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_POW_LT; REAL_HALF; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN REWRITE_TAC[REAL_ARITH `((n * e) / x) / n * p:real = n * (e * p) / x / n`] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d r:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN REWRITE_TAC[REAL_ARITH `min d r:real <= r`; BALL_MIN_INTER; IN_INTER] THEN EXISTS_TAC `ball(x:real^M,min d r) INTER {y | abs ((y - x)$1) < (e / &2 * min d r) / &(dimindex(:M)) pow dimindex(:M) }` THEN SUBGOAL_THEN `!b a:real^M. open {x | abs((x - a)$1) < b}` ASSUME_TAC THENL [POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^M` THEN REWRITE_TAC[VECTOR_SUB_RZERO; OPEN_STRIP_COMPONENT_LT]; ALL_TAC] THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; MEASURABLE_BALL; LEBESGUE_MEASURABLE_OPEN] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^M` THEN SIMP_TAC[IN_INTER; BALL_MIN_INTER] THEN REWRITE_TAC[IN_BALL; IN_ELIM_THM] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; VEC_COMPONENT; REAL_ABS_NUM; REAL_LT_MUL; REAL_LT_DIV; REAL_POW_LT; REAL_HALF; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1; REAL_LT_MIN] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LTE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_HALF; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e * y /\ x <= e / &2 * y ==> x < e * y`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LT_MUL; MEASURE_BALL_POS; GSYM BALL_MIN_INTER; REAL_LT_MIN]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `measure(interval [(x - lambda i. if i = 1 then (e / &2 * min d r) / &(dimindex(:M)) pow dimindex(:M) else min d r):real^M, (x + lambda i. if i = 1 then (e / &2 * min d r) / &(dimindex(:M)) pow dimindex(:M) else min d r)])` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; MEASURABLE_BALL; LEBESGUE_MEASURABLE_OPEN; MEASURABLE_INTERVAL] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; IN_INTERVAL; IN_ELIM_THM] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(y - x) <= e`] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; REAL_LT_IMP_LE] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `e / &2 * measure(interval[(x - lambda i. min d r / &(dimindex(:M))):real^M, (x + lambda i. min d r / &(dimindex(:M)))])` THEN CONJ_TAC THENL [SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`; REAL_ARITH `(x + e) - (x - e) = &2 * e`] THEN REWRITE_TAC[MESON[] `&0 <= (if p then x else y) <=> if p then &0 <= x else &0 <= y`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_MIN; REAL_LE_DIV; REAL_POW_LE; REAL_POS; REAL_HALF; REAL_LT_IMP_LE; COND_ID] THEN SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH] THEN SIMP_TAC[ARITH_RULE `2 <= i ==> ~(i = 1)`] THEN REWRITE_TAC[PRODUCT_CONST_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `(n + 1) - 2 = n - 1`] THEN REWRITE_TAC[REAL_ARITH `(&2 * (e * m) / p) * x = e * ((&2 * m) * x) / p`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`] THEN REWRITE_TAC[REAL_ARITH `&2 * x / y = (&2 * x) / y`] THEN REWRITE_TAC[REAL_POW_DIV; REAL_LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_HALF; GSYM BALL_MIN_INTER] THEN SIMP_TAC[GSYM INTERIOR_CBALL; MEASURE_INTERIOR; BOUNDED_CBALL; FRONTIER_CBALL; NEGLIGIBLE_SPHERE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_CBALL] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; CARD_NUMSEG_1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_AT = prove (`!f:real^M->real^N. lebesgue_measurable {x | f differentiable (at x)}`, GEN_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_WITHIN) THEN REWRITE_TAC[IN_UNIV; LEBESGUE_MEASURABLE_UNIV; WITHIN_UNIV]);; let MEASURABLE_ON_PARTIAL_DERIVATIVES = prove (`!f:real^M->real^N f' s i j. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x within s)) /\ 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> (\x. lift(matrix(f' x)$i$j)) measurable_on s`, let lemma = prove (`!f:real^M->real^N s a. linear f /\ ((\x. inv(norm(x - a)) % f(x - a)) --> vec 0) (at a within s) /\ (!n. ~(n = vec 0) ==> ?k. &0 < k /\ !e. &0 < e ==> ?x. x IN s DELETE a /\ dist(a,x) < e /\ k * norm(x - a) <= abs(n dot (x - a))) ==> f = \x. vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN] THEN GEN_GEOM_ORIGIN_TAC `a:real^M` ["n"] THEN REWRITE_TAC[GSYM LIM_WITHIN] THEN REWRITE_TAC[DIST_0; VECTOR_SUB_RZERO; IN_DELETE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; VEC_COMPONENT] THEN MATCH_MP_TAC(SET_RULE `span {x | P x} = {x | P x} /\ span {x | P x} = UNIV ==> !x. P x`) THEN REWRITE_TAC[GSYM DIM_EQ_FULL; SPAN_EQ_SELF] THEN ASM_SIMP_TAC[SUBSPACE_KERNEL] THEN MATCH_MP_TAC(ARITH_RULE `n:num <= N /\ ~(n < N) ==> n = N`) THEN REWRITE_TAC[DIM_SUBSET_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M` MP_TAC o MATCH_MP ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN REWRITE_TAC[FORALL_IN_GSPEC; orthogonal] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `~(d:real^M = vec 0)`)) THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?y:num->real^M. (!n. y n IN s /\ ~(y n = vec 0) /\ k * norm(y n) <= abs(d dot y n) /\ norm(y n) < inv(&n + &1)) /\ (!n. norm(y(SUC n)) < norm(y n))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (norm(y:real^M)) (inv(&(SUC n) + &1))`) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; NORM_POS_LT] THEN ANTS_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN ABBREV_TAC `z:num->real^M = \n. inv(norm(y n)) % y n` THEN MP_TAC(ISPEC `sphere(vec 0:real^M,&1)` compact) THEN REWRITE_TAC[COMPACT_SPHERE; IN_SPHERE_0] THEN DISCH_THEN(MP_TAC o SPEC `z:num->real^M`) THEN ANTS_TAC THENL [EXPAND_TAC "z" THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; REWRITE_TAC[NOT_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`l:real^M`; `r:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `k <= abs((d:real^M) dot l)` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o ISPEC `\x:real^M. lift(abs(d dot x) - k)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN ANTS_TAC THENL [REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `abs x = abs(drop(lift x))`] THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC CONTINUOUS_LIFT_ABS_COMPONENT THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT]; DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_DROP_LBOUND)) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; REAL_SUB_LE] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `k:num` THEN EXPAND_TAC "z" THEN REWRITE_TAC[o_DEF] THEN REWRITE_TAC[DOT_RMUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_ABS_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT]]; MATCH_MP_TAC(REAL_ARITH `&0 < k /\ x = &0 ==> k <= abs x ==> F`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:real^M->real^N) o z o (r:num->num)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [UNDISCH_TAC `((z:num->real^M) o (r:num->num) --> l) sequentially` THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_CONTINUOUS_FUNCTION) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `(y:num->real^M) o (r:num->num)`) THEN ASM_REWRITE_TAC[IN_DELETE; o_THM] THEN ANTS_TAC THENL [MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LTE_TRANS `inv(&m + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN EXPAND_TAC "z" THEN REWRITE_TAC[o_DEF] THEN ASM_MESON_TAC[LINEAR_CMUL]]]) in REPLICATE_TAC 3 GEN_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN X_GEN_TAC `b:real` THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF THEN EXISTS_TAC `{x | x IN s /\ !e. &0 < e ==> ?d A. &0 < d /\ A$m$n < b /\ (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> rational(A$i$j)) /\ !y. y IN s /\ norm(y - x) < d ==> norm((f:real^M->real^N) y - f x - A ** (y - x)) <= e * norm(y - x)}` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `!s. t = s /\ lebesgue_measurable s ==> lebesgue_measurable t`) THEN EXISTS_TAC `s INTER INTERS { UNIONS { UNIONS { s INTER INTERS {{x | x IN s /\ (norm(y - x) < d ==> norm((f:real^M->real^N) y - f x - A ** (y - x)) <= e * norm(y - x))} |y| y IN s} |d| d IN {d | d IN rational /\ &0 < d}} |A| A IN {A | A$m$n < b /\ !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> rational (A$i$j)}} |e| e IN {e | e IN rational /\ &0 < e}}` THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM; INTERS_GSPEC; UNIONS_GSPEC] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_INTER] THEN REWRITE_TAC[SET_RULE `x IN rational <=> rational x`] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP RATIONAL_BETWEEN) THEN DISCH_THEN(X_CHOOSE_THEN `e':real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e':real`) THEN ASM_REWRITE_TAC[IN_UNIV] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `A:real^M^N` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `&0 < d` THEN DISCH_THEN(MP_TAC o MATCH_MP RATIONAL_BETWEEN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d':real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `e:real` THEN STRIP_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN MATCH_MP_TAC COUNTABLE_INTER THEN DISJ2_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC COUNTABLE_CART THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | s x} = s`]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `A:real^M^N` THEN STRIP_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `d:real` THEN STRIP_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED_IN THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[SET_RULE `s INTER INTERS {} = s`; CLOSED_IN_REFL] `(~(u = {}) ==> closed_in (subtopology euclidean s) (s INTER INTERS u)) ==> closed_in (subtopology euclidean s) (s INTER INTERS u)`) THEN DISCH_TAC THEN MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN REWRITE_TAC[SET_RULE `{x | P x /\ (Q x ==> R x)} = {x | P x /\ ~Q x} UNION {x | P x /\ R x}`] THEN MATCH_MP_TAC CLOSED_IN_UNION THEN REWRITE_TAC[REAL_NOT_LT] THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 <= d <=> &0 <= drop(lift d)`] THEN ONCE_REWRITE_TAC[SET_RULE `&0 <= drop x <=> x IN {x | &0 <= drop x}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE; drop] THEN REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_CMUL) THEN REWRITE_TAC[CONTINUOUS_ON_CONST; dist] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN CONJ_TAC THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; LINEAR_CONTINUOUS_ON] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; differentiable]; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x | x IN s /\ ~(!n. ~(n:real^M = vec 0) ==> (?k. &0 < k /\ (!e. &0 < e ==> (?y. y IN s DELETE x /\ dist (x,y) < e /\ k * norm (y - x) <= abs (n dot (y - x))))))}` THEN CONJ_TAC THENL [UNDISCH_TAC `lebesgue_measurable(s:real^M->bool)` THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN GEN_REWRITE_TAC I [NEGLIGIBLE_EQ_ZERO_DENSITY] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `r:real`; `e:real`] THEN REWRITE_TAC[IN_ELIM_THM; SUBSET; NOT_FORALL_THM; NOT_IMP; IN_INTER; IN_DELETE; GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `n:real^M` MP_TAC) MP_TAC) THEN POP_ASSUM MP_TAC THEN GEOM_BASIS_MULTIPLE_TAC 1 `n:real^M` THEN REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_EXISTS_THM; MESON[] `(!k. ~(&0 < k /\ !e. &0 < e ==> P e k)) <=> (!k. &0 < k ==> ?e. &0 < e /\ ~P e k)`] THEN SIMP_TAC[DOT_LMUL; DOT_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < n ==> abs n * a = a * n`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_ARITH `(a * b) / c:real = a / c * b`] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; REAL_NOT_LE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(n * e / &2) / &(dimindex(:M)) pow dimindex(:M)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_POW_LT; REAL_HALF; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN REWRITE_TAC[REAL_ARITH `((n * e) / x) / n * p:real = n * (e * p) / x / n`] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d r:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN REWRITE_TAC[REAL_ARITH `min d r:real <= r`; BALL_MIN_INTER; IN_INTER] THEN EXISTS_TAC `ball(x:real^M,min d r) INTER {y | abs ((y - x)$1) < (e / &2 * min d r) / &(dimindex(:M)) pow dimindex(:M) }` THEN SUBGOAL_THEN `!b a:real^M. open {x | abs((x - a)$1) < b}` ASSUME_TAC THENL [POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^M` THEN REWRITE_TAC[VECTOR_SUB_RZERO; OPEN_STRIP_COMPONENT_LT]; ALL_TAC] THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; MEASURABLE_BALL; LEBESGUE_MEASURABLE_OPEN] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^M` THEN SIMP_TAC[IN_INTER; BALL_MIN_INTER] THEN REWRITE_TAC[IN_BALL; IN_ELIM_THM] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; VEC_COMPONENT; REAL_ABS_NUM; REAL_LT_MUL; REAL_LT_DIV; REAL_POW_LT; REAL_HALF; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1; REAL_LT_MIN] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LTE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_HALF; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e * y /\ x <= e / &2 * y ==> x < e * y`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LT_MUL; MEASURE_BALL_POS; GSYM BALL_MIN_INTER; REAL_LT_MIN]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `measure(interval [(x - lambda i. if i = 1 then (e / &2 * min d r) / &(dimindex(:M)) pow dimindex(:M) else min d r):real^M, (x + lambda i. if i = 1 then (e / &2 * min d r) / &(dimindex(:M)) pow dimindex(:M) else min d r)])` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; MEASURABLE_BALL; LEBESGUE_MEASURABLE_OPEN; MEASURABLE_INTERVAL] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; IN_INTERVAL; IN_ELIM_THM] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(y - x) <= e`] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; REAL_LT_IMP_LE] THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `e / &2 * measure(interval[(x - lambda i. min d r / &(dimindex(:M))):real^M, (x + lambda i. min d r / &(dimindex(:M)))])` THEN CONJ_TAC THENL [SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`; REAL_ARITH `(x + e) - (x - e) = &2 * e`] THEN REWRITE_TAC[MESON[] `&0 <= (if p then x else y) <=> if p then &0 <= x else &0 <= y`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_MIN; REAL_LE_DIV; REAL_POW_LE; REAL_POS; REAL_HALF; REAL_LT_IMP_LE; COND_ID] THEN SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH] THEN SIMP_TAC[ARITH_RULE `2 <= i ==> ~(i = 1)`] THEN REWRITE_TAC[PRODUCT_CONST_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `(n + 1) - 2 = n - 1`] THEN REWRITE_TAC[REAL_ARITH `(&2 * (e * m) / p) * x = e * ((&2 * m) * x) / p`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`] THEN REWRITE_TAC[REAL_ARITH `&2 * x / y = (&2 * x) / y`] THEN REWRITE_TAC[REAL_POW_DIV; REAL_LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_HALF; GSYM BALL_MIN_INTER] THEN SIMP_TAC[GSYM INTERIOR_CBALL; MEASURE_INTERIOR; BOUNDED_CBALL; FRONTIER_CBALL; NEGLIGIBLE_SPHERE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_CBALL] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; CARD_NUMSEG_1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(!x. ~(x IN s) ==> (x IN t <=> x IN u)) ==> (t DIFF u) UNION (u DIFF t) SUBSET s`) THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EQ_TAC THENL [ALL_TAC; DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [has_derivative_within] o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; DIST_0] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC (ISPEC `matrix((f':real^M->real^M->real^N) x) - lambda i j. if i = m /\ j = n then e / &4 else &0` MATRIX_RATIONAL_APPROXIMATION) THEN DISCH_THEN(MP_TAC o SPEC `e / &6`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &6 <=> &0 < e`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real^M^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MP_TAC(GEN `f:real^M->real^N` (ISPECL [`f:real^M->real^N`; `m:num`; `n:num`] COMPONENT_LE_ONORM)) THEN DISCH_THEN(fun th -> FIRST_ASSUM(fun th' -> MP_TAC(PART_MATCH (rand o rand) th (lhand(concl th'))))) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; MATRIX_OF_MATRIX_VECTOR_MUL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n < e ==> (p < e ==> u < v) ==> p <= n ==> u < v`)) THEN ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; LAMBDA_BETA] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; LINEAR_0; MATRIX_VECTOR_MUL_LINEAR; MATRIX_VECTOR_MUL_RZERO; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN ASM_REWRITE_TAC[dist] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[REAL_ARITH `x / &2 * y = (x * y) / &2`] THEN MATCH_MP_TAC(NORM_ARITH `norm(d' - d:real^N) <= e / &2 ==> norm(y - (x + d')) < e / &2 ==> norm(y - x - d) <= e`) THEN ASM_SIMP_TAC[GSYM MATRIX_WORKS] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN MATCH_MP_TAC(NORM_ARITH `!y. norm(y) <= e / &6 /\ norm(x - y) <= e / &4 ==> norm(x:real^N) <= e / &2`) THEN EXISTS_TAC `((matrix((f':real^M->real^M->real^N) x) - lambda i j. if i = m /\ j = n then e / &4 else &0) - B) ** (y - x)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_ARITH `(x * y) / &6 = x / &6 * y`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> y <= x ==> y <= e`)) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN SIMP_TAC[ONORM; MATRIX_VECTOR_MUL_LINEAR]; ALL_TAC] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_RDISTRIB; VECTOR_ARITH `m - b - (m - e - b):real^M = e`] THEN TRANS_TAC REAL_LE_TRANS `norm(e / &4 % (y - x:real^M)$n % basis m:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; REAL_MUL_LZERO; REAL_MUL_RZERO; SUM_0] THEN REWRITE_TAC[COND_RAND; REAL_MUL_RID; COND_RATOR; REAL_MUL_LZERO] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < e ==> (abs(e / &4) * x * &1 <= (e * y) / &4 <=> e * x <= e * y)`] THEN REWRITE_TAC[COMPONENT_LE_NORM]] THEN DISCH_THEN(MP_TAC o GEN `i:num` o SPEC `inv(&i + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`d:num->real`; `A:num->real^M^N`] THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM LIFT_DROP] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN EXISTS_TAC `\i. lift((A:num->real^M^N) i$m$n)` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY; LIFT_DROP; REAL_LT_IMP_LE] THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> ?a. ((\n. lift((A n:real^M^N)$i$j)) --> a) sequentially` MP_TAC THENL [SUBGOAL_THEN `{x | cauchy (\n. (A n:real^M^N) ** x)} = (:real^M)` ASSUME_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis j:real^M` o MATCH_MP (SET_RULE `s = UNIV ==> !x. x IN s`)) THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `l:real^N` MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `i:num` o MATCH_MP LIM_COMPONENT) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; LAMBDA_BETA] THEN MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `span s = s /\ span s = UNIV ==> s = UNIV`) THEN CONJ_TAC THENL [REWRITE_TAC[SPAN_EQ_SELF; GSYM CONVERGENT_EQ_CAUCHY] THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ADD_LDISTRIB; MATRIX_VECTOR_MUL_RZERO] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL] THEN CONJ_TAC THENL [EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[LIM_CONST]; REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD); DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL)] THEN REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM DIM_EQ_FULL] THEN MATCH_MP_TAC(ARITH_RULE `n:num <= N /\ ~(n < N) ==> n = N`) THEN REWRITE_TAC[DIM_SUBSET_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M` MP_TAC o MATCH_MP ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN REWRITE_TAC[FORALL_IN_GSPEC; orthogonal] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `~(d:real^M = vec 0)`)) THEN REWRITE_TAC[IN_DELETE; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?y:num->real^M z. (!n. y n IN s) /\ (!n. ~(y n = x)) /\ (!n. k * norm(y n - x) <= abs(d dot (y n - x))) /\ (y --> x) sequentially /\ ((\n. inv(norm(y n - x)) % (y n - x)) --> z) sequentially` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?y:num->real^M. (!i. y i IN s /\ ~(y i = x) /\ k * norm(y i - x) <= abs(d dot (y i - x)) /\ norm(y i - x) < inv(&i + &1)) /\ (!i. norm(y(SUC i) - x) < norm(y i - x))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (norm(y:real^M - x)) (inv(&(SUC i) + &1))`) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ANTS_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPEC `sphere(vec 0:real^M,&1)` compact) THEN REWRITE_TAC[COMPACT_SPHERE; IN_SPHERE_0] THEN DISCH_THEN(MP_TAC o SPEC `\i:num. inv(norm(y i - x:real^M)) % (y i - x)`) THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(y:num->real^M) o (r:num->num)` THEN ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; dist] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `i:num` THEN EXISTS_TAC `i:num` THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LTE_TRANS `inv(&p + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `k <= abs((d:real^M) dot z)` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o ISPEC `\x:real^M. lift(abs(d dot x) - k)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN ANTS_TAC THENL [REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `abs x = abs(drop(lift x))`] THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC CONTINUOUS_LIFT_ABS_COMPONENT THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT]; DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_DROP_LBOUND)) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; REAL_SUB_LE] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[o_DEF] THEN REWRITE_TAC[DOT_RMUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_ABS_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ]]; MATCH_MP_TAC(REAL_ARITH `&0 < k /\ x = &0 ==> k <= abs x ==> F`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN REWRITE_TAC[dist; GE] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e / &2 ==> a <= &2 * x ==> a < e`)) THEN FIRST_X_ASSUM(MP_TAC o ISPEC `\x:real^M. lift(norm((A:num->real^M^N) i ** x - A j ** x) - &2 / &N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_DROP_UBOUND)) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; REAL_SUB_LE] THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tendsto]) THEN DISCH_THEN(MP_TAC o SPEC `min ((d:num->real) i) (d j)`) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`i:num`; `(y:num->real^M) p`] th) THEN MP_TAC(ISPECL [`j:num`; `(y:num->real^M) p`] th)) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(y - x - a:real^N) <= d /\ norm(y - x - b) <= e ==> norm(b - a) <= d + e`)) THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; MATRIX_VECTOR_MUL_RMUL] THEN REWRITE_TAC[REAL_ARITH `a - b <= &0 <=> a <= b`; NORM_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM; GSYM REAL_ADD_RDISTRIB] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div); REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `a <= inv c /\ b <= inv c ==> a + b <= &2 / c`) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REWRITE_TAC[EXISTS_LIFT] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; LAMBDA_SKOLEM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN X_GEN_TAC `B:real^M^N` THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_TAC] THEN SUBGOAL_THEN `(f':real^M->real^M->real^N) x = \y. B ** y` (fun th -> ASM_SIMP_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; th]) THEN REWRITE_TAC[FUN_EQ_THM] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative_within]) THEN ASM_SIMP_TAC[GSYM MATRIX_WORKS] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC [`s:real^M->bool`; `x:real^M`] THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o C MATCH_MP (ASSUME `(x:real^M) IN s`)) THEN GEN_REWRITE_TAC LAND_CONV [GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_0] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN ASM_SIMP_TAC[MATRIX_WORKS; MATRIX_VECTOR_MUL_SUB_RDISTRIB; VECTOR_ARITH `--(a % (y - (x + d))) - a % (d - b):real^N = --(a % (y - x - b))`] THEN ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_NEG; VECTOR_NEG_0] THEN REWRITE_TAC[LIM_WITHIN] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `q:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `((\p. lift(onorm(\y. (A:num->real^M^N) p ** y - B ** y))) --> vec 0) sequentially` MP_TAC THENL [MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\p:num. sum (1..dimindex(:N)) (\i. sum (1..dimindex(:M)) (\j. abs((A p - B:real^M^N)$i$j)))` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB; NORM_LIFT] THEN SIMP_TAC[real_abs; ONORM_POS_LE; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[GSYM real_abs; ONORM_LE_MATRIX_COMPONENT_SUM] THEN REWRITE_TAC[LIFT_SUM; o_DEF] THEN REPEAT(MATCH_MP_TAC LIM_NULL_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC) THEN REWRITE_TAC[GSYM NORM_LIFT; GSYM LIM_NULL_NORM] THEN REWRITE_TAC[LIFT_SUB; MATRIX_SUB_COMPONENT; GSYM LIM_NULL] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:num` THEN DISCH_THEN(MP_TAC o SPEC `p + q:num`) THEN REWRITE_TAC[LE_ADD] THEN REWRITE_TAC[NORM_LIFT] THEN DISCH_TAC THEN EXISTS_TAC `(d:num->real) (p + q)` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p + q:num`; `y:real^M`]) THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(NORM_ARITH `norm(b - c:real^N) < e - d ==> norm(y - x - b) <= d ==> norm(y - x - c) < e`) THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN TRANS_TAC REAL_LET_TRANS `onorm(\x. ((A:num->real^M^N)(p + q) - B) ** x) * norm(y - x:real^M)` THEN SIMP_TAC[ONORM; MATRIX_VECTOR_MUL_LINEAR] THEN TRANS_TAC REAL_LTE_TRANS `e / &2 * norm(y - x:real^M)` THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_SUB_RDISTRIB; REAL_ARITH `abs x < e ==> x < e`] THEN REWRITE_TAC[REAL_ARITH `d * n <= e * n - n / q <=> n * (d + inv q) <= n * e`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 ==> e / &2 + x <= e`) THEN TRANS_TAC REAL_LET_TRANS `inv(&q)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC);; let MEASURABLE_ON_VECTOR_DERIVATIVE_GEN = prove (`!f:real^1->real^N f' s. lebesgue_measurable s /\ (!x. x IN s ==> (f has_vector_derivative f'(x)) (at x within s)) ==> f' measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN REWRITE_TAC[has_vector_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] MEASURABLE_ON_PARTIAL_DERIVATIVES)) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[DIMINDEX_1; FORALL_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_EQ) THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[GSYM drop; LIFT_DROP; matrix] THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; CART_EQ; FORALL_1; DIMINDEX_1; DROP_BASIS] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_MUL_LID]);; let MEASURABLE_ON_VECTOR_DERIVATIVE = prove (`!f:real^1->real^N f' s k. negligible k /\ lebesgue_measurable s /\ (!x. x IN (s DIFF k) ==> (f has_vector_derivative f'(x)) (at x)) ==> f' measurable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f':real^1->real^N) measurable_on (s DIFF k)` MP_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_VECTOR_DERIVATIVE_GEN THEN EXISTS_TAC `f:real^1->real^N` THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; HAS_VECTOR_DERIVATIVE_AT_WITHIN; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; MATCH_MP_TAC MEASURABLE_ON_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]);; let MEASURABLE_ON_DET_JACOBIAN = prove (`!f:real^N->real^N f' s. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s)) ==> (\x. lift(det(matrix(f' x)))) measurable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[det; LIFT_SUM; o_DEF] THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; FORALL_IN_GSPEC] THEN X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN MATCH_MP_TAC MEASURABLE_ON_LIFT_PRODUCT THEN ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_PARTIAL_DERIVATIVES THEN EXISTS_TAC `f:real^N->real^N` THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]);; (* ------------------------------------------------------------------------- *) (* Luzin's theorem (Talvila and Loeb's proof from Marius Junge's notes). *) (* ------------------------------------------------------------------------- *) let LUZIN = prove (`!f:real^M->real^N s e. measurable s /\ f measurable_on s /\ &0 < e ==> ?k. compact k /\ k SUBSET s /\ measure(s DIFF k) < e /\ f continuous_on k`, REPEAT STRIP_TAC THEN X_CHOOSE_THEN `v:num->real^N->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE_SEQUENCE THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `!n. ?k k'. compact k /\ k SUBSET {x | x IN s /\ (f:real^M->real^N) x IN v n} /\ compact k' /\ k' SUBSET {x | x IN s /\ f x IN ((:real^N) DIFF v n)} /\ measure(s DIFF (k UNION k')) < e / &4 / &2 pow n` MP_TAC THENL [GEN_TAC THEN MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (v:num->real^N->bool) n}`; `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH; REAL_LT_DIV; REAL_LT_POW2] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (:real^N) DIFF v(n:num)}`; `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN ASM_SIMP_TAC[GSYM OPEN_CLOSED; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k':real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `measure(({x | x IN s /\ (f:real^M->real^N) x IN v n} DIFF k) UNION ({x | x IN s /\ f x IN ((:real^N) DIFF v(n:num))} DIFF k'))` THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT; GSYM OPEN_CLOSED] THEN SET_TAC[]; ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_DIFF; MEASURABLE_COMPACT; GSYM OPEN_CLOSED; MEASURE_DIFF_SUBSET] THEN MATCH_MP_TAC(REAL_ARITH `s < k + e / &4 / &2 / d /\ s' < k' + e / &4 / &2 / d /\ m = &0 ==> (s - k) + (s' - k') - m < e / &4 / d`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[MEASURE_EMPTY] `s = {} ==> measure s = &0`) THEN SET_TAC[]]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_DIFF; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `k':num->real^M->bool`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN EXISTS_TAC `INTERS {k n UNION k' n | n IN (:num)} :real^M->bool` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COMPACT_INTERS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; COMPACT_UNION] THEN SET_TAC[]; REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[DIFF_INTERS; SET_RULE `{f y | y IN {g x | x IN s}} = {f(g x) | x IN s}`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_SIMP_TAC[real_div; SUM_LMUL; REAL_LE_LMUL_EQ; REAL_ARITH `(e * inv(&4)) * s <= e * inv(&2) <=> e * s <= e * &2`] THEN REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `(&1 - s) / (&1 / &2) <= &2 <=> &0 <= s`] THEN MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN_OPEN; IN_ELIM_THM] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?n:num. (f:real^M->real^N)(x) IN v(n) /\ v(n) SUBSET t` STRIP_ASSUME_TAC THENL [UNDISCH_THEN `!s. open s ==> (?k. s:real^N->bool = UNIONS {v(n:num) | n IN k})` (MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; UNIONS_GSPEC] THEN ASM SET_TAC[]; EXISTS_TAC `(:real^M) DIFF k'(n:num)` THEN ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]]);; let LUZIN_EQ,LUZIN_EQ_ALT = (CONJ_PAIR o prove) (`(!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !e. &0 < e ==> ?k. compact k /\ k SUBSET s /\ measure(s DIFF k) < e /\ f continuous_on k)) /\ (!f:real^M->real^N s. measurable s ==> (f measurable_on s <=> !e. &0 < e ==> ?k g. compact k /\ k SUBSET s /\ measure(s DIFF k) < e /\ g continuous_on (:real^M) /\ (!x. x IN k ==> g x = f x)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[LUZIN]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBTOPOLOGY_UNIV; GSYM CLOSED_IN]; DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `g:num->real^M->real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC [`g:num->real^M->real^N`; `s DIFF UNIONS {INTERS {k m | n <= m} | n IN (:num)}:real^M->bool`] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN ASM_MESON_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; SIMP_TAC[DIFF_UNIONS_NONEMPTY; SET_RULE `~({f x | x IN UNIV} = {})`] THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPECL [`inv(&2)`; `e / &4`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s DIFF INTERS {k m | n:num <= m}:real^M->bool` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[INTERS_GSPEC; FORALL_IN_GSPEC] THEN ASM SET_TAC[]; MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS_GEN THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[LE_REFL]] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV]; REWRITE_TAC[DIFF_INTERS] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT; MEASURABLE_DIFF] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV]; REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `ns:num->bool` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN ASM_SIMP_TAC[o_DEF; MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_COMPACT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN FIRST_ASSUM(MP_TAC o SPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (n..m) (\i. measure(s DIFF k i:real^M->bool))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_COMPACT; FINITE_NUMSEG; SUBSET; IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (n..m) (\i. inv(&2 pow i))` THEN ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `a <= e / &4 /\ &0 <= b ==> (a - b) / (&1 / &2) <= e / &2`) THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_LT_POW2]]]; REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[UNIONS_GSPEC; IN_INTER] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; INTERS_GSPEC] THEN STRIP_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]]]);; let LUZIN_SIGMA = prove (`!f:real^M->real^N s. lebesgue_measurable s /\ f measurable_on s ==> ?u. COUNTABLE u /\ pairwise DISJOINT u /\ (!k. k IN u ==> compact k /\ k SUBSET s /\ f continuous_on k) /\ negligible(s DIFF UNIONS u)`, let lemma = prove (`!f:real^M->real^N s. measurable s /\ f measurable_on s ==> ?u. COUNTABLE u /\ pairwise DISJOINT u /\ (!k. k IN u ==> compact k /\ k SUBSET s /\ f continuous_on k) /\ negligible(s DIFF UNIONS u)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?g. !n. g n = @k. compact k /\ k SUBSET (s DIFF UNIONS {g(i:num) | i < n}) /\ measure((s DIFF UNIONS {g i | i < n}) DIFF k) < inv(&n + &1) /\ (f:real^M->real^N) continuous_on k` MP_TAC THENL [MATCH_MP_TAC WF_REC_num THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN BINOP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPLICATE_TAC 2 (AP_THM_TAC THEN AP_TERM_TAC) THEN AP_TERM_TAC THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_TAC `g:num->real^M->bool`)] THEN SUBGOAL_THEN `!n:num. compact (g n) /\ (g n) SUBSET (s DIFF UNIONS {g(i:num) | i < n}) /\ measure (s DIFF UNIONS {g i | i < n} DIFF (g n)) < inv(&n + &1) /\ (f:real^M->real^N) continuous_on (g n)` MP_TAC THENL [MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SPEC `n:num`) THEN CONV_TAC SELECT_CONV THEN MATCH_MP_TAC LUZIN THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC MEASURABLE_ON_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_DIFF]] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT]; FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN EXISTS_TAC `IMAGE (g:num->real^M->bool) (:num)` THEN ASM_SIMP_TAC[NUM_COUNTABLE; COUNTABLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[PAIRWISE_IMAGE] THEN REWRITE_TAC[pairwise; IN_UNIV] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN ASM SET_TAC[]; ASM SET_TAC[]; REWRITE_TAC[NEGLIGIBLE_OUTER] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `s DIFF UNIONS {(g:num->real^M->bool) i | i < n} DIFF g n` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a. ?u. COUNTABLE u /\ pairwise DISJOINT u /\ (!k. k IN u ==> compact k /\ k SUBSET s INTER {x | !i. 1 <= i /\ i <= dimindex(:M) ==> a$i <= x$i /\ x$i < a$i + &1} /\ (f:real^M->real^N) continuous_on k) /\ negligible(s INTER {x | !i. 1 <= i /\ i <= dimindex(:M) ==> (a:real^M)$i <= x$i /\ x$i < a$i + &1} DIFF UNIONS u)` MP_TAC THENL [GEN_TAC THEN MATCH_MP_TAC lemma THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE THEN ASM_REWRITE_TAC[] THEN (MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL [MATCH_MP_TAC IS_INTERVAL_CONVEX THEN REWRITE_TAC[is_interval; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[a:real^M,a + vec 1]` THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN SIMP_TAC[SUBSET; IN_INTERVAL; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN SIMP_TAC[REAL_LT_IMP_LE; IN_ELIM_THM]]); REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `u:real^M->(real^M->bool)->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN EXISTS_TAC `UNIONS (IMAGE (u:real^M->(real^M->bool)->bool) {x | !i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i)})` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[COUNTABLE_INTEGER_COORDINATES; COUNTABLE_IMAGE]; REWRITE_TAC[pairwise] THEN REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_UNIONS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `a:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN X_GEN_TAC `b:real^M` THEN DISCH_TAC THEN X_GEN_TAC `l:real^M->bool` THEN REPEAT DISCH_TAC THEN ASM_CASES_TAC `a:real^M = b` THENL [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `(a:real^M)$i - (b:real^M)$i` REAL_ABS_INTEGER_LEMMA) THEN ASM_SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0] THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`a:real^M`; `k:real^M->bool`] th) THEN MP_TAC(ISPECL [`b:real^M`; `l:real^M->bool`] th)) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o el 1 o CONJUNCTS)) THEN MATCH_MP_TAC(SET_RULE `DISJOINT i j ==> k SUBSET s INTER i ==> l SUBSET s INTER j ==> DISJOINT k l`) THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[FORALL_IN_UNIONS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; FIRST_ASSUM(MP_TAC o ISPEC `{x:real^M | !i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i)}` o MATCH_MP (MESON[FORALL_IN_IMAGE; COUNTABLE_IMAGE; NEGLIGIBLE_COUNTABLE_UNIONS_GEN] `(!a. negligible(f a)) ==> !s. COUNTABLE s ==> negligible(UNIONS (IMAGE f s))`)) THEN REWRITE_TAC[COUNTABLE_INTEGER_COORDINATES] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; SUBSET; IN_DIFF; IN_INTER] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `(lambda i. floor((x:real^M)$i)):real^M` THEN ASM_SIMP_TAC[LAMBDA_BETA; FLOOR] THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(lambda i. floor((x:real^M)$i)):real^M` THEN ASM_SIMP_TAC[LAMBDA_BETA; FLOOR]]);; let LUZIN_SIGMA_EXPLICIT = prove (`!f:real^M->real^N s. lebesgue_measurable s /\ f measurable_on s ==> ?k. (!n. compact(k n)) /\ (!n. k n SUBSET s) /\ (!n. f continuous_on k n) /\ pairwise (\m n. DISJOINT (k m) (k n)) (:num) /\ negligible(s DIFF UNIONS {k n | n IN (:num)})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:(real^M->bool)->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COUNTABLE_AS_INJECTIVE_IMAGE_SUBSET]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_ALT] THEN MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `t:num->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN EXISTS_TAC `\n. if n IN t then (k:num->real^M->bool) n else {}` THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE]) THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_EMPTY]; ASM_MESON_TAC[EMPTY_SUBSET]; ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM UNIONS_INSERT_EMPTY] THEN AP_TERM_TAC THEN SET_TAC[]]);; let LUZIN_SIGMA_NESTED = prove (`!f:real^M->real^N s. lebesgue_measurable s /\ f measurable_on s ==> ?k. (!n. compact(k n)) /\ (!n. k n SUBSET s) /\ (!n. f continuous_on k n) /\ (!n. k n SUBSET k(SUC n)) /\ negligible(s DIFF UNIONS {k n | n IN (:num)})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:num->real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n. UNIONS {(c:num->real^M->bool) m | m <= n}` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC COMPACT_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_NUMSEG_LE; FINITE_IMAGE]; ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC]; X_GEN_TAC `k:num` THEN MP_TAC(ISPEC `\n:num. (f:real^M->real^N)` PASTING_LEMMA_LOCALLY_FINITE) THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`c:num->real^M->bool`; `{n:num | n <= k}`] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[CLOSED_SUBSET_EQ; COMPACT_IMP_CLOSED; UNIONS_GSPEC] THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG_LE] THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[OPEN_IN_REFL] `P(s:real^N->bool) ==> ?t. open_in (subtopology euclidean s) t /\ P t`) THEN ASM SET_TAC[]; REWRITE_TAC[LE; UNIONS_GSPEC] THEN SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[LE_REFL]]);; let PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN = prove (`!f:real^M->real^N s. f measurable_on s ==> ((!t. lebesgue_measurable t /\ t SUBSET s ==> lebesgue_measurable (IMAGE f t)) <=> (!t. negligible t /\ t SUBSET s ==> negligible (IMAGE f t)))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; DISCH_TAC THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`] LUZIN_SIGMA) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) t = IMAGE f (UNIONS u) UNION IMAGE f (t DIFF UNIONS u)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN CONJ_TAC THENL [REWRITE_TAC[IMAGE_UNIONS] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; LEBESGUE_MEASURABLE_COMPACT]; MATCH_MP_TAC NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Several variants of measurability of the Banach indicatrix. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_MEASURABLE_PREIMAGE_CARD_LE = prove (`!f:real^M->real^N s n. f measurable_on s /\ lebesgue_measurable s /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) ==> lebesgue_measurable {y | FINITE {x | x IN s /\ f x = y} /\ CARD {x | x IN s /\ f x = y} <= n}`, REPEAT STRIP_TAC THEN MP_TAC(SPECL[`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA_NESTED) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:num->real^M->bool` THEN STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF THEN EXISTS_TAC `{y | FINITE(UNIONS {{x | x IN c k /\ f x = (y:real^N)} | k IN (:num)}) /\ CARD(UNIONS {{x:real^M | x IN c k /\ f x = y} | k IN (:num)}) <= n}` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `!s:real^M->bool. lebesgue_measurable s /\ s = t ==> lebesgue_measurable t`) THEN EXISTS_TAC `INTERS {{y | FINITE {x | x IN c k /\ (f:real^M->real^N) x = y} /\ CARD {x | x IN c k /\ (f:real^M->real^N) x = y} <= n} | k IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT THEN X_GEN_TAC `k:num` THEN MATCH_MP_TAC GDELTA_IMP_LEBESGUE_MEASURABLE THEN MATCH_MP_TAC GDELTA_PREIMAGE_CARD_LE THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_FSIGMA]; REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARD_LE_UNIONS_CHAIN THEN ASM_REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m <= n ==> (c:num->real^M->bool) m SUBSET c n` MP_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE; SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[FINITE_SUBSET; CARD_SUBSET; LE_TRANS] `s SUBSET t ==> FINITE t /\ CARD t <= n ==> FINITE s /\ CARD s <= n`) THEN REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]]; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (s DIFF UNIONS {c n | n IN (:num)} )` THEN ASM_SIMP_TAC[SUBSET_DIFF] THEN MATCH_MP_TAC(SET_RULE `(!y. ~(P y <=> Q y) ==> y IN t) ==> ({y | P y} DIFF {y | Q y}) UNION ({y | Q y} DIFF {y | P y}) SUBSET t`) THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `~(FINITE(f y) /\ CARD(f y) <= n <=> FINITE(g y) /\ CARD(g y) <= n) ==> ~(f y = g y)`)) THEN REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]);; let LEBESGUE_MEASURABLE_PREIMAGE_HAS_SIZE = prove (`!f:real^M->real^N s n. f measurable_on s /\ lebesgue_measurable s /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) ==> lebesgue_measurable {y | {x | x IN s /\ f x = y} HAS_SIZE n}`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LEBESGUE_MEASURABLE_PREIMAGE_CARD_LE) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 0` THENL [DISCH_THEN(MP_TAC o SPEC `0`) THEN ASM_REWRITE_TAC[LE]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `n - 1` th) THEN MP_TAC(SPEC `n:num` th)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_DIFF) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[HAS_SIZE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `FINITE {x | x IN s /\ (f:real^M->real^N) x = y}` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let LEBESGUE_MEASURABLE_PREIMAGE_FINITE = prove (`!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) ==> lebesgue_measurable {y | FINITE {x | x IN s /\ f x = y}}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LEBESGUE_MEASURABLE_PREIMAGE_HAS_SIZE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[HAS_SIZE; UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);; let LEBESGUE_MEASURABLE_PREIMAGE_INFINITE = prove (`!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) ==> lebesgue_measurable {y | INFINITE {x | x IN s /\ f x = y}}`, REWRITE_TAC[INFINITE; SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL; LEBESGUE_MEASURABLE_PREIMAGE_FINITE]);; let MEASURABLE_ON_BANACH_INDICATRIX = prove (`!f:real^M->real^N s c. f measurable_on s /\ lebesgue_measurable s /\ (!t. t SUBSET s /\ negligible t ==> negligible (IMAGE f t)) ==> (\y. if FINITE {x | x IN s /\ f x = y} then lift(&(CARD{x | x IN s /\ f x = y})) else c) measurable_on (:real^N)`, REPEAT STRIP_TAC THEN SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; LEBESGUE_MEASURABLE_UNIV] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP; IN_UNIV] THEN X_GEN_TAC `a:real` THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[LIFT_DROP] THEN ASM_CASES_TAC `drop c <= a` THEN ASM_REWRITE_TAC[MESON[] `(if p then x else F) <=> p /\ x`; MESON[] `(if p then x else T) <=> ~p \/ p /\ x`] THENL [ONCE_REWRITE_TAC[SET_RULE `{x | ~P x \/ Q x} = (UNIV DIFF {x | P x}) UNION {x | Q x}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_COMPL; LEBESGUE_MEASURABLE_PREIMAGE_FINITE]; ALL_TAC] THEN (ASM_CASES_TAC `a < &0` THEN ASM_SIMP_TAC[REAL_ARITH `a < &0 ==> ~(&n <= a)`] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_EMPTY; EMPTY_GSPEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN SUBGOAL_THEN `!n. &n <= a <=> &n <= floor a` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM_MESON_TAC[REAL_LE_FLOOR; INTEGER_CLOSED]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `n:num` SUBST1_TAC o MATCH_MP FLOOR_POS) THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_PREIMAGE_CARD_LE THEN ASM_REWRITE_TAC[]));; (* ------------------------------------------------------------------------- *) (* A measurable subset on which a function is injective, the simple version *) (* first and then some approximate variants with a "better" subsets. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_MEASURABLE_DOMAIN_OF_INJECTIVITY = prove (`!f:real^M->real^N s. f measurable_on s ==> ?t. lebesgue_measurable t /\ t SUBSET s /\ IMAGE f t = IMAGE f s /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`, SUBGOAL_THEN `!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s ==> ?t. lebesgue_measurable t /\ t SUBSET s /\ IMAGE f t = IMAGE f s /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `u:(real^M->bool)->bool`] BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!y. ?x. y IN IMAGE f s DIFF IMAGE f (UNIONS u) ==> x IN s DIFF UNIONS u /\ (f:real^M->real^N) x = y` MP_TAC THENL [SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `b UNION IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s DIFF IMAGE f (UNIONS u))` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF THEN EXISTS_TAC `b:real^M->bool` THEN ASM_SIMP_TAC[BOREL_IMP_LEBESGUE_MEASURABLE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; ABBREV_TAC `v:real^M->bool = UNIONS u` THEN ASM_REWRITE_TAC[IMAGE_UNION] THEN ASM SET_TAC[]; ABBREV_TAC `v:real^M->bool = UNIONS u` THEN ASM SET_TAC[]]; REPEAT STRIP_TAC THEN SUBGOAL_THEN `lebesgue_measurable {x | x IN s /\ ~((f:real^M->real^N) x = vec 0)}` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `(:real^N) DELETE (vec 0)` o GEN_REWRITE_RULE I [MEASURABLE_ON_PREIMAGE_OPEN] o GEN_REWRITE_RULE I [GSYM MEASURABLE_ON_UNIV]) THEN SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`f:real^M->real^N`; `{x | x IN s /\ ~((f:real^M->real^N) x = vec 0)}`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT]; REWRITE_TAC[SET_RULE `IMAGE f {x | x IN s /\ ~(f x = a)} = IMAGE f s DELETE a`]] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `vec 0 IN IMAGE (f:real^M->real^N) s` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^M` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `(a:real^M) INSERT t` THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_INSERT] THEN ASM SET_TAC[]; EXISTS_TAC `t:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]]);; let BOREL_DOMAIN_OF_INJECTIVITY = prove (`!f:real^M->real^N s. f measurable_on s /\ lebesgue_measurable s /\ (!n. n SUBSET s /\ negligible n ==> negligible(IMAGE f n)) ==> ?t. borel t /\ t SUBSET s /\ negligible(IMAGE f s DIFF IMAGE f t) /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `u:(real^M->bool)->bool`] BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (s DIFF UNIONS u)` THEN ASM_SIMP_TAC[SUBSET_DIFF] THEN ASM SET_TAC[]);; let GDELTA_DOMAIN_OF_INJECTIVITY_MEASURABLE = prove (`!f:real^M->real^N s u e. f measurable_on s /\ lebesgue_measurable s /\ &0 < e /\ IMAGE f s SUBSET u /\ measurable u /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) ==> ?t. t SUBSET s /\ gdelta t /\ bounded t /\ measurable t /\ measurable(IMAGE f t) /\ measure(IMAGE f s DIFF IMAGE f t) < e /\ (!x y. x IN t /\ y IN t /\ f x = f y ==> x = y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA_NESTED) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:num->real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN) THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `\n:num. IMAGE (f:real^M->real^N) s DIFF IMAGE f (k n)` HAS_MEASURE_NESTED_INTERS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `n:num`; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SUBSET_REFL; LEBESGUE_MEASURABLE_COMPACT]; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN SUBGOAL_THEN `measure(INTERS {IMAGE (f:real^M->real^N) s DIFF IMAGE f (k n) | n IN (:num)}) = &0` SUBST1_TAC THENL [MATCH_MP_TAC MEASURE_EQ_0 THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (s DIFF UNIONS {k n | n IN (:num)})` THEN ASM_SIMP_TAC[SUBSET_DIFF] THEN REWRITE_TAC[INTERS_GSPEC; UNIONS_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[LIM_SEQUENTIALLY; DIST_LIFT]] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[REAL_SUB_RZERO; LE_REFL] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(k:num->real^M->bool) n`] GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `(k:num->real^M->bool) n` THEN ASM_SIMP_TAC[GDELTA_IMP_LEBESGUE_MEASURABLE; MEASURABLE_COMPACT]; ASM_SIMP_TAC[MEASURABLE_COMPACT; COMPACT_CONTINUOUS_IMAGE]; ASM_SIMP_TAC[REAL_ARITH `abs x < e ==> x < e`]; ASM_SIMP_TAC[]; ASM_MESON_TAC[SUBSET_TRANS]]);; (* ------------------------------------------------------------------------- *) (* Relations between image measure sizes and preimage cardinality. These *) (* are natural generalizations (from continuous functions on intervals) of *) (* two of the "Theorems of Banach" in Saks, "Theory of the Integral" IX.7. *) (* ------------------------------------------------------------------------- *) let LUZIN_NPROPERTY_IMP_COUNTABLE_PREIMAGES = prove (`!f:real^M->real^N s. lebesgue_measurable s /\ f measurable_on s /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) ==> negligible {y | ~COUNTABLE {x | x IN s /\ f x = y}}`, let lemma = prove (`!f:real^M->real^N s. lebesgue_measurable s /\ f measurable_on s /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) ==> ?t. t SUBSET s /\ lebesgue_measurable t /\ negligible(IMAGE f s DIFF IMAGE f t) /\ !y. COUNTABLE {x | x IN t /\ f x = y}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:(real^M->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!k. k IN u ==> ?k'. measurable k' /\ k' SUBSET k /\ IMAGE f k' = IMAGE f k /\ !y. FINITE {x | x IN k' /\ (f:real^M->real^N) x = y}` MP_TAC THENL [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `k:real^M->bool`] GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN REWRITE_TAC[SUBSET_RESTRICT] THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN ASM_SIMP_TAC[GDELTA_IMP_LEBESGUE_MEASURABLE]; MATCH_MP_TAC(MESON[FINITE_SUBSET; FINITE_SING] `(?a. s SUBSET {a}) ==> FINITE s`) THEN ASM SET_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS(IMAGE (c:(real^M->bool)->(real^M->bool)) u)` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE]; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (s DIFF UNIONS u)` THEN ASM_SIMP_TAC[SUBSET_DIFF] THEN MATCH_MP_TAC (SET_RULE `IMAGE f u = IMAGE f t ==> (IMAGE f s DIFF IMAGE f u) SUBSET IMAGE f (s DIFF t)`) THEN ASM SET_TAC[]; X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN c k /\ (f:real^M->real^N) x = y} | (k:real^M->bool) IN u}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LUZIN_SIGMA) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:(real^M->bool)->bool` THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS{{y | ~COUNTABLE {x | x IN k /\ f x = y}} | k IN u} UNION IMAGE (f:real^M->real^N) (s DIFF UNIONS u)` THEN REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[COUNTABLE_EMPTY] `~COUNTABLE s ==> ~(s = {})`)) THEN REWRITE_TAC[SET_RULE `~({x | x IN s /\ f x = y} = {}) <=> y IN IMAGE f s`] THEN DISCH_TAC THEN REWRITE_TAC[TAUT `p \/ q <=> ~q ==> p`] THEN DISCH_TAC THEN REWRITE_TAC[MESON[] `(?x. P x /\ ~Q x) <=> ~(!x. P x ==> Q x)`] THEN DISCH_TAC THEN UNDISCH_TAC `~COUNTABLE {x | x IN s /\ (f:real^M->real^N) x = y}` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x = y} = {x | x IN UNIONS u /\ f x = y}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN k /\ (f:real^M->real^N) x = y} | k IN u}` THEN ASM_SIMP_TAC[COUNTABLE_UNIONS; FORALL_IN_IMAGE; SIMPLE_IMAGE; COUNTABLE_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE] THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `compact k /\ (f:real^M->real^N) continuous_on k /\ (!t. t SUBSET k /\ negligible t ==> negligible(IMAGE f t))` MP_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS]; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`k:real^M->bool`,`s:real^M->bool`) THEN REPEAT STRIP_TAC THEN ABBREV_TAC `m = sup { measure t | t SUBSET s /\ lebesgue_measurable t /\ negligible(IMAGE f s DIFF IMAGE f t) /\ !y. COUNTABLE {x | x IN t /\ (f:real^M->real^N) x = y}}` THEN FIRST_ASSUM(MP_TAC o C SPEC SUP o rand o lhs o concl) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(?x. P x) ==> ~({f x | P x} = {})`) THEN MATCH_MP_TAC lemma THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_COMPACT; CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET]; ASM_MESON_TAC[MEASURE_SUBSET; MEASURABLE_LEBESGUE_MEASURABLE_SUBSET; MEASURABLE_COMPACT]]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `m - inv(&n + &1)`) THEN REWRITE_TAC[REAL_ARITH `m <= m - a <=> ~(&0 < a)`] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[NOT_FORALL_THM; SKOLEM_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:num->real^M->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ABBREV_TAC `t:real^M->bool = UNIONS {h n | n IN (:num)}` THEN SUBGOAL_THEN `lebesgue_measurable(t:real^M->bool)` ASSUME_TAC THENL [EXPAND_TAC "t" THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s DIFF t:real^M->bool`] lemma) THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_COMPACT] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; SUBSET_TRANS; SUBSET_DIFF; LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_COMPACT; CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET]; DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `measurable(t:real^M->bool) /\ measurable(u:real^M->bool) /\ (!n. measurable((h:num->real^M->bool) n))` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!y. COUNTABLE {x | x IN t /\ (f:real^M->real^N) x = y}` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN h n /\ (f:real^M->real^N) x = y} | n IN (:num)}` THEN ASM_SIMP_TAC[COUNTABLE_UNIONS; FORALL_IN_IMAGE; SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN EXPAND_TAC "t" THEN REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `negligible(IMAGE (f:real^M->real^N) s DIFF IMAGE f t)` ASSUME_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s DIFF IMAGE f (h 0)` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "t" THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `measure(t UNION u:real^M->bool) <= m` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_UNION] THEN REWRITE_TAC[SET_RULE `{x | x IN s UNION t /\ P x} = {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN ASM_REWRITE_TAC[COUNTABLE_UNION] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `(IMAGE f (s DIFF t) DIFF IMAGE f u) UNION (IMAGE (f:real^M->real^N) s DIFF IMAGE f t)` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN SET_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_DISJOINT_UNION o lhand o lhand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `t + u <= m ==> &0 <= u ==> ~(&0 < m - t) ==> u = &0`)) THEN ASM_SIMP_TAC[MEASURE_POS_LE] THEN ANTS_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM ARCH_EVENTUALLY_INV1] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; REAL_NOT_LT] THEN ONCE_REWRITE_TAC[REAL_ARITH `a - b <= c <=> a - c <= b`] THEN TRANS_TAC REAL_LE_TRANS `measure((h:num->real^M->bool) n)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "t" THEN SET_TAC[]; ASM_SIMP_TAC[MEASURABLE_MEASURE_EQ_0] THEN DISCH_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (s DIFF (t UNION u))` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) u UNION (IMAGE f s DIFF IMAGE f t) UNION (IMAGE f (s DIFF t) DIFF IMAGE f u)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ]; SET_TAC[]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `{x | x IN t /\ (f:real^M->real^N) x = y} UNION {x | x IN u /\ (f:real^M->real^N) x = y}` THEN ASM_REWRITE_TAC[COUNTABLE_UNION] THEN ASM SET_TAC[]]);; let BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY_OUTER = prove (`!f:real^M->real^N s. (!e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> ?u. IMAGE f t SUBSET u /\ measurable u /\ measure u < e) ==> (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t))`, REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "*") THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURE_EQ_0; NEGLIGIBLE_IMP_MEASURABLE]);; let BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY = prove (`!f:real^M->real^N s. (!e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable (IMAGE f t) /\ measure (IMAGE f t) < e) ==> (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY_OUTER THEN ASM_MESON_TAC[SUBSET_REFL]);; let BANACH_SPROPERTY_OUTER = prove (`!f:real^M->real^N s. f measurable_on s /\ (!e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> ?u. IMAGE f t SUBSET u /\ measurable u /\ measure u < e) ==> (!e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable (IMAGE f t) /\ measure (IMAGE f t) < e)`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o snd o EQ_IMP_RULE o MATCH_MP PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[CONJ_SYM] THEN MATCH_MP_TAC BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY_OUTER THEN ASM_REWRITE_TAC[]; DISCH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_MESON_TAC[MEASURABLE_LEBESGUE_MEASURABLE_SUBSET; MEASURE_SUBSET; REAL_LET_TRANS]);; let BANACH_SPROPERTY_IMP_PRESERVES_MEASURABLE = prove (`!f:real^M->real^N s. (!e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable (IMAGE f t) /\ measure (IMAGE f t) < e) ==> (!t. t SUBSET s /\ measurable t ==> measurable(IMAGE f t))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_LT_01] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN MP_TAC(SPEC `measure(t:real^M->bool) / d` REAL_ARCH_LT) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_DIV; REAL_LT_IMP_LE; MEASURE_POS_LE] THEN REWRITE_TAC[REAL_NOT_LE] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_HALF] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN DISCH_TAC THEN MP_TAC(ISPECL [`t:real^M->bool`; `n:num`] MULTIPART_MEASURES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN EXPAND_TAC "t" THEN REWRITE_TAC[IMAGE_UNIONS] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `measurable s /\ measure s < &1 ==> measurable(s:real^M->bool)`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let BANACH_SPROPERTY_IMP_FINITE_PREIMAGES = prove (`!f:real^M->real^N s. f measurable_on s /\ measurable s /\ (!e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable (IMAGE f t) /\ measure (IMAGE f t) < e) ==> negligible {y | INFINITE {x | x IN s /\ f x = y}}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_IMP_LEBESGUE_MEASURABLE) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP BANACH_SPROPERTY_IMP_PRESERVES_MEASURABLE) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LEBESGUE_MEASURABLE_PREIMAGE_INFINITE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LEBESGUE_MEASURABLE_INNER_COMPACT)) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?c. (!n. c n SUBSET s DIFF UNIONS {c m | (m:num) < n}) /\ (!n. measurable(c n)) /\ (!n. measurable(IMAGE (f:real^M->real^N) (c n))) /\ (!n. measure(k:real^N->bool) / &2 <= measure(IMAGE f (c n))) /\ (!n x y. x IN c n /\ y IN c n ==> (f x = f y <=> x = y))` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?c. !n. c n = @t. t SUBSET s DIFF UNIONS {c m | (m:num) < n} /\ measurable t /\ measurable(IMAGE (f:real^M->real^N) t) /\ measure(k:real^N->bool) / &2 <= measure(IMAGE f t) /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y))` MP_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[UNIONS_GSPEC; MESON[] `(?m:num. m < n /\ a IN f m) <=> ~(!m. m < n ==> ~(a IN f m))`] THEN ASM_SIMP_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `c:num->real^M->bool` THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(fun th -> MATCH_MP_TAC num_WF THEN MP_TAC th) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN CONV_TAC SELECT_CONV THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s DIFF UNIONS {(c:num->real^M->bool) m | m < n}`; `IMAGE (f:real^M->real^N) s`; `measure(k:real^N->bool) / &2`] GDELTA_DOMAIN_OF_INJECTIVITY_MEASURABLE) THEN ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL [MATCH_MP_TAC(TAUT `r /\ s /\ (q ==> p) /\ q ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_REFL]] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; SUBSET_DIFF]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; SUBSET_DIFF]; MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^M->bool`] THEN REWRITE_TAC[INJECTIVE_ON_ALT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < k / &2 ==> k <= x + y ==> k / &2 <= y`)) THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_UNION_LE o rand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[SUBSET_REFL] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THENL [REWRITE_TAC[SUBSET_DIFF]; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> (IMAGE f s DIFF IMAGE f t) UNION IMAGE f t = IMAGE f s`] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_DIFF] THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `{y | INFINITE {x | x IN s /\ (f:real^M->real^N) x = y}}` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `y IN IMAGE f s <=> ~({x | x IN s /\ f x = y} = {})`] THEN MATCH_MP_TAC(MESON[FINITE_EMPTY] `~FINITE s ==> ~(s = {})`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INFINITE]) THEN REWRITE_TAC[CONTRAPOS_THM] THEN SUBGOAL_THEN `FINITE {x | x IN UNIONS {c m | (m:num) < n} /\ (f:real^M->real^N) x = y}` MP_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN REWRITE_TAC[INTER_UNIONS; FINITE_UNIONS; SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[GSYM IMAGE_o; FINITE_IMAGE; FINITE_NUMSEG_LT] THEN REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; FORALL_IN_GSPEC; IMAGE_ID] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[FINITE_SUBSET; FINITE_SING] `(?a. s SUBSET {a}) ==> FINITE s`) THEN ASM SET_TAC[]; REWRITE_TAC[IMP_IMP; GSYM FINITE_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN SET_TAC[]]; FIRST_X_ASSUM(MP_TAC o SPEC `measure(k:real^N->bool) / &2`) THEN ASM_SIMP_TAC[REAL_HALF; NOT_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(c:num->real^M->bool) n`) THEN ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN MATCH_MP_TAC(MESON[] `(!n. P n) /\ ~(!n. ~Q n) ==> ?n. P n /\ Q n`) THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[REAL_NOT_LT]] THEN DISCH_TAC THEN MP_TAC(ISPEC `measure(s:real^M->bool) / d` REAL_ARCH_LT) THEN REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LT] THEN X_GEN_TAC `n:num` THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN TRANS_TAC REAL_LE_TRANS `measure(UNIONS {(c:num->real^M->bool) m | m < n})` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o rand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG_LT; FORALL_IN_GSPEC] THEN ANTS_TAC THENL [MATCH_MP_TAC WLOG_LT THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_LT] THEN SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG_LT] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; FINITE_NUMSEG_LT]; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[UNIONS_SUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]]]);; let ABSOLUTELY_CONTINUOUS_MEASURE_IMAGE = prove (`!f:real^M->real^N s u. f measurable_on s /\ IMAGE f s SUBSET u /\ measurable u /\ (!t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t)) /\ negligible {y | INFINITE {x | x IN s /\ f x = y}} ==> (!e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable (IMAGE f t) /\ measure (IMAGE f t) < e)`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[] `((!d. ~P d) ==> F) ==> ?d. P d`) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [NOT_FORALL_THM] THEN REWRITE_TAC[SKOLEM_THM; NOT_EXISTS_THM; NOT_IMP] THEN X_GEN_TAC `t:num->real^M->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `!n:num. measurable(IMAGE (f:real^M->real^N) (t n))` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN) THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE]; ASM_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC] THEN MAP_EVERY ABBREV_TAC [`c:real^M->bool = INTERS {UNIONS {t k | n <= k} | n IN (:num)}`; `d = INTERS {UNIONS {IMAGE (f:real^M->real^N) (t k) | n <= k} | n IN (:num)}`] THEN MP_TAC(ISPEC `\n:num. UNIONS {IMAGE (f:real^M->real^N) (t k) | n <= k}` HAS_MEASURE_NESTED_INTERS) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `SUC n <= k <=> n <= k /\ ~(n = k)`] THEN CONJ_TAC THENL [X_GEN_TAC `n:num`; SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN) THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN DISCH_THEN(MP_TAC o SPEC `e:real` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] LIM_DROP_LBOUND)) THEN REWRITE_TAC[LIFT_DROP; TRIVIAL_LIMIT_SEQUENTIALLY; NOT_IMP; REAL_NOT_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `measure(IMAGE (f:real^M->real^N) (t(n:num)))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN) THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE]; MP_TAC(SPEC `n:num` LE_REFL) THEN REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 < e ==> x = &0 ==> x < e`)) THEN ASM_SIMP_TAC[MEASURABLE_MEASURE_EQ_0]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL [EXPAND_TAC "c" THEN CONJ_TAC THENL [MATCH_MP_TAC INTERS_SUBSET THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EMPTY_UNIONS; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `d:real`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `UNIONS {t k | SUC N <= k}:real^M->bool` THEN CONJ_TAC THENL [EXPAND_TAC "c" THEN REWRITE_TAC[SUBSET; INTERS_GSPEC; UNIONS_GSPEC] THEN SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[REAL_LET_TRANS] `a < d ==> measurable(s:real^N->bool) /\ measure s <= a ==> measurable s /\ measure s < d`)) THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `k:num->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN ASM_SIMP_TAC[o_DEF; MEASURE_POS_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN FIRST_ASSUM(X_CHOOSE_THEN `M:num` MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[] THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `sum(SUC N..M) (\n. measure(t n:real^M->bool))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; MEASURE_POS_LE] THEN ASM SET_TAC[]; TRANS_TAC REAL_LE_TRANS `sum(SUC N..M) (\n. inv(&2 pow n))` THEN ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN REWRITE_TAC[SUM_GP; REAL_INV_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN SIMP_TAC[REAL_POW_LE; REAL_ARITH `&0 <= &1 / &2`; real_pow; REAL_ARITH `(&1 / &2 * x - &1 / &2 * y) / (&1 / &2) <= x <=> &0 <= y`]]]; UNDISCH_TAC `negligible {y | INFINITE {x | x IN s /\ (f:real^M->real^N) x = y}}` THEN REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET)] THEN EXPAND_TAC "d" THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN ONCE_REWRITE_TAC[TAUT `p \/ q <=> ~q ==> p`] THEN EXPAND_TAC "c" THEN REWRITE_TAC[IN_IMAGE; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV; UNIONS_GSPEC] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[INFINITE; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_TAC THEN DISCH_THEN(X_CHOOSE_TAC `r:real^M->num`) THEN FIRST_ASSUM(X_CHOOSE_THEN `M:num` MP_TAC o ISPEC `r:real^M->num` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `k:num` MP_TAC o SPEC `M:num`) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) THEN ASM_MESON_TAC[LE_TRANS]);; let ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_GEN = prove (`!f:real^N->real^N s. compact s /\ f continuous_on s /\ negligible (IMAGE f {x | x IN s /\ ~(f differentiable (at x within s))}) ==> !e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable(IMAGE f t) /\ measure(IMAGE f t) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_MEASURE_IMAGE THEN EXISTS_TAC `IMAGE (f:real^N->real^N) s` THEN REWRITE_TAC[SUBSET_REFL] THEN ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; COMPACT_CONTINUOUS_IMAGE; LEBESGUE_MEASURABLE_COMPACT; MEASURABLE_COMPACT; NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE] THEN X_GEN_TAC `n:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE f {x | x IN s /\ ~(f differentiable at x within s)} UNION IMAGE (f:real^N->real^N) {x | x IN n /\ f differentiable at x within s}` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN REWRITE_TAC[LE_REFL] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT]; REWRITE_TAC[differentiable_on; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] DIFFERENTIABLE_WITHIN_SUBSET) THEN ASM SET_TAC[]]);; let ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE = prove (`!f:real^N->real^N s. compact s /\ f differentiable_on s ==> !e. &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable(IMAGE f t) /\ measure(IMAGE f t) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_GEN THEN ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN RULE_ASSUM_TAC(REWRITE_RULE[differentiable_on]) THEN ASM_REWRITE_TAC[TAUT `p /\ ~q <=> ~(p ==> q)`] THEN REWRITE_TAC[EMPTY_GSPEC; IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]);; (* ------------------------------------------------------------------------- *) (* More refined measurability bounds for Lipschitz or differentiable images. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE = prove (`!f:real^M->real^N s. dimindex(:M) <= dimindex(:N) /\ lebesgue_measurable s /\ (!x. x IN s ==> ?t b. open t /\ x IN t /\ !y. y IN s INTER t ==> norm(f y - f x) <= b * norm(y - x)) ==> lebesgue_measurable(IMAGE f s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) continuous_on s` MP_TAC THENL [REWRITE_TAC[continuous_on] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; dist] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `B:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (e / (abs B + &1))` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MIN; REAL_ARITH `&0 < abs B + &1`] THEN X_GEN_TAC `y:real^M` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_ARITH `&0 < abs B + &1`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN TRANS_TAC REAL_LE_TRANS `B * norm(y - x:real^M)` THEN ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; REAL_ARITH `B <= abs B + &1`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[dist]; DISCH_THEN(MP_TAC o MATCH_MP PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE) THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_REFL]] THEN X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE,MEASURE_LOCALLY_LIPSCHITZ_IMAGE = (CONJ_PAIR o prove) (`(!f:real^M->real^N s B. dimindex(:M) <= dimindex(:N) /\ measurable s /\ (!x. x IN s ==> ?t. open t /\ x IN t /\ (!y. y IN s INTER t ==> norm(f y - f x) <= B * norm(y - x))) ==> measurable(IMAGE f s)) /\ (!f:real^M->real^N s B. dimindex(:M) <= dimindex(:N) /\ measurable s /\ (!x. x IN s ==> ?t. open t /\ x IN t /\ (!y. y IN s INTER t ==> norm(f y - f x) <= B * norm(y - x))) ==> measure(IMAGE f s) <= B pow dimindex(:N) * measure s)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. ?e. x IN s ==> &0 < e /\ !y. y IN s INTER ball(x,e) ==> norm((f:real^M->real^N) y - f x) <= B * norm(y - x)` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_INTER] THEN MESON_TAC[]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `r:real^M->real` THEN DISCH_THEN(LABEL_TAC "*") THEN ASM_CASES_TAC `B < &0` THENL [SUBGOAL_THEN `negligible(s:real^M->bool)` ASSUME_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `(r:real^M->real) x` THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[IN_INTER; IN_BALL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ANTS_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN MATCH_MP_TAC(NORM_ARITH `&0 < --x ==> ~(norm(a:real^M) <= x)`) THEN REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; SUBGOAL_THEN `negligible(IMAGE (f:real^M->real^N) s)` ASSUME_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_EQ_MEASURE_0]) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN ASM_CASES_TAC `dimindex(:M) < dimindex(:N)` THENL [SUBGOAL_THEN `negligible(IMAGE (f:real^M->real^N) s)` MP_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE_LOWDIM THEN ASM SET_TAC[]; ASM_SIMP_TAC[NEGLIGIBLE_EQ_MEASURE_0; REAL_POS; REAL_POW_LE; REAL_LE_MUL; MEASURE_POS_LE]]; ALL_TAC] THEN ASM_CASES_TAC `B = &0` THENL [SUBGOAL_THEN `negligible(IMAGE (f:real^M->real^N) s)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[NEGLIGIBLE_EQ_MEASURE_0; REAL_POS; REAL_POW_LE; REAL_LE_MUL; MEASURE_POS_LE]] THEN MP_TAC(ISPEC `{ball(x:real^M,r x) | x IN s}` LINDELOF) THEN REWRITE_TAC[FORALL_IN_IMAGE; SIMPLE_IMAGE; OPEN_BALL] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (UNIONS (IMAGE (\x. s INTER ball(x,r x)) c))` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE (\x. {(f:real^M->real^N) x}) c)` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; NEGLIGIBLE_SING]; REWRITE_TAC[IMAGE_UNIONS; GSYM IMAGE_o; o_DEF] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x SUBSET g x) ==> UNIONS (IMAGE f s) SUBSET UNIONS (IMAGE g s)`) THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^M) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[REAL_MUL_LZERO; NORM_ARITH `norm(x - y:real^M) <= &0 <=> x = y`] THEN SET_TAC[]]; TRANS_TAC SUBSET_TRANS `IMAGE (f:real^M->real^N) (s INTER UNIONS(IMAGE (\x. ball (x,r x)) c))` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[INTER_UNIONS] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:real^M` THEN ASM_SIMP_TAC[CENTRE_IN_BALL]]; SUBGOAL_THEN `&0 < B` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN SUBGOAL_THEN `measurable(IMAGE (f:real^M->real^N) s) /\ !e. &0 < e ==> measure(IMAGE f s) <= B pow dimindex(:N) * (measure s + e)` MP_TAC THENL [MATCH_MP_TAC(MESON[REAL_LT_01] `(!e. &0 < e ==> P /\ Q e) ==> P /\ (!e. &0 < e ==> Q e)`); DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `(measure(IMAGE (f:real^M->real^N) s) / B pow dimindex(:N) - measure s) / &2`)) THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_RDIV_EQ; REAL_ADD_LDISTRIB; REAL_HALF; REAL_LT_IMP_NZ; REAL_DIV_LMUL; REAL_POW_LT; REAL_ARITH `B * (x - y) / &2 = (B * x - B * y) / &2`] THEN REAL_ARITH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `e:real`] MEASURABLE_OUTER_OPEN) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`{(x,t) | x IN s /\ t <= (r:real^M->real) x /\ ball(x,t) SUBSET u}`; `FST:real^M#real->real^M`; `SND:real^M#real->real`; `s:real^M->bool`] VITALI_COVERING_THEOREM_BALLS) THEN ASM_REWRITE_TAC[EXISTS_IN_GSPEC] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^M`; `d:real`] THEN STRIP_TAC THEN EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d':real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min (d / &2) (min d' (r(x:real^M)))` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_MIN; REAL_MIN_LE; REAL_LE_REFL] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN TRANS_TAC SUBSET_TRANS `ball(x:real^M,d')` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `c:real^M#real->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `measurable(IMAGE (f:real^M->real^N) (s INTER UNIONS {ball i | i IN c})) /\ measure(IMAGE (f:real^M->real^N) (s INTER UNIONS {ball i | i IN c})) <= B pow dimindex(:N) * (measure(s:real^M->bool) + e)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] MEASURABLE_NEGLIGIBLE_SYMDIFF); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (s DIFF UNIONS {ball i | i IN c})` THEN (CONJ_TAC THENL [ALL_TAC; SET_TAC[]]) THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC(MESON[MEASURABLE_LEBESGUE_MEASURABLE_SUBSET; REAL_LE_TRANS; MEASURE_SUBSET] `!t. lebesgue_measurable s /\ s SUBSET t /\ measurable t /\ measure t <= b ==> measurable s /\ measure s <= b`) THEN EXISTS_TAC `UNIONS {ball((f:real^M->real^N) (FST x),B * SND x) | (x:real^M#real) IN c}` THEN CONJ_TAC THENL [REWRITE_TAC[INTER_UNIONS; SIMPLE_IMAGE; GSYM IMAGE_o; IMAGE_UNIONS] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_GSPEC; o_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_INTER; MEASURABLE_BALL] THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[INTER_UNIONS; IMAGE_UNIONS] THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_GSPEC; o_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `t:real`] THEN STRIP_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^M`)) THEN ASM_REWRITE_TAC[IN_INTER; GSYM dist; IN_BALL] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[MEASURABLE_BALL] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `k:real^M#real->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ASM_REWRITE_TAC[MEASURABLE_BALL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN TRANS_TAC REAL_LE_TRANS `sum k (\a:real^M#real. abs B pow dimindex(:N) * measure(ball a))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `t:real`] THEN DISCH_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) x = B % inv(B) % f x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]; ALL_TAC] THEN ASM_SIMP_TAC[BALL_SCALING; MEASURE_SCALING; MEASURABLE_BALL] THEN SUBGOAL_THEN `dimindex(:N) = dimindex(:M)` SUBST1_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC REAL_LE_LMUL] THEN ASM_SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN ONCE_REWRITE_TAC[GSYM VECTOR_ADD_RID] THEN REWRITE_TAC[BALL_TRANSLATION; MEASURE_TRANSLATION] THEN SUBGOAL_THEN `ball(vec 0:real^N,t) = IMAGE (\x. lambda i. x$i) (ball(vec 0:real^M,t))` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_BALL_0; NORM_LT_SQUARE] THEN SIMP_TAC[dot; LAMBDA_BETA] THEN SUBGOAL_THEN `dimindex(:M) = dimindex(:N)` SUBST1_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[]] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN EXISTS_TAC `(lambda i. (y:real^N)$i):real^M` THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN SUBGOAL_THEN `dimindex(:N) = dimindex(:M)` SUBST1_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA]]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC MEASURE_ISOMETRY THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA; CART_EQ] THEN X_GEN_TAC `z:real^M` THEN SIMP_TAC[NORM_EQ; dot; LAMBDA_BETA] THEN SUBGOAL_THEN `dimindex(:M) = dimindex(:N)` SUBST1_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[]]]; REWRITE_TAC[SUM_LMUL] THEN ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_POW_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `u < s + e ==> x <= u ==> x <= s + e`)) THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; MEASURABLE_BALL] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FORALL_PAIR_THM; MEASURABLE_BALL; FINITE_IMAGE] THEN ASM SET_TAC[]]);; let LEBESGUE_MEASURABLE_LIPSCHITZ_IMAGE = prove (`!f:real^M->real^N s B. dimindex(:M) <= dimindex(:N) /\ lebesgue_measurable s /\ (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> lebesgue_measurable(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(:real^M)`; `B:real`] THEN ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; IN_INTER]);; let MEASURABLE_LIPSCHITZ_IMAGE = prove (`!f:real^M->real^N s B. dimindex(:M) <= dimindex(:N) /\ measurable s /\ (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> measurable(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(:real^M)` THEN ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; IN_INTER]);; let MEASURE_LIPSCHITZ_IMAGE = prove (`!f:real^M->real^N s B. dimindex(:M) <= dimindex(:N) /\ measurable s /\ (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> measure(IMAGE f s) <= B pow dimindex(:N) * measure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_LOCALLY_LIPSCHITZ_IMAGE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(:real^M)` THEN ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; IN_INTER]);; let MEASURABLE_BOUNDED_DIFFERENTIABLE_IMAGE, MEASURE_BOUNDED_DIFFERENTIABLE_IMAGE = (CONJ_PAIR o prove) (`(!f:real^N->real^N f' s B. measurable s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\ abs(det(matrix(f' x))) <= B) ==> measurable(IMAGE f s)) /\ (!f:real^N->real^N f' s B. measurable s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\ abs(det(matrix(f' x))) <= B) ==> measure(IMAGE f s) <= B * measure s)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN ASM_CASES_TAC `B < &0` THENL [ASM_SIMP_TAC[REAL_ARITH `B < &0 ==> ~(abs x <= B)`] THEN SIMP_TAC[GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[IMAGE_CLAUSES; MEASURE_EMPTY; MEASURABLE_EMPTY] THEN REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN STRIP_TAC] THEN SUBGOAL_THEN `measurable(IMAGE (f:real^N->real^N) s) /\ !e. &0 < e ==> measure(IMAGE f s) <= (B + e) * measure s` MP_TAC THENL [MATCH_MP_TAC(MESON[REAL_LT_01] `(!e. &0 < e ==> P /\ Q e) ==> P /\ (!e. &0 < e ==> Q e)`); FIRST_X_ASSUM(MP_TAC o MATCH_MP MEASURE_POS_LE) THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[REAL_MUL_RZERO; REAL_LT_01]; FIRST_X_ASSUM(MP_TAC o SPEC `(measure(IMAGE (f:real^N->real^N) s) / measure s - B) / &2`) THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]] THEN SUBGOAL_THEN `!d e. &0 < d /\ &0 < e ==> measurable(IMAGE (f:real^N->real^N) s) /\ measure(IMAGE f s) <= (B + e) * (measure s + d)` MP_TAC THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[REAL_LT_01]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(measure(IMAGE (f:real^N->real^N) s) / (B + e) - measure s) / &2`) THEN SUBGOAL_THEN `&0 < B + e` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[]] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM REAL_LE_LDIV_EQ)] THEN ASM_REAL_ARITH_TAC] THEN MAP_EVERY X_GEN_TAC [`m:real`; `e:real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `m:real`] MEASURABLE_OUTER_OPEN) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `(f:real^N->real^N) differentiable_on s` ASSUME_TAC THENL [REWRITE_TAC[differentiable_on; differentiable] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x d. x IN s /\ &0 < d ==> ?r. &0 < r /\ r < d /\ ball(x,r) SUBSET u /\ measurable(IMAGE (f:real^N->real^N) (s INTER ball(x,r))) /\ measure(IMAGE f (s INTER ball(x,r))) <= (B + e) * measure(ball(x,r))` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE ((f':real^N->real^N->real^N) x) (ball(vec 0,&1))`; `e * measure(ball(vec 0:real^N,&1))`] MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_EXPLICIT) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [has_derivative_within]) THEN ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_BALL; NEGLIGIBLE_CONVEX_FRONTIER] THEN ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE; BOUNDED_BALL] THEN ASM_SIMP_TAC[REAL_LT_MUL; MEASURE_BALL_POS; REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `k:real`) THEN ASM_REWRITE_TAC[DIST_0] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `r = min (min l (n / &2)) (min (&1) (d / &2))` THEN EXISTS_TAC `r:real` THEN REPLICATE_TAC 2 (MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `ball(x:real^N,l)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x. inv(r) % x) (IMAGE (\y. --(f x) + y) (IMAGE (f:real^N->real^N) (s INTER ball(x,r))))`) THEN ASM_SIMP_TAC[MEASURE_LINEAR_IMAGE; MEASURABLE_BALL; MEASURE_TRANSLATION; MEASURABLE_TRANSLATION] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) /\ (p ==> r ==> s) ==> (p /\ q ==> r) ==> s`) THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_INTER; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^N = x` THENL [EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[DIST_REFL; REAL_LT_01] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN REWRITE_TAC[VECTOR_ARITH `r % (--x + x):real^N = vec 0`] THEN ASM_REWRITE_TAC[DIST_REFL]; EXISTS_TAC `inv(r) % (y - x):real^N` THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN ASM_REWRITE_TAC[DIST_0; NORM_MUL; REAL_ABS_INV; DIST_MUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`] THEN REWRITE_TAC[NORM_ARITH `norm(y - x:real^N) < &1 * r <=> dist(x,y) < r`] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; GSYM dist; GSYM DIST_NZ] THEN MATCH_MP_TAC(NORM_ARITH `a <= b ==> dist(y:real^N,x + f) < a ==> dist(--x + y,f) < b`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN CONJ_TAC THENL [DISCH_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) LEBESGUE_MEASURABLE_IFF_MEASURABLE o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{a + b | a IN IMAGE ((f':real^N->real^N->real^N) x) (ball(vec 0,&1)) /\ b IN ball(vec 0,k)}` THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL; BOUNDED_LINEAR_IMAGE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> r /\ p /\ q`] THEN REWRITE_TAC[UNWIND_THM2; VECTOR_ARITH `x:real^N = a + b <=> b = x - a`] THEN REWRITE_TAC[IN_BALL_0; GSYM dist] THEN ASM_MESON_TAC[DIST_SYM]; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN THEN REWRITE_TAC[LE_REFL; LINEAR_SCALING] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_TRANSLATION] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_SIMP_TAC[LE_REFL; MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_INTER; MEASURABLE_BALL] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN DISCH_THEN(MP_TAC o ISPEC `\x:real^N. r % x` o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT] MEASURABLE_LINEAR_IMAGE)) THEN REWRITE_TAC[LINEAR_SCALING] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM IMAGE_o] THEN ASM_SIMP_TAC[o_DEF; VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID; IMAGE_ID] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^N) x` o MATCH_MP MEASURABLE_TRANSLATION) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM IMAGE_o] THEN REWRITE_TAC[o_DEF; VECTOR_ARITH `x + --x + y:real^N = y`] THEN REWRITE_TAC[IMAGE_ID] THEN DISCH_TAC THEN ASM_SIMP_TAC[MEASURE_SCALING; MEASURABLE_TRANSLATION] THEN REWRITE_TAC[MEASURE_TRANSLATION; REAL_ABS_INV; REAL_POW_INV] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_ARITH `&0 < r ==> &0 < abs r`] THEN MATCH_MP_TAC(REAL_ARITH `y <= z ==> x < y ==> x <= z`) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b + c) * r:real = a * r * b + c * r`] THEN SIMP_TAC[GSYM MEASURE_SCALING; MEASURABLE_BALL] THEN ASM_SIMP_TAC[GSYM BALL_SCALING] THEN MATCH_MP_TAC(REAL_ARITH `x <= a * m /\ w * z * y <= b * m ==> x + (w * y) * z <= (a + b) * m`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS] THEN SIMP_TAC[MEASURE_POS_LE; MEASURABLE_BALL] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_MUL_ASSOC]; ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN SIMP_TAC[GSYM MEASURE_SCALING; MEASURABLE_BALL] THEN ASM_SIMP_TAC[GSYM BALL_SCALING]] THEN REWRITE_TAC[VECTOR_MUL_RZERO; REAL_MUL_RID] THEN SUBST1_TAC(VECTOR_ARITH `x:real^N = x + vec 0`) THEN REWRITE_TAC[BALL_TRANSLATION; MEASURE_TRANSLATION; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN X_GEN_TAC `r:real^N->real->real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`{(x:real^N,(r:real^N->real->real) x t) | x IN s /\ &0 < t}`; `FST:real^N#real->real^N`; `SND:real^N#real->real`; `s:real^N->bool`] VITALI_COVERING_THEOREM_BALLS) THEN ASM_REWRITE_TAC[EXISTS_IN_GSPEC] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `d:real`] THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_MESON_TAC[]; DISCH_THEN(X_CHOOSE_THEN `c:real^N#real->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `measurable(IMAGE (f:real^N->real^N) (s INTER UNIONS {ball i | i IN c})) /\ measure(IMAGE (f:real^N->real^N) (s INTER UNIONS {ball i | i IN c})) <= (B + e) * (measure s + m)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] MEASURABLE_NEGLIGIBLE_SYMDIFF); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^N->real^N) (s DIFF UNIONS {ball i | i IN c})` THEN (CONJ_TAC THENL [ALL_TAC; SET_TAC[]]) THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[SUBSET_DIFF; differentiable_on; differentiable] THEN ASM_MESON_TAC[]] THEN REWRITE_TAC[INTER_UNIONS; SIMPLE_IMAGE; GSYM IMAGE_o; IMAGE_UNIONS] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_GSPEC; o_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `k:real^N#real->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ASM_REWRITE_TAC[MEASURABLE_BALL] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_GSPEC; o_THM] THEN ASM SET_TAC[]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN TRANS_TAC REAL_LE_TRANS `sum k (\a:real^N#real. (B + e) * measure(ball a))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`))) THEN REWRITE_TAC[FORALL_IN_GSPEC; o_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `u < s + e ==> x <= u ==> x <= s + e`)) THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; MEASURABLE_BALL] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FORALL_PAIR_THM; MEASURABLE_BALL; FINITE_IMAGE] THEN ASM SET_TAC[]);; let MEASURABLE_DIFFERENTIABLE_IMAGE,MEASURE_DIFFERENTIABLE_IMAGE = (CONJ_PAIR o prove) (`(!f:real^N->real^N f' s. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x within s)) /\ (\x. lift(abs(det(matrix(f' x))))) integrable_on s ==> measurable(IMAGE f s)) /\ (!f:real^N->real^N f' s b. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x within s)) /\ (\x. lift(abs(det(matrix(f' x))))) integrable_on s /\ drop(integral s (\x. lift(abs(det(matrix(f' x)))))) <= b ==> measure(IMAGE f s) <= b)`, let lemma = prove (`!f:real^N->real^N f' s. measurable s /\ (!x. x IN s ==> (f has_derivative f'(x)) (at x within s)) /\ (\x. lift(abs(det(matrix(f' x))))) integrable_on s ==> measurable(IMAGE f s) /\ measure(IMAGE f s) <= drop(integral s (\x. lift(abs(det(matrix(f' x))))))`, REPEAT GEN_TAC THEN STRIP_TAC THEN ABBREV_TAC `m = integral s (\x:real^N. lift(abs(det(matrix(f' x):real^N^N))))` THEN SUBGOAL_THEN `measurable(IMAGE (f:real^N->real^N) s) /\ !e. &0 < e ==> measure(IMAGE (f:real^N->real^N) s) <= drop m + e * measure s` MP_TAC THENL [MATCH_MP_TAC(MESON[REAL_LT_01] `(!e. &0 < e ==> P /\ Q e) ==> P /\ (!e. &0 < e ==> Q e)`); MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP MEASURE_POS_LE) THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[REAL_ARITH `(m + e) - f:real = (m - f) + e`] THEN ABBREV_TAC `x = drop m - measure (IMAGE (f:real^N->real^N) s)` THEN DISCH_THEN(MP_TAC o SPEC `--x / &2 / measure(s:real^N->bool)`) THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_RDIV_EQ] THEN REAL_ARITH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ABBREV_TAC `t = \n. {x | x IN s /\ &n * e <= abs(det(matrix(f'(x:real^N)):real^N^N)) /\ abs(det(matrix(f' x))) < (&n + &1) * e}` THEN SUBGOAL_THEN `!n. measurable((t:num->real^N->bool) n)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "t" THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x /\ Q x} = {x | x IN s /\ P x} INTER {x | x IN s /\ Q x}`] THEN MATCH_MP_TAC MEASURABLE_INTER THEN CONJ_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE) THENL [ASM_SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE]; ASM_SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT]] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; real_ge] THEN SIMP_TAC[GSYM drop; LIFT_DROP]; ALL_TAC] THEN SUBGOAL_THEN `s:real^N->bool = UNIONS {t n | n IN (:num)}` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [EXPAND_TAC "t" THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_LT_LDIV_EQ] THEN MP_TAC(ISPEC `abs(det(matrix(f'(x:real^N)):real^N^N)) / e` FLOOR_POS) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; REAL_ABS_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[FLOOR]; ALL_TAC] THEN REWRITE_TAC[IMAGE_UNIONS] THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THEN X_GEN_TAC `n:num` THENL [MATCH_MP_TAC MEASURABLE_BOUNDED_DIFFERENTIABLE_IMAGE THEN MAP_EVERY EXISTS_TAC [`f':real^N->real^N->real^N`; `(&n + &1) * e`] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "t" THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_DERIVATIVE_WITHIN_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `sum(0..n) (\k. ((&k + &1) * e) * measure(t k:real^N->bool))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_BOUNDED_DIFFERENTIABLE_IMAGE THEN EXISTS_TAC `f':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "t" THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_DERIVATIVE_WITHIN_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM REAL_MUL_ASSOC; SUM_ADD_NUMSEG] THEN REWRITE_TAC[REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_LMUL; REAL_LE_LMUL_EQ] THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE_STRONG o lhand o snd) THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN ANTS_TAC THENL [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `k < n <=> k + 1 <= n`] THEN EXPAND_TAC "t" THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD; SET_RULE `DISJOINT {x | P x} {x | Q x} <=> !x. P x /\ Q x ==> F`] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_LT_LDIV_EQ] THEN REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; UNIONS_SUBSET] THEN EXPAND_TAC "t" THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUM_VSUM; o_DEF; LIFT_CMUL] THEN ASM_SIMP_TAC[GSYM INTEGRAL_MEASURE] THEN ASM_SIMP_TAC[GSYM INTEGRAL_CMUL; INTEGRABLE_ON_CONST] THEN TRANS_TAC REAL_LE_TRANS `drop(vsum (0..n) (\k. integral (t k) (\x:real^N. lift(abs(det(matrix(f' x):real^N^N))))))` THEN CONJ_TAC THENL [REWRITE_TAC[DROP_VSUM; o_DEF] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[INTEGRABLE_ON_CONST; DROP_CMUL] THEN REWRITE_TAC[DROP_VEC; LIFT_DROP; REAL_MUL_RID] THEN CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "t" THEN SET_TAC[]] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "t" THEN SET_TAC[]] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[DIMINDEX_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP; REAL_ABS_POS]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop(vsum {t k | k IN 0..n} (\t. integral t (\x:real^N. lift(abs(det(matrix(f' x):real^N^N))))))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE_NONZERO o rand o snd) THEN REWRITE_TAC[FINITE_NUMSEG] THEN ANTS_TAC THENL [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `k < n <=> k + 1 <= n`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `i = j ==> DISJOINT i j ==> i = {}`)) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[INTEGRAL_EMPTY]] THEN EXPAND_TAC "t" THEN REWRITE_TAC[SET_RULE `DISJOINT {x | P x} {x | Q x} <=> !x. P x /\ Q x ==> F`] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (UNIONS {t k | k IN 0..n}) (\x:real^N. lift(abs(det(matrix(f' x):real^N^N)))))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE; FINITE_NUMSEG] THEN CONJ_TAC THENL [X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "t" THEN SET_TAC[]] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[DIMINDEX_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP; REAL_ABS_POS]; REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `k < n <=> k + 1 <= n`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN EXPAND_TAC "t" THEN REWRITE_TAC[SET_RULE `{x | P x} INTER {x | Q x} = {} <=> !x. P x /\ Q x ==> F`] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]; EXPAND_TAC "m" THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP; REAL_ABS_POS; UNIONS_SUBSET] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [EXPAND_TAC "t" THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[DIMINDEX_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP; REAL_ABS_POS]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN EXPAND_TAC "t" THEN SET_TAC[]; MATCH_MP_TAC LEBESGUE_MEASURABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; MEASURABLE_IMP_LEBESGUE_MEASURABLE]]]) in REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; MESON[REAL_LE_REFL; REAL_LE_TRANS] `(!a. x <= a ==> y <= a) <=> y <= x`] THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN STRIP_TAC THEN SUBGOAL_THEN `s = UNIONS {interval[--vec n:real^N,vec n] INTER s | n IN (:num)}` (fun th -> SUBST1_TAC th THEN REWRITE_TAC[IMAGE_UNIONS] THEN REWRITE_TAC[SET_RULE `IMAGE f {g x | x IN s} = {f(g x) | x IN s}`] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN SUBST1_TAC(SYM th)) THENL [REWRITE_TAC[UNIONS_GSPEC] THEN SUBGOAL_THEN `!x:real^N. ?n. x IN interval[--vec n,vec n]` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN X_GEN_TAC `x:real^N` THEN MP_TAC(ISPEC `norm(x:real^N)` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN ASM_MESON_TAC[REAL_ABS_BOUNDS; COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `n:num` THEN SUBGOAL_THEN `UNIONS {IMAGE f (interval[--vec k,vec k] INTER s) | k <= n} = IMAGE (f:real^N->real^N) (interval [--vec n,vec n] INTER s)` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN SUBGOAL_THEN `!x:real^N n. x IN interval[--vec n,vec n] <=> ?k. k <= n /\ x IN interval[--vec k,vec k]` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN REWRITE_TAC[SUBSET_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_LE_NEG2]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `interval[--vec n:real^N,vec n] INTER s`] lemma) THEN ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; MEASURABLE_INTERVAL] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[HAS_DERIVATIVE_WITHIN_SUBSET; INTER_SUBSET; IN_INTER]; ALL_TAC]; MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_REWRITE_TAC[LIFT_DROP; REAL_ABS_POS; INTER_SUBSET]] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_INTER] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV; INTEGRABLE_RESTRICT_UNIV]);; let NEGLIGIBLE_DIFFERENTIABLE_PREIMAGE = prove (`!f:real^M->real^N f' s t. dimindex(:M) = dimindex(:N) /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\ rank(matrix(f' x)) = dimindex(:N)) /\ negligible t ==> negligible {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN ABBREV_TAC `u = \n. {x | x IN s /\ !y. y IN s /\ norm(y - x) < inv(&n + &1) ==> norm(y - x:real^M) <= (&n + &1) * norm(f y - f x:real^N)}` THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN u n /\ (f:real^M->real^N) x IN t} | n IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[LOCALLY_NEGLIGIBLE_ALT] THEN X_GEN_TAC `a:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ABBREV_TAC `v = {x | x IN u n /\ (f:real^M->real^N) x IN t} INTER ball(a,inv(&n + &1) / &2)` THEN EXISTS_TAC `v:real^M->bool` THEN EXPAND_TAC "v" THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN SUBGOAL_THEN `!x y:real^M. x IN v /\ y IN v ==> norm(x - y) <= (&n + &1) * norm(f x - f y:real^N)` ASSUME_TAC THENL [EXPAND_TAC "v" THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER; IN_BALL] THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[NORM_ARITH `dist(a:real^N,x) < e / &2 /\ dist(a,y) < e / &2 ==> norm(x - y) < e`]; ALL_TAC] THEN SUBGOAL_THEN `?g. !x. x IN v ==> g((f:real^M->real^N) x) = x` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM INJECTIVE_ON_LEFT_INVERSE] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; real_div; NORM_0; REAL_MUL_LZERO] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) v INTER t)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN CONJ_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[IN_INTER; IMP_CONJ; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN REPEAT DISCH_TAC THEN EXISTS_TAC `ball((f:real^M->real^N) x,&1)` THEN REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN ASM_MESON_TAC[]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; UNIONS_GSPEC] THEN X_GEN_TAC `x:real^M` THEN SIMP_TAC[] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN STRIP_TAC THEN MP_TAC(ISPEC `\h:real^M. matrix((f':real^M->real^M->real^N) x) ** h` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[GSYM FULL_RANK_INJECTIVE] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; MATRIX_WORKS] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[ETA_AX]] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] LINEAR_INVERTIBLE_BOUNDED_BELOW_POS)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN MP_TAC(SPEC `B:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; NOT_SUC] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `B - inv(&n + &1)`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; NOT_SUC] THEN X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN STRIP_TAC THEN EXISTS_TAC `MAX m n` THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LT_TRANS `inv(&m + &1)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LTE_TRANS `inv(&(MAX m n) + &1)` THEN ASM_SIMP_TAC[]; REWRITE_TAC[REAL_SUB_RDISTRIB] THEN MATCH_MP_TAC(NORM_ARITH `b <= norm(y) /\ d <= c ==> norm(f - f' - y:real^N) <= b - c ==> d <= norm(f - f')`) THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE]] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* A one-way version of change-of-variables not assuming injectivity. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_INTEGRABLE_ON_IMAGE,INTEGRAL_ON_IMAGE_DROP_UBOUND_LE = let lemma = prove (`!a:real. {x | x IN s /\ f x <= a} = UNIONS {{x | x IN s /\ f x = b} |b| b IN IMAGE f s /\ b <= a}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in let version0 = prove (`!f:real^N->real^1 g:real^N->real^N g' s b. lebesgue_measurable s /\ f measurable_on (IMAGE g s) /\ (!x. x IN s ==> &0 <= drop(f(g x))) /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!t. t SUBSET IMAGE g s /\ lebesgue_measurable t ==> lebesgue_measurable {x | x IN s /\ g x IN t}) /\ (\x. abs(det(matrix(g' x))) % f(g x)) integrable_on s /\ drop (integral s (\x. abs(det(matrix (g' x))) % f(g x))) <= b ==> f integrable_on (IMAGE g s) /\ drop(integral (IMAGE g s) f) <= b`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `?h:num->real^N->real^1. (!n x. &0 <= drop(h n x)) /\ (!n x. x IN IMAGE (g:real^N->real^N) s ==> drop(h n x) <= drop(f x)) /\ (!n x. drop(h n x) <= drop(h (SUC n) x)) /\ (!n. (h n) measurable_on (:real^N)) /\ (!n. FINITE(IMAGE (h n) (:real^N))) /\ (!x. x IN IMAGE g s ==> ((\n. h n x) --> f x) sequentially)` STRIP_ASSUME_TAC THENL [MP_TAC(fst(EQ_IMP_RULE(ISPEC `\x. if x IN IMAGE (g:real^N->real^N) s then (f:real^N->real^1) x else vec 0` MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING))) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[MEASURABLE_ON_UNIV] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; REAL_POS] THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!n y. lebesgue_measurable {x:real^N | x IN s /\ g x IN {u | (h:num->real^N->real^1) n u = y}}` MP_TAC THENL [REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ g x IN {x | P x}} = {x | x IN s /\ g x IN {y | y IN IMAGE g s /\ P y}}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_RESTRICT] THEN ONCE_REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED THEN REWRITE_TAC[CLOSED_SING; ETA_AX] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_REWRITE_TAC[LE_REFL; differentiable_on; differentiable] THEN ASM_MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC] THEN SUBGOAL_THEN `!k. (h:num->real^N->real^1) k integrable_on IMAGE (g:real^N->real^N) s /\ drop(integral (IMAGE g s) (h k)) <= drop(integral s (\x. abs(det(matrix(g' x):real^N^N)) % h k (g x)))` MP_TAC THENL [X_GEN_TAC `n:num` THEN ABBREV_TAC `r = IMAGE ((h:num->real^N->real^1) n) (:real^N)` THEN SUBGOAL_THEN `FINITE(r:real^1->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(h:num->real^N->real^1) n = \x. vsum r (\y. drop y % indicator {x | h n x = y} x)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REWRITE_TAC[indicator; COND_RAND; VECTOR_MUL_RZERO; IN_ELIM_THM] THEN REWRITE_TAC[GSYM VSUM_RESTRICT_SET; FUN_EQ_THM] THEN X_GEN_TAC `x:real^N` THEN SUBGOAL_THEN `(h:num->real^N->real^1) n x IN r` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> {y | y IN s /\ a = y} = {a}`] THEN REWRITE_TAC[VSUM_SING] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; REAL_MUL_RID]; ALL_TAC] THEN SUBGOAL_THEN `!y. y IN r ==> (\t. drop y % indicator{x | (h:num->real^N->real^1) n x = y} t) integrable_on (IMAGE (g:real^N->real^N) s) /\ drop(integral (IMAGE g s) (\t. drop y % indicator {x | h n x = y} t)) <= drop(integral s (\t. abs(det(matrix(g' t):real^N^N)) % drop y % (indicator {x | h n x = y} (g t))))` ASSUME_TAC THENL [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN ASM_CASES_TAC `y:real^1 = vec 0` THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; INTEGRABLE_0; INTEGRAL_0; REAL_LE_REFL] THEN ASM_REWRITE_TAC[INTEGRABLE_CMUL_EQ; GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM; ETA_AX] THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN SIMP_TAC[INTEGRAL_CMUL; ETA_AX] THEN REWRITE_TAC[INTEGRABLE_ON_INDICATOR] THEN SIMP_TAC[INTEGRAL_INDICATOR; DROP_CMUL; LIFT_DROP; ETA_AX] THEN REWRITE_TAC[indicator; COND_RAND; VECTOR_MUL_RZERO] THEN REWRITE_TAC[REWRITE_RULE[IN] INTEGRAL_RESTRICT_INTER; NOT_IMP] THEN REWRITE_TAC[SET_RULE `(\x. g x IN {x | h n x = y}) INTER s = {x | x IN s /\ h n (g x) = y}`] THEN REWRITE_TAC[SET_RULE `{x | h n x = y} INTER IMAGE g s = IMAGE g {x | x IN s /\ h n (g x) = y}`] THEN REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL; LIFT_DROP] THEN SUBGOAL_THEN `(\t:real^N. lift(abs(det(matrix(g' t):real^N^N)))) integrable_on {t | t IN s /\ (h:num->real^N->real^1) n (g t) = y}` ASSUME_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = {x | P x} INTER s`] THEN REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_INTER] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. inv(drop y) % abs(det(matrix(g' x):real^N^N)) % (f:real^N->real^1) (g(x:real^N))` THEN ASM_SIMP_TAC[INTEGRABLE_CMUL] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MESON[] `(if p then if q then x else vec 0 else vec 0) = (if p /\ q then x else vec 0)`] THEN REWRITE_TAC[SET_RULE `x IN s /\ x IN t <=> x IN (s INTER t)`] THEN REWRITE_TAC[MEASURABLE_ON_UNIV] THEN MATCH_MP_TAC MEASURABLE_ON_LIFT_ABS THEN MATCH_MP_TAC MEASURABLE_ON_DET_JACOBIAN THEN EXISTS_TAC `g:real^N->real^N` THEN ASM_REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[SUBSET_RESTRICT]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 <= drop y` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DROP_CMUL; NORM_0; REAL_LE_MUL; REAL_ABS_POS; REAL_LE_INV_EQ] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN SUBGOAL_THEN `&0 < drop y` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]; ASM_SIMP_TAC[REAL_LE_RDIV_EQ]] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_ABS] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM SET_TAC[]]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_DIFFERENTIABLE_IMAGE; ASM_SIMP_TAC[INTEGRAL_CMUL] THEN REWRITE_TAC[DROP_CMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MEASURE_DIFFERENTIABLE_IMAGE] THEN EXISTS_TAC `g':real^N->real^N->real^N` THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[SUBSET_RESTRICT]; ASM_SIMP_TAC[INTEGRABLE_VSUM; INTEGRABLE_CMUL; ETA_AX] THEN REWRITE_TAC[GSYM VSUM_LMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_VSUM o rand o lhand o snd) THEN ASM_SIMP_TAC[INTEGRABLE_CMUL; ETA_AX] THEN DISCH_THEN SUBST1_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_VSUM o rand o rand o snd) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x:real^N. abs(det(matrix(g' x):real^N^N)) % (f:real^N->real^1) (g x)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIFT_ABS THEN MATCH_MP_TAC MEASURABLE_ON_DET_JACOBIAN THEN EXISTS_TAC `g:real^N->real^N` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC MEASURABLE_ON_CMUL THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `y:real^1`]) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[lebesgue_measurable; indicator; IN_ELIM_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_ABS; DROP_CMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[GSYM NORM_MUL] THEN TRANS_TAC REAL_LE_TRANS `drop((h:num->real^N->real^1) n (g(x:real^N)))` THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN REWRITE_TAC[indicator; IN_ELIM_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; NORM_0] THEN REWRITE_TAC[NORM_1; DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN ASM SET_TAC[]]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[DROP_VSUM; o_DEF] THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[]]]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN SUBGOAL_THEN `!n. drop (integral s (\x. abs(det(matrix(g' x):real^N^N)) % (h:num->real^N->real^1) n (g(x:real^N)))) <= b` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[DROP_CMUL; REAL_LE_LMUL; REAL_ABS_POS; FUN_IN_IMAGE] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x:real^N. abs(det(matrix(g' x):real^N^N)) % (f:real^N->real^1) (g x)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIFT_ABS THEN MATCH_MP_TAC MEASURABLE_ON_DET_JACOBIAN THEN EXISTS_TAC `g:real^N->real^N` THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop] THEN X_GEN_TAC `a:real` THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; GSYM LIFT_EQ; LIFT_DROP] THEN MATCH_MP_TAC(MESON[] `(FINITE {f x | x IN s} ==> FINITE {f x | x IN s /\ P x}) /\ FINITE {f x | x IN s} ==> FINITE {f x | x IN s /\ P x}`) THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN SET_TAC[]; ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE drop (IMAGE ((h:num->real^N->real^1) n) (:real^N))` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN SET_TAC[]]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_ABS; DROP_CMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[NORM_1; real_abs; FUN_IN_IMAGE]]; ALL_TAC] THEN MP_TAC(ISPECL [`h:num->real^N->real^1`; `f:real^N->real^1`; `IMAGE (g:real^N->real^N) s`] MONOTONE_CONVERGENCE_INCREASING) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[bounded; FORALL_IN_GSPEC; IN_UNIV; RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[NORM_1; real_abs] THEN ASM_SIMP_TAC[INTEGRAL_DROP_POS] THEN ASM_MESON_TAC[REAL_LE_TRANS]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN EXISTS_TAC `\k. integral (IMAGE (g:real^N->real^N) s) ((h:num->real^N->real^1) k)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[REAL_LE_TRANS]]) in let version1 = prove (`!f:real^N->real^1 g:real^N->real^N g' s b. (!x. x IN s ==> &0 <= drop(f(g x))) /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (\x. abs(det(matrix(g' x))) % f(g x)) integrable_on s /\ drop(integral s (\x. abs(det(matrix (g' x))) % f(g x))) <= b ==> f integrable_on (IMAGE g s) /\ drop(integral (IMAGE g s) f) <= b`, REPEAT GEN_TAC THEN STRIP_TAC THEN ABBREV_TAC `s' = {x:real^N | x IN s /\ ~(abs(det(matrix(g' x):real^N^N)) % (f:real^N->real^1)(g x) = vec 0)}` THEN SUBGOAL_THEN `lebesgue_measurable(s':real^N->bool)` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `(:real^1) DELETE (vec 0)`) THEN SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN EXPAND_TAC "s'" THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `lebesgue_measurable(IMAGE (g:real^N->real^N) s')` ASSUME_TAC THENL [MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_REWRITE_TAC[LE_REFL; differentiable_on; differentiable] THEN X_GEN_TAC `x:real^N` THEN EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN EXISTS_TAC `(g':real^N->real^N->real^N) x` THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[SUBSET_RESTRICT] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^N->real^1) measurable_on (IMAGE (g:real^N->real^N) s')` ASSUME_TAC THENL [ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN] THEN X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `{x | x IN IMAGE g s /\ f x IN t} = IMAGE g {x | x IN s /\ f(g x) IN t}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_REWRITE_TAC[LE_REFL; differentiable_on; differentiable] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN EXISTS_TAC `(g':real^N->real^N->real^N) x` THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(\x:real^N. (f:real^N->real^1)(g x)) measurable_on s'` MP_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_EQ THEN EXISTS_TAC `\x:real^N. inv(abs(det(matrix(g' x):real^N^N))) % abs(det(matrix(g' x):real^N^N)) % (f:real^N->real^1)(g x)` THEN CONJ_TAC THENL [EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_ASSOC] THEN SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; REAL_MUL_LINV] THEN REWRITE_TAC[VECTOR_MUL_LID]; MATCH_MP_TAC MEASURABLE_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIFT_INV THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIFT_ABS THEN MATCH_MP_TAC MEASURABLE_ON_DET_JACOBIAN THEN EXISTS_TAC `g:real^N->real^N` THEN ASM_REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]; MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN EXPAND_TAC "s'" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; NOT_IN_EMPTY] THEN MESON_TAC[]]; FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN EXPAND_TAC "s'" THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MESON_TAC[VECTOR_MUL_EQ_0]]]; GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `t DELETE (vec 0:real^1)`) THEN ASM_SIMP_TAC[OPEN_DELETE; IN_DELETE] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN EXPAND_TAC "s'" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MESON_TAC[VECTOR_MUL_EQ_0]]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^N->real^N`; `g':real^N->real^N->real^N`; `s':real^N->bool`; `b:real`] version0) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]; GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV) [CONJ_SYM] THEN W(MP_TAC o PART_MATCH (lhand o rand) DOUBLE_LEBESGUE_MEASURABLE_ON o snd) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_REWRITE_TAC[LE_REFL; differentiable_on; differentiable] THEN X_GEN_TAC `x:real^N` THEN EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN EXISTS_TAC `(g':real^N->real^N->real^N) x` THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]; X_GEN_TAC `n:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_PREIMAGE THEN EXISTS_TAC `g':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN REWRITE_TAC[REAL_ABS_ZERO] THEN X_GEN_TAC `x:real^N` THEN SIMP_TAC[RANK_EQ_FULL_DET] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]]; ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INTEGRABLE_RESTRICT_UNIV]) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC] THEN REWRITE_TAC[FUN_EQ_THM] THEN EXPAND_TAC "s'" THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[VECTOR_MUL_EQ_0]; EXPAND_TAC "s'" THEN REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN REWRITE_TAC[SET_RULE `IMAGE g {x | x IN s /\ ~(P x) /\ ~(Q(g x))} = IMAGE g {x | x IN s /\ ~P x} INTER {y | ~Q y}`] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_INTER; GSYM INTEGRAL_RESTRICT_INTER] THEN REWRITE_TAC[IN_ELIM_THM; MESON[] `(if ~(x = a) then x else a) = x`] THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_SPIKE_SET; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET] THEN REWRITE_TAC[REAL_ABS_ZERO] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^N->real^N) {x | x IN s /\ det(matrix(g' x):real^N^N) = &0}` THEN (CONJ_TAC THENL [ALL_TAC; SET_TAC[]]) THEN MATCH_MP_TAC BABY_SARD THEN EXISTS_TAC `g':real^N->real^N->real^N` THEN SIMP_TAC[IN_ELIM_THM; LE_REFL; DET_EQ_0_RANK] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]]) in let version2 = prove (`!f:real^N->real^1 g:real^N->real^N g' s. (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s ==> f absolutely_integrable_on (IMAGE g s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. --((f:real^N->real^1) x)`; `g:real^N->real^N`; `g':real^N->real^N->real^N`; `{x | x IN s /\ drop(f((g:real^N->real^N) x)) < &0}`; `drop(integral {x | x IN s /\ drop(f((g:real^N->real^N) x)) < &0} (\x. abs(det(matrix(g' x):real^N^N)) % --(f(g x))))`] version1) THEN MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^N->real^N`; `g':real^N->real^N->real^N`; `{x | x IN s /\ &0 < drop(f((g:real^N->real^N) x))}`; `drop(integral {x | x IN s /\ &0 < drop(f((g:real^N->real^N) x))} (\x. abs(det(matrix(g' x):real^N^N)) % f(g x)))`] version1) THEN REWRITE_TAC[REAL_LE_REFL; SET_RULE `IMAGE g {x | x IN s /\ P(g x)} = {y | y IN IMAGE g s /\ P y}`] THEN REWRITE_TAC[INTEGRABLE_NEG_EQ; ETA_AX] THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE; REAL_NEG_GE0; DROP_NEG] THEN REWRITE_TAC[VECTOR_MUL_RNEG; INTEGRABLE_NEG_EQ] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(\x. abs(det(matrix(g' x))) % f((g:real^N->real^N) x)) integrable_on {x | x IN s /\ &0 < drop(abs(det(matrix(g' x):real^N^N)) % f(g x))}` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[FORALL_1; DIMINDEX_1; real_gt; GSYM drop] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[DROP_VEC; REAL_LT_REFL]; ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `det(matrix(g'(x:real^N)):real^N^N) = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; COND_ID; REAL_ABS_NUM; DROP_CMUL] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; GSYM REAL_ABS_NZ]]; DISCH_THEN(MP_TAC o ISPEC `(\x. vec 0):real^N->real^1` o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND) o CONJUNCT1) THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE; DROP_VEC] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0] THEN MATCH_MP_TAC(TAUT `(q ==> p ==> r) ==> p ==> q ==> r`)] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(\x. abs(det(matrix(g' x))) % f((g:real^N->real^N) x)) integrable_on {x | x IN s /\ drop(abs(det(matrix(g' x):real^N^N)) % f(g x)) < &0}` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET)) THEN REWRITE_TAC[SUBSET_RESTRICT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[FORALL_1; DIMINDEX_1; real_gt; GSYM drop] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[DROP_VEC; REAL_LT_REFL]; ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `det(matrix(g'(x:real^N)):real^N^N) = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; COND_ID; REAL_ABS_NUM] THEN REWRITE_TAC[DROP_CMUL; REAL_ARITH `a * b < &0 <=> &0 < a * --b`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; GSYM REAL_ABS_NZ; REAL_NEG_GT0]]; DISCH_THEN(MP_TAC o ISPEC `(\x. vec 0):real^N->real^1` o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND) o CONJUNCT1) THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE; DROP_VEC] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0; IMP_IMP]] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_UNION) THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(f:real^N->real^1) x = vec 0` THEN ASM_REWRITE_TAC[COND_ID] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DROP_EQ]) THEN REWRITE_TAC[DROP_VEC; REAL_ARITH `~(x = &0) <=> x < &0 \/ &0 < x`] THEN MESON_TAC[]) in let ABSOLUTELY_INTEGRABLE_ON_IMAGE = prove (`!f:real^M->real^N g:real^M->real^M g' s. (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s ==> f absolutely_integrable_on (IMAGE g s)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; LIFT_CMUL; version2]) in let INTEGRAL_ON_IMAGE_DROP_UBOUND_LE = prove (`!f:real^N->real^1 g:real^N->real^N g' s b. (!x. x IN s ==> &0 <= drop(f(g x))) /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (\x. abs(det(matrix(g' x))) % f(g x)) integrable_on s /\ drop(integral s (\x. abs(det(matrix (g' x))) % f(g x))) <= b ==> drop(integral (IMAGE g s) f) <= b`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP version1) THEN SIMP_TAC[]) in ABSOLUTELY_INTEGRABLE_ON_IMAGE,INTEGRAL_ON_IMAGE_DROP_UBOUND_LE;; (* ------------------------------------------------------------------------- *) (* The classic change-of-variables theorem. We have two versions with quite *) (* general hypotheses, the first that the transforming function has a *) (* continuous inverse, the second that the base set is Lebesgue measurable. *) (* I am not sure if one can eliminate both of these hypotheses, but anyway *) (* it's hard to imagine a useful application to a non-measurable set. *) (* ------------------------------------------------------------------------- *) let HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_INVERTIBLE = prove (`!f:real^M->real^N g:real^M->real^M h g' s b. (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!x. x IN s ==> h(g x) = x) /\ h continuous_on IMAGE g s ==> ((\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s /\ integral s (\x. abs(det(matrix(g' x))) % f(g x)) = b <=> f absolutely_integrable_on (IMAGE g s) /\ integral (IMAGE g s) f = b)`, let version0 = prove (`!f:real^N->real^1 g:real^N->real^N h g' h' s t b. (!x. x IN s ==> g(x) IN t /\ h(g x) = x) /\ (!y. y IN t ==> h(y) IN s /\ g(h y) = y) /\ (!y. y IN t ==> &0 <= drop(f y)) /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!y. y IN t ==> (h has_derivative h' y) (at y within t)) /\ (!y. y IN t ==> h' y o g'(h y) = I) ==> (f integrable_on t /\ drop(integral t f) <= b <=> (\x. abs(det(matrix(g' x))) % f(g x)) integrable_on s /\ drop (integral s (\x. abs(det(matrix (g' x))) % f(g x))) <= b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (g:real^N->real^N) s = t /\ IMAGE h t = s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EQ_TAC THEN STRIP_TAC THENL [EXPAND_TAC "s"; EXPAND_TAC "t"] THEN (CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_IMAGE; MATCH_MP_TAC INTEGRAL_ON_IMAGE_DROP_UBOUND_LE]) THENL [EXISTS_TAC `h':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND THEN EXISTS_TAC `(\x. vec 0):real^N->real^1` THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0; DROP_VEC; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_LE_MUL; DROP_CMUL; REAL_ABS_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_EQ)); EXISTS_TAC `h':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL; REAL_ABS_POS] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_EQ)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV)]; EXISTS_TAC `g':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND THEN EXISTS_TAC `(\x. vec 0):real^N->real^1` THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0; DROP_VEC] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; DROP_CMUL]; EXISTS_TAC `g':real^N->real^N->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]] THEN ASM_SIMP_TAC[GSYM DET_MUL; VECTOR_MUL_ASSOC; GSYM REAL_ABS_MUL] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_RCANCEL] THEN DISJ1_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_SIMP_TAC[GSYM MATRIX_COMPOSE] THEN REWRITE_TAC[MATRIX_I; DET_I; REAL_ABS_NUM]) in let version1 = prove (`!f:real^N->real^1 g:real^N->real^N h g' h' s t b. (!x. x IN s ==> g(x) IN t /\ h(g x) = x) /\ (!y. y IN t ==> h(y) IN s /\ g(h y) = y) /\ (!y. y IN t ==> &0 <= drop(f y)) /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!y. y IN t ==> (h has_derivative h' y) (at y within t)) /\ (!y. y IN t ==> h' y o g'(h y) = I) ==> (((\x. abs(det(matrix(g' x))) % f(g x)) has_integral b) s <=> (f has_integral b) t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN SPEC_TAC(`b:real^1`,`b:real^1`) THEN REWRITE_TAC[FORALL_LIFT; GSYM DROP_EQ; LIFT_DROP] THEN REWRITE_TAC[MESON[REAL_LE_TRANS; REAL_LE_ANTISYM] `(!b. P x /\ f x = b <=> Q x /\ g x = b) <=> (!b. P x /\ f x <= b <=> Q x /\ g x <= b)`] THEN GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC version0 THEN MAP_EVERY EXISTS_TAC [`h:real^N->real^N`; `h':real^N->real^N->real^N`] THEN ASM_REWRITE_TAC[]) in let version2 = prove (`!f:real^N->real^1 g:real^N->real^N h g' h' s t b. (!x. x IN s ==> g(x) IN t /\ h(g x) = x) /\ (!y. y IN t ==> h(y) IN s /\ g(h y) = y) /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!y. y IN t ==> (h has_derivative h' y) (at y within t)) /\ (!y. y IN t ==> h' y o g'(h y) = I) ==> ((\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s /\ integral s (\x. abs(det(matrix(g' x))) % f(g x)) = b <=> f absolutely_integrable_on t /\ integral t f = b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (g:real^N->real^N) s = t /\ IMAGE h t = s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^N->real^N`; `h:real^N->real^N`; `g':real^N->real^N->real^N`; `h':real^N->real^N->real^N`; `{x | x IN s /\ &0 < drop(f((g:real^N->real^N) x))}`; `{y:real^N | y IN t /\ &0 < drop(f y)}`] version1) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THENL [EXISTS_TAC `s:real^N->bool`; EXISTS_TAC `t:real^N->bool`] THEN ASM_REWRITE_TAC[differentiable_on; differentiable] THEN ASM SET_TAC[]; REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN(LABEL_TAC "+")] THEN MP_TAC(ISPECL [`\x. --((f:real^N->real^1) x)`; `g:real^N->real^N`; `h:real^N->real^N`; `g':real^N->real^N->real^N`; `h':real^N->real^N->real^N`; `{x | x IN s /\ drop(f((g:real^N->real^N) x)) < &0}`; `{y:real^N | y IN t /\ drop(f y) < &0}`] version1) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN ASM_SIMP_TAC[DROP_NEG; REAL_NEG_GT0; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THENL [EXISTS_TAC `s:real^N->bool`; EXISTS_TAC `t:real^N->bool`] THEN ASM_REWRITE_TAC[differentiable_on; differentiable] THEN ASM SET_TAC[]; REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN(LABEL_TAC "-")] THEN EQ_TAC THEN STRIP_TAC THENL [SUBGOAL_THEN `(\x. abs(det(matrix(g' x):real^N^N)) % f(g x)) absolutely_integrable_on {x | x IN s /\ &0 < drop((f:real^N->real^1)(g x))} /\ (\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on {x:real^N | x IN s /\ drop(f(g x)) < &0}` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THENL [REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[FORALL_1; DIMINDEX_1; real_gt; GSYM drop] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[DROP_VEC; REAL_LT_REFL; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `(a * b < &0 <=> b < &0) <=> (&0 < a * --b <=> &0 < --b)`] THEN MATCH_MP_TAC(CONJUNCT1 REAL_LT_MUL_EQ) THEN REWRITE_TAC[GSYM REAL_ABS_NZ] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^N->real^N) x`) THEN (SUBGOAL_THEN `(g:real^N->real^N) x IN t` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]) THEN DISCH_THEN(MP_TAC o AP_TERM `(det o matrix):(real^N->real^N)->real`) THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_SIMP_TAC[o_THM; MATRIX_COMPOSE; DET_MUL; MATRIX_I; DET_I] THEN CONV_TAC REAL_RING; ALL_TAC] THEN REMOVE_THEN "-" (MP_TAC o SPEC `integral {x | x IN s /\ drop(f((g:real^N->real^N) x)) < &0} (\x:real^N. abs(det(matrix(g' x):real^N^N)) % --f(g x))`) THEN ASM_SIMP_TAC[VECTOR_MUL_RNEG; INTEGRABLE_NEG_EQ; INTEGRAL_NEG; IMP_CONJ; VECTOR_EQ_NEG2; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o ISPEC `(\x. vec 0):real^N->real^1` o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND)) THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE; DROP_VEC] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0; IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN REMOVE_THEN "+" (MP_TAC o SPEC `integral {x | x IN s /\ &0 < drop (f((g:real^N->real^N) x))} (\x:real^N. abs(det(matrix(g' x):real^N^N)) % f(g x))`) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; IMP_CONJ] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o ISPEC `(\x. vec 0):real^N->real^1` o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND)) THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE; DROP_VEC] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0] THEN REPLICATE_TAC 2 (GEN_REWRITE_TAC I [IMP_IMP]) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q ==> p' ==> q' ==> r) <=> p /\ p' ==> q /\ q' ==> r`] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_UNION) THEN REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_UNION; IN_ELIM_THM] THEN REWRITE_TAC[GSYM LEFT_OR_DISTRIB; GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM; REAL_ARITH `&0 < x \/ x < &0 <=> ~(x = &0)`] THEN MESON_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_UNION))) THEN ANTS_TAC THENL [REWRITE_TAC[REAL_LT_ANTISYM; EMPTY_GSPEC; NEGLIGIBLE_EMPTY; SET_RULE `{x | x IN s /\ P x} INTER {x | x IN s /\ Q x} = {x | x IN s /\ P x /\ Q x}`]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o rand o rator o lhand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_LT_ANTISYM; EMPTY_GSPEC; NEGLIGIBLE_EMPTY; SET_RULE `{x | x IN s /\ P x} INTER {x | x IN s /\ Q x} = {x | x IN s /\ P x /\ Q x}`]; DISCH_THEN(SUBST1_TAC o SYM)] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN EXPAND_TAC "b" THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; IN_UNIV; SET_RULE `{x | x IN s /\ P x} UNION {x | x IN s /\ Q x} = {x | x IN s /\ (P x \/ Q x)}`] THEN REWRITE_TAC[REAL_ARITH `&0 < x \/ x < &0 <=> ~(x = &0)`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN MESON_TAC[VECTOR_MUL_EQ_0]]; SUBGOAL_THEN `(f:real^N->real^1) absolutely_integrable_on {y | y IN t /\ &0 < drop(f y)} /\ (f:real^N->real^1) absolutely_integrable_on {y | y IN t /\ drop(f y) < &0}` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_IMP_MEASURABLE o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THENL [REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]; REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[FORALL_1; DIMINDEX_1; real_gt; GSYM drop] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[DROP_VEC; REAL_LT_REFL; DROP_CMUL] THEN REWRITE_TAC[REAL_ARITH `(a * b < &0 <=> b < &0) <=> (&0 < a * --b <=> &0 < --b)`] THEN MATCH_MP_TAC(CONJUNCT1 REAL_LT_MUL_EQ) THEN REWRITE_TAC[GSYM REAL_ABS_NZ] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^N->real^N) x`) THEN (SUBGOAL_THEN `(g:real^N->real^N) x IN t` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]) THEN DISCH_THEN(MP_TAC o AP_TERM `(det o matrix):(real^N->real^N)->real`) THEN RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_SIMP_TAC[o_THM; MATRIX_COMPOSE; DET_MUL; MATRIX_I; DET_I] THEN CONV_TAC REAL_RING; ALL_TAC] THEN REMOVE_THEN "-" (MP_TAC o SPEC `integral {y | y IN t /\ drop(f y) < &0} (\x. --((f:real^N->real^1) x))`) THEN ASM_SIMP_TAC[VECTOR_MUL_RNEG; INTEGRABLE_NEG_EQ; INTEGRAL_NEG; IMP_CONJ; VECTOR_EQ_NEG2; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o ISPEC `(\x. vec 0):real^N->real^1` o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND)) THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE; DROP_VEC] THEN ANTS_TAC THENL [REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0; DROP_CMUL; REAL_ARITH `x * y <= &0 <=> &0 <= x * --y`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL]] THEN REMOVE_THEN "+" (MP_TAC o SPEC `integral {y | y IN t /\ &0 < drop(f y)} (f:real^N->real^1)`) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; IMP_CONJ] THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o ISPEC `(\x. vec 0):real^N->real^1` o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND)) THEN SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE; DROP_VEC; DROP_CMUL; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_ABS_POS] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0] THEN REPLICATE_TAC 2 (GEN_REWRITE_TAC I [IMP_IMP]) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q ==> p' ==> q' ==> r) <=> p /\ p' ==> q /\ q' ==> r`] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_UNION) THEN REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_UNION; IN_ELIM_THM] THEN REWRITE_TAC[GSYM LEFT_OR_DISTRIB; GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM; REAL_ARITH `&0 < x \/ x < &0 <=> ~(x = &0)`] THEN MESON_TAC[VECTOR_MUL_EQ_0]; DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_UNION))) THEN ANTS_TAC THENL [REWRITE_TAC[REAL_LT_ANTISYM; EMPTY_GSPEC; NEGLIGIBLE_EMPTY; SET_RULE `{x | x IN s /\ P x} INTER {x | x IN s /\ Q x} = {x | x IN s /\ P x /\ Q x}`]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o rand o rator o lhand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ANTS_TAC THENL [REWRITE_TAC[REAL_LT_ANTISYM; EMPTY_GSPEC; NEGLIGIBLE_EMPTY; SET_RULE `{x | x IN s /\ P x} INTER {x | x IN s /\ Q x} = {x | x IN s /\ P x /\ Q x}`]; DISCH_THEN(SUBST1_TAC o SYM)] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN EXPAND_TAC "b" THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; IN_UNIV; SET_RULE `{x | x IN s /\ P x} UNION {x | x IN s /\ Q x} = {x | x IN s /\ (P x \/ Q x)}`] THEN REWRITE_TAC[REAL_ARITH `&0 < x \/ x < &0 <=> ~(x = &0)`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN MESON_TAC[VECTOR_MUL_EQ_0]]]) in let version3 = prove (`!f:real^M->real^N g:real^M->real^M h g' h' s t b. (!x. x IN s ==> g(x) IN t /\ h(g x) = x) /\ (!y. y IN t ==> h(y) IN s /\ g(h y) = y) /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!y. y IN t ==> (h has_derivative h' y) (at y within t)) /\ (!y. y IN t ==> h' y o g'(h y) = I) ==> ((\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s /\ integral s (\x. abs(det(matrix(g' x))) % f(g x)) = b <=> f absolutely_integrable_on t /\ integral t f = b)`, REPEAT STRIP_TAC THEN REWRITE_TAC[MESON[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] `f absolutely_integrable_on s /\ integral s f = b <=> f absolutely_integrable_on s /\ (f has_integral b) s`] THEN ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE; HAS_INTEGRAL_COMPONENTWISE] THEN REWRITE_TAC[AND_FORALL_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MESON[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] `f absolutely_integrable_on s /\ (f has_integral b) s <=> f absolutely_integrable_on s /\ integral s f = b`] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; LIFT_CMUL] THEN MP_TAC(ISPEC `\x. (lift((f:real^M->real^N) x$i))` version2) THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`h:real^M->real^M`; `h':real^M->real^M->real^M`] THEN ASM_REWRITE_TAC[]) in let version4 = prove (`!f:real^M->real^N g:real^M->real^M h g' s b. (!x. x IN s ==> (g has_derivative g' x) (at x within s) /\ invertible(matrix(g' x))) /\ (!x. x IN s ==> h(g x) = x) /\ h continuous_on IMAGE g s ==> ((\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s /\ integral s (\x. abs(det(matrix(g' x))) % f(g x)) = b <=> f absolutely_integrable_on (IMAGE g s) /\ integral (IMAGE g s) f = b)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [TAUT `p /\ q <=> ~(p ==> ~q)`] THEN SIMP_TAC[has_derivative; MATRIX_INVERTIBLE] THEN REWRITE_TAC[GSYM has_derivative] THEN REWRITE_TAC[NOT_IMP; RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `h':real^M->real^M->real^M` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC version3 THEN EXISTS_TAC `h:real^M->real^M` THEN EXISTS_TAC `\x:real^M d. (h':real^M->real^M->real^M) (h x) d` THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FUN_IN_IMAGE; ETA_AX] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_WITHIN THEN EXISTS_TAC `(g':real^M->real^M->real^M) x` THEN ASM_MESON_TAC[FUN_IN_IMAGE; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^M`; `h:real^M->real^M`; `g':real^M->real^M->real^M`; `{x | x IN s /\ invertible(matrix((g':real^M->real^M->real^M) x))}`; `b:real^N`] version4) THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[SUBSET_RESTRICT]; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `IMAGE (g:real^M->real^M) s` THEN ASM_SIMP_TAC[] THEN SET_TAC[]]; MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [BINOP_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN AP_THM_TAC THEN AP_TERM_TAC; ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC] THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; INVERTIBLE_DET_NZ] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_MUL_LZERO]; BINOP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ; AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^M->real^M) {x | x IN s /\ ~invertible(matrix(g' x):real^M^M)}` THEN (CONJ_TAC THENL [ALL_TAC; SET_TAC[]]) THEN MATCH_MP_TAC BABY_SARD THEN EXISTS_TAC `g':real^M->real^M->real^M` THEN ASM_SIMP_TAC[LE_REFL; IN_ELIM_THM; GSYM DET_EQ_0_RANK; GSYM DET_EQ_0] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[SUBSET_RESTRICT]]]);; let HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES = prove (`!f:real^M->real^N g:real^M->real^M g' s b. lebesgue_measurable s /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) ==> ((\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s /\ integral s (\x. abs(det(matrix(g' x))) % f(g x)) = b <=> f absolutely_integrable_on (IMAGE g s) /\ integral (IMAGE g s) f = b)`, let lemma = prove (`UNIONS {IMAGE f (g x) | P x} = IMAGE f (UNIONS {g x | P x})`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in let version6 = prove (`!f:real^M->real^N g:real^M->real^M g' s b. compact s /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) ==> ((\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s /\ integral s (\x. abs(det(matrix(g' x))) % f(g x)) = b <=> f absolutely_integrable_on (IMAGE g s) /\ integral (IMAGE g s) f = b)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `h:real^M->real^M`) THEN MATCH_MP_TAC HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_INVERTIBLE THEN EXISTS_TAC `h:real^M->real^M` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN ASM_REWRITE_TAC[differentiable_on; differentiable] THEN ASM_MESON_TAC[]) in let version7 = prove (`!f:real^M->real^N g:real^M->real^M g' u b. COUNTABLE u /\ (!s. s IN u ==> compact s) /\ (!x. x IN UNIONS u ==> (g has_derivative g' x) (at x within UNIONS u)) /\ (!x y. x IN UNIONS u /\ y IN UNIONS u /\ g x = g y ==> x = y) ==> ((\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on (UNIONS u) /\ integral (UNIONS u) (\x. abs(det(matrix(g' x))) % f(g x)) = b <=> f absolutely_integrable_on (IMAGE g (UNIONS u)) /\ integral (IMAGE g (UNIONS u)) f = b)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `u:(real^M->bool)->bool = {}` THENL [ASM_REWRITE_TAC[UNIONS_0; INTEGRAL_EMPTY; ABSOLUTELY_INTEGRABLE_ON_EMPTY; IMAGE_CLAUSES] THEN MESON_TAC[]; MP_TAC(ISPEC `u:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN POP_ASSUM_LIST(K ALL_TAC)] THEN X_GEN_TAC `s:num->real^M->bool` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN REWRITE_TAC[IMAGE_UNIONS; GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[SET_RULE `IMAGE s (:num) = {s n | n IN (:num)}`] THEN EQ_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] INTEGRAL_COUNTABLE_UNIONS_ALT)) THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_COMPACT] THENL [ALL_TAC; ANTS_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_COMPACT; LE_REFL] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `UNIONS(IMAGE s (:num)):real^M->bool` THEN REWRITE_TAC[differentiable_on; differentiable] THEN ASM SET_TAC[]; ALL_TAC]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN (SUBGOAL_THEN `(!n. (f:real^M->real^N) absolutely_integrable_on UNIONS {IMAGE (g:real^M->real^M)(s m) | m IN 0..n} <=> (\x. abs(det(matrix(g' x):real^M^M)) % f(g x)) absolutely_integrable_on UNIONS {s m | m IN 0..n}) /\ (!n. integral (UNIONS {IMAGE (g:real^M->real^M)(s m) | m IN 0..n}) f = integral (UNIONS {s m | m IN 0..n}) (\x. abs(det(matrix(g' x))) % f(g x)))` MP_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] `(p \/ q) /\ (!b. p /\ x = b <=> q /\ y = b) ==> (p <=> q) /\ x = y`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; GEN_TAC] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC version6 THEN ASM_SIMP_TAC[COMPACT_UNIONS; SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE s (:num)):real^M->bool` THEN ASM SET_TAC[]; ALL_TAC]) THENL [DISCH_THEN(MP_TAC o GSYM); ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) (fun th -> REWRITE_TAC[th])) THEN DISCH_TAC THENL [CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\n x. if x IN UNIONS {IMAGE g (s m:real^M->bool) | m IN 0..n} then (f:real^M->real^N) x else vec 0`; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[TRIVIAL_LIMIT_SEQUENTIALLY] (ISPEC `sequentially` LIM_UNIQUE)))) THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC(TAUT `g integrable_on s /\ (f --> integral s g) net ==> (f --> integral s g) net`) THEN MATCH_MP_TAC DOMINATED_CONVERGENCE] THEN REWRITE_TAC[] THEN EXISTS_TAC `\x. if x IN UNIONS {IMAGE g (s m:real^M->bool) | m IN (:num)} then lift(norm((f:real^M->real^N) x)) else vec 0` THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN (REPEAT CONJ_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC; NORM_0; REAL_LE_REFL; NORM_POS_LE]) THEN ASM SET_TAC[]; GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN COND_CASES_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN MESON_TAC[]; MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]]] THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC(MESON[MONOTONE_CONVERGENCE_INCREASING] `!f. (!k. f k integrable_on s) /\ (!k x. x IN s ==> drop (f k x) <= drop (f (SUC k) x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral s (f k) | k IN (:num)} ==> (g:real^M->real^1) integrable_on s`) THEN EXISTS_TAC `\n x. if x IN UNIONS {IMAGE g (s m:real^M->bool) | m IN 0..n} then lift(norm((f:real^M->real^N) x)) else vec 0` THEN REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; INTEGRAL_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC; NORM_0; REAL_LE_REFL; NORM_POS_LE]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG; LE]) THEN ASM SET_TAC[]; GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN COND_CASES_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN MESON_TAC[]; MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]]; ALL_TAC] THEN MP_TAC(GEN `n:num` (ISPECL [`\x. lift(norm((f:real^M->real^N) x))`; `g:real^M->real^M`; `g':real^M->real^M->real^M`; `UNIONS {s m | m IN 0..n}:real^M->bool`; `integral (UNIONS {s m | m IN 0..n}) (\x:real^M. abs(det(matrix(g' x):real^M^M)) % lift(norm((f:real^M->real^N) (g x))))`] version6)) THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_UNIONS; SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN GEN_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE s (:num)):real^M->bool` THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!n. P n <=> Q n) ==> (!n. P n) ==> !n. Q n`)) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q ==> r) ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_ABS] THEN REWRITE_TAC[GSYM NORM_MUL] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET)) THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COMPACT THEN ASM_SIMP_TAC[COMPACT_UNIONS; SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG]; DISCH_TAC THEN REWRITE_TAC[lemma; FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN EXISTS_TAC `drop(integral (UNIONS {s m | m IN (:num)}) (\x:real^M. abs(det(matrix(g' x):real^M^M)) % lift(norm((f:real^M->real^N) (g x)))))` THEN X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_ABS] THEN REWRITE_TAC[GSYM NORM_MUL] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE]; REPEAT GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; NORM_0; NORM_MUL; DROP_CMUL; REAL_ABS_ABS; NORM_LIFT; REAL_ABS_NORM; NORM_POS_LE; REAL_LE_REFL; REAL_LE_MUL; NORM_POS_LE; REAL_ABS_POS]) THEN ASM SET_TAC[]]]); CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\n x. if (x:real^M) IN UNIONS {s m | m IN 0..n} then abs(det(matrix(g' x):real^M^M)) % (f:real^M->real^N) (g x) else vec 0`; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[TRIVIAL_LIMIT_SEQUENTIALLY] (ISPEC `sequentially` LIM_UNIQUE)))) THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC(TAUT `g integrable_on s /\ (f --> integral s g) net ==> (f --> integral s g) net`) THEN MATCH_MP_TAC DOMINATED_CONVERGENCE] THEN REWRITE_TAC[] THEN EXISTS_TAC `\x. if (x:real^M) IN UNIONS {s m | m IN (:num)} then lift(norm(abs(det(matrix(g' x):real^M^M)) % (f:real^M->real^N) (g x))) else vec 0` THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN (REPEAT CONJ_TAC THENL [ALL_TAC; REPEAT GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC; NORM_0; REAL_LE_REFL; NORM_POS_LE]) THEN ASM SET_TAC[]; GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN COND_CASES_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN MESON_TAC[]; MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]]] THEN ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC(MESON[MONOTONE_CONVERGENCE_INCREASING] `!f. (!k. f k integrable_on s) /\ (!k x. x IN s ==> drop (f k x) <= drop (f (SUC k) x)) /\ (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ bounded {integral s (f k) | k IN (:num)} ==> (g:real^M->real^1) integrable_on s`) THEN EXISTS_TAC `\n x. if (x:real^M) IN UNIONS {s m | m IN 0..n} then lift(norm(abs(det(matrix(g' x):real^M^M)) % (f:real^M->real^N) (g x))) else vec 0` THEN REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; INTEGRAL_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC; NORM_0; REAL_LE_REFL; NORM_POS_LE]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG; LE]) THEN ASM SET_TAC[]; GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN COND_CASES_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN MESON_TAC[]; MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[UNIONS_GSPEC; IN_NUMSEG; LE_0; IN_ELIM_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]]; ALL_TAC] THEN MP_TAC(GEN `n:num` (ISPECL [`\x. lift(norm((f:real^M->real^N) x))`; `g:real^M->real^M`; `g':real^M->real^M->real^M`; `UNIONS {s m | m IN 0..n}:real^M->bool`; `integral (IMAGE (g:real^M->real^M) (UNIONS {s m | m IN 0..n})) (\x:real^M. lift(norm((f:real^M->real^N) x)))`] version6)) THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_UNIONS; SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN GEN_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE s (:num)):real^M->bool` THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!n. P n <=> Q n) ==> (!n. Q n) ==> !n. P n`)) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q ==> r) ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET)) THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_UNIONS; SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN REWRITE_TAC[differentiable_on; differentiable] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `(g':real^M->real^M->real^M) x` THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `UNIONS (IMAGE s (:num)):real^M->bool` THEN ASM SET_TAC[]; DISCH_TAC THEN REWRITE_TAC[lemma; FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_ABS] THEN REWRITE_TAC[GSYM NORM_MUL] THEN REWRITE_TAC[REAL_ABS_ABS] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN EXISTS_TAC `drop(integral (IMAGE (g:real^M->real^M) (UNIONS {s m | m IN (:num)})) (\x. lift(norm((f:real^M->real^N) x))))` THEN X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[GSYM lemma] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; NORM_0; NORM_MUL; DROP_CMUL; REAL_ABS_ABS; NORM_LIFT; REAL_ABS_NORM; NORM_POS_LE; REAL_LE_REFL; REAL_LE_MUL; NORM_POS_LE; REAL_ABS_POS]) THEN ASM SET_TAC[]])]) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_ALMOST_FSIGMA) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^M->bool`; `n:real^M->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `(\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on c /\ integral c (\x. abs(det(matrix(g' x):real^M^M)) % f(g x)) = b <=> (f:real^M->real^N) absolutely_integrable_on (IMAGE g c) /\ integral (IMAGE (g:real^M->real^M) c) f = b` MP_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FSIGMA_UNIONS_COMPACT]) THEN REWRITE_TAC[UNION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN MATCH_MP_TAC version7 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [BINOP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ; AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `n:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; BINOP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ; AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^M->real^M) n` THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN ASM_REWRITE_TAC[LE_REFL; differentiable_on; differentiable] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `(g':real^M->real^M->real^M) x` THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM SET_TAC[]]]);; let ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES = prove (`!f:real^M->real^N g:real^M->real^M g' s. lebesgue_measurable s /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) ==> (f absolutely_integrable_on (IMAGE g s) <=> (\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES) THEN MESON_TAC[]);; let INTEGRAL_CHANGE_OF_VARIABLES = prove (`!f:real^M->real^N g:real^M->real^M g' s. lebesgue_measurable s /\ (!x. x IN s ==> (g has_derivative g' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) /\ (f absolutely_integrable_on (IMAGE g s) \/ (\x. abs(det(matrix(g' x))) % f(g x)) absolutely_integrable_on s) ==> integral (IMAGE g s) f = integral s (\x. abs(det(matrix(g' x))) % f(g x))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Change of variable for measure. *) (* ------------------------------------------------------------------------- *) let HAS_MEASURE_DIFFERENTIABLE_IMAGE = prove (`!f:real^N->real^N f' s m. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (IMAGE f s has_measure m <=> ((\x. lift(abs(det(matrix(f' x))))) has_integral (lift m)) s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\x. vec 1):real^N->real^1`; `f:real^N->real^N`; `f':real^N->real^N->real^N`; `s:real^N->bool`; `lift m`] HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID] THEN SIMP_TAC[ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS; LIFT_DROP; REAL_ABS_POS; REAL_POS] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LIFT_NUM; has_measure]);; let MEASURABLE_DIFFERENTIABLE_IMAGE_EQ = prove (`!f:real^N->real^N f' s. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (measurable (IMAGE f s) <=> (\x. lift(abs(det(matrix(f' x))))) integrable_on s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_DIFFERENTIABLE_IMAGE) THEN SIMP_TAC[measurable; integrable_on] THEN REWRITE_TAC[GSYM EXISTS_LIFT]);; let MEASURABLE_DIFFERENTIABLE_IMAGE_ALT = prove (`!f:real^N->real^N f' s. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (measurable (IMAGE f s) <=> (\x. lift(abs(det(matrix(f' x))))) absolutely_integrable_on s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `s:real^N->bool`] MEASURABLE_DIFFERENTIABLE_IMAGE_EQ) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS THEN REWRITE_TAC[LIFT_DROP; REAL_ABS_POS]);; let MEASURE_DIFFERENTIABLE_IMAGE_EQ = prove (`!f:real^N->real^N f' s. lebesgue_measurable s /\ (!x. x IN s ==> (f has_derivative f' x) (at x within s)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (\x. lift(abs(det(matrix(f' x))))) integrable_on s ==> measure (IMAGE f s) = drop(integral s (\x. lift(abs(det(matrix(f' x))))))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; `s:real^N->bool`] MEASURABLE_DIFFERENTIABLE_IMAGE_EQ) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[MEASURE_INTEGRAL] THEN DISCH_THEN(K ALL_TAC) THEN AP_TERM_TAC THEN REWRITE_TAC[LIFT_EQ_CMUL] THEN MATCH_MP_TAC INTEGRAL_CHANGE_OF_VARIABLES THEN ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL] THEN DISJ2_TAC THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS; LIFT_DROP; REAL_ABS_POS]);; (* ------------------------------------------------------------------------- *) (* Change of variables for integrals again: special case of linear function. *) (* ------------------------------------------------------------------------- *) let HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_LINEAR = prove (`!f:real^M->real^N g:real^M->real^M s b. linear g ==> ((\x. abs(det(matrix g)) % f(g x)) absolutely_integrable_on s /\ integral s (\x. abs(det(matrix g)) % f(g x)) = b <=> f absolutely_integrable_on (IMAGE g s) /\ integral (IMAGE g s) f = b)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `det(matrix g:real^M^M) = &0` THENL [ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_MUL_LZERO] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0; INTEGRAL_0] THEN SUBGOAL_THEN `negligible(IMAGE (g:real^M->real^M) s)` ASSUME_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_LINEAR_SINGULAR_IMAGE THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LINEAR_INJECTIVE_LEFT_INVERSE)) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `h:real^M->real^M` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o AP_TERM `(det o matrix):(real^M->real^M)->real`) THEN ASM_SIMP_TAC[o_THM; MATRIX_COMPOSE; DET_MUL; MATRIX_I; DET_I] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_NEGLIGIBLE; INTEGRAL_ON_NEGLIGIBLE]]; MATCH_MP_TAC HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_INVERTIBLE THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DET_EQ_0]) THEN ASM_SIMP_TAC[MATRIX_INVERTIBLE; FUN_EQ_THM; o_THM; I_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^M` THEN STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; HAS_DERIVATIVE_LINEAR]]);; let ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_LINEAR = prove (`!f:real^M->real^N g:real^M->real^M s. linear g ==> ((\x. abs(det(matrix g)) % f(g x)) absolutely_integrable_on s <=> f absolutely_integrable_on (IMAGE g s))`, MESON_TAC[HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_LINEAR]);; let ABSOLUTELY_INTEGRABLE_ON_LINEAR_IMAGE = prove (`!f:real^M->real^N g:real^M->real^M s. linear g ==> (f absolutely_integrable_on (IMAGE g s) <=> (f o g) absolutely_integrable_on s \/ det(matrix g) = &0)`, ASM_SIMP_TAC[GSYM ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_LINEAR] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CMUL_EQ; o_DEF; REAL_ABS_ZERO] THEN CONV_TAC TAUT);; let INTEGRAL_CHANGE_OF_VARIABLES_LINEAR = prove (`!f:real^M->real^N g:real^M->real^M s. linear g /\ (f absolutely_integrable_on (IMAGE g s) \/ (f o g) absolutely_integrable_on s) ==> integral (IMAGE g s) f = abs(det(matrix g)) % integral s (f o g)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^M`; `s:real^M->bool`] ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_LINEAR) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(p \/ q) /\ (p /\ q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN ASM_SIMP_TAC[o_DEF; ABSOLUTELY_INTEGRABLE_CMUL]; DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^M`; `s:real^M->bool`] HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_LINEAR) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ABSOLUTELY_INTEGRABLE_CMUL_EQ] o CONJUNCT1) THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INTEGRAL_0] THEN ASM_SIMP_TAC[INTEGRAL_CMUL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]);; (* ------------------------------------------------------------------------- *) (* Approximation of L_1 functions by bounded continuous ones. *) (* Note that 100/fourier.ml has some generalizations to L_p spaces. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove (`!f:real^M->real^N s e. lebesgue_measurable s /\ f absolutely_integrable_on s /\ &0 < e ==> ?g. g absolutely_integrable_on s /\ g continuous_on (:real^M) /\ bounded (IMAGE g (:real^M)) /\ norm(integral s (\x. lift(norm(f x - g x)))) < e`, let lemma = prove (`!f:real^M->real^N s e. measurable s /\ f absolutely_integrable_on s /\ &0 < e ==> ?g. g absolutely_integrable_on s /\ g continuous_on (:real^M) /\ bounded (IMAGE g (:real^M)) /\ norm(integral s (\x. lift(norm(f x - g x)))) < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?h. h absolutely_integrable_on s /\ bounded (IMAGE h (:real^M)) /\ norm(integral s (\x. lift(norm(f x - h x:real^N)))) < e / &2` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`\n x. lift(norm (f x - (lambda i. max (--(&n)) (min (&n) ((f:real^M->real^N)(x)$i)))))`; `(\x. vec 0):real^M->real^1`; `\x. lift(norm((f:real^M->real^N)(x)))`; `s:real^M->bool`] DOMINATED_CONVERGENCE) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!n. ((\x. lambda i. max (--(&n)) (min (&n) ((f x:real^N)$i))) :real^M->real^N) absolutely_integrable_on s` ASSUME_TAC THENL [GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(\x. lambda i. &n):real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MIN)) THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN DISCH_THEN(MP_TAC o SPEC `(\x. lambda i. --(&n)):real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MAX)) THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SUB]; ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(SPEC `norm((f:real^M->real^N) x)` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[DIST_0; NORM_LIFT; REAL_ABS_NORM; GSYM LIFT_SUB] THEN MATCH_MP_TAC(NORM_ARITH `&0 < d /\ x = y ==> norm(x:real^N - y) < d`) THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= n ==> x = max (--n) (min n x)`) THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_OF_NUM_LE]]; DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[INTEGRAL_0; DIST_0; LE_REFL] THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. max (--(&n)) (min (&n) ((f:real^M->real^N)(x)$i))):real^M->real^N` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[BOUNDED_COMPONENTWISE] THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `&n` THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[NORM_LIFT; LAMBDA_BETA] THEN REAL_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?k g. negligible k /\ (!n. g n continuous_on (:real^M)) /\ (!n x. norm(g n x:real^N) <= norm(B % vec 1:real^N)) /\ (!x. x IN (s DIFF k) ==> ((\n. g n x) --> h x) sequentially)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `(h:real^M->real^N) measurable_on s` MP_TAC THENL [ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE]; ALL_TAC] THEN REWRITE_TAC[measurable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\n x. lambda i. max (--B) (min B (((g n x):real^N)$i))): num->real^M->real^N` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN MP_TAC(ISPECL [`(:real^M)`; `(lambda i. B):real^N`] CONTINUOUS_ON_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN MP_TAC(ISPECL [`(:real^M)`; `(lambda i. --B):real^N`] CONTINUOUS_ON_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA]; REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `ee:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(c - a:real^N) <= norm(b - a) ==> dist(b,a) < ee ==> dist(c,a) < ee`) THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!n. (g:num->real^M->real^N) n absolutely_integrable_on s` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `(\x. lift(norm(B % vec 1:real^N))):real^M->real^1` THEN ASM_REWRITE_TAC[LIFT_DROP; INTEGRABLE_ON_CONST] THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN MATCH_MP_TAC(REWRITE_RULE[lebesgue_measurable; indicator] MEASURABLE_ON_RESTRICT) THEN ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN ASM_REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE]; ALL_TAC] THEN MP_TAC(ISPECL [`\n x. lift(norm((g:num->real^M->real^N) n x - h x))`; `(\x. vec 0):real^M->real^1`; `(\x. lift(B + norm(B % vec 1:real^N))):real^M->real^1`; `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN ASM_SIMP_TAC[INTEGRAL_0; INTEGRABLE_ON_CONST; MEASURABLE_DIFF; NEGLIGIBLE_IMP_MEASURABLE] THEN ANTS_TAC THENL [REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; REPEAT STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC(NORM_ARITH `norm(g:real^N) <= b /\ norm(h) <= a ==> norm(g - h) <= a + b`) THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[GSYM LIM_NULL_NORM; GSYM LIM_NULL]]; REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; DIST_0] THEN DISCH_TAC THEN EXISTS_TAC `(g:num->real^M->real^N) n` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(integral s (\x. lift(norm(f x - h x)))) + norm(integral s (\x. lift(norm ((g:num->real^M->real^N) n x - h x))))` THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= norm(y + z:real^N) ==> norm(x) <= norm(y) + norm(z)`) THEN W(MP_TAC o PART_MATCH (lhs o rand) (GSYM INTEGRAL_ADD) o rand o rand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(MESON[] `norm x = drop x /\ norm(a:real^N) <= drop x ==> norm a <= norm x`) THEN CONJ_TAC THENL [MATCH_MP_TAC NORM_1_POS THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN SIMP_TAC[DROP_ADD; LIFT_DROP; NORM_POS_LE; REAL_LE_ADD] THEN MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC; MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[DROP_ADD; LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN REWRITE_TAC[NORM_ARITH `norm(f - g:real^N) <= norm(f - h) + norm(g - h)`] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC]] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB; ETA_AX]; MATCH_MP_TAC(REAL_ARITH `a < e / &2 /\ b < e / &2 ==> a + b < e`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> x = y ==> y < e`)) THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `(!u v. f absolutely_integrable_on (s INTER interval[u,v])) /\ (!u v. (f:real^M->real^N) absolutely_integrable_on (s DIFF interval[u,v]))` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER; LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_UNIV]; ALL_TAC] THEN SUBGOAL_THEN `?a b. norm(integral (s INTER interval[a,b]) (\x. lift(norm(f x))) - integral s (\x. lift(norm((f:real^M->real^N) x)))) < e / &3` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRAL] THEN REWRITE_TAC[HAS_INTEGRAL_ALT; INTEGRAL_RESTRICT_INTER] THEN DISCH_THEN(MP_TAC o SPEC `e / &3` o CONJUNCT2) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL; BOUNDED_BALL]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s INTER interval[a:real^M,b]`; `e / &3`] lemma) THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_INTERVAL; REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?c d. interval[a:real^M,b] SUBSET interval(c,d) /\ measure(interval(c,d)) - measure(interval[a,b]) < e / &3 / B` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `e / &3 / B / &2`] EXPAND_CLOSED_OPEN_INTERVAL) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; REAL_ARITH `&0 < &3`] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> x <= y + e / &2 ==> x - y < e`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &3`]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. if x IN interval[a,b] then (g:real^M->real^N) x else vec 0`; `(:real^M)`; `interval[a,b] UNION ((:real^M) DIFF interval(c,d))`; `B:real`] TIETZE) THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; IN_UNIV] THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LT_IMP_LE; FORALL_IN_UNION] THEN SIMP_TAC[CLOSED_UNION; CLOSED_INTERVAL; GSYM OPEN_CLOSED; OPEN_INTERVAL; IN_DIFF; IN_UNIV] THEN ASM_SIMP_TAC[COND_RAND; NORM_0; COND_RATOR; REAL_LT_IMP_LE; COND_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN SIMP_TAC[CLOSED_INTERVAL; GSYM OPEN_CLOSED; OPEN_INTERVAL] THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N`] THEN REWRITE_TAC[FORALL_IN_UNION; bounded; FORALL_IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_EQ THEN EXISTS_TAC `\x. if x IN s INTER interval(c,d) then (h:real^M->real^N) x else vec 0` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_INTER] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `(\x. lift B):real^M->real^1` THEN ASM_REWRITE_TAC[INTEGRABLE_CONST; LIFT_DROP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_CASES THEN ASM_REWRITE_TAC[SET_RULE `{x | x IN s} = s`; MEASURABLE_ON_0] THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; REWRITE_TAC[INTEGRABLE_ON_OPEN_INTERVAL; INTEGRABLE_CONST]; GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE]]; DISCH_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(!u v. h absolutely_integrable_on (s INTER interval[u,v])) /\ (!u v. (h:real^M->real^N) absolutely_integrable_on (s DIFF interval[u,v]))` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER; LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_UNIV]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `norm(integral (s INTER interval[a,b]) (\x. lift(norm((f:real^M->real^N) x - h x)))) + norm(integral (s DIFF interval[a,b]) (\x. lift(norm(f x - h x))))` THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `a + b:real^N = c ==> norm(c) <= norm(a) + norm(b)`) THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o lhand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[NEGLIGIBLE_EMPTY; SET_RULE `(s INTER t) INTER (s DIFF t) = {} /\ (s INTER t) UNION (s DIFF t) = s`] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `norm(integral s f) < e / &3 ==> integral s f = integral s g /\ y < &2 / &3 * e ==> norm(integral s g) + y < e`)) THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_EQ THEN ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `drop(integral (s DIFF interval[a,b]) (\x. lift(norm((f:real^M->real^N) x)) + lift(norm(h x:real^N))))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB; ABSOLUTELY_INTEGRABLE_ADD; LIFT_DROP; DROP_ADD; NORM_LIFT; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN CONV_TAC NORM_ARITH; ASM_SIMP_TAC[INTEGRAL_ADD; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_NORM; DROP_ADD]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e / &3 ==> z = x /\ y <= e / &3 ==> z + y < &2 / &3 * e`)) THEN CONJ_TAC THENL [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `z + y = x /\ &0 <= y ==> y = abs(z - x)`) THEN ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE; ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[GSYM DROP_ADD; DROP_EQ] THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o lhand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REWRITE_TAC[NEGLIGIBLE_EMPTY; SET_RULE `(s INTER t) INTER (s DIFF t) = {} /\ (s INTER t) UNION (s DIFF t) = s`] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval(c,d) DIFF interval[a,b]) (\x:real^M. lift B))` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; IN_UNIV] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; INTEGRABLE_ON_CONST; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN ASM_CASES_TAC `x IN interval(c:real^M,d)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `x IN interval[a:real^M,b]` THEN ASM_REWRITE_TAC[] THEN REPEAT COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL; LIFT_DROP; NORM_0; REAL_LT_IMP_LE; DROP_VEC] THEN ASM_MESON_TAC[IN_DIFF; IN_UNIV; NORM_0; REAL_LE_REFL]; SIMP_TAC[LIFT_EQ_CMUL; INTEGRAL_CMUL; INTEGRABLE_ON_CONST; MEASURABLE_DIFF; MEASURABLE_INTERVAL; INTEGRAL_MEASURE] THEN REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> y = x ==> y <= e`)) THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM_REWRITE_TAC[MEASURABLE_INTERVAL]]);; (* ------------------------------------------------------------------------- *) (* A kind of continuity of the (absolute) integral under translation. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM = prove (`!f:real^M->real^N. f absolutely_integrable_on (:real^M) ==> ((\a. integral (:real^M) (\x. lift(norm(f(a + x) - f x)))) --> vec 0) (at (vec 0))`, let lemma = prove (`!f:real^M->real^N. lift(norm(f x)) - (if p x then lift(norm(f x)) else vec 0) = lift(norm(f x - (if p x then f x else vec 0)))`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_SUB_REFL] THEN REWRITE_TAC[NORM_0; LIFT_NUM]) in SUBGOAL_THEN `!f:real^M->real^N. f absolutely_integrable_on (:real^M) /\ f continuous_on (:real^M) ==> ((\a. integral (:real^M) (\x. lift(norm(f(a + x) - f x)))) --> vec 0) (at (vec 0))` ASSUME_TAC THENL [REPEAT STRIP_TAC; X_GEN_TAC `f:real^M->real^N` THEN STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `e / &3`] ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `g:real^M->real^N`) THEN ASM_REWRITE_TAC[LIM_AT] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[DIST_0] THEN UNDISCH_THEN `norm(integral(:real^M) (\x. lift(norm(f x - g x:real^N)))) < e / &3` (fun th -> MP_TAC th THEN MP_TAC th) THEN MP_TAC(ISPEC `a:real^M` TRANSLATION_UNIV) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM INTEGRAL_TRANSLATION] THEN MATCH_MP_TAC(NORM_ARITH `norm(w) <= norm(x + y + z) ==> norm(x:real^N) < e / &3 ==> norm(y:real^N) < e / &3 ==> norm(z:real^N) < e / &3 ==> norm(w:real^N) < e`) THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_ADD o funpow 3 rand o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_ADD o funpow 2 rand o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC RAND_CONV [NORM_1] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[IN_UNIV; DROP_ADD; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH]]] THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN REPEAT(MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ADD THEN CONJ_TAC) THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN ASM_REWRITE_TAC[ETA_AX] THEN SUBST1_TAC(SYM(ISPEC `--a:real^M` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`] THEN ASM_REWRITE_TAC[ETA_AX]] THEN REWRITE_TAC[LIM_AT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x. lift(norm((f:real^M->real^N) x))`; `(:real^M)`; `integral (:real^M) (\x. lift(norm((f:real^M->real^N) x)))`] HAS_INTEGRAL_ALT) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL; IN_UNIV; ETA_AX] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `ball(vec 0:real^M,B + &1)` BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^M` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `interval[--(c + vec 1):real^M,c + vec 1]`] COMPACT_UNIFORMLY_CONTINUOUS) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN REWRITE_TAC[uniformly_continuous_on] THEN SUBGOAL_THEN `&0 < content(interval[--(c + vec 1):real^M,c + vec 1])` ASSUME_TAC THENL [REWRITE_TAC[CONTENT_LT_NZ; CONTENT_EQ_0_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `!s. ~(s = {}) /\ s SUBSET t ==> ~(t = {})`) THEN EXISTS_TAC `interval[--c:real^M,c]` THEN REWRITE_TAC[INTERIOR_INTERVAL; SUBSET_INTERVAL] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN REWRITE_TAC[BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `e / &3 / content(interval[--(c + vec 1):real^M,c + vec 1])`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &3`; DIST_0] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `norm(integral(interval[--c,c]) (\x. lift(norm((f:real^M->real^N)(a + x) - f x)))) <= e / &3` MP_TAC THENL [REWRITE_TAC[NORM_1] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> abs x <= a`) THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_POS THEN REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN REWRITE_TAC[drop] THEN TRANS_TAC REAL_LE_TRANS `e / &3 / content (interval [--(c + vec 1),c + vec 1]) * content(interval[--c:real^M,c])` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_COMPONENT_UBOUND THEN REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT] THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN DISCH_TAC THEN REWRITE_TAC[GSYM drop; LIFT_DROP; GSYM dist] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a + x:real^M,x) = norm a`] THEN REWRITE_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; VEC_COMPONENT; GSYM REAL_ABS_BOUNDS] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`a:real^M`; `i:num`] COMPONENT_LE_NORM) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `e / &3 / x * y <= e / &3 <=> (e * y) / x <= e`] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC CONTENT_SUBSET THEN REWRITE_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[IN_UNIV; ETA_AX] THEN MATCH_MP_TAC(NORM_ARITH `norm(y - x:real^M) < &2 * e / &3 ==> norm(x) <= e / &3 ==> norm y < e`) THEN SUBGOAL_THEN `ball(vec 0,B) SUBSET interval[a + --c,a + c] /\ ball(vec 0:real^M,B) SUBSET interval[--c,c]` MP_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[INTERVAL_TRANSLATION; TRANSLATION_SUBSET_GALOIS_RIGHT]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `ball(vec 0:real^M,B + &1)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL_0; FORALL_IN_IMAGE] THEN UNDISCH_TAC `norm(a:real^M) < &1` THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th))) THEN MP_TAC(ISPEC `a:real^M` TRANSLATION_UNIV) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[INTERVAL_TRANSLATION; GSYM INTEGRAL_TRANSLATION; IMP_IMP] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NORM_SUB] THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[IN_UNIV; ETA_AX] THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o funpow 3 lhand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN ASM_REWRITE_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN MP_TAC(ISPEC `\x. lift(norm((f:real^M->real^N) x))` INTEGRABLE_TRANSLATION) THEN ASM_SIMP_TAC[GSYM INTERVAL_TRANSLATION; TRANSLATION_UNIV]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC(NORM_ARITH `norm(z:real^M) <= norm(x + y:real^M) ==> norm x < e / &3 /\ norm y < e / &3 ==> norm z < &2 * e / &3`) THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_ADD o rand o rand o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[NORM_1] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN REWRITE_TAC[GSYM NORM_1] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNIV] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_LIFT; GSYM LIFT_SUB; LIFT_DROP; GSYM LIFT_ADD; VECTOR_SUB_RZERO] THEN CONV_TAC NORM_ARITH]]] THEN REPEAT CONJ_TAC THEN REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN REPEAT(MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC) THEN REPEAT(MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ADD THEN CONJ_TAC) THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN ASM_REWRITE_TAC[TRANSLATION_UNIV; GSYM INTERVAL_TRANSLATION] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; let CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM_GEN = prove (`!f:real^M->real^N s t. f absolutely_integrable_on s /\ lebesgue_measurable t /\ t SUBSET s ==> ((\a. integral t (\x. lift(norm(f(a + x) - f x)))) --> vec 0) (at (vec 0) within {a | IMAGE (\x. a + x) t SUBSET s})`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV]) THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM) THEN MATCH_MP_TAC(MESON[LIM_AT_WITHIN] `((f --> l) (at x within s) ==> (g --> m) (at x within s)) ==> ((f --> l) (at x) ==> (g --> m) (at x within s))`) THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_NULL_COMPARISON) THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_ELIM_THM; DIST_0] THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[IN_UNIV; CONJ_ASSOC] THEN CONJ_TAC THENL [REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[REWRITE_RULE[IN] ABSOLUTELY_INTEGRABLE_RESTRICT_INTER] THEN REWRITE_TAC[SET_RULE `(\x. P x) INTER UNIV = {x | P x}`] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN REPEAT CONJ_TAC THEN REWRITE_TAC[IN_TRANSLATION_GALOIS_ALT; SET_RULE `{x | x IN s} = s`] THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `a + --a + x:real^N = x`] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_TRANSLATION]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[LIFT_DROP] THEN ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_REWRITE_TAC[NORM_0; NORM_POS_LE; NORM_LIFT; REAL_ABS_NORM] THEN REPEAT(COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN REWRITE_TAC[REAL_LE_REFL]]);; let CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN = prove (`!f:real^M->real^N s t. f absolutely_integrable_on s /\ lebesgue_measurable t ==> (\a. integral t (\x. f(a + x))) continuous_on {a | IMAGE (\x. a + x) t SUBSET s}`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON] THEN X_GEN_TAC `a:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN ONCE_REWRITE_TAC[LIM_WITHIN_ZERO] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `IMAGE (\x:real^M. a + x) t`] CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM_GEN) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_TRANSLATION] THEN REWRITE_TAC[GSYM INTEGRAL_TRANSLATION] THEN MATCH_MP_TAC(MESON[LIM_WITHIN_SUBSET] `t SUBSET s /\ ((x --> l) (at a within s) ==> (y --> m) (at a within s)) ==> (x --> l) (at a within s) ==> (y --> m) (at a within t)`) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; GSYM IMAGE_o] THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_ARITH `b - a + a + x:real^N = b + x`]; ALL_TAC] THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV o ABS_CONV) [GSYM LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_NULL_COMPARISON) THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN X_GEN_TAC `b:real^M` THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[VECTOR_ARITH `b + a + x:real^N = (a + b) + x`] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[INTEGRABLE_TRANSLATION] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_TRANSLATION]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL] THEN CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_TRANSLATION]);; let CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION = prove (`!f:real^M->real^N. f absolutely_integrable_on (:real^M) ==> (\a. integral (:real^M) (\x. f(a + x))) continuous_on (:real^M)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `(:real^M)`] CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV; SUBSET_UNIV; UNIV_GSPEC]);; let CONTINUOUS_MEASURE_TRANSLATION_SYMDIFF = prove (`!s:real^N->bool. measurable s ==> ((\a. lift(measure(((IMAGE (\x. a + x) s) DIFF s) UNION (s DIFF IMAGE (\x. a + x) s)))) --> vec 0) (at (vec 0))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM LIM_AT_REFLECT] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SET_RULE `s = s INTER UNIV`]) THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_ON_INDICATOR] THEN REWRITE_TAC[VECTOR_NEG_0] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `a:real^N` THEN ASM_SIMP_TAC[MEASURE_INTEGRAL; MEASURABLE_UNION; MEASURABLE_DIFF; MEASURABLE_TRANSLATION_EQ; LIFT_DROP] THEN GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_REWRITE_TAC[indicator; IN_DIFF; IN_UNION] THEN REWRITE_TAC[IN_TRANSLATION_GALOIS] THEN REWRITE_TAC[VECTOR_ARITH `x - --a:real^N = a + x`] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; NORM_1] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_SUB; DROP_VEC]) THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let CONTINUOUS_MEASURE_TRANSLATION_DIFF = prove (`!s:real^N->bool. measurable s ==> ((\a. lift(measure((IMAGE (\x. a + x) s) DIFF s))) --> vec 0) (at (vec 0))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_MEASURE_TRANSLATION_SYMDIFF) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_NULL_COMPARISON) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `a:real^N` THEN ASM_SIMP_TAC[NORM_LIFT; real_abs; MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_TRANSLATION_EQ] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNION; MEASURABLE_DIFF; MEASURABLE_TRANSLATION_EQ] THEN SET_TAC[]);; let CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_TRANSLATION = prove (`!f:real^N->real^N s k. open s /\ f differentiable_on s /\ compact k ==> (\a. lift(measure(IMAGE f (IMAGE (\x. a + x) k)))) continuous_on {a | IMAGE (\x. a + x) k SUBSET s}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`k:real^N->bool`; `s:real^N->bool`] OPEN_TRANSLATION_SUBSET_PREIMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN MP_TAC(ISPEC `{a:real^N | IMAGE (\x. a + x) k SUBSET s}` OPEN_CONTAINS_CBALL) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `b:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[continuous_at] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `{x + d:real^N | x IN k /\ d IN cball(b,r)}`] ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE) THEN ASM_SIMP_TAC[COMPACT_SUMS; COMPACT_CBALL] THEN SUBGOAL_THEN `{x + d:real^N | x IN k /\ d IN cball (b,r)} SUBSET s` ASSUME_TAC THENL [REWRITE_TAC[FORALL_IN_GSPEC; SUBSET] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real^N`] THEN STRIP_TAC THEN UNDISCH_TAC `cball(b:real^N,r) SUBSET {a | IMAGE (\x. a + x) k SUBSET s}` THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `d:real^N`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[VECTOR_ADD_SYM]; ALL_TAC] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] DIFFERENTIABLE_ON_SUBSET)) THEN ASM_REWRITE_TAC[]; DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `IMAGE (\x:real^N. b + x) k` CONTINUOUS_MEASURE_TRANSLATION_SYMDIFF) THEN ASM_SIMP_TAC[MEASURABLE_COMPACT; COMPACT_TRANSLATION] THEN REWRITE_TAC[LIM_AT; DIST_LIFT; DIST_0; NORM_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min t r:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c - b:real^N`) THEN ASM_REWRITE_TAC[GSYM dist; GSYM DIST_NZ] THEN ASM_CASES_TAC `c:real^N = b` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[VECTOR_ARITH `c - b + b + x:real^N = c + x`] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN FIRST_X_ASSUM(MP_TAC o SPEC (rand(rand(lhand(concl th)))))) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[REAL_ARITH `abs x < d ==> x < d`] THEN ASM_SIMP_TAC[MEASURABLE_UNION; MEASURABLE_DIFF; MEASURABLE_COMPACT; COMPACT_TRANSLATION_EQ] THEN MATCH_MP_TAC(SET_RULE `s UNION t SUBSET u ==> (s DIFF t UNION t DIFF s) SUBSET u`) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ADD_SYM] THEN SUBGOAL_THEN `b IN cball(b:real^N,r) /\ c IN cball(b,r)` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[IN_CBALL; DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN SUBGOAL_THEN `IMAGE (\x. b + x) k SUBSET {x + d:real^N | x IN k /\ d IN cball(b,r)} /\ IMAGE (\x. c + x) k SUBSET {x + d:real^N | x IN k /\ d IN cball(b,r)}` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE; SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `x:real^N` THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `b + x:real^N = x + c <=> b = c`] THEN ASM_REWRITE_TAC[UNWIND_THM1; IN_CBALL; DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC(REAL_ARITH `x <= y + d /\ y <= x + d ==> d < e ==> abs(x - y) < e`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) MEASURE_UNION_LE o rand o snd) THEN (ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]]]) THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `IMAGE (f:real^N->real^N) {x + d | x IN k /\ d IN cball(b,r)}` THEN (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN CONJ_TAC) THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_TRANSLATION; LEBESGUE_MEASURABLE_COMPACT; LEBESGUE_MEASURABLE_UNION; LEBESGUE_MEASURABLE_DIFF] THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_SUMS; COMPACT_CBALL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON]]));; (* ------------------------------------------------------------------------- *) (* A kind of mean-value theorem for integrals w.r.t. arbitrarily small *) (* subintervals, similar to the one in Saint-Raymond's "Local Inversion..." *) (* ------------------------------------------------------------------------- *) let SUBINTERVAL_MEAN_VALUE_THEOREM = prove (`!f:real^N->real^1 a b n. ~(interval[a,b] = {}) /\ ~(n = 0) /\ f absolutely_integrable_on interval[a,b] ==> ?c d. c + inv(&n) % (b - a) = d /\ interval[c,d] SUBSET interval[a,b] /\ measure(interval[a,b]) % integral (interval[c,d]) f = measure(interval[c,d]) % integral (interval[a,b]) f`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < &n /\ ~(&n = &0)` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_EQ]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[UNWIND_THM1]] THEN ASM_CASES_TAC `content(interval[a:real^N,b]) = &0` THENL [EXISTS_TAC `a:real^N` THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTENT_0_SUBSET)) THEN ASM_SIMP_TAC[INTEGRAL_NULL; VECTOR_MUL_RZERO]; ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT; REAL_LE_REFL; REAL_LE_ADDR; REAL_LE_MUL_EQ; REAL_LT_INV_EQ] THEN REWRITE_TAC[REAL_SUB_LE; REAL_ARITH `a + n * (b - a) <= b <=> &0 <= (&1 - n) * (b - a)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_SIMP_TAC[LE_1; REAL_OF_NUM_LE]]; RULE_ASSUM_TAC(REWRITE_RULE[CONTENT_POS_LT_EQ; GSYM CONTENT_LT_NZ])] THEN SUBGOAL_THEN `!c. measure(interval[c:real^N,c + inv(&n) % (b - a)]) = measure(interval[a,b]) / &n pow dimindex(:N)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; REAL_ADD_SUB] THEN REWRITE_TAC[REAL_ARITH `c <= c + inv x * y <=> &0 <= y / x`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_MUL_LZERO; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[REAL_SUB_LE; PRODUCT_MUL_NUMSEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN SIMP_TAC[PRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1; REAL_POW_INV] THEN REWRITE_TAC[REAL_MUL_AC]; REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC; VECTOR_MUL_LCANCEL] THEN REWRITE_TAC[LEFT_OR_DISTRIB; EXISTS_OR_THM] THEN DISJ2_TAC] THEN MATCH_MP_TAC(SET_RULE `(!a b. segment[a,b] SUBSET {x | P x} ==> segment [f a,f b] SUBSET IMAGE f (segment [a,b])) /\ (!a b. a IN {x | P x} /\ b IN {x | P x} ==> segment[a,b] SUBSET {x | P x}) /\ (?a b. P a /\ P b /\ c IN segment[f a,f b]) ==> ?x. P x /\ f x = c`) THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC SUBSET_CONTINUOUS_IMAGE_SEGMENT_1 THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET)) THEN ONCE_REWRITE_TAC[MESON[VECTOR_ADD_RID] `interval[c:real^N,c + d] = interval[c + vec 0,c + d]`] THEN REWRITE_TAC[INTERVAL_TRANSLATION; GSYM INTEGRAL_TRANSLATION] THEN MATCH_MP_TAC CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL]; REWRITE_TAC[GSYM CONVEX_CONTAINS_SEGMENT] THEN ONCE_REWRITE_TAC[MESON[VECTOR_ADD_RID] `interval[c:real^N,c + d] = interval[c + vec 0,c + d]`] THEN REWRITE_TAC[INTERVAL_TRANSLATION] THEN MATCH_MP_TAC CONVEX_TRANSLATION_SUBSET_PREIMAGE THEN REWRITE_TAC[CONVEX_INTERVAL]; MATCH_MP_TAC(MESON[INTERVAL_SUBSET_SEGMENT_1; SUBSET] `(?c d. P c /\ P d /\ x IN interval[(f:real^N->real^1) c,f d]) ==> ?c d. P c /\ P d /\ x IN segment[f c,f d]`) THEN REWRITE_TAC[IN_INTERVAL_1; MESON[] `(?a b. P a /\ P b /\ Q a /\ R b) <=> (?c. P c /\ Q c) /\ (?d. P d /\ R d)`] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`f:real^N->real^1`,`f:real^N->real^1`) THEN MATCH_MP_TAC(MESON[] `!g. (!f. P f ==> P(g f)) /\ (!f c. P f ==> R (g f) c ==> Q f c) /\ (!f. P f ==> ?d. R f d) ==> !f. P f ==> (?c. Q f c) /\ (?d. R f d)`) THEN EXISTS_TAC `\f:real^N->real^1. \x. --(f x)` THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_NEG_EQ] THEN CONJ_TAC THENL [SIMP_TAC[INTEGRAL_NEG; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_RNEG; DROP_NEG] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `x = --y ==> --f <= x ==> y <= f`) THEN REWRITE_TAC[GSYM DROP_NEG] THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_NEG THEN ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; X_GEN_TAC `f:real^N->real^1` THEN STRIP_TAC]] THEN MP_TAC(ISPECL [`f:real^N->real^1`; `{interval[(lambda i. a$i + &((m:num^N)$i) / &n * (b$i - a$i)):real^N, lambda i. (a:real^N)$i + &(m$i + 1) / &n * ((b:real^N)$i - a$i)] |m| !i. 1 <= i /\ i <= dimindex(:N) ==> m$i < n}`; `interval[a:real^N,b]`] INTEGRAL_COMBINE_DIVISION_TOPDOWN) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC(TAUT `p /\ (p /\ q ==> r) ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN REWRITE_TAC[division_of; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM; EXISTS_IN_GSPEC; SET_RULE `UNIONS f = s <=> (!t. t IN f ==> t SUBSET s) /\ (!x. x IN s ==> ?t. t IN f /\ x IN t)`] THEN REWRITE_TAC[IMP_IMP] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p ==> r) /\ p /\ q /\ s`] THEN CONJ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `m:num^N` THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN CONJ_TAC THENL [SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_LE_ADDR; REAL_ARITH `a + x * (b - a) <= b <=> &0 <= (&1 - x) * (b - a)`] THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN ASM_SIMP_TAC[ARITH_RULE `m < n ==> m + 1 <= n`]; SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA; REAL_LE_LADD] THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LE] THEN ARITH_TAC]; GEN_REWRITE_TAC BINDER_CONV [RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC(MESON[] `(!x y. ~(x = y) ==> R x y) ==> !x y. P x /\ P y /\ ~(f x = f y) ==> R x y`) THEN REWRITE_TAC[DISJOINT_INTERVAL; INTERIOR_INTERVAL] THEN REWRITE_TAC[MESON[] `(?i. P i /\ Q i /\ R i) <=> ~(!i. P i /\ Q i ==> ~R i)`] THEN SIMP_TAC[LAMBDA_BETA; REAL_LE_LADD] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CART_EQ; NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN DISJ2_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(m:num = n) ==> m + 1 <= n \/ n + 1 <= m`)) THEN MATCH_MP_TAC MONO_OR THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LE]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N)$i = (b:real^N)$i` THENL [EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[EXP_EQ_0; ARITH_EQ; ARITH_RULE `~(n = 0) ==> n - 1 < n /\ n - 1 + 1 = n`] THEN ASM_SIMP_TAC[REAL_DIV_REFL] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `a + x * (b - a) <= b <=> &0 <= (&1 - x) * (b - a)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(a:real^N)$i < (b:real^N)$i` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `&n * ((x:real^N)$i - (a:real^N)$i) / ((b:real^N)$i - a$i)` FLOOR_POS) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_SUB_LE; REAL_LT_IMP_LE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN REWRITE_TAC[REAL_NOT_LE; GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[FLOOR; REAL_LT_IMP_LE] `floor x = n ==> n <= x /\ x <= n + &1`)) THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM REAL_LE_LDIV_EQ); ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM REAL_LE_RDIV_EQ)] THEN UNDISCH_TAC `(a:real^N)$i < (b:real^N)$i` THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC]]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_OF_FINITE) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `FINITE s ==> ~(s = {}) ==> FINITE s /\ ~(s = {})`)) THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `{f x | P x} = {} <=> !n. ~(P n)`] THEN REWRITE_TAC[NOT_FORALL_THM; GSYM LAMBDA_SKOLEM] THEN ASM_MESON_TAC[LE_1]; STRIP_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `drop`) THEN REWRITE_TAC[DROP_VSUM; o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a = b ==> ~(b < a)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] SUM_BOUND_LT_GEN)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN DISCH_THEN(X_CHOOSE_THEN `m:num^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_INJ o rand o rand o lhand o lhand o snd) THEN SIMP_TAC[CARD_CART; FINITE_NUMSEG_LT; CARD_NUMSEG_LT; FINITE_CART] THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM; EQ_INTERVAL; INTERVAL_EQ_EMPTY; CART_EQ] THEN REWRITE_TAC[MESON[] `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN SIMP_TAC[LAMBDA_BETA; REAL_EQ_ADD_LCANCEL; REAL_LT_LADD] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_SUB_LT; REAL_LT_DIV2_EQ] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `~(x + &1 < x)`] THEN ASM_REWRITE_TAC[real_div; REAL_EQ_MUL_RCANCEL] THEN ASM_SIMP_TAC[REAL_SUB_0; REAL_LT_IMP_NZ; REAL_INV_EQ_0] THEN ASM_SIMP_TAC[REAL_EQ_ADD_RCANCEL; REAL_OF_NUM_EQ; REAL_LT_IMP_NE]; DISCH_THEN SUBST1_TAC] THEN SIMP_TAC[NPRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `x / y:real = inv y * x`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW; REAL_INV_POW; GSYM DROP_CMUL] THEN MATCH_MP_TAC(MESON[] `p u = v /\ interval[u,v] SUBSET s ==> a <= drop(integral (interval[u,v]) f) ==> ?d. interval[d,p d] SUBSET s /\ a <= drop(integral(interval[d,p d]) f)`) THEN CONJ_TAC THENL [SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; FIRST_ASSUM(MP_TAC o last o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `UNIONS s = a ==> !i. i IN s ==> i SUBSET a`)) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; let SUBINTERVAL_MEAN_VALUE_THEOREM_SEQ = prove (`!f:real^N->real^1 a b. ~(interval[a,b] = {}) /\ f absolutely_integrable_on interval[a,b] ==> ?c d. (!n. ?m. ~(m = 0) /\ c n + inv(&m) % (b - a) = d n) /\ (!n. ~(interval[c n,d n] = {})) /\ ((\n. d n - c n) --> vec 0) sequentially /\ (!n. interval[c n,d n] SUBSET interval[a,b]) /\ (!n. interval[c(SUC n),d(SUC n)] SUBSET interval[c n,d n]) /\ (!n. measure(interval[a,b]) % integral (interval[c n,d n]) f = measure(interval[c n,d n]) % integral (interval[a,b]) f)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?p. ((!n. ?m. ~(m = 0) /\ FST(p n) + inv(&m) % (b - a) = SND(p n)) /\ (!n. dist(FST(p n),SND(p n)) < inv(&n + &1)) /\ (!n. interval[FST(p n),SND(p n)] SUBSET interval[a,b]) /\ (!n. measure(interval[a,b]) % integral (interval[FST(p n),SND(p n)]) f = measure(interval[FST(p n),SND(p n)]) % integral (interval[a,b]) (f:real^N->real^1))) /\ (!n. interval[FST(p(SUC n)),SND(p(SUC n))] SUBSET interval[FST(p n),SND(p n)])` MP_TAC THENL [GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o TOP_DEPTH_CONV) [AND_FORALL_THM] THEN MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[EXISTS_PAIR_THM; FORALL_PAIR_THM]; REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:num->real^N#real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `FST o (p:num->real^N#real^N)` THEN EXISTS_TAC `SND o (p:num->real^N#real^N)` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o LAND_CONV) [GSYM PAIR] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN PURE_REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (fun th -> PURE_REWRITE_TAC[GSYM th])) THEN UNDISCH_TAC `~(interval[a:real^N,b] = {})` THEN PURE_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; VECTOR_SUB_COMPONENT; REAL_SUB_LE]; MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&n + &1)` THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; EVENTUALLY_TRUE] THEN REWRITE_TAC[SEQ_HARMONIC_OFFSET]]] THEN CONJ_TAC THENL [MP_TAC(ISPEC `dist(a:real^N,b) + &1` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NORM_ARITH `~(dist(p:real^N,q) + &1 <= &0)`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `b:real^N`; `n:num`] SUBINTERVAL_MEAN_VALUE_THEOREM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; CONV_TAC REAL_RAT_REDUCE_CONV] THEN EXPAND_TAC "d" THEN REWRITE_TAC[NORM_ARITH `dist(c:real^N,c + x) = norm x`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] NORM_MUL] THEN ASM_SIMP_TAC[REAL_ABS_INV; REAL_ABS_NUM; REAL_LT_LDIV_EQ; GSYM real_div; REAL_OF_NUM_LT; LE_1; REAL_MUL_LID] THEN UNDISCH_TAC `dist(a:real^N,b) + &1 <= &n` THEN CONV_TAC NORM_ARITH; MAP_EVERY X_GEN_TAC [`k:num`; `c:real^N`; `d:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `dist(c:real^N,d) * &(k + 2) + &1` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THENL [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> ~(x + &1 <= &0)`) THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; DIST_POS_LE]; DISCH_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^1`; `c:real^N`; `d:real^N`; `n:num`] SUBINTERVAL_MEAN_VALUE_THEOREM) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL]] THEN UNDISCH_TAC `~(interval[a:real^N,b] = {})` THEN EXPAND_TAC "d" THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; VECTOR_SUB_COMPONENT; REAL_SUB_LE]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MAP_EVERY EXPAND_TAC ["v"; "d"] THEN REWRITE_TAC[VECTOR_ADD_SUB] THEN EXISTS_TAC `m * n:num` THEN ASM_REWRITE_TAC[MULT_EQ_0; VECTOR_MUL_ASSOC] THEN REWRITE_TAC[REAL_OF_NUM_MUL; GSYM REAL_INV_MUL] THEN REWRITE_TAC[MULT_SYM]; EXPAND_TAC "v" THEN REWRITE_TAC[NORM_ARITH `dist(u:real^N,u + v) = norm v`] THEN REWRITE_TAC[REAL_OF_NUM_SUC; REAL_OF_NUM_ADD] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] NORM_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM; GSYM real_div] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 2`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[SUBSET_TRANS]; REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM DROP_EQ])) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL] THEN MATCH_MP_TAC(REAL_RING `((m0 = &0 ==> i0 = &0) /\ (m1 = &0 ==> i1 = &0) /\ (m2 = &0 ==> i2 = &0)) /\ ((m0 = &0 ==> m1 = &0) /\ (m1 = &0 ==> m2 = &0)) ==> m0 * i1 = m1 * i0 ==> m1 * i2 = m2 * i1 ==> m0 * i2 = m2 * i0`) THEN REWRITE_TAC[MESON[LIFT_DROP; LIFT_NUM] `drop x = &0 <=> x = vec 0`] THEN SIMP_TAC[MEASURE_INTERVAL; INTEGRAL_NULL] THEN ASM_MESON_TAC[CONTENT_0_SUBSET; SUBSET_TRANS]]]);; let SUBINTERVAL_MEAN_VALUE_THEOREM_ALT = prove (`!f:real^N->real^1 a b. ~(interval[a,b] = {}) /\ f absolutely_integrable_on interval[a,b] ==> ?x. x IN interval[a,b] /\ !e. &0 < e ==> ?c d n. ~(n = 0) /\ c + inv(&n) % (b - a) = d /\ x IN interval[c,d] /\ interval[c,d] SUBSET interval[a,b] /\ diameter(interval[c,d]) < e /\ measure(interval[a,b]) % integral (interval[c,d]) f = measure(interval[c,d]) % integral (interval[a,b]) f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `b:real^N`] SUBINTERVAL_MEAN_VALUE_THEOREM_SEQ) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:num->real^N`; `d:num->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `\n. interval[(c:num->real^N) n,d n]` COMPACT_NEST) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN ANTS_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_GSPEC; IN_ELIM_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[NORM_ARITH `dist(x - y:real^N,vec 0) = dist(x,y)`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o SPEC `n:num`)) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`(c:num->real^N) n`; `(d:num->real^N) n`; `m:num`] THEN ASM_REWRITE_TAC[DIAMETER_INTERVAL; GSYM dist]);; (* ------------------------------------------------------------------------- *) (* A kind of intermediate value result for a function where all points are *) (* a weak kind of Lebesgue point (inspired by Saint-Raymond's paper). *) (* ------------------------------------------------------------------------- *) let WEAK_LEBESGUE_POINTS_IMP_IVT = prove (`!f:real^N->real^1 a b s. open s /\ connected s /\ ~(interval(a,b) = {}) /\ locally ((absolutely_integrable_on) f) s /\ (!c x. x IN s /\ (!n. ?u v. &0 < u /\ c n = IMAGE (\x. u % x + v) (interval[a,b])) /\ eventually (\n. x IN c n) sequentially /\ ((\n. lift(diameter(c n))) --> vec 0) sequentially ==> ((\n. inv(measure(c n)) % integral (c n) f) --> f x) sequentially) ==> connected(IMAGE f s)`, REPLICATE_TAC 3 GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t <=> s /\ p /\ q /\ r /\ t`] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC(MESON[] `!P. ((!s. P s ==> R s) ==> (!s. Q s ==> R s)) /\ (!s. P s ==> R s) ==> !s. Q s ==> R s`) THEN EXISTS_TAC `\t. (f:real^N->real^1) absolutely_integrable_on t` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `x:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_REFL; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_OPEN_EQ] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `connected_component u (x:real^N)`) THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ASM_SIMP_TAC[OPEN_CONNECTED_COMPONENT] THEN ANTS_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `v:real^N->bool` THEN ASM_SIMP_TAC[OPEN_CONNECTED_COMPONENT; LEBESGUE_MEASURABLE_OPEN] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; DISCH_TAC] THEN EXISTS_TAC `connected_component u (x:real^N)` THEN ASM_SIMP_TAC[OPEN_CONNECTED_COMPONENT] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN GEN_REWRITE_TAC LAND_CONV [GSYM IN] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_IFF_CONNECTED_COMPONENT]) THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s x ==> t x`) THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN MATCH_MP_TAC IMAGE_SUBSET THEN ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET_TRANS]; REPEAT STRIP_TAC] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[CONNECTED_COMPONENT_SYM]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN REWRITE_TAC[FORALL_IN_IMAGE_2] THEN MAP_EVERY X_GEN_TAC [`p:real^N`; `q:real^N`] THEN STRIP_TAC THEN STRIP_TAC THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `interval[(f:real^N->real^1) p,f q]` THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN ASM_CASES_TAC `y = (f:real^N->real^1) p` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `y = (f:real^N->real^1) q` THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `drop(f(p:real^N)) < drop y /\ drop y < drop(f q) /\ drop(f p) < drop(f q)` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `s:real^N->bool` path_connected) THEN ASM_SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED] THEN DISCH_THEN(MP_TAC o SPECL [`p:real^N`; `q:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?d. &0 < d /\ !r:real^N. r IN path_image g ==> ball(r,d) SUBSET s` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `s = (:real^N)` THENL [ASM_MESON_TAC[SUBSET_UNIV; REAL_LT_01]; ALL_TAC] THEN EXISTS_TAC `setdist(path_image g,(:real^N) DIFF s)` THEN ASM_SIMP_TAC[SETDIST_POS_LT; SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED; PATH_IMAGE_NONEMPTY] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_BALL]] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_UNIV; IN_DIFF]; ALL_TAC] THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN ASM_REWRITE_TAC[SUBSET_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_ASSUM(MP_TAC o SPECL [`\n. IMAGE (\x. inv(&n + &1) % x + (p - inv(&n + &1) % a)) (interval[a:real^N,b])`; `p:real^N`]) THEN FIRST_ASSUM(MP_TAC o SPECL [`\n. IMAGE (\x. inv(&n + &1) % x + (q - inv(&n + &1) % a)) (interval[a:real^N,b])`; `q:real^N`]) THEN MATCH_MP_TAC(TAUT `(p /\ r) /\ (p /\ r ==> q /\ s ==> t) ==> (p ==> q) ==> (r ==> s) ==> t`) THEN CONJ_TAC THENL [CONJ_TAC THEN (ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN EXISTS_TAC `inv(&n + &1)` THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN SET_TAC[]; ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; DIAMETER_INTERVAL; REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN REWRITE_TAC[VECTOR_ARITH `c % a + p - c % b:real^N = p + c % (a - b)`] THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_ADD_SUB; REAL_ARITH `p + inv x * (b - a) < p <=> &0 < (a - b) / x`] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_LT; GSYM INTERVAL_EQ_EMPTY] THEN ASM_REWRITE_TAC[EVENTUALLY_TRUE; NORM_MUL; LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_VMUL THEN REWRITE_TAC[REAL_ABS_INV; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN REWRITE_TAC[SEQ_HARMONIC_OFFSET]]); DISCH_THEN(CONJUNCTS_THEN(MP_TAC o last o CONJUNCTS)) THEN GEN_REWRITE_TAC I [IMP_IMP] THEN REWRITE_TAC[tendsto; AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN DISCH_THEN(MP_TAC o SPEC `min (drop(f(q:real^N)) - drop y) (drop y - drop(f p))`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `&0` ARCH_EVENTUALLY_LT) THEN REWRITE_TAC[GSYM EVENTUALLY_AND; IMP_IMP]] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; DIAMETER_INTERVAL; LE_REFL; REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN REWRITE_TAC[VECTOR_ARITH `c % a + p - c % b:real^N = p + c % (a - b)`] THEN REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_ADD_SUB; REAL_ARITH `p + inv x * (b - a) < p <=> &0 < (a - b) / x`] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_LT; GSYM INTERVAL_EQ_EMPTY] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; LT_REFL] THEN ASM_CASES_TAC `0 < n` THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[MESON[VECTOR_ADD_RID] `interval[a:real^N,b] = interval[a + vec 0,b]`] THEN REWRITE_TAC[INTERVAL_TRANSLATION; MEASURE_TRANSLATION] THEN REWRITE_TAC[GSYM INTEGRAL_TRANSLATION; DIST_0; NORM_LIFT; REAL_ABS_NORM] THEN ABBREV_TAC `c:real^N = inv(&n + &1) % (b - a)` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[DIST_1] THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH `abs(z - q) < min (q - y) (y - p) /\ abs(x - p) < min (q - y) (y - p) ==> x < y /\ y < z`)) THEN MP_TAC(ISPECL [`f:real^N->real^1`; `s:real^N->bool`; `interval[vec 0:real^N,c]`] CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `path_image g:real^N->bool` o MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SUBGOAL_THEN `!a:real^N. a IN path_image g ==> interval[a,a + c] SUBSET s` ASSUME_TAC THENL [SUBGOAL_THEN `!a:real^N. interval[a,a + c] SUBSET ball(a,d)` MP_TAC THENL [GEN_TAC; ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[MESON[VECTOR_ADD_RID] `interval[a:real^N,b] = interval[a + vec 0,b]`] THEN REWRITE_TAC[INTERVAL_TRANSLATION; TRANSLATION_SUBSET_GALOIS_LEFT] THEN REWRITE_TAC[GSYM BALL_TRANSLATION; VECTOR_ADD_LINV] THEN REWRITE_TAC[SUBSET; IN_BALL_0] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT] THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `norm(c:real^N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= z /\ z <= c ==> abs z <= abs c`]; REWRITE_TAC[GSYM INTERVAL_TRANSLATION; VECTOR_ADD_RID] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONNECTED_CONTINUOUS_IMAGE)) THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; GSYM IS_INTERVAL_CONNECTED_1] THEN REWRITE_TAC[IS_INTERVAL_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `q:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `measure(interval[vec 0:real^N,c]) % y:real^1`) THEN SUBGOAL_THEN `~(interval(vec 0:real^N,c) = {})` ASSUME_TAC THENL [EXPAND_TAC "c" THEN REWRITE_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_LT_MUL_EQ; REAL_LT_INV_EQ; VECTOR_SUB_COMPONENT; REAL_SUB_LT; REAL_ARITH `&0 < &n + &1`] THEN ASM_REWRITE_TAC[GSYM INTERVAL_NE_EMPTY]; MP_TAC(ISPECL [`vec 0:real^N`; `c:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM_CASES_TAC `interval[vec 0:real^N,c] = {}` THEN ASM_REWRITE_TAC[SUBSET_EMPTY] THEN DISCH_THEN(K ALL_TAC)] THEN SUBGOAL_THEN `&0 < measure(interval[vec 0:real^N,c])` ASSUME_TAC THENL [SIMP_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL] THEN SIMP_TAC[NEGLIGIBLE_CONVEX_INTERIOR; CONVEX_INTERVAL] THEN ASM_REWRITE_TAC[INTERIOR_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] DROP_CMUL] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_SIMP_TAC[GSYM DROP_CMUL; REAL_LT_IMP_LE; IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^N` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[INTEGRAL_TRANSLATION] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `measure i % y:real^N = integral (IMAGE t i) f ==> measure(IMAGE t i) = measure i ==> integral (IMAGE t i) f = measure(IMAGE t i) % y`)) THEN ANTS_TAC THENL [REWRITE_TAC[MEASURE_TRANSLATION]; ALL_TAC] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION; VECTOR_ADD_RID] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^1`; `r:real^N`; `r + c:real^N`] SUBINTERVAL_MEAN_VALUE_THEOREM_ALT) THEN ANTS_TAC THENL [CONJ_TAC THENL [ONCE_REWRITE_TAC[MESON[VECTOR_ADD_RID] `interval[a:real^N,b] = interval[a + vec 0,b]`] THEN ASM_REWRITE_TAC[INTERVAL_TRANSLATION; IMAGE_EQ_EMPTY]; ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET; LEBESGUE_MEASURABLE_INTERVAL]]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `x:real^N` THEN GEN_REWRITE_TAC RAND_CONV [CONJ_SYM] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN `m:num` o SPEC `inv(&m + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &m + &1`] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`u:num->real^N`; `v:num->real^N`; `k:num->num`] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB; VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VECTOR_MUL_LCANCEL] THEN ONCE_REWRITE_TAC[MESON[VECTOR_ADD_RID] `interval[a:real^N,b] = interval[a + vec 0,b]`] THEN ASM_REWRITE_TAC[INTERVAL_TRANSLATION; MEASURE_TRANSLATION] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION; VECTOR_ADD_RID] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; VECTOR_ADD_RID] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\n. interval[(u:num->real^N) n,v n]`; `x:real^N`]) THEN ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `m:num` THEN MAP_EVERY EXISTS_TAC [`inv(&(k(m:num))) * inv(&n + &1)`; `u(m:num) - (inv(&(k(m:num))) * inv(&n + &1)) % a:real^N`] THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LE_1; REAL_ARITH `&0 < &n + &1`] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) [GSYM th]) THEN EXPAND_TAC "c" THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; REAL_ARITH `&0 <= &n + &1`] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[VECTOR_SUB_ADD2] THEN REWRITE_TAC[VECTOR_ARITH `k % b + (u - k % a):real^N = u + k % (b - a)`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC]; MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&n + &1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; EVENTUALLY_TRUE; NORM_LIFT; real_abs; DIAMETER_POS_LE; BOUNDED_INTERVAL] THEN REWRITE_TAC[SEQ_HARMONIC_OFFSET]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ; TRIVIAL_LIMIT_SEQUENTIALLY] (ISPEC `sequentially` LIM_UNIQUE)) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN SIMP_TAC[MEASURABLE_MEASURE_EQ_0; MEASURABLE_INTERVAL] THEN SIMP_TAC[NEGLIGIBLE_CONVEX_INTERIOR; CONVEX_INTERVAL] THEN REWRITE_TAC[INTERIOR_INTERVAL] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) [GSYM th]) THEN ONCE_REWRITE_TAC[MESON[VECTOR_ADD_RID] `interval(a:real^N,b) = interval(a + vec 0,b)`] THEN REWRITE_TAC[INTERVAL_TRANSLATION; IMAGE_EQ_EMPTY] THEN UNDISCH_TAC `~(interval(vec 0:real^N,c) = {})` THEN REWRITE_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LE_1]]);; (* ------------------------------------------------------------------------- *) (* A derivative-free formulation of (absolute) integration by parts. *) (* ------------------------------------------------------------------------- *) let ABSOLUTE_INTEGRATION_BY_PARTS = prove (`!(bop:real^M->real^N->real^P) (f:real^1->real^M) g f' g' a b. bilinear bop /\ drop a <= drop b /\ f' absolutely_integrable_on interval[a,b] /\ g' absolutely_integrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> (f' has_integral f(x)) (interval[a,x])) /\ (!x. x IN interval[a,b] ==> (g' has_integral g(x)) (interval[a,x])) ==> (\x. bop (f x) (g' x)) absolutely_integrable_on interval[a,b] /\ (\x. bop (f' x) (g x)) absolutely_integrable_on interval[a,b] /\ integral (interval[a,b]) (\x. bop (f x) (g' x)) + integral (interval[a,b]) (\x. bop (f' x) (g x)) = bop (f b) (g b) - bop (f a) (g a)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `(f:real^1->real^M) continuous_on interval[a,b] /\ (g:real^1->real^N) continuous_on interval[a,b]` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `\x. integral(interval[a,x]) (f':real^1->real^M)`; EXISTS_TAC `\x. integral(interval[a,x]) (g':real^1->real^N)`] THEN ASM_SIMP_TAC[INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(GEN `n:num` (ISPECL [`g':real^1->real^N`; `interval[a:real^1,b]`; `inv(&n + &1)`] ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS)) THEN MP_TAC(GEN `n:num` (ISPECL [`f':real^1->real^M`; `interval[a:real^1,b]`; `inv(&n + &1)`] ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS)) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL; REAL_LT_INV_EQ] THEN REWRITE_TAC[REAL_ARITH `&0 < &n + &1`; FORALL_AND_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `ff':num->real^1->real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `gg':num->real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(!n. ((ff':num->real^1->real^M) n) continuous_on interval[a,b]) /\ (!n. ((gg':num->real^1->real^N) n) continuous_on interval[a,b])` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`ff = \n x. integral(interval[a,x]) ((ff':num->real^1->real^M) n)`; `gg = \n x. integral(interval[a,x]) ((gg':num->real^1->real^N) n)`] THEN SUBGOAL_THEN `(!n. (ff:num->real^1->real^M) n continuous_on interval[a,b]) /\ (!n. (gg:num->real^1->real^N) n continuous_on interval[a,b])` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MAP_EVERY EXPAND_TAC ["ff"; "gg"] THEN MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^1->real^M) absolutely_integrable_on interval[a,b] /\ (g:real^1->real^N) absolutely_integrable_on interval[a,b] /\ (!n. (ff:num->real^1->real^M) n absolutely_integrable_on interval[a,b]) /\ (!n. (gg:num->real^1->real^N) n absolutely_integrable_on interval[a,b])` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_CONTINUOUS]; ALL_TAC] THEN SUBGOAL_THEN `(!f:real^1->real^M g:real^1->real^N. f absolutely_integrable_on interval[a,b] /\ g continuous_on interval[a,b] ==> (\x. (bop:real^M->real^N->real^P) (f x) (g x)) absolutely_integrable_on interval[a,b]) /\ (!f:real^1->real^M g:real^1->real^N. f continuous_on interval[a,b] /\ g absolutely_integrable_on interval[a,b] ==> (\x. (bop:real^M->real^N->real^P) (f x) (g x)) absolutely_integrable_on interval[a,b])` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THENL [MP_TAC(GEN `g:real^1->real^N` (ISPECL [`\x y. (bop:real^M->real^N->real^P) y x`; `g:real^1->real^N`] ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT)); MP_TAC(GEN `f:real^1->real^M` (ISPECL [`bop:real^M->real^N->real^P`; `f:real^1->real^M`] ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT))] THEN ASM_REWRITE_TAC[BILINEAR_SWAP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET; CLOSED_INTERVAL] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[]; STRIP_TAC] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. (integral (interval [a,b]) (\x. bop (ff n x) (gg' n x)) + integral (interval [a,b]) (\x. bop (ff' n x) (gg n x))) - ((bop:real^M->real^N->real^P) (ff n b) (gg n b) - bop ((ff:num->real^1->real^M) n a) (gg n a))` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[VECTOR_ARITH `(i + j) - b:real^N = vec 0 <=> j = b - i`] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC INTEGRATION_BY_PARTS THEN MAP_EVERY EXISTS_TAC [`(ff:num->real^1->real^M) n`; `(gg':num->real^1->real^N) n`; `{}:real^1->bool`] THEN ASM_REWRITE_TAC[COUNTABLE_EMPTY; DIFF_EMPTY] THEN REWRITE_TAC[VECTOR_ARITH `b - a - (b - a - i):real^N = i`] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN ASM_SIMP_TAC[BILINEAR_CONTINUOUS_ON_COMPOSE; ETA_AX; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`(ff':num->real^1->real^M) n`; `a:real^1`; `b:real^1`; `x:real^1`] INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ANTS_TAC THENL [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; EXPAND_TAC "ff"]; MP_TAC(ISPECL [`(gg':num->real^1->real^N) n`; `a:real^1`; `b:real^1`; `x:real^1`] INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ANTS_TAC THENL [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; EXPAND_TAC "gg"]] THEN REWRITE_TAC[has_vector_derivative; has_derivative] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM(CONJUNCT1 INTERIOR_INTERVAL)]) THEN SIMP_TAC[NETLIMIT_WITHIN_INTERIOR; NETLIMIT_AT; LIM_WITHIN_INTERIOR]] THEN MATCH_MP_TAC LIM_SUB THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_ADD; MATCH_MP_TAC LIM_SUB THEN CONJ_TAC THEN MP_TAC(ISPECL [`sequentially`; `bop:real^M->real^N->real^P`] LIM_BILINEAR) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN (SUBGOAL_THEN `!x. x IN interval[a,b] ==> (f:real^1->real^M) x = integral (interval[a,x]) f' /\ (g:real^1->real^N) x = integral (interval[a,x]) g'` MP_TAC THENL [ASM_MESON_TAC[INTEGRAL_UNIQUE]; ALL_TAC]) THEN ASM_SIMP_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN DISCH_THEN(K ALL_TAC) THEN MAP_EVERY EXPAND_TAC ["ff"; "gg"] THEN REWRITE_TAC[INTEGRAL_REFL; LIM_CONST] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN ASM_SIMP_TAC[GSYM INTEGRAL_SUB; INTEGRABLE_CONTINUOUS; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&n)` THEN REWRITE_TAC[SEQ_HARMONIC] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) ABSOLUTELY_INTEGRABLE_LE o lhand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `abs x < a ==> x <= a`) THEN REWRITE_TAC[GSYM ABS_DROP] THEN TRANS_TAC REAL_LTE_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN UNDISCH_TAC `1 <= n` THEN ARITH_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `M:real` STRIP_ASSUME_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN SUBGOAL_THEN `?B. &0 < B /\ norm (integral(interval[a,b]) (\x:real^1. lift(norm(f' x:real^M)))) <= B /\ norm (integral(interval[a,b]) (\x. lift(norm(g' x:real^N)))) <= B` STRIP_ASSUME_TAC THENL [REWRITE_TAC[NORM_REAL] THEN MESON_TAC[REAL_ARITH `&0 < max (abs a) (abs b) + &1 /\ abs a <= max (abs a) (abs b) + &1 /\ abs b <= max (abs a) (abs b) + &1`]; ALL_TAC] THEN CONJ_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; GSYM INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_CONTINUOUS; ETA_AX] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. &2 * M * B * inv(&n + &1) + M * inv(&n + &1) pow 2` THEN REWRITE_TAC[] THEN (CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[LIFT_ADD; LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_ADD THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC LIM_NULL_CMUL) THEN REWRITE_TAC[SEQ_HARMONIC_OFFSET] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = drop(vec 0) % vec 0`) THEN REWRITE_TAC[REAL_POW_2; LIFT_CMUL] THEN MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; SEQ_HARMONIC_OFFSET]]) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THENL [ONCE_REWRITE_TAC[VECTOR_ARITH `bop a b - bop c d:real^N = (bop a b - bop a d) + (bop a d - bop c d)`]; ONCE_REWRITE_TAC[VECTOR_ARITH `bop a b - bop c d:real^N = (bop a b - bop c b) + (bop c b - bop c d)`]] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_ADD o rand o lhand o snd) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; INTEGRABLE_SUB; ETA_AX] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ARITH `&2 * M * B * e + M * e pow 2 = M * (B + e) * e + M * B * e`] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bilinear]) THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o GEN_ALL o GSYM o MATCH_MP LINEAR_SUB o SPEC_ALL)) THEN SIMP_TAC[] THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `drop(integral(interval[a,b]) (\x. lift(M * (B + inv(&n + &1)) * norm((gg':num->real^1->real^N) n x - g' x))))`; EXISTS_TAC `drop(integral(interval[a,b]) (\x. lift(M * inv(&n + &1) * norm((g':real^1->real^N) x))))`; EXISTS_TAC `drop(integral(interval[a,b]) (\x. lift(M * (B + inv(&n + &1)) * norm((ff':num->real^1->real^M) n x - f' x))))`; EXISTS_TAC `drop(integral(interval[a,b]) (\x. lift(M * inv(&n + &1) * norm((f':real^1->real^M) x))))`] THEN (CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL; REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[LIFT_CMUL] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [INTEGRAL_CMUL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB; ABSOLUTELY_INTEGRABLE_CONTINUOUS; ETA_AX] THEN REWRITE_TAC[DROP_CMUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `inv x * a <= B * inv x <=> inv x * a <= inv x * B`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_POS] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN ASM_SIMP_TAC[GSYM ABS_DROP; REAL_LT_IMP_LE]]) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[LIFT_CMUL] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [VECTOR_MUL_ASSOC; INTEGRABLE_CMUL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB; CONTINUOUS_ON_SUB; ABSOLUTELY_INTEGRABLE_CONTINUOUS; ETA_AX] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `norm((bop:real^M->real^N->real^P) a b) <= M * norm a * norm b /\ M * norm a * norm b <= c ==> norm(bop a b) <= c`) THEN ASM_REWRITE_TAC[DROP_CMUL; LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `a * x <= y * a <=> x * a <= y * a`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[NORM_POS_LE] THENL [MATCH_MP_TAC(NORM_ARITH `!f'. norm(f':real^N) <= B /\ norm(f - f') <= i ==> norm(f) <= B + i`) THEN EXISTS_TAC `(f:real^1->real^M) x` THEN CONJ_TAC THENL [SUBGOAL_THEN `(f:real^1->real^M) x = integral(interval[a,x]) f'` SUBST1_TAC THENL [ASM_MESON_TAC[INTEGRAL_UNIQUE]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) ABSOLUTELY_INTEGRABLE_LE o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[a,b]) (\x. lift(norm((f':real^1->real^M) x))))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL]; MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN ASM_SIMP_TAC[GSYM ABS_DROP; REAL_LT_IMP_LE]]; ALL_TAC]; ALL_TAC; MATCH_MP_TAC(NORM_ARITH `!g'. norm(g':real^N) <= B /\ norm(g - g') <= i ==> norm(g) <= B + i`) THEN EXISTS_TAC `(g:real^1->real^N) x` THEN CONJ_TAC THENL [SUBGOAL_THEN `(g:real^1->real^N) x = integral(interval[a,x]) g'` SUBST1_TAC THENL [ASM_MESON_TAC[INTEGRAL_UNIQUE]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) ABSOLUTELY_INTEGRABLE_LE o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN TRANS_TAC REAL_LE_TRANS `drop(integral (interval[a,b]) (\x. lift(norm((g':real^1->real^N) x))))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL]; MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN ASM_SIMP_TAC[GSYM ABS_DROP; REAL_LT_IMP_LE]]; ALL_TAC]; ALL_TAC] THEN (SUBGOAL_THEN `(f:real^1->real^M) x = integral(interval[a,x]) f' /\ (g:real^1->real^N) x = integral(interval[a,x]) g'` (CONJUNCTS_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[INTEGRAL_UNIQUE]; MAP_EVERY EXPAND_TAC ["ff"; "gg"]]) THEN (W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN ANTS_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL]; DISCH_THEN(SUBST1_TAC o SYM)] THEN W(MP_TAC o PART_MATCH (lhand o rand) ABSOLUTELY_INTEGRABLE_LE o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL; ETA_AX]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)]) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[REAL_LE_TRANS; REAL_LT_IMP_LE] `norm(integral i f) < e ==> drop(integral j f) <= norm(integral i f) ==> drop(integral j f) <= e`) o SPEC `n:num`) THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN MATCH_MP_TAC(REAL_ARITH `a <= x ==> a <= abs x`) THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; GSYM IN_INTERVAL_1; REAL_LE_REFL; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Measurability of inverse function (including sections / selections). *) (* ------------------------------------------------------------------------- *) let DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION_GEN = prove (`!f:real^M->real^N s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t)) ==> (!t. lebesgue_measurable t ==> lebesgue_measurable(IMAGE f (s INTER t)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `t INTER {x | x IN s /\ ~((f:real^M->real^N) x = vec 0)}`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEASURABLE_ON_UNIV]) THEN REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `(:real^N) DELETE vec 0`) THEN SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{vec 0:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]]);; let DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION = prove (`!f:real^M->real^N g s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t)) /\ (!x. x IN s ==> g(f x) = x) ==> !t. lebesgue_measurable t ==> lebesgue_measurable {y | y IN IMAGE f s /\ g y IN t}`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION_GEN) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let LEBESGUE_MEASURABLE_MEASURABLE_IMAGE,MEASURABLE_ON_INVERSE_FUNCTION = (CONJ_PAIR o prove) (`(!f:real^M->real^N s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> lebesgue_measurable(IMAGE f s)) /\ (!f:real^M->real^N g s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t)) /\ (!x. x IN s ==> g(f x) = x) ==> g measurable_on (IMAGE f s))`, REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; AND_FORALL_THM] THEN GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; AND_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `g:real^N->real^M` THEN ONCE_REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> r /\ q`] THEN STRIP_TAC THEN REWRITE_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^N->real^M`; `s:real^M->bool`] DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_OPEN]);; let DOUBLE_LEBESGUE_MEASURABLE_LEFT_INVERSE = prove (`!f:real^M->real^N s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible (IMAGE f t)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ?g. (!x. x IN s ==> g(f x) = x) /\ (!t. lebesgue_measurable t ==> lebesgue_measurable {y | y IN IMAGE f s /\ g y IN t})`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION THEN ASM_REWRITE_TAC[]);; let MEASURABLE_ON_LEFT_INVERSE = prove (`!f:real^M->real^N s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible (IMAGE f t)) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ?g. (!x. x IN s ==> g(f x) = x) /\ g measurable_on IMAGE f s`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_ON_INVERSE_FUNCTION THEN ASM_REWRITE_TAC[]);; let DOUBLE_LEBESGUE_MEASURABLE_RIGHT_INVERSE = prove (`!f:real^M->real^N s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible (IMAGE f t)) ==> ?g. (!y. y IN IMAGE f s ==> g y IN s /\ f(g y) = y) /\ (!t. lebesgue_measurable t ==> lebesgue_measurable {y | y IN IMAGE f s /\ g y IN t})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LEBESGUE_MEASURABLE_DOMAIN_OF_INJECTIVITY) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`] DOUBLE_LEBESGUE_MEASURABLE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; SUBSET_TRANS]; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]);; let MEASURABLE_ON_RIGHT_INVERSE = prove (`!f:real^M->real^N s. f measurable_on s /\ (!t. negligible t /\ t SUBSET s ==> negligible (IMAGE f t)) ==> ?g. (!y. y IN IMAGE f s ==> g y IN s /\ f(g y) = y) /\ g measurable_on IMAGE f s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LEBESGUE_MEASURABLE_DOMAIN_OF_INJECTIVITY) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`] MEASURABLE_ON_LEFT_INVERSE) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; SUBSET_TRANS]; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Egorov's thoerem. *) (* ------------------------------------------------------------------------- *) let EGOROV = prove (`!f:num->real^M->real^N g s t. measurable s /\ negligible t /\ (!n. f n measurable_on s) /\ (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) ==> !d. &0 < d ==> ?k. k SUBSET s /\ measurable k /\ measure k < d /\ !e. &0 < e ==> ?N. !n x. N <= n /\ x IN s DIFF k ==> dist(f n x,g x) < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(g:real^M->real^N) measurable_on s` ASSUME_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN ASM_MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `e = \n m. UNIONS{{x | x IN s /\ dist((f:num->real^M->real^N) k x,g x) >= inv(&m + &1)} | n <= k}` THEN SUBGOAL_THEN `!m n. measurable ((e:num->num->real^M->bool) n m)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "e" THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN SET_TAC[]] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_ARITH `dist(a:real^M,b) >= e <=> ~(dist(vec 0,a - b) < e)`] THEN REWRITE_TAC[GSYM IN_BALL; SET_RULE `~(x IN s) <=> x IN UNIV DIFF s`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED THEN ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_BALL; MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN MATCH_MP_TAC MEASURABLE_ON_SUB THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m. ?k. measure((e:num->num->real^M->bool) k m) < d / &2 pow (m + 2)` MP_TAC THENL [GEN_TAC THEN MP_TAC(ISPEC `\n. (e:num->num->real^M->bool) n m` HAS_MEASURE_NESTED_INTERS) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [GEN_TAC THEN EXPAND_TAC "e" THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN SUBGOAL_THEN `measure (INTERS {(e:num->num->real^M->bool) n m | n IN (:num)}) = &0` SUBST1_TAC THENL [MATCH_MP_TAC MEASURE_EQ_0 THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real^M->bool` THEN ASM_REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "e" THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY; NOT_FORALL_THM; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `inv(&m + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &m + &1`] THEN REWRITE_TAC[DE_MORGAN_THM; real_ge; REAL_NOT_LE] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY; LIFT_NUM; DIST_0; NORM_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `d / &2 pow (m + 2)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:num->num` THEN DISCH_TAC] THEN EXISTS_TAC `UNIONS {(e:num->num->real^M->bool) (k m) m | m IN (:num)}` THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN EXPAND_TAC "e" THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`\m. (e:num->num->real^M->bool) (k m) m`; `d / &2`] MEASURE_COUNTABLE_UNIONS_LE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `n:num`; ASM_MESON_TAC[REAL_ARITH `&0 < d /\ x <= d / &2 ==> x < d`]] THEN TRANS_TAC REAL_LE_TRANS `sum(0..n) (\m. d / &2 pow (m + 2))` THEN ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_POW; REAL_MUL_ASSOC] THEN REWRITE_TAC[SUM_RMUL; SUM_LMUL; SUM_GP; CONJUNCT1 LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> (&1 - x) / (&1 / &2) * &1 / &4 <= &1 / &2`) THEN MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN EXISTS_TAC `(k:num->num) m` THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN EXPAND_TAC "e" THEN REWRITE_TAC[IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; IN_UNIV] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_REWRITE_TAC[REAL_NOT_LE; real_ge] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `i < e ==> m <= i ==> d < m ==> d < e`)) THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* The Lebesgue differentiation theorem. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_DIFFERENTIATION_THEOREM_COMPACT = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> negligible {x | x IN interval[a,b] /\ ~(f differentiable at x)}`, let lemma0 = prove (`k <= y - x ==> &0 < k ==> ?q. rational q /\ k / &3 < q - x /\ k / &3 < y - q`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(x + y) / &2`; `k / &6`] RATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]] THEN ASM_REAL_ARITH_TAC) in let lemma1 = prove (`!f:real^1->real^1 a b. f has_bounded_variation_on interval[a,b] ==> ?t. negligible t /\ !x. x IN interval[a,b] DIFF t ==> ?B. &0 < B /\ eventually (\y. norm(f y - f x) <= B * norm(y - x)) (at x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?t. negligible t /\ !x. x IN interval[a,b] DIFF t /\ (f:real^1->real^1) continuous at x ==> ?B. &0 < B /\ eventually (\y. norm(f y - f x) <= B * norm(y - x)) (at x)` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `t UNION {x | x IN interval[a,b] /\ ~((f:real^1->real^1) continuous at x)}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; SET_RULE `x IN i DIFF (t UNION {x | x IN i /\ ~P x}) <=> x IN i DIFF t /\ P x`] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL]] THEN ABBREV_TAC `t = {x | x IN interval(a,b) /\ (f:real^1->real^1) continuous at x /\ ~(?B. &0 < B /\ eventually (\y. norm(f y - f x) <= B * norm (y - x)) (at x))}` THEN EXISTS_TAC `{a:real^1,b} UNION t` THEN CONJ_TAC THENL [REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY]; EXPAND_TAC "t" THEN REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1; SET_RULE `s DIFF (t UNION u) = s DIFF t DIFF u`] THEN EXPAND_TAC "t" THEN SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_bounded_variation_on]) THEN REWRITE_TAC[has_bounded_setvariation_on] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `!x. x IN t ==> ?u v. u IN interval[a,b] /\ v IN interval[a,b] /\ x IN interval(u,v) /\ (&3 * (abs B + &1) / e) * norm(v - u) <= norm((f:real^1->real^1) u - f v)` MP_TAC THENL [ABBREV_TAC `M = &3 * (abs B + &1) / e` THEN SUBGOAL_THEN `&0 < M` ASSUME_TAC THENL [EXPAND_TAC "M" THEN REWRITE_TAC[REAL_ARITH `&0 < &3 * M <=> &0 < M`] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `&3 * M`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < &3 * M <=> &0 < M`] THEN REWRITE_TAC[EVENTUALLY_AT; NOT_EXISTS_THM] THEN MP_TAC(ISPEC `interval(a:real^1,b)` OPEN_CONTAINS_BALL) THEN REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN ASM_CASES_TAC `y:real^1 = x` THEN ASM_REWRITE_TAC[DIST_REFL; REAL_LT_REFL] THEN STRIP_TAC THEN SUBGOAL_THEN `y IN interval(a:real^1,b)` ASSUME_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN SUBGOAL_THEN `x IN interval[a:real^1,b] /\ y IN interval[a:real^1,b]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]; ALL_TAC] THEN MP_TAC(SPECL [`drop x`; `drop y`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_at]) THEN DISCH_THEN(MP_TAC o SPEC `M * norm(y - x:real^1)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; NORM_POS_LT; VECTOR_SUB_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `d':real` STRIP_ASSUME_TAC) THENL [ABBREV_TAC `u = x - lift(min (norm(y - x)) (min d d') / &2)` THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^1`)) THEN EXPAND_TAC "u" THEN REWRITE_TAC[NORM_ARITH `dist(x:real^1,x - a) = norm a`; NORM_ARITH `dist(x - a:real^1,x) = norm a`] THEN REWRITE_TAC[NORM_LIFT] THEN ASM_REWRITE_TAC[] THEN REPEAT(ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[dist]) THEN ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN MAP_EVERY EXISTS_TAC [`u:real^1`; `y:real^1`] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN EXPAND_TAC "u" THEN REWRITE_TAC[DROP_SUB; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[dist]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `a < norm(y - x:real^N) ==> !b. dist(u,x) < b /\ c <= a - b ==> c <= norm(u - y)`)) THEN EXISTS_TAC `M * norm(y - x:real^1)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `a <= (&3 * M) * y - M * y <=> a <= M * &2 * y`] THEN MATCH_MP_TAC(NORM_ARITH `norm(x - u:real^N) <= norm(y - x) ==> norm(y - u) <= &2 * norm(y - x)`) THEN EXPAND_TAC "u" THEN REWRITE_TAC[NORM_LIFT; VECTOR_ARITH `x - (x - l):real^N = l`] THEN RULE_ASSUM_TAC(REWRITE_RULE[dist]) THEN ASM_REAL_ARITH_TAC; ABBREV_TAC `u = x + lift(min (norm(y - x)) (min d d') / &2)` THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^1`)) THEN EXPAND_TAC "u" THEN REWRITE_TAC[NORM_ARITH `dist(x:real^1,x + a) = norm a`; NORM_ARITH `dist(x + a:real^1,x) = norm a`] THEN REWRITE_TAC[NORM_LIFT] THEN ASM_REWRITE_TAC[] THEN REPEAT(ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[dist]) THEN ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN MAP_EVERY EXISTS_TAC [`y:real^1`; `u:real^1`] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN EXPAND_TAC "u" THEN REWRITE_TAC[DROP_ADD; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[dist]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `a < norm(y - x:real^N) ==> !b. dist(u,x) < b /\ c <= a - b ==> c <= norm(y - u)`)) THEN EXISTS_TAC `M * norm(y - x:real^1)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `a <= (&3 * M) * y - M * y <=> a <= M * &2 * y`] THEN MATCH_MP_TAC(NORM_ARITH `norm(x - u:real^N) <= norm(y - x) ==> norm(u - y) <= &2 * norm(y - x)`) THEN EXPAND_TAC "u" THEN REWRITE_TAC[NORM_LIFT; NORM_NEG; VECTOR_ARITH `x - (x + l):real^N = --l`] THEN RULE_ASSUM_TAC(REWRITE_RULE[dist]) THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^1->real^1`; `v:real^1->real^1`] THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^1. interval(u x:real^1,v x)) t` LINDELOF) THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_INTERVAL] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x /\ R x) <=> ~(!x. Q x /\ P x ==> ~R x)`] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `?p. FINITE p /\ p SUBSET IMAGE (\x:real^1. interval[u x:real^1,v x]) c /\ e < measure(UNIONS p)` MP_TAC THENL [ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x /\ R x) <=> ~(!x. Q x /\ P x ==> ~R x)`] THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN))) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e < x ==> x <= e ==> F`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `UNIONS(IMAGE f c) = u ==> t SUBSET u /\ (!x. x IN c ==> f x SUBSET g x) ==> t SUBSET UNIONS(IMAGE g c)`)) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN ASM SET_TAC[]; REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->bool` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPEC `IMAGE (\x:real^1. interval[u x:real^1,v x]) p` AUSTIN_LEMMA) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `D:(real^1->bool)->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `e < m ==> a < e / &3 ==> a >= m / &3 pow 1 ==> F`)) THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; FINITE_IMAGE]; ALL_TAC] THEN ASM_MESON_TAC[SUBSET; IN_IMAGE; MEASURABLE_INTERVAL]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN SUBGOAL_THEN `e / &3 = (abs B + &1) / (&3 * (abs B + &1) / e)` SUBST1_TAC THENL [UNDISCH_TAC `&0 < e` THEN CONV_TAC REAL_FIELD; ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_ARITH `&0 < &3 * M <=> &0 < M`; REAL_LT_DIV; REAL_ARITH `&0 < abs B + &1`]] THEN MATCH_MP_TAC(REAL_ARITH `x <= b ==> x < abs b + &1`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`D:(real^1->bool)->bool`; `UNIONS D:real^1->bool`]) THEN ANTS_TAC THENL [REWRITE_TAC[division_of; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; FINITE_IMAGE]; ALL_TAC] THEN SIMP_TAC[SET_RULE `s IN t ==> s SUBSET UNIONS t`] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> P(f x)) ==> !x. x IN s ==> P x`)) THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]; MESON_TAC[]] THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `interior s SUBSET s /\ interior t SUBSET t /\ DISJOINT s t ==> interior s INTER interior t = {}`) THEN REWRITE_TAC[INTERIOR_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> f x SUBSET u) ==> UNIONS s SUBSET u`)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTERVAL_1]] THEN REAL_ARITH_TAC]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; FINITE_IMAGE]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> P(f x)) ==> !x. x IN s ==> P x`)) THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTERVAL_1]] THEN STRIP_TAC THEN SUBGOAL_THEN `drop((u:real^1->real^1) x) <= drop(v x)` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `x <= norm(u - v:real^N) ==> a <= x ==> a <= norm(v - u)`)) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(REAL_RING `x:real = y ==> x * c = c * y`) THEN ASM_REWRITE_TAC[MEASURE_INTERVAL_1; NORM_REAL] THEN REWRITE_TAC[GSYM drop; DROP_SUB] THEN ASM_REAL_ARITH_TAC]) in let lemma2 = prove (`!f a b k. f has_bounded_variation_on interval[a,b] /\ drop a < drop b /\ &0 < k ==> negligible {x | x IN interval[a,b] /\ !s. open s /\ x IN s ==> (?u v. u IN interval[a,b] /\ u IN s /\ v IN interval[a,b] /\ v IN s /\ x IN interval(u,v) /\ k <= (drop(f v) - drop(f u)) / (drop v - drop u)) /\ (?u v. u IN interval[a,b] /\ u IN s /\ v IN interval[a,b] /\ v IN s /\ x IN interval(u,v) /\ (drop(f v) - drop(f u)) / (drop v - drop u) <= --k)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(!t. s = t ==> negligible t) ==> negligible s`) THEN X_GEN_TAC `t':real^1->bool` THEN DISCH_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT2 o MATCH_MP HAS_BOUNDED_VARIATION_WORKS_ON_INTERVAL) THEN DISCH_THEN(MP_TAC o SPEC `vector_variation (interval[a,b]) (f:real^1->real^1) - k * e / &3`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_ARITH `v <= v - e <=> ~(&0 < e)`; REAL_ARITH `&0 < x / &3 <=> &0 < x`] THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP; REAL_NOT_LE] THEN X_GEN_TAC `D:(real^1->bool)->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN ABBREV_TAC `t:real^1->bool = t' DIFF UNIONS {frontier i | i IN D}` THEN SUBGOAL_THEN `?c:real^1->bool. t SUBSET c /\ measurable c /\ measure c <= e` MP_TAC THENL [ALL_TAC; DISCH_THEN(X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `c UNION UNIONS {frontier i:real^1->bool | i IN D}` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `negligible(UNIONS {frontier i:real^1->bool | i IN D})` ASSUME_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[FRONTIER_CLOSED_INTERVAL; OPEN_CLOSED_INTERVAL_1] THEN ASM_SIMP_TAC[ENDS_IN_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET; SET_RULE `t SUBSET s ==> s DIFF (s DIFF t) = t`] THEN REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY]; ASM_SIMP_TAC[MEASURABLE_UNION; NEGLIGIBLE_IMP_MEASURABLE] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNION_LE o lhand o snd) THEN RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_EQ_MEASURE_0]) THEN ASM_SIMP_TAC[MEASURABLE_UNION] THEN ASM_REAL_ARITH_TAC]] THEN SUBGOAL_THEN `!x. x IN t ==> ?c d u v. interval[c,d] IN D /\ x IN interval(c,d) /\ u IN interval(c,d) /\ v IN interval(c,d) /\ x IN interval(u,v) /\ (drop(f c) <= drop(f d) ==> drop(f v) - drop(f u) <= --k * (drop v - drop u)) /\ (drop(f d) < drop(f c) ==> k * (drop v - drop u) <= drop(f v) - drop(f u))` MP_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[IN_DIFF] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o last o CONJUNCTS o GEN_REWRITE_RULE I [division_of]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^1` o MATCH_MP (SET_RULE `s = t ==> !x. x IN t ==> x IN s`)) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`c:real^1`; `d:real^1`] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `interval[c:real^1,d]` o MATCH_MP (SET_RULE `~(x IN UNIONS {f y | y IN s}) ==> !a. a IN s ==> ~(x IN f a)`)) THEN ASM_REWRITE_TAC[FRONTIER_CLOSED_INTERVAL; IN_DIFF] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(x:real^1) IN t'` THEN EXPAND_TAC "t'" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `interval(c:real^1,d)`)) THEN ASM_REWRITE_TAC[OPEN_INTERVAL] THEN DISJ_CASES_TAC(SPECL [`drop(f(c:real^1))`; `drop(f(d:real^1))`] REAL_LET_TOTAL) THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(MP_TAC o CONJUNCT2); DISCH_THEN(MP_TAC o CONJUNCT1)] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN TRY(DISCH_TAC THEN ASM_REAL_ARITH_TAC) THEN (SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_SUB_LT; GSYM REAL_LE_RDIV_EQ]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^1->real^1`; `d:real^1->real^1`; `u:real^1->real^1`; `v:real^1->real^1`] THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^1. interval(u x:real^1,v x)) t` LINDELOF) THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_INTERVAL] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x /\ R x) <=> ~(!x. Q x /\ P x ==> ~R x)`] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `?p. FINITE p /\ p SUBSET IMAGE (\x:real^1. interval[u x:real^1,v x]) c /\ e < measure(UNIONS p)` MP_TAC THENL [ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x /\ R x) <=> ~(!x. Q x /\ P x ==> ~R x)`] THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN))) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e < x ==> x <= e ==> F`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `UNIONS(IMAGE f c) = u ==> t SUBSET u /\ (!x. x IN c ==> f x SUBSET g x) ==> t SUBSET UNIONS(IMAGE g c)`)) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN ASM SET_TAC[]; REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->bool` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPEC `IMAGE (\x:real^1. interval[u x:real^1,v x]) p` AUSTIN_LEMMA) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^1->bool)->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `e < m ==> a < e / &3 ==> a >= m / &3 pow 1 ==> F`)) THEN SUBGOAL_THEN `UNIONS d = UNIONS {UNIONS {i:real^1->bool | i IN d /\ i SUBSET j} | j IN D}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN SUBGOAL_THEN `!i:real^1->bool. i IN d ==> ?j. j IN D /\ i SUBSET j` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> P(f x)) ==> !y. y IN s ==> P y`)) THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `interval[(c:real^1->real^1) x,d x]` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `interval((c:real^1->real^1) x,d x)` THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:real^1->bool` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[FINITE_SUBSET; FINITE_IMAGE]; REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> P(f x)) ==> !y. y IN s ==> P y`)) THEN REWRITE_TAC[MEASURABLE_INTERVAL]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [X_GEN_TAC `i:real^1->bool` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURE_POS_LE THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[FINITE_SUBSET; FINITE_IMAGE]; REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> P(f x)) ==> !y. y IN s ==> P y`)) THEN REWRITE_TAC[MEASURABLE_INTERVAL]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `v - e < s ==> v - s < e`)) THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `D:(real^1->bool)->bool`] VECTOR_VARIATION_ON_DIVISION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[GSYM SUM_SUB] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`l:real^1`; `r:real^1`] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN SUBGOAL_THEN `FINITE(d:(real^1->bool)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; FINITE_IMAGE]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN ASM_SIMP_TAC[FINITE_RESTRICT; FORALL_IN_GSPEC] THEN ANTS_TAC THENL [REWRITE_TAC[IMP_CONJ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> P(f x)) ==> !y. y IN s ==> P y`)) THEN REWRITE_TAC[MEASURABLE_INTERVAL]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN ABBREV_TAC `d' = {i | i IN d /\ i SUBSET interval[l:real^1,r]}` THEN SUBGOAL_THEN `FINITE(d':(real^1->bool)->bool)` ASSUME_TAC THENL [EXPAND_TAC "d'" THEN ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN SUBGOAL_THEN `pairwise DISJOINT (d':(real^1->bool)->bool)` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_MONO)) THEN EXPAND_TAC "d'" THEN REWRITE_TAC[SUBSET_RESTRICT]; ALL_TAC] THEN MP_TAC(ISPECL [`d':(real^1->bool)->bool`; `l:real^1`; `r:real^1`] PARTIAL_DIVISION_EXTEND_INTERVAL) THEN ANTS_TAC THENL [EXPAND_TAC "d'" THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[division_of] THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN REWRITE_TAC[FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REPEAT CONJ_TAC THENL [SET_TAC[]; EXPAND_TAC "d'" THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> (!x. x IN t ==> P(f x)) ==> !y. y IN s ==> P y`)) THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT DISCH_TAC THEN EXISTS_TAC `x:real^1` THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM SET_TAC[]; ASM SET_TAC[]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `interior s SUBSET s /\ interior t SUBSET t /\ DISJOINT s t ==> interior s INTER interior t = {}`) THEN REWRITE_TAC[INTERIOR_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_MESON_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `d'':(real^1->bool)->bool` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN REWRITE_TAC[REAL_ARITH `abs(r - l) = if l <= r then r - l else l - r`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [TRANS_TAC REAL_LE_TRANS `sum d'' (\i. abs(drop(f(interval_upperbound i)) - drop(f(interval_lowerbound i))) - (drop((f:real^1->real^1)(interval_upperbound i)) - drop(f(interval_lowerbound i))))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_INCLUDED THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= abs x - x`] THEN EXISTS_TAC `\x:real^1->bool. x` THEN REWRITE_TAC[TAUT `p /\ a = b /\ q <=> a = b /\ p /\ q`] THEN REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(SET_RULE `d' SUBSET d'' /\ (!x. x IN d'' ==> x IN d' ==> P x) ==> !x. x IN d' ==> x IN d'' /\ P x`) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`w:real^1`;`z:real^1`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?x:real^1. x IN p /\ interval[w:real^1,z] = interval[u x,v x]` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[EQ_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^1` (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN SUBST_ALL_TAC))) THEN DISCH_TAC THEN ASM_SIMP_TAC[MEASURE_INTERVAL_1; GSYM INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= k * a /\ x <= --k * a ==> a * k <= abs x - x`) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; GSYM INTERVAL_NE_EMPTY_1; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC(ASSUME `D division_of interval[a:real^1,b]`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o SPECL [`interval[l:real^1,r]`; `interval[(c:real^1->real^1) x,d x]`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[EQ_INTERVAL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC (SET_RULE `!u. u SUBSET t /\ ~(u = {}) ==> ~(t = {})`) THEN EXISTS_TAC `interval((u:real^1->real^1) x,v x)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT1 INTERIOR_INTERVAL)] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; REWRITE_TAC[INTERIOR_INTERVAL; SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]; W(MP_TAC o PART_MATCH (lhand o rand) SUM_SUB o lhand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= x' /\ y = y' ==> x - y <= x' - y'`) THEN CONJ_TAC THENL [MP_TAC(ISPECL [`f:real^1->real^1`; `interval[l:real^1,r]`] HAS_BOUNDED_VARIATION_WORKS) THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_REFL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; ASM_SIMP_TAC[GSYM DROP_SUB; GSYM(REWRITE_RULE[o_DEF] DROP_VSUM)] THEN AP_TERM_TAC THEN MATCH_MP_TAC ADDITIVE_DIVISION_1 THEN ASM_REWRITE_TAC[GSYM INTERVAL_NE_EMPTY_1]]]; TRANS_TAC REAL_LE_TRANS `sum d'' (\i. abs(drop(f(interval_upperbound i)) - drop(f(interval_lowerbound i))) + (drop((f:real^1->real^1)(interval_upperbound i)) - drop(f(interval_lowerbound i))))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_INCLUDED THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= abs x + x`] THEN EXISTS_TAC `\x:real^1->bool. x` THEN REWRITE_TAC[TAUT `p /\ a = b /\ q <=> a = b /\ p /\ q`] THEN REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(SET_RULE `d' SUBSET d'' /\ (!x. x IN d'' ==> x IN d' ==> P x) ==> !x. x IN d' ==> x IN d'' /\ P x`) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`w:real^1`;`z:real^1`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?x:real^1. x IN p /\ interval[w:real^1,z] = interval[u x,v x]` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[EQ_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^1` (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN SUBST_ALL_TAC))) THEN DISCH_TAC THEN ASM_SIMP_TAC[MEASURE_INTERVAL_1; GSYM INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN MATCH_MP_TAC(REAL_ARITH `k * a <= x ==> a * k <= abs x + x`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC(ASSUME `D division_of interval[a:real^1,b]`) THEN REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o SPECL [`interval[l:real^1,r]`; `interval[(c:real^1->real^1) x,d x]`] o el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[EQ_INTERVAL; GSYM REAL_NOT_LE] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC (SET_RULE `!u. u SUBSET t /\ ~(u = {}) ==> ~(t = {})`) THEN EXISTS_TAC `interval((u:real^1->real^1) x,v x)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT1 INTERIOR_INTERVAL)] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; REWRITE_TAC[INTERIOR_INTERVAL; SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]; ASM_SIMP_TAC[SUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `x <= x' /\ y = --y' ==> x + y <= x' - y'`) THEN CONJ_TAC THENL [MP_TAC(ISPECL [`f:real^1->real^1`; `interval[l:real^1,r]`] HAS_BOUNDED_VARIATION_WORKS) THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_REFL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; REWRITE_TAC[REAL_NEG_SUB] THEN ASM_SIMP_TAC[GSYM DROP_SUB; GSYM(REWRITE_RULE[o_DEF] DROP_VSUM)] THEN AP_TERM_TAC THEN MATCH_MP_TAC ADDITIVE_DIVISION_1 THEN ASM_REWRITE_TAC[GSYM INTERVAL_NE_EMPTY_1]]]]) in let lemma3 = prove (`!f a b k. f has_bounded_variation_on interval[a,b] /\ drop a < drop b /\ &0 < k ==> negligible {x | x IN interval[a,b] /\ !n. ?u v. u IN ball(x,inv(&n + &1)) /\ u IN interval[a,b] /\ v IN ball(x,inv(&n + &1)) /\ v IN interval[a,b] /\ ~(u = x) /\ ~(v = x) /\ k <= (drop(f v) - drop(f x)) / (drop v - drop x) /\ (drop(f u) - drop(f x)) / (drop u - drop x) <= --k}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `k / &2` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] lemma2)) THEN ASM_REWRITE_TAC[REAL_HALF] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP NEGLIGIBLE_COUNTABLE o REWRITE_RULE[IS_INTERVAL_INTERVAL] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES)) THEN SUBGOAL_THEN `negligible {a:real^1,b}` MP_TAC THENL [REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ; IMP_IMP] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[TAUT `(p \/ ~q) \/ r <=> ~p /\ q ==> r`] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN X_GEN_TAC `s:real^1->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?n. ball(x:real^1,inv (&n + &1)) SUBSET s INTER interval(a,b)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `s INTER interval(a:real^1,b)` OPEN_CONTAINS_BALL) THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; IN_DIFF; IN_INSERT; IN_INTER; NOT_IN_EMPTY]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN TRANS_TAC SUBSET_TRANS `ball(x:real^1,e)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_BALL THEN TRANS_TAC REAL_LE_TRANS `inv(&n)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [SUBSET_INTER]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s SUBSET interval(a:real^1,b) ==> interval(a,b) SUBSET interval[a,b] ==> s SUBSET interval[a,b]`)) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC] THEN CONJ_TAC THENL [MP_TAC(SPECL [`drop v`; `drop x`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL [EXISTS_TAC `v:real^1` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\y. lift((drop(f v) - drop(f y)) / (drop v - drop y))) continuous at x` MP_TAC THENL [REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV) THEN ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; LIFT_SUB; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_AT_ID]; REWRITE_TAC[continuous_at; DIST_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `k / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC] THEN EXISTS_TAC `x + lift(min d (inv(&n + &1)) / &2)` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x:real^N,x + r) = norm r`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < y`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; REAL_LT_ADDR; LIFT_DROP] THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = --x * --(inv y)`] THEN REWRITE_TAC[GSYM REAL_INV_NEG; REAL_NEG_SUB] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `k <= y ==> abs(y' - y) < k / &2 ==> --k / -- &2 <= y'`)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x + y:real^N,x) = norm y`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < x`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]; GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN EXISTS_TAC `v:real^1` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\y. lift((drop(f v) - drop(f y)) / (drop v - drop y))) continuous at x` MP_TAC THENL [REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV) THEN ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; LIFT_SUB; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_AT_ID]; REWRITE_TAC[continuous_at; DIST_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `k / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC] THEN EXISTS_TAC `x - lift(min d (inv(&n + &1)) / &2)` THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ (p /\ q) /\ s`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x:real^N,x - r) = norm r`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < y`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[REAL_ARITH `x - a < x <=> &0 < a`] THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `k <= y ==> abs(y' - y) < k / &2 ==> k / &2 <= y'`)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x - y:real^N,x) = norm y`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < x`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]]; MP_TAC(SPECL [`drop u`; `drop x`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL [EXISTS_TAC `u:real^1` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\y. lift((drop(f u) - drop(f y)) / (drop u - drop y))) continuous at x` MP_TAC THENL [REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV) THEN ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; LIFT_SUB; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_AT_ID]; REWRITE_TAC[continuous_at; DIST_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `k / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC] THEN EXISTS_TAC `x + lift(min d (inv(&n + &1)) / &2)` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x:real^N,x + r) = norm r`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < y`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; REAL_LT_ADDR; LIFT_DROP] THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = --x * --(inv y)`] THEN REWRITE_TAC[GSYM REAL_INV_NEG; REAL_NEG_SUB] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y <= --k ==> abs(y' - y) < k / &2 ==> y' <= --(--k / -- &2)`)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x + y:real^N,x) = norm y`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < x`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]; GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^1` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\y. lift((drop(f u) - drop(f y)) / (drop u - drop y))) continuous at x` MP_TAC THENL [REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV) THEN ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; LIFT_SUB; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_AT_ID]; REWRITE_TAC[continuous_at; DIST_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `k / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC] THEN EXISTS_TAC `x - lift(min d (inv(&n + &1)) / &2)` THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ (p /\ q) /\ s`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x:real^N,x - r) = norm r`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < y`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[REAL_ARITH `x - a < x <=> &0 < a`] THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y <= --k ==> abs(y' - y) < k / &2 ==> y' <= --(k / &2)`)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x - y:real^N,x) = norm y`] THEN REWRITE_TAC[NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> abs(min x y / &2) < x`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]]]) in let lemma4 = prove (`!f a b k. f has_bounded_variation_on interval[a,b] /\ drop a < drop b /\ &0 < k ==> negligible {x | x IN interval[a,b] /\ !n. ?u v. u IN ball(x,inv(&n + &1)) /\ u IN interval[a,b] /\ v IN ball(x,inv(&n + &1)) /\ v IN interval[a,b] /\ ~(u = x) /\ ~(v = x) /\ k <= (drop(f v) - drop(f x)) / (drop v - drop x) - (drop(f u) - drop(f x)) / (drop u - drop x)}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemma1) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `u UNION UNIONS {{x | x IN interval[a,b] /\ !n. ?u v. u IN ball(x,inv(&n + &1)) /\ u IN interval[a,b] /\ v IN ball(x,inv(&n + &1)) /\ v IN interval[a,b] /\ ~(u = x) /\ ~(v = x) /\ k / &3 <= (drop(f v) - drop(f x)) / (drop v - drop x) - q /\ (drop(f u) - drop(f x)) / (drop u - drop x) - q <= --(k / &3)} | q IN rational}` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN SIMP_TAC[COUNTABLE_RATIONAL; COUNTABLE_IMAGE; SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN X_GEN_TAC `q:real` THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(ISPECL [`\x:real^1. f(x) - q % x`; `a:real^1`; `b:real^1`; `k / &3`] lemma3) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CMUL THEN SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL]; REWRITE_TAC[DROP_SUB; DROP_CMUL; REAL_ARITH `((a - q * a') - (b - q * b')) / i:real = (a - b) / i - q * (a' - b') / i`] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t /\ u /\ v <=> ~(t /\ u ==> ~(p /\ q /\ r /\ s /\ v))`] THEN SIMP_TAC[REAL_DIV_REFL; DROP_EQ; REAL_SUB_0; REAL_MUL_RID]]; GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN ASM_CASES_TAC `(x:real^1) IN u` THEN ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `?N B. &0 < B /\ !n u. N <= n /\ u IN ball(x,inv(&n + &1)) /\ ~(u = x) ==> abs((drop(f u) - drop(f x)) / (drop u - drop x)) <= B` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[EVENTUALLY_AT; GSYM DIST_NZ; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `u:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^1`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN TRANS_TAC REAL_LT_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ; REAL_SUB_0; DROP_EQ] THEN REWRITE_TAC[GSYM DROP_SUB; GSYM NORM_1]]; ALL_TAC] THEN SUBGOAL_THEN `!n. ~({ u:real^1 | u IN ball(x,inv(&n + &1)) /\ u IN interval[a,b] /\ ~(u = x)} = {})` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(SET_RULE `interval(a,b) SUBSET interval[a,b] /\ ~(s INTER interval(a,b) SUBSET {c}) ==> ~({x | x IN s /\ x IN interval[a,b] /\ ~(x = c)} = {})`) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; BALL_1] THEN REWRITE_TAC[GSYM(CONJUNCT1 INTERIOR_INTERVAL)] THEN REWRITE_TAC[GSYM INTERIOR_INTER; INTER_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN REWRITE_TAC[GSYM INTERVAL_SING; CLOSURE_INTERVAL] THEN MATCH_MP_TAC(MESON[CONVEX_CLOSURE_INTERIOR] `convex s /\ ~(interior s = {}) /\ closure s = s /\ ~(s SUBSET t) ==> ~(closure(interior s) SUBSET t)`) THEN REWRITE_TAC[CONVEX_INTERVAL; CLOSURE_INTERVAL] THEN REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_EQ_EMPTY_1; SUBSET_INTERVAL_1; LIFT_DROP; DROP_ADD; DROP_SUB] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN MP_TAC(ISPEC `&n + &1` REAL_LT_INV_EQ) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?l. ((\n. lift(inf {(drop (f u) - drop (f x)) / (drop u - drop x) |u| u IN ball (x,inv (&n + &1)) /\ u IN interval[a,b] /\ ~(u = x)})) --> l) sequentially` (CHOOSE_THEN (LABEL_TAC "l")) THENL [MATCH_MP_TAC(MATCH_MP MONO_EXISTS (GEN `l:real^1` (ISPECL [`f:num->real^1`; `l:real^1`; `N:num`] SEQ_OFFSET_REV))) THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE_1 THEN REWRITE_TAC[LIFT_DROP] THEN CONJ_TAC THENL [REWRITE_TAC[bounded; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN EXISTS_TAC `B:real` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_BOUNDS] THEN MATCH_MP_TAC REAL_INF_BOUNDS THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[ARITH_RULE `N:num <= n + N`]; DISJ1_TAC THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `b SUBSET c ==> {f x | x IN b /\ P x} SUBSET {f x | x IN c /\ P x}`) THEN MATCH_MP_TAC SUBSET_BALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC; EXISTS_TAC `--B:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[ARITH_RULE `N:num <= n + N`; REAL_ARITH `abs x <= B ==> --B <= x`]]]; ALL_TAC] THEN SUBGOAL_THEN `?m. ((\n. lift(sup {(drop (f u) - drop (f x)) / (drop u - drop x) |u| u IN ball (x,inv (&n + &1)) /\ u IN interval[a,b] /\ ~(u = x)})) --> m) sequentially` (CHOOSE_THEN (LABEL_TAC "m")) THENL [MATCH_MP_TAC(MATCH_MP MONO_EXISTS (GEN `l:real^1` (ISPECL [`f:num->real^1`; `l:real^1`; `N:num`] SEQ_OFFSET_REV))) THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE_1 THEN REWRITE_TAC[LIFT_DROP] THEN CONJ_TAC THENL [REWRITE_TAC[bounded; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN EXISTS_TAC `B:real` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_BOUNDS] THEN MATCH_MP_TAC REAL_SUP_BOUNDS THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[ARITH_RULE `N:num <= n + N`]; DISJ2_TAC THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `b SUBSET c ==> {f x | x IN b /\ P x} SUBSET {f x | x IN c /\ P x}`) THEN MATCH_MP_TAC SUBSET_BALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC; EXISTS_TAC `B:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[ARITH_RULE `N:num <= n + N`; REAL_ARITH `abs x <= B ==> x <= B`]]]; ALL_TAC] THEN SUBGOAL_THEN `k <= drop m - drop l` MP_TAC THENL [REMOVE_THEN "l" MP_TAC THEN REMOVE_THEN "m" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REWRITE_TAC[GSYM DROP_SUB] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] LIM_DROP_LBOUND) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_LE_SUB_LADD] THEN DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^1` MP_TAC o SPEC `n:num`) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^1` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REAL_ARITH `i <= u /\ v <= s ==> k <= v - u ==> k + i <= s`) THEN CONJ_TAC THENL [MATCH_MP_TAC INF_LE_ELEMENT; MATCH_MP_TAC ELEMENT_LE_SUP] THEN (CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_GSPEC]; ASM SET_TAC[]]) THENL [EXISTS_TAC `--B:real`; EXISTS_TAC `B:real`] THEN ASM_MESON_TAC[ARITH_RULE `N:num <= n + N`; REAL_ARITH `abs x <= B ==> --B <= x /\ x <= B`]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma0) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real` THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[TAUT `p1 /\ q1 /\ p2 /\ q2 /\ r1 /\ r2 /\ s2 /\ s1 <=> (p1 /\ q1 /\ r1 /\ s1) /\ (p2 /\ q2 /\ r2 /\ s2)`] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THEN REWRITE_TAC[REAL_LE_LT; LEFT_OR_DISTRIB; EXISTS_OR_THM] THEN DISJ1_TAC THEN REWRITE_TAC[REAL_NOT_LT; SET_RULE `(?u. p u /\ q u /\ r u /\ s u) <=> ~(!u. p u /\ q u /\ r u ==> ~s u)`] THEN REWRITE_TAC[REAL_ARITH `--k <= a - b <=> b - k <= a`; REAL_ARITH `a - b <= k / &3 <=> a <= k / &3 + b`] THENL [REMOVE_THEN "l" MP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `(q - drop l) - k / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M + n:num`)) THEN REWRITE_TAC[LE_ADD; DIST_REAL; GSYM drop; LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs(j - l) < q - l - k ==> ~(q - k <= j)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] REAL_LE_INF)); REMOVE_THEN "m" MP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `(drop m - q) - k / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M + n:num`)) THEN REWRITE_TAC[LE_ADD; DIST_REAL; GSYM drop; LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs(j - m) < m - q - k ==> ~(j <= k + q)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] REAL_SUP_LE))] THEN MATCH_MP_TAC (TAUT `p /\ (r ==> q) ==> ~(p /\ q) ==> ~r`) THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_IMP] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN MATCH_MP_TAC SUBSET_BALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC) in let lemma5 = prove (`!f a b k. f has_bounded_variation_on interval[a,b] /\ drop a < drop b /\ &0 < k ==> negligible {x | x IN interval[a,b] /\ !n. ?u v. u IN ball(x,inv(&n + &1)) /\ u IN interval[a,b] /\ v IN ball(x,inv(&n + &1)) /\ v IN interval[a,b] /\ ~(u = x) /\ ~(v = x) /\ k <= abs((drop(f v) - drop(f x)) / (drop v - drop x) - (drop(f u) - drop(f x)) / (drop u - drop x))}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(--) o (f:real^1->real^1)`; `a:real^1`; `b:real^1`; `k:real`] lemma4) THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `k:real`] lemma4) THEN ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ISOMETRIC_COMPOSE; NORM_ARITH `dist(--x:real^N,--y) = dist(x,y)`] THEN REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[LEFT_OR_FORALL_THM] THEN REWRITE_TAC[RIGHT_OR_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `m + n:num`) THEN REWRITE_TAC[REAL_ARITH `a <= abs x <=> a <= x \/ a <= --x`; o_DEF; TAUT `p /\ (q \/ r) <=> p /\ q \/ p /\ r`; EXISTS_OR_THM] THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN REWRITE_TAC[DROP_NEG; REAL_ARITH `--x - --y:real = --(x - y)`; REAL_ARITH `--a / b:real = --(a / b)`] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN MATCH_MP_TAC SUBSET_BALL THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC) in let lemma6 = prove (`!f:real^1->real^1 a b. f has_bounded_variation_on interval[a,b] /\ drop a < drop b ==> negligible {x | x IN interval[a,b] /\ ~(f differentiable (at x within interval[a,b]))}`, REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_DIFFERENTIABLE] THEN REWRITE_TAC[has_vector_derivative; EXISTS_LIFT] THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL; LIFT_DROP; has_derivative_within] THEN REWRITE_TAC[EXISTS_DROP; LIFT_DROP; LINEAR_SCALING] THEN REWRITE_TAC[NORM_1; GSYM REAL_ABS_INV] THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_ABS] THEN REWRITE_TAC[GSYM NORM_MUL] THEN REWRITE_TAC[GSYM LIM_NULL_NORM] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a % (y - (x + d)):real^N = a % (y - x) - a % d`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `a % x = a % lift(drop x)`] THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN SIMP_TAC[DROP_EQ; DROP_SUB; REAL_FIELD `~(x' = x) ==> (inv(x' - x) * h) * (x' - x):real = h`] THEN REWRITE_TAC[LIFT_DROP; ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN REWRITE_TAC[GSYM LIM_NULL] THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY_WITHIN; DIST_LIFT] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN interval[a,b] /\ !n. ?u v. u IN ball(x,inv(&n + &1)) /\ u IN interval[a,b] /\ v IN ball(x,inv(&n + &1)) /\ v IN interval[a,b] /\ ~(u = x) /\ ~(v = x) /\ inv(&m + &1) <= abs((drop(f v) - drop(f x)) / (drop v - drop x) - (drop(f u) - drop(f x)) / (drop u - drop x))} | m IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN GEN_TAC THEN MATCH_MP_TAC lemma5 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_TRANS]; X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[GSYM REAL_NOT_LT; NOT_FORALL_THM; GSYM DIST_NZ] THEN REWRITE_TAC[IN_BALL] THEN DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN EXISTS_TAC `inv(&p + &1)` THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN ASM_MESON_TAC[DIST_SYM]]]) in let lemma7 = prove (`!f:real^1->real^1 a b k. f has_bounded_variation_on interval[a,b] ==> negligible {x | x IN interval[a,b] /\ ~(f differentiable at x)}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; NEGLIGIBLE_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `a <= b ==> a = b \/ a < b`)) THEN REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL [ASM_REWRITE_TAC[INTERVAL_SING] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{b:real^1}` THEN REWRITE_TAC[SUBSET_RESTRICT; NEGLIGIBLE_SING]; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `(a:real^1) INSERT b INSERT {x | x IN interval[a,b] /\ ~((f:real^1->real^1) differentiable (at x within interval[a,b]))}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_INSERT] THEN CONJ_TAC THENL [MATCH_MP_TAC lemma6 THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> (Q x <=> P x)) ==> {x | x IN s /\ P x} SUBSET a INSERT b INSERT {x | x IN s /\ Q x}`) THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_DIFFERENTIABLE] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[has_vector_derivative] THEN REWRITE_TAC[has_derivative_at; has_derivative_within] THEN AP_TERM_TAC THEN MATCH_MP_TAC LIM_WITHIN_INTERIOR THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; INTERIOR_INTERVAL] THEN ASM SET_TAC[]]) in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DIFFERENTIABLE_COMPONENTWISE_AT] THEN REWRITE_TAC[GSYM IN_NUMSEG; NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[SET_RULE `x IN a /\ (?i. i IN s /\ P i x) <=> ?i. i IN s /\ x IN {x | x IN a /\ P i x}`] THEN REWRITE_TAC[SET_RULE `{x | ?i. i IN k /\ x IN f i} = UNIONS {f i | i IN k}`] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN MATCH_MP_TAC lemma7 THEN FIRST_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN ASM_REWRITE_TAC[]);; let LEBESGUE_DIFFERENTIATION_THEOREM = prove (`!f:real^1->real^N s. is_interval s /\ f has_bounded_variation_on s ==> negligible {x | x IN s /\ ~(f differentiable at x)}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `negligible {x | x IN frontier s /\ ~(f differentiable at x)} /\ negligible {x | x IN interior s /\ ~((f:real^1->real^N) differentiable at x)}` MP_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^1->bool` CLOSURE_SUBSET) THEN SET_TAC[]] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_FINITE THEN MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[CARD_FRONTIER_INTERVAL_1]; SUBGOAL_THEN `(f:real^1->real^N) has_bounded_variation_on interior s` MP_TAC THENL [ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^1->bool` OPEN_INTERIOR) THEN POP_ASSUM_LIST(K ALL_TAC)] THEN SPEC_TAC(`interior s:real^1->bool`,`s:real^1->bool`) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^1->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:real^1->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:real^1->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN MATCH_MP_TAC LEBESGUE_DIFFERENTIATION_THEOREM_COMPACT THEN ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET]);; let LEBESGUE_DIFFERENTIATION_THEOREM_ALT = prove (`!f:real^1->real^N s. is_interval s /\ f has_bounded_variation_on s ==> ?t. t SUBSET s /\ negligible t /\ !x. x IN s DIFF t ==> f differentiable at x`, REPEAT STRIP_TAC THEN EXISTS_TAC `{x | x IN s /\ ~((f:real^1->real^N) differentiable at x)}` THEN ASM_SIMP_TAC[LEBESGUE_DIFFERENTIATION_THEOREM; SUBSET_RESTRICT] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN CONV_TAC TAUT);; let LEBESGUE_DIFFERENTIATION_THEOREM_GEN = prove (`!f:real^1->real^N s. COUNTABLE(components s) /\ f has_bounded_variation_on s ==> negligible {x | x IN s /\ ~(f differentiable at x)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`] THEN MATCH_MP_TAC LEBESGUE_DIFFERENTIATION_THEOREM THEN REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET; HAS_BOUNDED_VARIATION_ON_SUBSET]);; let LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING = prove (`!f s. is_interval s /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> negligible {x | x IN s /\ ~(f differentiable at x)}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LOCALLY_NEGLIGIBLE_ALT] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP IS_INTERVAL_LOCALLY_COMPACT_INTERVAL) THEN REWRITE_TAC[locally] THEN DISCH_THEN(MP_TAC o SPECL [`s:real^1->bool`; `x:real^1`]) THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[OPEN_IN_OPEN; MESON[] `(?u. (?t. open t /\ u = s INTER t) /\ P u) <=> ?t. open t /\ P(s INTER t)`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1->bool` THEN ASM_REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM; IMP_CONJ; IN_ELIM_THM] THEN X_GEN_TAC `i:real^1->bool` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN DISCH_THEN SUBST1_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x | x IN interval[a,b] /\ ~((f:real^1->real^1) differentiable at x)}` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC LEBESGUE_DIFFERENTIATION_THEOREM_COMPACT THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN ASM SET_TAC[]);; let LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING = prove (`!f s. is_interval s /\ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)) ==> negligible {x | x IN s /\ ~(f differentiable at x)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(--) o (f:real^1->real^1)`; `s:real^1->bool`] LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING) THEN ASM_REWRITE_TAC[o_THM; DROP_NEG; REAL_LE_NEG2] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT(STRIP_TAC THEN ASM_REWRITE_TAC[]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIFFERENTIABLE_NEG) THEN ASM_REWRITE_TAC[o_THM; VECTOR_NEG_NEG; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Forms of absolute continuity of the indefinite (absolute) integral. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_CONTINUOUS_INTEGRAL = prove (`!f:real^M->real^N s e. f absolutely_integrable_on s /\ &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> norm(integral t f) < e`, ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. if x IN s then (f:real^M->real^N) x else vec 0`; `(:real^M)`; `e / &2`] ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / &2 / B` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF] THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN TRANS_TAC REAL_LET_TRANS `drop(integral t (\x. lift(norm((if x IN s then f x else vec 0) - g x)) + lift(norm((g:real^M->real^N) x))))` THEN SUBGOAL_THEN `(g:real^M->real^N) absolutely_integrable_on t /\ (\x. if x IN s then (f:real^M->real^N) x else vec 0) absolutely_integrable_on t` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real^M)` THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; SUBSET_UNIV]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on t` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_EQ)) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_ADD; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP; DROP_ADD] THEN COND_CASES_TAC THENL [CONV_TAC NORM_ARITH; ASM SET_TAC[]]; ALL_TAC] THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [ABSOLUTELY_INTEGRABLE_NORM; INTEGRAL_ADD; DROP_ADD; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `norm(integral s (f:real^M->real^1)) < e / &2 ==> drop(integral t f) <= norm(integral s f) ==> drop(integral t f) < e / &2`)) THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; IN_UNIV; SUBSET_UNIV; LIFT_DROP; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN REWRITE_TAC[NORM_POS_LE]; TRANS_TAC REAL_LET_TRANS `drop(integral t (\x:real^M. lift B))` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[LIFT_DROP; ABSOLUTELY_INTEGRABLE_NORM; INTEGRABLE_ON_CONST; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; ASM_SIMP_TAC[LIFT_EQ_CMUL; INTEGRAL_CMUL; INTEGRABLE_ON_CONST; INTEGRAL_MEASURE] THEN REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]]]);; let ABSOLUTELY_SETCONTINUOUS_INDEFINITE_INTEGRAL = prove (`!f:real^M->real^N s. f absolutely_integrable_on s /\ lebesgue_measurable s ==> (\k. integral k f) absolutely_setcontinuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_SETCONTINUOUS_ON_ALT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `e:real` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_INTEGRAL)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] INTEGRAL_COMBINE_DIVISION_TOPDOWN)) THEN ANTS_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; ASM_MESON_TAC[MEASURE_ELEMENTARY]]]);; let ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT = prove (`!f:real^1->real^N a b. f absolutely_integrable_on interval[a,b] ==> (\x. integral(interval[a,x]) f) absolutely_continuous_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_SETCONTINUOUS_INDEFINITE_INTEGRAL)) THEN REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_SETCONTINUOUS_COMPARISON) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1] THEN STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `y + z:real^N = x ==> norm(x - y) <= norm z`) THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL) o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_LEFT = prove (`!f:real^1->real^N a b. f absolutely_integrable_on interval[a,b] ==> (\x. integral(interval[x,b]) f) absolutely_continuous_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[absolutely_continuous_on] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_SETCONTINUOUS_INDEFINITE_INTEGRAL)) THEN REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_SETCONTINUOUS_COMPARISON) THEN SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1] THEN STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `z + x:real^N = y ==> norm(x - y) <= norm z`) THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL) o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS = prove (`!f:real^1->real^N f' s a b. negligible s /\ drop a <= drop b /\ f absolutely_continuous_on interval[a,b] /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f'(x)) (at x within interval[a,b])) ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_BARTLE THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [absolutely_continuous_on]) THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^1->bool`; `d:real`] MEASURABLE_OUTER_OPEN) THEN ASM_SIMP_TAC[MEASURE_EQ_0; NEGLIGIBLE_IMP_MEASURABLE; REAL_ADD_LID] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. if x IN s then u else ball(x:real^1,&1)` THEN CONJ_TAC THENL [REWRITE_TAC[gauge] THEN X_GEN_TAC `x:real^1` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `p:(real^1#(real^1->bool))->bool` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[tagged_partial_division_of]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE SND (p:(real^1#(real^1->bool))->bool)` o MATCH_MP(MESON[] `(!x y. P x y) ==> !x. P x (UNIONS x)`)) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM_MESON_TAC[PARTIAL_DIVISION_OF_TAGGED_DIVISION]; REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_PAIR_THM] THEN ASM_MESON_TAC[tagged_partial_division_of; SUBSET]; TRANS_TAC REAL_LET_TRANS `measure(u:real^1->bool)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `measure(UNIONS (IMAGE SND (p:(real^1#(real^1->bool))->bool)))` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x = y ==> y <= x`) THEN MATCH_MP_TAC MEASURE_ELEMENTARY THEN ASM_MESON_TAC[PARTIAL_DIVISION_OF_TAGGED_DIVISION]; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_ELEMENTARY; PARTIAL_DIVISION_OF_TAGGED_DIVISION]; REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_PAIR_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN REWRITE_TAC[AND_FORALL_THM; IMP_IMP] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN SET_TAC[]]]]; W(MP_TAC o PART_MATCH (lhand o rand) (ISPEC `SND` SUM_IMAGE_GEN) o lhand o rand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `y <= &2 * x ==> x < e / &2 ==> y <= e`) THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?y z:real^1. k = interval[y,z] /\ x IN interval[y,z]` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN ASM_MESON_TAC[]; DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC))] THEN ASM_CASES_TAC `interval[y:real^1,z] = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `sum {x | x IN (p:(real^1#(real^1->bool))->bool) /\ SND x = interval[y,z]} (\a. norm(f(z) - f(y):real^N))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT; FORALL_PAIR_THM; IN_ELIM_THM] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; REAL_LE_REFL]; ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY]] THEN ASM_CASES_TAC `content(interval[y:real^1,z]) = &0` THENL [SUBGOAL_THEN `z:real^1 = y` (fun th -> REWRITE_TAC[th; VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL]) THEN ASM_MESON_TAC[DROP_EQ; CONTENT_EQ_0_1; REAL_LE_ANTISYM; INTERVAL_NE_EMPTY_1]; MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE]] THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN MP_TAC(ISPECL [`p:(real^1#(real^1->bool))->bool`; `interval[a:real^1,b]`; `x:real^1`] TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND) THEN ASM_REWRITE_TAC[DIMINDEX_1; EXP_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_THM; PAIR_EQ] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);; let ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_EQ = prove (`!f:real^1->real^N a b. f absolutely_integrable_on interval[a,b] <=> f integrable_on interval[a,b] /\ (\t. integral(interval[a,t]) f) has_bounded_variation_on interval[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on; ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ] THEN ASM_CASES_TAC `(f:real^1->real^N) integrable_on interval[a,b]` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN MAP_EVERY X_GEN_TAC [`c:real^1`; `d:real^1`] THEN STRIP_TAC THEN REWRITE_TAC[] THENL [CONV_TAC SYM_CONV; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY] THEN MATCH_MP_TAC(VECTOR_ARITH `b + c:real^N = a ==> a - b = c`) THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL))) THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE = prove (`!f:real^1->real^N f' s a b. f absolutely_continuous_on interval[a,b] /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f'(x)) (at x within interval[a,b])) ==> f' absolutely_integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `drop b <= drop a \/ drop a <= drop b`) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_NULL; CONTENT_EQ_0_1] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[integrable_on] THEN EXISTS_TAC `(f:real^1->real^N) b - f a` THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_EQ THEN EXISTS_TAC `\x. (f:real^1->real^N) x - f a` THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_SUB; ABSOLUTELY_CONTINUOUS_ON_CONST] THEN X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM_REAL_ARITH_TAC] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]);; let ABSOLUTE_INTEGRAL_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ = prove (`!f:real^1->real^N f' a b. f' absolutely_integrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> (f' has_integral (f x - f a)) (interval[a,x])) <=> f absolutely_continuous_on interval[a,b] /\ ?s. negligible s /\ !x. x IN interval [a,b] DIFF s ==> (f has_vector_derivative f' x) (at x within interval[a,b])`, REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_EQ THEN EXISTS_TAC `\x. (f:real^1->real^N) a + integral(interval[a,x]) f'` THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT; ABSOLUTELY_CONTINUOUS_ON_ADD; ABSOLUTELY_CONTINUOUS_ON_CONST] THEN X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a + b:real^N = c <=> b = c - a`] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^1->bool` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[IN_DIFF] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^1` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `((\x:real^1. (f:real^1->real^N) a) has_vector_derivative (vec 0)) (at x within interval[a,b])` MP_TAC THENL [REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_VECTOR_DERIVATIVE_ADD) THEN REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN)) THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a + b:real^N = c <=> b = c - a`] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[]; MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE THEN ASM_MESON_TAC[]; MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM_REAL_ARITH_TAC] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]);; let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ = prove (`!f':real^1->real^N a b. f' absolutely_integrable_on interval[a,b] <=> ?f s. f absolutely_continuous_on interval[a,b] /\ negligible s /\ !x. x IN interval [a,b] DIFF s ==> (f has_vector_derivative f' x) (at x within interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[GSYM ABSOLUTE_INTEGRAL_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[TAUT `(p <=> p /\ q) <=> p ==> q`] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN EXISTS_TAC `\t. integral(interval[a,t]) (f':real^1->real^N)` THEN REWRITE_TAC[INTEGRAL_REFL; VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Characterizing absolutely continuous functions as Lebesgue integrals. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE = prove (`!f:real^1->real^1 a b. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) ==> ?s f'. negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x)) /\ f' absolutely_integrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> drop(integral(interval[a,x]) f') <= drop(f x) - drop(f a))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `interval[a:real^1,b]`] LEBESGUE_DIFFERENTIATION_THEOREM_ALT) THEN ASM_SIMP_TAC[IS_INTERVAL_INTERVAL; INCREASING_BOUNDED_VARIATION] THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{a:real^1,b} UNION s` THEN ASM_SIMP_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN RULE_ASSUM_TAC (REWRITE_RULE[VECTOR_DIFFERENTIABLE; RIGHT_IMP_EXISTS_THM]) THEN FIRST_X_ASSUM(X_CHOOSE_TAC`f':real^1->real^1` o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN EXISTS_TAC `f':real^1->real^1` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; ABSOLUTELY_INTEGRABLE_ON_EMPTY] THEN SUBGOAL_THEN `!c. c IN interval[a,b] ==> (f':real^1->real^1) absolutely_integrable_on interval[a,c] /\ drop(integral(interval[a,c]) f') <= drop(f c) - drop(f a)` (fun th -> ASM_MESON_TAC[ENDS_IN_INTERVAL; th]) THEN X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `~(interval[a:real^1,c] = {})` MP_TAC THENL [ASM_MESON_TAC[INTERVAL_NE_EMPTY_1; IN_INTERVAL_1]; ALL_TAC] THEN SUBGOAL_THEN `interval[a:real^1,c] SUBSET interval[a,b]` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN UNDISCH_TAC `negligible(s:real^1->bool)` THEN SUBGOAL_THEN `!x. x IN interval[a,c] DIFF s ==> ((f:real^1->real^1) has_vector_derivative f' x) (at x)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x y. x IN interval[a,c] /\ y IN interval[a,c] /\ drop x <= drop y ==> drop(f x) <= drop(f y)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`c:real^1`,`b:real^1`) THEN GEN_TAC THEN REPEAT DISCH_TAC THEN ABBREV_TAC `g = \x. if drop x < drop a then f(a) else if drop b < drop x then f(b) else (f:real^1->real^1) x` THEN SUBGOAL_THEN `(f':real^1->real^1) absolutely_integrable_on interval[a,b] /\ drop(integral(interval[a,b]) f') <= drop(g b) - drop(g a)` MP_TAC THENL [ALL_TAC; EXPAND_TAC "g" THEN REWRITE_TAC[REAL_LT_REFL] THEN ASM_REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY_1]] THEN ABBREV_TAC `t = s UNION {a:real^1,b}` THEN SUBGOAL_THEN `negligible(t:real^1->bool)` MP_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN ASM_REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN interval[a,b] DIFF t ==> ((g:real^1->real^1) has_vector_derivative f' x) (at x)` MP_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^1`; `interval(a:real^1,b)`] THEN REWRITE_TAC[OPEN_INTERVAL; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; IN_DIFF; IN_INSERT] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; DE_MORGAN_THM; IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. drop b <= drop x ==> (g:real^1->real^1) x = g b` MP_TAC THENL [REPEAT STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN EXPAND_TAC "g" THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!x y. drop x <= drop y ==> drop(g x) <= drop(g y)` MP_TAC THENL [REPEAT STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN EXPAND_TAC "g" THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN FIRST_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN UNDISCH_TAC `~(interval[a:real^1,b] = {})` THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`t:real^1->bool`,`s:real^1->bool`) THEN SPEC_TAC(`g:real^1->real^1`,`f:real^1->real^1`) THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`\n x. &n % ((f:real^1->real^1)(x + lift(inv(&n))) - f(x))`; `f':real^1->real^1`; `interval[a:real^1,b]`; `s:real^1->bool`; `drop(f(b:real^1)) - drop(f a)`] FATOU_STRONG) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN REWRITE_TAC[has_derivative_at; has_vector_derivative] THEN DISCH_THEN(MP_TAC o SPEC `\n. x + lift(inv(&n))` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] (ISPEC `sequentially` LIM_COMPOSE_AT))) o CONJUNCT2) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; o_DEF; VECTOR_ADD_SUB] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_INV; REAL_ABS_NUM; REAL_INV_INV] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_INV_0; VECTOR_MUL_LZERO] THEN ANTS_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST; SEQ_HARMONIC]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_ARITH `n % (f' - (f + d)) - (n % (f' - f) - k):real^N = k - n % d`] THEN REWRITE_TAC[LIFT_DROP; VECTOR_MUL_ASSOC; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; LE_1; VECTOR_MUL_LID]; MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTEGRABLE_INCREASING_1]] THEN SUBGOAL_THEN `(f:real^1->real^1) integrable_on interval[a + lift(inv(&n)),b + lift(inv(&n))]` MP_TAC THENL [MATCH_MP_TAC INTEGRABLE_INCREASING_1 THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`&1`; `lift(inv(&n))`] o MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_AFFINITY)) THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID; VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) + --x:real^1 = a`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_EQ_EMPTY_1]) THEN ASM_REWRITE_TAC[DROP_ADD; REAL_ARITH `x + i < y + i <=> ~(y <= x)`] THEN ASM_MESON_TAC[INTERVAL_NE_EMPTY_1]; MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[DROP_CMUL; DROP_SUB] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS; REAL_SUB_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[DROP_ADD; REAL_LE_ADDR; LIFT_DROP; REAL_LE_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `integral (interval[a + lift(inv(&n)),b + lift(inv(&n))]) f:real^1`; `interval[a + lift(inv(&n)),b + lift(inv(&n))]`; `&1`; `lift(inv(&n))`] HAS_INTEGRAL_AFFINITY) THEN REWRITE_TAC[DIMINDEX_1] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL; IMAGE_AFFINITY_INTERVAL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_LID; INTERVAL_EQ_EMPTY_1] THEN REWRITE_TAC[DROP_ADD; LIFT_DROP] THEN COND_CASES_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[VECTOR_ARITH `(a + x) + --x:real^N = a`]] THEN ANTS_TAC THENL [ASM_MESON_TAC[INTEGRABLE_INCREASING_1]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `&n` o MATCH_MP HAS_INTEGRAL_CMUL) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN SUBGOAL_THEN `!u v. (f:real^1->real^1) integrable_on interval[u,v]` ASSUME_TAC THENL [ASM_MESON_TAC[INTEGRABLE_INCREASING_1]; ALL_TAC] THEN ASM_SIMP_TAC[INTEGRABLE_CMUL; INTEGRAL_CMUL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; DROP_CMUL] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b + lift(&1 / &n)`; `a + lift(&1 / &n)`] INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + b:real^N = b <=> b = b - a`] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[DROP_ADD; REAL_LE_ADDR; REAL_LE_RADD] THEN SIMP_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; LIFT_DROP; REAL_POS] THEN ASM_MESON_TAC[INTERVAL_NE_EMPTY_1]; DISCH_THEN(SUBST1_TAC o MATCH_MP (VECTOR_ARITH `a + b:real^N = c ==> b = c - a`))] THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b + lift(&1 / &n)`; `b:real^1`] INTEGRAL_COMBINE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[DROP_ADD; REAL_LE_ADDR; REAL_LE_RADD] THEN SIMP_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; LIFT_DROP; REAL_POS] THEN ASM_MESON_TAC[INTERVAL_NE_EMPTY_1]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[VECTOR_ARITH `(i + b) - a - i:real^N = b - a`] THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC(REAL_ARITH `a <= b /\ d <= c ==> a - c <= b - d`) THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `&n * drop(integral (interval[b,b + lift (&1 / &n)]) (\x. (f:real^1->real^1) b))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[INTEGRABLE_CONST; IN_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_REFL]; REWRITE_TAC[INTEGRAL_CONST] THEN SIMP_TAC[CONTENT_1; DROP_ADD; LIFT_DROP; REAL_LE_ADDR; REAL_LE_DIV; REAL_POS] THEN REWRITE_TAC[DROP_CMUL] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE]) THEN CONV_TAC REAL_FIELD]; TRANS_TAC REAL_LE_TRANS `&n * drop(integral (interval[a,a + lift (&1 / &n)]) (\x. (f:real^1->real^1) a))` THEN CONJ_TAC THENL [REWRITE_TAC[INTEGRAL_CONST] THEN SIMP_TAC[CONTENT_1; DROP_ADD; LIFT_DROP; REAL_LE_ADDR; REAL_LE_DIV; REAL_POS] THEN REWRITE_TAC[DROP_CMUL] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE]) THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[INTEGRABLE_CONST; IN_INTERVAL_1]]]);; let ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE_ALT = prove (`!f:real^1->real^1 f' a b s. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x)) ==> f' absolutely_integrable_on interval[a,b] /\ (!x. x IN interval[a,b] ==> drop(integral(interval[a,x]) f') <= drop(f x) - drop(f a))`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^1->bool`; `g:real^1->real^1`] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN interval[a,b] DIFF (s UNION t) ==> (f':real^1->real^1) x = g x` ASSUME_TAC THENL [X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^1`; `x:real^1`] THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE) THEN EXISTS_TAC `g:real^1->real^1` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `s UNION t:real^1->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ]; X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `drop(integral(interval[a,c]) (g:real^1->real^1))` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `s UNION t:real^1->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN SUBGOAL_THEN `interval[a:real^1,c] SUBSET interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1; REAL_LE_REFL]; ASM SET_TAC[]]]);; let ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> ?f' s. negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x)) /\ f' absolutely_integrable_on interval[a,b]`, let lemma = prove (`!f:real^1->real^1 a b. f has_bounded_variation_on interval[a,b] ==> ?f' s. negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x)) /\ f' absolutely_integrable_on interval[a,b]`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:real^1->real^1`; `a:real^1`; `b:real^1`] ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE) THEN MP_TAC(ISPECL [`g:real^1->real^1`; `a:real^1`; `b:real^1`] ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^1->bool`; `g':real^1->real^1`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`t:real^1->bool`; `h':real^1->real^1`] THEN STRIP_TAC THEN EXISTS_TAC `\x. (g':real^1->real^1) x - h' x` THEN EXISTS_TAC `s UNION t:real^1->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SUB] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM]) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_SUB THEN ASM SET_TAC[]) in REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP MONO_FORALL (GEN `i:num` (MATCH_MP MONO_IMP (CONJ (TAUT `1 <= i /\ i <= dimindex(:N) ==> 1 <= i /\ i <= dimindex(:N)`) (SPECL [`\x. lift((f:real^1->real^N)x$i)`; `a:real^1`; `b:real^1`] lemma))))) THEN ASM_REWRITE_TAC[GSYM HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:num->real^1->real^1`; `s:num->real^1->bool`] THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. drop((g:num->real^1->real^1) i x)) :real^1->real^N` THEN EXISTS_TAC `UNIONS (IMAGE (s:num->real^1->bool) (1..dimindex(:N)))` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_IMAGE; FORALL_IN_IMAGE; FINITE_NUMSEG]; X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; UNIONS_IMAGE; IN_NUMSEG; IN_ELIM_THM] THEN REWRITE_TAC[MESON[] `~(?x. P x /\ Q x) <=> (!x. P x ==> ~Q x)`] THEN STRIP_TAC THEN REWRITE_TAC[has_vector_derivative] THEN ONCE_REWRITE_TAC[HAS_DERIVATIVE_COMPONENTWISE_AT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_SIMP_TAC[IN_DIFF; has_vector_derivative] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN REWRITE_TAC[LIFT_CMUL; LIFT_DROP]; ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]);; let ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ = prove (`!f:real^1->real^N a b. f absolutely_continuous_on interval[a,b] <=> ?f'. f' absolutely_integrable_on interval[a,b] /\ !x. x IN interval[a,b] ==> (f' has_integral (f x - f a)) (interval[a,x])`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON)) THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':real^1->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN ASM_MESON_TAC[IN_INTERVAL_1]; X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]; FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT) THEN MP_TAC(ISPECL [`interval[a:real^1,b]`; `(f:real^1->real^N) a`] ABSOLUTELY_CONTINUOUS_ON_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_CONTINUOUS_ON_ADD) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_ON_EQ) THEN REWRITE_TAC[VECTOR_ARITH `a + i:real^N = x <=> i = x - a`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Variation in terms of integral in a more general setting. *) (* ------------------------------------------------------------------------- *) let ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] ==> ?s f'. negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x)) /\ f' absolutely_integrable_on interval[a,b] /\ !c. c IN interval[a,b] ==> drop(integral (interval[a,c]) (\x. lift(norm(f' x)))) <= vector_variation (interval[a,c]) f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f':real^1->real^N`; `s:real^1->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x. lift(vector_variation (interval[a,x]) (f:real^1->real^N))`; `a:real^1`; `b:real^1`] ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); ALL_TAC] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[LIFT_DROP; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`t:real^1->bool`; `v':real^1->real^1`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a INSERT b INSERT s UNION t:real^1->bool`; `f':real^1->real^N`] THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_INSERT] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `interval[a:real^1,c] SUBSET interval[a,b]` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `c IN interval[a:real^1,b]`)) THEN SIMP_TAC[VECTOR_VARIATION_ON_NULL; CONTENT_EQ_0_1; REAL_LE_REFL; BOUNDED_INTERVAL; REAL_SUB_RZERO] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC INTEGRAL_DROP_LE_AE THEN EXISTS_TAC `a INSERT b INSERT s UNION t:real^1->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_INSERT] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL]; MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL]; ALL_TAC] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INSERT; IN_UNION; LIFT_DROP; DE_MORGAN_THM] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `a <= abs b /\ &0 <= b ==> a <= b`) THEN SUBGOAL_THEN `eventually (\y:real^1. y IN interval[a,b]) (at x)` ASSUME_TAC THENL [MP_TAC(ISPEC `interval(a:real^1,b)` OPEN_CONTAINS_BALL) THEN REWRITE_TAC[OPEN_INTERVAL; EVENTUALLY_AT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; IN_DIFF; IN_INSERT] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `d:real` THEN REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF] THEN MESON_TAC[DIST_SYM]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM NORM_1] THEN MATCH_MP_TAC NORM_VECTOR_DERIVATIVES_LE_AT THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^N`; `\x. lift (vector_variation (interval[a,x]) (f:real^1->real^N))`; `x:real^1`] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN SUBGOAL_THEN `!u v. u IN interval[a,b] /\ v IN interval[a,b] ==> norm((f:real^1->real^N) u - f v) <= abs(vector_variation (interval[a,u]) f - vector_variation (interval[a,v]) f)` (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[NORM_SUB; REAL_ABS_SUB; CONJ_SYM]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `vector_variation (interval[u,v]) (f:real^1->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[SEGMENT_1; SUBSET_REFL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `a + b = c ==> b <= abs(a - c)`) THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET))) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]; REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN ASM_REWRITE_TAC[IN_DIFF; HAS_VECTOR_DERIVATIVE_AT_1D] THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] LIM_DROP_LBOUND)) THEN REWRITE_TAC[TRIVIAL_LIMIT_AT; DROP_CMUL; DROP_SUB; LIFT_DROP] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `x IN interval[a:real^1,b]` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISJ_CASES_TAC(REAL_ARITH `drop x <= drop y \/ drop y <= drop x`) THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN SIMP_TAC[REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_SUB_LE] THEN (MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)); ALL_TAC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);; let ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION_ALT = prove (`!f:real^1->real^N f' a b s. f has_bounded_variation_on interval[a,b] /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x within interval[a,b])) ==> f' absolutely_integrable_on interval[a,b] /\ !c. c IN interval[a,b] ==> drop(integral (interval[a,c]) (\x. lift(norm(f' x)))) <= vector_variation (interval[a,c]) f`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^1->bool`; `g:real^1->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN interval[a,b] DIFF (a INSERT b INSERT (s UNION t)) ==> (f':real^1->real^N) x = g x` ASSUME_TAC THENL [X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^N`; `x:real^1`] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SUBGOAL_THEN `((f:real^1->real^N) has_vector_derivative f' x) (at x within interval[a,b])` MP_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN SIMP_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_1D; HAS_VECTOR_DERIVATIVE_AT_1D] THEN MATCH_MP_TAC LIM_WITHIN_INTERIOR THEN REWRITE_TAC[INTERIOR_INTERVAL] THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE) THEN EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `a INSERT b INSERT (s UNION t):real^1->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_INSERT]; X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `drop(integral(interval[a,c]) (\x. lift(norm((g:real^1->real^N) x))))` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `a INSERT b INSERT (s UNION t):real^1->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_INSERT] THEN SUBGOAL_THEN `interval[a:real^1,c] SUBSET interval[a,b]` MP_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1; REAL_LE_REFL]; ASM SET_TAC[]]]);; let VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_GEN = prove (`!f:real^1->real^N f' a b s. f absolutely_continuous_on interval[a,b] /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x within interval[a,b])) ==> f' absolutely_integrable_on interval[a,b] /\ vector_variation (interval[a,b]) f = drop(integral (interval[a,b]) (\x. lift(norm(f' x))))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE]; DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SET_VARIATION)] THEN REWRITE_TAC[vector_variation] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SET_VARIATION_EQ THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN SIMP_TAC[INTERVAL_NE_EMPTY_1; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[ABSOLUTELY_CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET; SUBSET; IN_DIFF]);; let ABSOLUTELY_CONTINUOUS_VECTOR_VARIATION = prove (`!f:real^1->real^N a b. f has_bounded_variation_on interval[a,b] /\ (\x. lift(vector_variation (interval [a,x]) f)) absolutely_continuous_on interval[a,b] <=> f absolutely_continuous_on interval[a,b]`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_COMPARISON)) THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN REWRITE_TAC[dist] THEN TRANS_TAC REAL_LE_TRANS `vector_variation(interval[x,y]) (f:real^1->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE; SUBSET_REFL]; REWRITE_TAC[NORM_LIFT; GSYM LIFT_SUB] THEN MATCH_MP_TAC(REAL_ARITH `x + y = z ==> y <= abs(x - z)`) THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN REPEAT CONJ_TAC] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET))) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON; BOUNDED_INTERVAL]; DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE)] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f':real^1->real^N`; `s:real^1->bool`] THEN STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[ABSOLUTELY_CONTINUOUS_ON_EMPTY] THEN REWRITE_TAC[ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ] THEN EXISTS_TAC `\x. lift(norm((f':real^1->real^N) x))` THEN SIMP_TAC[VECTOR_VARIATION_ON_NULL; CONTENT_EQ_0_1; REAL_LE_REFL; BOUNDED_INTERVAL; REAL_SUB_RZERO; LIFT_NUM; VECTOR_SUB_RZERO] THEN MATCH_MP_TAC(MESON[] `b IN interval[a,b] /\ (!c. c IN interval[a,b] ==> P(interval[a,c]) /\ Q c) ==> P(interval[a,b]) /\ !c. c IN interval[a,b] ==> Q c`) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; TAUT `(p ==> q) ==> (p /\ q /\ r <=> p /\ r)`] THEN X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN W(MP_TAC o PART_MATCH (rand o rand) VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_GEN o rand o snd) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM]] THEN SUBGOAL_THEN `interval[a:real^1,c] SUBSET interval[a,b]` ASSUME_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_AT_WITHIN; SUBSET; IN_DIFF; ABSOLUTELY_CONTINUOUS_ON_SUBSET]]]);; (* ------------------------------------------------------------------------- *) (* Converses to a couple of theorems above: equality holds only if the *) (* function concerned is absolutely continuous. *) (* ------------------------------------------------------------------------- *) let INCREASING_FTC_AE_IMP_ABSOLUTELY_CONTINUOUS = prove (`!f f' a b s. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)) /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x)) /\ integral (interval[a,b]) f' = f(b) - f(a) ==> f absolutely_continuous_on interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ] THEN EXISTS_TAC `f':real^1->real^1` THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN X_GEN_TAC `c:real^1` THEN MP_TAC(ISPECL [`f:real^1->real^1`; `f':real^1->real^1`] ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE_ALT) THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `s:real^1->bool`] th) THEN MP_TAC(ISPECL [`c:real^1`; `b:real^1`; `s:real^1->bool`] th) THEN MP_TAC(ISPECL [`a:real^1`; `b:real^1`; `s:real^1->bool`] th)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `c IN interval[a:real^1,b]` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `interval[a:real^1,c] SUBSET interval[a,b] /\ interval[c,b] SUBSET interval[a,b]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^1`))] THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; REAL_LE_REFL]; DISCH_TAC] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `c:real^1`))] THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; REAL_LE_REFL]; DISCH_TAC] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM DROP_EQ]) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `!j. i <= c - a /\ j <= b - c /\ i + j = k ==> k = b - a ==> i = c - a`) THEN EXISTS_TAC `drop(integral(interval[c:real^1,b]) f')` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM DROP_ADD; DROP_EQ] THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ASM_REWRITE_TAC[GSYM IN_INTERVAL_1]);; let VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_REV = prove (`!f:real^1->real^N f' a b s. f has_bounded_variation_on interval[a,b] /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x within interval[a,b])) /\ vector_variation (interval[a,b]) f = drop(integral (interval[a,b]) (\x. lift(norm(f' x)))) ==> f absolutely_continuous_on interval[a,b]`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_CONTINUOUS_VECTOR_VARIATION] THEN ASM_REWRITE_TAC[ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ] THEN EXISTS_TAC `\x. lift(norm((f':real^1->real^N) x))` THEN SIMP_TAC[VECTOR_VARIATION_ON_NULL; CONTENT_EQ_0_1; REAL_LE_REFL; BOUNDED_INTERVAL; REAL_SUB_RZERO; LIFT_NUM; VECTOR_SUB_RZERO] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN X_GEN_TAC `c:real^1` THEN MP_TAC(ISPECL [`f:real^1->real^N`; `f':real^1->real^N`] ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION_ALT) THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `s:real^1->bool`] th) THEN MP_TAC(ISPECL [`c:real^1`; `b:real^1`; `s:real^1->bool`] th) THEN MP_TAC(ISPECL [`a:real^1`; `b:real^1`; `s:real^1->bool`] th)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `c IN interval[a:real^1,b]` THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM] THEN SUBGOAL_THEN `interval[a:real^1,c] SUBSET interval[a,b] /\ interval[c,b] SUBSET interval[a,b]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET; SUBSET; IN_DIFF; HAS_BOUNDED_VARIATION_ON_SUBSET]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^1`))] THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; REAL_LE_REFL]; DISCH_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET; SUBSET; IN_DIFF; HAS_BOUNDED_VARIATION_ON_SUBSET]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `c:real^1`))] THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; REAL_LE_REFL]; DISCH_TAC] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN MP_TAC(ISPECL [`\x. lift(norm((f':real^1->real^N) x))`; `a:real^1`; `b:real^1`; `c:real^1`] INTEGRAL_COMBINE) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `b:real^1`; `c:real^1`] VECTOR_VARIATION_COMBINE) THEN ASM_REWRITE_TAC[GSYM IN_INTERVAL_1] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_ADD] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Banach-Zarecki and related results. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE, LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE, ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY = let lemma1 = prove (`!f:real^1->real^1 s e. f absolutely_continuous_on s /\ is_interval s /\ closed s /\ &0 < e ==> ?r. &0 < r /\ !t. t SUBSET s /\ measurable t /\ measure t < r ==> ?u. IMAGE f t SUBSET u /\ measurable u /\ measure u < e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [absolutely_continuous_on]) THEN REWRITE_TAC[absolutely_setcontinuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `r / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `t:real^1->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`t:real^1->bool`; `r / &2`] MEASURABLE_OUTER_CLOSED_INTERVALS) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `ds:(real^1->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!k. k IN ds ==> ~(k INTER s = {}) ==> ?u v. u IN k /\ v IN k /\ u IN s /\ v IN s /\ IMAGE (f:real^1->real^1) (k INTER s) SUBSET interval[f u,f v]` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(!k. k IN d ==> ~(k = {}) /\ ?a b. k = interval[a,b]) ==> (!a b. interval[a,b] IN d /\ ~(interval[a,b] = {}) ==> P(interval[a,b])) ==> !k. k IN d ==> P k`)) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?u v. IMAGE (f:real^1->real^1) (interval[a,b] INTER s) = interval[u,v]` MP_TAC THENL [REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN ASM_SIMP_TAC[COMPACT_INTERVAL; COMPACT_INTER_CLOSED; GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_INTER; IS_INTERVAL_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^1->bool` THEN REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN SUBGOAL_THEN `u IN IMAGE (f:real^1->real^1) (interval[a,b] INTER s) /\ v IN IMAGE (f:real^1->real^1) (interval[a,b] INTER s)` MP_TAC THENL [ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM]] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IMP_IMP; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:(real^1->bool)->real^1`; `v:(real^1->bool)->real^1`] THEN DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (\k. interval[(f:real^1->real^1)(u k),f(v k)]) {k:real^1->bool | k IN ds /\ ~(k INTER s = {})})` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`] `&0 < e /\ measurable s /\ measure s <= e / &2 ==> measurable s /\ measure s < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RESTRICT] THEN REWRITE_TAC[FORALL_IN_IMAGE; MEASURABLE_INTERVAL] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `dd:(real^1->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `IMAGE (\k:real^1->bool. interval[(f:real^1->real^1) (u k),f(v k)]) dd = IMAGE (\k. interval[lift(min (drop(f(interval_lowerbound k))) (drop(f(interval_upperbound k)))), lift(max (drop(f(interval_lowerbound k))) (drop(f(interval_upperbound k))))]) (IMAGE (\k. interval[lift(min (drop(u k)) (drop(v k))), lift(max (drop(u k)) (drop(v k)))]) dd)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> g x = f x) ==> IMAGE f s = IMAGE g s`) THEN SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; LIFT_DROP; REAL_ARITH `min a b <= max a b`] THEN X_GEN_TAC `k:real^1->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (~(s = {}) ==> t = s) ==> t = s`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[EQ_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN ASM_CASES_TAC `drop(u(k:real^1->bool)) <= drop(v k)` THEN ASM_SIMP_TAC[REAL_ARITH `a <= b ==> min a b = a /\ max a b = b`; REAL_ARITH `~(a <= b) ==> min a b = b /\ max a b = a`; LIFT_DROP] THEN SIMP_TAC[real_max; real_min; LIFT_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ASM_SIMP_TAC[MEASURABLE_INTERVAL; FINITE_IMAGE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`IMAGE (\k:real^1->bool. interval[lift(min (drop(u k)) (drop(v k))), lift(max (drop(u k)) (drop(v k)))]) dd`; `UNIONS(IMAGE (\k:real^1->bool. interval[lift(min (drop(u k)) (drop(v k))), lift(max (drop(u k)) (drop(v k)))]) dd)`]) THEN ANTS_TAC THENL [REWRITE_TAC[division_of]; MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x <= e`) THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; LIFT_DROP; REAL_ARITH `min a b <= max a b`; MEASURE_INTERVAL_1] THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN REAL_ARITH_TAC] THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INTERVAL_NE_EMPTY_1; LIFT_DROP] THEN REAL_ARITH_TAC; MESON_TAC[]]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `k:real^1->bool` THEN DISCH_TAC THEN X_GEN_TAC `l:real^1->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `l:real^1->bool = k` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^1->bool`; `l:real^1->bool`]) THEN ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) INTERVAL_SUBSET_IS_INTERVAL o snd) THEN (ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN ASM_MESON_TAC[IS_INTERVAL_INTERVAL]; DISCH_THEN SUBST1_TAC THEN DISJ2_TAC]) THEN REWRITE_TAC[real_min; real_max] THEN REPEAT(COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP]) THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN DISJ2_TAC THEN REWRITE_TAC[real_min; real_max] THEN REPEAT(COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP]) THEN ASM SET_TAC[]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `m <= t + r / &2 ==> t < r / &2 /\ x <= m ==> x < r`)) THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`k:real^1->bool`; `l:real^1->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^1->bool`; `l:real^1->bool`]) THEN ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR; GSYM INTERIOR_INTER] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM); ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTERVAL_SUBSET_IS_INTERVAL o snd) THEN (ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN ASM_MESON_TAC[IS_INTERVAL_INTERVAL]; DISCH_THEN SUBST1_TAC THEN DISJ2_TAC]) THEN REWRITE_TAC[real_min; real_max] THEN REPEAT(COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP]) THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN TRANS_TAC REAL_LE_TRANS `sum (dd:(real^1->bool)->bool) content` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[o_DEF] THEN X_GEN_TAC `k:real^1->bool` THEN ASM_CASES_TAC `?a b:real^1. k = interval[a,b]` THENL [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC); ASM SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC CONTENT_SUBSET THEN SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL; IS_INTERVAL_INTERVAL] THEN DISJ2_TAC THEN REWRITE_TAC[real_min; real_max] THEN REPEAT(COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP]) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`dd:(real^1->bool)->bool`; `UNIONS dd:real^1->bool`] HAS_MEASURE_ELEMENTARY) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM o MATCH_MP MEASURE_UNIQUE) THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN ASM_MESON_TAC[MEASURABLE_INTERVAL]]) in let lemma2 = prove (`!f:real^1->real^1 s e. f absolutely_continuous_on s /\ is_interval s /\ &0 < e ==> ?r. &0 < r /\ !t. t SUBSET s /\ measurable t /\ measure t < r ==> ?u. IMAGE f t SUBSET u /\ measurable u /\ measure u < e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ABSOLUTELY_CONTINUOUS_EXTENDS_TO_CLOSURE)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->real^1`; `closure s:real^1->bool`; `e:real`] lemma1) THEN ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN ANTS_TAC THENL [ASM_MESON_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CLOSURE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1->bool` THEN MP_TAC(ISPEC `s:real^1->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]) in let lemma3 = prove (`!f:real^1->real^N s e. f absolutely_continuous_on s /\ is_interval s /\ &0 < e ==> ?r. &0 < r /\ !t. t SUBSET s /\ measurable t /\ measure t < r ==> ?u. IMAGE f t SUBSET u /\ measurable u /\ measure u < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL [REWRITE_TAC[DIMINDEX_GE_1]; REWRITE_TAC[ARITH_RULE `1 <= n <=> 2 <= n \/ n = 1`]] THEN STRIP_TAC THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `t:real^1->bool` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:real^1->real^N) s` THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`] NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE_LOWDIM) THEN ASM_SIMP_TAC[NEGLIGIBLE_EQ_MEASURE_0]; ALL_TAC] THEN MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] ISOMETRIES_SUBSPACES) THEN ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; DIMINDEX_1] THEN REWRITE_TAC[IN_UNIV; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `k:real^1->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(h:real^N->real^1) o (f:real^1->real^N)`; `s:real^1->bool`; `e:real`] lemma2) THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_COMPOSE_LINEAR] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1->bool` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (k:real^1->real^N) u` THEN REPEAT CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IMAGE_o]) THEN ASM SET_TAC[]; MATCH_MP_TAC MEASURABLE_LINEAR_IMAGE_GEN THEN ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]; ASM_SIMP_TAC[MEASURE_ISOMETRY; DIMINDEX_1]]) in let NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE = prove (`!f:real^1->real^N s t. f absolutely_continuous_on s /\ is_interval s /\ negligible t /\ t SUBSET s ==> negligible(IMAGE f t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`; `e:real`] lemma3) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[NEGLIGIBLE_EQ_MEASURE_0]) in let LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE = prove (`!f:real^1->real^N s t. f absolutely_continuous_on s /\ is_interval s /\ lebesgue_measurable t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t)`, MESON_TAC[PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE; NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE; ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS]) in let ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY = prove (`!f:real^1->real^N s e. f absolutely_continuous_on s /\ is_interval s /\ &0 < e ==> ?d. &0 < d /\ !t. t SUBSET s /\ measurable t /\ measure t < d ==> measurable(IMAGE f t) /\ measure(IMAGE f t) < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemma3) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_MESON_TAC[LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE; MEASURABLE_IMP_LEBESGUE_MEASURABLE]; DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `measure(u:real^N->bool)` THEN ASM_SIMP_TAC[MEASURE_SUBSET]]) in NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE, LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE, ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY;; let MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE = prove (`!f:real^1->real^N s t. f absolutely_continuous_on s /\ is_interval s /\ measurable t /\ t SUBSET s ==> measurable(IMAGE f t)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REWRITE_TAC[IMP_IMP] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`; `&1`] ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY) THEN ASM_REWRITE_TAC[REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?n. measure(t:real^1->bool) < &2 pow n * d` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC REAL_ARCH_POW THEN CONV_TAC REAL_RAT_REDUCE_CONV; FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)) THEN FIRST_X_ASSUM(MP_TAC o check (is_exists o concl)) THEN SPEC_TAC(`t:real^1->bool`,`t:real^1->bool`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[real_pow; REAL_MUL_LID] THEN FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN X_GEN_TAC `t:real^1->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HALF_MEASURES) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^1->bool`; `v:real^1->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `v:real^1->bool` th) THEN MP_TAC(SPEC `u:real^1->bool` th)) THEN ASM_REWRITE_TAC[REAL_ARITH `x / &2 < p * d <=> x < (&2 * p) * d`] THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) THEN EXPAND_TAC "t" THEN REWRITE_TAC[IMAGE_UNION] THEN ASM_SIMP_TAC[MEASURABLE_UNION]);; let BANACH_ZARECKI = prove (`!f:real^1->real^1 a b. f absolutely_continuous_on interval[a,b] <=> f continuous_on interval[a,b] /\ f has_bounded_variation_on interval[a,b] /\ !t. t SUBSET interval[a,b] /\ negligible t ==> negligible(IMAGE f t)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON; ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS; IS_INTERVAL_INTERVAL; BOUNDED_INTERVAL] THEN ASM_MESON_TAC[NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE; IS_INTERVAL_INTERVAL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f':real^1->real^1`; `n:real^1->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_CONTINUOUS_COMPARISON) THEN MAP_EVERY X_GEN_TAC [`s:real^1`; `t:real^1`] THEN STRIP_TAC THEN REWRITE_TAC[dist] THEN TRANS_TAC REAL_LE_TRANS `norm(integral(interval[s,t]) (\x. lift(norm((f':real^1->real^1) x))))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(NORM_ARITH `a + c:real^N = b ==> norm c <= norm(a - b)`) THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC] THEN TRANS_TAC REAL_LE_TRANS `measure(IMAGE (f:real^1->real^1) (interval[s,t]))` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT1 MEASURE_SEGMENT_1)] THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_SEGMENT] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_INTERVAL]; REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_SIMP_TAC[FUN_IN_IMAGE; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM CONNECTED_CONVEX_1] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_INTERVAL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `measure(IMAGE (f:real^1->real^1) (interval[s,t] DIFF n))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN FIRST_X_ASSUM(MP_TAC o SPEC `n INTER interval[a:real^1,b]`) THEN ANTS_TAC THENL [ASM_MESON_TAC[INTER_SUBSET; NEGLIGIBLE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN SUBGOAL_THEN `interval[s:real^1,t] SUBSET interval[a,b]` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MEASURE_DIFFERENTIABLE_IMAGE THEN EXISTS_TAC `\x h. drop h % (f':real^1->real^1) x` THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_DIFF; MEASURABLE_INTERVAL; NEGLIGIBLE_IMP_MEASURABLE] THEN SIMP_TAC[DET_1; matrix; LAMBDA_BETA; DIMINDEX_1; ARITH; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; drop] THEN REWRITE_TAC[REAL_MUL_LID; GSYM drop; GSYM NORM_1] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF; IN_INTERVAL_1]) THEN REWRITE_TAC[GSYM has_vector_derivative] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `interval[s:real^1,t]` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SUBGOAL_THEN `interval[s:real^1,t] SUBSET interval[a,b]` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `interval[a:real^1,b]` THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[NORM_1] THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= abs y`) THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]);; let BANACH_ZARECKI_GEN = prove (`!f:real^1->real^1 s. is_interval s /\ bounded s ==> (f absolutely_continuous_on s <=> f continuous_on s /\ f has_bounded_variation_on s /\ !t. t SUBSET s /\ negligible t ==> negligible(IMAGE f t))`, REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON; ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS] THEN ASM_MESON_TAC[NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `?a b:real^1. closure s = interval[a,b]` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1; COMPACT_CLOSURE] THEN MATCH_MP_TAC CONNECTED_CLOSURE THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1]; ALL_TAC] THEN SUBGOAL_THEN `?g:real^1->real^1. g continuous_on closure s /\ !x. x IN s ==> g x = f x` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `(f:real^1->real^1) uniformly_continuous_on s` MP_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS]; DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS]]; MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^1->real^1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CLOSURE_SUBSET]] THEN REWRITE_TAC[BANACH_ZARECKI] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[]; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CLOSURE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_EQ THEN EXISTS_TAC `f:real^1->real^1` THEN ASM_MESON_TAC[]; X_GEN_TAC `t:real^1->bool` THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^1->real^1) (a INSERT b INSERT (t DIFF {a,b}))` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[IMAGE_CLAUSES; NEGLIGIBLE_INSERT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF {a:real^1,b}`) THEN SUBGOAL_THEN `t DIFF {a:real^1,b} SUBSET s` ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; SUBSET_DIFF]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]] THEN TRANS_TAC SUBSET_TRANS `interior(closure s):real^1->bool` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[INTERIOR_INTERVAL] THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t DIFF u`) THEN ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS]; ASM_MESON_TAC[CONVEX_INTERIOR_CLOSURE; IS_INTERVAL_CONVEX_1; INTERIOR_SUBSET]]]]);; let ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV_GEN = prove (`!f:real^1->real^N s t. is_interval s /\ bounded s /\ f continuous_on s /\ f has_bounded_variation_on s /\ COUNTABLE t /\ (!x. x IN s DIFF t ==> f differentiable (at x within s)) ==> f absolutely_continuous_on s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `COUNTABLE(t:real^1->bool)` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT; HAS_BOUNDED_VARIATION_ON_COMPONENTWISE; DIFFERENTIABLE_COMPONENTWISE_WITHIN; ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `g = \x. lift((f:real^1->real^N) x$i)` THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN STRIP_TAC THEN ASM_SIMP_TAC[BANACH_ZARECKI_GEN] THEN X_GEN_TAC `c:real^1->bool` THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (g:real^1->real^1) ((c DIFF t) UNION t)` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IMAGE_UNION] THEN ASM_SIMP_TAC[NEGLIGIBLE_COUNTABLE; COUNTABLE_IMAGE] THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN REWRITE_TAC[LE_REFL] THEN CONJ_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; SUBSET_DIFF]; ALL_TAC] THEN REWRITE_TAC[differentiable_on; IN_DIFF] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_MESON_TAC[DIFFERENTIABLE_WITHIN_SUBSET; SUBSET; IN_DIFF]);; let ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV = prove (`!f:real^1->real^N a b. f differentiable_on interval[a,b] /\ f has_bounded_variation_on interval[a,b] ==> f absolutely_continuous_on interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV_GEN THEN EXISTS_TAC `{}:real^1->bool` THEN ASM_REWRITE_TAC[COUNTABLE_EMPTY; DIFF_EMPTY; GSYM differentiable_on] THEN ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN REWRITE_TAC[IS_INTERVAL_INTERVAL; BOUNDED_INTERVAL]);; let ABSOLUTELY_CONTINUOUS_ON_COMPOSE = prove (`!f:real^1->real^N g s t. is_interval s /\ bounded s /\ is_interval t /\ bounded t /\ f absolutely_continuous_on t /\ g absolutely_continuous_on s /\ IMAGE g s SUBSET t ==> ((f o g) absolutely_continuous_on s <=> (f o g) has_bounded_variation_on s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON] THEN ONCE_REWRITE_TAC[ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE; HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o funpow 4 RAND_CONV o LAND_CONV) [ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM; LEFT_AND_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[o_DEF] THEN SUBGOAL_THEN `!h. (\x:real^1. lift(((f:real^1->real^N)(h x))$i)) = (\x. lift(f x$i)) o h` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN SPEC_TAC(`\x. lift((f:real^1->real^N)x$i)`,`f:real^1->real^1`) THEN POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[GSYM I_DEF; I_O_ID] THEN GEN_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[BANACH_ZARECKI_GEN] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET]; REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Indefinite integral of any gauge integrable function at least has the *) (* Luzin N property. Proof (with easy gap fixed up) from Bartle's "A Modern *) (* Theory of Integration" Th 14.20, apparently following Dongfu and Shipan: *) (* "Henstock integrals and Lusin's condition (N)" in Real Analysis Exchange. *) (* ------------------------------------------------------------------------- *) let NEGLIGIBLE_IMAGE_INDEFINITE_INTEGRAL = prove (`!f:real^1->real^1 s a b. f integrable_on interval[a,b] /\ negligible s /\ s SUBSET interval[a,b] ==> negligible (IMAGE (\c. integral(interval[a,c]) f) s)`, SUBGOAL_THEN `!f:real^1->real^1 s a b. f integrable_on interval[a,b] /\ negligible s /\ s SUBSET interval(a,b) ==> negligible (IMAGE (\c. integral(interval[a,c]) f) s)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN REPEAT(GEN_REWRITE_TAC BINOP_CONV [SWAP_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_TAC THEN X_GEN_TAC `s:real^1->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF {a:real^1,b}`) THEN ASM_SIMP_TAC[NEGLIGIBLE_DIFF; OPEN_CLOSED_INTERVAL_1] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (\c. integral(interval [a,c]) (f:real^1->real^1)) {a,b}` THEN REWRITE_TAC[IMAGE_CLAUSES; NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN SET_TAC[]] THEN SUBGOAL_THEN `!f:real^1->real^1 s a b. f integrable_on interval[a,b] /\ negligible s /\ s SUBSET interval(a,b) /\ (!x. x IN s ==> f x = vec 0) ==> negligible (IMAGE (\c. integral(interval[a,c]) f) s)` MP_TAC THENL [ALL_TAC; REPEAT(GEN_REWRITE_TAC BINOP_CONV [SWAP_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `\x. if ~(x IN s) then (f:real^1->real^1) x else vec 0` th)) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [UNDISCH_TAC `(f:real^1->real^1) integrable_on interval[a,b]` THEN MATCH_MP_TAC INTEGRABLE_SPIKE; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> g x = f x) ==> IMAGE g s = IMAGE f s`) THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_SPIKE] THEN EXISTS_TAC `s:real^1->bool` THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `!f:real^1->real^1 s a b. f integrable_on interval[a,b] /\ negligible s /\ s SUBSET interval(a,b) /\ (!x. x IN s ==> f x = vec 0) /\ (!x r. x IN s /\ &0 < r /\ cball(x,r) SUBSET interval[a,b] ==> ~ ?k. IMAGE (\c. integral(interval[a,c]) (f:real^1->real^1)) (cball(x,r)) SUBSET {k}) ==> negligible (IMAGE (\c. integral(interval[a,c]) f) s)` MP_TAC THENL [REPEAT STRIP_TAC; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN REPEAT(GEN_REWRITE_TAC BINOP_CONV [SWAP_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_TAC THEN X_GEN_TAC `s:real^1->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN s /\ !r. x IN s /\ &0 < r /\ cball(x,r) SUBSET interval[a,b] ==> ~ ?k. IMAGE (\c. integral(interval[a,c]) (f:real^1->real^1)) (cball(x,r)) SUBSET {k}}`) THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT]; MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (\c. integral (interval [a,c]) (f:real^1->real^1)) {x | x IN s /\ ?r k. &0 < r /\ cball(x,r) SUBSET interval[a,b] /\ IMAGE (\c. integral (interval [a,c]) f) (cball (x,r)) SUBSET {k}}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE; ABBREV_TAC `triv x r <=> ?k. IMAGE (\c. integral (interval[a,c]) (f:real^1->real^1)) (cball (x,r)) SUBSET {k}` THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN SET_TAC[]] THEN MP_TAC(SPEC `drop o (\c. integral (interval[a,c]) (f:real^1->real^1)) o lift` COUNTABLE_LOCAL_MAXIMA) THEN DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP COUNTABLE_IMAGE) THEN ONCE_REWRITE_TAC[SET_RULE `IMAGE f {g x | P x} = IMAGE (\x. f(g x)) {x | P x}`] THEN REWRITE_TAC[o_THM; LIFT_DROP] THEN REWRITE_TAC[SET_RULE `IMAGE (\x. f(lift x)) s = IMAGE f (IMAGE lift s)`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN MATCH_MP_TAC IMAGE_SUBSET THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN REWRITE_TAC[MESON[LIFT_DROP] `x = lift y <=> drop x = y`] THEN REWRITE_TAC[UNWIND_THM1] THEN X_GEN_TAC `x:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; GSYM DROP_SUB] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN DISCH_THEN(X_CHOOSE_THEN `k:real^1` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT2)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM NORM_1; IN_SING] THEN DISCH_THEN(fun th -> X_GEN_TAC `x':real^1` THEN DISCH_TAC THEN MP_TAC(SPEC `x:real^1` th) THEN MP_TAC(SPEC `x':real^1` th)) THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[IN_CBALL; REAL_LT_IMP_LE; REAL_LE_REFL; NORM_ARITH `dist(x:real^N,x') = norm(x' - x)`]]] THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN ONCE_REWRITE_TAC[MESON[REAL_ARITH `(&0 < e <=> &0 < &4 * e) /\ &4 * e / &4 = e`] `((!e. &0 < e ==> P e) <=> (!e. &0 < e ==> P(&4 * e)))`] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_INTEGRAL_INTEGRAL]) THEN REWRITE_TAC[has_integral] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^1->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!x r. x IN s /\ cball(x,r) SUBSET interval[a,b] ==> ?c t. IMAGE (\c. integral(interval[a,c]) (f:real^1->real^1)) (cball(x,r)) = cball(c,t)` MP_TAC THENL [REWRITE_TAC[CBALL_INTERVAL; GSYM EXISTS_LIFT; GSYM FORALL_LIFT] THEN REWRITE_TAC[MESON[VECTOR_ARITH `inv(&2) % (c + d) - inv(&2) % (d - c):real^N = c /\ inv(&2) % (c + d) + inv(&2) % (d - c):real^N = d`] `(?c t:real^1. P (c - t) (c + t)) <=> (?c d. P c d)`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM IS_INTERVAL_COMPACT; IS_INTERVAL_CONNECTED_1] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN REWRITE_TAC[COMPACT_INTERVAL; CONNECTED_INTERVAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`c:real^1->real->real^1`; `t:real^1->real->real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`{(x,r) | x IN s /\ &0 < r /\ cball(x,r) SUBSET interval[a,b] /\ cball(x,r) SUBSET (g:real^1->real^1->bool)(x)}`; `\(x,r). (c:real^1->real->real^1) x r`; `\(x,r). (t:real^1->real->real) x r`; `IMAGE (\c. integral (interval [a,c]) (f:real^1->real^1)) s`] VITALI_COVERING_THEOREM_CBALLS) THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN SUBGOAL_THEN `!x r. x IN s /\ &0 < r /\ cball(x,r) SUBSET interval[a,b] ==> &0 < (t:real^1->real->real) x r` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `r:real`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `r:real`])) THEN ASM_REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_ARITH `~(&0 < r) <=> r < &0 \/ r = &0`] THEN STRIP_TAC THEN ASM_SIMP_TAC[CBALL_SING; CBALL_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [ASM_SIMP_TAC[] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN X_GEN_TAC `r:real` THEN DISCH_TAC THEN EXISTS_TAC `x:real^1` THEN ASM_REWRITE_TAC[] THEN MP_TAC(fst(EQ_IMP_RULE(ISPEC `(g:real^1->real^1->bool) x INTER {y | y IN interval(a:real^1,b) /\ integral (interval[a,y]) f IN ball(integral (interval[a,x]) f:real^1,r / &2)}` OPEN_CONTAINS_CBALL))) THEN RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ANTS_TAC THENL [MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN REWRITE_TAC[OPEN_INTERVAL; OPEN_BALL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[a:real^1,b]` THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN ASM_REWRITE_TAC[]; DISCH_THEN(MP_TAC o SPEC `x:real^1`)] THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; CENTRE_IN_BALL; REAL_HALF] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `r':real` THEN REWRITE_TAC[SUBSET_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MP_TAC(ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM SET_TAC[]; DISCH_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `r':real`])) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^1` THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE]; FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `c SUBSET {y | y IN s /\ f y IN t} ==> IMAGE f c SUBSET t`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(X_CHOOSE_THEN `k:real^1#real->bool` MP_TAC)] THEN REWRITE_TAC[pairwise; FORALL_PAIR_THM; SUBSET; IN_ELIM_PAIR_THM] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM SUBSET] THEN SUBGOAL_THEN `k:real^1#real->bool = {x,y | (x,y) IN k}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM]; ONCE_REWRITE_TAC[SET_RULE `{f y | y IN {g x y | P x y}} = {f(g x y) | P x y}`]] THEN REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `(IMAGE (\x. integral (interval [a,x]) (f:real^1->real^1)) s DIFF UNIONS {cball (c x r,t x r) | x,r IN k}) UNION UNIONS {cball ((c:real^1->real->real^1) x r,t x r) | x,r IN k}` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `measurable(UNIONS{cball((c:real^1->real->real^1) x r,t x r) | x,r IN k}) /\ measure(UNIONS {cball (c x r,t x r) | x,r IN k}) <= &4 * e` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] MEASURABLE_NEGLIGIBLE_SYMDIFF); MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE (\x. integral (interval [a,x]) (f:real^1->real^1)) s DIFF UNIONS {cball ((c:real^1->real->real^1) x r,t x r) | x,r IN k}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN REWRITE_TAC[FORALL_IN_GSPEC; MEASURABLE_CBALL] THEN SUBGOAL_THEN `{cball ((c:real^1->real->real^1) x r,t x r) | x,r IN k} = IMAGE (\(x,r). cball (c x r,t x r)) k` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; EXISTS_PAIR_THM; IN_IMAGE] THEN MESON_TAC[]; ASM_SIMP_TAC[COUNTABLE_IMAGE]] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM SUBSET]) THEN X_GEN_TAC `l:real^1#real->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; MEASURABLE_CBALL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN TRANS_TAC REAL_LE_TRANS `sum l (\(x,r). (&2 * (t:real^1->real->real) x r) pow dimindex(:1))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_CBALL_BOUND THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM SET_TAC[]; REWRITE_TAC[REAL_POW_1; DIMINDEX_1]] THEN SUBGOAL_THEN `!x:real^1 r. (x,r) IN l ==> ?u v. x IN interval[u,v] /\ interval[u,v] SUBSET cball(x,r) /\ t x r <= norm(integral (interval[u,v]) (f:real^1->real^1))` MP_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `r:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^1,r:real) IN k` (ANTE_RES_THEN MP_TAC) THENL [ASM SET_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(K ALL_TAC o SPECL [`x:real^1`; `r:real`; `x:real^1`]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `r:real`]) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s = t ==> !y. y IN t ==> ?x. x IN s /\ f x = y`)) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `(c:real^1->real->real^1) x r - lift(t x r)` th) THEN MP_TAC(SPEC `(c:real^1->real->real^1) x r + lift(t x r)` th)) THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(x:real^N,x + r) = norm r`] THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x - r) = norm r`] THEN ASM_SIMP_TAC[NORM_LIFT; REAL_ARITH `&0 < x ==> abs x <= x`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1` ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^1` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM DROP_EQ; DROP_ADD; DROP_SUB; LIFT_DROP] THEN DISCH_THEN(MP_TAC o SPEC `drop(integral (interval[a,x]) (f:real^1->real^1))` o MATCH_MP (REAL_ARITH `u = x + r /\ v = x - r ==> !y. r <= abs(y - u) \/ r <= abs(y - v)`)) THEN MAP_EVERY UNDISCH_TAC [`dist(x:real^1,v) <= r`; `dist(x:real^1,u) <= r`] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v:real^1`; `u:real^1`] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r ==> s <=> r ==> p /\ q ==> s`] THEN MATCH_MP_TAC(MESON[] `(!u v. R u v ==> R v u) /\ (!u v. P u ==> R u v) ==> !u v. P u \/ P v ==> R u v`) THEN CONJ_TAC THENL [MESON_TAC[]; REPEAT STRIP_TAC] THEN DISJ_CASES_TAC(REAL_ARITH `drop u <= drop x \/ drop x <= drop u`) THENL [MAP_EVERY EXISTS_TAC [`u:real^1`; `x:real^1`]; MAP_EVERY EXISTS_TAC [`x:real^1`; `u:real^1`]] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN (CONJ_TAC THENL [MATCH_MP_TAC(MESON[SUBSET_TRANS; INTERVAL_SUBSET_SEGMENT_1] `segment[a:real^1,b] SUBSET t ==> interval[a,b] SUBSET t`) THEN SIMP_TAC[CONVEX_CONTAINS_SEGMENT_IMP; CONVEX_CBALL] THEN ASM_REWRITE_TAC[IN_CBALL; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN REWRITE_TAC[NORM_1] THENL [MATCH_MP_TAC(REAL_ARITH `u + d = x ==> abs(x - u) <= abs d`); MATCH_MP_TAC(REAL_ARITH `x + d = u ==> abs(x - u) <= abs d`)] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_DROP] THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN (SUBGOAL_THEN `x IN interval(a:real^1,b)` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN UNDISCH_TAC `cball(x:real^1,r) SUBSET interval [a,b]` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[IN_CBALL; IN_INTERVAL_1] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^1->real->real^1`; `v:real^1->real->real^1`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `g:real^1->real^1->bool`; `e:real`] HENSTOCK_LEMMA_PART2) THEN ASM_REWRITE_TAC[DIMINDEX_1; REAL_MUL_LID] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\(x:real^1,r:real). x,interval[u x r:real^1,v x r]) l`) THEN REWRITE_TAC[tagged_partial_division_of; GSYM CONJ_ASSOC] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x r x' r'. (x,r) IN l /\ (x',r') IN l /\ ~(x = x' /\ r = r') ==> DISJOINT (interval[(u:real^1->real->real^1) x r,v x r]) (interval[u x' r',v x' r'])` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `r:real`; `x':real^1`; `r':real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `r:real`; `x':real^1`; `r':real`]) THEN ASM_REWRITE_TAC[PAIR_EQ] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(?f. IMAGE f s SUBSET t /\ IMAGE f s' SUBSET t') ==> DISJOINT t t' ==> DISJOINT s s'`) THEN EXISTS_TAC `\c. integral (interval [a,c]) (f:real^1->real^1)` THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ IMAGE f t = v ==> IMAGE f s SUBSET v`) THENL [EXISTS_TAC `cball(x:real^1,r)`; EXISTS_TAC `cball(x':real^1,r')`] THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `interior s SUBSET s /\ interior t SUBSET t /\ DISJOINT s t ==> interior s INTER interior t = {}`) THEN REWRITE_TAC[INTERIOR_SUBSET] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [REWRITE_TAC[fine; IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o lhand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC(REAL_ARITH `x <= &2 * q ==> p = q ==> p <= &2 * e ==> x <= &4 * e`) THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM; o_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `r:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `(f:real^1->real^1) x = vec 0` SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[VECTOR_MUL_RZERO]] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN ASM_SIMP_TAC[NORM_ARITH `norm(vec 0 - x:real^N) = norm x`]]);; (* ------------------------------------------------------------------------- *) (* More refined ways of deducing increasing/decreasing/constant status *) (* from the sign of a derivative that may not hold on a set of exceptions. *) (* ------------------------------------------------------------------------- *) let POSITIVE_AE_DERIVATIVE_IMP_NONDECREASING = prove (`!f f' a b s. f continuous_on interval[a,b] /\ interior(IMAGE f s) = {} /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x) /\ &0 < drop(f' x)) ==> !x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)`, let lemma1 = prove (`!f f' a b s. drop a <= drop b /\ f continuous_on interval[a,b] /\ interior(IMAGE f s) = {} /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x) /\ &0 < drop(f' x)) ==> drop(f a) <= drop(f b)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `~(interval(f b,f a) SUBSET IMAGE (f:real^1->real^1) s)` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN ASM_REWRITE_TAC[SUBSET_EMPTY; INTERVAL_NE_EMPTY_1; INTERIOR_INTERVAL]; REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC] THEN MP_TAC(ISPECL [`drop`; `{x | x IN interval[a,b] /\ (f:real^1->real^1) x = y}`] CONTINUOUS_ATTAINS_SUP) THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; IN_ELIM_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN EXISTS_TAC `(:real^1)` THEN ASM_REWRITE_TAC[SUBSET_UNIV; COMPACT_INTERVAL] THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; CLOSED_SING]; REWRITE_TAC[SET_RULE `~({x | x IN s /\ f x = y} = {}) <=> y IN IMAGE f s`] THEN SUBGOAL_THEN `connected (IMAGE (f:real^1->real^1) (interval[a,b]))` MP_TAC THENL [ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE; CONNECTED_INTERVAL]; REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1]] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN EXISTS_TAC `b:real^1` THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN EXISTS_TAC `a:real^1` THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(X_CHOOSE_THEN `c:real^1` MP_TAC) THEN ASM_CASES_TAC `(c:real^1) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `c IN interval[a:real^1,b]` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^1`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `c IN interval(a:real^1,b)` ASSUME_TAC THENL [SIMP_TAC[OPEN_CLOSED_INTERVAL_1; IN_INSERT; NOT_IN_EMPTY; IN_DIFF] THEN ASM_MESON_TAC[REAL_LT_REFL]; MATCH_MP_TAC(TAUT `F ==> p`)]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_vector_derivative]) THEN REWRITE_TAC[has_derivative_at; LIM_AT; DIST_0] THEN DISCH_THEN(MP_TAC o SPEC `drop(f'(c:real^1))` o CONJUNCT2) THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN SIMP_TAC[dist; REAL_LT_LDIV_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `~(ball(c:real^1,d) INTER interval(c,b) = {})` MP_TAC THENL [SIMP_TAC[BALL_1; DISJOINT_INTERVAL_1; DROP_SUB; DROP_ADD; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^1` THEN SIMP_TAC[IN_INTER; IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_CASES_TAC `x:real^1 = c` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_INTERVAL_1] THEN STRIP_TAC THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [NORM_1] THEN ASM_SIMP_TAC[DROP_SUB; real_abs; REAL_SUB_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[NORM_1; DROP_ADD; DROP_SUB; DROP_CMUL] THEN MATCH_MP_TAC (REAL_ARITH `~(y < x) ==> ~(abs(x - (y + a * b)) < b * a)`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `b:real^1`; `drop y`; `1`] IVT_DECREASING_COMPONENT_ON_1) THEN ASM_SIMP_TAC[DIMINDEX_1; LE_REFL; GSYM drop; REAL_LT_IMP_LE; NOT_IMP] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_INTERVAL_1; DROP_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^1`) THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]) in REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN MAP_EVERY EXISTS_TAC [`f':real^1->real^1`; `s:real^1->bool`] THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `w:real^1` THEN REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DIFF] THEN ASM_REAL_ARITH_TAC]);; let POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT_GEN = prove (`!f:real^1->real^1 f' a b s. f continuous_on interval[a,b] /\ interior s = {} /\ interior(IMAGE f s) = {} /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x) /\ &0 < drop(f' x)) ==> !x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y ==> drop(f x) < drop(f y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `f':real^1->real^1`; `a:real^1`; `b:real^1`; `s:real^1->bool`] POSITIVE_AE_DERIVATIVE_IMP_NONDECREASING) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN SUBGOAL_THEN `!w. w IN interval[x,y] ==> (f:real^1->real^1) w = f x` ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM); ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; SUBGOAL_THEN `~(interval(x:real^1,y) SUBSET s)` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN ASM_REWRITE_TAC[INTERIOR_INTERVAL; SUBSET_EMPTY] THEN ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1]; REWRITE_TAC[SUBSET] THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN ASM_CASES_TAC `(z:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(f has_vector_derivative f'(z:real^1)) (at z) /\ &0 < drop(f' z)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &0 < x ==> F`)] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT THEN MAP_EVERY EXISTS_TAC [`f:real^1->real^1`; `z:real^1`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\w:real^1. (f:real^1->real^1) x` THEN EXISTS_TAC `interval(x:real^1,y)` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; OPEN_INTERVAL; HAS_VECTOR_DERIVATIVE_CONST] THEN ASM_MESON_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE]]]);; let POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT = prove (`!f:real^1->real^1 f' a b s. f absolutely_continuous_on interval[a,b] /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x) /\ &0 < drop(f' x)) ==> !x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y ==> drop(f x) < drop(f y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT_GEN THEN MAP_EVERY EXISTS_TAC [`f':real^1->real^1`; `interval[a:real^1,b] INTER s`] THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS; IS_INTERVAL_INTERVAL] THEN ASM_REWRITE_TAC[SET_RULE `i DIFF (i INTER s) = i DIFF s`] THEN CONJ_TAC THEN MATCH_MP_TAC NEGLIGIBLE_EMPTY_INTERIOR THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE)) THEN REWRITE_TAC[INTER_SUBSET; IS_INTERVAL_INTERVAL]] THEN ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]);; let POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN = prove (`!f:real^1->real^1 f' a b s. f continuous_on interval[a,b] /\ negligible(IMAGE f s) /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x) /\ &0 <= drop(f' x)) ==> !x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC POSITIVE_AE_DERIVATIVE_IMP_NONDECREASING THEN EXISTS_TAC `f':real^1->real^1` THEN EXISTS_TAC `s UNION {x | x IN interval[a,b] DIFF s /\ (f':real^1->real^1) x = vec 0}` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `x IN i DIFF (s UNION {x | x IN i DIFF s /\ P x}) <=> x IN i /\ ~P x /\ ~(x IN s)`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`; IN_DIFF] THEN SIMP_TAC[GSYM DROP_EQ; DROP_VEC] THEN MATCH_MP_TAC NEGLIGIBLE_EMPTY_INTERIOR THEN ASM_REWRITE_TAC[IMAGE_UNION; NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC BABY_SARD THEN EXISTS_TAC `\x h. drop h % (f':real^1->real^1) x` THEN REWRITE_TAC[LE_REFL; GSYM has_vector_derivative] THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_DIFF; HAS_VECTOR_DERIVATIVE_AT_WITHIN] THEN REWRITE_TAC[GSYM DET_EQ_0_RANK; DET_1] THEN SIMP_TAC[matrix; LAMBDA_BETA; LE_REFL; DIMINDEX_1] THEN SIMP_TAC[GSYM drop; DROP_CMUL; REAL_MUL_RZERO]);; let POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE = prove (`!f:real^1->real^1 f' a b s. f absolutely_continuous_on interval[a,b] /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative f' x) (at x) /\ &0 <= drop(f' x)) ==> !x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y ==> drop(f x) <= drop(f y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN THEN MAP_EVERY EXISTS_TAC [`f':real^1->real^1`; `interval[a:real^1,b] INTER s`] THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS; IS_INTERVAL_INTERVAL] THEN ASM_REWRITE_TAC[SET_RULE `i DIFF (i INTER s) = i DIFF s`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE)) THEN REWRITE_TAC[INTER_SUBSET; IS_INTERVAL_INTERVAL] THEN ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]);; let ZERO_AE_DERIVATIVE_IMP_CONSTANT_GEN = prove (`!f:real^1->real^1 a b s. f continuous_on interval[a,b] /\ negligible(IMAGE f s) /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative (vec 0)) (at x)) ==> !x. x IN interval[a,b] ==> f x = f a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `(\x. vec 0):real^1->real^1`] POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN) THEN MP_TAC(ISPECL [`(--) o (f:real^1->real^1)`; `(--) o (\x. vec 0):real^1->real^1`] POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`; `s:real^1->bool`]) THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; IMAGE_o; LINEAR_CONTINUOUS_ON; LINEAR_NEGATION; NEGLIGIBLE_LINEAR_IMAGE] THEN ASM_SIMP_TAC[DROP_VEC; REAL_LE_REFL; o_DEF; HAS_VECTOR_DERIVATIVE_NEG] THEN REWRITE_TAC[DROP_NEG; DROP_VEC; REAL_LE_REFL; REAL_NEG_0; REAL_LE_NEG2] THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `x:real^1`]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; GSYM REAL_LE_ANTISYM] THEN ASM_REAL_ARITH_TAC);; let ZERO_AE_DERIVATIVE_IMP_CONSTANT = prove (`!f:real^1->real^1 a b s. f absolutely_continuous_on interval[a,b] /\ negligible s /\ (!x. x IN interval[a,b] DIFF s ==> (f has_vector_derivative (vec 0)) (at x)) ==> !x. x IN interval[a,b] ==> f x = f a`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC ZERO_AE_DERIVATIVE_IMP_CONSTANT_GEN THEN EXISTS_TAC `interval[a:real^1,b] INTER s` THEN ASM_SIMP_TAC[ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS; IS_INTERVAL_INTERVAL] THEN ASM_REWRITE_TAC[SET_RULE `i DIFF (i INTER s) = i DIFF s`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE)) THEN REWRITE_TAC[INTER_SUBSET; IS_INTERVAL_INTERVAL] THEN ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Convergence in measure implies convergence AE of a subsequence. *) (* ------------------------------------------------------------------------- *) let CONVERGENCE_IN_MEASURE = prove (`!f:num->real^M->real^N g s. (!n. f n measurable_on s) /\ (!e. &0 < e ==> eventually (\n. ?t. {x | x IN s /\ dist(f n x,g x) >= e} SUBSET t /\ measurable t /\ measure t < e) sequentially) ==> ?r t. (!m n:num. m < n ==> r m < r n) /\ negligible t /\ t SUBSET s /\ !x. x IN s DIFF t ==> ((\n. f (r n) x) --> g x) sequentially`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?r. (!n. ?t. {x | x IN s /\ dist(f (r n) x,(g:real^M->real^N) x) >= inv(&2 pow n)} SUBSET t /\ measurable t /\ measure t < inv(&2 pow n)) /\ (!n. r n :num < r(SUC n))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `&1`); MAP_EVERY X_GEN_TAC [`n:num`; `p:num`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow (SUC n))`)] THEN ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_INV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THENL [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_THEN(MP_TAC o SPEC `m:num`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_REFL]; DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m + p + 1:num`)) THEN DISCH_THEN(fun th -> EXISTS_TAC `m + p + 1:num` THEN MP_TAC th) THEN REWRITE_TAC[LE_ADD; ARITH_RULE `p < m + p + 1`]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `t:num->real^M->bool` THEN STRIP_TAC] THEN EXISTS_TAC `s INTER INTERS {UNIONS {(t:num->real^M->bool) k | n <= k} | n IN (:num)}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN SIMP_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e / &2`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV; REAL_HALF] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `UNIONS {(t:num->real^M->bool) k | N <= k}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `x IN s ==> INTERS s SUBSET x`) THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[LE_EXISTS; SET_RULE `{f n | ?d. n = N + d} = {f(N + n) | n IN (:num)}`] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN TRANS_TAC REAL_LE_TRANS `sum(0..n) (\k. inv(&2 pow (N + k)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; SUM_LMUL; GSYM REAL_POW_INV] THEN REWRITE_TAC[SUM_GP; CONJUNCT1 LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_INV] THEN REWRITE_TAC[REAL_ARITH `x * y * &2 <= e <=> y * x <= e / &2`] THEN REWRITE_TAC[REAL_POW_INV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n < e / &2 ==> &0 <= x * n ==> (&1 - x) * n <= e / &2`)) THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_LE_INV_EQ; GSYM REAL_POW_ADD] THEN SIMP_TAC[REAL_POW_LE; REAL_POS]; REWRITE_TAC[INTER_SUBSET]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[SET_RULE `s DIFF (s INTER t) = s DIFF t`] THEN REWRITE_TAC[IN_DIFF; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N + M:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `x:real^M`]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; real_ge; REAL_NOT_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN TRANS_TAC REAL_LET_TRANS `inv(&2 pow M)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC]);; let CONVERGENCE_IN_MEASURE_UNIQUE = prove (`!f:num->real^M->real^N g h s. (!n. f n measurable_on s) /\ (!e. &0 < e ==> eventually (\n. ?t. {x | x IN s /\ dist(f n x,g x) >= e} SUBSET t /\ measurable t /\ measure t < e) sequentially) /\ (!e. &0 < e ==> eventually (\n. ?t. {x | x IN s /\ dist(f n x,h x) >= e} SUBSET t /\ measurable t /\ measure t < e) sequentially) ==> negligible {x | x IN s /\ ~(g x = h x)}`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "g") (LABEL_TAC "h")) THEN MP_TAC(ISPECL [`f:num->real^M->real^N`; `g:real^M->real^N`; `s:real^M->bool`] CONVERGENCE_IN_MEASURE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`r:num->num`; `t:real^M->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(f:num->real^M->real^N) o (r:num->num)`; `h:real^M->real^N`; `s:real^M->bool`] CONVERGENCE_IN_MEASURE) THEN ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "h" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `r:num->num` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_SUBSEQUENCE)) THEN ASM_REWRITE_TAC[o_DEF]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM]] THEN MAP_EVERY X_GEN_TAC [`r':num->num`; `t':real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t UNION t':real^M->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; SET_RULE `{x | x IN s /\ ~P x} SUBSET t <=> !x. x IN s DIFF t ==> P x`] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[SET_RULE `x IN s DIFF (t UNION t') <=> x IN s DIFF t /\ x IN s DIFF t'`] THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `((\n. (f:num->real^M->real^N) n x) o (r:num->num)) o (r':num->num)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_SUBSEQUENCE; ALL_TAC] THEN ASM_SIMP_TAC[o_DEF]);; (* ------------------------------------------------------------------------- *) (* Fubini-type results for measure. *) (* ------------------------------------------------------------------------- *) let FUBINI_MEASURE = prove (`!s:real^(M,N)finite_sum->bool. measurable s ==> negligible {x | ~measurable {y | pastecart x y IN s}} /\ ((\x. lift(measure {y | pastecart x y IN s})) has_integral lift(measure s)) UNIV`, let MEASURE_PASTECART_INTERVAL = prove (`!a b:real^(M,N)finite_sum. (!x. measurable {y | pastecart x y IN interval[a,b]}) /\ ((\x. lift(measure {y | pastecart x y IN interval[a,b]})) has_integral lift(measure(interval[a,b]))) UNIV`, REWRITE_TAC[FORALL_PASTECART] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `c:real^N`; `b:real^M`; `d:real^N`] THEN REWRITE_TAC[GSYM PCROSS_INTERVAL; PASTECART_IN_PCROSS] THEN REWRITE_TAC[SET_RULE `{x | P /\ Q x} = if P then {x | Q x} else {}`] THEN REWRITE_TAC[COND_RAND; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_EMPTY; COND_ID] THEN REWRITE_TAC[MEASURE_EMPTY; LIFT_NUM; HAS_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART] THEN REWRITE_TAC[LIFT_CMUL; HAS_INTEGRAL_CONST]) in let MEASURE_PASTECART_ELEMENTARY = prove (`!s:real^(M,N)finite_sum->bool. (?d. d division_of s) ==> (!x. measurable {y | pastecart x y IN s}) /\ ((\x. lift(measure {y | pastecart x y IN s})) has_integral lift(measure s)) UNIV`, let lemma = prove (`{x | f x IN UNIONS s} = UNIONS {{x | f x IN d} | d IN s}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in GEN_TAC THEN REWRITE_TAC[division_of; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:(real^(M,N)finite_sum->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[lemma] THEN CONJ_TAC THENL [X_GEN_TAC `s:real^M` THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `k:real^(M,N)finite_sum->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?a b:real^(M,N)finite_sum. k = interval[a,b]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[MEASURE_PASTECART_INTERVAL]; ALL_TAC] THEN SUBGOAL_THEN `((\x. vsum d (\k. lift(measure {y | pastecart x y IN k}))) has_integral vsum d (\k:real^(M,N)finite_sum->bool. lift(measure k))) UNIV` MP_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_VSUM THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:real^(M,N)finite_sum->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?a b:real^(M,N)finite_sum. k = interval[a,b]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[MEASURE_PASTECART_INTERVAL]; ALL_TAC] THEN MATCH_MP_TAC(MESON[HAS_INTEGRAL_SPIKE] `!t. negligible t /\ a = b /\ (!x. x IN s DIFF t ==> g x = f x) ==> (f has_integral a) s ==> (g has_integral b) s`) THEN EXISTS_TAC `UNIONS { {x | (x:real^M)$i = fstcart(interval_lowerbound k:real^(M,N)finite_sum)$i} | i IN 1..dimindex(:M) /\ k IN d} UNION UNIONS { {x | x$i = fstcart(interval_upperbound k)$i} | i IN 1..dimindex(:M) /\ k IN d}` THEN CONJ_TAC THENL [REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[CONJ_SYM] FINITE_PRODUCT_DEPENDENT; FINITE_NUMSEG] THEN SIMP_TAC[FORALL_IN_GSPEC; NEGLIGIBLE_STANDARD_HYPERPLANE; IN_NUMSEG]; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM LIFT_SUM); FUN_EQ_THM; LIFT_EQ] THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS; GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE] THEN ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN (CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_PASTECART_INTERVAL; MEASURABLE_INTERVAL]; ALL_TAC]) THEN MAP_EVERY X_GEN_TAC [`k:real^(M,N)finite_sum->bool`; `l:real^(M,N)finite_sum->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^(M,N)finite_sum->bool`; `l:real^(M,N)finite_sum->bool`]) THEN ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN (SUBGOAL_THEN `?a b:real^(M,N)finite_sum c d:real^(M,N)finite_sum. k = interval[a,b] /\ l = interval[c,d]` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; NEGLIGIBLE_CONVEX_INTERIOR; CONVEX_INTER; CONVEX_INTERVAL] THEN REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; PASTECART_IN_PCROSS] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P /\ Q x} INTER {x | R /\ S x} = {x | P /\ R} INTER {x | Q x /\ S x}`] THEN REWRITE_TAC[INTER_PCROSS; INTERIOR_PCROSS; GSYM INTER] THEN REWRITE_TAC[SET_RULE `{x | P} = if P then UNIV else {}`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[NEGLIGIBLE_EMPTY; INTER_EMPTY; INTER_UNIV] THEN SIMP_TAC[NEGLIGIBLE_CONVEX_INTERIOR; CONVEX_INTER; CONVEX_INTERVAL] THEN REWRITE_TAC[PCROSS_EQ_EMPTY; TAUT `(if p then q else T) <=> p ==> q`] THEN REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN SIMP_TAC[] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNION]) THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN DISCH_THEN(CONJUNCTS_THEN(fun th -> MP_TAC(SPEC `l:real^(M,N)finite_sum->bool` th) THEN MP_TAC(SPEC `k:real^(M,N)finite_sum->bool` th))) THEN REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[PCROSS_INTERVAL]) THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[TAUT `~a \/ b <=> a ==> b`] THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; FSTCART_PASTECART] THEN REPLICATE_TAC 3 (GEN_REWRITE_TAC I [IMP_IMP]) THEN MATCH_MP_TAC(TAUT `(a ==> c ==> ~b) ==> a ==> b ==> c ==> d`) THEN REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY; AND_FORALL_THM; INTERIOR_INTERVAL; IMP_IMP; INTER_INTERVAL] THEN MATCH_MP_TAC MONO_FORALL THEN SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN REAL_ARITH_TAC) in let MEASURE_PASTECART_OPEN_MEASURABLE = prove (`!s:real^(M,N)finite_sum->bool. open s /\ measurable s ==> negligible {x | ~measurable {y | pastecart x y IN s}} /\ ((\x. lift(measure {y | pastecart x y IN s})) has_integral lift(measure s)) UNIV`, let lemur = prove (`UNIONS {{y | pastecart x y IN g n} | n IN (:num)} = {y | pastecart x y IN UNIONS {g n | n IN (:num)}}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `g:num->real^(M,N)finite_sum->bool` STRIP_ASSUME_TAC o MATCH_MP OPEN_COUNTABLE_LIMIT_ELEMENTARY) THEN SUBGOAL_THEN `!n:num. g n SUBSET (s:real^(M,N)finite_sum->bool)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)})`; `(:real^M)`] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->bool) n` MEASURE_PASTECART_ELEMENTARY)) THEN ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LIFT_DROP] THEN ANTS_TAC THENL [CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_PASTECART_ELEMENTARY]; ALL_TAC]) THEN ASM SET_TAC[]; REWRITE_TAC[bounded; FORALL_IN_GSPEC; NORM_LIFT] THEN EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURE_POS_LE; MATCH_MP_TAC MEASURE_SUBSET] THEN ASM_MESON_TAC[MEASURABLE_ELEMENTARY]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^1`; `t:real^M->bool`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN SUBGOAL_THEN `!x:real^M. ~(x IN t) ==> {y:real^N | pastecart x y IN s} has_measure drop(f x)` ASSUME_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV; NORM_LIFT] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\n. {y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) n}`; `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN ASM_SIMP_TAC[lemur; REAL_ARITH `abs x <= B ==> x <= B`] THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; GSYM LIFT_EQ] THEN ASM_MESON_TAC[LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP]; CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[measurable] THEN ASM SET_TAC[]; MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^1`; `t:real^M->bool`] THEN ASM_REWRITE_TAC[NEGLIGIBLE; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\k. lift(measure ((g:num->real^(M,N)finite_sum->bool) k))` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MP_TAC(ISPECL [`g:num->real^(M,N)finite_sum->bool`; `measure(s:real^(M,N)finite_sum->bool)`] HAS_MEASURE_NESTED_UNIONS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[MEASURABLE_ELEMENTARY; MEASURE_SUBSET]]]) in let MEASURE_PASTECART_COMPACT = prove (`!s:real^(M,N)finite_sum->bool. compact s ==> (!x. measurable {y | pastecart x y IN s}) /\ ((\x. lift(measure {y | pastecart x y IN s})) has_integral lift(measure s)) UNIV`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC] THEN MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS]; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CONTINUOUS_PASTECART; CONTINUOUS_CONST; CONTINUOUS_AT_ID]]; DISCH_TAC] THEN SUBGOAL_THEN `?t:real^(M,N)finite_sum->bool. open t /\ measurable t /\ s SUBSET t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET_BALL; COMPACT_IMP_BOUNDED; MEASURABLE_BALL; OPEN_BALL]; ALL_TAC] THEN MP_TAC(ISPEC `t:real^(M,N)finite_sum->bool` MEASURE_PASTECART_OPEN_MEASURABLE) THEN MP_TAC(ISPEC `t DIFF s:real^(M,N)finite_sum->bool` MEASURE_PASTECART_OPEN_MEASURABLE) THEN ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_COMPACT; OPEN_DIFF; COMPACT_IMP_CLOSED; MEASURE_DIFF_SUBSET; IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[LIFT_SUB; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN REWRITE_TAC[VECTOR_ARITH `t - (t - s):real^1 = s`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE)) THEN EXISTS_TAC `{x | ~measurable {y | pastecart x y IN t DIFF s}} UNION {x:real^M | ~measurable {y:real^N | pastecart x y IN t}}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN SIMP_TAC[IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN STRIP_TAC THEN REWRITE_TAC[LIFT_EQ; GSYM LIFT_SUB] THEN ONCE_REWRITE_TAC[REAL_ARITH `a:real = b - c <=> c = b - a`] THEN REWRITE_TAC[SET_RULE `{y | pastecart x y IN t /\ ~(pastecart x y IN s)} = {y | pastecart x y IN t} DIFF {y | pastecart x y IN s}`] THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM SET_TAC[]) in GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `?f. (!n. compact(f n) /\ f n SUBSET s /\ measurable(f n) /\ measure s < measure(f n) + inv(&n + &1)) /\ (!n. (f:num->real^(M,N)finite_sum->bool) n SUBSET f(SUC n))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_INNER_COMPACT THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `t:real^(M,N)finite_sum->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^(M,N)finite_sum->bool`; `inv(&(SUC n) + &1)`] MEASURABLE_INNER_COMPACT) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t UNION u:real^(M,N)finite_sum->bool` THEN ASM_SIMP_TAC[COMPACT_UNION; UNION_SUBSET; MEASURABLE_UNION] THEN REWRITE_TAC[SUBSET_UNION] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `s < a + e ==> a <= b ==> s < b + e`)) THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_UNION; SUBSET_UNION]; ALL_TAC] THEN SUBGOAL_THEN `?g. (!n. open(g n) /\ s SUBSET g n /\ measurable(g n) /\ measure(g n) < measure s + inv(&n + &1)) /\ (!n. (g:num->real^(M,N)finite_sum->bool) (SUC n) SUBSET g n)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_OUTER_OPEN THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `t:real^(M,N)finite_sum->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^(M,N)finite_sum->bool`; `inv(&(SUC n) + &1)`] MEASURABLE_OUTER_OPEN) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t INTER u:real^(M,N)finite_sum->bool` THEN ASM_SIMP_TAC[OPEN_INTER; SUBSET_INTER; MEASURABLE_INTER] THEN REWRITE_TAC[INTER_SUBSET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a < s + e ==> b <= a ==> b < s + e`)) THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_INTER; INTER_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)}) - lift(measure {y:real^N | pastecart x y IN (f n)})`; `(:real^M)`] BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE) THEN MP_TAC(GEN `n:num` (ISPEC `(f:num->real^(M,N)finite_sum->bool) n` MEASURE_PASTECART_COMPACT)) THEN MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->bool) n` MEASURE_PASTECART_OPEN_MEASURABLE)) THEN ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; FORALL_AND_THM] THEN STRIP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; DROP_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRAL_SUB] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `n:num` THEN EXISTS_TAC `{x:real^M | ~measurable {y:real^N | pastecart x y IN g n}} UNION {x:real^M | ~measurable {y | pastecart x y IN g (SUC n)}}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_UNION; DE_MORGAN_THM] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `f <= f' /\ g' <= g ==> g' - f' <= g - f`) THEN CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN EXISTS_TAC `measure((g:num->real^(M,N)finite_sum->bool) 0) - measure((f:num->real^(M,N)finite_sum->bool) 0)` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `!s. f' <= s /\ s <= g' /\ f <= f' /\ g' <= g ==> abs(g' - f') <= g - f`) THEN EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN MP_TAC(ARITH_RULE `0 <= n`) THEN SPEC_TAC(`n:num`,`n:num`) THEN SPEC_TAC(`0`,`m:num`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`h:real^M->real^1`; `k:real^M->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?t. negligible t /\ (!n x. ~(x IN t) ==> measurable {y:real^N | pastecart x y IN g n}) /\ (!x. ~(x IN t) ==> ((\k. lift(measure {y | pastecart x y IN g k}) - lift(measure {y:real^N | pastecart x y IN f k})) --> vec 0) sequentially) /\ (!x. ~(x IN t) ==> (h:real^M->real^1) x = vec 0)` MP_TAC THENL [MP_TAC(ISPECL [`\x. if x IN UNIONS{ {x | ~measurable {y:real^N | pastecart x y IN g n}} | n IN (:num)} UNION k then vec 0 else (h:real^M->real^1) x`; `(:real^M)`] HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN REWRITE_TAC[IN_UNIV; DIMINDEX_1; FORALL_1] THEN ANTS_TAC THENL [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN COND_CASES_TAC THEN REWRITE_TAC[VEC_COMPONENT; REAL_LE_REFL] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_LBOUND) THEN EXISTS_TAC `\k:num. lift(measure {y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) k}) - lift(measure {y | pastecart x y IN (f:num->real^(M,N)finite_sum->bool) k})` THEN REWRITE_TAC[DIMINDEX_1; TRIVIAL_LIMIT_SEQUENTIALLY; LE_REFL] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM drop; DROP_SUB; LIFT_DROP] THEN REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_GSPEC]) THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `h:real^M->real^1` THEN EXISTS_TAC `UNIONS{ {x | ~measurable {y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) n}} | n IN (:num)} UNION k` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNION; IN_UNIV] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IN_UNIV] NEGLIGIBLE_COUNTABLE_UNIONS) THEN ASM_REWRITE_TAC[]; MESON_TAC[]; ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\k. lift(measure((g:num->real^(M,N)finite_sum->bool) k)) - lift(measure((f:num->real^(M,N)finite_sum->bool) k))` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[LIM_SEQUENTIALLY; GSYM LIFT_SUB; DIST_0; NORM_LIFT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `!s d. f <= s /\ s <= g /\ s < f + d /\ g < s + d /\ d <= e / &2 ==> abs(g - f) < e`) THEN EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_SUBSET]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `inv(&N)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]; DISCH_TAC THEN EXISTS_TAC `{x | ~((if x IN UNIONS {{x | ~measurable {y | pastecart x y IN g n}} | n | T} UNION k then vec 0 else (h:real^M->real^1) x) = vec 0)} UNION UNIONS {{x | ~measurable {y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) n}} | n | T} UNION k` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN ASM_SIMP_TAC[IN_UNION; DE_MORGAN_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[IN_UNIV] NEGLIGIBLE_COUNTABLE_UNIONS) THEN ASM_REWRITE_TAC[]; CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]]; FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`) THEN STRIP_TAC] THEN SUBGOAL_THEN `!x:real^M. ~(x IN t) ==> measurable {y:real^N | pastecart x y IN s}` ASSUME_TAC THENL [REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^M` th) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[DIST_0] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN REWRITE_TAC[LE_REFL; GSYM LIFT_SUB; NORM_LIFT] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`{y | pastecart x y IN (f:num->real^(M,N)finite_sum->bool) N}`; `{y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) N}`] THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)})`; `\x:real^M. lift(measure {y:real^N | pastecart x y IN s})`; `(:real^M)`; `t:real^M->bool`] MONOTONE_CONVERGENCE_DECREASING_AE) THEN ASM_REWRITE_TAC[LIFT_DROP; IN_UNIV; IN_DIFF] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[IN_DIFF] THEN ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^M` th) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[DIST_0] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[DIST_LIFT; GSYM dist] THEN MATCH_MP_TAC(REAL_ARITH `f <= s /\ s <= g ==> abs(g - f) < e ==> abs(g - s) < e`) THEN CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[IN_DIFF] THEN ASM SET_TAC[]; REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN EXISTS_TAC `measure((g:num->real^(M,N)finite_sum->bool) 0)` THEN ASM_SIMP_TAC[NORM_LIFT; real_abs; MEASURE_POS_LE] THEN X_GEN_TAC `m:num` THEN MP_TAC(ARITH_RULE `0 <= m`) THEN SPEC_TAC(`m:num`,`m:num`) THEN SPEC_TAC(`0`,`n:num`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REPEAT(CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[]]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\k. lift(measure((g:num->real^(M,N)finite_sum->bool) k))` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_LIFT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `!d. g < s + d /\ s <= g /\ d < e ==> abs(g - s) < e`) THEN EXISTS_TAC `inv(&n + &1)` THEN ASM_SIMP_TAC[MEASURE_SUBSET] THEN TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]);; let FUBINI_MEASURE_ALT = prove (`!s:real^(M,N)finite_sum->bool. measurable s ==> negligible {y | ~measurable {x | pastecart x y IN s}} /\ ((\y. lift(measure {x | pastecart x y IN s})) has_integral lift(measure s)) UNIV`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z)) (s:real^(M,N)finite_sum->bool)` FUBINI_MEASURE) THEN MP_TAC(ISPEC `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)` HAS_MEASURE_ISOMETRY) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]; DISCH_TAC THEN ASM_REWRITE_TAC[measurable; measure] THEN ASM_REWRITE_TAC[GSYM measurable; GSYM measure] THEN REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);; let FUBINI_LEBESGUE_MEASURABLE = prove (`!s:real^(M,N)finite_sum->bool. lebesgue_measurable s ==> negligible {x | ~lebesgue_measurable {y | pastecart x y IN s}}`, let lemma = prove (`{x | ?n. P n x} = UNIONS {{x | P n x} | n IN (:num)}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_COUNTABLE_INTERVALS] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS] THEN REWRITE_TAC[INTER; IN_ELIM_THM; NOT_FORALL_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN MP_TAC(ISPEC `(s:real^(M,N)finite_sum->bool) INTER (interval[--vec m,vec m] PCROSS interval[--vec n,vec n])` FUBINI_MEASURE) THEN ANTS_TAC THENL [REWRITE_TAC[PCROSS_INTERVAL] THEN ASM_MESON_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS]; DISCH_THEN(MP_TAC o CONJUNCT1)] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM_CASES_TAC `(x:real^M) IN interval[--vec m,vec m]` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);; let FUBINI_LEBESGUE_MEASURABLE_ALT = prove (`!s:real^(M,N)finite_sum->bool. lebesgue_measurable s ==> negligible {y | ~lebesgue_measurable {x | pastecart x y IN s}}`, let lemma = prove (`{x | ?n. P n x} = UNIONS {{x | P n x} | n IN (:num)}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_COUNTABLE_INTERVALS] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS] THEN REWRITE_TAC[INTER; IN_ELIM_THM; NOT_FORALL_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `m:num` THEN MP_TAC(ISPEC `(s:real^(M,N)finite_sum->bool) INTER (interval[--vec m,vec m] PCROSS interval[--vec n,vec n])` FUBINI_MEASURE_ALT) THEN ANTS_TAC THENL [REWRITE_TAC[PCROSS_INTERVAL] THEN ASM_MESON_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS]; DISCH_THEN(MP_TAC o CONJUNCT1)] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM_CASES_TAC `(y:real^N) IN interval[--vec n,vec n]` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);; let FUBINI_NEGLIGIBLE = prove (`!s. negligible s ==> negligible {x:real^M | ~negligible {y:real^N | pastecart x y IN s}}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE o MATCH_MP NEGLIGIBLE_IMP_MEASURABLE) THEN ASM_SIMP_TAC[MEASURE_EQ_0; LIFT_NUM; IMP_CONJ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x:real^M. lift (measure {y:real^N | pastecart x y IN s})`; `(:real^M)`; `{x:real^M | ~measurable {y:real^N | pastecart x y IN s}}`] HAS_INTEGRAL_NEGLIGIBLE_EQ_AE) THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN SIMP_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop; LIFT_DROP; IN_UNIV] THEN ASM_SIMP_TAC[MEASURE_POS_LE; IMP_CONJ] THEN DISCH_THEN(K ALL_TAC) THEN UNDISCH_TAC `negligible {x:real^M | ~measurable {y:real^N | pastecart x y IN s}}` THEN REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[HAS_MEASURE_MEASURE; GSYM HAS_MEASURE_0] THEN SET_TAC[]);; let FUBINI_NEGLIGIBLE_ALT = prove (`!s. negligible s ==> negligible {y:real^N | ~negligible {x:real^M | pastecart x y IN s}}`, let lemma = prove (`!s:real^(M,N)finite_sum->bool. negligible s ==> negligible (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_GEN THEN ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM; LE_REFL] THEN REWRITE_TAC[linear; FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL; GSYM PASTECART_ADD; GSYM PASTECART_CMUL]) in GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_NEGLIGIBLE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[UNWIND_THM1; UNWIND_THM2]);; let NEGLIGIBLE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. negligible(s PCROSS t) <=> negligible s \/ negligible t`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_NEGLIGIBLE) THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN REWRITE_TAC[SET_RULE `{y | P /\ Q y} = if P then {y | Q y} else {}`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN ASM_CASES_TAC `negligible(t:real^N->bool)` THEN ASM_REWRITE_TAC[SET_RULE `~(if P then F else T) = P`; SET_RULE `{x | x IN s} = s`]; ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; INTER_PCROSS] THEN MAP_EVERY X_GEN_TAC [`aa:real^M`; `a:real^N`; `bb:real^M`; `b:real^N`] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `(s:real^M->bool) PCROSS interval[a:real^N,b]` THEN REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `e / (content(interval[a:real^N,b]) + &1)`] MEASURABLE_OUTER_CLOSED_INTERVALS) THEN ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_LT_DIV; CONTENT_POS_LE; MEASURE_EQ_0; REAL_ADD_LID; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `UNIONS { (k:real^M->bool) PCROSS interval[a:real^N,b] | k IN d}` THEN ASM_REWRITE_TAC[GSYM PCROSS_UNIONS; SUBSET_PCROSS; SUBSET_REFL] THEN REWRITE_TAC[PCROSS_UNIONS] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `D:(real^M->bool)->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL; SUBSET]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN TRANS_TAC REAL_LE_TRANS `sum D (\k:real^M->bool. measure k * content(interval[a:real^N,b]))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ASM_REWRITE_TAC[]] THEN ASM_REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART]; REWRITE_TAC[SUM_RMUL]] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x * (y + &1) <= e ==> x * y <= e`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE THEN ASM_MESON_TAC[MEASURE_POS_LE; SUBSET; MEASURABLE_INTERVAL]; SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < x + &1`; CONTENT_POS_LE]] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN TRANS_TAC REAL_LE_TRANS `measure(UNIONS D:real^M->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[SUBSET_UNIONS] THEN ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_INTERVAL; SUBSET]] THEN TRANS_TAC EQ_TRANS `sum (D:(real^M->bool)->bool) content` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_ELEMENTARY THEN REWRITE_TAC[division_of] THEN ASM SET_TAC[]]; ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; INTER_PCROSS] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `aa:real^N`; `b:real^M`; `bb:real^N`] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `interval[a:real^M,b] PCROSS (t:real^N->bool)` THEN REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`t:real^N->bool`; `e / (content(interval[a:real^M,b]) + &1)`] MEASURABLE_OUTER_CLOSED_INTERVALS) THEN ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_LT_DIV; CONTENT_POS_LE; MEASURE_EQ_0; REAL_ADD_LID; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `UNIONS { interval[a:real^M,b] PCROSS (k:real^N->bool) | k IN d}` THEN ASM_REWRITE_TAC[GSYM PCROSS_UNIONS; SUBSET_PCROSS; SUBSET_REFL] THEN REWRITE_TAC[PCROSS_UNIONS] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `D:(real^N->bool)->bool` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o lhand o snd) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL; SUBSET]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN TRANS_TAC REAL_LE_TRANS `sum D (\k:real^N->bool. content(interval[a:real^M,b]) * measure k)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^N. k = interval[u,v]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ASM_REWRITE_TAC[]] THEN ASM_REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART]; REWRITE_TAC[SUM_LMUL]] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x * (y + &1) <= e ==> y * x <= e`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE THEN ASM_MESON_TAC[MEASURE_POS_LE; SUBSET; MEASURABLE_INTERVAL]; SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < x + &1`; CONTENT_POS_LE]] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN TRANS_TAC REAL_LE_TRANS `measure(UNIONS D:real^N->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE; MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[SUBSET_UNIONS] THEN ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_INTERVAL; SUBSET]] THEN TRANS_TAC EQ_TRANS `sum (D:(real^N->bool)->bool) content` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_ELEMENTARY THEN REWRITE_TAC[division_of] THEN ASM SET_TAC[]]]);; let FUBINI_TONELLI_MEASURE = prove (`!s:real^(M,N)finite_sum->bool. lebesgue_measurable s ==> (measurable s <=> negligible {x | ~measurable {y | pastecart x y IN s}} /\ (\x. lift(measure {y | pastecart x y IN s})) integrable_on UNIV)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[FUBINI_MEASURE; integrable_on]; STRIP_TAC] THEN MP_TAC(ISPECL [`\n. s INTER ball(vec 0:real^(M,N)finite_sum,&n)`; `drop(integral (:real^M) (\x. lift (measure {y:real^N | pastecart x y IN s})))`] MEASURABLE_NESTED_UNIONS) THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_BALL; GSYM REAL_OF_NUM_SUC; SUBSET_BALL; REAL_ARITH `x <= x + &1`; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN ANTS_TAC THENL [X_GEN_TAC `n:num` THEN MP_TAC(SPEC `s INTER ball(vec 0:real^(M,N)finite_sum,&n)` FUBINI_MEASURE) THEN ASM_SIMP_TAC[MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; MEASURABLE_BALL; HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC INTEGRAL_DROP_LE_AE THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `{x:real^M | ~measurable {y:real^N | pastecart x y IN s}} UNION {x:real^M | ~measurable {y:real^N | pastecart x y IN s INTER ball (vec 0,&n)}}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNIV; DE_MORGAN_THM; IN_UNION; IN_ELIM_THM; LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[UNIONS_GSPEC; IN_INTER; IN_BALL_0; IN_UNIV] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[REAL_ARCH_LT]]);; let FUBINI_TONELLI_MEASURE_ALT = prove (`!s:real^(M,N)finite_sum->bool. lebesgue_measurable s ==> (measurable s <=> negligible {y | ~measurable {x | pastecart x y IN s}} /\ (\y. lift(measure {x | pastecart x y IN s})) integrable_on UNIV)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z)) (s:real^(M,N)finite_sum->bool)` FUBINI_TONELLI_MEASURE) THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART; DIMINDEX_FINITE_SUM; ARITH_RULE `m + n:num <= n + m`] THEN MP_TAC(ISPEC `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)` HAS_MEASURE_ISOMETRY) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]; DISCH_TAC THEN ASM_REWRITE_TAC[measurable; measure] THEN ASM_REWRITE_TAC[GSYM measurable; GSYM measure] THEN REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);; let FUBINI_TONELLI_NEGLIGIBLE = prove (`!s:real^(M,N)finite_sum->bool. lebesgue_measurable s ==> (negligible s <=> negligible {x | ~negligible {y | pastecart x y IN s}})`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[FUBINI_NEGLIGIBLE] THEN DISCH_TAC THEN REWRITE_TAC[NEGLIGIBLE_EQ_MEASURE_0] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[FUBINI_TONELLI_MEASURE] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; CONTRAPOS_THM; NEGLIGIBLE_IMP_MEASURABLE]; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE)]; DISCH_TAC THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FUBINI_MEASURE) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_UNIQUE)) THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE] THEN EXISTS_TAC `(\x. vec 0):real^M->real^1` THEN EXISTS_TAC `{x:real^M | ~negligible {y:real^N | pastecart x y IN s}}` THEN ASM_REWRITE_TAC[INTEGRABLE_0; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN SIMP_TAC[MEASURE_EQ_0; GSYM DROP_EQ; DROP_VEC; LIFT_DROP; HAS_INTEGRAL_0]);; let FUBINI_TONELLI_NEGLIGIBLE_ALT = prove (`!s:real^(M,N)finite_sum->bool. lebesgue_measurable s ==> (negligible s <=> negligible {y | ~negligible {x | pastecart x y IN s}})`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z)) (s:real^(M,N)finite_sum->bool)` FUBINI_TONELLI_NEGLIGIBLE) THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART; DIMINDEX_FINITE_SUM; ARITH_RULE `m + n:num <= n + m`] THEN MP_TAC(ISPEC `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)` HAS_MEASURE_ISOMETRY) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]; DISCH_TAC THEN ASM_REWRITE_TAC[HAS_MEASURE_0] THEN ASM_REWRITE_TAC[GSYM HAS_MEASURE_0] THEN REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);; let LEBESGUE_MEASURABLE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. lebesgue_measurable(s PCROSS t) <=> negligible s \/ negligible t \/ (lebesgue_measurable s /\ lebesgue_measurable t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `negligible(s:real^M->bool)` THENL [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; ASM_REWRITE_TAC[]] THEN ASM_CASES_TAC `negligible(t:real^N->bool)` THENL [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[lebesgue_measurable; measurable_on; IN_UNIV] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`k:real^(M,N)finite_sum->bool`; `g:num->real^(M,N)finite_sum->real^1`] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> ASSUME_TAC(MATCH_MP FUBINI_NEGLIGIBLE th) THEN ASSUME_TAC(MATCH_MP FUBINI_NEGLIGIBLE_ALT th)) THEN SUBGOAL_THEN `~(s SUBSET {x:real^M | ~negligible {y:real^N | pastecart x y IN k}})` MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `~(t SUBSET {y:real^N | ~negligible {x:real^M | pastecart x y IN k}})` MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET; NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{x:real^M | pastecart x (y:real^N) IN k}` THEN EXISTS_TAC `\n x. (g:num->real^(M,N)finite_sum->real^1) n (pastecart x y)` THEN EXISTS_TAC `{y:real^N | pastecart (x:real^M) y IN k}` THEN EXISTS_TAC `\n y. (g:num->real^(M,N)finite_sum->real^1) n (pastecart x y)` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THEN (CONJ_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ALL_TAC]) THENL [X_GEN_TAC `u:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (u:real^M) (y:real^N)`); X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (x:real^M) (v:real^N)`)] THEN ASM_REWRITE_TAC[indicator; PASTECART_IN_PCROSS]; MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `f:num->real^M->real^1`; `v:real^N->bool`; `g:num->real^N->real^1`] THEN STRIP_TAC THEN EXISTS_TAC `u PCROSS (:real^N) UNION (:real^M) PCROSS v` THEN EXISTS_TAC `\n:num z:real^(M,N)finite_sum. lift(drop(f n (fstcart z)) * drop(g n (sndcart z)))` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_PCROSS] THEN CONJ_TAC THENL [GEN_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; REWRITE_TAC[FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_UNIV; DE_MORGAN_THM; LIFT_CMUL; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN SUBGOAL_THEN `indicator (s PCROSS t) (pastecart x y) = drop(indicator s (x:real^M)) % indicator t (y:real^N)` SUBST1_TAC THENL [REWRITE_TAC[indicator; PASTECART_IN_PCROSS] THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(y:real^N) IN t`] THEN ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN ASM_SIMP_TAC[]]]]);; let MEASURABLE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. measurable(s PCROSS t) <=> negligible s \/ negligible t \/ (measurable s /\ measurable t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `negligible(s:real^M->bool)` THENL [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_MEASURABLE]; ASM_REWRITE_TAC[]] THEN ASM_CASES_TAC `negligible(t:real^N->bool)` THENL [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_MEASURABLE]; ASM_REWRITE_TAC[]] THEN ASM_CASES_TAC `lebesgue_measurable((s:real^M->bool) PCROSS (t:real^N->bool))` THENL [ASM_SIMP_TAC[FUBINI_TONELLI_MEASURE; PASTECART_IN_PCROSS]; ASM_MESON_TAC[LEBESGUE_MEASURABLE_PCROSS; MEASURABLE_IMP_LEBESGUE_MEASURABLE]] THEN REWRITE_TAC[SET_RULE `{x | P /\ x IN s} = if P then s else {}`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURABLE_EMPTY; MEASURE_EMPTY] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[LIFT_NUM; INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST] THEN REWRITE_TAC[SET_RULE `{x | if x IN s then P else F} = if P then s else {}`] THEN ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `measurable(t:real^N->bool)` THEN ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_MESON_TAC[NEGLIGIBLE_EQ_MEASURE_0]);; let HAS_MEASURE_PCROSS = prove (`!s:real^M->bool t:real^N->bool a b. s has_measure a /\ t has_measure b ==> (s PCROSS t) has_measure (a * b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(s:real^M->bool) PCROSS (t:real^N->bool)` FUBINI_MEASURE) THEN REWRITE_TAC[MEASURABLE_PCROSS; PASTECART_IN_PCROSS] THEN ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{y | P /\ y IN s} = if P then s else {}`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURABLE_EMPTY; MEASURE_EMPTY] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[LIFT_NUM; INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST] THEN REWRITE_TAC[SET_RULE `{x | if x IN s then P else F} = if P then s else {}`] THEN REWRITE_TAC[HAS_INTEGRAL_RESTRICT_UNIV] THEN STRIP_TAC THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_PCROSS] THEN CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN REWRITE_TAC[GSYM LIFT_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_UNIQUE)) THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN ASM_REWRITE_TAC[LIFT_EQ_CMUL] THEN MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL] THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN ASM_REWRITE_TAC[GSYM HAS_MEASURE; HAS_MEASURE_MEASURABLE_MEASURE]);; let MEASURE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. measurable s /\ measurable t ==> measure(s PCROSS t) = measure s * measure t`, MESON_TAC[HAS_MEASURE_MEASURABLE_MEASURE; HAS_MEASURE_PCROSS]);; (* ------------------------------------------------------------------------- *) (* Relate the measurability of a function and of its ordinate set. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE = prove (`!f:real^M->real^N k. f measurable_on (:real^M) ==> lebesgue_measurable {pastecart x (y:real^N) | y$k <= (f x)$k}`, let lemma = prove (`!x y. x <= y <=> !q. rational q /\ y < q ==> x < q`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LET_TRANS]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE; NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN MESON_TAC[RATIONAL_BETWEEN; REAL_LT_IMP_LE]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `{pastecart (x:real^M) (y:real^N) | y$k <= (f x:real^N)$k} = INTERS {{pastecart x y | (f x)$k < q ==> y$k < q} | q IN rational}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; EXTENSION; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN ONCE_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN MESON_TAC[lemma; IN]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_RATIONAL] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[SET_RULE `{f x y | P x y ==> Q x y} = {f x y | Q x y} UNION {f x y | ~(P x y)}`] THEN X_GEN_TAC `q:real` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN REWRITE_TAC[REAL_NOT_LT; GSYM PCROSS; LEBESGUE_MEASURABLE_PCROSS; SET_RULE `{f x y |x,y| P x} = {f x y | x IN {x | P x} /\ y IN UNIV}`; SET_RULE `{f x y |x,y| Q y} = {f x y | x IN UNIV /\ y IN {x | Q x}}`] THEN CONJ_TAC THEN REPEAT DISJ2_TAC THEN REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THENL [MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT]; ONCE_REWRITE_TAC[SET_RULE `{x | q <= (f x)$k} = {x | f x IN {y | q <= y$k}}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_PREIMAGE_CLOSED THEN ASM_REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]]);; let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT = prove (`!f:real^M->real^N k. f measurable_on (:real^M) ==> lebesgue_measurable {pastecart x (y:real^N) | y$k < (f x)$k}`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `f < y <=> ~(--f <= --y)`] THEN MP_TAC(ISPECL [`(--) o (f:real^M->real^N)`; `k:num`] LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE) THEN ANTS_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN SIMP_TAC[CONTINUOUS_ON_NEG; CONTINUOUS_ON_ID]; ALL_TAC] THEN MP_TAC(ISPEC `\z:real^(M,N)finite_sum. pastecart (fstcart z) (--sndcart z)` LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; PASTECART_INJ; VECTOR_EQ_NEG2; GSYM PASTECART_EQ] THEN ANTS_TAC THENL [REWRITE_TAC[linear; PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; SNDCART_CMUL] THEN VECTOR_ARITH_TAC; DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th])] THEN GEN_REWRITE_TAC LAND_CONV [GSYM LEBESGUE_MEASURABLE_COMPL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[SET_RULE `UNIV DIFF s = t <=> s = UNIV DIFF t`] THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_PASTECART_THM; o_DEF; FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_NEG_NEG] THEN MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VECTOR_NEG_NEG]);; let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ, LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ = (CONJ_PAIR o prove) (`(!f:real^M->real^N. f measurable_on (:real^M) <=> !k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {pastecart x (y:real^N) | y$k <= (f x)$k}) /\ (!f:real^M->real^N. f measurable_on (:real^M) <=> lebesgue_measurable {pastecart x (y:real^N) | !k. 1 <= k /\ k <= dimindex(:N) ==> y$k <= (f x)$k})`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THEN DISCH_TAC THENL [ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE]; SUBGOAL_THEN `{ pastecart x y | !k. 1 <= k /\ k <= dimindex(:N) ==> (y:real^N)$k <= (f:real^M->real^N) x$k } = INTERS {{ pastecart x y | (y:real^N)$k <= (f:real^M->real^N) x$k} | k IN 1..dimindex(:N)}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_INJ] THEN MESON_TAC[]; MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG]]; MP_TAC(ISPECL [`f:real^M->real^N`; `{y | lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex (:N) ==> (y:real^N)$k <= (f:real^M->real^N) x$k}}`] MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE) THEN ASM_REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_LEBESGUE_MEASURABLE_ALT) THEN REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV DIFF s = {}`] THEN REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; NEGLIGIBLE_EMPTY_INTERIOR]]);; let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ, LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ = (CONJ_PAIR o prove) (`(!f:real^M->real^N. f measurable_on (:real^M) <=> !k. 1 <= k /\ k <= dimindex(:N) ==> lebesgue_measurable {pastecart x (y:real^N) | y$k < (f x)$k}) /\ (!f:real^M->real^N. f measurable_on (:real^M) <=> lebesgue_measurable {pastecart x (y:real^N) | !k. 1 <= k /\ k <= dimindex(:N) ==> y$k < (f x)$k})`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THEN DISCH_TAC THENL [ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT]; SUBGOAL_THEN `{ pastecart x y | !k. 1 <= k /\ k <= dimindex(:N) ==> (y:real^N)$k < (f:real^M->real^N) x$k } = INTERS {{ pastecart x y | (y:real^N)$k < (f:real^M->real^N) x$k} | k IN 1..dimindex(:N)}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_INJ] THEN MESON_TAC[]; MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG]]; MP_TAC(ISPECL [`f:real^M->real^N`; `{y | lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex (:N) ==> (y:real^N)$k < (f:real^M->real^N) x$k}}`] MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE) THEN ASM_REWRITE_TAC[IN_ELIM_THM; real_gt] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_LEBESGUE_MEASURABLE_ALT) THEN REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV DIFF s = {}`] THEN REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; NEGLIGIBLE_EMPTY_INTERIOR]]);; let NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH = prove (`!f:real^M->real^N. f measurable_on (:real^M) ==> negligible {pastecart x y | f x = y}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_DISJOINT_TRANSLATES THEN EXISTS_TAC `{pastecart (vec 0:real^M) x | x IN (:real^N)}` THEN EXISTS_TAC `vec 0:real^(M,N)finite_sum` THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `{pastecart x y | (f:real^M->real^N) x = y} = INTERS {{pastecart x y | y$i <= (f x)$i} DIFF {pastecart x y | y$i < (f x)$i} | i IN 1..dimindex(:N)}` SUBST1_TAC THENL [REWRITE_TAC[CART_EQ; INTERS_GSPEC; EXTENSION; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_NUMSEG] THEN ONCE_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF; REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_ANTISYM] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN SIMP_TAC[FINITE_IMAGE; SIMPLE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT]; MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN REWRITE_TAC[GSYM PCROSS; SET_RULE `{f a x | x IN s} = {f w x | w IN {a} /\ x IN s}`] THEN REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS] THEN REWRITE_TAC[CONNECTED_SING; CONNECTED_PCROSS_EQ; CONNECTED_UNIV] THEN REWRITE_TAC[IN_SING; IN_UNIV] THEN MATCH_MP_TAC(SET_RULE `!a b. a IN s /\ b IN s /\ ~(a = b) ==> ~(?a. s = {a})`) THEN EXISTS_TAC `pastecart (vec 0:real^M) (vec 0:real^N)` THEN EXISTS_TAC `pastecart (vec 0:real^M) (vec 1:real^N)` THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING; IN_UNIV] THEN REWRITE_TAC[PASTECART_INJ; VEC_EQ; ARITH_EQ]; REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; PASTECART_INJ] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; PASTECART_INJ; FORALL_IN_IMAGE; SET_RULE `DISJOINT s t <=> !x. x IN s ==> !y. y IN t ==> ~(x = y)`] THEN REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID; PASTECART_INJ] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x':real^M`; `y':real^N`] THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN ASM_CASES_TAC `x':real^M = x` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(a:real^N = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN CONV_TAC VECTOR_ARITH]);; (* ------------------------------------------------------------------------- *) (* Hence relate integrals and "area under curve" for functions into R^+. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE = prove (`!f:real^N->real^1. (!x. &0 <= drop(f x)) ==> (f measurable_on (:real^N) <=> lebesgue_measurable { pastecart x y | y IN interval[vec 0,f x]})`, REPEAT STRIP_TAC THEN REWRITE_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; IN_INTERVAL_1; GSYM drop; DROP_VEC] THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `{pastecart x y | &0 <= drop y /\ drop y <= drop (f x)} = (:real^N) PCROSS {y | &0 <= drop y} INTER {pastecart (x:real^N) y | drop y <= drop (f x)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_INTER; IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM]; MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED; GSYM real_ge; drop; CLOSED_HALFSPACE_COMPONENT_GE]]; SUBGOAL_THEN `{pastecart (x:real^N) y | drop y <= drop (f x)} = {pastecart x y | &0 <= drop y /\ drop y <= drop (f x)} UNION (:real^N) PCROSS {y | drop y < &0}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_NOT_LE; REAL_LT_IMP_LE; REAL_LE_TRANS]; MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN SIMP_TAC[LEBESGUE_MEASURABLE_OPEN; drop; OPEN_HALFSPACE_COMPONENT_LT]]]);; let INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE = prove (`!f:real^N->real^1. (!x. &0 <= drop(f x)) ==> (f integrable_on (:real^N) <=> measurable { pastecart x y | y IN interval[vec 0,f x]})`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) FUBINI_TONELLI_MEASURE o snd) THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN ASM_SIMP_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN REWRITE_TAC[MEASURABLE_INTERVAL; EMPTY_GSPEC; NEGLIGIBLE_EMPTY] THEN ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN SUBGOAL_THEN `{pastecart x y | y IN interval [vec 0,f x]} = {pastecart x y | drop y <= drop(f x)} INTER (:real^N) PCROSS {x | &0 <= drop x}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM; PASTECART_IN_PCROSS; IN_UNIV] THEN REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; DROP_VEC; CONJ_SYM]; MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN REWRITE_TAC[drop] THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; INTEGRABLE_IMP_MEASURABLE; LEBESGUE_MEASURABLE_PCROSS] THEN REPEAT DISJ2_TAC THEN REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED THEN REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]]; FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN ASM_SIMP_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN REWRITE_TAC[ETA_AX; GSYM LIFT_EQ] THEN MESON_TAC[integrable_on]]);; let HAS_INTEGRAL_MEASURE_UNDER_CURVE = prove (`!f:real^N->real^1 m. (!x. &0 <= drop(f x)) ==> ((f has_integral lift m) (:real^N) <=> { pastecart x y | y IN interval[vec 0,f x]} has_measure m)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN MATCH_MP_TAC(TAUT `(p <=> p') /\ (p /\ p' ==> (q <=> q')) ==> (p /\ q <=> p' /\ q')`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE]; STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN ASM_REWRITE_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN REWRITE_TAC[ETA_AX; GSYM LIFT_EQ] THEN ASM_MESON_TAC[integrable_on; INTEGRAL_UNIQUE]);; (* ------------------------------------------------------------------------- *) (* Some miscellanous lemmas. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_COMPOSE_FSTCART = prove (`!f:real^M->real^P. f measurable_on (:real^M) ==> (\z:real^(M,N)finite_sum. f(fstcart z)) measurable_on (:real^(M,N)finite_sum)`, GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:num->real^M->real^P`] THEN STRIP_TAC THEN EXISTS_TAC `(k:real^M->bool) PCROSS (:real^N)` THEN EXISTS_TAC `(\n z. g n (fstcart z)):num->real^(M,N)finite_sum->real^P` THEN ASM_REWRITE_TAC[NEGLIGIBLE_PCROSS; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNIV; FSTCART_PASTECART; SNDCART_PASTECART] THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]);; let MEASURABLE_ON_COMPOSE_SNDCART = prove (`!f:real^N->real^P. f measurable_on (:real^N) ==> (\z:real^(M,N)finite_sum. f(sndcart z)) measurable_on (:real^(M,N)finite_sum)`, GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `g:num->real^N->real^P`] THEN STRIP_TAC THEN EXISTS_TAC `(:real^M) PCROSS (k:real^N->bool)` THEN EXISTS_TAC `(\n z. g n (sndcart z)):num->real^(M,N)finite_sum->real^P` THEN ASM_REWRITE_TAC[NEGLIGIBLE_PCROSS; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNIV; SNDCART_PASTECART; SNDCART_PASTECART] THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]);; let MEASURABLE_ON_COMPOSE_SUB = prove (`!f:real^M->real^N. f measurable_on (:real^M) ==> (\z. f(fstcart z - sndcart z)) measurable_on (:real^(M,M)finite_sum)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\z. f(fstcart z - sndcart z)):real^(M,M)finite_sum->real^N = (\z. f(fstcart z)) o (\z. pastecart (fstcart z - sndcart z) (sndcart z))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART]; W(MP_TAC o PART_MATCH (lhs o rand) MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN o snd)] THEN REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL [REWRITE_TAC[PASTECART_INJ] THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_PASTECART; CONV_TAC VECTOR_ARITH] THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_FSTCART; LINEAR_COMPOSE_SUB]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real^(M,M)finite_sum)` THEN ASM_SIMP_TAC[MEASURABLE_ON_COMPOSE_FSTCART; SUBSET_UNIV] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN THEN REWRITE_TAC[LE_REFL; LEBESGUE_MEASURABLE_UNIV] THEN MATCH_MP_TAC LINEAR_PASTECART THEN SIMP_TAC[LINEAR_SNDCART; LINEAR_FSTCART; LINEAR_COMPOSE_SUB]]);; (* ------------------------------------------------------------------------- *) (* Fubini for absolute integrability. *) (* ------------------------------------------------------------------------- *) let FUBINI_ABSOLUTELY_INTEGRABLE = prove (`!f:real^(M,N)finite_sum->real^P. f absolutely_integrable_on (:real^(M,N)finite_sum) ==> negligible {x | ~((\y. f(pastecart x y)) absolutely_integrable_on (:real^N))} /\ ((\x. integral (:real^N) (\y. f(pastecart x y))) has_integral integral (:real^(M,N)finite_sum) f) (:real^M)`, let lemma = prove (`{x | ~(!i. i IN k ==> P i x)} = UNIONS {{x | ~P i x} | i IN k}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in let assoclemma = prove (`!P:real^(M,N)finite_sum->real^P->bool. {pastecart x y | P x y} has_measure m ==> {pastecart x (pastecart y z) | P (pastecart x y) z} has_measure m`, GEN_TAC THEN MP_TAC(ISPECL [`\z. pastecart (fstcart(fstcart z):real^M) (pastecart (sndcart(fstcart z):real^N) (sndcart z:real^P))`; `{pastecart (x:real^(M,N)finite_sum) (y:real^P) | P x y}`; `m:real`] HAS_MEASURE_ISOMETRY) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_AC] THEN ANTS_TAC THENL [CONJ_TAC THENL [REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN REWRITE_TAC[GSYM o_DEF] THEN REPEAT(MATCH_MP_TAC LINEAR_COMPOSE THEN CONJ_TAC) THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]; SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]]; DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM; EXISTS_PASTECART; PASTECART_INJ] THEN MESON_TAC[]]) in let FUBINI_LEMMA = prove (`!f:real^(M,N)finite_sum->real^1. f integrable_on (:real^(M,N)finite_sum) /\ (!x. &0 <= drop(f x)) ==> negligible {x | ~((f o pastecart x) integrable_on (:real^N))} /\ ((\x. integral (:real^N) (f o pastecart x)) has_integral integral (:real^(M,N)finite_sum) f) (:real^M)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `f:real^(M,N)finite_sum->real^1` INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `measurable { pastecart x (pastecart y z) | z IN interval[vec 0,(f:real^(M,N)finite_sum->real^1) (pastecart x y)] }` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN REWRITE_TAC[measurable] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[assoclemma]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_INJ] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REWRITE_TAC[SET_RULE `{x | ?y z. P y z /\ x = pastecart y z} = {pastecart y z | P y z}`] THEN MP_TAC(GEN `x:real^M` (ISPEC `(f:real^(M,N)finite_sum->real^1) o pastecart x` INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE)) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `y = z /\ ((f has_integral y) s ==> (g has_integral y) s) ==> (f has_integral y) s ==> (g has_integral z) s`) THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[HAS_INTEGRAL_MEASURE_UNDER_CURVE] THEN ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_UNIQUE THEN MATCH_MP_TAC assoclemma THEN ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE]; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE)) THEN EXISTS_TAC `{x | ~((\y. (f:real^(M,N)finite_sum->real^1) (pastecart x y)) integrable_on (:real^N))}` THEN ASM_REWRITE_TAC[IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[HAS_INTEGRAL_MEASURE_UNDER_CURVE] THEN ASM_SIMP_TAC[GSYM HAS_MEASURE_MEASURE]]) in let FUBINI_1 = prove (`!f:real^(M,N)finite_sum->real^1. f absolutely_integrable_on (:real^(M,N)finite_sum) ==> negligible {x | ~((f o pastecart x) absolutely_integrable_on (:real^N))} /\ ((\x. integral (:real^N) (f o pastecart x)) has_integral integral (:real^(M,N)finite_sum) f) (:real^M)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`g = \x:real^(M,N)finite_sum. lift (max (&0) (drop(f x)))`; `h = \x:real^(M,N)finite_sum. --(lift (min (&0) (drop(f x))))`] THEN SUBGOAL_THEN `!x:real^(M,N)finite_sum. &0 <= drop(g x) /\ &0 <= drop(h x)` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(g:real^(M,N)finite_sum->real^1) absolutely_integrable_on UNIV /\ (h:real^(M,N)finite_sum->real^1) absolutely_integrable_on UNIV` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN REWRITE_TAC[] THEN CONJ_TAC THEN TRY(MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NEG) THENL [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1; MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN_1] THEN ASM_REWRITE_TAC[LIFT_DROP; ETA_AX; LIFT_NUM] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^(M,N)finite_sum->real^1) = \x. g x - h x` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; LIFT_DROP; DROP_SUB; DROP_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `h:real^(M,N)finite_sum->real^1` FUBINI_LEMMA) THEN MP_TAC(ISPEC `g:real^(M,N)finite_sum->real^1` FUBINI_LEMMA) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q ==> r /\ s ==> t <=> p /\ r ==> q /\ s ==> t`] THEN REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ; o_DEF] THEN DISCH_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; GSYM DE_MORGAN_THM] THEN REWRITE_TAC[CONTRAPOS_THM; o_DEF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; IN_UNIV]; ASM_SIMP_TAC[INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE))) THEN FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN SIMP_TAC[DE_MORGAN_THM; INTEGRAL_SUB]]) in REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN REWRITE_TAC[GSYM IN_NUMSEG; lemma] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG]; DISCH_TAC THEN ONCE_REWRITE_TAC[HAS_INTEGRAL_COMPONENTWISE]] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ABSOLUTELY_INTEGRABLE_COMPONENTWISE]) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_1) THEN SIMP_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE)) THEN FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN REWRITE_TAC[IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);; let FUBINI_ABSOLUTELY_INTEGRABLE_ALT = prove (`!f:real^(M,N)finite_sum->real^P. f absolutely_integrable_on (:real^(M,N)finite_sum) ==> negligible {y | ~((\x. f(pastecart x y)) absolutely_integrable_on (:real^M))} /\ ((\y. integral (:real^M) (\x. f(pastecart x y))) has_integral integral (:real^(M,N)finite_sum) f) (:real^N)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV]) THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[INTEGRAL_PASTECART_SYM_UNIV]);; let FUBINI_INTEGRAL = prove (`!f:real^(M,N)finite_sum->real^P. f absolutely_integrable_on UNIV ==> integral UNIV f = integral UNIV (\x. integral UNIV (\y. f(pastecart x y)))`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o CONJUNCT2 o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC);; let FUBINI_INTEGRAL_ALT = prove (`!f:real^(M,N)finite_sum->real^P. f absolutely_integrable_on UNIV ==> integral UNIV f = integral UNIV (\y. integral UNIV (\x. f(pastecart x y)))`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o CONJUNCT2 o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT) THEN DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC);; let FUBINI_HAS_ABSOLUTE_INTEGRAL = prove (`!f:real^(M,N)finite_sum->real^P. f absolutely_integrable_on (:real^(M,N)finite_sum) ==> negligible {x | ~((\y. f(pastecart x y)) absolutely_integrable_on (:real^N))} /\ (\x. integral (:real^N) (\y. f(pastecart x y))) absolutely_integrable_on (:real^M) /\ integral (:real^M) (\x. integral (:real^N) (\y. f(pastecart x y))) = integral (:real^(M,N)finite_sum) f`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_SIMP_TAC[IN_UNIV; INTEGRABLE_IMP_MEASURABLE] THEN MAP_EVERY ABBREV_TAC [`n1 = {x | ~((\y. (f:real^(M,N)finite_sum->real^P)(pastecart x y)) absolutely_integrable_on (:real^N))} `; `n2 = {x | ~((\y. lift(norm((f:real^(M,N)finite_sum->real^P) (pastecart x y)))) absolutely_integrable_on (:real^N))}`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `(:real^M) DIFF (n1 UNION n2)` THEN REWRITE_TAC[SET_RULE `(s DIFF UNIV) UNION UNIV DIFF s = UNIV DIFF s`] THEN REWRITE_TAC[COMPL_COMPL] THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\x. integral (:real^N) (\y. lift(norm((f:real^(M,N)finite_sum->real^P) (pastecart x y))))` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `n1 UNION n2:real^M->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN SET_TAC[]; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `n1 UNION n2:real^M->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN SET_TAC[]; X_GEN_TAC `x:real^M` THEN MAP_EVERY EXPAND_TAC ["n1"; "n2"] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]);; let FUBINI_HAS_ABSOLUTE_INTEGRAL_ALT = prove (`!f:real^(M,N)finite_sum->real^P. f absolutely_integrable_on (:real^(M,N)finite_sum) ==> negligible {y | ~((\x. f(pastecart x y)) absolutely_integrable_on (:real^M))} /\ (\y. integral (:real^M) (\x. f(pastecart x y))) absolutely_integrable_on (:real^N) /\ integral (:real^N) (\y. integral (:real^M) (\x. f(pastecart x y))) = integral (:real^(M,N)finite_sum) f`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT) THEN ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN ASM_SIMP_TAC[IN_UNIV; INTEGRABLE_IMP_MEASURABLE] THEN MAP_EVERY ABBREV_TAC [`n1 = {y | ~((\x. (f:real^(M,N)finite_sum->real^P)(pastecart x y)) absolutely_integrable_on (:real^M))} `; `n2 = {y | ~((\x. lift(norm((f:real^(M,N)finite_sum->real^P) (pastecart x y)))) absolutely_integrable_on (:real^M))}`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `(:real^N) DIFF (n1 UNION n2)` THEN REWRITE_TAC[SET_RULE `(s DIFF UNIV) UNION UNIV DIFF s = UNIV DIFF s`] THEN REWRITE_TAC[COMPL_COMPL] THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\y. integral (:real^M) (\x. lift(norm((f:real^(M,N)finite_sum->real^P) (pastecart x y))))` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `n1 UNION n2:real^N->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN SET_TAC[]; MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `n1 UNION n2:real^N->bool` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN SET_TAC[]; X_GEN_TAC `x:real^N` THEN MAP_EVERY EXPAND_TAC ["n1"; "n2"] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]);; let FUBINI_INTEGRAL_INTERVAL = prove (`!f:real^(M,N)finite_sum->real^P a b c d. f absolutely_integrable_on interval[pastecart a c,pastecart b d] ==> integral (interval[pastecart a c,pastecart b d]) f = integral (interval[a,b]) (\x. integral (interval[c,d]) (\y. f(pastecart x y)))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_INTEGRAL) THEN REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[PASTECART_IN_PCROSS; GSYM PCROSS_INTERVAL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INTEGRAL_0] THEN REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);; let FUBINI_INTEGRAL_INTERVAL_ALT = prove (`!f:real^(M,N)finite_sum->real^P a b c d. f absolutely_integrable_on interval[pastecart a c,pastecart b d] ==> integral (interval[pastecart a c,pastecart b d]) f = integral (interval[c,d]) (\y. integral (interval[a,b]) (\x. f(pastecart x y)))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_INTEGRAL_ALT) THEN REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[PASTECART_IN_PCROSS; GSYM PCROSS_INTERVAL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INTEGRAL_0] THEN REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);; let INTEGRAL_PASTECART_CONTINUOUS = prove (`!f:real^(M,N)finite_sum->real^P a b c d. f continuous_on interval[pastecart a c,pastecart b d] ==> integral (interval[pastecart a c,pastecart b d]) f = integral (interval[a,b]) (\x. integral (interval[c,d]) (\y. f(pastecart x y)))`, SIMP_TAC[FUBINI_INTEGRAL_INTERVAL; ABSOLUTELY_INTEGRABLE_CONTINUOUS]);; let INTEGRAL_SWAP_CONTINUOUS = prove (`!f:real^M->real^N->real^P a b c d. (\z. f (fstcart z) (sndcart z)) continuous_on interval[pastecart a c,pastecart b d] ==> integral (interval[a,b]) (\x. integral (interval[c,d]) (f x)) = integral (interval[c,d]) (\y. integral (interval[a,b]) (\x. f x y))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_CONTINUOUS) THEN FIRST_X_ASSUM(fun th -> MP_TAC(MATCH_MP FUBINI_INTEGRAL_INTERVAL_ALT th) THEN MP_TAC(MATCH_MP FUBINI_INTEGRAL_INTERVAL th)) THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ETA_AX]);; let FUBINI_TONELLI = prove (`!f:real^(M,N)finite_sum->real^P. f measurable_on (:real^(M,N)finite_sum) ==> (f absolutely_integrable_on (:real^(M,N)finite_sum) <=> negligible {x | ~((\y. f(pastecart x y)) absolutely_integrable_on (:real^N))} /\ (\x. integral (:real^N) (\y. lift(norm(f(pastecart x y))))) integrable_on (:real^M))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(ACCEPT_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE); ALL_TAC] THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE] THEN ABBREV_TAC `g = \n x. if x IN interval[--vec n,vec n] then lift(min (norm ((f:real^(M,N)finite_sum->real^P) x)) (&n)) else vec 0` THEN SUBGOAL_THEN `!n. (g:num->real^(M,N)finite_sum->real^1) n absolutely_integrable_on UNIV` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN REWRITE_TAC[IN_UNIV; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[COND_RAND; COND_RATOR; GSYM drop; LIFT_DROP; DROP_VEC] THEN CONJ_TAC THENL [CONV_TAC NORM_ARITH; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_CASES THEN REWRITE_TAC[INTEGRABLE_0; IN_UNIV; SET_RULE `{x | x IN s} = s`] THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x:real^(M,N)finite_sum. lift(&n)` THEN REWRITE_TAC[INTEGRABLE_CONST; NORM_LIFT; LIFT_DROP] THEN SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> abs(min x (&n)) <= &n`] THEN MP_TAC(ISPECL [`\x. lift(norm((f:real^(M,N)finite_sum->real^P) x))`; `\x:real^(M,N)finite_sum. lift(&n)`; `interval[--vec n:real^(M,N)finite_sum,vec n]`] MEASURABLE_ON_MIN) THEN ANTS_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real^(M,N)finite_sum)` THEN REWRITE_TAC[SUBSET_UNIV; LEBESGUE_MEASURABLE_INTERVAL] THEN ASM_SIMP_TAC[MEASURABLE_ON_NORM; MEASURABLE_ON_CONST]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_1; LIFT_DROP; FORALL_1; GSYM drop]]; ALL_TAC] THEN MP_TAC(ISPECL [`g:num->real^(M,N)finite_sum->real^1`; `\x. lift(norm((f:real^(M,N)finite_sum->real^P) x))`; `(:real^(M,N)finite_sum)`] MONOTONE_CONVERGENCE_INCREASING) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; IN_UNIV] THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN REWRITE_TAC[REAL_LE_REFL; DROP_VEC; GSYM REAL_OF_NUM_SUC] THEN TRY(CONV_TAC NORM_ARITH) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `~p ==> p ==> q`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN REWRITE_TAC[SUBSET_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC; X_GEN_TAC `z:real^(M,N)finite_sum` THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MP_TAC(ISPEC `&1 + max (norm z) (norm((f:real^(M,N)finite_sum->real^P) z))` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN DISCH_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN COND_CASES_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[REAL_ARITH `min a b = a <=> a <= b`] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `~p ==> p ==> q`)) THEN REWRITE_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x$i) <= norm(x:real^N) /\ norm x <= a ==> abs(x$i) <= a`) THEN REWRITE_TAC[COMPONENT_LE_NORM] THEN ASM_REAL_ARITH_TAC]; MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->real^1) n` FUBINI_ABSOLUTELY_INTEGRABLE)) THEN ASM_REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP INTEGRAL_UNIQUE (SPEC `n:num` th))]) THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN EXISTS_TAC `drop(integral (:real^M) (\x. lift(norm(integral (:real^N) (\y. lift(norm( (f:real^(M,N)finite_sum->real^P) (pastecart x y))))))))` THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL_AE THEN EXISTS_TAC `{x | ~((\y. (f:real^(M,N)finite_sum->real^P)(pastecart x y)) absolutely_integrable_on (:real^N))} UNION {x | ~((\y. (g:num->real^(M,N)finite_sum->real^1) n (pastecart x y)) absolutely_integrable_on (:real^N))}` THEN ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN EXISTS_TAC `{x | ~((\y. (f:real^(M,N)finite_sum->real^P)(pastecart x y)) absolutely_integrable_on (:real^N))}` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[absolutely_integrable_on; GSYM drop] THEN STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `drop a <= norm a /\ x <= drop a==> x <= norm a`) THEN CONJ_TAC THENL [REWRITE_TAC[drop; NORM_REAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; IN_UNIV] THEN X_GEN_TAC `y:real^N` THEN EXPAND_TAC "g" THEN COND_CASES_TAC THEN REWRITE_TAC[NORM_0; NORM_POS_LE] THEN REWRITE_TAC[NORM_LIFT] THEN CONV_TAC NORM_ARITH]]);; let FUBINI_TONELLI_ALT = prove (`!f:real^(M,N)finite_sum->real^P. f measurable_on (:real^(M,N)finite_sum) ==> (f absolutely_integrable_on (:real^(M,N)finite_sum) <=> negligible {y | ~((\x. f(pastecart x y)) absolutely_integrable_on (:real^M))} /\ (\y. integral (:real^M) (\x. lift(norm(f(pastecart x y))))) integrable_on (:real^N))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(f:real^(M,N)finite_sum->real^P) o (\z. pastecart (sndcart z) (fstcart z))` FUBINI_TONELLI) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN o snd) THEN ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN ANTS_TAC THENL [SIMP_TAC[linear; FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ; FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL] THEN REWRITE_TAC[GSYM PASTECART_ADD; GSYM PASTECART_CMUL]; DISCH_THEN SUBST1_TAC THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[EXISTS_PASTECART; FORALL_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]]; REWRITE_TAC[ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV; o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]]);; let HAS_DOUBLE_INTEGRAL_PCROSS = prove (`!bop:real^P->real^Q->real^R f:real^M->real^P g:real^N->real^Q s t. bilinear bop /\ f absolutely_integrable_on s /\ g absolutely_integrable_on t ==> ((\z. bop (f(fstcart z)) (g(sndcart z))) has_integral bop (integral s f) (integral t g)) (s PCROSS t)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN ABBREV_TAC `f':real^M->real^P = \x. if x IN s then f x else vec 0` THEN ABBREV_TAC `g':real^N->real^Q = \x. if x IN t then g x else vec 0` THEN SUBGOAL_THEN `(\x:real^(M,N)finite_sum. if x IN s PCROSS t then (bop:real^P->real^Q->real^R) (f (fstcart x)) (g (sndcart x)) else vec 0) = (\x. bop (f'(fstcart x)) (g'(sndcart x)))` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["f'"; "g'"] THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP BILINEAR_LZERO) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP BILINEAR_RZERO) THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(y:real^N) IN t`] THEN ASM_REWRITE_TAC[]; UNDISCH_TAC `bilinear(bop:real^P->real^Q->real^R)` THEN POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`f':real^M->real^P`,`f:real^M->real^P`) THEN SPEC_TAC(`g':real^N->real^Q`,`g:real^N->real^Q`) THEN REPEAT STRIP_TAC] THEN ABBREV_TAC `h = \z. (bop:real^P->real^Q->real^R) ((f:real^M->real^P) (fstcart z)) ((g:real^N->real^Q) (sndcart z))` THEN SUBGOAL_THEN `(h:real^(M,N)finite_sum->real^R) measurable_on UNIV` ASSUME_TAC THENL [EXPAND_TAC "h" THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_BILINEAR)) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_FSTCART; MATCH_MP_TAC MEASURABLE_ON_COMPOSE_SNDCART] THEN RULE_ASSUM_TAC(REWRITE_RULE[ABSOLUTELY_INTEGRABLE_MEASURABLE]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(h:real^(M,N)finite_sum->real^R) absolutely_integrable_on UNIV` ASSUME_TAC THENL [MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z. lift(B * norm((f:real^M->real^P) (fstcart z)) * norm((g:real^N->real^Q) (sndcart z)))` THEN REWRITE_TAC[IN_UNIV; LIFT_DROP; LIFT_CMUL; DROP_CMUL] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_CMUL; EXPAND_TAC "h" THEN REWRITE_TAC[DROP_CMUL; LIFT_DROP] THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN W(MP_TAC o PART_MATCH (lhand o rand) FUBINI_TONELLI_ALT o snd) THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_MUL THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_NORM THENL [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_FSTCART; MATCH_MP_TAC MEASURABLE_ON_COMPOSE_SNDCART] THEN RULE_ASSUM_TAC(REWRITE_RULE[ABSOLUTELY_INTEGRABLE_MEASURABLE]) THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST1_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_EQ THEN REWRITE_TAC[NORM_MUL; LIFT_CMUL; REAL_ABS_NORM; NORM_LIFT; IN_UNIV] THEN EXISTS_TAC `\y. drop(integral (:real^M) (\x. lift(norm((f:real^M->real^P) x)))) % lift(norm((g:real^N->real^Q) y))` THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN EXPAND_TAC "h" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN MP_TAC(GEN `x:real^P` (ISPECL [`g:real^N->real^Q`; `(:real^N)`; `(bop:real^P->real^Q->real^R) x`] INTEGRAL_LINEAR)) THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear; ETA_AX]) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; o_DEF] THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(GEN `y:real^Q` (ISPECL [`f:real^M->real^P`; `(:real^M)`; `\x. (bop:real^P->real^Q->real^R) x y`] INTEGRAL_LINEAR)) THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear; ETA_AX]) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; o_DEF]);; (* ------------------------------------------------------------------------- *) (* Some versions of Fubini where we stay in a fixed space R^n. *) (* ------------------------------------------------------------------------- *) let FUBINI_NEGLIGIBLE_REPLACEMENTS = prove (`!k s:real^N->bool. lebesgue_measurable s ==> (negligible s <=> negligible { lift a | ~negligible { x:real^N | (lambda i. if i = k then a else x$i) IN s}})`, let lemma0 = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> linear((\x. lambda k. x$swap(i,j)k):real^N->real^N)`, SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA]) in let lemma1 = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> ((\x. lambda k. x$swap(i,j)k):real^N->real^N) o ((\x. lambda k. x$swap(i,j)k):real^N->real^N) = I`, SIMP_TAC[CART_EQ; FUN_EQ_THM; o_THM; I_THM; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])) in let lemma2 = prove (`!i j s. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (negligible (IMAGE ((\x. lambda k. x$swap(i,j)k):real^N->real^N) s) <=> negligible s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_EQ THEN ASM_SIMP_TAC[lemma0] THEN MATCH_MP_TAC(MESON[] `(!x. n(n x) = x) ==> !x y. n x = n y ==> x = y`) THEN ASM_SIMP_TAC[REWRITE_RULE[o_DEF; FUN_EQ_THM; I_DEF] lemma1]) in let lemma3 = prove (`!s. negligible s <=> negligible(s PCROSS (:real^1))`, REWRITE_TAC[NEGLIGIBLE_PCROSS; NOT_NEGLIGIBLE_UNIV]) in let lemma4 = prove (`!s:real^(N,1)finite_sum->bool. lebesgue_measurable s ==> (negligible s <=> negligible {lift a | ~negligible { x:real^(N,1)finite_sum | (lambda i. if i = dimindex(:N) + 1 then a else x$i) IN s}})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP FUBINI_TONELLI_NEGLIGIBLE_ALT) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [SIMPLE_IMAGE_GEN] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; X_GEN_TAC `y:real`] THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [lemma3] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `z:real^1`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; pastecart; DIMINDEX_FINITE_SUM; DIMINDEX_1; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i = dimindex(:N) + 1` THEN ASM_REWRITE_TAC[ARITH_RULE `~(n + 1 <= n) /\ (n + 1) - n = 1`] THEN REWRITE_TAC[GSYM drop; LIFT_DROP] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC) in let lemma5 = prove (`!k s:real^(N,1)finite_sum->bool. lebesgue_measurable s /\ 1 <= k /\ k <= dimindex(:N) ==> (negligible s <=> negligible { lift a | ~negligible { x:real^(N,1)finite_sum | (lambda i. if i = k then a else x$i) IN s}})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`k:num`; `dimindex(:N) + 1`] (INST_TYPE [`:(N,1)finite_sum`,`:N`] lemma2)) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th])] THEN W(MP_TAC o PART_MATCH (lhand o rand) lemma4 o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC lemma0 THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `a:real` THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `(!x. f(f x) = x) ==> (!y. P y ==> ?x. f x = y)`) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] lemma1) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ (f a IN s <=> Q) ==> (a IN IMAGE f s <=> Q)`) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] lemma1) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; AP_THM_TAC THEN AP_TERM_TAC] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[swap] THEN (W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o lhand o snd) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]]) THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o lhand o snd) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN AP_TERM_TAC THEN ASM_ARITH_TAC) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THENL [GEN_REWRITE_TAC LAND_CONV [lemma3] THEN MP_TAC(ISPECL [`k:num`; `(s:real^N->bool) PCROSS (:real^1)`] lemma5) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `a:real` THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [lemma3] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; FORALL_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM PASTECART_FST_SND] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_ELIM_THM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[fstcart; CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1; pastecart; ARITH_RULE `i <= n ==> i <= n + 1`]; SUBGOAL_THEN `!a x. (lambda i. if i = k then a else x$i):real^N = x` (fun th -> REWRITE_TAC[th]) THENL [SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{lift a | p} = if p then IMAGE lift UNIV else {}`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[IMAGE_LIFT_UNIV; NOT_NEGLIGIBLE_UNIV; NEGLIGIBLE_EMPTY] THEN ASM_CASES_TAC `negligible(s:real^N->bool)` THEN ASM_REWRITE_TAC[SET_RULE `{x | x IN s} = s`]]);; let FUBINI_NEGLIGIBLE_REPLACEMENTS_ALT = prove (`!k s:real^N->bool. lebesgue_measurable s ==> (negligible s <=> negligible { x:real^N | ~negligible { lift a | (lambda i. if i = k then a else x$i) IN s}})`, let lemma0 = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> linear((\x. lambda k. x$swap(i,j)k):real^N->real^N)`, SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA]) in let lemma1 = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> ((\x. lambda k. x$swap(i,j)k):real^N->real^N) o ((\x. lambda k. x$swap(i,j)k):real^N->real^N) = I`, SIMP_TAC[CART_EQ; FUN_EQ_THM; o_THM; I_THM; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])) in let lemma2 = prove (`!i j s. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (negligible (IMAGE ((\x. lambda k. x$swap(i,j)k):real^N->real^N) s) <=> negligible s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_EQ THEN ASM_SIMP_TAC[lemma0] THEN MATCH_MP_TAC(MESON[] `(!x. n(n x) = x) ==> !x y. n x = n y ==> x = y`) THEN ASM_SIMP_TAC[REWRITE_RULE[o_DEF; FUN_EQ_THM; I_DEF] lemma1]) in let lemma3 = prove (`!s. negligible s <=> negligible(s PCROSS (:real^1))`, REWRITE_TAC[NEGLIGIBLE_PCROSS; NOT_NEGLIGIBLE_UNIV]) in let lemma4 = prove (`!s:real^(N,1)finite_sum->bool. lebesgue_measurable s ==> (negligible s <=> negligible { x:real^(N,1)finite_sum | ~negligible { lift a | (lambda i. if i = dimindex(:N) + 1 then a else x$i) IN s}})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP FUBINI_TONELLI_NEGLIGIBLE) THEN GEN_REWRITE_TAC LAND_CONV [lemma3] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `z:real^1`] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [SIMPLE_IMAGE_GEN] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; X_GEN_TAC `y:real`] THEN REWRITE_TAC[IN_ELIM_THM] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; pastecart; DIMINDEX_FINITE_SUM; DIMINDEX_1; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i = dimindex(:N) + 1` THEN ASM_REWRITE_TAC[ARITH_RULE `~(n + 1 <= n) /\ (n + 1) - n = 1`] THEN REWRITE_TAC[GSYM drop; LIFT_DROP] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC) in let lemma5 = prove (`!k s:real^(N,1)finite_sum->bool. lebesgue_measurable s /\ 1 <= k /\ k <= dimindex(:N) ==> (negligible s <=> negligible { x:real^(N,1)finite_sum | ~negligible { lift a | (lambda i. if i = k then a else x$i) IN s}})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`k:num`; `dimindex(:N) + 1`] (INST_TYPE [`:(N,1)finite_sum`,`:N`] lemma2)) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th])] THEN W(MP_TAC o PART_MATCH (lhand o rand) lemma4 o lhand o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC lemma0 THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `(!x. f(f x) = x) ==> (!y. P y ==> ?x. f x = y)`) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] lemma1) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `a:real` THEN MATCH_MP_TAC(SET_RULE `(!x. f(f x) = x) /\ (f a IN s <=> Q) ==> (a IN IMAGE f s <=> Q)`) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] lemma1) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ASM_ARITH_TAC; AP_THM_TAC THEN AP_TERM_TAC] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[swap] THEN (W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o lhand o snd) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]]) THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o lhand o snd) THEN REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN AP_TERM_TAC THEN ASM_ARITH_TAC) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THENL [ONCE_REWRITE_TAC[lemma3] THEN MP_TAC(ISPECL [`k:num`; `(s:real^N->bool) PCROSS (:real^1)`] lemma5) THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM PASTECART_FST_SND] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[fstcart; CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1; pastecart; ARITH_RULE `i <= n ==> i <= n + 1`]; SUBGOAL_THEN `!a x. (lambda i. if i = k then a else x$i):real^N = x` (fun th -> REWRITE_TAC[th]) THENL [SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{lift a | p} = if p then IMAGE lift UNIV else {}`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[IMAGE_LIFT_UNIV; NOT_NEGLIGIBLE_UNIV; NEGLIGIBLE_EMPTY] THEN AP_TERM_TAC THEN SET_TAC[]]);; let FUBINI_NEGLIGIBLE_OFFSET = prove (`!s v:real^N. lebesgue_measurable s ==> (negligible s <=> negligible { x | ~negligible {t | (x + drop t % v) IN s}})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `v:real^N = vec 0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[SET_RULE `{a | P} = if P then UNIV else {}`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[NOT_NEGLIGIBLE_UNIV; NEGLIGIBLE_EMPTY] THEN AP_TERM_TAC THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`norm(v:real^N) % basis 1:real^N`; `v:real^N`] ORTHOGONAL_TRANSFORMATION_EXISTS) THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[REAL_ABS_NORM; REAL_MUL_RID; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN MP_TAC(ISPECL [`1`; `IMAGE (g:real^N->real^N) s`] FUBINI_NEGLIGIBLE_REPLACEMENTS_ALT) THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LE_REFL] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_LINEAR_IMAGE_EQ; ORTHOGONAL_TRANSFORMATION_INJECTIVE]; ALL_TAC] THEN SUBGOAL_THEN `!x. {t | (x + drop t % v:real^N) IN s} = {t | ((g:real^N->real^N) x + (drop t * norm(v)) % basis 1) IN IMAGE g s}` (fun th -> ONCE_REWRITE_TAC[th]) THENL [X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC(SET_RULE `(!t. f(b t) = a t) /\ (!x. f(g x) = x) /\ (!y. g(f y) = y) ==> {t | a t IN s} = {t | b t IN IMAGE g s}`) THEN ASM_SIMP_TAC[LINEAR_ADD] THEN ASM_MESON_TAC[LINEAR_CMUL; VECTOR_MUL_ASSOC]; REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM DROP_CMUL)]] THEN SUBGOAL_THEN `!P. {t:real^1 | P(norm(v:real^N) % t)} = IMAGE (\x. inv(norm v) % x) {t | P(t)}` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN EXISTS_TAC `norm(v:real^N) % y:real^1`; ALL_TAC] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID]; ALL_TAC] THEN ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_IMAGE_EQ; VECTOR_MUL_LCANCEL; NORM_EQ_0; REAL_INV_EQ_0; LINEAR_SCALING] THEN SUBGOAL_THEN `!P. {x | P(g x)} = IMAGE (f:real^N->real^N) {x | P x}` MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC)] THEN W(MP_TAC o PART_MATCH (lhand o rand) NEGLIGIBLE_LINEAR_IMAGE_EQ o rand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `!s x. {t | (x + drop t % basis 1) IN s} = IMAGE (\y. --(x$1 % basis 1) + y) {t | ((lambda i. if i = 1 then drop t else x$i):real^N) IN s}` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[EXISTS_REFL; VECTOR_ARITH `--a + x:real^N = y <=> x = y + a`] THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; DROP_ADD; DROP_NEG] THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA; DROP_CMUL; DROP_BASIS; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_CASES_TAC `k = 1` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ]] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);; (* ------------------------------------------------------------------------- *) (* Some basic results about convolution. *) (* ------------------------------------------------------------------------- *) let HAS_INTEGRAL_CONVOLUTION_SYM = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P i x. ((\y. bop (f(x - y)) (g y)) has_integral i) UNIV <=> ((\y. bop (f y) (g(x - y))) has_integral i) UNIV`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REFLECT_UNIV] THEN REWRITE_TAC[GSYM HAS_INTEGRAL_REFLECT_GEN] THEN MP_TAC(ISPEC `--x:real^M` TRANSLATION_UNIV) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[GSYM HAS_INTEGRAL_TRANSLATION] THEN REWRITE_TAC[VECTOR_ARITH `x - --(--x + y):real^M = y`] THEN REWRITE_TAC[VECTOR_ARITH `--(--x + y):real^N = x - y`]);; let INTEGRABLE_CONVOLUTION_SYM = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P x. (\y. bop (f(x - y)) (g y)) integrable_on UNIV <=> (\y. bop (f y) (g(x - y))) integrable_on UNIV`, REWRITE_TAC[integrable_on; HAS_INTEGRAL_CONVOLUTION_SYM]);; let INTEGRAL_CONVOLUTION_SYM = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P x. integral UNIV (\y. bop (f(x - y)) (g y)) = integral UNIV (\y. bop (f y) (g(x - y)))`, REWRITE_TAC[integral; HAS_INTEGRAL_CONVOLUTION_SYM]);; let ABSOLUTELY_INTEGRABLE_CONVOLUTION_SYM = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P x. (\y. bop (f(x - y)) (g y)) absolutely_integrable_on UNIV <=> (\y. bop (f y) (g(x - y))) absolutely_integrable_on UNIV`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN BINOP_TAC THEN REWRITE_TAC[INTEGRABLE_CONVOLUTION_SYM] THEN MP_TAC(ISPECL [`\x y. lift(norm((bop:real^N->real^P->real^Q) x y))`; `f:real^M->real^N`; `g:real^M->real^P`; `x:real^M`] INTEGRABLE_CONVOLUTION_SYM) THEN SIMP_TAC[]);; let MEASURABLE_ON_CONVOLUTION = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P x. bilinear bop /\ f measurable_on (:real^M) /\ g measurable_on (:real^M) ==> (\y. bop (f(x - y)) (g y)) measurable_on (:real^M)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_BILINEAR)) THEN ASM_REWRITE_TAC[VECTOR_SUB; MEASURABLE_ON_REFLECT; REFLECT_UNIV] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `x:real^M`] MEASURABLE_ON_TRANSLATION) THEN ASM_REWRITE_TAC[TRANSLATION_UNIV]);; let ABSOLUTELY_INTEGRABLE_CONVOLUTION_AE, HAS_DOUBLE_INTEGRAL_CONVOLUTION = (CONJ_PAIR o prove) (`(!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P. bilinear bop /\ f absolutely_integrable_on (:real^M) /\ g absolutely_integrable_on (:real^M) ==> ?t. negligible t /\ !x. ~(x IN t) ==> (\y. bop (f(x - y)) (g y)) absolutely_integrable_on (:real^M)) /\ (!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P. bilinear bop /\ f absolutely_integrable_on (:real^M) /\ g absolutely_integrable_on (:real^M) ==> ((\x. integral (:real^M) (\y. bop (f(x - y)) (g y))) has_integral bop (integral (:real^M) f) (integral (:real^M) g)) (:real^M))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN STRIP_TAC THEN ABBREV_TAC `h = \z. (bop:real^N->real^P->real^Q) ((f:real^M->real^N) (fstcart z - sndcart z)) (g(sndcart z))` THEN SUBGOAL_THEN `(h:real^(M,M)finite_sum->real^Q) measurable_on UNIV` ASSUME_TAC THENL [EXPAND_TAC "h" THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_BILINEAR)) THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_SUB; MATCH_MP_TAC MEASURABLE_ON_COMPOSE_SNDCART] THEN RULE_ASSUM_TAC(REWRITE_RULE[ABSOLUTELY_INTEGRABLE_MEASURABLE]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(h:real^(M,M)finite_sum->real^Q) absolutely_integrable_on UNIV` ASSUME_TAC THENL [MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z. lift(B * norm((f:real^M->real^N) (fstcart z - sndcart z)) * norm((g:real^M->real^P) (sndcart z)))` THEN REWRITE_TAC[IN_UNIV; LIFT_DROP; LIFT_CMUL; DROP_CMUL] THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_CMUL; EXPAND_TAC "h" THEN REWRITE_TAC[DROP_CMUL; LIFT_DROP] THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN W(MP_TAC o PART_MATCH (lhand o rand) FUBINI_TONELLI_ALT o snd) THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL [MATCH_MP_TAC MEASURABLE_ON_MUL THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_NORM THENL [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_SUB; MATCH_MP_TAC MEASURABLE_ON_COMPOSE_SNDCART] THEN RULE_ASSUM_TAC(REWRITE_RULE[ABSOLUTELY_INTEGRABLE_MEASURABLE]) THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST1_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN SUBST1_TAC(GSYM(ISPEC `y:real^M` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB; ETA_AX]; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_EQ THEN REWRITE_TAC[NORM_MUL; LIFT_CMUL; REAL_ABS_NORM; NORM_LIFT; IN_UNIV] THEN EXISTS_TAC `\y. drop(integral (:real^M) (\x. lift(norm((f:real^M->real^N)(x - y))))) % lift(norm((g:real^M->real^P) y))` THEN CONJ_TAC THENL [X_GEN_TAC `y:real^M` THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN SUBST1_TAC(GSYM(ISPEC `y:real^M` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB; ETA_AX]; ALL_TAC] THEN MATCH_MP_TAC INTEGRABLE_EQ THEN EXISTS_TAC `\y. drop(integral (:real^M) (\x. lift(norm((f:real^M->real^N) x)))) % lift(norm((g:real^M->real^P) y))` THEN REWRITE_TAC[IN_UNIV] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^M` THEN AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC(ISPEC `y:real^M` TRANSLATION_UNIV) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM INTEGRAL_TRANSLATION] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB; ETA_AX]; MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN MP_TAC(ISPEC `h:real^(M,M)finite_sum->real^Q` FUBINI_ABSOLUTELY_INTEGRABLE) THEN EXPAND_TAC "h" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `P s ==> (negligible s ==> ?t. negligible t /\ P t)`) THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `h:real^(M,M)finite_sum->real^Q` FUBINI_ABSOLUTELY_INTEGRABLE_ALT) THEN EXPAND_TAC "h" THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_UNIQUE)) THEN MATCH_MP_TAC HAS_INTEGRAL_EQ THEN EXISTS_TAC `\y:real^M. (bop:real^N->real^P->real^Q) (integral (:real^M) (\x. f(x - y))) (g y)` THEN REWRITE_TAC[IN_UNIV] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^M` THEN CONV_TAC SYM_CONV THEN MP_TAC(ISPECL [`\x. (f:real^M->real^N)(x - y)`; `(:real^M)`; `\x. (bop:real^N->real^P->real^Q) x (g(y:real^M))`] INTEGRAL_LINEAR) THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear]) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN SUBST1_TAC(GSYM(ISPEC `y:real^M` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM INTEGRABLE_TRANSLATION] THEN REWRITE_TAC[VECTOR_ADD_SUB; ETA_AX] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; ALL_TAC] THEN MATCH_MP_TAC HAS_INTEGRAL_EQ THEN EXISTS_TAC `\y:real^M. (bop:real^N->real^P->real^Q) (integral (:real^M) f) (g y)` THEN REWRITE_TAC[IN_UNIV] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^M` THEN AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC(ISPEC `y:real^M` TRANSLATION_UNIV) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM INTEGRAL_TRANSLATION] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB; ETA_AX]; MP_TAC(GEN `y:real^P` (ISPECL [`g:real^M->real^P`; `y:real^P`; `(:real^M)`; `\z. (bop:real^N->real^P->real^Q) (integral (:real^M) f) z`] HAS_INTEGRAL_LINEAR)) THEN RULE_ASSUM_TAC(REWRITE_RULE[bilinear]) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]);; let DOUBLE_INTEGRABLE_CONVOLUTION = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P. bilinear bop /\ f absolutely_integrable_on (:real^M) /\ g absolutely_integrable_on (:real^M) ==> (\x. integral (:real^M) (\y. bop (f(x - y)) (g y))) integrable_on (:real^M)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DOUBLE_INTEGRAL_CONVOLUTION) THEN REWRITE_TAC[integrable_on] THEN MESON_TAC[]);; let DOUBLE_INTEGRAL_CONVOLUTION = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P. bilinear bop /\ f absolutely_integrable_on (:real^M) /\ g absolutely_integrable_on (:real^M) ==> integral (:real^M) (\x. integral (:real^M) (\y. bop (f(x - y)) (g y))) = bop (integral (:real^M) f) (integral (:real^M) g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_DOUBLE_INTEGRAL_CONVOLUTION THEN ASM_REWRITE_TAC[]);; let ABSOLUTELY_INTEGRABLE_CONVOLUTION_L2 = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P x. bilinear bop /\ f measurable_on (:real^M) /\ g measurable_on (:real^M) /\ (\x. lift(norm(f x) pow 2)) absolutely_integrable_on (:real^M) /\ (\x. lift(norm(g x) pow 2)) absolutely_integrable_on (:real^M) ==> (\y. bop (f(x - y)) (g y)) absolutely_integrable_on (:real^M)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN ASM_SIMP_TAC[MEASURABLE_ON_CONVOLUTION; IN_UNIV] THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\y. B / &2 % lift(norm((f:real^M->real^N) (x - y)) pow 2 + norm((g:real^M->real^P) y) pow 2)` THEN CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_CMUL THEN REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(GSYM(ISPEC `x:real^M` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REFLECT_UNIV] THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_REFLECT_GEN] THEN ASM_REWRITE_TAC[VECTOR_ARITH `x - (x + --y):real^N = y`]; X_GEN_TAC `y:real^M` THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[DROP_CMUL; LIFT_DROP; REAL_ARITH `B * x * y <= B / &2 * (x pow 2 + y pow 2) <=> &0 <= B * (x - y) pow 2`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_POW_2; REAL_LT_IMP_LE]]);; let ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P x. bilinear bop /\ f absolutely_integrable_on (:real^M) /\ g measurable_on (:real^M) /\ bounded(IMAGE g (:real^M)) ==> (\y. bop (f(x - y)) (g y)) absolutely_integrable_on (:real^M)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `C:real` THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\y. B % C % lift(norm((f:real^M->real^N) (x - y)))` THEN ASM_SIMP_TAC[MEASURABLE_ON_CONVOLUTION; INTEGRABLE_IMP_MEASURABLE; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC INTEGRABLE_CMUL) THEN SUBST1_TAC(SYM(ISPEC `x:real^M` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM INTEGRABLE_TRANSLATION] THEN ONCE_REWRITE_TAC[GSYM REFLECT_UNIV] THEN REWRITE_TAC[GSYM INTEGRABLE_REFLECT_GEN; VECTOR_ARITH `x - (x + --y):real^N = y`] THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE]; X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_UNIV; DROP_CMUL; LIFT_DROP] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[NORM_POS_LE]]);; let ABSOLUTELY_INTEGRABLE_CONVOLUTION_LINF_L1 = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P x. bilinear bop /\ f measurable_on (:real^M) /\ bounded(IMAGE f (:real^M)) /\ g absolutely_integrable_on (:real^M) ==> (\y. bop (f(x - y)) (g y)) absolutely_integrable_on (:real^M)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONVOLUTION_SYM] THEN MATCH_MP_TAC(REWRITE_RULE[BILINEAR_SWAP] (ISPEC `\x y. (bop:real^N->real^P->real^Q) y x` ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF)) THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_ON_CONVOLUTION_L1_LINF = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P. bilinear bop /\ f absolutely_integrable_on (:real^M) /\ g measurable_on (:real^M) /\ bounded(IMAGE g (:real^M)) ==> (\x. integral (:real^M) (\y. bop (f(x - y)) (g y))) continuous_on (:real^M)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `C:real` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\z. drop(integral (:real^M) (\y. B % C % lift(norm(f(z - y) - f(x - y):real^N))))` THEN REWRITE_TAC[WITHIN_UNIV; EVENTUALLY_AT] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; GSYM DIST_NZ] THEN X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; GSYM INTEGRAL_SUB] THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF THEN ASM_REWRITE_TAC[]; REPEAT(MATCH_MP_TAC INTEGRABLE_CMUL) THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THENL [SUBST1_TAC(SYM(ISPEC `z:real^M` TRANSLATION_UNIV)); SUBST1_TAC(SYM(ISPEC `x:real^M` TRANSLATION_UNIV))] THEN ONCE_REWRITE_TAC[GSYM REFLECT_UNIV] THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_REFLECT_GEN; GSYM ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN ASM_REWRITE_TAC[VECTOR_ARITH `x - (x + --y):real^N = y`; ETA_AX]; X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_UNIV; DROP_CMUL; LIFT_DROP] THEN ASM_SIMP_TAC[GSYM BILINEAR_LSUB] THEN FIRST_X_ASSUM(fun t -> W(MP_TAC o PART_MATCH lhand t o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[NORM_POS_LE]]; SUBGOAL_THEN `!z w. integral (:real^M) (\y. B % C % lift(norm((f:real^M->real^N)(z - y) - f (w - y)))) = B % C % integral (:real^M) (\y. lift(norm((f(z - y) - f(w - y)))))` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC INTEGRAL_CMUL THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THENL [SUBST1_TAC(SYM(ISPEC `z:real^M` TRANSLATION_UNIV)); SUBST1_TAC(SYM(ISPEC `w:real^M` TRANSLATION_UNIV))] THEN ONCE_REWRITE_TAC[GSYM REFLECT_UNIV] THEN REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_REFLECT_GEN; GSYM ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN ASM_REWRITE_TAC[VECTOR_ARITH `x - (x + --y):real^N = y`; ETA_AX]; REWRITE_TAC[LIFT_CMUL; LIFT_DROP] THEN REPEAT(MATCH_MP_TAC LIM_NULL_CMUL) THEN ONCE_REWRITE_TAC[LIM_AT_ZERO] THEN REWRITE_TAC[] THEN SUBST1_TAC(SYM(ISPEC `x:real^M` TRANSLATION_UNIV)) THEN REWRITE_TAC[GSYM INTEGRAL_TRANSLATION; VECTOR_ARITH `(x + z) - (x + y):real^N = z + --y`] THEN REWRITE_TAC[VECTOR_ARITH `x - (x + y):real^N = --y`] THEN ONCE_REWRITE_TAC[GSYM REFLECT_UNIV] THEN REWRITE_TAC[GSYM INTEGRAL_REFLECT_GEN; VECTOR_NEG_NEG] THEN MATCH_MP_TAC CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM THEN ASM_REWRITE_TAC[]]]);; let CONTINUOUS_ON_CONVOLUTION_LINF_L1 = prove (`!bop:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P. bilinear bop /\ f measurable_on (:real^M) /\ bounded(IMAGE f (:real^M)) /\ g absolutely_integrable_on (:real^M) ==> (\x. integral (:real^M) (\y. bop (f(x - y)) (g y))) continuous_on (:real^M)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INTEGRAL_CONVOLUTION_SYM] THEN MATCH_MP_TAC(REWRITE_RULE[BILINEAR_SWAP] (ISPEC `\x y. (bop:real^N->real^P->real^Q) y x` CONTINUOUS_ON_CONVOLUTION_L1_LINF)) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some Steinhaus variants with two different sets of positive measure. *) (* ------------------------------------------------------------------------- *) let STEINHAUS_SUMS = prove (`!s t:real^N->bool. lebesgue_measurable s /\ ~negligible s /\ lebesgue_measurable t /\ ~negligible t ==> ~(interior {x + y | x IN s /\ y IN t} = {})`, SUBGOAL_THEN `!s t:real^N->bool. measurable s /\ &0 < measure s /\ measurable t /\ &0 < measure t ==> ~(interior {x + y | x IN s /\ y IN t} = {})` ASSUME_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x y. lift(drop x * drop y)`; `indicator(s:real^N->bool)`; `indicator(t:real^N->bool)`] HAS_DOUBLE_INTEGRAL_CONVOLUTION) THEN ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_INDICATOR; INTER_UNIV; INTEGRAL_INDICATOR; LIFT_CMUL; LIFT_DROP; BILINEAR_DROP_MUL] THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `drop`) THEN REWRITE_TAC[DROP_CMUL; LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `x = y ==> &0 < y ==> &0 < x`)) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] INTEGRAL_EQ_0)) THEN REWRITE_TAC[NOT_FORALL_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x y:real^1. drop x % y`; `indicator(s:real^N->bool)`; `indicator(t:real^N->bool)`] CONTINUOUS_ON_CONVOLUTION_L1_LINF) THEN ASM_REWRITE_TAC[BILINEAR_DROP_MUL; ABSOLUTELY_INTEGRABLE_ON_INDICATOR; INTER_UNIV; GSYM lebesgue_measurable] THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV; NORM_1] THEN ANTS_TAC THENL [MESON_TAC[DROP_INDICATOR_ABS_LE_1]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; WITHIN_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_UNIV] THEN REWRITE_TAC[continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `norm(integral (:real^N) (\y. drop(indicator s (x - y)) % indicator t y))`) THEN ASM_REWRITE_TAC[NORM_POS_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTERIOR] THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `d:real`] THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `dist(a:real^N,b) < norm b ==> ~(a = vec 0)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] INTEGRAL_EQ_0)) THEN REWRITE_TAC[NOT_FORALL_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN REWRITE_TAC[DE_MORGAN_THM; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN REWRITE_TAC[indicator] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[VEC_EQ; ARITH_EQ] THEN REWRITE_TAC[TAUT `(if p then F else T) <=> ~p`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`y - z:real^N`; `z:real^N`] THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH; REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` NEGLIGIBLE_ON_INTERVALS) THEN MP_TAC(ISPEC `s:real^N->bool` NEGLIGIBLE_ON_INTERVALS) THEN ASM_REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s INTER interval[a:real^N,b]`; `t INTER interval[c:real^N,d]`]) THEN ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL; MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]]);; let STEINHAUS_DIFFS = prove (`!s t:real^N->bool. lebesgue_measurable s /\ ~negligible s /\ lebesgue_measurable t /\ ~negligible t ==> ~(interior {x - y | x IN s /\ y IN t} = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `IMAGE (--) (t:real^N->bool)`] STEINHAUS_SUMS) THEN ASM_SIMP_TAC[LINEAR_NEGATION; VECTOR_EQ_NEG2; NEGLIGIBLE_LINEAR_IMAGE_EQ; LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ] THEN REWRITE_TAC[SET_RULE `{x + y:real^N | x IN s /\ y IN IMAGE f t} = {x + f y | x IN s /\ y IN t}`] THEN REWRITE_TAC[GSYM VECTOR_SUB]);; (* ------------------------------------------------------------------------- *) (* More refined Ostrowski-style theorems about midpoint convexity. *) (* ------------------------------------------------------------------------- *) let MIDPOINT_CONVEX_IMP_CONTINUOUS_OSTROWSKI = prove (`!f:real^N->real s t B. convex s /\ open s /\ (!x y. x IN s /\ y IN s ==> f(midpoint (x,y)) <= (f x + f y) / &2) /\ t SUBSET s /\ lebesgue_measurable t /\ ~negligible t /\ (!x. x IN t ==> f x <= B) ==> (lift o f) continuous_on s`, let lemma = prove (`!f:real^N->real s u a b. a IN s /\ convex s /\ open s /\ open u /\ u SUBSET s /\ ~(u = {}) /\ (!x y. x IN s /\ y IN s ==> f(midpoint (x,y)) <= (f x + f y) / &2) /\ (!x. x IN u ==> f x <= b) ==> ?v c. a IN v /\ open v /\ v SUBSET s /\ !x. x IN v ==> f x <= c`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN ABBREV_TAC `g = \x. (f:real^N->real) (z + x)` THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN SPEC_TAC(`a:real^N`,`y:real^N`) THEN SPEC_TAC(`g:real^N->real`,`f:real^N->real`) THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `y:real^N = vec 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?z:real^N p n. z IN s /\ p < 2 EXP n /\ &p / &2 pow n % z = y` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`{r | r IN interval(vec 0,vec 1) /\ inv(drop r) % (y:real^N) IN s}`; `{inv (&2 pow n) % x:real^1 | n,x | !i. 1 <= i /\ i <= dimindex (:1) ==> integer (x$i)}`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; INTER_UNIV] THEN MATCH_MP_TAC(TAUT `p /\ ~q /\ (~r ==> s) ==> (p ==> (q <=> r)) ==> s`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_NZ; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[CONTINUOUS_ON_ID]; REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN UNDISCH_TAC `open(s:real^N->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_CBALL; SUBSET; IN_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `lift(inv(&1 + e / norm(y:real^N)))`) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP; REAL_INV_INV] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[REAL_LT_INV_EQ] THEN MATCH_MP_TAC REAL_LT_ADD THEN ASM_SIMP_TAC[NORM_POS_LT; REAL_LT_01; REAL_LT_DIV]; MATCH_MP_TAC REAL_INV_LT_1 THEN ASM_SIMP_TAC[REAL_LT_ADDR; NORM_POS_LT; REAL_LT_01; REAL_LT_DIV]; FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID] THEN REWRITE_TAC[NORM_ARITH `dist(y:real^N,y + x) = norm x`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(r INTER s = {}) ==> ?x. x IN s /\ x IN r`)) THEN REWRITE_TAC[EXISTS_IN_GSPEC; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[GSYM drop; EXISTS_LIFT; LIFT_DROP; IN_ELIM_THM; DROP_CMUL; IN_INTERVAL_1; DROP_VEC; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN ASM_CASES_TAC `&0 < x` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; INTEGER_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`(&2 pow n * inv(&p)) % y:real^N`; `p:num`; `n:num`] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_ARITH `a % b % x:real^N = x <=> (a * b) % x = &1 % x`] THEN MP_TAC(SPEC `n:num` REAL_LT_POW2) THEN UNDISCH_TAC `&0 < &p` THEN SPEC_TAC(`&2 pow n`,`k:real`) THEN CONV_TAC REAL_FIELD]; MAP_EVERY EXISTS_TAC [`IMAGE (\x:real^N. y + x) (IMAGE (\x. (&1 - &p / &2 pow n) % x) u)`; `&(2 EXP n - p) / &2 pow n * b + &p / &2 pow n * f(z:real^N)`] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN MATCH_MP_TAC OPEN_AFFINITY THEN ASM_REWRITE_TAC[REAL_ARITH `&1 - x = &0 <=> x = &1`] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN MATCH_MP_TAC(REAL_FIELD `&0 <= x /\ x < y ==> ~(x / y = &1)`) THEN ASM_REWRITE_TAC[REAL_POS; REAL_OF_NUM_POW; REAL_OF_NUM_LT]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; AND_FORALL_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN u` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`] MIDPOINT_CONVEX_DYADIC_RATIONALS) THEN ASM_SIMP_TAC[MIDPOINT_IN_CONVEX] THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `2 EXP n - p`; `p:num`; `x:real^N`; `z:real^N`]) THEN ASM_SIMP_TAC[ARITH_RULE `p:num < n ==> (n - p) + p = n`] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&(2 EXP n - p) / &2 pow n % x + y:real^N = y + (&1 - &p / &2 pow n) % x` (fun th -> REWRITE_TAC[th]) THENL [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE; REAL_ARITH `(a - b) / c:real = a / c - b / c`] THEN SIMP_TAC[REAL_OF_NUM_POW; REAL_DIV_REFL; REAL_OF_NUM_EQ; EXP_EQ_0; ARITH_EQ] THEN CONV_TAC VECTOR_ARITH; MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_LE_RADD] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_POS]]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `?u. u SUBSET s /\ open u /\ ~(u = {}) /\ !x. x IN u ==> (f:real^N->real)(x) <= B` STRIP_ASSUME_TAC THENL [EXISTS_TAC `interior {midpoint(x,y):real^N | x IN t /\ y IN t}` THEN REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(MESON[SUBSET_TRANS; INTERIOR_SUBSET] `s SUBSET t ==> interior s SUBSET t`) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[MIDPOINT_IN_CONVEX; SUBSET]; REWRITE_TAC[midpoint; SET_RULE `{inv(&2) % (x + y):real^N | P x y} = IMAGE (\x. inv(&2) % x) {x + y | P x y}`] THEN SIMP_TAC[INTERIOR_INJECTIVE_LINEAR_IMAGE; LINEAR_SCALING; VECTOR_ARITH `inv(&2) % x:real^N = inv(&2) % y <=> x = y`] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN MATCH_MP_TAC STEINHAUS_SUMS THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `interior s SUBSET s /\ (!x. x IN s ==> P x) ==> (!x:real^N. x IN interior s ==> P x)`) THEN REWRITE_TAC[INTERIOR_SUBSET; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC(REAL_ARITH `x <= b /\ y <= b ==> (x + y) / &2 <= b`) THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`; `u:real^N->bool`; `a:real^N`; `B:real`] lemma) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `C:real`] THEN STRIP_TAC THEN REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; REAL_NOT_LT] THEN DISCH_THEN(LABEL_TAC "A") THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_CONTAINS_BALL) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!d. &0 < d ==> ?x. x IN s /\ dist(a,x) < d /\ dist(a,x) < r /\ (f:real^N->real) a + e <= f x` (LABEL_TAC "B") THENL [X_GEN_TAC `d:real` THEN DISCH_TAC THEN REMOVE_THEN "A" (MP_TAC o SPEC `min d r:real`) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `e <= abs(x - a) ==> a + e <= x \/ x + e <= a`)) THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN EXISTS_TAC `&2 % a - x:real^N` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a:real^N,&2 % a - x) = dist(x,a)`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `&2 % a - x:real^N`]) THEN REWRITE_TAC[midpoint; VECTOR_ARITH `inv(&2) % (x + (&2 % a - x)):real^N = a`] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ASM_REAL_ARITH_TAC] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a:real^N,&2 % a - x) = dist(x,a)`] THEN ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN SUBGOAL_THEN `!n d. &0 < d ==> ?x. x IN s /\ dist(a,x) < d /\ dist(a,x) < r /\ &2 pow n * e <= (f:real^N->real) x - f a` ASSUME_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[real_pow] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_ARITH `&1 * e <= x - a <=> a + e <= x`]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(fun th -> X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(SPEC `min (d / &2) (r / &2)` th)) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&2 % x - a:real^N` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a:real^N,&2 % x - a) = &2 * dist(a,x)`; REAL_ARITH `&2 * x < r <=> x < r / &2`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n * e <= x ==> &2 * x <= y ==> (&2 * n) * e <= y`)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `&2 % x - a:real^N`]) THEN REWRITE_TAC[midpoint; VECTOR_ARITH `inv(&2) % (a + (&2 % x - a)):real^N = x`] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ASM_REAL_ARITH_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `dist(a:real^N,x) < r / &2` THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN MP_TAC(SPEC `(C - (f:real^N->real) a) / e` REAL_ARCH_POW2) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN UNDISCH_TAC `open(v:real^N->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `d:real`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(f:real^N->real) x <= C` MP_TAC THENL [ASM_SIMP_TAC[]; ASM_REAL_ARITH_TAC]);; let MIDPOINT_CONVEX_IMP_CONVEX_OSTROWSKI = prove (`!f:real^N->real s t B. convex s /\ open s /\ t SUBSET s /\ lebesgue_measurable t /\ ~negligible t /\ (!x y. x IN s /\ y IN s ==> f(midpoint (x,y)) <= (f x + f y) / &2) /\ (!x. x IN t ==> f x <= B) ==> f convex_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MIDPOINT_CONVEX THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MIDPOINT_CONVEX_IMP_CONTINUOUS_OSTROWSKI THEN ASM_MESON_TAC[]);; let MEASURABLE_MIDPOINT_CONVEX_IMP_CONTINUOUS = prove (`!f:real^N->real s. (lift o f) measurable_on s /\ open s /\ (!x y. x IN s /\ y IN s ==> f(midpoint (x,y)) <= (f x + f y) / &2) ==> (lift o f) continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `\n. {x | x IN ball(a,r) /\ (f:real^N->real) x <= &n}` NEGLIGIBLE_COUNTABLE_UNIONS) THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ANTS_TAC THENL [SUBGOAL_THEN `~negligible(ball(a:real^N,r))` MP_TAC THENL [ASM_SIMP_TAC[OPEN_NOT_NEGLIGIBLE; OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE]; REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP] THEN AP_TERM_TAC THEN REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_UNIV; IN_ELIM_THM] THEN MESON_TAC[REAL_ARCH_SIMPLE]; REWRITE_TAC[NOT_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`f:real^N->real`; `ball(a:real^N,r)`; `{x:real^N | x IN ball (a,r) /\ f x <= &n}`; `&n:real`] MIDPOINT_CONVEX_IMP_CONTINUOUS_OSTROWSKI) THEN SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[CENTRE_IN_BALL]] THEN ASM_REWRITE_TAC[SUBSET_RESTRICT; CONVEX_BALL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC(ISPECL [`lift o (f:real^N->real)`; `ball(a:real^N,r)`] MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE) THEN REWRITE_TAC[LEBESGUE_MEASURABLE_BALL; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP] THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ p ==> (p <=> q) ==> r`) THEN SIMP_TAC[] THEN MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_BALL]);; let MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN = prove (`!f:real^N->real s. (lift o f) measurable_on s /\ convex s /\ (!x y. x IN s /\ y IN s ==> f(midpoint (x,y)) <= (f x + f y) / &2) ==> !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 /\ (segment[x,y] SUBSET frontier s ==> x = y) ==> f (u % x + v % y) <= u * f x + v * f y`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `interior s:real^N->bool`] MEASURABLE_MIDPOINT_CONVEX_IMP_CONTINUOUS) THEN REWRITE_TAC[OPEN_INTERIOR] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]] THEN MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[INTERIOR_SUBSET] THEN SIMP_TAC[LEBESGUE_MEASURABLE_OPEN; OPEN_INTERIOR]; DISCH_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `v:real`; `u:real`] THEN ASM_CASES_TAC `v = &1 - u` THENL [FIRST_X_ASSUM SUBST_ALL_TAC; ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[REAL_ARITH `&1 - u + u = &1`] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`; REAL_ARITH `x <= (&1 - u) * x + u * x`] THEN STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`u = &0`; `u = &1`] THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_RID; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL; REAL_MUL_LID; REAL_SUB_REFL; REAL_ADD_LID; VECTOR_ADD_LID] THEN SUBGOAL_THEN `!v. v IN closure (interval(midpoint(vec 0,lift u),midpoint(lift u,vec 1)) INTER {inv (&2 pow n) % x:real^1 | n,x | !i. 1 <= i /\ i <= dimindex (:1) ==> integer (x$i)}) ==> lift(f((&1 - drop v) % a + drop v % b:real^N) - ((&1 - drop v) * f a + drop v * f b)) IN {x | x$1 <= &0}` MP_TAC THENL [MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN SIMP_TAC[CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET; OPEN_INTERVAL] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[midpoint(vec 0,lift u),midpoint(lift u,vec 1)]` THEN SIMP_TAC[CLOSURE_INTERVAL] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[LIFT_SUB; LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[CONTINUOUS_ON_MUL; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; LIFT_SUB; CONTINUOUS_ON_SUB] THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_MUL; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; LIFT_SUB; CONTINUOUS_ON_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_LIFT] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; midpoint; DROP_CMUL; DROP_ADD; DROP_VEC] THEN X_GEN_TAC `w:real` THEN STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN interior s` THENL [REWRITE_TAC[VECTOR_ARITH `(&1 - w) % a + w % b:real^N = b - (&1 - w) % (b - a)`] THEN MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_SIMP_TAC[CLOSURE_INC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `(b:real^N) IN interior s` THENL [REWRITE_TAC[VECTOR_ARITH `(&1 - w) % a + w % b:real^N = a - w % (a - b)`] THEN MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN ASM_SIMP_TAC[CLOSURE_INC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `~(interior s:real^N->bool = {})` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(t SUBSET frontier s) ==> t SUBSET s /\ s DIFF frontier s = interior s ==> ~(interior s = {})`)) THEN ASM_SIMP_TAC[SET_DIFF_FRONTIER; SEGMENT_SUBSET_CONVEX]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`; `(&1 - w) % a + w % b:real^N`] SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; frontier; IN_DIFF] THEN ASM_SIMP_TAC[CLOSURE_INC] THEN MATCH_MP_TAC(SET_RULE `x IN t /\ t SUBSET s ==> ~(x IN t /\ x IN s /\ ~r) ==> r`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `w:real` THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[CONVEX_CONTAINS_OPEN_SEGMENT; SUBSET_TRANS; CLOSURE_SUBSET]]; REWRITE_TAC[SET_RULE `(!x. x IN s INTER t ==> P x) <=> (!x. x IN t ==> x IN s ==> P x)`] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; FORALL_LIFT; GSYM drop; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`n:num`; `p:real`] THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; midpoint; DROP_ADD; LIFT_DROP; DROP_VEC; IN_ELIM_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN REWRITE_TAC[REAL_ARITH `x - y <= &0 <=> x <= y`] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < p / &2 pow n /\ p / &2 pow n < &1` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN STRIP_TAC THEN UNDISCH_TAC `integer p` THEN ASM_SIMP_TAC[INTEGER_POS; REAL_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`] MIDPOINT_CONVEX_DYADIC_RATIONALS) THEN ASM_SIMP_TAC[CONVEX_ON_IMP_MIDPOINT_CONVEX; MIDPOINT_IN_CONVEX] THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `2 EXP n - m`; `m:num`; `a:real^N`; `b:real^N`]) THEN SUBGOAL_THEN `m <= 2 EXP n` ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW; REAL_LT_IMP_LE]; ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW]] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN REWRITE_TAC[REAL_ARITH `(a - b) / c:real = a / c - b / c`] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ]]; SIMP_TAC[CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET; OPEN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `lift u`) THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP; REAL_ARITH `a - b <= &0 <=> a <= b`; GSYM drop; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CLOSURE_INTERVAL] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; midpoint; DROP_CMUL; DROP_ADD; DROP_VEC; LIFT_DROP] THEN COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_CMUL; DROP_ADD; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);; let MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_OPEN = prove (`!f:real^N->real s. (lift o f) measurable_on s /\ convex s /\ open s /\ (!x y. x IN s /\ y IN s ==> f(midpoint (x,y)) <= (f x + f y) / &2) ==> f convex_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`] MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN) THEN ASM_REWRITE_TAC[convex_on] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `a IN t /\ a IN segment[a,b] ==> segment[a,b] SUBSET s DIFF t ==> p`) THEN ASM_SIMP_TAC[ENDS_IN_SEGMENT; INTERIOR_OPEN]);; let MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_1D = prove (`!f:real^1->real s. (lift o f) measurable_on s /\ convex s /\ (!x y. x IN s /\ y IN s ==> f(midpoint (x,y)) <= (f x + f y) / &2) ==> f convex_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real`; `s:real^1->bool`] MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN) THEN ASM_REWRITE_TAC[convex_on] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN ASM_SIMP_TAC[CARD_FRONTIER_INTERVAL_1; IS_INTERVAL_CONVEX_1] THEN ASM_REWRITE_TAC[FINITE_SEGMENT]);; let MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_CBALL = prove (`!f:real^N->real a r. (lift o f) measurable_on cball(a,r) /\ (!x y. x IN cball(a,r) /\ y IN cball(a,r) ==> f(midpoint (x,y)) <= (f x + f y) / &2) ==> f convex_on cball(a,r)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `cball(a:real^N,r)`] MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN) THEN ASM_REWRITE_TAC[convex_on; CONVEX_CBALL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[FRONTIER_CBALL] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `segment[x,y] SUBSET s ==> x IN segment[x,y] /\ y IN segment[x,y] /\ midpoint(x,y) IN segment[x,y] ==> x IN s /\ y IN s /\ midpoint(x,y) IN s`)) THEN REWRITE_TAC[MIDPOINT_IN_SEGMENT; ENDS_IN_SEGMENT] THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_SPHERE_0] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[DIFFERENT_NORM_3_COLLINEAR_POINTS] `(~(x = y) ==> m IN segment(x,y)) ==> norm x = r /\ norm y = r /\ norm m = r ==> x = y`) THEN REWRITE_TAC[MIDPOINT_IN_SEGMENT]);; let OSTROWSKI_THEOREM = prove (`!f:real^M->real^N B s. (!x y. f(x + y) = f(x) + f(y)) /\ (!x. x IN s ==> norm(f x) <= B) /\ measurable s /\ &0 < measure s ==> linear f`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LINEAR_COMPONENTWISE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[LINEAR_CONVEX_ON_1] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^M`; `vec 0:real^M`]) THEN SIMP_TAC[VECTOR_ADD_LID; VECTOR_ARITH `a:real^N = a + a <=> a = vec 0`; VEC_COMPONENT; LIFT_NUM]; ALL_TAC] THEN SUBGOAL_THEN `!x. (f:real^M->real^N)(inv(&2) % x) = inv(&2) % f x` ASSUME_TAC THENL [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv(&2) % x:real^M`; `inv(&2) % x:real^M`]) THEN REWRITE_TAC[VECTOR_ARITH `inv(&2) % x + inv(&2) % x:real^N = x`] THEN CONV_TAC VECTOR_ARITH; CONJ_TAC THEN MATCH_MP_TAC MIDPOINT_CONVEX_IMP_CONVEX_OSTROWSKI THEN MAP_EVERY EXISTS_TAC [`s:real^M->bool`; `B:real`] THEN REWRITE_TAC[o_THM; LIFT_DROP; CONVEX_UNIV; OPEN_UNIV; SUBSET_UNIV] THEN ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; GSYM MEASURABLE_MEASURE_POS_LT] THEN ASM_REWRITE_TAC[IN_UNIV; midpoint; VECTOR_ADD_LDISTRIB] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN (CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; REAL_ARITH `abs x <= b <=> x <= b /\ --x <= b`]]);; let MEASURABLE_ADDITIVE_IMP_LINEAR = prove (`!f:real^M->real^N. f measurable_on (:real^M) /\ (!x y. f(x + y) = f(x) + f(y)) ==> linear f`, GEN_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE; CART_EQ; LINEAR_COMPONENTWISE] THEN ONCE_REWRITE_TAC[MESON[] `(!x y z. P x y z) <=> (!z x y. P x y z)`] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `g = \x. lift((f:real^M->real^N) x$i)` THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_REWRITE_TAC[GSYM LIFT_EQ; VECTOR_ADD_COMPONENT; LIFT_ADD] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[LINEAR_CONVEX_ON_1] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. (g:real^M->real^1)(inv(&2) % x) = inv(&2) % g x` ASSUME_TAC THENL [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv(&2) % x:real^M`; `inv(&2) % x:real^M`]) THEN REWRITE_TAC[VECTOR_ARITH `inv(&2) % x + inv(&2) % x:real^N = x`] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^M`; `vec 0:real^M`]) THEN REWRITE_TAC[VECTOR_ADD_LID] THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_OPEN THEN ASM_REWRITE_TAC[CONVEX_UNIV; OPEN_UNIV; o_DEF; LIFT_DROP; ETA_AX] THEN ASM_REWRITE_TAC[midpoint; VECTOR_ADD_LDISTRIB] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; IN_UNIV; LIFT_NEG; LIFT_DROP] THEN ASM_REWRITE_TAC[MEASURABLE_ON_NEG_EQ] THEN REAL_ARITH_TAC);; let CONTINUOUS_ADDITIVE_IMP_LINEAR = prove (`!f:real^M->real^N. f continuous_on (:real^M) /\ (!x y. f(x + y) = f(x) + f(y)) ==> linear f`, ASM_MESON_TAC[CONTINUOUS_IMP_MEASURABLE_ON; MEASURABLE_ADDITIVE_IMP_LINEAR]);; (* ------------------------------------------------------------------------- *) (* Rademacher's theorem (the "simple proof" from Nekvinda and Zajicek). *) (* ------------------------------------------------------------------------- *) let RADEMACHER_UNIV = prove (`!f:real^M->real^N. (?B. !x y. norm(f x - f y) <= B * norm(x - y)) ==> negligible {x | ~(f differentiable at x)}`, let lemma = prove (`{x | ~(!i. i IN s ==> P i x)} = UNIONS (IMAGE (\i. {x | ~(P i x)}) s)`, REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[]) and lemma' = prove (`{x | !i. P i ==> R i x} = INTERS {{x | R i x} | P i}`, REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]) and lemur = prove (`!a b c. c < a + b ==> ?e p r s. rational r /\ rational s /\ rational p /\ rational e /\ &0 < e /\ a >= r + e /\ b >= s + e /\ c <= p - e /\ p < r + s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`&0`; `((a + b) - c) / &10`] RATIONAL_APPROXIMATION_ABOVE) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c + e:real`; `e:real`] RATIONAL_APPROXIMATION_ABOVE) THEN MP_TAC(ISPECL [`b - e:real`; `e:real`] RATIONAL_APPROXIMATION_BELOW) THEN MP_TAC(ISPECL [`a - e:real`; `e:real`] RATIONAL_APPROXIMATION_BELOW) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `p:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`e:real`; `p:real`; `r:real`; `s:real`] THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC) in SUBGOAL_THEN `!f:real^M->real^1. (?B. !x y. norm(f x - f y) <= B * norm(x - y)) ==> negligible {x | ~(f differentiable at x)}` ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `f:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ONCE_REWRITE_TAC[DIFFERENTIABLE_COMPONENTWISE_AT] THEN REWRITE_TAC[GSYM IN_NUMSEG; lemma] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[GSYM LIFT_SUB; GSYM VECTOR_SUB_COMPONENT; NORM_LIFT] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]] THEN REPEAT GEN_TAC THEN REWRITE_TAC[LIPSCHITZ_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `(:real^M)` SEPARABLE) THEN REWRITE_TAC[SUBSET_UNIV; SET_RULE `UNIV SUBSET s <=> s = UNIV`] THEN DISCH_THEN(X_CHOOSE_THEN `qq:real^M->bool` STRIP_ASSUME_TAC) THEN ABBREV_TAC `dd = UNIONS { {x | ~(?l. ((\t. inv(drop t) % ((f:real^M->real^1)(x + drop t % v) - f x)) --> l) (at (vec 0)))} | v IN qq}` THEN SUBGOAL_THEN `!x v. ~(x IN dd) ==> ?l. ((\t. inv(drop t) % ((f:real^M->real^1)(x + drop t % v) - f x)) --> l) (at (vec 0))` MP_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY_AT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M` o MATCH_MP (SET_RULE `s = UNIV ==> !x. x IN s`)) THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPEC `e / &4 / B`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &4`] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `~((x:real^M) IN dd)` THEN EXPAND_TAC "dd" THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `u:real^M`) THEN ASM_REWRITE_TAC[CONVERGENT_EQ_CAUCHY_AT; NOT_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^1` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[GSYM DIST_NZ] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(a:real^M - a') <= e / &4 /\ norm(b - b') <= e / &4 ==> dist(a,b) < e / &2 ==> dist(a',b') < e`) THEN REWRITE_TAC[VECTOR_ARITH `c % (y - x) - c % (z - x):real^M = c % (y - z)`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; GSYM NORM_1] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div); REAL_LE_LDIV_EQ; NORM_POS_LT] THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[VECTOR_ARITH `(x + s % u) - (x + s % v):real^N = s % (u - v)`] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[NORM_MUL; GSYM NORM_1; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM dist; REAL_LT_IMP_LE]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f':real^M->real^M->real^1` THEN DISCH_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `dd UNION {x | ~(x IN dd) /\ ~(linear((f':real^M->real^M->real^1) x))}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM; differentiable] THEN STRIP_TAC THEN EXISTS_TAC `(f':real^M->real^M->real^1) x` THEN MATCH_MP_TAC GATEAUX_DERIVATIVE_LIPSCHITZ THEN EXISTS_TAC `(:real^M)` THEN ASM_SIMP_TAC[IN_UNIV; OPEN_UNIV] THEN ASM_MESON_TAC[]] THEN SUBGOAL_THEN `!v. lebesgue_measurable {x | ~(?l. ((\t. inv(drop t) % ((f:real^M->real^1)(x + drop t % v) - f x)) --> l) (at (vec 0)))}` ASSUME_TAC THENL [X_GEN_TAC `v:real^M` THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = {x | x IN UNIV /\ P x}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_POINTS_OF_CONVERGENCE THEN REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV; CONTINUOUS_ON_CONST] THEN X_GEN_TAC `t:real^1` THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]; ALL_TAC] THEN MATCH_MP_TAC LIPSCHITZ_IMP_CONTINUOUS_ON THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL [EXPAND_TAC "dd" THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `v:real^M` THEN DISCH_TAC THEN MP_TAC(GEN `s:real^M->bool` (ISPECL [`s:real^M->bool`; `v:real^M`] FUBINI_NEGLIGIBLE_OFFSET)) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o snd)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s:real^N->bool = {} ==> negligible s`) THEN REWRITE_TAC[SET_RULE `{x | ~P x} = {} <=> !x. P x`] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_REWRITE_TAC I [NEGLIGIBLE_ON_INTERVALS] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN MP_TAC(ISPECL [`\h. (f:real^M->real^1) (y + drop h % v)`; `interval[a:real^1,b]`] LEBESGUE_DIFFERENTIATION_THEOREM) THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN ANTS_TAC THENL [MATCH_MP_TAC LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION THEN EXISTS_TAC `B * norm(v:real^M)` THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[NORM_MUL; GSYM DROP_SUB; GSYM NORM_1; VECTOR_ARITH `(x + a % v) - (x + b % v):real^M = (a - b) % v`] THEN REWRITE_TAC[REAL_LE_REFL; REAL_MUL_AC]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `h:real^1` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; VECTOR_DIFFERENTIABLE] THEN REWRITE_TAC[HAS_VECTOR_DERIVATIVE_AT_1D] THEN REPLICATE_TAC 3 AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `l:real^1` THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [LIM_AT_ZERO] THEN REWRITE_TAC[VECTOR_ADD_SUB; DROP_ADD; VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM VECTOR_ADD_ASSOC]]; ALL_TAC] THEN SUBGOAL_THEN `!c x v. ~(x IN dd) ==> (f':real^M->real^M->real^1) x (c % v) = c % f' x v` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`x:real^M`; `c % v:real^M`] th) THEN MP_TAC(ISPECL [`x:real^M`; `v:real^M`] th)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> p /\ r ==> q ==> s`] LIM_UNIQUE) THEN REWRITE_TAC[TRIVIAL_LIMIT_AT] THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_REFL; VECTOR_MUL_RZERO] THEN REWRITE_TAC[LIM_CONST]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `c:real` o MATCH_MP LIM_CMUL) THEN DISCH_THEN(MP_TAC o ISPECL [`at(vec 0:real^1)`; `\x:real^1. c % x`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] LIM_COMPOSE_AT))) THEN ASM_REWRITE_TAC[o_DEF; EVENTUALLY_AT; VECTOR_MUL_EQ_0] THEN SIMP_TAC[GSYM DIST_NZ] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_01]] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = c % vec 0`) THEN MATCH_MP_TAC LIM_CMUL THEN REWRITE_TAC[VECTOR_MUL_RZERO; LIM_AT_ID]; REWRITE_TAC[DROP_CMUL; REAL_INV_MUL; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `drop x * y = y * drop x`]]; ALL_TAC] THEN SUBGOAL_THEN `!v w r s p e. p < r + s /\ &0 < e ==> negligible {x | ~(x IN dd) /\ drop((f':real^M->real^M->real^1) x v) >= r + e /\ drop(f' x w) >= s + e /\ drop(f' x (v + w)) <= p - e}` (LABEL_TAC "*") THENL [ALL_TAC; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS { UNIONS {UNIONS {{x | ~(x IN dd) /\ drop((f':real^M->real^M->real^1) x v) >= r + e /\ drop(f' x w) >= s + e /\ drop(f' x (v + w)) <= p - e} |r,s| r IN rational /\ s IN {s | s IN rational /\ p < r + s}} |e,p| e IN {e | e IN rational /\ &0 < e} /\ p IN rational} | v IN qq UNION IMAGE (--) qq /\ w IN qq UNION IMAGE (--) qq}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT; COUNTABLE_UNION; COUNTABLE_IMAGE; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN REPLICATE_TAC 2 (MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN ASM_SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT; COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_RATIONAL; FORALL_IN_GSPEC] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_ELIM_THM] THEN STRIP_TAC) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[linear; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THEN SUBGOAL_THEN `(f':real^M->real^M->real^1) x continuous_on (:real^M)` MP_TAC THENL [MATCH_MP_TAC LIPSCHITZ_IMP_CONTINUOUS_ON THEN EXISTS_TAC `B:real` THEN MAP_EVERY X_GEN_TAC [`w:real^M`; `z:real^M`] THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `at (vec 0:real^1)` LIM_NORM_UBOUND) THEN EXISTS_TAC `\t. inv(drop t) % ((f:real^M->real^1)(x + drop t % w) - f x) - inv(drop t) % (f(x + drop t % z) - f x)` THEN ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_AT; EVENTUALLY_AT] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[GSYM DIST_NZ] THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; VECTOR_ARITH `a % (y - x) - a % (z - x):real^M = a % (y - z)`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ; GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = a * c * b`] THEN REWRITE_TAC[GSYM NORM_MUL] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN REWRITE_TAC[continuous_on; IN_UNIV] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `norm((f':real^M->real^M->real^1) x (u + v) - (f' x u + f' x v)) / &3`) THEN REWRITE_TAC[REAL_ARITH `&0 < x / &3 <=> &0 < x`] THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `u + v:real^M` th) THEN MP_TAC(SPEC `v:real^M` th) THEN MP_TAC(SPEC `u:real^M` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `du:real` THEN STRIP_TAC THEN X_GEN_TAC `dv:real` THEN STRIP_TAC THEN X_GEN_TAC `duv:real` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s = UNIV ==> !x. x IN s`)) THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`v:real^M`; `min dv (duv / &2)`] th) THEN MP_TAC(ISPECL [`u:real^M`; `min du (duv / &2)`] th)) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u':real^M` THEN STRIP_TAC THEN X_GEN_TAC `v':real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `~((f':real^M->real^M->real^1) x (u' + v') = f' x u' + f' x v')` MP_TAC THENL [MATCH_MP_TAC(NORM_ARITH `!u v uv. norm(uv' - uv) < norm(uv - (u + v)) / &3 /\ norm(u' - u) < norm(uv - (u + v)) / &3 /\ norm(v' - v) < norm(uv - (u + v)) / &3 ==> ~(uv':real^M = u' + v')`) THEN MAP_EVERY EXISTS_TAC [`(f':real^M->real^M->real^1) x u`; `(f':real^M->real^M->real^1) x v`; `(f':real^M->real^M->real^1) x (u + v)`] THEN REPEAT CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`dist(u':real^M,u) < duv / &2`; `dist(v':real^M,v) < duv / &2`] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DROP_EQ] THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `~(x = y) <=> x < y \/ y < x`] THEN REWRITE_TAC[DROP_ADD; REAL_ARITH `y + z < x <=> --x < --y + --z`] THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`u':real^M`; `v':real^M`]; MAP_EVERY EXISTS_TAC [`--u':real^M`; `--v':real^M`]] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[VECTOR_ARITH `--a + --b:real^N = --(a + b)`] THEN REWRITE_TAC[VECTOR_ARITH `--x:real^M = --(&1) % x`] THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[VECTOR_MUL_LNEG; VECTOR_MUL_LID; DROP_NEG] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; IN; GSYM CONJ_ASSOC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemur) THEN MESON_TAC[]] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `v + w:real^M = vec 0` THENL [MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `(y:real^M) IN dd` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH `v + w:real^N = vec 0 ==> w = --(&1) % v`)) THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^M = &0 % v`) THEN ASM_SIMP_TAC[DROP_CMUL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x | ~(x IN dd) /\ eventually (\t. (drop(f(x + drop t % v)) - drop(f(x:real^M))) / drop t >= r /\ (drop(f(x + drop t % w)) - drop(f x)) / drop t >= s /\ (drop(f(x + drop t % (v + w))) - drop(f x)) / drop t <= p) (at (vec 0))}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN dd` THEN ASM_REWRITE_TAC[EVENTUALLY_AND] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[real_gt] THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `v:real^M`]); FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `w:real^M`]); FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `v + w:real^M`])] THEN ASM_REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[DIST_1; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `!e. &0 < e ==> negligible {x | ~(x IN dd) /\ !t. ~(t = vec 0) /\ norm(t) < e ==> (drop(f(x + drop t % v)) - drop(f x)) / drop t >= r /\ (drop(f(x + drop t % w)) - drop(f x)) / drop t >= s /\ (drop(f(x + drop t % (v + w:real^M))) - drop(f x)) / drop t <= p}` ASSUME_TAC THENL [ALL_TAC; MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS { {x | ~(x IN dd) /\ !t. ~(t = vec 0) /\ norm(t) < inv(&n + &1) ==> (drop(f(x + drop t % v)) - drop(f x)) / drop t >= r /\ (drop(f(x + drop t % w)) - drop(f x)) / drop t >= s /\ (drop(f(x + drop t % (v + w:real^M))) - drop(f x)) / drop t <= p} | n IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; REWRITE_TAC[SUBSET; IN_UNIV; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN dd` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EVENTUALLY_AT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN REWRITE_TAC[DIST_0; NORM_POS_LT] THEN MESON_TAC[REAL_LT_TRANS]]] THEN UNDISCH_THEN `&0 < e` (K ALL_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(GEN `s:real^M->bool` (ISPECL [`s:real^M->bool`; `v + w:real^M`] FUBINI_NEGLIGIBLE_OFFSET)) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o snd)) THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `{x | ~(x IN s) /\ Q x} = (UNIV DIFF s) INTER {x | Q x}`] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL [REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN EXPAND_TAC "dd" THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE]; ALL_TAC] THEN REWRITE_TAC[lemma'] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED THEN MATCH_MP_TAC CLOSED_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REWRITE_TAC[real_ge] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REPEAT(MATCH_MP_TAC CLOSED_INTER THEN CONJ_TAC) THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 <= x <=> &0 <= drop(lift x)`] THEN ONCE_REWRITE_TAC[SET_RULE `{x | &0 <= drop(f x)} = {x | x IN UNIV /\ f x IN {y | &0 <= drop y}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN REWRITE_TAC[CLOSED_UNIV; drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[GSYM drop; LIFT_SUB; LIFT_DROP; LIFT_CMUL; ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN (CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]; ALL_TAC]) THEN MATCH_MP_TAC LIPSCHITZ_IMP_CONTINUOUS_ON THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_SUBSET] `{x | P x /\ Q x} SUBSET {x | Q x} /\ negligible {x | Q x} ==> negligible {x | P x /\ Q x}`) THEN CONJ_TAC THENL [SIMP_TAC[IN_ELIM_THM; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN MATCH_MP_TAC(MESON[] `(?e. &0 < e /\ !x y. x IN s /\ y IN s /\ ~(x = y) ==> e <= norm(y - x)) ==> !x:real^M. x IN s ==> ?e. &0 < e /\ !y. y IN s /\ ~(y = x) ==> e <= norm(y - x)`) THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[NORM_SUB; CONJ_ACI; EQ_SYM_EQ]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`r:real^1`; `s:real^1`] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN ABBREV_TAC `x = z + drop r % (v + w):real^M` THEN ABBREV_TAC `y = z + drop s % (v + w):real^M` THEN REWRITE_TAC[GSYM REAL_NOT_LT; NORM_1; DROP_SUB] THEN DISCH_TAC THEN ABBREV_TAC `t:real^1 = s - r` THEN SUBGOAL_THEN `~(t = vec 0) /\ &0 < drop t /\ norm(t) < e` STRIP_ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[VECTOR_SUB_EQ; DROP_SUB; NORM_1; REAL_SUB_LT] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ]; ALL_TAC] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `t:real^1`) (MP_TAC o SPEC `--t:real^1`)) THEN SUBGOAL_THEN `x + drop t % (v + w):real^M = y /\ y + drop(--t) % w = x + drop t % v` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["x"; "y"; "t"] THEN REWRITE_TAC[DROP_SUB; DROP_NEG] THEN CONV_TAC VECTOR_ARITH; ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; NORM_NEG]] THEN REWRITE_TAC[DROP_NEG; real_div; REAL_INV_NEG; REAL_MUL_RNEG] THEN ASM_REAL_ARITH_TAC);; let RADEMACHER = prove (`!f:real^M->real^N s. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> negligible {x | x IN s /\ ~(f differentiable (at x within s))}`, REPEAT GEN_TAC THEN REWRITE_TAC[LIPSCHITZ_ON_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `B:real`] KIRSZBRAUN) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN MP_TAC(ISPEC `g:real^M->real^N` RADEMACHER_UNIV) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IMP_CONJ; CONTRAPOS_THM] THEN X_GEN_TAC `x:real^M` THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`g:real^M->real^N`; `&1`] THEN ASM_SIMP_TAC[DIFFERENTIABLE_AT_WITHIN; REAL_LT_01]);; let RADEMACHER_OPEN = prove (`!f:real^M->real^N s. open s /\ (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> negligible {x | x IN s /\ ~(f differentiable (at x))}`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP RADEMACHER) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> (Q x <=> R x)) ==> {x | P x /\ ~R x} SUBSET {x | P x /\ ~Q x}`) THEN ASM_SIMP_TAC[DIFFERENTIABLE_WITHIN_OPEN]);; let RADEMACHER_GEN = prove (`!f:real^M->real^N s. negligible(frontier s) /\ (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> negligible {x | x IN s /\ ~(f differentiable (at x))}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `frontier s UNION {x | x IN interior s /\ ~((f:real^M->real^N) differentiable (at x))}` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN MATCH_MP_TAC RADEMACHER_OPEN THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET; OPEN_INTERIOR]; REWRITE_TAC[GSYM SET_DIFF_FRONTIER] THEN SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Stepanov's theorem (Maly's proof, slightly generalized by localization). *) (* ------------------------------------------------------------------------- *) let STEPANOV_GEN = prove (`!f:real^M->real^N s. lebesgue_measurable s ==> negligible {x | x IN s /\ (?B. eventually (\y. norm(f x - f y) / norm(x - y) <= B) (at x within s)) /\ ~(f differentiable at x within s)}`, let lemma = prove (`{x | x IN s /\ P x /\ ?i. i IN k /\ R i x} = UNIONS {{x | x IN s /\ P x /\ R i x} | i IN k}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in SUBGOAL_THEN `!f:real^M->real^1 s. lebesgue_measurable s ==> negligible {x | x IN s /\ (?B. eventually (\y. norm(f x - f y) / norm(x - y) <= B) (at x within s)) /\ ~(f differentiable at x within s)}` MP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^M->bool` THEN DISCH_TAC THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIFFERENTIABLE_COMPONENTWISE_WITHIN] THEN REWRITE_TAC[NOT_FORALL_THM; GSYM IN_NUMSEG; NOT_IMP; lemma] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x. lift((f:real^M->real^N) x$i)`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[COMPONENT_LE_NORM]] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `t = {x | x IN s /\ ?B. eventually (\y. norm(f x - f y:real^1) / norm(x - y) <= B) (at (x:real^M) within s)}` THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP (SET_RULE `{x | P x /\ Q x} = t ==> {x | P x /\ Q x /\ R x} = {x | x IN t /\ R x}`) th]) THEN ABBREV_TAC `us = { ball(x,e) | &0 < e /\ rational e /\ (!i. 1 <= i /\ i <= dimindex(:M) ==> rational(x$i)) /\ bounded (IMAGE (f:real^M->real^1) (ball(x,e) INTER s))}` THEN SUBGOAL_THEN `!x. x IN t ==> ?B. eventually (\y. norm(f x - f y:real^1) / norm(x - y) <= B) (at (x:real^M) within s)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real^M->real` THEN DISCH_TAC THEN SUBGOAL_THEN `!x:real^M. x IN t ==> INFINITE {c | c IN us /\ x IN c /\ !y. y IN c INTER s ==> norm(f x - f y:real^1) <= B x * norm(x - y)}` ASSUME_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[EVENTUALLY_WITHIN] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `x IN closure {x:real^M | !i. 1 <= i /\ i <= dimindex (:M) ==> rational (x$i)}` MP_TAC THENL [ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; IN_UNIV]; REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM]] THEN DISCH_THEN(MP_TAC o SPEC `d / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `q:real^M` STRIP_ASSUME_TAC)] THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `{ball(q:real^M,e) | rational e /\ d / &3 < e /\ e < &2 * d / &3}` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC INFINITE_IMAGE THEN CONJ_TAC THENL [MATCH_MP_TAC INFINITE_RATIONAL_IN_RANGE; REWRITE_TAC[IN_ELIM_THM; EQ_BALLS]] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXPAND_TAC "us" THEN REWRITE_TAC[IN_ELIM_THM; IN_BALL] THEN REPEAT CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`q:real^M`; `e:real`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `norm((f:real^M->real^1) x) + (abs(B x) + &1) * d` THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LT_MUL; REAL_LT_IMP_LE; REAL_ARITH `&0 < abs B + &1`] THEN MATCH_MP_TAC(NORM_ARITH `!a. norm(x - y:real^M) <= a /\ a <= b ==> norm(x) <= norm(y) + b`) THEN EXISTS_TAC `B(x) * norm(y - x:real^M)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM DIST_NZ]; TRANS_TAC REAL_LE_TRANS `(abs(B x) + &1) * norm(y - x:real^M)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_LMUL]]; ASM_REAL_ARITH_TAC; X_GEN_TAC `y:real^M` THEN REWRITE_TAC[IN_BALL; IN_INTER] THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL; GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM DIST_NZ]] THEN MAP_EVERY UNDISCH_TAC [`dist(q:real^M,x) < d / &3`; `dist(q:real^M,y) < e`; `e < &2 * d / &3`] THEN CONV_TAC NORM_ARITH]; ALL_TAC] THEN ASM_CASES_TAC `t:real^M->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; NOT_IN_EMPTY; NEGLIGIBLE_EMPTY] THEN MP_TAC(ISPEC `us:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN ANTS_TAC THENL [CONJ_TAC THENL [EXPAND_TAC "us" THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `{ball(a,e) | (a:real^M) IN {y | !i. 1 <= i /\ i <= dimindex(:M) ==> rational(y$i)} /\ e IN rational}` THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[COUNTABLE_RATIONAL_COORDINATES; COUNTABLE_RATIONAL]; SET_TAC[]]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; INFINITE; EMPTY_GSPEC; FINITE_EMPTY]]; DISCH_THEN(X_CHOOSE_THEN `b:num->real^M->bool` (ASSUME_TAC o SYM))] THEN ABBREV_TAC `u = \i x. lift(inf {drop((g:real^M->real^1)(x)) |g| (!x. x IN b i INTER s ==> drop(f x) <= drop(g x)) /\ (!x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(g x - g y) <= &i * norm(x - y))})` THEN ABBREV_TAC `v = \i x. lift(sup {drop((g:real^M->real^1)(x)) |g| (!x. x IN b i INTER s ==> drop(g x) <= drop(f x)) /\ (!x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(g x - g y) <= &i * norm(x - y))})` THEN SUBGOAL_THEN `!i x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(u i x - u i y:real^1) <= &i * norm(x - y:real^M)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "u" THEN REWRITE_TAC[] THEN MATCH_MP_TAC LIPSCHITZ_ON_INF THEN SIMP_TAC[REAL_POS] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `drop(f(x:real^M))` THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!i x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(v i x - v i y:real^1) <= &i * norm(x - y:real^M)` ASSUME_TAC THENL [GEN_TAC THEN EXPAND_TAC "v" THEN REWRITE_TAC[] THEN MATCH_MP_TAC LIPSCHITZ_ON_SUP THEN SIMP_TAC[REAL_POS] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `drop(f(x:real^M))` THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(!i:num x:real^M. x IN b i INTER s ==> drop(f x) <= drop(u i x)) /\ (!i z g. z IN b i INTER s /\ (!x. x IN b i INTER s ==> drop (f x) <= drop (g x)) /\ (!x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(g x - g y) <= &i * norm (x - y)) ==> drop(u i z) <= drop(g z))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`i:num`; `x:real^M`] THEN ASM_CASES_TAC `(x:real^M) IN b(i:num) INTER s` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `{drop((g:real^M->real^1)(x)) |g| (!x. x IN b i INTER s ==> drop(f x) <= drop(g x)) /\ (!x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(g x - g y) <= &i * norm(x - y))}` INF) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP (MESON[] `(\i x. f i x) = v ==> !i x. f i x = v i x`))) THEN GEN_REWRITE_TAC I [IMP_IMP] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `drop((f:real^M->real^1) x)` THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN MATCH_MP_TAC(SET_RULE `(?x. P x) ==> ~({f x | P x} = {})`) THEN SUBGOAL_THEN `bounded(IMAGE (f:real^M->real^1) (b(i:num) INTER s))` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[BOUNDED_POS]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; NORM_1] THEN X_GEN_TAC `C:real` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^M. lift C` THEN REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; REAL_ABS_NUM; LIFT_DROP] THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; NORM_POS_LE] THEN ASM_MESON_TAC[REAL_ARITH `abs x <= C ==> x <= C`]; REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(!i:num x:real^M. x IN b i INTER s ==> drop(v i x) <= drop(f x)) /\ (!i z g. z IN b i INTER s /\ (!x. x IN b i INTER s ==> drop (g x) <= drop (f x)) /\ (!x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(g x - g y) <= &i * norm (x - y)) ==> drop(g z) <= drop(v i z))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`i:num`; `x:real^M`] THEN ASM_CASES_TAC `(x:real^M) IN b(i:num) INTER s` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `{drop((g:real^M->real^1)(x)) |g| (!x. x IN b i INTER s ==> drop(g x) <= drop(f x)) /\ (!x y. x IN b i INTER s /\ y IN b i INTER s ==> norm(g x - g y) <= &i * norm(x - y))}` SUP) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP (MESON[] `(\i x. f i x) = v ==> !i x. f i x = v i x`))) THEN GEN_REWRITE_TAC I [IMP_IMP] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `drop((f:real^M->real^1) x)` THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN MATCH_MP_TAC(SET_RULE `(?x. P x) ==> ~({f x | P x} = {})`) THEN SUBGOAL_THEN `bounded(IMAGE (f:real^M->real^1) (b(i:num) INTER s))` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[BOUNDED_POS]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; NORM_1] THEN X_GEN_TAC `C:real` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^M. lift(--C)` THEN REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; REAL_ABS_NUM; LIFT_DROP] THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; NORM_POS_LE] THEN ASM_MESON_TAC[REAL_ARITH `abs x <= C ==> --C <= x`]; REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!a. a IN t ==> ?i. a IN b i /\ (u:num->real^M->real^1) i a = v i a` ASSUME_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^M) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_CHOOSE_TAC `M:num` (SPEC `(B:real^M->real) x` REAL_ARCH_SIMPLE) THEN SUBGOAL_THEN `INFINITE({i | x IN b i /\ !y. y IN b i INTER s ==> norm((f:real^M->real^1) x - f y) <= B x * norm(x - y)} DIFF (0..M))` MP_TAC THENL [MATCH_MP_TAC INFINITE_DIFF_FINITE THEN REWRITE_TAC[FINITE_NUMSEG] THEN REWRITE_TAC[INFINITE] THEN DISCH_THEN(MP_TAC o ISPEC `b:num->real^M->bool` o MATCH_MP FINITE_IMAGE) THEN REWRITE_TAC[GSYM INFINITE] THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `{c | c IN us /\ (x:real^M) IN c /\ !y. y IN c INTER s ==> norm(f x - f y:real^1) <= B x * norm(x - y)}` THEN ASM_SIMP_TAC[] THEN SUBST1_TAC(SYM(ASSUME `IMAGE (b:num->real^M->bool) (:num) = us`)) THEN SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (MESON[FINITE_EMPTY; INFINITE] `INFINITE s ==> ~(s = {})`))] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_NUMSEG] THEN REWRITE_TAC[LE_0; NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_INTER; REAL_LE_TRANS]] THEN TRANS_TAC REAL_LE_TRANS `drop(f(x:real^M))` THEN CONJ_TAC THENL [SUBGOAL_THEN `f x = (\y:real^M. f x + &i % lift(norm(y - x))) x` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; LIFT_NUM; VECTOR_MUL_RZERO; VECTOR_ADD_RID]; ALL_TAC]; SUBGOAL_THEN `f x = (\y:real^M. f x - &i % lift(norm(y - x))) x` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; LIFT_NUM; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]; ALL_TAC]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[VECTOR_ARITH `(x - a) - (x - b):real^M = --(a - b)`; VECTOR_ARITH `(x + a) - (x + b):real^M = a - b`] THEN REWRITE_TAC[NORM_NEG; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN REWRITE_TAC[REAL_ABS_NUM; GSYM LIFT_SUB; NORM_LIFT] THEN (CONJ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC NORM_ARITH]) THEN REWRITE_TAC[DROP_ADD; DROP_SUB] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `abs(y - x) <= e ==> y <= x + e`); MATCH_MP_TAC(REAL_ARITH `abs(y - x) <= e ==> x - e <= y`)] THEN REWRITE_TAC[GSYM DROP_SUB; GSYM NORM_1; DROP_CMUL; LIFT_DROP] THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; REAL_MUL_RZERO; REAL_LE_REFL; NORM_0] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN TRANS_TAC REAL_LE_TRANS `&M` THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; LT_IMP_LE] THEN TRANS_TAC REAL_LE_TRANS `(B:real^M->real) x` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER]; ALL_TAC] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x | x IN b i INTER s /\ ~((u i:real^M->real^1) differentiable (at x within s))} UNION {x | x IN b i INTER s /\ ~((v i:real^M->real^1) differentiable (at x within s))} | i IN (:num)} UNION {x | x IN s /\ ~(((\e. lift(measure(s INTER ball(x,drop e)) / measure(ball(x,drop e)))) --> vec 1) (at (vec 0) within {t | &0 < drop t}))}` THEN CONJ_TAC THENL [REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[] `negligible {x | x IN b INTER s /\ P x (b INTER s)} /\ {x | x IN b INTER s /\ P x (b INTER s)} = {x | x IN b INTER s /\ P x s} ==> negligible {x | x IN b INTER s /\ P x s}`) THEN (CONJ_TAC THENL [MATCH_MP_TAC RADEMACHER THEN ASM_MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ ~q <=> p /\ ~r)`) THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN REWRITE_TAC[differentiable; has_derivative_within] THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC LIM_WITHIN_INTERIOR_INTER THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> interior s = s ==> x IN interior s`)) THEN MATCH_MP_TAC INTERIOR_OPEN THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE b UNIV = u ==> (!x. x IN u ==> open x) ==> open(b i)`)) THEN EXPAND_TAC "us" THEN REWRITE_TAC[FORALL_IN_GSPEC; OPEN_BALL]; FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_DENSITY_THEOREM_LIFT_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `a:real^M` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN SUBGOAL_THEN `(a:real^M) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[IN_UNION; DE_MORGAN_THM; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN SUBGOAL_THEN `?i. a IN b i /\ (u:num->real^M->real^1) i a = v i a` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `u = v ==> !f. v <= f /\ f <= u ==> u = f /\ v = f`) o GEN_REWRITE_RULE I [GSYM DROP_EQ]) THEN DISCH_THEN(MP_TAC o SPEC `drop(f(a:real^M))`) THEN ASM_SIMP_TAC[IN_INTER; DROP_EQ] THEN STRIP_TAC THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN REWRITE_TAC[differentiable; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u':real^M->real^1` THEN DISCH_TAC THEN X_GEN_TAC `v':real^M->real^1` THEN DISCH_TAC THEN EXISTS_TAC `u':real^M->real^1` THEN SUBGOAL_THEN `v':real^M->real^1 = u'` SUBST_ALL_TAC THENL [ALL_TAC; MAP_EVERY UNDISCH_TAC [`((u:num->real^M->real^1) i has_derivative u') (at a within s)`; `((v:num->real^M->real^1) i has_derivative u') (at a within s)`] THEN ASM_REWRITE_TAC[has_derivative_within] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[tendsto; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN SUBGOAL_THEN `a IN interior((b:num->real^M->bool) i)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> interior s = s ==> x IN interior s`)) THEN MATCH_MP_TAC INTERIOR_OPEN THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE b UNIV = u ==> (!x. x IN u ==> open x) ==> open(b i)`)) THEN EXPAND_TAC "us" THEN REWRITE_TAC[FORALL_IN_GSPEC; OPEN_BALL]; REWRITE_TAC[IN_INTERIOR]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN REWRITE_TAC[DIST_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[NORM_1; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `v <= f /\ f <= u ==> abs(v - x) < e /\ abs(u - x) < e ==> abs(f - x) < e`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]] THEN REWRITE_TAC[FUN_EQ_THM] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN GEN_REWRITE_TAC I [GSYM FUN_EQ_THM] THEN MATCH_MP_TAC DIFFERENTIAL_ZERO_MAXMIN_DENSITY THEN MAP_EVERY EXISTS_TAC [`\x. (v:num->real^M->real^1) i x - u i x`; `s:real^M->bool`; `a:real^M`] THEN ASM_SIMP_TAC[HAS_DERIVATIVE_SUB; ETA_AX] THEN DISJ2_TAC THEN REWRITE_TAC[DROP_SUB; REAL_ARITH `v - u <= a - a <=> v <= u`] THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN SUBGOAL_THEN `a IN interior((b:num->real^M->bool) i)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> interior s = s ==> x IN interior s`)) THEN MATCH_MP_TAC INTERIOR_OPEN THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE b UNIV = u ==> (!x. x IN u ==> open x) ==> open(b i)`)) THEN EXPAND_TAC "us" THEN REWRITE_TAC[FORALL_IN_GSPEC; OPEN_BALL]; REWRITE_TAC[IN_INTERIOR]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `drop((f:real^M->real^1) x)` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]);; let STEPANOV = prove (`!f:real^M->real^N s. open s ==> negligible {x | x IN s /\ (?B. eventually (\y. norm(f x - f y) / norm(x - y) <= B) (at x)) /\ ~(f differentiable at x)}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_OPEN) THEN DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP STEPANOV_GEN) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_SIMP_TAC[DIFFERENTIABLE_WITHIN_OPEN; EVENTUALLY_WITHIN_OPEN]);; let STEPANOV_UNIV = prove (`!f:real^M->real^N. negligible {x | (?B. eventually (\y. norm(f x - f y) / norm(x - y) <= B) (at x)) /\ ~(f differentiable at x)}`, GEN_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] STEPANOV) THEN ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV]);; hol-light/Multivariate/metric.ml000066400000000000000000005221011303454263000172310ustar00rootroot00000000000000(* ========================================================================= *) (* Formalization of general topological and metric spaces in HOL Light *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "Multivariate/misc.ml";; needs "Library/iter.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* Instrument classical tactics to attach label to inductive hypothesis. *) (* ------------------------------------------------------------------------- *) let LABEL_INDUCT_TAC = let IND_TAC = MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC in fun (asl,w as gl) -> let s = fst (dest_var (fst (dest_forall w))) in (IND_TAC THENL [ALL_TAC; GEN_TAC THEN DISCH_THEN (LABEL_TAC("ind_"^s))]) gl;; let LABEL_ABBREV_TAC tm = let cvs,t = dest_eq tm in let v,vs = strip_comb cvs in let s = name_of v in let rs = list_mk_abs(vs,t) in let eq = mk_eq(rs,v) in let th1 = itlist (fun v th -> CONV_RULE(LAND_CONV BETA_CONV) (AP_THM th v)) (rev vs) (ASSUME eq) in let th2 = SIMPLE_CHOOSE v (SIMPLE_EXISTS v (GENL vs th1)) in let th3 = PROVE_HYP (EXISTS(mk_exists(v,eq),rs) (REFL rs)) th2 in fun (asl,w as gl) -> let avoids = itlist (union o frees o concl o snd) asl (frees w) in if mem v avoids then failwith "LABEL_ABBREV_TAC: variable already used" else CHOOSE_THEN (fun th -> RULE_ASSUM_TAC(PURE_ONCE_REWRITE_RULE[th]) THEN PURE_ONCE_REWRITE_TAC[th] THEN LABEL_TAC s th) th3 gl;; (* ------------------------------------------------------------------------- *) (* Further tactics for structuring the proof flow. *) (* ------------------------------------------------------------------------- *) let CUT_TAC : term -> tactic = let th = MESON [] `(p ==> q) /\ p ==> q` and ptm = `p:bool` in fun tm -> MATCH_MP_TAC (INST [tm,ptm] th) THEN CONJ_TAC;; let CLAIM_TAC s tm = SUBGOAL_THEN tm (DESTRUCT_TAC s);; let CONJ_LIST = end_itlist CONJ;; (* ------------------------------------------------------------------------- *) (* General notion of a topology. *) (* ------------------------------------------------------------------------- *) let istopology = new_definition `istopology L <=> {} IN L /\ (!s t. s IN L /\ t IN L ==> (s INTER t) IN L) /\ (!k. k SUBSET L ==> (UNIONS k) IN L)`;; let topology_tybij_th = prove (`?t:(A->bool)->bool. istopology t`, EXISTS_TAC `UNIV:(A->bool)->bool` THEN REWRITE_TAC[istopology; IN_UNIV]);; let topology_tybij = new_type_definition "topology" ("topology","open_in") topology_tybij_th;; let ISTOPOLOGY_OPEN_IN = prove (`istopology(open_in top)`, MESON_TAC[topology_tybij]);; let TOPOLOGY_EQ = prove (`!top1 top2. top1 = top2 <=> !s. open_in top1 s <=> open_in top2 s`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM FUN_EQ_THM] THEN REWRITE_TAC[ETA_AX] THEN MESON_TAC[topology_tybij]);; (* ------------------------------------------------------------------------- *) (* Infer the "universe" from union of all sets in the topology. *) (* ------------------------------------------------------------------------- *) let topspace = new_definition `topspace top = UNIONS {s | open_in top s}`;; (* ------------------------------------------------------------------------- *) (* Main properties of open sets. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_CLAUSES = prove (`!top:(A)topology. open_in top {} /\ (!s t. open_in top s /\ open_in top t ==> open_in top (s INTER t)) /\ (!k. (!s. s IN k ==> open_in top s) ==> open_in top (UNIONS k))`, SIMP_TAC[IN; SUBSET; SIMP_RULE[istopology; IN; SUBSET] ISTOPOLOGY_OPEN_IN]);; let OPEN_IN_SUBSET = prove (`!top s. open_in top s ==> s SUBSET (topspace top)`, REWRITE_TAC[topspace] THEN SET_TAC[]);; let OPEN_IN_EMPTY = prove (`!top. open_in top {}`, REWRITE_TAC[OPEN_IN_CLAUSES]);; let OPEN_IN_INTER = prove (`!top s t. open_in top s /\ open_in top t ==> open_in top (s INTER t)`, REWRITE_TAC[OPEN_IN_CLAUSES]);; let OPEN_IN_UNIONS = prove (`!top k. (!s. s IN k ==> open_in top s) ==> open_in top (UNIONS k)`, REWRITE_TAC[OPEN_IN_CLAUSES]);; let OPEN_IN_UNION = prove (`!top s t. open_in top s /\ open_in top t ==> open_in top (s UNION t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[]);; let OPEN_IN_TOPSPACE = prove (`!top. open_in top (topspace top)`, SIMP_TAC[topspace; OPEN_IN_UNIONS; IN_ELIM_THM]);; let OPEN_IN_INTERS = prove (`!top s:(A->bool)->bool. FINITE s /\ ~(s = {}) /\ (!t. t IN s ==> open_in top t) ==> open_in top (INTERS s)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INTERS_INSERT; IMP_IMP; NOT_INSERT_EMPTY; FORALL_IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`s:A->bool`; `f:(A->bool)->bool`] THEN ASM_CASES_TAC `f:(A->bool)->bool = {}` THEN ASM_SIMP_TAC[INTERS_0; INTER_UNIV] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_INTER THEN ASM_SIMP_TAC[]);; let OPEN_IN_SUBOPEN = prove (`!top s:A->bool. open_in top s <=> !x. x IN s ==> ?t. open_in top t /\ x IN t /\ t SUBSET s`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[GSYM FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_UNIONS) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Closed sets. *) (* ------------------------------------------------------------------------- *) let closed_in = new_definition `closed_in top s <=> s SUBSET (topspace top) /\ open_in top (topspace top DIFF s)`;; let CLOSED_IN_SUBSET = prove (`!top s. closed_in top s ==> s SUBSET (topspace top)`, MESON_TAC[closed_in]);; let CLOSED_IN_EMPTY = prove (`!top. closed_in top {}`, REWRITE_TAC[closed_in; EMPTY_SUBSET; DIFF_EMPTY; OPEN_IN_TOPSPACE]);; let CLOSED_IN_TOPSPACE = prove (`!top. closed_in top (topspace top)`, REWRITE_TAC[closed_in; SUBSET_REFL; DIFF_EQ_EMPTY; OPEN_IN_EMPTY]);; let CLOSED_IN_UNION = prove (`!top s t. closed_in top s /\ closed_in top t ==> closed_in top (s UNION t)`, SIMP_TAC[closed_in; UNION_SUBSET; OPEN_IN_INTER; SET_RULE `u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)`]);; let CLOSED_IN_INTERS = prove (`!top k:(A->bool)->bool. ~(k = {}) /\ (!s. s IN k ==> closed_in top s) ==> closed_in top (INTERS k)`, REPEAT GEN_TAC THEN REWRITE_TAC[closed_in] THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `topspace top DIFF INTERS k :A->bool = UNIONS {topspace top DIFF s | s IN k}` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[]] THEN GEN_REWRITE_TAC I [EXTENSION] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[IN_UNIONS; IN_INTERS; IN_DIFF; EXISTS_IN_IMAGE] THEN MESON_TAC[]);; let CLOSED_IN_INTER = prove (`!top s t. closed_in top s /\ closed_in top t ==> closed_in top (s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM SET_TAC[]);; let OPEN_IN_CLOSED_IN_EQ = prove (`!top s. open_in top s <=> s SUBSET topspace top /\ closed_in top (topspace top DIFF s)`, REWRITE_TAC[closed_in; SET_RULE `(u DIFF s) SUBSET u`] THEN REWRITE_TAC[SET_RULE `u DIFF (u DIFF s) = u INTER s`] THEN MESON_TAC[OPEN_IN_SUBSET; SET_RULE `s SUBSET t ==> t INTER s = s`]);; let OPEN_IN_CLOSED_IN = prove (`!s. s SUBSET topspace top ==> (open_in top s <=> closed_in top (topspace top DIFF s))`, SIMP_TAC[OPEN_IN_CLOSED_IN_EQ]);; let OPEN_IN_DIFF = prove (`!top s t:A->bool. open_in top s /\ closed_in top t ==> open_in top (s DIFF t)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s DIFF t :A->bool = s INTER (topspace top DIFF t)` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN SET_TAC[]; MATCH_MP_TAC OPEN_IN_INTER THEN ASM_MESON_TAC[closed_in]]);; let CLOSED_IN_DIFF = prove (`!top s t:A->bool. closed_in top s /\ open_in top t ==> closed_in top (s DIFF t)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s DIFF t :A->bool = s INTER (topspace top DIFF t)` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN SET_TAC[]; MATCH_MP_TAC CLOSED_IN_INTER THEN ASM_MESON_TAC[OPEN_IN_CLOSED_IN_EQ]]);; let CLOSED_IN_UNIONS = prove (`!top s. FINITE s /\ (!t. t IN s ==> closed_in top t) ==> closed_in top (UNIONS s)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_INSERT; UNIONS_0; CLOSED_IN_EMPTY; IN_INSERT] THEN MESON_TAC[CLOSED_IN_UNION]);; let CLOSED_IN_LOCALLY_FINITE_UNIONS = prove (`!top f:(A->bool)->bool. (!s. s IN f ==> closed_in top s) /\ (!x. x IN topspace top ==> ?v. open_in top v /\ x IN v /\ FINITE {s | s IN f /\ ~(s INTER v = {})}) ==> closed_in top (UNIONS f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[closed_in] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[closed_in]) THEN ASM_SIMP_TAC[UNIONS_SUBSET]; ALL_TAC] THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `v DIFF UNIONS {s | s IN f /\ ~(s INTER v = {})}:A->bool` THEN ASM_REWRITE_TAC[IN_DIFF; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[IN_ELIM_THM]; FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Subspace topology. *) (* ------------------------------------------------------------------------- *) let subtopology = new_definition `subtopology top u = topology {s INTER u | open_in top s}`;; let ISTOPLOGY_SUBTOPOLOGY = prove (`!top u:A->bool. istopology {s INTER u | open_in top s}`, REWRITE_TAC[istopology; SET_RULE `{s INTER u | open_in top s} = IMAGE (\s. s INTER u) {s | open_in top s}`] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[SUBSET_IMAGE; IN_IMAGE; IN_ELIM_THM; SUBSET] THEN REPEAT GEN_TAC THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `{}:A->bool` THEN REWRITE_TAC[OPEN_IN_EMPTY; INTER_EMPTY]; SIMP_TAC[SET_RULE `(s INTER u) INTER t INTER u = (s INTER t) INTER u`] THEN ASM_MESON_TAC[OPEN_IN_INTER]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(A->bool)->bool`; `g:(A->bool)->bool`] THEN STRIP_TAC THEN EXISTS_TAC `UNIONS g :A->bool` THEN ASM_SIMP_TAC[OPEN_IN_UNIONS; INTER_UNIONS] THEN SET_TAC[]]);; let OPEN_IN_SUBTOPOLOGY = prove (`!top u s. open_in (subtopology top u) s <=> ?t. open_in top t /\ s = t INTER u`, REWRITE_TAC[subtopology] THEN SIMP_TAC[REWRITE_RULE[CONJUNCT2 topology_tybij] ISTOPLOGY_SUBTOPOLOGY] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]);; let OPEN_IN_RELATIVE_TO = prove (`!top s t:A->bool. (open_in top relative_to s) t <=> open_in (subtopology top s) t`, REWRITE_TAC[relative_to; OPEN_IN_SUBTOPOLOGY] THEN MESON_TAC[INTER_COMM]);; let TOPSPACE_SUBTOPOLOGY = prove (`!top u. topspace(subtopology top u) = topspace top INTER u`, REWRITE_TAC[topspace; OPEN_IN_SUBTOPOLOGY; INTER_UNIONS] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM]);; let TOPSPACE_SUBTOPOLOGY_SUBSET = prove (`!top s:A->bool. topspace(subtopology top s) SUBSET s`, REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; INTER_SUBSET]);; let CLOSED_IN_SUBTOPOLOGY = prove (`!top u s. closed_in (subtopology top u) s <=> ?t:A->bool. closed_in top t /\ s = t INTER u`, REWRITE_TAC[closed_in; TOPSPACE_SUBTOPOLOGY] THEN REWRITE_TAC[SUBSET_INTER; OPEN_IN_SUBTOPOLOGY; RIGHT_AND_EXISTS_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `topspace top DIFF t :A->bool` THEN ASM_SIMP_TAC[CLOSED_IN_TOPSPACE; OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_TOPSPACE] THEN ASM SET_TAC[]);; let CLOSED_IN_RELATIVE_TO = prove (`!top s t:A->bool. (closed_in top relative_to s) t <=> closed_in (subtopology top s) t`, REWRITE_TAC[relative_to; CLOSED_IN_SUBTOPOLOGY] THEN MESON_TAC[INTER_COMM]);; let SUBTOPOLOGY_SUBTOPOLOGY = prove (`!top s t:A->bool. subtopology (subtopology top s) t = subtopology top (s INTER t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[subtopology] THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN REWRITE_TAC[SET_RULE `{f x | ?y. P y /\ x = g y} = {f(g y) | P y}`] THEN REWRITE_TAC[INTER_ASSOC]);; let OPEN_IN_SUBTOPOLOGY_EMPTY = prove (`!top s. open_in (subtopology top {}) s <=> s = {}`, REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; INTER_EMPTY] THEN MESON_TAC[OPEN_IN_EMPTY]);; let CLOSED_IN_SUBTOPOLOGY_EMPTY = prove (`!top s. closed_in (subtopology top {}) s <=> s = {}`, REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY; INTER_EMPTY] THEN MESON_TAC[CLOSED_IN_EMPTY]);; let OPEN_IN_SUBTOPOLOGY_REFL = prove (`!top u:A->bool. open_in (subtopology top u) u <=> u SUBSET topspace top`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN ASM_SIMP_TAC[OPEN_IN_SUBSET]; DISCH_TAC THEN EXISTS_TAC `topspace top:A->bool` THEN REWRITE_TAC[OPEN_IN_TOPSPACE] THEN ASM SET_TAC[]]);; let CLOSED_IN_SUBTOPOLOGY_REFL = prove (`!top u:A->bool. closed_in (subtopology top u) u <=> u SUBSET topspace top`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY] THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN ASM_SIMP_TAC[CLOSED_IN_SUBSET]; DISCH_TAC THEN EXISTS_TAC `topspace top:A->bool` THEN REWRITE_TAC[CLOSED_IN_TOPSPACE] THEN ASM SET_TAC[]]);; let SUBTOPOLOGY_SUPERSET = prove (`!top s:A->bool. topspace top SUBSET s ==> subtopology top s = top`, REPEAT GEN_TAC THEN SIMP_TAC[TOPOLOGY_EQ; OPEN_IN_SUBTOPOLOGY] THEN DISCH_TAC THEN X_GEN_TAC `u:A->bool` THEN EQ_TAC THENL [DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP OPEN_IN_SUBSET th)) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; DISCH_TAC THEN EXISTS_TAC `u:A->bool` THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN ASM SET_TAC[]]);; let SUBTOPOLOGY_TOPSPACE = prove (`!top. subtopology top (topspace top) = top`, SIMP_TAC[SUBTOPOLOGY_SUPERSET; SUBSET_REFL]);; let SUBTOPOLOGY_UNIV = prove (`!top. subtopology top UNIV = top`, SIMP_TAC[SUBTOPOLOGY_SUPERSET; SUBSET_UNIV]);; let OPEN_IN_IMP_SUBSET = prove (`!top s t. open_in (subtopology top s) t ==> t SUBSET s`, REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN SET_TAC[]);; let CLOSED_IN_IMP_SUBSET = prove (`!top s t. closed_in (subtopology top s) t ==> t SUBSET s`, REWRITE_TAC[closed_in; TOPSPACE_SUBTOPOLOGY] THEN SET_TAC[]);; let OPEN_IN_SUBTOPOLOGY_UNION = prove (`!top s t u:A->bool. open_in (subtopology top t) s /\ open_in (subtopology top u) s ==> open_in (subtopology top (t UNION u)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s':A->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t':A->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `s' INTER t':A->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER] THEN ASM SET_TAC[]);; let CLOSED_IN_SUBTOPOLOGY_UNION = prove (`!top s t u:A->bool. closed_in (subtopology top t) s /\ closed_in (subtopology top u) s ==> closed_in (subtopology top (t UNION u)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s':A->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t':A->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `s' INTER t':A->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER] THEN ASM SET_TAC[]);; let OPEN_IN_SUBTOPOLOGY_INTER_SUBSET = prove (`!top s u v:A->bool. open_in (subtopology top u) (u INTER s) /\ v SUBSET u ==> open_in (subtopology top v) (v INTER s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Derived set (set of limit points). *) (* ------------------------------------------------------------------------- *) parse_as_infix("derived_set_of",(21,"right"));; let derived_set_of = new_definition `top derived_set_of s = {x:A | x IN topspace top /\ (!t. x IN t /\ open_in top t ==> ?y. ~(y = x) /\ y IN s /\ y IN t)}`;; let DERIVED_SET_OF_RESTRICT = prove (`!top s:A->bool. top derived_set_of s = top derived_set_of (topspace top INTER s)`, REWRITE_TAC[derived_set_of; EXTENSION; IN_ELIM_THM; IN_INTER] THEN MESON_TAC[REWRITE_RULE[SUBSET] OPEN_IN_SUBSET]);; let IN_DERIVED_SET_OF = prove (`!top s x:A. x IN top derived_set_of s <=> x IN topspace top /\ (!t. x IN t /\ open_in top t ==> ?y. ~(y = x) /\ y IN s /\ y IN t)`, REWRITE_TAC[derived_set_of; IN_ELIM_THM]);; let DERIVED_SET_OF_SUBSET_TOPSPACE = prove (`!top s:A->bool. top derived_set_of s SUBSET topspace top`, REWRITE_TAC[derived_set_of] THEN SET_TAC[]);; let DERIVED_SET_OF_SUBTOPOLOGY = prove (`!top u s:A->bool. (subtopology top u) derived_set_of s = u INTER top derived_set_of (u INTER s)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[derived_set_of; OPEN_IN_SUBTOPOLOGY; TOPSPACE_SUBTOPOLOGY] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] THEN REWRITE_TAC[FORALL_UNWIND_THM2; IN_INTER; IN_ELIM_THM] THEN ASM SET_TAC[]);; let DERIVED_SET_OF_SUBSET_SUBTOPOLOGY = prove (`!top s t:A->bool. (subtopology top s) derived_set_of t SUBSET s`, SIMP_TAC[DERIVED_SET_OF_SUBTOPOLOGY; INTER_SUBSET]);; let DERIVED_SET_OF_EMPTY = prove (`!top:A topology. top derived_set_of {} = {}`, REWRITE_TAC[EXTENSION; IN_DERIVED_SET_OF; NOT_IN_EMPTY] THEN MESON_TAC[OPEN_IN_TOPSPACE]);; let DERIVED_SET_OF_MONO = prove (`!top s t:A->bool. s SUBSET t ==> top derived_set_of s SUBSET top derived_set_of t`, REWRITE_TAC[derived_set_of] THEN SET_TAC[]);; let DERIVED_SET_OF_UNION = prove (`!top s t:A->bool. top derived_set_of (s UNION t) = top derived_set_of s UNION top derived_set_of t`, REPEAT GEN_TAC THEN SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; UNION_SUBSET; DERIVED_SET_OF_MONO; SUBSET_UNION] THEN REWRITE_TAC[SUBSET; IN_DERIVED_SET_OF; IN_UNION] THEN X_GEN_TAC `x:A` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `u:A->bool`) (X_CHOOSE_TAC `v:A->bool`)) THEN EXISTS_TAC `u INTER v:A->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER] THEN ASM_MESON_TAC[]);; let DERIVED_SET_OF_UNIONS = prove (`!top (f:(A->bool)->bool). FINITE f ==> top derived_set_of (UNIONS f) = UNIONS {top derived_set_of s | s IN f}`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[UNIONS_0; NOT_IN_EMPTY; UNIONS_INSERT; DERIVED_SET_OF_EMPTY; DERIVED_SET_OF_UNION; SIMPLE_IMAGE; IMAGE_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Closure with respect to a topological space. *) (* ------------------------------------------------------------------------- *) parse_as_infix("closure_of",(21,"right"));; let closure_of = new_definition `top closure_of s = {x:A | x IN topspace top /\ (!t. x IN t /\ open_in top t ==> ?y. y IN s /\ y IN t)}`;; let CLOSURE_OF_RESTRICT = prove (`!top s:A->bool. top closure_of s = top closure_of (topspace top INTER s)`, REWRITE_TAC[closure_of; EXTENSION; IN_ELIM_THM; IN_INTER] THEN MESON_TAC[REWRITE_RULE[SUBSET] OPEN_IN_SUBSET]);; let IN_CLOSURE_OF = prove (`!top s x:A. x IN top closure_of s <=> x IN topspace top /\ (!t. x IN t /\ open_in top t ==> ?y. y IN s /\ y IN t)`, REWRITE_TAC[closure_of; IN_ELIM_THM]);; let CLOSURE_OF = prove (`!top s:A->bool. top closure_of s = topspace top INTER (s UNION top derived_set_of s)`, REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN FIX_TAC "[x]" THEN REWRITE_TAC[IN_CLOSURE_OF; IN_DERIVED_SET_OF; IN_UNION; IN_INTER] THEN ASM_CASES_TAC `x:A IN topspace top` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(LABEL_TAC "x_ok") THEN MESON_TAC[]);; let CLOSURE_OF_ALT = prove (`!top s:A->bool. top closure_of s = topspace top INTER s UNION top derived_set_of s`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSURE_OF] THEN MP_TAC(ISPECL [`top:A topology`; `s:A->bool`] DERIVED_SET_OF_SUBSET_TOPSPACE) THEN SET_TAC[]);; let DERIVED_SET_OF_SUBSET_CLOSURE_OF = prove (`!top s:A->bool. top derived_set_of s SUBSET top closure_of s`, REWRITE_TAC[CLOSURE_OF; SUBSET_INTER; DERIVED_SET_OF_SUBSET_TOPSPACE] THEN SIMP_TAC[SUBSET_UNION]);; let CLOSURE_OF_SUBTOPOLOGY = prove (`!top u s:A->bool. (subtopology top u) closure_of s = u INTER (top closure_of (u INTER s))`, SIMP_TAC[CLOSURE_OF; TOPSPACE_SUBTOPOLOGY; DERIVED_SET_OF_SUBTOPOLOGY] THEN SET_TAC[]);; let CLOSURE_OF_EMPTY = prove (`!top. top closure_of {}:A->bool = {}`, REWRITE_TAC[EXTENSION; IN_CLOSURE_OF; NOT_IN_EMPTY] THEN MESON_TAC[OPEN_IN_TOPSPACE]);; let CLOSURE_OF_TOPSPACE = prove (`!top:A topology. top closure_of topspace top = topspace top`, REWRITE_TAC[EXTENSION; IN_CLOSURE_OF] THEN MESON_TAC[]);; let CLOSURE_OF_UNIV = prove (`!top. top closure_of (:A) = topspace top`, REWRITE_TAC[closure_of] THEN SET_TAC[]);; let CLOSURE_OF_SUBSET_TOPSPACE = prove (`!top s:A->bool. top closure_of s SUBSET topspace top`, REWRITE_TAC[closure_of] THEN SET_TAC[]);; let CLOSURE_OF_SUBSET_SUBTOPOLOGY = prove (`!top s t:A->bool. (subtopology top s) closure_of t SUBSET s`, REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; closure_of] THEN SET_TAC[]);; let CLOSURE_OF_MONO = prove (`!top s t:A->bool. s SUBSET t ==> top closure_of s SUBSET top closure_of t`, REWRITE_TAC[closure_of] THEN SET_TAC[]);; let CLOSURE_OF_SUBTOPOLOGY_SUBSET = prove (`!top s u:A->bool. (subtopology top u) closure_of s SUBSET (top closure_of s)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET u`) THEN MATCH_MP_TAC CLOSURE_OF_MONO THEN REWRITE_TAC[INTER_SUBSET]);; let CLOSURE_OF_SUBTOPOLOGY_MONO = prove (`!top s t u:A->bool. t SUBSET u ==> (subtopology top t) closure_of s SUBSET (subtopology top u) closure_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSURE_OF_MONO THEN ASM SET_TAC[]);; let CLOSURE_OF_UNION = prove (`!top s t:A->bool. top closure_of (s UNION t) = top closure_of s UNION top closure_of t`, REWRITE_TAC[CLOSURE_OF; DERIVED_SET_OF_UNION] THEN SET_TAC[]);; let CLOSURE_OF_UNIONS = prove (`!top (f:(A->bool)->bool). FINITE f ==> top closure_of (UNIONS f) = UNIONS {top closure_of s | s IN f}`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[UNIONS_0; NOT_IN_EMPTY; UNIONS_INSERT; CLOSURE_OF_EMPTY; CLOSURE_OF_UNION; SIMPLE_IMAGE; IMAGE_CLAUSES]);; let CLOSURE_OF_SUBSET = prove (`!top s:A->bool. s SUBSET topspace top ==> s SUBSET top closure_of s`, REWRITE_TAC[CLOSURE_OF] THEN SET_TAC[]);; let CLOSURE_OF_SUBSET_INTER = prove (`!top s:A->bool. topspace top INTER s SUBSET top closure_of s`, REWRITE_TAC[CLOSURE_OF] THEN SET_TAC[]);; let CLOSURE_OF_SUBSET_EQ = prove (`!top s:A->bool. s SUBSET topspace top /\ top closure_of s SUBSET s <=> closed_in top s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(s:A->bool) SUBSET topspace top` THEN ASM_REWRITE_TAC[closed_in; SUBSET; closure_of; IN_ELIM_THM] THEN GEN_REWRITE_TAC RAND_CONV [OPEN_IN_SUBOPEN] THEN MP_TAC(ISPEC `top:A topology` OPEN_IN_SUBSET) THEN ASM SET_TAC[]);; let CLOSURE_OF_EQ = prove (`!top s:A->bool. top closure_of s = s <=> closed_in top s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(s:A->bool) SUBSET topspace top` THENL [ASM_MESON_TAC[SUBSET_ANTISYM_EQ; CLOSURE_OF_SUBSET; CLOSURE_OF_SUBSET_EQ]; ASM_MESON_TAC[CLOSED_IN_SUBSET; CLOSURE_OF_SUBSET_TOPSPACE]]);; let CLOSED_IN_CONTAINS_DERIVED_SET = prove (`!top s:A->bool. closed_in top s <=> s SUBSET topspace top /\ !x. x IN (top derived_set_of s) ==> x IN s`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CLOSURE_OF_SUBSET_EQ; CLOSURE_OF] THEN MP_TAC(ISPECL [`top:A topology`; `s:A->bool`] IN_DERIVED_SET_OF) THEN SET_TAC[]);; let CLOSURE_OF_CLOSED_IN = prove (`!top s:A->bool. closed_in top s ==> top closure_of s = s`, REWRITE_TAC[CLOSURE_OF_EQ]);; let CLOSED_IN_CLOSURE_OF = prove (`!top s:A->bool. closed_in top (top closure_of s)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `top closure_of (s:A->bool) = topspace top DIFF UNIONS {t | open_in top t /\ DISJOINT s t}` SUBST1_TAC THENL [REWRITE_TAC[closure_of; UNIONS_GSPEC] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_TOPSPACE] THEN SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC]]);; let CLOSURE_OF_CLOSURE_OF = prove (`!top s:A->bool. top closure_of (top closure_of s) = top closure_of s`, REWRITE_TAC[CLOSURE_OF_EQ; CLOSED_IN_CLOSURE_OF]);; let CLOSURE_OF_HULL = prove (`!top s:A->bool. s SUBSET topspace top ==> top closure_of s = (closed_in top) hull s`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HULL_UNIQUE THEN ASM_SIMP_TAC[CLOSURE_OF_SUBSET; CLOSED_IN_CLOSURE_OF] THEN ASM_MESON_TAC[CLOSURE_OF_EQ; CLOSURE_OF_MONO]);; let CLOSURE_OF_MINIMAL = prove (`!top s t:A->bool. s SUBSET t /\ closed_in top t ==> (top closure_of s) SUBSET t`, ASM_MESON_TAC[CLOSURE_OF_EQ; CLOSURE_OF_MONO]);; let CLOSURE_OF_MINIMAL_EQ = prove (`!top s t:A->bool. s SUBSET topspace top /\ closed_in top t ==> ((top closure_of s) SUBSET t <=> s SUBSET t)`, MESON_TAC[SUBSET_TRANS; CLOSURE_OF_SUBSET; CLOSURE_OF_MINIMAL]);; let CLOSURE_OF_UNIQUE = prove (`!top s t. s SUBSET t /\ closed_in top t /\ (!t'. s SUBSET t' /\ closed_in top t' ==> t SUBSET t') ==> top closure_of s = t`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) CLOSURE_OF_HULL o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[CLOSED_IN_SUBSET; SUBSET_TRANS]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC HULL_UNIQUE THEN ASM_REWRITE_TAC[]);; let CLOSURE_OF_EQ_EMPTY_GEN = prove (`!top s:A->bool. top closure_of s = {} <=> DISJOINT (topspace top) s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CLOSURE_OF_RESTRICT; DISJOINT] THEN EQ_TAC THEN SIMP_TAC[CLOSURE_OF_EMPTY] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> s = {} ==> t = {}`) THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN REWRITE_TAC[INTER_SUBSET]);; let CLOSURE_OF_EQ_EMPTY_GEN = prove (`!top s:A->bool. s SUBSET topspace top ==> (top closure_of s = {} <=> s = {})`, REWRITE_TAC[CLOSURE_OF_EQ_EMPTY_GEN] THEN SET_TAC[]);; let OPEN_IN_INTER_CLOSURE_OF_SUBSET = prove (`!top s t:A->bool. open_in top s ==> s INTER top closure_of t SUBSET top closure_of (s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[closure_of] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:A->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s INTER u:A->bool`) THEN ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER] THEN MESON_TAC[]);; let CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF = prove (`!top s t:A->bool. open_in top s ==> top closure_of (s INTER top closure_of t) = top closure_of (s INTER t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_OF_MINIMAL THEN REWRITE_TAC[CLOSED_IN_CLOSURE_OF] THEN ASM_SIMP_TAC[OPEN_IN_INTER_CLOSURE_OF_SUBSET]; MATCH_MP_TAC CLOSURE_OF_MONO THEN MP_TAC(ISPECL [`top:A topology`; `topspace top INTER t:A->bool`] CLOSURE_OF_SUBSET) THEN REWRITE_TAC[INTER_SUBSET; GSYM CLOSURE_OF_RESTRICT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN SET_TAC[]]);; let OPEN_IN_INTER_CLOSURE_OF_EQ = prove (`!top s t:A->bool. open_in top s ==> s INTER top closure_of t = s INTER top closure_of (s INTER t)`, SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; INTER_SUBSET; SUBSET_INTER] THEN SIMP_TAC[OPEN_IN_INTER_CLOSURE_OF_SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u INTER s SUBSET t`) THEN MATCH_MP_TAC CLOSURE_OF_MONO THEN SET_TAC[]);; let OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY = prove (`!top s t:A->bool. open_in top s ==> (s INTER top closure_of t = {} <=> s INTER t = {})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SPEC `t:A->bool` o MATCH_MP OPEN_IN_INTER_CLOSURE_OF_EQ) THEN EQ_TAC THEN SIMP_TAC[CLOSURE_OF_EMPTY; INTER_EMPTY] THEN MATCH_MP_TAC(SET_RULE `s INTER t SUBSET c ==> s INTER c = {} ==> s INTER t = {}`) THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN SET_TAC[]);; let CLOSURE_OF_OPEN_IN_INTER_SUPERSET = prove (`!top s t:A->bool. open_in top s /\ s SUBSET top closure_of t ==> top closure_of (s INTER t) = top closure_of s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `t:A->bool` o MATCH_MP CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF) THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let CLOSURE_OF_OPEN_IN_SUBTOPOLOGY_INTER_CLOSURE_OF = prove (`!top s t u:A->bool. open_in (subtopology top u) s /\ t SUBSET u ==> top closure_of (s INTER top closure_of t) = top closure_of (s INTER t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_SUBTOPOLOGY]) THEN DISCH_THEN(X_CHOOSE_THEN `v:A->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN FIRST_ASSUM(MP_TAC o SPEC `t:A->bool` o MATCH_MP CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF) THEN ASM_SIMP_TAC[SET_RULE `t SUBSET u ==> (v INTER u) INTER t = v INTER t`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CLOSURE_OF_MONO THEN SET_TAC[]; MATCH_MP_TAC CLOSURE_OF_MONO THEN MP_TAC(ISPECL [`top:A topology`; `topspace top INTER t:A->bool`] CLOSURE_OF_SUBSET) THEN REWRITE_TAC[GSYM CLOSURE_OF_RESTRICT; INTER_SUBSET] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY] THEN SET_TAC[]]);; let CLOSURE_OF_SUBTOPOLOGY_OPEN = prove (`!top u s:A->bool. open_in top u \/ s SUBSET u ==> (subtopology top u) closure_of s = u INTER top closure_of s`, REWRITE_TAC[SET_RULE `s SUBSET u <=> u INTER s = s`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY] THEN ASM_MESON_TAC[OPEN_IN_INTER_CLOSURE_OF_EQ]);; (* ------------------------------------------------------------------------- *) (* Interior with respect to a topological space. *) (* ------------------------------------------------------------------------- *) parse_as_infix("interior_of",(21,"right"));; let interior_of = new_definition `top interior_of s = {x | ?t. open_in top t /\ x IN t /\ t SUBSET s}`;; let INTERIOR_OF_RESTRICT = prove (`!top s:A->bool. top interior_of s = top interior_of (topspace top INTER s)`, REWRITE_TAC[interior_of; EXTENSION; IN_ELIM_THM; SUBSET_INTER] THEN MESON_TAC[OPEN_IN_SUBSET]);; let INTERIOR_OF_EQ = prove (`!top s:A->bool. (top interior_of s = s) <=> open_in top s`, REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; interior_of; IN_ELIM_THM] THEN GEN_REWRITE_TAC RAND_CONV [OPEN_IN_SUBOPEN] THEN MESON_TAC[SUBSET]);; let INTERIOR_OF_OPEN_IN = prove (`!top s:a->bool. open_in top s ==> top interior_of s = s`, MESON_TAC[INTERIOR_OF_EQ]);; let INTERIOR_OF_EMPTY = prove (`!top:A topology. top interior_of {} = {}`, REWRITE_TAC[INTERIOR_OF_EQ; OPEN_IN_EMPTY]);; let INTERIOR_OF_TOPSPACE = prove (`!top:A topology. top interior_of (topspace top) = topspace top`, REWRITE_TAC[INTERIOR_OF_EQ; OPEN_IN_TOPSPACE]);; let OPEN_IN_INTERIOR_OF = prove (`!top s:A->bool. open_in top (top interior_of s)`, REPEAT GEN_TAC THEN REWRITE_TAC[interior_of] THEN GEN_REWRITE_TAC I [OPEN_IN_SUBOPEN] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let INTERIOR_OF_INTERIOR_OF = prove (`!top s:A->bool. top interior_of top interior_of s = top interior_of s`, REWRITE_TAC[INTERIOR_OF_EQ; OPEN_IN_INTERIOR_OF]);; let INTERIOR_OF_SUBSET = prove (`!top s:A->bool. top interior_of s SUBSET s`, REWRITE_TAC[interior_of] THEN SET_TAC[]);; let INTERIOR_OF_SUBSET_CLOSURE_OF = prove (`!top s:A->bool. top interior_of s SUBSET top closure_of s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[INTERIOR_OF_RESTRICT; CLOSURE_OF_RESTRICT] THEN TRANS_TAC SUBSET_TRANS `topspace top INTER s:A->bool` THEN SIMP_TAC[INTERIOR_OF_SUBSET; CLOSURE_OF_SUBSET; INTER_SUBSET]);; let SUBSET_INTERIOR_OF_EQ = prove (`!top s:A->bool. s SUBSET top interior_of s <=> open_in top s`, SIMP_TAC[GSYM INTERIOR_OF_EQ; GSYM SUBSET_ANTISYM_EQ; INTERIOR_OF_SUBSET]);; let INTERIOR_OF_MONO = prove (`!top s t:A->bool. s SUBSET t ==> top interior_of s SUBSET top interior_of t`, REWRITE_TAC[interior_of] THEN SET_TAC[]);; let INTERIOR_OF_MAXIMAL = prove (`!top s t:A->bool. t SUBSET s /\ open_in top t ==> t SUBSET top interior_of s`, REWRITE_TAC[interior_of] THEN SET_TAC[]);; let INTERIOR_OF_MAXIMAL_EQ = prove (`!top s t:A->bool. open_in top t ==> (t SUBSET top interior_of s <=> t SUBSET s)`, MESON_TAC[INTERIOR_OF_MAXIMAL; SUBSET_TRANS; INTERIOR_OF_SUBSET]);; let INTERIOR_OF_UNIQUE = prove (`!top s t:A->bool. t SUBSET s /\ open_in top t /\ (!t'. t' SUBSET s /\ open_in top t' ==> t' SUBSET t) ==> top interior_of s = t`, MESON_TAC[SUBSET_ANTISYM; INTERIOR_OF_MAXIMAL; INTERIOR_OF_SUBSET; OPEN_IN_INTERIOR_OF]);; let INTERIOR_OF_SUBSET_TOPSPACE = prove (`!top s:A->bool. top interior_of s SUBSET topspace top`, REWRITE_TAC[SUBSET; interior_of; IN_ELIM_THM] THEN MESON_TAC[REWRITE_RULE[SUBSET] OPEN_IN_SUBSET]);; let INTERIOR_OF_SUBSET_SUBTOPOLOGY = prove (`!top s t:A->bool. (subtopology top s) interior_of t SUBSET s`, REPEAT STRIP_TAC THEN MP_TAC (ISPEC `subtopology top (s:A->bool)` INTERIOR_OF_SUBSET_TOPSPACE) THEN SIMP_TAC[TOPSPACE_SUBTOPOLOGY; SUBSET_INTER]);; let INTERIOR_OF_INTER = prove (`!top s t:A->bool. top interior_of (s INTER t) = top interior_of s INTER top interior_of t`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER] THEN SIMP_TAC[INTERIOR_OF_MONO; INTER_SUBSET] THEN SIMP_TAC[INTERIOR_OF_MAXIMAL_EQ; OPEN_IN_INTERIOR_OF; OPEN_IN_INTER] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'`) THEN REWRITE_TAC[INTERIOR_OF_SUBSET]);; let INTERIOR_OF_INTERS_SUBSET = prove (`!top f:(A->bool)->bool. top interior_of (INTERS f) SUBSET INTERS {top interior_of s | s IN f}`, REWRITE_TAC[SUBSET; interior_of; INTERS_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; IN_INTERS] THEN MESON_TAC[]);; let UNION_INTERIOR_OF_SUBSET = prove (`!top s t:A->bool. top interior_of s UNION top interior_of t SUBSET top interior_of (s UNION t)`, SIMP_TAC[UNION_SUBSET; INTERIOR_OF_MONO; SUBSET_UNION]);; let INTERIOR_OF_EQ_EMPTY = prove (`!top s:A->bool. top interior_of s = {} <=> !t. open_in top t /\ t SUBSET s ==> t = {}`, MESON_TAC[INTERIOR_OF_MAXIMAL_EQ; SUBSET_EMPTY; OPEN_IN_INTERIOR_OF; INTERIOR_OF_SUBSET]);; let INTERIOR_OF_EQ_EMPTY_ALT = prove (`!top s:A->bool. top interior_of s = {} <=> !t. open_in top t /\ ~(t = {}) ==> ~(t DIFF s = {})`, GEN_TAC THEN REWRITE_TAC[INTERIOR_OF_EQ_EMPTY] THEN SET_TAC[]);; let INTERIOR_OF_UNIONS_OPEN_IN_SUBSETS = prove (`!top s:A->bool. UNIONS {t | open_in top t /\ t SUBSET s} = top interior_of s`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTERIOR_OF_UNIQUE THEN SIMP_TAC[OPEN_IN_UNIONS; IN_ELIM_THM] THEN SET_TAC[]);; let INTERIOR_OF_COMPLEMENT = prove (`!top s:A->bool. top interior_of (topspace top DIFF s) = topspace top DIFF top closure_of s`, REWRITE_TAC[interior_of; closure_of] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; SUBSET] THEN MESON_TAC[REWRITE_RULE[SUBSET] OPEN_IN_SUBSET]);; let INTERIOR_OF_CLOSURE_OF = prove (`!top s:A->bool. top interior_of s = topspace top DIFF top closure_of (topspace top DIFF s)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INTERIOR_OF_COMPLEMENT] THEN GEN_REWRITE_TAC LAND_CONV [INTERIOR_OF_RESTRICT] THEN AP_TERM_TAC THEN SET_TAC[]);; let CLOSURE_OF_INTERIOR_OF = prove (`!top s:A->bool. top closure_of s = topspace top DIFF top interior_of (topspace top DIFF s)`, REWRITE_TAC[INTERIOR_OF_COMPLEMENT] THEN REWRITE_TAC[SET_RULE `s = t DIFF (t DIFF s) <=> s SUBSET t`] THEN REWRITE_TAC[CLOSURE_OF_SUBSET_TOPSPACE]);; let CLOSURE_OF_COMPLEMENT = prove (`!top s:A->bool. top closure_of (topspace top DIFF s) = topspace top DIFF top interior_of s`, REWRITE_TAC[interior_of; closure_of] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; SUBSET] THEN MESON_TAC[REWRITE_RULE[SUBSET] OPEN_IN_SUBSET]);; let INTERIOR_OF_EQ_EMPTY_COMPLEMENT = prove (`!top s:A->bool. top interior_of s = {} <=> top closure_of (topspace top DIFF s) = topspace top`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`top:A topology`; `s:A->bool`] INTERIOR_OF_SUBSET_TOPSPACE) THEN REWRITE_TAC[CLOSURE_OF_COMPLEMENT] THEN SET_TAC[]);; let CLOSURE_OF_EQ_UNIV = prove (`!top s:A->bool. top closure_of s = topspace top <=> top interior_of (topspace top DIFF s) = {}`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`top:A topology`; `s:A->bool`] CLOSURE_OF_SUBSET_TOPSPACE) THEN REWRITE_TAC[INTERIOR_OF_COMPLEMENT] THEN SET_TAC[]);; let INTERIOR_OF_SUBTOPOLOGY_SUBSET = prove (`!top s u:A->bool. u INTER top interior_of s SUBSET (subtopology top u) interior_of s`, REWRITE_TAC[SUBSET; IN_INTER; interior_of; OPEN_IN_SUBTOPOLOGY; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2] THEN ASM SET_TAC[]);; let INTERIOR_OF_SUBTOPOLOGY_SUBSETS = prove (`!top s t u:A->bool. t SUBSET u ==> t INTER (subtopology top u) interior_of s SUBSET (subtopology top t) interior_of s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `t SUBSET u ==> t = u INTER t`)) THEN REWRITE_TAC[GSYM SUBTOPOLOGY_SUBTOPOLOGY] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `t SUBSET u ==> u INTER t = t`)) THEN REWRITE_TAC[INTERIOR_OF_SUBTOPOLOGY_SUBSET]);; let INTERIOR_OF_SUBTOPOLOGY_MONO = prove (`!top s t u:A->bool. s SUBSET t /\ t SUBSET u ==> (subtopology top u) interior_of s SUBSET (subtopology top t) interior_of s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `i SUBSET s /\ t INTER i SUBSET i' ==> s SUBSET t ==> i SUBSET i'`) THEN ASM_SIMP_TAC[INTERIOR_OF_SUBSET; INTERIOR_OF_SUBTOPOLOGY_SUBSETS]);; let INTERIOR_OF_SUBTOPOLOGY_OPEN = prove (`!top u s:A->bool. open_in top u ==> (subtopology top u) interior_of s = u INTER top interior_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERIOR_OF_CLOSURE_OF] THEN ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY_OPEN] THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY] THEN REWRITE_TAC[SET_RULE `s INTER t DIFF u = t INTER (s DIFF u)`] THEN ASM_SIMP_TAC[GSYM OPEN_IN_INTER_CLOSURE_OF_EQ] THEN SET_TAC[]);; let DENSE_INTERSECTS_OPEN = prove (`!top s:A->bool. top closure_of s = topspace top <=> !t. open_in top t /\ ~(t = {}) ==> ~(s INTER t = {})`, REWRITE_TAC[CLOSURE_OF_INTERIOR_OF] THEN SIMP_TAC[INTERIOR_OF_SUBSET_TOPSPACE; SET_RULE `s SUBSET u ==> (u DIFF s = u <=> s = {})`] THEN REWRITE_TAC[INTERIOR_OF_EQ_EMPTY_ALT] THEN SIMP_TAC[OPEN_IN_SUBSET; SET_RULE `t SUBSET u ==> (~(t DIFF (u DIFF s) = {}) <=> ~(s INTER t = {}))`]);; let INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF = prove (`!top s t:A->bool. closed_in top s /\ top interior_of t = {} ==> top interior_of (s UNION t) = top interior_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERIOR_OF_CLOSURE_OF] THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)`] THEN W(MP_TAC o PART_MATCH (rand o rand) CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF o lhand o snd) THEN ASM_SIMP_TAC[CLOSURE_OF_COMPLEMENT; OPEN_IN_DIFF; OPEN_IN_TOPSPACE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM CLOSURE_OF_COMPLEMENT] THEN AP_TERM_TAC THEN SET_TAC[]);; let INTERIOR_OF_UNION_EQ_EMPTY = prove (`!top s t:A->bool. closed_in top s \/ closed_in top t ==> (top interior_of (s UNION t) = {} <=> top interior_of s = {} /\ top interior_of t = {})`, GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!x y. R x y ==> R y x) /\ (!x y. P x ==> R x y) ==> (!x y. P x \/ P y ==> R x y)`) THEN CONJ_TAC THENL [REWRITE_TAC[UNION_COMM] THEN SET_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(p ==> r) /\ (r ==> (p <=> q)) ==> (p <=> q /\ r)`) THEN ASM_SIMP_TAC[INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN SIMP_TAC[INTERIOR_OF_MONO; SUBSET_UNION]);; (* ------------------------------------------------------------------------- *) (* Frontier with respect to topological space. *) (* ------------------------------------------------------------------------- *) parse_as_infix("frontier_of",(21,"right"));; let frontier_of = new_definition `top frontier_of s = top closure_of s DIFF top interior_of s`;; let FRONTIER_OF_CLOSURES = prove (`!top s. top frontier_of s = top closure_of s INTER top closure_of (topspace top DIFF s)`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[frontier_of; CLOSURE_OF_COMPLEMENT] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER (u DIFF t) = s DIFF t`) THEN REWRITE_TAC[CLOSURE_OF_SUBSET_TOPSPACE]);; let FRONTIER_OF_RESTRICT = prove (`!top s:A->bool. top frontier_of s = top frontier_of (topspace top INTER s)`, REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_OF_CLOSURES] THEN BINOP_TAC THEN GEN_REWRITE_TAC LAND_CONV [CLOSURE_OF_RESTRICT] THEN AP_TERM_TAC THEN SET_TAC[]);; let CLOSED_IN_FRONTIER_OF = prove (`!top s:A->bool. closed_in top (top frontier_of s)`, SIMP_TAC[FRONTIER_OF_CLOSURES; CLOSED_IN_INTER; CLOSED_IN_CLOSURE_OF]);; let FRONTIER_OF_SUBSET_TOPSPACE = prove (`!top s:A->bool. top frontier_of s SUBSET topspace top`, SIMP_TAC[CLOSED_IN_SUBSET; CLOSED_IN_FRONTIER_OF]);; let FRONTIER_OF_SUBSET_SUBTOPOLOGY = prove (`!top s t:A->bool. (subtopology top s) frontier_of t SUBSET s`, MESON_TAC[TOPSPACE_SUBTOPOLOGY; FRONTIER_OF_SUBSET_TOPSPACE; SUBSET_INTER]);; let FRONTIER_OF_SUBTOPOLOGY_SUBSET = prove (`!top s u:A->bool. u INTER (subtopology top u) frontier_of s SUBSET (top frontier_of s)`, REPEAT GEN_TAC THEN REWRITE_TAC[frontier_of] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ u INTER t' SUBSET t ==> u INTER (s DIFF t) SUBSET s' DIFF t'`) THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY_SUBSET; INTERIOR_OF_SUBTOPOLOGY_SUBSET]);; let FRONTIER_OF_SUBTOPOLOGY_MONO = prove (`!top s t u:A->bool. s SUBSET t /\ t SUBSET u ==> (subtopology top t) frontier_of s SUBSET (subtopology top u) frontier_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[frontier_of] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t' SUBSET t ==> s DIFF t SUBSET s' DIFF t'`) THEN ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY_MONO; INTERIOR_OF_SUBTOPOLOGY_MONO]);; let CLOPEN_IN_EQ_FRONTIER_OF = prove (`!top s:A->bool. closed_in top s /\ open_in top s <=> s SUBSET topspace top /\ top frontier_of s = {}`, REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_OF_CLOSURES; OPEN_IN_CLOSED_IN_EQ] THEN ASM_CASES_TAC `(s:A->bool) SUBSET topspace top` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [SIMP_TAC[CLOSURE_OF_CLOSED_IN] THEN SET_TAC[]; DISCH_TAC] THEN ASM_REWRITE_TAC[GSYM CLOSURE_OF_SUBSET_EQ; SUBSET_DIFF] THEN MATCH_MP_TAC(SET_RULE `c INTER c' = {} /\ s SUBSET c /\ (u DIFF s) SUBSET c' /\ c SUBSET u /\ c' SUBSET u ==> c SUBSET s /\ c' SUBSET (u DIFF s)`) THEN ASM_SIMP_TAC[CLOSURE_OF_SUBSET; SUBSET_DIFF; CLOSURE_OF_SUBSET_TOPSPACE]);; let FRONTIER_OF_EQ_EMPTY = prove (`!top s:A->bool. s SUBSET topspace top ==> (top frontier_of s = {} <=> closed_in top s /\ open_in top s)`, SIMP_TAC[CLOPEN_IN_EQ_FRONTIER_OF]);; let FRONTIER_OF_OPEN_IN = prove (`!top s:A->bool. open_in top s ==> top frontier_of s = top closure_of s DIFF s`, SIMP_TAC[frontier_of; INTERIOR_OF_OPEN_IN]);; let FRONTIER_OF_OPEN_IN_STRADDLE_INTER = prove (`!top s u:A->bool. open_in top u /\ ~(u INTER top frontier_of s = {}) ==> ~(u INTER s = {}) /\ ~(u DIFF s = {})`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[FRONTIER_OF_CLOSURES] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(s INTER t INTER u = {}) ==> ~(s INTER t = {}) /\ ~(s INTER u = {})`)) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY o rand o lhand o snd) THEN ASM SET_TAC[]);; let FRONTIER_OF_SUBSET_CLOSED_IN = prove (`!top s:A->bool. closed_in top s ==> (top frontier_of s) SUBSET s`, REWRITE_TAC[GSYM CLOSURE_OF_SUBSET_EQ; frontier_of] THEN SET_TAC[]);; let FRONTIER_OF_EMPTY = prove (`!top. top frontier_of {} = {}`, REWRITE_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_EMPTY; INTER_EMPTY]);; let FRONTIER_OF_TOPSPACE = prove (`!top:A topology. top frontier_of topspace top = {}`, SIMP_TAC[FRONTIER_OF_EQ_EMPTY; SUBSET_REFL] THEN REWRITE_TAC[OPEN_IN_TOPSPACE; CLOSED_IN_TOPSPACE]);; let FRONTIER_OF_SUBSET_EQ = prove (`!top s:A->bool. s SUBSET topspace top ==> ((top frontier_of s) SUBSET s <=> closed_in top s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[FRONTIER_OF_SUBSET_CLOSED_IN] THEN REWRITE_TAC[FRONTIER_OF_CLOSURES] THEN ASM_REWRITE_TAC[GSYM CLOSURE_OF_SUBSET_EQ] THEN ONCE_REWRITE_TAC[SET_RULE `s INTER t = s DIFF (s DIFF t)`] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP (SET_RULE `s DIFF t SUBSET u ==> t SUBSET u ==> s SUBSET u`)) THEN MATCH_MP_TAC(SET_RULE `!u. u DIFF s SUBSET d /\ c SUBSET u ==> c DIFF d SUBSET s`) THEN EXISTS_TAC `topspace top:A->bool` THEN REWRITE_TAC[CLOSURE_OF_SUBSET_TOPSPACE] THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN SET_TAC[]);; let FRONTIER_OF_COMPLEMENT = prove (`!top s:A->bool. top frontier_of (topspace top DIFF s) = top frontier_of s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[FRONTIER_OF_RESTRICT] THEN REWRITE_TAC[FRONTIER_OF_CLOSURES] THEN GEN_REWRITE_TAC RAND_CONV [INTER_COMM] THEN BINOP_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; let FRONTIER_OF_DISJOINT_EQ = prove (`!top s. s SUBSET topspace top ==> ((top frontier_of s) INTER s = {} <=> open_in top s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[OPEN_IN_CLOSED_IN] THEN ASM_SIMP_TAC[GSYM FRONTIER_OF_SUBSET_EQ; SUBSET_DIFF] THEN REWRITE_TAC[FRONTIER_OF_COMPLEMENT] THEN MATCH_MP_TAC(SET_RULE `f SUBSET u ==> (f INTER s = {} <=> f SUBSET u DIFF s)`) THEN REWRITE_TAC[FRONTIER_OF_SUBSET_TOPSPACE]);; let FRONTIER_OF_DISJOINT_EQ_ALT = prove (`!top s:A->bool. s SUBSET (topspace top DIFF top frontier_of s) <=> open_in top s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(s:A->bool) SUBSET topspace top` THENL [ASM_SIMP_TAC[GSYM FRONTIER_OF_DISJOINT_EQ] THEN ASM SET_TAC[]; EQ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[OPEN_IN_SUBSET]]]);; let FRONTIER_OF_INTER = prove (`!top s t:A->bool. top frontier_of(s INTER t) = top closure_of (s INTER t) INTER (top frontier_of s UNION top frontier_of t)`, REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_OF_CLOSURES] THEN SIMP_TAC[CLOSURE_OF_MONO; INTER_SUBSET; GSYM CLOSURE_OF_UNION; SET_RULE `u SUBSET s /\ u SUBSET t ==> u INTER (s INTER x UNION t INTER y) = u INTER (x UNION y)`] THEN REPLICATE_TAC 2 AP_TERM_TAC THEN SET_TAC[]);; let FRONTIER_OF_INTER_SUBSET = prove (`!top s t. top frontier_of(s INTER t) SUBSET top frontier_of(s) UNION top frontier_of(t)`, REWRITE_TAC[FRONTIER_OF_INTER] THEN SET_TAC[]);; let FRONTIER_OF_INTER_CLOSED_IN = prove (`!top s t:A->bool. closed_in top s /\ closed_in top t ==> top frontier_of(s INTER t) = top frontier_of s INTER t UNION s INTER top frontier_of t`, SIMP_TAC[FRONTIER_OF_INTER; CLOSED_IN_INTER; CLOSURE_OF_CLOSED_IN] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_SUBSET_CLOSED_IN)) THEN SET_TAC[]);; let FRONTIER_OF_UNION_SUBSET = prove (`!top s t:A->bool. top frontier_of(s UNION t) SUBSET top frontier_of s UNION top frontier_of t`, ONCE_REWRITE_TAC[GSYM FRONTIER_OF_COMPLEMENT] THEN REWRITE_TAC[SET_RULE `u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)`] THEN REWRITE_TAC[FRONTIER_OF_INTER_SUBSET]);; let FRONTIER_OF_UNIONS_SUBSET = prove (`!top f:(A->bool)->bool. FINITE f ==> top frontier_of (UNIONS f) SUBSET UNIONS {top frontier_of t | t IN f}`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SIMPLE_IMAGE; IMAGE_UNIONS; IMAGE_CLAUSES; UNIONS_0; UNIONS_INSERT; FRONTIER_OF_EMPTY; SUBSET_REFL] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH lhand FRONTIER_OF_UNION_SUBSET o lhand o snd) THEN ASM SET_TAC[]);; let FRONTIER_OF_FRONTIER_OF_SUBSET = prove (`!top s:A->bool. top frontier_of (top frontier_of s) SUBSET top frontier_of s`, REPEAT GEN_TAC THEN MATCH_MP_TAC FRONTIER_OF_SUBSET_CLOSED_IN THEN REWRITE_TAC[CLOSED_IN_FRONTIER_OF]);; let FRONTIER_OF_SUBTOPOLOGY_OPEN = prove (`!top u s:A->bool. open_in top u ==> (subtopology top u) frontier_of s = u INTER top frontier_of s`, SIMP_TAC[frontier_of; CLOSURE_OF_SUBTOPOLOGY_OPEN; INTERIOR_OF_SUBTOPOLOGY_OPEN] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Iteration of interior and closure. *) (* ------------------------------------------------------------------------- *) let INTERIOR_OF_CLOSURE_OF_IDEMP = prove (`!top s:A->bool. top interior_of top closure_of top interior_of top closure_of s = top interior_of top closure_of s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_OF_UNIQUE THEN REWRITE_TAC[OPEN_IN_INTERIOR_OF] THEN SIMP_TAC[CLOSURE_OF_SUBSET; INTERIOR_OF_SUBSET_TOPSPACE] THEN SIMP_TAC[INTERIOR_OF_MAXIMAL_EQ] THEN X_GEN_TAC `t:A->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN MATCH_MP_TAC CLOSURE_OF_MINIMAL THEN REWRITE_TAC[CLOSED_IN_CLOSURE_OF; INTERIOR_OF_SUBSET]);; let CLOSURE_OF_INTERIOR_OF_IDEMP = prove (`!top s:A->bool. top closure_of top interior_of top closure_of top interior_of s = top closure_of top interior_of s`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`top:A topology`; `topspace top DIFF s:A->bool`] INTERIOR_OF_CLOSURE_OF_IDEMP) THEN REWRITE_TAC[CLOSURE_OF_COMPLEMENT; INTERIOR_OF_COMPLEMENT] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u /\ t SUBSET u ==> u DIFF s = u DIFF t ==> s = t`) THEN REWRITE_TAC[CLOSURE_OF_SUBSET_TOPSPACE; INTERIOR_OF_SUBSET_TOPSPACE]);; let INTERIOR_OF_FRONTIER_OF = prove (`!top s:A->bool. top interior_of (top frontier_of s) = top interior_of (top closure_of s) DIFF top closure_of (top interior_of s)`, REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_OF_CLOSURES; INTERIOR_OF_INTER] THEN REWRITE_TAC[CLOSURE_OF_COMPLEMENT; INTERIOR_OF_COMPLEMENT] THEN MP_TAC(ISPECL [`top:A topology`; `top closure_of s:A->bool`] INTERIOR_OF_SUBSET_TOPSPACE) THEN SET_TAC[]);; let THIN_FRONTIER_OF_SUBSET = prove (`!top s:A->bool. top interior_of (top frontier_of s) = {} <=> top interior_of (top closure_of s) SUBSET top closure_of (top interior_of s)`, REWRITE_TAC[INTERIOR_OF_FRONTIER_OF] THEN SET_TAC[]);; let THIN_FRONTIER_OF_CIC = prove (`!top s:A->bool. top interior_of (top frontier_of s) = {} <=> top closure_of (top interior_of (top closure_of s)) = top closure_of (top interior_of s)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[THIN_FRONTIER_OF_SUBSET] THEN MATCH_MP_TAC(TAUT `(p <=> q) /\ r==> (p <=> q /\ r)`) THEN CONJ_TAC THENL [SIMP_TAC[CLOSURE_OF_MINIMAL_EQ; CLOSED_IN_CLOSURE_OF; INTERIOR_OF_SUBSET_TOPSPACE]; GEN_REWRITE_TAC LAND_CONV [GSYM CLOSURE_OF_INTERIOR_OF_IDEMP] THEN SIMP_TAC[CLOSURE_OF_MONO; INTERIOR_OF_MONO; INTERIOR_OF_SUBSET]]);; let THIN_FRONTIER_OF_ICI = prove (`!s:A->bool. top interior_of (top frontier_of s) = {} <=> top interior_of (top closure_of (top interior_of s)) = top interior_of (top closure_of s)`, GEN_TAC THEN REWRITE_TAC[THIN_FRONTIER_OF_CIC] THEN MESON_TAC[INTERIOR_OF_CLOSURE_OF_IDEMP; CLOSURE_OF_INTERIOR_OF_IDEMP]);; let INTERIOR_OF_FRONTIER_OF_EMPTY = prove (`!top s:A->bool. open_in top s \/ closed_in top s ==> top interior_of (top frontier_of s) = {}`, REPEAT STRIP_TAC THENL [REWRITE_TAC[THIN_FRONTIER_OF_ICI]; REWRITE_TAC[THIN_FRONTIER_OF_CIC]] THEN ASM_SIMP_TAC[INTERIOR_OF_OPEN_IN; CLOSURE_OF_CLOSED_IN]);; let FRONTIER_OF_FRONTIER_OF = prove (`!top s:A->bool. open_in top s \/ closed_in top s ==> top frontier_of (top frontier_of s) = top frontier_of s`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [frontier_of] THEN SIMP_TAC[INTERIOR_OF_FRONTIER_OF_EMPTY; CLOSURE_OF_CLOSED_IN; CLOSED_IN_FRONTIER_OF; DIFF_EMPTY]);; let FRONTIER_OF_FRONTIER_OF_FRONTIER_OF = prove (`!top s:A->bool. top frontier_of top frontier_of top frontier_of s = top frontier_of top frontier_of s`, SIMP_TAC[FRONTIER_OF_FRONTIER_OF; CLOSED_IN_FRONTIER_OF]);; (* ------------------------------------------------------------------------- *) (* A variant of nets (slightly non-standard but good for our purposes). *) (* ------------------------------------------------------------------------- *) let net_tybij = new_type_definition "net" ("mk_net","netord") (prove (`?g:A->A->bool. !x y. (!z. g z x ==> g z y) \/ (!z. g z y ==> g z x)`, EXISTS_TAC `\x:A y:A. F` THEN REWRITE_TAC[]));; let NET = prove (`!n x y. (!z. netord n z x ==> netord n z y) \/ (!z. netord n z y ==> netord n z x)`, REWRITE_TAC[net_tybij; ETA_AX]);; let OLDNET = prove (`!n x y. netord n x x /\ netord n y y ==> ?z. netord n z z /\ !w. netord n w z ==> netord n w x /\ netord n w y`, MESON_TAC[NET]);; let NET_DILEMMA = prove (`!net. (?a. (?x. netord net x a) /\ (!x. netord net x a ==> P x)) /\ (?b. (?x. netord net x b) /\ (!x. netord net x b ==> Q x)) ==> ?c. (?x. netord net x c) /\ (!x. netord net x c ==> P x /\ Q x)`, MESON_TAC[NET]);; (* ------------------------------------------------------------------------- *) (* Sequential net and the "within" modifier for nets. *) (* ------------------------------------------------------------------------- *) parse_as_infix("within",(14,"right"));; let sequentially = new_definition `sequentially = mk_net(\m:num n. m >= n)`;; let within = new_definition `net within s = mk_net(\x y. netord net x y /\ x IN s)`;; let NET_PROVE_TAC[def] = REWRITE_TAC[GSYM FUN_EQ_THM; def] THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[GSYM(CONJUNCT2 net_tybij)];; let SEQUENTIALLY = prove (`!m n. netord sequentially m n <=> m >= n`, NET_PROVE_TAC[sequentially] THEN REWRITE_TAC[GE; LE_REFL] THEN MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; let WITHIN = prove (`!n s x y. netord(n within s) x y <=> netord n x y /\ x IN s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[within; GSYM FUN_EQ_THM] THEN REWRITE_TAC[GSYM(CONJUNCT2 net_tybij); ETA_AX] THEN MESON_TAC[NET]);; let NET_WITHIN_UNIV = prove (`!net. net within UNIV = net`, REWRITE_TAC[within; IN_UNIV; ETA_AX; net_tybij]);; let WITHIN_WITHIN = prove (`!net s t. (net within s) within t = net within (s INTER t)`, ONCE_REWRITE_TAC[within] THEN REWRITE_TAC[WITHIN; IN_INTER; GSYM CONJ_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Identify trivial limits, where we can't approach arbitrarily closely. *) (* ------------------------------------------------------------------------- *) let trivial_limit = new_definition `trivial_limit net <=> (!a:A b. a = b) \/ ?a:A b. ~(a = b) /\ !x. ~(netord(net) x a) /\ ~(netord(net) x b)`;; let TRIVIAL_LIMIT_SEQUENTIALLY = prove (`~(trivial_limit sequentially)`, REWRITE_TAC[trivial_limit; SEQUENTIALLY] THEN MESON_TAC[GE_REFL; NOT_SUC]);; let NONTRIVIAL_LIMIT_WITHIN = prove (`!net s. trivial_limit net ==> trivial_limit(net within s)`, REWRITE_TAC[trivial_limit; WITHIN] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some property holds "sufficiently close" to the limit point. *) (* ------------------------------------------------------------------------- *) let eventually = new_definition `eventually p net <=> trivial_limit net \/ ?y. (?x. netord net x y) /\ (!x. netord net x y ==> p x)`;; let EVENTUALLY_HAPPENS = prove (`!net p. eventually p net ==> trivial_limit net \/ ?x. p x`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_SEQUENTIALLY = prove (`!p. eventually p sequentially <=> ?N. !n. N <= n ==> p n`, REWRITE_TAC[eventually; SEQUENTIALLY; GE; LE_REFL; TRIVIAL_LIMIT_SEQUENTIALLY] THEN MESON_TAC[LE_REFL]);; let ALWAYS_EVENTUALLY = prove (`(!x. p x) ==> eventually p net`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[eventually; trivial_limit] THEN MESON_TAC[]);; let EVENTUALLY_AND = prove (`!net:(A net) p q. eventually (\x. p x /\ q x) net <=> eventually p net /\ eventually q net`, REPEAT GEN_TAC THEN REWRITE_TAC[eventually] THEN ASM_CASES_TAC `trivial_limit(net:(A net))` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN SIMP_TAC[NET_DILEMMA] THEN MESON_TAC[]);; let EVENTUALLY_MONO = prove (`!net:(A net) p q. (!x. p x ==> q x) /\ eventually p net ==> eventually q net`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_MP = prove (`!net:(A net) p q. eventually (\x. p x ==> q x) net /\ eventually p net ==> eventually q net`, REWRITE_TAC[GSYM EVENTUALLY_AND] THEN REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_FALSE = prove (`!net. eventually (\x. F) net <=> trivial_limit net`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_TRUE = prove (`!net. eventually (\x. T) net <=> T`, REWRITE_TAC[eventually; trivial_limit] THEN MESON_TAC[]);; let NOT_EVENTUALLY = prove (`!net p. (!x. ~(p x)) /\ ~(trivial_limit net) ==> ~(eventually p net)`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_SUBSEQUENCE = prove (`!P r. (!m n. m < n ==> r m < r n) /\ eventually P sequentially ==> eventually (P o r) sequentially`, REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; o_THM] THEN MESON_TAC[MONOTONE_BIGGER; LE_TRANS]);; let EVENTUALLY_FORALL = prove (`!net:(A net) p s:B->bool. FINITE s /\ ~(s = {}) ==> (eventually (\x. !a. a IN s ==> p a x) net <=> !a. a IN s ==> eventually (p a) net)`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT; EVENTUALLY_AND; ETA_AX] THEN MAP_EVERY X_GEN_TAC [`b:B`; `t:B->bool`] THEN ASM_CASES_TAC `t:B->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; EVENTUALLY_TRUE]);; let FORALL_EVENTUALLY = prove (`!net:(A net) p s:B->bool. FINITE s /\ ~(s = {}) ==> ((!a. a IN s ==> eventually (p a) net) <=> eventually (\x. !a. a IN s ==> p a x) net)`, SIMP_TAC[EVENTUALLY_FORALL]);; let ARCH_EVENTUALLY_LT = prove (`!x. eventually (\n. x < &n) sequentially`, GEN_TAC THEN MP_TAC(ISPEC `x + &1` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; let ARCH_EVENTUALLY_LE = prove (`!x. eventually (\n. x <= &n) sequentially`, GEN_TAC THEN MP_TAC(ISPEC `x:real` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; let ARCH_EVENTUALLY_INV = prove (`!e. eventually (\n. inv(&n) < e) sequentially <=> &0 < e`, GEN_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n + 1`)) THEN REWRITE_TAC[LE_ADD] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LT_TRANS) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT] THEN ARITH_TAC; GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; let ARCH_EVENTUALLY_INV1 = prove (`!e. eventually (\n. inv(&n + &1) < e) sequentially <=> &0 < e`, GEN_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LT_TRANS) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT] THEN ARITH_TAC; GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; let ARCH_EVENTUALLY_POW = prove (`!x b. &1 < x ==> eventually (\n. b < x pow n) sequentially`, REPEAT STRIP_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_ASSUM(MP_TAC o SPEC `b:real` o MATCH_MP REAL_ARCH_POW) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LTE_TRANS `(x:real) pow N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]);; let ARCH_EVENTUALLY_POW_INV = prove (`!x e. &0 < e /\ abs(x) < &1 ==> eventually (\n. abs(x pow n) < e) sequentially`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN ASM_SIMP_TAC[REAL_POW_ZERO; LE_1; REAL_ABS_NUM]; ALL_TAC] THEN MP_TAC(ISPECL [`inv(abs x)`; `inv e:real`] ARCH_EVENTUALLY_POW) THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_INV_1_LT THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_ABS_POW] THEN DISCH_TAC THEN GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN ASM_SIMP_TAC[GSYM REAL_POW_INV; REAL_LT_INV; REAL_LT_INV2]);; let EVENTUALLY_IN_SEQUENTIALLY = prove (`!P. eventually P sequentially <=> FINITE {n | ~P n}`, GEN_TAC THEN REWRITE_TAC[num_FINITE; EVENTUALLY_SEQUENTIALLY; IN_ELIM_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE] THEN MESON_TAC[LT_IMP_LE; ARITH_RULE `a + 1 <= x ==> a < x`]);; let EVENTUALLY_NO_SUBSEQUENCE = prove (`!P. eventually P sequentially <=> ~(?r:num->num. (!m n. m < n ==> r m < r n) /\ (!n. ~P(r n)))`, GEN_TAC THEN REWRITE_TAC[EVENTUALLY_IN_SEQUENTIALLY] THEN ONCE_REWRITE_TAC[TAUT `(p <=> ~q) <=> (~p <=> q)`] THEN REWRITE_TAC[GSYM INFINITE; INFINITE_ENUMERATE_EQ_ALT] THEN REWRITE_TAC[IN_ELIM_THM]);; (* ------------------------------------------------------------------------- *) (* Metric spaces. *) (* ------------------------------------------------------------------------- *) let is_metric_space = new_definition `is_metric_space (s,d) <=> (!x y:A. x IN s /\ y IN s ==> &0 <= d(x,y)) /\ (!x y. x IN s /\ y IN s ==> (d(x,y) = &0 <=> x = y)) /\ (!x y. x IN s /\ y IN s ==> d(x,y) = d(y,x)) /\ (!x y z. x IN s /\ y IN s /\ z IN s ==> d(x,z) <= d(x,y) + d(y,z))`;; let metric_tybij = (new_type_definition "metric" ("metric","dest_metric") o prove) (`?m:(A->bool)#(A#A->real). is_metric_space m`, EXISTS_TAC `({}:A->bool,(\p:A#A. &0))` THEN REWRITE_TAC[is_metric_space; NOT_IN_EMPTY]);; let IS_METRIC_SPACE_SUBSPACE = prove (`!(s:A->bool) d. is_metric_space (s,d) ==> (! s'. s' SUBSET s ==> is_metric_space (s',d))`, SIMP_TAC[SUBSET; is_metric_space]);; let mspace = new_definition `!m:A metric. mspace m = FST (dest_metric m)`;; let mdist = new_definition `!m:A metric. mdist m = SND (dest_metric m)`;; let METRIC = prove (`!s d. is_metric_space (s:A->bool,d) ==> mspace (metric (s,d)) = s /\ mdist (metric (s,d)) = d`, REWRITE_TAC[mspace; mdist] THEN MESON_TAC[metric_tybij; FST; SND]);; let MSPACE = prove (`!s:A->bool d. is_metric_space (s,d) ==> mspace (metric (s,d)) = s`, SIMP_TAC[METRIC]);; let MDIST = prove (`!s:A->bool d. is_metric_space (s,d) ==> mdist (metric (s,d)) = d`, SIMP_TAC[METRIC]);; (* ------------------------------------------------------------------------- *) (* Distance properties. *) (* ------------------------------------------------------------------------- *) let [MDIST_POS_LE; MDIST_0; MDIST_SYM; MDIST_TRIANGLE] = let FORALL_METRIC_THM = prove (`!P. (!m. P m) <=> (!s:A->bool d. is_metric_space(s,d) ==> P(metric (s,d)))`, REWRITE_TAC[GSYM FORALL_PAIR_THM; metric_tybij] THEN MESON_TAC[CONJUNCT1 metric_tybij]) in let METRIC_AXIOMS = (`!m. (!x y:A. x IN mspace m /\ y IN mspace m ==> &0 <= mdist m (x,y)) /\ (!x y. x IN mspace m /\ y IN mspace m ==> (mdist m (x,y) = &0 <=> x = y)) /\ (!x y. x IN mspace m /\ y IN mspace m ==> mdist m (x,y) = mdist m (y,x)) /\ (!x y z. x IN mspace m /\ y IN mspace m /\ z IN mspace m ==> mdist m (x,z) <= mdist m (x,y) + mdist m (y,z))`, SIMP_TAC[FORALL_METRIC_THM; MSPACE; MDIST; is_metric_space]) in (CONJUNCTS o REWRITE_RULE [FORALL_AND_THM] o prove) METRIC_AXIOMS;; let REAL_ABS_MDIST = prove (`!m x y:A. x IN mspace m /\ y IN mspace m ==> abs(mdist m (x,y)) = mdist m (x,y)`, SIMP_TAC[REAL_ABS_REFL; MDIST_POS_LE]);; let MDIST_POS_LT = prove (`!m x y:A. x IN mspace m /\ y IN mspace m /\ ~(x=y) ==> &0 < mdist m (x,y)`, SIMP_TAC [REAL_LT_LE; MDIST_POS_LE] THEN MESON_TAC[MDIST_0]);; let MDIST_REFL = prove (`!m x:A. x IN mspace m ==> mdist m (x,x) = &0`, SIMP_TAC[MDIST_0]);; let MDIST_REVERSE_TRIANGLE = prove (`!m x y z:A. x IN mspace m /\ y IN mspace m /\ z IN mspace m ==> abs(mdist m (x,y) - mdist m (y,z)) <= mdist m (x,z)`, GEN_TAC THEN CLAIM_TAC "rmk" `!x y z:A. x IN mspace m /\ y IN mspace m /\ z IN mspace m ==> mdist m (x,y) - mdist m (y,z) <= mdist m (x,z)` THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[REAL_LE_SUB_RADD] THEN ASM_MESON_TAC[MDIST_TRIANGLE; MDIST_SYM]; REWRITE_TAC[REAL_ABS_BOUNDS; REAL_ARITH `!a b c. --a <= b - c <=> c - a <= b`] THEN ASM_MESON_TAC[MDIST_SYM]]);; (* ------------------------------------------------------------------------- *) (* Open ball. *) (* ------------------------------------------------------------------------- *) let mball = new_definition `mball m (x:A,r) = {y | x IN mspace m /\ y IN mspace m /\ mdist m (x,y) < r}`;; let IN_MBALL = prove (`!m x y:A r. y IN mball m (x,r) <=> x IN mspace m /\ y IN mspace m /\ mdist m (x,y) < r`, REWRITE_TAC[mball; IN_ELIM_THM]);; let CENTRE_IN_MBALL = prove (`!m x:A r. &0 < r /\ x IN mspace m ==> x IN mball m (x,r)`, SIMP_TAC[IN_MBALL; MDIST_REFL; real_gt]);; let CENTRE_IN_MBALL_EQ = prove (`!m x:A r. x IN mball m (x,r) <=> x IN mspace m /\ &0 < r`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_MBALL] THEN ASM_CASES_TAC `x:A IN mspace m` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MDIST_REFL]);; let MBALL_SUBSET_MSPACE = prove (`!m (x:A) r. mball m (x,r) SUBSET mspace m`, SIMP_TAC[SUBSET; IN_MBALL]);; let MBALL_EMPTY = prove (`!m x:A r. r <= &0 ==> mball m (x,r) = {}`, REWRITE_TAC[IN_MBALL; EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[MDIST_POS_LE; REAL_ARITH `!x. ~(r <= &0 /\ &0 <= x /\ x < r)`]);; let MBALL_EMPTY_ALT = prove (`!m x:A r. ~(x IN mspace m) ==> mball m (x,r) = {}`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_MBALL] THEN MESON_TAC[]);; let MBALL_EQ_EMPTY = prove (`!m x:A r. mball m (x,r) = {} <=> ~(x IN mspace m) \/ r <= &0`, REPEAT GEN_TAC THEN EQ_TAC THENL [MP_TAC CENTRE_IN_MBALL THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN SET_TAC[]; STRIP_TAC THEN ASM_SIMP_TAC[MBALL_EMPTY; MBALL_EMPTY_ALT]]);; let MBALL_SUBSET = prove (`!m x y:A a b. y IN mspace m /\ mdist m (x,y) + a <= b ==> mball m (x,a) SUBSET mball m (y,b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:A IN mspace m` THENL [STRIP_TAC; ASM SET_TAC [MBALL_EMPTY_ALT]] THEN ASM_REWRITE_TAC[SUBSET; IN_MBALL] THEN FIX_TAC "[z]" THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CUT_TAC `mdist m (y,z) <= mdist m (x:A,y) + mdist m (x,z)` THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[MDIST_SYM; MDIST_TRIANGLE]]);; let DISJOINT_MBALL = prove (`!m x:A x' r r'. r + r' <= mdist m (x,x') ==> DISJOINT (mball m (x,r)) (mball m (x',r'))`, REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_MBALL; NOT_IN_EMPTY; CONJ_ACI] THEN INTRO_TAC "!m x x' r r'; HPrr'; !x''; x x' x'' d1 d2" THEN SUBGOAL_THEN `mdist m (x:A,x') < r + r'` (fun th -> ASM_MESON_TAC[th; REAL_NOT_LE]) THEN TRANS_TAC REAL_LET_TRANS `mdist m (x:A,x'') + mdist m (x'',x')` THEN ASM_SIMP_TAC[MDIST_TRIANGLE; MDIST_SYM] THEN HYP (MP_TAC o end_itlist CONJ) "d1 d2" [] THEN REAL_ARITH_TAC);; let MBALL_SUBSET_CONCENTRIC = prove (`!m (x:A) r1 r2. r1 <= r2 ==> mball m (x,r1) SUBSET mball m (x,r2)`, SIMP_TAC[SUBSET; IN_MBALL] THEN MESON_TAC[REAL_LTE_TRANS]);; (* ------------------------------------------------------------------------- *) (* Subspace of a metric space. *) (* ------------------------------------------------------------------------- *) let submetric = new_definition `submetric (m:A metric) s = metric (s INTER mspace m, mdist m)`;; let SUBMETRIC = prove (`(!m:A metric s. mspace (submetric m s) = s INTER mspace m) /\ (!m:A metric s. mdist (submetric m s) = mdist m)`, CLAIM_TAC "metric" `!m:A metric s. is_metric_space (s INTER mspace m, mdist m)` THENL [REWRITE_TAC[is_metric_space; IN_INTER] THEN SIMP_TAC[MDIST_POS_LE; MDIST_0; MDIST_SYM; MDIST_TRIANGLE]; ASM_SIMP_TAC[submetric; MSPACE; MDIST]]);; let MBALL_SUBMETRIC = prove (`!m s x:A r. x IN s ==> mball (submetric m s) (x,r) = mball m (x,r) INTER s`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_MBALL; IN_INTER; SUBMETRIC] THEN MESON_TAC[]);; let SUBMETRIC_UNIV = prove (`submetric m (:A) = m`, REWRITE_TAC[submetric; INTER_UNIV; mspace; mdist; metric_tybij]);; (* ------------------------------------------------------------------------- *) (* Metric topology *) (* ------------------------------------------------------------------------- *) let mtopology = new_definition `mtopology (m:A metric) = topology {u | u SUBSET mspace m /\ !x:A. x IN u ==> ?r. &0 < r /\ mball m (x,r) SUBSET u}`;; let IS_TOPOLOGY_METRIC_TOPOLOGY = prove (`istopology {u | u SUBSET mspace m /\ !x:A. x IN u ==> ?r. &0 < r /\ mball m (x,r) SUBSET u}`, REWRITE_TAC[istopology; IN_ELIM_THM; NOT_IN_EMPTY; EMPTY_SUBSET] THEN CONJ_TAC THENL [INTRO_TAC "!s t; (s shp) (t thp)" THEN CONJ_TAC THENL [HYP SET_TAC "s t" []; ALL_TAC] THEN REWRITE_TAC[IN_INTER] THEN INTRO_TAC "!x; sx tx" THEN REMOVE_THEN "shp" (DESTRUCT_TAC "@r1. r1 rs" o C MATCH_MP (ASSUME `x:A IN s`)) THEN REMOVE_THEN "thp" (DESTRUCT_TAC "@r2. r2 rt" o C MATCH_MP (ASSUME `x:A IN t`)) THEN EXISTS_TAC `min r1 r2` THEN ASM_REWRITE_TAC[REAL_LT_MIN; SUBSET_INTER] THEN ASM_MESON_TAC[REAL_MIN_MIN; MBALL_SUBSET_CONCENTRIC; SUBSET_TRANS]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIONS] THEN MESON_TAC[]]);; let OPEN_IN_MTOPOLOGY = prove (`!m:A metric u. open_in (mtopology m) u <=> u SUBSET mspace m /\ (!x. x IN u ==> ?r. &0 < r /\ mball m (x,r) SUBSET u)`, REPEAT GEN_TAC THEN REWRITE_TAC[mtopology] THEN (SUBST1_TAC o REWRITE_RULE[IS_TOPOLOGY_METRIC_TOPOLOGY] o SPEC `{u | u SUBSET mspace m /\ !x:A. x IN u ==> ?r. &0 < r /\ mball m (x,r) SUBSET u}` o CONJUNCT2) topology_tybij THEN GEN_REWRITE_TAC LAND_CONV [GSYM IN] THEN REWRITE_TAC[IN_ELIM_THM]);; let TOPSPACE_MTOPOLOGY = prove (`!m:A metric. topspace (mtopology m) = mspace m`, GEN_TAC THEN REWRITE_TAC[mtopology; topspace] THEN (SUBST1_TAC o REWRITE_RULE[IS_TOPOLOGY_METRIC_TOPOLOGY] o SPEC `{u | u SUBSET mspace m /\ !x:A. x IN u ==> ?r. &0 < r /\ mball m (x,r) SUBSET u}` o CONJUNCT2) topology_tybij THEN REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN INTRO_TAC "x" THEN EXISTS_TAC `mspace (m:A metric)` THEN ASM_REWRITE_TAC[MBALL_SUBSET_MSPACE; SUBSET_REFL] THEN MESON_TAC[REAL_LT_01]);; let OPEN_IN_MBALL = prove (`!m (x:A) r. open_in (mtopology m) (mball m (x,r))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < (r:real)` THENL [ALL_TAC; ASM_SIMP_TAC[MBALL_EMPTY; GSYM REAL_NOT_LT; OPEN_IN_EMPTY]] THEN REWRITE_TAC[OPEN_IN_MTOPOLOGY; MBALL_SUBSET_MSPACE; IN_MBALL; SUBSET] THEN INTRO_TAC "![y]; x y xy" THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `r - mdist m (x:A,y)` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN INTRO_TAC "![z]; z lt" THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LET_TRANS `mdist m (x:A,y) + mdist m (y,z)` THEN ASM_SIMP_TAC[MDIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC);; let MTOPOLOGY_SUBMETRIC = prove (`!m:A metric s. mtopology (submetric m s) = subtopology (mtopology m) s`, REWRITE_TAC[TOPOLOGY_EQ] THEN INTRO_TAC "!m s [u]" THEN EQ_TAC THEN INTRO_TAC "hp" THENL [REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN EXISTS_TAC `UNIONS {mball m (c:A,r) | c,r | mball m (c,r) INTER s SUBSET u}` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN INTRO_TAC "![t]; @c r. sub t" THEN REMOVE_THEN "t" SUBST_VAR_TAC THEN MATCH_ACCEPT_TAC OPEN_IN_MBALL; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN HYP_TAC "hp: (us um) hp" (REWRITE_RULE[OPEN_IN_MTOPOLOGY; SUBMETRIC; SUBSET_INTER]) THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN REWRITE_TAC[SUBSET] THEN INTRO_TAC "!x; x" THEN USE_THEN "x" (HYP_TAC "hp: @r. rpos sub" o C MATCH_MP) THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN EXISTS_TAC `mball m (x:A,r)` THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`x:A`; `r:real`] THEN IMP_REWRITE_TAC [GSYM MBALL_SUBMETRIC] THEN ASM SET_TAC[]; MATCH_MP_TAC CENTRE_IN_MBALL THEN ASM SET_TAC[]]]; ALL_TAC] THEN REWRITE_TAC[OPEN_IN_MTOPOLOGY; SUBMETRIC; SUBSET_INTER] THEN HYP_TAC "hp: @t. t u" (REWRITE_RULE[OPEN_IN_SUBTOPOLOGY]) THEN REMOVE_THEN "u" SUBST_VAR_TAC THEN HYP_TAC "t: tm r" (REWRITE_RULE[OPEN_IN_MTOPOLOGY]) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTER] THEN INTRO_TAC "!x; xt xs" THEN USE_THEN "xt" (HYP_TAC "r: @r. rpos sub" o C MATCH_MP) THEN EXISTS_TAC `r:real` THEN IMP_REWRITE_TAC[MBALL_SUBMETRIC] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Closed sets. *) (* ------------------------------------------------------------------------- *) let CLOSED_IN_METRIC = prove (`!m c:A->bool. closed_in (mtopology m) c <=> c SUBSET mspace m /\ (!x. x IN mspace m DIFF c ==> ?r. &0 < r /\ DISJOINT c (mball m (x,r)))`, REWRITE_TAC[closed_in; OPEN_IN_MTOPOLOGY; DISJOINT; TOPSPACE_MTOPOLOGY] THEN MP_TAC MBALL_SUBSET_MSPACE THEN ASM SET_TAC[]);; let mcball = new_definition `mcball m (x:A,r) = {y | x IN mspace m /\ y IN mspace m /\ mdist m (x,y) <= r}`;; let IN_MCBALL = prove (`!m (x:A) r y. y IN mcball m (x,r) <=> x IN mspace m /\ y IN mspace m /\ mdist m (x,y) <= r`, REWRITE_TAC[mcball; IN_ELIM_THM]);; let CENTRE_IN_MCBALL = prove (`!m x:A r. &0 <= r /\ x IN mspace m ==> x IN mcball m (x,r)`, SIMP_TAC[IN_MCBALL; MDIST_REFL]);; let CENTRE_IN_MCBALL_EQ = prove (`!m x:A r. x IN mcball m (x,r) <=> x IN mspace m /\ &0 <= r`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_MCBALL] THEN ASM_CASES_TAC `x:A IN mspace m` THEN ASM_SIMP_TAC[MDIST_REFL]);; let MCBALL_EMPTY = prove (`!m (x:A) r. r < &0 ==> mcball m (x,r) = {}`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_MCBALL] THEN MESON_TAC[REAL_LET_TRANS; MDIST_POS_LE; REAL_NOT_LT]);; let MCBALL_EMPTY_ALT = prove (`!m (x:A) r. ~(x IN mspace m) ==> mcball m (x,r) = {}`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_MCBALL; DE_MORGAN_THM] THEN MESON_TAC[]);; let MCBALL_SUBSET_MSPACE = prove (`!m (x:A) r. mcball m (x,r) SUBSET (mspace m)`, REWRITE_TAC[mcball; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let MBALL_SUBSET_MCBALL = prove (`!m x:A r. mball m (x,r) SUBSET mcball m (x,r)`, SIMP_TAC[SUBSET; IN_MBALL; IN_MCBALL; REAL_LT_IMP_LE]);; let MCBALL_SUBSET = prove (`!m x y:A a b. y IN mspace m /\ mdist m (x,y) + a <= b ==> mcball m (x,a) SUBSET mcball m (y,b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:A IN mspace m` THENL [STRIP_TAC; ASM SET_TAC [MCBALL_EMPTY_ALT]] THEN ASM_REWRITE_TAC[SUBSET; IN_MCBALL] THEN FIX_TAC "[z]" THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CUT_TAC `mdist m (y,z) <= mdist m (x:A,y) + mdist m (x,z)` THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[MDIST_SYM; MDIST_TRIANGLE]]);; let MCBALL_SUBSET_CONCENTRIC = prove (`!m (x:A) a b. a <= b ==> mcball m (x,a) SUBSET mcball m (x,b)`, SIMP_TAC[SUBSET; IN_MCBALL] THEN MESON_TAC[REAL_LE_TRANS]);; let MCBALL_SUBSET_MBALL = prove (`!m x y:A a b. y IN mspace m /\ mdist m (x,y) + a < b ==> mcball m (x,a) SUBSET mball m (y,b)`, INTRO_TAC "!m x y a b; y lt" THEN ASM_CASES_TAC `x:A IN mspace m` THENL [POP_ASSUM (LABEL_TAC "x"); ASM_SIMP_TAC[MCBALL_EMPTY_ALT; EMPTY_SUBSET]] THEN ASM_REWRITE_TAC[SUBSET; IN_MCBALL; IN_MBALL] THEN INTRO_TAC "![z]; z le" THEN HYP REWRITE_TAC "z" [] THEN TRANS_TAC REAL_LET_TRANS `mdist m (y:A,x) + mdist m (x,z)` THEN ASM_SIMP_TAC[MDIST_TRIANGLE] THEN TRANS_TAC REAL_LET_TRANS `mdist m (x:A,y) + a` THEN HYP REWRITE_TAC "lt" [] THEN HYP SIMP_TAC "x y" [MDIST_SYM] THEN ASM_REAL_ARITH_TAC);; let MCBALL_SUBSET_MBALL_CONCENTRIC = prove (`!m x:A a b. a < b ==> mcball m (x,a) SUBSET mball m (x,b)`, INTRO_TAC "!m x a b; lt" THEN ASM_CASES_TAC `x:A IN mspace m` THENL [POP_ASSUM (LABEL_TAC "x"); ASM_SIMP_TAC[MCBALL_EMPTY_ALT; EMPTY_SUBSET]] THEN MATCH_MP_TAC MCBALL_SUBSET_MBALL THEN ASM_SIMP_TAC[MDIST_REFL] THEN ASM_REAL_ARITH_TAC);; let CLOSED_IN_MCBALL = prove (`!m:A metric x r. closed_in (mtopology m) (mcball m (x,r))`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_METRIC; MCBALL_SUBSET_MSPACE; DIFF; IN_ELIM_THM; IN_MCBALL; DE_MORGAN_THM; REAL_NOT_LE] THEN FIX_TAC "[y]" THEN MAP_EVERY ASM_CASES_TAC [`x:A IN mspace m`; `y:A IN mspace m`] THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_SIMP_TAC[MCBALL_EMPTY_ALT; DISJOINT_EMPTY] THEN MESON_TAC[REAL_LT_01]] THEN INTRO_TAC "lt" THEN EXISTS_TAC `mdist m (x:A,y) - r` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[EXTENSION; DISJOINT; IN_INTER; NOT_IN_EMPTY; IN_MBALL; IN_MCBALL] THEN FIX_TAC "[z]" THEN ASM_CASES_TAC `z:A IN mspace m` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `mdist m (x,y) <= mdist m (x:A,z) + mdist m (z,y)` MP_TAC THENL [ASM_SIMP_TAC[MDIST_TRIANGLE]; ALL_TAC] THEN ASM_SIMP_TAC[MDIST_SYM] THEN ASM_REAL_ARITH_TAC);; let MCBALL_SUBMETRIC = prove (`!m s x:A r. x IN s ==> mcball (submetric m s) (x,r) = mcball m (x,r) INTER s`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_MCBALL; IN_INTER; SUBMETRIC] THEN MESON_TAC[]);; let OPEN_IN_MTOPOLOGY_MCBALL = prove (`!m u. open_in (mtopology m) (u:A->bool) <=> u SUBSET mspace m /\ (!x. x IN u ==> (?r. &0 < r /\ mcball m (x,r) SUBSET u))`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_MTOPOLOGY] THEN ASM_CASES_TAC `u:A->bool SUBSET mspace m` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [INTRO_TAC "hp; !x; x" THEN REMOVE_THEN "x" (HYP_TAC "hp: @r. rpos sub" o C MATCH_MP) THEN EXISTS_TAC `r / &2` THEN HYP REWRITE_TAC "rpos" [REAL_HALF] THEN TRANS_TAC SUBSET_TRANS `mball m (x:A,r)` THEN HYP REWRITE_TAC "sub" [] THEN MATCH_MP_TAC MCBALL_SUBSET_MBALL_CONCENTRIC THEN ASM_REAL_ARITH_TAC; INTRO_TAC "hp; !x; x" THEN REMOVE_THEN "x" (HYP_TAC "hp: @r. rpos sub" o C MATCH_MP) THEN EXISTS_TAC `r:real` THEN HYP REWRITE_TAC "rpos" [] THEN TRANS_TAC SUBSET_TRANS `mcball m (x:A,r)` THEN HYP REWRITE_TAC "sub" [MBALL_SUBSET_MCBALL]]);; let METRIC_DERIVED_SET_OF = prove (`!m s. mtopology m derived_set_of s = {x:A | x IN mspace m /\ (!r. &0 < r ==> (?y. ~(y = x) /\ y IN s /\ y IN mball m (x,r)))}`, REWRITE_TAC[derived_set_of; TOPSPACE_MTOPOLOGY; OPEN_IN_MTOPOLOGY; EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `x:A IN mspace m` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (LABEL_TAC "x") THEN EQ_TAC THENL [INTRO_TAC "hp; !r; r" THEN HYP_TAC "hp: +" (SPEC `mball m (x:A,r)`) THEN ASM_REWRITE_TAC[CENTRE_IN_MBALL_EQ; MBALL_SUBSET_MSPACE] THEN DISCH_THEN MATCH_MP_TAC THEN HYP REWRITE_TAC "x" [IN_MBALL] THEN INTRO_TAC "![y]; y xy" THEN EXISTS_TAC `r - mdist m (x:A,y)` THEN CONJ_TAC THENL [REMOVE_THEN "xy" MP_TAC THEN REAL_ARITH_TAC; HYP REWRITE_TAC "x y" [SUBSET; IN_MBALL] THEN INTRO_TAC "![z]; z lt" THEN HYP REWRITE_TAC "z" [] THEN TRANS_TAC REAL_LET_TRANS `mdist m (x:A,y) + mdist m (y,z)` THEN ASM_SIMP_TAC[MDIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC]; INTRO_TAC "hp; !t; t inc r" THEN HYP_TAC "r: @r. r ball" (C MATCH_MP (ASSUME `x:A IN t`)) THEN HYP_TAC "hp: @y. neq y dist" (C MATCH_MP (ASSUME `&0 < r`)) THEN EXISTS_TAC `y:A` THEN HYP REWRITE_TAC "neq y" [] THEN ASM SET_TAC[]]);; let METRIC_CLOSURE_OF = prove (`!m s. mtopology m closure_of s = {x:A | x IN mspace m /\ (!r. &0 < r ==> (?y. y IN s /\ y IN mball m (x,r)))}`, REWRITE_TAC[closure_of; TOPSPACE_MTOPOLOGY; OPEN_IN_MTOPOLOGY; EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `x:A IN mspace m` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (LABEL_TAC "x") THEN EQ_TAC THENL [INTRO_TAC "hp; !r; r" THEN HYP_TAC "hp: +" (SPEC `mball m (x:A,r)`) THEN ASM_REWRITE_TAC[CENTRE_IN_MBALL_EQ; MBALL_SUBSET_MSPACE] THEN DISCH_THEN MATCH_MP_TAC THEN HYP REWRITE_TAC "x" [IN_MBALL] THEN INTRO_TAC "![y]; y xy" THEN EXISTS_TAC `r - mdist m (x:A,y)` THEN CONJ_TAC THENL [REMOVE_THEN "xy" MP_TAC THEN REAL_ARITH_TAC; HYP REWRITE_TAC "x y" [SUBSET; IN_MBALL] THEN INTRO_TAC "![z]; z lt" THEN HYP REWRITE_TAC "z" [] THEN TRANS_TAC REAL_LET_TRANS `mdist m (x:A,y) + mdist m (y,z)` THEN ASM_SIMP_TAC[MDIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC]; INTRO_TAC "hp; !t; t inc r" THEN HYP_TAC "r: @r. r ball" (C MATCH_MP (ASSUME `x:A IN t`)) THEN HYP_TAC "hp: @y. y dist" (C MATCH_MP (ASSUME `&0 < r`)) THEN EXISTS_TAC `y:A` THEN HYP REWRITE_TAC "y" [] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Spheres in metric spaces. *) (* ------------------------------------------------------------------------- *) let msphere = new_definition `msphere m (x:A,e) = {y | mdist m (x,y) = e}`;; (* ------------------------------------------------------------------------- *) (* Bounded sets. *) (* ------------------------------------------------------------------------- *) let mbounded = new_definition `mbounded m s <=> (?c:A b. s SUBSET mcball m (c,b))`;; let MBOUNDED_SUBSET = prove (`!m s t:A->bool. mbounded m t /\ s SUBSET t ==> mbounded m s`, REWRITE_TAC[mbounded] THEN SET_TAC[]);; let MBOUNDED_SUBSET_MSPACE = prove (`!m s:A->bool. mbounded m s ==> s SUBSET mspace m`, REWRITE_TAC[mbounded] THEN REPEAT STRIP_TAC THEN TRANS_TAC SUBSET_TRANS `mcball m (c:A,b)` THEN ASM_REWRITE_TAC[MCBALL_SUBSET_MSPACE]);; let MBOUNDED = prove (`!m s. mbounded m s <=> s = {} \/ (!x:A. x IN s ==> x IN mspace m) /\ (?c b. c IN mspace m /\ (!x. x IN s ==> mdist m (c,x) <= b))`, REPEAT GEN_TAC THEN REWRITE_TAC[mbounded; SUBSET; IN_MCBALL] THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM SET_TAC[]);; let MBOUNDED_EMPTY = prove (`!m:A metric. mbounded m {}`, REWRITE_TAC[mbounded; EMPTY_SUBSET]);; let MBOUNDED_MCBALL = prove (`!m:A metric c b. mbounded m (mcball m (c,b))`, REWRITE_TAC[mbounded] THEN MESON_TAC[SUBSET_REFL]);; let MBOUNDED_MBALL = prove (`!m:A metric c b. mbounded m (mball m (c,b))`, REPEAT GEN_TAC THEN MATCH_MP_TAC MBOUNDED_SUBSET THEN EXISTS_TAC `mcball m (c:A,b)` THEN REWRITE_TAC[MBALL_SUBSET_MCBALL; MBOUNDED_MCBALL]);; let MBOUNDED_INSERT = prove (`!m a:A s. mbounded m (a INSERT s) <=> a IN mspace m /\ mbounded m s`, REPEAT GEN_TAC THEN REWRITE_TAC[MBOUNDED; NOT_INSERT_EMPTY; IN_INSERT] THEN ASM_CASES_TAC `a:A IN mspace m` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY] THENL [ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`c:A`; `max b (mdist m (c:A,a))`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MAX_MAX] THEN TRANS_TAC REAL_LE_TRANS `b:real` THEN ASM_SIMP_TAC[REAL_MAX_MAX]);; let MBOUNDED_INTER = prove (`!m:A metric s t. mbounded m s /\ mbounded m t ==> mbounded m (s INTER t)`, REWRITE_TAC[mbounded] THEN SET_TAC[]);; let MBOUNDED_UNION = prove (`!m:A metric s t. mbounded m (s UNION t) <=> mbounded m s /\ mbounded m t`, REPEAT GEN_TAC THEN REWRITE_TAC[mbounded] THEN EQ_TAC THENL [SET_TAC[]; INTRO_TAC "(@c1 b1. s) (@c2 b2. t)"] THEN ASM_CASES_TAC `&0 <= b1 /\ &0 <= b2 /\ c1:A IN mspace m /\ c2 IN mspace m` THENL [POP_ASSUM STRIP_ASSUME_TAC; POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN ASM SET_TAC [MCBALL_EMPTY; MCBALL_EMPTY_ALT]] THEN MAP_EVERY EXISTS_TAC [`c1:A`; `b1 + b2 + mdist m (c1:A,c2)`] THEN REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `mcball m (c1:A,b1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MCBALL_SUBSET_CONCENTRIC THEN CUT_TAC `&0 <= mdist m (c1:A,c2)` THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[MDIST_POS_LE]]; TRANS_TAC SUBSET_TRANS `mcball m (c2:A,b2)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MCBALL_SUBSET THEN ASM_SIMP_TAC[MDIST_SYM] THEN ASM_REAL_ARITH_TAC]);; let MBOUNDED_IFF_FINITE_DIAMETER = prove (`!m:A metric s. mbounded m s <=> s SUBSET mspace m /\ (?b. !x y. x IN s /\ y IN s ==> mdist m (x,y) <= b)`, REPEAT GEN_TAC THEN REWRITE_TAC[mbounded; SUBSET; IN_MCBALL] THEN EQ_TAC THENL [INTRO_TAC "@c b. hp" THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `b + b:real` THEN INTRO_TAC "!x y; x y" THEN TRANS_TAC REAL_LE_TRANS `mdist m (x:A,c) + mdist m (c,y)` THEN CONJ_TAC THENL [ASM_MESON_TAC[MDIST_TRIANGLE]; MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_MESON_TAC[MDIST_SYM]]; ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN POP_ASSUM (DESTRUCT_TAC "@a. a" o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN INTRO_TAC "inc (@b. bound)" THEN MAP_EVERY EXISTS_TAC [`a:A`; `b:real`] THEN ASM_SIMP_TAC[]]);; let MBOUNDED_SUBMETRIC = prove (`!m:A metric s. mbounded (submetric m s) t <=> mbounded m (s INTER t) /\ t SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[MBOUNDED_IFF_FINITE_DIAMETER; SUBMETRIC] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A decision procedure for metric spaces. *) (* ------------------------------------------------------------------------- *) let METRIC_ARITH : term -> thm = let SUP_CONV = let conv0 = REWR_CONV SUP_INSERT_INSERT and conv1 = REWR_CONV SUP_SING in conv1 ORELSEC (conv0 THENC REPEATC conv0 THENC TRY_CONV conv1) in let MAXDIST_THM = prove (`!m s x y:A. mbounded m s /\ x IN s /\ y IN s ==> mdist m (x,y) = sup (IMAGE (\a. abs(mdist m (x,a) - mdist m (a,y))) s)`, REPEAT GEN_TAC THEN INTRO_TAC "bnd x y" THEN MATCH_MP_TAC (GSYM SUP_UNIQUE) THEN CLAIM_TAC "inc" `!p:A. p IN s ==> p IN mspace m` THENL [HYP SET_TAC "bnd" [MBOUNDED_SUBSET_MSPACE]; ALL_TAC] THEN GEN_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN EQ_TAC THENL [INTRO_TAC "le; ![z]; z" THEN TRANS_TAC REAL_LE_TRANS `mdist m (x:A,y)` THEN ASM_SIMP_TAC[MDIST_REVERSE_TRIANGLE]; DISCH_THEN (MP_TAC o C MATCH_MP (ASSUME `y:A IN s`)) THEN ASM_SIMP_TAC[MDIST_REFL; REAL_SUB_RZERO; REAL_ABS_MDIST]]) and METRIC_EQ_THM = prove (`!m s x y:A. s SUBSET mspace m /\ x IN s /\ y IN s ==> (x = y <=> (!a. a IN s ==> mdist m (x,a) = mdist m (y,a)))`, INTRO_TAC "!m s x y; sub sx sy" THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `y:A`) THEN CLAIM_TAC "x y" `x:A IN mspace m /\ y IN mspace m` THENL [ASM SET_TAC []; ASM_SIMP_TAC[MDIST_REFL; MDIST_0]]) in let CONJ1_CONV : conv -> conv = let TRUE_CONJ_CONV = REWR_CONV (MESON [] `T /\ p <=> p`) in fun conv -> LAND_CONV conv THENC TRUE_CONJ_CONV in let IN_CONV : conv = let DISJ_TRUE_CONV = REWR_CONV (MESON [] `p \/ T <=> T`) and TRUE_DISJ_CONV = REWR_CONV (MESON [] `T \/ p <=> T`) in let REFL_CONV = REWR_CONV (MESON [] `x:A = x <=> T`) in let conv0 = REWR_CONV (EQF_INTRO (SPEC_ALL NOT_IN_EMPTY)) in let conv1 = REWR_CONV IN_INSERT in let conv2 = LAND_CONV REFL_CONV THENC TRUE_DISJ_CONV in let rec IN_CONV tm = (conv0 ORELSEC (conv1 THENC (conv2 ORELSEC (RAND_CONV IN_CONV THENC DISJ_TRUE_CONV)))) tm in IN_CONV and IMAGE_CONV : conv = let pth0,pth1 = CONJ_PAIR IMAGE_CLAUSES in let conv0 = REWR_CONV pth0 and conv1 = REWR_CONV pth1 THENC TRY_CONV (LAND_CONV BETA_CONV) in let rec IMAGE_CONV tm = (conv0 ORELSEC (conv1 THENC RAND_CONV IMAGE_CONV)) tm in IMAGE_CONV in let SUBSET_CONV : conv -> conv = let conv0 = REWR_CONV (EQT_INTRO (SPEC_ALL EMPTY_SUBSET)) in let conv1 = REWR_CONV INSERT_SUBSET in fun conv -> let conv2 = conv1 THENC CONJ1_CONV conv in REPEATC conv2 THENC conv0 in let rec prove_hyps th = match hyp th with | [] -> th | htm :: _ -> let emth = SPEC htm EXCLUDED_MIDDLE in let nhp = EQF_INTRO (ASSUME (mk_neg htm)) in let nth1 = (SUBS_CONV [nhp] THENC PRESIMP_CONV) (concl th) in let nth2 = MESON [nhp] (rand (concl nth1)) in let nth = EQ_MP (SYM nth1) nth2 in prove_hyps(DISJ_CASES emth th nth) in let rec guess_metric tm = match tm with | Comb(Const("mdist",_),m) -> m | Comb(Const("mspace",_),m) -> m | Comb(s,t) -> (try guess_metric s with Failure _ -> guess_metric t) | Abs(_, bd) -> guess_metric bd | _ -> failwith "metric not found" in let find_mdist mtm = let rec find tm = match tm with | Comb(Comb(Const("mdist",_),pmtm),p) when pmtm = mtm -> [tm] | Comb(s,t) -> union (find s) (find t) | Abs(v, bd) -> filter (fun x -> not(free_in v x)) (find bd) | _ -> [] in find and find_eq mty = let rec find tm = match tm with | Comb(Comb(Const("=",ty),_),_) when fst(dest_fun_ty ty) = mty -> [tm] | Comb(s,t) -> union (find s) (find t) | Abs(v, bd) -> filter (fun x -> not(free_in v x)) (find bd) | _ -> [] in find and find_points mtm = let rec find tm = match tm with | Comb(Comb(Const("mdist",_),pmtm),p) when pmtm = mtm -> let x,y = dest_pair p in if x = y then [x] else [x;y] | Comb(s,t) -> union (find s) (find t) | Abs(v, bd) -> filter (fun x -> not(free_in v x)) (find bd) | _ -> [] in find in let prenex_conv = TOP_DEPTH_CONV BETA_CONV THENC PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP] THENC NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC PRESIMP_CONV THENC GEN_REWRITE_CONV REDEPTH_CONV [AND_FORALL_THM; LEFT_AND_FORALL_THM; RIGHT_AND_FORALL_THM; LEFT_OR_FORALL_THM; RIGHT_OR_FORALL_THM] THENC PRENEX_CONV and real_poly_conv = let eths = REAL_ARITH `(x = y <=> x - y = &0) /\ (x < y <=> y - x > &0) /\ (x > y <=> x - y > &0) /\ (x <= y <=> y - x >= &0) /\ (x >= y <=> x - y >= &0)` in GEN_REWRITE_CONV I [eths] THENC LAND_CONV REAL_POLY_CONV and augment_mdist_pos_thm = MESON [] `p ==> (q <=> r) ==> (q <=> (p ==> r))` in fun tm -> let mtm = guess_metric tm in let mty = hd(snd(dest_type(type_of mtm))) in let mspace_tm = mk_icomb(mk_const("mspace",[]),mtm) in let metric_eq_thm = ISPEC mtm METRIC_EQ_THM and mk_in_mspace_th = let in_tm = mk_const("IN",[mty,aty]) in fun pt -> ASSUME (mk_comb(mk_comb(in_tm,pt),mspace_tm)) in let th0 = prenex_conv tm in let tm0 = rand (concl th0) in let avs,bod = strip_forall tm0 in let points = find_points mtm bod in let in_mspace_conv = GEN_REWRITE_CONV I (map mk_in_mspace_th points) in let in_mspace2_conv = CONJ1_CONV in_mspace_conv THENC in_mspace_conv in let MDIST_REFL_CONV = let pconv = IMP_REWR_CONV (ISPEC mtm MDIST_REFL) in fun tm -> MP_CONV in_mspace_conv (pconv tm) and MDIST_SYM_CONV = let pconv = IMP_REWR_CONV (ISPEC mtm MDIST_SYM) in fun tm -> let x,y = dest_pair (rand tm) in if x <= y then failwith "MDIST_SYM_CONV" else MP_CONV in_mspace2_conv (pconv tm) and MBOUNDED_CONV = let conv0 = REWR_CONV (EQT_INTRO (ISPEC mtm MBOUNDED_EMPTY)) in let conv1 = REWR_CONV (ISPEC mtm MBOUNDED_INSERT) in let rec mbounded_conv tm = try conv0 tm with Failure _ -> (conv1 THENC CONJ1_CONV in_mspace_conv THENC mbounded_conv) tm in mbounded_conv in let REFL_SYM_CONV = MDIST_REFL_CONV ORELSEC MDIST_SYM_CONV in let ABS_MDIST_CONV = let pconv = IMP_REWR_CONV (ISPEC mtm REAL_ABS_MDIST) in fun tm -> MP_CONV in_mspace2_conv (pconv tm) in let metric_eq_prerule = (CONV_RULE o BINDER_CONV o BINDER_CONV) (LAND_CONV (CONJ1_CONV (SUBSET_CONV in_mspace_conv)) THENC RAND_CONV (REWRITE_CONV[FORALL_IN_INSERT; NOT_IN_EMPTY])) in let MAXDIST_CONV = let maxdist_thm = ISPEC mtm MAXDIST_THM and ante_conv = CONJ1_CONV MBOUNDED_CONV THENC CONJ1_CONV IN_CONV THENC IN_CONV and image_conv = IMAGE_CONV THENC ONCE_DEPTH_CONV REFL_SYM_CONV THENC PURE_REWRITE_CONV [REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_SUB_REFL; REAL_ABS_0; REAL_ABS_NEG; REAL_ABS_SUB; INSERT_AC] THENC ONCE_DEPTH_CONV ABS_MDIST_CONV THENC PURE_REWRITE_CONV[INSERT_AC] in let sup_conv = RAND_CONV image_conv THENC SUP_CONV in fun fset_tm -> let maxdist_th = SPEC fset_tm maxdist_thm in fun tm -> let th0 = MP_CONV ante_conv (IMP_REWR_CONV maxdist_th tm) in let tm0 = rand (concl th0) in let th1 = sup_conv tm0 in TRANS th0 th1 in let AUGMENT_MDISTS_POS_RULE = let mdist_pos_le = ISPEC mtm MDIST_POS_LE in let augment_rule : term -> thm -> thm = let mk_mdist_pos_thm tm = let xtm,ytm = dest_pair (rand tm) in let pth = SPECL[xtm;ytm] mdist_pos_le in MP_CONV (CONJ1_CONV in_mspace_conv THENC in_mspace_conv) pth in fun mdist_tm -> let ith = MATCH_MP augment_mdist_pos_thm (mk_mdist_pos_thm mdist_tm) in fun th -> MATCH_MP ith th in fun th -> let mdist_thl = find_mdist mtm (concl th) in itlist augment_rule mdist_thl th in let BASIC_METRIC_ARITH (tm : term) : thm = let mdist_tms = find_mdist mtm tm in let th0 = let eqs = mapfilter (MDIST_REFL_CONV ORELSEC MDIST_SYM_CONV) mdist_tms in (ONCE_DEPTH_CONV in_mspace_conv THENC PRESIMP_CONV THENC SUBS_CONV eqs THENC REAL_RAT_REDUCE_CONV THENC ONCE_DEPTH_CONV real_poly_conv) tm in let tm0 = rand (concl th0) in let points = find_points mtm tm0 in let fset_tm = mk_setenum(points,mty) in let METRIC_EQ_CONV = let th = metric_eq_prerule (SPEC fset_tm metric_eq_thm) in fun tm -> let xtm,ytm = dest_eq tm in let th0 = SPECL[xtm;ytm] th in let th1 = MP_CONV (CONJ1_CONV IN_CONV THENC IN_CONV) th0 in let tm1 = rand (concl th1) in let th2 = ONCE_DEPTH_CONV REFL_SYM_CONV tm1 in TRANS th1 th2 in let eq1 = map (MAXDIST_CONV fset_tm) (find_mdist mtm tm0) and eq2 = map METRIC_EQ_CONV (find_eq mty tm0) in let th1 = AUGMENT_MDISTS_POS_RULE (SUBS_CONV (eq1 @ eq2) tm0) in let tm1 = rand (concl th1) in prove_hyps (EQ_MP (SYM th0) (EQ_MP (SYM th1) (REAL_ARITH tm1))) in let SIMPLE_METRIC_ARITH tm = let th0 = (WEAK_CNF_CONV THENC CONJ_CANON_CONV) tm in let tml = try conjuncts (rand (concl th0)) with Failure s -> failwith("conjuncts "^s) in let th1 = try end_itlist CONJ (map BASIC_METRIC_ARITH tml) with Failure s -> failwith("end_itlist "^s) in EQ_MP (SYM th0) th1 in let elim_exists tm = let points = find_points mtm tm in let rec try_points v tm ptl = if ptl = [] then fail () else let xtm = hd ptl in try EXISTS (mk_exists(v,tm),xtm) (elim_exists (vsubst [xtm,v] tm)) with Failure _ -> try_points v tm (tl ptl) and elim_exists tm = try let v,bd = dest_exists tm in try_points v bd points with Failure _ -> SIMPLE_METRIC_ARITH tm in elim_exists tm in EQ_MP (SYM th0) (GENL avs (elim_exists bod));; let METRIC_ARITH_TAC = CONV_TAC METRIC_ARITH;; let ASM_METRIC_ARITH_TAC = REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN METRIC_ARITH_TAC;; (* ------------------------------------------------------------------------- *) (* Compact sets. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("compact_in",(12,"right"));; let compact_in = new_definition `!top s:A->bool. s compact_in top <=> s SUBSET topspace top /\ (!U. (!u. u IN U ==> open_in top u) /\ s SUBSET UNIONS U ==> (?V. FINITE V /\ V SUBSET U /\ s SUBSET UNIONS V))`;; let COMPACT_IN_SUBSET_TOPSPACE = prove (`!top s:A->bool. s compact_in top ==> s SUBSET topspace top`, SIMP_TAC[compact_in]);; let FINITE_IMP_COMPACT_IN = prove (`!top s:A->bool. s SUBSET topspace top /\ FINITE s ==> s compact_in top`, SIMP_TAC[compact_in] THEN INTRO_TAC "!top s; sub fin; !U; U s" THEN EXISTS_TAC `IMAGE (\x:A. @u. u IN U /\ x IN u) s` THEN HYP SIMP_TAC "fin" [FINITE_IMAGE] THEN ASM SET_TAC []);; let EMPTY_IMP_COMPACT_IN = prove (`!top. {}:A->bool compact_in top`, GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COMPACT_IN THEN REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET]);; let CLOSED_COMPACT_IN = prove (`!top k c:A->bool. k compact_in top /\ c SUBSET k /\ closed_in top c ==> c compact_in top`, INTRO_TAC "! *; cpt sub cl" THEN REWRITE_TAC[compact_in] THEN CONJ_TAC THENL [HYP SET_TAC "sub cpt" [compact_in]; INTRO_TAC "!U; U c"] THEN HYP_TAC "cpt: ksub cpt" (REWRITE_RULE[compact_in]) THEN REMOVE_THEN "cpt" (MP_TAC o SPEC `(topspace top DIFF c:A->bool) INSERT U`) THEN ANTS_TAC THENL [CONJ_TAC THENL [CUT_TAC `open_in top (topspace top DIFF c:A->bool)` THENL [HYP SET_TAC "U" [IN_DIFF]; HYP SIMP_TAC "cl" [OPEN_IN_DIFF; OPEN_IN_TOPSPACE]]; HYP_TAC "cl: c' cl" (REWRITE_RULE[closed_in]) THEN REWRITE_TAC[SUBSET; IN_INSERT; IN_DIFF; IN_UNIONS] THEN INTRO_TAC "!x; x" THEN ASM_CASES_TAC `x:A IN c` THEN POP_ASSUM (LABEL_TAC "x'") THENL [HYP SET_TAC "c x'" []; EXISTS_TAC `topspace top DIFF c:A->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC []]]; INTRO_TAC "@V. fin v k" THEN EXISTS_TAC `V DELETE (topspace top DIFF c:A->bool)` THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN CONJ_TAC THENL [ASM SET_TAC []; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_DELETE] THEN ASM SET_TAC []]);; let COMPACT_IN_IMP_MBOUNDED = prove (`!m s:A->bool. s compact_in (mtopology m) ==> mbounded m s`, REWRITE_TAC[compact_in; TOPSPACE_MTOPOLOGY; mbounded] THEN INTRO_TAC "!m s; s cpt" THEN ASM_CASES_TAC `s:A->bool = {}` THENL [ASM_REWRITE_TAC[EMPTY_SUBSET]; POP_ASSUM (DESTRUCT_TAC "@a. a" o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY])] THEN CLAIM_TAC "a'" `a:A IN mspace m` THENL [ASM SET_TAC[]; EXISTS_TAC `a:A`] THEN REMOVE_THEN "cpt" (MP_TAC o SPEC `{mball m (a:A,&n) | n IN (:num)}`) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN; OPEN_IN_MBALL]; REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN INTRO_TAC "!x; x" THEN CLAIM_TAC "@n. n" `?n. mdist m (a:A,x) <= &n` THENL [MATCH_ACCEPT_TAC REAL_ARCH_SIMPLE; EXISTS_TAC `mball m (a:A,&n + &1)`] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_ADD; IN_UNIV] THEN MESON_TAC[]; ASM_SIMP_TAC[IN_MBALL; REAL_ARITH `!x. x <= &n ==> x < &n + &1`] THEN ASM SET_TAC []]]; ALL_TAC] THEN INTRO_TAC "@V. fin V cov" THEN CLAIM_TAC "@k. k" `?k. !v. v IN V ==> v = mball m (a:A,&(k v))` THENL [REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN ASM SET_TAC []; ALL_TAC] THEN CLAIM_TAC "kfin" `FINITE (IMAGE (k:(A->bool)->num) V)` THENL [HYP SIMP_TAC "fin" [FINITE_IMAGE]; HYP_TAC "kfin: @n. n" (REWRITE_RULE[num_FINITE])] THEN EXISTS_TAC `&n` THEN TRANS_TAC SUBSET_TRANS `UNIONS (V:(A->bool)->bool)` THEN HYP SIMP_TAC "cov" [UNIONS_SUBSET] THEN INTRO_TAC "![v]; v" THEN USE_THEN "v" (HYP_TAC "k" o C MATCH_MP) THEN REMOVE_THEN "k" SUBST1_TAC THEN TRANS_TAC SUBSET_TRANS `mball m (a:A,&n)` THEN REWRITE_TAC[MBALL_SUBSET_MCBALL] THEN MATCH_MP_TAC MBALL_SUBSET THEN ASM_SIMP_TAC[MDIST_REFL; REAL_ADD_LID; REAL_OF_NUM_LE] THEN HYP SET_TAC "n v" []);; let COMPACT_IN_SUBTOPOLOGY_IMP_COMPACT = prove (`!top k s:A->bool. k compact_in subtopology top s ==> k compact_in top`, REWRITE_TAC[compact_in; TOPSPACE_SUBTOPOLOGY; SUBSET_INTER] THEN INTRO_TAC "!top k s; (k sub) cpt" THEN ASM_REWRITE_TAC[] THEN INTRO_TAC "!U; open cover" THEN HYP_TAC "cpt: +" (SPEC `{u INTER s | u | u:A->bool IN U}`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[GSYM INTER_UNIONS; SUBSET_INTER] THEN REWRITE_TAC[IN_ELIM_THM; OPEN_IN_SUBTOPOLOGY] THEN INTRO_TAC "!u; @v. v ueq" THEN REMOVE_THEN "ueq" SUBST_VAR_TAC THEN EXISTS_TAC `v:A->bool` THEN REMOVE_THEN "v" (HYP_TAC "open" o C MATCH_MP) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN INTRO_TAC "@V. fin V k" THEN EXISTS_TAC `IMAGE (\v:A->bool. if v IN V then @u. u IN U /\ v = u INTER s else {}) V` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_IMAGE] THEN INTRO_TAC "![u]; @v. ueq v" THEN REMOVE_THEN "ueq" SUBST_VAR_TAC THEN ASM_REWRITE_TAC[] THEN HYP_TAC "V" (REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN REMOVE_THEN "v" (HYP_TAC "V: @u. u veq" o C MATCH_MP) THEN REMOVE_THEN "veq" SUBST_VAR_TAC THEN HYP MESON_TAC "u" []; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_IMAGE] THEN INTRO_TAC "!x; x" THEN HYP_TAC "k" (REWRITE_RULE[SUBSET; IN_UNIONS]) THEN USE_THEN "x" (HYP_TAC "k: @v. v xINv" o C MATCH_MP) THEN LABEL_ABBREV_TAC `u:A->bool = @u. u IN U /\ v = u INTER s` THEN CLAIM_TAC "u' veq" `u:A->bool IN U /\ v = u INTER s` THENL [REMOVE_THEN "u" SUBST_VAR_TAC THEN CUT_TAC `?u:A->bool. u IN U /\ v = u INTER s` THENL [MESON_TAC[]; ALL_TAC] THEN HYP_TAC "V" (REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN USE_THEN "v" (HYP_TAC "V" o C MATCH_MP) THEN REMOVE_THEN "V" MATCH_ACCEPT_TAC; EXISTS_TAC `u:A->bool` THEN CONJ_TAC THENL [EXISTS_TAC `v:A->bool` THEN ASM_REWRITE_TAC[]; HYP SET_TAC "veq xINv" []]]);; let COMPACT_IMP_COMPACT_IN_SUBTOPOLOGY = prove (`!top k s:A->bool. k compact_in top /\ k SUBSET s ==> k compact_in subtopology top s`, INTRO_TAC "!top k s; cpt sub" THEN ASM_SIMP_TAC[compact_in; TOPSPACE_SUBTOPOLOGY; SUBSET_INTER; COMPACT_IN_SUBSET_TOPSPACE] THEN INTRO_TAC "!U; open cover" THEN HYP_TAC "cpt: sub' cpt" (REWRITE_RULE[compact_in]) THEN (HYP_TAC "cpt: +" o SPEC) `{v:A->bool | v | open_in top v /\ ?u. u IN U /\ u = v INTER s}` THEN ANTS_TAC THENL [SIMP_TAC[IN_ELIM_THM] THEN TRANS_TAC SUBSET_TRANS `UNIONS U:A->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC UNIONS_MONO THEN INTRO_TAC "![u]; u" THEN USE_THEN "u" (HYP_TAC "open" o C MATCH_MP) THEN HYP_TAC "open: @v. v ueq" (REWRITE_RULE[OPEN_IN_SUBTOPOLOGY]) THEN EXISTS_TAC `v:A->bool` THEN REMOVE_THEN "ueq" SUBST_VAR_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [EXISTS_TAC `v INTER s:A->bool` THEN ASM_REWRITE_TAC[]; SET_TAC[]]; ALL_TAC] THEN INTRO_TAC "@V. fin open cover" THEN EXISTS_TAC `{v INTER s | v | v:A->bool IN V}` THEN CONJ_TAC THENL [(SUBST1_TAC o SET_RULE) `{v INTER s | v | v:A->bool IN V} = IMAGE (\v. v INTER s) V` THEN ASM_SIMP_TAC[FINITE_IMAGE]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM INTER_UNIONS; SUBSET_INTER] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN INTRO_TAC "![u]; @v. v ueq" THEN REMOVE_THEN "ueq" SUBST_VAR_TAC THEN HYP_TAC "open" (REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN REMOVE_THEN "v" (HYP_TAC "open: v @u. u ueq" o C MATCH_MP) THEN REMOVE_THEN "ueq" SUBST_VAR_TAC THEN ASM_REWRITE_TAC[]);; let COMPACT_IN_SUBTOPOLOGY_EQ = prove (`!top k s:A->bool. k compact_in subtopology top s <=> k compact_in top /\ k SUBSET s`, REPEAT GEN_TAC THEN CUT_TAC `k:A->bool compact_in subtopology top s ==> k SUBSET s` THENL [MESON_TAC[COMPACT_IMP_COMPACT_IN_SUBTOPOLOGY; COMPACT_IN_SUBTOPOLOGY_IMP_COMPACT]; ALL_TAC] THEN DISCH_TAC THEN TRANS_TAC SUBSET_TRANS `topspace top INTER s:A->bool` THEN REWRITE_TAC[INTER_SUBSET] THEN ASM_SIMP_TAC[GSYM TOPSPACE_SUBTOPOLOGY; COMPACT_IN_SUBSET_TOPSPACE]);; (* ------------------------------------------------------------------------- *) (* Limits in a topological space. *) (* ------------------------------------------------------------------------- *) let limit = new_definition `limit top (f:A->B) l net <=> l IN topspace top /\ (!u. open_in top u /\ l IN u ==> eventually (\x. f x IN u) net)`;; let LIMIT_IN_TOPSPACE = prove (`!net top f:A->B l. limit top f l net ==> l IN topspace top`, SIMP_TAC[limit]);; let LIMIT_HAUSDORFF_UNIQUE = prove (`!net top f:A->B l1 l2. ~trivial_limit net /\ (!x y. x IN topspace top /\ y IN topspace top /\ ~(x = y) ==> ?u v. open_in top u /\ open_in top v /\ x IN u /\ y IN v /\ DISJOINT u v) /\ limit top f l1 net /\ limit top f l2 net ==> l1 = l2`, REWRITE_TAC[limit] THEN INTRO_TAC "! *; nontriv hp (l1 hp1) (l2 hp2)" THEN REFUTE_THEN (LABEL_TAC "contra") THEN REMOVE_THEN "hp" (MP_TAC o SPECL [`l1:B`; `l2:B`]) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT GEN_TAC THEN CUT_TAC `open_in top u /\ open_in top v /\ l1:B IN u /\ l2:B IN v ==> ?x:A. f x IN u /\ f x IN v` THENL [SET_TAC[]; STRIP_TAC] THEN CLAIM_TAC "rmk" `eventually (\x:A. f x:B IN u /\ f x IN v) net` THENL [ASM_SIMP_TAC[EVENTUALLY_AND]; HYP_TAC "rmk" (MATCH_MP EVENTUALLY_HAPPENS) THEN ASM_MESON_TAC[]]);; let LIMIT_SEQUENTIALLY = prove (`!top s l:A. limit top s l sequentially <=> l IN topspace top /\ (!u. open_in top u /\ l IN u ==> (?N. !n. N <= n ==> s n IN u))`, REWRITE_TAC[limit; EVENTUALLY_SEQUENTIALLY]);; let LIMIT_SEQUENTIALLY_OFFSET = prove (`!top f l:A k. limit top f l sequentially ==> limit top (\i. f (i + k)) l sequentially`, SIMP_TAC[LIMIT_SEQUENTIALLY] THEN INTRO_TAC "! *; l lim; !u; hp" THEN USE_THEN "hp" (HYP_TAC "lim: @N. N" o C MATCH_MP) THEN EXISTS_TAC `N:num` THEN INTRO_TAC "!n; n" THEN USE_THEN "N" MATCH_MP_TAC THEN ASM_ARITH_TAC);; let LIMIT_SEQUENTIALLY_OFFSET_REV = prove (`!top f l:A k. limit top (\i. f (i + k)) l sequentially ==> limit top f l sequentially`, SIMP_TAC[LIMIT_SEQUENTIALLY] THEN INTRO_TAC "! *; l lim; !u; hp" THEN USE_THEN "hp" (HYP_TAC "lim: @N. N" o C MATCH_MP) THEN EXISTS_TAC `N+k:num` THEN INTRO_TAC "!n; n" THEN REMOVE_THEN "N" (MP_TAC o SPEC `n-k:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `n - k + k = n:num` (fun th -> REWRITE_TAC[th]) THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Topological limit in metric spaces. *) (* ------------------------------------------------------------------------- *) let LIMIT_IN_MSPACE = prove (`!net m f:A->B l. limit (mtopology m) f l net ==> l IN mspace m`, MESON_TAC[LIMIT_IN_TOPSPACE; TOPSPACE_MTOPOLOGY]);; let LIMIT_METRIC_UNIQUE = prove (`!m f:A->B l1 l2 net. ~trivial_limit net /\ limit (mtopology m) f l1 net /\ limit (mtopology m) f l2 net ==> l1 = l2`, REPEAT STRIP_TAC THEN (MATCH_MP_TAC o ISPECL [`net:(A)net`; `mtopology (m:B metric)`; `f:A->B`]) LIMIT_HAUSDORFF_UNIQUE THEN ASM_REWRITE_TAC[TOPSPACE_MTOPOLOGY] THEN INTRO_TAC "!x y; x y neq" THEN LABEL_ABBREV_TAC `r = mdist m (x:B,y) / &3` THEN MAP_EVERY EXISTS_TAC [`mball m (x:B,r)`; `mball m (y:B,r)`] THEN REMOVE_THEN "r" (SUBST_ALL_TAC o GSYM) THEN ASM_SIMP_TAC[OPEN_IN_MBALL; CENTRE_IN_MBALL; MDIST_POS_LT; REAL_LT_DIV; REAL_ARITH `&0 < &3`] THEN HYP SIMP_TAC "x y neq" [DISJOINT_MBALL; MDIST_POS_LT; REAL_ARITH `!x. &0 < x ==> x / &3 + x / &3 <= x`]);; let LIMIT_METRIC = prove (`!m f:A->B l net. limit (mtopology m) f l net <=> l IN mspace m /\ (!e. &0 < e ==> eventually (\x. f x IN mspace m /\ mdist m (f x, l) < e) net)`, REPEAT GEN_TAC THEN REWRITE_TAC[limit; OPEN_IN_MTOPOLOGY; TOPSPACE_MTOPOLOGY] THEN EQ_TAC THENL [INTRO_TAC "l hp" THEN ASM_REWRITE_TAC[] THEN INTRO_TAC "!e; e" THEN REMOVE_THEN "hp" (MP_TAC o SPEC `mball m (l:B,e)`) THEN ASM_REWRITE_TAC[MBALL_SUBSET_MSPACE] THEN ASM_SIMP_TAC[CENTRE_IN_MBALL] THEN REWRITE_TAC[IN_MBALL] THEN ANTS_TAC THENL [INTRO_TAC "!x; x lt" THEN EXISTS_TAC `e - mdist m (l:B,x)` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[SUBSET; IN_MBALL] THEN INTRO_TAC "![y]; y lt'" THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LET_TRANS `mdist m (l:B,x) + mdist m (x,y)` THEN ASM_SIMP_TAC[MDIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC (REWRITE_RULE [IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[] THEN ASM_CASES_TAC `f (x:A):B IN mspace m` THEN ASM_SIMP_TAC[MDIST_SYM]]; INTRO_TAC "l hp" THEN ASM_REWRITE_TAC[] THEN INTRO_TAC "!u; (u hp) l" THEN REMOVE_THEN "hp" (DESTRUCT_TAC "@r. r sub" o C MATCH_MP (ASSUME `l:B IN u`)) THEN REMOVE_THEN "hp" (MP_TAC o C MATCH_MP (ASSUME `&0 < r`)) THEN MATCH_MP_TAC (REWRITE_RULE [IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[] THEN INTRO_TAC "f lt" THEN CLAIM_TAC "rmk" `f (x:A):B IN mball m (l,r)` THENL [ASM_SIMP_TAC[IN_MBALL; MDIST_SYM]; HYP SET_TAC "rmk sub" []]]);; let LIMIT_METRIC_SEQUENTIALLY = prove (`!m f:num->A l. limit (mtopology m) f l sequentially <=> l IN mspace m /\ (!e. &0 < e ==> (?N. !n. N <= n ==> f n IN mspace m /\ mdist m (f n,l) < e))`, REPEAT GEN_TAC THEN REWRITE_TAC[LIMIT_METRIC; EVENTUALLY_SEQUENTIALLY] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; let LIMIT_IN_CLOSED_IN = prove (`!net top s f:A->B l. ~trivial_limit net /\ limit top f l net /\ closed_in top s /\ eventually (\x. f x IN s) net ==> l IN s`, INTRO_TAC "! *; ntriv lim cl ev" THEN REFUTE_THEN (LABEL_TAC "contra") THEN HYP_TAC "lim: l lim" (REWRITE_RULE[limit]) THEN REMOVE_THEN "lim" (MP_TAC o SPEC `topspace top DIFF s:B->bool`) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_TOPSPACE; IN_DIFF; EVENTUALLY_AND] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ2_TAC THEN INTRO_TAC "nev" THEN HYP (MP_TAC o CONJ_LIST) "ev nev" [] THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);; let LIMIT_SUBMETRIC_IFF = prove (`!net m s f:A->B l. limit (mtopology (submetric m s)) f l net <=> l IN s /\ eventually (\x. f x IN s) net /\ limit (mtopology m) f l net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIMIT_METRIC; SUBMETRIC; IN_INTER; EVENTUALLY_AND] THEN EQ_TAC THEN SIMP_TAC[] THENL [INTRO_TAC "l hp"; MESON_TAC[]] THEN HYP_TAC "hp" (C MATCH_MP REAL_LT_01) THEN ASM_REWRITE_TAC[]);; let METRIC_CLOSED_IN_IFF_SEQUENTIALLY_CLOSED = prove (`!m s:A->bool. closed_in (mtopology m) s <=> s SUBSET mspace m /\ (!a l. (!n. a n IN s) /\ limit (mtopology m) a l sequentially ==> l IN s)`, REPEAT GEN_TAC THEN EQ_TAC THENL [INTRO_TAC "cl" THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_METRIC]; INTRO_TAC "!a l; a lim"] THEN MATCH_MP_TAC (ISPECL[`sequentially`; `mtopology (m:A metric)`] LIMIT_IN_CLOSED_IN) THEN EXISTS_TAC `a:num->A` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_TRUE]; ALL_TAC] THEN SIMP_TAC[CLOSED_IN_METRIC; IN_DIFF] THEN INTRO_TAC "sub seq; !x; x diff" THEN REFUTE_THEN (LABEL_TAC "contra" o REWRITE_RULE[NOT_EXISTS_THM; MESON[] `~(a /\ b) <=> a ==> ~b`]) THEN CLAIM_TAC "@a. a lt" `?a. (!n. a n:A IN s) /\ (!n. mdist m (x, a n) < inv(&n + &1))` THENL [REWRITE_TAC[GSYM FORALL_AND_THM; GSYM SKOLEM_THM] THEN GEN_TAC THEN REMOVE_THEN "contra" (MP_TAC o SPEC `inv (&n + &1)`) THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SET_RULE `~DISJOINT s t <=> ?x:A. x IN s /\ x IN t`] THEN ASM_REWRITE_TAC[IN_MBALL] THEN MESON_TAC[]; ALL_TAC] THEN CLAIM_TAC "a'" `!n:num. a n:A IN mspace m` THENL [HYP SET_TAC "sub a" []; ALL_TAC] THEN REMOVE_THEN "seq" (MP_TAC o SPECL[`a:num->A`;`x:A`]) THEN ASM_REWRITE_TAC[LIMIT_METRIC_SEQUENTIALLY] THEN INTRO_TAC "!e; e" THEN HYP_TAC "e -> @N. NZ Ngt Nlt" (ONCE_REWRITE_RULE[REAL_ARCH_INV]) THEN EXISTS_TAC `N:num` THEN INTRO_TAC "!n; n" THEN TRANS_TAC REAL_LT_TRANS `inv (&n + &1)` THEN CONJ_TAC THENL [HYP MESON_TAC "lt a' x" [MDIST_SYM]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `inv (&N)` THEN HYP REWRITE_TAC "Nlt" [] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Cauchy sequences and complete metric spaces. *) (* ------------------------------------------------------------------------- *) let cauchy_in = new_definition `!m:A metric s:num->A. cauchy_in m s <=> (!n. s n IN mspace m) /\ (!e. &0 < e ==> (?N. !n n'. N <= n /\ N <= n' ==> mdist m (s n,s n') < e))`;; let mcomplete = new_definition `!m:A metric. mcomplete m <=> (!s. cauchy_in m s ==> ?x. limit (mtopology m) s x sequentially)`;; let CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE = prove (`!m s:A->bool. closed_in (mtopology m) s /\ mcomplete m ==> mcomplete (submetric m s)`, INTRO_TAC "!m s; cl cp" THEN REWRITE_TAC[mcomplete] THEN INTRO_TAC "![a]; a" THEN CLAIM_TAC "cy'" `cauchy_in m (a:num->A)` THENL [REMOVE_THEN "a" MP_TAC THEN SIMP_TAC[cauchy_in; SUBMETRIC; IN_INTER]; HYP_TAC "cp" (GSYM o REWRITE_RULE[mcomplete]) THEN HYP REWRITE_TAC "cp" [LIMIT_SUBMETRIC_IFF] THEN REMOVE_THEN "cp" (HYP_TAC "cy': @l.l" o MATCH_MP) THEN EXISTS_TAC `l:A` THEN HYP_TAC "a: A cy" (REWRITE_RULE[cauchy_in; SUBMETRIC; IN_INTER]) THEN ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN MATCH_MP_TAC (ISPECL [`sequentially`; `mtopology(m:A metric)`] LIMIT_IN_CLOSED_IN) THEN EXISTS_TAC `a:num->A` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_TRUE]]);; let SEQUENTIALLY_CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE = prove (`!m s:A->bool. mcomplete m /\ (!x l. (!n. x n IN s) /\ limit (mtopology m) x l sequentially ==> l IN s) ==> mcomplete (submetric m s)`, INTRO_TAC "!m s; cpl seq" THEN SUBGOAL_THEN `submetric m (s:A->bool) = submetric m (mspace m INTER s)` SUBST1_TAC THENL [REWRITE_TAC[submetric; INTER_ACI]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE THEN ASM_REWRITE_TAC[METRIC_CLOSED_IN_IFF_SEQUENTIALLY_CLOSED; INTER_SUBSET] THEN INTRO_TAC "!a l; a lim" THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [MATCH_MP_TAC (ISPEC `sequentially` LIMIT_IN_MSPACE) THEN HYP MESON_TAC "lim" []; REMOVE_THEN "seq" MATCH_MP_TAC THEN HYP SET_TAC "a lim" []]);; (* ------------------------------------------------------------------------- *) (* Topological definition of continuous functions. *) (* ------------------------------------------------------------------------- *) let topcontinuous = new_definition `!top top' f:A->B. topcontinuous top top' f <=> (!x. x IN topspace top ==> f x IN topspace top') /\ (!u. open_in top' u ==> open_in top {x | x IN topspace top /\ f x IN u})`;; let TOPCONTINUOUS_IMAGE_SUBSET_TOPSPACE = prove (`!top top' f:A->B. topcontinuous top top' f ==> IMAGE f (topspace top) SUBSET topspace top'`, REWRITE_TAC[topcontinuous] THEN SET_TAC[]);; let TOPCONTINUOUS_LIMIT = prove (`!net top top' f:A->B g:B->C l. topcontinuous top top' g /\ limit top f l net ==> limit top' (g o f) (g l) net`, REWRITE_TAC[limit; o_THM] THEN INTRO_TAC "! *; cont l lim" THEN USE_THEN "cont" MP_TAC THEN REWRITE_TAC[topcontinuous] THEN INTRO_TAC "g cont" THEN ASM_SIMP_TAC[] THEN INTRO_TAC "!u; u gl" THEN ASM_CASES_TAC `trivial_limit (net:A net)` THENL [ASM_REWRITE_TAC[eventually]; POP_ASSUM (LABEL_TAC "nontriv")] THEN REMOVE_THEN "lim" (MP_TAC o SPEC `{x:B | x IN topspace top /\ g x:C IN u}`) THEN ASM_SIMP_TAC[IN_ELIM_THM; eventually] THEN MESON_TAC[]);; let TOPCONTINUOUS_IN_SUBTOPOLGY = prove (`!top top' s f:A->B. topcontinuous top (subtopology top' s) f <=> topcontinuous top top' f /\ IMAGE f (topspace top) SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[topcontinuous; TOPSPACE_SUBTOPOLOGY; IN_INTER; OPEN_IN_SUBTOPOLOGY] THEN EQ_TAC THEN SIMP_TAC[] THENL [INTRO_TAC "img cont" THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN INTRO_TAC "!u; u" THEN SUBGOAL_THEN `{x:A | x IN topspace top /\ f x:B IN u} = {x | x IN topspace top /\ f x IN u INTER s}` (fun th -> REWRITE_TAC[th]) THENL [HYP SET_TAC "img" []; ALL_TAC] THEN REMOVE_THEN "cont" MATCH_MP_TAC THEN EXISTS_TAC `u:B->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; INTRO_TAC "(img cont) img'" THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN INTRO_TAC "!u; @t. t ueq" THEN REMOVE_THEN "ueq" SUBST_VAR_TAC THEN SUBGOAL_THEN `{x:A | x IN topspace top /\ f x:B IN t INTER s} = {x | x IN topspace top /\ f x IN t}` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM SET_TAC[]]);; let IMAGE_COMPACT_IN = prove (`!top top' (f:A->B) s. s compact_in top /\ topcontinuous top top' f ==> (IMAGE f s) compact_in top'`, INTRO_TAC "!top top' f s; cpt cont" THEN REWRITE_TAC[compact_in] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `IMAGE (f:A->B) (topspace top)` THEN ASM_SIMP_TAC[TOPCONTINUOUS_IMAGE_SUBSET_TOPSPACE; IMAGE_SUBSET; COMPACT_IN_SUBSET_TOPSPACE]; INTRO_TAC "!U; U img"] THEN HYP_TAC "cpt : sub cpt" (REWRITE_RULE[compact_in]) THEN REMOVE_THEN "cpt" (MP_TAC o SPEC `{{x | x | x IN topspace top /\ (f:A->B) x IN u} | u | u IN U}`) THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIONS] THEN INTRO_TAC "{![w]; @v. v eq & !x; x}" THENL [REMOVE_THEN "eq" SUBST1_TAC THEN HYP_TAC "cont : wd cont" (REWRITE_RULE[topcontinuous]) THEN ASM SET_TAC[]; REMOVE_THEN "img" (MP_TAC o SPEC `f (x:A):B` o REWRITE_RULE[SUBSET]) THEN ANTS_TAC THENL [HYP SET_TAC "x" []; REWRITE_TAC[IN_UNIONS]] THEN INTRO_TAC "@t. t fx" THEN EXISTS_TAC `{x:A | x IN topspace top /\ f x:B IN t}` THEN ASM SET_TAC[]]; ALL_TAC] THEN INTRO_TAC "@V. fin sub s" THEN CLAIM_TAC "@u. u" `?u. !v. v IN V ==> u v IN U /\ v = {x:A | x IN topspace top /\ f x:B IN u v}` THENL [REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN INTRO_TAC "!v; v" THEN HYP_TAC "sub" (REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN REMOVE_THEN "v" (HYP_TAC "sub: @u. u eq" o C MATCH_MP) THEN EXISTS_TAC `u:B->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EXISTS_TAC `IMAGE (u:(A->bool)->(B->bool)) V` THEN CONJ_TAC THENL [HYP SIMP_TAC "fin" [FINITE_IMAGE]; ASM SET_TAC []]);; (* ------------------------------------------------------------------------- *) (* Pointwise continuity in topological spaces. *) (* ------------------------------------------------------------------------- *) let topcontinuous_at = new_definition `!top top' f:A->B x. topcontinuous_at top top' f x <=> x IN topspace top /\ (!x. x IN topspace top ==> f x IN topspace top') /\ (!v. open_in top' v /\ f x IN v ==> (?u. open_in top u /\ x IN u /\ (!y. y IN u ==> f y IN v)))`;; let TOPCONTINUOUS_EQ_TOPCONTINUOUS_AT = prove (`!top top' f:A->B. topcontinuous top top' f <=> (!x. x IN topspace top ==> topcontinuous_at top top' f x)`, REPEAT GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[topcontinuous; topcontinuous_at] THEN INTRO_TAC "f v; !x; x; !v; v1 v2" THEN REMOVE_THEN "v" (MP_TAC o C MATCH_MP (ASSUME `open_in top' (v:B->bool)`)) THEN INTRO_TAC "pre" THEN EXISTS_TAC `{x:A | x IN topspace top /\ f x:B IN v}` THEN ASM_SIMP_TAC[IN_ELIM_THM]; ALL_TAC] THEN SIMP_TAC[topcontinuous; topcontinuous_at; SUBSET] THEN INTRO_TAC "hp1" THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN INTRO_TAC "![v]; v" THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[IN_ELIM_THM] THEN INTRO_TAC "!x; x1 x2" THEN REMOVE_THEN "hp1" (MP_TAC o SPEC `x:A`) THEN ASM_SIMP_TAC[] THEN INTRO_TAC "x3 v1" THEN REMOVE_THEN "v1" (MP_TAC o SPEC `v:B->bool`) THEN USE_THEN "x1" (LABEL_TAC "x4" o REWRITE_RULE[IN_ELIM_THM]) THEN ASM_SIMP_TAC[] THEN INTRO_TAC "@u. u1 u2 u3" THEN EXISTS_TAC `u:A->bool` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[OPEN_IN_SUBSET; SUBSET]);; (* ------------------------------------------------------------------------- *) (* Continuous functions on metric spaces. *) (* ------------------------------------------------------------------------- *) let METRIC_TOPCONTINUOUS = prove (`!m m' f:A->B. topcontinuous (mtopology m) (mtopology m') f <=> (!x. x IN mspace m ==> f x IN mspace m') /\ (!a e. &0 < e /\ a IN mspace m ==> (?d. &0 < d /\ (!x. x IN mspace m /\ mdist m (a,x) < d ==> mdist m' (f a, f x) < e)))`, REPEAT GEN_TAC THEN REWRITE_TAC[topcontinuous; TOPSPACE_MTOPOLOGY] THEN EQ_TAC THEN SIMP_TAC[] THENL [INTRO_TAC "f cont; !a e; e a" THEN REMOVE_THEN "cont" (MP_TAC o SPEC `mball m' (f (a:A):B,e)`) THEN REWRITE_TAC[OPEN_IN_MBALL] THEN ASM_SIMP_TAC[OPEN_IN_MTOPOLOGY; SUBSET; IN_MBALL; IN_ELIM_THM] THEN DISCH_THEN (MP_TAC o SPEC `a:A`) THEN ASM_SIMP_TAC[MDIST_REFL]; SIMP_TAC[OPEN_IN_MTOPOLOGY; SUBSET; IN_MBALL; IN_ELIM_THM] THEN ASM_MESON_TAC[]]);; let TOPCONTINUOUS_TO_METRIC = prove (`!t m f:A->B. topcontinuous t (mtopology m) f <=> (!x. x IN topspace t ==> (!r. &0 < r ==> (?u. open_in t u /\ x IN u /\ (!y. y IN u ==> f y IN mball m (f x,r)))))`, INTRO_TAC "!t m f" THEN REWRITE_TAC[TOPCONTINUOUS_EQ_TOPCONTINUOUS_AT; topcontinuous_at; TOPSPACE_MTOPOLOGY] THEN EQ_TAC THENL [INTRO_TAC "A; !x; x" THEN REMOVE_THEN "A" (MP_TAC o SPEC `x:A`) THEN ASM_SIMP_TAC[OPEN_IN_MBALL; CENTRE_IN_MBALL]; INTRO_TAC "A; !x; x" THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_01; IN_MBALL]; ASM_MESON_TAC[OPEN_IN_MTOPOLOGY; SUBSET]]]);; (* ------------------------------------------------------------------------- *) (* Lipschitz functions. *) (* ------------------------------------------------------------------------- *) let LIPSCHITZ_COEFFICIENT_POS = prove (`!m m' f:A->B k. (!x. x IN mspace m ==> f x IN mspace m') /\ (!x y. x IN mspace m /\ y IN mspace m ==> mdist m' (f x,f y) <= k * mdist m (x,y)) /\ (?x y. x IN mspace m /\ y IN mspace m /\ ~(f x = f y)) ==> &0 < k`, REPEAT GEN_TAC THEN INTRO_TAC "f k (@x y. x y fneq)" THEN CLAIM_TAC "neq" `~(x:A = y)` THENL [HYP MESON_TAC "fneq" []; ALL_TAC] THEN TRANS_TAC REAL_LTE_TRANS `mdist m' (f x:B,f y) / mdist m (x:A,y)` THEN ASM_SIMP_TAC[REAL_LT_DIV; MDIST_POS_LT; REAL_LE_LDIV_EQ]);; let LIPSCHITZ_CONTINUOUS_IMP_TOPCONTINUOUS = prove (`!m m' (f:A->B) k. (!x. x IN mspace m ==> f x IN mspace m') /\ (!x y. x IN mspace m /\ y IN mspace m ==> mdist m' (f x,f y) <= k * mdist m (x,y)) ==> topcontinuous (mtopology m) (mtopology m') f`, SIMP_TAC[METRIC_TOPCONTINUOUS] THEN INTRO_TAC "! *; f lip; !a e; e a" THEN ASM_CASES_TAC `?y:A. y IN mspace m /\ ~(f a:B = f y)` THENL [EXISTS_TAC `e / k` THEN POP_ASSUM (DESTRUCT_TAC "@y. y neq") THEN CLAIM_TAC "kpos" `&0 < k` THENL [(MATCH_MP_TAC o ISPECL[`m:A metric`; `m':B metric`; `f:A->B`]) LIPSCHITZ_COEFFICIENT_POS THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[REAL_LT_DIV] THEN INTRO_TAC "!x; x lt" THEN TRANS_TAC REAL_LET_TRANS `k * mdist m (a:A,x)` THEN ASM_SIMP_TAC[] THEN REMOVE_THEN "lt" MP_TAC THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN REWRITE_TAC[REAL_MUL_SYM]]; POP_ASSUM (LABEL_TAC "eq" o REWRITE_RULE[NOT_EXISTS_THM; DE_MORGAN_THM]) THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN INTRO_TAC "![y]; y d" THEN REMOVE_THEN "eq" (MP_TAC o SPEC `y:A`) THEN ASM_SIMP_TAC[MDIST_REFL]]);; (* ------------------------------------------------------------------------- *) (* Contractions. *) (* ------------------------------------------------------------------------- *) let CONTRACTION_IMP_UNIQUE_FIXPOINT = prove (`!m (f:A->A) k x y. k < &1 /\ (!x. x IN mspace m ==> f x IN mspace m) /\ (!x y. x IN mspace m /\ y IN mspace m ==> mdist m (f x, f y) <= k * mdist m (x,y)) /\ x IN mspace m /\ y IN mspace m /\ f x = x /\ f y = y ==> x = y`, INTRO_TAC "!m f k x y; k f le x y xeq yeq" THEN ASM_CASES_TAC `x:A = y` THENL [POP_ASSUM ACCEPT_TAC; ALL_TAC] THEN REMOVE_THEN "le" (MP_TAC o SPECL[`x:A`;`y:A`]) THEN ASM_REWRITE_TAC[] THEN CUT_TAC `&0 < (&1 - k) * mdist m (x:A,y:A)` THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[MDIST_POS_LT] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Banach Fixed-Point Theorem (aka, Contraction Mapping Principle). *) (* ------------------------------------------------------------------------- *) let BANACH_FIXPOINT_THM = prove (`!m f:A->A k. ~(mspace m = {}) /\ mcomplete m /\ (!x. x IN mspace m ==> f x IN mspace m) /\ k < &1 /\ (!x y. x IN mspace m /\ y IN mspace m ==> mdist m (f x, f y) <= k * mdist m (x,y)) ==> (?!x. x IN mspace m /\ f x = x)`, INTRO_TAC "!m f k; ne compl 4 k1 contr" THEN REMOVE_THEN "ne" MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN INTRO_TAC "@a. aINm" THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTRACTION_IMP_UNIQUE_FIXPOINT THEN ASM_MESON_TAC[]] THEN ASM_CASES_TAC `!x:A. x IN mspace m ==> f x:A = f a` THENL [ASM_MESON_TAC[]; POP_ASSUM (LABEL_TAC "nonsing")] THEN CLAIM_TAC "kpos" `&0 < k` THENL [MATCH_MP_TAC (ISPECL [`m:A metric`; `m:A metric`; `f:A->A`] LIPSCHITZ_COEFFICIENT_POS) THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN CLAIM_TAC "fINm" `!n:num. (ITER n f (a:A)) IN mspace m` THENL [LABEL_INDUCT_TAC THEN ASM_SIMP_TAC[ITER]; ALL_TAC] THEN ASM_CASES_TAC `f a = a:A` THENL [ASM_MESON_TAC[]; POP_ASSUM (LABEL_TAC "aneq")] THEN CUT_TAC `cauchy_in (m:A metric) (\n. ITER n f (a:A))` THENL [DISCH_THEN (fun cauchy -> HYP_TAC "compl : @l. lim" (C MATCH_MP cauchy o REWRITE_RULE[mcomplete])) THEN EXISTS_TAC `l:A` THEN CONJ_TAC THENL [ASM_MESON_TAC [LIMIT_IN_MSPACE]; ALL_TAC] THEN MATCH_MP_TAC (ISPECL [`m:A metric`; `(\n. ITER n f a:A)`] LIMIT_METRIC_UNIQUE) THEN EXISTS_TAC `sequentially` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC LIMIT_SEQUENTIALLY_OFFSET_REV THEN EXISTS_TAC `1` THEN REWRITE_TAC[GSYM ADD1] THEN SUBGOAL_THEN `(\i. ITER (SUC i) f (a:A)) = f o (\i. ITER i f a)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; ITER]; ALL_TAC] THEN MATCH_MP_TAC TOPCONTINUOUS_LIMIT THEN EXISTS_TAC `mtopology (m:A metric)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIPSCHITZ_CONTINUOUS_IMP_TOPCONTINUOUS THEN EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CLAIM_TAC "k1'" `&0 < &1 - k` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[cauchy_in] THEN INTRO_TAC "!e; e" THEN CLAIM_TAC "@N. N" `?N. k pow N < ((&1 - k) * e) / mdist m (a:A,f a)` THENL [MATCH_MP_TAC REAL_ARCH_POW_INV THEN ASM_SIMP_TAC[REAL_LT_DIV; MDIST_POS_LT; REAL_LT_MUL]; EXISTS_TAC `N:num`] THEN MATCH_MP_TAC WLOG_LT THEN ASM_SIMP_TAC[MDIST_REFL] THEN CONJ_TAC THENL [HYP MESON_TAC "fINm" [MDIST_SYM]; ALL_TAC] THEN INTRO_TAC "!n n'; lt; le le'" THEN TRANS_TAC REAL_LET_TRANS `sum (n..n'-1) (\i. mdist m (ITER i f a:A, ITER (SUC i) f a))` THEN CONJ_TAC THENL [REMOVE_THEN "lt" MP_TAC THEN SPEC_TAC (`n':num`,`n':num`) THEN LABEL_INDUCT_TAC THENL [REWRITE_TAC[LT]; REWRITE_TAC[LT_SUC_LE]] THEN INTRO_TAC "nle" THEN HYP_TAC "nle : nlt | neq" (REWRITE_RULE[LE_LT]) THENL [ALL_TAC; POP_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[ITER; ARITH_RULE `SUC n'' - 1 = n''`; SUM_SING_NUMSEG; REAL_LE_REFL]] THEN USE_THEN "nlt" (HYP_TAC "ind_n'" o C MATCH_MP) THEN REWRITE_TAC[ITER] THEN TRANS_TAC REAL_LE_TRANS `mdist m (ITER n f a:A,ITER n'' f a) + mdist m (ITER n'' f a,f (ITER n'' f a))` THEN ASM_SIMP_TAC[MDIST_TRIANGLE] THEN SUBGOAL_THEN `SUC n'' - 1 = SUC (n'' - 1)` SUBST1_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG]] THEN SUBGOAL_THEN `SUC (n'' - 1) = n''` SUBST1_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LT_IMP_LE; REAL_LE_RADD]] THEN REMOVE_THEN "ind_n'" (ACCEPT_TAC o REWRITE_RULE[ITER]); ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `sum (n..n'-1) (\i. mdist m (a:A, f a) * k pow i)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN CUT_TAC `!i. mdist m (ITER i f a,ITER (SUC i) f a) <= mdist m (a:A,f a) * k pow i` THENL [SIMP_TAC[ITER]; ALL_TAC] THEN LABEL_INDUCT_TAC THENL [REWRITE_TAC[ITER; real_pow; REAL_MUL_RID; REAL_LE_REFL]; HYP_TAC "ind_i" (REWRITE_RULE[ITER]) THEN TRANS_TAC REAL_LE_TRANS `k * mdist m (ITER i f a:A, f (ITER i f a))` THEN ASM_SIMP_TAC[real_pow; REAL_LE_LMUL_EQ; ITER; REAL_ARITH `!x. x * k * k pow i = k * x * k pow i`]]; ALL_TAC] THEN REWRITE_TAC[SUM_LMUL; SUM_GP] THEN HYP SIMP_TAC "lt" [ARITH_RULE `n < n' ==> ~(n' - 1 < n)`] THEN HYP SIMP_TAC "k1" [REAL_ARITH `k < &1 ==> ~(k = &1)`] THEN USE_THEN "lt" (SUBST1_TAC o MATCH_MP (ARITH_RULE `n < n' ==> SUC (n' - 1) = n'`)) THEN SUBGOAL_THEN `k pow n - k pow n' = k pow n * (&1 - k pow (n' - n))` SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_MUL_RID; GSYM REAL_POW_ADD] THEN HYP SIMP_TAC "lt" [ARITH_RULE `n < n' ==> n + n' - n = n':num`]; (SUBST1_TAC o REAL_ARITH) `mdist m (a:A,f a) * (k pow n * (&1 - k pow (n' - n))) / (&1 - k) = ((k pow n * (&1 - k pow (n' - n))) / (&1 - k)) * mdist m (a,f a)`] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; MDIST_POS_LT; REAL_LT_LDIV_EQ] THEN TRANS_TAC REAL_LET_TRANS `k pow n` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[GSYM REAL_POW_ADD; REAL_ARITH `k pow n - k pow n * (&1 - k pow (n' - n)) = k pow n * k pow (n' - n)`] THEN HYP SIMP_TAC "lt" [ARITH_RULE `n < n' ==> n + n' - n = n':num`] THEN HYP SIMP_TAC "kpos" [REAL_POW_LE; REAL_LT_IMP_LE]; TRANS_TAC REAL_LET_TRANS `k pow N` THEN ASM_SIMP_TAC[REAL_POW_MONO_INV; REAL_LT_IMP_LE; REAL_ARITH `e / mdist m (a:A,f a) * (&1 - k) = ((&1 - k) * e) / mdist m (a,f a)`]]);; (* ------------------------------------------------------------------------- *) (* Metric space of bounded functions. *) (* ------------------------------------------------------------------------- *) let funspace = new_definition `funspace s m = metric ({f:A->B | (!x. x IN s ==> f x IN mspace m) /\ f IN EXTENSIONAL s /\ mbounded m (IMAGE f s)}, (\(f,g). if s = {} then &0 else sup {mdist m (f x,g x) | x | x IN s}))`;; let FUNSPACE = (REWRITE_RULE[GSYM FORALL_AND_THM] o prove) (`!s m. mspace (funspace s m) = {f:A->B | (!x. x IN s ==> f x IN mspace m) /\ f IN EXTENSIONAL s /\ mbounded m (IMAGE f s)} /\ (!f g. mdist (funspace s m) (f,g) = if s = {} then &0 else sup {mdist m (f x,g x) | x | x IN s})`, REPEAT GEN_TAC THEN MAP_EVERY LABEL_ABBREV_TAC [`fspace = {f:A->B | (!x. x IN s ==> f x IN mspace m) /\ f IN EXTENSIONAL s /\ mbounded m (IMAGE f s)}`; `fdist = \(f,g). if s = {} then &0 else sup {mdist m (f x:B,g x) | x | x:A IN s}`] THEN CUT_TAC `mspace (funspace s m) = fspace:(A->B)->bool /\ mdist (funspace s m:(A->B)metric) = fdist` THENL [EXPAND_TAC "fdist" THEN DISCH_THEN (fun th -> REWRITE_TAC[th]); ASM_REWRITE_TAC[funspace] THEN MATCH_MP_TAC METRIC] THEN ASM_CASES_TAC `s:A->bool = {}` THENL [POP_ASSUM SUBST_ALL_TAC THEN MAP_EVERY EXPAND_TAC ["fspace"; "fdist"] THEN SIMP_TAC[is_metric_space; NOT_IN_EMPTY; IN_EXTENSIONAL; IMAGE_CLAUSES; MBOUNDED_EMPTY; IN_ELIM_THM; REAL_LE_REFL; REAL_ADD_LID; FUN_EQ_THM]; POP_ASSUM (LABEL_TAC "nempty")] THEN REMOVE_THEN "nempty" (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN LABEL_TAC "nempty" th) THEN CLAIM_TAC "wd ext bound" `(!f x:A. f IN fspace /\ x IN s ==> f x:B IN mspace m) /\ (!f. f IN fspace ==> f IN EXTENSIONAL s) /\ (!f. f IN fspace ==> (?c b. c IN mspace m /\ (!x. x IN s ==> mdist m (c,f x) <= b)))` THENL [EXPAND_TAC "fspace" THEN ASM_SIMP_TAC[IN_ELIM_THM; MBOUNDED; IMAGE_EQ_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN CLAIM_TAC "bound2" `!f g:A->B. f IN fspace /\ g IN fspace ==> (?b. !x. x IN s ==> mdist m (f x,g x) <= b)` THENL [REMOVE_THEN "fspace" (SUBST_ALL_TAC o GSYM) THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN CUT_TAC `mbounded m (IMAGE (f:A->B) s UNION IMAGE g s)` THENL [REWRITE_TAC[MBOUNDED_IFF_FINITE_DIAMETER; SUBSET; IN_UNION] THEN STRIP_TAC THEN EXISTS_TAC `b:real` THEN ASM SET_TAC []; ASM_REWRITE_TAC[MBOUNDED_UNION]]; ALL_TAC] THEN HYP_TAC "nempty -> @a. a" (REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[is_metric_space] THEN CONJ_TAC THENL [INTRO_TAC "![f] [g]; f g" THEN EXPAND_TAC "fdist" THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_SUP THEN CLAIM_TAC "@b. b" `?b. !x:A. x IN s ==> mdist m (f x:B,g x) <= b` THENL [HYP SIMP_TAC "bound2 f g" []; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`b:real`; `mdist m (f(a:A):B,g a)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN HYP SIMP_TAC "wd f g a" [MDIST_POS_LE] THEN HYP MESON_TAC "a b" []; ALL_TAC] THEN CONJ_TAC THENL [INTRO_TAC "![f] [g]; f g" THEN EXPAND_TAC "fdist" THEN REWRITE_TAC[] THEN EQ_TAC THENL [INTRO_TAC "sup0" THEN MATCH_MP_TAC (SPEC `s:A->bool` EXTENSIONAL_EQ) THEN HYP SIMP_TAC "f g ext" [] THEN INTRO_TAC "!x; x" THEN REFUTE_THEN (LABEL_TAC "neq") THEN CUT_TAC `&0 < mdist m (f (x:A):B, g x) /\ mdist m (f x, g x) <= sup {mdist m (f x,g x) | x IN s}` THENL [HYP REWRITE_TAC "sup0" [] THEN REAL_ARITH_TAC; ALL_TAC] THEN HYP SIMP_TAC "wd f g x neq" [MDIST_POS_LT] THEN MATCH_MP_TAC REAL_LE_SUP THEN CLAIM_TAC "@B. B" `?b. !x:A. x IN s ==> mdist m (f x:B,g x) <= b` THENL [HYP SIMP_TAC "bound2 f g" []; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`B:real`; `mdist m (f (x:A):B,g x)`] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; REAL_LE_REFL] THEN HYP MESON_TAC "B x" []; DISCH_THEN (SUBST1_TAC o GSYM) THEN SUBGOAL_THEN `{mdist m (f x:B,f x) | x:A IN s} = {&0}` (fun th -> REWRITE_TAC[th; SUP_SING]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNIV; IN_INSERT] THEN HYP MESON_TAC "wd f a" [MDIST_REFL]]; ALL_TAC] THEN CONJ_TAC THENL [INTRO_TAC "![f] [g]; f g" THEN EXPAND_TAC "fdist" THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN HYP MESON_TAC "wd f g" [MDIST_SYM]; ALL_TAC] THEN INTRO_TAC "![f] [g] [h]; f g h" THEN EXPAND_TAC "fdist" THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNIV] THEN HYP MESON_TAC "a" []; ALL_TAC] THEN FIX_TAC "[d]" THEN REWRITE_TAC [IN_ELIM_THM; IN_UNIV] THEN INTRO_TAC "@x. x d" THEN POP_ASSUM SUBST1_TAC THEN CUT_TAC `mdist m (f (x:A):B,h x) <= mdist m (f x,g x) + mdist m (g x, h x) /\ mdist m (f x, g x) <= fdist (f,g) /\ mdist m (g x, h x) <= fdist (g,h)` THEN EXPAND_TAC "fdist" THEN REWRITE_TAC[] THENL [REAL_ARITH_TAC; ALL_TAC] THEN HYP SIMP_TAC "wd f g h x" [MDIST_TRIANGLE] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_SUP THENL [CLAIM_TAC "@B. B" `?b. !x:A. x IN s ==> mdist m (f x:B,g x) <= b` THENL [HYP SIMP_TAC "bound2 f g" []; MAP_EVERY EXISTS_TAC [`B:real`; `mdist m (f(x:A):B,g x)`]] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; REAL_LE_REFL] THEN HYP MESON_TAC "B x" []; CLAIM_TAC "@B. B" `?b. !x:A. x IN s ==> mdist m (g x:B,h x) <= b` THENL [HYP SIMP_TAC "bound2 g h" []; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`B:real`; `mdist m (g(x:A):B,h x)`] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; REAL_LE_REFL] THEN HYP MESON_TAC "B x" []]);; let FUNSPACE_IMP_WELLDEFINED = prove (`!s m f:A->B x. f IN mspace (funspace s m) /\ x IN s ==> f x IN mspace m`, SIMP_TAC[FUNSPACE; IN_ELIM_THM]);; let FUNSPACE_IMP_EXTENSIONAL = prove (`!s m f:A->B. f IN mspace (funspace s m) ==> f IN EXTENSIONAL s`, SIMP_TAC[FUNSPACE; IN_ELIM_THM]);; let FUNSPACE_IMP_BOUNDED_IMAGE = prove (`!s m f:A->B. f IN mspace (funspace s m) ==> mbounded m (IMAGE f s)`, SIMP_TAC[FUNSPACE; IN_ELIM_THM]);; let FUNSPACE_IMP_BOUNDED = prove (`!s m f:A->B. f IN mspace (funspace s m) ==> s = {} \/ (?c b. !x. x IN s ==> mdist m (c,f x) <= b)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUNSPACE; MBOUNDED; IMAGE_EQ_EMPTY; IN_ELIM_THM] THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let FUNSPACE_IMP_BOUNDED2 = prove (`!s m f g:A->B. f IN mspace (funspace s m) /\ g IN mspace (funspace s m) ==> (?b. !x. x IN s ==> mdist m (f x,g x) <= b)`, REWRITE_TAC[FUNSPACE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN CUT_TAC `mbounded m (IMAGE (f:A->B) s UNION IMAGE g s)` THENL [REWRITE_TAC[MBOUNDED_IFF_FINITE_DIAMETER; SUBSET; IN_UNION] THEN STRIP_TAC THEN EXISTS_TAC `b:real` THEN ASM SET_TAC []; ASM_REWRITE_TAC[MBOUNDED_UNION]]);; let FUNSPACE_MDIST_LE = prove (`!s m f g:A->B a. ~(s = {}) /\ f IN mspace (funspace s m) /\ g IN mspace (funspace s m) ==> (mdist (funspace s m) (f,g) <= a <=> !x. x IN s ==> mdist m (f x, g x) <= a)`, INTRO_TAC "! *; ne f g" THEN HYP (DESTRUCT_TAC "@b. b" o MATCH_MP FUNSPACE_IMP_BOUNDED2 o CONJ_LIST) "f g" [] THEN ASM_REWRITE_TAC[FUNSPACE] THEN MP_TAC (ISPECL [`{mdist m (f x:B,g x) | x:A IN s}`; `a:real`] REAL_SUP_LE_EQ) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM]] THEN MESON_TAC[]);; let MCOMPLETE_FUNSPACE = prove (`!s:A->bool m:B metric. mcomplete m ==> mcomplete (funspace s m)`, REWRITE_TAC[mcomplete] THEN INTRO_TAC "!s m; cpl; ![f]; cy" THEN ASM_CASES_TAC `s:A->bool = {}` THENL [POP_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `\x:A. UNDEFINED:B` THEN REMOVE_THEN "cy" MP_TAC THEN SIMP_TAC[cauchy_in; LIMIT_METRIC_SEQUENTIALLY; FUNSPACE; NOT_IN_EMPTY; IN_ELIM_THM; IN_EXTENSIONAL; IMAGE_CLAUSES; MBOUNDED_EMPTY]; POP_ASSUM (LABEL_TAC "nempty")] THEN LABEL_ABBREV_TAC `g (x:A) = if x IN s then @y. limit (mtopology m) (\n:num. f n x) y sequentially else UNDEFINED:B` THEN EXISTS_TAC `g:A->B` THEN USE_THEN "cy" MP_TAC THEN HYP REWRITE_TAC "nempty" [cauchy_in; FUNSPACE; IN_ELIM_THM; FORALL_AND_THM] THEN INTRO_TAC "(fwd fext fbd) cy'" THEN ASM_REWRITE_TAC[LIMIT_METRIC_SEQUENTIALLY; FUNSPACE; IN_ELIM_THM] THEN CLAIM_TAC "gext" `g:A->B IN EXTENSIONAL s` THENL [REMOVE_THEN "g" (fun th -> SIMP_TAC[IN_EXTENSIONAL; GSYM th]); HYP REWRITE_TAC "gext" []] THEN CLAIM_TAC "bd2" `!n n'. ?b. !x:A. x IN s ==> mdist m (f (n:num) x:B, f n' x) <= b` THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC FUNSPACE_IMP_BOUNDED2 THEN ASM_REWRITE_TAC[FUNSPACE; IN_ELIM_THM; ETA_AX]; ALL_TAC] THEN CLAIM_TAC "sup" `!n n':num x0:A. x0 IN s ==> mdist m (f n x0:B,f n' x0) <= sup {mdist m (f n x,f n' x) | x IN s}` THENL [INTRO_TAC "!n n' x0; x0" THEN MATCH_MP_TAC REAL_LE_SUP THEN REMOVE_THEN "bd2" (DESTRUCT_TAC "@b. b" o SPECL[`n:num`;`n':num`]) THEN MAP_EVERY EXISTS_TAC [`b:real`; `mdist m (f (n:num) (x0:A):B, f n' x0)`] THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [HYP MESON_TAC "x0" []; REWRITE_TAC[REAL_LE_REFL]] THEN INTRO_TAC "![d]; @y. y d" THEN REMOVE_THEN "d" SUBST1_TAC THEN HYP SIMP_TAC "b y" []; ALL_TAC] THEN CLAIM_TAC "pcy" `!x:A. x IN s ==> cauchy_in m (\n. f n x:B)` THENL [INTRO_TAC "!x; x" THEN REWRITE_TAC[cauchy_in] THEN HYP SIMP_TAC "fwd x" [] THEN INTRO_TAC "!e; e" THEN USE_THEN "e" (HYP_TAC "cy': @N.N" o C MATCH_MP) THEN EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN DISCH_THEN (HYP_TAC "N" o C MATCH_MP) THEN TRANS_TAC REAL_LET_TRANS `sup {mdist m (f (n:num) x:B,f n' x) | x:A IN s}` THEN HYP REWRITE_TAC "N" [] THEN HYP SIMP_TAC "sup x" []; ALL_TAC] THEN CLAIM_TAC "glim" `!x:A. x IN s ==> limit (mtopology m) (\n. f n x:B) (g x) sequentially` THENL [INTRO_TAC "!x; x" THEN REMOVE_THEN "g" (fun th -> ASM_REWRITE_TAC[GSYM th]) THEN SELECT_ELIM_TAC THEN HYP SIMP_TAC "cpl pcy x" []; ALL_TAC] THEN CLAIM_TAC "gwd" `!x:A. x IN s ==> g x:B IN mspace m` THENL [INTRO_TAC "!x; x" THEN MATCH_MP_TAC (ISPECL[`sequentially`] LIMIT_IN_MSPACE) THEN EXISTS_TAC `\n:num. f n (x:A):B` THEN HYP SIMP_TAC "glim x" []; HYP REWRITE_TAC "gwd" []] THEN CLAIM_TAC "unif" `!e. &0 < e ==> ?N:num. !x:A n. x IN s /\ N <= n ==> mdist m (f n x:B, g x) < e` THENL [INTRO_TAC "!e; e" THEN REMOVE_THEN "cy'" (MP_TAC o SPEC `e / &2`) THEN HYP REWRITE_TAC "e" [REAL_HALF] THEN INTRO_TAC "@N. N" THEN EXISTS_TAC `N:num` THEN INTRO_TAC "!x n; x n" THEN USE_THEN "x" (HYP_TAC "glim" o C MATCH_MP) THEN HYP_TAC "glim: gx glim" (REWRITE_RULE[LIMIT_METRIC_SEQUENTIALLY]) THEN REMOVE_THEN "glim" (MP_TAC o SPEC `e / &2`) THEN HYP REWRITE_TAC "e" [REAL_HALF] THEN HYP SIMP_TAC "fwd x" [] THEN INTRO_TAC "@N'. N'" THEN TRANS_TAC REAL_LET_TRANS `mdist m (f n (x:A):B, f (MAX N N') x) + mdist m (f (MAX N N') x, g x)` THEN HYP SIMP_TAC "fwd x gwd" [MDIST_TRIANGLE] THEN TRANS_TAC REAL_LTE_TRANS `e / &2 + e / &2` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_ADD2; REWRITE_TAC[REAL_HALF; REAL_LE_REFL]] THEN CONJ_TAC THENL [ALL_TAC; REMOVE_THEN "N'" MATCH_MP_TAC THEN ARITH_TAC] THEN TRANS_TAC REAL_LET_TRANS `sup {mdist m (f n x:B,f (MAX N N') x) | x:A IN s}` THEN HYP SIMP_TAC "N n" [ARITH_RULE `N <= MAX N N'`] THEN HYP SIMP_TAC "sup x" []; ALL_TAC] THEN CONJ_TAC THENL [HYP_TAC "cy': @N. N" (C MATCH_MP REAL_LT_01) THEN USE_THEN "fbd" (MP_TAC o REWRITE_RULE[MBOUNDED] o SPEC `N:num`) THEN HYP REWRITE_TAC "nempty" [mbounded; IMAGE_EQ_EMPTY] THEN INTRO_TAC "Nwd (@c b. c Nbd)" THEN MAP_EVERY EXISTS_TAC [`c:B`; `b + &1`] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_MCBALL] THEN INTRO_TAC "![y]; (@x. y x)" THEN REMOVE_THEN "y" SUBST1_TAC THEN HYP SIMP_TAC "x gwd c" [] THEN TRANS_TAC REAL_LE_TRANS `mdist m (c:B, f (N:num) (x:A)) + mdist m (f N x, g x)` THEN HYP SIMP_TAC "c fwd gwd x" [MDIST_TRIANGLE] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL [REMOVE_THEN "Nbd" MATCH_MP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN HYP MESON_TAC "x" []; REFUTE_THEN (LABEL_TAC "contra" o REWRITE_RULE[REAL_NOT_LE])] THEN CLAIM_TAC "@a. a1 a2" `?a. &1 < a /\ a < mdist m (f (N:num) (x:A), g x:B)` THENL [EXISTS_TAC `(&1 + mdist m (f (N:num) (x:A), g x:B)) / &2` THEN REMOVE_THEN "contra" MP_TAC THEN REAL_ARITH_TAC; USE_THEN "x" (HYP_TAC "glim" o C MATCH_MP)] THEN REMOVE_THEN "glim" (MP_TAC o REWRITE_RULE[LIMIT_METRIC_SEQUENTIALLY]) THEN HYP SIMP_TAC "gwd x" [] THEN DISCH_THEN (MP_TAC o SPEC `a - &1`) THEN ANTS_TAC THENL [REMOVE_THEN "a1" MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN HYP SIMP_TAC "fwd x" [] THEN INTRO_TAC "@N'. N'" THEN CUT_TAC `mdist m (f (N:num) (x:A), g x:B) < a` THENL [REMOVE_THEN "a2" MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `mdist m (f N (x:A),f (MAX N N') x:B) + mdist m (f (MAX N N') x,g x)` THEN HYP SIMP_TAC "fwd gwd x" [MDIST_TRIANGLE] THEN SUBST1_TAC (REAL_ARITH `a = &1 + (a - &1)`) THEN MATCH_MP_TAC REAL_LT_ADD2 THEN CONJ_TAC THENL [ALL_TAC; REMOVE_THEN "N'" MATCH_MP_TAC THEN ARITH_TAC] THEN TRANS_TAC REAL_LET_TRANS `sup {mdist m (f N x:B,f (MAX N N') x) | x:A IN s}` THEN CONJ_TAC THENL [HYP SIMP_TAC "sup x" []; REMOVE_THEN "N" MATCH_MP_TAC THEN ARITH_TAC]; ALL_TAC] THEN INTRO_TAC "!e; e" THEN REMOVE_THEN "unif" (MP_TAC o SPEC `e / &2`) THEN HYP REWRITE_TAC "e" [REAL_HALF] THEN INTRO_TAC "@N. N" THEN EXISTS_TAC `N:num` THEN INTRO_TAC "!n; n" THEN TRANS_TAC REAL_LET_TRANS `e / &2` THEN CONJ_TAC THENL [ALL_TAC; REMOVE_THEN "e" MP_TAC THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC REAL_SUP_LE THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [HYP SET_TAC "nempty" []; HYP MESON_TAC "N n" [REAL_LT_IMP_LE]]);; (* ------------------------------------------------------------------------- *) (* Metric space of continuous bounded functions. *) (* ------------------------------------------------------------------------- *) let cfunspace = new_definition `cfunspace top m = submetric (funspace (topspace top) m) {f:A->B | topcontinuous top (mtopology m) f}`;; let CFUNSPACE = (REWRITE_RULE[GSYM FORALL_AND_THM] o prove) (`(!top m. mspace (cfunspace top m) = {f:A->B | (!x. x IN topspace top ==> f x IN mspace m) /\ f IN EXTENSIONAL (topspace top) /\ mbounded m (IMAGE f (topspace top)) /\ topcontinuous top (mtopology m) f}) /\ (!f g:A->B. mdist (cfunspace top m) (f,g) = if topspace top = {} then &0 else sup {mdist m (f x,g x) | x IN topspace top})`, REWRITE_TAC[cfunspace; SUBMETRIC; FUNSPACE] THEN SET_TAC[]);; let CFUNSPACE_SUBSET_FUNSPACE = prove (`!top:A topology m:B metric. mspace (cfunspace top m) SUBSET mspace (funspace (topspace top) m)`, SIMP_TAC[SUBSET; FUNSPACE; CFUNSPACE; IN_ELIM_THM]);; let MDIST_CFUNSPACE_EQ_MDIST_FUNSPACE = prove (`!top m f g:A->B. mdist (cfunspace top m) (f,g) = mdist (funspace (topspace top) m) (f,g)`, REWRITE_TAC[FUNSPACE; CFUNSPACE]);; let CFUNSPACE_MDIST_LE = prove (`!top m f g:A->B a. ~(topspace top = {}) /\ f IN mspace (cfunspace top m) /\ g IN mspace (cfunspace top m) ==> (mdist (cfunspace top m) (f,g) <= a <=> !x. x IN topspace top ==> mdist m (f x, g x) <= a)`, INTRO_TAC "! *; ne f g" THEN REWRITE_TAC[MDIST_CFUNSPACE_EQ_MDIST_FUNSPACE] THEN MATCH_MP_TAC FUNSPACE_MDIST_LE THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CFUNSPACE_SUBSET_FUNSPACE]);; let CFUNSPACE_IMP_BOUNDED2 = prove (`!top m f g:A->B. f IN mspace (cfunspace top m) /\ g IN mspace (cfunspace top m) ==> (?b. !x. x IN topspace top ==> mdist m (f x,g x) <= b)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNSPACE_IMP_BOUNDED2 THEN ASM SET_TAC [CFUNSPACE_SUBSET_FUNSPACE]);; let CFUNSPACE_MDIST_LT = prove (`!top m f g:A->B a x. topspace top compact_in top /\ f IN mspace (cfunspace top m) /\ g IN mspace (cfunspace top m) /\ mdist (cfunspace top m) (f, g) < a /\ x IN topspace top ==> mdist m (f x, g x) < a`, REPEAT GEN_TAC THEN ASM_CASES_TAC `topspace (top:A topology) = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN INTRO_TAC "cpt f g lt x" THEN REMOVE_THEN "lt" MP_TAC THEN ASM_REWRITE_TAC[CFUNSPACE] THEN INTRO_TAC "lt" THEN TRANS_TAC REAL_LET_TRANS `sup {mdist m (f x:B,g x) | x:A IN topspace top}` THEN HYP SIMP_TAC "lt" [] THEN MATCH_MP_TAC REAL_LE_SUP THEN HYP (DESTRUCT_TAC "@b. b" o MATCH_MP CFUNSPACE_IMP_BOUNDED2 o CONJ_LIST) "f g" [] THEN MAP_EVERY EXISTS_TAC [`b:real`; `mdist m (f (x:A):B,g x)`] THEN REWRITE_TAC[IN_ELIM_THM; REAL_LE_REFL] THEN HYP MESON_TAC "x b" []);; let MDIST_CFUNSPACE_LE = prove (`!top m B f g. &0 <= B /\ (!x:A. x IN topspace top ==> mdist m (f x:B, g x) <= B) ==> mdist (cfunspace top m) (f,g) <= B`, INTRO_TAC "!top m B f g; Bpos bound" THEN REWRITE_TAC[CFUNSPACE] THEN COND_CASES_TAC THEN HYP REWRITE_TAC "Bpos" [] THEN MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN SET_TAC[]; REWRITE_TAC[IN_ELIM_THM] THEN HYP MESON_TAC "bound" []]);; let MDIST_CFUNSPACE_IMP_MDIST_LE = prove (`!top m f g:A->B a x. f IN mspace (cfunspace top m) /\ g IN mspace (cfunspace top m) /\ mdist (cfunspace top m) (f,g) <= a /\ x IN topspace top ==> mdist m (f x,g x) <= a`, MESON_TAC[MEMBER_NOT_EMPTY; CFUNSPACE_MDIST_LE]);; let COMPACT_IN_MSPACE_CFUNSPACE = prove (`!top m. topspace top compact_in top ==> mspace (cfunspace top m) = {f | (!x:A. x IN topspace top ==> f x:B IN mspace m) /\ f IN EXTENSIONAL (topspace top) /\ topcontinuous top (mtopology m) f}`, REWRITE_TAC[CFUNSPACE; EXTENSION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN INTRO_TAC "wd ext cont" THEN MATCH_MP_TAC COMPACT_IN_IMP_MBOUNDED THEN MATCH_MP_TAC (ISPEC `top:A topology` IMAGE_COMPACT_IN) THEN ASM_REWRITE_TAC[]);; let MCOMPLETE_CFUNSPACE = prove (`!top:A topology m:B metric. mcomplete m ==> mcomplete (cfunspace top m)`, INTRO_TAC "!top m; cpl" THEN REWRITE_TAC[cfunspace] THEN MATCH_MP_TAC SEQUENTIALLY_CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE THEN ASM_SIMP_TAC[MCOMPLETE_FUNSPACE] THEN REWRITE_TAC[IN_ELIM_THM; LIMIT_METRIC_SEQUENTIALLY] THEN INTRO_TAC "![f] [g]; fcont g lim" THEN ASM_CASES_TAC `topspace top = {}:A->bool` THENL [ASM_REWRITE_TAC[topcontinuous; NOT_IN_EMPTY; EMPTY_GSPEC; OPEN_IN_EMPTY]; POP_ASSUM (LABEL_TAC "nempty")] THEN REWRITE_TAC[TOPCONTINUOUS_TO_METRIC; IN_MBALL] THEN INTRO_TAC "!x; x; ![e]; e" THEN CLAIM_TAC "e3pos" `&0 < e / &3` THENL [REMOVE_THEN "e" MP_TAC THEN REAL_ARITH_TAC; USE_THEN "e3pos" (HYP_TAC "lim: @N. N" o C MATCH_MP)] THEN HYP_TAC "N: f lt" (C MATCH_MP (SPEC `N:num` LE_REFL)) THEN HYP_TAC "fcont" (REWRITE_RULE[TOPCONTINUOUS_TO_METRIC]) THEN USE_THEN "x" (HYP_TAC "fcont" o C MATCH_MP) THEN USE_THEN "e3pos" (HYP_TAC "fcont" o C MATCH_MP) THEN HYP_TAC "fcont: @u. u x' inc" (SPEC `N:num`) THEN EXISTS_TAC `u:A->bool` THEN HYP REWRITE_TAC "u x'" [] THEN INTRO_TAC "!y; y'" THEN CLAIM_TAC "uinc" `!x:A. x IN u ==> x IN topspace top` THENL [REMOVE_THEN "u" (MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN HYP_TAC "g -> gwd gext gbd" (REWRITE_RULE[FUNSPACE; IN_ELIM_THM]) THEN HYP_TAC "f -> fwd fext fbd" (REWRITE_RULE[FUNSPACE; IN_ELIM_THM]) THEN CLAIM_TAC "y" `y:A IN topspace top` THENL [HYP SIMP_TAC "uinc y'" [OPEN_IN_SUBSET]; HYP SIMP_TAC "gwd x y" []] THEN CLAIM_TAC "sup" `!x0:A. x0 IN topspace top ==> mdist m (f (N:num) x0:B,g x0) <= e / &3` THENL [INTRO_TAC "!x0; x0" THEN TRANS_TAC REAL_LE_TRANS `sup {mdist m (f (N:num) x,g x:B) | x:A IN topspace top}` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_SUP THEN HYP (DESTRUCT_TAC "@b. b" o MATCH_MP FUNSPACE_IMP_BOUNDED2 o CONJ_LIST) "f g" [] THEN MAP_EVERY EXISTS_TAC [`b:real`; `mdist m (f (N:num) (x0:A), g x0:B)`] THEN REWRITE_TAC[IN_ELIM_THM; REAL_LE_REFL] THEN CONJ_TAC THENL [HYP SET_TAC "x0" []; HYP MESON_TAC "b" []]; REMOVE_THEN "lt" MP_TAC THEN HYP REWRITE_TAC "nempty" [FUNSPACE] THEN MATCH_ACCEPT_TAC REAL_LT_IMP_LE]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `mdist m (g (x:A):B, f (N:num) x) + mdist m (f N x, g y)` THEN HYP SIMP_TAC "gwd fwd x y" [MDIST_TRIANGLE] THEN SUBST1_TAC (ARITH_RULE `e = e / &3 + (e / &3 + e / &3)`) THEN MATCH_MP_TAC REAL_LET_ADD2 THEN HYP SIMP_TAC "gwd fwd x sup" [MDIST_SYM] THEN TRANS_TAC REAL_LET_TRANS `mdist m (f (N:num) (x:A):B, f N y) + mdist m (f N y, g y)` THEN HYP SIMP_TAC "fwd gwd x y" [MDIST_TRIANGLE] THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN HYP SIMP_TAC "gwd fwd y sup" [] THEN REMOVE_THEN "inc" MP_TAC THEN HYP SIMP_TAC "fwd x y' uinc" [IN_MBALL]);; (* ------------------------------------------------------------------------- *) (* The Baire Category theorem for complete metric spaces. *) (* ------------------------------------------------------------------------- *) let METRIC_BAIRE_CATEGORY = prove (`!m:A metric g. mcomplete m /\ COUNTABLE g /\ (!t. t IN g ==> open_in (mtopology m) t /\ mtopology m closure_of t = mspace m) ==> mtopology m closure_of INTERS g = mspace m`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN INTRO_TAC "!m; m" THEN REWRITE_TAC[FORALL_COUNTABLE_AS_IMAGE; NOT_IN_EMPTY; CLOSURE_OF_UNIV; INTERS_0; TOPSPACE_MTOPOLOGY; FORALL_IN_IMAGE; IN_UNIV; FORALL_AND_THM] THEN INTRO_TAC "![u]; u_open u_dense" THEN REWRITE_TAC[GSYM TOPSPACE_MTOPOLOGY] THEN REWRITE_TAC[DENSE_INTERSECTS_OPEN] THEN INTRO_TAC "![w]; w_open w_ne" THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN CLAIM_TAC "@x0. x0" `?x0:A. x0 IN u 0 INTER w` THENL [REWRITE_TAC[MEMBER_NOT_EMPTY] THEN ASM_MESON_TAC[DENSE_INTERSECTS_OPEN; TOPSPACE_MTOPOLOGY]; ALL_TAC] THEN CLAIM_TAC "@r0. r0pos r0lt1 sub" `?r. &0 < r /\ r < &1 /\ mcball m (x0:A,r) SUBSET u 0 INTER w` THENL [SUBGOAL_THEN `open_in (mtopology m) (u 0 INTER w:A->bool)` MP_TAC THENL [HYP SIMP_TAC "u_open w_open" [OPEN_IN_INTER]; ALL_TAC] THEN REWRITE_TAC[OPEN_IN_MTOPOLOGY] THEN INTRO_TAC "u0w hp" THEN REMOVE_THEN "hp" (MP_TAC o SPEC `x0:A`) THEN ANTS_TAC THENL [HYP REWRITE_TAC "x0" []; ALL_TAC] THEN INTRO_TAC "@r. rpos ball" THEN EXISTS_TAC `min r (&1) / &2` THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `mball m (x0:A,r)` THEN HYP REWRITE_TAC "ball" [] THEN MATCH_MP_TAC MCBALL_SUBSET_MBALL_CONCENTRIC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN (DESTRUCT_TAC "@b. b0 b1" o prove_general_recursive_function_exists) `?b:num->(A#real). b 0 = (x0:A,r0) /\ (!n. b (SUC n) = @(x,r). &0 < r /\ r < SND (b n) / &2 /\ x IN mspace m /\ mcball m (x,r) SUBSET mball m (b n) INTER u n)` THEN CLAIM_TAC "rmk" `!n. (\ (x:A,r). &0 < r /\ r < SND (b n) / &2 /\ x IN mspace m /\ mcball m (x,r) SUBSET mball m (b n) INTER u n) (b (SUC n))` THENL [LABEL_INDUCT_TAC THENL [REMOVE_THEN "b1" (fun b1 -> REWRITE_TAC[b1]) THEN MATCH_MP_TAC CHOICE_PAIRED_THM THEN REMOVE_THEN "b0" (fun b0 -> REWRITE_TAC[b0]) THEN MAP_EVERY EXISTS_TAC [`x0:A`; `r0 / &4`] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [CUT_TAC `u 0:A->bool SUBSET mspace m` THENL [HYP SET_TAC "x0" []; HYP SIMP_TAC "u_open" [GSYM TOPSPACE_MTOPOLOGY; OPEN_IN_SUBSET]]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `mball m (x0:A,r0)` THEN CONJ_TAC THENL [MATCH_MP_TAC MCBALL_SUBSET_MBALL_CONCENTRIC THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SUBSET_INTER; SUBSET_REFL] THEN TRANS_TAC SUBSET_TRANS `mcball m (x0:A,r0)` THEN REWRITE_TAC [MBALL_SUBSET_MCBALL] THEN HYP SET_TAC "sub" []]; ALL_TAC] THEN USE_THEN "b1" (fun b1 -> GEN_REWRITE_TAC RAND_CONV [b1]) THEN MATCH_MP_TAC CHOICE_PAIRED_THM THEN REWRITE_TAC[] THEN HYP_TAC "ind_n: rpos rlt x subn" (REWRITE_RULE[LAMBDA_UNPAIR_THM]) THEN USE_THEN "u_dense" (MP_TAC o SPEC `SUC n` o REWRITE_RULE[GSYM TOPSPACE_MTOPOLOGY]) THEN REWRITE_TAC[DENSE_INTERSECTS_OPEN] THEN DISCH_THEN (MP_TAC o SPEC `mball m (b (SUC n):A#real)`) THEN (DESTRUCT_TAC "@x1 r1. bsuc" o MESON[PAIR]) `?x1:A r1:real. b (SUC n) = x1,r1` THEN HYP REWRITE_TAC "bsuc" [] THEN REMOVE_THEN "bsuc" (fun th -> RULE_ASSUM_TAC (REWRITE_RULE[th]) THEN LABEL_TAC "bsuc" th) THEN ANTS_TAC THENL [HYP REWRITE_TAC "x" [OPEN_IN_MBALL; MBALL_EQ_EMPTY; DE_MORGAN_THM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN INTRO_TAC "@z. hp" THEN EXISTS_TAC `z:A` THEN SUBGOAL_THEN `open_in (mtopology m) (mball m (x1:A,r1) INTER u (SUC n))` (DESTRUCT_TAC "hp1 hp2" o REWRITE_RULE[OPEN_IN_MTOPOLOGY_MCBALL]) THENL [HYP SIMP_TAC "u_open" [OPEN_IN_INTER; OPEN_IN_MBALL]; ALL_TAC] THEN CLAIM_TAC "z" `z:A IN mspace m` THENL [CUT_TAC `u (SUC n):A->bool SUBSET mspace m` THENL [HYP SET_TAC "hp" []; HYP SIMP_TAC "u_open" [GSYM TOPSPACE_MTOPOLOGY; OPEN_IN_SUBSET]]; HYP REWRITE_TAC "z" []] THEN REMOVE_THEN "hp2" (MP_TAC o SPEC `z:A`) THEN ANTS_TAC THENL [HYP SET_TAC "hp" []; ALL_TAC] THEN INTRO_TAC "@r. rpos ball" THEN EXISTS_TAC `min r (r1 / &4)` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `mcball m (z:A,r)` THEN HYP SIMP_TAC "ball" [MCBALL_SUBSET_CONCENTRIC; REAL_MIN_MIN]; ALL_TAC] THEN CLAIM_TAC "@x r. b" `?x r. !n:num. b n = x n:A, r n:real` THENL [MAP_EVERY EXISTS_TAC [`FST o (b:num->A#real)`; `SND o (b:num->A#real)`] THEN REWRITE_TAC[o_DEF]; ALL_TAC] THEN REMOVE_THEN "b" (fun b -> RULE_ASSUM_TAC (REWRITE_RULE[b]) THEN LABEL_TAC "b" b) THEN HYP_TAC "b0: x_0 r_0" (REWRITE_RULE[PAIR_EQ]) THEN REMOVE_THEN "x_0" (SUBST_ALL_TAC o GSYM) THEN REMOVE_THEN "r_0" (SUBST_ALL_TAC o GSYM) THEN HYP_TAC "rmk: r1pos r1lt x1 ball" (REWRITE_RULE[FORALL_AND_THM]) THEN CLAIM_TAC "x" `!n:num. x n:A IN mspace m` THENL [LABEL_INDUCT_TAC THENL [CUT_TAC `u 0:A->bool SUBSET mspace m` THENL [HYP SET_TAC "x0" []; HYP SIMP_TAC "u_open" [GSYM TOPSPACE_MTOPOLOGY; OPEN_IN_SUBSET]]; HYP REWRITE_TAC "x1" []]; ALL_TAC] THEN CLAIM_TAC "rpos" `!n:num. &0 < r n` THENL [LABEL_INDUCT_TAC THENL [HYP REWRITE_TAC "r0pos" []; HYP REWRITE_TAC "r1pos" []]; ALL_TAC] THEN CLAIM_TAC "rmono" `!p q:num. p <= q ==> r q <= r p` THENL [MATCH_MP_TAC LE_INDUCT THEN REWRITE_TAC[REAL_LE_REFL] THEN INTRO_TAC "!p q; pq rpq" THEN REMOVE_THEN "r1lt" (MP_TAC o SPEC `q:num`) THEN REMOVE_THEN "rpos" (MP_TAC o SPEC `q:num`) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN CLAIM_TAC "rlt" `!n:num. r n < inv (&2 pow n)` THENL [LABEL_INDUCT_TAC THENL [CONV_TAC (RAND_CONV REAL_RAT_REDUCE_CONV) THEN HYP REWRITE_TAC "r0lt1" []; TRANS_TAC REAL_LTE_TRANS `r (n:num) / &2` THEN HYP REWRITE_TAC "r1lt" [real_pow] THEN REMOVE_THEN "ind_n" MP_TAC THEN REMOVE_THEN "rpos" (MP_TAC o SPEC `n:num`) THEN CONV_TAC REAL_FIELD]; ALL_TAC] THEN CLAIM_TAC "nested" `!p q:num. p <= q ==> mball m (x q:A, r q) SUBSET mball m (x p, r p)` THENL [MATCH_MP_TAC LE_INDUCT THEN REWRITE_TAC[SUBSET_REFL] THEN INTRO_TAC "!p q; pq sub" THEN TRANS_TAC SUBSET_TRANS `mball m (x (q:num):A,r q)` THEN HYP REWRITE_TAC "sub" [] THEN TRANS_TAC SUBSET_TRANS `mcball m (x (SUC q):A,r(SUC q))` THEN REWRITE_TAC[MBALL_SUBSET_MCBALL] THEN HYP SET_TAC "ball" []; ALL_TAC] THEN CLAIM_TAC "in_ball" `!p q:num. p <= q ==> x q:A IN mball m (x p, r p)` THENL [INTRO_TAC "!p q; le" THEN CUT_TAC `x (q:num):A IN mball m (x q, r q)` THENL [HYP SET_TAC "nested le" []; HYP SIMP_TAC "x rpos" [CENTRE_IN_MBALL_EQ]]; ALL_TAC] THEN CLAIM_TAC "@l. l" `?l:A. limit (mtopology m) x l sequentially` THENL [HYP_TAC "m" (REWRITE_RULE[mcomplete]) THEN REMOVE_THEN "m" MATCH_MP_TAC THEN HYP REWRITE_TAC "x" [cauchy_in] THEN INTRO_TAC "!e; epos" THEN CLAIM_TAC "@N. N" `?N. inv(&2 pow N) < e` THENL [REWRITE_TAC[REAL_INV_POW] THEN MATCH_MP_TAC REAL_ARCH_POW_INV THEN HYP REWRITE_TAC "epos" [] THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `N:num` THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [HYP SIMP_TAC "x" [MDIST_SYM] THEN MESON_TAC[]; ALL_TAC] THEN INTRO_TAC "!n n'; le; n n'" THEN TRANS_TAC REAL_LT_TRANS `inv (&2 pow N)` THEN HYP REWRITE_TAC "N" [] THEN TRANS_TAC REAL_LT_TRANS `r (N:num):real` THEN HYP REWRITE_TAC "rlt" [] THEN CUT_TAC `x (n':num):A IN mball m (x n, r n)` THENL [HYP REWRITE_TAC "x" [IN_MBALL] THEN INTRO_TAC "hp" THEN TRANS_TAC REAL_LTE_TRANS `r (n:num):real` THEN HYP SIMP_TAC "n rmono hp" []; HYP SIMP_TAC "in_ball le" []]; ALL_TAC] THEN EXISTS_TAC `l:A` THEN CLAIM_TAC "in_mcball" `!n:num. l:A IN mcball m (x n, r n)` THENL [GEN_TAC THEN (MATCH_MP_TAC o ISPECL [`sequentially`; `mtopology (m:A metric)`]) LIMIT_IN_CLOSED_IN THEN EXISTS_TAC `x:num->A` THEN HYP REWRITE_TAC "l" [TRIVIAL_LIMIT_SEQUENTIALLY; CLOSED_IN_MCBALL] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN INTRO_TAC "![p]; p" THEN CUT_TAC `x (p:num):A IN mball m (x n, r n)` THENL [SET_TAC[MBALL_SUBSET_MCBALL]; HYP SIMP_TAC "in_ball p" []]; ALL_TAC] THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [REWRITE_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN LABEL_INDUCT_TAC THENL [HYP SET_TAC "in_mcball sub " []; HYP SET_TAC "in_mcball ball " []]; HYP SET_TAC "sub in_mcball" []]);; (* ------------------------------------------------------------------------- *) (* Basic definition of the small inductive dimension relation ind t <= n. *) (* We plan to prove most of the theorems in R^n so this is as good a *) (* definition as any other, but the present stuff works in any top space. *) (* ------------------------------------------------------------------------- *) parse_as_infix("dimension_le",(12,"right"));; let DIMENSION_LE_RULES,DIMENSION_LE_INDUCT,DIMENSION_LE_CASES = new_inductive_definition `!top n. -- &1 <= n /\ (!v a. open_in top v /\ a IN v ==> ?u. a IN u /\ u SUBSET v /\ open_in top u /\ subtopology top (top frontier_of u) dimension_le (n - &1)) ==> (top:A topology) dimension_le (n:int)`;; let DIMENSION_LE_BOUND = prove (`!top:(A)topology n. top dimension_le n ==> -- &1 <= n`, MATCH_MP_TAC DIMENSION_LE_INDUCT THEN SIMP_TAC[]);; let DIMENSION_LE_MONO = prove (`!top:(A)topology m n. top dimension_le m /\ m <= n ==> top dimension_le n`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC DIMENSION_LE_INDUCT THEN MAP_EVERY X_GEN_TAC [`top:(A)topology`; `m:int`] THEN STRIP_TAC THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN GEN_REWRITE_TAC I [DIMENSION_LE_CASES] THEN CONJ_TAC THENL [ASM_MESON_TAC[INT_LE_TRANS]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`v:A->bool`; `a:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`v:A->bool`; `a:A`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_INT_ARITH_TAC);; let DIMENSION_LE_EQ_EMPTY = prove (`!top:(A)topology. top dimension_le (-- &1) <=> topspace top = {}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[DIMENSION_LE_CASES] THEN CONV_TAC INT_REDUCE_CONV THEN SUBGOAL_THEN `!top:A topology. ~(top dimension_le --(&2))` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIMENSION_LE_BOUND) THEN INT_ARITH_TAC; EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `topspace top:A->bool`) THEN REWRITE_TAC[OPEN_IN_TOPSPACE] THEN SET_TAC[]; REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN ASM SET_TAC[]]]);; let DIMENSION_LE_SUBTOPOLOGY = prove (`!top n s:A->bool. top dimension_le n ==> (subtopology top s) dimension_le n`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC DIMENSION_LE_INDUCT THEN MAP_EVERY X_GEN_TAC [`top:A topology`; `n:int`] THEN STRIP_TAC THEN X_GEN_TAC `s:A->bool` THEN GEN_REWRITE_TAC I [DIMENSION_LE_CASES] THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`u':A->bool`; `a:A`] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [OPEN_IN_SUBTOPOLOGY] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:A->bool` THEN DISCH_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:A->bool`; `a:A`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:A->bool` THEN STRIP_TAC THEN EXISTS_TAC `s INTER v:A->bool` THEN ASM_REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN ASM_MESON_TAC[INTER_COMM]; FIRST_X_ASSUM(MP_TAC o SPEC `subtopology top s frontier_of (s INTER v):A->bool`) THEN REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET u /\ s SUBSET t ==> t INTER s = u INTER s`) THEN REWRITE_TAC[FRONTIER_OF_SUBSET_SUBTOPOLOGY] THEN REWRITE_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_SUBTOPOLOGY] THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; INTER_ASSOC] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u /\ v SUBSET w ==> s INTER t INTER s INTER v SUBSET u INTER w`) THEN CONJ_TAC THEN MATCH_MP_TAC CLOSURE_OF_MONO THEN SET_TAC[]]);; let DIMENSION_LE_SUBTOPOLOGIES = prove (`!top n s t:A->bool. s SUBSET t /\ subtopology top t dimension_le n ==> (subtopology top s) dimension_le n`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `s:A->bool` o MATCH_MP DIMENSION_LE_SUBTOPOLOGY) THEN REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> t INTER s = s`]);; let DIMENSION_LE_EQ_SUBTOPOLOGY = prove (`!top s:A->bool n. (subtopology top s) dimension_le n <=> -- &1 <= n /\ !v a. open_in top v /\ a IN v /\ a IN s ==> ?u. a IN u /\ u SUBSET v /\ open_in top u /\ subtopology top ((subtopology top s frontier_of (s INTER u))) dimension_le (n - &1)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_CASES] THEN REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY; OPEN_IN_SUBTOPOLOGY] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!v a t. (P t /\ Q v t) /\ R a v t ==> S a v t) <=> (!t a v. Q v t ==> P t /\ R a v t ==> S a v t)`] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `v:A->bool` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[IN_INTER] THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p ==> q <=> p ==> r)`) THEN STRIP_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ (r /\ s) /\ t <=> s /\ p /\ q /\ r /\ t`] THEN ASM_REWRITE_TAC[UNWIND_THM2; IN_INTER] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u INTER v:A->bool` THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_INTER] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[SET_RULE `u SUBSET v ==> u INTER v = u`; SET_RULE `u INTER s SUBSET v INTER s ==> s INTER u INTER v = s INTER u`] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ASM_SIMP_TAC[FRONTIER_OF_SUBSET_SUBTOPOLOGY; SET_RULE `v SUBSET u ==> u INTER v = v`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[]);; hol-light/Multivariate/misc.ml000066400000000000000000002572471303454263000167210ustar00rootroot00000000000000(* ========================================================================= *) (* Various convenient background stuff not specifically to do with R^n. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "Library/card.ml";; needs "Library/floor.ml";; prioritize_real();; (* ------------------------------------------------------------------------- *) (* A couple of extra tactics used in some proofs below. *) (* ------------------------------------------------------------------------- *) let ASSERT_TAC tm = SUBGOAL_THEN tm STRIP_ASSUME_TAC;; let EQ_TRANS_TAC tm = MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC;; (* ------------------------------------------------------------------------- *) (* Miscellaneous lemmas. *) (* ------------------------------------------------------------------------- *) let FORALL_DIFF = prove (`(!s:A->bool. P(UNIV DIFF s)) <=> (!s. P s)`, MESON_TAC[COMPL_COMPL]);; let EXISTS_DIFF = prove (`(?s:A->bool. P(UNIV DIFF s)) <=> (?s. P s)`, MESON_TAC[COMPL_COMPL]);; let GE_REFL = prove (`!n:num. n >= n`, REWRITE_TAC[GE; LE_REFL]);; let FORALL_SUC = prove (`(!n. ~(n = 0) ==> P n) <=> (!n. P(SUC n))`, MESON_TAC[num_CASES; NOT_SUC]);; let SEQ_MONO_LEMMA = prove (`!d e. (!n. n >= m ==> d(n) < e(n)) /\ (!n. n >= m ==> e(n) <= e(m)) ==> !n:num. n >= m ==> d(n) < e(m)`, MESON_TAC[GE; REAL_LTE_TRANS]);; let REAL_HALF = prove (`(!e. &0 < e / &2 <=> &0 < e) /\ (!e. e / &2 + e / &2 = e) /\ (!e. &2 * (e / &2) = e)`, REAL_ARITH_TAC);; let UPPER_BOUND_FINITE_SET = prove (`!f:(A->num) s. FINITE(s) ==> ?a. !x. x IN s ==> f(x) <= a`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN METIS_TAC[LE_CASES; LE_REFL; LE_TRANS]);; let UPPER_BOUND_FINITE_SET_REAL = prove (`!f:(A->real) s. FINITE(s) ==> ?a. !x. x IN s ==> f(x) <= a`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN METIS_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; let LOWER_BOUND_FINITE_SET = prove (`!f:(A->num) s. FINITE(s) ==> ?a. !x. x IN s ==> a <= f(x)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN METIS_TAC[LE_CASES; LE_REFL; LE_TRANS]);; let LOWER_BOUND_FINITE_SET_REAL = prove (`!f:(A->real) s. FINITE(s) ==> ?a. !x. x IN s ==> a <= f(x)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN METIS_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; let REAL_CONVEX_BOUND2_LT = prove (`!x y a u v. x < a /\ y < b /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> u * x + v * y < u * a + v * b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `u = &0` THENL [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN REPEAT STRIP_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE]] THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REAL_ARITH_TAC);; let REAL_CONVEX_BOUND_LT = prove (`!x y a u v. x < a /\ y < a /\ &0 <= u /\ &0 <= v /\ (u + v = &1) ==> u * x + v * y < a`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `u * a + v * a:real` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_CONVEX_BOUND2_LT]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN UNDISCH_TAC `u + v = &1` THEN CONV_TAC REAL_RING]);; let REAL_CONVEX_BOUND_LE = prove (`!x y a u v. x <= a /\ y <= a /\ &0 <= u /\ &0 <= v /\ (u + v = &1) ==> u * x + v * y <= a`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(u + v) * a` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LE_REFL; REAL_MUL_LID]] THEN ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_LE_ADD2; REAL_LE_LMUL]);; let APPROACHABLE_LT_LE = prove (`!P f. (?d. &0 < d /\ !x. f(x) < d ==> P x) = (?d. &0 < d /\ !x. f(x) <= d ==> P x)`, let lemma = prove (`&0 < d ==> x <= d / &2 ==> x < d`, SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REAL_ARITH_TAC) in MESON_TAC[REAL_LT_IMP_LE; lemma; REAL_HALF]);; let REAL_LE_BETWEEN = prove (`!a b. a <= b <=> ?x. a <= x /\ x <= b`, MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; let REAL_LET_BETWEEN = prove (`!a b. a < b <=> (?x. a <= x /\ x < b)`, MESON_TAC[REAL_LE_REFL; REAL_LET_TRANS]);; let REAL_LTE_BETWEEN = prove (`!a b. a < b <=> (?x. a < x /\ x <= b)`, MESON_TAC[REAL_LE_REFL; REAL_LTE_TRANS]);; let REAL_LT_BETWEEN = prove (`!a b. a < b <=> ?x. a < x /\ x < b`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_TRANS]] THEN DISCH_TAC THEN EXISTS_TAC `(a + b) / &2` THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let REAL_LT_BETWEEN_GEN = prove (`!s t:real->bool. FINITE s /\ FINITE t ==> ((?x. (!a. a IN s ==> a < x) /\ (!b. b IN t ==> x < b)) <=> !a b. a IN s /\ b IN t ==> a < b)`, REPEAT GEN_TAC THEN SIMP_TAC[MESON[REAL_SUP_LT_FINITE; NOT_IN_EMPTY] `FINITE s ==> ((!a. a IN s ==> a < x) <=> s = {} \/ sup s < x)`] THEN SIMP_TAC[MESON[REAL_LT_INF_FINITE; NOT_IN_EMPTY] `FINITE t ==> ((!b. b IN t ==> x < b) <=> t = {} \/ x < inf t)`] THEN STRIP_TAC THEN ASM_CASES_TAC `s:real->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [MESON_TAC[REAL_ARITH `s - &1 < s`]; ALL_TAC] THEN ASM_CASES_TAC `t:real->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [MESON_TAC[REAL_ARITH `t < t + &1`]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_LT_BETWEEN] THEN ASM_SIMP_TAC[REAL_SUP_LT_FINITE; REAL_LT_INF_FINITE] THEN MESON_TAC[]);; let TRIANGLE_LEMMA = prove (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z /\ x pow 2 <= y pow 2 + z pow 2 ==> x <= y + z`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(y + z) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT2; REAL_LE_ADD; ARITH_EQ] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_2; REAL_ARITH `x * x + y * y <= (x + y) * (x + y) <=> &0 <= x * y`]);; let LAMBDA_SKOLEM = prove (`(!i. 1 <= i /\ i <= dimindex(:N) ==> ?x. P i x) = (?x:A^N. !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i))`, REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `x:num->A`) THEN EXISTS_TAC `(lambda i. x i):A^N` THEN ASM_SIMP_TAC[LAMBDA_BETA]; DISCH_THEN(X_CHOOSE_TAC `x:A^N`) THEN EXISTS_TAC `\i. (x:A^N)$i` THEN ASM_REWRITE_TAC[]]);; let LAMBDA_PAIR = prove (`(\(x,y). P x y) = (\p. P (FST p) (SND p))`, REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[]);; let EPSILON_DELTA_MINIMAL = prove (`!P:real->A->bool Q. FINITE {x | Q x} /\ (!d e x. Q x /\ &0 < e /\ e < d ==> P d x ==> P e x) /\ (!x. Q x ==> ?d. &0 < d /\ P d x) ==> ?d. &0 < d /\ !x. Q x ==> P d x`, REWRITE_TAC[IMP_IMP] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `{x:A | Q x} = {}` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM] THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_EXISTS_THM]) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:A->real` THEN DISCH_TAC THEN EXISTS_TAC `inf(IMAGE d {x:A | Q x})` THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN X_GEN_TAC `a:A` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < inf(IMAGE d {x:A | Q x}) /\ inf(IMAGE d {x | Q x}) <= d a` MP_TAC THENL [ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]; REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(d:A->real) a` THEN ASM_SIMP_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* A generic notion of "hull" (convex, affine, conic hull and closure). *) (* ------------------------------------------------------------------------- *) parse_as_infix("hull",(21,"left"));; let hull = new_definition `P hull s = INTERS {t | P t /\ s SUBSET t}`;; let HULL_P = prove (`!P s. P s ==> (P hull s = s)`, REWRITE_TAC[hull; EXTENSION; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[SUBSET]);; let P_HULL = prove (`!P s. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) ==> P(P hull s)`, REWRITE_TAC[hull] THEN SIMP_TAC[IN_ELIM_THM]);; let HULL_EQ = prove (`!P s. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) ==> ((P hull s = s) <=> P s)`, MESON_TAC[P_HULL; HULL_P]);; let HULL_HULL = prove (`!P s. P hull (P hull s) = P hull s`, REWRITE_TAC[hull; EXTENSION; IN_INTERS; IN_ELIM_THM; SUBSET] THEN MESON_TAC[]);; let HULL_SUBSET = prove (`!P s. s SUBSET (P hull s)`, REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; let HULL_MONO = prove (`!P s t. s SUBSET t ==> (P hull s) SUBSET (P hull t)`, REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; let HULL_ANTIMONO = prove (`!P Q s. P SUBSET Q ==> (Q hull s) SUBSET (P hull s)`, REWRITE_TAC[SUBSET; hull; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[IN]);; let HULL_UNIV = prove (`!P:(A->bool)->bool. P hull UNIV = UNIV`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIV; HULL_SUBSET]);; let HULL_MINIMAL = prove (`!P s t. s SUBSET t /\ P t ==> (P hull s) SUBSET t`, REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; let SUBSET_HULL = prove (`!P s t. P t ==> ((P hull s) SUBSET t <=> s SUBSET t)`, REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; let HULL_UNIQUE = prove (`!P s t. s SUBSET t /\ P t /\ (!t'. s SUBSET t' /\ P t' ==> t SUBSET t') ==> (P hull s = t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET_HULL; SUBSET]);; let HULL_UNION_SUBSET = prove (`!P s t. (P hull s) UNION (P hull t) SUBSET (P hull (s UNION t))`, SIMP_TAC[UNION_SUBSET; HULL_MONO; SUBSET_UNION]);; let HULL_UNION = prove (`!P s t. P hull (s UNION t) = P hull (P hull s UNION P hull t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[hull] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; UNION_SUBSET] THEN MESON_TAC[SUBSET_HULL]);; let HULL_UNION_LEFT = prove (`!P s t:A->bool. P hull (s UNION t) = P hull (P hull s UNION t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[hull] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; UNION_SUBSET] THEN MESON_TAC[SUBSET_HULL]);; let HULL_UNION_RIGHT = prove (`!P s t:A->bool. P hull (s UNION t) = P hull (s UNION P hull t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[hull] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; UNION_SUBSET] THEN MESON_TAC[SUBSET_HULL]);; let HULL_INSERT = prove (`!P a s. P hull (a INSERT s) = P hull (a INSERT P hull s)`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN ONCE_REWRITE_TAC[HULL_UNION] THEN REWRITE_TAC[HULL_HULL]);; let HULL_REDUNDANT_EQ = prove (`!P a s. a IN (P hull s) <=> (P hull (a INSERT s) = P hull s)`, REWRITE_TAC[hull] THEN SET_TAC[]);; let HULL_REDUNDANT = prove (`!P a s. a IN (P hull s) ==> (P hull (a INSERT s) = P hull s)`, REWRITE_TAC[HULL_REDUNDANT_EQ]);; let HULL_INDUCT = prove (`!P p s. (!x:A. x IN s ==> p x) /\ P {x | p x} ==> !x. x IN P hull s ==> p x`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`P:(A->bool)->bool`; `s:A->bool`; `{x:A | p x}`] HULL_MINIMAL) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM]);; let HULL_INC = prove (`!P s x. x IN s ==> x IN P hull s`, MESON_TAC[REWRITE_RULE[SUBSET] HULL_SUBSET]);; let HULL_IMAGE_SUBSET = prove (`!P f s. P(P hull s) /\ (!s. P s ==> P(IMAGE f s)) ==> P hull (IMAGE f s) SUBSET (IMAGE f (P hull s))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[IMAGE_SUBSET; HULL_SUBSET]);; let HULL_IMAGE_GALOIS = prove (`!P f g s. (!s. P(P hull s)) /\ (!s. P s ==> P(IMAGE f s)) /\ (!s. P s ==> P(IMAGE g s)) /\ (!s t. s SUBSET IMAGE g t <=> IMAGE f s SUBSET t) ==> P hull (IMAGE f s) = IMAGE f (P hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[HULL_IMAGE_SUBSET] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[HULL_SUBSET]);; let HULL_IMAGE = prove (`!P f s. (!s. P(P hull s)) /\ (!s. P(IMAGE f s) <=> P s) /\ (!x y:A. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> P hull (IMAGE f s) = IMAGE f (P hull s)`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[BIJECTIVE_LEFT_RIGHT_INVERSE] THEN DISCH_THEN(X_CHOOSE_THEN `g:A->A` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC HULL_IMAGE_GALOIS THEN EXISTS_TAC `g:A->A` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN X_GEN_TAC `s:A->bool` THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let IS_HULL = prove (`!P s. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) ==> (P s <=> ?t. s = P hull t)`, MESON_TAC[HULL_P; P_HULL]);; let HULLS_EQ = prove (`!P s t. (!f. (!s. s IN f ==> P s) ==> P (INTERS f)) /\ s SUBSET P hull t /\ t SUBSET P hull s ==> P hull s = P hull t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[P_HULL]);; let HULL_P_AND_Q = prove (`!P Q. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) /\ (!f. (!s. s IN f ==> Q s) ==> Q(INTERS f)) /\ (!s. Q s ==> Q(P hull s)) ==> (\x. P x /\ Q x) hull s = P hull (Q hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN ASM_SIMP_TAC[HULL_INC; SUBSET_HULL] THEN ASM_MESON_TAC[P_HULL; HULL_SUBSET; SUBSET_TRANS]);; let HULL_UNIONS_SUBSET = prove (`!P f. UNIONS {P hull s | s IN f} SUBSET P hull (UNIONS f)`, REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]);; let HULL_INTERS_SUBSET = prove (`!P f. P hull (INTERS f) SUBSET INTERS {P hull s | s IN f}`, REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]);; let HULL_INTER_SUBSET = prove (`!P s t. P hull (s INTER t) SUBSET (P hull s) INTER (P hull t)`, REWRITE_TAC[hull; INTERS_GSPEC] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* More variants of the Archimedian property and useful consequences. *) (* ------------------------------------------------------------------------- *) let REAL_ARCH_INV = prove (`!e. &0 < e <=> ?n. ~(n = 0) /\ &0 < inv(&n) /\ inv(&n) < e`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_TRANS]] THEN DISCH_TAC THEN MP_TAC(SPEC `inv(e)` REAL_ARCH_LT) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[REAL_LT_INV2; REAL_INV_INV; REAL_LT_INV_EQ; REAL_LT_TRANS; REAL_LT_ANTISYM]);; let REAL_POW_LBOUND = prove (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; let REAL_ARCH_POW = prove (`!x y. &1 < x ==> ?n. y < x pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 + &n * (x - &1)` THEN ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH `&1 < x ==> &0 <= x - &1`]);; let REAL_ARCH_POW2 = prove (`!x. ?n. x < &2 pow n`, SIMP_TAC[REAL_ARCH_POW; REAL_OF_NUM_LT; ARITH]);; let REAL_ARCH_POW_INV = prove (`!x y. &0 < y /\ x < &1 ==> ?n. x pow n < y`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < x` THENL [ALL_TAC; ASM_MESON_TAC[REAL_POW_1; REAL_LET_TRANS; REAL_NOT_LT]] THEN SUBGOAL_THEN `inv(&1) < inv(x)` MP_TAC THENL [ASM_SIMP_TAC[REAL_LT_INV2]; REWRITE_TAC[REAL_INV_1]] THEN DISCH_THEN(MP_TAC o SPEC `inv(y)` o MATCH_MP REAL_ARCH_POW) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN ASM_SIMP_TAC[GSYM REAL_POW_INV; REAL_LT_INV; REAL_LT_INV2]);; let FORALL_POS_MONO = prove (`!P. (!d e. d < e /\ P d ==> P e) /\ (!n. ~(n = 0) ==> P(inv(&n))) ==> !e. &0 < e ==> P e`, MESON_TAC[REAL_ARCH_INV; REAL_LT_TRANS]);; let FORALL_POS_MONO_1 = prove (`!P. (!d e. d < e /\ P d ==> P e) /\ (!n. P(inv(&n + &1))) ==> !e. &0 < e ==> P e`, REWRITE_TAC[REAL_OF_NUM_SUC; GSYM FORALL_SUC; FORALL_POS_MONO]);; let FORALL_POS_MONO_EQ = prove (`!P. (!d e. d < e /\ P d ==> P e) ==> ((!e. &0 < e ==> P e) <=> (!n. ~(n = 0) ==> P(inv(&n))))`, MESON_TAC[REAL_ARCH_INV; REAL_LT_INV_EQ; REAL_LT_TRANS; LE_1; REAL_OF_NUM_LT]);; let FORALL_POS_MONO_1_EQ = prove (`!P. (!d e. d < e /\ P d ==> P e) ==> ((!e. &0 < e ==> P e) <=> (!n. P(inv(&n + &1))))`, GEN_TAC THEN DISCH_THEN(SUBST1_TAC o MATCH_MP FORALL_POS_MONO_EQ) THEN REWRITE_TAC[REAL_OF_NUM_SUC; GSYM FORALL_SUC]);; let REAL_ARCH_RDIV_EQ_0 = prove (`!x c. &0 <= x /\ &0 <= c /\ (!m. 0 < m ==> &m * x <= c) ==> x = &0`, SIMP_TAC [GSYM REAL_LE_ANTISYM; GSYM REAL_NOT_LT] THEN REPEAT STRIP_TAC THEN POP_ASSUM (STRIP_ASSUME_TAC o SPEC `c:real` o MATCH_MP REAL_ARCH) THEN ASM_CASES_TAC `n=0` THENL [POP_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC (REWRITE_RULE [REAL_MUL_LZERO]) THEN ASM_MESON_TAC [REAL_LET_ANTISYM]; ASM_MESON_TAC [REAL_LET_ANTISYM; REAL_MUL_SYM; LT_NZ]]);; (* ------------------------------------------------------------------------- *) (* Relate max and min to sup and inf. *) (* ------------------------------------------------------------------------- *) let REAL_MAX_SUP = prove (`!x y. max x y = sup {x,y}`, SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_SUP_LE_FINITE; REAL_LE_SUP_FINITE; FINITE_RULES; NOT_INSERT_EMPTY; REAL_MAX_LE; REAL_LE_MAX] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LE_TOTAL]);; let REAL_MIN_INF = prove (`!x y. min x y = inf {x,y}`, SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_INF_LE_FINITE; REAL_LE_INF_FINITE; FINITE_RULES; NOT_INSERT_EMPTY; REAL_MIN_LE; REAL_LE_MIN] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LE_TOTAL]);; (* ------------------------------------------------------------------------- *) (* Define square root here to decouple it from the existing analysis theory. *) (* We totalize by making sqrt(-x) = -sqrt(x), which looks rather unnatural *) (* but allows many convenient properties to be used without sideconditions. *) (* ------------------------------------------------------------------------- *) let sqrt = new_definition `sqrt(x) = @y. real_sgn y = real_sgn x /\ y pow 2 = abs x`;; let SQRT_UNIQUE = prove (`!x y. &0 <= y /\ y pow 2 = x ==> sqrt(x) = y`, REPEAT STRIP_TAC THEN REWRITE_TAC[sqrt] THEN MATCH_MP_TAC SELECT_UNIQUE THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_SGN_POW_2; REAL_ABS_POW] THEN X_GEN_TAC `z:real` THEN ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[REAL_RING `x pow 2 = y pow 2 <=> x:real = y \/ x = --y`] THEN REWRITE_TAC[real_sgn] THEN ASM_REAL_ARITH_TAC);; let POW_2_SQRT = prove (`!x. &0 <= x ==> sqrt(x pow 2) = x`, MESON_TAC[SQRT_UNIQUE]);; let SQRT_0 = prove (`sqrt(&0) = &0`, MESON_TAC[SQRT_UNIQUE; REAL_POW_2; REAL_MUL_LZERO; REAL_POS]);; let SQRT_1 = prove (`sqrt(&1) = &1`, MESON_TAC[SQRT_UNIQUE; REAL_POW_2; REAL_MUL_LID; REAL_POS]);; let POW_2_SQRT_ABS = prove (`!x. sqrt(x pow 2) = abs(x)`, GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE THEN REWRITE_TAC[REAL_ABS_POS; REAL_POW_2; GSYM REAL_ABS_MUL] THEN REWRITE_TAC[real_abs; REAL_LE_SQUARE]);; (* ------------------------------------------------------------------------- *) (* A slightly sharper indexing lemma. *) (* ------------------------------------------------------------------------- *) let FINITE_INDEX_NUMSEG_SPECIAL = prove (`!s a:A. FINITE s /\ a IN s ==> ?f. (!i j. i IN 1..CARD s /\ j IN 1..CARD s /\ f i = f j ==> i = j) /\ s = IMAGE f (1..CARD s) /\ f 1 = a`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?k. k IN 1..CARD(s:A->bool) /\ (a:A) = f k` STRIP_ASSUME_TAC THENL[ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `(f:num->A) o (\j. if j = 1 then k else if j = k then 1 else j)` THEN SUBGOAL_THEN `1 IN 1..CARD(s:A->bool)` ASSUME_TAC THENL [REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN ASM_SIMP_TAC[CARD_EQ_0; ARITH_EQ] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_THEN `s = IMAGE (f:num->A) (1..CARD(s:A->bool))` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; o_THM] THEN X_GEN_TAC `b:A` THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `if i = 1 then k else if i = k then 1 else i` THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Geometric progression. *) (* ------------------------------------------------------------------------- *) let SUM_GP_BASIC = prove (`!x n. (&1 - x) * sum(0..n) (\i. x pow i) = &1 - x pow (SUC n)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[real_pow; REAL_MUL_RID; LE_0] THEN ASM_REWRITE_TAC[REAL_ADD_LDISTRIB; real_pow] THEN REAL_ARITH_TAC);; let SUM_GP_MULTIPLIED = prove (`!x m n. m <= n ==> ((&1 - x) * sum(m..n) (\i. x pow i) = x pow m - x pow (SUC n))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC [SUM_OFFSET_0; REAL_POW_ADD; REAL_MUL_ASSOC; SUM_GP_BASIC; SUM_RMUL] THEN REWRITE_TAC[REAL_SUB_RDISTRIB; GSYM REAL_POW_ADD; REAL_MUL_LID] THEN ASM_SIMP_TAC[ARITH_RULE `m <= n ==> (SUC(n - m) + m = SUC n)`]);; let SUM_GP = prove (`!x m n. sum(m..n) (\i. x pow i) = if n < m then &0 else if x = &1 then &((n + 1) - m) else (x pow m - x pow (SUC n)) / (&1 - x)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n < m \/ ~(n < m) /\ m <= n:num`) THEN ASM_SIMP_TAC[SUM_TRIV_NUMSEG] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[REAL_POW_ONE; SUM_CONST_NUMSEG; REAL_MUL_RID]; ALL_TAC] THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&1 - x` THEN ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_SUB_0; SUM_GP_MULTIPLIED]);; let SUM_GP_OFFSET = prove (`!x m n. sum(m..m+n) (\i. x pow i) = if x = &1 then &n + &1 else x pow m * (&1 - x pow (SUC n)) / (&1 - x)`, REPEAT GEN_TAC THEN REWRITE_TAC[SUM_GP; ARITH_RULE `~(m + n < m:num)`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[REAL_OF_NUM_ADD] THEN AP_TERM_TAC THEN ARITH_TAC; REWRITE_TAC[real_div; real_pow; REAL_POW_ADD] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Segment of natural numbers starting at a specific number. *) (* ------------------------------------------------------------------------- *) let from = new_definition `from n = {m:num | n <= m}`;; let FROM_0 = prove (`from 0 = (:num)`, REWRITE_TAC[from; LE_0] THEN SET_TAC[]);; let IN_FROM = prove (`!m n. m IN from n <=> n <= m`, REWRITE_TAC[from; IN_ELIM_THM]);; let FROM_INTER_NUMSEG_GEN = prove (`!k m n. (from k) INTER (m..n) = (if m < k then k..n else m..n)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[from; IN_ELIM_THM; IN_INTER; IN_NUMSEG; EXTENSION] THEN ARITH_TAC);; let FROM_INTER_NUMSEG_MAX = prove (`!m n p. from p INTER (m..n) = (MAX p m..n)`, REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; IN_FROM] THEN ARITH_TAC);; let FROM_INTER_NUMSEG = prove (`!k n. (from k) INTER (0..n) = k..n`, REWRITE_TAC[from; IN_ELIM_THM; IN_INTER; IN_NUMSEG; EXTENSION] THEN ARITH_TAC);; let INFINITE_FROM = prove (`!n. INFINITE(from n)`, GEN_TAC THEN SUBGOAL_THEN `from n = (:num) DIFF {i | i < n}` (fun th -> SIMP_TAC[th; INFINITE_DIFF_FINITE; FINITE_NUMSEG_LT; num_INFINITE]) THEN REWRITE_TAC[EXTENSION; from; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN ARITH_TAC);; let FINITE_INTER_NUMSEG = prove (`!s m n. FINITE(s INTER (m..n))`, MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG; INTER_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Make a Horner-style evaluation of sum(m..n) (\k. a(k) * x pow k). *) (* ------------------------------------------------------------------------- *) let HORNER_SUM_CONV = let horner_0,horner_s = (CONJ_PAIR o prove) (`(sum(0..0) (\i. c(i) * x pow i) = c 0) /\ (sum(0..SUC n) (\i. c(i) * x pow i) = c(0) + x * sum(0..n) (\i. c(i+1) * x pow i))`, REWRITE_TAC[CONJUNCT1 SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `x * c * y:real = c * x * y`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow); ADD1] THEN REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; real_pow; REAL_MUL_RID]) in let conv_0 = GEN_REWRITE_CONV I [horner_0] THENC NUM_REDUCE_CONV and conv_s = LAND_CONV(RAND_CONV(num_CONV)) THENC GEN_REWRITE_CONV I [horner_s] THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [LEFT_ADD_DISTRIB] THENC GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM ADD_ASSOC] THENC NUM_REDUCE_CONV in let rec conv tm = try (conv_0 THENC REAL_RAT_REDUCE_CONV) tm with Failure _ -> (conv_s THENC RAND_CONV(RAND_CONV conv) THENC REAL_RAT_REDUCE_CONV) tm in conv;; (* ------------------------------------------------------------------------- *) (* Some general lemmas about subsequences. *) (* ------------------------------------------------------------------------- *) let SUBSEQUENCE_IMP_INJECTIVE = prove (`!r:num->num. (!m n. m < n ==> r m < r n) ==> (!m n. r m = r n <=> m = n)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LT THEN ASM_MESON_TAC[LT_REFL]);; let MONOTONE_BIGGER = prove (`!r. (!m n. m < n ==> r(m) < r(n)) ==> !n:num. n <= r(n)`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LE_0; ARITH_RULE `n <= m /\ m < p ==> SUC n <= p`; LT]);; let INFINITE_ENUMERATE_WEAK = prove (`!s:num->bool. INFINITE s ==> ?r:num->num. (!m n. m < n ==> r(m) < r(n)) /\ (!n. r n IN s)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; let INFINITE_ENUMERATE_EQ_ALT = prove (`!s:num->bool. INFINITE s <=> ?r. (!m n:num. m < n ==> r m < r n) /\ (!n. r n IN s)`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[INFINITE_ENUMERATE_WEAK] THEN STRIP_TAC THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `IMAGE (r:num->num) (:num)` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN MATCH_MP_TAC INFINITE_IMAGE THEN REWRITE_TAC[num_INFINITE; IN_UNIV] THEN ASM_MESON_TAC[SUBSEQUENCE_IMP_INJECTIVE]);; let MONOTONE_SUBSEQUENCE = prove (`!s:num->real. ?r:num->num. (!m n. m < n ==> r(m) < r(n)) /\ ((!m n. m <= n ==> s(r(m)) <= s(r(n))) \/ (!m n. m <= n ==> s(r(n)) <= s(r(m))))`, GEN_TAC THEN ASM_CASES_TAC `!n:num. ?p. n < p /\ !m. p <= m ==> s(m) <= s(p)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; NOT_IMP; DE_MORGAN_THM] THEN REWRITE_TAC[RIGHT_OR_EXISTS_THM; SKOLEM_THM; REAL_NOT_LE; REAL_NOT_LT] THENL [ABBREV_TAC `N = 0`; DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC)] THEN DISCH_THEN(X_CHOOSE_THEN `next:num->num` STRIP_ASSUME_TAC) THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `(r 0 = next(SUC N)) /\ (!n. r(SUC n) = next(r n))` THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THENL [SUBGOAL_THEN `!m:num n:num. r n <= m ==> s(m) <= s(r n):real` ASSUME_TAC THEN TRY CONJ_TAC THEN TRY DISJ2_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL; LT_IMP_LE; LT_TRANS]; SUBGOAL_THEN `!n. N < (r:num->num) n` ASSUME_TAC THEN TRY(CONJ_TAC THENL [GEN_TAC; DISJ1_TAC THEN GEN_TAC]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN TRY STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_REFL; LT_LE; LTE_TRANS; REAL_LE_REFL; REAL_LT_LE; REAL_LE_TRANS; LT]]);; let CONVERGENT_BOUNDED_INCREASING = prove (`!s:num->real b. (!m n. m <= n ==> s m <= s n) /\ (!n. abs(s n) <= b) ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. ?n. (s:num->real) n = x` REAL_COMPLETE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ARITH `abs(x) <= b ==> x <= b`]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `l - e`) THEN ASM_MESON_TAC[REAL_ARITH `&0 < e ==> ~(l <= l - e)`; REAL_ARITH `x <= y /\ y <= l /\ ~(x <= l - e) ==> abs(y - l) < e`]);; let CONVERGENT_BOUNDED_MONOTONE = prove (`!s:num->real b. (!n. abs(s n) <= b) /\ ((!m n. m <= n ==> s m <= s n) \/ (!m n. m <= n ==> s n <= s m)) ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CONVERGENT_BOUNDED_INCREASING]; ALL_TAC] THEN MP_TAC(SPEC `\n. --((s:num->real) n)` CONVERGENT_BOUNDED_INCREASING) THEN ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_ABS_NEG] THEN ASM_MESON_TAC[REAL_ARITH `abs(x - --l) = abs(--x - l)`]);; (* ------------------------------------------------------------------------- *) (* A characterization of monotonicity. *) (* ------------------------------------------------------------------------- *) let REAL_NON_MONOTONE = prove (`!P f:real->real. (!x y. P x /\ P y /\ x <= y ==> f x <= f y) \/ (!x y. P x /\ P y /\ x <= y ==> f y <= f x) <=> ~(?x y z. P x /\ P y /\ P z /\ x < y /\ y < z /\ (f x < f y /\ f z < f y \/ f y < f x /\ f y < f z))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE; REAL_LET_ANTISYM]; ALL_TAC] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP; DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; REAL_NOT_LE; MESON[REAL_LT_LE] `(x <= y /\ (f:real->real) y < f x <=> x < y /\ f y < f x) /\ (x <= y /\ f x < f y <=> x < y /\ f x < f y)`] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`w:real`; `z:real`] THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `u:real = w \/ u < w \/ w < u`) THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(MESON[] `P w v z \/ P w z v ==> ?x y z. P x y z`); MATCH_MP_TAC(MESON[] `P u v \/ P u w \/ P u z ==> ?x y. P x y`) THEN ASM_REWRITE_TAC[OR_EXISTS_THM; REAL_LT_REFL] THEN MATCH_MP_TAC(MESON[] `P(v:real) \/ P z ==> ?x. P x`); MATCH_MP_TAC(MESON[] `P w u \/ P w v \/ P w z ==> ?x y. P x y`) THEN ASM_REWRITE_TAC[OR_EXISTS_THM; REAL_LT_REFL] THEN MATCH_MP_TAC(MESON[] `P(v:real) \/ P z ==> ?x. P x`)] THEN ASM_SIMP_TAC[REAL_LT_REFL; REAL_ARITH `a < b ==> ~(b < a)`] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN CONV_TAC NNFC_CONV THEN CONV_TAC CNF_CONV THEN REPEAT CONJ_TAC THEN TRY REAL_ARITH_TAC THEN ASM_CASES_TAC `u:real = w` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN ASM_CASES_TAC `u:real = z` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN ASM_CASES_TAC `v:real = w` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN ASM_CASES_TAC `v:real = z` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Countability of some relevant sets. *) (* ------------------------------------------------------------------------- *) let COUNTABLE_INTEGER = prove (`COUNTABLE integer`, MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\n. (&n:real)) (:num) UNION IMAGE (\n. --(&n)) (:num)` THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_UNION; NUM_COUNTABLE] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[IN; INTEGER_CASES]);; let CARD_EQ_INTEGER = prove (`integer =_c (:num)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_INTEGER] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN REWRITE_TAC[IN; INTEGER_CLOSED]);; let COUNTABLE_RATIONAL = prove (`COUNTABLE rational`, MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\(x,y). x / y) (integer CROSS integer)` THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; COUNTABLE_INTEGER] THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS] THEN REWRITE_TAC[rational; IN] THEN MESON_TAC[]);; let CARD_EQ_RATIONAL = prove (`rational =_c (:num)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_RATIONAL] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN REWRITE_TAC[IN; RATIONAL_CLOSED]);; let COUNTABLE_INTEGER_COORDINATES = prove (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }`, MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_INTEGER]);; let COUNTABLE_RATIONAL_COORDINATES = prove (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`, MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_RATIONAL]);; (* ------------------------------------------------------------------------- *) (* Natural "irrational" variants of rational approximations. *) (* ------------------------------------------------------------------------- *) let IRRATIONAL_APPROXIMATION = prove (`!x e. &0 < e ==> ?y. ~(rational y) /\ abs(y - x) < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?z. ~rational z` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s = (:real)) ==> ?z. ~s z`) THEN MESON_TAC[COUNTABLE_RATIONAL; UNCOUNTABLE_REAL]; MP_TAC(ISPECL [`z + x:real`; `e:real`] RATIONAL_APPROXIMATION) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:real` THEN STRIP_TAC THEN EXISTS_TAC `q - z:real` THEN ASM_REWRITE_TAC[REAL_ARITH `q - z - x:real = q - (z + x)`] THEN DISCH_TAC THEN UNDISCH_TAC `~rational z` THEN REWRITE_TAC[] THEN ASM_MESON_TAC[RATIONAL_CLOSED; REAL_ARITH `z:real = q - (q - z)`]]);; let IRRATIONAL_BETWEEN = prove (`!a b. a < b ==> ?q. ~rational q /\ a < q /\ q < b`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`(a + b) / &2`; `(b - a) / &4`] IRRATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]] THEN ASM_REAL_ARITH_TAC);; let IRRATIONAL_BETWEEN_EQ = prove (`!a b. (?q. ~rational q /\ a < q /\ q < b) <=> a < b`, MESON_TAC[IRRATIONAL_BETWEEN; REAL_LT_TRANS]);; let IRRATIONAL_APPROXIMATION_STRADDLE = prove (`!x e. &0 < e ==> ?a b. ~rational a /\ ~rational b /\ a < x /\ x < b /\ abs(b - a) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`x - e / &4`; `e / &4`] IRRATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC] THEN MP_TAC(ISPECL [`x + e / &4`; `e / &4`] IRRATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let IRRATIONAL_APPROXIMATION_ABOVE = prove (`!x e. &0 < e ==> ?q. ~rational q /\ x < q /\ q < x + e`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `e:real`] IRRATIONAL_APPROXIMATION_STRADDLE) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let IRRATIONAL_APPROXIMATION_BELOW = prove (`!x e. &0 < e ==> ?q. ~rational q /\ x - e < q /\ q < x`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real`; `e:real`] IRRATIONAL_APPROXIMATION_STRADDLE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let INFINITE_IRRATIONAL_IN_RANGE = prove (`!a b. a < b ==> INFINITE {q | ~rational q /\ a < q /\ q < b}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?q. (!n. ~rational(q n) /\ a < q n /\ q n < b) /\ (!n. q(SUC n) < q n)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[GSYM CONJ_ASSOC; GSYM REAL_LT_MIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC IRRATIONAL_BETWEEN THEN ASM_REWRITE_TAC[REAL_LT_MIN]; MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `IMAGE (q:num->real) (:num)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC INFINITE_IMAGE THEN REWRITE_TAC[num_INFINITE; IN_UNIV] THEN SUBGOAL_THEN `!m n. m < n ==> (q:num->real) n < q m` (fun th -> MESON_TAC[LT_CASES; th; REAL_LT_REFL]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_MESON_TAC[REAL_LT_TRANS]]);; (* ------------------------------------------------------------------------- *) (* Countability of extrema for arbitrary function R->R. *) (* ------------------------------------------------------------------------- *) let COUNTABLE_LOCAL_MAXIMA = prove (`!f:real->real. COUNTABLE {f x |x| ?d. &0 < d /\ !x'. abs(x' - x) < d ==> f(x') <= f(x)}`, GEN_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\(a,b). sup {f x | a <= x /\ x <= b}) ((rational CROSS rational) INTER {(a,b) | ?x. a < x /\ x < b /\ !x'. a <= x' /\ x' <= b ==> f x' <= f x})` THEN SIMP_TAC[COUNTABLE_INTER; COUNTABLE_CROSS; COUNTABLE_RATIONAL; COUNTABLE_IMAGE; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_IMAGE; IN_INTER; EXISTS_PAIR_THM] THEN MP_TAC(ISPECL [`x:real`; `d:real`] RATIONAL_APPROXIMATION_STRADDLE) THEN ASM_REWRITE_TAC[IN_CROSS; IN_ELIM_PAIR_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN] THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC]; ALL_TAC] THEN REPEAT STRIP_TAC THEN TRY(EXISTS_TAC `x:real`) THEN REPEAT STRIP_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REAL_ARITH_TAC);; let COUNTABLE_LOCAL_MINIMA = prove (`!f:real->real. COUNTABLE {f x |x| ?d. &0 < d /\ !x'. abs(x' - x) < d ==> f(x) <= f(x')}`, GEN_TAC THEN MP_TAC(SPEC `(--) o (f:real->real)` COUNTABLE_LOCAL_MAXIMA) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[ETA_AX; IMAGE_o] THEN REWRITE_TAC[o_THM; REAL_LE_NEG2] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC COUNTABLE_IMAGE_INJ_EQ THEN SIMP_TAC[REAL_EQ_NEG2]);; let COUNTABLE_STRICT_LOCAL_MAXIMA = prove (`!f:real->real. COUNTABLE {x | ?d. &0 < d /\ !x'. abs(x' - x) < d /\ ~(x' = x) ==> f(x') < f(x)}`, GEN_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\(a,b). @x. a < x /\ x < b /\ !x'. a <= x' /\ x' <= b /\ ~(x' = x) ==> f x' < f x) ((rational CROSS rational) INTER {(a,b) | ?x. a < x /\ x < b /\ !x'. a <= x' /\ x' <= b /\ ~(x' = x) ==> f x' < f x})` THEN SIMP_TAC[COUNTABLE_INTER; COUNTABLE_CROSS; COUNTABLE_RATIONAL; COUNTABLE_IMAGE; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_IMAGE; IN_INTER; EXISTS_PAIR_THM] THEN MP_TAC(ISPECL [`x:real`; `d:real`] RATIONAL_APPROXIMATION_STRADDLE) THEN ASM_REWRITE_TAC[IN_CROSS; IN_ELIM_PAIR_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN] THEN MATCH_MP_TAC(MESON[] `P x /\ (!x y. P x /\ P y ==> x = y) ==> x = (@y. P y) /\ (?y. P y)`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[REAL_LT_ANTISYM; REAL_LT_IMP_LE]]);; let COUNTABLE_STRICT_LOCAL_MINIMA = prove (`!f:real->real. COUNTABLE {x | ?d. &0 < d /\ !x'. abs(x' - x) < d /\ ~(x' = x) ==> f(x) < f(x')}`, GEN_TAC THEN MP_TAC(SPEC `(--) o (f:real->real)` COUNTABLE_STRICT_LOCAL_MAXIMA) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[ETA_AX; IMAGE_o] THEN REWRITE_TAC[o_THM; REAL_LT_NEG2] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC COUNTABLE_IMAGE_INJ_EQ THEN SIMP_TAC[REAL_EQ_NEG2]);; (* ------------------------------------------------------------------------- *) (* Extensional functions over a set. *) (* ------------------------------------------------------------------------- *) let UNDEFINED = new_definition `UNDEFINED = (@x:A. F)`;; let EXTENSIONAL = new_definition `EXTENSIONAL s = {f:A->B | !x. ~(x IN s) ==> f x = UNDEFINED}`;; let IN_EXTENSIONAL = prove (`!s f:A->B. f IN EXTENSIONAL s <=> (!x. ~(x IN s) ==> f x = UNDEFINED)`, REWRITE_TAC[EXTENSIONAL; IN_ELIM_THM]);; let IN_EXTENSIONAL_UNDEFINED = prove (`!s f:A->B x. f IN EXTENSIONAL s /\ ~(x IN s) ==> f x = UNDEFINED`, SIMP_TAC[IN_EXTENSIONAL]);; let EXTENSIONAL_EMPTY = prove (`EXTENSIONAL {} = {\x:A. UNDEFINED:B}`, REWRITE_TAC[EXTENSION; IN_EXTENSIONAL; IN_SING; NOT_IN_EMPTY] THEN REWRITE_TAC[FUN_EQ_THM]);; let EXTENSIONAL_EQ = prove (`!s f g:A->B. f IN EXTENSIONAL s /\ g IN EXTENSIONAL s /\ (!x. x IN s ==> f x = g x) ==> f = g`, REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN ASM_CASES_TAC `x:A IN s` THENL [ASM_SIMP_TAC[]; ASM_MESON_TAC[IN_EXTENSIONAL_UNDEFINED]]);; (* ------------------------------------------------------------------------- *) (* Restriction of a function on a set. *) (* ------------------------------------------------------------------------- *) let RESTRICTION = new_definition `RESTRICTION s (f:A->B) x = if x IN s then f x else UNDEFINED`;; let RESTRICTION_DEFINED = prove (`!s f:A->B x. x IN s ==> RESTRICTION s f x = f x`, SIMP_TAC[RESTRICTION]);; let RESTRICTION_UNDEFINED = prove (`!s f:A->B x. ~(x IN s) ==> RESTRICTION s f x = UNDEFINED`, SIMP_TAC[RESTRICTION]);; let RESTRICTION_EQ = prove (`!s f:A->B x y. x IN s /\ f x = y ==> RESTRICTION s f x = y`, SIMP_TAC[RESTRICTION_DEFINED]);; let RESTRICTION_IN_EXTENSIONAL = prove (`!s f:A->B. RESTRICTION s f IN EXTENSIONAL s`, SIMP_TAC[IN_EXTENSIONAL; RESTRICTION]);; let RESTRICTION_EXTENSION = prove (`!s f g:A->B. RESTRICTION s f = RESTRICTION s g <=> (!x. x IN s ==> f x = g x)`, REPEAT GEN_TAC THEN REWRITE_TAC[RESTRICTION; FUN_EQ_THM] THEN MESON_TAC[]);; let RESTRICTION_FIXPOINT = prove (`!s f:A->B. RESTRICTION s f = f <=> f IN EXTENSIONAL s`, REWRITE_TAC[IN_EXTENSIONAL; FUN_EQ_THM; RESTRICTION] THEN MESON_TAC[]);; let RESTRICTION_IDEMP = prove (`!s f:A->B. RESTRICTION s (RESTRICTION s f) = RESTRICTION s f`, REWRITE_TAC[RESTRICTION_FIXPOINT; RESTRICTION_IN_EXTENSIONAL]);; let IMAGE_RESTRICTION = prove (`!f:A->B s t. s SUBSET t ==> IMAGE (RESTRICTION t f) s = IMAGE f s`, REWRITE_TAC[EXTENSION; IN_IMAGE; RESTRICTION] THEN SET_TAC[]);; let RESTRICTION_COMPOSE_RIGHT = prove (`!f:A->B g:B->C s. RESTRICTION s (g o RESTRICTION s f) = RESTRICTION s (g o f)`, REWRITE_TAC[FUN_EQ_THM; o_DEF; RESTRICTION] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN SET_TAC[]);; let RESTRICTION_COMPOSE_LEFT = prove (`!f:A->B g:B->C s t. IMAGE f s SUBSET t ==> RESTRICTION s (RESTRICTION t g o f) = RESTRICTION s (g o f)`, REWRITE_TAC[FUN_EQ_THM; o_DEF; RESTRICTION] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN SET_TAC[]);; let RESTRICTION_COMPOSE = prove (`!f:A->B g:B->C s t. IMAGE f s SUBSET t ==> RESTRICTION s (RESTRICTION t g o RESTRICTION s f) = RESTRICTION s (g o f)`, SIMP_TAC[RESTRICTION_COMPOSE_LEFT; RESTRICTION_COMPOSE_RIGHT]);; (* ------------------------------------------------------------------------- *) (* A somewhat cheap but handy way of getting localized forms of various *) (* topological concepts (open, closed, borel, fsigma, gdelta etc.) *) (* ------------------------------------------------------------------------- *) parse_as_infix("relative_to",(12,"right"));; let relative_to = define `(P relative_to s) t <=> ?u. P u /\ s INTER u = t`;; let RELATIVE_TO_UNIV = prove (`!P s. (P relative_to (:A)) s <=> P s`, REWRITE_TAC[relative_to; INTER_UNIV] THEN MESON_TAC[]);; let RELATIVE_TO_IMP_SUBSET = prove (`!P s t. (P relative_to s) t ==> t SUBSET s`, REWRITE_TAC[relative_to] THEN SET_TAC[]);; let RELATIVE_TO_COMPL = prove (`!P u s:A->bool. s SUBSET u ==> ((P relative_to u) (u DIFF s) <=> ((\c. P(UNIV DIFF c)) relative_to u) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[relative_to] THEN GEN_REWRITE_TAC RAND_CONV [GSYM EXISTS_DIFF] THEN REWRITE_TAC[COMPL_COMPL] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM SET_TAC[]);; let RELATIVE_TO_SUBSET = prove (`!P s t:A->bool. s SUBSET t /\ P s ==> (P relative_to t) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[relative_to] THEN EXISTS_TAC `s:A->bool` THEN ASM SET_TAC[]);; let RELATIVE_TO_SUBSET_TRANS = prove (`!P u s t:A->bool. (P relative_to u) s /\ s SUBSET t /\ t SUBSET u ==> (P relative_to t) s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[relative_to] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let RELATIVE_TO_MONO = prove (`!P Q. (!s. P s ==> Q s) ==> !u. (P relative_to u) s ==> (Q relative_to u) s`, REWRITE_TAC[relative_to] THEN MESON_TAC[]);; let COUNTABLE_UNION_OF_RELATIVE_TO = prove (`!P u s:A->bool. ((COUNTABLE UNION_OF P) relative_to u) s <=> (COUNTABLE UNION_OF (P relative_to u)) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_OF; relative_to] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM))) THEN DISCH_THEN(X_CHOOSE_THEN `f:(A->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `{u INTER c | (c:A->bool) IN f}` THEN ASM_REWRITE_TAC[INTER_UNIONS] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]; DISCH_THEN(X_CHOOSE_THEN `f:(A->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_EXISTS_THM]) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:(A->bool)->(A->bool)` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS (IMAGE (g:(A->bool)->(A->bool)) f)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN EXISTS_TAC `IMAGE (g:(A->bool)->(A->bool)) f` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE]]);; (* ------------------------------------------------------------------------- *) (* Reduction theorem used for sigma-sets doesn't really depend on much. *) (* Besides, our formulation of "Delta" via "baire" doesn't work for *) (* n = 0 so we want to avoid a separate proof for clopen sets. *) (* ------------------------------------------------------------------------- *) let GENERAL_REDUCTION_THEOREM = prove (`!P. P {} /\ (!s t. P s /\ P t ==> P(s UNION t)) /\ (!s t. P s /\ P t ==> P(s DIFF t)) ==> !s:num->A->bool. (!n. (COUNTABLE UNION_OF P) (s n)) ==> ?t. (!n. (COUNTABLE UNION_OF P) (t n)) /\ (!n. t n SUBSET s n) /\ pairwise (\m n. DISJOINT (t m) (t n)) (:num) /\ UNIONS {t n | n IN (:num)} = UNIONS {s n | n IN (:num)}`, REWRITE_TAC[UNION_OF; o_THM] THEN REPEAT STRIP_TAC THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!k:(A->bool)->bool. FINITE k /\ (!i. i IN k ==> P i) ==> P(UNIONS k)` ASSUME_TAC THENL [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[UNIONS_0; UNIONS_INSERT; FORALL_IN_INSERT]; ALL_TAC] THEN SUBGOAL_THEN `?c:num->num->A->bool. (!n m. P (c n m)) /\ (!n. UNIONS {c n m | m IN (:num)} = s n)` MP_TAC THENL [REWRITE_TAC[AND_FORALL_THM; GSYM SKOLEM_THM] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN DISCH_THEN(X_CHOOSE_THEN `u:(A->bool)->bool` MP_TAC) THEN ASM_CASES_TAC `u:(A->bool)->bool = {}` THENL [ASM_REWRITE_TAC[UNIONS_0] THEN DISCH_THEN(SUBST1_TAC o SYM o last o CONJUNCTS) THEN EXISTS_TAC `(\n. {}):num->A->bool` THEN ASM_REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; STRIP_TAC] THEN MP_TAC(ISPEC `u:(A->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [SKOLEM_THM])] THEN DISCH_THEN(X_CHOOSE_THEN `c:num->num->A->bool` STRIP_ASSUME_TAC) THEN MP_TAC CARD_SQUARE_NUM THEN REWRITE_TAC[EQ_C_BIJECTIONS; LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM] THEN REWRITE_TAC[mul_c; IN_ELIM_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`p:num#num->num`; `q:num->num#num`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_UNIV] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ABBREV_TAC `d:num->num->A->bool = \m n. c m n DIFF UNIONS {c i j | (p:num#num->num)(i,j) < p(m,n)}` THEN EXISTS_TAC `\n. UNIONS { d i j | i,j | (d:num->num->A->bool) i j SUBSET s n /\ !m:num. m < n ==> ~(d i j SUBSET s m)}` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN EXISTS_TAC `{ d i j | i,j | (d:num->num->A->bool) i j SUBSET s n /\ !m:num. m < n ==> ~(d i j SUBSET s m)}` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `{(d:num->num->A->bool) i j | i IN (:num) /\ j IN (:num)}` THEN SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT; COUNTABLE_SUBSET_NUM] THEN SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN EXPAND_TAC "d" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN SUBGOAL_THEN `{(c:num->num->A->bool) k l | (p(k,l):num) < p(i,j)} = IMAGE (\r. c (FST(q r)) (SND(q r))) {r | r < p(i,j)}` (fun th -> SIMP_TAC[th; FINITE_IMAGE; FINITE_NUMSEG_LT]) THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `v:A->bool` THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN EQ_TAC THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN EXISTS_TAC `(p:num#num->num)(a,b)` THEN ASM_REWRITE_TAC[]; X_GEN_TAC `c:num` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`FST((q:num->num#num) c)`; `SND((q:num->num#num) c)`] THEN ASM_REWRITE_TAC[]]]; ASM SET_TAC[]; REWRITE_TAC[pairwise] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN REWRITE_TAC[IN_UNIV] THEN BINOP_TAC THENL [MESON_TAC[]; MATCH_ACCEPT_TAC DISJOINT_SYM]; REWRITE_TAC[IN_UNIV; DISJOINT; INTER_UNIONS]] THEN REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN EXPAND_TAC "d" THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(p:num#num->num)(a,b) < p(m,n) \/ p(m,n) < p(a,b)` MP_TAC THENL [REWRITE_TAC[ARITH_RULE `m < n \/ n < m <=> ~(m:num = n)`] THEN DISCH_THEN(MP_TAC o AP_TERM `q:num->num#num`) THEN ASM_REWRITE_TAC[PAIR_EQ] THEN ASM SET_TAC[]; REWRITE_TAC[EXTENSION; IN_DIFF; IN_INTER; UNIONS_GSPEC] THEN SET_TAC[]]; GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[MESON[] `(?n i j. P n i j) <=> (?i j n. P n i j)`] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; GSYM num_WOP] THEN TRANS_TAC EQ_TRANS `?i j. x IN (d:num->num->A->bool) i j` THEN CONJ_TAC THENL [REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MATCH_MP_TAC(TAUT `p ==> (p /\ q <=> q)`) THEN EXPAND_TAC "d" THEN REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV o RAND_CONV) [GSYM t]) THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN MATCH_MP_TAC(MESON[] `!p:num#num->num. (P <=> ?n i j. p(i,j) = n /\ Q i j) ==> (P <=> ?i j. Q i j)`) THEN EXISTS_TAC `p:num#num->num` THEN GEN_REWRITE_TAC RAND_CONV [num_WOP] THEN EXPAND_TAC "d" THEN REWRITE_TAC[IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM] THEN MESON_TAC[]]);; let GENERAL_REDUCTION_THEOREM_2 = prove (`!P. P {} /\ (!s t:A->bool. P s /\ P t ==> P(s UNION t)) /\ (!s t. P s /\ P t ==> P(s DIFF t)) ==> !s t. (COUNTABLE UNION_OF P) s /\ (COUNTABLE UNION_OF P) t ==> ?s' t'. (COUNTABLE UNION_OF P) s' /\ (COUNTABLE UNION_OF P) t' /\ s' SUBSET s /\ t' SUBSET t /\ DISJOINT s' t' /\ s' UNION t' = s UNION t`, GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\n. if n = 0 then s:A->bool else if n = 1 then t else {}` o MATCH_MP GENERAL_REDUCTION_THEOREM) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_SIMP_TAC[COUNTABLE_UNION_OF_INC]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:num->A->bool` MP_TAC) THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (MESON[] `(!n. P n) ==> P 0 /\ P 1`)) THEN ONCE_REWRITE_TAC[MESON[] `(!n. P n) <=> P 0 /\ P 1 /\ (!n. ~(n = 0) /\ ~(n = 1) ==> P n)`] THEN CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[SUBSET_EMPTY] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `(:num) = 0 INSERT 1 INSERT ((:num) DIFF {0,1})`] THEN SIMP_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_INSERT; PAIRWISE_INSERT] THEN DISCH_THEN(MP_TAC o SPEC `1` o CONJUNCT1) THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[IN_INSERT] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s UNION t UNION u = s' UNION t' UNION u' ==> u = {} /\ u' = {} ==> s UNION t = s' UNION t'`)) THEN REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_IMAGE; IN_UNIV; IN_DIFF] THEN ASM_SIMP_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A somewhat general formulation of "back and forth" arguments. *) (* ------------------------------------------------------------------------- *) let BACK_AND_FORTH_ALT = prove (`!P s:A->bool t:B->bool. COUNTABLE s /\ COUNTABLE t /\ (!R. FINITE R /\ R SUBSET s CROSS t /\ pairwise P R ==> (!x. x IN s ==> ?y. y IN t /\ pairwise P ((x,y) INSERT R)) /\ (!y. y IN t ==> ?x. x IN s /\ pairwise P ((x,y) INSERT R))) ==> ?R. R SUBSET s CROSS t /\ pairwise P R /\ (!x. x IN s ==> ?y. y IN t /\ (x,y) IN R) /\ (!y. y IN t ==> ?x. x IN s /\ (x,y) IN R)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?x:num->A. ?y:num->B. s SUBSET IMAGE x (:num) /\ t SUBSET IMAGE y (:num)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[COUNTABLE_AS_IMAGE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `?R:num->A#B->bool. (!n. FINITE(R n) /\ (R n) SUBSET s CROSS t /\ pairwise P (R n) /\ (x n IN s ==> x n IN IMAGE FST(R n)) /\ (y n IN t ==> y n IN IMAGE SND(R n))) /\ (!n. R n SUBSET R(SUC n))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN MATCH_MP_TAC(MESON[] `((!n x. P x /\ Q x /\ R x ==> ?y. B n x y) ==> X) /\ (!n x. P x /\ Q x /\ R x ==> ?y. B n x y) ==> X /\ (!n x. P x /\ Q x /\ R x /\ S n x ==> ?y. B (SUC n) x y)`) THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o SPECL [`0`; `{}:A#B->bool`]) THEN REWRITE_TAC[EMPTY_SUBSET; PAIRWISE_EMPTY; FINITE_RULES]; MAP_EVERY X_GEN_TAC [`n:num`; `R:A#B->bool`] THEN STRIP_TAC] THEN ASM_CASES_TAC `(x:num->A) n IN s` THEN ASM_REWRITE_TAC[] THENL [FIRST_ASSUM(MP_TAC o SPEC `R:A#B->bool`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(x:num->A) n` o CONJUNCT1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:B` THEN STRIP_TAC THEN ASM_CASES_TAC `(y:num->B) n IN t` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(MP_TAC o SPEC `((x:num->A) n,z:B) INSERT R`) THEN ASM_REWRITE_TAC[FINITE_INSERT; INSERT_SUBSET] THEN ASM_REWRITE_TAC[IN_CROSS] THEN DISCH_THEN(MP_TAC o SPEC `(y:num->B) n` o CONJUNCT2) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:A` THEN STRIP_TAC THEN EXISTS_TAC `(w,y(n:num)) INSERT (x n,z) INSERT (R:A#B->bool)` THEN ASM_REWRITE_TAC[FINITE_INSERT; INSERT_SUBSET; IN_CROSS] THEN REWRITE_TAC[IMAGE_CLAUSES; IN_INSERT] THEN SET_TAC[]; EXISTS_TAC `(x(n:num),z) INSERT (R:A#B->bool)` THEN ASM_REWRITE_TAC[FINITE_INSERT; INSERT_SUBSET; IN_CROSS] THEN REWRITE_TAC[IMAGE_CLAUSES; IN_INSERT] THEN SET_TAC[]]; ASM_CASES_TAC `(y:num->B) n IN t` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_REFL]] THEN FIRST_ASSUM(MP_TAC o SPEC `R:A#B->bool`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(y:num->B) n` o CONJUNCT2) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:A` THEN STRIP_TAC THEN EXISTS_TAC `(w,y(n:num)) INSERT (R:A#B->bool)` THEN ASM_REWRITE_TAC[FINITE_INSERT; INSERT_SUBSET; IN_CROSS] THEN REWRITE_TAC[IMAGE_CLAUSES; IN_INSERT] THEN SET_TAC[]]; EXISTS_TAC `UNIONS {R n | n IN (:num)} :A#B->bool` THEN ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [MATCH_MP_TAC PAIRWISE_CHAIN_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `(!x y. P x y ==> Q x y) ==> (!x y. P x y ==> Q x y \/ R x y)`) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; UNWIND_THM1; RIGHT_EXISTS_AND_THM; SUBSET; FORALL_PAIR_THM; IN_CROSS] THEN SET_TAC[]]]);; let BACK_AND_FORTH = prove (`!R s:A->bool t:B->bool. (!x y. x IN s /\ y IN t ==> R x x y y) /\ (!x y x' y'. x IN s /\ x' IN s /\ y IN t /\ y' IN t /\ ~(x = x') /\ ~(y = y') /\ R x x' y y' ==> R x' x y' y) /\ COUNTABLE s /\ COUNTABLE t /\ (!f s' t'. FINITE s' /\ s' SUBSET s /\ FINITE t' /\ t' SUBSET t /\ IMAGE f s' = t' /\ (!x y. x IN s' /\ y IN s' ==> (f x = f y <=> x = y)) /\ (!x y. x IN s' /\ y IN s' ==> R x y (f x) (f y)) ==> (!x. x IN s DIFF s' ==> ?y. y IN t DIFF t' /\ !z. z IN s' ==> R x z y (f z)) /\ (!y. y IN t DIFF t' ==> ?x. x IN s DIFF s' /\ !z. z IN s' ==> R x z y (f z))) ==> ?f. IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (!x y. x IN s /\ y IN s ==> R x y (f x) (f y))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\(x:A,y:B) (x',y'). (x = x' <=> y = y') /\ R x x' y y'`; `s:A->bool`; `t:B->bool`] BACK_AND_FORTH_ALT) THEN ASM_SIMP_TAC[PAIRWISE_INSERT; FORALL_PAIR_THM; PAIR_EQ] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[pairwise; FORALL_PAIR_THM; PAIR_EQ; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:A#B->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_PAIR_THM; IN_CROSS] THEN STRIP_TAC THEN ABBREV_TAC `f:A->B = \x. @y. (x,y) IN r` THEN EXISTS_TAC `f:A->B` THEN SUBGOAL_THEN `!x:A y:B. x IN s ==> (f x = y <=> (x,y) IN r)` ASSUME_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `(f:A->B) x`; `y:A`; `(f:A->B) y`]) THEN ASM_CASES_TAC `x:A = y` THEN ASM_MESON_TAC[]] THEN X_GEN_TAC `r:A#B->bool` THEN REWRITE_TAC[SUBSET; pairwise] THEN REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ; LEFT_IMP_EXISTS_THM; IN_CROSS] THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`s' = IMAGE FST (r:A#B->bool)`; `t' = IMAGE SND (r:A#B->bool)`; `f:A->B = \x. @y. (x,y) IN r`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`f:A->B`; `s':A->bool`; `t':B->bool`]) THEN SUBGOAL_THEN `!x:A y:B. (x,y) IN r <=> x IN s' /\ y IN t' /\ f x = y` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["f"; "s'"; "t'"] THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `(s':A->bool) SUBSET s /\ (t':B->bool) SUBSET t` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (f:A->B) s' = t'` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN REWRITE_TAC[FORALL_PAIR_THM; o_THM] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMAGE]; ALL_TAC]) THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC MONO_FORALL THENL [X_GEN_TAC `x:A` THEN ASM_CASES_TAC `(x:A) IN s` THEN ASM_REWRITE_TAC[IN_DIFF] THEN ASM_CASES_TAC `(x:A) IN s'` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `(f:A->B) x` THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; X_GEN_TAC `y:B` THEN ASM_CASES_TAC `(y:B) IN t` THEN ASM_REWRITE_TAC[IN_DIFF] THEN ASM_CASES_TAC `(y:B) IN t'` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `?x:A. x IN s' /\ (f:A->B) x = y` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `x:A` THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]]);; let BACK_AND_FORTH_2 = prove (`!R s:A->bool t:B->bool. (!x y. x IN s /\ y IN t ==> R x x y y) /\ (!x y x' y'. x IN s /\ x' IN s /\ y IN t /\ y' IN t /\ ~(x = x') /\ ~(y = y') /\ R x x' y y' ==> R x' x y' y) /\ COUNTABLE s /\ COUNTABLE t /\ (!f s' t' x. FINITE s' /\ s' SUBSET s /\ FINITE t' /\ t' SUBSET t /\ IMAGE f s' = t' /\ (!x y. x IN s' /\ y IN s' ==> (f x = f y <=> x = y)) /\ (!x y. x IN s' /\ y IN s' ==> R x y (f x) (f y)) /\ x IN s DIFF s' ==> ?y. y IN t DIFF t' /\ !z. z IN s' ==> R x z y (f z)) /\ (!f t' s' x. FINITE t' /\ t' SUBSET t /\ FINITE s' /\ s' SUBSET s /\ IMAGE f t' = s' /\ (!x y. x IN t' /\ y IN t' ==> (f x = f y <=> x = y)) /\ (!x y. x IN t' /\ y IN t' ==> R (f x) (f y) x y) /\ x IN t DIFF t' ==> ?y. y IN s DIFF s' /\ !z. z IN t' ==> R y (f z) x z) ==> ?f. IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (!x y. x IN s /\ y IN s ==> R x y (f x) (f y))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BACK_AND_FORTH THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`f:A->B`; `s':A->bool`; `t':B->bool`] THEN STRIP_TAC THEN CONJ_TAC THENL [X_GEN_TAC `x:A` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(K ALL_TAC o SPEC `f:A->B`)] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INJECTIVE_ON_ALT]) THEN GEN_REWRITE_TAC LAND_CONV [INJECTIVE_ON_LEFT_INVERSE] THEN DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN X_GEN_TAC `y:B` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`g:B->A`; `t':B->bool`; `s':A->bool`; `y:B`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]; ALL_TAC] THEN EXPAND_TAC "t'" THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_IMAGE_2] THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* The Suslin operation. The proof of the only non-trivial result, *) (* idempotence, is taken from Fremlin's "Measure Theory" volume 4. *) (* ------------------------------------------------------------------------- *) let suslin_operation = new_definition `suslin_operation (f:num list->A->bool) = UNIONS { INTERS {f (list_of_seq s n) | 1 <= n} | s IN (:num->num)}`;; let suslin = new_definition `suslin u = {suslin_operation f | !l. ~(l = []) ==> f l IN u}`;; let SUSLIN_INC = prove (`!C s:A->bool. C s ==> suslin C s`, REPEAT STRIP_TAC THEN REWRITE_TAC[suslin; IN_ELIM_THM] THEN EXISTS_TAC `(\i. s):num list->A->bool` THEN ASM_REWRITE_TAC[suslin_operation] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_CONST; UNIV_NOT_EMPTY] THEN COND_CASES_TAC THEN REWRITE_TAC[INTERS_1; UNIONS_1] THEN MP_TAC LE_REFL THEN ASM SET_TAC[]);; let SUSLIN_SUPERSET = prove (`!u:(A->bool)->bool. u SUBSET suslin u`, REWRITE_TAC[SUBSET; IN; SUSLIN_INC]);; let SUSLIN_SUBSET = prove (`!C D:(A->bool)->bool. C SUBSET D ==> suslin C SUBSET suslin D`, REWRITE_TAC[suslin] THEN SET_TAC[]);; let SUSLIN_MONO = prove (`!C D s:A->bool. (!t. C t ==> D t) /\ suslin C s ==> suslin D s`, REWRITE_TAC[suslin] THEN SET_TAC[]);; let SUSLIN_REGULAR = prove (`!u:(A->bool)->bool. (!c. FINITE c /\ ~(c = {}) /\ c SUBSET u ==> INTERS c IN u) ==> (suslin u = {suslin_operation f | (!l. ~(l = []) ==> f l IN u) /\ !s m n. 1 <= m /\ m <= n ==> f(list_of_seq s n) SUBSET f(list_of_seq s m)})`, REPEAT STRIP_TAC THEN REWRITE_TAC[suslin; GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `f:num list->A->bool` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\l. INTERS {(f:num list->A->bool)(list_of_seq (\i. EL i l) n) |n| 1 <= n /\ n <= LENGTH l}` THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[GSYM numseg; FINITE_NUMSEG; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[NUMSEG_EMPTY; NOT_LT; LENGTH_EQ_NIL; LE_1] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[GSYM LENGTH_EQ_NIL; LENGTH_LIST_OF_SEQ; LE_1]; REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; LENGTH_LIST_OF_SEQ] THEN MAP_EVERY X_GEN_TAC [`s:num->num`; `m:num`; `n:num`] THEN DISCH_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[LIST_EQ] THEN SIMP_TAC[LENGTH_LIST_OF_SEQ; EL_LIST_OF_SEQ] THEN X_GEN_TAC `q:num` THEN DISCH_TAC THEN ASM_MESON_TAC[EL_LIST_OF_SEQ; LT_TRANS; LTE_TRANS]; REWRITE_TAC[suslin_operation] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(SET_RULE `(!x. f x = g x) ==> IMAGE f UNIV = IMAGE g UNIV`) THEN X_GEN_TAC `s:num->num` THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[IN_UNIV; LENGTH_LIST_OF_SEQ] THEN SUBGOAL_THEN `!m n. 1 <= m /\ m <= n ==> list_of_seq (\i. EL i (list_of_seq s n)) m :num list = list_of_seq s m` (fun th -> SIMP_TAC[th]) THENL [SIMP_TAC[LIST_EQ; LENGTH_LIST_OF_SEQ; EL_LIST_OF_SEQ] THEN MESON_TAC[EL_LIST_OF_SEQ; LTE_TRANS]; ASM_MESON_TAC[LE_TRANS; LE_REFL]]]);; let SUSLIN_SUSLIN = prove (`!u:(A->bool)->bool. suslin (suslin u) = suslin u`, GEN_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUSLIN_SUPERSET] THEN REWRITE_TAC[suslin; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `f:num list->A->bool` THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_ELIM_THM; RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:(num)list->(num)list->A->bool` THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN SUBGOAL_THEN `suslin_operation(f:num list->A->bool) = suslin_operation(\l. suslin_operation (g l))` SUBST1_TAC THENL [GEN_REWRITE_TAC BINOP_CONV [suslin_operation] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `s:num->num` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[GSYM LENGTH_EQ_NIL; LENGTH_LIST_OF_SEQ; LE_1]; REMOVE_THEN "*" (K ALL_TAC)] THEN REWRITE_TAC[IN_ELIM_THM; suslin_operation] THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; INTERS_GSPEC; UNIONS_GSPEC; IN_UNIV] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN SUBGOAL_THEN `?h:num->A->bool. {g l m | ~(l:num list = []) /\ ~(m:num list = [])} = IMAGE h (:num)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `~(x = []) <=> x IN {l | ~(l = [])}`] THEN MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN SIMP_TAC[] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `(:num list)` THEN REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC COUNTABLE_LIST THEN REWRITE_TAC[NUM_COUNTABLE]; MATCH_MP_TAC(SET_RULE `(?x. P x) ==> ~({f x y | P x /\ P y} = {})`) THEN MESON_TAC[NOT_CONS_NIL]]; ALL_TAC] THEN SUBGOAL_THEN `?q:num#num->num. (!a b. 1 <= q(a,b)) /\ q(0,0) = 1 /\ q(0,1) = 2 /\ (!a b a' b'. q(a,b) = q(a',b') <=> a = a' /\ b = b')` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `(:num#num) DIFF {(0,0), (0,1)} =_c (:num) DIFF {0,1,2}` MP_TAC THENL [TRANS_TAC CARD_EQ_TRANS `(:num#num)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_DIFF_ABSORB THEN REWRITE_TAC[INFINITE_UNIV_PAIR; num_INFINITE] THEN TRANS_TAC CARD_LTE_TRANS `(:num)` THEN REWRITE_TAC[GSYM FINITE_CARD_LT; FINITE_INSERT; FINITE_EMPTY] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_SQUARE_NUM; GSYM MUL_C_UNIV]; REWRITE_TAC[GSYM MUL_C_UNIV] THEN TRANS_TAC CARD_EQ_TRANS `(:num)` THEN REWRITE_TAC[CARD_SQUARE_NUM] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_DIFF_ABSORB THEN REWRITE_TAC[num_INFINITE] THEN REWRITE_TAC[GSYM FINITE_CARD_LT; FINITE_INSERT; FINITE_EMPTY]]; REWRITE_TAC[EQ_C_BIJECTIONS; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`q:num#num->num`; `q':num->num#num`] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_DIFF; IN_UNIV; IN_INSERT] THEN REWRITE_TAC[PAIR_EQ; NOT_IN_EMPTY; DE_MORGAN_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!a b a' b'. q(a,b):num = q(a',b') ==> a = 0 /\ (b = 0 \/ b = 1) \/ a' = 0 /\ (b' = 0 \/ b' = 1) \/ a = a' /\ b = b'` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`a:num`; `b:num`; `c:num`; `d:num`] THEN REWRITE_TAC[TAUT `p ==> q \/ r <=> p ==> ~q ==> r`] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`a:num`; `b:num`] th) THEN MP_TAC(SPECL [`c:num`; `d:num`] th)) THEN ASM_REWRITE_TAC[GSYM PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `\(a,b). if (a,b) = (0,0) then 1 else if (a,b) = (0,1) then 2 else q(a,b)` THEN ASM_REWRITE_TAC[PAIR_EQ; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_MESON_TAC[]]; ALL_TAC] THEN ABBREV_TAC `J = \(k,m). {(i,0) | i < k} UNION {(i,k) | i < m}` THEN SUBGOAL_THEN `?k:num->num m:num->num. IMAGE (\n. k n,m n) {n | 3 <= n} = ((:num) DELETE 0) CROSS ((:num) DELETE 0) /\ !n. 3 <= n ==> IMAGE (q:num#num->num) (J(k n,m n)) SUBSET {a | a < n}` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?r:num#num->num. (!a. a IN ((:num) DELETE 0) CROSS ((:num) DELETE 0) ==> r a IN {n | 3 <= n}) /\ (!a. a IN ((:num) DELETE 0) CROSS ((:num) DELETE 0) ==> IMAGE (q:num#num->num) (J a) SUBSET {m | m < r a}) /\ (!a b. a IN ((:num) DELETE 0) CROSS ((:num) DELETE 0) /\ b IN ((:num) DELETE 0) CROSS ((:num) DELETE 0) /\ r a = r b ==> a = b)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `((:num) DELETE 0) CROSS ((:num) DELETE 0) =_c (:num)` MP_TAC THENL [TRANS_TAC CARD_EQ_TRANS `(:num) *_c (:num)` THEN REWRITE_TAC[CARD_SQUARE_NUM; CROSS; GSYM mul_c] THEN MATCH_MP_TAC CARD_MUL_CONG THEN REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN MATCH_MP_TAC CARD_DIFF_ABSORB THEN REWRITE_TAC[num_INFINITE; GSYM FINITE_CARD_LT; FINITE_SING]; REWRITE_TAC[EQ_C_BIJECTIONS; LEFT_IMP_EXISTS_THM; IN_UNIV]] THEN MAP_EVERY X_GEN_TAC [`p':num#num->num`; `p:num->num#num`] THEN STRIP_TAC THEN SUBGOAL_THEN `?t:num->num. (!n. IMAGE q ((J:num#num->num#num->bool)(p n)) SUBSET {a | a < t n} /\ 2 < t n) /\ (!n. t n < t (SUC n))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[SET_RULE `s SUBSET {a | a < y} /\ x < y <=> (x INSERT s) SUBSET {a:num | a < y}`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(?a. P(SUC a)) ==> (?a. P a)`) THEN REWRITE_TAC[LT_SUC_LE; SUBSET; IN_ELIM_THM] THEN MATCH_MP_TAC UPPER_BOUND_FINITE_SET THEN REWRITE_TAC[FINITE_INSERT] THEN MATCH_MP_TAC FINITE_IMAGE THEN EXPAND_TAC "J" THEN MATCH_MP_TAC(MESON[] `(!x. FINITE(f x)) ==> FINITE(f a)`) THEN REWRITE_TAC[FORALL_PAIR_THM; FINITE_UNION] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE]; REWRITE_TAC[ARITH_RULE `2 < n <=> 3 <= n`] THEN STRIP_TAC] THEN EXISTS_TAC `(t:num->num) o (p':num#num->num)` THEN ASM_REWRITE_TAC[o_THM; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `((:num) DELETE 0) CROSS ((:num) DELETE 0) = IMAGE p (:num)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m < n ==> (t:num->num) m < t n` MP_TAC THENL [ALL_TAC; MESON_TAC[LT_REFL]] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `l:num->num#num`) THEN EXISTS_TAC `\n. if n IN IMAGE r (((:num) DELETE 0) CROSS ((:num) DELETE 0)) then FST((l:num->num#num) n) else 1` THEN EXISTS_TAC `\n. if n IN IMAGE r (((:num) DELETE 0) CROSS ((:num) DELETE 0)) then SND((l:num->num#num) n) else 1` THEN REWRITE_TAC[MESON[] `(if p then x else 1),(if p then y else 1) = (if p then x,y else 1,1)`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUBSET_ANTISYM_EQ] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[IN_CROSS; IN_UNIV; IN_DELETE] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM SET_TAC[]; ASM SET_TAC[]; REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[IN_CROSS; IN_UNIV; IN_DELETE] THENL [ASM SET_TAC[]; ALL_TAC] THEN EXPAND_TAC "J" THEN REWRITE_TAC[IN_UNION] THEN REWRITE_TAC[ARITH_RULE `i < 1 <=> i = 0`] THEN REWRITE_TAC[SET_RULE `{f x | x = a} = {f a}`] THEN REWRITE_TAC[IN_SING] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_ARITH_TAC]]; ALL_TAC] THEN ABBREV_TAC `f = \l. if LENGTH l <= 2 then h(EL 0 l) else (g:(num)list->(num)list->A->bool) (list_of_seq (\i. EL (q(i,0)) l) (k(LENGTH l))) (list_of_seq (\i. EL (q(i,k(LENGTH l))) l) (m(LENGTH l)))` THEN EXISTS_TAC `f:num list->A->bool` THEN EXPAND_TAC "f" THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `l:num list` THEN DISCH_TAC THEN COND_CASES_TAC THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC] THEN REWRITE_TAC[GSYM LENGTH_EQ_NIL; LENGTH_LIST_OF_SEQ] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s = t ==> !x. x IN s ==> f x IN t`)) THEN DISCH_THEN(MP_TAC o SPEC `LENGTH(l:num list)`) THEN REWRITE_TAC[IN_ELIM_THM; IN_CROSS; IN_UNIV; IN_DELETE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:A` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`s:num->num`; `s':num->num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `?t. h(t 0) = (g:(num)list->(num)list->A->bool) (list_of_seq s 1) (list_of_seq (s' 1) 1) /\ (!i. t(q(i,0)) = s i) /\ (!i j. 1 <= j ==> t(q(i,j)) = s' j i)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?t:num->num. (\(i,j). if j = 0 then s i else s' j i) = t o (q:num#num->num)` MP_TAC THENL [REWRITE_TAC[GSYM FUNCTION_FACTORS_LEFT] THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN SIMP_TAC[]; REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM; o_THM]] THEN DISCH_THEN(X_CHOOSE_TAC `t:num->num` o GSYM) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `t = IMAGE f UNIV ==> !y. y IN t ==> ?x. f x = y`)) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN(MP_TAC o SPECL [`list_of_seq s 1:num list`; `list_of_seq (s' 1) 1:num list`]) THEN REWRITE_TAC[LIST_OF_SEQ_EQ_NIL] THEN CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `p:num` (SUBST1_TAC o SYM)) THEN EXISTS_TAC `\n. if n = 0 then p:num else t n` THEN ASM_SIMP_TAC[LE_1]; EXISTS_TAC `t:num->num`] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[LENGTH_LIST_OF_SEQ] THEN SIMP_TAC[LE_1; EL_LIST_OF_SEQ] THEN DISCH_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONV_TAC NUM_REDUCE_CONV; RULE_ASSUM_TAC(REWRITE_RULE[ARITH_RULE `~(n <= 2) <=> 3 <= n`])] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s = t ==> !x. x IN s ==> f x IN t`)) THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_CROSS; IN_DELETE; IN_UNIV] THEN REWRITE_TAC[ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THEN SIMP_TAC[LIST_EQ; LENGTH_LIST_OF_SEQ; EL_LIST_OF_SEQ] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) EL_LIST_OF_SEQ o rand o snd) THEN ASM_SIMP_TAC[LE_1] THEN DISCH_THEN(MATCH_MP_TAC o GSYM); X_GEN_TAC `t:num->num` THEN DISCH_THEN(LABEL_TAC "*") THEN EXISTS_TAC `\i:num. (t:num->num)(q(i,0))` THEN EXISTS_TAC `\j:num i:num. (t:num->num)(q(i,j))` THEN MAP_EVERY X_GEN_TAC [`kk:num`; `mm:num`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s = t ==> !y. y IN t ==> ?x. x IN s /\ f x = y`)) THEN DISCH_THEN(MP_TAC o SPEC `(kk:num),(mm:num)`) THEN ASM_SIMP_TAC[IN_CROSS; IN_DELETE; IN_UNIV; LE_1; PAIR_EQ; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN (SUBST_ALL_TAC o SYM)) THEN REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN ASM_SIMP_TAC[LENGTH_LIST_OF_SEQ; ARITH_RULE `3 <= n ==> 1 <= n /\ ~(n <= 2)`] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THEN SIMP_TAC[LIST_EQ; LENGTH_LIST_OF_SEQ; EL_LIST_OF_SEQ] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN MATCH_MP_TAC EL_LIST_OF_SEQ] THEN RULE_ASSUM_TAC(REWRITE_RULE [SUBSET; IN_ELIM_THM; FORALL_IN_IMAGE; RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "J" THEN REWRITE_TAC[IN_UNION; IN_ELIM_PAIR_THM] THEN ASM SET_TAC[]);; let SUSLIN_INTERS = prove (`!C f:(A->bool)->bool. COUNTABLE f /\ ~(f = {}) /\ (!s. s IN f ==> suslin C s) ==> suslin C (INTERS f)`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPEC `f:(A->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:num->A->bool` THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SUSLIN_SUSLIN] THEN ONCE_REWRITE_TAC[suslin] THEN REWRITE_TAC[IN_ELIM_THM; suslin_operation] THEN EXISTS_TAC `(f:num->A->bool) o (\n. n - 1) o (LENGTH:num list->num)` THEN ASM_REWRITE_TAC[o_THM; LENGTH_LIST_OF_SEQ] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CONST; UNIV_NOT_EMPTY; UNIONS_1] THEN CONJ_TAC THENL [ASM SET_TAC[]; AP_TERM_TAC] THEN MP_TAC(ARITH_RULE `!n. 1 <= SUC n /\ SUC n - 1 = n`) THEN SET_TAC[]);; let SUSLIN_INTER = prove (`!C s t:A->bool. suslin C s /\ suslin C t ==> suslin C (s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN MATCH_MP_TAC SUSLIN_INTERS THEN REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY; NOT_INSERT_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let SUSLIN_UNIONS = prove (`!C f:(A->bool)->bool. COUNTABLE f /\ ~(f = {}) /\ (!s. s IN f ==> suslin C s) ==> suslin C (UNIONS f)`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPEC `f:(A->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:num->A->bool` THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SUSLIN_SUSLIN] THEN ONCE_REWRITE_TAC[suslin] THEN REWRITE_TAC[IN_ELIM_THM; suslin_operation] THEN EXISTS_TAC `(f:num->A->bool) o (EL 0:num list->num)` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!f:num->A->bool s. {f (EL 0 (list_of_seq s n)) | 1 <= n} = {f(s 0)}` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC(SET_RULE `(?x. P x) /\ (!x. P x ==> f x = a) ==> {f x | P x} = {a}`) THEN SIMP_TAC[EL_LIST_OF_SEQ; LE_1] THEN MESON_TAC[LE_REFL]; REWRITE_TAC[INTERS_1] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_GSPEC] THEN SIMP_TAC[FUN_IN_IMAGE; IN_UNIV; FORALL_IN_IMAGE] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `(\i. n):num->num` THEN REWRITE_TAC[]]);; let SUSLIN_UNION = prove (`!C s t:A->bool. suslin C s /\ suslin C t ==> suslin C (s UNION t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN MATCH_MP_TAC SUSLIN_UNIONS THEN REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY; NOT_INSERT_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let CARD_SUSLIN_LE = prove (`!C:(A->bool)->bool. C <=_c (:real) ==> suslin C <=_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[suslin] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN TRANS_TAC CARD_LE_TRANS `IMAGE suslin_operation ((C:(A->bool)->bool) ^_c (:num list))` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[exp_c; IN_UNIV] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> ?y. y IN t /\ f x = f y) ==> IMAGE f s SUBSET IMAGE f t`) THEN X_GEN_TAC `f:num list->A->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `\l. if l = [] then f[0] else f l:A->bool` THEN REWRITE_TAC[suslin_operation] THEN CONJ_TAC THENL [ASM_MESON_TAC[NOT_CONS_NIL]; ALL_TAC] THEN REPEAT(AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN REPEAT STRIP_TAC) THEN ASM_SIMP_TAC[LIST_OF_SEQ_EQ_NIL; LE_1]; ALL_TAC] THEN W(MP_TAC o PART_MATCH lhand CARD_LE_IMAGE o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN TRANS_TAC CARD_LE_TRANS `(:real) ^_c (:num list)` THEN ASM_SIMP_TAC[CARD_LE_EXP_LEFT] THEN TRANS_TAC CARD_LE_TRANS `(:num->bool) ^_c (:num)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_EXP_CONG THEN SIMP_TAC[CARD_EQ_REAL; CARD_EQ_LIST; num_INFINITE]; ALL_TAC] THEN REWRITE_TAC[GSYM CARD_EXP_UNIV] THEN W(MP_TAC o PART_MATCH rand CARD_EXP_MUL o lhand o snd) THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_IMP_LE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN TRANS_TAC CARD_EQ_TRANS `(:num->bool)` THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_REAL] THEN REWRITE_TAC[GSYM CARD_EXP_UNIV] THEN MATCH_MP_TAC CARD_EXP_CONG THEN REWRITE_TAC[CARD_EQ_REFL] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_SQUARE_NUM]);; let CARD_SUSLIN_EQ = prove (`!C:(A->bool)->bool. C =_c (:real) ==> suslin C =_c (:real)`, GEN_TAC THEN SIMP_TAC[GSYM CARD_LE_ANTISYM] THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[CARD_SUSLIN_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUSLIN_SUPERSET]);; hol-light/Multivariate/moretop.ml000066400000000000000000014604241303454263000174450ustar00rootroot00000000000000(* ========================================================================= *) (* Additional topology theory. *) (* *) (* (c) Copyright, John Harrison 1998-2013 *) (* ========================================================================= *) needs "Multivariate/realanalysis.ml";; (* ------------------------------------------------------------------------- *) (* Injective map into R is also an open map w.r.t. the universe, and this *) (* is actually an implication in both directions for an interval. Compare *) (* the local form in INJECTIVE_INTO_1D_IMP_OPEN_MAP (not a bi-implication). *) (* ------------------------------------------------------------------------- *) let INJECTIVE_EQ_1D_OPEN_MAP_UNIV = prove (`!f:real^1->real^1 s. f continuous_on s /\ is_interval s ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> (!t. open t /\ t SUBSET s ==> open(IMAGE f t)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BALL_1] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (f:real^1->real^1) (segment (x - lift d,x + lift d))` THEN MP_TAC(ISPECL [`f:real^1->real^1`; `x - lift d`; `x + lift d`] CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1) THEN REWRITE_TAC[SEGMENT_1; DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_CASES_TAC `drop x - d <= drop x + d` THENL [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM SEGMENT_1]; ASM_REAL_ARITH_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC[OPEN_SEGMENT_1]; MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC IMAGE_SUBSET THEN ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_TRANS]]; MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `y:real^1`] CONTINUOUS_IVT_LOCAL_EXTREMUM) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT_EQ; IS_INTERVAL_CONVEX_1; CONTINUOUS_ON_SUBSET]; DISCH_THEN(X_CHOOSE_TAC `z:real^1`) THEN FIRST_ASSUM(MP_TAC o SPEC `segment(x:real^1,y)`) THEN REWRITE_TAC[OPEN_SEGMENT_1; NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; IS_INTERVAL_CONVEX_1; SUBSET_TRANS; SEGMENT_OPEN_SUBSET_CLOSED]; FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `z:real^1`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z + lift(e / &2)`); DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z - lift(e / &2)`)] THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a + b:real^N,a) = norm b`; NORM_ARITH `dist(a - b:real^N,a) = norm b`; NORM_LIFT; REAL_ARITH `abs(e / &2) < e <=> &0 < e`] THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real^1`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]]]);; (* ------------------------------------------------------------------------- *) (* Map f:S^m->S^n for m < n is nullhomotopic. *) (* ------------------------------------------------------------------------- *) let INESSENTIAL_SPHEREMAP_LOWDIM_GEN = prove (`!f:real^M->real^N s t. convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s < aff_dim t /\ f continuous_on relative_frontier s /\ IMAGE f (relative_frontier s) SUBSET (relative_frontier t) ==> ?c. homotopic_with (\z. T) (relative_frontier s,relative_frontier t) f (\x. c)`, let lemma1 = prove (`!f:real^N->real^N s t. subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\ f differentiable_on sphere(vec 0,&1) INTER s ==> ~(IMAGE f (sphere(vec 0,&1) INTER s) = sphere(vec 0,&1) INTER t)`, REPEAT STRIP_TAC THEN ABBREV_TAC `(g:real^N->real^N) = \x. norm(x) % (f:real^N->real^N)(inv(norm x) % x)` THEN SUBGOAL_THEN `(g:real^N->real^N) differentiable_on s DELETE (vec 0)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN SIMP_TAC[o_DEF; DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN REWRITE_TAC[DIFFERENTIABLE_ON_ID] THEN SUBGOAL_THEN `lift o (\x:real^N. inv(norm x)) = (lift o inv o drop) o (\x. lift(norm x))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN SIMP_TAC[DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN SIMP_TAC[FORALL_IN_IMAGE; IN_DELETE; GSYM REAL_DIFFERENTIABLE_AT] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN ASM_REWRITE_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] DIFFERENTIABLE_ON_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_INTER; SUBSPACE_MUL; NORM_MUL; IN_DELETE] THEN SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (g:real^N->real^N) (s DELETE vec 0) = t DELETE (vec 0)` ASSUME_TAC THENL [UNDISCH_TAC `IMAGE (f:real^N->real^N) (sphere (vec 0,&1) INTER s) = sphere (vec 0,&1) INTER t` THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER; IN_SPHERE_0] THEN EXPAND_TAC "g" THEN REWRITE_TAC[IN_IMAGE; IN_INTER; IN_SPHERE_0] THEN SIMP_TAC[IN_DELETE; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN MATCH_MP_TAC(TAUT `(p ==> r) /\ (p ==> q ==> s) ==> p /\ q ==> r /\ s`) THEN CONJ_TAC THENL [ALL_TAC; DISCH_TAC] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(SPEC `inv(norm x) % x:real^N` th)) THEN ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `norm(x:real^N) % y:real^N` THEN ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_NORM; REAL_MUL_RID] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN ASM_SIMP_TAC[NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN UNDISCH_THEN `inv(norm x) % x = (f:real^N->real^N) y` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN REWRITE_TAC[VECTOR_MUL_LID]; ALL_TAC] THEN MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`] DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV; IN_UNIV; SUBSET_UNIV] THEN ABBREV_TAC `t' = {y:real^N | !x. x IN t ==> orthogonal x y}` THEN DISCH_TAC THEN SUBGOAL_THEN `subspace(t':real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "t'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS]; ALL_TAC] THEN SUBGOAL_THEN `?fst snd. linear fst /\ linear snd /\ (!z. fst(z) IN t /\ snd z IN t' /\ fst z + snd z = z) /\ (!x y:real^N. x IN t /\ y IN t' ==> fst(x + y) = x /\ snd(x + y) = y)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `t:real^N->bool` ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `fst:real^N->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `snd:real^N->real^N` THEN DISCH_THEN(MP_TAC o GSYM) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE; FORALL_AND_THM] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q /\ s) ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [EXPAND_TAC "t'" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[ORTHOGONAL_SYM]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN ASM SET_TAC[]; DISCH_TAC] THEN REWRITE_TAC[linear] THEN MATCH_MP_TAC(TAUT `(p /\ r) /\ (q /\ s) ==> (p /\ q) /\ (r /\ s)`) THEN REWRITE_TAC[AND_FORALL_THM] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_ADD; SUBSPACE_MUL] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\x:real^N. (g:real^N->real^N)(fst x) + snd x`; `{x + y:real^N | x IN (s DELETE vec 0) /\ y IN t'}`] NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE) THEN REWRITE_TAC[LE_REFL; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN MP_TAC(ISPECL [`s:real^N->bool`; `t':real^N->bool`] DIM_SUMS_INTER) THEN ASM_REWRITE_TAC[IN_DELETE] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `t' + t = n ==> s < t /\ d' <= d /\ i = 0 ==> d + i = s + t' ==> d' < n`)) THEN ASM_REWRITE_TAC[DIM_EQ_0] THEN CONJ_TAC THENL [MATCH_MP_TAC DIM_SUBSET THEN SET_TAC[]; EXPAND_TAC "t'"] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_SING; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET; ORTHOGONAL_REFL]; MATCH_MP_TAC DIFFERENTIABLE_ON_ADD THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] DIFFERENTIABLE_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_DELETE]; SUBGOAL_THEN `~negligible {x + y | x IN IMAGE (g:real^N->real^N) (s DELETE vec 0) /\ y IN t'}` MP_TAC THENL [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `negligible(t':real^N->bool)` MP_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_ARITH_TAC; REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ] THEN MP_TAC NOT_NEGLIGIBLE_UNIV THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM; IN_DELETE] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[TAUT `p \/ q <=> ~p ==> q`] THEN DISCH_TAC THEN EXISTS_TAC `(fst:real^N->real^N) z` THEN EXISTS_TAC `(snd:real^N->real^N) z` THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_ADD_LID]; REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x + y:real^N` THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]]]) in let lemma2 = prove (`!f:real^N->real^N s t. subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\ f continuous_on sphere(vec 0,&1) INTER s /\ IMAGE f (sphere(vec 0,&1) INTER s) SUBSET sphere(vec 0,&1) INTER t ==> ?c. homotopic_with (\x. T) (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t) f (\x. c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `sphere(vec 0:real^N,&1) INTER s`; `&1 / &2`; `t:real^N->bool`;] STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_SPHERE; CLOSED_SUBSPACE] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x. x IN sphere(vec 0,&1) INTER s ==> ~((g:real^N->real^N) x = vec 0)` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_SPHERE_0]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN SUBGOAL_THEN `(g:real^N->real^N) differentiable_on sphere(vec 0,&1) INTER s` ASSUME_TAC THENL [ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION]; ALL_TAC] THEN ABBREV_TAC `(h:real^N->real^N) = \x. inv(norm(g x)) % g x` THEN SUBGOAL_THEN `!x. x IN sphere(vec 0,&1) INTER s ==> (h:real^N->real^N) x IN sphere(vec 0,&1) INTER t` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_SIMP_TAC[SUBSPACE_MUL; IN_INTER; IN_SPHERE_0; NORM_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; GSYM IN_SPHERE_0]; ALL_TAC] THEN SUBGOAL_THEN `(h:real^N->real^N) differentiable_on sphere(vec 0,&1) INTER s` ASSUME_TAC THENL [EXPAND_TAC "h" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION; o_DEF] THEN SUBGOAL_THEN `(\x. lift(inv(norm((g:real^N->real^N) x)))) = (lift o inv o drop) o (\x. lift(norm x)) o (g:real^N->real^N)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN MATCH_MP_TAC DIFFERENTIABLE_ON_NORM THEN ASM_REWRITE_TAC[SET_RULE `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`]; MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT; o_THM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0; IN_SPHERE_0]]; ALL_TAC] THEN SUBGOAL_THEN `?c. homotopic_with (\z. T) (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t) (h:real^N->real^N) (\x. c)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN SUBGOAL_THEN `homotopic_with (\z. T) (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N)) f g` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN ASM_SIMP_TAC[CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP SEGMENT_BOUND) THEN SUBGOAL_THEN `(f:real^N->real^N) x IN sphere(vec 0,&1) /\ norm(f x - g x) < &1/ &2` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_SPHERE_0] THEN CONV_TAC NORM_ARITH]; DISCH_THEN(MP_TAC o ISPECL [`\y:real^N. inv(norm y) % y`; `sphere(vec 0:real^N,&1) INTER t`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]]; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN RULE_ASSUM_TAC(REWRITE_RULE [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER; REAL_INV_1; VECTOR_MUL_LID]]]] THEN SUBGOAL_THEN `?c. c IN (sphere(vec 0,&1) INTER t) DIFF (IMAGE (h:real^N->real^N) (sphere(vec 0,&1) INTER s))` MP_TAC THENL [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ ~(t = s) ==> ?a. a IN s DIFF t`) THEN CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC lemma1] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER; IN_DIFF; IN_IMAGE] THEN REWRITE_TAC[SET_RULE `~(?x. P x /\ x IN s /\ x IN t) <=> (!x. x IN s INTER t ==> ~(P x))`] THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN EXISTS_TAC `--c:real^N` THEN SUBGOAL_THEN `homotopic_with (\z. T) (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N)) h (\x. --c)` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; CONTINUOUS_ON_CONST] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX; INSERT_SUBSET; SUBSPACE_NEG] THEN ASM SET_TAC[]; DISCH_TAC THEN MP_TAC(ISPECL [`(h:real^N->real^N) x`; `vec 0:real^N`; `--c:real^N`] MIDPOINT_BETWEEN) THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; DIST_0; NORM_NEG] THEN SUBGOAL_THEN `((h:real^N->real^N) x) IN sphere(vec 0,&1) /\ (c:real^N) IN sphere(vec 0,&1)` MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_SPHERE_0]] THEN STRIP_TAC THEN REWRITE_TAC[midpoint; VECTOR_ARITH `vec 0:real^N = inv(&2) % (x + --y) <=> x = y`] THEN ASM SET_TAC[]]; DISCH_THEN(MP_TAC o ISPECL [`\y:real^N. inv(norm y) % y`; `sphere(vec 0:real^N,&1) INTER t`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]]; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN RULE_ASSUM_TAC(REWRITE_RULE [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER; REAL_INV_1; VECTOR_MUL_LID; NORM_NEG]]]) in let lemma3 = prove (`!s:real^M->bool u:real^N->bool. bounded s /\ convex s /\ subspace u /\ aff_dim s <= &(dim u) ==> ?t. subspace t /\ t SUBSET u /\ (~(s = {}) ==> aff_dim t = aff_dim s) /\ (relative_frontier s) homeomorphic (sphere(vec 0,&1) INTER t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [STRIP_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN ASM_REWRITE_TAC[SUBSPACE_TRIVIAL; RELATIVE_FRONTIER_EMPTY] THEN ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY; SET_RULE `s INTER {a} = {} <=> ~(a IN s)`; IN_SPHERE_0; NORM_0; SING_SUBSET; SUBSPACE_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV; FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN GEOM_ORIGIN_TAC `a:real^M` THEN SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LE; GSYM DIM_UNIV] THEN REPEAT STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE; AFF_DIM_DIM_SUBSPACE; INT_OF_NUM_EQ] THEN STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `relative_frontier(ball(vec 0:real^N,&1) INTER t)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS THEN ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; SUBSPACE_IMP_CONVEX; CONVEX_BALL] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_0) THEN SUBGOAL_THEN `~(t INTER ball(vec 0:real^N,&1) = {})` ASSUME_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01]; ASM_SIMP_TAC[AFF_DIM_CONVEX_INTER_OPEN; OPEN_BALL; SUBSPACE_IMP_CONVEX] THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]]; MATCH_MP_TAC(MESON[HOMEOMORPHIC_REFL] `s = t ==> s homeomorphic t`) THEN SIMP_TAC[GSYM FRONTIER_BALL; REAL_LT_01] THEN MATCH_MP_TAC RELATIVE_FRONTIER_CONVEX_INTER_AFFINE THEN ASM_SIMP_TAC[CONVEX_BALL; SUBSPACE_IMP_AFFINE; GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; INTERIOR_OPEN; OPEN_BALL; SUBSPACE_0; IN_INTER; REAL_LT_01]]) in ONCE_REWRITE_TAC[MESON[] `(!a b c. P a b c) <=> (!b c a. P a b c)`] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_SIMP_TAC[HOMOTOPIC_WITH; RELATIVE_FRONTIER_EMPTY; PCROSS_EMPTY; NOT_IN_EMPTY; IMAGE_CLAUSES; CONTINUOUS_ON_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; GSYM INT_NOT_LE; AFF_DIM_GE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`] lemma3) THEN ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV; AFF_DIM_LE_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL th]) THEN MP_TAC(ISPECL [`s:real^M->bool`; `t':real^N->bool`] lemma3) THEN ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE] THEN ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL th]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN ASM_SIMP_TAC[GSYM INT_OF_NUM_LT; GSYM AFF_DIM_DIM_SUBSPACE] THEN ASM_INT_ARITH_TAC);; let INESSENTIAL_SPHEREMAP_LOWDIM = prove (`!f:real^M->real^N a r b s. dimindex(:M) < dimindex(:N) /\ f continuous_on sphere(a,r) /\ IMAGE f (sphere(a,r)) SUBSET (sphere(b,s)) ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s <= &0` THEN ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN ASM_CASES_TAC `r <= &0` THEN ASM_SIMP_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN ASM_SIMP_TAC[GSYM FRONTIER_CBALL; INTERIOR_CBALL; BALL_EQ_EMPTY; CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL RELATIVE_FRONTIER_NONEMPTY_INTERIOR)] THEN STRIP_TAC THEN MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE; INT_OF_NUM_LT]);; let HOMEOMORPHIC_SPHERES_EQ,HOMOTOPY_EQUIVALENT_SPHERES_EQ = (CONJ_PAIR o prove) (`(!a:real^M b:real^N r s. sphere(a,r) homeomorphic sphere(b,s) <=> r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/ &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)) /\ (!a:real^M b:real^N r s. sphere(a,r) homotopy_equivalent sphere(b,s) <=> r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/ &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N))`, let lemma = prove (`!a:real^M r b:real^N s. dimindex(:M) < dimindex(:N) /\ &0 < r /\ &0 < s ==> ~(sphere(a,r) homotopy_equivalent sphere(b,s))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `sphere(a:real^M,r)` o MATCH_MP HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY) THEN MATCH_MP_TAC(TAUT `~p /\ q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL [SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `c:real^M` THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPECL[`\a:real^M. a`; `(\a. c):real^M->real^M`]) THEN SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(contractible(sphere(a:real^M,r)))` MP_TAC THENL [REWRITE_TAC[CONTRACTIBLE_SPHERE] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[contractible] THEN MESON_TAC[]]; MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `g:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN MP_TAC(ISPEC `f:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN ASM_REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN (MP_TAC o SPECL [`a:real^M`; `r:real`; `b:real^N`; `s:real`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ; RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th -> CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) th THEN MP_TAC th) THEN MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM] `homotopic_with p (s,t) c d ==> homotopic_with p (s,t) f c /\ homotopic_with p (s,t) g d ==> homotopic_with p (s,t) f g`) THEN REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN MP_TAC(ISPECL [`b:real^N`; `s:real`] PATH_CONNECTED_SPHERE) THEN ANTS_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `m < n ==> 1 <= m ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1]; REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN DISCH_THEN MATCH_MP_TAC THEN SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; ASM SET_TAC[]]]]) in REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> p) /\ (q ==> r) /\ (p ==> q) ==> (r <=> q) /\ (p <=> q)`) THEN REWRITE_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT] THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY; HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `s < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY; HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING; HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE; ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM] HOMOTOPY_EQUIVALENT_SING] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `s = &0` THEN ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING; HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE; ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM] HOMOTOPY_EQUIVALENT_SING] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < r /\ &0 < s` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL [DISCH_THEN(fun th -> let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[ARITH_RULE `~(m:num = n) <=> m < n \/ n < m`] THEN STRIP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM]] THEN ASM_SIMP_TAC[lemma]]);; let SIMPLY_CONNECTED_SPHERE_GEN = prove (`!s. convex s /\ bounded s /\ &3 <= aff_dim s ==> simply_connected(relative_frontier s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP; PATH_CONNECTED_SPHERE_GEN; INT_ARITH `&3:int <= x ==> ~(x = &1)`] THEN SUBGOAL_THEN `sphere(vec 0:real^2,&1) = relative_frontier(cball(vec 0,&1))` SUBST1_TAC THENL [REWRITE_TAC[RELATIVE_FRONTIER_CBALL; REAL_OF_NUM_EQ; ARITH]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN REWRITE_TAC[DIMINDEX_2; REAL_LT_01] THEN ASM_INT_ARITH_TAC);; let SIMPLY_CONNECTED_SPHERE = prove (`!a:real^N r. 3 <= dimindex(:N) ==> simply_connected(sphere(a,r))`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) THEN ASM_SIMP_TAC[SPHERE_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN ASM_SIMP_TAC[SPHERE_SING; CONVEX_SING; CONVEX_IMP_SIMPLY_CONNECTED] THEN MP_TAC(ISPEC `cball(a:real^N,r)` SIMPLY_CONNECTED_SPHERE_GEN) THEN ASM_SIMP_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL; CONVEX_CBALL; BOUNDED_CBALL; REAL_LT_IMP_NE; INT_OF_NUM_LE]);; let SIMPLY_CONNECTED_PUNCTURED_CONVEX = prove (`!s a:real^N. convex s /\ &3 <= aff_dim s ==> simply_connected(s DELETE a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN relative_interior s` THENL [ALL_TAC; MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN MATCH_MP_TAC CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN MP_TAC(ISPECL [`cball(a:real^N,e) INTER affine hull s`; `s:real^N->bool`; `a:real^N`] HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(MESON[HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS] `simply_connected s ==> s homotopy_equivalent t ==> simply_connected t`) THEN MATCH_MP_TAC SIMPLY_CONNECTED_SPHERE_GEN] THEN ASM_SIMP_TAC[CONVEX_INTER; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX; CONVEX_CBALL; BOUNDED_INTER; BOUNDED_CBALL] THEN REPEAT CONJ_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_INTERIOR_CONVEX_INTER_AFFINE o rand o snd) THEN REWRITE_TAC[CONVEX_CBALL; AFFINE_AFFINE_HULL; INTERIOR_CBALL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[CENTRE_IN_BALL; IN_INTER]] THEN ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; REWRITE_TAC[relative_frontier] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET u ==> c = s ==> c DIFF i SUBSET u`)) THEN REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_AFFINE_HULL; CLOSED_CBALL]; ONCE_REWRITE_TAC[INTER_COMM] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR o rand o snd); ONCE_REWRITE_TAC[INTER_COMM] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd)] THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_SIMP_TAC[INTERIOR_CBALL; CENTRE_IN_BALL; HULL_INC; HULL_SUBSET; AFF_DIM_AFFINE_HULL]);; let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE = prove (`!a. 3 <= dimindex(:N) ==> simply_connected((:real^N) DELETE a)`, GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `&1`] o MATCH_MP SIMPLY_CONNECTED_SPHERE) THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`] HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL; RELATIVE_FRONTIER_CBALL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL; BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);; let SIMPLY_CONNECTED_CONVEX_DIFF_FINITE = prove (`!s t:real^N->bool. convex s /\ &3 <= aff_dim s /\ FINITE t ==> simply_connected(s DIFF t)`, let lemma = prove (`!P. (?u v. P u /\ P v /\ ~(u = v)) /\ (!c. P c ==> ~(s INTER {x:real^N | x$k = c} = {})) ==> ?u v. u IN s INTER {x | P(x$k)} /\ v IN s INTER {x | P(x$k)} /\ ~(u = v)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `u:real` th) THEN MP_TAC(SPEC `v:real` th)) THEN ASM SET_TAC[]) in ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN WF_INDUCT_TAC `CARD(t:real^N->bool)` THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC (SET_RULE `s INTER t = {} \/ ?a:real^N. s INTER t = {a} \/ ?a b. ~(a = b) /\ a IN s /\ a IN t /\ b IN s /\ b IN t`) THEN ASM_SIMP_TAC[CONVEX_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_PUNCTURED_CONVEX; DIFF_EMPTY; SET_RULE `s DIFF {a} = s DELETE a`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `~(x = y) ==> x < y \/ y < x`)) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ONCE_REWRITE_TAC[REWRITE_RULE[IMP_CONJ_ALT] IMP_IMP] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`b:real^N`; `a:real^N`] THEN MATCH_MP_TAC(MESON[] `(!a b. R a b ==> R b a) /\ (!a b. P a b ==> R a b) ==> !a b. P a b \/ P b a ==> R a b`) THEN CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI]; REPEAT STRIP_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN SUBGOAL_THEN `!s t. s DIFF t = {x | x IN s /\ x$k < (b:real^N)$k} DIFF {x | x IN t /\ x$k < b$k} UNION {x:real^N | x IN s /\ (a:real^N)$k < x$k} DIFF {x | x IN t /\ a$k < x$k}` (fun th -> ONCE_REWRITE_TAC[th] THEN ASSUME_TAC(GSYM th)) THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `a < b ==> !x. a < x \/ x < b`)) THEN SET_TAC[]; MATCH_MP_TAC SIMPLY_CONNECTED_UNION THEN ASM_REWRITE_TAC[]] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} = (s DIFF t) INTER {x | P x}`] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]; REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} = (s DIFF t) INTER {x | P x}`] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN REWRITE_TAC[GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`; FINITE_INTER; CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT] THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `&3:int <= x ==> y = x ==> &3 <= y`)) THEN MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN ASM_REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT] THEN ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`; FINITE_INTER; CONVEX_INTER; REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `&3:int <= x ==> y = x ==> &3 <= y`)) THEN MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN ASM_REWRITE_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN ASM SET_TAC[]; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} = (s DIFF t) INTER {x | P x}`] THEN REWRITE_TAC[SET_RULE `(s INTER u) INTER (s INTER v) = s INTER (u INTER v)`; SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF t`] THEN REWRITE_TAC[SET_RULE `s INTER u DIFF s INTER t = s INTER u DIFF t`] THENL [MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; CONVEX_INTER; COLLINEAR_AFF_DIM; CONVEX_HALFSPACE_COMPONENT_LT; REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `&3:int <= x ==> y = x ==> ~(y <= &1)`)) THEN MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_HALFSPACE_COMPONENT_LT; REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN MATCH_MP_TAC(MESON[INFINITE; FINITE_EMPTY] `INFINITE s ==> ~(s = {})`); REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN MATCH_MP_TAC(MESON[FINITE_SUBSET; INFINITE] `INFINITE s /\ FINITE t ==> ~(s SUBSET t)`) THEN ASM_REWRITE_TAC[]] THEN (ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [CONNECTED_FINITE_IFF_SING; INFINITE; CONVEX_CONNECTED; CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT; REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN MATCH_MP_TAC(SET_RULE `!u v. u IN s /\ v IN s /\ ~(u = v) ==> ~(s = {} \/ ?z. s = {z})`) THEN REWRITE_TAC[SET_RULE `{x | P x} INTER {x | Q x} = {x | Q x /\ P x}`] THEN MP_TAC lemma THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [EXISTS_TAC `a$k + &1 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN EXISTS_TAC `a$k + &2 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `c:real` THEN STRIP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN SUBGOAL_THEN `!x:real^N. x$k = basis k dot x` (fun t -> SIMP_TAC[t]) THENL [ASM_MESON_TAC[DOT_BASIS]; MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE] THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_SIMP_TAC[CONVEX_CONNECTED; DOT_BASIS; REAL_LT_IMP_LE]]));; (* ------------------------------------------------------------------------- *) (* Some technical lemmas about extending maps from cell complexes. *) (* ------------------------------------------------------------------------- *) let EXTEND_MAP_CELL_COMPLEX_TO_SPHERE, EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE = (CONJ_PAIR o prove) (`(!f:real^M->real^N m s t. FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c < aff_dim t) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\ s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier t ==> ?g. g continuous_on UNIONS m /\ IMAGE g (UNIONS m) SUBSET relative_frontier t /\ !x. x IN s ==> g x = f x) /\ (!f:real^M->real^N m s t. FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c <= aff_dim t) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\ s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier t ==> ?k g. FINITE k /\ DISJOINT k s /\ g continuous_on (UNIONS m DIFF k) /\ IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\ !x. x IN s ==> g x = f x)`, let wemma = prove (`!h:real^M->real^N k t f. (!s. s IN f ==> ?g. g continuous_on s /\ IMAGE g s SUBSET t /\ !x. x IN s INTER k ==> g x = h x) /\ FINITE f /\ (!s. s IN f ==> closed s) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k) ==> ?g. g continuous_on (UNIONS f) /\ IMAGE g (UNIONS f) SUBSET t /\ !x. x IN (UNIONS f) INTER k ==> g x = h x`, REPLICATE_TAC 3 GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY; INTER_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN ASM_SIMP_TAC[UNIONS_INSERT] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN ASM SET_TAC[]) in let lemma = prove (`!h:real^M->real^N k t f. (!s. s IN f ==> ?g. g continuous_on s /\ IMAGE g s SUBSET t /\ !x. x IN s INTER k ==> g x = h x) /\ FINITE f /\ (!s. s IN f ==> closed s) /\ (!s t. s IN f /\ t IN f /\ ~(s SUBSET t) /\ ~(t SUBSET s) ==> (s INTER t) SUBSET k) ==> ?g. g continuous_on (UNIONS f) /\ IMAGE g (UNIONS f) SUBSET t /\ !x. x IN (UNIONS f) INTER k ==> g x = h x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNIONS_MAXIMAL_SETS) THEN MATCH_MP_TAC wemma THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN ASM SET_TAC[]) in let zemma = prove (`!f:real^M->real^N m n t. FINITE m /\ (!c. c IN m ==> polytope c) /\ n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c < aff_dim t) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\ convex t /\ bounded t /\ f continuous_on (UNIONS n) /\ IMAGE f (UNIONS n) SUBSET relative_frontier t ==> ?g. g continuous_on (UNIONS m) /\ IMAGE g (UNIONS m) SUBSET relative_frontier t /\ (!x. x IN UNIONS n ==> g x = f x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m DIFF n:(real^M->bool)->bool = {}` THENL [SUBGOAL_THEN `(UNIONS m:real^M->bool) SUBSET UNIONS n` ASSUME_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `f:real^M->real^N`] THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!i. &i <= aff_dim t ==> ?g. g continuous_on (UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &i})) /\ IMAGE g (UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &i})) SUBSET relative_frontier t /\ (!x. x IN UNIONS n ==> g x = (f:real^M->real^N) x)` MP_TAC THENL [ALL_TAC; MP_TAC(ISPEC `aff_dim(t:real^N->bool)` INT_OF_NUM_EXISTS) THEN MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_GE; MEMBER_NOT_EMPTY; INT_ARITH `--(&1):int <= s /\ s < t ==> &0 <= t`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN SUBGOAL_THEN `UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &i}) = UNIONS m:real^M->bool` (fun th -> REWRITE_TAC[th]) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[IN_UNION] THEN REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; GEN_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FACE_OF_IMP_SUBSET]; MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SUBSET; IN_UNION] THEN X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `(d:real^M->bool) IN n` THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN EXISTS_TAC `d:real^M->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX] THEN ASM SET_TAC[]]] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [REWRITE_TAC[INT_ARITH `d < &0 <=> (--(&1) <= d ==> d:int = --(&1))`] THEN REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1] THEN SUBGOAL_THEN `{d:real^M->bool| ?c. c IN m /\ d face_of c /\ d = {}} = {{}}` (fun th -> REWRITE_TAC[th]) THENL [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `d:real^M->bool` THEN REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN ASM_CASES_TAC `d:real^M->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_FACE_OF] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_UNION; UNIONS_1; UNION_EMPTY] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN REWRITE_TAC[INT_ARITH `p + &1 <= x <=> p:int < x`] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[INT_LT_IMP_LE] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[INT_ARITH `x:int < p + &1 <=> x <= p`] THEN SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL [ASM_MESON_TAC[AFF_DIM_EMPTY; INT_ARITH `~(&p:int < --(&1))`]; ALL_TAC] THEN SUBGOAL_THEN `~(relative_frontier t:real^N->bool = {})` ASSUME_TAC THENL [ASM_REWRITE_TAC[RELATIVE_FRONTIER_EQ_EMPTY] THEN DISCH_TAC THEN MP_TAC(ISPEC `t:real^N->bool` AFFINE_BOUNDED_EQ_LOWDIM) THEN ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!d. d IN n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p} ==> ?g. (g:real^M->real^N) continuous_on d /\ IMAGE g d SUBSET relative_frontier t /\ !x. x IN d INTER UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p}) ==> g x = h x` MP_TAC THENL [X_GEN_TAC `d:real^M->bool` THEN ASM_CASES_TAC `(d:real^M->bool) SUBSET UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})` THENL [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `h:real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `?a:real^M. d = {a}` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` SUBST_ALL_TAC) THEN DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_SING; SET_RULE `~({a} SUBSET s) ==> ~(x IN {a} INTER s)`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN MATCH_MP_TAC(MESON[] `(?c. P(\x. c)) ==> (?f. P f)`) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(d:real^M->bool = {})` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s SUBSET UNIONS f) ==> ~(s IN f)`)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(d IN s UNION t) /\ d IN s UNION u ==> ~(d IN s) /\ d IN u DIFF t`)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `d IN {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p} DIFF {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p} ==> ?c. c IN m /\ d face_of c /\ (aff_dim d <= &p /\ ~(aff_dim d < &p))`)) THEN REWRITE_TAC[INT_ARITH `d:int <= p /\ ~(d < p) <=> d = p`] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`h:real^M->real^N`; `relative_frontier d:real^M->bool`; `t:real^N->bool`] NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION) THEN ASM_REWRITE_TAC[CLOSED_RELATIVE_FRONTIER; RELATIVE_FRONTIER_EQ_EMPTY] THEN SUBGOAL_THEN `relative_frontier d SUBSET UNIONS {e:real^M->bool | e face_of c /\ aff_dim e < &p}` ASSUME_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC SUBSET_UNIONS THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN X_GEN_TAC `f:real^M->bool` THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[FACE_OF_TRANS]; INT_ARITH_TAC]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM_MESON_TAC[AFFINE_BOUNDED_EQ_TRIVIAL; FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_BOUNDED]; ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_CONVEX]; ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_BOUNDED]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTER_UNIONS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN s ==> P x) ==> t SUBSET s ==> !x. x IN t ==> P x`)) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[] `(d INTER e) face_of d /\ (d INTER e) face_of e ==> (d INTER e) face_of d`) THEN MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_MESON_TAC[FACE_OF_REFL; SUBSET; POLYTOPE_IMP_CONVEX]; REWRITE_TAC[SET_RULE `d INTER e = d <=> d SUBSET e`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[AFF_DIM_SUBSET; INT_NOT_LE]]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] lemma)) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]] THEN CONJ_TAC THENL [REWRITE_TAC[FINITE_UNION] THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN CONJ_TAC THENL [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM_MESON_TAC[FINITE_POLYTOPE_FACES]; REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_IMP_CLOSED; POLYTOPE_IMP_CLOSED; POLYTOPE_IMP_CONVEX; SUBSET]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC) THENL [ASM SET_TAC[]; STRIP_TAC] THEN REWRITE_TAC[UNIONS_UNION] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s SUBSET t UNION u`) THEN MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET UNIONS s`) THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `d INTER e face_of (d:real^M->bool) /\ d INTER e face_of e` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_TRANS]; ALL_TAC] THEN TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX]; ASM SET_TAC[]]) in let memma = prove (`!h:real^M->real^N k t u f. (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\ IMAGE g (s DELETE a) SUBSET t /\ !x. x IN s INTER k ==> g x = h x) /\ FINITE f /\ (!s. s IN f ==> closed s) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k) ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\ g continuous_on (UNIONS f DIFF c) /\ IMAGE g (UNIONS f DIFF c) SUBSET t /\ !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`, REPLICATE_TAC 4 GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY; INTER_EMPTY; NOT_IN_EMPTY; EMPTY_DIFF] THEN CONJ_TAC THENL [MESON_TAC[DISJOINT_EMPTY; FINITE_EMPTY; CARD_CLAUSES; LE_REFL]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN ASM_SIMP_TAC[UNIONS_INSERT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `x <= y ==> x <= SUC y`]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` (X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(a:real^M) INSERT c` THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; RIGHT_EXISTS_AND_THM] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(s DIFF ((a:real^M) INSERT c)) UNION (UNIONS u DIFF ((a:real^M) INSERT c))` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `UNIONS u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNIONS]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); ALL_TAC] THEN ASM SET_TAC[]) in let temma = prove (`!h:real^M->real^N k t u f. (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\ IMAGE g (s DELETE a) SUBSET t /\ !x. x IN s INTER k ==> g x = h x) /\ FINITE f /\ (!s. s IN f ==> closed s) /\ (!s t. s IN f /\ t IN f /\ ~(s SUBSET t) /\ ~(t SUBSET s) ==> (s INTER t) SUBSET k) ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\ g continuous_on (UNIONS f DIFF c) /\ IMAGE g (UNIONS f DIFF c) SUBSET t /\ !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`h:real^M->real^N`; `k:real^M->bool`; `t:real^N->bool`; `u:real^M->bool`; `{t:real^M->bool | t IN f /\ (!u. u IN f ==> ~(t PSUBSET u))}`] memma) THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; UNIONS_MAXIMAL_SETS] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LE_TRANS)) THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_SIMP_TAC[] THEN SET_TAC[]) in let bemma = prove (`!f:real^M->real^N m n t. FINITE m /\ (!c. c IN m ==> polytope c) /\ n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c <= aff_dim t) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\ convex t /\ bounded t /\ f continuous_on (UNIONS n) /\ IMAGE f (UNIONS n) SUBSET relative_frontier t ==> ?k g. FINITE k /\ DISJOINT k (UNIONS n) /\ CARD k <= CARD m /\ g continuous_on (UNIONS m DIFF k) /\ IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\ (!x. x IN UNIONS n ==> g x = f x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `n UNION {d:real^M->bool | ?c. c IN m DIFF n /\ d face_of c /\ aff_dim d < aff_dim(t:real^N->bool)}`; `n:(real^M->bool)->bool`; `t:real^N->bool`] zemma) THEN ASM_REWRITE_TAC[SUBSET_UNION; SET_RULE `(n UNION m) DIFF n = m DIFF n`] THEN SIMP_TAC[IN_DIFF; IN_ELIM_THM; LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[FINITE_UNION] THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN CONJ_TAC THENL [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM_MESON_TAC[FINITE_POLYTOPE_FACES]; REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]; REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SUBSET]; REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_INTER_SUBFACE; SUBSET; FACE_OF_REFL; POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!d. d IN m ==> ?a g. ~(a IN UNIONS n) /\ (g:real^M->real^N) continuous_on (d DELETE a) /\ IMAGE g (d DELETE a) SUBSET relative_frontier t /\ !x. x IN d INTER UNIONS (n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\ d face_of c /\ aff_dim d < aff_dim t}) ==> g x = h x` MP_TAC THENL [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `(d:real^M->bool) SUBSET UNIONS(n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\ d face_of c /\ aff_dim d < aff_dim(t:real^N->bool)})` THENL [SUBGOAL_THEN `~(UNIONS n = (:real^M))` MP_TAC THENL [MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV] `bounded s ==> ~(s = UNIV)`) THEN MATCH_MP_TAC BOUNDED_UNIONS THEN ASM_MESON_TAC[POLYTOPE_IMP_BOUNDED; SUBSET; FINITE_SUBSET]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EXTENSION]] THEN REWRITE_TAC[IN_UNIV; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN EXISTS_TAC `h:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`]; ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN DISJ_CASES_THEN MP_TAC (SPEC `relative_interior(d:real^M->bool) = {}` EXCLUDED_MIDDLE) THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYTOPE_IMP_CONVEX] THEN ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `relative_frontier d SUBSET UNIONS {e:real^M->bool | e face_of d /\ aff_dim e < aff_dim(t:real^N->bool)}` ASSUME_TAC THENL [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC SUBSET_UNIONS THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN ASM_SIMP_TAC[INT_ARITH `d - &1:int < t <=> d <= t`; IN_DIFF]; ALL_TAC] THEN MP_TAC(ISPECL [`d:real^M->bool`; `a:real^M`] RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED] THEN REWRITE_TAC[retract_of; LEFT_IMP_EXISTS_THM; retraction] THEN X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN EXISTS_TAC `(h:real^M->real^N) o (r:real^M->real^M)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `e:real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `e INTER d face_of e /\ e INTER d face_of (d:real^M->bool)` MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FACE_OF_SUBSET_RELATIVE_FRONTIER) o CONJUNCT2) THEN REWRITE_TAC[NOT_IMP; relative_frontier] THEN MP_TAC(ISPEC `d:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[HULL_SUBSET; SET_RULE `s SUBSET t ==> s DELETE a SUBSET t DELETE a`]; REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h t SUBSET u ==> s SUBSET t ==> IMAGE h s SUBSET u`)); SIMP_TAC[INTER_UNIONS; o_THM] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN s ==> r x = x) ==> t SUBSET s ==> !x. x IN t ==> h(r x) = h x`)) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC(MESON[] `(d INTER e) face_of d /\ (d INTER e) face_of e ==> (d INTER e) face_of d`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN MAP_EVERY EXISTS_TAC [`d:real^M->bool`; `c:real^M->bool`] THEN ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE r (h DELETE a) SUBSET t ==> d SUBSET h /\ t SUBSET u ==> IMAGE r (d DELETE a) SUBSET u`)) THEN REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] temma)) THEN ANTS_TAC THENL [ALL_TAC; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]] THEN ASM_SIMP_TAC[POLYTOPE_IMP_CLOSED] THEN MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN STRIP_TAC THEN REWRITE_TAC[UNIONS_UNION] THEN ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET t UNION UNIONS s`) THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `d:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `d INTER e:real^M->bool = d` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN ASM_SIMP_TAC[IN_DIFF] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_MESON_TAC[POLYTOPE_IMP_CONVEX]) in CONJ_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `relative_frontier t:real^N->bool`] NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ENR_IMP_ANR; ENR_RELATIVE_FRONTIER_CONVEX] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`] SEPARATE_COMPACT_CLOSED) THEN ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool) - &1`; `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN ASM_SIMP_TAC[INT_ARITH `x:int <= t - &1 <=> x < t`] THEN DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^M->real^N`; `n:(real^M->bool)->bool`; `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`] zemma) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `diameter(c:real^M->bool)` THEN ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED]]; REPEAT STRIP_TAC THEN SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `relative_frontier t:real^N->bool`] NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ENR_IMP_ANR; ENR_RELATIVE_FRONTIER_CONVEX] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`] SEPARATE_COMPACT_CLOSED) THEN ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool)`; `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^M->real^N`; `n:(real^M->bool)->bool`; `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`] bemma) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT k u ==> s SUBSET u ==> DISJOINT k s`)) THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN (SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `diameter(c:real^M->bool)` THEN ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED])]]);; (* ------------------------------------------------------------------------- *) (* Special cases and corollaries involving spheres. *) (* ------------------------------------------------------------------------- *) let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE = prove (`!f:real^M->real^N s t u. compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\ s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u ==> ?k g. FINITE k /\ k SUBSET t /\ DISJOINT k s /\ g continuous_on (t DIFF k) /\ IMAGE g (t DIFF k) SUBSET relative_frontier u /\ !x. x IN s ==> g x = f x`, let lemma = prove (`!f:A->B->bool P k. INFINITE {x | P x} /\ FINITE k /\ (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> ?x. P x /\ DISJOINT k (f x)`, REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=> ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ASM SET_TAC[]) in SUBGOAL_THEN `!f:real^M->real^N s t u. compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\ s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u ==> ?k g. FINITE k /\ DISJOINT k s /\ g continuous_on (t DIFF k) /\ IMAGE g (t DIFF k) SUBSET relative_frontier u /\ !x. x IN s ==> g x = f x` MP_TAC THENL [ALL_TAC; REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `k INTER t:real^M->bool` THEN ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `!f:real^M->real^N s t u. compact s /\ s SUBSET t /\ affine t /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u ==> ?k g. FINITE k /\ DISJOINT k s /\ g continuous_on (t DIFF k) /\ IMAGE g (t DIFF k) SUBSET relative_frontier u /\ !x. x IN s ==> g x = f x` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN SUBGOAL_THEN `?k g. FINITE k /\ DISJOINT k s /\ g continuous_on (affine hull t DIFF k) /\ IMAGE g (affine hull t DIFF k) SUBSET relative_frontier u /\ !x. x IN s ==> g x = (f:real^M->real^N) x` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN TRANS_TAC SUBSET_TRANS `t:real^M->bool` THEN ASM_REWRITE_TAC[HULL_SUBSET]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN MATCH_MP_TAC IMAGE_SUBSET] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF k SUBSET t DIFF k`) THEN REWRITE_TAC[HULL_SUBSET]]] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN UNDISCH_TAC `bounded(u:real^N->bool)` THEN ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[AFF_DIM_GE; INT_ARITH `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THEN EXISTS_TAC `{a:real^M}` THEN ASM_REWRITE_TAC[DISJOINT_EMPTY; FINITE_SING; NOT_IN_EMPTY; EMPTY_DIFF; DIFF_EQ_EMPTY; IMAGE_CLAUSES; CONTINUOUS_ON_EMPTY; EMPTY_SUBSET]; EXISTS_TAC `{}:real^M->bool` THEN FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN EXISTS_TAC `(\x. y):real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN REWRITE_TAC[INSERT_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `{interval[--(b + vec 1):real^M,b + vec 1] INTER t}`; `s:real^M->bool`; `u:real^N->bool`] EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE) THEN SUBGOAL_THEN `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` ASSUME_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FINITE_SING] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IMP_IMP] THEN REWRITE_TAC[INTER_IDEMPOT; UNIONS_1; FACE_OF_REFL_EQ; SUBSET_INTER] THEN ANTS_TAC THENL [ASM_SIMP_TAC[HULL_SUBSET; COMPACT_IMP_CLOSED] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC POLYTOPE_INTER_POLYHEDRON THEN ASM_SIMP_TAC[POLYTOPE_INTERVAL; AFFINE_IMP_POLYHEDRON]; TRANS_TAC INT_LE_TRANS `aff_dim(t:real^M->bool)` THEN ASM_SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET]; ASM_SIMP_TAC[CONVEX_INTER; CONVEX_INTERVAL; AFFINE_IMP_CONVEX]; ASM SET_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?d:real. (&1 / &2 <= d /\ d <= &1) /\ DISJOINT k (frontier(interval[--(b + lambda i. d):real^M, (b + lambda i. d)]))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC lemma THEN ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN `interval[--b:real^M,b] SUBSET interval(--c,c) /\ interval[--b:real^M,b] SUBSET interval[--c,c] /\ interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `(g:real^M->real^N) o closest_point (interval[--c,c] INTER t)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))]; REWRITE_TAC[IMAGE_o] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN MATCH_MP_TAC IMAGE_SUBSET; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSEST_POINT_SELF THEN ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THEN MATCH_MP_TAC(SET_RULE `closest_point s x IN relative_frontier s /\ DISJOINT k (relative_frontier s) ==> ~(closest_point s x IN k)`) THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o rand o snd) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN ASM SET_TAC[]]));; let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN = prove (`!f:real^M->real^N s t u p. compact s /\ convex u /\ bounded u /\ affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\ (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {})) ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\ g continuous_on (t DIFF k) /\ IMAGE g (t DIFF k) SUBSET relative_frontier u /\ !x. x IN s ==> g x = f x`, let lemma0 = prove (`!u t s v. closed_in (subtopology euclidean u) v /\ t SUBSET u /\ s = v INTER t ==> closed_in (subtopology euclidean t) s`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]) in let lemma1 = prove (`!f:A->B->bool P k. INFINITE {x | P x} /\ FINITE k /\ (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> ?x. P x /\ DISJOINT k (f x)`, REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=> ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ASM SET_TAC[]) in let lemma2 = prove (`!f:real^M->real^N s t k p u. FINITE k /\ affine u /\ f continuous_on ((u:real^M->bool) DIFF k) /\ IMAGE f ((u:real^M->bool) DIFF k) SUBSET t /\ (!c. c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {}) ==> ~(c INTER p = {})) /\ closed_in (subtopology euclidean u) s /\ DISJOINT k s /\ k SUBSET u ==> ?g. g continuous_on ((u:real^M->bool) DIFF p) /\ IMAGE g ((u:real^M->bool) DIFF p) SUBSET t /\ !x. x IN s ==> g x = f x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `k:real^M->bool = {}` THENL [ASM_REWRITE_TAC[DIFF_EMPTY] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_DIFF]; ASM SET_TAC[]]; STRIP_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN SUBGOAL_THEN `~(((u:real^M->bool) DIFF s) INTER k = {})` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `co:real^M->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `locally connected (u:real^M->bool)` ASSUME_TAC THENL [ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_IMP_LOCALLY_CONNECTED]; ALL_TAC] THEN SUBGOAL_THEN `!c. c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {}) ==> ?a g. a IN c /\ a IN p /\ g continuous_on (s UNION (c DELETE a)) /\ IMAGE g (s UNION (c DELETE a)) SUBSET t /\ !x. x IN s ==> g x = (f:real^M->real^N) x` MP_TAC THENL [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `open_in (subtopology euclidean u) (c:real^M->bool)` MP_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u DIFF s:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `u:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th)] THEN REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^M`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `ball(a:real^M,d) INTER u SUBSET c` ASSUME_TAC THENL [ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS; SET_RULE `b SUBSET c ==> b INTER u SUBSET c INTER u`]; ALL_TAC] THEN MP_TAC(ISPECL [`ball(a:real^M,d) INTER u`; `c:real^M->bool`; `s UNION c:real^M->bool`; `c INTER k:real^M->bool`] HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN) THEN ASM_REWRITE_TAC[INTER_SUBSET; SUBSET_UNION; UNION_SUBSET] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN ASM_SIMP_TAC[HULL_MINIMAL; HULL_SUBSET]; MP_TAC(ISPECL [`c:real^M->bool`; `u:real^M->bool`] AFFINE_HULL_OPEN_IN) THEN ASM_SIMP_TAC[HULL_P] THEN ASM SET_TAC[]; REWRITE_TAC[HULL_SUBSET]; ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM_MESON_TAC[FINITE_SUBSET; INTER_SUBSET]; MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; INTER_COMM]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `a:real^M` THEN REWRITE_TAC[CENTRE_IN_BALL] THEN ASM SET_TAC[]]; REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN MP_TAC(ISPECL [`cball(a:real^M,d) INTER u`; `a:real^M`] RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`] RELATIVE_INTERIOR_CONVEX_INTER_AFFINE) THEN MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`] RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN MP_TAC(ISPECL [`u:real^M->bool`; `cball(a:real^M,d)`] (ONCE_REWRITE_RULE[INTER_COMM] AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR)) THEN ASM_SIMP_TAC[CONVEX_CBALL; FRONTIER_CBALL; INTERIOR_CBALL] THEN SUBGOAL_THEN `a IN ball(a:real^M,d) INTER u` ASSUME_TAC THENL [ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN REPLICATE_TAC 3 (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CBALL; AFFINE_IMP_CONVEX] THEN ANTS_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CBALL]; ALL_TAC] THEN ASM_REWRITE_TAC[retract_of; retraction] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) o (k:real^M->real^M) o (\x. if x IN ball(a,d) then r x else x)` THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; AP_TERM_TAC THEN ASM SET_TAC[]]] THEN ABBREV_TAC `j = \x:real^M. if x IN ball(a,d) then r x else x` THEN SUBGOAL_THEN `(j:real^M->real^M) continuous_on ((u:real^M->bool) DELETE a)` ASSUME_TAC THENL [EXPAND_TAC "j" THEN SUBGOAL_THEN `u DELETE (a:real^M) = (cball(a,d) DELETE a) INTER u UNION ((u:real^M->bool) DIFF ball(a,d))` (fun th -> SUBST1_TAC th THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN SUBST1_TAC(SYM th)) THENL [MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_DIFF; IN_INTER; IN_DELETE; CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL [ALL_TAC; ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN ASM SET_TAC[]] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THENL [EXISTS_TAC `cball(a:real^M,d)` THEN REWRITE_TAC[CLOSED_CBALL]; EXISTS_TAC `(:real^M) DIFF ball(a,d)` THEN REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL]] THEN MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (j:real^M->real^M) (s UNION c DELETE a) SUBSET (s UNION c DIFF ball(a,d))` ASSUME_TAC THENL [EXPAND_TAC "j" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SUBGOAL_THEN `(r:real^M->real^M) x IN sphere(a,d)` MP_TAC THENL [MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC]; ONCE_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f u SUBSET t ==> s SUBSET u ==> IMAGE f s SUBSET t`))] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET u ==> IMAGE f u SUBSET t ==> IMAGE f s SUBSET t`)) THEN REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:(real^M->bool)->real^M`; `h:(real^M->bool)->real^M->real^N`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`h:(real^M->bool)->real^M->real^N`; `\c:real^M->bool. s UNION (c DELETE (a c))`; `s UNION UNIONS { c DELETE (a c) | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`; `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`; `(:real^N)`] PASTING_LEMMA_EXISTS_CLOSED) THEN SUBGOAL_THEN `FINITE {c | c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}` ASSUME_TAC THENL [MP_TAC(ISPECL [`\c:real^M->bool. c INTER k`; `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`] FINITE_IMAGE_INJ_EQ) THEN REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [MESON_TAC[COMPONENTS_EQ; SET_RULE `s INTER k = t INTER k /\ ~(s INTER k = {}) ==> ~(s INTER t = {})`]; DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; IN_ELIM_THM]] THEN MP_TAC(ISPEC `{c INTER k |c| c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}` FINITE_UNIONS) THEN MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_ELIM_THM; SUBSET_UNIV] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC lemma0 THEN MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `s UNION c:real^M->bool`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[UNION_SUBSET; UNIONS_SUBSET; FORALL_IN_GSPEC] THEN MESON_TAC[IN_COMPONENTS_SUBSET; SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u`]; ASM_SIMP_TAC[CLOSED_UNION_COMPLEMENT_COMPONENT; UNIONS_GSPEC] THEN MATCH_MP_TAC(SET_RULE `~(a IN t) /\ c DELETE a SUBSET t ==> s UNION c DELETE a = (s UNION c) INTER (s UNION t)`) THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `c':real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; `c:real^M->bool`; `c':real^M->bool`] COMPONENTS_EQ) THEN ASM_CASES_TAC `c':real^M->bool = c` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM SET_TAC[]]; MAP_EVERY X_GEN_TAC [`c1:real^M->bool`; `c2:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN ASM_CASES_TAC `c2:real^M->bool = c1` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `x IN u INTER (s UNION c1 DELETE a) INTER (s UNION c2 DELETE b) ==> (c1 INTER c2 = {}) ==> x IN s`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[COMPONENTS_EQ]; ASM_SIMP_TAC[]]]; DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN MP_TAC (ISPECL [`\x. x IN s UNION UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\ c INTER k = {}}`; `f:real^M->real^N`; `g:real^M->real^N`; `s UNION UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\ c INTER k = {}}`; `s UNION UNIONS { c DELETE (a c) | c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`] CONTINUOUS_ON_CASES_LOCAL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN EXISTS_TAC `u DIFF UNIONS {c DELETE a c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_DELETE THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u DIFF s:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `u:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; ASM_REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN MESON_TAC[IN_COMPONENTS_SUBSET; SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\ c SUBSET u`]; REWRITE_TAC[SET_RULE `(s UNION t) UNION (s UNION u) = (s UNION t) UNION u`] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u /\ t INTER s = {} ==> s = (u DIFF t) INTER (s UNION t)`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN MESON_TAC[IN_COMPONENTS_SUBSET; SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\ c SUBSET u`]; ALL_TAC] THEN REWRITE_TAC[EMPTY_UNION; SET_RULE `c INTER (s UNION t) = (s INTER c) UNION (c INTER t)`] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `t SUBSET UNIV DIFF s ==> s INTER t = {}`) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) MP_TAC) THEN ASM SET_TAC[]; REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; `c:real^M->bool`; `c':real^M->bool`] COMPONENTS_EQ) THEN ASM_CASES_TAC `c':real^M->bool = c` THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]]]; MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN EXISTS_TAC `UNIONS {s UNION c |c| c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN MESON_TAC[IN_COMPONENTS_SUBSET; SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\ c SUBSET u`]; MATCH_MP_TAC(SET_RULE `t SUBSET u /\ u INTER s SUBSET t ==> t = u INTER (s UNION t)`) THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `u INTER t SUBSET s ==> u INTER (s UNION t) SUBSET s UNION v`) THEN MATCH_MP_TAC(SET_RULE `((UNIV DIFF s) INTER t) INTER u SUBSET s ==> t INTER u SUBSET s`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV) [INTER_UNIONS] THEN REWRITE_TAC[SET_RULE `{g x | x IN {f y | P y}} = {g(f y) | P y}`] THEN REWRITE_TAC[SET_RULE `(UNIV DIFF s) INTER (s UNION c) = c DIFF s`] THEN REWRITE_TAC[SET_RULE `t INTER u SUBSET s <=> t INTER ((UNIV DIFF s) INTER u) = {}`] THEN ONCE_REWRITE_TAC[INTER_UNIONS] THEN REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC; INTER_UNIONS] THEN X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; `c:real^M->bool`; `c':real^M->bool`] COMPONENTS_EQ) THEN ASM_CASES_TAC `c':real^M->bool = c` THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) MP_TAC) THEN ASM SET_TAC[]; REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNION] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DELETE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `c:real^M->bool`) (X_CHOOSE_TAC `c':real^M->bool`)) THEN MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; `c:real^M->bool`; `c':real^M->bool`] COMPONENTS_EQ) THEN ASM_CASES_TAC `c':real^M->bool = c` THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]]; MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET] `t SUBSET s /\ P f ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `(s UNION t) UNION (s UNION u) = s UNION (t UNION u)`] THEN MATCH_MP_TAC(SET_RULE `(u DIFF s) DIFF p SUBSET t ==> u DIFF p SUBSET s UNION t`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; SIMP_TAC[IN_UNION]] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_UNION; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^M) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `x IN ((u:real^M->bool) DIFF s)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN REWRITE_TAC[IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `c:real^M->bool`]) THEN ASM_REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]) in let lemma3 = prove (`!f:real^M->real^N s t u p. compact s /\ convex u /\ bounded u /\ affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\ (!c. c IN components(t DIFF s) ==> ~(c INTER p = {})) ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\ g continuous_on (t DIFF k) /\ IMAGE g (t DIFF k) SUBSET relative_frontier u /\ !x. x IN s ==> g x = f x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^M->bool`; `u:real^N->bool`] EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. ?y. x IN k ==> ?c. c IN components (t DIFF s:real^M->bool) /\ x IN c /\ y IN c /\ y IN p` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^M) IN (t DIFF s)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[IN_UNIONS; RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^M` (LABEL_TAC "*"))] THEN EXISTS_TAC `IMAGE (h:real^M->real^M) k` THEN MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`; `relative_frontier u:real^N->bool`; `k:real^M->bool`; `IMAGE (h:real^M->real^M) k`; `t:real^M->bool`] lemma2) THEN ASM_SIMP_TAC[AFFINE_AFFINE_HULL; FINITE_IMAGE] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_IN_IMAGE; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`(t:real^M->bool) DIFF s`; `c:real^M->bool`; `c':real^M->bool`] COMPONENTS_EQ) THEN ASM_CASES_TAC `c':real^M->bool = c` THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_UNIV]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET; IN_DIFF]]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN UNDISCH_TAC `bounded(u:real^N->bool)` THEN ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[AFF_DIM_GE; INT_ARITH `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THENL [EXISTS_TAC `{}:real^M->bool` THEN ASM_REWRITE_TAC[EMPTY_DIFF; FINITE_EMPTY; CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; NOT_IN_EMPTY] THEN SET_TAC[]; FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN ASM_REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF] THEN REWRITE_TAC[CONNECTED_SING; NOT_INSERT_EMPTY; BOUNDED_SING] THEN DISCH_TAC THEN EXISTS_TAC `{a:real^M}` THEN ASM_REWRITE_TAC[DIFF_EQ_EMPTY; CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY; FINITE_SING; IMAGE_CLAUSES; EMPTY_SUBSET] THEN ASM SET_TAC[]]; EXISTS_TAC `{}:real^M->bool` THEN FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN EXISTS_TAC `(\x. y):real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN REWRITE_TAC[INSERT_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^M->bool`; `u:real^N->bool`; `p UNION (UNIONS {c | c IN components (t DIFF s) /\ ~bounded c} DIFF interval[--(b + vec 1):real^M,b + vec 1])`] lemma3) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `bounded(c:real^M->bool)` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(c SUBSET interval[--(b + vec 1):real^M,b + vec 1])` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `k INTER interval[--(b + vec 1):real^M,b + vec 1]` THEN ASM_SIMP_TAC[FINITE_INTER; RIGHT_EXISTS_AND_THM] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN SUBGOAL_THEN `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` ASSUME_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?d:real. (&1 / &2 <= d /\ d <= &1) /\ DISJOINT k (frontier(interval[--(b + lambda i. d):real^M, (b + lambda i. d)]))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC lemma1 THEN ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN `interval[--b:real^M,b] SUBSET interval(--c,c) /\ interval[--b:real^M,b] SUBSET interval[--c,c] /\ interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `(g:real^M->real^N) o closest_point (interval[--c,c] INTER t)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))]; REWRITE_TAC[IMAGE_o] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN MATCH_MP_TAC IMAGE_SUBSET; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSEST_POINT_SELF THEN ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `closest_point s x IN relative_frontier s /\ DISJOINT k (relative_frontier s) ==> ~(closest_point s x IN k)`) THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o rand o snd) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN ASM SET_TAC[]]));; let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE = prove (`!f:real^M->real^N s t a r p. compact s /\ affine t /\ aff_dim t <= &(dimindex(:N)) /\ s SUBSET t /\ &0 <= r /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {})) ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\ g continuous_on (t DIFF k) /\ IMAGE g (t DIFF k) SUBSET sphere(a,r) /\ !x. x IN s ==> g x = f x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r = &0` THENL [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN EXISTS_TAC `{}:real^M->bool` THEN EXISTS_TAC `(\x. a):real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[]; MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN STRIP_TAC THEN MATCH_MP_TAC EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; let EXTEND_MAP_UNIV_TO_SPHERE_COFINITE = prove (`!f:real^M->real^N s a r p. dimindex(:M) <= dimindex(:N) /\ &0 <= r /\ compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ (!c. c IN components((:real^M) DIFF s) /\ bounded c ==> ~(c INTER p = {})) ==> ?k g. FINITE k /\ k SUBSET p /\ DISJOINT k s /\ g continuous_on ((:real^M) DIFF k) /\ IMAGE g ((:real^M) DIFF k) SUBSET sphere(a,r) /\ !x. x IN s ==> g x = f x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`; `a:real^N`; `r:real`; `p:real^M->bool`] EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE) THEN ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV; INT_OF_NUM_LE]);; let EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT = prove (`!f:real^M->real^N s a r. dimindex(:M) <= dimindex(:N) /\ &0 <= r /\ compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ (!c. c IN components((:real^M) DIFF s) ==> ~bounded c) ==> ?g. g continuous_on (:real^M) /\ IMAGE g (:real^M) SUBSET sphere(a,r) /\ !x. x IN s ==> g x = f x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `a:real^N`; `r:real`; `{}:real^M->bool`] EXTEND_MAP_UNIV_TO_SPHERE_COFINITE) THEN ASM_SIMP_TAC[IMP_CONJ; SUBSET_EMPTY; RIGHT_EXISTS_AND_THM] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; DISJOINT_EMPTY; DIFF_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);; let EXTEND_MAP_SPHERE_TO_SPHERE_GEN = prove (`!f:real^M->real^N c s t. closed c /\ c SUBSET relative_frontier s /\ convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s <= aff_dim t /\ f continuous_on c /\ IMAGE f c SUBSET relative_frontier t ==> ?g. g continuous_on (relative_frontier s) /\ IMAGE g (relative_frontier s) SUBSET relative_frontier t /\ !x. x IN c ==> g x = f x`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?p:real^M->bool. polytope p /\ aff_dim p = aff_dim(s:real^M->bool)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC CHOOSE_POLYTOPE THEN ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^M->bool`; `p:real^M->bool`] HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED; homeomorphic] THEN REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^M->real^N) o (k:real^M->real^M)`; `{f:real^M->bool | f face_of p /\ ~(f = p)}`; `IMAGE (h:real^M->real^M) c`; `t:real^N->bool`] EXTEND_MAP_CELL_COMPLEX_TO_SPHERE) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_OF_POLYHEDRON_ALT; POLYTOPE_IMP_POLYHEDRON] THEN REWRITE_TAC[IN_ELIM_THM; GSYM IMAGE_o; o_THM] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{f:real^M->bool | f face_of p}` THEN ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[]; ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; FACE_OF_AFF_DIM_LT; POLYTOPE_IMP_CONVEX; INT_LTE_TRANS]; ASM_MESON_TAC[FACE_OF_INTER; FACE_OF_SUBSET; INTER_SUBSET; FACE_OF_INTER; FACE_OF_IMP_SUBSET]; ASM SET_TAC[]; MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN ASM_SIMP_TAC[BOUNDED_RELATIVE_FRONTIER]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);; let EXTEND_MAP_SPHERE_TO_SPHERE = prove (`!f:real^M->real^N c a r b s. dimindex(:M) <= dimindex(:N) /\ closed c /\ c SUBSET sphere(a,r) /\ f continuous_on c /\ IMAGE f c SUBSET sphere(b,s) /\ (&0 <= r /\ c = {} ==> &0 <= s) ==> ?g. g continuous_on sphere(a,r) /\ IMAGE g (sphere(a,r)) SUBSET sphere(b,s) /\ !x. x IN c ==> g x = f x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET] THENL [MESON_TAC[]; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN ASM_CASES_TAC `sphere(b:real^N,s) = {}` THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SPHERE_EQ_EMPTY]) THEN ASM SET_TAC[]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SPHERE_EQ_EMPTY])] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; CONTINUOUS_ON_SING; REAL_LE_REFL] THENL [ASM_CASES_TAC `c:real^M->bool = {}` THENL [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(MESON[] `(?c. P(\x. c)) ==> ?f. P f`) THEN ASM SET_TAC[]; DISCH_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `s = &0` THENL [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN EXISTS_TAC `(\x. b):real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`; `cball(a:real^M,r)`; `cball(b:real^N,s)`] EXTEND_MAP_SPHERE_TO_SPHERE_GEN) THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN = prove (`!f:real^M->real^N s t u p. convex t /\ bounded t /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u + &1 /\ closed s /\ s SUBSET relative_frontier t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\ (!c. c IN components(relative_frontier t DIFF s) ==> ~(c INTER p = {})) ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET relative_frontier t /\ DISJOINT k s /\ g continuous_on (relative_frontier t DIFF k) /\ IMAGE g (relative_frontier t DIFF k) SUBSET relative_frontier u /\ !x. x IN s ==> g x = f x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s = (relative_frontier t:real^M->bool)` THENL [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[]; POP_ASSUM MP_TAC] THEN ASM_CASES_TAC `relative_frontier t:real^M->bool = {}` THENL [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN SUBGOAL_THEN `?c q:real^M. c IN components (relative_frontier t DIFF s) /\ q IN c /\ q IN relative_frontier t /\ ~(q IN s) /\ q IN p` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `(relative_frontier t:real^M->bool) DIFF s` UNIONS_COMPONENTS) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = u ==> ~(s = {}) ==> ~(u = {})`)) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[EMPTY_UNIONS]] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM IN_DIFF] THEN ASM_MESON_TAC[SUBSET; IN_COMPONENTS_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `?af. affine af /\ aff_dim(t:real^M->bool) = aff_dim(af:real^M->bool) + &1` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`(:real^M)`; `aff_dim(t:real^M->bool) - &1`] CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL [MATCH_MP_TAC(INT_ARITH `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN INT_ARITH_TAC]; ALL_TAC] THEN MP_TAC(ISPECL [`t:real^M->bool`; `af:real^M->bool`; `q:real^M`] HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^M->real^N) o (k:real^M->real^M)`; `IMAGE (h:real^M->real^M) s`; `(af:real^M->bool)`; `u:real^N->bool`; `IMAGE (h:real^M->real^M) (p INTER relative_frontier t DELETE q)`] EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; COMPACT_RELATIVE_FRONTIER_BOUNDED]]; ASM_INT_ARITH_TAC; ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; X_GEN_TAC `l:real^M->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `~(l:real^M->bool = {})` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN SUBGOAL_THEN `?x:real^M. x IN l` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `l SUBSET af DIFF IMAGE (h:real^M->real^M) s` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `connected(l:real^M->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN SUBGOAL_THEN `?r. r IN components (relative_frontier t DIFF s) /\ IMAGE (k:real^M->real^M) l SUBSET r` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `connected_component (relative_frontier t DIFF s) ((k:real^M->real^M) x)` THEN EXISTS_TAC `(k:real^M->real^M) x` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `r SUBSET ((relative_frontier t:real^M->bool) DIFF s)` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `connected(r:real^M->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN ASM_CASES_TAC `(q:real^M) IN r` THENL [ALL_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `(h:real^M->real^M) z` THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN EXISTS_TAC `IMAGE (h:real^M->real^M) r` THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN MATCH_MP_TAC(MESON[] `k(h y) = y /\ k(h y') = y' /\ ~(y = y') ==> k(h y) = k(h y') ==> F`) THEN ASM SET_TAC[]; ASM SET_TAC[]]] THEN SUBGOAL_THEN `?n. open_in (subtopology euclidean (relative_frontier t)) n /\ (q:real^M) IN n /\ n INTER IMAGE (k:real^M->real^M) l = {}` STRIP_ASSUME_TAC THENL [EXISTS_TAC `relative_frontier t DIFF IMAGE (k:real^M->real^M) (closure l)` THEN SUBGOAL_THEN `closure l SUBSET (af:real^M->bool)` ASSUME_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[CLOSED_AFFINE] THEN ASM SET_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; MP_TAC(ISPEC `l:real^M->bool` CLOSURE_SUBSET) THEN SET_TAC[]]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `?w. connected w /\ w SUBSET r DELETE q /\ (k:real^M->real^M) x IN w /\ ~((n DELETE q) INTER w = {})` STRIP_ASSUME_TAC THENL [ALL_TAC; MATCH_MP_TAC(TAUT `F ==> p`) THEN SUBGOAL_THEN `IMAGE (h:real^M->real^M) w SUBSET l` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN MATCH_MP_TAC(MESON[] `k(h y) = y /\ k(h y') = y' /\ ~(y = y') ==> k(h y) = k(h y') ==> F`) THEN ASM SET_TAC[]; ASM SET_TAC[]]] THEN SUBGOAL_THEN `path_connected(r:real^M->bool)` MP_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o snd) THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `(relative_frontier t:real^M->bool) DIFF s` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN ASM_SIMP_TAC[LOCALLY_CONNECTED_SPHERE_GEN]; ALL_TAC] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN DISCH_THEN(MP_TAC o SPECL [`(k:real^M->real^M) x`; `q:real^M`]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o GEN_REWRITE_RULE I [arc]) THEN DISCH_TAC THEN SUBGOAL_THEN `open_in (subtopology euclidean (interval[vec 0,vec 1])) {x | x IN interval[vec 0,vec 1] /\ (g:real^1->real^M) x IN n}` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN REWRITE_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ABBREV_TAC `t' = lift(&1 - min (&1 / &2) r)` THEN SUBGOAL_THEN `t' IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL [EXPAND_TAC "t'" THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `t':real^1`) THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_CBALL; DIST_REAL; DROP_VEC; GSYM drop] THEN ANTS_TAC THENL [EXPAND_TAC "t'" THEN REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN EXISTS_TAC `IMAGE (g:real^1->real^M) (interval[vec 0,t'])` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[GSYM path; SUBSET_INTERVAL_1] THEN ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1]; REWRITE_TAC[SET_RULE `s SUBSET t DELETE q <=> s SUBSET t /\ !x. x IN s ==> ~(x = q)`] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `IMAGE (g:real^1->real^M) (interval[vec 0,vec 1])` THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_SUBSET THEN ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1; SUBSET_INTERVAL_1]; ASM_REWRITE_TAC[GSYM path_image]]; REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `t'':real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t'':real^1`; `vec 1:real^1`]) THEN ASM_REWRITE_TAC[GSYM DROP_EQ] THEN UNDISCH_TAC `t'' IN interval[vec 0:real^1,t']` THEN EXPAND_TAC "t'" THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN CONJ_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN EXPAND_TAC "t'" THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN EXISTS_TAC `t':real^1` THEN CONJ_TAC THENL [EXPAND_TAC "t'" THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[IN_DELETE] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t':real^1`; `vec 1:real^1`]) THEN ASM_REWRITE_TAC[GSYM DROP_EQ] THEN EXPAND_TAC "t'" THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]]]; ALL_TAC] THEN ASM_SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`tk:real^M->bool`; `g:real^M->real^N`] THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THEN EXISTS_TAC `q INSERT IMAGE (k:real^M->real^M) tk` THEN EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN ASM_SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; o_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `a IN t /\ s SUBSET t DELETE a ==> a INSERT s SUBSET t`) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `p INTER (relative_frontier t:real^M->bool) DELETE q` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t SUBSET IMAGE h s ==> IMAGE k (IMAGE h s) SUBSET s ==> IMAGE k t SUBSET s`)) THEN REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = x) ==> IMAGE f s SUBSET s`) THEN REWRITE_TAC[o_THM] THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE = prove (`!f:real^M->real^N s a d b e p. dimindex(:M) <= dimindex(:N) + 1 /\ (&0 < d /\ s = {} ==> &0 <= e) /\ closed s /\ s SUBSET sphere(a,d) /\ f continuous_on s /\ IMAGE f s SUBSET sphere(b,e) /\ (!c. c IN components(sphere(a,d) DIFF s) ==> ~(c INTER p = {})) ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET sphere(a,d) /\ DISJOINT k s /\ g continuous_on (sphere(a,d) DIFF k) /\ IMAGE g (sphere(a,d) DIFF k) SUBSET sphere(b,e) /\ !x. x IN s ==> g x = f x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s = sphere(a:real^M,d)` THENL [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[]; POP_ASSUM MP_TAC] THEN ASM_CASES_TAC `d < &0` THENL [ASM_SIMP_TAC[SPHERE_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `d = &0` THENL [ASM_SIMP_TAC[SPHERE_SING] THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `{a:real^M}` THEN REWRITE_TAC[FINITE_SING; CONTINUOUS_ON_EMPTY; DIFF_EQ_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF; CONNECTED_SING] THEN REWRITE_TAC[IMAGE_CLAUSES] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `e = &0` THENL [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `{}:real^M->bool` THEN EXISTS_TAC `(\x. b):real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[]; REPEAT STRIP_TAC] THEN SUBGOAL_THEN `&0 <= e` ASSUME_TAC THENL [ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[] THEN MP_TAC(SYM(ISPECL [`b:real^N`; `e:real`] SPHERE_EQ_EMPTY)) THEN SIMP_TAC[GSYM REAL_NOT_LT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `cball(a:real^M,d)`; `cball(b:real^N,e)`; `p:real^M->bool`] EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN) THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL] THEN REWRITE_TAC[AFF_DIM_CBALL] THEN MP_TAC(ISPECL [`a:real^M`; `d:real`] RELATIVE_FRONTIER_CBALL) THEN MP_TAC(ISPECL [`b:real^N`; `e:real`] RELATIVE_FRONTIER_CBALL) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE]);; (* ------------------------------------------------------------------------- *) (* Borsuk-style characterization of separation. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_BORSUK_MAP = prove (`!s a:real^N. ~(a IN s) ==> (\x. inv(norm (x - a)) % (x - a)) continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV); ALL_TAC] THEN SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]);; let BORSUK_MAP_INTO_SPHERE = prove (`!s a:real^N. IMAGE (\x. inv(norm (x - a)) % (x - a)) s SUBSET sphere(vec 0,&1) <=> ~(a IN s)`, REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN REWRITE_TAC[REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`] THEN REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN MESON_TAC[]);; let BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT = prove (`!s a b. path_component ((:real^N) DIFF s) a b ==> homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. inv(norm(x - a)) % (x - a)) (\x. inv(norm(x - b)) % (x - b))`, REPEAT GEN_TAC THEN REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DIFF] THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN SIMP_TAC[HOMOTOPIC_WITH] THEN EXISTS_TAC `\z. inv(norm(sndcart z - g(fstcart z))) % (sndcart z - (g:real^1->real^N)(fstcart z))` THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SPHERE_0; SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; NORM_EQ_0; VECTOR_SUB_EQ] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE; ASM_MESON_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN REWRITE_TAC[IMAGE_FSTCART_PCROSS] THEN ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]; REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]]);; let NON_EXTENSIBLE_BORSUK_MAP = prove (`!s c a:real^N. compact s /\ c IN components((:real^N) DIFF s) /\ bounded c /\ a IN c ==> ~(?g. g continuous_on (s UNION c) /\ IMAGE g (s UNION c) SUBSET sphere (vec 0,&1) /\ (!x. x IN s ==> g x = inv(norm(x - a)) % (x - a)))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN SUBGOAL_THEN `c = connected_component ((:real^N) DIFF s) a` SUBST_ALL_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS; CONNECTED_COMPONENT_EQ]; ALL_TAC] THEN MP_TAC(ISPECL [`s UNION connected_component ((:real^N) DIFF s) a`; `a:real^N`] BOUNDED_SUBSET_BALL) THEN ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN REWRITE_TAC[retract_of; retraction] THEN EXISTS_TAC `\x. if x IN connected_component ((:real^N) DIFF s) a then a + r % g(x) else a + r % inv(norm(x - a)) % (x - a)` THEN REWRITE_TAC[SPHERE_SUBSET_CBALL] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `cball(a:real^N,r) = (s UNION connected_component ((:real^N) DIFF s) a) UNION (cball(a,r) DIFF connected_component ((:real^N) DIFF s) a)` SUBST1_TAC THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN ASM_SIMP_TAC[IN_COMPONENTS; COMPACT_IMP_CLOSED; IN_UNIV; IN_DIFF] THEN ASM_MESON_TAC[]; MATCH_MP_TAC CLOSED_DIFF THEN ASM_SIMP_TAC[CLOSED_CBALL; OPEN_CONNECTED_COMPONENT; GSYM closed; COMPACT_IMP_CLOSED]; MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST]; MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC CONTINUOUS_ON_BORSUK_MAP THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; IN_DIFF; REAL_LT_IMP_LE] THEN REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]; REPEAT STRIP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(a:real^N,a + x) = norm x`; NORM_MUL] THEN ASM_SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; VECTOR_SUB_EQ; REAL_FIELD `&0 < r ==> abs r = r /\ (r * x = r <=> x = &1)`; REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`; NORM_EQ_0] THENL [ONCE_REWRITE_TAC[GSYM IN_SPHERE_0] THEN ASM SET_TAC[]; UNDISCH_TAC `~(x IN connected_component ((:real^N) DIFF s) a)` THEN SIMP_TAC[CONTRAPOS_THM; IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]; SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s UNION t SUBSET u ==> !x. x IN t /\ ~(x IN u) ==> wev`)) THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist; IN_BALL; REAL_LT_REFL]]);; let BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT = prove (`!s a. compact s /\ ~(a IN s) ==> (bounded(connected_component ((:real^N) DIFF s) a) <=> ~(?c. homotopic_with (\x. T) (s,sphere(vec 0:real^N,&1)) (\x. inv(norm(x - a)) % (x - a)) (\x. c)))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV; NOT_BOUNDED_UNIV] THEN SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES; CONTINUOUS_ON_EMPTY; EMPTY_SUBSET]; ALL_TAC] THEN EQ_TAC THENL [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`\x:real^N. inv(norm(x - a)) % (x - a)`; `s:real^N->bool`; `vec 0:real^N`; `&1`] NULLHOMOTOPIC_INTO_SPHERE_EXTENSION) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; NOT_IMP; CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE] THEN MP_TAC(ISPECL [`s:real^N->bool`; `connected_component ((:real^N) DIFF s) a`; `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [GEN_REWRITE_TAC RAND_CONV [IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[]; REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; SET_TAC[]]]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?b. b IN connected_component ((:real^N) DIFF s) a /\ ~(b IN ball(vec 0,r))` MP_TAC THENL [REWRITE_TAC[SET_RULE `(?b. b IN s /\ ~(b IN t)) <=> ~(s SUBSET t)`] THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `?c. homotopic_with (\x. T) (ball(vec 0:real^N,r),sphere (vec 0,&1)) (\x. inv (norm (x - b)) % (x - b)) (\x. c)` MP_TAC THENL [MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE; CONVEX_IMP_CONTRACTIBLE; CONVEX_BALL]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN EXISTS_TAC `\x:real^N. inv(norm (x - b)) % (x - b)` THEN CONJ_TAC THENL [MATCH_MP_TAC BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT THEN ASM_SIMP_TAC[OPEN_PATH_CONNECTED_COMPONENT; GSYM closed; COMPACT_IMP_CLOSED] THEN ASM_MESON_TAC[IN]; ASM_MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT]]]);; let HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT = prove (`!s a b. compact s /\ ~(a IN s) /\ ~(b IN s) /\ bounded (connected_component ((:real^N) DIFF s) a) /\ homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. inv(norm(x - a)) % (x - a)) (\x. inv(norm(x - b)) % (x - b)) ==> connected_component ((:real^N) DIFF s) a b`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM IN] THEN MP_TAC(ISPECL [`s:real^N->bool`; `connected_component ((:real^N) DIFF s) a`; `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [GEN_REWRITE_TAC RAND_CONV [IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]] THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN EXISTS_TAC `\x:real^N. inv(norm(x - b)) % (x - b)` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; ANR_SPHERE; CLOSED_SUBSET; SUBSET_UNION] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; IN_UNION; BORSUK_MAP_INTO_SPHERE] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[]);; let BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ = prove (`!s a b. 2 <= dimindex(:N) /\ compact s /\ ~(a IN s) /\ ~(b IN s) ==> (homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. inv(norm(x - a)) % (x - a)) (\x. inv(norm(x - b)) % (x - b)) <=> connected_component ((:real^N) DIFF s) a b)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC; ASM_SIMP_TAC[GSYM OPEN_PATH_CONNECTED_COMPONENT; GSYM closed; COMPACT_IMP_CLOSED] THEN REWRITE_TAC[BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT]] THEN ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) a)` THENL [MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) b)` THENL [ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(:real^N) DIFF s`; `a:real^N`; `b:real^N`] COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV; COMPL_COMPL] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]);; let BORSUK_SEPARATION_THEOREM_GEN = prove (`!s:real^N->bool. compact s ==> ((!c. c IN components((:real^N) DIFF s) ==> ~bounded c) <=> (!f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1) ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c)))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; components; EXISTS_IN_GSPEC; NOT_IMP; IN_UNIV; IN_DIFF] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^N. inv(norm(x - a)) % (x - a)` THEN ASM_SIMP_TAC[GSYM BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT; CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE]] THEN DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`; `vec 0:real^N`; `&1:real`] EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT) THEN ASM_REWRITE_TAC[LE_REFL; REAL_POS] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^N->real^N`; `(:real^N)`; `sphere(vec 0:real^N,&1)`] NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN ASM_SIMP_TAC[]);; let BORSUK_SEPARATION_THEOREM = prove (`!s:real^N->bool. 2 <= dimindex(:N) /\ compact s ==> (connected((:real^N) DIFF s) <=> !f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1) ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c))`, SIMP_TAC[GSYM BORSUK_SEPARATION_THEOREM_GEN] THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ_SING) THEN MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_IMP_UNBOUNDED) THEN ASM_CASES_TAC `(:real^N) DIFF s = {}` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; COMPL_COMPL; BOUNDED_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY]; REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN DISCH_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; COMPL_COMPL]]);; let HOMOTOPY_EQUIVALENT_SEPARATION = prove (`!s t. compact s /\ compact t /\ s homotopy_equivalent t ==> (connected((:real^N) DIFF s) <=> connected((:real^N) DIFF t))`, let special = prove (`!s:real^1->bool. bounded s /\ connected((:real^1) DIFF s) ==> s = {}`, REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; EXTENSION; NOT_IN_EMPTY] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN REWRITE_TAC[IN_UNIV; IN_DIFF; SUBSET; IN_INTERVAL_1] THEN MESON_TAC[REAL_LT_REFL; REAL_LT_IMP_LE]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL [REWRITE_TAC[DIMINDEX_GE_1]; REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`] THEN REWRITE_TAC[GSYM DIMINDEX_1]] THEN STRIP_TAC THENL [ASSUME_TAC(GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`) special) THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`); FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`)] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN DISCH_TAC THEN UNDISCH_TAC `(s:real^N->bool) homotopy_equivalent (t:real^N->bool)` THEN ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY] THEN DISCH_TAC THEN ASM_REWRITE_TAC[CONNECTED_UNIV; DIFF_EMPTY]; REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BORSUK_SEPARATION_THEOREM] THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN ASM_REWRITE_TAC[]]);; let JORDAN_BROUWER_SEPARATION = prove (`!s a:real^N r. &0 < r /\ s homeomorphic sphere(a,r) ==> ~connected((:real^N) DIFF s)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `sphere(a:real^N,r)`] HOMOTOPY_EQUIVALENT_SEPARATION) THEN ANTS_TAC THENL [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE; HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]; DISCH_THEN SUBST1_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(:real^N) DIFF sphere(a,r)`; `ball(a:real^N,r)`] CONNECTED_INTER_FRONTIER) THEN ASM_SIMP_TAC[FRONTIER_BALL; NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN MATCH_MP_TAC(SET_RULE `~(b = {}) ==> ~((UNIV DIFF (c DIFF b)) INTER b = {})`) THEN ASM_SIMP_TAC[BALL_EQ_EMPTY; REAL_NOT_LE]; MATCH_MP_TAC(SET_RULE `~(s UNION t = UNIV) ==> ~(UNIV DIFF t DIFF s = {})`) THEN REWRITE_TAC[BALL_UNION_SPHERE] THEN MESON_TAC[BOUNDED_CBALL; NOT_BOUNDED_UNIV]; SET_TAC[]]);; let JORDAN_BROUWER_FRONTIER = prove (`!s t a:real^N r. 2 <= dimindex(:N) /\ s homeomorphic sphere(a,r) /\ t IN components((:real^N) DIFF s) ==> frontier t = s`, let lemma = prove (`!s a r. 2 <= dimindex(:N) /\ &0 < r /\ s PSUBSET sphere(a,r) ==> connected((:real^N) DIFF s)`, REWRITE_TAC[PSUBSET_ALT; SUBSET; IN_SPHERE; GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(:real^N) DIFF s = {x:real^N | dist(a,x) <= r /\ ~(x IN s)} UNION {x:real^N | r <= dist(a,x) /\ ~(x IN s)}` SUBST1_TAC THENL [SET_TAC[REAL_LE_TOTAL]; MATCH_MP_TAC CONNECTED_UNION] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `ball(a:real^N,r)` THEN ASM_SIMP_TAC[CONNECTED_BALL; CLOSURE_BALL; SUBSET; IN_BALL; IN_CBALL; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE]; MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `(:real^N) DIFF cball(a,r)` THEN REWRITE_TAC[CLOSURE_COMPLEMENT; SUBSET; IN_DIFF; IN_UNIV; IN_BALL; IN_CBALL; IN_ELIM_THM; INTERIOR_CBALL] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE]] THEN MATCH_MP_TAC CONNECTED_OPEN_DIFF_CBALL THEN ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV; OPEN_UNIV]; ASM SET_TAC[]]) in MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `c:real^N->bool`; `a:real^N`; `r:real`] THEN ASM_CASES_TAC `r < &0` THENL [ASM_SIMP_TAC[SPHERE_EMPTY; HOMEOMORPHIC_EMPTY; IMP_CONJ; DIFF_EMPTY] THEN SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING)); UNIV_NOT_EMPTY; CONNECTED_UNIV; IN_SING; FRONTIER_UNIV]; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THENL [ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; SPHERE_SING; FINITE_SING] THEN SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; GSYM HAS_SIZE; NOT_IN_EMPTY] THEN REWRITE_TAC[HAS_SIZE_CLAUSES; UNWIND_THM2; NOT_IN_EMPTY; IMP_CONJ] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; CONNECTED_PUNCTURED_UNIVERSE; IN_SING; snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING)); FRONTIER_SING; SET_RULE `UNIV DIFF s = {} <=> s = UNIV`; FRONTIER_COMPLEMENT; MESON[BOUNDED_SING; NOT_BOUNDED_UNIV] `~((:real^N) = {a})`]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED] THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[JORDAN_BROUWER_SEPARATION]; ALL_TAC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`t:real^N->bool`; `IMAGE (f:real^N->real^N) t`] HOMOTOPY_EQUIVALENT_SEPARATION) THEN ANTS_TAC THENL [MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; PSUBSET]; DISCH_TAC THEN SUBGOAL_THEN `t homeomorphic (IMAGE (f:real^N->real^N) t)` MP_TAC THENL [REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN ASM_REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]]]; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`] THEN ASM SET_TAC[]]);; let JORDAN_BROUWER_NONSEPARATION_STRONG = prove (`!s t a:real^N r. 2 <= dimindex(:N) /\ s homeomorphic sphere(a,r) /\ t PSUBSET s ==> path_connected((:real^N) DIFF t)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!c. c IN components((:real^N) DIFF s) ==> path_connected(c UNION (s DIFF t))` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `c:real^N->bool`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_ANRNESS) THEN REWRITE_TAC[COMPACT_SPHERE; ANR_SPHERE] THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN REWRITE_TAC[UNION_SUBSET; CLOSURE_SUBSET; CLOSURE_UNION_FRONTIER] THEN MATCH_MP_TAC(SET_RULE `f = s ==> s DIFF t SUBSET k UNION f`) THEN MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(components((:real^N) DIFF s) = {})` ASSUME_TAC THENL [REWRITE_TAC[COMPONENTS_EQ_EMPTY; SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN ASM_MESON_TAC[NOT_BOUNDED_UNIV; COMPACT_EQ_BOUNDED_CLOSED; HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE]; ALL_TAC] THEN SUBGOAL_THEN `(:real^N) DIFF t = UNIONS {c UNION (s DIFF t) | c | c IN components((:real^N) DIFF s)}` SUBST1_TAC THENL [MP_TAC(ISPEC `(:real^N) DIFF s` UNIONS_COMPONENTS) THEN REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; MATCH_MP_TAC PATH_CONNECTED_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]]);; let JORDAN_BROUWER_NONSEPARATION = prove (`!s t a:real^N r. 2 <= dimindex(:N) /\ s homeomorphic sphere(a,r) /\ t PSUBSET s ==> connected((:real^N) DIFF t)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP JORDAN_BROUWER_NONSEPARATION_STRONG) THEN REWRITE_TAC[PATH_CONNECTED_IMP_CONNECTED]);; let JORDAN_BROUWER_ACCESSIBILITY = prove (`!s c a:real^N r x y. 2 <= dimindex(:N) /\ s homeomorphic sphere(a,r) /\ c IN components((:real^N) DIFF s) /\ x IN c /\ y IN s ==> ?g. arc g /\ pathstart g = x /\ pathfinish g = y /\ IMAGE g (interval[vec 0,vec 1] DELETE (vec 1)) SUBSET c`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN MATCH_MP_TAC ACCESSIBLE_FRONTIER_ANR_COMPLEMENT_COMPONENT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN REWRITE_TAC[COMPACT_SPHERE]; FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_ANRNESS) THEN REWRITE_TAC[ANR_SPHERE]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> t = s ==> x IN t`)) THEN MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN ASM_MESON_TAC[]]);; let HOMOTOPY_EQUIVALENT_SEPARATION_SPHERE = prove (`!s t:real^N->bool a r. s SUBSET sphere(a,r) /\ t SUBSET sphere(a,r) /\ compact s /\ compact t /\ s homotopy_equivalent t ==> (connected (sphere(a,r) DIFF s) <=> connected(sphere(a,r) DIFF t))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL [REWRITE_TAC[CONNECTED_EQ_CARD_COMPONENTS] THEN SUBGOAL_THEN `FINITE(s:real^N->bool) /\ FINITE(t:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS) THEN ASM_SIMP_TAC[FINITE_IMP_TOTALLY_DISCONNECTED; FINITE_DIFF; FINITE_IMAGE; CARD_IMAGE_INJ; SET_RULE `{a} = {b} <=> a = b`] THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_EQ_IMAGE o rand o lhand o snd) THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_EQ_IMAGE o lhand o lhand o rand o snd) THEN SIMP_TAC[SET_RULE `{a} = {b} <=> a = b`] THEN GEN_REWRITE_TAC LAND_CONV [CARD_EQ_SYM] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r ==> s <=> p /\ r ==> q ==> s`] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_TRANS) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP CARD_EQ_TRANS) THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CARD_DIFF] THEN MATCH_MP_TAC(ARITH_RULE `m:num <= n /\ p <= n /\ m = p ==> n - m = n - p`) THEN ASM_SIMP_TAC[CARD_SUBSET] THEN MATCH_MP_TAC CARD_EQ_CARD_IMP THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FINITE_SPHERE]) THEN REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN ASM_CASES_TAC `dimindex(:N) = 2` THENL [ASM_SIMP_TAC[CONNECTED_COMPLEMENT_SUBSET_CIRCLE] THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONNECTEDNESS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s PSUBSET sphere(a:real^N,r) <=> t PSUBSET sphere(a:real^N,r)` ASSUME_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] HOMOTOPY_EQUIVALENT_SEPARATION) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`sphere(a:real^N,r)`; `s:real^N->bool`; `a:real^N`; `r:real`] JORDAN_BROUWER_NONSEPARATION) THEN MP_TAC(ISPECL[`sphere(a:real^N,r)`; `t:real^N->bool`; `a:real^N`; `r:real`] JORDAN_BROUWER_NONSEPARATION) THEN MP_TAC(ISPECL[`sphere(a:real^N,r)`; `a:real^N`; `r:real`] JORDAN_BROUWER_SEPARATION) THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> s PSUBSET t \/ s = t`))) THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `(s PSUBSET u <=> t PSUBSET u) ==> s SUBSET u /\ t SUBSET u ==> s = u /\ t = u \/ s PSUBSET u /\ t PSUBSET u`)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[DIFF_EQ_EMPTY] THEN SUBGOAL_THEN `?w z:real^N. w IN sphere(a,r) /\ z IN sphere(a,r) /\ ~(w IN s) /\ ~(z IN t)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(sphere(a:real^N,r) DELETE w) homeomorphic (:real^(N,1)finite_diff)` MP_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN ASM_ARITH_TAC; REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^(N,1)finite_diff`; `g:real^(N,1)finite_diff->real^N`] THEN DISCH_TAC THEN SUBGOAL_THEN `(sphere(a:real^N,r) DELETE z) homeomorphic (:real^(N,1)finite_diff)` MP_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN ASM_ARITH_TAC; REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^(N,1)finite_diff`; `k:real^(N,1)finite_diff->real^N`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`IMAGE (f:real^N->real^(N,1)finite_diff) s`; `IMAGE (h:real^N->real^(N,1)finite_diff) t`] HOMOTOPY_EQUIVALENT_SEPARATION) THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPACTNESS; SET_RULE `s SUBSET t /\ ~(a IN s) ==> s SUBSET t DELETE a`]; TRANS_TAC HOMOTOPY_EQUIVALENT_TRANS `s:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; TRANS_TAC HOMOTOPY_EQUIVALENT_TRANS `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM]] THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN MATCH_MP_TAC HOMEOMORPHIC_SELF_IMAGE THEN ASM_MESON_TAC[SET_RULE `s SUBSET t /\ ~(a IN s) ==> s SUBSET t DELETE a`]]; ALL_TAC] THEN SUBGOAL_THEN `UNIV DIFF IMAGE (f:real^N->real^(N,1)finite_diff) s = IMAGE f ((sphere(a,r) DELETE w) DIFF s) /\ UNIV DIFF IMAGE (h:real^N->real^(N,1)finite_diff) t = IMAGE h ((sphere(a,r) DELETE z) DIFF t)` (fun th -> REWRITE_TAC[th]) THENL [CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `IMAGE f (s DIFF t) = IMAGE f s DIFF IMAGE f t /\ IMAGE f s DIFF IMAGE f t = u ==> u = IMAGE f (s DIFF t)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_UNIV]) THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC IMAGE_DIFF_INJ_ALT THEN ASM_REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; SUBSET_DELETE] THEN ASM_MESON_TAC[]; MATCH_MP_TAC EQ_IMP] THEN BINOP_TAC THEN FIRST_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CONNECTEDNESS) th) o lhand o snd)) THEN REWRITE_TAC[SUBSET_DIFF] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SET_RULE `s DELETE a DIFF t = (s DIFF t) DELETE a`] THEN MATCH_MP_TAC CONNECTED_OPEN_IN_SPHERE_DELETE_EQ THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`] THEN ASM_SIMP_TAC[OPEN_IN_DIFF_CLOSED; COMPACT_IMP_CLOSED] THEN ASM_ARITH_TAC);; let HOMEOMORPHIC_SEPARATION_SPHERE = prove (`!s t:real^N->bool a r. s SUBSET sphere(a,r) /\ t SUBSET sphere(a,r) /\ s homeomorphic t ==> (connected (sphere(a,r) DIFF s) <=> connected(sphere(a,r) DIFF t))`, SUBGOAL_THEN `!s t:real^N->bool a r. s SUBSET sphere(a,r) /\ t SUBSET sphere(a,r) /\ s homeomorphic t ==> connected (sphere(a,r) DIFF t) ==> connected(sphere(a,r) DIFF s)` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN EQ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN ASM_REWRITE_TAC[]] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_SIMP_TAC[SEPARATION_BY_CLOSED_INTERMEDIATES_EQ; LOCALLY_CONNECTED_SPHERE] THEN SIMP_TAC[CLOSED_IN_CLOSED_EQ; CLOSED_SPHERE] THEN SUBGOAL_THEN `!c:real^N->bool. closed c /\ c SUBSET sphere(a,r) <=> compact c /\ c SUBSET sphere(a,r)` (fun th -> REWRITE_TAC[th] THEN REWRITE_TAC[GSYM CONJ_ASSOC]) THENL [MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_SPHERE]; DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:real^N->real^N) c` THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC])] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (g:real^N->real^N) d`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SEPARATION_SPHERE THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN MATCH_MP_TAC HOMEOMORPHIC_SELF_IMAGE THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `t:real^N->bool`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[homeomorphism]]]);; let HOMEOMORPHIC_SEPARATION = prove (`!s t. bounded s /\ bounded t /\ s homeomorphic t ==> (connected((:real^N) DIFF s) <=> connected((:real^N) DIFF t))`, SUBGOAL_THEN `!s t. bounded s /\ bounded t /\ s homeomorphic t /\ connected((:real^N) DIFF s) ==> connected((:real^N) DIFF t)` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SYM]] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [ASM_SIMP_TAC[IMP_CONJ; BOUNDED_SEPARATION_1D] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY]; FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN REPEAT STRIP_TAC] THEN SUBGOAL_THEN `basis 1 IN sphere(vec 0:real^(N,1)finite_sum,&1)` ASSUME_TAC THENL [SIMP_TAC[IN_SPHERE_0; NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; ABBREV_TAC `a:real^(N,1)finite_sum = basis 1` THEN FIRST_X_ASSUM(K ALL_TAC o SYM)] THEN SUBGOAL_THEN `(sphere(vec 0:real^(N,1)finite_sum,&1) DELETE a) homeomorphic (:real^N)` MP_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; REAL_LT_01]; REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM] THEN MAP_EVERY X_GEN_TAC [`g:real^(N,1)finite_sum->real^N`; `f:real^N->real^(N,1)finite_sum`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (f:real^N->real^(N,1)finite_sum) s`; `IMAGE (f:real^N->real^(N,1)finite_sum) t`; `vec 0:real^(N,1)finite_sum`; `&1`] HOMEOMORPHIC_SEPARATION_SPHERE) THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; TRANS_TAC HOMEOMORPHIC_TRANS `s:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; TRANS_TAC HOMEOMORPHIC_TRANS `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN MATCH_MP_TAC HOMEOMORPHIC_SELF_IMAGE THEN ASM_MESON_TAC[HOMEOMORPHIC_SELF_IMAGE; SUBSET_UNIV]]; MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`)] THEN CONJ_TAC THENL [SUBGOAL_THEN `sphere (vec 0,&1) DIFF IMAGE f s = a INSERT IMAGE (f:real^N->real^(N,1)finite_sum) (UNIV DIFF s)` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH (lhand o rand) CONNECTED_INSERT o snd)] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_UNIV; HOMEOMORPHISM_CONNECTEDNESS]; DISCH_THEN SUBST1_TAC] THEN DISJ2_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SET_RULE `s DELETE a = s DIFF {a}`]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] BOUNDED_IMAGE_IN_COMPACTIFICATION)) THEN REWRITE_TAC[SET_RULE `(p <=> s INTER {a} = {}) <=> (a IN s <=> ~p)`] THEN SIMP_TAC[COMPACT_SPHERE; CLOSED_UNIV; SUBSET_UNIV] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN ASM_REWRITE_TAC[COMPL_COMPL]; DISCH_TAC THEN SUBGOAL_THEN `(:real^N) DIFF t = IMAGE (g:real^(N,1)finite_sum->real^N) ((sphere(vec 0,&1) DIFF IMAGE f t) DELETE a)` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_UNIV]) THEN ONCE_REWRITE_TAC[SET_RULE `(s DIFF t) DELETE a = s DELETE a DIFF t`] THEN MATCH_MP_TAC(SET_RULE `IMAGE f (s DIFF t) = IMAGE f s DIFF IMAGE f t /\ IMAGE f s = u /\ IMAGE f t = v ==> u DIFF v = IMAGE f (s DIFF t)`) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM_SYM]) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CONNECTEDNESS)) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o snd)) THEN ANTS_TAC THENL [SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `~(a IN IMAGE (f:real^N->real^(N,1)finite_sum) (closure t))` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `t:real^N->bool` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE)) THEN REWRITE_TAC[SUBSET_UNIV; INTER_UNIV] THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`vec 0:real^(N,1)finite_sum`; `a:real^(N,1)finite_sum`; `&1`; `sphere (vec 0,&1) DIFF IMAGE (f:real^N->real^(N,1)finite_sum) (closure t)`; `sphere (vec 0,&1) DIFF IMAGE (f:real^N->real^(N,1)finite_sum) t`] CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ) THEN ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; SUBSET_DIFF] THEN REPEAT CONJ_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]]);; let CONNECTED_COMPLEMENT_CONTRACTIBLE = prove (`!s. 2 <= dimindex(:N) /\ compact s /\ contractible s ==> connected((:real^N) DIFF s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY; CONNECTED_UNIV] THEN MP_TAC(ISPECL [`s:real^N->bool`; `{a:real^N}`] HOMOTOPY_EQUIVALENT_SEPARATION) THEN ASM_SIMP_TAC[HOMOTOPY_EQUIVALENT_SING; COMPACT_SING; AR_SING; CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT]);; let CONNECTED_COMPLEMENT_SIMPLE_PATH_IMAGE = prove (`!g. 3 <= dimindex(:N) /\ simple_path g ==> connected((:real^N) DIFF path_image g)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `arc(g:real^1->real^N)` THEN ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> 2 <= n`; CONNECTED_ARC_COMPLEMENT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [ARC_SIMPLE_PATH]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`path_image g:real^N->bool`; `relative_frontier(convex hull {vec 0:real^N,basis 1,basis 2})`] HOMOTOPY_EQUIVALENT_SEPARATION) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN SIMP_TAC[COMPACT_RELATIVE_FRONTIER; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY] THEN ANTS_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN TRANS_TAC HOMEOMORPHIC_TRANS `relative_frontier(cball(vec 0:real^2,&1))` THEN CONJ_TAC THENL [SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_OF_NUM_EQ; ARITH_EQ] THEN ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01]; MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS THEN REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[BOUNDED_CONVEX_HULL_EQ; BOUNDED_INSERT; BOUNDED_EMPTY] THEN REWRITE_TAC[AFF_DIM_CBALL; REAL_LT_01] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL; DIMINDEX_2] THEN SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; IN_INSERT; INT_OF_NUM_EQ] THEN REWRITE_TAC[DIM_INSERT_0] THEN REWRITE_TAC[DIM_INSERT; SPAN_SING; DIM_SING; SPAN_EMPTY; IN_SING] THEN ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_2; ARITH; DIM_EMPTY; ARITH_RULE `3 <= n ==> 2 <= n`] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real` MP_TAC) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$1`) THEN ASM_SIMP_TAC[BASIS_COMPONENT; VECTOR_MUL_COMPONENT; ARITH; ARITH_RULE `3 <= n ==> 1 <= n /\ 2 <= n`] THEN REAL_ARITH_TAC]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) RELATIVE_FRONTIER_OF_TRIANGLE o rand o rand o snd) THEN ASM_SIMP_TAC[COLLINEAR_LEMMA; BASIS_NONZERO; DIMINDEX_2; ARITH; DIM_EMPTY; ARITH_RULE `3 <= n ==> 1 <= n /\ 2 <= n`] THEN ANTS_TAC THENL [DISCH_THEN(CHOOSE_THEN (MP_TAC o AP_TERM `\x:real^N. x$2`)) THEN ASM_SIMP_TAC[BASIS_COMPONENT; VECTOR_MUL_COMPONENT; ARITH; ARITH_RULE `3 <= n ==> 1 <= n /\ 2 <= n`] THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[SET_RULE `a UNION b UNION c = UNIONS {a,b,c}`] THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM THEN REWRITE_TAC[CONNECTED_UNIV; AFFINE_HULL_UNIV; OPEN_IN_REFL] THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; FORALL_IN_INSERT] THEN REWRITE_TAC[NOT_IN_EMPTY; CLOSED_SEGMENT; AFF_DIM_SEGMENT] THEN REWRITE_TAC[AFF_DIM_UNIV] THEN REPEAT CONJ_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC);; let PATH_CONNECTED_PSUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE = prove (`!g s:real^N->bool. 2 <= dimindex(:N) /\ simple_path g /\ (:real^N) DIFF path_image g PSUBSET s ==> path_connected s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `arc(g:real^1->real^N)` THENL [MATCH_MP_TAC PATH_CONNECTED_SUPERSET_COMPLEMENT_ARC_IMAGE THEN ASM_MESON_TAC[PSUBSET]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [ARC_SIMPLE_PATH]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN ASM_CASES_TAC `3 <= dimindex(:N)` THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT THEN EXISTS_TAC `path_image g:real^N->bool` THEN EXISTS_TAC `(:real^N) DIFF path_image g` THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN ASM_SIMP_TAC[ANR_PATH_IMAGE_SIMPLE_PATH; IN_COMPONENTS_SELF] THEN ASM_SIMP_TAC[CONNECTED_COMPLEMENT_SIMPLE_PATH_IMAGE] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN ASM_MESON_TAC[SIMPLE_PATH_IMP_PATH; BOUNDED_PATH_IMAGE; BOUNDED_SUBSET; NOT_BOUNDED_UNIV]; ASM SET_TAC[]; REWRITE_TAC[CLOSURE_COMPLEMENT] THEN ASM_SIMP_TAC[INTERIOR_SIMPLE_PATH_IMAGE] THEN SET_TAC[]]; GEN_REWRITE_TAC RAND_CONV [GSYM COMPL_COMPL] THEN MATCH_MP_TAC JORDAN_BROUWER_NONSEPARATION_STRONG THEN MAP_EVERY EXISTS_TAC [`path_image g:real^N->bool`; `vec 0:real^N`; `&1`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN TRANS_TAC HOMEOMORPHIC_TRANS `sphere(vec 0:real^2,&1)` THEN ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01] THEN REWRITE_TAC[GSYM (CONV_RULE REAL_RAT_REDUCE_CONV (ISPECL [`x:real^N`; `&1`] RELATIVE_FRONTIER_CBALL))] THEN MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS THEN REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN REWRITE_TAC[REAL_LT_01; INT_OF_NUM_EQ; DIMINDEX_2] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Invariance of domain and corollaries. *) (* ------------------------------------------------------------------------- *) let INVARIANCE_OF_DOMAIN = prove (`!f:real^N->real^N s. f continuous_on s /\ open s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> open(IMAGE f s)`, let lemma = prove (`!f:real^N->real^N a r. f continuous_on cball(a,r) /\ &0 < r /\ (!x y. x IN cball(a,r) /\ y IN cball(a,r) /\ f x = f y ==> x = y) ==> open(IMAGE f (ball(a,r)))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] ISOMETRIES_SUBSPACES) THEN ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; DIMINDEX_1; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `k:real^1->real^N`] THEN REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(h:real^N->real^1) o f o (k:real^1->real^N)`; `IMAGE (h:real^N->real^1) (cball(a,r))`] INJECTIVE_EQ_1D_OPEN_MAP_UNIV) THEN MATCH_MP_TAC(TAUT `p /\ q /\ r /\ (s ==> t) ==> (p /\ q ==> (r <=> s)) ==> t`) THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; GSYM IMAGE_o] THEN ASM_REWRITE_TAC[o_DEF; IMAGE_ID]; REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CBALL]; ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; o_DEF] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `IMAGE (h:real^N->real^1) (ball(a,r))`) THEN ASM_SIMP_TAC[IMAGE_SUBSET; BALL_SUBSET_CBALL; GSYM IMAGE_o] THEN ANTS_TAC THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`] OPEN_BALL); ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THENL [CONV_TAC SYM_CONV; REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[IMAGE_o] THEN ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN MATCH_MP_TAC OPEN_BIJECTIVE_LINEAR_IMAGE_EQ THEN ASM_MESON_TAC[]]; FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (f:real^N->real^N) (sphere(a,r))`; `a:real^N`; `r:real`] JORDAN_BROUWER_SEPARATION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `f:real^N->real^N` THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL; COMPACT_SPHERE]; DISCH_TAC] THEN MP_TAC(ISPEC `(:real^N) DIFF IMAGE f (sphere(a:real^N,r))` COBOUNDED_HAS_BOUNDED_COMPONENT) THEN ASM_REWRITE_TAC[COMPL_COMPL] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL; COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_BOUNDED]; DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `IMAGE (f:real^N->real^N) (ball(a,r)) = c` SUBST1_TAC THENL [ALL_TAC; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_COMPONENTS)) THEN REWRITE_TAC[GSYM closed] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL; COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_CLOSED]] THEN MATCH_MP_TAC(SET_RULE `~(c = {}) /\ (~(c INTER t = {}) ==> t SUBSET c) /\ c SUBSET t ==> t = c`) THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_BALL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; BALL_SUBSET_CBALL]; REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN ASM SET_TAC[]]; FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_ASSUM(MP_TAC o SPEC `(:real^N) DIFF IMAGE f (cball(a:real^N,r))` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN SIMP_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`; IMAGE_SUBSET; SPHERE_SUBSET_CBALL] THEN MATCH_MP_TAC(TAUT `p /\ ~r /\ (~q ==> s) ==> (p /\ q ==> r) ==> s`) THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(INST_TYPE [`:N`,`:M`] CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN EXISTS_TAC `cball(a:real^N,r)` THEN ASM_REWRITE_TAC[CONVEX_CBALL; COMPACT_CBALL] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[COMPACT_CBALL]; DISCH_THEN(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN REWRITE_TAC[COMPL_COMPL] THEN ASM_MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE; COMPACT_CBALL]; REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]]]) in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:real^N->real^N) (ball(a,r))` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC lemma THEN ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ASM_SIMP_TAC[FUN_IN_IMAGE; CENTRE_IN_BALL]; MATCH_MP_TAC IMAGE_SUBSET THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]]);; let INVARIANCE_OF_DOMAIN_SUBSPACES = prove (`!f:real^M->real^N u v s. subspace u /\ subspace v /\ dim v <= dim u /\ f continuous_on s /\ IMAGE f s SUBSET v /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ open_in (subtopology euclidean u) s ==> open_in (subtopology euclidean v) (IMAGE f s)`, let lemma0 = prove (`!f:real^M->real^M s u. subspace s /\ dim s = dimindex(:N) /\ f continuous_on u /\ IMAGE f u SUBSET s /\ (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\ open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean s) (IMAGE f u)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^M->bool`] HOMEOMORPHIC_SUBSPACES) THEN ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV] THEN REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(k:real^M->real^N) o f o (h:real^N->real^M)`; `IMAGE (k:real^M->real^N) u`] INVARIANCE_OF_DOMAIN) THEN REWRITE_TAC[GSYM IMAGE_o; o_THM] THEN SUBGOAL_THEN `!t. open t <=> open_in (subtopology euclidean (IMAGE (k:real^M->real^N) s)) t` (fun th -> REWRITE_TAC[th]) THENL [ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[homeomorphism]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]; ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `IMAGE f u = IMAGE (h:real^N->real^M) (IMAGE ((k o f o h) o (k:real^M->real^N)) u)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`k:real^M->real^N`; `(:real^N)`] THEN ASM_REWRITE_TAC[homeomorphism]]]) in let lemma1 = prove (`!f:real^N->real^N s u. subspace s /\ f continuous_on u /\ IMAGE f u SUBSET s /\ (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\ open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean s) (IMAGE f u)`, REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ABBREV_TAC `s' = {y:real^N | !x. x IN s ==> orthogonal x y}` THEN SUBGOAL_THEN `subspace(s':real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "s'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS]; FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_IMP_NONEMPTY)] THEN ABBREV_TAC `g:real^(N,N)finite_sum->real^(N,N)finite_sum = \z. pastecart (f(fstcart z)) (sndcart z)` THEN SUBGOAL_THEN `g continuous_on ((u:real^N->bool) PCROSS s') /\ IMAGE g (u PCROSS s') SUBSET (s:real^N->bool) PCROSS (s':real^N->bool) /\ (!w z. w IN u PCROSS s' /\ z IN u PCROSS s' ==> (g w = g z <=> w = z))` STRIP_ASSUME_TAC THENL [EXPAND_TAC "g" THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN SIMP_TAC[PASTECART_IN_PCROSS; SNDCART_PASTECART; FSTCART_PASTECART] THEN ASM SET_TAC[]; EXPAND_TAC "g" THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_SIMP_TAC[PASTECART_INJ]]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean (s PCROSS s')) (IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum) (u PCROSS s'))` MP_TAC THENL [MATCH_MP_TAC lemma0 THEN ASM_SIMP_TAC[SUBSPACE_PCROSS; OPEN_IN_PCROSS_EQ; OPEN_IN_REFL] THEN CONJ_TAC THENL [ASM_SIMP_TAC[DIM_PCROSS]; ASM_MESON_TAC[]] THEN MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN ASM_REWRITE_TAC[SUBSET_UNIV; SUBSPACE_UNIV; IN_UNIV; DIM_UNIV] THEN ARITH_TAC; SUBGOAL_THEN `IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum) (u PCROSS s') = IMAGE f u PCROSS s'` SUBST1_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[EXTENSION; EXISTS_PASTECART; PASTECART_IN_PCROSS; IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; IMAGE_EQ_EMPTY] THEN STRIP_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY]]]) in REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`] CHOOSE_SUBSPACE_OF_SUBSPACE) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`v:real^N->bool`; `v:real^M->bool`] HOMEOMORPHIC_SUBSPACES) THEN ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = IMAGE (k:real^M->real^N) (IMAGE ((h:real^N->real^M) o f) s)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN u ==> f x = g x) ==> IMAGE f u = IMAGE g u`) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `v:real^M->bool`] THEN ASM_REWRITE_TAC[homeomorphism] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN ASM_REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC lemma1 THEN ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);; let INVARIANCE_OF_DIMENSION_SUBSPACES = prove (`!f:real^M->real^N u v s. subspace u /\ subspace v /\ ~(s = {}) /\ open_in (subtopology euclidean u) s /\ f continuous_on s /\ IMAGE f s SUBSET v /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> dim u <= dim v`, REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`] CHOOSE_SUBSPACE_OF_SUBSPACE) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE; LE_LT] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`v:real^N->bool`; `t:real^M->bool`] HOMEOMORPHIC_SUBSPACES) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_REWRITE_TAC[homeomorphic; homeomorphism; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(h:real^N->real^M) o (f:real^M->real^N)`; `u:real^M->bool`; `u:real^M->bool`; `s:real^M->bool`] INVARIANCE_OF_DOMAIN_SUBSPACES) THEN ASM_REWRITE_TAC[LE_LT; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; REWRITE_TAC[o_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s SUBSET t` ASSUME_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `w = IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s` THEN DISCH_TAC THEN UNDISCH_TAC `dim(t:real^M->bool) < dim(u:real^M->bool)` THEN REWRITE_TAC[NOT_LT] THEN MP_TAC(ISPECL [`w:real^M->bool`; `u:real^M->bool`] DIM_OPEN_IN) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[IMAGE_EQ_EMPTY]; DISCH_THEN(SUBST1_TAC o SYM)] THEN ASM_SIMP_TAC[DIM_SUBSET]);; let INVARIANCE_OF_DOMAIN_AFFINE_SETS = prove (`!f:real^M->real^N u v s. affine u /\ affine v /\ aff_dim v <= aff_dim u /\ f continuous_on s /\ IMAGE f s SUBSET v /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ open_in (subtopology euclidean u) s ==> open_in (subtopology euclidean v) (IMAGE f s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`; `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`; `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DOMAIN_SUBSPACES) THEN REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN ASM_MESON_TAC[]; REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]); REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]]; ALL_TAC] THEN ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF; IMAGE_ID; ETA_AX]);; let INVARIANCE_OF_DIMENSION_AFFINE_SETS = prove (`!f:real^M->real^N u v s. affine u /\ affine v /\ ~(s = {}) /\ open_in (subtopology euclidean u) s /\ f continuous_on s /\ IMAGE f s SUBSET v /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> aff_dim u <= aff_dim v`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`; `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`; `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DIMENSION_SUBSPACES) THEN REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]); REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET; REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]] THEN ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF; IMAGE_ID; ETA_AX]);; let INVARIANCE_OF_DIMENSION = prove (`!f:real^M->real^N s. f continuous_on s /\ open s /\ ~(s = {}) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> dimindex(:M) <= dimindex(:N)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; SUBSET_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN]);; let CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE = prove (`!f:real^M->real^N s t. subspace s /\ subspace t /\ f continuous_on s /\ IMAGE f s SUBSET t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> dim(s) <= dim(t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[SUBSPACE_IMP_NONEMPTY]);; let INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN = prove (`!f:real^M->real^N s t. convex s /\ f continuous_on s /\ IMAGE f s SUBSET affine hull t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> aff_dim(s) <= aff_dim(t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_GE] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `affine hull s:real^M->bool`; `affine hull t:real^N->bool`; `relative_interior s:real^M->bool`] INVARIANCE_OF_DIMENSION_AFFINE_SETS) THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL; OPEN_IN_RELATIVE_INTERIOR] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; let HOMEOMORPHIC_CONVEX_SETS = prove (`!s:real^M->bool t:real^N->bool. convex s /\ convex t /\ s homeomorphic t ==> aff_dim s = aff_dim t`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM INT_LE_ANTISYM; homeomorphism] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^N->real^M`] THEN ASM_REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]);; let HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ = prove (`!s:real^M->bool t:real^N->bool. convex s /\ compact s /\ convex t /\ compact t ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`, MESON_TAC[HOMEOMORPHIC_CONVEX_SETS; HOMEOMORPHIC_CONVEX_COMPACT_SETS]);; let INVARIANCE_OF_DOMAIN_GEN = prove (`!f:real^M->real^N s. dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> open(IMAGE f s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `(:real^N)`; `s:real^M->bool`] INVARIANCE_OF_DOMAIN_SUBSPACES) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSPACE_UNIV; DIM_UNIV; SUBSET_UNIV]);; let INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV = prove (`!f:real^N->real^1 s t. f continuous_on s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ open t /\ t SUBSET s ==> open (IMAGE f t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; let CONTINUOUS_ON_INVERSE_OPEN = prove (`!f:real^M->real^N g s. dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\ (!x. x IN s ==> g(f x) = x) ==> g continuous_on IMAGE f s`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN IMAGE f s /\ g x IN t} = IMAGE (f:real^M->real^N) (s INTER t)` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC OPEN_OPEN_IN_TRANS] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);; let CONTINUOUS_ON_INVERSE_INTO_1D = prove (`!f:real^N->real^1 g s t. f continuous_on s /\ (path_connected s \/ connected s /\ (locally compact s \/ locally connected s) \/ compact s \/ open s) /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) ==> g continuous_on t`, REPEAT STRIP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONOTONE_INTO_1D_IMP_PROPER_MAP THEN ASM_REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `y:real^1` THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^N->real^1) x = y} = {} \/ ?a. {x | x IN s /\ (f:real^N->real^1) x = y} = {a}` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[COMPACT_EMPTY; CONNECTED_EMPTY]; ASM_REWRITE_TAC[COMPACT_SING; CONNECTED_SING]]; MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[open_in; SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC] THEN ABBREV_TAC `u = connected_component w (x:real^N)` THEN SUBGOAL_THEN `connected u /\ (x:real^N) IN u /\ u SUBSET s /\ u SUBSET w /\ open_in (subtopology euclidean s) u` STRIP_ASSUME_TAC THENL [EXPAND_TAC "u" THEN REPEAT CONJ_TAC THENL [MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]; ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET_TRANS]; ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ASM_MESON_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT]]; SUBGOAL_THEN `?e. &0 < e /\ !y. y IN t /\ dist(y,(f:real^N->real^1) x) < e ==> y IN IMAGE f u` ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `w:real^N->bool`) o concl))] THEN SUBGOAL_THEN `(?e. &0 < e /\ !y. y IN t /\ drop(f x) <= drop y /\ drop y < drop(f x) + e ==> y IN IMAGE f (u:real^N->bool)) /\ (?e. &0 < e /\ !y. y IN t /\ drop(f x) - e < drop y /\ drop y <= drop(f x) ==> y IN IMAGE f (u:real^N->bool))` MP_TAC THENL [ALL_TAC; DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) (X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM; TAUT `(p ==> r) /\ (q ==> r) <=> (p \/ q ==> r)`] THEN DISCH_TAC THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN; DIST_1] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN MP_TAC(ISPECL [`f:real^N->real^1`; `s:real^N->bool`] MONOTONE_TOPOLOGICALLY_INTO_1D) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^1` THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^N->real^1) x = y} = {} \/ ?a. {x | x IN s /\ (f:real^N->real^1) x = y} = {a}` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[COMPACT_EMPTY; CONNECTED_EMPTY]; ASM_REWRITE_TAC[COMPACT_SING; CONNECTED_SING]]; ALL_TAC] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [DISCH_THEN(MP_TAC o SPEC `{y | y IN IMAGE (f:real^N->real^1) s /\ drop(f x) <= drop y}`); DISCH_THEN(MP_TAC o SPEC `{y | y IN IMAGE (f:real^N->real^1) s /\ drop y <= drop(f x)}`)] THEN (ANTS_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN REWRITE_TAC[GSYM CONVEX_CONNECTED_1] THEN MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[drop; CONVEX_HALFSPACE_COMPONENT_LE; REWRITE_RULE[real_ge] CONVEX_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[CONVEX_CONNECTED_1] THEN ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]; ALL_TAC]) THEN REWRITE_TAC[IN_ELIM_THM; SET_RULE `x IN s /\ f x IN IMAGE f s /\ P x <=> x IN s /\ P x`] THEN REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `{x:real^N}`) THEN REWRITE_TAC[CLOSED_IN_SING; IN_ELIM_THM; REAL_LE_REFL] THEN REWRITE_TAC[NOT_INSERT_EMPTY] THENL [DISCH_THEN(MP_TAC o SPEC `{w:real^N | w IN s DIFF u /\ drop(f x) <= drop(f w)}`); DISCH_THEN(MP_TAC o SPEC `{w:real^N | w IN s DIFF u /\ drop(f w) <= drop(f x)}`)] THEN DISCH_THEN(MP_TAC o MATCH_MP (TAUT `~(p /\ q /\ r /\ s /\ ~t) ==> p /\ q /\ s ==> t \/ ~r`)) THEN (ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SET_RULE `{x | x IN s DIFF u /\ P x} = {x | x IN s /\ P x} INTER (s DIFF u)`] THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_REFL]; ALL_TAC]) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `{x | x IN s DIFF u /\ P x} = {} \/ ~({x | x IN s /\ P x} SUBSET {a} UNION {x | x IN s DIFF u /\ P x}) ==> u SUBSET s ==> (!x. x IN s /\ P x ==> x = a) \/ ?x. x IN u /\ ~(x = a) /\ P x`)) THEN ASM_REWRITE_TAC[] THEN (DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[]; ALL_TAC]) THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `dist((f:real^N->real^1) x,f y)` THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN X_GEN_TAC `z:real^1` THEN STRIP_TAC THEN (SUBGOAL_THEN `is_interval(IMAGE (f:real^N->real^1) u)` MP_TAC THENL [REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN MATCH_MP_TAC]) THENL [ALL_TAC; ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN ONCE_REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(f:real^N->real^1) y` THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE]) THEN REWRITE_TAC[DIST_1] THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[CONTINUOUS_ON_INVERSE]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN THEN ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1]]);; let REAL_CONTINUOUS_ON_INVERSE = prove (`!f g s. f real_continuous_on s /\ (is_realinterval s \/ real_compact s \/ real_open s) /\ (!x. x IN s ==> g(f x) = x) ==> g real_continuous_on (IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; real_compact; REAL_OPEN; IS_REALINTERVAL_IS_INTERVAL] THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_INTO_1D THEN MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_PATH_CONNECTED_1] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; GSYM IMAGE_o] THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_ON_INVERSE_ALT = prove (`!f g s t. f real_continuous_on s /\ (is_realinterval s \/ real_compact s \/ real_open s) /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) ==> g real_continuous_on t`, MESON_TAC[REAL_CONTINUOUS_ON_INVERSE]);; let INVARIANCE_OF_DOMAIN_HOMEOMORPHISM = prove (`!f:real^M->real^N s. dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ?g. homeomorphism (s,IMAGE f s) (f,g)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN DISCH_TAC THEN ASM_REWRITE_TAC[homeomorphism] THEN ASM_SIMP_TAC[CONTINUOUS_ON_INVERSE_OPEN] THEN ASM SET_TAC[]);; let INVARIANCE_OF_DOMAIN_HOMEOMORPHIC = prove (`!f:real^M->real^N s. dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> s homeomorphic (IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INVARIANCE_OF_DOMAIN_HOMEOMORPHISM) THEN REWRITE_TAC[homeomorphic] THEN MESON_TAC[]);; let HOMEOMORPHIC_INTERVALS_EQ = prove (`(!a b:real^M c d:real^N. interval[a,b] homeomorphic interval[c,d] <=> aff_dim(interval[a,b]) = aff_dim(interval[c,d])) /\ (!a b:real^M c d:real^N. interval[a,b] homeomorphic interval(c,d) <=> interval[a,b] = {} /\ interval(c,d) = {}) /\ (!a b:real^M c d:real^N. interval(a,b) homeomorphic interval[c,d] <=> interval(a,b) = {} /\ interval[c,d] = {}) /\ (!a b:real^M c d:real^N. interval(a,b) homeomorphic interval(c,d) <=> interval(a,b) = {} /\ interval(c,d) = {} \/ ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) /\ dimindex(:M) = dimindex(:N))`, SIMP_TAC[HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ; CONVEX_INTERVAL; COMPACT_INTERVAL] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY] THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; MATCH_MP_TAC(TAUT `(p <=> q) /\ (~p /\ ~q ==> r) ==> p /\ q \/ ~p /\ ~q /\ r`) THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; STRIP_TAC] THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THENL [EXISTS_TAC `interval(a:real^M,b)`; EXISTS_TAC `interval(c:real^N,d)`] THEN ASM_REWRITE_TAC[OPEN_INTERVAL] THEN ASM SET_TAC[]; TRANS_TAC HOMEOMORPHIC_TRANS `IMAGE ((\x. lambda i. x$i):real^M->real^N) (interval(a,b))` THEN CONJ_TAC THENL [MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHIC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[LE_REFL]; MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA; CART_EQ]; REWRITE_TAC[OPEN_INTERVAL]; SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE ((\x. lambda i. x$i):real^M->real^N) (interval(a,b)) = interval((lambda i. a$i),(lambda i. b$i))` SUBST1_TAC THENL [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(lambda i. (y:real^N)$i):real^M` THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]; MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVALS THEN GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY])) THEN ASM_MESON_TAC[]]]);; let CONTINUOUS_IMAGE_SUBSET_INTERIOR = prove (`!f:real^M->real^N s. f continuous_on s /\ dimindex(:N) <= dimindex(:M) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET] THEN ASM_CASES_TAC `interior s:real^M->bool = {}` THENL [ASM_REWRITE_TAC[INTERIOR_EMPTY; OPEN_EMPTY; IMAGE_CLAUSES]; MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN] THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);; let HOMEOMORPHIC_INTERIORS_SAME_DIMENSION = prove (`!s:real^M->bool t:real^N->bool. dimindex(:M) = dimindex(:N) /\ s homeomorphic t ==> (interior s) homeomorphic (interior t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET] THEN REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN ASM_MESON_TAC[LE_REFL]]; SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN ASM_MESON_TAC[LE_REFL]]; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]]);; let HOMEOMORPHIC_INTERIORS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ (interior s = {} <=> interior t = {}) ==> (interior s) homeomorphic (interior t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interior t:real^N->bool = {}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_INTERIORS_SAME_DIMENSION THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`]; MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);; let HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION = prove (`!s:real^M->bool t:real^N->bool. dimindex(:M) = dimindex(:N) /\ s homeomorphic t /\ closed s /\ closed t ==> (frontier s) homeomorphic (frontier t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] FRONTIER_SUBSET_CLOSED] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[FRONTIER_SUBSET_CLOSED; CONTINUOUS_ON_SUBSET]] THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN SUBGOAL_THEN `(!x:real^M. x IN interior s ==> f x IN interior t) /\ (!y:real^N. y IN interior t ==> g y IN interior s)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN CONJ_TAC THENL [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN ASM_MESON_TAC[LE_REFL]]; SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN ASM_MESON_TAC[LE_REFL]]]);; let HOMEOMORPHIC_FRONTIERS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ closed s /\ closed t /\ (interior s = {} <=> interior t = {}) ==> (frontier s) homeomorphic (frontier t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interior t:real^N->bool = {}` THENL [ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY]; STRIP_TAC] THEN MATCH_MP_TAC HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`]; MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);; let CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ aff_dim t <= aff_dim s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f (relative_interior s) SUBSET relative_interior(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET] THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_AFFINE_SETS THEN EXISTS_TAC `affine hull s:real^M->bool` THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_SUBSET; INT_LE_TRANS]; ALL_TAC] THEN ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET; HULL_SUBSET]);; let HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION = prove (`!s:real^M->bool t:real^N->bool. aff_dim s = aff_dim t /\ s homeomorphic t ==> (relative_interior s) homeomorphic (relative_interior t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN ASM SET_TAC[]]; SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN ASM SET_TAC[]]; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]]);; let HOMEOMORPHIC_RELATIVE_INTERIORS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ (relative_interior s = {} <=> relative_interior t = {}) ==> (relative_interior s) homeomorphic (relative_interior t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `relative_interior s:real^M->bool`]; MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN (REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]; ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t' ==> IMAGE f s' SUBSET t'`]; ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));; let HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION = prove (`!s:real^M->bool t:real^N->bool. aff_dim s = aff_dim t /\ s homeomorphic t ==> (s DIFF relative_interior s) homeomorphic (t DIFF relative_interior t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN ASM_SIMP_TAC[IN_DIFF] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_DIFF; CONTINUOUS_ON_SUBSET]] THEN SUBGOAL_THEN `(!x:real^M. x IN relative_interior s ==> f x IN relative_interior t) /\ (!y:real^N. y IN relative_interior t ==> g y IN relative_interior s)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN CONJ_TAC THENL [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN ASM SET_TAC[]]; SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN ASM SET_TAC[]]]);; let HOMEOMORPHIC_RELATIVE_BOUNDARIES = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ (relative_interior s = {} <=> relative_interior t = {}) ==> (s DIFF relative_interior s) homeomorphic (t DIFF relative_interior t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN ASM_SIMP_TAC[DIFF_EMPTY] THEN STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `relative_interior s:real^M->bool`]; MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN (REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]; ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t' ==> IMAGE f s' SUBSET t'`]; ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));; let UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL = prove (`!f g s:real^N->bool. homeomorphism (s,(:real^N)) (f,g) /\ f uniformly_continuous_on s ==> s = (:real^N)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism; IN_UNIV] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [SET_TAC[]; STRIP_TAC] THEN MP_TAC(ISPEC `s:real^N->bool` CLOPEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; complete] THEN X_GEN_TAC `x:num->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `cauchy ((f:real^N->real^N) o x)` MP_TAC THENL [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS]; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN EXISTS_TAC `(g:real^N->real^N) l` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `(g:real^N->real^N) o (f:real^N->real^N) o (x:num->real^N)` THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[]; MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN ASM_SIMP_TAC[GSYM o_DEF] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]]; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN ASM_REWRITE_TAC[OPEN_UNIV] THEN ASM SET_TAC[]]);; let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN = prove (`!f:real^M->real^N u s t. f continuous_on s /\ IMAGE f s SUBSET t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ bounded u /\ convex u /\ affine t /\ aff_dim t < aff_dim u /\ open_in (subtopology euclidean (relative_frontier u)) s ==> open_in (subtopology euclidean t) (IMAGE f s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `relative_frontier u:real^M->bool = {}` THEN ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; IMAGE_CLAUSES; OPEN_IN_EMPTY] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `?b c:real^M. b IN relative_frontier u /\ c IN relative_frontier u /\ ~(b = c)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s = {} \/ ?x. s = {x}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN ASM_MESON_TAC[RELATIVE_FRONTIER_NOT_SING]; ALL_TAC] THEN MP_TAC(ISPECL [`(:real^M)`; `aff_dim(u:real^M->bool) - &1`] CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL [MATCH_MP_TAC(INT_ARITH `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY]; DISCH_THEN(X_CHOOSE_THEN `af:real^M->bool` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`u:real^M->bool`; `af:real^M->bool`] HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN ASM_REWRITE_TAC[INT_ARITH `x - a + a:int = x`] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `c:real^M` th) THEN MP_TAC(SPEC `b:real^M` th)) THEN ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^M->real^M`; `h:real^M->real^M`] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`j:real^M->real^M`; `k:real^M->real^M`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^M->real^N) o (k:real^M->real^M)`; `(af:real^M->bool)`; `t:real^N->bool`; `IMAGE (j:real^M->real^M) (s DELETE c)`] INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN MP_TAC(ISPECL [`(f:real^M->real^N) o (h:real^M->real^M)`; `(af:real^M->bool)`; `t:real^N->bool`; `IMAGE (g:real^M->real^M) (s DELETE b)`] INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IMP_IMP; INT_ARITH `x:int <= y - &1 <=> x < y`] THEN MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p1 ==> q1) /\ (p2 ==> q2) ==> r`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`h:real^M->real^M`; `relative_frontier u DELETE (b:real^M)`] THEN ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`k:real^M->real^M`; `relative_frontier u DELETE (c:real^M)`] THEN ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP OPEN_IN_UNION) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^N) ((s DELETE b) UNION (s DELETE c))` THEN CONJ_TAC THENL [REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[IMAGE_o] THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET = prove (`!f:real^M->real^N a r s t. f continuous_on s /\ IMAGE f s SUBSET t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ ~(r = &0) /\ affine t /\ aff_dim t < &(dimindex(:M)) /\ open_in (subtopology euclidean (sphere(a,r))) s ==> open_in (subtopology euclidean t) (IMAGE f s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `sphere(a:real^M,r) = {}` THEN ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; OPEN_IN_EMPTY; IMAGE_CLAUSES] THEN RULE_ASSUM_TAC(REWRITE_RULE[SPHERE_EQ_EMPTY; REAL_NOT_LT]) THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `cball(a:real^M,r)`; `s:real^M->bool`; `t:real^N->bool`] INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN) THEN ASM_REWRITE_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL; BOUNDED_CBALL; CONVEX_CBALL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let NO_EMBEDDING_SPHERE_LOWDIM = prove (`!f:real^M->real^N a r. &0 < r /\ f continuous_on sphere(a,r) /\ (!x y. x IN sphere(a,r) /\ y IN sphere(a,r) /\ f x = f y ==> x = y) ==> dimindex(:M) <= dimindex(:N)`, REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (sphere(a:real^M,r))` COMPACT_OPEN) THEN ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY; COMPACT_SPHERE; SPHERE_EQ_EMPTY; REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN ONCE_REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET THEN MAP_EVERY EXISTS_TAC [`a:real^M`; `r:real`] THEN ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV; OPEN_IN_REFL; INT_OF_NUM_LT] THEN ASM_REAL_ARITH_TAC);; let EMPTY_INTERIOR_LOWDIM_GEN = prove (`!s:real^N->bool t:real^M->bool. dimindex(:M) < dimindex(:N) /\ s homeomorphic t ==> interior s = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`] ISOMETRY_SUBSET_SUBSPACE) THEN ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; LT_IMP_LE; IN_UNIV; SUBSET_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(MESON[HOMEOMORPHIC_EMPTY] `!t. interior(t:real^N->bool) homeomorphic interior(s:real^N->bool) /\ interior t = {} ==> interior s = {}`) THEN EXISTS_TAC `IMAGE (h:real^M->real^N) t` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_INTERIORS_SAME_DIMENSION THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]) THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE]; MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN EXISTS_TAC `interior(IMAGE (h:real^M->real^N) (:real^M))` THEN SIMP_TAC[SUBSET_INTERIOR; SET_RULE `IMAGE f s SUBSET IMAGE f UNIV`] THEN MATCH_MP_TAC EMPTY_INTERIOR_LOWDIM THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LET_TRANS)) THEN REWRITE_TAC[GSYM DIM_UNIV] THEN MATCH_MP_TAC EQ_IMP_LE THEN MATCH_MP_TAC DIM_INJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE]]);; let EMPTY_INTERIOR_LOWDIM_GEN_LE = prove (`!s:real^N->bool t:real^M->bool. dimindex(:M) <= dimindex(:N) /\ interior t = {} /\ s homeomorphic t ==> interior s = {}`, REWRITE_TAC[LE_LT] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[EMPTY_INTERIOR_LOWDIM_GEN]; ASM_MESON_TAC[HOMEOMORPHIC_INTERIORS_SAME_DIMENSION; HOMEOMORPHIC_EMPTY]]);; (* ------------------------------------------------------------------------- *) (* Dimension-based conditions for various homeomorphisms. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_SUBSPACES_EQ = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t ==> (s homeomorphic t <=> dim s = dim t)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SUBSPACES]] THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE THEN ASM_MESON_TAC[]);; let HOMEOMORPHIC_AFFINE_SETS_EQ = prove (`!s:real^M->bool t:real^N->bool. affine s /\ affine t ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [EQ_SYM_EQ] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN SIMP_TAC[AFFINE_EQ_SUBSPACE; HOMEOMORPHIC_SUBSPACES_EQ; AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_EQ] THEN MESON_TAC[]);; let HOMEOMORPHIC_HYPERPLANES_EQ = prove (`!a:real^M b c:real^N d. ~(a = vec 0) /\ ~(c = vec 0) ==> ({x | a dot x = b} homeomorphic {x | c dot x = d} <=> dimindex(:M) = dimindex(:N))`, SIMP_TAC[HOMEOMORPHIC_AFFINE_SETS_EQ; AFFINE_HYPERPLANE] THEN SIMP_TAC[AFF_DIM_HYPERPLANE; INT_OF_NUM_EQ; INT_ARITH `x - &1:int = y - &1 <=> x = y`]);; let HOMEOMORPHIC_UNIV_UNIV = prove (`(:real^M) homeomorphic (:real^N) <=> dimindex(:M) = dimindex(:N)`, SIMP_TAC[HOMEOMORPHIC_SUBSPACES_EQ; DIM_UNIV; SUBSPACE_UNIV]);; let HOMEOMORPHIC_CBALLS_EQ = prove (`!a:real^M b:real^N r s. cball(a,r) homeomorphic cball(b,s) <=> r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/ &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`, let lemma = let d = `dimindex(:M) = dimindex(:N)` and t = `?a:real^M b:real^N. ~(cball(a,r) homeomorphic cball(b,s))` in DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THENL [ASM_SIMP_TAC[CBALL_EMPTY; HOMEOMORPHIC_EMPTY; CBALL_EQ_EMPTY] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THENL [ASM_SIMP_TAC[CBALL_TRIVIAL; FINITE_SING; HOMEOMORPHIC_FINITE_STRONG] THEN REWRITE_TAC[FINITE_CBALL] THEN ASM_CASES_TAC `s < &0` THEN ASM_SIMP_TAC[CBALL_EMPTY; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY; ARITH; REAL_LT_IMP_NE] THEN ASM_CASES_TAC `s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[CBALL_TRIVIAL; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY; REAL_LE_REFL; ARITH]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `s <= &0` THEN ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; FINITE_CBALL] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < s` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`] THEN MP_TAC(ISPECL [`a:real^M`; `r:real`] BALL_SUBSET_CBALL); MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`] THEN MP_TAC(ISPECL [`b:real^N`; `s:real`] BALL_SUBSET_CBALL)] THEN ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_CBALLS]]);; let HOMEOMORPHIC_BALLS_EQ = prove (`!a:real^M b:real^N r s. ball(a,r) homeomorphic ball(b,s) <=> r <= &0 /\ s <= &0 \/ &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`, let lemma = let d = `dimindex(:M) = dimindex(:N)` and t = `?a:real^M b:real^N. ~(ball(a,r) homeomorphic ball(b,s))` in DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `s <= &0` THENL [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`]; MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`]] THEN ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_BALLS]]);; let SIMPLY_CONNECTED_SPHERE_EQ = prove (`!a:real^N r. simply_connected(sphere(a,r)) <=> 3 <= dimindex(:N) \/ r <= &0`, let hslemma = prove (`!a:real^M r b:real^N s. dimindex(:M) = dimindex(:N) ==> &0 < r /\ &0 < s ==> (sphere(a,r) homeomorphic sphere(b,s))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; REAL_LT_IMP_LE; SIMPLY_CONNECTED_EMPTY] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONVEX_IMP_SIMPLY_CONNECTED; CONVEX_SING] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_SPHERE] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[ARITH_RULE `~(3 <= n) <=> (1 <= n ==> n = 1 \/ n = 2)`] THEN REWRITE_TAC[DIMINDEX_GE_1] THEN STRIP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN ASM_REWRITE_TAC[CONNECTED_SPHERE_EQ; ARITH] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_2]) THEN FIRST_ASSUM(MP_TAC o ISPECL [`a:real^N`; `r:real`; `vec 0:real^2`; `&1:real`] o MATCH_MP hslemma) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_SIMPLY_CONNECTED_EQ) THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^2. x`) THEN REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL] THEN REWRITE_TAC[GSYM contractible; CONTRACTIBLE_SPHERE] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ = prove (`!a. simply_connected((:real^N) DELETE a) <=> 3 <= dimindex(:N)`, GEN_TAC THEN TRANS_TAC EQ_TRANS `simply_connected(sphere(a:real^N,&1))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ]] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`] HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL; RELATIVE_FRONTIER_CBALL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL; BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);; let NOT_SIMPLY_CONNECTED_CIRCLE = prove (`!a:real^2 r. &0 < r ==> ~simply_connected(sphere(a,r))`, REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ; DIMINDEX_2; ARITH] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The exponential function as a covering map. *) (* ------------------------------------------------------------------------- *) let COVERING_SPACE_CEXP_PUNCTURED_PLANE = prove (`covering_space((:complex),cexp) ((:complex) DIFF {Cx(&0)})`, SIMP_TAC[covering_space; IN_UNIV; CONTINUOUS_ON_CEXP; IN_DIFF; IN_SING] THEN CONJ_TAC THENL [SET_TAC[CEXP_CLOG; CEXP_NZ]; ALL_TAC] THEN SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE cexp (ball(clog z,&1))` THEN REWRITE_TAC[SET_RULE `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`] THEN REWRITE_TAC[CEXP_NZ] THEN CONJ_TAC THENL [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `clog z` THEN ASM_SIMP_TAC[CEXP_CLOG; CENTRE_IN_BALL; REAL_LT_01]; ALL_TAC] THEN SUBGOAL_THEN `!x y. x IN cball(clog z,&1) /\ y IN cball(clog z,&1) /\ cexp x = cexp y ==> x = y` ASSUME_TAC THENL [REWRITE_TAC[IN_CBALL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(x - y:complex)` THEN REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2` THEN CONJ_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN REWRITE_TAC[OPEN_BALL; CONTINUOUS_ON_CEXP] THEN ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL]; ALL_TAC] THEN MP_TAC(ISPECL [`cball(clog z,&1)`; `cexp`; `IMAGE cexp (cball(clog z,&1))`] HOMEOMORPHISM_COMPACT) THEN ASM_REWRITE_TAC[COMPACT_CBALL; CONTINUOUS_ON_CEXP] THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `l:complex->complex` THEN STRIP_TAC THEN EXISTS_TAC `{ IMAGE (\x. x + Cx (&2 * n * pi) * ii) (ball(clog z,&1)) | integer n}` THEN SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; ONCE_REWRITE_RULE[VECTOR_ADD_SYM] OPEN_TRANSLATION] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; IN_IMAGE; CEXP_EQ] THEN SET_TAC[]; REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `m:real` THEN DISCH_TAC THEN X_GEN_TAC `n:real` THEN DISCH_TAC THEN ASM_CASES_TAC `m:real = n` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[IN_BALL; dist; SET_RULE `DISJOINT (IMAGE f s) (IMAGE g s) <=> !x y. x IN s /\ y IN s ==> ~(f x = g y)`] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH `&2 <= norm(m - n) ==> norm(c - x) < &1 /\ norm(c - y) < &1 ==> ~(x + m = y + n)`) THEN REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_II; GSYM CX_SUB; COMPLEX_NORM_CX] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * &1 * pi` THEN CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_POS] THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN ASM_SIMP_TAC[REAL_SUB_0; INTEGER_CLOSED]; X_GEN_TAC `n:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. x + Cx(&2 * n * pi) * ii) o (l:complex->complex)` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CEXP; o_THM; IMAGE_o; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID; REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. e(f x) = e x) ==> IMAGE e (IMAGE f s) = IMAGE e s`) THEN ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID]; MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> l(e x) = x) ==> IMAGE t (IMAGE l (IMAGE e s)) = IMAGE t s`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; IMAGE_SUBSET; CONTINUOUS_ON_SUBSET]]]);; (* ------------------------------------------------------------------------- *) (* Hence the Borsukian results about mappings into circle. *) (* ------------------------------------------------------------------------- *) let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM = prove (`!f:real^N->complex s. (?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=> (?g. g continuous_on s /\ (!x. x IN s ==> f x = cexp(g x)))`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(CHOOSE_THEN (MP_TAC o CONJ COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION) THEN REWRITE_TAC[SUBSET_UNIV] THEN MESON_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) (cexp o g) (\x:real^N. a)` MP_TAC THENL [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN ASM_SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV] THEN REWRITE_TAC[CONTINUOUS_ON_CEXP; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_UNIV; IN_DIFF; IN_SING; CEXP_NZ]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN ASM_SIMP_TAC[o_THM]]]);; let INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE = prove (`!f:real^N->complex s. (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a)) ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`, REPEAT GEN_TAC THEN SIMP_TAC[sphere; GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN SIMP_TAC[SUBSET; DIST_0; FORALL_IN_GSPEC; IN_UNIV; IN_DIFF; IN_SING] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC);; let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE = prove (`!f:real^N->complex s. (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a)) <=> (?g. (Cx o g) continuous_on s /\ !x. x IN s ==> f x = cexp(ii * Cx(g x)))`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `Im o (g:real^N->complex)` THEN CONJ_TAC THENL [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM]; FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; NORM_CEXP] THEN REWRITE_TAC[EULER; o_THM; RE_MUL_II; IM_MUL_II] THEN SIMP_TAC[RE_CX; IM_CX; REAL_NEG_0; REAL_EXP_0]]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) ((cexp o (\z. ii * z)) o (Cx o g)) (\x:real^N. a)` MP_TAC THENL [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN EXISTS_TAC `{z | Im z = &0}` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CEXP; CONJ_ASSOC; CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_SPHERE_0; o_THM; IM_CX] THEN SIMP_TAC[NORM_CEXP; RE_MUL_II; REAL_EXP_0; REAL_NEG_0]; MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN CONJ_TAC THENL [REWRITE_TAC[IM_DEF; CONVEX_STANDARD_HYPERPLANE]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MESON_TAC[IM_CX]]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN ASM_SIMP_TAC[o_THM]]]);; let HOMOTOPIC_CIRCLEMAPS_DIV,HOMOTOPIC_CIRCLEMAPS_DIV_1 = (CONJ_PAIR o prove) (`(!f g:real^N->real^2 s. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=> f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\ g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\ ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. c)) /\ (!f g:real^N->real^2 s. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=> f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\ g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\ homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. Cx(&1)))`, let lemma = prove (`!f g h:real^N->real^2 s. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g ==> h continuous_on s /\ (!x. x IN s ==> h(x) IN sphere(vec 0,&1)) ==> homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x * h x) (\x. g x * h x)`, REWRITE_TAC[IN_SPHERE_0] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN ASM_SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; FORALL_IN_PCROSS] THEN X_GEN_TAC `k:real^((1,N)finite_sum)->real^2` THEN STRIP_TAC THEN EXISTS_TAC `\z. (k:real^(1,N)finite_sum->real^2) z * h(sndcart z)` THEN ASM_SIMP_TAC[COMPLEX_NORM_MUL; SNDCART_PASTECART; REAL_MUL_LID] THEN ASM_REWRITE_TAC[SNDCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]) in REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC (TAUT `(q <=> r) /\ (p <=> r) ==> (p <=> q) /\ (p <=> r)`) THEN CONJ_TAC THENL [REPEAT(MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN DISCH_TAC) THEN EQ_TAC THENL [ALL_TAC; DISCH_TAC THEN EXISTS_TAC `Cx(&1)` THEN ASM_MESON_TAC[]] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:complex` THEN DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`vec 0:real^2`; `&1`] PATH_CONNECTED_SPHERE) THEN REWRITE_TAC[DIMINDEX_2; LE_REFL; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_SPHERE_0; COMPLEX_NORM_CX; REAL_ABS_NUM]]; EQ_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemma) THENL [FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN DISCH_THEN(MP_TAC o SPEC `\x. inv((g:real^N->complex) x)`); DISCH_THEN(MP_TAC o SPEC `g:real^N->complex`)] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN ASM_SIMP_TAC[IN_SPHERE_0; COMPLEX_NORM_INV; REAL_INV_1] THEN ASM_SIMP_TAC[GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ; CONTINUOUS_ON_COMPLEX_INV] THEN ASM_REWRITE_TAC[SUBSET; IN_SPHERE_0; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_MUL_LID; COMPLEX_MUL_RINV; GSYM complex_div; COMPLEX_DIV_REFL; GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ]]);; (* ------------------------------------------------------------------------- *) (* In particular, complex logs exist on various "well-behaved" sets. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE = prove (`!f:real^N->complex s. f continuous_on s /\ contractible s /\ (!x. x IN s ==> ~(f x = Cx(&0))) ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED = prove (`!f:real^N->complex s. f continuous_on s /\ simply_connected s /\ locally path_connected s /\ (!x. x IN s ==> ~(f x = Cx(&0))) ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`, REPEAT STRIP_TAC THEN MP_TAC (ISPECL [`f:real^N->complex`; `s:real^N->bool`] (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT) COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN ASM_REWRITE_TAC[IN_UNIV] THEN ASM SET_TAC[]);; let CONTINUOUS_LOGARITHM_ON_CBALL = prove (`!f:real^N->complex a r. f continuous_on cball(a,r) /\ (!z. z IN cball(a,r) ==> ~(f z = Cx(&0))) ==> ?h. h continuous_on cball(a,r) /\ !z. z IN cball(a,r) ==> f z = cexp(h z)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN ASM_REWRITE_TAC[CONVEX_CBALL]);; let CONTINUOUS_LOGARITHM_ON_BALL = prove (`!f:real^N->complex a r. f continuous_on ball(a,r) /\ (!x. x IN ball(a,r) ==> ~(f x = Cx(&0))) ==> ?h. h continuous_on ball(a,r) /\ !x. x IN ball(a,r) ==> f x = cexp(h x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN ASM_REWRITE_TAC[CONVEX_BALL]);; let CONTINUOUS_SQRT_ON_CONTRACTIBLE = prove (`!f:real^N->complex s. f continuous_on s /\ contractible s /\ (!x. x IN s ==> ~(f x = Cx(&0))) ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN CONV_TAC COMPLEX_RING);; let CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED = prove (`!f:real^N->complex s. f continuous_on s /\ simply_connected s /\ locally path_connected s /\ (!x. x IN s ==> ~(f x = Cx(&0))) ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* Analogously, holomorphic logarithms and square roots. *) (* ------------------------------------------------------------------------- *) let CONTRACTIBLE_IMP_HOLOMORPHIC_LOG,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG = (CONJ_PAIR o prove) (`(!s:complex->bool. contractible s ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z)) /\ (!s:complex->bool. simply_connected s /\ locally path_connected s ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z))`, REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE); MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED)] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN (MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `f holomorphic_on s` THEN REWRITE_TAC[holomorphic_on] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `(z:complex) IN s` THEN ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN] THEN DISCH_THEN(X_CHOOSE_THEN `f':complex` MP_TAC) THEN DISCH_THEN(MP_TAC o ISPECL [`\x. (cexp(g x) - cexp(g z)) / (x - z)`; `&1`] o MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] LIM_TRANSFORM_WITHIN)) THEN ASM_SIMP_TAC[REAL_LT_01] THEN DISCH_THEN(MP_TAC o SPECL [`\x:complex. if g x = g z then cexp(g z) else (cexp(g x) - cexp(g z)) / (g x - g z)`; `cexp(g(z:complex))`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_COMPLEX_DIV)) THEN REWRITE_TAC[CEXP_NZ] THEN ANTS_TAC THENL [SUBGOAL_THEN `(\x. if g x = g z then cexp(g z) else (cexp(g x) - cexp(g(z:complex))) / (g x - g z)) = (\y. if y = g z then cexp(g z) else (cexp y - cexp(g z)) / (y - g z)) o g` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC LIM_COMPOSE_AT THEN EXISTS_TAC `(g:complex->complex) z` THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON]; REWRITE_TAC[EVENTUALLY_TRUE]; ONCE_REWRITE_TAC[LIM_AT_ZERO] THEN SIMP_TAC[COMPLEX_VEC_0; COMPLEX_ADD_SUB; COMPLEX_EQ_ADD_LCANCEL_0] THEN MP_TAC(SPEC `cexp(g(z:complex))` (MATCH_MP LIM_COMPLEX_LMUL LIM_CEXP_MINUS_1)) THEN REWRITE_TAC[COMPLEX_MUL_RID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN SIMP_TAC[EVENTUALLY_AT; GSYM DIST_NZ; CEXP_ADD] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN SIMPLE_COMPLEX_ARITH_TAC]; DISCH_THEN(fun th -> EXISTS_TAC `f' / cexp(g(z:complex))` THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONTINUOUS_WITHIN; tendsto] THEN DISCH_THEN(MP_TAC o SPEC `&2 * pi`) THEN REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `w:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[COMPLEX_SUB_REFL; complex_div; COMPLEX_MUL_LZERO]; ASM_CASES_TAC `w:complex = z` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(cexp(g(w:complex)) = cexp(g z))` MP_TAC THENL [UNDISCH_TAC `~((g:complex->complex) w = g z)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] COMPLEX_EQ_CEXP) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]; REPEAT(FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))) THEN CONV_TAC COMPLEX_FIELD]]]));; let CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT = (CONJ_PAIR o prove) (`(!s:complex->bool. contractible s ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = g z pow 2) /\ (!s:complex->bool. simply_connected s /\ locally path_connected s ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = g z pow 2)`, CONJ_TAC THEN GEN_TAC THENL [DISCH_THEN(ASSUME_TAC o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG); DISCH_THEN(ASSUME_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG)] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST] THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* Related theorems about holomorphic inverse cosines. *) (* ------------------------------------------------------------------------- *) let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS = prove (`!f s. f holomorphic_on s /\ contractible s /\ (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1))) ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = ccos(g z)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\z:complex. Cx(&1) - f(z) pow 2` o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_POW; COMPLEX_RING `~(Cx(&1) - z pow 2 = Cx(&0)) <=> ~(z = Cx(&1)) /\ ~(z = --Cx(&1))`] THEN REWRITE_TAC[COMPLEX_RING `Cx(&1) - w pow 2 = z pow 2 <=> (w + ii * z) * (w - ii * z) = Cx(&1)`] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `\z:complex. f(z) + ii * g(z)` o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG) THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; COMPLEX_RING `(a + b) * (a - b) = Cx(&1) ==> ~(a + b = Cx(&0))`] THEN DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:complex. --ii * h(z)` THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; ccos] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (COMPLEX_FIELD `a * b = Cx(&1) ==> b = inv a`)) THEN ASM_SIMP_TAC[GSYM CEXP_NEG] THEN FIRST_X_ASSUM(ASSUME_TAC o SYM) THEN DISCH_THEN(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[COMPLEX_RING `ii * --ii * z = z`; COMPLEX_RING `--ii * --ii * z = --z`] THEN CONV_TAC COMPLEX_RING);; let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED = prove (`!f s a. f holomorphic_on s /\ contractible s /\ a IN s /\ (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1))) ==> ?g. g holomorphic_on s /\ norm(g a) <= pi + norm(f a) /\ !z. z IN s ==> f z = ccos(g z)`, let lemma = prove (`!w. ?v. ccos(v) = w /\ norm(v) <= pi + norm(w)`, GEN_TAC THEN EXISTS_TAC `cacs w` THEN ABBREV_TAC `v = cacs w` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[CCOS_CACS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN SIMP_TAC[NORM_LE_SQUARE; PI_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= b * c /\ a <= b pow 2 + c pow 2 ==> a <= (b + c) pow 2`) THEN SIMP_TAC[REAL_LE_MUL; PI_POS_LE; NORM_POS_LE] THEN REWRITE_TAC[COMPLEX_SQNORM; GSYM NORM_POW_2; NORM_CCOS_POW_2] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN EXPAND_TAC "v" THEN REWRITE_TAC[REAL_ABS_PI; RE_CACS_BOUND] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= c /\ x <= (d / &2) pow 2 ==> x <= c + d pow 2 / &4`) THEN REWRITE_TAC[REAL_LE_POW_2; GSYM REAL_LE_SQUARE_ABS; REAL_LE_ABS_SINH]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] CONTRACTIBLE_IMP_HOLOMORPHIC_ACS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `(f:complex->complex) a` lemma) THEN DISCH_THEN(X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `ccos b = ccos(g(a:complex))` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[CCOS_EQ]] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` (STRIP_ASSUME_TAC o GSYM)) THENL [EXISTS_TAC `\z:complex. g z + Cx(&2 * n * pi)`; EXISTS_TAC `\z:complex. --(g z) + Cx(&2 * n * pi)`] THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_NEG; HOLOMORPHIC_ON_CONST] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[CCOS_EQ] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Extension property for inessential maps. This almost follows from *) (* INESSENTIAL_NEIGHBOURHOOD_EXTENSION except that here we don't need to *) (* assume that t is closed in s. *) (* ------------------------------------------------------------------------- *) let INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM = prove (`!f:real^N->complex s t. f continuous_on s /\ t SUBSET s /\ (?g. g continuous_on t /\ !x. x IN t ==> f x = cexp(g x)) ==> ?u. t SUBSET u /\ open_in (subtopology euclidean s) u /\ (?g. g continuous_on u /\ !x. x IN u ==> f x = cexp(g x))`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `!x. x IN t ==> ?d. &0 < d /\ (!y. y IN s /\ dist(x,y) < d ==> norm(f y / f x - Cx(&1)) < &1 / &7) /\ (!z:real^N. z IN t /\ dist(x,z) < &2 * d ==> norm(h z - h x) < &1 / &5)` MP_TAC THENL [REPEAT STRIP_TAC THEN UNDISCH_TAC `(h:real^N->complex) continuous_on t` THEN GEN_REWRITE_TAC LAND_CONV [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[continuous_within] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &5`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dist] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~((f:real^N->complex) x = Cx(&0))` ASSUME_TAC THENL [ASM_MESON_TAC[CEXP_NZ]; ALL_TAC] THEN SUBGOAL_THEN `(\y:real^N. f y / f x) continuous (at x within s)` MP_TAC THENL [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; SUBSET]; REWRITE_TAC[continuous_within] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &7`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[COMPLEX_DIV_REFL; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `min d (e / &2)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN CONJ_TAC THENL [ASM_MESON_TAC[NORM_SUB]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real^N->real` THEN DISCH_THEN(LABEL_TAC "*")] THEN ABBREV_TAC `u = \x. s INTER ball(x:real^N,d x)` THEN ABBREV_TAC `g = \x y. h(x:real^N) + clog(f y / f x)` THEN SUBGOAL_THEN `(!x:real^N. x IN t ==> x IN u x) /\ (!x. x IN t ==> open_in (subtopology euclidean s) (u x))` STRIP_ASSUME_TAC THENL [EXPAND_TAC "u" THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N y:real^N. x IN t /\ y IN u x ==> cexp(g x y) = f y` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[CEXP_ADD] THEN ASM_SIMP_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `norm(x - y) < &1 / &7 ==> norm(y) = &1 ==> ~(x = vec 0)`)) THEN SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; CEXP_CLOG; COMPLEX_VEC_0] THEN SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_DIV_EQ_0; DE_MORGAN_THM]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^N->real^N->complex`; `u:real^N->real^N->bool`; `UNIONS {(u:real^N->real^N->bool) x | x IN t}`; `t:real^N->bool`; `(:complex)`] PASTING_LEMMA_EXISTS) THEN REWRITE_TAC[SUBSET_REFL; SUBSET_UNIV;] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; EXPAND_TAC "g" THEN REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_RMUL THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `abs x < &1 ==> &0 < x + &1`) THEN MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS] `norm z < &1 ==> abs(Re z) < &1`) THEN MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]]; MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN EXPAND_TAC "g" THEN REWRITE_TAC[IM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `&5 < a /\ abs(ha - hb) < &1 / &5 /\ abs(fa) < &2 /\ abs(fb) < &2 ==> abs((ha + fa) - (hb + fb)) < a`) THEN CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IM_SUB] THEN MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS] `norm z < a ==> abs(Im z) < a`) THEN MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`) THEN MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`) THEN EXPAND_TAC "u" THEN REWRITE_TAC[IMP_IMP; IN_INTER; IN_BALL] THEN DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(p /\ q) /\ (p /\ r) ==> q /\ r`)) THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `dist(a,x) < d /\ dist(b,x) < e ==> dist(a,b) < &2 * d \/ dist(a,b) < &2 * e`)) THEN STRIP_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`); REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN ASM_MESON_TAC[NORM_SUB; DIST_SYM]; CONJ_TAC THEN TRANS_TAC REAL_LT_TRANS `pi / &2` THEN (CONJ_TAC THENL [ALL_TAC; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]) THEN MATCH_MP_TAC RE_CLOG_POS_LT_IMP THEN ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `abs x < &1 ==> &0 < x + &1`) THEN MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS] `norm z < &1 ==> abs(Re z) < &1`) THEN MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THENL [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`); REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N` o el 1 o CONJUNCTS) THEN DISCH_THEN MATCH_MP_TAC THENL [MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`); MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`)] THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]]; DISCH_THEN(X_CHOOSE_THEN `h':real^N->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `UNIONS {(u:real^N->real^N->bool) x | x IN t}` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC] THEN EXISTS_TAC `h':real^N->complex` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `x:real^N`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The "borsukian" property of sets. This doesn't seem to have a standard *) (* name. Kuratowski uses "contractible with respect to [S^1]" while *) (* Whyburn uses "property b". It's closely related to unicoherence. *) (* ------------------------------------------------------------------------- *) let borsukian = new_definition `borsukian(s:real^N->bool) <=> !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) ==> ?a. homotopic_with (\h. T) (s,(:real^2) DIFF {Cx(&0)}) f (\x. a)`;; let BORSUKIAN_RETRACTION_GEN = prove (`!s:real^M->bool t:real^N->bool h k. h continuous_on s /\ IMAGE h s = t /\ k continuous_on t /\ IMAGE k t SUBSET s /\ (!y. y IN t ==> h(k y) = y) /\ borsukian s ==> borsukian t`, REPEAT GEN_TAC THEN REWRITE_TAC[borsukian] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN PURE_ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let RETRACT_OF_BORSUKIAN = prove (`!s t:real^N->bool. borsukian t /\ s retract_of t ==> borsukian s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] BORSUKIAN_RETRACTION_GEN)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; let HOMEOMORPHIC_BORSUKIAN = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ borsukian s ==> borsukian t`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[BORSUKIAN_RETRACTION_GEN; SUBSET_REFL]);; let HOMEOMORPHIC_BORSUKIAN_EQ = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (borsukian s <=> borsukian t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_BORSUKIAN) THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; let BORSUKIAN_TRANSLATION = prove (`!a:real^N s. borsukian (IMAGE (\x. a + x) s) <=> borsukian s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [BORSUKIAN_TRANSLATION];; let BORSUKIAN_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (borsukian(IMAGE f s) <=> borsukian s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; HOMEOMORPHIC_REFL]);; add_linear_invariants [BORSUKIAN_INJECTIVE_LINEAR_IMAGE];; let HOMEOMORPHISM_BORSUKIANNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (borsukian(IMAGE f k) <=> borsukian k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMOTOPY_EQUIVALENT_BORSUKIANNESS = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t ==> (borsukian s <=> borsukian t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[borsukian] THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN ASM_REWRITE_TAC[]);; let BORSUKIAN_ALT = prove (`!s:real^N->bool. borsukian s <=> !f g:real^N->real^2. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) /\ g continuous_on s /\ IMAGE g s SUBSET ((:real^2) DIFF {Cx(&0)}) ==> homotopic_with (\h. T) (s,(:real^2) DIFF {Cx (&0)}) f g`, REWRITE_TAC[borsukian; HOMOTOPIC_TRIVIALITY] THEN SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; DIMINDEX_2; LE_REFL]);; let BORSUKIAN_CONTINUOUS_LOGARITHM = prove (`!s:real^N->bool. borsukian s <=> !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`, REWRITE_TAC[borsukian; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM]);; let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE = prove (`!s:real^N->bool. borsukian s <=> !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`, GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0; SET_RULE `IMAGE f s SUBSET UNIV DIFF {a} <=> !z. z IN s ==> ~(f z = a)`] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^N. f(x) / Cx(norm(f x))`) THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NORM; REAL_DIV_REFL; NORM_EQ_0; COMPLEX_NORM_ZERO] THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN ASM_REWRITE_TAC[CX_INJ; COMPLEX_NORM_ZERO; CONTINUOUS_ON_CX_LIFT] THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE]; ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD `~(z = Cx(&0)) ==> (w / z = u <=> w = z * u)`] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. clog(Cx(norm(f x:complex))) + (g:real^N->complex)(x)` THEN ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG; CX_INJ; COMPLEX_NORM_ZERO] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_CX_LIFT; CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; RE_CX; COMPLEX_NORM_NZ]]]);; let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX = prove (`!s:real^N->bool. borsukian s <=> !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) ==> ?g. (Cx o g) continuous_on s /\ (!x. x IN s ==> f x = cexp(ii * Cx(g x)))`, GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^N->complex` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN EXISTS_TAC `Im o (g:real^N->complex)` THEN ASM_SIMP_TAC[CONTINUOUS_ON_CX_IM; CONTINUOUS_ON_COMPOSE; o_ASSOC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(f:real^N->complex) x = cexp(g x)` THEN ASM_REWRITE_TAC[NORM_CEXP; o_DEF; REAL_EXP_EQ_1] THEN DISCH_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN REWRITE_TAC[REAL_NEG_0]; X_GEN_TAC `g:real^N->real` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. ii * Cx(g x)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN ASM_REWRITE_TAC[GSYM o_DEF]]);; let BORSUKIAN_CIRCLE = prove (`!s:real^N->bool. borsukian s <=> !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) ==> ?a. homotopic_with (\h. T) (s,sphere(Cx(&0),&1)) f (\x. a)`, REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX] THEN REWRITE_TAC[COMPLEX_VEC_0]);; let BORSUKIAN_CIRCLE_ALT = prove (`!s:real^N->bool. borsukian s <=> !f g:real^N->real^2. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) /\ g continuous_on s /\ IMAGE g s SUBSET sphere(Cx(&0),&1) ==> homotopic_with (\h. T) (s,sphere(Cx(&0),&1)) f g`, REWRITE_TAC[BORSUKIAN_CIRCLE; HOMOTOPIC_TRIVIALITY] THEN SIMP_TAC[PATH_CONNECTED_SPHERE; DIMINDEX_2; LE_REFL]);; let CONTRACTIBLE_IMP_BORSUKIAN = prove (`!s:real^N->bool. contractible s ==> borsukian s`, SIMP_TAC[borsukian; CONTRACTIBLE_IMP_PATH_CONNECTED] THEN MESON_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE]);; let CONIC_IMP_BORSUKIAN = prove (`!s:real^N->bool. conic s ==> borsukian s`, MESON_TAC[CONIC_IMP_CONTRACTIBLE; CONTRACTIBLE_IMP_BORSUKIAN]);; let SIMPLY_CONNECTED_IMP_BORSUKIAN = prove (`!s:real^N->bool. simply_connected s /\ locally path_connected s ==> borsukian s`, SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED THEN ASM SET_TAC[]);; let STARLIKE_IMP_BORSUKIAN = prove (`!s:real^N->bool. starlike s ==> borsukian s`, SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; STARLIKE_IMP_CONTRACTIBLE]);; let BORSUKIAN_EMPTY = prove (`borsukian({}:real^N->bool)`, SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_EMPTY]);; let BORSUKIAN_UNIV = prove (`borsukian(:real^N)`, SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_UNIV]);; let CONVEX_IMP_BORSUKIAN = prove (`!s:real^N->bool. convex s ==> borsukian s`, MESON_TAC[STARLIKE_IMP_BORSUKIAN; CONVEX_IMP_STARLIKE; BORSUKIAN_EMPTY]);; let BORSUKIAN_1_GEN = prove (`!s:real^N->bool. (dimindex(:N) = 1 \/ ?r:real^1->bool. s homeomorphic r) ==> borsukian s`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[BORSUKIAN_CIRCLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COHOMOTOPICALLY_TRIVIAL_1D THEN ASM_REWRITE_TAC[ANR_SPHERE; CONNECTED_SPHERE_EQ] THEN REWRITE_TAC[DIMINDEX_2; LE_REFL]);; let BORSUKIAN_1 = prove (`!s:real^1->bool. borsukian s`, GEN_TAC THEN MATCH_MP_TAC BORSUKIAN_1_GEN THEN REWRITE_TAC[DIMINDEX_1]);; let BORSUKIAN_SPHERE = prove (`!a:real^N r. borsukian(sphere(a,r)) <=> r <= &0 \/ ~(dimindex(:N) = 2)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; BORSUKIAN_EMPTY; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[REAL_LT_REFL; SPHERE_SING; CONVEX_IMP_BORSUKIAN; CONVEX_SING; GSYM REAL_NOT_LT] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [ASM_SIMP_TAC[ARITH; BORSUKIAN_1_GEN]; ALL_TAC] THEN ASM_CASES_TAC `dimindex(:N) = 2` THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `~borsukian(sphere(Cx(&0),&1))` MP_TAC THENL [REWRITE_TAC[BORSUKIAN_CIRCLE] THEN DISCH_THEN(MP_TAC o SPEC `\z:complex. z`) THEN REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL] THEN ASM_REWRITE_TAC[GSYM contractible; CONTRACTIBLE_SPHERE] THEN REAL_ARITH_TAC; REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_BORSUKIAN) THEN REWRITE_TAC[HOMEOMORPHIC_SPHERES_EQ] THEN ASM_REWRITE_TAC[DIMINDEX_2; REAL_LT_01]]; MATCH_MP_TAC SIMPLY_CONNECTED_IMP_BORSUKIAN THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE; SIMPLY_CONNECTED_SPHERE_EQ] THEN DISJ1_TAC THEN MATCH_MP_TAC(ARITH_RULE `1 <= n /\ ~(n = 1) /\ ~(n = 2) ==> 3 <= n`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1]]);; let BORSUKIAN_OPEN_UNION = prove (`!s t:real^N->bool. open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t /\ borsukian s /\ borsukian t /\ connected(s INTER t) ==> borsukian(s UNION t)`, REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`] CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN EXISTS_TAC `&2 * pi` THEN REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a - b:complex = c - d <=> a - c = b - d`] THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]]; REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`; CEXP_NZ; COMPLEX_MUL_LID] THEN ASM SET_TAC[]]]);; let BORSUKIAN_CLOSED_UNION = prove (`!s t:real^N->bool. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ borsukian s /\ borsukian t /\ connected(s INTER t) ==> borsukian(s UNION t)`, REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`] CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN EXISTS_TAC `&2 * pi` THEN REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN ONCE_REWRITE_TAC[COMPLEX_RING `a - b:complex = c - d <=> a - c = b - d`] THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]]; REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`; CEXP_NZ; COMPLEX_MUL_LID] THEN ASM SET_TAC[]]]);; let BORSUKIAN_SEPARATION_COMPACT = prove (`!s:real^2->bool. compact s ==> (borsukian s <=> connected((:real^2) DIFF s))`, SIMP_TAC[BORSUKIAN_CIRCLE; BORSUK_SEPARATION_THEOREM; DIMINDEX_2; LE_REFL; COMPLEX_VEC_0]);; let BORSUKIAN_COMPONENTWISE_EQ = prove (`!s:real^N->bool. locally connected s \/ compact s ==> (borsukian s <=> !c. c IN components s ==> borsukian c)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[BORSUKIAN_ALT] THEN MATCH_MP_TAC COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS THEN ASM_SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING]);; let BORSUKIAN_COMPONENTWISE = prove (`!s:real^N->bool. (locally connected s \/ compact s) /\ (!c. c IN components s ==> borsukian c) ==> borsukian s`, MESON_TAC[BORSUKIAN_COMPONENTWISE_EQ]);; let BORSUKIAN_MONOTONE_IMAGE_COMPACT = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ compact s /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ borsukian s ==> borsukian t`, REPEAT STRIP_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [BORSUKIAN_CONTINUOUS_LOGARITHM]) THEN DISCH_THEN(MP_TAC o SPEC `(g:real^N->complex) o (f:real^M->real^N)`) THEN ASM_SIMP_TAC[IMAGE_o; CONTINUOUS_ON_COMPOSE; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->complex` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!y. ?x. y IN t ==> x IN s /\ (f:real^M->real^N) x = y` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f':real^N->real^M` THEN STRIP_TAC THEN EXISTS_TAC `(h:real^M->complex) o (f':real^N->real^M)` THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_FROM_CLOSED_GRAPH THEN EXISTS_TAC `IMAGE (h:real^M->complex) s` THEN ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_o] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[o_THM]] THEN SUBGOAL_THEN `{pastecart x ((h:real^M->complex) ((f':real^N->real^M) x)) | x IN t} = {p | ?x. x IN s /\ pastecart x p IN {z | z IN s PCROSS UNIV /\ (sndcart z - pastecart (f(fstcart z)) (h(fstcart z))) IN {vec 0}}}` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC CLOSED_COMPACT_PROJECTION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_SIMP_TAC[CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED] THEN REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[GSYM o_DEF] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN ASM_REWRITE_TAC[UNIV_NOT_EMPTY]] THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM] THEN REWRITE_TAC[CONJ_ASSOC; PASTECART_INJ] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `z:complex`] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM1] THEN EQ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?a. !x. x IN {x | x IN s /\ (f:real^M->real^N) x = y} ==> h x - h(f' y):complex = a` MP_TAC THENL [ALL_TAC; REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:complex` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `(f':real^N->real^M) y`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[VECTOR_SUB_REFL]] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `v:real^M` THEN STRIP_TAC THEN EXISTS_TAC `&2 * pi` THEN REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN X_GEN_TAC `u:real^M` THEN REWRITE_TAC[COMPLEX_RING `a - x:complex = b - x <=> a = b`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN REWRITE_TAC[COMPLEX_RING `(a - x) - (b - x):complex = a - b`] THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[GSYM IM_SUB] THEN ASM_MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);; let BORSUKIAN_OPEN_MAP_IMAGE_COMPACT = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ compact s /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ borsukian s ==> borsukian t`, REPEAT GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX] THEN STRIP_TAC THEN X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^N->complex) o (f:real^M->real^N)`) THEN ASM_SIMP_TAC[IMAGE_o; CONTINUOUS_ON_COMPOSE; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!y. ?x. y IN t ==> x IN s /\ (f:real^M->real^N) x = y /\ (!x'. x' IN s /\ f x' = y ==> h x <= h x')` MP_TAC THENL [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{ h x:real | x IN s /\ (f:real^M->real^N) x = y}` COMPACT_ATTAINS_INF) THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM CONJ_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; ONCE_REWRITE_TAC[SET_RULE `x = y <=> x IN {y}`] THEN MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN ASM_MESON_TAC[CLOSED_IN_SING; SUBSET_REFL]]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `k:real^N->real^M` THEN DISCH_TAC THEN EXISTS_TAC `(h:real^M->real) o (k:real^N->real^M)` THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[continuous_on] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`Cx o (h:real^M->real)`; `s:real^M->bool`] COMPACT_UNIFORMLY_CONTINUOUS) THEN ASM_REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_THM; DIST_CX] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\y. {x | x IN s /\ (f:real^M->real^N) x = y}`; `s:real^M->bool`; `t:real^N->bool`] UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN ASM_SIMP_TAC[GSYM CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE; GSYM OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE; SUBSET_REFL; SUBSET_RESTRICT] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_IMP_CLOSED_MAP]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `d:real`]) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SET_RULE `x IN s /\ f x = y <=> x IN s /\ f x IN {y}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CLOSED_IN_SING; SUBSET_REFL]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y':real^N` THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `y':real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `(k:real^N->real^M) y`) (MP_TAC o SPEC `(k:real^N->real^M) y'`)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `w':real^M` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `y':real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_SIMP_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `w':real^M`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`w:real^M`; `(k:real^N->real^M) y'`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w':real^M`; `(k:real^N->real^M) y`]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Unicoherence (closed). *) (* ------------------------------------------------------------------------- *) let unicoherent = new_definition `unicoherent(u:real^N->bool) <=> !s t. connected s /\ connected t /\ s UNION t = u /\ closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t ==> connected (s INTER t)`;; let HOMEOMORPHIC_UNICOHERENT = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ unicoherent s ==> unicoherent t`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN REWRITE_TAC[unicoherent] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `u INTER v = IMAGE (f:real^M->real^N) (IMAGE (g:real^N->real^M) u INTER IMAGE g v)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ (p /\ q) /\ s`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; CONJ_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `t:real^N->bool`] THEN ASM_REWRITE_TAC[homeomorphism]]);; let HOMEOMORPHIC_UNICOHERENT_EQ = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (unicoherent s <=> unicoherent t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_UNICOHERENT) THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; let UNICOHERENT_TRANSLATION = prove (`!a:real^N s. unicoherent (IMAGE (\x. a + x) s) <=> unicoherent s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [UNICOHERENT_TRANSLATION];; let UNICOHERENT_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (unicoherent(IMAGE f s) <=> unicoherent s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; HOMEOMORPHIC_REFL]);; add_linear_invariants [UNICOHERENT_INJECTIVE_LINEAR_IMAGE];; let HOMEOMORPHISM_UNICOHERENCE = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (unicoherent(IMAGE f k) <=> unicoherent k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let BORSUKIAN_IMP_UNICOHERENT = prove (`!u:real^N->bool. borsukian u ==> unicoherent u`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[unicoherent] THEN SUBGOAL_THEN `!f. f continuous_on u /\ IMAGE f u SUBSET sphere(vec 0,&1) ==> ?a. homotopic_with (\h. T) (u,(:complex) DIFF {Cx (&0)}) (f:real^N->complex) (\t. a)` MP_TAC THENL [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [BORSUKIAN_CIRCLE]) THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`) THEN ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_SUBSET_RIGHT) THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN REWRITE_TAC[IN_SPHERE; DIST_REFL] THEN REAL_ARITH_TAC; POP_ASSUM(K ALL_TAC)] THEN REWRITE_TAC[sphere; DIST_0; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN REPEAT STRIP_TAC THEN SIMP_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `closed_in (subtopology euclidean u) (v:real^N->bool) /\ closed_in (subtopology euclidean u) (w:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_INTER; CLOSED_IN_TRANS]; ALL_TAC] THEN MP_TAC(ISPECL [`v:real^N->bool`; `w:real^N->bool`; `u:real^N->bool`; `vec 0:real^1`; `vec 1:real^1`] URYSOHN_LOCAL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^1` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?g:real^N->real^2. g continuous_on u /\ IMAGE g u SUBSET {x | norm x = &1} /\ (!x. x IN s ==> g(x) = cexp(Cx pi * ii * Cx(drop(q x)))) /\ (!x. x IN t ==> g(x) = inv(cexp(Cx pi * ii * Cx(drop(q x)))))` (DESTRUCT_TAC "@g. cont circle s t") THENL [EXISTS_TAC `\x. if (x:real^N) IN s then cexp(Cx pi * ii * Cx(drop(q x))) else inv(cexp(Cx pi * ii * Cx(drop(q x))))` THEN SUBGOAL_THEN `!x:real^N. x IN s INTER t ==> cexp(Cx pi * ii * Cx(drop(q x))) = inv(cexp(Cx pi * ii * Cx(drop (q x))))` ASSUME_TAC THENL [SUBST1_TAC(SYM(ASSUME `v UNION w:real^N->bool = s INTER t`)) THEN REWRITE_TAC[IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_INV_1] THEN REWRITE_TAC[COMPLEX_MUL_RID; EULER] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II] THEN REWRITE_TAC[RE_II; IM_II; REAL_MUL_RZERO; REAL_MUL_RID] THEN REWRITE_TAC[REAL_EXP_0; COMPLEX_MUL_LID; COS_PI; SIN_PI] THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN SIMP_TAC[] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "u" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[SET_RULE `P /\ ~P \/ x IN t /\ x IN s <=> x IN s INTER t`] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CEXP_NZ]] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_NORM_INV; NORM_CEXP] THEN REWRITE_TAC[RE_MUL_CX; RE_MUL_II; IM_CX] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0; REAL_INV_1]; GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MP_TAC o SPEC `g:real^N->complex`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `(?n. integer n /\ !x:real^N. x IN s ==> h(x) - Cx pi * ii * Cx (drop (q x)) = Cx(&2 * n * pi) * ii) /\ (?n. integer n /\ !x:real^N. x IN t ==> h(x) + Cx pi * ii * Cx (drop (q x)) = Cx(&2 * n * pi) * ii)` (CONJUNCTS_THEN2 (X_CHOOSE_THEN `m:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) (X_CHOOSE_THEN `n:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THENL [CONJ_TAC THEN MATCH_MP_TAC(MESON[] `(?x. x IN s) /\ (!x. x IN s ==> ?n. P n /\ f x = k n) /\ (?a. !x. x IN s ==> f x = a) ==> (?n. P n /\ !x. x IN s ==> f x = k n)`) THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN (CONJ_TAC THENL [REWRITE_TAC[COMPLEX_RING `a + b:complex = c <=> a = --b + c`; COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN REWRITE_TAC[GSYM CEXP_EQ; CEXP_NEG] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(LABEL_TAC "*") THEN MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [(MATCH_MP_TAC CONTINUOUS_ON_ADD ORELSE MATCH_MP_TAC CONTINUOUS_ON_SUB) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ALL_TAC] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `&2 * pi` THEN REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REMOVE_THEN "*" (fun th -> MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPLEX_EQ_MUL_RCANCEL; II_NZ; GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL; CX_INJ; COMPLEX_NORM_II; REAL_MUL_RID] THEN REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_EQ_MUL_LCANCEL; GSYM REAL_SUB_LDISTRIB] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN REWRITE_TAC[REAL_EQ_MUL_RCANCEL; PI_NZ; REAL_ABS_PI] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `&2 * p <= &2 * a * p <=> &0 <= &2 * p * (a - &1)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[PI_POS_LE; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN ASM_SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0]]); ALL_TAC] THEN GEN_REWRITE_TAC I [TAUT `p ==> q ==> F <=> ~(p /\ q)`] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `(!x. x IN s ==> P x) /\ (!x. x IN t ==> Q x) ==> ~(v = {}) /\ ~(w = {}) /\ v UNION w SUBSET s INTER t ==> ~(!y z. y IN v /\ z IN w ==> ~(P y /\ Q y /\ P z /\ Q z))`)) THEN ANTS_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING `y + p = n /\ y - p = m /\ z + q = n /\ z - q = m ==> q:complex = p`)) THEN REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; COMPLEX_ENTIRE; CX_INJ] THEN REWRITE_TAC[PI_NZ; II_NZ; REAL_OF_NUM_EQ; ARITH_EQ]);; let CONTRACTIBLE_IMP_UNICOHERENT = prove (`!u:real^N->bool. contractible u ==> unicoherent u`, SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONTRACTIBLE_IMP_BORSUKIAN]);; let CONVEX_IMP_UNICOHERENT = prove (`!u:real^N->bool. convex u ==> unicoherent u`, SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONVEX_IMP_BORSUKIAN]);; let UNICOHERENT_UNIV = prove (`unicoherent(:real^N)`, SIMP_TAC[CONVEX_IMP_UNICOHERENT; CONVEX_UNIV]);; let UNICOHERENT_MONOTONE_IMAGE_COMPACT = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ compact s /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ unicoherent s ==> unicoherent t`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `compact(t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE]; REWRITE_TAC[unicoherent]] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN DISCH_THEN(MP_TAC o SPECL [`{x | x IN s /\ (f:real^M->real^N) x IN u}`; `{x | x IN s /\ (f:real^M->real^N) x IN v}`]) THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; SUBSET_RESTRICT; CONTINUOUS_CLOSED_PREIMAGE; CONJ_ASSOC] THEN REWRITE_TAC[IMP_CONJ_ALT] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] CONNECTED_CLOSED_MONOTONE_PREIMAGE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_IMP_CLOSED_MAP]; ALL_TAC] THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Several common variants of unicoherence for R^n. *) (* ------------------------------------------------------------------------- *) let CONNECTED_FRONTIER_SIMPLE = prove (`!s. connected(s) /\ connected((:real^N) DIFF s) ==> connected(frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES] THEN MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN ASM_SIMP_TAC[CLOSED_CLOSURE; CONNECTED_CLOSURE] THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure s /\ t SUBSET closure t /\ s UNION t = UNIV ==> closure s UNION closure t = UNIV`) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN SET_TAC[]);; let CONNECTED_FRONTIER_COMPONENT_COMPLEMENT = prove (`!s c:real^N->bool. connected s /\ c IN components((:real^N) DIFF s) ==> connected(frontier c)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_FRONTIER_SIMPLE THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV]]);; let CONNECTED_FRONTIER_DISJOINT = prove (`!s t:real^N->bool. connected s /\ connected t /\ DISJOINT s t /\ frontier s SUBSET frontier t ==> connected(frontier s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s = (:real^N)` THEN ASM_REWRITE_TAC[FRONTIER_UNIV; CONNECTED_EMPTY] THEN SUBGOAL_THEN `?c. c IN components((:real^N) DIFF s) /\ t SUBSET c` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `frontier s:real^N->bool = frontier c` SUBST1_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONNECTED_FRONTIER_COMPONENT_COMPLEMENT]] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[frontier; IN_DIFF] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP SUBSET_CLOSURE) THEN ASM_MESON_TAC[SUBSET; frontier; IN_DIFF]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM FRONTIER_COMPLEMENT]) THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `u SUBSET t ==> x IN s DIFF t ==> ~(x IN u)`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_MESON_TAC[IN_COMPONENTS_SUBSET]]; GEN_REWRITE_TAC RAND_CONV [GSYM FRONTIER_COMPLEMENT] THEN ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET]]);; let SEPARATION_BY_COMPONENT_CLOSED_POINTWISE = prove (`!s a b. closed s /\ ~connected_component ((:real^N) DIFF s) a b ==> ?c. c IN components s /\ ~connected_component((:real^N) DIFF c) a b`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [EXISTS_TAC `connected_component s (a:real^N)` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]; ALL_TAC] THEN ASM_CASES_TAC `(b:real^N) IN s` THENL [EXISTS_TAC `connected_component s (b:real^N)` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IRREDUCIBLE_SEPARATOR) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?c:real^N->bool. c IN components s /\ t SUBSET c` MP_TAC THENL [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(t b) ==> s SUBSET t ==> ~(s b)`)) THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`connected_component ((:real^N) DIFF t) a`; `connected_component ((:real^N) DIFF t) b`] CONNECTED_FRONTIER_DISJOINT) THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_DISJOINT] THEN ASM_REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN SUBGOAL_THEN `frontier(connected_component ((:real^N) DIFF t) a) = t /\ frontier(connected_component ((:real^N) DIFF t) b) = t` (fun th -> ASM_REWRITE_TAC[th; SUBSET_REFL]) THEN CONJ_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE THENL [EXISTS_TAC `b:real^N`; EXISTS_TAC `a:real^N`] THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; let SEPARATION_BY_COMPONENT_CLOSED = prove (`!s. closed s /\ ~connected((:real^N) DIFF s) ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`, REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNIV] THEN MP_TAC SEPARATION_BY_COMPONENT_CLOSED_POINTWISE THEN MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[REWRITE_RULE[SUBSET] IN_COMPONENTS_SUBSET]);; let SEPARATION_BY_UNION_CLOSED_POINTWISE = prove (`!s t a b. closed s /\ closed t /\ DISJOINT s t /\ connected_component ((:real^N) DIFF s) a b /\ connected_component ((:real^N) DIFF t) a b ==> connected_component ((:real^N) DIFF (s UNION t)) a b`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN (fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP CONNECTED_COMPONENT_IN th))) THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SEPARATION_BY_COMPONENT_CLOSED_POINTWISE)) THEN ASM_SIMP_TAC[CLOSED_UNION; NOT_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(c:real^N->bool) SUBSET s \/ c SUBSET t` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN REWRITE_TAC[CONNECTED_CLOSED; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; UNDISCH_TAC `connected_component ((:real^N) DIFF s) a b`; UNDISCH_TAC `connected_component ((:real^N) DIFF t) a b`] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s b ==> t b`) THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);; let SEPARATION_BY_UNION_CLOSED = prove (`!s t:real^N->bool. closed s /\ closed t /\ DISJOINT s t /\ connected((:real^N) DIFF s) /\ connected((:real^N) DIFF t) ==> connected((:real^N) DIFF (s UNION t))`, SIMP_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNION; IN_UNIV] THEN MESON_TAC[SEPARATION_BY_UNION_CLOSED_POINTWISE]);; let OPEN_UNICOHERENT_UNIV = prove (`!s t. open s /\ open t /\ connected s /\ connected t /\ s UNION t = (:real^N) ==> connected(s INTER t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s INTER t = UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t))`] THEN MATCH_MP_TAC SEPARATION_BY_UNION_CLOSED THEN ASM_SIMP_TAC[GSYM OPEN_CLOSED; COMPL_COMPL] THEN ASM SET_TAC[]);; let SEPARATION_BY_COMPONENT_OPEN = prove (`!s. open s /\ ~connected((:real^N) DIFF s) ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`, let lemma = prove (`!s t u. closed s /\ closed t /\ s INTER t = {} /\ connected u /\ ~(u INTER s = {}) /\ ~(u INTER t = {}) ==> ?c. c IN components((:real^N) DIFF (s UNION t)) /\ ~(c INTER u = {}) /\ ~(frontier c INTER s = {}) /\ ~(frontier c INTER t = {})`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`s UNION UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\ frontier c SUBSET s}`; `t UNION UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\ frontier c SUBSET t}`] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s SUBSET t UNION u`) THEN MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) (SPEC_ALL FRONTIER_UNION_SUBSET)) THEN ASM_REWRITE_TAC[UNION_SUBSET; FRONTIER_SUBSET_EQ] THEN MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) (SPEC_ALL FRONTIER_UNIONS_SUBSET_CLOSURE)) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[UNIONS_SUBSET] THEN SIMP_TAC[FORALL_IN_GSPEC]; ALL_TAC]) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(s UNION t) UNION UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\ ~(c INTER u = {})}` THEN CONJ_TAC THENL [MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` UNIONS_COMPONENTS) THEN SET_TAC[]; MATCH_MP_TAC(SET_RULE `c SUBSET d UNION e ==> (s UNION t) UNION c SUBSET (s UNION d) UNION (t UNION e)`) THEN REWRITE_TAC[GSYM UNIONS_UNION] THEN MATCH_MP_TAC SUBSET_UNIONS THEN ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[DE_MORGAN_THM] THEN MATCH_MP_TAC(SET_RULE `c SUBSET s UNION t ==> c INTER s = {} \/ c INTER t = {} ==> c SUBSET s \/ c SUBSET t`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN ASM_SIMP_TAC[FRONTIER_SUBSET_EQ; CLOSED_UNION]]; MATCH_MP_TAC(SET_RULE `c UNION d SUBSET UNIV DIFF (s UNION t) /\ s INTER t = {} /\ DISJOINT c d ==> (s UNION c) INTER (t UNION d) INTER u = {}`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM UNIONS_UNION] THEN GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[]; MATCH_MP_TAC(SET_RULE `(!s. s IN c ==> !t. t IN c' ==> s INTER t = {}) ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` COMPONENTS_NONOVERLAP) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `c':real^N->bool` THEN ASM_CASES_TAC `c':real^N->bool = c` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c SUBSET s ==> s INTER t = {} /\ ~(c = {}) ==> ~(c SUBSET t)`)) THEN ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]]; ASM SET_TAC[]; ASM SET_TAC[]]) in GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[CONNECTED_CLOSED_SET; GSYM OPEN_CLOSED; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`t:real^N->bool`; `u:real^N->bool`; `(:real^N)`] lemma) THEN ASM_REWRITE_TAC[CONNECTED_UNIV; COMPL_COMPL] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `c:real^N->bool` CONNECTED_FRONTIER_SIMPLE) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONNECTED_CLOSED] THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN ASM_REWRITE_TAC[FRONTIER_SUBSET_EQ; GSYM OPEN_CLOSED]);; let SEPARATION_BY_UNION_OPEN = prove (`!s t:real^N->bool. open s /\ open t /\ DISJOINT s t /\ connected((:real^N) DIFF s) /\ connected((:real^N) DIFF t) ==> connected((:real^N) DIFF (s UNION t))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`] THEN MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; let CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS = prove (`!s t:real^N->bool. open s /\ connected s /\ open t /\ connected t /\ DISJOINT (frontier s) (frontier t) ==> connected(s INTER t)`, let lemma = prove (`~(f = {}) ==> s UNION UNIONS f = UNIONS {s UNION c | c IN f}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[INTER_EMPTY; CONNECTED_EMPTY] THEN MAP_EVERY ASM_CASES_TAC [`s = (:real^N)`; `t = (:real^N)`] THEN ASM_REWRITE_TAC[INTER_UNIV; CONNECTED_UNIV] THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN MP_TAC(ISPECL [`s UNION UNIONS {c | c IN components((:real^N) DIFF closure t) /\ ~(c INTER s = {})}`; `t UNION UNIONS {c | c IN components((:real^N) DIFF closure s) /\ ~(c INTER t = {})}`] OPEN_UNICOHERENT_UNIV) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; MATCH_MP_TAC(MESON[] `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s)) ==> connected(u UNION UNIONS s)`) THEN STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION]; MATCH_MP_TAC(MESON[] `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s)) ==> connected(u UNION UNIONS s)`) THEN STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION]; GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE `DISJOINT s t ==> !x. ~(x IN s) \/ ~(x IN t)`)) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN STRIP_TAC THENL [SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))` MP_TAC THENL [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; ALL_TAC] THEN SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))` MP_TAC THENL [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; ALL_TAC]; SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))` MP_TAC THENL [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; ALL_TAC] THEN SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))` MP_TAC THENL [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; ALL_TAC]] THEN (FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT s t ==> !c d. ~(c = {}) /\ c SUBSET s /\ d SUBSET t /\ c = d ==> p`)) THEN MAP_EVERY EXISTS_TAC [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM] THEN ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_SUBSET; SET_RULE `s SUBSET UNIV DIFF t /\ s = UNIV ==> t = {}`; CLOSURE_EQ_EMPTY]; ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THENL [EXISTS_TAC `(:real^N) DIFF closure t`; EXISTS_TAC `(:real^N) DIFF closure s`] THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM SET_TAC[]])])]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `s INTER t' = {} /\ t INTER s' = {} /\ s' INTER t' = {} ==> (s UNION s') INTER (t UNION t') = s INTER t`) THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC; UNIONS_SUBSET] THEN REPEAT CONJ_TAC THEN X_GEN_TAC `d:real^N->bool` THENL [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN MP_TAC(ISPECL [`(:real^N) DIFF closure s`; `d:real^N->bool`] IN_COMPONENTS_SUBSET) THEN SET_TAC[]; MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN MP_TAC(ISPECL [`(:real^N) DIFF closure t`; `d:real^N->bool`] IN_COMPONENTS_SUBSET) THEN SET_TAC[]; STRIP_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC] THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT s t ==> !c d. c SUBSET s /\ d SUBSET t /\ ~(c INTER d = {}) ==> F`)) THEN MAP_EVERY EXISTS_TAC [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; ALL_TAC]) THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_FRONTIER_COMPONENT_COMPLEMENT THEN EXISTS_TAC `closure s:real^N->bool` THEN ASM_MESON_TAC[CONNECTED_CLOSURE]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `c DIFF d = c INTER (UNIV DIFF d)`] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC; MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN EXISTS_TAC `closure t:real^N->bool` THEN ASM_SIMP_TAC[CONNECTED_UNIV; SUBSET_UNIV; CONNECTED_CLOSURE]; ALL_TAC; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);; let NONSEPARATION_BY_COMPONENT_EQ = prove (`!s. (open s \/ closed s) ==> ((!c. c IN components s ==> connected((:real^N) DIFF c)) <=> connected((:real^N) DIFF s))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[SEPARATION_BY_COMPONENT_OPEN]; ALL_TAC; ASM_MESON_TAC[SEPARATION_BY_COMPONENT_CLOSED]; ALL_TAC] THEN MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN EXISTS_TAC `(:real^N) DIFF s` THEN ASM_REWRITE_TAC[CONNECTED_UNIV; SUBSET_UNIV; COMPL_COMPL]);; let CONNECTED_COMMON_FRONTIER_DOMAINS = prove (`!s t c:real^N->bool. open s /\ connected s /\ open t /\ connected t /\ ~(s = t) /\ frontier s = c /\ frontier t = c ==> connected c`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] COMMON_FRONTIER_DOMAINS) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] CONNECTED_FRONTIER_DISJOINT) THEN ASM_REWRITE_TAC[SUBSET_REFL]);; (* ------------------------------------------------------------------------- *) (* The frontier of an ANR is locally connected (this is only this late *) (* since it's handy to use basics about unicoherence). *) (* ------------------------------------------------------------------------- *) let LOCALLY_CONNECTED_FRONTIER_ANR = prove (`!s:real^N->bool. compact s /\ ANR s ==> locally connected (frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `p:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `p:real^N`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] ANR_IMP_NEIGHBOURHOOD_RETRACT) THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `frontier(s:real^N->bool) SUBSET s` ASSUME_TAC THENL [ASM_SIMP_TAC[FRONTIER_SUBSET_EQ; COMPACT_IMP_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `(p:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?d. &0 < d /\ d < e /\ {x + l:real^N | x IN s /\ l IN cball(vec 0,d)} SUBSET u /\ !y:real^N. dist(p,y) <= d ==> dist(p,r y) <= e` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?d. &0 < d /\ {x + l:real^N | x IN s /\ l IN cball(vec 0,d)} SUBSET u` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SET_RULE `{f x y | x IN {} /\ P y} SUBSET u`] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN ASM_CASES_TAC `u = (:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN EXISTS_TAC `setdist(s,(:real^N) DIFF u) / &2` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[REAL_HALF; SETDIST_POS_LT] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]; REWRITE_TAC[REAL_HALF; SUBSET; FORALL_IN_GSPEC] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `l:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[IN_CBALL_0] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < s /\ s <= e ==> ~(e <= s / &2)`) THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(NORM_ARITH `norm(l:real^N) = dist(x,x + l)`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `e:real`)] THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d':real` THEN STRIP_TAC THEN EXISTS_TAC `min (e / &2) (min d (d' / &2))` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LE_MIN; REAL_HALF; CBALL_MIN_INTER] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CONJ_ASSOC]] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN UNDISCH_TAC `{x + l:real^N | x IN s /\ l IN cball(vec 0,d)} SUBSET u` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_CBALL_0] THEN MAP_EVERY EXISTS_TAC [`p:real^N`; `y - p:real^N`] THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN CONV_TAC VECTOR_ARITH]; ABBREV_TAC `sd = {x + l:real^N | x IN s /\ l IN cball(vec 0,d)}`] THEN SUBGOAL_THEN `(s:real^N->bool) SUBSET interior sd` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `{x + l:real^N | x IN s /\ l IN ball(vec 0,d)}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `vec 0 IN t /\ (!x:real^N. f x (vec 0) = x) ==> s SUBSET {f x y | x IN s /\ y IN t}`) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; SIMP_TAC[INTERIOR_MAXIMAL_EQ; OPEN_SUMS; OPEN_BALL] THEN EXPAND_TAC "sd" THEN REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(s:real^N->bool) SUBSET sd` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; INTERIOR_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `compact(sd:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "sd" THEN ASM_SIMP_TAC[COMPACT_SUMS; COMPACT_CBALL]; ALL_TAC] THEN SUBGOAL_THEN `?k. &0 < k /\ k <= d /\ (!x. ~(x IN u) ==> k <= dist(p,x)) /\ (!c x. c IN components(cball(p,d) DIFF s) /\ ~(p IN closure c) /\ x IN c ==> k <= dist(p:real^N,x))` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN STRIP_TAC THEN EXISTS_TAC `inf (k INSERT (d / &2) INSERT IMAGE (\c. setdist({p:real^N},c)) {c | c IN components (cball (p,d) DIFF s) /\ ~(closure c INTER cball (p,d / &2) = {}) /\ ~(p IN closure c)})` THEN MP_TAC(ISPECL [`s:real^N->bool`; `p:real^N`; `d / &2`; `d:real`] FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC) THEN ASM_REWRITE_TAC[REAL_ARITH `e / &2 < e <=> &0 < e`] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} = {x | x IN {y | P y /\ Q y} /\ R x}`] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; NOT_INSERT_EMPTY; FINITE_INSERT; FINITE_IMAGE; FINITE_RESTRICT; REAL_INF_LE_FINITE] THEN REWRITE_TAC[EXISTS_IN_INSERT; FORALL_IN_INSERT] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_IN_GSPEC] THEN ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; REAL_HALF] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `c:real^N->bool` THEN REPEAT DISCH_TAC THEN REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; DISJ2_TAC THEN DISJ1_TAC THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DIST_SYM]; MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `x:real^N`] THEN REPEAT DISCH_TAC THEN DISJ2_TAC THEN ASM_CASES_TAC `closure c INTER cball(p:real^N,d / &2) = {}` THENL [DISJ1_TAC THEN TRANS_TAC REAL_LE_TRANS `setdist({p:real^N},c)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_SETDIST THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IMP_CONJ; IN_SING] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N` o GEN_REWRITE_RULE I [EXTENSION]) THEN ASM_SIMP_TAC[IN_INTER; CLOSURE_INC; NOT_IN_EMPTY; IN_CBALL] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]]; DISJ2_TAC THEN EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]]]; ALL_TAC] THEN EXISTS_TAC `frontier s INTER ball(p:real^N,k)` THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; SUBGOAL_THEN `ball(p:real^N,k) SUBSET cball(p,e)` MP_TAC THENL [REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ASM SET_TAC[]]; X_GEN_TAC `q:real^N` THEN REWRITE_TAC[IN_BALL] THEN STRIP_TAC] THEN SUBGOAL_THEN `?c. c IN components(cball(p:real^N,d) DIFF s) /\ q IN closure c` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `q IN closure (UNIONS {c | c IN components (cball(p:real^N,d) DIFF s) /\ ~(closure c INTER cball(p,(k + dist (p,q)) / &2) = {})} UNION UNIONS {c | c IN components (cball(p,d) DIFF s) /\ closure c INTER cball(p,(k + dist (p,q)) / &2) = {}})` MP_TAC THENL [REWRITE_TAC[GSYM UNIONS_UNION; GSYM UNIONS_COMPONENTS; SET_RULE `{x | x IN s /\ ~P x} UNION {x | x IN s /\ P x} = s`] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN EXISTS_TAC `closure(ball(p:real^N,d) DIFF s)` THEN SIMP_TAC[SUBSET_CLOSURE; BALL_SUBSET_CBALL; SET_RULE `s SUBSET t ==> s DIFF c SUBSET t DIFF c`] THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_SUBSET o rand o snd) THEN REWRITE_TAC[OPEN_BALL] THEN MATCH_MP_TAC(SET_RULE `x IN s ==> s SUBSET t ==> x IN t`) THEN ASM_REWRITE_TAC[IN_BALL; IN_INTER] THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; FRONTIER_COMPLEMENT; IN_UNION] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_UNION; IN_UNION] THEN MATCH_MP_TAC(TAUT `~q /\ (p ==> r) ==> p \/ q ==> r`) THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. ~(x IN t) /\ s SUBSET t ==> ~(x IN s)`) THEN EXISTS_TAC `(:real^N) DIFF ball(p,(k + dist(p,q)) / &2)` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_BALL] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `d INTER cball(x:real^N,r) = {} ==> ball(x,r) SUBSET cball(x,r) ==> ball(x,r) INTER d = {}`)) THEN SIMP_TAC[BALL_SUBSET_CBALL; OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_BALL] THEN SET_TAC[]; MP_TAC(ISPECL [`s:real^N->bool`; `p:real^N`; `(k + dist(p:real^N,q)) / &2`; `d:real`] FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[CLOSURE_UNIONS]] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN MESON_TAC[]]]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM REAL_NOT_LT; GSYM IN_BALL] THEN REWRITE_TAC[SET_RULE `~(x IN s) <=> x IN (UNIV DIFF s)`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] FORALL_IN_CLOSURE))) THEN REWRITE_TAC[CONTINUOUS_ON_ID; GSYM OPEN_CLOSED; OPEN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `q:real^N`) THEN ASM_REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL]; DISCH_TAC] THEN SUBGOAL_THEN `(p:real^N) IN frontier c /\ (q:real^N) IN frontier c` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN RULE_ASSUM_TAC(REWRITE_RULE[CLOSURE_UNION_FRONTIER]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?g. path g /\ pathstart g:real^N = p /\ pathfinish g = q /\ (!t. t IN interval(vec 0,vec 1) ==> g t IN c)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`] ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `cball(p:real^N,d)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `q:real^N` th) THEN MP_TAC(SPEC `p:real^N` th)) THEN ASM_REWRITE_TAC[INTERIOR_CBALL; CENTRE_IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_BALL] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `path_component c (pathstart g1:real^N) (pathstart g2)` MP_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) PATH_COMPONENT_EQ_CONNECTED_COMPONENT o rator o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `cball(p:real^N,d) DIFF s` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `cball(p:real^N,d)` THEN ASM_SIMP_TAC[OPEN_IN_DIFF_CLOSED; COMPACT_IMP_CLOSED] THEN SIMP_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; CONVEX_CBALL; CONVEX_IMP_LOCALLY_CONNECTED]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^N->bool` THEN REWRITE_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN REWRITE_TAC[pathstart] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_DELETE; ENDS_IN_UNIT_INTERVAL; VEC_EQ; ARITH_EQ]]; REWRITE_TAC[path_component] THEN DISCH_THEN(X_CHOOSE_THEN `g3:real^1->real^N` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `reversepath g1 ++ g3 ++ g2:real^1->real^N` THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN ASM_SIMP_TAC[PATH_REVERSEPATH; ARC_IMP_PATH] THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN REWRITE_TAC[joinpaths; reversepath] THEN REWRITE_TAC[DROP_SUB; DROP_VEC; DROP_CMUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[path_image; SUBSET; FORALL_IN_IMAGE]) THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_CMUL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `path_image g SUBSET cball(p:real^N,d)` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `closure c:real^N->bool` THEN CONJ_TAC THENL [REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN SIMP_TAC[CLOSED_OPEN_INTERVAL_1; DROP_VEC; REAL_POS] THEN REWRITE_TAC[IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[CLOSURE_INC; pathstart; pathfinish]; MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CBALL] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[]]; ALL_TAC] THEN MP_TAC(ISPECL [`cball(p:real^N,e) INTER s`; `IMAGE (r:real^N->real^N) (path_image g)`] EXISTS_COMPONENT_SUPERSET) THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_CBALL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM IN_CBALL] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE r u SUBSET s ==> t SUBSET u ==> IMAGE r t SUBSET s`)); REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `p:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_CBALL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))] THEN TRANS_TAC SUBSET_TRANS `sd:real^N->bool` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `cball(p:real^N,d)` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "sd" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_CBALL] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`p:real^N`; `y - p:real^N`] THEN ASM_REWRITE_TAC[DIST_0] THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN CONV_TAC VECTOR_ARITH; DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC)] THEN ABBREV_TAC `h = connected_component (cball(p:real^N,e) DIFF f) (g(lift(&1 / &2)))` THEN MP_TAC(ISPEC `cball(p:real^N,e)` CONVEX_IMP_UNICOHERENT) THEN REWRITE_TAC[CONVEX_CBALL; unicoherent] THEN DISCH_THEN(MP_TAC o SPECL [`cball(p:real^N,e) DIFF h:real^N->bool`; `closure h:real^N->bool`]) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN EXISTS_TAC `f:real^N->bool` THEN REWRITE_TAC[CONNECTED_CBALL] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET_INTER]; EXPAND_TAC "h" THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EXISTS_TAC `g(lift(&1 / &2)):real^N` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `lift(&1 / &2)`) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN SUBGOAL_THEN `cball(p:real^N,d) SUBSET cball(p,e)` MP_TAC THENL [ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ASM SET_TAC[]]]; MATCH_MP_TAC CONNECTED_CLOSURE THEN EXPAND_TAC "h" THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]; MATCH_MP_TAC(SET_RULE `h SUBSET c /\ c SUBSET b ==> (b DIFF h) UNION c = b`) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CBALL] THEN EXPAND_TAC "h" THEN TRANS_TAC SUBSET_TRANS `cball(p:real^N,e) DIFF f` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `cball(p:real^N,e) DIFF f` THEN CONJ_TAC THENL [EXPAND_TAC "h" THEN MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `cball(p:real^N,e)` THEN SIMP_TAC[CONVEX_CBALL; CONVEX_IMP_LOCALLY_CONNECTED]; ALL_TAC] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN TRANS_TAC CLOSED_IN_TRANS `cball(p:real^N,e) INTER s` THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; COMPACT_IMP_CLOSED] THEN ASM_SIMP_TAC[CLOSED_IN_COMPONENT]; MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CBALL] THEN EXPAND_TAC "h" THEN TRANS_TAC SUBSET_TRANS `cball(p:real^N,e) DIFF f` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[]]; ABBREV_TAC `j = (cball(p:real^N,e) DIFF h) INTER closure h` THEN DISCH_TAC] THEN EXISTS_TAC `j:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `cball(p:real^N,e) INTER frontier s` THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXPAND_TAC "j" THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_INTER] THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^N) IN f` ASSUME_TAC THENL [MP_TAC(ISPECL [`cball(p:real^N,e) DIFF f`; `g(lift(&1 / &2)):real^N`] CLOSED_IN_CONNECTED_COMPONENT) THEN ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[frontier; IN_DIFF] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CLOSURE_INC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `cball(p:real^N,e) INTER ball(x,r) SUBSET f` ASSUME_TAC THENL [MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `cball(p:real^N,e) INTER s` THEN ASM_SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTER; CONVEX_BALL; CONVEX_CBALL] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`x:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSURE_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM IN_BALL)] THEN MP_TAC(ISPECL [`cball(p:real^N,e) DIFF f`; `g(lift(&1 / &2)):real^N`] CONNECTED_COMPONENT_SUBSET) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; SUBGOAL_THEN `!t. t IN closure(interval(vec 0,vec 1)) ==> (g:real^1->real^N) t IN closure h` MP_TAC THENL [MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_CLOSURE] THEN SIMP_TAC[CLOSURE_OPEN_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN ASM_REWRITE_TAC[GSYM path] THEN REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN TRANS_TAC SUBSET_TRANS `h:real^N->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN EXPAND_TAC "h" THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV; MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[GSYM path; INTERVAL_OPEN_SUBSET_CLOSED]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN SUBGOAL_THEN `cball(p:real^N,d) SUBSET cball(p,e)` MP_TAC THENL [ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ASM SET_TAC[]]]; SIMP_TAC[CLOSURE_OPEN_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `vec 1:real^1` th) THEN MP_TAC(SPEC `vec 0:real^1` th)) THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[IMP_IMP; ENDS_IN_UNIT_INTERVAL] THEN EXPAND_TAC "j" THEN MATCH_MP_TAC MONO_AND THEN SIMP_TAC[IN_INTER] THEN CONJ_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN (MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[IN_CBALL; DIST_REFL] THEN ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN EXPAND_TAC "h" THEN MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SUBSET; SUBSET] `~(p IN s) ==> ~(p IN connected_component s r)`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN MATCH_MP_TAC(SET_RULE `r x = x /\ x IN s ==> x IN IMAGE r s`) THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; pathstart; pathfinish]]]);; (* ------------------------------------------------------------------------- *) (* Another interesting equivalent of an inessential mapping into C-{0} *) (* ------------------------------------------------------------------------- *) let INESSENTIAL_EQ_EXTENSIBLE = prove (`!f s. closed s ==> ((?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=> (?g. g continuous_on (:real^N) /\ (!x. x IN s ==> g x = f x) /\ (!x. ~(g x = Cx(&0)))))`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `\x:real^N. Cx(&1)` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; NOT_IN_EMPTY] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN FIRST_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] BORSUK_HOMOTOPY_EXTENSION)) o GEN_REWRITE_RULE I [HOMOTOPIC_WITH_SYM]) THEN ASM_REWRITE_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN ASM_SIMP_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN MP_TAC(ISPECL [`vec 0:real^N`; `&1`] HOMEOMORPHIC_BALL_UNIV) THEN REWRITE_TAC[REAL_LT_01; homeomorphic; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN REWRITE_TAC[homeomorphism; IN_UNIV] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(g:real^N->complex) o (h:real^N->real^N)`; `vec 0:real^N`; `&1`] CONTINUOUS_LOGARITHM_ON_BALL) THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `j:real^N->complex` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(j:real^N->complex) o (k:real^N->real^N)` THEN ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Another simple case where sphere maps are nullhomotopic. *) (* ------------------------------------------------------------------------- *) let INESSENTIAL_SPHEREMAP_2 = prove (`!f:real^M->real^N a r b s. 2 < dimindex(:M) /\ dimindex(:N) = 2 /\ f continuous_on sphere(a,r) /\ IMAGE f (sphere(a,r)) SUBSET (sphere(b,s)) ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`, let lemma = prove (`!f:real^N->real^2 a r. 2 < dimindex(:N) /\ f continuous_on sphere(a,r) /\ IMAGE f (sphere(a,r)) SUBSET (sphere(vec 0,&1)) ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(vec 0,&1)) f (\x. c)`, REPEAT STRIP_TAC THEN REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN MP_TAC(ISPECL [`f:real^N->real^2`; `sphere(a:real^N,r)`] CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE_EQ; LOCALLY_PATH_CONNECTED_SPHERE] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[ARITH_RULE `3 <= n <=> 2 < n`] THEN FIRST_X_ASSUM (MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f s SUBSET t ==> (!x. P x ==> ~(x IN t)) ==> !x. x IN s ==> ~P(f x)`)) THEN SIMP_TAC[COMPLEX_NORM_0; IN_SPHERE_0] THEN REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^2` STRIP_ASSUME_TAC) THEN EXISTS_TAC `Im o (g:real^N->real^2)` THEN CONJ_TAC THENL [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[o_DEF; COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[IN_SPHERE_0; NORM_CEXP; REAL_EXP_EQ_1] THEN REAL_ARITH_TAC]]) and hslemma = prove (`!a:real^M r b:real^N s. dimindex(:M) = dimindex(:N) /\ &0 < r /\ &0 < s ==> (sphere(a,r) homeomorphic sphere(b,s))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `s <= &0` THEN ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN SUBGOAL_THEN `(sphere(b:real^N,s)) homeomorphic (sphere(vec 0:real^2,&1))` MP_TAC THENL [ASM_SIMP_TAC[hslemma; REAL_LT_01; DIMINDEX_2]; REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^2`; `k:real^2->real^N`] THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(h:real^N->real^2) o (f:real^M->real^N)`; `a:real^M`; `r:real`] lemma) THEN ASM_REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; DISCH_THEN(X_CHOOSE_THEN `c:real^2` (fun th -> EXISTS_TAC `(k:real^2->real^N) c` THEN MP_TAC th)) THEN DISCH_THEN(MP_TAC o ISPEC `k:real^2->real^N` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN DISCH_THEN(MP_TAC o SPEC `sphere(b:real^N,s)`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Janiszewski's theorem. *) (* ------------------------------------------------------------------------- *) let JANISZEWSKI = prove (`!s t a b:real^2. compact s /\ closed t /\ connected(s INTER t) /\ connected_component ((:real^2) DIFF s) a b /\ connected_component ((:real^2) DIFF t) a b ==> connected_component ((:real^2) DIFF (s UNION t)) a b`, let lemma = prove (`!s t a b:real^2. compact s /\ compact t /\ connected(s INTER t) /\ connected_component ((:real^2) DIFF s) a b /\ connected_component ((:real^2) DIFF t) a b ==> connected_component ((:real^2) DIFF (s UNION t)) a b`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN FIRST_X_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN)) THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ; DIMINDEX_2; LE_REFL; COMPACT_UNION; IN_UNION] THEN ONCE_REWRITE_TAC[HOMOTOPIC_CIRCLEMAPS_DIV] THEN REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN ASM_SIMP_TAC[BORSUK_MAP_INTO_SPHERE; CONTINUOUS_ON_BORSUK_MAP; IN_UNION] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `g:real^2->real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `h:real^2->real` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) (t:real^2->bool)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL [EXISTS_TAC `s:real^2->bool`; EXISTS_TAC `t:real^2->bool`] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `s INTER t:real^2->bool = {}` THENL [EXISTS_TAC `(\x. if x IN s then g x else h x):real^2->real` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[o_DEF; COND_RAND] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\x:real^2. lift(g x) - lift(h x)`; `s INTER t:real^2->bool`] CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[GSYM CONTINUOUS_ON_CX_LIFT] THEN REWRITE_TAC[GSYM o_DEF] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; REWRITE_TAC[o_DEF]] THEN X_GEN_TAC `x:real^2` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN EXISTS_TAC `&2 * pi` THEN REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN X_GEN_TAC `y:real^2` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ; NORM_LIFT] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_RING `a - b:real = c - d <=> a - c = b - d`] THEN REWRITE_TAC[GSYM CX_INJ] THEN MATCH_MP_TAC(COMPLEX_RING `ii * w = ii * z ==> w = z`) THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL [REWRITE_TAC[IM_MUL_II; RE_CX] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[CX_SUB; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN ASM_MESON_TAC[]]; REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; LIFT_EQ; IN_INTER] THEN REWRITE_TAC[REAL_EQ_SUB_RADD; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. if x IN s then g x else z + h x):real^2->real` THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; COND_RAND] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_SIMP_TAC[TAUT `~(p /\ ~p)`; CX_ADD; GSYM o_DEF] THEN REWRITE_TAC[o_DEF; CX_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; GSYM o_DEF]; X_GEN_TAC `x:real^2` THEN REWRITE_TAC[] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `?w:real^2. cexp(ii * Cx(h w)) = cexp (ii * Cx(z + h w))` (CHOOSE_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN REWRITE_TAC[COMPLEX_FIELD `a = b * a <=> a = Cx(&0) \/ b = Cx(&1)`; CEXP_NZ]]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^2->bool. compact c /\ connected c /\ a IN c /\ b IN c /\ c INTER t = {}` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `path_component((:real^2) DIFF t) a b` MP_TAC THENL [ASM_MESON_TAC[OPEN_PATH_CONNECTED_COMPONENT; closed; COMPACT_IMP_CLOSED]; REWRITE_TAC[path_component; SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`]] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^2` STRIP_ASSUME_TAC) THEN EXISTS_TAC `path_image(g:real^1->real^2)` THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; COMPACT_PATH_IMAGE] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; ALL_TAC] THEN MP_TAC(ISPECL [`c UNION s:real^2->bool`; `vec 0:real^2`] BOUNDED_SUBSET_BALL) THEN ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^2->bool`; `(t INTER cball(vec 0,r)) UNION sphere(vec 0:real^2,r)`; `a:real^2`; `b:real^2`] lemma) THEN ASM_SIMP_TAC[COMPACT_UNION; CLOSED_INTER_COMPACT; COMPACT_SPHERE; COMPACT_CBALL] THEN ANTS_TAC THENL [CONJ_TAC THENL [UNDISCH_TAC `connected(s INTER t:real^2->bool)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC; REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^2->bool`] THEN MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] CBALL_DIFF_SPHERE) THEN ASM SET_TAC[]; REWRITE_TAC[connected_component] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^2->bool` THEN SIMP_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`u:real^2->bool`; `cball(vec 0:real^2,r)`] CONNECTED_INTER_FRONTIER) THEN ASM_REWRITE_TAC[FRONTIER_CBALL] THEN MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]]);; let JANISZEWSKI_GEN = prove (`!s t a b:real^N. dimindex(:N) <= 2 /\ compact s /\ closed t /\ connected(s INTER t) /\ connected_component ((:real^N) DIFF s) a b /\ connected_component ((:real^N) DIFF t) a b ==> connected_component ((:real^N) DIFF (s UNION t)) a b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [ASM_SIMP_TAC[CONNECTED_COMPONENT_1_GEN] THEN SET_TAC[]; ASM_SIMP_TAC[ARITH_RULE `1 <= n /\ ~(n = 1) ==> (n <= 2 <=> n = 2)`; DIMINDEX_GE_1] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[GSYM DIMINDEX_2] THEN DISCH_THEN(fun th -> MATCH_ACCEPT_TAC(GEOM_EQUAL_DIMENSION_RULE th JANISZEWSKI))]);; let JANISZEWSKI_CONNECTED = prove (`!s t:real^2->bool. compact s /\ closed t /\ connected(s INTER t) /\ connected ((:real^2) DIFF s) /\ connected ((:real^2) DIFF t) ==> connected((:real^2) DIFF (s UNION t))`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION] THEN ASM_MESON_TAC[JANISZEWSKI]);; let JANISZEWSKI_DUAL = prove (`!s t:real^2->bool. compact s /\ compact t /\ connected s /\ connected t /\ connected((:real^2) DIFF (s UNION t)) ==> connected(s INTER t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s UNION t:real^2->bool` BORSUKIAN_IMP_UNICOHERENT) THEN ASM_SIMP_TAC[BORSUKIAN_SEPARATION_COMPACT; COMPACT_UNION; unicoherent] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* The Jordan Curve theorem. *) (* ------------------------------------------------------------------------- *) let JORDAN_CURVE_THEOREM = prove (`!c:real^1->real^2. simple_path c /\ pathfinish c = pathstart c ==> ?ins out. ~(ins = {}) /\ open ins /\ connected ins /\ ~(out = {}) /\ open out /\ connected out /\ bounded ins /\ ~bounded out /\ ins INTER out = {} /\ ins UNION out = (:real^2) DIFF path_image c /\ frontier ins = path_image c /\ frontier out = path_image c`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `path_image(c:real^1->real^2) homeomorphic sphere(vec 0:real^2,&1)` ASSUME_TAC THENL [ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01]; FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP COMPACT_PATH_IMAGE) THEN ABBREV_TAC `s:real^2->bool = path_image c`] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] JORDAN_BROUWER_SEPARATION)) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_UNBOUNDED_COMPONENTS) THEN MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_HAS_BOUNDED_COMPONENT) THEN ASM_SIMP_TAC[COMPL_COMPL; COMPACT_IMP_BOUNDED; DIMINDEX_2; LE_REFL; IMP_IMP] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `ins:real^2->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `out:real^2->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 5 (GEN_REWRITE_TAC I [CONJ_ASSOC]) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED; OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED]; STRIP_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPONENTS_EQ]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[]; STRIP_TAC] THEN GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN REWRITE_TAC[GSYM UNIONS_2] THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s /\ (!c. c IN s /\ ~(c = a) /\ ~(c = b) ==> F) ==> {a,b} = s`) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `mid:real^2->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `frontier mid:real^2->bool = s` ASSUME_TAC THENL [MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `open(mid:real^2->bool) /\ connected mid /\ ~(mid = {})` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED; OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `?a b:real^2. a IN s /\ b IN s /\ ~(a = b) /\ ?g. arc g /\ pathstart g = a /\ pathfinish g = b /\ path_image g DIFF {a,b} SUBSET mid` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?a b:real^2. a IN s /\ b IN s /\ ~(a = b)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `(!c. s SUBSET {c} ==> F) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN ASM_MESON_TAC[INFINITE_SIMPLE_PATH_IMAGE; INFINITE; FINITE_SING; FINITE_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`mid:real^2->bool`; `s INTER ball(a:real^2,dist(a,b))`; `s INTER ball(b:real^2,dist(a,b))`] DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ANTS_TAC THENL [SUBGOAL_THEN `a IN ball(a:real^2,dist(a,b)) /\ b IN ball(b,dist(a,b)) /\ ~(a IN ball(b,dist(a,b))) /\ ~(b IN ball(a,dist(a,b)))` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_REWRITE_TAC[IN_BALL; DIST_REFL; GSYM DIST_NZ] THEN REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC; REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `g:real^1->real^2` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`pathstart g:real^2`; `pathfinish g:real^2`] THEN ASM_SIMP_TAC[ARC_DISTINCT_ENDS] THEN EXISTS_TAC `g:real^1->real^2` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path_image; pathstart; pathfinish] THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`c:real^1->real^2`; `a:real^2`; `b:real^2`] EXISTS_DOUBLE_ARC) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^1->real^2`; `d:real^1->real^2`] THEN STRIP_TAC THEN SUBGOAL_THEN `?x:real^2 y:real^2. x IN ins /\ y IN out` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`(path_image u UNION path_image g):real^2->bool`; `(path_image d UNION path_image g):real^2->bool`; `x:real^2`; `y:real^2`] JANISZEWSKI) THEN ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [COMPACT_UNION; COMPACT_IMP_CLOSED; COMPACT_PATH_IMAGE; ARC_IMP_PATH; NOT_IMP] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `(path_image u UNION path_image g) INTER (path_image d UNION path_image g) = path_image(g:real^1->real^2)` (fun th -> ASM_SIMP_TAC[CONNECTED_ARC_IMAGE; th]) THEN MATCH_MP_TAC(SET_RULE `u INTER d SUBSET s ==> (u UNION s) INTER (d UNION s) = s`) THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; ARC_IMP_PATH]; REWRITE_TAC[connected_component] THEN EXISTS_TAC `ins UNION out UNION (s DIFF path_image u):real^2->bool` THEN ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = (s UNION u) UNION (t UNION u)`] THEN MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `ins:real^2->bool` THEN ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `out:real^2->bool` THEN ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN SUBGOAL_THEN `~(path_image d SUBSET {a:real^2,b})` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]]; SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\ (mid:real^2->bool) INTER out = {}` MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]]; REWRITE_TAC[connected_component] THEN EXISTS_TAC `ins UNION out UNION (s DIFF path_image d):real^2->bool` THEN ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = (s UNION u) UNION (t UNION u)`] THEN MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `ins:real^2->bool` THEN ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `out:real^2->bool` THEN ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN SUBGOAL_THEN `~(path_image u SUBSET {a:real^2,b})` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]]; SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\ (mid:real^2->bool) INTER out = {}` MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]]; SUBGOAL_THEN `~(connected_component ((:real^2) DIFF s) x y)` MP_TAC THENL [REWRITE_TAC[connected_component] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^2->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(:real^2) DIFF s`; `t:real^2->bool`] COMPONENTS_MAXIMAL) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `ins:real^2->bool` th) THEN MP_TAC(SPEC `out:real^2->bool` th)) THEN ASM SET_TAC[]; REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s y ==> t y`) THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]]]);; let JORDAN_DISCONNECTED = prove (`!c. simple_path c /\ pathfinish c = pathstart c ==> ~connected((:real^2) DIFF path_image c)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[connected] THEN FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let JORDAN_INSIDE_OUTSIDE = prove (`!c:real^1->real^2. simple_path c /\ pathfinish c = pathstart c ==> ~(inside(path_image c) = {}) /\ open(inside(path_image c)) /\ connected(inside(path_image c)) /\ ~(outside(path_image c) = {}) /\ open(outside(path_image c)) /\ connected(outside(path_image c)) /\ bounded(inside(path_image c)) /\ ~bounded(outside(path_image c)) /\ inside(path_image c) INTER outside(path_image c) = {} /\ inside(path_image c) UNION outside(path_image c) = (:real^2) DIFF path_image c /\ frontier(inside(path_image c)) = path_image c /\ frontier(outside(path_image c)) = path_image c`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`ins:real^2->bool`; `out:real^2->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `inside(path_image c) :real^2->bool = ins /\ outside(path_image c):real^2->bool = out ` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC INSIDE_OUTSIDE_UNIQUE THEN ASM_SIMP_TAC[JORDAN_DISCONNECTED]);; let JORDAN_COMPONENTS = prove (`!g. simple_path g /\ pathfinish g = pathstart g ==> components((:real^2) DIFF path_image g) = {inside(path_image g),outside(path_image g)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPONENTS_OPEN_UNIQUE THEN REWRITE_TAC[UNIONS_2; PAIRWISE_INSERT; NOT_IN_EMPTY; FORALL_IN_INSERT; IMP_CONJ; PAIRWISE_EMPTY] THEN MP_TAC(ISPEC `g:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `path_image g:complex->bool` INSIDE_INTER_OUTSIDE) THEN REPLICATE_TAC 2 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Triple-curve or "theta-curve" theorem. Proof that there is no fourth *) (* component taken from Kuratowski's Topology vol 2, para 61, II. *) (* ------------------------------------------------------------------------- *) let THETA_CURVE_INSIDE_CASES = prove (`!c1 c2 c3 a b:real^2. arc c1 /\ pathstart c1 = a /\ pathfinish c1 = b /\ arc c2 /\ pathstart c2 = a /\ pathfinish c2 = b /\ arc c3 /\ pathstart c3 = a /\ pathfinish c3 = b /\ path_image c1 INTER path_image c2 = {a,b} /\ path_image c2 INTER path_image c3 = {a,b} /\ path_image c3 INTER path_image c1 = {a,b} ==> path_image c1 DIFF {a,b} SUBSET inside(path_image c2 UNION path_image c3) \/ path_image c2 DIFF {a,b} SUBSET inside(path_image c3 UNION path_image c1) \/ path_image c3 DIFF {a,b} SUBSET inside(path_image c1 UNION path_image c2)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `c3 ++ reversepath c1:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN MP_TAC(ISPEC `c2 ++ reversepath c3:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN MP_TAC(ISPEC `c1 ++ reversepath c2:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; SIMPLE_PATH_JOIN_LOOP_EQ; ARC_REVERSEPATH_EQ; PATH_IMAGE_REVERSEPATH; SUBSET_REFL; PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[TAUT `p \/ q <=> ~(~p /\ ~q)`] THEN REWRITE_TAC[SET_RULE `s SUBSET t <=> s DIFF t = {}`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] CONNECTED_INTER_FRONTIER)))) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[TAUT `p /\ ~q ==> ~r <=> p /\ r ==> q`] THEN PURE_ONCE_REWRITE_TAC[TAUT `~p <=> p ==> F`] THEN REPEAT(ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[CONNECTED_SIMPLE_PATH_ENDLESS; ARC_IMP_SIMPLE_PATH]; DISCH_TAC]) THEN SUBGOAL_THEN `inside(path_image c1 UNION path_image c2:real^2->bool) IN components((:real^2) DIFF (path_image c1 UNION path_image c2 UNION path_image c3)) /\ inside(path_image c2 UNION path_image c3:real^2->bool) IN components((:real^2) DIFF (path_image c1 UNION path_image c2 UNION path_image c3)) /\ inside(path_image c3 UNION path_image c1:real^2->bool) IN components((:real^2) DIFF (path_image c1 UNION path_image c2 UNION path_image c3))` STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THEN MATCH_MP_TAC CLOPEN_IN_COMPONENTS THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; CLOSURE_UNION_FRONTIER]; MATCH_MP_TAC OPEN_SUBSET THEN ASM_REWRITE_TAC[]]) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`closure(inside(path_image c1 UNION path_image c2)):real^2->bool`; `closure(inside(path_image c2 UNION path_image c3)):real^2->bool`] JANISZEWSKI_CONNECTED) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE; CLOSED_CLOSURE; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `c2:real^1->real^2` CONNECTED_PATH_IMAGE) THEN ASM_SIMP_TAC[ARC_IMP_PATH] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN MATCH_MP_TAC(SET_RULE `i INTER (c1 UNION c2 UNION c3) = {} /\ j INTER (c1 UNION c2 UNION c3) = {} /\ i INTER j = {} /\ c1 INTER c3 SUBSET c2 ==> c2 = (i UNION c1 UNION c2) INTER (j UNION c2 UNION c3)`) THEN REPEAT CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN SET_TAC[]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN SET_TAC[]; MP_TAC(ISPEC `(:real^2) DIFF (path_image c1 UNION path_image c2 UNION path_image c3)` COMPONENTS_NONOVERLAP) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o AP_TERM `frontier:(real^2->bool)->real^2->bool`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `c1:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH] THEN ASM SET_TAC[]; ASM SET_TAC[]]; UNDISCH_TAC `connected(outside(path_image c1 UNION path_image c2):real^2->bool)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]; UNDISCH_TAC `connected(outside(path_image c2 UNION path_image c3):real^2->bool)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]; (MP_TAC o ASSUME) `inside(path_image c3 UNION path_image c1:real^2->bool) IN components((:real^2) DIFF (path_image c1 UNION path_image c2 UNION path_image c3))` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN MATCH_MP_TAC(MESON[] `R s /\ ~(s = i) /\ P s /\ Q s ==> (!c. P c /\ Q c /\ R c /\ connected c ==> c = i) ==> ~connected s`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^2->bool)->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN REWRITE_TAC[COMPL_COMPL] THEN ASM_REWRITE_TAC[BOUNDED_UNION; BOUNDED_CLOSURE_EQ]; ALL_TAC] THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; SET_RULE `(i UNION c1 UNION c2) UNION (j UNION c2 UNION c3) = (i UNION j) UNION (c1 UNION c2 UNION c3)`] THEN MATCH_MP_TAC(SET_RULE `i3 SUBSET UNIV DIFF c /\ ~(i3 = {}) /\ i1 INTER i3 = {} /\ i2 INTER i3 = {} ==> ~(UNIV DIFF ((i1 UNION i2) UNION c) = {}) /\ i3 SUBSET UNIV DIFF ((i1 UNION i2) UNION c)`) THEN ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; IN_COMPONENTS_NONEMPTY] THEN MP_TAC(ISPEC `(:real^2) DIFF (path_image c1 UNION path_image c2 UNION path_image c3)` COMPONENTS_NONOVERLAP) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `frontier:(real^2->bool)->real^2->bool`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `c2:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH] THEN ASM SET_TAC[]]);; let SPLIT_INSIDE_SIMPLE_CLOSED_CURVE = prove (`!c1 c2 c a b:real^2. ~(a = b) /\ simple_path c1 /\ pathstart c1 = a /\ pathfinish c1 = b /\ simple_path c2 /\ pathstart c2 = a /\ pathfinish c2 = b /\ simple_path c /\ pathstart c = a /\ pathfinish c = b /\ path_image c1 INTER path_image c2 = {a,b} /\ path_image c1 INTER path_image c = {a,b} /\ path_image c2 INTER path_image c = {a,b} /\ ~(path_image c INTER inside(path_image c1 UNION path_image c2) = {}) ==> inside(path_image c1 UNION path_image c) INTER inside(path_image c2 UNION path_image c) = {} /\ inside(path_image c1 UNION path_image c) UNION inside(path_image c2 UNION path_image c) UNION (path_image c DIFF {a,b}) = inside(path_image c1 UNION path_image c2)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY (MP_TAC o C ISPEC JORDAN_INSIDE_OUTSIDE) [`(c1 ++ reversepath c2):real^1->real^2`; `(c1 ++ reversepath c):real^1->real^2`; `(c2 ++ reversepath c):real^1->real^2`] THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; SIMPLE_PATH_JOIN_LOOP; SIMPLE_PATH_IMP_ARC; PATH_IMAGE_JOIN; SIMPLE_PATH_IMP_PATH; PATH_IMAGE_REVERSEPATH; SIMPLE_PATH_REVERSEPATH; ARC_REVERSEPATH; SUBSET_REFL] THEN REPLICATE_TAC 3 STRIP_TAC THEN SUBGOAL_THEN `path_image(c:real^1->real^2) INTER outside(path_image c1 UNION path_image c2) = {}` ASSUME_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `connected(path_image(c:real^1->real^2) DIFF {pathstart c,pathfinish c})` MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN ASM_REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`inside(path_image c1 UNION path_image c2):real^2->bool`; `outside(path_image c1 UNION path_image c2):real^2->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `outside(path_image c1 UNION path_image c2) SUBSET outside(path_image c1 UNION path_image (c:real^1->real^2)) /\ outside(path_image c1 UNION path_image c2) SUBSET outside(path_image c2 UNION path_image c)` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM]] THEN MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `path_image(c1:real^1->real^2) INTER inside(path_image c2 UNION path_image c) = {}` ASSUME_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool = frontier(outside(path_image c2 UNION path_image c))` MP_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [UNION_COMM] THEN MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `connected(path_image(c1:real^1->real^2) DIFF {pathstart c1,pathfinish c1})` MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN ASM_REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`inside(path_image c2 UNION path_image c):real^2->bool`; `outside(path_image c2 UNION path_image c):real^2->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `path_image(c2:real^1->real^2) INTER inside(path_image c1 UNION path_image c) = {}` ASSUME_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool = frontier(outside(path_image c1 UNION path_image c))` MP_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `connected(path_image(c2:real^1->real^2) DIFF {pathstart c2,pathfinish c2})` MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN ASM_REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`inside(path_image c1 UNION path_image c):real^2->bool`; `outside(path_image c1 UNION path_image c):real^2->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `inside(path_image c1 UNION path_image (c:real^1->real^2)) SUBSET inside(path_image c1 UNION path_image c2) /\ inside(path_image c2 UNION path_image (c:real^1->real^2)) SUBSET inside(path_image c1 UNION path_image c2)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN REWRITE_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`] THENL [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNION_COMM]] THEN MATCH_MP_TAC(SET_RULE `out1 SUBSET out2 /\ c2 DIFF (c1 UNION c) SUBSET out2 ==> (c1 UNION c2) UNION out1 SUBSET (c1 UNION c) UNION out2`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `inside(path_image c1 UNION path_image c :real^2->bool) SUBSET outside(path_image c2 UNION path_image c) /\ inside(path_image c2 UNION path_image c) SUBSET outside(path_image c1 UNION path_image c)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SUBSET] THEN CONJ_TAC THEN X_GEN_TAC `x:real^2` THEN DISCH_TAC THENL [SUBGOAL_THEN `?z:real^2. z IN path_image c1 /\ z IN outside(path_image c2 UNION path_image c)` (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN MP_TAC(ISPEC `c1:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN MP_TAC(ASSUME `open(outside(path_image c2 UNION path_image c):real^2->bool)`) THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ASSUME `frontier(inside(path_image c1 UNION path_image c):real^2->bool) = path_image c1 UNION path_image c`) THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN REWRITE_TAC[connected_component] THEN CONJ_TAC THENL [EXISTS_TAC `outside(path_image c2 UNION path_image c:real^2->bool)` THEN ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`; OUTSIDE_NO_OVERLAP] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]; EXISTS_TAC `inside(path_image c1 UNION path_image c:real^2->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `inside(c1 UNION c) INTER (c1 UNION c) = {} /\ c2 INTER inside(c1 UNION c) = {} ==> inside(c1 UNION c) SUBSET UNIV DIFF (c2 UNION c)`) THEN ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]]; SUBGOAL_THEN `?z:real^2. z IN path_image c2 /\ z IN outside(path_image c1 UNION path_image c)` (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN MP_TAC(ISPEC `c2:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN MP_TAC(ASSUME `open(outside(path_image c1 UNION path_image c):real^2->bool)`) THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ASSUME `frontier(inside(path_image c2 UNION path_image c):real^2->bool) = path_image c2 UNION path_image c`) THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN REWRITE_TAC[connected_component] THEN CONJ_TAC THENL [EXISTS_TAC `outside(path_image c1 UNION path_image c:real^2->bool)` THEN ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`; OUTSIDE_NO_OVERLAP] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]; EXISTS_TAC `inside(path_image c2 UNION path_image c:real^2->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `inside(c2 UNION c) INTER (c2 UNION c) = {} /\ c1 INTER inside(c2 UNION c) = {} ==> inside(c2 UNION c) SUBSET UNIV DIFF (c1 UNION c)`) THEN ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]]]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!u. s SUBSET u /\ t INTER u = {} ==> s INTER t = {}`) THEN EXISTS_TAC `outside(path_image c2 UNION path_image c):real^2->bool` THEN ASM_REWRITE_TAC[INSIDE_INTER_OUTSIDE]; ALL_TAC] THEN SUBGOAL_THEN `outside (path_image c1 UNION path_image c) INTER outside (path_image c2 UNION path_image c):real^2->bool SUBSET outside (path_image c1 UNION path_image c2)` MP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[SET_RULE `s INTER t = u <=> (UNIV DIFF s) UNION (UNIV DIFF t) = UNIV DIFF u`] THEN REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `(:real^2) DIFF (path_image c1 UNION path_image c2)` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]; DISCH_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC(ISPECL [`closure(inside(path_image c1 UNION path_image c)):real^2->bool`; `closure(inside(path_image c2 UNION path_image c)):real^2->bool`] JANISZEWSKI_CONNECTED) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE; CLOSED_CLOSURE] THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; COMPL_COMPL; ONCE_REWRITE_RULE[UNION_COMM] UNION_WITH_INSIDE] THEN REWRITE_TAC[SET_RULE `UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t)) = s INTER t`] THEN DISCH_THEN MATCH_MP_TAC THEN SUBGOAL_THEN `connected(path_image c:real^2->bool)` MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_IMAGE]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]);; hol-light/Multivariate/multivariate_database.ml000066400000000000000000020602671303454263000223140ustar00rootroot00000000000000needs "help.ml";; theorems := [ "ABSOLUTELY_CONTINUOUS_COMPARISON",ABSOLUTELY_CONTINUOUS_COMPARISON; "ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV",ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV; "ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV_GEN",ABSOLUTELY_CONTINUOUS_DIFFERENTIABLE_BV_GEN; "ABSOLUTELY_CONTINUOUS_EXTENDS_TO_CLOSURE",ABSOLUTELY_CONTINUOUS_EXTENDS_TO_CLOSURE; "ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY",ABSOLUTELY_CONTINUOUS_IMP_BANACH_SPROPERTY; "ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ",ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_EQ; "ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_LEFT",ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_LEFT; "ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT",ABSOLUTELY_CONTINUOUS_INDEFINITE_INTEGRAL_RIGHT; "ABSOLUTELY_CONTINUOUS_INTEGRAL",ABSOLUTELY_CONTINUOUS_INTEGRAL; "ABSOLUTELY_CONTINUOUS_ISOMETRIC",ABSOLUTELY_CONTINUOUS_ISOMETRIC; "ABSOLUTELY_CONTINUOUS_ISOMETRIC_COMPOSE",ABSOLUTELY_CONTINUOUS_ISOMETRIC_COMPOSE; "ABSOLUTELY_CONTINUOUS_LIPSCHITZ_COMPOSE",ABSOLUTELY_CONTINUOUS_LIPSCHITZ_COMPOSE; "ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE",ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE; "ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_GEN",ABSOLUTELY_CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_GEN; "ABSOLUTELY_CONTINUOUS_MEASURE_IMAGE",ABSOLUTELY_CONTINUOUS_MEASURE_IMAGE; "ABSOLUTELY_CONTINUOUS_ON_ADD",ABSOLUTELY_CONTINUOUS_ON_ADD; "ABSOLUTELY_CONTINUOUS_ON_BILINEAR",ABSOLUTELY_CONTINUOUS_ON_BILINEAR; "ABSOLUTELY_CONTINUOUS_ON_CLOSURE",ABSOLUTELY_CONTINUOUS_ON_CLOSURE; "ABSOLUTELY_CONTINUOUS_ON_CLOSURE_EQ",ABSOLUTELY_CONTINUOUS_ON_CLOSURE_EQ; "ABSOLUTELY_CONTINUOUS_ON_CMUL",ABSOLUTELY_CONTINUOUS_ON_CMUL; "ABSOLUTELY_CONTINUOUS_ON_CMUL_EQ",ABSOLUTELY_CONTINUOUS_ON_CMUL_EQ; "ABSOLUTELY_CONTINUOUS_ON_COMBINE",ABSOLUTELY_CONTINUOUS_ON_COMBINE; "ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE",ABSOLUTELY_CONTINUOUS_ON_COMPONENTWISE; "ABSOLUTELY_CONTINUOUS_ON_COMPOSE",ABSOLUTELY_CONTINUOUS_ON_COMPOSE; "ABSOLUTELY_CONTINUOUS_ON_COMPOSE_LINEAR",ABSOLUTELY_CONTINUOUS_ON_COMPOSE_LINEAR; "ABSOLUTELY_CONTINUOUS_ON_CONST",ABSOLUTELY_CONTINUOUS_ON_CONST; "ABSOLUTELY_CONTINUOUS_ON_DIVISION",ABSOLUTELY_CONTINUOUS_ON_DIVISION; "ABSOLUTELY_CONTINUOUS_ON_EMPTY",ABSOLUTELY_CONTINUOUS_ON_EMPTY; "ABSOLUTELY_CONTINUOUS_ON_EQ",ABSOLUTELY_CONTINUOUS_ON_EQ; "ABSOLUTELY_CONTINUOUS_ON_ID",ABSOLUTELY_CONTINUOUS_ON_ID; "ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS",ABSOLUTELY_CONTINUOUS_ON_IMP_CONTINUOUS; "ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON",ABSOLUTELY_CONTINUOUS_ON_IMP_HAS_BOUNDED_VARIATION_ON; "ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS",ABSOLUTELY_CONTINUOUS_ON_IMP_UNIFORMLY_CONTINUOUS; "ABSOLUTELY_CONTINUOUS_ON_INTERIOR",ABSOLUTELY_CONTINUOUS_ON_INTERIOR; "ABSOLUTELY_CONTINUOUS_ON_INTERIOR_EQ",ABSOLUTELY_CONTINUOUS_ON_INTERIOR_EQ; "ABSOLUTELY_CONTINUOUS_ON_LIFT_ABS",ABSOLUTELY_CONTINUOUS_ON_LIFT_ABS; "ABSOLUTELY_CONTINUOUS_ON_MAX",ABSOLUTELY_CONTINUOUS_ON_MAX; "ABSOLUTELY_CONTINUOUS_ON_MIN",ABSOLUTELY_CONTINUOUS_ON_MIN; "ABSOLUTELY_CONTINUOUS_ON_MUL",ABSOLUTELY_CONTINUOUS_ON_MUL; "ABSOLUTELY_CONTINUOUS_ON_NEG",ABSOLUTELY_CONTINUOUS_ON_NEG; "ABSOLUTELY_CONTINUOUS_ON_NORM",ABSOLUTELY_CONTINUOUS_ON_NORM; "ABSOLUTELY_CONTINUOUS_ON_NULL",ABSOLUTELY_CONTINUOUS_ON_NULL; "ABSOLUTELY_CONTINUOUS_ON_SING",ABSOLUTELY_CONTINUOUS_ON_SING; "ABSOLUTELY_CONTINUOUS_ON_SUB",ABSOLUTELY_CONTINUOUS_ON_SUB; "ABSOLUTELY_CONTINUOUS_ON_SUBSET",ABSOLUTELY_CONTINUOUS_ON_SUBSET; "ABSOLUTELY_CONTINUOUS_ON_TRANSLATION",ABSOLUTELY_CONTINUOUS_ON_TRANSLATION; "ABSOLUTELY_CONTINUOUS_ON_VMUL",ABSOLUTELY_CONTINUOUS_ON_VMUL; "ABSOLUTELY_CONTINUOUS_ON_VMUL_EQ",ABSOLUTELY_CONTINUOUS_ON_VMUL_EQ; "ABSOLUTELY_CONTINUOUS_ON_VSUM",ABSOLUTELY_CONTINUOUS_ON_VSUM; "ABSOLUTELY_CONTINUOUS_VECTOR_VARIATION",ABSOLUTELY_CONTINUOUS_VECTOR_VARIATION; "ABSOLUTELY_INTEGRABLE_0",ABSOLUTELY_INTEGRABLE_0; "ABSOLUTELY_INTEGRABLE_ABS",ABSOLUTELY_INTEGRABLE_ABS; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND; "ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND; "ABSOLUTELY_INTEGRABLE_ABS_1",ABSOLUTELY_INTEGRABLE_ABS_1; "ABSOLUTELY_INTEGRABLE_ABS_EQ",ABSOLUTELY_INTEGRABLE_ABS_EQ; "ABSOLUTELY_INTEGRABLE_ADD",ABSOLUTELY_INTEGRABLE_ADD; "ABSOLUTELY_INTEGRABLE_AFFINITY",ABSOLUTELY_INTEGRABLE_AFFINITY; "ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS; "ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT; "ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ; "ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ_ALT",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT_EQ_ALT; "ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; "ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ; "ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ; "ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE",ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_DERIVATIVE; "ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_VARIATION_EQ; "ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES",ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES; "ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_LINEAR",ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_LINEAR; "ABSOLUTELY_INTEGRABLE_CMUL",ABSOLUTELY_INTEGRABLE_CMUL; "ABSOLUTELY_INTEGRABLE_CMUL_EQ",ABSOLUTELY_INTEGRABLE_CMUL_EQ; "ABSOLUTELY_INTEGRABLE_COMPONENTWISE",ABSOLUTELY_INTEGRABLE_COMPONENTWISE; "ABSOLUTELY_INTEGRABLE_CONST",ABSOLUTELY_INTEGRABLE_CONST; "ABSOLUTELY_INTEGRABLE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_CONTINUOUS; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_AE",ABSOLUTELY_INTEGRABLE_CONVOLUTION_AE; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF",ABSOLUTELY_INTEGRABLE_CONVOLUTION_L1_LINF; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_L2",ABSOLUTELY_INTEGRABLE_CONVOLUTION_L2; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_LINF_L1",ABSOLUTELY_INTEGRABLE_CONVOLUTION_LINF_L1; "ABSOLUTELY_INTEGRABLE_CONVOLUTION_SYM",ABSOLUTELY_INTEGRABLE_CONVOLUTION_SYM; "ABSOLUTELY_INTEGRABLE_DIFF",ABSOLUTELY_INTEGRABLE_DIFF; "ABSOLUTELY_INTEGRABLE_EQ",ABSOLUTELY_INTEGRABLE_EQ; "ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS",ABSOLUTELY_INTEGRABLE_EQ_INTEGRABLE_POS; "ABSOLUTELY_INTEGRABLE_IMPROPER",ABSOLUTELY_INTEGRABLE_IMPROPER; "ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE",ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; "ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE",ABSOLUTELY_INTEGRABLE_IMP_LIFT_NORM_INTEGRABLE; "ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE",ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE; "ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE_ALT",ABSOLUTELY_INTEGRABLE_INCREASING_DERIVATIVE_ALT; "ABSOLUTELY_INTEGRABLE_INF_1",ABSOLUTELY_INTEGRABLE_INF_1; "ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND; "ABSOLUTELY_INTEGRABLE_INTER",ABSOLUTELY_INTEGRABLE_INTER; "ABSOLUTELY_INTEGRABLE_LE",ABSOLUTELY_INTEGRABLE_LE; "ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS",ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS; "ABSOLUTELY_INTEGRABLE_LINEAR",ABSOLUTELY_INTEGRABLE_LINEAR; "ABSOLUTELY_INTEGRABLE_MAX",ABSOLUTELY_INTEGRABLE_MAX; "ABSOLUTELY_INTEGRABLE_MAX_1",ABSOLUTELY_INTEGRABLE_MAX_1; "ABSOLUTELY_INTEGRABLE_MEASURABLE",ABSOLUTELY_INTEGRABLE_MEASURABLE; "ABSOLUTELY_INTEGRABLE_MIN",ABSOLUTELY_INTEGRABLE_MIN; "ABSOLUTELY_INTEGRABLE_MIN_1",ABSOLUTELY_INTEGRABLE_MIN_1; "ABSOLUTELY_INTEGRABLE_NEG",ABSOLUTELY_INTEGRABLE_NEG; "ABSOLUTELY_INTEGRABLE_NEG_EQ",ABSOLUTELY_INTEGRABLE_NEG_EQ; "ABSOLUTELY_INTEGRABLE_NORM",ABSOLUTELY_INTEGRABLE_NORM; "ABSOLUTELY_INTEGRABLE_ON_CONST",ABSOLUTELY_INTEGRABLE_ON_CONST; "ABSOLUTELY_INTEGRABLE_ON_EMPTY",ABSOLUTELY_INTEGRABLE_ON_EMPTY; "ABSOLUTELY_INTEGRABLE_ON_IMAGE",ABSOLUTELY_INTEGRABLE_ON_IMAGE; "ABSOLUTELY_INTEGRABLE_ON_INDICATOR",ABSOLUTELY_INTEGRABLE_ON_INDICATOR; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_INTER; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ; "ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ_ALT",ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET_EQ_ALT; "ABSOLUTELY_INTEGRABLE_ON_LINEAR_IMAGE",ABSOLUTELY_INTEGRABLE_ON_LINEAR_IMAGE; "ABSOLUTELY_INTEGRABLE_ON_NEGLIGIBLE",ABSOLUTELY_INTEGRABLE_ON_NEGLIGIBLE; "ABSOLUTELY_INTEGRABLE_ON_NULL",ABSOLUTELY_INTEGRABLE_ON_NULL; "ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL",ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL; "ABSOLUTELY_INTEGRABLE_PASTECART_SYM",ABSOLUTELY_INTEGRABLE_PASTECART_SYM; "ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV",ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV; "ABSOLUTELY_INTEGRABLE_REFLECT",ABSOLUTELY_INTEGRABLE_REFLECT; "ABSOLUTELY_INTEGRABLE_REFLECT_GEN",ABSOLUTELY_INTEGRABLE_REFLECT_GEN; "ABSOLUTELY_INTEGRABLE_RESTRICT_INTER",ABSOLUTELY_INTEGRABLE_RESTRICT_INTER; "ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV",ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; "ABSOLUTELY_INTEGRABLE_SET_VARIATION",ABSOLUTELY_INTEGRABLE_SET_VARIATION; "ABSOLUTELY_INTEGRABLE_SPIKE",ABSOLUTELY_INTEGRABLE_SPIKE; "ABSOLUTELY_INTEGRABLE_SPIKE_EQ",ABSOLUTELY_INTEGRABLE_SPIKE_EQ; "ABSOLUTELY_INTEGRABLE_SPIKE_SET",ABSOLUTELY_INTEGRABLE_SPIKE_SET; "ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ",ABSOLUTELY_INTEGRABLE_SPIKE_SET_EQ; "ABSOLUTELY_INTEGRABLE_SQUARE_INTEGRABLE_PRODUCT",ABSOLUTELY_INTEGRABLE_SQUARE_INTEGRABLE_PRODUCT; "ABSOLUTELY_INTEGRABLE_SUB",ABSOLUTELY_INTEGRABLE_SUB; "ABSOLUTELY_INTEGRABLE_SUP_1",ABSOLUTELY_INTEGRABLE_SUP_1; "ABSOLUTELY_INTEGRABLE_TRANSLATION",ABSOLUTELY_INTEGRABLE_TRANSLATION; "ABSOLUTELY_INTEGRABLE_TWIZZLE_EQ",ABSOLUTELY_INTEGRABLE_TWIZZLE_EQ; "ABSOLUTELY_INTEGRABLE_UNION",ABSOLUTELY_INTEGRABLE_UNION; "ABSOLUTELY_INTEGRABLE_VSUM",ABSOLUTELY_INTEGRABLE_VSUM; "ABSOLUTELY_SETCONTINUOUS_COMPARISON",ABSOLUTELY_SETCONTINUOUS_COMPARISON; "ABSOLUTELY_SETCONTINUOUS_INDEFINITE_INTEGRAL",ABSOLUTELY_SETCONTINUOUS_INDEFINITE_INTEGRAL; "ABSOLUTELY_SETCONTINUOUS_ON_0",ABSOLUTELY_SETCONTINUOUS_ON_0; "ABSOLUTELY_SETCONTINUOUS_ON_ADD",ABSOLUTELY_SETCONTINUOUS_ON_ADD; "ABSOLUTELY_SETCONTINUOUS_ON_ALT",ABSOLUTELY_SETCONTINUOUS_ON_ALT; "ABSOLUTELY_SETCONTINUOUS_ON_CMUL",ABSOLUTELY_SETCONTINUOUS_ON_CMUL; "ABSOLUTELY_SETCONTINUOUS_ON_COMPONENTWISE",ABSOLUTELY_SETCONTINUOUS_ON_COMPONENTWISE; "ABSOLUTELY_SETCONTINUOUS_ON_COMPOSE_LINEAR",ABSOLUTELY_SETCONTINUOUS_ON_COMPOSE_LINEAR; "ABSOLUTELY_SETCONTINUOUS_ON_DIVISION",ABSOLUTELY_SETCONTINUOUS_ON_DIVISION; "ABSOLUTELY_SETCONTINUOUS_ON_EQ",ABSOLUTELY_SETCONTINUOUS_ON_EQ; "ABSOLUTELY_SETCONTINUOUS_ON_IMP_HAS_BOUNDED_SETVARIATION_ON",ABSOLUTELY_SETCONTINUOUS_ON_IMP_HAS_BOUNDED_SETVARIATION_ON; "ABSOLUTELY_SETCONTINUOUS_ON_LIFT_ABS",ABSOLUTELY_SETCONTINUOUS_ON_LIFT_ABS; "ABSOLUTELY_SETCONTINUOUS_ON_MUL",ABSOLUTELY_SETCONTINUOUS_ON_MUL; "ABSOLUTELY_SETCONTINUOUS_ON_NEG",ABSOLUTELY_SETCONTINUOUS_ON_NEG; "ABSOLUTELY_SETCONTINUOUS_ON_NORM",ABSOLUTELY_SETCONTINUOUS_ON_NORM; "ABSOLUTELY_SETCONTINUOUS_ON_NULL",ABSOLUTELY_SETCONTINUOUS_ON_NULL; "ABSOLUTELY_SETCONTINUOUS_ON_SUB",ABSOLUTELY_SETCONTINUOUS_ON_SUB; "ABSOLUTELY_SETCONTINUOUS_ON_SUBSET",ABSOLUTELY_SETCONTINUOUS_ON_SUBSET; "ABSOLUTELY_SETCONTINUOUS_ON_VSUM",ABSOLUTELY_SETCONTINUOUS_ON_VSUM; "ABSOLUTELY_SUMMABLE_IMP_CAUCHY",ABSOLUTELY_SUMMABLE_IMP_CAUCHY; "ABSOLUTE_EXTENSOR_IMP_AR",ABSOLUTE_EXTENSOR_IMP_AR; "ABSOLUTE_INTEGRAL_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ",ABSOLUTE_INTEGRAL_ABSOLUTELY_CONTINUOUS_DERIVATIVE_EQ; "ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION",ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION; "ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION_ALT",ABSOLUTE_INTEGRAL_NORM_DERIVATIVE_LE_VARIATION_ALT; "ABSOLUTE_INTEGRATION_BY_PARTS",ABSOLUTE_INTEGRATION_BY_PARTS; "ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR",ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR; "ABSOLUTE_RETRACTION_CONVEX_CLOSED",ABSOLUTE_RETRACTION_CONVEX_CLOSED; "ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE",ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE; "ABSOLUTE_RETRACT_CONTRACTIBLE_ANR",ABSOLUTE_RETRACT_CONTRACTIBLE_ANR; "ABSOLUTE_RETRACT_CONVEX",ABSOLUTE_RETRACT_CONVEX; "ABSOLUTE_RETRACT_CONVEX_CLOSED",ABSOLUTE_RETRACT_CONVEX_CLOSED; "ABSOLUTE_RETRACT_FROM_UNION_AND_INTER",ABSOLUTE_RETRACT_FROM_UNION_AND_INTER; "ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT",ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT; "ABSOLUTE_RETRACT_IMP_AR",ABSOLUTE_RETRACT_IMP_AR; "ABSOLUTE_RETRACT_IMP_AR_GEN",ABSOLUTE_RETRACT_IMP_AR_GEN; "ABSOLUTE_RETRACT_PATH_IMAGE_ARC",ABSOLUTE_RETRACT_PATH_IMAGE_ARC; "ABSOLUTE_RETRACT_UNION",ABSOLUTE_RETRACT_UNION; "ABSORPTION",ABSORPTION; "ABS_DROP",ABS_DROP; "ABS_SIMP",ABS_SIMP; "ACCESSIBLE_FRONTIER_ANR_COMPLEMENT_COMPONENT",ACCESSIBLE_FRONTIER_ANR_COMPLEMENT_COMPONENT; "ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT",ACCESSIBLE_FRONTIER_ANR_INTER_COMPLEMENT_COMPONENT; "ADD",ADD; "ADD1",ADD1; "ADDITIVE_CONTENT_DIVISION",ADDITIVE_CONTENT_DIVISION; "ADDITIVE_CONTENT_TAGGED_DIVISION",ADDITIVE_CONTENT_TAGGED_DIVISION; "ADDITIVE_DIVISION_1",ADDITIVE_DIVISION_1; "ADDITIVE_TAGGED_DIVISION_1",ADDITIVE_TAGGED_DIVISION_1; "ADD_0",ADD_0; "ADD_AC",ADD_AC; "ADD_ASSOC",ADD_ASSOC; "ADD_CLAUSES",ADD_CLAUSES; "ADD_EQ_0",ADD_EQ_0; "ADD_SUB",ADD_SUB; "ADD_SUB2",ADD_SUB2; "ADD_SUBR",ADD_SUBR; "ADD_SUBR2",ADD_SUBR2; "ADD_SUC",ADD_SUC; "ADD_SYM",ADD_SYM; "ADJOINT_ADJOINT",ADJOINT_ADJOINT; "ADJOINT_CLAUSES",ADJOINT_CLAUSES; "ADJOINT_COMPOSE",ADJOINT_COMPOSE; "ADJOINT_INJECTIVE",ADJOINT_INJECTIVE; "ADJOINT_INJECTIVE_INJECTIVE",ADJOINT_INJECTIVE_INJECTIVE; "ADJOINT_INJECTIVE_INJECTIVE_0",ADJOINT_INJECTIVE_INJECTIVE_0; "ADJOINT_LINEAR",ADJOINT_LINEAR; "ADJOINT_MATRIX",ADJOINT_MATRIX; "ADJOINT_SURJECTIVE",ADJOINT_SURJECTIVE; "ADJOINT_UNIQUE",ADJOINT_UNIQUE; "ADJOINT_WORKS",ADJOINT_WORKS; "ADMISSIBLE_BASE",ADMISSIBLE_BASE; "ADMISSIBLE_COMB",ADMISSIBLE_COMB; "ADMISSIBLE_COND",ADMISSIBLE_COND; "ADMISSIBLE_CONST",ADMISSIBLE_CONST; "ADMISSIBLE_GUARDED_PATTERN",ADMISSIBLE_GUARDED_PATTERN; "ADMISSIBLE_IMP_SUPERADMISSIBLE",ADMISSIBLE_IMP_SUPERADMISSIBLE; "ADMISSIBLE_LAMBDA",ADMISSIBLE_LAMBDA; "ADMISSIBLE_MAP",ADMISSIBLE_MAP; "ADMISSIBLE_MATCH",ADMISSIBLE_MATCH; "ADMISSIBLE_MATCH_SEQPATTERN",ADMISSIBLE_MATCH_SEQPATTERN; "ADMISSIBLE_NEST",ADMISSIBLE_NEST; "ADMISSIBLE_NSUM",ADMISSIBLE_NSUM; "ADMISSIBLE_RAND",ADMISSIBLE_RAND; "ADMISSIBLE_SEQPATTERN",ADMISSIBLE_SEQPATTERN; "ADMISSIBLE_SUM",ADMISSIBLE_SUM; "ADMISSIBLE_UNGUARDED_PATTERN",ADMISSIBLE_UNGUARDED_PATTERN; "AFFINE",AFFINE; "AFFINE_AFFINE_HULL",AFFINE_AFFINE_HULL; "AFFINE_AFFINITY",AFFINE_AFFINITY; "AFFINE_AFFINITY_EQ",AFFINE_AFFINITY_EQ; "AFFINE_ALT",AFFINE_ALT; "AFFINE_BASIS_EXISTS",AFFINE_BASIS_EXISTS; "AFFINE_BOUNDED_EQ_LOWDIM",AFFINE_BOUNDED_EQ_LOWDIM; "AFFINE_BOUNDED_EQ_TRIVIAL",AFFINE_BOUNDED_EQ_TRIVIAL; "AFFINE_DEPENDENT_BIGGERSET",AFFINE_DEPENDENT_BIGGERSET; "AFFINE_DEPENDENT_BIGGERSET_GENERAL",AFFINE_DEPENDENT_BIGGERSET_GENERAL; "AFFINE_DEPENDENT_CHOOSE",AFFINE_DEPENDENT_CHOOSE; "AFFINE_DEPENDENT_EXPLICIT",AFFINE_DEPENDENT_EXPLICIT; "AFFINE_DEPENDENT_EXPLICIT_FINITE",AFFINE_DEPENDENT_EXPLICIT_FINITE; "AFFINE_DEPENDENT_IMP_COLLINEAR_3",AFFINE_DEPENDENT_IMP_COLLINEAR_3; "AFFINE_DEPENDENT_IMP_DEPENDENT",AFFINE_DEPENDENT_IMP_DEPENDENT; "AFFINE_DEPENDENT_LINEAR_IMAGE",AFFINE_DEPENDENT_LINEAR_IMAGE; "AFFINE_DEPENDENT_LINEAR_IMAGE_EQ",AFFINE_DEPENDENT_LINEAR_IMAGE_EQ; "AFFINE_DEPENDENT_MONO",AFFINE_DEPENDENT_MONO; "AFFINE_DEPENDENT_TRANSLATION",AFFINE_DEPENDENT_TRANSLATION; "AFFINE_DEPENDENT_TRANSLATION_EQ",AFFINE_DEPENDENT_TRANSLATION_EQ; "AFFINE_DIFFERENCES",AFFINE_DIFFERENCES; "AFFINE_DIFFS_SUBSPACE",AFFINE_DIFFS_SUBSPACE; "AFFINE_EMPTY",AFFINE_EMPTY; "AFFINE_EQ_SUBSPACE",AFFINE_EQ_SUBSPACE; "AFFINE_EXISTS",AFFINE_EXISTS; "AFFINE_EXPLICIT",AFFINE_EXPLICIT; "AFFINE_HULLS_EQ",AFFINE_HULLS_EQ; "AFFINE_HULL_0_2_EXPLICIT",AFFINE_HULL_0_2_EXPLICIT; "AFFINE_HULL_0_3_EXPLICIT",AFFINE_HULL_0_3_EXPLICIT; "AFFINE_HULL_0_EXPLICIT",AFFINE_HULL_0_EXPLICIT; "AFFINE_HULL_2",AFFINE_HULL_2; "AFFINE_HULL_2_ALT",AFFINE_HULL_2_ALT; "AFFINE_HULL_3",AFFINE_HULL_3; "AFFINE_HULL_3_IMP_COLLINEAR",AFFINE_HULL_3_IMP_COLLINEAR; "AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR; "AFFINE_HULL_AFFINE_INTER_OPEN",AFFINE_HULL_AFFINE_INTER_OPEN; "AFFINE_HULL_AFFINE_INTER_OPEN_IN",AFFINE_HULL_AFFINE_INTER_OPEN_IN; "AFFINE_HULL_AFFINITY",AFFINE_HULL_AFFINITY; "AFFINE_HULL_CLOSURE",AFFINE_HULL_CLOSURE; "AFFINE_HULL_CONIC_HULL",AFFINE_HULL_CONIC_HULL; "AFFINE_HULL_CONVEX_HULL",AFFINE_HULL_CONVEX_HULL; "AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; "AFFINE_HULL_CONVEX_INTER_OPEN",AFFINE_HULL_CONVEX_INTER_OPEN; "AFFINE_HULL_CONVEX_INTER_OPEN_IN",AFFINE_HULL_CONVEX_INTER_OPEN_IN; "AFFINE_HULL_EMPTY",AFFINE_HULL_EMPTY; "AFFINE_HULL_EQ",AFFINE_HULL_EQ; "AFFINE_HULL_EQ_EMPTY",AFFINE_HULL_EQ_EMPTY; "AFFINE_HULL_EQ_SING",AFFINE_HULL_EQ_SING; "AFFINE_HULL_EQ_SPAN",AFFINE_HULL_EQ_SPAN; "AFFINE_HULL_EQ_SPAN_EQ",AFFINE_HULL_EQ_SPAN_EQ; "AFFINE_HULL_EXPLICIT",AFFINE_HULL_EXPLICIT; "AFFINE_HULL_EXPLICIT_ALT",AFFINE_HULL_EXPLICIT_ALT; "AFFINE_HULL_EXPLICIT_UNIQUE",AFFINE_HULL_EXPLICIT_UNIQUE; "AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR",AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR; "AFFINE_HULL_FINITE",AFFINE_HULL_FINITE; "AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES",AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES; "AFFINE_HULL_FINITE_STEP",AFFINE_HULL_FINITE_STEP; "AFFINE_HULL_FINITE_STEP_GEN",AFFINE_HULL_FINITE_STEP_GEN; "AFFINE_HULL_HALFSPACE_GE",AFFINE_HULL_HALFSPACE_GE; "AFFINE_HULL_HALFSPACE_GT",AFFINE_HULL_HALFSPACE_GT; "AFFINE_HULL_HALFSPACE_LE",AFFINE_HULL_HALFSPACE_LE; "AFFINE_HULL_HALFSPACE_LT",AFFINE_HULL_HALFSPACE_LT; "AFFINE_HULL_INDEXED",AFFINE_HULL_INDEXED; "AFFINE_HULL_INSERT_SPAN",AFFINE_HULL_INSERT_SPAN; "AFFINE_HULL_INSERT_SUBSET_SPAN",AFFINE_HULL_INSERT_SUBSET_SPAN; "AFFINE_HULL_INTER",AFFINE_HULL_INTER; "AFFINE_HULL_INTERS",AFFINE_HULL_INTERS; "AFFINE_HULL_LINEAR_IMAGE",AFFINE_HULL_LINEAR_IMAGE; "AFFINE_HULL_NONEMPTY_INTERIOR",AFFINE_HULL_NONEMPTY_INTERIOR; "AFFINE_HULL_OPEN",AFFINE_HULL_OPEN; "AFFINE_HULL_OPEN_IN",AFFINE_HULL_OPEN_IN; "AFFINE_HULL_OPEN_IN_AFFINE",AFFINE_HULL_OPEN_IN_AFFINE; "AFFINE_HULL_OPEN_IN_CONVEX",AFFINE_HULL_OPEN_IN_CONVEX; "AFFINE_HULL_PCROSS",AFFINE_HULL_PCROSS; "AFFINE_HULL_RELATIVE_FRONTIER_BOUNDED",AFFINE_HULL_RELATIVE_FRONTIER_BOUNDED; "AFFINE_HULL_RELATIVE_INTERIOR",AFFINE_HULL_RELATIVE_INTERIOR; "AFFINE_HULL_SCALING",AFFINE_HULL_SCALING; "AFFINE_HULL_SEGMENT",AFFINE_HULL_SEGMENT; "AFFINE_HULL_SING",AFFINE_HULL_SING; "AFFINE_HULL_SPAN",AFFINE_HULL_SPAN; "AFFINE_HULL_SUBSET_SPAN",AFFINE_HULL_SUBSET_SPAN; "AFFINE_HULL_SUMS",AFFINE_HULL_SUMS; "AFFINE_HULL_TRANSLATION",AFFINE_HULL_TRANSLATION; "AFFINE_HULL_UNIV",AFFINE_HULL_UNIV; "AFFINE_HYPERPLANE",AFFINE_HYPERPLANE; "AFFINE_HYPERPLANE_SUMS_EQ_UNIV",AFFINE_HYPERPLANE_SUMS_EQ_UNIV; "AFFINE_IMP_CONVEX",AFFINE_IMP_CONVEX; "AFFINE_IMP_POLYHEDRON",AFFINE_IMP_POLYHEDRON; "AFFINE_IMP_SUBSPACE",AFFINE_IMP_SUBSPACE; "AFFINE_INDEPENDENT_1",AFFINE_INDEPENDENT_1; "AFFINE_INDEPENDENT_2",AFFINE_INDEPENDENT_2; "AFFINE_INDEPENDENT_CARD_DIM_DIFFS",AFFINE_INDEPENDENT_CARD_DIM_DIFFS; "AFFINE_INDEPENDENT_CARD_LE",AFFINE_INDEPENDENT_CARD_LE; "AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL",AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL; "AFFINE_INDEPENDENT_DELETE",AFFINE_INDEPENDENT_DELETE; "AFFINE_INDEPENDENT_EMPTY",AFFINE_INDEPENDENT_EMPTY; "AFFINE_INDEPENDENT_IFF_CARD",AFFINE_INDEPENDENT_IFF_CARD; "AFFINE_INDEPENDENT_IMP_FINITE",AFFINE_INDEPENDENT_IMP_FINITE; "AFFINE_INDEPENDENT_INSERT",AFFINE_INDEPENDENT_INSERT; "AFFINE_INDEPENDENT_SPAN_EQ",AFFINE_INDEPENDENT_SPAN_EQ; "AFFINE_INDEPENDENT_SPAN_GT",AFFINE_INDEPENDENT_SPAN_GT; "AFFINE_INDEPENDENT_STDBASIS",AFFINE_INDEPENDENT_STDBASIS; "AFFINE_INDEPENDENT_SUBSET",AFFINE_INDEPENDENT_SUBSET; "AFFINE_INDEXED",AFFINE_INDEXED; "AFFINE_INTER",AFFINE_INTER; "AFFINE_INTERS",AFFINE_INTERS; "AFFINE_LINEAR_IMAGE",AFFINE_LINEAR_IMAGE; "AFFINE_LINEAR_IMAGE_EQ",AFFINE_LINEAR_IMAGE_EQ; "AFFINE_LINEAR_PREIMAGE",AFFINE_LINEAR_PREIMAGE; "AFFINE_NEGATIONS",AFFINE_NEGATIONS; "AFFINE_PARALLEL_SLICE",AFFINE_PARALLEL_SLICE; "AFFINE_PCROSS",AFFINE_PCROSS; "AFFINE_PCROSS_EQ",AFFINE_PCROSS_EQ; "AFFINE_SCALING",AFFINE_SCALING; "AFFINE_SCALING_EQ",AFFINE_SCALING_EQ; "AFFINE_SING",AFFINE_SING; "AFFINE_SPAN",AFFINE_SPAN; "AFFINE_STANDARD_HYPERPLANE",AFFINE_STANDARD_HYPERPLANE; "AFFINE_SUMS",AFFINE_SUMS; "AFFINE_TRANSLATION",AFFINE_TRANSLATION; "AFFINE_TRANSLATION_EQ",AFFINE_TRANSLATION_EQ; "AFFINE_TRANSLATION_SUBSPACE",AFFINE_TRANSLATION_SUBSPACE; "AFFINE_TRANSLATION_SUBSPACE_EXPLICIT",AFFINE_TRANSLATION_SUBSPACE_EXPLICIT; "AFFINE_TRANSLATION_UNIQUE_SUBSPACE",AFFINE_TRANSLATION_UNIQUE_SUBSPACE; "AFFINE_UNIV",AFFINE_UNIV; "AFFINE_VSUM",AFFINE_VSUM; "AFFINE_VSUM_STRONG",AFFINE_VSUM_STRONG; "AFFINITY_INVERSES",AFFINITY_INVERSES; "AFFINITY_SCALING_TRANSLATION",AFFINITY_SCALING_TRANSLATION; "AFF_DIM",AFF_DIM; "AFF_DIM_2",AFF_DIM_2; "AFF_DIM_AFFINE_HULL",AFF_DIM_AFFINE_HULL; "AFF_DIM_AFFINE_INDEPENDENT",AFF_DIM_AFFINE_INDEPENDENT; "AFF_DIM_AFFINE_INTER_HYPERPLANE",AFF_DIM_AFFINE_INTER_HYPERPLANE; "AFF_DIM_BALL",AFF_DIM_BALL; "AFF_DIM_CBALL",AFF_DIM_CBALL; "AFF_DIM_CLOSURE",AFF_DIM_CLOSURE; "AFF_DIM_CONIC_HULL",AFF_DIM_CONIC_HULL; "AFF_DIM_CONIC_HULL_DIM",AFF_DIM_CONIC_HULL_DIM; "AFF_DIM_CONVEX_HULL",AFF_DIM_CONVEX_HULL; "AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR",AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR; "AFF_DIM_CONVEX_INTER_OPEN",AFF_DIM_CONVEX_INTER_OPEN; "AFF_DIM_DIM",AFF_DIM_DIM; "AFF_DIM_DIMENSION",AFF_DIM_DIMENSION; "AFF_DIM_DIMENSION_ALT",AFF_DIM_DIMENSION_ALT; "AFF_DIM_DIM_0",AFF_DIM_DIM_0; "AFF_DIM_DIM_AFFINE_DIFFS",AFF_DIM_DIM_AFFINE_DIFFS; "AFF_DIM_DIM_AFFINE_DIFFS_STRONG",AFF_DIM_DIM_AFFINE_DIFFS_STRONG; "AFF_DIM_DIM_SUBSPACE",AFF_DIM_DIM_SUBSPACE; "AFF_DIM_EMPTY",AFF_DIM_EMPTY; "AFF_DIM_EQ_0",AFF_DIM_EQ_0; "AFF_DIM_EQ_AFFINE_HULL",AFF_DIM_EQ_AFFINE_HULL; "AFF_DIM_EQ_FULL",AFF_DIM_EQ_FULL; "AFF_DIM_EQ_FULL_GEN",AFF_DIM_EQ_FULL_GEN; "AFF_DIM_EQ_HYPERPLANE",AFF_DIM_EQ_HYPERPLANE; "AFF_DIM_EQ_INTER_HYPERPLANE",AFF_DIM_EQ_INTER_HYPERPLANE; "AFF_DIM_EQ_MINUS1",AFF_DIM_EQ_MINUS1; "AFF_DIM_GE",AFF_DIM_GE; "AFF_DIM_HALFSPACE_GE",AFF_DIM_HALFSPACE_GE; "AFF_DIM_HALFSPACE_GT",AFF_DIM_HALFSPACE_GT; "AFF_DIM_HALFSPACE_LE",AFF_DIM_HALFSPACE_LE; "AFF_DIM_HALFSPACE_LT",AFF_DIM_HALFSPACE_LT; "AFF_DIM_HYPERPLANE",AFF_DIM_HYPERPLANE; "AFF_DIM_INJECTIVE_LINEAR_IMAGE",AFF_DIM_INJECTIVE_LINEAR_IMAGE; "AFF_DIM_INSERT",AFF_DIM_INSERT; "AFF_DIM_INTERVAL",AFF_DIM_INTERVAL; "AFF_DIM_LE_CARD",AFF_DIM_LE_CARD; "AFF_DIM_LE_DIM",AFF_DIM_LE_DIM; "AFF_DIM_LE_UNIV",AFF_DIM_LE_UNIV; "AFF_DIM_LINEAR_IMAGE_LE",AFF_DIM_LINEAR_IMAGE_LE; "AFF_DIM_LT_FULL",AFF_DIM_LT_FULL; "AFF_DIM_NONEMPTY_INTERIOR",AFF_DIM_NONEMPTY_INTERIOR; "AFF_DIM_NONEMPTY_INTERIOR_EQ",AFF_DIM_NONEMPTY_INTERIOR_EQ; "AFF_DIM_NONEMPTY_INTERIOR_OF",AFF_DIM_NONEMPTY_INTERIOR_OF; "AFF_DIM_NONEMPTY_INTERIOR_OF_EQ",AFF_DIM_NONEMPTY_INTERIOR_OF_EQ; "AFF_DIM_OPEN",AFF_DIM_OPEN; "AFF_DIM_OPEN_IN",AFF_DIM_OPEN_IN; "AFF_DIM_PCROSS",AFF_DIM_PCROSS; "AFF_DIM_POS_LE",AFF_DIM_POS_LE; "AFF_DIM_PSUBSET",AFF_DIM_PSUBSET; "AFF_DIM_RELATIVE_INTERIOR",AFF_DIM_RELATIVE_INTERIOR; "AFF_DIM_SEGMENT",AFF_DIM_SEGMENT; "AFF_DIM_SIMPLEX",AFF_DIM_SIMPLEX; "AFF_DIM_SING",AFF_DIM_SING; "AFF_DIM_SUBSET",AFF_DIM_SUBSET; "AFF_DIM_SUMS_INTER",AFF_DIM_SUMS_INTER; "AFF_DIM_TRANSLATION_EQ",AFF_DIM_TRANSLATION_EQ; "AFF_DIM_UNION",AFF_DIM_UNION; "AFF_DIM_UNIQUE",AFF_DIM_UNIQUE; "AFF_DIM_UNIV",AFF_DIM_UNIV; "AFF_LOWDIM_SUBSET_HYPERPLANE",AFF_LOWDIM_SUBSET_HYPERPLANE; "ALL",ALL; "ALL2",ALL2; "ALL2_ALL",ALL2_ALL; "ALL2_AND_RIGHT",ALL2_AND_RIGHT; "ALL2_DEF",ALL2_DEF; "ALL2_MAP",ALL2_MAP; "ALL2_MAP2",ALL2_MAP2; "ALL_APPEND",ALL_APPEND; "ALL_EL",ALL_EL; "ALL_FILTER",ALL_FILTER; "ALL_IMP",ALL_IMP; "ALL_MAP",ALL_MAP; "ALL_MEM",ALL_MEM; "ALL_MP",ALL_MP; "ALL_T",ALL_T; "ALWAYS_EVENTUALLY",ALWAYS_EVENTUALLY; "ANALYTIC_BOREL_MEASURABLE_IMAGE",ANALYTIC_BOREL_MEASURABLE_IMAGE; "ANALYTIC_BOREL_MEASURABLE_PREIMAGE",ANALYTIC_BOREL_MEASURABLE_PREIMAGE; "ANALYTIC_CONTINUOUS_IMAGE",ANALYTIC_CONTINUOUS_IMAGE; "ANALYTIC_CONTINUOUS_PREIMAGE",ANALYTIC_CONTINUOUS_PREIMAGE; "ANALYTIC_EMPTY",ANALYTIC_EMPTY; "ANALYTIC_IMP_LEBESGUE_MEASURABLE",ANALYTIC_IMP_LEBESGUE_MEASURABLE; "ANALYTIC_INTER",ANALYTIC_INTER; "ANALYTIC_INTERS",ANALYTIC_INTERS; "ANALYTIC_LINEAR_IMAGE",ANALYTIC_LINEAR_IMAGE; "ANALYTIC_PCROSS",ANALYTIC_PCROSS; "ANALYTIC_PCROSS_EQ",ANALYTIC_PCROSS_EQ; "ANALYTIC_TRANSLATION",ANALYTIC_TRANSLATION; "ANALYTIC_UNION",ANALYTIC_UNION; "ANALYTIC_UNIONS",ANALYTIC_UNIONS; "ANALYTIC_UNIV",ANALYTIC_UNIV; "AND_ALL",AND_ALL; "AND_ALL2",AND_ALL2; "AND_CLAUSES",AND_CLAUSES; "AND_DEF",AND_DEF; "AND_FORALL_THM",AND_FORALL_THM; "ANR",ANR; "ANR_BALL",ANR_BALL; "ANR_CBALL",ANR_CBALL; "ANR_CLOSED_UNION",ANR_CLOSED_UNION; "ANR_CLOSED_UNION_LOCAL",ANR_CLOSED_UNION_LOCAL; "ANR_CLOSURE_FROM_FRONTIER",ANR_CLOSURE_FROM_FRONTIER; "ANR_COMPONENTWISE",ANR_COMPONENTWISE; "ANR_COMPONENT_ANR",ANR_COMPONENT_ANR; "ANR_CONNECTED_COMPONENT_ANR",ANR_CONNECTED_COMPONENT_ANR; "ANR_COVERING_SPACE",ANR_COVERING_SPACE; "ANR_COVERING_SPACE_EQ",ANR_COVERING_SPACE_EQ; "ANR_DELETE",ANR_DELETE; "ANR_EMPTY",ANR_EMPTY; "ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; "ANR_FINITE_UNIONS_CONVEX_CLOSED",ANR_FINITE_UNIONS_CONVEX_CLOSED; "ANR_FROM_UNION_AND_INTER",ANR_FROM_UNION_AND_INTER; "ANR_FROM_UNION_AND_INTER_LOCAL",ANR_FROM_UNION_AND_INTER_LOCAL; "ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR; "ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT; "ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; "ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; "ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; "ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT; "ANR_IMP_LOCALLY_CONNECTED",ANR_IMP_LOCALLY_CONNECTED; "ANR_IMP_LOCALLY_PATH_CONNECTED",ANR_IMP_LOCALLY_PATH_CONNECTED; "ANR_IMP_NEIGHBOURHOOD_RETRACT",ANR_IMP_NEIGHBOURHOOD_RETRACT; "ANR_INSERT",ANR_INSERT; "ANR_INTERIOR",ANR_INTERIOR; "ANR_INTERVAL",ANR_INTERVAL; "ANR_LINEAR_IMAGE_EQ",ANR_LINEAR_IMAGE_EQ; "ANR_LOCALLY",ANR_LOCALLY; "ANR_NEIGHBORHOOD_RETRACT",ANR_NEIGHBORHOOD_RETRACT; "ANR_OPEN_IN",ANR_OPEN_IN; "ANR_OPEN_UNION",ANR_OPEN_UNION; "ANR_OPEN_UNIONS",ANR_OPEN_UNIONS; "ANR_PATH_COMPONENT_ANR",ANR_PATH_COMPONENT_ANR; "ANR_PATH_IMAGE_SIMPLE_PATH",ANR_PATH_IMAGE_SIMPLE_PATH; "ANR_PCROSS",ANR_PCROSS; "ANR_PCROSS_EQ",ANR_PCROSS_EQ; "ANR_RELATIVE_FRONTIER_CONVEX",ANR_RELATIVE_FRONTIER_CONVEX; "ANR_RELATIVE_INTERIOR",ANR_RELATIVE_INTERIOR; "ANR_RETRACT_OF_ANR",ANR_RETRACT_OF_ANR; "ANR_SIMPLICIAL_COMPLEX",ANR_SIMPLICIAL_COMPLEX; "ANR_SING",ANR_SING; "ANR_SPHERE",ANR_SPHERE; "ANR_STRONG_DEFORMATION_RETRACTION",ANR_STRONG_DEFORMATION_RETRACTION; "ANR_TRANSLATION",ANR_TRANSLATION; "ANR_TRIANGULATION",ANR_TRIANGULATION; "ANR_UNION_EXTENSION_LEMMA",ANR_UNION_EXTENSION_LEMMA; "ANR_UNIV",ANR_UNIV; "ANTIDERIVATIVE_CONTINUOUS",ANTIDERIVATIVE_CONTINUOUS; "ANTIDERIVATIVE_INTEGRAL_CONTINUOUS",ANTIDERIVATIVE_INTEGRAL_CONTINUOUS; "ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL",ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL; "ANY_CLOSEST_POINT_DOT",ANY_CLOSEST_POINT_DOT; "ANY_CLOSEST_POINT_UNIQUE",ANY_CLOSEST_POINT_UNIQUE; "ANY_IN_CONIC_HULL_SIMPLEX",ANY_IN_CONIC_HULL_SIMPLEX; "APPEND",APPEND; "APPEND_ASSOC",APPEND_ASSOC; "APPEND_BUTLAST_LAST",APPEND_BUTLAST_LAST; "APPEND_EQ_NIL",APPEND_EQ_NIL; "APPEND_LCANCEL",APPEND_LCANCEL; "APPEND_NIL",APPEND_NIL; "APPEND_RCANCEL",APPEND_RCANCEL; "APPEND_SING",APPEND_SING; "APPROACHABLE_LT_LE",APPROACHABLE_LT_LE; "APPROXIMABLE_ON_DIVISION",APPROXIMABLE_ON_DIVISION; "AR",AR; "ARBITRARILY_SMALL_CONTINUUM",ARBITRARILY_SMALL_CONTINUUM; "ARCH_EVENTUALLY_INV",ARCH_EVENTUALLY_INV; "ARCH_EVENTUALLY_INV1",ARCH_EVENTUALLY_INV1; "ARCH_EVENTUALLY_LE",ARCH_EVENTUALLY_LE; "ARCH_EVENTUALLY_LT",ARCH_EVENTUALLY_LT; "ARCH_EVENTUALLY_POW",ARCH_EVENTUALLY_POW; "ARCH_EVENTUALLY_POW_INV",ARCH_EVENTUALLY_POW_INV; "ARC_ASSOC",ARC_ASSOC; "ARC_CONNECTED_TRANS",ARC_CONNECTED_TRANS; "ARC_CONTINUOUS_IMAGE",ARC_CONTINUOUS_IMAGE; "ARC_DISTINCT_ENDS",ARC_DISTINCT_ENDS; "ARC_ENDS_UNIQUE",ARC_ENDS_UNIQUE; "ARC_HOMEOMORPHISM_ENDS",ARC_HOMEOMORPHISM_ENDS; "ARC_IMAGE_UNIQUE",ARC_IMAGE_UNIQUE; "ARC_IMP_PATH",ARC_IMP_PATH; "ARC_IMP_SIMPLE_PATH",ARC_IMP_SIMPLE_PATH; "ARC_JOIN",ARC_JOIN; "ARC_JOIN_EQ",ARC_JOIN_EQ; "ARC_JOIN_EQ_ALT",ARC_JOIN_EQ_ALT; "ARC_LENGTH_MINIMAL",ARC_LENGTH_MINIMAL; "ARC_LENGTH_REPARAMETRIZATION",ARC_LENGTH_REPARAMETRIZATION; "ARC_LENGTH_UNIQUE",ARC_LENGTH_UNIQUE; "ARC_LINEAR_IMAGE_EQ",ARC_LINEAR_IMAGE_EQ; "ARC_LINEPATH",ARC_LINEPATH; "ARC_LINEPATH_EQ",ARC_LINEPATH_EQ; "ARC_REVERSEPATH",ARC_REVERSEPATH; "ARC_REVERSEPATH_EQ",ARC_REVERSEPATH_EQ; "ARC_SIMPLE_PATH",ARC_SIMPLE_PATH; "ARC_SIMPLE_PATH_SUBPATH",ARC_SIMPLE_PATH_SUBPATH; "ARC_SIMPLE_PATH_SUBPATH_INTERIOR",ARC_SIMPLE_PATH_SUBPATH_INTERIOR; "ARC_SUBPATH_ARC",ARC_SUBPATH_ARC; "ARC_SUBPATH_EQ",ARC_SUBPATH_EQ; "ARC_TRANSLATION_EQ",ARC_TRANSLATION_EQ; "ARITH",ARITH; "ARITH_ADD",ARITH_ADD; "ARITH_EQ",ARITH_EQ; "ARITH_EVEN",ARITH_EVEN; "ARITH_EXP",ARITH_EXP; "ARITH_GE",ARITH_GE; "ARITH_GT",ARITH_GT; "ARITH_LE",ARITH_LE; "ARITH_LT",ARITH_LT; "ARITH_MULT",ARITH_MULT; "ARITH_ODD",ARITH_ODD; "ARITH_PRE",ARITH_PRE; "ARITH_SUB",ARITH_SUB; "ARITH_SUC",ARITH_SUC; "ARITH_ZERO",ARITH_ZERO; "ARZELA_ASCOLI",ARZELA_ASCOLI; "ARZELA_ASCOLI_LIPSCHITZ",ARZELA_ASCOLI_LIPSCHITZ; "AR_ANR",AR_ANR; "AR_ARC_IMAGE",AR_ARC_IMAGE; "AR_BALL",AR_BALL; "AR_CBALL",AR_CBALL; "AR_CLOSED_UNION",AR_CLOSED_UNION; "AR_CLOSED_UNION_LOCAL",AR_CLOSED_UNION_LOCAL; "AR_DEFORMATION_RETRACT_OF_CONTRACTIBLE",AR_DEFORMATION_RETRACT_OF_CONTRACTIBLE; "AR_EQ_ABSOLUTE_EXTENSOR",AR_EQ_ABSOLUTE_EXTENSOR; "AR_FROM_UNION_AND_INTER",AR_FROM_UNION_AND_INTER; "AR_FROM_UNION_AND_INTER_LOCAL",AR_FROM_UNION_AND_INTER_LOCAL; "AR_IMP_ABSOLUTE_EXTENSOR",AR_IMP_ABSOLUTE_EXTENSOR; "AR_IMP_ABSOLUTE_RETRACT",AR_IMP_ABSOLUTE_RETRACT; "AR_IMP_ABSOLUTE_RETRACT_UNIV",AR_IMP_ABSOLUTE_RETRACT_UNIV; "AR_IMP_ANR",AR_IMP_ANR; "AR_IMP_CONNECTED",AR_IMP_CONNECTED; "AR_IMP_CONTRACTIBLE",AR_IMP_CONTRACTIBLE; "AR_IMP_LOCALLY_CONNECTED",AR_IMP_LOCALLY_CONNECTED; "AR_IMP_LOCALLY_PATH_CONNECTED",AR_IMP_LOCALLY_PATH_CONNECTED; "AR_IMP_NONEMPTY",AR_IMP_NONEMPTY; "AR_IMP_PATH_CONNECTED",AR_IMP_PATH_CONNECTED; "AR_IMP_RETRACT",AR_IMP_RETRACT; "AR_INTERVAL",AR_INTERVAL; "AR_LINEAR_IMAGE_EQ",AR_LINEAR_IMAGE_EQ; "AR_PCROSS",AR_PCROSS; "AR_PCROSS_EQ",AR_PCROSS_EQ; "AR_RETRACT_OF_AR",AR_RETRACT_OF_AR; "AR_SING",AR_SING; "AR_STRONG_DEFORMATION_RETRACT_OF_AR",AR_STRONG_DEFORMATION_RETRACT_OF_AR; "AR_TRANSLATION",AR_TRANSLATION; "AR_UNIV",AR_UNIV; "ASSOC",ASSOC; "AT",AT; "AT_INFINITY",AT_INFINITY; "AT_NEGINFINITY",AT_NEGINFINITY; "AT_POSINFINITY",AT_POSINFINITY; "AUSTIN_LEMMA",AUSTIN_LEMMA; "BABY_SARD",BABY_SARD; "BABY_SARD_ALT",BABY_SARD_ALT; "BACK_AND_FORTH",BACK_AND_FORTH; "BACK_AND_FORTH_2",BACK_AND_FORTH_2; "BACK_AND_FORTH_ALT",BACK_AND_FORTH_ALT; "BAIRE",BAIRE; "BAIRE0_INDICATOR",BAIRE0_INDICATOR; "BAIRE1_DET_JACOBIAN",BAIRE1_DET_JACOBIAN; "BAIRE1_INDICATOR",BAIRE1_INDICATOR; "BAIRE1_PARTIAL_DERIVATIVES",BAIRE1_PARTIAL_DERIVATIVES; "BAIRE1_VECTOR_DERIVATIVE",BAIRE1_VECTOR_DERIVATIVE; "BAIRE_ADD",BAIRE_ADD; "BAIRE_ALT",BAIRE_ALT; "BAIRE_BILINEAR",BAIRE_BILINEAR; "BAIRE_CMUL",BAIRE_CMUL; "BAIRE_COMPONENTWISE",BAIRE_COMPONENTWISE; "BAIRE_COMPOSE_CONTINUOUS",BAIRE_COMPOSE_CONTINUOUS; "BAIRE_CONST",BAIRE_CONST; "BAIRE_CONTINUOUS_COMPOSE_UNIV",BAIRE_CONTINUOUS_COMPOSE_UNIV; "BAIRE_EQ",BAIRE_EQ; "BAIRE_IMP_BOREL_MEASURABLE",BAIRE_IMP_BOREL_MEASURABLE; "BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE",BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE; "BAIRE_INDICATOR_COMPLEMENT",BAIRE_INDICATOR_COMPLEMENT; "BAIRE_INDICATOR_COMPLEMENT_UNIV",BAIRE_INDICATOR_COMPLEMENT_UNIV; "BAIRE_INDICATOR_CONTINUOUS_PREIMAGE",BAIRE_INDICATOR_CONTINUOUS_PREIMAGE; "BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV",BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV; "BAIRE_INDICATOR_DELTA",BAIRE_INDICATOR_DELTA; "BAIRE_INDICATOR_DIFF",BAIRE_INDICATOR_DIFF; "BAIRE_INDICATOR_EMPTY",BAIRE_INDICATOR_EMPTY; "BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE",BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE; "BAIRE_INDICATOR_INTER",BAIRE_INDICATOR_INTER; "BAIRE_INDICATOR_INTERS",BAIRE_INDICATOR_INTERS; "BAIRE_INDICATOR_REFL",BAIRE_INDICATOR_REFL; "BAIRE_INDICATOR_SUC",BAIRE_INDICATOR_SUC; "BAIRE_INDICATOR_TRANSLATION",BAIRE_INDICATOR_TRANSLATION; "BAIRE_INDICATOR_UNION",BAIRE_INDICATOR_UNION; "BAIRE_INDICATOR_UNIONS",BAIRE_INDICATOR_UNIONS; "BAIRE_INDICATOR_UNIV",BAIRE_INDICATOR_UNIV; "BAIRE_MAX",BAIRE_MAX; "BAIRE_MIN",BAIRE_MIN; "BAIRE_MONO",BAIRE_MONO; "BAIRE_MUL",BAIRE_MUL; "BAIRE_NORM",BAIRE_NORM; "BAIRE_PASTECART",BAIRE_PASTECART; "BAIRE_PRODUCT",BAIRE_PRODUCT; "BAIRE_SUB",BAIRE_SUB; "BAIRE_SUBSET",BAIRE_SUBSET; "BAIRE_UNIFORM_APPROXIMATION",BAIRE_UNIFORM_APPROXIMATION; "BAIRE_UNIFORM_LIMIT",BAIRE_UNIFORM_LIMIT; "BAIRE_VSUM",BAIRE_VSUM; "BALL_1",BALL_1; "BALL_EMPTY",BALL_EMPTY; "BALL_EQ_EMPTY",BALL_EQ_EMPTY; "BALL_INTERVAL",BALL_INTERVAL; "BALL_INTERVAL_0",BALL_INTERVAL_0; "BALL_LINEAR_IMAGE",BALL_LINEAR_IMAGE; "BALL_MAX_UNION",BALL_MAX_UNION; "BALL_MIN_INTER",BALL_MIN_INTER; "BALL_SCALING",BALL_SCALING; "BALL_SUBSET_CBALL",BALL_SUBSET_CBALL; "BALL_SUBSET_OPEN_MAP_IMAGE",BALL_SUBSET_OPEN_MAP_IMAGE; "BALL_TRANSLATION",BALL_TRANSLATION; "BALL_TRIVIAL",BALL_TRIVIAL; "BALL_UNION_SPHERE",BALL_UNION_SPHERE; "BANACH_FIX",BANACH_FIX; "BANACH_FIXPOINT_THM",BANACH_FIXPOINT_THM; "BANACH_FIX_ITER",BANACH_FIX_ITER; "BANACH_SPROPERTY_IMP_FINITE_PREIMAGES",BANACH_SPROPERTY_IMP_FINITE_PREIMAGES; "BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY",BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY; "BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY_OUTER",BANACH_SPROPERTY_IMP_LUZIN_NPROPERTY_OUTER; "BANACH_SPROPERTY_IMP_PRESERVES_MEASURABLE",BANACH_SPROPERTY_IMP_PRESERVES_MEASURABLE; "BANACH_SPROPERTY_OUTER",BANACH_SPROPERTY_OUTER; "BANACH_ZARECKI",BANACH_ZARECKI; "BANACH_ZARECKI_GEN",BANACH_ZARECKI_GEN; "BARYCENTRE_0",BARYCENTRE_0; "BARYCENTRE_1",BARYCENTRE_1; "BARYCENTRE_2",BARYCENTRE_2; "BARYCENTRE_IN_AFFINE_HULL",BARYCENTRE_IN_AFFINE_HULL; "BARYCENTRE_IN_CONVEX_HULL",BARYCENTRE_IN_CONVEX_HULL; "BARYCENTRE_IN_RELATIVE_INTERIOR",BARYCENTRE_IN_RELATIVE_INTERIOR; "BARYCENTRE_LINEAR_IMAGE",BARYCENTRE_LINEAR_IMAGE; "BARYCENTRE_NOT_IN_SET",BARYCENTRE_NOT_IN_SET; "BARYCENTRE_TRANSLATION",BARYCENTRE_TRANSLATION; "BASIS_CARD_EQ_DIM",BASIS_CARD_EQ_DIM; "BASIS_COMPONENT",BASIS_COMPONENT; "BASIS_COORDINATES_CONTINUOUS",BASIS_COORDINATES_CONTINUOUS; "BASIS_COORDINATES_LIPSCHITZ",BASIS_COORDINATES_LIPSCHITZ; "BASIS_EQ_0",BASIS_EQ_0; "BASIS_EXISTS",BASIS_EXISTS; "BASIS_EXISTS_FINITE",BASIS_EXISTS_FINITE; "BASIS_EXPANSION",BASIS_EXPANSION; "BASIS_EXPANSION_UNIQUE",BASIS_EXPANSION_UNIQUE; "BASIS_HAS_SIZE_DIM",BASIS_HAS_SIZE_DIM; "BASIS_HAS_SIZE_UNIV",BASIS_HAS_SIZE_UNIV; "BASIS_INJ",BASIS_INJ; "BASIS_INJ_EQ",BASIS_INJ_EQ; "BASIS_NE",BASIS_NE; "BASIS_NONZERO",BASIS_NONZERO; "BASIS_ORTHOGONAL",BASIS_ORTHOGONAL; "BASIS_SUBSPACE_EXISTS",BASIS_SUBSPACE_EXISTS; "BEPPO_LEVI_DECREASING",BEPPO_LEVI_DECREASING; "BEPPO_LEVI_INCREASING",BEPPO_LEVI_INCREASING; "BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING; "BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE; "BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING; "BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE; "BESSEL_INEQUALITY",BESSEL_INEQUALITY; "BETA_THM",BETA_THM; "BETWEEN_1",BETWEEN_1; "BETWEEN_ANTISYM",BETWEEN_ANTISYM; "BETWEEN_CMUL_LIFT",BETWEEN_CMUL_LIFT; "BETWEEN_COLLINEAR_DIST_EQ",BETWEEN_COLLINEAR_DIST_EQ; "BETWEEN_DIST_LE",BETWEEN_DIST_LE; "BETWEEN_DIST_LT",BETWEEN_DIST_LT; "BETWEEN_DOT",BETWEEN_DOT; "BETWEEN_EXISTS_EXTENSION",BETWEEN_EXISTS_EXTENSION; "BETWEEN_IMP_COLLINEAR",BETWEEN_IMP_COLLINEAR; "BETWEEN_IN_CONVEX_HULL",BETWEEN_IN_CONVEX_HULL; "BETWEEN_IN_SEGMENT",BETWEEN_IN_SEGMENT; "BETWEEN_LINEAR_IMAGE_EQ",BETWEEN_LINEAR_IMAGE_EQ; "BETWEEN_MIDPOINT",BETWEEN_MIDPOINT; "BETWEEN_NORM",BETWEEN_NORM; "BETWEEN_NORM_LE",BETWEEN_NORM_LE; "BETWEEN_NORM_LT",BETWEEN_NORM_LT; "BETWEEN_REFL",BETWEEN_REFL; "BETWEEN_REFL_EQ",BETWEEN_REFL_EQ; "BETWEEN_RESTRICTED_CASES",BETWEEN_RESTRICTED_CASES; "BETWEEN_SYM",BETWEEN_SYM; "BETWEEN_TRANS",BETWEEN_TRANS; "BETWEEN_TRANSLATION",BETWEEN_TRANSLATION; "BETWEEN_TRANS_2",BETWEEN_TRANS_2; "BICONNECTED_IMP_CONTINUOUS_ON",BICONNECTED_IMP_CONTINUOUS_ON; "BIJ",BIJ; "BIJECTIONS_CARD_EQ",BIJECTIONS_CARD_EQ; "BIJECTIONS_HAS_SIZE",BIJECTIONS_HAS_SIZE; "BIJECTIONS_HAS_SIZE_EQ",BIJECTIONS_HAS_SIZE_EQ; "BIJECTIVE_INJECTIVE_SURJECTIVE",BIJECTIVE_INJECTIVE_SURJECTIVE; "BIJECTIVE_INVERSES",BIJECTIVE_INVERSES; "BIJECTIVE_LEFT_RIGHT_INVERSE",BIJECTIVE_LEFT_RIGHT_INVERSE; "BIJECTIVE_ON_LEFT_RIGHT_INVERSE",BIJECTIVE_ON_LEFT_RIGHT_INVERSE; "BILINEAR_BOUNDED",BILINEAR_BOUNDED; "BILINEAR_BOUNDED_POS",BILINEAR_BOUNDED_POS; "BILINEAR_CONTINUOUS_COMPOSE",BILINEAR_CONTINUOUS_COMPOSE; "BILINEAR_CONTINUOUS_ON",BILINEAR_CONTINUOUS_ON; "BILINEAR_CONTINUOUS_ON_COMPOSE",BILINEAR_CONTINUOUS_ON_COMPOSE; "BILINEAR_DIFFERENTIABLE_AT_COMPOSE",BILINEAR_DIFFERENTIABLE_AT_COMPOSE; "BILINEAR_DIFFERENTIABLE_ON_COMPOSE",BILINEAR_DIFFERENTIABLE_ON_COMPOSE; "BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE",BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE; "BILINEAR_DOT",BILINEAR_DOT; "BILINEAR_DROP_MUL",BILINEAR_DROP_MUL; "BILINEAR_EPSILON_DELTA",BILINEAR_EPSILON_DELTA; "BILINEAR_EQ",BILINEAR_EQ; "BILINEAR_EQ_MBASIS",BILINEAR_EQ_MBASIS; "BILINEAR_EQ_STDBASIS",BILINEAR_EQ_STDBASIS; "BILINEAR_GEOM",BILINEAR_GEOM; "BILINEAR_INNER",BILINEAR_INNER; "BILINEAR_LADD",BILINEAR_LADD; "BILINEAR_LIFT_MUL",BILINEAR_LIFT_MUL; "BILINEAR_LMUL",BILINEAR_LMUL; "BILINEAR_LNEG",BILINEAR_LNEG; "BILINEAR_LSUB",BILINEAR_LSUB; "BILINEAR_LSUM",BILINEAR_LSUM; "BILINEAR_LZERO",BILINEAR_LZERO; "BILINEAR_MUL_DROP",BILINEAR_MUL_DROP; "BILINEAR_OUTER",BILINEAR_OUTER; "BILINEAR_PRODUCT",BILINEAR_PRODUCT; "BILINEAR_RADD",BILINEAR_RADD; "BILINEAR_RMUL",BILINEAR_RMUL; "BILINEAR_RNEG",BILINEAR_RNEG; "BILINEAR_RSUB",BILINEAR_RSUB; "BILINEAR_RSUM",BILINEAR_RSUM; "BILINEAR_RZERO",BILINEAR_RZERO; "BILINEAR_SWAP",BILINEAR_SWAP; "BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE",BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE; "BILINEAR_VSUM",BILINEAR_VSUM; "BILINEAR_VSUM_CONVOLUTION_1",BILINEAR_VSUM_CONVOLUTION_1; "BILINEAR_VSUM_CONVOLUTION_2",BILINEAR_VSUM_CONVOLUTION_2; "BILINEAR_VSUM_PARTIAL_PRE",BILINEAR_VSUM_PARTIAL_PRE; "BILINEAR_VSUM_PARTIAL_SUC",BILINEAR_VSUM_PARTIAL_SUC; "BILIPSCHITZ_HOMEOMORPHISM_RELATIVE_FRONTIERS",BILIPSCHITZ_HOMEOMORPHISM_RELATIVE_FRONTIERS; "BILIPSCHITZ_HOMEOMORPHISM_SPHERICAL_PROJECTION",BILIPSCHITZ_HOMEOMORPHISM_SPHERICAL_PROJECTION; "BINARYSUM_BITSET",BINARYSUM_BITSET; "BINARYSUM_BOUND",BINARYSUM_BOUND; "BINARYSUM_BOUND_EQ",BINARYSUM_BOUND_EQ; "BINARYSUM_BOUND_LEMMA",BINARYSUM_BOUND_LEMMA; "BINARYSUM_DIV",BINARYSUM_DIV; "BINARYSUM_DIV_DIVISIBLE",BINARYSUM_DIV_DIVISIBLE; "BINARY_INDUCT",BINARY_INDUCT; "BIT0",BIT0; "BIT0_DEF",BIT0_DEF; "BIT0_THM",BIT0_THM; "BIT1",BIT1; "BIT1_DEF",BIT1_DEF; "BIT1_THM",BIT1_THM; "BITSET_0",BITSET_0; "BITSET_BINARYSUM",BITSET_BINARYSUM; "BITSET_BOUND",BITSET_BOUND; "BITSET_BOUND_EQ",BITSET_BOUND_EQ; "BITSET_BOUND_LEMMA",BITSET_BOUND_LEMMA; "BITSET_BOUND_WEAK",BITSET_BOUND_WEAK; "BITSET_EQ",BITSET_EQ; "BITSET_EQ_EMPTY",BITSET_EQ_EMPTY; "BITSET_STEP",BITSET_STEP; "BLASCHKE",BLASCHKE; "BLASCHKE_UNIV",BLASCHKE_UNIV; "BOHL",BOHL; "BOHL_ALT",BOHL_ALT; "BOHL_SIMPLE",BOHL_SIMPLE; "BOLZANO_WEIERSTRASS",BOLZANO_WEIERSTRASS; "BOLZANO_WEIERSTRASS_CONTRAPOS",BOLZANO_WEIERSTRASS_CONTRAPOS; "BOLZANO_WEIERSTRASS_IMP_BOUNDED",BOLZANO_WEIERSTRASS_IMP_BOUNDED; "BOLZANO_WEIERSTRASS_IMP_CLOSED",BOLZANO_WEIERSTRASS_IMP_CLOSED; "BOOL_CASES_AX",BOOL_CASES_AX; "BOREL_BOREL_MEASURABLE_PREIMAGE",BOREL_BOREL_MEASURABLE_PREIMAGE; "BOREL_COMPLEMENT",BOREL_COMPLEMENT; "BOREL_DIFF",BOREL_DIFF; "BOREL_DOMAIN_OF_INJECTIVITY",BOREL_DOMAIN_OF_INJECTIVITY; "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS; "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN; "BOREL_EMPTY",BOREL_EMPTY; "BOREL_IMP_ANALYTIC",BOREL_IMP_ANALYTIC; "BOREL_IMP_LEBESGUE_MEASURABLE",BOREL_IMP_LEBESGUE_MEASURABLE; "BOREL_INDUCT_CLOSED_UNIONS_INTERS",BOREL_INDUCT_CLOSED_UNIONS_INTERS; "BOREL_INDUCT_COMPACT",BOREL_INDUCT_COMPACT; "BOREL_INDUCT_COMPACT_ALT",BOREL_INDUCT_COMPACT_ALT; "BOREL_INDUCT_COMPACT_DIFF",BOREL_INDUCT_COMPACT_DIFF; "BOREL_INDUCT_COMPACT_UNIONS_INTERS",BOREL_INDUCT_COMPACT_UNIONS_INTERS; "BOREL_INDUCT_OPEN_UNIONS_INTERS",BOREL_INDUCT_OPEN_UNIONS_INTERS; "BOREL_INDUCT_UNIONS_INTERS",BOREL_INDUCT_UNIONS_INTERS; "BOREL_INTER",BOREL_INTER; "BOREL_INTERS",BOREL_INTERS; "BOREL_LINEAR_IMAGE",BOREL_LINEAR_IMAGE; "BOREL_MEASURABLE_ADD",BOREL_MEASURABLE_ADD; "BOREL_MEASURABLE_BILINEAR",BOREL_MEASURABLE_BILINEAR; "BOREL_MEASURABLE_CASES",BOREL_MEASURABLE_CASES; "BOREL_MEASURABLE_CMUL",BOREL_MEASURABLE_CMUL; "BOREL_MEASURABLE_COMPONENTWISE",BOREL_MEASURABLE_COMPONENTWISE; "BOREL_MEASURABLE_COMPOSE",BOREL_MEASURABLE_COMPOSE; "BOREL_MEASURABLE_CONST",BOREL_MEASURABLE_CONST; "BOREL_MEASURABLE_CONTINUOUS_COMPOSE",BOREL_MEASURABLE_CONTINUOUS_COMPOSE; "BOREL_MEASURABLE_EQ",BOREL_MEASURABLE_EQ; "BOREL_MEASURABLE_EXTENSION",BOREL_MEASURABLE_EXTENSION; "BOREL_MEASURABLE_IMP_MEASURABLE_ON",BOREL_MEASURABLE_IMP_MEASURABLE_ON; "BOREL_MEASURABLE_INDICATOR",BOREL_MEASURABLE_INDICATOR; "BOREL_MEASURABLE_MAX",BOREL_MEASURABLE_MAX; "BOREL_MEASURABLE_MIN",BOREL_MEASURABLE_MIN; "BOREL_MEASURABLE_MUL",BOREL_MEASURABLE_MUL; "BOREL_MEASURABLE_NORM",BOREL_MEASURABLE_NORM; "BOREL_MEASURABLE_ON_INDICATOR",BOREL_MEASURABLE_ON_INDICATOR; "BOREL_MEASURABLE_ON_SUBSET",BOREL_MEASURABLE_ON_SUBSET; "BOREL_MEASURABLE_PASTECART",BOREL_MEASURABLE_PASTECART; "BOREL_MEASURABLE_PREIMAGE_BOREL",BOREL_MEASURABLE_PREIMAGE_BOREL; "BOREL_MEASURABLE_PRODUCT",BOREL_MEASURABLE_PRODUCT; "BOREL_MEASURABLE_RESTRICT",BOREL_MEASURABLE_RESTRICT; "BOREL_MEASURABLE_SUB",BOREL_MEASURABLE_SUB; "BOREL_MEASURABLE_VSUM",BOREL_MEASURABLE_VSUM; "BOREL_PCROSS",BOREL_PCROSS; "BOREL_PCROSS_EQ",BOREL_PCROSS_EQ; "BOREL_POINTS_OF_DIFFERENTIABILITY",BOREL_POINTS_OF_DIFFERENTIABILITY; "BOREL_PREIMAGE_FINITE",BOREL_PREIMAGE_FINITE; "BOREL_PREIMAGE_HAS_SIZE",BOREL_PREIMAGE_HAS_SIZE; "BOREL_PREIMAGE_INFINITE",BOREL_PREIMAGE_INFINITE; "BOREL_TRANSLATION",BOREL_TRANSLATION; "BOREL_UNION",BOREL_UNION; "BOREL_UNIONS",BOREL_UNIONS; "BOREL_UNIV",BOREL_UNIV; "BORSUK_HOMOTOPY_EXTENSION",BORSUK_HOMOTOPY_EXTENSION; "BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC",BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC; "BOTTOM",BOTTOM; "BOUNDARY_BUMPING_THEOREM",BOUNDARY_BUMPING_THEOREM; "BOUNDARY_BUMPING_THEOREM_ALT",BOUNDARY_BUMPING_THEOREM_ALT; "BOUNDARY_BUMPING_THEOREM_CLOSED",BOUNDARY_BUMPING_THEOREM_CLOSED; "BOUNDARY_BUMPING_THEOREM_INTER",BOUNDARY_BUMPING_THEOREM_INTER; "BOUNDARY_BUMPING_THEOREM_INTER_ALT",BOUNDARY_BUMPING_THEOREM_INTER_ALT; "BOUNDARY_BUMPING_THEOREM_OPEN",BOUNDARY_BUMPING_THEOREM_OPEN; "BOUNDARY_BUMPING_THEOREM_OPEN_ALT",BOUNDARY_BUMPING_THEOREM_OPEN_ALT; "BOUNDED_AFFINITY",BOUNDED_AFFINITY; "BOUNDED_AFFINITY_EQ",BOUNDED_AFFINITY_EQ; "BOUNDED_AND_DIAMETER_LE",BOUNDED_AND_DIAMETER_LE; "BOUNDED_ARC_IMAGE",BOUNDED_ARC_IMAGE; "BOUNDED_BALL",BOUNDED_BALL; "BOUNDED_CBALL",BOUNDED_CBALL; "BOUNDED_CLOSED_CHAIN",BOUNDED_CLOSED_CHAIN; "BOUNDED_CLOSED_IMP_COMPACT",BOUNDED_CLOSED_IMP_COMPACT; "BOUNDED_CLOSED_INTERVAL",BOUNDED_CLOSED_INTERVAL; "BOUNDED_CLOSED_NEST",BOUNDED_CLOSED_NEST; "BOUNDED_CLOSURE",BOUNDED_CLOSURE; "BOUNDED_CLOSURE_EQ",BOUNDED_CLOSURE_EQ; "BOUNDED_COMMON_FRONTIER_DOMAINS",BOUNDED_COMMON_FRONTIER_DOMAINS; "BOUNDED_COMPONENTS_INSIDE",BOUNDED_COMPONENTS_INSIDE; "BOUNDED_COMPONENTWISE",BOUNDED_COMPONENTWISE; "BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS",BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS; "BOUNDED_CONVEX_HULL",BOUNDED_CONVEX_HULL; "BOUNDED_CONVEX_HULL_EQ",BOUNDED_CONVEX_HULL_EQ; "BOUNDED_DECREASING_CONVERGENT",BOUNDED_DECREASING_CONVERGENT; "BOUNDED_DELETE",BOUNDED_DELETE; "BOUNDED_DIFF",BOUNDED_DIFF; "BOUNDED_DIFFS",BOUNDED_DIFFS; "BOUNDED_EMPTY",BOUNDED_EMPTY; "BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION",BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION; "BOUNDED_EQ_BOLZANO_WEIERSTRASS",BOUNDED_EQ_BOLZANO_WEIERSTRASS; "BOUNDED_EQ_TOTALLY_BOUNDED",BOUNDED_EQ_TOTALLY_BOUNDED; "BOUNDED_FINITE",BOUNDED_FINITE; "BOUNDED_FRONTIER",BOUNDED_FRONTIER; "BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED",BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED; "BOUNDED_FUNCTIONS_BIJECTIONS_1",BOUNDED_FUNCTIONS_BIJECTIONS_1; "BOUNDED_FUNCTIONS_BIJECTIONS_2",BOUNDED_FUNCTIONS_BIJECTIONS_2; "BOUNDED_HALFSPACE_GE",BOUNDED_HALFSPACE_GE; "BOUNDED_HALFSPACE_GT",BOUNDED_HALFSPACE_GT; "BOUNDED_HALFSPACE_LE",BOUNDED_HALFSPACE_LE; "BOUNDED_HALFSPACE_LT",BOUNDED_HALFSPACE_LT; "BOUNDED_HAS_INF",BOUNDED_HAS_INF; "BOUNDED_HAS_SUP",BOUNDED_HAS_SUP; "BOUNDED_HYPERPLANE_EQ_TRIVIAL",BOUNDED_HYPERPLANE_EQ_TRIVIAL; "BOUNDED_IMAGE_IN_COMPACTIFICATION",BOUNDED_IMAGE_IN_COMPACTIFICATION; "BOUNDED_INCREASING_CONVERGENT",BOUNDED_INCREASING_CONVERGENT; "BOUNDED_INSERT",BOUNDED_INSERT; "BOUNDED_INSIDE",BOUNDED_INSIDE; "BOUNDED_INTEGRALS_OVER_SUBINTERVALS",BOUNDED_INTEGRALS_OVER_SUBINTERVALS; "BOUNDED_INTER",BOUNDED_INTER; "BOUNDED_INTERIOR",BOUNDED_INTERIOR; "BOUNDED_INTERS",BOUNDED_INTERS; "BOUNDED_INTERVAL",BOUNDED_INTERVAL; "BOUNDED_LIFT",BOUNDED_LIFT; "BOUNDED_LINEAR_IMAGE",BOUNDED_LINEAR_IMAGE; "BOUNDED_LINEAR_IMAGE_EQ",BOUNDED_LINEAR_IMAGE_EQ; "BOUNDED_LIPSCHITZ_IMAGE",BOUNDED_LIPSCHITZ_IMAGE; "BOUNDED_NEGATIONS",BOUNDED_NEGATIONS; "BOUNDED_NORM_IMAGE",BOUNDED_NORM_IMAGE; "BOUNDED_PARTIAL_SUMS",BOUNDED_PARTIAL_SUMS; "BOUNDED_PATH_IMAGE",BOUNDED_PATH_IMAGE; "BOUNDED_PCROSS",BOUNDED_PCROSS; "BOUNDED_PCROSS_EQ",BOUNDED_PCROSS_EQ; "BOUNDED_POS",BOUNDED_POS; "BOUNDED_POS_LT",BOUNDED_POS_LT; "BOUNDED_RECTIFIABLE_PATH_IMAGE",BOUNDED_RECTIFIABLE_PATH_IMAGE; "BOUNDED_RELATIVE_FRONTIER",BOUNDED_RELATIVE_FRONTIER; "BOUNDED_RELATIVE_INTERIOR",BOUNDED_RELATIVE_INTERIOR; "BOUNDED_SCALING",BOUNDED_SCALING; "BOUNDED_SCALING_EQ",BOUNDED_SCALING_EQ; "BOUNDED_SEGMENT",BOUNDED_SEGMENT; "BOUNDED_SEPARATION_1D",BOUNDED_SEPARATION_1D; "BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE; "BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL; "BOUNDED_SET_VARIATION_FROM_PASTECART",BOUNDED_SET_VARIATION_FROM_PASTECART; "BOUNDED_SET_VARIATION_ON_PASTECART",BOUNDED_SET_VARIATION_ON_PASTECART; "BOUNDED_SIMPLE_PATH_IMAGE",BOUNDED_SIMPLE_PATH_IMAGE; "BOUNDED_SING",BOUNDED_SING; "BOUNDED_SPHERE",BOUNDED_SPHERE; "BOUNDED_SUBSET",BOUNDED_SUBSET; "BOUNDED_SUBSET_BALL",BOUNDED_SUBSET_BALL; "BOUNDED_SUBSET_CBALL",BOUNDED_SUBSET_CBALL; "BOUNDED_SUBSET_CLOSED_INTERVAL",BOUNDED_SUBSET_CLOSED_INTERVAL; "BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC; "BOUNDED_SUBSET_OPEN_INTERVAL",BOUNDED_SUBSET_OPEN_INTERVAL; "BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC; "BOUNDED_SUMS",BOUNDED_SUMS; "BOUNDED_SUMS_IMAGE",BOUNDED_SUMS_IMAGE; "BOUNDED_SUMS_IMAGES",BOUNDED_SUMS_IMAGES; "BOUNDED_TRANSLATION",BOUNDED_TRANSLATION; "BOUNDED_TRANSLATION_EQ",BOUNDED_TRANSLATION_EQ; "BOUNDED_ULC_IMP_FCCOVERABLE",BOUNDED_ULC_IMP_FCCOVERABLE; "BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE",BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE; "BOUNDED_UNION",BOUNDED_UNION; "BOUNDED_UNIONS",BOUNDED_UNIONS; "BOUNDED_UNIQUE_OUTSIDE",BOUNDED_UNIQUE_OUTSIDE; "BOUNDED_VARIATION_FROM_PASTECART",BOUNDED_VARIATION_FROM_PASTECART; "BOUNDED_VECTOR_VARIATION_ON_PASTECART",BOUNDED_VECTOR_VARIATION_ON_PASTECART; "BOUNDED_WITH_INSIDE",BOUNDED_WITH_INSIDE; "BOUNDS_DIVIDED",BOUNDS_DIVIDED; "BOUNDS_IGNORE",BOUNDS_IGNORE; "BOUNDS_LINEAR",BOUNDS_LINEAR; "BOUNDS_LINEAR_0",BOUNDS_LINEAR_0; "BOUNDS_NOTZERO",BOUNDS_NOTZERO; "BROUWER",BROUWER; "BROUWER_ABSOLUTE_RETRACT",BROUWER_ABSOLUTE_RETRACT; "BROUWER_ABSOLUTE_RETRACT_GEN",BROUWER_ABSOLUTE_RETRACT_GEN; "BROUWER_AR",BROUWER_AR; "BROUWER_BALL",BROUWER_BALL; "BROUWER_CONTRACTIBLE_ANR",BROUWER_CONTRACTIBLE_ANR; "BROUWER_CUBE",BROUWER_CUBE; "BROUWER_DEGREE2_HOMOTOPY_INVARIANCE_LEMMA",BROUWER_DEGREE2_HOMOTOPY_INVARIANCE_LEMMA; "BROUWER_DEGREE3_LINEAR",BROUWER_DEGREE3_LINEAR; "BROUWER_DEGREE3_LINEAR_GEN",BROUWER_DEGREE3_LINEAR_GEN; "BROUWER_DEGREE3_PERTURB",BROUWER_DEGREE3_PERTURB; "BROUWER_DEGREE3_POINT_INDEPENDENCE",BROUWER_DEGREE3_POINT_INDEPENDENCE; "BROUWER_FACTOR_THROUGH_AR",BROUWER_FACTOR_THROUGH_AR; "BROUWER_INESSENTIAL_ANR",BROUWER_INESSENTIAL_ANR; "BROUWER_REDUCTION_THEOREM",BROUWER_REDUCTION_THEOREM; "BROUWER_REDUCTION_THEOREM_GEN",BROUWER_REDUCTION_THEOREM_GEN; "BROUWER_SURJECTIVE",BROUWER_SURJECTIVE; "BROUWER_SURJECTIVE_CBALL",BROUWER_SURJECTIVE_CBALL; "BROUWER_WEAK",BROUWER_WEAK; "BUTLAST",BUTLAST; "BUTLAST_APPEND",BUTLAST_APPEND; "CANTOR_BAIRE_STATIONARY_PRINCIPLE",CANTOR_BAIRE_STATIONARY_PRINCIPLE; "CANTOR_BENDIXSON",CANTOR_BENDIXSON; "CANTOR_BENDIXSON_GEN",CANTOR_BENDIXSON_GEN; "CANTOR_THM",CANTOR_THM; "CANTOR_THM_UNIV",CANTOR_THM_UNIV; "CARATHEODORY",CARATHEODORY; "CARATHEODORY_AFF_DIM",CARATHEODORY_AFF_DIM; "CARD",CARD; "CARD_ADD2_ABSORB_LE",CARD_ADD2_ABSORB_LE; "CARD_ADD2_ABSORB_LT",CARD_ADD2_ABSORB_LT; "CARD_ADD_ABSORB_LE",CARD_ADD_ABSORB_LE; "CARD_ADD_ABSORB_LEFT",CARD_ADD_ABSORB_LEFT; "CARD_ADD_ABSORB_RIGHT",CARD_ADD_ABSORB_RIGHT; "CARD_ADD_ASSOC",CARD_ADD_ASSOC; "CARD_ADD_C",CARD_ADD_C; "CARD_ADD_CONG",CARD_ADD_CONG; "CARD_ADD_FINITE",CARD_ADD_FINITE; "CARD_ADD_FINITE_EQ",CARD_ADD_FINITE_EQ; "CARD_ADD_LE_MUL_INFINITE",CARD_ADD_LE_MUL_INFINITE; "CARD_ADD_SYM",CARD_ADD_SYM; "CARD_ADD_SYMDIFF_INTER",CARD_ADD_SYMDIFF_INTER; "CARD_BOOL",CARD_BOOL; "CARD_CART",CARD_CART; "CARD_CART_UNIV",CARD_CART_UNIV; "CARD_CIRCLE_INTERSECTION_LE",CARD_CIRCLE_INTERSECTION_LE; "CARD_CLAUSES",CARD_CLAUSES; "CARD_COLUMNS_LE",CARD_COLUMNS_LE; "CARD_COMPONENTS_COMPLEMENT_CONVEX",CARD_COMPONENTS_COMPLEMENT_CONVEX; "CARD_COUNTABLE_CONG",CARD_COUNTABLE_CONG; "CARD_CROSS",CARD_CROSS; "CARD_DELETE",CARD_DELETE; "CARD_DIFF",CARD_DIFF; "CARD_DIFF_ABSORB",CARD_DIFF_ABSORB; "CARD_DIFF_INTER",CARD_DIFF_INTER; "CARD_DISJOINT_UNION",CARD_DISJOINT_UNION; "CARD_EMPTY_LE",CARD_EMPTY_LE; "CARD_EQ_0",CARD_EQ_0; "CARD_EQ_ANALYTIC_SETS",CARD_EQ_ANALYTIC_SETS; "CARD_EQ_ARC_IMAGE",CARD_EQ_ARC_IMAGE; "CARD_EQ_BAIRE_FUNCTIONS",CARD_EQ_BAIRE_FUNCTIONS; "CARD_EQ_BALL",CARD_EQ_BALL; "CARD_EQ_BIJECTION",CARD_EQ_BIJECTION; "CARD_EQ_BIJECTIONS",CARD_EQ_BIJECTIONS; "CARD_EQ_BOREL_MEASURABLE_FUNCTIONS",CARD_EQ_BOREL_MEASURABLE_FUNCTIONS; "CARD_EQ_BOREL_SETS",CARD_EQ_BOREL_SETS; "CARD_EQ_CARD",CARD_EQ_CARD; "CARD_EQ_CARD_IMP",CARD_EQ_CARD_IMP; "CARD_EQ_CART",CARD_EQ_CART; "CARD_EQ_CBALL",CARD_EQ_CBALL; "CARD_EQ_CLOSED",CARD_EQ_CLOSED; "CARD_EQ_CLOSED_SETS",CARD_EQ_CLOSED_SETS; "CARD_EQ_COMPACT_SETS",CARD_EQ_COMPACT_SETS; "CARD_EQ_CONDENSATION_POINTS",CARD_EQ_CONDENSATION_POINTS; "CARD_EQ_CONDENSATION_POINTS_IN_SET",CARD_EQ_CONDENSATION_POINTS_IN_SET; "CARD_EQ_CONG",CARD_EQ_CONG; "CARD_EQ_CONNECTED",CARD_EQ_CONNECTED; "CARD_EQ_CONVEX",CARD_EQ_CONVEX; "CARD_EQ_COUNTABLE",CARD_EQ_COUNTABLE; "CARD_EQ_COUNTABLE_SUBSETS_REAL",CARD_EQ_COUNTABLE_SUBSETS_REAL; "CARD_EQ_COUNTABLE_SUBSETS_SUBREAL",CARD_EQ_COUNTABLE_SUBSETS_SUBREAL; "CARD_EQ_COVERING_MAP_FIBRES",CARD_EQ_COVERING_MAP_FIBRES; "CARD_EQ_DIM",CARD_EQ_DIM; "CARD_EQ_EMPTY",CARD_EQ_EMPTY; "CARD_EQ_EUCLIDEAN",CARD_EQ_EUCLIDEAN; "CARD_EQ_FINITE",CARD_EQ_FINITE; "CARD_EQ_FINITE_SUBSETS",CARD_EQ_FINITE_SUBSETS; "CARD_EQ_FSIGMA_SETS",CARD_EQ_FSIGMA_SETS; "CARD_EQ_FULLSIZE_POWERSET",CARD_EQ_FULLSIZE_POWERSET; "CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS",CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS; "CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE",CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE; "CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT",CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT; "CARD_EQ_GDELTA_SETS",CARD_EQ_GDELTA_SETS; "CARD_EQ_IMAGE",CARD_EQ_IMAGE; "CARD_EQ_IMP_LE",CARD_EQ_IMP_LE; "CARD_EQ_INTEGER",CARD_EQ_INTEGER; "CARD_EQ_INTERVAL",CARD_EQ_INTERVAL; "CARD_EQ_LIMITED_POWERSET",CARD_EQ_LIMITED_POWERSET; "CARD_EQ_LIST",CARD_EQ_LIST; "CARD_EQ_LIST_GEN",CARD_EQ_LIST_GEN; "CARD_EQ_NONEMPTY_INTERIOR",CARD_EQ_NONEMPTY_INTERIOR; "CARD_EQ_NSUM",CARD_EQ_NSUM; "CARD_EQ_OPEN",CARD_EQ_OPEN; "CARD_EQ_OPEN_IN",CARD_EQ_OPEN_IN; "CARD_EQ_OPEN_IN_AFFINE",CARD_EQ_OPEN_IN_AFFINE; "CARD_EQ_OPEN_SETS",CARD_EQ_OPEN_SETS; "CARD_EQ_ORDINAL_EXISTS",CARD_EQ_ORDINAL_EXISTS; "CARD_EQ_PATH_CONNECTED",CARD_EQ_PATH_CONNECTED; "CARD_EQ_PCROSS",CARD_EQ_PCROSS; "CARD_EQ_PERFECT_SET",CARD_EQ_PERFECT_SET; "CARD_EQ_RATIONAL",CARD_EQ_RATIONAL; "CARD_EQ_REAL",CARD_EQ_REAL; "CARD_EQ_REAL_IMP_UNCOUNTABLE",CARD_EQ_REAL_IMP_UNCOUNTABLE; "CARD_EQ_REAL_SEQUENCES",CARD_EQ_REAL_SEQUENCES; "CARD_EQ_REFL",CARD_EQ_REFL; "CARD_EQ_REFL_IMP",CARD_EQ_REFL_IMP; "CARD_EQ_RESTRICTED_POWERSET",CARD_EQ_RESTRICTED_POWERSET; "CARD_EQ_SEGMENT",CARD_EQ_SEGMENT; "CARD_EQ_SIMPLE_PATH_IMAGE",CARD_EQ_SIMPLE_PATH_IMAGE; "CARD_EQ_SPHERE",CARD_EQ_SPHERE; "CARD_EQ_SUM",CARD_EQ_SUM; "CARD_EQ_SYM",CARD_EQ_SYM; "CARD_EQ_TRANS",CARD_EQ_TRANS; "CARD_EVEN_PERMUTATIONS",CARD_EVEN_PERMUTATIONS; "CARD_EXP_0",CARD_EXP_0; "CARD_EXP_ABSORB",CARD_EXP_ABSORB; "CARD_EXP_ADD",CARD_EXP_ADD; "CARD_EXP_C",CARD_EXP_C; "CARD_EXP_CANTOR",CARD_EXP_CANTOR; "CARD_EXP_CONG",CARD_EXP_CONG; "CARD_EXP_EQ_REAL",CARD_EXP_EQ_REAL; "CARD_EXP_FINITE",CARD_EXP_FINITE; "CARD_EXP_GRAPH",CARD_EXP_GRAPH; "CARD_EXP_GRAPH_PAIRED",CARD_EXP_GRAPH_PAIRED; "CARD_EXP_LE_REAL",CARD_EXP_LE_REAL; "CARD_EXP_MUL",CARD_EXP_MUL; "CARD_EXP_POWERSET",CARD_EXP_POWERSET; "CARD_EXP_SING",CARD_EXP_SING; "CARD_EXP_UNIV",CARD_EXP_UNIV; "CARD_EXP_ZERO",CARD_EXP_ZERO; "CARD_FACES_OF_SIMPLEX",CARD_FACES_OF_SIMPLEX; "CARD_FINITE_CONG",CARD_FINITE_CONG; "CARD_FINITE_IMAGE",CARD_FINITE_IMAGE; "CARD_FRONTIER_INTERVAL_1",CARD_FRONTIER_INTERVAL_1; "CARD_FUNSPACE",CARD_FUNSPACE; "CARD_FUNSPACE_CONG",CARD_FUNSPACE_CONG; "CARD_FUNSPACE_CURRY",CARD_FUNSPACE_CURRY; "CARD_FUNSPACE_LE",CARD_FUNSPACE_LE; "CARD_FUNSPACE_UNIV",CARD_FUNSPACE_UNIV; "CARD_GE_DIM_INDEPENDENT",CARD_GE_DIM_INDEPENDENT; "CARD_HAS_SIZE_CONG",CARD_HAS_SIZE_CONG; "CARD_IMAGE_EQ_INJ",CARD_IMAGE_EQ_INJ; "CARD_IMAGE_INJ",CARD_IMAGE_INJ; "CARD_IMAGE_INJ_EQ",CARD_IMAGE_INJ_EQ; "CARD_IMAGE_LE",CARD_IMAGE_LE; "CARD_INFINITE_CONG",CARD_INFINITE_CONG; "CARD_INTSEG_INT",CARD_INTSEG_INT; "CARD_LDISTRIB",CARD_LDISTRIB; "CARD_LET_TOTAL",CARD_LET_TOTAL; "CARD_LET_TRANS",CARD_LET_TRANS; "CARD_LE_ADD",CARD_LE_ADD; "CARD_LE_ADDL",CARD_LE_ADDL; "CARD_LE_ADDR",CARD_LE_ADDR; "CARD_LE_ANTISYM",CARD_LE_ANTISYM; "CARD_LE_CARD",CARD_LE_CARD; "CARD_LE_CARD_IMP",CARD_LE_CARD_IMP; "CARD_LE_COMPONENTS",CARD_LE_COMPONENTS; "CARD_LE_COMPONENTS_CLOSURE_FRONTIER",CARD_LE_COMPONENTS_CLOSURE_FRONTIER; "CARD_LE_COMPONENTS_FRONTIER",CARD_LE_COMPONENTS_FRONTIER; "CARD_LE_COMPONENTS_UNION",CARD_LE_COMPONENTS_UNION; "CARD_LE_CONG",CARD_LE_CONG; "CARD_LE_CONNECTED_COMPONENTS",CARD_LE_CONNECTED_COMPONENTS; "CARD_LE_COUNTABLE",CARD_LE_COUNTABLE; "CARD_LE_COUNTABLE_SUBSETS",CARD_LE_COUNTABLE_SUBSETS; "CARD_LE_DIM_SPANNING",CARD_LE_DIM_SPANNING; "CARD_LE_EMPTY",CARD_LE_EMPTY; "CARD_LE_EQ_SUBSET",CARD_LE_EQ_SUBSET; "CARD_LE_EXISTS",CARD_LE_EXISTS; "CARD_LE_EXP",CARD_LE_EXP; "CARD_LE_EXP_LEFT",CARD_LE_EXP_LEFT; "CARD_LE_EXP_RIGHT",CARD_LE_EXP_RIGHT; "CARD_LE_FINITE",CARD_LE_FINITE; "CARD_LE_FINITE_INFINITE",CARD_LE_FINITE_INFINITE; "CARD_LE_FINITE_SUBSETS",CARD_LE_FINITE_SUBSETS; "CARD_LE_IMAGE",CARD_LE_IMAGE; "CARD_LE_IMAGE_GEN",CARD_LE_IMAGE_GEN; "CARD_LE_INFINITE",CARD_LE_INFINITE; "CARD_LE_INJ",CARD_LE_INJ; "CARD_LE_LIST",CARD_LE_LIST; "CARD_LE_LT",CARD_LE_LT; "CARD_LE_MUL",CARD_LE_MUL; "CARD_LE_PATH_COMPONENTS",CARD_LE_PATH_COMPONENTS; "CARD_LE_POWERSET",CARD_LE_POWERSET; "CARD_LE_REFL",CARD_LE_REFL; "CARD_LE_RELATIONAL",CARD_LE_RELATIONAL; "CARD_LE_RELATIONAL_FULL",CARD_LE_RELATIONAL_FULL; "CARD_LE_RETRACT_COMPLEMENT_COMPONENTS",CARD_LE_RETRACT_COMPLEMENT_COMPONENTS; "CARD_LE_SQUARE",CARD_LE_SQUARE; "CARD_LE_SUBPOWERSET",CARD_LE_SUBPOWERSET; "CARD_LE_SUBSET",CARD_LE_SUBSET; "CARD_LE_TOTAL",CARD_LE_TOTAL; "CARD_LE_TRANS",CARD_LE_TRANS; "CARD_LE_UNIONS",CARD_LE_UNIONS; "CARD_LE_UNIONS2",CARD_LE_UNIONS2; "CARD_LE_UNIONS_CHAIN",CARD_LE_UNIONS_CHAIN; "CARD_LE_UNIV",CARD_LE_UNIV; "CARD_LTE_TOTAL",CARD_LTE_TOTAL; "CARD_LTE_TRANS",CARD_LTE_TRANS; "CARD_LT_ADD",CARD_LT_ADD; "CARD_LT_CARD",CARD_LT_CARD; "CARD_LT_CONG",CARD_LT_CONG; "CARD_LT_FINITE_INFINITE",CARD_LT_FINITE_INFINITE; "CARD_LT_IMP_DISCONNECTED",CARD_LT_IMP_DISCONNECTED; "CARD_LT_IMP_LE",CARD_LT_IMP_LE; "CARD_LT_IMP_SUC_LE",CARD_LT_IMP_SUC_LE; "CARD_LT_LE",CARD_LT_LE; "CARD_LT_REFL",CARD_LT_REFL; "CARD_LT_TOTAL",CARD_LT_TOTAL; "CARD_LT_TRANS",CARD_LT_TRANS; "CARD_MUL2_ABSORB_LE",CARD_MUL2_ABSORB_LE; "CARD_MUL_ABSORB",CARD_MUL_ABSORB; "CARD_MUL_ABSORB_LE",CARD_MUL_ABSORB_LE; "CARD_MUL_ASSOC",CARD_MUL_ASSOC; "CARD_MUL_C",CARD_MUL_C; "CARD_MUL_CONG",CARD_MUL_CONG; "CARD_MUL_EXP",CARD_MUL_EXP; "CARD_MUL_FINITE",CARD_MUL_FINITE; "CARD_MUL_FINITE_EQ",CARD_MUL_FINITE_EQ; "CARD_MUL_LT_INFINITE",CARD_MUL_LT_INFINITE; "CARD_MUL_LT_LEMMA",CARD_MUL_LT_LEMMA; "CARD_MUL_SYM",CARD_MUL_SYM; "CARD_NOT_LE",CARD_NOT_LE; "CARD_NOT_LT",CARD_NOT_LT; "CARD_NUMSEG",CARD_NUMSEG; "CARD_NUMSEG_1",CARD_NUMSEG_1; "CARD_NUMSEG_LE",CARD_NUMSEG_LE; "CARD_NUMSEG_LEMMA",CARD_NUMSEG_LEMMA; "CARD_NUMSEG_LT",CARD_NUMSEG_LT; "CARD_PERMUTATIONS",CARD_PERMUTATIONS; "CARD_POWERSET",CARD_POWERSET; "CARD_POWERSET_CONG",CARD_POWERSET_CONG; "CARD_PRODUCT",CARD_PRODUCT; "CARD_PSUBSET",CARD_PSUBSET; "CARD_RDISTRIB",CARD_RDISTRIB; "CARD_ROWS_LE",CARD_ROWS_LE; "CARD_SET_OF_LIST_LE",CARD_SET_OF_LIST_LE; "CARD_SING",CARD_SING; "CARD_SING_LE",CARD_SING_LE; "CARD_SQUARE_INFINITE",CARD_SQUARE_INFINITE; "CARD_SQUARE_NUM",CARD_SQUARE_NUM; "CARD_STDBASIS",CARD_STDBASIS; "CARD_SUBSET",CARD_SUBSET; "CARD_SUBSET_EQ",CARD_SUBSET_EQ; "CARD_SUBSET_IMAGE",CARD_SUBSET_IMAGE; "CARD_SUBSET_LE",CARD_SUBSET_LE; "CARD_SUSLIN_EQ",CARD_SUSLIN_EQ; "CARD_SUSLIN_LE",CARD_SUSLIN_LE; "CARD_UNION",CARD_UNION; "CARD_UNIONS",CARD_UNIONS; "CARD_UNIONS_LE",CARD_UNIONS_LE; "CARD_UNION_ABSORB_LEFT",CARD_UNION_ABSORB_LEFT; "CARD_UNION_ABSORB_RIGHT",CARD_UNION_ABSORB_RIGHT; "CARD_UNION_EQ",CARD_UNION_EQ; "CARD_UNION_GEN",CARD_UNION_GEN; "CARD_UNION_LE",CARD_UNION_LE; "CARD_UNION_LEMMA",CARD_UNION_LEMMA; "CARD_UNION_OVERLAP",CARD_UNION_OVERLAP; "CARD_UNION_OVERLAP_EQ",CARD_UNION_OVERLAP_EQ; "CART_EQ",CART_EQ; "CART_EQ_FULL",CART_EQ_FULL; "CASEWISE",CASEWISE; "CASEWISE_CASES",CASEWISE_CASES; "CASEWISE_DEF",CASEWISE_DEF; "CASEWISE_WORKS",CASEWISE_WORKS; "CAUCHY",CAUCHY; "CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE",CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE; "CAUCHY_CONTINUOUS_EQ_EXTENDS_TO_CLOSURE",CAUCHY_CONTINUOUS_EQ_EXTENDS_TO_CLOSURE; "CAUCHY_CONTINUOUS_EXTENDS_TO_CAUCHY_CONTINUOUS_CLOSURE",CAUCHY_CONTINUOUS_EXTENDS_TO_CAUCHY_CONTINUOUS_CLOSURE; "CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE",CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE; "CAUCHY_CONTINUOUS_IMP_CONTINUOUS",CAUCHY_CONTINUOUS_IMP_CONTINUOUS; "CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA",CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA; "CAUCHY_CONVERGENT_SUBSEQUENCE",CAUCHY_CONVERGENT_SUBSEQUENCE; "CAUCHY_EQ_SUMMABLE",CAUCHY_EQ_SUMMABLE; "CAUCHY_IMP_BOUNDED",CAUCHY_IMP_BOUNDED; "CAUCHY_IN_EQ_CAUCHY",CAUCHY_IN_EQ_CAUCHY; "CAUCHY_ISOMETRIC",CAUCHY_ISOMETRIC; "CAUCHY_OFFSET",CAUCHY_OFFSET; "CAUCHY_SUBSEQUENCE",CAUCHY_SUBSEQUENCE; "CBALL_DIFF_BALL",CBALL_DIFF_BALL; "CBALL_DIFF_SPHERE",CBALL_DIFF_SPHERE; "CBALL_EMPTY",CBALL_EMPTY; "CBALL_EQ_EMPTY",CBALL_EQ_EMPTY; "CBALL_EQ_SING",CBALL_EQ_SING; "CBALL_INTERVAL",CBALL_INTERVAL; "CBALL_INTERVAL_0",CBALL_INTERVAL_0; "CBALL_LINEAR_IMAGE",CBALL_LINEAR_IMAGE; "CBALL_MAX_UNION",CBALL_MAX_UNION; "CBALL_MIN_INTER",CBALL_MIN_INTER; "CBALL_SCALING",CBALL_SCALING; "CBALL_SING",CBALL_SING; "CBALL_TRANSLATION",CBALL_TRANSLATION; "CBALL_TRIVIAL",CBALL_TRIVIAL; "CELL_COMPLEX_DISJOINT_RELATIVE_INTERIORS",CELL_COMPLEX_DISJOINT_RELATIVE_INTERIORS; "CELL_COMPLEX_SUBDIVISION_EXISTS",CELL_COMPLEX_SUBDIVISION_EXISTS; "CENTRE_IN_BALL",CENTRE_IN_BALL; "CENTRE_IN_CBALL",CENTRE_IN_CBALL; "CENTRE_IN_MBALL",CENTRE_IN_MBALL; "CENTRE_IN_MBALL_EQ",CENTRE_IN_MBALL_EQ; "CENTRE_IN_MCBALL",CENTRE_IN_MCBALL; "CENTRE_IN_MCBALL_EQ",CENTRE_IN_MCBALL_EQ; "CFUNSPACE",CFUNSPACE; "CFUNSPACE_IMP_BOUNDED2",CFUNSPACE_IMP_BOUNDED2; "CFUNSPACE_MDIST_LE",CFUNSPACE_MDIST_LE; "CFUNSPACE_MDIST_LT",CFUNSPACE_MDIST_LT; "CFUNSPACE_SUBSET_FUNSPACE",CFUNSPACE_SUBSET_FUNSPACE; "CHAIN_SUBSET",CHAIN_SUBSET; "CHARACTERISTIC_POLYNOMIAL",CHARACTERISTIC_POLYNOMIAL; "CHOICE",CHOICE; "CHOICE_DEF",CHOICE_DEF; "CHOICE_PAIRED_THM",CHOICE_PAIRED_THM; "CHOICE_UNPAIR_THM",CHOICE_UNPAIR_THM; "CHOOSE_AFFINE_SUBSET",CHOOSE_AFFINE_SUBSET; "CHOOSE_LARGE_COMPACT_SUBSET",CHOOSE_LARGE_COMPACT_SUBSET; "CHOOSE_LARGE_MEASURABLE_SUBSET",CHOOSE_LARGE_MEASURABLE_SUBSET; "CHOOSE_POLYTOPE",CHOOSE_POLYTOPE; "CHOOSE_SIMPLEX",CHOOSE_SIMPLEX; "CHOOSE_SUBSET",CHOOSE_SUBSET; "CHOOSE_SUBSET_BETWEEN",CHOOSE_SUBSET_BETWEEN; "CHOOSE_SUBSET_EQ",CHOOSE_SUBSET_EQ; "CHOOSE_SUBSET_STRONG",CHOOSE_SUBSET_STRONG; "CHOOSE_SUBSPACE_OF_SUBSPACE",CHOOSE_SUBSPACE_OF_SUBSPACE; "CHOOSE_SURROUNDING_SIMPLEX",CHOOSE_SURROUNDING_SIMPLEX; "CHOOSE_SURROUNDING_SIMPLEX_FULL",CHOOSE_SURROUNDING_SIMPLEX_FULL; "CLOPEN",CLOPEN; "CLOPEN_IN_COMPONENTS",CLOPEN_IN_COMPONENTS; "CLOPEN_IN_EQ_FRONTIER_OF",CLOPEN_IN_EQ_FRONTIER_OF; "CLOPEN_UNIONS_COMPONENTS",CLOPEN_UNIONS_COMPONENTS; "CLOSED_AFFINE",CLOSED_AFFINE; "CLOSED_AFFINE_HULL",CLOSED_AFFINE_HULL; "CLOSED_AFFINITY",CLOSED_AFFINITY; "CLOSED_AFFINITY_EQ",CLOSED_AFFINITY_EQ; "CLOSED_APPROACHABLE",CLOSED_APPROACHABLE; "CLOSED_ARC_IMAGE",CLOSED_ARC_IMAGE; "CLOSED_AS_FRONTIER",CLOSED_AS_FRONTIER; "CLOSED_AS_FRONTIER_OF_SUBSET",CLOSED_AS_FRONTIER_OF_SUBSET; "CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE",CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE; "CLOSED_CBALL",CLOSED_CBALL; "CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON",CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON; "CLOSED_CLOSURE",CLOSED_CLOSURE; "CLOSED_COMPACT_DIFFERENCES",CLOSED_COMPACT_DIFFERENCES; "CLOSED_COMPACT_IN",CLOSED_COMPACT_IN; "CLOSED_COMPACT_PROJECTION",CLOSED_COMPACT_PROJECTION; "CLOSED_COMPACT_SUMS",CLOSED_COMPACT_SUMS; "CLOSED_COMPONENTS",CLOSED_COMPONENTS; "CLOSED_CONDENSATION_POINTS",CLOSED_CONDENSATION_POINTS; "CLOSED_CONIC_HULL",CLOSED_CONIC_HULL; "CLOSED_CONIC_HULL_STRONG",CLOSED_CONIC_HULL_STRONG; "CLOSED_CONIC_HULL_VERTEX_IMAGE",CLOSED_CONIC_HULL_VERTEX_IMAGE; "CLOSED_CONNECTED_COMPONENT",CLOSED_CONNECTED_COMPONENT; "CLOSED_CONNECTED_PREIMAGES_IMP_CONTINUOUS_ON",CLOSED_CONNECTED_PREIMAGES_IMP_CONTINUOUS_ON; "CLOSED_CONTAINS_SEQUENTIAL_LIMIT",CLOSED_CONTAINS_SEQUENTIAL_LIMIT; "CLOSED_CONVEX_CONE_HULL",CLOSED_CONVEX_CONE_HULL; "CLOSED_CONVEX_CONE_HULL_STRONG",CLOSED_CONVEX_CONE_HULL_STRONG; "CLOSED_DIFF",CLOSED_DIFF; "CLOSED_DIFF_OPEN_INTERVAL_1",CLOSED_DIFF_OPEN_INTERVAL_1; "CLOSED_EMPTY",CLOSED_EMPTY; "CLOSED_EQ_CONTINUOUS_LEVELSET",CLOSED_EQ_CONTINUOUS_LEVELSET; "CLOSED_EXTREME_POINTS_2D",CLOSED_EXTREME_POINTS_2D; "CLOSED_FIP",CLOSED_FIP; "CLOSED_FORALL",CLOSED_FORALL; "CLOSED_FORALL_IN",CLOSED_FORALL_IN; "CLOSED_HALFSPACE_COMPONENT_GE",CLOSED_HALFSPACE_COMPONENT_GE; "CLOSED_HALFSPACE_COMPONENT_LE",CLOSED_HALFSPACE_COMPONENT_LE; "CLOSED_HALFSPACE_GE",CLOSED_HALFSPACE_GE; "CLOSED_HALFSPACE_LE",CLOSED_HALFSPACE_LE; "CLOSED_HYPERPLANE",CLOSED_HYPERPLANE; "CLOSED_IMP_ANALYTIC",CLOSED_IMP_ANALYTIC; "CLOSED_IMP_BAIRE1_INDICATOR",CLOSED_IMP_BAIRE1_INDICATOR; "CLOSED_IMP_BOREL",CLOSED_IMP_BOREL; "CLOSED_IMP_FIP",CLOSED_IMP_FIP; "CLOSED_IMP_FIP_COMPACT",CLOSED_IMP_FIP_COMPACT; "CLOSED_IMP_FSIGMA",CLOSED_IMP_FSIGMA; "CLOSED_IMP_GDELTA",CLOSED_IMP_GDELTA; "CLOSED_IMP_LOCALLY_COMPACT",CLOSED_IMP_LOCALLY_COMPACT; "CLOSED_IN",CLOSED_IN; "CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE; "CLOSED_INJECTIVE_IMAGE_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSPACE; "CLOSED_INJECTIVE_LINEAR_IMAGE",CLOSED_INJECTIVE_LINEAR_IMAGE; "CLOSED_INJECTIVE_LINEAR_IMAGE_EQ",CLOSED_INJECTIVE_LINEAR_IMAGE_EQ; "CLOSED_INSERT",CLOSED_INSERT; "CLOSED_INTER",CLOSED_INTER; "CLOSED_INTERS",CLOSED_INTERS; "CLOSED_INTERS_COMPACT",CLOSED_INTERS_COMPACT; "CLOSED_INTERVAL",CLOSED_INTERVAL; "CLOSED_INTERVAL_AS_CONVEX_HULL",CLOSED_INTERVAL_AS_CONVEX_HULL; "CLOSED_INTERVAL_DROPOUT",CLOSED_INTERVAL_DROPOUT; "CLOSED_INTERVAL_EQ",CLOSED_INTERVAL_EQ; "CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL",CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL; "CLOSED_INTERVAL_LEFT",CLOSED_INTERVAL_LEFT; "CLOSED_INTERVAL_RIGHT",CLOSED_INTERVAL_RIGHT; "CLOSED_INTER_COMPACT",CLOSED_INTER_COMPACT; "CLOSED_IN_ANALYTIC",CLOSED_IN_ANALYTIC; "CLOSED_IN_BOREL",CLOSED_IN_BOREL; "CLOSED_IN_CLOSED",CLOSED_IN_CLOSED; "CLOSED_IN_CLOSED_EQ",CLOSED_IN_CLOSED_EQ; "CLOSED_IN_CLOSED_INTER",CLOSED_IN_CLOSED_INTER; "CLOSED_IN_CLOSED_TRANS",CLOSED_IN_CLOSED_TRANS; "CLOSED_IN_CLOSURE_OF",CLOSED_IN_CLOSURE_OF; "CLOSED_IN_COMPACT",CLOSED_IN_COMPACT; "CLOSED_IN_COMPACT_EQ",CLOSED_IN_COMPACT_EQ; "CLOSED_IN_COMPACT_PROJECTION",CLOSED_IN_COMPACT_PROJECTION; "CLOSED_IN_COMPONENT",CLOSED_IN_COMPONENT; "CLOSED_IN_CONIC_HULL",CLOSED_IN_CONIC_HULL; "CLOSED_IN_CONNECTED_COMPONENT",CLOSED_IN_CONNECTED_COMPONENT; "CLOSED_IN_CONTAINS_DERIVED_SET",CLOSED_IN_CONTAINS_DERIVED_SET; "CLOSED_IN_DIFF",CLOSED_IN_DIFF; "CLOSED_IN_DIFF_OPEN",CLOSED_IN_DIFF_OPEN; "CLOSED_IN_EMPTY",CLOSED_IN_EMPTY; "CLOSED_IN_EQ_CONTINUOUS_LEVELSET",CLOSED_IN_EQ_CONTINUOUS_LEVELSET; "CLOSED_IN_EUCLIDEAN",CLOSED_IN_EUCLIDEAN; "CLOSED_IN_FRONTIER_OF",CLOSED_IN_FRONTIER_OF; "CLOSED_IN_FSIGMA",CLOSED_IN_FSIGMA; "CLOSED_IN_GDELTA",CLOSED_IN_GDELTA; "CLOSED_IN_IMP_SUBSET",CLOSED_IN_IMP_SUBSET; "CLOSED_IN_INJECTIVE_LINEAR_IMAGE",CLOSED_IN_INJECTIVE_LINEAR_IMAGE; "CLOSED_IN_INSERT",CLOSED_IN_INSERT; "CLOSED_IN_INTER",CLOSED_IN_INTER; "CLOSED_IN_INTERS",CLOSED_IN_INTERS; "CLOSED_IN_INTER_CLOSED",CLOSED_IN_INTER_CLOSED; "CLOSED_IN_INTER_CLOSURE",CLOSED_IN_INTER_CLOSURE; "CLOSED_IN_LIMPT",CLOSED_IN_LIMPT; "CLOSED_IN_LOCALLY_FINITE_UNIONS",CLOSED_IN_LOCALLY_FINITE_UNIONS; "CLOSED_IN_MCBALL",CLOSED_IN_MCBALL; "CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE",CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE; "CLOSED_IN_METRIC",CLOSED_IN_METRIC; "CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; "CLOSED_IN_PCROSS",CLOSED_IN_PCROSS; "CLOSED_IN_PCROSS_EQ",CLOSED_IN_PCROSS_EQ; "CLOSED_IN_REFL",CLOSED_IN_REFL; "CLOSED_IN_RELATIVE_TO",CLOSED_IN_RELATIVE_TO; "CLOSED_IN_RETRACT",CLOSED_IN_RETRACT; "CLOSED_IN_SEPARATED_UNION",CLOSED_IN_SEPARATED_UNION; "CLOSED_IN_SEQUENTIAL_LIMITS",CLOSED_IN_SEQUENTIAL_LIMITS; "CLOSED_IN_SING",CLOSED_IN_SING; "CLOSED_IN_SUBSET",CLOSED_IN_SUBSET; "CLOSED_IN_SUBSET_TRANS",CLOSED_IN_SUBSET_TRANS; "CLOSED_IN_SUBTOPOLOGY",CLOSED_IN_SUBTOPOLOGY; "CLOSED_IN_SUBTOPOLOGY_EMPTY",CLOSED_IN_SUBTOPOLOGY_EMPTY; "CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET",CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET; "CLOSED_IN_SUBTOPOLOGY_REFL",CLOSED_IN_SUBTOPOLOGY_REFL; "CLOSED_IN_SUBTOPOLOGY_UNION",CLOSED_IN_SUBTOPOLOGY_UNION; "CLOSED_IN_TOPSPACE",CLOSED_IN_TOPSPACE; "CLOSED_IN_TRANS",CLOSED_IN_TRANS; "CLOSED_IN_TRANSLATION_EQ",CLOSED_IN_TRANSLATION_EQ; "CLOSED_IN_TRANS_EQ",CLOSED_IN_TRANS_EQ; "CLOSED_IN_UNION",CLOSED_IN_UNION; "CLOSED_IN_UNIONS",CLOSED_IN_UNIONS; "CLOSED_IN_UNION_COMPLEMENT_COMPONENT",CLOSED_IN_UNION_COMPLEMENT_COMPONENT; "CLOSED_IN_UNION_COMPLEMENT_COMPONENTS",CLOSED_IN_UNION_COMPLEMENT_COMPONENTS; "CLOSED_IRREDUCIBLE_SEPARATOR",CLOSED_IRREDUCIBLE_SEPARATOR; "CLOSED_LIFT",CLOSED_LIFT; "CLOSED_LIMPT",CLOSED_LIMPT; "CLOSED_LIMPTS",CLOSED_LIMPTS; "CLOSED_LOCALLY_FINITE_UNIONS",CLOSED_LOCALLY_FINITE_UNIONS; "CLOSED_LOCAL_HOMEOMORPHISM_GLOBAL",CLOSED_LOCAL_HOMEOMORPHISM_GLOBAL; "CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP",CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP; "CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER",CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER; "CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN",CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN; "CLOSED_MAP_CLOSURES",CLOSED_MAP_CLOSURES; "CLOSED_MAP_FROM_COMPOSITION_INJECTIVE",CLOSED_MAP_FROM_COMPOSITION_INJECTIVE; "CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE",CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE; "CLOSED_MAP_FSTCART",CLOSED_MAP_FSTCART; "CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE",CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE; "CLOSED_MAP_IMP_OPEN_MAP",CLOSED_MAP_IMP_OPEN_MAP; "CLOSED_MAP_IMP_QUOTIENT_MAP",CLOSED_MAP_IMP_QUOTIENT_MAP; "CLOSED_MAP_NORM",CLOSED_MAP_NORM; "CLOSED_MAP_OPEN_SUPERSET_PREIMAGE",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE; "CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ; "CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT; "CLOSED_MAP_RESTRICT",CLOSED_MAP_RESTRICT; "CLOSED_MAP_SNDCART",CLOSED_MAP_SNDCART; "CLOSED_NEGATIONS",CLOSED_NEGATIONS; "CLOSED_OPEN_INTERVAL_1",CLOSED_OPEN_INTERVAL_1; "CLOSED_PATH_IMAGE",CLOSED_PATH_IMAGE; "CLOSED_PCROSS",CLOSED_PCROSS; "CLOSED_PCROSS_EQ",CLOSED_PCROSS_EQ; "CLOSED_POSITIVE_ORTHANT",CLOSED_POSITIVE_ORTHANT; "CLOSED_RELATIVE_BOUNDARY",CLOSED_RELATIVE_BOUNDARY; "CLOSED_RELATIVE_FRONTIER",CLOSED_RELATIVE_FRONTIER; "CLOSED_RELATIVE_TO",CLOSED_RELATIVE_TO; "CLOSED_SCALING",CLOSED_SCALING; "CLOSED_SCALING_EQ",CLOSED_SCALING_EQ; "CLOSED_SEGMENT",CLOSED_SEGMENT; "CLOSED_SEGMENT_DESCALE",CLOSED_SEGMENT_DESCALE; "CLOSED_SEGMENT_LINEAR_IMAGE",CLOSED_SEGMENT_LINEAR_IMAGE; "CLOSED_SEQUENTIAL_LIMITS",CLOSED_SEQUENTIAL_LIMITS; "CLOSED_SHIFTPATH",CLOSED_SHIFTPATH; "CLOSED_SIMPLEX",CLOSED_SIMPLEX; "CLOSED_SIMPLE_PATH_IMAGE",CLOSED_SIMPLE_PATH_IMAGE; "CLOSED_SING",CLOSED_SING; "CLOSED_SPAN",CLOSED_SPAN; "CLOSED_SPHERE",CLOSED_SPHERE; "CLOSED_STANDARD_HYPERPLANE",CLOSED_STANDARD_HYPERPLANE; "CLOSED_STRIP_COMPONENT_LE",CLOSED_STRIP_COMPONENT_LE; "CLOSED_SUBSET",CLOSED_SUBSET; "CLOSED_SUBSET_EQ",CLOSED_SUBSET_EQ; "CLOSED_SUBSPACE",CLOSED_SUBSPACE; "CLOSED_SUBSTANDARD",CLOSED_SUBSTANDARD; "CLOSED_TRANSLATION",CLOSED_TRANSLATION; "CLOSED_TRANSLATION_EQ",CLOSED_TRANSLATION_EQ; "CLOSED_UNION",CLOSED_UNION; "CLOSED_UNIONS",CLOSED_UNIONS; "CLOSED_UNIONS_COMPONENTS_MEETING_CLOSED",CLOSED_UNIONS_COMPONENTS_MEETING_CLOSED; "CLOSED_UNION_COMPACT_SUBSETS",CLOSED_UNION_COMPACT_SUBSETS; "CLOSED_UNION_COMPLEMENT_COMPONENT",CLOSED_UNION_COMPLEMENT_COMPONENT; "CLOSED_UNION_COMPLEMENT_COMPONENTS",CLOSED_UNION_COMPLEMENT_COMPONENTS; "CLOSED_UNIV",CLOSED_UNIV; "CLOSED_WITH_INSIDE",CLOSED_WITH_INSIDE; "CLOSER_POINTS_LEMMA",CLOSER_POINTS_LEMMA; "CLOSER_POINT_LEMMA",CLOSER_POINT_LEMMA; "CLOSEST_POINT_AFFINE_ORTHOGONAL",CLOSEST_POINT_AFFINE_ORTHOGONAL; "CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ",CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ; "CLOSEST_POINT_DOT",CLOSEST_POINT_DOT; "CLOSEST_POINT_EXISTS",CLOSEST_POINT_EXISTS; "CLOSEST_POINT_FRONTIER",CLOSEST_POINT_FRONTIER; "CLOSEST_POINT_IDEMPOTENT",CLOSEST_POINT_IDEMPOTENT; "CLOSEST_POINT_IN_FRONTIER",CLOSEST_POINT_IN_FRONTIER; "CLOSEST_POINT_IN_INTERIOR",CLOSEST_POINT_IN_INTERIOR; "CLOSEST_POINT_IN_RELATIVE_FRONTIER",CLOSEST_POINT_IN_RELATIVE_FRONTIER; "CLOSEST_POINT_IN_RELATIVE_INTERIOR",CLOSEST_POINT_IN_RELATIVE_INTERIOR; "CLOSEST_POINT_IN_SET",CLOSEST_POINT_IN_SET; "CLOSEST_POINT_LE",CLOSEST_POINT_LE; "CLOSEST_POINT_LIPSCHITZ",CLOSEST_POINT_LIPSCHITZ; "CLOSEST_POINT_LT",CLOSEST_POINT_LT; "CLOSEST_POINT_REFL",CLOSEST_POINT_REFL; "CLOSEST_POINT_SELF",CLOSEST_POINT_SELF; "CLOSEST_POINT_SUBSPACE_ORTHOGONAL",CLOSEST_POINT_SUBSPACE_ORTHOGONAL; "CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ",CLOSEST_POINT_SUBSPACE_ORTHOGONAL_EQ; "CLOSEST_POINT_TRANSLATION",CLOSEST_POINT_TRANSLATION; "CLOSEST_POINT_UNIQUE",CLOSEST_POINT_UNIQUE; "CLOSURE_AFFINITY",CLOSURE_AFFINITY; "CLOSURE_APPROACHABLE",CLOSURE_APPROACHABLE; "CLOSURE_BALL",CLOSURE_BALL; "CLOSURE_BOUNDED_LINEAR_IMAGE",CLOSURE_BOUNDED_LINEAR_IMAGE; "CLOSURE_CBALL",CLOSURE_CBALL; "CLOSURE_CLOSED",CLOSURE_CLOSED; "CLOSURE_CLOSURE",CLOSURE_CLOSURE; "CLOSURE_COCOUNTABLE_COORDINATES",CLOSURE_COCOUNTABLE_COORDINATES; "CLOSURE_COMPLEMENT",CLOSURE_COMPLEMENT; "CLOSURE_CONIC_HULL",CLOSURE_CONIC_HULL; "CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS",CLOSURE_CONIC_HULL_VERTEX_IMAGE_NONFRONTIERS; "CLOSURE_CONVEX_HULL",CLOSURE_CONVEX_HULL; "CLOSURE_CONVEX_INTER_AFFINE",CLOSURE_CONVEX_INTER_AFFINE; "CLOSURE_CONVEX_INTER_SUPERSET",CLOSURE_CONVEX_INTER_SUPERSET; "CLOSURE_COSMALL_COORDINATES",CLOSURE_COSMALL_COORDINATES; "CLOSURE_DELETE",CLOSURE_DELETE; "CLOSURE_DYADIC_RATIONALS",CLOSURE_DYADIC_RATIONALS; "CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET",CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; "CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET",CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET; "CLOSURE_EMPTY",CLOSURE_EMPTY; "CLOSURE_EQ",CLOSURE_EQ; "CLOSURE_EQ_EMPTY",CLOSURE_EQ_EMPTY; "CLOSURE_HALFSPACE_COMPONENT_GT",CLOSURE_HALFSPACE_COMPONENT_GT; "CLOSURE_HALFSPACE_COMPONENT_LT",CLOSURE_HALFSPACE_COMPONENT_LT; "CLOSURE_HALFSPACE_GT",CLOSURE_HALFSPACE_GT; "CLOSURE_HALFSPACE_LT",CLOSURE_HALFSPACE_LT; "CLOSURE_HULL",CLOSURE_HULL; "CLOSURE_HYPERPLANE",CLOSURE_HYPERPLANE; "CLOSURE_IMAGE_BOUNDED",CLOSURE_IMAGE_BOUNDED; "CLOSURE_IMAGE_CLOSURE",CLOSURE_IMAGE_CLOSURE; "CLOSURE_INC",CLOSURE_INC; "CLOSURE_INJECTIVE_LINEAR_IMAGE",CLOSURE_INJECTIVE_LINEAR_IMAGE; "CLOSURE_INSERT",CLOSURE_INSERT; "CLOSURE_INSIDE_SUBSET",CLOSURE_INSIDE_SUBSET; "CLOSURE_INTERIOR",CLOSURE_INTERIOR; "CLOSURE_INTERIOR_IDEMP",CLOSURE_INTERIOR_IDEMP; "CLOSURE_INTERIOR_UNION_CLOSED",CLOSURE_INTERIOR_UNION_CLOSED; "CLOSURE_INTERS_CONVEX",CLOSURE_INTERS_CONVEX; "CLOSURE_INTERS_CONVEX_OPEN",CLOSURE_INTERS_CONVEX_OPEN; "CLOSURE_INTERS_SUBSET",CLOSURE_INTERS_SUBSET; "CLOSURE_INTERVAL",CLOSURE_INTERVAL; "CLOSURE_INTER_CONVEX",CLOSURE_INTER_CONVEX; "CLOSURE_INTER_CONVEX_OPEN",CLOSURE_INTER_CONVEX_OPEN; "CLOSURE_INTER_SUBSET",CLOSURE_INTER_SUBSET; "CLOSURE_IRRATIONAL_COORDINATES",CLOSURE_IRRATIONAL_COORDINATES; "CLOSURE_LINEAR_IMAGE_SUBSET",CLOSURE_LINEAR_IMAGE_SUBSET; "CLOSURE_LOCALLY_FINITE_UNIONS",CLOSURE_LOCALLY_FINITE_UNIONS; "CLOSURE_MINIMAL",CLOSURE_MINIMAL; "CLOSURE_MINIMAL_EQ",CLOSURE_MINIMAL_EQ; "CLOSURE_MINIMAL_LOCAL",CLOSURE_MINIMAL_LOCAL; "CLOSURE_NEGATIONS",CLOSURE_NEGATIONS; "CLOSURE_NONEMPTY_OPEN_INTER",CLOSURE_NONEMPTY_OPEN_INTER; "CLOSURE_OF",CLOSURE_OF; "CLOSURE_OF_ALT",CLOSURE_OF_ALT; "CLOSURE_OF_CLOSED_IN",CLOSURE_OF_CLOSED_IN; "CLOSURE_OF_CLOSURE_OF",CLOSURE_OF_CLOSURE_OF; "CLOSURE_OF_COMPLEMENT",CLOSURE_OF_COMPLEMENT; "CLOSURE_OF_EMPTY",CLOSURE_OF_EMPTY; "CLOSURE_OF_EQ",CLOSURE_OF_EQ; "CLOSURE_OF_EQ_EMPTY_GEN",CLOSURE_OF_EQ_EMPTY_GEN; "CLOSURE_OF_EQ_UNIV",CLOSURE_OF_EQ_UNIV; "CLOSURE_OF_HULL",CLOSURE_OF_HULL; "CLOSURE_OF_INJECTIVE_LINEAR_IMAGE",CLOSURE_OF_INJECTIVE_LINEAR_IMAGE; "CLOSURE_OF_INTERIOR_OF",CLOSURE_OF_INTERIOR_OF; "CLOSURE_OF_INTERIOR_OF_IDEMP",CLOSURE_OF_INTERIOR_OF_IDEMP; "CLOSURE_OF_MINIMAL",CLOSURE_OF_MINIMAL; "CLOSURE_OF_MINIMAL_EQ",CLOSURE_OF_MINIMAL_EQ; "CLOSURE_OF_MONO",CLOSURE_OF_MONO; "CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF",CLOSURE_OF_OPEN_IN_INTER_CLOSURE_OF; "CLOSURE_OF_OPEN_IN_INTER_SUPERSET",CLOSURE_OF_OPEN_IN_INTER_SUPERSET; "CLOSURE_OF_OPEN_IN_SUBTOPOLOGY_INTER_CLOSURE_OF",CLOSURE_OF_OPEN_IN_SUBTOPOLOGY_INTER_CLOSURE_OF; "CLOSURE_OF_RESTRICT",CLOSURE_OF_RESTRICT; "CLOSURE_OF_SUBSET",CLOSURE_OF_SUBSET; "CLOSURE_OF_SUBSET_EQ",CLOSURE_OF_SUBSET_EQ; "CLOSURE_OF_SUBSET_INTER",CLOSURE_OF_SUBSET_INTER; "CLOSURE_OF_SUBSET_SUBTOPOLOGY",CLOSURE_OF_SUBSET_SUBTOPOLOGY; "CLOSURE_OF_SUBSET_TOPSPACE",CLOSURE_OF_SUBSET_TOPSPACE; "CLOSURE_OF_SUBTOPOLOGY",CLOSURE_OF_SUBTOPOLOGY; "CLOSURE_OF_SUBTOPOLOGY_MONO",CLOSURE_OF_SUBTOPOLOGY_MONO; "CLOSURE_OF_SUBTOPOLOGY_OPEN",CLOSURE_OF_SUBTOPOLOGY_OPEN; "CLOSURE_OF_SUBTOPOLOGY_SUBSET",CLOSURE_OF_SUBTOPOLOGY_SUBSET; "CLOSURE_OF_TOPSPACE",CLOSURE_OF_TOPSPACE; "CLOSURE_OF_TRANSLATION",CLOSURE_OF_TRANSLATION; "CLOSURE_OF_UNION",CLOSURE_OF_UNION; "CLOSURE_OF_UNIONS",CLOSURE_OF_UNIONS; "CLOSURE_OF_UNIQUE",CLOSURE_OF_UNIQUE; "CLOSURE_OF_UNIV",CLOSURE_OF_UNIV; "CLOSURE_OPEN_INTERVAL",CLOSURE_OPEN_INTERVAL; "CLOSURE_OPEN_INTER_CLOSURE",CLOSURE_OPEN_INTER_CLOSURE; "CLOSURE_OPEN_INTER_SUPERSET",CLOSURE_OPEN_INTER_SUPERSET; "CLOSURE_OPEN_IN_INTER_CLOSURE",CLOSURE_OPEN_IN_INTER_CLOSURE; "CLOSURE_OUTSIDE_SUBSET",CLOSURE_OUTSIDE_SUBSET; "CLOSURE_PCROSS",CLOSURE_PCROSS; "CLOSURE_RATIONALS_IN_CONVEX_SET",CLOSURE_RATIONALS_IN_CONVEX_SET; "CLOSURE_RATIONALS_IN_OPEN_SET",CLOSURE_RATIONALS_IN_OPEN_SET; "CLOSURE_RATIONAL_COORDINATES",CLOSURE_RATIONAL_COORDINATES; "CLOSURE_SCALING",CLOSURE_SCALING; "CLOSURE_SEGMENT",CLOSURE_SEGMENT; "CLOSURE_SEQUENTIAL",CLOSURE_SEQUENTIAL; "CLOSURE_SING",CLOSURE_SING; "CLOSURE_SPHERE",CLOSURE_SPHERE; "CLOSURE_STRIP_COMPONENT_LT",CLOSURE_STRIP_COMPONENT_LT; "CLOSURE_SUBSET",CLOSURE_SUBSET; "CLOSURE_SUBSET_AFFINE_HULL",CLOSURE_SUBSET_AFFINE_HULL; "CLOSURE_SUBSET_EQ",CLOSURE_SUBSET_EQ; "CLOSURE_SUBSET_SPAN",CLOSURE_SUBSET_SPAN; "CLOSURE_SUMS",CLOSURE_SUMS; "CLOSURE_SURJECTIVE_LINEAR_IMAGE",CLOSURE_SURJECTIVE_LINEAR_IMAGE; "CLOSURE_TRANSLATION",CLOSURE_TRANSLATION; "CLOSURE_UNION",CLOSURE_UNION; "CLOSURE_UNIONS",CLOSURE_UNIONS; "CLOSURE_UNIONS_SUBSET",CLOSURE_UNIONS_SUBSET; "CLOSURE_UNION_FRONTIER",CLOSURE_UNION_FRONTIER; "CLOSURE_UNIQUE",CLOSURE_UNIQUE; "CLOSURE_UNIV",CLOSURE_UNIV; "COBOUNDED_HAS_BOUNDED_COMPONENT",COBOUNDED_HAS_BOUNDED_COMPONENT; "COBOUNDED_IMP_UNBOUNDED",COBOUNDED_IMP_UNBOUNDED; "COBOUNDED_INTER_UNBOUNDED",COBOUNDED_INTER_UNBOUNDED; "COBOUNDED_OUTSIDE",COBOUNDED_OUTSIDE; "COBOUNDED_UNBOUNDED_COMPONENT",COBOUNDED_UNBOUNDED_COMPONENT; "COBOUNDED_UNBOUNDED_COMPONENTS",COBOUNDED_UNBOUNDED_COMPONENTS; "COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT; "COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS; "COCOUNTABLE_APPROXIMATION",COCOUNTABLE_APPROXIMATION; "CODESET_SETCODE_BIJECTIONS",CODESET_SETCODE_BIJECTIONS; "COFACTOR_0",COFACTOR_0; "COFACTOR_1",COFACTOR_1; "COFACTOR_1_GEN",COFACTOR_1_GEN; "COFACTOR_CMUL",COFACTOR_CMUL; "COFACTOR_COFACTOR",COFACTOR_COFACTOR; "COFACTOR_COLUMN",COFACTOR_COLUMN; "COFACTOR_EQ_0",COFACTOR_EQ_0; "COFACTOR_I",COFACTOR_I; "COFACTOR_MATRIX_INV",COFACTOR_MATRIX_INV; "COFACTOR_MATRIX_MUL",COFACTOR_MATRIX_MUL; "COFACTOR_ROW",COFACTOR_ROW; "COFACTOR_TRANSP",COFACTOR_TRANSP; "COHOMOTOPICALLY_TRIVIAL_1D",COHOMOTOPICALLY_TRIVIAL_1D; "COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS; "COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL; "COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; "COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; "COLLINEAR_1",COLLINEAR_1; "COLLINEAR_2",COLLINEAR_2; "COLLINEAR_3",COLLINEAR_3; "COLLINEAR_3_2D",COLLINEAR_3_2D; "COLLINEAR_3_AFFINE_HULL",COLLINEAR_3_AFFINE_HULL; "COLLINEAR_3_DOT_MULTIPLES",COLLINEAR_3_DOT_MULTIPLES; "COLLINEAR_3_EQ_AFFINE_DEPENDENT",COLLINEAR_3_EQ_AFFINE_DEPENDENT; "COLLINEAR_3_EXPAND",COLLINEAR_3_EXPAND; "COLLINEAR_3_EXPLICIT",COLLINEAR_3_EXPLICIT; "COLLINEAR_3_IN_AFFINE_HULL",COLLINEAR_3_IN_AFFINE_HULL; "COLLINEAR_3_TRANS",COLLINEAR_3_TRANS; "COLLINEAR_4_3",COLLINEAR_4_3; "COLLINEAR_AFFINE_HULL",COLLINEAR_AFFINE_HULL; "COLLINEAR_AFFINE_HULL_COLLINEAR",COLLINEAR_AFFINE_HULL_COLLINEAR; "COLLINEAR_AFF_DIM",COLLINEAR_AFF_DIM; "COLLINEAR_ALT",COLLINEAR_ALT; "COLLINEAR_ALT2",COLLINEAR_ALT2; "COLLINEAR_BETWEEN_CASES",COLLINEAR_BETWEEN_CASES; "COLLINEAR_BETWEEN_CASES_2",COLLINEAR_BETWEEN_CASES_2; "COLLINEAR_CONVEX_HULL_COLLINEAR",COLLINEAR_CONVEX_HULL_COLLINEAR; "COLLINEAR_DESCALE",COLLINEAR_DESCALE; "COLLINEAR_DIST_BETWEEN",COLLINEAR_DIST_BETWEEN; "COLLINEAR_DIST_IN_CLOSED_SEGMENT",COLLINEAR_DIST_IN_CLOSED_SEGMENT; "COLLINEAR_DIST_IN_OPEN_SEGMENT",COLLINEAR_DIST_IN_OPEN_SEGMENT; "COLLINEAR_EMPTY",COLLINEAR_EMPTY; "COLLINEAR_EXTREME_POINTS",COLLINEAR_EXTREME_POINTS; "COLLINEAR_HYPERPLANE_2",COLLINEAR_HYPERPLANE_2; "COLLINEAR_IMP_COPLANAR",COLLINEAR_IMP_COPLANAR; "COLLINEAR_LEMMA",COLLINEAR_LEMMA; "COLLINEAR_LEMMA_ALT",COLLINEAR_LEMMA_ALT; "COLLINEAR_LINEAR_IMAGE",COLLINEAR_LINEAR_IMAGE; "COLLINEAR_LINEAR_IMAGE_EQ",COLLINEAR_LINEAR_IMAGE_EQ; "COLLINEAR_MIDPOINT",COLLINEAR_MIDPOINT; "COLLINEAR_SEGMENT",COLLINEAR_SEGMENT; "COLLINEAR_SIMPLE_PATH_IMAGE",COLLINEAR_SIMPLE_PATH_IMAGE; "COLLINEAR_SING",COLLINEAR_SING; "COLLINEAR_SMALL",COLLINEAR_SMALL; "COLLINEAR_SPAN",COLLINEAR_SPAN; "COLLINEAR_STANDARD_HYPERPLANE_2",COLLINEAR_STANDARD_HYPERPLANE_2; "COLLINEAR_SUBSET",COLLINEAR_SUBSET; "COLLINEAR_TRANSLATION",COLLINEAR_TRANSLATION; "COLLINEAR_TRANSLATION_EQ",COLLINEAR_TRANSLATION_EQ; "COLLINEAR_TRIPLES",COLLINEAR_TRIPLES; "COLUMNS_IMAGE_BASIS",COLUMNS_IMAGE_BASIS; "COLUMNS_NONEMPTY",COLUMNS_NONEMPTY; "COLUMNS_TRANSP",COLUMNS_TRANSP; "COLUMN_0",COLUMN_0; "COLUMN_MATRIX_MUL",COLUMN_MATRIX_MUL; "COLUMN_TRANSP",COLUMN_TRANSP; "COMMA_DEF",COMMA_DEF; "COMMON_FRONTIER_DOMAINS",COMMON_FRONTIER_DOMAINS; "COMMUTING_MATRIX_INV_COVARIANCE",COMMUTING_MATRIX_INV_COVARIANCE; "COMMUTING_MATRIX_INV_NORMAL",COMMUTING_MATRIX_INV_NORMAL; "COMMUTING_WITH_DIAGONAL_MATRIX",COMMUTING_WITH_DIAGONAL_MATRIX; "COMMUTING_WITH_SQUARE_ROOT_MATRIX",COMMUTING_WITH_SQUARE_ROOT_MATRIX; "COMPACT_AFFINITY",COMPACT_AFFINITY; "COMPACT_AFFINITY_EQ",COMPACT_AFFINITY_EQ; "COMPACT_AR",COMPACT_AR; "COMPACT_ARC_IMAGE",COMPACT_ARC_IMAGE; "COMPACT_ATTAINS_INF",COMPACT_ATTAINS_INF; "COMPACT_ATTAINS_SUP",COMPACT_ATTAINS_SUP; "COMPACT_CBALL",COMPACT_CBALL; "COMPACT_CHAIN",COMPACT_CHAIN; "COMPACT_CLOSED_DIFFERENCES",COMPACT_CLOSED_DIFFERENCES; "COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON",COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON; "COMPACT_CLOSED_SUMS",COMPACT_CLOSED_SUMS; "COMPACT_CLOSURE",COMPACT_CLOSURE; "COMPACT_COMPONENTS",COMPACT_COMPONENTS; "COMPACT_CONNECTED_COMPONENT",COMPACT_CONNECTED_COMPONENT; "COMPACT_CONTINUOUS_IMAGE",COMPACT_CONTINUOUS_IMAGE; "COMPACT_CONTINUOUS_IMAGE_EQ",COMPACT_CONTINUOUS_IMAGE_EQ; "COMPACT_CONVEX_COLLINEAR_SEGMENT",COMPACT_CONVEX_COLLINEAR_SEGMENT; "COMPACT_CONVEX_COLLINEAR_SEGMENT_ALT",COMPACT_CONVEX_COLLINEAR_SEGMENT_ALT; "COMPACT_CONVEX_COMBINATIONS",COMPACT_CONVEX_COMBINATIONS; "COMPACT_CONVEX_HULL",COMPACT_CONVEX_HULL; "COMPACT_DIFF",COMPACT_DIFF; "COMPACT_DIFFERENCES",COMPACT_DIFFERENCES; "COMPACT_EMPTY",COMPACT_EMPTY; "COMPACT_EQ_BOLZANO_WEIERSTRASS",COMPACT_EQ_BOLZANO_WEIERSTRASS; "COMPACT_EQ_BOUNDED_CLOSED",COMPACT_EQ_BOUNDED_CLOSED; "COMPACT_EQ_HEINE_BOREL",COMPACT_EQ_HEINE_BOREL; "COMPACT_EQ_HEINE_BOREL_GEN",COMPACT_EQ_HEINE_BOREL_GEN; "COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY",COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY; "COMPACT_FIP",COMPACT_FIP; "COMPACT_FRONTIER",COMPACT_FRONTIER; "COMPACT_FRONTIER_BOUNDED",COMPACT_FRONTIER_BOUNDED; "COMPACT_FRONTIER_LINE_LEMMA",COMPACT_FRONTIER_LINE_LEMMA; "COMPACT_HAUSDIST",COMPACT_HAUSDIST; "COMPACT_IMP_ANALYTIC",COMPACT_IMP_ANALYTIC; "COMPACT_IMP_BOREL",COMPACT_IMP_BOREL; "COMPACT_IMP_BOUNDED",COMPACT_IMP_BOUNDED; "COMPACT_IMP_CLOSED",COMPACT_IMP_CLOSED; "COMPACT_IMP_COMPACT_IN_SUBTOPOLOGY",COMPACT_IMP_COMPACT_IN_SUBTOPOLOGY; "COMPACT_IMP_COMPLETE",COMPACT_IMP_COMPLETE; "COMPACT_IMP_FIP",COMPACT_IMP_FIP; "COMPACT_IMP_HEINE_BOREL",COMPACT_IMP_HEINE_BOREL; "COMPACT_IMP_TOTALLY_BOUNDED",COMPACT_IMP_TOTALLY_BOUNDED; "COMPACT_INSERT",COMPACT_INSERT; "COMPACT_INTER",COMPACT_INTER; "COMPACT_INTERS",COMPACT_INTERS; "COMPACT_INTERVAL",COMPACT_INTERVAL; "COMPACT_INTERVAL_EQ",COMPACT_INTERVAL_EQ; "COMPACT_INTER_CLOSED",COMPACT_INTER_CLOSED; "COMPACT_IN_IFF_COMPACT",COMPACT_IN_IFF_COMPACT; "COMPACT_IN_IMP_MBOUNDED",COMPACT_IN_IMP_MBOUNDED; "COMPACT_IN_MSPACE_CFUNSPACE",COMPACT_IN_MSPACE_CFUNSPACE; "COMPACT_IN_SEPARATED_UNION",COMPACT_IN_SEPARATED_UNION; "COMPACT_IN_SUBSET_TOPSPACE",COMPACT_IN_SUBSET_TOPSPACE; "COMPACT_IN_SUBTOPOLOGY_EQ",COMPACT_IN_SUBTOPOLOGY_EQ; "COMPACT_IN_SUBTOPOLOGY_IMP_COMPACT",COMPACT_IN_SUBTOPOLOGY_IMP_COMPACT; "COMPACT_LEMMA",COMPACT_LEMMA; "COMPACT_LINEAR_IMAGE",COMPACT_LINEAR_IMAGE; "COMPACT_LINEAR_IMAGE_EQ",COMPACT_LINEAR_IMAGE_EQ; "COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE",COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE; "COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE_ALT",COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE_ALT; "COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE",COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE; "COMPACT_LOCALLY_CONNECTED_IMP_ULC",COMPACT_LOCALLY_CONNECTED_IMP_ULC; "COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT",COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT; "COMPACT_NEGATIONS",COMPACT_NEGATIONS; "COMPACT_NEST",COMPACT_NEST; "COMPACT_OPEN",COMPACT_OPEN; "COMPACT_PARTITION_CONTAINING_CLOSED",COMPACT_PARTITION_CONTAINING_CLOSED; "COMPACT_PARTITION_CONTAINING_POINTS",COMPACT_PARTITION_CONTAINING_POINTS; "COMPACT_PATH_IMAGE",COMPACT_PATH_IMAGE; "COMPACT_PCROSS",COMPACT_PCROSS; "COMPACT_PCROSS_EQ",COMPACT_PCROSS_EQ; "COMPACT_REAL_LEMMA",COMPACT_REAL_LEMMA; "COMPACT_RELATIVE_BOUNDARY",COMPACT_RELATIVE_BOUNDARY; "COMPACT_RELATIVE_FRONTIER",COMPACT_RELATIVE_FRONTIER; "COMPACT_RELATIVE_FRONTIER_BOUNDED",COMPACT_RELATIVE_FRONTIER_BOUNDED; "COMPACT_SCALING",COMPACT_SCALING; "COMPACT_SCALING_EQ",COMPACT_SCALING_EQ; "COMPACT_SEGMENT",COMPACT_SEGMENT; "COMPACT_SEQUENCE_WITH_LIMIT",COMPACT_SEQUENCE_WITH_LIMIT; "COMPACT_SEQUENCE_WITH_LIMIT_GEN",COMPACT_SEQUENCE_WITH_LIMIT_GEN; "COMPACT_SIMPLEX",COMPACT_SIMPLEX; "COMPACT_SIMPLE_PATH_IMAGE",COMPACT_SIMPLE_PATH_IMAGE; "COMPACT_SING",COMPACT_SING; "COMPACT_SPHERE",COMPACT_SPHERE; "COMPACT_SUBSET_FRONTIER_RETRACTION",COMPACT_SUBSET_FRONTIER_RETRACTION; "COMPACT_SUMS",COMPACT_SUMS; "COMPACT_SUP_MAXDISTANCE",COMPACT_SUP_MAXDISTANCE; "COMPACT_TRANSLATION",COMPACT_TRANSLATION; "COMPACT_TRANSLATION_EQ",COMPACT_TRANSLATION_EQ; "COMPACT_UNIFORMLY_CONTINUOUS",COMPACT_UNIFORMLY_CONTINUOUS; "COMPACT_UNIFORMLY_EQUICONTINUOUS",COMPACT_UNIFORMLY_EQUICONTINUOUS; "COMPACT_UNION",COMPACT_UNION; "COMPACT_UNIONS",COMPACT_UNIONS; "COMPACT_WITH_INSIDE",COMPACT_WITH_INSIDE; "COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ",COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ; "COMPLEMENT_CONNECTED_COMPONENT_UNIONS",COMPLEMENT_CONNECTED_COMPONENT_UNIONS; "COMPLEMENT_PATH_COMPONENT_UNIONS",COMPLEMENT_PATH_COMPONENT_UNIONS; "COMPLETE_ABSOLUTELY_SUMMABLE",COMPLETE_ABSOLUTELY_SUMMABLE; "COMPLETE_EQ_CLOSED",COMPLETE_EQ_CLOSED; "COMPLETE_HAUSDIST",COMPLETE_HAUSDIST; "COMPLETE_HAUSDIST_CONVEX",COMPLETE_HAUSDIST_CONVEX; "COMPLETE_HAUSDIST_CONVEX_UNIV",COMPLETE_HAUSDIST_CONVEX_UNIV; "COMPLETE_HAUSDIST_UNIV",COMPLETE_HAUSDIST_UNIV; "COMPLETE_INJECTIVE_LINEAR_IMAGE",COMPLETE_INJECTIVE_LINEAR_IMAGE; "COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ",COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ; "COMPLETE_ISOMETRIC_IMAGE",COMPLETE_ISOMETRIC_IMAGE; "COMPLETE_SUBSPACE",COMPLETE_SUBSPACE; "COMPLETE_TRANSLATION_EQ",COMPLETE_TRANSLATION_EQ; "COMPLETE_UNIV",COMPLETE_UNIV; "COMPL_COMPL",COMPL_COMPL; "COMPONENT",COMPONENT; "COMPONENTS_COMPLEMENT_FRONTIER",COMPONENTS_COMPLEMENT_FRONTIER; "COMPONENTS_CONVEX_COMPLEMENT_CONTAINS_HALFSPACE",COMPONENTS_CONVEX_COMPLEMENT_CONTAINS_HALFSPACE; "COMPONENTS_EMPTY",COMPONENTS_EMPTY; "COMPONENTS_EQ",COMPONENTS_EQ; "COMPONENTS_EQ_EMPTY",COMPONENTS_EQ_EMPTY; "COMPONENTS_EQ_SING",COMPONENTS_EQ_SING; "COMPONENTS_EQ_SING_EXISTS",COMPONENTS_EQ_SING_EXISTS; "COMPONENTS_INTERMEDIATE_SUBSET",COMPONENTS_INTERMEDIATE_SUBSET; "COMPONENTS_INTER_COMPONENTS",COMPONENTS_INTER_COMPONENTS; "COMPONENTS_LINEAR_IMAGE",COMPONENTS_LINEAR_IMAGE; "COMPONENTS_MAXIMAL",COMPONENTS_MAXIMAL; "COMPONENTS_NONOVERLAP",COMPONENTS_NONOVERLAP; "COMPONENTS_OPEN_UNIQUE",COMPONENTS_OPEN_UNIQUE; "COMPONENTS_PCROSS",COMPONENTS_PCROSS; "COMPONENTS_SEPARATED_UNION",COMPONENTS_SEPARATED_UNION; "COMPONENTS_SUBSETS_CLOPEN_PARTITION",COMPONENTS_SUBSETS_CLOPEN_PARTITION; "COMPONENTS_TRANSLATION",COMPONENTS_TRANSLATION; "COMPONENTS_UNIQUE",COMPONENTS_UNIQUE; "COMPONENTS_UNIQUE_2",COMPONENTS_UNIQUE_2; "COMPONENTS_UNIQUE_EQ",COMPONENTS_UNIQUE_EQ; "COMPONENTS_UNIV",COMPONENTS_UNIV; "COMPONENT_CLOPEN_HAUSDIST",COMPONENT_CLOPEN_HAUSDIST; "COMPONENT_CLOPEN_HAUSDIST_EXPLICIT",COMPONENT_CLOPEN_HAUSDIST_EXPLICIT; "COMPONENT_COMPLEMENT_CONNECTED",COMPONENT_COMPLEMENT_CONNECTED; "COMPONENT_INTERMEDIATE_CLOPEN",COMPONENT_INTERMEDIATE_CLOPEN; "COMPONENT_LE_INFNORM",COMPONENT_LE_INFNORM; "COMPONENT_LE_NORM",COMPONENT_LE_NORM; "COMPONENT_LE_ONORM",COMPONENT_LE_ONORM; "COMPONENT_RETRACT_COMPLEMENT_MEETS",COMPONENT_RETRACT_COMPLEMENT_MEETS; "CONDENSATION_POINTS_EQ_EMPTY",CONDENSATION_POINTS_EQ_EMPTY; "CONDENSATION_POINT_ALT",CONDENSATION_POINT_ALT; "CONDENSATION_POINT_IMP_LIMPT",CONDENSATION_POINT_IMP_LIMPT; "CONDENSATION_POINT_INFINITE_BALL",CONDENSATION_POINT_INFINITE_BALL; "CONDENSATION_POINT_INFINITE_CBALL",CONDENSATION_POINT_INFINITE_CBALL; "CONDENSATION_POINT_OF_CONDENSATION_POINTS",CONDENSATION_POINT_OF_CONDENSATION_POINTS; "CONDENSATION_POINT_OF_SUBSET",CONDENSATION_POINT_OF_SUBSET; "COND_ABS",COND_ABS; "COND_CLAUSES",COND_CLAUSES; "COND_COMPONENT",COND_COMPONENT; "COND_DEF",COND_DEF; "COND_ELIM_THM",COND_ELIM_THM; "COND_EXPAND",COND_EXPAND; "COND_ID",COND_ID; "COND_RAND",COND_RAND; "COND_RATOR",COND_RATOR; "COND_SWAP",COND_SWAP; "CONGRUENT_IMAGE_STD_SIMPLEX",CONGRUENT_IMAGE_STD_SIMPLEX; "CONIC_CLOSURE",CONIC_CLOSURE; "CONIC_CONIC_HULL",CONIC_CONIC_HULL; "CONIC_CONTAINS_0",CONIC_CONTAINS_0; "CONIC_CONVEX_CONE_HULL",CONIC_CONVEX_CONE_HULL; "CONIC_CONVEX_HULL",CONIC_CONVEX_HULL; "CONIC_EMPTY",CONIC_EMPTY; "CONIC_HALFSPACE_GE",CONIC_HALFSPACE_GE; "CONIC_HALFSPACE_LE",CONIC_HALFSPACE_LE; "CONIC_HULLS_EQ_IMP_SPANS_EQ",CONIC_HULLS_EQ_IMP_SPANS_EQ; "CONIC_HULL_0",CONIC_HULL_0; "CONIC_HULL_AS_IMAGE",CONIC_HULL_AS_IMAGE; "CONIC_HULL_CONTAINS_0",CONIC_HULL_CONTAINS_0; "CONIC_HULL_CONVEX_HULL",CONIC_HULL_CONVEX_HULL; "CONIC_HULL_DIFF",CONIC_HULL_DIFF; "CONIC_HULL_EMPTY",CONIC_HULL_EMPTY; "CONIC_HULL_EQ",CONIC_HULL_EQ; "CONIC_HULL_EQ_AFFINE_HULL",CONIC_HULL_EQ_AFFINE_HULL; "CONIC_HULL_EQ_EMPTY",CONIC_HULL_EQ_EMPTY; "CONIC_HULL_EQ_SING",CONIC_HULL_EQ_SING; "CONIC_HULL_EQ_SPAN",CONIC_HULL_EQ_SPAN; "CONIC_HULL_EQ_SPAN_EQ",CONIC_HULL_EQ_SPAN_EQ; "CONIC_HULL_EXPLICIT",CONIC_HULL_EXPLICIT; "CONIC_HULL_IMAGE_SCALE",CONIC_HULL_IMAGE_SCALE; "CONIC_HULL_INTER",CONIC_HULL_INTER; "CONIC_HULL_INTER_AFFINE_HULL",CONIC_HULL_INTER_AFFINE_HULL; "CONIC_HULL_LINEAR_IMAGE",CONIC_HULL_LINEAR_IMAGE; "CONIC_HULL_POINTLESS_AS_IMAGE",CONIC_HULL_POINTLESS_AS_IMAGE; "CONIC_HULL_RELATIVE_FRONTIER",CONIC_HULL_RELATIVE_FRONTIER; "CONIC_HULL_RELATIVE_INTERIOR",CONIC_HULL_RELATIVE_INTERIOR; "CONIC_HULL_RELATIVE_INTERIOR_SUBSET",CONIC_HULL_RELATIVE_INTERIOR_SUBSET; "CONIC_HULL_SUBSET_CONVEX_CONE_HULL",CONIC_HULL_SUBSET_CONVEX_CONE_HULL; "CONIC_HULL_SUBSET_SPAN",CONIC_HULL_SUBSET_SPAN; "CONIC_HULL_UNIV",CONIC_HULL_UNIV; "CONIC_HULL_VERTEX_IMAGE_LINEAR",CONIC_HULL_VERTEX_IMAGE_LINEAR; "CONIC_IMAGE_MULTIPLE",CONIC_IMAGE_MULTIPLE; "CONIC_IMAGE_MULTIPLE_EQ",CONIC_IMAGE_MULTIPLE_EQ; "CONIC_IMP_CONNECTED",CONIC_IMP_CONNECTED; "CONIC_IMP_CONTRACTIBLE",CONIC_IMP_CONTRACTIBLE; "CONIC_IMP_PATH_CONNECTED",CONIC_IMP_PATH_CONNECTED; "CONIC_IMP_SIMPLY_CONNECTED",CONIC_IMP_SIMPLY_CONNECTED; "CONIC_IMP_STARLIKE",CONIC_IMP_STARLIKE; "CONIC_INTERIOR",CONIC_INTERIOR; "CONIC_INTERIOR_INSERT",CONIC_INTERIOR_INSERT; "CONIC_INTERS",CONIC_INTERS; "CONIC_LINEAR_IMAGE",CONIC_LINEAR_IMAGE; "CONIC_LINEAR_IMAGE_EQ",CONIC_LINEAR_IMAGE_EQ; "CONIC_MUL",CONIC_MUL; "CONIC_NEGATIONS",CONIC_NEGATIONS; "CONIC_PCROSS",CONIC_PCROSS; "CONIC_PCROSS_EQ",CONIC_PCROSS_EQ; "CONIC_POSITIVE_ORTHANT",CONIC_POSITIVE_ORTHANT; "CONIC_RELATIVE_INTERIOR",CONIC_RELATIVE_INTERIOR; "CONIC_RELATIVE_INTERIOR_INSERT",CONIC_RELATIVE_INTERIOR_INSERT; "CONIC_SPAN",CONIC_SPAN; "CONIC_SUBSET_AS_CONIC_HULL",CONIC_SUBSET_AS_CONIC_HULL; "CONIC_SUMS",CONIC_SUMS; "CONIC_UNIV",CONIC_UNIV; "CONJ_ACI",CONJ_ACI; "CONJ_ASSOC",CONJ_ASSOC; "CONJ_SYM",CONJ_SYM; "CONNECTED",CONNECTED; "CONNECTED_2",CONNECTED_2; "CONNECTED_AFFINITY",CONNECTED_AFFINITY; "CONNECTED_AFFINITY_EQ",CONNECTED_AFFINITY_EQ; "CONNECTED_ANNULUS",CONNECTED_ANNULUS; "CONNECTED_ARC_COMPLEMENT",CONNECTED_ARC_COMPLEMENT; "CONNECTED_ARC_IMAGE",CONNECTED_ARC_IMAGE; "CONNECTED_ARC_IMAGE_DELETE",CONNECTED_ARC_IMAGE_DELETE; "CONNECTED_BALL",CONNECTED_BALL; "CONNECTED_CARD_EQ_IFF_NONTRIVIAL",CONNECTED_CARD_EQ_IFF_NONTRIVIAL; "CONNECTED_CARD_LT_IFF_TRIVIAL",CONNECTED_CARD_LT_IFF_TRIVIAL; "CONNECTED_CBALL",CONNECTED_CBALL; "CONNECTED_CHAIN",CONNECTED_CHAIN; "CONNECTED_CHAIN_GEN",CONNECTED_CHAIN_GEN; "CONNECTED_CLOPEN",CONNECTED_CLOPEN; "CONNECTED_CLOSED",CONNECTED_CLOSED; "CONNECTED_CLOSED_IN",CONNECTED_CLOSED_IN; "CONNECTED_CLOSED_IN_EQ",CONNECTED_CLOSED_IN_EQ; "CONNECTED_CLOSED_MONOTONE_PREIMAGE",CONNECTED_CLOSED_MONOTONE_PREIMAGE; "CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON",CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON; "CONNECTED_CLOSED_SET",CONNECTED_CLOSED_SET; "CONNECTED_CLOSURE",CONNECTED_CLOSURE; "CONNECTED_CLOSURE_FROM_FRONTIER",CONNECTED_CLOSURE_FROM_FRONTIER; "CONNECTED_COMPACT_INTERVAL_1",CONNECTED_COMPACT_INTERVAL_1; "CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; "CONNECTED_COMPLEMENT_BOUNDED_CONVEX",CONNECTED_COMPLEMENT_BOUNDED_CONVEX; "CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; "CONNECTED_COMPLEMENT_SUBSET_CIRCLE",CONNECTED_COMPLEMENT_SUBSET_CIRCLE; "CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE",CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE; "CONNECTED_COMPONENTS",CONNECTED_COMPONENTS; "CONNECTED_COMPONENT_1",CONNECTED_COMPONENT_1; "CONNECTED_COMPONENT_1_GEN",CONNECTED_COMPONENT_1_GEN; "CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED",CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED; "CONNECTED_COMPONENT_DIFF_NONSEPARATED",CONNECTED_COMPONENT_DIFF_NONSEPARATED; "CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT",CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT; "CONNECTED_COMPONENT_DISJOINT",CONNECTED_COMPONENT_DISJOINT; "CONNECTED_COMPONENT_EMPTY",CONNECTED_COMPONENT_EMPTY; "CONNECTED_COMPONENT_EQ",CONNECTED_COMPONENT_EQ; "CONNECTED_COMPONENT_EQUIVALENCE_RELATION",CONNECTED_COMPONENT_EQUIVALENCE_RELATION; "CONNECTED_COMPONENT_EQ_EMPTY",CONNECTED_COMPONENT_EQ_EMPTY; "CONNECTED_COMPONENT_EQ_EQ",CONNECTED_COMPONENT_EQ_EQ; "CONNECTED_COMPONENT_EQ_SELF",CONNECTED_COMPONENT_EQ_SELF; "CONNECTED_COMPONENT_EQ_UNIV",CONNECTED_COMPONENT_EQ_UNIV; "CONNECTED_COMPONENT_EQ_WELLCHAINED",CONNECTED_COMPONENT_EQ_WELLCHAINED; "CONNECTED_COMPONENT_IDEMP",CONNECTED_COMPONENT_IDEMP; "CONNECTED_COMPONENT_IMP_WELLCHAINED",CONNECTED_COMPONENT_IMP_WELLCHAINED; "CONNECTED_COMPONENT_IN",CONNECTED_COMPONENT_IN; "CONNECTED_COMPONENT_INSIDE",CONNECTED_COMPONENT_INSIDE; "CONNECTED_COMPONENT_INTERMEDIATE_SUBSET",CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; "CONNECTED_COMPONENT_IN_COMPONENTS",CONNECTED_COMPONENT_IN_COMPONENTS; "CONNECTED_COMPONENT_LIMIT",CONNECTED_COMPONENT_LIMIT; "CONNECTED_COMPONENT_LINEAR_IMAGE",CONNECTED_COMPONENT_LINEAR_IMAGE; "CONNECTED_COMPONENT_MAXIMAL",CONNECTED_COMPONENT_MAXIMAL; "CONNECTED_COMPONENT_MONO",CONNECTED_COMPONENT_MONO; "CONNECTED_COMPONENT_NONOVERLAP",CONNECTED_COMPONENT_NONOVERLAP; "CONNECTED_COMPONENT_OF_SUBSET",CONNECTED_COMPONENT_OF_SUBSET; "CONNECTED_COMPONENT_OUTSIDE",CONNECTED_COMPONENT_OUTSIDE; "CONNECTED_COMPONENT_OVERLAP",CONNECTED_COMPONENT_OVERLAP; "CONNECTED_COMPONENT_PCROSS",CONNECTED_COMPONENT_PCROSS; "CONNECTED_COMPONENT_REFL",CONNECTED_COMPONENT_REFL; "CONNECTED_COMPONENT_REFL_EQ",CONNECTED_COMPONENT_REFL_EQ; "CONNECTED_COMPONENT_SEPARATED_UNION",CONNECTED_COMPONENT_SEPARATED_UNION; "CONNECTED_COMPONENT_SET",CONNECTED_COMPONENT_SET; "CONNECTED_COMPONENT_SUBSET",CONNECTED_COMPONENT_SUBSET; "CONNECTED_COMPONENT_SYM",CONNECTED_COMPONENT_SYM; "CONNECTED_COMPONENT_SYM_EQ",CONNECTED_COMPONENT_SYM_EQ; "CONNECTED_COMPONENT_TRANS",CONNECTED_COMPONENT_TRANS; "CONNECTED_COMPONENT_TRANSLATION",CONNECTED_COMPONENT_TRANSLATION; "CONNECTED_COMPONENT_UNIONS",CONNECTED_COMPONENT_UNIONS; "CONNECTED_COMPONENT_UNIQUE",CONNECTED_COMPONENT_UNIQUE; "CONNECTED_COMPONENT_UNIV",CONNECTED_COMPONENT_UNIV; "CONNECTED_CONNECTED_COMPONENT",CONNECTED_CONNECTED_COMPONENT; "CONNECTED_CONNECTED_COMPONENT_SET",CONNECTED_CONNECTED_COMPONENT_SET; "CONNECTED_CONNECTED_DIFF",CONNECTED_CONNECTED_DIFF; "CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES",CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES; "CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON",CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON; "CONNECTED_CONTINUOUS_IMAGE",CONNECTED_CONTINUOUS_IMAGE; "CONNECTED_CONVEX_1",CONNECTED_CONVEX_1; "CONNECTED_CONVEX_1_GEN",CONNECTED_CONVEX_1_GEN; "CONNECTED_CONVEX_DIFF_CARD_LT",CONNECTED_CONVEX_DIFF_CARD_LT; "CONNECTED_CONVEX_DIFF_COUNTABLE",CONNECTED_CONVEX_DIFF_COUNTABLE; "CONNECTED_CONVEX_DIFF_LOWDIM",CONNECTED_CONVEX_DIFF_LOWDIM; "CONNECTED_DELETE_INTERIOR_POINT",CONNECTED_DELETE_INTERIOR_POINT; "CONNECTED_DELETE_INTERIOR_POINT_EQ",CONNECTED_DELETE_INTERIOR_POINT_EQ; "CONNECTED_DIFF_BALL",CONNECTED_DIFF_BALL; "CONNECTED_DIFF_OPEN_FROM_CLOSED",CONNECTED_DIFF_OPEN_FROM_CLOSED; "CONNECTED_DIMENSION_EQ_SING",CONNECTED_DIMENSION_EQ_SING; "CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE",CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE; "CONNECTED_EMPTY",CONNECTED_EMPTY; "CONNECTED_EQUIVALENCE_RELATION",CONNECTED_EQUIVALENCE_RELATION; "CONNECTED_EQUIVALENCE_RELATION_GEN",CONNECTED_EQUIVALENCE_RELATION_GEN; "CONNECTED_EQ_CARD_COMPONENTS",CONNECTED_EQ_CARD_COMPONENTS; "CONNECTED_EQ_COMPONENTS_SING",CONNECTED_EQ_COMPONENTS_SING; "CONNECTED_EQ_COMPONENTS_SING_EXISTS",CONNECTED_EQ_COMPONENTS_SING_EXISTS; "CONNECTED_EQ_COMPONENTS_SUBSET_SING",CONNECTED_EQ_COMPONENTS_SUBSET_SING; "CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS",CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS; "CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED",CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED; "CONNECTED_EQ_COMPONENT_DIFF_CLOSED_NONSEPARATED",CONNECTED_EQ_COMPONENT_DIFF_CLOSED_NONSEPARATED; "CONNECTED_EQ_CONNECTED_COMPONENTS_EQ",CONNECTED_EQ_CONNECTED_COMPONENTS_EQ; "CONNECTED_EQ_CONNECTED_COMPONENT_EQ",CONNECTED_EQ_CONNECTED_COMPONENT_EQ; "CONNECTED_EQ_WELLCHAINED",CONNECTED_EQ_WELLCHAINED; "CONNECTED_FINITE_EQ_LOWDIM",CONNECTED_FINITE_EQ_LOWDIM; "CONNECTED_FINITE_IFF_COUNTABLE",CONNECTED_FINITE_IFF_COUNTABLE; "CONNECTED_FINITE_IFF_SING",CONNECTED_FINITE_IFF_SING; "CONNECTED_FROM_CLOSED_UNION_AND_INTER",CONNECTED_FROM_CLOSED_UNION_AND_INTER; "CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL",CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL; "CONNECTED_FROM_OPEN_UNION_AND_INTER",CONNECTED_FROM_OPEN_UNION_AND_INTER; "CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL",CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL; "CONNECTED_FULL_CONVEX_DIFF_LOWDIM",CONNECTED_FULL_CONVEX_DIFF_LOWDIM; "CONNECTED_FULL_REGULAR_DIFF_LOWDIM",CONNECTED_FULL_REGULAR_DIFF_LOWDIM; "CONNECTED_HAUSDIST_LIMIT",CONNECTED_HAUSDIST_LIMIT; "CONNECTED_IFF_CONNECTABLE_POINTS",CONNECTED_IFF_CONNECTABLE_POINTS; "CONNECTED_IFF_CONNECTED_COMPONENT",CONNECTED_IFF_CONNECTED_COMPONENT; "CONNECTED_IMP_CONNECTED_COMPONENT",CONNECTED_IMP_CONNECTED_COMPONENT; "CONNECTED_IMP_NONSEPARATED_UNION",CONNECTED_IMP_NONSEPARATED_UNION; "CONNECTED_IMP_PERFECT",CONNECTED_IMP_PERFECT; "CONNECTED_IMP_PERFECT_AFF_DIM",CONNECTED_IMP_PERFECT_AFF_DIM; "CONNECTED_IMP_PERFECT_CLOSED",CONNECTED_IMP_PERFECT_CLOSED; "CONNECTED_IMP_WELLCHAINED",CONNECTED_IMP_WELLCHAINED; "CONNECTED_INDUCTION",CONNECTED_INDUCTION; "CONNECTED_INDUCTION_SIMPLE",CONNECTED_INDUCTION_SIMPLE; "CONNECTED_INFINITE_IFF_CARD_EQ",CONNECTED_INFINITE_IFF_CARD_EQ; "CONNECTED_INSERT",CONNECTED_INSERT; "CONNECTED_INSERT_COMPACT",CONNECTED_INSERT_COMPACT; "CONNECTED_INSERT_LIMPT",CONNECTED_INSERT_LIMPT; "CONNECTED_INTERMEDIATE_CLOSURE",CONNECTED_INTERMEDIATE_CLOSURE; "CONNECTED_INTERVAL",CONNECTED_INTERVAL; "CONNECTED_INTER_FRONTIER",CONNECTED_INTER_FRONTIER; "CONNECTED_INTER_RELATIVE_FRONTIER",CONNECTED_INTER_RELATIVE_FRONTIER; "CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ",CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ; "CONNECTED_IVT_COMPONENT",CONNECTED_IVT_COMPONENT; "CONNECTED_IVT_HYPERPLANE",CONNECTED_IVT_HYPERPLANE; "CONNECTED_LIMIT_POINTS",CONNECTED_LIMIT_POINTS; "CONNECTED_LIMIT_POINTS_EQ_CLOSURE",CONNECTED_LIMIT_POINTS_EQ_CLOSURE; "CONNECTED_LINEAR_IMAGE",CONNECTED_LINEAR_IMAGE; "CONNECTED_LINEAR_IMAGE_EQ",CONNECTED_LINEAR_IMAGE_EQ; "CONNECTED_MONOTONE_QUOTIENT_PREIMAGE",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE; "CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN; "CONNECTED_NEGATIONS",CONNECTED_NEGATIONS; "CONNECTED_NEST",CONNECTED_NEST; "CONNECTED_NEST_GEN",CONNECTED_NEST_GEN; "CONNECTED_OPEN_ARC_CONNECTED",CONNECTED_OPEN_ARC_CONNECTED; "CONNECTED_OPEN_DELETE",CONNECTED_OPEN_DELETE; "CONNECTED_OPEN_DELETE_EQ",CONNECTED_OPEN_DELETE_EQ; "CONNECTED_OPEN_DIFF_CARD_LT",CONNECTED_OPEN_DIFF_CARD_LT; "CONNECTED_OPEN_DIFF_CBALL",CONNECTED_OPEN_DIFF_CBALL; "CONNECTED_OPEN_DIFF_COUNTABLE",CONNECTED_OPEN_DIFF_COUNTABLE; "CONNECTED_OPEN_DIFF_LOWDIM",CONNECTED_OPEN_DIFF_LOWDIM; "CONNECTED_OPEN_IN",CONNECTED_OPEN_IN; "CONNECTED_OPEN_IN_CONVEX_DIFF_LOWDIM",CONNECTED_OPEN_IN_CONVEX_DIFF_LOWDIM; "CONNECTED_OPEN_IN_DIFF_CARD_LT",CONNECTED_OPEN_IN_DIFF_CARD_LT; "CONNECTED_OPEN_IN_DIFF_LOWDIM",CONNECTED_OPEN_IN_DIFF_LOWDIM; "CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM",CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM; "CONNECTED_OPEN_IN_EQ",CONNECTED_OPEN_IN_EQ; "CONNECTED_OPEN_IN_SPHERE_DELETE_EQ",CONNECTED_OPEN_IN_SPHERE_DELETE_EQ; "CONNECTED_OPEN_MONOTONE_PREIMAGE",CONNECTED_OPEN_MONOTONE_PREIMAGE; "CONNECTED_OPEN_PATH_CONNECTED",CONNECTED_OPEN_PATH_CONNECTED; "CONNECTED_OPEN_SET",CONNECTED_OPEN_SET; "CONNECTED_OUTSIDE",CONNECTED_OUTSIDE; "CONNECTED_PATH_IMAGE",CONNECTED_PATH_IMAGE; "CONNECTED_PCROSS",CONNECTED_PCROSS; "CONNECTED_PCROSS_EQ",CONNECTED_PCROSS_EQ; "CONNECTED_PUNCTURED_BALL",CONNECTED_PUNCTURED_BALL; "CONNECTED_PUNCTURED_CBALL",CONNECTED_PUNCTURED_CBALL; "CONNECTED_PUNCTURED_CONVEX",CONNECTED_PUNCTURED_CONVEX; "CONNECTED_PUNCTURED_SPHERE",CONNECTED_PUNCTURED_SPHERE; "CONNECTED_PUNCTURED_UNIVERSE",CONNECTED_PUNCTURED_UNIVERSE; "CONNECTED_REAL_LEMMA",CONNECTED_REAL_LEMMA; "CONNECTED_RETRACT_COMPLEMENT",CONNECTED_RETRACT_COMPLEMENT; "CONNECTED_SCALING",CONNECTED_SCALING; "CONNECTED_SCALING_EQ",CONNECTED_SCALING_EQ; "CONNECTED_SEGMENT",CONNECTED_SEGMENT; "CONNECTED_SEMIOPEN_SEGMENT",CONNECTED_SEMIOPEN_SEGMENT; "CONNECTED_SEPARATION",CONNECTED_SEPARATION; "CONNECTED_SEPARATION_ALT",CONNECTED_SEPARATION_ALT; "CONNECTED_SIMPLE_PATH_ENDLESS",CONNECTED_SIMPLE_PATH_ENDLESS; "CONNECTED_SIMPLE_PATH_IMAGE",CONNECTED_SIMPLE_PATH_IMAGE; "CONNECTED_SIMPLE_PATH_IMAGE_DELETE",CONNECTED_SIMPLE_PATH_IMAGE_DELETE; "CONNECTED_SING",CONNECTED_SING; "CONNECTED_SPHERE",CONNECTED_SPHERE; "CONNECTED_SPHERE_EQ",CONNECTED_SPHERE_EQ; "CONNECTED_SPHERE_GEN",CONNECTED_SPHERE_GEN; "CONNECTED_SUBSET_ARC_PAIR",CONNECTED_SUBSET_ARC_PAIR; "CONNECTED_SUBSET_CLOPEN",CONNECTED_SUBSET_CLOPEN; "CONNECTED_SUBSET_PATH_IMAGE_ARC",CONNECTED_SUBSET_PATH_IMAGE_ARC; "CONNECTED_SUBSET_SEGMENT",CONNECTED_SUBSET_SEGMENT; "CONNECTED_SUMS",CONNECTED_SUMS; "CONNECTED_TRANSLATION",CONNECTED_TRANSLATION; "CONNECTED_TRANSLATION_EQ",CONNECTED_TRANSLATION_EQ; "CONNECTED_UNION",CONNECTED_UNION; "CONNECTED_UNIONS",CONNECTED_UNIONS; "CONNECTED_UNIONS_PAIRWISE",CONNECTED_UNIONS_PAIRWISE; "CONNECTED_UNIONS_STRONG",CONNECTED_UNIONS_STRONG; "CONNECTED_UNION_CLOPEN_IN_COMPLEMENT",CONNECTED_UNION_CLOPEN_IN_COMPLEMENT; "CONNECTED_UNION_STRONG",CONNECTED_UNION_STRONG; "CONNECTED_UNIV",CONNECTED_UNIV; "CONNECTED_UNIV_DIFF_LOWDIM",CONNECTED_UNIV_DIFF_LOWDIM; "CONNECTED_WITH_INSIDE",CONNECTED_WITH_INSIDE; "CONNECTED_WITH_OUTSIDE",CONNECTED_WITH_OUTSIDE; "CONNECTED_WITH_RELATIVE_INTERIOR_OPEN_IN_CONVEX",CONNECTED_WITH_RELATIVE_INTERIOR_OPEN_IN_CONVEX; "CONSTR",CONSTR; "CONSTR_BOT",CONSTR_BOT; "CONSTR_IND",CONSTR_IND; "CONSTR_INJ",CONSTR_INJ; "CONSTR_REC",CONSTR_REC; "CONS_11",CONS_11; "CONS_HD_TL",CONS_HD_TL; "CONTAINS_COMPONENT_OF_CLOSURE_FRONTIER",CONTAINS_COMPONENT_OF_CLOSURE_FRONTIER; "CONTAINS_COMPONENT_OF_COMPACT_FRONTIER",CONTAINS_COMPONENT_OF_COMPACT_FRONTIER; "CONTENT_0_SUBSET",CONTENT_0_SUBSET; "CONTENT_0_SUBSET_GEN",CONTENT_0_SUBSET_GEN; "CONTENT_1",CONTENT_1; "CONTENT_CLOSED_INTERVAL",CONTENT_CLOSED_INTERVAL; "CONTENT_CLOSED_INTERVAL_CASES",CONTENT_CLOSED_INTERVAL_CASES; "CONTENT_DOUBLESPLIT",CONTENT_DOUBLESPLIT; "CONTENT_EMPTY",CONTENT_EMPTY; "CONTENT_EQ_0",CONTENT_EQ_0; "CONTENT_EQ_0_1",CONTENT_EQ_0_1; "CONTENT_EQ_0_GEN",CONTENT_EQ_0_GEN; "CONTENT_EQ_0_INTERIOR",CONTENT_EQ_0_INTERIOR; "CONTENT_IMAGE_AFFINITY_INTERVAL",CONTENT_IMAGE_AFFINITY_INTERVAL; "CONTENT_IMAGE_STRETCH_INTERVAL",CONTENT_IMAGE_STRETCH_INTERVAL; "CONTENT_LT_NZ",CONTENT_LT_NZ; "CONTENT_PASTECART",CONTENT_PASTECART; "CONTENT_POS_LE",CONTENT_POS_LE; "CONTENT_POS_LT",CONTENT_POS_LT; "CONTENT_POS_LT_1",CONTENT_POS_LT_1; "CONTENT_POS_LT_EQ",CONTENT_POS_LT_EQ; "CONTENT_SPLIT",CONTENT_SPLIT; "CONTENT_SUBSET",CONTENT_SUBSET; "CONTENT_UNIT",CONTENT_UNIT; "CONTENT_UNIT_1",CONTENT_UNIT_1; "CONTINUOUS_ABS",CONTINUOUS_ABS; "CONTINUOUS_ADD",CONTINUOUS_ADD; "CONTINUOUS_ADDITIVE_IMP_LINEAR",CONTINUOUS_ADDITIVE_IMP_LINEAR; "CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "CONTINUOUS_AGREE_ON_CLOSURE",CONTINUOUS_AGREE_ON_CLOSURE; "CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_AT",CONTINUOUS_AT; "CONTINUOUS_ATTAINS_INF",CONTINUOUS_ATTAINS_INF; "CONTINUOUS_ATTAINS_SUP",CONTINUOUS_ATTAINS_SUP; "CONTINUOUS_AT_AVOID",CONTINUOUS_AT_AVOID; "CONTINUOUS_AT_BALL",CONTINUOUS_AT_BALL; "CONTINUOUS_AT_CLOSEST_POINT",CONTINUOUS_AT_CLOSEST_POINT; "CONTINUOUS_AT_COMPOSE",CONTINUOUS_AT_COMPOSE; "CONTINUOUS_AT_COMPOSE_EQ",CONTINUOUS_AT_COMPOSE_EQ; "CONTINUOUS_AT_DIST_CLOSEST_POINT",CONTINUOUS_AT_DIST_CLOSEST_POINT; "CONTINUOUS_AT_ID",CONTINUOUS_AT_ID; "CONTINUOUS_AT_IMP_CONTINUOUS_ON",CONTINUOUS_AT_IMP_CONTINUOUS_ON; "CONTINUOUS_AT_INV",CONTINUOUS_AT_INV; "CONTINUOUS_AT_LIFT_COMPONENT",CONTINUOUS_AT_LIFT_COMPONENT; "CONTINUOUS_AT_LIFT_DIST",CONTINUOUS_AT_LIFT_DIST; "CONTINUOUS_AT_LIFT_DOT",CONTINUOUS_AT_LIFT_DOT; "CONTINUOUS_AT_LIFT_INFNORM",CONTINUOUS_AT_LIFT_INFNORM; "CONTINUOUS_AT_LIFT_NORM",CONTINUOUS_AT_LIFT_NORM; "CONTINUOUS_AT_LIFT_RANGE",CONTINUOUS_AT_LIFT_RANGE; "CONTINUOUS_AT_LIFT_SETDIST",CONTINUOUS_AT_LIFT_SETDIST; "CONTINUOUS_AT_LINEAR_IMAGE",CONTINUOUS_AT_LINEAR_IMAGE; "CONTINUOUS_AT_OPEN",CONTINUOUS_AT_OPEN; "CONTINUOUS_AT_SEQUENTIALLY",CONTINUOUS_AT_SEQUENTIALLY; "CONTINUOUS_AT_SEQUENTIALLY_ALT",CONTINUOUS_AT_SEQUENTIALLY_ALT; "CONTINUOUS_AT_SEQUENTIALLY_INJ",CONTINUOUS_AT_SEQUENTIALLY_INJ; "CONTINUOUS_AT_SQRT",CONTINUOUS_AT_SQRT; "CONTINUOUS_AT_SQRT_COMPOSE",CONTINUOUS_AT_SQRT_COMPOSE; "CONTINUOUS_AT_TRANSLATION",CONTINUOUS_AT_TRANSLATION; "CONTINUOUS_AT_WITHIN",CONTINUOUS_AT_WITHIN; "CONTINUOUS_AT_WITHIN_INV",CONTINUOUS_AT_WITHIN_INV; "CONTINUOUS_BOREL_PREIMAGE",CONTINUOUS_BOREL_PREIMAGE; "CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS",CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS; "CONTINUOUS_CARD_LT_RANGE_CONSTANT",CONTINUOUS_CARD_LT_RANGE_CONSTANT; "CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ",CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ; "CONTINUOUS_CLOSED_GRAPH",CONTINUOUS_CLOSED_GRAPH; "CONTINUOUS_CLOSED_GRAPH_EQ",CONTINUOUS_CLOSED_GRAPH_EQ; "CONTINUOUS_CLOSED_GRAPH_GEN",CONTINUOUS_CLOSED_GRAPH_GEN; "CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS",CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS; "CONTINUOUS_CLOSED_IN_PREIMAGE",CONTINUOUS_CLOSED_IN_PREIMAGE; "CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT; "CONTINUOUS_CLOSED_IN_PREIMAGE_EQ",CONTINUOUS_CLOSED_IN_PREIMAGE_EQ; "CONTINUOUS_CLOSED_IN_PREIMAGE_GEN",CONTINUOUS_CLOSED_IN_PREIMAGE_GEN; "CONTINUOUS_CLOSED_IN_PREIMAGE_SUBSET",CONTINUOUS_CLOSED_IN_PREIMAGE_SUBSET; "CONTINUOUS_CLOSED_PREIMAGE",CONTINUOUS_CLOSED_PREIMAGE; "CONTINUOUS_CLOSED_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_PREIMAGE_CONSTANT; "CONTINUOUS_CLOSED_PREIMAGE_UNIV",CONTINUOUS_CLOSED_PREIMAGE_UNIV; "CONTINUOUS_CMUL",CONTINUOUS_CMUL; "CONTINUOUS_COMPONENTWISE_LIFT",CONTINUOUS_COMPONENTWISE_LIFT; "CONTINUOUS_CONST",CONTINUOUS_CONST; "CONTINUOUS_CONSTANT_ON_CLOSURE",CONTINUOUS_CONSTANT_ON_CLOSURE; "CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_COUNTABLE_RANGE_CONSTANT",CONTINUOUS_COUNTABLE_RANGE_CONSTANT; "CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ",CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ; "CONTINUOUS_DECREASING_IMAGE_INTERVAL_1",CONTINUOUS_DECREASING_IMAGE_INTERVAL_1; "CONTINUOUS_DET_EXPLICIT",CONTINUOUS_DET_EXPLICIT; "CONTINUOUS_DIAMETER",CONTINUOUS_DIAMETER; "CONTINUOUS_DISCONNECTED_RANGE_CONSTANT",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT; "CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; "CONTINUOUS_DISCRETE_RANGE_CONSTANT",CONTINUOUS_DISCRETE_RANGE_CONSTANT; "CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ",CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; "CONTINUOUS_EQ_CAUCHY_AT",CONTINUOUS_EQ_CAUCHY_AT; "CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED",CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED; "CONTINUOUS_EQ_CAUCHY_WITHIN",CONTINUOUS_EQ_CAUCHY_WITHIN; "CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING",CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING; "CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN",CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN; "CONTINUOUS_EQ_COMPACT_PATH_CONNECTED_PRESERVING",CONTINUOUS_EQ_COMPACT_PATH_CONNECTED_PRESERVING; "CONTINUOUS_FINITE_RANGE_CONSTANT",CONTINUOUS_FINITE_RANGE_CONSTANT; "CONTINUOUS_FINITE_RANGE_CONSTANT_EQ",CONTINUOUS_FINITE_RANGE_CONSTANT_EQ; "CONTINUOUS_FROM_CLOSED_GRAPH",CONTINUOUS_FROM_CLOSED_GRAPH; "CONTINUOUS_FSIGMA_PREIMAGE",CONTINUOUS_FSIGMA_PREIMAGE; "CONTINUOUS_FSTCART",CONTINUOUS_FSTCART; "CONTINUOUS_FUNCTION_HAS_EIGENVALUES_ODD_DIM",CONTINUOUS_FUNCTION_HAS_EIGENVALUES_ODD_DIM; "CONTINUOUS_GDELTA_PREIMAGE",CONTINUOUS_GDELTA_PREIMAGE; "CONTINUOUS_GE_ON_CLOSURE",CONTINUOUS_GE_ON_CLOSURE; "CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_IMAGE_NESTED_INTERS",CONTINUOUS_IMAGE_NESTED_INTERS; "CONTINUOUS_IMAGE_NESTED_INTERS_GEN",CONTINUOUS_IMAGE_NESTED_INTERS_GEN; "CONTINUOUS_IMP_BOREL_MEASURABLE_ON",CONTINUOUS_IMP_BOREL_MEASURABLE_ON; "CONTINUOUS_IMP_CLOSED_MAP",CONTINUOUS_IMP_CLOSED_MAP; "CONTINUOUS_IMP_MEASURABLE_ON",CONTINUOUS_IMP_MEASURABLE_ON; "CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET; "CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "CONTINUOUS_IMP_QUOTIENT_MAP",CONTINUOUS_IMP_QUOTIENT_MAP; "CONTINUOUS_INCREASING_IMAGE_INTERVAL_1",CONTINUOUS_INCREASING_IMAGE_INTERVAL_1; "CONTINUOUS_INJECTIVE_IFF_MONOTONIC",CONTINUOUS_INJECTIVE_IFF_MONOTONIC; "CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1; "CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1; "CONTINUOUS_INJECTIVE_IMP_MONOTONIC",CONTINUOUS_INJECTIVE_IMP_MONOTONIC; "CONTINUOUS_INTERVAL_BIJ",CONTINUOUS_INTERVAL_BIJ; "CONTINUOUS_INV",CONTINUOUS_INV; "CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP",CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP; "CONTINUOUS_IVT_LOCAL_EXTREMUM",CONTINUOUS_IVT_LOCAL_EXTREMUM; "CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP; "CONTINUOUS_LEVELSET_OPEN",CONTINUOUS_LEVELSET_OPEN; "CONTINUOUS_LEVELSET_OPEN_IN",CONTINUOUS_LEVELSET_OPEN_IN; "CONTINUOUS_LEVELSET_OPEN_IN_CASES",CONTINUOUS_LEVELSET_OPEN_IN_CASES; "CONTINUOUS_LE_ON_CLOSURE",CONTINUOUS_LE_ON_CLOSURE; "CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_LIFT_ABS",CONTINUOUS_LIFT_ABS; "CONTINUOUS_LIFT_ABS_COMPONENT",CONTINUOUS_LIFT_ABS_COMPONENT; "CONTINUOUS_LIFT_COMPONENT_COMPOSE",CONTINUOUS_LIFT_COMPONENT_COMPOSE; "CONTINUOUS_LIFT_DET",CONTINUOUS_LIFT_DET; "CONTINUOUS_LIFT_DOT2",CONTINUOUS_LIFT_DOT2; "CONTINUOUS_LIFT_NORM_COMPOSE",CONTINUOUS_LIFT_NORM_COMPOSE; "CONTINUOUS_LIFT_POW",CONTINUOUS_LIFT_POW; "CONTINUOUS_LIFT_PRODUCT",CONTINUOUS_LIFT_PRODUCT; "CONTINUOUS_LINEPATH_AT",CONTINUOUS_LINEPATH_AT; "CONTINUOUS_MAP_CLOSURES",CONTINUOUS_MAP_CLOSURES; "CONTINUOUS_MAP_CLOSURES_GEN",CONTINUOUS_MAP_CLOSURES_GEN; "CONTINUOUS_MATRIX_COMPONENTWISE",CONTINUOUS_MATRIX_COMPONENTWISE; "CONTINUOUS_MAX",CONTINUOUS_MAX; "CONTINUOUS_MAX_1",CONTINUOUS_MAX_1; "CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_TRANSLATION",CONTINUOUS_MEASURE_DIFFERENTIABLE_IMAGE_TRANSLATION; "CONTINUOUS_MEASURE_TRANSLATION_DIFF",CONTINUOUS_MEASURE_TRANSLATION_DIFF; "CONTINUOUS_MEASURE_TRANSLATION_SYMDIFF",CONTINUOUS_MEASURE_TRANSLATION_SYMDIFF; "CONTINUOUS_MIDPOINT_CONVEX",CONTINUOUS_MIDPOINT_CONVEX; "CONTINUOUS_MIN",CONTINUOUS_MIN; "CONTINUOUS_MIN_1",CONTINUOUS_MIN_1; "CONTINUOUS_MUL",CONTINUOUS_MUL; "CONTINUOUS_NEG",CONTINUOUS_NEG; "CONTINUOUS_ON",CONTINUOUS_ON; "CONTINUOUS_ON_ABS",CONTINUOUS_ON_ABS; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_GEN; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM; "CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM_GEN",CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM_GEN; "CONTINUOUS_ON_ADD",CONTINUOUS_ON_ADD; "CONTINUOUS_ON_AVOID",CONTINUOUS_ON_AVOID; "CONTINUOUS_ON_CASES",CONTINUOUS_ON_CASES; "CONTINUOUS_ON_CASES_1",CONTINUOUS_ON_CASES_1; "CONTINUOUS_ON_CASES_LE",CONTINUOUS_ON_CASES_LE; "CONTINUOUS_ON_CASES_LOCAL",CONTINUOUS_ON_CASES_LOCAL; "CONTINUOUS_ON_CASES_LOCAL_OPEN",CONTINUOUS_ON_CASES_LOCAL_OPEN; "CONTINUOUS_ON_CASES_OPEN",CONTINUOUS_ON_CASES_OPEN; "CONTINUOUS_ON_CLOPEN_INDICATOR",CONTINUOUS_ON_CLOPEN_INDICATOR; "CONTINUOUS_ON_CLOSED",CONTINUOUS_ON_CLOSED; "CONTINUOUS_ON_CLOSED_GEN",CONTINUOUS_ON_CLOSED_GEN; "CONTINUOUS_ON_CLOSEST_POINT",CONTINUOUS_ON_CLOSEST_POINT; "CONTINUOUS_ON_CLOSURE",CONTINUOUS_ON_CLOSURE; "CONTINUOUS_ON_CLOSURE_COMPONENT_GE",CONTINUOUS_ON_CLOSURE_COMPONENT_GE; "CONTINUOUS_ON_CLOSURE_COMPONENT_LE",CONTINUOUS_ON_CLOSURE_COMPONENT_LE; "CONTINUOUS_ON_CLOSURE_NORM_LE",CONTINUOUS_ON_CLOSURE_NORM_LE; "CONTINUOUS_ON_CLOSURE_SEQUENTIALLY",CONTINUOUS_ON_CLOSURE_SEQUENTIALLY; "CONTINUOUS_ON_CMUL",CONTINUOUS_ON_CMUL; "CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION",CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION; "CONTINUOUS_ON_COMPARISON",CONTINUOUS_ON_COMPARISON; "CONTINUOUS_ON_COMPONENTS",CONTINUOUS_ON_COMPONENTS; "CONTINUOUS_ON_COMPONENTS_EQ",CONTINUOUS_ON_COMPONENTS_EQ; "CONTINUOUS_ON_COMPONENTS_FINITE",CONTINUOUS_ON_COMPONENTS_FINITE; "CONTINUOUS_ON_COMPONENTS_GEN",CONTINUOUS_ON_COMPONENTS_GEN; "CONTINUOUS_ON_COMPONENTS_OPEN",CONTINUOUS_ON_COMPONENTS_OPEN; "CONTINUOUS_ON_COMPONENTS_OPEN_EQ",CONTINUOUS_ON_COMPONENTS_OPEN_EQ; "CONTINUOUS_ON_COMPONENTWISE_LIFT",CONTINUOUS_ON_COMPONENTWISE_LIFT; "CONTINUOUS_ON_COMPOSE",CONTINUOUS_ON_COMPOSE; "CONTINUOUS_ON_COMPOSE_QUOTIENT",CONTINUOUS_ON_COMPOSE_QUOTIENT; "CONTINUOUS_ON_CONST",CONTINUOUS_ON_CONST; "CONTINUOUS_ON_CONVOLUTION_L1_LINF",CONTINUOUS_ON_CONVOLUTION_L1_LINF; "CONTINUOUS_ON_CONVOLUTION_LINF_L1",CONTINUOUS_ON_CONVOLUTION_LINF_L1; "CONTINUOUS_ON_DIST_CLOSEST_POINT",CONTINUOUS_ON_DIST_CLOSEST_POINT; "CONTINUOUS_ON_EMPTY",CONTINUOUS_ON_EMPTY; "CONTINUOUS_ON_EQ",CONTINUOUS_ON_EQ; "CONTINUOUS_ON_EQ_CONTINUOUS_AT",CONTINUOUS_ON_EQ_CONTINUOUS_AT; "CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN",CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; "CONTINUOUS_ON_FINITE",CONTINUOUS_ON_FINITE; "CONTINUOUS_ON_FSTCART",CONTINUOUS_ON_FSTCART; "CONTINUOUS_ON_ID",CONTINUOUS_ON_ID; "CONTINUOUS_ON_IMP_BAIRE",CONTINUOUS_ON_IMP_BAIRE; "CONTINUOUS_ON_IMP_CLOSED_IN",CONTINUOUS_ON_IMP_CLOSED_IN; "CONTINUOUS_ON_IMP_OPEN_IN",CONTINUOUS_ON_IMP_OPEN_IN; "CONTINUOUS_ON_INTERIOR",CONTINUOUS_ON_INTERIOR; "CONTINUOUS_ON_INTERMEDIATE_CLOSURE",CONTINUOUS_ON_INTERMEDIATE_CLOSURE; "CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ",CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ; "CONTINUOUS_ON_INTERMEDIATE_CLOSURE_POINTWISE",CONTINUOUS_ON_INTERMEDIATE_CLOSURE_POINTWISE; "CONTINUOUS_ON_INTERVAL_BIJ",CONTINUOUS_ON_INTERVAL_BIJ; "CONTINUOUS_ON_INV",CONTINUOUS_ON_INV; "CONTINUOUS_ON_INVERSE",CONTINUOUS_ON_INVERSE; "CONTINUOUS_ON_INVERSE_CLOSED_MAP",CONTINUOUS_ON_INVERSE_CLOSED_MAP; "CONTINUOUS_ON_INVERSE_OPEN_MAP",CONTINUOUS_ON_INVERSE_OPEN_MAP; "CONTINUOUS_ON_LIFT_ABS",CONTINUOUS_ON_LIFT_ABS; "CONTINUOUS_ON_LIFT_ABS_COMPONENT",CONTINUOUS_ON_LIFT_ABS_COMPONENT; "CONTINUOUS_ON_LIFT_COMPONENT",CONTINUOUS_ON_LIFT_COMPONENT; "CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE",CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; "CONTINUOUS_ON_LIFT_DET",CONTINUOUS_ON_LIFT_DET; "CONTINUOUS_ON_LIFT_DIST",CONTINUOUS_ON_LIFT_DIST; "CONTINUOUS_ON_LIFT_DOT",CONTINUOUS_ON_LIFT_DOT; "CONTINUOUS_ON_LIFT_DOT2",CONTINUOUS_ON_LIFT_DOT2; "CONTINUOUS_ON_LIFT_NORM",CONTINUOUS_ON_LIFT_NORM; "CONTINUOUS_ON_LIFT_NORM_COMPOSE",CONTINUOUS_ON_LIFT_NORM_COMPOSE; "CONTINUOUS_ON_LIFT_POW",CONTINUOUS_ON_LIFT_POW; "CONTINUOUS_ON_LIFT_PRODUCT",CONTINUOUS_ON_LIFT_PRODUCT; "CONTINUOUS_ON_LIFT_RANGE",CONTINUOUS_ON_LIFT_RANGE; "CONTINUOUS_ON_LIFT_SETDIST",CONTINUOUS_ON_LIFT_SETDIST; "CONTINUOUS_ON_LIFT_SQRT",CONTINUOUS_ON_LIFT_SQRT; "CONTINUOUS_ON_LIFT_SQRT_COMPOSE",CONTINUOUS_ON_LIFT_SQRT_COMPOSE; "CONTINUOUS_ON_LINEPATH",CONTINUOUS_ON_LINEPATH; "CONTINUOUS_ON_MATRIX_COMPONENTWISE",CONTINUOUS_ON_MATRIX_COMPONENTWISE; "CONTINUOUS_ON_MAX",CONTINUOUS_ON_MAX; "CONTINUOUS_ON_MAX_1",CONTINUOUS_ON_MAX_1; "CONTINUOUS_ON_MIN",CONTINUOUS_ON_MIN; "CONTINUOUS_ON_MIN_1",CONTINUOUS_ON_MIN_1; "CONTINUOUS_ON_MUL",CONTINUOUS_ON_MUL; "CONTINUOUS_ON_NEG",CONTINUOUS_ON_NEG; "CONTINUOUS_ON_NO_LIMPT",CONTINUOUS_ON_NO_LIMPT; "CONTINUOUS_ON_OPEN",CONTINUOUS_ON_OPEN; "CONTINUOUS_ON_OPEN_AVOID",CONTINUOUS_ON_OPEN_AVOID; "CONTINUOUS_ON_OPEN_GEN",CONTINUOUS_ON_OPEN_GEN; "CONTINUOUS_ON_PASTECART",CONTINUOUS_ON_PASTECART; "CONTINUOUS_ON_PATH_LENGTH_SUBPATH_LEFT",CONTINUOUS_ON_PATH_LENGTH_SUBPATH_LEFT; "CONTINUOUS_ON_PATH_LENGTH_SUBPATH_RIGHT",CONTINUOUS_ON_PATH_LENGTH_SUBPATH_RIGHT; "CONTINUOUS_ON_REFLECT",CONTINUOUS_ON_REFLECT; "CONTINUOUS_ON_RESTRICT",CONTINUOUS_ON_RESTRICT; "CONTINUOUS_ON_SEQUENTIALLY",CONTINUOUS_ON_SEQUENTIALLY; "CONTINUOUS_ON_SING",CONTINUOUS_ON_SING; "CONTINUOUS_ON_SNDCART",CONTINUOUS_ON_SNDCART; "CONTINUOUS_ON_SUB",CONTINUOUS_ON_SUB; "CONTINUOUS_ON_SUBSET",CONTINUOUS_ON_SUBSET; "CONTINUOUS_ON_UNION",CONTINUOUS_ON_UNION; "CONTINUOUS_ON_UNION_LOCAL",CONTINUOUS_ON_UNION_LOCAL; "CONTINUOUS_ON_UNION_LOCAL_OPEN",CONTINUOUS_ON_UNION_LOCAL_OPEN; "CONTINUOUS_ON_UNION_OPEN",CONTINUOUS_ON_UNION_OPEN; "CONTINUOUS_ON_VECTOR_VARIATION",CONTINUOUS_ON_VECTOR_VARIATION; "CONTINUOUS_ON_VMUL",CONTINUOUS_ON_VMUL; "CONTINUOUS_ON_VSUM",CONTINUOUS_ON_VSUM; "CONTINUOUS_OPEN_IN_PREIMAGE",CONTINUOUS_OPEN_IN_PREIMAGE; "CONTINUOUS_OPEN_IN_PREIMAGE_EQ",CONTINUOUS_OPEN_IN_PREIMAGE_EQ; "CONTINUOUS_OPEN_IN_PREIMAGE_GEN",CONTINUOUS_OPEN_IN_PREIMAGE_GEN; "CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET",CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET; "CONTINUOUS_OPEN_PREIMAGE",CONTINUOUS_OPEN_PREIMAGE; "CONTINUOUS_OPEN_PREIMAGE_UNIV",CONTINUOUS_OPEN_PREIMAGE_UNIV; "CONTINUOUS_PASTECART",CONTINUOUS_PASTECART; "CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP; "CONTINUOUS_SNDCART",CONTINUOUS_SNDCART; "CONTINUOUS_SUB",CONTINUOUS_SUB; "CONTINUOUS_TRANSFORM_AT",CONTINUOUS_TRANSFORM_AT; "CONTINUOUS_TRANSFORM_WITHIN",CONTINUOUS_TRANSFORM_WITHIN; "CONTINUOUS_TRANSFORM_WITHIN_OPEN",CONTINUOUS_TRANSFORM_WITHIN_OPEN; "CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN",CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN; "CONTINUOUS_TRANSFORM_WITHIN_SET_IMP",CONTINUOUS_TRANSFORM_WITHIN_SET_IMP; "CONTINUOUS_TRIVIAL_LIMIT",CONTINUOUS_TRIVIAL_LIMIT; "CONTINUOUS_UNIFORMLY_CAUCHY_LIMIT",CONTINUOUS_UNIFORMLY_CAUCHY_LIMIT; "CONTINUOUS_UNIFORM_LIMIT",CONTINUOUS_UNIFORM_LIMIT; "CONTINUOUS_VMUL",CONTINUOUS_VMUL; "CONTINUOUS_VSUM",CONTINUOUS_VSUM; "CONTINUOUS_WITHIN",CONTINUOUS_WITHIN; "CONTINUOUS_WITHIN_AVOID",CONTINUOUS_WITHIN_AVOID; "CONTINUOUS_WITHIN_BALL",CONTINUOUS_WITHIN_BALL; "CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL",CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL; "CONTINUOUS_WITHIN_COMPARISON",CONTINUOUS_WITHIN_COMPARISON; "CONTINUOUS_WITHIN_COMPOSE",CONTINUOUS_WITHIN_COMPOSE; "CONTINUOUS_WITHIN_ID",CONTINUOUS_WITHIN_ID; "CONTINUOUS_WITHIN_LIFT_SQRT",CONTINUOUS_WITHIN_LIFT_SQRT; "CONTINUOUS_WITHIN_OPEN",CONTINUOUS_WITHIN_OPEN; "CONTINUOUS_WITHIN_OPEN_IN",CONTINUOUS_WITHIN_OPEN_IN; "CONTINUOUS_WITHIN_SEQUENTIALLY",CONTINUOUS_WITHIN_SEQUENTIALLY; "CONTINUOUS_WITHIN_SEQUENTIALLY_ALT",CONTINUOUS_WITHIN_SEQUENTIALLY_ALT; "CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP",CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP; "CONTINUOUS_WITHIN_SEQUENTIALLY_INJ",CONTINUOUS_WITHIN_SEQUENTIALLY_INJ; "CONTINUOUS_WITHIN_SQRT_COMPOSE",CONTINUOUS_WITHIN_SQRT_COMPOSE; "CONTINUOUS_WITHIN_SUBSET",CONTINUOUS_WITHIN_SUBSET; "CONTINUUM_UNION_COMPONENTS_COMPLEMENT",CONTINUUM_UNION_COMPONENTS_COMPLEMENT; "CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT",CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT; "CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS",CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS; "CONTRACTIBLE_EMPTY",CONTRACTIBLE_EMPTY; "CONTRACTIBLE_IMP_CONNECTED",CONTRACTIBLE_IMP_CONNECTED; "CONTRACTIBLE_IMP_PATH_CONNECTED",CONTRACTIBLE_IMP_PATH_CONNECTED; "CONTRACTIBLE_IMP_SIMPLY_CONNECTED",CONTRACTIBLE_IMP_SIMPLY_CONNECTED; "CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE",CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE; "CONTRACTIBLE_PCROSS",CONTRACTIBLE_PCROSS; "CONTRACTIBLE_PCROSS_EQ",CONTRACTIBLE_PCROSS_EQ; "CONTRACTIBLE_PUNCTURED_SPHERE",CONTRACTIBLE_PUNCTURED_SPHERE; "CONTRACTIBLE_SING",CONTRACTIBLE_SING; "CONTRACTIBLE_SPHERE",CONTRACTIBLE_SPHERE; "CONTRACTIBLE_TRANSLATION",CONTRACTIBLE_TRANSLATION; "CONTRACTIBLE_UNIV",CONTRACTIBLE_UNIV; "CONTRACTION_IMP_CONTINUOUS_ON",CONTRACTION_IMP_CONTINUOUS_ON; "CONTRACTION_IMP_UNIQUE_FIXPOINT",CONTRACTION_IMP_UNIQUE_FIXPOINT; "CONTRAPOS_THM",CONTRAPOS_THM; "CONVERGENCE_IN_MEASURE",CONVERGENCE_IN_MEASURE; "CONVERGENCE_IN_MEASURE_UNIQUE",CONVERGENCE_IN_MEASURE_UNIQUE; "CONVERGENT_BOUNDED_DECREASING_1",CONVERGENT_BOUNDED_DECREASING_1; "CONVERGENT_BOUNDED_INCREASING",CONVERGENT_BOUNDED_INCREASING; "CONVERGENT_BOUNDED_INCREASING_1",CONVERGENT_BOUNDED_INCREASING_1; "CONVERGENT_BOUNDED_MONOTONE",CONVERGENT_BOUNDED_MONOTONE; "CONVERGENT_BOUNDED_MONOTONE_1",CONVERGENT_BOUNDED_MONOTONE_1; "CONVERGENT_BOUNDED_MONOTONE_EQ",CONVERGENT_BOUNDED_MONOTONE_EQ; "CONVERGENT_EQ_CAUCHY",CONVERGENT_EQ_CAUCHY; "CONVERGENT_EQ_CAUCHY_AT",CONVERGENT_EQ_CAUCHY_AT; "CONVERGENT_EQ_CAUCHY_WITHIN",CONVERGENT_EQ_CAUCHY_WITHIN; "CONVERGENT_EQ_ZERO_OSCILLATION",CONVERGENT_EQ_ZERO_OSCILLATION; "CONVERGENT_IMP_BOUNDED",CONVERGENT_IMP_BOUNDED; "CONVERGENT_IMP_CAUCHY",CONVERGENT_IMP_CAUCHY; "CONVERGENT_OFFSET",CONVERGENT_OFFSET; "CONVERGENT_OFFSET_EQ",CONVERGENT_OFFSET_EQ; "CONVERGENT_OFFSET_REV",CONVERGENT_OFFSET_REV; "CONVERGENT_SUBSEQUENCE",CONVERGENT_SUBSEQUENCE; "CONVEX",CONVEX; "CONVEXITY_PRESERVING",CONVEXITY_PRESERVING; "CONVEXITY_PRESERVING_ALT",CONVEXITY_PRESERVING_ALT; "CONVEXITY_PRESERVING_SHRINK_0",CONVEXITY_PRESERVING_SHRINK_0; "CONVEX_ADD",CONVEX_ADD; "CONVEX_ADD_EQ",CONVEX_ADD_EQ; "CONVEX_AFFINITY",CONVEX_AFFINITY; "CONVEX_AFFINITY_EQ",CONVEX_AFFINITY_EQ; "CONVEX_ALT",CONVEX_ALT; "CONVEX_AND_AFFINE_INTER_OPEN",CONVEX_AND_AFFINE_INTER_OPEN; "CONVEX_BALL",CONVEX_BALL; "CONVEX_BOUNDS_LEMMA",CONVEX_BOUNDS_LEMMA; "CONVEX_CBALL",CONVEX_CBALL; "CONVEX_CLOSED_CONTAINS_SAME_RAY",CONVEX_CLOSED_CONTAINS_SAME_RAY; "CONVEX_CLOSURE",CONVEX_CLOSURE; "CONVEX_CLOSURE_INTERIOR",CONVEX_CLOSURE_INTERIOR; "CONVEX_CLOSURE_RELATIVE_INTERIOR",CONVEX_CLOSURE_RELATIVE_INTERIOR; "CONVEX_CMUL",CONVEX_CMUL; "CONVEX_CONCAVE_EQ_AFFINE",CONVEX_CONCAVE_EQ_AFFINE; "CONVEX_CONE",CONVEX_CONE; "CONVEX_CONE_ADD",CONVEX_CONE_ADD; "CONVEX_CONE_CONTAINS_0",CONVEX_CONE_CONTAINS_0; "CONVEX_CONE_CONVEX_CONE_HULL",CONVEX_CONE_CONVEX_CONE_HULL; "CONVEX_CONE_HALFSPACE_GE",CONVEX_CONE_HALFSPACE_GE; "CONVEX_CONE_HALFSPACE_LE",CONVEX_CONE_HALFSPACE_LE; "CONVEX_CONE_HULL_ADD",CONVEX_CONE_HULL_ADD; "CONVEX_CONE_HULL_CONTAINS_0",CONVEX_CONE_HULL_CONTAINS_0; "CONVEX_CONE_HULL_CONVEX_HULL",CONVEX_CONE_HULL_CONVEX_HULL; "CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY",CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; "CONVEX_CONE_HULL_EMPTY",CONVEX_CONE_HULL_EMPTY; "CONVEX_CONE_HULL_LINEAR_IMAGE",CONVEX_CONE_HULL_LINEAR_IMAGE; "CONVEX_CONE_HULL_MUL",CONVEX_CONE_HULL_MUL; "CONVEX_CONE_HULL_NONEMPTY",CONVEX_CONE_HULL_NONEMPTY; "CONVEX_CONE_HULL_SEPARATE",CONVEX_CONE_HULL_SEPARATE; "CONVEX_CONE_HULL_SEPARATE_NONEMPTY",CONVEX_CONE_HULL_SEPARATE_NONEMPTY; "CONVEX_CONE_HULL_UNION",CONVEX_CONE_HULL_UNION; "CONVEX_CONE_INTERS",CONVEX_CONE_INTERS; "CONVEX_CONE_LINEAR_IMAGE",CONVEX_CONE_LINEAR_IMAGE; "CONVEX_CONE_LINEAR_IMAGE_EQ",CONVEX_CONE_LINEAR_IMAGE_EQ; "CONVEX_CONE_MUL",CONVEX_CONE_MUL; "CONVEX_CONE_NEGATIONS",CONVEX_CONE_NEGATIONS; "CONVEX_CONE_NONEMPTY",CONVEX_CONE_NONEMPTY; "CONVEX_CONE_PCROSS",CONVEX_CONE_PCROSS; "CONVEX_CONE_PCROSS_EQ",CONVEX_CONE_PCROSS_EQ; "CONVEX_CONE_SING",CONVEX_CONE_SING; "CONVEX_CONE_SPAN",CONVEX_CONE_SPAN; "CONVEX_CONE_SUMS",CONVEX_CONE_SUMS; "CONVEX_CONIC_HULL",CONVEX_CONIC_HULL; "CONVEX_CONIC_HULL_VERTEX_IMAGE",CONVEX_CONIC_HULL_VERTEX_IMAGE; "CONVEX_CONNECTED",CONVEX_CONNECTED; "CONVEX_CONNECTED_1",CONVEX_CONNECTED_1; "CONVEX_CONNECTED_1_GEN",CONVEX_CONNECTED_1_GEN; "CONVEX_CONNECTED_COLLINEAR",CONVEX_CONNECTED_COLLINEAR; "CONVEX_CONTAINS_OPEN_SEGMENT",CONVEX_CONTAINS_OPEN_SEGMENT; "CONVEX_CONTAINS_SEGMENT",CONVEX_CONTAINS_SEGMENT; "CONVEX_CONTAINS_SEGMENT_EQ",CONVEX_CONTAINS_SEGMENT_EQ; "CONVEX_CONTAINS_SEGMENT_IMP",CONVEX_CONTAINS_SEGMENT_IMP; "CONVEX_CONVEX_CONE_HULL",CONVEX_CONVEX_CONE_HULL; "CONVEX_CONVEX_HULL",CONVEX_CONVEX_HULL; "CONVEX_DIFFERENCES",CONVEX_DIFFERENCES; "CONVEX_DISTANCE",CONVEX_DISTANCE; "CONVEX_EMPTY",CONVEX_EMPTY; "CONVEX_EPIGRAPH",CONVEX_EPIGRAPH; "CONVEX_EPIGRAPH_CONVEX",CONVEX_EPIGRAPH_CONVEX; "CONVEX_EQ_CONNECTED_LINE_INTERSECTION",CONVEX_EQ_CONNECTED_LINE_INTERSECTION; "CONVEX_EQ_CONVEX_LINE_INTERSECTION",CONVEX_EQ_CONVEX_LINE_INTERSECTION; "CONVEX_EXPLICIT",CONVEX_EXPLICIT; "CONVEX_FACIAL_PARTITION",CONVEX_FACIAL_PARTITION; "CONVEX_FINITE",CONVEX_FINITE; "CONVEX_HALFSPACE_COMPONENT_GE",CONVEX_HALFSPACE_COMPONENT_GE; "CONVEX_HALFSPACE_COMPONENT_GT",CONVEX_HALFSPACE_COMPONENT_GT; "CONVEX_HALFSPACE_COMPONENT_LE",CONVEX_HALFSPACE_COMPONENT_LE; "CONVEX_HALFSPACE_COMPONENT_LT",CONVEX_HALFSPACE_COMPONENT_LT; "CONVEX_HALFSPACE_COMPONENT_SGN",CONVEX_HALFSPACE_COMPONENT_SGN; "CONVEX_HALFSPACE_GE",CONVEX_HALFSPACE_GE; "CONVEX_HALFSPACE_GT",CONVEX_HALFSPACE_GT; "CONVEX_HALFSPACE_INTERSECTION",CONVEX_HALFSPACE_INTERSECTION; "CONVEX_HALFSPACE_LE",CONVEX_HALFSPACE_LE; "CONVEX_HALFSPACE_LT",CONVEX_HALFSPACE_LT; "CONVEX_HALFSPACE_SGN",CONVEX_HALFSPACE_SGN; "CONVEX_HAS_BOUNDED_VARIATION",CONVEX_HAS_BOUNDED_VARIATION; "CONVEX_HAS_BOUNDED_VARIATION_EQ",CONVEX_HAS_BOUNDED_VARIATION_EQ; "CONVEX_HAUSDIST_LIMIT",CONVEX_HAUSDIST_LIMIT; "CONVEX_HULLS_EQ",CONVEX_HULLS_EQ; "CONVEX_HULL_2",CONVEX_HULL_2; "CONVEX_HULL_2_ALT",CONVEX_HULL_2_ALT; "CONVEX_HULL_3",CONVEX_HULL_3; "CONVEX_HULL_3_ALT",CONVEX_HULL_3_ALT; "CONVEX_HULL_AFFINITY",CONVEX_HULL_AFFINITY; "CONVEX_HULL_CARATHEODORY",CONVEX_HULL_CARATHEODORY; "CONVEX_HULL_CARATHEODORY_AFF_DIM",CONVEX_HULL_CARATHEODORY_AFF_DIM; "CONVEX_HULL_CLOSURE",CONVEX_HULL_CLOSURE; "CONVEX_HULL_CLOSURE_SUBSET",CONVEX_HULL_CLOSURE_SUBSET; "CONVEX_HULL_EMPTY",CONVEX_HULL_EMPTY; "CONVEX_HULL_EQ",CONVEX_HULL_EQ; "CONVEX_HULL_EQ_EMPTY",CONVEX_HULL_EQ_EMPTY; "CONVEX_HULL_EQ_SING",CONVEX_HULL_EQ_SING; "CONVEX_HULL_EXCHANGE_INTER",CONVEX_HULL_EXCHANGE_INTER; "CONVEX_HULL_EXCHANGE_UNION",CONVEX_HULL_EXCHANGE_UNION; "CONVEX_HULL_EXPLICIT",CONVEX_HULL_EXPLICIT; "CONVEX_HULL_FINITE",CONVEX_HULL_FINITE; "CONVEX_HULL_FINITE_IMAGE_EXPLICIT",CONVEX_HULL_FINITE_IMAGE_EXPLICIT; "CONVEX_HULL_FINITE_STEP",CONVEX_HULL_FINITE_STEP; "CONVEX_HULL_IMAGE",CONVEX_HULL_IMAGE; "CONVEX_HULL_IMAGE_LT",CONVEX_HULL_IMAGE_LT; "CONVEX_HULL_INDEXED",CONVEX_HULL_INDEXED; "CONVEX_HULL_INSERT",CONVEX_HULL_INSERT; "CONVEX_HULL_INSERT_ALT",CONVEX_HULL_INSERT_ALT; "CONVEX_HULL_INSERT_REDUNDANT_POINT",CONVEX_HULL_INSERT_REDUNDANT_POINT; "CONVEX_HULL_INSERT_SEGMENTS",CONVEX_HULL_INSERT_SEGMENTS; "CONVEX_HULL_INTER",CONVEX_HULL_INTER; "CONVEX_HULL_INTERIOR_SUBSET",CONVEX_HULL_INTERIOR_SUBSET; "CONVEX_HULL_INTERS",CONVEX_HULL_INTERS; "CONVEX_HULL_LINEAR_IMAGE",CONVEX_HULL_LINEAR_IMAGE; "CONVEX_HULL_PCROSS",CONVEX_HULL_PCROSS; "CONVEX_HULL_REDUNDANT_POINT",CONVEX_HULL_REDUNDANT_POINT; "CONVEX_HULL_REDUNDANT_SUBSET",CONVEX_HULL_REDUNDANT_SUBSET; "CONVEX_HULL_REDUNDANT_SUBSET_GEN",CONVEX_HULL_REDUNDANT_SUBSET_GEN; "CONVEX_HULL_REDUNDANT_SUBSET_REV",CONVEX_HULL_REDUNDANT_SUBSET_REV; "CONVEX_HULL_SCALING",CONVEX_HULL_SCALING; "CONVEX_HULL_SING",CONVEX_HULL_SING; "CONVEX_HULL_SPHERE",CONVEX_HULL_SPHERE; "CONVEX_HULL_SUBSET_AFFINE_HULL",CONVEX_HULL_SUBSET_AFFINE_HULL; "CONVEX_HULL_SUBSET_CONVEX_CONE_HULL",CONVEX_HULL_SUBSET_CONVEX_CONE_HULL; "CONVEX_HULL_SUBSET_SPAN",CONVEX_HULL_SUBSET_SPAN; "CONVEX_HULL_SUMS",CONVEX_HULL_SUMS; "CONVEX_HULL_TRANSLATION",CONVEX_HULL_TRANSLATION; "CONVEX_HULL_UNION_EXPLICIT",CONVEX_HULL_UNION_EXPLICIT; "CONVEX_HULL_UNION_NONEMPTY_EXPLICIT",CONVEX_HULL_UNION_NONEMPTY_EXPLICIT; "CONVEX_HULL_UNION_UNIONS",CONVEX_HULL_UNION_UNIONS; "CONVEX_HULL_UNIV",CONVEX_HULL_UNIV; "CONVEX_HYPERPLANE",CONVEX_HYPERPLANE; "CONVEX_IMP_ANR",CONVEX_IMP_ANR; "CONVEX_IMP_AR",CONVEX_IMP_AR; "CONVEX_IMP_BOUNDED_ON_INTERVAL",CONVEX_IMP_BOUNDED_ON_INTERVAL; "CONVEX_IMP_CONTRACTIBLE",CONVEX_IMP_CONTRACTIBLE; "CONVEX_IMP_LIPSCHITZ",CONVEX_IMP_LIPSCHITZ; "CONVEX_IMP_LOCALLY_BOUNDED",CONVEX_IMP_LOCALLY_BOUNDED; "CONVEX_IMP_LOCALLY_CONNECTED",CONVEX_IMP_LOCALLY_CONNECTED; "CONVEX_IMP_LOCALLY_LIPSCHITZ",CONVEX_IMP_LOCALLY_LIPSCHITZ; "CONVEX_IMP_LOCALLY_PATH_CONNECTED",CONVEX_IMP_LOCALLY_PATH_CONNECTED; "CONVEX_IMP_PATH_CONNECTED",CONVEX_IMP_PATH_CONNECTED; "CONVEX_IMP_PIECEWISE_MONOTONE",CONVEX_IMP_PIECEWISE_MONOTONE; "CONVEX_IMP_SIMPLY_CONNECTED",CONVEX_IMP_SIMPLY_CONNECTED; "CONVEX_IMP_STARLIKE",CONVEX_IMP_STARLIKE; "CONVEX_INDEXED",CONVEX_INDEXED; "CONVEX_INNER_APPROXIMATION",CONVEX_INNER_APPROXIMATION; "CONVEX_INNER_POLYTOPE",CONVEX_INNER_POLYTOPE; "CONVEX_INTER",CONVEX_INTER; "CONVEX_INTERIOR",CONVEX_INTERIOR; "CONVEX_INTERIOR_CLOSURE",CONVEX_INTERIOR_CLOSURE; "CONVEX_INTERMEDIATE_BALL",CONVEX_INTERMEDIATE_BALL; "CONVEX_INTERS",CONVEX_INTERS; "CONVEX_INTERVAL",CONVEX_INTERVAL; "CONVEX_LINEAR_IMAGE",CONVEX_LINEAR_IMAGE; "CONVEX_LINEAR_IMAGE_EQ",CONVEX_LINEAR_IMAGE_EQ; "CONVEX_LINEAR_PREIMAGE",CONVEX_LINEAR_PREIMAGE; "CONVEX_LINE_INTERSECTION_UNIQUE_CLOSED",CONVEX_LINE_INTERSECTION_UNIQUE_CLOSED; "CONVEX_LINE_INTERSECTION_UNIQUE_OPEN",CONVEX_LINE_INTERSECTION_UNIQUE_OPEN; "CONVEX_LOCAL_GLOBAL_MINIMUM",CONVEX_LOCAL_GLOBAL_MINIMUM; "CONVEX_LOCAL_GLOBAL_MINIMUM_GEN",CONVEX_LOCAL_GLOBAL_MINIMUM_GEN; "CONVEX_LOCAL_GLOBAL_MINIMUM_SEGMENT",CONVEX_LOCAL_GLOBAL_MINIMUM_SEGMENT; "CONVEX_LOWER",CONVEX_LOWER; "CONVEX_LOWER_SEGMENT",CONVEX_LOWER_SEGMENT; "CONVEX_LOWER_SEGMENT_LT",CONVEX_LOWER_SEGMENT_LT; "CONVEX_MAX",CONVEX_MAX; "CONVEX_NEARBY_IN_SCALING",CONVEX_NEARBY_IN_SCALING; "CONVEX_NEARBY_IN_SCALING_RELATIVE_INTERIOR",CONVEX_NEARBY_IN_SCALING_RELATIVE_INTERIOR; "CONVEX_NEARBY_NOT_IN_SCALING",CONVEX_NEARBY_NOT_IN_SCALING; "CONVEX_NEGATIONS",CONVEX_NEGATIONS; "CONVEX_NORM",CONVEX_NORM; "CONVEX_ON_COMPOSE_LINEAR",CONVEX_ON_COMPOSE_LINEAR; "CONVEX_ON_CONST",CONVEX_ON_CONST; "CONVEX_ON_CONTINUOUS",CONVEX_ON_CONTINUOUS; "CONVEX_ON_CONTINUOUS_ON_RELATIVE_INTERIOR",CONVEX_ON_CONTINUOUS_ON_RELATIVE_INTERIOR; "CONVEX_ON_CONVEX_HULL_BOUND",CONVEX_ON_CONVEX_HULL_BOUND; "CONVEX_ON_CONVEX_HULL_BOUND_EQ",CONVEX_ON_CONVEX_HULL_BOUND_EQ; "CONVEX_ON_COUNTABLE_NONDIFFERENTIABLE",CONVEX_ON_COUNTABLE_NONDIFFERENTIABLE; "CONVEX_ON_DERIVATIVES",CONVEX_ON_DERIVATIVES; "CONVEX_ON_DERIVATIVES_IMP",CONVEX_ON_DERIVATIVES_IMP; "CONVEX_ON_DERIVATIVE_SECANT",CONVEX_ON_DERIVATIVE_SECANT; "CONVEX_ON_DERIVATIVE_SECANT_IMP",CONVEX_ON_DERIVATIVE_SECANT_IMP; "CONVEX_ON_DIRECTIONAL_DERIVATIVES",CONVEX_ON_DIRECTIONAL_DERIVATIVES; "CONVEX_ON_DIRECTIONAL_DERIVATIVE_FUNCTIONS",CONVEX_ON_DIRECTIONAL_DERIVATIVE_FUNCTIONS; "CONVEX_ON_EMPTY",CONVEX_ON_EMPTY; "CONVEX_ON_EPIGRAPH_SLICE_LE",CONVEX_ON_EPIGRAPH_SLICE_LE; "CONVEX_ON_EPIGRAPH_SLICE_LT",CONVEX_ON_EPIGRAPH_SLICE_LT; "CONVEX_ON_EQ",CONVEX_ON_EQ; "CONVEX_ON_IMP_JENSEN",CONVEX_ON_IMP_JENSEN; "CONVEX_ON_IMP_MIDPOINT_CONVEX",CONVEX_ON_IMP_MIDPOINT_CONVEX; "CONVEX_ON_INDEFINITE_INTEGRAL_INCREASING",CONVEX_ON_INDEFINITE_INTEGRAL_INCREASING; "CONVEX_ON_IS_INDEFINITE_INTEGRAL",CONVEX_ON_IS_INDEFINITE_INTEGRAL; "CONVEX_ON_JENSEN",CONVEX_ON_JENSEN; "CONVEX_ON_LEFT_DIFFERENTIABLE",CONVEX_ON_LEFT_DIFFERENTIABLE; "CONVEX_ON_LEFT_SECANT",CONVEX_ON_LEFT_SECANT; "CONVEX_ON_LEFT_SECANT_MUL",CONVEX_ON_LEFT_SECANT_MUL; "CONVEX_ON_MID_SECANT",CONVEX_ON_MID_SECANT; "CONVEX_ON_MID_SECANT_MUL",CONVEX_ON_MID_SECANT_MUL; "CONVEX_ON_RIGHT_DIFFERENTIABLE",CONVEX_ON_RIGHT_DIFFERENTIABLE; "CONVEX_ON_RIGHT_SECANT",CONVEX_ON_RIGHT_SECANT; "CONVEX_ON_RIGHT_SECANT_MUL",CONVEX_ON_RIGHT_SECANT_MUL; "CONVEX_ON_SECANTS_1",CONVEX_ON_SECANTS_1; "CONVEX_ON_SECANTS_1_IMP",CONVEX_ON_SECANTS_1_IMP; "CONVEX_ON_SECANT_DERIVATIVE",CONVEX_ON_SECANT_DERIVATIVE; "CONVEX_ON_SECANT_DERIVATIVE_IMP",CONVEX_ON_SECANT_DERIVATIVE_IMP; "CONVEX_ON_SETDIST",CONVEX_ON_SETDIST; "CONVEX_ON_SING",CONVEX_ON_SING; "CONVEX_ON_SUBSET",CONVEX_ON_SUBSET; "CONVEX_ON_SUP",CONVEX_ON_SUP; "CONVEX_ON_TRANSLATION",CONVEX_ON_TRANSLATION; "CONVEX_OPEN_SEGMENT_CASES",CONVEX_OPEN_SEGMENT_CASES; "CONVEX_OUTER_APPROXIMATION",CONVEX_OUTER_APPROXIMATION; "CONVEX_OUTER_POLYTOPE",CONVEX_OUTER_POLYTOPE; "CONVEX_PCROSS",CONVEX_PCROSS; "CONVEX_PCROSS_EQ",CONVEX_PCROSS_EQ; "CONVEX_POSITIVE_ORTHANT",CONVEX_POSITIVE_ORTHANT; "CONVEX_PREIMAGE_CONCAVE_SCALING",CONVEX_PREIMAGE_CONCAVE_SCALING; "CONVEX_RELATIVE_BOUNDARY_SUBSET_OF_PROPER_FACE",CONVEX_RELATIVE_BOUNDARY_SUBSET_OF_PROPER_FACE; "CONVEX_RELATIVE_INTERIOR",CONVEX_RELATIVE_INTERIOR; "CONVEX_RELATIVE_INTERIOR_CLOSURE",CONVEX_RELATIVE_INTERIOR_CLOSURE; "CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE; "CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE; "CONVEX_SCALING",CONVEX_SCALING; "CONVEX_SCALING_EQ",CONVEX_SCALING_EQ; "CONVEX_SEGMENT",CONVEX_SEGMENT; "CONVEX_SEMIOPEN_SEGMENT",CONVEX_SEMIOPEN_SEGMENT; "CONVEX_SIMPLEX",CONVEX_SIMPLEX; "CONVEX_SING",CONVEX_SING; "CONVEX_SPAN",CONVEX_SPAN; "CONVEX_STANDARD_HYPERPLANE",CONVEX_STANDARD_HYPERPLANE; "CONVEX_STARCENTRES",CONVEX_STARCENTRES; "CONVEX_STRIP_COMPONENT_LE",CONVEX_STRIP_COMPONENT_LE; "CONVEX_STRIP_COMPONENT_LT",CONVEX_STRIP_COMPONENT_LT; "CONVEX_SUMS",CONVEX_SUMS; "CONVEX_SUMS_MULTIPLES",CONVEX_SUMS_MULTIPLES; "CONVEX_SYMDIFF_CLOSE_TO_FRONTIER",CONVEX_SYMDIFF_CLOSE_TO_FRONTIER; "CONVEX_TRANSLATION",CONVEX_TRANSLATION; "CONVEX_TRANSLATION_EQ",CONVEX_TRANSLATION_EQ; "CONVEX_TRANSLATION_SUBSET_PREIMAGE",CONVEX_TRANSLATION_SUBSET_PREIMAGE; "CONVEX_TRANSLATION_SUPERSET_PREIMAGE",CONVEX_TRANSLATION_SUPERSET_PREIMAGE; "CONVEX_UNIONS_FULLDIM_CELLS",CONVEX_UNIONS_FULLDIM_CELLS; "CONVEX_UNIV",CONVEX_UNIV; "CONVEX_VSUM",CONVEX_VSUM; "CONVEX_VSUM_STRONG",CONVEX_VSUM_STRONG; "COPLANAR_2",COPLANAR_2; "COPLANAR_3",COPLANAR_3; "COPLANAR_AFFINE_HULL_COPLANAR",COPLANAR_AFFINE_HULL_COPLANAR; "COPLANAR_AFF_DIM",COPLANAR_AFF_DIM; "COPLANAR_EMPTY",COPLANAR_EMPTY; "COPLANAR_INTERSECTING_LINES",COPLANAR_INTERSECTING_LINES; "COPLANAR_LINEAR_IMAGE",COPLANAR_LINEAR_IMAGE; "COPLANAR_LINEAR_IMAGE_EQ",COPLANAR_LINEAR_IMAGE_EQ; "COPLANAR_SING",COPLANAR_SING; "COPLANAR_SMALL",COPLANAR_SMALL; "COPLANAR_SUBSET",COPLANAR_SUBSET; "COPLANAR_TRANSLATION",COPLANAR_TRANSLATION; "COPLANAR_TRANSLATION_EQ",COPLANAR_TRANSLATION_EQ; "COSMALL_APPROXIMATION",COSMALL_APPROXIMATION; "COUNTABLE",COUNTABLE; "COUNTABLE_ALT",COUNTABLE_ALT; "COUNTABLE_ANR_COMPONENTS",COUNTABLE_ANR_COMPONENTS; "COUNTABLE_ANR_CONNECTED_COMPONENTS",COUNTABLE_ANR_CONNECTED_COMPONENTS; "COUNTABLE_ANR_PATH_COMPONENTS",COUNTABLE_ANR_PATH_COMPONENTS; "COUNTABLE_ASCENDING_CHAIN",COUNTABLE_ASCENDING_CHAIN; "COUNTABLE_ASCENDING_CLOPEN_CHAIN",COUNTABLE_ASCENDING_CLOPEN_CHAIN; "COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN",COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN; "COUNTABLE_AS_IMAGE",COUNTABLE_AS_IMAGE; "COUNTABLE_AS_IMAGE_NUM_SUBSET",COUNTABLE_AS_IMAGE_NUM_SUBSET; "COUNTABLE_AS_IMAGE_SUBSET",COUNTABLE_AS_IMAGE_SUBSET; "COUNTABLE_AS_IMAGE_SUBSET_EQ",COUNTABLE_AS_IMAGE_SUBSET_EQ; "COUNTABLE_AS_INJECTIVE_IMAGE",COUNTABLE_AS_INJECTIVE_IMAGE; "COUNTABLE_AS_INJECTIVE_IMAGE_SUBSET",COUNTABLE_AS_INJECTIVE_IMAGE_SUBSET; "COUNTABLE_CARD_ADD",COUNTABLE_CARD_ADD; "COUNTABLE_CARD_ADD_EQ",COUNTABLE_CARD_ADD_EQ; "COUNTABLE_CARD_MUL",COUNTABLE_CARD_MUL; "COUNTABLE_CARD_MUL_EQ",COUNTABLE_CARD_MUL_EQ; "COUNTABLE_CART",COUNTABLE_CART; "COUNTABLE_CASES",COUNTABLE_CASES; "COUNTABLE_CLOPEN_IN",COUNTABLE_CLOPEN_IN; "COUNTABLE_COMPACT_OPEN_IN",COUNTABLE_COMPACT_OPEN_IN; "COUNTABLE_COMPONENTS",COUNTABLE_COMPONENTS; "COUNTABLE_COMPONENTS_UNION",COUNTABLE_COMPONENTS_UNION; "COUNTABLE_CONNECTED_COMPONENTS",COUNTABLE_CONNECTED_COMPONENTS; "COUNTABLE_CROSS",COUNTABLE_CROSS; "COUNTABLE_DELETE",COUNTABLE_DELETE; "COUNTABLE_DESCENDING_CHAIN",COUNTABLE_DESCENDING_CHAIN; "COUNTABLE_DESCENDING_CLOPEN_CHAIN",COUNTABLE_DESCENDING_CLOPEN_CHAIN; "COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN",COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN; "COUNTABLE_DIFF_FINITE",COUNTABLE_DIFF_FINITE; "COUNTABLE_DISJOINT_NONEMPTY_INTERIOR_SUBSETS",COUNTABLE_DISJOINT_NONEMPTY_INTERIOR_SUBSETS; "COUNTABLE_DISJOINT_OPEN_IN_SUBSETS",COUNTABLE_DISJOINT_OPEN_IN_SUBSETS; "COUNTABLE_DISJOINT_OPEN_SUBSETS",COUNTABLE_DISJOINT_OPEN_SUBSETS; "COUNTABLE_ELEMENTARY_DIVISION",COUNTABLE_ELEMENTARY_DIVISION; "COUNTABLE_EMPTY",COUNTABLE_EMPTY; "COUNTABLE_EMPTY_INTERIOR",COUNTABLE_EMPTY_INTERIOR; "COUNTABLE_ENR_COMPONENTS",COUNTABLE_ENR_COMPONENTS; "COUNTABLE_ENR_CONNECTED_COMPONENTS",COUNTABLE_ENR_CONNECTED_COMPONENTS; "COUNTABLE_ENR_PATH_COMPONENTS",COUNTABLE_ENR_PATH_COMPONENTS; "COUNTABLE_FINITE_SUBSETS",COUNTABLE_FINITE_SUBSETS; "COUNTABLE_FL",COUNTABLE_FL; "COUNTABLE_IMAGE",COUNTABLE_IMAGE; "COUNTABLE_IMAGE_INJ",COUNTABLE_IMAGE_INJ; "COUNTABLE_IMAGE_INJ_EQ",COUNTABLE_IMAGE_INJ_EQ; "COUNTABLE_IMAGE_INJ_GENERAL",COUNTABLE_IMAGE_INJ_GENERAL; "COUNTABLE_IMP_CARD_LT_REAL",COUNTABLE_IMP_CARD_LT_REAL; "COUNTABLE_IMP_DIMENSION_LE_0",COUNTABLE_IMP_DIMENSION_LE_0; "COUNTABLE_IMP_DISCONNECTED",COUNTABLE_IMP_DISCONNECTED; "COUNTABLE_IMP_FSIGMA",COUNTABLE_IMP_FSIGMA; "COUNTABLE_INSERT",COUNTABLE_INSERT; "COUNTABLE_INTEGER",COUNTABLE_INTEGER; "COUNTABLE_INTEGER_COORDINATES",COUNTABLE_INTEGER_COORDINATES; "COUNTABLE_INTER",COUNTABLE_INTER; "COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR",COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR; "COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR",COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR; "COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE",COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE; "COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION",COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION; "COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE",COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE; "COUNTABLE_INTERSECTION_OF_COMPLEMENT",COUNTABLE_INTERSECTION_OF_COMPLEMENT; "COUNTABLE_INTERSECTION_OF_IDEMPOT",COUNTABLE_INTERSECTION_OF_IDEMPOT; "COUNTABLE_INTERSECTION_OF_INC",COUNTABLE_INTERSECTION_OF_INC; "COUNTABLE_INTERSECTION_OF_INTER",COUNTABLE_INTERSECTION_OF_INTER; "COUNTABLE_INTERSECTION_OF_INTERS",COUNTABLE_INTERSECTION_OF_INTERS; "COUNTABLE_INTERSECTION_OF_UNION",COUNTABLE_INTERSECTION_OF_UNION; "COUNTABLE_ISOLATED_SET",COUNTABLE_ISOLATED_SET; "COUNTABLE_LIST",COUNTABLE_LIST; "COUNTABLE_LIST_GEN",COUNTABLE_LIST_GEN; "COUNTABLE_LOCAL_MAXIMA",COUNTABLE_LOCAL_MAXIMA; "COUNTABLE_LOCAL_MINIMA",COUNTABLE_LOCAL_MINIMA; "COUNTABLE_NON_CONDENSATION_POINTS",COUNTABLE_NON_CONDENSATION_POINTS; "COUNTABLE_NON_LIMIT_POINTS",COUNTABLE_NON_LIMIT_POINTS; "COUNTABLE_OPEN_COMPONENTS",COUNTABLE_OPEN_COMPONENTS; "COUNTABLE_OPEN_CONNECTED_COMPONENTS",COUNTABLE_OPEN_CONNECTED_COMPONENTS; "COUNTABLE_OPEN_INTERVAL",COUNTABLE_OPEN_INTERVAL; "COUNTABLE_PATH_COMPONENTS",COUNTABLE_PATH_COMPONENTS; "COUNTABLE_PCROSS",COUNTABLE_PCROSS; "COUNTABLE_PCROSS_EQ",COUNTABLE_PCROSS_EQ; "COUNTABLE_PRODUCT_DEPENDENT",COUNTABLE_PRODUCT_DEPENDENT; "COUNTABLE_RATIONAL",COUNTABLE_RATIONAL; "COUNTABLE_RATIONAL_COORDINATES",COUNTABLE_RATIONAL_COORDINATES; "COUNTABLE_RESTRICT",COUNTABLE_RESTRICT; "COUNTABLE_SING",COUNTABLE_SING; "COUNTABLE_STRICT_LOCAL_MAXIMA",COUNTABLE_STRICT_LOCAL_MAXIMA; "COUNTABLE_STRICT_LOCAL_MINIMA",COUNTABLE_STRICT_LOCAL_MINIMA; "COUNTABLE_SUBSET",COUNTABLE_SUBSET; "COUNTABLE_SUBSET_IMAGE",COUNTABLE_SUBSET_IMAGE; "COUNTABLE_SUBSET_NUM",COUNTABLE_SUBSET_NUM; "COUNTABLE_UNION",COUNTABLE_UNION; "COUNTABLE_UNIONS",COUNTABLE_UNIONS; "COUNTABLE_UNION_IMP",COUNTABLE_UNION_IMP; "COUNTABLE_UNION_OF_ASCENDING",COUNTABLE_UNION_OF_ASCENDING; "COUNTABLE_UNION_OF_BAIRE0_INDICATOR",COUNTABLE_UNION_OF_BAIRE0_INDICATOR; "COUNTABLE_UNION_OF_BAIRE_INDICATOR",COUNTABLE_UNION_OF_BAIRE_INDICATOR; "COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE",COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE; "COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION",COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION; "COUNTABLE_UNION_OF_BIJECTIVE_IMAGE",COUNTABLE_UNION_OF_BIJECTIVE_IMAGE; "COUNTABLE_UNION_OF_COMPLEMENT",COUNTABLE_UNION_OF_COMPLEMENT; "COUNTABLE_UNION_OF_EXPLICIT",COUNTABLE_UNION_OF_EXPLICIT; "COUNTABLE_UNION_OF_IDEMPOT",COUNTABLE_UNION_OF_IDEMPOT; "COUNTABLE_UNION_OF_INC",COUNTABLE_UNION_OF_INC; "COUNTABLE_UNION_OF_INTER",COUNTABLE_UNION_OF_INTER; "COUNTABLE_UNION_OF_RELATIVE_TO",COUNTABLE_UNION_OF_RELATIVE_TO; "COUNTABLE_UNION_OF_UNION",COUNTABLE_UNION_OF_UNION; "COUNTABLE_UNION_OF_UNIONS",COUNTABLE_UNION_OF_UNIONS; "COVARIANCE_MATRIX_EQ_0",COVARIANCE_MATRIX_EQ_0; "COVARIANCE_MATRIX_EQ_SQUARE",COVARIANCE_MATRIX_EQ_SQUARE; "COVARIANCE_MATRIX_INV",COVARIANCE_MATRIX_INV; "COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL",COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL; "COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL_ALT",COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL_ALT; "COVERING_LEMMA",COVERING_LEMMA; "COVERING_SPACE_CLOSED_MAP",COVERING_SPACE_CLOSED_MAP; "COVERING_SPACE_COMPACT",COVERING_SPACE_COMPACT; "COVERING_SPACE_COUNTABLE_SHEETS",COVERING_SPACE_COUNTABLE_SHEETS; "COVERING_SPACE_FIBRE_NO_LIMPT",COVERING_SPACE_FIBRE_NO_LIMPT; "COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE",COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE; "COVERING_SPACE_FINITE_SHEETS",COVERING_SPACE_FINITE_SHEETS; "COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP; "COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG; "COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP; "COVERING_SPACE_HOMEOMORPHISM",COVERING_SPACE_HOMEOMORPHISM; "COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL",COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL; "COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ",COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ; "COVERING_SPACE_IMP_CONTINUOUS",COVERING_SPACE_IMP_CONTINUOUS; "COVERING_SPACE_IMP_SURJECTIVE",COVERING_SPACE_IMP_SURJECTIVE; "COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP",COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP; "COVERING_SPACE_INJECTIVE",COVERING_SPACE_INJECTIVE; "COVERING_SPACE_LIFT",COVERING_SPACE_LIFT; "COVERING_SPACE_LIFT_GENERAL",COVERING_SPACE_LIFT_GENERAL; "COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION",COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION; "COVERING_SPACE_LIFT_HOMOTOPIC_PATH",COVERING_SPACE_LIFT_HOMOTOPIC_PATH; "COVERING_SPACE_LIFT_HOMOTOPIC_PATHS",COVERING_SPACE_LIFT_HOMOTOPIC_PATHS; "COVERING_SPACE_LIFT_HOMOTOPY",COVERING_SPACE_LIFT_HOMOTOPY; "COVERING_SPACE_LIFT_HOMOTOPY_ALT",COVERING_SPACE_LIFT_HOMOTOPY_ALT; "COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION",COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION; "COVERING_SPACE_LIFT_PATH",COVERING_SPACE_LIFT_PATH; "COVERING_SPACE_LIFT_PATH_STRONG",COVERING_SPACE_LIFT_PATH_STRONG; "COVERING_SPACE_LIFT_STRONG",COVERING_SPACE_LIFT_STRONG; "COVERING_SPACE_LIFT_STRONGER",COVERING_SPACE_LIFT_STRONGER; "COVERING_SPACE_LIFT_UNIQUE",COVERING_SPACE_LIFT_UNIQUE; "COVERING_SPACE_LIFT_UNIQUE_GEN",COVERING_SPACE_LIFT_UNIQUE_GEN; "COVERING_SPACE_LIFT_UNIQUE_IDENTITY",COVERING_SPACE_LIFT_UNIQUE_IDENTITY; "COVERING_SPACE_LOCALIZED_HOMEOMORPHISM",COVERING_SPACE_LOCALIZED_HOMEOMORPHISM; "COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT",COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT; "COVERING_SPACE_LOCALLY",COVERING_SPACE_LOCALLY; "COVERING_SPACE_LOCALLY_COMPACT",COVERING_SPACE_LOCALLY_COMPACT; "COVERING_SPACE_LOCALLY_COMPACT_EQ",COVERING_SPACE_LOCALLY_COMPACT_EQ; "COVERING_SPACE_LOCALLY_CONNECTED",COVERING_SPACE_LOCALLY_CONNECTED; "COVERING_SPACE_LOCALLY_CONNECTED_EQ",COVERING_SPACE_LOCALLY_CONNECTED_EQ; "COVERING_SPACE_LOCALLY_EQ",COVERING_SPACE_LOCALLY_EQ; "COVERING_SPACE_LOCALLY_HOMEOMORPHIC",COVERING_SPACE_LOCALLY_HOMEOMORPHIC; "COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ",COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ; "COVERING_SPACE_LOCALLY_PATH_CONNECTED",COVERING_SPACE_LOCALLY_PATH_CONNECTED; "COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ",COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ; "COVERING_SPACE_LOCAL_HOMEOMORPHISM",COVERING_SPACE_LOCAL_HOMEOMORPHISM; "COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT",COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT; "COVERING_SPACE_MONODROMY",COVERING_SPACE_MONODROMY; "COVERING_SPACE_OPEN_MAP",COVERING_SPACE_OPEN_MAP; "COVERING_SPACE_QUOTIENT_MAP",COVERING_SPACE_QUOTIENT_MAP; "COVERING_SPACE_SELF_FINITE_FUNDAMENTAL_GROUP",COVERING_SPACE_SELF_FINITE_FUNDAMENTAL_GROUP; "COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP",COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP; "CRAMER",CRAMER; "CRAMER_LEMMA",CRAMER_LEMMA; "CRAMER_LEMMA_TRANSP",CRAMER_LEMMA_TRANSP; "CRAMER_MATRIX_LEFT",CRAMER_MATRIX_LEFT; "CRAMER_MATRIX_LEFT_INVERSE",CRAMER_MATRIX_LEFT_INVERSE; "CRAMER_MATRIX_RIGHT",CRAMER_MATRIX_RIGHT; "CRAMER_MATRIX_RIGHT_INVERSE",CRAMER_MATRIX_RIGHT_INVERSE; "CROSS",CROSS; "CROSS_DIFF",CROSS_DIFF; "CROSS_EMPTY",CROSS_EMPTY; "CROSS_EQ",CROSS_EQ; "CROSS_EQ_EMPTY",CROSS_EQ_EMPTY; "CROSS_INTER",CROSS_INTER; "CROSS_INTERS",CROSS_INTERS; "CROSS_INTERS_INTERS",CROSS_INTERS_INTERS; "CROSS_MONO",CROSS_MONO; "CROSS_UNION",CROSS_UNION; "CROSS_UNIONS",CROSS_UNIONS; "CROSS_UNIONS_UNIONS",CROSS_UNIONS_UNIONS; "CROSS_UNIV",CROSS_UNIV; "CURRY_DEF",CURRY_DEF; "DARBOUX_AND_REGULATED_IMP_CONTINUOUS",DARBOUX_AND_REGULATED_IMP_CONTINUOUS; "DECIMAL",DECIMAL; "DECOMPOSITION",DECOMPOSITION; "DECREASING_BOUNDED_VARIATION",DECREASING_BOUNDED_VARIATION; "DECREASING_BOUNDED_VARIATION_GEN",DECREASING_BOUNDED_VARIATION_GEN; "DECREASING_CLOSED_NEST",DECREASING_CLOSED_NEST; "DECREASING_CLOSED_NEST_SING",DECREASING_CLOSED_NEST_SING; "DECREASING_COUNTABLE_DISCONTINUITIES",DECREASING_COUNTABLE_DISCONTINUITIES; "DECREASING_LEFT_LIMIT_1",DECREASING_LEFT_LIMIT_1; "DECREASING_LEFT_LIMIT_1_GEN",DECREASING_LEFT_LIMIT_1_GEN; "DECREASING_RIGHT_LIMIT_1",DECREASING_RIGHT_LIMIT_1; "DECREASING_RIGHT_LIMIT_1_GEN",DECREASING_RIGHT_LIMIT_1_GEN; "DECREASING_VECTOR_VARIATION",DECREASING_VECTOR_VARIATION; "DEFORMATION_RETRACT",DEFORMATION_RETRACT; "DEFORMATION_RETRACTION_COMPOSE",DEFORMATION_RETRACTION_COMPOSE; "DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT",DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT; "DEFORMATION_RETRACT_OF_CONTRACTIBLE",DEFORMATION_RETRACT_OF_CONTRACTIBLE; "DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING",DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING; "DEFORMATION_RETRACT_TRANS",DEFORMATION_RETRACT_TRANS; "DELETE",DELETE; "DELETE_COMM",DELETE_COMM; "DELETE_DELETE",DELETE_DELETE; "DELETE_INSERT",DELETE_INSERT; "DELETE_INTER",DELETE_INTER; "DELETE_NON_ELEMENT",DELETE_NON_ELEMENT; "DELETE_SUBSET",DELETE_SUBSET; "DENSE_ACCESSIBLE_FRONTIER_POINTS",DENSE_ACCESSIBLE_FRONTIER_POINTS; "DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED",DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED; "DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS",DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS; "DENSE_COMPLEMENT_AFFINE",DENSE_COMPLEMENT_AFFINE; "DENSE_COMPLEMENT_CONVEX",DENSE_COMPLEMENT_CONVEX; "DENSE_COMPLEMENT_CONVEX_CLOSED",DENSE_COMPLEMENT_CONVEX_CLOSED; "DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL",DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL; "DENSE_COMPLEMENT_SUBSPACE",DENSE_COMPLEMENT_SUBSPACE; "DENSE_GDELTA_IMP_LARGE",DENSE_GDELTA_IMP_LARGE; "DENSE_IMP_PERFECT",DENSE_IMP_PERFECT; "DENSE_INTERSECTS_OPEN",DENSE_INTERSECTS_OPEN; "DENSE_LIMIT_POINTS",DENSE_LIMIT_POINTS; "DENSE_OPEN_INTER",DENSE_OPEN_INTER; "DENSE_OPEN_INTERS",DENSE_OPEN_INTERS; "DEPENDENT_2",DEPENDENT_2; "DEPENDENT_3",DEPENDENT_3; "DEPENDENT_AFFINE_DEPENDENT_CASES",DEPENDENT_AFFINE_DEPENDENT_CASES; "DEPENDENT_BIGGERSET",DEPENDENT_BIGGERSET; "DEPENDENT_BIGGERSET_GENERAL",DEPENDENT_BIGGERSET_GENERAL; "DEPENDENT_CHOICE",DEPENDENT_CHOICE; "DEPENDENT_CHOICE_FIXED",DEPENDENT_CHOICE_FIXED; "DEPENDENT_EQ_DIM_LT_CARD",DEPENDENT_EQ_DIM_LT_CARD; "DEPENDENT_EXPLICIT",DEPENDENT_EXPLICIT; "DEPENDENT_FINITE",DEPENDENT_FINITE; "DEPENDENT_IMP_AFFINE_DEPENDENT",DEPENDENT_IMP_AFFINE_DEPENDENT; "DEPENDENT_LINEAR_IMAGE",DEPENDENT_LINEAR_IMAGE; "DEPENDENT_LINEAR_IMAGE_EQ",DEPENDENT_LINEAR_IMAGE_EQ; "DEPENDENT_MONO",DEPENDENT_MONO; "DEPENDENT_SING",DEPENDENT_SING; "DERIVED_SET_OF_EMPTY",DERIVED_SET_OF_EMPTY; "DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE",DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE; "DERIVED_SET_OF_MONO",DERIVED_SET_OF_MONO; "DERIVED_SET_OF_RESTRICT",DERIVED_SET_OF_RESTRICT; "DERIVED_SET_OF_SUBSET_CLOSURE_OF",DERIVED_SET_OF_SUBSET_CLOSURE_OF; "DERIVED_SET_OF_SUBSET_SUBTOPOLOGY",DERIVED_SET_OF_SUBSET_SUBTOPOLOGY; "DERIVED_SET_OF_SUBSET_TOPSPACE",DERIVED_SET_OF_SUBSET_TOPSPACE; "DERIVED_SET_OF_SUBTOPOLOGY",DERIVED_SET_OF_SUBTOPOLOGY; "DERIVED_SET_OF_TRANSLATION",DERIVED_SET_OF_TRANSLATION; "DERIVED_SET_OF_UNION",DERIVED_SET_OF_UNION; "DERIVED_SET_OF_UNIONS",DERIVED_SET_OF_UNIONS; "DEST_MK_MULTIVECTOR",DEST_MK_MULTIVECTOR; "DEST_REC_INJ",DEST_REC_INJ; "DET_0",DET_0; "DET_1",DET_1; "DET_1_GEN",DET_1_GEN; "DET_2",DET_2; "DET_3",DET_3; "DET_4",DET_4; "DET_CMUL",DET_CMUL; "DET_COFACTOR",DET_COFACTOR; "DET_COFACTOR_EXPANSION",DET_COFACTOR_EXPANSION; "DET_DEPENDENT_COLUMNS",DET_DEPENDENT_COLUMNS; "DET_DEPENDENT_ROWS",DET_DEPENDENT_ROWS; "DET_DIAGONAL",DET_DIAGONAL; "DET_EQ_0",DET_EQ_0; "DET_EQ_0_RANK",DET_EQ_0_RANK; "DET_I",DET_I; "DET_IDENTICAL_COLUMNS",DET_IDENTICAL_COLUMNS; "DET_IDENTICAL_ROWS",DET_IDENTICAL_ROWS; "DET_LE_ONORM_POW",DET_LE_ONORM_POW; "DET_LINEAR_ROWS",DET_LINEAR_ROWS; "DET_LINEAR_ROWS_VSUM",DET_LINEAR_ROWS_VSUM; "DET_LINEAR_ROWS_VSUM_LEMMA",DET_LINEAR_ROWS_VSUM_LEMMA; "DET_LINEAR_ROW_VSUM",DET_LINEAR_ROW_VSUM; "DET_LOWERTRIANGULAR",DET_LOWERTRIANGULAR; "DET_MAPROWS_LINEAR",DET_MAPROWS_LINEAR; "DET_MATRIX_EQ_0",DET_MATRIX_EQ_0; "DET_MATRIX_EQ_0_LEFT",DET_MATRIX_EQ_0_LEFT; "DET_MATRIX_EQ_0_RIGHT",DET_MATRIX_EQ_0_RIGHT; "DET_MATRIX_INV",DET_MATRIX_INV; "DET_MATRIX_REFLECT_ALONG",DET_MATRIX_REFLECT_ALONG; "DET_MUL",DET_MUL; "DET_NEG",DET_NEG; "DET_OPEN_MAP",DET_OPEN_MAP; "DET_ORDERED_SIMPLEX_EQ_0",DET_ORDERED_SIMPLEX_EQ_0; "DET_ORDERED_SIMPLEX_EQ_0_GEN",DET_ORDERED_SIMPLEX_EQ_0_GEN; "DET_ORDERED_SIMPLEX_NZ",DET_ORDERED_SIMPLEX_NZ; "DET_ORTHOGONAL_MATRIX",DET_ORTHOGONAL_MATRIX; "DET_PERMUTE_COLUMNS",DET_PERMUTE_COLUMNS; "DET_PERMUTE_ROWS",DET_PERMUTE_ROWS; "DET_POSITIVE_DEFINITE",DET_POSITIVE_DEFINITE; "DET_POSITIVE_SEMIDEFINITE",DET_POSITIVE_SEMIDEFINITE; "DET_ROWS_MUL",DET_ROWS_MUL; "DET_ROW_ADD",DET_ROW_ADD; "DET_ROW_MUL",DET_ROW_MUL; "DET_ROW_OPERATION",DET_ROW_OPERATION; "DET_ROW_SPAN",DET_ROW_SPAN; "DET_SIMILAR",DET_SIMILAR; "DET_TRANSP",DET_TRANSP; "DET_UPPERTRIANGULAR",DET_UPPERTRIANGULAR; "DET_ZERO_COLUMN",DET_ZERO_COLUMN; "DET_ZERO_ROW",DET_ZERO_ROW; "DE_MORGAN_THM",DE_MORGAN_THM; "DIAGONAL_MATRIX",DIAGONAL_MATRIX; "DIAGONAL_MATRIX_ADD",DIAGONAL_MATRIX_ADD; "DIAGONAL_MATRIX_CMUL",DIAGONAL_MATRIX_CMUL; "DIAGONAL_MATRIX_INV",DIAGONAL_MATRIX_INV; "DIAGONAL_MATRIX_INV_COMPONENT",DIAGONAL_MATRIX_INV_COMPONENT; "DIAGONAL_MATRIX_INV_EXPLICIT",DIAGONAL_MATRIX_INV_EXPLICIT; "DIAGONAL_MATRIX_MAT",DIAGONAL_MATRIX_MAT; "DIAGONAL_MATRIX_MUL",DIAGONAL_MATRIX_MUL; "DIAGONAL_MATRIX_MUL_COMPONENT",DIAGONAL_MATRIX_MUL_COMPONENT; "DIAGONAL_MATRIX_MUL_EQ",DIAGONAL_MATRIX_MUL_EQ; "DIAGONAL_MATRIX_MUL_EXPLICIT",DIAGONAL_MATRIX_MUL_EXPLICIT; "DIAGONAL_POSITIVE_DEFINITE",DIAGONAL_POSITIVE_DEFINITE; "DIAGONAL_POSITIVE_SEMIDEFINITE",DIAGONAL_POSITIVE_SEMIDEFINITE; "DIAMETERS_HAUSDIST_BOUND",DIAMETERS_HAUSDIST_BOUND; "DIAMETER_AFFINITY",DIAMETER_AFFINITY; "DIAMETER_ATTAINED_FRONTIER",DIAMETER_ATTAINED_FRONTIER; "DIAMETER_ATTAINED_RELATIVE_FRONTIER",DIAMETER_ATTAINED_RELATIVE_FRONTIER; "DIAMETER_BALL",DIAMETER_BALL; "DIAMETER_BOUNDED",DIAMETER_BOUNDED; "DIAMETER_BOUNDED_BOUND",DIAMETER_BOUNDED_BOUND; "DIAMETER_BOUNDED_BOUND_LT",DIAMETER_BOUNDED_BOUND_LT; "DIAMETER_CBALL",DIAMETER_CBALL; "DIAMETER_CLOSURE",DIAMETER_CLOSURE; "DIAMETER_COMPACT_ATTAINED",DIAMETER_COMPACT_ATTAINED; "DIAMETER_CONVEX_HULL",DIAMETER_CONVEX_HULL; "DIAMETER_EMPTY",DIAMETER_EMPTY; "DIAMETER_EQ_0",DIAMETER_EQ_0; "DIAMETER_FRONTIER",DIAMETER_FRONTIER; "DIAMETER_INTERVAL",DIAMETER_INTERVAL; "DIAMETER_LE",DIAMETER_LE; "DIAMETER_LE_SUMS_LEFT",DIAMETER_LE_SUMS_LEFT; "DIAMETER_LE_SUMS_RIGHT",DIAMETER_LE_SUMS_RIGHT; "DIAMETER_LINEAR_IMAGE",DIAMETER_LINEAR_IMAGE; "DIAMETER_LT_SUMS_LEFT",DIAMETER_LT_SUMS_LEFT; "DIAMETER_LT_SUMS_RIGHT",DIAMETER_LT_SUMS_RIGHT; "DIAMETER_POS_LE",DIAMETER_POS_LE; "DIAMETER_RELATIVE_FRONTIER",DIAMETER_RELATIVE_FRONTIER; "DIAMETER_SCALING",DIAMETER_SCALING; "DIAMETER_SEGMENT",DIAMETER_SEGMENT; "DIAMETER_SIMPLEX",DIAMETER_SIMPLEX; "DIAMETER_SING",DIAMETER_SING; "DIAMETER_SPHERE",DIAMETER_SPHERE; "DIAMETER_SUBSET",DIAMETER_SUBSET; "DIAMETER_SUBSET_CBALL",DIAMETER_SUBSET_CBALL; "DIAMETER_SUBSET_CBALL_NONEMPTY",DIAMETER_SUBSET_CBALL_NONEMPTY; "DIAMETER_SUMS",DIAMETER_SUMS; "DIAMETER_TRANSLATION",DIAMETER_TRANSLATION; "DIAMETER_UNION_LE",DIAMETER_UNION_LE; "DIFF",DIFF; "DIFFERENTIABLE_ADD",DIFFERENTIABLE_ADD; "DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON",DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; "DIFFERENTIABLE_AT_LIFT_DOT2",DIFFERENTIABLE_AT_LIFT_DOT2; "DIFFERENTIABLE_AT_WITHIN",DIFFERENTIABLE_AT_WITHIN; "DIFFERENTIABLE_BOUND",DIFFERENTIABLE_BOUND; "DIFFERENTIABLE_CHAIN_AT",DIFFERENTIABLE_CHAIN_AT; "DIFFERENTIABLE_CHAIN_WITHIN",DIFFERENTIABLE_CHAIN_WITHIN; "DIFFERENTIABLE_CMUL",DIFFERENTIABLE_CMUL; "DIFFERENTIABLE_COMPONENTWISE_AT",DIFFERENTIABLE_COMPONENTWISE_AT; "DIFFERENTIABLE_COMPONENTWISE_WITHIN",DIFFERENTIABLE_COMPONENTWISE_WITHIN; "DIFFERENTIABLE_CONST",DIFFERENTIABLE_CONST; "DIFFERENTIABLE_COUNTABLE_PREIMAGES",DIFFERENTIABLE_COUNTABLE_PREIMAGES; "DIFFERENTIABLE_DISCRETE_PREIMAGES",DIFFERENTIABLE_DISCRETE_PREIMAGES; "DIFFERENTIABLE_DISCRETE_PREIMAGES_CLOSED",DIFFERENTIABLE_DISCRETE_PREIMAGES_CLOSED; "DIFFERENTIABLE_FINITE_PREIMAGES",DIFFERENTIABLE_FINITE_PREIMAGES; "DIFFERENTIABLE_FINITE_PREIMAGES_GEN",DIFFERENTIABLE_FINITE_PREIMAGES_GEN; "DIFFERENTIABLE_ID",DIFFERENTIABLE_ID; "DIFFERENTIABLE_IMP_CONTINUOUS_AT",DIFFERENTIABLE_IMP_CONTINUOUS_AT; "DIFFERENTIABLE_IMP_CONTINUOUS_ON",DIFFERENTIABLE_IMP_CONTINUOUS_ON; "DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN",DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; "DIFFERENTIABLE_IMP_OPEN_MAP",DIFFERENTIABLE_IMP_OPEN_MAP; "DIFFERENTIABLE_IMP_OPEN_MAP_ALT",DIFFERENTIABLE_IMP_OPEN_MAP_ALT; "DIFFERENTIABLE_IMP_OPEN_MAP_GEN",DIFFERENTIABLE_IMP_OPEN_MAP_GEN; "DIFFERENTIABLE_LIFT_COMPONENT",DIFFERENTIABLE_LIFT_COMPONENT; "DIFFERENTIABLE_LINEAR",DIFFERENTIABLE_LINEAR; "DIFFERENTIABLE_MUL_AT",DIFFERENTIABLE_MUL_AT; "DIFFERENTIABLE_MUL_WITHIN",DIFFERENTIABLE_MUL_WITHIN; "DIFFERENTIABLE_NEG",DIFFERENTIABLE_NEG; "DIFFERENTIABLE_ON_ADD",DIFFERENTIABLE_ON_ADD; "DIFFERENTIABLE_ON_COMPOSE",DIFFERENTIABLE_ON_COMPOSE; "DIFFERENTIABLE_ON_CONST",DIFFERENTIABLE_ON_CONST; "DIFFERENTIABLE_ON_EMPTY",DIFFERENTIABLE_ON_EMPTY; "DIFFERENTIABLE_ON_EQ",DIFFERENTIABLE_ON_EQ; "DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT",DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; "DIFFERENTIABLE_ON_ID",DIFFERENTIABLE_ON_ID; "DIFFERENTIABLE_ON_LIFT_DOT2",DIFFERENTIABLE_ON_LIFT_DOT2; "DIFFERENTIABLE_ON_LINEAR",DIFFERENTIABLE_ON_LINEAR; "DIFFERENTIABLE_ON_MUL",DIFFERENTIABLE_ON_MUL; "DIFFERENTIABLE_ON_NEG",DIFFERENTIABLE_ON_NEG; "DIFFERENTIABLE_ON_REFLECT",DIFFERENTIABLE_ON_REFLECT; "DIFFERENTIABLE_ON_SQNORM",DIFFERENTIABLE_ON_SQNORM; "DIFFERENTIABLE_ON_SUB",DIFFERENTIABLE_ON_SUB; "DIFFERENTIABLE_ON_SUBSET",DIFFERENTIABLE_ON_SUBSET; "DIFFERENTIABLE_SQNORM_AT",DIFFERENTIABLE_SQNORM_AT; "DIFFERENTIABLE_SUB",DIFFERENTIABLE_SUB; "DIFFERENTIABLE_TRANSFORM_AT",DIFFERENTIABLE_TRANSFORM_AT; "DIFFERENTIABLE_TRANSFORM_WITHIN",DIFFERENTIABLE_TRANSFORM_WITHIN; "DIFFERENTIABLE_VSUM",DIFFERENTIABLE_VSUM; "DIFFERENTIABLE_VSUM_NUMSEG",DIFFERENTIABLE_VSUM_NUMSEG; "DIFFERENTIABLE_WITHIN_LIFT_DOT2",DIFFERENTIABLE_WITHIN_LIFT_DOT2; "DIFFERENTIABLE_WITHIN_OPEN",DIFFERENTIABLE_WITHIN_OPEN; "DIFFERENTIABLE_WITHIN_SUBSET",DIFFERENTIABLE_WITHIN_SUBSET; "DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM",DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM; "DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM",DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM; "DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN",DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN; "DIFFERENTIAL_ZERO_LEVELSET_DENSITY",DIFFERENTIAL_ZERO_LEVELSET_DENSITY; "DIFFERENTIAL_ZERO_MAXMIN",DIFFERENTIAL_ZERO_MAXMIN; "DIFFERENTIAL_ZERO_MAXMIN_COMPONENT",DIFFERENTIAL_ZERO_MAXMIN_COMPONENT; "DIFFERENTIAL_ZERO_MAXMIN_DENSITY",DIFFERENTIAL_ZERO_MAXMIN_DENSITY; "DIFFERENT_NORM_3_COLLINEAR_POINTS",DIFFERENT_NORM_3_COLLINEAR_POINTS; "DIFFS_AFFINE_HULL_SPAN",DIFFS_AFFINE_HULL_SPAN; "DIFF_CHAIN_AT",DIFF_CHAIN_AT; "DIFF_CHAIN_WITHIN",DIFF_CHAIN_WITHIN; "DIFF_CLOSURE_SUBSET",DIFF_CLOSURE_SUBSET; "DIFF_DIFF",DIFF_DIFF; "DIFF_EMPTY",DIFF_EMPTY; "DIFF_EQ_EMPTY",DIFF_EQ_EMPTY; "DIFF_INSERT",DIFF_INSERT; "DIFF_INTERS",DIFF_INTERS; "DIFF_UNIONS",DIFF_UNIONS; "DIFF_UNIONS_NONEMPTY",DIFF_UNIONS_NONEMPTY; "DIFF_UNIONS_PAIRWISE_DISJOINT",DIFF_UNIONS_PAIRWISE_DISJOINT; "DIFF_UNIV",DIFF_UNIV; "DIMENSION_ATMOST_RATIONAL_COORDINATES",DIMENSION_ATMOST_RATIONAL_COORDINATES; "DIMENSION_COMPLEMENT_RATIONAL_COORDINATES",DIMENSION_COMPLEMENT_RATIONAL_COORDINATES; "DIMENSION_DECOMPOSITION",DIMENSION_DECOMPOSITION; "DIMENSION_DELETE",DIMENSION_DELETE; "DIMENSION_DIMENSION_LE",DIMENSION_DIMENSION_LE; "DIMENSION_EMPTY",DIMENSION_EMPTY; "DIMENSION_EQ_AFF_DIM",DIMENSION_EQ_AFF_DIM; "DIMENSION_EQ_FULL",DIMENSION_EQ_FULL; "DIMENSION_EQ_FULL_ALT",DIMENSION_EQ_FULL_ALT; "DIMENSION_EQ_FULL_GEN",DIMENSION_EQ_FULL_GEN; "DIMENSION_EQ_LOCALLY_CLOPEN",DIMENSION_EQ_LOCALLY_CLOPEN; "DIMENSION_EQ_MINUS1",DIMENSION_EQ_MINUS1; "DIMENSION_EQ_ON_NBDS",DIMENSION_EQ_ON_NBDS; "DIMENSION_EQ_ON_OPEN_SUBSETS",DIMENSION_EQ_ON_OPEN_SUBSETS; "DIMENSION_EXACTLY_RATIONAL_COORDINATES",DIMENSION_EXACTLY_RATIONAL_COORDINATES; "DIMENSION_FRONTIER_BOUNDED_OPEN",DIMENSION_FRONTIER_BOUNDED_OPEN; "DIMENSION_FRONTIER_NONDENSE_OPEN",DIMENSION_FRONTIER_NONDENSE_OPEN; "DIMENSION_GE",DIMENSION_GE; "DIMENSION_INSERT",DIMENSION_INSERT; "DIMENSION_LE_AFF_DIM",DIMENSION_LE_AFF_DIM; "DIMENSION_LE_BOUND",DIMENSION_LE_BOUND; "DIMENSION_LE_CASES",DIMENSION_LE_CASES; "DIMENSION_LE_CLOSED_IN_UNIONS",DIMENSION_LE_CLOSED_IN_UNIONS; "DIMENSION_LE_DIMINDEX",DIMENSION_LE_DIMINDEX; "DIMENSION_LE_EQ",DIMENSION_LE_EQ; "DIMENSION_LE_EQ_ALT",DIMENSION_LE_EQ_ALT; "DIMENSION_LE_EQ_EMPTY",DIMENSION_LE_EQ_EMPTY; "DIMENSION_LE_EQ_GEN",DIMENSION_LE_EQ_GEN; "DIMENSION_LE_EQ_GENERAL",DIMENSION_LE_EQ_GENERAL; "DIMENSION_LE_EQ_LOCAL",DIMENSION_LE_EQ_LOCAL; "DIMENSION_LE_EQ_LOCALLY",DIMENSION_LE_EQ_LOCALLY; "DIMENSION_LE_EQ_SUBTOPOLOGY",DIMENSION_LE_EQ_SUBTOPOLOGY; "DIMENSION_LE_IMP_GE",DIMENSION_LE_IMP_GE; "DIMENSION_LE_INDUCT",DIMENSION_LE_INDUCT; "DIMENSION_LE_MINUS1",DIMENSION_LE_MINUS1; "DIMENSION_LE_MONO",DIMENSION_LE_MONO; "DIMENSION_LE_RATIONAL_COORDINATES",DIMENSION_LE_RATIONAL_COORDINATES; "DIMENSION_LE_RULES",DIMENSION_LE_RULES; "DIMENSION_LE_SUBTOPOLOGIES",DIMENSION_LE_SUBTOPOLOGIES; "DIMENSION_LE_SUBTOPOLOGY",DIMENSION_LE_SUBTOPOLOGY; "DIMENSION_LE_UNION",DIMENSION_LE_UNION; "DIMENSION_LE_UNIONS",DIMENSION_LE_UNIONS; "DIMENSION_LE_UNIONS_RELATIVE",DIMENSION_LE_UNIONS_RELATIVE; "DIMENSION_LE_UNIONS_ZERODIMENSIONAL",DIMENSION_LE_UNIONS_ZERODIMENSIONAL; "DIMENSION_LE_UNIONS_ZERODIMENSIONAL_EQ",DIMENSION_LE_UNIONS_ZERODIMENSIONAL_EQ; "DIMENSION_LE_UNION_CLOSED_IN",DIMENSION_LE_UNION_CLOSED_IN; "DIMENSION_LE_UNION_GEN",DIMENSION_LE_UNION_GEN; "DIMENSION_LE_UNION_RELATIVE",DIMENSION_LE_UNION_RELATIVE; "DIMENSION_LE_UNION_RELATIVE_GEN",DIMENSION_LE_UNION_RELATIVE_GEN; "DIMENSION_LINEAR_IMAGE",DIMENSION_LINEAR_IMAGE; "DIMENSION_LT_FULL",DIMENSION_LT_FULL; "DIMENSION_LT_FULL_ALT",DIMENSION_LT_FULL_ALT; "DIMENSION_LT_FULL_GEN",DIMENSION_LT_FULL_GEN; "DIMENSION_NONEMPTY_INTERIOR",DIMENSION_NONEMPTY_INTERIOR; "DIMENSION_OPEN",DIMENSION_OPEN; "DIMENSION_OPEN_IN_CONVEX",DIMENSION_OPEN_IN_CONVEX; "DIMENSION_PCROSS_EQ_0",DIMENSION_PCROSS_EQ_0; "DIMENSION_PCROSS_LE",DIMENSION_PCROSS_LE; "DIMENSION_POS_LE",DIMENSION_POS_LE; "DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN",DIMENSION_RELATIVE_FRONTIER_BOUNDED_OPEN; "DIMENSION_RELATIVE_FRONTIER_CONVEX",DIMENSION_RELATIVE_FRONTIER_CONVEX; "DIMENSION_RELATIVE_FRONTIER_NONDENSE_OPEN",DIMENSION_RELATIVE_FRONTIER_NONDENSE_OPEN; "DIMENSION_SEPARATION_THEOREM",DIMENSION_SEPARATION_THEOREM; "DIMENSION_SING",DIMENSION_SING; "DIMENSION_SPHERE",DIMENSION_SPHERE; "DIMENSION_SPHERE_INTER_AFFINE",DIMENSION_SPHERE_INTER_AFFINE; "DIMENSION_SUBSET",DIMENSION_SUBSET; "DIMENSION_SUBSET_EXISTS",DIMENSION_SUBSET_EXISTS; "DIMENSION_SUBSPACE",DIMENSION_SUBSPACE; "DIMENSION_TRANSLATION",DIMENSION_TRANSLATION; "DIMENSION_UNION_LE_BASIC",DIMENSION_UNION_LE_BASIC; "DIMENSION_UNIV",DIMENSION_UNIV; "DIMENSION_ZERO_REDUCTION_THEOREM",DIMENSION_ZERO_REDUCTION_THEOREM; "DIMENSION_ZERO_REDUCTION_THEOREM_2",DIMENSION_ZERO_REDUCTION_THEOREM_2; "DIMENSION_ZERO_SEPARATION_THEOREM",DIMENSION_ZERO_SEPARATION_THEOREM; "DIMINDEX_1",DIMINDEX_1; "DIMINDEX_2",DIMINDEX_2; "DIMINDEX_3",DIMINDEX_3; "DIMINDEX_4",DIMINDEX_4; "DIMINDEX_FINITE_DIFF",DIMINDEX_FINITE_DIFF; "DIMINDEX_FINITE_IMAGE",DIMINDEX_FINITE_IMAGE; "DIMINDEX_FINITE_PROD",DIMINDEX_FINITE_PROD; "DIMINDEX_FINITE_SUM",DIMINDEX_FINITE_SUM; "DIMINDEX_GE_1",DIMINDEX_GE_1; "DIMINDEX_HAS_SIZE_FINITE_DIFF",DIMINDEX_HAS_SIZE_FINITE_DIFF; "DIMINDEX_HAS_SIZE_FINITE_PROD",DIMINDEX_HAS_SIZE_FINITE_PROD; "DIMINDEX_HAS_SIZE_FINITE_SUM",DIMINDEX_HAS_SIZE_FINITE_SUM; "DIMINDEX_MULTIVECTOR",DIMINDEX_MULTIVECTOR; "DIMINDEX_NONZERO",DIMINDEX_NONZERO; "DIMINDEX_UNIQUE",DIMINDEX_UNIQUE; "DIMINDEX_UNIV",DIMINDEX_UNIV; "DIM_BASIS_IMAGE",DIM_BASIS_IMAGE; "DIM_CLOSURE",DIM_CLOSURE; "DIM_CONIC_HULL",DIM_CONIC_HULL; "DIM_CONVEX_HULL",DIM_CONVEX_HULL; "DIM_DIMENSION",DIM_DIMENSION; "DIM_EMPTY",DIM_EMPTY; "DIM_EQ_0",DIM_EQ_0; "DIM_EQ_CARD",DIM_EQ_CARD; "DIM_EQ_FULL",DIM_EQ_FULL; "DIM_EQ_HYPERPLANE",DIM_EQ_HYPERPLANE; "DIM_EQ_SPAN",DIM_EQ_SPAN; "DIM_EQ_SUBSPACE",DIM_EQ_SUBSPACE; "DIM_EQ_SUBSPACES",DIM_EQ_SUBSPACES; "DIM_HYPERPLANE",DIM_HYPERPLANE; "DIM_IMAGE_KERNEL",DIM_IMAGE_KERNEL; "DIM_IMAGE_KERNEL_GEN",DIM_IMAGE_KERNEL_GEN; "DIM_IMAGE_SCALE",DIM_IMAGE_SCALE; "DIM_INJECTIVE_LINEAR_IMAGE",DIM_INJECTIVE_LINEAR_IMAGE; "DIM_INJECTIVE_ON_LINEAR_IMAGE",DIM_INJECTIVE_ON_LINEAR_IMAGE; "DIM_INSERT",DIM_INSERT; "DIM_INSERT_0",DIM_INSERT_0; "DIM_KERNEL_COMPOSE",DIM_KERNEL_COMPOSE; "DIM_LE_CARD",DIM_LE_CARD; "DIM_LINEAR_IMAGE_LE",DIM_LINEAR_IMAGE_LE; "DIM_NONEMPTY_INTERIOR",DIM_NONEMPTY_INTERIOR; "DIM_OPEN",DIM_OPEN; "DIM_OPEN_IN",DIM_OPEN_IN; "DIM_ORTHOGONAL_SUM",DIM_ORTHOGONAL_SUM; "DIM_PCROSS",DIM_PCROSS; "DIM_PCROSS_STRONG",DIM_PCROSS_STRONG; "DIM_PSUBSET",DIM_PSUBSET; "DIM_ROWS_LE_DIM_COLUMNS",DIM_ROWS_LE_DIM_COLUMNS; "DIM_SING",DIM_SING; "DIM_SPAN",DIM_SPAN; "DIM_SPECIAL_HYPERPLANE",DIM_SPECIAL_HYPERPLANE; "DIM_SPECIAL_SUBSPACE",DIM_SPECIAL_SUBSPACE; "DIM_SUBSET",DIM_SUBSET; "DIM_SUBSET_UNIV",DIM_SUBSET_UNIV; "DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS",DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS; "DIM_SUBSTANDARD",DIM_SUBSTANDARD; "DIM_SUMS_INTER",DIM_SUMS_INTER; "DIM_UNION_INTER",DIM_UNION_INTER; "DIM_UNIQUE",DIM_UNIQUE; "DIM_UNIV",DIM_UNIV; "DINI",DINI; "DISCRETE_BOUNDED_IMP_FINITE",DISCRETE_BOUNDED_IMP_FINITE; "DISCRETE_EQ_FINITE_BOUNDED",DISCRETE_EQ_FINITE_BOUNDED; "DISCRETE_EQ_FINITE_BOUNDED_CLOSED",DISCRETE_EQ_FINITE_BOUNDED_CLOSED; "DISCRETE_EQ_FINITE_COMPACT",DISCRETE_EQ_FINITE_COMPACT; "DISCRETE_IMP_CLOSED",DISCRETE_IMP_CLOSED; "DISCRETE_IMP_COUNTABLE",DISCRETE_IMP_COUNTABLE; "DISCRETE_SET",DISCRETE_SET; "DISJOINT",DISJOINT; "DISJOINT_AFFINE_HULL",DISJOINT_AFFINE_HULL; "DISJOINT_DELETE_SYM",DISJOINT_DELETE_SYM; "DISJOINT_EMPTY",DISJOINT_EMPTY; "DISJOINT_EMPTY_REFL",DISJOINT_EMPTY_REFL; "DISJOINT_HALFSPACES_IMP_COLLINEAR",DISJOINT_HALFSPACES_IMP_COLLINEAR; "DISJOINT_HYPERPLANES_IMP_COLLINEAR",DISJOINT_HYPERPLANES_IMP_COLLINEAR; "DISJOINT_INSERT",DISJOINT_INSERT; "DISJOINT_INTERVAL",DISJOINT_INTERVAL; "DISJOINT_INTERVAL_1",DISJOINT_INTERVAL_1; "DISJOINT_MBALL",DISJOINT_MBALL; "DISJOINT_NUMSEG",DISJOINT_NUMSEG; "DISJOINT_RELATIVE_INTERIOR_CONVEX_HULL",DISJOINT_RELATIVE_INTERIOR_CONVEX_HULL; "DISJOINT_SYM",DISJOINT_SYM; "DISJOINT_UNION",DISJOINT_UNION; "DISJ_ACI",DISJ_ACI; "DISJ_ASSOC",DISJ_ASSOC; "DISJ_SYM",DISJ_SYM; "DISTANCE_ATTAINS_INF",DISTANCE_ATTAINS_INF; "DISTANCE_ATTAINS_SUP",DISTANCE_ATTAINS_SUP; "DIST_0",DIST_0; "DIST_1",DIST_1; "DIST_ADD2",DIST_ADD2; "DIST_ADD2_REV",DIST_ADD2_REV; "DIST_ADDBOUND",DIST_ADDBOUND; "DIST_CLOSEST_POINT_LIPSCHITZ",DIST_CLOSEST_POINT_LIPSCHITZ; "DIST_CONVEX_HULL_BOUND_2",DIST_CONVEX_HULL_BOUND_2; "DIST_CONVEX_HULL_BOUND_EQ",DIST_CONVEX_HULL_BOUND_EQ; "DIST_DECREASES_CLOSED_SEGMENT",DIST_DECREASES_CLOSED_SEGMENT; "DIST_DECREASES_OPEN_SEGMENT",DIST_DECREASES_OPEN_SEGMENT; "DIST_DESCALE",DIST_DESCALE; "DIST_ELIM_THM",DIST_ELIM_THM; "DIST_ENDPOINTS_LE_PATH_LENGTH",DIST_ENDPOINTS_LE_PATH_LENGTH; "DIST_EQ",DIST_EQ; "DIST_EQ_0",DIST_EQ_0; "DIST_FSTCART",DIST_FSTCART; "DIST_INCREASES_ONLINE",DIST_INCREASES_ONLINE; "DIST_IN_CLOSED_SEGMENT",DIST_IN_CLOSED_SEGMENT; "DIST_IN_CLOSED_SEGMENT_2",DIST_IN_CLOSED_SEGMENT_2; "DIST_IN_OPEN_SEGMENT",DIST_IN_OPEN_SEGMENT; "DIST_LADD",DIST_LADD; "DIST_LADD_0",DIST_LADD_0; "DIST_LE_0",DIST_LE_0; "DIST_LE_CASES",DIST_LE_CASES; "DIST_LE_DIAMETER",DIST_LE_DIAMETER; "DIST_LE_PASTECART",DIST_LE_PASTECART; "DIST_LIFT",DIST_LIFT; "DIST_LMUL",DIST_LMUL; "DIST_LZERO",DIST_LZERO; "DIST_MIDPOINT",DIST_MIDPOINT; "DIST_MUL",DIST_MUL; "DIST_NZ",DIST_NZ; "DIST_PASTECART_CANCEL",DIST_PASTECART_CANCEL; "DIST_PASTECART_LE",DIST_PASTECART_LE; "DIST_POINTS_LE_PATH_LENGTH",DIST_POINTS_LE_PATH_LENGTH; "DIST_POS_LE",DIST_POS_LE; "DIST_POS_LT",DIST_POS_LT; "DIST_RADD",DIST_RADD; "DIST_RADD_0",DIST_RADD_0; "DIST_REAL",DIST_REAL; "DIST_REFL",DIST_REFL; "DIST_RESCALE",DIST_RESCALE; "DIST_RMUL",DIST_RMUL; "DIST_RZERO",DIST_RZERO; "DIST_SNDCART",DIST_SNDCART; "DIST_SYM",DIST_SYM; "DIST_TRIANGLE",DIST_TRIANGLE; "DIST_TRIANGLES_LE",DIST_TRIANGLES_LE; "DIST_TRIANGLE_ADD",DIST_TRIANGLE_ADD; "DIST_TRIANGLE_ADD_HALF",DIST_TRIANGLE_ADD_HALF; "DIST_TRIANGLE_ALT",DIST_TRIANGLE_ALT; "DIST_TRIANGLE_EQ",DIST_TRIANGLE_EQ; "DIST_TRIANGLE_HALF_L",DIST_TRIANGLE_HALF_L; "DIST_TRIANGLE_HALF_R",DIST_TRIANGLE_HALF_R; "DIST_TRIANGLE_LE",DIST_TRIANGLE_LE; "DIST_TRIANGLE_LT",DIST_TRIANGLE_LT; "DIVIDES_LE",DIVIDES_LE; "DIVISION",DIVISION; "DIVISION_0",DIVISION_0; "DIVISION_1_SORT",DIVISION_1_SORT; "DIVISION_COMMON_POINT_BOUND",DIVISION_COMMON_POINT_BOUND; "DIVISION_CONTAINS",DIVISION_CONTAINS; "DIVISION_DISJOINT_UNION",DIVISION_DISJOINT_UNION; "DIVISION_DOUBLESPLIT",DIVISION_DOUBLESPLIT; "DIVISION_INTER",DIVISION_INTER; "DIVISION_INTER_1",DIVISION_INTER_1; "DIVISION_OF",DIVISION_OF; "DIVISION_OF_AFFINITY",DIVISION_OF_AFFINITY; "DIVISION_OF_CLOSED",DIVISION_OF_CLOSED; "DIVISION_OF_CONTENT_0",DIVISION_OF_CONTENT_0; "DIVISION_OF_FINITE",DIVISION_OF_FINITE; "DIVISION_OF_NONTRIVIAL",DIVISION_OF_NONTRIVIAL; "DIVISION_OF_REFLECT",DIVISION_OF_REFLECT; "DIVISION_OF_SELF",DIVISION_OF_SELF; "DIVISION_OF_SING",DIVISION_OF_SING; "DIVISION_OF_SUBSET",DIVISION_OF_SUBSET; "DIVISION_OF_TAGGED_DIVISION",DIVISION_OF_TAGGED_DIVISION; "DIVISION_OF_TRANSLATION",DIVISION_OF_TRANSLATION; "DIVISION_OF_TRIVIAL",DIVISION_OF_TRIVIAL; "DIVISION_OF_UNIONS",DIVISION_OF_UNIONS; "DIVISION_OF_UNION_SELF",DIVISION_OF_UNION_SELF; "DIVISION_POINTS_FINITE",DIVISION_POINTS_FINITE; "DIVISION_POINTS_PSUBSET",DIVISION_POINTS_PSUBSET; "DIVISION_POINTS_SUBSET",DIVISION_POINTS_SUBSET; "DIVISION_SIMP",DIVISION_SIMP; "DIVISION_SPLIT",DIVISION_SPLIT; "DIVISION_SPLIT_LEFT_INJ",DIVISION_SPLIT_LEFT_INJ; "DIVISION_SPLIT_RIGHT_INJ",DIVISION_SPLIT_RIGHT_INJ; "DIVISION_UNION_INTERVALS_EXISTS",DIVISION_UNION_INTERVALS_EXISTS; "DIVMOD_ELIM_THM",DIVMOD_ELIM_THM; "DIVMOD_ELIM_THM'",DIVMOD_ELIM_THM'; "DIVMOD_EXIST",DIVMOD_EXIST; "DIVMOD_EXIST_0",DIVMOD_EXIST_0; "DIVMOD_UNIQ",DIVMOD_UNIQ; "DIVMOD_UNIQ_LEMMA",DIVMOD_UNIQ_LEMMA; "DIV_0",DIV_0; "DIV_1",DIV_1; "DIV_ADD_MOD",DIV_ADD_MOD; "DIV_DIV",DIV_DIV; "DIV_EQ_0",DIV_EQ_0; "DIV_EQ_EXCLUSION",DIV_EQ_EXCLUSION; "DIV_LE",DIV_LE; "DIV_LE_EXCLUSION",DIV_LE_EXCLUSION; "DIV_LT",DIV_LT; "DIV_MOD",DIV_MOD; "DIV_MONO",DIV_MONO; "DIV_MONO2",DIV_MONO2; "DIV_MONO_LT",DIV_MONO_LT; "DIV_MULT",DIV_MULT; "DIV_MULT2",DIV_MULT2; "DIV_MULT_ADD",DIV_MULT_ADD; "DIV_MUL_LE",DIV_MUL_LE; "DIV_REFL",DIV_REFL; "DIV_UNIQ",DIV_UNIQ; "DOMINATED_CONVERGENCE",DOMINATED_CONVERGENCE; "DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE",DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE; "DOMINATED_CONVERGENCE_AE",DOMINATED_CONVERGENCE_AE; "DOMINATED_CONVERGENCE_INTEGRABLE",DOMINATED_CONVERGENCE_INTEGRABLE; "DOT_1",DOT_1; "DOT_2",DOT_2; "DOT_3",DOT_3; "DOT_4",DOT_4; "DOT_BASIS",DOT_BASIS; "DOT_BASIS_BASIS",DOT_BASIS_BASIS; "DOT_BASIS_BASIS_UNEQUAL",DOT_BASIS_BASIS_UNEQUAL; "DOT_CAUCHY_SCHWARZ_EQUAL",DOT_CAUCHY_SCHWARZ_EQUAL; "DOT_DROPOUT",DOT_DROPOUT; "DOT_EQ_0",DOT_EQ_0; "DOT_LADD",DOT_LADD; "DOT_LMUL",DOT_LMUL; "DOT_LMUL_MATRIX",DOT_LMUL_MATRIX; "DOT_LNEG",DOT_LNEG; "DOT_LSUB",DOT_LSUB; "DOT_LSUM",DOT_LSUM; "DOT_LZERO",DOT_LZERO; "DOT_MATRIX_PRODUCT",DOT_MATRIX_PRODUCT; "DOT_MATRIX_TRANSP_LMUL",DOT_MATRIX_TRANSP_LMUL; "DOT_MATRIX_TRANSP_RMUL",DOT_MATRIX_TRANSP_RMUL; "DOT_MATRIX_VECTOR_MUL",DOT_MATRIX_VECTOR_MUL; "DOT_NORM",DOT_NORM; "DOT_NORM_NEG",DOT_NORM_NEG; "DOT_NORM_SUB",DOT_NORM_SUB; "DOT_PASTECART",DOT_PASTECART; "DOT_POS_LE",DOT_POS_LE; "DOT_POS_LT",DOT_POS_LT; "DOT_PUSHIN",DOT_PUSHIN; "DOT_RADD",DOT_RADD; "DOT_RMUL",DOT_RMUL; "DOT_RNEG",DOT_RNEG; "DOT_ROWVECTOR_COLUMNVECTOR",DOT_ROWVECTOR_COLUMNVECTOR; "DOT_RSUB",DOT_RSUB; "DOT_RSUM",DOT_RSUM; "DOT_RZERO",DOT_RZERO; "DOT_SQUARE_NORM",DOT_SQUARE_NORM; "DOT_SYM",DOT_SYM; "DOUBLE_INTEGRABLE_CONVOLUTION",DOUBLE_INTEGRABLE_CONVOLUTION; "DOUBLE_INTEGRAL_CONVOLUTION",DOUBLE_INTEGRAL_CONVOLUTION; "DOUBLE_LEBESGUE_MEASURABLE",DOUBLE_LEBESGUE_MEASURABLE; "DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION",DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION; "DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION_GEN",DOUBLE_LEBESGUE_MEASURABLE_INVERSE_FUNCTION_GEN; "DOUBLE_LEBESGUE_MEASURABLE_LEFT_INVERSE",DOUBLE_LEBESGUE_MEASURABLE_LEFT_INVERSE; "DOUBLE_LEBESGUE_MEASURABLE_ON",DOUBLE_LEBESGUE_MEASURABLE_ON; "DOUBLE_LEBESGUE_MEASURABLE_RIGHT_INVERSE",DOUBLE_LEBESGUE_MEASURABLE_RIGHT_INVERSE; "DROPOUT_0",DROPOUT_0; "DROPOUT_ADD",DROPOUT_ADD; "DROPOUT_EQ",DROPOUT_EQ; "DROPOUT_GALOIS",DROPOUT_GALOIS; "DROPOUT_MUL",DROPOUT_MUL; "DROPOUT_PUSHIN",DROPOUT_PUSHIN; "DROPOUT_SUB",DROPOUT_SUB; "DROP_ADD",DROP_ADD; "DROP_BASIS",DROP_BASIS; "DROP_CMUL",DROP_CMUL; "DROP_DIFFERENTIAL_NEG_AT_MAXIMUM",DROP_DIFFERENTIAL_NEG_AT_MAXIMUM; "DROP_DIFFERENTIAL_POS_AT_MINIMUM",DROP_DIFFERENTIAL_POS_AT_MINIMUM; "DROP_EQ",DROP_EQ; "DROP_EQ_0",DROP_EQ_0; "DROP_INDICATOR",DROP_INDICATOR; "DROP_INDICATOR_ABS_LE_1",DROP_INDICATOR_ABS_LE_1; "DROP_INDICATOR_LE_1",DROP_INDICATOR_LE_1; "DROP_INDICATOR_POS_LE",DROP_INDICATOR_POS_LE; "DROP_IN_IMAGE_DROP",DROP_IN_IMAGE_DROP; "DROP_LAMBDA",DROP_LAMBDA; "DROP_MIDPOINT",DROP_MIDPOINT; "DROP_NEG",DROP_NEG; "DROP_SUB",DROP_SUB; "DROP_VEC",DROP_VEC; "DROP_VSUM",DROP_VSUM; "DROP_WLOG_LE",DROP_WLOG_LE; "DSUM_BOUND",DSUM_BOUND; "DUGUNDJI",DUGUNDJI; "EDELSTEIN_FIX",EDELSTEIN_FIX; "EDELSTEIN_FIX_ITER",EDELSTEIN_FIX_ITER; "EDGE_OF_IMP_SUBSET",EDGE_OF_IMP_SUBSET; "EDGE_OF_LINEAR_IMAGE",EDGE_OF_LINEAR_IMAGE; "EDGE_OF_TRANSLATION_EQ",EDGE_OF_TRANSLATION_EQ; "EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS",EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS; "EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS",EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS; "EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS",EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS; "EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS",EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS; "EGOROV",EGOROV; "EIGENVALUES_CHARACTERISTIC",EIGENVALUES_CHARACTERISTIC; "EIGENVALUES_CHARACTERISTIC_ALT",EIGENVALUES_CHARACTERISTIC_ALT; "EIGENVALUE_LOWERBOUND_DOT",EIGENVALUE_LOWERBOUND_DOT; "EIGENVALUE_LOWERBOUND_DOT_EQ",EIGENVALUE_LOWERBOUND_DOT_EQ; "EL",EL; "ELEMENTARY_BOUNDED",ELEMENTARY_BOUNDED; "ELEMENTARY_COMPACT",ELEMENTARY_COMPACT; "ELEMENTARY_EMPTY",ELEMENTARY_EMPTY; "ELEMENTARY_INTER",ELEMENTARY_INTER; "ELEMENTARY_INTERS",ELEMENTARY_INTERS; "ELEMENTARY_INTERVAL",ELEMENTARY_INTERVAL; "ELEMENTARY_SUBSET_INTERVAL",ELEMENTARY_SUBSET_INTERVAL; "ELEMENTARY_UNION",ELEMENTARY_UNION; "ELEMENTARY_UNIONS_INTERVALS",ELEMENTARY_UNIONS_INTERVALS; "ELEMENTARY_UNION_INTERVAL",ELEMENTARY_UNION_INTERVAL; "ELEMENTARY_UNION_INTERVAL_STRONG",ELEMENTARY_UNION_INTERVAL_STRONG; "ELEMENT_LE_SUP",ELEMENT_LE_SUP; "EL_APPEND",EL_APPEND; "EL_CONS",EL_CONS; "EL_LIST_OF_SEQ",EL_LIST_OF_SEQ; "EL_MAP",EL_MAP; "EL_TL",EL_TL; "EMPTY",EMPTY; "EMPTY_AS_INTERVAL",EMPTY_AS_INTERVAL; "EMPTY_DELETE",EMPTY_DELETE; "EMPTY_DIFF",EMPTY_DIFF; "EMPTY_DIVISION_OF",EMPTY_DIVISION_OF; "EMPTY_EXPOSED_FACE_OF",EMPTY_EXPOSED_FACE_OF; "EMPTY_FACE_OF",EMPTY_FACE_OF; "EMPTY_GSPEC",EMPTY_GSPEC; "EMPTY_IMP_COMPACT_IN",EMPTY_IMP_COMPACT_IN; "EMPTY_INSIDE_PSUBSET_CONVEX_FRONTIER",EMPTY_INSIDE_PSUBSET_CONVEX_FRONTIER; "EMPTY_INTERIOR_AFFINE_HULL",EMPTY_INTERIOR_AFFINE_HULL; "EMPTY_INTERIOR_AFF_DIM",EMPTY_INTERIOR_AFF_DIM; "EMPTY_INTERIOR_CONVEX_HULL",EMPTY_INTERIOR_CONVEX_HULL; "EMPTY_INTERIOR_FINITE",EMPTY_INTERIOR_FINITE; "EMPTY_INTERIOR_LOWDIM",EMPTY_INTERIOR_LOWDIM; "EMPTY_INTERIOR_OF_AFF_DIM",EMPTY_INTERIOR_OF_AFF_DIM; "EMPTY_INTERIOR_SUBSET_HYPERPLANE",EMPTY_INTERIOR_SUBSET_HYPERPLANE; "EMPTY_NOT_UNIV",EMPTY_NOT_UNIV; "EMPTY_SUBSET",EMPTY_SUBSET; "EMPTY_UNION",EMPTY_UNION; "EMPTY_UNIONS",EMPTY_UNIONS; "ENDPOINTS_NOT_IN_INTERIOR_SIMPLE_PATH_IMAGE",ENDPOINTS_NOT_IN_INTERIOR_SIMPLE_PATH_IMAGE; "ENDPOINTS_SHIFTPATH",ENDPOINTS_SHIFTPATH; "ENDS_IN_INTERVAL",ENDS_IN_INTERVAL; "ENDS_IN_SEGMENT",ENDS_IN_SEGMENT; "ENDS_IN_UNIT_INTERVAL",ENDS_IN_UNIT_INTERVAL; "ENDS_NOT_IN_SEGMENT",ENDS_NOT_IN_SEGMENT; "ENR",ENR; "ENR_ANR",ENR_ANR; "ENR_BALL",ENR_BALL; "ENR_BOUNDED",ENR_BOUNDED; "ENR_CBALL",ENR_CBALL; "ENR_CLOSED_UNION",ENR_CLOSED_UNION; "ENR_CLOSED_UNION_LOCAL",ENR_CLOSED_UNION_LOCAL; "ENR_CLOSURE_FROM_FRONTIER",ENR_CLOSURE_FROM_FRONTIER; "ENR_COMPONENTWISE",ENR_COMPONENTWISE; "ENR_COMPONENT_ENR",ENR_COMPONENT_ENR; "ENR_CONNECTED_COMPONENT_ENR",ENR_CONNECTED_COMPONENT_ENR; "ENR_CONVEX_CLOSED",ENR_CONVEX_CLOSED; "ENR_COVERING_SPACE",ENR_COVERING_SPACE; "ENR_COVERING_SPACE_EQ",ENR_COVERING_SPACE_EQ; "ENR_DELETE",ENR_DELETE; "ENR_EMPTY",ENR_EMPTY; "ENR_FINITE_UNIONS_CONVEX_CLOSED",ENR_FINITE_UNIONS_CONVEX_CLOSED; "ENR_FROM_UNION_AND_INTER",ENR_FROM_UNION_AND_INTER; "ENR_FROM_UNION_AND_INTER_GEN",ENR_FROM_UNION_AND_INTER_GEN; "ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; "ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; "ENR_IMP_ANR",ENR_IMP_ANR; "ENR_IMP_FSGIMA",ENR_IMP_FSGIMA; "ENR_IMP_GDELTA",ENR_IMP_GDELTA; "ENR_IMP_LOCALLY_COMPACT",ENR_IMP_LOCALLY_COMPACT; "ENR_IMP_LOCALLY_CONNECTED",ENR_IMP_LOCALLY_CONNECTED; "ENR_IMP_LOCALLY_PATH_CONNECTED",ENR_IMP_LOCALLY_PATH_CONNECTED; "ENR_INSERT",ENR_INSERT; "ENR_INTERIOR",ENR_INTERIOR; "ENR_INTERVAL",ENR_INTERVAL; "ENR_INTER_CLOSED_OPEN",ENR_INTER_CLOSED_OPEN; "ENR_LINEAR_IMAGE_EQ",ENR_LINEAR_IMAGE_EQ; "ENR_LOCALLY",ENR_LOCALLY; "ENR_NEIGHBORHOOD_RETRACT",ENR_NEIGHBORHOOD_RETRACT; "ENR_OPEN_IN",ENR_OPEN_IN; "ENR_OPEN_UNION",ENR_OPEN_UNION; "ENR_OPEN_UNIONS",ENR_OPEN_UNIONS; "ENR_PATH_COMPONENT_ENR",ENR_PATH_COMPONENT_ENR; "ENR_PATH_IMAGE_SIMPLE_PATH",ENR_PATH_IMAGE_SIMPLE_PATH; "ENR_PCROSS",ENR_PCROSS; "ENR_PCROSS_EQ",ENR_PCROSS_EQ; "ENR_RELATIVE_FRONTIER_CONVEX",ENR_RELATIVE_FRONTIER_CONVEX; "ENR_RELATIVE_INTERIOR",ENR_RELATIVE_INTERIOR; "ENR_RETRACT_OF_ENR",ENR_RETRACT_OF_ENR; "ENR_SIMPLICIAL_COMPLEX",ENR_SIMPLICIAL_COMPLEX; "ENR_SING",ENR_SING; "ENR_SPHERE",ENR_SPHERE; "ENR_TRANSLATION",ENR_TRANSLATION; "ENR_TRIANGULATION",ENR_TRIANGULATION; "ENR_UNIV",ENR_UNIV; "EPSILON_DELTA_MINIMAL",EPSILON_DELTA_MINIMAL; "EQUIINTEGRABLE_ADD",EQUIINTEGRABLE_ADD; "EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS; "EQUIINTEGRABLE_CMUL",EQUIINTEGRABLE_CMUL; "EQUIINTEGRABLE_DIVISION",EQUIINTEGRABLE_DIVISION; "EQUIINTEGRABLE_EQ",EQUIINTEGRABLE_EQ; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE; "EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT; "EQUIINTEGRABLE_LIMIT",EQUIINTEGRABLE_LIMIT; "EQUIINTEGRABLE_NEG",EQUIINTEGRABLE_NEG; "EQUIINTEGRABLE_ON_NULL",EQUIINTEGRABLE_ON_NULL; "EQUIINTEGRABLE_ON_SING",EQUIINTEGRABLE_ON_SING; "EQUIINTEGRABLE_ON_SPLIT",EQUIINTEGRABLE_ON_SPLIT; "EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS; "EQUIINTEGRABLE_REFLECT",EQUIINTEGRABLE_REFLECT; "EQUIINTEGRABLE_SUB",EQUIINTEGRABLE_SUB; "EQUIINTEGRABLE_SUBSET",EQUIINTEGRABLE_SUBSET; "EQUIINTEGRABLE_SUM",EQUIINTEGRABLE_SUM; "EQUIINTEGRABLE_UNIFORM_LIMIT",EQUIINTEGRABLE_UNIFORM_LIMIT; "EQUIINTEGRABLE_UNION",EQUIINTEGRABLE_UNION; "EQ_ADD_LCANCEL",EQ_ADD_LCANCEL; "EQ_ADD_LCANCEL_0",EQ_ADD_LCANCEL_0; "EQ_ADD_RCANCEL",EQ_ADD_RCANCEL; "EQ_ADD_RCANCEL_0",EQ_ADD_RCANCEL_0; "EQ_BALLS",EQ_BALLS; "EQ_C",EQ_C; "EQ_CLAUSES",EQ_CLAUSES; "EQ_C_BIJECTIONS",EQ_C_BIJECTIONS; "EQ_EXP",EQ_EXP; "EQ_EXT",EQ_EXT; "EQ_IMP",EQ_IMP; "EQ_IMP_LE",EQ_IMP_LE; "EQ_INTERVAL",EQ_INTERVAL; "EQ_INTERVAL_1",EQ_INTERVAL_1; "EQ_MULT_LCANCEL",EQ_MULT_LCANCEL; "EQ_MULT_RCANCEL",EQ_MULT_RCANCEL; "EQ_REFL",EQ_REFL; "EQ_SPAN_INSERT_EQ",EQ_SPAN_INSERT_EQ; "EQ_SUMS_LCANCEL",EQ_SUMS_LCANCEL; "EQ_SUMS_RCANCEL",EQ_SUMS_RCANCEL; "EQ_SYM",EQ_SYM; "EQ_SYM_EQ",EQ_SYM_EQ; "EQ_TRANS",EQ_TRANS; "EQ_UNIV",EQ_UNIV; "ETA_AX",ETA_AX; "EUCLIDEAN_CLOSURE_OF",EUCLIDEAN_CLOSURE_OF; "EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF",EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF; "EUCLIDEAN_FRONTIER_OF",EUCLIDEAN_FRONTIER_OF; "EUCLIDEAN_INTERIOR_OF",EUCLIDEAN_INTERIOR_OF; "EUCLIDEAN_METRIC",EUCLIDEAN_METRIC; "EUCLIDEAN_SPACE_INFINITE",EUCLIDEAN_SPACE_INFINITE; "EULER_ROTATION_THEOREM",EULER_ROTATION_THEOREM; "EULER_ROTATION_THEOREM_GEN",EULER_ROTATION_THEOREM_GEN; "EULER_ROTOINVERSION_THEOREM",EULER_ROTOINVERSION_THEOREM; "EVEN",EVEN; "EVENPERM_COMPOSE",EVENPERM_COMPOSE; "EVENPERM_I",EVENPERM_I; "EVENPERM_INVERSE",EVENPERM_INVERSE; "EVENPERM_SWAP",EVENPERM_SWAP; "EVENPERM_UNIQUE",EVENPERM_UNIQUE; "EVENTUALLY_AND",EVENTUALLY_AND; "EVENTUALLY_AT",EVENTUALLY_AT; "EVENTUALLY_AT_INFINITY",EVENTUALLY_AT_INFINITY; "EVENTUALLY_AT_INFINITY_POS",EVENTUALLY_AT_INFINITY_POS; "EVENTUALLY_AT_INFINITY_WITHIN",EVENTUALLY_AT_INFINITY_WITHIN; "EVENTUALLY_AT_NEGINFINITY",EVENTUALLY_AT_NEGINFINITY; "EVENTUALLY_AT_POSINFINITY",EVENTUALLY_AT_POSINFINITY; "EVENTUALLY_AT_REFLECT",EVENTUALLY_AT_REFLECT; "EVENTUALLY_AT_TOPOLOGICAL",EVENTUALLY_AT_TOPOLOGICAL; "EVENTUALLY_AT_WITHIN",EVENTUALLY_AT_WITHIN; "EVENTUALLY_AT_ZERO",EVENTUALLY_AT_ZERO; "EVENTUALLY_FALSE",EVENTUALLY_FALSE; "EVENTUALLY_FORALL",EVENTUALLY_FORALL; "EVENTUALLY_HAPPENS",EVENTUALLY_HAPPENS; "EVENTUALLY_HAPPENS_AT",EVENTUALLY_HAPPENS_AT; "EVENTUALLY_IN_OPEN",EVENTUALLY_IN_OPEN; "EVENTUALLY_IN_SEQUENTIALLY",EVENTUALLY_IN_SEQUENTIALLY; "EVENTUALLY_MONO",EVENTUALLY_MONO; "EVENTUALLY_MP",EVENTUALLY_MP; "EVENTUALLY_NO_SUBSEQUENCE",EVENTUALLY_NO_SUBSEQUENCE; "EVENTUALLY_SCALABLE_PROPERTY",EVENTUALLY_SCALABLE_PROPERTY; "EVENTUALLY_SCALABLE_PROPERTY_EQ",EVENTUALLY_SCALABLE_PROPERTY_EQ; "EVENTUALLY_SEQUENTIALLY",EVENTUALLY_SEQUENTIALLY; "EVENTUALLY_SUBSEQUENCE",EVENTUALLY_SUBSEQUENCE; "EVENTUALLY_TRUE",EVENTUALLY_TRUE; "EVENTUALLY_WITHIN",EVENTUALLY_WITHIN; "EVENTUALLY_WITHIN_DELETE",EVENTUALLY_WITHIN_DELETE; "EVENTUALLY_WITHIN_IMP",EVENTUALLY_WITHIN_IMP; "EVENTUALLY_WITHIN_INTERIOR",EVENTUALLY_WITHIN_INTERIOR; "EVENTUALLY_WITHIN_INTERIOR_INTER",EVENTUALLY_WITHIN_INTERIOR_INTER; "EVENTUALLY_WITHIN_INTERIOR_LOCAL",EVENTUALLY_WITHIN_INTERIOR_LOCAL; "EVENTUALLY_WITHIN_INTER_IMP",EVENTUALLY_WITHIN_INTER_IMP; "EVENTUALLY_WITHIN_LE",EVENTUALLY_WITHIN_LE; "EVENTUALLY_WITHIN_OPEN",EVENTUALLY_WITHIN_OPEN; "EVENTUALLY_WITHIN_OPEN_IN",EVENTUALLY_WITHIN_OPEN_IN; "EVENTUALLY_WITHIN_REFLECT",EVENTUALLY_WITHIN_REFLECT; "EVENTUALLY_WITHIN_TOPOLOGICAL",EVENTUALLY_WITHIN_TOPOLOGICAL; "EVENTUALLY_WITHIN_ZERO",EVENTUALLY_WITHIN_ZERO; "EVEN_ADD",EVEN_ADD; "EVEN_AND_ODD",EVEN_AND_ODD; "EVEN_DOUBLE",EVEN_DOUBLE; "EVEN_EXISTS",EVEN_EXISTS; "EVEN_EXISTS_LEMMA",EVEN_EXISTS_LEMMA; "EVEN_EXP",EVEN_EXP; "EVEN_MOD",EVEN_MOD; "EVEN_MULT",EVEN_MULT; "EVEN_NSUM",EVEN_NSUM; "EVEN_ODD_DECOMPOSITION",EVEN_ODD_DECOMPOSITION; "EVEN_OR_ODD",EVEN_OR_ODD; "EVEN_SUB",EVEN_SUB; "EX",EX; "EXCHANGE_LEMMA",EXCHANGE_LEMMA; "EXCLUDED_MIDDLE",EXCLUDED_MIDDLE; "EXISTS_ARC_PSUBSET_SIMPLE_PATH",EXISTS_ARC_PSUBSET_SIMPLE_PATH; "EXISTS_BOOL_THM",EXISTS_BOOL_THM; "EXISTS_COMPONENT_SUPERSET",EXISTS_COMPONENT_SUPERSET; "EXISTS_COUNTABLE_SUBSET_IMAGE",EXISTS_COUNTABLE_SUBSET_IMAGE; "EXISTS_COUNTABLE_SUBSET_IMAGE_INJ",EXISTS_COUNTABLE_SUBSET_IMAGE_INJ; "EXISTS_CURRY",EXISTS_CURRY; "EXISTS_DEF",EXISTS_DEF; "EXISTS_DIFF",EXISTS_DIFF; "EXISTS_DOUBLE_ARC",EXISTS_DOUBLE_ARC; "EXISTS_DOUBLE_ARC_EXPLICIT",EXISTS_DOUBLE_ARC_EXPLICIT; "EXISTS_DROP",EXISTS_DROP; "EXISTS_DROP_FUN",EXISTS_DROP_FUN; "EXISTS_DROP_IMAGE",EXISTS_DROP_IMAGE; "EXISTS_EX",EXISTS_EX; "EXISTS_FINITE_SUBSET_IMAGE",EXISTS_FINITE_SUBSET_IMAGE; "EXISTS_FINITE_SUBSET_IMAGE_INJ",EXISTS_FINITE_SUBSET_IMAGE_INJ; "EXISTS_IN_CLAUSES",EXISTS_IN_CLAUSES; "EXISTS_IN_CROSS",EXISTS_IN_CROSS; "EXISTS_IN_GSPEC",EXISTS_IN_GSPEC; "EXISTS_IN_IMAGE",EXISTS_IN_IMAGE; "EXISTS_IN_INSERT",EXISTS_IN_INSERT; "EXISTS_IN_PCROSS",EXISTS_IN_PCROSS; "EXISTS_IN_UNION",EXISTS_IN_UNION; "EXISTS_IN_UNIONS",EXISTS_IN_UNIONS; "EXISTS_LIFT",EXISTS_LIFT; "EXISTS_LIFT_FUN",EXISTS_LIFT_FUN; "EXISTS_LIFT_IMAGE",EXISTS_LIFT_IMAGE; "EXISTS_NOT_THM",EXISTS_NOT_THM; "EXISTS_ONE_REP",EXISTS_ONE_REP; "EXISTS_OPTION",EXISTS_OPTION; "EXISTS_OR_THM",EXISTS_OR_THM; "EXISTS_PAIRED_THM",EXISTS_PAIRED_THM; "EXISTS_PAIR_THM",EXISTS_PAIR_THM; "EXISTS_PASTECART",EXISTS_PASTECART; "EXISTS_PATH_SUBPATH_TO_FRONTIER",EXISTS_PATH_SUBPATH_TO_FRONTIER; "EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED",EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED; "EXISTS_REFL",EXISTS_REFL; "EXISTS_SIMP",EXISTS_SIMP; "EXISTS_SUBARC_OF_ARC_NOENDS",EXISTS_SUBARC_OF_ARC_NOENDS; "EXISTS_SUBPATH_OF_ARC_NOENDS",EXISTS_SUBPATH_OF_ARC_NOENDS; "EXISTS_SUBPATH_OF_PATH",EXISTS_SUBPATH_OF_PATH; "EXISTS_SUBSET_IMAGE",EXISTS_SUBSET_IMAGE; "EXISTS_SUBSET_IMAGE_INJ",EXISTS_SUBSET_IMAGE_INJ; "EXISTS_SUBSET_INSERT",EXISTS_SUBSET_INSERT; "EXISTS_SUBSET_UNION",EXISTS_SUBSET_UNION; "EXISTS_SUM_THM",EXISTS_SUM_THM; "EXISTS_SWAP",EXISTS_SWAP; "EXISTS_THM",EXISTS_THM; "EXISTS_TRIPLED_THM",EXISTS_TRIPLED_THM; "EXISTS_UNCURRY",EXISTS_UNCURRY; "EXISTS_UNIQUE",EXISTS_UNIQUE; "EXISTS_UNIQUE_ALT",EXISTS_UNIQUE_ALT; "EXISTS_UNIQUE_DEF",EXISTS_UNIQUE_DEF; "EXISTS_UNIQUE_REFL",EXISTS_UNIQUE_REFL; "EXISTS_UNIQUE_THM",EXISTS_UNIQUE_THM; "EXISTS_UNPAIR_THM",EXISTS_UNPAIR_THM; "EXISTS_VECTOR_1",EXISTS_VECTOR_1; "EXISTS_VECTOR_2",EXISTS_VECTOR_2; "EXISTS_VECTOR_3",EXISTS_VECTOR_3; "EXISTS_VECTOR_4",EXISTS_VECTOR_4; "EXP",EXP; "EXPAND_CLOSED_OPEN_INTERVAL",EXPAND_CLOSED_OPEN_INTERVAL; "EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL; "EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL; "EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL; "EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL; "EXPOSED_FACET_OF",EXPOSED_FACET_OF; "EXPOSED_FACE_OF",EXPOSED_FACE_OF; "EXPOSED_FACE_OF_IMP_FACE_OF",EXPOSED_FACE_OF_IMP_FACE_OF; "EXPOSED_FACE_OF_INTER",EXPOSED_FACE_OF_INTER; "EXPOSED_FACE_OF_INTERS",EXPOSED_FACE_OF_INTERS; "EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; "EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; "EXPOSED_FACE_OF_LINEAR_IMAGE",EXPOSED_FACE_OF_LINEAR_IMAGE; "EXPOSED_FACE_OF_PARALLEL",EXPOSED_FACE_OF_PARALLEL; "EXPOSED_FACE_OF_POLYHEDRON",EXPOSED_FACE_OF_POLYHEDRON; "EXPOSED_FACE_OF_REFL",EXPOSED_FACE_OF_REFL; "EXPOSED_FACE_OF_REFL_EQ",EXPOSED_FACE_OF_REFL_EQ; "EXPOSED_FACE_OF_SUMS",EXPOSED_FACE_OF_SUMS; "EXPOSED_FACE_OF_TRANSLATION_EQ",EXPOSED_FACE_OF_TRANSLATION_EQ; "EXPOSED_POINT_OF_FURTHEST_POINT",EXPOSED_POINT_OF_FURTHEST_POINT; "EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; "EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; "EXP_1",EXP_1; "EXP_2",EXP_2; "EXP_ADD",EXP_ADD; "EXP_EQ_0",EXP_EQ_0; "EXP_EQ_1",EXP_EQ_1; "EXP_LT_0",EXP_LT_0; "EXP_MONO_EQ",EXP_MONO_EQ; "EXP_MONO_LE",EXP_MONO_LE; "EXP_MONO_LE_IMP",EXP_MONO_LE_IMP; "EXP_MONO_LT",EXP_MONO_LT; "EXP_MONO_LT_IMP",EXP_MONO_LT_IMP; "EXP_MULT",EXP_MULT; "EXP_ONE",EXP_ONE; "EXP_ZERO",EXP_ZERO; "EXTEND_FL",EXTEND_FL; "EXTEND_INSEG",EXTEND_INSEG; "EXTEND_LINSEG",EXTEND_LINSEG; "EXTEND_TO_AFFINE_BASIS",EXTEND_TO_AFFINE_BASIS; "EXTENSION",EXTENSION; "EXTENSIONAL",EXTENSIONAL; "EXTENSIONAL_EMPTY",EXTENSIONAL_EMPTY; "EXTENSIONAL_EQ",EXTENSIONAL_EQ; "EXTENSION_FROM_CLOPEN",EXTENSION_FROM_CLOPEN; "EXTENSION_FROM_COMPONENT",EXTENSION_FROM_COMPONENT; "EXTENSION_INTO_AR",EXTENSION_INTO_AR; "EXTENSION_INTO_AR_LOCAL",EXTENSION_INTO_AR_LOCAL; "EXTREME_POINTS_OF_CONVEX_HULL",EXTREME_POINTS_OF_CONVEX_HULL; "EXTREME_POINTS_OF_CONVEX_HULL_AFFINE_INDEPENDENT",EXTREME_POINTS_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "EXTREME_POINTS_OF_CONVEX_HULL_EQ",EXTREME_POINTS_OF_CONVEX_HULL_EQ; "EXTREME_POINTS_OF_LINEAR_IMAGE",EXTREME_POINTS_OF_LINEAR_IMAGE; "EXTREME_POINTS_OF_STILLCONVEX",EXTREME_POINTS_OF_STILLCONVEX; "EXTREME_POINTS_OF_TRANSLATION",EXTREME_POINTS_OF_TRANSLATION; "EXTREME_POINT_EXISTS_CONVEX",EXTREME_POINT_EXISTS_CONVEX; "EXTREME_POINT_IN_FRONTIER",EXTREME_POINT_IN_FRONTIER; "EXTREME_POINT_IN_RELATIVE_FRONTIER",EXTREME_POINT_IN_RELATIVE_FRONTIER; "EXTREME_POINT_NOT_IN_INTERIOR",EXTREME_POINT_NOT_IN_INTERIOR; "EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR",EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR; "EXTREME_POINT_OF_CBALL",EXTREME_POINT_OF_CBALL; "EXTREME_POINT_OF_CONIC",EXTREME_POINT_OF_CONIC; "EXTREME_POINT_OF_CONIC_HULL",EXTREME_POINT_OF_CONIC_HULL; "EXTREME_POINT_OF_CONVEX_HULL",EXTREME_POINT_OF_CONVEX_HULL; "EXTREME_POINT_OF_CONVEX_HULL_2",EXTREME_POINT_OF_CONVEX_HULL_2; "EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT; "EXTREME_POINT_OF_CONVEX_HULL_EQ",EXTREME_POINT_OF_CONVEX_HULL_EQ; "EXTREME_POINT_OF_CONVEX_HULL_INSERT",EXTREME_POINT_OF_CONVEX_HULL_INSERT; "EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ",EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ; "EXTREME_POINT_OF_EMPTY",EXTREME_POINT_OF_EMPTY; "EXTREME_POINT_OF_FACE",EXTREME_POINT_OF_FACE; "EXTREME_POINT_OF_INTER",EXTREME_POINT_OF_INTER; "EXTREME_POINT_OF_INTER_GEN",EXTREME_POINT_OF_INTER_GEN; "EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; "EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; "EXTREME_POINT_OF_LINEAR_IMAGE",EXTREME_POINT_OF_LINEAR_IMAGE; "EXTREME_POINT_OF_MIDPOINT",EXTREME_POINT_OF_MIDPOINT; "EXTREME_POINT_OF_SEGMENT",EXTREME_POINT_OF_SEGMENT; "EXTREME_POINT_OF_SING",EXTREME_POINT_OF_SING; "EXTREME_POINT_OF_STILLCONVEX",EXTREME_POINT_OF_STILLCONVEX; "EXTREME_POINT_OF_STILLCONVEX_IMP",EXTREME_POINT_OF_STILLCONVEX_IMP; "EXTREME_POINT_OF_TRANSLATION_EQ",EXTREME_POINT_OF_TRANSLATION_EQ; "EXTREME_POINT_RELATIVE_FRONTIER",EXTREME_POINT_RELATIVE_FRONTIER; "EX_IMP",EX_IMP; "EX_MAP",EX_MAP; "EX_MEM",EX_MEM; "FACES_OF_LINEAR_IMAGE",FACES_OF_LINEAR_IMAGE; "FACES_OF_SIMPLEX",FACES_OF_SIMPLEX; "FACES_OF_TRANSLATION",FACES_OF_TRANSLATION; "FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT",FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT; "FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT; "FACET_OF_EMPTY",FACET_OF_EMPTY; "FACET_OF_HALFSPACE_GE",FACET_OF_HALFSPACE_GE; "FACET_OF_HALFSPACE_LE",FACET_OF_HALFSPACE_LE; "FACET_OF_IMP_FACE_OF",FACET_OF_IMP_FACE_OF; "FACET_OF_IMP_PROPER",FACET_OF_IMP_PROPER; "FACET_OF_IMP_SUBSET",FACET_OF_IMP_SUBSET; "FACET_OF_LINEAR_IMAGE",FACET_OF_LINEAR_IMAGE; "FACET_OF_POLYHEDRON",FACET_OF_POLYHEDRON; "FACET_OF_POLYHEDRON_EXPLICIT",FACET_OF_POLYHEDRON_EXPLICIT; "FACET_OF_REFL",FACET_OF_REFL; "FACET_OF_TRANSLATION_EQ",FACET_OF_TRANSLATION_EQ; "FACE_OF_AFFINE_EQ",FACE_OF_AFFINE_EQ; "FACE_OF_AFFINE_TRIVIAL",FACE_OF_AFFINE_TRIVIAL; "FACE_OF_AFF_DIM_0",FACE_OF_AFF_DIM_0; "FACE_OF_AFF_DIM_LT",FACE_OF_AFF_DIM_LT; "FACE_OF_CONIC",FACE_OF_CONIC; "FACE_OF_CONIC_HULL",FACE_OF_CONIC_HULL; "FACE_OF_CONIC_HULL_EQ",FACE_OF_CONIC_HULL_EQ; "FACE_OF_CONIC_HULL_REV",FACE_OF_CONIC_HULL_REV; "FACE_OF_CONVEX_HULLS",FACE_OF_CONVEX_HULLS; "FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT; "FACE_OF_CONVEX_HULL_INSERT",FACE_OF_CONVEX_HULL_INSERT; "FACE_OF_CONVEX_HULL_INSERT_EQ",FACE_OF_CONVEX_HULL_INSERT_EQ; "FACE_OF_CONVEX_HULL_SUBSET",FACE_OF_CONVEX_HULL_SUBSET; "FACE_OF_DISJOINT_INTERIOR",FACE_OF_DISJOINT_INTERIOR; "FACE_OF_DISJOINT_RELATIVE_INTERIOR",FACE_OF_DISJOINT_RELATIVE_INTERIOR; "FACE_OF_EMPTY",FACE_OF_EMPTY; "FACE_OF_EQ",FACE_OF_EQ; "FACE_OF_FACE",FACE_OF_FACE; "FACE_OF_HALFSPACE_GE",FACE_OF_HALFSPACE_GE; "FACE_OF_HALFSPACE_LE",FACE_OF_HALFSPACE_LE; "FACE_OF_IMP_CLOSED",FACE_OF_IMP_CLOSED; "FACE_OF_IMP_COMPACT",FACE_OF_IMP_COMPACT; "FACE_OF_IMP_CONVEX",FACE_OF_IMP_CONVEX; "FACE_OF_IMP_SUBSET",FACE_OF_IMP_SUBSET; "FACE_OF_INTER",FACE_OF_INTER; "FACE_OF_INTERS",FACE_OF_INTERS; "FACE_OF_INTER_AS_INTER_OF_FACE",FACE_OF_INTER_AS_INTER_OF_FACE; "FACE_OF_INTER_INTER",FACE_OF_INTER_INTER; "FACE_OF_INTER_SUBFACE",FACE_OF_INTER_SUBFACE; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; "FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG; "FACE_OF_LINEAR_IMAGE",FACE_OF_LINEAR_IMAGE; "FACE_OF_PCROSS",FACE_OF_PCROSS; "FACE_OF_PCROSS_DECOMP",FACE_OF_PCROSS_DECOMP; "FACE_OF_PCROSS_EQ",FACE_OF_PCROSS_EQ; "FACE_OF_POLYHEDRON",FACE_OF_POLYHEDRON; "FACE_OF_POLYHEDRON_EXPLICIT",FACE_OF_POLYHEDRON_EXPLICIT; "FACE_OF_POLYHEDRON_FACE_OF_FACET",FACE_OF_POLYHEDRON_FACE_OF_FACET; "FACE_OF_POLYHEDRON_POLYHEDRON",FACE_OF_POLYHEDRON_POLYHEDRON; "FACE_OF_POLYHEDRON_SUBSET_EXPLICIT",FACE_OF_POLYHEDRON_SUBSET_EXPLICIT; "FACE_OF_POLYHEDRON_SUBSET_FACET",FACE_OF_POLYHEDRON_SUBSET_FACET; "FACE_OF_POLYTOPE_INSERT_EQ",FACE_OF_POLYTOPE_INSERT_EQ; "FACE_OF_POLYTOPE_POLYTOPE",FACE_OF_POLYTOPE_POLYTOPE; "FACE_OF_REFL",FACE_OF_REFL; "FACE_OF_REFL_EQ",FACE_OF_REFL_EQ; "FACE_OF_SIMPLEX_SUBSET",FACE_OF_SIMPLEX_SUBSET; "FACE_OF_SING",FACE_OF_SING; "FACE_OF_SLICE",FACE_OF_SLICE; "FACE_OF_STILLCONVEX",FACE_OF_STILLCONVEX; "FACE_OF_SUBSET",FACE_OF_SUBSET; "FACE_OF_SUBSET_FRONTIER_AFF_DIM",FACE_OF_SUBSET_FRONTIER_AFF_DIM; "FACE_OF_SUBSET_RELATIVE_BOUNDARY",FACE_OF_SUBSET_RELATIVE_BOUNDARY; "FACE_OF_SUBSET_RELATIVE_FRONTIER",FACE_OF_SUBSET_RELATIVE_FRONTIER; "FACE_OF_SUBSET_RELATIVE_FRONTIER_AFF_DIM",FACE_OF_SUBSET_RELATIVE_FRONTIER_AFF_DIM; "FACE_OF_TRANS",FACE_OF_TRANS; "FACE_OF_TRANSLATION_EQ",FACE_OF_TRANSLATION_EQ; "FACT",FACT; "FACTOR_CONTINUOUS_THROUGH_VARIATION",FACTOR_CONTINUOUS_THROUGH_VARIATION; "FACTOR_THROUGH_VARIATION",FACTOR_THROUGH_VARIATION; "FACT_LE",FACT_LE; "FACT_LT",FACT_LT; "FACT_MONO",FACT_MONO; "FACT_NZ",FACT_NZ; "FARKAS_LEMMA",FARKAS_LEMMA; "FARKAS_LEMMA_ALT",FARKAS_LEMMA_ALT; "FASHODA",FASHODA; "FASHODA_INTERLACE",FASHODA_INTERLACE; "FASHODA_UNIT",FASHODA_UNIT; "FASHODA_UNIT_PATH",FASHODA_UNIT_PATH; "FATOU",FATOU; "FATOU_STRONG",FATOU_STRONG; "FCCOVERABLE_IMP_LOCALLY_CONNECTED",FCCOVERABLE_IMP_LOCALLY_CONNECTED; "FCCOVERABLE_INTERMEDIATE_CLOSURE",FCCOVERABLE_INTERMEDIATE_CLOSURE; "FCONS",FCONS; "FCONS_UNDO",FCONS_UNDO; "FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT",FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT; "FILTER",FILTER; "FILTER_APPEND",FILTER_APPEND; "FILTER_MAP",FILTER_MAP; "FINE_DIVISION_EXISTS",FINE_DIVISION_EXISTS; "FINE_INTER",FINE_INTER; "FINE_INTERS",FINE_INTERS; "FINE_SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX",FINE_SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX; "FINE_SUBSET",FINE_SUBSET; "FINE_TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX",FINE_TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX; "FINE_UNION",FINE_UNION; "FINE_UNIONS",FINE_UNIONS; "FINITELY_GENERATED_CONIC_POLYHEDRON",FINITELY_GENERATED_CONIC_POLYHEDRON; "FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC",FINITE_ANR_COMPLEMENT_COMPONENTS_CONCENTRIC; "FINITE_ANR_COMPONENTS",FINITE_ANR_COMPONENTS; "FINITE_BALL",FINITE_BALL; "FINITE_BITSET",FINITE_BITSET; "FINITE_BOOL",FINITE_BOOL; "FINITE_BOUNDED_FUNCTIONS",FINITE_BOUNDED_FUNCTIONS; "FINITE_CARD_LT",FINITE_CARD_LT; "FINITE_CART",FINITE_CART; "FINITE_CART_SUBSET_LEMMA",FINITE_CART_SUBSET_LEMMA; "FINITE_CART_UNIV",FINITE_CART_UNIV; "FINITE_CASES",FINITE_CASES; "FINITE_CBALL",FINITE_CBALL; "FINITE_CIRCLE_INTERSECTION",FINITE_CIRCLE_INTERSECTION; "FINITE_COLUMNS",FINITE_COLUMNS; "FINITE_COMPLEMENT_ANR_COMPONENTS",FINITE_COMPLEMENT_ANR_COMPONENTS; "FINITE_COMPLEMENT_ENR_COMPONENTS",FINITE_COMPLEMENT_ENR_COMPONENTS; "FINITE_COMPONENTS",FINITE_COMPONENTS; "FINITE_COMPONENTS_COMPLEMENT_CONVEX",FINITE_COMPONENTS_COMPLEMENT_CONVEX; "FINITE_COMPONENTS_MEETING_COMPACT_SUBSET",FINITE_COMPONENTS_MEETING_COMPACT_SUBSET; "FINITE_COMPONENTS_UNION",FINITE_COMPONENTS_UNION; "FINITE_CROSS",FINITE_CROSS; "FINITE_CROSS_EQ",FINITE_CROSS_EQ; "FINITE_DELETE",FINITE_DELETE; "FINITE_DELETE_IMP",FINITE_DELETE_IMP; "FINITE_DIFF",FINITE_DIFF; "FINITE_DIFF_IMAGE",FINITE_DIFF_IMAGE; "FINITE_EIGENVALUES",FINITE_EIGENVALUES; "FINITE_EMPTY",FINITE_EMPTY; "FINITE_EMPTY_INTERIOR",FINITE_EMPTY_INTERIOR; "FINITE_ENR_COMPONENTS",FINITE_ENR_COMPONENTS; "FINITE_EQ_BOUNDED_DISCRETE",FINITE_EQ_BOUNDED_DISCRETE; "FINITE_FACES_OF_SIMPLEX",FINITE_FACES_OF_SIMPLEX; "FINITE_FINITE_IMAGE",FINITE_FINITE_IMAGE; "FINITE_FINITE_PREIMAGE",FINITE_FINITE_PREIMAGE; "FINITE_FINITE_PREIMAGE_GENERAL",FINITE_FINITE_PREIMAGE_GENERAL; "FINITE_FINITE_UNIONS",FINITE_FINITE_UNIONS; "FINITE_FL",FINITE_FL; "FINITE_FUNSPACE",FINITE_FUNSPACE; "FINITE_FUNSPACE_UNIV",FINITE_FUNSPACE_UNIV; "FINITE_HAS_SIZE",FINITE_HAS_SIZE; "FINITE_IMAGE",FINITE_IMAGE; "FINITE_IMAGE_EXPAND",FINITE_IMAGE_EXPAND; "FINITE_IMAGE_IMAGE",FINITE_IMAGE_IMAGE; "FINITE_IMAGE_INJ",FINITE_IMAGE_INJ; "FINITE_IMAGE_INJ_EQ",FINITE_IMAGE_INJ_EQ; "FINITE_IMAGE_INJ_GENERAL",FINITE_IMAGE_INJ_GENERAL; "FINITE_IMP_ANR",FINITE_IMP_ANR; "FINITE_IMP_BOUNDED",FINITE_IMP_BOUNDED; "FINITE_IMP_BOUNDED_CONVEX_HULL",FINITE_IMP_BOUNDED_CONVEX_HULL; "FINITE_IMP_CLOSED",FINITE_IMP_CLOSED; "FINITE_IMP_CLOSED_IN",FINITE_IMP_CLOSED_IN; "FINITE_IMP_COMPACT",FINITE_IMP_COMPACT; "FINITE_IMP_COMPACT_CONVEX_HULL",FINITE_IMP_COMPACT_CONVEX_HULL; "FINITE_IMP_COMPACT_IN",FINITE_IMP_COMPACT_IN; "FINITE_IMP_COUNTABLE",FINITE_IMP_COUNTABLE; "FINITE_IMP_DIMENSION_LE_0",FINITE_IMP_DIMENSION_LE_0; "FINITE_IMP_ENR",FINITE_IMP_ENR; "FINITE_IMP_NOT_OPEN",FINITE_IMP_NOT_OPEN; "FINITE_IMP_TOTALLY_DISCONNECTED",FINITE_IMP_TOTALLY_DISCONNECTED; "FINITE_INDEX_INJ",FINITE_INDEX_INJ; "FINITE_INDEX_INRANGE",FINITE_INDEX_INRANGE; "FINITE_INDEX_INRANGE_2",FINITE_INDEX_INRANGE_2; "FINITE_INDEX_NUMBERS",FINITE_INDEX_NUMBERS; "FINITE_INDEX_NUMSEG",FINITE_INDEX_NUMSEG; "FINITE_INDEX_NUMSEG_SPECIAL",FINITE_INDEX_NUMSEG_SPECIAL; "FINITE_INDEX_WORKS",FINITE_INDEX_WORKS; "FINITE_INDUCT",FINITE_INDUCT; "FINITE_INDUCT_DELETE",FINITE_INDUCT_DELETE; "FINITE_INDUCT_STRONG",FINITE_INDUCT_STRONG; "FINITE_INSERT",FINITE_INSERT; "FINITE_INTER",FINITE_INTER; "FINITE_INTERVAL_1",FINITE_INTERVAL_1; "FINITE_INTER_COLLINEAR_OPEN_SEGMENTS",FINITE_INTER_COLLINEAR_OPEN_SEGMENTS; "FINITE_INTER_NUMSEG",FINITE_INTER_NUMSEG; "FINITE_INTSEG",FINITE_INTSEG; "FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS",FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS; "FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS",FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS; "FINITE_MULTIVECTOR",FINITE_MULTIVECTOR; "FINITE_NUMSEG",FINITE_NUMSEG; "FINITE_NUMSEG_LE",FINITE_NUMSEG_LE; "FINITE_NUMSEG_LT",FINITE_NUMSEG_LT; "FINITE_PCROSS",FINITE_PCROSS; "FINITE_PCROSS_EQ",FINITE_PCROSS_EQ; "FINITE_PERMUTATIONS",FINITE_PERMUTATIONS; "FINITE_POLYHEDRON_EXPOSED_FACES",FINITE_POLYHEDRON_EXPOSED_FACES; "FINITE_POLYHEDRON_EXTREME_POINTS",FINITE_POLYHEDRON_EXTREME_POINTS; "FINITE_POLYHEDRON_FACES",FINITE_POLYHEDRON_FACES; "FINITE_POLYHEDRON_FACETS",FINITE_POLYHEDRON_FACETS; "FINITE_POLYTOPE_FACES",FINITE_POLYTOPE_FACES; "FINITE_POLYTOPE_FACETS",FINITE_POLYTOPE_FACETS; "FINITE_POWERSET",FINITE_POWERSET; "FINITE_PRODUCT",FINITE_PRODUCT; "FINITE_PRODUCT_DEPENDENT",FINITE_PRODUCT_DEPENDENT; "FINITE_PROD_IMAGE",FINITE_PROD_IMAGE; "FINITE_REAL_INTERVAL",FINITE_REAL_INTERVAL; "FINITE_RECURSION",FINITE_RECURSION; "FINITE_RECURSION_DELETE",FINITE_RECURSION_DELETE; "FINITE_RESTRICT",FINITE_RESTRICT; "FINITE_ROWS",FINITE_ROWS; "FINITE_RULES",FINITE_RULES; "FINITE_SEGMENT",FINITE_SEGMENT; "FINITE_SET_AS_MATRIX_ROWS",FINITE_SET_AS_MATRIX_ROWS; "FINITE_SET_AVOID",FINITE_SET_AVOID; "FINITE_SET_OF_LIST",FINITE_SET_OF_LIST; "FINITE_SING",FINITE_SING; "FINITE_SPHERE",FINITE_SPHERE; "FINITE_SPHERE_1",FINITE_SPHERE_1; "FINITE_STDBASIS",FINITE_STDBASIS; "FINITE_SUBSET",FINITE_SUBSET; "FINITE_SUBSET_IMAGE",FINITE_SUBSET_IMAGE; "FINITE_SUBSET_IMAGE_IMP",FINITE_SUBSET_IMAGE_IMP; "FINITE_SUBSET_NUMSEG",FINITE_SUBSET_NUMSEG; "FINITE_SUBSET_UNIONS",FINITE_SUBSET_UNIONS; "FINITE_SUBSET_UNIONS_CHAIN",FINITE_SUBSET_UNIONS_CHAIN; "FINITE_SUM_IMAGE",FINITE_SUM_IMAGE; "FINITE_SUPPORT",FINITE_SUPPORT; "FINITE_SUPPORT_DELTA",FINITE_SUPPORT_DELTA; "FINITE_TRANSITIVITY_CHAIN",FINITE_TRANSITIVITY_CHAIN; "FINITE_UNION",FINITE_UNION; "FINITE_UNIONS",FINITE_UNIONS; "FINITE_UNION_IMP",FINITE_UNION_IMP; "FINITE_UNIV_PAIR",FINITE_UNIV_PAIR; "FINREC",FINREC; "FINREC_1_LEMMA",FINREC_1_LEMMA; "FINREC_EXISTS_LEMMA",FINREC_EXISTS_LEMMA; "FINREC_FUN",FINREC_FUN; "FINREC_FUN_LEMMA",FINREC_FUN_LEMMA; "FINREC_SUC_LEMMA",FINREC_SUC_LEMMA; "FINREC_UNIQUE_LEMMA",FINREC_UNIQUE_LEMMA; "FIXED_POINT_INESSENTIAL_SPHERE_MAP",FIXED_POINT_INESSENTIAL_SPHERE_MAP; "FIXING_SWAPSEQ_DECREASE",FIXING_SWAPSEQ_DECREASE; "FIXPOINT_HOMOTOPIC_IDENTITY_SPHERE",FIXPOINT_HOMOTOPIC_IDENTITY_SPHERE; "FIXPOINT_OR_NEG_MAPPING_SPHERE",FIXPOINT_OR_NEG_MAPPING_SPHERE; "FL",FL; "FLATTEN_LEMMA",FLATTEN_LEMMA; "FLOOR",FLOOR; "FLOOR_DIV_DIV",FLOOR_DIV_DIV; "FLOOR_DOUBLE",FLOOR_DOUBLE; "FLOOR_EQ_0",FLOOR_EQ_0; "FLOOR_FRAC",FLOOR_FRAC; "FLOOR_MONO",FLOOR_MONO; "FLOOR_NUM",FLOOR_NUM; "FLOOR_POS",FLOOR_POS; "FLOOR_POS_LE",FLOOR_POS_LE; "FLOOR_UNIQUE",FLOOR_UNIQUE; "FL_RESTRICT",FL_RESTRICT; "FL_RESTRICTED_SUBSET",FL_RESTRICTED_SUBSET; "FL_SUBSET",FL_SUBSET; "FL_SUC",FL_SUC; "FNIL",FNIL; "FORALL_1",FORALL_1; "FORALL_2",FORALL_2; "FORALL_3",FORALL_3; "FORALL_4",FORALL_4; "FORALL_ALL",FORALL_ALL; "FORALL_AND_THM",FORALL_AND_THM; "FORALL_BOOL_THM",FORALL_BOOL_THM; "FORALL_COUNTABLE_AS_IMAGE",FORALL_COUNTABLE_AS_IMAGE; "FORALL_COUNTABLE_SUBSET_IMAGE",FORALL_COUNTABLE_SUBSET_IMAGE; "FORALL_COUNTABLE_SUBSET_IMAGE_INJ",FORALL_COUNTABLE_SUBSET_IMAGE_INJ; "FORALL_CURRY",FORALL_CURRY; "FORALL_DEF",FORALL_DEF; "FORALL_DIFF",FORALL_DIFF; "FORALL_DIMINDEX_1",FORALL_DIMINDEX_1; "FORALL_DOT_EQ_0",FORALL_DOT_EQ_0; "FORALL_DROP",FORALL_DROP; "FORALL_DROP_FUN",FORALL_DROP_FUN; "FORALL_DROP_IMAGE",FORALL_DROP_IMAGE; "FORALL_EVENTUALLY",FORALL_EVENTUALLY; "FORALL_FINITE_INDEX",FORALL_FINITE_INDEX; "FORALL_FINITE_SUBSET_IMAGE",FORALL_FINITE_SUBSET_IMAGE; "FORALL_FINITE_SUBSET_IMAGE_INJ",FORALL_FINITE_SUBSET_IMAGE_INJ; "FORALL_INTEGER",FORALL_INTEGER; "FORALL_IN_CLAUSES",FORALL_IN_CLAUSES; "FORALL_IN_CLOSURE",FORALL_IN_CLOSURE; "FORALL_IN_CLOSURE_EQ",FORALL_IN_CLOSURE_EQ; "FORALL_IN_CROSS",FORALL_IN_CROSS; "FORALL_IN_DIVISION",FORALL_IN_DIVISION; "FORALL_IN_DIVISION_NONEMPTY",FORALL_IN_DIVISION_NONEMPTY; "FORALL_IN_GSPEC",FORALL_IN_GSPEC; "FORALL_IN_IMAGE",FORALL_IN_IMAGE; "FORALL_IN_IMAGE_2",FORALL_IN_IMAGE_2; "FORALL_IN_INSERT",FORALL_IN_INSERT; "FORALL_IN_INTERMEDIATE_CLOSURE",FORALL_IN_INTERMEDIATE_CLOSURE; "FORALL_IN_INTERMEDIATE_CLOSURE_EQ",FORALL_IN_INTERMEDIATE_CLOSURE_EQ; "FORALL_IN_PCROSS",FORALL_IN_PCROSS; "FORALL_IN_UNION",FORALL_IN_UNION; "FORALL_IN_UNIONS",FORALL_IN_UNIONS; "FORALL_LIFT",FORALL_LIFT; "FORALL_LIFT_FUN",FORALL_LIFT_FUN; "FORALL_LIFT_IMAGE",FORALL_LIFT_IMAGE; "FORALL_MULTIVECTOR",FORALL_MULTIVECTOR; "FORALL_NOT_THM",FORALL_NOT_THM; "FORALL_OF_DROP",FORALL_OF_DROP; "FORALL_OF_PASTECART",FORALL_OF_PASTECART; "FORALL_OPTION",FORALL_OPTION; "FORALL_PAIRED_THM",FORALL_PAIRED_THM; "FORALL_PAIR_THM",FORALL_PAIR_THM; "FORALL_PASTECART",FORALL_PASTECART; "FORALL_POS_MONO",FORALL_POS_MONO; "FORALL_POS_MONO_1",FORALL_POS_MONO_1; "FORALL_POS_MONO_1_EQ",FORALL_POS_MONO_1_EQ; "FORALL_POS_MONO_EQ",FORALL_POS_MONO_EQ; "FORALL_REAL_ONE",FORALL_REAL_ONE; "FORALL_SETCODE",FORALL_SETCODE; "FORALL_SIMP",FORALL_SIMP; "FORALL_SUBSET_IMAGE",FORALL_SUBSET_IMAGE; "FORALL_SUBSET_IMAGE_INJ",FORALL_SUBSET_IMAGE_INJ; "FORALL_SUBSET_INSERT",FORALL_SUBSET_INSERT; "FORALL_SUBSET_UNION",FORALL_SUBSET_UNION; "FORALL_SUC",FORALL_SUC; "FORALL_SUM_THM",FORALL_SUM_THM; "FORALL_TRIPLED_THM",FORALL_TRIPLED_THM; "FORALL_UNCURRY",FORALL_UNCURRY; "FORALL_UNPAIR_THM",FORALL_UNPAIR_THM; "FORALL_UNWIND_THM1",FORALL_UNWIND_THM1; "FORALL_UNWIND_THM2",FORALL_UNWIND_THM2; "FORALL_VECTOR_1",FORALL_VECTOR_1; "FORALL_VECTOR_2",FORALL_VECTOR_2; "FORALL_VECTOR_3",FORALL_VECTOR_3; "FORALL_VECTOR_4",FORALL_VECTOR_4; "FRAC_DIV_MOD",FRAC_DIV_MOD; "FRAC_FLOOR",FRAC_FLOOR; "FRAC_NEG",FRAC_NEG; "FRAC_NUM",FRAC_NUM; "FRAC_UNIQUE",FRAC_UNIQUE; "FRECHET_DERIVATIVE_AT",FRECHET_DERIVATIVE_AT; "FRECHET_DERIVATIVE_CONST_AT",FRECHET_DERIVATIVE_CONST_AT; "FRECHET_DERIVATIVE_UNIQUE_AT",FRECHET_DERIVATIVE_UNIQUE_AT; "FRECHET_DERIVATIVE_UNIQUE_WITHIN",FRECHET_DERIVATIVE_UNIQUE_WITHIN; "FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; "FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL; "FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL; "FRECHET_DERIVATIVE_WORKS",FRECHET_DERIVATIVE_WORKS; "FROM_0",FROM_0; "FROM_INTER_NUMSEG",FROM_INTER_NUMSEG; "FROM_INTER_NUMSEG_GEN",FROM_INTER_NUMSEG_GEN; "FROM_INTER_NUMSEG_MAX",FROM_INTER_NUMSEG_MAX; "FRONTIER_AFFINITY",FRONTIER_AFFINITY; "FRONTIER_BALL",FRONTIER_BALL; "FRONTIER_BIJECTIVE_LINEAR_IMAGE",FRONTIER_BIJECTIVE_LINEAR_IMAGE; "FRONTIER_CBALL",FRONTIER_CBALL; "FRONTIER_CLOPEN_MAP_IMAGE",FRONTIER_CLOPEN_MAP_IMAGE; "FRONTIER_CLOPEN_MAP_IMAGE_SUBSET",FRONTIER_CLOPEN_MAP_IMAGE_SUBSET; "FRONTIER_CLOSED",FRONTIER_CLOSED; "FRONTIER_CLOSED_INTERVAL",FRONTIER_CLOSED_INTERVAL; "FRONTIER_CLOSURES",FRONTIER_CLOSURES; "FRONTIER_CLOSURE_CONVEX",FRONTIER_CLOSURE_CONVEX; "FRONTIER_CLOSURE_SUBSET",FRONTIER_CLOSURE_SUBSET; "FRONTIER_COMPLEMENT",FRONTIER_COMPLEMENT; "FRONTIER_CONVEX_HULL_CASES",FRONTIER_CONVEX_HULL_CASES; "FRONTIER_CONVEX_HULL_EXPLICIT",FRONTIER_CONVEX_HULL_EXPLICIT; "FRONTIER_DISJOINT_EQ",FRONTIER_DISJOINT_EQ; "FRONTIER_EMPTY",FRONTIER_EMPTY; "FRONTIER_EQ_EMPTY",FRONTIER_EQ_EMPTY; "FRONTIER_FRONTIER",FRONTIER_FRONTIER; "FRONTIER_FRONTIER_FRONTIER",FRONTIER_FRONTIER_FRONTIER; "FRONTIER_FRONTIER_SUBSET",FRONTIER_FRONTIER_SUBSET; "FRONTIER_HALFSPACE_COMPONENT_GE",FRONTIER_HALFSPACE_COMPONENT_GE; "FRONTIER_HALFSPACE_COMPONENT_GT",FRONTIER_HALFSPACE_COMPONENT_GT; "FRONTIER_HALFSPACE_COMPONENT_LE",FRONTIER_HALFSPACE_COMPONENT_LE; "FRONTIER_HALFSPACE_COMPONENT_LT",FRONTIER_HALFSPACE_COMPONENT_LT; "FRONTIER_HALFSPACE_GE",FRONTIER_HALFSPACE_GE; "FRONTIER_HALFSPACE_GT",FRONTIER_HALFSPACE_GT; "FRONTIER_HALFSPACE_LE",FRONTIER_HALFSPACE_LE; "FRONTIER_HALFSPACE_LT",FRONTIER_HALFSPACE_LT; "FRONTIER_INJECTIVE_LINEAR_IMAGE",FRONTIER_INJECTIVE_LINEAR_IMAGE; "FRONTIER_INSIDE_SUBSET",FRONTIER_INSIDE_SUBSET; "FRONTIER_INTER",FRONTIER_INTER; "FRONTIER_INTERIORS",FRONTIER_INTERIORS; "FRONTIER_INTERIOR_SUBSET",FRONTIER_INTERIOR_SUBSET; "FRONTIER_INTER_CLOSED",FRONTIER_INTER_CLOSED; "FRONTIER_INTER_SUBSET",FRONTIER_INTER_SUBSET; "FRONTIER_INTER_SUBSET_INTER",FRONTIER_INTER_SUBSET_INTER; "FRONTIER_MINIMAL_SEPARATING_CLOSED",FRONTIER_MINIMAL_SEPARATING_CLOSED; "FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE",FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE; "FRONTIER_NOT_EMPTY",FRONTIER_NOT_EMPTY; "FRONTIER_OF_CLOSURES",FRONTIER_OF_CLOSURES; "FRONTIER_OF_COMPLEMENT",FRONTIER_OF_COMPLEMENT; "FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT",FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; "FRONTIER_OF_COMPONENTS_SUBSET",FRONTIER_OF_COMPONENTS_SUBSET; "FRONTIER_OF_CONNECTED_COMPONENT_SUBSET",FRONTIER_OF_CONNECTED_COMPONENT_SUBSET; "FRONTIER_OF_CONVEX_CLOSED",FRONTIER_OF_CONVEX_CLOSED; "FRONTIER_OF_CONVEX_HULL",FRONTIER_OF_CONVEX_HULL; "FRONTIER_OF_DISJOINT_EQ",FRONTIER_OF_DISJOINT_EQ; "FRONTIER_OF_DISJOINT_EQ_ALT",FRONTIER_OF_DISJOINT_EQ_ALT; "FRONTIER_OF_EMPTY",FRONTIER_OF_EMPTY; "FRONTIER_OF_EQ_EMPTY",FRONTIER_OF_EQ_EMPTY; "FRONTIER_OF_FRONTIER_OF",FRONTIER_OF_FRONTIER_OF; "FRONTIER_OF_FRONTIER_OF_FRONTIER_OF",FRONTIER_OF_FRONTIER_OF_FRONTIER_OF; "FRONTIER_OF_FRONTIER_OF_SUBSET",FRONTIER_OF_FRONTIER_OF_SUBSET; "FRONTIER_OF_INJECTIVE_LINEAR_IMAGE",FRONTIER_OF_INJECTIVE_LINEAR_IMAGE; "FRONTIER_OF_INTER",FRONTIER_OF_INTER; "FRONTIER_OF_INTER_CLOSED_IN",FRONTIER_OF_INTER_CLOSED_IN; "FRONTIER_OF_INTER_SUBSET",FRONTIER_OF_INTER_SUBSET; "FRONTIER_OF_OPEN_IN",FRONTIER_OF_OPEN_IN; "FRONTIER_OF_OPEN_IN_STRADDLE_INTER",FRONTIER_OF_OPEN_IN_STRADDLE_INTER; "FRONTIER_OF_RESTRICT",FRONTIER_OF_RESTRICT; "FRONTIER_OF_SUBSET_CLOSED_IN",FRONTIER_OF_SUBSET_CLOSED_IN; "FRONTIER_OF_SUBSET_EQ",FRONTIER_OF_SUBSET_EQ; "FRONTIER_OF_SUBSET_SUBTOPOLOGY",FRONTIER_OF_SUBSET_SUBTOPOLOGY; "FRONTIER_OF_SUBSET_TOPSPACE",FRONTIER_OF_SUBSET_TOPSPACE; "FRONTIER_OF_SUBTOPOLOGY_MONO",FRONTIER_OF_SUBTOPOLOGY_MONO; "FRONTIER_OF_SUBTOPOLOGY_OPEN",FRONTIER_OF_SUBTOPOLOGY_OPEN; "FRONTIER_OF_SUBTOPOLOGY_SUBSET",FRONTIER_OF_SUBTOPOLOGY_SUBSET; "FRONTIER_OF_TOPSPACE",FRONTIER_OF_TOPSPACE; "FRONTIER_OF_TRANSLATION",FRONTIER_OF_TRANSLATION; "FRONTIER_OF_TRIANGLE",FRONTIER_OF_TRIANGLE; "FRONTIER_OF_UNIONS_SUBSET",FRONTIER_OF_UNIONS_SUBSET; "FRONTIER_OF_UNION_SUBSET",FRONTIER_OF_UNION_SUBSET; "FRONTIER_OPEN_INTERVAL",FRONTIER_OPEN_INTERVAL; "FRONTIER_OPEN_MAP_IMAGE_SUBSET",FRONTIER_OPEN_MAP_IMAGE_SUBSET; "FRONTIER_OPEN_STRADDLE_INTER",FRONTIER_OPEN_STRADDLE_INTER; "FRONTIER_OPEN_UNION",FRONTIER_OPEN_UNION; "FRONTIER_OPEN_UNIONS",FRONTIER_OPEN_UNIONS; "FRONTIER_OUTSIDE_SUBSET",FRONTIER_OUTSIDE_SUBSET; "FRONTIER_PCROSS",FRONTIER_PCROSS; "FRONTIER_PROPER_CLOPEN_MAP_IMAGE",FRONTIER_PROPER_CLOPEN_MAP_IMAGE; "FRONTIER_PROPER_MAP_IMAGE_SUBSET",FRONTIER_PROPER_MAP_IMAGE_SUBSET; "FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN",FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN; "FRONTIER_PROPER_OPEN_MAP_IMAGE",FRONTIER_PROPER_OPEN_MAP_IMAGE; "FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE",FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE; "FRONTIER_SCALING",FRONTIER_SCALING; "FRONTIER_SEGMENT",FRONTIER_SEGMENT; "FRONTIER_SING",FRONTIER_SING; "FRONTIER_SPHERE",FRONTIER_SPHERE; "FRONTIER_STRADDLE",FRONTIER_STRADDLE; "FRONTIER_STRIP_COMPONENT_LE",FRONTIER_STRIP_COMPONENT_LE; "FRONTIER_STRIP_COMPONENT_LT",FRONTIER_STRIP_COMPONENT_LT; "FRONTIER_SUBSET_CLOSED",FRONTIER_SUBSET_CLOSED; "FRONTIER_SUBSET_COMPACT",FRONTIER_SUBSET_COMPACT; "FRONTIER_SUBSET_EQ",FRONTIER_SUBSET_EQ; "FRONTIER_SUBSET_RETRACTION",FRONTIER_SUBSET_RETRACTION; "FRONTIER_SURJECTIVE_LINEAR_IMAGE",FRONTIER_SURJECTIVE_LINEAR_IMAGE; "FRONTIER_TRANSLATION",FRONTIER_TRANSLATION; "FRONTIER_UNION",FRONTIER_UNION; "FRONTIER_UNIONS_SUBSET",FRONTIER_UNIONS_SUBSET; "FRONTIER_UNIONS_SUBSET_CLOSURE",FRONTIER_UNIONS_SUBSET_CLOSURE; "FRONTIER_UNION_INTERIOR",FRONTIER_UNION_INTERIOR; "FRONTIER_UNION_SUBSET",FRONTIER_UNION_SUBSET; "FRONTIER_UNIV",FRONTIER_UNIV; "FRONTIER_WITH_INSIDE_SUBSET",FRONTIER_WITH_INSIDE_SUBSET; "FRONTIER_WITH_OUTSIDE_SUBSET",FRONTIER_WITH_OUTSIDE_SUBSET; "FSIGMA_ASCENDING",FSIGMA_ASCENDING; "FSIGMA_BAIRE",FSIGMA_BAIRE; "FSIGMA_BAIRE1_PREIMAGE_OPEN",FSIGMA_BAIRE1_PREIMAGE_OPEN; "FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN",FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN; "FSIGMA_COMPLEMENT",FSIGMA_COMPLEMENT; "FSIGMA_CONTINUOUS_IMAGE",FSIGMA_CONTINUOUS_IMAGE; "FSIGMA_DIFF",FSIGMA_DIFF; "FSIGMA_EMPTY",FSIGMA_EMPTY; "FSIGMA_FSIGMA_PROJECTION",FSIGMA_FSIGMA_PROJECTION; "FSIGMA_IMP_ANALYTIC",FSIGMA_IMP_ANALYTIC; "FSIGMA_IMP_BOREL",FSIGMA_IMP_BOREL; "FSIGMA_IMP_LEBESGUE_MEASURABLE",FSIGMA_IMP_LEBESGUE_MEASURABLE; "FSIGMA_INTER",FSIGMA_INTER; "FSIGMA_INTERS",FSIGMA_INTERS; "FSIGMA_LINEAR_IMAGE",FSIGMA_LINEAR_IMAGE; "FSIGMA_LOCALLY_COMPACT",FSIGMA_LOCALLY_COMPACT; "FSIGMA_PCROSS",FSIGMA_PCROSS; "FSIGMA_PCROSS_EQ",FSIGMA_PCROSS_EQ; "FSIGMA_PREIMAGE_CARD_GE",FSIGMA_PREIMAGE_CARD_GE; "FSIGMA_PROPER_PREIMAGE",FSIGMA_PROPER_PREIMAGE; "FSIGMA_REDUCTION",FSIGMA_REDUCTION; "FSIGMA_REDUCTION_GEN",FSIGMA_REDUCTION_GEN; "FSIGMA_REDUCTION_GEN_2",FSIGMA_REDUCTION_GEN_2; "FSIGMA_REDUCTION_GEN_ALT",FSIGMA_REDUCTION_GEN_ALT; "FSIGMA_SING",FSIGMA_SING; "FSIGMA_TRANSLATION",FSIGMA_TRANSLATION; "FSIGMA_UNION",FSIGMA_UNION; "FSIGMA_UNIONS",FSIGMA_UNIONS; "FSIGMA_UNIONS_CLOPEN_CHAIN",FSIGMA_UNIONS_CLOPEN_CHAIN; "FSIGMA_UNIONS_COMPACT",FSIGMA_UNIONS_COMPACT; "FSIGMA_UNIV",FSIGMA_UNIV; "FST",FST; "FSTCART_ADD",FSTCART_ADD; "FSTCART_CMUL",FSTCART_CMUL; "FSTCART_NEG",FSTCART_NEG; "FSTCART_PASTECART",FSTCART_PASTECART; "FSTCART_SUB",FSTCART_SUB; "FSTCART_VEC",FSTCART_VEC; "FSTCART_VSUM",FSTCART_VSUM; "FST_DEF",FST_DEF; "FUBINI_ABSOLUTELY_INTEGRABLE",FUBINI_ABSOLUTELY_INTEGRABLE; "FUBINI_ABSOLUTELY_INTEGRABLE_ALT",FUBINI_ABSOLUTELY_INTEGRABLE_ALT; "FUBINI_HAS_ABSOLUTE_INTEGRAL",FUBINI_HAS_ABSOLUTE_INTEGRAL; "FUBINI_HAS_ABSOLUTE_INTEGRAL_ALT",FUBINI_HAS_ABSOLUTE_INTEGRAL_ALT; "FUBINI_INTEGRAL",FUBINI_INTEGRAL; "FUBINI_INTEGRAL_ALT",FUBINI_INTEGRAL_ALT; "FUBINI_INTEGRAL_INTERVAL",FUBINI_INTEGRAL_INTERVAL; "FUBINI_INTEGRAL_INTERVAL_ALT",FUBINI_INTEGRAL_INTERVAL_ALT; "FUBINI_LEBESGUE_MEASURABLE",FUBINI_LEBESGUE_MEASURABLE; "FUBINI_LEBESGUE_MEASURABLE_ALT",FUBINI_LEBESGUE_MEASURABLE_ALT; "FUBINI_MEASURE",FUBINI_MEASURE; "FUBINI_MEASURE_ALT",FUBINI_MEASURE_ALT; "FUBINI_NEGLIGIBLE",FUBINI_NEGLIGIBLE; "FUBINI_NEGLIGIBLE_ALT",FUBINI_NEGLIGIBLE_ALT; "FUBINI_NEGLIGIBLE_OFFSET",FUBINI_NEGLIGIBLE_OFFSET; "FUBINI_NEGLIGIBLE_REPLACEMENTS",FUBINI_NEGLIGIBLE_REPLACEMENTS; "FUBINI_NEGLIGIBLE_REPLACEMENTS_ALT",FUBINI_NEGLIGIBLE_REPLACEMENTS_ALT; "FUBINI_TONELLI",FUBINI_TONELLI; "FUBINI_TONELLI_ALT",FUBINI_TONELLI_ALT; "FUBINI_TONELLI_MEASURE",FUBINI_TONELLI_MEASURE; "FUBINI_TONELLI_MEASURE_ALT",FUBINI_TONELLI_MEASURE_ALT; "FUBINI_TONELLI_NEGLIGIBLE",FUBINI_TONELLI_NEGLIGIBLE; "FUBINI_TONELLI_NEGLIGIBLE_ALT",FUBINI_TONELLI_NEGLIGIBLE_ALT; "FULL_RANK_INJECTIVE",FULL_RANK_INJECTIVE; "FULL_RANK_SURJECTIVE",FULL_RANK_SURJECTIVE; "FUNCTION_CONVERGENT_SUBSEQUENCE",FUNCTION_CONVERGENT_SUBSEQUENCE; "FUNCTION_EXTENSION_POINTWISE",FUNCTION_EXTENSION_POINTWISE; "FUNCTION_EXTENSION_POINTWISE_ALT",FUNCTION_EXTENSION_POINTWISE_ALT; "FUNCTION_FACTORS_LEFT",FUNCTION_FACTORS_LEFT; "FUNCTION_FACTORS_LEFT_GEN",FUNCTION_FACTORS_LEFT_GEN; "FUNCTION_FACTORS_RIGHT",FUNCTION_FACTORS_RIGHT; "FUNCTION_FACTORS_RIGHT_GEN",FUNCTION_FACTORS_RIGHT_GEN; "FUNDAMENTAL_GROUP_EQ_EMPTY",FUNDAMENTAL_GROUP_EQ_EMPTY; "FUNDAMENTAL_GROUP_SIMPLY_CONNECTED",FUNDAMENTAL_GROUP_SIMPLY_CONNECTED; "FUNDAMENTAL_THEOREM_OF_CALCULUS",FUNDAMENTAL_THEOREM_OF_CALCULUS; "FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS",FUNDAMENTAL_THEOREM_OF_CALCULUS_ABSOLUTELY_CONTINUOUS; "FUNDAMENTAL_THEOREM_OF_CALCULUS_BARTLE",FUNDAMENTAL_THEOREM_OF_CALCULUS_BARTLE; "FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR; "FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG; "FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG; "FUNSPACE",FUNSPACE; "FUNSPACE_IMP_BOUNDED",FUNSPACE_IMP_BOUNDED; "FUNSPACE_IMP_BOUNDED2",FUNSPACE_IMP_BOUNDED2; "FUNSPACE_IMP_BOUNDED_IMAGE",FUNSPACE_IMP_BOUNDED_IMAGE; "FUNSPACE_IMP_EXTENSIONAL",FUNSPACE_IMP_EXTENSIONAL; "FUNSPACE_IMP_WELLDEFINED",FUNSPACE_IMP_WELLDEFINED; "FUNSPACE_MDIST_LE",FUNSPACE_MDIST_LE; "FUN_EQ_THM",FUN_EQ_THM; "FUN_IN_IMAGE",FUN_IN_IMAGE; "F_DEF",F_DEF; "GABS_DEF",GABS_DEF; "GATEAUX_DERIVATIVE",GATEAUX_DERIVATIVE; "GATEAUX_DERIVATIVE_LIPSCHITZ",GATEAUX_DERIVATIVE_LIPSCHITZ; "GATEAUX_DERIVATIVE_WITHIN",GATEAUX_DERIVATIVE_WITHIN; "GAUGE_BALL",GAUGE_BALL; "GAUGE_BALL_DEPENDENT",GAUGE_BALL_DEPENDENT; "GAUGE_EXISTENCE_LEMMA",GAUGE_EXISTENCE_LEMMA; "GAUGE_INTER",GAUGE_INTER; "GAUGE_INTERS",GAUGE_INTERS; "GAUGE_MODIFY",GAUGE_MODIFY; "GAUGE_TRIVIAL",GAUGE_TRIVIAL; "GDELTA_BAIRE",GDELTA_BAIRE; "GDELTA_BAIRE1_PREIMAGE_CLOSED",GDELTA_BAIRE1_PREIMAGE_CLOSED; "GDELTA_COMPLEMENT",GDELTA_COMPLEMENT; "GDELTA_CONTINUOUS_FUNCTION_MINIMA",GDELTA_CONTINUOUS_FUNCTION_MINIMA; "GDELTA_DESCENDING",GDELTA_DESCENDING; "GDELTA_DIFF",GDELTA_DIFF; "GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS",GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS; "GDELTA_DOMAIN_OF_INJECTIVITY_MEASURABLE",GDELTA_DOMAIN_OF_INJECTIVITY_MEASURABLE; "GDELTA_EMPTY",GDELTA_EMPTY; "GDELTA_IMP_ANALYTIC",GDELTA_IMP_ANALYTIC; "GDELTA_IMP_BOREL",GDELTA_IMP_BOREL; "GDELTA_IMP_LEBESGUE_MEASURABLE",GDELTA_IMP_LEBESGUE_MEASURABLE; "GDELTA_INTER",GDELTA_INTER; "GDELTA_INTERS",GDELTA_INTERS; "GDELTA_INTERS_CLOPEN_CHAIN",GDELTA_INTERS_CLOPEN_CHAIN; "GDELTA_LINEAR_IMAGE",GDELTA_LINEAR_IMAGE; "GDELTA_LOCALLY_COMPACT",GDELTA_LOCALLY_COMPACT; "GDELTA_PCROSS",GDELTA_PCROSS; "GDELTA_PCROSS_EQ",GDELTA_PCROSS_EQ; "GDELTA_POINTS_OF_CONTINUITY",GDELTA_POINTS_OF_CONTINUITY; "GDELTA_POINTS_OF_CONTINUITY_WITHIN",GDELTA_POINTS_OF_CONTINUITY_WITHIN; "GDELTA_POINTS_OF_CONVERGENCE_AT",GDELTA_POINTS_OF_CONVERGENCE_AT; "GDELTA_POINTS_OF_CONVERGENCE_WITHIN",GDELTA_POINTS_OF_CONVERGENCE_WITHIN; "GDELTA_PREIMAGE_CARD_LE",GDELTA_PREIMAGE_CARD_LE; "GDELTA_SEPARATION",GDELTA_SEPARATION; "GDELTA_SEPARATION_GEN",GDELTA_SEPARATION_GEN; "GDELTA_SING",GDELTA_SING; "GDELTA_TRANSLATION",GDELTA_TRANSLATION; "GDELTA_UNION",GDELTA_UNION; "GDELTA_UNIONS",GDELTA_UNIONS; "GDELTA_UNIV",GDELTA_UNIV; "GE",GE; "GENERAL_CONNECTED_OPEN",GENERAL_CONNECTED_OPEN; "GENERAL_REDUCTION_THEOREM",GENERAL_REDUCTION_THEOREM; "GENERAL_REDUCTION_THEOREM_2",GENERAL_REDUCTION_THEOREM_2; "GEOM_ASSOC",GEOM_ASSOC; "GEOM_LADD",GEOM_LADD; "GEOM_LMUL",GEOM_LMUL; "GEOM_LNEG",GEOM_LNEG; "GEOM_LZERO",GEOM_LZERO; "GEOM_MBASIS",GEOM_MBASIS; "GEOM_MBASIS_SING",GEOM_MBASIS_SING; "GEOM_RADD",GEOM_RADD; "GEOM_RMUL",GEOM_RMUL; "GEOM_RNEG",GEOM_RNEG; "GEOM_RZERO",GEOM_RZERO; "GEQ_DEF",GEQ_DEF; "GE_C",GE_C; "GE_REFL",GE_REFL; "GRADE_ADD",GRADE_ADD; "GRADE_CMUL",GRADE_CMUL; "GRAM_SCHMIDT_STEP",GRAM_SCHMIDT_STEP; "GRAPH_EMBEDS_IN_R3",GRAPH_EMBEDS_IN_R3; "GRASSMANN_PLUCKER_2",GRASSMANN_PLUCKER_2; "GRASSMANN_PLUCKER_3",GRASSMANN_PLUCKER_3; "GRASSMANN_PLUCKER_4",GRASSMANN_PLUCKER_4; "GSPEC",GSPEC; "GT",GT; "HADAMARD_INEQUALITY_COLUMN",HADAMARD_INEQUALITY_COLUMN; "HADAMARD_INEQUALITY_PSD",HADAMARD_INEQUALITY_PSD; "HADAMARD_INEQUALITY_ROW",HADAMARD_INEQUALITY_ROW; "HAIRY_BALL_THEOREM",HAIRY_BALL_THEOREM; "HAIRY_BALL_THEOREM_ALT",HAIRY_BALL_THEOREM_ALT; "HALFSPACE_EQ_EMPTY_GE",HALFSPACE_EQ_EMPTY_GE; "HALFSPACE_EQ_EMPTY_GT",HALFSPACE_EQ_EMPTY_GT; "HALFSPACE_EQ_EMPTY_LE",HALFSPACE_EQ_EMPTY_LE; "HALFSPACE_EQ_EMPTY_LT",HALFSPACE_EQ_EMPTY_LT; "HALF_MEASURES",HALF_MEASURES; "HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES",HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES; "HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_INVERTIBLE",HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_INVERTIBLE; "HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_LINEAR",HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_LINEAR; "HAS_ANTIDERIVATIVE_LIMIT",HAS_ANTIDERIVATIVE_LIMIT; "HAS_ANTIDERIVATIVE_SEQUENCE",HAS_ANTIDERIVATIVE_SEQUENCE; "HAS_BOUNDED_SETVARIATION_COMPARISON",HAS_BOUNDED_SETVARIATION_COMPARISON; "HAS_BOUNDED_SETVARIATION_ON",HAS_BOUNDED_SETVARIATION_ON; "HAS_BOUNDED_SETVARIATION_ON_0",HAS_BOUNDED_SETVARIATION_ON_0; "HAS_BOUNDED_SETVARIATION_ON_ADD",HAS_BOUNDED_SETVARIATION_ON_ADD; "HAS_BOUNDED_SETVARIATION_ON_CMUL",HAS_BOUNDED_SETVARIATION_ON_CMUL; "HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE",HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE; "HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR; "HAS_BOUNDED_SETVARIATION_ON_DIVISION",HAS_BOUNDED_SETVARIATION_ON_DIVISION; "HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY; "HAS_BOUNDED_SETVARIATION_ON_EQ",HAS_BOUNDED_SETVARIATION_ON_EQ; "HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; "HAS_BOUNDED_SETVARIATION_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_ON_INTERVAL; "HAS_BOUNDED_SETVARIATION_ON_LIFT_ABS",HAS_BOUNDED_SETVARIATION_ON_LIFT_ABS; "HAS_BOUNDED_SETVARIATION_ON_MUL",HAS_BOUNDED_SETVARIATION_ON_MUL; "HAS_BOUNDED_SETVARIATION_ON_NEG",HAS_BOUNDED_SETVARIATION_ON_NEG; "HAS_BOUNDED_SETVARIATION_ON_NORM",HAS_BOUNDED_SETVARIATION_ON_NORM; "HAS_BOUNDED_SETVARIATION_ON_NULL",HAS_BOUNDED_SETVARIATION_ON_NULL; "HAS_BOUNDED_SETVARIATION_ON_PASTECART",HAS_BOUNDED_SETVARIATION_ON_PASTECART; "HAS_BOUNDED_SETVARIATION_ON_SUB",HAS_BOUNDED_SETVARIATION_ON_SUB; "HAS_BOUNDED_SETVARIATION_ON_SUBSET",HAS_BOUNDED_SETVARIATION_ON_SUBSET; "HAS_BOUNDED_SETVARIATION_ON_UNIV",HAS_BOUNDED_SETVARIATION_ON_UNIV; "HAS_BOUNDED_SETVARIATION_ON_VSUM",HAS_BOUNDED_SETVARIATION_ON_VSUM; "HAS_BOUNDED_SETVARIATION_REFLECT2_EQ",HAS_BOUNDED_SETVARIATION_REFLECT2_EQ; "HAS_BOUNDED_SETVARIATION_TRANSLATION",HAS_BOUNDED_SETVARIATION_TRANSLATION; "HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ",HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ; "HAS_BOUNDED_SETVARIATION_WORKS",HAS_BOUNDED_SETVARIATION_WORKS; "HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY; "HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL; "HAS_BOUNDED_SET_VARIATION",HAS_BOUNDED_SET_VARIATION; "HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE",HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE; "HAS_BOUNDED_VARIATION_AFFINITY2_EQ",HAS_BOUNDED_VARIATION_AFFINITY2_EQ; "HAS_BOUNDED_VARIATION_AFFINITY_EQ",HAS_BOUNDED_VARIATION_AFFINITY_EQ; "HAS_BOUNDED_VARIATION_COMPARISON",HAS_BOUNDED_VARIATION_COMPARISON; "HAS_BOUNDED_VARIATION_COMPOSE_DECREASING",HAS_BOUNDED_VARIATION_COMPOSE_DECREASING; "HAS_BOUNDED_VARIATION_COMPOSE_HOMEOMORPHISM",HAS_BOUNDED_VARIATION_COMPOSE_HOMEOMORPHISM; "HAS_BOUNDED_VARIATION_COMPOSE_INCREASING",HAS_BOUNDED_VARIATION_COMPOSE_INCREASING; "HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN",HAS_BOUNDED_VARIATION_COMPOSE_INCREASING_GEN; "HAS_BOUNDED_VARIATION_COMPOSE_INJECTIVE",HAS_BOUNDED_VARIATION_COMPOSE_INJECTIVE; "HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES",HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES; "HAS_BOUNDED_VARIATION_DARBOUX",HAS_BOUNDED_VARIATION_DARBOUX; "HAS_BOUNDED_VARIATION_DARBOUX_GEN",HAS_BOUNDED_VARIATION_DARBOUX_GEN; "HAS_BOUNDED_VARIATION_DARBOUX_STRICT",HAS_BOUNDED_VARIATION_DARBOUX_STRICT; "HAS_BOUNDED_VARIATION_DARBOUX_STRONG",HAS_BOUNDED_VARIATION_DARBOUX_STRONG; "HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE",HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE; "HAS_BOUNDED_VARIATION_ISOMETRIC",HAS_BOUNDED_VARIATION_ISOMETRIC; "HAS_BOUNDED_VARIATION_ISOMETRIC_COMPOSE",HAS_BOUNDED_VARIATION_ISOMETRIC_COMPOSE; "HAS_BOUNDED_VARIATION_LEFT_LIMIT_GEN",HAS_BOUNDED_VARIATION_LEFT_LIMIT_GEN; "HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE",HAS_BOUNDED_VARIATION_LIPSCHITZ_COMPOSE; "HAS_BOUNDED_VARIATION_NONTRIVIAL",HAS_BOUNDED_VARIATION_NONTRIVIAL; "HAS_BOUNDED_VARIATION_ON_ADD",HAS_BOUNDED_VARIATION_ON_ADD; "HAS_BOUNDED_VARIATION_ON_BILINEAR",HAS_BOUNDED_VARIATION_ON_BILINEAR; "HAS_BOUNDED_VARIATION_ON_CLOSURE",HAS_BOUNDED_VARIATION_ON_CLOSURE; "HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ",HAS_BOUNDED_VARIATION_ON_CLOSURE_EQ; "HAS_BOUNDED_VARIATION_ON_CMUL",HAS_BOUNDED_VARIATION_ON_CMUL; "HAS_BOUNDED_VARIATION_ON_CMUL_EQ",HAS_BOUNDED_VARIATION_ON_CMUL_EQ; "HAS_BOUNDED_VARIATION_ON_COMBINE",HAS_BOUNDED_VARIATION_ON_COMBINE; "HAS_BOUNDED_VARIATION_ON_COMBINE_GEN",HAS_BOUNDED_VARIATION_ON_COMBINE_GEN; "HAS_BOUNDED_VARIATION_ON_COMPONENTWISE",HAS_BOUNDED_VARIATION_ON_COMPONENTWISE; "HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR; "HAS_BOUNDED_VARIATION_ON_CONST",HAS_BOUNDED_VARIATION_ON_CONST; "HAS_BOUNDED_VARIATION_ON_DARBOUX_IMP_CONTINUOUS",HAS_BOUNDED_VARIATION_ON_DARBOUX_IMP_CONTINUOUS; "HAS_BOUNDED_VARIATION_ON_DIVISION",HAS_BOUNDED_VARIATION_ON_DIVISION; "HAS_BOUNDED_VARIATION_ON_EMPTY",HAS_BOUNDED_VARIATION_ON_EMPTY; "HAS_BOUNDED_VARIATION_ON_EQ",HAS_BOUNDED_VARIATION_ON_EQ; "HAS_BOUNDED_VARIATION_ON_ID",HAS_BOUNDED_VARIATION_ON_ID; "HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED; "HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL; "HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; "HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT; "HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT; "HAS_BOUNDED_VARIATION_ON_INTERIOR",HAS_BOUNDED_VARIATION_ON_INTERIOR; "HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ",HAS_BOUNDED_VARIATION_ON_INTERIOR_EQ; "HAS_BOUNDED_VARIATION_ON_INTERVAL",HAS_BOUNDED_VARIATION_ON_INTERVAL; "HAS_BOUNDED_VARIATION_ON_LIFT_ABS",HAS_BOUNDED_VARIATION_ON_LIFT_ABS; "HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE",HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE; "HAS_BOUNDED_VARIATION_ON_MAX",HAS_BOUNDED_VARIATION_ON_MAX; "HAS_BOUNDED_VARIATION_ON_MIN",HAS_BOUNDED_VARIATION_ON_MIN; "HAS_BOUNDED_VARIATION_ON_MUL",HAS_BOUNDED_VARIATION_ON_MUL; "HAS_BOUNDED_VARIATION_ON_NEG",HAS_BOUNDED_VARIATION_ON_NEG; "HAS_BOUNDED_VARIATION_ON_NORM",HAS_BOUNDED_VARIATION_ON_NORM; "HAS_BOUNDED_VARIATION_ON_NULL",HAS_BOUNDED_VARIATION_ON_NULL; "HAS_BOUNDED_VARIATION_ON_PASTECART",HAS_BOUNDED_VARIATION_ON_PASTECART; "HAS_BOUNDED_VARIATION_ON_REFLECT",HAS_BOUNDED_VARIATION_ON_REFLECT; "HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL",HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL; "HAS_BOUNDED_VARIATION_ON_SING",HAS_BOUNDED_VARIATION_ON_SING; "HAS_BOUNDED_VARIATION_ON_SPLIT",HAS_BOUNDED_VARIATION_ON_SPLIT; "HAS_BOUNDED_VARIATION_ON_SUB",HAS_BOUNDED_VARIATION_ON_SUB; "HAS_BOUNDED_VARIATION_ON_SUBSET",HAS_BOUNDED_VARIATION_ON_SUBSET; "HAS_BOUNDED_VARIATION_ON_TRANSLATION",HAS_BOUNDED_VARIATION_ON_TRANSLATION; "HAS_BOUNDED_VARIATION_ON_UNION",HAS_BOUNDED_VARIATION_ON_UNION; "HAS_BOUNDED_VARIATION_ON_VECTOR_VARIATION",HAS_BOUNDED_VARIATION_ON_VECTOR_VARIATION; "HAS_BOUNDED_VARIATION_ON_VMUL",HAS_BOUNDED_VARIATION_ON_VMUL; "HAS_BOUNDED_VARIATION_ON_VMUL_EQ",HAS_BOUNDED_VARIATION_ON_VMUL_EQ; "HAS_BOUNDED_VARIATION_ON_VSUM",HAS_BOUNDED_VARIATION_ON_VSUM; "HAS_BOUNDED_VARIATION_REFLECT2_EQ",HAS_BOUNDED_VARIATION_REFLECT2_EQ; "HAS_BOUNDED_VARIATION_REFLECT_EQ",HAS_BOUNDED_VARIATION_REFLECT_EQ; "HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL",HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL; "HAS_BOUNDED_VARIATION_RIGHT_LIMIT_GEN",HAS_BOUNDED_VARIATION_RIGHT_LIMIT_GEN; "HAS_BOUNDED_VARIATION_TRANSLATION",HAS_BOUNDED_VARIATION_TRANSLATION; "HAS_BOUNDED_VARIATION_TRANSLATION2_EQ",HAS_BOUNDED_VARIATION_TRANSLATION2_EQ; "HAS_BOUNDED_VARIATION_TRANSLATION_EQ",HAS_BOUNDED_VARIATION_TRANSLATION_EQ; "HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL",HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL; "HAS_BOUNDED_VARIATION_WORKS",HAS_BOUNDED_VARIATION_WORKS; "HAS_BOUNDED_VARIATION_WORKS_ON_ELEMENTARY",HAS_BOUNDED_VARIATION_WORKS_ON_ELEMENTARY; "HAS_BOUNDED_VARIATION_WORKS_ON_INTERVAL",HAS_BOUNDED_VARIATION_WORKS_ON_INTERVAL; "HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_HAS_BOUNDED_VARIATION_ON",HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_HAS_BOUNDED_VARIATION_ON; "HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_LIPSCHITZ",HAS_BOUNDED_VECTOR_DERIVATIVE_IMP_LIPSCHITZ; "HAS_BOUNDED_VECTOR_VARIATION",HAS_BOUNDED_VECTOR_VARIATION; "HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT; "HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL",HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL; "HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL_GEN",HAS_BOUNDED_VECTOR_VARIATION_ON_INTERVAL_GEN; "HAS_BOUNDED_VECTOR_VARIATION_ON_SUBINTERVALS",HAS_BOUNDED_VECTOR_VARIATION_ON_SUBINTERVALS; "HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT; "HAS_BOUNDED_VECTOR_VARIATION_UNIFORM_LIM",HAS_BOUNDED_VECTOR_VARIATION_UNIFORM_LIM; "HAS_DERIVATIVE_ADD",HAS_DERIVATIVE_ADD; "HAS_DERIVATIVE_AT",HAS_DERIVATIVE_AT; "HAS_DERIVATIVE_AT_ALT",HAS_DERIVATIVE_AT_ALT; "HAS_DERIVATIVE_AT_REFLECT",HAS_DERIVATIVE_AT_REFLECT; "HAS_DERIVATIVE_AT_WITHIN",HAS_DERIVATIVE_AT_WITHIN; "HAS_DERIVATIVE_BILINEAR_AT",HAS_DERIVATIVE_BILINEAR_AT; "HAS_DERIVATIVE_BILINEAR_WITHIN",HAS_DERIVATIVE_BILINEAR_WITHIN; "HAS_DERIVATIVE_CMUL",HAS_DERIVATIVE_CMUL; "HAS_DERIVATIVE_CMUL_EQ",HAS_DERIVATIVE_CMUL_EQ; "HAS_DERIVATIVE_COMPONENTWISE_AT",HAS_DERIVATIVE_COMPONENTWISE_AT; "HAS_DERIVATIVE_COMPONENTWISE_WITHIN",HAS_DERIVATIVE_COMPONENTWISE_WITHIN; "HAS_DERIVATIVE_CONST",HAS_DERIVATIVE_CONST; "HAS_DERIVATIVE_ID",HAS_DERIVATIVE_ID; "HAS_DERIVATIVE_IMP_DIFFERENTIABLE",HAS_DERIVATIVE_IMP_DIFFERENTIABLE; "HAS_DERIVATIVE_INVERSE",HAS_DERIVATIVE_INVERSE; "HAS_DERIVATIVE_INVERSE_BASIC",HAS_DERIVATIVE_INVERSE_BASIC; "HAS_DERIVATIVE_INVERSE_BASIC_X",HAS_DERIVATIVE_INVERSE_BASIC_X; "HAS_DERIVATIVE_INVERSE_DIEUDONNE",HAS_DERIVATIVE_INVERSE_DIEUDONNE; "HAS_DERIVATIVE_INVERSE_ON",HAS_DERIVATIVE_INVERSE_ON; "HAS_DERIVATIVE_INVERSE_STRONG",HAS_DERIVATIVE_INVERSE_STRONG; "HAS_DERIVATIVE_INVERSE_STRONG_X",HAS_DERIVATIVE_INVERSE_STRONG_X; "HAS_DERIVATIVE_INVERSE_WITHIN",HAS_DERIVATIVE_INVERSE_WITHIN; "HAS_DERIVATIVE_LIFT_COMPONENT",HAS_DERIVATIVE_LIFT_COMPONENT; "HAS_DERIVATIVE_LIFT_DOT",HAS_DERIVATIVE_LIFT_DOT; "HAS_DERIVATIVE_LINEAR",HAS_DERIVATIVE_LINEAR; "HAS_DERIVATIVE_LOCALLY_INJECTIVE",HAS_DERIVATIVE_LOCALLY_INJECTIVE; "HAS_DERIVATIVE_MUL_AT",HAS_DERIVATIVE_MUL_AT; "HAS_DERIVATIVE_MUL_WITHIN",HAS_DERIVATIVE_MUL_WITHIN; "HAS_DERIVATIVE_NEG",HAS_DERIVATIVE_NEG; "HAS_DERIVATIVE_NEG_EQ",HAS_DERIVATIVE_NEG_EQ; "HAS_DERIVATIVE_PASTECART",HAS_DERIVATIVE_PASTECART; "HAS_DERIVATIVE_PASTECART_EQ",HAS_DERIVATIVE_PASTECART_EQ; "HAS_DERIVATIVE_SEQUENCE",HAS_DERIVATIVE_SEQUENCE; "HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ",HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ; "HAS_DERIVATIVE_SERIES",HAS_DERIVATIVE_SERIES; "HAS_DERIVATIVE_SQNORM_AT",HAS_DERIVATIVE_SQNORM_AT; "HAS_DERIVATIVE_SUB",HAS_DERIVATIVE_SUB; "HAS_DERIVATIVE_TRANSFORM_AT",HAS_DERIVATIVE_TRANSFORM_AT; "HAS_DERIVATIVE_TRANSFORM_WITHIN",HAS_DERIVATIVE_TRANSFORM_WITHIN; "HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN; "HAS_DERIVATIVE_VMUL_COMPONENT",HAS_DERIVATIVE_VMUL_COMPONENT; "HAS_DERIVATIVE_VMUL_DROP",HAS_DERIVATIVE_VMUL_DROP; "HAS_DERIVATIVE_VSUM",HAS_DERIVATIVE_VSUM; "HAS_DERIVATIVE_VSUM_NUMSEG",HAS_DERIVATIVE_VSUM_NUMSEG; "HAS_DERIVATIVE_WITHIN",HAS_DERIVATIVE_WITHIN; "HAS_DERIVATIVE_WITHIN_ALT",HAS_DERIVATIVE_WITHIN_ALT; "HAS_DERIVATIVE_WITHIN_OPEN",HAS_DERIVATIVE_WITHIN_OPEN; "HAS_DERIVATIVE_WITHIN_OPEN_IN",HAS_DERIVATIVE_WITHIN_OPEN_IN; "HAS_DERIVATIVE_WITHIN_REFLECT",HAS_DERIVATIVE_WITHIN_REFLECT; "HAS_DERIVATIVE_WITHIN_SUBSET",HAS_DERIVATIVE_WITHIN_SUBSET; "HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT",HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT; "HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE",HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE; "HAS_DERIVATIVE_ZERO_CONSTANT",HAS_DERIVATIVE_ZERO_CONSTANT; "HAS_DERIVATIVE_ZERO_UNIQUE",HAS_DERIVATIVE_ZERO_UNIQUE; "HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED; "HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX; "HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL; "HAS_DOUBLE_INTEGRAL_CONVOLUTION",HAS_DOUBLE_INTEGRAL_CONVOLUTION; "HAS_DOUBLE_INTEGRAL_PCROSS",HAS_DOUBLE_INTEGRAL_PCROSS; "HAS_FRECHET_DERIVATIVE_UNIQUE_AT",HAS_FRECHET_DERIVATIVE_UNIQUE_AT; "HAS_INTEGRAL",HAS_INTEGRAL; "HAS_INTEGRAL_0",HAS_INTEGRAL_0; "HAS_INTEGRAL_0_EQ",HAS_INTEGRAL_0_EQ; "HAS_INTEGRAL_ADD",HAS_INTEGRAL_ADD; "HAS_INTEGRAL_AFFINITY",HAS_INTEGRAL_AFFINITY; "HAS_INTEGRAL_ALT",HAS_INTEGRAL_ALT; "HAS_INTEGRAL_BOUND",HAS_INTEGRAL_BOUND; "HAS_INTEGRAL_CLOSURE",HAS_INTEGRAL_CLOSURE; "HAS_INTEGRAL_CMUL",HAS_INTEGRAL_CMUL; "HAS_INTEGRAL_COMBINE",HAS_INTEGRAL_COMBINE; "HAS_INTEGRAL_COMBINE_DIVISION",HAS_INTEGRAL_COMBINE_DIVISION; "HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN; "HAS_INTEGRAL_COMBINE_TAGGED_DIVISION",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION; "HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; "HAS_INTEGRAL_COMPONENTWISE",HAS_INTEGRAL_COMPONENTWISE; "HAS_INTEGRAL_COMPONENT_LBOUND",HAS_INTEGRAL_COMPONENT_LBOUND; "HAS_INTEGRAL_COMPONENT_LE",HAS_INTEGRAL_COMPONENT_LE; "HAS_INTEGRAL_COMPONENT_LE_AE",HAS_INTEGRAL_COMPONENT_LE_AE; "HAS_INTEGRAL_COMPONENT_NEG",HAS_INTEGRAL_COMPONENT_NEG; "HAS_INTEGRAL_COMPONENT_POS",HAS_INTEGRAL_COMPONENT_POS; "HAS_INTEGRAL_COMPONENT_UBOUND",HAS_INTEGRAL_COMPONENT_UBOUND; "HAS_INTEGRAL_CONST",HAS_INTEGRAL_CONST; "HAS_INTEGRAL_CONST_GEN",HAS_INTEGRAL_CONST_GEN; "HAS_INTEGRAL_CONVOLUTION_SYM",HAS_INTEGRAL_CONVOLUTION_SYM; "HAS_INTEGRAL_DIFF",HAS_INTEGRAL_DIFF; "HAS_INTEGRAL_DROP_LE",HAS_INTEGRAL_DROP_LE; "HAS_INTEGRAL_DROP_LE_AE",HAS_INTEGRAL_DROP_LE_AE; "HAS_INTEGRAL_DROP_NEG",HAS_INTEGRAL_DROP_NEG; "HAS_INTEGRAL_DROP_POS",HAS_INTEGRAL_DROP_POS; "HAS_INTEGRAL_DROP_POS_AE",HAS_INTEGRAL_DROP_POS_AE; "HAS_INTEGRAL_EMPTY",HAS_INTEGRAL_EMPTY; "HAS_INTEGRAL_EMPTY_EQ",HAS_INTEGRAL_EMPTY_EQ; "HAS_INTEGRAL_EQ",HAS_INTEGRAL_EQ; "HAS_INTEGRAL_EQ_EQ",HAS_INTEGRAL_EQ_EQ; "HAS_INTEGRAL_FACTOR_CONTENT",HAS_INTEGRAL_FACTOR_CONTENT; "HAS_INTEGRAL_INTEGRABLE",HAS_INTEGRAL_INTEGRABLE; "HAS_INTEGRAL_INTEGRABLE_INTEGRAL",HAS_INTEGRAL_INTEGRABLE_INTEGRAL; "HAS_INTEGRAL_INTEGRAL",HAS_INTEGRAL_INTEGRAL; "HAS_INTEGRAL_INTERIOR",HAS_INTEGRAL_INTERIOR; "HAS_INTEGRAL_IS_0",HAS_INTEGRAL_IS_0; "HAS_INTEGRAL_LIM_AT_POSINFINITY",HAS_INTEGRAL_LIM_AT_POSINFINITY; "HAS_INTEGRAL_LIM_AT_POSINFINITY_GEN",HAS_INTEGRAL_LIM_AT_POSINFINITY_GEN; "HAS_INTEGRAL_LIM_SEQUENTIALLY",HAS_INTEGRAL_LIM_SEQUENTIALLY; "HAS_INTEGRAL_LINEAR",HAS_INTEGRAL_LINEAR; "HAS_INTEGRAL_MEASURE_UNDER_CURVE",HAS_INTEGRAL_MEASURE_UNDER_CURVE; "HAS_INTEGRAL_NEG",HAS_INTEGRAL_NEG; "HAS_INTEGRAL_NEGLIGIBLE",HAS_INTEGRAL_NEGLIGIBLE; "HAS_INTEGRAL_NEGLIGIBLE_EQ",HAS_INTEGRAL_NEGLIGIBLE_EQ; "HAS_INTEGRAL_NEGLIGIBLE_EQ_AE",HAS_INTEGRAL_NEGLIGIBLE_EQ_AE; "HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; "HAS_INTEGRAL_NULL",HAS_INTEGRAL_NULL; "HAS_INTEGRAL_NULL_EQ",HAS_INTEGRAL_NULL_EQ; "HAS_INTEGRAL_ON_NEGLIGIBLE",HAS_INTEGRAL_ON_NEGLIGIBLE; "HAS_INTEGRAL_ON_SUPERSET",HAS_INTEGRAL_ON_SUPERSET; "HAS_INTEGRAL_OPEN_INTERVAL",HAS_INTEGRAL_OPEN_INTERVAL; "HAS_INTEGRAL_PASTECART_SYM",HAS_INTEGRAL_PASTECART_SYM; "HAS_INTEGRAL_PASTECART_SYM_ALT",HAS_INTEGRAL_PASTECART_SYM_ALT; "HAS_INTEGRAL_PASTECART_SYM_UNIV",HAS_INTEGRAL_PASTECART_SYM_UNIV; "HAS_INTEGRAL_REFL",HAS_INTEGRAL_REFL; "HAS_INTEGRAL_REFLECT",HAS_INTEGRAL_REFLECT; "HAS_INTEGRAL_REFLECT_GEN",HAS_INTEGRAL_REFLECT_GEN; "HAS_INTEGRAL_REFLECT_LEMMA",HAS_INTEGRAL_REFLECT_LEMMA; "HAS_INTEGRAL_RESTRICT",HAS_INTEGRAL_RESTRICT; "HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL; "HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ; "HAS_INTEGRAL_RESTRICT_INTER",HAS_INTEGRAL_RESTRICT_INTER; "HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL; "HAS_INTEGRAL_RESTRICT_UNIV",HAS_INTEGRAL_RESTRICT_UNIV; "HAS_INTEGRAL_SEPARATE_SIDES",HAS_INTEGRAL_SEPARATE_SIDES; "HAS_INTEGRAL_SPIKE",HAS_INTEGRAL_SPIKE; "HAS_INTEGRAL_SPIKE_EQ",HAS_INTEGRAL_SPIKE_EQ; "HAS_INTEGRAL_SPIKE_FINITE",HAS_INTEGRAL_SPIKE_FINITE; "HAS_INTEGRAL_SPIKE_FINITE_EQ",HAS_INTEGRAL_SPIKE_FINITE_EQ; "HAS_INTEGRAL_SPIKE_INTERIOR",HAS_INTEGRAL_SPIKE_INTERIOR; "HAS_INTEGRAL_SPIKE_INTERIOR_EQ",HAS_INTEGRAL_SPIKE_INTERIOR_EQ; "HAS_INTEGRAL_SPIKE_SET",HAS_INTEGRAL_SPIKE_SET; "HAS_INTEGRAL_SPIKE_SET_EQ",HAS_INTEGRAL_SPIKE_SET_EQ; "HAS_INTEGRAL_SPLIT",HAS_INTEGRAL_SPLIT; "HAS_INTEGRAL_STRADDLE_NULL",HAS_INTEGRAL_STRADDLE_NULL; "HAS_INTEGRAL_STRETCH",HAS_INTEGRAL_STRETCH; "HAS_INTEGRAL_SUB",HAS_INTEGRAL_SUB; "HAS_INTEGRAL_SUBSET_COMPONENT_LE",HAS_INTEGRAL_SUBSET_COMPONENT_LE; "HAS_INTEGRAL_SUBSET_DROP_LE",HAS_INTEGRAL_SUBSET_DROP_LE; "HAS_INTEGRAL_SUBSTITUTION_STRONG",HAS_INTEGRAL_SUBSTITUTION_STRONG; "HAS_INTEGRAL_TRANSLATION",HAS_INTEGRAL_TRANSLATION; "HAS_INTEGRAL_TWIDDLE",HAS_INTEGRAL_TWIDDLE; "HAS_INTEGRAL_TWIDDLE_GEN",HAS_INTEGRAL_TWIDDLE_GEN; "HAS_INTEGRAL_TWIZZLE",HAS_INTEGRAL_TWIZZLE; "HAS_INTEGRAL_TWIZZLE_EQ",HAS_INTEGRAL_TWIZZLE_EQ; "HAS_INTEGRAL_TWIZZLE_INTERVAL",HAS_INTEGRAL_TWIZZLE_INTERVAL; "HAS_INTEGRAL_UNION",HAS_INTEGRAL_UNION; "HAS_INTEGRAL_UNIONS",HAS_INTEGRAL_UNIONS; "HAS_INTEGRAL_UNIONS_IMAGE",HAS_INTEGRAL_UNIONS_IMAGE; "HAS_INTEGRAL_UNIQUE",HAS_INTEGRAL_UNIQUE; "HAS_INTEGRAL_VSUM",HAS_INTEGRAL_VSUM; "HAS_MEASURE",HAS_MEASURE; "HAS_MEASURE_0",HAS_MEASURE_0; "HAS_MEASURE_AFFINITY",HAS_MEASURE_AFFINITY; "HAS_MEASURE_ALMOST",HAS_MEASURE_ALMOST; "HAS_MEASURE_ALMOST_EQ",HAS_MEASURE_ALMOST_EQ; "HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS; "HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED; "HAS_MEASURE_DIFFERENTIABLE_IMAGE",HAS_MEASURE_DIFFERENTIABLE_IMAGE; "HAS_MEASURE_DIFF_NEGLIGIBLE",HAS_MEASURE_DIFF_NEGLIGIBLE; "HAS_MEASURE_DIFF_NEGLIGIBLE_EQ",HAS_MEASURE_DIFF_NEGLIGIBLE_EQ; "HAS_MEASURE_DIFF_SUBSET",HAS_MEASURE_DIFF_SUBSET; "HAS_MEASURE_DISJOINT_UNION",HAS_MEASURE_DISJOINT_UNION; "HAS_MEASURE_DISJOINT_UNIONS",HAS_MEASURE_DISJOINT_UNIONS; "HAS_MEASURE_DISJOINT_UNIONS_IMAGE",HAS_MEASURE_DISJOINT_UNIONS_IMAGE; "HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; "HAS_MEASURE_ELEMENTARY",HAS_MEASURE_ELEMENTARY; "HAS_MEASURE_EMPTY",HAS_MEASURE_EMPTY; "HAS_MEASURE_IMAGE_STD_SIMPLEX",HAS_MEASURE_IMAGE_STD_SIMPLEX; "HAS_MEASURE_IMP_MEASURABLE",HAS_MEASURE_IMP_MEASURABLE; "HAS_MEASURE_INNER_OUTER",HAS_MEASURE_INNER_OUTER; "HAS_MEASURE_INNER_OUTER_LE",HAS_MEASURE_INNER_OUTER_LE; "HAS_MEASURE_INTERVAL",HAS_MEASURE_INTERVAL; "HAS_MEASURE_ISOMETRY",HAS_MEASURE_ISOMETRY; "HAS_MEASURE_LIMIT",HAS_MEASURE_LIMIT; "HAS_MEASURE_LINEAR_IMAGE",HAS_MEASURE_LINEAR_IMAGE; "HAS_MEASURE_LINEAR_IMAGE_ALT",HAS_MEASURE_LINEAR_IMAGE_ALT; "HAS_MEASURE_LINEAR_IMAGE_SAME",HAS_MEASURE_LINEAR_IMAGE_SAME; "HAS_MEASURE_LINEAR_SUFFICIENT",HAS_MEASURE_LINEAR_SUFFICIENT; "HAS_MEASURE_MEASURABLE_MEASURE",HAS_MEASURE_MEASURABLE_MEASURE; "HAS_MEASURE_MEASURE",HAS_MEASURE_MEASURE; "HAS_MEASURE_NEGLIGIBLE_SYMDIFF",HAS_MEASURE_NEGLIGIBLE_SYMDIFF; "HAS_MEASURE_NEGLIGIBLE_UNION",HAS_MEASURE_NEGLIGIBLE_UNION; "HAS_MEASURE_NEGLIGIBLE_UNIONS",HAS_MEASURE_NEGLIGIBLE_UNIONS; "HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE; "HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; "HAS_MEASURE_NESTED_INTERS",HAS_MEASURE_NESTED_INTERS; "HAS_MEASURE_NESTED_UNIONS",HAS_MEASURE_NESTED_UNIONS; "HAS_MEASURE_ORTHOGONAL_IMAGE",HAS_MEASURE_ORTHOGONAL_IMAGE; "HAS_MEASURE_ORTHOGONAL_IMAGE_EQ",HAS_MEASURE_ORTHOGONAL_IMAGE_EQ; "HAS_MEASURE_PCROSS",HAS_MEASURE_PCROSS; "HAS_MEASURE_POS_LE",HAS_MEASURE_POS_LE; "HAS_MEASURE_SCALING",HAS_MEASURE_SCALING; "HAS_MEASURE_SCALING_EQ",HAS_MEASURE_SCALING_EQ; "HAS_MEASURE_SHEAR_INTERVAL",HAS_MEASURE_SHEAR_INTERVAL; "HAS_MEASURE_SIMPLEX",HAS_MEASURE_SIMPLEX; "HAS_MEASURE_SIMPLEX_0",HAS_MEASURE_SIMPLEX_0; "HAS_MEASURE_STD_SIMPLEX",HAS_MEASURE_STD_SIMPLEX; "HAS_MEASURE_STRETCH",HAS_MEASURE_STRETCH; "HAS_MEASURE_SUBSET",HAS_MEASURE_SUBSET; "HAS_MEASURE_TETRAHEDRON",HAS_MEASURE_TETRAHEDRON; "HAS_MEASURE_TRANSLATION",HAS_MEASURE_TRANSLATION; "HAS_MEASURE_TRANSLATION_EQ",HAS_MEASURE_TRANSLATION_EQ; "HAS_MEASURE_TRIANGLE",HAS_MEASURE_TRIANGLE; "HAS_MEASURE_UNION_NEGLIGIBLE",HAS_MEASURE_UNION_NEGLIGIBLE; "HAS_MEASURE_UNION_NEGLIGIBLE_EQ",HAS_MEASURE_UNION_NEGLIGIBLE_EQ; "HAS_MEASURE_UNIQUE",HAS_MEASURE_UNIQUE; "HAS_SIZE",HAS_SIZE; "HAS_SIZE_0",HAS_SIZE_0; "HAS_SIZE_1",HAS_SIZE_1; "HAS_SIZE_1_EXISTS",HAS_SIZE_1_EXISTS; "HAS_SIZE_2",HAS_SIZE_2; "HAS_SIZE_2_EXISTS",HAS_SIZE_2_EXISTS; "HAS_SIZE_3",HAS_SIZE_3; "HAS_SIZE_4",HAS_SIZE_4; "HAS_SIZE_BOOL",HAS_SIZE_BOOL; "HAS_SIZE_CARD",HAS_SIZE_CARD; "HAS_SIZE_CART",HAS_SIZE_CART; "HAS_SIZE_CART_UNIV",HAS_SIZE_CART_UNIV; "HAS_SIZE_CLAUSES",HAS_SIZE_CLAUSES; "HAS_SIZE_CROSS",HAS_SIZE_CROSS; "HAS_SIZE_DIFF",HAS_SIZE_DIFF; "HAS_SIZE_FACES_OF_SIMPLEX",HAS_SIZE_FACES_OF_SIMPLEX; "HAS_SIZE_FINITE_IMAGE",HAS_SIZE_FINITE_IMAGE; "HAS_SIZE_FUNSPACE",HAS_SIZE_FUNSPACE; "HAS_SIZE_FUNSPACE_UNIV",HAS_SIZE_FUNSPACE_UNIV; "HAS_SIZE_IMAGE_INJ",HAS_SIZE_IMAGE_INJ; "HAS_SIZE_IMAGE_INJ_EQ",HAS_SIZE_IMAGE_INJ_EQ; "HAS_SIZE_INDEX",HAS_SIZE_INDEX; "HAS_SIZE_INTER_SPHERE_1",HAS_SIZE_INTER_SPHERE_1; "HAS_SIZE_INTSEG_INT",HAS_SIZE_INTSEG_INT; "HAS_SIZE_INTSEG_NUM",HAS_SIZE_INTSEG_NUM; "HAS_SIZE_MULTIVECTOR",HAS_SIZE_MULTIVECTOR; "HAS_SIZE_NUMSEG",HAS_SIZE_NUMSEG; "HAS_SIZE_NUMSEG_1",HAS_SIZE_NUMSEG_1; "HAS_SIZE_NUMSEG_LE",HAS_SIZE_NUMSEG_LE; "HAS_SIZE_NUMSEG_LT",HAS_SIZE_NUMSEG_LT; "HAS_SIZE_PCROSS",HAS_SIZE_PCROSS; "HAS_SIZE_PERMUTATIONS",HAS_SIZE_PERMUTATIONS; "HAS_SIZE_POWERSET",HAS_SIZE_POWERSET; "HAS_SIZE_PRODUCT",HAS_SIZE_PRODUCT; "HAS_SIZE_PRODUCT_DEPENDENT",HAS_SIZE_PRODUCT_DEPENDENT; "HAS_SIZE_SET_OF_LIST",HAS_SIZE_SET_OF_LIST; "HAS_SIZE_SPHERE_1",HAS_SIZE_SPHERE_1; "HAS_SIZE_SPHERE_2",HAS_SIZE_SPHERE_2; "HAS_SIZE_STDBASIS",HAS_SIZE_STDBASIS; "HAS_SIZE_SUC",HAS_SIZE_SUC; "HAS_SIZE_UNION",HAS_SIZE_UNION; "HAS_SIZE_UNIONS",HAS_SIZE_UNIONS; "HAS_VECTOR_DERIVATIVE_ADD",HAS_VECTOR_DERIVATIVE_ADD; "HAS_VECTOR_DERIVATIVE_AT_1D",HAS_VECTOR_DERIVATIVE_AT_1D; "HAS_VECTOR_DERIVATIVE_AT_WITHIN",HAS_VECTOR_DERIVATIVE_AT_WITHIN; "HAS_VECTOR_DERIVATIVE_BILINEAR_AT",HAS_VECTOR_DERIVATIVE_BILINEAR_AT; "HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN",HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN; "HAS_VECTOR_DERIVATIVE_CMUL",HAS_VECTOR_DERIVATIVE_CMUL; "HAS_VECTOR_DERIVATIVE_CMUL_EQ",HAS_VECTOR_DERIVATIVE_CMUL_EQ; "HAS_VECTOR_DERIVATIVE_CONST",HAS_VECTOR_DERIVATIVE_CONST; "HAS_VECTOR_DERIVATIVE_ID",HAS_VECTOR_DERIVATIVE_ID; "HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE",HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE; "HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL",HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL; "HAS_VECTOR_DERIVATIVE_NEG",HAS_VECTOR_DERIVATIVE_NEG; "HAS_VECTOR_DERIVATIVE_NEG_EQ",HAS_VECTOR_DERIVATIVE_NEG_EQ; "HAS_VECTOR_DERIVATIVE_SUB",HAS_VECTOR_DERIVATIVE_SUB; "HAS_VECTOR_DERIVATIVE_TRANSFORM_AT",HAS_VECTOR_DERIVATIVE_TRANSFORM_AT; "HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN; "HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN; "HAS_VECTOR_DERIVATIVE_UNIQUE_AT",HAS_VECTOR_DERIVATIVE_UNIQUE_AT; "HAS_VECTOR_DERIVATIVE_WITHIN_1D",HAS_VECTOR_DERIVATIVE_WITHIN_1D; "HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET",HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET; "HAUSDIST_ALT",HAUSDIST_ALT; "HAUSDIST_BALLS",HAUSDIST_BALLS; "HAUSDIST_CLOSURE",HAUSDIST_CLOSURE; "HAUSDIST_COMPACT_EXISTS",HAUSDIST_COMPACT_EXISTS; "HAUSDIST_COMPACT_INTERS_LIMIT",HAUSDIST_COMPACT_INTERS_LIMIT; "HAUSDIST_COMPACT_NONTRIVIAL",HAUSDIST_COMPACT_NONTRIVIAL; "HAUSDIST_COMPACT_SUMS",HAUSDIST_COMPACT_SUMS; "HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT",HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT; "HAUSDIST_COMPLEMENTS_CONVEX_LE",HAUSDIST_COMPLEMENTS_CONVEX_LE; "HAUSDIST_CONVEX_HULLS",HAUSDIST_CONVEX_HULLS; "HAUSDIST_EMPTY",HAUSDIST_EMPTY; "HAUSDIST_EQ",HAUSDIST_EQ; "HAUSDIST_EQ_0",HAUSDIST_EQ_0; "HAUSDIST_FRONTIERS_CONVEX",HAUSDIST_FRONTIERS_CONVEX; "HAUSDIST_INSERT_LE",HAUSDIST_INSERT_LE; "HAUSDIST_LINEAR_IMAGE",HAUSDIST_LINEAR_IMAGE; "HAUSDIST_NONTRIVIAL",HAUSDIST_NONTRIVIAL; "HAUSDIST_NONTRIVIAL_ALT",HAUSDIST_NONTRIVIAL_ALT; "HAUSDIST_POS_LE",HAUSDIST_POS_LE; "HAUSDIST_POS_LT",HAUSDIST_POS_LT; "HAUSDIST_REFL",HAUSDIST_REFL; "HAUSDIST_RELATIVE_INTERIOR",HAUSDIST_RELATIVE_INTERIOR; "HAUSDIST_SCALING",HAUSDIST_SCALING; "HAUSDIST_SETDIST_TRIANGLE",HAUSDIST_SETDIST_TRIANGLE; "HAUSDIST_SINGS",HAUSDIST_SINGS; "HAUSDIST_STILL_INSIDE",HAUSDIST_STILL_INSIDE; "HAUSDIST_STILL_INSIDE_INTERIOR",HAUSDIST_STILL_INSIDE_INTERIOR; "HAUSDIST_STILL_NONEMPTY_INTERIOR",HAUSDIST_STILL_NONEMPTY_INTERIOR; "HAUSDIST_STILL_OUTSIDE",HAUSDIST_STILL_OUTSIDE; "HAUSDIST_STILL_SAME_PLACE",HAUSDIST_STILL_SAME_PLACE; "HAUSDIST_STILL_SAME_PLACE_CONIC_HULL",HAUSDIST_STILL_SAME_PLACE_CONIC_HULL; "HAUSDIST_STILL_SAME_PLACE_CONIC_HULL_STRONG",HAUSDIST_STILL_SAME_PLACE_CONIC_HULL_STRONG; "HAUSDIST_STILL_SAME_PLACE_STRONG",HAUSDIST_STILL_SAME_PLACE_STRONG; "HAUSDIST_SUMS",HAUSDIST_SUMS; "HAUSDIST_SUMS_LE",HAUSDIST_SUMS_LE; "HAUSDIST_SUMS_LE_LCANCEL",HAUSDIST_SUMS_LE_LCANCEL; "HAUSDIST_SUMS_LE_RCANCEL",HAUSDIST_SUMS_LE_RCANCEL; "HAUSDIST_SYM",HAUSDIST_SYM; "HAUSDIST_TRANS",HAUSDIST_TRANS; "HAUSDIST_TRANSLATION",HAUSDIST_TRANSLATION; "HAUSDIST_TRIANGLE",HAUSDIST_TRIANGLE; "HAUSDIST_UNIFORMLY_CONTINUOUS_ON",HAUSDIST_UNIFORMLY_CONTINUOUS_ON; "HAUSDIST_UNION_LE",HAUSDIST_UNION_LE; "HD",HD; "HD_APPEND",HD_APPEND; "HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS",HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS; "HEINE_BOREL_LEMMA",HEINE_BOREL_LEMMA; "HELLY",HELLY; "HELLY_ALT",HELLY_ALT; "HELLY_CLOSED",HELLY_CLOSED; "HELLY_CLOSED_ALT",HELLY_CLOSED_ALT; "HELLY_COMPACT",HELLY_COMPACT; "HELLY_COMPACT_ALT",HELLY_COMPACT_ALT; "HELLY_INDUCT",HELLY_INDUCT; "HELLY_SELECTION_INCREASING",HELLY_SELECTION_INCREASING; "HELLY_SELECTION_THEOREM",HELLY_SELECTION_THEOREM; "HENSTOCK_LEMMA",HENSTOCK_LEMMA; "HENSTOCK_LEMMA_PART1",HENSTOCK_LEMMA_PART1; "HENSTOCK_LEMMA_PART2",HENSTOCK_LEMMA_PART2; "HOMEOMORPHIC_AFFINE_SETS",HOMEOMORPHIC_AFFINE_SETS; "HOMEOMORPHIC_AFFINITY",HOMEOMORPHIC_AFFINITY; "HOMEOMORPHIC_ANALYTICITY",HOMEOMORPHIC_ANALYTICITY; "HOMEOMORPHIC_ANRNESS",HOMEOMORPHIC_ANRNESS; "HOMEOMORPHIC_ARC_IMAGES",HOMEOMORPHIC_ARC_IMAGES; "HOMEOMORPHIC_ARC_IMAGE_INTERVAL",HOMEOMORPHIC_ARC_IMAGE_INTERVAL; "HOMEOMORPHIC_ARC_IMAGE_SEGMENT",HOMEOMORPHIC_ARC_IMAGE_SEGMENT; "HOMEOMORPHIC_ARC_IMAGE_SEGMENT_EQ",HOMEOMORPHIC_ARC_IMAGE_SEGMENT_EQ; "HOMEOMORPHIC_ARNESS",HOMEOMORPHIC_ARNESS; "HOMEOMORPHIC_BALLS",HOMEOMORPHIC_BALLS; "HOMEOMORPHIC_BALL_UNIV",HOMEOMORPHIC_BALL_UNIV; "HOMEOMORPHIC_BORELNESS",HOMEOMORPHIC_BORELNESS; "HOMEOMORPHIC_CARD_EQ_COMPONENTS",HOMEOMORPHIC_CARD_EQ_COMPONENTS; "HOMEOMORPHIC_CARD_EQ_PATH_COMPONENTS",HOMEOMORPHIC_CARD_EQ_PATH_COMPONENTS; "HOMEOMORPHIC_CBALLS",HOMEOMORPHIC_CBALLS; "HOMEOMORPHIC_CLOSED_INTERVALS",HOMEOMORPHIC_CLOSED_INTERVALS; "HOMEOMORPHIC_CLOSED_IN_CONVEX",HOMEOMORPHIC_CLOSED_IN_CONVEX; "HOMEOMORPHIC_COMPACT",HOMEOMORPHIC_COMPACT; "HOMEOMORPHIC_COMPACTNESS",HOMEOMORPHIC_COMPACTNESS; "HOMEOMORPHIC_COMPACT_ARNESS",HOMEOMORPHIC_COMPACT_ARNESS; "HOMEOMORPHIC_CONNECTEDNESS",HOMEOMORPHIC_CONNECTEDNESS; "HOMEOMORPHIC_CONTRACTIBLE",HOMEOMORPHIC_CONTRACTIBLE; "HOMEOMORPHIC_CONTRACTIBLE_EQ",HOMEOMORPHIC_CONTRACTIBLE_EQ; "HOMEOMORPHIC_CONVEX_COMPACT",HOMEOMORPHIC_CONVEX_COMPACT; "HOMEOMORPHIC_CONVEX_COMPACT_CBALL",HOMEOMORPHIC_CONVEX_COMPACT_CBALL; "HOMEOMORPHIC_CONVEX_COMPACT_SETS",HOMEOMORPHIC_CONVEX_COMPACT_SETS; "HOMEOMORPHIC_CONVEX_OPEN_SETS",HOMEOMORPHIC_CONVEX_OPEN_SETS; "HOMEOMORPHIC_COUNTABILITY",HOMEOMORPHIC_COUNTABILITY; "HOMEOMORPHIC_DIMENSION",HOMEOMORPHIC_DIMENSION; "HOMEOMORPHIC_EMPTY",HOMEOMORPHIC_EMPTY; "HOMEOMORPHIC_ENRNESS",HOMEOMORPHIC_ENRNESS; "HOMEOMORPHIC_FINITE",HOMEOMORPHIC_FINITE; "HOMEOMORPHIC_FINITENESS",HOMEOMORPHIC_FINITENESS; "HOMEOMORPHIC_FINITE_STRONG",HOMEOMORPHIC_FINITE_STRONG; "HOMEOMORPHIC_FIXPOINT_PROPERTY",HOMEOMORPHIC_FIXPOINT_PROPERTY; "HOMEOMORPHIC_FSIGMANESS",HOMEOMORPHIC_FSIGMANESS; "HOMEOMORPHIC_GDELTANESS",HOMEOMORPHIC_GDELTANESS; "HOMEOMORPHIC_GRAPH",HOMEOMORPHIC_GRAPH; "HOMEOMORPHIC_HAS_SIZE",HOMEOMORPHIC_HAS_SIZE; "HOMEOMORPHIC_HYPERPLANES",HOMEOMORPHIC_HYPERPLANES; "HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE",HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE; "HOMEOMORPHIC_HYPERPLANE_UNIV",HOMEOMORPHIC_HYPERPLANE_UNIV; "HOMEOMORPHIC_IMP_CARD_EQ",HOMEOMORPHIC_IMP_CARD_EQ; "HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT",HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; "HOMEOMORPHIC_INFINITENESS",HOMEOMORPHIC_INFINITENESS; "HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; "HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; "HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; "HOMEOMORPHIC_LOCALLY",HOMEOMORPHIC_LOCALLY; "HOMEOMORPHIC_LOCAL_COMPACTNESS",HOMEOMORPHIC_LOCAL_COMPACTNESS; "HOMEOMORPHIC_LOCAL_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_CONNECTEDNESS; "HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS; "HOMEOMORPHIC_MINIMAL",HOMEOMORPHIC_MINIMAL; "HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL",HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL; "HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS",HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS; "HOMEOMORPHIC_OPEN_INTERVALS",HOMEOMORPHIC_OPEN_INTERVALS; "HOMEOMORPHIC_OPEN_INTERVALS_1",HOMEOMORPHIC_OPEN_INTERVALS_1; "HOMEOMORPHIC_OPEN_INTERVAL_UNIV",HOMEOMORPHIC_OPEN_INTERVAL_UNIV; "HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1",HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; "HOMEOMORPHIC_PATH_CONNECTEDNESS",HOMEOMORPHIC_PATH_CONNECTEDNESS; "HOMEOMORPHIC_PCROSS",HOMEOMORPHIC_PCROSS; "HOMEOMORPHIC_PCROSS_ASSOC",HOMEOMORPHIC_PCROSS_ASSOC; "HOMEOMORPHIC_PCROSS_SING",HOMEOMORPHIC_PCROSS_SING; "HOMEOMORPHIC_PCROSS_SYM",HOMEOMORPHIC_PCROSS_SYM; "HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE; "HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE; "HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN; "HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE",HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE; "HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV",HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV; "HOMEOMORPHIC_REFL",HOMEOMORPHIC_REFL; "HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS",HOMEOMORPHIC_RELATIVELY_OPEN_CONVEX_SETS; "HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS",HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS; "HOMEOMORPHIC_RELATIVE_INTERIORS_CONVEX_COMPACT_SETS",HOMEOMORPHIC_RELATIVE_INTERIORS_CONVEX_COMPACT_SETS; "HOMEOMORPHIC_SCALING",HOMEOMORPHIC_SCALING; "HOMEOMORPHIC_SCALING_LEFT",HOMEOMORPHIC_SCALING_LEFT; "HOMEOMORPHIC_SCALING_RIGHT",HOMEOMORPHIC_SCALING_RIGHT; "HOMEOMORPHIC_SEGMENTS",HOMEOMORPHIC_SEGMENTS; "HOMEOMORPHIC_SELF_IMAGE",HOMEOMORPHIC_SELF_IMAGE; "HOMEOMORPHIC_SIMPLE_PATH_ARC",HOMEOMORPHIC_SIMPLE_PATH_ARC; "HOMEOMORPHIC_SIMPLE_PATH_ARC_EQ",HOMEOMORPHIC_SIMPLE_PATH_ARC_EQ; "HOMEOMORPHIC_SIMPLE_PATH_IMAGES",HOMEOMORPHIC_SIMPLE_PATH_IMAGES; "HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE",HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; "HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ",HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ; "HOMEOMORPHIC_SIMPLY_CONNECTED",HOMEOMORPHIC_SIMPLY_CONNECTED; "HOMEOMORPHIC_SIMPLY_CONNECTED_EQ",HOMEOMORPHIC_SIMPLY_CONNECTED_EQ; "HOMEOMORPHIC_SING",HOMEOMORPHIC_SING; "HOMEOMORPHIC_SPHERES",HOMEOMORPHIC_SPHERES; "HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE",HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE; "HOMEOMORPHIC_SUBSPACES",HOMEOMORPHIC_SUBSPACES; "HOMEOMORPHIC_SYM",HOMEOMORPHIC_SYM; "HOMEOMORPHIC_TRANS",HOMEOMORPHIC_TRANS; "HOMEOMORPHIC_TRANSLATION",HOMEOMORPHIC_TRANSLATION; "HOMEOMORPHIC_TRANSLATION_LEFT_EQ",HOMEOMORPHIC_TRANSLATION_LEFT_EQ; "HOMEOMORPHIC_TRANSLATION_RIGHT_EQ",HOMEOMORPHIC_TRANSLATION_RIGHT_EQ; "HOMEOMORPHIC_TRANSLATION_SELF",HOMEOMORPHIC_TRANSLATION_SELF; "HOMEOMORPHISM",HOMEOMORPHISM; "HOMEOMORPHISM_1D_IMP_MONOTONIC",HOMEOMORPHISM_1D_IMP_MONOTONIC; "HOMEOMORPHISM_ANRNESS",HOMEOMORPHISM_ANRNESS; "HOMEOMORPHISM_ARC",HOMEOMORPHISM_ARC; "HOMEOMORPHISM_ARC_IMAGES",HOMEOMORPHISM_ARC_IMAGES; "HOMEOMORPHISM_ARNESS",HOMEOMORPHISM_ARNESS; "HOMEOMORPHISM_BORELNESS",HOMEOMORPHISM_BORELNESS; "HOMEOMORPHISM_CLOSEDNESS",HOMEOMORPHISM_CLOSEDNESS; "HOMEOMORPHISM_CLOSED_IN_EQ",HOMEOMORPHISM_CLOSED_IN_EQ; "HOMEOMORPHISM_CLOSURE",HOMEOMORPHISM_CLOSURE; "HOMEOMORPHISM_CLOSURE_OF",HOMEOMORPHISM_CLOSURE_OF; "HOMEOMORPHISM_COMPACT",HOMEOMORPHISM_COMPACT; "HOMEOMORPHISM_COMPACTNESS",HOMEOMORPHISM_COMPACTNESS; "HOMEOMORPHISM_COMPONENTS",HOMEOMORPHISM_COMPONENTS; "HOMEOMORPHISM_COMPOSE",HOMEOMORPHISM_COMPOSE; "HOMEOMORPHISM_CONNECTEDNESS",HOMEOMORPHISM_CONNECTEDNESS; "HOMEOMORPHISM_CONNECTED_COMPONENT",HOMEOMORPHISM_CONNECTED_COMPONENT; "HOMEOMORPHISM_CONTRACTIBILITY",HOMEOMORPHISM_CONTRACTIBILITY; "HOMEOMORPHISM_COUNTABILITY",HOMEOMORPHISM_COUNTABILITY; "HOMEOMORPHISM_DERIVED_SET_OF",HOMEOMORPHISM_DERIVED_SET_OF; "HOMEOMORPHISM_ENRNESS",HOMEOMORPHISM_ENRNESS; "HOMEOMORPHISM_EQ",HOMEOMORPHISM_EQ; "HOMEOMORPHISM_FINITENESS",HOMEOMORPHISM_FINITENESS; "HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE; "HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE; "HOMEOMORPHISM_FRONTIER_OF",HOMEOMORPHISM_FRONTIER_OF; "HOMEOMORPHISM_FSIGMANESS",HOMEOMORPHISM_FSIGMANESS; "HOMEOMORPHISM_GDELTANESS",HOMEOMORPHISM_GDELTANESS; "HOMEOMORPHISM_GRAPH",HOMEOMORPHISM_GRAPH; "HOMEOMORPHISM_GRAPH_EXPLICIT",HOMEOMORPHISM_GRAPH_EXPLICIT; "HOMEOMORPHISM_GROUPING_POINTS_EXISTS",HOMEOMORPHISM_GROUPING_POINTS_EXISTS; "HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN",HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN; "HOMEOMORPHISM_HAS_SIZE_EQ",HOMEOMORPHISM_HAS_SIZE_EQ; "HOMEOMORPHISM_I",HOMEOMORPHISM_I; "HOMEOMORPHISM_ID",HOMEOMORPHISM_ID; "HOMEOMORPHISM_IMP_CLOSED_MAP",HOMEOMORPHISM_IMP_CLOSED_MAP; "HOMEOMORPHISM_IMP_COVERING_SPACE",HOMEOMORPHISM_IMP_COVERING_SPACE; "HOMEOMORPHISM_IMP_HOMEOMORPHIC",HOMEOMORPHISM_IMP_HOMEOMORPHIC; "HOMEOMORPHISM_IMP_OPEN_MAP",HOMEOMORPHISM_IMP_OPEN_MAP; "HOMEOMORPHISM_IMP_QUOTIENT_MAP",HOMEOMORPHISM_IMP_QUOTIENT_MAP; "HOMEOMORPHISM_INFINITENESS",HOMEOMORPHISM_INFINITENESS; "HOMEOMORPHISM_INJECTIVE_CLOSED_MAP",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP; "HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ; "HOMEOMORPHISM_INJECTIVE_OPEN_MAP",HOMEOMORPHISM_INJECTIVE_OPEN_MAP; "HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ",HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; "HOMEOMORPHISM_INTERIOR_OF",HOMEOMORPHISM_INTERIOR_OF; "HOMEOMORPHISM_INTO_1D",HOMEOMORPHISM_INTO_1D; "HOMEOMORPHISM_LOCALLY",HOMEOMORPHISM_LOCALLY; "HOMEOMORPHISM_LOCAL_COMPACTNESS",HOMEOMORPHISM_LOCAL_COMPACTNESS; "HOMEOMORPHISM_LOCAL_CONNECTEDNESS",HOMEOMORPHISM_LOCAL_CONNECTEDNESS; "HOMEOMORPHISM_LOCAL_PATH_CONNECTEDNESS",HOMEOMORPHISM_LOCAL_PATH_CONNECTEDNESS; "HOMEOMORPHISM_MOVING_DENSE_COUNTABLE_SUBSETS_EXISTS",HOMEOMORPHISM_MOVING_DENSE_COUNTABLE_SUBSETS_EXISTS; "HOMEOMORPHISM_MOVING_POINTS_EXISTS",HOMEOMORPHISM_MOVING_POINTS_EXISTS; "HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN",HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN; "HOMEOMORPHISM_MOVING_POINT_EXISTS",HOMEOMORPHISM_MOVING_POINT_EXISTS; "HOMEOMORPHISM_OF_SUBSETS",HOMEOMORPHISM_OF_SUBSETS; "HOMEOMORPHISM_OF_SUBSETS_ALT",HOMEOMORPHISM_OF_SUBSETS_ALT; "HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS",HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS; "HOMEOMORPHISM_OPENNESS",HOMEOMORPHISM_OPENNESS; "HOMEOMORPHISM_OPEN_IN_EQ",HOMEOMORPHISM_OPEN_IN_EQ; "HOMEOMORPHISM_PATH_CONNECTEDNESS",HOMEOMORPHISM_PATH_CONNECTEDNESS; "HOMEOMORPHISM_SEGMENT",HOMEOMORPHISM_SEGMENT; "HOMEOMORPHISM_SIMPLE_CONNECTEDNESS",HOMEOMORPHISM_SIMPLE_CONNECTEDNESS; "HOMEOMORPHISM_SYM",HOMEOMORPHISM_SYM; "HOMOEOMORPHISM_PASTE",HOMOEOMORPHISM_PASTE; "HOMOGENEOUS_LINEAR_EQUATIONS_DET",HOMOGENEOUS_LINEAR_EQUATIONS_DET; "HOMOMORPHISM_REAL_TO_REAL",HOMOMORPHISM_REAL_TO_REAL; "HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; "HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; "HOMOTOPIC_COMPOSE",HOMOTOPIC_COMPOSE; "HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT; "HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT; "HOMOTOPIC_CONSTANT_MAPS",HOMOTOPIC_CONSTANT_MAPS; "HOMOTOPIC_FROM_CONTRACTIBLE",HOMOTOPIC_FROM_CONTRACTIBLE; "HOMOTOPIC_INTO_CONTRACTIBLE",HOMOTOPIC_INTO_CONTRACTIBLE; "HOMOTOPIC_INTO_RETRACT",HOMOTOPIC_INTO_RETRACT; "HOMOTOPIC_JOIN_LEMMA",HOMOTOPIC_JOIN_LEMMA; "HOMOTOPIC_JOIN_SUBPATHS",HOMOTOPIC_JOIN_SUBPATHS; "HOMOTOPIC_LINEAR_MAPS_ALT",HOMOTOPIC_LINEAR_MAPS_ALT; "HOMOTOPIC_LINEAR_MAPS_IMP",HOMOTOPIC_LINEAR_MAPS_IMP; "HOMOTOPIC_LOOPS",HOMOTOPIC_LOOPS; "HOMOTOPIC_LOOPS_ADD_SYM",HOMOTOPIC_LOOPS_ADD_SYM; "HOMOTOPIC_LOOPS_CONJUGATE",HOMOTOPIC_LOOPS_CONJUGATE; "HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE",HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE; "HOMOTOPIC_LOOPS_EQ",HOMOTOPIC_LOOPS_EQ; "HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL",HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL; "HOMOTOPIC_LOOPS_IMP_LOOP",HOMOTOPIC_LOOPS_IMP_LOOP; "HOMOTOPIC_LOOPS_IMP_PATH",HOMOTOPIC_LOOPS_IMP_PATH; "HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE",HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE; "HOMOTOPIC_LOOPS_IMP_SUBSET",HOMOTOPIC_LOOPS_IMP_SUBSET; "HOMOTOPIC_LOOPS_LINEAR",HOMOTOPIC_LOOPS_LINEAR; "HOMOTOPIC_LOOPS_NEARBY_EXPLICIT",HOMOTOPIC_LOOPS_NEARBY_EXPLICIT; "HOMOTOPIC_LOOPS_REFL",HOMOTOPIC_LOOPS_REFL; "HOMOTOPIC_LOOPS_SHIFTPATH",HOMOTOPIC_LOOPS_SHIFTPATH; "HOMOTOPIC_LOOPS_SHIFTPATH_SELF",HOMOTOPIC_LOOPS_SHIFTPATH_SELF; "HOMOTOPIC_LOOPS_SUBSET",HOMOTOPIC_LOOPS_SUBSET; "HOMOTOPIC_LOOPS_SYM",HOMOTOPIC_LOOPS_SYM; "HOMOTOPIC_LOOPS_TRANS",HOMOTOPIC_LOOPS_TRANS; "HOMOTOPIC_NEARBY_LOOPS",HOMOTOPIC_NEARBY_LOOPS; "HOMOTOPIC_NEARBY_PATHS",HOMOTOPIC_NEARBY_PATHS; "HOMOTOPIC_NEIGHBOURHOOD_EXTENSION",HOMOTOPIC_NEIGHBOURHOOD_EXTENSION; "HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS",HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS; "HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS",HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS; "HOMOTOPIC_ON_CLOPEN_UNIONS",HOMOTOPIC_ON_CLOPEN_UNIONS; "HOMOTOPIC_ON_COMPONENTS",HOMOTOPIC_ON_COMPONENTS; "HOMOTOPIC_ON_COMPONENTS_EQ",HOMOTOPIC_ON_COMPONENTS_EQ; "HOMOTOPIC_ON_EMPTY",HOMOTOPIC_ON_EMPTY; "HOMOTOPIC_ON_NEIGHBOURHOOD_INTO_ANR",HOMOTOPIC_ON_NEIGHBOURHOOD_INTO_ANR; "HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP",HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP; "HOMOTOPIC_PATHS",HOMOTOPIC_PATHS; "HOMOTOPIC_PATHS_ASSOC",HOMOTOPIC_PATHS_ASSOC; "HOMOTOPIC_PATHS_CONTINUOUS_IMAGE",HOMOTOPIC_PATHS_CONTINUOUS_IMAGE; "HOMOTOPIC_PATHS_EQ",HOMOTOPIC_PATHS_EQ; "HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS",HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS; "HOMOTOPIC_PATHS_IMP_PATH",HOMOTOPIC_PATHS_IMP_PATH; "HOMOTOPIC_PATHS_IMP_PATHFINISH",HOMOTOPIC_PATHS_IMP_PATHFINISH; "HOMOTOPIC_PATHS_IMP_PATHSTART",HOMOTOPIC_PATHS_IMP_PATHSTART; "HOMOTOPIC_PATHS_IMP_SUBSET",HOMOTOPIC_PATHS_IMP_SUBSET; "HOMOTOPIC_PATHS_JOIN",HOMOTOPIC_PATHS_JOIN; "HOMOTOPIC_PATHS_LCANCEL",HOMOTOPIC_PATHS_LCANCEL; "HOMOTOPIC_PATHS_LCANCEL_EQ",HOMOTOPIC_PATHS_LCANCEL_EQ; "HOMOTOPIC_PATHS_LID",HOMOTOPIC_PATHS_LID; "HOMOTOPIC_PATHS_LINEAR",HOMOTOPIC_PATHS_LINEAR; "HOMOTOPIC_PATHS_LINV",HOMOTOPIC_PATHS_LINV; "HOMOTOPIC_PATHS_LOOP_PARTS",HOMOTOPIC_PATHS_LOOP_PARTS; "HOMOTOPIC_PATHS_NEARBY_EXPLICIT",HOMOTOPIC_PATHS_NEARBY_EXPLICIT; "HOMOTOPIC_PATHS_RCANCEL",HOMOTOPIC_PATHS_RCANCEL; "HOMOTOPIC_PATHS_RCANCEL_EQ",HOMOTOPIC_PATHS_RCANCEL_EQ; "HOMOTOPIC_PATHS_REFL",HOMOTOPIC_PATHS_REFL; "HOMOTOPIC_PATHS_REPARAMETRIZE",HOMOTOPIC_PATHS_REPARAMETRIZE; "HOMOTOPIC_PATHS_REVERSEPATH",HOMOTOPIC_PATHS_REVERSEPATH; "HOMOTOPIC_PATHS_RID",HOMOTOPIC_PATHS_RID; "HOMOTOPIC_PATHS_RINV",HOMOTOPIC_PATHS_RINV; "HOMOTOPIC_PATHS_SUBSET",HOMOTOPIC_PATHS_SUBSET; "HOMOTOPIC_PATHS_SYM",HOMOTOPIC_PATHS_SYM; "HOMOTOPIC_PATHS_TRANS",HOMOTOPIC_PATHS_TRANS; "HOMOTOPIC_POINTS_EQ_PATH_COMPONENT",HOMOTOPIC_POINTS_EQ_PATH_COMPONENT; "HOMOTOPIC_THROUGH_CONTRACTIBLE",HOMOTOPIC_THROUGH_CONTRACTIBLE; "HOMOTOPIC_TRIVIALITY",HOMOTOPIC_TRIVIALITY; "HOMOTOPIC_WITH",HOMOTOPIC_WITH; "HOMOTOPIC_WITH_COMPOSE",HOMOTOPIC_WITH_COMPOSE; "HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT; "HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT; "HOMOTOPIC_WITH_EQ",HOMOTOPIC_WITH_EQ; "HOMOTOPIC_WITH_EQUAL",HOMOTOPIC_WITH_EQUAL; "HOMOTOPIC_WITH_IMP_CONTINUOUS",HOMOTOPIC_WITH_IMP_CONTINUOUS; "HOMOTOPIC_WITH_IMP_PATH_COMPONENT",HOMOTOPIC_WITH_IMP_PATH_COMPONENT; "HOMOTOPIC_WITH_IMP_PROPERTY",HOMOTOPIC_WITH_IMP_PROPERTY; "HOMOTOPIC_WITH_IMP_SUBSET",HOMOTOPIC_WITH_IMP_SUBSET; "HOMOTOPIC_WITH_LINEAR",HOMOTOPIC_WITH_LINEAR; "HOMOTOPIC_WITH_MONO",HOMOTOPIC_WITH_MONO; "HOMOTOPIC_WITH_PCROSS",HOMOTOPIC_WITH_PCROSS; "HOMOTOPIC_WITH_REFL",HOMOTOPIC_WITH_REFL; "HOMOTOPIC_WITH_RESTRICT",HOMOTOPIC_WITH_RESTRICT; "HOMOTOPIC_WITH_SUBSET_LEFT",HOMOTOPIC_WITH_SUBSET_LEFT; "HOMOTOPIC_WITH_SUBSET_RIGHT",HOMOTOPIC_WITH_SUBSET_RIGHT; "HOMOTOPIC_WITH_SYM",HOMOTOPIC_WITH_SYM; "HOMOTOPIC_WITH_TRANS",HOMOTOPIC_WITH_TRANS; "HOMOTOPY_DOMINATED_CONTRACTIBILITY",HOMOTOPY_DOMINATED_CONTRACTIBILITY; "HOMOTOPY_EQUIVALENT",HOMOTOPY_EQUIVALENT; "HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS",HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS; "HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS",HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS; "HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY; "HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL; "HOMOTOPY_EQUIVALENT_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_CONNECTEDNESS; "HOMOTOPY_EQUIVALENT_CONTRACTIBILITY",HOMOTOPY_EQUIVALENT_CONTRACTIBILITY; "HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS",HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; "HOMOTOPY_EQUIVALENT_EMPTY",HOMOTOPY_EQUIVALENT_EMPTY; "HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY; "HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL; "HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; "HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; "HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF; "HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS; "HOMOTOPY_EQUIVALENT_PCROSS",HOMOTOPY_EQUIVALENT_PCROSS; "HOMOTOPY_EQUIVALENT_PUNCTURED_UNIV_SPHERE",HOMOTOPY_EQUIVALENT_PUNCTURED_UNIV_SPHERE; "HOMOTOPY_EQUIVALENT_REFL",HOMOTOPY_EQUIVALENT_REFL; "HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL; "HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX; "HOMOTOPY_EQUIVALENT_SING",HOMOTOPY_EQUIVALENT_SING; "HOMOTOPY_EQUIVALENT_SYM",HOMOTOPY_EQUIVALENT_SYM; "HOMOTOPY_EQUIVALENT_TRANS",HOMOTOPY_EQUIVALENT_TRANS; "HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ; "HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ; "HOMOTOPY_EQUIVALENT_TRANSLATION_SELF",HOMOTOPY_EQUIVALENT_TRANSLATION_SELF; "HOMOTOPY_INVARIANT_CARD_COMPONENTS",HOMOTOPY_INVARIANT_CARD_COMPONENTS; "HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS",HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS; "HOMOTOPY_INVARIANT_CONNECTEDNESS",HOMOTOPY_INVARIANT_CONNECTEDNESS; "HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS",HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS; "HP",HP; "HREAL_ADD_AC",HREAL_ADD_AC; "HREAL_ADD_ASSOC",HREAL_ADD_ASSOC; "HREAL_ADD_LCANCEL",HREAL_ADD_LCANCEL; "HREAL_ADD_LDISTRIB",HREAL_ADD_LDISTRIB; "HREAL_ADD_LID",HREAL_ADD_LID; "HREAL_ADD_RDISTRIB",HREAL_ADD_RDISTRIB; "HREAL_ADD_RID",HREAL_ADD_RID; "HREAL_ADD_SYM",HREAL_ADD_SYM; "HREAL_ARCH",HREAL_ARCH; "HREAL_COMPLETE",HREAL_COMPLETE; "HREAL_EQ_ADD_LCANCEL",HREAL_EQ_ADD_LCANCEL; "HREAL_EQ_ADD_RCANCEL",HREAL_EQ_ADD_RCANCEL; "HREAL_INV_0",HREAL_INV_0; "HREAL_LE_ADD",HREAL_LE_ADD; "HREAL_LE_ADD2",HREAL_LE_ADD2; "HREAL_LE_ADD_LCANCEL",HREAL_LE_ADD_LCANCEL; "HREAL_LE_ADD_RCANCEL",HREAL_LE_ADD_RCANCEL; "HREAL_LE_ANTISYM",HREAL_LE_ANTISYM; "HREAL_LE_EXISTS",HREAL_LE_EXISTS; "HREAL_LE_EXISTS_DEF",HREAL_LE_EXISTS_DEF; "HREAL_LE_MUL_RCANCEL_IMP",HREAL_LE_MUL_RCANCEL_IMP; "HREAL_LE_REFL",HREAL_LE_REFL; "HREAL_LE_TOTAL",HREAL_LE_TOTAL; "HREAL_LE_TRANS",HREAL_LE_TRANS; "HREAL_MUL_ASSOC",HREAL_MUL_ASSOC; "HREAL_MUL_LID",HREAL_MUL_LID; "HREAL_MUL_LINV",HREAL_MUL_LINV; "HREAL_MUL_LZERO",HREAL_MUL_LZERO; "HREAL_MUL_RZERO",HREAL_MUL_RZERO; "HREAL_MUL_SYM",HREAL_MUL_SYM; "HREAL_OF_NUM_ADD",HREAL_OF_NUM_ADD; "HREAL_OF_NUM_EQ",HREAL_OF_NUM_EQ; "HREAL_OF_NUM_LE",HREAL_OF_NUM_LE; "HREAL_OF_NUM_MUL",HREAL_OF_NUM_MUL; "HULLS_EQ",HULLS_EQ; "HULL_ANTIMONO",HULL_ANTIMONO; "HULL_EQ",HULL_EQ; "HULL_HULL",HULL_HULL; "HULL_IMAGE",HULL_IMAGE; "HULL_IMAGE_GALOIS",HULL_IMAGE_GALOIS; "HULL_IMAGE_SUBSET",HULL_IMAGE_SUBSET; "HULL_INC",HULL_INC; "HULL_INDUCT",HULL_INDUCT; "HULL_INSERT",HULL_INSERT; "HULL_INTERS_SUBSET",HULL_INTERS_SUBSET; "HULL_INTER_SUBSET",HULL_INTER_SUBSET; "HULL_MINIMAL",HULL_MINIMAL; "HULL_MONO",HULL_MONO; "HULL_P",HULL_P; "HULL_P_AND_Q",HULL_P_AND_Q; "HULL_REDUNDANT",HULL_REDUNDANT; "HULL_REDUNDANT_EQ",HULL_REDUNDANT_EQ; "HULL_SUBSET",HULL_SUBSET; "HULL_UNION",HULL_UNION; "HULL_UNIONS_SUBSET",HULL_UNIONS_SUBSET; "HULL_UNION_LEFT",HULL_UNION_LEFT; "HULL_UNION_RIGHT",HULL_UNION_RIGHT; "HULL_UNION_SUBSET",HULL_UNION_SUBSET; "HULL_UNIQUE",HULL_UNIQUE; "HULL_UNIV",HULL_UNIV; "HYPERPLANE_EQ_EMPTY",HYPERPLANE_EQ_EMPTY; "HYPERPLANE_EQ_UNIV",HYPERPLANE_EQ_UNIV; "HYPERPLANE_FACET_OF_HALFSPACE_GE",HYPERPLANE_FACET_OF_HALFSPACE_GE; "HYPERPLANE_FACET_OF_HALFSPACE_LE",HYPERPLANE_FACET_OF_HALFSPACE_LE; "HYPERPLANE_FACE_OF_HALFSPACE_GE",HYPERPLANE_FACE_OF_HALFSPACE_GE; "HYPERPLANE_FACE_OF_HALFSPACE_LE",HYPERPLANE_FACE_OF_HALFSPACE_LE; "IDEMPOTENT_IMP_RETRACTION",IDEMPOTENT_IMP_RETRACTION; "IDEMPOTENT_MATRIX_MUL_LINV",IDEMPOTENT_MATRIX_MUL_LINV; "IDEMPOTENT_MATRIX_MUL_RINV",IDEMPOTENT_MATRIX_MUL_RINV; "IDEMPOTENT_MATRIX_TRACE_EQ_RANK",IDEMPOTENT_MATRIX_TRACE_EQ_RANK; "IMAGE",IMAGE; "IMAGE_AFFINITY_BALL",IMAGE_AFFINITY_BALL; "IMAGE_AFFINITY_CBALL",IMAGE_AFFINITY_CBALL; "IMAGE_AFFINITY_INTERVAL",IMAGE_AFFINITY_INTERVAL; "IMAGE_AFFINITY_SPHERE",IMAGE_AFFINITY_SPHERE; "IMAGE_CLAUSES",IMAGE_CLAUSES; "IMAGE_CLOSURE_SUBSET",IMAGE_CLOSURE_SUBSET; "IMAGE_COMPACT_IN",IMAGE_COMPACT_IN; "IMAGE_COMPOSE_PERMUTATIONS_L",IMAGE_COMPOSE_PERMUTATIONS_L; "IMAGE_COMPOSE_PERMUTATIONS_R",IMAGE_COMPOSE_PERMUTATIONS_R; "IMAGE_CONST",IMAGE_CONST; "IMAGE_DELETE_INJ",IMAGE_DELETE_INJ; "IMAGE_DELETE_INJ_ALT",IMAGE_DELETE_INJ_ALT; "IMAGE_DIFF_INJ",IMAGE_DIFF_INJ; "IMAGE_DIFF_INJ_ALT",IMAGE_DIFF_INJ_ALT; "IMAGE_DROPOUT_CLOSED_INTERVAL",IMAGE_DROPOUT_CLOSED_INTERVAL; "IMAGE_DROP_UNIV",IMAGE_DROP_UNIV; "IMAGE_EQ_EMPTY",IMAGE_EQ_EMPTY; "IMAGE_FSTCART_PCROSS",IMAGE_FSTCART_PCROSS; "IMAGE_FST_CROSS",IMAGE_FST_CROSS; "IMAGE_I",IMAGE_I; "IMAGE_ID",IMAGE_ID; "IMAGE_IMP_INJECTIVE",IMAGE_IMP_INJECTIVE; "IMAGE_IMP_INJECTIVE_GEN",IMAGE_IMP_INJECTIVE_GEN; "IMAGE_INJECTIVE_IMAGE_OF_SUBSET",IMAGE_INJECTIVE_IMAGE_OF_SUBSET; "IMAGE_INTERS",IMAGE_INTERS; "IMAGE_INTERS_SATURATED",IMAGE_INTERS_SATURATED; "IMAGE_INTERS_SATURATED_GEN",IMAGE_INTERS_SATURATED_GEN; "IMAGE_INTERS_SUBSET",IMAGE_INTERS_SUBSET; "IMAGE_INTER_INJ",IMAGE_INTER_INJ; "IMAGE_INTER_SATURATED",IMAGE_INTER_SATURATED; "IMAGE_INTER_SATURATED_GEN",IMAGE_INTER_SATURATED_GEN; "IMAGE_INTER_SUBSET",IMAGE_INTER_SUBSET; "IMAGE_INVERSE_PERMUTATIONS",IMAGE_INVERSE_PERMUTATIONS; "IMAGE_LIFT_DROP",IMAGE_LIFT_DROP; "IMAGE_LIFT_UNIV",IMAGE_LIFT_UNIV; "IMAGE_MATRIX_INV",IMAGE_MATRIX_INV; "IMAGE_RESTRICTION",IMAGE_RESTRICTION; "IMAGE_SNDCART_PCROSS",IMAGE_SNDCART_PCROSS; "IMAGE_SND_CROSS",IMAGE_SND_CROSS; "IMAGE_STRETCH_INTERVAL",IMAGE_STRETCH_INTERVAL; "IMAGE_SUBSET",IMAGE_SUBSET; "IMAGE_TWIZZLE_INTERVAL",IMAGE_TWIZZLE_INTERVAL; "IMAGE_UNION",IMAGE_UNION; "IMAGE_UNIONS",IMAGE_UNIONS; "IMAGE_o",IMAGE_o; "IMP_CLAUSES",IMP_CLAUSES; "IMP_CONJ",IMP_CONJ; "IMP_CONJ_ALT",IMP_CONJ_ALT; "IMP_DEF",IMP_DEF; "IMP_IMP",IMP_IMP; "IN",IN; "INCREASING_BOUNDED_VARIATION",INCREASING_BOUNDED_VARIATION; "INCREASING_BOUNDED_VARIATION_GEN",INCREASING_BOUNDED_VARIATION_GEN; "INCREASING_COUNTABLE_DISCONTINUITIES",INCREASING_COUNTABLE_DISCONTINUITIES; "INCREASING_EXTENDS_FROM_DENSE",INCREASING_EXTENDS_FROM_DENSE; "INCREASING_FTC_AE_IMP_ABSOLUTELY_CONTINUOUS",INCREASING_FTC_AE_IMP_ABSOLUTELY_CONTINUOUS; "INCREASING_LEFT_LIMIT_1",INCREASING_LEFT_LIMIT_1; "INCREASING_LEFT_LIMIT_1_GEN",INCREASING_LEFT_LIMIT_1_GEN; "INCREASING_RIGHT_LIMIT_1",INCREASING_RIGHT_LIMIT_1; "INCREASING_RIGHT_LIMIT_1_GEN",INCREASING_RIGHT_LIMIT_1_GEN; "INCREASING_VECTOR_VARIATION",INCREASING_VECTOR_VARIATION; "INDEFINITE_INTEGRAL_CONTINUOUS",INDEFINITE_INTEGRAL_CONTINUOUS; "INDEFINITE_INTEGRAL_CONTINUOUS_LEFT",INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; "INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT",INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT; "INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS; "INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT; "INDEPENDENT_2",INDEPENDENT_2; "INDEPENDENT_3",INDEPENDENT_3; "INDEPENDENT_BASIS_IMAGE",INDEPENDENT_BASIS_IMAGE; "INDEPENDENT_BOUND",INDEPENDENT_BOUND; "INDEPENDENT_BOUND_GENERAL",INDEPENDENT_BOUND_GENERAL; "INDEPENDENT_CARD_LE_DIM",INDEPENDENT_CARD_LE_DIM; "INDEPENDENT_EMPTY",INDEPENDENT_EMPTY; "INDEPENDENT_EQ_DIM_EQ_CARD",INDEPENDENT_EQ_DIM_EQ_CARD; "INDEPENDENT_EXPLICIT",INDEPENDENT_EXPLICIT; "INDEPENDENT_IMP_AFFINE_DEPENDENT_0",INDEPENDENT_IMP_AFFINE_DEPENDENT_0; "INDEPENDENT_IMP_FINITE",INDEPENDENT_IMP_FINITE; "INDEPENDENT_INJECTIVE_IMAGE",INDEPENDENT_INJECTIVE_IMAGE; "INDEPENDENT_INJECTIVE_IMAGE_GEN",INDEPENDENT_INJECTIVE_IMAGE_GEN; "INDEPENDENT_INSERT",INDEPENDENT_INSERT; "INDEPENDENT_LINEAR_IMAGE_EQ",INDEPENDENT_LINEAR_IMAGE_EQ; "INDEPENDENT_MONO",INDEPENDENT_MONO; "INDEPENDENT_NONZERO",INDEPENDENT_NONZERO; "INDEPENDENT_SING",INDEPENDENT_SING; "INDEPENDENT_SPAN_BOUND",INDEPENDENT_SPAN_BOUND; "INDEPENDENT_STDBASIS",INDEPENDENT_STDBASIS; "INDEPENDENT_SUBSPACES",INDEPENDENT_SUBSPACES; "INDEPENDENT_SUBSPACES_0",INDEPENDENT_SUBSPACES_0; "INDEPENDENT_SUBSPACES_ALT",INDEPENDENT_SUBSPACES_ALT; "INDEPENDENT_UNION",INDEPENDENT_UNION; "INDICATOR_COMPLEMENT",INDICATOR_COMPLEMENT; "INDUCT_LINEAR_ELEMENTARY",INDUCT_LINEAR_ELEMENTARY; "INDUCT_MATRIX_ELEMENTARY",INDUCT_MATRIX_ELEMENTARY; "INDUCT_MATRIX_ELEMENTARY_ALT",INDUCT_MATRIX_ELEMENTARY_ALT; "INDUCT_MATRIX_ROW_OPERATIONS",INDUCT_MATRIX_ROW_OPERATIONS; "IND_SUC_0",IND_SUC_0; "IND_SUC_0_EXISTS",IND_SUC_0_EXISTS; "IND_SUC_INJ",IND_SUC_INJ; "IND_SUC_SPEC",IND_SUC_SPEC; "INESSENTIAL_ON_CLOPEN_UNIONS",INESSENTIAL_ON_CLOPEN_UNIONS; "INESSENTIAL_ON_COMPONENTS",INESSENTIAL_ON_COMPONENTS; "INESSENTIAL_ON_COMPONENTS_EQ",INESSENTIAL_ON_COMPONENTS_EQ; "INF",INF; "INFINITE",INFINITE; "INFINITE_ARC_IMAGE",INFINITE_ARC_IMAGE; "INFINITE_CARD_LE",INFINITE_CARD_LE; "INFINITE_DIFF_FINITE",INFINITE_DIFF_FINITE; "INFINITE_ENUMERATE",INFINITE_ENUMERATE; "INFINITE_ENUMERATE_EQ",INFINITE_ENUMERATE_EQ; "INFINITE_ENUMERATE_EQ_ALT",INFINITE_ENUMERATE_EQ_ALT; "INFINITE_ENUMERATE_WEAK",INFINITE_ENUMERATE_WEAK; "INFINITE_FROM",INFINITE_FROM; "INFINITE_IMAGE",INFINITE_IMAGE; "INFINITE_IMAGE_INJ",INFINITE_IMAGE_INJ; "INFINITE_INTEGER",INFINITE_INTEGER; "INFINITE_IRRATIONAL_IN_RANGE",INFINITE_IRRATIONAL_IN_RANGE; "INFINITE_NONEMPTY",INFINITE_NONEMPTY; "INFINITE_OPEN_IN",INFINITE_OPEN_IN; "INFINITE_RATIONAL",INFINITE_RATIONAL; "INFINITE_RATIONAL_IN_RANGE",INFINITE_RATIONAL_IN_RANGE; "INFINITE_SIMPLE_PATH_IMAGE",INFINITE_SIMPLE_PATH_IMAGE; "INFINITE_SUPERSET",INFINITE_SUPERSET; "INFINITE_UNIV_PAIR",INFINITE_UNIV_PAIR; "INFINITY_AX",INFINITY_AX; "INFNORM_0",INFNORM_0; "INFNORM_2",INFNORM_2; "INFNORM_EQ_0",INFNORM_EQ_0; "INFNORM_EQ_1_2",INFNORM_EQ_1_2; "INFNORM_EQ_1_IMP",INFNORM_EQ_1_IMP; "INFNORM_LE_NORM",INFNORM_LE_NORM; "INFNORM_MUL",INFNORM_MUL; "INFNORM_MUL_LEMMA",INFNORM_MUL_LEMMA; "INFNORM_NEG",INFNORM_NEG; "INFNORM_POS_LE",INFNORM_POS_LE; "INFNORM_POS_LT",INFNORM_POS_LT; "INFNORM_SET_IMAGE",INFNORM_SET_IMAGE; "INFNORM_SET_LEMMA",INFNORM_SET_LEMMA; "INFNORM_SUB",INFNORM_SUB; "INFNORM_TRIANGLE",INFNORM_TRIANGLE; "INFSUM_0",INFSUM_0; "INFSUM_ADD",INFSUM_ADD; "INFSUM_CMUL",INFSUM_CMUL; "INFSUM_EQ",INFSUM_EQ; "INFSUM_EVEN",INFSUM_EVEN; "INFSUM_LINEAR",INFSUM_LINEAR; "INFSUM_NEG",INFSUM_NEG; "INFSUM_ODD",INFSUM_ODD; "INFSUM_RESTRICT",INFSUM_RESTRICT; "INFSUM_SUB",INFSUM_SUB; "INFSUM_UNIQUE",INFSUM_UNIQUE; "INF_CLOSURE",INF_CLOSURE; "INF_EQ",INF_EQ; "INF_FINITE",INF_FINITE; "INF_FINITE_LEMMA",INF_FINITE_LEMMA; "INF_INSERT",INF_INSERT; "INF_INSERT_FINITE",INF_INSERT_FINITE; "INF_INSERT_INSERT",INF_INSERT_INSERT; "INF_LE_ELEMENT",INF_LE_ELEMENT; "INF_SING",INF_SING; "INF_UNION",INF_UNION; "INF_UNIQUE",INF_UNIQUE; "INF_UNIQUE_FINITE",INF_UNIQUE_FINITE; "INJ",INJ; "INJA",INJA; "INJA_INJ",INJA_INJ; "INJECTIVE_ALT",INJECTIVE_ALT; "INJECTIVE_IMAGE",INJECTIVE_IMAGE; "INJECTIVE_IMP_ISOMETRIC",INJECTIVE_IMP_ISOMETRIC; "INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM",INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM; "INJECTIVE_INTO_1D_IMP_OPEN_MAP",INJECTIVE_INTO_1D_IMP_OPEN_MAP; "INJECTIVE_INVERSE",INJECTIVE_INVERSE; "INJECTIVE_INVERSE_o",INJECTIVE_INVERSE_o; "INJECTIVE_LEFT_INVERSE",INJECTIVE_LEFT_INVERSE; "INJECTIVE_LEFT_INVERSE_NONEMPTY",INJECTIVE_LEFT_INVERSE_NONEMPTY; "INJECTIVE_MAP",INJECTIVE_MAP; "INJECTIVE_MAP_OPEN_IFF_CLOSED",INJECTIVE_MAP_OPEN_IFF_CLOSED; "INJECTIVE_ON_ALT",INJECTIVE_ON_ALT; "INJECTIVE_ON_IMAGE",INJECTIVE_ON_IMAGE; "INJECTIVE_ON_LEFT_INVERSE",INJECTIVE_ON_LEFT_INVERSE; "INJECTIVE_ON_PREIMAGE",INJECTIVE_ON_PREIMAGE; "INJECTIVE_PREIMAGE",INJECTIVE_PREIMAGE; "INJECTIVE_SCALING",INJECTIVE_SCALING; "INJF",INJF; "INJF_INJ",INJF_INJ; "INJN",INJN; "INJN_INJ",INJN_INJ; "INJP",INJP; "INJP_INJ",INJP_INJ; "INJ_INVERSE2",INJ_INVERSE2; "INNER_LADD",INNER_LADD; "INNER_LMUL",INNER_LMUL; "INNER_LNEG",INNER_LNEG; "INNER_LZERO",INNER_LZERO; "INNER_RADD",INNER_RADD; "INNER_RMUL",INNER_RMUL; "INNER_RNEG",INNER_RNEG; "INNER_RZERO",INNER_RZERO; "INSEG_ANTISYM",INSEG_ANTISYM; "INSEG_FL_SUBSET",INSEG_FL_SUBSET; "INSEG_LINSEG",INSEG_LINSEG; "INSEG_ORDINAL",INSEG_ORDINAL; "INSEG_PROPER_SUBSET",INSEG_PROPER_SUBSET; "INSEG_PROPER_SUBSET_FL",INSEG_PROPER_SUBSET_FL; "INSEG_REFL",INSEG_REFL; "INSEG_SUBSET",INSEG_SUBSET; "INSEG_SUBSET_FL",INSEG_SUBSET_FL; "INSEG_TRANS",INSEG_TRANS; "INSEG_WOSET",INSEG_WOSET; "INSERT",INSERT; "INSERT_AC",INSERT_AC; "INSERT_COMM",INSERT_COMM; "INSERT_DEF",INSERT_DEF; "INSERT_DELETE",INSERT_DELETE; "INSERT_DIFF",INSERT_DIFF; "INSERT_INSERT",INSERT_INSERT; "INSERT_INTER",INSERT_INTER; "INSERT_SUBSET",INSERT_SUBSET; "INSERT_UNION",INSERT_UNION; "INSERT_UNION_EQ",INSERT_UNION_EQ; "INSERT_UNIV",INSERT_UNIV; "INSIDE_ARC_EMPTY",INSIDE_ARC_EMPTY; "INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY",INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY; "INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY",INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY; "INSIDE_CONNECTED_COMPONENT_LE",INSIDE_CONNECTED_COMPONENT_LE; "INSIDE_CONNECTED_COMPONENT_LT",INSIDE_CONNECTED_COMPONENT_LT; "INSIDE_CONVEX",INSIDE_CONVEX; "INSIDE_EMPTY",INSIDE_EMPTY; "INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT",INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT; "INSIDE_EQ_OUTSIDE",INSIDE_EQ_OUTSIDE; "INSIDE_FRONTIER_EQ_INTERIOR",INSIDE_FRONTIER_EQ_INTERIOR; "INSIDE_INSIDE",INSIDE_INSIDE; "INSIDE_INSIDE_COMPACT_CONNECTED",INSIDE_INSIDE_COMPACT_CONNECTED; "INSIDE_INSIDE_EQ_EMPTY",INSIDE_INSIDE_EQ_EMPTY; "INSIDE_INSIDE_SUBSET",INSIDE_INSIDE_SUBSET; "INSIDE_INTER_OUTSIDE",INSIDE_INTER_OUTSIDE; "INSIDE_IN_COMPONENTS",INSIDE_IN_COMPONENTS; "INSIDE_LINEAR_IMAGE",INSIDE_LINEAR_IMAGE; "INSIDE_MONO",INSIDE_MONO; "INSIDE_MONO_ALT",INSIDE_MONO_ALT; "INSIDE_NO_OVERLAP",INSIDE_NO_OVERLAP; "INSIDE_OF_TRIANGLE",INSIDE_OF_TRIANGLE; "INSIDE_OUTSIDE",INSIDE_OUTSIDE; "INSIDE_OUTSIDE_COMPACT_CONNECTED",INSIDE_OUTSIDE_COMPACT_CONNECTED; "INSIDE_OUTSIDE_INTERSECT_CONNECTED",INSIDE_OUTSIDE_INTERSECT_CONNECTED; "INSIDE_OUTSIDE_UNIQUE",INSIDE_OUTSIDE_UNIQUE; "INSIDE_SAME_COMPONENT",INSIDE_SAME_COMPONENT; "INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED",INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED; "INSIDE_SELF_OUTSIDE_EVERSION",INSIDE_SELF_OUTSIDE_EVERSION; "INSIDE_SIMPLE_CURVE_IMP_CLOSED",INSIDE_SIMPLE_CURVE_IMP_CLOSED; "INSIDE_SPHERE",INSIDE_SPHERE; "INSIDE_SUBSET",INSIDE_SUBSET; "INSIDE_SUBSET_CONVEX",INSIDE_SUBSET_CONVEX; "INSIDE_SUBSET_CONVEX_HULL",INSIDE_SUBSET_CONVEX_HULL; "INSIDE_SUBSET_INTERIOR_CONVEX",INSIDE_SUBSET_INTERIOR_CONVEX; "INSIDE_SUBSET_INTERIOR_CONVEX_HULL",INSIDE_SUBSET_INTERIOR_CONVEX_HULL; "INSIDE_TRANSLATION",INSIDE_TRANSLATION; "INSIDE_UNION_OUTSIDE",INSIDE_UNION_OUTSIDE; "INSIDE_UNIQUE",INSIDE_UNIQUE; "INSIDE_WITH_INSIDE",INSIDE_WITH_INSIDE; "INTEGER_ABS",INTEGER_ABS; "INTEGER_ABS_MUL_EQ_1",INTEGER_ABS_MUL_EQ_1; "INTEGER_ADD",INTEGER_ADD; "INTEGER_ADD_EQ",INTEGER_ADD_EQ; "INTEGER_CASES",INTEGER_CASES; "INTEGER_CLOSED",INTEGER_CLOSED; "INTEGER_DET",INTEGER_DET; "INTEGER_DIV",INTEGER_DIV; "INTEGER_EXISTS_BETWEEN",INTEGER_EXISTS_BETWEEN; "INTEGER_EXISTS_BETWEEN_ABS",INTEGER_EXISTS_BETWEEN_ABS; "INTEGER_EXISTS_BETWEEN_ABS_LT",INTEGER_EXISTS_BETWEEN_ABS_LT; "INTEGER_EXISTS_BETWEEN_ALT",INTEGER_EXISTS_BETWEEN_ALT; "INTEGER_EXISTS_BETWEEN_LT",INTEGER_EXISTS_BETWEEN_LT; "INTEGER_MUL",INTEGER_MUL; "INTEGER_NEG",INTEGER_NEG; "INTEGER_POS",INTEGER_POS; "INTEGER_POW",INTEGER_POW; "INTEGER_PRODUCT",INTEGER_PRODUCT; "INTEGER_REAL_OF_INT",INTEGER_REAL_OF_INT; "INTEGER_ROUND",INTEGER_ROUND; "INTEGER_SIGN",INTEGER_SIGN; "INTEGER_SUB",INTEGER_SUB; "INTEGER_SUB_EQ",INTEGER_SUB_EQ; "INTEGER_SUM",INTEGER_SUM; "INTEGRABLE_0",INTEGRABLE_0; "INTEGRABLE_ADD",INTEGRABLE_ADD; "INTEGRABLE_AFFINITY",INTEGRABLE_AFFINITY; "INTEGRABLE_ALT",INTEGRABLE_ALT; "INTEGRABLE_ALT_SUBSET",INTEGRABLE_ALT_SUBSET; "INTEGRABLE_BOUNDED_VARIATION",INTEGRABLE_BOUNDED_VARIATION; "INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL",INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL; "INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL",INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL; "INTEGRABLE_BOUNDED_VARIATION_PRODUCT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT; "INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT; "INTEGRABLE_BY_PARTS",INTEGRABLE_BY_PARTS; "INTEGRABLE_BY_PARTS_EQ",INTEGRABLE_BY_PARTS_EQ; "INTEGRABLE_CASES",INTEGRABLE_CASES; "INTEGRABLE_CAUCHY",INTEGRABLE_CAUCHY; "INTEGRABLE_CCONTINUOUS_EXPLICIT",INTEGRABLE_CCONTINUOUS_EXPLICIT; "INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC",INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC; "INTEGRABLE_CMUL",INTEGRABLE_CMUL; "INTEGRABLE_CMUL_EQ",INTEGRABLE_CMUL_EQ; "INTEGRABLE_COMBINE",INTEGRABLE_COMBINE; "INTEGRABLE_COMBINE_DIVISION",INTEGRABLE_COMBINE_DIVISION; "INTEGRABLE_COMPONENTWISE",INTEGRABLE_COMPONENTWISE; "INTEGRABLE_CONST",INTEGRABLE_CONST; "INTEGRABLE_CONTINUOUS",INTEGRABLE_CONTINUOUS; "INTEGRABLE_CONVOLUTION_SYM",INTEGRABLE_CONVOLUTION_SYM; "INTEGRABLE_DECREASING",INTEGRABLE_DECREASING; "INTEGRABLE_DECREASING_1",INTEGRABLE_DECREASING_1; "INTEGRABLE_DECREASING_PRODUCT",INTEGRABLE_DECREASING_PRODUCT; "INTEGRABLE_DECREASING_PRODUCT_UNIV",INTEGRABLE_DECREASING_PRODUCT_UNIV; "INTEGRABLE_DIFF",INTEGRABLE_DIFF; "INTEGRABLE_EQ",INTEGRABLE_EQ; "INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE",INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE; "INTEGRABLE_IMP_MEASURABLE",INTEGRABLE_IMP_MEASURABLE; "INTEGRABLE_INCREASING",INTEGRABLE_INCREASING; "INTEGRABLE_INCREASING_1",INTEGRABLE_INCREASING_1; "INTEGRABLE_INCREASING_PRODUCT",INTEGRABLE_INCREASING_PRODUCT; "INTEGRABLE_INCREASING_PRODUCT_UNIV",INTEGRABLE_INCREASING_PRODUCT_UNIV; "INTEGRABLE_INTEGRAL",INTEGRABLE_INTEGRAL; "INTEGRABLE_LINEAR",INTEGRABLE_LINEAR; "INTEGRABLE_MIN_CONST_1",INTEGRABLE_MIN_CONST_1; "INTEGRABLE_NEG",INTEGRABLE_NEG; "INTEGRABLE_NEG_EQ",INTEGRABLE_NEG_EQ; "INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND",INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND; "INTEGRABLE_ON_CONST",INTEGRABLE_ON_CONST; "INTEGRABLE_ON_EMPTY",INTEGRABLE_ON_EMPTY; "INTEGRABLE_ON_INDICATOR",INTEGRABLE_ON_INDICATOR; "INTEGRABLE_ON_LITTLE_SUBINTERVALS",INTEGRABLE_ON_LITTLE_SUBINTERVALS; "INTEGRABLE_ON_NEGLIGIBLE",INTEGRABLE_ON_NEGLIGIBLE; "INTEGRABLE_ON_NULL",INTEGRABLE_ON_NULL; "INTEGRABLE_ON_OPEN_INTERVAL",INTEGRABLE_ON_OPEN_INTERVAL; "INTEGRABLE_ON_REFL",INTEGRABLE_ON_REFL; "INTEGRABLE_ON_SUBDIVISION",INTEGRABLE_ON_SUBDIVISION; "INTEGRABLE_ON_SUBINTERVAL",INTEGRABLE_ON_SUBINTERVAL; "INTEGRABLE_ON_SUBINTERVAL_GEN",INTEGRABLE_ON_SUBINTERVAL_GEN; "INTEGRABLE_ON_SUBSET",INTEGRABLE_ON_SUBSET; "INTEGRABLE_ON_SUPERSET",INTEGRABLE_ON_SUPERSET; "INTEGRABLE_PASTECART_SYM",INTEGRABLE_PASTECART_SYM; "INTEGRABLE_PASTECART_SYM_UNIV",INTEGRABLE_PASTECART_SYM_UNIV; "INTEGRABLE_REFLECT",INTEGRABLE_REFLECT; "INTEGRABLE_REFLECT_GEN",INTEGRABLE_REFLECT_GEN; "INTEGRABLE_RESTRICT",INTEGRABLE_RESTRICT; "INTEGRABLE_RESTRICT_INTER",INTEGRABLE_RESTRICT_INTER; "INTEGRABLE_RESTRICT_UNIV",INTEGRABLE_RESTRICT_UNIV; "INTEGRABLE_SPIKE",INTEGRABLE_SPIKE; "INTEGRABLE_SPIKE_EQ",INTEGRABLE_SPIKE_EQ; "INTEGRABLE_SPIKE_FINITE",INTEGRABLE_SPIKE_FINITE; "INTEGRABLE_SPIKE_INTERIOR",INTEGRABLE_SPIKE_INTERIOR; "INTEGRABLE_SPIKE_SET",INTEGRABLE_SPIKE_SET; "INTEGRABLE_SPIKE_SET_EQ",INTEGRABLE_SPIKE_SET_EQ; "INTEGRABLE_SPLIT",INTEGRABLE_SPLIT; "INTEGRABLE_STRADDLE",INTEGRABLE_STRADDLE; "INTEGRABLE_STRADDLE_INTERVAL",INTEGRABLE_STRADDLE_INTERVAL; "INTEGRABLE_STRETCH",INTEGRABLE_STRETCH; "INTEGRABLE_SUB",INTEGRABLE_SUB; "INTEGRABLE_SUBINTERVAL",INTEGRABLE_SUBINTERVAL; "INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE",INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE; "INTEGRABLE_TRANSLATION",INTEGRABLE_TRANSLATION; "INTEGRABLE_TWIZZLE_EQ",INTEGRABLE_TWIZZLE_EQ; "INTEGRABLE_UNIFORM_LIMIT",INTEGRABLE_UNIFORM_LIMIT; "INTEGRABLE_UNION",INTEGRABLE_UNION; "INTEGRABLE_UNIONS",INTEGRABLE_UNIONS; "INTEGRABLE_UNIONS_IMAGE",INTEGRABLE_UNIONS_IMAGE; "INTEGRABLE_UNION_EQ",INTEGRABLE_UNION_EQ; "INTEGRABLE_VSUM",INTEGRABLE_VSUM; "INTEGRAL_0",INTEGRAL_0; "INTEGRAL_ADD",INTEGRAL_ADD; "INTEGRAL_CHANGE_OF_VARIABLES",INTEGRAL_CHANGE_OF_VARIABLES; "INTEGRAL_CHANGE_OF_VARIABLES_LINEAR",INTEGRAL_CHANGE_OF_VARIABLES_LINEAR; "INTEGRAL_CMUL",INTEGRAL_CMUL; "INTEGRAL_COMBINE",INTEGRAL_COMBINE; "INTEGRAL_COMBINE_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_DIVISION_BOTTOMUP; "INTEGRAL_COMBINE_DIVISION_TOPDOWN",INTEGRAL_COMBINE_DIVISION_TOPDOWN; "INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP; "INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; "INTEGRAL_COMPONENT",INTEGRAL_COMPONENT; "INTEGRAL_COMPONENT_LBOUND",INTEGRAL_COMPONENT_LBOUND; "INTEGRAL_COMPONENT_LE",INTEGRAL_COMPONENT_LE; "INTEGRAL_COMPONENT_LE_AE",INTEGRAL_COMPONENT_LE_AE; "INTEGRAL_COMPONENT_POS",INTEGRAL_COMPONENT_POS; "INTEGRAL_COMPONENT_UBOUND",INTEGRAL_COMPONENT_UBOUND; "INTEGRAL_CONST",INTEGRAL_CONST; "INTEGRAL_CONST_GEN",INTEGRAL_CONST_GEN; "INTEGRAL_CONVOLUTION_SYM",INTEGRAL_CONVOLUTION_SYM; "INTEGRAL_COUNTABLE_UNIONS",INTEGRAL_COUNTABLE_UNIONS; "INTEGRAL_COUNTABLE_UNIONS_ALT",INTEGRAL_COUNTABLE_UNIONS_ALT; "INTEGRAL_DIFF",INTEGRAL_DIFF; "INTEGRAL_DROP_LE",INTEGRAL_DROP_LE; "INTEGRAL_DROP_LE_AE",INTEGRAL_DROP_LE_AE; "INTEGRAL_DROP_LE_MEASURABLE",INTEGRAL_DROP_LE_MEASURABLE; "INTEGRAL_DROP_POS",INTEGRAL_DROP_POS; "INTEGRAL_DROP_POS_AE",INTEGRAL_DROP_POS_AE; "INTEGRAL_EMPTY",INTEGRAL_EMPTY; "INTEGRAL_EQ",INTEGRAL_EQ; "INTEGRAL_EQ_0",INTEGRAL_EQ_0; "INTEGRAL_EQ_HAS_INTEGRAL",INTEGRAL_EQ_HAS_INTEGRAL; "INTEGRAL_HAS_VECTOR_DERIVATIVE",INTEGRAL_HAS_VECTOR_DERIVATIVE; "INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE",INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE; "INTEGRAL_INDICATOR",INTEGRAL_INDICATOR; "INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION; "INTEGRAL_INTERVALS_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION; "INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT; "INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT; "INTEGRAL_LINEAR",INTEGRAL_LINEAR; "INTEGRAL_MEASURE",INTEGRAL_MEASURE; "INTEGRAL_MEASURE_UNIV",INTEGRAL_MEASURE_UNIV; "INTEGRAL_NEG",INTEGRAL_NEG; "INTEGRAL_NORM_BOUND_INTEGRAL",INTEGRAL_NORM_BOUND_INTEGRAL; "INTEGRAL_NORM_BOUND_INTEGRAL_AE",INTEGRAL_NORM_BOUND_INTEGRAL_AE; "INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; "INTEGRAL_NULL",INTEGRAL_NULL; "INTEGRAL_ON_IMAGE_DROP_UBOUND_LE",INTEGRAL_ON_IMAGE_DROP_UBOUND_LE; "INTEGRAL_ON_NEGLIGIBLE",INTEGRAL_ON_NEGLIGIBLE; "INTEGRAL_OPEN_INTERVAL",INTEGRAL_OPEN_INTERVAL; "INTEGRAL_PASTECART_CONST",INTEGRAL_PASTECART_CONST; "INTEGRAL_PASTECART_CONTINUOUS",INTEGRAL_PASTECART_CONTINUOUS; "INTEGRAL_PASTECART_SYM",INTEGRAL_PASTECART_SYM; "INTEGRAL_PASTECART_SYM_UNIV",INTEGRAL_PASTECART_SYM_UNIV; "INTEGRAL_REFL",INTEGRAL_REFL; "INTEGRAL_REFLECT",INTEGRAL_REFLECT; "INTEGRAL_REFLECT_GEN",INTEGRAL_REFLECT_GEN; "INTEGRAL_RESTRICT",INTEGRAL_RESTRICT; "INTEGRAL_RESTRICT_INTER",INTEGRAL_RESTRICT_INTER; "INTEGRAL_RESTRICT_UNIV",INTEGRAL_RESTRICT_UNIV; "INTEGRAL_SPIKE",INTEGRAL_SPIKE; "INTEGRAL_SPIKE_SET",INTEGRAL_SPIKE_SET; "INTEGRAL_SPLIT",INTEGRAL_SPLIT; "INTEGRAL_SPLIT_SIGNED",INTEGRAL_SPLIT_SIGNED; "INTEGRAL_SUB",INTEGRAL_SUB; "INTEGRAL_SUBSET_COMPONENT_LE",INTEGRAL_SUBSET_COMPONENT_LE; "INTEGRAL_SUBSET_DROP_LE",INTEGRAL_SUBSET_DROP_LE; "INTEGRAL_SUBSET_DROP_LE_AE",INTEGRAL_SUBSET_DROP_LE_AE; "INTEGRAL_SWAP_CONTINUOUS",INTEGRAL_SWAP_CONTINUOUS; "INTEGRAL_TRANSLATION",INTEGRAL_TRANSLATION; "INTEGRAL_TWIZZLE_EQ",INTEGRAL_TWIZZLE_EQ; "INTEGRAL_UNION",INTEGRAL_UNION; "INTEGRAL_UNIQUE",INTEGRAL_UNIQUE; "INTEGRAL_VSUM",INTEGRAL_VSUM; "INTEGRAL_ZERO_ON_SUBINTERVALS_IMP_ZERO_AE",INTEGRAL_ZERO_ON_SUBINTERVALS_IMP_ZERO_AE; "INTEGRATION_BY_PARTS",INTEGRATION_BY_PARTS; "INTEGRATION_BY_PARTS_SIMPLE",INTEGRATION_BY_PARTS_SIMPLE; "INTER",INTER; "INTERIOR_AFFINITY",INTERIOR_AFFINITY; "INTERIOR_ARC_IMAGE",INTERIOR_ARC_IMAGE; "INTERIOR_BALL",INTERIOR_BALL; "INTERIOR_BIJECTIVE_LINEAR_IMAGE",INTERIOR_BIJECTIVE_LINEAR_IMAGE; "INTERIOR_CBALL",INTERIOR_CBALL; "INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER",INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER; "INTERIOR_CLOSED_INTERVAL",INTERIOR_CLOSED_INTERVAL; "INTERIOR_CLOSED_UNION_EMPTY_INTERIOR",INTERIOR_CLOSED_UNION_EMPTY_INTERIOR; "INTERIOR_CLOSURE",INTERIOR_CLOSURE; "INTERIOR_CLOSURE_IDEMP",INTERIOR_CLOSURE_IDEMP; "INTERIOR_CLOSURE_INTER_OPEN",INTERIOR_CLOSURE_INTER_OPEN; "INTERIOR_COMPLEMENT",INTERIOR_COMPLEMENT; "INTERIOR_CONVEX_HULL_3",INTERIOR_CONVEX_HULL_3; "INTERIOR_CONVEX_HULL_3_MINIMAL",INTERIOR_CONVEX_HULL_3_MINIMAL; "INTERIOR_CONVEX_HULL_EQ_EMPTY",INTERIOR_CONVEX_HULL_EQ_EMPTY; "INTERIOR_CONVEX_HULL_EXPLICIT",INTERIOR_CONVEX_HULL_EXPLICIT; "INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL",INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL; "INTERIOR_DIFF",INTERIOR_DIFF; "INTERIOR_EMPTY",INTERIOR_EMPTY; "INTERIOR_EQ",INTERIOR_EQ; "INTERIOR_EQ_EMPTY",INTERIOR_EQ_EMPTY; "INTERIOR_EQ_EMPTY_ALT",INTERIOR_EQ_EMPTY_ALT; "INTERIOR_EQ_UNIV",INTERIOR_EQ_UNIV; "INTERIOR_FINITE_INTERS",INTERIOR_FINITE_INTERS; "INTERIOR_FRONTIER",INTERIOR_FRONTIER; "INTERIOR_FRONTIER_EMPTY",INTERIOR_FRONTIER_EMPTY; "INTERIOR_HALFSPACE_COMPONENT_GE",INTERIOR_HALFSPACE_COMPONENT_GE; "INTERIOR_HALFSPACE_COMPONENT_LE",INTERIOR_HALFSPACE_COMPONENT_LE; "INTERIOR_HALFSPACE_GE",INTERIOR_HALFSPACE_GE; "INTERIOR_HALFSPACE_LE",INTERIOR_HALFSPACE_LE; "INTERIOR_HYPERPLANE",INTERIOR_HYPERPLANE; "INTERIOR_IMAGE_SUBSET",INTERIOR_IMAGE_SUBSET; "INTERIOR_INJECTIVE_LINEAR_IMAGE",INTERIOR_INJECTIVE_LINEAR_IMAGE; "INTERIOR_INSIDE_FRONTIER",INTERIOR_INSIDE_FRONTIER; "INTERIOR_INTER",INTERIOR_INTER; "INTERIOR_INTERIOR",INTERIOR_INTERIOR; "INTERIOR_INTERS_SUBSET",INTERIOR_INTERS_SUBSET; "INTERIOR_INTERVAL",INTERIOR_INTERVAL; "INTERIOR_LIMIT_POINT",INTERIOR_LIMIT_POINT; "INTERIOR_MAXIMAL",INTERIOR_MAXIMAL; "INTERIOR_MAXIMAL_EQ",INTERIOR_MAXIMAL_EQ; "INTERIOR_NEGATIONS",INTERIOR_NEGATIONS; "INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF",INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF; "INTERIOR_OF_CLOSURE_OF",INTERIOR_OF_CLOSURE_OF; "INTERIOR_OF_CLOSURE_OF_IDEMP",INTERIOR_OF_CLOSURE_OF_IDEMP; "INTERIOR_OF_COMPLEMENT",INTERIOR_OF_COMPLEMENT; "INTERIOR_OF_EMPTY",INTERIOR_OF_EMPTY; "INTERIOR_OF_EQ",INTERIOR_OF_EQ; "INTERIOR_OF_EQ_EMPTY",INTERIOR_OF_EQ_EMPTY; "INTERIOR_OF_EQ_EMPTY_ALT",INTERIOR_OF_EQ_EMPTY_ALT; "INTERIOR_OF_EQ_EMPTY_COMPLEMENT",INTERIOR_OF_EQ_EMPTY_COMPLEMENT; "INTERIOR_OF_FRONTIER_OF",INTERIOR_OF_FRONTIER_OF; "INTERIOR_OF_FRONTIER_OF_EMPTY",INTERIOR_OF_FRONTIER_OF_EMPTY; "INTERIOR_OF_INJECTIVE_LINEAR_IMAGE",INTERIOR_OF_INJECTIVE_LINEAR_IMAGE; "INTERIOR_OF_INTER",INTERIOR_OF_INTER; "INTERIOR_OF_INTERIOR_OF",INTERIOR_OF_INTERIOR_OF; "INTERIOR_OF_INTERS_SUBSET",INTERIOR_OF_INTERS_SUBSET; "INTERIOR_OF_MAXIMAL",INTERIOR_OF_MAXIMAL; "INTERIOR_OF_MAXIMAL_EQ",INTERIOR_OF_MAXIMAL_EQ; "INTERIOR_OF_MONO",INTERIOR_OF_MONO; "INTERIOR_OF_OPEN_IN",INTERIOR_OF_OPEN_IN; "INTERIOR_OF_RESTRICT",INTERIOR_OF_RESTRICT; "INTERIOR_OF_SUBSET",INTERIOR_OF_SUBSET; "INTERIOR_OF_SUBSET_CLOSURE_OF",INTERIOR_OF_SUBSET_CLOSURE_OF; "INTERIOR_OF_SUBSET_SUBTOPOLOGY",INTERIOR_OF_SUBSET_SUBTOPOLOGY; "INTERIOR_OF_SUBSET_TOPSPACE",INTERIOR_OF_SUBSET_TOPSPACE; "INTERIOR_OF_SUBTOPOLOGY_MONO",INTERIOR_OF_SUBTOPOLOGY_MONO; "INTERIOR_OF_SUBTOPOLOGY_OPEN",INTERIOR_OF_SUBTOPOLOGY_OPEN; "INTERIOR_OF_SUBTOPOLOGY_SUBSET",INTERIOR_OF_SUBTOPOLOGY_SUBSET; "INTERIOR_OF_SUBTOPOLOGY_SUBSETS",INTERIOR_OF_SUBTOPOLOGY_SUBSETS; "INTERIOR_OF_TOPSPACE",INTERIOR_OF_TOPSPACE; "INTERIOR_OF_TRANSLATION",INTERIOR_OF_TRANSLATION; "INTERIOR_OF_TRIANGLE",INTERIOR_OF_TRIANGLE; "INTERIOR_OF_UNIONS_OPEN_IN_SUBSETS",INTERIOR_OF_UNIONS_OPEN_IN_SUBSETS; "INTERIOR_OF_UNION_EQ_EMPTY",INTERIOR_OF_UNION_EQ_EMPTY; "INTERIOR_OF_UNIQUE",INTERIOR_OF_UNIQUE; "INTERIOR_OPEN",INTERIOR_OPEN; "INTERIOR_PCROSS",INTERIOR_PCROSS; "INTERIOR_RECTIFIABLE_PATH_IMAGE",INTERIOR_RECTIFIABLE_PATH_IMAGE; "INTERIOR_SCALING",INTERIOR_SCALING; "INTERIOR_SEGMENT",INTERIOR_SEGMENT; "INTERIOR_SIMPLEX_NONEMPTY",INTERIOR_SIMPLEX_NONEMPTY; "INTERIOR_SIMPLE_PATH_IMAGE",INTERIOR_SIMPLE_PATH_IMAGE; "INTERIOR_SING",INTERIOR_SING; "INTERIOR_SPHERE",INTERIOR_SPHERE; "INTERIOR_STANDARD_HYPERPLANE",INTERIOR_STANDARD_HYPERPLANE; "INTERIOR_STD_SIMPLEX",INTERIOR_STD_SIMPLEX; "INTERIOR_STRIP_COMPONENT_LE",INTERIOR_STRIP_COMPONENT_LE; "INTERIOR_SUBSET",INTERIOR_SUBSET; "INTERIOR_SUBSET_RELATIVE_INTERIOR",INTERIOR_SUBSET_RELATIVE_INTERIOR; "INTERIOR_SUBSET_UNION_INTERVALS",INTERIOR_SUBSET_UNION_INTERVALS; "INTERIOR_SURJECTIVE_LINEAR_IMAGE",INTERIOR_SURJECTIVE_LINEAR_IMAGE; "INTERIOR_TRANSLATION",INTERIOR_TRANSLATION; "INTERIOR_UNIONS_OPEN_SUBSETS",INTERIOR_UNIONS_OPEN_SUBSETS; "INTERIOR_UNION_EQ_EMPTY",INTERIOR_UNION_EQ_EMPTY; "INTERIOR_UNIQUE",INTERIOR_UNIQUE; "INTERIOR_UNIV",INTERIOR_UNIV; "INTERS",INTERS; "INTERSECTION_OF",INTERSECTION_OF; "INTERSECTION_OF_INC",INTERSECTION_OF_INC; "INTERSECTION_OF_MONO",INTERSECTION_OF_MONO; "INTERS_0",INTERS_0; "INTERS_1",INTERS_1; "INTERS_2",INTERS_2; "INTERS_EQ_UNIV",INTERS_EQ_UNIV; "INTERS_FACES_FINITE_ALTBOUND",INTERS_FACES_FINITE_ALTBOUND; "INTERS_FACES_FINITE_BOUND",INTERS_FACES_FINITE_BOUND; "INTERS_GSPEC",INTERS_GSPEC; "INTERS_IMAGE",INTERS_IMAGE; "INTERS_INSERT",INTERS_INSERT; "INTERS_IN_CHAIN",INTERS_IN_CHAIN; "INTERS_OVER_UNIONS",INTERS_OVER_UNIONS; "INTERS_SUBSET",INTERS_SUBSET; "INTERS_SUBSET_STRONG",INTERS_SUBSET_STRONG; "INTERS_UNION",INTERS_UNION; "INTERS_UNIONS",INTERS_UNIONS; "INTERVAL_1",INTERVAL_1; "INTERVAL_BIJ_AFFINE",INTERVAL_BIJ_AFFINE; "INTERVAL_BIJ_BIJ",INTERVAL_BIJ_BIJ; "INTERVAL_BISECTION",INTERVAL_BISECTION; "INTERVAL_BISECTION_STEP",INTERVAL_BISECTION_STEP; "INTERVAL_BOUNDS_EMPTY_1",INTERVAL_BOUNDS_EMPTY_1; "INTERVAL_BOUNDS_NULL_1",INTERVAL_BOUNDS_NULL_1; "INTERVAL_CASES_1",INTERVAL_CASES_1; "INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD",INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD; "INTERVAL_DOUBLESPLIT",INTERVAL_DOUBLESPLIT; "INTERVAL_EQ_EMPTY",INTERVAL_EQ_EMPTY; "INTERVAL_EQ_EMPTY_1",INTERVAL_EQ_EMPTY_1; "INTERVAL_IMAGE_AFFINITY_INTERVAL",INTERVAL_IMAGE_AFFINITY_INTERVAL; "INTERVAL_IMAGE_STRETCH_INTERVAL",INTERVAL_IMAGE_STRETCH_INTERVAL; "INTERVAL_LOWERBOUND",INTERVAL_LOWERBOUND; "INTERVAL_LOWERBOUND_1",INTERVAL_LOWERBOUND_1; "INTERVAL_LOWERBOUND_NONEMPTY",INTERVAL_LOWERBOUND_NONEMPTY; "INTERVAL_NE_EMPTY",INTERVAL_NE_EMPTY; "INTERVAL_NE_EMPTY_1",INTERVAL_NE_EMPTY_1; "INTERVAL_OPEN_SUBSET_CLOSED",INTERVAL_OPEN_SUBSET_CLOSED; "INTERVAL_SING",INTERVAL_SING; "INTERVAL_SPLIT",INTERVAL_SPLIT; "INTERVAL_SUBDIVISION",INTERVAL_SUBDIVISION; "INTERVAL_SUBSET_IS_INTERVAL",INTERVAL_SUBSET_IS_INTERVAL; "INTERVAL_SUBSET_SEGMENT_1",INTERVAL_SUBSET_SEGMENT_1; "INTERVAL_TRANSLATION",INTERVAL_TRANSLATION; "INTERVAL_UPPERBOUND",INTERVAL_UPPERBOUND; "INTERVAL_UPPERBOUND_1",INTERVAL_UPPERBOUND_1; "INTERVAL_UPPERBOUND_NONEMPTY",INTERVAL_UPPERBOUND_NONEMPTY; "INTER_ACI",INTER_ACI; "INTER_ASSOC",INTER_ASSOC; "INTER_BALLS_EQ_EMPTY",INTER_BALLS_EQ_EMPTY; "INTER_COMM",INTER_COMM; "INTER_CONIC_HULL",INTER_CONIC_HULL; "INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER",INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER; "INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR",INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR; "INTER_CROSS",INTER_CROSS; "INTER_EMPTY",INTER_EMPTY; "INTER_IDEMPOT",INTER_IDEMPOT; "INTER_INTERIOR_UNIONS_INTERVALS",INTER_INTERIOR_UNIONS_INTERVALS; "INTER_INTERS",INTER_INTERS; "INTER_INTERVAL",INTER_INTERVAL; "INTER_INTERVAL_1",INTER_INTERVAL_1; "INTER_INTERVAL_MIXED_EQ_EMPTY",INTER_INTERVAL_MIXED_EQ_EMPTY; "INTER_NUMSEG",INTER_NUMSEG; "INTER_OVER_UNION",INTER_OVER_UNION; "INTER_PCROSS",INTER_PCROSS; "INTER_RELATIVE_FRONTIER_CONIC_HULL",INTER_RELATIVE_FRONTIER_CONIC_HULL; "INTER_RELATIVE_INTERIOR_SUBSET",INTER_RELATIVE_INTERIOR_SUBSET; "INTER_SEGMENT",INTER_SEGMENT; "INTER_SPHERE_EQ_EMPTY",INTER_SPHERE_EQ_EMPTY; "INTER_SUBSET",INTER_SUBSET; "INTER_UNIONS",INTER_UNIONS; "INTER_UNIONS_PAIRWISE_DISJOINT",INTER_UNIONS_PAIRWISE_DISJOINT; "INTER_UNIV",INTER_UNIV; "INT_ABS",INT_ABS; "INT_ABS_0",INT_ABS_0; "INT_ABS_1",INT_ABS_1; "INT_ABS_ABS",INT_ABS_ABS; "INT_ABS_BETWEEN",INT_ABS_BETWEEN; "INT_ABS_BETWEEN1",INT_ABS_BETWEEN1; "INT_ABS_BETWEEN2",INT_ABS_BETWEEN2; "INT_ABS_BOUND",INT_ABS_BOUND; "INT_ABS_CASES",INT_ABS_CASES; "INT_ABS_CIRCLE",INT_ABS_CIRCLE; "INT_ABS_LE",INT_ABS_LE; "INT_ABS_MUL",INT_ABS_MUL; "INT_ABS_MUL_1",INT_ABS_MUL_1; "INT_ABS_NEG",INT_ABS_NEG; "INT_ABS_NUM",INT_ABS_NUM; "INT_ABS_NZ",INT_ABS_NZ; "INT_ABS_POS",INT_ABS_POS; "INT_ABS_POW",INT_ABS_POW; "INT_ABS_REFL",INT_ABS_REFL; "INT_ABS_SGN",INT_ABS_SGN; "INT_ABS_SIGN",INT_ABS_SIGN; "INT_ABS_SIGN2",INT_ABS_SIGN2; "INT_ABS_STILLNZ",INT_ABS_STILLNZ; "INT_ABS_SUB",INT_ABS_SUB; "INT_ABS_SUB_ABS",INT_ABS_SUB_ABS; "INT_ABS_TRIANGLE",INT_ABS_TRIANGLE; "INT_ABS_ZERO",INT_ABS_ZERO; "INT_ADD2_SUB2",INT_ADD2_SUB2; "INT_ADD_AC",INT_ADD_AC; "INT_ADD_ASSOC",INT_ADD_ASSOC; "INT_ADD_LDISTRIB",INT_ADD_LDISTRIB; "INT_ADD_LID",INT_ADD_LID; "INT_ADD_LINV",INT_ADD_LINV; "INT_ADD_RDISTRIB",INT_ADD_RDISTRIB; "INT_ADD_RID",INT_ADD_RID; "INT_ADD_RINV",INT_ADD_RINV; "INT_ADD_SUB",INT_ADD_SUB; "INT_ADD_SUB2",INT_ADD_SUB2; "INT_ADD_SYM",INT_ADD_SYM; "INT_ARCH",INT_ARCH; "INT_BOUNDS_LE",INT_BOUNDS_LE; "INT_BOUNDS_LT",INT_BOUNDS_LT; "INT_DIFFSQ",INT_DIFFSQ; "INT_DIVISION",INT_DIVISION; "INT_DIVISION_0",INT_DIVISION_0; "INT_DIVMOD_EXIST_0",INT_DIVMOD_EXIST_0; "INT_DIVMOD_UNIQ",INT_DIVMOD_UNIQ; "INT_ENTIRE",INT_ENTIRE; "INT_EQ_ADD_LCANCEL",INT_EQ_ADD_LCANCEL; "INT_EQ_ADD_LCANCEL_0",INT_EQ_ADD_LCANCEL_0; "INT_EQ_ADD_RCANCEL",INT_EQ_ADD_RCANCEL; "INT_EQ_ADD_RCANCEL_0",INT_EQ_ADD_RCANCEL_0; "INT_EQ_IMP_LE",INT_EQ_IMP_LE; "INT_EQ_MUL_LCANCEL",INT_EQ_MUL_LCANCEL; "INT_EQ_MUL_RCANCEL",INT_EQ_MUL_RCANCEL; "INT_EQ_NEG2",INT_EQ_NEG2; "INT_EQ_SGN_ABS",INT_EQ_SGN_ABS; "INT_EQ_SQUARE_ABS",INT_EQ_SQUARE_ABS; "INT_EQ_SUB_LADD",INT_EQ_SUB_LADD; "INT_EQ_SUB_RADD",INT_EQ_SUB_RADD; "INT_EXISTS_ABS",INT_EXISTS_ABS; "INT_EXISTS_POS",INT_EXISTS_POS; "INT_FORALL_ABS",INT_FORALL_ABS; "INT_FORALL_POS",INT_FORALL_POS; "INT_GCD_EXISTS",INT_GCD_EXISTS; "INT_GCD_EXISTS_POS",INT_GCD_EXISTS_POS; "INT_GE",INT_GE; "INT_GT",INT_GT; "INT_GT_DISCRETE",INT_GT_DISCRETE; "INT_IMAGE",INT_IMAGE; "INT_LET_ADD",INT_LET_ADD; "INT_LET_ADD2",INT_LET_ADD2; "INT_LET_ANTISYM",INT_LET_ANTISYM; "INT_LET_TOTAL",INT_LET_TOTAL; "INT_LET_TRANS",INT_LET_TRANS; "INT_LE_01",INT_LE_01; "INT_LE_ADD",INT_LE_ADD; "INT_LE_ADD2",INT_LE_ADD2; "INT_LE_ADDL",INT_LE_ADDL; "INT_LE_ADDR",INT_LE_ADDR; "INT_LE_ANTISYM",INT_LE_ANTISYM; "INT_LE_DISCRETE",INT_LE_DISCRETE; "INT_LE_DOUBLE",INT_LE_DOUBLE; "INT_LE_LADD",INT_LE_LADD; "INT_LE_LADD_IMP",INT_LE_LADD_IMP; "INT_LE_LMUL",INT_LE_LMUL; "INT_LE_LNEG",INT_LE_LNEG; "INT_LE_LT",INT_LE_LT; "INT_LE_MAX",INT_LE_MAX; "INT_LE_MIN",INT_LE_MIN; "INT_LE_MUL",INT_LE_MUL; "INT_LE_MUL_EQ",INT_LE_MUL_EQ; "INT_LE_NEG",INT_LE_NEG; "INT_LE_NEG2",INT_LE_NEG2; "INT_LE_NEGL",INT_LE_NEGL; "INT_LE_NEGR",INT_LE_NEGR; "INT_LE_NEGTOTAL",INT_LE_NEGTOTAL; "INT_LE_POW2",INT_LE_POW2; "INT_LE_RADD",INT_LE_RADD; "INT_LE_REFL",INT_LE_REFL; "INT_LE_RMUL",INT_LE_RMUL; "INT_LE_RNEG",INT_LE_RNEG; "INT_LE_SQUARE",INT_LE_SQUARE; "INT_LE_SQUARE_ABS",INT_LE_SQUARE_ABS; "INT_LE_SUB_LADD",INT_LE_SUB_LADD; "INT_LE_SUB_RADD",INT_LE_SUB_RADD; "INT_LE_TOTAL",INT_LE_TOTAL; "INT_LE_TRANS",INT_LE_TRANS; "INT_LE_TRANS_LE",INT_LE_TRANS_LE; "INT_LE_TRANS_LT",INT_LE_TRANS_LT; "INT_LNEG_UNIQ",INT_LNEG_UNIQ; "INT_LT",INT_LT; "INT_LTE_ADD",INT_LTE_ADD; "INT_LTE_ADD2",INT_LTE_ADD2; "INT_LTE_ANTISYM",INT_LTE_ANTISYM; "INT_LTE_TOTAL",INT_LTE_TOTAL; "INT_LTE_TRANS",INT_LTE_TRANS; "INT_LT_01",INT_LT_01; "INT_LT_ADD",INT_LT_ADD; "INT_LT_ADD1",INT_LT_ADD1; "INT_LT_ADD2",INT_LT_ADD2; "INT_LT_ADDL",INT_LT_ADDL; "INT_LT_ADDNEG",INT_LT_ADDNEG; "INT_LT_ADDNEG2",INT_LT_ADDNEG2; "INT_LT_ADDR",INT_LT_ADDR; "INT_LT_ADD_SUB",INT_LT_ADD_SUB; "INT_LT_ANTISYM",INT_LT_ANTISYM; "INT_LT_DISCRETE",INT_LT_DISCRETE; "INT_LT_GT",INT_LT_GT; "INT_LT_IMP_LE",INT_LT_IMP_LE; "INT_LT_IMP_NE",INT_LT_IMP_NE; "INT_LT_LADD",INT_LT_LADD; "INT_LT_LE",INT_LT_LE; "INT_LT_LMUL_EQ",INT_LT_LMUL_EQ; "INT_LT_MAX",INT_LT_MAX; "INT_LT_MIN",INT_LT_MIN; "INT_LT_MUL",INT_LT_MUL; "INT_LT_MUL_EQ",INT_LT_MUL_EQ; "INT_LT_NEG",INT_LT_NEG; "INT_LT_NEG2",INT_LT_NEG2; "INT_LT_NEGTOTAL",INT_LT_NEGTOTAL; "INT_LT_POW2",INT_LT_POW2; "INT_LT_RADD",INT_LT_RADD; "INT_LT_REFL",INT_LT_REFL; "INT_LT_RMUL_EQ",INT_LT_RMUL_EQ; "INT_LT_SQUARE_ABS",INT_LT_SQUARE_ABS; "INT_LT_SUB_LADD",INT_LT_SUB_LADD; "INT_LT_SUB_RADD",INT_LT_SUB_RADD; "INT_LT_TOTAL",INT_LT_TOTAL; "INT_LT_TRANS",INT_LT_TRANS; "INT_MAX",INT_MAX; "INT_MAX_ACI",INT_MAX_ACI; "INT_MAX_ASSOC",INT_MAX_ASSOC; "INT_MAX_LE",INT_MAX_LE; "INT_MAX_LT",INT_MAX_LT; "INT_MAX_MAX",INT_MAX_MAX; "INT_MAX_MIN",INT_MAX_MIN; "INT_MAX_SYM",INT_MAX_SYM; "INT_MIN",INT_MIN; "INT_MIN_ACI",INT_MIN_ACI; "INT_MIN_ASSOC",INT_MIN_ASSOC; "INT_MIN_LE",INT_MIN_LE; "INT_MIN_LT",INT_MIN_LT; "INT_MIN_MAX",INT_MIN_MAX; "INT_MIN_MIN",INT_MIN_MIN; "INT_MIN_SYM",INT_MIN_SYM; "INT_MUL_AC",INT_MUL_AC; "INT_MUL_ASSOC",INT_MUL_ASSOC; "INT_MUL_LID",INT_MUL_LID; "INT_MUL_LNEG",INT_MUL_LNEG; "INT_MUL_LZERO",INT_MUL_LZERO; "INT_MUL_POS_LE",INT_MUL_POS_LE; "INT_MUL_POS_LT",INT_MUL_POS_LT; "INT_MUL_RID",INT_MUL_RID; "INT_MUL_RNEG",INT_MUL_RNEG; "INT_MUL_RZERO",INT_MUL_RZERO; "INT_MUL_SYM",INT_MUL_SYM; "INT_NEGNEG",INT_NEGNEG; "INT_NEG_0",INT_NEG_0; "INT_NEG_ADD",INT_NEG_ADD; "INT_NEG_EQ",INT_NEG_EQ; "INT_NEG_EQ_0",INT_NEG_EQ_0; "INT_NEG_GE0",INT_NEG_GE0; "INT_NEG_GT0",INT_NEG_GT0; "INT_NEG_LE0",INT_NEG_LE0; "INT_NEG_LMUL",INT_NEG_LMUL; "INT_NEG_LT0",INT_NEG_LT0; "INT_NEG_MINUS1",INT_NEG_MINUS1; "INT_NEG_MUL2",INT_NEG_MUL2; "INT_NEG_NEG",INT_NEG_NEG; "INT_NEG_RMUL",INT_NEG_RMUL; "INT_NEG_SUB",INT_NEG_SUB; "INT_NOT_EQ",INT_NOT_EQ; "INT_NOT_LE",INT_NOT_LE; "INT_NOT_LT",INT_NOT_LT; "INT_OF_NUM_ADD",INT_OF_NUM_ADD; "INT_OF_NUM_EQ",INT_OF_NUM_EQ; "INT_OF_NUM_EXISTS",INT_OF_NUM_EXISTS; "INT_OF_NUM_GE",INT_OF_NUM_GE; "INT_OF_NUM_GT",INT_OF_NUM_GT; "INT_OF_NUM_LE",INT_OF_NUM_LE; "INT_OF_NUM_LT",INT_OF_NUM_LT; "INT_OF_NUM_MAX",INT_OF_NUM_MAX; "INT_OF_NUM_MIN",INT_OF_NUM_MIN; "INT_OF_NUM_MUL",INT_OF_NUM_MUL; "INT_OF_NUM_OF_INT",INT_OF_NUM_OF_INT; "INT_OF_NUM_POW",INT_OF_NUM_POW; "INT_OF_NUM_SUB",INT_OF_NUM_SUB; "INT_OF_NUM_SUC",INT_OF_NUM_SUC; "INT_OF_REAL_OF_INT",INT_OF_REAL_OF_INT; "INT_POS",INT_POS; "INT_POS_NZ",INT_POS_NZ; "INT_POW",INT_POW; "INT_POW2_ABS",INT_POW2_ABS; "INT_POW_1",INT_POW_1; "INT_POW_1_LE",INT_POW_1_LE; "INT_POW_1_LT",INT_POW_1_LT; "INT_POW_2",INT_POW_2; "INT_POW_ADD",INT_POW_ADD; "INT_POW_EQ",INT_POW_EQ; "INT_POW_EQ_0",INT_POW_EQ_0; "INT_POW_EQ_ABS",INT_POW_EQ_ABS; "INT_POW_LE",INT_POW_LE; "INT_POW_LE2",INT_POW_LE2; "INT_POW_LE2_ODD",INT_POW_LE2_ODD; "INT_POW_LE2_REV",INT_POW_LE2_REV; "INT_POW_LE_1",INT_POW_LE_1; "INT_POW_LT",INT_POW_LT; "INT_POW_LT2",INT_POW_LT2; "INT_POW_LT2_REV",INT_POW_LT2_REV; "INT_POW_LT_1",INT_POW_LT_1; "INT_POW_MONO",INT_POW_MONO; "INT_POW_MONO_LT",INT_POW_MONO_LT; "INT_POW_MUL",INT_POW_MUL; "INT_POW_NEG",INT_POW_NEG; "INT_POW_NZ",INT_POW_NZ; "INT_POW_ONE",INT_POW_ONE; "INT_POW_POW",INT_POW_POW; "INT_POW_ZERO",INT_POW_ZERO; "INT_RNEG_UNIQ",INT_RNEG_UNIQ; "INT_SGN",INT_SGN; "INT_SGNS_EQ",INT_SGNS_EQ; "INT_SGNS_EQ_ALT",INT_SGNS_EQ_ALT; "INT_SGN_0",INT_SGN_0; "INT_SGN_ABS",INT_SGN_ABS; "INT_SGN_ABS_ALT",INT_SGN_ABS_ALT; "INT_SGN_CASES",INT_SGN_CASES; "INT_SGN_EQ",INT_SGN_EQ; "INT_SGN_EQ_INEQ",INT_SGN_EQ_INEQ; "INT_SGN_INEQS",INT_SGN_INEQS; "INT_SGN_INT_SGN",INT_SGN_INT_SGN; "INT_SGN_MUL",INT_SGN_MUL; "INT_SGN_NEG",INT_SGN_NEG; "INT_SGN_POW",INT_SGN_POW; "INT_SGN_POW_2",INT_SGN_POW_2; "INT_SOS_EQ_0",INT_SOS_EQ_0; "INT_SUB",INT_SUB; "INT_SUB_0",INT_SUB_0; "INT_SUB_ABS",INT_SUB_ABS; "INT_SUB_ADD",INT_SUB_ADD; "INT_SUB_ADD2",INT_SUB_ADD2; "INT_SUB_LDISTRIB",INT_SUB_LDISTRIB; "INT_SUB_LE",INT_SUB_LE; "INT_SUB_LNEG",INT_SUB_LNEG; "INT_SUB_LT",INT_SUB_LT; "INT_SUB_LZERO",INT_SUB_LZERO; "INT_SUB_NEG2",INT_SUB_NEG2; "INT_SUB_RDISTRIB",INT_SUB_RDISTRIB; "INT_SUB_REFL",INT_SUB_REFL; "INT_SUB_RNEG",INT_SUB_RNEG; "INT_SUB_RZERO",INT_SUB_RZERO; "INT_SUB_SUB",INT_SUB_SUB; "INT_SUB_SUB2",INT_SUB_SUB2; "INT_SUB_TRIANGLE",INT_SUB_TRIANGLE; "INT_WOP",INT_WOP; "INVERSE_FUNCTION_C1",INVERSE_FUNCTION_C1; "INVERSE_FUNCTION_THEOREM",INVERSE_FUNCTION_THEOREM; "INVERSE_FUNCTION_THEOREM_AFFINE",INVERSE_FUNCTION_THEOREM_AFFINE; "INVERSE_FUNCTION_THEOREM_C1_POINTWISE",INVERSE_FUNCTION_THEOREM_C1_POINTWISE; "INVERSE_FUNCTION_THEOREM_GLOBAL",INVERSE_FUNCTION_THEOREM_GLOBAL; "INVERSE_FUNCTION_THEOREM_SUBSPACE",INVERSE_FUNCTION_THEOREM_SUBSPACE; "INVERSE_I",INVERSE_I; "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION; "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT; "INVERSE_SWAP",INVERSE_SWAP; "INVERSE_UNIQUE_o",INVERSE_UNIQUE_o; "INVERTIBLE_CMUL",INVERTIBLE_CMUL; "INVERTIBLE_COFACTOR",INVERTIBLE_COFACTOR; "INVERTIBLE_COVARIANCE_RANK",INVERTIBLE_COVARIANCE_RANK; "INVERTIBLE_DET_NZ",INVERTIBLE_DET_NZ; "INVERTIBLE_DIAGONAL_MATRIX",INVERTIBLE_DIAGONAL_MATRIX; "INVERTIBLE_EIGENVALUES",INVERTIBLE_EIGENVALUES; "INVERTIBLE_EQ_INJECTIVE_AND_SURJECTIVE",INVERTIBLE_EQ_INJECTIVE_AND_SURJECTIVE; "INVERTIBLE_FIXPOINT_PROPERTY",INVERTIBLE_FIXPOINT_PROPERTY; "INVERTIBLE_I",INVERTIBLE_I; "INVERTIBLE_IMP_SQUARE_MATRIX",INVERTIBLE_IMP_SQUARE_MATRIX; "INVERTIBLE_LEFT_INVERSE",INVERTIBLE_LEFT_INVERSE; "INVERTIBLE_MAT",INVERTIBLE_MAT; "INVERTIBLE_MATRIX_INV",INVERTIBLE_MATRIX_INV; "INVERTIBLE_MATRIX_MUL",INVERTIBLE_MATRIX_MUL; "INVERTIBLE_NEARBY",INVERTIBLE_NEARBY; "INVERTIBLE_NEARBY_ONORM",INVERTIBLE_NEARBY_ONORM; "INVERTIBLE_NEG",INVERTIBLE_NEG; "INVERTIBLE_RIGHT_INVERSE",INVERTIBLE_RIGHT_INVERSE; "INVERTIBLE_TRANSP",INVERTIBLE_TRANSP; "INVOLUTION_IMP_HOMEOMORPHISM",INVOLUTION_IMP_HOMEOMORPHISM; "INVOLUTION_IMP_HOMEOMORPHISM_GEN",INVOLUTION_IMP_HOMEOMORPHISM_GEN; "IN_AFFINE_ADD_MUL",IN_AFFINE_ADD_MUL; "IN_AFFINE_ADD_MUL_DIFF",IN_AFFINE_ADD_MUL_DIFF; "IN_AFFINE_HULL_LINEAR_IMAGE",IN_AFFINE_HULL_LINEAR_IMAGE; "IN_AFFINE_MUL_DIFF_ADD",IN_AFFINE_MUL_DIFF_ADD; "IN_AFFINE_SUB_MUL_DIFF",IN_AFFINE_SUB_MUL_DIFF; "IN_BALL",IN_BALL; "IN_BALL_0",IN_BALL_0; "IN_CARD_ADD",IN_CARD_ADD; "IN_CARD_MUL",IN_CARD_MUL; "IN_CBALL",IN_CBALL; "IN_CBALL_0",IN_CBALL_0; "IN_CLOSURE_CONNECTED_COMPONENT",IN_CLOSURE_CONNECTED_COMPONENT; "IN_CLOSURE_DELETE",IN_CLOSURE_DELETE; "IN_CLOSURE_OF",IN_CLOSURE_OF; "IN_COMPONENTS",IN_COMPONENTS; "IN_COMPONENTS_CONNECTED",IN_COMPONENTS_CONNECTED; "IN_COMPONENTS_MAXIMAL",IN_COMPONENTS_MAXIMAL; "IN_COMPONENTS_MAXIMAL_ALT",IN_COMPONENTS_MAXIMAL_ALT; "IN_COMPONENTS_NONEMPTY",IN_COMPONENTS_NONEMPTY; "IN_COMPONENTS_SELF",IN_COMPONENTS_SELF; "IN_COMPONENTS_SUBSET",IN_COMPONENTS_SUBSET; "IN_COMPONENTS_UNIONS_COMPLEMENT",IN_COMPONENTS_UNIONS_COMPLEMENT; "IN_CONIC_CONVEX_HULL_ROWS",IN_CONIC_CONVEX_HULL_ROWS; "IN_CONIC_CONVEX_HULL_ROWS_QFREE",IN_CONIC_CONVEX_HULL_ROWS_QFREE; "IN_CONVEX_HULL_EXCHANGE",IN_CONVEX_HULL_EXCHANGE; "IN_CONVEX_HULL_EXCHANGE_UNIQUE",IN_CONVEX_HULL_EXCHANGE_UNIQUE; "IN_CONVEX_HULL_INTERVAL_1",IN_CONVEX_HULL_INTERVAL_1; "IN_CONVEX_HULL_LINEAR_IMAGE",IN_CONVEX_HULL_LINEAR_IMAGE; "IN_CONVEX_HULL_ROWS",IN_CONVEX_HULL_ROWS; "IN_CONVEX_HULL_SEGMENT_1",IN_CONVEX_HULL_SEGMENT_1; "IN_CONVEX_SET",IN_CONVEX_SET; "IN_CROSS",IN_CROSS; "IN_DELETE",IN_DELETE; "IN_DELETE_EQ",IN_DELETE_EQ; "IN_DERIVED_SET_OF",IN_DERIVED_SET_OF; "IN_DIFF",IN_DIFF; "IN_DIMINDEX_SWAP",IN_DIMINDEX_SWAP; "IN_DIRECTION",IN_DIRECTION; "IN_DISJOINT",IN_DISJOINT; "IN_ELIM_PAIR_THM",IN_ELIM_PAIR_THM; "IN_ELIM_PASTECART_THM",IN_ELIM_PASTECART_THM; "IN_ELIM_THM",IN_ELIM_THM; "IN_EPIGRAPH",IN_EPIGRAPH; "IN_EXTENSIONAL",IN_EXTENSIONAL; "IN_EXTENSIONAL_UNDEFINED",IN_EXTENSIONAL_UNDEFINED; "IN_FROM",IN_FROM; "IN_FRONTIER_CONVEX_HULL",IN_FRONTIER_CONVEX_HULL; "IN_IMAGE",IN_IMAGE; "IN_IMAGE_DROPOUT",IN_IMAGE_DROPOUT; "IN_IMAGE_LIFT_DROP",IN_IMAGE_LIFT_DROP; "IN_INSERT",IN_INSERT; "IN_INTER",IN_INTER; "IN_INTERIOR",IN_INTERIOR; "IN_INTERIOR_CBALL",IN_INTERIOR_CBALL; "IN_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_INTERIOR_CLOSURE_CONVEX_SEGMENT; "IN_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_INTERIOR_CLOSURE_CONVEX_SHRINK; "IN_INTERIOR_CONIC_CONVEX_HULL_ROWS_QFREE",IN_INTERIOR_CONIC_CONVEX_HULL_ROWS_QFREE; "IN_INTERIOR_CONVEX_SHRINK",IN_INTERIOR_CONVEX_SHRINK; "IN_INTERIOR_EVENTUALLY",IN_INTERIOR_EVENTUALLY; "IN_INTERIOR_LINEAR_IMAGE",IN_INTERIOR_LINEAR_IMAGE; "IN_INTERS",IN_INTERS; "IN_INTERVAL",IN_INTERVAL; "IN_INTERVAL_1",IN_INTERVAL_1; "IN_INTERVAL_INTERVAL_BIJ",IN_INTERVAL_INTERVAL_BIJ; "IN_INTERVAL_REFLECT",IN_INTERVAL_REFLECT; "IN_MBALL",IN_MBALL; "IN_MCBALL",IN_MCBALL; "IN_NUMSEG",IN_NUMSEG; "IN_NUMSEG_0",IN_NUMSEG_0; "IN_OPEN_SEGMENT",IN_OPEN_SEGMENT; "IN_OPEN_SEGMENT_ALT",IN_OPEN_SEGMENT_ALT; "IN_RELATIVE_INTERIOR",IN_RELATIVE_INTERIOR; "IN_RELATIVE_INTERIOR_CBALL",IN_RELATIVE_INTERIOR_CBALL; "IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; "IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK; "IN_RELATIVE_INTERIOR_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CONVEX_SHRINK; "IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT",IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT; "IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_EQ",IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_EQ; "IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_STRONG",IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_STRONG; "IN_RELATIVE_INTERIOR_OF_FACE",IN_RELATIVE_INTERIOR_OF_FACE; "IN_RELATIVE_INTERIOR_OF_UNIQUE_FACE",IN_RELATIVE_INTERIOR_OF_UNIQUE_FACE; "IN_REST",IN_REST; "IN_SEGMENT",IN_SEGMENT; "IN_SEGMENT_COMPONENT",IN_SEGMENT_COMPONENT; "IN_SET_OF_LIST",IN_SET_OF_LIST; "IN_SING",IN_SING; "IN_SPAN_DELETE",IN_SPAN_DELETE; "IN_SPAN_DEPLETED_ROWS_QFREE",IN_SPAN_DEPLETED_ROWS_QFREE; "IN_SPAN_IMAGE_BASIS",IN_SPAN_IMAGE_BASIS; "IN_SPAN_INSERT",IN_SPAN_INSERT; "IN_SPHERE",IN_SPHERE; "IN_SPHERE_0",IN_SPHERE_0; "IN_SUPPORT",IN_SUPPORT; "IN_TRANSLATION_GALOIS",IN_TRANSLATION_GALOIS; "IN_TRANSLATION_GALOIS_ALT",IN_TRANSLATION_GALOIS_ALT; "IN_UNION",IN_UNION; "IN_UNIONS",IN_UNIONS; "IN_UNIV",IN_UNIV; "IRRATIONAL_APPROXIMATION",IRRATIONAL_APPROXIMATION; "IRRATIONAL_APPROXIMATION_ABOVE",IRRATIONAL_APPROXIMATION_ABOVE; "IRRATIONAL_APPROXIMATION_BELOW",IRRATIONAL_APPROXIMATION_BELOW; "IRRATIONAL_APPROXIMATION_STRADDLE",IRRATIONAL_APPROXIMATION_STRADDLE; "IRRATIONAL_BETWEEN",IRRATIONAL_BETWEEN; "IRRATIONAL_BETWEEN_EQ",IRRATIONAL_BETWEEN_EQ; "ISO",ISO; "ISOMETRIC_HOMEOMORPHISM_AFFINE",ISOMETRIC_HOMEOMORPHISM_AFFINE; "ISOMETRIES_SUBSPACES",ISOMETRIES_SUBSPACES; "ISOMETRY_IMP_AFFINITY",ISOMETRY_IMP_AFFINITY; "ISOMETRY_IMP_EMBEDDING",ISOMETRY_IMP_EMBEDDING; "ISOMETRY_IMP_HOMEOMORPHISM_COMPACT",ISOMETRY_IMP_HOMEOMORPHISM_COMPACT; "ISOMETRY_IMP_OPEN_MAP",ISOMETRY_IMP_OPEN_MAP; "ISOMETRY_LINEAR",ISOMETRY_LINEAR; "ISOMETRY_ON_IMP_CONTINUOUS_ON",ISOMETRY_ON_IMP_CONTINUOUS_ON; "ISOMETRY_SPHERE_EXTEND",ISOMETRY_SPHERE_EXTEND; "ISOMETRY_SUBSET_SUBSPACE",ISOMETRY_SUBSET_SUBSPACE; "ISOMETRY_SUBSPACES",ISOMETRY_SUBSPACES; "ISOMETRY_UNIV_SUBSPACE",ISOMETRY_UNIV_SUBSPACE; "ISOMETRY_UNIV_SUPERSET_SUBSPACE",ISOMETRY_UNIV_SUPERSET_SUBSPACE; "ISOMETRY_UNIV_UNIV",ISOMETRY_UNIV_UNIV; "ISOMORPHISMS_UNIV_UNIV",ISOMORPHISMS_UNIV_UNIV; "ISOMORPHISM_EXPAND",ISOMORPHISM_EXPAND; "ISO_FUN",ISO_FUN; "ISO_REFL",ISO_REFL; "ISO_USAGE",ISO_USAGE; "ISTOPLOGY_SUBTOPOLOGY",ISTOPLOGY_SUBTOPOLOGY; "ISTOPOLOGY_OPEN_IN",ISTOPOLOGY_OPEN_IN; "IS_AFFINE_HULL",IS_AFFINE_HULL; "IS_CONVEX_HULL",IS_CONVEX_HULL; "IS_HULL",IS_HULL; "IS_INTERVAL_1",IS_INTERVAL_1; "IS_INTERVAL_1_CASES",IS_INTERVAL_1_CASES; "IS_INTERVAL_1_CLAUSES",IS_INTERVAL_1_CLAUSES; "IS_INTERVAL_CLOSURE",IS_INTERVAL_CLOSURE; "IS_INTERVAL_COMPACT",IS_INTERVAL_COMPACT; "IS_INTERVAL_CONNECTED",IS_INTERVAL_CONNECTED; "IS_INTERVAL_CONNECTED_1",IS_INTERVAL_CONNECTED_1; "IS_INTERVAL_CONTRACTIBLE_1",IS_INTERVAL_CONTRACTIBLE_1; "IS_INTERVAL_CONVEX",IS_INTERVAL_CONVEX; "IS_INTERVAL_CONVEX_1",IS_INTERVAL_CONVEX_1; "IS_INTERVAL_EMPTY",IS_INTERVAL_EMPTY; "IS_INTERVAL_IMP_BAIRE1_INDICATOR",IS_INTERVAL_IMP_BAIRE1_INDICATOR; "IS_INTERVAL_IMP_ENR",IS_INTERVAL_IMP_ENR; "IS_INTERVAL_IMP_FSIGMA",IS_INTERVAL_IMP_FSIGMA; "IS_INTERVAL_IMP_GDELTA",IS_INTERVAL_IMP_GDELTA; "IS_INTERVAL_IMP_LOCALLY_COMPACT",IS_INTERVAL_IMP_LOCALLY_COMPACT; "IS_INTERVAL_INTER",IS_INTERVAL_INTER; "IS_INTERVAL_INTERIOR",IS_INTERVAL_INTERIOR; "IS_INTERVAL_INTERVAL",IS_INTERVAL_INTERVAL; "IS_INTERVAL_LOCALLY_COMPACT_INTERVAL",IS_INTERVAL_LOCALLY_COMPACT_INTERVAL; "IS_INTERVAL_PATH_CONNECTED",IS_INTERVAL_PATH_CONNECTED; "IS_INTERVAL_PATH_CONNECTED_1",IS_INTERVAL_PATH_CONNECTED_1; "IS_INTERVAL_PCROSS",IS_INTERVAL_PCROSS; "IS_INTERVAL_PCROSS_EQ",IS_INTERVAL_PCROSS_EQ; "IS_INTERVAL_POINTWISE",IS_INTERVAL_POINTWISE; "IS_INTERVAL_REFLECT",IS_INTERVAL_REFLECT; "IS_INTERVAL_RELATIVE_INTERIOR",IS_INTERVAL_RELATIVE_INTERIOR; "IS_INTERVAL_SCALING",IS_INTERVAL_SCALING; "IS_INTERVAL_SCALING_EQ",IS_INTERVAL_SCALING_EQ; "IS_INTERVAL_SIMPLY_CONNECTED_1",IS_INTERVAL_SIMPLY_CONNECTED_1; "IS_INTERVAL_SING",IS_INTERVAL_SING; "IS_INTERVAL_SUMS",IS_INTERVAL_SUMS; "IS_INTERVAL_TRANSLATION",IS_INTERVAL_TRANSLATION; "IS_INTERVAL_TRANSLATION_EQ",IS_INTERVAL_TRANSLATION_EQ; "IS_INTERVAL_UNIV",IS_INTERVAL_UNIV; "IS_METRIC_SPACE_SUBSPACE",IS_METRIC_SPACE_SUBSPACE; "IS_TOPOLOGY_METRIC_TOPOLOGY",IS_TOPOLOGY_METRIC_TOPOLOGY; "ITER",ITER; "ITERATE_AND",ITERATE_AND; "ITERATE_BIJECTION",ITERATE_BIJECTION; "ITERATE_CASES",ITERATE_CASES; "ITERATE_CLAUSES",ITERATE_CLAUSES; "ITERATE_CLAUSES_GEN",ITERATE_CLAUSES_GEN; "ITERATE_CLAUSES_NUMSEG",ITERATE_CLAUSES_NUMSEG; "ITERATE_CLOSED",ITERATE_CLOSED; "ITERATE_DELETE",ITERATE_DELETE; "ITERATE_DELTA",ITERATE_DELTA; "ITERATE_DIFF",ITERATE_DIFF; "ITERATE_DIFF_GEN",ITERATE_DIFF_GEN; "ITERATE_EQ",ITERATE_EQ; "ITERATE_EQ_GENERAL",ITERATE_EQ_GENERAL; "ITERATE_EQ_GENERAL_INVERSES",ITERATE_EQ_GENERAL_INVERSES; "ITERATE_EQ_NEUTRAL",ITERATE_EQ_NEUTRAL; "ITERATE_EXPAND_CASES",ITERATE_EXPAND_CASES; "ITERATE_IMAGE",ITERATE_IMAGE; "ITERATE_IMAGE_GEN",ITERATE_IMAGE_GEN; "ITERATE_IMAGE_NONZERO",ITERATE_IMAGE_NONZERO; "ITERATE_INCL_EXCL",ITERATE_INCL_EXCL; "ITERATE_INJECTION",ITERATE_INJECTION; "ITERATE_ITERATE_PRODUCT",ITERATE_ITERATE_PRODUCT; "ITERATE_NONZERO_IMAGE_LEMMA",ITERATE_NONZERO_IMAGE_LEMMA; "ITERATE_OP",ITERATE_OP; "ITERATE_OP_GEN",ITERATE_OP_GEN; "ITERATE_PAIR",ITERATE_PAIR; "ITERATE_PERMUTE",ITERATE_PERMUTE; "ITERATE_REFLECT",ITERATE_REFLECT; "ITERATE_RELATED",ITERATE_RELATED; "ITERATE_RESTRICT_SET",ITERATE_RESTRICT_SET; "ITERATE_SING",ITERATE_SING; "ITERATE_SOME",ITERATE_SOME; "ITERATE_SUPERSET",ITERATE_SUPERSET; "ITERATE_SUPPORT",ITERATE_SUPPORT; "ITERATE_SWAP",ITERATE_SWAP; "ITERATE_UNION",ITERATE_UNION; "ITERATE_UNION_GEN",ITERATE_UNION_GEN; "ITERATE_UNION_NONZERO",ITERATE_UNION_NONZERO; "ITERATE_UNIV",ITERATE_UNIV; "ITER_1",ITER_1; "ITER_ADD",ITER_ADD; "ITER_ADD_POINTLESS",ITER_ADD_POINTLESS; "ITER_ALT",ITER_ALT; "ITER_ALT_POINTLESS",ITER_ALT_POINTLESS; "ITER_FIXPOINT",ITER_FIXPOINT; "ITER_MUL",ITER_MUL; "ITER_POINTLESS",ITER_POINTLESS; "ITLIST",ITLIST; "ITLIST2",ITLIST2; "ITLIST2_DEF",ITLIST2_DEF; "ITLIST_APPEND",ITLIST_APPEND; "ITLIST_EXTRA",ITLIST_EXTRA; "ITSET",ITSET; "ITSET_EQ",ITSET_EQ; "IVT_DECREASING_COMPONENT_1",IVT_DECREASING_COMPONENT_1; "IVT_DECREASING_COMPONENT_ON_1",IVT_DECREASING_COMPONENT_ON_1; "IVT_INCREASING_COMPONENT_1",IVT_INCREASING_COMPONENT_1; "IVT_INCREASING_COMPONENT_ON_1",IVT_INCREASING_COMPONENT_ON_1; "I_DEF",I_DEF; "I_O_ID",I_O_ID; "I_THM",I_THM; "JACOBIAN_SIGN_INVARIANCE",JACOBIAN_SIGN_INVARIANCE; "JACOBIAN_WORKS",JACOBIAN_WORKS; "JOINABLE_COMPONENTS_EQ",JOINABLE_COMPONENTS_EQ; "JOINABLE_CONNECTED_COMPONENT_EQ",JOINABLE_CONNECTED_COMPONENT_EQ; "JOINPATHS",JOINPATHS; "JOINPATHS_LINEAR_IMAGE",JOINPATHS_LINEAR_IMAGE; "JOINPATHS_TRANSLATION",JOINPATHS_TRANSLATION; "JOIN_PATHS_EQ",JOIN_PATHS_EQ; "JOIN_SUBPATHS_MIDDLE",JOIN_SUBPATHS_MIDDLE; "JUNG",JUNG; "KERNEL_MATRIX_INV",KERNEL_MATRIX_INV; "KIRCHBERGER",KIRCHBERGER; "KIRSZBRAUN",KIRSZBRAUN; "KL",KL; "KL_POSET_LEMMA",KL_POSET_LEMMA; "KREIN_MILMAN",KREIN_MILMAN; "KREIN_MILMAN_EQ",KREIN_MILMAN_EQ; "KREIN_MILMAN_FRONTIER",KREIN_MILMAN_FRONTIER; "KREIN_MILMAN_MINKOWSKI",KREIN_MILMAN_MINKOWSKI; "KREIN_MILMAN_POLYTOPE",KREIN_MILMAN_POLYTOPE; "KREIN_MILMAN_RELATIVE_BOUNDARY",KREIN_MILMAN_RELATIVE_BOUNDARY; "KREIN_MILMAN_RELATIVE_FRONTIER",KREIN_MILMAN_RELATIVE_FRONTIER; "L1_LE_NORM",L1_LE_NORM; "LAMBDA_ADD_GALOIS",LAMBDA_ADD_GALOIS; "LAMBDA_BETA",LAMBDA_BETA; "LAMBDA_BETA_PERM",LAMBDA_BETA_PERM; "LAMBDA_ETA",LAMBDA_ETA; "LAMBDA_PAIR",LAMBDA_PAIR; "LAMBDA_PAIR_THM",LAMBDA_PAIR_THM; "LAMBDA_SKOLEM",LAMBDA_SKOLEM; "LAMBDA_SWAP_GALOIS",LAMBDA_SWAP_GALOIS; "LAMBDA_UNIQUE",LAMBDA_UNIQUE; "LAMBDA_UNPAIR_THM",LAMBDA_UNPAIR_THM; "LARGE_INDUCTIVE_DIMENSION",LARGE_INDUCTIVE_DIMENSION; "LAST",LAST; "LAST_APPEND",LAST_APPEND; "LAST_CLAUSES",LAST_CLAUSES; "LAST_EL",LAST_EL; "LAVRENTIEV",LAVRENTIEV; "LAVRENTIEV_BOREL",LAVRENTIEV_BOREL; "LAVRENTIEV_HOMEOMORPHISM",LAVRENTIEV_HOMEOMORPHISM; "LAVRENTIEV_HOMEOMORPHISM_SELF",LAVRENTIEV_HOMEOMORPHISM_SELF; "LDIV_LT_EQ",LDIV_LT_EQ; "LE",LE; "LEBESGUE_COVERING_LEMMA",LEBESGUE_COVERING_LEMMA; "LEBESGUE_COVERING_LEMMA_GEN",LEBESGUE_COVERING_LEMMA_GEN; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_BALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_BALL; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_CBALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_CBALL; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_BALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_BALL; "LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_CBALL",LEBESGUE_DENSITY_THEOREM_INTEGRAL_NORM_CBALL; "LEBESGUE_DENSITY_THEOREM_LIFT_BALL",LEBESGUE_DENSITY_THEOREM_LIFT_BALL; "LEBESGUE_DENSITY_THEOREM_LIFT_CBALL",LEBESGUE_DENSITY_THEOREM_LIFT_CBALL; "LEBESGUE_DIFFERENTIATION_THEOREM",LEBESGUE_DIFFERENTIATION_THEOREM; "LEBESGUE_DIFFERENTIATION_THEOREM_ALT",LEBESGUE_DIFFERENTIATION_THEOREM_ALT; "LEBESGUE_DIFFERENTIATION_THEOREM_COMPACT",LEBESGUE_DIFFERENTIATION_THEOREM_COMPACT; "LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING",LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING; "LEBESGUE_DIFFERENTIATION_THEOREM_GEN",LEBESGUE_DIFFERENTIATION_THEOREM_GEN; "LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING",LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING; "LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE",LEBESGUE_MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE; "LEBESGUE_MEASURABLE_ALMOST_FSIGMA",LEBESGUE_MEASURABLE_ALMOST_FSIGMA; "LEBESGUE_MEASURABLE_ALMOST_GDELTA",LEBESGUE_MEASURABLE_ALMOST_GDELTA; "LEBESGUE_MEASURABLE_BALL",LEBESGUE_MEASURABLE_BALL; "LEBESGUE_MEASURABLE_CBALL",LEBESGUE_MEASURABLE_CBALL; "LEBESGUE_MEASURABLE_CLOSED",LEBESGUE_MEASURABLE_CLOSED; "LEBESGUE_MEASURABLE_CLOSED_IN",LEBESGUE_MEASURABLE_CLOSED_IN; "LEBESGUE_MEASURABLE_COMPACT",LEBESGUE_MEASURABLE_COMPACT; "LEBESGUE_MEASURABLE_COMPL",LEBESGUE_MEASURABLE_COMPL; "LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE",LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE; "LEBESGUE_MEASURABLE_CONVEX",LEBESGUE_MEASURABLE_CONVEX; "LEBESGUE_MEASURABLE_COUNTABLE_INTERS",LEBESGUE_MEASURABLE_COUNTABLE_INTERS; "LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT; "LEBESGUE_MEASURABLE_COUNTABLE_UNIONS",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS; "LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; "LEBESGUE_MEASURABLE_DELETE",LEBESGUE_MEASURABLE_DELETE; "LEBESGUE_MEASURABLE_DIFF",LEBESGUE_MEASURABLE_DIFF; "LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE",LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE; "LEBESGUE_MEASURABLE_DOMAIN_OF_INJECTIVITY",LEBESGUE_MEASURABLE_DOMAIN_OF_INJECTIVITY; "LEBESGUE_MEASURABLE_EMPTY",LEBESGUE_MEASURABLE_EMPTY; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT; "LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ; "LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ; "LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ; "LEBESGUE_MEASURABLE_IFF_MEASURABLE",LEBESGUE_MEASURABLE_IFF_MEASURABLE; "LEBESGUE_MEASURABLE_INNER_CLOSED",LEBESGUE_MEASURABLE_INNER_CLOSED; "LEBESGUE_MEASURABLE_INNER_COMPACT",LEBESGUE_MEASURABLE_INNER_COMPACT; "LEBESGUE_MEASURABLE_INSERT",LEBESGUE_MEASURABLE_INSERT; "LEBESGUE_MEASURABLE_INTER",LEBESGUE_MEASURABLE_INTER; "LEBESGUE_MEASURABLE_INTERS",LEBESGUE_MEASURABLE_INTERS; "LEBESGUE_MEASURABLE_INTERVAL",LEBESGUE_MEASURABLE_INTERVAL; "LEBESGUE_MEASURABLE_JORDAN",LEBESGUE_MEASURABLE_JORDAN; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_BOREL",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_BOREL; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; "LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; "LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ; "LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN; "LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; "LEBESGUE_MEASURABLE_LIPSCHITZ_IMAGE",LEBESGUE_MEASURABLE_LIPSCHITZ_IMAGE; "LEBESGUE_MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE",LEBESGUE_MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE; "LEBESGUE_MEASURABLE_MEASURABLE_IMAGE",LEBESGUE_MEASURABLE_MEASURABLE_IMAGE; "LEBESGUE_MEASURABLE_MEASURABLE_INTER_EQ",LEBESGUE_MEASURABLE_MEASURABLE_INTER_EQ; "LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS; "LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS; "LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF",LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF; "LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ",LEBESGUE_MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ; "LEBESGUE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_ON_SUBINTERVALS; "LEBESGUE_MEASURABLE_OPEN",LEBESGUE_MEASURABLE_OPEN; "LEBESGUE_MEASURABLE_OPEN_IN",LEBESGUE_MEASURABLE_OPEN_IN; "LEBESGUE_MEASURABLE_OUTER_OPEN",LEBESGUE_MEASURABLE_OUTER_OPEN; "LEBESGUE_MEASURABLE_PCROSS",LEBESGUE_MEASURABLE_PCROSS; "LEBESGUE_MEASURABLE_POINTS_OF_CONVERGENCE",LEBESGUE_MEASURABLE_POINTS_OF_CONVERGENCE; "LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_AT",LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_AT; "LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_WITHIN",LEBESGUE_MEASURABLE_POINTS_OF_DIFFERENTIABILITY_WITHIN; "LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC",LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC; "LEBESGUE_MEASURABLE_PREIMAGE_BOREL",LEBESGUE_MEASURABLE_PREIMAGE_BOREL; "LEBESGUE_MEASURABLE_PREIMAGE_CARD_LE",LEBESGUE_MEASURABLE_PREIMAGE_CARD_LE; "LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; "LEBESGUE_MEASURABLE_PREIMAGE_FINITE",LEBESGUE_MEASURABLE_PREIMAGE_FINITE; "LEBESGUE_MEASURABLE_PREIMAGE_HAS_SIZE",LEBESGUE_MEASURABLE_PREIMAGE_HAS_SIZE; "LEBESGUE_MEASURABLE_PREIMAGE_INFINITE",LEBESGUE_MEASURABLE_PREIMAGE_INFINITE; "LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_PREIMAGE_OPEN; "LEBESGUE_MEASURABLE_REGULAR_INNER",LEBESGUE_MEASURABLE_REGULAR_INNER; "LEBESGUE_MEASURABLE_REGULAR_OUTER",LEBESGUE_MEASURABLE_REGULAR_OUTER; "LEBESGUE_MEASURABLE_SMALL_IMP_NEGLIGIBLE",LEBESGUE_MEASURABLE_SMALL_IMP_NEGLIGIBLE; "LEBESGUE_MEASURABLE_TRANSLATION",LEBESGUE_MEASURABLE_TRANSLATION; "LEBESGUE_MEASURABLE_UNION",LEBESGUE_MEASURABLE_UNION; "LEBESGUE_MEASURABLE_UNIONS",LEBESGUE_MEASURABLE_UNIONS; "LEBESGUE_MEASURABLE_UNIV",LEBESGUE_MEASURABLE_UNIV; "LEFT_ADD_DISTRIB",LEFT_ADD_DISTRIB; "LEFT_AND_EXISTS_THM",LEFT_AND_EXISTS_THM; "LEFT_AND_FORALL_THM",LEFT_AND_FORALL_THM; "LEFT_EXISTS_AND_THM",LEFT_EXISTS_AND_THM; "LEFT_EXISTS_IMP_THM",LEFT_EXISTS_IMP_THM; "LEFT_FORALL_IMP_THM",LEFT_FORALL_IMP_THM; "LEFT_FORALL_OR_THM",LEFT_FORALL_OR_THM; "LEFT_IMP_EXISTS_THM",LEFT_IMP_EXISTS_THM; "LEFT_IMP_FORALL_THM",LEFT_IMP_FORALL_THM; "LEFT_INVERSE_LINEAR",LEFT_INVERSE_LINEAR; "LEFT_INVERTIBLE_TRANSP",LEFT_INVERTIBLE_TRANSP; "LEFT_OR_DISTRIB",LEFT_OR_DISTRIB; "LEFT_OR_EXISTS_THM",LEFT_OR_EXISTS_THM; "LEFT_OR_FORALL_THM",LEFT_OR_FORALL_THM; "LEFT_POLAR_DECOMPOSITION",LEFT_POLAR_DECOMPOSITION; "LEFT_POLAR_DECOMPOSITION_INVERTIBLE",LEFT_POLAR_DECOMPOSITION_INVERTIBLE; "LEFT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE",LEFT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE; "LEFT_POLAR_DECOMPOSITION_UNIQUE",LEFT_POLAR_DECOMPOSITION_UNIQUE; "LEFT_RIGHT_INVERSE_EQ",LEFT_RIGHT_INVERSE_EQ; "LEFT_RIGHT_INVERSE_LINEAR",LEFT_RIGHT_INVERSE_LINEAR; "LEFT_SUB_DISTRIB",LEFT_SUB_DISTRIB; "LENGTH",LENGTH; "LENGTH_APPEND",LENGTH_APPEND; "LENGTH_EQ_CONS",LENGTH_EQ_CONS; "LENGTH_EQ_NIL",LENGTH_EQ_NIL; "LENGTH_LIST_OF_SEQ",LENGTH_LIST_OF_SEQ; "LENGTH_LIST_OF_SET",LENGTH_LIST_OF_SET; "LENGTH_MAP",LENGTH_MAP; "LENGTH_MAP2",LENGTH_MAP2; "LENGTH_REPLICATE",LENGTH_REPLICATE; "LENGTH_TL",LENGTH_TL; "LENGTH_ZIP",LENGTH_ZIP; "LET_ADD2",LET_ADD2; "LET_ANTISYM",LET_ANTISYM; "LET_CASES",LET_CASES; "LET_DEF",LET_DEF; "LET_END_DEF",LET_END_DEF; "LET_TRANS",LET_TRANS; "LE_0",LE_0; "LE_1",LE_1; "LE_ADD",LE_ADD; "LE_ADD2",LE_ADD2; "LE_ADDR",LE_ADDR; "LE_ADD_LCANCEL",LE_ADD_LCANCEL; "LE_ADD_RCANCEL",LE_ADD_RCANCEL; "LE_ANTISYM",LE_ANTISYM; "LE_C",LE_C; "LE_CASES",LE_CASES; "LE_C_IMAGE",LE_C_IMAGE; "LE_C_IMAGE_SUBSET",LE_C_IMAGE_SUBSET; "LE_EXISTS",LE_EXISTS; "LE_EXP",LE_EXP; "LE_INDUCT",LE_INDUCT; "LE_LDIV",LE_LDIV; "LE_LDIV_EQ",LE_LDIV_EQ; "LE_LT",LE_LT; "LE_MULT2",LE_MULT2; "LE_MULT_LCANCEL",LE_MULT_LCANCEL; "LE_MULT_RCANCEL",LE_MULT_RCANCEL; "LE_RDIV_EQ",LE_RDIV_EQ; "LE_REFL",LE_REFL; "LE_SQUARE_REFL",LE_SQUARE_REFL; "LE_SUC",LE_SUC; "LE_SUC_LT",LE_SUC_LT; "LE_TRANS",LE_TRANS; "LIEB",LIEB; "LIFT_ADD",LIFT_ADD; "LIFT_CMUL",LIFT_CMUL; "LIFT_COMPONENT",LIFT_COMPONENT; "LIFT_DROP",LIFT_DROP; "LIFT_EQ",LIFT_EQ; "LIFT_EQ_CMUL",LIFT_EQ_CMUL; "LIFT_INTEGRAL_COMPONENT",LIFT_INTEGRAL_COMPONENT; "LIFT_IN_IMAGE_LIFT",LIFT_IN_IMAGE_LIFT; "LIFT_NEG",LIFT_NEG; "LIFT_NUM",LIFT_NUM; "LIFT_SUB",LIFT_SUB; "LIFT_SUM",LIFT_SUM; "LIFT_TO_QUOTIENT_SPACE",LIFT_TO_QUOTIENT_SPACE; "LIFT_TO_QUOTIENT_SPACE_UNIQUE",LIFT_TO_QUOTIENT_SPACE_UNIQUE; "LIM",LIM; "LIMIT_EUCLIDEAN",LIMIT_EUCLIDEAN; "LIMIT_HAUSDORFF_UNIQUE",LIMIT_HAUSDORFF_UNIQUE; "LIMIT_IN_CLOSED_IN",LIMIT_IN_CLOSED_IN; "LIMIT_IN_MSPACE",LIMIT_IN_MSPACE; "LIMIT_IN_TOPSPACE",LIMIT_IN_TOPSPACE; "LIMIT_METRIC",LIMIT_METRIC; "LIMIT_METRIC_SEQUENTIALLY",LIMIT_METRIC_SEQUENTIALLY; "LIMIT_METRIC_UNIQUE",LIMIT_METRIC_UNIQUE; "LIMIT_PAIR_DROP_LE",LIMIT_PAIR_DROP_LE; "LIMIT_POINT_FINITE",LIMIT_POINT_FINITE; "LIMIT_POINT_IN_DERIVED_SET",LIMIT_POINT_IN_DERIVED_SET; "LIMIT_POINT_OF_IMAGE",LIMIT_POINT_OF_IMAGE; "LIMIT_POINT_OF_IMAGE_GEN",LIMIT_POINT_OF_IMAGE_GEN; "LIMIT_POINT_OF_LOCAL",LIMIT_POINT_OF_LOCAL; "LIMIT_POINT_OF_LOCAL_IMP",LIMIT_POINT_OF_LOCAL_IMP; "LIMIT_POINT_OF_SPHERE",LIMIT_POINT_OF_SPHERE; "LIMIT_POINT_UNION",LIMIT_POINT_UNION; "LIMIT_POINT_UNIONS",LIMIT_POINT_UNIONS; "LIMIT_SEQUENTIALLY",LIMIT_SEQUENTIALLY; "LIMIT_SEQUENTIALLY_OFFSET",LIMIT_SEQUENTIALLY_OFFSET; "LIMIT_SEQUENTIALLY_OFFSET_REV",LIMIT_SEQUENTIALLY_OFFSET_REV; "LIMIT_SUBMETRIC_IFF",LIMIT_SUBMETRIC_IFF; "LIMPT_APPROACHABLE",LIMPT_APPROACHABLE; "LIMPT_APPROACHABLE_LE",LIMPT_APPROACHABLE_LE; "LIMPT_APPROACHABLE_LIFT",LIMPT_APPROACHABLE_LIFT; "LIMPT_BALL",LIMPT_BALL; "LIMPT_DELETE",LIMPT_DELETE; "LIMPT_EMPTY",LIMPT_EMPTY; "LIMPT_INFINITE_BALL",LIMPT_INFINITE_BALL; "LIMPT_INFINITE_CBALL",LIMPT_INFINITE_CBALL; "LIMPT_INFINITE_OPEN",LIMPT_INFINITE_OPEN; "LIMPT_INJECTIVE_LINEAR_IMAGE_EQ",LIMPT_INJECTIVE_LINEAR_IMAGE_EQ; "LIMPT_INSERT",LIMPT_INSERT; "LIMPT_OF_CLOSURE",LIMPT_OF_CLOSURE; "LIMPT_OF_CONDENSATION_POINTS",LIMPT_OF_CONDENSATION_POINTS; "LIMPT_OF_CONVEX",LIMPT_OF_CONVEX; "LIMPT_OF_LIMPTS",LIMPT_OF_LIMPTS; "LIMPT_OF_OPEN",LIMPT_OF_OPEN; "LIMPT_OF_OPEN_CLOSURE",LIMPT_OF_OPEN_CLOSURE; "LIMPT_OF_OPEN_IN",LIMPT_OF_OPEN_IN; "LIMPT_OF_SEQUENCE_SUBSEQUENCE",LIMPT_OF_SEQUENCE_SUBSEQUENCE; "LIMPT_OF_UNIV",LIMPT_OF_UNIV; "LIMPT_PCROSS",LIMPT_PCROSS; "LIMPT_SEQUENTIAL",LIMPT_SEQUENTIAL; "LIMPT_SEQUENTIAL_DECREASING",LIMPT_SEQUENTIAL_DECREASING; "LIMPT_SEQUENTIAL_INJ",LIMPT_SEQUENTIAL_INJ; "LIMPT_SING",LIMPT_SING; "LIMPT_SUBSET",LIMPT_SUBSET; "LIMPT_TRANSLATION_EQ",LIMPT_TRANSLATION_EQ; "LIM_ABS",LIM_ABS; "LIM_ADD",LIM_ADD; "LIM_AT",LIM_AT; "LIM_AT_ID",LIM_AT_ID; "LIM_AT_INFINITY",LIM_AT_INFINITY; "LIM_AT_INFINITY_POS",LIM_AT_INFINITY_POS; "LIM_AT_INFINITY_WITHIN",LIM_AT_INFINITY_WITHIN; "LIM_AT_INFINITY_WITHIN_POS",LIM_AT_INFINITY_WITHIN_POS; "LIM_AT_LE",LIM_AT_LE; "LIM_AT_NEGINFINITY",LIM_AT_NEGINFINITY; "LIM_AT_POSINFINITY",LIM_AT_POSINFINITY; "LIM_AT_REFLECT",LIM_AT_REFLECT; "LIM_AT_SEQUENTIALLY",LIM_AT_SEQUENTIALLY; "LIM_AT_WITHIN",LIM_AT_WITHIN; "LIM_AT_ZERO",LIM_AT_ZERO; "LIM_BILINEAR",LIM_BILINEAR; "LIM_BILINEAR_CONVOLUTION",LIM_BILINEAR_CONVOLUTION; "LIM_CASES_COFINITE_SEQUENTIALLY",LIM_CASES_COFINITE_SEQUENTIALLY; "LIM_CASES_FINITE_SEQUENTIALLY",LIM_CASES_FINITE_SEQUENTIALLY; "LIM_CASES_SEQUENTIALLY",LIM_CASES_SEQUENTIALLY; "LIM_CESARO",LIM_CESARO; "LIM_CMUL",LIM_CMUL; "LIM_CMUL_EQ",LIM_CMUL_EQ; "LIM_COFACTOR",LIM_COFACTOR; "LIM_COMPONENT",LIM_COMPONENT; "LIM_COMPONENTWISE_LIFT",LIM_COMPONENTWISE_LIFT; "LIM_COMPONENT_EQ",LIM_COMPONENT_EQ; "LIM_COMPONENT_LBOUND",LIM_COMPONENT_LBOUND; "LIM_COMPONENT_LE",LIM_COMPONENT_LE; "LIM_COMPONENT_UBOUND",LIM_COMPONENT_UBOUND; "LIM_COMPOSE_AT",LIM_COMPOSE_AT; "LIM_COMPOSE_WITHIN",LIM_COMPOSE_WITHIN; "LIM_CONG_AT",LIM_CONG_AT; "LIM_CONG_WITHIN",LIM_CONG_WITHIN; "LIM_CONST",LIM_CONST; "LIM_CONST_EQ",LIM_CONST_EQ; "LIM_CONTINUOUS",LIM_CONTINUOUS; "LIM_CONTINUOUS_FUNCTION",LIM_CONTINUOUS_FUNCTION; "LIM_CONTINUOUS_FUNCTION_WITHIN",LIM_CONTINUOUS_FUNCTION_WITHIN; "LIM_CONTINUOUS_SELF_AT",LIM_CONTINUOUS_SELF_AT; "LIM_CONTINUOUS_SELF_WITHIN",LIM_CONTINUOUS_SELF_WITHIN; "LIM_DROP_LBOUND",LIM_DROP_LBOUND; "LIM_DROP_LE",LIM_DROP_LE; "LIM_DROP_UBOUND",LIM_DROP_UBOUND; "LIM_EVENTUALLY",LIM_EVENTUALLY; "LIM_EVENTUALLY_IN_OPEN",LIM_EVENTUALLY_IN_OPEN; "LIM_EVENTUALLY_IN_OPEN_IN",LIM_EVENTUALLY_IN_OPEN_IN; "LIM_INFINITY_POSINFINITY_LIFT",LIM_INFINITY_POSINFINITY_LIFT; "LIM_INV",LIM_INV; "LIM_IN_CLOSED_SET",LIM_IN_CLOSED_SET; "LIM_LIFT_ABS_COMPONENT",LIM_LIFT_ABS_COMPONENT; "LIM_LIFT_DET",LIM_LIFT_DET; "LIM_LIFT_DOT",LIM_LIFT_DOT; "LIM_LIFT_POW",LIM_LIFT_POW; "LIM_LIFT_PRODUCT",LIM_LIFT_PRODUCT; "LIM_LINEAR",LIM_LINEAR; "LIM_MATRIX_COMPONENTWISE",LIM_MATRIX_COMPONENTWISE; "LIM_MATRIX_INV",LIM_MATRIX_INV; "LIM_MATRIX_TRANSP",LIM_MATRIX_TRANSP; "LIM_MAX",LIM_MAX; "LIM_MIN",LIM_MIN; "LIM_MUL",LIM_MUL; "LIM_MUL_NORM_WITHIN",LIM_MUL_NORM_WITHIN; "LIM_NEG",LIM_NEG; "LIM_NEG_EQ",LIM_NEG_EQ; "LIM_NORM",LIM_NORM; "LIM_NORM_LBOUND",LIM_NORM_LBOUND; "LIM_NORM_UBOUND",LIM_NORM_UBOUND; "LIM_NULL",LIM_NULL; "LIM_NULL_ADD",LIM_NULL_ADD; "LIM_NULL_CMUL",LIM_NULL_CMUL; "LIM_NULL_CMUL_BOUNDED",LIM_NULL_CMUL_BOUNDED; "LIM_NULL_CMUL_EQ",LIM_NULL_CMUL_EQ; "LIM_NULL_COMPARISON",LIM_NULL_COMPARISON; "LIM_NULL_MATRIX_ONORM",LIM_NULL_MATRIX_ONORM; "LIM_NULL_MATRIX_ONORM_COMPONENTWISE",LIM_NULL_MATRIX_ONORM_COMPONENTWISE; "LIM_NULL_NEG",LIM_NULL_NEG; "LIM_NULL_NORM",LIM_NULL_NORM; "LIM_NULL_ONORM",LIM_NULL_ONORM; "LIM_NULL_ONORM_COMPONENTWISE",LIM_NULL_ONORM_COMPONENTWISE; "LIM_NULL_SUB",LIM_NULL_SUB; "LIM_NULL_VMUL",LIM_NULL_VMUL; "LIM_NULL_VMUL_BOUNDED",LIM_NULL_VMUL_BOUNDED; "LIM_NULL_VMUL_EQ",LIM_NULL_VMUL_EQ; "LIM_NULL_VSUM",LIM_NULL_VSUM; "LIM_PASTECART",LIM_PASTECART; "LIM_PASTECART_EQ",LIM_PASTECART_EQ; "LIM_POSINFINITY_SEQUENTIALLY",LIM_POSINFINITY_SEQUENTIALLY; "LIM_SELF_AT",LIM_SELF_AT; "LIM_SELF_WITHIN",LIM_SELF_WITHIN; "LIM_SEQUENTIALLY",LIM_SEQUENTIALLY; "LIM_SUB",LIM_SUB; "LIM_SUBSEQUENCE",LIM_SUBSEQUENCE; "LIM_TRANSFORM",LIM_TRANSFORM; "LIM_TRANSFORM_AT",LIM_TRANSFORM_AT; "LIM_TRANSFORM_AWAY_AT",LIM_TRANSFORM_AWAY_AT; "LIM_TRANSFORM_AWAY_WITHIN",LIM_TRANSFORM_AWAY_WITHIN; "LIM_TRANSFORM_BOUND",LIM_TRANSFORM_BOUND; "LIM_TRANSFORM_EQ",LIM_TRANSFORM_EQ; "LIM_TRANSFORM_EVENTUALLY",LIM_TRANSFORM_EVENTUALLY; "LIM_TRANSFORM_WITHIN",LIM_TRANSFORM_WITHIN; "LIM_TRANSFORM_WITHIN_OPEN",LIM_TRANSFORM_WITHIN_OPEN; "LIM_TRANSFORM_WITHIN_OPEN_IN",LIM_TRANSFORM_WITHIN_OPEN_IN; "LIM_TRANSFORM_WITHIN_SET",LIM_TRANSFORM_WITHIN_SET; "LIM_TRANSFORM_WITHIN_SET_IMP",LIM_TRANSFORM_WITHIN_SET_IMP; "LIM_UNION",LIM_UNION; "LIM_UNION_UNIV",LIM_UNION_UNIV; "LIM_UNIQUE",LIM_UNIQUE; "LIM_VMUL",LIM_VMUL; "LIM_VSUM",LIM_VSUM; "LIM_WITHIN",LIM_WITHIN; "LIM_WITHIN_CLOSED_TRIVIAL",LIM_WITHIN_CLOSED_TRIVIAL; "LIM_WITHIN_DELETE",LIM_WITHIN_DELETE; "LIM_WITHIN_EMPTY",LIM_WITHIN_EMPTY; "LIM_WITHIN_ID",LIM_WITHIN_ID; "LIM_WITHIN_INTERIOR",LIM_WITHIN_INTERIOR; "LIM_WITHIN_INTERIOR_INTER",LIM_WITHIN_INTERIOR_INTER; "LIM_WITHIN_LE",LIM_WITHIN_LE; "LIM_WITHIN_OPEN",LIM_WITHIN_OPEN; "LIM_WITHIN_OPEN_IN",LIM_WITHIN_OPEN_IN; "LIM_WITHIN_REFLECT",LIM_WITHIN_REFLECT; "LIM_WITHIN_SEQUENTIALLY",LIM_WITHIN_SEQUENTIALLY; "LIM_WITHIN_SEQUENTIALLY_DECREASING",LIM_WITHIN_SEQUENTIALLY_DECREASING; "LIM_WITHIN_SEQUENTIALLY_INJ",LIM_WITHIN_SEQUENTIALLY_INJ; "LIM_WITHIN_SUBSET",LIM_WITHIN_SUBSET; "LIM_WITHIN_UNION",LIM_WITHIN_UNION; "LIM_WITHIN_ZERO",LIM_WITHIN_ZERO; "LINDELOF",LINDELOF; "LINDELOF_OPEN_IN",LINDELOF_OPEN_IN; "LINEAR_0",LINEAR_0; "LINEAR_1",LINEAR_1; "LINEAR_1_GEN",LINEAR_1_GEN; "LINEAR_ADD",LINEAR_ADD; "LINEAR_BIJECTIVE_DIMINDEX_EQ",LINEAR_BIJECTIVE_DIMINDEX_EQ; "LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE",LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE; "LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ",LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ; "LINEAR_BOUNDED",LINEAR_BOUNDED; "LINEAR_BOUNDED_POS",LINEAR_BOUNDED_POS; "LINEAR_CLOSEST_POINT",LINEAR_CLOSEST_POINT; "LINEAR_CMUL",LINEAR_CMUL; "LINEAR_COMPONENTWISE",LINEAR_COMPONENTWISE; "LINEAR_COMPONENTWISE_EXPANSION",LINEAR_COMPONENTWISE_EXPANSION; "LINEAR_COMPOSE",LINEAR_COMPOSE; "LINEAR_COMPOSE_ADD",LINEAR_COMPOSE_ADD; "LINEAR_COMPOSE_CMUL",LINEAR_COMPOSE_CMUL; "LINEAR_COMPOSE_NEG",LINEAR_COMPOSE_NEG; "LINEAR_COMPOSE_NEG_EQ",LINEAR_COMPOSE_NEG_EQ; "LINEAR_COMPOSE_SUB",LINEAR_COMPOSE_SUB; "LINEAR_COMPOSE_VSUM",LINEAR_COMPOSE_VSUM; "LINEAR_CONTINUOUS_AT",LINEAR_CONTINUOUS_AT; "LINEAR_CONTINUOUS_COMPOSE",LINEAR_CONTINUOUS_COMPOSE; "LINEAR_CONTINUOUS_ON",LINEAR_CONTINUOUS_ON; "LINEAR_CONTINUOUS_ON_COMPOSE",LINEAR_CONTINUOUS_ON_COMPOSE; "LINEAR_CONTINUOUS_WITHIN",LINEAR_CONTINUOUS_WITHIN; "LINEAR_CONVEX_ON_1",LINEAR_CONVEX_ON_1; "LINEAR_DROPOUT",LINEAR_DROPOUT; "LINEAR_EQ",LINEAR_EQ; "LINEAR_EQ_0",LINEAR_EQ_0; "LINEAR_EQ_0_SPAN",LINEAR_EQ_0_SPAN; "LINEAR_EQ_MATRIX",LINEAR_EQ_MATRIX; "LINEAR_EQ_MBASIS",LINEAR_EQ_MBASIS; "LINEAR_EQ_STDBASIS",LINEAR_EQ_STDBASIS; "LINEAR_FRECHET_DERIVATIVE",LINEAR_FRECHET_DERIVATIVE; "LINEAR_FROM_1",LINEAR_FROM_1; "LINEAR_FROM_REALS",LINEAR_FROM_REALS; "LINEAR_FSTCART",LINEAR_FSTCART; "LINEAR_I",LINEAR_I; "LINEAR_ID",LINEAR_ID; "LINEAR_IMAGE_SUBSET_INTERIOR",LINEAR_IMAGE_SUBSET_INTERIOR; "LINEAR_IMP_CONVEX_ON",LINEAR_IMP_CONVEX_ON; "LINEAR_IMP_HAS_BOUNDED_VARIATION",LINEAR_IMP_HAS_BOUNDED_VARIATION; "LINEAR_IMP_HOMEOMORPHISM",LINEAR_IMP_HOMEOMORPHISM; "LINEAR_IMP_LIPSCHITZ",LINEAR_IMP_LIPSCHITZ; "LINEAR_INDEPENDENT_EXTEND",LINEAR_INDEPENDENT_EXTEND; "LINEAR_INDEPENDENT_EXTEND_LEMMA",LINEAR_INDEPENDENT_EXTEND_LEMMA; "LINEAR_INDEP_IMAGE_LEMMA",LINEAR_INDEP_IMAGE_LEMMA; "LINEAR_INJECTIVE_0",LINEAR_INJECTIVE_0; "LINEAR_INJECTIVE_0_SUBSPACE",LINEAR_INJECTIVE_0_SUBSPACE; "LINEAR_INJECTIVE_BOUNDED_BELOW_POS",LINEAR_INJECTIVE_BOUNDED_BELOW_POS; "LINEAR_INJECTIVE_DIMINDEX_LE",LINEAR_INJECTIVE_DIMINDEX_LE; "LINEAR_INJECTIVE_IFF_DIM",LINEAR_INJECTIVE_IFF_DIM; "LINEAR_INJECTIVE_IMP_SURJECTIVE",LINEAR_INJECTIVE_IMP_SURJECTIVE; "LINEAR_INJECTIVE_IMP_SURJECTIVE_ON",LINEAR_INJECTIVE_IMP_SURJECTIVE_ON; "LINEAR_INJECTIVE_ISOMORPHISM",LINEAR_INJECTIVE_ISOMORPHISM; "LINEAR_INJECTIVE_LEFT_INVERSE",LINEAR_INJECTIVE_LEFT_INVERSE; "LINEAR_INJECTIVE_LEFT_INVERSE_EQ",LINEAR_INJECTIVE_LEFT_INVERSE_EQ; "LINEAR_INJECTIVE_LEFT_RIGHT_INVERSE_EQ",LINEAR_INJECTIVE_LEFT_RIGHT_INVERSE_EQ; "LINEAR_INJECTIVE_ON_IFF_DIM",LINEAR_INJECTIVE_ON_IFF_DIM; "LINEAR_INTERIOR_IMAGE_SUBSET",LINEAR_INTERIOR_IMAGE_SUBSET; "LINEAR_INVERSE_LEFT",LINEAR_INVERSE_LEFT; "LINEAR_INVERTIBLE_BOUNDED_BELOW",LINEAR_INVERTIBLE_BOUNDED_BELOW; "LINEAR_INVERTIBLE_BOUNDED_BELOW_POS",LINEAR_INVERTIBLE_BOUNDED_BELOW_POS; "LINEAR_LIFT_COMPONENT",LINEAR_LIFT_COMPONENT; "LINEAR_LIFT_DOT",LINEAR_LIFT_DOT; "LINEAR_LIMIT",LINEAR_LIMIT; "LINEAR_LIM_0",LINEAR_LIM_0; "LINEAR_MATRIX_EXISTS",LINEAR_MATRIX_EXISTS; "LINEAR_NEG",LINEAR_NEG; "LINEAR_NEGATION",LINEAR_NEGATION; "LINEAR_OPEN_MAPPING",LINEAR_OPEN_MAPPING; "LINEAR_PASTECART",LINEAR_PASTECART; "LINEAR_PASTECART_EQ",LINEAR_PASTECART_EQ; "LINEAR_PROPERTY",LINEAR_PROPERTY; "LINEAR_PUSHIN",LINEAR_PUSHIN; "LINEAR_REFLECT_ALONG",LINEAR_REFLECT_ALONG; "LINEAR_SCALING",LINEAR_SCALING; "LINEAR_SEQUENTIAL_LIMIT",LINEAR_SEQUENTIAL_LIMIT; "LINEAR_SINGULAR_IMAGE_HYPERPLANE",LINEAR_SINGULAR_IMAGE_HYPERPLANE; "LINEAR_SINGULAR_INTO_HYPERPLANE",LINEAR_SINGULAR_INTO_HYPERPLANE; "LINEAR_SNDCART",LINEAR_SNDCART; "LINEAR_SUB",LINEAR_SUB; "LINEAR_SUBSPACE_GRAPH",LINEAR_SUBSPACE_GRAPH; "LINEAR_SURJECTIVE_DIMINDEX_LE",LINEAR_SURJECTIVE_DIMINDEX_LE; "LINEAR_SURJECTIVE_IFF_DIM",LINEAR_SURJECTIVE_IFF_DIM; "LINEAR_SURJECTIVE_IFF_INJECTIVE",LINEAR_SURJECTIVE_IFF_INJECTIVE; "LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN",LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN; "LINEAR_SURJECTIVE_IFF_INJECTIVE_ON",LINEAR_SURJECTIVE_IFF_INJECTIVE_ON; "LINEAR_SURJECTIVE_IMP_INJECTIVE",LINEAR_SURJECTIVE_IMP_INJECTIVE; "LINEAR_SURJECTIVE_ISOMORPHISM",LINEAR_SURJECTIVE_ISOMORPHISM; "LINEAR_SURJECTIVE_LEFT_RIGHT_INVERSE_EQ",LINEAR_SURJECTIVE_LEFT_RIGHT_INVERSE_EQ; "LINEAR_SURJECTIVE_ON_IFF_DIM",LINEAR_SURJECTIVE_ON_IFF_DIM; "LINEAR_SURJECTIVE_RIGHT_INVERSE",LINEAR_SURJECTIVE_RIGHT_INVERSE; "LINEAR_SURJECTIVE_RIGHT_INVERSE_EQ",LINEAR_SURJECTIVE_RIGHT_INVERSE_EQ; "LINEAR_TO_1",LINEAR_TO_1; "LINEAR_TO_REALS",LINEAR_TO_REALS; "LINEAR_UNIFORMLY_CONTINUOUS_ON",LINEAR_UNIFORMLY_CONTINUOUS_ON; "LINEAR_VMUL_COMPONENT",LINEAR_VMUL_COMPONENT; "LINEAR_VMUL_DROP",LINEAR_VMUL_DROP; "LINEAR_VSUM",LINEAR_VSUM; "LINEAR_VSUM_MUL",LINEAR_VSUM_MUL; "LINEAR_ZERO",LINEAR_ZERO; "LINEPATH_LINEAR_IMAGE",LINEPATH_LINEAR_IMAGE; "LINEPATH_REFL",LINEPATH_REFL; "LINEPATH_TRANSLATION",LINEPATH_TRANSLATION; "LINSEG_FL",LINSEG_FL; "LINSEG_INSEG",LINSEG_INSEG; "LINSEG_WOSET",LINSEG_WOSET; "LIPSCHITZ_COEFFICIENT_POS",LIPSCHITZ_COEFFICIENT_POS; "LIPSCHITZ_CONTINUOUS_IMP_TOPCONTINUOUS",LIPSCHITZ_CONTINUOUS_IMP_TOPCONTINUOUS; "LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION",LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION; "LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT",LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT; "LIPSCHITZ_EXTENSION_EXISTS",LIPSCHITZ_EXTENSION_EXISTS; "LIPSCHITZ_IMP_ABSOLUTELY_CONTINUOUS",LIPSCHITZ_IMP_ABSOLUTELY_CONTINUOUS; "LIPSCHITZ_IMP_CONTINUOUS_ON",LIPSCHITZ_IMP_CONTINUOUS_ON; "LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION",LIPSCHITZ_IMP_HAS_BOUNDED_VARIATION; "LIPSCHITZ_IMP_RECTIFIABLE_PATH",LIPSCHITZ_IMP_RECTIFIABLE_PATH; "LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON",LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON; "LIPSCHITZ_LIM",LIPSCHITZ_LIM; "LIPSCHITZ_ON_COMBINE",LIPSCHITZ_ON_COMBINE; "LIPSCHITZ_ON_COMPONENTWISE",LIPSCHITZ_ON_COMPONENTWISE; "LIPSCHITZ_ON_COMPOSE",LIPSCHITZ_ON_COMPOSE; "LIPSCHITZ_ON_INF",LIPSCHITZ_ON_INF; "LIPSCHITZ_ON_POS",LIPSCHITZ_ON_POS; "LIPSCHITZ_ON_SUP",LIPSCHITZ_ON_SUP; "LIPSCHITZ_ON_UNION",LIPSCHITZ_ON_UNION; "LIPSCHITZ_POS",LIPSCHITZ_POS; "LIPSCHITZ_VECTOR_VARIATION",LIPSCHITZ_VECTOR_VARIATION; "LIST_EQ",LIST_EQ; "LIST_OF_SEQ_EQ_NIL",LIST_OF_SEQ_EQ_NIL; "LIST_OF_SET_EMPTY",LIST_OF_SET_EMPTY; "LIST_OF_SET_PROPERTIES",LIST_OF_SET_PROPERTIES; "LIST_OF_SET_SING",LIST_OF_SET_SING; "LOCALLY_AND_OPEN_IN",LOCALLY_AND_OPEN_IN; "LOCALLY_AND_OPEN_IN_IDEMPOT",LOCALLY_AND_OPEN_IN_IDEMPOT; "LOCALLY_AND_SMALL_LE",LOCALLY_AND_SMALL_LE; "LOCALLY_AND_SMALL_LT",LOCALLY_AND_SMALL_LT; "LOCALLY_AND_SUBSET",LOCALLY_AND_SUBSET; "LOCALLY_ANR",LOCALLY_ANR; "LOCALLY_ANR_ALT",LOCALLY_ANR_ALT; "LOCALLY_CLOSED",LOCALLY_CLOSED; "LOCALLY_CLOSED_IN",LOCALLY_CLOSED_IN; "LOCALLY_CLOSED_IN_EXPLICIT",LOCALLY_CLOSED_IN_EXPLICIT; "LOCALLY_COMPACT",LOCALLY_COMPACT; "LOCALLY_COMPACT_ALT",LOCALLY_COMPACT_ALT; "LOCALLY_COMPACT_CLOSED_DIFF",LOCALLY_COMPACT_CLOSED_DIFF; "LOCALLY_COMPACT_CLOSED_IN",LOCALLY_COMPACT_CLOSED_IN; "LOCALLY_COMPACT_CLOSED_INTER_OPEN",LOCALLY_COMPACT_CLOSED_INTER_OPEN; "LOCALLY_COMPACT_CLOSED_IN_OPEN",LOCALLY_COMPACT_CLOSED_IN_OPEN; "LOCALLY_COMPACT_CLOSED_UNION",LOCALLY_COMPACT_CLOSED_UNION; "LOCALLY_COMPACT_CLOSURE_DIFF",LOCALLY_COMPACT_CLOSURE_DIFF; "LOCALLY_COMPACT_COMPACT",LOCALLY_COMPACT_COMPACT; "LOCALLY_COMPACT_COMPACT_ALT",LOCALLY_COMPACT_COMPACT_ALT; "LOCALLY_COMPACT_COMPACT_SUBOPEN",LOCALLY_COMPACT_COMPACT_SUBOPEN; "LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED",LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED; "LOCALLY_COMPACT_DELETE",LOCALLY_COMPACT_DELETE; "LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED",LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED; "LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED",LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED; "LOCALLY_COMPACT_IMP_ANALYTIC",LOCALLY_COMPACT_IMP_ANALYTIC; "LOCALLY_COMPACT_IMP_BOREL",LOCALLY_COMPACT_IMP_BOREL; "LOCALLY_COMPACT_INTER",LOCALLY_COMPACT_INTER; "LOCALLY_COMPACT_INTER_CBALL",LOCALLY_COMPACT_INTER_CBALL; "LOCALLY_COMPACT_INTER_CBALLS",LOCALLY_COMPACT_INTER_CBALLS; "LOCALLY_COMPACT_LINEAR_IMAGE_EQ",LOCALLY_COMPACT_LINEAR_IMAGE_EQ; "LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED",LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED; "LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED",LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED; "LOCALLY_COMPACT_OPEN_IN",LOCALLY_COMPACT_OPEN_IN; "LOCALLY_COMPACT_OPEN_INTER_CLOSURE",LOCALLY_COMPACT_OPEN_INTER_CLOSURE; "LOCALLY_COMPACT_OPEN_UNION",LOCALLY_COMPACT_OPEN_UNION; "LOCALLY_COMPACT_OPEN_UNIONS",LOCALLY_COMPACT_OPEN_UNIONS; "LOCALLY_COMPACT_PATH_CONNECTED_EQ_CONNECTED",LOCALLY_COMPACT_PATH_CONNECTED_EQ_CONNECTED; "LOCALLY_COMPACT_PCROSS",LOCALLY_COMPACT_PCROSS; "LOCALLY_COMPACT_PCROSS_EQ",LOCALLY_COMPACT_PCROSS_EQ; "LOCALLY_COMPACT_PROPER_CONTINUOUS_PREIMAGE",LOCALLY_COMPACT_PROPER_CONTINUOUS_PREIMAGE; "LOCALLY_COMPACT_PROPER_IMAGE",LOCALLY_COMPACT_PROPER_IMAGE; "LOCALLY_COMPACT_PROPER_IMAGE_EQ",LOCALLY_COMPACT_PROPER_IMAGE_EQ; "LOCALLY_COMPACT_TRANSLATION_EQ",LOCALLY_COMPACT_TRANSLATION_EQ; "LOCALLY_COMPACT_UNIV",LOCALLY_COMPACT_UNIV; "LOCALLY_CONNECTED",LOCALLY_CONNECTED; "LOCALLY_CONNECTED_CLOSED_UNION",LOCALLY_CONNECTED_CLOSED_UNION; "LOCALLY_CONNECTED_CLOSED_UNIONS",LOCALLY_CONNECTED_CLOSED_UNIONS; "LOCALLY_CONNECTED_CLOSED_UNION_GEN",LOCALLY_CONNECTED_CLOSED_UNION_GEN; "LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER",LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER; "LOCALLY_CONNECTED_COMPONENTS",LOCALLY_CONNECTED_COMPONENTS; "LOCALLY_CONNECTED_CONNECTED_COMPONENT",LOCALLY_CONNECTED_CONNECTED_COMPONENT; "LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT; "LOCALLY_CONNECTED_CONTINUUM",LOCALLY_CONNECTED_CONTINUUM; "LOCALLY_CONNECTED_FROM_UNION_AND_INTER",LOCALLY_CONNECTED_FROM_UNION_AND_INTER; "LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN",LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN; "LOCALLY_CONNECTED_IM_KLEINEN",LOCALLY_CONNECTED_IM_KLEINEN; "LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE; "LOCALLY_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_CONNECTED_LINEAR_IMAGE_EQ; "LOCALLY_CONNECTED_OPEN_COMPONENT",LOCALLY_CONNECTED_OPEN_COMPONENT; "LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT",LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT; "LOCALLY_CONNECTED_PATH_IMAGE",LOCALLY_CONNECTED_PATH_IMAGE; "LOCALLY_CONNECTED_PCROSS",LOCALLY_CONNECTED_PCROSS; "LOCALLY_CONNECTED_PCROSS_EQ",LOCALLY_CONNECTED_PCROSS_EQ; "LOCALLY_CONNECTED_QUOTIENT_IMAGE",LOCALLY_CONNECTED_QUOTIENT_IMAGE; "LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE; "LOCALLY_CONNECTED_SPHERE",LOCALLY_CONNECTED_SPHERE; "LOCALLY_CONNECTED_SPHERE_GEN",LOCALLY_CONNECTED_SPHERE_GEN; "LOCALLY_CONNECTED_SUBREGION",LOCALLY_CONNECTED_SUBREGION; "LOCALLY_CONNECTED_TRANSLATION_EQ",LOCALLY_CONNECTED_TRANSLATION_EQ; "LOCALLY_CONNECTED_UNIV",LOCALLY_CONNECTED_UNIV; "LOCALLY_CONSTANT",LOCALLY_CONSTANT; "LOCALLY_CONSTANT_IMP_CONSTANT",LOCALLY_CONSTANT_IMP_CONSTANT; "LOCALLY_CONTINUOUS_ON",LOCALLY_CONTINUOUS_ON; "LOCALLY_CONTINUOUS_ON_ALT",LOCALLY_CONTINUOUS_ON_ALT; "LOCALLY_CONTINUOUS_ON_EXPLICIT",LOCALLY_CONTINUOUS_ON_EXPLICIT; "LOCALLY_CONVEX",LOCALLY_CONVEX; "LOCALLY_COUNTABLE",LOCALLY_COUNTABLE; "LOCALLY_DIFF_CLOSED",LOCALLY_DIFF_CLOSED; "LOCALLY_DIMENSION_EQ",LOCALLY_DIMENSION_EQ; "LOCALLY_DIMENSION_LE",LOCALLY_DIMENSION_LE; "LOCALLY_EMPTY",LOCALLY_EMPTY; "LOCALLY_ENR",LOCALLY_ENR; "LOCALLY_ENR_ALT",LOCALLY_ENR_ALT; "LOCALLY_FCCOVERABLE",LOCALLY_FCCOVERABLE; "LOCALLY_FCCOVERABLE_ALT",LOCALLY_FCCOVERABLE_ALT; "LOCALLY_FINE_COVERING_COMPACT",LOCALLY_FINE_COVERING_COMPACT; "LOCALLY_IMP_COUNTABLE_UNION_OF",LOCALLY_IMP_COUNTABLE_UNION_OF; "LOCALLY_IMP_FINITE_UNION_OF",LOCALLY_IMP_FINITE_UNION_OF; "LOCALLY_INJECTIVE_LINEAR_IMAGE",LOCALLY_INJECTIVE_LINEAR_IMAGE; "LOCALLY_INTER",LOCALLY_INTER; "LOCALLY_INTER_OPEN",LOCALLY_INTER_OPEN; "LOCALLY_LEBESGUE_MEASURABLE",LOCALLY_LEBESGUE_MEASURABLE; "LOCALLY_LEBESGUE_MEASURABLE_ALT",LOCALLY_LEBESGUE_MEASURABLE_ALT; "LOCALLY_LIPSCHITZ",LOCALLY_LIPSCHITZ; "LOCALLY_LIPSCHITZ_GEN",LOCALLY_LIPSCHITZ_GEN; "LOCALLY_LOCALLY",LOCALLY_LOCALLY; "LOCALLY_MONO",LOCALLY_MONO; "LOCALLY_NEGLIGIBLE",LOCALLY_NEGLIGIBLE; "LOCALLY_NEGLIGIBLE_ALT",LOCALLY_NEGLIGIBLE_ALT; "LOCALLY_ON_NBDS",LOCALLY_ON_NBDS; "LOCALLY_ON_OPEN_SUBSETS",LOCALLY_ON_OPEN_SUBSETS; "LOCALLY_OPEN_AND_DIMENSION_LE",LOCALLY_OPEN_AND_DIMENSION_LE; "LOCALLY_OPEN_BASIS",LOCALLY_OPEN_BASIS; "LOCALLY_OPEN_INTER",LOCALLY_OPEN_INTER; "LOCALLY_OPEN_MAP_IMAGE",LOCALLY_OPEN_MAP_IMAGE; "LOCALLY_OPEN_SUBSET",LOCALLY_OPEN_SUBSET; "LOCALLY_PATH_CONNECTED",LOCALLY_PATH_CONNECTED; "LOCALLY_PATH_CONNECTED_CLOSURE_FROM_FRONTIER",LOCALLY_PATH_CONNECTED_CLOSURE_FROM_FRONTIER; "LOCALLY_PATH_CONNECTED_COMPONENTS",LOCALLY_PATH_CONNECTED_COMPONENTS; "LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT",LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT; "LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT; "LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER",LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER; "LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN",LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN; "LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED",LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED; "LOCALLY_PATH_CONNECTED_IM_KLEINEN",LOCALLY_PATH_CONNECTED_IM_KLEINEN; "LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE; "LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ; "LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT; "LOCALLY_PATH_CONNECTED_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_PATH_COMPONENT; "LOCALLY_PATH_CONNECTED_PATH_IMAGE",LOCALLY_PATH_CONNECTED_PATH_IMAGE; "LOCALLY_PATH_CONNECTED_PCROSS",LOCALLY_PATH_CONNECTED_PCROSS; "LOCALLY_PATH_CONNECTED_PCROSS_EQ",LOCALLY_PATH_CONNECTED_PCROSS_EQ; "LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE",LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE; "LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE; "LOCALLY_PATH_CONNECTED_SPHERE",LOCALLY_PATH_CONNECTED_SPHERE; "LOCALLY_PATH_CONNECTED_SPHERE_GEN",LOCALLY_PATH_CONNECTED_SPHERE_GEN; "LOCALLY_PATH_CONNECTED_SUBREGION",LOCALLY_PATH_CONNECTED_SUBREGION; "LOCALLY_PATH_CONNECTED_TRANSLATION_EQ",LOCALLY_PATH_CONNECTED_TRANSLATION_EQ; "LOCALLY_PATH_CONNECTED_UNIV",LOCALLY_PATH_CONNECTED_UNIV; "LOCALLY_PCROSS",LOCALLY_PCROSS; "LOCALLY_SING",LOCALLY_SING; "LOCALLY_TRANSLATION",LOCALLY_TRANSLATION; "LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP",LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP; "LOWDIM_EQ_HYPERPLANE",LOWDIM_EQ_HYPERPLANE; "LOWDIM_EQ_INTER_HYPERPLANE",LOWDIM_EQ_INTER_HYPERPLANE; "LOWDIM_EXPAND_BASIS",LOWDIM_EXPAND_BASIS; "LOWDIM_EXPAND_DIMENSION",LOWDIM_EXPAND_DIMENSION; "LOWDIM_SUBSET_HYPERPLANE",LOWDIM_SUBSET_HYPERPLANE; "LOWER_BOUND_FINITE_SET",LOWER_BOUND_FINITE_SET; "LOWER_BOUND_FINITE_SET_REAL",LOWER_BOUND_FINITE_SET_REAL; "LOWER_HEMICONTINUOUS",LOWER_HEMICONTINUOUS; "LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT",LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT; "LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT",LPC_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT; "LPC_OPEN_SIMPLE_PATH_COMPLEMENT",LPC_OPEN_SIMPLE_PATH_COMPLEMENT; "LPC_SUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE",LPC_SUPERSET_COMPLEMENT_SIMPLE_PATH_IMAGE; "LT",LT; "LTE_ADD2",LTE_ADD2; "LTE_ANTISYM",LTE_ANTISYM; "LTE_CASES",LTE_CASES; "LTE_TRANS",LTE_TRANS; "LT_0",LT_0; "LT_ADD",LT_ADD; "LT_ADD2",LT_ADD2; "LT_ADDR",LT_ADDR; "LT_ADD_LCANCEL",LT_ADD_LCANCEL; "LT_ADD_RCANCEL",LT_ADD_RCANCEL; "LT_ANTISYM",LT_ANTISYM; "LT_CASES",LT_CASES; "LT_EXISTS",LT_EXISTS; "LT_EXP",LT_EXP; "LT_IMP_LE",LT_IMP_LE; "LT_LE",LT_LE; "LT_LMULT",LT_LMULT; "LT_MULT",LT_MULT; "LT_MULT2",LT_MULT2; "LT_MULT_LCANCEL",LT_MULT_LCANCEL; "LT_MULT_RCANCEL",LT_MULT_RCANCEL; "LT_NZ",LT_NZ; "LT_POW2_REFL",LT_POW2_REFL; "LT_REFL",LT_REFL; "LT_SUC",LT_SUC; "LT_SUC_LE",LT_SUC_LE; "LT_TRANS",LT_TRANS; "LUZIN",LUZIN; "LUZIN_EQ",LUZIN_EQ; "LUZIN_EQ_ALT",LUZIN_EQ_ALT; "LUZIN_NPROPERTY_IMP_COUNTABLE_PREIMAGES",LUZIN_NPROPERTY_IMP_COUNTABLE_PREIMAGES; "LUZIN_SIGMA",LUZIN_SIGMA; "LUZIN_SIGMA_EXPLICIT",LUZIN_SIGMA_EXPLICIT; "LUZIN_SIGMA_NESTED",LUZIN_SIGMA_NESTED; "MANHATTAN",MANHATTAN; "MAP",MAP; "MAP2",MAP2; "MAP2_DEF",MAP2_DEF; "MAPPING_CONNECTED_ONTO_SEGMENT",MAPPING_CONNECTED_ONTO_SEGMENT; "MAPROWS_COMPOSE",MAPROWS_COMPOSE; "MAP_APPEND",MAP_APPEND; "MAP_EQ",MAP_EQ; "MAP_EQ_ALL2",MAP_EQ_ALL2; "MAP_EQ_DEGEN",MAP_EQ_DEGEN; "MAP_EQ_NIL",MAP_EQ_NIL; "MAP_FST_ZIP",MAP_FST_ZIP; "MAP_I",MAP_I; "MAP_ID",MAP_ID; "MAP_REVERSE",MAP_REVERSE; "MAP_SND_ZIP",MAP_SND_ZIP; "MAP_o",MAP_o; "MATCH_SEQPATTERN",MATCH_SEQPATTERN; "MATRIX_0",MATRIX_0; "MATRIX_ADD",MATRIX_ADD; "MATRIX_ADD_AC",MATRIX_ADD_AC; "MATRIX_ADD_ASSOC",MATRIX_ADD_ASSOC; "MATRIX_ADD_COMPONENT",MATRIX_ADD_COMPONENT; "MATRIX_ADD_LDISTRIB",MATRIX_ADD_LDISTRIB; "MATRIX_ADD_LID",MATRIX_ADD_LID; "MATRIX_ADD_LNEG",MATRIX_ADD_LNEG; "MATRIX_ADD_RDISTRIB",MATRIX_ADD_RDISTRIB; "MATRIX_ADD_RID",MATRIX_ADD_RID; "MATRIX_ADD_RNEG",MATRIX_ADD_RNEG; "MATRIX_ADD_SYM",MATRIX_ADD_SYM; "MATRIX_ADJOINT",MATRIX_ADJOINT; "MATRIX_AUGMENTED_LINEAR_EQUATIONS",MATRIX_AUGMENTED_LINEAR_EQUATIONS; "MATRIX_CMUL",MATRIX_CMUL; "MATRIX_CMUL_ADD_LDISTRIB",MATRIX_CMUL_ADD_LDISTRIB; "MATRIX_CMUL_ADD_RDISTRIB",MATRIX_CMUL_ADD_RDISTRIB; "MATRIX_CMUL_ASSOC",MATRIX_CMUL_ASSOC; "MATRIX_CMUL_COMPONENT",MATRIX_CMUL_COMPONENT; "MATRIX_CMUL_EQ_0",MATRIX_CMUL_EQ_0; "MATRIX_CMUL_LID",MATRIX_CMUL_LID; "MATRIX_CMUL_LZERO",MATRIX_CMUL_LZERO; "MATRIX_CMUL_RZERO",MATRIX_CMUL_RZERO; "MATRIX_CMUL_SUB_LDISTRIB",MATRIX_CMUL_SUB_LDISTRIB; "MATRIX_CMUL_SUB_RDISTRIB",MATRIX_CMUL_SUB_RDISTRIB; "MATRIX_COMPONENT",MATRIX_COMPONENT; "MATRIX_COMPONENT_LE_ONORM",MATRIX_COMPONENT_LE_ONORM; "MATRIX_COMPOSE",MATRIX_COMPOSE; "MATRIX_DIAGONALIZABLE",MATRIX_DIAGONALIZABLE; "MATRIX_ENTIRE",MATRIX_ENTIRE; "MATRIX_EQ",MATRIX_EQ; "MATRIX_EQUAL_COLUMNS",MATRIX_EQUAL_COLUMNS; "MATRIX_EQUAL_ROWS",MATRIX_EQUAL_ROWS; "MATRIX_EQ_0",MATRIX_EQ_0; "MATRIX_FULL_LINEAR_EQUATIONS",MATRIX_FULL_LINEAR_EQUATIONS; "MATRIX_I",MATRIX_I; "MATRIX_ID",MATRIX_ID; "MATRIX_INJECTIVE_0",MATRIX_INJECTIVE_0; "MATRIX_INV",MATRIX_INV; "MATRIX_INVERTIBLE",MATRIX_INVERTIBLE; "MATRIX_INVERTIBLE_LEFT",MATRIX_INVERTIBLE_LEFT; "MATRIX_INVERTIBLE_LEFT_GEN",MATRIX_INVERTIBLE_LEFT_GEN; "MATRIX_INVERTIBLE_RIGHT",MATRIX_INVERTIBLE_RIGHT; "MATRIX_INVERTIBLE_RIGHT_GEN",MATRIX_INVERTIBLE_RIGHT_GEN; "MATRIX_INV_0",MATRIX_INV_0; "MATRIX_INV_CMUL",MATRIX_INV_CMUL; "MATRIX_INV_COFACTOR",MATRIX_INV_COFACTOR; "MATRIX_INV_COVARIANCE",MATRIX_INV_COVARIANCE; "MATRIX_INV_COVARIANCE_LMUL",MATRIX_INV_COVARIANCE_LMUL; "MATRIX_INV_COVARIANCE_RMUL",MATRIX_INV_COVARIANCE_RMUL; "MATRIX_INV_EQ",MATRIX_INV_EQ; "MATRIX_INV_EQ_0",MATRIX_INV_EQ_0; "MATRIX_INV_I",MATRIX_INV_I; "MATRIX_INV_IDEMPOTENT",MATRIX_INV_IDEMPOTENT; "MATRIX_INV_INV",MATRIX_INV_INV; "MATRIX_INV_LEFT",MATRIX_INV_LEFT; "MATRIX_INV_MUL",MATRIX_INV_MUL; "MATRIX_INV_MULTIPLE_TRANP_LEFT",MATRIX_INV_MULTIPLE_TRANP_LEFT; "MATRIX_INV_MULTIPLE_TRANP_RIGHT",MATRIX_INV_MULTIPLE_TRANP_RIGHT; "MATRIX_INV_MUL_INNER",MATRIX_INV_MUL_INNER; "MATRIX_INV_MUL_LINV",MATRIX_INV_MUL_LINV; "MATRIX_INV_MUL_OUTER",MATRIX_INV_MUL_OUTER; "MATRIX_INV_MUL_RINV",MATRIX_INV_MUL_RINV; "MATRIX_INV_ORTHOGONAL_LMUL",MATRIX_INV_ORTHOGONAL_LMUL; "MATRIX_INV_ORTHOGONAL_RMUL",MATRIX_INV_ORTHOGONAL_RMUL; "MATRIX_INV_PROJECTION_IMAGE",MATRIX_INV_PROJECTION_IMAGE; "MATRIX_INV_PROJECTION_IMAGE_ALT",MATRIX_INV_PROJECTION_IMAGE_ALT; "MATRIX_INV_RIGHT",MATRIX_INV_RIGHT; "MATRIX_INV_TRANSP",MATRIX_INV_TRANSP; "MATRIX_INV_UNIQUE",MATRIX_INV_UNIQUE; "MATRIX_INV_UNIQUE_LEFT",MATRIX_INV_UNIQUE_LEFT; "MATRIX_INV_UNIQUE_RIGHT",MATRIX_INV_UNIQUE_RIGHT; "MATRIX_INV_UNIQUE_STRONG",MATRIX_INV_UNIQUE_STRONG; "MATRIX_LEFT_INVERSE_COFACTOR",MATRIX_LEFT_INVERSE_COFACTOR; "MATRIX_LEFT_INVERTIBLE",MATRIX_LEFT_INVERTIBLE; "MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS",MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS; "MATRIX_LEFT_INVERTIBLE_INJECTIVE",MATRIX_LEFT_INVERTIBLE_INJECTIVE; "MATRIX_LEFT_INVERTIBLE_KER",MATRIX_LEFT_INVERTIBLE_KER; "MATRIX_LEFT_INVERTIBLE_NULLSPACE",MATRIX_LEFT_INVERTIBLE_NULLSPACE; "MATRIX_LEFT_INVERTIBLE_SPAN_ROWS",MATRIX_LEFT_INVERTIBLE_SPAN_ROWS; "MATRIX_LEFT_RIGHT_INVERSE",MATRIX_LEFT_RIGHT_INVERSE; "MATRIX_MUL_ASSOC",MATRIX_MUL_ASSOC; "MATRIX_MUL_COMPONENT",MATRIX_MUL_COMPONENT; "MATRIX_MUL_COVARIANCE_LCANCEL",MATRIX_MUL_COVARIANCE_LCANCEL; "MATRIX_MUL_COVARIANCE_RCANCEL",MATRIX_MUL_COVARIANCE_RCANCEL; "MATRIX_MUL_DIAGONAL",MATRIX_MUL_DIAGONAL; "MATRIX_MUL_DOT",MATRIX_MUL_DOT; "MATRIX_MUL_INV_EQ_0",MATRIX_MUL_INV_EQ_0; "MATRIX_MUL_LCANCEL",MATRIX_MUL_LCANCEL; "MATRIX_MUL_LEFT_COFACTOR",MATRIX_MUL_LEFT_COFACTOR; "MATRIX_MUL_LID",MATRIX_MUL_LID; "MATRIX_MUL_LINV",MATRIX_MUL_LINV; "MATRIX_MUL_LMUL",MATRIX_MUL_LMUL; "MATRIX_MUL_LNEG",MATRIX_MUL_LNEG; "MATRIX_MUL_LTRANSP_DOT_COLUMN",MATRIX_MUL_LTRANSP_DOT_COLUMN; "MATRIX_MUL_LZERO",MATRIX_MUL_LZERO; "MATRIX_MUL_RCANCEL",MATRIX_MUL_RCANCEL; "MATRIX_MUL_RID",MATRIX_MUL_RID; "MATRIX_MUL_RIGHT_COFACTOR",MATRIX_MUL_RIGHT_COFACTOR; "MATRIX_MUL_RINV",MATRIX_MUL_RINV; "MATRIX_MUL_RMUL",MATRIX_MUL_RMUL; "MATRIX_MUL_RNEG",MATRIX_MUL_RNEG; "MATRIX_MUL_RTRANSP_DOT_ROW",MATRIX_MUL_RTRANSP_DOT_ROW; "MATRIX_MUL_RZERO",MATRIX_MUL_RZERO; "MATRIX_MUL_VSUM",MATRIX_MUL_VSUM; "MATRIX_MUL_VSUM_ALT",MATRIX_MUL_VSUM_ALT; "MATRIX_NEG",MATRIX_NEG; "MATRIX_NEG_0",MATRIX_NEG_0; "MATRIX_NEG_ADD",MATRIX_NEG_ADD; "MATRIX_NEG_COMPONENT",MATRIX_NEG_COMPONENT; "MATRIX_NEG_EQ_0",MATRIX_NEG_EQ_0; "MATRIX_NEG_MINUS1",MATRIX_NEG_MINUS1; "MATRIX_NEG_NEG",MATRIX_NEG_NEG; "MATRIX_NEG_SUB",MATRIX_NEG_SUB; "MATRIX_NONFULL_LINEAR_EQUATIONS",MATRIX_NONFULL_LINEAR_EQUATIONS; "MATRIX_NONFULL_LINEAR_EQUATIONS_EQ",MATRIX_NONFULL_LINEAR_EQUATIONS_EQ; "MATRIX_OF_MATRIX_VECTOR_MUL",MATRIX_OF_MATRIX_VECTOR_MUL; "MATRIX_RATIONAL_APPROXIMATION",MATRIX_RATIONAL_APPROXIMATION; "MATRIX_REFLECT_ALONG_BASIS",MATRIX_REFLECT_ALONG_BASIS; "MATRIX_RIGHT_INVERSE_COFACTOR",MATRIX_RIGHT_INVERSE_COFACTOR; "MATRIX_RIGHT_INVERTIBLE",MATRIX_RIGHT_INVERTIBLE; "MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS",MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS; "MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS",MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS; "MATRIX_RIGHT_INVERTIBLE_SURJECTIVE",MATRIX_RIGHT_INVERTIBLE_SURJECTIVE; "MATRIX_SELF_ADJOINT",MATRIX_SELF_ADJOINT; "MATRIX_SUB",MATRIX_SUB; "MATRIX_SUB_ADD",MATRIX_SUB_ADD; "MATRIX_SUB_ADD2",MATRIX_SUB_ADD2; "MATRIX_SUB_COMPONENT",MATRIX_SUB_COMPONENT; "MATRIX_SUB_EQ",MATRIX_SUB_EQ; "MATRIX_SUB_LDISTRIB",MATRIX_SUB_LDISTRIB; "MATRIX_SUB_LZERO",MATRIX_SUB_LZERO; "MATRIX_SUB_RDISTRIB",MATRIX_SUB_RDISTRIB; "MATRIX_SUB_REFL",MATRIX_SUB_REFL; "MATRIX_SUB_RZERO",MATRIX_SUB_RZERO; "MATRIX_TRANSP_MUL",MATRIX_TRANSP_MUL; "MATRIX_TRANSP_MULTIPLE_INV_LEFT",MATRIX_TRANSP_MULTIPLE_INV_LEFT; "MATRIX_TRANSP_MULTIPLE_INV_RIGHT",MATRIX_TRANSP_MULTIPLE_INV_RIGHT; "MATRIX_TRIVIAL_LINEAR_EQUATIONS",MATRIX_TRIVIAL_LINEAR_EQUATIONS; "MATRIX_VECTOR_COLUMN",MATRIX_VECTOR_COLUMN; "MATRIX_VECTOR_LMUL",MATRIX_VECTOR_LMUL; "MATRIX_VECTOR_MUL",MATRIX_VECTOR_MUL; "MATRIX_VECTOR_MUL_ADD_LDISTRIB",MATRIX_VECTOR_MUL_ADD_LDISTRIB; "MATRIX_VECTOR_MUL_ADD_RDISTRIB",MATRIX_VECTOR_MUL_ADD_RDISTRIB; "MATRIX_VECTOR_MUL_ASSOC",MATRIX_VECTOR_MUL_ASSOC; "MATRIX_VECTOR_MUL_BASIS",MATRIX_VECTOR_MUL_BASIS; "MATRIX_VECTOR_MUL_COMPONENT",MATRIX_VECTOR_MUL_COMPONENT; "MATRIX_VECTOR_MUL_COVARIANCE_EQ_0",MATRIX_VECTOR_MUL_COVARIANCE_EQ_0; "MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE",MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE; "MATRIX_VECTOR_MUL_INV_EQ_0",MATRIX_VECTOR_MUL_INV_EQ_0; "MATRIX_VECTOR_MUL_IN_COLUMNSPACE",MATRIX_VECTOR_MUL_IN_COLUMNSPACE; "MATRIX_VECTOR_MUL_LID",MATRIX_VECTOR_MUL_LID; "MATRIX_VECTOR_MUL_LINEAR",MATRIX_VECTOR_MUL_LINEAR; "MATRIX_VECTOR_MUL_LNEG",MATRIX_VECTOR_MUL_LNEG; "MATRIX_VECTOR_MUL_LZERO",MATRIX_VECTOR_MUL_LZERO; "MATRIX_VECTOR_MUL_RMUL",MATRIX_VECTOR_MUL_RMUL; "MATRIX_VECTOR_MUL_RNEG",MATRIX_VECTOR_MUL_RNEG; "MATRIX_VECTOR_MUL_RZERO",MATRIX_VECTOR_MUL_RZERO; "MATRIX_VECTOR_MUL_SUB_LDISTRIB",MATRIX_VECTOR_MUL_SUB_LDISTRIB; "MATRIX_VECTOR_MUL_SUB_RDISTRIB",MATRIX_VECTOR_MUL_SUB_RDISTRIB; "MATRIX_VECTOR_MUL_TRANSP",MATRIX_VECTOR_MUL_TRANSP; "MATRIX_WLOG_INVERTIBLE",MATRIX_WLOG_INVERTIBLE; "MATRIX_WORKS",MATRIX_WORKS; "MAT_0_COMPONENT",MAT_0_COMPONENT; "MAT_CMUL",MAT_CMUL; "MAT_COMPONENT",MAT_COMPONENT; "MAT_EQ",MAT_EQ; "MAX",MAX; "MAXIMAL_AFFINE_INDEPENDENT_SUBSET",MAXIMAL_AFFINE_INDEPENDENT_SUBSET; "MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE",MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE; "MAXIMAL_INDEPENDENT_SUBSET",MAXIMAL_INDEPENDENT_SUBSET; "MAXIMAL_INDEPENDENT_SUBSET_EXTEND",MAXIMAL_INDEPENDENT_SUBSET_EXTEND; "MBALL_EMPTY",MBALL_EMPTY; "MBALL_EMPTY_ALT",MBALL_EMPTY_ALT; "MBALL_EQ_EMPTY",MBALL_EQ_EMPTY; "MBALL_EUCLIDEAN",MBALL_EUCLIDEAN; "MBALL_SUBMETRIC",MBALL_SUBMETRIC; "MBALL_SUBSET",MBALL_SUBSET; "MBALL_SUBSET_CONCENTRIC",MBALL_SUBSET_CONCENTRIC; "MBALL_SUBSET_MCBALL",MBALL_SUBSET_MCBALL; "MBALL_SUBSET_MSPACE",MBALL_SUBSET_MSPACE; "MBASIS_COMPONENT",MBASIS_COMPONENT; "MBASIS_EQ_0",MBASIS_EQ_0; "MBASIS_EXPANSION",MBASIS_EXPANSION; "MBASIS_EXTENSION",MBASIS_EXTENSION; "MBASIS_NONZERO",MBASIS_NONZERO; "MBASIS_SPLIT",MBASIS_SPLIT; "MBOUNDED",MBOUNDED; "MBOUNDED_EMPTY",MBOUNDED_EMPTY; "MBOUNDED_EQ_BOUNDED",MBOUNDED_EQ_BOUNDED; "MBOUNDED_IFF_FINITE_DIAMETER",MBOUNDED_IFF_FINITE_DIAMETER; "MBOUNDED_INSERT",MBOUNDED_INSERT; "MBOUNDED_INTER",MBOUNDED_INTER; "MBOUNDED_MBALL",MBOUNDED_MBALL; "MBOUNDED_MCBALL",MBOUNDED_MCBALL; "MBOUNDED_SUBMETRIC",MBOUNDED_SUBMETRIC; "MBOUNDED_SUBSET",MBOUNDED_SUBSET; "MBOUNDED_SUBSET_MSPACE",MBOUNDED_SUBSET_MSPACE; "MBOUNDED_UNION",MBOUNDED_UNION; "MCBALL_EMPTY",MCBALL_EMPTY; "MCBALL_EMPTY_ALT",MCBALL_EMPTY_ALT; "MCBALL_EUCLIDEAN",MCBALL_EUCLIDEAN; "MCBALL_SUBMETRIC",MCBALL_SUBMETRIC; "MCBALL_SUBSET",MCBALL_SUBSET; "MCBALL_SUBSET_CONCENTRIC",MCBALL_SUBSET_CONCENTRIC; "MCBALL_SUBSET_MBALL",MCBALL_SUBSET_MBALL; "MCBALL_SUBSET_MBALL_CONCENTRIC",MCBALL_SUBSET_MBALL_CONCENTRIC; "MCBALL_SUBSET_MSPACE",MCBALL_SUBSET_MSPACE; "MCOMPLETE_CFUNSPACE",MCOMPLETE_CFUNSPACE; "MCOMPLETE_EUCLIDEAN",MCOMPLETE_EUCLIDEAN; "MCOMPLETE_FUNSPACE",MCOMPLETE_FUNSPACE; "MDIST",MDIST; "MDIST_0",MDIST_0; "MDIST_CFUNSPACE_EQ_MDIST_FUNSPACE",MDIST_CFUNSPACE_EQ_MDIST_FUNSPACE; "MDIST_CFUNSPACE_IMP_MDIST_LE",MDIST_CFUNSPACE_IMP_MDIST_LE; "MDIST_CFUNSPACE_LE",MDIST_CFUNSPACE_LE; "MDIST_POS_LE",MDIST_POS_LE; "MDIST_POS_LT",MDIST_POS_LT; "MDIST_REFL",MDIST_REFL; "MDIST_REVERSE_TRIANGLE",MDIST_REVERSE_TRIANGLE; "MDIST_SYM",MDIST_SYM; "MDIST_TRIANGLE",MDIST_TRIANGLE; "MEASURABLE",MEASURABLE; "MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE",MEASURABLE_ABSOLUTELY_CONTINUOUS_IMAGE; "MEASURABLE_ADDITIVE_IMP_LINEAR",MEASURABLE_ADDITIVE_IMP_LINEAR; "MEASURABLE_AFFINITY",MEASURABLE_AFFINITY; "MEASURABLE_AFFINITY_EQ",MEASURABLE_AFFINITY_EQ; "MEASURABLE_ALMOST",MEASURABLE_ALMOST; "MEASURABLE_BALL",MEASURABLE_BALL; "MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE; "MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; "MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE; "MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE; "MEASURABLE_BOUNDED_DIFFERENTIABLE_IMAGE",MEASURABLE_BOUNDED_DIFFERENTIABLE_IMAGE; "MEASURABLE_CBALL",MEASURABLE_CBALL; "MEASURABLE_CLOSED_IN",MEASURABLE_CLOSED_IN; "MEASURABLE_CLOSURE",MEASURABLE_CLOSURE; "MEASURABLE_COMPACT",MEASURABLE_COMPACT; "MEASURABLE_CONTINUOUS_COMPOSE",MEASURABLE_CONTINUOUS_COMPOSE; "MEASURABLE_CONVEX",MEASURABLE_CONVEX; "MEASURABLE_CONVEX_EQ",MEASURABLE_CONVEX_EQ; "MEASURABLE_CONVEX_HULL",MEASURABLE_CONVEX_HULL; "MEASURABLE_COUNTABLE_INTERS",MEASURABLE_COUNTABLE_INTERS; "MEASURABLE_COUNTABLE_INTERS_GEN",MEASURABLE_COUNTABLE_INTERS_GEN; "MEASURABLE_COUNTABLE_UNIONS",MEASURABLE_COUNTABLE_UNIONS; "MEASURABLE_COUNTABLE_UNIONS_BOUNDED",MEASURABLE_COUNTABLE_UNIONS_BOUNDED; "MEASURABLE_COUNTABLE_UNIONS_STRONG",MEASURABLE_COUNTABLE_UNIONS_STRONG; "MEASURABLE_DELETE",MEASURABLE_DELETE; "MEASURABLE_DIFF",MEASURABLE_DIFF; "MEASURABLE_DIFFERENTIABLE_IMAGE",MEASURABLE_DIFFERENTIABLE_IMAGE; "MEASURABLE_DIFFERENTIABLE_IMAGE_ALT",MEASURABLE_DIFFERENTIABLE_IMAGE_ALT; "MEASURABLE_DIFFERENTIABLE_IMAGE_EQ",MEASURABLE_DIFFERENTIABLE_IMAGE_EQ; "MEASURABLE_ELEMENTARY",MEASURABLE_ELEMENTARY; "MEASURABLE_EMPTY",MEASURABLE_EMPTY; "MEASURABLE_FRONTIER",MEASURABLE_FRONTIER; "MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE",MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE; "MEASURABLE_IMP_LEBESGUE_MEASURABLE",MEASURABLE_IMP_LEBESGUE_MEASURABLE; "MEASURABLE_INNER_COMPACT",MEASURABLE_INNER_COMPACT; "MEASURABLE_INNER_OUTER",MEASURABLE_INNER_OUTER; "MEASURABLE_INSERT",MEASURABLE_INSERT; "MEASURABLE_INSIDE",MEASURABLE_INSIDE; "MEASURABLE_INTEGRABLE",MEASURABLE_INTEGRABLE; "MEASURABLE_INTER",MEASURABLE_INTER; "MEASURABLE_INTERIOR",MEASURABLE_INTERIOR; "MEASURABLE_INTERVAL",MEASURABLE_INTERVAL; "MEASURABLE_INTER_HALFSPACE_GE",MEASURABLE_INTER_HALFSPACE_GE; "MEASURABLE_INTER_HALFSPACE_LE",MEASURABLE_INTER_HALFSPACE_LE; "MEASURABLE_INTER_INTERVAL",MEASURABLE_INTER_INTERVAL; "MEASURABLE_JORDAN",MEASURABLE_JORDAN; "MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE",MEASURABLE_LEBESGUE_MEASURABLE_INTER_MEASURABLE; "MEASURABLE_LEBESGUE_MEASURABLE_SUBSET",MEASURABLE_LEBESGUE_MEASURABLE_SUBSET; "MEASURABLE_LINEAR_IMAGE",MEASURABLE_LINEAR_IMAGE; "MEASURABLE_LINEAR_IMAGE_EQ",MEASURABLE_LINEAR_IMAGE_EQ; "MEASURABLE_LINEAR_IMAGE_EQ_GEN",MEASURABLE_LINEAR_IMAGE_EQ_GEN; "MEASURABLE_LINEAR_IMAGE_GEN",MEASURABLE_LINEAR_IMAGE_GEN; "MEASURABLE_LINEAR_IMAGE_INTERVAL",MEASURABLE_LINEAR_IMAGE_INTERVAL; "MEASURABLE_LIPSCHITZ_IMAGE",MEASURABLE_LIPSCHITZ_IMAGE; "MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE",MEASURABLE_LOCALLY_LIPSCHITZ_IMAGE; "MEASURABLE_MEASURABLE_DIFF_LEBESGUE_MEASURABLE",MEASURABLE_MEASURABLE_DIFF_LEBESGUE_MEASURABLE; "MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE",MEASURABLE_MEASURABLE_INTER_LEBESGUE_MEASURABLE; "MEASURABLE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_MEASURABLE_PREIMAGE_CLOSED; "MEASURABLE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_MEASURABLE_PREIMAGE_OPEN; "MEASURABLE_MEASURE_EQ_0",MEASURABLE_MEASURE_EQ_0; "MEASURABLE_MEASURE_POS_LT",MEASURABLE_MEASURE_POS_LT; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONTINUOUS",MEASURABLE_MIDPOINT_CONVEX_IMP_CONTINUOUS; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_1D",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_1D; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_CBALL",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_CBALL; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_GEN; "MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_OPEN",MEASURABLE_MIDPOINT_CONVEX_IMP_CONVEX_OPEN; "MEASURABLE_NEGLIGIBLE_SYMDIFF",MEASURABLE_NEGLIGIBLE_SYMDIFF; "MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ",MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ; "MEASURABLE_NESTED_UNIONS",MEASURABLE_NESTED_UNIONS; "MEASURABLE_NONNEGLIGIBLE_IMP_LARGE",MEASURABLE_NONNEGLIGIBLE_IMP_LARGE; "MEASURABLE_ON_0",MEASURABLE_ON_0; "MEASURABLE_ON_ADD",MEASURABLE_ON_ADD; "MEASURABLE_ON_BANACH_INDICATRIX",MEASURABLE_ON_BANACH_INDICATRIX; "MEASURABLE_ON_BILINEAR",MEASURABLE_ON_BILINEAR; "MEASURABLE_ON_CASES",MEASURABLE_ON_CASES; "MEASURABLE_ON_CMUL",MEASURABLE_ON_CMUL; "MEASURABLE_ON_CMUL_EQ",MEASURABLE_ON_CMUL_EQ; "MEASURABLE_ON_COMBINE",MEASURABLE_ON_COMBINE; "MEASURABLE_ON_COMPONENTWISE",MEASURABLE_ON_COMPONENTWISE; "MEASURABLE_ON_COMPOSE_ALT",MEASURABLE_ON_COMPOSE_ALT; "MEASURABLE_ON_COMPOSE_CONTINUOUS",MEASURABLE_ON_COMPOSE_CONTINUOUS; "MEASURABLE_ON_COMPOSE_CONTINUOUS_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_0; "MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET; "MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0; "MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL",MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL; "MEASURABLE_ON_COMPOSE_FSTCART",MEASURABLE_ON_COMPOSE_FSTCART; "MEASURABLE_ON_COMPOSE_GEN",MEASURABLE_ON_COMPOSE_GEN; "MEASURABLE_ON_COMPOSE_REV",MEASURABLE_ON_COMPOSE_REV; "MEASURABLE_ON_COMPOSE_SNDCART",MEASURABLE_ON_COMPOSE_SNDCART; "MEASURABLE_ON_COMPOSE_SUB",MEASURABLE_ON_COMPOSE_SUB; "MEASURABLE_ON_CONST",MEASURABLE_ON_CONST; "MEASURABLE_ON_CONST_EQ",MEASURABLE_ON_CONST_EQ; "MEASURABLE_ON_CONTINUOUS_COMPOSE",MEASURABLE_ON_CONTINUOUS_COMPOSE; "MEASURABLE_ON_CONTINUOUS_COMPOSE_REV",MEASURABLE_ON_CONTINUOUS_COMPOSE_REV; "MEASURABLE_ON_CONVOLUTION",MEASURABLE_ON_CONVOLUTION; "MEASURABLE_ON_COUNTABLE_UNIONS",MEASURABLE_ON_COUNTABLE_UNIONS; "MEASURABLE_ON_DET_JACOBIAN",MEASURABLE_ON_DET_JACOBIAN; "MEASURABLE_ON_DIFF",MEASURABLE_ON_DIFF; "MEASURABLE_ON_DIFFERENTIABLE_IMAGE",MEASURABLE_ON_DIFFERENTIABLE_IMAGE; "MEASURABLE_ON_DROP_MUL",MEASURABLE_ON_DROP_MUL; "MEASURABLE_ON_EMPTY",MEASURABLE_ON_EMPTY; "MEASURABLE_ON_EQ",MEASURABLE_ON_EQ; "MEASURABLE_ON_INDICATOR",MEASURABLE_ON_INDICATOR; "MEASURABLE_ON_INDICATOR_SUBSET",MEASURABLE_ON_INDICATOR_SUBSET; "MEASURABLE_ON_INTER",MEASURABLE_ON_INTER; "MEASURABLE_ON_INVERSE_FUNCTION",MEASURABLE_ON_INVERSE_FUNCTION; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_ANALYTIC_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ; "MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL; "MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; "MEASURABLE_ON_LEFT_INVERSE",MEASURABLE_ON_LEFT_INVERSE; "MEASURABLE_ON_LIFT_ABS",MEASURABLE_ON_LIFT_ABS; "MEASURABLE_ON_LIFT_DIV",MEASURABLE_ON_LIFT_DIV; "MEASURABLE_ON_LIFT_INV",MEASURABLE_ON_LIFT_INV; "MEASURABLE_ON_LIFT_MUL",MEASURABLE_ON_LIFT_MUL; "MEASURABLE_ON_LIFT_PRODUCT",MEASURABLE_ON_LIFT_PRODUCT; "MEASURABLE_ON_LIMIT",MEASURABLE_ON_LIMIT; "MEASURABLE_ON_LINEAR_IMAGE_EQ",MEASURABLE_ON_LINEAR_IMAGE_EQ; "MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN",MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN; "MEASURABLE_ON_MAX",MEASURABLE_ON_MAX; "MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED; "MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ; "MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; "MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; "MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN; "MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ; "MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL; "MEASURABLE_ON_MEASURABLE_SUBSET",MEASURABLE_ON_MEASURABLE_SUBSET; "MEASURABLE_ON_MIN",MEASURABLE_ON_MIN; "MEASURABLE_ON_MUL",MEASURABLE_ON_MUL; "MEASURABLE_ON_NEG",MEASURABLE_ON_NEG; "MEASURABLE_ON_NEG_EQ",MEASURABLE_ON_NEG_EQ; "MEASURABLE_ON_NORM",MEASURABLE_ON_NORM; "MEASURABLE_ON_PARTIAL_DERIVATIVES",MEASURABLE_ON_PARTIAL_DERIVATIVES; "MEASURABLE_ON_PASTECART",MEASURABLE_ON_PASTECART; "MEASURABLE_ON_PREIMAGE_ANALYTIC",MEASURABLE_ON_PREIMAGE_ANALYTIC; "MEASURABLE_ON_PREIMAGE_BOREL",MEASURABLE_ON_PREIMAGE_BOREL; "MEASURABLE_ON_PREIMAGE_CLOSED",MEASURABLE_ON_PREIMAGE_CLOSED; "MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; "MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT; "MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE; "MEASURABLE_ON_PREIMAGE_OPEN",MEASURABLE_ON_PREIMAGE_OPEN; "MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; "MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_GE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE; "MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_GT",MEASURABLE_ON_PREIMAGE_ORTHANT_GT; "MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_LE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE; "MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE; "MEASURABLE_ON_PREIMAGE_ORTHANT_LT",MEASURABLE_ON_PREIMAGE_ORTHANT_LT; "MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE; "MEASURABLE_ON_REAL_SGN",MEASURABLE_ON_REAL_SGN; "MEASURABLE_ON_REFLECT",MEASURABLE_ON_REFLECT; "MEASURABLE_ON_RESTRICT",MEASURABLE_ON_RESTRICT; "MEASURABLE_ON_RIGHT_INVERSE",MEASURABLE_ON_RIGHT_INVERSE; "MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT; "MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING; "MEASURABLE_ON_SPIKE",MEASURABLE_ON_SPIKE; "MEASURABLE_ON_SPIKE_SET",MEASURABLE_ON_SPIKE_SET; "MEASURABLE_ON_SUB",MEASURABLE_ON_SUB; "MEASURABLE_ON_TRANSLATION",MEASURABLE_ON_TRANSLATION; "MEASURABLE_ON_TRANSLATION_EQ",MEASURABLE_ON_TRANSLATION_EQ; "MEASURABLE_ON_UNION",MEASURABLE_ON_UNION; "MEASURABLE_ON_UNIONS",MEASURABLE_ON_UNIONS; "MEASURABLE_ON_UNIV",MEASURABLE_ON_UNIV; "MEASURABLE_ON_VECTOR_DERIVATIVE",MEASURABLE_ON_VECTOR_DERIVATIVE; "MEASURABLE_ON_VECTOR_DERIVATIVE_GEN",MEASURABLE_ON_VECTOR_DERIVATIVE_GEN; "MEASURABLE_ON_VSUM",MEASURABLE_ON_VSUM; "MEASURABLE_OPEN",MEASURABLE_OPEN; "MEASURABLE_OPEN_IN",MEASURABLE_OPEN_IN; "MEASURABLE_OUTER_CLOSED_INTERVALS",MEASURABLE_OUTER_CLOSED_INTERVALS; "MEASURABLE_OUTER_INTERVALS_BOUNDED",MEASURABLE_OUTER_INTERVALS_BOUNDED; "MEASURABLE_OUTER_OPEN",MEASURABLE_OUTER_OPEN; "MEASURABLE_OUTER_OPEN_INTERVALS",MEASURABLE_OUTER_OPEN_INTERVALS; "MEASURABLE_PCROSS",MEASURABLE_PCROSS; "MEASURABLE_SCALING",MEASURABLE_SCALING; "MEASURABLE_SCALING_EQ",MEASURABLE_SCALING_EQ; "MEASURABLE_SEGMENT",MEASURABLE_SEGMENT; "MEASURABLE_SIMPLEX",MEASURABLE_SIMPLEX; "MEASURABLE_SING",MEASURABLE_SING; "MEASURABLE_SMALL_IMP_NEGLIGIBLE",MEASURABLE_SMALL_IMP_NEGLIGIBLE; "MEASURABLE_TETRAHEDRON",MEASURABLE_TETRAHEDRON; "MEASURABLE_TRANSLATION",MEASURABLE_TRANSLATION; "MEASURABLE_TRANSLATION_EQ",MEASURABLE_TRANSLATION_EQ; "MEASURABLE_TRIANGLE",MEASURABLE_TRIANGLE; "MEASURABLE_UNION",MEASURABLE_UNION; "MEASURABLE_UNIONS",MEASURABLE_UNIONS; "MEASURE",MEASURE; "MEASURE_AFFINITY",MEASURE_AFFINITY; "MEASURE_BALL_BOUND",MEASURE_BALL_BOUND; "MEASURE_BALL_POS",MEASURE_BALL_POS; "MEASURE_BALL_SCALING",MEASURE_BALL_SCALING; "MEASURE_BOUNDED_DIFFERENTIABLE_IMAGE",MEASURE_BOUNDED_DIFFERENTIABLE_IMAGE; "MEASURE_CBALL_BOUND",MEASURE_CBALL_BOUND; "MEASURE_CBALL_POS",MEASURE_CBALL_POS; "MEASURE_CBALL_SCALING",MEASURE_CBALL_SCALING; "MEASURE_CLOSURE",MEASURE_CLOSURE; "MEASURE_CONTINUOUS_WITH_HAUSDIST",MEASURE_CONTINUOUS_WITH_HAUSDIST; "MEASURE_CONTINUOUS_WITH_HAUSDIST_EXPLICIT",MEASURE_CONTINUOUS_WITH_HAUSDIST_EXPLICIT; "MEASURE_COUNTABLE_UNIONS_APPROACHABLE",MEASURE_COUNTABLE_UNIONS_APPROACHABLE; "MEASURE_COUNTABLE_UNIONS_LE",MEASURE_COUNTABLE_UNIONS_LE; "MEASURE_COUNTABLE_UNIONS_LE_GEN",MEASURE_COUNTABLE_UNIONS_LE_GEN; "MEASURE_COUNTABLE_UNIONS_LE_STRONG",MEASURE_COUNTABLE_UNIONS_LE_STRONG; "MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN",MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN; "MEASURE_DELETE",MEASURE_DELETE; "MEASURE_DIFFERENTIABLE_IMAGE",MEASURE_DIFFERENTIABLE_IMAGE; "MEASURE_DIFFERENTIABLE_IMAGE_EQ",MEASURE_DIFFERENTIABLE_IMAGE_EQ; "MEASURE_DIFF_SUBSET",MEASURE_DIFF_SUBSET; "MEASURE_DISJOINT_UNION",MEASURE_DISJOINT_UNION; "MEASURE_DISJOINT_UNIONS",MEASURE_DISJOINT_UNIONS; "MEASURE_DISJOINT_UNIONS_IMAGE",MEASURE_DISJOINT_UNIONS_IMAGE; "MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; "MEASURE_DISJOINT_UNION_EQ",MEASURE_DISJOINT_UNION_EQ; "MEASURE_ELEMENTARY",MEASURE_ELEMENTARY; "MEASURE_EMPTY",MEASURE_EMPTY; "MEASURE_EQ_0",MEASURE_EQ_0; "MEASURE_FRONTIER",MEASURE_FRONTIER; "MEASURE_INSERT",MEASURE_INSERT; "MEASURE_INTEGRAL",MEASURE_INTEGRAL; "MEASURE_INTEGRAL_UNIV",MEASURE_INTEGRAL_UNIV; "MEASURE_INTERIOR",MEASURE_INTERIOR; "MEASURE_INTERVAL",MEASURE_INTERVAL; "MEASURE_INTERVAL_1",MEASURE_INTERVAL_1; "MEASURE_INTERVAL_1_ALT",MEASURE_INTERVAL_1_ALT; "MEASURE_INTERVAL_2",MEASURE_INTERVAL_2; "MEASURE_INTERVAL_2_ALT",MEASURE_INTERVAL_2_ALT; "MEASURE_INTERVAL_3",MEASURE_INTERVAL_3; "MEASURE_INTERVAL_3_ALT",MEASURE_INTERVAL_3_ALT; "MEASURE_INTERVAL_4",MEASURE_INTERVAL_4; "MEASURE_INTERVAL_4_ALT",MEASURE_INTERVAL_4_ALT; "MEASURE_ISOMETRY",MEASURE_ISOMETRY; "MEASURE_LE",MEASURE_LE; "MEASURE_LIMIT",MEASURE_LIMIT; "MEASURE_LINEAR_IMAGE",MEASURE_LINEAR_IMAGE; "MEASURE_LINEAR_IMAGE_SAME",MEASURE_LINEAR_IMAGE_SAME; "MEASURE_LIPSCHITZ_IMAGE",MEASURE_LIPSCHITZ_IMAGE; "MEASURE_LOCALLY_LIPSCHITZ_IMAGE",MEASURE_LOCALLY_LIPSCHITZ_IMAGE; "MEASURE_NEGLIGIBLE_SYMDIFF",MEASURE_NEGLIGIBLE_SYMDIFF; "MEASURE_NEGLIGIBLE_UNION",MEASURE_NEGLIGIBLE_UNION; "MEASURE_NEGLIGIBLE_UNIONS",MEASURE_NEGLIGIBLE_UNIONS; "MEASURE_NEGLIGIBLE_UNIONS_IMAGE",MEASURE_NEGLIGIBLE_UNIONS_IMAGE; "MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; "MEASURE_NEGLIGIBLE_UNION_EQ",MEASURE_NEGLIGIBLE_UNION_EQ; "MEASURE_OPEN_POS_LT",MEASURE_OPEN_POS_LT; "MEASURE_OPEN_POS_LT_EQ",MEASURE_OPEN_POS_LT_EQ; "MEASURE_ORTHOGONAL_IMAGE_EQ",MEASURE_ORTHOGONAL_IMAGE_EQ; "MEASURE_PCROSS",MEASURE_PCROSS; "MEASURE_POS_LE",MEASURE_POS_LE; "MEASURE_SCALING",MEASURE_SCALING; "MEASURE_SEGMENT_1",MEASURE_SEGMENT_1; "MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_BOUND",MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_BOUND; "MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_EXPLICIT",MEASURE_SEMICONTINUOUS_WITH_HAUSDIST_EXPLICIT; "MEASURE_SIMPLEX",MEASURE_SIMPLEX; "MEASURE_SING",MEASURE_SING; "MEASURE_SUBSET",MEASURE_SUBSET; "MEASURE_SUB_LE_MEASURE_DIFF",MEASURE_SUB_LE_MEASURE_DIFF; "MEASURE_SUB_LE_MEASURE_SYMDIFF",MEASURE_SUB_LE_MEASURE_SYMDIFF; "MEASURE_TETRAHEDRON",MEASURE_TETRAHEDRON; "MEASURE_TRANSLATION",MEASURE_TRANSLATION; "MEASURE_TRIANGLE",MEASURE_TRIANGLE; "MEASURE_UNION",MEASURE_UNION; "MEASURE_UNIONS_LE",MEASURE_UNIONS_LE; "MEASURE_UNIONS_LE_IMAGE",MEASURE_UNIONS_LE_IMAGE; "MEASURE_UNION_LE",MEASURE_UNION_LE; "MEASURE_UNIQUE",MEASURE_UNIQUE; "MEM",MEM; "MEMBER_NOT_EMPTY",MEMBER_NOT_EMPTY; "MEM_APPEND",MEM_APPEND; "MEM_APPEND_DECOMPOSE",MEM_APPEND_DECOMPOSE; "MEM_APPEND_DECOMPOSE_LEFT",MEM_APPEND_DECOMPOSE_LEFT; "MEM_ASSOC",MEM_ASSOC; "MEM_EL",MEM_EL; "MEM_EXISTS_EL",MEM_EXISTS_EL; "MEM_FILTER",MEM_FILTER; "MEM_LINEAR_IMAGE",MEM_LINEAR_IMAGE; "MEM_LIST_OF_SET",MEM_LIST_OF_SET; "MEM_MAP",MEM_MAP; "MEM_TRANSLATION",MEM_TRANSLATION; "METRIC",METRIC; "METRIC_BAIRE_CATEGORY",METRIC_BAIRE_CATEGORY; "METRIC_CLOSED_IN_IFF_SEQUENTIALLY_CLOSED",METRIC_CLOSED_IN_IFF_SEQUENTIALLY_CLOSED; "METRIC_CLOSURE_OF",METRIC_CLOSURE_OF; "METRIC_DERIVED_SET_OF",METRIC_DERIVED_SET_OF; "METRIC_TOPCONTINUOUS",METRIC_TOPCONTINUOUS; "MIDPOINTS_IN_CONVEX_HULL",MIDPOINTS_IN_CONVEX_HULL; "MIDPOINT_BETWEEN",MIDPOINT_BETWEEN; "MIDPOINT_COLLINEAR",MIDPOINT_COLLINEAR; "MIDPOINT_CONVEX_DYADIC_RATIONALS",MIDPOINT_CONVEX_DYADIC_RATIONALS; "MIDPOINT_CONVEX_IMP_CONTINUOUS_OSTROWSKI",MIDPOINT_CONVEX_IMP_CONTINUOUS_OSTROWSKI; "MIDPOINT_CONVEX_IMP_CONVEX_OSTROWSKI",MIDPOINT_CONVEX_IMP_CONVEX_OSTROWSKI; "MIDPOINT_CONVEX_SET",MIDPOINT_CONVEX_SET; "MIDPOINT_EQ_ENDPOINT",MIDPOINT_EQ_ENDPOINT; "MIDPOINT_IN_CONVEX",MIDPOINT_IN_CONVEX; "MIDPOINT_IN_SEGMENT",MIDPOINT_IN_SEGMENT; "MIDPOINT_LINEAR_IMAGE",MIDPOINT_LINEAR_IMAGE; "MIDPOINT_REFL",MIDPOINT_REFL; "MIDPOINT_SYM",MIDPOINT_SYM; "MIN",MIN; "MINIMAL",MINIMAL; "MINIMAL_CONTINUUM",MINIMAL_CONTINUUM; "MINIMAL_IN_INSERT",MINIMAL_IN_INSERT; "MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER",MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER; "MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER_ELEMENTWISE",MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER_ELEMENTWISE; "MK_REC_INJ",MK_REC_INJ; "MOD_0",MOD_0; "MOD_1",MOD_1; "MOD_ADD_MOD",MOD_ADD_MOD; "MOD_EQ",MOD_EQ; "MOD_EQ_0",MOD_EQ_0; "MOD_EXISTS",MOD_EXISTS; "MOD_EXP_MOD",MOD_EXP_MOD; "MOD_LE",MOD_LE; "MOD_LT",MOD_LT; "MOD_MOD",MOD_MOD; "MOD_MOD_EXP_MIN",MOD_MOD_EXP_MIN; "MOD_MOD_REFL",MOD_MOD_REFL; "MOD_MULT",MOD_MULT; "MOD_MULT2",MOD_MULT2; "MOD_MULT_ADD",MOD_MULT_ADD; "MOD_MULT_LMOD",MOD_MULT_LMOD; "MOD_MULT_MOD2",MOD_MULT_MOD2; "MOD_MULT_RMOD",MOD_MULT_RMOD; "MOD_NSUM_MOD",MOD_NSUM_MOD; "MOD_NSUM_MOD_NUMSEG",MOD_NSUM_MOD_NUMSEG; "MOD_REFL",MOD_REFL; "MOD_UNIQ",MOD_UNIQ; "MONOIDAL_AC",MONOIDAL_AC; "MONOIDAL_ADD",MONOIDAL_ADD; "MONOIDAL_AND",MONOIDAL_AND; "MONOIDAL_LIFTED",MONOIDAL_LIFTED; "MONOIDAL_MUL",MONOIDAL_MUL; "MONOIDAL_REAL_ADD",MONOIDAL_REAL_ADD; "MONOIDAL_REAL_MUL",MONOIDAL_REAL_MUL; "MONOIDAL_VECTOR_ADD",MONOIDAL_VECTOR_ADD; "MONOTONE_BIGGER",MONOTONE_BIGGER; "MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP",MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP; "MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP_GEN",MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP_GEN; "MONOTONE_CONVERGENCE_DECREASING",MONOTONE_CONVERGENCE_DECREASING; "MONOTONE_CONVERGENCE_DECREASING_AE",MONOTONE_CONVERGENCE_DECREASING_AE; "MONOTONE_CONVERGENCE_INCREASING",MONOTONE_CONVERGENCE_INCREASING; "MONOTONE_CONVERGENCE_INCREASING_AE",MONOTONE_CONVERGENCE_INCREASING_AE; "MONOTONE_CONVERGENCE_INTERVAL",MONOTONE_CONVERGENCE_INTERVAL; "MONOTONE_IMP_HOMEOMORPHISM_1D",MONOTONE_IMP_HOMEOMORPHISM_1D; "MONOTONE_INTO_1D_IMP_PROPER_MAP",MONOTONE_INTO_1D_IMP_PROPER_MAP; "MONOTONE_SUBSEQUENCE",MONOTONE_SUBSEQUENCE; "MONOTONE_TOPOLOGICALLY",MONOTONE_TOPOLOGICALLY; "MONOTONE_TOPOLOGICALLY_EQ",MONOTONE_TOPOLOGICALLY_EQ; "MONOTONE_TOPOLOGICALLY_IMP",MONOTONE_TOPOLOGICALLY_IMP; "MONOTONE_TOPOLOGICALLY_INTO_1D",MONOTONE_TOPOLOGICALLY_INTO_1D; "MONOTONE_TOPOLOGICALLY_INTO_1D_EQ",MONOTONE_TOPOLOGICALLY_INTO_1D_EQ; "MONOTONE_TOPOLOGICALLY_POINTS",MONOTONE_TOPOLOGICALLY_POINTS; "MONOTONE_TOPOLOGICALLY_POINTS_IMP",MONOTONE_TOPOLOGICALLY_POINTS_IMP; "MONO_ALL",MONO_ALL; "MONO_ALL2",MONO_ALL2; "MONO_AND",MONO_AND; "MONO_COND",MONO_COND; "MONO_EXISTS",MONO_EXISTS; "MONO_FORALL",MONO_FORALL; "MONO_IMP",MONO_IMP; "MONO_NOT",MONO_NOT; "MONO_OR",MONO_OR; "MOORE_PENROSE_PSEUDOINVERSE",MOORE_PENROSE_PSEUDOINVERSE; "MOORE_PENROSE_PSEUDOINVERSE_UNIQUE",MOORE_PENROSE_PSEUDOINVERSE_UNIQUE; "MSPACE",MSPACE; "MTOPOLOGY_EUCLIDEAN_METRIC",MTOPOLOGY_EUCLIDEAN_METRIC; "MTOPOLOGY_SUBMETRIC",MTOPOLOGY_SUBMETRIC; "MULT",MULT; "MULTIPART_MEASURES",MULTIPART_MEASURES; "MULTIVECTOR_ADD_COMPONENT",MULTIVECTOR_ADD_COMPONENT; "MULTIVECTOR_BETA",MULTIVECTOR_BETA; "MULTIVECTOR_EQ",MULTIVECTOR_EQ; "MULTIVECTOR_ETA",MULTIVECTOR_ETA; "MULTIVECTOR_GRADE",MULTIVECTOR_GRADE; "MULTIVECTOR_IMAGE",MULTIVECTOR_IMAGE; "MULTIVECTOR_MUL_COMPONENT",MULTIVECTOR_MUL_COMPONENT; "MULTIVECTOR_UNIQUE",MULTIVECTOR_UNIQUE; "MULTIVECTOR_VEC_COMPONENT",MULTIVECTOR_VEC_COMPONENT; "MULTIVECTOR_VSUM",MULTIVECTOR_VSUM; "MULTIVECTOR_VSUM_COMPONENT",MULTIVECTOR_VSUM_COMPONENT; "MULT_0",MULT_0; "MULT_2",MULT_2; "MULT_AC",MULT_AC; "MULT_ASSOC",MULT_ASSOC; "MULT_CLAUSES",MULT_CLAUSES; "MULT_DIV_LE",MULT_DIV_LE; "MULT_EQ_0",MULT_EQ_0; "MULT_EQ_1",MULT_EQ_1; "MULT_EXP",MULT_EXP; "MULT_SUC",MULT_SUC; "MULT_SYM",MULT_SYM; "MUL_C_UNIV",MUL_C_UNIV; "MUMFORD_LEMMA",MUMFORD_LEMMA; "MVT",MVT; "MVT_GENERAL",MVT_GENERAL; "MVT_SEGMENT",MVT_SEGMENT; "MVT_SEGMENT_SIMPLE",MVT_SEGMENT_SIMPLE; "MVT_SIMPLE",MVT_SIMPLE; "MVT_VERY_SIMPLE",MVT_VERY_SIMPLE; "NADD_ADD",NADD_ADD; "NADD_ADDITIVE",NADD_ADDITIVE; "NADD_ADD_ASSOC",NADD_ADD_ASSOC; "NADD_ADD_LCANCEL",NADD_ADD_LCANCEL; "NADD_ADD_LID",NADD_ADD_LID; "NADD_ADD_SYM",NADD_ADD_SYM; "NADD_ADD_WELLDEF",NADD_ADD_WELLDEF; "NADD_ALTMUL",NADD_ALTMUL; "NADD_ARCH",NADD_ARCH; "NADD_ARCH_LEMMA",NADD_ARCH_LEMMA; "NADD_ARCH_MULT",NADD_ARCH_MULT; "NADD_ARCH_ZERO",NADD_ARCH_ZERO; "NADD_BOUND",NADD_BOUND; "NADD_CAUCHY",NADD_CAUCHY; "NADD_COMPLETE",NADD_COMPLETE; "NADD_DIST",NADD_DIST; "NADD_DIST_LEMMA",NADD_DIST_LEMMA; "NADD_EQ_IMP_LE",NADD_EQ_IMP_LE; "NADD_EQ_REFL",NADD_EQ_REFL; "NADD_EQ_SYM",NADD_EQ_SYM; "NADD_EQ_TRANS",NADD_EQ_TRANS; "NADD_INV",NADD_INV; "NADD_INV_0",NADD_INV_0; "NADD_INV_WELLDEF",NADD_INV_WELLDEF; "NADD_LBOUND",NADD_LBOUND; "NADD_LDISTRIB",NADD_LDISTRIB; "NADD_LE_0",NADD_LE_0; "NADD_LE_ADD",NADD_LE_ADD; "NADD_LE_ANTISYM",NADD_LE_ANTISYM; "NADD_LE_EXISTS",NADD_LE_EXISTS; "NADD_LE_LADD",NADD_LE_LADD; "NADD_LE_LMUL",NADD_LE_LMUL; "NADD_LE_RADD",NADD_LE_RADD; "NADD_LE_REFL",NADD_LE_REFL; "NADD_LE_RMUL",NADD_LE_RMUL; "NADD_LE_TOTAL",NADD_LE_TOTAL; "NADD_LE_TOTAL_LEMMA",NADD_LE_TOTAL_LEMMA; "NADD_LE_TRANS",NADD_LE_TRANS; "NADD_LE_WELLDEF",NADD_LE_WELLDEF; "NADD_LE_WELLDEF_LEMMA",NADD_LE_WELLDEF_LEMMA; "NADD_MUL",NADD_MUL; "NADD_MULTIPLICATIVE",NADD_MULTIPLICATIVE; "NADD_MUL_ASSOC",NADD_MUL_ASSOC; "NADD_MUL_LID",NADD_MUL_LID; "NADD_MUL_LINV",NADD_MUL_LINV; "NADD_MUL_LINV_LEMMA0",NADD_MUL_LINV_LEMMA0; "NADD_MUL_LINV_LEMMA1",NADD_MUL_LINV_LEMMA1; "NADD_MUL_LINV_LEMMA2",NADD_MUL_LINV_LEMMA2; "NADD_MUL_LINV_LEMMA3",NADD_MUL_LINV_LEMMA3; "NADD_MUL_LINV_LEMMA4",NADD_MUL_LINV_LEMMA4; "NADD_MUL_LINV_LEMMA5",NADD_MUL_LINV_LEMMA5; "NADD_MUL_LINV_LEMMA6",NADD_MUL_LINV_LEMMA6; "NADD_MUL_LINV_LEMMA7",NADD_MUL_LINV_LEMMA7; "NADD_MUL_LINV_LEMMA7a",NADD_MUL_LINV_LEMMA7a; "NADD_MUL_LINV_LEMMA8",NADD_MUL_LINV_LEMMA8; "NADD_MUL_SYM",NADD_MUL_SYM; "NADD_MUL_WELLDEF",NADD_MUL_WELLDEF; "NADD_MUL_WELLDEF_LEMMA",NADD_MUL_WELLDEF_LEMMA; "NADD_NONZERO",NADD_NONZERO; "NADD_OF_NUM",NADD_OF_NUM; "NADD_OF_NUM_ADD",NADD_OF_NUM_ADD; "NADD_OF_NUM_EQ",NADD_OF_NUM_EQ; "NADD_OF_NUM_LE",NADD_OF_NUM_LE; "NADD_OF_NUM_MUL",NADD_OF_NUM_MUL; "NADD_OF_NUM_WELLDEF",NADD_OF_NUM_WELLDEF; "NADD_RDISTRIB",NADD_RDISTRIB; "NADD_SUC",NADD_SUC; "NADD_UBOUND",NADD_UBOUND; "NEARBY_INVERTIBLE_MATRIX",NEARBY_INVERTIBLE_MATRIX; "NEARBY_INVERTIBLE_MATRIX_GEN",NEARBY_INVERTIBLE_MATRIX_GEN; "NEARBY_POSITIVE_DEFINITE_MATRIX",NEARBY_POSITIVE_DEFINITE_MATRIX; "NEARBY_POSITIVE_DEFINITE_MATRIX_GEN",NEARBY_POSITIVE_DEFINITE_MATRIX_GEN; "NEGATIONS_BALL",NEGATIONS_BALL; "NEGATIONS_CBALL",NEGATIONS_CBALL; "NEGATIONS_SPHERE",NEGATIONS_SPHERE; "NEGLIGIBLE",NEGLIGIBLE; "NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE",NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE; "NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE_LOWDIM",NEGLIGIBLE_ABSOLUTELY_CONTINUOUS_IMAGE_LOWDIM; "NEGLIGIBLE_AFFINE_HULL",NEGLIGIBLE_AFFINE_HULL; "NEGLIGIBLE_AFFINE_HULL_1",NEGLIGIBLE_AFFINE_HULL_1; "NEGLIGIBLE_AFFINE_HULL_2",NEGLIGIBLE_AFFINE_HULL_2; "NEGLIGIBLE_AFFINE_HULL_3",NEGLIGIBLE_AFFINE_HULL_3; "NEGLIGIBLE_AFFINITY",NEGLIGIBLE_AFFINITY; "NEGLIGIBLE_AFFINITY_EQ",NEGLIGIBLE_AFFINITY_EQ; "NEGLIGIBLE_BOUNDED_SUBSETS",NEGLIGIBLE_BOUNDED_SUBSETS; "NEGLIGIBLE_CONVEX_FRONTIER",NEGLIGIBLE_CONVEX_FRONTIER; "NEGLIGIBLE_CONVEX_HULL",NEGLIGIBLE_CONVEX_HULL; "NEGLIGIBLE_CONVEX_HULL_1",NEGLIGIBLE_CONVEX_HULL_1; "NEGLIGIBLE_CONVEX_HULL_2",NEGLIGIBLE_CONVEX_HULL_2; "NEGLIGIBLE_CONVEX_HULL_3",NEGLIGIBLE_CONVEX_HULL_3; "NEGLIGIBLE_CONVEX_INTERIOR",NEGLIGIBLE_CONVEX_INTERIOR; "NEGLIGIBLE_COUNTABLE",NEGLIGIBLE_COUNTABLE; "NEGLIGIBLE_COUNTABLE_UNIONS",NEGLIGIBLE_COUNTABLE_UNIONS; "NEGLIGIBLE_COUNTABLE_UNIONS_GEN",NEGLIGIBLE_COUNTABLE_UNIONS_GEN; "NEGLIGIBLE_DELETE",NEGLIGIBLE_DELETE; "NEGLIGIBLE_DIFF",NEGLIGIBLE_DIFF; "NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM; "NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE; "NEGLIGIBLE_DIFFERENTIABLE_PREIMAGE",NEGLIGIBLE_DIFFERENTIABLE_PREIMAGE; "NEGLIGIBLE_DISJOINT_TRANSLATES",NEGLIGIBLE_DISJOINT_TRANSLATES; "NEGLIGIBLE_EMPTY",NEGLIGIBLE_EMPTY; "NEGLIGIBLE_EMPTY_INTERIOR",NEGLIGIBLE_EMPTY_INTERIOR; "NEGLIGIBLE_EQ_MEASURE_0",NEGLIGIBLE_EQ_MEASURE_0; "NEGLIGIBLE_EQ_ZERO_DENSITY",NEGLIGIBLE_EQ_ZERO_DENSITY; "NEGLIGIBLE_EQ_ZERO_DENSITY_ALT",NEGLIGIBLE_EQ_ZERO_DENSITY_ALT; "NEGLIGIBLE_FINITE",NEGLIGIBLE_FINITE; "NEGLIGIBLE_FRONTIER_INTERVAL",NEGLIGIBLE_FRONTIER_INTERVAL; "NEGLIGIBLE_HYPERPLANE",NEGLIGIBLE_HYPERPLANE; "NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS; "NEGLIGIBLE_IFF_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_MEASURABLE_SUBSETS; "NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL",NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL; "NEGLIGIBLE_IMAGE_INDEFINITE_INTEGRAL",NEGLIGIBLE_IMAGE_INDEFINITE_INTEGRAL; "NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE",NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE; "NEGLIGIBLE_IMP_MEASURABLE",NEGLIGIBLE_IMP_MEASURABLE; "NEGLIGIBLE_INFINITE_PREIMAGES_DIFFERENTIABLE",NEGLIGIBLE_INFINITE_PREIMAGES_DIFFERENTIABLE; "NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE",NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE; "NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE_GEN",NEGLIGIBLE_INFINITE_PREIMAGES_MOSTLY_DIFFERENTIABLE_GEN; "NEGLIGIBLE_INSERT",NEGLIGIBLE_INSERT; "NEGLIGIBLE_INTER",NEGLIGIBLE_INTER; "NEGLIGIBLE_INTERVAL",NEGLIGIBLE_INTERVAL; "NEGLIGIBLE_LINEAR_IMAGE",NEGLIGIBLE_LINEAR_IMAGE; "NEGLIGIBLE_LINEAR_IMAGE_EQ",NEGLIGIBLE_LINEAR_IMAGE_EQ; "NEGLIGIBLE_LINEAR_IMAGE_GEN",NEGLIGIBLE_LINEAR_IMAGE_GEN; "NEGLIGIBLE_LINEAR_SINGULAR_IMAGE",NEGLIGIBLE_LINEAR_SINGULAR_IMAGE; "NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV",NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV; "NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE",NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE; "NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE_LOWDIM",NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE_LOWDIM; "NEGLIGIBLE_LOWDIM",NEGLIGIBLE_LOWDIM; "NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH",NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH; "NEGLIGIBLE_ON_COUNTABLE_INTERVALS",NEGLIGIBLE_ON_COUNTABLE_INTERVALS; "NEGLIGIBLE_ON_INTERVALS",NEGLIGIBLE_ON_INTERVALS; "NEGLIGIBLE_ON_UNIV",NEGLIGIBLE_ON_UNIV; "NEGLIGIBLE_OUTER",NEGLIGIBLE_OUTER; "NEGLIGIBLE_OUTER_LE",NEGLIGIBLE_OUTER_LE; "NEGLIGIBLE_PCROSS",NEGLIGIBLE_PCROSS; "NEGLIGIBLE_POINTS_OF_AMBIGUOUS_DERIVATIVE",NEGLIGIBLE_POINTS_OF_AMBIGUOUS_DERIVATIVE; "NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE",NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE; "NEGLIGIBLE_SCALING",NEGLIGIBLE_SCALING; "NEGLIGIBLE_SCALING_EQ",NEGLIGIBLE_SCALING_EQ; "NEGLIGIBLE_SEGMENT",NEGLIGIBLE_SEGMENT; "NEGLIGIBLE_SING",NEGLIGIBLE_SING; "NEGLIGIBLE_SPHERE",NEGLIGIBLE_SPHERE; "NEGLIGIBLE_STANDARD_HYPERPLANE",NEGLIGIBLE_STANDARD_HYPERPLANE; "NEGLIGIBLE_SUBSET",NEGLIGIBLE_SUBSET; "NEGLIGIBLE_SYMDIFF_EQ",NEGLIGIBLE_SYMDIFF_EQ; "NEGLIGIBLE_TRANSLATION",NEGLIGIBLE_TRANSLATION; "NEGLIGIBLE_TRANSLATION_EQ",NEGLIGIBLE_TRANSLATION_EQ; "NEGLIGIBLE_TRANSLATION_REV",NEGLIGIBLE_TRANSLATION_REV; "NEGLIGIBLE_UNION",NEGLIGIBLE_UNION; "NEGLIGIBLE_UNIONS",NEGLIGIBLE_UNIONS; "NEGLIGIBLE_UNION_EQ",NEGLIGIBLE_UNION_EQ; "NEIGHBOURHOOD_EXTENSION_INTO_ANR",NEIGHBOURHOOD_EXTENSION_INTO_ANR; "NET",NET; "NETLIMIT_AT",NETLIMIT_AT; "NETLIMIT_WITHIN",NETLIMIT_WITHIN; "NETLIMIT_WITHIN_INTERIOR",NETLIMIT_WITHIN_INTERIOR; "NET_DILEMMA",NET_DILEMMA; "NET_WITHIN_UNIV",NET_WITHIN_UNIV; "NEUTRAL_ADD",NEUTRAL_ADD; "NEUTRAL_AND",NEUTRAL_AND; "NEUTRAL_LIFTED",NEUTRAL_LIFTED; "NEUTRAL_MUL",NEUTRAL_MUL; "NEUTRAL_OUTER",NEUTRAL_OUTER; "NEUTRAL_REAL_ADD",NEUTRAL_REAL_ADD; "NEUTRAL_REAL_MUL",NEUTRAL_REAL_MUL; "NEUTRAL_VECTOR_ADD",NEUTRAL_VECTOR_ADD; "NONBOUNDARY_IN_UNIQUE_CONIC_HULL_SIMPLEX",NONBOUNDARY_IN_UNIQUE_CONIC_HULL_SIMPLEX; "NONDECREASING_EXTENDS_FROM_DENSE",NONDECREASING_EXTENDS_FROM_DENSE; "NONDECREASING_EXTENDS_TO_CONVEX_HULL",NONDECREASING_EXTENDS_TO_CONVEX_HULL; "NONEMPTY_AFFINE_EXISTS",NONEMPTY_AFFINE_EXISTS; "NONEMPTY_SIMPLE_PATH_ENDLESS",NONEMPTY_SIMPLE_PATH_ENDLESS; "NONEMPTY_SPAN",NONEMPTY_SPAN; "NONNEGATIVE_ABSOLUTELY_INTEGRABLE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE; "NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE; "NONNEGATIVE_INTEGER",NONNEGATIVE_INTEGER; "NONPOSITIVE_INTEGER",NONPOSITIVE_INTEGER; "NONPOSITIVE_INTEGER_ALT",NONPOSITIVE_INTEGER_ALT; "NONTRIVIAL_LIMIT_WITHIN",NONTRIVIAL_LIMIT_WITHIN; "NON_MEASURABLE_SET",NON_MEASURABLE_SET; "NON_TRIVIAL_LIMIT_LEFT",NON_TRIVIAL_LIMIT_LEFT; "NON_TRIVIAL_LIMIT_RIGHT",NON_TRIVIAL_LIMIT_RIGHT; "NORMAL_BIPOLAR_DECOMPOSITION",NORMAL_BIPOLAR_DECOMPOSITION; "NORMAL_LEFT_POLAR_DECOMPOSITION",NORMAL_LEFT_POLAR_DECOMPOSITION; "NORMAL_MATRIX_IFF_SAME_DOT_TRANSP",NORMAL_MATRIX_IFF_SAME_DOT_TRANSP; "NORMAL_MATRIX_IFF_SAME_NORM_TRANSP",NORMAL_MATRIX_IFF_SAME_NORM_TRANSP; "NORMAL_MATRIX_INV",NORMAL_MATRIX_INV; "NORMAL_MATRIX_KERNEL_TRANSP",NORMAL_MATRIX_KERNEL_TRANSP; "NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT",NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT; "NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP",NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP; "NORMAL_MATRIX_SAME_EIGENVECTORS_TRANSP",NORMAL_MATRIX_SAME_EIGENVECTORS_TRANSP; "NORMAL_MATRIX_SIMILAR_TRANSP",NORMAL_MATRIX_SIMILAR_TRANSP; "NORMAL_MATRIX_SIMILAR_TRANSP_ALT",NORMAL_MATRIX_SIMILAR_TRANSP_ALT; "NORMAL_RIGHT_POLAR_DECOMPOSITION",NORMAL_RIGHT_POLAR_DECOMPOSITION; "NORM_0",NORM_0; "NORM_1",NORM_1; "NORM_1_POS",NORM_1_POS; "NORM_ADD_PYTHAGOREAN",NORM_ADD_PYTHAGOREAN; "NORM_BASIS",NORM_BASIS; "NORM_BASIS_1",NORM_BASIS_1; "NORM_BOUND_COMPONENT_LE",NORM_BOUND_COMPONENT_LE; "NORM_BOUND_COMPONENT_LT",NORM_BOUND_COMPONENT_LT; "NORM_BOUND_GENERALIZE",NORM_BOUND_GENERALIZE; "NORM_CAUCHY_SCHWARZ",NORM_CAUCHY_SCHWARZ; "NORM_CAUCHY_SCHWARZ_ABS",NORM_CAUCHY_SCHWARZ_ABS; "NORM_CAUCHY_SCHWARZ_ABS_EQ",NORM_CAUCHY_SCHWARZ_ABS_EQ; "NORM_CAUCHY_SCHWARZ_DIV",NORM_CAUCHY_SCHWARZ_DIV; "NORM_CAUCHY_SCHWARZ_EQ",NORM_CAUCHY_SCHWARZ_EQ; "NORM_CAUCHY_SCHWARZ_EQUAL",NORM_CAUCHY_SCHWARZ_EQUAL; "NORM_COLUMN_LE_ONORM",NORM_COLUMN_LE_ONORM; "NORM_CROSS_MULTIPLY",NORM_CROSS_MULTIPLY; "NORM_EQ",NORM_EQ; "NORM_EQ_0",NORM_EQ_0; "NORM_EQ_0_DOT",NORM_EQ_0_DOT; "NORM_EQ_0_IMP",NORM_EQ_0_IMP; "NORM_EQ_1",NORM_EQ_1; "NORM_EQ_COMPONENTWISE",NORM_EQ_COMPONENTWISE; "NORM_EQ_SQUARE",NORM_EQ_SQUARE; "NORM_FSTCART",NORM_FSTCART; "NORM_GE_SQUARE",NORM_GE_SQUARE; "NORM_GT_SQUARE",NORM_GT_SQUARE; "NORM_INCREASES_ONLINE",NORM_INCREASES_ONLINE; "NORM_LE",NORM_LE; "NORM_LE_0",NORM_LE_0; "NORM_LE_COMPONENTWISE",NORM_LE_COMPONENTWISE; "NORM_LE_INFNORM",NORM_LE_INFNORM; "NORM_LE_L1",NORM_LE_L1; "NORM_LE_PASTECART",NORM_LE_PASTECART; "NORM_LE_SQUARE",NORM_LE_SQUARE; "NORM_LIFT",NORM_LIFT; "NORM_LT",NORM_LT; "NORM_LT_SQUARE",NORM_LT_SQUARE; "NORM_LT_SQUARE_ALT",NORM_LT_SQUARE_ALT; "NORM_MUL",NORM_MUL; "NORM_NEG",NORM_NEG; "NORM_PASTECART",NORM_PASTECART; "NORM_PASTECART_0",NORM_PASTECART_0; "NORM_PASTECART_LE",NORM_PASTECART_LE; "NORM_POS_LE",NORM_POS_LE; "NORM_POS_LT",NORM_POS_LT; "NORM_POW_2",NORM_POW_2; "NORM_REAL",NORM_REAL; "NORM_REFLECT_ALONG",NORM_REFLECT_ALONG; "NORM_SEGMENT_LOWERBOUND",NORM_SEGMENT_LOWERBOUND; "NORM_SEGMENT_ORTHOGONAL_LOWERBOUND",NORM_SEGMENT_ORTHOGONAL_LOWERBOUND; "NORM_SNDCART",NORM_SNDCART; "NORM_SUB",NORM_SUB; "NORM_TRIANGLE",NORM_TRIANGLE; "NORM_TRIANGLE_EQ",NORM_TRIANGLE_EQ; "NORM_TRIANGLE_LE",NORM_TRIANGLE_LE; "NORM_TRIANGLE_LT",NORM_TRIANGLE_LT; "NORM_TRIANGLE_SUB",NORM_TRIANGLE_SUB; "NORM_VECTOR_DERIVATIVES_LE_AT",NORM_VECTOR_DERIVATIVES_LE_AT; "NORM_VECTOR_DERIVATIVES_LE_WITHIN",NORM_VECTOR_DERIVATIVES_LE_WITHIN; "NORM_VSUM_PYTHAGOREAN",NORM_VSUM_PYTHAGOREAN; "NORM_VSUM_TRIVIAL_LEMMA",NORM_VSUM_TRIVIAL_LEMMA; "NOT_ABSOLUTE_RETRACT_COBOUNDED",NOT_ABSOLUTE_RETRACT_COBOUNDED; "NOT_ALL",NOT_ALL; "NOT_AR_EMPTY",NOT_AR_EMPTY; "NOT_BOUNDED_UNIV",NOT_BOUNDED_UNIV; "NOT_CLAUSES",NOT_CLAUSES; "NOT_CLAUSES_WEAK",NOT_CLAUSES_WEAK; "NOT_CONNECTED_COMPONENT_SEPARATED_UNION",NOT_CONNECTED_COMPONENT_SEPARATED_UNION; "NOT_CONS_NIL",NOT_CONS_NIL; "NOT_DEF",NOT_DEF; "NOT_EMPTY_INSERT",NOT_EMPTY_INSERT; "NOT_EQUAL_SETS",NOT_EQUAL_SETS; "NOT_EVEN",NOT_EVEN; "NOT_EVENTUALLY",NOT_EVENTUALLY; "NOT_EX",NOT_EX; "NOT_EXISTS_THM",NOT_EXISTS_THM; "NOT_FORALL_THM",NOT_FORALL_THM; "NOT_GDELTA_DENSE_COUNTABLE",NOT_GDELTA_DENSE_COUNTABLE; "NOT_IMP",NOT_IMP; "NOT_INSERT_EMPTY",NOT_INSERT_EMPTY; "NOT_INTERVAL_UNIV",NOT_INTERVAL_UNIV; "NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION",NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION; "NOT_IN_EMPTY",NOT_IN_EMPTY; "NOT_IN_INTERIOR_CONVEX_HULL",NOT_IN_INTERIOR_CONVEX_HULL; "NOT_IN_PATH_IMAGE_JOIN",NOT_IN_PATH_IMAGE_JOIN; "NOT_LE",NOT_LE; "NOT_LT",NOT_LT; "NOT_MEASURABLE_UNIV",NOT_MEASURABLE_UNIV; "NOT_NEGLIGIBLE_UNIV",NOT_NEGLIGIBLE_UNIV; "NOT_ODD",NOT_ODD; "NOT_ON_PATH_BALL",NOT_ON_PATH_BALL; "NOT_ON_PATH_CBALL",NOT_ON_PATH_CBALL; "NOT_OPEN_SING",NOT_OPEN_SING; "NOT_OUTSIDE_CONNECTED_COMPONENT_LE",NOT_OUTSIDE_CONNECTED_COMPONENT_LE; "NOT_OUTSIDE_CONNECTED_COMPONENT_LT",NOT_OUTSIDE_CONNECTED_COMPONENT_LT; "NOT_PSUBSET_EMPTY",NOT_PSUBSET_EMPTY; "NOT_SUC",NOT_SUC; "NOT_UNIV_PSUBSET",NOT_UNIV_PSUBSET; "NOWHERE_DENSE",NOWHERE_DENSE; "NOWHERE_DENSE_COUNTABLE_UNIONS",NOWHERE_DENSE_COUNTABLE_UNIONS; "NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED",NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED; "NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN",NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN; "NOWHERE_DENSE_UNION",NOWHERE_DENSE_UNION; "NO_LIMIT_POINT_IMP_CLOSED",NO_LIMIT_POINT_IMP_CLOSED; "NO_RETRACTION_CBALL",NO_RETRACTION_CBALL; "NO_RETRACTION_FRONTIER_BOUNDED",NO_RETRACTION_FRONTIER_BOUNDED; "NPRODUCT_ADD_SPLIT",NPRODUCT_ADD_SPLIT; "NPRODUCT_CLAUSES",NPRODUCT_CLAUSES; "NPRODUCT_CLAUSES_LEFT",NPRODUCT_CLAUSES_LEFT; "NPRODUCT_CLAUSES_NUMSEG",NPRODUCT_CLAUSES_NUMSEG; "NPRODUCT_CLAUSES_RIGHT",NPRODUCT_CLAUSES_RIGHT; "NPRODUCT_CLOSED",NPRODUCT_CLOSED; "NPRODUCT_CONST",NPRODUCT_CONST; "NPRODUCT_CONST_NUMSEG",NPRODUCT_CONST_NUMSEG; "NPRODUCT_CONST_NUMSEG_1",NPRODUCT_CONST_NUMSEG_1; "NPRODUCT_DELETE",NPRODUCT_DELETE; "NPRODUCT_DELTA",NPRODUCT_DELTA; "NPRODUCT_EQ",NPRODUCT_EQ; "NPRODUCT_EQ_0",NPRODUCT_EQ_0; "NPRODUCT_EQ_0_NUMSEG",NPRODUCT_EQ_0_NUMSEG; "NPRODUCT_EQ_1",NPRODUCT_EQ_1; "NPRODUCT_EQ_1_NUMSEG",NPRODUCT_EQ_1_NUMSEG; "NPRODUCT_EQ_NUMSEG",NPRODUCT_EQ_NUMSEG; "NPRODUCT_FACT",NPRODUCT_FACT; "NPRODUCT_IMAGE",NPRODUCT_IMAGE; "NPRODUCT_LE",NPRODUCT_LE; "NPRODUCT_LE_NUMSEG",NPRODUCT_LE_NUMSEG; "NPRODUCT_MUL",NPRODUCT_MUL; "NPRODUCT_MUL_GEN",NPRODUCT_MUL_GEN; "NPRODUCT_MUL_NUMSEG",NPRODUCT_MUL_NUMSEG; "NPRODUCT_OFFSET",NPRODUCT_OFFSET; "NPRODUCT_ONE",NPRODUCT_ONE; "NPRODUCT_PAIR",NPRODUCT_PAIR; "NPRODUCT_POS_LT",NPRODUCT_POS_LT; "NPRODUCT_POS_LT_NUMSEG",NPRODUCT_POS_LT_NUMSEG; "NPRODUCT_REFLECT",NPRODUCT_REFLECT; "NPRODUCT_SING",NPRODUCT_SING; "NPRODUCT_SING_NUMSEG",NPRODUCT_SING_NUMSEG; "NPRODUCT_SUPERSET",NPRODUCT_SUPERSET; "NPRODUCT_SUPPORT",NPRODUCT_SUPPORT; "NPRODUCT_UNION",NPRODUCT_UNION; "NPRODUCT_UNIV",NPRODUCT_UNIV; "NSUM_0",NSUM_0; "NSUM_ADD",NSUM_ADD; "NSUM_ADD_GEN",NSUM_ADD_GEN; "NSUM_ADD_NUMSEG",NSUM_ADD_NUMSEG; "NSUM_ADD_SPLIT",NSUM_ADD_SPLIT; "NSUM_BIJECTION",NSUM_BIJECTION; "NSUM_BOUND",NSUM_BOUND; "NSUM_BOUND_GEN",NSUM_BOUND_GEN; "NSUM_BOUND_LT",NSUM_BOUND_LT; "NSUM_BOUND_LT_ALL",NSUM_BOUND_LT_ALL; "NSUM_BOUND_LT_GEN",NSUM_BOUND_LT_GEN; "NSUM_CASES",NSUM_CASES; "NSUM_CLAUSES",NSUM_CLAUSES; "NSUM_CLAUSES_LEFT",NSUM_CLAUSES_LEFT; "NSUM_CLAUSES_NUMSEG",NSUM_CLAUSES_NUMSEG; "NSUM_CLAUSES_RIGHT",NSUM_CLAUSES_RIGHT; "NSUM_CLOSED",NSUM_CLOSED; "NSUM_CONST",NSUM_CONST; "NSUM_CONST_NUMSEG",NSUM_CONST_NUMSEG; "NSUM_DEGENERATE",NSUM_DEGENERATE; "NSUM_DELETE",NSUM_DELETE; "NSUM_DELTA",NSUM_DELTA; "NSUM_DIFF",NSUM_DIFF; "NSUM_EQ",NSUM_EQ; "NSUM_EQ_0",NSUM_EQ_0; "NSUM_EQ_0_IFF",NSUM_EQ_0_IFF; "NSUM_EQ_0_IFF_NUMSEG",NSUM_EQ_0_IFF_NUMSEG; "NSUM_EQ_0_NUMSEG",NSUM_EQ_0_NUMSEG; "NSUM_EQ_GENERAL",NSUM_EQ_GENERAL; "NSUM_EQ_GENERAL_INVERSES",NSUM_EQ_GENERAL_INVERSES; "NSUM_EQ_NUMSEG",NSUM_EQ_NUMSEG; "NSUM_EQ_SUPERSET",NSUM_EQ_SUPERSET; "NSUM_GROUP",NSUM_GROUP; "NSUM_GROUP_RELATION",NSUM_GROUP_RELATION; "NSUM_IMAGE",NSUM_IMAGE; "NSUM_IMAGE_GEN",NSUM_IMAGE_GEN; "NSUM_IMAGE_NONZERO",NSUM_IMAGE_NONZERO; "NSUM_INCL_EXCL",NSUM_INCL_EXCL; "NSUM_INJECTION",NSUM_INJECTION; "NSUM_LE",NSUM_LE; "NSUM_LE_GEN",NSUM_LE_GEN; "NSUM_LE_NUMSEG",NSUM_LE_NUMSEG; "NSUM_LMUL",NSUM_LMUL; "NSUM_LT",NSUM_LT; "NSUM_LT_ALL",NSUM_LT_ALL; "NSUM_MULTICOUNT",NSUM_MULTICOUNT; "NSUM_MULTICOUNT_GEN",NSUM_MULTICOUNT_GEN; "NSUM_MUL_BOUND",NSUM_MUL_BOUND; "NSUM_NSUM_PRODUCT",NSUM_NSUM_PRODUCT; "NSUM_NSUM_RESTRICT",NSUM_NSUM_RESTRICT; "NSUM_OFFSET",NSUM_OFFSET; "NSUM_OFFSET_0",NSUM_OFFSET_0; "NSUM_PAIR",NSUM_PAIR; "NSUM_PERMUTE",NSUM_PERMUTE; "NSUM_PERMUTE_NUMSEG",NSUM_PERMUTE_NUMSEG; "NSUM_POS_BOUND",NSUM_POS_BOUND; "NSUM_POS_LT",NSUM_POS_LT; "NSUM_POS_LT_ALL",NSUM_POS_LT_ALL; "NSUM_REFLECT",NSUM_REFLECT; "NSUM_RESTRICT",NSUM_RESTRICT; "NSUM_RESTRICT_SET",NSUM_RESTRICT_SET; "NSUM_RMUL",NSUM_RMUL; "NSUM_SING",NSUM_SING; "NSUM_SING_NUMSEG",NSUM_SING_NUMSEG; "NSUM_SUBSET",NSUM_SUBSET; "NSUM_SUBSET_SIMPLE",NSUM_SUBSET_SIMPLE; "NSUM_SUPERSET",NSUM_SUPERSET; "NSUM_SUPPORT",NSUM_SUPPORT; "NSUM_SWAP",NSUM_SWAP; "NSUM_SWAP_NUMSEG",NSUM_SWAP_NUMSEG; "NSUM_TRIV_NUMSEG",NSUM_TRIV_NUMSEG; "NSUM_UNION",NSUM_UNION; "NSUM_UNIONS_NONZERO",NSUM_UNIONS_NONZERO; "NSUM_UNION_EQ",NSUM_UNION_EQ; "NSUM_UNION_LZERO",NSUM_UNION_LZERO; "NSUM_UNION_NONZERO",NSUM_UNION_NONZERO; "NSUM_UNION_RZERO",NSUM_UNION_RZERO; "NSUM_UNIV",NSUM_UNIV; "NULL",NULL; "NULLHOMOTOPIC_FROM_CONTRACTIBLE",NULLHOMOTOPIC_FROM_CONTRACTIBLE; "NULLHOMOTOPIC_FROM_SPHERE_EXTENSION",NULLHOMOTOPIC_FROM_SPHERE_EXTENSION; "NULLHOMOTOPIC_INTO_ANR_EXTENSION",NULLHOMOTOPIC_INTO_ANR_EXTENSION; "NULLHOMOTOPIC_INTO_CONTRACTIBLE",NULLHOMOTOPIC_INTO_CONTRACTIBLE; "NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION",NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION; "NULLHOMOTOPIC_INTO_SPHERE_EXTENSION",NULLHOMOTOPIC_INTO_SPHERE_EXTENSION; "NULLHOMOTOPIC_THROUGH_CONTRACTIBLE",NULLHOMOTOPIC_THROUGH_CONTRACTIBLE; "NULLSPACE_INTER_ROWSPACE",NULLSPACE_INTER_ROWSPACE; "NUMERAL",NUMERAL; "NUMPAIR",NUMPAIR; "NUMPAIR_DEST",NUMPAIR_DEST; "NUMPAIR_INJ",NUMPAIR_INJ; "NUMPAIR_INJ_LEMMA",NUMPAIR_INJ_LEMMA; "NUMSEG_ADD_SPLIT",NUMSEG_ADD_SPLIT; "NUMSEG_CLAUSES",NUMSEG_CLAUSES; "NUMSEG_COMBINE_L",NUMSEG_COMBINE_L; "NUMSEG_COMBINE_R",NUMSEG_COMBINE_R; "NUMSEG_DIMINDEX_NONEMPTY",NUMSEG_DIMINDEX_NONEMPTY; "NUMSEG_EMPTY",NUMSEG_EMPTY; "NUMSEG_LE",NUMSEG_LE; "NUMSEG_LREC",NUMSEG_LREC; "NUMSEG_LT",NUMSEG_LT; "NUMSEG_OFFSET_IMAGE",NUMSEG_OFFSET_IMAGE; "NUMSEG_REC",NUMSEG_REC; "NUMSEG_RREC",NUMSEG_RREC; "NUMSEG_SING",NUMSEG_SING; "NUMSUM",NUMSUM; "NUMSUM_DEST",NUMSUM_DEST; "NUMSUM_INJ",NUMSUM_INJ; "NUM_COUNTABLE",NUM_COUNTABLE; "NUM_GCD",NUM_GCD; "NUM_OF_INT",NUM_OF_INT; "NUM_OF_INT_OF_NUM",NUM_OF_INT_OF_NUM; "NUM_REP_CASES",NUM_REP_CASES; "NUM_REP_INDUCT",NUM_REP_INDUCT; "NUM_REP_RULES",NUM_REP_RULES; "ODD",ODD; "ODD_ADD",ODD_ADD; "ODD_DOUBLE",ODD_DOUBLE; "ODD_EXISTS",ODD_EXISTS; "ODD_EXP",ODD_EXP; "ODD_MOD",ODD_MOD; "ODD_MULT",ODD_MULT; "ODD_SUB",ODD_SUB; "OEP",OEP; "OLDNET",OLDNET; "ONE",ONE; "ONE_ONE",ONE_ONE; "ONORM",ONORM; "ONORM_ADJOINT",ONORM_ADJOINT; "ONORM_CMUL",ONORM_CMUL; "ONORM_COMPOSE",ONORM_COMPOSE; "ONORM_COMPOSE_ADJOINT_LEFT",ONORM_COMPOSE_ADJOINT_LEFT; "ONORM_COMPOSE_ADJOINT_RIGHT",ONORM_COMPOSE_ADJOINT_RIGHT; "ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT",ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT; "ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT",ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT; "ONORM_CONST",ONORM_CONST; "ONORM_COVARIANCE",ONORM_COVARIANCE; "ONORM_COVARIANCE_ALT",ONORM_COVARIANCE_ALT; "ONORM_DERIVATIVES_LE",ONORM_DERIVATIVES_LE; "ONORM_DIAGONAL_MATRIX",ONORM_DIAGONAL_MATRIX; "ONORM_DOT",ONORM_DOT; "ONORM_EQ_0",ONORM_EQ_0; "ONORM_I",ONORM_I; "ONORM_ID",ONORM_ID; "ONORM_INVERSE_DET_LE_ONORM_POW",ONORM_INVERSE_DET_LE_ONORM_POW; "ONORM_INVERSE_DET_LE_ONORM_POW_ALT",ONORM_INVERSE_DET_LE_ONORM_POW_ALT; "ONORM_INVERSE_FUNCTION_BOUND",ONORM_INVERSE_FUNCTION_BOUND; "ONORM_LE_EQ",ONORM_LE_EQ; "ONORM_LE_EVENTUALLY",ONORM_LE_EVENTUALLY; "ONORM_LE_MATRIX_COMPONENT",ONORM_LE_MATRIX_COMPONENT; "ONORM_LE_MATRIX_COMPONENT_SUM",ONORM_LE_MATRIX_COMPONENT_SUM; "ONORM_NEG",ONORM_NEG; "ONORM_ORTHOGONAL_MATRIX",ONORM_ORTHOGONAL_MATRIX; "ONORM_ORTHOGONAL_TRANSFORMATION",ONORM_ORTHOGONAL_TRANSFORMATION; "ONORM_POS_LE",ONORM_POS_LE; "ONORM_POS_LT",ONORM_POS_LT; "ONORM_TRANSP",ONORM_TRANSP; "ONORM_TRIANGLE",ONORM_TRIANGLE; "ONORM_TRIANGLE_LE",ONORM_TRIANGLE_LE; "ONORM_TRIANGLE_LT",ONORM_TRIANGLE_LT; "ONTO",ONTO; "OPEN_AFFINITY",OPEN_AFFINITY; "OPEN_AFFINITY_EQ",OPEN_AFFINITY_EQ; "OPEN_BALL",OPEN_BALL; "OPEN_BIJECTIVE_LINEAR_IMAGE_EQ",OPEN_BIJECTIVE_LINEAR_IMAGE_EQ; "OPEN_CLOSED",OPEN_CLOSED; "OPEN_CLOSED_INTERVAL_1",OPEN_CLOSED_INTERVAL_1; "OPEN_CLOSED_INTERVAL_CONVEX",OPEN_CLOSED_INTERVAL_CONVEX; "OPEN_COMPONENTS",OPEN_COMPONENTS; "OPEN_CONIC_HULL",OPEN_CONIC_HULL; "OPEN_CONNECTED_COMPONENT",OPEN_CONNECTED_COMPONENT; "OPEN_CONTAINS_BALL",OPEN_CONTAINS_BALL; "OPEN_CONTAINS_BALL_EQ",OPEN_CONTAINS_BALL_EQ; "OPEN_CONTAINS_CBALL",OPEN_CONTAINS_CBALL; "OPEN_CONTAINS_CBALL_EQ",OPEN_CONTAINS_CBALL_EQ; "OPEN_CONTAINS_INTERVAL",OPEN_CONTAINS_INTERVAL; "OPEN_CONTAINS_OPEN_INTERVAL",OPEN_CONTAINS_OPEN_INTERVAL; "OPEN_CONVEX_HULL",OPEN_CONVEX_HULL; "OPEN_COUNTABLE_LIMIT_ELEMENTARY",OPEN_COUNTABLE_LIMIT_ELEMENTARY; "OPEN_COUNTABLE_UNION_CLOSED_INTERVALS",OPEN_COUNTABLE_UNION_CLOSED_INTERVALS; "OPEN_COUNTABLE_UNION_OPEN_INTERVALS",OPEN_COUNTABLE_UNION_OPEN_INTERVALS; "OPEN_DELETE",OPEN_DELETE; "OPEN_DIFF",OPEN_DIFF; "OPEN_EMPTY",OPEN_EMPTY; "OPEN_EXISTS",OPEN_EXISTS; "OPEN_EXISTS_IN",OPEN_EXISTS_IN; "OPEN_GENERAL_COMPONENT",OPEN_GENERAL_COMPONENT; "OPEN_HALFSPACE_COMPONENT_GT",OPEN_HALFSPACE_COMPONENT_GT; "OPEN_HALFSPACE_COMPONENT_LT",OPEN_HALFSPACE_COMPONENT_LT; "OPEN_HALFSPACE_GT",OPEN_HALFSPACE_GT; "OPEN_HALFSPACE_LT",OPEN_HALFSPACE_LT; "OPEN_IMP_ANALYTIC",OPEN_IMP_ANALYTIC; "OPEN_IMP_ANR",OPEN_IMP_ANR; "OPEN_IMP_BAIRE1_INDICATOR",OPEN_IMP_BAIRE1_INDICATOR; "OPEN_IMP_BOREL",OPEN_IMP_BOREL; "OPEN_IMP_ENR",OPEN_IMP_ENR; "OPEN_IMP_FSIGMA",OPEN_IMP_FSIGMA; "OPEN_IMP_GDELTA",OPEN_IMP_GDELTA; "OPEN_IMP_INFINITE",OPEN_IMP_INFINITE; "OPEN_IMP_LOCALLY_COMPACT",OPEN_IMP_LOCALLY_COMPACT; "OPEN_IMP_LOCALLY_CONNECTED",OPEN_IMP_LOCALLY_CONNECTED; "OPEN_IMP_LOCALLY_PATH_CONNECTED",OPEN_IMP_LOCALLY_PATH_CONNECTED; "OPEN_IN",OPEN_IN; "OPEN_INSIDE",OPEN_INSIDE; "OPEN_INTER",OPEN_INTER; "OPEN_INTERIOR",OPEN_INTERIOR; "OPEN_INTERS",OPEN_INTERS; "OPEN_INTERVAL",OPEN_INTERVAL; "OPEN_INTERVAL_EQ",OPEN_INTERVAL_EQ; "OPEN_INTERVAL_LEFT",OPEN_INTERVAL_LEFT; "OPEN_INTERVAL_LEMMA",OPEN_INTERVAL_LEMMA; "OPEN_INTERVAL_MIDPOINT",OPEN_INTERVAL_MIDPOINT; "OPEN_INTERVAL_RIGHT",OPEN_INTERVAL_RIGHT; "OPEN_INTER_CLOSURE_EQ",OPEN_INTER_CLOSURE_EQ; "OPEN_INTER_CLOSURE_EQ_EMPTY",OPEN_INTER_CLOSURE_EQ_EMPTY; "OPEN_INTER_CLOSURE_SUBSET",OPEN_INTER_CLOSURE_SUBSET; "OPEN_INVERTIBLE_LINEAR_IMAGE",OPEN_INVERTIBLE_LINEAR_IMAGE; "OPEN_IN_ANALYTIC",OPEN_IN_ANALYTIC; "OPEN_IN_BOREL",OPEN_IN_BOREL; "OPEN_IN_CLAUSES",OPEN_IN_CLAUSES; "OPEN_IN_CLOSED_IN",OPEN_IN_CLOSED_IN; "OPEN_IN_CLOSED_IN_EQ",OPEN_IN_CLOSED_IN_EQ; "OPEN_IN_COMPONENTS_LOCALLY_CONNECTED",OPEN_IN_COMPONENTS_LOCALLY_CONNECTED; "OPEN_IN_CONIC_HULL",OPEN_IN_CONIC_HULL; "OPEN_IN_CONNECTED_COMPONENT",OPEN_IN_CONNECTED_COMPONENT; "OPEN_IN_CONNECTED_COMPONENTS",OPEN_IN_CONNECTED_COMPONENTS; "OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED",OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; "OPEN_IN_CONTAINS_BALL",OPEN_IN_CONTAINS_BALL; "OPEN_IN_CONTAINS_CBALL",OPEN_IN_CONTAINS_CBALL; "OPEN_IN_CONVEX_MEETS_RELATIVE_INTERIOR",OPEN_IN_CONVEX_MEETS_RELATIVE_INTERIOR; "OPEN_IN_DELETE",OPEN_IN_DELETE; "OPEN_IN_DIFF",OPEN_IN_DIFF; "OPEN_IN_DIFF_CLOSED",OPEN_IN_DIFF_CLOSED; "OPEN_IN_EMPTY",OPEN_IN_EMPTY; "OPEN_IN_EUCLIDEAN",OPEN_IN_EUCLIDEAN; "OPEN_IN_FSIGMA",OPEN_IN_FSIGMA; "OPEN_IN_GDELTA",OPEN_IN_GDELTA; "OPEN_IN_IMP_LOCALLY_PATH_CONNECTED",OPEN_IN_IMP_LOCALLY_PATH_CONNECTED; "OPEN_IN_IMP_SUBSET",OPEN_IN_IMP_SUBSET; "OPEN_IN_INJECTIVE_LINEAR_IMAGE",OPEN_IN_INJECTIVE_LINEAR_IMAGE; "OPEN_IN_INTER",OPEN_IN_INTER; "OPEN_IN_INTERIOR_OF",OPEN_IN_INTERIOR_OF; "OPEN_IN_INTERS",OPEN_IN_INTERS; "OPEN_IN_INTER_CLOSURE_EQ_EMPTY",OPEN_IN_INTER_CLOSURE_EQ_EMPTY; "OPEN_IN_INTER_CLOSURE_OF_EQ",OPEN_IN_INTER_CLOSURE_OF_EQ; "OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY",OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY; "OPEN_IN_INTER_CLOSURE_OF_SUBSET",OPEN_IN_INTER_CLOSURE_OF_SUBSET; "OPEN_IN_INTER_OPEN",OPEN_IN_INTER_OPEN; "OPEN_IN_LOCALLY_COMPACT",OPEN_IN_LOCALLY_COMPACT; "OPEN_IN_MBALL",OPEN_IN_MBALL; "OPEN_IN_MTOPOLOGY",OPEN_IN_MTOPOLOGY; "OPEN_IN_MTOPOLOGY_MCBALL",OPEN_IN_MTOPOLOGY_MCBALL; "OPEN_IN_OPEN",OPEN_IN_OPEN; "OPEN_IN_OPEN_EQ",OPEN_IN_OPEN_EQ; "OPEN_IN_OPEN_INTER",OPEN_IN_OPEN_INTER; "OPEN_IN_OPEN_TRANS",OPEN_IN_OPEN_TRANS; "OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; "OPEN_IN_PCROSS",OPEN_IN_PCROSS; "OPEN_IN_PCROSS_EQ",OPEN_IN_PCROSS_EQ; "OPEN_IN_REFL",OPEN_IN_REFL; "OPEN_IN_RELATIVE_FRONTIER_INTERIOR_FACET",OPEN_IN_RELATIVE_FRONTIER_INTERIOR_FACET; "OPEN_IN_RELATIVE_INTERIOR",OPEN_IN_RELATIVE_INTERIOR; "OPEN_IN_RELATIVE_TO",OPEN_IN_RELATIVE_TO; "OPEN_IN_SAME_CONIC_HULL",OPEN_IN_SAME_CONIC_HULL; "OPEN_IN_SEGMENT",OPEN_IN_SEGMENT; "OPEN_IN_SEPARATED_UNION",OPEN_IN_SEPARATED_UNION; "OPEN_IN_SET_RELATIVE_INTERIOR",OPEN_IN_SET_RELATIVE_INTERIOR; "OPEN_IN_SING",OPEN_IN_SING; "OPEN_IN_SUBOPEN",OPEN_IN_SUBOPEN; "OPEN_IN_SUBSET",OPEN_IN_SUBSET; "OPEN_IN_SUBSET_RELATIVE_INTERIOR",OPEN_IN_SUBSET_RELATIVE_INTERIOR; "OPEN_IN_SUBSET_TRANS",OPEN_IN_SUBSET_TRANS; "OPEN_IN_SUBTOPOLOGY",OPEN_IN_SUBTOPOLOGY; "OPEN_IN_SUBTOPOLOGY_EMPTY",OPEN_IN_SUBTOPOLOGY_EMPTY; "OPEN_IN_SUBTOPOLOGY_INTER_SUBSET",OPEN_IN_SUBTOPOLOGY_INTER_SUBSET; "OPEN_IN_SUBTOPOLOGY_REFL",OPEN_IN_SUBTOPOLOGY_REFL; "OPEN_IN_SUBTOPOLOGY_UNION",OPEN_IN_SUBTOPOLOGY_UNION; "OPEN_IN_TOPSPACE",OPEN_IN_TOPSPACE; "OPEN_IN_TRANS",OPEN_IN_TRANS; "OPEN_IN_TRANSLATION_EQ",OPEN_IN_TRANSLATION_EQ; "OPEN_IN_TRANS_EQ",OPEN_IN_TRANS_EQ; "OPEN_IN_UNION",OPEN_IN_UNION; "OPEN_IN_UNIONS",OPEN_IN_UNIONS; "OPEN_LIFT",OPEN_LIFT; "OPEN_MAP_CLOSED_SUPERSET_PREIMAGE",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE; "OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ; "OPEN_MAP_FROM_COMPOSITION_INJECTIVE",OPEN_MAP_FROM_COMPOSITION_INJECTIVE; "OPEN_MAP_FROM_COMPOSITION_SURJECTIVE",OPEN_MAP_FROM_COMPOSITION_SURJECTIVE; "OPEN_MAP_IFF_CLOSED_MAP_BIJECTIVE",OPEN_MAP_IFF_CLOSED_MAP_BIJECTIVE; "OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE",OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE; "OPEN_MAP_IMP_CLOSED_MAP",OPEN_MAP_IMP_CLOSED_MAP; "OPEN_MAP_IMP_QUOTIENT_MAP",OPEN_MAP_IMP_QUOTIENT_MAP; "OPEN_MAP_INTERIORS",OPEN_MAP_INTERIORS; "OPEN_MAP_RESTRICT",OPEN_MAP_RESTRICT; "OPEN_MEASURABLE_INNER_DIVISION",OPEN_MEASURABLE_INNER_DIVISION; "OPEN_NEGATIONS",OPEN_NEGATIONS; "OPEN_NON_GENERAL_COMPONENT",OPEN_NON_GENERAL_COMPONENT; "OPEN_NON_PATH_COMPONENT",OPEN_NON_PATH_COMPONENT; "OPEN_NOT_NEGLIGIBLE",OPEN_NOT_NEGLIGIBLE; "OPEN_OPEN_IN_TRANS",OPEN_OPEN_IN_TRANS; "OPEN_OPEN_LEFT_PROJECTION",OPEN_OPEN_LEFT_PROJECTION; "OPEN_OPEN_RIGHT_PROJECTION",OPEN_OPEN_RIGHT_PROJECTION; "OPEN_OUTSIDE",OPEN_OUTSIDE; "OPEN_PATH_COMPONENT",OPEN_PATH_COMPONENT; "OPEN_PATH_CONNECTED_COMPONENT",OPEN_PATH_CONNECTED_COMPONENT; "OPEN_PCROSS",OPEN_PCROSS; "OPEN_PCROSS_EQ",OPEN_PCROSS_EQ; "OPEN_POSITIVE_MULTIPLES",OPEN_POSITIVE_MULTIPLES; "OPEN_POSITIVE_ORTHANT",OPEN_POSITIVE_ORTHANT; "OPEN_RELATIVE_TO",OPEN_RELATIVE_TO; "OPEN_SCALING",OPEN_SCALING; "OPEN_SCALING_EQ",OPEN_SCALING_EQ; "OPEN_SEGMENT_1",OPEN_SEGMENT_1; "OPEN_SEGMENT_ALT",OPEN_SEGMENT_ALT; "OPEN_SEGMENT_DESCALE",OPEN_SEGMENT_DESCALE; "OPEN_SEGMENT_LINEAR_IMAGE",OPEN_SEGMENT_LINEAR_IMAGE; "OPEN_SEGMENT_SUBSET_BALL",OPEN_SEGMENT_SUBSET_BALL; "OPEN_SET_COCOUNTABLE_COORDINATES",OPEN_SET_COCOUNTABLE_COORDINATES; "OPEN_SET_COSMALL_COORDINATES",OPEN_SET_COSMALL_COORDINATES; "OPEN_SET_IRRATIONAL_COORDINATES",OPEN_SET_IRRATIONAL_COORDINATES; "OPEN_SET_RATIONAL_COORDINATES",OPEN_SET_RATIONAL_COORDINATES; "OPEN_STRIP_COMPONENT_LT",OPEN_STRIP_COMPONENT_LT; "OPEN_SUBOPEN",OPEN_SUBOPEN; "OPEN_SUBSET",OPEN_SUBSET; "OPEN_SUMS",OPEN_SUMS; "OPEN_SURJECTIVE_LINEAR_IMAGE",OPEN_SURJECTIVE_LINEAR_IMAGE; "OPEN_TRANSLATION",OPEN_TRANSLATION; "OPEN_TRANSLATION_EQ",OPEN_TRANSLATION_EQ; "OPEN_TRANSLATION_SUBSET_PREIMAGE",OPEN_TRANSLATION_SUBSET_PREIMAGE; "OPEN_UNION",OPEN_UNION; "OPEN_UNIONS",OPEN_UNIONS; "OPEN_UNION_COMPACT_SUBSETS",OPEN_UNION_COMPACT_SUBSETS; "OPEN_UNIV",OPEN_UNIV; "OPERATIVE_1_LE",OPERATIVE_1_LE; "OPERATIVE_1_LT",OPERATIVE_1_LT; "OPERATIVE_ABSOLUTELY_CONTINUOUS_ON",OPERATIVE_ABSOLUTELY_CONTINUOUS_ON; "OPERATIVE_ABSOLUTELY_SETCONTINUOUS_ON",OPERATIVE_ABSOLUTELY_SETCONTINUOUS_ON; "OPERATIVE_APPROXIMABLE",OPERATIVE_APPROXIMABLE; "OPERATIVE_CONTENT",OPERATIVE_CONTENT; "OPERATIVE_DIVISION",OPERATIVE_DIVISION; "OPERATIVE_DIVISION_AND",OPERATIVE_DIVISION_AND; "OPERATIVE_EMPTY",OPERATIVE_EMPTY; "OPERATIVE_FUNCTION_ENDPOINT_DIFF",OPERATIVE_FUNCTION_ENDPOINT_DIFF; "OPERATIVE_HAS_BOUNDED_SETVARIATION_ON",OPERATIVE_HAS_BOUNDED_SETVARIATION_ON; "OPERATIVE_HAS_BOUNDED_VARIATION_ON",OPERATIVE_HAS_BOUNDED_VARIATION_ON; "OPERATIVE_INTEGRABLE",OPERATIVE_INTEGRABLE; "OPERATIVE_INTEGRAL",OPERATIVE_INTEGRAL; "OPERATIVE_LIFTED_SETVARIATION",OPERATIVE_LIFTED_SETVARIATION; "OPERATIVE_LIFTED_VECTOR_VARIATION",OPERATIVE_LIFTED_VECTOR_VARIATION; "OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF",OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF; "OPERATIVE_TAGGED_DIVISION",OPERATIVE_TAGGED_DIVISION; "OPERATIVE_TRIVIAL",OPERATIVE_TRIVIAL; "ORDER_EXISTENCE_CARD",ORDER_EXISTENCE_CARD; "ORDER_EXISTENCE_FINITE",ORDER_EXISTENCE_FINITE; "ORDER_EXISTENCE_GEN",ORDER_EXISTENCE_GEN; "ORDER_EXISTENCE_ITER",ORDER_EXISTENCE_ITER; "ORDINAL_CHAINED",ORDINAL_CHAINED; "ORDINAL_CHAINED_LEMMA",ORDINAL_CHAINED_LEMMA; "ORDINAL_FL_SUBSET",ORDINAL_FL_SUBSET; "ORDINAL_FL_SUBSET_EQ",ORDINAL_FL_SUBSET_EQ; "ORDINAL_FL_UNIQUE",ORDINAL_FL_UNIQUE; "ORDINAL_IMP_WOSET",ORDINAL_IMP_WOSET; "ORDINAL_SUC",ORDINAL_SUC; "ORDINAL_UNION",ORDINAL_UNION; "ORDINAL_UNION_LEMMA",ORDINAL_UNION_LEMMA; "ORDINAL_UP",ORDINAL_UP; "ORIENTING_PERTURBATION_EXISTS",ORIENTING_PERTURBATION_EXISTS; "ORTHOGONALITY_PRESERVING_EQ_SIMILARITY",ORTHOGONALITY_PRESERVING_EQ_SIMILARITY; "ORTHOGONALITY_PRESERVING_EQ_SIMILARITY_ALT",ORTHOGONALITY_PRESERVING_EQ_SIMILARITY_ALT; "ORTHOGONALITY_PRESERVING_IMP_SCALING",ORTHOGONALITY_PRESERVING_IMP_SCALING; "ORTHOGONAL_0",ORTHOGONAL_0; "ORTHOGONAL_AND_COLLINEAR",ORTHOGONAL_AND_COLLINEAR; "ORTHOGONAL_ANY_CLOSEST_POINT",ORTHOGONAL_ANY_CLOSEST_POINT; "ORTHOGONAL_BASIS",ORTHOGONAL_BASIS; "ORTHOGONAL_BASIS_BASIS",ORTHOGONAL_BASIS_BASIS; "ORTHOGONAL_BASIS_EXISTS",ORTHOGONAL_BASIS_EXISTS; "ORTHOGONAL_BASIS_SUBSPACE",ORTHOGONAL_BASIS_SUBSPACE; "ORTHOGONAL_CLAUSES",ORTHOGONAL_CLAUSES; "ORTHOGONAL_EXTENSION",ORTHOGONAL_EXTENSION; "ORTHOGONAL_EXTENSION_STRONG",ORTHOGONAL_EXTENSION_STRONG; "ORTHOGONAL_IMP_INDEPENDENT_SUBSPACES",ORTHOGONAL_IMP_INDEPENDENT_SUBSPACES; "ORTHOGONAL_LINEAR_IMAGE_EQ",ORTHOGONAL_LINEAR_IMAGE_EQ; "ORTHOGONAL_LNEG",ORTHOGONAL_LNEG; "ORTHOGONAL_LVSUM",ORTHOGONAL_LVSUM; "ORTHOGONAL_MATRIX",ORTHOGONAL_MATRIX; "ORTHOGONAL_MATRIX_1",ORTHOGONAL_MATRIX_1; "ORTHOGONAL_MATRIX_2",ORTHOGONAL_MATRIX_2; "ORTHOGONAL_MATRIX_2_ALT",ORTHOGONAL_MATRIX_2_ALT; "ORTHOGONAL_MATRIX_ALT",ORTHOGONAL_MATRIX_ALT; "ORTHOGONAL_MATRIX_EXISTS_BASIS",ORTHOGONAL_MATRIX_EXISTS_BASIS; "ORTHOGONAL_MATRIX_ID",ORTHOGONAL_MATRIX_ID; "ORTHOGONAL_MATRIX_IMP_INVERTIBLE",ORTHOGONAL_MATRIX_IMP_INVERTIBLE; "ORTHOGONAL_MATRIX_INV",ORTHOGONAL_MATRIX_INV; "ORTHOGONAL_MATRIX_INV_EQ",ORTHOGONAL_MATRIX_INV_EQ; "ORTHOGONAL_MATRIX_MATRIX",ORTHOGONAL_MATRIX_MATRIX; "ORTHOGONAL_MATRIX_MUL",ORTHOGONAL_MATRIX_MUL; "ORTHOGONAL_MATRIX_NORM",ORTHOGONAL_MATRIX_NORM; "ORTHOGONAL_MATRIX_NORM_EQ",ORTHOGONAL_MATRIX_NORM_EQ; "ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE; "ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE; "ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN; "ORTHOGONAL_MATRIX_TRANSFORMATION",ORTHOGONAL_MATRIX_TRANSFORMATION; "ORTHOGONAL_MATRIX_TRANSP",ORTHOGONAL_MATRIX_TRANSP; "ORTHOGONAL_MATRIX_TRANSP_LMUL",ORTHOGONAL_MATRIX_TRANSP_LMUL; "ORTHOGONAL_MATRIX_TRANSP_RMUL",ORTHOGONAL_MATRIX_TRANSP_RMUL; "ORTHOGONAL_MUL",ORTHOGONAL_MUL; "ORTHOGONAL_NULLSPACE_ROWSPACE",ORTHOGONAL_NULLSPACE_ROWSPACE; "ORTHOGONAL_ORTHOGONAL_TRANSFORMATION",ORTHOGONAL_ORTHOGONAL_TRANSFORMATION; "ORTHOGONAL_PROJECTION_ALT",ORTHOGONAL_PROJECTION_ALT; "ORTHOGONAL_PROJECTION_EQ_SELF_ADJOINT_IDEMPOTENT",ORTHOGONAL_PROJECTION_EQ_SELF_ADJOINT_IDEMPOTENT; "ORTHOGONAL_REFL",ORTHOGONAL_REFL; "ORTHOGONAL_RNEG",ORTHOGONAL_RNEG; "ORTHOGONAL_ROTATION_OR_ROTOINVERSION",ORTHOGONAL_ROTATION_OR_ROTOINVERSION; "ORTHOGONAL_RVSUM",ORTHOGONAL_RVSUM; "ORTHOGONAL_SPANNINGSET_SUBSPACE",ORTHOGONAL_SPANNINGSET_SUBSPACE; "ORTHOGONAL_SUBSPACE_DECOMP",ORTHOGONAL_SUBSPACE_DECOMP; "ORTHOGONAL_SUBSPACE_DECOMP_EXISTS",ORTHOGONAL_SUBSPACE_DECOMP_EXISTS; "ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE",ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE; "ORTHOGONAL_SYM",ORTHOGONAL_SYM; "ORTHOGONAL_TO_ORTHOGONAL_2D",ORTHOGONAL_TO_ORTHOGONAL_2D; "ORTHOGONAL_TO_SPAN",ORTHOGONAL_TO_SPAN; "ORTHOGONAL_TO_SPANS_EQ",ORTHOGONAL_TO_SPANS_EQ; "ORTHOGONAL_TO_SPAN_EQ",ORTHOGONAL_TO_SPAN_EQ; "ORTHOGONAL_TO_SUBSPACE_EXISTS",ORTHOGONAL_TO_SUBSPACE_EXISTS; "ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN",ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN; "ORTHOGONAL_TO_VECTOR_EXISTS",ORTHOGONAL_TO_VECTOR_EXISTS; "ORTHOGONAL_TRANSFORMATION",ORTHOGONAL_TRANSFORMATION; "ORTHOGONAL_TRANSFORMATION_1_GEN",ORTHOGONAL_TRANSFORMATION_1_GEN; "ORTHOGONAL_TRANSFORMATION_ADJOINT",ORTHOGONAL_TRANSFORMATION_ADJOINT; "ORTHOGONAL_TRANSFORMATION_BALL",ORTHOGONAL_TRANSFORMATION_BALL; "ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS",ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS; "ORTHOGONAL_TRANSFORMATION_CBALL",ORTHOGONAL_TRANSFORMATION_CBALL; "ORTHOGONAL_TRANSFORMATION_COMPOSE",ORTHOGONAL_TRANSFORMATION_COMPOSE; "ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT",ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT; "ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT",ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_LEFT; "ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_RIGHT",ORTHOGONAL_TRANSFORMATION_EQ_ADJOINT_RIGHT; "ORTHOGONAL_TRANSFORMATION_EXISTS",ORTHOGONAL_TRANSFORMATION_EXISTS; "ORTHOGONAL_TRANSFORMATION_EXISTS_1",ORTHOGONAL_TRANSFORMATION_EXISTS_1; "ORTHOGONAL_TRANSFORMATION_EXISTS_GEN",ORTHOGONAL_TRANSFORMATION_EXISTS_GEN; "ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS",ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS; "ORTHOGONAL_TRANSFORMATION_I",ORTHOGONAL_TRANSFORMATION_I; "ORTHOGONAL_TRANSFORMATION_ID",ORTHOGONAL_TRANSFORMATION_ID; "ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM",ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM; "ORTHOGONAL_TRANSFORMATION_INJECTIVE",ORTHOGONAL_TRANSFORMATION_INJECTIVE; "ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE; "ORTHOGONAL_TRANSFORMATION_INVERSE",ORTHOGONAL_TRANSFORMATION_INVERSE; "ORTHOGONAL_TRANSFORMATION_INVERSE_o",ORTHOGONAL_TRANSFORMATION_INVERSE_o; "ORTHOGONAL_TRANSFORMATION_ISOMETRY",ORTHOGONAL_TRANSFORMATION_ISOMETRY; "ORTHOGONAL_TRANSFORMATION_LINEAR",ORTHOGONAL_TRANSFORMATION_LINEAR; "ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL",ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL; "ORTHOGONAL_TRANSFORMATION_MATRIX",ORTHOGONAL_TRANSFORMATION_MATRIX; "ORTHOGONAL_TRANSFORMATION_NEG",ORTHOGONAL_TRANSFORMATION_NEG; "ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE; "ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS; "ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG",ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG; "ORTHOGONAL_TRANSFORMATION_SPHERE",ORTHOGONAL_TRANSFORMATION_SPHERE; "ORTHOGONAL_TRANSFORMATION_SURJECTIVE",ORTHOGONAL_TRANSFORMATION_SURJECTIVE; "ORTHONORMAL_BASIS_EXPAND",ORTHONORMAL_BASIS_EXPAND; "ORTHONORMAL_BASIS_EXPAND_DOT",ORTHONORMAL_BASIS_EXPAND_DOT; "ORTHONORMAL_BASIS_EXPAND_NORM",ORTHONORMAL_BASIS_EXPAND_NORM; "ORTHONORMAL_BASIS_SUBSPACE",ORTHONORMAL_BASIS_SUBSPACE; "ORTHONORMAL_EXTENSION",ORTHONORMAL_EXTENSION; "OR_CLAUSES",OR_CLAUSES; "OR_DEF",OR_DEF; "OR_EXISTS_THM",OR_EXISTS_THM; "OSTROWSKI_THEOREM",OSTROWSKI_THEOREM; "OUTER",OUTER; "OUTERMORPHISM_MBASIS",OUTERMORPHISM_MBASIS; "OUTERMORPHISM_MBASIS_EMPTY",OUTERMORPHISM_MBASIS_EMPTY; "OUTER_ACI",OUTER_ACI; "OUTER_ASSOC",OUTER_ASSOC; "OUTER_LADD",OUTER_LADD; "OUTER_LEBESGUE_MEASURE",OUTER_LEBESGUE_MEASURE; "OUTER_LMUL",OUTER_LMUL; "OUTER_LNEG",OUTER_LNEG; "OUTER_LZERO",OUTER_LZERO; "OUTER_MBASIS",OUTER_MBASIS; "OUTER_MBASIS_LSCALAR",OUTER_MBASIS_LSCALAR; "OUTER_MBASIS_REFL",OUTER_MBASIS_REFL; "OUTER_MBASIS_RSCALAR",OUTER_MBASIS_RSCALAR; "OUTER_MBASIS_SING",OUTER_MBASIS_SING; "OUTER_MBASIS_SKEWSYM",OUTER_MBASIS_SKEWSYM; "OUTER_MEASURE",OUTER_MEASURE; "OUTER_MEASURE_EQ",OUTER_MEASURE_EQ; "OUTER_MEASURE_GEN",OUTER_MEASURE_GEN; "OUTER_RADD",OUTER_RADD; "OUTER_RMUL",OUTER_RMUL; "OUTER_RNEG",OUTER_RNEG; "OUTER_RZERO",OUTER_RZERO; "OUTL",OUTL; "OUTR",OUTR; "OUTSIDE",OUTSIDE; "OUTSIDE_BOUNDED_NONEMPTY",OUTSIDE_BOUNDED_NONEMPTY; "OUTSIDE_COMPACT_IN_OPEN",OUTSIDE_COMPACT_IN_OPEN; "OUTSIDE_CONNECTED_COMPONENT_LE",OUTSIDE_CONNECTED_COMPONENT_LE; "OUTSIDE_CONNECTED_COMPONENT_LT",OUTSIDE_CONNECTED_COMPONENT_LT; "OUTSIDE_CONVEX",OUTSIDE_CONVEX; "OUTSIDE_EMPTY",OUTSIDE_EMPTY; "OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT",OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT; "OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE",OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE; "OUTSIDE_FRONTIER_MISSES_CLOSURE",OUTSIDE_FRONTIER_MISSES_CLOSURE; "OUTSIDE_INSIDE",OUTSIDE_INSIDE; "OUTSIDE_IN_COMPONENTS",OUTSIDE_IN_COMPONENTS; "OUTSIDE_LINEAR_IMAGE",OUTSIDE_LINEAR_IMAGE; "OUTSIDE_MONO",OUTSIDE_MONO; "OUTSIDE_NO_OVERLAP",OUTSIDE_NO_OVERLAP; "OUTSIDE_SAME_COMPONENT",OUTSIDE_SAME_COMPONENT; "OUTSIDE_SPHERE",OUTSIDE_SPHERE; "OUTSIDE_SUBSET_CONVEX",OUTSIDE_SUBSET_CONVEX; "OUTSIDE_TRANSLATION",OUTSIDE_TRANSLATION; "OUTSIDE_UNION_OUTSIDE_UNION",OUTSIDE_UNION_OUTSIDE_UNION; "OUTSIDE_WITH_OUTSIDE",OUTSIDE_WITH_OUTSIDE; "PAIR",PAIR; "PAIRED_ETA_THM",PAIRED_ETA_THM; "PAIRED_EXT",PAIRED_EXT; "PAIRWISE",PAIRWISE; "PAIRWISE_AND",PAIRWISE_AND; "PAIRWISE_APPEND",PAIRWISE_APPEND; "PAIRWISE_CHAIN_UNIONS",PAIRWISE_CHAIN_UNIONS; "PAIRWISE_DISJOINT_COMPONENTS",PAIRWISE_DISJOINT_COMPONENTS; "PAIRWISE_DISJOINT_LEBESGUE_MEASURABLE_IMP_COUNTABLE",PAIRWISE_DISJOINT_LEBESGUE_MEASURABLE_IMP_COUNTABLE; "PAIRWISE_EMPTY",PAIRWISE_EMPTY; "PAIRWISE_IMAGE",PAIRWISE_IMAGE; "PAIRWISE_IMP",PAIRWISE_IMP; "PAIRWISE_IMPLIES",PAIRWISE_IMPLIES; "PAIRWISE_INSERT",PAIRWISE_INSERT; "PAIRWISE_MAP",PAIRWISE_MAP; "PAIRWISE_MONO",PAIRWISE_MONO; "PAIRWISE_ORTHOGONAL_IMP_FINITE",PAIRWISE_ORTHOGONAL_IMP_FINITE; "PAIRWISE_ORTHOGONAL_INDEPENDENT",PAIRWISE_ORTHOGONAL_INDEPENDENT; "PAIRWISE_SING",PAIRWISE_SING; "PAIRWISE_TRANSITIVE",PAIRWISE_TRANSITIVE; "PAIRWISE_UNION",PAIRWISE_UNION; "PAIR_EQ",PAIR_EQ; "PAIR_EXISTS_THM",PAIR_EXISTS_THM; "PAIR_SURJECTIVE",PAIR_SURJECTIVE; "PARACOMPACT",PARACOMPACT; "PARACOMPACT_CLOSED",PARACOMPACT_CLOSED; "PARACOMPACT_CLOSED_IN",PARACOMPACT_CLOSED_IN; "PARTIAL_DIVISION_EXTEND",PARTIAL_DIVISION_EXTEND; "PARTIAL_DIVISION_EXTEND_1",PARTIAL_DIVISION_EXTEND_1; "PARTIAL_DIVISION_EXTEND_INTERVAL",PARTIAL_DIVISION_EXTEND_INTERVAL; "PARTIAL_DIVISION_OF_TAGGED_DIVISION",PARTIAL_DIVISION_OF_TAGGED_DIVISION; "PARTIAL_SUMS_COMPONENT_LE_INFSUM",PARTIAL_SUMS_COMPONENT_LE_INFSUM; "PARTIAL_SUMS_DROP_LE_INFSUM",PARTIAL_SUMS_DROP_LE_INFSUM; "PART_MEASURES",PART_MEASURES; "PASSOC_DEF",PASSOC_DEF; "PASTECART_ADD",PASTECART_ADD; "PASTECART_AS_ORTHOGONAL_SUM",PASTECART_AS_ORTHOGONAL_SUM; "PASTECART_CMUL",PASTECART_CMUL; "PASTECART_EQ",PASTECART_EQ; "PASTECART_EQ_VEC",PASTECART_EQ_VEC; "PASTECART_FST_SND",PASTECART_FST_SND; "PASTECART_INJ",PASTECART_INJ; "PASTECART_IN_INTERIOR",PASTECART_IN_INTERIOR; "PASTECART_IN_INTERIOR_SUBTOPOLOGY",PASTECART_IN_INTERIOR_SUBTOPOLOGY; "PASTECART_IN_PCROSS",PASTECART_IN_PCROSS; "PASTECART_NEG",PASTECART_NEG; "PASTECART_SUB",PASTECART_SUB; "PASTECART_VEC",PASTECART_VEC; "PASTECART_VSUM",PASTECART_VSUM; "PASTING_LEMMA",PASTING_LEMMA; "PASTING_LEMMA_CLOSED",PASTING_LEMMA_CLOSED; "PASTING_LEMMA_EXISTS",PASTING_LEMMA_EXISTS; "PASTING_LEMMA_EXISTS_CLOSED",PASTING_LEMMA_EXISTS_CLOSED; "PASTING_LEMMA_EXISTS_LOCALLY_FINITE",PASTING_LEMMA_EXISTS_LOCALLY_FINITE; "PASTING_LEMMA_LOCALLY_FINITE",PASTING_LEMMA_LOCALLY_FINITE; "PATHFINISH_COMPOSE",PATHFINISH_COMPOSE; "PATHFINISH_IN_PATH_IMAGE",PATHFINISH_IN_PATH_IMAGE; "PATHFINISH_JOIN",PATHFINISH_JOIN; "PATHFINISH_LINEAR_IMAGE",PATHFINISH_LINEAR_IMAGE; "PATHFINISH_LINEPATH",PATHFINISH_LINEPATH; "PATHFINISH_REVERSEPATH",PATHFINISH_REVERSEPATH; "PATHFINISH_SHIFTPATH",PATHFINISH_SHIFTPATH; "PATHFINISH_SUBPATH",PATHFINISH_SUBPATH; "PATHFINISH_TRANSLATION",PATHFINISH_TRANSLATION; "PATHSTART_COMPOSE",PATHSTART_COMPOSE; "PATHSTART_IN_PATH_IMAGE",PATHSTART_IN_PATH_IMAGE; "PATHSTART_JOIN",PATHSTART_JOIN; "PATHSTART_LINEAR_IMAGE_EQ",PATHSTART_LINEAR_IMAGE_EQ; "PATHSTART_LINEPATH",PATHSTART_LINEPATH; "PATHSTART_REVERSEPATH",PATHSTART_REVERSEPATH; "PATHSTART_SHIFTPATH",PATHSTART_SHIFTPATH; "PATHSTART_SUBPATH",PATHSTART_SUBPATH; "PATHSTART_TRANSLATION",PATHSTART_TRANSLATION; "PATH_ASSOC",PATH_ASSOC; "PATH_COMBINE",PATH_COMBINE; "PATH_COMPONENT",PATH_COMPONENT; "PATH_COMPONENT_DISJOINT",PATH_COMPONENT_DISJOINT; "PATH_COMPONENT_EMPTY",PATH_COMPONENT_EMPTY; "PATH_COMPONENT_EQ",PATH_COMPONENT_EQ; "PATH_COMPONENT_EQ_CONNECTED_COMPONENT",PATH_COMPONENT_EQ_CONNECTED_COMPONENT; "PATH_COMPONENT_EQ_EMPTY",PATH_COMPONENT_EQ_EMPTY; "PATH_COMPONENT_EQ_EQ",PATH_COMPONENT_EQ_EQ; "PATH_COMPONENT_IMP_CONNECTED_COMPONENT",PATH_COMPONENT_IMP_CONNECTED_COMPONENT; "PATH_COMPONENT_IMP_HOMOTOPIC_POINTS",PATH_COMPONENT_IMP_HOMOTOPIC_POINTS; "PATH_COMPONENT_IN",PATH_COMPONENT_IN; "PATH_COMPONENT_INTERMEDIATE_SUBSET",PATH_COMPONENT_INTERMEDIATE_SUBSET; "PATH_COMPONENT_LINEAR_IMAGE",PATH_COMPONENT_LINEAR_IMAGE; "PATH_COMPONENT_MAXIMAL",PATH_COMPONENT_MAXIMAL; "PATH_COMPONENT_MONO",PATH_COMPONENT_MONO; "PATH_COMPONENT_OF_SUBSET",PATH_COMPONENT_OF_SUBSET; "PATH_COMPONENT_PATH_COMPONENT",PATH_COMPONENT_PATH_COMPONENT; "PATH_COMPONENT_PATH_IMAGE_PATHSTART",PATH_COMPONENT_PATH_IMAGE_PATHSTART; "PATH_COMPONENT_PCROSS",PATH_COMPONENT_PCROSS; "PATH_COMPONENT_REFL",PATH_COMPONENT_REFL; "PATH_COMPONENT_REFL_EQ",PATH_COMPONENT_REFL_EQ; "PATH_COMPONENT_SET",PATH_COMPONENT_SET; "PATH_COMPONENT_SUBSET",PATH_COMPONENT_SUBSET; "PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT",PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; "PATH_COMPONENT_SYM",PATH_COMPONENT_SYM; "PATH_COMPONENT_SYM_EQ",PATH_COMPONENT_SYM_EQ; "PATH_COMPONENT_TRANS",PATH_COMPONENT_TRANS; "PATH_COMPONENT_TRANSLATION",PATH_COMPONENT_TRANSLATION; "PATH_COMPONENT_UNIQUE",PATH_COMPONENT_UNIQUE; "PATH_COMPONENT_UNIV",PATH_COMPONENT_UNIV; "PATH_COMPOSE_JOIN",PATH_COMPOSE_JOIN; "PATH_COMPOSE_REVERSEPATH",PATH_COMPOSE_REVERSEPATH; "PATH_CONNECTED_AFFINITY",PATH_CONNECTED_AFFINITY; "PATH_CONNECTED_AFFINITY_EQ",PATH_CONNECTED_AFFINITY_EQ; "PATH_CONNECTED_ANNULUS",PATH_CONNECTED_ANNULUS; "PATH_CONNECTED_ARCWISE",PATH_CONNECTED_ARCWISE; "PATH_CONNECTED_ARC_COMPLEMENT",PATH_CONNECTED_ARC_COMPLEMENT; "PATH_CONNECTED_CLOSURE_FROM_FRONTIER",PATH_CONNECTED_CLOSURE_FROM_FRONTIER; "PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; "PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX",PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX; "PATH_CONNECTED_COMPLEMENT_CARD_LT",PATH_CONNECTED_COMPLEMENT_CARD_LT; "PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; "PATH_CONNECTED_COMPONENT_SET",PATH_CONNECTED_COMPONENT_SET; "PATH_CONNECTED_CONNECTED_DIFF",PATH_CONNECTED_CONNECTED_DIFF; "PATH_CONNECTED_CONTINUOUS_IMAGE",PATH_CONNECTED_CONTINUOUS_IMAGE; "PATH_CONNECTED_CONVEX_DIFF_CARD_LT",PATH_CONNECTED_CONVEX_DIFF_CARD_LT; "PATH_CONNECTED_CONVEX_DIFF_COUNTABLE",PATH_CONNECTED_CONVEX_DIFF_COUNTABLE; "PATH_CONNECTED_CONVEX_DIFF_LOWDIM",PATH_CONNECTED_CONVEX_DIFF_LOWDIM; "PATH_CONNECTED_DELETE_INTERIOR_POINT",PATH_CONNECTED_DELETE_INTERIOR_POINT; "PATH_CONNECTED_DIFF_BALL",PATH_CONNECTED_DIFF_BALL; "PATH_CONNECTED_EMPTY",PATH_CONNECTED_EMPTY; "PATH_CONNECTED_EQ_CONNECTED",PATH_CONNECTED_EQ_CONNECTED; "PATH_CONNECTED_EQ_CONNECTED_LPC",PATH_CONNECTED_EQ_CONNECTED_LPC; "PATH_CONNECTED_EQ_HOMOTOPIC_POINTS",PATH_CONNECTED_EQ_HOMOTOPIC_POINTS; "PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER",PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER; "PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL",PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL; "PATH_CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL",PATH_CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL; "PATH_CONNECTED_IFF_PATH_COMPONENT",PATH_CONNECTED_IFF_PATH_COMPONENT; "PATH_CONNECTED_IMP_CONNECTED",PATH_CONNECTED_IMP_CONNECTED; "PATH_CONNECTED_IMP_PATH_COMPONENT",PATH_CONNECTED_IMP_PATH_COMPONENT; "PATH_CONNECTED_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT",PATH_CONNECTED_INTERMEDIATE_CLOSURE_ANR_COMPLEMENT_COMPONENT; "PATH_CONNECTED_INTERVAL",PATH_CONNECTED_INTERVAL; "PATH_CONNECTED_LINEAR_IMAGE",PATH_CONNECTED_LINEAR_IMAGE; "PATH_CONNECTED_LINEAR_IMAGE_EQ",PATH_CONNECTED_LINEAR_IMAGE_EQ; "PATH_CONNECTED_LINEPATH",PATH_CONNECTED_LINEPATH; "PATH_CONNECTED_NEGATIONS",PATH_CONNECTED_NEGATIONS; "PATH_CONNECTED_OPEN_ARC_COMPLEMENT",PATH_CONNECTED_OPEN_ARC_COMPLEMENT; "PATH_CONNECTED_OPEN_DELETE",PATH_CONNECTED_OPEN_DELETE; "PATH_CONNECTED_OPEN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_DIFF_CARD_LT; "PATH_CONNECTED_OPEN_DIFF_COUNTABLE",PATH_CONNECTED_OPEN_DIFF_COUNTABLE; "PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT; "PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM",PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM; "PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM",PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM; "PATH_CONNECTED_PATH_COMPONENT",PATH_CONNECTED_PATH_COMPONENT; "PATH_CONNECTED_PATH_IMAGE",PATH_CONNECTED_PATH_IMAGE; "PATH_CONNECTED_PCROSS",PATH_CONNECTED_PCROSS; "PATH_CONNECTED_PCROSS_EQ",PATH_CONNECTED_PCROSS_EQ; "PATH_CONNECTED_PUNCTURED_BALL",PATH_CONNECTED_PUNCTURED_BALL; "PATH_CONNECTED_PUNCTURED_CBALL",PATH_CONNECTED_PUNCTURED_CBALL; "PATH_CONNECTED_PUNCTURED_CONVEX",PATH_CONNECTED_PUNCTURED_CONVEX; "PATH_CONNECTED_PUNCTURED_UNIVERSE",PATH_CONNECTED_PUNCTURED_UNIVERSE; "PATH_CONNECTED_SCALING",PATH_CONNECTED_SCALING; "PATH_CONNECTED_SCALING_EQ",PATH_CONNECTED_SCALING_EQ; "PATH_CONNECTED_SEGMENT",PATH_CONNECTED_SEGMENT; "PATH_CONNECTED_SEMIOPEN_SEGMENT",PATH_CONNECTED_SEMIOPEN_SEGMENT; "PATH_CONNECTED_SING",PATH_CONNECTED_SING; "PATH_CONNECTED_SPHERE",PATH_CONNECTED_SPHERE; "PATH_CONNECTED_SPHERE_EQ",PATH_CONNECTED_SPHERE_EQ; "PATH_CONNECTED_SPHERE_GEN",PATH_CONNECTED_SPHERE_GEN; "PATH_CONNECTED_SUMS",PATH_CONNECTED_SUMS; "PATH_CONNECTED_SUPERSET_COMPLEMENT_ARC_IMAGE",PATH_CONNECTED_SUPERSET_COMPLEMENT_ARC_IMAGE; "PATH_CONNECTED_TRANSLATION",PATH_CONNECTED_TRANSLATION; "PATH_CONNECTED_TRANSLATION_EQ",PATH_CONNECTED_TRANSLATION_EQ; "PATH_CONNECTED_UNION",PATH_CONNECTED_UNION; "PATH_CONNECTED_UNIONS",PATH_CONNECTED_UNIONS; "PATH_CONNECTED_UNIV",PATH_CONNECTED_UNIV; "PATH_CONTAINS_ARC",PATH_CONTAINS_ARC; "PATH_CONTINUOUS_IMAGE",PATH_CONTINUOUS_IMAGE; "PATH_EQ",PATH_EQ; "PATH_IMAGE_COMPOSE",PATH_IMAGE_COMPOSE; "PATH_IMAGE_CONST",PATH_IMAGE_CONST; "PATH_IMAGE_JOIN",PATH_IMAGE_JOIN; "PATH_IMAGE_JOIN_SUBSET",PATH_IMAGE_JOIN_SUBSET; "PATH_IMAGE_LINEAR_IMAGE",PATH_IMAGE_LINEAR_IMAGE; "PATH_IMAGE_LINEPATH",PATH_IMAGE_LINEPATH; "PATH_IMAGE_NONEMPTY",PATH_IMAGE_NONEMPTY; "PATH_IMAGE_REVERSEPATH",PATH_IMAGE_REVERSEPATH; "PATH_IMAGE_SHIFTPATH",PATH_IMAGE_SHIFTPATH; "PATH_IMAGE_SUBPATH",PATH_IMAGE_SUBPATH; "PATH_IMAGE_SUBPATH_COMBINE",PATH_IMAGE_SUBPATH_COMBINE; "PATH_IMAGE_SUBPATH_GEN",PATH_IMAGE_SUBPATH_GEN; "PATH_IMAGE_SUBPATH_SUBSET",PATH_IMAGE_SUBPATH_SUBSET; "PATH_IMAGE_SYM",PATH_IMAGE_SYM; "PATH_IMAGE_TRANSLATION",PATH_IMAGE_TRANSLATION; "PATH_JOIN",PATH_JOIN; "PATH_JOIN_EQ",PATH_JOIN_EQ; "PATH_JOIN_IMP",PATH_JOIN_IMP; "PATH_JOIN_PATH_ENDS",PATH_JOIN_PATH_ENDS; "PATH_LENGTH_COMBINE",PATH_LENGTH_COMBINE; "PATH_LENGTH_DIFFERENTIABLE",PATH_LENGTH_DIFFERENTIABLE; "PATH_LENGTH_EQ",PATH_LENGTH_EQ; "PATH_LENGTH_EQ_0",PATH_LENGTH_EQ_0; "PATH_LENGTH_EQ_LINE_SEGMENT",PATH_LENGTH_EQ_LINE_SEGMENT; "PATH_LENGTH_ISOMETRIC_IMAGE",PATH_LENGTH_ISOMETRIC_IMAGE; "PATH_LENGTH_JOIN",PATH_LENGTH_JOIN; "PATH_LENGTH_LINEAR_IMAGE",PATH_LENGTH_LINEAR_IMAGE; "PATH_LENGTH_LINEPATH",PATH_LENGTH_LINEPATH; "PATH_LENGTH_LIPSCHITZ",PATH_LENGTH_LIPSCHITZ; "PATH_LENGTH_POS_LE",PATH_LENGTH_POS_LE; "PATH_LENGTH_REPARAMETRIZATION",PATH_LENGTH_REPARAMETRIZATION; "PATH_LENGTH_REVERSEPATH",PATH_LENGTH_REVERSEPATH; "PATH_LENGTH_SCALING",PATH_LENGTH_SCALING; "PATH_LENGTH_SHIFTPATH",PATH_LENGTH_SHIFTPATH; "PATH_LENGTH_SUBPATH",PATH_LENGTH_SUBPATH; "PATH_LENGTH_SUBPATH_LE",PATH_LENGTH_SUBPATH_LE; "PATH_LENGTH_TRANSLATION",PATH_LENGTH_TRANSLATION; "PATH_LINEAR_IMAGE_EQ",PATH_LINEAR_IMAGE_EQ; "PATH_LINEPATH",PATH_LINEPATH; "PATH_REVERSEPATH",PATH_REVERSEPATH; "PATH_SHIFTPATH",PATH_SHIFTPATH; "PATH_SUBPATH",PATH_SUBPATH; "PATH_SYM",PATH_SYM; "PATH_TRANSLATION_EQ",PATH_TRANSLATION_EQ; "PCROSS",PCROSS; "PCROSS_AS_ORTHOGONAL_SUM",PCROSS_AS_ORTHOGONAL_SUM; "PCROSS_DIFF",PCROSS_DIFF; "PCROSS_EMPTY",PCROSS_EMPTY; "PCROSS_EQ",PCROSS_EQ; "PCROSS_EQ_EMPTY",PCROSS_EQ_EMPTY; "PCROSS_INTER",PCROSS_INTER; "PCROSS_INTERS",PCROSS_INTERS; "PCROSS_INTERS_INTERS",PCROSS_INTERS_INTERS; "PCROSS_INTERVAL",PCROSS_INTERVAL; "PCROSS_MONO",PCROSS_MONO; "PCROSS_UNION",PCROSS_UNION; "PCROSS_UNIONS",PCROSS_UNIONS; "PCROSS_UNIONS_UNIONS",PCROSS_UNIONS_UNIONS; "PERFECT_FROM_CLOSURE",PERFECT_FROM_CLOSURE; "PERMUTATION",PERMUTATION; "PERMUTATION_BIJECTIVE",PERMUTATION_BIJECTIVE; "PERMUTATION_COMPOSE",PERMUTATION_COMPOSE; "PERMUTATION_COMPOSE_EQ",PERMUTATION_COMPOSE_EQ; "PERMUTATION_COMPOSE_SWAP",PERMUTATION_COMPOSE_SWAP; "PERMUTATION_FINITE_SUPPORT",PERMUTATION_FINITE_SUPPORT; "PERMUTATION_I",PERMUTATION_I; "PERMUTATION_INVERSE",PERMUTATION_INVERSE; "PERMUTATION_INVERSE_COMPOSE",PERMUTATION_INVERSE_COMPOSE; "PERMUTATION_INVERSE_WORKS",PERMUTATION_INVERSE_WORKS; "PERMUTATION_LEMMA",PERMUTATION_LEMMA; "PERMUTATION_PERMUTES",PERMUTATION_PERMUTES; "PERMUTATION_SWAP",PERMUTATION_SWAP; "PERMUTES_BIJECTIONS",PERMUTES_BIJECTIONS; "PERMUTES_COMPOSE",PERMUTES_COMPOSE; "PERMUTES_EMPTY",PERMUTES_EMPTY; "PERMUTES_FINITE_INJECTIVE",PERMUTES_FINITE_INJECTIVE; "PERMUTES_FINITE_SURJECTIVE",PERMUTES_FINITE_SURJECTIVE; "PERMUTES_I",PERMUTES_I; "PERMUTES_ID",PERMUTES_ID; "PERMUTES_IMAGE",PERMUTES_IMAGE; "PERMUTES_INDUCT",PERMUTES_INDUCT; "PERMUTES_INJECTIVE",PERMUTES_INJECTIVE; "PERMUTES_INSERT",PERMUTES_INSERT; "PERMUTES_INSERT_LEMMA",PERMUTES_INSERT_LEMMA; "PERMUTES_INVERSE",PERMUTES_INVERSE; "PERMUTES_INVERSES",PERMUTES_INVERSES; "PERMUTES_INVERSES_o",PERMUTES_INVERSES_o; "PERMUTES_INVERSE_EQ",PERMUTES_INVERSE_EQ; "PERMUTES_INVERSE_INVERSE",PERMUTES_INVERSE_INVERSE; "PERMUTES_INVOLUTION",PERMUTES_INVOLUTION; "PERMUTES_IN_IMAGE",PERMUTES_IN_IMAGE; "PERMUTES_IN_NUMSEG",PERMUTES_IN_NUMSEG; "PERMUTES_NUMSET_GE",PERMUTES_NUMSET_GE; "PERMUTES_NUMSET_LE",PERMUTES_NUMSET_LE; "PERMUTES_SING",PERMUTES_SING; "PERMUTES_SUBSET",PERMUTES_SUBSET; "PERMUTES_SUPERSET",PERMUTES_SUPERSET; "PERMUTES_SURJECTIVE",PERMUTES_SURJECTIVE; "PERMUTES_SWAP",PERMUTES_SWAP; "PERMUTES_UNIV",PERMUTES_UNIV; "PERRON_FROBENIUS",PERRON_FROBENIUS; "PICARD_LINDELOF_RIGHT",PICARD_LINDELOF_RIGHT; "POLYHEDRAL_CONVEX_CONE",POLYHEDRAL_CONVEX_CONE; "POLYHEDRON",POLYHEDRON; "POLYHEDRON_AFFINE_HULL",POLYHEDRON_AFFINE_HULL; "POLYHEDRON_AS_CONE_PLUS_CONV",POLYHEDRON_AS_CONE_PLUS_CONV; "POLYHEDRON_CONIC_HULL_POLYTOPE",POLYHEDRON_CONIC_HULL_POLYTOPE; "POLYHEDRON_CONIC_HULL_VERTEX_IMAGE",POLYHEDRON_CONIC_HULL_VERTEX_IMAGE; "POLYHEDRON_CONVEX_CONE_HULL",POLYHEDRON_CONVEX_CONE_HULL; "POLYHEDRON_CONVEX_CONE_HULL_POLYTOPE",POLYHEDRON_CONVEX_CONE_HULL_POLYTOPE; "POLYHEDRON_CONVEX_HULL",POLYHEDRON_CONVEX_HULL; "POLYHEDRON_EMPTY",POLYHEDRON_EMPTY; "POLYHEDRON_EQ_FINITE_EXPOSED_FACES",POLYHEDRON_EQ_FINITE_EXPOSED_FACES; "POLYHEDRON_EQ_FINITE_FACES",POLYHEDRON_EQ_FINITE_FACES; "POLYHEDRON_HALFSPACE_GE",POLYHEDRON_HALFSPACE_GE; "POLYHEDRON_HALFSPACE_LE",POLYHEDRON_HALFSPACE_LE; "POLYHEDRON_HYPERPLANE",POLYHEDRON_HYPERPLANE; "POLYHEDRON_IMP_CLOSED",POLYHEDRON_IMP_CLOSED; "POLYHEDRON_IMP_CONVEX",POLYHEDRON_IMP_CONVEX; "POLYHEDRON_INTER",POLYHEDRON_INTER; "POLYHEDRON_INTERS",POLYHEDRON_INTERS; "POLYHEDRON_INTERVAL",POLYHEDRON_INTERVAL; "POLYHEDRON_INTER_AFFINE",POLYHEDRON_INTER_AFFINE; "POLYHEDRON_INTER_AFFINE_MINIMAL",POLYHEDRON_INTER_AFFINE_MINIMAL; "POLYHEDRON_INTER_AFFINE_PARALLEL",POLYHEDRON_INTER_AFFINE_PARALLEL; "POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL",POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL; "POLYHEDRON_INTER_POLYTOPE",POLYHEDRON_INTER_POLYTOPE; "POLYHEDRON_LINEAR_IMAGE",POLYHEDRON_LINEAR_IMAGE; "POLYHEDRON_LINEAR_IMAGE_EQ",POLYHEDRON_LINEAR_IMAGE_EQ; "POLYHEDRON_LINEAR_PREIMAGE",POLYHEDRON_LINEAR_PREIMAGE; "POLYHEDRON_MINIMAL_LEMMA",POLYHEDRON_MINIMAL_LEMMA; "POLYHEDRON_NEGATIONS",POLYHEDRON_NEGATIONS; "POLYHEDRON_POLYTOPE_SUMS",POLYHEDRON_POLYTOPE_SUMS; "POLYHEDRON_POSITIVE_ORTHANT",POLYHEDRON_POSITIVE_ORTHANT; "POLYHEDRON_RIDGE_TWO_FACETS",POLYHEDRON_RIDGE_TWO_FACETS; "POLYHEDRON_SUMS",POLYHEDRON_SUMS; "POLYHEDRON_TRANSLATION_EQ",POLYHEDRON_TRANSLATION_EQ; "POLYHEDRON_UNIV",POLYHEDRON_UNIV; "POLYNOMIAL_FUNCTION_ADD",POLYNOMIAL_FUNCTION_ADD; "POLYNOMIAL_FUNCTION_CONST",POLYNOMIAL_FUNCTION_CONST; "POLYNOMIAL_FUNCTION_FINITE_ROOTS",POLYNOMIAL_FUNCTION_FINITE_ROOTS; "POLYNOMIAL_FUNCTION_I",POLYNOMIAL_FUNCTION_I; "POLYNOMIAL_FUNCTION_ID",POLYNOMIAL_FUNCTION_ID; "POLYNOMIAL_FUNCTION_INDUCT",POLYNOMIAL_FUNCTION_INDUCT; "POLYNOMIAL_FUNCTION_LMUL",POLYNOMIAL_FUNCTION_LMUL; "POLYNOMIAL_FUNCTION_MUL",POLYNOMIAL_FUNCTION_MUL; "POLYNOMIAL_FUNCTION_NEG",POLYNOMIAL_FUNCTION_NEG; "POLYNOMIAL_FUNCTION_POW",POLYNOMIAL_FUNCTION_POW; "POLYNOMIAL_FUNCTION_PRODUCT",POLYNOMIAL_FUNCTION_PRODUCT; "POLYNOMIAL_FUNCTION_RMUL",POLYNOMIAL_FUNCTION_RMUL; "POLYNOMIAL_FUNCTION_SUB",POLYNOMIAL_FUNCTION_SUB; "POLYNOMIAL_FUNCTION_SUM",POLYNOMIAL_FUNCTION_SUM; "POLYNOMIAL_FUNCTION_o",POLYNOMIAL_FUNCTION_o; "POLYTOPE_1",POLYTOPE_1; "POLYTOPE_AFFINITY",POLYTOPE_AFFINITY; "POLYTOPE_AFFINITY_EQ",POLYTOPE_AFFINITY_EQ; "POLYTOPE_AFF_DIM_1",POLYTOPE_AFF_DIM_1; "POLYTOPE_CONVEX_HULL",POLYTOPE_CONVEX_HULL; "POLYTOPE_EMPTY",POLYTOPE_EMPTY; "POLYTOPE_EQ_BOUNDED_POLYHEDRON",POLYTOPE_EQ_BOUNDED_POLYHEDRON; "POLYTOPE_FACET_EXISTS",POLYTOPE_FACET_EXISTS; "POLYTOPE_FACET_LOWER_BOUND",POLYTOPE_FACET_LOWER_BOUND; "POLYTOPE_IMP_BOUNDED",POLYTOPE_IMP_BOUNDED; "POLYTOPE_IMP_CLOSED",POLYTOPE_IMP_CLOSED; "POLYTOPE_IMP_COMPACT",POLYTOPE_IMP_COMPACT; "POLYTOPE_IMP_CONVEX",POLYTOPE_IMP_CONVEX; "POLYTOPE_IMP_POLYHEDRON",POLYTOPE_IMP_POLYHEDRON; "POLYTOPE_INTER",POLYTOPE_INTER; "POLYTOPE_INTERVAL",POLYTOPE_INTERVAL; "POLYTOPE_INTER_POLYHEDRON",POLYTOPE_INTER_POLYHEDRON; "POLYTOPE_LINEAR_IMAGE",POLYTOPE_LINEAR_IMAGE; "POLYTOPE_LINEAR_IMAGE_EQ",POLYTOPE_LINEAR_IMAGE_EQ; "POLYTOPE_LOWDIM_IMP_SIMPLEX",POLYTOPE_LOWDIM_IMP_SIMPLEX; "POLYTOPE_NEGATIONS",POLYTOPE_NEGATIONS; "POLYTOPE_PCROSS",POLYTOPE_PCROSS; "POLYTOPE_PCROSS_EQ",POLYTOPE_PCROSS_EQ; "POLYTOPE_SCALING",POLYTOPE_SCALING; "POLYTOPE_SCALING_EQ",POLYTOPE_SCALING_EQ; "POLYTOPE_SEGMENT",POLYTOPE_SEGMENT; "POLYTOPE_SING",POLYTOPE_SING; "POLYTOPE_SUMS",POLYTOPE_SUMS; "POLYTOPE_TRANSLATION_EQ",POLYTOPE_TRANSLATION_EQ; "POLYTOPE_UNION_CONVEX_HULL_FACETS",POLYTOPE_UNION_CONVEX_HULL_FACETS; "POLYTOPE_VERTEX_IMAGE",POLYTOPE_VERTEX_IMAGE; "POLYTOPE_VERTEX_LOWER_BOUND",POLYTOPE_VERTEX_LOWER_BOUND; "POSET_ANTISYM",POSET_ANTISYM; "POSET_FLEQ",POSET_FLEQ; "POSET_REFL",POSET_REFL; "POSET_RESTRICTED_SUBSET",POSET_RESTRICTED_SUBSET; "POSET_TRANS",POSET_TRANS; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LE_GEN; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT; "POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT_GEN",POSITIVE_AE_DERIVATIVE_IMP_INCREASING_LT_GEN; "POSITIVE_AE_DERIVATIVE_IMP_NONDECREASING",POSITIVE_AE_DERIVATIVE_IMP_NONDECREASING; "POSITIVE_DEFINITE_1",POSITIVE_DEFINITE_1; "POSITIVE_DEFINITE_1_GEN",POSITIVE_DEFINITE_1_GEN; "POSITIVE_DEFINITE_2",POSITIVE_DEFINITE_2; "POSITIVE_DEFINITE_2_DET",POSITIVE_DEFINITE_2_DET; "POSITIVE_DEFINITE_ADD",POSITIVE_DEFINITE_ADD; "POSITIVE_DEFINITE_CMUL",POSITIVE_DEFINITE_CMUL; "POSITIVE_DEFINITE_COFACTOR",POSITIVE_DEFINITE_COFACTOR; "POSITIVE_DEFINITE_COFACTOR_EQ",POSITIVE_DEFINITE_COFACTOR_EQ; "POSITIVE_DEFINITE_COVARIANCE",POSITIVE_DEFINITE_COVARIANCE; "POSITIVE_DEFINITE_COVARIANCE_EQ",POSITIVE_DEFINITE_COVARIANCE_EQ; "POSITIVE_DEFINITE_COVARIANCE_EQ_ALT",POSITIVE_DEFINITE_COVARIANCE_EQ_ALT; "POSITIVE_DEFINITE_DIAGONAL_MATRIX",POSITIVE_DEFINITE_DIAGONAL_MATRIX; "POSITIVE_DEFINITE_DIAGONAL_MATRIX_EQ",POSITIVE_DEFINITE_DIAGONAL_MATRIX_EQ; "POSITIVE_DEFINITE_EIGENVALUES",POSITIVE_DEFINITE_EIGENVALUES; "POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY",POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY; "POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY_ALT",POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY_ALT; "POSITIVE_DEFINITE_EVENTUALLY",POSITIVE_DEFINITE_EVENTUALLY; "POSITIVE_DEFINITE_HADAMARD_PRODUCT",POSITIVE_DEFINITE_HADAMARD_PRODUCT; "POSITIVE_DEFINITE_ID",POSITIVE_DEFINITE_ID; "POSITIVE_DEFINITE_IMP_INVERTIBLE",POSITIVE_DEFINITE_IMP_INVERTIBLE; "POSITIVE_DEFINITE_IMP_POSITIVE_SEMIDEFINITE",POSITIVE_DEFINITE_IMP_POSITIVE_SEMIDEFINITE; "POSITIVE_DEFINITE_IMP_SYMMETRIC",POSITIVE_DEFINITE_IMP_SYMMETRIC; "POSITIVE_DEFINITE_INV",POSITIVE_DEFINITE_INV; "POSITIVE_DEFINITE_MAT",POSITIVE_DEFINITE_MAT; "POSITIVE_DEFINITE_MUL",POSITIVE_DEFINITE_MUL; "POSITIVE_DEFINITE_MUL_EQ",POSITIVE_DEFINITE_MUL_EQ; "POSITIVE_DEFINITE_NEARBY",POSITIVE_DEFINITE_NEARBY; "POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE",POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; "POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE_ADD",POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE_ADD; "POSITIVE_DEFINITE_SIMILAR",POSITIVE_DEFINITE_SIMILAR; "POSITIVE_DEFINITE_SIMILAR_EQ",POSITIVE_DEFINITE_SIMILAR_EQ; "POSITIVE_DEFINITE_TRANSP",POSITIVE_DEFINITE_TRANSP; "POSITIVE_SEMIDEFINITE_1",POSITIVE_SEMIDEFINITE_1; "POSITIVE_SEMIDEFINITE_1_GEN",POSITIVE_SEMIDEFINITE_1_GEN; "POSITIVE_SEMIDEFINITE_2",POSITIVE_SEMIDEFINITE_2; "POSITIVE_SEMIDEFINITE_2_DET",POSITIVE_SEMIDEFINITE_2_DET; "POSITIVE_SEMIDEFINITE_ADD",POSITIVE_SEMIDEFINITE_ADD; "POSITIVE_SEMIDEFINITE_AND_ORTHOGONAL",POSITIVE_SEMIDEFINITE_AND_ORTHOGONAL; "POSITIVE_SEMIDEFINITE_CMUL",POSITIVE_SEMIDEFINITE_CMUL; "POSITIVE_SEMIDEFINITE_COFACTOR",POSITIVE_SEMIDEFINITE_COFACTOR; "POSITIVE_SEMIDEFINITE_COVARIANCE",POSITIVE_SEMIDEFINITE_COVARIANCE; "POSITIVE_SEMIDEFINITE_COVARIANCE_EQ",POSITIVE_SEMIDEFINITE_COVARIANCE_EQ; "POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT",POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT; "POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE",POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE; "POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY",POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY; "POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX",POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX; "POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ",POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ; "POSITIVE_SEMIDEFINITE_EIGENVALUES",POSITIVE_SEMIDEFINITE_EIGENVALUES; "POSITIVE_SEMIDEFINITE_HADAMARD_PRODUCT",POSITIVE_SEMIDEFINITE_HADAMARD_PRODUCT; "POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC",POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC; "POSITIVE_SEMIDEFINITE_INV",POSITIVE_SEMIDEFINITE_INV; "POSITIVE_SEMIDEFINITE_MAT",POSITIVE_SEMIDEFINITE_MAT; "POSITIVE_SEMIDEFINITE_MUL",POSITIVE_SEMIDEFINITE_MUL; "POSITIVE_SEMIDEFINITE_MUL_EIGENVALUES",POSITIVE_SEMIDEFINITE_MUL_EIGENVALUES; "POSITIVE_SEMIDEFINITE_MUL_EQ",POSITIVE_SEMIDEFINITE_MUL_EQ; "POSITIVE_SEMIDEFINITE_POSITIVE_DEFINITE_ADD",POSITIVE_SEMIDEFINITE_POSITIVE_DEFINITE_ADD; "POSITIVE_SEMIDEFINITE_SIMILAR",POSITIVE_SEMIDEFINITE_SIMILAR; "POSITIVE_SEMIDEFINITE_SIMILAR_EQ",POSITIVE_SEMIDEFINITE_SIMILAR_EQ; "POSITIVE_SEMIDEFINITE_SQRT",POSITIVE_SEMIDEFINITE_SQRT; "POSITIVE_SEMIDEFINITE_SQRT_EQ",POSITIVE_SEMIDEFINITE_SQRT_EQ; "POSITIVE_SEMIDEFINITE_SQRT_UNIQUE",POSITIVE_SEMIDEFINITE_SQRT_UNIQUE; "POSITIVE_SEMIDEFINITE_SUBMATRIX_2",POSITIVE_SEMIDEFINITE_SUBMATRIX_2; "POSITIVE_SEMIDEFINITE_TRACE_EQ_0",POSITIVE_SEMIDEFINITE_TRACE_EQ_0; "POSITIVE_SEMIDEFINITE_TRANSP",POSITIVE_SEMIDEFINITE_TRANSP; "POSITIVE_SEMIDEFINITE_ZERO_COLUMN",POSITIVE_SEMIDEFINITE_ZERO_COLUMN; "POSITIVE_SEMIDEFINITE_ZERO_FORM",POSITIVE_SEMIDEFINITE_ZERO_FORM; "POSITIVE_SEMIDEFINITE_ZERO_FORM_EQ",POSITIVE_SEMIDEFINITE_ZERO_FORM_EQ; "POSITIVE_SEMIDEFINITE_ZERO_ROW",POSITIVE_SEMIDEFINITE_ZERO_ROW; "POWERSET_CLAUSES",POWERSET_CLAUSES; "POW_2_SQRT",POW_2_SQRT; "POW_2_SQRT_ABS",POW_2_SQRT_ABS; "PRE",PRE; "PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE",PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE; "PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_ALT",PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_ALT; "PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN",PRESERVES_LEBESGUE_MEASURABLE_IFF_PRESERVES_NEGLIGIBLE_GEN; "PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE",PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE; "PRESERVES_NEGLIGIBLE_IMAGE",PRESERVES_NEGLIGIBLE_IMAGE; "PRESERVES_NEGLIGIBLE_IMAGE_UNIV",PRESERVES_NEGLIGIBLE_IMAGE_UNIV; "PRESERVES_NORM_INJECTIVE",PRESERVES_NORM_INJECTIVE; "PRESERVES_NORM_PRESERVES_DOT",PRESERVES_NORM_PRESERVES_DOT; "PRESEVES_NORM_PRESERVES_DIST",PRESEVES_NORM_PRESERVES_DIST; "PRE_ELIM_THM",PRE_ELIM_THM; "PRE_ELIM_THM'",PRE_ELIM_THM'; "PRODUCT_1",PRODUCT_1; "PRODUCT_2",PRODUCT_2; "PRODUCT_3",PRODUCT_3; "PRODUCT_4",PRODUCT_4; "PRODUCT_ABS",PRODUCT_ABS; "PRODUCT_ADD_SPLIT",PRODUCT_ADD_SPLIT; "PRODUCT_ASSOCIATIVE",PRODUCT_ASSOCIATIVE; "PRODUCT_CLAUSES",PRODUCT_CLAUSES; "PRODUCT_CLAUSES_LEFT",PRODUCT_CLAUSES_LEFT; "PRODUCT_CLAUSES_NUMSEG",PRODUCT_CLAUSES_NUMSEG; "PRODUCT_CLAUSES_RIGHT",PRODUCT_CLAUSES_RIGHT; "PRODUCT_CLOSED",PRODUCT_CLOSED; "PRODUCT_CONST",PRODUCT_CONST; "PRODUCT_CONST_NUMSEG",PRODUCT_CONST_NUMSEG; "PRODUCT_CONST_NUMSEG_1",PRODUCT_CONST_NUMSEG_1; "PRODUCT_DELETE",PRODUCT_DELETE; "PRODUCT_DELTA",PRODUCT_DELTA; "PRODUCT_DIV",PRODUCT_DIV; "PRODUCT_DIV_NUMSEG",PRODUCT_DIV_NUMSEG; "PRODUCT_EQ",PRODUCT_EQ; "PRODUCT_EQ_0",PRODUCT_EQ_0; "PRODUCT_EQ_0_NUMSEG",PRODUCT_EQ_0_NUMSEG; "PRODUCT_EQ_1",PRODUCT_EQ_1; "PRODUCT_EQ_1_NUMSEG",PRODUCT_EQ_1_NUMSEG; "PRODUCT_EQ_NUMSEG",PRODUCT_EQ_NUMSEG; "PRODUCT_IMAGE",PRODUCT_IMAGE; "PRODUCT_INV",PRODUCT_INV; "PRODUCT_LADD",PRODUCT_LADD; "PRODUCT_LE",PRODUCT_LE; "PRODUCT_LE_1",PRODUCT_LE_1; "PRODUCT_LE_NUMSEG",PRODUCT_LE_NUMSEG; "PRODUCT_LMUL",PRODUCT_LMUL; "PRODUCT_LNEG",PRODUCT_LNEG; "PRODUCT_LZERO",PRODUCT_LZERO; "PRODUCT_MBASIS",PRODUCT_MBASIS; "PRODUCT_MBASIS_SING",PRODUCT_MBASIS_SING; "PRODUCT_MUL",PRODUCT_MUL; "PRODUCT_MUL_GEN",PRODUCT_MUL_GEN; "PRODUCT_MUL_NUMSEG",PRODUCT_MUL_NUMSEG; "PRODUCT_NEG",PRODUCT_NEG; "PRODUCT_NEG_NUMSEG",PRODUCT_NEG_NUMSEG; "PRODUCT_NEG_NUMSEG_1",PRODUCT_NEG_NUMSEG_1; "PRODUCT_OFFSET",PRODUCT_OFFSET; "PRODUCT_ONE",PRODUCT_ONE; "PRODUCT_PAIR",PRODUCT_PAIR; "PRODUCT_PERMUTE",PRODUCT_PERMUTE; "PRODUCT_PERMUTE_NUMSEG",PRODUCT_PERMUTE_NUMSEG; "PRODUCT_POS_LE",PRODUCT_POS_LE; "PRODUCT_POS_LE_NUMSEG",PRODUCT_POS_LE_NUMSEG; "PRODUCT_POS_LT",PRODUCT_POS_LT; "PRODUCT_POS_LT_NUMSEG",PRODUCT_POS_LT_NUMSEG; "PRODUCT_RADD",PRODUCT_RADD; "PRODUCT_REFLECT",PRODUCT_REFLECT; "PRODUCT_RMUL",PRODUCT_RMUL; "PRODUCT_RNEG",PRODUCT_RNEG; "PRODUCT_RZERO",PRODUCT_RZERO; "PRODUCT_SING",PRODUCT_SING; "PRODUCT_SING_NUMSEG",PRODUCT_SING_NUMSEG; "PRODUCT_SUPERSET",PRODUCT_SUPERSET; "PRODUCT_SUPPORT",PRODUCT_SUPPORT; "PRODUCT_UNION",PRODUCT_UNION; "PRODUCT_UNIV",PRODUCT_UNIV; "PROPERTY_EMPTY_INTERVAL",PROPERTY_EMPTY_INTERVAL; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM; "PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM_GEN",PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM_GEN; "PROPER_LOCAL_HOMEOMORPHISM_GLOBAL",PROPER_LOCAL_HOMEOMORPHISM_GLOBAL; "PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP",PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP; "PROPER_MAP",PROPER_MAP; "PROPER_MAP_COMPOSE",PROPER_MAP_COMPOSE; "PROPER_MAP_EQ",PROPER_MAP_EQ; "PROPER_MAP_ESCAPES",PROPER_MAP_ESCAPES; "PROPER_MAP_ESCAPES_FROM_IMAGE",PROPER_MAP_ESCAPES_FROM_IMAGE; "PROPER_MAP_ESCAPES_IMP",PROPER_MAP_ESCAPES_IMP; "PROPER_MAP_FROM_COMPACT",PROPER_MAP_FROM_COMPACT; "PROPER_MAP_FROM_COMPACT_ALT",PROPER_MAP_FROM_COMPACT_ALT; "PROPER_MAP_FROM_COMPOSITION_LEFT",PROPER_MAP_FROM_COMPOSITION_LEFT; "PROPER_MAP_FROM_COMPOSITION_RIGHT",PROPER_MAP_FROM_COMPOSITION_RIGHT; "PROPER_MAP_FSTCART",PROPER_MAP_FSTCART; "PROPER_MAP_NORM",PROPER_MAP_NORM; "PROPER_MAP_NORM_SIMPLE",PROPER_MAP_NORM_SIMPLE; "PROPER_MAP_SEQUENTIALLY",PROPER_MAP_SEQUENTIALLY; "PROPER_MAP_SEQUENTIALLY_IMP",PROPER_MAP_SEQUENTIALLY_IMP; "PROPER_MAP_SEQUENTIALLY_REV",PROPER_MAP_SEQUENTIALLY_REV; "PROPER_MAP_SNDCART",PROPER_MAP_SNDCART; "PROPER_MAP_TO_COMPACT",PROPER_MAP_TO_COMPACT; "PSUBSET",PSUBSET; "PSUBSET_ALT",PSUBSET_ALT; "PSUBSET_INSERT_SUBSET",PSUBSET_INSERT_SUBSET; "PSUBSET_IRREFL",PSUBSET_IRREFL; "PSUBSET_MEMBER",PSUBSET_MEMBER; "PSUBSET_SUBSET_TRANS",PSUBSET_SUBSET_TRANS; "PSUBSET_TRANS",PSUBSET_TRANS; "PSUBSET_UNIONS_PAIRWISE_DISJOINT",PSUBSET_UNIONS_PAIRWISE_DISJOINT; "PSUBSET_UNIV",PSUBSET_UNIV; "PUSHIN_DROPOUT",PUSHIN_DROPOUT; "P_HULL",P_HULL; "Product_DEF",Product_DEF; "QUANTIFY_SURJECTION_HIGHER_THM",QUANTIFY_SURJECTION_HIGHER_THM; "QUANTIFY_SURJECTION_THM",QUANTIFY_SURJECTION_THM; "QUASICOMPACT_OPEN_CLOSED",QUASICOMPACT_OPEN_CLOSED; "QUOTIENT_MAP_CLOSED_MAP_EQ",QUOTIENT_MAP_CLOSED_MAP_EQ; "QUOTIENT_MAP_COMPOSE",QUOTIENT_MAP_COMPOSE; "QUOTIENT_MAP_FROM_COMPOSITION",QUOTIENT_MAP_FROM_COMPOSITION; "QUOTIENT_MAP_FROM_SUBSET",QUOTIENT_MAP_FROM_SUBSET; "QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED",QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED; "QUOTIENT_MAP_IMP_CONTINUOUS_OPEN",QUOTIENT_MAP_IMP_CONTINUOUS_OPEN; "QUOTIENT_MAP_OPEN_CLOSED",QUOTIENT_MAP_OPEN_CLOSED; "QUOTIENT_MAP_OPEN_MAP_EQ",QUOTIENT_MAP_OPEN_MAP_EQ; "QUOTIENT_MAP_RESTRICT",QUOTIENT_MAP_RESTRICT; "RADEMACHER",RADEMACHER; "RADEMACHER_GEN",RADEMACHER_GEN; "RADEMACHER_OPEN",RADEMACHER_OPEN; "RADEMACHER_UNIV",RADEMACHER_UNIV; "RADON",RADON; "RADON_EX_LEMMA",RADON_EX_LEMMA; "RADON_PARTITION",RADON_PARTITION; "RADON_S_LEMMA",RADON_S_LEMMA; "RADON_V_LEMMA",RADON_V_LEMMA; "RANK_0",RANK_0; "RANK_BOUND",RANK_BOUND; "RANK_CMUL",RANK_CMUL; "RANK_COFACTOR",RANK_COFACTOR; "RANK_COFACTOR_EQ_1",RANK_COFACTOR_EQ_1; "RANK_COFACTOR_EQ_FULL",RANK_COFACTOR_EQ_FULL; "RANK_DIAGONAL_MATRIX",RANK_DIAGONAL_MATRIX; "RANK_DIM_IM",RANK_DIM_IM; "RANK_EQ_0",RANK_EQ_0; "RANK_EQ_FULL_DET",RANK_EQ_FULL_DET; "RANK_GRAM",RANK_GRAM; "RANK_I",RANK_I; "RANK_INVERTIBLE_LMUL",RANK_INVERTIBLE_LMUL; "RANK_INVERTIBLE_RMUL",RANK_INVERTIBLE_RMUL; "RANK_MATRIX_INV",RANK_MATRIX_INV; "RANK_MATRIX_INV_LMUL",RANK_MATRIX_INV_LMUL; "RANK_MATRIX_INV_RMUL",RANK_MATRIX_INV_RMUL; "RANK_MUL_LE_LEFT",RANK_MUL_LE_LEFT; "RANK_MUL_LE_RIGHT",RANK_MUL_LE_RIGHT; "RANK_NEG",RANK_NEG; "RANK_NULLSPACE",RANK_NULLSPACE; "RANK_ROW",RANK_ROW; "RANK_SIMILAR",RANK_SIMILAR; "RANK_SYLVESTER",RANK_SYLVESTER; "RANK_TRANSP",RANK_TRANSP; "RANK_TRIANGLE",RANK_TRIANGLE; "RATIONAL_ABS",RATIONAL_ABS; "RATIONAL_ADD",RATIONAL_ADD; "RATIONAL_ALT",RATIONAL_ALT; "RATIONAL_APPROXIMATION",RATIONAL_APPROXIMATION; "RATIONAL_APPROXIMATION_ABOVE",RATIONAL_APPROXIMATION_ABOVE; "RATIONAL_APPROXIMATION_BELOW",RATIONAL_APPROXIMATION_BELOW; "RATIONAL_APPROXIMATION_STRADDLE",RATIONAL_APPROXIMATION_STRADDLE; "RATIONAL_BETWEEN",RATIONAL_BETWEEN; "RATIONAL_BETWEEN_EQ",RATIONAL_BETWEEN_EQ; "RATIONAL_CLOSED",RATIONAL_CLOSED; "RATIONAL_DIV",RATIONAL_DIV; "RATIONAL_INTEGER",RATIONAL_INTEGER; "RATIONAL_INV",RATIONAL_INV; "RATIONAL_INV_EQ",RATIONAL_INV_EQ; "RATIONAL_MUL",RATIONAL_MUL; "RATIONAL_NEG",RATIONAL_NEG; "RATIONAL_NEG_EQ",RATIONAL_NEG_EQ; "RATIONAL_NUM",RATIONAL_NUM; "RATIONAL_POW",RATIONAL_POW; "RATIONAL_SUB",RATIONAL_SUB; "RATIONAL_SUM",RATIONAL_SUM; "RAT_LEMMA1",RAT_LEMMA1; "RAT_LEMMA2",RAT_LEMMA2; "RAT_LEMMA3",RAT_LEMMA3; "RAT_LEMMA4",RAT_LEMMA4; "RAT_LEMMA5",RAT_LEMMA5; "RAY_TO_FRONTIER",RAY_TO_FRONTIER; "RAY_TO_RELATIVE_FRONTIER",RAY_TO_RELATIVE_FRONTIER; "RDIV_LT_EQ",RDIV_LT_EQ; "REAL_ABS_0",REAL_ABS_0; "REAL_ABS_1",REAL_ABS_1; "REAL_ABS_ABS",REAL_ABS_ABS; "REAL_ABS_BETWEEN",REAL_ABS_BETWEEN; "REAL_ABS_BETWEEN1",REAL_ABS_BETWEEN1; "REAL_ABS_BETWEEN2",REAL_ABS_BETWEEN2; "REAL_ABS_BOUND",REAL_ABS_BOUND; "REAL_ABS_BOUNDS",REAL_ABS_BOUNDS; "REAL_ABS_CASES",REAL_ABS_CASES; "REAL_ABS_CIRCLE",REAL_ABS_CIRCLE; "REAL_ABS_DIST",REAL_ABS_DIST; "REAL_ABS_DIV",REAL_ABS_DIV; "REAL_ABS_HAUSDIST",REAL_ABS_HAUSDIST; "REAL_ABS_INFNORM",REAL_ABS_INFNORM; "REAL_ABS_INF_LE",REAL_ABS_INF_LE; "REAL_ABS_INTEGER_LEMMA",REAL_ABS_INTEGER_LEMMA; "REAL_ABS_INV",REAL_ABS_INV; "REAL_ABS_LE",REAL_ABS_LE; "REAL_ABS_MDIST",REAL_ABS_MDIST; "REAL_ABS_MUL",REAL_ABS_MUL; "REAL_ABS_NEG",REAL_ABS_NEG; "REAL_ABS_NORM",REAL_ABS_NORM; "REAL_ABS_NUM",REAL_ABS_NUM; "REAL_ABS_NZ",REAL_ABS_NZ; "REAL_ABS_POS",REAL_ABS_POS; "REAL_ABS_POW",REAL_ABS_POW; "REAL_ABS_REFL",REAL_ABS_REFL; "REAL_ABS_SGN",REAL_ABS_SGN; "REAL_ABS_SIGN",REAL_ABS_SIGN; "REAL_ABS_SIGN2",REAL_ABS_SIGN2; "REAL_ABS_STILLNZ",REAL_ABS_STILLNZ; "REAL_ABS_SUB",REAL_ABS_SUB; "REAL_ABS_SUB_ABS",REAL_ABS_SUB_ABS; "REAL_ABS_SUB_INFNORM",REAL_ABS_SUB_INFNORM; "REAL_ABS_SUB_NORM",REAL_ABS_SUB_NORM; "REAL_ABS_SUP_LE",REAL_ABS_SUP_LE; "REAL_ABS_TRIANGLE",REAL_ABS_TRIANGLE; "REAL_ABS_TRIANGLE_LE",REAL_ABS_TRIANGLE_LE; "REAL_ABS_TRIANGLE_LT",REAL_ABS_TRIANGLE_LT; "REAL_ABS_ZERO",REAL_ABS_ZERO; "REAL_ADD2_SUB2",REAL_ADD2_SUB2; "REAL_ADD_AC",REAL_ADD_AC; "REAL_ADD_ASSOC",REAL_ADD_ASSOC; "REAL_ADD_LDISTRIB",REAL_ADD_LDISTRIB; "REAL_ADD_LID",REAL_ADD_LID; "REAL_ADD_LINV",REAL_ADD_LINV; "REAL_ADD_RDISTRIB",REAL_ADD_RDISTRIB; "REAL_ADD_RID",REAL_ADD_RID; "REAL_ADD_RINV",REAL_ADD_RINV; "REAL_ADD_SUB",REAL_ADD_SUB; "REAL_ADD_SUB2",REAL_ADD_SUB2; "REAL_ADD_SYM",REAL_ADD_SYM; "REAL_AFFINITY_EQ",REAL_AFFINITY_EQ; "REAL_AFFINITY_LE",REAL_AFFINITY_LE; "REAL_AFFINITY_LT",REAL_AFFINITY_LT; "REAL_ARCH",REAL_ARCH; "REAL_ARCH_INV",REAL_ARCH_INV; "REAL_ARCH_LT",REAL_ARCH_LT; "REAL_ARCH_POW",REAL_ARCH_POW; "REAL_ARCH_POW2",REAL_ARCH_POW2; "REAL_ARCH_POW_INV",REAL_ARCH_POW_INV; "REAL_ARCH_RDIV_EQ_0",REAL_ARCH_RDIV_EQ_0; "REAL_ARCH_SIMPLE",REAL_ARCH_SIMPLE; "REAL_BOUNDS_LE",REAL_BOUNDS_LE; "REAL_BOUNDS_LT",REAL_BOUNDS_LT; "REAL_CARD_INTSEG_INT",REAL_CARD_INTSEG_INT; "REAL_COMPLETE",REAL_COMPLETE; "REAL_COMPLETE_SOMEPOS",REAL_COMPLETE_SOMEPOS; "REAL_CONVEX_BOUND2_LT",REAL_CONVEX_BOUND2_LT; "REAL_CONVEX_BOUND_LE",REAL_CONVEX_BOUND_LE; "REAL_CONVEX_BOUND_LT",REAL_CONVEX_BOUND_LT; "REAL_DIFFSQ",REAL_DIFFSQ; "REAL_DIV_1",REAL_DIV_1; "REAL_DIV_EQ_0",REAL_DIV_EQ_0; "REAL_DIV_LMUL",REAL_DIV_LMUL; "REAL_DIV_POW2",REAL_DIV_POW2; "REAL_DIV_POW2_ALT",REAL_DIV_POW2_ALT; "REAL_DIV_REFL",REAL_DIV_REFL; "REAL_DIV_RMUL",REAL_DIV_RMUL; "REAL_DIV_SQRT",REAL_DIV_SQRT; "REAL_DOWN",REAL_DOWN; "REAL_DOWN2",REAL_DOWN2; "REAL_ENTIRE",REAL_ENTIRE; "REAL_EQ_ADD_LCANCEL",REAL_EQ_ADD_LCANCEL; "REAL_EQ_ADD_LCANCEL_0",REAL_EQ_ADD_LCANCEL_0; "REAL_EQ_ADD_RCANCEL",REAL_EQ_ADD_RCANCEL; "REAL_EQ_ADD_RCANCEL_0",REAL_EQ_ADD_RCANCEL_0; "REAL_EQ_AFFINITY",REAL_EQ_AFFINITY; "REAL_EQ_IMP_LE",REAL_EQ_IMP_LE; "REAL_EQ_INTEGERS",REAL_EQ_INTEGERS; "REAL_EQ_INTEGERS_IMP",REAL_EQ_INTEGERS_IMP; "REAL_EQ_INV2",REAL_EQ_INV2; "REAL_EQ_LCANCEL_IMP",REAL_EQ_LCANCEL_IMP; "REAL_EQ_LDIV_EQ",REAL_EQ_LDIV_EQ; "REAL_EQ_MUL_LCANCEL",REAL_EQ_MUL_LCANCEL; "REAL_EQ_MUL_RCANCEL",REAL_EQ_MUL_RCANCEL; "REAL_EQ_NEG2",REAL_EQ_NEG2; "REAL_EQ_RCANCEL_IMP",REAL_EQ_RCANCEL_IMP; "REAL_EQ_RDIV_EQ",REAL_EQ_RDIV_EQ; "REAL_EQ_SGN_ABS",REAL_EQ_SGN_ABS; "REAL_EQ_SQUARE_ABS",REAL_EQ_SQUARE_ABS; "REAL_EQ_SUB_LADD",REAL_EQ_SUB_LADD; "REAL_EQ_SUB_RADD",REAL_EQ_SUB_RADD; "REAL_FLOOR_ADD",REAL_FLOOR_ADD; "REAL_FLOOR_EQ",REAL_FLOOR_EQ; "REAL_FLOOR_FLOOR_DIV",REAL_FLOOR_FLOOR_DIV; "REAL_FLOOR_LE",REAL_FLOOR_LE; "REAL_FLOOR_LT",REAL_FLOOR_LT; "REAL_FLOOR_LT_REFL",REAL_FLOOR_LT_REFL; "REAL_FLOOR_NEG",REAL_FLOOR_NEG; "REAL_FLOOR_REFL",REAL_FLOOR_REFL; "REAL_FLOOR_TRIANGLE",REAL_FLOOR_TRIANGLE; "REAL_FRAC_ADD",REAL_FRAC_ADD; "REAL_FRAC_EQ",REAL_FRAC_EQ; "REAL_FRAC_EQ_0",REAL_FRAC_EQ_0; "REAL_FRAC_POS_LT",REAL_FRAC_POS_LT; "REAL_FRAC_ZERO",REAL_FRAC_ZERO; "REAL_HALF",REAL_HALF; "REAL_HAUSDIST_LE",REAL_HAUSDIST_LE; "REAL_HAUSDIST_LE_EQ",REAL_HAUSDIST_LE_EQ; "REAL_HAUSDIST_LE_SUMS",REAL_HAUSDIST_LE_SUMS; "REAL_HREAL_LEMMA1",REAL_HREAL_LEMMA1; "REAL_HREAL_LEMMA2",REAL_HREAL_LEMMA2; "REAL_INF_ASCLOSE",REAL_INF_ASCLOSE; "REAL_INF_BOUNDS",REAL_INF_BOUNDS; "REAL_INF_LE",REAL_INF_LE; "REAL_INF_LE_FINITE",REAL_INF_LE_FINITE; "REAL_INF_LT_FINITE",REAL_INF_LT_FINITE; "REAL_INF_UNIQUE",REAL_INF_UNIQUE; "REAL_INV_0",REAL_INV_0; "REAL_INV_1",REAL_INV_1; "REAL_INV_1_LE",REAL_INV_1_LE; "REAL_INV_1_LT",REAL_INV_1_LT; "REAL_INV_DIV",REAL_INV_DIV; "REAL_INV_EQ_0",REAL_INV_EQ_0; "REAL_INV_EQ_1",REAL_INV_EQ_1; "REAL_INV_INV",REAL_INV_INV; "REAL_INV_LE_1",REAL_INV_LE_1; "REAL_INV_LT_1",REAL_INV_LT_1; "REAL_INV_MUL",REAL_INV_MUL; "REAL_INV_NEG",REAL_INV_NEG; "REAL_INV_POW",REAL_INV_POW; "REAL_INV_SGN",REAL_INV_SGN; "REAL_LET_ADD",REAL_LET_ADD; "REAL_LET_ADD2",REAL_LET_ADD2; "REAL_LET_ANTISYM",REAL_LET_ANTISYM; "REAL_LET_BETWEEN",REAL_LET_BETWEEN; "REAL_LET_TOTAL",REAL_LET_TOTAL; "REAL_LET_TRANS",REAL_LET_TRANS; "REAL_LE_01",REAL_LE_01; "REAL_LE_ADD",REAL_LE_ADD; "REAL_LE_ADD2",REAL_LE_ADD2; "REAL_LE_ADDL",REAL_LE_ADDL; "REAL_LE_ADDR",REAL_LE_ADDR; "REAL_LE_AFFINITY",REAL_LE_AFFINITY; "REAL_LE_ANTISYM",REAL_LE_ANTISYM; "REAL_LE_BETWEEN",REAL_LE_BETWEEN; "REAL_LE_CASES_INTEGERS",REAL_LE_CASES_INTEGERS; "REAL_LE_DIV",REAL_LE_DIV; "REAL_LE_DIV2_EQ",REAL_LE_DIV2_EQ; "REAL_LE_DOUBLE",REAL_LE_DOUBLE; "REAL_LE_FLOOR",REAL_LE_FLOOR; "REAL_LE_HAUSDIST",REAL_LE_HAUSDIST; "REAL_LE_INF",REAL_LE_INF; "REAL_LE_INF_EQ",REAL_LE_INF_EQ; "REAL_LE_INF_FINITE",REAL_LE_INF_FINITE; "REAL_LE_INF_SUBSET",REAL_LE_INF_SUBSET; "REAL_LE_INTEGERS",REAL_LE_INTEGERS; "REAL_LE_INV",REAL_LE_INV; "REAL_LE_INV2",REAL_LE_INV2; "REAL_LE_INV_EQ",REAL_LE_INV_EQ; "REAL_LE_LADD",REAL_LE_LADD; "REAL_LE_LADD_IMP",REAL_LE_LADD_IMP; "REAL_LE_LCANCEL_IMP",REAL_LE_LCANCEL_IMP; "REAL_LE_LDIV_EQ",REAL_LE_LDIV_EQ; "REAL_LE_LINV",REAL_LE_LINV; "REAL_LE_LMUL",REAL_LE_LMUL; "REAL_LE_LMUL_EQ",REAL_LE_LMUL_EQ; "REAL_LE_LNEG",REAL_LE_LNEG; "REAL_LE_LSQRT",REAL_LE_LSQRT; "REAL_LE_LT",REAL_LE_LT; "REAL_LE_MAX",REAL_LE_MAX; "REAL_LE_MIN",REAL_LE_MIN; "REAL_LE_MUL",REAL_LE_MUL; "REAL_LE_MUL2",REAL_LE_MUL2; "REAL_LE_MUL_EQ",REAL_LE_MUL_EQ; "REAL_LE_NEG",REAL_LE_NEG; "REAL_LE_NEG2",REAL_LE_NEG2; "REAL_LE_NEGL",REAL_LE_NEGL; "REAL_LE_NEGR",REAL_LE_NEGR; "REAL_LE_NEGTOTAL",REAL_LE_NEGTOTAL; "REAL_LE_NORM_MATRIX_MUL_DET",REAL_LE_NORM_MATRIX_MUL_DET; "REAL_LE_POW2",REAL_LE_POW2; "REAL_LE_POW_2",REAL_LE_POW_2; "REAL_LE_RADD",REAL_LE_RADD; "REAL_LE_RCANCEL_IMP",REAL_LE_RCANCEL_IMP; "REAL_LE_RDIV_EQ",REAL_LE_RDIV_EQ; "REAL_LE_REFL",REAL_LE_REFL; "REAL_LE_REVERSE_INTEGERS",REAL_LE_REVERSE_INTEGERS; "REAL_LE_RINV",REAL_LE_RINV; "REAL_LE_RMUL",REAL_LE_RMUL; "REAL_LE_RMUL_EQ",REAL_LE_RMUL_EQ; "REAL_LE_RNEG",REAL_LE_RNEG; "REAL_LE_RSQRT",REAL_LE_RSQRT; "REAL_LE_SETDIST",REAL_LE_SETDIST; "REAL_LE_SETDIST_EQ",REAL_LE_SETDIST_EQ; "REAL_LE_SQUARE",REAL_LE_SQUARE; "REAL_LE_SQUARE_ABS",REAL_LE_SQUARE_ABS; "REAL_LE_SUB_LADD",REAL_LE_SUB_LADD; "REAL_LE_SUB_RADD",REAL_LE_SUB_RADD; "REAL_LE_SUP",REAL_LE_SUP; "REAL_LE_SUP_FINITE",REAL_LE_SUP_FINITE; "REAL_LE_TOTAL",REAL_LE_TOTAL; "REAL_LE_TRANS",REAL_LE_TRANS; "REAL_LE_TRANS_LE",REAL_LE_TRANS_LE; "REAL_LE_TRANS_LT",REAL_LE_TRANS_LT; "REAL_LE_TRANS_LTE",REAL_LE_TRANS_LTE; "REAL_LNEG_UNIQ",REAL_LNEG_UNIQ; "REAL_LSQRT_LE",REAL_LSQRT_LE; "REAL_LTE_ADD",REAL_LTE_ADD; "REAL_LTE_ADD2",REAL_LTE_ADD2; "REAL_LTE_ANTISYM",REAL_LTE_ANTISYM; "REAL_LTE_BETWEEN",REAL_LTE_BETWEEN; "REAL_LTE_TOTAL",REAL_LTE_TOTAL; "REAL_LTE_TRANS",REAL_LTE_TRANS; "REAL_LT_01",REAL_LT_01; "REAL_LT_ADD",REAL_LT_ADD; "REAL_LT_ADD1",REAL_LT_ADD1; "REAL_LT_ADD2",REAL_LT_ADD2; "REAL_LT_ADDL",REAL_LT_ADDL; "REAL_LT_ADDNEG",REAL_LT_ADDNEG; "REAL_LT_ADDNEG2",REAL_LT_ADDNEG2; "REAL_LT_ADDR",REAL_LT_ADDR; "REAL_LT_ADD_SUB",REAL_LT_ADD_SUB; "REAL_LT_AFFINITY",REAL_LT_AFFINITY; "REAL_LT_ANTISYM",REAL_LT_ANTISYM; "REAL_LT_BETWEEN",REAL_LT_BETWEEN; "REAL_LT_BETWEEN_GEN",REAL_LT_BETWEEN_GEN; "REAL_LT_DIV",REAL_LT_DIV; "REAL_LT_DIV2_EQ",REAL_LT_DIV2_EQ; "REAL_LT_FLOOR",REAL_LT_FLOOR; "REAL_LT_GT",REAL_LT_GT; "REAL_LT_HAUSDIST_POINT_EXISTS",REAL_LT_HAUSDIST_POINT_EXISTS; "REAL_LT_IMP_LE",REAL_LT_IMP_LE; "REAL_LT_IMP_NE",REAL_LT_IMP_NE; "REAL_LT_IMP_NZ",REAL_LT_IMP_NZ; "REAL_LT_INF_FINITE",REAL_LT_INF_FINITE; "REAL_LT_INTEGERS",REAL_LT_INTEGERS; "REAL_LT_INV",REAL_LT_INV; "REAL_LT_INV2",REAL_LT_INV2; "REAL_LT_INV_EQ",REAL_LT_INV_EQ; "REAL_LT_LADD",REAL_LT_LADD; "REAL_LT_LADD_IMP",REAL_LT_LADD_IMP; "REAL_LT_LCANCEL_IMP",REAL_LT_LCANCEL_IMP; "REAL_LT_LDIV_EQ",REAL_LT_LDIV_EQ; "REAL_LT_LE",REAL_LT_LE; "REAL_LT_LINV",REAL_LT_LINV; "REAL_LT_LMUL",REAL_LT_LMUL; "REAL_LT_LMUL_EQ",REAL_LT_LMUL_EQ; "REAL_LT_LNEG",REAL_LT_LNEG; "REAL_LT_LSQRT",REAL_LT_LSQRT; "REAL_LT_MAX",REAL_LT_MAX; "REAL_LT_MIN",REAL_LT_MIN; "REAL_LT_MUL",REAL_LT_MUL; "REAL_LT_MUL2",REAL_LT_MUL2; "REAL_LT_MUL_EQ",REAL_LT_MUL_EQ; "REAL_LT_NEG",REAL_LT_NEG; "REAL_LT_NEG2",REAL_LT_NEG2; "REAL_LT_NEGTOTAL",REAL_LT_NEGTOTAL; "REAL_LT_POW2",REAL_LT_POW2; "REAL_LT_POW_2",REAL_LT_POW_2; "REAL_LT_RADD",REAL_LT_RADD; "REAL_LT_RCANCEL_IMP",REAL_LT_RCANCEL_IMP; "REAL_LT_RDIV_EQ",REAL_LT_RDIV_EQ; "REAL_LT_REFL",REAL_LT_REFL; "REAL_LT_RINV",REAL_LT_RINV; "REAL_LT_RMUL",REAL_LT_RMUL; "REAL_LT_RMUL_EQ",REAL_LT_RMUL_EQ; "REAL_LT_RNEG",REAL_LT_RNEG; "REAL_LT_RSQRT",REAL_LT_RSQRT; "REAL_LT_SQUARE",REAL_LT_SQUARE; "REAL_LT_SQUARE_ABS",REAL_LT_SQUARE_ABS; "REAL_LT_SUB_LADD",REAL_LT_SUB_LADD; "REAL_LT_SUB_RADD",REAL_LT_SUB_RADD; "REAL_LT_SUP_FINITE",REAL_LT_SUP_FINITE; "REAL_LT_TOTAL",REAL_LT_TOTAL; "REAL_LT_TRANS",REAL_LT_TRANS; "REAL_MAX_ACI",REAL_MAX_ACI; "REAL_MAX_ASSOC",REAL_MAX_ASSOC; "REAL_MAX_LE",REAL_MAX_LE; "REAL_MAX_LT",REAL_MAX_LT; "REAL_MAX_MAX",REAL_MAX_MAX; "REAL_MAX_MIN",REAL_MAX_MIN; "REAL_MAX_SUP",REAL_MAX_SUP; "REAL_MAX_SYM",REAL_MAX_SYM; "REAL_MIN_ACI",REAL_MIN_ACI; "REAL_MIN_ASSOC",REAL_MIN_ASSOC; "REAL_MIN_INF",REAL_MIN_INF; "REAL_MIN_LE",REAL_MIN_LE; "REAL_MIN_LT",REAL_MIN_LT; "REAL_MIN_MAX",REAL_MIN_MAX; "REAL_MIN_MIN",REAL_MIN_MIN; "REAL_MIN_SYM",REAL_MIN_SYM; "REAL_MUL_2",REAL_MUL_2; "REAL_MUL_AC",REAL_MUL_AC; "REAL_MUL_ASSOC",REAL_MUL_ASSOC; "REAL_MUL_LID",REAL_MUL_LID; "REAL_MUL_LINV",REAL_MUL_LINV; "REAL_MUL_LINV_UNIQ",REAL_MUL_LINV_UNIQ; "REAL_MUL_LNEG",REAL_MUL_LNEG; "REAL_MUL_LZERO",REAL_MUL_LZERO; "REAL_MUL_POS_LE",REAL_MUL_POS_LE; "REAL_MUL_POS_LT",REAL_MUL_POS_LT; "REAL_MUL_RID",REAL_MUL_RID; "REAL_MUL_RINV",REAL_MUL_RINV; "REAL_MUL_RINV_UNIQ",REAL_MUL_RINV_UNIQ; "REAL_MUL_RNEG",REAL_MUL_RNEG; "REAL_MUL_RZERO",REAL_MUL_RZERO; "REAL_MUL_SUM",REAL_MUL_SUM; "REAL_MUL_SUM_NUMSEG",REAL_MUL_SUM_NUMSEG; "REAL_MUL_SYM",REAL_MUL_SYM; "REAL_NEGNEG",REAL_NEGNEG; "REAL_NEG_0",REAL_NEG_0; "REAL_NEG_ADD",REAL_NEG_ADD; "REAL_NEG_EQ",REAL_NEG_EQ; "REAL_NEG_EQ_0",REAL_NEG_EQ_0; "REAL_NEG_GE0",REAL_NEG_GE0; "REAL_NEG_GT0",REAL_NEG_GT0; "REAL_NEG_LE0",REAL_NEG_LE0; "REAL_NEG_LMUL",REAL_NEG_LMUL; "REAL_NEG_LT0",REAL_NEG_LT0; "REAL_NEG_MINUS1",REAL_NEG_MINUS1; "REAL_NEG_MUL2",REAL_NEG_MUL2; "REAL_NEG_NEG",REAL_NEG_NEG; "REAL_NEG_RMUL",REAL_NEG_RMUL; "REAL_NEG_SUB",REAL_NEG_SUB; "REAL_NON_MONOTONE",REAL_NON_MONOTONE; "REAL_NOT_EQ",REAL_NOT_EQ; "REAL_NOT_LE",REAL_NOT_LE; "REAL_NOT_LT",REAL_NOT_LT; "REAL_OF_INT_OF_REAL",REAL_OF_INT_OF_REAL; "REAL_OF_NUM_ADD",REAL_OF_NUM_ADD; "REAL_OF_NUM_EQ",REAL_OF_NUM_EQ; "REAL_OF_NUM_GE",REAL_OF_NUM_GE; "REAL_OF_NUM_GT",REAL_OF_NUM_GT; "REAL_OF_NUM_LE",REAL_OF_NUM_LE; "REAL_OF_NUM_LT",REAL_OF_NUM_LT; "REAL_OF_NUM_MAX",REAL_OF_NUM_MAX; "REAL_OF_NUM_MIN",REAL_OF_NUM_MIN; "REAL_OF_NUM_MUL",REAL_OF_NUM_MUL; "REAL_OF_NUM_NPRODUCT",REAL_OF_NUM_NPRODUCT; "REAL_OF_NUM_POW",REAL_OF_NUM_POW; "REAL_OF_NUM_SUB",REAL_OF_NUM_SUB; "REAL_OF_NUM_SUB_CASES",REAL_OF_NUM_SUB_CASES; "REAL_OF_NUM_SUC",REAL_OF_NUM_SUC; "REAL_OF_NUM_SUM",REAL_OF_NUM_SUM; "REAL_OF_NUM_SUM_GEN",REAL_OF_NUM_SUM_GEN; "REAL_OF_NUM_SUM_NUMSEG",REAL_OF_NUM_SUM_NUMSEG; "REAL_POLYFUN_EQ_0",REAL_POLYFUN_EQ_0; "REAL_POLYFUN_EQ_CONST",REAL_POLYFUN_EQ_CONST; "REAL_POLYFUN_FINITE_ROOTS",REAL_POLYFUN_FINITE_ROOTS; "REAL_POLYFUN_ROOTBOUND",REAL_POLYFUN_ROOTBOUND; "REAL_POLY_CLAUSES",REAL_POLY_CLAUSES; "REAL_POLY_NEG_CLAUSES",REAL_POLY_NEG_CLAUSES; "REAL_POS",REAL_POS; "REAL_POS_NZ",REAL_POS_NZ; "REAL_POW2_ABS",REAL_POW2_ABS; "REAL_POW_1",REAL_POW_1; "REAL_POW_1_LE",REAL_POW_1_LE; "REAL_POW_1_LT",REAL_POW_1_LT; "REAL_POW_2",REAL_POW_2; "REAL_POW_ADD",REAL_POW_ADD; "REAL_POW_DIV",REAL_POW_DIV; "REAL_POW_EQ",REAL_POW_EQ; "REAL_POW_EQ_0",REAL_POW_EQ_0; "REAL_POW_EQ_1",REAL_POW_EQ_1; "REAL_POW_EQ_1_IMP",REAL_POW_EQ_1_IMP; "REAL_POW_EQ_ABS",REAL_POW_EQ_ABS; "REAL_POW_EQ_EQ",REAL_POW_EQ_EQ; "REAL_POW_EQ_ODD",REAL_POW_EQ_ODD; "REAL_POW_EQ_ODD_EQ",REAL_POW_EQ_ODD_EQ; "REAL_POW_INV",REAL_POW_INV; "REAL_POW_LBOUND",REAL_POW_LBOUND; "REAL_POW_LE",REAL_POW_LE; "REAL_POW_LE2",REAL_POW_LE2; "REAL_POW_LE2_ODD",REAL_POW_LE2_ODD; "REAL_POW_LE2_ODD_EQ",REAL_POW_LE2_ODD_EQ; "REAL_POW_LE2_REV",REAL_POW_LE2_REV; "REAL_POW_LE_1",REAL_POW_LE_1; "REAL_POW_LT",REAL_POW_LT; "REAL_POW_LT2",REAL_POW_LT2; "REAL_POW_LT2_ODD",REAL_POW_LT2_ODD; "REAL_POW_LT2_ODD_EQ",REAL_POW_LT2_ODD_EQ; "REAL_POW_LT2_REV",REAL_POW_LT2_REV; "REAL_POW_LT_1",REAL_POW_LT_1; "REAL_POW_MONO",REAL_POW_MONO; "REAL_POW_MONO_INV",REAL_POW_MONO_INV; "REAL_POW_MONO_LT",REAL_POW_MONO_LT; "REAL_POW_MUL",REAL_POW_MUL; "REAL_POW_NEG",REAL_POW_NEG; "REAL_POW_NZ",REAL_POW_NZ; "REAL_POW_ONE",REAL_POW_ONE; "REAL_POW_POW",REAL_POW_POW; "REAL_POW_SUB",REAL_POW_SUB; "REAL_POW_ZERO",REAL_POW_ZERO; "REAL_RNEG_UNIQ",REAL_RNEG_UNIQ; "REAL_RSQRT_LE",REAL_RSQRT_LE; "REAL_SETDIST_LT_EXISTS",REAL_SETDIST_LT_EXISTS; "REAL_SGN",REAL_SGN; "REAL_SGNS_EQ",REAL_SGNS_EQ; "REAL_SGNS_EQ_ALT",REAL_SGNS_EQ_ALT; "REAL_SGN_0",REAL_SGN_0; "REAL_SGN_ABS",REAL_SGN_ABS; "REAL_SGN_ABS_ALT",REAL_SGN_ABS_ALT; "REAL_SGN_CASES",REAL_SGN_CASES; "REAL_SGN_DIV",REAL_SGN_DIV; "REAL_SGN_EQ",REAL_SGN_EQ; "REAL_SGN_EQ_INEQ",REAL_SGN_EQ_INEQ; "REAL_SGN_INEQS",REAL_SGN_INEQS; "REAL_SGN_INV",REAL_SGN_INV; "REAL_SGN_MUL",REAL_SGN_MUL; "REAL_SGN_NEG",REAL_SGN_NEG; "REAL_SGN_POW",REAL_SGN_POW; "REAL_SGN_POW_2",REAL_SGN_POW_2; "REAL_SGN_REAL_SGN",REAL_SGN_REAL_SGN; "REAL_SGN_SIGN",REAL_SGN_SIGN; "REAL_SGN_SQRT",REAL_SGN_SQRT; "REAL_SOS_EQ_0",REAL_SOS_EQ_0; "REAL_SQRT_POW_2",REAL_SQRT_POW_2; "REAL_SUB_0",REAL_SUB_0; "REAL_SUB_ABS",REAL_SUB_ABS; "REAL_SUB_ADD",REAL_SUB_ADD; "REAL_SUB_ADD2",REAL_SUB_ADD2; "REAL_SUB_INV",REAL_SUB_INV; "REAL_SUB_LDISTRIB",REAL_SUB_LDISTRIB; "REAL_SUB_LE",REAL_SUB_LE; "REAL_SUB_LNEG",REAL_SUB_LNEG; "REAL_SUB_LT",REAL_SUB_LT; "REAL_SUB_LZERO",REAL_SUB_LZERO; "REAL_SUB_NEG2",REAL_SUB_NEG2; "REAL_SUB_POLYFUN",REAL_SUB_POLYFUN; "REAL_SUB_POLYFUN_ALT",REAL_SUB_POLYFUN_ALT; "REAL_SUB_POW",REAL_SUB_POW; "REAL_SUB_POW_L1",REAL_SUB_POW_L1; "REAL_SUB_POW_R1",REAL_SUB_POW_R1; "REAL_SUB_RDISTRIB",REAL_SUB_RDISTRIB; "REAL_SUB_REFL",REAL_SUB_REFL; "REAL_SUB_RNEG",REAL_SUB_RNEG; "REAL_SUB_RZERO",REAL_SUB_RZERO; "REAL_SUB_SUB",REAL_SUB_SUB; "REAL_SUB_SUB2",REAL_SUB_SUB2; "REAL_SUB_TRIANGLE",REAL_SUB_TRIANGLE; "REAL_SUP_ASCLOSE",REAL_SUP_ASCLOSE; "REAL_SUP_BOUNDS",REAL_SUP_BOUNDS; "REAL_SUP_EQ_INF",REAL_SUP_EQ_INF; "REAL_SUP_LE",REAL_SUP_LE; "REAL_SUP_LE_EQ",REAL_SUP_LE_EQ; "REAL_SUP_LE_FINITE",REAL_SUP_LE_FINITE; "REAL_SUP_LE_SUBSET",REAL_SUP_LE_SUBSET; "REAL_SUP_LT_FINITE",REAL_SUP_LT_FINITE; "REAL_SUP_UNIQUE",REAL_SUP_UNIQUE; "REAL_TRUNCATE",REAL_TRUNCATE; "REAL_TRUNCATE_POS",REAL_TRUNCATE_POS; "REAL_WLOG_LE",REAL_WLOG_LE; "REAL_WLOG_LT",REAL_WLOG_LT; "RECTIFIABLE_PATH_COMBINE",RECTIFIABLE_PATH_COMBINE; "RECTIFIABLE_PATH_DIFFERENTIABLE",RECTIFIABLE_PATH_DIFFERENTIABLE; "RECTIFIABLE_PATH_EQ",RECTIFIABLE_PATH_EQ; "RECTIFIABLE_PATH_IMAGE_SUBSET_CBALL",RECTIFIABLE_PATH_IMAGE_SUBSET_CBALL; "RECTIFIABLE_PATH_IMP_PATH",RECTIFIABLE_PATH_IMP_PATH; "RECTIFIABLE_PATH_JOIN",RECTIFIABLE_PATH_JOIN; "RECTIFIABLE_PATH_JOIN_EQ",RECTIFIABLE_PATH_JOIN_EQ; "RECTIFIABLE_PATH_JOIN_IMP",RECTIFIABLE_PATH_JOIN_IMP; "RECTIFIABLE_PATH_LINEAR_IMAGE_EQ",RECTIFIABLE_PATH_LINEAR_IMAGE_EQ; "RECTIFIABLE_PATH_LINEPATH",RECTIFIABLE_PATH_LINEPATH; "RECTIFIABLE_PATH_LIPSCHITZ_IMAGE",RECTIFIABLE_PATH_LIPSCHITZ_IMAGE; "RECTIFIABLE_PATH_REPARAMETRIZATION",RECTIFIABLE_PATH_REPARAMETRIZATION; "RECTIFIABLE_PATH_REVERSEPATH",RECTIFIABLE_PATH_REVERSEPATH; "RECTIFIABLE_PATH_SHIFTPATH",RECTIFIABLE_PATH_SHIFTPATH; "RECTIFIABLE_PATH_SUBPATH",RECTIFIABLE_PATH_SUBPATH; "RECTIFIABLE_PATH_SUBPATH_EQ",RECTIFIABLE_PATH_SUBPATH_EQ; "RECTIFIABLE_PATH_SYM",RECTIFIABLE_PATH_SYM; "RECTIFIABLE_PATH_TRANSLATION_EQ",RECTIFIABLE_PATH_TRANSLATION_EQ; "RECURSION_CASEWISE",RECURSION_CASEWISE; "RECURSION_CASEWISE_PAIRWISE",RECURSION_CASEWISE_PAIRWISE; "RECURSION_SUPERADMISSIBLE",RECURSION_SUPERADMISSIBLE; "REFLECT_ALONG_0",REFLECT_ALONG_0; "REFLECT_ALONG_1D",REFLECT_ALONG_1D; "REFLECT_ALONG_ADD",REFLECT_ALONG_ADD; "REFLECT_ALONG_BASIS",REFLECT_ALONG_BASIS; "REFLECT_ALONG_BASIS_COMPONENT",REFLECT_ALONG_BASIS_COMPONENT; "REFLECT_ALONG_EQ",REFLECT_ALONG_EQ; "REFLECT_ALONG_EQ_0",REFLECT_ALONG_EQ_0; "REFLECT_ALONG_EQ_SELF",REFLECT_ALONG_EQ_SELF; "REFLECT_ALONG_INVOLUTION",REFLECT_ALONG_INVOLUTION; "REFLECT_ALONG_LINEAR_IMAGE",REFLECT_ALONG_LINEAR_IMAGE; "REFLECT_ALONG_MUL",REFLECT_ALONG_MUL; "REFLECT_ALONG_REFL",REFLECT_ALONG_REFL; "REFLECT_ALONG_SCALE",REFLECT_ALONG_SCALE; "REFLECT_ALONG_SURJECTIVE",REFLECT_ALONG_SURJECTIVE; "REFLECT_ALONG_ZERO",REFLECT_ALONG_ZERO; "REFLECT_INTERVAL",REFLECT_INTERVAL; "REFLECT_UNIV",REFLECT_UNIV; "REFL_CLAUSE",REFL_CLAUSE; "REGULAR_CLOSED_UNION",REGULAR_CLOSED_UNION; "REGULAR_CLOSED_UNIONS",REGULAR_CLOSED_UNIONS; "REGULAR_CLOSED_UNIONS_FAT_CELLS_UNIV",REGULAR_CLOSED_UNIONS_FAT_CELLS_UNIV; "REGULAR_OPEN_INTER",REGULAR_OPEN_INTER; "REGULAR_POLYTOPE_DIST_BARYCENTRE",REGULAR_POLYTOPE_DIST_BARYCENTRE; "REGULAR_POLYTOPE_EXISTS",REGULAR_POLYTOPE_EXISTS; "REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS",REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS; "REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS_ALT",REGULAR_POLYTOPE_WITH_BARYCENTRE_EXISTS_ALT; "RELATIVE_BOUNDARY_OF_CONVEX_HULL",RELATIVE_BOUNDARY_OF_CONVEX_HULL; "RELATIVE_BOUNDARY_OF_POLYHEDRON",RELATIVE_BOUNDARY_OF_POLYHEDRON; "RELATIVE_BOUNDARY_OF_TRIANGLE",RELATIVE_BOUNDARY_OF_TRIANGLE; "RELATIVE_BOUNDARY_POINT_IN_EXPOSED_FACE",RELATIVE_BOUNDARY_POINT_IN_EXPOSED_FACE; "RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE",RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE; "RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL; "RELATIVE_FRONTIER_BALL",RELATIVE_FRONTIER_BALL; "RELATIVE_FRONTIER_CBALL",RELATIVE_FRONTIER_CBALL; "RELATIVE_FRONTIER_CLOSURE",RELATIVE_FRONTIER_CLOSURE; "RELATIVE_FRONTIER_CONIC_HULL",RELATIVE_FRONTIER_CONIC_HULL; "RELATIVE_FRONTIER_CONVEX_HULL_CASES",RELATIVE_FRONTIER_CONVEX_HULL_CASES; "RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT",RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT; "RELATIVE_FRONTIER_CONVEX_INTER_AFFINE",RELATIVE_FRONTIER_CONVEX_INTER_AFFINE; "RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX",RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX; "RELATIVE_FRONTIER_EMPTY",RELATIVE_FRONTIER_EMPTY; "RELATIVE_FRONTIER_EQ_EMPTY",RELATIVE_FRONTIER_EQ_EMPTY; "RELATIVE_FRONTIER_FACIAL_PARTITION",RELATIVE_FRONTIER_FACIAL_PARTITION; "RELATIVE_FRONTIER_FACIAL_PARTITION_ALT",RELATIVE_FRONTIER_FACIAL_PARTITION_ALT; "RELATIVE_FRONTIER_FRONTIER",RELATIVE_FRONTIER_FRONTIER; "RELATIVE_FRONTIER_FRONTIER_OF",RELATIVE_FRONTIER_FRONTIER_OF; "RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE",RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE; "RELATIVE_FRONTIER_NONEMPTY_INTERIOR",RELATIVE_FRONTIER_NONEMPTY_INTERIOR; "RELATIVE_FRONTIER_NOT_SING",RELATIVE_FRONTIER_NOT_SING; "RELATIVE_FRONTIER_OF_CONVEX_CLOSED",RELATIVE_FRONTIER_OF_CONVEX_CLOSED; "RELATIVE_FRONTIER_OF_CONVEX_HULL",RELATIVE_FRONTIER_OF_CONVEX_HULL; "RELATIVE_FRONTIER_OF_POLYHEDRON",RELATIVE_FRONTIER_OF_POLYHEDRON; "RELATIVE_FRONTIER_OF_POLYHEDRON_ALT",RELATIVE_FRONTIER_OF_POLYHEDRON_ALT; "RELATIVE_FRONTIER_OF_TRIANGLE",RELATIVE_FRONTIER_OF_TRIANGLE; "RELATIVE_FRONTIER_OPEN",RELATIVE_FRONTIER_OPEN; "RELATIVE_FRONTIER_RELATIVE_INTERIOR",RELATIVE_FRONTIER_RELATIVE_INTERIOR; "RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL; "RELATIVE_FRONTIER_SING",RELATIVE_FRONTIER_SING; "RELATIVE_FRONTIER_SUBSET",RELATIVE_FRONTIER_SUBSET; "RELATIVE_FRONTIER_SUBSET_EQ",RELATIVE_FRONTIER_SUBSET_EQ; "RELATIVE_FRONTIER_SUBSET_FRONTIER",RELATIVE_FRONTIER_SUBSET_FRONTIER; "RELATIVE_FRONTIER_TRANSLATION",RELATIVE_FRONTIER_TRANSLATION; "RELATIVE_INTERIOR",RELATIVE_INTERIOR; "RELATIVE_INTERIOR_AFFINE",RELATIVE_INTERIOR_AFFINE; "RELATIVE_INTERIOR_BALL",RELATIVE_INTERIOR_BALL; "RELATIVE_INTERIOR_CBALL",RELATIVE_INTERIOR_CBALL; "RELATIVE_INTERIOR_CLOSURE_SUBSET",RELATIVE_INTERIOR_CLOSURE_SUBSET; "RELATIVE_INTERIOR_CONIC_HULL",RELATIVE_INTERIOR_CONIC_HULL; "RELATIVE_INTERIOR_CONIC_HULL_0",RELATIVE_INTERIOR_CONIC_HULL_0; "RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY",RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY; "RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT",RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT; "RELATIVE_INTERIOR_CONVEX_INTER_AFFINE",RELATIVE_INTERIOR_CONVEX_INTER_AFFINE; "RELATIVE_INTERIOR_CONVEX_INTER_OPEN",RELATIVE_INTERIOR_CONVEX_INTER_OPEN; "RELATIVE_INTERIOR_CONVEX_PROLONG",RELATIVE_INTERIOR_CONVEX_PROLONG; "RELATIVE_INTERIOR_EMPTY",RELATIVE_INTERIOR_EMPTY; "RELATIVE_INTERIOR_EQ",RELATIVE_INTERIOR_EQ; "RELATIVE_INTERIOR_EQ_CLOSURE",RELATIVE_INTERIOR_EQ_CLOSURE; "RELATIVE_INTERIOR_EQ_EMPTY",RELATIVE_INTERIOR_EQ_EMPTY; "RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE",RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE; "RELATIVE_INTERIOR_INTER",RELATIVE_INTERIOR_INTER; "RELATIVE_INTERIOR_INTERIOR",RELATIVE_INTERIOR_INTERIOR; "RELATIVE_INTERIOR_INTERIOR_OF",RELATIVE_INTERIOR_INTERIOR_OF; "RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX",RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; "RELATIVE_INTERIOR_LINEAR_PREIMAGE_CONVEX",RELATIVE_INTERIOR_LINEAR_PREIMAGE_CONVEX; "RELATIVE_INTERIOR_MAXIMAL",RELATIVE_INTERIOR_MAXIMAL; "RELATIVE_INTERIOR_NONEMPTY_INTERIOR",RELATIVE_INTERIOR_NONEMPTY_INTERIOR; "RELATIVE_INTERIOR_OF_POLYHEDRON",RELATIVE_INTERIOR_OF_POLYHEDRON; "RELATIVE_INTERIOR_OPEN",RELATIVE_INTERIOR_OPEN; "RELATIVE_INTERIOR_OPEN_IN",RELATIVE_INTERIOR_OPEN_IN; "RELATIVE_INTERIOR_PCROSS",RELATIVE_INTERIOR_PCROSS; "RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT",RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT; "RELATIVE_INTERIOR_PROLONG",RELATIVE_INTERIOR_PROLONG; "RELATIVE_INTERIOR_RELATIVE_INTERIOR",RELATIVE_INTERIOR_RELATIVE_INTERIOR; "RELATIVE_INTERIOR_SEGMENT",RELATIVE_INTERIOR_SEGMENT; "RELATIVE_INTERIOR_SING",RELATIVE_INTERIOR_SING; "RELATIVE_INTERIOR_SUBSET",RELATIVE_INTERIOR_SUBSET; "RELATIVE_INTERIOR_SUBSET_OF_PROPER_FACE",RELATIVE_INTERIOR_SUBSET_OF_PROPER_FACE; "RELATIVE_INTERIOR_SUMS",RELATIVE_INTERIOR_SUMS; "RELATIVE_INTERIOR_TRANSLATION",RELATIVE_INTERIOR_TRANSLATION; "RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY; "RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS; "RELATIVE_INTERIOR_UNIQUE",RELATIVE_INTERIOR_UNIQUE; "RELATIVE_INTERIOR_UNIV",RELATIVE_INTERIOR_UNIV; "RELATIVE_ORIENTATION",RELATIVE_ORIENTATION; "RELATIVE_ORIENTATION_COMPOSE",RELATIVE_ORIENTATION_COMPOSE; "RELATIVE_ORIENTATION_LINEAR",RELATIVE_ORIENTATION_LINEAR; "RELATIVE_ORIENTATION_NONZERO",RELATIVE_ORIENTATION_NONZERO; "RELATIVE_TO_COMPL",RELATIVE_TO_COMPL; "RELATIVE_TO_IMP_SUBSET",RELATIVE_TO_IMP_SUBSET; "RELATIVE_TO_MONO",RELATIVE_TO_MONO; "RELATIVE_TO_SUBSET",RELATIVE_TO_SUBSET; "RELATIVE_TO_SUBSET_TRANS",RELATIVE_TO_SUBSET_TRANS; "RELATIVE_TO_UNIV",RELATIVE_TO_UNIV; "REPLICATE",REPLICATE; "REP_ABS_PAIR",REP_ABS_PAIR; "REST",REST; "RESTRICTION",RESTRICTION; "RESTRICTION_COMPOSE",RESTRICTION_COMPOSE; "RESTRICTION_COMPOSE_LEFT",RESTRICTION_COMPOSE_LEFT; "RESTRICTION_COMPOSE_RIGHT",RESTRICTION_COMPOSE_RIGHT; "RESTRICTION_CONTINUOUS_ON",RESTRICTION_CONTINUOUS_ON; "RESTRICTION_DEFINED",RESTRICTION_DEFINED; "RESTRICTION_EQ",RESTRICTION_EQ; "RESTRICTION_EXTENSION",RESTRICTION_EXTENSION; "RESTRICTION_FIXPOINT",RESTRICTION_FIXPOINT; "RESTRICTION_HAS_DERIVATIVE",RESTRICTION_HAS_DERIVATIVE; "RESTRICTION_IDEMP",RESTRICTION_IDEMP; "RESTRICTION_IN_EXTENSIONAL",RESTRICTION_IN_EXTENSIONAL; "RESTRICTION_UNDEFINED",RESTRICTION_UNDEFINED; "RETRACTION",RETRACTION; "RETRACTION_ARC",RETRACTION_ARC; "RETRACTION_CLOSEST_POINT",RETRACTION_CLOSEST_POINT; "RETRACTION_IDEMPOTENT",RETRACTION_IDEMPOTENT; "RETRACTION_IMP_QUOTIENT_MAP",RETRACTION_IMP_QUOTIENT_MAP; "RETRACTION_REFL",RETRACTION_REFL; "RETRACTION_SUBSET",RETRACTION_SUBSET; "RETRACTION_o",RETRACTION_o; "RETRACT_FIXPOINT_PROPERTY",RETRACT_FIXPOINT_PROPERTY; "RETRACT_FROM_UNION_AND_INTER",RETRACT_FROM_UNION_AND_INTER; "RETRACT_OF_CLOSED",RETRACT_OF_CLOSED; "RETRACT_OF_CLOSED_UNION",RETRACT_OF_CLOSED_UNION; "RETRACT_OF_COHOMOTOPICALLY_TRIVIAL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL; "RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL; "RETRACT_OF_COMPACT",RETRACT_OF_COMPACT; "RETRACT_OF_CONNECTED",RETRACT_OF_CONNECTED; "RETRACT_OF_CONTRACTIBLE",RETRACT_OF_CONTRACTIBLE; "RETRACT_OF_EMPTY",RETRACT_OF_EMPTY; "RETRACT_OF_HOMOTOPICALLY_TRIVIAL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL; "RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL; "RETRACT_OF_IMP_EXTENSIBLE",RETRACT_OF_IMP_EXTENSIBLE; "RETRACT_OF_IMP_SUBSET",RETRACT_OF_IMP_SUBSET; "RETRACT_OF_INJECTIVE_LINEAR_IMAGE",RETRACT_OF_INJECTIVE_LINEAR_IMAGE; "RETRACT_OF_LINEAR_IMAGE_EQ",RETRACT_OF_LINEAR_IMAGE_EQ; "RETRACT_OF_LOCALLY_COMPACT",RETRACT_OF_LOCALLY_COMPACT; "RETRACT_OF_LOCALLY_CONNECTED",RETRACT_OF_LOCALLY_CONNECTED; "RETRACT_OF_LOCALLY_PATH_CONNECTED",RETRACT_OF_LOCALLY_PATH_CONNECTED; "RETRACT_OF_OPEN_UNION",RETRACT_OF_OPEN_UNION; "RETRACT_OF_PATH_CONNECTED",RETRACT_OF_PATH_CONNECTED; "RETRACT_OF_PCROSS",RETRACT_OF_PCROSS; "RETRACT_OF_PCROSS_EQ",RETRACT_OF_PCROSS_EQ; "RETRACT_OF_REFL",RETRACT_OF_REFL; "RETRACT_OF_SEPARATED_UNION",RETRACT_OF_SEPARATED_UNION; "RETRACT_OF_SIMPLY_CONNECTED",RETRACT_OF_SIMPLY_CONNECTED; "RETRACT_OF_SING",RETRACT_OF_SING; "RETRACT_OF_SUBSET",RETRACT_OF_SUBSET; "RETRACT_OF_TRANS",RETRACT_OF_TRANS; "RETRACT_OF_TRANSLATION",RETRACT_OF_TRANSLATION; "RETRACT_OF_TRANSLATION_EQ",RETRACT_OF_TRANSLATION_EQ; "RETRACT_OF_UNIV",RETRACT_OF_UNIV; "REVERSE",REVERSE; "REVERSEPATH_JOINPATHS",REVERSEPATH_JOINPATHS; "REVERSEPATH_LINEAR_IMAGE",REVERSEPATH_LINEAR_IMAGE; "REVERSEPATH_LINEPATH",REVERSEPATH_LINEPATH; "REVERSEPATH_REVERSEPATH",REVERSEPATH_REVERSEPATH; "REVERSEPATH_SUBPATH",REVERSEPATH_SUBPATH; "REVERSEPATH_TRANSLATION",REVERSEPATH_TRANSLATION; "REVERSE_APPEND",REVERSE_APPEND; "REVERSE_REVERSE",REVERSE_REVERSE; "RIGHT_ADD_DISTRIB",RIGHT_ADD_DISTRIB; "RIGHT_AND_EXISTS_THM",RIGHT_AND_EXISTS_THM; "RIGHT_AND_FORALL_THM",RIGHT_AND_FORALL_THM; "RIGHT_EXISTS_AND_THM",RIGHT_EXISTS_AND_THM; "RIGHT_EXISTS_IMP_THM",RIGHT_EXISTS_IMP_THM; "RIGHT_FORALL_IMP_THM",RIGHT_FORALL_IMP_THM; "RIGHT_FORALL_OR_THM",RIGHT_FORALL_OR_THM; "RIGHT_IMP_EXISTS_THM",RIGHT_IMP_EXISTS_THM; "RIGHT_IMP_FORALL_THM",RIGHT_IMP_FORALL_THM; "RIGHT_INVERSE_LINEAR",RIGHT_INVERSE_LINEAR; "RIGHT_INVERTIBLE_TRANSP",RIGHT_INVERTIBLE_TRANSP; "RIGHT_OR_DISTRIB",RIGHT_OR_DISTRIB; "RIGHT_OR_EXISTS_THM",RIGHT_OR_EXISTS_THM; "RIGHT_OR_FORALL_THM",RIGHT_OR_FORALL_THM; "RIGHT_POLAR_DECOMPOSITION",RIGHT_POLAR_DECOMPOSITION; "RIGHT_POLAR_DECOMPOSITION_INVERTIBLE",RIGHT_POLAR_DECOMPOSITION_INVERTIBLE; "RIGHT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE",RIGHT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE; "RIGHT_POLAR_DECOMPOSITION_UNIQUE",RIGHT_POLAR_DECOMPOSITION_UNIQUE; "RIGHT_SUB_DISTRIB",RIGHT_SUB_DISTRIB; "RIGID_TRANSFORMATION_BETWEEN_2",RIGID_TRANSFORMATION_BETWEEN_2; "RIGID_TRANSFORMATION_BETWEEN_3",RIGID_TRANSFORMATION_BETWEEN_3; "RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS; "RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG; "ROLLE",ROLLE; "ROTATION_EXISTS",ROTATION_EXISTS; "ROTATION_EXISTS_1",ROTATION_EXISTS_1; "ROTATION_LOWDIM_HORIZONTAL",ROTATION_LOWDIM_HORIZONTAL; "ROTATION_MATRIX_1",ROTATION_MATRIX_1; "ROTATION_MATRIX_2",ROTATION_MATRIX_2; "ROTATION_MATRIX_EXISTS_BASIS",ROTATION_MATRIX_EXISTS_BASIS; "ROTATION_RIGHTWARD_LINE",ROTATION_RIGHTWARD_LINE; "ROTATION_TO_GENERAL_POSITION_EXISTS",ROTATION_TO_GENERAL_POSITION_EXISTS; "ROTATION_TO_GENERAL_POSITION_EXISTS_GEN",ROTATION_TO_GENERAL_POSITION_EXISTS_GEN; "ROTHE",ROTHE; "ROTOINVERSION_EXISTS_GEN",ROTOINVERSION_EXISTS_GEN; "ROTOINVERSION_MATRIX_1",ROTOINVERSION_MATRIX_1; "ROTOINVERSION_MATRIX_REFLECT_ALONG",ROTOINVERSION_MATRIX_REFLECT_ALONG; "ROWS_MAPROWS",ROWS_MAPROWS; "ROWS_NONEMPTY",ROWS_NONEMPTY; "ROWS_TRANSP",ROWS_TRANSP; "ROW_0",ROW_0; "ROW_MAPROWS",ROW_MAPROWS; "ROW_MATRIX_MUL",ROW_MATRIX_MUL; "ROW_TRANSP",ROW_TRANSP; "RSUM_BOUND",RSUM_BOUND; "RSUM_COMPONENT_LE",RSUM_COMPONENT_LE; "RSUM_DIFF_BOUND",RSUM_DIFF_BOUND; "SAME_DISTANCES_TO_AFFINE_HULL",SAME_DISTANCES_TO_AFFINE_HULL; "SAME_EIGENVALUES_MATRIX_MUL",SAME_EIGENVALUES_MATRIX_MUL; "SAME_EIGENVALUES_SIMILAR",SAME_EIGENVALUES_SIMILAR; "SAME_EIGENVALUES_TRANSP",SAME_EIGENVALUES_TRANSP; "SAME_EIGENVECTORS_MATRIX_INV",SAME_EIGENVECTORS_MATRIX_INV; "SAME_NORM_SAME_DOT",SAME_NORM_SAME_DOT; "SCALING_LINEAR",SCALING_LINEAR; "SCHAUDER",SCHAUDER; "SCHAUDER_GEN",SCHAUDER_GEN; "SCHAUDER_PROJECTION",SCHAUDER_PROJECTION; "SCHAUDER_UNIV",SCHAUDER_UNIV; "SECOND_MEAN_VALUE_THEOREM",SECOND_MEAN_VALUE_THEOREM; "SECOND_MEAN_VALUE_THEOREM_BONNET",SECOND_MEAN_VALUE_THEOREM_BONNET; "SECOND_MEAN_VALUE_THEOREM_BONNET_FULL",SECOND_MEAN_VALUE_THEOREM_BONNET_FULL; "SECOND_MEAN_VALUE_THEOREM_FULL",SECOND_MEAN_VALUE_THEOREM_FULL; "SECOND_MEAN_VALUE_THEOREM_GEN",SECOND_MEAN_VALUE_THEOREM_GEN; "SECOND_MEAN_VALUE_THEOREM_GEN_FULL",SECOND_MEAN_VALUE_THEOREM_GEN_FULL; "SEGMENT_1",SEGMENT_1; "SEGMENT_AS_BALL",SEGMENT_AS_BALL; "SEGMENT_BOUND",SEGMENT_BOUND; "SEGMENT_CLOSED_OPEN",SEGMENT_CLOSED_OPEN; "SEGMENT_CONVEX_HULL",SEGMENT_CONVEX_HULL; "SEGMENT_EDGE_OF",SEGMENT_EDGE_OF; "SEGMENT_EQ",SEGMENT_EQ; "SEGMENT_EQ_EMPTY",SEGMENT_EQ_EMPTY; "SEGMENT_EQ_SING",SEGMENT_EQ_SING; "SEGMENT_FACE_OF",SEGMENT_FACE_OF; "SEGMENT_FURTHEST_LE",SEGMENT_FURTHEST_LE; "SEGMENT_HORIZONTAL",SEGMENT_HORIZONTAL; "SEGMENT_IMAGE_INTERVAL",SEGMENT_IMAGE_INTERVAL; "SEGMENT_OPEN_SUBSET_CLOSED",SEGMENT_OPEN_SUBSET_CLOSED; "SEGMENT_REFL",SEGMENT_REFL; "SEGMENT_SCALAR_MULTIPLE",SEGMENT_SCALAR_MULTIPLE; "SEGMENT_SUBSET_CONVEX",SEGMENT_SUBSET_CONVEX; "SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX",SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX; "SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX_GEN",SEGMENT_SUBSET_RELATIVE_FRONTIER_CONVEX_GEN; "SEGMENT_SYM",SEGMENT_SYM; "SEGMENT_TO_CLOSEST_POINT",SEGMENT_TO_CLOSEST_POINT; "SEGMENT_TO_FRONTIER",SEGMENT_TO_FRONTIER; "SEGMENT_TO_FRONTIER_SIMPLE",SEGMENT_TO_FRONTIER_SIMPLE; "SEGMENT_TO_POINT_EXISTS",SEGMENT_TO_POINT_EXISTS; "SEGMENT_TO_RELATIVE_FRONTIER",SEGMENT_TO_RELATIVE_FRONTIER; "SEGMENT_TO_RELATIVE_FRONTIER_SIMPLE",SEGMENT_TO_RELATIVE_FRONTIER_SIMPLE; "SEGMENT_TRANSLATION",SEGMENT_TRANSLATION; "SEGMENT_VERTICAL",SEGMENT_VERTICAL; "SELECT_AX",SELECT_AX; "SELECT_REFL",SELECT_REFL; "SELECT_UNIQUE",SELECT_UNIQUE; "SELF_ADJOINT_CLOSEST_POINT",SELF_ADJOINT_CLOSEST_POINT; "SELF_ADJOINT_COMPOSE",SELF_ADJOINT_COMPOSE; "SELF_ADJOINT_HAS_EIGENVECTOR",SELF_ADJOINT_HAS_EIGENVECTOR; "SELF_ADJOINT_HAS_EIGENVECTOR_BASIS",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS; "SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE; "SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE; "SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS",SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS; "SEMI_LOCALLY_CONNECTED",SEMI_LOCALLY_CONNECTED; "SEMI_LOCALLY_CONNECTED_COMPACT",SEMI_LOCALLY_CONNECTED_COMPACT; "SEMI_LOCALLY_CONNECTED_GEN",SEMI_LOCALLY_CONNECTED_GEN; "SEPARABLE",SEPARABLE; "SEPARATE_CLOSED_COMPACT",SEPARATE_CLOSED_COMPACT; "SEPARATE_CLOSED_CONES",SEPARATE_CLOSED_CONES; "SEPARATE_COMPACT_CLOSED",SEPARATE_COMPACT_CLOSED; "SEPARATE_POINT_CLOSED",SEPARATE_POINT_CLOSED; "SEPARATING_HYPERPLANE_AFFINE_AFFINE",SEPARATING_HYPERPLANE_AFFINE_AFFINE; "SEPARATING_HYPERPLANE_AFFINE_HULLS",SEPARATING_HYPERPLANE_AFFINE_HULLS; "SEPARATING_HYPERPLANE_CLOSED_0",SEPARATING_HYPERPLANE_CLOSED_0; "SEPARATING_HYPERPLANE_CLOSED_0_INSET",SEPARATING_HYPERPLANE_CLOSED_0_INSET; "SEPARATING_HYPERPLANE_CLOSED_COMPACT",SEPARATING_HYPERPLANE_CLOSED_COMPACT; "SEPARATING_HYPERPLANE_CLOSED_POINT",SEPARATING_HYPERPLANE_CLOSED_POINT; "SEPARATING_HYPERPLANE_CLOSED_POINT_INSET",SEPARATING_HYPERPLANE_CLOSED_POINT_INSET; "SEPARATING_HYPERPLANE_COMPACT_CLOSED",SEPARATING_HYPERPLANE_COMPACT_CLOSED; "SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO",SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO; "SEPARATING_HYPERPLANE_COMPACT_COMPACT",SEPARATING_HYPERPLANE_COMPACT_COMPACT; "SEPARATING_HYPERPLANE_POLYHEDRA",SEPARATING_HYPERPLANE_POLYHEDRA; "SEPARATING_HYPERPLANE_RELATIVE_INTERIORS",SEPARATING_HYPERPLANE_RELATIVE_INTERIORS; "SEPARATING_HYPERPLANE_SETS",SEPARATING_HYPERPLANE_SETS; "SEPARATING_HYPERPLANE_SET_0",SEPARATING_HYPERPLANE_SET_0; "SEPARATING_HYPERPLANE_SET_0_INSPAN",SEPARATING_HYPERPLANE_SET_0_INSPAN; "SEPARATING_HYPERPLANE_SET_POINT_INAFF",SEPARATING_HYPERPLANE_SET_POINT_INAFF; "SEPARATION_BY_CLOSED_INTERMEDIATES",SEPARATION_BY_CLOSED_INTERMEDIATES; "SEPARATION_BY_CLOSED_INTERMEDIATES_EQ",SEPARATION_BY_CLOSED_INTERMEDIATES_EQ; "SEPARATION_CLOSED_IN_UNION",SEPARATION_CLOSED_IN_UNION; "SEPARATION_CLOSURES",SEPARATION_CLOSURES; "SEPARATION_HAUSDORFF",SEPARATION_HAUSDORFF; "SEPARATION_NORMAL",SEPARATION_NORMAL; "SEPARATION_NORMAL_CLOSURES",SEPARATION_NORMAL_CLOSURES; "SEPARATION_NORMAL_COMPACT",SEPARATION_NORMAL_COMPACT; "SEPARATION_NORMAL_LOCAL",SEPARATION_NORMAL_LOCAL; "SEPARATION_NORMAL_LOCAL_CLOSURES",SEPARATION_NORMAL_LOCAL_CLOSURES; "SEPARATION_OPEN_IN_UNION",SEPARATION_OPEN_IN_UNION; "SEPARATION_T0",SEPARATION_T0; "SEPARATION_T1",SEPARATION_T1; "SEPARATION_T2",SEPARATION_T2; "SEQITERATE_CLAUSES",SEQITERATE_CLAUSES; "SEQITERATE_ITERATE",SEQITERATE_ITERATE; "SEQUENCE_CAUCHY_WLOG",SEQUENCE_CAUCHY_WLOG; "SEQUENCE_ESCAPES",SEQUENCE_ESCAPES; "SEQUENCE_ESCAPES_ALT",SEQUENCE_ESCAPES_ALT; "SEQUENCE_INFINITE_LEMMA",SEQUENCE_INFINITE_LEMMA; "SEQUENCE_UNIQUE_LIMPT",SEQUENCE_UNIQUE_LIMPT; "SEQUENTIALLY",SEQUENTIALLY; "SEQUENTIALLY_CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE",SEQUENTIALLY_CLOSED_IN_MCOMPLETE_IMP_MCOMPLETE; "SEQUENTIAL_LIMIT_URYSOHN",SEQUENTIAL_LIMIT_URYSOHN; "SEQ_HARMONIC",SEQ_HARMONIC; "SEQ_HARMONIC_OFFSET",SEQ_HARMONIC_OFFSET; "SEQ_HARMONIC_RATIO",SEQ_HARMONIC_RATIO; "SEQ_MONO_LEMMA",SEQ_MONO_LEMMA; "SEQ_OFFSET",SEQ_OFFSET; "SEQ_OFFSET_EQ",SEQ_OFFSET_EQ; "SEQ_OFFSET_NEG",SEQ_OFFSET_NEG; "SEQ_OFFSET_REV",SEQ_OFFSET_REV; "SERIES_0",SERIES_0; "SERIES_ADD",SERIES_ADD; "SERIES_BILINEAR",SERIES_BILINEAR; "SERIES_BILINEAR_UNIQUE",SERIES_BILINEAR_UNIQUE; "SERIES_BOUND",SERIES_BOUND; "SERIES_CAUCHY",SERIES_CAUCHY; "SERIES_CAUCHY_UNIFORM",SERIES_CAUCHY_UNIFORM; "SERIES_CMUL",SERIES_CMUL; "SERIES_COMPARISON",SERIES_COMPARISON; "SERIES_COMPARISON_BOUND",SERIES_COMPARISON_BOUND; "SERIES_COMPARISON_UNIFORM",SERIES_COMPARISON_UNIFORM; "SERIES_COMPONENT",SERIES_COMPONENT; "SERIES_DIFFS",SERIES_DIFFS; "SERIES_DIRICHLET",SERIES_DIRICHLET; "SERIES_DIRICHLET_BILINEAR",SERIES_DIRICHLET_BILINEAR; "SERIES_DROP_LE",SERIES_DROP_LE; "SERIES_DROP_POS",SERIES_DROP_POS; "SERIES_EVEN",SERIES_EVEN; "SERIES_FINITE",SERIES_FINITE; "SERIES_FINITE_EQ",SERIES_FINITE_EQ; "SERIES_FINITE_SUPPORT",SERIES_FINITE_SUPPORT; "SERIES_FROM",SERIES_FROM; "SERIES_GOESTOZERO",SERIES_GOESTOZERO; "SERIES_INJECTIVE_IMAGE",SERIES_INJECTIVE_IMAGE; "SERIES_INJECTIVE_IMAGE_STRONG",SERIES_INJECTIVE_IMAGE_STRONG; "SERIES_LIFT_ABSCONV_IMP_CONV",SERIES_LIFT_ABSCONV_IMP_CONV; "SERIES_LINEAR",SERIES_LINEAR; "SERIES_NEG",SERIES_NEG; "SERIES_ODD",SERIES_ODD; "SERIES_RATIO",SERIES_RATIO; "SERIES_REARRANGE",SERIES_REARRANGE; "SERIES_REARRANGE_EQ",SERIES_REARRANGE_EQ; "SERIES_RESTRICT",SERIES_RESTRICT; "SERIES_SUB",SERIES_SUB; "SERIES_SUBSET",SERIES_SUBSET; "SERIES_TERMS_TOZERO",SERIES_TERMS_TOZERO; "SERIES_TRIVIAL",SERIES_TRIVIAL; "SERIES_UNIQUE",SERIES_UNIQUE; "SERIES_VSUM",SERIES_VSUM; "SETCODE_BOUNDS",SETCODE_BOUNDS; "SETDIST_BALLS",SETDIST_BALLS; "SETDIST_CLOSED_COMPACT",SETDIST_CLOSED_COMPACT; "SETDIST_CLOSEST_POINT",SETDIST_CLOSEST_POINT; "SETDIST_CLOSURE",SETDIST_CLOSURE; "SETDIST_COMPACT_CLOSED",SETDIST_COMPACT_CLOSED; "SETDIST_DIFFERENCES",SETDIST_DIFFERENCES; "SETDIST_EMPTY",SETDIST_EMPTY; "SETDIST_EQ_0_BOUNDED",SETDIST_EQ_0_BOUNDED; "SETDIST_EQ_0_CLOSED",SETDIST_EQ_0_CLOSED; "SETDIST_EQ_0_CLOSED_COMPACT",SETDIST_EQ_0_CLOSED_COMPACT; "SETDIST_EQ_0_CLOSED_IN",SETDIST_EQ_0_CLOSED_IN; "SETDIST_EQ_0_COMPACT_CLOSED",SETDIST_EQ_0_COMPACT_CLOSED; "SETDIST_EQ_0_SING",SETDIST_EQ_0_SING; "SETDIST_FRONTIER",SETDIST_FRONTIER; "SETDIST_FRONTIERS",SETDIST_FRONTIERS; "SETDIST_HAUSDIST_TRIANGLE",SETDIST_HAUSDIST_TRIANGLE; "SETDIST_LE_DIST",SETDIST_LE_DIST; "SETDIST_LE_HAUSDIST",SETDIST_LE_HAUSDIST; "SETDIST_LE_SING",SETDIST_LE_SING; "SETDIST_LINEAR_IMAGE",SETDIST_LINEAR_IMAGE; "SETDIST_LIPSCHITZ",SETDIST_LIPSCHITZ; "SETDIST_POS_LE",SETDIST_POS_LE; "SETDIST_POS_LT",SETDIST_POS_LT; "SETDIST_REFL",SETDIST_REFL; "SETDIST_RELATIVE_INTERIOR",SETDIST_RELATIVE_INTERIOR; "SETDIST_SCALING",SETDIST_SCALING; "SETDIST_SINGS",SETDIST_SINGS; "SETDIST_SING_FRONTIER",SETDIST_SING_FRONTIER; "SETDIST_SING_FRONTIER_CASES",SETDIST_SING_FRONTIER_CASES; "SETDIST_SING_IN_SET",SETDIST_SING_IN_SET; "SETDIST_SING_LE_HAUSDIST",SETDIST_SING_LE_HAUSDIST; "SETDIST_SING_TRIANGLE",SETDIST_SING_TRIANGLE; "SETDIST_SUBSETS_EQ",SETDIST_SUBSETS_EQ; "SETDIST_SUBSET_LEFT",SETDIST_SUBSET_LEFT; "SETDIST_SUBSET_RIGHT",SETDIST_SUBSET_RIGHT; "SETDIST_SYM",SETDIST_SYM; "SETDIST_TRANSLATION",SETDIST_TRANSLATION; "SETDIST_TRIANGLE",SETDIST_TRIANGLE; "SETDIST_UNIFORMLY_CONTINUOUS_ON",SETDIST_UNIFORMLY_CONTINUOUS_ON; "SETDIST_UNIFORMLY_CONTINUOUS_ON_ALT",SETDIST_UNIFORMLY_CONTINUOUS_ON_ALT; "SETDIST_UNIQUE",SETDIST_UNIQUE; "SETDIST_UNIV",SETDIST_UNIV; "SETDIST_ZERO",SETDIST_ZERO; "SETDIST_ZERO_STRONG",SETDIST_ZERO_STRONG; "SETSPEC",SETSPEC; "SETVARIATION_EQUAL_LEMMA",SETVARIATION_EQUAL_LEMMA; "SET_CASES",SET_CASES; "SET_DIFF_FRONTIER",SET_DIFF_FRONTIER; "SET_OF_LIST_APPEND",SET_OF_LIST_APPEND; "SET_OF_LIST_EQ_EMPTY",SET_OF_LIST_EQ_EMPTY; "SET_OF_LIST_MAP",SET_OF_LIST_MAP; "SET_OF_LIST_OF_SET",SET_OF_LIST_OF_SET; "SET_PAIR_THM",SET_PAIR_THM; "SET_PROVE_CASES",SET_PROVE_CASES; "SET_RECURSION_LEMMA",SET_RECURSION_LEMMA; "SET_VARIATION",SET_VARIATION; "SET_VARIATION_0",SET_VARIATION_0; "SET_VARIATION_CMUL",SET_VARIATION_CMUL; "SET_VARIATION_COMPARISON",SET_VARIATION_COMPARISON; "SET_VARIATION_DEGENERATES",SET_VARIATION_DEGENERATES; "SET_VARIATION_ELEMENTARY_LEMMA",SET_VARIATION_ELEMENTARY_LEMMA; "SET_VARIATION_EQ",SET_VARIATION_EQ; "SET_VARIATION_GE_FUNCTION",SET_VARIATION_GE_FUNCTION; "SET_VARIATION_INTERVAL_LEMMA",SET_VARIATION_INTERVAL_LEMMA; "SET_VARIATION_LBOUND",SET_VARIATION_LBOUND; "SET_VARIATION_LBOUND_ON_INTERVAL",SET_VARIATION_LBOUND_ON_INTERVAL; "SET_VARIATION_MONOTONE",SET_VARIATION_MONOTONE; "SET_VARIATION_ON_DIVISION",SET_VARIATION_ON_DIVISION; "SET_VARIATION_ON_ELEMENTARY",SET_VARIATION_ON_ELEMENTARY; "SET_VARIATION_ON_EMPTY",SET_VARIATION_ON_EMPTY; "SET_VARIATION_ON_INTERVAL",SET_VARIATION_ON_INTERVAL; "SET_VARIATION_ON_NULL",SET_VARIATION_ON_NULL; "SET_VARIATION_POS_LE",SET_VARIATION_POS_LE; "SET_VARIATION_REFLECT2",SET_VARIATION_REFLECT2; "SET_VARIATION_SUM_LE",SET_VARIATION_SUM_LE; "SET_VARIATION_TRANSLATION2",SET_VARIATION_TRANSLATION2; "SET_VARIATION_TRIANGLE",SET_VARIATION_TRIANGLE; "SET_VARIATION_UBOUND",SET_VARIATION_UBOUND; "SET_VARIATION_UBOUND_ON_INTERVAL",SET_VARIATION_UBOUND_ON_INTERVAL; "SET_VARIATION_WORKS_ON_INTERVAL",SET_VARIATION_WORKS_ON_INTERVAL; "SHIFTPATH_LINEAR_IMAGE",SHIFTPATH_LINEAR_IMAGE; "SHIFTPATH_SHIFTPATH",SHIFTPATH_SHIFTPATH; "SHIFTPATH_TRANSLATION",SHIFTPATH_TRANSLATION; "SHIFTPATH_TRIVIAL",SHIFTPATH_TRIVIAL; "SHORTEST_ARC_EXISTS",SHORTEST_ARC_EXISTS; "SHORTEST_PATH_EXISTS",SHORTEST_PATH_EXISTS; "SHORTEST_PATH_EXISTS_GEN",SHORTEST_PATH_EXISTS_GEN; "SHORTEST_PATH_EXISTS_STRADDLE",SHORTEST_PATH_EXISTS_STRADDLE; "SIGMA_COMPACT",SIGMA_COMPACT; "SIGN_COMPOSE",SIGN_COMPOSE; "SIGN_I",SIGN_I; "SIGN_IDEMPOTENT",SIGN_IDEMPOTENT; "SIGN_INVERSE",SIGN_INVERSE; "SIGN_INVOLUTION",SIGN_INVOLUTION; "SIGN_NZ",SIGN_NZ; "SIGN_SWAP",SIGN_SWAP; "SILVERMAN_STEINHAUSLIKE",SILVERMAN_STEINHAUSLIKE; "SIMPLEX",SIMPLEX; "SIMPLEX_0_NOT_IN_AFFINE_HULL",SIMPLEX_0_NOT_IN_AFFINE_HULL; "SIMPLEX_ALT",SIMPLEX_ALT; "SIMPLEX_ALT1",SIMPLEX_ALT1; "SIMPLEX_CONVEX_HULL",SIMPLEX_CONVEX_HULL; "SIMPLEX_DIM_GE",SIMPLEX_DIM_GE; "SIMPLEX_EMPTY",SIMPLEX_EMPTY; "SIMPLEX_EXPLICIT",SIMPLEX_EXPLICIT; "SIMPLEX_EXTREMAL_LE",SIMPLEX_EXTREMAL_LE; "SIMPLEX_EXTREMAL_LE_EXISTS",SIMPLEX_EXTREMAL_LE_EXISTS; "SIMPLEX_EXTREME_POINTS",SIMPLEX_EXTREME_POINTS; "SIMPLEX_EXTREME_POINTS_NONEMPTY",SIMPLEX_EXTREME_POINTS_NONEMPTY; "SIMPLEX_FACE_OF_SIMPLEX",SIMPLEX_FACE_OF_SIMPLEX; "SIMPLEX_FURTHEST_LE",SIMPLEX_FURTHEST_LE; "SIMPLEX_FURTHEST_LE_EXISTS",SIMPLEX_FURTHEST_LE_EXISTS; "SIMPLEX_FURTHEST_LT",SIMPLEX_FURTHEST_LT; "SIMPLEX_IMP_CLOSED",SIMPLEX_IMP_CLOSED; "SIMPLEX_IMP_COMPACT",SIMPLEX_IMP_COMPACT; "SIMPLEX_IMP_CONVEX",SIMPLEX_IMP_CONVEX; "SIMPLEX_IMP_POLYHEDRON",SIMPLEX_IMP_POLYHEDRON; "SIMPLEX_IMP_POLYTOPE",SIMPLEX_IMP_POLYTOPE; "SIMPLEX_INSERT",SIMPLEX_INSERT; "SIMPLEX_INSERT_DIMPLUS1",SIMPLEX_INSERT_DIMPLUS1; "SIMPLEX_LINEAR_IMAGE_EQ",SIMPLEX_LINEAR_IMAGE_EQ; "SIMPLEX_MINUS_1",SIMPLEX_MINUS_1; "SIMPLEX_ORDERING_EXISTS",SIMPLEX_ORDERING_EXISTS; "SIMPLEX_SEGMENT",SIMPLEX_SEGMENT; "SIMPLEX_SEGMENT_CASES",SIMPLEX_SEGMENT_CASES; "SIMPLEX_SING",SIMPLEX_SING; "SIMPLEX_TRANSLATION_EQ",SIMPLEX_TRANSLATION_EQ; "SIMPLEX_VERTICES_UNIQUE",SIMPLEX_VERTICES_UNIQUE; "SIMPLEX_ZERO",SIMPLEX_ZERO; "SIMPLE_IMAGE",SIMPLE_IMAGE; "SIMPLE_IMAGE_GEN",SIMPLE_IMAGE_GEN; "SIMPLE_PATH_ASSOC",SIMPLE_PATH_ASSOC; "SIMPLE_PATH_CASES",SIMPLE_PATH_CASES; "SIMPLE_PATH_CONTINUOUS_IMAGE",SIMPLE_PATH_CONTINUOUS_IMAGE; "SIMPLE_PATH_ENDLESS",SIMPLE_PATH_ENDLESS; "SIMPLE_PATH_EQ_ARC",SIMPLE_PATH_EQ_ARC; "SIMPLE_PATH_IMP_ARC",SIMPLE_PATH_IMP_ARC; "SIMPLE_PATH_IMP_PATH",SIMPLE_PATH_IMP_PATH; "SIMPLE_PATH_JOIN_IMP",SIMPLE_PATH_JOIN_IMP; "SIMPLE_PATH_JOIN_LOOP",SIMPLE_PATH_JOIN_LOOP; "SIMPLE_PATH_JOIN_LOOP_EQ",SIMPLE_PATH_JOIN_LOOP_EQ; "SIMPLE_PATH_JOIN_LOOP_EQ_ALT",SIMPLE_PATH_JOIN_LOOP_EQ_ALT; "SIMPLE_PATH_LENGTH_MINIMAL",SIMPLE_PATH_LENGTH_MINIMAL; "SIMPLE_PATH_LENGTH_UNIQUE",SIMPLE_PATH_LENGTH_UNIQUE; "SIMPLE_PATH_LINEAR_IMAGE_EQ",SIMPLE_PATH_LINEAR_IMAGE_EQ; "SIMPLE_PATH_LINEPATH",SIMPLE_PATH_LINEPATH; "SIMPLE_PATH_LINEPATH_EQ",SIMPLE_PATH_LINEPATH_EQ; "SIMPLE_PATH_REVERSEPATH",SIMPLE_PATH_REVERSEPATH; "SIMPLE_PATH_REVERSEPATH_EQ",SIMPLE_PATH_REVERSEPATH_EQ; "SIMPLE_PATH_SHIFTPATH",SIMPLE_PATH_SHIFTPATH; "SIMPLE_PATH_SUBPATH",SIMPLE_PATH_SUBPATH; "SIMPLE_PATH_SUBPATH_EQ",SIMPLE_PATH_SUBPATH_EQ; "SIMPLE_PATH_SYM",SIMPLE_PATH_SYM; "SIMPLE_PATH_TRANSLATION_EQ",SIMPLE_PATH_TRANSLATION_EQ; "SIMPLICIAL_COMPLEX_DISJOINT_RELATIVE_INTERIORS",SIMPLICIAL_COMPLEX_DISJOINT_RELATIVE_INTERIORS; "SIMPLICIAL_COMPLEX_IMP_TRIANGULATION",SIMPLICIAL_COMPLEX_IMP_TRIANGULATION; "SIMPLICIAL_COMPLEX_LINEAR_IMAGE",SIMPLICIAL_COMPLEX_LINEAR_IMAGE; "SIMPLICIAL_COMPLEX_TRANSLATION",SIMPLICIAL_COMPLEX_TRANSLATION; "SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX",SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX; "SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX_LOWDIM",SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX_LOWDIM; "SIMPLY_CONNECTED_EMPTY",SIMPLY_CONNECTED_EMPTY; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME; "SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; "SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS",SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS; "SIMPLY_CONNECTED_FUNDAMENTAL_GROUP",SIMPLY_CONNECTED_FUNDAMENTAL_GROUP; "SIMPLY_CONNECTED_IMP_CONNECTED",SIMPLY_CONNECTED_IMP_CONNECTED; "SIMPLY_CONNECTED_IMP_PATH_CONNECTED",SIMPLY_CONNECTED_IMP_PATH_CONNECTED; "SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE",SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE; "SIMPLY_CONNECTED_NESTED_UNIONS",SIMPLY_CONNECTED_NESTED_UNIONS; "SIMPLY_CONNECTED_PCROSS",SIMPLY_CONNECTED_PCROSS; "SIMPLY_CONNECTED_PCROSS_EQ",SIMPLY_CONNECTED_PCROSS_EQ; "SIMPLY_CONNECTED_RETRACTION_GEN",SIMPLY_CONNECTED_RETRACTION_GEN; "SIMPLY_CONNECTED_SING",SIMPLY_CONNECTED_SING; "SIMPLY_CONNECTED_TRANSLATION",SIMPLY_CONNECTED_TRANSLATION; "SIMPLY_CONNECTED_UNION",SIMPLY_CONNECTED_UNION; "SING",SING; "SING_GSPEC",SING_GSPEC; "SING_STRONG_DEFORMATION_RETRACT_OF_AR",SING_STRONG_DEFORMATION_RETRACT_OF_AR; "SING_SUBSET",SING_SUBSET; "SKOLEM_THM",SKOLEM_THM; "SKOLEM_THM_GEN",SKOLEM_THM_GEN; "SMALL_IMP_DIMENSION_LE_0",SMALL_IMP_DIMENSION_LE_0; "SMALL_IMP_TOTALLY_DISCONNECTED",SMALL_IMP_TOTALLY_DISCONNECTED; "SMALL_INDUCTIVE_DIMENSION",SMALL_INDUCTIVE_DIMENSION; "SND",SND; "SNDCART_ADD",SNDCART_ADD; "SNDCART_CMUL",SNDCART_CMUL; "SNDCART_NEG",SNDCART_NEG; "SNDCART_PASTECART",SNDCART_PASTECART; "SNDCART_SUB",SNDCART_SUB; "SNDCART_VEC",SNDCART_VEC; "SNDCART_VSUM",SNDCART_VSUM; "SND_DEF",SND_DEF; "SPANNING_SUBSET_INDEPENDENT",SPANNING_SUBSET_INDEPENDENT; "SPANNING_SURJECTIVE_IMAGE",SPANNING_SURJECTIVE_IMAGE; "SPANS_IMAGE",SPANS_IMAGE; "SPAN_0",SPAN_0; "SPAN_2",SPAN_2; "SPAN_3",SPAN_3; "SPAN_ADD",SPAN_ADD; "SPAN_ADD_EQ",SPAN_ADD_EQ; "SPAN_AFFINE_HULL_INSERT",SPAN_AFFINE_HULL_INSERT; "SPAN_BREAKDOWN",SPAN_BREAKDOWN; "SPAN_BREAKDOWN_EQ",SPAN_BREAKDOWN_EQ; "SPAN_CARD_GE_DIM",SPAN_CARD_GE_DIM; "SPAN_CLAUSES",SPAN_CLAUSES; "SPAN_COLUMNSPACE",SPAN_COLUMNSPACE; "SPAN_CONIC_HULL",SPAN_CONIC_HULL; "SPAN_CONVEX_CONE_ALLSIGNS",SPAN_CONVEX_CONE_ALLSIGNS; "SPAN_CONVEX_HULL",SPAN_CONVEX_HULL; "SPAN_DELETE_0",SPAN_DELETE_0; "SPAN_EMPTY",SPAN_EMPTY; "SPAN_EQ",SPAN_EQ; "SPAN_EQ_DIM",SPAN_EQ_DIM; "SPAN_EQ_INSERT",SPAN_EQ_INSERT; "SPAN_EQ_SELF",SPAN_EQ_SELF; "SPAN_EXPLICIT",SPAN_EXPLICIT; "SPAN_FINITE",SPAN_FINITE; "SPAN_IMAGE_SCALE",SPAN_IMAGE_SCALE; "SPAN_INC",SPAN_INC; "SPAN_INDUCT",SPAN_INDUCT; "SPAN_INDUCT_ALT",SPAN_INDUCT_ALT; "SPAN_INSERT_0",SPAN_INSERT_0; "SPAN_LINEAR_IMAGE",SPAN_LINEAR_IMAGE; "SPAN_MBASIS",SPAN_MBASIS; "SPAN_MONO",SPAN_MONO; "SPAN_MUL",SPAN_MUL; "SPAN_MUL_EQ",SPAN_MUL_EQ; "SPAN_NEG",SPAN_NEG; "SPAN_NEG_EQ",SPAN_NEG_EQ; "SPAN_NOT_UNIV_ORTHOGONAL",SPAN_NOT_UNIV_ORTHOGONAL; "SPAN_NOT_UNIV_SUBSET_HYPERPLANE",SPAN_NOT_UNIV_SUBSET_HYPERPLANE; "SPAN_OF_SUBSPACE",SPAN_OF_SUBSPACE; "SPAN_OPEN",SPAN_OPEN; "SPAN_PCROSS",SPAN_PCROSS; "SPAN_PCROSS_SUBSET",SPAN_PCROSS_SUBSET; "SPAN_SING",SPAN_SING; "SPAN_SPAN",SPAN_SPAN; "SPAN_SPECIAL_SCALE",SPAN_SPECIAL_SCALE; "SPAN_STDBASIS",SPAN_STDBASIS; "SPAN_SUB",SPAN_SUB; "SPAN_SUBSET_SUBSPACE",SPAN_SUBSET_SUBSPACE; "SPAN_SUBSPACE",SPAN_SUBSPACE; "SPAN_SUMS",SPAN_SUMS; "SPAN_SUPERSET",SPAN_SUPERSET; "SPAN_TRANS",SPAN_TRANS; "SPAN_UNION",SPAN_UNION; "SPAN_UNION_SUBSET",SPAN_UNION_SUBSET; "SPAN_UNIV",SPAN_UNIV; "SPAN_VSUM",SPAN_VSUM; "SPECIAL_HYPERPLANE_SPAN",SPECIAL_HYPERPLANE_SPAN; "SPHERE_1",SPHERE_1; "SPHERE_EMPTY",SPHERE_EMPTY; "SPHERE_EQ_EMPTY",SPHERE_EQ_EMPTY; "SPHERE_EQ_SING",SPHERE_EQ_SING; "SPHERE_LINEAR_IMAGE",SPHERE_LINEAR_IMAGE; "SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE; "SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN; "SPHERE_SCALING",SPHERE_SCALING; "SPHERE_SING",SPHERE_SING; "SPHERE_SUBSET_CBALL",SPHERE_SUBSET_CBALL; "SPHERE_SUBSET_CONVEX",SPHERE_SUBSET_CONVEX; "SPHERE_TRANSLATION",SPHERE_TRANSLATION; "SPHERE_UNION_BALL",SPHERE_UNION_BALL; "SQNORM_PASTECART",SQNORM_PASTECART; "SQRT_0",SQRT_0; "SQRT_1",SQRT_1; "SQRT_DIV",SQRT_DIV; "SQRT_EQ_0",SQRT_EQ_0; "SQRT_EVEN_POW2",SQRT_EVEN_POW2; "SQRT_INJ",SQRT_INJ; "SQRT_INV",SQRT_INV; "SQRT_LE_0",SQRT_LE_0; "SQRT_LT_0",SQRT_LT_0; "SQRT_MONO_LE",SQRT_MONO_LE; "SQRT_MONO_LE_EQ",SQRT_MONO_LE_EQ; "SQRT_MONO_LT",SQRT_MONO_LT; "SQRT_MONO_LT_EQ",SQRT_MONO_LT_EQ; "SQRT_MUL",SQRT_MUL; "SQRT_NEG",SQRT_NEG; "SQRT_POS_LE",SQRT_POS_LE; "SQRT_POS_LT",SQRT_POS_LT; "SQRT_POW2",SQRT_POW2; "SQRT_POW_2",SQRT_POW_2; "SQRT_UNIQUE",SQRT_UNIQUE; "SQRT_UNIQUE_GEN",SQRT_UNIQUE_GEN; "SQRT_WORKS",SQRT_WORKS; "SQRT_WORKS_GEN",SQRT_WORKS_GEN; "SQUARE_BOUND_LEMMA",SQUARE_BOUND_LEMMA; "SQUARE_CONTINUOUS",SQUARE_CONTINUOUS; "SQUARE_INTEGRAL_SQUARE_INTEGRABLE_PRODUCT_LE",SQUARE_INTEGRAL_SQUARE_INTEGRABLE_PRODUCT_LE; "STARLIKE_CLOSURE",STARLIKE_CLOSURE; "STARLIKE_COMPACT_PROJECTIVE",STARLIKE_COMPACT_PROJECTIVE; "STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS",STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS; "STARLIKE_IMP_CONNECTED",STARLIKE_IMP_CONNECTED; "STARLIKE_IMP_CONTRACTIBLE",STARLIKE_IMP_CONTRACTIBLE; "STARLIKE_IMP_CONTRACTIBLE_GEN",STARLIKE_IMP_CONTRACTIBLE_GEN; "STARLIKE_IMP_PATH_CONNECTED",STARLIKE_IMP_PATH_CONNECTED; "STARLIKE_IMP_SIMPLY_CONNECTED",STARLIKE_IMP_SIMPLY_CONNECTED; "STARLIKE_LINEAR_IMAGE",STARLIKE_LINEAR_IMAGE; "STARLIKE_LINEAR_IMAGE_EQ",STARLIKE_LINEAR_IMAGE_EQ; "STARLIKE_NEGLIGIBLE",STARLIKE_NEGLIGIBLE; "STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE",STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE; "STARLIKE_NEGLIGIBLE_LEMMA",STARLIKE_NEGLIGIBLE_LEMMA; "STARLIKE_NEGLIGIBLE_STRONG",STARLIKE_NEGLIGIBLE_STRONG; "STARLIKE_PCROSS",STARLIKE_PCROSS; "STARLIKE_PCROSS_EQ",STARLIKE_PCROSS_EQ; "STARLIKE_TRANSLATION_EQ",STARLIKE_TRANSLATION_EQ; "STARLIKE_UNIV",STARLIKE_UNIV; "STD_SIMPLEX",STD_SIMPLEX; "STEINHAUS",STEINHAUS; "STEINHAUS_DIFFS",STEINHAUS_DIFFS; "STEINHAUS_LEBESGUE",STEINHAUS_LEBESGUE; "STEINHAUS_SUMS",STEINHAUS_SUMS; "STEPANOV",STEPANOV; "STEPANOV_GEN",STEPANOV_GEN; "STEPANOV_UNIV",STEPANOV_UNIV; "STRETCH_GALOIS",STRETCH_GALOIS; "STRONG_DEFORMATION_RETRACT_OF_AR",STRONG_DEFORMATION_RETRACT_OF_AR; "SUB",SUB; "SUBADDITIVE_CONTENT_DIVISION",SUBADDITIVE_CONTENT_DIVISION; "SUBINTERVAL_MEAN_VALUE_THEOREM",SUBINTERVAL_MEAN_VALUE_THEOREM; "SUBINTERVAL_MEAN_VALUE_THEOREM_ALT",SUBINTERVAL_MEAN_VALUE_THEOREM_ALT; "SUBINTERVAL_MEAN_VALUE_THEOREM_SEQ",SUBINTERVAL_MEAN_VALUE_THEOREM_SEQ; "SUBMETRIC",SUBMETRIC; "SUBMETRIC_UNIV",SUBMETRIC_UNIV; "SUBORDINATE_PARTITION_OF_UNITY",SUBORDINATE_PARTITION_OF_UNITY; "SUBPATH_LINEAR_IMAGE",SUBPATH_LINEAR_IMAGE; "SUBPATH_REFL",SUBPATH_REFL; "SUBPATH_REVERSEPATH",SUBPATH_REVERSEPATH; "SUBPATH_SCALING_LEMMA",SUBPATH_SCALING_LEMMA; "SUBPATH_TO_FRONTIER",SUBPATH_TO_FRONTIER; "SUBPATH_TO_FRONTIER_EXPLICIT",SUBPATH_TO_FRONTIER_EXPLICIT; "SUBPATH_TO_FRONTIER_STRONG",SUBPATH_TO_FRONTIER_STRONG; "SUBPATH_TRANSLATION",SUBPATH_TRANSLATION; "SUBPATH_TRIVIAL",SUBPATH_TRIVIAL; "SUBSEQUENCE_DIAGONALIZATION_LEMMA",SUBSEQUENCE_DIAGONALIZATION_LEMMA; "SUBSEQUENCE_IMP_INJECTIVE",SUBSEQUENCE_IMP_INJECTIVE; "SUBSET",SUBSET; "SUBSET_ANTISYM",SUBSET_ANTISYM; "SUBSET_ANTISYM_EQ",SUBSET_ANTISYM_EQ; "SUBSET_BALL",SUBSET_BALL; "SUBSET_BALLS",SUBSET_BALLS; "SUBSET_CARD_EQ",SUBSET_CARD_EQ; "SUBSET_CBALL",SUBSET_CBALL; "SUBSET_CLOSURE",SUBSET_CLOSURE; "SUBSET_COMPACT_HAUSDIST_LIMIT",SUBSET_COMPACT_HAUSDIST_LIMIT; "SUBSET_CONTINUOUS_IMAGE_SEGMENT_1",SUBSET_CONTINUOUS_IMAGE_SEGMENT_1; "SUBSET_CONVEX_HULL_FRONTIER",SUBSET_CONVEX_HULL_FRONTIER; "SUBSET_CONVEX_HULL_RELATIVE_FRONTIER",SUBSET_CONVEX_HULL_RELATIVE_FRONTIER; "SUBSET_CROSS",SUBSET_CROSS; "SUBSET_DELETE",SUBSET_DELETE; "SUBSET_DIFF",SUBSET_DIFF; "SUBSET_DROP_IMAGE",SUBSET_DROP_IMAGE; "SUBSET_EMPTY",SUBSET_EMPTY; "SUBSET_FACE_OF_SIMPLEX",SUBSET_FACE_OF_SIMPLEX; "SUBSET_HALFSPACES_IMP_COLLINEAR",SUBSET_HALFSPACES_IMP_COLLINEAR; "SUBSET_HULL",SUBSET_HULL; "SUBSET_HYPERPLANES",SUBSET_HYPERPLANES; "SUBSET_IMAGE",SUBSET_IMAGE; "SUBSET_IMAGE_INJ",SUBSET_IMAGE_INJ; "SUBSET_INSERT",SUBSET_INSERT; "SUBSET_INSERT_DELETE",SUBSET_INSERT_DELETE; "SUBSET_INTER",SUBSET_INTER; "SUBSET_INTERIOR",SUBSET_INTERIOR; "SUBSET_INTERIOR_EQ",SUBSET_INTERIOR_EQ; "SUBSET_INTERIOR_OF_EQ",SUBSET_INTERIOR_OF_EQ; "SUBSET_INTERS",SUBSET_INTERS; "SUBSET_INTERVAL",SUBSET_INTERVAL; "SUBSET_INTERVAL_1",SUBSET_INTERVAL_1; "SUBSET_INTERVAL_IMP",SUBSET_INTERVAL_IMP; "SUBSET_INTER_ABSORPTION",SUBSET_INTER_ABSORPTION; "SUBSET_LE_DIM",SUBSET_LE_DIM; "SUBSET_LIFT_IMAGE",SUBSET_LIFT_IMAGE; "SUBSET_NUMSEG",SUBSET_NUMSEG; "SUBSET_OF_FACE_OF",SUBSET_OF_FACE_OF; "SUBSET_OF_FACE_OF_AFFINE_HULL",SUBSET_OF_FACE_OF_AFFINE_HULL; "SUBSET_PATH_IMAGE_JOIN",SUBSET_PATH_IMAGE_JOIN; "SUBSET_PCROSS",SUBSET_PCROSS; "SUBSET_PRED",SUBSET_PRED; "SUBSET_PSUBSET_TRANS",SUBSET_PSUBSET_TRANS; "SUBSET_REFL",SUBSET_REFL; "SUBSET_RELATIVE_INTERIOR",SUBSET_RELATIVE_INTERIOR; "SUBSET_RELATIVE_INTERIOR_INTERSECTING_CONVEX",SUBSET_RELATIVE_INTERIOR_INTERSECTING_CONVEX; "SUBSET_RESTRICT",SUBSET_RESTRICT; "SUBSET_SECOND_COUNTABLE",SUBSET_SECOND_COUNTABLE; "SUBSET_SEGMENT",SUBSET_SEGMENT; "SUBSET_SEGMENT_OPEN_CLOSED",SUBSET_SEGMENT_OPEN_CLOSED; "SUBSET_SUMS_LCANCEL",SUBSET_SUMS_LCANCEL; "SUBSET_SUMS_RCANCEL",SUBSET_SUMS_RCANCEL; "SUBSET_TRANS",SUBSET_TRANS; "SUBSET_UNION",SUBSET_UNION; "SUBSET_UNIONS",SUBSET_UNIONS; "SUBSET_UNION_ABSORPTION",SUBSET_UNION_ABSORPTION; "SUBSET_UNIV",SUBSET_UNIV; "SUBSPACE_0",SUBSPACE_0; "SUBSPACE_ADD",SUBSPACE_ADD; "SUBSPACE_BOUNDED_EQ_TRIVIAL",SUBSPACE_BOUNDED_EQ_TRIVIAL; "SUBSPACE_CONVEX_CONE_SYMMETRIC",SUBSPACE_CONVEX_CONE_SYMMETRIC; "SUBSPACE_EQ_AFFINE",SUBSPACE_EQ_AFFINE; "SUBSPACE_EXISTS",SUBSPACE_EXISTS; "SUBSPACE_HYPERPLANE",SUBSPACE_HYPERPLANE; "SUBSPACE_IMP_AFFINE",SUBSPACE_IMP_AFFINE; "SUBSPACE_IMP_CONIC",SUBSPACE_IMP_CONIC; "SUBSPACE_IMP_CONVEX",SUBSPACE_IMP_CONVEX; "SUBSPACE_IMP_CONVEX_CONE",SUBSPACE_IMP_CONVEX_CONE; "SUBSPACE_IMP_NONEMPTY",SUBSPACE_IMP_NONEMPTY; "SUBSPACE_INTER",SUBSPACE_INTER; "SUBSPACE_INTERS",SUBSPACE_INTERS; "SUBSPACE_ISOMORPHISM",SUBSPACE_ISOMORPHISM; "SUBSPACE_KERNEL",SUBSPACE_KERNEL; "SUBSPACE_LINEAR_FIXED_POINTS",SUBSPACE_LINEAR_FIXED_POINTS; "SUBSPACE_LINEAR_IMAGE",SUBSPACE_LINEAR_IMAGE; "SUBSPACE_LINEAR_IMAGE_EQ",SUBSPACE_LINEAR_IMAGE_EQ; "SUBSPACE_LINEAR_PREIMAGE",SUBSPACE_LINEAR_PREIMAGE; "SUBSPACE_MUL",SUBSPACE_MUL; "SUBSPACE_NEG",SUBSPACE_NEG; "SUBSPACE_ORTHOGONAL_TO_VECTOR",SUBSPACE_ORTHOGONAL_TO_VECTOR; "SUBSPACE_ORTHOGONAL_TO_VECTORS",SUBSPACE_ORTHOGONAL_TO_VECTORS; "SUBSPACE_PCROSS",SUBSPACE_PCROSS; "SUBSPACE_PCROSS_EQ",SUBSPACE_PCROSS_EQ; "SUBSPACE_SPAN",SUBSPACE_SPAN; "SUBSPACE_SPECIAL_HYPERPLANE",SUBSPACE_SPECIAL_HYPERPLANE; "SUBSPACE_SUB",SUBSPACE_SUB; "SUBSPACE_SUBSTANDARD",SUBSPACE_SUBSTANDARD; "SUBSPACE_SUMS",SUBSPACE_SUMS; "SUBSPACE_TRANSLATION_SELF",SUBSPACE_TRANSLATION_SELF; "SUBSPACE_TRANSLATION_SELF_EQ",SUBSPACE_TRANSLATION_SELF_EQ; "SUBSPACE_TRIVIAL",SUBSPACE_TRIVIAL; "SUBSPACE_UNION_CHAIN",SUBSPACE_UNION_CHAIN; "SUBSPACE_UNIV",SUBSPACE_UNIV; "SUBSPACE_VSUM",SUBSPACE_VSUM; "SUBTOPOLOGY_SUBTOPOLOGY",SUBTOPOLOGY_SUBTOPOLOGY; "SUBTOPOLOGY_SUPERSET",SUBTOPOLOGY_SUPERSET; "SUBTOPOLOGY_TOPSPACE",SUBTOPOLOGY_TOPSPACE; "SUBTOPOLOGY_UNIV",SUBTOPOLOGY_UNIV; "SUBWOSET_ISO_INSEG",SUBWOSET_ISO_INSEG; "SUB_0",SUB_0; "SUB_ADD",SUB_ADD; "SUB_ADD_LCANCEL",SUB_ADD_LCANCEL; "SUB_ADD_RCANCEL",SUB_ADD_RCANCEL; "SUB_ELIM_THM",SUB_ELIM_THM; "SUB_ELIM_THM'",SUB_ELIM_THM'; "SUB_EQ_0",SUB_EQ_0; "SUB_PRESUC",SUB_PRESUC; "SUB_REFL",SUB_REFL; "SUB_SUC",SUB_SUC; "SUC_DEF",SUC_DEF; "SUC_INJ",SUC_INJ; "SUC_SUB1",SUC_SUB1; "SUMMABLE_0",SUMMABLE_0; "SUMMABLE_ADD",SUMMABLE_ADD; "SUMMABLE_BILINEAR_LEFT",SUMMABLE_BILINEAR_LEFT; "SUMMABLE_BILINEAR_PARTIAL_PRE",SUMMABLE_BILINEAR_PARTIAL_PRE; "SUMMABLE_BILINEAR_RIGHT",SUMMABLE_BILINEAR_RIGHT; "SUMMABLE_CAUCHY",SUMMABLE_CAUCHY; "SUMMABLE_CMUL",SUMMABLE_CMUL; "SUMMABLE_COMPARISON",SUMMABLE_COMPARISON; "SUMMABLE_COMPONENT",SUMMABLE_COMPONENT; "SUMMABLE_EQ",SUMMABLE_EQ; "SUMMABLE_EQ_COFINITE",SUMMABLE_EQ_COFINITE; "SUMMABLE_EQ_EVENTUALLY",SUMMABLE_EQ_EVENTUALLY; "SUMMABLE_EVEN",SUMMABLE_EVEN; "SUMMABLE_FROM_ELSEWHERE",SUMMABLE_FROM_ELSEWHERE; "SUMMABLE_FROM_ELSEWHERE_EQ",SUMMABLE_FROM_ELSEWHERE_EQ; "SUMMABLE_IFF",SUMMABLE_IFF; "SUMMABLE_IFF_COFINITE",SUMMABLE_IFF_COFINITE; "SUMMABLE_IFF_EVENTUALLY",SUMMABLE_IFF_EVENTUALLY; "SUMMABLE_IMP_BOUNDED",SUMMABLE_IMP_BOUNDED; "SUMMABLE_IMP_SUMS_BOUNDED",SUMMABLE_IMP_SUMS_BOUNDED; "SUMMABLE_IMP_TOZERO",SUMMABLE_IMP_TOZERO; "SUMMABLE_LINEAR",SUMMABLE_LINEAR; "SUMMABLE_NEG",SUMMABLE_NEG; "SUMMABLE_ODD",SUMMABLE_ODD; "SUMMABLE_RATIO",SUMMABLE_RATIO; "SUMMABLE_REAL_GP",SUMMABLE_REAL_GP; "SUMMABLE_REARRANGE",SUMMABLE_REARRANGE; "SUMMABLE_REINDEX",SUMMABLE_REINDEX; "SUMMABLE_RESTRICT",SUMMABLE_RESTRICT; "SUMMABLE_SUB",SUMMABLE_SUB; "SUMMABLE_SUBSET",SUMMABLE_SUBSET; "SUMMABLE_SUBSET_ABSCONV",SUMMABLE_SUBSET_ABSCONV; "SUMMABLE_TRIVIAL",SUMMABLE_TRIVIAL; "SUMS_0",SUMS_0; "SUMS_ASSOC",SUMS_ASSOC; "SUMS_EQ",SUMS_EQ; "SUMS_FINITE_DIFF",SUMS_FINITE_DIFF; "SUMS_FINITE_UNION",SUMS_FINITE_UNION; "SUMS_IFF",SUMS_IFF; "SUMS_INFSUM",SUMS_INFSUM; "SUMS_INTERVALS",SUMS_INTERVALS; "SUMS_LIM",SUMS_LIM; "SUMS_OFFSET",SUMS_OFFSET; "SUMS_OFFSET_REV",SUMS_OFFSET_REV; "SUMS_REINDEX",SUMS_REINDEX; "SUMS_REINDEX_GEN",SUMS_REINDEX_GEN; "SUMS_SUMMABLE",SUMS_SUMMABLE; "SUMS_SYM",SUMS_SYM; "SUM_0",SUM_0; "SUM_1",SUM_1; "SUM_2",SUM_2; "SUM_3",SUM_3; "SUM_4",SUM_4; "SUM_ABS",SUM_ABS; "SUM_ABS_BOUND",SUM_ABS_BOUND; "SUM_ABS_LE",SUM_ABS_LE; "SUM_ABS_NUMSEG",SUM_ABS_NUMSEG; "SUM_ADD",SUM_ADD; "SUM_ADD_GEN",SUM_ADD_GEN; "SUM_ADD_NUMSEG",SUM_ADD_NUMSEG; "SUM_ADD_SPLIT",SUM_ADD_SPLIT; "SUM_BIJECTION",SUM_BIJECTION; "SUM_BOUND",SUM_BOUND; "SUM_BOUND_GEN",SUM_BOUND_GEN; "SUM_BOUND_LT",SUM_BOUND_LT; "SUM_BOUND_LT_ALL",SUM_BOUND_LT_ALL; "SUM_BOUND_LT_GEN",SUM_BOUND_LT_GEN; "SUM_CASES",SUM_CASES; "SUM_CASES_1",SUM_CASES_1; "SUM_CLAUSES",SUM_CLAUSES; "SUM_CLAUSES_LEFT",SUM_CLAUSES_LEFT; "SUM_CLAUSES_NUMSEG",SUM_CLAUSES_NUMSEG; "SUM_CLAUSES_RIGHT",SUM_CLAUSES_RIGHT; "SUM_CLOSED",SUM_CLOSED; "SUM_COMBINE_L",SUM_COMBINE_L; "SUM_COMBINE_R",SUM_COMBINE_R; "SUM_CONST",SUM_CONST; "SUM_CONST_NUMSEG",SUM_CONST_NUMSEG; "SUM_CONTENT_AREA_OVER_THIN_DIVISION",SUM_CONTENT_AREA_OVER_THIN_DIVISION; "SUM_DEGENERATE",SUM_DEGENERATE; "SUM_DELETE",SUM_DELETE; "SUM_DELETE_CASES",SUM_DELETE_CASES; "SUM_DELTA",SUM_DELTA; "SUM_DIFF",SUM_DIFF; "SUM_DIFFS",SUM_DIFFS; "SUM_DIFFS_ALT",SUM_DIFFS_ALT; "SUM_EQ",SUM_EQ; "SUM_EQ_0",SUM_EQ_0; "SUM_EQ_0_NUMSEG",SUM_EQ_0_NUMSEG; "SUM_EQ_GENERAL",SUM_EQ_GENERAL; "SUM_EQ_GENERAL_INVERSES",SUM_EQ_GENERAL_INVERSES; "SUM_EQ_NUMSEG",SUM_EQ_NUMSEG; "SUM_EQ_SUPERSET",SUM_EQ_SUPERSET; "SUM_GP",SUM_GP; "SUM_GP_BASIC",SUM_GP_BASIC; "SUM_GP_MULTIPLIED",SUM_GP_MULTIPLIED; "SUM_GP_OFFSET",SUM_GP_OFFSET; "SUM_GROUP",SUM_GROUP; "SUM_GROUP_RELATION",SUM_GROUP_RELATION; "SUM_IMAGE",SUM_IMAGE; "SUM_IMAGE_GEN",SUM_IMAGE_GEN; "SUM_IMAGE_LE",SUM_IMAGE_LE; "SUM_IMAGE_NONZERO",SUM_IMAGE_NONZERO; "SUM_INCL_EXCL",SUM_INCL_EXCL; "SUM_INJECTION",SUM_INJECTION; "SUM_LE",SUM_LE; "SUM_LE_INCLUDED",SUM_LE_INCLUDED; "SUM_LE_NUMSEG",SUM_LE_NUMSEG; "SUM_LMUL",SUM_LMUL; "SUM_LT",SUM_LT; "SUM_LT_ALL",SUM_LT_ALL; "SUM_MULTICOUNT",SUM_MULTICOUNT; "SUM_MULTICOUNT_GEN",SUM_MULTICOUNT_GEN; "SUM_MUL_BOUND",SUM_MUL_BOUND; "SUM_NEG",SUM_NEG; "SUM_OFFSET",SUM_OFFSET; "SUM_OFFSET_0",SUM_OFFSET_0; "SUM_OVER_PERMUTATIONS_INSERT",SUM_OVER_PERMUTATIONS_INSERT; "SUM_OVER_PERMUTATIONS_NUMSEG",SUM_OVER_PERMUTATIONS_NUMSEG; "SUM_OVER_TAGGED_DIVISION_LEMMA",SUM_OVER_TAGGED_DIVISION_LEMMA; "SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; "SUM_PAIR",SUM_PAIR; "SUM_PARTIAL_PRE",SUM_PARTIAL_PRE; "SUM_PARTIAL_SUC",SUM_PARTIAL_SUC; "SUM_PERMUTATIONS_COMPOSE_L",SUM_PERMUTATIONS_COMPOSE_L; "SUM_PERMUTATIONS_COMPOSE_R",SUM_PERMUTATIONS_COMPOSE_R; "SUM_PERMUTATIONS_INVERSE",SUM_PERMUTATIONS_INVERSE; "SUM_PERMUTE",SUM_PERMUTE; "SUM_PERMUTE_NUMSEG",SUM_PERMUTE_NUMSEG; "SUM_POS_BOUND",SUM_POS_BOUND; "SUM_POS_EQ_0",SUM_POS_EQ_0; "SUM_POS_EQ_0_NUMSEG",SUM_POS_EQ_0_NUMSEG; "SUM_POS_LE",SUM_POS_LE; "SUM_POS_LE_NUMSEG",SUM_POS_LE_NUMSEG; "SUM_POS_LT",SUM_POS_LT; "SUM_POS_LT_ALL",SUM_POS_LT_ALL; "SUM_REFLECT",SUM_REFLECT; "SUM_RESTRICT",SUM_RESTRICT; "SUM_RESTRICT_SET",SUM_RESTRICT_SET; "SUM_RMUL",SUM_RMUL; "SUM_SING",SUM_SING; "SUM_SING_NUMSEG",SUM_SING_NUMSEG; "SUM_SUB",SUM_SUB; "SUM_SUBSET",SUM_SUBSET; "SUM_SUBSET_SIMPLE",SUM_SUBSET_SIMPLE; "SUM_SUB_NUMSEG",SUM_SUB_NUMSEG; "SUM_SUM_PRODUCT",SUM_SUM_PRODUCT; "SUM_SUM_RESTRICT",SUM_SUM_RESTRICT; "SUM_SUPERSET",SUM_SUPERSET; "SUM_SUPPORT",SUM_SUPPORT; "SUM_SWAP",SUM_SWAP; "SUM_SWAP_NUMSEG",SUM_SWAP_NUMSEG; "SUM_TRIV_NUMSEG",SUM_TRIV_NUMSEG; "SUM_UNION",SUM_UNION; "SUM_UNIONS_NONZERO",SUM_UNIONS_NONZERO; "SUM_UNION_EQ",SUM_UNION_EQ; "SUM_UNION_LZERO",SUM_UNION_LZERO; "SUM_UNION_NONZERO",SUM_UNION_NONZERO; "SUM_UNION_RZERO",SUM_UNION_RZERO; "SUM_UNIV",SUM_UNIV; "SUM_VSUM",SUM_VSUM; "SUM_ZERO_EXISTS",SUM_ZERO_EXISTS; "SUP",SUP; "SUPERADMISSIBLE_COND",SUPERADMISSIBLE_COND; "SUPERADMISSIBLE_CONST",SUPERADMISSIBLE_CONST; "SUPERADMISSIBLE_MATCH_GUARDED_PATTERN",SUPERADMISSIBLE_MATCH_GUARDED_PATTERN; "SUPERADMISSIBLE_MATCH_SEQPATTERN",SUPERADMISSIBLE_MATCH_SEQPATTERN; "SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN",SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN; "SUPERADMISSIBLE_T",SUPERADMISSIBLE_T; "SUPERADMISSIBLE_TAIL",SUPERADMISSIBLE_TAIL; "SUPPORTING_HYPERPLANE_CLOSED_POINT",SUPPORTING_HYPERPLANE_CLOSED_POINT; "SUPPORTING_HYPERPLANE_COMPACT_POINT_INF",SUPPORTING_HYPERPLANE_COMPACT_POINT_INF; "SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP",SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP; "SUPPORTING_HYPERPLANE_FRONTIER",SUPPORTING_HYPERPLANE_FRONTIER; "SUPPORTING_HYPERPLANE_POINT",SUPPORTING_HYPERPLANE_POINT; "SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY",SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY; "SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER",SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER; "SUPPORT_CLAUSES",SUPPORT_CLAUSES; "SUPPORT_DELTA",SUPPORT_DELTA; "SUPPORT_EMPTY",SUPPORT_EMPTY; "SUPPORT_SUBSET",SUPPORT_SUBSET; "SUPPORT_SUPPORT",SUPPORT_SUPPORT; "SUP_CLOSURE",SUP_CLOSURE; "SUP_EQ",SUP_EQ; "SUP_FINITE",SUP_FINITE; "SUP_FINITE_LEMMA",SUP_FINITE_LEMMA; "SUP_INSERT",SUP_INSERT; "SUP_INSERT_FINITE",SUP_INSERT_FINITE; "SUP_INSERT_INSERT",SUP_INSERT_INSERT; "SUP_SING",SUP_SING; "SUP_UNION",SUP_UNION; "SUP_UNIQUE",SUP_UNIQUE; "SUP_UNIQUE_FINITE",SUP_UNIQUE_FINITE; "SURA_BURA",SURA_BURA; "SURA_BURA_CLOPEN_SUBSET",SURA_BURA_CLOPEN_SUBSET; "SURA_BURA_CLOPEN_SUBSET_ALT",SURA_BURA_CLOPEN_SUBSET_ALT; "SURA_BURA_COMPACT",SURA_BURA_COMPACT; "SURJ",SURJ; "SURJECTIVE_EXISTS_THM",SURJECTIVE_EXISTS_THM; "SURJECTIVE_FORALL_THM",SURJECTIVE_FORALL_THM; "SURJECTIVE_IFF_INJECTIVE",SURJECTIVE_IFF_INJECTIVE; "SURJECTIVE_IFF_INJECTIVE_GEN",SURJECTIVE_IFF_INJECTIVE_GEN; "SURJECTIVE_IMAGE",SURJECTIVE_IMAGE; "SURJECTIVE_IMAGE_EQ",SURJECTIVE_IMAGE_EQ; "SURJECTIVE_IMAGE_THM",SURJECTIVE_IMAGE_THM; "SURJECTIVE_INVERSE",SURJECTIVE_INVERSE; "SURJECTIVE_INVERSE_o",SURJECTIVE_INVERSE_o; "SURJECTIVE_MAP",SURJECTIVE_MAP; "SURJECTIVE_ON_IMAGE",SURJECTIVE_ON_IMAGE; "SURJECTIVE_ON_PREIMAGE",SURJECTIVE_ON_PREIMAGE; "SURJECTIVE_ON_RIGHT_INVERSE",SURJECTIVE_ON_RIGHT_INVERSE; "SURJECTIVE_PREIMAGE",SURJECTIVE_PREIMAGE; "SURJECTIVE_RIGHT_INVERSE",SURJECTIVE_RIGHT_INVERSE; "SURJECTIVE_SCALING",SURJECTIVE_SCALING; "SUSLIN_INC",SUSLIN_INC; "SUSLIN_INTER",SUSLIN_INTER; "SUSLIN_INTERS",SUSLIN_INTERS; "SUSLIN_LEBESGUE_MEASURABLE",SUSLIN_LEBESGUE_MEASURABLE; "SUSLIN_MONO",SUSLIN_MONO; "SUSLIN_REGULAR",SUSLIN_REGULAR; "SUSLIN_SUBSET",SUSLIN_SUBSET; "SUSLIN_SUPERSET",SUSLIN_SUPERSET; "SUSLIN_SUSLIN",SUSLIN_SUSLIN; "SUSLIN_UNION",SUSLIN_UNION; "SUSLIN_UNIONS",SUSLIN_UNIONS; "SUSSMANN_OPEN_MAPPING",SUSSMANN_OPEN_MAPPING; "SWAPSEQ_COMPOSE",SWAPSEQ_COMPOSE; "SWAPSEQ_ENDSWAP",SWAPSEQ_ENDSWAP; "SWAPSEQ_EVEN_EVEN",SWAPSEQ_EVEN_EVEN; "SWAPSEQ_I",SWAPSEQ_I; "SWAPSEQ_IDENTITY_EVEN",SWAPSEQ_IDENTITY_EVEN; "SWAPSEQ_INVERSE",SWAPSEQ_INVERSE; "SWAPSEQ_INVERSE_EXISTS",SWAPSEQ_INVERSE_EXISTS; "SWAPSEQ_SWAP",SWAPSEQ_SWAP; "SWAP_COMMON",SWAP_COMMON; "SWAP_COMMON'",SWAP_COMMON'; "SWAP_EXISTS_THM",SWAP_EXISTS_THM; "SWAP_FORALL_THM",SWAP_FORALL_THM; "SWAP_GALOIS",SWAP_GALOIS; "SWAP_GENERAL",SWAP_GENERAL; "SWAP_IDEMPOTENT",SWAP_IDEMPOTENT; "SWAP_INDEPENDENT",SWAP_INDEPENDENT; "SWAP_REFL",SWAP_REFL; "SWAP_SYM",SWAP_SYM; "SYLVESTER_DETERMINANT_IDENTITY",SYLVESTER_DETERMINANT_IDENTITY; "SYMDIFF_PARITY_LEMMA",SYMDIFF_PARITY_LEMMA; "SYMMETRIC_CLOSURE",SYMMETRIC_CLOSURE; "SYMMETRIC_INTERIOR",SYMMETRIC_INTERIOR; "SYMMETRIC_LINEAR_IMAGE",SYMMETRIC_LINEAR_IMAGE; "SYMMETRIC_MATRIX",SYMMETRIC_MATRIX; "SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT",SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT; "SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE",SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE; "SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT",SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT; "SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE",SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE; "SYMMETRIC_MATRIX_INV",SYMMETRIC_MATRIX_INV; "SYMMETRIC_MATRIX_INV_LMUL",SYMMETRIC_MATRIX_INV_LMUL; "SYMMETRIC_MATRIX_INV_RMUL",SYMMETRIC_MATRIX_INV_RMUL; "SYMMETRIC_MATRIX_MUL",SYMMETRIC_MATRIX_MUL; "SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS",SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS; "SYMMETRIC_MATRIX_SIMILAR",SYMMETRIC_MATRIX_SIMILAR; "SYMMETRY_LEMMA",SYMMETRY_LEMMA; "TAGGED_DIVISION_FINER",TAGGED_DIVISION_FINER; "TAGGED_DIVISION_OF",TAGGED_DIVISION_OF; "TAGGED_DIVISION_OF_ALT",TAGGED_DIVISION_OF_ALT; "TAGGED_DIVISION_OF_ANOTHER",TAGGED_DIVISION_OF_ANOTHER; "TAGGED_DIVISION_OF_EMPTY",TAGGED_DIVISION_OF_EMPTY; "TAGGED_DIVISION_OF_FINITE",TAGGED_DIVISION_OF_FINITE; "TAGGED_DIVISION_OF_NONTRIVIAL",TAGGED_DIVISION_OF_NONTRIVIAL; "TAGGED_DIVISION_OF_SELF",TAGGED_DIVISION_OF_SELF; "TAGGED_DIVISION_OF_TRIVIAL",TAGGED_DIVISION_OF_TRIVIAL; "TAGGED_DIVISION_OF_UNION_SELF",TAGGED_DIVISION_OF_UNION_SELF; "TAGGED_DIVISION_SPLIT_LEFT_INJ",TAGGED_DIVISION_SPLIT_LEFT_INJ; "TAGGED_DIVISION_SPLIT_RIGHT_INJ",TAGGED_DIVISION_SPLIT_RIGHT_INJ; "TAGGED_DIVISION_UNION",TAGGED_DIVISION_UNION; "TAGGED_DIVISION_UNIONS",TAGGED_DIVISION_UNIONS; "TAGGED_DIVISION_UNIONS_EXISTS",TAGGED_DIVISION_UNIONS_EXISTS; "TAGGED_DIVISION_UNION_IMAGE_SND",TAGGED_DIVISION_UNION_IMAGE_SND; "TAGGED_DIVISION_UNION_INTERVAL",TAGGED_DIVISION_UNION_INTERVAL; "TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND",TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND; "TAGGED_PARTIAL_DIVISION_COMMON_TAGS",TAGGED_PARTIAL_DIVISION_COMMON_TAGS; "TAGGED_PARTIAL_DIVISION_OF_SUBSET",TAGGED_PARTIAL_DIVISION_OF_SUBSET; "TAGGED_PARTIAL_DIVISION_OF_TRIVIAL",TAGGED_PARTIAL_DIVISION_OF_TRIVIAL; "TAGGED_PARTIAL_DIVISION_OF_UNION_SELF",TAGGED_PARTIAL_DIVISION_OF_UNION_SELF; "TAGGED_PARTIAL_DIVISION_SUBSET",TAGGED_PARTIAL_DIVISION_SUBSET; "TAG_IN_INTERVAL",TAG_IN_INTERVAL; "TARSKI_SET",TARSKI_SET; "TENDSTO_ALT",TENDSTO_ALT; "TENDSTO_ALT_WITHIN",TENDSTO_ALT_WITHIN; "TENDSTO_LIM",TENDSTO_LIM; "THIN_FRONTIER_CIC",THIN_FRONTIER_CIC; "THIN_FRONTIER_ICI",THIN_FRONTIER_ICI; "THIN_FRONTIER_OF_CIC",THIN_FRONTIER_OF_CIC; "THIN_FRONTIER_OF_ICI",THIN_FRONTIER_OF_ICI; "THIN_FRONTIER_OF_SUBSET",THIN_FRONTIER_OF_SUBSET; "THIN_FRONTIER_SUBSET",THIN_FRONTIER_SUBSET; "TIETZE",TIETZE; "TIETZE_CLOSED_INTERVAL",TIETZE_CLOSED_INTERVAL; "TIETZE_CLOSED_INTERVAL_1",TIETZE_CLOSED_INTERVAL_1; "TIETZE_OPEN_INTERVAL",TIETZE_OPEN_INTERVAL; "TIETZE_OPEN_INTERVAL_1",TIETZE_OPEN_INTERVAL_1; "TIETZE_UNBOUNDED",TIETZE_UNBOUNDED; "TINY_INDUCTIVE_DIMENSION",TINY_INDUCTIVE_DIMENSION; "TL",TL; "TOEPLITZ_BILINEAR_SERIES",TOEPLITZ_BILINEAR_SERIES; "TOEPLITZ_BILINEAR_SERIES_NULL",TOEPLITZ_BILINEAR_SERIES_NULL; "TOPCONTINUOUS_EQ_CONTINUOUS_ON",TOPCONTINUOUS_EQ_CONTINUOUS_ON; "TOPCONTINUOUS_EQ_TOPCONTINUOUS_AT",TOPCONTINUOUS_EQ_TOPCONTINUOUS_AT; "TOPCONTINUOUS_IMAGE_SUBSET_TOPSPACE",TOPCONTINUOUS_IMAGE_SUBSET_TOPSPACE; "TOPCONTINUOUS_IN_SUBTOPOLGY",TOPCONTINUOUS_IN_SUBTOPOLGY; "TOPCONTINUOUS_LIMIT",TOPCONTINUOUS_LIMIT; "TOPCONTINUOUS_TO_METRIC",TOPCONTINUOUS_TO_METRIC; "TOPOLOGICAL_SORT",TOPOLOGICAL_SORT; "TOPOLOGY_EQ",TOPOLOGY_EQ; "TOPSPACE_EUCLIDEAN",TOPSPACE_EUCLIDEAN; "TOPSPACE_EUCLIDEAN_SUBTOPOLOGY",TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; "TOPSPACE_MTOPOLOGY",TOPSPACE_MTOPOLOGY; "TOPSPACE_SUBTOPOLOGY",TOPSPACE_SUBTOPOLOGY; "TOPSPACE_SUBTOPOLOGY_SUBSET",TOPSPACE_SUBTOPOLOGY_SUBSET; "TOSET_COFINAL_WOSET",TOSET_COFINAL_WOSET; "TOTALLY_BOUNDED_HAUSDIST",TOTALLY_BOUNDED_HAUSDIST; "TRACE_0",TRACE_0; "TRACE_ADD",TRACE_ADD; "TRACE_CMUL",TRACE_CMUL; "TRACE_COVARIANCE_CAUCHY_SCHWARZ",TRACE_COVARIANCE_CAUCHY_SCHWARZ; "TRACE_COVARIANCE_CAUCHY_SCHWARZ_ABS",TRACE_COVARIANCE_CAUCHY_SCHWARZ_ABS; "TRACE_COVARIANCE_CAUCHY_SCHWARZ_SQUARE",TRACE_COVARIANCE_CAUCHY_SCHWARZ_SQUARE; "TRACE_COVARIANCE_EQ_0",TRACE_COVARIANCE_EQ_0; "TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE",TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE; "TRACE_COVARIANCE_POS_LE",TRACE_COVARIANCE_POS_LE; "TRACE_COVARIANCE_POS_LT",TRACE_COVARIANCE_POS_LT; "TRACE_I",TRACE_I; "TRACE_LE_MUL_SQUARES",TRACE_LE_MUL_SQUARES; "TRACE_MATRIX_INV_LMUL",TRACE_MATRIX_INV_LMUL; "TRACE_MATRIX_INV_RMUL",TRACE_MATRIX_INV_RMUL; "TRACE_MUL_CYCLIC",TRACE_MUL_CYCLIC; "TRACE_MUL_POSITIVE_DEFINITE_SEMIDEFINITE_EQ_0",TRACE_MUL_POSITIVE_DEFINITE_SEMIDEFINITE_EQ_0; "TRACE_MUL_POSITIVE_SEMIDEFINITE",TRACE_MUL_POSITIVE_SEMIDEFINITE; "TRACE_MUL_POSITIVE_SEMIDEFINITE_DEFINITE_EQ_0",TRACE_MUL_POSITIVE_SEMIDEFINITE_DEFINITE_EQ_0; "TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0",TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0; "TRACE_MUL_POSITIVE_SEMIDEFINITE_LE",TRACE_MUL_POSITIVE_SEMIDEFINITE_LE; "TRACE_MUL_SYM",TRACE_MUL_SYM; "TRACE_NEG",TRACE_NEG; "TRACE_POSITIVE_DEFINITE",TRACE_POSITIVE_DEFINITE; "TRACE_POSITIVE_SEMIDEFINITE",TRACE_POSITIVE_SEMIDEFINITE; "TRACE_SIMILAR",TRACE_SIMILAR; "TRACE_SQUARE_POSITIVE_SEMIDEFINITE_LE",TRACE_SQUARE_POSITIVE_SEMIDEFINITE_LE; "TRACE_SUB",TRACE_SUB; "TRACE_TRANSP",TRACE_TRANSP; "TRANSITIVE_STEPWISE_LE",TRANSITIVE_STEPWISE_LE; "TRANSITIVE_STEPWISE_LE_EQ",TRANSITIVE_STEPWISE_LE_EQ; "TRANSITIVE_STEPWISE_LT",TRANSITIVE_STEPWISE_LT; "TRANSITIVE_STEPWISE_LT_EQ",TRANSITIVE_STEPWISE_LT_EQ; "TRANSLATION_DIFF",TRANSLATION_DIFF; "TRANSLATION_EQ_IMP",TRANSLATION_EQ_IMP; "TRANSLATION_GALOIS",TRANSLATION_GALOIS; "TRANSLATION_SUBSET_GALOIS_LEFT",TRANSLATION_SUBSET_GALOIS_LEFT; "TRANSLATION_SUBSET_GALOIS_RIGHT",TRANSLATION_SUBSET_GALOIS_RIGHT; "TRANSLATION_UNIV",TRANSLATION_UNIV; "TRANSP_COLUMNVECTOR",TRANSP_COLUMNVECTOR; "TRANSP_COMPONENT",TRANSP_COMPONENT; "TRANSP_DIAGONAL_MATRIX",TRANSP_DIAGONAL_MATRIX; "TRANSP_EQ",TRANSP_EQ; "TRANSP_EQ_0",TRANSP_EQ_0; "TRANSP_INJECTIVE",TRANSP_INJECTIVE; "TRANSP_MAT",TRANSP_MAT; "TRANSP_MATRIX_ADD",TRANSP_MATRIX_ADD; "TRANSP_MATRIX_CMUL",TRANSP_MATRIX_CMUL; "TRANSP_MATRIX_INV",TRANSP_MATRIX_INV; "TRANSP_MATRIX_NEG",TRANSP_MATRIX_NEG; "TRANSP_MATRIX_SUB",TRANSP_MATRIX_SUB; "TRANSP_ROWVECTOR",TRANSP_ROWVECTOR; "TRANSP_SURJECTIVE",TRANSP_SURJECTIVE; "TRANSP_TRANSP",TRANSP_TRANSP; "TREAL_ADD_ASSOC",TREAL_ADD_ASSOC; "TREAL_ADD_LDISTRIB",TREAL_ADD_LDISTRIB; "TREAL_ADD_LID",TREAL_ADD_LID; "TREAL_ADD_LINV",TREAL_ADD_LINV; "TREAL_ADD_SYM",TREAL_ADD_SYM; "TREAL_ADD_SYM_EQ",TREAL_ADD_SYM_EQ; "TREAL_ADD_WELLDEF",TREAL_ADD_WELLDEF; "TREAL_ADD_WELLDEFR",TREAL_ADD_WELLDEFR; "TREAL_EQ_AP",TREAL_EQ_AP; "TREAL_EQ_IMP_LE",TREAL_EQ_IMP_LE; "TREAL_EQ_REFL",TREAL_EQ_REFL; "TREAL_EQ_SYM",TREAL_EQ_SYM; "TREAL_EQ_TRANS",TREAL_EQ_TRANS; "TREAL_INV_0",TREAL_INV_0; "TREAL_INV_WELLDEF",TREAL_INV_WELLDEF; "TREAL_LE_ANTISYM",TREAL_LE_ANTISYM; "TREAL_LE_LADD_IMP",TREAL_LE_LADD_IMP; "TREAL_LE_MUL",TREAL_LE_MUL; "TREAL_LE_REFL",TREAL_LE_REFL; "TREAL_LE_TOTAL",TREAL_LE_TOTAL; "TREAL_LE_TRANS",TREAL_LE_TRANS; "TREAL_LE_WELLDEF",TREAL_LE_WELLDEF; "TREAL_MUL_ASSOC",TREAL_MUL_ASSOC; "TREAL_MUL_LID",TREAL_MUL_LID; "TREAL_MUL_LINV",TREAL_MUL_LINV; "TREAL_MUL_SYM",TREAL_MUL_SYM; "TREAL_MUL_SYM_EQ",TREAL_MUL_SYM_EQ; "TREAL_MUL_WELLDEF",TREAL_MUL_WELLDEF; "TREAL_MUL_WELLDEFR",TREAL_MUL_WELLDEFR; "TREAL_NEG_WELLDEF",TREAL_NEG_WELLDEF; "TREAL_OF_NUM_ADD",TREAL_OF_NUM_ADD; "TREAL_OF_NUM_EQ",TREAL_OF_NUM_EQ; "TREAL_OF_NUM_LE",TREAL_OF_NUM_LE; "TREAL_OF_NUM_MUL",TREAL_OF_NUM_MUL; "TREAL_OF_NUM_WELLDEF",TREAL_OF_NUM_WELLDEF; "TRIANGLE_LEMMA",TRIANGLE_LEMMA; "TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX",TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX; "TRIANGULATION_DISJOINT_RELATIVE_INTERIORS",TRIANGULATION_DISJOINT_RELATIVE_INTERIORS; "TRIANGULATION_INTER_SIMPLEX",TRIANGULATION_INTER_SIMPLEX; "TRIANGULATION_LINEAR_IMAGE",TRIANGULATION_LINEAR_IMAGE; "TRIANGULATION_SIMPLEX_FACES",TRIANGULATION_SIMPLEX_FACES; "TRIANGULATION_SIMPLEX_FACETS",TRIANGULATION_SIMPLEX_FACETS; "TRIANGULATION_SIMPLICIAL_COMPLEX",TRIANGULATION_SIMPLICIAL_COMPLEX; "TRIANGULATION_SUBFACES",TRIANGULATION_SUBFACES; "TRIANGULATION_SUBSET",TRIANGULATION_SUBSET; "TRIANGULATION_TRANSLATION",TRIANGULATION_TRANSLATION; "TRIANGULATION_UNION",TRIANGULATION_UNION; "TRIVIAL_LIMIT_AT",TRIVIAL_LIMIT_AT; "TRIVIAL_LIMIT_AT_INFINITY",TRIVIAL_LIMIT_AT_INFINITY; "TRIVIAL_LIMIT_AT_NEGINFINITY",TRIVIAL_LIMIT_AT_NEGINFINITY; "TRIVIAL_LIMIT_AT_POSINFINITY",TRIVIAL_LIMIT_AT_POSINFINITY; "TRIVIAL_LIMIT_SEQUENTIALLY",TRIVIAL_LIMIT_SEQUENTIALLY; "TRIVIAL_LIMIT_WITHIN",TRIVIAL_LIMIT_WITHIN; "TRIVIAL_LIMIT_WITHIN_CONVEX",TRIVIAL_LIMIT_WITHIN_CONVEX; "TRIV_AND_EXISTS_THM",TRIV_AND_EXISTS_THM; "TRIV_EXISTS_AND_THM",TRIV_EXISTS_AND_THM; "TRIV_EXISTS_IMP_THM",TRIV_EXISTS_IMP_THM; "TRIV_FORALL_IMP_THM",TRIV_FORALL_IMP_THM; "TRIV_FORALL_OR_THM",TRIV_FORALL_OR_THM; "TRIV_OR_FORALL_THM",TRIV_OR_FORALL_THM; "TRUTH",TRUTH; "TUBE_LEMMA",TUBE_LEMMA; "TUBE_LEMMA_GEN",TUBE_LEMMA_GEN; "TUKEY",TUKEY; "TWO",TWO; "TWO_SIDED_LIMIT_AT",TWO_SIDED_LIMIT_AT; "TWO_SIDED_LIMIT_WITHIN",TWO_SIDED_LIMIT_WITHIN; "T_DEF",T_DEF; "ULC_IMP_LOCALLY_CONNECTED",ULC_IMP_LOCALLY_CONNECTED; "UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX",UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX; "UNBOUNDED_COMPLEMENT_CONVEX",UNBOUNDED_COMPLEMENT_CONVEX; "UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT",UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT; "UNBOUNDED_COMPONENTS_OUTSIDE",UNBOUNDED_COMPONENTS_OUTSIDE; "UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY; "UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS; "UNBOUNDED_DISJOINT_IN_OUTSIDE",UNBOUNDED_DISJOINT_IN_OUTSIDE; "UNBOUNDED_HALFSPACE_COMPONENT_GE",UNBOUNDED_HALFSPACE_COMPONENT_GE; "UNBOUNDED_HALFSPACE_COMPONENT_GT",UNBOUNDED_HALFSPACE_COMPONENT_GT; "UNBOUNDED_HALFSPACE_COMPONENT_LE",UNBOUNDED_HALFSPACE_COMPONENT_LE; "UNBOUNDED_HALFSPACE_COMPONENT_LT",UNBOUNDED_HALFSPACE_COMPONENT_LT; "UNBOUNDED_INTER_COBOUNDED",UNBOUNDED_INTER_COBOUNDED; "UNBOUNDED_OUTSIDE",UNBOUNDED_OUTSIDE; "UNCOUNTABLE_CONNECTED",UNCOUNTABLE_CONNECTED; "UNCOUNTABLE_CONTAINS_LIMIT_POINT",UNCOUNTABLE_CONTAINS_LIMIT_POINT; "UNCOUNTABLE_CONVEX",UNCOUNTABLE_CONVEX; "UNCOUNTABLE_EUCLIDEAN",UNCOUNTABLE_EUCLIDEAN; "UNCOUNTABLE_HAS_CONDENSATION_POINT",UNCOUNTABLE_HAS_CONDENSATION_POINT; "UNCOUNTABLE_INTERVAL",UNCOUNTABLE_INTERVAL; "UNCOUNTABLE_NONEMPTY_INTERIOR",UNCOUNTABLE_NONEMPTY_INTERIOR; "UNCOUNTABLE_OPEN",UNCOUNTABLE_OPEN; "UNCOUNTABLE_PATH_CONNECTED",UNCOUNTABLE_PATH_CONNECTED; "UNCOUNTABLE_REAL",UNCOUNTABLE_REAL; "UNCOUNTABLE_SEGMENT",UNCOUNTABLE_SEGMENT; "UNCURRY_DEF",UNCURRY_DEF; "UNDEFINED",UNDEFINED; "UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT",UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT; "UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED",UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED; "UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE",UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE; "UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS; "UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; "UNIFORMLY_CONTINUOUS_ON_ADD",UNIFORMLY_CONTINUOUS_ON_ADD; "UNIFORMLY_CONTINUOUS_ON_CLOSURE",UNIFORMLY_CONTINUOUS_ON_CLOSURE; "UNIFORMLY_CONTINUOUS_ON_CMUL",UNIFORMLY_CONTINUOUS_ON_CMUL; "UNIFORMLY_CONTINUOUS_ON_COMPOSE",UNIFORMLY_CONTINUOUS_ON_COMPOSE; "UNIFORMLY_CONTINUOUS_ON_CONST",UNIFORMLY_CONTINUOUS_ON_CONST; "UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT",UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT; "UNIFORMLY_CONTINUOUS_ON_EQ",UNIFORMLY_CONTINUOUS_ON_EQ; "UNIFORMLY_CONTINUOUS_ON_ID",UNIFORMLY_CONTINUOUS_ON_ID; "UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST",UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST; "UNIFORMLY_CONTINUOUS_ON_MUL",UNIFORMLY_CONTINUOUS_ON_MUL; "UNIFORMLY_CONTINUOUS_ON_NEG",UNIFORMLY_CONTINUOUS_ON_NEG; "UNIFORMLY_CONTINUOUS_ON_RESTRICT",UNIFORMLY_CONTINUOUS_ON_RESTRICT; "UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY",UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; "UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT",UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT; "UNIFORMLY_CONTINUOUS_ON_SETDIST",UNIFORMLY_CONTINUOUS_ON_SETDIST; "UNIFORMLY_CONTINUOUS_ON_SETDIST_EQ",UNIFORMLY_CONTINUOUS_ON_SETDIST_EQ; "UNIFORMLY_CONTINUOUS_ON_SUB",UNIFORMLY_CONTINUOUS_ON_SUB; "UNIFORMLY_CONTINUOUS_ON_SUBSET",UNIFORMLY_CONTINUOUS_ON_SUBSET; "UNIFORMLY_CONTINUOUS_ON_UNION",UNIFORMLY_CONTINUOUS_ON_UNION; "UNIFORMLY_CONTINUOUS_ON_VMUL",UNIFORMLY_CONTINUOUS_ON_VMUL; "UNIFORMLY_CONTINUOUS_ON_VSUM",UNIFORMLY_CONTINUOUS_ON_VSUM; "UNIFORMLY_CONVERGENT_EQ_CAUCHY",UNIFORMLY_CONVERGENT_EQ_CAUCHY; "UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT",UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT; "UNIFORM_LIM_ADD",UNIFORM_LIM_ADD; "UNIFORM_LIM_BILINEAR",UNIFORM_LIM_BILINEAR; "UNIFORM_LIM_SUB",UNIFORM_LIM_SUB; "UNION",UNION; "UNIONS",UNIONS; "UNIONS_0",UNIONS_0; "UNIONS_1",UNIONS_1; "UNIONS_2",UNIONS_2; "UNIONS_COMPONENTS",UNIONS_COMPONENTS; "UNIONS_CONNECTED_COMPONENT",UNIONS_CONNECTED_COMPONENT; "UNIONS_DELETE_EMPTY",UNIONS_DELETE_EMPTY; "UNIONS_DIFF",UNIONS_DIFF; "UNIONS_GSPEC",UNIONS_GSPEC; "UNIONS_IMAGE",UNIONS_IMAGE; "UNIONS_INSERT",UNIONS_INSERT; "UNIONS_INSERT_EMPTY",UNIONS_INSERT_EMPTY; "UNIONS_INTERS",UNIONS_INTERS; "UNIONS_IN_CHAIN",UNIONS_IN_CHAIN; "UNIONS_MAXIMAL_SETS",UNIONS_MAXIMAL_SETS; "UNIONS_MONO",UNIONS_MONO; "UNIONS_MONO_IMAGE",UNIONS_MONO_IMAGE; "UNIONS_OVER_INTERS",UNIONS_OVER_INTERS; "UNIONS_PATH_COMPONENT",UNIONS_PATH_COMPONENT; "UNIONS_PRED",UNIONS_PRED; "UNIONS_SUBSET",UNIONS_SUBSET; "UNIONS_UNION",UNIONS_UNION; "UNIONS_UNIV",UNIONS_UNIV; "UNION_ACI",UNION_ACI; "UNION_ASSOC",UNION_ASSOC; "UNION_COMM",UNION_COMM; "UNION_EMPTY",UNION_EMPTY; "UNION_FL",UNION_FL; "UNION_FRONTIER",UNION_FRONTIER; "UNION_IDEMPOT",UNION_IDEMPOT; "UNION_INSEG",UNION_INSEG; "UNION_INTERIOR_OF_SUBSET",UNION_INTERIOR_OF_SUBSET; "UNION_INTERIOR_SUBSET",UNION_INTERIOR_SUBSET; "UNION_INTERVAL_1",UNION_INTERVAL_1; "UNION_INTERVAL_SUBSET_INTERVAL",UNION_INTERVAL_SUBSET_INTERVAL; "UNION_LE_ADD_C",UNION_LE_ADD_C; "UNION_OF",UNION_OF; "UNION_OF_INC",UNION_OF_INC; "UNION_OF_MONO",UNION_OF_MONO; "UNION_OVER_INTER",UNION_OVER_INTER; "UNION_SEGMENT",UNION_SEGMENT; "UNION_SUBSET",UNION_SUBSET; "UNION_UNIV",UNION_UNIV; "UNION_WITH_INSIDE",UNION_WITH_INSIDE; "UNION_WITH_OUTSIDE",UNION_WITH_OUTSIDE; "UNIQUE_SKOLEM_ALT",UNIQUE_SKOLEM_ALT; "UNIQUE_SKOLEM_THM",UNIQUE_SKOLEM_THM; "UNIT_INTERVAL_CONVEX_HULL",UNIT_INTERVAL_CONVEX_HULL; "UNIT_INTERVAL_NONEMPTY",UNIT_INTERVAL_NONEMPTY; "UNIV",UNIV; "UNIVERSAL_COVERING_SPACE",UNIVERSAL_COVERING_SPACE; "UNIV_GSPEC",UNIV_GSPEC; "UNIV_NOT_EMPTY",UNIV_NOT_EMPTY; "UNIV_PCROSS_UNIV",UNIV_PCROSS_UNIV; "UNIV_SECOND_COUNTABLE",UNIV_SECOND_COUNTABLE; "UNIV_SECOND_COUNTABLE_SEQUENCE",UNIV_SECOND_COUNTABLE_SEQUENCE; "UNIV_SUBSET",UNIV_SUBSET; "UNWIND_THM1",UNWIND_THM1; "UNWIND_THM2",UNWIND_THM2; "UPPER_BOUND_FINITE_SET",UPPER_BOUND_FINITE_SET; "UPPER_BOUND_FINITE_SET_REAL",UPPER_BOUND_FINITE_SET_REAL; "UPPER_HEMICONTINUOUS",UPPER_HEMICONTINUOUS; "UPPER_LOWER_HEMICONTINUOUS",UPPER_LOWER_HEMICONTINUOUS; "UPPER_LOWER_HEMICONTINUOUS_EXPLICIT",UPPER_LOWER_HEMICONTINUOUS_EXPLICIT; "URYSOHN",URYSOHN; "URYSOHN_LOCAL",URYSOHN_LOCAL; "URYSOHN_LOCAL_STRONG",URYSOHN_LOCAL_STRONG; "URYSOHN_STRONG",URYSOHN_STRONG; "VARIATION_EQUAL_LEMMA",VARIATION_EQUAL_LEMMA; "VECTOR_1",VECTOR_1; "VECTOR_2",VECTOR_2; "VECTOR_3",VECTOR_3; "VECTOR_4",VECTOR_4; "VECTOR_ADD_AC",VECTOR_ADD_AC; "VECTOR_ADD_ASSOC",VECTOR_ADD_ASSOC; "VECTOR_ADD_COMPONENT",VECTOR_ADD_COMPONENT; "VECTOR_ADD_LDISTRIB",VECTOR_ADD_LDISTRIB; "VECTOR_ADD_LID",VECTOR_ADD_LID; "VECTOR_ADD_LINV",VECTOR_ADD_LINV; "VECTOR_ADD_RDISTRIB",VECTOR_ADD_RDISTRIB; "VECTOR_ADD_RID",VECTOR_ADD_RID; "VECTOR_ADD_RINV",VECTOR_ADD_RINV; "VECTOR_ADD_SUB",VECTOR_ADD_SUB; "VECTOR_ADD_SYM",VECTOR_ADD_SYM; "VECTOR_AFFINITY_EQ",VECTOR_AFFINITY_EQ; "VECTOR_CHOOSE_DIST",VECTOR_CHOOSE_DIST; "VECTOR_CHOOSE_SIZE",VECTOR_CHOOSE_SIZE; "VECTOR_COMPONENTWISE",VECTOR_COMPONENTWISE; "VECTOR_DERIVATIVE_AT",VECTOR_DERIVATIVE_AT; "VECTOR_DERIVATIVE_CONST_AT",VECTOR_DERIVATIVE_CONST_AT; "VECTOR_DERIVATIVE_INCREASING_WITHIN",VECTOR_DERIVATIVE_INCREASING_WITHIN; "VECTOR_DERIVATIVE_UNIQUE_AT",VECTOR_DERIVATIVE_UNIQUE_AT; "VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; "VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL; "VECTOR_DERIVATIVE_WORKS",VECTOR_DERIVATIVE_WORKS; "VECTOR_DIFFERENTIABLE",VECTOR_DIFFERENTIABLE; "VECTOR_DIFFERENTIABLE_BOUND",VECTOR_DIFFERENTIABLE_BOUND; "VECTOR_DIFF_CHAIN_AT",VECTOR_DIFF_CHAIN_AT; "VECTOR_DIFF_CHAIN_WITHIN",VECTOR_DIFF_CHAIN_WITHIN; "VECTOR_EQ",VECTOR_EQ; "VECTOR_EQ_ADDR",VECTOR_EQ_ADDR; "VECTOR_EQ_AFFINITY",VECTOR_EQ_AFFINITY; "VECTOR_EQ_DOT_SPAN",VECTOR_EQ_DOT_SPAN; "VECTOR_EQ_LDOT",VECTOR_EQ_LDOT; "VECTOR_EQ_NEG2",VECTOR_EQ_NEG2; "VECTOR_EQ_RDOT",VECTOR_EQ_RDOT; "VECTOR_EXPAND_1",VECTOR_EXPAND_1; "VECTOR_EXPAND_2",VECTOR_EXPAND_2; "VECTOR_EXPAND_3",VECTOR_EXPAND_3; "VECTOR_EXPAND_4",VECTOR_EXPAND_4; "VECTOR_IN_ORTHOGONAL_BASIS",VECTOR_IN_ORTHOGONAL_BASIS; "VECTOR_IN_ORTHOGONAL_SPANNINGSET",VECTOR_IN_ORTHOGONAL_SPANNINGSET; "VECTOR_IN_ORTHONORMAL_BASIS",VECTOR_IN_ORTHONORMAL_BASIS; "VECTOR_MATRIX_MUL_TRANSP",VECTOR_MATRIX_MUL_TRANSP; "VECTOR_MUL_ASSOC",VECTOR_MUL_ASSOC; "VECTOR_MUL_COMPONENT",VECTOR_MUL_COMPONENT; "VECTOR_MUL_EQ_0",VECTOR_MUL_EQ_0; "VECTOR_MUL_LCANCEL",VECTOR_MUL_LCANCEL; "VECTOR_MUL_LCANCEL_IMP",VECTOR_MUL_LCANCEL_IMP; "VECTOR_MUL_LID",VECTOR_MUL_LID; "VECTOR_MUL_LNEG",VECTOR_MUL_LNEG; "VECTOR_MUL_LZERO",VECTOR_MUL_LZERO; "VECTOR_MUL_RCANCEL",VECTOR_MUL_RCANCEL; "VECTOR_MUL_RCANCEL_IMP",VECTOR_MUL_RCANCEL_IMP; "VECTOR_MUL_RNEG",VECTOR_MUL_RNEG; "VECTOR_MUL_RZERO",VECTOR_MUL_RZERO; "VECTOR_NEG_0",VECTOR_NEG_0; "VECTOR_NEG_COMPONENT",VECTOR_NEG_COMPONENT; "VECTOR_NEG_EQ_0",VECTOR_NEG_EQ_0; "VECTOR_NEG_MINUS1",VECTOR_NEG_MINUS1; "VECTOR_NEG_NEG",VECTOR_NEG_NEG; "VECTOR_NEG_SUB",VECTOR_NEG_SUB; "VECTOR_ONE",VECTOR_ONE; "VECTOR_SUB",VECTOR_SUB; "VECTOR_SUB_ADD",VECTOR_SUB_ADD; "VECTOR_SUB_ADD2",VECTOR_SUB_ADD2; "VECTOR_SUB_COMPONENT",VECTOR_SUB_COMPONENT; "VECTOR_SUB_EQ",VECTOR_SUB_EQ; "VECTOR_SUB_LDISTRIB",VECTOR_SUB_LDISTRIB; "VECTOR_SUB_LZERO",VECTOR_SUB_LZERO; "VECTOR_SUB_PROJECT_ORTHOGONAL",VECTOR_SUB_PROJECT_ORTHOGONAL; "VECTOR_SUB_RADD",VECTOR_SUB_RADD; "VECTOR_SUB_RDISTRIB",VECTOR_SUB_RDISTRIB; "VECTOR_SUB_REFL",VECTOR_SUB_REFL; "VECTOR_SUB_RZERO",VECTOR_SUB_RZERO; "VECTOR_VARIATION_AFFINITY",VECTOR_VARIATION_AFFINITY; "VECTOR_VARIATION_AFFINITY2",VECTOR_VARIATION_AFFINITY2; "VECTOR_VARIATION_CMUL",VECTOR_VARIATION_CMUL; "VECTOR_VARIATION_COMBINE",VECTOR_VARIATION_COMBINE; "VECTOR_VARIATION_COMPARISON",VECTOR_VARIATION_COMPARISON; "VECTOR_VARIATION_COMPONENT_LE",VECTOR_VARIATION_COMPONENT_LE; "VECTOR_VARIATION_COMPOSE_DECREASING",VECTOR_VARIATION_COMPOSE_DECREASING; "VECTOR_VARIATION_COMPOSE_HOMEOMORPHISM",VECTOR_VARIATION_COMPOSE_HOMEOMORPHISM; "VECTOR_VARIATION_COMPOSE_INCREASING",VECTOR_VARIATION_COMPOSE_INCREASING; "VECTOR_VARIATION_COMPOSE_INCREASING_GEN",VECTOR_VARIATION_COMPOSE_INCREASING_GEN; "VECTOR_VARIATION_CONST",VECTOR_VARIATION_CONST; "VECTOR_VARIATION_CONST_EQ",VECTOR_VARIATION_CONST_EQ; "VECTOR_VARIATION_CONTINUOUS",VECTOR_VARIATION_CONTINUOUS; "VECTOR_VARIATION_CONTINUOUS_LEFT",VECTOR_VARIATION_CONTINUOUS_LEFT; "VECTOR_VARIATION_CONTINUOUS_RIGHT",VECTOR_VARIATION_CONTINUOUS_RIGHT; "VECTOR_VARIATION_DEGENERATES",VECTOR_VARIATION_DEGENERATES; "VECTOR_VARIATION_EQ",VECTOR_VARIATION_EQ; "VECTOR_VARIATION_GE_DROP_FUNCTION",VECTOR_VARIATION_GE_DROP_FUNCTION; "VECTOR_VARIATION_GE_NORM_FUNCTION",VECTOR_VARIATION_GE_NORM_FUNCTION; "VECTOR_VARIATION_ID",VECTOR_VARIATION_ID; "VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE; "VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_GEN",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_GEN; "VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_REV",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE_REV; "VECTOR_VARIATION_ISOMETRIC",VECTOR_VARIATION_ISOMETRIC; "VECTOR_VARIATION_ISOMETRIC_COMPOSE",VECTOR_VARIATION_ISOMETRIC_COMPOSE; "VECTOR_VARIATION_LE_UNION",VECTOR_VARIATION_LE_UNION; "VECTOR_VARIATION_LIFT_ABS",VECTOR_VARIATION_LIFT_ABS; "VECTOR_VARIATION_LINEAR",VECTOR_VARIATION_LINEAR; "VECTOR_VARIATION_LIPSCHITZ",VECTOR_VARIATION_LIPSCHITZ; "VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; "VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_LEFT",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_LEFT; "VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_RIGHT",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE_RIGHT; "VECTOR_VARIATION_MONOTONE",VECTOR_VARIATION_MONOTONE; "VECTOR_VARIATION_NEG",VECTOR_VARIATION_NEG; "VECTOR_VARIATION_ON_CLOSURE",VECTOR_VARIATION_ON_CLOSURE; "VECTOR_VARIATION_ON_DIVISION",VECTOR_VARIATION_ON_DIVISION; "VECTOR_VARIATION_ON_EMPTY",VECTOR_VARIATION_ON_EMPTY; "VECTOR_VARIATION_ON_INTERIOR",VECTOR_VARIATION_ON_INTERIOR; "VECTOR_VARIATION_ON_INTERVAL",VECTOR_VARIATION_ON_INTERVAL; "VECTOR_VARIATION_ON_NULL",VECTOR_VARIATION_ON_NULL; "VECTOR_VARIATION_POS_LE",VECTOR_VARIATION_POS_LE; "VECTOR_VARIATION_REFLECT",VECTOR_VARIATION_REFLECT; "VECTOR_VARIATION_REFLECT2",VECTOR_VARIATION_REFLECT2; "VECTOR_VARIATION_REFLECT_INTERVAL",VECTOR_VARIATION_REFLECT_INTERVAL; "VECTOR_VARIATION_SEGMENT_TRIANGLE",VECTOR_VARIATION_SEGMENT_TRIANGLE; "VECTOR_VARIATION_SING",VECTOR_VARIATION_SING; "VECTOR_VARIATION_SPLIT",VECTOR_VARIATION_SPLIT; "VECTOR_VARIATION_SUM_LE",VECTOR_VARIATION_SUM_LE; "VECTOR_VARIATION_TRANSLATION",VECTOR_VARIATION_TRANSLATION; "VECTOR_VARIATION_TRANSLATION2",VECTOR_VARIATION_TRANSLATION2; "VECTOR_VARIATION_TRANSLATION_ALT",VECTOR_VARIATION_TRANSLATION_ALT; "VECTOR_VARIATION_TRANSLATION_INTERVAL",VECTOR_VARIATION_TRANSLATION_INTERVAL; "VECTOR_VARIATION_TRIANGLE",VECTOR_VARIATION_TRIANGLE; "VECTOR_VARIATION_UNION_LE",VECTOR_VARIATION_UNION_LE; "VECTOR_VARIATION_VECTOR_VARIATION",VECTOR_VARIATION_VECTOR_VARIATION; "VECTOR_VARIATION_VMUL",VECTOR_VARIATION_VMUL; "VEC_COMPONENT",VEC_COMPONENT; "VEC_EQ",VEC_EQ; "VERTEX_IMAGE_LINEAR",VERTEX_IMAGE_LINEAR; "VERTEX_IMAGE_LINEAR_GEN",VERTEX_IMAGE_LINEAR_GEN; "VERTEX_IMAGE_LINEAR_POLYTOPE",VERTEX_IMAGE_LINEAR_POLYTOPE; "VERTEX_IMAGE_NONEMPTY",VERTEX_IMAGE_NONEMPTY; "VITALI_COVERING_LEMMA_BALLS",VITALI_COVERING_LEMMA_BALLS; "VITALI_COVERING_LEMMA_CBALLS",VITALI_COVERING_LEMMA_CBALLS; "VITALI_COVERING_LEMMA_CBALLS_BALLS",VITALI_COVERING_LEMMA_CBALLS_BALLS; "VITALI_COVERING_THEOREM_BALLS",VITALI_COVERING_THEOREM_BALLS; "VITALI_COVERING_THEOREM_CBALLS",VITALI_COVERING_THEOREM_CBALLS; "VSUM",VSUM; "VSUM_0",VSUM_0; "VSUM_1",VSUM_1; "VSUM_2",VSUM_2; "VSUM_3",VSUM_3; "VSUM_4",VSUM_4; "VSUM_ADD",VSUM_ADD; "VSUM_ADD_GEN",VSUM_ADD_GEN; "VSUM_ADD_NUMSEG",VSUM_ADD_NUMSEG; "VSUM_ADD_SPLIT",VSUM_ADD_SPLIT; "VSUM_BIJECTION",VSUM_BIJECTION; "VSUM_CASES",VSUM_CASES; "VSUM_CASES_1",VSUM_CASES_1; "VSUM_CLAUSES",VSUM_CLAUSES; "VSUM_CLAUSES_LEFT",VSUM_CLAUSES_LEFT; "VSUM_CLAUSES_NUMSEG",VSUM_CLAUSES_NUMSEG; "VSUM_CLAUSES_RIGHT",VSUM_CLAUSES_RIGHT; "VSUM_CMUL_NUMSEG",VSUM_CMUL_NUMSEG; "VSUM_COMBINE_L",VSUM_COMBINE_L; "VSUM_COMBINE_R",VSUM_COMBINE_R; "VSUM_COMPONENT",VSUM_COMPONENT; "VSUM_CONST",VSUM_CONST; "VSUM_CONST_NUMSEG",VSUM_CONST_NUMSEG; "VSUM_CONTENT_NULL",VSUM_CONTENT_NULL; "VSUM_DELETE",VSUM_DELETE; "VSUM_DELETE_CASES",VSUM_DELETE_CASES; "VSUM_DELTA",VSUM_DELTA; "VSUM_DIFF",VSUM_DIFF; "VSUM_DIFFS",VSUM_DIFFS; "VSUM_DIFFS_ALT",VSUM_DIFFS_ALT; "VSUM_DIFF_LEMMA",VSUM_DIFF_LEMMA; "VSUM_EQ",VSUM_EQ; "VSUM_EQ_0",VSUM_EQ_0; "VSUM_EQ_GENERAL",VSUM_EQ_GENERAL; "VSUM_EQ_GENERAL_INVERSES",VSUM_EQ_GENERAL_INVERSES; "VSUM_EQ_NUMSEG",VSUM_EQ_NUMSEG; "VSUM_EQ_SUPERSET",VSUM_EQ_SUPERSET; "VSUM_GROUP",VSUM_GROUP; "VSUM_GROUP_RELATION",VSUM_GROUP_RELATION; "VSUM_IMAGE",VSUM_IMAGE; "VSUM_IMAGE_GEN",VSUM_IMAGE_GEN; "VSUM_IMAGE_NONZERO",VSUM_IMAGE_NONZERO; "VSUM_INCL_EXCL",VSUM_INCL_EXCL; "VSUM_INJECTION",VSUM_INJECTION; "VSUM_LMUL",VSUM_LMUL; "VSUM_NEG",VSUM_NEG; "VSUM_NONZERO_IMAGE_LEMMA",VSUM_NONZERO_IMAGE_LEMMA; "VSUM_NORM",VSUM_NORM; "VSUM_NORM_ALLSUBSETS_BOUND",VSUM_NORM_ALLSUBSETS_BOUND; "VSUM_NORM_BOUND",VSUM_NORM_BOUND; "VSUM_NORM_LE",VSUM_NORM_LE; "VSUM_NORM_TRIANGLE",VSUM_NORM_TRIANGLE; "VSUM_OFFSET",VSUM_OFFSET; "VSUM_OFFSET_0",VSUM_OFFSET_0; "VSUM_OVER_TAGGED_DIVISION_LEMMA",VSUM_OVER_TAGGED_DIVISION_LEMMA; "VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; "VSUM_PAIR",VSUM_PAIR; "VSUM_PAIR_0",VSUM_PAIR_0; "VSUM_PARTIAL_PRE",VSUM_PARTIAL_PRE; "VSUM_PARTIAL_SUC",VSUM_PARTIAL_SUC; "VSUM_REAL",VSUM_REAL; "VSUM_REFLECT",VSUM_REFLECT; "VSUM_RESTRICT",VSUM_RESTRICT; "VSUM_RESTRICT_SET",VSUM_RESTRICT_SET; "VSUM_RMUL",VSUM_RMUL; "VSUM_SING",VSUM_SING; "VSUM_SING_NUMSEG",VSUM_SING_NUMSEG; "VSUM_SUB",VSUM_SUB; "VSUM_SUB_NUMSEG",VSUM_SUB_NUMSEG; "VSUM_SUC",VSUM_SUC; "VSUM_SUPERSET",VSUM_SUPERSET; "VSUM_SUPPORT",VSUM_SUPPORT; "VSUM_SWAP",VSUM_SWAP; "VSUM_SWAP_NUMSEG",VSUM_SWAP_NUMSEG; "VSUM_TRIV_NUMSEG",VSUM_TRIV_NUMSEG; "VSUM_UNION",VSUM_UNION; "VSUM_UNIONS_NONZERO",VSUM_UNIONS_NONZERO; "VSUM_UNION_LZERO",VSUM_UNION_LZERO; "VSUM_UNION_NONZERO",VSUM_UNION_NONZERO; "VSUM_UNION_RZERO",VSUM_UNION_RZERO; "VSUM_UNIV",VSUM_UNIV; "VSUM_VMUL",VSUM_VMUL; "VSUM_VSUM_PRODUCT",VSUM_VSUM_PRODUCT; "WEAK_LEBESGUE_POINTS_IMP_IVT",WEAK_LEBESGUE_POINTS_IMP_IVT; "WELLCHAINED_ELEMENTS",WELLCHAINED_ELEMENTS; "WELLCHAINED_INTERS",WELLCHAINED_INTERS; "WELLCHAINED_SETS",WELLCHAINED_SETS; "WF",WF; "WF_ANTISYM",WF_ANTISYM; "WF_CARD_LT",WF_CARD_LT; "WF_DCHAIN",WF_DCHAIN; "WF_EQ",WF_EQ; "WF_EREC",WF_EREC; "WF_FALSE",WF_FALSE; "WF_FINITE",WF_FINITE; "WF_IND",WF_IND; "WF_INSEG_WOSET",WF_INSEG_WOSET; "WF_INT_MEASURE",WF_INT_MEASURE; "WF_INT_MEASURE_2",WF_INT_MEASURE_2; "WF_LEX",WF_LEX; "WF_LEX_DEPENDENT",WF_LEX_DEPENDENT; "WF_MEASURE",WF_MEASURE; "WF_MEASURE_GEN",WF_MEASURE_GEN; "WF_POINTWISE",WF_POINTWISE; "WF_PSUBSET",WF_PSUBSET; "WF_REC",WF_REC; "WF_REC_CASES",WF_REC_CASES; "WF_REC_CASES'",WF_REC_CASES'; "WF_REC_EXISTS",WF_REC_EXISTS; "WF_REC_INVARIANT",WF_REC_INVARIANT; "WF_REC_TAIL",WF_REC_TAIL; "WF_REC_TAIL_GENERAL",WF_REC_TAIL_GENERAL; "WF_REC_TAIL_GENERAL'",WF_REC_TAIL_GENERAL'; "WF_REC_WF",WF_REC_WF; "WF_REC_num",WF_REC_num; "WF_REFL",WF_REFL; "WF_SUBSET",WF_SUBSET; "WF_UREC",WF_UREC; "WF_UREC_WF",WF_UREC_WF; "WF_num",WF_num; "WIENER_COVERING_LEMMA_BALLS",WIENER_COVERING_LEMMA_BALLS; "WIENER_COVERING_LEMMA_CBALLS",WIENER_COVERING_LEMMA_CBALLS; "WITHIN",WITHIN; "WITHIN_UNIV",WITHIN_UNIV; "WITHIN_WITHIN",WITHIN_WITHIN; "WLOG_LE",WLOG_LE; "WLOG_LINEAR_INJECTIVE_IMAGE",WLOG_LINEAR_INJECTIVE_IMAGE; "WLOG_LINEAR_INJECTIVE_IMAGE_2",WLOG_LINEAR_INJECTIVE_IMAGE_2; "WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT; "WLOG_LINEAR_INJECTIVE_IMAGE_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_ALT; "WLOG_LT",WLOG_LT; "WLOG_RELATION",WLOG_RELATION; "WO",WO; "WOSET",WOSET; "WOSET_ANTISYM",WOSET_ANTISYM; "WOSET_FINITE_TOSET",WOSET_FINITE_TOSET; "WOSET_FLEQ",WOSET_FLEQ; "WOSET_INSEG_ORDINAL",WOSET_INSEG_ORDINAL; "WOSET_POSET",WOSET_POSET; "WOSET_REFL",WOSET_REFL; "WOSET_TOTAL",WOSET_TOTAL; "WOSET_TOTAL_LE",WOSET_TOTAL_LE; "WOSET_TOTAL_LT",WOSET_TOTAL_LT; "WOSET_TRANS",WOSET_TRANS; "WOSET_TRANS_LE",WOSET_TRANS_LE; "WOSET_TRANS_LESS",WOSET_TRANS_LESS; "WOSET_WELL",WOSET_WELL; "WOSET_WELL_CONTRAPOS",WOSET_WELL_CONTRAPOS; "WOSET_WF",WOSET_WF; "WO_ORDINAL",WO_ORDINAL; "ZBOT",ZBOT; "ZCONSTR",ZCONSTR; "ZCONSTR_ZBOT",ZCONSTR_ZBOT; "ZERO_AE_DERIVATIVE_IMP_CONSTANT",ZERO_AE_DERIVATIVE_IMP_CONSTANT; "ZERO_AE_DERIVATIVE_IMP_CONSTANT_GEN",ZERO_AE_DERIVATIVE_IMP_CONSTANT_GEN; "ZERO_DEF",ZERO_DEF; "ZIP",ZIP; "ZIP_DEF",ZIP_DEF; "ZL",ZL; "ZL_SUBSETS",ZL_SUBSETS; "ZL_SUBSETS_UNIONS",ZL_SUBSETS_UNIONS; "ZL_SUBSETS_UNIONS_NONEMPTY",ZL_SUBSETS_UNIONS_NONEMPTY; "ZRECSPACE_CASES",ZRECSPACE_CASES; "ZRECSPACE_INDUCT",ZRECSPACE_INDUCT; "ZRECSPACE_RULES",ZRECSPACE_RULES; "_FALSITY_",_FALSITY_; "_FUNCTION",_FUNCTION; "_GUARDED_PATTERN",_GUARDED_PATTERN; "_MATCH",_MATCH; "_SEQPATTERN",_SEQPATTERN; "_UNGUARDED_PATTERN",_UNGUARDED_PATTERN; "absolutely_continuous_on",absolutely_continuous_on; "absolutely_integrable_on",absolutely_integrable_on; "absolutely_setcontinuous_on",absolutely_setcontinuous_on; "add_c",add_c; "adjoint",adjoint; "admissible",admissible; "aff_dim",aff_dim; "affine",affine; "affine_dependent",affine_dependent; "analytic",analytic; "arc",arc; "at",at; "at_infinity",at_infinity; "at_neginfinity",at_neginfinity; "at_posinfinity",at_posinfinity; "baire",baire; "ball",ball; "barycentre",barycentre; "basis",basis; "between",between; "bilinear",bilinear; "binarysum",binarysum; "bitset",bitset; "bool_INDUCT",bool_INDUCT; "bool_RECURSION",bool_RECURSION; "borel_CASES",borel_CASES; "borel_INDUCT",borel_INDUCT; "borel_RULES",borel_RULES; "borel_measurable_CASES",borel_measurable_CASES; "borel_measurable_INDUCT",borel_measurable_INDUCT; "borel_measurable_RULES",borel_measurable_RULES; "bounded",bounded; "brouwer_degree2",brouwer_degree2; "brouwer_degree3",brouwer_degree3; "cart_tybij",cart_tybij; "cauchy",cauchy; "cauchy_in",cauchy_in; "cball",cball; "cfunspace",cfunspace; "chain",chain; "char_INDUCT",char_INDUCT; "char_RECURSION",char_RECURSION; "closed",closed; "closed_in",closed_in; "closed_interval",closed_interval; "closed_segment",closed_segment; "closest_point",closest_point; "closure",closure; "closure_of",closure_of; "codeset",codeset; "cofactor",cofactor; "collinear",collinear; "column",column; "columns",columns; "columnvector",columnvector; "compact",compact; "compact_in",compact_in; "complete",complete; "components",components; "condensation_point_of",condensation_point_of; "cong",cong; "conic",conic; "connected",connected; "connected_component",connected_component; "content",content; "continuous",continuous; "continuous_at",continuous_at; "continuous_on",continuous_on; "continuous_within",continuous_within; "contractible",contractible; "convex",convex; "convex_cone",convex_cone; "convex_on",convex_on; "coplanar",coplanar; "covering_space",covering_space; "dependent",dependent; "derived_set_of",derived_set_of; "dest_int_rep",dest_int_rep; "det",det; "diagonal_matrix",diagonal_matrix; "diameter",diameter; "differentiable",differentiable; "differentiable_on",differentiable_on; "dim",dim; "dimension",dimension; "dimindex",dimindex; "dist",dist; "divides",divides; "division_of",division_of; "division_points",division_points; "dot",dot; "drop",drop; "dropout",dropout; "edge_of",edge_of; "epigraph",epigraph; "eq_c",eq_c; "equiintegrable_on",equiintegrable_on; "euclidean",euclidean; "euclidean_metric",euclidean_metric; "evenperm",evenperm; "eventually",eventually; "exp_c",exp_c; "exposed_face_of",exposed_face_of; "extreme_point_of",extreme_point_of; "face_of",face_of; "facet_of",facet_of; "fine",fine; "finite_diff_tybij",finite_diff_tybij; "finite_image_tybij",finite_image_tybij; "finite_index",finite_index; "finite_prod_tybij",finite_prod_tybij; "finite_sum_tybij",finite_sum_tybij; "fl",fl; "frechet_derivative",frechet_derivative; "from",from; "frontier",frontier; "frontier_of",frontier_of; "fsigma",fsigma; "fstcart",fstcart; "fundamental_group",fundamental_group; "funspace",funspace; "gauge",gauge; "gdelta",gdelta; "ge_c",ge_c; "geom_mul",geom_mul; "grade",grade; "gt_c",gt_c; "has_bounded_setvariation_on",has_bounded_setvariation_on; "has_bounded_variation_on",has_bounded_variation_on; "has_derivative",has_derivative; "has_derivative_at",has_derivative_at; "has_derivative_within",has_derivative_within; "has_integral",has_integral; "has_integral_alt",has_integral_alt; "has_integral_compact_interval",has_integral_compact_interval; "has_integral_def",has_integral_def; "has_measure",has_measure; "has_vector_derivative",has_vector_derivative; "hausdist",hausdist; "homeomorphic",homeomorphic; "homeomorphism",homeomorphism; "homotopic_loops",homotopic_loops; "homotopic_paths",homotopic_paths; "homotopic_with",homotopic_with; "homotopy_equivalent",homotopy_equivalent; "hreal_add",hreal_add; "hreal_add_th",hreal_add_th; "hreal_inv",hreal_inv; "hreal_inv_th",hreal_inv_th; "hreal_le",hreal_le; "hreal_le_th",hreal_le_th; "hreal_mul",hreal_mul; "hreal_mul_th",hreal_mul_th; "hreal_of_num",hreal_of_num; "hreal_of_num_th",hreal_of_num_th; "hull",hull; "in_direction",in_direction; "independent",independent; "indicator",indicator; "inf",inf; "infnorm",infnorm; "infsum",infsum; "inner",inner; "inseg",inseg; "inside",inside; "int_abs",int_abs; "int_abs_th",int_abs_th; "int_abstr",int_abstr; "int_add",int_add; "int_add_th",int_add_th; "int_congruent",int_congruent; "int_coprime",int_coprime; "int_divides",int_divides; "int_eq",int_eq; "int_gcd",int_gcd; "int_ge",int_ge; "int_gt",int_gt; "int_le",int_le; "int_lt",int_lt; "int_max",int_max; "int_max_th",int_max_th; "int_min",int_min; "int_min_th",int_min_th; "int_mod",int_mod; "int_mul",int_mul; "int_mul_th",int_mul_th; "int_neg",int_neg; "int_neg_th",int_neg_th; "int_of_num",int_of_num; "int_of_num_th",int_of_num_th; "int_pow",int_pow; "int_pow_th",int_pow_th; "int_rep",int_rep; "int_sgn",int_sgn; "int_sgn_th",int_sgn_th; "int_sub",int_sub; "int_sub_th",int_sub_th; "int_tybij",int_tybij; "integer",integer; "integrable_on",integrable_on; "integral",integral; "interior",interior; "interior_of",interior_of; "interval",interval; "interval_bij",interval_bij; "interval_lowerbound",interval_lowerbound; "interval_upperbound",interval_upperbound; "inverse",inverse; "invertible",invertible; "is_int",is_int; "is_interval",is_interval; "is_metric_space",is_metric_space; "is_nadd",is_nadd; "is_nadd_0",is_nadd_0; "istopology",istopology; "iterate",iterate; "jacobian",jacobian; "joinpaths",joinpaths; "lambda",lambda; "lambdas",lambdas; "le_c",le_c; "lebesgue_measurable",lebesgue_measurable; "lemma",lemma; "less",less; "lift",lift; "lifted",lifted; "lim",lim; "limit",limit; "limit_point_of",limit_point_of; "linear",linear; "linepath",linepath; "linseg",linseg; "list_CASES",list_CASES; "list_INDUCT",list_INDUCT; "list_RECURSION",list_RECURSION; "list_of_seq",list_of_seq; "list_of_set",list_of_set; "locally",locally; "lt_c",lt_c; "manhattan",manhattan; "maprows",maprows; "mat",mat; "matrix",matrix; "matrix_add",matrix_add; "matrix_cmul",matrix_cmul; "matrix_inv",matrix_inv; "matrix_mul",matrix_mul; "matrix_neg",matrix_neg; "matrix_sub",matrix_sub; "matrix_vector_mul",matrix_vector_mul; "mball",mball; "mbasis",mbasis; "mbounded",mbounded; "mcball",mcball; "mcomplete",mcomplete; "mdist",mdist; "measurable",measurable; "measurable_on",measurable_on; "measure",measure; "metric_tybij",metric_tybij; "midpoint",midpoint; "minimal",minimal; "mk_pair_def",mk_pair_def; "monoidal",monoidal; "mspace",mspace; "msphere",msphere; "mtopology",mtopology; "mul_c",mul_c; "multivec",multivec; "multivector",multivector; "multivector_tybij",multivector_tybij; "multivector_tybij_th",multivector_tybij_th; "nadd_abs",nadd_abs; "nadd_add",nadd_add; "nadd_eq",nadd_eq; "nadd_inv",nadd_inv; "nadd_le",nadd_le; "nadd_mul",nadd_mul; "nadd_of_num",nadd_of_num; "nadd_rep",nadd_rep; "nadd_rinv",nadd_rinv; "negligible",negligible; "net_tybij",net_tybij; "netlimit",netlimit; "neutral",neutral; "nproduct",nproduct; "nsum",nsum; "num_Axiom",num_Axiom; "num_CASES",num_CASES; "num_FINITE",num_FINITE; "num_FINITE_AVOID",num_FINITE_AVOID; "num_INDUCTION",num_INDUCTION; "num_INFINITE",num_INFINITE; "num_INFINITE_EQ",num_INFINITE_EQ; "num_MAX",num_MAX; "num_RECURSION",num_RECURSION; "num_RECURSION_STD",num_RECURSION_STD; "num_WF",num_WF; "num_WOP",num_WOP; "num_congruent",num_congruent; "num_coprime",num_coprime; "num_divides",num_divides; "num_gcd",num_gcd; "num_mod",num_mod; "num_of_int",num_of_int; "numseg",numseg; "o_ASSOC",o_ASSOC; "o_DEF",o_DEF; "o_THM",o_THM; "one",one; "one_Axiom",one_Axiom; "one_DEF",one_DEF; "one_INDUCT",one_INDUCT; "one_RECURSION",one_RECURSION; "one_axiom",one_axiom; "one_tydef",one_tydef; "onorm",onorm; "open_def",open_def; "open_in",open_in; "open_interval",open_interval; "open_segment",open_segment; "operative",operative; "option_INDUCT",option_INDUCT; "option_RECURSION",option_RECURSION; "ordinal",ordinal; "orthogonal",orthogonal; "orthogonal_matrix",orthogonal_matrix; "orthogonal_transformation",orthogonal_transformation; "outer",outer; "outermorphism",outermorphism; "outside",outside; "pair_INDUCT",pair_INDUCT; "pair_RECURSION",pair_RECURSION; "pairwise",pairwise; "pastecart",pastecart; "path",path; "path_component",path_component; "path_connected",path_connected; "path_image",path_image; "path_length",path_length; "pathfinish",pathfinish; "pathstart",pathstart; "permutation",permutation; "permutes",permutes; "polyhedron",polyhedron; "polynomial_function",polynomial_function; "polytope",polytope; "poset",poset; "positive_definite",positive_definite; "positive_semidefinite",positive_semidefinite; "prod_tybij",prod_tybij; "product",product; "pushin",pushin; "rank",rank; "rational",rational; "real_INFINITE",real_INFINITE; "real_abs",real_abs; "real_add",real_add; "real_add_th",real_add_th; "real_div",real_div; "real_ge",real_ge; "real_gt",real_gt; "real_inv",real_inv; "real_inv_th",real_inv_th; "real_le",real_le; "real_le_th",real_le_th; "real_lt",real_lt; "real_max",real_max; "real_min",real_min; "real_mod",real_mod; "real_mul",real_mul; "real_mul_th",real_mul_th; "real_neg",real_neg; "real_neg_th",real_neg_th; "real_of_num",real_of_num; "real_of_num_th",real_of_num_th; "real_pow",real_pow; "real_sgn",real_sgn; "real_sub",real_sub; "rectifiable_path",rectifiable_path; "reflect_along",reflect_along; "relative_frontier",relative_frontier; "relative_interior",relative_interior; "relative_orientation",relative_orientation; "relative_to",relative_to; "retract_of",retract_of; "retraction",retraction; "reversepath",reversepath; "reversion",reversion; "rotation_matrix",rotation_matrix; "rotoinversion_matrix",rotoinversion_matrix; "row",row; "rows",rows; "rowvector",rowvector; "segment",segment; "seqiterate",seqiterate; "seqiterate_EXISTS",seqiterate_EXISTS; "sequentially",sequentially; "set_of_list",set_of_list; "set_variation",set_variation; "setcode",setcode; "setdist",setdist; "shiftpath",shiftpath; "sign",sign; "simple_path",simple_path; "simplex",simplex; "simplicial_complex",simplicial_complex; "simply_connected",simply_connected; "sindex",sindex; "sndcart",sndcart; "span",span; "sphere",sphere; "sqrt",sqrt; "starlike",starlike; "string_INFINITE",string_INFINITE; "submetric",submetric; "subpath",subpath; "subspace",subspace; "subtopology",subtopology; "sum",sum; "sum_CASES",sum_CASES; "sum_DISTINCT",sum_DISTINCT; "sum_INDUCT",sum_INDUCT; "sum_INJECTIVE",sum_INJECTIVE; "sum_RECURSION",sum_RECURSION; "summable",summable; "sums",sums; "sup",sup; "superadmissible",superadmissible; "support",support; "suslin",suslin; "suslin_operation",suslin_operation; "swap",swap; "swapseq_CASES",swapseq_CASES; "swapseq_INDUCT",swapseq_INDUCT; "swapseq_RULES",swapseq_RULES; "tagged_division_of",tagged_division_of; "tagged_partial_division_of",tagged_partial_division_of; "tailadmissible",tailadmissible; "tendsto",tendsto; "topcontinuous",topcontinuous; "topcontinuous_at",topcontinuous_at; "topology_tybij",topology_tybij; "topology_tybij_th",topology_tybij_th; "topspace",topspace; "toset",toset; "trace",trace; "transp",transp; "treal_add",treal_add; "treal_eq",treal_eq; "treal_inv",treal_inv; "treal_le",treal_le; "treal_mul",treal_mul; "treal_neg",treal_neg; "treal_of_num",treal_of_num; "triangulation",triangulation; "trivial_limit",trivial_limit; "uniformly_continuous_on",uniformly_continuous_on; "vec",vec; "vector",vector; "vector_add",vector_add; "vector_derivative",vector_derivative; "vector_matrix_mul",vector_matrix_mul; "vector_mul",vector_mul; "vector_neg",vector_neg; "vector_norm",vector_norm; "vector_sub",vector_sub; "vector_variation",vector_variation; "vertex_image",vertex_image; "vsum",vsum; "within",within; "woset",woset ];; hol-light/Multivariate/paths.ml000066400000000000000000052171771303454263000171100ustar00rootroot00000000000000(* ========================================================================= *) (* Paths, connectedness, homotopy, simple connectedness & contractibility. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Valentina Bruno 2010 *) (* ========================================================================= *) needs "Multivariate/convex.ml";; (* ------------------------------------------------------------------------- *) (* Paths and arcs. *) (* ------------------------------------------------------------------------- *) let path = new_definition `!g:real^1->real^N. path g <=> g continuous_on interval[vec 0,vec 1]`;; let pathstart = new_definition `pathstart (g:real^1->real^N) = g(vec 0)`;; let pathfinish = new_definition `pathfinish (g:real^1->real^N) = g(vec 1)`;; let path_image = new_definition `path_image (g:real^1->real^N) = IMAGE g (interval[vec 0,vec 1])`;; let reversepath = new_definition `reversepath (g:real^1->real^N) = \x. g(vec 1 - x)`;; let joinpaths = new_definition `(g1 ++ g2) = \x. if drop x <= &1 / &2 then g1(&2 % x) else g2(&2 % x - vec 1)`;; let simple_path = new_definition `simple_path (g:real^1->real^N) <=> path g /\ !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\ g x = g y ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0`;; let arc = new_definition `arc (g:real^1->real^N) <=> path g /\ !x y. x IN interval [vec 0,vec 1] /\ y IN interval [vec 0,vec 1] /\ g x = g y ==> x = y`;; (* ------------------------------------------------------------------------- *) (* Invariance theorems. *) (* ------------------------------------------------------------------------- *) let PATH_EQ = prove (`!p q. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ path p ==> path q`, REWRITE_TAC[path; CONTINUOUS_ON_EQ]);; let PATH_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N g. path g /\ f continuous_on path_image g ==> path(f o g)`, REWRITE_TAC[path; path_image; CONTINUOUS_ON_COMPOSE]);; let PATH_TRANSLATION_EQ = prove (`!a g:real^1->real^N. path((\x. a + x) o g) <=> path g`, REPEAT GEN_TAC THEN REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `(g:real^1->real^N) = (\x. --a + x) o (\x. a + x) o g` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; add_translation_invariants [PATH_TRANSLATION_EQ];; let PATH_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N g. linear f /\ (!x y. f x = f y ==> x = y) ==> (path(f o g) <=> path g)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `g:real^1->real^M = h o (f:real^M->real^N) o g` SUBST1_TAC THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]);; add_linear_invariants [PATH_LINEAR_IMAGE_EQ];; let PATHSTART_TRANSLATION = prove (`!a g. pathstart((\x. a + x) o g) = a + pathstart g`, REWRITE_TAC[pathstart; o_THM]);; add_translation_invariants [PATHSTART_TRANSLATION];; let PATHSTART_LINEAR_IMAGE_EQ = prove (`!f g. linear f ==> pathstart(f o g) = f(pathstart g)`, REWRITE_TAC[pathstart; o_THM]);; add_linear_invariants [PATHSTART_LINEAR_IMAGE_EQ];; let PATHFINISH_TRANSLATION = prove (`!a g. pathfinish((\x. a + x) o g) = a + pathfinish g`, REWRITE_TAC[pathfinish; o_THM]);; add_translation_invariants [PATHFINISH_TRANSLATION];; let PATHFINISH_LINEAR_IMAGE = prove (`!f g. linear f ==> pathfinish(f o g) = f(pathfinish g)`, REWRITE_TAC[pathfinish; o_THM]);; add_linear_invariants [PATHFINISH_LINEAR_IMAGE];; let PATH_IMAGE_TRANSLATION = prove (`!a g. path_image((\x. a + x) o g) = IMAGE (\x. a + x) (path_image g)`, REWRITE_TAC[path_image; IMAGE_o]);; add_translation_invariants [PATH_IMAGE_TRANSLATION];; let PATH_IMAGE_LINEAR_IMAGE = prove (`!f g. linear f ==> path_image(f o g) = IMAGE f (path_image g)`, REWRITE_TAC[path_image; IMAGE_o]);; add_linear_invariants [PATH_IMAGE_LINEAR_IMAGE];; let REVERSEPATH_TRANSLATION = prove (`!a g. reversepath((\x. a + x) o g) = (\x. a + x) o reversepath g`, REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);; add_translation_invariants [REVERSEPATH_TRANSLATION];; let REVERSEPATH_LINEAR_IMAGE = prove (`!f g. linear f ==> reversepath(f o g) = f o reversepath g`, REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);; add_linear_invariants [REVERSEPATH_LINEAR_IMAGE];; let JOINPATHS_TRANSLATION = prove (`!a:real^N g1 g2. ((\x. a + x) o g1) ++ ((\x. a + x) o g2) = (\x. a + x) o (g1 ++ g2)`, REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);; add_translation_invariants [JOINPATHS_TRANSLATION];; let JOINPATHS_LINEAR_IMAGE = prove (`!f g1 g2. linear f ==> (f o g1) ++ (f o g2) = f o (g1 ++ g2)`, REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);; add_linear_invariants [JOINPATHS_LINEAR_IMAGE];; let SIMPLE_PATH_TRANSLATION_EQ = prove (`!a g:real^1->real^N. simple_path((\x. a + x) o g) <=> simple_path g`, REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);; add_translation_invariants [SIMPLE_PATH_TRANSLATION_EQ];; let SIMPLE_PATH_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N g. linear f /\ (!x y. f x = f y ==> x = y) ==> (simple_path(f o g) <=> simple_path g)`, REPEAT STRIP_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; add_linear_invariants [SIMPLE_PATH_LINEAR_IMAGE_EQ];; let ARC_TRANSLATION_EQ = prove (`!a g:real^1->real^N. arc((\x. a + x) o g) <=> arc g`, REPEAT GEN_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);; add_translation_invariants [ARC_TRANSLATION_EQ];; let ARC_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N g. linear f /\ (!x y. f x = f y ==> x = y) ==> (arc(f o g) <=> arc g)`, REPEAT STRIP_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; add_linear_invariants [ARC_LINEAR_IMAGE_EQ];; let SIMPLE_PATH_CONTINUOUS_IMAGE = prove (`!f g. simple_path g /\ f continuous_on path_image g /\ (!x y. x IN path_image g /\ y IN path_image g /\ f x = f y ==> x = y) ==> simple_path(f o g)`, REWRITE_TAC[simple_path; INJECTIVE_ON_ALT] THEN SIMP_TAC[PATH_CONTINUOUS_IMAGE] THEN REWRITE_TAC[path_image; o_THM] THEN SET_TAC[]);; let ARC_CONTINUOUS_IMAGE = prove (`!f g:real^1->real^N. arc g /\ f continuous_on path_image g /\ (!x y. x IN path_image g /\ y IN path_image g /\ f x = f y ==> x = y) ==> arc(f o g)`, REWRITE_TAC[arc; INJECTIVE_ON_ALT] THEN SIMP_TAC[PATH_CONTINUOUS_IMAGE] THEN REWRITE_TAC[path_image; o_THM] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Basic lemmas about paths. *) (* ------------------------------------------------------------------------- *) let ARC_IMP_SIMPLE_PATH = prove (`!g. arc g ==> simple_path g`, REWRITE_TAC[arc; simple_path] THEN MESON_TAC[]);; let ARC_IMP_PATH = prove (`!g. arc g ==> path g`, REWRITE_TAC[arc] THEN MESON_TAC[]);; let SIMPLE_PATH_IMP_PATH = prove (`!g. simple_path g ==> path g`, REWRITE_TAC[simple_path] THEN MESON_TAC[]);; let SIMPLE_PATH_CASES = prove (`!g:real^1->real^N. simple_path g ==> arc g \/ pathfinish g = pathstart g`, REWRITE_TAC[simple_path; arc; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(g:real^1->real^N) (vec 0) = g(vec 1)` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`]) THEN ASM_MESON_TAC[]);; let SIMPLE_PATH_IMP_ARC = prove (`!g:real^1->real^N. simple_path g /\ ~(pathfinish g = pathstart g) ==> arc g`, MESON_TAC[SIMPLE_PATH_CASES]);; let ARC_DISTINCT_ENDS = prove (`!g:real^1->real^N. arc g ==> ~(pathfinish g = pathstart g)`, GEN_TAC THEN REWRITE_TAC[arc; pathfinish; pathstart] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b /\ ~d ==> ~c`] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ARC_SIMPLE_PATH = prove (`!g:real^1->real^N. arc g <=> simple_path g /\ ~(pathfinish g = pathstart g)`, MESON_TAC[SIMPLE_PATH_CASES; ARC_IMP_SIMPLE_PATH; ARC_DISTINCT_ENDS]);; let SIMPLE_PATH_EQ_ARC = prove (`!g. ~(pathstart g = pathfinish g) ==> (simple_path g <=> arc g)`, SIMP_TAC[ARC_SIMPLE_PATH]);; let PATH_IMAGE_NONEMPTY = prove (`!g. ~(path_image g = {})`, REWRITE_TAC[path_image; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY] THEN SIMP_TAC[DIMINDEX_1; CONJ_ASSOC; LE_ANTISYM; UNWIND_THM1; VEC_COMPONENT; ARITH; REAL_OF_NUM_LT]);; let PATHSTART_IN_PATH_IMAGE = prove (`!g. (pathstart g) IN path_image g`, GEN_TAC THEN REWRITE_TAC[pathstart; path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS]);; let PATHFINISH_IN_PATH_IMAGE = prove (`!g. (pathfinish g) IN path_image g`, GEN_TAC THEN REWRITE_TAC[pathfinish; path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC);; let CONNECTED_PATH_IMAGE = prove (`!g. path g ==> connected(path_image g)`, REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERVAL]);; let COMPACT_PATH_IMAGE = prove (`!g. path g ==> compact(path_image g)`, REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_INTERVAL]);; let BOUNDED_PATH_IMAGE = prove (`!g. path g ==> bounded(path_image g)`, MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_BOUNDED]);; let CLOSED_PATH_IMAGE = prove (`!g. path g ==> closed(path_image g)`, MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED]);; let CONNECTED_SIMPLE_PATH_IMAGE = prove (`!g. simple_path g ==> connected(path_image g)`, MESON_TAC[CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; let COMPACT_SIMPLE_PATH_IMAGE = prove (`!g. simple_path g ==> compact(path_image g)`, MESON_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; let BOUNDED_SIMPLE_PATH_IMAGE = prove (`!g. simple_path g ==> bounded(path_image g)`, MESON_TAC[BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; let CLOSED_SIMPLE_PATH_IMAGE = prove (`!g. simple_path g ==> closed(path_image g)`, MESON_TAC[CLOSED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; let CONNECTED_ARC_IMAGE = prove (`!g. arc g ==> connected(path_image g)`, MESON_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH]);; let COMPACT_ARC_IMAGE = prove (`!g. arc g ==> compact(path_image g)`, MESON_TAC[COMPACT_PATH_IMAGE; ARC_IMP_PATH]);; let BOUNDED_ARC_IMAGE = prove (`!g. arc g ==> bounded(path_image g)`, MESON_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH]);; let CLOSED_ARC_IMAGE = prove (`!g. arc g ==> closed(path_image g)`, MESON_TAC[CLOSED_PATH_IMAGE; ARC_IMP_PATH]);; let PATHSTART_COMPOSE = prove (`!f p. pathstart(f o p) = f(pathstart p)`, REWRITE_TAC[pathstart; o_THM]);; let PATHFINISH_COMPOSE = prove (`!f p. pathfinish(f o p) = f(pathfinish p)`, REWRITE_TAC[pathfinish; o_THM]);; let PATH_IMAGE_COMPOSE = prove (`!f p. path_image (f o p) = IMAGE f (path_image p)`, REWRITE_TAC[path_image; IMAGE_o]);; let PATH_COMPOSE_JOIN = prove (`!f p q. f o (p ++ q) = (f o p) ++ (f o q)`, REWRITE_TAC[joinpaths; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);; let PATH_COMPOSE_REVERSEPATH = prove (`!f p. f o reversepath p = reversepath(f o p)`, REWRITE_TAC[reversepath; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);; let JOIN_PATHS_EQ = prove (`!p q:real^1->real^N. (!t. t IN interval[vec 0,vec 1] ==> p t = p' t) /\ (!t. t IN interval[vec 0,vec 1] ==> q t = q' t) ==> !t. t IN interval[vec 0,vec 1] ==> (p ++ q) t = (p' ++ q') t`, REWRITE_TAC[joinpaths; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC);; let CARD_EQ_SIMPLE_PATH_IMAGE = prove (`!g. simple_path g ==> path_image g =_c (:real)`, SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SIMPLE_PATH_IMAGE] THEN GEN_TAC THEN REWRITE_TAC[simple_path; path_image] THEN MATCH_MP_TAC(SET_RULE `(?u v. u IN s /\ v IN s /\ ~(u = a) /\ ~(v = a) /\ ~(u = v)) ==> P /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a) ==> ~(?c. IMAGE f s SUBSET {c})`) THEN MAP_EVERY EXISTS_TAC [`lift(&1 / &3)`; `lift(&1 / &2)`] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let INFINITE_SIMPLE_PATH_IMAGE = prove (`!g. simple_path g ==> INFINITE(path_image g)`, MESON_TAC[CARD_EQ_SIMPLE_PATH_IMAGE; INFINITE; FINITE_IMP_COUNTABLE; UNCOUNTABLE_REAL; CARD_COUNTABLE_CONG]);; let CARD_EQ_ARC_IMAGE = prove (`!g. arc g ==> path_image g =_c (:real)`, MESON_TAC[ARC_IMP_SIMPLE_PATH; CARD_EQ_SIMPLE_PATH_IMAGE]);; let INFINITE_ARC_IMAGE = prove (`!g. arc g ==> INFINITE(path_image g)`, MESON_TAC[ARC_IMP_SIMPLE_PATH; INFINITE_SIMPLE_PATH_IMAGE]);; (* ------------------------------------------------------------------------- *) (* The operations on paths. *) (* ------------------------------------------------------------------------- *) let JOINPATHS = prove (`!g1 g2. pathfinish g1 = pathstart g2 ==> g1 ++ g2 = \x. if drop x < &1 / &2 then g1(&2 % x) else g2 (&2 % x - vec 1)`, REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `drop x = &1 / &2` THENL [FIRST_X_ASSUM(MP_TAC o AP_TERM `lift`) THEN REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_CMUL; REAL_LT_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL]; REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC]);; let REVERSEPATH_REVERSEPATH = prove (`!g:real^1->real^N. reversepath(reversepath g) = g`, REWRITE_TAC[reversepath; ETA_AX; VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);; let PATHSTART_REVERSEPATH = prove (`pathstart(reversepath g) = pathfinish g`, REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_RZERO]);; let PATHFINISH_REVERSEPATH = prove (`pathfinish(reversepath g) = pathstart g`, REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_REFL]);; let PATHSTART_JOIN = prove (`!g1 g2. pathstart(g1 ++ g2) = pathstart g1`, REWRITE_TAC[joinpaths; pathstart; pathstart; DROP_VEC; VECTOR_MUL_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let PATHFINISH_JOIN = prove (`!g1 g2. pathfinish(g1 ++ g2) = pathfinish g2`, REPEAT GEN_TAC THEN REWRITE_TAC[joinpaths; pathfinish; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; let PATH_IMAGE_REVERSEPATH = prove (`!g:real^1->real^N. path_image(reversepath g) = path_image g`, SUBGOAL_THEN `!g:real^1->real^N. path_image(reversepath g) SUBSET path_image g` (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH; SUBSET_ANTISYM]) THEN REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^N`; `x:real^1`] THEN DISCH_TAC THEN REWRITE_TAC[reversepath; IN_IMAGE] THEN EXISTS_TAC `vec 1 - x:real^1` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; let PATH_REVERSEPATH = prove (`!g:real^1->real^N. path(reversepath g) <=> path g`, SUBGOAL_THEN `!g:real^1->real^N. path g ==> path(reversepath g)` (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN GEN_TAC THEN REWRITE_TAC[path; reversepath] THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_VEC; DROP_SUB] THEN REAL_ARITH_TAC);; let PATH_JOIN = prove (`!g1 g2:real^1->real^N. pathfinish g1 = pathstart g2 ==> (path(g1 ++ g2) <=> path g1 /\ path g2)`, REWRITE_TAC[path; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [STRIP_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `(g1:real^1->real^N) = (\x. g1 (&2 % x)) o (\x. &1 / &2 % x)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN SIMP_TAC[DROP_VEC; REAL_ARITH `&1 / &2 * x <= &1 / &2 <=> x <= &1`]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC; SUBGOAL_THEN `(g2:real^1->real^N) = (\x. g2 (&2 % x - vec 1)) o (\x. &1 / &2 % (x + vec 1))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN REWRITE_TAC[DROP_VEC; DROP_ADD; REAL_ARITH `&1 / &2 * (x + &1) <= &1 / &2 <=> x <= &0`] THEN SIMP_TAC[REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`; LIFT_NUM; VECTOR_MUL_ASSOC; GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LID] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `(x + vec 1) - vec 1 = x`]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN REWRITE_TAC[DROP_VEC; DROP_ADD] THEN REAL_ARITH_TAC]; STRIP_TAC THEN SUBGOAL_THEN `interval[vec 0,vec 1] = interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]` SUBST1_TAC THENL [SIMP_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `\x. (g1:real^1->real^N) (&2 % x)`; EXISTS_TAC `\x. (g2:real^1->real^N) (&2 % x - vec 1)`] THEN REWRITE_TAC[joinpaths] THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP] THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % (x:real^1) = &2 % x + vec 0`] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM]; ALL_TAC] THEN CONJ_TAC THENL [SIMP_TAC[REAL_ARITH `&1 / &2 <= x ==> (x <= &1 / &2 <=> x = &1 / &2)`; GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[LIFT_NUM] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x - vec 1 = &2 % x + --vec 1`] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM] THEN ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x + --x = x /\ x + --x = vec 0`]]);; let PATH_JOIN_IMP = prove (`!g1 g2:real^1->real^N. path g1 /\ path g2 /\ pathfinish g1 = pathstart g2 ==> path(g1 ++ g2)`, MESON_TAC[PATH_JOIN]);; let PATH_IMAGE_JOIN_SUBSET = prove (`!g1 g2:real^1->real^N. path_image(g1 ++ g2) SUBSET (path_image g1 UNION path_image g2)`, REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; IN_UNION; IN_IMAGE; DROP_VEC; joinpaths] THEN STRIP_TAC THEN ASM_CASES_TAC `drop x <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL [DISJ1_TAC THEN EXISTS_TAC `&2 % x:real^1` THEN REWRITE_TAC[DROP_CMUL]; DISJ2_TAC THEN EXISTS_TAC `&2 % x - vec 1:real^1` THEN REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC]] THEN ASM_REAL_ARITH_TAC);; let SUBSET_PATH_IMAGE_JOIN = prove (`!g1 g2:real^1->real^N s. path_image g1 SUBSET s /\ path_image g2 SUBSET s ==> path_image(g1 ++ g2) SUBSET s`, MP_TAC PATH_IMAGE_JOIN_SUBSET THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN SET_TAC[]);; let PATH_IMAGE_JOIN = prove (`!g1 g2. pathfinish g1 = pathstart g2 ==> path_image(g1 ++ g2) = path_image g1 UNION path_image g2`, REWRITE_TAC[pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[PATH_IMAGE_JOIN_SUBSET] THEN REWRITE_TAC[path_image; SUBSET; FORALL_AND_THM; IN_UNION; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN REWRITE_TAC[FORALL_IN_IMAGE; joinpaths] THEN REWRITE_TAC[IN_INTERVAL_1; IN_IMAGE; DROP_VEC] THEN CONJ_TAC THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THENL [EXISTS_TAC `(&1 / &2) % x:real^1` THEN ASM_REWRITE_TAC[DROP_CMUL; REAL_ARITH `&1 / &2 * x <= &1 / &2 <=> x <= &1`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_LID]; EXISTS_TAC `(&1 / &2) % (x + vec 1):real^1` THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; DROP_VEC] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(x + vec 1) - vec 1 = x`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&1 / &2 * (x + &1) <= &1 / &2 <=> x = &0)`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; DROP_VEC]] THEN ASM_REAL_ARITH_TAC);; let NOT_IN_PATH_IMAGE_JOIN = prove (`!g1 g2 x. ~(x IN path_image g1) /\ ~(x IN path_image g2) ==> ~(x IN path_image(g1 ++ g2))`, MESON_TAC[PATH_IMAGE_JOIN_SUBSET; SUBSET; IN_UNION]);; let ARC_REVERSEPATH = prove (`!g. arc g ==> arc(reversepath g)`, GEN_TAC THEN SIMP_TAC[arc; PATH_REVERSEPATH] THEN REWRITE_TAC[arc; reversepath] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; let ARC_REVERSEPATH_EQ = prove (`!g:real^1->real^N. arc(reversepath g) <=> arc g`, MESON_TAC[ARC_REVERSEPATH; REVERSEPATH_REVERSEPATH]);; let SIMPLE_PATH_REVERSEPATH = prove (`!g. simple_path g ==> simple_path (reversepath g)`, GEN_TAC THEN SIMP_TAC[simple_path; PATH_REVERSEPATH] THEN REWRITE_TAC[simple_path; reversepath] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; let SIMPLE_PATH_REVERSEPATH_EQ = prove (`!g:real^1->real^N. simple_path(reversepath g) <=> simple_path g`, MESON_TAC[SIMPLE_PATH_REVERSEPATH; REVERSEPATH_REVERSEPATH]);; let SIMPLE_PATH_JOIN_LOOP = prove (`!g1 g2:real^1->real^N. arc g1 /\ arc g2 /\ pathfinish g1 = pathstart g2 /\ pathfinish g2 = pathstart g1 /\ (path_image g1 INTER path_image g2) SUBSET {pathstart g1,pathstart g2} ==> simple_path(g1 ++ g2)`, REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c /\ d ==> f) /\ (a' /\ b' /\ c /\ d /\ e ==> g) ==> (a /\ a') /\ (b /\ b') /\ c /\ d /\ e ==> f /\ g`) THEN CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart; pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC; ALL_TAC; ASM_REAL_ARITH_TAC; REMOVE_THEN "G2" (MP_TAC o SPECL [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC] THEN REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % y:real^1 - vec 1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN STRIP_TAC THENL [DISJ2_TAC THEN DISJ1_TAC; DISJ1_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&1 / &2 % vec 1:real^1`] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [SUBGOAL_THEN `&2 % x:real^1 = vec 0` MP_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN REMOVE_THEN "G1" MATCH_MP_TAC; DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_RZERO]) THEN UNDISCH_TAC `T` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 1` MP_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN REMOVE_THEN "G2" MATCH_MP_TAC; SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN REMOVE_THEN "G1" MATCH_MP_TAC; DISCH_THEN SUBST_ALL_TAC THEN SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN REMOVE_THEN "G2" MATCH_MP_TAC] THEN (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC));; let ARC_JOIN = prove (`!g1 g2:real^1->real^N. arc g1 /\ arc g2 /\ pathfinish g1 = pathstart g2 /\ (path_image g1 INTER path_image g2) SUBSET {pathstart g2} ==> arc(g1 ++ g2)`, REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c /\ d ==> f) /\ (a' /\ b' /\ c /\ d ==> g) ==> (a /\ a') /\ (b /\ b') /\ c /\ d ==> f /\ g`) THEN CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart; pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN VECTOR_ARITH_TAC; ALL_TAC; ASM_REAL_ARITH_TAC; REMOVE_THEN "G2" (MP_TAC o SPECL [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN VECTOR_ARITH_TAC] THEN REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % y:real^1 - vec 1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `x:real^1 = &1 / &2 % vec 1` SUBST_ALL_TAC THENL [SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN REMOVE_THEN "G1" MATCH_MP_TAC; SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN REMOVE_THEN "G2" MATCH_MP_TAC] THEN (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC));; let REVERSEPATH_JOINPATHS = prove (`!g1 g2. pathfinish g1 = pathstart g2 ==> reversepath(g1 ++ g2) = reversepath g2 ++ reversepath g1`, REPEAT GEN_TAC THEN REWRITE_TAC[reversepath; joinpaths; pathfinish; pathstart; FUN_EQ_THM] THEN DISCH_TAC THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[DROP_VEC; DROP_SUB; REAL_ARITH `&1 - x <= &1 / &2 <=> &1 / &2 <= x`] THEN ASM_CASES_TAC `t = lift(&1 / &2)` THENL [ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_NUM; GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DROP_EQ]) THEN REWRITE_TAC[LIFT_DROP] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_ARITH `~(x = &1 / &2) ==> (&1 / &2 <= x <=> ~(x <= &1 / &2))`] THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN VECTOR_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Some reversed and "if and only if" versions of joining theorems. *) (* ------------------------------------------------------------------------- *) let PATH_JOIN_PATH_ENDS = prove (`!g1 g2:real^1->real^N. path g2 /\ path(g1 ++ g2) ==> pathfinish g1 = pathstart g2`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(NORM_ARITH `pathfinish g1:real^N = pathstart g2 \/ &0 < dist(pathfinish g1,pathstart g2)`) THEN ASM_REWRITE_TAC[path; continuous_on; joinpaths] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN REWRITE_TAC[pathstart; pathfinish] THEN ABBREV_TAC `e = dist((g1:real^1->real^N)(vec 1),g2(vec 0:real^1))` THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `vec 0:real^1`) (MP_TAC o SPEC `lift(&1 / &2)`)) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; LIFT_DROP; REAL_LE_REFL] THEN REWRITE_TAC[GSYM LIFT_CMUL; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN REMOVE_THEN "2" (MP_TAC o SPEC `lift(min (&1 / &2) (min d1 d2) / &2)`) THEN REWRITE_TAC[LIFT_DROP; DIST_LIFT; DIST_0; NORM_REAL; GSYM drop] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "1" (MP_TAC o SPEC `lift(&1 / &2 + min (&1 / &2) (min d1 d2) / &4)`) THEN REWRITE_TAC[LIFT_DROP; DIST_LIFT] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM LIFT_CMUL; LIFT_ADD; REAL_ADD_LDISTRIB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN REWRITE_TAC[VECTOR_ADD_SUB; REAL_ARITH `&2 * x / &4 = x / &2`] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let PATH_JOIN_EQ = prove (`!g1 g2:real^1->real^N. path g1 /\ path g2 ==> (path(g1 ++ g2) <=> pathfinish g1 = pathstart g2)`, MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_JOIN_IMP]);; let SIMPLE_PATH_JOIN_IMP = prove (`!g1 g2:real^1->real^N. simple_path(g1 ++ g2) /\ pathfinish g1 = pathstart g2 ==> arc g1 /\ arc g2 /\ path_image g1 INTER path_image g2 SUBSET {pathstart g1, pathstart g2}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `path(g1:real^1->real^N) /\ path(g2:real^1->real^N)` THENL [ALL_TAC; ASM_MESON_TAC[PATH_JOIN; SIMPLE_PATH_IMP_PATH]] THEN REWRITE_TAC[simple_path; pathstart; pathfinish; arc] THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&1 / &2 % x:real^1`; `&1 / &2 % y:real^1`]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; joinpaths; DROP_CMUL] THEN REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC] THEN ASM_REAL_ARITH_TAC; MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&1 / &2 % (x + vec 1):real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_CMUL] THEN REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(a + b) - b:real^N = a`] THEN ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC; DROP_ADD] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SET_RULE `s INTER t SUBSET u <=> !x. x IN s ==> x IN t ==> x IN u`] THEN REWRITE_TAC[path_image; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN SUBST1_TAC(SYM(ASSUME `(g1:real^1->real^N)(vec 1) = g2(vec 0:real^1)`)) THEN MATCH_MP_TAC(SET_RULE `x = a \/ x = b ==> f x IN {f a,f b}`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&1 / &2 % x:real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_ADD] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [joinpaths] THEN ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_VEC] THEN REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN REWRITE_TAC[VECTOR_ARITH `&2 % &1 / &2 % x:real^N = x`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `(a + b) - b:real^N = a`]; REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_VEC] THEN ASM_REAL_ARITH_TAC]]);; let SIMPLE_PATH_JOIN_LOOP_EQ = prove (`!g1 g2:real^1->real^N. pathfinish g2 = pathstart g1 /\ pathfinish g1 = pathstart g2 ==> (simple_path(g1 ++ g2) <=> arc g1 /\ arc g2 /\ path_image g1 INTER path_image g2 SUBSET {pathstart g1, pathstart g2})`, MESON_TAC[SIMPLE_PATH_JOIN_IMP; SIMPLE_PATH_JOIN_LOOP]);; let SIMPLE_PATH_JOIN_LOOP_EQ_ALT = prove (`!g1 g2:real^1->real^N. pathfinish g2 = pathstart g1 /\ pathfinish g1 = pathstart g2 ==> (simple_path(g1 ++ g2) <=> arc g1 /\ arc g2 /\ path_image g1 INTER path_image g2 = {pathstart g1, pathstart g2})`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s ==> (s SUBSET {a,b} <=> s = {a,b})`) THEN REWRITE_TAC[IN_INTER] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]);; let ARC_JOIN_EQ = prove (`!g1 g2:real^1->real^N. pathfinish g1 = pathstart g2 ==> (arc(g1 ++ g2) <=> arc g1 /\ arc g2 /\ path_image g1 INTER path_image g2 SUBSET {pathstart g2})`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ARC_JOIN] THEN GEN_REWRITE_TAC LAND_CONV [ARC_SIMPLE_PATH] THEN REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN] THEN STRIP_TAC THEN MP_TAC(ISPECL [`g1:real^1->real^N`; `g2:real^1->real^N`] SIMPLE_PATH_JOIN_IMP) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~((pathstart g1:real^N) IN path_image g2)` (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN REWRITE_TAC[path_image; IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `lift(&1 / &2) + inv(&2) % u`] o CONJUNCT2) THEN REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_CMUL; LIFT_DROP; joinpaths] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_IMP_NZ; REAL_ARITH `&0 <= x ==> &0 < &1 / &2 + &1 / &2 * x`] THEN REWRITE_TAC[REAL_ARITH `&1 / &2 + &1 / &2 * u = &1 <=> u = &1`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= u ==> (&1 / &2 + &1 / &2 * u <= &1 / &2 <=> u = &0)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_ARITH `u <= &1 ==> &1 / &2 + &1 / &2 * u <= &1`] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN ASM_REWRITE_TAC[VEC_EQ] THEN ARITH_TAC; REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM LIFT_CMUL] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM; VECTOR_MUL_LID; VECTOR_ADD_SUB] THEN ASM_MESON_TAC[]]);; let ARC_JOIN_EQ_ALT = prove (`!g1 g2:real^1->real^N. pathfinish g1 = pathstart g2 ==> (arc(g1 ++ g2) <=> arc g1 /\ arc g2 /\ path_image g1 INTER path_image g2 = {pathstart g2})`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARC_JOIN_EQ] THEN MP_TAC(ISPEC `g1:real^1->real^N` PATHFINISH_IN_PATH_IMAGE) THEN MP_TAC(ISPEC `g2:real^1->real^N` PATHSTART_IN_PATH_IMAGE) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Reassociating a joined path doesn't matter for various properties. *) (* ------------------------------------------------------------------------- *) let PATH_ASSOC = prove (`!p q r:real^1->real^N. pathfinish p = pathstart q /\ pathfinish q = pathstart r ==> (path(p ++ (q ++ r)) <=> path((p ++ q) ++ r))`, SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN CONV_TAC TAUT);; let SIMPLE_PATH_ASSOC = prove (`!p q r:real^1->real^N. pathfinish p = pathstart q /\ pathfinish q = pathstart r ==> (simple_path(p ++ (q ++ r)) <=> simple_path((p ++ q) ++ r))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `pathstart(p:real^1->real^N) = pathfinish r` THENL [ALL_TAC; ASM_SIMP_TAC[SIMPLE_PATH_EQ_ARC; PATHSTART_JOIN; PATHFINISH_JOIN]] THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; ARC_JOIN_EQ; PATH_IMAGE_JOIN] THEN MAP_EVERY ASM_CASES_TAC [`arc(p:real^1->real^N)`; `arc(q:real^1->real^N)`; `arc(r:real^1->real^N)`] THEN ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET; ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS)) THEN MAP_EVERY (fun t -> MP_TAC(ISPEC t PATHSTART_IN_PATH_IMAGE) THEN MP_TAC(ISPEC t PATHFINISH_IN_PATH_IMAGE)) [`p:real^1->real^N`; `q:real^1->real^N`; `r:real^1->real^N`] THEN ASM SET_TAC[]);; let ARC_ASSOC = prove (`!p q r:real^1->real^N. pathfinish p = pathstart q /\ pathfinish q = pathstart r ==> (arc(p ++ (q ++ r)) <=> arc((p ++ q) ++ r))`, SIMP_TAC[ARC_SIMPLE_PATH; SIMPLE_PATH_ASSOC] THEN SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN]);; (* ------------------------------------------------------------------------- *) (* In the case of a loop, neither does symmetry. *) (* ------------------------------------------------------------------------- *) let PATH_SYM = prove (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p ==> (path(p ++ q) <=> path(q ++ p))`, SIMP_TAC[PATH_JOIN; CONJ_ACI]);; let SIMPLE_PATH_SYM = prove (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p ==> (simple_path(p ++ q) <=> simple_path(q ++ p))`, SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; INTER_ACI; CONJ_ACI; INSERT_AC]);; let PATH_IMAGE_SYM = prove (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p ==> path_image(p ++ q) = path_image(q ++ p)`, SIMP_TAC[PATH_IMAGE_JOIN; UNION_ACI]);; (* ------------------------------------------------------------------------- *) (* Reparametrizing a closed curve to start at some chosen point. *) (* ------------------------------------------------------------------------- *) let shiftpath = new_definition `shiftpath a (f:real^1->real^N) = \x. if drop(a + x) <= &1 then f(a + x) else f(a + x - vec 1)`;; let SHIFTPATH_TRANSLATION = prove (`!a t g. shiftpath t ((\x. a + x) o g) = (\x. a + x) o shiftpath t g`, REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);; add_translation_invariants [SHIFTPATH_TRANSLATION];; let SHIFTPATH_LINEAR_IMAGE = prove (`!f t g. linear f ==> shiftpath t (f o g) = f o shiftpath t g`, REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);; add_linear_invariants [SHIFTPATH_LINEAR_IMAGE];; let PATHSTART_SHIFTPATH = prove (`!a g. drop a <= &1 ==> pathstart(shiftpath a g) = g(a)`, SIMP_TAC[pathstart; shiftpath; VECTOR_ADD_RID]);; let PATHFINISH_SHIFTPATH = prove (`!a g. &0 <= drop a /\ pathfinish g = pathstart g ==> pathfinish(shiftpath a g) = g(a)`, SIMP_TAC[pathfinish; shiftpath; pathstart; DROP_ADD; DROP_VEC] THEN REWRITE_TAC[VECTOR_ARITH `a + vec 1 - vec 1 = a`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x + &1 <= &1 <=> x = &0)`] THEN SIMP_TAC[DROP_EQ_0; VECTOR_ADD_LID] THEN MESON_TAC[]);; let ENDPOINTS_SHIFTPATH = prove (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> pathfinish(shiftpath a g) = g a /\ pathstart(shiftpath a g) = g a`, SIMP_TAC[IN_INTERVAL_1; DROP_VEC; PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]);; let CLOSED_SHIFTPATH = prove (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> pathfinish(shiftpath a g) = pathstart(shiftpath a g)`, SIMP_TAC[IN_INTERVAL_1; PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH; DROP_VEC]);; let PATH_SHIFTPATH = prove (`!g a. path g /\ pathfinish g:real^N = pathstart g /\ a IN interval[vec 0,vec 1] ==> path(shiftpath a g)`, REWRITE_TAC[shiftpath; path] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `interval[vec 0,vec 1] = interval[vec 0,vec 1 - a:real^1] UNION interval[vec 1 - a,vec 1]` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `(\x. g(a + x)):real^1->real^N` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN SIMP_TAC[REAL_ARITH `a + x <= &1 <=> x <= &1 - a`]; EXISTS_TAC `(\x. g(a + x - vec 1)):real^1->real^N` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN SIMP_TAC[REAL_ARITH `&1 - a <= x ==> (a + x <= &1 <=> a + x = &1)`] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VECTOR_ARITH `a + x - vec 1 = (a + x) - vec 1`] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_NUM; LIFT_DROP] THEN REWRITE_TAC[VECTOR_SUB_REFL; COND_ID]] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; CONTINUOUS_ON_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_ADD] THEN REAL_ARITH_TAC);; let SHIFTPATH_SHIFTPATH = prove (`!g a x. a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g /\ x IN interval[vec 0,vec 1] ==> shiftpath (vec 1 - a) (shiftpath a g) x = g x`, REWRITE_TAC[shiftpath; pathfinish; pathstart] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REWRITE_TAC[DROP_VEC] THEN REPEAT STRIP_TAC THENL [ALL_TAC; AP_TERM_TAC THEN VECTOR_ARITH_TAC; AP_TERM_TAC THEN VECTOR_ARITH_TAC; ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `x:real^1 = vec 0` SUBST1_TAC THENL [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a + vec 0:real^1 = vec 1`]]);; let PATH_IMAGE_SHIFTPATH = prove (`!a g:real^1->real^N. a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g ==> path_image(shiftpath a g) = path_image g`, REWRITE_TAC[IN_INTERVAL_1; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN REWRITE_TAC[path_image; shiftpath; FORALL_IN_IMAGE; SUBSET] THEN REWRITE_TAC[IN_IMAGE] THEN REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_IMAGE] THENL [EXISTS_TAC `a + x:real^1`; EXISTS_TAC `a + x - vec 1:real^1`; ALL_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_ADD] THEN TRY REAL_ARITH_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `drop a <= drop x` THENL [EXISTS_TAC `x - a:real^1` THEN REWRITE_TAC[VECTOR_ARITH `a + x - a:real^1 = x`; DROP_SUB] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `vec 1 + x - a:real^1` THEN REWRITE_TAC[VECTOR_ARITH `a + (v + x - a) - v:real^1 = x`] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN ASM_CASES_TAC `x:real^1 = vec 0` THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + v + x - a:real^1 = v + x`] THEN ASM_REWRITE_TAC[VECTOR_ADD_RID; DROP_VEC; COND_ID] THEN ASM_REWRITE_TAC[REAL_ARITH `a + &1 + x - a <= &1 <=> x <= &0`] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN TRY(COND_CASES_TAC THEN POP_ASSUM MP_TAC) THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]);; let SIMPLE_PATH_SHIFTPATH = prove (`!g a. simple_path g /\ pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] ==> simple_path(shiftpath a g)`, REPEAT GEN_TAC THEN REWRITE_TAC[simple_path] THEN MATCH_MP_TAC(TAUT `(a /\ c /\ d ==> e) /\ (b /\ c /\ d ==> f) ==> (a /\ b) /\ c /\ d ==> e /\ f`) THEN CONJ_TAC THENL [MESON_TAC[PATH_SHIFTPATH]; ALL_TAC] THEN REWRITE_TAC[simple_path; shiftpath; IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_SUB] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN STRIP_TAC THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; GSYM DROP_EQ] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Choosing a sub-path of an existing path. *) (* ------------------------------------------------------------------------- *) let subpath = new_definition `subpath u v g = \x. g(u + drop(v - u) % x)`;; let SUBPATH_SCALING_LEMMA = prove (`!u v. IMAGE (\x. u + drop(v - u) % x) (interval[vec 0,vec 1]) = segment[u,v]`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; SEGMENT_1] THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO] THEN REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN VECTOR_ARITH_TAC);; let PATH_IMAGE_SUBPATH_GEN = prove (`!u v g:real^1->real^N. path_image(subpath u v g) = IMAGE g (segment[u,v])`, REPEAT GEN_TAC THEN REWRITE_TAC[path_image; subpath] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o; SUBPATH_SCALING_LEMMA]);; let PATH_IMAGE_SUBPATH = prove (`!u v g:real^1->real^N. drop u <= drop v ==> path_image(subpath u v g) = IMAGE g (interval[u,v])`, SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; SEGMENT_1]);; let PATH_IMAGE_SUBPATH_COMBINE = prove (`!g:real^1->real^N u. path g /\ u IN interval[vec 0,vec 1] ==> path_image(subpath (vec 0) u g) UNION path_image(subpath u (vec 1) g) = path_image g`, REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH] THEN REWRITE_TAC[path_image; GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN MATCH_MP_TAC UNION_INTERVAL_1 THEN ASM_REWRITE_TAC[IN_INTERVAL_1]);; let PATH_SUBPATH = prove (`!u v g:real^1->real^N. path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] ==> path(subpath u v g)`, REWRITE_TAC[path; subpath] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBPATH_SCALING_LEMMA; SEGMENT_1] THEN COND_CASES_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC);; let PATHSTART_SUBPATH = prove (`!u v g:real^1->real^N. pathstart(subpath u v g) = g(u)`, REWRITE_TAC[pathstart; subpath; VECTOR_MUL_RZERO; VECTOR_ADD_RID]);; let PATHFINISH_SUBPATH = prove (`!u v g:real^1->real^N. pathfinish(subpath u v g) = g(v)`, REWRITE_TAC[pathfinish; subpath; GSYM LIFT_EQ_CMUL] THEN REWRITE_TAC[LIFT_DROP; VECTOR_ARITH `u + v - u:real^N = v`]);; let SUBPATH_TRIVIAL = prove (`!g. subpath (vec 0) (vec 1) g = g`, REWRITE_TAC[subpath; VECTOR_SUB_RZERO; DROP_VEC; VECTOR_MUL_LID; VECTOR_ADD_LID; ETA_AX]);; let SUBPATH_REVERSEPATH = prove (`!g. subpath (vec 1) (vec 0) g = reversepath g`, REWRITE_TAC[subpath; reversepath; VECTOR_SUB_LZERO; DROP_NEG; DROP_VEC] THEN REWRITE_TAC[VECTOR_ARITH `a + -- &1 % b:real^N = a - b`]);; let REVERSEPATH_SUBPATH = prove (`!g u v. reversepath(subpath u v g) = subpath v u g`, REWRITE_TAC[reversepath; subpath; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_SUB_LDISTRIB] THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_SUB; LIFT_DROP] THEN VECTOR_ARITH_TAC);; let SUBPATH_TRANSLATION = prove (`!a g:real^1->real^N u v. subpath u v ((\x. a + x) o g) = (\x. a + x) o subpath u v g`, REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);; add_translation_invariants [SUBPATH_TRANSLATION];; let SUBPATH_LINEAR_IMAGE = prove (`!f:real^M->real^N g u v. linear f ==> subpath u v (f o g) = f o subpath u v g`, REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);; add_linear_invariants [SUBPATH_LINEAR_IMAGE];; let SIMPLE_PATH_SUBPATH_EQ = prove (`!g u v. simple_path(subpath u v g) <=> path(subpath u v g) /\ ~(u = v) /\ (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y ==> x = y \/ x = u /\ y = v \/ x = v /\ y = u)`, REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; subpath] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `u + a % x = u <=> a % x = vec 0`; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_MUL_LCANCEL] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB; REAL_RING `u + (v - u) * y = v <=> v = u \/ y = &1`] THEN REWRITE_TAC[REAL_SUB_0; DROP_EQ; GSYM DROP_VEC] THEN ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ARC_SUBPATH_EQ = prove (`!g u v. arc(subpath u v g) <=> path(subpath u v g) /\ ~(u = v) /\ (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y ==> x = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[arc; subpath] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `u + a % x = u + a % y <=> a % (x - y) = vec 0`; VECTOR_MUL_EQ_0; DROP_EQ_0; VECTOR_SUB_EQ] THEN ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let SIMPLE_PATH_SUBPATH = prove (`!g u v. simple_path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ ~(u = v) ==> simple_path(subpath u v g)`, SIMP_TAC[SIMPLE_PATH_SUBPATH_EQ; PATH_SUBPATH; SIMPLE_PATH_IMP_PATH] THEN REWRITE_TAC[simple_path] THEN GEN_TAC THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN SUBGOAL_THEN `!x:real^1. x IN interval[u,v] ==> x IN interval[vec 0,vec 1]` ASSUME_TAC THENL [REWRITE_TAC[GSYM SUBSET; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_TRANS]; ASM_SIMP_TAC[]] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REWRITE_TAC[DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; let ARC_SIMPLE_PATH_SUBPATH = prove (`!g u v. simple_path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ ~(g u = g v) ==> arc(subpath u v g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN ASM_MESON_TAC[SIMPLE_PATH_SUBPATH]);; let ARC_SUBPATH_ARC = prove (`!u v g. arc g /\ u IN interval [vec 0,vec 1] /\ v IN interval [vec 0,vec 1] /\ ~(u = v) ==> arc(subpath u v g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH; arc]);; let ARC_SIMPLE_PATH_SUBPATH_INTERIOR = prove (`!g u v. simple_path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ ~(u = v) /\ abs(drop u - drop v) < &1 ==> arc(subpath u v g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);; let PATH_IMAGE_SUBPATH_SUBSET = prove (`!u v g:real^1->real^N. path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] ==> path_image(subpath u v g) SUBSET path_image g`, SIMP_TAC[PATH_IMAGE_SUBPATH_GEN] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);; let JOIN_SUBPATHS_MIDDLE = prove (`!p:real^1->real^N. subpath (vec 0) (lift(&1 / &2)) p ++ subpath (lift(&1 / &2)) (vec 1) p = p`, REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[joinpaths; subpath] THEN COND_CASES_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_CMUL; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some additional lemmas about choosing sub-paths. *) (* ------------------------------------------------------------------------- *) let EXISTS_SUBPATH_OF_PATH = prove (`!g a b:real^N. path g /\ a IN path_image g /\ b IN path_image g ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\ path_image h SUBSET path_image g`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN ASM_REWRITE_TAC[GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);; let EXISTS_SUBPATH_OF_ARC_NOENDS = prove (`!g a b:real^N. arc g /\ a IN path_image g /\ b IN path_image g /\ {a,b} INTER {pathstart g,pathfinish g} = {} ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\ path_image h SUBSET (path_image g) DIFF {pathstart g,pathfinish g}`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN DISCH_TAC THEN EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN REWRITE_TAC[path_image; pathstart; pathfinish] THEN REWRITE_TAC[SET_RULE `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN REWRITE_TAC[IN_IMAGE] THEN SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\ (vec 1:real^1) IN interval[vec 0,vec 1]` MP_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]; ASM SET_TAC[]]);; let EXISTS_SUBARC_OF_ARC_NOENDS = prove (`!g a b:real^N. arc g /\ a IN path_image g /\ b IN path_image g /\ ~(a = b) /\ {a,b} INTER {pathstart g,pathfinish g} = {} ==> ?h. arc h /\ pathstart h = a /\ pathfinish h = b /\ path_image h SUBSET (path_image g) DIFF {pathstart g,pathfinish g}`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN X_GEN_TAC `v:real^1` THEN REPEAT DISCH_TAC THEN EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH]; ALL_TAC] THEN REWRITE_TAC[path_image; pathstart; pathfinish] THEN REWRITE_TAC[SET_RULE `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN REWRITE_TAC[IN_IMAGE] THEN SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\ (vec 1:real^1) IN interval[vec 0,vec 1]` MP_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]; ASM SET_TAC[]]);; let EXISTS_ARC_PSUBSET_SIMPLE_PATH = prove (`!g:real^1->real^N. simple_path g /\ closed s /\ s PSUBSET path_image g ==> ?h. arc h /\ s SUBSET path_image h /\ path_image h SUBSET path_image g`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_PATH_CASES) THENL [EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN ABBREV_TAC `(h:real^1->real^N) = shiftpath u g` THEN SUBGOAL_THEN `simple_path(h:real^1->real^N) /\ pathstart h = (g:real^1->real^N) u /\ pathfinish h = (g:real^1->real^N) u /\ path_image h = path_image g` MP_TAC THENL [EXPAND_TAC "h" THEN ASM_MESON_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH; IN_INTERVAL_1; DROP_VEC]; REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN UNDISCH_THEN `pathstart(h:real^1->real^N) = (g:real^1->real^N) u` (SUBST_ALL_TAC o SYM)] THEN SUBGOAL_THEN `open_in (subtopology euclidean (interval[vec 0,vec 1])) {x:real^1 | x IN interval[vec 0,vec 1] /\ (h x) IN ((:real^N) DIFF s)}` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN ASM_SIMP_TAC[GSYM path; GSYM closed; SIMPLE_PATH_IMP_PATH]; REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o CONJUNCT2)] THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN REWRITE_TAC[DIST_REAL; VEC_COMPONENT; REAL_SUB_RZERO] THEN SIMP_TAC[GSYM drop] THEN ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN ANTS_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `subpath (lift(min d1 (&1 / &4))) (lift(&1 - min d2 (&1 / &4))) (h:real^1->real^N)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP; LIFT_EQ] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> t INTER s SUBSET u ==> s SUBSET u`)) THEN REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ] THEN SIMP_TAC[PATH_IMAGE_SUBPATH; LIFT_DROP; REAL_ARITH `min d1 (&1 / &4) <= &1 - min d2 (&1 / &4)`] THEN REWRITE_TAC[FORALL_IN_IMAGE; path_image; IN_INTERVAL_1; DROP_VEC] THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);; let EXISTS_DOUBLE_ARC_EXPLICIT = prove (`!g:real^1->real^N a b. simple_path g /\ pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] /\ b IN interval[vec 0,vec 1] /\ drop a <= drop b /\ ~(g a = g b) ==> ?u d. arc u /\ arc d /\ pathstart u = g a /\ pathfinish u = g b /\ pathstart d = g b /\ pathfinish d = g a /\ path_image u = IMAGE g (interval[a,b]) /\ path_image d = IMAGE g (interval[vec 0,vec 1] DIFF interval(a,b)) /\ (path_image u) INTER (path_image d) = {g a,g b} /\ (path_image u) UNION (path_image d) = path_image g`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^1 = vec 0` THENL [MAP_EVERY EXISTS_TAC [`subpath (vec 0) b (g:real^1->real^N)`; `subpath b (vec 1) (g:real^1->real^N)`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]; MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[pathfinish; pathstart]; ASM_REWRITE_TAC[PATHSTART_SUBPATH]; ASM_REWRITE_TAC[PATHFINISH_SUBPATH]; ASM_REWRITE_TAC[PATHSTART_SUBPATH]; ASM_REWRITE_TAC[PATHFINISH_SUBPATH] THEN ASM_MESON_TAC[pathfinish; pathstart]; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH]; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `g u = g l ==> u IN s /\ u IN t /\ (!x. ~(x = l) ==> (x IN s <=> x IN t)) ==> IMAGE g s = IMAGE g t`)) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; IN_DIFF] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `g c = g a ==> a IN ab /\ b IN ab /\ b IN b1 /\ c IN b1 /\ (!x y. g x = g y /\ x IN ab /\ y IN b1 ==> x = a \/ x = b) ==> IMAGE g ab INTER IMAGE g b1 = {g a,g b}`)) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; DROP_VEC] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION; DROP_VEC] THEN REWRITE_TAC[path_image] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN ASM_CASES_TAC `b:real^1 = vec 1` THENL [MAP_EVERY EXISTS_TAC [`subpath a b (g:real^1->real^N)`; `subpath (vec 0) a (g:real^1->real^N)`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]; MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[pathfinish; pathstart]; ASM_REWRITE_TAC[PATHSTART_SUBPATH]; ASM_REWRITE_TAC[PATHFINISH_SUBPATH]; ASM_REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_MESON_TAC[pathfinish; pathstart]; ASM_REWRITE_TAC[PATHFINISH_SUBPATH]; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH]; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `g u = g l ==> l IN s /\ u IN t /\ (!x. ~(x = u) ==> (x IN s <=> x IN t)) ==> IMAGE g s = IMAGE g t`)) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; IN_DIFF] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `g b = g c ==> a IN a1 /\ b IN a1 /\ a IN a0 /\ c IN a0 /\ (!x y. g x = g y /\ x IN a0 /\ y IN a1 ==> x = a \/ x = c) ==> IMAGE g a1 INTER IMAGE g a0 = {g a,g b}`)) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; DROP_VEC] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION; DROP_VEC] THEN REWRITE_TAC[path_image] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`subpath a b (g:real^1->real^N)`; `subpath b (vec 1) (g:real^1->real^N) ++ subpath (vec 0) a g`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC ARC_JOIN THEN REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `vec 1:real^1`]) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `vec 0:real^1`]) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[pathstart; pathfinish]; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `g u = g l ==> (!x y. x IN b1 /\ y IN a0 /\ g x = g y ==> x = l \/ x = u) ==> IMAGE g b1 INTER IMAGE g a0 SUBSET {g l}`)) THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `a:real^1 = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; GSYM DROP_EQ]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[PATHSTART_SUBPATH]; REWRITE_TAC[PATHFINISH_SUBPATH]; REWRITE_TAC[PATHSTART_JOIN; PATHSTART_SUBPATH]; REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_SUBPATH]; ASM_SIMP_TAC[PATH_IMAGE_SUBPATH]; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_DIFF; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN MATCH_MP_TAC(SET_RULE `a IN ab /\ b IN ab /\ a IN a0 /\ b IN b1 /\ (!x y. g x = g y /\ x IN ab /\ (y IN b1 \/ y IN a0) ==> x = a \/ x = b) ==> IMAGE g ab INTER IMAGE g (b1 UNION a0) = {g a,g b}`) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN REWRITE_TAC[path_image] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);; let EXISTS_DOUBLE_ARC = prove (`!g:real^1->real^N a b. simple_path g /\ pathfinish g = pathstart g /\ a IN path_image g /\ b IN path_image g /\ ~(a = b) ==> ?u d. arc u /\ arc d /\ pathstart u = a /\ pathfinish u = b /\ pathstart d = b /\ pathfinish d = a /\ (path_image u) INTER (path_image d) = {a,b} /\ (path_image u) UNION (path_image d) = path_image g`, REPEAT STRIP_TAC THEN UNDISCH_TAC `(b:real^N) IN path_image g` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN UNDISCH_TAC `(a:real^N) IN path_image g` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN X_GEN_TAC `v:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN DISJ_CASES_TAC(REAL_ARITH `drop u <= drop v \/ drop v <= drop u`) THENL [MP_TAC(ISPECL [`g:real^1->real^N`; `u:real^1`; `v:real^1`] EXISTS_DOUBLE_ARC_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; MP_TAC(ISPECL [`g:real^1->real^N`; `v:real^1`; `u:real^1`] EXISTS_DOUBLE_ARC_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[INTER_COMM; UNION_COMM; INSERT_AC]]);; let SUBPATH_TO_FRONTIER_EXPLICIT = prove (`!g:real^1->real^N s. path g /\ pathstart g IN s /\ ~(pathfinish g IN s) ==> ?u. u IN interval[vec 0,vec 1] /\ (!x. &0 <= drop x /\ drop x < drop u ==> g x IN interior s) /\ ~(g u IN interior s) /\ (u = vec 0 \/ g u IN closure s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{u | lift u IN interval[vec 0,vec 1] /\ g(lift u) IN closure((:real^N) DIFF s)}` COMPACT_ATTAINS_INF) THEN SIMP_TAC[LIFT_DROP; SET_RULE `(!x. lift(drop x) = x) ==> IMAGE lift {x | P(lift x)} = {x | P x}`] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish; SUBSET; path_image; FORALL_IN_IMAGE]) THEN CONJ_TAC THENL [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSED_INTERVAL]]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[LIFT_NUM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]]; ALL_TAC] THEN REWRITE_TAC[EXISTS_DROP; FORALL_DROP; IN_ELIM_THM; LIFT_DROP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN ASM_REWRITE_TAC[subpath; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV [TAUT `a /\ ~b ==> c <=> a /\ ~c ==> b`]) THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^1`) THEN DISCH_TAC] THEN ASM_CASES_TAC `drop u = &0` THEN ASM_REWRITE_TAC[frontier; IN_DIFF; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `lift(max (&0) (drop u - d / &2))`) THEN REWRITE_TAC[LIFT_DROP; DIST_REAL; GSYM drop] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC (MESON[] `P a ==> dist(a,y) < e ==> ?x. P x /\ dist(x,y) < e`) THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] INTERIOR_SUBSET) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN ASM_ARITH_TAC);; let SUBPATH_TO_FRONTIER_STRONG = prove (`!g:real^1->real^N s. path g /\ pathstart g IN s /\ ~(pathfinish g IN s) ==> ?u. u IN interval[vec 0,vec 1] /\ ~(pathfinish(subpath (vec 0) u g) IN interior s) /\ (u = vec 0 \/ (!x. x IN interval[vec 0,vec 1] /\ ~(x = vec 1) ==> (subpath (vec 0) u g x) IN interior s) /\ pathfinish(subpath (vec 0) u g) IN closure s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_EXPLICIT) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN REWRITE_TAC[subpath; pathfinish; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO] THEN ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL] THEN REWRITE_TAC[REAL_ARITH `u * x < u <=> &0 < u * (&1 - x)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_SUB_LT] THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]);; let SUBPATH_TO_FRONTIER = prove (`!g:real^1->real^N s. path g /\ pathstart g IN s /\ ~(pathfinish g IN s) ==> ?u. u IN interval[vec 0,vec 1] /\ pathfinish(subpath (vec 0) u g) IN frontier s /\ (path_image(subpath (vec 0) u g) DELETE pathfinish(subpath (vec 0) u g)) SUBSET interior s`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[frontier; IN_DIFF] THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_STRONG) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN REWRITE_TAC[subpath; path_image; VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN SET_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_DELETE; IMP_CONJ] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; pathfinish] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_MESON_TAC[]]);; let EXISTS_PATH_SUBPATH_TO_FRONTIER = prove (`!g:real^1->real^N s. path g /\ pathstart g IN s /\ ~(pathfinish g IN s) ==> ?h. path h /\ pathstart h = pathstart g /\ (path_image h) SUBSET (path_image g) /\ (path_image h DELETE (pathfinish h)) SUBSET interior s /\ pathfinish h IN frontier s`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP SUBPATH_TO_FRONTIER) THEN EXISTS_TAC `subpath (vec 0) u (g:real^1->real^N)` THEN ASM_SIMP_TAC[PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; PATHSTART_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN REWRITE_TAC[pathstart]);; let EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED = prove (`!g:real^1->real^N s. closed s /\ path g /\ pathstart g IN s /\ ~(pathfinish g IN s) ==> ?h. path h /\ pathstart h = pathstart g /\ (path_image h) SUBSET (path_image g) INTER s /\ pathfinish h IN frontier s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET_INTER] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(pathfinish h:real^N) INSERT (path_image h DELETE pathfinish h)` THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN CONJ_TAC THENL [ASM_MESON_TAC[frontier; CLOSURE_EQ; IN_DIFF]; ASM_MESON_TAC[SUBSET_TRANS; INTERIOR_SUBSET]]);; let PATH_COMBINE = prove (`!u g:real^1->real^N. u IN interval[vec 0,vec 1] ==> (path g <=> path(subpath (vec 0) u g) /\ path(subpath u (vec 1) g))`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL] THEN ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_SIMP_TAC[SUBPATH_TRIVIAL] THEN ASM_CASES_TAC `u:real^1 = vec 1` THEN ASM_SIMP_TAC[SUBPATH_TRIVIAL] THEN REWRITE_TAC[path; subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN STRIP_TAC THEN SUBGOAL_THEN `interval[vec 0:real^1,vec 1] = interval[vec 0,u] UNION interval[u,vec 1]` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN CONJ_TAC THENL [SUBGOAL_THEN `(g:real^1->real^N) = (\x. g(drop u % x)) o (\x. inv(drop u) % x)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_SCALING; LINEAR_CONTINUOUS_ON] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `inv u % x:real^N = inv u % x + vec 0`] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE; REAL_LE_INV_EQ] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; REAL_MUL_LINV]]; SUBGOAL_THEN `(g:real^1->real^N) = (\x. g(u + drop(vec 1 - u) % x)) o (\x. inv(drop(vec 1 - u)) % (x - u))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_SUB_EQ; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN REWRITE_TAC[VECTOR_ARITH `u + x - u:real^N = x`]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN REWRITE_TAC[VECTOR_ARITH `c % (x - u):real^N = c % x + --(c % u)`] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE; REAL_LE_INV_EQ; DROP_SUB; REAL_SUB_LE] THEN AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_NEG] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]]]);; (* ------------------------------------------------------------------------- *) (* Special case of straight-line paths. *) (* ------------------------------------------------------------------------- *) let linepath = new_definition `linepath(a,b) = \x. (&1 - drop x) % a + drop x % b`;; let LINEPATH_TRANSLATION = prove (`!a b c. linepath(a + b,a + c) = (\x. a + x) o linepath(b,c)`, REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; add_translation_invariants [LINEPATH_TRANSLATION];; let LINEPATH_LINEAR_IMAGE = prove (`!f. linear f ==> !b c. linepath(f b,f c) = f o linepath(b,c)`, REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_ADD) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL) THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; add_linear_invariants [LINEPATH_LINEAR_IMAGE];; let PATHSTART_LINEPATH = prove (`!a b. pathstart(linepath(a,b)) = a`, REWRITE_TAC[linepath; pathstart; DROP_VEC] THEN VECTOR_ARITH_TAC);; let PATHFINISH_LINEPATH = prove (`!a b. pathfinish(linepath(a,b)) = b`, REWRITE_TAC[linepath; pathfinish; DROP_VEC] THEN VECTOR_ARITH_TAC);; let CONTINUOUS_LINEPATH_AT = prove (`!a b x. linepath(a,b) continuous (at x)`, REPEAT GEN_TAC THEN REWRITE_TAC[linepath] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + y = x + u % --x + y`] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; let CONTINUOUS_ON_LINEPATH = prove (`!a b s. linepath(a,b) continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_LINEPATH_AT]);; let PATH_LINEPATH = prove (`!a b. path(linepath(a,b))`, REWRITE_TAC[path; CONTINUOUS_ON_LINEPATH]);; let PATH_IMAGE_LINEPATH = prove (`!a b. path_image(linepath (a,b)) = segment[a,b]`, REWRITE_TAC[segment; path_image; linepath] THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTERVAL] THEN SIMP_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT; ARITH] THEN REWRITE_TAC[EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN MESON_TAC[]);; let REVERSEPATH_LINEPATH = prove (`!a b. reversepath(linepath(a,b)) = linepath(b,a)`, REWRITE_TAC[reversepath; linepath; DROP_SUB; DROP_VEC; FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; let ARC_LINEPATH = prove (`!a b. ~(a = b) ==> arc(linepath(a,b))`, REWRITE_TAC[arc; PATH_LINEPATH] THEN REWRITE_TAC[linepath] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=> (x - y) % (a - b) = vec 0`] THEN SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; DROP_EQ; REAL_SUB_0]);; let SIMPLE_PATH_LINEPATH = prove (`!a b. ~(a = b) ==> simple_path(linepath(a,b))`, MESON_TAC[ARC_IMP_SIMPLE_PATH; ARC_LINEPATH]);; let SIMPLE_PATH_LINEPATH_EQ = prove (`!a b:real^N. simple_path(linepath(a,b)) <=> ~(a = b)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SIMPLE_PATH_LINEPATH] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[simple_path] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[linepath; GSYM VECTOR_ADD_RDISTRIB] THEN DISCH_THEN(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]) THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM DROP_EQ; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ARC_LINEPATH_EQ = prove (`!a b. arc(linepath(a,b)) <=> ~(a = b)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ARC_LINEPATH] THEN MESON_TAC[SIMPLE_PATH_LINEPATH_EQ; ARC_IMP_SIMPLE_PATH]);; let LINEPATH_REFL = prove (`!a. linepath(a,a) = \x. a`, REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`]);; let PATH_IMAGE_CONST = prove (`!a:real^N. path_image (\x. a) = {a}`, REWRITE_TAC[GSYM LINEPATH_REFL; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[SEGMENT_REFL]);; let SHIFTPATH_TRIVIAL = prove (`!t a. shiftpath t (linepath(a,a)) = linepath(a,a)`, REWRITE_TAC[shiftpath; LINEPATH_REFL; COND_ID]);; let SUBPATH_REFL = prove (`!g a. subpath a a g = linepath(g a,g a)`, REWRITE_TAC[subpath; linepath; VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO; FUN_EQ_THM; VECTOR_ADD_RID] THEN VECTOR_ARITH_TAC);; let SEGMENT_TO_FRONTIER = prove (`!s a b:real^N. a IN interior s /\ ~(b IN interior s) ==> ?c. c IN segment[a,b] /\ ~(c = a) /\ c IN frontier s /\ segment(a,c) SUBSET interior s`, GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(!x. R x ==> Q x) /\ (?x. P x /\ R x /\ S x) ==> ?x. P x /\ Q x /\ R x /\ S x`) THEN CONJ_TAC THENL [ASM_MESON_TAC[frontier; IN_DIFF]; ALL_TAC] THEN MP_TAC(ISPECL [`linepath(vec 0:real^N,b)`; `interior s:real^N->bool`] SUBPATH_TO_FRONTIER) THEN ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_INTERIOR] THEN REWRITE_TAC[subpath; linepath; VECTOR_ADD_LID; VECTOR_SUB_RZERO; VECTOR_MUL_RZERO; pathstart; pathfinish] THEN REWRITE_TAC[IN_INTERVAL_1; GSYM EXISTS_DROP; DROP_VEC] THEN REWRITE_TAC[DROP_CMUL; path_image; DROP_VEC; REAL_MUL_RID] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u % b:real^N` THEN REWRITE_TAC[IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[FRONTIER_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN ONCE_REWRITE_TAC[segment] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF {a,b} SUBSET t DELETE b`) THEN REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `v:real` THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN EXISTS_TAC `lift v` THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC; VECTOR_MUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_SYM]);; (* ------------------------------------------------------------------------- *) (* Bounding a point away from a path. *) (* ------------------------------------------------------------------------- *) let NOT_ON_PATH_BALL = prove (`!g z:real^N. path g /\ ~(z IN path_image g) ==> ?e. &0 < e /\ ball(z,e) INTER (path_image g) = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`path_image g:real^N->bool`; `z:real^N`] DISTANCE_ATTAINS_INF) THEN REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `dist(z:real^N,a)` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIST_POS_LT]; ALL_TAC] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_BALL; IN_INTER] THEN ASM_MESON_TAC[REAL_NOT_LE]);; let NOT_ON_PATH_CBALL = prove (`!g z:real^N. path g /\ ~(z IN path_image g) ==> ?e. &0 < e /\ cball(z,e) INTER (path_image g) = {}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NOT_ON_PATH_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Homeomorphisms of arc images. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHISM_ARC = prove (`!g:real^1->real^N. arc g ==> ?h. homeomorphism (interval[vec 0,vec 1],path_image g) (g,h)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN ASM_REWRITE_TAC[path_image; COMPACT_INTERVAL; GSYM path; GSYM arc]);; let HOMEOMORPHIC_ARC_IMAGE_INTERVAL = prove (`!g:real^1->real^N a b:real^1. arc g /\ drop a < drop b ==> (path_image g) homeomorphic interval[a,b]`, REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN EXISTS_TAC `g:real^1->real^N` THEN ASM_SIMP_TAC[HOMEOMORPHISM_ARC]; MATCH_MP_TAC HOMEOMORPHIC_CLOSED_INTERVALS THEN ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC; REAL_LT_01]]);; let HOMEOMORPHIC_ARC_IMAGES = prove (`!g:real^1->real^M h:real^1->real^N. arc g /\ arc h ==> (path_image g) homeomorphic (path_image h)`, REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGE_INTERVAL THEN ASM_REWRITE_TAC[DROP_VEC; REAL_LT_01]);; let HOMEOMORPHIC_ARC_IMAGE_SEGMENT = prove (`!g:real^1->real^N a b:real^M. arc g /\ ~(a = b) ==> (path_image g) homeomorphic segment[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH] THEN MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGES THEN ASM_REWRITE_TAC[ARC_LINEPATH_EQ]);; let HOMEOMORPHIC_ARC_IMAGE_SEGMENT_EQ = prove (`!s:real^N->bool a b:real^M. ~(a = b) ==> (s homeomorphic segment[a,b] <=> ?g. arc g /\ path_image g = s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_ARC_IMAGE_SEGMENT]] THEN REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^M`; `g:real^M->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `(g:real^M->real^N) o linepath(a,b)` THEN ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN MATCH_MP_TAC ARC_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; ARC_LINEPATH_EQ] THEN ASM SET_TAC[]);; let CONNECTED_SUBSET_PATH_IMAGE_ARC = prove (`!s g:real^1->real^N. arc g /\ connected s /\ s SUBSET path_image g /\ pathstart g IN s /\ pathfinish g IN s ==> s = path_image g`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_ARC) THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `IMAGE (h:real^N->real^1) (path_image g) SUBSET IMAGE h s` MP_TAC THENL [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTERVAL_SUBSET_IS_INTERVAL o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `vec 0 IN interval[vec 0:real^1,vec 1] /\ vec 1 IN interval[vec 0:real^1,vec 1]` MP_TAC THENL [REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN ASM SET_TAC[]);; let ARC_IMAGE_UNIQUE = prove (`!g h:real^1->real^N. path g /\ arc h /\ path_image g SUBSET path_image h /\ {pathstart g,pathfinish g} = {pathstart h,pathfinish h} ==> path_image g = path_image h`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `{a,b} = {c,d} ==> a = c /\ b = d \/ a = d /\ b = c`)) THEN STRIP_TAC THENL [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [GSYM PATH_IMAGE_REVERSEPATH]] THEN MATCH_MP_TAC CONNECTED_SUBSET_PATH_IMAGE_ARC THEN ASM_REWRITE_TAC[ARC_REVERSEPATH_EQ; PATH_IMAGE_REVERSEPATH] THEN REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN ASM_MESON_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH; PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]);; let CONNECTED_SUBSET_ARC_PAIR = prove (`!g h s:real^N->bool. arc g /\ arc h /\ pathstart g = pathstart h /\ pathfinish g = pathfinish h /\ path_image g INTER path_image h = {pathstart g,pathfinish g} /\ connected s /\ s SUBSET path_image g UNION path_image h /\ pathstart g IN s /\ pathfinish g IN s ==> path_image g SUBSET s \/ path_image h SUBSET s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `((?x. x IN t /\ ~(x IN s)) /\ (?y. y IN u /\ ~(y IN s)) ==> F) ==> t SUBSET s \/ u SUBSET s`) THEN REWRITE_TAC[path_image; EXISTS_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `p:real^1` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `q:real^1` STRIP_ASSUME_TAC)) THEN UNDISCH_TAC `connected(s:real^N->bool)` THEN REWRITE_TAC[CONNECTED_OPEN_IN] THEN MAP_EVERY EXISTS_TAC [`s DIFF (path_image (subpath p (vec 1) g) UNION path_image (subpath q (vec 1) h)):real^N->bool`; `s DIFF (path_image (subpath (vec 0) p g) UNION path_image (subpath (vec 0) q h)):real^N->bool`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF_CLOSED THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_PATH_IMAGE THEN MATCH_MP_TAC PATH_SUBPATH THEN ASM_SIMP_TAC[ARC_IMP_PATH; ENDS_IN_UNIT_INTERVAL]; MATCH_MP_TAC OPEN_IN_DIFF_CLOSED THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_PATH_IMAGE THEN MATCH_MP_TAC PATH_SUBPATH THEN ASM_SIMP_TAC[ARC_IMP_PATH; ENDS_IN_UNIT_INTERVAL]; REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM DE_MORGAN_THM] THEN DISCH_THEN(REPEAT_TCL STRIP_THM_THEN MP_TAC) THEN REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM; NOT_EXISTS_THM] THEN X_GEN_TAC `a:real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN X_GEN_TAC `b:real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THENL [UNDISCH_TAC `arc(g:real^1->real^N)` THEN REWRITE_TAC[arc] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`] o CONJUNCT2) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_CASES_TAC `a:real^1 = p` THENL [ASM SET_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s INTER IMAGE g s = a ==> !x y. x IN s /\ y IN s /\ f x = g y ==> f(x) IN a`)) THEN DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `a:real^1`]) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM]] THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `arc(g:real^1->real^N)` THEN REWRITE_TAC[arc] THEN DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `vec 0:real^1`] o CONJUNCT2); UNDISCH_TAC `arc(h:real^1->real^N)` THEN REWRITE_TAC[arc] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `vec 1:real^1`] o CONJUNCT2)]; RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE f s INTER IMAGE g s = a ==> !x y. x IN s /\ y IN s /\ f x = g y ==> f(x) IN a`)) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM]] THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `arc(h:real^1->real^N)` THEN REWRITE_TAC[arc] THEN DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `vec 0:real^1`] o CONJUNCT2); UNDISCH_TAC `arc(g:real^1->real^N)` THEN REWRITE_TAC[arc] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `vec 1:real^1`] o CONJUNCT2)]; UNDISCH_TAC `arc(h:real^1->real^N)` THEN REWRITE_TAC[arc] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`] o CONJUNCT2) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_CASES_TAC `a:real^1 = q` THENL [ASM SET_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC]; MP_TAC(ISPECL [`g:real^1->real^N`; `p:real^1`] PATH_IMAGE_SUBPATH_COMBINE) THEN MP_TAC(ISPECL [`h:real^1->real^N`; `q:real^1`] PATH_IMAGE_SUBPATH_COMBINE) THEN ASM_SIMP_TAC[ARC_IMP_PATH] THEN ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `pathstart g:real^N` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; ARC_IMP_PATH] THEN CONJ_TAC THENL [UNDISCH_TAC `arc(g:real^1->real^N)`; UNDISCH_TAC `arc(h:real^1->real^N)`] THEN REWRITE_TAC[arc; path_image; IN_IMAGE; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real^1` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC(SPEC `vec 0:real^1` th)) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; NOT_IMP]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `pathfinish g:real^N` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; ARC_IMP_PATH] THEN CONJ_TAC THENL [UNDISCH_TAC `arc(g:real^1->real^N)`; UNDISCH_TAC `arc(h:real^1->real^N)`] THEN REWRITE_TAC[arc; path_image; IN_IMAGE; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real^1` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; NOT_IMP]] THEN (REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; NOT_IMP] THEN REPEAT CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[pathstart; pathfinish]; DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_MESON_TAC[REAL_LE_ANTISYM; LIFT_EQ; LIFT_NUM; LIFT_DROP; pathstart; pathfinish]]));; let HOMEOMORPHIC_SIMPLE_PATH_IMAGES = prove (`!g:real^1->real^M h:real^1->real^N. simple_path g /\ pathfinish g = pathstart g /\ simple_path h /\ pathfinish h = pathstart h ==> (path_image g) homeomorphic (path_image h)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^M`; `h:real^1->real^N`; `interval[vec 0:real^1,vec 1]`; `path_image g:real^M->bool`; `path_image h:real^N->bool`] LIFT_TO_QUOTIENT_SPACE_UNIQUE) THEN REWRITE_TAC[path_image; CONJ_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_QUOTIENT_MAP THEN ASM_SIMP_TAC[GSYM path; COMPACT_INTERVAL; SIMPLE_PATH_IMP_PATH]; RULE_ASSUM_TAC(REWRITE_RULE[simple_path; pathstart; pathfinish]) THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`] o CONJUNCT2)) THEN ASM_MESON_TAC[]]);; let HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ = prove (`!s:real^N->bool a:real^2 r. &0 < r ==> (s homeomorphic sphere(a,r) <=> ?g. simple_path g /\ pathfinish g = pathstart g /\ path_image g = s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?p. simple_path p /\ pathfinish p = pathstart p /\ (path_image p:real^2->bool) homeomorphic(sphere(a:real^2,r))` STRIP_ASSUME_TAC THENL [EXISTS_TAC `linepath(vec 0:real^2,basis 1) ++ linepath(basis 1,basis 2) ++ linepath(basis 2,vec 0)` THEN SUBGOAL_THEN `~(basis 2:real^2 = basis 1) /\ ~(basis 1:real^2 = vec 0) /\ ~(basis 2:real^2 = vec 0)` STRIP_ASSUME_TAC THENL [SIMP_TAC[BASIS_INJ_EQ; BASIS_NONZERO; DIMINDEX_2; ARITH]; ALL_TAC] THEN SUBGOAL_THEN `~affine_dependent {vec 0:real^2,basis 1,basis 2}` ASSUME_TAC THENL [MATCH_MP_TAC INDEPENDENT_IMP_AFFINE_DEPENDENT_0 THEN ASM_REWRITE_TAC[independent; DEPENDENT_2] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(AP_TERM `\x:real^2. x$1` th) THEN MP_TAC(AP_TERM `\x:real^2. x$2` th)) THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; VEC_COMPONENT; DIMINDEX_2; ARITH] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; ARC_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[ARC_LINEPATH_EQ; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET; CONJ_ASSOC] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SEGMENT_SYM] THEN REPEAT CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) INTER_SEGMENT o lhand o snd) THEN (ANTS_TAC THENL [DISJ2_TAC; SET_TAC[]]) THEN ASM_REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT] THEN ASM_MESON_TAC[INSERT_AC]; TRANS_TAC HOMEOMORPHIC_TRANS `relative_frontier(convex hull {vec 0:real^2,basis 1,basis 2})` THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[HOMEOMORPHIC_REFL] `s = t ==> s homeomorphic t`) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_CONVEX_HULL_CASES] THEN REWRITE_TAC[SET_RULE `{f x | x IN {a,b,c}} = {f a,f b,f c}`] THEN ASM_REWRITE_TAC[DELETE_INSERT; GSYM SEGMENT_CONVEX_HULL; EMPTY_DELETE; SEGMENT_SYM] THEN SET_TAC[]; MP_TAC(ISPECL [`convex hull {vec 0:real^2,basis 1,basis 2}`; `cball(a:real^2,r)`] HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; CONVEX_CONVEX_HULL] THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL; BOUNDED_CONVEX_HULL_EQ] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL; BOUNDED_INSERT; BOUNDED_EMPTY] THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[AFF_DIM_CBALL; DIMINDEX_2] THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN CONV_TAC INT_REDUCE_CONV]]; TRANS_TAC EQ_TRANS `(s:real^N->bool) homeomorphic (path_image p:real^2->bool)` THEN CONJ_TAC THENL [EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EQ_TAC THENL [REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^N->real^2`; `f:real^2->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `(f:real^2->real^N) o (p:real^1->real^2)` THEN REWRITE_TAC[PATHFINISH_COMPOSE; PATHSTART_COMPOSE] THEN ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN MATCH_MP_TAC SIMPLE_PATH_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLE_PATH_IMAGES THEN ASM_REWRITE_TAC[]]]);; let HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE = prove (`!g:real^1->real^N a:real^2 r. simple_path g /\ pathfinish g = pathstart g /\ &0 < r ==> (path_image g) homeomorphic sphere(a,r)`, MESON_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ]);; (* ------------------------------------------------------------------------- *) (* Path component, considered as a "joinability" relation (from Tom Hales). *) (* ------------------------------------------------------------------------- *) let path_component = new_definition `path_component s x y <=> ?g. path g /\ path_image g SUBSET s /\ pathstart g = x /\ pathfinish g = y`;; let PATH_COMPONENT_IN = prove (`!s x y. path_component s x y ==> x IN s /\ y IN s`, REWRITE_TAC[path_component; path_image; pathstart; pathfinish] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_REFL; REAL_POS]);; let PATH_COMPONENT_REFL = prove (`!s x:real^N. x IN s ==> path_component s x x`, REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN EXISTS_TAC `(\u. x):real^1->real^N` THEN REWRITE_TAC[pathstart; pathfinish; path_image; path; CONTINUOUS_ON_CONST; IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let PATH_COMPONENT_REFL_EQ = prove (`!s x:real^N. path_component s x x <=> x IN s`, MESON_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_REFL]);; let PATH_COMPONENT_SYM = prove (`!s x y:real^N. path_component s x y ==> path_component s y x`, REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN MESON_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);; let PATH_COMPONENT_SYM_EQ = prove (`!s x y. path_component s x y <=> path_component s y x`, MESON_TAC[PATH_COMPONENT_SYM]);; let PATH_COMPONENT_TRANS = prove (`!s x y:real^N. path_component s x y /\ path_component s y z ==> path_component s x z`, REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `g1:real^1->real^N`) (X_CHOOSE_TAC `g2:real^1->real^N`)) THEN EXISTS_TAC `g1 ++ g2 :real^1->real^N` THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET; PATHSTART_JOIN; PATHFINISH_JOIN]);; let PATH_COMPONENT_OF_SUBSET = prove (`!s t x. s SUBSET t /\ path_component s x y ==> path_component t x y`, REWRITE_TAC[path_component] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Can also consider it as a set, as the name suggests. *) (* ------------------------------------------------------------------------- *) let PATH_COMPONENT_SET = prove (`!s x. path_component s x = { y | ?g. path g /\ path_image g SUBSET s /\ pathstart g = x /\ pathfinish g = y }`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN; path_component]);; let PATH_COMPONENT_SUBSET = prove (`!s x. (path_component s x) SUBSET s`, REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[PATH_COMPONENT_IN; IN]);; let PATH_COMPONENT_EQ_EMPTY = prove (`!s x. path_component s x = {} <=> ~(x IN s)`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[IN; PATH_COMPONENT_REFL; PATH_COMPONENT_IN]);; let PATH_COMPONENT_EMPTY = prove (`!x. path_component {} x = {}`, REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);; let UNIONS_PATH_COMPONENT = prove (`!s:real^N->bool. UNIONS {path_component s x |x| x IN s} = s`, GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; PATH_COMPONENT_SUBSET] THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ]);; let PATH_COMPONENT_TRANSLATION = prove (`!a s x. path_component (IMAGE (\x. a + x) s) (a + x) = IMAGE (\x. a + x) (path_component s x)`, REWRITE_TAC[PATH_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [PATH_COMPONENT_TRANSLATION];; let PATH_COMPONENT_LINEAR_IMAGE = prove (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> path_component (IMAGE f s) (f x) = IMAGE f (path_component s x)`, REWRITE_TAC[PATH_COMPONENT_SET] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [PATH_COMPONENT_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Path connectedness of a space. *) (* ------------------------------------------------------------------------- *) let path_connected = new_definition `path_connected s <=> !x y. x IN s /\ y IN s ==> ?g. path g /\ (path_image g) SUBSET s /\ pathstart g = x /\ pathfinish g = y`;; let PATH_CONNECTED_IFF_PATH_COMPONENT = prove (`!s. path_connected s <=> !x y. x IN s /\ y IN s ==> path_component s x y`, REWRITE_TAC[path_connected; path_component]);; let PATH_CONNECTED_IMP_PATH_COMPONENT = prove (`!s a b:real^N. path_connected s /\ a IN s /\ b IN s ==> path_component s a b`, MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]);; let PATH_CONNECTED_COMPONENT_SET = prove (`!s. path_connected s <=> !x. x IN s ==> path_component s x = s`, REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[PATH_COMPONENT_SUBSET] THEN SET_TAC[]);; let PATH_COMPONENT_MONO = prove (`!s t x. s SUBSET t ==> (path_component s x) SUBSET (path_component t x)`, REWRITE_TAC[PATH_COMPONENT_SET] THEN SET_TAC[]);; let PATH_COMPONENT_MAXIMAL = prove (`!s t x. x IN t /\ path_connected t /\ t SUBSET s ==> t SUBSET (path_component s x)`, REWRITE_TAC[path_connected; PATH_COMPONENT_SET; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let PATH_COMPONENT_EQ = prove (`!s x y. y IN path_component s x ==> path_component s y = path_component s x`, REWRITE_TAC[EXTENSION; IN] THEN MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);; let PATH_COMPONENT_PATH_IMAGE_PATHSTART = prove (`!p x:real^N. path p /\ x IN path_image p ==> path_component (path_image p) (pathstart p) x`, REWRITE_TAC[path_image; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^1 = vec 0` THENL [ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC PATH_COMPONENT_REFL THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN REWRITE_TAC[DROP_VEC; REAL_POS]; ALL_TAC] THEN REWRITE_TAC[path_component] THEN EXISTS_TAC `\y. (p:real^1->real^N)(drop x % y)` THEN ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET); ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET; AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN REWRITE_TAC[REAL_MUL_RID]] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN SIMP_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_LE_MUL] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]);; let PATH_CONNECTED_PATH_IMAGE = prove (`!p:real^1->real^N. path p ==> path_connected(path_image p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `pathstart p :real^N` THEN ASM_MESON_TAC[PATH_COMPONENT_PATH_IMAGE_PATHSTART; PATH_COMPONENT_SYM]);; let PATH_CONNECTED_PATH_COMPONENT = prove (`!s x:real^N. path_connected(path_component s x)`, REPEAT GEN_TAC THEN REWRITE_TAC[path_connected; IN] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `path_component s y (z:real^N)` MP_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]; ALL_TAC] THEN REWRITE_TAC[path_component] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `path_component s (x:real^N) = path_component s y` SUBST1_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_EQ; IN]; ALL_TAC] THEN MP_TAC(ISPECL [`p:real^1->real^N`; `w:real^N`] PATH_COMPONENT_PATH_IMAGE_PATHSTART) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_MONO) THEN REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]);; let PATH_COMPONENT = prove (`!s x y:real^N. path_component s x y <=> ?t. path_connected t /\ t SUBSET s /\ x IN t /\ y IN t`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC `path_component s (x:real^N)` THEN REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT; PATH_COMPONENT_SUBSET] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_IN) THEN ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL_EQ]; REWRITE_TAC[path_component] THEN ASM_MESON_TAC[path_connected; SUBSET]]);; let PATH_COMPONENT_PATH_COMPONENT = prove (`!s x:real^N. path_component (path_component s x) x = path_component s x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[PATH_COMPONENT_MONO; PATH_COMPONENT_SUBSET] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN REWRITE_TAC[SUBSET_REFL; PATH_CONNECTED_PATH_COMPONENT] THEN ASM_REWRITE_TAC[IN; PATH_COMPONENT_REFL_EQ]; MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN ASM_MESON_TAC[SUBSET; PATH_COMPONENT_SUBSET]]);; let PATH_CONNECTED_LINEPATH = prove (`!s a b:real^N. segment[a,b] SUBSET s ==> path_component s a b`, REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN EXISTS_TAC `linepath(a:real^N,b)` THEN ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH]);; let PATH_COMPONENT_DISJOINT = prove (`!s a b. DISJOINT (path_component s a) (path_component s b) <=> ~(a IN path_component s b)`, REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN REWRITE_TAC[IN] THEN MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);; let PATH_COMPONENT_EQ_EQ = prove (`!s x y:real^N. path_component s x = path_component s y <=> ~(x IN s) /\ ~(y IN s) \/ x IN s /\ y IN s /\ path_component s x y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[PATH_COMPONENT_TRANS; PATH_COMPONENT_REFL; PATH_COMPONENT_SYM]; ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM PATH_COMPONENT_EQ_EMPTY]) THEN ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]]);; let PATH_COMPONENT_UNIQUE = prove (`!s c x:real^N. x IN c /\ c SUBSET s /\ path_connected c /\ (!c'. x IN c' /\ c' SUBSET s /\ path_connected c' ==> c' SUBSET c) ==> path_component s x = c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);; let PATH_COMPONENT_INTERMEDIATE_SUBSET = prove (`!t u a:real^N. path_component u a SUBSET t /\ t SUBSET u ==> path_component t a = path_component u a`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_UNIQUE THEN ASM_REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN CONJ_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_REFL; IN]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM SET_TAC[]; ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET]]);; let COMPLEMENT_PATH_COMPONENT_UNIONS = prove (`!s x:real^N. s DIFF path_component s x = UNIONS({path_component s y | y | y IN s} DELETE (path_component s x))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_PATH_COMPONENT] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s DELETE a ==> DISJOINT a x) ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN SIMP_TAC[PATH_COMPONENT_DISJOINT; PATH_COMPONENT_EQ_EQ] THEN MESON_TAC[IN; SUBSET; PATH_COMPONENT_SUBSET]);; (* ------------------------------------------------------------------------- *) (* General "locally connected implies connected" type results. *) (* ------------------------------------------------------------------------- *) let OPEN_GENERAL_COMPONENT = prove (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\ (!s x y. c s x y ==> c s y x) /\ (!s x y z. c s x y /\ c s y z ==> c s x z) /\ (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\ (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s ==> c (ball(x,e)) x y) ==> !s x:real^N. open s ==> open(c s x)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[SUBSET; IN] THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^N) IN s /\ y IN s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN REMOVE_THEN "BALL" MATCH_MP_TAC THEN REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);; let OPEN_NON_GENERAL_COMPONENT = prove (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\ (!s x y. c s x y ==> c s y x) /\ (!s x y z. c s x y /\ c s y z ==> c s x z) /\ (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\ (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s ==> c (ball(x,e)) x y) ==> !s x:real^N. open s ==> open(s DIFF c s x)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o REWRITE_RULE[IN])) THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN REMOVE_THEN "SYM" MATCH_MP_TAC THEN REMOVE_THEN "BALL" MATCH_MP_TAC THEN REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);; let GENERAL_CONNECTED_OPEN = prove (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\ (!s x y. c s x y ==> c s y x) /\ (!s x y z. c s x y /\ c s y z ==> c s x z) /\ (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\ (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s ==> c (ball(x,e)) x y) ==> !s x y:real^N. open s /\ connected s /\ x IN s /\ y IN s ==> c s x y`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN REWRITE_TAC[IN] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_FORALL_THM] THEN MAP_EVERY EXISTS_TAC [`c (s:real^N->bool) (x:real^N):real^N->bool`; `s DIFF (c (s:real^N->bool) (x:real^N))`] THEN MATCH_MP_TAC(TAUT `a /\ b /\ c /\ d /\ e /\ (f ==> g) ==> ~(a /\ b /\ c /\ d /\ e /\ ~f) ==> g`) THEN REPEAT CONJ_TAC THENL [MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool` OPEN_GENERAL_COMPONENT) THEN ASM_MESON_TAC[]; MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool` OPEN_NON_GENERAL_COMPONENT) THEN ASM_MESON_TAC[]; SET_TAC[]; SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN FIRST_ASSUM(MATCH_MP_TAC o SPECL [`ball(x:real^N,e)`; `s:real^N->bool`]) THEN ASM_MESON_TAC[CENTRE_IN_BALL]);; (* ------------------------------------------------------------------------- *) (* Some useful lemmas about path-connectedness. *) (* ------------------------------------------------------------------------- *) let CONVEX_IMP_PATH_CONNECTED = prove (`!s:real^N->bool. convex s ==> path_connected s`, REWRITE_TAC[CONVEX_ALT; path_connected] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `\u. (&1 - drop u) % x + drop u % y:real^N` THEN ASM_SIMP_TAC[pathstart; pathfinish; DROP_VEC; path; path_image; SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN VECTOR_ARITH_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; let PATH_CONNECTED_UNIV = prove (`path_connected(:real^N)`, SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV]);; let IS_INTERVAL_PATH_CONNECTED = prove (`!s. is_interval s ==> path_connected s`, SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; IS_INTERVAL_CONVEX]);; let PATH_CONNECTED_INTERVAL = prove (`(!a b:real^N. path_connected(interval[a,b])) /\ (!a b:real^N. path_connected(interval(a,b)))`, SIMP_TAC[IS_INTERVAL_PATH_CONNECTED; IS_INTERVAL_INTERVAL]);; let PATH_COMPONENT_UNIV = prove (`!x. path_component(:real^N) x = (:real^N)`, MESON_TAC[PATH_CONNECTED_COMPONENT_SET; PATH_CONNECTED_UNIV; IN_UNIV]);; let PATH_CONNECTED_IMP_CONNECTED = prove (`!s:real^N->bool. path_connected s ==> connected s`, GEN_TAC THEN REWRITE_TAC[path_connected; CONNECTED_IFF_CONNECTED_COMPONENT] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `path_image(g:real^1->real^N)` THEN ASM_MESON_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]);; let OPEN_PATH_COMPONENT = prove (`!s x:real^N. open s ==> open(path_component s x)`, MATCH_MP_TAC OPEN_GENERAL_COMPONENT THEN REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS; PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT] (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);; let OPEN_NON_PATH_COMPONENT = prove (`!s x:real^N. open s ==> open(s DIFF path_component s x)`, MATCH_MP_TAC OPEN_NON_GENERAL_COMPONENT THEN REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS; PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT] (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);; let PATH_CONNECTED_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ path_connected s ==> path_connected (IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[path_connected] THEN STRIP_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) o (g:real^1->real^M)` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);; let HOMEOMORPHIC_PATH_CONNECTEDNESS = prove (`!s t. s homeomorphic t ==> (path_connected s <=> path_connected t)`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);; let PATH_CONNECTED_LINEAR_IMAGE = prove (`!f:real^M->real^N s. path_connected s /\ linear f ==> path_connected(IMAGE f s)`, SIMP_TAC[LINEAR_CONTINUOUS_ON; PATH_CONNECTED_CONTINUOUS_IMAGE]);; let PATH_CONNECTED_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (path_connected (IMAGE f s) <=> path_connected s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE PATH_CONNECTED_LINEAR_IMAGE));; add_linear_invariants [PATH_CONNECTED_LINEAR_IMAGE_EQ];; let HOMEOMORPHISM_PATH_CONNECTEDNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (path_connected(IMAGE f k) <=> path_connected k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PATH_CONNECTEDNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let PATH_CONNECTED_EMPTY = prove (`path_connected {}`, REWRITE_TAC[path_connected; NOT_IN_EMPTY]);; let PATH_CONNECTED_SING = prove (`!a:real^N. path_connected {a}`, GEN_TAC THEN REWRITE_TAC[path_connected; IN_SING] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `linepath(a:real^N,a)` THEN ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[SEGMENT_REFL; PATH_IMAGE_LINEPATH; SUBSET_REFL]);; let PATH_CONNECTED_UNION = prove (`!s t. path_connected s /\ path_connected t /\ ~(s INTER t = {}) ==> path_connected (s UNION t)`, REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN REWRITE_TAC[IN_INTER; IN_UNION] THEN MESON_TAC[PATH_COMPONENT_OF_SUBSET; SUBSET_UNION; PATH_COMPONENT_TRANS]);; let PATH_CONNECTED_UNIONS = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> path_connected s) /\ ~(INTERS f = {}) ==> path_connected(UNIONS f)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `a:real^N` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN UNDISCH_TAC `(x:real^N) IN UNIONS f`; UNDISCH_TAC `(y:real^N) IN UNIONS f`] THEN REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THENL [DISCH_THEN(MP_TAC o SPEC `x:real^N`); DISCH_THEN(MP_TAC o SPEC `y:real^N`)] THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s x ==> t x`) THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC PATH_COMPONENT_MONO THEN ASM SET_TAC[]);; let PATH_CONNECTED_TRANSLATION = prove (`!a s. path_connected s ==> path_connected (IMAGE (\x:real^N. a + x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; let PATH_CONNECTED_TRANSLATION_EQ = prove (`!a s. path_connected (IMAGE (\x:real^N. a + x) s) <=> path_connected s`, REWRITE_TAC[path_connected] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [PATH_CONNECTED_TRANSLATION_EQ];; let PATH_CONNECTED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. path_connected s /\ path_connected t ==> path_connected (s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; path_connected] THEN DISCH_TAC THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`]) (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN EXISTS_TAC `(\t. pastecart (x1:real^M) ((h:real^1->real^N) t)) ++ (\t. pastecart ((g:real^1->real^M) t) (y2:real^N))` THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path]) THEN RULE_ASSUM_TAC(REWRITE_RULE[path_image; FORALL_IN_IMAGE; SUBSET]) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_JOIN_IMP THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST]; REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST]; ASM_REWRITE_TAC[pathstart; pathfinish]]; MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[path_image; FORALL_IN_IMAGE; SUBSET; IN_ELIM_PASTECART_THM]; REWRITE_TAC[PATHSTART_JOIN] THEN ASM_REWRITE_TAC[pathstart]; REWRITE_TAC[PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[pathfinish]]);; let PATH_CONNECTED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. path_connected(s PCROSS t) <=> s = {} \/ t = {} \/ path_connected s /\ path_connected t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let PATH_COMPONENT_PCROSS = prove (`!s t a:real^M b:real^N. path_component (s PCROSS t) (pastecart a b) = path_component s a PCROSS path_component t b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^M) IN s /\ (b:real^N) IN t` THENL [MATCH_MP_TAC PATH_COMPONENT_UNIQUE THEN REWRITE_TAC[PASTECART_IN_PCROSS; SUBSET_PCROSS; PATH_CONNECTED_PCROSS_EQ] THEN REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN] THEN ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN X_GEN_TAC `c:real^(M,N)finite_sum->bool` THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN REWRITE_TAC[IN] THEN REWRITE_TAC[PATH_COMPONENT] THEN CONJ_TAC THENL [EXISTS_TAC `IMAGE fstcart (c:real^(M,N)finite_sum->bool)`; EXISTS_TAC `IMAGE sndcart (c:real^(M,N)finite_sum->bool)`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PASTECART; EXISTS_PASTECART; IN_IMAGE] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN REWRITE_TAC[PCROSS_EQ_EMPTY; PATH_COMPONENT_EQ_EMPTY] THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[]]);; let PATH_CONNECTED_SCALING = prove (`!s:real^N->bool c. path_connected s ==> path_connected (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let PATH_CONNECTED_SCALING_EQ = prove (`!s:real^N->bool c. path_connected (IMAGE (\x. c % x) s) <=> c = &0 \/ path_connected s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[PATH_CONNECTED_SING; PATH_CONNECTED_EMPTY]; EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP PATH_CONNECTED_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let PATH_CONNECTED_AFFINITY_EQ = prove (`!s m c:real^N. path_connected (IMAGE (\x. m % x + c) s) <=> m = &0 \/ path_connected s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; PATH_CONNECTED_TRANSLATION_EQ; PATH_CONNECTED_SCALING_EQ; IMAGE_o]);; let PATH_CONNECTED_AFFINITY = prove (`!s m c:real^N. path_connected s ==> path_connected (IMAGE (\x. m % x + c) s)`, SIMP_TAC[PATH_CONNECTED_AFFINITY_EQ]);; let PATH_CONNECTED_NEGATIONS = prove (`!s:real^N->bool. path_connected s ==> path_connected (IMAGE (--) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let PATH_CONNECTED_SUMS = prove (`!s t:real^N->bool. path_connected s /\ path_connected t ==> path_connected {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PATH_CONNECTED_PCROSS) THEN DISCH_THEN(MP_TAC o ISPEC `\z. (fstcart z + sndcart z:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] PATH_CONNECTED_CONTINUOUS_IMAGE)) THEN SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; PCROSS] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]);; let IS_INTERVAL_PATH_CONNECTED_1 = prove (`!s:real^1->bool. is_interval s <=> path_connected s`, MESON_TAC[CONVEX_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED; IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1]);; (* ------------------------------------------------------------------------- *) (* Bounds on components of a continuous image. *) (* ------------------------------------------------------------------------- *) let CARD_LE_PATH_COMPONENTS = prove (`!f:real^M->real^N s. f continuous_on s ==> {path_component (IMAGE f s) y | y | y IN IMAGE f s} <=_c {path_component s x | x | x IN s}`, REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC `\c. path_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[PATH_COMPONENT] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (path_component s x)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT]; MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[PATH_COMPONENT_SUBSET]; ALL_TAC; ALL_TAC] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN ASM_MESON_TAC[PATH_COMPONENT_REFL_EQ]);; let CARD_LE_CONNECTED_COMPONENTS = prove (`!f:real^M->real^N s. f continuous_on s ==> {connected_component (IMAGE f s) y | y | y IN IMAGE f s} <=_c {connected_component s x | x | x IN s}`, REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC `\c. connected_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[connected_component] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (connected_component s x)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT]; MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC; ALL_TAC] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_REFL_EQ]);; let CARD_LE_COMPONENTS = prove (`!f:real^M->real^N s. f continuous_on s ==> components(IMAGE f s) <=_c components s`, REWRITE_TAC[components; CARD_LE_CONNECTED_COMPONENTS]);; (* ------------------------------------------------------------------------- *) (* More stuff about segments. *) (* ------------------------------------------------------------------------- *) let PATH_CONNECTED_SEGMENT = prove (`(!a b. path_connected(segment[a,b])) /\ (!a b. path_connected(segment(a,b)))`, SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEGMENT]);; let PATH_CONNECTED_SEMIOPEN_SEGMENT = prove (`(!a b:real^N. path_connected(segment[a,b] DELETE a)) /\ (!a b:real^N. path_connected(segment[a,b] DELETE b))`, SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);; let SUBSET_CONTINUOUS_IMAGE_SEGMENT_1 = prove (`!f:real^N->real^1 a b. f continuous_on segment[a,b] ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONNECTED_CONTINUOUS_IMAGE)) THEN REWRITE_TAC[CONNECTED_SEGMENT] THEN REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1] THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN MESON_TAC[IN_IMAGE; ENDS_IN_SEGMENT]);; let CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1 = prove (`!f:real^N->real^1 a b. f continuous_on segment[a,b] /\ (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y) ==> IMAGE f (segment[a,b]) = segment[f a,f b]`, let lemma = prove (`!a b c:real^1. ~(a = b) /\ ~(a IN segment(c,b)) /\ ~(b IN segment(a,c)) ==> c IN segment[a,b]`, REWRITE_TAC[FORALL_LIFT; SEGMENT_1; LIFT_DROP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1; LIFT_EQ] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP]) THEN ASM_REAL_ARITH_TAC) in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^1->real^N`; `segment[a:real^N,b]`] CONTINUOUS_ON_INVERSE) THEN ASM_REWRITE_TAC[COMPACT_SEGMENT] THEN DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUBSET_CONTINUOUS_IMAGE_SEGMENT_1]; DISCH_TAC] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL] THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; DISCH_TAC] THEN ONCE_REWRITE_TAC[segment] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`f:real^N->real^1`; `c:real^N`; `b:real^N`] SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN SUBGOAL_THEN `segment[c:real^N,b] SUBSET segment[a,b]` ASSUME_TAC THENL [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) a`) THEN ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = a` THENL [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT]; ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]; MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `c:real^N`] SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN SUBGOAL_THEN `segment[a:real^N,c] SUBSET segment[a,b]` ASSUME_TAC THENL [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) b`) THEN ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = b` THENL [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT; BETWEEN_SYM]; ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]]);; let CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1 = prove (`!f:real^N->real^1 a b. f continuous_on segment[a,b] /\ (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y) ==> IMAGE f (segment(a,b)) = segment(f a,f b)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[segment] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN MP_TAC(ISPECL [`(f:real^N->real^1) a`; `(f:real^1->real^1) b`] ENDS_IN_SEGMENT) THEN ASM SET_TAC[]);; let CONTINUOUS_IVT_LOCAL_EXTREMUM = prove (`!f:real^N->real^1 a b. f continuous_on segment[a,b] /\ ~(a = b) /\ f(a) = f(b) ==> ?z. z IN segment(a,b) /\ ((!w. w IN segment[a,b] ==> drop(f w) <= drop(f z)) \/ (!w. w IN segment[a,b] ==> drop(f z) <= drop(f w)))`, REPEAT STRIP_TAC THEN MAP_EVERY (MP_TAC o ISPECL [`drop o (f:real^N->real^1)`; `segment[a:real^N,b]`]) [CONTINUOUS_ATTAINS_SUP; CONTINUOUS_ATTAINS_INF] THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN REWRITE_TAC[COMPACT_SEGMENT; SEGMENT_EQ_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `(d:real^N) IN segment(a,b)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `(c:real^N) IN segment(a,b)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `midpoint(a:real^N,b)` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT]; DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONJUNCT2 segment]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [segment])) THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT(DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]);; let FRONTIER_UNIONS_SUBSET_CLOSURE = prove (`!f:(real^N->bool)->bool. frontier(UNIONS f) SUBSET closure(UNIONS {frontier t | t IN f})`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN REWRITE_TAC[SUBSET; IN_DIFF; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[EXISTS_IN_UNIONS; EXISTS_IN_GSPEC; RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN ASM_CASES_TAC `(t:real^N->bool) IN f` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(x:real^N) IN t` THENL [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[frontier; DIST_REFL; IN_DIFF] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN SPEC_TAC(`x:real^N`,`z:real^N`) THEN REWRITE_TAC[CONTRAPOS_THM; GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`segment[x:real^N,y]`; `t:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM; REAL_LET_TRANS]]);; let FRONTIER_UNIONS_SUBSET = prove (`!f:(real^N->bool)->bool. FINITE f ==> frontier(UNIONS f) SUBSET UNIONS {frontier t | t IN f}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `s SUBSET closure t /\ closure t = t ==> s SUBSET t`) THEN REWRITE_TAC[FRONTIER_UNIONS_SUBSET_CLOSURE; CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE; FRONTIER_CLOSED]);; let CLOSURE_CONVEX_INTER_AFFINE = prove (`!s t:real^N->bool. convex s /\ affine t /\ ~(relative_interior s INTER t = {}) ==> closure(s INTER t) = closure(s) INTER t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]; TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; CLOSED_AFFINE; SUBSET_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_INTER] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN_INTER]; ALL_TAC] THEN SUBGOAL_THEN `x IN closure(segment(vec 0:real^N,x))` MP_TAC THENL [ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `relative_interior s:real^N->bool` THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[SUBSET; IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID; SUBSPACE_MUL; LEFT_IMP_EXISTS_THM]]);; let RELATIVE_FRONTIER_CONVEX_INTER_AFFINE = prove (`!s t:real^N->bool. convex s /\ affine t /\ ~(interior s INTER t = {}) ==> relative_frontier(s INTER t) = frontier s INTER t`, SIMP_TAC[relative_frontier; RELATIVE_INTERIOR_CONVEX_INTER_AFFINE; frontier] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(relative_interior s INTER t:real^N->bool = {})` ASSUME_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN ASM SET_TAC[]; ASM_SIMP_TAC[CLOSURE_CONVEX_INTER_AFFINE] THEN SET_TAC[]]);; let CONNECTED_COMPONENT_1_GEN = prove (`!s a b:real^N. dimindex(:N) = 1 ==> (connected_component s a b <=> segment[a,b] SUBSET s)`, SIMP_TAC[connected_component; GSYM CONNECTED_CONVEX_1_GEN] THEN MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET; CONVEX_SEGMENT; ENDS_IN_SEGMENT]);; let CONNECTED_COMPONENT_1 = prove (`!s a b:real^1. connected_component s a b <=> segment[a,b] SUBSET s`, SIMP_TAC[CONNECTED_COMPONENT_1_GEN; DIMINDEX_1]);; let HOMEOMORPHIC_SEGMENTS = prove (`(!a b:real^M c d:real^N. segment[a,b] homeomorphic segment[c,d] <=> (a = b <=> c = d)) /\ (!a b:real^M c d:real^N. ~(segment[a,b] homeomorphic segment(c,d))) /\ (!a b:real^M c d:real^N. ~(segment(a,b) homeomorphic segment[c,d])) /\ (!a b:real^M c d:real^N. segment(a,b) homeomorphic segment(c,d) <=> (a = b <=> c = d))`, let lemma = prove (`!a b:real^N. (\u:real^1. (&1 - drop u) % a + drop u % b) = (\u. a + u) o (\u. drop u % (b - a))`, REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC) in ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (q /\ r) /\ (p /\ s)`] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN REWRITE_TAC[COMPACT_SEGMENT] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[SEGMENT_REFL; HOMEOMORPHIC_EMPTY; SEGMENT_EQ_EMPTY]; REPEAT STRIP_TAC THEN (EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_FINITENESS) THEN REWRITE_TAC[FINITE_SEGMENT]; ASM_CASES_TAC `c:real^N = d` THEN ASM_SIMP_TAC[SEGMENT_REFL; HOMEOMORPHIC_SING; HOMEOMORPHIC_EMPTY] THEN DISCH_TAC])] THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL [TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]`; TRANS_TAC HOMEOMORPHIC_TRANS `interval(vec 0:real^1,vec 1)`] THEN (CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]]) THEN REWRITE_TAC[lemma; IMAGE_o; HOMEOMORPHIC_TRANSLATION_LEFT_EQ] THEN W(MP_TAC o PART_MATCH (lhand o rand) HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ o snd) THEN REWRITE_TAC[HOMEOMORPHIC_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[LINEAR_VMUL_DROP; LINEAR_ID; VECTOR_MUL_RCANCEL] THEN ASM_REWRITE_TAC[DROP_EQ; VECTOR_SUB_EQ]);; let HOMEOMORPHISM_SEGMENT = prove (`!a b:real^N. ~(a = b) ==> ?h. homeomorphism (interval[vec 0:real^1,vec 1],segment[a,b]) ((\t. (&1 - drop t) % a + drop t % b),h)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL; GSYM SEGMENT_IMAGE_INTERVAL] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST; LIFT_DROP; CONTINUOUS_ON_ID; LIFT_SUB; CONTINUOUS_ON_SUB]; REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=> (x - y) % (a - b) = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ; DROP_EQ]]);; let CONNECTED_SUBSET_SEGMENT = prove (`!s a b:real^N. connected s /\ s SUBSET segment[a,b] /\ a IN s /\ b IN s ==> s = segment[a,b]`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THENL [ASM_REWRITE_TAC[SEGMENT_REFL] THEN SET_TAC[]; STRIP_TAC] THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_SEGMENT) THEN ABBREV_TAC `g = \x. (&1 - drop x) % a + drop x % (b:real^N)` THEN REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^1` THEN SUBGOAL_THEN `(g:real^1->real^N)(vec 0) = a /\ g(vec 1) = b` MP_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[DROP_VEC] THEN CONV_TAC VECTOR_ARITH; FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REPEAT STRIP_TAC] THEN SUBGOAL_THEN `IMAGE (h:real^N->real^1) (segment[a,b]) SUBSET IMAGE h s` MP_TAC THENL [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTERVAL_SUBSET_IS_INTERVAL o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `vec 0 IN interval[vec 0:real^1,vec 1] /\ vec 1 IN interval[vec 0:real^1,vec 1]` MP_TAC THENL [REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN ASM SET_TAC[]);; let DIAMETER_SEGMENT = prove (`(!a b:real^N. diameter(segment[a,b]) = dist(a,b)) /\ (!a b:real^N. diameter(segment(a,b)) = dist(a,b))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; DIST_REFL; DIAMETER_SING; DIAMETER_EMPTY] THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM DIAMETER_CLOSURE] THEN ASM_REWRITE_TAC[CLOSURE_SEGMENT]] THEN (REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC DIAMETER_LE; REWRITE_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND]) THEN REWRITE_TAC[BOUNDED_SEGMENT; ENDS_IN_SEGMENT; DIST_POS_LE] THEN REWRITE_TAC[GSYM dist; DIST_IN_CLOSED_SEGMENT_2]);; (* ------------------------------------------------------------------------- *) (* Removing points from arcs and simple paths, hence allowing us to *) (* distinguish simple closed curves and arcs topologically. *) (* ------------------------------------------------------------------------- *) let SIMPLE_PATH_ENDLESS = prove (`!c:real^1->real^N. simple_path c ==> path_image c DIFF {pathstart c,pathfinish c} = IMAGE c (interval(vec 0,vec 1))`, REWRITE_TAC[simple_path; path_image; pathstart; pathfinish] THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `(!x y. x IN s /\ y IN s /\ c x = c y ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a) /\ a IN s /\ b IN s ==> IMAGE c s DIFF {c a,c b} = IMAGE c (s DIFF {a,b})`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);; let CONNECTED_SIMPLE_PATH_ENDLESS = prove (`!c:real^1->real^N. simple_path c ==> connected(path_image c DIFF {pathstart c,pathfinish c})`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLE_PATH_ENDLESS] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN SIMP_TAC[CONVEX_INTERVAL; CONVEX_CONNECTED] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN RULE_ASSUM_TAC(REWRITE_RULE[simple_path; path]) THEN ASM_REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]);; let NONEMPTY_SIMPLE_PATH_ENDLESS = prove (`!c:real^1->real^N. simple_path c ==> ~(path_image c DIFF {pathstart c,pathfinish c} = {})`, SIMP_TAC[SIMPLE_PATH_ENDLESS; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY_1] THEN REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);; let CONNECTED_ARC_IMAGE_DELETE = prove (`!g a:real^N. arc g /\ a IN path_image g ==> (connected(path_image g DELETE a) <=> a IN {pathstart g,pathfinish g})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_ARC) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [path_image]) THEN REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN TRANS_TAC EQ_TRANS `connected(IMAGE (h:real^N->real^1) (path_image g DELETE a))` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`h:real^N->real^1`; `g:real^1->real^N`] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[HOMEOMORPHISM_SYM]) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC EQ_TRANS `connected(interval[vec 0:real^1,vec 1] DELETE t)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; REWRITE_TAC[pathstart; pathfinish]] THEN TRANS_TAC EQ_TRANS `t IN {vec 0:real^1,vec 1}` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1]; EXPAND_TAC "a" THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> (!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) /\ a IN s /\ b IN s ==> (x IN {a,b} <=> g x IN {g a,g b})`)) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `vec 1:real^1`; `t:real^1`]) THEN ASM_REWRITE_TAC[GSYM IN_INTERVAL_1; IN_DELETE; ENDS_IN_UNIT_INTERVAL] THEN SET_TAC[]; REWRITE_TAC[IN_DELETE; IN_INSERT; NOT_IN_EMPTY; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC]);; let CONNECTED_SIMPLE_PATH_IMAGE_DELETE = prove (`!g a:real^N. simple_path g /\ pathfinish g = pathstart g ==> connected(path_image g DELETE a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN path_image g` THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`; CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(ISPEC `shiftpath t (g:real^1->real^N)` CONNECTED_SIMPLE_PATH_ENDLESS) THEN ASM_SIMP_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH] THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`]);; let HOMEOMORPHIC_SIMPLE_PATH_ARC = prove (`!g:real^1->real^M h:real^1->real^N. arc g /\ simple_path h /\ (path_image g) homeomorphic (path_image h) ==> arc h`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[ARC_SIMPLE_PATH] THEN DISCH_TAC THEN SUBGOAL_THEN `?a:real^M. a IN path_image g /\ ~connected(path_image g DELETE a)` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[CONNECTED_ARC_IMAGE_DELETE; TAUT `p /\ ~q <=> ~(p ==> q)`] THEN REWRITE_TAC[path_image; NOT_IMP; EXISTS_IN_IMAGE] THEN EXISTS_TAC `lift(&1 / &2)` THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[IN_INSERT; pathstart; pathfinish; NOT_IN_EMPTY] THEN REWRITE_TAC[DE_MORGAN_THM] THEN FIRST_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[arc]) THEN ONCE_REWRITE_TAC[SET_RULE `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN DISCH_TAC THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`i:real^M->real^N`; `j:real^N->real^M`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`h:real^1->real^N`; `(i:real^M->real^N) a`] CONNECTED_SIMPLE_PATH_IMAGE_DELETE) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`i:real^M->real^N`; `j:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHIC_SIMPLE_PATH_ARC_EQ = prove (`!g:real^1->real^M h:real^1->real^N. simple_path g /\ simple_path h /\ (path_image g) homeomorphic (path_image h) ==> (arc g <=> arc h)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MP_TAC(ISPECL [`g:real^1->real^M`; `h:real^1->real^N`] HOMEOMORPHIC_SIMPLE_PATH_ARC); MP_TAC(ISPECL [`h:real^1->real^N`; `g:real^1->real^M`] HOMEOMORPHIC_SIMPLE_PATH_ARC)] THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; let ARC_ENDS_UNIQUE = prove (`!g h:real^1->real^N. arc g /\ simple_path h /\ path_image g = path_image h ==> {pathstart g, pathfinish g} = {pathstart h, pathfinish h}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^N`; `h:real^1->real^N`] HOMEOMORPHIC_SIMPLE_PATH_ARC) THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `{x:real^N | x IN path_image g /\ connected(path_image g DELETE x)}` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s /\ (!x. x IN s ==> (P x <=> x IN {a,b})) ==> {x | x IN s /\ P x} = {a,b}`) THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE] THEN ASM_SIMP_TAC[CONNECTED_ARC_IMAGE_DELETE]);; let ARC_HOMEOMORPHISM_ENDS = prove (`!g h f f':real^N->real^N. homeomorphism (path_image g,path_image h) (f,f') /\ arc g /\ arc h ==> f(pathstart g) = pathstart h /\ f(pathfinish g) = pathfinish h /\ f'(pathstart h) = pathstart g /\ f'(pathfinish h) = pathfinish g \/ f(pathstart g) = pathfinish h /\ f(pathfinish g) = pathstart h /\ f'(pathstart h) = pathfinish g /\ f'(pathfinish h) = pathstart g`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:real^N->real^N) o (g:real^1->real^N)`; `h:real^1->real^N`] ARC_ENDS_UNIQUE) THEN ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ANTS_TAC THENL [ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH] THEN MATCH_MP_TAC ARC_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE; SET_RULE `{a,b} = {a',b'} <=> a = a' /\ b = b' \/ a = b' /\ b = a'`] THEN MATCH_MP_TAC MONO_OR THEN SIMP_TAC[] THEN CONJ_TAC THEN DISCH_THEN(CONJUNCTS_THEN(SUBST1_TAC o SYM)) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]);; let HOMEOMORPHISM_ARC_IMAGES = prove (`!g:real^1->real^M h:real^1->real^N. arc g /\ arc h ==> ?f f'. homeomorphism (path_image g,path_image h) (f,f') /\ f(pathstart g) = pathstart h /\ f(pathfinish g) = pathfinish h /\ f'(pathstart h) = pathstart g /\ f'(pathfinish h) = pathfinish g`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHISM_ARC) THEN MP_TAC(ISPEC `g:real^1->real^M` HOMEOMORPHISM_ARC) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g':real^M->real^1` THEN STRIP_TAC THEN X_GEN_TAC `h':real^N->real^1` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(h:real^1->real^N) o (g':real^M->real^1)`; `(g:real^1->real^M) o (h':real^N->real^1)`] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM_SIMP_TAC[o_THM; pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]]);; let COLLINEAR_SIMPLE_PATH_IMAGE = prove (`!g:real^1->real^N. simple_path g /\ collinear(path_image g) ==> path_image g = segment[pathstart g,pathfinish g]`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `path_image g:real^N->bool` COMPACT_CONVEX_COLLINEAR_SEGMENT) THEN ASM_SIMP_TAC[CONVEX_CONNECTED_COLLINEAR; CONNECTED_PATH_IMAGE; COMPACT_PATH_IMAGE; PATH_IMAGE_NONEMPTY; SIMPLE_PATH_IMP_PATH] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[SEGMENT_EQ] THEN MP_TAC(ISPECL [`linepath(a:real^N,b)`; `g:real^1->real^N`] ARC_ENDS_UNIQUE) THEN ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC ARC_LINEPATH THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN RULE_ASSUM_TAC(REWRITE_RULE[SEGMENT_REFL]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP NONEMPTY_SIMPLE_PATH_ENDLESS) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s = {a} ==> x IN s ==> {a} DIFF {x,y} = {}`)) THEN REWRITE_TAC[PATHSTART_IN_PATH_IMAGE]);; (* ------------------------------------------------------------------------- *) (* An injective function into R is a homeomorphism and so an open map. *) (* ------------------------------------------------------------------------- *) let INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM = prove (`!f:real^N->real^1 s. f continuous_on s /\ path_connected s ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> ?g. homeomorphism (s,IMAGE f s) (f,g))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE]; REWRITE_TAC[homeomorphism] THEN MESON_TAC[]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[homeomorphism; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `is_interval (IMAGE (f:real^N->real^1) s)` ASSUME_TAC THENL [REWRITE_TAC[IS_INTERVAL_PATH_CONNECTED_1] THEN ASM_MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]; ALL_TAC] THEN REWRITE_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ABBREV_TAC `y = (f:real^N->real^1) x` THEN ABBREV_TAC `t = IMAGE (f:real^N->real^1) s` THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?a b d. a IN s /\ b IN s /\ &0 < d /\ ball(y,d) INTER t SUBSET segment[(f:real^N->real^1) a,f b]` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`t:real^1->bool`; `y:real^1`] INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN REWRITE_TAC[SET_RULE `P /\ y IN s /\ (s = {} \/ a IN t /\ b IN t) /\ R <=> a IN t /\ b IN t /\ P /\ y IN s /\ R`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN EXPAND_TAC "t" THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN REWRITE_TAC[SEGMENT_1; IN_INTERVAL_1] THEN MESON_TAC[REAL_LE_TRANS]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(g:real^1->real^N) continuous_on segment[(f:real^N->real^1) a,f b]` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `IMAGE (f:real^N->real^1) (path_image p)` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; SUBGOAL_THEN `convex(IMAGE (f:real^N->real^1) (path_image p))` MP_TAC THENL [REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; IS_INTERVAL_CONNECTED_1] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]]; REWRITE_TAC[continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x':real^N` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_INTER; IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM SET_TAC[]]]);; let INJECTIVE_INTO_1D_IMP_OPEN_MAP = prove (`!f:real^N->real^1 s t. f continuous_on s /\ path_connected s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ open_in (subtopology euclidean s) t ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM]);; let HOMEOMORPHISM_INTO_1D = prove (`!f:real^N->real^1 s t. path_connected s /\ f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ?g. homeomorphism(s,t) (f,g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Injective function on an interval is strictly increasing or decreasing. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove (`!f:real^1->real^1 s. f continuous_on s /\ is_interval s ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> (!x y. x IN s /\ y IN s /\ drop x < drop y ==> drop(f x) < drop(f y)) \/ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> drop(f y) < drop(f x)))`, let lemma = prove (`!s f:real^1->real^1. f continuous_on s /\ is_interval s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> !u v w. u IN s /\ v IN s /\ w IN s /\ drop u < drop v /\ drop v < drop w /\ drop(f u) <= drop(f v) /\ drop(f w) <= drop(f v) ==> F`, REWRITE_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `u:real^1`; `w:real^1`] CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) v`) THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL [MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE]; ASM_REAL_ARITH_TAC]; REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THENL [SUBGOAL_THEN `drop(f(w:real^1)) = drop(f v)` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]; SUBGOAL_THEN `drop(f(u:real^1)) = drop(f v)` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]]]) and tac s1 s2 = let [l1;l2] = map (map (fun x -> mk_var(x,`:real^1`)) o explode) [s1;s2] in REPEAT(FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL l1 th) THEN MP_TAC(ISPECL l2 th))) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC in REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM DROP_EQ] THEN MESON_TAC[REAL_LT_TOTAL; REAL_LT_REFL]] THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[] `(!a b c d. ~(~P a b /\ ~Q c d)) ==> (!x y. P x y) \/ (!x y. Q x y)`) THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN STRIP_TAC THEN REPEAT (FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_LE_LT]) THEN REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]]) THEN MP_TAC(ISPEC `s:real^1->bool` lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `(--) o (f:real^1->real^1)` th) THEN MP_TAC(SPEC `f:real^1->real^1` th)) THEN ASM_REWRITE_TAC[o_THM; VECTOR_ARITH `--x:real^N = --y <=> x = y`] THEN DISCH_TAC THEN REWRITE_TAC[NOT_IMP; DROP_NEG; REAL_LE_NEG2] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE;LINEAR_CONTINUOUS_ON; LINEAR_NEGATION]; DISCH_TAC] THEN ASM_CASES_TAC `drop d <= drop a` THENL [tac "cab" "cdb"; ALL_TAC] THEN ASM_CASES_TAC `drop b <= drop c` THENL [tac "abd" "acd"; ALL_TAC] THEN ASM_CASES_TAC `c:real^1 = a /\ d:real^1 = b` THENL [ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `~(c = a /\ d = b) ==> (c = a ==> d = b) /\ (d = b ==> c = a) /\ (~(c = a) /\ ~(d = b) ==> F) ==> F`)) THEN REPEAT CONJ_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "adb" "abd"; DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "acb" "cab"; REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC] THEN ASM_CASES_TAC `drop a <= drop c` THENL [tac "acb" "acd"; tac "cab" "cad"]);; let CONTINUOUS_INJECTIVE_IMP_MONOTONIC = prove (`!f s. f continuous_on s /\ is_interval s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (!x y. x IN s /\ y IN s ==> (drop(f x) < drop(f y) <=> drop x < drop y)) \/ (!x y. x IN s /\ y IN s ==> (drop(f x) < drop(f y) <=> drop y < drop x))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC th THEN ASM_SIMP_TAC[CONTINUOUS_INJECTIVE_IFF_MONOTONIC] THEN ASSUME_TAC(REWRITE_RULE[INJECTIVE_ON_ALT] th)) THEN MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_MESON_TAC[DROP_EQ]);; let HOMEOMORPHISM_1D_IMP_MONOTONIC = prove (`!f g s t. homeomorphism(s,t) (f,g) /\ is_interval s ==> (!x y. x IN s /\ y IN s ==> (drop(f x) < drop(f y) <=> drop x < drop y)) /\ (!x y. x IN t /\ y IN t ==> (drop(g x) < drop(g y) <=> drop x < drop y)) \/ (!x y. x IN s /\ y IN s ==> (drop(f x) < drop(f y) <=> drop y < drop x)) /\ (!x y. x IN t /\ y IN t ==> (drop(g x) < drop(g y) <=> drop y < drop x))`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`] CONTINUOUS_INJECTIVE_IMP_MONOTONIC) THEN ASM_REWRITE_TAC[] THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC]) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[EXTENSION; IN_IMAGE]) THEN ASM_MESON_TAC[REAL_LT_ANTISYM]);; (* ------------------------------------------------------------------------- *) (* Topological rendering of Darboux continuity, proof it implies continuity *) (* for a regulated function from R^1 (having left and right limits). *) (* ------------------------------------------------------------------------- *) let CONVEXITY_PRESERVING = prove (`!f:real^M->real^N s. (!c. c SUBSET s /\ convex c ==> convex(IMAGE f c)) <=> (!a b. segment[a,b] SUBSET s ==> convex(IMAGE f (segment[a,b])))`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONVEX_SEGMENT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; FORALL_IN_IMAGE_2] THEN ASM_SIMP_TAC[GSYM CONVEX_CONTAINS_SEGMENT_IMP] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_CONTAINS_SEGMENT_IMP) THEN DISCH_THEN(MP_TAC o SPECL [`(f:real^M->real^N) a`; `(f:real^M->real^N) b`]) THEN SIMP_TAC[FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN ASM SET_TAC[]);; let CONVEXITY_PRESERVING_ALT = prove (`!f:real^M->real^N s. (!c. c SUBSET s /\ convex c ==> convex(IMAGE f c)) <=> (!a b. segment[a,b] SUBSET s ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b]))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN SIMP_TAC[FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CONVEX_SEGMENT]; REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; FORALL_IN_IMAGE_2] THEN ASM_SIMP_TAC[GSYM CONVEX_CONTAINS_SEGMENT_IMP] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN ASM SET_TAC[]]);; let DARBOUX_AND_REGULATED_IMP_CONTINUOUS = prove (`!f:real^1->real^N s. is_interval s /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\ (!a. a IN s ==> (?l. (f --> l) (at a within s INTER {x | drop x <= drop a})) /\ (?r. (f --> r) (at a within s INTER {x | drop a <= drop x}))) ==> f continuous_on s`, SUBGOAL_THEN `!f:real^1->real^1 s. is_interval s /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\ (!a. a IN s ==> (?l. (f --> l) (at a within s INTER {x | drop x <= drop a})) /\ (?r. (f --> r) (at a within s INTER {x | drop a <= drop x}))) ==> f continuous_on s` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `c:real^1->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `(\x. lift(((f:real^1->real^N) x)$i)) = (\x. lift(x$i)) o f` (fun th -> ONCE_REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF]; REWRITE_TAC[IMAGE_o]] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT]; X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN EXISTS_TAC `lift((y:real^N)$i)` THEN ASM_SIMP_TAC[LIM_COMPONENT]]] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON] THEN X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[TWO_SIDED_LIMIT_WITHIN] THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `m:real^1` MP_TAC) THEN MATCH_MP_TAC(MESON[LIM] `(~trivial_limit net /\ (f --> l) net ==> m = l) ==> (f --> l) net ==> (f --> m) net`) THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `~(&0 < norm(x - y:real^N)) ==> x = y`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^1) a - m) / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; IN_INTER; IN_ELIM_THM; GSYM DIST_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; GSYM DIST_NZ] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`IMAGE (f:real^1->real^1) (segment(a,b))`; `(f:real^1->real^1) a`] CONNECTED_INSERT) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; SEGMENT_EQ_EMPTY] THEN MATCH_MP_TAC(TAUT `(p /\ q) /\ ~r ==> ~(p ==> (q <=> r))`) THEN (CONJ_TAC THENL [REWRITE_TAC[GSYM(CONJUNCT2 IMAGE_CLAUSES)] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CONNECTED_INSERT; CONNECTED_SEGMENT] THEN ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT; INSERT_SUBSET] THEN ASM_MESON_TAC[CONVEX_CONTAINS_OPEN_SEGMENT; IS_INTERVAL_CONVEX_1]; DISCH_THEN(MP_TAC o SPEC `closure(ball(m,norm((f:real^1->real^1) a - m) / &2))` o MATCH_MP(SET_RULE `a IN s ==> !t. s SUBSET t ==> a IN t`)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN TRY(RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN ASM_REAL_ARITH_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; IN_BALL] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM DROP_EQ; DIST_1; GSYM CONJ_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_1; IS_INTERVAL_1]) THEN (CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[REAL_LT_IMP_LE]; ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; IN_CBALL] THEN MATCH_MP_TAC(NORM_ARITH `&0 < norm(y - x) ==> ~(dist(x:real^N,y) <= norm(y - x) / &2)`) THEN ASM_REWRITE_TAC[]]]));; (* ------------------------------------------------------------------------- *) (* Some handy facts about Lipschitz functions. *) (* ------------------------------------------------------------------------- *) let LIPSCHITZ_ON_UNION = prove (`!(f:real^1->real^N) s t l. is_interval s /\ is_interval t /\ ~(s INTER t = {}) /\ (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= l * norm(x - y)) /\ (!x y. x IN t /\ y IN t ==> norm(f x - f y) <= l * norm(x - y)) ==> !x y. x IN s UNION t /\ y IN s UNION t ==> norm(f x - f y) <= l * norm(x - y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[] `!Q. (!x y. P x y <=> P y x) /\ (!x y. ~Q x /\ ~Q y ==> P x y) /\ (!x y. Q x /\ Q y ==> P x y) /\ (!x y. ~Q x /\ Q y ==> P x y) ==> !x y. P x y`) THEN EXISTS_TAC `\x:real^1. x IN s` THEN ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> (x IN s UNION t <=> x IN t)`] THEN CONJ_TAC THENL [MESON_TAC[NORM_SUB]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN ASM_CASES_TAC `(y:real^1) IN t` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^1` THEN STRIP_TAC THEN MP_TAC(ISPEC `{z:real^1,x,y}` COLLINEAR_1) THEN REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [REWRITE_TAC[between; dist] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN TRANS_TAC REAL_LE_TRANS `norm((f:real^1->real^N) x - f z) + norm(f z - f y)` THEN CONJ_TAC THENL [CONV_TAC NORM_ARITH; ASM_MESON_TAC[REAL_LE_ADD2]]; RULE_ASSUM_TAC(REWRITE_RULE[IS_INTERVAL_CONVEX_1]) THEN REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]]);; let LIPSCHITZ_ON_COMBINE = prove (`!(f:real^1->real^N) a b c l. (!x y. x IN interval[a,b] /\ y IN interval[a,b] ==> norm(f x - f y) <= l * norm(x - y)) /\ (!x y. x IN interval[b,c] /\ y IN interval[b,c] ==> norm(f x - f y) <= l * norm(x - y)) ==> !x y. x IN interval[a,c] /\ y IN interval[a,c] ==> norm(f x - f y) <= l * norm(x - y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,c] = {}` THENL [ASM_MESON_TAC[NOT_IN_EMPTY]; RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1])] THEN ASM_CASES_TAC `interval[a,c] SUBSET interval[a,b] \/ interval[a:real^1,c] SUBSET interval[b,c]` THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `b IN interval[a:real^1,c]` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNION_INTERVAL_1) THEN MATCH_MP_TAC LIPSCHITZ_ON_UNION THEN ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN REWRITE_TAC[INTER_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]);; let LOCALLY_LIPSCHITZ_GEN = prove (`!f:real^M->real^N s b. convex s /\ (!x c. x IN s /\ b < c ==> eventually (\y. norm(f y - f x) <= c * norm(y - x)) (at x within s)) ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= b * norm(x - y)`, let lemma = prove (`{x | x IN s /\ !y. P x y} = s INTER INTERS {{x | x IN s /\ P x y} | y IN UNIV}`, REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN GEN_REWRITE_TAC I [REAL_LE_TRANS_LTE] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN X_GEN_TAC `c:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`x:real^M`; `y:real^M`] (CONJUNCT1 CONNECTED_SEGMENT)) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN(MP_TAC o SPEC `{z | z IN segment[x,y] /\ !t. t IN segment[x,z] ==> norm((f:real^M->real^N) t - f x) <= c * norm(t - x)}`) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`] o MATCH_MP (SET_RULE `!a b. {x | x IN s /\ P x} = {} \/ {x | x IN s /\ P x} = s ==> a IN s /\ b IN s /\ P a ==> P b`)) THEN REWRITE_TAC[ENDS_IN_SEGMENT; DIST_REFL; DIST_POS_LE] THEN REWRITE_TAC[SEGMENT_REFL; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN REWRITE_TAC[ENDS_IN_SEGMENT; NORM_SUB]] THEN CONJ_TAC THENL [REWRITE_TAC[open_in; SUBSET_RESTRICT; IN_ELIM_THM] THEN X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`z:real^M`; `c:real`]) THEN ASM_REWRITE_TAC[EVENTUALLY_WITHIN] THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `v IN segment[x:real^M,z]` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (MESON[ENDS_IN_SEGMENT] `z IN segment[x:real^M,z]`)) THEN MATCH_MP_TAC(NORM_ARITH `norm(v - z:real^N) <= d - c ==> norm(z - x) <= c ==> norm(v - x) <= d`) THEN SUBGOAL_THEN `v IN segment[x:real^M,y] /\ ~(u IN segment[x:real^M,z])` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[BETWEEN_TRANS; BETWEEN_IN_SEGMENT; BETWEEN_SYM]; ALL_TAC] THEN SUBGOAL_THEN `u IN segment[z:real^M,y] /\ v IN segment[z,y]` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`x:real^M`; `z:real^M`; `y:real^M`] UNION_SEGMENT) THEN ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `c * norm(v - z:real^M)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM DIST_NZ] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN SUBGOAL_THEN `v IN segment[z:real^M,u]` ASSUME_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(REAL_RING `z = x + y:real ==> c * x = c * z - c * y`)] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM BETWEEN_IN_SEGMENT; between]) THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; GSYM dist; between] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `{z | z IN segment [x,y] /\ !t. t IN segment[x,z] ==> norm((f:real^M->real^N) t - f x) <= c * norm (t - x)} = {z | z IN segment [x,y] /\ !t. t IN segment(x,z) ==> norm(f t - f x) <= c * norm(t - x)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:real^M` THEN ASM_CASES_TAC `z IN segment[x:real^M,y]` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `z:real^M = x` THEN ASM_REWRITE_TAC[SEGMENT_REFL; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN MP_TAC(ISPECL [`\t. lift(c * norm(t - x) - norm((f:real^M->real^N) t - f x))`; `segment(x:real^M,z)`; `{t | &0 <= drop t}`] FORALL_IN_CLOSURE_EQ) THEN ASM_REWRITE_TAC[CLOSURE_SEGMENT; IN_ELIM_THM; LIFT_DROP; REAL_SUB_LE] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CLOSED_SING; drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[LIFT_SUB; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_CMUL) THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `w:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `segment[x:real^M,y]` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT]] THEN ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; DISCH_TAC] THEN REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `abs b + &1`]) THEN REWRITE_TAC[ARITH_RULE `b < abs b + &1`] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[EVENTUALLY_WITHIN]] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (e / (abs b + &1))` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_MUL_LZERO; dist; REAL_LT_MIN; REAL_ARITH `&0 < abs b + &1`] THEN X_GEN_TAC `v:real^M` THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M`) THEN ASM_CASES_TAC `v:real^M = w` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; GSYM DIST_NZ] THEN ASM_REWRITE_TAC[dist] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; SEGMENT_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; UNIV_NOT_EMPTY; SET_RULE `{x | x IN s /\ (P x ==> Q x)} = {x | x IN s /\ ~P x} UNION {x | x IN s /\ Q x}`] THEN X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC CLOSED_IN_UNION THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P} = if P then s else {}`] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[CLOSED_IN_REFL; CLOSED_IN_EMPTY]] THEN ASM_CASES_TAC `z IN segment[x:real^M,y]` THENL [SUBGOAL_THEN `{w:real^M | w IN segment[x,y] /\ ~(z IN segment (x,w))} = {w | w IN segment[x,y] /\ (z = x \/ z IN segment[w,y])}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `w:real^M` THEN MP_TAC(ISPECL [`x:real^M`; `w:real^M`; `y:real^M`] UNION_SEGMENT) THEN ASM_CASES_TAC `w IN segment[x:real^M,y]` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:real^M` o REWRITE_RULE[EXTENSION]) THEN ASM_REWRITE_TAC[IN_UNION] THEN MP_TAC(ISPECL [`x:real^M`; `w:real^M`] SEGMENT_CLOSED_OPEN) THEN DISCH_THEN(MP_TAC o SPEC `z:real^M` o REWRITE_RULE[EXTENSION]) THEN ASM_REWRITE_TAC[IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN MAP_EVERY ASM_CASES_TAC [`z:real^M = x`; `z:real^M = w`] THEN ASM_REWRITE_TAC[ENDS_NOT_IN_SEGMENT; ENDS_IN_SEGMENT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(TAUT `~(p /\ q) ==> p \/ q ==> (~p <=> q)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM BETWEEN_IN_SEGMENT; between]) THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; GSYM dist; between] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM DIST_EQ_0; DIST_SYM] THEN REAL_ARITH_TAC; ASM_CASES_TAC `z:real^M = x` THEN ASM_REWRITE_TAC[CLOSED_IN_REFL; SET_RULE `{x | x IN s} = s`] THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN ONCE_REWRITE_TAC[REAL_ARITH `a:real = b /\ c = d <=> a = b /\ d - c = &0`] THEN REWRITE_TAC[GSYM between; BETWEEN_IN_SEGMENT] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_ADD) THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]]; MATCH_MP_TAC(MESON[CLOSED_IN_REFL] `s = t ==> closed_in (subtopology euclidean t) s`) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN X_GEN_TAC `w:real^M` THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED)) THEN ASM_MESON_TAC[BETWEEN_TRANS; BETWEEN_IN_SEGMENT; BETWEEN_SYM]]);; let LOCALLY_LIPSCHITZ = prove (`!f:real^M->real^N s b. convex s /\ (!x. x IN s ==> eventually (\y. norm(f y - f x) <= b * norm(y - x)) (at x within s)) ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= b * norm(x - y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC LOCALLY_LIPSCHITZ_GEN THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `c:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Some uncountability results for relevant sets. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_SEGMENT = prove (`(!a b:real^N. ~(a = b) ==> segment[a,b] =_c (:real)) /\ (!a b:real^N. ~(a = b) ==> segment(a,b) =_c (:real))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL [TRANS_TAC CARD_EQ_TRANS `interval[vec 0:real^1,vec 1]`; TRANS_TAC CARD_EQ_TRANS `interval(vec 0:real^1,vec 1)`] THEN SIMP_TAC[CARD_EQ_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=> (x - y) % (a - b) = vec 0`] THEN SIMP_TAC[REAL_SUB_0; DROP_EQ]);; let UNCOUNTABLE_SEGMENT = prove (`(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment[a,b])) /\ (!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment(a,b)))`, SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_SEGMENT]);; let CARD_EQ_PATH_CONNECTED = prove (`!s a b:real^N. path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, MESON_TAC[CARD_EQ_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; let UNCOUNTABLE_PATH_CONNECTED = prove (`!s a b:real^N. path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN MATCH_MP_TAC CARD_EQ_PATH_CONNECTED THEN ASM_MESON_TAC[]);; let CARD_EQ_CONVEX = prove (`!s a b:real^N. convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, MESON_TAC[CARD_EQ_PATH_CONNECTED; CONVEX_IMP_PATH_CONNECTED]);; let UNCOUNTABLE_CONVEX = prove (`!s a b:real^N. convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN MATCH_MP_TAC CARD_EQ_CONVEX THEN ASM_MESON_TAC[]);; let CARD_EQ_NONEMPTY_INTERIOR = prove (`!s:real^N->bool. ~(interior s = {}) ==> s =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN SIMP_TAC[CARD_LE_UNIV; CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN]; TRANS_TAC CARD_LE_TRANS `interior(s:real^N->bool)` THEN SIMP_TAC[CARD_LE_SUBSET; INTERIOR_SUBSET] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN MATCH_MP_TAC CARD_EQ_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]]);; let UNCOUNTABLE_NONEMPTY_INTERIOR = prove (`!s:real^N->bool. ~(interior s = {}) ==> ~(COUNTABLE s)`, SIMP_TAC[CARD_EQ_NONEMPTY_INTERIOR; CARD_EQ_REAL_IMP_UNCOUNTABLE]);; let COUNTABLE_EMPTY_INTERIOR = prove (`!s:real^N->bool. COUNTABLE s ==> interior s = {}`, MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]);; let FINITE_EMPTY_INTERIOR = prove (`!s:real^N->bool. FINITE s ==> interior s = {}`, SIMP_TAC[COUNTABLE_EMPTY_INTERIOR; FINITE_IMP_COUNTABLE]);; let [CONNECTED_FINITE_IFF_SING; CONNECTED_FINITE_IFF_COUNTABLE; CONNECTED_INFINITE_IFF_CARD_EQ] = (CONJUNCTS o prove) (`(!s:real^N->bool. connected s ==> (FINITE s <=> s = {} \/ ?a. s = {a})) /\ (!s:real^N->bool. connected s ==> (FINITE s <=> COUNTABLE s)) /\ (!s:real^N->bool. connected s ==> (INFINITE s <=> s =_c (:real)))`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN ASM_CASES_TAC `connected(s:real^N->bool)` THEN ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT `(f ==> c) /\ (r ==> ~c) /\ (s ==> f) /\ (~s ==> r) ==> (f <=> s) /\ (f <=> c) /\ (~f <=> r)`) THEN REWRITE_TAC[FINITE_IMP_COUNTABLE] THEN REPEAT CONJ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_INSERT; FINITE_EMPTY] THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);; let CONNECTED_FINITE_EQ_LOWDIM = prove (`!s:real^N->bool. connected s ==> (FINITE s <=> aff_dim s <= &0)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONNECTED_FINITE_IFF_SING] THEN REWRITE_TAC[GSYM AFF_DIM_EQ_0; GSYM AFF_DIM_EQ_MINUS1] THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_GE) THEN INT_ARITH_TAC);; let CLOSED_AS_FRONTIER_OF_SUBSET = prove (`!s:real^N->bool. closed s <=> ?t. t SUBSET s /\ s = frontier t`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FRONTIER_CLOSED]] THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` SEPARABLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN SIMP_TAC[frontier] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET c /\ c SUBSET s /\ i = {} ==> s = c DIFF i`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET_CLOSURE; CLOSURE_CLOSED]; ASM_MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]]);; let CLOSED_AS_FRONTIER = prove (`!s:real^N->bool. closed s <=> ?t. s = frontier t`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[CLOSED_AS_FRONTIER_OF_SUBSET]; MESON_TAC[FRONTIER_CLOSED]]);; let CARD_EQ_CLOSED = prove (`!s:real^N->bool. closed s ==> s <=_c (:num) \/ s =_c (:real)`, let slemma = prove (`!s:real^N->bool. ~COUNTABLE s ==> ?x y. ~(x = y) /\ x IN s /\ y IN s /\ x condensation_point_of s /\ y condensation_point_of s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_INFINITE_CONG) THEN REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT `q /\ (p ==> s) ==> (p <=> q) ==> s`) THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMP_COUNTABLE]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`2`; `{x:real^N | x IN s /\ x condensation_point_of s}`] CHOOSE_SUBSET_STRONG) THEN ASM_REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`; RIGHT_AND_EXISTS_THM] THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_INSERT; NOT_IN_EMPTY]) THEN ASM_REWRITE_TAC[]) in GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM COUNTABLE_ALT] THEN ASM_CASES_TAC `COUNTABLE(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!n t:real^N->bool. closed t /\ ~COUNTABLE t ==> ?l r. (compact l /\ ~COUNTABLE l) /\ (compact r /\ ~COUNTABLE r) /\ l INTER r = {} /\ l SUBSET t /\ r SUBSET t /\ diameter l <= inv(&2 pow n) /\ diameter r <= inv(&2 pow n)` MP_TAC THENL [REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o MATCH_MP slemma)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`t INTER cball(a:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`; `t INTER cball(b:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`] THEN ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONDENSATION_POINT_INFINITE_CBALL]) THEN REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONDENSATION_POINT_INFINITE_CBALL]) THEN REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC(SET_RULE `(!x. ~(x IN t /\ x IN u)) ==> (s INTER t) INTER (s INTER u) = {}`) THEN REWRITE_TAC[IN_CBALL; REAL_LE_MIN] THEN UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH; SET_TAC[]; SET_TAC[]; MATCH_MP_TAC DIAMETER_LE THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC DIAMETER_LE THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN CONV_TAC NORM_ARITH]; REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:num->(real^N->bool)->(real^N->bool)`; `r:num->(real^N->bool)->(real^N->bool)`] THEN DISCH_TAC THEN SUBGOAL_THEN `!b. ?x:num->real^N->bool. (x 0 = s) /\ (!n. x(SUC n) = if b(n) then r n (x n) else l n (x n))` MP_TAC THENL [GEN_TAC THEN W(ACCEPT_TAC o prove_recursive_functions_exist num_RECURSION o snd o dest_exists o snd); REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN X_GEN_TAC `x:(num->bool)->num->real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE]; TRANS_TAC CARD_LE_TRANS `(:num->bool)` THEN SIMP_TAC[CARD_EQ_REAL; CARD_EQ_IMP_LE]] THEN REWRITE_TAC[le_c; IN_UNIV] THEN SUBGOAL_THEN `!b n. closed((x:(num->bool)->num->real^N->bool) b n) /\ ~COUNTABLE(x b n)` MP_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN MP_TAC(GEN `b:num->bool` (ISPEC `(x:(num->bool)->num->real^N->bool) b` DECREASING_CLOSED_NEST_SING)) THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[COUNTABLE_EMPTY]; GEN_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[SUBSET_REFL] THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`b:num->bool`; `e:real`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN EXISTS_TAC `SUC m` THEN ASM_SIMP_TAC[] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q /\ r ==> p ==> s`] DIAMETER_BOUNDED_BOUND)) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN UNDISCH_TAC `inv(&2 pow m) < e` THEN MATCH_MP_TAC(NORM_ARITH `d <= i ==> i < e ==> norm(x - y) <= d ==> dist(x:real^N,y) < e`) THEN ASM_SIMP_TAC[]]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:(num->bool)->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL [X_GEN_TAC `b:num->bool` THEN REWRITE_TAC[SET_RULE `x IN s <=> {x} SUBSET s`] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[FORALL_UNWIND_THM2] THEN GEN_TAC THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`b:num->bool`; `c:num->bool`] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [FUN_EQ_THM] THEN REWRITE_TAC[NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `!f g. INTERS f = {a} /\ INTERS g = {b} /\ (?s t. s IN f /\ t IN g /\ s INTER t = {}) ==> ~(a = b)`) THEN EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) b n}` THEN EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) c n}` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `(x:(num->bool)->num->real^N->bool) b (SUC k)` THEN EXISTS_TAC `(x:(num->bool)->num->real^N->bool) c (SUC k)` THEN REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `!i. i <= k ==> (x:(num->bool)->num->real^N->bool) b i = x c i` MP_TAC THENL [INDUCT_TAC THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE]; DISCH_THEN(MP_TAC o SPEC `k:num`)] THEN REWRITE_TAC[LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAUT `~(p <=> q) <=> (q <=> ~p)`]) THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_MESON_TAC[INTER_COMM]]]);; let CONDENSATION_POINTS_EQ_EMPTY,CARD_EQ_CONDENSATION_POINTS = (CONJ_PAIR o prove) (`(!s:real^N->bool. {x | x condensation_point_of s} = {} <=> COUNTABLE s) /\ (!s:real^N->bool. {x | x condensation_point_of s} =_c (:real) <=> ~(COUNTABLE s))`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> p) /\ (~r ==> q) /\ (p ==> ~q) ==> (p <=> r) /\ (q <=> ~r)`) THEN REPEAT CONJ_TAC THENL [DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN REWRITE_TAC[condensation_point_of] THEN ASM_MESON_TAC[COUNTABLE_SUBSET; INTER_SUBSET; IN_UNIV; OPEN_UNIV]; DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE [TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] CARD_EQ_CLOSED) THEN REWRITE_TAC[CLOSED_CONDENSATION_POINTS; GSYM COUNTABLE_ALT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_COUNTABLE_CONG) THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[]; DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN REWRITE_TAC[FINITE_EMPTY; GSYM INFINITE; real_INFINITE]]);; let UNCOUNTABLE_HAS_CONDENSATION_POINT = prove (`!s:real^N->bool. ~COUNTABLE s ==> ?x. x condensation_point_of s`, REWRITE_TAC[GSYM CONDENSATION_POINTS_EQ_EMPTY] THEN SET_TAC[]);; let CARD_EQ_PERFECT_SET = prove (`!s:real^N->bool. closed s /\ (!x. x IN s ==> x limit_point_of s) /\ ~(s = {}) ==> s =_c (:real)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP CARD_EQ_CLOSED) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM COUNTABLE; GSYM ge_c]) THEN MP_TAC(ISPECL [`IMAGE (\x:real^N. s DELETE x) s`; `s:real^N->bool`] BAIRE) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[OPEN_IN_DELETE; CLOSED_IMP_LOCALLY_COMPACT; OPEN_IN_REFL] THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[IN_CLOSURE_DELETE] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN_DELETE]; REWRITE_TAC[INTERS_IMAGE; IN_DELETE] THEN SUBGOAL_THEN `{y:real^N | !x. x IN s ==> y IN s /\ ~(y = x)} = {}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[CLOSURE_EMPTY; SUBSET_EMPTY]]]);; (* ------------------------------------------------------------------------- *) (* Density of sets with small complement, including irrationals. *) (* ------------------------------------------------------------------------- *) let COSMALL_APPROXIMATION = prove (`!s. ((:real) DIFF s) <_c (:real) ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`, let lemma = prove (`!s. ((:real^1) DIFF s) <_c (:real) ==> !x e. &0 < e ==> ?y. y IN s /\ norm(y - x) < e`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `~({x | P x} SUBSET UNIV DIFF s) ==> ?x. x IN s /\ P x`) THEN MP_TAC(ISPEC `ball(x:real^1,e)` CARD_EQ_OPEN) THEN ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN REWRITE_TAC[CARD_NOT_LE] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); GSYM ball] THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE]) in REWRITE_TAC[FORALL_DROP_IMAGE; FORALL_DROP; EXISTS_DROP] THEN REWRITE_TAC[GSYM IMAGE_DROP_UNIV; GSYM DROP_SUB; GSYM ABS_DROP] THEN REWRITE_TAC[DROP_IN_IMAGE_DROP] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN SIMP_TAC[GSYM IMAGE_DIFF_INJ; DROP_EQ] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC CARD_LT_CONG THEN REWRITE_TAC[IMAGE_DROP_UNIV; CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[DROP_EQ]);; let COCOUNTABLE_APPROXIMATION = prove (`!s. COUNTABLE((:real) DIFF s) ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`, GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_TAC THEN MATCH_MP_TAC COSMALL_APPROXIMATION THEN TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_REAL]);; let OPEN_SET_COSMALL_COORDINATES = prove (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> (:real) DIFF {x | P i x} <_c (:real)) ==> !s:real^N->bool. open s /\ ~(s = {}) ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?y:real. P i y /\ abs(y - (a:real^N)$i) < d / &(dimindex(:N))` MP_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP COSMALL_APPROXIMATION) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; REWRITE_TAC[LAMBDA_SKOLEM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL; dist] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; CARD_NUMSEG_1]]);; let OPEN_SET_COCOUNTABLE_COORDINATES = prove (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> COUNTABLE((:real) DIFF {x | P i x})) ==> !s:real^N->bool. open s /\ ~(s = {}) ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SET_COSMALL_COORDINATES THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_REAL]);; let OPEN_SET_IRRATIONAL_COORDINATES = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> ~rational(x$i)`, MATCH_MP_TAC OPEN_SET_COCOUNTABLE_COORDINATES THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);; let CLOSURE_COSMALL_COORDINATES = prove (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> (:real) DIFF {x | P i x} <_c (:real)) ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} = (:real^N)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[CLOSURE_APPROACHABLE; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_SET_COSMALL_COORDINATES) THEN DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e)`) THEN ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; IN_BALL] THEN MESON_TAC[DIST_SYM]);; let CLOSURE_COCOUNTABLE_COORDINATES = prove (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> COUNTABLE((:real) DIFF {x | P i x})) ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} = (:real^N)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_COSMALL_COORDINATES THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_REAL]);; let CLOSURE_IRRATIONAL_COORDINATES = prove (`closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> ~rational(x$i)} = (:real^N)`, MATCH_MP_TAC CLOSURE_COCOUNTABLE_COORDINATES THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);; (* ------------------------------------------------------------------------- *) (* Every path between distinct points contains an arc, and hence *) (* that path connection is equivalent to arcwise connection, for distinct *) (* points. The proof is based on Whyburn's "Topological Analysis". *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL = prove (`!f:real^1->real^N. f continuous_on interval[vec 0,vec 1] /\ (!y. connected {x | x IN interval[vec 0,vec 1] /\ f x = y}) /\ ~(f(vec 1) = f(vec 0)) ==> (IMAGE f (interval[vec 0,vec 1])) homeomorphic (interval[vec 0:real^1,vec 1])`, let closure_dyadic_rationals_in_convex_set_pos_1 = prove (`!s. convex s /\ ~(interior s = {}) /\ (!x. x IN s ==> &0 <= drop x) ==> closure(s INTER { lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}) = closure s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^1->bool` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN t ==> x IN u) /\ (!x. x IN u ==> x IN s ==> x IN t) ==> s INTER t = s INTER u`) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[IN_ELIM_THM; EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`; LIFT_CMUL] THEN CONJ_TAC THENL [MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n) % x:real^1`) THEN ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN ASM_MESON_TAC[INTEGER_POS; LIFT_DROP]) in let function_on_dyadic_rationals = prove (`!f:num->num->A. (!m n. f (2 * m) (n + 1) = f m n) ==> ?g. !m n. g(&m / &2 pow n) = f m n`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MP_TAC(ISPECL [`\(m,n). (f:num->num->A) m n`; `\(m,n). &m / &2 pow n`] FUNCTION_FACTORS_LEFT) THEN REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM; o_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[MESON[] `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN MATCH_MP_TAC WLOG_LE THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[REAL_FIELD `~(y = &0) /\ ~(y' = &0) ==> (x / y = x' / y' <=> y' / y * x = x')`; REAL_POW_EQ_0; REAL_OF_NUM_EQ; REAL_DIV_POW2; ARITH_EQ] THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[ADD_SUB2; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN REWRITE_TAC[MESON[] `(!n n' d. n' = f d n ==> !m m'. g d m = m' ==> P m m' n d) <=> (!d m n. P m (g d m) n d)`] THEN INDUCT_TAC THEN SIMP_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[GSYM MULT_ASSOC; ADD1] THEN ASM_MESON_TAC[]) in let recursion_on_dyadic_rationals = prove (`!b:num->A l r. ?f. (!m. f(&m) = b m) /\ (!m n. f(&(4 * m + 1) / &2 pow (n + 1)) = l(f(&(2 * m + 1) / &2 pow n))) /\ (!m n. f(&(4 * m + 3) / &2 pow (n + 1)) = r(f(&(2 * m + 1) / &2 pow n)))`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?f:num->num->A. (!m n. f (2 * m) (n + 1) = f m n) /\ (!m. f m 0 = b m) /\ (!m n. f (4 * m + 1) (n + 1) = l(f (2 * m + 1) n)) /\ (!m n. f (4 * m + 3) (n + 1) = r(f (2 * m + 1) n))` MP_TAC THENL [MP_TAC(prove_recursive_functions_exist num_RECURSION `(!m. f m 0 = (b:num->A) m) /\ (!m n. f m (SUC n) = if EVEN m then f (m DIV 2) n else if EVEN(m DIV 2) then l(f ((m + 1) DIV 2) n) else r(f (m DIV 2) n))`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->num->A` THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[ADD1]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EVEN_MULT; ARITH_EVEN; ARITH_RULE `(2 * m) DIV 2 = m`] THEN REWRITE_TAC[ARITH_RULE `(4 * m + 1) DIV 2 = 2 * m`; ARITH_RULE `(4 * m + 3) DIV 2 = 2 * m + 1`; ARITH_RULE `((4 * m + 1) + 1) DIV 2 = 2 * m + 1`; ARITH_RULE `((4 * m + 3) + 1) DIV 2 = 2 * m + 2`] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; EVEN; ARITH_EVEN; SND]; DISCH_THEN(X_CHOOSE_THEN `f:num->num->A` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(MP_TAC o MATCH_MP function_on_dyadic_rationals) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `x / &2 pow 0 = x`]) THEN ASM_REWRITE_TAC[]]) in let recursion_on_dyadic_rationals_1 = prove (`!b:A l r. ?f. (!m. f(&m / &2) = b) /\ (!m n. 0 < n ==> f(&(4 * m + 1) / &2 pow (n + 1)) = l(f(&(2 * m + 1) / &2 pow n))) /\ (!m n. 0 < n ==> f(&(4 * m + 3) / &2 pow (n + 1)) = r(f(&(2 * m + 1) / &2 pow n)))`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`(\n. b):num->A`; `l:A->A`; `r:A->A`] recursion_on_dyadic_rationals) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:real->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. (f:real->A)(&2 * x)` THEN ASM_REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN CONJ_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN ASM_SIMP_TAC[ADD_CLAUSES; real_pow; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ; REAL_FIELD `~(y = &0) ==> &2 * x / (&2 * y) = x / y`]) in let exists_function_unpair = prove (`(?f:A->B#C. P f) <=> (?f1 f2. P(\x. (f1 x,f2 x)))`, EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN EXISTS_TAC `\x. FST((f:A->B#C) x)` THEN EXISTS_TAC `\x. SND((f:A->B#C) x)` THEN ASM_REWRITE_TAC[PAIR; ETA_AX]) in let dyadics_in_open_unit_interval = prove (`interval(vec 0,vec 1) INTER {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)} = {lift(&m / &2 pow n) | 0 < m /\ m < 2 EXP n}`, MATCH_MP_TAC(SET_RULE `(!m n. (f m n) IN s <=> P m n) ==> s INTER {f m n | m IN UNIV /\ n IN UNIV} = {f m n | P m n}`) THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a b m. m IN interval[a,b] /\ interval[a,b] SUBSET interval[vec 0,vec 1] ==> ?c d. drop a <= drop c /\ drop c <= drop m /\ drop m <= drop d /\ drop d <= drop b /\ (!x. x IN interval[c,d] ==> f x = f m) /\ (!x. x IN interval[a,c] DELETE c ==> ~(f x = f m)) /\ (!x. x IN interval[d,b] DELETE d ==> ~(f x = f m)) /\ (!x y. x IN interval[a,c] DELETE c /\ y IN interval[d,b] DELETE d ==> ~((f:real^1->real^N) x = f y))` MP_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET_INTERVAL_1] THEN REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?c d. {x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} = interval[c,d]` MP_TAC THENL [SUBGOAL_THEN `{x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} = interval[a,b] INTER {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; IN_ELIM_THM; DROP_VEC] THEN GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?c d. {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m} = interval[c,d]` MP_TAC THENL [ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | x IN s /\ P x}`] THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[COMPACT_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN ASM_REWRITE_TAC[CLOSED_INTERVAL]; STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL_1] THEN MESON_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `m IN interval[c:real^1,d]` MP_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN STRIP_TAC] THEN SUBGOAL_THEN `{c:real^1,d} SUBSET interval[c,d]` MP_TAC THENL [ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; IN_INTERVAL_1] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL [GEN_TAC THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN SIMP_TAC[IN_ELIM_THM]; ALL_TAC] THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `{x | x IN s /\ f x = a} = t ==> (!x. P x ==> x IN s) /\ (!x. P x /\ Q x ==> ~(x IN t)) ==> !x. P x /\ Q x ==> ~(f x = a)`)) THEN REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `{x:real^1,y} INTER interval[c,d] = {}` MP_TAC THENL [REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`] THEN REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1] THEN ASM_CASES_TAC `(f:real^1->real^N) x = f m` THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `(f:real^1->real^N) y = f m` THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1] o SPEC `(f:real^1->real^N) y`) THEN ASM_REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`; `m:real^1`]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`leftcut:real^1->real^1->real^1->real^1`; `rightcut:real^1->real^1->real^1->real^1`] THEN STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `vec 1:real^1`; `vec 0:real^1`]) THEN REWRITE_TAC[SUBSET_REFL; ENDS_IN_UNIT_INTERVAL] THEN ABBREV_TAC `u = (rightcut:real^1->real^1->real^1->real^1) (vec 0) (vec 1) (vec 0)` THEN REWRITE_TAC[CONJ_ASSOC; REAL_LE_ANTISYM; DROP_EQ] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`u:real^1`; `vec 1:real^1`; `vec 1:real^1`]) THEN REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ABBREV_TAC `v = (leftcut:real^1->real^1->real^1->real^1) u (vec 1) (vec 1)` THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> (c /\ d) /\ a /\ b /\ e`] THEN REWRITE_TAC[REAL_LE_ANTISYM; DROP_EQ] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN interval[vec 0,v] DELETE v ==> ~((f:real^1->real^N) x = f(vec 1))` ASSUME_TAC THENL [X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN STRIP_TAC THEN ASM_CASES_TAC `drop t < drop u` THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `~(f1 = f0) ==> ft = f0 ==> ~(ft = f1)`)); ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; UNDISCH_THEN `!x. x IN interval[u,v] DELETE v ==> ~((f:real^1->real^N) x = f (vec 1))` (K ALL_TAC)] THEN MP_TAC(ISPECL [`(u:real^1,v:real^1)`; `\(a,b). (a:real^1,leftcut a b (midpoint(a,b)):real^1)`; `\(a,b). (rightcut a b (midpoint(a,b)):real^1,b:real^1)`] recursion_on_dyadic_rationals_1) THEN REWRITE_TAC[exists_function_unpair; PAIR_EQ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real->real^1`; `b:real->real^1`] THEN ABBREV_TAC `(c:real->real^1) x = midpoint(a x,b x)` THEN REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!m n. drop u <= drop(a(&m / &2 pow n)) /\ drop(a(&m / &2 pow n)) <= drop(b(&m / &2 pow n)) /\ drop(b(&m / &2 pow n)) <= drop v` MP_TAC THENL [GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_LE_REFL]; X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*")] THEN X_GEN_TAC `p:num` THEN DISJ_CASES_TAC(SPEC `p:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_pow] THEN ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < y ==> (&2 * x) / (&2 * y) = x / y`]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_LE_REFL]; REWRITE_TAC[ADD1]] THEN DISJ_CASES_TAC(SPEC `m:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN ASM_SIMP_TAC[ARITH_RULE `2 * 2 * r = 4 * r`]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN ASM_SIMP_TAC[ARITH_RULE `2 * SUC(2 * r) + 1 = 4 * r + 3`]] THEN (FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * r + 1) / &2 pow n):real^1`; `b(&(2 * r + 1) / &2 pow n):real^1`; `c(&(2 * r + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM th]) THEN REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN UNDISCH_TAC `drop(vec 0) <= drop u` THEN UNDISCH_TAC `drop v <= drop (vec 1)`; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `2 * r + 1`) THEN REAL_ARITH_TAC); REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN SUBGOAL_THEN `!m n. drop(vec 0) <= drop(a(&m / &2 pow n))` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!m n. drop(b(&m / &2 pow n)) <= drop(vec 1)` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!m n. drop(a(&m / &2 pow n)) <= drop(c(&m / &2 pow n)) /\ drop(c(&m / &2 pow n)) <= drop(b(&m / &2 pow n))` MP_TAC THENL [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x` (fun th -> REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]; REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN SUBGOAL_THEN `!i m n j. ODD j /\ abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) ==> drop(a(&j / &2 pow n)) <= drop(c(&i / &2 pow m)) /\ drop(c(&i / &2 pow m)) <= drop(b(&j / &2 pow n))` ASSUME_TAC THENL [REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `m - n:num` THEN DISJ_CASES_TAC(ARITH_RULE `m <= n \/ n:num < m`) THENL [GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `abs(&2 pow n) * abs(&i / &2 pow m - &j / &2 pow n)` REAL_ABS_INTEGER_LEMMA) THEN MATCH_MP_TAC(TAUT `i /\ ~b /\ (n ==> p) ==> (i /\ ~n ==> b) ==> p`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_ABS_MUL; INTEGER_ABS] THEN REWRITE_TAC[REAL_ARITH `n * (x / m - y / n):real = x * (n / m) - y * (n / n)`] THEN ASM_SIMP_TAC[GSYM REAL_POW_SUB; LE_REFL; REAL_OF_NUM_EQ; ARITH_EQ] THEN MESON_TAC[INTEGER_CLOSED]; SIMP_TAC[REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_POW; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `~(&1 <= x * y) <=> y * x < &1`] THEN SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN ASM_REWRITE_TAC[REAL_ARITH `&1 / x = inv x`]; ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_ENTIRE; REAL_LT_IMP_NZ; REAL_LT_POW2; REAL_ARITH `abs(x - y) = &0 <=> x = y`]]; ALL_TAC] THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IMP_CONJ; ODD_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN UNDISCH_THEN `n:num < m` (fun th -> let th' = MATCH_MP (ARITH_RULE `n < m ==> m - SUC n < m - n`) th in FIRST_X_ASSUM(MP_TAC o C MATCH_MP th')) THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `&i / &2 pow m = &(2 * j + 1) / &2 pow n \/ &i / &2 pow m < &(2 * j + 1) / &2 pow n \/ &(2 * j + 1) / &2 pow n < &i / &2 pow m`) THENL [ASM_REWRITE_TAC[ADD1]; DISCH_THEN(MP_TAC o SPEC `4 * j + 1`) THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x < i /\ &2 * n1 = n /\ j + n1 = i ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN ASM_REWRITE_TAC[REAL_ARITH `a / b + inv b = (a + &1) / b`] THEN REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `b' <= b ==> a <= c /\ c <= b' ==> a <= c /\ c <= b`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * j + 1) / &2 pow n):real^1`; `b(&(2 * j + 1) / &2 pow n):real^1`; `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM th]) THEN REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]; DISCH_THEN(MP_TAC o SPEC `4 * j + 3`) THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `i < x /\ &2 * n1 = n /\ j - n1 = i ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN ASM_REWRITE_TAC[REAL_ARITH `a / b - inv b = (a - &1) / b`] THEN REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `a <= a' ==> a' <= c /\ c <= b ==> a <= c /\ c <= b`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * j + 1) / &2 pow n):real^1`; `b(&(2 * j + 1) / &2 pow n):real^1`; `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM th]) THEN REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]]; ALL_TAC] THEN SUBGOAL_THEN `!m n. ODD m ==> abs(drop(a(&m / &2 pow n)) - drop(b(&m / &2 pow n))) <= &2 / &2 pow n` ASSUME_TAC THENL [ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN CONV_TAC NUM_REDUCE_CONV THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[ODD_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL [ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[ARITH_RULE `SUC(2 * 2 * j) = 4 * j + 1`] THEN ASM_SIMP_TAC[ADD1] THEN MATCH_MP_TAC(REAL_ARITH `drop c = (drop a + drop b) / &2 /\ abs(drop a - drop b) <= &2 * k /\ drop a <= drop(leftcut a b c) /\ drop(leftcut a b c) <= drop c ==> abs(drop a - drop(leftcut a b c)) <= k`); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[ARITH_RULE `SUC(2 * SUC(2 * j)) = 4 * j + 3`] THEN ASM_SIMP_TAC[ADD1] THEN MATCH_MP_TAC(REAL_ARITH `drop c = (drop a + drop b) / &2 /\ abs(drop a - drop b) <= &2 * k /\ drop c <= drop(rightcut a b c) /\ drop(rightcut a b c) <= drop b ==> abs(drop(rightcut a b c) - drop b) <= k`)] THEN (CONJ_TAC THENL [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x` (fun th -> REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `&2 * x * inv y * inv(&2 pow 1) = x / y`] THEN ASM_SIMP_TAC[GSYM real_div; ODD_ADD; ODD_MULT; ARITH]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * j + 1) / &2 pow n):real^1`; `b(&(2 * j + 1) / &2 pow n):real^1`; `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM th]) THEN REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]); ALL_TAC] THEN SUBGOAL_THEN `!n j. 0 < 2 * j /\ 2 * j < 2 EXP n ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow n)) = f(a(&(2 * j + 1) / &2 pow n))` ASSUME_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`; ARITH_RULE `2 * j < 2 <=> j < 1`] THEN ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "+") THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`; ARITH_RULE `2 * j < 2 <=> j < 1`] THEN ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `k:num` THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[EXP; ARITH_RULE `0 < 2 * j <=> 0 < j`; LT_MULT_LCANCEL] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_SIMP_TAC[ARITH_RULE `0 < j ==> 2 * 2 * j - 1 = 4 * (j - 1) + 3`; ADD1; ARITH_RULE `2 * 2 * j + 1 = 4 * j + 1`] THEN SIMP_TAC[ARITH_RULE `0 < j ==> 2 * (j - 1) + 1 = 2 * j - 1`] THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN STRIP_TAC THEN ASM_SIMP_TAC[ADD1; ARITH_RULE `2 * SUC(2 * j) - 1 = 4 * j + 1`; ARITH_RULE `2 * SUC(2 * j) + 1 = 4 * j + 3`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * j + 1) / &2 pow n):real^1`; `b(&(2 * j + 1) / &2 pow n):real^1`; `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM th]) THEN REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]; REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(MESON[] `a IN s /\ b IN s ==> (!x. x IN s ==> f x = c) ==> f a = f b`) THEN REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]]]; ALL_TAC] THEN SUBGOAL_THEN `!n j. 0 < j /\ j < 2 EXP n ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n)) /\ f(a(&(2 * j + 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n))` ASSUME_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH_RULE `~(0 < j /\ j < 2 EXP 0)`] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `j:num` THEN DISJ_CASES_TAC(SPEC `j:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN REWRITE_TAC[ADD_CLAUSES; EXP; ARITH_RULE `0 < 2 * k <=> 0 < k`; ARITH_RULE `2 * x < 2 * y <=> x < y`] THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `c' = c /\ a' = a /\ b' = b ==> b = c /\ a = c ==> b' = c' /\ a' = c'`) THEN REPEAT CONJ_TAC THEN AP_TERM_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; REWRITE_TAC[ADD1; ARITH_RULE `2 * 2 * n = 4 * n`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; SUBGOAL_THEN `k = PRE k + 1` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `2 * (k + 1) - 1 = 2 * k + 1`; ARITH_RULE `2 * 2 * (k + 1) - 1 = 4 * k + 3`] THEN REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN REWRITE_TAC[EXP; ARITH_RULE `SUC(2 * k) < 2 * n <=> k < n`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * k + 1) / &2 pow (SUC n)):real^1`; `b(&(2 * k + 1) / &2 pow (SUC n)):real^1`; `c(&(2 * k + 1) / &2 pow (SUC n)):real^1`]) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1]; REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th) THEN ASM_SIMP_TAC[ARITH_RULE `2 * (2 * k + 1) - 1 = 4 * k + 1`; ADD1; ARITH_RULE `2 * (2 * k + 1) + 1 = 4 * k + 3`; ARITH_RULE `0 < n + 1`] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM ADD1] THEN ASM_SIMP_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN MP_TAC(ISPECL [`\x. (f:real^1->real^N)(c(drop x))`; `interval(vec 0,vec 1) INTER {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}`] UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN SIMP_TAC[closure_dyadic_rationals_in_convex_set_pos_1; CONVEX_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL; UNIT_INTERVAL_NONEMPTY; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; CLOSURE_OPEN_INTERVAL] THEN REWRITE_TAC[dyadics_in_open_unit_interval] THEN ANTS_TAC THENL [REWRITE_TAC[uniformly_continuous_on; FORALL_IN_GSPEC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `(f:real^1->real^N) uniformly_continuous_on interval[vec 0,vec 1]` MP_TAC THENL [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL]; REWRITE_TAC[uniformly_continuous_on]] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`inv(&2)`; `min (d:real) (&1 / &4)`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN EXISTS_TAC `inv(&2 pow n)` THEN REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN SUBGOAL_THEN `!i j m. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\ abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) ==> norm((f:real^1->real^N)(c(&i / &2 pow m)) - f(c(&j / &2 pow n))) < e / &2` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH `abs(x - a) < e ==> x = a \/ abs(x - (a - e / &2)) < e / &2 \/ abs(x - (a + e / &2)) < e / &2`)) THENL [DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_HALF]; ALL_TAC] THEN SUBGOAL_THEN `&j / &2 pow n = &(2 * j) / &2 pow (n + 1)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div; GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 real_pow))] THEN REWRITE_TAC[ADD1; REAL_ARITH `x / n + inv n = (x + &1) / n`; REAL_ARITH `x / n - inv n = (x - &1) / n`] THEN ASM_SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `0 < j ==> 1 <= 2 * j`] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN STRIP_TAC THENL [SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) = f(b (&(2 * j - 1) / &2 pow (n + 1)))` SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]; SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) = f(a (&(2 * j + 1) / &2 pow (n + 1)))` SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]] THEN REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `m:num`; `n + 1`]) THENL [DISCH_THEN(MP_TAC o SPEC `2 * j - 1`) THEN REWRITE_TAC[ODD_SUB]; DISCH_THEN(MP_TAC o SPEC `2 * j + 1`) THEN REWRITE_TAC[ODD_ADD]] THEN ASM_REWRITE_TAC[ODD_MULT; ARITH; ARITH_RULE `1 < 2 * j <=> 0 < j`] THEN REWRITE_TAC[DIST_REAL; GSYM drop] THENL [MATCH_MP_TAC(NORM_ARITH `!t. abs(a - b) <= t /\ t < d ==> a <= c /\ c <= b ==> abs(c - b) < d`); MATCH_MP_TAC(NORM_ARITH `!t. abs(a - b) <= t /\ t < d ==> a <= c /\ c <= b ==> abs(c - a) < d`)] THEN EXISTS_TAC `&2 / &2 pow (n + 1)` THEN (CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ODD_SUB; ODD_ADD; ODD_MULT; ARITH_ODD] THEN ASM_REWRITE_TAC[ARITH_RULE `1 < 2 * j <=> 0 < j`]; REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN ASM_REAL_ARITH_TAC]); ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `m:num`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN REWRITE_TAC[DIST_LIFT; LIFT_DROP] THEN STRIP_TAC THEN SUBGOAL_THEN `?j. 0 < j /\ j < 2 EXP n /\ abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\ abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)` STRIP_ASSUME_TAC THENL [MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m) (&2 pow n * &k / &2 pow p)` FLOOR_POS) THEN SIMP_TAC[REAL_LE_MUL; REAL_LE_MAX; REAL_LE_DIV; REAL_POS; REAL_POW_LE] THEN DISCH_THEN(X_CHOOSE_TAC `j:num`) THEN MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m) (&2 pow n * &k / &2 pow p)` FLOOR) THEN ASM_REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `(j + &1) / n = j / n + inv n`] THEN ASM_CASES_TAC `j = 0` THENL [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_ADD_LID] THEN DISCH_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[ARITH_RULE `1 < n <=> 2 EXP 1 <= n`] THEN ASM_SIMP_TAC[LE_EXP; LE_1] THEN CONV_TAC NUM_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x < inv n /\ &0 < y /\ y < inv n ==> abs(x - &1 / n) < inv n /\ abs(y - &1 / n) < inv n`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_POW2]; DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[LE_1] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN REWRITE_TAC[REAL_NOT_LE; REAL_MAX_LT] THEN REWRITE_TAC[REAL_ARITH `n * x < n <=> n * x < n * &1`] THEN SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]]; MATCH_MP_TAC(NORM_ARITH `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2 ==> dist(w,z) < e`) THEN EXISTS_TAC `(f:real^1->real^N)(c(&j / &2 pow n))` THEN REWRITE_TAC[dist] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN ONCE_REWRITE_TAC[MESON[] `h x = f(c(drop x)) <=> f(c(drop x)) = h x`] THEN REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN ASM_REWRITE_TAC[IN_UNIV; LIFT_DROP; IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)` closure_dyadic_rationals_in_convex_set_pos_1) THEN SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01; CLOSURE_OPEN_INTERVAL] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]; MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_INTERVAL]; SIMP_TAC[dyadics_in_open_unit_interval; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure(IMAGE (h:real^1->real^N) (interval (vec 0,vec 1) INTER {lift (&m / &2 pow n) | m IN (:num) /\ n IN (:num)}))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_INTERVAL; COMPACT_CONTINUOUS_IMAGE] THEN MATCH_MP_TAC IMAGE_SUBSET THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; FORALL_IN_IMAGE] THEN REWRITE_TAC[dyadics_in_open_unit_interval; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `(f:real^1->real^N) continuous_on interval [vec 0,vec 1]` THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_UNIFORMLY_CONTINUOUS)) THEN REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n. ~(n = 0) ==> ?m y. ODD m /\ 0 < m /\ m < 2 EXP n /\ y IN interval[a(&m / &2 pow n),b(&m / &2 pow n)] /\ (f:real^1->real^N) y = f x` MP_TAC THENL [ALL_TAC; MP_TAC(SPECL [`inv(&2)`; `min (d / &2) (&1 / &4)`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `n:num` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= y /\ y <= b ==> a <= c /\ c <= b /\ abs(a - b) < d ==> abs(c - y) < d`)) THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow n` THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC] THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_POW_1] THEN SUBGOAL_THEN `x IN interval[vec 0:real^1,u] \/ x IN interval[u,v] \/ x IN interval[v,vec 1]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `u:real^1` THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]; EXISTS_TAC `x:real^1` THEN ASM_MESON_TAC[]; EXISTS_TAC `v:real^1` THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]]; DISCH_THEN(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `y:real^1` MP_TAC)) THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN REWRITE_TAC[ADD1] THEN DISCH_TAC THEN SUBGOAL_THEN `y IN interval[a(&(2 * j + 1) / &2 pow n):real^1, b(&(4 * j + 1) / &2 pow (n + 1))] \/ y IN interval[b(&(4 * j + 1) / &2 pow (n + 1)), a(&(4 * j + 3) / &2 pow (n + 1))] \/ y IN interval[a(&(4 * j + 3) / &2 pow (n + 1)), b(&(2 * j + 1) / &2 pow n)]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `4 * j + 1` THEN EXISTS_TAC `y:real^1` THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `y IN interval[a,b] ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN ASM_MESON_TAC[LE_1]; EXISTS_TAC `4 * j + 1` THEN EXISTS_TAC `b(&(4 * j + 1) / &2 pow (n + 1)):real^1` THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * j + 1) / &2 pow n):real^1`; `b(&(2 * j + 1) / &2 pow n):real^1`; `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1]; REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN MATCH_MP_TAC(MESON[] `a IN s /\ b IN s ==> (!x. x IN s ==> f x = k) ==> f a = f b`) THEN SUBGOAL_THEN `leftcut (a (&(2 * j + 1) / &2 pow n)) (b (&(2 * j + 1) / &2 pow n)) (c (&(2 * j + 1) / &2 pow n):real^1):real^1 = b(&(4 * j + 1) / &2 pow (n + 1)) /\ rightcut (a (&(2 * j + 1) / &2 pow n)) (b (&(2 * j + 1) / &2 pow n)) (c (&(2 * j + 1) / &2 pow n)):real^1 = a(&(4 * j + 3) / &2 pow (n + 1))` (CONJUNCTS_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `y IN interval[a,b] ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN ASM_MESON_TAC[LE_1]; EXISTS_TAC `4 * j + 3` THEN EXISTS_TAC `y:real^1` THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `y IN interval[a,b] ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN ASM_MESON_TAC[LE_1]]]]; ALL_TAC] THEN SUBGOAL_THEN `!n m. drop(a(&m / &2 pow n)) < drop(b(&m / &2 pow n)) /\ (!x. drop(a(&m / &2 pow n)) < drop x /\ drop x <= drop(b(&m / &2 pow n)) ==> ~(f x = f(a(&m / &2 pow n)))) /\ (!x. drop(a(&m / &2 pow n)) <= drop x /\ drop x < drop(b(&m / &2 pow n)) ==> ~(f x :real^N = f(b(&m / &2 pow n))))` ASSUME_TAC THENL [SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE [IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN ASM_MESON_TAC[DROP_EQ]; ALL_TAC] THEN SUBGOAL_THEN `(!x. drop u < drop x /\ drop x <= drop v ==> ~((f:real^1->real^N) x = f u)) /\ (!x. drop u <= drop x /\ drop x < drop v ==> ~(f x = f v))` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `(f:real^1->real^N) u = f(vec 0) /\ (f:real^1->real^N) v = f(vec 1)` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]; ALL_TAC] THEN CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[REAL_ARITH `&m / &2 pow 0 = (&2 * &m) / &2`] THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THEN ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN X_GEN_TAC `j:num` THEN DISJ_CASES_TAC(ISPEC `j:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN SIMP_TAC[GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; real_pow] THEN ASM_REWRITE_TAC[REAL_ARITH `(&2 * p) * inv(&2) * inv q = p / q`]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN DISJ_CASES_TAC(ISPEC `k:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN ASM_SIMP_TAC[ARITH_RULE `2 * 2 * m = 4 * m`; ADD1] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * m + 1) / &2 pow n):real^1`; `b(&(2 * m + 1) / &2 pow n):real^1`; `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]; REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(K ALL_TAC)] THEN SUBGOAL_THEN `(f:real^1->real^N) (leftcut (a (&(2 * m + 1) / &2 pow n):real^1) (b (&(2 * m + 1) / &2 pow n):real^1) (c (&(2 * m + 1) / &2 pow n):real^1)) = (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN REPEAT CONJ_TAC THENL [DISCH_THEN(SUBST_ALL_TAC o SYM) THEN UNDISCH_THEN `(f:real^1->real^N) (a (&(2 * m + 1) / &2 pow n)) = f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`); midpoint; DROP_CMUL; DROP_ADD] THEN ASM_REWRITE_TAC[REAL_ARITH `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`]; GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN ASM_MESON_TAC[REAL_LE_TRANS]; GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM (fun th -> MATCH_MP_TAC th THEN REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN GEN_REWRITE_TAC I [REAL_ARITH `(a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b`]) THEN ASM_REWRITE_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN ASM_SIMP_TAC[ARITH_RULE `2 * (2 * m + 1) + 1 = 4 * m + 3`; ADD1] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * m + 1) / &2 pow n):real^1`; `b(&(2 * m + 1) / &2 pow n):real^1`; `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]; REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(K ALL_TAC)] THEN SUBGOAL_THEN `(f:real^1->real^N) (rightcut (a (&(2 * m + 1) / &2 pow n):real^1) (b (&(2 * m + 1) / &2 pow n):real^1) (c (&(2 * m + 1) / &2 pow n):real^1)) = (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN REPEAT CONJ_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_THEN `(f:real^1->real^N) (b (&(2 * m + 1) / &2 pow n)) = f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`); midpoint; DROP_CMUL; DROP_ADD] THEN ASM_REWRITE_TAC[REAL_ARITH `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) < b <=> a < b`]; GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM (fun th -> MATCH_MP_TAC th THEN REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN GEN_REWRITE_TAC I [REAL_ARITH `(a <= x /\ x <= b) /\ ~(x = a) <=> a < x /\ x <= b`]) THEN ASM_REWRITE_TAC[]; GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN ASM_MESON_TAC[REAL_LE_TRANS]]]; ALL_TAC] THEN SUBGOAL_THEN `!m i n j. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\ &i / &2 pow m < &j / &2 pow n ==> drop(c(&i / &2 pow m)) <= drop(c(&j / &2 pow n))` ASSUME_TAC THENL [SUBGOAL_THEN `!N m p i k. 0 < i /\ i < 2 EXP m /\ 0 < k /\ k < 2 EXP p /\ &i / &2 pow m < &k / &2 pow p /\ m + p = N ==> ?j n. ODD(j) /\ ~(n = 0) /\ &i / &2 pow m <= &j / &2 pow n /\ &j / &2 pow n <= &k / &2 pow p /\ abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\ abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)` MP_TAC THENL [MATCH_MP_TAC num_WF THEN X_GEN_TAC `N:num` THEN DISCH_THEN(LABEL_TAC "I") THEN MAP_EVERY X_GEN_TAC [`m:num`; `p:num`; `i:num`; `k:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `&i / &2 pow m <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= &k / &2 pow p \/ &k / &2 pow p < &1 / &2 \/ &1 / &2 < &i / &2 pow m` (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL [ASM_REAL_ARITH_TAC; MAP_EVERY EXISTS_TAC [`1`; `1`] THEN ASM_REWRITE_TAC[ARITH] THEN MATCH_MP_TAC(REAL_ARITH `&0 < i /\ i <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= k /\ k < &1 ==> abs(i - &1 / &2 pow 1) < inv(&2 pow 1) /\ abs(k - &1 / &2 pow 1) < inv(&2 pow 1)`) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[MULT_CLAUSES; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT]; REMOVE_THEN "I" MP_TAC THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i:num`; `k:num`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MAP_EVERY UNDISCH_TAC [`&k / &2 pow SUC p < &1 / &2`; `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x < y /\ y < &1 ==> x < &1 /\ y < &1`)) THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC] THEN REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC; REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; ARITH]]; REMOVE_THEN "I" MP_TAC THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i - 2 EXP m`; `k - 2 EXP p`]) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`&1 / &2 < &i / &2 pow SUC m`; `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP (REAL_ARITH `i < k /\ &1 < i ==> &1 < i /\ &1 < k`) th)) THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_OF_NUM_POW] THEN SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ANTS_TAC THENL [ASM_SIMP_TAC[ARITH_RULE `a < b ==> 0 < b - a`] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN ASM_REWRITE_TAC[REAL_ARITH `u * inv v - &1 < w * inv z - &1 <=> u / v < w / z`] THEN CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE `i < 2 * m ==> i - m < m`) THEN ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)]; REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN REWRITE_TAC[GSYM real_div] THEN DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `2 EXP n + j` THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC; ODD_ADD; ODD_EXP; ARITH] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC; REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN REWRITE_TAC[GSYM real_div] THEN ASM_REAL_ARITH_TAC]]; DISCH_THEN(fun th -> MAP_EVERY X_GEN_TAC [`m:num`; `i:num`; `p:num`; `k:num`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`m + p:num`; `m:num`; `p:num`; `i:num`; `k:num`] th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`j:num`; `n:num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN REWRITE_TAC[ADD1; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:num` THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(c(&(2 * q + 1) / &2 pow n))` THEN CONJ_TAC THENL [ASM_CASES_TAC `&i / &2 pow m = &(2 * q + 1) / &2 pow n` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN SUBGOAL_THEN `drop(a(&(4 * q + 1) / &2 pow (n + 1))) <= drop(c(&i / &2 pow m)) /\ drop(c(&i / &2 pow m)) <= drop(b(&(4 * q + 1) / &2 pow (n + 1)))` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(i - q) < n ==> i <= q /\ ~(i = q) /\ q = q' + n / &2 ==> abs(i - q') < n / &2`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH `l <= d ==> u <= v /\ c <= l ==> c <= d`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * q + 1) / &2 pow n):real^1`; `b(&(2 * q + 1) / &2 pow n):real^1`; `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]; DISCH_THEN(fun th -> REWRITE_TAC[th])]]; ASM_CASES_TAC `&k / &2 pow p = &(2 * q + 1) / &2 pow n` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN SUBGOAL_THEN `drop(a(&(4 * q + 3) / &2 pow (n + 1))) <= drop(c(&k / &2 pow p)) /\ drop(c(&k / &2 pow p)) <= drop(b(&(4 * q + 3) / &2 pow (n + 1)))` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(i - q) < n ==> q <= i /\ ~(i = q) /\ q' = q + n / &2 ==> abs(i - q') < n / &2`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH `d <= l ==> l <= c /\ u <= v ==> d <= c`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * q + 1) / &2 pow n):real^1`; `b(&(2 * q + 1) / &2 pow n):real^1`; `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]; DISCH_THEN(fun th -> REWRITE_TAC[th])]]]]; ALL_TAC] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN MAP_EVERY X_GEN_TAC [`x1:real^1`; `x2:real^1`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?m n. 0 < m /\ m < 2 EXP n /\ drop x1 < &m / &2 pow n /\ &m / &2 pow n < drop x2 /\ ~(h(x1):real^N = h(lift(&m / &2 pow n)))` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)` closure_dyadic_rationals_in_convex_set_pos_1) THEN SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01; CLOSURE_OPEN_INTERVAL] THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `inv(&2) % (x1 + x2):real^1`) THEN REWRITE_TAC[dyadics_in_open_unit_interval; IN_INTERVAL_1; DROP_VEC] THEN REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> p) ==> r`) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN DISCH_THEN(MP_TAC o SPEC `(drop x2 - drop x1) / &64`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[EXISTS_IN_GSPEC]] THEN REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP; DROP_CMUL; DROP_ADD] THEN DISCH_TAC THEN SUBGOAL_THEN `?m n. (0 < m /\ m < 2 EXP n) /\ abs(&m / &2 pow n - inv (&2) * (drop x1 + drop x2)) < (drop x2 - drop x1) / &64 /\ inv(&2 pow n) < (drop x2 - drop x1) / &128` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`inv(&2)`; `min (&1 / &4) ((drop x2 - drop x1) / &128)`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN ASM_CASES_TAC `N = 0` THENL [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_INV_POW; REAL_LT_MIN; EXISTS_IN_GSPEC] THEN STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `2 EXP N * m` THEN EXISTS_TAC `N + n:num` THEN ASM_SIMP_TAC[EXP_ADD; LT_MULT; EXP_LT_0; LT_MULT_LCANCEL; LE_1; ARITH_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_ARITH `(N * n) * inv N * inv m:real = (N / N) * (n / m)`] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_LID; GSYM real_div]; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) pow N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_ADD]]; REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `!m n m' n'. (P m n /\ P m' n') /\ (P m n /\ P m' n' ==> ~(g m n = g m' n')) ==> (?m n. P m n /\ ~(a = g m n))`) THEN MAP_EVERY EXISTS_TAC [`2 * m + 1`; `n + 1`; `4 * m + 3`; `n + 2`] THEN CONJ_TAC THENL [REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN (REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC])) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(x - inv(&2) * (x1 + x2)) < (x2 - x1) / &64 ==> abs(x - y) < (x2 - x1) / &4 ==> x1 < y /\ y < x2`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `n < x / &128 ==> &0 < x /\ y < &4 * n ==> y < x / &4`)) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN MATCH_MP_TAC(REAL_ARITH `a / y = x /\ abs(b / y) < z ==> abs(x - (a + b) / y) < z`) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD] THEN SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ABS_POW] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN SIMP_TAC[REAL_LT_RMUL_EQ; REAL_EQ_MUL_RCANCEL; REAL_LT_INV_EQ; REAL_LT_POW2; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH_EQ; REAL_OF_NUM_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC; ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n + 2`; `4 * m + 3`]) THEN UNDISCH_THEN `!x. midpoint ((a:real->real^1) x,b x) = c x` (fun th -> REWRITE_TAC[GSYM th] THEN ASM_SIMP_TAC[ARITH_RULE `n + 2 = (n + 1) + 1 /\ 0 < n + 1`] THEN REWRITE_TAC[th] THEN ASSUME_TAC th) THEN DISCH_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a(&(2 * m + 1) / &2 pow (n + 1)):real^1`; `b(&(2 * m + 1) / &2 pow (n + 1)):real^1`; `c(&(2 * m + 1) / &2 pow (n + 1)):real^1`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN ASM_MESON_TAC[REAL_LE_TRANS]; REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT1)] THEN REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN REWRITE_TAC[REAL_ARITH `(a <= b /\ b <= c) /\ ~(b = a) <=> a < b /\ b <= c`] THEN REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN ASM_REWRITE_TAC[REAL_ARITH `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`] THEN ASM_REWRITE_TAC[REAL_LT_LE]]]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE h (interval[vec 0,lift(&m / &2 pow n)]) SUBSET IMAGE (f:real^1->real^N) (interval[vec 0,c(&m / &2 pow n)]) /\ IMAGE h (interval[lift(&m / &2 pow n),vec 1]) SUBSET IMAGE (f:real^1->real^N) (interval[c(&m / &2 pow n),vec 1])` MP_TAC THENL [MP_TAC(ISPEC `interval(lift(&m / &2 pow n),vec 1)` closure_dyadic_rationals_in_convex_set_pos_1) THEN MP_TAC(ISPEC `interval(vec 0,lift(&m / &2 pow n))` closure_dyadic_rationals_in_convex_set_pos_1) THEN SUBGOAL_THEN `&0 < &m / &2 pow n /\ &m / &2 pow n < &1` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; REAL_OF_NUM_LT; REAL_LT_LDIV_EQ; REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_POW; MULT_CLAUSES]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 ==> r1) /\ (q2 ==> r2) ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r1 /\ r2`) THEN ASM_SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01; CLOSURE_OPEN_INTERVAL; LIFT_DROP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN (MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; REAL_LT_IMP_LE; DROP_VEC; REAL_LE_REFL]; MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(SET_RULE `i SUBSET interval(vec 0,vec 1) /\ (!x. x IN interval(vec 0,vec 1) INTER l ==> x IN i ==> P x) ==> !x. x IN i INTER l ==> P x`) THEN ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE; REAL_LE_REFL] THEN REWRITE_TAC[dyadics_in_open_unit_interval; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[REAL_LE_TRANS]]); DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `IMAGE h s SUBSET t /\ IMAGE h s' SUBSET t' ==> !x y. x IN s /\ y IN s' ==> h(x) IN t /\ h(y) IN t'`)) THEN DISCH_THEN(MP_TAC o SPECL [`x1:real^1`; `x2:real^1`]) THEN ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `a IN IMAGE f s /\ a IN IMAGE f t ==> ?x y. x IN s /\ y IN t /\ f x = a /\ f y = a`)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^1->real^N) x2` o GEN_REWRITE_RULE BINDER_CONV [GSYM IS_INTERVAL_CONNECTED_1]) THEN REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPECL [`t1:real^1`; `t2:real^1`; `c(&m / &2 pow n):real^1`]) THEN UNDISCH_TAC `~(h x1:real^N = h(lift (&m / &2 pow n)))` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `q ==> p ==> ~q ==> r`) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_MESON_TAC[REAL_LE_TRANS]]);; let PATH_CONTAINS_ARC = prove (`!p:real^1->real^N a b. path p /\ pathstart p = a /\ pathfinish p = b /\ ~(a = b) ==> ?q. arc q /\ path_image q SUBSET path_image p /\ pathstart q = a /\ pathfinish q = b`, REWRITE_TAC[pathstart; pathfinish; path] THEN MAP_EVERY X_GEN_TAC [`f:real^1->real^N`; `a:real^N`; `b:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\s. s SUBSET interval[vec 0,vec 1] /\ vec 0 IN s /\ vec 1 IN s /\ (!x y. x IN s /\ y IN s /\ segment(x,y) INTER s = {} ==> (f:real^1->real^N)(x) = f(y))`; `interval[vec 0:real^1,vec 1]`] BROUWER_REDUCTION_THEOREM_GEN) THEN ASM_REWRITE_TAC[GSYM path_image; CLOSED_INTERVAL; SUBSET_REFL] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s INTER i = {} ==> s SUBSET i ==> s = {}`)) THEN REWRITE_TAC[SEGMENT_EQ_EMPTY] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[segment]; MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF i SUBSET t`) THEN ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]] THEN X_GEN_TAC `s:num->real^1->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; REWRITE_TAC[FORALL_DROP; LIFT_DROP]] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN DISCH_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_UNIFORMLY_CONTINUOUS)) THEN REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^N) x - f y) / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?u v. u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ norm(u - x) < e /\ norm(v - y) < e /\ (f:real^1->real^N) u = f v` STRIP_ASSUME_TAC THENL [ALL_TAC; FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`x:real^1`; `u:real^1`] th) THEN MP_TAC(ISPECL [`y:real^1`; `v:real^1`] th)) THEN ASM_REWRITE_TAC[dist] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `q /\ (p ==> ~r) ==> p ==> ~(q ==> r)`) THEN CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]] THEN SUBGOAL_THEN `?w z. w IN interval(x,y) /\ z IN interval(x,y) /\ drop w < drop z /\ norm(w - x) < e /\ norm(z - y) < e` STRIP_ASSUME_TAC THENL [EXISTS_TAC `x + lift(min e (drop y - drop x) / &3)` THEN EXISTS_TAC `y - lift(min e (drop y - drop x) / &3)` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; LIFT_DROP; NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`interval[w:real^1,z]`; `{s n :real^1->bool | n IN (:num)}`] COMPACT_IMP_FIP) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_GSPEC] THEN MATCH_MP_TAC(TAUT `q /\ (~p ==> r) ==> (p ==> ~q) ==> r`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_UNIV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[MESON[] `~(!x. P x /\ Q x ==> R x) <=> (?x. P x /\ Q x /\ ~R x)`] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `interval[w,z] INTER (s:num->real^1->bool) n = {}` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `a INTER t = {} ==> s SUBSET t ==> a INTER s = {}`)) THEN REWRITE_TAC[SUBSET; INTERS_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[SET_RULE `(!x. x IN s n ==> !i. i IN k ==> x IN s i) <=> (!i. i IN k ==> s n SUBSET s i)`] THEN SUBGOAL_THEN `!i n. i <= n ==> (s:num->real^1->bool) n SUBSET s i` (fun th -> ASM_MESON_TAC[th]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?u. u IN (s:num->real^1->bool) n /\ u IN interval[x,w] /\ (interval[u,w] DELETE u) INTER (s n) = {}` MP_TAC THENL [ASM_CASES_TAC `w IN (s:num->real^1->bool) n` THENL [EXISTS_TAC `w:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[x,w]`; `w:real^1`] SEGMENT_TO_POINT_EXISTS) THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^1` THEN ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]; ANTS_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN SUBGOAL_THEN `?v. v IN (s:num->real^1->bool) n /\ v IN interval[z,y] /\ (interval[z,v] DELETE v) INTER (s n) = {}` MP_TAC THENL [ASM_CASES_TAC `z IN (s:num->real^1->bool) n` THENL [EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[z,y]`; `z:real^1`] SEGMENT_TO_POINT_EXISTS) THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^1` THEN ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL [ANTS_TAC THENL [REWRITE_TAC[SUBSET_INTERVAL_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL [MAP_EVERY UNDISCH_TAC [`interval[w,z] INTER (s:num->real^1->bool) n = {}`; `interval[u,w] DELETE u INTER (s:num->real^1->bool) n = {}`; `interval[z,v] DELETE v INTER (s:num->real^1->bool) n = {}`] THEN REWRITE_TAC[IMP_IMP; SET_RULE `s1 INTER t = {} /\ s2 INTER t = {} <=> (s1 UNION s2) INTER t = {}`] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> s INTER u = {} ==> t INTER u = {}`) THEN REWRITE_TAC[SUBSET; IN_UNION; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `t:real^1->bool = {}` THENL [ASM_MESON_TAC[IN_IMAGE; NOT_IN_EMPTY]; ALL_TAC] THEN ABBREV_TAC `h = \x. (f:real^1->real^N)(@y. y IN t /\ segment(x,y) INTER t = {})` THEN SUBGOAL_THEN `!x y. y IN t /\ segment(x,y) INTER t = {} ==> h(x) = (f:real^1->real^N)(y)` ASSUME_TAC THENL [SUBGOAL_THEN `!x y z. y IN t /\ segment(x,y) INTER t = {} /\ z IN t /\ segment(x,z) INTER t = {} ==> (f:real^1->real^N)(y) = f(z)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^1) IN t` THENL [ASM_MESON_TAC[]; UNDISCH_TAC `~((x:real^1) IN t)`] THEN ONCE_REWRITE_TAC[TAUT `p ==> a /\ b /\ c /\ d ==> q <=> (a /\ c) ==> p /\ b /\ d ==> q`] THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `~(x IN t) /\ s INTER t = {} /\ s' INTER t = {} <=> (x INSERT (s UNION s')) INTER t = {}`] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' ==> s' INTER t = {} ==> s INTER t = {}`) THEN REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN t ==> h(x) = (f:real^1->real^N)(x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL; INTER_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^1. ?y. y IN t /\ segment(x,y) INTER t = {}` ASSUME_TAC THENL [X_GEN_TAC `x:real^1` THEN EXISTS_TAC `closest_point t (x:real^1)` THEN ASM_SIMP_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]; ALL_TAC] THEN SUBGOAL_THEN `!x y. segment(x,y) INTER t = {} ==> (h:real^1->real^N) x = h y` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^1`; `x':real^1`] THEN ASM_CASES_TAC `(x:real^1) IN t` THENL [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN ASM_CASES_TAC `(x':real^1) IN t` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?y y'. y IN t /\ segment(x,y) INTER t = {} /\ h x = f y /\ y' IN t /\ segment(x',y') INTER t = {} /\ (h:real^1->real^N) x' = f y'` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`~((x:real^1) IN t)`; `~((x':real^1) IN t)`; `segment(x:real^1,y) INTER t = {}`; `segment(x':real^1,y') INTER t = {}`; `segment(x:real^1,x') INTER t = {}`] THEN MATCH_MP_TAC(SET_RULE `s SUBSET (x1 INSERT x2 INSERT (s0 UNION s1 UNION s2)) ==> s0 INTER t = {} ==> s1 INTER t = {} ==> s2 INTER t = {} ==> ~(x1 IN t) ==> ~(x2 IN t) ==> s INTER t = {}`) THEN REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[continuous_on] THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN SUBGOAL_THEN `(?w:real^1. w IN t /\ w IN segment[u,v] /\ segment(u,w) INTER t = {}) /\ (?z:real^1. z IN t /\ z IN segment[u,v] /\ segment(v,z) INTER t = {})` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `u:real^1`] SEGMENT_TO_POINT_EXISTS); MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `v:real^1`] SEGMENT_TO_POINT_EXISTS)] THEN (ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(segment(u,v) INTER t = {}) ==> segment(u,v) SUBSET segment[u,v] ==> ~(segment[u,v] INTER t = {})`)) THEN REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^1` THEN SIMP_TAC[IN_INTER] THEN MATCH_MP_TAC(SET_RULE `(w IN uv ==> uw SUBSET uv) ==> (w IN uv /\ w IN t) /\ (uw INTER uv INTER t = {}) ==> uw INTER t = {}`) THEN DISCH_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_SEGMENT] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_SEGMENT]); SUBGOAL_THEN `(h:real^1->real^N) u = (f:real^1->real^N) w /\ (h:real^1->real^N) v = (f:real^1->real^N) z` (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2 ==> dist(w,z) < e`) THEN EXISTS_TAC `(f:real^1->real^N) u` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[CONVEX_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET]; ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]])]; X_GEN_TAC `z:real^N` THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `segment[u:real^1,v]` THEN REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL [REWRITE_TAC[SET_RULE `s SUBSET {x | x IN t /\ P x} <=> s SUBSET t /\ !x. x IN s ==> P x`] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]; X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `segment(u:real^1,x) INTER t = {}` (fun th -> ASM_MESON_TAC[th]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `uv INTER t = {} ==> ux SUBSET uv ==> ux INTER t = {}`)) THEN UNDISCH_TAC `(x:real^1) IN segment[u,v]` THEN REWRITE_TAC[SEGMENT_1] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF segment(u:real^1,v)`) THEN ASM_REWRITE_TAC[SET_RULE `t DIFF s PSUBSET t <=> ~(s INTER t = {})`] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[OPEN_SEGMENT_1]; ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC [`(u:real^1) IN interval[vec 0,vec 1]`; `(v:real^1) IN interval[vec 0,vec 1]`] THEN REWRITE_TAC[SEGMENT_1] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC [`(u:real^1) IN interval[vec 0,vec 1]`; `(v:real^1) IN interval[vec 0,vec 1]`] THEN REWRITE_TAC[SEGMENT_1] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN ASM_CASES_TAC `segment(x:real^1,y) INTER segment(u,v) = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(segment(x:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\ segment(y:real^1,v) SUBSET segment(x,y) DIFF segment(u,v)) \/ (segment(y:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\ segment(x:real^1,v) SUBSET segment(x,y) DIFF segment(u,v))` MP_TAC THENL [MAP_EVERY UNDISCH_TAC [`~(x IN segment(u:real^1,v))`; `~(y IN segment(u:real^1,v))`; `~(segment(x:real^1,y) INTER segment (u,v) = {})`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v:real^1`; `u:real^1`; `y:real^1`; `x:real^1`] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[SEGMENT_1] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[IN_INTERVAL_1; SUBSET; IN_DIFF; AND_FORALL_THM] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(DISJ_CASES_THEN(CONJUNCTS_THEN (let sl = SET_RULE `i SUBSET xy DIFF uv ==> xy INTER (t DIFF uv) = {} ==> i INTER t = {}` in fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP sl th))))) THEN ASM_MESON_TAC[]]]; ASM_MESON_TAC[]]; DISCH_TAC] THEN SUBGOAL_THEN `?q:real^1->real^N. arc q /\ path_image q SUBSET path_image f /\ a IN path_image q /\ b IN path_image q` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[homeomorphism] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN REWRITE_TAC[arc; path; path_image] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM MESON_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; path_image] THEN ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]; REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]]; SUBGOAL_THEN `?u v. u IN interval[vec 0,vec 1] /\ a = (q:real^1->real^N) u /\ v IN interval[vec 0,vec 1] /\ b = (q:real^1->real^N) v` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `subpath u v (q:real^1->real^N)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH]; ASM_MESON_TAC[SUBSET_TRANS; PATH_IMAGE_SUBPATH_SUBSET; ARC_IMP_PATH]; ASM_MESON_TAC[pathstart; PATHSTART_SUBPATH]; ASM_MESON_TAC[pathfinish; PATHFINISH_SUBPATH]]]);; let PATH_CONNECTED_ARCWISE = prove (`!s:real^N->bool. path_connected s <=> !x y. x IN s /\ y IN s /\ ~(x = y) ==> ?g. arc g /\ path_image g SUBSET s /\ pathstart g = x /\ pathfinish g = y`, GEN_TAC THEN REWRITE_TAC[path_connected] THEN EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g:real^1->real^N`; `x:real^N`; `y:real^N`] PATH_CONTAINS_ARC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SUBSET_TRANS]; ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `linepath(y:real^N,y)` THEN ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ARC_IMP_PATH]]]);; let ARC_CONNECTED_TRANS = prove (`!g h:real^1->real^N. arc g /\ arc h /\ pathfinish g = pathstart h /\ ~(pathstart g = pathfinish h) ==> ?i. arc i /\ path_image i SUBSET (path_image g UNION path_image h) /\ pathstart i = pathstart g /\ pathfinish i = pathfinish h`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g ++ h:real^1->real^N`; `pathstart(g):real^N`; `pathfinish(h):real^N`] PATH_CONTAINS_ARC) THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_JOIN_EQ; ARC_IMP_PATH; PATH_IMAGE_JOIN]);; (* ------------------------------------------------------------------------- *) (* Local connectedness and local path connectedness. *) (* ------------------------------------------------------------------------- *) let LOCALLY_CONNECTED,LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT = (CONJ_PAIR o prove) (`(!s:real^N->bool. locally connected s <=> !v x. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ connected u /\ x IN u /\ u SUBSET v) /\ (!s:real^N->bool. locally connected s <=> !t x. open_in (subtopology euclidean s) t /\ x IN t ==> open_in (subtopology euclidean s) (connected_component t x))`, REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[SUBSET_REFL]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `connected_component u (x:real^N)` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN ASM_SIMP_TAC[IN; CONNECTED_COMPONENT_REFL]]);; let LOCALLY_PATH_CONNECTED,LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT = (CONJ_PAIR o prove) (`(!s:real^N->bool. locally path_connected s <=> !v x. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ path_connected u /\ x IN u /\ u SUBSET v) /\ (!s:real^N->bool. locally path_connected s <=> !t x. open_in (subtopology euclidean s) t /\ x IN t ==> open_in (subtopology euclidean s) (path_component t x))`, REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[SUBSET_REFL]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `path_component u (x:real^N)` THEN REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL]]);; let LOCALLY_CONNECTED_OPEN_COMPONENT = prove (`!s:real^N->bool. locally connected s <=> !t c. open_in (subtopology euclidean s) t /\ c IN components t ==> open_in (subtopology euclidean s) c`, REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC]);; let LOCALLY_CONNECTED_IM_KLEINEN = prove (`!s:real^N->bool. locally connected s <=> !v x. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ u SUBSET v /\ !y. y IN u ==> ?c. connected c /\ c SUBSET v /\ x IN c /\ y IN c`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[LOCALLY_CONNECTED] THEN MESON_TAC[SUBSET_REFL]; DISCH_TAC] THEN REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(k:real^N->bool) SUBSET c` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]);; let LOCALLY_PATH_CONNECTED_IM_KLEINEN = prove (`!s:real^N->bool. locally path_connected s <=> !v x. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ u SUBSET v /\ !y. y IN u ==> ?p. path p /\ path_image p SUBSET v /\ pathstart p = x /\ pathfinish p = y`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN REWRITE_TAC[path_connected] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `z:real^N`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(path_image p) SUBSET path_component u (z:real^N)` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_SIMP_TAC[PATH_CONNECTED_PATH_IMAGE] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);; let LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. locally path_connected s ==> locally connected s`, MESON_TAC[LOCALLY_MONO; PATH_CONNECTED_IMP_CONNECTED]);; let LOCALLY_CONNECTED_COMPONENTS = prove (`!s c:real^N->bool. locally connected s /\ c IN components s ==> locally connected c`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);; let LOCALLY_CONNECTED_CONNECTED_COMPONENT = prove (`!s x:real^N. locally connected s ==> locally connected (connected_component s x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN MATCH_MP_TAC LOCALLY_CONNECTED_COMPONENTS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; let LOCALLY_PATH_CONNECTED_COMPONENTS = prove (`!s c:real^N->bool. locally path_connected s /\ c IN components s ==> locally path_connected c`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT] o MATCH_MP LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED) THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);; let LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT = prove (`!s x:real^N. locally path_connected s ==> locally path_connected (connected_component s x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_COMPONENTS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; let OPEN_IMP_LOCALLY_PATH_CONNECTED = prove (`!s:real^N->bool. open s ==> locally path_connected s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN EXISTS_TAC `convex:(real^N->bool)->bool` THEN REWRITE_TAC[CONVEX_IMP_PATH_CONNECTED] THEN ASM_SIMP_TAC[locally; OPEN_IN_OPEN_EQ] THEN ASM_MESON_TAC[OPEN_CONTAINS_BALL; CENTRE_IN_BALL; OPEN_BALL; CONVEX_BALL; SUBSET]);; let OPEN_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. open s ==> locally connected s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN EXISTS_TAC `path_connected:(real^N->bool)->bool` THEN ASM_SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; let LOCALLY_PATH_CONNECTED_UNIV = prove (`locally path_connected (:real^N)`, SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; OPEN_UNIV]);; let LOCALLY_CONNECTED_UNIV = prove (`locally connected (:real^N)`, SIMP_TAC[OPEN_IMP_LOCALLY_CONNECTED; OPEN_UNIV]);; let OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED = prove (`!s x:real^N. locally connected s ==> open_in (subtopology euclidean s) (connected_component s x)`, REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]; ASM_MESON_TAC[OPEN_IN_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]]);; let OPEN_IN_COMPONENTS_LOCALLY_CONNECTED = prove (`!s c:real^N->bool. locally connected s /\ c IN components s ==> open_in (subtopology euclidean s) c`, MESON_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT; OPEN_IN_REFL]);; let OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove (`!s x:real^N. locally path_connected s ==> open_in (subtopology euclidean s) (path_component s x)`, REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]; ASM_MESON_TAC[OPEN_IN_EMPTY; PATH_COMPONENT_EQ_EMPTY]]);; let CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove (`!s x:real^N. locally path_connected s ==> closed_in (subtopology euclidean s) (path_component s x)`, REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; PATH_COMPONENT_SUBSET] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEMENT_PATH_COMPONENT_UNIONS] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED]);; let CONVEX_IMP_LOCALLY_PATH_CONNECTED = prove (`!s:real^N->bool. convex s ==> locally path_connected s`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s INTER ball(x:real^N,e)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[OPEN_BALL]; MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL]; ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL]; ASM SET_TAC[]]);; let OPEN_IN_IMP_LOCALLY_PATH_CONNECTED = prove (`!s:real^N->bool. open_in (subtopology euclidean (affine hull s)) s ==> locally path_connected s`, GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET) THEN MATCH_MP_TAC CONVEX_IMP_LOCALLY_PATH_CONNECTED THEN SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);; let OPEN_IN_CONNECTED_COMPONENTS = prove (`!s c:real^N->bool. FINITE(components s) /\ c IN components s ==> open_in (subtopology euclidean s) c`, REWRITE_TAC[components; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT]);; let FINITE_COMPONENTS_MEETING_COMPACT_SUBSET = prove (`!k s:real^N->bool. compact k /\ locally connected s /\ k SUBSET s ==> FINITE {c | c IN components s /\ ~(c INTER k = {})}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN DISCH_THEN(MP_TAC o SPEC `{k INTER c:real^N->bool |c| c IN {d | d IN components s /\ ~(d INTER k = {})}}`) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[GSYM INTER_UNIONS] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `k SUBSET s ==> k INTER s SUBSET t ==> k SUBSET k INTER t`)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN SET_TAC[]]; ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN REWRITE_TAC[SUBSET_INTER; SUBSET_REFL; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `p:(real^N->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `FINITE s ==> t = s ==> FINITE t`)) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p SUBSET k ==> ~(p PSUBSET k) ==> k = p`)) THEN REWRITE_TAC[PSUBSET_ALT; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC o CONJUNCT2) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `(a:real^N) IN UNIONS p` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS; NOT_EXISTS_THM]] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` PAIRWISE_DISJOINT_COMPONENTS) THEN REWRITE_TAC[pairwise] THEN DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `d:real^N->bool`]) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]);; let FINITE_COMPONENTS = prove (`!s:real^N->bool. compact s /\ locally connected s ==> FINITE(components s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`] FINITE_COMPONENTS_MEETING_COMPACT_SUBSET) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s <=> !x. x IN s ==> P x`] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]);; let FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS = prove (`!s:real^N->bool. compact s /\ locally connected s ==> FINITE {connected_component s x |x| x IN s}`, REWRITE_TAC[GSYM components; FINITE_COMPONENTS]);; let FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS = prove (`!s:real^N->bool. compact s /\ locally path_connected s ==> FINITE {path_component s x |x| x IN s}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{path_component s (x:real^N) |x| x IN s}` o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; FORALL_IN_GSPEC; UNIONS_PATH_COMPONENT; SUBSET_REFL] THEN DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN ASM_CASES_TAC `{path_component s (x:real^N) |x| x IN s} = cs` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN SUBGOAL_THEN `?x:real^N. x IN s /\ ~(path_component s x IN cs)` MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?y:real^N. y IN s /\ x IN path_component s y /\ path_component s y IN cs` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_EQ) THEN ASM_MESON_TAC[]);; let CONVEX_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. convex s ==> locally connected s`, MESON_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; let HOMEOMORPHIC_LOCAL_CONNECTEDNESS = prove (`!s t. s homeomorphic t ==> (locally connected s <=> locally connected t)`, MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN REWRITE_TAC[HOMEOMORPHIC_CONNECTEDNESS]);; let HOMEOMORPHISM_LOCAL_CONNECTEDNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (locally connected (IMAGE f k) <=> locally connected k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_LOCAL_CONNECTEDNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS = prove (`!s t. s homeomorphic t ==> (locally path_connected s <=> locally path_connected t)`, MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN REWRITE_TAC[HOMEOMORPHIC_PATH_CONNECTEDNESS]);; let HOMEOMORPHISM_LOCAL_PATH_CONNECTEDNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (locally path_connected (IMAGE f k) <=> locally path_connected k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let LOCALLY_PATH_CONNECTED_TRANSLATION_EQ = prove (`!a:real^N s. locally path_connected (IMAGE (\x. a + x) s) <=> locally path_connected s`, MATCH_MP_TAC LOCALLY_TRANSLATION THEN REWRITE_TAC[PATH_CONNECTED_TRANSLATION_EQ]);; add_translation_invariants [LOCALLY_PATH_CONNECTED_TRANSLATION_EQ];; let LOCALLY_CONNECTED_TRANSLATION_EQ = prove (`!a:real^N s. locally connected (IMAGE (\x. a + x) s) <=> locally connected s`, MATCH_MP_TAC LOCALLY_TRANSLATION THEN REWRITE_TAC[CONNECTED_TRANSLATION_EQ]);; add_translation_invariants [LOCALLY_CONNECTED_TRANSLATION_EQ];; let LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (locally path_connected (IMAGE f s) <=> locally path_connected s)`, MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN REWRITE_TAC[PATH_CONNECTED_LINEAR_IMAGE_EQ]);; add_linear_invariants [LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ];; let LOCALLY_CONNECTED_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (locally connected (IMAGE f s) <=> locally connected s)`, MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN REWRITE_TAC[CONNECTED_LINEAR_IMAGE_EQ]);; add_linear_invariants [LOCALLY_CONNECTED_LINEAR_IMAGE_EQ];; let LOCALLY_CONNECTED_QUOTIENT_IMAGE = prove (`!f:real^M->real^N s. (!t. t SUBSET IMAGE f s ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> open_in (subtopology euclidean (IMAGE f s)) t)) /\ locally connected s ==> locally connected (IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `connected_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_COMPONENTS; IN_ELIM_THM] THEN ASM SET_TAC[]; ALL_TAC; ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`] CONNECTED_COMPONENT_SUBSET) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) (connected_component {w | w IN s /\ f w IN u} x) SUBSET c` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in]; ASM SET_TAC[]]; ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `(f:real^M->real^N) x` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FUN_IN_IMAGE]] THEN GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]);; let LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE = prove (`!f:real^M->real^N s. (!t. t SUBSET IMAGE f s ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> open_in (subtopology euclidean (IMAGE f s)) t)) /\ locally path_connected s ==> locally path_connected (IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN ASSUME_TAC(ISPECL [`u:real^N->bool`; `y:real^N`] PATH_COMPONENT_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN FIRST_ASSUM(MP_TAC o SPEC `path_component u (y:real^N)`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `path_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT]) THEN REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC; ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`] PATH_COMPONENT_SUBSET) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) (path_component {w | w IN s /\ f w IN u} x) SUBSET path_component u y` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FUN_IN_IMAGE; MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in]; ASM SET_TAC[]]; ASM SET_TAC[]]] THEN GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]);; let LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove (`!f:real^M->real^N s. locally connected s /\ compact s /\ f continuous_on s ==> locally connected (IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_QUOTIENT_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; let LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove (`!f:real^M->real^N s. locally path_connected s /\ compact s /\ f continuous_on s ==> locally path_connected (IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; let LOCALLY_PATH_CONNECTED_PATH_IMAGE = prove (`!p:real^1->real^N. path p ==> locally path_connected (path_image p)`, REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT THEN ASM_SIMP_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL; CONVEX_IMP_LOCALLY_PATH_CONNECTED]);; let LOCALLY_CONNECTED_PATH_IMAGE = prove (`!p:real^1->real^N. path p ==> locally connected (path_image p)`, SIMP_TAC[LOCALLY_PATH_CONNECTED_PATH_IMAGE; LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; let LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on (IMAGE f s) /\ (!x. x IN s ==> g(f x) = x) /\ locally connected s ==> locally connected (IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);; let LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on (IMAGE f s) /\ IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\ locally connected s ==> locally connected (IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);; let LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on (IMAGE f s) /\ (!x. x IN s ==> g(f x) = x) /\ locally path_connected s ==> locally path_connected (IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);; let LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on (IMAGE f s) /\ IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\ locally path_connected s ==> locally path_connected (IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);; let LOCALLY_CONNECTED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. locally connected s /\ locally connected t ==> locally connected (s PCROSS t)`, MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[CONNECTED_PCROSS]);; let LOCALLY_PATH_CONNECTED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. locally path_connected s /\ locally path_connected t ==> locally path_connected (s PCROSS t)`, MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[PATH_CONNECTED_PCROSS]);; let LOCALLY_CONNECTED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. locally connected (s PCROSS t) <=> s = {} \/ t = {} \/ locally connected s /\ locally connected t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_PCROSS] THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_CONNECTED] THEN DISCH_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(u:real^M->bool) PCROSS (t:real^N->bool)`; `pastecart (x:real^M) (y:real^N)`]); MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(s:real^M->bool) PCROSS (v:real^N->bool)`; `pastecart (x:real^M) (y:real^N)`])] THEN ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV; OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE fstcart (w:real^(M,N)finite_sum->bool)` THEN ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_FSTCART] THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]]; DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE sndcart (w:real^(M,N)finite_sum->bool)` THEN ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_SNDCART] THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]]] THEN RULE_ASSUM_TAC(REWRITE_RULE [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN ASM SET_TAC[]);; let LOCALLY_PATH_CONNECTED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. locally path_connected (s PCROSS t) <=> s = {} \/ t = {} \/ locally path_connected s /\ locally path_connected t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_PCROSS] THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_PATH_CONNECTED] THEN DISCH_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(u:real^M->bool) PCROSS (t:real^N->bool)`; `pastecart (x:real^M) (y:real^N)`]); MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(s:real^M->bool) PCROSS (v:real^N->bool)`; `pastecart (x:real^M) (y:real^N)`])] THEN ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV; OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `w:real^(M,N)finite_sum->bool`] PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `z:real^M`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]; DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `w:real^(M,N)finite_sum->bool`] PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]] THEN RULE_ASSUM_TAC(REWRITE_RULE [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN ASM SET_TAC[]);; let LOCALLY_CONNECTED_SUBREGION = prove (`!s t c:real^N->bool. locally connected s /\ t SUBSET s /\ connected c /\ open_in (subtopology euclidean t) c ==> ?c'. connected c' /\ open_in (subtopology euclidean s) c' /\ c = t INTER c'`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN ASM_CASES_TAC `s INTER u:real^N->bool = {}` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[CONNECTED_EMPTY; OPEN_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s INTER u:real^N->bool`; `t INTER u:real^N->bool`] EXISTS_COMPONENT_SUPERSET) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s INTER u:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]; ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; INTER_SUBSET] THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[]]);; let CARD_EQ_OPEN_IN = prove (`!u s:real^N->bool. locally connected u /\ open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u) ==> s =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN DISCH_THEN(MP_TAC o SPECL [`u INTER t:real^N->bool`; `x:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN REWRITE_TAC[OPEN_IN_OPEN; GSYM CONJ_ASSOC; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [limit_point_of]) THEN DISCH_THEN(MP_TAC o SPEC `t INTER v:real^N->bool`) THEN ASM_SIMP_TAC[IN_INTER; OPEN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN TRANS_TAC CARD_LE_TRANS `u INTER v:real^N->bool` THEN ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);; let CARD_EQ_OPEN_IN_AFFINE = prove (`!u s:real^N->bool. affine u /\ ~(aff_dim u = &0) /\ open_in (subtopology euclidean u) s /\ ~(s = {}) ==> s =_c (:real)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_OPEN_IN THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; AFFINE_IMP_CONVEX] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);; let SEPARATION_BY_CLOSED_INTERMEDIATES = prove (`!u s:real^N->bool. s SUBSET u /\ ~connected(u DIFF s) ==> ?t. closed_in (subtopology euclidean u) t /\ t SUBSET s /\ !c. closed_in (subtopology euclidean u) c /\ t SUBSET c /\ c SUBSET s ==> ~connected(u DIFF c)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONNECTED]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g1:real^N->bool`; `g2:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `u DIFF (g1 UNION g2):real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_DIFF_OPEN; OPEN_UNION] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`g1 DIFF d:real^N->bool`; `g2 DIFF d:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_DIFF] THEN ASM SET_TAC[]);; let SEPARATION_BY_CLOSED_INTERMEDIATES_EQ = prove (`!u s:real^N->bool. locally connected u /\ s SUBSET u ==> (~connected(u DIFF s) <=> ?t. closed_in (subtopology euclidean u) t /\ t SUBSET s /\ !c. closed_in (subtopology euclidean u) c /\ t SUBSET c /\ c SUBSET s ==> ~connected(u DIFF c))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC SEPARATION_BY_CLOSED_INTERMEDIATES THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC)] THEN ASM_CASES_TAC `s:real^N->bool = u` THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CLOSED_IN_REFL; SUBSET_REFL]; ALL_TAC] THEN SUBGOAL_THEN `~(UNIONS(components(u DIFF t)) DIFF s:real^N->bool = {})` MP_TAC THENL [REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_DIFF; EMPTY_UNIONS; FORALL_IN_GSPEC]] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[CONNECTED_OPEN_IN] THEN MAP_EVERY EXISTS_TAC [`c DIFF s:real^N->bool`; `(u DIFF t DIFF c DIFF s):real^N->bool`] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [SUBGOAL_THEN `open_in (subtopology euclidean u) (c:real^N->bool) /\ open_in (subtopology euclidean u) (u DIFF t DIFF c)` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u DIFF t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THENL [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[CLOSED_IN_COMPONENT]]; MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[OPEN_IN_OPEN] THEN CONJ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]]; ASM_REWRITE_TAC[] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u DIFF c:real^N->bool`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u DIFF t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; ASM SET_TAC[]; SUBGOAL_THEN `u DIFF (u DIFF c):real^N->bool = c` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]]]]);; let LOCALLY_CONNECTED_CLOSED_UNION_GEN = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ locally connected s /\ locally connected t ==> locally connected (s UNION t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[locally] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [ALL_TAC; MATCH_MP_TAC(MESON[] `(?x. P x x) ==> (?x y. P x y)`) THEN SUBGOAL_THEN `locally connected(t DIFF s:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `t DIFF s = t DIFF (t INTER s)`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; REWRITE_TAC[LOCALLY_CONNECTED] THEN DISCH_THEN(MP_TAC o SPECL [`v DIFF s:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN ONCE_REWRITE_TAC[SET_RULE `t DIFF s = (s UNION t) DIFF s`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN SET_TAC[]]]] THEN ASM_CASES_TAC `(a:real^N) IN t` THENL [ALL_TAC; MATCH_MP_TAC(MESON[] `(?x. P x x) ==> (?x y. P x y)`) THEN SUBGOAL_THEN `locally connected(s DIFF t:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `t DIFF s = t DIFF (t INTER s)`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; REWRITE_TAC[LOCALLY_CONNECTED] THEN DISCH_THEN(MP_TAC o SPECL [`v DIFF t:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN SET_TAC[]]]] THEN UNDISCH_TAC `locally connected (t:real^N->bool)` THEN UNDISCH_TAC `locally connected (s:real^N->bool)` THEN REWRITE_TAC[LOCALLY_CONNECTED] THEN DISCH_THEN(MP_TAC o SPECL [`s INTER v:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; SUBSET_UNION]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2; IN_INTER; SUBSET_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `m:real^N->bool` STRIP_ASSUME_TAC)] THEN DISCH_THEN(MP_TAC o SPECL [`t INTER v:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; SUBSET_UNION]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2; IN_INTER; SUBSET_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `(s UNION t) INTER (m INTER n):real^N->bool` THEN EXISTS_TAC `(s INTER m) UNION (t INTER n):real^N->bool` THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);; let LOCALLY_CONNECTED_CLOSED_UNION = prove (`!s t:real^N->bool. locally connected s /\ locally connected t /\ closed s /\ closed t ==> locally connected (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_CLOSED_UNION_GEN THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN]);; let LOCALLY_CONNECTED_CLOSED_UNIONS = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> closed s /\ locally connected s) ==> locally connected (UNIONS f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_0; UNIONS_INSERT] THEN REWRITE_TAC[LOCALLY_EMPTY] THEN ASM_SIMP_TAC[LOCALLY_CONNECTED_CLOSED_UNION; CLOSED_UNIONS]);; let LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ locally connected (s UNION t) /\ locally connected (s INTER t) ==> locally connected s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool) /\ closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)` MP_TAC THENL [CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN SET_TAC[]; REPEAT(FIRST_X_ASSUM(K ALL_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN REPEAT STRIP_TAC] THEN REWRITE_TAC[LOCALLY_CONNECTED] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN t` THENL [ALL_TAC; SUBGOAL_THEN `locally connected (s DIFF t:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL]; REWRITE_TAC[LOCALLY_CONNECTED] THEN DISCH_THEN(MP_TAC o SPECL [`u DIFF t:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s UNION t:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL]]]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[IN_INTER]) THEN ABBREV_TAC `c = connected_component (s INTER t INTER g) (x:real^N)` THEN MP_TAC(ISPECL [`(s UNION t) INTER g:real^N->bool`; `s INTER t INTER g:real^N->bool`; `c:real^N->bool`] LOCALLY_CONNECTED_SUBREGION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]; SET_TAC[]; ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; EXPAND_TAC "c" THEN MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s INTER t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM INTER_ASSOC]]; DISCH_THEN(X_CHOOSE_THEN `h:real^N->bool` (STRIP_ASSUME_TAC o GSYM))] THEN EXISTS_TAC `s INTER h:real^N->bool` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN REWRITE_TAC[SUBSET_UNION] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `(s UNION t) INTER g:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; ALL_TAC; SUBGOAL_THEN `(x:real^N) IN c` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_REFL_EQ; IN; IN_INTER]; FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]] THEN MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN EXISTS_TAC `connected(t INTER h:real^N->bool)` THEN MATCH_MP_TAC CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL THEN EXISTS_TAC `h:real^N->bool` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THENL [UNDISCH_TAC `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool)`; UNDISCH_TAC `closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)`] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; SUBGOAL_THEN `s INTER h UNION t INTER h:real^N->bool = h` SUBST1_TAC THENL [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `(s INTER h) INTER t INTER h:real^N->bool = c` SUBST1_TAC THENL [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]]]);; let LOCALLY_CONNECTED_FROM_UNION_AND_INTER = prove (`!s t:real^N->bool. closed s /\ closed t /\ locally connected (s UNION t) /\ locally connected (s INTER t) ==> locally connected s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `s UNION t:real^N->bool`] THEN ASM_SIMP_TAC[CLOSED_SUBSET; SUBSET_UNION]);; let LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER = prove (`!s:real^N->bool. locally connected (frontier s) ==> locally connected (closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_FROM_UNION_AND_INTER THEN EXISTS_TAC `closure((:real^N) DIFF s)` THEN ASM_REWRITE_TAC[GSYM FRONTIER_CLOSURES; CLOSED_CLOSURE] THEN SUBGOAL_THEN `closure s UNION closure ((:real^N) DIFF s) = (:real^N)` (fun th -> REWRITE_TAC[th; LOCALLY_CONNECTED_UNIV]) THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure s /\ (:real^N) DIFF s SUBSET closure((:real^N) DIFF s) ==> closure s UNION closure ((:real^N) DIFF s) = (:real^N)`) THEN REWRITE_TAC[CLOSURE_SUBSET]);; let PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL, PATH_CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL = (CONJ_PAIR o prove) (`(!u s t:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ path_connected (s UNION t) /\ path_connected (s INTER t) ==> path_connected s /\ path_connected t) /\ (!u s t:real^N->bool. open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t /\ path_connected (s UNION t) /\ path_connected (s INTER t) ==> path_connected s /\ path_connected t)`, let lemma0 = prove (`!g u s:real^N->bool. closed_in (subtopology euclidean u) s /\ path g /\ path_image g SUBSET u /\ ~DISJOINT (path_image g) s ==> ?p. p IN interval[vec 0,vec 1] /\ g p IN s /\ !x. x IN interval[vec 0,vec 1] /\ drop x < drop p ==> ~(g x IN s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{x | x IN interval[vec 0,vec 1] /\ (g:real^1->real^N) x IN s}`; `vec 0:real^1`] DISTANCE_ATTAINS_INF) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN REWRITE_TAC[CLOSED_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_ELIM_THM; DIST_0; NORM_1; IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[real_abs] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^1` THEN ASM_CASES_TAC `(g:real^1->real^N) y IN s` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]) in let lemma1 = prove (`!g s t u:real^N->bool. (closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t \/ open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t) /\ path g /\ pathstart g IN s /\ path_image g SUBSET s UNION t /\ ~(path_image g SUBSET s) ==> ?p. p IN interval[vec 0,vec 1] /\ g p IN t /\ !x. x IN interval[vec 0,p] ==> g x IN s`, REPEAT STRIP_TAC THENL [SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ (t:real^N->bool) SUBSET u` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^1->real^N`; `u:real^N->bool`; `t:real^N->bool`] lemma0) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `p:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `q:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN ASM_CASES_TAC `q:real^1 = vec 0` THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN ASM_CASES_TAC `p:real^1 = vec 0` THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ; DROP_VEC]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < drop p` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]; ALL_TAC] THEN ASM_CASES_TAC `q:real^1 = p` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:real^1`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_DROP]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p SUBSET s UNION t ==> y IN p ==> ~(y IN t) ==> y IN s`)) THEN REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `q:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC] THEN SUBGOAL_THEN `p IN {x | x IN interval[vec 0,vec 1] /\ (g:real^1->real^N) x IN s}` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `!s. x IN closure s /\ closure s SUBSET t ==> x IN t`) THEN EXISTS_TAC `interval(vec 0:real^1,p)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; DROP_VEC; ENDS_IN_INTERVAL; REAL_LT_IMP_LE]; MATCH_MP_TAC CLOSURE_MINIMAL] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_ELIM_THM; DROP_VEC] THEN X_GEN_TAC `r:real^1` THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `p SUBSET s UNION t ==> y IN p ==> ~(y IN t) ==> y IN s`)) THEN REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `r:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN REWRITE_TAC[CLOSED_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]]; SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ (t:real^N->bool) SUBSET u` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`g:real^1->real^N`; `u:real^N->bool`; `u DIFF s:real^N->bool`] lemma0) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(g:real^1->real^N) p IN t` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `p:real^1 = vec 0` THENL [EXISTS_TAC `vec 0:real^1` THEN REWRITE_TAC[INTERVAL_SING; ENDS_IN_UNIT_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `&0 < drop p` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[DROP_VEC] THEN STRIP_TAC THEN MP_TAC(ISPECL [`interval[vec 0:real^1,vec 1]`; `{x | x IN interval[vec 0,vec 1] /\ (g:real^1->real^N) x IN t}`; `interval(vec 0:real^1,p)`] OPEN_IN_INTER_CLOSURE_EQ_EMPTY) THEN ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; DROP_VEC] THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; REAL_LE_REFL] THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(p <=> q) ==> ~p ==> ~q`))] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_INTER] THEN ANTS_TAC THENL [EXISTS_TAC `p:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `q:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `r:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC(SET_RULE `x IN u ==> ~(x IN u DIFF s) ==> x IN s`) THEN RULE_ASSUM_TAC(REWRITE_RULE[path_image; SUBSET; FORALL_IN_IMAGE]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]]] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC]) in REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN REWRITE_TAC[TAUT `(p1 /\ q ==> r) /\ (p2 /\ q ==> r) <=> (p1 \/ p2) /\ q ==> r`] THEN MATCH_MP_TAC(MESON[] `(!x y. R x y ==> R y x) /\ (!x y. R x y ==> P x) ==> !x y. R x y ==> P x /\ P y`) THEN CONJ_TAC THENL [REWRITE_TAC[INTER_COMM; UNION_COMM; CONJ_ACI]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[path_connected] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN UNDISCH_TAC `path_connected (s UNION t:real^N->bool)` THEN REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[IN_UNION] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `(path_image g:real^N->bool) SUBSET s` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?p q. p IN interval[vec 0,vec 1] /\ q IN interval[vec 0,vec 1] /\ (g:real^1->real^N) p IN s /\ g p IN t /\ g q IN s /\ g q IN t /\ (!x. &0 <= drop x /\ drop x <= &1 /\ (drop x <= drop p \/ drop q <= drop x) ==> g x IN s)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`g:real^1->real^N`; `s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`] lemma1) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`reversepath g:real^1->real^N`; `s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`] lemma1) THEN ASM_REWRITE_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN ASM_REWRITE_TAC[PATHSTART_REVERSEPATH] THEN REWRITE_TAC[reversepath; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `vec 1 - q:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CONJ_ASSOC]] THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL [DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th); X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN SUBST1_TAC(VECTOR_ARITH `x:real^1 = vec 1 - (vec 1 - x)`) THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN ASM_REWRITE_TAC[DROP_VEC; DROP_SUB] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(MP_TAC o SPECL [`(g:real^1->real^N) p`; `(g:real^1->real^N) q`]) THEN ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `subpath (vec 0) p g ++ (h:real^1->real^N) ++ subpath q (vec 1) g` THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_JOIN; PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[pathstart; pathfinish]] THEN REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `g SUBSET s UNION t ==> g' SUBSET g /\ (!x. x IN g' ==> x IN s) ==> g' SUBSET s`)) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; IN_INTERVAL_1; DROP_VEC; REAL_LE_REFL; REAL_POS] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; let PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER = prove (`!s t:real^N->bool. closed s /\ closed t /\ path_connected (s UNION t) /\ path_connected (s INTER t) ==> path_connected s /\ path_connected t`, REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL]);; let PATH_CONNECTED_CLOSURE_FROM_FRONTIER = prove (`!s:real^N->bool. path_connected(frontier s) ==> path_connected(closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN EXISTS_TAC `path_connected(closure((:real^N) DIFF s))` THEN MATCH_MP_TAC PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER THEN ASM_REWRITE_TAC[CLOSED_CLOSURE; GSYM FRONTIER_CLOSURES] THEN SUBGOAL_THEN `closure s UNION closure ((:real^N) DIFF s) = (:real^N)` (fun th -> REWRITE_TAC[th; PATH_CONNECTED_UNIV]) THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure s /\ (:real^N) DIFF s SUBSET closure((:real^N) DIFF s) ==> closure s UNION closure ((:real^N) DIFF s) = (:real^N)`) THEN REWRITE_TAC[CLOSURE_SUBSET]);; let LOCALLY_PATH_CONNECTED_SUBREGION = prove (`!s t c:real^N->bool. locally path_connected s /\ t SUBSET s /\ path_connected c /\ open_in (subtopology euclidean t) c ==> ?c'. path_connected c' /\ open_in (subtopology euclidean s) c' /\ c = t INTER c'`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN ASM_CASES_TAC `s INTER u:real^N->bool = {}` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; OPEN_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `t INTER u:real^N->bool = {}` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; OPEN_IN_EMPTY; INTER_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `?a:real^N. a IN t /\ a IN u` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `path_component (s INTER u) (a:real^N)` THEN REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s INTER u:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]; ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; INTER_SUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[IN_INTER] THEN ASM SET_TAC[]; MP_TAC(ISPECL [`s INTER u:real^N->bool`; `a:real^N`] PATH_COMPONENT_SUBSET) THEN ASM SET_TAC[]]]);; let LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ locally path_connected (s UNION t) /\ locally path_connected (s INTER t) ==> locally path_connected s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool) /\ closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)` MP_TAC THENL [CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN SET_TAC[]; REPEAT(FIRST_X_ASSUM(K ALL_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN REPEAT STRIP_TAC] THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN t` THENL [ALL_TAC; SUBGOAL_THEN `locally path_connected (s DIFF t:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL]; REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN DISCH_THEN(MP_TAC o SPECL [`u DIFF t:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s UNION t:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL]]]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[IN_INTER]) THEN ABBREV_TAC `c = path_component (s INTER t INTER g) (x:real^N)` THEN MP_TAC(ISPECL [`(s UNION t) INTER g:real^N->bool`; `s INTER t INTER g:real^N->bool`; `c:real^N->bool`] LOCALLY_PATH_CONNECTED_SUBREGION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]; SET_TAC[]; ASM_MESON_TAC[PATH_CONNECTED_PATH_COMPONENT]; EXPAND_TAC "c" THEN MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s INTER t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM INTER_ASSOC]]; DISCH_THEN(X_CHOOSE_THEN `h:real^N->bool` (STRIP_ASSUME_TAC o GSYM))] THEN EXISTS_TAC `s INTER h:real^N->bool` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN REWRITE_TAC[SUBSET_UNION] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `(s UNION t) INTER g:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; ALL_TAC; SUBGOAL_THEN `(x:real^N) IN c` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[PATH_COMPONENT_REFL_EQ; IN; IN_INTER]; FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]] THEN MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN EXISTS_TAC `path_connected(t INTER h:real^N->bool)` THEN MATCH_MP_TAC PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL THEN EXISTS_TAC `h:real^N->bool` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THENL [UNDISCH_TAC `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool)`; UNDISCH_TAC `closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)`] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; SUBGOAL_THEN `s INTER h UNION t INTER h:real^N->bool = h` SUBST1_TAC THENL [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN SUBGOAL_THEN `(s INTER h) INTER t INTER h:real^N->bool = c` SUBST1_TAC THENL [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ASM_MESON_TAC[PATH_CONNECTED_PATH_COMPONENT]]]);; let LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER = prove (`!s t:real^N->bool. closed s /\ closed t /\ locally path_connected (s UNION t) /\ locally path_connected (s INTER t) ==> locally path_connected s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `s UNION t:real^N->bool`] THEN ASM_SIMP_TAC[CLOSED_SUBSET; SUBSET_UNION]);; (* ------------------------------------------------------------------------- *) (* Two uniform variants of local connectedness. ULC is an abbreviation for *) (* "uniformly locally connected"; FCCOVERABLE ("fine connected coverable") *) (* is more usually called "Property S" (Whyburn, Hocking & Young etc.) *) (* ------------------------------------------------------------------------- *) let FCCOVERABLE_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e) ==> locally connected s`, GEN_TAC THEN REWRITE_TAC[locally] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `c:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `UNIONS {t | t IN c /\ (x:real^N) IN closure t}` THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t <=> q /\ t /\ p /\ r /\ s`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNIONS_STRONG THEN ASM_SIMP_TAC[IN_ELIM_THM; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `x:real^N` THEN SIMP_TAC[INTERS_GSPEC; IN_ELIM_THM; UNIONS_GSPEC; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `(!t. R t ==> Q t) /\ (?t. P t /\ R t) ==> (?t. P t /\ Q t /\ R t)`) THEN REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `diameter(t:real^N->bool)` THEN CONJ_TAC THENL [REWRITE_TAC[dist]; ASM_REAL_ARITH_TAC] THEN ONCE_REWRITE_TAC[GSYM DIAMETER_CLOSURE] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_SIMP_TAC[BOUNDED_CLOSURE]; ALL_TAC] THEN EXISTS_TAC `s INTER ball(x:real^N,e) INTER interior ((:real^N) DIFF (s DIFF UNIONS {t | t IN c /\ x IN closure t}))` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN SIMP_TAC[OPEN_INTER; OPEN_BALL; OPEN_INTERIOR]; ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTERIOR_COMPLEMENT; IN_DIFF; IN_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `closure(UNIONS {t | t IN c /\ ~((x:real^N) IN closure t)})` o MATCH_MP(SET_RULE `x IN s ==> !t. s SUBSET t ==> x IN t`)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]; ASM_SIMP_TAC[CLOSURE_UNIONS; FINITE_RESTRICT] THEN ASM SET_TAC[]]; MATCH_MP_TAC(SET_RULE `interior t SUBSET t /\ s INTER t SUBSET u ==> s INTER b INTER interior t SUBSET u`) THEN REWRITE_TAC[INTERIOR_SUBSET] THEN SET_TAC[]]);; let ULC_IMP_LOCALLY_CONNECTED = prove (`!s:real^N->bool. (!e. &0 < e ==> ?d. &0 < d /\ !x y. x IN s /\ y IN s /\ dist(x,y) < d ==> ?c. x IN c /\ y IN c /\ c SUBSET s /\ connected c /\ bounded c /\ diameter c <= e) ==> locally connected s`, GEN_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `p:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `p:real^N`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s INTER ball(p:real^N,min d e)` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_MIN; IN_INTER] THEN REWRITE_TAC[BALL_MIN_INTER; CONJ_ASSOC] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[GSYM CONJ_ASSOC]] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^N`; `x:real^N`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER s SUBSET u ==> c SUBSET s /\ c SUBSET b ==> c SUBSET u`)) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `c <= e / &2 ==> &0 < e /\ d <= c ==> d < e`)) THEN ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_REWRITE_TAC[]);; let FCCOVERABLE_INTERMEDIATE_CLOSURE = prove (`!s t:real^N->bool. s SUBSET t /\ t SUBSET closure s /\ (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e) ==> (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = t /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{t INTER closure k:real^N->bool | k IN c}` THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t SUBSET c ==> (!x. x IN c ==> P x) ==> (!x. x IN t ==> P x)`)) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[CLOSURE_UNIONS] THEN SET_TAC[]; X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN ASM SET_TAC[]; ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CLOSURE]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN GEN_REWRITE_TAC RAND_CONV [GSYM DIAMETER_CLOSURE] THEN MATCH_MP_TAC DIAMETER_SUBSET THEN ASM_SIMP_TAC[INTER_SUBSET; BOUNDED_CLOSURE]]]);; let COMPACT_LOCALLY_CONNECTED_IMP_ULC = prove (`!s:real^N->bool. compact s /\ locally connected s ==> (!e. &0 < e ==> ?d. &0 < d /\ !x y. x IN s /\ y IN s /\ dist(x,y) < d ==> ?c. x IN c /\ y IN c /\ c SUBSET s /\ connected c /\ bounded c /\ diameter c <= e)`, GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[] `((!x. ~P x) ==> F) ==> ?x. P x`) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; RIGHT_AND_FORALL_THM] THEN GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [NOT_FORALL_THM] THEN REWRITE_TAC[SKOLEM_THM; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:num->real^N`; `y:num->real^N`] THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPEC `(s:real^N->bool) PCROSS s` compact) THEN ASM_REWRITE_TAC[COMPACT_PCROSS_EQ] THEN DISCH_THEN(MP_TAC o SPEC `\n:num. pastecart(x n:real^N) (y n:real^N)`) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; NOT_IMP] THEN ASM_REWRITE_TAC[NOT_EXISTS_THM; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`w:real^N`; `z:real^N`; `r:num->num`] THEN REWRITE_TAC[o_DEF; LIM_PASTECART_EQ] THEN STRIP_TAC THEN SUBGOAL_THEN `w:real^N = z` SUBST_ALL_TAC THENL [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(\n. x((r:num->num) n) - y(r n)):num->real^N` THEN ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `max (inv d) (inv e)` REAL_ARCH_POW2) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_MAX_LT] THEN STRIP_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2 pow ((r:num->num) m))` THEN ASM_SIMP_TAC[GSYM dist; REAL_LT_IMP_LE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN TRANS_TAC REAL_LTE_TRANS `&2 pow n` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN TRANS_TAC LE_TRANS `m:num` THEN ASM_MESON_TAC[MONOTONE_BIGGER]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN DISCH_THEN(MP_TAC o SPECL [`s INTER ball(z:real^N,e / &2)`; `z:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?d. &0 < d /\ ball(z:real^N,d) INTER s SUBSET u` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN DISCH_THEN(MP_TAC o SPEC `z:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN MESON_TAC[DIST_SYM]; ALL_TAC] THEN MAP_EVERY UNDISCH_TAC [`((\m:num. (y:num->real^N) (r m)) --> z) sequentially`; `((\m:num. (x:num->real^N) (r m)) --> z) sequentially`] THEN REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`; tendsto; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `min d (e / &2)`) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN; GSYM EVENTUALLY_AND] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM; RIGHT_AND_FORALL_THM; RIGHT_IMP_FORALL_THM]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(r:num->num) n`; `u:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[IN_BALL; IN_INTER] THEN ASM_MESON_TAC[DIST_SYM]; FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[IN_BALL; IN_INTER] THEN ASM_MESON_TAC[DIST_SYM]; ASM SET_TAC[]; MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(z:real^N,e / &2)` THEN REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]; TRANS_TAC REAL_LE_TRANS `diameter(ball(z:real^N,e / &2))` THEN CONJ_TAC THENL [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]; REWRITE_TAC[DIAMETER_BALL] THEN ASM_REAL_ARITH_TAC]]);; let COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT = prove (`!s:real^N->bool. compact s /\ locally connected s ==> !e. &0 < e ==> ?d. &0 < d /\ d < e /\ !x y. x IN s /\ y IN s /\ dist(x,y) < d ==> ?c. connected c /\ x IN c /\ y IN c /\ c SUBSET s INTER ball(x,e) INTER ball(y,e)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` COMPACT_LOCALLY_CONNECTED_IMP_ULC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d e / &2` THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `diameter(c:real^N->bool)` THEN REWRITE_TAC[dist] THEN ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND] THEN ASM_REAL_ARITH_TAC);; let BOUNDED_ULC_IMP_FCCOVERABLE = prove (`!s:real^N->bool. bounded s /\ (!e. &0 < e ==> ?d. &0 < d /\ !x y. x IN s /\ y IN s /\ dist(x,y) < d ==> ?c. x IN c /\ y IN c /\ c SUBSET s /\ connected c /\ bounded c /\ diameter c <= e) ==> (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e)`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `M = \p. {x | x IN s /\ ?c. (p:real^N) IN c /\ (x:real^N) IN c /\ c SUBSET s /\ connected c /\ bounded c /\ diameter c <= e / &2}` THEN SUBGOAL_THEN `!p:real^N. p IN s ==> ball(p,d) INTER s SUBSET M p` ASSUME_TAC THENL [X_GEN_TAC `p:real^N` THEN DISCH_TAC THEN EXPAND_TAC "M" THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^N`; `x:real^N`]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?k. FINITE k /\ k SUBSET s /\ UNIONS(IMAGE (M:real^N->real^N->bool) k) = s` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN DISCH_TAC THEN SUBGOAL_THEN `?f:num->real^N. !n. f n IN s DIFF UNIONS(IMAGE ((M:real^N->real^N->bool) o f) {m | m < n})` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?f:num->real^N. !n. f n = @x. x IN s DIFF UNIONS(IMAGE ((M:real^N->real^N->bool) o f) {m | m < n})` MP_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_o] THEN AP_TERM_TAC THEN ABS_TAC THEN REPLICATE_TAC 4 AP_TERM_TAC THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^N` THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:num->real^N) {m | m < n}`) THEN SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IMAGE_o]] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> ~(t = s) ==> ?x. x IN s DIFF t`) THEN REWRITE_TAC[UNIONS_SUBSET] THEN ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN EXPAND_TAC "M" THEN SET_TAC[]]; MP_TAC(ISPECL [`IMAGE (f:num->real^N) (:num)`; `d:real`] DISCRETE_BOUNDED_IMP_FINITE) THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_UNIV; NOT_IMP] THEN SUBGOAL_THEN `!m n. norm((f:num->real^N) m - f n) < d ==> m = n` ASSUME_TAC THENL [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[NORM_SUB]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN MATCH_MP_TAC(SET_RULE `x IN t ==> x IN s DIFF t ==> P`) THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; o_THM; IN_ELIM_THM] THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `!p:real^N. p IN s ==> ball(p,d) INTER s SUBSET M p` (MP_TAC o SPEC `(f:num->real^N) m`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET]] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_BALL; IN_INTER; dist] THEN ASM SET_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN ASM SET_TAC[]; W(MP_TAC o PART_MATCH (lhand o rand) FINITE_IMAGE_INJ_EQ o rand o snd) THEN REWRITE_TAC[REWRITE_RULE[INFINITE] num_INFINITE] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0]]]; EXISTS_TAC `IMAGE (M:real^N->real^N->bool) k` THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `p:real^N` THEN EXPAND_TAC "M" THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [GEN_REWRITE_TAC I [CONNECTED_IFF_CONNECTED_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `c UNION d:real^N->bool` THEN ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]; ASM SET_TAC[]]; MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(NORM_ARITH `!p:real^N. norm(x - p) <= e / &2 /\ norm(y - p) <= e / &2 ==> norm(x - y) <= e`) THEN EXISTS_TAC `p:real^N` THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `diameter(d:real^N->bool)`; TRANS_TAC REAL_LE_TRANS `diameter(c:real^N->bool)`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_REWRITE_TAC[]]]);; let COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE = prove (`!s:real^N->bool. compact s /\ locally connected s ==> !e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_LOCALLY_CONNECTED_IMP_ULC) THEN FIRST_X_ASSUM STRIP_ASSUME_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_ULC_IMP_FCCOVERABLE) THEN REWRITE_TAC[]);; let COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE = prove (`!s:real^N->bool. compact s /\ locally connected s <=> !e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\ !t. t IN c ==> connected t /\ compact t /\ diameter t <= e`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:(real^N->bool)->bool` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE closure (c:(real^N->bool)->bool)` THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; CONNECTED_CLOSURE; COMPACT_CLOSURE; DIAMETER_CLOSURE] THEN ASM_SIMP_TAC[GSYM SIMPLE_IMAGE; GSYM CLOSURE_UNIONS] THEN ASM_SIMP_TAC[CLOSURE_EQ; COMPACT_IMP_CLOSED]; CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_UNIONS; REAL_LT_01]; ALL_TAC] THEN MATCH_MP_TAC FCCOVERABLE_IMP_LOCALLY_CONNECTED THEN ASM_MESON_TAC[COMPACT_IMP_BOUNDED]]);; (* ------------------------------------------------------------------------- *) (* Localization of "property S" *) (* ------------------------------------------------------------------------- *) let LOCALLY_FCCOVERABLE = prove (`!s u a:real^N. (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e) /\ open_in (subtopology euclidean s) u /\ a IN u ==> ?v. open_in (subtopology euclidean s) v /\ connected v /\ a IN v /\ v SUBSET u /\ !e. &0 < e ==> ?c. FINITE c /\ UNIONS c = v /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[REAL_ARITH `&0 < e ==> &0 < e / &2 /\ &2 * e / &2 = e`] `(?e. &0 < e /\ P e) ==> ?r. &0 < r /\ P(&2 * r)`)) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `t = \k. {x | ?f. (!i. i <= k ==> connected(f i) /\ f i SUBSET s /\ bounded(f i) /\ diameter(f i) < r / &2 pow i) /\ a IN f 0 /\ (x:real^N) IN f k /\ (!i. i < k ==> ~(f i INTER f(SUC i) = {}))}` THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN SUBGOAL_THEN `!k. a IN (t:num->real^N->bool) k` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\i:num. {a:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING; SING_SUBSET; BOUNDED_SING] THEN REWRITE_TAC[IN_SING; DIAMETER_SING] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET s` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `k:num`) ASSUME_TAC)) THEN REWRITE_TAC[LE_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET ball(a,&2 * r)` ASSUME_TAC THENL [SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET ball(a,(&2 - inv(&2 pow k)) * r)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `x - a <= x <=> &0 <= a`] THEN SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_LE_INV_EQ]] THEN MATCH_MP_TAC num_INDUCTION THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_MUL_LID] THEN CONJ_TAC THENL [REWRITE_TAC[LE; LT; FORALL_UNWIND_THM2] THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < r / &2 pow 0 ==> a <= x ==> a < r`)) THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN ASM_REWRITE_TAC[]; X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL [EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[IN_BALL]] THEN MATCH_MP_TAC(NORM_ARITH `!u. dist(b,c) <= u /\ x + u <= y ==> dist(a:real^N,b) < x ==> dist(a,c) < y`) THEN EXISTS_TAC `diameter((f:num->real^N->bool) (SUC k))` THEN ASM_SIMP_TAC[DIST_LE_DIAMETER; LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `r * k = r * &2 * k' /\ d < r * k' ==> (&2 - k) * r + d <= (&2 - k') * r`) THEN ASM_SIMP_TAC[GSYM real_div; LE_REFL] THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET t(SUC k)` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else {b}` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN ASM_SIMP_TAC[LT_SUC_LE] THENL [ASM_MESON_TAC[]; REWRITE_TAC[CONNECTED_SING; IN_SING; BOUNDED_SING] THEN DISCH_TAC THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM2; DIAMETER_SING] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM_MESON_TAC[LE_REFL]; ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `!k. connected((t:num->real^N->bool) k)` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] `!a. (!x. x IN s ==> connected_component s a x) ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN EXISTS_TAC `a:real^N` THEN SPEC_TAC(`k:num`,`k:num`) THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `connected_component (f 0) (a:real^N) x` MP_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `f 0:real^N->bool` THEN ASM_SIMP_TAC[LE_REFL; SUBSET_REFL]; MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s x ==> t x`) THEN REWRITE_TAC[ETA_AX]] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[GSYM SUBSET]; ALL_TAC] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC(SET_RULE `connected_component k a SUBSET connected_component k' a /\ (connected_component k' a b ==> connected_component k' a c) ==> connected_component k a b ==> connected_component k' a c`)] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_MONO] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_COMPONENT_TRANS) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `f(SUC k):real^N->bool` THEN ASM_SIMP_TAC[LE_REFL] THEN EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[GSYM SUBSET]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP FCCOVERABLE_IMP_LOCALLY_CONNECTED) THEN REWRITE_TAC[LOCALLY_CONNECTED] THEN DISCH_THEN(MP_TAC o SPECL [`s INTER ball(x:real^N,r / &2 pow (k + 3))`; `x:real^N`]) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN REWRITE_TAC[SUBSET_INTER; UNIONS_GSPEC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `SUC k` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else v` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN ASM_SIMP_TAC[LT_SUC_LE] THENL [DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `diameter(ball(x:real^N,r / &2 pow (k + 3)))` THEN ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN ASM_SIMP_TAC[DIAMETER_BALL; REAL_LT_DIV; REAL_LT_POW2; REAL_ARITH `&0 < x ==> ~(x < &0)`] THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[real_div; REAL_LT_LMUL_EQ] THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; MATCH_MP_TAC CONNECTED_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; ASM SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `k:num` THEN TRANS_TAC SUBSET_TRANS `s INTER cball(a:real^N,&2 * r)` THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN ASM_MESON_TAC[SUBSET_TRANS; INTER_COMM; BALL_SUBSET_CBALL]; X_GEN_TAC `e:real` THEN DISCH_TAC] THEN SUBGOAL_THEN `?k. r / &2 pow k < e / &4` STRIP_ASSUME_TAC THENL [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_SIMP_TAC[REAL_INV_POW; GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC REAL_ARCH_POW_INV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&0 < (&1 / &4 * x) / y <=> &0 < x / y`] THEN ASM_SIMP_TAC[REAL_LT_DIV]; ALL_TAC] THEN SUBGOAL_THEN `?ws. FINITE ws /\ (t:num->real^N->bool) k SUBSET UNIONS ws /\ !w. w IN ws ==> w SUBSET s /\ ~(t k INTER w = {}) /\ connected w /\ bounded w /\ diameter w < r / &2 pow (k + 1)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `r / &2 pow (k + 2)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN DISCH_THEN(X_CHOOSE_THEN `ws:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{w:real^N->bool | w IN ws /\ ~(t(k:num) INTER w = {})}` THEN ASM_SIMP_TAC[FINITE_RESTRICT; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `w:real^N->bool` THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < r / k ==> r * inv k * inv(&2 pow 2) < r * inv k * inv(&2 pow 1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2]; ALL_TAC] THEN SUBGOAL_THEN `!w:real^N->bool. w IN ws ==> w SUBSET t(SUC k)` ASSUME_TAC THENL [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN UNDISCH_TAC `~((t:num->real^N->bool) k INTER w = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else w` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN ASM_SIMP_TAC[LT_SUC_LE] THENL [DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ASM_SIMP_TAC[real_div; REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; ALL_TAC] THEN ABBREV_TAC `q = \w. {x | ?c. connected c /\ c SUBSET UNIONS {t k | k IN (:num)} /\ bounded c /\ diameter c < e / &4 /\ ~(w INTER c = {}) /\ (x:real^N) IN c}` THEN EXISTS_TAC `IMAGE (q:(real^N->bool)->(real^N->bool)) ws` THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `?b:real^N. b IN w` CHOOSE_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] `!a. (!x. x IN s ==> connected_component s a x) ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN EXISTS_TAC `b:real^N` THEN X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `w UNION c:real^N->bool` THEN ASM_SIMP_TAC[IN_UNION; CONNECTED_UNION] THEN EXPAND_TAC "q" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM SUBSET] THEN STRIP_TAC THENL [EXISTS_TAC `{y:real^N}` THEN REWRITE_TAC[BOUNDED_SING; IN_SING; CONNECTED_SING] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `q w SUBSET {x + y:real^N | x IN w /\ y IN ball(vec 0,e / &4)}` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `~(w INTER c:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_BALL_0] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN REWRITE_TAC[UNWIND_THM2; GSYM dist] THEN TRANS_TAC REAL_LET_TRANS `diameter(c:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN ASM_REWRITE_TAC[]; CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[DIAMETER_SUBSET; REAL_LE_TRANS] `s SUBSET t ==> bounded t /\ diameter t <= e ==> diameter s <= e`))] THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_SUMS o lhand o snd) THEN ASM_SIMP_TAC[BOUNDED_BALL; DIAMETER_BALL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(e / &4 < &0)`] THEN REWRITE_TAC[REAL_ARITH `d + &2 * e / &4 <= e <=> d <= e / &2`] THEN TRANS_TAC REAL_LE_TRANS `r / &2 pow (k + 1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN ASM_REAL_ARITH_TAC]] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN SET_TAC[]; REWRITE_TAC[IN_UNIV]] THEN X_GEN_TAC `n:num` THEN DISJ_CASES_TAC(ARITH_RULE `n:num <= k \/ k < n`) THENL [TRANS_TAC SUBSET_TRANS `(t:num->real^N->bool) k` THEN CONJ_TAC THENL [UNDISCH_TAC `n:num <= k` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`k:num`; `n:num`] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; TRANS_TAC SUBSET_TRANS `UNIONS ws:real^N->bool` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[BOUNDED_SING; CONNECTED_SING; IN_SING] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `?b:real^N. b IN f k /\ b IN f(SUC k)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[IN_INTER; MEMBER_NOT_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `b IN (t:num->real^N->bool) k` ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_MESON_TAC[LT_TRANS; LE_TRANS; LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `(b:real^N) IN UNIONS ws` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `UNIONS (IMAGE f (k+1..n)):real^N->bool` THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `!i. i <= n ==> connected(UNIONS(IMAGE f (k+1..i)):real^N->bool)` (fun th -> SIMP_TAC[th; LE_REFL]) THEN MATCH_MP_TAC num_INDUCTION THEN SUBGOAL_THEN `k+1..0 = {}` SUBST1_TAC THENL [REWRITE_TAC[NUMSEG_EMPTY] THEN ARITH_TAC; REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; CONNECTED_EMPTY]] THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `i:num = k` THENL [ASM_REWRITE_TAC[ADD1; NUMSEG_SING; IMAGE_CLAUSES; UNIONS_1] THEN ASM_MESON_TAC[ADD1]; REWRITE_TAC[NUMSEG_CLAUSES] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ONCE_REWRITE_TAC[INTER_COMM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x SUBSET g x) /\ s SUBSET t ==> UNIONS(IMAGE f s) SUBSET UNIONS {g x | x IN t}`) THEN REWRITE_TAC[IN_NUMSEG; SUBSET_UNIV] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC BOUNDED_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE; IN_NUMSEG]; ALL_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_NUMSEG; IN_INTER] THEN EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC] THEN SUBGOAL_THEN `!d j. j + d = n ==> diameter (UNIONS (IMAGE f (j..n)):real^N->bool) < &2 * r / &2 pow j` (MP_TAC o SPECL [`n - (k + 1)`; `k + 1`]) THENL [ALL_TAC; ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LTE_TRANS) THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ADD_CLAUSES; FORALL_UNWIND_THM2] THEN REWRITE_TAC[NUMSEG_SING; UNIONS_1; IMAGE_CLAUSES] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ x < n ==> x < &2 * n`; DIAMETER_POS_LE; LE_REFL] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN SUBGOAL_THEN `j:num < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LT_IMP_LE; GSYM NUMSEG_LREC]] THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_UNION_LE o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[BOUNDED_UNIONS; FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE; IN_NUMSEG; LT_IMP_LE] THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `SUC j`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN REMOVE_THEN "*" (MP_TAC o SPEC `j + 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `d1 < rj /\ &2 * rj' = rj ==> d2 < &2 * rj' ==> d1 + d2 < &2 * rj`) THEN ASM_SIMP_TAC[LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN REAL_ARITH_TAC);; let LOCALLY_FCCOVERABLE_ALT = prove (`!s u a:real^N. locally compact s /\ locally connected s /\ open_in (subtopology euclidean s) u /\ a IN u ==> ?v. open_in (subtopology euclidean s) v /\ connected v /\ a IN v /\ v SUBSET u /\ !e. &0 < e ==> ?c. FINITE c /\ UNIONS c = v /\ !t. t IN c ==> connected t /\ bounded t /\ diameter t <= e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?r. &0 < r /\ s INTER cball(a,&2 * r) SUBSET u /\ compact(s INTER cball(a:real^N,&2 * r))` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[INTER_COMM] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_INTER_CBALLS]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d e / &2` THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN CONJ_TAC THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CBALL]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)] THEN ABBREV_TAC `t = \k. {x | ?f. (!i. i <= k ==> connected(f i) /\ f i SUBSET s /\ bounded(f i) /\ diameter(f i) < r / &2 pow i) /\ a IN f 0 /\ (x:real^N) IN f k /\ (!i. i < k ==> ~(f i INTER f(SUC i) = {}))}` THEN EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN SUBGOAL_THEN `!k. a IN (t:num->real^N->bool) k` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\i:num. {a:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING; SING_SUBSET; BOUNDED_SING] THEN REWRITE_TAC[IN_SING; DIAMETER_SING] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET s` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `k:num`) ASSUME_TAC)) THEN REWRITE_TAC[LE_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET ball(a,&2 * r)` ASSUME_TAC THENL [SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET ball(a,(&2 - inv(&2 pow k)) * r)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN MATCH_MP_TAC SUBSET_BALL THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `x - a <= x <=> &0 <= a`] THEN SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_LE_INV_EQ]] THEN MATCH_MP_TAC num_INDUCTION THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_MUL_LID] THEN CONJ_TAC THENL [REWRITE_TAC[LE; LT; FORALL_UNWIND_THM2] THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < r / &2 pow 0 ==> a <= x ==> a < r`)) THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN ASM_REWRITE_TAC[]; X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL [EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[IN_BALL]] THEN MATCH_MP_TAC(NORM_ARITH `!u. dist(b,c) <= u /\ x + u <= y ==> dist(a:real^N,b) < x ==> dist(a,c) < y`) THEN EXISTS_TAC `diameter((f:num->real^N->bool) (SUC k))` THEN ASM_SIMP_TAC[DIST_LE_DIAMETER; LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `r * k = r * &2 * k' /\ d < r * k' ==> (&2 - k) * r + d <= (&2 - k') * r`) THEN ASM_SIMP_TAC[GSYM real_div; LE_REFL] THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET t(SUC k)` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else {b}` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN ASM_SIMP_TAC[LT_SUC_LE] THENL [ASM_MESON_TAC[]; REWRITE_TAC[CONNECTED_SING; IN_SING; BOUNDED_SING] THEN DISCH_TAC THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM2; DIAMETER_SING] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM_MESON_TAC[LE_REFL]; ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `!k. connected((t:num->real^N->bool) k)` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] `!a. (!x. x IN s ==> connected_component s a x) ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN EXISTS_TAC `a:real^N` THEN SPEC_TAC(`k:num`,`k:num`) THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `connected_component (f 0) (a:real^N) x` MP_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `f 0:real^N->bool` THEN ASM_SIMP_TAC[LE_REFL; SUBSET_REFL]; MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s x ==> t x`) THEN REWRITE_TAC[ETA_AX]] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[GSYM SUBSET]; ALL_TAC] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC(SET_RULE `connected_component k a SUBSET connected_component k' a /\ (connected_component k' a b ==> connected_component k' a c) ==> connected_component k a b ==> connected_component k' a c`)] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_MONO] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_COMPONENT_TRANS) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `f(SUC k):real^N->bool` THEN ASM_SIMP_TAC[LE_REFL] THEN EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[GSYM SUBSET]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN DISCH_THEN(MP_TAC o SPECL [`s INTER ball(x:real^N,r / &2 pow (k + 3))`; `x:real^N`]) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_REFL]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN REWRITE_TAC[SUBSET_INTER; UNIONS_GSPEC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `SUC k` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else v` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN ASM_SIMP_TAC[LT_SUC_LE] THENL [DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `diameter(ball(x:real^N,r / &2 pow (k + 3)))` THEN ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN ASM_SIMP_TAC[DIAMETER_BALL; REAL_LT_DIV; REAL_LT_POW2; REAL_ARITH `&0 < x ==> ~(x < &0)`] THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[real_div; REAL_LT_LMUL_EQ] THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; MATCH_MP_TAC CONNECTED_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; ASM SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `k:num` THEN TRANS_TAC SUBSET_TRANS `s INTER cball(a:real^N,&2 * r)` THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]; X_GEN_TAC `e:real` THEN DISCH_TAC] THEN SUBGOAL_THEN `?k. r / &2 pow k < e / &4` STRIP_ASSUME_TAC THENL [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN ASM_SIMP_TAC[REAL_INV_POW; GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC REAL_ARCH_POW_INV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&0 < (&1 / &4 * x) / y <=> &0 < x / y`] THEN ASM_SIMP_TAC[REAL_LT_DIV]; ALL_TAC] THEN SUBGOAL_THEN `?ws. FINITE ws /\ (t:num->real^N->bool) k SUBSET UNIONS ws /\ !w. w IN ws ==> w SUBSET s /\ ~(t k INTER w = {}) /\ connected w /\ bounded w /\ diameter w < r / &2 pow (k + 1)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN DISCH_THEN(MP_TAC o GEN `x:real^N` o SPECL [`s INTER ball(x:real^N,r / &2 pow (k + 3))`; `x:real^N`]) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; SUBSET_INTER] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_GEN]) THEN DISCH_THEN(MP_TAC o SPECL [`IMAGE (uu:real^N->real^N->bool) s`; `s:real^N->bool`]) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `ws:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{w:real^N->bool | w IN IMAGE (uu:real^N->real^N->bool) ws /\ ~(t(k:num) INTER w = {})}` THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `s SUBSET UNIONS {k | k IN f /\ ~(s INTER k = {})} <=> s SUBSET UNIONS f`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]; REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN CONJ_TAC THENL [TRANS_TAC REAL_LE_TRANS `diameter(ball(x:real^N,r / &2 pow (k + 3)))` THEN ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN ASM_SIMP_TAC[DIAMETER_BALL; REAL_LT_DIV; REAL_LT_POW2; REAL_ARITH `&0 < x ==> ~(x < &0)`] THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[real_div; REAL_LT_LMUL_EQ] THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]]; ALL_TAC] THEN SUBGOAL_THEN `!w:real^N->bool. w IN ws ==> w SUBSET t(SUC k)` ASSUME_TAC THENL [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN UNDISCH_TAC `~((t:num->real^N->bool) k INTER w = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else w` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN ASM_SIMP_TAC[LT_SUC_LE] THENL [DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ASM_SIMP_TAC[real_div; REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; ALL_TAC] THEN ABBREV_TAC `q = \w. {x | ?c. connected c /\ c SUBSET UNIONS {t k | k IN (:num)} /\ bounded c /\ diameter c < e / &4 /\ ~(w INTER c = {}) /\ (x:real^N) IN c}` THEN EXISTS_TAC `IMAGE (q:(real^N->bool)->(real^N->bool)) ws` THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `?b:real^N. b IN w` CHOOSE_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] `!a. (!x. x IN s ==> connected_component s a x) ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN EXISTS_TAC `b:real^N` THEN X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `w UNION c:real^N->bool` THEN ASM_SIMP_TAC[IN_UNION; CONNECTED_UNION] THEN EXPAND_TAC "q" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM SUBSET] THEN STRIP_TAC THENL [EXISTS_TAC `{y:real^N}` THEN REWRITE_TAC[BOUNDED_SING; IN_SING; CONNECTED_SING] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `q w SUBSET {x + y:real^N | x IN w /\ y IN ball(vec 0,e / &4)}` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `~(w INTER c:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_BALL_0] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN REWRITE_TAC[UNWIND_THM2; GSYM dist] THEN TRANS_TAC REAL_LET_TRANS `diameter(c:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN ASM_REWRITE_TAC[]; CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)); FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[DIAMETER_SUBSET; REAL_LE_TRANS] `s SUBSET t ==> bounded t /\ diameter t <= e ==> diameter s <= e`))] THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_SUMS o lhand o snd) THEN ASM_SIMP_TAC[BOUNDED_BALL; DIAMETER_BALL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(e / &4 < &0)`] THEN REWRITE_TAC[REAL_ARITH `d + &2 * e / &4 <= e <=> d <= e / &2`] THEN TRANS_TAC REAL_LE_TRANS `r / &2 pow (k + 1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN ASM_REAL_ARITH_TAC]] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN SET_TAC[]; REWRITE_TAC[IN_UNIV]] THEN X_GEN_TAC `n:num` THEN DISJ_CASES_TAC(ARITH_RULE `n:num <= k \/ k < n`) THENL [TRANS_TAC SUBSET_TRANS `(t:num->real^N->bool) k` THEN CONJ_TAC THENL [UNDISCH_TAC `n:num <= k` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`k:num`; `n:num`] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; TRANS_TAC SUBSET_TRANS `UNIONS ws:real^N->bool` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[BOUNDED_SING; CONNECTED_SING; IN_SING] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `?b:real^N. b IN f k /\ b IN f(SUC k)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[IN_INTER; MEMBER_NOT_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `b IN (t:num->real^N->bool) k` ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_MESON_TAC[LT_TRANS; LE_TRANS; LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `(b:real^N) IN UNIONS ws` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `UNIONS (IMAGE f (k+1..n)):real^N->bool` THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `!i. i <= n ==> connected(UNIONS(IMAGE f (k+1..i)):real^N->bool)` (fun th -> SIMP_TAC[th; LE_REFL]) THEN MATCH_MP_TAC num_INDUCTION THEN SUBGOAL_THEN `k+1..0 = {}` SUBST1_TAC THENL [REWRITE_TAC[NUMSEG_EMPTY] THEN ARITH_TAC; REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; CONNECTED_EMPTY]] THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `i:num = k` THENL [ASM_REWRITE_TAC[ADD1; NUMSEG_SING; IMAGE_CLAUSES; UNIONS_1] THEN ASM_MESON_TAC[ADD1]; REWRITE_TAC[NUMSEG_CLAUSES] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ONCE_REWRITE_TAC[INTER_COMM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x SUBSET g x) /\ s SUBSET t ==> UNIONS(IMAGE f s) SUBSET UNIONS {g x | x IN t}`) THEN REWRITE_TAC[IN_NUMSEG; SUBSET_UNIV] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC BOUNDED_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE; IN_NUMSEG]; ALL_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_NUMSEG; IN_INTER] THEN EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC] THEN SUBGOAL_THEN `!d j. j + d = n ==> diameter (UNIONS (IMAGE f (j..n)):real^N->bool) < &2 * r / &2 pow j` (MP_TAC o SPECL [`n - (k + 1)`; `k + 1`]) THENL [ALL_TAC; ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LTE_TRANS) THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD] THEN ASM_REAL_ARITH_TAC] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ADD_CLAUSES; FORALL_UNWIND_THM2] THEN REWRITE_TAC[NUMSEG_SING; UNIONS_1; IMAGE_CLAUSES] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ x < n ==> x < &2 * n`; DIAMETER_POS_LE; LE_REFL] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN SUBGOAL_THEN `j:num < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LT_IMP_LE; GSYM NUMSEG_LREC]] THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_UNION_LE o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[BOUNDED_UNIONS; FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE; IN_NUMSEG; LT_IMP_LE] THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `SUC j`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN REMOVE_THEN "*" (MP_TAC o SPEC `j + 1`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `d1 < rj /\ &2 * rj' = rj ==> d2 < &2 * rj' ==> d1 + d2 < &2 * rj`) THEN ASM_SIMP_TAC[LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN REAL_ARITH_TAC);; let LOCALLY_CONNECTED_CONTINUUM = prove (`!s:real^N->bool. locally (\c. compact c /\ connected c /\ locally connected c) s <=> locally compact s /\ locally connected s`, GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN SIMP_TAC[]; STRIP_TAC THEN GEN_REWRITE_TAC I [locally] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN MP_TAC(ASSUME `locally compact (s:real^N->bool)`) THEN GEN_REWRITE_TAC LAND_CONV [locally] THEN DISCH_THEN(MP_TAC o SPECL [`u:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`; `a:real^N`] LOCALLY_FCCOVERABLE_ALT) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `closure w:real^N->bool` THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_CLOSURE; COMPACT_IMP_BOUNDED; BOUNDED_SUBSET; SUBSET_TRANS]; ASM_SIMP_TAC[CONNECTED_CLOSURE]; MATCH_MP_TAC FCCOVERABLE_IMP_LOCALLY_CONNECTED THEN MATCH_MP_TAC FCCOVERABLE_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN REWRITE_TAC[CLOSURE_SUBSET]; REWRITE_TAC[CLOSURE_SUBSET]; TRANS_TAC SUBSET_TRANS `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]]);; let COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE_ALT = prove (`!s:real^N->bool. compact s /\ locally connected s <=> !e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\ !t. t IN c ==> connected t /\ compact t /\ locally connected t /\ diameter t <= e`, GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[MESON[COMPACT_IMP_BOUNDED] `P c /\ compact c /\ Q c /\ R c <=> (compact c /\ P c /\ Q c) /\ bounded c /\ R c`] THEN MATCH_MP_TAC LOCALLY_FINE_COVERING_COMPACT THEN ASM_REWRITE_TAC[LOCALLY_CONNECTED_CONTINUUM] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT]; REWRITE_TAC[COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Sufficient conditions for "semi-local connectedness" *) (* ------------------------------------------------------------------------- *) let SEMI_LOCALLY_CONNECTED = prove (`!s:real^N->bool. connected s /\ locally compact s /\ locally connected s ==> !x v. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ u SUBSET v /\ FINITE(components(s DIFF u))`, REPEAT STRIP_TAC THEN MP_TAC(ASSUME `locally compact (s:real^N->bool)`) THEN REWRITE_TAC[locally] THEN DISCH_THEN(MP_TAC o SPECL [`v:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`d:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?u k:real^N->bool. x IN u /\ u SUBSET k /\ k SUBSET d /\ open_in (subtopology euclidean s) u /\ closed_in (subtopology euclidean s) k` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `locally compact (s:real^N->bool)` THEN REWRITE_TAC[locally] THEN DISCH_THEN(MP_TAC o SPECL [`d:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_SUBSET; COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN c DIFF d ==> ?t. open_in (subtopology euclidean s) t /\ connected t /\ x IN t /\ t SUBSET s DIFF k` MP_TAC THENL [X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE [LOCALLY_CONNECTED]) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `compact(c DIFF d:real^N->bool)` MP_TAC THENL [UNDISCH_TAC `open_in (subtopology euclidean s) (d:real^N->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `c DIFF d:real^N->bool = c DIFF w` (fun th -> ASM_SIMP_TAC[th; COMPACT_DIFF]) THEN ASM SET_TAC[]; GEN_REWRITE_TAC LAND_CONV [COMPACT_EQ_HEINE_BOREL_GEN]] THEN DISCH_THEN(MP_TAC o SPECL [`IMAGE (t:real^N->real^N->bool) (c DIFF d)`; `s:real^N->bool`]) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^N->bool` STRIP_ASSUME_TAC) THEN ABBREV_TAC `r = (s DIFF d) UNION UNIONS(IMAGE (\x. s INTER closure((t:real^N->real^N->bool) x)) q)` THEN EXISTS_TAC `s DIFF r:real^N->bool` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN EXPAND_TAC "r" THEN MATCH_MP_TAC CLOSED_IN_UNION THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]; ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "r" THEN REWRITE_TAC[IN_UNION; UNIONS_IMAGE; IN_DIFF; IN_ELIM_THM] THEN SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; ASM_REWRITE_TAC[IN_INTER; NOT_EXISTS_THM]] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `s INTER closure((t:real^N->real^N->bool) y) SUBSET s DIFF u` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSURE_MINIMAL_LOCAL THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(r:real^N->bool) SUBSET s` ASSUME_TAC THENL [EXPAND_TAC "r" THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> (s DIFF d) UNION t SUBSET s`) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN SET_TAC[]; ASM_SIMP_TAC[SET_RULE `r SUBSET s ==> s DIFF (s DIFF r) = r`]] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\x:real^N. connected_component r x) q` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[components; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN MP_TAC(ASSUME `(y:real^N) IN r`) THEN EXPAND_TAC "r" THEN GEN_REWRITE_TAC LAND_CONV [IN_UNION] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_DIFF; UNIONS_IMAGE; IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (~q /\ p ==> r) ==> p \/ q ==> r`) THEN CONJ_TAC THENL [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected_component]] THEN EXISTS_TAC `s INTER closure ((t:real^N->real^N->bool) z)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `(t:real^N->real^N->bool) z` THEN REWRITE_TAC[INTER_SUBSET] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET_INTER]] THEN REWRITE_TAC[CLOSURE_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN REWRITE_TAC[open_in] THEN ASM SET_TAC[]; EXPAND_TAC "r" THEN REWRITE_TAC[UNIONS_IMAGE] THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM_REWRITE_TAC[IN_INTER] THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN REWRITE_TAC[open_in] THEN MP_TAC(ISPEC `(t:real^N->real^N->bool) z` CLOSURE_SUBSET) THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_CASES_TAC `(y:real^N) IN d` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(y:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(y:real^N) IN c` THENL [MATCH_MP_TAC(TAUT `p ==> ~p ==> r`) THEN SUBGOAL_THEN `y IN UNIONS (IMAGE (t:real^N->real^N->bool) q)` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM]] THEN REWRITE_TAC[IN_INTER] THEN ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]; DISCH_THEN(K ALL_TAC)] THEN SUBGOAL_THEN `~((s INTER closure(connected_component (s DIFF c) y)) INTER c :real^N->bool = {})` MP_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s INTER l SUBSET s DIFF c) ==> ~((s INTER l) INTER c = {})`) THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` CONNECTED_CLOPEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `connected_component (s DIFF c) y:real^N->bool`) THEN ASM_REWRITE_TAC[NOT_IMP; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF] THEN REPEAT CONJ_TAC THENL [TRANS_TAC OPEN_IN_TRANS `s DIFF c:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_MESON_TAC[CLOSED_SUBSET; COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET; SUBSET_TRANS]; REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `c y /\ c SUBSET closure c ==> y IN closure c`) THEN ASM_REWRITE_TAC[CLOSURE_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN ASM_REWRITE_TAC[IN_DIFF]; MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `connected_component (s DIFF c) y:real^N->bool` THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; INTER_SUBSET]]; ALL_TAC] THEN REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[]; MATCH_MP_TAC(SET_RULE `connected_component (s DIFF c) y SUBSET s DIFF c /\ c SUBSET s /\ ~(c = {}) ==> ~(connected_component (s DIFF c) y = s)`) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]]; ALL_TAC] THEN REWRITE_TAC[closure] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~((s INTER (cl UNION l)) INTER c = {}) ==> cl SUBSET s DIFF c ==> ?x. x IN c /\ x IN s /\ x IN l`)) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `(z:real^N) IN d` THENL [MP_TAC(ISPECL [`s:real^N->bool`; `connected_component (s DIFF c) (y:real^N)`; `d:real^N->bool`; `z:real^N`] LIMIT_POINT_OF_LOCAL_IMP) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s DIFF c:real^N->bool`; `y:real^N`] CONNECTED_COMPONENT_SUBSET) THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `z IN UNIONS (IMAGE (t:real^N->real^N->bool) q)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `connected_component (s DIFF c) (y:real^N)`; `(t:real^N->real^N->bool) w`; `z:real^N`] LIMIT_POINT_OF_LOCAL_IMP) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected_component]] THEN EXISTS_TAC `connected_component (s DIFF c) y UNION (t:real^N->real^N->bool) w` THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ASM SET_TAC[]; EXPAND_TAC "r" THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> s UNION t SUBSET s' UNION t'`) THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; SUBSET] THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N`) THEN REWRITE_TAC[open_in] THEN MP_TAC(ISPEC `(t:real^N->real^N->bool) w` CLOSURE_SUBSET) THEN ASM SET_TAC[]]; MATCH_MP_TAC(SET_RULE `c y ==> y IN c UNION s`) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF]; ASM SET_TAC[]]);; let SEMI_LOCALLY_CONNECTED_GEN = prove (`!s:real^N->bool. FINITE(components s) /\ locally compact s /\ locally connected s ==> !x v. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ u SUBSET v /\ FINITE(components(s DIFF u))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[open_in]) THEN SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `connected_component s (x:real^N)` SEMI_LOCALLY_CONNECTED) THEN ANTS_TAC THENL [REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ASM_SIMP_TAC[LOCALLY_CONNECTED_CONNECTED_COMPONENT] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `connected_component s (x:real^N) INTER v`]) THEN ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL]; REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN REWRITE_TAC[SUBSET_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] OPEN_IN_TRANS)) THEN ASM_SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED]; ALL_TAC] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `components(connected_component s (x:real^N) DIFF u) UNION components s` THEN ASM_REWRITE_TAC[FINITE_UNION] THEN REWRITE_TAC[components; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN ASM_CASES_TAC `(y:real^N) IN connected_component s x` THEN REWRITE_TAC[IN_UNION] THENL [DISJ1_TAC; DISJ2_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^N` THENL [SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y` SUBST1_TAC THENL [ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN ASM_MESON_TAC[IN]; ALL_TAC]; ALL_TAC] THEN ONCE_REWRITE_TAC[connected_component] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `c:real^N->bool` THEN REWRITE_TAC[SET_RULE `s SUBSET t DIFF u <=> s SUBSET t /\ DISJOINT s u`] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET_TRANS; CONNECTED_COMPONENT_SUBSET]; MP_TAC(ISPECL [`s:real^N->bool`; `y:real^N`; `x:real^N`] CONNECTED_COMPONENT_DISJOINT) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s' SUBSET s /\ t' SUBSET t ==> DISJOINT s t ==> DISJOINT s' t'`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);; let SEMI_LOCALLY_CONNECTED_COMPACT = prove (`!s:real^N->bool. compact s /\ locally connected s ==> !x v. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ u SUBSET v /\ FINITE(components(s DIFF u))`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SEMI_LOCALLY_CONNECTED_GEN THEN ASM_SIMP_TAC[FINITE_COMPONENTS; CLOSED_IMP_LOCALLY_COMPACT; COMPACT_IMP_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Locally convex sets. *) (* ------------------------------------------------------------------------- *) let LOCALLY_CONVEX = prove (`!s:real^N->bool. locally convex s <=> !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\ open_in (subtopology euclidean s) u /\ convex v`, GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN MESON_TAC[SUBSET_INTER]; MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN EXISTS_TAC `cball(x:real^N,e) INTER v` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL; CONVEX_INTER; CONVEX_CBALL; IN_INTER] THEN MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Various sufficient conditions for continuity. These are mainly from the *) (* papers by Klee & Utz, Pervin & Levine, and Tanaka. *) (* ------------------------------------------------------------------------- *) let PROPER_MAP_TO_COMPACT = prove (`!f:real^M->real^N s t. (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ compact t /\ IMAGE f s SUBSET t ==> f continuous_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] CONTINUOUS_ON_CLOSED_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_COMPACT)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_SIMP_TAC[CLOSED_SUBSET_EQ; COMPACT_IMP_CLOSED; SUBSET_RESTRICT]);; let CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP = prove (`!f:real^M->real^N s x. (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\ x IN s ==> (f continuous (at x within s) <=> !p y. (!n. p n IN s) /\ (p --> x) sequentially /\ (!n. f(p n) = y) ==> f x = y)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:num->real^M` THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:real^M->real^N) o (p:num->real^M)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_REWRITE_TAC[o_DEF; LIM_CONST]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_ALT] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`e:real`; `p:num->real^M`] THEN STRIP_TAC THEN ASM_CASES_TAC `?y. INFINITE {n:num | (f:real^M->real^N) (p n) = y}` THENL [FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`(p:num->real^M) o (r:num->num)`; `y:real^N`] THEN ASM_SIMP_TAC[o_THM; LIM_SUBSEQUENCE] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (MESON[INFINITE; FINITE_EMPTY] `INFINITE s ==> ~(s = {})`)) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[DIST_REFL]; ALL_TAC] THEN SUBGOAL_THEN `?r. (!n m. m < n ==> (r:num->num) m < r n) /\ (!n m. m < n ==> ~((f:real^M->real^N)(p(r m)) = f(p(r n))))` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?r. !n. r n = @y. !m. m < n ==> (r:num->num) m < y /\ ~((f:real^M->real^N)(p(r m)) = f(p y))` MP_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN CONV_TAC SELECT_CONV THEN MP_TAC(ISPECL [`\i:num. i`; `UNIONS {{i | (f:real^M->real^N)(p i) = f(p(r m:num))} | m | m IN {m:num | m < n}}`] UPPER_BOUND_FINITE_SET) THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM; INFINITE]) THEN ASM_REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[FINITE_IMAGE; SIMPLE_IMAGE; FINITE_NUMSEG_LT] THEN REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `m:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[ARITH_RULE `m < N + 1 <=> m <= N`] THEN MESON_TAC[ARITH_RULE `~(N + 1 <= N)`]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `(x:real^M) INSERT IMAGE (p o (r:num->num)) (:num)`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_SEQUENCE_WITH_LIMIT; LIM_SUBSEQUENCE] THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_DIFF)) THEN REWRITE_TAC[OPEN_BALL] THEN ASM_SIMP_TAC[CENTRE_IN_BALL; SET_RULE `f x IN b ==> IMAGE f (x INSERT s) DIFF b = IMAGE f s DIFF b`] THEN REWRITE_TAC[IMAGE_o] THEN RULE_ASSUM_TAC(REWRITE_RULE [ONCE_REWRITE_RULE[DIST_SYM] (GSYM IN_BALL); NOT_EXISTS_THM]) THEN ASM_SIMP_TAC[SET_RULE `(!n. ~(f(p n) IN s)) ==> IMAGE f (IMAGE p t) DIFF s = IMAGE f (IMAGE p t)`] THEN GEN_REWRITE_TAC LAND_CONV [COMPACT_EQ_BOLZANO_WEIERSTRASS] THEN SUBGOAL_THEN `!m n. (f:real^M->real^N) (p ((r:num->num) m)) = f (p (r n)) <=> m = n` ASSUME_TAC THENL [MATCH_MP_TAC WLOG_LT THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) (IMAGE p (IMAGE (r:num->num) (:num)))`) THEN REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC INFINITE_IMAGE THEN REWRITE_TAC[num_INFINITE; IN_UNIV; o_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^M) INSERT (IMAGE (p o (r:num->num)) (:num) DELETE p(r i))`) THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_SEQUENCE_WITH_LIMIT_GEN)) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMAGE_CLAUSES] THEN W(MP_TAC o PART_MATCH (lhand o rand) (SET_RULE `(!i. i IN s /\ f i = f a ==> i = a) ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a`) o rand o rand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) (p((r:num->num) i))`) THEN ASM_SIMP_TAC[LIMPT_INSERT; LIMPT_DELETE; IMAGE_o; IN_DELETE; IN_INSERT] THEN ASM_MESON_TAC[CENTRE_IN_BALL]);; let COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N s. (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\ (!y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y}) ==> f continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `x:real^M`] CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:num->real^M`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[LIMPT_SEQUENTIAL] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `p:num->real^M`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN ASM_MESON_TAC[]);; let COMPACT_CONTINUOUS_IMAGE_EQ = prove (`!f:real^M->real^N s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (f continuous_on s <=> !t. compact t /\ t SUBSET s ==> compact(IMAGE f t))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; DISCH_TAC] THEN MATCH_MP_TAC COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN CONJ_TAC THENL [ASM_MESON_TAC[]; X_GEN_TAC `y:real^N`] THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x = y} = {} \/ ?x. x IN s /\ {x | x IN s /\ (f:real^M->real^N) x = y} = {x}` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[CLOSED_IN_EMPTY]; ASM_REWRITE_TAC[CLOSED_IN_SING]]);; let CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN = prove (`!P f:real^M->real^N s. locally P s /\ (!c. P c ==> connected c) ==> (f continuous_on s <=> (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\ (!c. c SUBSET s /\ P c ==> connected(IMAGE f c)))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; STRIP_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP] THEN MAP_EVERY X_GEN_TAC [`p:num->real^M`; `b:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `!n. ?c x. a IN c /\ x IN c /\ (f:real^M->real^N) x = b /\ P c /\ c SUBSET s /\ c SUBSET ball(a,inv(&n + &1))` MP_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN DISCH_THEN(MP_TAC o SPECL [`s INTER ball(a:real^M,inv(&n + &1))`; `a:real^M`]) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^M->bool` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN REWRITE_TAC[SUBSET_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m:num`)) THEN REWRITE_TAC[LE_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL] THEN DISCH_TAC THEN EXISTS_TAC `(p:num->real^M) m` THEN ASM SET_TAC[]; PURE_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN MAP_EVERY X_GEN_TAC [`c:num->real^M->bool`; `x:num->real^M`] THEN STRIP_TAC] THEN SUBGOAL_THEN `!n. ?u. u IN c n /\ (f:real^M->real^N) u IN ball(b,inv(&n + &1)) DELETE b` MP_TAC THENL [X_GEN_TAC `n:num` THEN SUBGOAL_THEN `connected (IMAGE (f:real^M->real^N) (c(n:num)))` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `b:real^N` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CONNECTED_IMP_PERFECT)) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[limit_point_of]] THEN DISCH_THEN(MP_TAC o SPEC `ball(b:real^N,inv(&n + &1))`) THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; PURE_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `u:num->real^M` THEN REWRITE_TAC[FORALL_AND_THM; IN_DELETE] THEN STRIP_TAC] THEN SUBGOAL_THEN `compact(IMAGE (f:real^M->real^N) (a INSERT IMAGE u (:num)))` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ONCE_REWRITE_TAC[DIST_SYM]] THEN REWRITE_TAC[GSYM IN_BALL] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `ball(a:real^M,inv(&m + &1)) SUBSET ball(a,inv(&n + &1))` (fun th -> ASM SET_TAC[th]) THEN MATCH_MP_TAC SUBSET_BALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `b:real^N`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ONCE_REWRITE_TAC[DIST_SYM]] THEN REWRITE_TAC[GSYM IN_BALL] THEN ASM SET_TAC[]]);; let CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING = prove (`!f:real^M->real^N s. locally connected s ==> (f continuous_on s <=> (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_EQ_COMPACT_PATH_CONNECTED_PRESERVING = prove (`!f:real^M->real^N s. locally path_connected s ==> (f continuous_on s <=> (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\ (!c. c SUBSET s /\ path_connected c ==> path_connected(IMAGE f c)))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; PATH_CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN)) THEN ASM_MESON_TAC[PATH_CONNECTED_IMP_CONNECTED]]);; let CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON = prove (`!f:real^N->real^1 s t. IMAGE f s SUBSET t /\ locally connected s /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\ (!y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y}) ==> f continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN DISCH_THEN(MP_TAC o SPECL [`s DIFF {y:real^N | y IN s /\ f y IN sphere(f x:real^1,e)}`; `x:real^N`]) THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[SPHERE_1; REAL_ARITH `&0 < e ==> ~(e < &0)`] THEN ASM_SIMP_TAC[CLOSED_IN_UNION; SET_RULE `{x | x IN s /\ f x IN {a,b}} = {x | x IN s /\ f x = a} UNION {x | x IN s /\ f x = b}`]; ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_SPHERE; DIST_REFL] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]]; DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `IMAGE (f:real^N->real^1) u SUBSET ball(f x,e)` MP_TAC THENL [MP_TAC(ISPECL [`IMAGE (f:real^N->real^1) u`; `ball((f:real^N->real^1) x,e)`] CONNECTED_INTER_FRONTIER) THEN ASM_SIMP_TAC[FRONTIER_BALL] THEN SUBGOAL_THEN `(f:real^N->real^1) x IN ball(f x,e)` MP_TAC THENL [ASM_REWRITE_TAC[CENTRE_IN_BALL]; ASM SET_TAC[]]; REWRITE_TAC[IN_BALL; FORALL_IN_IMAGE; SUBSET] THEN ASM_MESON_TAC[DIST_SYM]]]);; let CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES = prove (`!f:real^M->real^N s. (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\ (!y. connected {x | x IN s /\ f x = y}) ==> !y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y}`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN ABBREV_TAC `t = {x | x IN s /\ (f:real^M->real^N) x = b}` THEN ASM_CASES_TAC `t:real^M->bool = {}` THEN ASM_SIMP_TAC[CLOSED_IN_EMPTY] THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `connected(IMAGE (f:real^M->real^N) (a INSERT t))` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CONNECTED_INSERT_LIMPT] THEN ASM SET_TAC[]; REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`{b:real^N}`; `{(f:real^M->real^N) a}`]) THEN REWRITE_TAC[CLOSED_IN_SING] THEN ASM SET_TAC[]]);; let CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON = prove (`!f:real^N->real^1 s t. IMAGE f s SUBSET t /\ locally connected s /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\ (!y. connected {x | x IN s /\ f x = y}) ==> f continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN EXISTS_TAC `t:real^1->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES THEN ASM_REWRITE_TAC[]);; let CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N s t. compact t /\ (!y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y}) /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) ==> f continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CLOSED_SUBSET_EQ; COMPACT_IMP_CLOSED]);; let CLOSED_CONNECTED_PREIMAGES_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N s t. compact t /\ (!y. connected {x | x IN s /\ f x = y}) /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) ==> f continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES THEN ASM_REWRITE_TAC[]);; let BICONNECTED_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N s t. FINITE (components t) /\ locally compact t /\ locally connected t /\ IMAGE f s = t /\ (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\ (!c. c SUBSET t /\ connected c ==> connected {x | x IN s /\ f x IN c}) ==> f continuous_on s`, let lemma = prove (`{n | f n IN UNIONS a} = UNIONS {{n | f n IN s} | s IN a}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `p:real^M` THEN DISCH_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_INJ] THEN X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN REWRITE_TAC[TENDSTO_ALT; EVENTUALLY_SEQUENTIALLY; o_DEF] THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `FINITE {n:num | (f:real^M->real^N) (x n) IN (t DIFF v)}` THENL [FIRST_ASSUM(MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_DIFF] THEN MATCH_MP_TAC(MESON[] `(!n. P n ==> Q(SUC n)) ==> (?n. P n) ==> (?n. Q n)`) THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[ARITH_RULE `~(SUC m <= n) <=> n <= m`] THEN ASM SET_TAC[]; MATCH_MP_TAC(TAUT `F ==> p`)] THEN SUBGOAL_THEN `?u. open_in (subtopology euclidean t) u /\ (f:real^M->real^N) p IN u /\ u SUBSET v /\ INFINITE {n:num | (f:real^M->real^N) (x n) IN t DIFF u} /\ FINITE(components(t DIFF u))` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `t:real^N->bool` SEMI_LOCALLY_CONNECTED_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`(f:real^M->real^N) p`; `t INTER v:real^N->bool`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM INFINITE]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INFINITE_SUPERSET)) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?c. c IN components (t DIFF u) /\ INFINITE {n:num | (f:real^M->real^N)(x n) IN c}` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `INFINITE {n:num | (f:real^M->real^N)(x n) IN t DIFF u}` THEN MP_TAC(ISPEC `t DIFF u:real^N->bool` UNIONS_COMPONENTS) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[lemma; INFINITE; FINITE_UNIONS] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M) INSERT {x | x IN s /\ (f:real^M->real^N) x IN c}`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_INSERT_LIMPT THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `t DIFF u:real^N->bool` THEN REWRITE_TAC[SUBSET_DIFF] THEN ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]]; FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIMPT_SEQUENTIAL] THEN EXISTS_TAC `(x:num->real^M) o (r:num->num)` THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE] THEN REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN ASM SET_TAC[]]; SUBGOAL_THEN `IMAGE f (p INSERT {x | x IN s /\ f x IN c}) = (f:real^M->real^N)(p) INSERT c` SUBST1_TAC THENL [MP_TAC(ISPECL [`t DIFF u:real^N->bool`; `c:real^N->bool`] IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM_SIMP_TAC[CONNECTED_INSERT] THEN REWRITE_TAC[closure; IN_UNION; DE_MORGAN_THM; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN MP_TAC(ISPECL [`t:real^N->bool`; `c:real^N->bool`; `(f:real^M->real^N) p`] LIMIT_POINT_OF_LOCAL) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Topological characterizations of non-strict monotonicity. *) (* ------------------------------------------------------------------------- *) let MONOTONE_TOPOLOGICALLY_IMP = prove (`!f s. (!c. connected c ==> connected {x | x IN s /\ f x IN c}) ==> (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) \/ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x))`, REPEAT STRIP_TAC THEN REWRITE_TAC[FORALL_LIFT; REAL_NON_MONOTONE; LIFT_DROP] THEN REWRITE_TAC[NOT_EXISTS_THM; FORALL_DROP; LIFT_DROP] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `{y | drop y < drop(f(b:real^1))}`); FIRST_X_ASSUM(MP_TAC o SPEC `{y | drop(f(b:real^1)) < drop y}`)] THEN REWRITE_TAC[NOT_IMP; GSYM IS_INTERVAL_CONNECTED_1] THEN (CONJ_TAC THENL [REWRITE_TAC[IS_INTERVAL_1_CASES] THEN SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `c:real^1`; `b:real^1`]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_REFL]);; let MONOTONE_TOPOLOGICALLY_EQ = prove (`!f s. (!c. connected c ==> connected {x | x IN s /\ f x IN c}) <=> is_interval s /\ ((!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) \/ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)))`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[MONOTONE_TOPOLOGICALLY_IMP] THENL [DISCH_THEN(MP_TAC o SPEC `(:real^1)`) THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN REWRITE_TAC[CONNECTED_UNIV; GSYM IS_INTERVAL_CONNECTED_1]; REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN SET_TAC[]]);; let MONOTONE_TOPOLOGICALLY = prove (`!f s. is_interval s ==> ((!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) \/ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)) <=> !c. connected c ==> connected {x | x IN s /\ f x IN c})`, SIMP_TAC[MONOTONE_TOPOLOGICALLY_EQ]);; let MONOTONE_TOPOLOGICALLY_INTO_1D = prove (`!f:real^N->real^1 s. connected s /\ f continuous_on s /\ (!y. connected {x | x IN s /\ f x = y}) ==> (!k. connected k ==> connected {x | x IN s /\ f x IN k})`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u0:real^N->bool`; `v0:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `DISJOINT (IMAGE (f:real^N->real^1) u0) (IMAGE f v0)` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT (IMAGE f s) (IMAGE f t) <=> !a b. a IN s /\ b IN t ==> ~(f a = f b)`] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^N->real^1) b`) THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN MAP_EVERY EXISTS_TAC [`{x | x IN s /\ (f:real^N->real^1) x = f b} INTER u0`; `{x | x IN s /\ (f:real^N->real^1) x = f b} INTER v0`] THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `{x | x IN s /\ (f:real^N->real^1) x IN k}` THEN ASM_SIMP_TAC[CLOSED_IN_REFL; CLOSED_IN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY UNDISCH_TAC [`~(v0:real^N->bool = {})`; `~(u0:real^N->bool = {})`] THEN PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ABBREV_TAC `a' = (f:real^N->real^1) a` THEN ABBREV_TAC `b' = (f:real^N->real^1) b` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v0:real^N->bool`; `u0:real^N->bool`; `b:real^N`; `a:real^N`; `b':real^1`; `a':real^1`] THEN REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN REPEAT CONJ_TAC THENL [SET_TAC[]; REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC) THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`p:real^N`; `q:real^N`] THEN MAP_EVERY X_GEN_TAC [`u0:real^N->bool`; `v0:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`u = {x | x IN u0 /\ (f:real^N->real^1) x IN segment[a,b]}`; `v = {x | x IN v0 /\ (f:real^N->real^1) x IN segment[a,b]}`] THEN SUBGOAL_THEN `(a:real^1) IN k /\ b IN k` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment[a:real^1,b] SUBSET k` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_CONVEX_1; CONVEX_CONTAINS_SEGMENT]; ALL_TAC] THEN SUBGOAL_THEN `closed_in (subtopology euclidean s) (u:real^N->bool) /\ closed_in (subtopology euclidean s) (v:real^N->bool)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `{x | x IN s /\ (f:real^N->real^1) x IN segment[a,b]}` THEN (CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_SEGMENT]]) THENL [EXPAND_TAC "u" THEN UNDISCH_TAC `closed_in (subtopology euclidean {x | x IN s /\ (f:real^N->real^1) x IN k}) u0`; EXPAND_TAC "v" THEN UNDISCH_TAC `closed_in (subtopology euclidean {x | x IN s /\ (f:real^N->real^1) x IN k}) v0`] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `connected(s:real^N->bool)` THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN MAP_EVERY EXISTS_TAC [`u UNION {x:real^N | x IN s /\ f x IN {t | drop t <= drop a}}`; `v UNION {x:real^N | x IN s /\ f x IN {t | drop b <= drop t}}`] THEN SUBGOAL_THEN `segment [a,b] UNION {t | drop t <= drop a} UNION {t | drop b <= drop t} = (:real^1)` ASSUME_TAC THENL [ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE; EXTENSION; IN_UNIV] THEN REWRITE_TAC[IN_UNION; IN_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]; MATCH_MP_TAC CLOSED_IN_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]; ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]; ASM SET_TAC[]] THEN REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `u UNION {x:real^N | x IN s /\ drop(f x) <= drop a} = u UNION {x | x IN s /\ drop(f x) < drop a} /\ v UNION {x:real^N | x IN s /\ drop b <= drop(f x)} = v UNION {x | x IN s /\ drop b < drop(f x)}` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN MATCH_MP_TAC(SET_RULE `(!x. P x /\ R x ==> x IN u) ==> u UNION {x | P x /\ Q x} = u UNION {x | P x /\ Q x /\ ~R x}`) THEN MAP_EVERY EXPAND_TAC ["u"; "v"] THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[ENDS_IN_SEGMENT] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `DISJOINT u v /\ DISJOINT u' v' /\ DISJOINT u v' /\ DISJOINT v u' ==> (u UNION u') INTER (v UNION v') = {}`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY EXPAND_TAC ["u"; "v"] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY; DISJOINT] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; IN_INTERVAL_1; SEGMENT_1] THEN REAL_ARITH_TAC);; let MONOTONE_TOPOLOGICALLY_INTO_1D_EQ = prove (`!f:real^N->real^1 s. f continuous_on s ==> ((!k. connected k ==> connected {x | x IN s /\ f x IN k}) <=> connected s /\ (!y. connected {x | x IN s /\ f x = y}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[MONOTONE_TOPOLOGICALLY_INTO_1D]] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `(:real^1)`) THEN REWRITE_TAC[CONNECTED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`]; REWRITE_TAC[GSYM IN_SING] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CONNECTED_SING]]);; let MONOTONE_TOPOLOGICALLY_POINTS = prove (`!f:real^1->real^1 s. is_interval s /\ f continuous_on s ==> ((!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) \/ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x)) <=> !a. connected {x | x IN s /\ f x = a})`, SIMP_TAC[MONOTONE_TOPOLOGICALLY; MONOTONE_TOPOLOGICALLY_INTO_1D_EQ] THEN SIMP_TAC[IS_INTERVAL_CONNECTED]);; let MONOTONE_TOPOLOGICALLY_POINTS_IMP = prove (`!f s. f continuous_on s /\ is_interval s /\ (!y. connected {x | x IN s /\ f x = y}) ==> (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f x) <= drop(f y)) \/ (!x y. x IN s /\ y IN s /\ drop x <= drop y ==> drop(f y) <= drop(f x))`, SIMP_TAC[MONOTONE_TOPOLOGICALLY_POINTS]);; let MONOTONE_IMP_HOMEOMORPHISM_1D = prove (`!f s t. is_interval s /\ is_interval t /\ IMAGE f s = t /\ ((!x y. x IN s /\ y IN s /\ drop x < drop y ==> drop(f x) < drop(f y)) \/ (!x y. x IN s /\ y IN s /\ drop x < drop y ==> drop(f x) < drop(f y))) ==> ?g. homeomorphism(s,t) (f,g)`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s ==> ((f:real^1->real^1) x = f y <=> x = y)` ASSUME_TAC THENL [REWRITE_TAC[GSYM INJECTIVE_ON_ALT] THEN REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN ASM_MESON_TAC[REAL_NOT_LE]; ALL_TAC] THEN EXPAND_TAC "t" THEN W(MP_TAC o PART_MATCH (rand o rand) INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM o snd) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[IS_INTERVAL_PATH_CONNECTED] THEN MATCH_MP_TAC CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON THEN EXISTS_TAC `t:real^1->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; GSYM IS_INTERVAL_CONVEX_1] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`] INJECTIVE_ON_LEFT_INVERSE) THEN ASM_REWRITE_TAC[INJECTIVE_ON_ALT] THEN DISCH_THEN(X_CHOOSE_TAC `g:real^1->real^1`) THEN MP_TAC(ISPECL [`g:real^1->real^1`; `t:real^1->bool`] MONOTONE_TOPOLOGICALLY) THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[GSYM REAL_NOT_LT; CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_FORALL] THEN X_GEN_TAC `c:real^1->bool` THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; X_GEN_TAC `y:real^1` THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^1->real^1) x = y} = {} \/ ?a. {x | x IN s /\ f x = y} = {a}` MP_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> {x | x IN s /\ f x = a} = {} \/ ?b. {x | x IN s /\ f x = a} = {b}`) THEN ASM_MESON_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EMPTY; CONNECTED_SING]]]);; let MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ locally compact s /\ locally connected t /\ f continuous_on s /\ (!y. compact {x | x IN s /\ f x = y}) /\ (!c. c SUBSET t /\ connected c ==> connected {x | x IN s /\ f x IN c}) ==> (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k})`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[PROPER_MAP; SUBSET_REFL] THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> q /\ ~r ==> ~p`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `s DIFF k:real^M->bool`] LOCALLY_COMPACT_OPEN_IN) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN ABBREV_TAC `b:real^M->bool = closure u DIFF u` THEN SUBGOAL_THEN `(b:real^M->bool) SUBSET v` ASSUME_TAC THENL [EXPAND_TAC "b" THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `compact(b:real^M->bool)` ASSUME_TAC THENL [MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `v:real^M->bool` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "b" THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_CLOSURE] THEN ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s DIFF k:real^M->bool` THEN ASM SET_TAC[]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN DISCH_THEN(MP_TAC o SPECL [`t DIFF IMAGE (f:real^M->real^N) b`; `y:real^N`]) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `r:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`t:real^N->bool`; `IMAGE (f:real^M->real^N) k`; `y:real^N`] LIMIT_POINT_OF_LOCAL) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN DISCH_THEN(MP_TAC o SPEC `r:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `{x | x IN s /\ (f:real^M->real^N) x IN r}` CONNECTED_OPEN_IN) THEN MATCH_MP_TAC(TAUT `p /\ (r ==> q) ==> (p <=> ~q) ==> ~r`) THEN CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; DISCH_TAC] THEN MAP_EVERY EXISTS_TAC [`{x | x IN s /\ (f:real^M->real^N) x IN r} INTER u`; `{x | x IN s /\ (f:real^M->real^N) x IN r} DIFF closure u`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s DIFF k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL]; SIMP_TAC[OPEN_IN_DIFF_CLOSED; CLOSED_CLOSURE]; ASM SET_TAC[]; MP_TAC(ISPEC `u:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]]);; let MONOTONE_INTO_1D_IMP_PROPER_MAP = prove (`!f:real^N->real^1 s t. connected s /\ locally compact s /\ f continuous_on s /\ IMAGE f s = t /\ (!y. compact {x | x IN s /\ f x = y}) /\ (!y. connected {x | x IN s /\ f x = y}) ==> (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_IMP_LOCALLY_CONNECTED THEN REWRITE_TAC[CONVEX_CONNECTED_1] THEN ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]; ASM_MESON_TAC[MONOTONE_TOPOLOGICALLY_INTO_1D]]);; let MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP_GEN = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ locally compact s /\ locally connected t /\ (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\ (!y. compact {x | x IN s /\ f x = y}) /\ (!c. c SUBSET t /\ connected c ==> connected {x | x IN s /\ f x IN c}) ==> (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[SUBSET_RESTRICT] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Sura-Bura's results about compact components of sets. *) (* ------------------------------------------------------------------------- *) let SURA_BURA_COMPACT = prove (`!s c:real^N->bool. compact s /\ c IN components s ==> c = INTERS {t | c SUBSET t /\ open_in (subtopology euclidean s) t /\ closed_in (subtopology euclidean s) t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [components]) THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN SUBGOAL_THEN `(x:real^N) IN c` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN REWRITE_TAC[IN_ELIM_THM; CONNECTED_COMPONENT_SUBSET; OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]] THEN W(fun (asl,w) -> ABBREV_TAC(mk_eq(`k:real^N->bool`,rand w))) THEN SUBGOAL_THEN `closed(k:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "k" THEN MATCH_MP_TAC CLOSED_INTERS THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`k1:real^N->bool`; `k2:real^N->bool`] SEPARATION_NORMAL) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`v1:real^N->bool`; `v2:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s DIFF (v1 UNION v2):real^N->bool`; `{t:real^N->bool | connected_component s x SUBSET t /\ open_in (subtopology euclidean s) t /\ closed_in (subtopology euclidean s) t}`] COMPACT_IMP_FIP) THEN ASM_SIMP_TAC[NOT_IMP; COMPACT_DIFF; OPEN_UNION; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM]; ASM SET_TAC[]] THEN X_GEN_TAC `f:(real^N->bool)->bool` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c0:real^N->bool. c SUBSET c0 /\ c0 SUBSET (v1 UNION v2) /\ open_in (subtopology euclidean s) c0 /\ closed_in (subtopology euclidean s) c0` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV; OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN UNDISCH_TAC `(s DIFF (v1 UNION v2)) INTER INTERS f :real^N->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; INTER_UNIV] THEN SET_TAC[]; EXISTS_TAC `INTERS f :real^N->bool` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(s DIFF u) INTER t = {} ==> t SUBSET s ==> t SUBSET u`)) THEN MATCH_MP_TAC(SET_RULE `~(f = {}) /\ (!s. s IN f ==> s SUBSET t) ==> INTERS f SUBSET t`) THEN ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[]; MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_SIMP_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `connected(c:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN SUBGOAL_THEN `closed_in (subtopology euclidean c0) (c0 INTER v1 :real^N->bool) /\ closed_in (subtopology euclidean c0) (c0 INTER v2 :real^N->bool)` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC(MESON[] `closed_in top (c INTER closure v) /\ c INTER closure v = c INTER v ==> closed_in top (c INTER v)`) THEN (CONJ_TAC THENL [MESON_TAC[CLOSED_IN_CLOSED; CLOSED_CLOSURE]; ALL_TAC]) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c0 SUBSET vv ==> c0 INTER (vv INTER v') = c0 INTER v ==> c0 INTER v' = c0 INTER v`)) THEN REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER; UNION_OVER_INTER] THEN SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`; CLOSURE_SUBSET] THENL [ALL_TAC; ONCE_REWRITE_TAC[UNION_COMM]] THEN MATCH_MP_TAC(SET_RULE `t = {} ==> s UNION (u INTER t) = s`) THEN ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u1:real^N->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `u2:real^N->bool` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `closed(c0:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN REWRITE_TAC[CONNECTED_CLOSED] THEN MAP_EVERY EXISTS_TAC [`c0 INTER u1:real^N->bool`; `c0 INTER u2:real^N->bool`] THEN ASM_SIMP_TAC[CLOSED_INTER] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL [STRIP_TAC THEN SUBGOAL_THEN `c SUBSET (c0 INTER v2 :real^N->bool)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `k SUBSET (c0 INTER v2 :real^N->bool)` ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]]; STRIP_TAC THEN SUBGOAL_THEN `c SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `k SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]]] THEN (UNDISCH_THEN `k1 UNION k2 :real^N->bool = k` (K ALL_TAC) THEN EXPAND_TAC "k" THEN MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_INTER_OPEN THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER_CLOSED THEN ASM_REWRITE_TAC[]]));; let SURA_BURA_CLOPEN_SUBSET = prove (`!s c u:real^N->bool. locally compact s /\ c IN components s /\ compact c /\ open u /\ c SUBSET u ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\ c SUBSET k /\ k SUBSET u`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_SUBOPEN]) THEN DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `u:real^N->bool`]) THEN ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`k:real^N->bool`; `c:real^N->bool`] SURA_BURA_COMPACT) THEN ASM_SIMP_TAC[CLOSED_IN_COMPACT_EQ] THEN ANTS_TAC THENL [MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; DISCH_THEN(ASSUME_TAC o SYM)] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(ISPECL [`(:real^N) DIFF (u INTER w)`; `{t:real^N->bool | c SUBSET t /\ open_in (subtopology euclidean k) t /\ compact t /\ t SUBSET k}`] CLOSED_IMP_FIP_COMPACT) THEN ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_INTER; FORALL_IN_GSPEC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM; SET_RULE `(UNIV DIFF u) INTER s = {} <=> s SUBSET u`] THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; FINITE_EMPTY] THEN REWRITE_TAC[SET_RULE `UNIV SUBSET s INTER t <=> s = UNIV /\ t = UNIV`] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[INTER_UNIV]) THEN UNDISCH_THEN `s:real^N->bool = v` (SUBST_ALL_TAC o SYM) THEN SUBGOAL_THEN `k:real^N->bool = s` SUBST_ALL_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET_UNIV]] THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; OPEN_IN_REFL]; STRIP_TAC THEN EXISTS_TAC `INTERS f:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_INTERS] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[]; EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `(!t. t IN f ==> t SUBSET s) /\ ~(f = {}) ==> INTERS f SUBSET s`) THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]]]);; let SURA_BURA_CLOPEN_SUBSET_ALT = prove (`!s c u:real^N->bool. locally compact s /\ c IN components s /\ compact c /\ open_in (subtopology euclidean s) u /\ c SUBSET u ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\ c SUBSET k /\ k SUBSET u`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`] SURA_BURA_CLOPEN_SUBSET) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]);; let SURA_BURA = prove (`!s c:real^N->bool. locally compact s /\ c IN components s /\ compact c ==> c = INTERS {k | c SUBSET k /\ compact k /\ open_in (subtopology euclidean s) k}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN MP_TAC(ISPECL [`{x:real^N}`; `c:real^N->bool`] SEPARATION_NORMAL) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SING] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`] SURA_BURA_CLOPEN_SUBSET) THEN ASM_REWRITE_TAC[IN_INTERS; NOT_FORALL_THM; IN_ELIM_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM SET_TAC[]);; let COMPONENT_CLOPEN_HAUSDIST_EXPLICIT = prove (`!s c:real^N->bool e. &0 < e /\ locally compact s /\ c IN components s /\ compact c ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\ c SUBSET k /\ k SUBSET {x + d | x IN c /\ d IN ball(vec 0,e)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SURA_BURA_CLOPEN_SUBSET THEN ASM_SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]);; let COMPONENT_CLOPEN_HAUSDIST = prove (`!s c:real^N->bool e. &0 < e /\ locally compact s /\ c IN components s /\ compact c ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\ c SUBSET k /\ hausdist(c,k) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `e / &2`] COMPONENT_CLOPEN_HAUSDIST_EXPLICIT) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY ASM_CASES_TAC [`c:real^N->bool = {}`; `k:real^N->bool = {}`] THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[CENTRE_IN_CBALL; VECTOR_ADD_RID] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `t SUBSET u ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s /\ y IN u}`) THEN REWRITE_TAC[BALL_SUBSET_CBALL]]);; let COMPONENT_INTERMEDIATE_CLOPEN = prove (`!s t u:real^N->bool. t IN components s /\ open_in (subtopology euclidean s) u /\ t SUBSET u /\ (dimindex(:N) = 1 \/ (?r:real^1->bool. s homeomorphic r) \/ locally connected s \/ (locally compact s /\ compact t)) ==> ?c. closed_in (subtopology euclidean s) c /\ open_in (subtopology euclidean s) c /\ t SUBSET c /\ c SUBSET u`, let lemma = prove (`!s t u:real^1->bool. bounded s /\ t IN components s /\ open_in (subtopology euclidean s) u /\ t SUBSET u ==> ?c. closed_in (subtopology euclidean s) c /\ open_in (subtopology euclidean s) c /\ t SUBSET c /\ c SUBSET u`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN DISCH_TAC THEN SUBGOAL_THEN `?a b:real^1. s INTER interval[a,b] = t` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `d:real^1->bool` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(ISPECL [`d:real^1->bool`; `t:real^1->bool`] EXISTS_COMPONENT_SUPERSET) THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(X_CHOOSE_TAC `b:real^1` o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN MP_TAC(ISPEC `c INTER interval[--b:real^1,b]` CONNECTED_COMPACT_INTERVAL_1) THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN MATCH_MP_TAC IS_INTERVAL_INTER THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN ASM_MESON_TAC[IS_INTERVAL_CONNECTED_1; IN_COMPONENTS_CONNECTED]; MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_MESON_TAC[CLOSED_COMPONENTS; COMPACT_INTERVAL]]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `drop a <= drop b` ASSUME_TAC THENL [REWRITE_TAC[GSYM INTERVAL_NE_EMPTY_1] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?a'. drop a' <= drop a /\ ~(a' IN s) /\ s INTER interval[a',b] SUBSET u` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `(a:real^1) IN s` THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTER] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC] THEN SUBGOAL_THEN `~(interval[a - lift r,a] SUBSET s)` MP_TAC THENL [DISCH_TAC THEN MP_TAC(ISPECL [`s:real^1->bool`; `t UNION interval [a - lift r,a]`; `t:real^1->bool`] COMPONENTS_MAXIMAL) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_INTERVAL; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `a:real^1` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTER; ENDS_IN_INTERVAL] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; UNION_SUBSET]; ASM SET_TAC[]; EXPAND_TAC "t" THEN REWRITE_TAC[UNION_SUBSET; SUBSET_INTER] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[SUBSET; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a':real^1` THEN REWRITE_TAC[NOT_IMP; IN_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN MP_TAC(ISPECL [`a':real^1`; `b:real^1`; `a:real^1`] UNION_INTERVAL_1) THEN ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM INTERVAL_NE_EMPTY_1] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER s SUBSET u ==> i SUBSET b ==> s INTER i SUBSET u`)) THEN REWRITE_TAC[CBALL_INTERVAL; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `?b'. drop b <= drop b' /\ ~(b' IN s) /\ s INTER interval[a',b'] SUBSET u` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `(b:real^1) IN s` THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^1`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTER] THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC] THEN SUBGOAL_THEN `~(interval[b,b + lift r] SUBSET s)` MP_TAC THENL [DISCH_TAC THEN MP_TAC(ISPECL [`s:real^1->bool`; `t UNION interval [b,b + lift r]`; `t:real^1->bool`] COMPONENTS_MAXIMAL) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_INTERVAL; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `b:real^1` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTER; ENDS_IN_INTERVAL] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_ADD; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; UNION_SUBSET]; ASM SET_TAC[]; EXPAND_TAC "t" THEN REWRITE_TAC[UNION_SUBSET; SUBSET_INTER] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[SUBSET_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[SUBSET; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b':real^1` THEN REWRITE_TAC[NOT_IMP; IN_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN MP_TAC(ISPECL [`a':real^1`; `b':real^1`; `b:real^1`] UNION_INTERVAL_1) THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER s SUBSET u ==> i SUBSET b ==> s INTER i SUBSET u`)) THEN REWRITE_TAC[CBALL_INTERVAL; SUBSET_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN EXISTS_TAC `s INTER interval[a':real^1,b']` THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_INTERVAL] THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `interval(a':real^1,b')` THEN REWRITE_TAC[OPEN_INTERVAL] THEN MP_TAC(ISPECL [`a':real^1`; `b':real^1`] CLOSED_OPEN_INTERVAL_1) THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SUBGOAL_THEN `~(interval[a:real^1,b] = {})` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC]; EXPAND_TAC "t" THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> a INTER s SUBSET a INTER t`) THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]) in REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[DISJ_ASSOC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN DISCH_THEN DISJ_CASES_TAC THENL [SUBGOAL_THEN `?r:real^1->bool. bounded r /\ (s:real^N->bool) homeomorphic r` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (MESON[] `p \/ q ==> (p ==> q) ==> q`)) THEN ANTS_TAC THENL [REWRITE_TAC[GSYM DIMINDEX_1; GSYM DIM_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HOMEOMORPHIC_SUBSPACES))) THEN REWRITE_TAC[SUBSPACE_UNIV; homeomorphic] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^1` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (f:real^N->real^1) s` THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_TAC `r:real^1->bool`) THEN SUBGOAL_THEN `?r'. bounded r' /\ (r:real^1->bool) homeomorphic (r':real^1->bool)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_TRANS) THEN ASM_REWRITE_TAC[]] THEN MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`] HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN GEN_REWRITE_TAC LAND_CONV [HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic; RIGHT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^1->real^1` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^1` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (f:real^1->real^1) r` THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval(vec 0:real^1,vec 1)` THEN REWRITE_TAC[BOUNDED_INTERVAL]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS))] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^1`; `g:real^1->real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN MP_TAC(ISPECL [`IMAGE (f:real^N->real^1) s`; `IMAGE (f:real^N->real^1) t`; `IMAGE (f:real^N->real^1) u`] lemma) THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN ANTS_TAC THENL [CONJ_TAC THENL [FIRST_ASSUM(SUBST1_TAC o MATCH_MP HOMEOMORPHISM_COMPONENTS) THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[]; EXPAND_TAC "r" THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OPEN_IN_EQ)) THEN DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `u:real^N->bool`]) THEN ASM_MESON_TAC[SUBSET_REFL; OPEN_IN_IMP_SUBSET]]; DISCH_THEN(X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (g:real^1->real^N) c` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]] THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `IMAGE (f:real^N->real^1) s`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]]; FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `v:real^N->bool`] SURA_BURA_CLOPEN_SUBSET) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]]);; let COMPONENTS_SUBSETS_CLOPEN_PARTITION = prove (`!u s:real^N->bool. locally compact s /\ FINITE u /\ ~(u = {}) /\ u SUBSET components s /\ (!c. c IN u ==> compact c) ==> ?f. (!c. c IN u ==> open_in (subtopology euclidean s) (f c) /\ closed_in (subtopology euclidean s) (f c) /\ c SUBSET f(c)) /\ pairwise (\c c'. ~(f(c) = f(c'))) u /\ pairwise (\c c'. DISJOINT (f c) (f c')) u /\ UNIONS (IMAGE f u) = s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?l. !c. c IN u ==> closed_in (subtopology euclidean s) (l c) /\ open_in (subtopology euclidean s) (l c) /\ (c:real^N->bool) SUBSET l c /\ (!c'. c' IN u /\ ~(c' = c) ==> DISJOINT (l c) (l c'))` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `!c. c IN u ==> ?l. closed_in (subtopology euclidean s) l /\ open_in (subtopology euclidean s) l /\ c SUBSET l /\ (!c':real^N->bool. c' IN u /\ ~(c' = c) ==> DISJOINT c' l)` MP_TAC THENL [X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `s DIFF UNIONS (u DELETE c):real^N->bool`] COMPONENT_INTERMEDIATE_CLOPEN) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN ASM_SIMP_TAC[IN_DELETE; COMPACT_IMP_CLOSED; CLOSED_SUBSET_EQ] THEN ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; MATCH_MP_TAC(SET_RULE `c SUBSET s /\ (!d. d IN u ==> DISJOINT c d) ==> c SUBSET s DIFF UNIONS u`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[REWRITE_RULE[pairwise] PAIRWISE_DISJOINT_COMPONENTS; SUBSET]]; ASM SET_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `l:(real^N->bool)->(real^N->bool)`) THEN EXISTS_TAC `\c. (l:(real^N->bool)->(real^N->bool)) c DIFF UNIONS (IMAGE l (u DELETE c))` THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[FINITE_DELETE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `c SUBSET s /\ (!d. d IN u ==> DISJOINT c d) ==> c SUBSET s DIFF UNIONS u`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; REWRITE_TAC[IN_DELETE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[REWRITE_RULE[pairwise] PAIRWISE_DISJOINT_COMPONENTS; SUBSET]]; SET_TAC[]]]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `d:real^N->bool`) THEN EXISTS_TAC `\c. if c = d then s DIFF UNIONS (IMAGE l (u DELETE d)) else (l:(real^N->bool)->(real^N->bool)) c` THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ (q /\ r) /\ s`] THEN REWRITE_TAC[PAIRWISE_AND] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[FINITE_DELETE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `c SUBSET s /\ (!d. d IN u ==> DISJOINT c d) ==> c SUBSET s DIFF UNIONS u`) THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN REWRITE_TAC[IN_DELETE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SET_RULE `c SUBSET c' /\ DISJOINT c' d ==> DISJOINT c d`]]; FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `a IN s ==> s = a INSERT (s DELETE a)`)) THEN REWRITE_TAC[PAIRWISE_INSERT] THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT (s DELETE a) = s`] THEN SUBGOAL_THEN `!c:real^N->bool. c IN u ==> ~(l c:real^N->bool = {})` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_EMPTY; IN_COMPONENTS_NONEMPTY; SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[IN_DELETE; pairwise; SET_RULE `~(c' = {}) ==> ((~(c = c') /\ DISJOINT c c') /\ (~(c' = c) /\ DISJOINT c' c) <=> DISJOINT c c')`] THEN ASM SET_TAC[]; FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `a IN s ==> s = a INSERT (s DELETE a)`)) THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT (s DELETE a) = s`] THEN REWRITE_TAC[SET_RULE `IMAGE (\x. if x = a then f x else g x) (s DELETE a) = IMAGE g (s DELETE a)`] THEN MATCH_MP_TAC(SET_RULE `u SUBSET s ==> (s DIFF u) UNION u = s`) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* "Boundary bumping theorems" and relatives. *) (* ------------------------------------------------------------------------- *) let CONNECTED_COMPONENT_DIFF_NONSEPARATED = prove (`!s t c:real^N->bool. compact s /\ connected s /\ t SUBSET s /\ ~(t = {}) /\ c IN components(s DIFF t) ==> ~(closure(c) INTER closure(t) = {})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s DIFF {x + d | (x:real^N) IN t /\ d IN ball(vec 0,setdist(c,t) / &2)}`; `c:real^N->bool`; `setdist(c:real^N->bool,t) / &2`] COMPONENT_CLOPEN_HAUSDIST_EXPLICIT) THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; REAL_HALF] THEN ABBREV_TAC `t' = {x + d | (x:real^N) IN t /\ d IN ball(vec 0,setdist(c,t) / &2)}` THEN SUBGOAL_THEN `open(t':real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "t'" THEN SIMP_TAC[OPEN_SUMS; OPEN_BALL]; ALL_TAC] THEN SUBGOAL_THEN `compact(s DIFF t':real^N->bool)` ASSUME_TAC THENL [MATCH_MP_TAC COMPACT_DIFF THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[SETDIST_POS_LT] THEN MP_TAC(ISPECL [`closure c:real^N->bool`; `closure t:real^N->bool`] SETDIST_EQ_0_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[SETDIST_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[COMPACT_CLOSURE] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_INTERMEDIATE_SUBSET)) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c SUBSET s DIFF t ==> (!x. x IN t' ==> ~(x IN c)) ==> c SUBSET s DIFF t'`)) THEN EXPAND_TAC "t'" THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN SUBST1_TAC(NORM_ARITH `norm(d:real^N) = dist(x + d,x)`) THEN MATCH_MP_TAC(NORM_ARITH `a <= dist(p:real^N,q) ==> a / &2 <= dist(p,q)`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(SET_RULE `t SUBSET t' ==> s DIFF t' SUBSET s DIFF t`) THEN EXPAND_TAC "t'" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID; REAL_HALF]]; DISCH_TAC] THEN SUBGOAL_THEN `compact(c:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM_REWRITE_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN DISCH_THEN(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]; ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t SUBSET s ==> ~(t = {}) /\ DISJOINT t k ==> ~(k = s)`)) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `k SUBSET k' ==> (!x. x IN k' ==> ~(x IN t)) ==> DISJOINT t k`)) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN SUBST1_TAC(NORM_ARITH `norm(d:real^N) = dist(x,x + d)`) THEN MATCH_MP_TAC(NORM_ARITH `a <= dist(p:real^N,q) ==> a / &2 <= dist(p,q)`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s INTER {x + d:real^N | x IN c /\ d IN ball(vec 0,setdist(c,t) / &2)}` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_SUMS; OPEN_BALL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN u ==> !y. y IN t ==> ~(x = y)) ==> s INTER u SUBSET s DIFF t`) THEN EXPAND_TAC "t'" THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real^N`; `x':real^N`; `d':real^N`] THEN MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN c`; `(x':real^N) IN t`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `k <= dist(x:real^N,x') ==> norm d < k / &2 ==> norm d' < k / &2 ==> ~(x + d = x' + d')`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[]);; let CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT = prove (`!s t c:real^N->bool. compact s /\ connected s /\ t PSUBSET s /\ c IN components t ==> ~(closure(c) INTER closure(s DIFF t) = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_DIFF_NONSEPARATED THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[SET_RULE `t PSUBSET s ==> s DIFF (s DIFF t) = t`] THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED = prove (`!s t c:real^N->bool. compact s /\ connected s /\ closed t /\ t SUBSET s /\ ~(t = {}) /\ c IN components(s DIFF t) ==> ~(closure(c) INTER t = {})`, MESON_TAC[CONNECTED_COMPONENT_DIFF_NONSEPARATED; CLOSURE_CLOSED]);; let CONNECTED_EQ_COMPONENT_DIFF_CLOSED_NONSEPARATED = prove (`!s:real^N->bool t. compact s /\ closed t /\ connected t /\ t SUBSET s /\ ~(t = {}) ==> (connected s <=> !c. c IN components (s DIFF t) ==> ~(closure c INTER t = {}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED]; ALL_TAC] THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = t` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `s = UNIONS {c UNION t:real^N->bool |c| c IN components(s DIFF t)}` SUBST1_TAC THENL [TRANS_TAC EQ_TRANS `UNIONS(components(s DIFF t)) UNION t:real^N->bool` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN ASM SET_TAC[]; SUBGOAL_THEN `~(components(s DIFF t:real^N->bool) = {})` MP_TAC THENL [REWRITE_TAC[COMPONENTS_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[NOT_IN_EMPTY; UNIONS_GSPEC] THEN REWRITE_TAC[IN_UNION; IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[]]; MATCH_MP_TAC CONNECTED_UNIONS THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[CONNECTED_UNION_STRONG; IN_COMPONENTS_CONNECTED]; REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]]]);; let CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED = prove (`!s:real^N->bool a:real^N. compact s /\ a IN s ==> (connected s <=> !c. c IN components (s DELETE a) ==> a IN closure c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `{a:real^N}`] CONNECTED_EQ_COMPONENT_DIFF_CLOSED_NONSEPARATED) THEN ASM_REWRITE_TAC[CLOSED_SING; CONNECTED_SING; SING_SUBSET] THEN REWRITE_TAC[NOT_INSERT_EMPTY; SET_RULE `s DIFF {a} = s DELETE a`] THEN SET_TAC[]);; let CONNECTED_INSERT_COMPACT = prove (`!s:real^N->bool a:real^N. compact(a INSERT s) ==> (connected(a INSERT s) <=> !c. c IN components s ==> a IN closure c)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `a IN s ==> ~(s = {})`)) THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN EQ_TAC THENL [DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` COMPONENTS_EQ_SING) THEN ASM_SIMP_TAC[IN_SING; CLOSURE_INC]; DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN REWRITE_TAC[IN_COMPONENTS_CONNECTED] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTERS] THEN EXISTS_TAC `a:real^N` THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN ASM SET_TAC[]]; MP_TAC(ISPECL [`(a:real^N) INSERT s`; `a:real^N`] CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED) THEN ASM_REWRITE_TAC[IN_INSERT] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> (a INSERT s) DELETE a = s`]]);; let BOUNDARY_BUMPING_THEOREM = prove (`!s t c:real^N->bool. compact s /\ connected s /\ t PSUBSET s /\ c IN components t ==> ~(closure(c) INTER closure(t) INTER closure(s DIFF t) = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `~(c INTER s = {}) /\ c SUBSET t ==> ~(c INTER t INTER s = {})`) THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT; SUBSET_CLOSURE; IN_COMPONENTS_SUBSET]);; let BOUNDARY_BUMPING_THEOREM_CLOSED = prove (`!s t c:real^N->bool. compact s /\ connected s /\ closed t /\ t PSUBSET s /\ c IN components t ==> ~(c INTER closure t INTER closure(s DIFF t) = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `c:real^N->bool`] BOUNDARY_BUMPING_THEOREM) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CLOSED_COMPONENTS)) THEN ASM_SIMP_TAC[CLOSURE_CLOSED]);; let BOUNDARY_BUMPING_THEOREM_OPEN = prove (`!s t c:real^N->bool. compact s /\ connected s /\ open_in (subtopology euclidean s) t /\ t PSUBSET s /\ c IN components t ==> ~(closure c INTER (s DIFF t) = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `c:real^N->bool`] BOUNDARY_BUMPING_THEOREM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s = s' ==> ~(c INTER t INTER s = {}) ==> ~(c INTER s' = {})`) THEN MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL; COMPACT_IMP_CLOSED]);; let BOUNDARY_BUMPING_THEOREM_OPEN_ALT = prove (`!s t c:real^N->bool. compact s /\ connected s /\ open_in (subtopology euclidean s) t /\ t PSUBSET s /\ c IN components t ==> ~(closure c INTER (closure t DIFF t) = {})`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDARY_BUMPING_THEOREM_OPEN) THEN MATCH_MP_TAC(SET_RULE `c SUBSET t' ==> ~(c INTER (s DIFF t) = {}) ==> ~(c INTER (t' DIFF t) = {})`) THEN ASM_SIMP_TAC[SUBSET_CLOSURE; IN_COMPONENTS_SUBSET]);; let BOUNDARY_BUMPING_THEOREM_ALT = prove (`!s t c:real^N->bool. compact s /\ connected s /\ open_in (subtopology euclidean s) t /\ t PSUBSET s /\ c IN components(closure t) ==> ~(c INTER (s DIFF t) = {})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `closure t:real^N->bool = s` THENL [REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(snd(EQ_IMP_RULE(ISPEC `s:real^N->bool` COMPONENTS_EQ_SING))) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[IN_SING] THEN ASM SET_TAC[]; STRIP_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `closure t:real^N->bool`; `c:real^N->bool`] BOUNDARY_BUMPING_THEOREM_CLOSED) THEN ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[PSUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET u ==> ~(c INTER t INTER s = {}) ==> ~(c INTER u = {})`) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[SET_RULE `k SUBSET s DIFF (s INTER u) <=> k SUBSET s /\ u INTER k = {}`] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN SET_TAC[]; ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN MP_TAC(ISPEC `s INTER u:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]);; let CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT = prove (`!s t u c:real^N->bool. compact s /\ connected s /\ compact t /\ s SUBSET t /\ compact u /\ connected u /\ t SUBSET u /\ c IN components(u DIFF t) /\ closure c DIFF c SUBSET s ==> compact(c UNION s) /\ connected(c UNION s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_SIMP_TAC[DIFF_EMPTY; SUBSET_EMPTY; UNION_EMPTY] THEN MESON_TAC[COMPACT_COMPONENTS; IN_COMPONENTS_CONNECTED]; STRIP_TAC] THEN MP_TAC(ISPECL [`u:real^N->bool`; `u DIFF t:real^N->bool`; `c:real^N->bool`] BOUNDARY_BUMPING_THEOREM_OPEN) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]; ASM_SIMP_TAC[SET_RULE `t SUBSET u ==> u DIFF (u DIFF t) = t`]] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SUBGOAL_THEN `c UNION s:real^N->bool = closure c UNION s` SUBST1_TAC THENL [MP_TAC(ISPEC `c:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_UNION THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPACT_CLOSURE] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_UNION THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN ASM_SIMP_TAC[CONNECTED_CLOSURE] THEN ASM SET_TAC[]]);; let CONTINUUM_UNION_COMPONENTS_COMPLEMENT = prove (`!s u c:real^N->bool. compact s /\ connected s /\ compact u /\ connected u /\ s SUBSET u /\ c IN components(u DIFF s) /\ closure c DIFF c SUBSET s ==> compact(c UNION s) /\ connected(c UNION s)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN ASM_REWRITE_TAC[SUBSET_REFL]);; (* ------------------------------------------------------------------------- *) (* More compact component properties via the notion of "well-chained". *) (* ------------------------------------------------------------------------- *) let WELLCHAINED_ELEMENTS = prove (`!s:real^N->bool a b e. (?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p(SUC i)) < e)) <=> a IN s /\ b IN s /\ (!c. c SUBSET s /\ a IN c /\ (!x y. x IN c /\ y IN s /\ dist(x,y) < e ==> y IN c) ==> b IN c)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [ALL_TAC; ASM_MESON_TAC[LE_0]] THEN ASM_CASES_TAC `(b:real^N) IN s` THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN STRIP_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!k. k <= n ==> (p:num->real^N) k IN c` (fun th -> ASM_MESON_TAC[th; LE_REFL]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(p:num->real^N) k` THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `{x:real^N | ?p n. p 0 = a /\ p n = x /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p(SUC i)) < e)}`) THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[LE_REFL]; REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`(\n. a):num->real^N`; `0`] THEN ASM_REWRITE_TAC[LT]; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN STRIP_TAC THEN EXISTS_TAC `\i. if i <= n then (p:num->real^N) i else y` THEN EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC n <= n)`] THEN REWRITE_TAC[LE; LT; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`; FORALL_AND_THM; FORALL_UNWIND_THM2] THEN REWRITE_TAC[LE_REFL; LE_SUC_LT; LT_REFL] THEN ASM_SIMP_TAC[LT_IMP_LE]]]);; let WELLCHAINED_SETS = prove (`!s:real^N->bool e. (!a b. a IN s /\ b IN s ==> ?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p(SUC i)) < e)) <=> (!c. c SUBSET s /\ ~(c = {}) /\ (!x y. x IN c /\ y IN s /\ dist(x,y) < e ==> y IN c) ==> c = s)`, REPEAT GEN_TAC THEN REWRITE_TAC[WELLCHAINED_ELEMENTS] THEN SIMP_TAC[] THEN REWRITE_TAC[MESON[] `(!a b. P a /\ P b ==> !c. Q a b c ==> R a b c) <=> (!c a b. Q a b c /\ P a /\ P b ==> R a b c)`] THEN AP_TERM_TAC THEN ABS_TAC THEN SIMP_TAC[GSYM MEMBER_NOT_EMPTY; GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MESON_TAC[]);; let CONNECTED_IMP_WELLCHAINED = prove (`!s e a b:real^N. connected s /\ &0 < e /\ a IN s /\ b IN s ==> ?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p(SUC i)) < e)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPLICATE_TAC 2 (GEN_TAC THEN DISCH_TAC) THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REWRITE_TAC[WELLCHAINED_SETS] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SET_RULE `c SUBSET s /\ ~(c = {}) ==> (c = s <=> !a b. a IN s /\ b IN s /\ a IN c ==> b IN c)`] THEN MATCH_MP_TAC CONNECTED_INDUCTION_SIMPLE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN EXISTS_TAC `s INTER ball(a:real^N,e / &2)` THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[IN_BALL] THEN ASM_MESON_TAC[NORM_ARITH `dist(a:real^N,x) < e / &2 /\ dist(a,y) < e / &2 ==> dist(x,y) < e`]);; let CONNECTED_EQ_WELLCHAINED = prove (`!s:real^N->bool. compact s ==> (connected s <=> !e a b. &0 < e /\ a IN s /\ b IN s ==> ?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p(SUC i)) < e))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_IMP_WELLCHAINED THEN ASM_MESON_TAC[]; ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM]] THEN REWRITE_TAC[WELLCHAINED_SETS] THEN DISCH_TAC THEN ASM_CASES_TAC `connected(s:real^N->bool)` THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[CONNECTED_CLOSED_IN_EQ]] THEN UNDISCH_TAC `compact(s:real^N->bool)` THEN SIMP_TAC[CLOSED_IN_COMPACT_EQ] THEN DISCH_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?a:real^N. a IN k1` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `setdist(k1:real^N->bool,k2)`) THEN REWRITE_TAC[NOT_IMP; SETDIST_POS_LT] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_IMP_CLOSED] THEN DISCH_THEN(MP_TAC o SPEC `k1:real^N->bool`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN REWRITE_TAC[REAL_NOT_LT; GSYM IN_DIFF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]);; let WELLCHAINED_INTERS = prove (`!s:num->(real^N->bool) d e. d < e /\ (!m. compact (s m)) /\ (!m. s(SUC m) SUBSET s m) /\ (!m a b. a IN s m /\ b IN s m ==> ?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN s m) /\ (!i. i < n ==> dist(p i,p (SUC i)) < d)) ==> !a b. a IN INTERS {s m | m IN (:num)} /\ b IN INTERS {s m | m IN (:num)} ==> ?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN INTERS {s m | m IN (:num)}) /\ (!i. i < n ==> dist(p i,p (SUC i)) < e)`, REWRITE_TAC[WELLCHAINED_SETS] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ABBREV_TAC `k:real^N->bool = INTERS {s m | m IN (:num)}` THEN ASM_CASES_TAC `k:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `compact(k:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "k" THEN MATCH_MP_TAC COMPACT_INTERS THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM WELLCHAINED_SETS] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `s:num->real^N->bool` HAUSDIST_COMPACT_INTERS_LIMIT) THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN DISCH_THEN(MP_TAC o SPEC `(e - d) / &2`) THEN ASM_REWRITE_TAC[REAL_SUB_LT; REAL_HALF; NORM_LIFT] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; real_abs; HAUSDIST_POS_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `a:real^N`; `b:real^N`] o GEN_REWRITE_RULE BINDER_CONV [GSYM WELLCHAINED_SETS]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN DISCH_THEN(X_CHOOSE_THEN `p:num->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!i. ?y. i <= m ==> y IN k /\ dist((p:num->real^N) i,y) <= (e - d) / &2` MP_TAC THENL [X_GEN_TAC `j:num` THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(s:num->real^N->bool) n`; `k:real^N->bool`] HAUSDIST_COMPACT_EXISTS) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN DISCH_THEN(MP_TAC o SPEC `(p:num->real^N) j`) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `q:num->real^N` THEN DISCH_TAC THEN EXISTS_TAC `\i. if 0 < i /\ i < m then (q:num->real^N) i else p i` THEN ASM_SIMP_TAC[LT_REFL] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THENL [ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[LT_REFL] THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[LT_REFL] THEN REPEAT DISCH_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN ASM_ARITH_TAC; ASM_CASES_TAC `i = 0` THEN ASM_SIMP_TAC[LE_1; LT_0; LT_REFL] THEN SIMP_TAC[ARITH_RULE `i < m ==> (SUC i < m <=> ~(SUC i = m))`] THEN REWRITE_TAC[COND_SWAP] THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC(NORM_ARITH `dist(a:real^N,p(SUC 0)) < d /\ dist(p(SUC 0),q(SUC 0)) <= (e - d) / &2 ==> dist(a,q(SUC 0)) < e`) THEN ASM_MESON_TAC[ARITH_RULE `0 < m ==> SUC 0 <= m`]; MATCH_MP_TAC(NORM_ARITH `dist((p:num->real^N) i,b) < d /\ dist(p i,q i) <= (e - d) / &2 ==> dist(q i,b) < e`) THEN ASM_MESON_TAC[LT_IMP_LE]; MATCH_MP_TAC(NORM_ARITH `dist(p i:real^N,p(SUC i)) < d /\ dist(p i,q i) <= (e - d) / &2 /\ dist(p(SUC i),q(SUC i)) <= (e - d) / &2 ==> dist(q i,q(SUC i)) < e`) THEN ASM_MESON_TAC[LT_IMP_LE; ARITH_RULE `i < m /\ ~(SUC i = m) ==> SUC i <= m`]]]);; let CONNECTED_COMPONENT_IMP_WELLCHAINED = prove (`!s a b:real^N e. &0 < e /\ connected_component s a b ==> ?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p (SUC i)) < e)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`connected_component s (a:real^N)`; `e:real`; `a:real^N`; `b:real^N`] CONNECTED_IMP_WELLCHAINED) THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL [REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_IN]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN MP_TAC (ISPECL [`s:real^N->bool`; `a:real^N`] CONNECTED_COMPONENT_SUBSET) THEN ASM SET_TAC[]]);; let CONNECTED_COMPONENT_EQ_WELLCHAINED = prove (`!s a b:real^N. compact s ==> (connected_component s a b <=> a IN s /\ b IN s /\ !e. &0 < e ==> ?p n. p 0 = a /\ p n = b /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p (SUC i)) < e))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_IMP_WELLCHAINED THEN ASM_MESON_TAC[]; ALL_TAC] THEN ABBREV_TAC `t = \k. {x | (x:real^N) IN s /\ ?p n. p 0 = a /\ p n = x /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p(SUC i)) < inv(&k + &1))}` THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `INTERS {t k | k IN (:num)}:real^N->bool` THEN REPEAT CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "t" THEN REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]; EXPAND_TAC "t" THEN REWRITE_TAC[INTERS_GSPEC] THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `j:num` THEN EXISTS_TAC `(\n. a):num->real^N` THEN ASM_REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`]; EXPAND_TAC "t" THEN REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `j:num` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`]] THEN W(MP_TAC o PART_MATCH (lhand o rand) CONNECTED_EQ_WELLCHAINED o snd) THEN SUBGOAL_THEN `!n. compact((t:num->real^N->bool) n)` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET_RESTRICT] THEN REWRITE_TAC[open_in; SET_RULE `s DIFF t SUBSET s`] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[DIFF; IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `inv(&n + &1)` THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:num->real^N`; `m:num`] THEN STRIP_TAC THEN EXISTS_TAC `\j. if j <= m then (p:num->real^N) j else x` THEN EXISTS_TAC `SUC m` THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC m <= m)`] THEN REWRITE_TAC[LE_SUC_LT; LT; LE] THEN CONJ_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LT_IMP_LE; ARITH_RULE `~(SUC m <= m)`; LE_REFL; LT_REFL]; ALL_TAC] THEN ANTS_TAC THENL [MATCH_MP_TAC COMPACT_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `!n. t(SUC n):real^N->bool SUBSET t n` ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `e / &2` ARCH_EVENTUALLY_INV1) THEN ASM_REWRITE_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN SUBGOAL_THEN `INTERS {t n | n IN (:num)}:real^N->bool = INTERS {t(N + n) | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN SUBGOAL_THEN `!m n. m <= n ==> (t:num->real^N->bool) n SUBSET t m` (fun th -> MESON_TAC[th; LE_ADD; ADD_SYM; SUBSET]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC WELLCHAINED_INTERS THEN EXISTS_TAC `e / &2` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[ADD_CLAUSES]] THEN MAP_EVERY X_GEN_TAC [`m:num`; `x:real^N`; `y:real^N`] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(y:real^N) IN s`] THEN ASM_REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p1:num->real^N`; `n1:num`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`p2:num->real^N`; `n2:num`] THEN REPEAT DISCH_TAC THEN EXISTS_TAC `\j. if j <= n1 then (p1:num->real^N) (n1 - j) else p2(j - n1)` THEN EXISTS_TAC `n1 + n2:num` THEN ASM_REWRITE_TAC[LE_0; SUB_0; ADD_SUB2; ARITH_RULE `n - (n + m) = 0`] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `n1 + n2 <= n1 <=> n2 = 0`] THEN ASM_MESON_TAC[]; X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_CASES_TAC `(i:num) <= n1` THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC]) THENL [MAP_EVERY EXISTS_TAC [`p1:num->real^N`; `n1 - i:num`]; MAP_EVERY EXISTS_TAC [`p2:num->real^N`; `i - n1:num`]] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_CASES_TAC `SUC i <= n1` THEN ASM_SIMP_TAC[ARITH_RULE `SUC i <= n ==> i <= n`] THENL [ASM_SIMP_TAC[ARITH_RULE `SUC i <= n ==> n - i = SUC(n - SUC i)`] THEN TRANS_TAC REAL_LT_TRANS `inv(&(N + m) + &1)` THEN ASM_SIMP_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ASM_SIMP_TAC[ARITH_RULE `~(SUC i <= n) ==> (i <= n <=> i = n)`] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[SUB_REFL; ARITH_RULE `SUC n - n = SUC 0`] THEN SUBGOAL_THEN `a:real^N = p2 0` SUBST1_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC]; ASM_SIMP_TAC[ARITH_RULE `~(SUC i <= n) ==> SUC i - n = SUC(i - n)`]] THEN (TRANS_TAC REAL_LT_TRANS `inv(&(N + m) + &1)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ASM_SIMP_TAC[LE_ADD]])]]);; let COMPACT_PARTITION_CONTAINING_CLOSED = prove (`!s t t':real^N->bool. compact s /\ closed t /\ closed t' /\ t SUBSET s /\ t' SUBSET s /\ (!c. c IN components s ==> c INTER t = {} \/ c INTER t' = {}) ==> ?k k'. compact k /\ compact k' /\ t SUBSET k /\ t' SUBSET k' /\ DISJOINT k k' /\ k UNION k' = s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[COMPACT_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `t':real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `{}:real^N->bool`] THEN ASM_REWRITE_TAC[COMPACT_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `compact(t:real^N->bool) /\ compact(t':real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `?e. &0 < e /\ !x y. x IN t /\ (y:real^N) IN t' ==> ~(?p n. p 0 = x /\ p n = y /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist(p i,p (SUC i)) < e))` STRIP_ASSUME_TAC THENL [ONCE_REWRITE_TAC[MESON[] `(?e. P e /\ Q e) <=> ~(!e. P e ==> ~Q e)`] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [NOT_FORALL_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP] THEN MAP_EVERY X_GEN_TAC [`x:num->real^N`; `y:num->real^N`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(t:real^N->bool) PCROSS (t':real^N->bool)`] compact) THEN ASM_REWRITE_TAC[COMPACT_PCROSS_EQ] THEN DISCH_THEN(MP_TAC o SPEC `\n. pastecart((x:num->real^N) n) (y n:real^N)`) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; o_DEF; EXISTS_PASTECART] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `r:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `(a:real^N) IN s /\ b IN s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `connected_component s (a:real^N)`) THEN REWRITE_TAC[NOT_IMP; components; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[DE_MORGAN_THM]] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THENL [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_WELLCHAINED] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_PASTECART_EQ]) THEN REWRITE_TAC[tendsto; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN SUBGOAL_THEN `eventually ((\n. inv(&n + &1) < e) o r) sequentially` MP_TAC THENL [MATCH_MP_TAC EVENTUALLY_SUBSEQUENCE THEN ASM_REWRITE_TAC[ARCH_EVENTUALLY_INV1]; ASM_REWRITE_TAC[o_DEF; GSYM EVENTUALLY_AND; IMP_IMP]] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `NN:num` (MP_TAC o SPEC `NN:num`)) THEN REWRITE_TAC[LE_REFL] THEN ABBREV_TAC `N = (r:num->num) NN` THEN STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `p:num->real^N` MP_TAC o SPEC `N:num`) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\i. if i = 0 then a:real^N else if i <= SUC n then p(i - 1) else b` THEN EXISTS_TAC `n + 2` THEN ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `~(n + 2 <= SUC n)`] THEN MATCH_MP_TAC num_INDUCTION THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; NOT_SUC; LE_SUC] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN CONJ_TAC THENL [DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; SIMP_TAC[LE_SUC_LT; ARITH_RULE `SUC i < n + 2 <=> i = n \/ i < n`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LT_IMP_LE; LE_REFL; LT_REFL; SUC_SUB1] THEN TRANS_TAC REAL_LT_TRANS `inv(&N + &1)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN EXISTS_TAC `{x | (x:real^N) IN s /\ ?p n. p 0 IN t /\ p n = x /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist (p i,p (SUC i)) < e)}` THEN EXISTS_TAC `{x | (x:real^N) IN s /\ ~(?p n. p 0 IN t /\ p n = x /\ (!i. i <= n ==> p i IN s) /\ (!i. i < n ==> dist (p i,p (SUC i)) < e))}` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [ALL_TAC; STRIP_TAC THEN MATCH_MP_TAC COMPACT_IN_SEPARATED_UNION] THEN ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} UNION {x | x IN s /\ ~P x} = s`; SET_RULE `DISJOINT {x | x IN s /\ P x} {x | x IN s /\ ~P x}`] THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM MESON_TAC[]] THEN X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`(\i. x):num->real^N`; `0`] THEN ASM_REWRITE_TAC[LT; LE] THEN ASM SET_TAC[]; TRANS_TAC REAL_LTE_TRANS `e:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t u. t SUBSET t' /\ u SUBSET u' /\ ~(t = {}) /\ ~(u = {}) ==> ~(t' = {}) /\ ~(u' = {})`) THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN ASM_REWRITE_TAC[]; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN REPLICATE_TAC 5 DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`\i. if i <= n then (p:num->real^N) i else y`; `SUC n`] THEN ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC n <= n)`] THEN REWRITE_TAC[LE; LT; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`; FORALL_AND_THM; FORALL_UNWIND_THM2] THEN REWRITE_TAC[LE_REFL; LE_SUC_LT; LT_REFL] THEN ASM_SIMP_TAC[LT_IMP_LE]]]);; let COMPACT_PARTITION_CONTAINING_POINTS = prove (`!s a b:real^N. compact s /\ a IN s /\ b IN s /\ ~(connected_component s a b) ==> ?k k'. compact k /\ compact k' /\ a IN k /\ b IN k' /\ DISJOINT k k' /\ k UNION k' = s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SING_SUBSET] THEN MATCH_MP_TAC COMPACT_PARTITION_CONTAINING_CLOSED THEN ASM_REWRITE_TAC[SING_SUBSET; CLOSED_SING] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [connected_component]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_LIMIT = prove (`!s x y a b:real^N. compact s /\ (x --> a) sequentially /\ (y --> b) sequentially /\ eventually (\n. connected_component s (x n) (y n)) sequentially ==> connected_component s a b`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_WELLCHAINED] THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC) THEN CONJ_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_IN_CLOSED_SET) THENL [EXISTS_TAC `x:num->real^N`; EXISTS_TAC `y:num->real^N`] THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; COMPACT_IMP_CLOSED] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN SIMP_TAC[]; STRIP_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)) THEN REWRITE_TAC[tendsto; CONJ_ASSOC; AND_FORALL_THM] THEN REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; GSYM CONJ_ASSOC] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN REWRITE_TAC[LE_REFL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN STRIP_TAC THEN EXISTS_TAC `\i. if i = 0 then a:real^N else if i <= SUC n then p(i - 1) else b` THEN EXISTS_TAC `n + 2` THEN ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `~(n + 2 <= SUC n)`] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC num_INDUCTION THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; NOT_SUC; LE_SUC] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LE_SUC_LT; ARITH_RULE `SUC i < n + 2 <=> i = n \/ i < n`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LT_IMP_LE; LE_REFL; LT_REFL; SUC_SUB1]]);; let CLOSED_UNIONS_COMPONENTS_MEETING_CLOSED = prove (`!s t:real^N->bool. compact s /\ closed t ==> closed (UNIONS {c | c IN components s /\ ~(c INTER t = {})})`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN MAP_EVERY X_GEN_TAC [`x:num->real^N`; `a:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [IN_UNIONS]) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `c:num->real^N->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_INTER] THEN X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `(!n. (x:num->real^N) n IN s) /\ (!n. (y:num->real^N) n IN s)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; IN_COMPONENTS_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_SEQUENTIAL_LIMITS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `y:num->real^N` o REWRITE_RULE[compact]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `r:num->num`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(x:num->real^N) o (r:num->num)`; `(y:num->real^N) o (r:num->num)`; `a:real^N`; `b:real^N`] CONNECTED_COMPONENT_LIMIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_SIMP_TAC[LIM_SUBSEQUENCE] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[o_THM] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `(c:num->real^N->bool)(r(n:num))` THEN ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]; DISCH_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN EXISTS_TAC `connected_component s (a:real^N)` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP (REWRITE_RULE[IN] CONNECTED_COMPONENT_EQ)) THEN REWRITE_TAC[components; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `b:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CLOSED_SEQUENTIAL_LIMITS]) THEN EXISTS_TAC `(y:num->real^N) o (r:num->num)` THEN ASM_REWRITE_TAC[o_THM]]);; let ARBITRARILY_SMALL_CONTINUUM = prove (`!s u a:real^N. connected s /\ locally compact s /\ open u /\ {a} PSUBSET s /\ a IN u ==> ?c. {a} PSUBSET c /\ c SUBSET s /\ c SUBSET u /\ compact c /\ connected c`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?b:real^N. b IN s /\ ~(b = a)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN DISCH_THEN(MP_TAC o SPECL [`s INTER (u DELETE (b:real^N))`; `a:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_DELETE; SUBSET_INTER] THEN ASM_REWRITE_TAC[IN_DELETE; IN_INTER; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `connected_component k (a:real^N)` THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN REPEAT CONJ_TAC THENL [ALL_TAC; TRANS_TAC SUBSET_TRANS `k:real^N->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN ASM SET_TAC[]; TRANS_TAC SUBSET_TRANS `k:real^N->bool` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ ~(s = {a}) ==> {a} PSUBSET s`) THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN MP_TAC(ISPECL [`k:real^N->bool`; `{a:real^N}`; `v:real^N->bool`] SURA_BURA_CLOPEN_SUBSET_ALT) THEN ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET; IN_INTER] THEN REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; COMPACT_IMP_CLOSED]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EXISTS_TAC `a:real^N` THEN REWRITE_TAC[] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN REWRITE_TAC[NOT_IMP; DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; ALL_TAC] THEN ASM SET_TAC[]);; let BOUNDARY_BUMPING_THEOREM_INTER = prove (`!s u c:real^N->bool. connected s /\ locally compact s /\ open u /\ ~(s SUBSET u) /\ compact(s INTER closure u) /\ c IN components(s INTER closure u) ==> ~(c INTER frontier u = {})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s INTER closure u:real^N->bool`; `c:real^N->bool`; `s INTER frontier u:real^N->bool`] COMPACT_PARTITION_CONTAINING_CLOSED) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_COMPONENTS; COMPACT_IMP_CLOSED]; SUBGOAL_THEN `s INTER frontier u:real^N->bool = (s INTER closure u) INTER frontier u` (fun th -> ASM_SIMP_TAC[th; CLOSED_INTER; FRONTIER_CLOSED; COMPACT_IMP_CLOSED]) THEN REWRITE_TAC[frontier] THEN SET_TAC[]; ASM_SIMP_TAC[IN_COMPONENTS_SUBSET]; REWRITE_TAC[frontier] THEN SET_TAC[]; MP_TAC(ISPEC `s INTER closure u:real^N->bool` PAIRWISE_DISJOINT_COMPONENTS) THEN REWRITE_TAC[pairwise] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N->bool` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM SET_TAC[]; REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`k:real^N->bool`; `l UNION (s DIFF closure u):real^N->bool`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]; SUBGOAL_THEN `l UNION s DIFF closure u:real^N->bool = s INTER (l UNION closure(s DIFF closure u))` (fun th -> ASM_SIMP_TAC[th; CLOSED_IN_CLOSED_INTER; CLOSED_UNION; COMPACT_IMP_CLOSED; CLOSED_CLOSURE]) THEN MP_TAC(ISPECL [`u:real^N->bool`; `s DIFF closure u:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `u:real^N->bool` CLOSURE_UNION_FRONTIER) THEN MP_TAC (ISPEC `s DIFF closure u:real^N->bool` CLOSURE_UNION_FRONTIER) THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]; SUBGOAL_THEN `frontier u:real^N->bool = closure u DIFF u` SUBST_ALL_TAC THENL [ASM_SIMP_TAC[frontier; INTERIOR_OPEN]; ALL_TAC] THEN ASM SET_TAC[]]]);; let BOUNDARY_BUMPING_THEOREM_INTER_ALT = prove (`!s u c:real^N->bool. connected s /\ locally compact s /\ open u /\ ~(s INTER u = {}) /\ ~(s SUBSET u) /\ compact(s INTER closure u) /\ c IN components(s INTER u) ==> ?x. x IN frontier u /\ x limit_point_of c`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(closure c INTER frontier u:real^N->bool = {})` MP_TAC THENL [DISCH_TAC; REWRITE_TAC[closure] THEN MATCH_MP_TAC(SET_RULE `s INTER u = {} ==> ~((s UNION {x | P x}) INTER u = {}) ==> ?x. x IN u /\ P x`) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[]] THEN SUBGOAL_THEN `closed(c:real^N->bool)` ASSUME_TAC THENL [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `s INTER closure u:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [REWRITE_TAC[closure] THEN SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o LAND_CONV) [closure]) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`c:real^N->bool`; `(:real^N) DIFF u`] SEPARATION_NORMAL) THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED; NOT_IMP] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[]; REWRITE_TAC[NOT_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`h:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `closure(h:real^N->bool) SUBSET u` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `(:real^N) DIFF k` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s INTER closure h:real^N->bool`; `c:real^N->bool`] EXISTS_COMPONENT_SUPERSET) THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN REWRITE_TAC[closure] THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c':real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `h:real^N->bool`; `c':real^N->bool`] BOUNDARY_BUMPING_THEOREM_INTER) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [SUBGOAL_THEN `s INTER closure(h:real^N->bool) = (s INTER closure u) INTER closure h` (fun th -> ASM_SIMP_TAC[COMPACT_INTER_CLOSED; th; CLOSED_CLOSURE]) THEN MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `c':real^N->bool = c` SUBST_ALL_TAC THENL [ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `s INTER u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `s INTER closure h:real^N->bool` THEN ASM_SIMP_TAC[IN_COMPONENTS_SUBSET] THEN ASM SET_TAC[]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY)) THEN ASM SET_TAC[]]; ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Relations between components and path components. *) (* ------------------------------------------------------------------------- *) let OPEN_CONNECTED_COMPONENT = prove (`!s x:real^N. open s ==> open(connected_component s x)`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y` SUBST1_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; CONNECTED_BALL]]);; let IN_CLOSURE_CONNECTED_COMPONENT = prove (`!x y:real^N. x IN s /\ open s ==> (x IN closure(connected_component s y) <=> x IN connected_component s y)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN SUBGOAL_THEN `~((connected_component s (x:real^N)) INTER closure(connected_component s y) = {})` MP_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER] THEN ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_CONNECTED_COMPONENT] THEN REWRITE_TAC[CONNECTED_COMPONENT_OVERLAP] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]]);; let PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT = prove (`!s x:real^N. (path_component s x) SUBSET (connected_component s x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[PATH_COMPONENT_SUBSET; IN; PATH_COMPONENT_REFL_EQ] THEN SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; PATH_CONNECTED_PATH_COMPONENT]; ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET_REFL; CONNECTED_COMPONENT_EQ_EMPTY]]);; let PATH_COMPONENT_EQ_CONNECTED_COMPONENT = prove (`!s x:real^N. locally path_connected s ==> (path_component s x = connected_component s x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [ALL_TAC; ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]] THEN MP_TAC(ISPECL[`s:real^N->bool`; `x:real^N`] CONNECTED_CONNECTED_COMPONENT) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN REWRITE_TAC[TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS; MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS] THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; CONNECTED_COMPONENT_SUBSET]);; let PATH_COMPONENT_IMP_CONNECTED_COMPONENT = prove (`!s a b:real^N. path_component s a b ==> connected_component s a b`, REWRITE_TAC[SET_RULE `(!x. P x ==> Q x) <=> P SUBSET Q`] THEN REWRITE_TAC[PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; ETA_AX]);; let LOCALLY_PATH_CONNECTED_PATH_COMPONENT = prove (`!s x:real^N. locally path_connected s ==> locally path_connected (path_component s x)`, MESON_TAC[LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT; PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);; let OPEN_PATH_CONNECTED_COMPONENT = prove (`!s x:real^N. open s ==> path_component s x = connected_component s x`, SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT; OPEN_IMP_LOCALLY_PATH_CONNECTED]);; let PATH_CONNECTED_EQ_CONNECTED_LPC = prove (`!s. locally path_connected s ==> (path_connected s <=> connected s)`, REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; CONNECTED_IFF_CONNECTED_COMPONENT] THEN SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);; let PATH_CONNECTED_EQ_CONNECTED = prove (`!s. open s ==> (path_connected s <=> connected s)`, SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC; OPEN_IMP_LOCALLY_PATH_CONNECTED]);; let CONNECTED_OPEN_PATH_CONNECTED = prove (`!s:real^N->bool. open s /\ connected s ==> path_connected s`, SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED]);; let CONNECTED_OPEN_ARC_CONNECTED = prove (`!s:real^N->bool. open s /\ connected s ==> !x y. x IN s /\ y IN s ==> x = y \/ ?g. arc g /\ path_image g SUBSET s /\ pathstart g = x /\ pathfinish g = y`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_OPEN_PATH_CONNECTED) THEN REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);; let OPEN_COMPONENTS = prove (`!u:real^N->bool s. open u /\ s IN components u ==> open s`, REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS; ASSUME `s:real^N->bool IN components u`] `?x. s:real^N->bool = connected_component u x`) THEN ASM_SIMP_TAC [OPEN_CONNECTED_COMPONENT]);; let COMPONENTS_OPEN_UNIQUE = prove (`!f:(real^N->bool)->bool s. (!c. c IN f ==> open c /\ connected c /\ ~(c = {})) /\ pairwise DISJOINT f /\ UNIONS f = s ==> components s = f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE THEN ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; PAIRWISE_DISJOINT_COMPONENTS] THEN ASM_MESON_TAC[OPEN_COMPONENTS; IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED; OPEN_UNIONS]);; let COUNTABLE_OPEN_COMPONENTS = prove (`!s:real^N->bool. open s ==> COUNTABLE(components s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_DISJOINT_OPEN_SUBSETS THEN REWRITE_TAC[PAIRWISE_DISJOINT_COMPONENTS] THEN ASM_MESON_TAC[OPEN_COMPONENTS]);; let COUNTABLE_OPEN_CONNECTED_COMPONENTS = prove (`!s t:real^N->bool. open s ==> COUNTABLE {connected_component s x | x IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `{} INSERT components(s:real^N->bool)` THEN ASM_SIMP_TAC[COUNTABLE_INSERT; COUNTABLE_OPEN_COMPONENTS] THEN REWRITE_TAC[SUBSET; IN_INSERT; components; FORALL_IN_GSPEC] THEN REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN SET_TAC[]);; let CONTINUOUS_ON_COMPONENTS = prove (`!f:real^M->real^N s. locally connected s /\ (!c. c IN components s ==> f continuous_on c) ==> f continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_GEN THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);; let CONTINUOUS_ON_COMPONENTS_EQ = prove (`!f s. locally connected s ==> (f continuous_on s <=> !c. c IN components s ==> f continuous_on c)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET]; ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS]]);; let CONTINUOUS_ON_COMPONENTS_OPEN = prove (`!f:real^M->real^N s. open s /\ (!c. c IN components s ==> f continuous_on c) ==> f continuous_on s`, ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS; OPEN_IMP_LOCALLY_CONNECTED]);; let CONTINUOUS_ON_COMPONENTS_OPEN_EQ = prove (`!f s. open s ==> (f continuous_on s <=> !c. c IN components s ==> f continuous_on c)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET]; ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS_OPEN]]);; let CLOSED_IN_UNION_COMPLEMENT_COMPONENTS = prove (`!u s:real^N->bool c. locally connected u /\ closed_in (subtopology euclidean u) s /\ c SUBSET components(u DIFF s) ==> closed_in (subtopology euclidean u) (s UNION UNIONS c)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s UNION UNIONS c:real^N->bool = u DIFF (UNIONS(components(u DIFF s) DIFF c))` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET u /\ u DIFF s = c UNION c' /\ DISJOINT c c' ==> s UNION c = u DIFF c'`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[GSYM UNIONS_UNION; GSYM UNIONS_COMPONENTS; SET_RULE `s SUBSET t ==> s UNION (t DIFF s) = t`] THEN MATCH_MP_TAC(SET_RULE `(!s t. s IN c /\ t IN c' ==> DISJOINT s t) ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(u:real^N->bool) DIFF s` PAIRWISE_DISJOINT_COMPONENTS) THEN REWRITE_TAC[pairwise] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[]; REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_DIFF] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IN_DIFF] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u DIFF s:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);; let CLOSED_UNION_COMPLEMENT_COMPONENTS = prove (`!s c. closed s /\ c SUBSET components((:real^N) DIFF s) ==> closed(s UNION UNIONS c)`, ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);; let CLOSED_IN_UNION_COMPLEMENT_COMPONENT = prove (`!u s c:real^N->bool. locally connected u /\ closed_in (subtopology euclidean u) s /\ c IN components(u DIFF s) ==> closed_in (subtopology euclidean u) (s UNION c)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM UNIONS_1] THEN MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN ASM_REWRITE_TAC[SING_SUBSET]);; let CLOSED_UNION_COMPLEMENT_COMPONENT = prove (`!s c. closed s /\ c IN components((:real^N) DIFF s) ==> closed(s UNION c)`, ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);; let COUNTABLE_CONNECTED_COMPONENTS = prove (`!s:real^N->bool t. locally connected s ==> COUNTABLE {connected_component s x | x IN t}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{connected_component s (x:real^N) |x| x IN s}`; `s:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; UNIONS_CONNECTED_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `({}:real^N->bool) INSERT u` THEN ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] COMPLEMENT_CONNECTED_COMPONENT_UNIONS) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ASM_CASES_TAC `(x:real^N) IN connected_component s x` THENL [ALL_TAC; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);; let COUNTABLE_PATH_COMPONENTS = prove (`!s:real^N->bool t. locally path_connected s ==> COUNTABLE {path_component s x | x IN t}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{path_component s (x:real^N) |x| x IN s}`; `s:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; UNIONS_PATH_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `({}:real^N->bool) INSERT u` THEN ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] COMPLEMENT_PATH_COMPONENT_UNIONS) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF] THEN ASM_CASES_TAC `(x:real^N) IN path_component s x` THENL [ALL_TAC; ASM_MESON_TAC[IN; PATH_COMPONENT_REFL]] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);; let COUNTABLE_COMPONENTS = prove (`!s:real^N->bool. locally connected s ==> COUNTABLE(components s)`, SIMP_TAC[components; COUNTABLE_CONNECTED_COMPONENTS]);; let FRONTIER_MINIMAL_SEPARATING_CLOSED = prove (`!s c. closed s /\ ~connected((:real^N) DIFF s) /\ (!t. closed t /\ t PSUBSET s ==> connected((:real^N) DIFF t)) /\ c IN components ((:real^N) DIFF s) ==> frontier c = s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONNECTED_EQ_CONNECTED_COMPONENTS_EQ]) THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `~(!x x'. x IN s /\ x' IN s ==> x = x') ==> !x. x IN s ==> ?y. y IN s /\ ~(y = x)`)) THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `frontier c:real^N->bool`) THEN REWRITE_TAC[SET_RULE `s PSUBSET t <=> s SUBSET t /\ ~(t SUBSET s)`; GSYM SUBSET_ANTISYM_EQ] THEN ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; FRONTIER_CLOSED] THEN MATCH_MP_TAC(TAUT `~r ==> (~p ==> r) ==> p`) THEN REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `(:real^N) DIFF closure c`] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[OPEN_COMPONENTS; closed]; REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]; MP_TAC(ISPEC `c:real^N->bool` INTERIOR_SUBSET) THEN REWRITE_TAC[frontier] THEN SET_TAC[]; MATCH_MP_TAC(SET_RULE `c SUBSET c' ==> c INTER (UNIV DIFF c') INTER s = {}`) THEN REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; CLOSURE_SUBSET]; REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `ci = c /\ ~(c = {}) ==> ~(c INTER (UNIV DIFF (cc DIFF ci)) = {})`) THEN ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; INTERIOR_OPEN; closed; OPEN_COMPONENTS]; REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `~(UNIV DIFF c = {}) ==> ~((UNIV DIFF c) INTER (UNIV DIFF (c DIFF i)) = {})`) THEN REWRITE_TAC[GSYM INTERIOR_COMPLEMENT] THEN MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ ~(t = {}) ==> ~(s = {})`) THEN EXISTS_TAC `d:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN ASM_MESON_TAC[COMPONENTS_NONOVERLAP; OPEN_COMPONENTS; GSYM closed]]);; let FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE = prove (`!s a b. closed s /\ ~(a IN s) /\ ~connected_component ((:real^N) DIFF s) a b /\ (!t. closed t /\ t PSUBSET s ==> connected_component((:real^N) DIFF t) a b) ==> frontier(connected_component ((:real^N) DIFF s) a) = s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN CONJ_TAC THENL [MATCH_MP_TAC FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT THEN ASM_REWRITE_TAC[IN_COMPONENTS; IN_UNIV; IN_DIFF] THEN ASM SET_TAC[]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `frontier (connected_component ((:real^N) DIFF s) a)`) THEN ASM_REWRITE_TAC[FRONTIER_CLOSED] THEN GEN_REWRITE_TAC RAND_CONV [connected_component] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `t SUBSET UNIV DIFF f ==> ~(t INTER f = {}) ==> F`)) THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN CONJ_TAC THENL [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNIV; IN_DIFF]]);; (* ------------------------------------------------------------------------- *) (* Equivalence of LC and LPC for locally connected sets. *) (* ------------------------------------------------------------------------- *) let LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED = prove (`!s:real^N->bool. locally compact s /\ locally connected s /\ connected s ==> path_connected s`, SUBGOAL_THEN `!s:real^N->bool. compact s /\ connected s /\ locally connected s ==> path_connected s` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN EXISTS_TAC `\c:real^N->bool. compact c /\ connected c /\ locally connected c` THEN ASM_SIMP_TAC[LOCALLY_CONNECTED_CONTINUUM]] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `?f:real^1->real^N. f(vec 0) = a /\ f(vec 1) = b /\ (!x. x IN {lift(&m / &2 pow n) | 0 <= m /\ m <= 2 EXP n} ==> f x IN s) /\ f uniformly_continuous_on {lift(&m / &2 pow n) | 0 <= m /\ m <= 2 EXP n}` STRIP_ASSUME_TAC THENL [ALL_TAC; SUBGOAL_THEN `interval[vec 0:real^1,vec 1] INTER {inv(&2 pow n) % m | n,m | !i. 1 <= i /\ i <= dimindex(:1) ==> integer(m$i)} = {lift (&m / &2 pow n) | 0 <= m /\ m <= 2 EXP n}` ASSUME_TAC THENL [REWRITE_TAC[FORALL_1; DIMINDEX_1; SET_RULE `s INTER t = u <=> (!x. x IN t ==> x IN s ==> x IN u) /\ (!x. x IN u ==> x IN s /\ x IN t)`] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REWRITE_TAC[GSYM drop; FORALL_LIFT; LIFT_DROP; DROP_CMUL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; IMP_CONJ] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; LE_0] THEN REWRITE_TAC[MESON[INTEGER_POS; REAL_POS] `(!m. integer m ==> &0 <= m ==> P m) <=> (!n. P(&n))`] THEN REWRITE_TAC[IN_ELIM_THM; ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[REAL_OF_NUM_LE; LIFT_CMUL; EXISTS_LIFT; LIFT_DROP] THEN MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^1->real^N`; `interval[vec 0:real^1,vec 1] INTER {inv(&2 pow n) % m | n,m | !i. 1 <= i /\ i <= dimindex(:1) ==> integer(m$i)}`] UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN SIMP_TAC[CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; CONVEX_INTERVAL; INTERIOR_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN REWRITE_TAC[path_component] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o CONJUNCT1)) THEN ASM_SIMP_TAC[path; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`g:real^1->real^N`; `interval[vec 0:real^1,vec 1] INTER {inv(&2 pow n) % m | n,m | !i. 1 <= i /\ i <= dimindex(:1) ==> integer(m$i)}`; `s:real^N->bool`] FORALL_IN_CLOSURE) THEN SIMP_TAC[CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; CONVEX_INTERVAL; INTERIOR_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]; CONJ_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[pathstart; pathfinish] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THENL [EXISTS_TAC `0`; EXISTS_TAC `1`] THEN EXISTS_TAC `0` THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM]]] THEN SUBGOAL_THEN `?f:real->real^N. f(&0) = a /\ f(&1) = b /\ (!m n. m <= 2 EXP n ==> f(&m / &2 pow n) IN s) /\ (!j. ?d. &0 < d /\ !n m1 m2. m1 <= 2 EXP n /\ m2 <= 2 EXP n /\ abs(&m1 / &2 pow n - &m2 / &2 pow n) < d ==> dist(f(&m1 / &2 pow n),f(&m2 / &2 pow n)) < inv(&2 pow j))` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `(f:real->real^N) o drop` THEN REWRITE_TAC[GSYM LIFT_NUM; uniformly_continuous_on; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM; DIST_LIFT; o_DEF] THEN ASM_REWRITE_TAC[LE_0; LIFT_DROP] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `j:num` th) THEN MATCH_MP_TAC MONO_EXISTS) THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_ABS_SUB]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n1:num`; `n2:num`] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`m1:num`; `m2:num`] THEN REPEAT DISCH_TAC THEN TRANS_TAC REAL_LT_TRANS `inv(&2 pow j)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n2:num`; `m2:num`; `2 EXP (n2 - n1) * m1`]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < n1 /\ &0 < n2 ==> (n2 / n1 * m) / n2 = m / n1`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `a / b * c <= a <=> a * c / b <= a * &1`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW] THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE]] THEN SUBGOAL_THEN `?p f. (!n. p n < p(SUC n)) /\ f(&0):real^N = a /\ f(&1) = b /\ (!k1 i1 k2 i2. k1 <= k2 /\ i1 <= 2 EXP (p k1) /\ i2 <= 2 EXP (p k2) /\ abs(&i1 / &2 pow (p k1) - &i2 / &2 pow (p k2)) < inv(&2 pow (p k1)) ==> ?c. connected c /\ c SUBSET s /\ c SUBSET ball(f(&i1 / &2 pow (p k1)),&2 / &2 pow k1) /\ f(&i1 / &2 pow (p k1)) IN c /\ f(&i2 / &2 pow (p k2)) IN c)` MP_TAC THENL [ALL_TAC; DISCH_THEN(X_CHOOSE_THEN `r:num->num` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN MP_TAC(ISPEC `r:num->num` MONOTONE_BIGGER) THEN ANTS_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS]; DISCH_THEN(MP_TAC o SPEC `n:num`) THEN DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `2 EXP (r n - n) * m`; `n:num`; `2 EXP (r n - n) * m`]) THEN REWRITE_TAC[LE_REFL; REAL_SUB_REFL; REAL_ABS_NUM] THEN REWRITE_TAC[CONJ_ASSOC; REAL_LT_INV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_ARITH `a / b * c <= a <=> a * c / b <= a * &1`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < n1 /\ &0 < n2 ==> (n2 / n1 * m) / n2 = m / n1`] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN SET_TAC[]; X_GEN_TAC `j:num` THEN EXISTS_TAC `inv(&2 pow (r(j + 2)))` THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_LT_POW2] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_ABS_SUB]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m1:num`; `m2:num`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `r(j + 2):num < n` ASSUME_TAC THENL [REWRITE_TAC[GSYM NOT_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n)` o MATCH_MP (REAL_ARITH `a < b ==> !x. x <= a ==> x < b`)) THEN REWRITE_TAC[REAL_NOT_LT; NOT_IMP] THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_LT_POW2; REAL_POW_MONO; REAL_OF_NUM_LE; ARITH] THEN REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0; REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `r:num->num` MONOTONE_BIGGER) THEN ANTS_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS]; DISCH_THEN(MP_TAC o SPEC `n:num`) THEN DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`j + 2`; `m2 DIV (2 EXP (n - r(j + 2)))`; `n:num`]) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN ANTS_TAC THENL [TRANS_TAC LE_TRANS `r(j + 2):num` THEN ASM_SIMP_TAC[LT_IMP_LE] THEN SPEC_TAC(`j + 2`,`i:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS]; ALL_TAC] THEN ANTS_TAC THENL [SIMP_TAC[LE_LDIV_EQ; EXP_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC (ARITH_RULE `~(b = 0) /\ a <= b * c ==> a < b * (c + 1)`) THEN REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN ASM_SIMP_TAC[GSYM EXP_ADD; LT_IMP_LE; SUB_ADD]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `2 EXP (r n - n) * m1` th) THEN MP_TAC(SPEC `2 EXP (r n - n) * m2` th)) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_ARITH `a / b * c <= a <=> a * c / b <= a * &1`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < n1 /\ &0 < n2 ==> (n2 / n1 * m) / n2 = m / n1`] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN MATCH_MP_TAC(TAUT `(q1 /\ q2 ==> r) /\ (p1 /\ p2) ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r`) THEN CONJ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (SET_RULE `(?c. P c /\ c SUBSET s /\ c SUBSET b /\ x IN c /\ y IN c) ==> y IN b`))) THEN REWRITE_TAC[IN_BALL; IMP_IMP] THEN MATCH_MP_TAC(NORM_ARITH `inv(&2) * j = i ==> dist(x:real^N,a) < i /\ dist(x,b) < i ==> dist(a,b) < j`) THEN REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `a < b /\ x <= b /\ b - i < x /\ abs(a - b) < i ==> abs(x - b) < i /\ abs(x - a) < i`) THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LT_POW2; REAL_OF_NUM_LT] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < n /\ &0 < j ==> (m / n - inv j) * j = m / (n / j) - &1`] THEN SIMP_TAC[REAL_LT_POW2; REAL_LT_SUB_RADD; REAL_FIELD `&0 < n /\ &0 < j ==> m / n * j = m / (n / j)`] THEN ASM_SIMP_TAC[GSYM REAL_POW_SUB; LT_IMP_LE; REAL_OF_NUM_EQ; ARITH] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[DIV_MUL_LE] THEN W(MP_TAC o PART_MATCH (lhand o lhand o rand o lhand o rand) DIVISION o lhand o rand o rand o snd) THEN REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN ARITH_TAC]]] THEN SUBGOAL_THEN `?p f. (!n. p n < p(SUC n)) /\ f(&0):real^N = a /\ f(&1) = b /\ (!n m k. m <= 2 EXP (p n) /\ k <= 2 EXP (p(SUC n)) /\ abs(&m / &2 pow (p n) - &k / &2 pow (p(SUC n))) < inv(&2 pow (p n)) ==> ?c. connected c /\ c SUBSET s /\ c SUBSET ball(f(&m / &2 pow (p n)),inv(&2 pow n)) /\ f(&m / &2 pow (p n)) IN c /\ f(&k / &2 pow (p(SUC n))) IN c)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ONCE_REWRITE_TAC[MESON[LE_EXISTS] `(!m n:num. m <= n ==> P m n) <=> !n d. P n (n + d)`] THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`n:num`; `m1:num`; `m2:num`] THEN REWRITE_TAC[ADD_CLAUSES; real_div; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN SIMP_TAC[GSYM REAL_EQ_INTEGERS; INTEGER_CLOSED] THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN STRIP_TAC THEN EXISTS_TAC `{f(&m2 / &2 pow r(n:num)):real^N}` THEN ASM_REWRITE_TAC[SING_SUBSET; IN_SING; CENTRE_IN_BALL] THEN REWRITE_TAC[CONNECTED_SING] THEN SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `m2:num`; `2 EXP (r(SUC n) - r n) * m2`]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_SUB; LT_IMP_LE; REAL_OF_NUM_EQ; ARITH_EQ] THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < r /\ &0 < s ==> (r / s * m) / r = m / s`] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_INV_EQ] THEN REWRITE_TAC[REAL_LT_POW2] THEN ONCE_REWRITE_TAC[REAL_ARITH `a / b * c <= a <=> a * c / b <= a * &1`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_LID] THEN ASM_REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE]; ALL_TAC] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "*") THEN MAP_EVERY X_GEN_TAC [`n:num`; `m1:num`; `m2:num`] THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN SUBGOAL_THEN `?k. k <= 2 EXP r(SUC n) /\ abs(&m1 / &2 pow (r n) - &k / &2 pow r(SUC n)) < inv(&2 pow r n) /\ abs(&k / &2 pow r(SUC n) - &m2 / &2 pow r(SUC(n + d))) < inv (&2 pow r (SUC n))` STRIP_ASSUME_TAC THENL [ALL_TAC; REMOVE_THEN "*" (MP_TAC o SPECL [`SUC n`; `k:num`; `m2:num`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `m1:num`; `k:num`]) THEN ASM_REWRITE_TAC[ADD_CLAUSES; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c1:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `c1 UNION c2:real^N->bool` THEN ASM_REWRITE_TAC[UNION_SUBSET; IN_UNION] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL; REAL_ARITH `&0 + inv x <= &2 / x <=> &0 <= inv x`] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN DISJ1_TAC THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN MATCH_MP_TAC(REAL_ARITH `x < y ==> x + &2 * inv(&2) * y <= &2 * y`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL] THEN REWRITE_TAC[GSYM real_div] THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `!m n. m <= n ==> (r:num->num) m <= r n` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[LT_IMP_LE] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `(?k. P k \/ P(k + 1)) ==> ?k. P k`) THEN EXISTS_TAC `m2 DIV 2 EXP (r(SUC(n + d)) - r(SUC n))` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1 * y`] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_ARITH `(x + &1) / y = x / y + inv(y)`] THEN MATCH_MP_TAC(REAL_ARITH `x <= b /\ b < x + e /\ abs(a - b) < d /\ e <= d /\ a <= c /\ b <= c ==> x <= c /\ abs(a - x) < d /\ abs(x - b) < e \/ x + e <= c /\ abs(a - (x + e)) < d /\ abs((x + e) - b) < e`) THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; LT_IMP_LE; REAL_LT_POW2] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN ASM_REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN REWRITE_TAC[REAL_ARITH `x / y + inv y = (x + &1) / y`] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; GSYM REAL_OF_NUM_POW] THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < m /\ &0 < n ==> x / m * n = x / (m / n)`] THEN ASM_SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ; ARITH_RULE `SUC n <= SUC(n + d)`] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN W(MP_TAC o PART_MATCH (lhand o lhand o rand o lhand o rand) DIVISION o lhand o lhand o lhand o snd) THEN REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN ARITH_TAC] THEN SUBGOAL_THEN `?p f. (!n. p n < p(SUC n)) /\ (!n. f n 0 = (a:real^N)) /\ (!n. f n (2 EXP (p n)) = b) /\ (!n k. k <= 2 EXP (p n) ==> f (SUC n) (2 EXP (p(SUC n) - p n) * k) = f n k) /\ (!n m k. m <= 2 EXP (p n) /\ k <= 2 EXP (p(SUC n)) /\ abs(&m / &2 pow (p n) - &k / &2 pow (p(SUC n))) < inv(&2 pow (p n)) ==> ?c. connected c /\ c SUBSET s /\ c SUBSET ball(f n m,inv(&2 pow n)) /\ f n m IN c /\ f (SUC n) k IN c)` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN DISCH_THEN(X_CHOOSE_THEN `f:num->num->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x. let t = @t. &(SND t) / &2 pow (r(FST t)) = x in (f:num->num->real^N) (FST t) (SND t)` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [LET_TAC THEN SUBGOAL_THEN `&(SND t) / &2 pow r(FST t:num) = &0` MP_TAC THENL [EXPAND_TAC "t" THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC `0,0` THEN REWRITE_TAC[real_div; REAL_MUL_LZERO]; REWRITE_TAC[REAL_DIV_EQ_0; REAL_POW_EQ_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ]]; LET_TAC THEN SUBGOAL_THEN `&(SND t) / &2 pow r(FST t:num) = &1` MP_TAC THENL [EXPAND_TAC "t" THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC `0,2 EXP r 0` THEN SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ]; SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_EQ]]; MAP_EVERY X_GEN_TAC [`n:num`; `m:num`; `k:num`] THEN STRIP_TAC THEN ABBREV_TAC `t = @t. &(SND t) / &2 pow r (FST t:num) = &m / &2 pow r n` THEN ABBREV_TAC `u = @t. &(SND t) / &2 pow r (FST t) = &k / &2 pow r(SUC n)` THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN SUBGOAL_THEN `(f:num->num->real^N) (FST t) (SND t) = f n m /\ (f:num->num->real^N) (FST u) (SND u) = f (SUC n) k` (fun th -> ASM_SIMP_TAC[th]) THEN SUBGOAL_THEN `!n n' m m'. &m / &2 pow (r n) = &m' / &2 pow (r n') /\ m' <= 2 EXP (r n') ==> (f:num->num->real^N) n m = f n' m'` (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXPAND_TAC ["t"; "u"] THEN CONV_TAC SELECT_CONV THEN REWRITE_TAC[EXISTS_PAIR_THM] THEN MESON_TAC[]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1 * y`] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (fun t -> not(is_forall t)) o concl)) THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [SIMP_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[REAL_OF_NUM_EQ; REAL_LT_POW2; REAL_FIELD `&0 < z ==> (x / z = y / z <=> x = y)`]; ALL_TAC] THEN X_GEN_TAC `p:num` THEN ASM_CASES_TAC `SUC p = n` THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_LT_POW2; REAL_FIELD `&0 < z ==> (x / z = y / z <=> x = y)`] THEN ASM_CASES_TAC `n <= SUC p` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n:num <= p` THENL [ALL_TAC; ASM_ARITH_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN MAP_EVERY X_GEN_TAC [`m1:num`; `m2:num`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN SUBGOAL_THEN `!m n. m <= n ==> (r:num->num) m <= r n` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[LT_IMP_LE] THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < m /\ &0 < n ==> (x / m = y / n <=> y = (n / m) * x)`] THEN ASM_SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ; LT_IMP_LE] THEN REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE] THEN STRIP_TAC THEN SUBGOAL_THEN `r(SUC p) - r n:num = (r(SUC p) - r p) + (r p - r n)` SUBST1_TAC THENL [MATCH_MP_TAC(ARITH_RULE `x <= y /\ y <= z ==> z - x:num = (z - y) + (y - x)`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[EXP_ADD; GSYM MULT_ASSOC]] THEN CONV_TAC SYM_CONV THEN TRANS_TAC EQ_TRANS `(f:num->num->real^N) p (2 EXP (r p - r(n:num)) * m1)` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN ONCE_REWRITE_TAC[REAL_ARITH `m / x * y:real = (y / x) * m`] THEN ASM_SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_POW; MULT_CLAUSES]] THEN UNDISCH_TAC `m2 <= 2 EXP r (SUC p)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN REWRITE_TAC[REAL_ARITH `x / y * z <= x <=> x * (z / y) <= x * &1`] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2]]] THEN SUBGOAL_THEN `?t. (!n. SND(t n) 0 = (a:real^N) /\ (!i. 2 EXP (FST(t n)) <= i ==> SND(t n) i = b) /\ !m. m <= 2 EXP (FST(t n)) ==> ?c. connected c /\ c SUBSET s /\ c SUBSET ball(SND(t n) m,inv(&2 pow n)) /\ c SUBSET ball(SND(t n) (SUC m),inv(&2 pow n)) /\ SND(t n) m IN c /\ SND(t n) (SUC m) IN c) /\ (!n. FST(t n) < FST(t(SUC n)) /\ (!k. k <= 2 EXP (FST(t n)) ==> SND(t(SUC n)) (2 EXP (FST(t(SUC n)) - FST(t n)) * k) = SND(t n) k) /\ (!m k. m <= 2 EXP (FST(t n)) /\ k <= 2 EXP (FST(t(SUC n))) /\ abs(&m / &2 pow (FST(t n)) - &k / &2 pow (FST(t(SUC n)))) < inv(&2 pow (FST(t n))) ==> ?c. connected c /\ c SUBSET s /\ c SUBSET ball(SND(t n) m,inv(&2 pow n)) /\ SND(t n) m IN c /\ SND(t(SUC n)) k IN c))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[EXISTS_PAIR_THM; FORALL_PAIR_THM]; DISCH_THEN(X_CHOOSE_THEN `t:num->num#(num->real^N)` STRIP_ASSUME_TAC) THEN EXISTS_TAC `FST o (t:num->num#(num->real^N))` THEN EXISTS_TAC `SND o (t:num->num#(num->real^N))` THEN ASM_REWRITE_TAC[o_THM] THEN ASM_SIMP_TAC[LE_REFL]] THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `d:real`; `a:real^N`; `b:real^N`] CONNECTED_IMP_WELLCHAINED) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^N` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN EXISTS_TAC `\i. if i <= l then (g:num->real^N) i else b:real^N` THEN ASM_REWRITE_TAC[LE_0] THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `l:num` LT_POW2_REFL) THEN ASM_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_CASES_TAC `l:num <= i` THENL [ASM_SIMP_TAC[ARITH_RULE `l <= i ==> ~(SUC i <= l)`] THEN ASM_SIMP_TAC[ARITH_RULE `l:num <= i ==> (i <= l <=> i = l)`] THEN EXISTS_TAC `{b:real^N}` THEN REWRITE_TAC[COND_ID; CONNECTED_SING; IN_SING; SING_SUBSET] THEN REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE])] THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(g:num->real^N) i`; `g(SUC i):real^N`]) THEN ANTS_TAC THENL [ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[SUBSET_INTER; CONJ_ACI]]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `m:num`; `f:num->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `!r. r <= 2 EXP m ==> ?l g:num->real^N. g 0 = f r /\ (!i. l <= i ==> g i = f (SUC r)) /\ (?c. connected c /\ f r IN c /\ f(SUC r) IN c /\ c SUBSET s /\ c SUBSET ball(f r,inv (&2 pow n)) /\ c SUBSET ball(f(SUC r),inv (&2 pow n)) /\ !i. g i IN c) /\ (!i. ?c. connected c /\ c SUBSET s /\ c SUBSET ball(g i,inv(&2 pow (SUC n))) /\ c SUBSET ball(g(SUC i),inv(&2 pow (SUC n))) /\ g i IN c /\ g(SUC i) IN c)` MP_TAC THENL [X_GEN_TAC `r:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `s:real^N->bool` COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `inv(&2 pow (SUC n))`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^N->bool`; `d:real`; `(f:num->real^N) r`; `(f:num->real^N) (SUC r)`] CONNECTED_IMP_WELLCHAINED) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^N` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN EXISTS_TAC `\i. if i <= l then (g:num->real^N) i else f(SUC r)` THEN ASM_REWRITE_TAC[LE_0] THEN CONJ_TAC THENL [ASM_MESON_TAC[LE_ANTISYM]; ALL_TAC] THEN CONJ_TAC THENL [EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `l:num <= i` THENL [ASM_SIMP_TAC[ARITH_RULE `l <= i ==> ~(SUC i <= l)`] THEN ASM_SIMP_TAC[ARITH_RULE `l:num <= i ==> (i <= l <=> i = l)`] THEN EXISTS_TAC `{f(SUC r):real^N}` THEN REWRITE_TAC[COND_ID; CONNECTED_SING; IN_SING; SING_SUBSET] THEN REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ; REAL_LT_POW2] THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE])] THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(g:num->real^N) i`; `g(SUC i):real^N`]) THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET_INTER; CONJ_ACI]] THEN REPEAT(FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `SUC i` th))) THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE] THEN ASM SET_TAC[]; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:num->num`; `g:num->num->real^N`] THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPECL [`\n:num. n`; `2 EXP 1 INSERT IMAGE (l:num->num) {r | r <= 2 EXP m}`] UPPER_BOUND_FINITE_SET) THEN SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; FINITE_NUMSEG_LE] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` (MP_TAC o MATCH_MP (MESON[LE_TRANS; LT_LE] `(!x. x IN s ==> x <= p) ==> p < 2 EXP p ==> (!x. x IN s ==> x <= 2 EXP p)`))) THEN ANTS_TAC THEN REWRITE_TAC[LT_POW2_REFL] THEN REWRITE_TAC[FORALL_IN_INSERT; LE_EXP] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN STRIP_TAC THEN EXISTS_TAC `m + p:num` THEN EXISTS_TAC `\i. if i <= 2 EXP (m + p) then (g:num->num->real^N) (i DIV (2 EXP p)) (i MOD (2 EXP p)) else b` THEN ASM_REWRITE_TAC[ARITH_RULE `m < m + p <=> 1 <= p`] THEN REWRITE_TAC[ADD_SUB2] THEN SIMP_TAC[] THEN SIMP_TAC[DIV_MULT; EXP_EQ_0; ARITH_EQ; EXP_ADD; MOD_MULT; ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT; ONCE_REWRITE_RULE[MULT_SYM] MOD_MULT] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[LE_0; DIV_0; MOD_0; EXP_EQ_0; ARITH_EQ] THEN ASM_SIMP_TAC[LE_0]; SIMP_TAC[ARITH_RULE `m:num <= n ==> (n <= m <=> n = m)`] THEN SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT; ONCE_REWRITE_RULE[MULT_SYM] MOD_MULT; EXP_EQ_0; ARITH_EQ] THEN ASM_SIMP_TAC[LE_REFL; COND_ID]; ALL_TAC; ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE `p * k:num <= m * p <=> p * k <= p * m`] THEN SIMP_TAC[LE_MULT_LCANCEL]; MAP_EVERY X_GEN_TAC [`r:num`; `k:num`] THEN MP_TAC(ISPECL [`k:num`; `2 EXP p`] DIVISION) THEN MAP_EVERY ABBREV_TAC [`k1 = k DIV 2 EXP p`; `k2 = k MOD 2 EXP p`] THEN REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC) THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `k * p + k':num <= m ==> k * p <= m`)) THEN REWRITE_TAC[LE_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ] THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `k1:num`) THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC MONO_EXISTS THEN SUBGOAL_THEN `r = k1 \/ r = SUC k1` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [REAL_ABS_SUB]) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; GSYM REAL_OF_NUM_POW] THEN SIMP_TAC[REAL_POW_ADD; REAL_LT_POW2; REAL_FIELD `&0 < m /\ &0 < p ==> (k1 * p + k2) / (m * p) - r / m = ((k1 - r) * p + k2) / p / m`] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_LT_POW2] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `abs(r + k2) < p ==> &0 <= k2 /\ k2 < p ==> -- &2 * p < r /\ r < &1 * p`)) THEN SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN ASM_REWRITE_TAC[REAL_POS; REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; REAL_POS] THEN REWRITE_TAC[REAL_ARITH `-- &2 + &1:real <= k - r <=> r <= k + &1`; REAL_ARITH `k - r + &1:real <= &1 <=> k <= r`] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ARITH_TAC] THEN X_GEN_TAC `k:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [UNDISCH_TAC `SUC k <= 2 EXP m * 2 EXP p`; DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `k <= n ==> ~(SUC k <= n) ==> k = n`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT; ONCE_REWRITE_RULE[MULT_SYM] MOD_MULT; EXP_EQ_0; ARITH_EQ] THEN ASM_SIMP_TAC[LE_REFL] THEN EXISTS_TAC `{b:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING; IN_SING; SING_SUBSET] THEN REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ; REAL_LT_POW2]] THEN MP_TAC(ISPECL [`k:num`; `2 EXP p`] DIVISION) THEN MAP_EVERY ABBREV_TAC [`k1 = k DIV 2 EXP p`; `k2 = k MOD 2 EXP p`] THEN REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC) THEN REWRITE_TAC[LE_SUC_LT] THEN REPEAT DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `SUC(a * b + c) = a * b + SUC c`] THEN SIMP_TAC[DIV_MULT_ADD; MOD_MULT_ADD; EXP_EQ_0; ARITH_EQ] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a + b:num < c ==> a < c`)) THEN REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ] THEN DISCH_TAC THEN SUBGOAL_THEN `SUC k2 <= 2 EXP p` MP_TAC THENL [ASM_REWRITE_TAC[LE_SUC_LT]; REWRITE_TAC[LE_LT]] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[DIV_LT; MOD_LT; ADD_CLAUSES] THEN REMOVE_THEN "*" (MP_TAC o SPEC `k1:num`) THEN ASM_SIMP_TAC[LT_IMP_LE] THEN MESON_TAC[]; ASM_SIMP_TAC[DIV_REFL; MOD_REFL; EXP_EQ_0; ARITH_EQ] THEN ASM_SIMP_TAC[ARITH_RULE `a < b ==> a + 1 <= b`] THEN REMOVE_THEN "*" (MP_TAC o SPEC `k1:num`) THEN ASM_SIMP_TAC[LT_IMP_LE] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN DISCH_THEN(MP_TAC o SPEC `k2:num`) THEN REWRITE_TAC[GSYM ADD1] THEN SUBGOAL_THEN `(g:num->num->real^N) k1 (SUC k2) = f(SUC k1)` (fun th -> REWRITE_TAC[th]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[LT_IMP_LE]]);; let LOCALLY_COMPACT_PATH_CONNECTED_EQ_CONNECTED = prove (`!s:real^N->bool. locally compact s /\ locally connected s ==> (path_connected s <=> connected s)`, MESON_TAC[LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; let LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED = prove (`!s:real^N->bool. locally compact s /\ locally connected s ==> locally path_connected s`, REPEAT STRIP_TAC THEN MP_TAC(ASSUME `locally connected (s:real^N->bool)`) THEN REWRITE_TAC[LOCALLY_CONNECTED; LOCALLY_PATH_CONNECTED] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `v:real^N->bool` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]);; let LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED = prove (`!s:real^N->bool. locally compact s ==> (locally path_connected s <=> locally connected s)`, MESON_TAC[LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED; LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; let LOCALLY_PATH_CONNECTED_CLOSURE_FROM_FRONTIER = prove (`!s:real^N->bool. locally connected (frontier s) ==> locally path_connected (closure s)`, SIMP_TAC[LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_CLOSURE; FRONTIER_CLOSED] THEN REWRITE_TAC[LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER]);; (* ------------------------------------------------------------------------- *) (* If two points are separated by a closed set, there's a minimal one. *) (* ------------------------------------------------------------------------- *) let CLOSED_IRREDUCIBLE_SEPARATOR = prove (`!s a b:real^N. closed s /\ ~connected_component ((:real^N) DIFF s) a b ==> ?t. t SUBSET s /\ closed t /\ ~(t = {}) /\ ~connected_component ((:real^N) DIFF t) a b /\ !u. u PSUBSET t ==> connected_component ((:real^N) DIFF u) a b`, MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `a:real^N`; `b:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN c` THENL [EXISTS_TAC `{a:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(b:real^N) IN c` THENL [EXISTS_TAC `{b:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[]; ALL_TAC] THEN MAP_EVERY ABBREV_TAC [`r = connected_component ((:real^N) DIFF c) a`; `s = connected_component ((:real^N) DIFF closure r) b`] THEN EXISTS_TAC `frontier s:real^N->bool` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN SUBGOAL_THEN `(a:real^N) IN r` ASSUME_TAC THENL [EXPAND_TAC "r" THEN REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(b:real^N) IN s` ASSUME_TAC THENL [EXPAND_TAC "s" THEN REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION; DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN]; EXPAND_TAC "r"] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] FRONTIER_OF_CONNECTED_COMPONENT_SUBSET)) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(b IN s) ==> t SUBSET s ==> b IN t ==> F`)) THEN ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ]; ALL_TAC] THEN SUBGOAL_THEN `frontier(s:real^N->bool) SUBSET frontier r` ASSUME_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] `frontier s SUBSET t ==> frontier(connected_component s a) SUBSET t`) THEN REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ p /\ ~r /\ s ==> p /\ ~q /\ ~r /\ s`) THEN CONJ_TAC THENL [SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN REWRITE_TAC[UNIV]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN EXPAND_TAC "r" THEN MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] `frontier s SUBSET t ==>frontier (connected_component s a) SUBSET t`) THEN ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ]; REWRITE_TAC[connected_component; NOT_EXISTS_THM; SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THENL [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `a:real^N`] THEN ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN] THEN DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP CONNECTED_COMPONENT_IN) THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[]; X_GEN_TAC `u:real^N->bool` THEN REWRITE_TAC[PSUBSET_ALT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `(p:real^N) INSERT (s UNION r)` THEN ASM_REWRITE_TAC[IN_INSERT; IN_UNION] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `a INSERT (s UNION t) = (a INSERT s) UNION (a INSERT t)`] THEN MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL [EXISTS_TAC `s:real^N->bool`; EXISTS_TAC `r:real^N->bool`] THEN (CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN REWRITE_TAC[CLOSURE_SUBSET] THEN ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN ASM SET_TAC[]); MATCH_MP_TAC(SET_RULE `s INTER u = {} /\ t INTER u = {} /\ ~(p IN u) ==> p INSERT (s UNION t) SUBSET UNIV DIFF u`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `u SUBSET t ==> t INTER s = {} ==> s INTER u = {}`)) THEN REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "s"; SUBGOAL_THEN `frontier(r:real^N->bool) INTER r = {}` (fun th -> ASM SET_TAC[th]) THEN REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "r"] THEN MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]]]);; (* ------------------------------------------------------------------------- *) (* Lower bound on norms within segment between vectors. *) (* Could have used these for connectedness results below, in fact. *) (* ------------------------------------------------------------------------- *) let NORM_SEGMENT_LOWERBOUND = prove (`!a b x:real^N r d. &0 < r /\ norm(a) = r /\ norm(b) = r /\ x IN segment[a,b] /\ a dot b = d * r pow 2 ==> sqrt((&1 - abs d) / &2) * r <= norm(x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real_ge] THEN REWRITE_TAC[NORM_GE_SQUARE] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[real_ge; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2 - &2 * (&1 - u) * u * abs d * r pow 2` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `(&1 - u) pow 2 + u pow 2 - ((&2 * (&1 - u)) * u) * d = (&1 + d) * (&1 - &2 * u + &2 * u pow 2) - d`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + abs d) * &1 / &2 - abs d` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `(&1 + d) * &1 / &2 - d = (&1 - d) / &2`] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SQRT_POW_2 THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_POW2_ABS] THEN ASM_REWRITE_TAC[REAL_ARITH `r * r = &1 * r pow 2`] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `x <= y ==> x - a <= y - a`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `&0 <= (u - &1 / &2) * (u - &1 / &2) ==> &1 / &2 <= &1 - &2 * u + &2 * u pow 2`) THEN REWRITE_TAC[REAL_LE_SQUARE]]]; ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_LE_LADD; real_sub] THEN MATCH_MP_TAC(REAL_ARITH `abs(a) <= --x ==> x <= a`) THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_LNEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN ASM_REWRITE_TAC[real_abs; GSYM real_sub; REAL_SUB_LE; REAL_POS] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Special case of orthogonality (could replace 2 by sqrt(2)). *) (* ------------------------------------------------------------------------- *) let NORM_SEGMENT_ORTHOGONAL_LOWERBOUND = prove (`!a b:real^N x r. r <= norm(a) /\ r <= norm(b) /\ orthogonal a b /\ x IN segment[a,b] ==> r / &2 <= norm(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM real_ge] THEN REWRITE_TAC[NORM_GE_SQUARE] THEN REWRITE_TAC[real_ge] THEN ASM_CASES_TAC `r <= &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[orthogonal] THEN STRIP_TAC THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `(r / &2) pow 2 = &1 / &4 * r pow 2`] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= (u - &1 / &2) * (u - &1 / &2) ==> &1 / &4 <= (&1 - u) * (&1 - u) + u * u`) THEN REWRITE_TAC[REAL_LE_SQUARE]; REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Accessibility of frontier points. *) (* ------------------------------------------------------------------------- *) let DENSE_ACCESSIBLE_FRONTIER_POINTS = prove (`!s:real^N->bool v. open s /\ open_in (subtopology euclidean (frontier s)) v /\ ~(v = {}) ==> ?g. arc g /\ IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\ pathstart g IN s /\ pathfinish g IN v`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `z:real^N`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN SUBGOAL_THEN `(z:real^N) IN frontier s` MP_TAC THENL [ASM SET_TAC[]; DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN]] THEN REWRITE_TAC[closure; IN_UNION; TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `s INTER ball(z:real^N,r) = {}` THENL [ASM_MESON_TAC[INFINITE; FINITE_EMPTY]; DISCH_THEN(K ALL_TAC)] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~((y:real^N) IN frontier s)` ASSUME_TAC THENL [ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN; frontier]; ALL_TAC] THEN SUBGOAL_THEN `path_connected(ball(z:real^N,r))` MP_TAC THENL [ASM_SIMP_TAC[CONVEX_BALL; CONVEX_IMP_PATH_CONNECTED]; ALL_TAC] THEN REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `IMAGE drop {t | t IN interval[vec 0,vec 1] /\ (g:real^1->real^N) t IN frontier s}` COMPACT_ATTAINS_INF) THEN REWRITE_TAC[EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IMP_CONJ] THEN REWRITE_TAC[IMP_IMP; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM IMAGE_o] THEN REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_ID] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN REWRITE_TAC[BOUNDED_INTERVAL; SUBSET_RESTRICT]; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN REWRITE_TAC[FRONTIER_CLOSED; CLOSED_INTERVAL; GSYM path] THEN ASM_MESON_TAC[arc]]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 1:real^1` THEN ASM_REWRITE_TAC[IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[pathfinish; SUBSET]]; DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `subpath (vec 0) t (g:real^1->real^N)` THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC ARC_SUBPATH_ARC THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[pathstart]; REWRITE_TAC[arc] THEN STRIP_TAC] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [GSYM pathstart] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(SIMP_RULE[path_image]) THEN ASM SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f (s DELETE a) SUBSET t`) THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN W(MP_TAC o PART_MATCH (lhand o rand) PATH_IMAGE_SUBPATH o lhand o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[REWRITE_RULE[pathfinish] PATHFINISH_SUBPATH] THEN MATCH_MP_TAC(SET_RULE `IMAGE f (s DELETE a) DIFF t = {} ==> IMAGE f s DELETE f a SUBSET t`) THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `p /\ q /\ ~r ==> ~s <=> p /\ q /\ s ==> r`] CONNECTED_INTER_FRONTIER) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [arc]) THEN REWRITE_TAC[path] THEN MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `interval(vec 0:real^1,t)` THEN REWRITE_TAC[CONNECTED_INTERVAL; CLOSURE_INTERVAL] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[SET_RULE `~(IMAGE f s INTER t = {}) <=> ?x. x IN s /\ f x IN t`] THEN EXISTS_TAC `vec 0:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; REAL_LE_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM SET_TAC[pathstart]; REWRITE_TAC[SET_RULE `IMAGE g i INTER s = {} <=> !x. x IN i ==> ~(g x IN s)`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; IN_DIFF] THEN X_GEN_TAC `z:real^1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1] THEN DISCH_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]]);; let DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED = prove (`!s:real^N->bool v x. open s /\ connected s /\ x IN s /\ open_in (subtopology euclidean (frontier s)) v /\ ~(v = {}) ==> ?g. arc g /\ IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\ pathstart g = x /\ pathfinish g IN v`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`] DENSE_ACCESSIBLE_FRONTIER_POINTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `pathstart g:real^N`]) THEN ASM_REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^1->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`f ++ g:real^1->real^N`; `x:real^N`; `pathfinish g:real^N`] PATH_CONTAINS_ARC) THEN ASM_SIMP_TAC[PATH_JOIN_EQ; ARC_IMP_PATH; PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN DISCH_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f (s DELETE a) SUBSET t`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM path_image]; ASM_MESON_TAC[arc]] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `h SUBSET f UNION g ==> f SUBSET s /\ g DELETE a SUBSET s ==> h DELETE a SUBSET s`)) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish]) THEN REWRITE_TAC[path_image] THEN ASM SET_TAC[]);; let DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS = prove (`!s u v:real^N->bool. open s /\ connected s /\ open_in (subtopology euclidean (frontier s)) u /\ open_in (subtopology euclidean (frontier s)) v /\ ~(u = {}) /\ ~(v = {}) /\ ~(u = v) ==> ?g. arc g /\ pathstart g IN u /\ pathfinish g IN v /\ IMAGE g (interval(vec 0,vec 1)) SUBSET s`, GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o RAND_CONV) [GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `(!u v. R u v ==> R v u) /\ (!u v. P u v ==> R u v) ==> !u v. P u v \/ P v u ==> R u v`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN EXISTS_TAC `reversepath g:real^1->real^N` THEN ASM_SIMP_TAC[ARC_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN REWRITE_TAC[reversepath] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f i SUBSET t ==> IMAGE r i SUBSET i ==> IMAGE f (IMAGE r i) SUBSET t`)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[FRONTIER_EMPTY; OPEN_IN_SUBTOPOLOGY_EMPTY] THENL [CONV_TAC TAUT; STRIP_TAC THEN UNDISCH_TAC `~(s:real^N->bool = {})`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`; `x:real^N`] DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(u DELETE pathfinish g):real^N->bool`; `x:real^N`] DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN ASM_SIMP_TAC[OPEN_IN_DELETE; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`(reversepath h ++ g):real^1->real^N`; `pathfinish h:real^N`; `pathfinish g:real^N`] PATH_CONTAINS_ARC) THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_REVERSEPATH; ARC_IMP_PATH; PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN MATCH_MP_TAC(SET_RULE `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ t SUBSET s /\ IMAGE f s SUBSET u UNION IMAGE f t ==> IMAGE f (s DIFF t) SUBSET u`) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN CONJ_TAC THENL [ASM_MESON_TAC[arc]; REWRITE_TAC[GSYM path_image]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN REWRITE_TAC[path_image] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some simple positive connection theorems. *) (* ------------------------------------------------------------------------- *) let PATH_CONNECTED_CONVEX_DIFF_CARD_LT = prove (`!u s:real^N->bool. convex u /\ ~(collinear u) /\ s <_c (:real) ==> path_connected(u DIFF s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[path_connected; IN_DIFF; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `a:real^N = b` THENL [EXISTS_TAC `linepath(a:real^N,b)` THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN ABBREV_TAC `m:real^N = midpoint(a,b)` THEN SUBGOAL_THEN `~(m:real^N = a) /\ ~(m = b)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MIDPOINT_EQ_ENDPOINT]; ALL_TAC] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN GEOM_ORIGIN_TAC `m:real^N` THEN REPEAT GEN_TAC THEN GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEN_TAC THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `bbb:real` THEN DISCH_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN REPEAT GEN_TAC THEN REWRITE_TAC[midpoint; VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN ASM_CASES_TAC `a:real^N = --(basis 1)` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN REPLICATE_TAC 7 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `segment[--basis 1:real^N,basis 1] SUBSET u` ASSUME_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(vec 0:real^N) IN u` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?c:real^N k. 1 <= k /\ ~(k = 1) /\ k <= dimindex(:N) /\ c IN u /\ ~(c$k = &0)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM NOT_FORALL_THM; TAUT `a /\ ~b /\ c /\ d /\ ~e <=> ~(d ==> a /\ c ==> ~b ==> e)`] THEN DISCH_TAC THEN UNDISCH_TAC `~collinear(u:real^N->bool)` THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `basis 1:real^N`] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN REWRITE_TAC[SPAN_SING; SUBSET; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(c:real^N)$1` THEN SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(c:real^N = vec 0)` ASSUME_TAC THENL [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `segment[vec 0:real^N,c] SUBSET u` ASSUME_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?z:real^N. z IN segment[vec 0,c] /\ (segment[--basis 1,z] UNION segment[z,basis 1]) INTER s = {}` STRIP_ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `linepath(--basis 1:real^N,z) ++ linepath(z,basis 1)` THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(t UNION v) INTER s = {} ==> t SUBSET u /\ v SUBSET u ==> (t UNION v) SUBSET u DIFF s`)) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]] THEN MATCH_MP_TAC(SET_RULE `~(s SUBSET {z | z IN s /\ ~P z}) ==> ?z. z IN s /\ P z`) THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN REWRITE_TAC[CARD_NOT_LE; SET_RULE `~((b UNION c) INTER s = {}) <=> ~(b INTER s = {}) \/ ~(c INTER s = {})`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ (Q x \/ R x)} = {x | P x /\ Q x} UNION {x | P x /\ R x}`] THEN W(MP_TAC o PART_MATCH lhand UNION_LE_ADD_C o lhand o snd) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CARD_LET_TRANS) THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN REWRITE_TAC[real_INFINITE]; MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_SEGMENT]] THEN REWRITE_TAC[MESON[SEGMENT_SYM] `segment[--a:real^N,b] = segment[b,--a]`] THEN SUBGOAL_THEN `!b:real^N. b IN u /\ ~(b IN s) /\ ~(b = vec 0) /\ b$k = &0 ==> {z | z IN segment[vec 0,c] /\ ~(segment[z,b] INTER s = {})} <_c (:real)` (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_NEG_COMPONENT] THEN ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; BASIS_COMPONENT] THEN REWRITE_TAC[REAL_NEG_0]) THEN REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN MATCH_MP_TAC CARD_LE_RELATIONAL THEN MAP_EVERY X_GEN_TAC [`w:real^N`; `x1:real^N`; `x2:real^N`] THEN REWRITE_TAC[SEGMENT_SYM] THEN STRIP_TAC THEN ASM_CASES_TAC `x2:real^N = x1` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`x1:real^N`; `b:real^N`; `x2:real^N`] INTER_SEGMENT) THEN REWRITE_TAC[NOT_IMP; SEGMENT_SYM] THEN CONJ_TAC THENL [DISJ2_TAC; REWRITE_TAC[SEGMENT_SYM] THEN ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[SET_RULE `{x1,b,x2} = {x1,x2,b}`] THEN ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN SUBGOAL_THEN `(b:real^N) IN affine hull {vec 0,c}` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b IN s ==> s SUBSET t ==> b IN t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `segment[c:real^N,vec 0]` THEN CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL]; REWRITE_TAC[AFFINE_HULL_2_ALT; IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_SUB_RZERO; NOT_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$k`) THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ENTIRE]]);; let CONNECTED_CONVEX_DIFF_CARD_LT = prove (`!u s. convex u /\ ~collinear u /\ s <_c (:real) ==> connected(u DIFF s)`, SIMP_TAC[PATH_CONNECTED_CONVEX_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);; let PATH_CONNECTED_CONVEX_DIFF_COUNTABLE = prove (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> path_connected(u DIFF s)`, MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; PATH_CONNECTED_CONVEX_DIFF_CARD_LT]);; let CONNECTED_CONVEX_DIFF_COUNTABLE = prove (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> connected(u DIFF s)`, MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; CONNECTED_CONVEX_DIFF_CARD_LT]);; let PATH_CONNECTED_PUNCTURED_CONVEX = prove (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> path_connected(s DELETE a)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `~(x:int = &1) ==> --(&1) <= x ==> x = -- &1 \/ x = &0 \/ &2 <= x`)) THEN ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{} DELETE a = {}`] THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` SUBST1_TAC) THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{a} DELETE a = {}`] THEN ASM_SIMP_TAC[SET_RULE `~(b = a) ==> {a} DELETE b = {a}`] THEN REWRITE_TAC[PATH_CONNECTED_SING]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN ASM_REWRITE_TAC[COUNTABLE_SING; COLLINEAR_AFF_DIM] THEN ASM_INT_ARITH_TAC]);; let CONNECTED_PUNCTURED_CONVEX = prove (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> connected(s DELETE a)`, SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; PATH_CONNECTED_IMP_CONNECTED]);; let PATH_CONNECTED_COMPLEMENT_CARD_LT = prove (`!s. 2 <= dimindex(:N) /\ s <_c (:real) ==> path_connected((:real^N) DIFF s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN ASM_REWRITE_TAC[CONVEX_UNIV; COLLINEAR_AFF_DIM; AFF_DIM_UNIV] THEN REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC);; let PATH_CONNECTED_CONNECTED_DIFF = prove (`!s t:real^N->bool. connected s /\ s SUBSET closure(s DIFF t) /\ (!x. x IN s ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\ path_connected(u DIFF t)) ==> path_connected(s DIFF t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IN_DIFF] THEN REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN ASM_REWRITE_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS] THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`; `u:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[CLOSURE_NONEMPTY_OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN ONCE_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[IN_DIFF] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN MATCH_MP_TAC(SET_RULE `P SUBSET Q ==> P x ==> Q x`) THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC PATH_COMPONENT_MONO THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]]);; let PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT = prove (`!s t:real^N->bool. connected s /\ open_in (subtopology euclidean (affine hull s)) s /\ ~collinear s /\ t <_c (:real) ==> path_connected(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONNECTED_DIFF THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[OPEN_IN_CONTAINS_BALL]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~((ball(x:real^N,min d e) INTER affine hull s) DIFF t = {})` MP_TAC THENL [REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN MATCH_MP_TAC CARD_EQ_CONVEX THEN ASM_SIMP_TAC[CONVEX_BALL; CONVEX_INTER; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_MIN; IN_INTER; HULL_INC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] CONNECTED_IMP_PERFECT) THEN ANTS_TAC THENL [ASM_MESON_TAC[COLLINEAR_SING]; ALL_TAC] THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPEC `min d e:real`) THEN ASM_REWRITE_TAC[REAL_LT_MIN; IN_BALL] THEN ASM_MESON_TAC[HULL_INC; DIST_SYM]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; BALL_MIN_INTER; IN_DIFF; IN_BALL; REAL_LT_MIN] THEN MESON_TAC[DIST_SYM]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[OPEN_IN_CONTAINS_BALL]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `ball(x:real^N,r)` THEN REWRITE_TAC[OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER t SUBSET s ==> s SUBSET t ==> b INTER t = s INTER b`)) THEN REWRITE_TAC[HULL_SUBSET]; MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_BALL; COLLINEAR_AFF_DIM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_AFF_DIM]) THEN MATCH_MP_TAC(INT_ARITH `x:int = y ==> ~(y <= &1) ==> ~(x <= &1)`) THEN GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN ASM_MESON_TAC[HULL_INC; CENTRE_IN_BALL]]]);; let CONNECTED_OPEN_IN_DIFF_CARD_LT = prove (`!s t:real^N->bool. connected s /\ open_in (subtopology euclidean (affine hull s)) s /\ ~collinear s /\ t <_c (:real) ==> connected(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN ASM_REWRITE_TAC[]);; let PATH_CONNECTED_OPEN_DIFF_CARD_LT = prove (`!s t:real^N->bool. 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real) ==> path_connected(s DIFF t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_DIFF; PATH_CONNECTED_EMPTY] THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN ASM_REWRITE_TAC[COLLINEAR_AFF_DIM] THEN ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFF_DIM_OPEN] THEN ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN ASM_ARITH_TAC);; let CONNECTED_OPEN_DIFF_CARD_LT = prove (`!s t:real^N->bool. 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real) ==> connected(s DIFF t)`, SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);; let PATH_CONNECTED_OPEN_DIFF_COUNTABLE = prove (`!s t:real^N->bool. 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t ==> path_connected(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_CARD_LT THEN ASM_REWRITE_TAC[GSYM CARD_NOT_LE] THEN ASM_MESON_TAC[UNCOUNTABLE_REAL; CARD_LE_COUNTABLE]);; let CONNECTED_OPEN_DIFF_COUNTABLE = prove (`!s t:real^N->bool. 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t ==> connected(s DIFF t)`, SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_COUNTABLE; PATH_CONNECTED_IMP_CONNECTED]);; let PATH_CONNECTED_OPEN_DELETE = prove (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s ==> path_connected(s DELETE a)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN ASM_REWRITE_TAC[COUNTABLE_SING]);; let CONNECTED_OPEN_DELETE = prove (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s ==> connected(s DELETE a)`, SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; PATH_CONNECTED_IMP_CONNECTED]);; let PATH_CONNECTED_PUNCTURED_UNIVERSE = prove (`!a. 2 <= dimindex(:N) ==> path_connected((:real^N) DIFF {a})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; COUNTABLE_SING]);; let CONNECTED_PUNCTURED_UNIVERSE = prove (`!a. 2 <= dimindex(:N) ==> connected((:real^N) DIFF {a})`, SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; PATH_CONNECTED_IMP_CONNECTED]);; let PATH_CONNECTED_PUNCTURED_BALL = prove (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(ball(a,r) DELETE a)`, SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);; let CONNECTED_PUNCTURED_BALL = prove (`!a:real^N r. 2 <= dimindex(:N) ==> connected(ball(a,r) DELETE a)`, SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);; let PATH_CONNECTED_PUNCTURED_CBALL = prove (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(cball(a,r) DELETE a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < r` THENL [MATCH_MP_TAC PATH_CONNECTED_PUNCTURED_CONVEX THEN ASM_REWRITE_TAC[CONVEX_CBALL; AFF_DIM_CBALL; INT_OF_NUM_EQ] THEN ASM_ARITH_TAC; MATCH_MP_TAC(MESON[PATH_CONNECTED_EMPTY] `s = {} ==> path_connected s`) THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(&0 < r) ==> r = &0 \/ r < &0`)) THEN ASM_SIMP_TAC[CBALL_EMPTY; CBALL_SING] THEN ASM SET_TAC[]]);; let CONNECTED_PUNCTURED_CBALL = prove (`!a:real^N r. 2 <= dimindex(:N) ==> connected(cball(a,r) DELETE a)`, SIMP_TAC[PATH_CONNECTED_PUNCTURED_CBALL; PATH_CONNECTED_IMP_CONNECTED]);; let PATH_CONNECTED_SPHERE = prove (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(sphere(a,r))`, REPEAT GEN_TAC THEN REWRITE_TAC[sphere; dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN GEOM_ORIGIN_TAC `a:real^N` THEN GEN_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) THENL [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm(x:real^N) = r)`] THEN REWRITE_TAC[EMPTY_GSPEC; PATH_CONNECTED_EMPTY]; ASM_REWRITE_TAC[NORM_EQ_0; SING_GSPEC; PATH_CONNECTED_SING]; SUBGOAL_THEN `{x:real^N | norm x = r} = IMAGE (\x. r / norm x % x) ((:real^N) DIFF {vec 0})` SUBST1_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF; IN_SING; IN_UNIV] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; REAL_ARITH `&0 < r ==> abs r = r`] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN ASM_MESON_TAC[NORM_0; REAL_LT_IMP_NZ]; MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN REWRITE_TAC[o_DEF; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN DISCH_TAC THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]]);; let CONNECTED_SPHERE = prove (`!a:real^N r. 2 <= dimindex(:N) ==> connected(sphere(a,r))`, SIMP_TAC[PATH_CONNECTED_SPHERE; PATH_CONNECTED_IMP_CONNECTED]);; let CONNECTED_SPHERE_EQ = prove (`!a:real^N r. connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`, let lemma = prove (`!a:real^1 r. &0 < r ==> ?x y. ~(x = y) /\ dist(a,x) = r /\ dist(a,y) = r`, MP_TAC SPHERE_1 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_SPHERE; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `~(a = b) ==> ?x y. ~(x = y) /\ (x = a \/ x = b) /\ (y = a \/ y = b)`) THEN REWRITE_TAC[VECTOR_ARITH `a - r:real^1 = a + r <=> r = vec 0`] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC) in REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; CONNECTED_EMPTY; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONNECTED_SING] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN EQ_TAC THEN SIMP_TAC[CONNECTED_SPHERE] THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_FINITE_IFF_SING) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN DISCH_TAC THEN FIRST_ASSUM (fun th -> REWRITE_TAC[GEOM_EQUAL_DIMENSION_RULE th FINITE_SPHERE_1]) THEN REWRITE_TAC[SET_RULE `~(s = {} \/ ?a. s = {a}) <=> ?x y. ~(x = y) /\ x IN s /\ y IN s`] THEN REWRITE_TAC[IN_SPHERE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE lemma) THEN ASM_REWRITE_TAC[]);; let PATH_CONNECTED_SPHERE_EQ = prove (`!a:real^N r. path_connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[GSYM CONNECTED_SPHERE_EQ; PATH_CONNECTED_IMP_CONNECTED]; STRIP_TAC THEN ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]] THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; PATH_CONNECTED_EMPTY] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; PATH_CONNECTED_SING] THEN ASM_REAL_ARITH_TAC);; let FINITE_SPHERE = prove (`!a:real^N r. FINITE(sphere(a,r)) <=> r <= &0 \/ dimindex(:N) = 1`, REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_1]) THEN FIRST_ASSUM(MATCH_ACCEPT_TAC o C PROVE_HYP (GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`) FINITE_SPHERE_1)); ASM_SIMP_TAC[CONNECTED_SPHERE; ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`; DIMINDEX_GE_1; CONNECTED_FINITE_IFF_SING] THEN REWRITE_TAC[SET_RULE `(s = {} \/ ?a. s = {a}) <=> (!a b. a IN s /\ b IN s ==> a = b)`] THEN SIMP_TAC[IN_SPHERE] THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] VECTOR_CHOOSE_DIST) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `a - (x - a):real^N`]) THEN FIRST_X_ASSUM(K ALL_TAC o check (is_neg o concl)) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH]);; let LIMIT_POINT_OF_SPHERE = prove (`!a r x:real^N. x limit_point_of sphere(a,r) <=> &0 < r /\ 2 <= dimindex(:N) /\ x IN sphere(a,r)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL [ASM_SIMP_TAC[LIMIT_POINT_FINITE]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o REWRITE_RULE[FINITE_SPHERE]) THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE; ARITH; REAL_NOT_LT] THEN ASM_SIMP_TAC[GSYM REAL_NOT_LE; DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN EQ_TAC THEN REWRITE_TAC[REWRITE_RULE[CLOSED_LIMPT] CLOSED_SPHERE] THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN ASM_SIMP_TAC[CONNECTED_SPHERE_EQ; DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN ASM_MESON_TAC[FINITE_SING]);; let CARD_EQ_SPHERE = prove (`!a:real^N r. 2 <= dimindex(:N) /\ &0 < r ==> sphere(a,r) =_c (:real)`, SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SPHERE] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN ASM_REWRITE_TAC[FINITE_SING; FINITE_SPHERE; REAL_NOT_LE; DE_MORGAN_THM] THEN ASM_ARITH_TAC);; let HAS_SIZE_SPHERE_2 = prove (`!a:real^N r. sphere(a,r) HAS_SIZE 2 <=> dimindex(:N) = 1 /\ &0 < r`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[HAS_SIZE; SPHERE_EMPTY; CARD_CLAUSES] THENL [CONV_TAC NUM_REDUCE_CONV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[REAL_LT_REFL] THEN CONV_TAC NUM_REDUCE_CONV THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `r <= &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[FINITE_SPHERE] THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `sphere(a:real^N,r) = {a - r % basis 1,a + r % basis 1}` SUBST1_TAC THENL [ASM_REWRITE_TAC[EXTENSION; IN_SPHERE; dist; vector_norm; dot] THEN REWRITE_TAC[SUM_1; GSYM REAL_POW_2; POW_2_SQRT_ABS] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; CART_EQ; FORALL_1] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; LE_REFL; DIMINDEX_GE_1] THEN ASM_REAL_ARITH_TAC; SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN SIMP_TAC[IN_SING; VECTOR_ARITH `a - r:real^N = a + r <=> r = vec 0`] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN CONV_TAC NUM_REDUCE_CONV]);; let FINITE_CIRCLE_INTERSECTION,CARD_CIRCLE_INTERSECTION_LE = (CONJ_PAIR o prove) (`(!a b:real^2 r s. FINITE(sphere(a,r) INTER sphere(b,s)) <=> ~(a = b /\ r = s /\ &0 < r /\ &0 < s)) /\ (!a b:real^2 r s. ~(a = b /\ r = s /\ &0 < r /\ &0 < s) ==> CARD(sphere(a,r) INTER sphere(b,s)) <= 2)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < r` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; MATCH_MP_TAC(MESON[FINITE_SUBSET; CARD_SUBSET; LE_TRANS] `!t. s SUBSET t /\ FINITE t /\ CARD t <= n ==> FINITE s /\ CARD s <= n`) THEN EXISTS_TAC `{a:real^2}` THEN REWRITE_TAC[FINITE_SING; CARD_SING; SUBSET; IN_SING; IN_INTER; ARITH] THEN REWRITE_TAC[IN_SPHERE] THEN POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH] THEN ASM_CASES_TAC `&0 < s` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; MATCH_MP_TAC(MESON[FINITE_SUBSET; CARD_SUBSET; LE_TRANS] `!t. s SUBSET t /\ FINITE t /\ CARD t <= n ==> FINITE s /\ CARD s <= n`) THEN EXISTS_TAC `{b:real^2}` THEN REWRITE_TAC[FINITE_SING; CARD_SING; SUBSET; IN_SING; IN_INTER; ARITH] THEN REWRITE_TAC[IN_SPHERE] THEN POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH] THEN ASM_CASES_TAC `a:real^2 = b /\ r:real = s` THEN ASM_REWRITE_TAC[INTER_IDEMPOT; FINITE_SPHERE] THEN ASM_REWRITE_TAC[DIMINDEX_2; ARITH_EQ; REAL_NOT_LE] THEN REWRITE_TAC[ARITH_RULE `n <= 2 <=> ~(3 <= n)`] THEN MP_TAC(ISPECL [`3`; `sphere(a:real^2,r) INTER sphere(b,s)`] CHOOSE_SUBSET_STRONG) THEN MATCH_MP_TAC(TAUT `~r ==> ((p ==> q) ==> r) ==> p /\ ~q`) THEN CONV_TAC (ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN MP_TAC)) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (TAUT `~(p /\ q) ==> p ==> ~q`)) THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH `&0 < r ==> r = abs r`))) THEN REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTER; IN_SPHERE] THEN ONCE_REWRITE_TAC[GSYM DIST_EQ_0] THEN REWRITE_TAC[dist; NORM_EQ_SQUARE; REAL_POS] THEN REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);; let INTER_SPHERE_EQ_EMPTY = prove (`!a b:real^N r s. sphere(a,r) INTER sphere(b,s) = {} <=> if dimindex(:N) = 1 then r < &0 \/ s < &0 \/ ~(dist(a,b) = abs(r - s)) /\ ~(dist(a,b) = r + s) else r < &0 \/ s < &0 \/ dist(a,b) < abs(r - s) \/ r + s < dist(a,b)`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE; NOT_IN_EMPTY] THEN REWRITE_TAC[dist; NORM_EQ_SQUARE] THEN ASM_CASES_TAC `&0 <= r` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `&0 <= s` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[dot; SUM_1; VECTOR_SUB_COMPONENT] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_EQ_SQUARE_ABS] THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_ABS_POS; REAL_ABS_ABS] THEN REWRITE_TAC[REAL_ARITH `abs(x - y) = abs r <=> y = x - r \/ y = x + r`] THEN EQ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `(lambda i. (a:real^N)$1 + r):real^N` th) THEN MP_TAC(SPEC `(lambda i. (a:real^N)$1 - r):real^N` th)) THEN ASM_SIMP_TAC[LAMBDA_BETA; ARITH] THEN REAL_ARITH_TAC; EQ_TAC THENL [ALL_TAC; REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE; NOT_IN_EMPTY] THEN CONV_TAC NORM_ARITH] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN ASM_CASES_TAC `sphere(a:real^N,r) SUBSET cball(b,s)` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM SPHERE_UNION_BALL]) THEN ASM_SIMP_TAC[SET_RULE `a INTER b = {} ==> (a SUBSET b UNION c <=> a SUBSET c)`] THEN SIMP_TAC[SPHERE_SUBSET_CONVEX; CONVEX_BALL; SUBSET_BALLS] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`sphere(a:real^N,r)`; `cball(b:real^N,s)`] CONNECTED_INTER_FRONTIER) THEN ASM_SIMP_TAC[CONNECTED_SPHERE; FRONTIER_CBALL; DE_MORGAN_THM] THEN DISCH_THEN DISJ_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC(ISPECL [`cball(b:real^N,s)`; `cball(a:real^N,r)`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_CBALL; FRONTIER_CBALL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[DE_MORGAN_THM]] THEN REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [REWRITE_TAC[INTER_BALLS_EQ_EMPTY; DIST_SYM] THEN REAL_ARITH_TAC; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SPHERE_UNION_BALL] THEN ASM_SIMP_TAC[SET_RULE `a INTER b = {} ==> (b SUBSET a UNION c <=> b SUBSET c)`] THEN REWRITE_TAC[SUBSET_BALLS; DIST_SYM] THEN REAL_ARITH_TAC]]);; let HAS_SIZE_INTER_SPHERE_1 = prove (`!a b:real^N r s. (sphere(a,r) INTER sphere(b,s)) HAS_SIZE 1 <=> &0 <= r /\ &0 <= s /\ (a = b ==> r = &0 /\ s = &0) /\ (dist(a,b) = r + s \/ dist(a,b) = abs(r - s))`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN SIMP_TAC[REAL_ARITH `&0 <= b ==> (abs b * &1 = x <=> x = b)`] THEN X_GEN_TAC `b:real` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `b = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_CASES_TAC `r:real = s` THEN ASM_REWRITE_TAC[INTER_IDEMPOT; HAS_SIZE_SPHERE_1] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN EQ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN MATCH_MP_TAC(SET_RULE `s = {} ==> (?a. s = {a}) ==> P`) THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE_0; NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[CONV_RULE (LAND_CONV SYM_CONV) (SPEC_ALL VECTOR_MUL_EQ_0)] THEN ASM_SIMP_TAC[BASIS_EQ_0; IN_NUMSEG; LE_1; DIMINDEX_GE_1; LE_REFL]] THEN ASM_CASES_TAC `sphere(vec 0:real^N,r) INTER sphere (b % basis 1,s) = {}` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[HAS_SIZE; CARD_CLAUSES; ARITH_EQ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTER_SPHERE_EQ_EMPTY]) THEN SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= b ==> (abs b * &1 = x <=> x = b)`] THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN REWRITE_TAC[IN_INTER; IN_SPHERE; DIST_0; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `!r. (p ==> r) /\ (r ==> q) /\ (q ==> p) ==> (p <=> q)`) THEN EXISTS_TAC `x:real^N = x$1 % basis 1` THEN REPEAT CONJ_TAC THENL [DISCH_TAC THEN REWRITE_TAC[CART_EQ] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN FIRST_X_ASSUM(MP_TAC o CONV_RULE HAS_SIZE_CONV) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `(?a. s = {a}) ==> !x y. x IN s /\ y IN s ==> x = y`)) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `(lambda i. if i = k then --((x:real^N)$k) else x$i):real^N`]) THEN ANTS_TAC THENL [REWRITE_TAC[IN_INTER; IN_SPHERE] THEN MATCH_MP_TAC(MESON[] `(x = r /\ y = s) /\ (x' = x /\ y' = y) ==> (x = r /\ y = s) /\ (x' = r /\ y' = s)`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[DIST_0]; ALL_TAC] THEN REWRITE_TAC[dist] THEN CONJ_TAC THEN MATCH_MP_TAC NORM_EQ_COMPONENTWISE THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VEC_COMPONENT; LAMBDA_BETA] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC; SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL; dist; GSYM VECTOR_SUB_RDISTRIB] THEN REAL_ARITH_TAC; DISCH_TAC THEN CONV_TAC HAS_SIZE_CONV THEN EXISTS_TAC `x:real^N` THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE; DIST_0; IN_SING] THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `x:real^N = x$1 % basis 1 /\ y:real^N = y$1 % basis 1` (CONJUNCTS_THEN SUBST_ALL_TAC) THENL [ALL_TAC; AP_THM_TAC THEN AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[dist; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC] THEN CONJ_TAC THEN MP_TAC(ISPEC `b % basis 1:real^N` COLLINEAR_LEMMA_ALT) THENL [DISCH_THEN(MP_TAC o SPEC `x:real^N`); DISCH_THEN(MP_TAC o SPEC `y:real^N`)] THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; VECTOR_MUL_COMPONENT; VECTOR_MUL_ASSOC] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN REWRITE_TAC[COLLINEAR_BETWEEN_CASES; between] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN REWRITE_TAC[DIST_SYM; DIST_0; NORM_MUL] THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; real_abs] THEN REAL_ARITH_TAC]);; let PATH_CONNECTED_ANNULUS = prove (`(!a:real^N r1 r2. 2 <= dimindex(:N) ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\ (!a:real^N r1 r2. 2 <= dimindex(:N) ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\ (!a:real^N r1 r2. 2 <= dimindex(:N) ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\ (!a:real^N r1 r2. 2 <= dimindex(:N) ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`, let lemma = prove (`!a:real^N P. 2 <= dimindex(:N) /\ path_connected {lift r | &0 <= r /\ P r} ==> path_connected {x | P(norm(x - a))}`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x:real^N | P(norm(x))} = IMAGE (\z. drop(fstcart z) % sndcart z) {pastecart x y | x IN {lift x | &0 <= x /\ P x} /\ y IN {y | norm y = &1}}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IMAGE_ID] THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; REAL_MUL_RID] THEN ASM_REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `z:real^N = vec 0` THENL [MAP_EVERY EXISTS_TAC [`&0`; `basis 1:real^N`] THEN ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_LZERO] THEN ASM_MESON_TAC[NORM_0; REAL_ABS_NUM; REAL_LE_REFL]; MAP_EVERY EXISTS_TAC [`norm(z:real^N)`; `inv(norm z) % z:real^N`] THEN ASM_SIMP_TAC[REAL_ABS_NORM; NORM_MUL; VECTOR_MUL_ASSOC; VECTOR_MUL_LID; NORM_POS_LE; REAL_ABS_INV; REAL_MUL_RINV; REAL_MUL_LINV; NORM_EQ_0]]; MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; REWRITE_TAC[GSYM PCROSS] THEN MATCH_MP_TAC PATH_CONNECTED_PCROSS THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_ARITH `norm y = norm(y - vec 0:real^N)`] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[REWRITE_RULE[dist] (GSYM sphere)] THEN ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPEC `a:real^N` lemma) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN MATCH_MP_TAC IS_INTERVAL_CONVEX THEN REWRITE_TAC[is_interval] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IN_IMAGE_LIFT_DROP; FORALL_1; DIMINDEX_1] THEN REWRITE_TAC[IN_ELIM_THM; GSYM drop] THEN REAL_ARITH_TAC);; let CONNECTED_ANNULUS = prove (`(!a:real^N r1 r2. 2 <= dimindex(:N) ==> connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\ (!a:real^N r1 r2. 2 <= dimindex(:N) ==> connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\ (!a:real^N r1 r2. 2 <= dimindex(:N) ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\ (!a:real^N r1 r2. 2 <= dimindex(:N) ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN ASM_SIMP_TAC[PATH_CONNECTED_ANNULUS]);; let PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s ==> path_connected((:real^N) DIFF s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[DIFF_EMPTY; CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN SUBGOAL_THEN `~(x:real^N = a) /\ ~(y = a)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `bounded((x:real^N) INSERT y INSERT s)` MP_TAC THENL [ASM_REWRITE_TAC[BOUNDED_INSERT]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN REWRITE_TAC[INSERT_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN ABBREV_TAC `C = (B / norm(x - a:real^N))` THEN EXISTS_TAC `a + C % (x - a):real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + u % (a + B % (x - a)):real^N = a + (&1 + (B - &1) * u) % (x - a)`] THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a + (&1 + (C - &1) * u) % (x - a):real^N`; `&1 / (&1 + (C - &1) * u)`]) THEN SUBGOAL_THEN `&1 <= &1 + (C - &1) * u` ASSUME_TAC THENL [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN EXPAND_TAC "C" THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(x - a) = norm(a - x)`]; FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN ASM_REWRITE_TAC[NOT_IMP] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN UNDISCH_TAC `~((x:real^N) IN s)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC PATH_COMPONENT_SYM THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN ABBREV_TAC `D = (B / norm(y - a:real^N))` THEN EXISTS_TAC `a + D % (y - a):real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % y + u % (a + B % (y - a)):real^N = a + (&1 + (B - &1) * u) % (y - a)`] THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a + (&1 + (D - &1) * u) % (y - a):real^N`; `&1 / (&1 + (D - &1) * u)`]) THEN SUBGOAL_THEN `&1 <= &1 + (D - &1) * u` ASSUME_TAC THENL [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN EXPAND_TAC "D" THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(y - a) = norm(a - y)`]; FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN ASM_REWRITE_TAC[NOT_IMP] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN UNDISCH_TAC `~((y:real^N) IN s)` THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN EXISTS_TAC `{x:real^N | norm(x - a) = B}` THEN CONJ_TAC THENL [UNDISCH_TAC `s SUBSET ball(a:real^N,B)` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_BALL; dist] THEN MESON_TAC[NORM_SUB; REAL_LT_REFL]; MP_TAC(ISPECL [`a:real^N`; `B:real`] PATH_CONNECTED_SPHERE) THEN REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] THEN ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM; VECTOR_ADD_SUB; NORM_MUL] THEN MAP_EVERY EXPAND_TAC ["C"; "D"] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s ==> connected((:real^N) DIFF s)`, SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX]);; let CONNECTED_DIFF_BALL = prove (`!s a:real^N r. 2 <= dimindex(:N) /\ connected s /\ cball(a,r) SUBSET s ==> connected(s DIFF ball(a,r))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_DIFF_OPEN_FROM_CLOSED THEN EXISTS_TAC `cball(a:real^N,r)` THEN ASM_REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BALL_SUBSET_CBALL] THEN REWRITE_TAC[CBALL_DIFF_BALL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_SIMP_TAC[CONNECTED_SPHERE]);; let PATH_CONNECTED_DIFF_BALL = prove (`!s a:real^N r. 2 <= dimindex(:N) /\ path_connected s /\ cball(a,r) SUBSET s ==> path_connected(s DIFF ball(a,r))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN ASM_SIMP_TAC[DIFF_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[BALL_EQ_EMPTY; REAL_NOT_LE]) THEN REWRITE_TAC[path_connected] THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`x:real^N`; `a:real^N`] th) THEN MP_TAC(SPECL [`y:real^N`; `a:real^N`] th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`g2:real^1->real^N`; `(:real^N) DIFF ball(a,r)`] EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN MP_TAC(ISPECL [`g1:real^1->real^N`; `(:real^N) DIFF ball(a,r)`] EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN ASM_SIMP_TAC[CENTRE_IN_BALL; IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN ASM_SIMP_TAC[FRONTIER_COMPLEMENT; INTERIOR_COMPLEMENT; CLOSURE_BALL] THEN ASM_SIMP_TAC[FRONTIER_BALL; IN_SPHERE] THEN X_GEN_TAC `h1:real^1->real^N` THEN STRIP_TAC THEN X_GEN_TAC `h2:real^1->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] PATH_CONNECTED_SPHERE) THEN ASM_REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL [`pathfinish h1:real^N`; `pathfinish h2:real^N`]) THEN ASM_SIMP_TAC[IN_SPHERE] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `h1 ++ h ++ reversepath h2:real^1->real^N` THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH; PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN UNDISCH_TAC `cball(a:real^N,r) SUBSET s` THEN SIMP_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_BALL; IN_DIFF] THEN MESON_TAC[REAL_LE_REFL; REAL_LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s DELETE a SUBSET (UNIV DIFF t) ==> ~(a IN u) /\ u SUBSET t ==> s INTER u = {}`)) THEN ASM_REWRITE_TAC[BALL_SUBSET_CBALL; IN_BALL; REAL_LT_REFL]);; let CONNECTED_DELETE_INTERIOR_POINT = prove (`!s a:real^N. 2 <= dimindex(:N) /\ connected s /\ a IN interior s ==> connected(s DELETE a)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s DELETE a = (s DIFF ball(a:real^N,r)) UNION (cball(a,r) DELETE a)` SUBST1_TAC THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_BALL) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[CONNECTED_DIFF_BALL; CONNECTED_PUNCTURED_CBALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c SUBSET s ==> ~(c DIFF b = {}) /\ a IN b ==> ~((s DIFF b) INTER (c DELETE a) = {})`)) THEN ASM_REWRITE_TAC[CBALL_DIFF_BALL; CENTRE_IN_BALL; SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC]);; let CONNECTED_DELETE_INTERIOR_POINT_EQ = prove (`!s a:real^N. 2 <= dimindex(:N) /\ a IN interior s ==> (connected (s DELETE a) <=> connected s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[CONNECTED_DELETE_INTERIOR_POINT] THEN FIRST_ASSUM (ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_INSERT_LIMPT] THEN ASM_SIMP_TAC[LIMPT_DELETE; INTERIOR_LIMIT_POINT]);; let CONNECTED_OPEN_DELETE_EQ = prove (`!s a:real^N. 2 <= dimindex(:N) /\ open s ==> (connected(s DELETE a) <=> connected s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s DELETE (a:real^N) = s \/ a IN s` STRIP_ASSUME_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_DELETE_INTERIOR_POINT_EQ THEN ASM_SIMP_TAC[INTERIOR_OPEN]);; let PATH_CONNECTED_DELETE_INTERIOR_POINT = prove (`!s a:real^N. 2 <= dimindex(:N) /\ path_connected s /\ a IN interior s ==> path_connected(s DELETE a)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s DELETE a = (s DIFF ball(a:real^N,r)) UNION (cball(a,r) DELETE a)` SUBST1_TAC THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_BALL) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MATCH_MP_TAC PATH_CONNECTED_UNION THEN ASM_SIMP_TAC[PATH_CONNECTED_DIFF_BALL; PATH_CONNECTED_PUNCTURED_CBALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c SUBSET s ==> ~(c DIFF b = {}) /\ a IN b ==> ~((s DIFF b) INTER (c DELETE a) = {})`)) THEN ASM_REWRITE_TAC[CBALL_DIFF_BALL; CENTRE_IN_BALL; SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC]);; let CONNECTED_OPEN_DIFF_CBALL = prove (`!s a:real^N r. 2 <= dimindex (:N) /\ open s /\ connected s /\ cball(a,r) SUBSET s ==> connected(s DIFF cball(a,r))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[CBALL_EQ_EMPTY; REAL_NOT_LT]) THEN SUBGOAL_THEN `?r'. r < r' /\ cball(a:real^N,r') SUBSET s` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `s = (:real^N)` THENL [EXISTS_TAC `r + &1` THEN ASM_SIMP_TAC[SUBSET_UNIV] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`] SETDIST_POS_LE) THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED; COMPACT_CBALL; CBALL_EQ_EMPTY] THEN ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN ASM_SIMP_TAC[SET_RULE `b INTER (UNIV DIFF s) = {} <=> b SUBSET s`; REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN STRIP_TAC THEN EXISTS_TAC `r + setdist(cball(a,r),(:real^N) DIFF s) / &2` THEN ASM_REWRITE_TAC[REAL_LT_ADDR; REAL_HALF; SUBSET; IN_CBALL] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THENL [ASM_MESON_TAC[SUBSET; DIST_REFL; IN_CBALL]; ALL_TAC] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`; `a + r / dist(a,x) % (x - a):real^N`; `x:real^N`] SETDIST_LE_DIST) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; ONCE_REWRITE_RULE[DIST_SYM] dist; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REWRITE_TAC[REAL_ARITH `abs r <= r <=> &0 <= r`] THEN REWRITE_TAC[NORM_MUL; VECTOR_ARITH `x - (a + d % (x - a)):real^N = (&1 - d) % (x - a)`] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM; REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REAL_ARITH_TAC; SUBGOAL_THEN `s DIFF cball(a:real^N,r) = s DIFF ball(a,r') UNION {x | r < norm(x - a) /\ norm(x - a) <= r'}` SUBST1_TAC THENL [REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE `b' SUBSET c' /\ c' SUBSET s /\ c SUBSET b' ==> s DIFF c = (s DIFF b') UNION {x | ~(x IN c) /\ x IN c'}`) THEN ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[CONNECTED_ANNULUS; PATH_CONNECTED_DIFF_BALL; PATH_CONNECTED_IMP_CONNECTED; CONNECTED_OPEN_PATH_CONNECTED] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE `c' SUBSET s /\ (?x. x IN c' /\ ~(x IN b') /\ ~(x IN c)) ==> ~((s DIFF b') INTER {x | ~(x IN c) /\ x IN c'} = {})`) THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `a + r' % basis 1:real^N` THEN REWRITE_TAC[IN_BALL; IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC]]);; let PATH_CONNECTED_CONVEX_DIFF_LOWDIM = prove (`!s t:real^N->bool. convex s /\ aff_dim t + &2 <= aff_dim s ==> path_connected(s DIFF t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_COMPONENT_SET] THEN ASM_CASES_TAC `segment[x:real^N,y] INTER t = {}` THENL [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN ASM_SIMP_TAC[CONVEX_CONTAINS_SEGMENT_IMP; SET_RULE `s SUBSET t DIFF u <=> s INTER u = {} /\ s SUBSET t`]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(fun th -> REPEAT(POP_ASSUM MP_TAC) THEN X_CHOOSE_THEN `a:real^N` MP_TAC th) THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `?z:real^N. z IN s /\ ~(z IN span(x INSERT y INSERT span t))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `~(t SUBSET s) ==> ?x. x IN t /\ ~(x IN s)`) THEN DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN UNDISCH_TAC `aff_dim(t:real^N->bool) + &2 <= aff_dim(s:real^N->bool)` THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN MATCH_MP_TAC(ARITH_RULE `x <= SUC y ==> y + 2 <= s ==> ~(s <= x)`) THEN ONCE_REWRITE_TAC[DIM_INSERT] THEN SUBGOAL_THEN `(x:real^N) IN span(y INSERT span t)` (fun th -> REWRITE_TAC[th; DIM_INSERT; DIM_SPAN] THEN ARITH_TAC) THEN SUBGOAL_THEN `(vec 0:real^N) IN segment(x,y)` MP_TAC THENL [ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM SET_TAC[]; REWRITE_TAC[IN_SEGMENT]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` (STRIP_ASSUME_TAC o GSYM))) THEN FIRST_ASSUM(MP_TAC o AP_TERM `(%) (inv(&1 - u)):real^N->real^N`) THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; VECTOR_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_SUB_0; REAL_LT_IMP_NE] THEN REWRITE_TAC[VECTOR_ARITH `&1 % x + a % y:real^N = vec 0 <=> x = --a % y`] THEN SIMP_TAC[SPAN_MUL; SPAN_SUPERSET; IN_INSERT]; ALL_TAC] THEN MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `z:real^N` THEN SUBGOAL_THEN `~((z:real^N) IN t)` ASSUME_TAC THENL [ASM_MESON_TAC[SPAN_SUPERSET; IN_INSERT]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC PATH_CONNECTED_LINEPATH THENL [ALL_TAC; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN ASM_SIMP_TAC[CONVEX_CONTAINS_SEGMENT_IMP; SET_RULE `s SUBSET t DIFF u <=> s INTER u = {} /\ s SUBSET t`] THEN ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; SET_RULE `(s UNION {a,b}) INTER t = {} <=> ~(a IN t) /\ ~(b IN t) /\ s INTER t = {}`] THEN REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN X_GEN_TAC `w:real^N` THEN REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv u):real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b + &1 % z <=> z = a - b`] THEN REPEAT DISCH_TAC THEN UNDISCH_TAC `~((z:real^N) IN span (x INSERT y INSERT span t))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT]);; let PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM = prove (`!s t:real^N->bool. connected s /\ open_in (subtopology euclidean (affine hull s)) s /\ aff_dim t + &2 <= aff_dim s ==> path_connected(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONNECTED_DIFF THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `closure s:real^N->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC(SET_RULE `t = s ==> s SUBSET t`) THEN MATCH_MP_TAC DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL THEN ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[OPEN_IN_CONTAINS_BALL]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `ball(x:real^N,r)` THEN REWRITE_TAC[OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER t SUBSET s ==> s SUBSET t ==> b INTER t = s INTER b`)) THEN REWRITE_TAC[HULL_SUBSET]; MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_LOWDIM THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `t:int <= s ==> s' = s ==> t <= s'`)) THEN GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN ASM_MESON_TAC[HULL_INC; CENTRE_IN_BALL]]]);; let PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM = prove (`!(s:real^N->bool) f. connected s /\ open_in (subtopology euclidean (affine hull s)) s /\ FINITE f /\ (!t. t IN f ==> closed t /\ aff_dim t + &2 <= aff_dim s) ==> path_connected(s DIFF UNIONS f)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[UNIONS_0; DIFF_EMPTY] THEN ASM_MESON_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC; OPEN_IN_IMP_LOCALLY_PATH_CONNECTED]; MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `g:(real^N->bool)->bool`] THEN REWRITE_TAC[FORALL_IN_INSERT; UNIONS_INSERT] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = (s DIFF u) DIFF t`] THEN ASM_CASES_TAC `s DIFF UNIONS g:real^N->bool = {}` THEN ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; EMPTY_DIFF] THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM THEN ASM_SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED] THEN SUBGOAL_THEN `open_in (subtopology euclidean (affine hull s)) (s DIFF UNIONS g:real^N->bool)` ASSUME_TAC THENL [SUBGOAL_THEN `s DIFF UNIONS g:real^N->bool = s DIFF (affine hull s INTER UNIONS g)` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u = s DIFF (t INTER u)`) THEN REWRITE_TAC[HULL_SUBSET]; MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER_CLOSED THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_UNIONS THEN ASM_SIMP_TAC[]]; CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `affine hull s:real^N->bool` THEN ASM_REWRITE_TAC[HULL_SUBSET] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `t:int <= s ==> u = s ==> t <= u`)) THEN GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC AFF_DIM_OPEN_IN THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL]]]]);; let CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM = prove (`!f s:real^N->bool. connected s /\ open_in (subtopology euclidean (affine hull s)) s /\ FINITE f /\ (!t. t IN f ==> aff_dim t + &2 <= aff_dim s) ==> connected(s DIFF UNIONS f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `s DIFF UNIONS {closure t:real^N->bool | t IN f}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE; AFF_DIM_CLOSURE] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE]; MATCH_MP_TAC(SET_RULE `u SUBSET t ==> s DIFF t SUBSET s DIFF u`) THEN MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN MESON_TAC[CLOSURE_SUBSET]; ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; SET_RULE `{f x |x| F} = {}`; NOT_IN_EMPTY; DIFF_EMPTY; CLOSURE_SUBSET] THEN REWRITE_TAC[DIFF_UNIONS] THEN REWRITE_TAC[SET_RULE `{f x | x IN {g y | P y}} = {f(g y) | P y}`] THEN MP_TAC(ISPECL [`s:real^N->bool`; `INTERS {s DIFF closure t:real^N->bool | t IN f}`; `affine hull s:real^N->bool`] CLOSURE_OPEN_IN_INTER_CLOSURE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [TRANS_TAC SUBSET_TRANS `s:real^N->bool` THEN REWRITE_TAC[HULL_SUBSET; INTERS_GSPEC] THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC(SET_RULE `u SUBSET closure u /\ s = u ==> s INTER t SUBSET closure u`) THEN REWRITE_TAC[CLOSURE_SUBSET; SET_RULE `s = s INTER t <=> s SUBSET t`] THEN MATCH_MP_TAC DENSE_OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE] THEN X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM closed; CLOSED_CLOSURE]; TRANS_TAC SUBSET_TRANS `closure s:real^N->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC(SET_RULE `t = s ==> s SUBSET t`) THEN MATCH_MP_TAC DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL THEN ASM_REWRITE_TAC[AFF_DIM_CLOSURE] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]]);; let BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED = prove (`!s. 2 <= dimindex(:N) /\ bounded(frontier s) ==> bounded(s) \/ bounded((:real^N) DIFF s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `f SUBSET s <=> (UNIV DIFF s) INTER f = {}`] THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN ASM_SIMP_TAC[CONNECTED_COMPLEMENT_BOUNDED_CONVEX; BOUNDED_BALL; CONVEX_BALL; SET_RULE `UNIV DIFF s DIFF t = {} <=> UNIV DIFF t SUBSET s`; SET_RULE `(UNIV DIFF s) INTER t = {} <=> t SUBSET s`] THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]);; let BOUNDED_COMMON_FRONTIER_DOMAINS = prove (`!s t c:real^N->bool. 2 <= dimindex(:N) /\ bounded c /\ open s /\ connected s /\ open t /\ connected t /\ ~(s = t) /\ frontier s = c /\ frontier t = c ==> bounded s \/ bounded t`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED) THEN MP_TAC(ISPEC `s:real^N->bool` BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED) THEN ASM_REWRITE_TAC[] THEN REPEAT(STRIP_TAC THEN ASM_REWRITE_TAC[]) THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] COMMON_FRONTIER_DOMAINS) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(SET_RULE `~((UNIV DIFF s) UNION (UNIV DIFF t) = UNIV) ==> ~DISJOINT s t`) THEN MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV] `bounded s ==> ~(s = (:real^N))`) THEN ASM_REWRITE_TAC[BOUNDED_UNION]);; let INTERIOR_ARC_IMAGE = prove (`!g:real^1->real^N. 2 <= dimindex(:N) /\ arc g ==> interior(path_image g) = {}`, REPEAT STRIP_TAC THEN SIMP_TAC[path_image; CLOSED_OPEN_INTERVAL_1; DROP_VEC; REAL_POS] THEN REWRITE_TAC[IMAGE_UNION; IMAGE_CLAUSES] THEN SIMP_TAC[INTERIOR_UNION_EQ_EMPTY; CLOSED_INSERT; CLOSED_EMPTY] THEN SIMP_TAC[EMPTY_INTERIOR_FINITE; FINITE_INSERT; FINITE_EMPTY] THEN MATCH_MP_TAC(SET_RULE `(!a. ~(a IN s)) ==> s = {}`) THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] CONNECTED_DELETE_INTERIOR_POINT))) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; GSYM path; ARC_IMP_PATH]; FIRST_X_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN SPEC_TAC(`a:real^N`,`a:real^N`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^1` THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_ARC) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o ISPEC `interval(vec 0,vec 1) DELETE (t:real^1)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CONNECTEDNESS)) THEN MATCH_MP_TAC(TAUT `p /\ q /\ ~r ==> (p ==> (q <=> r)) ==> F`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`) THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `connected s ==> s = t ==> connected t`)) THEN RULE_ASSUM_TAC(REWRITE_RULE[arc]) THEN MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL [`midpoint(vec 0:real^1,t)`; `midpoint(vec 1:real^1,t)`; `t:real^1`]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[DROP_VEC; IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; midpoint; DROP_ADD; DROP_CMUL] THEN REAL_ARITH_TAC]]);; let INTERIOR_SIMPLE_PATH_IMAGE = prove (`!g:real^1->real^N. 2 <= dimindex(:N) /\ simple_path g ==> interior(path_image g) = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^N`; `lift(&1 / &2)`] PATH_IMAGE_SUBPATH_COMBINE) THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN W(MP_TAC o PART_MATCH (lhs o rand) INTERIOR_UNION_EQ_EMPTY o snd) THEN ANTS_TAC THENL [DISJ1_TAC THEN MATCH_MP_TAC CLOSED_PATH_IMAGE THEN MATCH_MP_TAC PATH_SUBPATH THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH]; DISCH_THEN SUBST1_TAC THEN CONJ_TAC THEN MATCH_MP_TAC INTERIOR_ARC_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; GSYM DROP_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let ENDPOINTS_NOT_IN_INTERIOR_SIMPLE_PATH_IMAGE = prove (`!g:real^1->real^N. simple_path g ==> DISJOINT {pathstart g,pathfinish g} (interior(path_image g))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL [ASM_SIMP_TAC[INTERIOR_SIMPLE_PATH_IMAGE] THEN SET_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(2 <= p) ==> 1 <= p ==> p = 1`))] THEN REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COLLINEAR_SIMPLE_PATH_IMAGE)) THEN ANTS_TAC THENL [REWRITE_TAC[COLLINEAR_AFF_DIM] THEN ASM_MESON_TAC[AFF_DIM_LE_UNIV]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; INTERIOR_SEGMENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ENDS_NOT_IN_SEGMENT; NOT_IN_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Existence of unbounded components. *) (* ------------------------------------------------------------------------- *) let COBOUNDED_UNBOUNDED_COMPONENT = prove (`!s. bounded((:real^N) DIFF s) ==> ?x. x IN s /\ ~bounded(connected_component s x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `B % basis 1:real^N` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `B % basis 1:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL_0] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> ~(abs B * &1 < B)`]; MP_TAC(ISPECL [`basis 1:real^N`; `B:real`] BOUNDED_HALFSPACE_GE) THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN SIMP_TAC[CONVEX_HALFSPACE_GE; CONVEX_CONNECTED] THEN ASM_SIMP_TAC[IN_ELIM_THM; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_GE_1; LE_REFL; real_ge; REAL_MUL_RID; REAL_LE_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `UNIV DIFF s SUBSET b ==> (!x. x IN h ==> ~(x IN b)) ==> h SUBSET s`)) THEN SIMP_TAC[IN_ELIM_THM; DOT_BASIS; IN_BALL_0; DIMINDEX_GE_1; LE_REFL] THEN GEN_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= n ==> b <= x ==> b <= n`) THEN SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_GE_1; LE_REFL]]);; let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT = prove (`!s x y:real^N. 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ ~bounded(connected_component s x) /\ ~bounded(connected_component s y) ==> connected_component s x = connected_component s y`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `ball(vec 0:real^N,B)` CONNECTED_COMPLEMENT_BOUNDED_CONVEX) THEN ASM_REWRITE_TAC[BOUNDED_BALL; CONVEX_BALL] THEN DISCH_TAC THEN MAP_EVERY (MP_TAC o SPEC `B:real` o REWRITE_RULE[bounded; NOT_EXISTS_THM] o ASSUME) [`~bounded(connected_component s (y:real^N))`; `~bounded(connected_component s (x:real^N))`] THEN REWRITE_TAC[NOT_FORALL_THM; IN; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `x':real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `y':real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN SUBGOAL_THEN `connected_component s (x':real^N) (y':real^N)` ASSUME_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `(:real^N) DIFF ball (vec 0,B)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN REWRITE_TAC[IN_BALL_0] THEN ASM_MESON_TAC[REAL_LT_IMP_LE]; ASM_MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]]);; let COBOUNDED_UNBOUNDED_COMPONENTS = prove (`!s. bounded ((:real^N) DIFF s) ==> ?c. c IN components s /\ ~bounded c`, REWRITE_TAC[components; EXISTS_IN_GSPEC; COBOUNDED_UNBOUNDED_COMPONENT]);; let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS = prove (`!s c c'. 2 <= dimindex(:N) /\ bounded ((:real^N) DIFF s) /\ c IN components s /\ ~bounded c /\ c' IN components s /\ ~bounded c' ==> c' = c`, REWRITE_TAC[components; IN_ELIM_THM] THEN MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT]);; let COBOUNDED_HAS_BOUNDED_COMPONENT = prove (`!s. 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ ~connected s ==> ?c. c IN components s /\ bounded c`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c c':real^N->bool. c IN components s /\ c' IN components s /\ ~(c = c')` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s = {}) /\ ~(?a. s = {a}) ==> ?x y. x IN s /\ y IN s /\ ~(x = y)`) THEN ASM_REWRITE_TAC[COMPONENTS_EQ_SING_EXISTS; COMPONENTS_EQ_EMPTY] THEN ASM_MESON_TAC[DIFF_EMPTY; NOT_BOUNDED_UNIV]; ASM_MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS]]);; (* ------------------------------------------------------------------------- *) (* Self-homeomorphisms shuffling points about in various ways. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHISM_MOVING_POINT_EXISTS = prove (`!s t a b:real^N. open_in (subtopology euclidean (affine hull s)) s /\ s SUBSET t /\ t SUBSET affine hull s /\ connected s /\ a IN s /\ b IN s ==> ?f g. homeomorphism (t,t) (f,g) /\ f a = b /\ {x | ~(f x = x /\ g x = x)} SUBSET s /\ bounded {x | ~(f x = x /\ g x = x)}`, let lemma1 = prove (`!a t r u:real^N. affine t /\ a IN t /\ u IN ball(a,r) INTER t ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t) (f,g) /\ f(a) = u /\ (!x. x IN sphere(a,r) ==> f(x) = x)`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN EXISTS_TAC `\x:real^N. (&1 - norm(x - a) / r) % (u - a) + x` THEN REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_CBALL; CLOSED_AFFINE]; ASM_SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist; REAL_DIV_REFL; REAL_LT_IMP_NZ; IN_INTER] THEN REWRITE_TAC[real_div; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ f x = y) ==> IMAGE f s = s`) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(&1 - n) % (u - a) + x:real^N = a + (&1 - n) % (u - a) + (x - a)`]; ALL_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_BALL_0; VECTOR_SUB_RZERO; IN_CBALL_0; IN_INTER] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`; VECTOR_ARITH `(&1 - n) % u + a + x = (&1 - m) % u + a + y <=> (n - m) % u:real^N = x - y`] THEN REWRITE_TAC[REAL_ARITH `x / r - y / r:real = (x - y) / r`] THENL [ALL_TAC; REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `norm(x:real^N) = norm(y:real^N)` THEN ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; VECTOR_MUL_LZERO; VECTOR_ARITH `vec 0:real^N = x - y <=> x = y`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:real^N->real`) THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `r = norm(x - y:real^N) ==> r < abs(norm x - norm y) * &1 ==> F`)) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < r ==> &0 < abs r`] THEN ASM_REAL_ARITH_TAC] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `subspace(t:real^N->bool)` THENL [ALL_TAC; ASM_MESON_TAC[AFFINE_IMP_SUBSPACE]] THEN ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC(NORM_ARITH `norm(x) + norm(y) <= &1 * r ==> norm(x + y:real^N) <= r`) THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_LDIV_EQ; REAL_ARITH `(a * u + x) / r:real = a * u / r + x / r`] THEN MATCH_MP_TAC(REAL_ARITH `x <= &1 /\ a <= abs(&1 - x) * &1 ==> a + x <= &1`) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`\a. lift((&1 - drop a) * r - norm(y - drop a % u:real^N))`; `vec 0:real^1`; `vec 1:real^1`; `&0`; `1`] IVT_DECREASING_COMPONENT_1) THEN REWRITE_TAC[DIMINDEX_1; GSYM drop; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[REAL_POS; LE_REFL; REAL_SUB_REFL; VECTOR_MUL_LZERO] THEN REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; REAL_MUL_LID] THEN REWRITE_TAC[NORM_ARITH `&0 * r - norm(x:real^N) <= &0`] THEN ASM_REWRITE_TAC[REAL_SUB_LE; GSYM EXISTS_DROP; IN_INTERVAL_1] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(&1 - x) * r - b:real = r - r * x - b`] THEN REWRITE_TAC[LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN REWRITE_TAC[CONTINUOUS_CONST]) THEN SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID; CONTINUOUS_CONST]; ASM_SIMP_TAC[DROP_VEC; REAL_FIELD `&0 < r ==> ((&1 - x) * r - n = &0 <=> &1 - n / r = x)`] THEN DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `y - a % u:real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]) in let lemma2 = prove (`!a t u v:real^N r. affine t /\ a IN t /\ u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t) (f,g) /\ f(u) = v /\ !x. x IN sphere(a,r) /\ x IN t ==> f(x) = x`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_TAC] THEN MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `r:real`] lemma1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> FIRST_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP th))) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `(f1:real^N->real^N) o (g2:real^N->real^N)` THEN EXISTS_TAC `(f2:real^N->real^N) o (g1:real^N->real^N)` THEN REWRITE_TAC[o_THM; SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_INTER]) THEN CONJ_TAC THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_CBALL) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM SET_TAC[]; MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN ASM SET_TAC[]]]) in let lemma3 = prove (`!a t u v:real^N r s. affine t /\ a IN t /\ ball(a,r) INTER t SUBSET s /\ s SUBSET t /\ u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t ==> ?f g. homeomorphism (s,s) (f,g) /\ f(u) = v /\ {x | ~(f x = x /\ g x = x)} SUBSET ball(a,r) INTER t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `u:real^N`; `v:real^N`; `r:real`] lemma2) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then f x else x` THEN EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then g x else x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN SUBGOAL_THEN `(!x:real^N. x IN ball(a,r) INTER t ==> f x IN ball(a,r)) /\ (!x:real^N. x IN ball(a,r) INTER t ==> g x IN ball(a,r))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x IN ball(a:real^N,r)` THEN ASM_SIMP_TAC[] THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN ASM SET_TAC[]) THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(cball(a,r) INTER t) UNION ((t:real^N->bool) DIFF ball(a,r))` THEN (CONJ_TAC THENL [ALL_TAC; MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]]) THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_CBALL; CLOSED_DIFF; OPEN_BALL; CONTINUOUS_ON_ID; GSYM IN_DIFF; CBALL_DIFF_BALL; CLOSED_AFFINE; CLOSED_INTER] THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] CBALL_DIFF_BALL) THEN ASM SET_TAC[]) in REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=> p /\ q /\ r /\ s ==> t ==> u`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p /\ q`] THEN MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN X_GEN_TAC `a:real^N` THENL [X_GEN_TAC `b:real^N` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `~(p /\ q) <=> ~(q /\ p)`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[]) [`(a:real^N) IN s`; `(b:real^N) IN s`; `(c:real^N) IN s`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `(f2:real^N->real^N) o (f1:real^N->real^N)` THEN EXISTS_TAC `(g1:real^N->real^N) o (g2:real^N->real^N)` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{x | ~(f1 x = x /\ g1 x = x)} UNION {x:real^N | ~(f2 x = x /\ g2 x = x)}` THEN ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]; DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s INTER ball(a:real^N,r)` THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N`; `affine hull s:real^N->bool`; `a:real^N`; `b:real^N`; `r:real`; `t:real^N->bool`] lemma3) THEN ASM_SIMP_TAC[CENTRE_IN_BALL; AFFINE_AFFINE_HULL; HULL_INC; IN_INTER] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; INTER_SUBSET; SUBSET_TRANS]]);; let HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN = prove (`!s t x (y:A->real^N) k. &2 <= aff_dim s /\ open_in (subtopology euclidean (affine hull s)) s /\ s SUBSET t /\ t SUBSET affine hull s /\ connected s /\ FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\ pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k ==> ?f g. homeomorphism (t,t) (f,g) /\ (!i. i IN k ==> f(x i) = y i) /\ {x | ~(f x = x /\ g x = x)} SUBSET s /\ bounded {x | ~(f x = x /\ g x = x)}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(k:A->bool)` THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`s:real^N->bool`,`s:real^N->bool`) THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`k:A->bool`,`k:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [GEN_TAC THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN STRIP_TAC THEN X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[PAIRWISE_INSERT; FORALL_IN_INSERT] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s DIFF IMAGE (y:A->real^N) k`; `t:real^N->bool`; `(f:real^N->real^N) ((x:A->real^N) i)`; `(y:A->real^N) i`] HOMEOMORPHISM_MOVING_POINT_EXISTS) THEN SUBGOAL_THEN `affine hull (s DIFF (IMAGE (y:A->real^N) k)) = affine hull s` SUBST1_TAC THENL [MATCH_MP_TAC AFFINE_HULL_OPEN_IN THEN CONJ_TAC THENL [TRANS_TAC OPEN_IN_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[]; REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN ASM_SIMP_TAC[FINITE_IMAGE; CONNECTED_FINITE_IFF_SING] THEN UNDISCH_TAC `&2 <= aff_dim(s:real^N->bool)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_SING] THEN CONV_TAC INT_REDUCE_CONV]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_CARD_LT THEN ASM_REWRITE_TAC[COLLINEAR_AFF_DIM; INT_ARITH `~(s:int <= &1) <=> &2 <= s`] THEN MATCH_MP_TAC CARD_LT_FINITE_INFINITE THEN ASM_SIMP_TAC[FINITE_IMAGE; real_INFINITE]; ALL_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[IN_DIFF] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF]]) THEN SIMP_TAC[SET_RULE `~(y IN IMAGE f s) <=> !x. x IN s ==> ~(f x = y)`] THEN ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(h:real^N->real^N) o (f:real^N->real^N)`; `(g:real^N->real^N) o (k:real^N->real^N)`] THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN ASM_SIMP_TAC[o_THM] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{x | ~(f x = x /\ g x = x)} UNION {x:real^N | ~(h x = x /\ k x = x)}` THEN ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]]);; let HOMEOMORPHISM_MOVING_POINTS_EXISTS = prove (`!s t x (y:A->real^N) k. 2 <= dimindex(:N) /\ open s /\ connected s /\ s SUBSET t /\ FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\ pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k ==> ?f g. homeomorphism (t,t) (f,g) /\ (!i. i IN k ==> f(x i) = y i) /\ {x | ~(f x = x /\ g x = x)} SUBSET s /\ bounded {x | ~(f x = x /\ g x = x)}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY] THEN ASM SET_TAC[]; STRIP_TAC] THEN MATCH_MP_TAC HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SUBGOAL_THEN `affine hull s = (:real^N)` SUBST1_TAC THENL [MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM SET_TAC[]; ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFF_DIM_UNIV] THEN ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBSET_UNIV]]);; let HOMEOMORPHISM_GROUPING_POINTS_EXISTS = prove (`!u s t k:real^N->bool. open u /\ open s /\ connected s /\ ~(u = {}) /\ FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t ==> ?f g. homeomorphism (t,t) (f,g) /\ {x | ~(f x = x /\ g x = x)} SUBSET s /\ bounded {x | ~(f x = x /\ g x = x)} /\ !x. x IN k ==> (f x) IN u`, let lemma1 = prove (`!a b:real^1 c d:real^1. drop a < drop b /\ drop c < drop d ==> ?f g. homeomorphism (interval[a,b],interval[c,d]) (f,g) /\ f(a) = c /\ f(b) = d`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. c + (drop x - drop a) / (drop b - drop a) % (d - c:real^1)` THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_LT; REAL_LT_IMP_NZ; REAL_ARITH `(a - a) / x = &0`; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[LIFT_CMUL; real_div; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_IMAGE] THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_SUB; REAL_FIELD `a < b /\ c < d ==> (x = c + (y - a) / (b - a) * (d - c) <=> a + (x - c) / (d - c) * (b - a) = y)`] THEN REWRITE_TAC[GSYM EXISTS_DROP; UNWIND_THM1] THEN REWRITE_TAC[REAL_ARITH `c <= c + x /\ c + x <= d <=> &0 <= x /\ x <= &1 * (d - c)`] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`; REAL_FIELD `a < b ==> (x / (b - a) = y / (b - a) <=> x = y)`; REAL_ARITH `x - a:real = y - a <=> x = y`; VECTOR_MUL_RCANCEL; DROP_EQ; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[REAL_LT_REFL]]) in let lemma2 = prove (`!a b c:real^1 u v w:real^1 f1 g1 f2 g2. homeomorphism (interval[a,b],interval[u,v]) (f1,g1) /\ homeomorphism (interval[b,c],interval[v,w]) (f2,g2) ==> b IN interval[a,c] /\ v IN interval[u,w] /\ f1 a = u /\ f1 b = v /\ f2 b = v /\ f2 c = w ==> ?f g. homeomorphism(interval[a,c],interval[u,w]) (f,g) /\ f a = u /\ f c = w /\ (!x. x IN interval[a,b] ==> f x = f1 x) /\ (!x. x IN interval[b,c] ==> f x = f2 x)`, REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN EXISTS_TAC `\x. if drop x <= drop b then (f1:real^1->real^1) x else f2 x` THEN ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; REAL_LE_REFL] THEN ASM_SIMP_TAC[DROP_EQ; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC]; ASM_MESON_TAC[]] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN ASM_SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; DROP_EQ] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_DROP; IN_ELIM_THM; IN_INTERVAL_1]; SUBGOAL_THEN `interval[a:real^1,c] = interval[a,b] UNION interval[b,c] /\ interval[u:real^1,w] = interval[u,v] UNION interval[v,w]` (CONJUNCTS_THEN SUBST1_TAC) THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN SIMP_TAC[IN_INTERVAL_1; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN ASM_MESON_TAC[DROP_EQ]]; REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN ASM_CASES_TAC `drop y <= drop b` THEN ASM_REWRITE_TAC[] THENL [COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]] THEN STRIP_TAC THEN SUBGOAL_THEN `(f1:real^1->real^1) x IN interval[u,v] INTER interval[v,w]` MP_TAC THENL [REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(a <= x /\ x <= b) /\ (b <= x /\ x <= c) ==> x = b`)) THEN REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN SUBGOAL_THEN `(f1:real^1->real^1) x = f1 b /\ (f2:real^1->real^1) y = f2 b` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[] `!g1:real^1->real^1 g2:real^1->real^1. g1(f1 x) = x /\ g1(f1 b) = b /\ g2(f2 y) = y /\ g2(f2 b) = b ==> f1 x = f1 b /\ f2 y = f2 b ==> x = y`) THEN MAP_EVERY EXISTS_TAC [`g1:real^1->real^1`; `g2:real^1->real^1`] THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]) in let lemma3 = prove (`!a b c d u v:real^1. interval[c,d] SUBSET interval(a,b) /\ interval[u,v] SUBSET interval(a,b) /\ ~(interval(c,d) = {}) /\ ~(interval(u,v) = {}) ==> ?f g. homeomorphism (interval[a,b],interval[a,b]) (f,g) /\ f a = a /\ f b = b /\ !x. x IN interval[c,d] ==> f(x) IN interval[u,v]`, REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN ASM_CASES_TAC `drop u < drop v` THEN ASM_SIMP_TAC[REAL_ARITH `u < v ==> ~(v < u)`] THEN ASM_CASES_TAC `interval[c:real^1,d] = {}` THENL [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(EXISTS_TAC `I:real^1->real^1`) THEN REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM]; RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN ASM_SIMP_TAC[REAL_ARITH `c <= d ==> ~(d < c)`] THEN STRIP_TAC] THEN MP_TAC(ISPECL [`d:real^1`; `b:real^1`; `v:real^1`; `b:real^1`] lemma1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f3:real^1->real^1`; `g3:real^1->real^1`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^1`; `d:real^1`; `u:real^1`; `v:real^1`] lemma1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f2:real^1->real^1`; `g2:real^1->real^1`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `a:real^1`; `u:real^1`] lemma1) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f1:real^1->real^1`; `g1:real^1->real^1`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC(MATCH_MP lemma2 th)) THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f4:real^1->real^1`; `g4:real^1->real^1`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1]) THEN SUBGOAL_THEN `drop a <= drop x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[]]) in let lemma4 = prove (`!s k u t:real^1->bool. open u /\ open s /\ connected s /\ ~(u = {}) /\ FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t ==> ?f g. homeomorphism (t,t) (f,g) /\ (!x. x IN k ==> f(x) IN u) /\ {x | ~(f x = x /\ g x = x)} SUBSET s /\ bounded {x | ~(f x = x /\ g x = x)}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c d:real^1. ~(interval(c,d) = {}) /\ interval[c,d] SUBSET u` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `open(u:real^1->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?a b:real^1. ~(interval(a,b) = {}) /\ k SUBSET interval[a,b] /\ interval[a,b] SUBSET s` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `k:real^1->bool = {}` THENL [ASM_MESON_TAC[SUBSET_TRANS; EMPTY_SUBSET]; ALL_TAC] THEN MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_SUP) THEN MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_INF) THEN ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_EQ_EMPTY; IMAGE_ID; FINITE_IMP_COMPACT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^1` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `open(s:real^1->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^1`; `v:real^1`] THEN REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN REWRITE_TAC[IS_INTERVAL_1] THEN ASM_MESON_TAC[GSYM MEMBER_NOT_EMPTY; REAL_LET_TRANS; REAL_LE_TRANS; REAL_LT_IMP_LE; SUBSET; REAL_LE_TOTAL]; ALL_TAC] THEN SUBGOAL_THEN `?w z:real^1. interval[w,z] SUBSET s /\ interval[a,b] UNION interval[c,d] SUBSET interval(w,z)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?w z:real^1. interval[w,z] SUBSET s /\ interval[a,b] UNION interval[c,d] SUBSET interval[w,z]` STRIP_ASSUME_TAC THENL [EXISTS_TAC `lift(min (drop a) (drop c))` THEN EXISTS_TAC `lift(max (drop b) (drop d))` THEN REWRITE_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN REWRITE_TAC[IS_INTERVAL_1; SUBSET; IN_INTERVAL_1; LIFT_DROP] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `lift(min (drop a) (drop c))` THEN EXISTS_TAC `lift(max (drop b) (drop d))` THEN ASM_REWRITE_TAC[LIFT_DROP] THEN REWRITE_TAC[real_min; real_max] THEN CONJ_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_EQ_EMPTY_1; REAL_LT_IMP_LE]; ASM_REAL_ARITH_TAC]; UNDISCH_TAC `open(s:real^1->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `z:real^1` th) THEN MP_TAC(SPEC `w:real^1` th)) THEN SUBGOAL_THEN `(w:real^1) IN interval[w,z] /\ z IN interval[w,z]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[ENDS_IN_INTERVAL] THEN MP_TAC (ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM SET_TAC[]; REWRITE_TAC[UNION_SUBSET]] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`w0:real^1`; `w1:real^1`] THEN REWRITE_TAC[IN_INTERVAL_1; SUBSET] THEN STRIP_TAC THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`z0:real^1`; `z1:real^1`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w0:real^1`; `z1:real^1`] THEN RULE_ASSUM_TAC (REWRITE_RULE[ENDS_IN_UNIT_INTERVAL; INTERVAL_NE_EMPTY_1; UNION_SUBSET; SUBSET_INTERVAL_1]) THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_INTERVAL_1]) THEN X_GEN_TAC `x:real^1` THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [UNION_SUBSET]) THEN MP_TAC(ISPECL [`w:real^1`; `z:real^1`; `a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] lemma3) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^1. if x IN interval[w,z] then f x else x` THEN EXISTS_TAC `\x:real^1. if x IN interval[w,z] then g x else x` THEN ASSUME_TAC(ISPECL [`w:real^1`; `z:real^1`]INTERVAL_OPEN_SUBSET_CLOSED) THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]; ASM SET_TAC[]; MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[w:real^1,z]` THEN REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]] THEN (SUBGOAL_THEN `t = interval[w:real^1,z] UNION (t DIFF interval(w,z))` (fun th -> SUBST1_TAC th THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASSUME_TAC(SYM th)) THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_SUBSET THEN REWRITE_TAC[OPEN_INTERVAL] THEN ASM SET_TAC[]; REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; SET_RULE `p /\ ~p \/ x IN t DIFF s /\ x IN u <=> x IN t /\ x IN u DIFF s`] THEN MAP_EVERY (MP_TAC o ISPECL [`w:real^1`; `z:real^1`]) (CONJUNCTS ENDS_IN_INTERVAL) THEN ASM SET_TAC[]])) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL [MP_TAC(ISPECL [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN ANTS_TAC THENL [ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`; `y:real^N->real^N`; `k:real^N->bool`] HOMEOMORPHISM_MOVING_POINTS_EXISTS) THEN ASM_REWRITE_TAC[pairwise] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n < 2 <=> n = 1)`] THEN REWRITE_TAC[GSYM DIMINDEX_1] THEN DISCH_THEN(MP_TAC o MATCH_MP ISOMORPHISMS_UNIV_UNIV) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`IMAGE (h:real^N->real^1) s`; `IMAGE (h:real^N->real^1) k`; `IMAGE (h:real^N->real^1) u`; `IMAGE (h:real^N->real^1) t`] lemma4) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY; CONNECTED_CONTINUOUS_IMAGE; LINEAR_CONTINUOUS_ON] THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_BIJECTIVE_LINEAR_IMAGE_EQ]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)`; `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)`] THEN ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON] THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `{x | ~(j ((f:real^1->real^1) (h x)) = x /\ j (g (h x)) = x)} = IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE]]);; let HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN = prove (`!u s t k:real^N->bool. open_in (subtopology euclidean (affine hull s)) s /\ s SUBSET t /\ t SUBSET affine hull s /\ connected s /\ FINITE k /\ k SUBSET s /\ open_in (subtopology euclidean s) u /\ ~(u = {}) ==> ?f g. homeomorphism (t,t) (f,g) /\ (!x. x IN k ==> f(x) IN u) /\ {x | ~(f x = x /\ g x = x)} SUBSET s /\ bounded {x | ~(f x = x /\ g x = x)}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `&2 <= aff_dim(s:real^N->bool)` THENL [MP_TAC(ISPECL [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN ANTS_TAC THENL [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM INFINITE] THEN MATCH_MP_TAC INFINITE_OPEN_IN THEN EXISTS_TAC `affine hull s:real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN ASM_SIMP_TAC[CONVEX_CONNECTED; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX; AFF_DIM_AFFINE_HULL] THEN CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN MP_TAC (ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`; `y:real^N->real^N`; `k:real^N->bool`] HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN) THEN ASM_REWRITE_TAC[pairwise] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_NOT_LE])] THEN SIMP_TAC[AFF_DIM_GE; INT_ARITH `--(&1):int <= x ==> (x < &2 <=> x = --(&1) \/ x = &0 \/ x = &1)`] THEN REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN SUBGOAL_THEN `(u:real^N->bool) SUBSET s /\ s SUBSET affine hull s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN STRIP_TAC THENL [REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN REWRITE_TAC[HOMEOMORPHISM_I; I_THM; EMPTY_GSPEC; BOUNDED_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(:real^1)`] HOMEOMORPHIC_AFFINE_SETS) THEN ASM_REWRITE_TAC[AFF_DIM_UNIV; AFFINE_AFFINE_HULL; AFFINE_UNIV] THEN ASM_REWRITE_TAC[DIMINDEX_1; AFF_DIM_AFFINE_HULL] THEN REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (h:real^N->real^1) u`; `IMAGE (h:real^N->real^1) s`; `IMAGE (h:real^N->real^1) t`; `IMAGE (h:real^N->real^1) k`] HOMEOMORPHISM_GROUPING_POINTS_EXISTS) THEN ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL [MP_TAC(ISPECL [`h:real^N->real^1`; `j:real^1->real^N`; `affine hull s:real^N->bool`; `(:real^1)`] HOMEOMORPHISM_IMP_OPEN_MAP) THEN ASM_SIMP_TAC[homeomorphism; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`\x. if x IN affine hull s then ((j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)) x else x`; `\x. if x IN affine hull s then ((j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)) x else x`] THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)` THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)` THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[MESON[] `(if P then f x else x) = x <=> ~P \/ f x = x`] THEN REWRITE_TAC[DE_MORGAN_THM; GSYM LEFT_OR_DISTRIB] THEN (SUBGOAL_THEN `{x | x IN affine hull s /\ (~(j (f (h x)) = x) \/ ~(j (g (h x)) = x))} = IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THENL [TRANS_TAC SUBSET_TRANS `IMAGE (j:real^1->real^N) (IMAGE (h:real^N->real^1) s)` THEN ASM SET_TAC[]; MATCH_MP_TAC(MESON[CLOSURE_SUBSET; BOUNDED_SUBSET; IMAGE_SUBSET] `bounded (IMAGE f (closure s)) ==> bounded (IMAGE f s)`) THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]]);; let HOMEOMORPHISM_MOVING_DENSE_COUNTABLE_SUBSETS_EXISTS = prove (`!s:real^M->bool t:real^N->bool. COUNTABLE s /\ closure s = affine hull s /\ COUNTABLE t /\ closure t = affine hull t /\ aff_dim s = aff_dim t ==> ?f g. homeomorphism (affine hull s,affine hull t) (f,g) /\ IMAGE f s = t`, let lemma = prove (`!n s:real^N->bool t:real^N->bool. 1 <= n /\ n <= dimindex(:N) /\ INFINITE s /\ COUNTABLE s /\ closure s = span(IMAGE basis (1..n)) /\ INFINITE t /\ COUNTABLE t /\ closure t = span(IMAGE basis (1..n)) ==> ?f g. homeomorphism (span(IMAGE basis (1..n)),span(IMAGE basis (1..n))) (f,g) /\ IMAGE f s = t`, X_GEN_TAC `n:num` THEN ASM_CASES_TAC `1 <= n` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN MATCH_MP_TAC(METIS[] `!Q. (!s t. P s /\ P t /\ R s t ==> R t s) /\ (!t. P t /\ (!s. P s /\ Q s ==> R s t) ==> (!s. P s ==> R s t)) /\ (!s t. P s /\ Q s /\ P t /\ Q t ==> R s t) ==> !s t. P s /\ P t ==> R s t`) THEN EXISTS_TAC `\s. pairwise (\x y:real^N. !i. 1 <= i /\ i <= n ==> ~(x$i = y$i)) s` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [HOMEOMORPHISM_SYM] THEN SIMP_TAC[] THEN REWRITE_TAC[homeomorphism] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`n:num`; `s:real^N->bool`] ROTATION_TO_GENERAL_POSITION_EXISTS_GEN) THEN ANTS_TAC THENL [ASM_MESON_TAC[CLOSURE_SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^N->real^N) s`) THEN FIRST_ASSUM(MP_TAC o SPECL [`span(IMAGE basis (1..n)):real^N->bool`; `span(IMAGE basis (1..n)):real^N->bool`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_INFINITENESS; CLOSURE_SUBSET]; ASM_MESON_TAC[HOMEOMORPHISM_COUNTABILITY; CLOSURE_SUBSET]; FIRST_ASSUM(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP(REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; CLOSURE_MINIMAL; CLOSED_SPAN; SET_RULE `s INTER s = s`; SET_RULE `s SUBSET t ==> t INTER s = s`] THEN ANTS_TAC THENL [ASM_MESON_TAC[CLOSURE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `c SUBSET d /\ d SUBSET s ==> s = s INTER c ==> d = s`) THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_SPAN] THEN ASM_MESON_TAC[CLOSURE_SUBSET; IMAGE_SUBSET; SUBSET_TRANS]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[PAIRWISE_IMAGE] THEN REWRITE_TAC[pairwise] THEN MESON_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(h:real^N->real^N) o (f:real^N->real^N)`; `(g:real^N->real^N) o (k:real^N->real^N)`] THEN ASM_REWRITE_TAC[IMAGE_o] THEN ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?f:real^N->real^N. IMAGE f s = t /\ !x y i. x IN s /\ y IN s /\ 1 <= i /\ i <= n ==> real_sgn(f x$i - f y$i) = real_sgn(x$i - y$i)` STRIP_ASSUME_TAC THENL [ALL_TAC; SUBGOAL_THEN `!i. ?g h. 1 <= i /\ i <= n ==> (!x. x IN s ==> (f:real^N->real^N) x$i = drop(g(lift(x$i)))) /\ homeomorphism ((:real^1),(:real^1)) (g,h)` MP_TAC THENL [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `?g. !x. x IN s ==> (f:real^N->real^N)(x)$i = g(x$i)` STRIP_ASSUME_TAC THENL [GEN_REWRITE_TAC I [GSYM FUNCTION_FACTORS_LEFT_GEN] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`lift o g o drop`; `IMAGE (\x:real^N. lift(x$i)) s`] INCREASING_EXTENDS_FROM_DENSE) THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN ANTS_TAC THENL [REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[LIFT_DROP; CONJ_ASSOC] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN SUBGOAL_THEN `IMAGE (\x. lift(g(x$i))) s = IMAGE (\x. lift((f:real^N->real^N) x$i)) s` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `IMAGE (\x. lift(f x$i)) s = IMAGE (\y. lift(y$i)) (IMAGE f s)`] THEN ASM_REWRITE_TAC[IMAGE_ID] THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) CLOSURE_LINEAR_IMAGE_SUBSET o lhand o snd) THEN ASM_REWRITE_TAC[LINEAR_LIFT_COMPONENT] THEN MATCH_MP_TAC(SET_RULE `s = UNIV ==> s SUBSET t ==> t = UNIV`) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPAN_IMAGE_BASIS; IN_UNIV] THEN X_GEN_TAC `c:real^1` THEN EXISTS_TAC `drop c % basis i:real^N` THEN (SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN REWRITE_TAC[IN_NUMSEG; REAL_MUL_RID; LIFT_DROP] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL[`x:real^N`; `y:real^N`; `i:num`]) THEN ASM_SIMP_TAC[real_sgn] THEN REAL_ARITH_TAC]; REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^1` THEN STRIP_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC MONOTONE_IMP_HOMEOMORPHISM_1D THEN ASM_REWRITE_TAC[IS_INTERVAL_UNIV; IN_UNIV]]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:num->real^1->real^1`; `h:num->real^1->real^1`] THEN REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(\x. lambda i. if i IN 1..n then drop((g:num->real^1->real^1) i (lift(x$i))) else &0):real^N->real^N`; `(\x. lambda i. if i IN 1..n then drop((h:num->real^1->real^1) i (lift(x$i))) else &0):real^N->real^N`] THEN SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA; GSYM CONJ_ASSOC] THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i IN 1..n` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_DROP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN CONJ_TAC THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LIFT_DROP] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN ASM_SIMP_TAC[]; EXPAND_TAC "t" THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_NUMSEG] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN CONV_TAC SYM_CONV THEN SUBGOAL_THEN `(f:real^N->real^N) x IN span(IMAGE basis (1..n))` MP_TAC THENL [ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET; IN_IMAGE]; ALL_TAC] THEN ASM_SIMP_TAC[IN_SPAN_IMAGE_BASIS; IN_NUMSEG]]]] THEN REWRITE_TAC[TAUT `p /\ q /\ r /\ s ==> t <=> p /\ q ==> r /\ s ==> t`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC(MESON[] `(?f. IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ P f) ==> (?f. IMAGE f s = t /\ P f)`) THEN MATCH_MP_TAC BACK_AND_FORTH_2 THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN REWRITE_TAC[REAL_SGN_NEG] THEN ASM_MESON_TAC[]; ALL_TAC] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ONCE_REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:real^N->bool`; `s:real^N->bool`] THEN REWRITE_TAC[FORALL_AND_THM] THEN GEN_REWRITE_TAC RAND_CONV [MESON[] `(!s t f s' t' x. P s t f s' t' x) <=> (!s t f t' s' x. P t s f t' s' x)`] THEN REWRITE_TAC[AND_FORALL_THM; IMP_IMP] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`; `f:real^N->real^N`; `s':real^N->bool`; `t':real^N->bool`; `x:real^N`] THEN MATCH_MP_TAC(TAUT `(q <=> p) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[CONJ_ACI]; REWRITE_TAC[IN_DIFF] THEN STRIP_TAC] THEN ABBREV_TAC `u = INTERS {{y:real^N | y$i < (f:real^N->real^N)(z)$i} |i,z| i IN 1..n /\ z IN {z | z IN s' /\ (x:real^N)$i < z$i}} INTER INTERS {{y:real^N | y$i > (f:real^N->real^N)(z)$i} |i,z| i IN 1..n /\ z IN {z | z IN s' /\ (x:real^N)$i > z$i}}` THEN SUBGOAL_THEN `open(u:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "u" THEN MATCH_MP_TAC OPEN_INTER THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_INTERS THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_NUMSEG; FINITE_RESTRICT; FORALL_IN_GSPEC; OPEN_HALFSPACE_COMPONENT_GT; OPEN_HALFSPACE_COMPONENT_LT]; ALL_TAC] THEN SUBGOAL_THEN `~(u:real^N->bool = {})` ASSUME_TAC THENL [EXPAND_TAC "u" THEN GEN_REWRITE_TAC RAND_CONV [EXTENSION] THEN REWRITE_TAC[INTERS_GSPEC; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[NOT_FORALL_THM; IN_NUMSEG] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= n <=> (1 <= i /\ i <= dimindex(:N)) /\ i <= n` MP_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r ==> s <=> p ==> q /\ r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i:num <= n` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s /\ P x ==> R y ((f x)$i)) <=> (!x. x IN IMAGE (\x. (f x)$i) {x | x IN s /\ P x} ==> R y x)`] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[real_gt] THEN ASM_SIMP_TAC[REAL_LT_BETWEEN_GEN; FINITE_RESTRICT; FINITE_IMAGE] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real^N` THEN STRIP_TAC THEN X_GEN_TAC `v:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N`; `v:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[REAL_SGN_EQ_INEQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?y:real^N. y IN (t DIFF t') /\ y IN u` MP_TAC THENL [SUBGOAL_THEN `?z:real^N. z IN span(IMAGE basis (1..n)) INTER u` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN EXISTS_TAC `(lambda i. if i IN 1..n then (z:real^N)$i else &0):real^N` THEN UNDISCH_TAC `(z:real^N) IN u` THEN EXPAND_TAC "u" THEN REWRITE_TAC[INTERS_GSPEC; IN_INTER; IN_ELIM_THM] THEN SUBGOAL_THEN `!i. i IN 1..n ==> 1 <= i /\ i <= dimindex(:N)` MP_TAC THENL [REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA]; REWRITE_TAC[IN_INTER] THEN STRIP_TAC] THEN SUBGOAL_THEN `(z:real^N) limit_point_of t` MP_TAC THENL [ONCE_REWRITE_TAC[GSYM LIMPT_OF_CLOSURE] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN ASM_SIMP_TAC[CONVEX_SPAN; CONVEX_CONNECTED] THEN SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN REWRITE_TAC[DIM_SPAN; DIM_BASIS_IMAGE] THEN REWRITE_TAC[INTER_NUMSEG; CARD_NUMSEG_1; ARITH_RULE `MAX n n = n`] THEN REWRITE_TAC[INT_OF_NUM_EQ] THEN MATCH_MP_TAC(ARITH_RULE `1 <= m /\ 1 <= n ==> ~(MIN m n = 0)`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1]; GEN_REWRITE_TAC LAND_CONV [LIMPT_INFINITE_OPEN]] THEN DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `FINITE(t':real^N->bool)` THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_DIFF_FINITE) THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; INTERS_GSPEC; IN_ELIM_THM] THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN REWRITE_TAC[REAL_SGNS_EQ_ALT; real_gt; REAL_SUB_LT; REAL_SUB_0; REAL_ARITH `x - y < &0 <=> x < y`] THEN SIMP_TAC[IN_NUMSEG] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; AFFINE_HULL_EMPTY] THEN REWRITE_TAC[IMAGE_CLAUSES; GSYM homeomorphic] THEN REWRITE_TAC[HOMEOMORPHIC_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `aff_dim(t:real^N->bool) = &0` THENL [ASM_REWRITE_TAC[AFF_DIM_EQ_0; CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFF_DIM_EQ_0]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `a:real^M` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[AFFINE_HULL_SING; CLOSURE_SING] THEN DISCH_THEN(K ALL_TAC) THEN MAP_EVERY EXISTS_TAC [`(\x. b):real^M->real^N`; `(\x. a):real^N->real^M`] THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; homeomorphism; CONTINUOUS_ON_CONST] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `FINITE(s:real^M->bool)` THENL [ASM_SIMP_TAC[CLOSURE_CLOSED; FINITE_IMP_CLOSED] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MP_TAC(ISPEC `affine hull s:real^M->bool` CONNECTED_FINITE_IFF_SING) THEN SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_CONNECTED] THEN ASM_MESON_TAC[AFF_DIM_EQ_0; AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN ASM_CASES_TAC `FINITE(t:real^N->bool)` THENL [ASM_SIMP_TAC[CLOSURE_CLOSED; FINITE_IMP_CLOSED] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MP_TAC(ISPEC `affine hull t:real^N->bool` CONNECTED_FINITE_IFF_SING) THEN SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_CONNECTED] THEN ASM_MESON_TAC[AFF_DIM_EQ_0; AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `?n. aff_dim(t:real^N->bool) = &n` (CHOOSE_THEN (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)) THENL [ASM_REWRITE_TAC[INT_OF_NUM_EXISTS; AFF_DIM_POS_LE]; ALL_TAC] THEN SUBGOAL_THEN `&1 <= aff_dim(t:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC(INT_ARITH `-- &1:int <= x /\ ~(x = -- &1) /\ ~(x = &0) ==> &1 <= x`) THEN REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1] THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[INT_OF_NUM_LE] THEN DISCH_TAC] THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`~(t:real^N->bool = {})`; `~(&n:int = &0)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM INFINITE]) THEN MP_TAC(ISPEC `s:real^M->bool` AFF_DIM_LE_UNIV) THEN MP_TAC(ISPEC `t:real^N->bool` AFF_DIM_LE_UNIV) THEN ASM_REWRITE_TAC[INT_OF_NUM_LE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`affine hull s:real^M->bool`; `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool`] HOMEOMORPHIC_AFFINE_SETS) THEN SIMP_TAC[AFFINE_AFFINE_HULL; AFFINE_SPAN; AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN SIMP_TAC[DIM_BASIS_IMAGE; DIM_SPAN; INTER_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `MAX x x = x`; CARD_NUMSEG_1] THEN ASM_SIMP_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `n <= N ==> MIN (M + N) n = n`; homeomorphic; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h1:real^M->real^(M,N)finite_sum`; `k1:real^(M,N)finite_sum->real^M`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`affine hull t:real^N->bool`; `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool`] HOMEOMORPHIC_AFFINE_SETS) THEN SIMP_TAC[AFFINE_AFFINE_HULL; AFFINE_SPAN; AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN SIMP_TAC[DIM_BASIS_IMAGE; DIM_SPAN; INTER_NUMSEG] THEN ASM_SIMP_TAC[ARITH_RULE `MAX x x = x`; CARD_NUMSEG_1] THEN ASM_SIMP_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `n <= N ==> MIN (M + N) n = n`; homeomorphic; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h2:real^N->real^(M,N)finite_sum`; `k2:real^(M,N)finite_sum->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`n:num`; `IMAGE (h1:real^M->real^(M,N)finite_sum) s`; `IMAGE (h2:real^N->real^(M,N)finite_sum) t`] lemma) THEN ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM] THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^(M,N)finite_sum->real^(M,N)finite_sum`; `g:real^(M,N)finite_sum->real^(M,N)finite_sum`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(k2:real^(M,N)finite_sum->real^N) o f o (h1:real^M->real^(M,N)finite_sum)`; `(k1:real^(M,N)finite_sum->real^M) o g o (h2:real^N->real^(M,N)finite_sum)`] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [o_ASSOC] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool` THEN GEN_REWRITE_TAC RAND_CONV [HOMEOMORPHISM_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN EXISTS_TAC `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool` THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `(t:real^N->bool) SUBSET affine hull t` MP_TAC THENL [REWRITE_TAC[HULL_SUBSET]; ASM_REWRITE_TAC[IMAGE_o]] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[COUNTABLE_IMAGE]] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ r) /\ (q /\ s)`] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC INFINITE_IMAGE THEN ASM_REWRITE_TAC[] THENL [SUBGOAL_THEN `(s:real^M->bool) SUBSET affine hull s` MP_TAC THENL [REWRITE_TAC[HULL_SUBSET]; ALL_TAC]; SUBGOAL_THEN `(t:real^N->bool) SUBSET affine hull t` MP_TAC THENL [REWRITE_TAC[HULL_SUBSET]; ALL_TAC]] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `s:real^M->bool` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN SUBGOAL_THEN `span(IMAGE basis (1..n)) = IMAGE (h1:real^M->real^(M,N)finite_sum) (affine hull s)` (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THENL [ASM_MESON_TAC[homeomorphism]; ALL_TAC]; FIRST_ASSUM(MP_TAC o SPEC `t:real^N->bool` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN SUBGOAL_THEN `span(IMAGE basis (1..n)) = IMAGE (h2:real^N->real^(M,N)finite_sum) (affine hull t)` (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THENL [ASM_MESON_TAC[homeomorphism]; ALL_TAC]] THEN SIMP_TAC[HULL_SUBSET; CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF; IMAGE_SUBSET; SET_RULE `s SUBSET t ==> t INTER s = s`] THEN ASM_REWRITE_TAC[SET_RULE `s INTER s = s`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SET_RULE `c = s INTER c <=> c SUBSET s`] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_SPAN] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN SIMP_TAC[IMAGE_SUBSET; HULL_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* The "inside" and "outside" of a set, i.e. the points respectively in a *) (* bounded or unbounded connected component of the set's complement. *) (* ------------------------------------------------------------------------- *) let inside = new_definition `inside s = {x | ~(x IN s) /\ bounded(connected_component ((:real^N) DIFF s) x)}`;; let outside = new_definition `outside s = {x | ~(x IN s) /\ ~bounded(connected_component ((:real^N) DIFF s) x)}`;; let INSIDE_TRANSLATION = prove (`!a s. inside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (inside s)`, REWRITE_TAC[inside] THEN GEOM_TRANSLATE_TAC[]);; let OUTSIDE_TRANSLATION = prove (`!a s. outside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (outside s)`, REWRITE_TAC[outside] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [INSIDE_TRANSLATION; OUTSIDE_TRANSLATION];; let INSIDE_LINEAR_IMAGE = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> inside(IMAGE f s) = IMAGE f (inside s)`, REWRITE_TAC[inside] THEN GEOM_TRANSFORM_TAC[]);; let OUTSIDE_LINEAR_IMAGE = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> outside(IMAGE f s) = IMAGE f (outside s)`, REWRITE_TAC[outside] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [INSIDE_LINEAR_IMAGE; OUTSIDE_LINEAR_IMAGE];; let OUTSIDE = prove (`!s. outside s = {x | ~bounded(connected_component((:real^N) DIFF s) x)}`, GEN_TAC THEN REWRITE_TAC[outside; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[BOUNDED_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF]);; let INSIDE_NO_OVERLAP = prove (`!s. inside s INTER s = {}`, REWRITE_TAC[inside] THEN SET_TAC[]);; let OUTSIDE_NO_OVERLAP = prove (`!s. outside s INTER s = {}`, REWRITE_TAC[outside] THEN SET_TAC[]);; let INSIDE_INTER_OUTSIDE = prove (`!s. inside s INTER outside s = {}`, REWRITE_TAC[inside; outside] THEN SET_TAC[]);; let INSIDE_UNION_OUTSIDE = prove (`!s. inside s UNION outside s = (:real^N) DIFF s`, REWRITE_TAC[inside; outside] THEN SET_TAC[]);; let INSIDE_EQ_OUTSIDE = prove (`!s. inside s = outside s <=> s = (:real^N)`, REWRITE_TAC[inside; outside] THEN SET_TAC[]);; let INSIDE_OUTSIDE = prove (`!s. inside s = (:real^N) DIFF (s UNION outside s)`, GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`) [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN SET_TAC[]);; let OUTSIDE_INSIDE = prove (`!s. outside s = (:real^N) DIFF (s UNION inside s)`, GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`) [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN SET_TAC[]);; let INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT = prove (`!s. inside s = {} <=> !c. c IN components((:real^N) DIFF s) ==> ~bounded c`, REWRITE_TAC[components; FORALL_IN_GSPEC; inside] THEN SET_TAC[]);; let OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT = prove (`!s. outside s = {} <=> !c. c IN components((:real^N) DIFF s) ==> bounded c`, REWRITE_TAC[components; FORALL_IN_GSPEC; outside] THEN SET_TAC[]);; let INSIDE_SELF_OUTSIDE_EVERSION = prove (`!s t:real^N->bool. s UNION inside s SUBSET inside t <=> t UNION outside t SUBSET outside s`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV[SET_RULE `s SUBSET t <=> UNIV DIFF t SUBSET UNIV DIFF s`] THEN REWRITE_TAC[GSYM INSIDE_OUTSIDE] THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN ASM SET_TAC[]);; let UNION_WITH_INSIDE = prove (`!s. s UNION inside s = (:real^N) DIFF outside s`, REWRITE_TAC[OUTSIDE_INSIDE] THEN SET_TAC[]);; let UNION_WITH_OUTSIDE = prove (`!s. s UNION outside s = (:real^N) DIFF inside s`, REWRITE_TAC[INSIDE_OUTSIDE] THEN SET_TAC[]);; let OUTSIDE_MONO = prove (`!s t. s SUBSET t ==> outside t SUBSET outside s`, REPEAT GEN_TAC THEN REWRITE_TAC[OUTSIDE; SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);; let INSIDE_MONO = prove (`!s t. s SUBSET t ==> inside s DIFF t SUBSET inside t`, REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; IN_DIFF; inside; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) ASSUME_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);; let INSIDE_MONO_ALT = prove (`!s t:real^N->bool. s SUBSET t ==> inside s SUBSET t UNION inside t`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INSIDE_MONO) THEN SET_TAC[]);; let COBOUNDED_OUTSIDE = prove (`!s:real^N->bool. bounded s ==> bounded((:real^N) DIFF outside s)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[outside] THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~(x IN s) /\ ~P x} = s UNION {x | P x}`] THEN ASM_REWRITE_TAC[BOUNDED_UNION] THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,B)` THEN REWRITE_TAC[BOUNDED_BALL; SUBSET; IN_ELIM_THM; IN_BALL_0] THEN X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_REWRITE_TAC[NORM_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(B + C) / norm(x) % x:real^N`) THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `segment[x:real^N,(B + C) / norm(x) % x]` THEN REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(:real^N) DIFF ball(vec 0,B)` THEN ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL_0] THEN REWRITE_TAC[segment; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_ASSOC] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < B /\ B <= x ==> B <= abs x`) THEN ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - u) * B + u * (B + C)` THEN ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; REAL_SUB_LE] THEN SIMP_TAC[REAL_ARITH `B <= (&1 - u) * B + u * (B + C) <=> &0 <= u * C`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);; let UNBOUNDED_OUTSIDE = prove (`!s:real^N->bool. bounded s ==> ~bounded(outside s)`, MESON_TAC[COBOUNDED_IMP_UNBOUNDED; COBOUNDED_OUTSIDE]);; let BOUNDED_INSIDE = prove (`!s:real^N->bool. bounded s ==> bounded(inside s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `(:real^N) DIFF outside s` THEN ASM_SIMP_TAC[COBOUNDED_OUTSIDE] THEN MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN SET_TAC[]);; let CONNECTED_OUTSIDE = prove (`!s:real^N->bool. 2 <= dimindex(:N) /\ bounded s ==> connected(outside s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[outside; IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] CONNECTED_COMPONENT_SUBSET)) THEN REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; REWRITE_TAC[CONNECTED_COMPONENT_IDEMP] THEN SUBGOAL_THEN `connected_component ((:real^N) DIFF s) x = connected_component ((:real^N) DIFF s) y` SUBST1_TAC THENL [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN ASM_REWRITE_TAC[COMPL_COMPL]; ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]]);; let OUTSIDE_CONNECTED_COMPONENT_LT = prove (`!s. outside s = {x | !B. ?y. B < norm(y) /\ connected_component((:real^N) DIFF s) x y}`, REWRITE_TAC[OUTSIDE; bounded; EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN] THEN ASM_MESON_TAC[REAL_NOT_LE]);; let OUTSIDE_CONNECTED_COMPONENT_LE = prove (`!s. outside s = {x | !B. ?y. B <= norm(y) /\ connected_component((:real^N) DIFF s) x y}`, GEN_TAC THEN REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);; let NOT_OUTSIDE_CONNECTED_COMPONENT_LT = prove (`!s. 2 <= dimindex(:N) /\ bounded s ==> (:real^N) DIFF (outside s) = {x | !B. ?y. B < norm(y) /\ ~(connected_component((:real^N) DIFF s) x y)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[bounded] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `C:real`) THEN X_GEN_TAC `B:real` THEN EXISTS_TAC `(abs B + abs C + &1) % basis 1:real^N` THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `B:real`) THEN DISCH_THEN (X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL_0; IN_UNIV; CONTRAPOS_THM] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN ASM_SIMP_TAC[SUBSET_REFL; IN_DIFF; IN_UNIV; IN_CBALL_0; REAL_NOT_LE] THEN MATCH_MP_TAC CONNECTED_COMPLEMENT_BOUNDED_CONVEX THEN ASM_SIMP_TAC[BOUNDED_CBALL; CONVEX_CBALL]]);; let NOT_OUTSIDE_CONNECTED_COMPONENT_LE = prove (`!s. 2 <= dimindex(:N) /\ bounded s ==> (:real^N) DIFF (outside s) = {x | !B. ?y. B <= norm(y) /\ ~(connected_component((:real^N) DIFF s) x y)}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);; let INSIDE_CONNECTED_COMPONENT_LT = prove (`!s. 2 <= dimindex(:N) /\ bounded s ==> inside s = {x:real^N | ~(x IN s) /\ !B. ?y. B < norm(y) /\ ~(connected_component((:real^N) DIFF s) x y)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN SET_TAC[]);; let INSIDE_CONNECTED_COMPONENT_LE = prove (`!s. 2 <= dimindex(:N) /\ bounded s ==> inside s = {x:real^N | ~(x IN s) /\ !B. ?y. B <= norm(y) /\ ~(connected_component((:real^N) DIFF s) x y)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LE] THEN SET_TAC[]);; let OUTSIDE_UNION_OUTSIDE_UNION = prove (`!c c1 c2:real^N->bool. c INTER outside(c1 UNION c2) = {} ==> outside(c1 UNION c2) SUBSET outside(c1 UNION c)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `B:real` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[connected_component] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `t SUBSET outside(c1 UNION c2:real^N->bool)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `connected_component((:real^N) DIFF (c1 UNION c2)) x` THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]; ALL_TAC] THEN UNDISCH_TAC `(x:real^N) IN outside(c1 UNION c2)` THEN REWRITE_TAC[OUTSIDE; IN_ELIM_THM; SUBSET] THEN MESON_TAC[CONNECTED_COMPONENT_EQ]);; let INSIDE_SUBSET = prove (`!s t u. connected u /\ ~bounded u /\ t UNION u = (:real^N) DIFF s ==> inside s SUBSET t`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN UNDISCH_TAC `~bounded(u:real^N->bool)` THEN REWRITE_TAC[] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `connected_component((:real^N) DIFF s) x` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let INSIDE_UNIQUE = prove (`!s t u. connected t /\ bounded t /\ connected u /\ ~(bounded u) /\ ~connected((:real^N) DIFF s) /\ t UNION u = (:real^N) DIFF s ==> inside s = t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ASM_MESON_TAC[INSIDE_SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `!s u. c INTER s = {} /\ c INTER u = {} /\ t UNION u = UNIV DIFF s ==> c SUBSET t`) THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `c INTER s = {} <=> c SUBSET (UNIV DIFF s)`] THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t = {}`) THEN X_GEN_TAC `y:real^N` THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [IN] THEN STRIP_TAC THEN UNDISCH_TAC `~connected((:real^N) DIFF s)` THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN SUBGOAL_THEN `(!w. w IN t ==> connected_component ((:real^N) DIFF s) x w) /\ (!w. w IN u ==> connected_component ((:real^N) DIFF s) y w)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[connected_component] THENL [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `u:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_UNION] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]]);; let INSIDE_OUTSIDE_UNIQUE = prove (`!s t u. connected t /\ bounded t /\ connected u /\ ~(bounded u) /\ ~connected((:real^N) DIFF s) /\ t UNION u = (:real^N) DIFF s ==> inside s = t /\ outside s = u`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_MESON_TAC[INSIDE_UNIQUE]; MP_TAC(ISPEC `(:real^N) DIFF s` INSIDE_NO_OVERLAP) THEN SUBGOAL_THEN `t INTER u:real^N->bool = {}` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN UNDISCH_TAC `~connected ((:real^N) DIFF s)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[]]);; let INTERIOR_INSIDE_FRONTIER = prove (`!s:real^N->bool. bounded s ==> interior s SUBSET inside(frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[inside; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[frontier; IN_DIFF]; DISCH_TAC] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `~(connected_component((:real^N) DIFF frontier s) x INTER frontier s = {})` MP_TAC THENL [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; GSYM MEMBER_NOT_EMPTY] THEN CONJ_TAC THENL [REWRITE_TAC[IN_INTER]; ASM SET_TAC[]] THEN EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN GEN_REWRITE_TAC I [GSYM IN] THEN ASM SET_TAC[]; ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]]; REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; let INSIDE_EMPTY = prove (`inside {} = {}`, REWRITE_TAC[inside; NOT_IN_EMPTY; DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN REWRITE_TAC[NOT_BOUNDED_UNIV; EMPTY_GSPEC]);; let OUTSIDE_EMPTY = prove (`outside {} = (:real^N)`, REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_EMPTY] THEN SET_TAC[]);; let INSIDE_SAME_COMPONENT = prove (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN inside s ==> y IN inside s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN]) MP_TAC) THEN REWRITE_TAC[inside; IN_ELIM_THM] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SIMP_TAC[IN_DIFF]);; let OUTSIDE_SAME_COMPONENT = prove (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN outside s ==> y IN outside s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN]) MP_TAC) THEN REWRITE_TAC[outside; IN_ELIM_THM] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SIMP_TAC[IN_DIFF]);; let CONNECTED_COMPONENT_INSIDE = prove (`!s a. connected_component (inside s) a = if a IN inside s then connected_component ((:real^N) DIFF s) a else {}`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN REWRITE_TAC[INSIDE_NO_OVERLAP]; GEN_REWRITE_TAC LAND_CONV [GSYM CONNECTED_COMPONENT_IDEMP] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN REWRITE_TAC[SUBSET] THEN ASM_MESON_TAC[IN; INSIDE_SAME_COMPONENT]]);; let CONNECTED_COMPONENT_OUTSIDE = prove (`!s a. connected_component (outside s) a = if a IN outside s then connected_component ((:real^N) DIFF s) a else {}`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN REWRITE_TAC[OUTSIDE_NO_OVERLAP]; GEN_REWRITE_TAC LAND_CONV [GSYM CONNECTED_COMPONENT_IDEMP] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN REWRITE_TAC[SUBSET] THEN ASM_MESON_TAC[IN; OUTSIDE_SAME_COMPONENT]]);; let BOUNDED_COMPONENTS_INSIDE = prove (`!c:real^N->bool. c IN components(inside s) ==> bounded c`, SIMP_TAC[components; FORALL_IN_GSPEC; CONNECTED_COMPONENT_INSIDE] THEN REWRITE_TAC[inside] THEN SET_TAC[]);; let UNBOUNDED_COMPONENTS_OUTSIDE = prove (`!s c:real^N->bool. c IN components(outside s) ==> ~bounded c`, SIMP_TAC[components; FORALL_IN_GSPEC; CONNECTED_COMPONENT_OUTSIDE] THEN REWRITE_TAC[outside] THEN SET_TAC[]);; let INSIDE_WITH_INSIDE = prove (`!s:real^N->bool. inside(s UNION inside s) = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT] THEN REWRITE_TAC[GSYM OUTSIDE_INSIDE; UNBOUNDED_COMPONENTS_OUTSIDE]);; let OUTSIDE_WITH_OUTSIDE = prove (`!s:real^N->bool. outside(s UNION outside s) = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT] THEN REWRITE_TAC[GSYM INSIDE_OUTSIDE] THEN REWRITE_TAC[BOUNDED_COMPONENTS_INSIDE]);; let OUTSIDE_CONVEX = prove (`!s. convex s ==> outside s = (:real^N) DIFF s`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; REWRITE_RULE[SET_RULE `t INTER s = {} <=> t SUBSET UNIV DIFF s`] OUTSIDE_NO_OVERLAP] THEN REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[OUTSIDE_EMPTY; IN_UNIV] THEN X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT t)`) THEN SPEC_TAC(`(vec 0:real^N) INSERT t`,`s:real^N->bool`) THEN GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN SUBGOAL_THEN `~(x:real^N = vec 0)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(max (&2) ((B + &1) / norm(x))) % x:real^N`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `segment[x:real^N,(max (&2) ((B + &1) / norm(x))) % x]` THEN REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN ASM_CASES_TAC `u = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_RZERO; VECTOR_ADD_RID; IN_DIFF; IN_UNIV] THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_ARITH `a % x + b % c % x:real^N = (a + b * c) % x`] THEN ABBREV_TAC `c = &1 - u + u * max (&2) ((B + &1) / norm(x:real^N))` THEN DISCH_TAC THEN SUBGOAL_THEN `&1 < c` ASSUME_TAC THENL [EXPAND_TAC "c" THEN REWRITE_TAC[REAL_ARITH `&1 < &1 - u + u * x <=> &0 < u * (x - &1)`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `x:real^N = (&1 - inv c) % vec 0 + inv c % c % x` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < x ==> ~(x = &0)`] THEN REWRITE_TAC[VECTOR_MUL_LID]; MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_LT_IMP_LE] THEN ASM_REAL_ARITH_TAC]]; ASM_SIMP_TAC[NORM_MUL; REAL_NOT_LE; GSYM REAL_LT_LDIV_EQ; NORM_POS_LT] THEN MATCH_MP_TAC(REAL_ARITH `&0 < b /\ b < c ==> b < abs(max (&2) c)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_DIV2_EQ] THEN REAL_ARITH_TAC]);; let INSIDE_CONVEX = prove (`!s. convex s ==> inside s = {}`, SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_CONVEX] THEN SET_TAC[]);; let OUTSIDE_SUBSET_CONVEX = prove (`!s t. convex t /\ s SUBSET t ==> (:real^N) DIFF t SUBSET outside s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `outside(t:real^N->bool)` THEN ASM_SIMP_TAC[OUTSIDE_MONO] THEN ASM_SIMP_TAC[OUTSIDE_CONVEX; SUBSET_REFL]);; let INSIDE_SUBSET_CONVEX = prove (`!s c:real^N->bool. convex c /\ s SUBSET c ==> inside s SUBSET c`, REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`] OUTSIDE_SUBSET_CONVEX) THEN ASM SET_TAC[]);; let INSIDE_SUBSET_CONVEX_HULL = prove (`!s:real^N->bool. inside s SUBSET convex hull s`, SIMP_TAC[INSIDE_SUBSET_CONVEX; CONVEX_CONVEX_HULL; HULL_SUBSET]);; let UNBOUNDED_DISJOINT_IN_OUTSIDE = prove (`!s t x:real^N. connected t /\ ~bounded t /\ x IN t /\ DISJOINT s t ==> x IN outside s`, REPEAT STRIP_TAC THEN REWRITE_TAC[outside; IN_ELIM_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `~bounded(t:real^N->bool)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM SET_TAC[]);; let INSIDE_SUBSET_INTERIOR_CONVEX = prove (`!s c:real^N->bool. convex c /\ s SUBSET c ==> inside s SUBSET interior c`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SET_DIFF_FRONTIER] THEN REWRITE_TAC[SET_RULE `s SUBSET t DIFF u <=> s SUBSET t /\ DISJOINT s u`] THEN ASM_SIMP_TAC[INSIDE_SUBSET_CONVEX] THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN MP_TAC(ISPECL [`c:real^N->bool`; `x:real^N`] SUPPORTING_HYPERPLANE_FRONTIER) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x INSERT {y:real^N | a dot y < a dot x}`; `x:real^N`] UNBOUNDED_DISJOINT_IN_OUTSIDE) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `{y:real^N | a dot y < a dot x}` THEN ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; CONVEX_CONNECTED; CONVEX_HALFSPACE_LT; INSERT_SUBSET; IN_ELIM_THM; SUBSET; IN_INSERT] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[BOUNDED_INSERT; BOUNDED_HALFSPACE_LT]; REWRITE_TAC[IN_INSERT]; REWRITE_TAC[SET_RULE `DISJOINT s (x INSERT t) <=> ~(x IN s) /\ (!y. y IN s ==> ~(y IN t))`] THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM; REAL_NOT_LT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CLOSURE_INC THEN ASM SET_TAC[]]; MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN ASM SET_TAC[]]);; let INSIDE_SUBSET_INTERIOR_CONVEX_HULL = prove (`!s:real^N->bool. inside s SUBSET interior(convex hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INSIDE_SUBSET_INTERIOR_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL; HULL_SUBSET]);; let OUTSIDE_FRONTIER_MISSES_CLOSURE = prove (`!s. bounded s ==> outside(frontier s) SUBSET (:real^N) DIFF closure s`, REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN SIMP_TAC[SET_RULE `(UNIV DIFF s) SUBSET (UNIV DIFF t) <=> t SUBSET s`] THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `i SUBSET ins ==> c SUBSET (c DIFF i) UNION ins`) THEN ASM_SIMP_TAC[GSYM frontier; INTERIOR_INSIDE_FRONTIER]);; let OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE = prove (`!s. bounded s /\ convex s ==> outside(frontier s) = (:real^N) DIFF closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[OUTSIDE_FRONTIER_MISSES_CLOSURE] THEN MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN ASM_SIMP_TAC[CONVEX_CLOSURE; frontier] THEN SET_TAC[]);; let INSIDE_FRONTIER_EQ_INTERIOR = prove (`!s:real^N->bool. bounded s /\ convex s ==> inside(frontier s) = interior s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE] THEN REWRITE_TAC[frontier] THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`) [CLOSURE_SUBSET; INTERIOR_SUBSET] THEN ASM SET_TAC[]);; let INSIDE_SPHERE = prove (`!a:real^N r. inside(sphere(a,r)) = ball(a,r)`, REWRITE_TAC[GSYM FRONTIER_CBALL] THEN SIMP_TAC[INSIDE_FRONTIER_EQ_INTERIOR; BOUNDED_CBALL; CONVEX_CBALL] THEN REWRITE_TAC[INTERIOR_CBALL]);; let OUTSIDE_SPHERE = prove (`!a r. outside(sphere(a,r)) = (:real^N) DIFF cball(a,r)`, REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_SPHERE; SPHERE_UNION_BALL]);; let OPEN_INSIDE = prove (`!s:real^N->bool. closed s ==> open(inside s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed]; REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN GEN_REWRITE_TAC I [GSYM IN] THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);; let OPEN_OUTSIDE = prove (`!s:real^N->bool. closed s ==> open(outside s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed]; REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN GEN_REWRITE_TAC I [GSYM IN] THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN MP_TAC(ISPEC `s:real^N->bool` OUTSIDE_NO_OVERLAP) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);; let CLOSURE_INSIDE_SUBSET = prove (`!s:real^N->bool. closed s ==> closure(inside s) SUBSET s UNION inside s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[closed; GSYM OUTSIDE_INSIDE; OPEN_OUTSIDE] THEN SET_TAC[]);; let FRONTIER_INSIDE_SUBSET = prove (`!s:real^N->bool. closed s ==> frontier(inside s) SUBSET s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[frontier; OPEN_INSIDE; INTERIOR_OPEN] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN SET_TAC[]);; let FRONTIER_WITH_INSIDE_SUBSET = prove (`!s:real^N->bool. closed s ==> frontier(s UNION inside s) SUBSET s`, REPEAT STRIP_TAC THEN TRANS_TAC SUBSET_TRANS `frontier s UNION frontier(inside s):real^N->bool` THEN REWRITE_TAC[FRONTIER_UNION_SUBSET; UNION_SUBSET] THEN ASM_SIMP_TAC[FRONTIER_INSIDE_SUBSET; FRONTIER_SUBSET_CLOSED]);; let CLOSURE_OUTSIDE_SUBSET = prove (`!s:real^N->bool. closed s ==> closure(outside s) SUBSET s UNION outside s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[closed; GSYM INSIDE_OUTSIDE; OPEN_INSIDE] THEN SET_TAC[]);; let FRONTIER_OUTSIDE_SUBSET = prove (`!s:real^N->bool. closed s ==> frontier(outside s) SUBSET s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[frontier; OPEN_OUTSIDE; INTERIOR_OPEN] THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_OUTSIDE_SUBSET) THEN SET_TAC[]);; let FRONTIER_WITH_OUTSIDE_SUBSET = prove (`!s:real^N->bool. closed s ==> frontier(s UNION outside s) SUBSET s`, REPEAT STRIP_TAC THEN TRANS_TAC SUBSET_TRANS `frontier s UNION frontier(outside s):real^N->bool` THEN REWRITE_TAC[FRONTIER_UNION_SUBSET; UNION_SUBSET] THEN ASM_SIMP_TAC[FRONTIER_OUTSIDE_SUBSET; FRONTIER_SUBSET_CLOSED]);; let CLOSED_WITH_INSIDE = prove (`!s:real^N->bool. closed s ==> closed(s UNION inside s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s UNION inside s:real^N->bool = s UNION closure(inside s)` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN MP_TAC(ISPEC `inside s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]; ASM_SIMP_TAC[CLOSED_UNION; CLOSED_CLOSURE]]);; let BOUNDED_WITH_INSIDE = prove (`!s:real^N->bool. bounded s ==> bounded(s UNION inside s)`, SIMP_TAC[BOUNDED_UNION; BOUNDED_INSIDE]);; let COMPACT_WITH_INSIDE = prove (`!s:real^N->bool. compact s ==> compact(s UNION inside s)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_WITH_INSIDE; CLOSED_WITH_INSIDE]);; let INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY = prove (`!s. connected((:real^N) DIFF s) /\ ~bounded((:real^N) DIFF s) ==> inside s = {}`, REWRITE_TAC[inside; CONNECTED_CONNECTED_COMPONENT_SET] THEN REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN SIMP_TAC[IN_ELIM_THM; IN_DIFF; IN_UNIV; TAUT `~(a /\ b) <=> a ==> ~b`]);; let INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY = prove (`!s. connected((:real^N) DIFF s) /\ bounded s ==> inside s = {}`, MESON_TAC[INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY; COBOUNDED_IMP_UNBOUNDED]);; let INSIDE_INSIDE = prove (`!s t:real^N->bool. s SUBSET inside t ==> inside s DIFF t SUBSET inside t`, REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; inside; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `s INTER connected_component ((:real^N) DIFF t) x = {}` THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s INTER t = {}) ==> ?x. x IN s /\ x IN t`)) THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST_ALL_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_SIMP_TAC[inside; IN_ELIM_THM]]);; let INSIDE_INSIDE_SUBSET = prove (`!s:real^N->bool. inside(inside s) SUBSET s`, GEN_TAC THEN MP_TAC (ISPECL [`inside s:real^N->bool`; `s:real^N->bool`] INSIDE_INSIDE) THEN REWRITE_TAC[SUBSET_REFL] THEN MP_TAC(ISPEC `inside s:real^N->bool` INSIDE_NO_OVERLAP) THEN SET_TAC[]);; let INSIDE_OUTSIDE_INTERSECT_CONNECTED = prove (`!s t:real^N->bool. connected t /\ ~(inside s INTER t = {}) /\ ~(outside s INTER t = {}) ==> ~(s INTER t = {})`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN REWRITE_TAC[inside; outside; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `connected_component ((:real^N) DIFF s) y = connected_component ((:real^N) DIFF s) x` (fun th -> ASM_MESON_TAC[th]) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]);; let OUTSIDE_BOUNDED_NONEMPTY = prove (`!s:real^N->bool. bounded s ==> ~(outside s = {})`, GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OUTSIDE_SUBSET_CONVEX)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[CONVEX_BALL; SUBSET_EMPTY] THEN REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN MESON_TAC[BOUNDED_BALL; BOUNDED_SUBSET; NOT_BOUNDED_UNIV]);; let OUTSIDE_COMPACT_IN_OPEN = prove (`!s t:real^N->bool. compact s /\ open t /\ s SUBSET t /\ ~(t = {}) ==> ~(outside s INTER t = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY o MATCH_MP COMPACT_IMP_BOUNDED) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`linepath(a:real^N,b)`; `(:real^N) DIFF t`] EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_DIFF; INTERIOR_UNIV] THEN ABBREV_TAC `c:real^N = pathfinish g` THEN STRIP_TAC THEN SUBGOAL_THEN `frontier t SUBSET (:real^N) DIFF s` MP_TAC THENL [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV]] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` OPEN_CONTAINS_CBALL) THEN ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED; IN_DIFF; IN_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`c:real^N`; `t:real^N->bool`] CLOSURE_APPROACHABLE) THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `path_image(g) UNION segment[c:real^N,d]` THEN REWRITE_TAC[IN_UNION; ENDS_IN_SEGMENT] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; CONNECTED_PATH_IMAGE] THEN EXISTS_TAC `c:real^N` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]; CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]] THEN REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(c IN s) ==> (t DELETE c) SUBSET (UNIV DIFF s) ==> t SUBSET (UNIV DIFF s)`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN SIMP_TAC[SET_RULE `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[CONVEX_CBALL; INSERT_SUBSET; REAL_LT_IMP_LE; EMPTY_SUBSET; CENTRE_IN_CBALL] THEN REWRITE_TAC[IN_CBALL] THEN ASM_MESON_TAC[DIST_SYM; REAL_LT_IMP_LE]]]);; let INSIDE_INSIDE_COMPACT_CONNECTED = prove (`!s t:real^N->bool. closed s /\ compact t /\ s SUBSET inside t /\ connected t ==> inside s SUBSET inside t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `inside t:real^N->bool = {}` THEN ASM_SIMP_TAC[INSIDE_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET] THEN SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL [REWRITE_TAC[DIMINDEX_GE_1]; REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`]] THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM CONNECTED_CONVEX_1_GEN] THENL [ASM_MESON_TAC[INSIDE_CONVEX]; ALL_TAC] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_INSIDE) THEN MATCH_MP_TAC(SET_RULE `s INTER t = {} ==> s DIFF t SUBSET u ==> s SUBSET u`) THEN SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_INSIDE]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] INSIDE_OUTSIDE_INTERSECT_CONNECTED) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `r /\ q ==> (~p /\ q ==> ~r) ==> p`) THEN CONJ_TAC THENL [MP_TAC(ISPEC `t:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[INTER_COMM]] THEN MATCH_MP_TAC INSIDE_OUTSIDE_INTERSECT_CONNECTED THEN ASM_SIMP_TAC[CONNECTED_OUTSIDE; COMPACT_IMP_BOUNDED] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OUTSIDE_COMPACT_IN_OPEN THEN ASM_SIMP_TAC[OPEN_INSIDE; COMPACT_IMP_CLOSED]; MP_TAC(ISPECL [`s UNION t:real^N->bool`; `vec 0:real^N`] BOUNDED_SUBSET_BALL) THEN ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `!u. ~(u = UNIV) /\ UNIV DIFF u SUBSET s /\ UNIV DIFF u SUBSET t ==> ~(s INTER t = {})`) THEN EXISTS_TAC `ball(vec 0:real^N,r)` THEN CONJ_TAC THENL [ASM_MESON_TAC[NOT_BOUNDED_UNIV; BOUNDED_BALL]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN REWRITE_TAC[CONVEX_BALL] THEN ASM SET_TAC[]]);; let INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED = prove (`!s t:real^N->bool. closed s /\ compact t /\ s SUBSET inside t /\ connected t ==> t UNION outside t SUBSET outside s`, REWRITE_TAC[GSYM INSIDE_SELF_OUTSIDE_EVERSION] THEN SIMP_TAC[UNION_SUBSET] THEN REWRITE_TAC[INSIDE_INSIDE_COMPACT_CONNECTED]);; let INSIDE_OUTSIDE_COMPACT_CONNECTED = prove (`!s t:real^N->bool. closed s /\ compact t /\ s SUBSET inside t /\ connected t ==> t SUBSET outside s`, REPEAT STRIP_TAC THEN TRANS_TAC SUBSET_TRANS `t UNION outside t:real^N->bool` THEN ASM_SIMP_TAC[INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED] THEN SET_TAC[]);; let CONNECTED_WITH_INSIDE = prove (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION inside s)`, GEN_TAC THEN ASM_CASES_TAC `s UNION inside s = (:real^N)` THEN ASM_REWRITE_TAC[CONNECTED_UNIV] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN (s UNION inside s) ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\ t SUBSET (s UNION inside s)` MP_TAC THENL [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`linepath(a:real^N,b)`; `inside s:real^N->bool`] EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; IN_UNION; OPEN_INSIDE; INTERIOR_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `pathfinish g :real^N` THEN EXISTS_TAC `path_image g :real^N->bool` THEN ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[FRONTIER_INSIDE_SUBSET; SUBSET]; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ASM SET_TAC[]]]; DISCH_THEN(fun th -> MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN ASM SET_TAC[]]);; let CONNECTED_WITH_OUTSIDE = prove (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION outside s)`, GEN_TAC THEN ASM_CASES_TAC `s UNION outside s = (:real^N)` THEN ASM_REWRITE_TAC[CONNECTED_UNIV] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN (s UNION outside s) ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\ t SUBSET (s UNION outside s)` MP_TAC THENL [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`linepath(a:real^N,b)`; `outside s:real^N->bool`] EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; IN_UNION; OPEN_OUTSIDE; INTERIOR_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `pathfinish g :real^N` THEN EXISTS_TAC `path_image g :real^N->bool` THEN ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[FRONTIER_OUTSIDE_SUBSET; SUBSET]; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ASM SET_TAC[]]]; DISCH_THEN(fun th -> MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN ASM SET_TAC[]]);; let INSIDE_INSIDE_EQ_EMPTY = prove (`!s:real^N->bool. closed s /\ connected s ==> inside(inside s) = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[inside] THEN REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[INSIDE_OUTSIDE] THEN REWRITE_TAC[COMPL_COMPL] THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_SELF; CONNECTED_WITH_OUTSIDE] THEN REWRITE_TAC[BOUNDED_UNION] THEN MESON_TAC[UNBOUNDED_OUTSIDE]);; let INSIDE_IN_COMPONENTS = prove (`!s. (inside s) IN components((:real^N) DIFF s) <=> connected(inside s) /\ ~(inside s = {})`, X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN ASM_CASES_TAC `inside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `connected(inside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN REWRITE_TAC[INSIDE_NO_OVERLAP] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN UNDISCH_TAC `~(inside s:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[connected_component] THEN EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);; let OUTSIDE_IN_COMPONENTS = prove (`!s. (outside s) IN components((:real^N) DIFF s) <=> connected(outside s) /\ ~(outside s = {})`, X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN ASM_CASES_TAC `outside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `connected(outside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN REWRITE_TAC[OUTSIDE_NO_OVERLAP] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN UNDISCH_TAC `~(outside s:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[connected_component] THEN EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);; let BOUNDED_UNIQUE_OUTSIDE = prove (`!c s. 2 <= dimindex(:N) /\ bounded s ==> (c IN components ((:real^N) DIFF s) /\ ~bounded c <=> c = outside s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN EXISTS_TAC `(:real^N) DIFF s` THEN ASM_REWRITE_TAC[COMPL_COMPL] THEN ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]; ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]] THEN ASM_SIMP_TAC[UNBOUNDED_OUTSIDE; OUTSIDE_BOUNDED_NONEMPTY; CONNECTED_OUTSIDE]);; let EMPTY_INSIDE_PSUBSET_CONVEX_FRONTIER = prove (`!s t:real^N->bool. convex s /\ t PSUBSET frontier s ==> inside t = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[inside] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN closure s` THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))` MP_TAC THENL [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV]; REWRITE_TAC[IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX)) THEN ASM_SIMP_TAC[CONVEX_CLOSURE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]]] THEN SUBGOAL_THEN `?y:real^N. y IN frontier s /\ ~(y IN t) /\ connected_component ((:real^N) DIFF t) x = connected_component ((:real^N) DIFF t) y` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `(x:real^N) IN frontier s` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `t PSUBSET s ==> ?x. x IN s /\ ~(x IN t)`)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `(y:real^N) INSERT interior s` THEN ASM_REWRITE_TAC[IN_INSERT] THEN ASM_SIMP_TAC[IN_INSERT; CONNECTED_INSERT; CONVEX_CONNECTED; CONVEX_INTERIOR; INSERT_SUBSET; IN_DIFF; IN_UNIV] THEN SUBGOAL_THEN `(x:real^N) IN interior s /\ ~(interior s = {})` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CONVEX_CLOSURE_INTERIOR] THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]; FIRST_X_ASSUM SUBST_ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `y:real^N`] SUPPORTING_HYPERPLANE_FRONTIER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `y INSERT {u:real^N | a dot u < a dot y}` o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN ASM_REWRITE_TAC[NOT_IMP; BOUNDED_INSERT; BOUNDED_HALFSPACE_LT] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_SIMP_TAC[IN_INSERT; CONNECTED_INSERT; CONVEX_CONNECTED; CONVEX_HALFSPACE_LT; CLOSURE_HALFSPACE_LT] THEN REWRITE_TAC[INSERT_SUBSET; IN_ELIM_THM; REAL_LE_REFL] THEN ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM; REAL_NOT_LT; IN_UNIV; SET_RULE `s SUBSET UNIV DIFF t <=> !x. x IN t ==> ~(x IN s)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Homotopy of maps p,q : X->Y with property P of all intermediate maps. *) (* We often just want to require that it fixes some subset, but to take in *) (* the case of loop homotopy it's convenient to have a general property P. *) (* ------------------------------------------------------------------------- *) let homotopic_with = new_definition `homotopic_with P (X,Y) p q <=> ?h:real^(1,M)finite_sum->real^N. h continuous_on (interval[vec 0,vec 1] PCROSS X) /\ IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\ (!x. h(pastecart (vec 0) x) = p x) /\ (!x. h(pastecart (vec 1) x) = q x) /\ (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x)))`;; (* ------------------------------------------------------------------------- *) (* We often want to just localize the ending function equality or whatever. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_WITH = prove (`(!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k)) ==> (homotopic_with P (X,Y) p q <=> ?h:real^(1,M)finite_sum->real^N. h continuous_on (interval[vec 0,vec 1] PCROSS X) /\ IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\ (!x. x IN X ==> h(pastecart (vec 0) x) = p x) /\ (!x. x IN X ==> h(pastecart (vec 1) x) = q x) /\ (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x))))`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL [REWRITE_TAC[homotopic_with; PCROSS] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; REWRITE_TAC[homotopic_with; PCROSS] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` (fun th -> EXISTS_TAC `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y else if fstcart(y) = vec 0 then p(sndcart y) else q(sndcart y)` THEN MP_TAC th)) THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART]; SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[]]]);; let HOMOTOPIC_WITH_EQ = prove (`!P X Y f g f' g':real^M->real^N. homotopic_with P (X,Y) f g /\ (!x. x IN X ==> f' x = f x /\ g' x = g x) /\ (!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k)) ==> homotopic_with P (X,Y) f' g'`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[homotopic_with] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` (fun th -> EXISTS_TAC `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y else if fstcart(y) = vec 0 then f'(sndcart y) else g'(sndcart y)` THEN MP_TAC th)) THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART]; SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART]; ASM_MESON_TAC[]; ASM_MESON_TAC[]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[]]);; let HOMOTOPIC_WITH_EQUAL = prove (`!P f:real^M->real^N g s t. P f /\ P g /\ f continuous_on s /\ IMAGE f s SUBSET t /\ (!x. x IN s ==> g x = f x) ==> homotopic_with P (s,t) f g`, REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN EXISTS_TAC `\z:real^(1,M)finite_sum. if fstcart z = vec 1 then g(sndcart z):real^N else f(sndcart z)` THEN REWRITE_TAC[VEC_EQ; ARITH_EQ; SNDCART_PASTECART; FSTCART_PASTECART] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\z:real^(1,M)finite_sum. (f:real^M->real^N)(sndcart z)` THEN ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[COND_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN REWRITE_TAC[ FSTCART_PASTECART; SNDCART_PASTECART] THEN CONJ_TAC THEN X_GEN_TAC `t:real^1` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^1 = vec 1` THEN ASM_REWRITE_TAC[ETA_AX] THEN ASM SET_TAC[]]);; let HOMOTOPIC_CONSTANT_MAPS = prove (`!s:real^M->bool t:real^N->bool a b. homotopic_with (\x. T) (s,t) (\x. a) (\x. b) <=> s = {} \/ path_component t a b`, REPEAT GEN_TAC THEN SIMP_TAC[HOMOTOPIC_WITH; path_component] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES] THEN REWRITE_TAC[EMPTY_SUBSET; CONTINUOUS_ON_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY; SUBSET_EMPTY; PCROSS_EQ_EMPTY; IMAGE_EQ_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?c:real^M. c IN s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `(h:real^(1,M)finite_sum->real^N) o (\t. pastecart t c)` THEN ASM_SIMP_TAC[pathstart; pathfinish; o_THM; PATH_IMAGE_COMPOSE] THEN CONJ_TAC THENL [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); REWRITE_TAC[path_image]] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS]; REWRITE_TAC[path; pathstart; path_image; pathfinish] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:real^1->real^N) o (fstcart:real^(1,M)finite_sum->real^1)` THEN ASM_SIMP_TAC[FSTCART_PASTECART; o_THM; IMAGE_o; IMAGE_FSTCART_PCROSS] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; IMAGE_FSTCART_PCROSS]]);; (* ------------------------------------------------------------------------- *) (* Trivial properties. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_WITH_RESTRICT = prove (`!P s t s' t' f g:real^M->real^N. homotopic_with P (s,t) f g /\ s' SUBSET s /\ (!h. P h /\ IMAGE h s SUBSET t ==> IMAGE h s' SUBSET t') ==> homotopic_with P (s',t') f g`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `x:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x. (h:real^(1,M)finite_sum->real^N)(pastecart a x)`) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE [SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN ASM_SIMP_TAC[]]);; let HOMOTOPIC_WITH_IMP_PROPERTY = prove (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g ==> P f /\ P g`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; ETA_AX]);; let HOMOTOPIC_WITH_IMP_CONTINUOUS = prove (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g ==> f continuous_on X /\ g continuous_on X`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN STRIP_TAC THEN SUBGOAL_THEN `((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 0) x)) continuous_on X /\ ((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 1) x)) continuous_on X` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);; let HOMOTOPIC_WITH_IMP_SUBSET = prove (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g ==> IMAGE f X SUBSET Y /\ IMAGE g X SUBSET Y`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN DISCH_THEN (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);; let HOMOTOPIC_WITH_MONO = prove (`!P Q X Y f g:real^M->real^N. homotopic_with P (X,Y) f g /\ (!h. h continuous_on X /\ IMAGE h X SUBSET Y /\ P h ==> Q h) ==> homotopic_with Q (X,Y) f g`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[homotopic_with; PCROSS] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let HOMOTOPIC_WITH_SUBSET_LEFT = prove (`!P X Y Z f g. homotopic_with P (X,Y) f g /\ Z SUBSET X ==> homotopic_with P (Z,Y) f g`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[homotopic_with; PCROSS] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let HOMOTOPIC_WITH_SUBSET_RIGHT = prove (`!P X Y Z (f:real^M->real^N) g h. homotopic_with P (X,Y) f g /\ Y SUBSET Z ==> homotopic_with P (X,Z) f g`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM_MESON_TAC[SUBSET_TRANS]);; let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT = prove (`!p f:real^N->real^P g h:real^M->real^N W X Y. homotopic_with (\f. p(f o h)) (X,Y) f g /\ h continuous_on W /\ IMAGE h W SUBSET X ==> homotopic_with p (W,Y) (f o h) (g o h)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[homotopic_with; o_DEF; PCROSS] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^(1,N)finite_sum->real^P` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\y:real^(1,M)finite_sum. (k:real^(1,N)finite_sum->real^P) (pastecart (fstcart y) (h(sndcart y)))` THEN ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] CONTINUOUS_ON_SUBSET)); ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT = prove (`!f:real^N->real^P g h:real^M->real^N W X Y. homotopic_with (\f. T) (X,Y) f g /\ h continuous_on W /\ IMAGE h W SUBSET X ==> homotopic_with (\f. T) (W,Y) (f o h) (g o h)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `X:real^N->bool` THEN ASM_REWRITE_TAC[]);; let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT = prove (`!p f:real^M->real^N g h:real^N->real^P X Y Z. homotopic_with (\f. p(h o f)) (X,Y) f g /\ h continuous_on Y /\ IMAGE h Y SUBSET Z ==> homotopic_with p (X,Z) (h o f) (h o g)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[homotopic_with; o_DEF] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(h:real^N->real^P) o (k:real^(1,M)finite_sum->real^N)` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] CONTINUOUS_ON_SUBSET)); ALL_TAC] THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]);; let HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT = prove (`!f:real^M->real^N g h:real^N->real^P X Y Z. homotopic_with (\f. T) (X,Y) f g /\ h continuous_on Y /\ IMAGE h Y SUBSET Z ==> homotopic_with (\f. T) (X,Z) (h o f) (h o g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `Y:real^N->bool` THEN ASM_REWRITE_TAC[]);; let HOMOTOPIC_WITH_PCROSS = prove (`!f:real^M->real^N f':real^P->real^Q g g' p p' q s s' t t'. homotopic_with p (s,t) f g /\ homotopic_with p' (s',t') f' g' /\ (!f g. p f /\ p' g ==> q(\x. pastecart (f(fstcart x)) (g(sndcart x)))) ==> homotopic_with q (s PCROSS s',t PCROSS t') (\z. pastecart (f(fstcart z)) (f'(sndcart z))) (\z. pastecart (g(fstcart z)) (g'(sndcart z)))`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `k':real^(1,P)finite_sum->real^Q` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\z:real^(1,(M,P)finite_sum)finite_sum. pastecart (k(pastecart (fstcart z) (fstcart(sndcart z))):real^N) (k'(pastecart (fstcart z) (sndcart(sndcart z))):real^Q)` THEN ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS]]));; let HOMOTOPIC_ON_EMPTY = prove (`!t f g. homotopic_with (\x. T) ({},t) f g`, SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY] THEN REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Homotopy with P is an equivalence relation (on continuous functions *) (* mapping X into Y that satisfy P, though this only affects reflexivity). *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_WITH_REFL = prove (`!P X Y (f:real^M->real^N). homotopic_with P (X,Y) f f <=> f continuous_on X /\ IMAGE f X SUBSET Y /\ P f`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[HOMOTOPIC_WITH_IMP_PROPERTY; HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET]; STRIP_TAC THEN REWRITE_TAC[homotopic_with; PCROSS]] THEN EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) (sndcart y)` THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_SIMP_TAC[SNDCART_PASTECART; ETA_AX; SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART]);; let HOMOTOPIC_WITH_SYM = prove (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g <=> homotopic_with P (X,Y) g f`, REPLICATE_TAC 3 GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!x y. P x y ==> P y x) ==> (!x y. P x y <=> P y x)`) THEN REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\y:real^(1,M)finite_sum. (h:real^(1,M)finite_sum->real^N) (pastecart (vec 1 - fstcart y) (sndcart y))` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC]; REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[PASTECART_EQ] THEN REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL; DROP_SUB] THEN ASM_REAL_ARITH_TAC);; let HOMOTOPIC_WITH_TRANS = prove (`!P X Y (f:real^M->real^N) g h. homotopic_with P (X,Y) f g /\ homotopic_with P (X,Y) g h ==> homotopic_with P (X,Y) f h`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `k1:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `k2:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\y:real^(1,M)finite_sum. if drop(fstcart y) <= &1 / &2 then (k1:real^(1,M)finite_sum->real^N) (pastecart (&2 % fstcart y) (sndcart y)) else (k2:real^(1,M)finite_sum->real^N) (pastecart (&2 % fstcart y - vec 1) (sndcart y))` THEN REWRITE_TAC[FSTCART_PASTECART; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; SNDCART_PASTECART] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `interval[vec 0:real^1,vec 1] = interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{f x y | x IN s UNION t /\ y IN u} = {f x y | x IN s /\ y IN u} UNION {f x y | x IN t /\ y IN u}`] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> (a /\ b) /\ (c /\ d) /\ e`] THEN CONJ_TAC THENL [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL [EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) | t IN interval[vec 0,lift(&1 / &2)] /\ x IN UNIV }`; EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) | t IN interval[lift(&1 / &2),vec 1] /\ x IN UNIV}`] THEN SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; TAUT `(x IN (s UNION t) /\ x IN u ==> x IN v) <=> (x IN u ==> x IN (s UNION t) ==> x IN v)`] THEN REWRITE_TAC[PASTECART_EQ; IN_ELIM_THM; IN_UNION] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[MESON[] `(?t x. P t x /\ a = t /\ b = x) <=> P a b`] THEN SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN REAL_ARITH_TAC; REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_ARITH `&1 / &2 <= t ==> (t <= &1 / &2 <=> t = &1 / &2)`] THEN SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN REWRITE_TAC[GSYM LIFT_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET t ==> x IN s ==> k x IN t`)) THEN ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC; X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC]);; let HOMOTOPIC_WITH_COMPOSE = prove (`!P Q R f f':real^M->real^N g g':real^N->real^P s t u. (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\ P f /\ g continuous_on t /\ IMAGE g t SUBSET u /\ Q g ==> R(g o f)) /\ homotopic_with P (s,t) f f' /\ homotopic_with Q (t,u) g g' ==> homotopic_with R (s,u) (g o f) (g' o f')`, REPEAT STRIP_TAC THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN EXISTS_TAC `(g:real^N->real^P) o (f':real^M->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT; MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT] THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN ASM_SIMP_TAC[]; ASM_MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET]]));; let HOMOTOPIC_COMPOSE = prove (`!f f':real^M->real^N g g':real^N->real^P s t u. homotopic_with (\x. T) (s,t) f f' /\ homotopic_with (\x. T) (t,u) g g' ==> homotopic_with (\x. T) (s,u) (g o f) (g' o f')`, REPEAT GEN_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_COMPOSE) THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Two characterizations of homotopic triviality, one of which *) (* implicitly incorporates path-connectedness. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_TRIVIALITY = prove (`!s:real^M->bool t:real^N->bool. (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on s /\ IMAGE g s SUBSET t ==> homotopic_with (\x. T) (s,t) f g) <=> (s = {} \/ path_connected t) /\ (!f. f continuous_on s /\ IMAGE f s SUBSET t ==> ?c. homotopic_with (\x. T) (s,t) f (\x. c))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET]; ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; PATH_CONNECTED_EMPTY]] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) HOMOTOPIC_CONSTANT_MAPS o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; SUBGOAL_THEN `?c:real^N. c IN t` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST]; FIRST_X_ASSUM(fun th -> MP_TAC(ISPEC `g:real^M->real^N` th) THEN MP_TAC(ISPEC `f:real^M->real^N` th)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. c):real^M->real^N` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. d):real^M->real^N` THEN ASM_REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Homotopy on a union of closed-open sets. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_ON_CLOPEN_UNIONS = prove (`!f:real^M->real^N g t u. (!s. s IN u ==> closed_in (subtopology euclidean (UNIONS u)) s /\ open_in (subtopology euclidean (UNIONS u)) s /\ homotopic_with (\x. T) (s,t) f g) ==> homotopic_with (\x. T) (UNIONS u,t) f g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?v. v SUBSET u /\ COUNTABLE v /\ UNIONS v :real^M->bool = UNIONS u` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC LINDELOF_OPEN_IN THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)] THEN ASM_CASES_TAC `v:(real^M->bool)->bool = {}` THEN ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY; UNIONS_0] THEN MP_TAC(ISPEC `v:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `(f:num->real^M->bool) n`) THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM]] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homotopic_with] THEN SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; HOMOTOPIC_WITH] THEN X_GEN_TAC `h:num->real^(1,M)finite_sum->real^N` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MP_TAC(ISPECL [`h:num->real^(1,M)finite_sum->real^N`; `(\n. interval[vec 0,vec 1] PCROSS (f n DIFF UNIONS {f m | m < n})) :num->real^(1,M)finite_sum->bool`; `(interval[vec 0,vec 1] PCROSS UNIONS(IMAGE f (:num))) :real^(1,M)finite_sum->bool`; `(:num)`; `(:real^N)`] PASTING_LEMMA_EXISTS) THEN REWRITE_TAC[IN_UNIV; FORALL_AND_THM; SUBSET_UNIV; INTER_PCROSS] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; SUBSET; IN_ELIM_THM; FORALL_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_UNIV; IMP_CONJ] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MESON_TAC[]; X_GEN_TAC `n:num` THEN MATCH_MP_TAC OPEN_IN_PCROSS THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE] THEN ASM SET_TAC[]; X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC(MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET) (SPEC `n:num` th))) THEN REWRITE_TAC[SUBSET_PCROSS; SUBSET_REFL; SUBSET_DIFF]; MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[INTER_ACI] THEN MESON_TAC[]; REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN SET_TAC[]]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^(1,M)finite_sum->real^N` THEN REWRITE_TAC[INTER_ACI; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; SUBSET; RIGHT_FORALL_IMP_THM; IN_UNIV; FORALL_IN_PCROSS] THEN CONJ_TAC THENL [X_GEN_TAC `t:real^1` THEN DISCH_TAC; CONJ_TAC] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^1`; `y:real^M`; `n:num`]); FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `y:real^M`; `n:num`]); FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1:real^1`; `y:real^M`; `n:num`])] THEN ASM_REWRITE_TAC[IN_INTER; UNIONS_IMAGE; IN_UNIV; IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);; let INESSENTIAL_ON_CLOPEN_UNIONS = prove (`!f:real^M->real^N t u. path_connected t /\ (!s. s IN u ==> closed_in (subtopology euclidean (UNIONS u)) s /\ open_in (subtopology euclidean (UNIONS u)) s /\ ?a. homotopic_with (\x. T) (s,t) f (\x. a)) ==> ?a. homotopic_with (\x. T) (UNIONS u,t) f (\x. a)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `UNIONS u:real^M->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; HOMOTOPIC_ON_EMPTY] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EMPTY_UNIONS]) THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `a:real^N` THEN MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN X_GEN_TAC `s:real^M->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY] THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]);; (* ------------------------------------------------------------------------- *) (* Homotopy of paths, maintaining the same endpoints. *) (* ------------------------------------------------------------------------- *) let homotopic_paths = new_definition `homotopic_paths s p q = homotopic_with (\r. pathstart r = pathstart p /\ pathfinish r = pathfinish p) (interval[vec 0:real^1,vec 1],s) p q`;; let HOMOTOPIC_PATHS = prove (`!s p q:real^1->real^N. homotopic_paths s p q <=> ?h. h continuous_on interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\ IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) SUBSET s /\ (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\ (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\ (!t. t IN interval[vec 0:real^1,vec 1] ==> pathstart(h o pastecart t) = pathstart p /\ pathfinish(h o pastecart t) = pathfinish p)`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; let HOMOTOPIC_PATHS_IMP_PATHSTART = prove (`!s p q. homotopic_paths s p q ==> pathstart p = pathstart q`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[]);; let HOMOTOPIC_PATHS_IMP_PATHFINISH = prove (`!s p q. homotopic_paths s p q ==> pathfinish p = pathfinish q`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[]);; let HOMOTOPIC_PATHS_IMP_PATH = prove (`!s p q. homotopic_paths s p q ==> path p /\ path q`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN SIMP_TAC[path]);; let HOMOTOPIC_PATHS_IMP_SUBSET = prove (`!s p q. homotopic_paths s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN SIMP_TAC[path_image]);; let HOMOTOPIC_PATHS_REFL = prove (`!s p. homotopic_paths s p p <=> path p /\ path_image p SUBSET s`, REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_REFL; path; path_image]);; let HOMOTOPIC_PATHS_SYM = prove (`!s p q. homotopic_paths s p q <=> homotopic_paths s q p`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_SIMP_TAC[homotopic_paths]);; let HOMOTOPIC_PATHS_TRANS = prove (`!s p q r. homotopic_paths s p q /\ homotopic_paths s q r ==> homotopic_paths s p r`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(CONJUNCTS_THEN (fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART th) THEN ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH th))) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINOP_CONV [homotopic_paths]) THEN ASM_REWRITE_TAC[HOMOTOPIC_WITH_TRANS; homotopic_paths]);; let HOMOTOPIC_PATHS_EQ = prove (`!p:real^1->real^N q s. path p /\ path_image p SUBSET s /\ (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t)) ==> homotopic_paths s p q`, REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_paths] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN REWRITE_TAC[pathstart; pathfinish] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);; let HOMOTOPIC_PATHS_REPARAMETRIZE = prove (`!p:real^1->real^N q f:real^1->real^1. path p /\ path_image p SUBSET s /\ (?f. f continuous_on interval[vec 0,vec 1] /\ IMAGE f (interval[vec 0,vec 1]) SUBSET interval[vec 0,vec 1] /\ f(vec 0) = vec 0 /\ f(vec 1) = vec 1 /\ !t. t IN interval[vec 0,vec 1] ==> q(t) = p(f t)) ==> homotopic_paths s p q`, REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN ASM_SIMP_TAC[o_THM; pathstart; pathfinish; o_THM; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN REWRITE_TAC[path; path_image] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN EXISTS_TAC `(p:real^1->real^N) o (\y. (&1 - drop(fstcart y)) % f(sndcart y) + drop(fstcart y) % sndcart y)` THEN ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; pathstart; pathfinish] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_LID; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_SUB] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))]; ONCE_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE p i SUBSET s ==> IMAGE f x SUBSET i ==> IMAGE p (IMAGE f x) SUBSET s`))] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART; FSTCART_PASTECART] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] (CONJUNCT1(SPEC_ALL CONVEX_INTERVAL))) THEN ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET; IN_IMAGE]]);; let HOMOTOPIC_PATHS_SUBSET = prove (`!s p q. homotopic_paths s p q /\ s SUBSET t ==> homotopic_paths t p q`, REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_SUBSET_RIGHT]);; (* ------------------------------------------------------------------------- *) (* A slightly ad-hoc but useful lemma in constructing homotopies. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_JOIN_LEMMA = prove (`!p q:real^1->real^1->real^N. (\y. p (fstcart y) (sndcart y)) continuous_on (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\ (\y. q (fstcart y) (sndcart y)) continuous_on (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\ (!t. t IN interval[vec 0,vec 1] ==> pathfinish(p t) = pathstart(q t)) ==> (\y. (p(fstcart y) ++ q(fstcart y)) (sndcart y)) continuous_on (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])`, REWRITE_TAC[joinpaths; PCROSS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `(\y. p (fstcart y) (&2 % sndcart y)):real^(1,1)finite_sum->real^N = (\y. p (fstcart y) (sndcart y)) o (\y. pastecart (fstcart y) (&2 % sndcart y))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC]; SUBGOAL_THEN `(\y. q (fstcart y) (&2 % sndcart y - vec 1)):real^(1,1)finite_sum->real^N = (\y. q (fstcart y) (sndcart y)) o (\y. pastecart (fstcart y) (&2 % sndcart y - vec 1))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC]; SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; ETA_AX]; SIMP_TAC[IMP_CONJ; FORALL_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART; GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[LIFT_NUM; VECTOR_SUB_REFL]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART; ALL_TAC]) THEN SIMP_TAC[CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ] THEN SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Congruence properties of homotopy w.r.t. path-combining operations. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_PATHS_REVERSEPATH = prove (`!s p q:real^1->real^N. homotopic_paths s (reversepath p) (reversepath q) <=> homotopic_paths s p q`, GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!p. f(f p) = p) /\ (!a b. homotopic_paths s a b ==> homotopic_paths s (f a) (f b)) ==> !a b. homotopic_paths s (f a) (f b) <=> homotopic_paths s a b`) THEN REWRITE_TAC[REVERSEPATH_REVERSEPATH] THEN REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS; o_DEF] THEN DISCH_THEN (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\y:real^(1,1)finite_sum. (h:real^(1,1)finite_sum->real^N) (pastecart(fstcart y) (vec 1 - sndcart y))` THEN ASM_REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[reversepath; pathstart; pathfinish; VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]);; let HOMOTOPIC_PATHS_JOIN = prove (`!s p q p' q':real^1->real^N. homotopic_paths s p p' /\ homotopic_paths s q q' /\ pathfinish p = pathstart q ==> homotopic_paths s (p ++ q) (p' ++ q')`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `k1:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `k2:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(\y. ((k1 o pastecart (fstcart y)) ++ (k2 o pastecart (fstcart y))) (sndcart y)) :real^(1,1)finite_sum->real^N` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN ASM_REWRITE_TAC[o_DEF; PASTECART_FST_SND; ETA_AX] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[pathstart; pathfinish] THEN ASM_MESON_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; o_DEF] THEN ASM SET_TAC[]; ALL_TAC; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[joinpaths; o_DEF] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; VECTOR_MUL_RZERO]);; let HOMOTOPIC_PATHS_CONTINUOUS_IMAGE = prove (`!f:real^1->real^M g h:real^M->real^N s t. homotopic_paths s f g /\ h continuous_on s /\ IMAGE h s SUBSET t ==> homotopic_paths t (h o f) (h o g)`, REWRITE_TAC[homotopic_paths] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN SIMP_TAC[pathstart; pathfinish; o_THM]);; (* ------------------------------------------------------------------------- *) (* Group properties for homotopy of paths (so taking equivalence classes *) (* under homotopy would give the fundamental group). *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_PATHS_RID = prove (`!s p. path p /\ path_image p SUBSET s ==> homotopic_paths s (p ++ linepath(pathfinish p,pathfinish p)) p`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN ASM_REWRITE_TAC[joinpaths] THEN EXISTS_TAC `\t. if drop t <= &1 / &2 then &2 % t else vec 1` THEN ASM_REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_RZERO; linepath; pathfinish; VECTOR_ARITH `(&1 - t) % x + t % x:real^N = x`] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN CONJ_TAC THENL [SUBGOAL_THEN `interval[vec 0:real^1,vec 1] = interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_CASES THEN SIMP_TAC[CLOSED_INTERVAL; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; IN_INTERVAL_1; DROP_VEC; LIFT_DROP; GSYM DROP_EQ; DROP_CMUL] THEN REAL_ARITH_TAC]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);; let HOMOTOPIC_PATHS_LID = prove (`!s p:real^1->real^N. path p /\ path_image p SUBSET s ==> homotopic_paths s (linepath(pathstart p,pathstart p) ++ p) p`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN REWRITE_TAC[o_DEF; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH; PATHFINISH_LINEPATH] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p :real^1->real^N`] HOMOTOPIC_PATHS_RID) THEN ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);; let HOMOTOPIC_PATHS_ASSOC = prove (`!s p q r:real^1->real^N. path p /\ path_image p SUBSET s /\ path q /\ path_image q SUBSET s /\ path r /\ path_image r SUBSET s /\ pathfinish p = pathstart q /\ pathfinish q = pathstart r ==> homotopic_paths s (p ++ (q ++ r)) ((p ++ q) ++ r)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET; PATHSTART_JOIN; PATHFINISH_JOIN] THEN REWRITE_TAC[joinpaths] THEN EXISTS_TAC `\t. if drop t <= &1 / &2 then inv(&2) % t else if drop t <= &3 / &4 then t - lift(&1 / &4) else &2 % t - vec 1` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; LIFT_DROP] THEN REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REWRITE_TAC[DROP_CMUL; DROP_VEC; LIFT_DROP; DROP_SUB] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_RZERO]; REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC; X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[DROP_CMUL] THEN ASM_REWRITE_TAC[REAL_ARITH `inv(&2) * t <= &1 / &2 <=> t <= &1`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN ASM_CASES_TAC `drop t <= &3 / &4` THEN ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP; REAL_ARITH `&2 * (t - &1 / &4) <= &1 / &2 <=> t <= &1 / &2`; REAL_ARITH `&2 * t - &1 <= &1 / &2 <=> t <= &3 / &4`; REAL_ARITH `t - &1 / &4 <= &1 / &2 <=> t <= &3 / &4`] THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN REWRITE_TAC[VECTOR_ARITH `a - b - b:real^N = a - &2 % b`]]);; let HOMOTOPIC_PATHS_RINV = prove (`!s p:real^1->real^N. path p /\ path_image p SUBSET s ==> homotopic_paths s (p ++ reversepath p) (linepath(pathstart p,pathstart p))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN EXISTS_TAC `(\y. (subpath (vec 0) (fstcart y) p ++ reversepath(subpath (vec 0) (fstcart y) p)) (sndcart y)) : real^(1,1)finite_sum->real^N` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL] THEN REWRITE_TAC[ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN] THEN REWRITE_TAC[REVERSEPATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[joinpaths] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_CMUL]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC; DROP_ADD; REAL_ARITH `t + (&0 - t) * (&2 * x - &1) = t * &2 * (&1 - x)`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN ASM_REAL_ARITH_TAC]; SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[subpath] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_VEC; DROP_ADD; DROP_CMUL; LIFT_DROP] THEN REAL_ARITH_TAC]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX; SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN REWRITE_TAC[GSYM path_image] THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [path_image]) THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ u SUBSET s ==> IMAGE p s SUBSET v ==> IMAGE p t SUBSET v /\ IMAGE p u SUBSET v`) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]; REWRITE_TAC[subpath; linepath; pathstart; joinpaths] THEN REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN REWRITE_TAC[VECTOR_ADD_RID; COND_ID] THEN VECTOR_ARITH_TAC; REWRITE_TAC[pathstart; PATHFINISH_LINEPATH; PATHSTART_LINEPATH]]);; let HOMOTOPIC_PATHS_LINV = prove (`!s p:real^1->real^N. path p /\ path_image p SUBSET s ==> homotopic_paths s (reversepath p ++ p) (linepath(pathfinish p,pathfinish p))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p:real^1->real^N`] HOMOTOPIC_PATHS_RINV) THEN ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; REVERSEPATH_REVERSEPATH]);; let HOMOTOPIC_PATHS_LCANCEL = prove (`!p q r s:real^N->bool. homotopic_paths s (p ++ q) (p ++ r) /\ pathstart q = pathfinish p /\ pathstart r = pathfinish p ==> homotopic_paths s q r`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `homotopic_paths (s:real^N->bool) (reversepath p ++ p ++ q) (reversepath p ++ p ++ r)` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[PATHFINISH_REVERSEPATH; PATHSTART_JOIN] THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH]; MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS] `homotopic_paths s p p' /\ homotopic_paths s q q' ==> homotopic_paths s p q ==> homotopic_paths s p' q'`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (rator o rand) HOMOTOPIC_PATHS_ASSOC o rator o snd) THEN ASM_REWRITE_TAC[PATH_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN MP_TAC(ISPEC `s:real^N->bool` HOMOTOPIC_PATHS_LID) THENL [DISCH_THEN(MP_TAC o SPEC `q:real^1->real^N`); DISCH_THEN(MP_TAC o SPEC `r:real^1->real^N`)] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_TRANS) THEN MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHFINISH_JOIN] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_LINV THEN ASM_REWRITE_TAC[]]);; let HOMOTOPIC_PATHS_LCANCEL_EQ = prove (`!p q r s:real^N->bool. pathstart q = pathfinish p /\ pathstart r = pathfinish p ==> (homotopic_paths s (p ++ q) (p ++ r) <=> path p /\ path_image p SUBSET s /\ homotopic_paths s q r)`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_JOIN; HOMOTOPIC_PATHS_REFL] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_LCANCEL]);; let HOMOTOPIC_PATHS_RCANCEL = prove (`!p q r s:real^N->bool. homotopic_paths s (p ++ r) (q ++ r) /\ pathfinish p = pathstart r /\ pathfinish q = pathstart r ==> homotopic_paths s p q`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `homotopic_paths (s:real^N->bool) ((p ++ r) ++ reversepath r) ((q ++ r) ++ reversepath r)` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH]; MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS] `homotopic_paths s p p' /\ homotopic_paths s q q' ==> homotopic_paths s p q ==> homotopic_paths s p' q'`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (rator o rand) (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] HOMOTOPIC_PATHS_ASSOC) o rator o snd) THEN ASM_REWRITE_TAC[PATH_REVERSEPATH; PATHSTART_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN MP_TAC(ISPEC `s:real^N->bool` HOMOTOPIC_PATHS_RID) THENL [DISCH_THEN(MP_TAC o SPEC `p:real^1->real^N`); DISCH_THEN(MP_TAC o SPEC `q:real^1->real^N`)] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_TRANS) THEN MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_JOIN] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN ASM_REWRITE_TAC[]]);; let HOMOTOPIC_PATHS_RCANCEL_EQ = prove (`!p q r s:real^N->bool. pathfinish p = pathstart r /\ pathfinish q = pathstart r ==> (homotopic_paths s (p ++ r) (q ++ r) <=> homotopic_paths s p q /\ path r /\ path_image r SUBSET s)`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_JOIN; HOMOTOPIC_PATHS_REFL] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_RCANCEL]);; (* ------------------------------------------------------------------------- *) (* Homotopy of loops without requiring preservation of endpoints. *) (* ------------------------------------------------------------------------- *) let homotopic_loops = new_definition `homotopic_loops s p q = homotopic_with (\r. pathfinish r = pathstart r) (interval[vec 0:real^1,vec 1],s) p q`;; let HOMOTOPIC_LOOPS = prove (`!s p q:real^1->real^N. homotopic_loops s p q <=> ?h. h continuous_on interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\ IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) SUBSET s /\ (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\ (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\ (!t. t IN interval[vec 0:real^1,vec 1] ==> pathfinish(h o pastecart t) = pathstart(h o pastecart t))`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; let HOMOTOPIC_LOOPS_IMP_LOOP = prove (`!s p q. homotopic_loops s p q ==> pathfinish p = pathstart p /\ pathfinish q = pathstart q`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[]);; let HOMOTOPIC_LOOPS_IMP_PATH = prove (`!s p q. homotopic_loops s p q ==> path p /\ path q`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN SIMP_TAC[path]);; let HOMOTOPIC_LOOPS_IMP_SUBSET = prove (`!s p q. homotopic_loops s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN SIMP_TAC[path_image]);; let HOMOTOPIC_LOOPS_REFL = prove (`!s p. homotopic_loops s p p <=> path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p`, REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_REFL; path; path_image]);; let HOMOTOPIC_LOOPS_SYM = prove (`!s p q. homotopic_loops s p q <=> homotopic_loops s q p`, REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SYM]);; let HOMOTOPIC_LOOPS_TRANS = prove (`!s p q r. homotopic_loops s p q /\ homotopic_loops s q r ==> homotopic_loops s p r`, REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_TRANS]);; let HOMOTOPIC_LOOPS_SUBSET = prove (`!s p q. homotopic_loops s p q /\ s SUBSET t ==> homotopic_loops t p q`, REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SUBSET_RIGHT]);; let HOMOTOPIC_LOOPS_EQ = prove (`!p:real^1->real^N q s. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\ (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t)) ==> homotopic_loops s p q`, REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_loops] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN REWRITE_TAC[pathstart; pathfinish] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);; let HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE = prove (`!f:real^1->real^M g h:real^M->real^N s t. homotopic_loops s f g /\ h continuous_on s /\ IMAGE h s SUBSET t ==> homotopic_loops t (h o f) (h o g)`, REWRITE_TAC[homotopic_loops] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN SIMP_TAC[pathstart; pathfinish; o_THM]);; let HOMOTOPIC_LOOPS_SHIFTPATH_SELF = prove (`!p:real^1->real^N t s. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\ t IN interval[vec 0,vec 1] ==> homotopic_loops s p (shiftpath t p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_LOOPS] THEN EXISTS_TAC `\z. shiftpath (drop t % fstcart z) (p:real^1->real^N) (sndcart z)` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_DEF] THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO; ETA_AX] THEN REPEAT CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN MATCH_MP_TAC(SET_RULE `IMAGE p t SUBSET u /\ (!x. x IN s ==> IMAGE(shiftpath (f x) p) t = IMAGE p t) ==> (!x y. x IN s /\ y IN t ==> shiftpath (f x) p y IN u)`) THEN ASM_REWRITE_TAC[GSYM path_image] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_IMAGE_SHIFTPATH THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[REAL_LE_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]; SIMP_TAC[shiftpath; VECTOR_ADD_LID; IN_INTERVAL_1; DROP_VEC]; REWRITE_TAC[LIFT_DROP]; X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_SHIFTPATH THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[REAL_LE_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]] THEN REWRITE_TAC[shiftpath; DROP_ADD; DROP_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_CONST] THEN RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL] THEN SIMP_TAC[REAL_ARITH `&0 <= x + y - &1 <=> &1 <= x + y`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `t * x <= &1 * &1 /\ y <= &1 ==> t * x + y - &1 <= &1`) THEN ASM_SIMP_TAC[REAL_LE_MUL2; REAL_POS]; REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_CMUL; LIFT_DROP; LIFT_NUM; VECTOR_ARITH `a + b - c:real^1 = (a + b) - c`] THEN ASM_MESON_TAC[VECTOR_SUB_REFL; pathstart; pathfinish]]);; (* ------------------------------------------------------------------------- *) (* Relations between the two variants of homotopy. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS = prove (`!s p q. homotopic_paths s p q /\ pathfinish p = pathstart p /\ pathfinish q = pathstart p ==> homotopic_loops s p q`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[homotopic_paths; homotopic_loops] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_MONO) THEN ASM_SIMP_TAC[]);; let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL = prove (`!s p a:real^N. homotopic_loops s p (linepath(a,a)) ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMOTOPIC_PATHS_RID; HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `linepath(pathstart p,pathstart p) ++ (p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)`] HOMOTOPIC_PATHS_LID) THEN REWRITE_TAC[PATHSTART_JOIN] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[PATH_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `((\u. (h:real^(1,1)finite_sum->real^N) (pastecart u (vec 0))) ++ linepath(a,a) ++ reversepath(\u. h (pastecart u (vec 0))))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_LID; HOMOTOPIC_PATHS_JOIN; HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_RINV] `(path p /\ path(reversepath p)) /\ (path_image p SUBSET s /\ path_image(reversepath p) SUBSET s) /\ (pathfinish p = pathstart(linepath(b,b) ++ reversepath p) /\ pathstart(reversepath p) = b) /\ pathstart p = a ==> homotopic_paths s (p ++ linepath(b,b) ++ reversepath p) (linepath(a,a))`) THEN REWRITE_TAC[PATHSTART_REVERSEPATH; PATHSTART_JOIN; PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATHSTART_LINEPATH] THEN ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish; LINEPATH_REFL] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; ENDS_IN_UNIT_INTERVAL]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; ENDS_IN_UNIT_INTERVAL]]] THEN REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN EXISTS_TAC `\y:real^(1,1)finite_sum. (subpath (vec 0) (fstcart y) (\u. h(pastecart u (vec 0))) ++ (\u. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart y) u)) ++ subpath (fstcart y) (vec 0) (\u. h(pastecart u (vec 0)))) (sndcart y)` THEN ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL; SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[pathstart]] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN ASM_REWRITE_TAC[PASTECART_FST_SND; ETA_AX] THEN CONJ_TAC THENL [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_SIMP_TAC[pathstart; pathfinish]]; RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN REWRITE_TAC[PATHFINISH_SUBPATH; PATHSTART_JOIN] THEN ASM_SIMP_TAC[pathstart]] THEN REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; VECTOR_ADD_LID] THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; LIFT_DROP; CONTINUOUS_ON_NEG; DROP_NEG; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; LIFT_NEG; o_DEF; ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_NEG; DROP_VEC; DROP_CMUL; REAL_POS] THEN SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH `t + --t * x = t * (&1 - x)`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `t * x <= t * &1 /\ &1 * t <= &1 * &1 ==> t * x <= &1`) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN REWRITE_TAC[GSYM path_image; ETA_AX] THEN REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN REWRITE_TAC[path_image; subpath] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; DROP_ADD] THEN REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; REAL_POS] THEN REWRITE_TAC[REAL_ARITH `t + (&0 - t) * x = t * (&1 - x)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]);; let HOMOTOPIC_LOOPS_CONJUGATE = prove (`!p q s:real^N->bool. path p /\ path_image p SUBSET s /\ path q /\ path_image q SUBSET s /\ pathfinish p = pathstart q /\ pathfinish q = pathstart q ==> homotopic_loops s (p ++ q ++ reversepath p) q`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `linepath(pathstart q,pathstart q) ++ (q:real^1->real^N) ++ linepath(pathstart q,pathstart q)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN MP_TAC(ISPECL [`s:real^N->bool`; `(q:real^1->real^N) ++ linepath(pathfinish q,pathfinish q)`] HOMOTOPIC_PATHS_LID) THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; UNION_SUBSET; SING_SUBSET; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; PATH_JOIN; PATH_IMAGE_JOIN; PATH_LINEPATH; SEGMENT_REFL] THEN ANTS_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_RID]] THEN REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN EXISTS_TAC `(\y. (subpath (fstcart y) (vec 1) p ++ q ++ subpath (vec 1) (fstcart y) p) (sndcart y)):real^(1,1)finite_sum->real^N` THEN ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL; SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN REPEAT CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[SNDCART_PASTECART]; ALL_TAC; REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_REWRITE_TAC[pathfinish]]; REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_SUBPATH] THEN ASM_REWRITE_TAC[pathstart]] THEN REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN (CONJ_TAC THENL [REWRITE_TAC[DROP_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; DROP_CMUL]]) THENL [REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `t + (&1 - t) * x <= &1 <=> (&1 - t) * x <= (&1 - t) * &1`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; REPEAT STRIP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x * (&1 - t) <= x * &1 /\ x <= &1 ==> &0 <= &1 + (t - &1) * x`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `a + (t - &1) * x <= a <=> &0 <= (&1 - t) * x`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN REPEAT STRIP_TAC THEN REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image p:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);; (* ------------------------------------------------------------------------- *) (* Relating homotopy of trivial loops to path-connectedness. *) (* ------------------------------------------------------------------------- *) let PATH_COMPONENT_IMP_HOMOTOPIC_POINTS = prove (`!s a b:real^N. path_component s a b ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`, REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN REPEAT GEN_TAC THEN REWRITE_TAC[pathstart; pathfinish; path_image; path] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\y:real^(1,1)finite_sum. (g(fstcart y):real^N)` THEN ASM_SIMP_TAC[FSTCART_PASTECART; linepath] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % a:real^N = a`] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; FSTCART_PASTECART]);; let HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE = prove (`!s p q:real^1->real^N t. homotopic_loops s p q /\ t IN interval[vec 0,vec 1] ==> path_component s (p t) (q t)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` MP_TAC) THEN STRIP_TAC THEN EXISTS_TAC `\u. (h:real^(1,1)finite_sum->real^N) (pastecart u t)` THEN ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL [REWRITE_TAC[path] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ASM SET_TAC[]]; REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);; let HOMOTOPIC_POINTS_EQ_PATH_COMPONENT = prove (`!s a b:real^N. homotopic_loops s (linepath(a,a)) (linepath(b,b)) <=> path_component s a b`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[PATH_COMPONENT_IMP_HOMOTOPIC_POINTS] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE)) THEN REWRITE_TAC[linepath; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);; let PATH_CONNECTED_EQ_HOMOTOPIC_POINTS = prove (`!s:real^N->bool. path_connected s <=> !a b. a IN s /\ b IN s ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`, GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN REWRITE_TAC[path_connected; path_component]);; (* ------------------------------------------------------------------------- *) (* Homotopy of "nearby" function, paths and loops. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_WITH_LINEAR = prove (`!f g:real^M->real^N s t. f continuous_on s /\ g continuous_on s /\ (!x. x IN s ==> segment[f x,g x] SUBSET t) ==> homotopic_with (\z. T) (s,t) f g`, REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN EXISTS_TAC `\y. ((&1 - drop(fstcart y)) % (f:real^M->real^N)(sndcart y) + drop(fstcart y) % g(sndcart y):real^N)` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_SUB_RZERO] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; ETA_AX] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[SNDCART_PASTECART; FORALL_IN_PCROSS]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^M`] THEN STRIP_TAC THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^M` THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]);; let HOMOTOPIC_PATHS_LINEAR,HOMOTOPIC_LOOPS_LINEAR = (CONJ_PAIR o prove) (`(!g s:real^N->bool h. path g /\ path h /\ pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s) ==> homotopic_paths s g h) /\ (!g s:real^N->bool h. path g /\ path h /\ pathfinish g = pathstart g /\ pathfinish h = pathstart h /\ (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s) ==> homotopic_loops s g h)`, CONJ_TAC THEN (REWRITE_TAC[pathstart; pathfinish] THEN REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_paths; homotopic_loops; homotopic_with; PCROSS] THEN EXISTS_TAC `\y:real^(1,1)finite_sum. ((&1 - drop(fstcart y)) % g(sndcart y) + drop(fstcart y) % h(sndcart y):real^N)` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN ASM_REWRITE_TAC[pathstart; pathfinish; REAL_SUB_REFL; REAL_SUB_RZERO] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; ETA_AX] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[SNDCART_PASTECART]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^1`] THEN STRIP_TAC THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^1` THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]));; let HOMOTOPIC_PATHS_NEARBY_EXPLICIT, HOMOTOPIC_LOOPS_NEARBY_EXPLICIT = (CONJ_PAIR o prove) (`(!g s:real^N->bool h. path g /\ path h /\ pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s) ==> norm(h t - g t) < norm(g t - x)) ==> homotopic_paths s g h) /\ (!g s:real^N->bool h. path g /\ path h /\ pathfinish g = pathstart g /\ pathfinish h = pathstart h /\ (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s) ==> norm(h t - g t) < norm(g t - x)) ==> homotopic_loops s g h)`, ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR; MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:real^1` THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN MP_TAC(ISPECL [`(g:real^1->real^N) t`; `(h:real^1->real^N) t`] DIST_IN_CLOSED_SEGMENT) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN REWRITE_TAC[segment; FORALL_IN_GSPEC; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN ASM_MESON_TAC[]);; let HOMOTOPIC_NEARBY_PATHS,HOMOTOPIC_NEARBY_LOOPS = (CONJ_PAIR o prove) (`(!g s:real^N->bool. path g /\ open s /\ path_image g SUBSET s ==> ?e. &0 < e /\ !h. path h /\ pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e) ==> homotopic_paths s g h) /\ (!g s:real^N->bool. path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s ==> ?e. &0 < e /\ !h. path h /\ pathfinish h = pathstart h /\ (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e) ==> homotopic_loops s g h)`, CONJ_TAC THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`path_image g:real^N->bool`; `(:real^N) DIFF s`] SEPARATE_COMPACT_CLOSED) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN (ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV; dist]]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT; MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT] THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[path_image] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Homotopy of non-antipodal sphere maps. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS = prove (`!f g:real^M->real^N s a r. f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ g continuous_on s /\ IMAGE g s SUBSET sphere(a,r) /\ (!x. x IN s ==> ~(midpoint(f x,g x) = a)) ==> homotopic_with (\x. T) (s,sphere(a,r)) f g`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN REPEAT(EXISTS_TAC `g:real^M->real^N`) THEN ASM_REWRITE_TAC[HOMOTOPIC_WITH_REFL] THEN SUBGOAL_THEN `?c:real^N. sphere(a,r) SUBSET {c}` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; SPHERE_EMPTY; REAL_LT_LE] THEN MESON_TAC[SUBSET_REFL; EMPTY_SUBSET]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN STRIP_TAC] THEN SUBGOAL_THEN `homotopic_with (\z. T) (s:real^M->bool,(:real^N) DELETE a) f g` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE a <=> ~(a IN s)`] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE; IMP_IMP] THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN FIRST_X_ASSUM(MP_TAC o GSYM o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; MIDPOINT_BETWEEN] THEN MESON_TAC[DIST_SYM]; ALL_TAC] THEN DISCH_THEN(MP_TAC o ISPECL [`\y:real^N. a + r / norm(y - a) % (y - a)`; `sphere(a:real^N,r)`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[real_div; o_DEF; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[IN_DELETE; NORM_EQ_0; VECTOR_SUB_EQ] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE; IN_SPHERE] THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b`] THEN SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[real_abs; REAL_LE_RMUL; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ; REAL_LT_IMP_LE]]; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE]) THEN ASM_SIMP_TAC[NORM_ARITH `norm(a - b:real^N) = dist(b,a)`] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC]);; let HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS = prove (`!f g:real^M->real^N s r. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,r) /\ g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,r) /\ (!x. x IN s ==> ~(f x = --g x)) ==> homotopic_with (\x. T) (s,sphere(vec 0,r)) f g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS THEN ASM_REWRITE_TAC[midpoint; VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`]);; (* ------------------------------------------------------------------------- *) (* Retracts, in a general sense, preserve (co)homotopic triviality. *) (* ------------------------------------------------------------------------- *) let HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. (h continuous_on s /\ IMAGE h s = t /\ k continuous_on t /\ IMAGE k t SUBSET s /\ (!y. y IN t ==> h(k y) = y) /\ (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\ (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\ (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\ (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ P f /\ g continuous_on u /\ IMAGE g u SUBSET s /\ P g ==> homotopic_with P (u,s) f g) ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f /\ g continuous_on u /\ IMAGE g u SUBSET t /\ Q g ==> homotopic_with Q (u,t) f g)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`p:real^P->real^N`; `q:real^P->real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(k:real^N->real^M) o (p:real^P->real^N)`; `(k:real^N->real^M) o (q:real^P->real^N)`]) THEN ANTS_TAC THENL [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`; `(h:real^M->real^N) o (k:real^N->real^M) o (q:real^P->real^N)`] THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN ASM_SIMP_TAC[]);; let HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. (h continuous_on s /\ IMAGE h s = t /\ k continuous_on t /\ IMAGE k t SUBSET s /\ (!y. y IN t ==> h(k y) = y) /\ (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\ (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\ (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\ (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> ?c. homotopic_with P (u,s) f (\x. c)) ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> ?c. homotopic_with Q (u,t) f (\x. c))`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^P->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(k:real^N->real^M) o (p:real^P->real^N)`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[IMAGE_o] THEN CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_TAC `c:real^M`)] THEN EXISTS_TAC `(h:real^M->real^N) c` THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`; `(h:real^M->real^N) o ((\x. c):real^P->real^M)`] THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN ASM_SIMP_TAC[]);; let COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. (h continuous_on s /\ IMAGE h s = t /\ k continuous_on t /\ IMAGE k t SUBSET s /\ (!y. y IN t ==> h(k y) = y) /\ (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\ (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\ (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\ (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ P f /\ g continuous_on s /\ IMAGE g s SUBSET u /\ P g ==> homotopic_with P (s,u) f g) ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f /\ g continuous_on t /\ IMAGE g t SUBSET u /\ Q g ==> homotopic_with Q (t,u) f g)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`p:real^N->real^P`; `q:real^N->real^P`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(p:real^N->real^P) o (h:real^M->real^N)`; `(q:real^N->real^P) o (h:real^M->real^N)`]) THEN ANTS_TAC THENL [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`; `((q:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`] THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN ASM_SIMP_TAC[]);; let COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. (h continuous_on s /\ IMAGE h s = t /\ k continuous_on t /\ IMAGE k t SUBSET s /\ (!y. y IN t ==> h(k y) = y) /\ (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\ (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\ (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\ (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> ?c. homotopic_with P (s,u) f (\x. c)) ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> ?c. homotopic_with Q (t,u) f (\x. c))`, REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^N->real^P` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^N->real^P) o (h:real^M->real^N)`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[IMAGE_o] THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`; `((\x. c):real^M->real^P) o (k:real^N->real^M)`] THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Another useful lemma. *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_JOIN_SUBPATHS = prove (`!g:real^1->real^N s. path g /\ path_image g SUBSET s /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ w IN interval[vec 0,vec 1] ==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`, let lemma1 = prove (`!g:real^1->real^N s. drop u <= drop v /\ drop v <= drop w ==> path g /\ path_image g SUBSET s /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ w IN interval[vec 0,vec 1] /\ drop u <= drop v /\ drop v <= drop w ==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN EXISTS_TAC `path_image g:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `w:real^1 = u` THENL [MP_TAC(ISPECL [`path_image g:real^N->bool`; `subpath u v (g:real^1->real^N)`] HOMOTOPIC_PATHS_RINV) THEN ASM_REWRITE_TAC[REVERSEPATH_SUBPATH; SUBPATH_REFL] THEN REWRITE_TAC[LINEPATH_REFL; PATHSTART_SUBPATH] THEN ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET]; ALL_TAC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN EXISTS_TAC `\t. if drop t <= &1 / &2 then inv(drop(w - u)) % (&2 * drop(v - u)) % t else inv(drop(w - u)) % ((v - u) + drop(w - v) % (&2 % t - vec 1))` THEN REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP; GSYM LIFT_NUM; DROP_ADD; DROP_SUB] THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) [CONTINUOUS_ON_MUL; o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ADD] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC; SUBGOAL_THEN `drop u < drop w` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_SUB] THEN ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN (CONJ_TAC THENL [REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[REAL_ARITH `v - u + x * t <= w - u <=> x * t <= w - v`; REAL_ARITH `(&2 * x) * t = x * &2 * t`] THEN MATCH_MP_TAC(REAL_ARITH `a * t <= a * &1 /\ a <= b ==> a * t <= b`) THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; ALL_TAC]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `(v - u) + (w - v) * &1 = w - u`] THEN ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; REAL_MUL_LINV]; X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[subpath; joinpaths] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; DROP_EQ_0; VECTOR_SUB_EQ] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN REAL_ARITH_TAC]) in let lemma2 = prove (`path g /\ path_image g SUBSET s /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ w IN interval[vec 0,vec 1] /\ homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g) ==> homotopic_paths s (subpath w v g ++ subpath v u g) (subpath w u g)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]) in let lemma3 = prove (`path (g:real^1->real^N) /\ path_image g SUBSET s /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ w IN interval[vec 0,vec 1] /\ homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g) ==> homotopic_paths s (subpath v w g ++ subpath w u g) (subpath v u g)`, let tac = ASM_MESON_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_SUBPATH; HOMOTOPIC_PATHS_REFL; PATH_IMAGE_SUBPATH_SUBSET; SUBSET_TRANS; PATHSTART_JOIN; PATHFINISH_JOIN] in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN ASM_REWRITE_TAC[REVERSEPATH_SUBPATH] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `(subpath u v g ++ subpath v w g) ++ subpath w v g:real^1->real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN tac; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `subpath u v g ++ (subpath v w g ++ subpath w v g):real^1->real^N` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN tac; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `(subpath u v g :real^1->real^N) ++ linepath(pathfinish(subpath u v g),pathfinish(subpath u v g))` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN tac] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN REPEAT CONJ_TAC THENL [tac; ALL_TAC; tac] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `linepath(pathstart(subpath v w g):real^N,pathstart(subpath v w g))` THEN CONJ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REVERSEPATH_SUBPATH] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN tac; ALL_TAC] THEN REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; HOMOTOPIC_PATHS_REFL; PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]) in REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `(drop u <= drop v /\ drop v <= drop w \/ drop w <= drop v /\ drop v <= drop u) \/ (drop u <= drop w /\ drop w <= drop v \/ drop v <= drop w /\ drop w <= drop u) \/ (drop v <= drop u /\ drop u <= drop w \/ drop w <= drop u /\ drop u <= drop v)`) THEN FIRST_ASSUM(MP_TAC o SPECL [`g:real^1->real^N`; `s:real^N->bool`] o MATCH_MP lemma1) THEN ASM_MESON_TAC[lemma2; lemma3]);; let HOMOTOPIC_LOOPS_SHIFTPATH = prove (`!s:real^N->bool p q u. homotopic_loops s p q /\ u IN interval[vec 0,vec 1] ==> homotopic_loops s (shiftpath u p) (shiftpath u q)`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN( (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\z. shiftpath u (\t. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart z) t)) (sndcart z)` THEN ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX] THEN ASM_SIMP_TAC[CLOSED_SHIFTPATH] THEN CONJ_TAC THENL [REWRITE_TAC[shiftpath; DROP_ADD; REAL_ARITH `u + z <= &1 <=> z <= &1 - u`] THEN SUBGOAL_THEN `{ pastecart (t:real^1) (x:real^1) | t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1]} = { pastecart (t:real^1) (x:real^1) | t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1 - u]} UNION { pastecart (t:real^1) (x:real^1) | t IN interval[vec 0,vec 1] /\ x IN interval[vec 1 - u,vec 1]}` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `s UNION s' = u ==> {f t x | t IN i /\ x IN u} = {f t x | t IN i /\ x IN s} UNION {f t x | t IN i /\ x IN s'}`) THEN UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; CLOSED_INTERVAL] THEN REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; TAUT `p /\ q \/ r /\ s ==> t <=> (p ==> q ==> t) /\ (r ==> s ==> t)`] THEN SIMP_TAC[SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN SIMP_TAC[REAL_ARITH `&1 - u <= x ==> (x <= &1 - u <=> x = &1 - u)`] THEN SIMP_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN REWRITE_TAC[FSTCART_PASTECART; VECTOR_ARITH `u + v - u:real^N = v`; VECTOR_ARITH `u + v - u - v:real^N = vec 0`] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN ASM_SIMP_TAC[GSYM IN_INTERVAL_1; GSYM DROP_VEC] THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; VECTOR_ARITH `u + z - v:real^N = (u - v) + z`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; IN_ELIM_PASTECART_THM; DROP_ADD; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SET_RULE `(!t x. t IN i /\ x IN i ==> f t x IN s) <=> (!t. t IN i ==> IMAGE (f t) i SUBSET s)`] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; ETA_AX] THEN REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);; let HOMOTOPIC_PATHS_LOOP_PARTS = prove (`!s p q a:real^N. homotopic_loops s (p ++ reversepath q) (linepath(a,a)) /\ path q ==> homotopic_paths s p q`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL) THEN REWRITE_TAC[PATHSTART_JOIN] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN ASM_CASES_TAC `pathfinish p:real^N = pathstart(reversepath q)` THENL [ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH] THEN STRIP_TAC; ASM_MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_REVERSEPATH]] THEN RULE_ASSUM_TAC(REWRITE_RULE[PATHSTART_REVERSEPATH]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; UNION_SUBSET; SING_SUBSET; PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `p ++ (linepath(pathfinish p:real^N,pathfinish p))` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; PATHSTART_JOIN; PATHSTART_REVERSEPATH; HOMOTOPIC_PATHS_REFL]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATH_REVERSEPATH]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `linepath(pathstart p:real^N,pathstart p) ++ q` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH]; FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH; PATHFINISH_REVERSEPATH] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC HOMOTOPIC_PATHS_LID THEN ASM_REWRITE_TAC[]]);; let HOMOTOPIC_LOOPS_ADD_SYM = prove (`!p q:real^1->real^N. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\ path q /\ path_image q SUBSET s /\ pathfinish q = pathstart q /\ pathstart q = pathstart p ==> homotopic_loops s (p ++ q) (q ++ p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN SUBGOAL_THEN `lift(&1 / &2) IN interval[vec 0,vec 1]` ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN EXISTS_TAC `shiftpath (lift(&1 / &2)) (p ++ q:real^1->real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_LOOPS_SHIFTPATH_SELF; MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ] THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; UNION_SUBSET; IN_INTERVAL_1; DROP_VEC; LIFT_DROP; PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; CLOSED_SHIFTPATH] THEN SIMP_TAC[shiftpath; joinpaths; LIFT_DROP; DROP_ADD; DROP_SUB; DROP_VEC; REAL_ARITH `&0 <= t ==> (a + t <= a <=> t = &0)`; REAL_ARITH `t <= &1 ==> &1 / &2 + t - &1 <= &1 / &2`; REAL_ARITH `&1 / &2 + t <= &1 <=> t <= &1 / &2`] THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THENL [REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_MUL_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[LIFT_NUM; pathstart; pathfinish]; ALL_TAC]; ALL_TAC] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_ADD; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Simply connected sets defined as "all loops are homotopic (as loops)". *) (* ------------------------------------------------------------------------- *) let simply_connected = new_definition `simply_connected(s:real^N->bool) <=> !p q. path p /\ pathfinish p = pathstart p /\ path_image p SUBSET s /\ path q /\ pathfinish q = pathstart q /\ path_image q SUBSET s ==> homotopic_loops s p q`;; let SIMPLY_CONNECTED_EMPTY = prove (`simply_connected {}`, REWRITE_TAC[simply_connected; SUBSET_EMPTY] THEN MESON_TAC[PATH_IMAGE_NONEMPTY]);; let SIMPLY_CONNECTED_IMP_PATH_CONNECTED = prove (`!s:real^N->bool. simply_connected s ==> path_connected s`, REWRITE_TAC[simply_connected; PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[]);; let SIMPLY_CONNECTED_IMP_CONNECTED = prove (`!s:real^N->bool. simply_connected s ==> connected s`, SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY = prove (`!s:real^N->bool. simply_connected s <=> !p a. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\ a IN s ==> homotopic_loops s p (linepath(a,a))`, GEN_TAC THEN REWRITE_TAC[simply_connected] THEN EQ_TAC THEN DISCH_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]; MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `linepath(pathstart p:real^N,pathstart p)` THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);; let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME = prove (`!s:real^N->bool. simply_connected s <=> path_connected s /\ !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p ==> ?a. a IN s /\ homotopic_loops s p (linepath(a,a))`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE]; REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `linepath(b:real^N,b)` THEN ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]]);; let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL = prove (`!s:real^N->bool. simply_connected s <=> s = {} \/ ?a. a IN s /\ !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p ==> homotopic_loops s p (linepath(a,a))`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN EQ_TAC THENL [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `linepath(b:real^N,b)` THEN ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]; DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `linepath(a:real^N,a)` THEN GEN_REWRITE_TAC RAND_CONV [HOMOTOPIC_LOOPS_SYM] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM SET_TAC[]]);; let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH = prove (`!s:real^N->bool. simply_connected s <=> path_connected s /\ !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN EXISTS_TAC `pathstart p :real^N` THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC `linepath(pathstart p:real^N,pathfinish p)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN ASM_SIMP_TAC[PATHFINISH_LINEPATH]; ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN RULE_ASSUM_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]]);; let SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS = prove (`!s:real^N->bool. simply_connected s <=> path_connected s /\ !p q. path p /\ path_image p SUBSET s /\ path q /\ path_image q SUBSET s /\ pathstart q = pathstart p /\ pathfinish q = pathfinish p ==> homotopic_paths s p q`, REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THENL [X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p ++ reversepath q :real^1->real^N`) THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_REVERSEPATH; PATH_REVERSEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH; PATH_IMAGE_JOIN; UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `p ++ linepath(pathfinish p,pathfinish p):real^1->real^N` THEN GEN_REWRITE_TAC LAND_CONV [HOMOTOPIC_PATHS_SYM] THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_RID] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_LINEPATH] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `linepath(pathstart q,pathstart q) ++ q:real^1->real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL] THEN ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH]; ASM_MESON_TAC[HOMOTOPIC_PATHS_LID]]; STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);; let SIMPLY_CONNECTED_RETRACTION_GEN = prove (`!s:real^M->bool t:real^N->bool h k. h continuous_on s /\ IMAGE h s = t /\ k continuous_on t /\ IMAGE k t SUBSET s /\ (!y. y IN t ==> h(k y) = y) /\ simply_connected s ==> simply_connected t`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[simply_connected; path; path_image; homotopic_loops] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ a' /\ b' /\ c' <=> a /\ c /\ b /\ a' /\ c' /\ b'`] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN MAP_EVERY EXISTS_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN ASM_SIMP_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN REWRITE_TAC[pathfinish; pathstart] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);; let HOMEOMORPHIC_SIMPLY_CONNECTED = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ simply_connected s ==> simply_connected t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[homeomorphism; SUBSET_REFL]);; let HOMEOMORPHIC_SIMPLY_CONNECTED_EQ = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (simply_connected s <=> simply_connected t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SIMPLY_CONNECTED) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN ASM_REWRITE_TAC[]);; let SIMPLY_CONNECTED_TRANSLATION = prove (`!a:real^N s. simply_connected (IMAGE (\x. a + x) s) <=> simply_connected s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);; add_translation_invariants [SIMPLY_CONNECTED_TRANSLATION];; let SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (simply_connected (IMAGE f s) <=> simply_connected s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; HOMEOMORPHIC_REFL]);; add_linear_invariants [SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE];; let HOMEOMORPHISM_SIMPLE_CONNECTEDNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (simply_connected(IMAGE f k) <=> simply_connected k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let SIMPLY_CONNECTED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. simply_connected s /\ simply_connected t ==> simply_connected(s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN REWRITE_TAC[path; path_image; pathstart; pathfinish; FORALL_PASTECART] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`p:real^1->real^(M,N)finite_sum`; `a:real^M`; `b:real^N`] THEN REWRITE_TAC[PASTECART_IN_PCROSS; FORALL_IN_IMAGE; SUBSET] THEN STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPECL [`fstcart o (p:real^1->real^(M,N)finite_sum)`; `a:real^M`]) (MP_TAC o SPECL [`sndcart o (p:real^1->real^(M,N)finite_sum)`; `b:real^N`])) THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON; homotopic_loops; homotopic_with; pathfinish; pathstart; IMAGE_o; o_THM] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN ASM_MESON_TAC[SNDCART_PASTECART]; DISCH_THEN(X_CHOOSE_THEN `k:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN ASM_MESON_TAC[FSTCART_PASTECART]; DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^M` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `(\z. pastecart (h z) (k z)) :real^(1,1)finite_sum->real^(M,N)finite_sum` THEN ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX] THEN REWRITE_TAC[LINEPATH_REFL; PASTECART_FST_SND] THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS]);; let SIMPLY_CONNECTED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. simply_connected(s PCROSS t) <=> s = {} \/ t = {} \/ simply_connected s /\ simply_connected t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN MAP_EVERY X_GEN_TAC [`p:real^1->real^M`; `a:real^M`] THEN REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN DISCH_THEN(MP_TAC o SPECL [`(\t. pastecart (p t) (b)):real^1->real^(M,N)finite_sum`; `pastecart (a:real^M) (b:real^N)`]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ; CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(\t. pastecart (p t) b):real^1->real^(M,N)finite_sum`; `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`; `fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`] HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN SIMP_TAC[o_DEF; LINEPATH_REFL; FSTCART_PASTECART; ETA_AX; SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]; REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `b:real^N`] THEN REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN DISCH_THEN(MP_TAC o SPECL [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`; `pastecart (a:real^M) (b:real^N)`]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ; CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`; `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`; `sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`] HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN SIMP_TAC[o_DEF; LINEPATH_REFL; SNDCART_PASTECART; ETA_AX; SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]]);; let SIMPLY_CONNECTED_NESTED_UNIONS = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> open s /\ simply_connected s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> simply_connected(UNIONS f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[simply_connected] THEN MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\u:real^N->bool. (path_image p UNION path_image q) DIFF u) f` COMPACT_CHAIN) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_IMAGE_2] THEN MATCH_MP_TAC(TAUT `q /\ r /\ (~p ==> s) ==> (p /\ q ==> ~r) ==> s`) THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC(ISPEC `p:real^1->real^N` PATH_IMAGE_NONEMPTY) THEN REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 STRIP_TAC THEN FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN ASM_SIMP_TAC[COMPACT_DIFF; COMPACT_UNION; COMPACT_PATH_IMAGE] THEN REWRITE_TAC[SET_RULE `(s UNION t) DIFF u = {} <=> s SUBSET u /\ t SUBSET u`] THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[simply_connected]) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* The (carrier of) the fundamental group: homotopy classes of loops at a. *) (* ------------------------------------------------------------------------- *) let fundamental_group = new_definition `fundamental_group(s,a:real^N) = { homotopic_paths s p | p | path p /\ path_image p SUBSET s /\ pathstart p = a /\ pathfinish p = a}`;; let FUNDAMENTAL_GROUP_EQ_EMPTY = prove (`!s a:real^N. fundamental_group (s,a) = {} <=> ~(a IN s)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN PURE_REWRITE_TAC[fundamental_group; FORALL_IN_GSPEC] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE]] THEN DISCH_THEN(MP_TAC o SPEC `linepath(a:real^N,a)`) THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN SET_TAC[]);; let CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS = prove (`!s a b:real^N. path_connected s /\ a IN s /\ b IN s ==> fundamental_group(s,a) =_c fundamental_group(s,b)`, let lemma = prove (`!g:real^1->real^N. path g /\ path_image g SUBSET s ==> homotopic_paths s g ((@) (homotopic_paths s g)) /\ path ((@) (homotopic_paths s g)) /\ path_image ((@) (homotopic_paths s g)) SUBSET s /\ pathstart ((@) (homotopic_paths s g)) = pathstart g /\ pathfinish ((@) (homotopic_paths s g)) = pathfinish g`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL]; ASM MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; HOMOTOPIC_PATHS_IMP_SUBSET; HOMOTOPIC_PATHS_IMP_PATHSTART; HOMOTOPIC_PATHS_IMP_PATHFINISH]]) and tac = ASM_SIMP_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_REVERSEPATH; SUBSET_PATH_IMAGE_JOIN; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATH_JOIN] in REWRITE_TAC[GSYM CARD_LE_ANTISYM; FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[le_c] THEN SUBGOAL_THEN `?f:real^1->real^N. path f /\ path_image f SUBSET s /\ pathstart f = a /\ pathfinish f = b` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[path_connected]; ALL_TAC] THEN REWRITE_TAC[fundamental_group; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN EXISTS_TAC `\g. homotopic_paths (s:real^N->bool) (reversepath f ++ (@) g ++ f)` THEN CONJ_TAC THEN X_GEN_TAC `g:real^1->real^N` THEN REPEAT DISCH_TAC THEN MP_TAC(ISPEC `g:real^1->real^N` lemma) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `g':real^1->real^N = (@) (homotopic_paths s g)` THEN STRIP_TAC THENL [MATCH_MP_TAC(SET_RULE `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`) THEN tac; X_GEN_TAC `h:real^1->real^N` THEN REPLICATE_TAC 4 DISCH_TAC THEN MP_TAC(ISPEC `h:real^1->real^N` lemma) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `h':real^1->real^N = (@) (homotopic_paths s h)` THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o C AP_THM`reversepath f ++ h' ++ f:real^1->real^N`) THEN tac THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_LCANCEL)) THEN tac THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_RCANCEL)) THEN tac THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]]);; let SIMPLY_CONNECTED_FUNDAMENTAL_GROUP = prove (`!s:real^N->bool. simply_connected s <=> path_connected s /\ !a. a IN s ==> fundamental_group(s,a) = {homotopic_paths s (linepath(a,a))}`, GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN ASM_CASES_TAC `path_connected(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !x. x IN s ==> x = a`] THEN REWRITE_TAC[fundamental_group; FORALL_IN_GSPEC] THEN SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET; SET_RULE `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t <=> t /\ q /\ p /\ r /\ s`] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; FORALL_UNWIND_THM1] THEN REWRITE_TAC[MESON[PATHFINISH_IN_PATH_IMAGE; SUBSET] `pathfinish p IN s ==> path_image p SUBSET s ==> P <=> path_image p SUBSET s ==> P`] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[ISPEC `pathfinish p:real^N` EQ_SYM_EQ] THEN X_GEN_TAC `p:real^1->real^N` THEN REPEAT (MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> ((p ==> q) <=> (p ==> r))`) THEN DISCH_TAC) THEN REPEAT(EQ_TAC ORELSE STRIP_TAC) THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATH_LINEPATH] THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM; PATHFINISH_IN_PATH_IMAGE; SUBSET]);; let FUNDAMENTAL_GROUP_SIMPLY_CONNECTED = prove (`!s a:real^N. simply_connected s /\ a IN s ==> fundamental_group(s,a) = {homotopic_paths s (linepath(a,a))}`, SIMP_TAC[SIMPLY_CONNECTED_FUNDAMENTAL_GROUP]);; (* ------------------------------------------------------------------------- *) (* A mapping out of a sphere is nullhomotopic iff it extends to the ball. *) (* This even works out in the degenerate cases when the radius is <= 0, and *) (* we also don't need to explicitly assume continuity since it's already *) (* implicit in both sides of the equivalence. *) (* ------------------------------------------------------------------------- *) let NULLHOMOTOPIC_FROM_SPHERE_EXTENSION = prove (`!f:real^M->real^N s a r. (?c. homotopic_with (\x. T) (sphere(a,r),s) f (\x. c)) <=> (?g. g continuous_on cball(a,r) /\ IMAGE g (cball(a,r)) SUBSET s /\ !x. x IN sphere(a,r) ==> g x = f x)`, let lemma = prove (`!f:real^M->real^N g a r. (!e. &0 < e ==> ?d. &0 < d /\ !x. ~(x = a) /\ norm(x - a) < d ==> norm(g x - f a) < e) /\ g continuous_on (cball(a,r) DELETE a) /\ (!x. x IN cball(a,r) /\ ~(x = a) ==> f x = g x) ==> f continuous_on cball(a,r)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^M = a` THENL [ASM_REWRITE_TAC[continuous_within; IN_CBALL; dist] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = a` THEN ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0]; MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `norm(x - a:real^M)` THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_CBALL; dist] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]); UNDISCH_TAC `(g:real^M->real^N) continuous_on (cball(a,r) DELETE a)` THEN REWRITE_TAC[continuous_on; continuous_within] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_DELETE; IN_CBALL; dist] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (norm(x - a:real^M))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]] THEN ASM_MESON_TAC[NORM_SUB; NORM_ARITH `norm(y - x:real^N) < norm(x - a) ==> ~(y = a)`]]) in REWRITE_TAC[sphere; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) THENL [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x = r)`] THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM CBALL_EQ_EMPTY]) THEN ASM_SIMP_TAC[HOMOTOPIC_WITH; IMAGE_CLAUSES; EMPTY_GSPEC; NOT_IN_EMPTY; PCROSS; SET_RULE `{f t x |x,t| F} = {}`; EMPTY_SUBSET] THEN REWRITE_TAC[CONTINUOUS_ON_EMPTY]; ASM_SIMP_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CBALL_SING] THEN SIMP_TAC[HOMOTOPIC_WITH; PCROSS; FORALL_IN_GSPEC; FORALL_UNWIND_THM2] THEN ASM_CASES_TAC `(f:real^M->real^N) a IN s` THENL [MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL [EXISTS_TAC `(f:real^M->real^N) a` THEN EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) a` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE]; EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_SING] THEN ASM SET_TAC[]]; MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN UNDISCH_TAC `~((f:real^M->real^N) a IN s)` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h t SUBSET s ==> (?y. y IN t /\ z = h y) ==> z IN s`)) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `vec 0:real^1` THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_REWRITE_TAC[EXISTS_IN_GSPEC; UNWIND_THM2]]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `!p. (q ==> p) /\ (r ==> p) /\ (p ==> (q <=> r)) ==> (q <=> r)`) THEN EXISTS_TAC `(f:real^M->real^N) continuous_on {x | norm(x - a) = r} /\ IMAGE f {x | norm(x - a) = r} SUBSET s` THEN REPEAT CONJ_TAC THENL [STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(a:real^M,r)`; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g t SUBSET s ==> u SUBSET t /\ (!x. x IN u ==> f x = g x) ==> IMAGE f u SUBSET s`)) THEN ASM_SIMP_TAC[]] THEN ASM_SIMP_TAC[SUBSET; IN_CBALL; dist; IN_ELIM_THM] THEN MESON_TAC[REAL_LE_REFL; NORM_SUB]; STRIP_TAC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EQ_TAC THENL [REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `h:real^(1,M)finite_sum->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N) (pastecart (lift(inv(r) * norm(x - a))) (a + (if x = a then r % basis 1 else r / norm(x - a) % (x - a))))` THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_MUL_LINV; REAL_DIV_REFL; REAL_LT_IMP_NZ; LIFT_NUM; VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC lemma THEN EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N) (pastecart (lift(inv(r) * norm(x - a))) (a + r / norm(x - a) % (x - a)))` THEN SIMP_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; LIFT_NUM] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_UNIFORMLY_CONTINUOUS)) THEN SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; REWRITE_RULE[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] COMPACT_SPHERE; COMPACT_INTERVAL] THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min r (d * r):real` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^1`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; RIGHT_IMP_FORALL_THM] THEN ASM_REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!x t y. P x t y) ==> (!t x. P x t x)`)) THEN REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; CONJ_ASSOC] THEN REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`] THEN REWRITE_TAC[PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART] THEN REWRITE_TAC[NORM_0; VECTOR_SUB_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM; NORM_LIFT] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; REAL_ABS_NORM; REAL_ARITH `&0 < r ==> abs r = r`]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[CONTINUOUS_ON_CMUL; LIFT_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; o_DEF; real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_INV) THEN ASM_SIMP_TAC[NETLIMIT_AT; NORM_EQ_0; VECTOR_SUB_EQ] THEN MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DELETE; IN_ELIM_THM] THEN SIMP_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]]; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_CBALL; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE]; REWRITE_TAC[VECTOR_ADD_SUB] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_MUL_RID; REAL_ARITH `&0 < r ==> abs r = r`] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]]; GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`]]; DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:real^M->real^N) a` THEN ASM_SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN EXISTS_TAC `\y:real^(1,M)finite_sum. (g:real^M->real^N) (a + drop(fstcart y) % (sndcart y - a))` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_MUL_LID] THEN ASM_SIMP_TAC[VECTOR_SUB_ADD2] THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; LINEAR_FSTCART; ETA_AX]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))]; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`))] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_LE_RMUL_EQ; REAL_ARITH `x * r <= r <=> x * r <= &1 * r`] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Homotopy equivalence. *) (* ------------------------------------------------------------------------- *) parse_as_infix("homotopy_equivalent",(12,"right"));; let homotopy_equivalent = new_definition `(s:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> ?f g. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ homotopic_with (\x. T) (s,s) (g o f) I /\ homotopic_with (\x. T) (t,t) (f o g) I`;; let HOMOTOPY_EQUIVALENT = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t <=> ?f g h. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ h continuous_on t /\ IMAGE h t SUBSET s /\ homotopic_with (\x. T) (s,s) (g o f) I /\ homotopic_with (\x. T) (t,t) (f o h) I`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((?x. P x) <=> (?x. Q x))`) THEN X_GEN_TAC `f:real^M->real^N` THEN EQ_TAC THENL [MESON_TAC[]; STRIP_TAC] THEN EXISTS_TAC `(g:real^N->real^M) o f o (h:real^N->real^M)` THEN ASM_REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; TRANS_TAC HOMOTOPIC_WITH_TRANS `((g:real^N->real^M) o I) o (f:real^M->real^N)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; TRANS_TAC HOMOTOPIC_WITH_TRANS `(f:real^M->real^N) o I o (h:real^N->real^M)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]]);; let HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> s homotopy_equivalent t`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homotopy_equivalent; homeomorphism] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM; I_THM; SUBSET_REFL]);; let HOMOTOPY_EQUIVALENT_REFL = prove (`!s:real^N->bool. s homotopy_equivalent s`, SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_REFL]);; let HOMOTOPY_EQUIVALENT_SYM = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t <=> t homotopy_equivalent s`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);; let HOMOTOPY_EQUIVALENT_TRANS = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t /\ t homotopy_equivalent u ==> s homotopy_equivalent u`, REPEAT GEN_TAC THEN SIMP_TAC[homotopy_equivalent; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f1:real^M->real^N`; `g1:real^N->real^M`; `f2:real^N->real^P`; `g2:real^P->real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(f2:real^N->real^P) o (f1:real^M->real^N)`; `(g1:real^N->real^M) o (g2:real^P->real^N)`] THEN REWRITE_TAC[IMAGE_o] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET];ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THENL [EXISTS_TAC `(g1:real^N->real^M) o I o (f1:real^M->real^N)`; EXISTS_TAC `(f2:real^N->real^P) o I o (g2:real^P->real^N)`] THEN (CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]]) THEN REWRITE_TAC[GSYM o_ASSOC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]);; let HOMOTOPY_EQUIVALENT_PCROSS = prove (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool. s homotopy_equivalent s' /\ t homotopy_equivalent t' ==> s PCROSS t homotopy_equivalent s' PCROSS t'`, REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f1:real^M->real^P`; `g1:real^P->real^M`; `f2:real^N->real^Q`; `g2:real^Q->real^N`] THEN DISCH_TAC THEN EXISTS_TAC `\z. pastecart ((f1:real^M->real^P) (fstcart z)) ((f2:real^N->real^Q) (sndcart z))` THEN EXISTS_TAC `\z. pastecart ((g1:real^P->real^M) (fstcart z)) ((g2:real^Q->real^N) (sndcart z))` THEN FIRST_X_ASSUM(CONJUNCTS_THEN (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC o GEN_REWRITE_RULE I [TAUT `p /\ q /\ r /\ s /\ t <=> (p /\ q /\ r /\ s) /\ t`])) THEN ONCE_REWRITE_TAC[TAUT `p /\ q ==> p' /\ q' ==> r <=> (p' /\ p) /\ (q' /\ q) ==> r`] THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP(MESON[] `(!x. p x) ==> (!x. p(\a. T))`) o MATCH_MP (ONCE_REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] HOMOTOPIC_WITH_PCROSS))) THEN REWRITE_TAC[I_DEF; PASTECART_FST_SND; o_DEF] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ r) /\ (q /\ s)`] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY]; CONJ_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN REWRITE_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]]);; let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s) homotopy_equivalent s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN ASM_REWRITE_TAC[]);; let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> ((IMAGE f s) homotopy_equivalent t <=> s homotopy_equivalent t)`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o MATCH_MP HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF) THEN EQ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPY_EQUIVALENT_SYM]); POP_ASSUM MP_TAC] THEN REWRITE_TAC[IMP_IMP; HOMOTOPY_EQUIVALENT_TRANS]);; let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s homotopy_equivalent (IMAGE f t) <=> s homotopy_equivalent t)`, ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN REWRITE_TAC[HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);; add_linear_invariants [HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];; let HOMOTOPY_EQUIVALENT_TRANSLATION_SELF = prove (`!a:real^N s. (IMAGE (\x. a + x) s) homotopy_equivalent s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; let HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ = prove (`!a:real^N s t. (IMAGE (\x. a + x) s) homotopy_equivalent t <=> s homotopy_equivalent t`, MESON_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_SELF; HOMOTOPY_EQUIVALENT_SYM; HOMOTOPY_EQUIVALENT_TRANS]);; let HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ = prove (`!a:real^N s t. s homotopy_equivalent (IMAGE (\x. a + x) t) <=> s homotopy_equivalent t`, ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN REWRITE_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ]);; add_translation_invariants [HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ; HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ];; let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t ==> ((!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ g continuous_on u /\ IMAGE g u SUBSET s ==> homotopic_with (\x. T) (u,s) f g) <=> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ g continuous_on u /\ IMAGE g u SUBSET t ==> homotopic_with (\x. T) (u,t) f g))`, let lemma = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t /\ (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ g continuous_on u /\ IMAGE g u SUBSET s ==> homotopic_with (\x. T) (u,s) f g) ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ g continuous_on u /\ IMAGE g u SUBSET t ==> homotopic_with (\x. T) (u,t) f g)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `homotopic_with (\x. T) (u,t) ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N)) (h o k o g)` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM] `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g' ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ g continuous_on s /\ IMAGE g s SUBSET u ==> homotopic_with (\x. T) (s,u) f g) <=> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ g continuous_on t /\ IMAGE g t SUBSET u ==> homotopic_with (\x. T) (t,u) f g))`, let lemma = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t /\ (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ g continuous_on s /\ IMAGE g s SUBSET u ==> homotopic_with (\x. T) (s,u) f g) ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ g continuous_on t /\ IMAGE g t SUBSET u ==> homotopic_with (\x. T) (t,u) f g)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `homotopic_with (\x. T) (t,u) (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((g o h) o k)` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM] `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g' ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN REWRITE_TAC[GSYM o_ASSOC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t ==> ((!f. f continuous_on u /\ IMAGE f u SUBSET s ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) <=> (!f. f continuous_on u /\ IMAGE f u SUBSET t ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c)))`, let lemma = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t /\ (!f. f continuous_on u /\ IMAGE f u SUBSET s ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(k:real^N->real^M) o (f:real^P->real^N)`) THEN REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; DISCH_THEN(X_CHOOSE_TAC `c:real^M`) THEN EXISTS_TAC `(h:real^M->real^N) c`] THEN SUBGOAL_THEN `homotopic_with (\x. T) (u,t) ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N)) (h o (\x. c))` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN REWRITE_TAC[o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET u ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) <=> (!f. f continuous_on t /\ IMAGE f t SUBSET u ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c)))`, let lemma = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homotopy_equivalent t /\ (!f. f continuous_on s /\ IMAGE f s SUBSET u ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^N->real^P) o (h:real^M->real^N)`) THEN REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN SUBGOAL_THEN `homotopic_with (\x. T) (t,u) (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((\x. c) o k)` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; let HOMOTOPIC_WITH_IMP_PATH_COMPONENT = prove (`!f g:real^M->real^N s t a. homotopic_with (\x. T) (s,t) f g /\ a IN s ==> path_component t (f a) (g a)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN REWRITE_TAC[o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN EXISTS_TAC `IMAGE (h:real^(1,M)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS {a})` THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE f s' SUBSET t ==> s SUBSET s' ==> IMAGE f s SUBSET t`)) THEN REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[]; W(MP_TAC o fst o EQ_IMP_RULE o PART_MATCH (rand o lhand) PATH_CONNECTED_IFF_PATH_COMPONENT o lhand o rator o snd) THEN ANTS_TAC THENL [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[PATH_CONNECTED_PCROSS_EQ; PATH_CONNECTED_INTERVAL; PATH_CONNECTED_SING] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[]; DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL; IN_SING]]]);; let HOMOTOPY_INVARIANT_CARD_COMPONENTS = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ homotopic_with (\x. T) (t,t) (f o g) I ==> components t <=_c components s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; COMPONENTS_EMPTY] THEN REWRITE_TAC[CARD_EMPTY_LE] THEN STRIP_TAC THEN MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN EXISTS_TAC `\c d. IMAGE (g:real^N->real^M) d SUBSET c` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[IN_COMPONENTS_SUBSET; CONTINUOUS_ON_SUBSET; IN_COMPONENTS_CONNECTED]]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] `!f. connected_component s (f b) (f c) /\ connected_component s (f b) b /\ connected_component s (f c) c ==> connected_component s b c`) THEN EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN MATCH_MP_TAC PATH_COMPONENT_IMP_CONNECTED_COMPONENT THEN GEN_REWRITE_TAC RAND_CONV [GSYM I_THM] THEN MATCH_MP_TAC HOMOTOPIC_WITH_IMP_PATH_COMPONENT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[ETA_AX]] THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (connected_component s a)` THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:real^M->bool`; `a:real^M`] CONNECTED_COMPONENT_SUBSET) THEN ASM SET_TAC[]; REWRITE_TAC[o_THM] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_REFL)) THEN ASM SET_TAC[]]);; let HOMOTOPY_INVARIANT_CONNECTEDNESS = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ homotopic_with (\x. T) (t,t) (f o g) I /\ connected s ==> connected t`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[CONNECTED_EQ_CARD_COMPONENTS] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`] HOMOTOPY_INVARIANT_CARD_COMPONENTS) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CARD_LE_CARD_IMP; LE_TRANS]);; let HOMOTOPY_EQUIVALENT_CONNECTEDNESS = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t ==> (connected s <=> connected t)`, REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_CONNECTEDNESS)) THEN ASM_MESON_TAC[]);; let HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t ==> components s =_c components t`, REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC HOMOTOPY_INVARIANT_CARD_COMPONENTS THEN ASM_MESON_TAC[]);; let HOMEOMORPHIC_CARD_EQ_COMPONENTS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> components s =_c components t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN ASM_REWRITE_TAC[]);; let HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ homotopic_with (\x. T) (t,t) (f o g) I ==> {path_component t x | x | x IN t} <=_c {path_component s x | x | x IN s}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN EXISTS_TAC `\c d. IMAGE (g:real^N->real^M) d SUBSET c` THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(g:real^N->real^M) y` THEN CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC PATH_COMPONENT_MAXIMAL] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN ASM_SIMP_TAC[PATH_COMPONENT_REFL]; MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN ASM_MESON_TAC[PATH_COMPONENT_SUBSET; CONTINUOUS_ON_SUBSET]; MP_TAC(ISPECL [`t:real^N->bool`; `y:real^N`] PATH_COMPONENT_SUBSET) THEN ASM SET_TAC[]]; ALL_TAC] THEN SIMP_TAC[PATH_COMPONENT_EQ_EQ] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC(MESON[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS] `!f. path_component s (f b) (f c) /\ path_component s (f b) b /\ path_component s (f c) c ==> path_component s b c`) THEN EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM I_THM] THEN MATCH_MP_TAC HOMOTOPIC_WITH_IMP_PATH_COMPONENT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[ETA_AX]] THEN REWRITE_TAC[PATH_COMPONENT] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (path_component s a)` THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN ASM_MESON_TAC[PATH_COMPONENT_SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:real^M->bool`; `a:real^M`] PATH_COMPONENT_SUBSET) THEN ASM SET_TAC[]; REWRITE_TAC[o_THM] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_REFL)) THEN ASM SET_TAC[]]);; let HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ homotopic_with (\x. T) (t,t) (f o g) I /\ path_connected s ==> path_connected t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; COMPONENTS_EMPTY] THEN REWRITE_TAC[PATH_CONNECTED_EMPTY] THEN STRIP_TAC THEN SUBGOAL_THEN `{path_component s (x:real^M) | x | x IN s} = {s}` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !x. x IN s ==> x = a`] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC(ISPEC `s:real^M->bool` PATH_CONNECTED_COMPONENT_SET) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`] HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE)) THEN REWRITE_TAC[FINITE_SING] THEN DISCH_TAC THEN UNDISCH_TAC `{path_component t (x:real^N) | x | x IN t} <=_c {s:real^M->bool}` THEN ASM_SIMP_TAC[CARD_LE_CARD; FINITE_SING; CARD_SING] THEN UNDISCH_TAC `FINITE {path_component t (x:real^N) | x | x IN t}` THEN REWRITE_TAC[ARITH_RULE `n <= 1 <=> n = 0 \/ n = 1`] THEN REWRITE_TAC[IMP_IMP; LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = {} \/ (?a. s = {a}) ==> !x. x IN s ==> !y. y IN s ==> x = y`)) THEN SIMP_TAC[FORALL_IN_GSPEC; PATH_COMPONENT_EQ_EQ] THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN MESON_TAC[]);; let HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t ==> (path_connected s <=> path_connected t)`, REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS)) THEN ASM_MESON_TAC[]);; let HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t ==> {path_component s x | x | x IN s} =_c {path_component t x | x | x IN t}`, REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THEN MATCH_MP_TAC HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS THEN ASM_MESON_TAC[]);; let HOMEOMORPHIC_CARD_EQ_PATH_COMPONENTS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> {path_component s x | x | x IN s} =_c {path_component t x | x | x IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Contractible sets. *) (* ------------------------------------------------------------------------- *) let contractible = new_definition `contractible s <=> ?a. homotopic_with (\x. T) (s,s) (\x. x) (\x. a)`;; let CONTRACTIBLE_IMP_SIMPLY_CONNECTED = prove (`!s:real^N->bool. contractible s ==> simply_connected s`, GEN_TAC THEN REWRITE_TAC[contractible] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[homotopic_loops; PCROSS] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN X_GEN_TAC `p:real^1->real^N` THEN REWRITE_TAC[path; path_image; pathfinish; pathstart] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN REWRITE_TAC[homotopic_with; SUBSET; FORALL_IN_IMAGE; PCROSS] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(h o (\y. pastecart (fstcart y) (p(sndcart y):real^N))) :real^(1,1)finite_sum->real^N` THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; linepath; o_THM] THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART]);; let CONTRACTIBLE_IMP_CONNECTED = prove (`!s:real^N->bool. contractible s ==> connected s`, SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_IMP_CONNECTED]);; let CONTRACTIBLE_IMP_PATH_CONNECTED = prove (`!s:real^N->bool. contractible s ==> path_connected s`, SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);; let NULLHOMOTOPIC_THROUGH_CONTRACTIBLE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ contractible t ==> ?c. homotopic_with (\h. T) (s,u) (g o f) (\x. c)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN DISCH_THEN(MP_TAC o ISPECL [`g:real^N->real^P`; `u:real^P->bool`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o ISPECL [`f:real^M->real^N`; `s:real^M->bool`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT)) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_TAC THEN EXISTS_TAC `(g:real^N->real^P) b` THEN ASM_REWRITE_TAC[]);; let NULLHOMOTOPIC_INTO_CONTRACTIBLE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ contractible t ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) = (\x. x) o f` SUBST1_TAC THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN SET_TAC[]]);; let NULLHOMOTOPIC_FROM_CONTRACTIBLE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ contractible s ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) = f o (\x. x)` SUBST1_TAC THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN SET_TAC[]]);; let HOMOTOPIC_THROUGH_CONTRACTIBLE = prove (`!f1:real^M->real^N g1:real^N->real^P f2 g2 s t u. f1 continuous_on s /\ IMAGE f1 s SUBSET t /\ g1 continuous_on t /\ IMAGE g1 t SUBSET u /\ f2 continuous_on s /\ IMAGE f2 s SUBSET t /\ g2 continuous_on t /\ IMAGE g2 t SUBSET u /\ contractible t /\ path_connected u ==> homotopic_with (\h. T) (s,u) (g1 o f1) (g2 o f2)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f1:real^M->real^N`; `g1:real^N->real^P`; `s:real^M->bool`; `t:real^N->bool`; `u:real^P->bool`] NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c1:real^P` THEN DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN MP_TAC(ISPECL [`f2:real^M->real^N`; `g2:real^N->real^P`; `s:real^M->bool`; `t:real^N->bool`; `u:real^P->bool`] NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c2:real^P` THEN DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE I [PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN ASM SET_TAC[]);; let HOMOTOPIC_INTO_CONTRACTIBLE = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on s /\ IMAGE g s SUBSET t /\ contractible t ==> homotopic_with (\h. T) (s,t) f g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) = (\x. x) o f /\ (g:real^M->real^N) = (\x. x) o g` (CONJUNCTS_THEN SUBST1_TAC) THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM_SIMP_TAC[IMAGE_ID; SUBSET_REFL; CONTRACTIBLE_IMP_PATH_CONNECTED]);; let HOMOTOPIC_FROM_CONTRACTIBLE = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on s /\ IMAGE g s SUBSET t /\ contractible s /\ path_connected t ==> homotopic_with (\h. T) (s,t) f g`, REPEAT STRIP_TAC THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) = f o (\x. x) /\ (g:real^M->real^N) = g o (\x. x)` (CONJUNCTS_THEN SUBST1_TAC) THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM_REWRITE_TAC[IMAGE_ID; SUBSET_REFL]);; let HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS = prove (`!s:real^M->bool t:real^N->bool. contractible s /\ contractible t /\ (s = {} <=> t = {}) ==> s homotopy_equivalent t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_EMPTY] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `b:real^N` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN STRIP_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^M` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN EXISTS_TAC `(\x. b):real^M->real^N` THEN EXISTS_TAC `(\y. a):real^N->real^M` THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_INTO_CONTRACTIBLE THEN ASM_REWRITE_TAC[o_DEF; IMAGE_ID; I_DEF; SUBSET_REFL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);; let STARLIKE_IMP_CONTRACTIBLE_GEN = prove (`!P s. (!a t. a IN s /\ &0 <= t /\ t <= &1 ==> P(\x. (&1 - t) % x + t % a)) /\ starlike s ==> ?a:real^N. homotopic_with P (s,s) (\x. x) (\x. a)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[starlike] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN EXISTS_TAC `\y:real^(1,N)finite_sum. (&1 - drop(fstcart y)) % sndcart y + drop(fstcart y) % a` THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; IN_INTERVAL_1; SUBSET; FORALL_IN_IMAGE; REAL_SUB_RZERO; REAL_SUB_REFL; FORALL_IN_GSPEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; ETA_AX; LINEAR_FSTCART; LINEAR_SNDCART]);; let STARLIKE_IMP_CONTRACTIBLE = prove (`!s:real^N->bool. starlike s ==> contractible s`, SIMP_TAC[contractible; STARLIKE_IMP_CONTRACTIBLE_GEN]);; let CONTRACTIBLE_UNIV = prove (`contractible(:real^N)`, SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV]);; let STARLIKE_IMP_SIMPLY_CONNECTED = prove (`!s:real^N->bool. starlike s ==> simply_connected s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);; let CONVEX_IMP_SIMPLY_CONNECTED = prove (`!s:real^N->bool. convex s ==> simply_connected s`, MESON_TAC[CONVEX_IMP_STARLIKE; STARLIKE_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_EMPTY]);; let STARLIKE_IMP_PATH_CONNECTED = prove (`!s:real^N->bool. starlike s ==> path_connected s`, MESON_TAC[STARLIKE_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);; let STARLIKE_IMP_CONNECTED = prove (`!s:real^N->bool. starlike s ==> connected s`, MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; let CONIC_IMP_PATH_CONNECTED = prove (`!s:real^N->bool. conic s ==> path_connected s`, MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; CONIC_IMP_STARLIKE; PATH_CONNECTED_EMPTY]);; let CONIC_IMP_CONNECTED = prove (`!s:real^N->bool. conic s ==> connected s`, MESON_TAC[CONIC_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; let IS_INTERVAL_SIMPLY_CONNECTED_1 = prove (`!s:real^1->bool. is_interval s <=> simply_connected s`, MESON_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1; CONVEX_IMP_SIMPLY_CONNECTED; IS_INTERVAL_CONVEX_1]);; let CONTRACTIBLE_EMPTY = prove (`contractible {}`, SIMP_TAC[contractible; HOMOTOPIC_WITH; PCROSS_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[CONTINUOUS_ON_EMPTY] THEN SET_TAC[]);; let CONIC_IMP_CONTRACTIBLE = prove (`!s:real^N->bool. conic s ==> contractible s`, MESON_TAC[CONIC_IMP_STARLIKE; STARLIKE_IMP_CONTRACTIBLE; CONTRACTIBLE_EMPTY]);; let CONIC_IMP_SIMPLY_CONNECTED = prove (`!s:real^N->bool. conic s ==> simply_connected s`, MESON_TAC[CONIC_IMP_CONTRACTIBLE; CONTRACTIBLE_IMP_SIMPLY_CONNECTED]);; let CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS = prove (`!s t:real^N->bool. convex s /\ relative_interior s SUBSET t /\ t SUBSET closure s ==> contractible t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[SUBSET_EMPTY; CLOSURE_EMPTY; CONTRACTIBLE_EMPTY] THEN STRIP_TAC THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN MATCH_MP_TAC STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS THEN ASM_MESON_TAC[]);; let CONVEX_IMP_CONTRACTIBLE = prove (`!s:real^N->bool. convex s ==> contractible s`, MESON_TAC[CONVEX_IMP_STARLIKE; CONTRACTIBLE_EMPTY; STARLIKE_IMP_CONTRACTIBLE]);; let CONTRACTIBLE_SING = prove (`!a:real^N. contractible {a}`, SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_SING]);; let SIMPLY_CONNECTED_SING = prove (`!a:real^N. simply_connected {a}`, SIMP_TAC[CONTRACTIBLE_SING; CONTRACTIBLE_IMP_SIMPLY_CONNECTED]);; let IS_INTERVAL_CONTRACTIBLE_1 = prove (`!s:real^1->bool. is_interval s <=> contractible s`, MESON_TAC[CONTRACTIBLE_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1; CONVEX_IMP_CONTRACTIBLE; IS_INTERVAL_CONVEX_1]);; let CONTRACTIBLE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. contractible s /\ contractible t ==> contractible(s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[contractible; homotopic_with] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `h:real^(1,M)finite_sum->real^M`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `k:real^(1,N)finite_sum->real^N`] THEN REPEAT DISCH_TAC THEN EXISTS_TAC `pastecart (a:real^M) (b:real^N)` THEN EXISTS_TAC `\z. pastecart ((h:real^(1,M)finite_sum->real^M) (pastecart (fstcart z) (fstcart(sndcart z)))) ((k:real^(1,N)finite_sum->real^N) (pastecart (fstcart z) (sndcart(sndcart z))))` THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_ID; GSYM o_DEF; CONTINUOUS_ON_COMPOSE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);; let CONTRACTIBLE_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. contractible(s PCROSS t) <=> s = {} \/ t = {} \/ contractible s /\ contractible t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[CONTRACTIBLE_PCROSS] THEN REWRITE_TAC[contractible; homotopic_with; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`; `h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum`] THEN STRIP_TAC THEN SUBGOAL_THEN `(a:real^M) IN s /\ (b:real^N) IN t` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM PASTECART_IN_PCROSS] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN CONJ_TAC THENL [EXISTS_TAC `a:real^M` THEN EXISTS_TAC `fstcart o (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o (\z. pastecart (fstcart z) (pastecart (sndcart z) b))`; EXISTS_TAC `b:real^N` THEN EXISTS_TAC `sndcart o (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o (\z. pastecart (fstcart z) (pastecart a (sndcart z)))`] THEN ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; o_THM] THEN (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS]]) THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS]);; let HOMOTOPY_EQUIVALENT_EMPTY = prove (`(!s. (s:real^M->bool) homotopy_equivalent ({}:real^N->bool) <=> s = {}) /\ (!t. ({}:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> t = {})`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; CONTRACTIBLE_EMPTY] THEN REWRITE_TAC[homotopy_equivalent] THEN SET_TAC[]);; let HOMOTOPY_DOMINATED_CONTRACTIBILITY = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ homotopic_with (\x. T) (t,t) (f o g) I /\ contractible s ==> contractible t`, REPEAT GEN_TAC THEN SIMP_TAC[contractible; I_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN ASM_REWRITE_TAC[contractible; I_DEF] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\x. (b:real^N)) = (\x. b) o (g:real^N->real^M)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]);; let HOMOTOPY_EQUIVALENT_CONTRACTIBILITY = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t ==> (contractible s <=> contractible t)`, REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_DOMINATED_CONTRACTIBILITY)) THEN ASM_MESON_TAC[]);; let HOMOTOPY_EQUIVALENT_SING = prove (`!s:real^M->bool a:real^N. s homotopy_equivalent {a} <=> ~(s = {}) /\ contractible s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY; NOT_INSERT_EMPTY] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPY_EQUIVALENT_CONTRACTIBILITY) THEN REWRITE_TAC[CONTRACTIBLE_SING]; DISCH_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS THEN ASM_REWRITE_TAC[CONTRACTIBLE_SING; NOT_INSERT_EMPTY]]);; let HOMEOMORPHIC_CONTRACTIBLE_EQ = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (contractible s <=> contractible t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBILITY THEN ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]);; let HOMEOMORPHIC_CONTRACTIBLE = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t /\ contractible s ==> contractible t`, MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ]);; let CONTRACTIBLE_TRANSLATION = prove (`!a:real^N s. contractible (IMAGE (\x. a + x) s) <=> contractible s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);; add_translation_invariants [CONTRACTIBLE_TRANSLATION];; let CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (contractible (IMAGE f s) <=> contractible s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; HOMEOMORPHIC_REFL]);; add_linear_invariants [CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE];; let HOMEOMORPHISM_CONTRACTIBILITY = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (contractible(IMAGE f k) <=> contractible k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Homeomorphisms between punctured spheres and affine sets. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE = prove (`!a r b t:real^N->bool p:real^M->bool. &0 < r /\ b IN sphere(a,r) /\ affine t /\ a IN t /\ b IN t /\ affine p /\ aff_dim t = aff_dim p + &1 ==> ((sphere(a:real^N,r) INTER t) DELETE b) homeomorphic p`, GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[sphere; DIST_0; IN_ELIM_THM] THEN SIMP_TAC[CONJ_ASSOC; NORM_ARITH `&0 < r /\ norm(b:real^N) = r <=> norm(b) = r /\ ~(b = vec 0)`] THEN GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN SIMP_TAC[NORM_MUL; real_abs; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN X_GEN_TAC `b:real` THEN REWRITE_TAC[REAL_MUL_RID; VECTOR_MUL_EQ_0] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN SUBST1_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN ASM_CASES_TAC `r = &1` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN STRIP_TAC THEN SUBGOAL_THEN `subspace(t:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_EQ_SUBSPACE]; ALL_TAC] THEN TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0} INTER t` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMEOMORPHIC_AFFINE_SETS THEN ASM_SIMP_TAC[AFFINE_INTER; AFFINE_STANDARD_HYPERPLANE] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MP_TAC(ISPECL [`basis 1:real^N`; `&0`; `t:real^N->bool`] AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `~(t INTER {x:real^N | x$1 = &0} = {})` ASSUME_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VEC_COMPONENT]; ALL_TAC] THEN SUBGOAL_THEN `~(t SUBSET {v:real^N | v$1 = &0})` ASSUME_TAC THENL [REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN ASM_SIMP_TAC[IN_ELIM_THM; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]] THEN SUBGOAL_THEN `({x:real^N | norm x = &1} INTER t) DELETE (basis 1) = {x | norm x = &1 /\ ~(x$1 = &1)} INTER t` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `s DELETE a = s' ==> (s INTER t) DELETE a = s' INTER t`) THEN MATCH_MP_TAC(SET_RULE `Q a /\ (!x. P x /\ Q x ==> x = a) ==> {x | P x} DELETE a = {x | P x /\ ~Q x}`) THEN SIMP_TAC[BASIS_COMPONENT; CART_EQ; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[dot; SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN REWRITE_TAC[REAL_ARITH `&1 * &1 + s = &1 <=> s = &0`] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] SUM_POS_EQ_0_NUMSEG)) THEN REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY ABBREV_TAC [`f = \x:real^N. &2 % basis 1 + &2 / (&1 - x$1) % (x - basis 1)`; `g = \y:real^N. basis 1 + &4 / (norm y pow 2 + &4) % (y - &2 % basis 1)`] THEN MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET] `f continuous_on s ==> f continuous_on (s INTER t)`) THEN EXPAND_TAC "f" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[REAL_SUB_0; IN_ELIM_THM] THEN REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1]; MATCH_MP_TAC(SET_RULE `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB] THEN REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; LE_REFL; DIMINDEX_GE_1; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET] `f continuous_on s ==> f continuous_on (s INTER t)`) THEN EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN SIMP_TAC[LIFT_ADD; REAL_POW_LE; NORM_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[REAL_POW_2; LIFT_CMUL; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF]; MATCH_MP_TAC(SET_RULE `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN EXPAND_TAC "g" THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB]] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_ARITH `b + a % (y - &2 % b):real^N = (&1 - &2 * a) % b + a % y`] THEN REWRITE_TAC[NORM_POW_2; VECTOR_ARITH `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; LE_REFL; VECTOR_ADD_COMPONENT; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; GSYM REAL_POW_2] THEN SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` MP_TAC THENL [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`]; CONV_TAC REAL_FIELD]; SUBGOAL_THEN `!x. norm x = &1 /\ ~(x$1 = &1) ==> norm((f:real^N->real^N) x) pow 2 = &4 * (&1 + x$1) / (&1 - x$1)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "f" THEN REWRITE_TAC[VECTOR_ARITH `a % b + m % (x - b):real^N = (a - m) % b + m % x`] THEN REWRITE_TAC[NORM_POW_2; VECTOR_ARITH `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_COMPONENT] THEN ASM_REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_2; REAL_MUL_RID; REAL_POW_ONE] THEN UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN EXPAND_TAC "g" THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &1) ==> &4 * (&1 + x) / (&1 - x) + &4 = &8 / (&1 - x)`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REWRITE_TAC[REAL_ARITH `&4 * inv(&8) * x = x / &2`] THEN EXPAND_TAC "f" THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD; X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` ASSUME_TAC THENL [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`]; ALL_TAC] THEN SUBGOAL_THEN `((g:real^N->real^N) y)$1 = (y dot y - &4) / (y dot y + &4)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[BASIS_COMPONENT; LE_REFL; NORM_POW_2; DIMINDEX_GE_1] THEN UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "g" THEN SIMP_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; NORM_POW_2] THEN DISJ1_TAC THEN UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN CONV_TAC REAL_FIELD]);; let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN = prove (`!s:real^N->bool t:real^M->bool a. convex s /\ bounded s /\ a IN relative_frontier s /\ affine t /\ aff_dim s = aff_dim t + &1 ==> (relative_frontier s DELETE a) homeomorphic t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_GE; INT_ARITH `--(&1):int <= s ==> ~(--(&1) = s + &1)`] THEN MP_TAC(ISPECL [`(:real^N)`; `aff_dim(s:real^N->bool)`] CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV] THEN REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFFINE_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(t:real^N->bool = {})` MP_TAC THENL [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `ball(z:real^N,&1) INTER t`] HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN MP_TAC(ISPECL [`t:real^N->bool`; `ball(z:real^N,&1)`] (ONCE_REWRITE_RULE[INTER_COMM] AFF_DIM_CONVEX_INTER_OPEN)) THEN MP_TAC(ISPECL [`ball(z:real^N,&1)`; `t:real^N->bool`] RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; CONVEX_BALL; AFFINE_IMP_CONVEX; INTERIOR_OPEN; OPEN_BALL; FRONTIER_BALL; REAL_LT_01] THEN SUBGOAL_THEN `~(ball(z:real^N,&1) INTER t = {})` ASSUME_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01]; ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN SIMP_TAC[]] THEN REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM homeomorphic] THEN TRANS_TAC HOMEOMORPHIC_TRANS `(sphere(z,&1) INTER t) DELETE (h:real^N->real^N) a` THEN CONJ_TAC THENL [REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET]; ASM SET_TAC[]; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET]; ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]; MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN ASM_REWRITE_TAC[REAL_LT_01; GSYM IN_INTER] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN ASM SET_TAC[]]);; let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE = prove (`!a r b:real^N t:real^M->bool. &0 < r /\ b IN sphere(a,r) /\ affine t /\ aff_dim(t) + &1 = &(dimindex(:N)) ==> (sphere(a:real^N,r) DELETE b) homeomorphic t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`cball(a:real^N,r)`; `t:real^M->bool`; `b:real^N`] HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL; CONVEX_CBALL; BOUNDED_CBALL]);; let HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE = prove (`!a r b c d. &0 < r /\ b IN sphere(a,r) /\ ~(c = vec 0) ==> (sphere(a:real^N,r) DELETE b) homeomorphic {x:real^N | c dot x = d}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE THEN ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);; let HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV = prove (`!a r b. &0 < r /\ b IN sphere(a,r) /\ dimindex(:N) = dimindex(:M) + 1 ==> (sphere(a:real^N,r) DELETE b) homeomorphic (:real^M)`, REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis 1 dot x = &0}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANE_UNIV; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE]);; let CONTRACTIBLE_PUNCTURED_SPHERE = prove (`!a r b:real^N. &0 < r /\ b IN sphere(a,r) ==> contractible(sphere(a,r) DELETE b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `contractible {x:real^N | basis 1 dot x = &0}` MP_TAC THENL [SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_HYPERPLANE]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_CONTRACTIBLE) THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE THEN ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]]);; let CONNECTED_PUNCTURED_SPHERE = prove (`!a r b:real^N. connected(sphere(a,r) DELETE b) <=> (dimindex(:N) = 1 /\ &0 < r ==> b IN sphere(a,r))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; EMPTY_DELETE; NOT_IN_EMPTY; CONNECTED_EMPTY] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL] THENL [SUBGOAL_THEN `{a:real^N} DELETE b = {a} \/ {a} DELETE b = {}` MP_TAC THENL [SET_TAC[]; DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC)] THEN REWRITE_TAC[CONNECTED_EMPTY; CONNECTED_SING]; ALL_TAC] THEN SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`] HAS_SIZE_SPHERE_2) THEN ASM_REWRITE_TAC[] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN ASM_CASES_TAC `b:real^N = u` THENL [SUBGOAL_THEN `{u:real^N,v} DELETE b = {v}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[CONNECTED_SING]]; ALL_TAC] THEN ASM_CASES_TAC `b:real^N = v` THENL [SUBGOAL_THEN `{u:real^N,v} DELETE b = {u}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[CONNECTED_SING]]; ALL_TAC] THEN SUBGOAL_THEN `{u:real^N,v} DELETE b = {u,v}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[CONNECTED_2] THEN ASM SET_TAC[]]; ASM_CASES_TAC `b IN sphere(a:real^N,r)` THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`; `b:real^N`; `basis 1:real^N`; `&0`] HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE) THEN ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_CONNECTEDNESS) THEN SIMP_TAC[CONVEX_HYPERPLANE; CONVEX_CONNECTED]; ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN MATCH_MP_TAC CONNECTED_SPHERE THEN MATCH_MP_TAC(ARITH_RULE `1 <= n /\ ~(n = 1) ==> 2 <= n`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1]]]);; let CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ = prove (`!a b r u s:real^N->bool. 3 <= dimindex(:N) /\ open_in (subtopology euclidean (sphere(a,r))) u /\ b IN u /\ u SUBSET s /\ s SUBSET sphere(a,r) ==> (connected(s DELETE b) <=> connected s)`, REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (SET_RULE `s DELETE (b:real^N) = s \/ b IN s`) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_CASES_TAC `s = {b:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING; CONNECTED_EMPTY; SET_RULE `{b} DELETE b = {}`] THEN ASM_CASES_TAC `r < &0` THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_EQ_EMPTY) THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_NOT_LE])] THEN ASM_CASES_TAC `r = &0` THENL [MP_TAC(ISPECL [`a:real^N`; `r:real`; `a:real^N`] SPHERE_EQ_SING) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN ASM_CASES_TAC `s = sphere(a:real^N,r)` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CONNECTED_PUNCTURED_SPHERE; CONNECTED_SPHERE_EQ] THEN DISJ1_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?c:real^N. c IN sphere(a,r) /\ ~(c IN s) /\ ~(c = b)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `sphere(a:real^N,r) DELETE c homeomorphic (:real^(N,1)finite_diff)` MP_TAC THENL [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN ASM_REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN ASM_ARITH_TAC; REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^(N,1)finite_diff`; `g:real^(N,1)finite_diff->real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CONNECTEDNESS)) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `s DELETE (b:real^N)` th) THEN MP_TAC(SPEC `s:real^N->bool` th)) THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN SUBGOAL_THEN `IMAGE (f:real^N->real^(N,1)finite_diff) (s DELETE b) = IMAGE f s DELETE f b` SUBST1_TAC THENL [MATCH_MP_TAC IMAGE_DELETE_INJ_ALT THEN ASM_REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_UNIV]) THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_DELETE_INTERIOR_POINT_EQ THEN REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[OPEN_IN]] THEN MATCH_MP_TAC(SET_RULE `!u. b IN u /\ IMAGE f u SUBSET t ==> f b IN t`) THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN SUBGOAL_THEN `open_in (subtopology euclidean (sphere(a:real^N,r) DELETE c)) u` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_OPENNESS THEN EXISTS_TAC `g:real^(N,1)finite_diff->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let CONNECTED_OPEN_IN_SPHERE_DELETE_EQ = prove (`!a b r s:real^N->bool. 3 <= dimindex(:N) /\ open_in (subtopology euclidean (sphere(a,r))) s ==> (connected(s DELETE b) <=> connected s)`, REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (SET_RULE `s DELETE (b:real^N) = s \/ b IN s`) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MATCH_MP_TAC CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[SUBSET_REFL]);; let CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE = prove (`!g s:real^N->bool. simple_path g /\ pathfinish g = pathstart g /\ s SUBSET path_image g ==> (connected(path_image g DIFF s) <=> connected s)`, SUBGOAL_THEN `!g s:real^N->bool. simple_path g /\ pathfinish g = pathstart g /\ s SUBSET path_image g ==> ~connected s ==> ~connected(path_image g DIFF s)` MP_TAC THENL [ALL_TAC; MESON_TAC[SUBSET_DIFF; SET_RULE `s SUBSET t ==> t DIFF (t DIFF s) = s`]] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CONNECTED_IFF_CONNECTED_COMPONENT] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:real^1->real^N`; `a:real^N`; `b:real^N`] EXISTS_DOUBLE_ARC) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`g1:real^1->real^N`; `g2:real^1->real^N`] THEN STRIP_TAC THEN REWRITE_TAC[CONNECTED_CLOSED] THEN MAP_EVERY EXISTS_TAC [`path_image g1:real^N->bool`;`path_image g2:real^N->bool`] THEN ASM_SIMP_TAC[CLOSED_PATH_IMAGE; ARC_IMP_PATH] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `~connected_component s (a:real^N) b` THEN REWRITE_TAC[connected_component] THENL [EXISTS_TAC `path_image g1:real^N->bool`; EXISTS_TAC `path_image g2:real^N->bool`] THEN ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]);; let CONNECTED_COMPLEMENT_SUBSET_CIRCLE = prove (`!s a:real^N r. dimindex(:N) = 2 /\ s SUBSET sphere(a,r) ==> (connected(sphere(a,r) DIFF s) <=> connected s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; SUBSET_EMPTY; DIFF_EQ_EMPTY] THEN ASM_CASES_TAC `r = &0` THENL [ASM_SIMP_TAC[SPHERE_SING; SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN STRIP_TAC THEN ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_EMPTY; CONNECTED_SING; DIFF_EQ_EMPTY]; SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN STRIP_TAC THEN MP_TAC(ISPECL [`cball(a:real^N,r)`; `cball(vec 0:real^2,r)`] HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL] THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL] THEN ASM_REWRITE_TAC[DIMINDEX_2] THEN ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_MESON_TAC[CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE]);; (* ------------------------------------------------------------------------- *) (* When dealing with AR, ANR and ANR later, it's useful to know that any set *) (* at all is homeomorphic to a closed subset of a convex set, and if the *) (* set is locally compact we can take the convex set to be the universe. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_CLOSED_IN_CONVEX = prove (`!s:real^M->bool. aff_dim s < &(dimindex(:N)) ==> ?u t:real^N->bool. convex u /\ ~(u = {}) /\ closed_in (subtopology euclidean u) t /\ s homeomorphic t`, GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN REWRITE_TAC[CONVEX_UNIV; UNIV_NOT_EMPTY; CLOSED_IN_EMPTY] THEN ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^M` MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^M` THEN SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LT] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{x:real^N | x$1 = &0}`; `dim(s:real^M->bool)`] CHOOSE_SUBSPACE_OF_SUBSPACE) THEN SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_GE_1; LE_REFL; SUBSET; IN_ELIM_THM; SPAN_OF_SUBSPACE; SUBSPACE_SPECIAL_HYPERPLANE] THEN ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`span s:real^M->bool`; `t:real^N->bool`] ISOMETRIES_SUBSPACES) THEN ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`vec 0:real^N`; `&1`; `basis 1:real^N`; `{x:real^N | basis 1 dot x = &0}`] HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE) THEN SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; REAL_LT_01; IN_SPHERE_0; NORM_BASIS] THEN ANTS_TAC THENL [INT_ARITH_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; homeomorphic] THEN REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `ball(vec 0,&1) UNION IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN EXISTS_TAC `IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONVEX_INTERMEDIATE_BALL THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; BALL_SUBSET_CBALL] THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_CBALL_0] THEN ASM_MESON_TAC[SPAN_SUPERSET; REAL_LE_REFL]; REWRITE_TAC[NOT_IN_EMPTY; IMAGE_o] THEN ASM SET_TAC[]; REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `sphere(vec 0:real^N,&1)` THEN REWRITE_TAC[CLOSED_SPHERE] THEN MATCH_MP_TAC(SET_RULE `b INTER t = {} /\ s SUBSET t ==> s = (b UNION s) INTER t`) THEN REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[SUBSET]] THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_SPHERE_0] THEN ASM_MESON_TAC[SPAN_SUPERSET]; MAP_EVERY EXISTS_TAC [`(k:real^N->real^M) o (g:real^N->real^N)`; `(f:real^N->real^N) o (h:real^M->real^N)`] THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN MP_TAC(ISPEC `s:real^M->bool` SPAN_INC) THEN ASM SET_TAC[]]);; let LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED = prove (`!s:real^M->bool. locally compact s /\ dimindex(:M) < dimindex(:N) ==> ?t:real^N->bool. closed t /\ s homeomorphic t`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?t:real^(M,1)finite_sum->bool h. closed t /\ homeomorphism (s,t) (h,fstcart)` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED]; ALL_TAC] THEN ABBREV_TAC `f:real^(M,1)finite_sum->real^N = \x. lambda i. if i <= dimindex(:M) then x$i else x$(dimindex(:M)+1)` THEN ABBREV_TAC `g:real^N->real^(M,1)finite_sum = (\x. lambda i. x$i)` THEN EXISTS_TAC `IMAGE (f:real^(M,1)finite_sum->real^N) t` THEN SUBGOAL_THEN `linear(f:real^(M,1)finite_sum->real^N)` ASSUME_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[linear; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `linear(g:real^N->real^(M,1)finite_sum)` ASSUME_TAC THENL [EXPAND_TAC "g" THEN REWRITE_TAC[linear; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. (g:real^N->real^(M,1)finite_sum)((f:real^(M,1)finite_sum->real^N) x) = x` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["f"; "g"] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `m < n ==> !i. i <= m + 1 ==> i <= n`)) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]; ALL_TAC] THEN TRANS_TAC HOMEOMORPHIC_TRANS `t:real^(M,1)finite_sum->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC [`f:real^(M,1)finite_sum->real^N`; `g:real^N->real^(M,1)finite_sum`] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Simple connectedness of a union. This is essentially a stripped-down *) (* version of the Seifert - Van Kampen theorem. *) (* ------------------------------------------------------------------------- *) let SIMPLY_CONNECTED_UNION = prove (`!s t:real^N->bool. open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t /\ simply_connected s /\ simply_connected t /\ path_connected (s INTER t) /\ ~(s INTER t = {}) ==> simply_connected (s UNION t)`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; PATH_CONNECTED_UNION] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(pathstart p:real^N) IN s UNION t` MP_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REWRITE_TAC[IN_UNION]] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN MAP_EVERY (fun s -> let x = mk_var(s,`:real^N->bool`) in SPEC_TAC(x,x)) ["v"; "u"; "t"; "s"] THEN MATCH_MP_TAC(MESON[] `(!s t u v. x IN s ==> P x s t u v) /\ (!x s t u v. P x s t u v ==> P x t s v u) ==> (!s t u v. x IN s \/ x IN t ==> P x s t u v)`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC; REPEAT GEN_TAC THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[]] THEN SUBGOAL_THEN `?e. &0 < e /\ !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\ norm(x - y) < e ==> path_image(subpath x y p) SUBSET (s:real^N->bool) \/ path_image(subpath x y p) SUBSET t` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `path_image(p:real^1->real^N)` HEINE_BOREL_LEMMA) THEN ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `{u:real^N->bool,v}`) THEN SIMP_TAC[UNIONS_2; EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`p:real^1->real^N`; `interval[vec 0:real^1,vec 1]`] COMPACT_UNIFORMLY_CONTINUOUS) THEN ASM_REWRITE_TAC[GSYM path; COMPACT_INTERVAL; uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) x`) THEN ANTS_TAC THENL [REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!p'. p SUBSET b /\ (s UNION t) INTER u = s /\ (s UNION t) INTER v = t /\ p SUBSET p' /\ p' SUBSET s UNION t ==> (b SUBSET u \/ b SUBSET v) ==> p SUBSET s \/ p SUBSET t`) THEN EXISTS_TAC `path_image(p:real^1->real^N)` THEN ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET] THEN REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SUBSET; FORALL_IN_IMAGE] THEN SUBGOAL_THEN `segment[x,y] SUBSET ball(x:real^1,d)` MP_TAC THENL [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL; EMPTY_SUBSET; CONVEX_BALL; dist]; REWRITE_TAC[IN_BALL; dist; SUBSET] THEN STRIP_TAC THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_1]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC]; MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN STRIP_TAC] THEN SUBGOAL_THEN `!n. n <= N /\ p(lift(&n / &N)) IN s ==> ?q. path(q:real^1->real^N) /\ path_image q SUBSET s /\ homotopic_paths (s UNION t) (subpath (vec 0) (lift(&n / &N)) p) q` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `N:num`) THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_REFL; LIFT_NUM] THEN ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` MP_TAC) THEN REWRITE_TAC[SUBPATH_TRIVIAL] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[SUBSET_UNION]] THEN SUBGOAL_THEN `!n. n < N ==> path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p) SUBSET (s:real^N->bool) \/ path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p) SUBSET t` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_SUB; DROP_VEC; NORM_REAL; GSYM drop; REAL_ARITH `abs(a / c - b / c) = abs((b - a) / c)`] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_ARITH `(x + &1) - x = &1`] THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LZERO; REAL_ABS_INV; REAL_ABS_NUM; REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM] THEN EXISTS_TAC `linepath((p:real^1->real^N)(vec 0),p(vec 0))` THEN REWRITE_TAC[SUBPATH_REFL; HOMOTOPIC_PATHS_REFL] THEN REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN UNDISCH_TAC `(pathstart p:real^N) IN s` THEN REWRITE_TAC[pathstart] THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `\m. m < n /\ (p(lift(&m / &N)):real^N) IN s` num_MAX) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `0`; MESON_TAC[LT_IMP_LE]] THEN ASM_SIMP_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM; LE_1] THEN ASM_MESON_TAC[pathstart]; DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `?q. path q /\ path_image(q:real^1->real^N) SUBSET s /\ homotopic_paths (s UNION t) (subpath (vec 0) (lift (&m / &N)) p) q` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!i. m < i /\ i <= n ==> path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET s \/ path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET (t:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_CASES_TAC `i:num = m` THENL [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN SUBGOAL_THEN `p(lift(&i / &N)) IN t /\ ~((p(lift(&i / &N)):real^N) IN s)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `x IN s UNION t /\ ~(x IN s) ==> x IN t /\ ~(x IN s)`) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> x IN s ==> x IN t`)) THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; SUBGOAL_THEN `i < n /\ ~(i:num <= m)` MP_TAC THENL [ASM_ARITH_TAC; ASM_MESON_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET s \/ path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET (t:real^N->bool)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(x IN s) ==> (x IN p /\ x IN q) /\ (q UNION p = r) ==> p SUBSET s \/ p SUBSET t ==> q SUBSET s \/ q SUBSET t ==> r SUBSET s \/ r SUBSET t`)) THEN SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN REWRITE_TAC[GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN MATCH_MP_TAC UNION_SEGMENT THEN ASM_SIMP_TAC[SEGMENT_1; LIFT_DROP; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_LE; LT_IMP_LE; IN_INTERVAL_1] THEN ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL]] THEN STRIP_TAC THENL [EXISTS_TAC `(q:real^1->real^N) ++ subpath (lift(&m / &N)) (lift (&n / &N)) p` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_JOIN_IMP THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN DISCH_TAC THEN MATCH_MP_TAC PATH_SUBPATH THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++ subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN MATCH_MP_TAC PATH_SUBPATH] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; SUBGOAL_THEN `(p(lift(&m / &N)):real^N) IN t /\ (p(lift(&n / &N)):real^N) IN t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; SUBSET]; ALL_TAC] THEN UNDISCH_TAC `path_connected(s INTER t:real^N->bool)` THEN REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL [`p(lift(&m / &N)):real^N`; `p(lift(&n / &N)):real^N`]) THEN ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^N` STRIP_ASSUME_TAC) THEN UNDISCH_THEN `!p. path p /\ path_image p SUBSET t /\ pathfinish p:real^N = pathstart p ==> homotopic_paths t p (linepath (pathstart p,pathstart p))` (MP_TAC o SPEC `subpath (lift(&m / &N)) (lift(&n / &N)) p ++ reversepath(r:real^1->real^N)`) THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN ANTS_TAC THENL [ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN MATCH_MP_TAC PATH_JOIN_IMP THEN ASM_SIMP_TAC[PATH_REVERSEPATH; PATHFINISH_SUBPATH; PATHSTART_REVERSEPATH] THEN MATCH_MP_TAC PATH_SUBPATH THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_SUBPATH; PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_LOOP_PARTS)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN REPLICATE_TAC 2 (DISCH_THEN(ASSUME_TAC o SYM)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `(q:real^1->real^N) ++ r` THEN ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++ subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION]]]);; (* ------------------------------------------------------------------------- *) (* Basic results about topological dimension. *) (* ------------------------------------------------------------------------- *) let dimension = new_definition `(dimension:(real^N->bool)->int) s = if s = {} then --(&1) else &(minimal n. (subtopology euclidean s) dimension_le &n)`;; let DIMENSION_GE = prove (`!s:real^N->bool. -- &1 <= dimension s`, GEN_TAC THEN REWRITE_TAC[dimension; INT_LE_REFL] THEN INT_ARITH_TAC);; let DIMENSION_LE_IMP_GE = prove (`!s:real^N->bool n. dimension s <= n ==> -- &1 <= n`, REWRITE_TAC[GSYM INT_LE_TRANS_LE; DIMENSION_GE]);; let (HOMEOMORPHIC_DIMENSION,DIMENSION_LE_EQ, LOCALLY_DIMENSION_LE, DIMENSION_LE_AFF_DIM,DIMENSION_DIMENSION_LE) = let HOMEOMORPHIC_DIMENSION_LE' = prove (`!s:real^M->bool t:real^N->bool n. s homeomorphic t ==> (subtopology euclidean s dimension_le n <=> subtopology euclidean t dimension_le n)`, let lemma = prove (`!n s:real^M->bool t:real^N->bool. s homeomorphic t /\ (subtopology euclidean s) dimension_le (&n - &1) ==> (subtopology euclidean t) dimension_le (&n - &1)`, INDUCT_TAC THENL [CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[DIMENSION_LE_EQ_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN MESON_TAC[HOMEOMORPHIC_EMPTY]; REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `(x + y) - y:int = x`]] THEN MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `t:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[DIMENSION_LE_CASES] THEN SIMP_TAC[SUBTOPOLOGY_SUBTOPOLOGY; FRONTIER_OF_SUBSET_SUBTOPOLOGY; SET_RULE `t SUBSET s ==> s INTER t = t`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `b:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`IMAGE (g:real^N->real^M) v`; `(g:real^N->real^M) b`]) THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) u` THEN REPEAT CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `subtopology euclidean s frontier_of u:real^M->bool` THEN ASM_REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN REWRITE_TAC[FRONTIER_OF_SUBSET_SUBTOPOLOGY] THEN MATCH_MP_TAC HOMEOMORPHISM_FRONTIER_OF THEN EXISTS_TAC `g:real^N->real^M` THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]]) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `-- &1:int <= n` THENL [ALL_TAC; ASM_MESON_TAC[DIMENSION_LE_BOUND]] THEN SUBST1_TAC(INT_ARITH `n:int = (n + &1) - &1`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `--x:int <= y ==> &0 <= y + x`)) THEN REWRITE_TAC[GSYM INT_OF_NUM_EXISTS; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN DISCH_THEN SUBST1_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] lemma) THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]) in let DIMENSION_LE_EQ' = prove (`!s:real^N->bool n. (subtopology euclidean s) dimension_le n <=> -- &1 <= n /\ !v a. open v /\ a IN v /\ a IN s ==> ?u. a IN u /\ u SUBSET v /\ open u /\ subtopology euclidean (s INTER frontier u) dimension_le (n - &1)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_SUBTOPOLOGY] THEN REWRITE_TAC[GSYM OPEN_IN] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC (BINOP_CONV o funpow 2 BINDER_CONV o RAND_CONV o ONCE_DEPTH_CONV) [TAUT `open(u:real^N->bool) /\ p <=> ~(open u ==> ~p)`] THEN SIMP_TAC[frontier; INTERIOR_OPEN; FRONTIER_OF_CLOSURES] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REWRITE_TAC[SET_RULE `s DIFF s INTER u = s INTER (UNIV DIFF u)`] THEN SIMP_TAC[CLOSURE_OF_CLOSED_IN; CLOSED_IN_CLOSED_INTER; GSYM OPEN_CLOSED] THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY] THEN REWRITE_TAC[TAUT `~(p ==> ~q) <=> p /\ q`] THEN REWRITE_TAC[SET_RULE `s INTER s INTER u = s INTER u`] THEN REWRITE_TAC[SET_RULE `(s INTER t) INTER (s INTER (UNIV DIFF u)) = (s INTER t) DIFF u`] THEN REWRITE_TAC[EUCLIDEAN_CLOSURE_OF] THEN EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] DIMENSION_LE_SUBTOPOLOGIES) THEN MATCH_MP_TAC(SET_RULE `t SUBSET t' ==> s INTER t DIFF u SUBSET s INTER (t' DIFF u)`) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[INTER_SUBSET]] THEN SUBGOAL_THEN `?w:real^N->bool. a IN w /\ open w /\ closure w SUBSET v` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`(:real^N)`; `v:real^N->bool`; `a:real^N`] LOCALLY_CLOSED_IN_EXPLICIT) THEN ASM_SIMP_TAC[GSYM OPEN_IN; SUBTOPOLOGY_UNIV; EUCLIDEAN_CLOSURE_OF] THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s INTER u:real^N->bool`; `s DIFF closure(s INTER u):real^N->bool`] SEPARATION_CLOSURES) THEN ANTS_TAC THENL [REWRITE_TAC[SEPARATION_OPEN_IN_UNION] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s INTER t SUBSET u ==> DISJOINT (s INTER t) (s DIFF u)`) THEN REWRITE_TAC[CLOSURE_SUBSET]; REWRITE_TAC[OPEN_IN_OPEN] THEN CONJ_TAC THENL [EXISTS_TAC `u:real^N->bool`; EXISTS_TAC `(:real^N) DIFF closure(s INTER u)`] THEN ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE] THEN SET_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `t INTER v:real^N->bool` THEN ASM_SIMP_TAC[IN_INTER; INTER_SUBSET; OPEN_INTER] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] DIMENSION_LE_SUBTOPOLOGIES)) THEN MATCH_MP_TAC(SET_RULE `s DIFF d SUBSET s DIFF c /\ s INTER u SUBSET t ==> s INTER (c DIFF t) SUBSET s INTER d DIFF u`) THEN CONJ_TAC THENL [ALL_TAC; MP_TAC(ISPEC `w:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s DIFF t SUBSET u ==> s INTER u SUBSET v ==> s DIFF t SUBSET v`)) THEN MATCH_MP_TAC(SET_RULE `d SUBSET UNIV DIFF c ==> s INTER c SUBSET s DIFF d`) THEN ASM_SIMP_TAC[CLOSURE_MINIMAL_EQ; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]) in let LOCALLY_DIMENSION_LE' = prove (`!s:real^N->bool n. (subtopology euclidean s) dimension_le n <=> -- &1 <= n /\ locally (\u. (subtopology euclidean u) dimension_le n) s`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[DIMENSION_LE_BOUND]; ALL_TAC] THEN REWRITE_TAC[locally] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`v:real^N->bool`; `v:real^N->bool`] THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN FIRST_ASSUM(MP_TAC o SPEC `v:real^N->bool` o MATCH_MP DIMENSION_LE_SUBTOPOLOGY) THEN REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ'] THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s INTER v:real^N->bool`; `a:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; LEFT_IMP_EXISTS_THM; IN_INTER] THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?b:real^N->bool. a IN b /\ open b /\ s INTER closure b SUBSET w` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(a:real^N,r)` THEN ASM_SIMP_TAC[CLOSURE_BALL; OPEN_BALL; CENTRE_IN_BALL] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`b INTER v:real^N->bool`; `a:real^N`]) THEN ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s INTER frontier c:real^N->bool = u INTER frontier c` (fun th -> ASM_REWRITE_TAC[th]) THEN MP_TAC(ISPECL [`c:real^N->bool`; `b:real^N->bool`] SUBSET_CLOSURE) THEN REWRITE_TAC[frontier] THEN ASM SET_TAC[]) in let DIMENSION_LE_AFF_DIM' = prove (`!s:real^N->bool. (subtopology euclidean s) dimension_le aff_dim s`, SUBGOAL_THEN `!n s:real^N->bool. -- &1 <= n ==> aff_dim s = n ==> (subtopology euclidean s) dimension_le n` MP_TAC THENL [ALL_TAC; MESON_TAC[AFF_DIM_GE]] THEN SIMP_TAC[RIGHT_FORALL_IMP_THM; INT_ARITH `--w:int <= x <=> &0 <= x + w`] THEN REWRITE_TAC[GSYM INT_OF_NUM_EXISTS; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[INT_ARITH `x + &1:int = &n <=> x = &n - &1`] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN INDUCT_TAC THEN CONV_TAC INT_REDUCE_CONV THEN SIMP_TAC[AFF_DIM_EQ_MINUS1; DIMENSION_LE_EQ_EMPTY] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; GSYM INT_OF_NUM_SUC] THEN REWRITE_TAC[INT_ARITH `(x + &1) - &1:int = x`] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC DIMENSION_LE_SUBTOPOLOGIES THEN EXISTS_TAC `affine hull s:real^N->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ'] THEN CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o REWRITE_RULE[OPEN_CONTAINS_BALL]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN EXISTS_TAC `ball(a:real^N,r)` THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; FRONTIER_BALL] THEN ONCE_REWRITE_TAC[LOCALLY_DIMENSION_LE'] THEN CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN ONCE_REWRITE_TAC[LOCALLY_ON_OPEN_SUBSETS] THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN EXISTS_TAC `(affine hull s INTER sphere(a,r)) DELETE (&2 % a - b:real^N)` THEN ASM_SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL; IN_DELETE; IN_INTER] THEN REWRITE_TAC[NORM_ARITH `b:real^N = &2 % a - b <=> dist(a,b) = &0`] THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_SPHERE; REAL_LT_REFL]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `!p. p /\ q ==> q`) THEN EXISTS_TAC `-- &1:int <= &n - &1` THEN REWRITE_TAC[GSYM LOCALLY_DIMENSION_LE'] THEN MATCH_MP_TAC (MESON[HOMEOMORPHIC_DIMENSION_LE'] `!s:real^N->bool t:real^N->bool n. s homeomorphic t /\ subtopology euclidean t dimension_le n ==> subtopology euclidean s dimension_le n`) THEN SUBGOAL_THEN `?s:real^N->bool. affine s /\ aff_dim s = &n - &1` MP_TAC THENL [MATCH_MP_TAC AFFINE_EXISTS THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_LE_UNIV) THEN ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN SIMP_TAC[IN_SPHERE; NORM_ARITH `dist(a:real^N,&2 % a - b) = dist(a,b)`] THEN ASM_REWRITE_TAC[GSYM IN_SPHERE] THEN CONJ_TAC THENL [ALL_TAC; INT_ARITH_TAC] THEN REWRITE_TAC[VECTOR_ARITH `&2 % a - b:real^N = a - &1 % (b - a)`] THEN MATCH_MP_TAC IN_AFFINE_SUB_MUL_DIFF THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL]) in let DIMENSION_DIMENSION_LE = prove (`!s:real^N->bool n. dimension s <= n <=> (subtopology euclidean s) dimension_le n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[dimension] THENL [EQ_TAC THEN REWRITE_TAC[DIMENSION_LE_BOUND] THEN DISCH_TAC THEN MATCH_MP_TAC DIMENSION_LE_MONO THEN EXISTS_TAC `-- &1:int` THEN ASM_REWRITE_TAC[DIMENSION_LE_EQ_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; ALL_TAC] THEN ASM_CASES_TAC `--(&1):int <= n` THENL [ALL_TAC; ASM_MESON_TAC[DIMENSION_LE_BOUND; INT_ARITH `&n:int <= x ==> --(&1):int <= x `]] THEN ASM_CASES_TAC `n:int = --(&1)` THENL [ASM_REWRITE_TAC[DIMENSION_LE_EQ_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?k. n:int = &k` (CHOOSE_THEN SUBST1_TAC) THENL [REWRITE_TAC[INT_OF_NUM_EXISTS] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN MP_TAC(fst(EQ_IMP_RULE(ISPEC `\n. subtopology euclidean (s:real^N->bool) dimension_le &n` MINIMAL))) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM AFF_DIM_POS_LE]) THEN REWRITE_TAC[GSYM INT_OF_NUM_EXISTS] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[DIMENSION_LE_AFF_DIM']; ALL_TAC] THEN ABBREV_TAC `d = minimal n. subtopology euclidean (s:real^N->bool) dimension_le &n` THEN REWRITE_TAC[GSYM NOT_LE; CONTRAPOS_THM; INT_OF_NUM_LE] THEN MESON_TAC[INT_OF_NUM_LE; INT_LE_TRANS; DIMENSION_LE_MONO]) in let HOMEOMORPHIC_DIMENSION = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> dimension s = dimension t`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN ONCE_REWRITE_TAC[INT_LE_TRANS_LE] THEN REWRITE_TAC[DIMENSION_DIMENSION_LE; AND_FORALL_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(p ==> q) /\ (q ==> p) <=> (q <=> p)`] THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION_LE' THEN ASM_REWRITE_TAC[]) in let DIMENSION_LE_EQ = prove (`!s:real^N->bool n. dimension s <= n <=> -- &1 <= n /\ !v a. open v /\ a IN v /\ a IN s ==> ?u. a IN u /\ u SUBSET v /\ open u /\ dimension(s INTER frontier u) <= n - &1`, REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN MATCH_ACCEPT_TAC DIMENSION_LE_EQ') in let LOCALLY_DIMENSION_LE = prove (`!s:real^N->bool n. dimension s <= n <=> -- &1 <= n /\ locally (\u. dimension u <= n) s`, REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN MATCH_ACCEPT_TAC LOCALLY_DIMENSION_LE') in let DIMENSION_LE_AFF_DIM = prove (`!s:real^N->bool. dimension s <= aff_dim s`, REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN MATCH_ACCEPT_TAC DIMENSION_LE_AFF_DIM') in (HOMEOMORPHIC_DIMENSION,DIMENSION_LE_EQ, LOCALLY_DIMENSION_LE, DIMENSION_LE_AFF_DIM,DIMENSION_DIMENSION_LE);; let DIMENSION_TRANSLATION = prove (`!a:real^N s. dimension(IMAGE (\x. a + x) s) = dimension s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [DIMENSION_TRANSLATION];; let DIMENSION_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> dimension(IMAGE f s) = dimension s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN ASM_REWRITE_TAC[]);; add_linear_invariants [DIMENSION_LINEAR_IMAGE];; let DIMENSION_LE_DIMINDEX = prove (`!s:real^N->bool. dimension s <= &(dimindex(:N))`, MESON_TAC[INT_LE_TRANS; AFF_DIM_LE_UNIV; DIMENSION_LE_AFF_DIM]);; let DIMENSION_LE_MINUS1 = prove (`!s:real^N->bool. dimension s <= -- &1 <=> s = {}`, REWRITE_TAC[DIMENSION_DIMENSION_LE; DIMENSION_LE_EQ_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);; let DIMENSION_EQ_MINUS1 = prove (`!s:real^N->bool. dimension s = -- &1 <=> s = {}`, REWRITE_TAC[GSYM INT_LE_ANTISYM; DIMENSION_GE; DIMENSION_LE_MINUS1]);; let DIMENSION_POS_LE = prove (`!s:real^N->bool. &0 <= dimension s <=> ~(s = {})`, SIMP_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; INT_ARITH `-- &1:int <= d ==> (&0 <= d <=> ~(d = -- &1))`]);; let DIMENSION_EMPTY = prove (`dimension {} = -- &1`, REWRITE_TAC[DIMENSION_EQ_MINUS1]);; let DIMENSION_SUBSET = prove (`!s t:real^N->bool. s SUBSET t ==> dimension s <= dimension t`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INT_LE_TRANS_LE] THEN REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN ASM_MESON_TAC[DIMENSION_LE_SUBTOPOLOGIES]);; let DIMENSION_LE_EQ_ALT = prove (`!s:real^N->bool n. dimension s <= n <=> -- &1 <= n /\ !v a. open v /\ a IN v /\ a IN s ==> ?u. a IN u /\ u SUBSET v /\ open u /\ dimension(subtopology euclidean s frontier_of (s INTER u)) <= n - &1`, REPEAT GEN_TAC THEN REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_SUBTOPOLOGY] THEN REWRITE_TAC[GSYM OPEN_IN]);; let DIMENSION_LE_EQ_LOCAL = prove (`!s:real^N->bool n. dimension s <= n <=> -- &1 <= n /\ !v a. open_in (subtopology euclidean s) v /\ a IN v ==> ?u. a IN u /\ u SUBSET v /\ open_in (subtopology euclidean s) u /\ dimension(subtopology euclidean s frontier_of u) <= n - &1`, REPEAT GEN_TAC THEN REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_CASES] THEN REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN REWRITE_TAC[GSYM DIMENSION_DIMENSION_LE] THEN SIMP_TAC[FRONTIER_OF_SUBSET_SUBTOPOLOGY; SET_RULE `t SUBSET s ==> s INTER t = t`]);; let DIMENSION_LE_EQ_GENERAL = prove (`!t s:real^N->bool n. s SUBSET t ==> (dimension s <= n <=> -- &1 <= n /\ !v a. open_in (subtopology euclidean t) v /\ a IN v /\ a IN s ==> ?u. a IN u /\ u SUBSET v /\ open_in (subtopology euclidean t) u /\ dimension(s INTER subtopology euclidean t frontier_of u) <= n - &1)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ]; GEN_REWRITE_TAC RAND_CONV [DIMENSION_LE_EQ_LOCAL]] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER]) THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t INTER u:real^N->bool`; SUBGOAL_THEN `(a:real^N) IN t` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t INTER v:real^N->bool`; `a:real^N`]) THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `uu:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER]) THEN EXISTS_TAC `s INTER u:real^N->bool`] THEN (ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS)) THEN MATCH_MP_TAC DIMENSION_SUBSET THEN REWRITE_TAC[FRONTIER_OF_CLOSURES; FRONTIER_CLOSURES] THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]) THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t /\ c1 SUBSET c1' /\ c2 SUBSET c2' ==> s INTER (t INTER c1) INTER t INTER c2 SUBSET s INTER c1' INTER c2'`); MATCH_MP_TAC(SET_RULE `s SUBSET t /\ c1 SUBSET c1' /\ c2 SUBSET c2' ==> (s INTER c1) INTER s INTER c2 SUBSET s INTER (t INTER c1') INTER (t INTER c2')`)] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]);; let DIMENSION_LE_EQ_LOCALLY = prove (`!s:real^N->bool n. dimension s <= n <=> --(&1) <= n /\ locally (\u. open_in (subtopology euclidean s) u /\ dimension(subtopology euclidean s frontier_of u) <= n - &1) s`, REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_LOCAL] THEN MESON_TAC[SUBSET]);; let LOCALLY_OPEN_AND_DIMENSION_LE = prove (`!s n. dimension s <= n <=> -- &1 <= n /\ locally (\u. open_in (subtopology euclidean s) u /\ dimension u <= n) s`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_DIMENSION_LE] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [LOCALLY_AND_OPEN_IN] THEN REWRITE_TAC[locally] THEN MESON_TAC[DIMENSION_SUBSET; INT_LE_TRANS; SUBSET_TRANS]);; let DIMENSION_EQ_ON_NBDS = prove (`!s:real^N->bool n. ~(s = {}) /\ (!x. x IN s ==> ?u v. x IN u /\ open_in (subtopology euclidean s) u /\ u SUBSET v /\ v SUBSET s /\ dimension v = n) ==> dimension s = n`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `dimension(v:real^N->bool) <= dimension(s:real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[DIMENSION_SUBSET]; ASM_REWRITE_TAC[]] THEN SIMP_TAC[GSYM INT_LE_ANTISYM] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[LOCALLY_DIMENSION_LE] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIMENSION_GE]; ALL_TAC] THEN ONCE_REWRITE_TAC[LOCALLY_ON_NBDS] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM INT_LE_ANTISYM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LOCALLY_DIMENSION_LE] THEN SIMP_TAC[]);; let LOCALLY_DIMENSION_EQ = prove (`!s:real^N->bool n. ~(s = {}) /\ locally (\u. dimension u = n) s ==> dimension s = n`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN REWRITE_TAC[OPEN_IN_REFL] THEN DISCH_TAC THEN MATCH_MP_TAC DIMENSION_EQ_ON_NBDS THEN ASM_MESON_TAC[]);; let DIMENSION_EQ_ON_OPEN_SUBSETS = prove (`!s:real^N->bool n. ~(s = {}) /\ (!x. x IN s ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\ dimension u = n) ==> dimension s = n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIMENSION_EQ_ON_NBDS THEN ASM_MESON_TAC[SUBSET_REFL; OPEN_IN_IMP_SUBSET]);; let DIMENSION_EQ_LOCALLY_CLOPEN = prove (`!s:real^N->bool. dimension s <= &0 <=> locally (\u. closed_in (subtopology euclidean s) u /\ open_in (subtopology euclidean s) u) s`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_LOCALLY] THEN CONV_TAC INT_REDUCE_CONV THEN SIMP_TAC[DIMENSION_LE_MINUS1] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:real^N->bool` THEN ASM_CASES_TAC `open_in (subtopology euclidean s) (u:real^N->bool)` THEN ASM_MESON_TAC[FRONTIER_OF_EQ_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; OPEN_IN_IMP_SUBSET]);; let SMALL_INDUCTIVE_DIMENSION = prove (`!s:real^N->bool n. dimension s <= n <=> -- &1 <= n /\ !c a. a IN s /\ closed_in (subtopology euclidean s) c /\ ~(a IN c) ==> ?b. closed_in (subtopology euclidean s) b /\ dimension b <= n - &1 /\ ?u v. open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean s) v /\ DISJOINT u v /\ u UNION v = s DIFF b /\ a IN u /\ c SUBSET v`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_LOCAL] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `?v:real^N->bool. a IN v /\ open_in (subtopology euclidean s) v /\ DISJOINT ((subtopology euclidean s) closure_of v) c` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF c:real^N->bool`; `a:real^N`] LOCALLY_CLOSED_IN_EXPLICIT) THEN ASM_SIMP_TAC[IN_DIFF; OPEN_IN_DIFF; OPEN_IN_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `subtopology euclidean s frontier_of u:real^N->bool` THEN ASM_REWRITE_TAC[CLOSED_IN_FRONTIER_OF] THEN MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `s DIFF (subtopology euclidean s closure_of u):real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_CLOSURE_OF; FRONTIER_OF_CLOSURES; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; CLOSED_IN_DIFF; CLOSED_IN_REFL; CLOSURE_OF_CLOSED_IN] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `u SUBSET t ==> DISJOINT u (s DIFF t)`) THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_MESON_TAC[OPEN_IN_SUBSET]; MATCH_MP_TAC(SET_RULE `u SUBSET u' /\ u' SUBSET s ==> u UNION (s DIFF u') = s DIFF (u' INTER (s DIFF u))`) THEN REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY] THEN ASM_SIMP_TAC[CLOSURE_OF_SUBSET; OPEN_IN_SUBSET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT v c ==> c SUBSET s /\ u SUBSET v ==> c SUBSET s DIFF u`)) THEN ASM_MESON_TAC[CLOSURE_OF_MONO; CLOSED_IN_IMP_SUBSET]]; MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s DIFF w:real^N->bool`; `a:real^N`]) THEN ASM_SIMP_TAC[IN_DIFF; CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real^N->bool`; `u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC INT_LE_TRANS `dimension(b:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `u UNION v = s DIFF b ==> f SUBSET s /\ DISJOINT f u /\ DISJOINT f v ==> f SUBSET b`)) THEN REWRITE_TAC[FRONTIER_OF_SUBSET_SUBTOPOLOGY] THEN ASM_SIMP_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_CLOSED_IN; CLOSED_IN_REFL; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; CLOSED_IN_DIFF] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `v INTER s = {} ==> DISJOINT (s INTER c) v`) THEN ASM_SIMP_TAC[OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY; OPEN_IN_SUBSET] THEN ASM SET_TAC[]]);; let SMALL_IMP_DIMENSION_LE_0 = prove (`!s:real^N->bool. s <_c (:real) ==> dimension s <= &0`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ] THEN CONV_TAC INT_REDUCE_CONV THEN SIMP_TAC[DIMENSION_GE; INT_ARITH `a:int <= d ==> (d <= a <=> d = a)`] THEN REWRITE_TAC[DIMENSION_EQ_MINUS1] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(interval(vec 0,lift r) SUBSET IMAGE (\x:real^N. lift(dist(a,x))) s)` MP_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN W(MP_TAC o PART_MATCH lhand CARD_LE_IMAGE o rand o lhand o snd) THEN PURE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_TRANS) THEN REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC(CONJUNCT2 CARD_EQ_INTERVAL) THEN ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC; LIFT_DROP]; REWRITE_TAC[SUBSET; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM; FORALL_LIFT; IN_INTERVAL_1] THEN X_GEN_TAC `p:real` THEN REWRITE_TAC[LIFT_EQ; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> q ==> ~p`] THEN STRIP_TAC THEN EXISTS_TAC `ball(a:real^N,p)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; GSYM SUBSET] THEN ASM_SIMP_TAC[FRONTIER_BALL; sphere] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN TRANS_TAC SUBSET_TRANS `ball(a:real^N,r)` THEN ASM_SIMP_TAC[SUBSET_BALL; REAL_LT_IMP_LE]]);; let COUNTABLE_IMP_DIMENSION_LE_0 = prove (`!s:real^N->bool. COUNTABLE s ==> dimension s <= &0`, SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL; SMALL_IMP_DIMENSION_LE_0]);; let FINITE_IMP_DIMENSION_LE_0 = prove (`!s:real^N->bool. FINITE s ==> dimension s <= &0`, SIMP_TAC[COUNTABLE_IMP_DIMENSION_LE_0; FINITE_IMP_COUNTABLE]);; let DIMENSION_SING = prove (`!a:real^N. dimension {a} = &0`, GEN_TAC THEN MATCH_MP_TAC(INT_ARITH `-- &1:int <= x /\ x <= &0 /\ ~(x = -- &1) ==> x = &0`) THEN REWRITE_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; NOT_INSERT_EMPTY] THEN SIMP_TAC[FINITE_IMP_DIMENSION_LE_0; FINITE_SING]);; let CONNECTED_DIMENSION_EQ_SING = prove (`!s:real^N->bool. connected s ==> (dimension s = &0 <=> ?a. s = {a})`, REPEAT GEN_TAC THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[DIMENSION_SING] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (!a b. ~(a = b) /\ a IN s /\ b IN s ==> F) ==> ?a. s = {a}`) THEN ASM_REWRITE_TAC[GSYM DIMENSION_EQ_MINUS1] THEN CONV_TAC INT_REDUCE_CONV THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `i:int = &0 ==> i <= &0`)) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SMALL_INDUCTIVE_DIMENSION] THEN CONV_TAC INT_REDUCE_CONV THEN SIMP_TAC[DIMENSION_GE; INT_ARITH `a:int <= d ==> (d <= a <=> d = a)`] THEN REWRITE_TAC[DIMENSION_EQ_MINUS1] THEN DISCH_THEN(MP_TAC o SPECL [`{b:real^N}`; `a:real^N`]) THEN ASM_REWRITE_TAC[CLOSED_IN_SING; IN_SING; SING_SUBSET] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2; CLOSED_IN_EMPTY] THEN REWRITE_TAC[NOT_EXISTS_THM; DIFF_EMPTY] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN_EQ]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN ASM SET_TAC[]);; let DIMENSION_SUBSET_EXISTS = prove (`!s:real^N->bool n. -- &1 <= n /\ n <= dimension s ==> ?t. closed_in (subtopology euclidean s) t /\ t SUBSET s /\ dimension t = n`, let lemma = prove (`!s:real^N->bool. ~(s = {}) ==> ?t. closed_in (subtopology euclidean s) t /\ dimension t = dimension s - &1`, REPEAT STRIP_TAC THEN MP_TAC(INT_ARITH `dimension(s:real^N->bool) <= dimension(s) /\ ~(dimension s <= dimension s - &1)`) THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ_ALT] THEN ASM_REWRITE_TAC[DIMENSION_GE; DIMENSION_POS_LE; INT_ARITH `--a:int <= d - a <=> &0 <= d`] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!x y. P x y ==> Q x y) /\ ~(!x y. P x y ==> R x y) ==> (?x y. P x y) ==> ~(!x y. Q x y ==> R x y)`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_UNIV; IN_UNIV; MEMBER_NOT_EMPTY]; ALL_TAC] THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN MATCH_MP_TAC(INT_ARITH `~(x:int = s - &1) ==> x <= s - &1 ==> x <= s - &1 - &1`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CLOSED_IN_FRONTIER_OF]) in REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[INT_ARITH `-- &1:int <= n /\ n <= s <=> &0 <= s - n /\ -- &1 <= s - (s - n)`] THEN ASM_CASES_TAC `!t:real^N->bool. dimension t = n <=> dimension t = dimension(s:real^N->bool) - (dimension s - n)` THENL [POP_ASSUM(fun th -> ONCE_REWRITE_TAC[th]); ASM_INT_ARITH_TAC] THEN SPEC_TAC(`dimension(s:real^N->bool) - n`,`d:int`) THEN REWRITE_TAC[IMP_CONJ; GSYM INT_FORALL_POS] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [REWRITE_TAC[INT_SUB_RZERO] THEN MESON_TAC[CLOSED_IN_REFL; SUBSET_REFL]; X_GEN_TAC `d:num`] THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `--a:int <= d - (x + a) <=> x <= d`] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (INT_ARITH `d:int <= s ==> d = s \/ d < s`)) THENL [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[CLOSED_IN_EMPTY; EMPTY_SUBSET; DIMENSION_EMPTY] THEN INT_ARITH_TAC; ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `t:real^N->bool` lemma) THEN ASM_REWRITE_TAC[GSYM DIMENSION_EQ_MINUS1] THEN ANTS_TAC THENL [ASM_INT_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `u:real^N->bool` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[CLOSED_IN_TRANS]; ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; SUBSET_TRANS]; INT_ARITH_TAC]]);; let DIMENSION_UNION_LE_BASIC = prove (`!s t:real^N->bool. dimension(s UNION t) <= dimension s + dimension t + &1`, SUBGOAL_THEN `!n s t. dimension s + dimension t + &2 <= &n ==> dimension(s UNION t:real^N->bool) <= &n - &1` ASSUME_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN SUBGOAL_THEN `?n. dimension(s:real^N->bool) + dimension(t:real^N->bool) + &2 = &n` CHOOSE_TAC THENL [REWRITE_TAC[INT_OF_NUM_EXISTS] THEN MATCH_MP_TAC(INT_ARITH `-- &1:int <= x /\ -- &1 <= y ==> &0 <= x + y + &2`) THEN REWRITE_TAC[DIMENSION_GE]; ASM_SIMP_TAC[INT_LE_REFL; INT_ARITH `x:int <= a + b + &1 <=> x <= (a + b + &2) - &1`]]] THEN INDUCT_TAC THEN SIMP_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; UNION_EMPTY; DIMENSION_EMPTY; INT_SUB_LZERO; INT_LE_REFL; GSYM INT_OF_NUM_SUC; INT_ARITH `-- &1:int <= x /\ -- &1 <= y ==> (x + y + &2 <= &0 <=> x = -- &1 /\ y = -- &1)`] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN REWRITE_TAC[INT_ARITH `(n + &1) - &1:int = n`] THEN REWRITE_TAC[INT_ARITH `s + t + &2:int <= n + &1 <=> s + t <= n - &1`] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ] THEN CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN REWRITE_TAC[SET_RULE `p /\ q /\ x IN s UNION t ==> r <=> (x IN s \/ x IN t ==> p /\ q ==> r)`] THEN UNDISCH_TAC `dimension(s:real^N->bool) + dimension(t:real^N->bool) <= &n - &1` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:real^N->bool`; `s:real^N->bool`] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN MATCH_MP_TAC(MESON[] `(!s t. R s t ==> R t s) /\ (!s t. P s ==> R s t) ==> (!s t. P s \/ P t ==> R s t)`) THEN CONJ_TAC THENL [REWRITE_TAC[INT_ADD_SYM; UNION_COMM]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `dimension(s:real^N->bool)` INT_LE_REFL) THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ] THEN DISCH_THEN(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`] o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC(ISPECL [`t INTER frontier u:real^N->bool`; `t:real^N->bool`] DIMENSION_SUBSET) THEN REWRITE_TAC[INTER_SUBSET] THEN ASM_INT_ARITH_TAC);; let DIMENSION_ZERO_REDUCTION_THEOREM = prove (`!s:real^N->bool v. dimension s <= &0 /\ (!n:num. open_in (subtopology euclidean s) (v n)) ==> ?u. (!n. open_in (subtopology euclidean s) (u n)) /\ (!n. u n SUBSET v n) /\ pairwise (\m n. DISJOINT (u m) (u n)) (:num) /\ UNIONS {u n | n IN (:num)} = UNIONS {v n | n IN (:num)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\u:real^N->bool. closed_in (subtopology euclidean s) u /\ open_in (subtopology euclidean s) u` GENERAL_REDUCTION_THEOREM) THEN REWRITE_TAC[OPEN_IN_EMPTY; CLOSED_IN_EMPTY] THEN ANTS_TAC THENL [SIMP_TAC[OPEN_IN_UNION; CLOSED_IN_UNION; CLOSED_IN_DIFF; OPEN_IN_DIFF]; DISCH_THEN(MP_TAC o SPEC `v:num->real^N->bool`)] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIMENSION_EQ_LOCALLY_CLOPEN]) THEN DISCH_THEN(MP_TAC o SPEC `(v:num->real^N->bool) n` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN ASM_REWRITE_TAC[LOCALLY_IMP_COUNTABLE_UNION_OF]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->real^N->bool` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[UNION_OF] THEN MESON_TAC[OPEN_IN_UNIONS]]);; let DIMENSION_ZERO_REDUCTION_THEOREM_2 = prove (`!u s t:real^N->bool. dimension u <= &0 /\ open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t ==> ?s' t'. open_in (subtopology euclidean u) s' /\ open_in (subtopology euclidean u) t' /\ s' SUBSET s /\ t' SUBSET t /\ DISJOINT s' t' /\ s' UNION t' = s UNION t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPEC `\v:real^N->bool. closed_in (subtopology euclidean u) v /\ open_in (subtopology euclidean u) v` GENERAL_REDUCTION_THEOREM_2) THEN REWRITE_TAC[OPEN_IN_EMPTY; CLOSED_IN_EMPTY] THEN ANTS_TAC THENL [SIMP_TAC[OPEN_IN_UNION; CLOSED_IN_UNION; CLOSED_IN_DIFF; OPEN_IN_DIFF]; DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`])] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_IMP_COUNTABLE_UNION_OF THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[GSYM DIMENSION_EQ_LOCALLY_CLOPEN]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[UNION_OF] THEN MESON_TAC[OPEN_IN_UNIONS]]);; let DIMENSION_ZERO_SEPARATION_THEOREM = prove (`!u s t:real^N->bool. dimension u <= &0 /\ closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ DISJOINT s t ==> ?s' t'. closed_in (subtopology euclidean u) s' /\ open_in (subtopology euclidean u) s' /\ closed_in (subtopology euclidean u) t' /\ open_in (subtopology euclidean u) t' /\ s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' /\ s' UNION t' = u`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`u:real^N->bool`; `u DIFF s:real^N->bool`; `u DIFF t:real^N->bool`] DIMENSION_ZERO_REDUCTION_THEOREM_2) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s':real^N->bool`; `t':real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`u DIFF s':real^N->bool`; `u DIFF t':real^N->bool`] THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN SUBGOAL_THEN `u DIFF s':real^N->bool = t' /\ u DIFF t' = s'` (CONJUNCTS_THEN SUBST1_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]);; let DIMENSION_LE_CLOSED_IN_UNIONS,DIMENSION_DECOMPOSITION = let lemma = prove (`!s:real^N->bool n. dimension s <= n /\ &0 <= n ==> ?t. (COUNTABLE UNION_OF (\c. closed_in (subtopology euclidean s) c /\ dimension c <= n - &1)) t /\ dimension(s DIFF t) <= &0`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIMENSION_LE_EQ_LOCALLY]) THEN DISCH_THEN(MP_TAC o REWRITE_RULE[LOCALLY_OPEN_BASIS] o CONJUNCT2) THEN DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN ABBREV_TAC `t = UNIONS(IMAGE (\c:real^N->bool. subtopology euclidean s frontier_of c) b)` THEN EXISTS_TAC `t:real^N->bool` THEN CONJ_TAC THENL [EXPAND_TAC "t" THEN MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN ASM_SIMP_TAC[CLOSED_IN_FRONTIER_OF]; GEN_REWRITE_TAC I [DIMENSION_LE_EQ_LOCAL] THEN CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[DIMENSION_LE_MINUS1] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTER]) THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN SUBGOAL_THEN `?c. c SUBSET b /\ s INTER w:real^N->bool = UNIONS c` MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP (SET_RULE `(?c. c SUBSET b /\ x = UNIONS c) ==> !a. a IN x ==> ?d. d IN b /\ d SUBSET x /\ a IN d`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER; SUBSET_INTER] THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN ANTE_RES_THEN MP_TAC (ASSUME `(d:real^N->bool) IN b`) THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl))) THEN STRIP_TAC THEN EXISTS_TAC `d DIFF t:real^N->bool` THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL [UNDISCH_TAC `open_in (subtopology euclidean s) (d:real^N->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_SIMP_TAC[SET_RULE `d SUBSET s ==> (s DIFF t) INTER (d DIFF t) = d DIFF t`] THEN ASM_SIMP_TAC[SET_RULE `d SUBSET s ==> (s DIFF t) INTER (s DIFF t DIFF (d DIFF t)) = s DIFF (t UNION d)`] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(ASSUME `~((x:real^N) IN t)`) THEN EXPAND_TAC "t" THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `d:real^N->bool` THEN ASM_REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF; FRONTIER_OF_CLOSURES; IN_INTER; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_SIMP_TAC[SET_RULE `d SUBSET s ==> s INTER d = d /\ s INTER (s DIFF d) = s DIFF d`] THEN CONJ_TAC THENL [UNDISCH_TAC `(x:real^N) IN closure (d DIFF t)`; UNDISCH_TAC `(x:real^N) IN closure (s DIFF (t UNION d))`] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]]) and case0 = prove (`!u:real^N->bool c. COUNTABLE c /\ (!s. s IN c ==> closed_in (subtopology euclidean u) s /\ dimension s <= &0) ==> dimension(UNIONS c) <= &0`, MAP_EVERY X_GEN_TAC [`uu:real^N->bool`; `cc:(real^N->bool)->bool`] THEN ASM_CASES_TAC `cc:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; DIMENSION_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPEC `cc:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:num->real^N->bool` SUBST1_TAC) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; FORALL_AND_THM] THEN STRIP_TAC THEN REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN ABBREV_TAC `u:real^N->bool = UNIONS {c n | n IN (:num)}` THEN SUBGOAL_THEN `!n. closed_in (subtopology euclidean u) ((c:num->real^N->bool) n)` ASSUME_TAC THENL [GEN_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `uu:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o GEN `n:num` o MATCH_MP CLOSED_IN_IMP_SUBSET o SPEC `n:num`) THEN ASM SET_TAC[]; UNDISCH_THEN `!n. closed_in (subtopology euclidean uu) ((c:num->real^N->bool) n)` (K ALL_TAC)] THEN GEN_REWRITE_TAC I [SMALL_INDUCTIVE_DIMENSION] THEN CONV_TAC INT_REDUCE_CONV THEN MAP_EVERY X_GEN_TAC [`l:real^N->bool`; `aa:real^N`] THEN REWRITE_TAC[SET_RULE `~(a IN l) <=> DISJOINT {a} l`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM CLOSED_IN_SING] THEN REWRITE_TAC[GSYM SING_SUBSET] THEN SPEC_TAC(`{aa:real^N}`,`k:real^N->bool`) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[DIMENSION_LE_MINUS1] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2; CLOSED_IN_EMPTY; DIFF_EMPTY] THEN SUBGOAL_THEN `?g h:num->real^N->bool. (!n. open_in (subtopology euclidean u) (g n) /\ open_in (subtopology euclidean u) (h n) /\ DISJOINT (g n) (h n) /\ DISJOINT ((subtopology euclidean u) closure_of g n) ((subtopology euclidean u) closure_of h n) /\ k SUBSET g n /\ l SUBSET h n /\ c n SUBSET g n UNION h n) /\ (!n. (subtopology euclidean u) closure_of (g n) SUBSET g(SUC n) /\ (subtopology euclidean u) closure_of (h n) SUBSET h(SUC n))` STRIP_ASSUME_TAC THENL [ALL_TAC; MAP_EVERY EXISTS_TAC [`UNIONS {g n | n IN (:num)}:real^N->bool`; `UNIONS {h n | n IN (:num)}:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT (UNIONS a) (UNIONS b) <=> !s. s IN a ==> !t. t IN b ==> DISJOINT s t`] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISJ_CASES_TAC(ARITH_RULE `i:num <= j \/ j <= i`) THENL [MATCH_MP_TAC(SET_RULE `!s'. DISJOINT s' t /\ s SUBSET s' ==> DISJOINT s t`) THEN EXISTS_TAC `(g:num->real^N->bool) j` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `i:num <= j` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`j:num`; `i:num`]; MATCH_MP_TAC(SET_RULE `!t'. DISJOINT s t' /\ t SUBSET t' ==> DISJOINT s t`) THEN EXISTS_TAC `(h:num->real^N->bool) i` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `j:num <= i` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`i:num`; `j:num`]] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[SUBSET_TRANS; SUBSET_REFL] THEN ASM_MESON_TAC[CLOSURE_OF_SUBSET; SUBSET_TRANS; OPEN_IN_SUBSET]; REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNION_SUBSET; UNIONS_SUBSET] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ASM SET_TAC[]]]] THEN MATCH_MP_TAC(MESON[] `(?f. R (FST o f) (SND o f)) ==> ?g h. R g h`) THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[NOT_SUC; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`c 0:real^N->bool`; `c 0 INTER k:real^N->bool`; `c 0 INTER l:real^N->bool`] DIMENSION_ZERO_SEPARATION_THEOREM) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; INTER_SUBSET]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`k UNION a:real^N->bool`; `l UNION b:real^N->bool`; `u:real^N->bool`] SEPARATION_NORMAL_LOCAL_CLOSURES) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_UNION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `c 0:real^N->bool` THEN ASM_REWRITE_TAC[]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]; MAP_EVERY X_GEN_TAC [`n:num`; `g:real^N->bool`; `h:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`c (SUC n):real^N->bool`; `c(SUC n) INTER (subtopology euclidean u closure_of g):real^N->bool`; `c(SUC n) INTER (subtopology euclidean u closure_of h):real^N->bool`] DIMENSION_ZERO_SEPARATION_THEOREM) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_CLOSURE_OF] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; INTER_SUBSET]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(subtopology euclidean u closure_of g) UNION a:real^N->bool`; `(subtopology euclidean u closure_of h) UNION b:real^N->bool`; `u:real^N->bool`] SEPARATION_NORMAL_LOCAL_CLOSURES) THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_UNION THEN REWRITE_TAC[CLOSED_IN_CLOSURE_OF] THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `c(SUC n):real^N->bool` THEN ASM_REWRITE_TAC[]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s SUBSET t UNION u`) THEN MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_MESON_TAC[OPEN_IN_SUBSET]]]) in let DIMENSION_LE_CLOSED_IN_UNIONS = prove (`!u:real^N->bool c n. -- &1 <= n /\ COUNTABLE c /\ (!s. s IN c ==> closed_in (subtopology euclidean u) s /\ dimension s <= n) ==> dimension(UNIONS c) <= n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n:int = -- &1` THENL [ASM_REWRITE_TAC[DIMENSION_LE_MINUS1] THEN SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `&0:int <= n` THENL [ALL_TAC; ASM_INT_ARITH_TAC] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`c:(real^N->bool)->bool`; `u:real^N->bool`] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INT_OF_NUM_EXISTS]) THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN SPEC_TAC(`n:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[case0] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `c:(real^N->bool)->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `!u. u IN c ==> ?t r. DISJOINT t r /\ t UNION r = u /\ dimension(t) <= &d /\ dimension(r:real^N->bool) <= &0 /\ (COUNTABLE UNION_OF closed_in (subtopology euclidean s)) t` MP_TAC THENL [X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN MP_TAC(ISPECL [`u:real^N->bool`; `&(SUC d):int`] lemma) THEN ASM_SIMP_TAC[INT_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `u DIFF t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:(real^N->bool)->bool` THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `(x + y) - y:int = x`] THEN REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> t UNION (u DIFF t) = u`) THEN EXPAND_TAC "t" THEN REWRITE_TAC[UNIONS_SUBSET] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] UNION_OF_MONO)) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_IN_TRANS]]; REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`t:(real^N->bool)->(real^N->bool)`; `r:(real^N->bool)->(real^N->bool)`] THEN DISCH_TAC THEN SUBGOAL_THEN `UNIONS c = UNIONS (IMAGE (t:(real^N->bool)->(real^N->bool)) c) UNION (UNIONS (IMAGE r c) DIFF UNIONS (IMAGE t c))` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN W(MP_TAC o PART_MATCH lhand DIMENSION_UNION_LE_BASIC o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS) THEN MATCH_MP_TAC(INT_ARITH `x:int <= d /\ y <= &0 ==> x + y + &1 <= d + &1`) THEN CONJ_TAC THENL [SUBGOAL_THEN `(COUNTABLE UNION_OF (\c. closed_in (subtopology euclidean s) c /\ dimension c <= &d)) (UNIONS (IMAGE (t:(real^N->bool)->(real^N->bool)) c))` MP_TAC THENL [MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `d:real^N->bool` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN REWRITE_TAC[UNION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `b:real^N->bool` THEN DISCH_TAC THEN TRANS_TAC INT_LE_TRANS `dimension((t:(real^N->bool)->(real^N->bool)) d)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN ASM SET_TAC[]; REWRITE_TAC[UNION_OF] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]; REWRITE_TAC[UNIONS_DIFF] THEN MATCH_MP_TAC case0 THEN EXISTS_TAC `UNIONS (IMAGE (r:(real^N->bool)->(real^N->bool)) c) DIFF UNIONS (IMAGE t c)` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `d:real^N->bool` THEN DISCH_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `r d DIFF UNIONS (IMAGE (t:(real^N->bool)->(real^N->bool)) c) = (UNIONS (IMAGE r c) DIFF UNIONS (IMAGE t c)) INTER d` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN c ==> x SUBSET s) ==> UNIONS c DIFF t SUBSET s`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN TRANS_TAC SUBSET_TRANS `b:real^N->bool` THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]]; TRANS_TAC INT_LE_TRANS `dimension((r:(real^N->bool)->(real^N->bool)) d)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN SET_TAC[]]]) in let DIMENSION_DECOMPOSITION = prove (`!s:real^N->bool n. &0 <= n ==> (dimension s <= n <=> ?t u. t UNION u = s /\ DISJOINT t u /\ (fsigma relative_to s) t /\ dimension t <= n - &1 /\ dimension u <= &0)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `n:int`] lemma) THEN ASM_REWRITE_TAC[COUNTABLE_UNION_OF_RELATIVE_TO; REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] fsigma] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `s DIFF t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[UNIONS_SUBSET] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] UNION_OF_MONO)) THEN SIMP_TAC[CLOSED_RELATIVE_TO]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]; EXPAND_TAC "s" THEN W(MP_TAC o PART_MATCH lhand DIMENSION_UNION_LE_BASIC o lhand o snd) THEN ASM_INT_ARITH_TAC]) in DIMENSION_LE_CLOSED_IN_UNIONS,DIMENSION_DECOMPOSITION;; let DIMENSION_LE_UNIONS_RELATIVE = prove (`!u:real^N->bool c n. -- &1 <= n /\ COUNTABLE c /\ (!s. s IN c ==> (fsigma relative_to u) s /\ dimension s <= n) ==> dimension(UNIONS c) <= n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(COUNTABLE UNION_OF (\t. closed_in (subtopology euclidean u) t /\ dimension t <= n)) (UNIONS c:real^N->bool)` MP_TAC THENL [MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[COUNTABLE_UNION_OF_RELATIVE_TO; REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] fsigma] THEN REWRITE_TAC[UNION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:(real^N->bool)->bool` THEN SIMP_TAC[CLOSED_RELATIVE_TO] THEN STRIP_TAC THEN X_GEN_TAC `d:real^N->bool` THEN DISCH_TAC THEN TRANS_TAC INT_LE_TRANS `dimension(UNIONS u:real^N->bool)` THEN CONJ_TAC THENL [MATCH_MP_TAC DIMENSION_SUBSET; ASM_REWRITE_TAC[]] THEN ASM SET_TAC[]; REWRITE_TAC[UNION_OF] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[]]);; let DIMENSION_LE_UNIONS = prove (`!c:(real^N->bool)->bool n. -- &1 <= n /\ COUNTABLE c /\ (!s. s IN c ==> fsigma s /\ dimension s <= n) ==> dimension(UNIONS c) <= n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIMENSION_LE_UNIONS_RELATIVE THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[RELATIVE_TO_UNIV]);; let DIMENSION_LE_UNION_RELATIVE = prove (`!u s t:real^N->bool n. (fsigma relative_to u) s /\ (fsigma relative_to u) t /\ dimension s <= n /\ dimension t <= n ==> dimension(s UNION t) <= n`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN MATCH_MP_TAC DIMENSION_LE_UNIONS_RELATIVE THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[DIMENSION_LE_IMP_GE]);; let DIMENSION_LE_UNION = prove (`!s t:real^N->bool n. fsigma s /\ fsigma t /\ dimension s <= n /\ dimension t <= n ==> dimension(s UNION t) <= n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[RELATIVE_TO_UNIV]);; let DIMENSION_LE_UNION_RELATIVE_GEN = prove (`!u s t:real^N->bool n. ((fsigma relative_to u) s /\ (gdelta relative_to u) s /\ t SUBSET u \/ (fsigma relative_to u) t /\ (gdelta relative_to u) t /\ s SUBSET u) /\ dimension s <= n /\ dimension t <= n ==> dimension(s UNION t) <= n`, ONCE_REWRITE_TAC[MESON[] `(!u s t n. P u s t n) <=> (!u n s t. P u s t n)`] THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!x y. Q x y ==> Q y x) /\ (!x y. R x y ==> R y x) /\ (!x y. P x y /\ Q x y ==> R x y) ==> !x y. (P x y \/ P y x) /\ Q x y ==> R x y`) THEN SIMP_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[UNION_COMM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC RELATIVE_TO_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP RELATIVE_TO_IMP_SUBSET)) THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[SET_RULE `t DIFF s = (s UNION t) DIFF s`] THEN SIMP_TAC[RELATIVE_TO_COMPL; SUBSET_UNION; FSIGMA_COMPLEMENT; ETA_AX] THEN MATCH_MP_TAC RELATIVE_TO_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP RELATIVE_TO_IMP_SUBSET)) THEN ASM SET_TAC[]; TRANS_TAC INT_LE_TRANS `dimension(t:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN SET_TAC[]]);; let DIMENSION_LE_UNION_GEN = prove (`!s t:real^N->bool. (fsigma s /\ gdelta s \/ fsigma t /\ gdelta t) /\ dimension s <= n /\ dimension t <= n ==> dimension(s UNION t) <= n`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE_GEN THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[RELATIVE_TO_UNIV; SUBSET_UNIV]);; let DIMENSION_LE_UNION_CLOSED_IN = prove (`!u s t:real^N->bool n. (closed_in (subtopology euclidean u) s /\ t SUBSET u \/ closed_in (subtopology euclidean u) t /\ s SUBSET u) /\ dimension s <= n /\ dimension t <= n ==> dimension(s UNION t) <= n`, REWRITE_TAC[GSYM CLOSED_RELATIVE_TO] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE_GEN THEN EXISTS_TAC `u:real^N->bool` THEN ASM_MESON_TAC[RELATIVE_TO_MONO; CLOSED_IMP_GDELTA; CLOSED_IMP_FSIGMA]);; let DIMENSION_LE_UNIONS_ZERODIMENSIONAL = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> dimension s <= &0) ==> dimension(UNIONS f) <= &(CARD f) - &1`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; CARD_CLAUSES; DIMENSION_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN SIMP_TAC[FORALL_IN_INSERT; UNIONS_INSERT; CARD_CLAUSES] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN STRIP_TAC THEN TRANS_TAC INT_LE_TRANS `dimension(s:real^N->bool) + dimension(UNIONS f:real^N->bool) + &1` THEN CONJ_TAC THENL [ALL_TAC; ASM_INT_ARITH_TAC] THEN REWRITE_TAC[DIMENSION_UNION_LE_BASIC]);; let DIMENSION_LE_UNIONS_ZERODIMENSIONAL_EQ = prove (`!s:real^N->bool n. dimension s <= n <=> ?f. FINITE f /\ &(CARD f) <= n + &1 /\ (!d. d IN f ==> dimension d <= &0) /\ UNIONS f = s`, REWRITE_TAC[TAUT `(p <=> q) <=> (q ==> p) /\ (p ==> q)`; FORALL_AND_THM] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `n:int`] THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN TRANS_TAC INT_LE_TRANS `&(CARD(f:(real^N->bool)->bool)) - &1:int` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIMENSION_LE_UNIONS_ZERODIMENSIONAL]; ASM_INT_ARITH_TAC]; ONCE_REWRITE_TAC[MESON[DIMENSION_LE_IMP_GE] `dimension(s:real^N->bool) <= n <=> -- &1 <= n /\ dimension s <= n`] THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ONCE_REWRITE_TAC[INT_ARITH `i:int <= n <=> i + &1 <= n + &1`] THEN X_GEN_TAC `m:int` THEN SPEC_TAC(`m + &1:int`,`n:int`) THEN REWRITE_TAC[INT_ADD_LINV; GSYM INT_FORALL_POS] THEN REWRITE_TAC[INT_LE_RADD; INT_ARITH `d + &1:int <= &1 <=> d <= &0`] THEN CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[GSYM INT_LE_SUB_LADD] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[DIMENSION_LE_MINUS1; FORALL_UNWIND_THM2] THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN REWRITE_TAC[FINITE_RULES; UNIONS_0; NOT_IN_EMPTY; CARD_CLAUSES] THEN REWRITE_TAC[INT_LE_REFL]; X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN REWRITE_TAC[INT_ARITH `(n + &1) - &1:int = n`] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIMENSION_DECOMPOSITION o lhand o snd) THEN REWRITE_TAC[INT_POS] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(u:real^N->bool) INSERT f` THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; FINITE_INSERT] THEN ASM_REWRITE_TAC[UNIONS_INSERT] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN ASM_INT_ARITH_TAC]]);; let DIMENSION_INSERT = prove (`!s a:real^N. dimension(a INSERT s) = if s = {} then &0 else dimension s`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIMENSION_SING] THEN SIMP_TAC[GSYM INT_LE_ANTISYM; DIMENSION_SUBSET; SET_RULE `s SUBSET a INSERT s`] THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN MATCH_MP_TAC DIMENSION_LE_UNION_GEN THEN REWRITE_TAC[FSIGMA_SING; GDELTA_SING; DIMENSION_SING] THEN ASM_REWRITE_TAC[INT_LE_REFL; DIMENSION_POS_LE]);; let DIMENSION_DELETE = prove (`!s a:real^N. dimension(s DELETE a) = if s DELETE a = {} then --(&1) else dimension s`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN SIMP_TAC[GSYM INT_LE_ANTISYM; DIMENSION_SUBSET; DELETE_SUBSET] THEN TRANS_TAC INT_LE_TRANS `dimension((a:real^N) INSERT (s DELETE a))` THEN SIMP_TAC[DIMENSION_SUBSET; SET_RULE `s SUBSET a INSERT (s DELETE a)`] THEN ASM_REWRITE_TAC[DIMENSION_INSERT; INT_LE_REFL]);; let DIMENSION_LE_EQ_GEN = prove (`!s:real^N->bool n. dimension s <= n <=> if s = {} then -- &1 <= n else !v a. open v /\ a IN v ==> ?u. a IN u /\ u SUBSET v /\ open u /\ dimension (s INTER frontier u) <= n - &1`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN EQ_TAC THENL [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`(a:real^N) INSERT s`; `n:int`] DIMENSION_LE_EQ) THEN ASM_REWRITE_TAC[DIMENSION_INSERT; IN_INSERT] THEN DISCH_THEN(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`] o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INT_LE_TRANS) THEN MATCH_MP_TAC DIMENSION_SUBSET THEN SET_TAC[]; DISCH_TAC THEN GEN_REWRITE_TAC I [DIMENSION_LE_EQ] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`(:real^N)`; `vec 0:real^N`]) THEN ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIMENSION_LE_IMP_GE) THEN ASM_ARITH_TAC; ASM_MESON_TAC[]]]);; let DIMENSION_PCROSS_LE = prove (`!s:real^M->bool t:real^N->bool. ~(s = {} /\ t = {}) ==> dimension(s PCROSS t) <= dimension s + dimension t`, SUBGOAL_THEN `!n s:real^M->bool t:real^N->bool. dimension s + dimension t <= &n - &1 ==> dimension(s PCROSS t) <= &n - &1` ASSUME_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `t:real^N->bool`] THEN REWRITE_TAC[GSYM DIMENSION_POS_LE; DE_MORGAN_THM] THEN DISCH_THEN(MP_TAC o MATCH_MP (INT_ARITH `&0:int <= s \/ &0 <= t ==> -- &1 <= s /\ -- &1 <= t ==> &0 <= (s + t) + &1`)) THEN REWRITE_TAC[DIMENSION_GE; GSYM INT_OF_NUM_EXISTS] THEN REWRITE_TAC[INT_ARITH `x + &1:int = n <=> x = n - &1`] THEN ASM_MESON_TAC[INT_LE_REFL]] THEN INDUCT_TAC THENL [REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (INT_ARITH `s + t:int <= &0 - &1 ==> -- &1 <= s /\ -- &1 <= t ==> s = -- &1 \/ t = -- &1`)) THEN REWRITE_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; INT_SUB_LZERO] THEN STRIP_TAC THEN ASM_REWRITE_TAC[PCROSS_EMPTY; DIMENSION_EMPTY; INT_LE_REFL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `t:real^N->bool`] THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `(x + y) - y:int = x`] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ] THEN CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN SIMP_TAC[FORALL_PASTECART] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN STRIP_TAC THEN MP_TAC(ISPECL [ `w:real^(M,N)finite_sum->bool`; `a:real^M`; `b:real^N`] PASTECART_IN_INTERIOR) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v1:real^M->bool`; `v2:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPEC `dimension(s:real^M->bool)` INT_LE_REFL) THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ] THEN DISCH_THEN(MP_TAC o SPECL [`v1:real^M->bool`; `a:real^M`] o CONJUNCT2) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u1:real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPEC `dimension(t:real^N->bool)` INT_LE_REFL) THEN GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ] THEN DISCH_THEN(MP_TAC o SPECL [`v2:real^N->bool`; `b:real^N`] o CONJUNCT2) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u2:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `(u1:real^M->bool) PCROSS (u2:real^N->bool)` THEN ASM_REWRITE_TAC[OPEN_PCROSS_EQ; PASTECART_IN_PCROSS] THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; SUBSET_PCROSS]; ALL_TAC] THEN REWRITE_TAC[FRONTIER_PCROSS; UNION_OVER_INTER; INTER_PCROSS] THEN MATCH_MP_TAC DIMENSION_LE_UNION_CLOSED_IN THEN EXISTS_TAC `(s:real^M->bool) PCROSS (t:real^N->bool)` THEN CONJ_TAC THENL [DISJ1_TAC THEN REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; FRONTIER_CLOSED; CLOSED_CLOSURE]; CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC INT_LE_TRANS THENL [EXISTS_TAC `(dimension(s:real^M->bool) - &1) + dimension(t:real^N->bool)`; EXISTS_TAC `dimension(s:real^M->bool) + (dimension(t:real^N->bool) - &1)`] THEN (CONJ_TAC THENL [ALL_TAC; ASM_INT_ARITH_TAC]) THEN MATCH_MP_TAC INT_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[DIMENSION_SUBSET; INTER_SUBSET]]);; let DIMENSION_PCROSS_EQ_0 = prove (`!s:real^M->bool t:real^N->bool. dimension(s PCROSS t) = &0 <=> dimension s = &0 /\ dimension t = &0`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[PCROSS_EMPTY; DIMENSION_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MP_TAC(ASSUME `~(t:real^N->bool = {})`) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `dimension((s:real^M->bool) PCROSS {b:real^N}) = &0` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `d2:int = &0 ==> d <= d2 /\ ~(d <= -- &1) ==> d = &0`)) THEN ASM_REWRITE_TAC[DIMENSION_LE_MINUS1; PCROSS_EQ_EMPTY; NOT_INSERT_EMPTY] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN REWRITE_TAC[HOMEOMORPHIC_PCROSS_SING]]; MP_TAC(ASSUME `~(s:real^M->bool = {})`) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `dimension({a:real^M} PCROSS (t:real^N->bool)) = &0` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH `d2:int = &0 ==> d <= d2 /\ ~(d <= -- &1) ==> d = &0`)) THEN ASM_REWRITE_TAC[DIMENSION_LE_MINUS1; PCROSS_EQ_EMPTY; NOT_INSERT_EMPTY] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN REWRITE_TAC[HOMEOMORPHIC_PCROSS_SING]]; MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`] DIMENSION_PCROSS_LE) THEN MP_TAC(ISPEC `(s:real^M->bool) PCROSS (t:real^N->bool)` DIMENSION_LE_MINUS1) THEN ASM_REWRITE_TAC[PCROSS_EQ_EMPTY] THEN ASM_INT_ARITH_TAC]);; let DIMENSION_SEPARATION_THEOREM = prove (`!t s:real^N->bool n c d. &0 <= n /\ s SUBSET t /\ dimension s <= n /\ closed_in (subtopology euclidean t) c /\ closed_in (subtopology euclidean t) d /\ DISJOINT c d ==> ?b. closed_in (subtopology euclidean t) b /\ dimension(b INTER s) <= n - &1 /\ ?u v. open_in (subtopology euclidean t) u /\ open_in (subtopology euclidean t) v /\ DISJOINT u v /\ u UNION v = t DIFF b /\ c SUBSET u /\ d SUBSET v`, GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; GSYM INT_FORALL_POS] THEN MATCH_MP_TAC(MESON[num_CASES] `P 0 /\ (P 0 ==> !n. P(SUC n)) ==> !n. P n`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`c:real^N->bool`; `d:real^N->bool`; `t:real^N->bool`] SEPARATION_NORMAL_LOCAL_CLOSURES) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `s INTER (subtopology euclidean t closure_of u):real^N->bool`; `s INTER (subtopology euclidean t closure_of v):real^N->bool`] DIMENSION_ZERO_SEPARATION_THEOREM) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_CLOSURE_OF]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`c':real^N->bool`; `d':real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `c SUBSET t /\ d SUBSET t /\ u SUBSET t /\ v SUBSET (t:real^N->bool) /\ c' SUBSET t /\ d' SUBSET t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE [CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF]) THEN SUBGOAL_THEN `t INTER u:real^N->bool = u /\ t INTER v = v` (CONJUNCTS_THEN SUBST_ALL_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`c UNION c':real^N->bool`; `d UNION d':real^N->bool`] SEPARATION_CLOSURES) THEN ANTS_TAC THENL [REWRITE_TAC[CLOSURE_UNION] THEN SUBGOAL_THEN `c' INTER closure v:real^N->bool = {} /\ d' INTER closure u:real^N->bool = {}` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `c' INTER closure d':real^N->bool = {} /\ d' INTER closure c':real^N->bool = {}` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[SEPARATION_CLOSED_IN_UNION]; ALL_TAC] THEN SUBGOAL_THEN `c' INTER closure d:real^N->bool = {} /\ d' INTER closure c:real^N->bool = {}` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP SUBSET_CLOSURE)) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `v INTER closure c':real^N->bool = {} /\ u INTER closure d':real^N->bool = {}` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `subtopology euclidean (t:real^N->bool)` OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`v:real^N->bool`; `c':real^N->bool`] th) THEN MP_TAC(SPECL [`u:real^N->bool`; `d':real^N->bool`] th)) THEN MP_TAC(ISPEC `subtopology euclidean (t:real^N->bool)` CLOSURE_OF_SUBSET) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^N->bool` th) THEN MP_TAC(SPEC `v:real^N->bool` th)) THEN ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF; SET_RULE `s SUBSET t ==> t INTER s = s`] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `d INTER closure c':real^N->bool = {} /\ c INTER closure d':real^N->bool = {}` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSURE_OF_CLOSED_IN)) THEN ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF; SET_RULE `s SUBSET t ==> t INTER s = s`] THEN ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `z:real^N->bool`] THEN REWRITE_TAC[UNION_SUBSET] THEN STRIP_TAC THEN EXISTS_TAC `t INTER frontier w:real^N->bool` THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; FRONTIER_CLOSED] THEN CONV_TAC INT_REDUCE_CONV THEN ASM_REWRITE_TAC[DIMENSION_LE_MINUS1] THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`z:real^N->bool`; `w:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM SET_TAC[]; MAP_EVERY EXISTS_TAC [`t INTER w:real^N->bool`; `t INTER ((:real^N) DIFF closure w):real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM closed; CLOSED_CLOSURE] THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `w:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]; MP_TAC(ISPECL [`z:real^N->bool`; `w:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM SET_TAC[]]]]; REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `&(SUC n):int`] DIMENSION_DECOMPOSITION) THEN ASM_REWRITE_TAC[INT_POS; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^N->bool`; `z:real^N->bool`] THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `(x + y) - y:int = x`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`z:real^N->bool`; `c:real^N->bool`; `d:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[DIMENSION_LE_MINUS1]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC INT_LE_TRANS `dimension(l:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN ASM SET_TAC[]]);; let LARGE_INDUCTIVE_DIMENSION = prove (`!s:real^N->bool n. dimension s <= n <=> if s = {} then -- &1 <= n else !c d. closed_in (subtopology euclidean s) c /\ closed_in (subtopology euclidean s) d /\ DISJOINT c d ==> ?b. closed_in (subtopology euclidean s) b /\ dimension b <= n - &1 /\ ?u v. open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean s) v /\ DISJOINT u v /\ u UNION v = s DIFF b /\ c SUBSET u /\ d SUBSET v`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`; `n:int`; `c:real^N->bool`; `d:real^N->bool`] DIMENSION_SEPARATION_THEOREM) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMENSION_POS_LE]) THEN ASM_INT_ARITH_TAC; MESON_TAC[CLOSED_IN_IMP_SUBSET; SET_RULE `b SUBSET s ==> b INTER s = b`]]; STRIP_TAC THEN GEN_REWRITE_TAC I [SMALL_INDUCTIVE_DIMENSION] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`{}:real^N->bool`; `{}:real^N->bool`]) THEN REWRITE_TAC[CLOSED_IN_EMPTY; DISJOINT_EMPTY] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIMENSION_LE_IMP_GE) THEN ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SING_SUBSET] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN ASM SET_TAC[]]]);; let TINY_INDUCTIVE_DIMENSION = prove (`!s:real^N->bool n. locally compact s ==> (dimension s <= n <=> if s = {} then -- &1 <= n else &0 <= n /\ !x y. x IN s /\ y IN s /\ ~(x = y) ==> ?b. closed_in (subtopology euclidean s) b /\ dimension b <= n - &1 /\ ?u v. open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean s) v /\ DISJOINT u v /\ u UNION v = s DIFF b /\ x IN u /\ y IN v)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMENSION_LE_MINUS1]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIMENSION_LE_IMP_GE) THEN ASM_INT_ARITH_TAC; MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SMALL_INDUCTIVE_DIMENSION]) THEN DISCH_THEN(MP_TAC o SPECL [`{b:real^N}`; `a:real^N`] o CONJUNCT2) THEN ASM_REWRITE_TAC[IN_SING; CLOSED_IN_SING] THEN REWRITE_TAC[SING_SUBSET; CONJ_ACI]]; STRIP_TAC] THEN ONCE_REWRITE_TAC[LOCALLY_DIMENSION_LE] THEN CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_AND_SUBSET]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN X_GEN_TAC `k:real^N->bool` THEN REWRITE_TAC[] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SMALL_INDUCTIVE_DIMENSION] THEN CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `p:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_COMPACT)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `!q. q IN c ==> ?u. open_in (subtopology euclidean k) u /\ q IN u /\ ~((p:real^N) IN closure u) /\ dimension(subtopology euclidean k frontier_of u) <= n - &1` MP_TAC THENL [X_GEN_TAC `q:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^N`; `q:real^N`]) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `b:real^N->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `k INTER v:real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_INTER; OPEN_IN_REFL; OPEN_IN_SUBTOPOLOGY_INTER_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(snd(EQ_IMP_RULE(ISPECL [`k INTER u:real^N->bool`; `k INTER v:real^N->bool`] SEPARATION_OPEN_IN_UNION))) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [UNDISCH_TAC `open_in (subtopology euclidean s) (u:real^N->bool)`; UNDISCH_TAC `open_in (subtopology euclidean s) (v:real^N->bool)`] THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; STRIP_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC INT_LE_TRANS `dimension(b:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN REWRITE_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[SET_RULE `k INTER k INTER v = k INTER v`; SET_RULE `k INTER (k DIFF k INTER v) = k DIFF v`] THEN SUBGOAL_THEN `closure(k DIFF v):real^N->bool = k DIFF v /\ (k INTER v) SUBSET closure(k INTER v)` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[CLOSURE_SUBSET; CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `k:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN SUBGOAL_THEN `k DIFF v:real^N->bool = k INTER (s DIFF v)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_DIFF; CLOSED_IN_REFL]; FIRST_X_ASSUM(K ALL_TAC o SPEC `vec 0:real^N`)] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->real^N->bool` THEN DISCH_TAC THEN MP_TAC(ISPEC `c:real^N->bool` COMPACT_EQ_HEINE_BOREL_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`IMAGE (u:real^N->real^N->bool) c`; `k:real^N->bool`]) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN ABBREV_TAC `v = UNIONS (IMAGE (u:real^N->real^N->bool) d)` THEN EXISTS_TAC `subtopology euclidean k frontier_of v:real^N->bool` THEN REWRITE_TAC[CLOSED_IN_FRONTIER_OF; RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `k DIFF subtopology euclidean k closure_of v:real^N->bool` THEN EXISTS_TAC `v:real^N->bool` THEN SUBGOAL_THEN `open_in (subtopology euclidean k) (v:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "v" THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_CLOSURE_OF] THEN ASM_REWRITE_TAC[IN_DIFF] THEN FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP FRONTIER_OF_OPEN_IN) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MP_TAC(ISPECL [`subtopology euclidean (k:real^N->bool)`; `v:real^N->bool`] CLOSURE_OF_SUBSET) THEN ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (q /\ r) /\ p /\ s`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `subtopology euclidean k frontier_of (v:real^N->bool) SUBSET UNIONS {subtopology euclidean k frontier_of (u q) | (q:real^N) IN d}` ASSUME_TAC THENL [EXPAND_TAC "v" THEN W(MP_TAC o PART_MATCH (lhand o rand) FRONTIER_OF_UNIONS_SUBSET o lhand o snd) THEN ASM_SIMP_TAC[FINITE_IMAGE; SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`]; ALL_TAC] THEN CONJ_TAC THENL [TRANS_TAC INT_LE_TRANS `dimension(UNIONS { subtopology euclidean k frontier_of (u q) | (q:real^N) IN d}:real^N->bool)` THEN ASM_SIMP_TAC[DIMENSION_SUBSET] THEN MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN EXISTS_TAC `k:real^N->bool` THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMP_COUNTABLE; COUNTABLE_IMAGE] THEN CONJ_TAC THENL [ASM_INT_ARITH_TAC; REWRITE_TAC[FORALL_IN_IMAGE]] THEN REWRITE_TAC[CLOSED_IN_FRONTIER_OF] THEN ASM SET_TAC[]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c DIFF v = f ==> ~(p IN v) /\ ~(p IN f) ==> ~(p IN c)`)) THEN CONJ_TAC THENL [EXPAND_TAC "v"; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s SUBSET t ==> ~(p IN t) ==> ~(p IN s)`))] THEN (REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THENL [MP_TAC(ISPEC `(u:real^N->real^N->bool) q` CLOSURE_SUBSET) THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FRONTIER_OF_CLOSURES]) THEN REWRITE_TAC[IN_INTER; CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (x IN k /\ x IN s) /\ P ==> x IN t`) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[INTER_SUBSET]]]);; let DIMENSION_LE_RATIONAL_COORDINATES = prove (`!n. dimension {x:real^N | {i | i IN 1..dimindex(:N) /\ rational(x$i)} HAS_SIZE n} <= &0`, GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!x. t = x ==> dimension x <= &0) ==> dimension t <= &0`) THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `s = UNIONS {s INTER h | h IN { INTERS {{x:real^N | x$i = q$i} | i IN k} | k IN {l | l SUBSET 1..dimindex(:N) /\ l HAS_SIZE n} /\ q IN {y:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(y$i)}}}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; EXISTS_IN_GSPEC] THEN EXPAND_TAC "s" THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN ABBREV_TAC `k = {i | i IN 1..dimindex(:N) /\ rational((x:real^N)$i)}` THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `k:num->bool` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(lambda i. if i IN k then (x:real^N)$i else &0):real^N` THEN SIMP_TAC[LAMBDA_BETA] THEN EXPAND_TAC "k" THEN REWRITE_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN MESON_TAC[RATIONAL_NUM]; ALL_TAC] THEN MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN EXISTS_TAC `s:real^N->bool` THEN CONV_TAC INT_REDUCE_CONV THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[COUNTABLE_RATIONAL_COORDINATES] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `{k | k SUBSET (:num) /\ FINITE k}` THEN SIMP_TAC[COUNTABLE_FINITE_SUBSETS; NUM_COUNTABLE] THEN REWRITE_TAC[HAS_SIZE] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`k:num->bool`; `q:real^N`] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN MATCH_MP_TAC CLOSED_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_STANDARD_HYPERPLANE]; ALL_TAC] THEN TRANS_TAC INT_LE_TRANS `dimension {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> (rational(x$i) <=> i IN k)}` THEN CONJ_TAC THENL [MATCH_MP_TAC DIMENSION_SUBSET THEN REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`k:num->bool`; `{i | i IN 1..dimindex(:N) /\ rational((x:real^N)$i)}`] CARD_SUBSET_LE) THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[IN_NUMSEG] THEN SET_TAC[]] THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM IN_NUMSEG]) THEN ASM SET_TAC[]; UNDISCH_TAC `(x:real^N) IN s` THEN EXPAND_TAC "s" THEN UNDISCH_TAC `(k:num->bool) HAS_SIZE n` THEN SIMP_TAC[IN_ELIM_THM; HAS_SIZE; LE_REFL]]; ALL_TAC] THEN GEN_REWRITE_TAC I [DIMENSION_LE_EQ] THEN CONV_TAC INT_REDUCE_CONV THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN REWRITE_TAC[DIMENSION_LE_MINUS1; IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:real^N`] THEN REWRITE_TAC[IN_INTERVAL] THEN STRIP_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?u v. (rational u <=> ~(i IN k)) /\ (rational v <=> ~(i IN k)) /\ u < (a:real^N)$i /\ a$i < v /\ abs(v - u) < min ((r:real^N)$i - a$i) (a$i - (l:real^N)$i)` MP_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `(i:num) IN k` THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC IRRATIONAL_APPROXIMATION_STRADDLE; MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE] THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT]; REWRITE_TAC[LAMBDA_SKOLEM; LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `interval(x:real^N,y)` THEN ASM_SIMP_TAC[IN_INTERVAL; OPEN_INTERVAL] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `interval[l:real^N,r]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[FRONTIER_OPEN_INTERVAL; INTERVAL_EQ_EMPTY] THEN COND_CASES_TAC THEN REWRITE_TAC[INTER_EMPTY] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_INTERVAL] THEN MATCH_MP_TAC(MESON[] `(!x. ~R x ==> ~(P x /\ Q x)) ==> ~((!x. P x) /\ (!x. Q x) /\ ~(!x. R x))`) THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_LT]);; let DIMENSION_EXACTLY_RATIONAL_COORDINATES = prove (`!n. 1 <= n /\ n <= dimindex(:N) ==> dimension {x:real^N | {i | i IN 1..dimindex(:N) /\ rational(x$i)} HAS_SIZE n} = &0`, GEN_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN REWRITE_TAC[DIMENSION_POS_LE; DIMENSION_LE_RATIONAL_COORDINATES] THEN STRIP_TAC THEN SUBGOAL_THEN `?q r. rational q /\ ~rational r` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[RATIONAL_APPROXIMATION; IRRATIONAL_APPROXIMATION; REAL_LT_01]; REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM; NOT_IN_EMPTY] THEN EXISTS_TAC `(lambda i. if i <= n then q else r):real^N` THEN ONCE_REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ASM_REWRITE_TAC[TAUT `(if p then T else F) <=> p`; NOT_IMP] THEN ASM_SIMP_TAC[ARITH_RULE `n <= m ==> ((1 <= i /\ i <= m) /\ i <= n <=> 1 <= i /\ i <= n)`] THEN REWRITE_TAC[GSYM numseg; HAS_SIZE_NUMSEG_1]]);; (* ------------------------------------------------------------------------- *) (* Covering spaces and lifting results for them. *) (* ------------------------------------------------------------------------- *) let covering_space = new_definition `covering_space(c,(p:real^M->real^N)) s <=> p continuous_on c /\ IMAGE p c = s /\ !x. x IN s ==> ?t. x IN t /\ open_in (subtopology euclidean s) t /\ ?v. UNIONS v = {x | x IN c /\ p(x) IN t} /\ (!u. u IN v ==> open_in (subtopology euclidean c) u) /\ pairwise DISJOINT v /\ (!u. u IN v ==> ?q. homeomorphism (u,t) (p,q))`;; let COVERING_SPACE_IMP_CONTINUOUS = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> p continuous_on c`, SIMP_TAC[covering_space]);; let COVERING_SPACE_IMP_SURJECTIVE = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> IMAGE p c = s`, SIMP_TAC[covering_space]);; let HOMEOMORPHISM_IMP_COVERING_SPACE = prove (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) ==> covering_space (s,f) t`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[covering_space] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN EXISTS_TAC `{s:real^M->bool}` THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_1; PAIRWISE_SING] THEN ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN CONJ_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `g:real^N->real^M`] THEN ASM_REWRITE_TAC[homeomorphism]);; let COVERING_SPACE_LOCAL_HOMEOMORPHISM = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> !x. x IN c ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\ p(x) IN u /\ open_in (subtopology euclidean s) u /\ ?q. homeomorphism (t,u) (p,q)`, REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) x`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `v:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(x:real^M) IN UNIONS v` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[]);; let COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> !y. y IN s ==> ?x t u. p(x) = y /\ x IN t /\ open_in (subtopology euclidean c) t /\ y IN u /\ open_in (subtopology euclidean s) u /\ ?q. homeomorphism (t,u) (p,q)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN ASM_MESON_TAC[]]);; let COVERING_SPACE_OPEN_MAP = prove (`!p:real^M->real^N c s t. covering_space (c,p) s /\ open_in (subtopology euclidean c) t ==> open_in (subtopology euclidean s) (IMAGE p t)`, REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vs:(real^M->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `?x. x IN {x | x IN c /\ (p:real^M->real^N) x IN u} /\ x IN t /\ p x = y` MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN ASM_REWRITE_TAC[homeomorphism] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (p:real^M->real^N) (t INTER v)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SUBGOAL_THEN `IMAGE (p:real^M->real^N) (t INTER v) = {z | z IN u /\ q z IN (t INTER v)}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `c:real^M->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER; ASM_MESON_TAC[open_in]] THEN ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; let COVERING_SPACE_QUOTIENT_MAP = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> !u. u SUBSET s ==> (open_in (subtopology euclidean c) {x | x IN c /\ p x IN u} <=> open_in (subtopology euclidean s) u)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN MATCH_MP_TAC OPEN_MAP_IMP_QUOTIENT_MAP THEN CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);; let COVERING_SPACE_LOCALIZED_HOMEOMORPHISM = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> !w x. x IN w /\ open_in (subtopology euclidean c) w ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\ p(x) IN u /\ open_in (subtopology euclidean s) u /\ t SUBSET w /\ ?q. homeomorphism (t,u) (p,q)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_TAC `q:real^N->real^M`) THEN MAP_EVERY EXISTS_TAC [`u INTER w:real^M->bool`; `IMAGE (p:real^M->real^N) (u INTER w)`] THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_INTER; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[FUN_IN_IMAGE; IN_INTER]; ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP; OPEN_IN_INTER]; EXISTS_TAC `q:real^N->real^M` THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]);; let COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> !w y. y IN w /\ open_in (subtopology euclidean s) w ==> ?x t u. p(x) = y /\ x IN t /\ open_in (subtopology euclidean c) t /\ y IN u /\ open_in (subtopology euclidean s) u /\ u SUBSET w /\ ?q. homeomorphism (t,u) (p,q)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`{x | x IN c /\ (p:real^M->real^N) x IN w}`; `x:real^M`] o MATCH_MP COVERING_SPACE_LOCALIZED_HOMEOMORPHISM) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[SUBSET_REFL]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]]]);; let COVERING_SPACE_LOCALLY_HOMEOMORPHIC = prove (`!P Q p:real^M->real^N c s. covering_space (c,p) s /\ (!q u v. ~(u = {}) /\ u SUBSET c /\ v SUBSET s /\ homeomorphism (u,v) (p,q) /\ P u ==> Q v) /\ locally P c ==> locally Q s`, REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `y:real^N`] o MATCH_MP COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `u:real^M->bool`; `v:real^N->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_TAC `q:real^N->real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:real^M->bool`; `l:real^M->bool`] THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (p:real^M->real^N) n` THEN EXISTS_TAC `IMAGE (p:real^M->real^N) l` THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP; OPEN_IN_INTER]; FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`q:real^N->real^M`; `l:real^M->bool`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS))] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]);; let COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ = prove (`!P Q p:real^M->real^N c s. covering_space (c,p) s /\ (!q u v. ~(u = {}) /\ u SUBSET c /\ v SUBSET s /\ homeomorphism (u,v) (p,q) ==> (P u <=> Q v)) ==> (locally P c <=> locally Q s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_LOCALLY_HOMEOMORPHIC]; ALL_TAC] THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN FIRST_ASSUM(MP_TAC o SPECL [`w:real^M->bool`; `x:real^M`] o MATCH_MP COVERING_SPACE_LOCALIZED_HOMEOMORPHISM) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_TAC `q:real^N->real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `(p:real^M->real^N) x`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:real^N->bool`; `l:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{x | x IN u /\ (p:real^M->real^N) x IN n}`; `{x | x IN u /\ (p:real^M->real^N) x IN l}`] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`q:real^N->real^M`; `{x | x IN u /\ (p:real^M->real^N) x IN l}`; `l:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]);; let COVERING_SPACE_LOCALLY = prove (`!P Q p:real^M->real^N c s. covering_space (c,p) s /\ (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\ locally P c ==> locally Q s`, MP_TAC COVERING_SPACE_LOCALLY_HOMEOMORPHIC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);; let COVERING_SPACE_LOCALLY_EQ = prove (`!P Q p:real^M->real^N c s. covering_space (c,p) s /\ (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\ (!q u. u SUBSET s /\ q continuous_on u /\ Q u ==> P(IMAGE q u)) ==> (locally Q s <=> locally P c)`, MP_TAC COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);; let COVERING_SPACE_LOCALLY_COMPACT_EQ = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> (locally compact s <=> locally compact c)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; COMPACT_CONTINUOUS_IMAGE]);; let COVERING_SPACE_LOCALLY_CONNECTED_EQ = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> (locally connected s <=> locally connected c)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_CONTINUOUS_IMAGE]);; let COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> (locally path_connected s <=> locally path_connected c)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_CONNECTED_CONTINUOUS_IMAGE]);; let COVERING_SPACE_LOCALLY_COMPACT = prove (`!p:real^M->real^N c s. covering_space (c,p) s /\ locally compact c ==> locally compact s`, MESON_TAC[COVERING_SPACE_LOCALLY_COMPACT_EQ]);; let COVERING_SPACE_LOCALLY_CONNECTED = prove (`!p:real^M->real^N c s. covering_space (c,p) s /\ locally connected c ==> locally connected s`, MESON_TAC[COVERING_SPACE_LOCALLY_CONNECTED_EQ]);; let COVERING_SPACE_LOCALLY_PATH_CONNECTED = prove (`!p:real^M->real^N c s. covering_space (c,p) s /\ locally path_connected c ==> locally path_connected s`, MESON_TAC[COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ]);; let COVERING_SPACE_LIFT_UNIQUE_GEN = prove (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t u a x. covering_space (c,p) s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ g1 continuous_on t /\ IMAGE g1 t SUBSET c /\ (!x. x IN t ==> f(x) = p(g1 x)) /\ g2 continuous_on t /\ IMAGE g2 t SUBSET c /\ (!x. x IN t ==> f(x) = p(g2 x)) /\ u IN components t /\ a IN u /\ g1(a) = g2(a) /\ x IN u ==> g1(x) = g2(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN UNDISCH_TAC `(x:real^P) IN u` THEN SPEC_TAC(`x:real^P`,`x:real^P`) THEN MATCH_MP_TAC(SET_RULE `(?a. a IN u /\ g a = z) /\ ({x | x IN u /\ g x = z} = {} \/ {x | x IN u /\ g x = z} = u) ==> !x. x IN u ==> g x = z`) THEN CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_SUB_EQ]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^P` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(g1:real^P->real^M) x` o MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `w:real^N->bool`] THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[homeomorphism] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{x | x IN u /\ (g1:real^P->real^M) x IN v} INTER {x | x IN u /\ (g2:real^P->real^M) x IN v}` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN u /\ g x IN v} = {x | x IN u /\ g x IN (v INTER IMAGE g u)}`] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC]) THEN UNDISCH_TAC `open_in (subtopology euclidean c) (v:real^M->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER; VECTOR_SUB_EQ] THEN ASM SET_TAC[]]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; let COVERING_SPACE_LIFT_UNIQUE = prove (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t a x. covering_space (c,p) s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ g1 continuous_on t /\ IMAGE g1 t SUBSET c /\ (!x. x IN t ==> f(x) = p(g1 x)) /\ g2 continuous_on t /\ IMAGE g2 t SUBSET c /\ (!x. x IN t ==> f(x) = p(g2 x)) /\ connected t /\ a IN t /\ g1(a) = g2(a) /\ x IN t ==> g1(x) = g2(x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:real^M->real^N`; `f:real^P->real^N`; `g1:real^P->real^M`; `g2:real^P->real^M`; `c:real^M->bool`; `s:real^N->bool`; `t:real^P->bool`; `t:real^P->bool`; `a:real^P`; `x:real^P`] COVERING_SPACE_LIFT_UNIQUE_GEN) THEN ASM_REWRITE_TAC[IN_COMPONENTS_SELF] THEN ASM SET_TAC[]);; let COVERING_SPACE_LIFT_UNIQUE_IDENTITY = prove (`!p:real^M->real^N c f s a. covering_space (c,p) s /\ path_connected c /\ f continuous_on c /\ IMAGE f c SUBSET c /\ (!x. x IN c ==> p(f x) = p x) /\ a IN c /\ f(a) = a ==> !x. x IN c ==> f x = x`, REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `x:real^M`]) THEN ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`p:real^M->real^N`; `(p:real^M->real^N) o (g:real^1->real^M)`; `(f:real^M->real^M) o (g:real^1->real^M)`; `g:real^1->real^M`; `c:real^M->bool`; `s:real^N->bool`; `interval[vec 0:real^1,vec 1]`; `vec 0:real^1`; `vec 1:real^1`] COVERING_SPACE_LIFT_UNIQUE) THEN ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `IMAGE p c = s ==> !x. x IN c ==> p(x) IN s`)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);; let COVERING_SPACE_LIFT_HOMOTOPY = prove (`!p:real^M->real^N c s (h:real^(1,P)finite_sum->real^N) f u. covering_space (c,p) s /\ h continuous_on (interval[vec 0,vec 1] PCROSS u) /\ IMAGE h (interval[vec 0,vec 1] PCROSS u) SUBSET s /\ (!y. y IN u ==> h (pastecart (vec 0) y) = p(f y)) /\ f continuous_on u /\ IMAGE f u SUBSET c ==> ?k. k continuous_on (interval[vec 0,vec 1] PCROSS u) /\ IMAGE k (interval[vec 0,vec 1] PCROSS u) SUBSET c /\ (!y. y IN u ==> k(pastecart (vec 0) y) = f y) /\ (!z. z IN interval[vec 0,vec 1] PCROSS u ==> h z = p(k z))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!y. y IN u ==> ?v. open_in (subtopology euclidean u) v /\ y IN v /\ ?k:real^(1,P)finite_sum->real^M. k continuous_on (interval[vec 0,vec 1] PCROSS v) /\ IMAGE k (interval[vec 0,vec 1] PCROSS v) SUBSET c /\ (!y. y IN v ==> k(pastecart (vec 0) y) = f y) /\ (!z. z IN interval[vec 0,vec 1] PCROSS v ==> h z :real^N = p(k z))` MP_TAC THENL [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^P->real^P->bool`; `fs:real^P->real^(1,P)finite_sum->real^M`] THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPECL [`fs:real^P->real^(1,P)finite_sum->real^M`; `(\x. interval[vec 0,vec 1] PCROSS (v x)) :real^P->real^(1,P)finite_sum->bool`; `(interval[vec 0,vec 1] PCROSS u):real^(1,P)finite_sum->bool`; `u:real^P->bool`; `(:real^M)`] PASTING_LEMMA_EXISTS) THEN ASM_SIMP_TAC[SUBSET_UNIV] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,P)finite_sum->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `t:real^1`) THEN X_GEN_TAC `y:real^P` THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`pastecart (t:real^1) (y:real^P)`; `y:real^P`]); FIRST_X_ASSUM(MP_TAC o SPECL [`pastecart (vec 0:real^1) (y:real^P)`; `y:real^P`]); FIRST_X_ASSUM(MP_TAC o SPECL [`pastecart (t:real^1) (y:real^P)`; `y:real^P`])] THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_INTER; ENDS_IN_UNIT_INTERVAL] THEN DISCH_THEN SUBST1_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; UNIONS_GSPEC; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `y:real^P`] THEN STRIP_TAC THEN EXISTS_TAC `y:real^P` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS]; X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(:real^1) PCROSS (t:real^P->bool)` THEN ASM_SIMP_TAC[REWRITE_RULE[GSYM PCROSS] OPEN_PCROSS; OPEN_UNIV] THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_INTER; IN_UNIV] THEN REPEAT GEN_TAC THEN CONV_TAC TAUT; REWRITE_TAC[FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`x:real^P`; `z:real^P`; `t:real^1`; `y:real^P`] THEN REWRITE_TAC[CONJ_ACI] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`h:real^(1,P)finite_sum->real^N`; `(fs:real^P->real^(1,P)finite_sum->real^M) x`; `(fs:real^P->real^(1,P)finite_sum->real^M) z`; `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`; `pastecart (vec 0:real^1) (y:real^P)`; `pastecart (t:real^1) (y:real^P)`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_SING; ENDS_IN_UNIT_INTERVAL] THEN SIMP_TAC[REWRITE_RULE[GSYM PCROSS] CONNECTED_PCROSS; CONNECTED_INTERVAL; CONNECTED_SING] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN ASM_SIMP_TAC[IN_SING]; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN ASM_SIMP_TAC[IN_SING]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN CONJ_TAC THENL [REMOVE_THEN "*" (MP_TAC o SPEC `x:real^P`); REMOVE_THEN "*" (MP_TAC o SPEC `z:real^P`)] THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN ASM_SIMP_TAC[IN_SING]]] THEN X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o last o CONJUNCTS o GEN_REWRITE_RULE I [covering_space]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `!t. t IN interval[vec 0,vec 1] ==> ?k n i:real^N. open_in (subtopology euclidean (interval[vec 0,vec 1])) k /\ open_in (subtopology euclidean u) n /\ t IN k /\ y IN n /\ i IN s /\ IMAGE (h:real^(1,P)finite_sum->real^N) (k PCROSS n) SUBSET uu i` MP_TAC THENL [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `(h:real^(1,P)finite_sum->real^N) (pastecart t y) IN s` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[FORALL_IN_IMAGE] o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean (interval[vec 0,vec 1] PCROSS u)) {z | z IN (interval[vec 0,vec 1] PCROSS u) /\ (h:real^(1,P)finite_sum->real^N) z IN uu(h(pastecart t y))}` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] PASTECART_IN_INTERIOR_SUBTOPOLOGY)) THEN DISCH_THEN(MP_TAC o SPECL [`t:real^1`; `y:real^P`]) THEN ASM_SIMP_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^P->bool` THEN STRIP_TAC THEN EXISTS_TAC `(h:real^(1,P)finite_sum->real^N) (pastecart t y)` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[MESON[] `(?x y. (P y /\ x = f y) /\ Q x) <=> ?y. P y /\ Q(f y)`] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`kk:real^1->real^1->bool`; `nn:real^1->real^P->bool`; `xx:real^1->real^N`] THEN DISCH_THEN(LABEL_TAC "+") THEN MP_TAC(ISPEC `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}` COMPACT_IMP_HEINE_BOREL) THEN SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_SING] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE ((\i. kk i PCROSS nn i):real^1->real^(1,P)finite_sum->bool) (interval[vec 0,vec 1])`) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; OPEN_PCROSS] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IN_SING] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `z:real^P`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[IN_INTER]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `tk:real^1->bool` STRIP_ASSUME_TAC)] THEN ABBREV_TAC `n = INTERS (IMAGE (nn:real^1->real^P->bool) tk)` THEN SUBGOAL_THEN `(y:real^P) IN n /\ open n` STRIP_ASSUME_TAC THENL [EXPAND_TAC "n" THEN CONJ_TAC THENL [REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM]; MATCH_MP_TAC OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE]] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN (ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_INTER]]); ALL_TAC] THEN MP_TAC(ISPECL [`interval[vec 0:real^1,vec 1]`; `IMAGE (kk:real^1->real^1->bool) tk`] LEBESGUE_COVERING_LEMMA) THEN REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN MATCH_MP_TAC(TAUT `q /\ (p ==> ~q) /\ (q ==> (r ==> s) ==> t) ==> (~p /\ q /\ r ==> s) ==> t`) THEN SIMP_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IMP_CONJ; IN_SING] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN MESON_TAC[]; DISCH_TAC] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!n. n <= N ==> ?v k:real^(1,P)finite_sum->real^M. open_in (subtopology euclidean u) v /\ y IN v /\ k continuous_on interval[vec 0,lift(&n / &N)] PCROSS v /\ IMAGE k (interval[vec 0,lift(&n / &N)] PCROSS v) SUBSET c /\ (!y. y IN v ==> k (pastecart (vec 0) y) = f y) /\ (!z. z IN interval[vec 0,lift(&n / &N)] PCROSS v ==> h z:real^N = p (k z))` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM]] THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [DISCH_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN EXISTS_TAC `u:real^P->bool` THEN EXISTS_TAC `(f o sndcart):real^(1,P)finite_sum->real^M` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; INTERVAL_SING] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; o_THM] THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM2; SNDCART_PASTECART] THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN SIMP_TAC[SNDCART_PASTECART]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `SUC m <= N` THEN ASM_SIMP_TAC[ARITH_RULE `SUC m <= N ==> m <= N`; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^P->bool`; `k:real^(1,P)finite_sum->real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `interval[lift(&m / &N),lift(&(SUC m) / &N)]`) THEN ANTS_TAC THENL [REWRITE_TAC[DIAMETER_INTERVAL; SUBSET_INTERVAL_1] THEN REWRITE_TAC[LIFT_DROP; DROP_VEC; INTERVAL_EQ_EMPTY_1; GSYM LIFT_SUB; NORM_LIFT] THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1; REAL_FIELD `&0 < x ==> a / x - b / x = (a - b) / x`] THEN SIMP_TAC[GSYM NOT_LE; ARITH_RULE `m <= SUC m`; REAL_OF_NUM_SUB] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_DIV; REAL_POS; REAL_ABS_NUM; ARITH_RULE `SUC m - m = 1`] THEN ASM_SIMP_TAC[REAL_ARITH `&1 / n = inv(n)`; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(xx:real^1->real^N) t`) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `(k:real^(1,P)finite_sum->real^M) (pastecart (lift(&m / &N)) y)`) THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER])) THEN SUBGOAL_THEN `lift(&m / &N) IN interval[vec 0,lift (&m / &N)] /\ lift(&m / &N) IN interval[lift(&m / &N),lift(&(SUC m) / &N)]` STRIP_ASSUME_TAC THENL [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; LE_1; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; FIRST_X_ASSUM(MP_TAC o SPEC `pastecart(lift(&m / &N)) (y:real^P)`) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_LE_DIV; REAL_LE_LDIV_EQ; REAL_POS; REAL_OF_NUM_LT; LE_1; DROP_VEC] THEN REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC LAND_CONV [IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w:real^M->bool`) MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `w:real^M->bool` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN DISCH_TAC THEN UNDISCH_THEN `(w:real^M->bool) IN vv` (K ALL_TAC)] THEN ABBREV_TAC `w' = (uu:real^N->real^N->bool)(xx(t:real^1))` THEN SUBGOAL_THEN `?n'. open_in (subtopology euclidean u) n' /\ y IN n' /\ IMAGE (k:real^(1,P)finite_sum->real^M) ({lift(&m / &N)} PCROSS n') SUBSET w` STRIP_ASSUME_TAC THENL [EXISTS_TAC `{z | z IN v /\ ((k:real^(1,P)finite_sum->real^M) o pastecart (lift(&m / &N))) z IN w}` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_SING; o_THM] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^P->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS]; ALL_TAC] THEN SUBGOAL_THEN `?q q':real^P->bool. open_in (subtopology euclidean u) q /\ closed_in (subtopology euclidean u) q' /\ y IN q /\ y IN q' /\ q SUBSET q' /\ q SUBSET (u INTER nn(t:real^1)) INTER n' INTER v /\ q' SUBSET (u INTER nn(t:real^1)) INTER n' INTER v` STRIP_ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `y IN q /\ y IN q' /\ q SUBSET q' /\ q SUBSET s /\ q' SUBSET s <=> y IN q /\ q SUBSET q' /\ q' SUBSET s`] THEN UNDISCH_TAC `open_in (subtopology euclidean u) (v:real^P->bool)` THEN UNDISCH_TAC `open_in (subtopology euclidean u) (n':real^P->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `vo:real^P->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `vx:real^P->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `nn(t:real^1) INTER vo INTER vx:real^P->bool` OPEN_CONTAINS_CBALL) THEN ASM_SIMP_TAC[OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `y:real^P`) THEN ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u INTER ball(y:real^P,e)` THEN EXISTS_TAC `u INTER cball(y:real^P,e)` THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL [MESON_TAC[OPEN_BALL]; ALL_TAC] THEN CONJ_TAC THENL [MESON_TAC[CLOSED_CBALL]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN MP_TAC(ISPECL [`y:real^P`; `e:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN EXISTS_TAC `q:real^P->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`\x:real^(1,P)finite_sum. x IN interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`; `k:real^(1,P)finite_sum->real^M`; `(p':real^N->real^M) o (h:real^(1,P)finite_sum->real^N)`; `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`; `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (q':real^P->bool)`] CONTINUOUS_ON_CASES_LOCAL) THEN REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `interval[vec 0,lift(&m / &N)] PCROSS (:real^P)` THEN SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT; REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (:real^P)` THEN SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN MATCH_MP_TAC PCROSS_MONO THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN ASM_REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; SUBSET_INTER] THEN REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN DISJ2_TAC THEN ARITH_TAC; REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN ASM_CASES_TAC `(z:real^P) IN q'` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `(b <= x /\ x <= c) /\ (a <= x /\ x <= b) ==> x = b`)) THEN REWRITE_TAC[DROP_EQ; o_THM] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(!x. x IN w ==> p' (p x) = x) ==> h z = p(k z) /\ k z IN w ==> k z = p' (h z)`)) THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]]]; SUBGOAL_THEN `interval[vec 0,lift(&m / &N)] UNION interval [lift(&m / &N),lift(&(SUC m) / &N)] = interval[vec 0,lift(&(SUC m) / &N)]` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= c ==> (a <= x /\ x <= b \/ b <= x /\ x <= c <=> a <= x /\ x <= c)`) THEN SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_DIV; REAL_POS] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LE; LE_1] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool) UNION interval [lift(&m / &N),lift(&(SUC m) / &N)] PCROSS q' = interval[vec 0,lift(&(SUC m) / &N)] PCROSS q'` SUBST1_TAC THENL [SIMP_TAC[EXTENSION; IN_UNION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET] `t SUBSET s /\ (f continuous_on s ==> P f) ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN ASM_SIMP_TAC[PCROSS_MONO; SUBSET_REFL] THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN COND_CASES_TAC THEN REWRITE_TAC[o_THM] THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE p w' = w ==> x IN w' ==> p x IN w`))]; X_GEN_TAC `z:real^P` THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC]] THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; REWRITE_TAC[o_THM] THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN REPEAT(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= x /\ x <= b ==> b <= c ==> a <= x /\ x <= c`)) THEN ASM_SIMP_TAC[LIFT_DROP; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ASM_REWRITE_TAC[DROP_VEC; REAL_MUL_LID; REAL_OF_NUM_LE]]);; let COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION = prove (`!p:real^M->real^N c s f f' g u:real^P->bool. covering_space (c,p) s /\ g continuous_on u /\ IMAGE g u SUBSET c /\ (!y. y IN u ==> p(g y) = f y) /\ homotopic_with (\x. T) (u,s) f f' ==> ?g'. g' continuous_on u /\ IMAGE g' u SUBSET c /\ (!y. y IN u ==> p(g' y) = f' y)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `h:real^(1,P)finite_sum->real^N` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN FIRST_ASSUM(MP_TAC o ISPECL [`h:real^(1,P)finite_sum->real^N`; `g:real^P->real^M`; `u:real^P->bool`] o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\x. pastecart (vec 1) x)` THEN ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]]);; let COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION = prove (`!p:real^M->real^N c s f a u:real^P->bool. covering_space (c,p) s /\ homotopic_with (\x. T) (u,s) f (\x. a) ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ (!y. y IN u ==> p(g y) = f y)`, ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `u:real^P->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c /\ d /\ e ==> f <=> a /\ e ==> b /\ c /\ d ==> f`] COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION)) THEN FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN SUBGOAL_THEN `?b. b IN c /\ (p:real^M->real^N) b = a` CHOOSE_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `(\x. b):real^P->real^M`] THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);; let COVERING_SPACE_LIFT_HOMOTOPY_ALT = prove (`!p:real^M->real^N c s (h:real^(P,1)finite_sum->real^N) f u. covering_space (c,p) s /\ h continuous_on (u PCROSS interval[vec 0,vec 1]) /\ IMAGE h (u PCROSS interval[vec 0,vec 1]) SUBSET s /\ (!y. y IN u ==> h (pastecart y (vec 0)) = p(f y)) /\ f continuous_on u /\ IMAGE f u SUBSET c ==> ?k. k continuous_on (u PCROSS interval[vec 0,vec 1]) /\ IMAGE k (u PCROSS interval[vec 0,vec 1]) SUBSET c /\ (!y. y IN u ==> k(pastecart y (vec 0)) = f y) /\ (!z. z IN u PCROSS interval[vec 0,vec 1] ==> h z = p(k z))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`(h:real^(P,1)finite_sum->real^N) o (\z. pastecart (sndcart z) (fstcart z))`; `f:real^P->real^M`; `u:real^P->bool`] o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]; DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\z. pastecart (sndcart z) (fstcart z))` THEN ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; FORALL_IN_PCROSS; PASTECART_IN_PCROSS] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)); MAP_EVERY X_GEN_TAC [`x:real^P`; `t:real^1`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (x:real^P)`)] THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; FORALL_IN_PCROSS]]);; let COVERING_SPACE_LIFT_PATH_STRONG = prove (`!p:real^M->real^N c s g a. covering_space (c,p) s /\ path g /\ path_image g SUBSET s /\ pathstart g = p(a) /\ a IN c ==> ?h. path h /\ path_image h SUBSET c /\ pathstart h = a /\ !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`, REWRITE_TAC[path_image; path; pathstart] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`(g:real^1->real^N) o (fstcart:real^(1,P)finite_sum->real^1)`; `(\y. a):real^P->real^M`; `{arb:real^P}`] o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; o_THM; FSTCART_PASTECART] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IMAGE_o; CONTINUOUS_ON_CONST] THEN ASM_REWRITE_TAC[SET_RULE `IMAGE (\y. a) {b} SUBSET s <=> a IN s`] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); ALL_TAC] THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN SIMP_TAC[FSTCART_PASTECART] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\t. pastecart t arb)` THEN ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING]; X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (arb:real^P)`) THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; IN_SING]]]);; let COVERING_SPACE_LIFT_PATH = prove (`!p:real^M->real^N c s g. covering_space (c,p) s /\ path g /\ path_image g SUBSET s ==> ?h. path h /\ path_image h SUBSET c /\ !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `IMAGE g i SUBSET s ==> vec 0 IN i ==> g(vec 0) IN s`) o GEN_REWRITE_RULE LAND_CONV [path_image]) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN MP_TAC(ISPECL [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`; `g:real^1->real^N`; `a:real^M`] COVERING_SPACE_LIFT_PATH_STRONG) THEN ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);; let COVERING_SPACE_LIFT_HOMOTOPIC_PATHS = prove (`!p:real^M->real^N c s g1 g2 h1 h2. covering_space (c,p) s /\ path g1 /\ path_image g1 SUBSET s /\ path g2 /\ path_image g2 SUBSET s /\ homotopic_paths s g1 g2 /\ path h1 /\ path_image h1 SUBSET c /\ (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\ path h2 /\ path_image h2 SUBSET c /\ (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\ pathstart h1 = pathstart h2 ==> homotopic_paths c h1 h2`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_PATHS] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN REWRITE_TAC[homotopic_with; pathstart; pathfinish] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o ISPECL [`h:real^(1,1)finite_sum->real^N`; `(\x. pathstart h2):real^1->real^M`; `interval[vec 0:real^1,vec 1]`] o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY_ALT)) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,1)finite_sum->real^M` THEN STRIP_TAC THEN ASM_SIMP_TAC[o_DEF] THEN MATCH_MP_TAC(TAUT `(p /\ q) /\ (p /\ q ==> r) ==> p /\ q /\ r`) THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_FORALL_IMP_THM] o ONCE_REWRITE_RULE[IMP_CONJ] o REWRITE_RULE[CONJ_ASSOC] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THENL [MAP_EVERY EXISTS_TAC [`g1:real^1->real^N`; `vec 0:real^1`]; MAP_EVERY EXISTS_TAC [`g2:real^1->real^N`; `vec 0:real^1`]] THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish; path]) THEN ASM_REWRITE_TAC[CONNECTED_INTERVAL; pathstart; pathfinish] THEN REWRITE_TAC[CONJ_ASSOC] THEN (REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)); ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]); STRIP_TAC THEN REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_FORALL_IMP_THM] o ONCE_REWRITE_RULE[IMP_CONJ] o REWRITE_RULE[CONJ_ASSOC] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN MAP_EVERY EXISTS_TAC [`(\x. pathfinish g1):real^1->real^N`; `vec 0:real^1`] THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN REWRITE_TAC[CONTINUOUS_ON_CONST; pathfinish] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (vec 1:real^1)` o REWRITE_RULE[FORALL_IN_IMAGE] o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]]]);; let COVERING_SPACE_MONODROMY = prove (`!p:real^M->real^N c s g1 g2 h1 h2. covering_space (c,p) s /\ path g1 /\ path_image g1 SUBSET s /\ path g2 /\ path_image g2 SUBSET s /\ homotopic_paths s g1 g2 /\ path h1 /\ path_image h1 SUBSET c /\ (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\ path h2 /\ path_image h2 SUBSET c /\ (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\ pathstart h1 = pathstart h2 ==> pathfinish h1 = pathfinish h2`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_HOMOTOPIC_PATHS) THEN REWRITE_TAC[HOMOTOPIC_PATHS_IMP_PATHFINISH]);; let COVERING_SPACE_LIFT_HOMOTOPIC_PATH = prove (`!p:real^M->real^N c s f f' g a b. covering_space (c,p) s /\ homotopic_paths s f f' /\ path g /\ path_image g SUBSET c /\ pathstart g = a /\ pathfinish g = b /\ (!t. t IN interval[vec 0,vec 1] ==> p(g t) = f t) ==> ?g'. path g' /\ path_image g' SUBSET c /\ pathstart g' = a /\ pathfinish g' = b /\ (!t. t IN interval[vec 0,vec 1] ==> p(g' t) = f' t)`, ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN FIRST_ASSUM(MP_TAC o ISPECL [`f':real^1->real^N`; `a:real^M`] o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; HOMOTOPIC_PATHS_IMP_PATHSTART]; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^1->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(ASSUME `pathfinish g:real^M = b`)) THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN MAP_EVERY EXISTS_TAC [`f':real^1->real^N`; `f:real^1->real^N`] THEN ASM_REWRITE_TAC[]]);; let COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP = prove (`!p:real^M->real^N c s g h a. covering_space (c,p) s /\ path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ homotopic_paths s g (linepath(a,a)) /\ path h /\ path_image h SUBSET c /\ (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t) ==> pathfinish h = pathstart h`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN REWRITE_TAC[PATHSTART_LINEPATH] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL [`g:real^1->real^N`; `linepath(a:real^N,a)`; `h:real^1->real^M`; `linepath(pathstart h:real^M,pathstart h)`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN ASM_REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM_REWRITE_TAC[SING_SUBSET; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LINEPATH_REFL] THEN CONJ_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);; let COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP = prove (`!p:real^M->real^N c s g h. covering_space (c,p) s /\ simply_connected s /\ path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ path h /\ path_image h SUBSET c /\ (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t) ==> pathfinish h = pathstart h`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP)) THEN EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH]);; let COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL = prove (`!p:real^M->real^N c s g h. covering_space (c,p) s /\ path g /\ path_image g SUBSET c /\ path h /\ path_image h SUBSET c /\ pathstart g = pathstart h /\ homotopic_paths s (p o g) (p o h) ==> homotopic_paths c g h`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPIC_PATHS)) THEN MAP_EVERY EXISTS_TAC [`(p:real^M->real^N) o (g:real^1->real^M)`; `(p:real^M->real^N) o (h:real^1->real^M)`] THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; HOMOTOPIC_PATHS_IMP_SUBSET]);; let COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ = prove (`!p:real^M->real^N c s g h. covering_space (c,p) s /\ path g /\ path_image g SUBSET c /\ path h /\ path_image h SUBSET c /\ pathstart g = pathstart h ==> (homotopic_paths s (p o g) (p o h) <=> homotopic_paths c g h)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL]; DISCH_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN EXISTS_TAC `c:real^M->bool` THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_REWRITE_TAC[SUBSET_REFL]);; (* ------------------------------------------------------------------------- *) (* Lifting of general functions to covering space *) (* ------------------------------------------------------------------------- *) let COVERING_SPACE_LIFT_GENERAL = prove (`!p:real^M->real^N c s f:real^P->real^N u a z. covering_space (c,p) s /\ a IN c /\ z IN u /\ path_connected u /\ locally path_connected u /\ f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\ (!r. path r /\ path_image r SUBSET u /\ pathstart r = z /\ pathfinish r = z ==> ?q. path q /\ path_image q SUBSET c /\ pathstart q = a /\ pathfinish q = a /\ homotopic_paths s (f o r) (p o q)) ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\ (!y. y IN u ==> p(g y) = f y)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!y. y IN u ==> ?g h. path g /\ path_image g SUBSET u /\ pathstart g = z /\ pathfinish g = y /\ path h /\ path_image h SUBSET c /\ pathstart h = a /\ (!t. t IN interval[vec 0,vec 1] ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))` (LABEL_TAC "*") THENL [X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(MP_TAC o SPECL [`z:real^P`; `y:real^P`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^P` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATHSTART_COMPOSE] THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `?l. !y g h. path g /\ path_image g SUBSET u /\ pathstart g = z /\ pathfinish g = y /\ path h /\ path_image h SUBSET c /\ pathstart h = a /\ (!t. t IN interval[vec 0,vec 1] ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t)) ==> pathfinish h = l y` MP_TAC THENL [REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `y:real^P` THEN MATCH_MP_TAC(MESON[] `(!g h g' h'. P g h /\ P g' h' ==> f h = f h') ==> ?z. !g h. P g h ==> f h = z`) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g ++ reversepath g'):real^1->real^P`) THEN ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^M` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o ISPECL [`(p:real^M->real^N) o (q:real^1->real^M)`; `(f:real^P->real^N) o (g ++ reversepath g')`; `q:real^1->real^M`; `pathstart q:real^M`; `pathfinish q:real^M`] o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] COVERING_SPACE_LIFT_HOMOTOPIC_PATH))) THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `q':real^1->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `path(h ++ reversepath h':real^1->real^M)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_REVERSEPATH; PATHSTART_REVERSEPATH]] THEN MATCH_MP_TAC PATH_EQ THEN EXISTS_TAC `q':real^1->real^M` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL [FIRST_ASSUM(MP_TAC o ISPECL [`(f:real^P->real^N) o (g:real^1->real^P) o (\t. &2 % t)`; `q':real^1->real^M`; `(h:real^1->real^M) o (\t. &2 % t)`; `interval[vec 0,lift(&1 / &2)]`; `vec 0:real^1`; `t:real^1`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN CONJ_TAC THENL [SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; joinpaths; o_THM]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path]; REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) /\ s SUBSET t ==> IMAGE f s SUBSET IMAGE g t`) THEN REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; IN_INTERVAL_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[joinpaths; o_THM]; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[GSYM path] THEN REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image(q':real^1->real^M)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image(h:real^1->real^M)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN REWRITE_TAC[DROP_VEC; DROP_CMUL; LIFT_DROP] THEN REAL_ARITH_TAC; X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[CONNECTED_INTERVAL]; REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM pathstart] THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SYM(ASSUME `pathstart h:real^M = a`)) THEN REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN REWRITE_TAC[VECTOR_MUL_RZERO]; REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; FIRST_ASSUM(MP_TAC o ISPECL [`(f:real^P->real^N) o reversepath(g':real^1->real^P) o (\t. &2 % t - vec 1)`; `q':real^1->real^M`; `reversepath(h':real^1->real^M) o (\t. &2 % t - vec 1)`; `{t | &1 / &2 < drop t /\ drop t <= &1}`; `vec 1:real^1`; `t:real^1`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN CONJ_TAC THENL [SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC]; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) /\ s SUBSET t ==> IMAGE f s SUBSET IMAGE g t`) THEN SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[GSYM path] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image(q':real^1->real^M)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC; X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC; GSYM REAL_NOT_LT] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_SIMP_TAC[GSYM path; PATH_REVERSEPATH] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image(reversepath h':real^1->real^M)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH]] THEN REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN REAL_ARITH_TAC; X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REWRITE_TAC[reversepath] THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM; DROP_VEC] THEN REAL_ARITH_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM pathfinish] THEN ASM_REWRITE_TAC[reversepath] THEN SUBST1_TAC(SYM(ASSUME `pathstart h':real^M = a`)) THEN REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_CMUL; DROP_VEC] THEN REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^P->real^M` THEN DISCH_THEN(LABEL_TAC "+") THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN REPEAT CONJ_TAC THENL [STRIP_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]; FIRST_ASSUM(MP_TAC o SPECL [`z:real^P`; `linepath(z:real^P,z)`; `linepath(a:real^M,a)`]) THEN REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_SIMP_TAC[LINEPATH_REFL; SING_SUBSET]; X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^P`; `h:real^1->real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^P`; `g:real^1->real^P`; `h:real^1->real^M`]) THEN ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN X_GEN_TAC `n:real^M->bool` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^P` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN FIRST_ASSUM(MP_TAC o SPEC `(f:real^P->real^N) y` o last o CONJUNCTS o GEN_REWRITE_RULE I [covering_space]) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `(l:real^P->real^M) y`) THEN MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN DISCH_THEN(X_CHOOSE_THEN `w':real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w':real^M->bool`) MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `w':real^M->bool` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN DISCH_TAC THEN UNDISCH_THEN `(w':real^M->bool) IN vv` (K ALL_TAC) THEN SUBGOAL_THEN `?v. y IN v /\ y IN u /\ IMAGE (f:real^P->real^N) v SUBSET w /\ v SUBSET u /\ path_connected v /\ open_in (subtopology euclidean u) v` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED]) THEN DISCH_THEN(MP_TAC o SPECL [`{x | x IN u /\ (f:real^P->real^N) x IN w}`; `y:real^P`]) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN SUBGOAL_THEN `(w':real^M->bool) SUBSET c /\ (w:real^N->bool) SUBSET s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN EXISTS_TAC `v INTER {x | x IN u /\ (f:real^P->real^N) x IN {x | x IN w /\ (p':real^N->real^M) x IN w' INTER n}}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `w':real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN UNDISCH_TAC `open_in (subtopology euclidean c) (n:real^M->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC] THEN SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `y':real^P` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(MP_TAC o SPECL [`y:real^P`; `y':real^P`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^P` STRIP_ASSUME_TAC) THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`pp:real^1->real^P`; `qq:real^1->real^M`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`y':real^P`; `(pp:real^1->real^P) ++ r`; `(qq:real^1->real^M) ++ ((p':real^N->real^M) o (f:real^P->real^N) o (r:real^1->real^P))`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^P`; `pp:real^1->real^P`; `qq:real^1->real^M`]) THEN ASM_SIMP_TAC[o_THM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN DISCH_TAC THEN SUBGOAL_THEN `path_image ((pp:real^1->real^P) ++ r) SUBSET u` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[PATHFINISH_COMPOSE] THEN ASM_MESON_TAC[]] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[PATH_JOIN]; ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN]; MATCH_MP_TAC PATH_JOIN_IMP THEN ASM_SIMP_TAC[PATHSTART_COMPOSE] THEN CONJ_TAC THENL [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[pathfinish] THEN ASM SET_TAC[]]; MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[]; X_GEN_TAC `tt:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN REWRITE_TAC[joinpaths; o_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ABBREV_TAC `t:real^1 = &2 % tt`; ABBREV_TAC `t:real^1 = &2 % tt - vec 1`] THEN (SUBGOAL_THEN `t IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL [EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]);; let COVERING_SPACE_LIFT_STRONGER = prove (`!p:real^M->real^N c s f:real^P->real^N u a z. covering_space (c,p) s /\ a IN c /\ z IN u /\ path_connected u /\ locally path_connected u /\ f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\ (!r. path r /\ path_image r SUBSET u /\ pathstart r = z /\ pathfinish r = z ==> ?b. homotopic_paths s (f o r) (linepath(b,b))) ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\ (!y. y IN u ==> p(g y) = f y)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_GENERAL)) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1->real^P`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN EXISTS_TAC `linepath(a:real^M,a)` THEN REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF; LINEPATH_REFL]) THEN ASM_REWRITE_TAC[o_DEF; LINEPATH_REFL]);; let COVERING_SPACE_LIFT_STRONG = prove (`!p:real^M->real^N c s f:real^P->real^N u a z. covering_space (c,p) s /\ a IN c /\ z IN u /\ simply_connected u /\ locally path_connected u /\ f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\ (!y. y IN u ==> p(g y) = f y)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_STRONGER)) THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN EXISTS_TAC `(f:real^P->real^N) z` THEN SUBGOAL_THEN `linepath(f z,f z) = (f:real^P->real^N) o linepath(z,z)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LINEPATH_REFL]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]);; let COVERING_SPACE_LIFT = prove (`!p:real^M->real^N c s f:real^P->real^N u. covering_space (c,p) s /\ simply_connected u /\ locally path_connected u /\ f continuous_on u /\ IMAGE f u SUBSET s ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ (!y. y IN u ==> p(g y) = f y)`, MP_TAC COVERING_SPACE_LIFT_STRONG THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN ASM_CASES_TAC `u:real^P->bool = {}` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^P`) THEN FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^P->real^N) a`) THEN MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some additional lemmas about covering spaces. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_COVERING_MAP_FIBRES = prove (`!p:real^M->real^N c s a b. covering_space (c,p) s /\ path_connected s /\ a IN s /\ b IN s ==> {x | x IN c /\ p(x) = a} =_c {x | x IN c /\ p(x) = b}`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV) [CONJ_SYM] THEN MATCH_MP_TAC(MESON[] `(!a b. P a b) ==> (!a b. P a b) /\ (!a b. P b a)`) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`] o GEN_REWRITE_RULE I [path_connected]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `!z. ?h. z IN c /\ p z = a ==> path h /\ path_image h SUBSET c /\ pathstart h = z /\ !t. t IN interval[vec 0,vec 1] ==> (p:real^M->real^N)(h t) = g t` MP_TAC THENL [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^M->real^1->real^M` THEN DISCH_TAC] THEN REWRITE_TAC[le_c; IN_ELIM_THM] THEN EXISTS_TAC `\z. pathfinish((h:real^M->real^1->real^M) z)` THEN ASM_REWRITE_TAC[pathfinish] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[SUBSET; path_image; pathstart; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]; MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`; `reversepath(g:real^1->real^N)`; `reversepath(g:real^1->real^N)`; `reversepath((h:real^M->real^1->real^M) x)`; `reversepath((h:real^M->real^1->real^M) y)`] COVERING_SPACE_MONODROMY) THEN ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; HOMOTOPIC_PATHS_REFL] THEN ASM_REWRITE_TAC[pathfinish; reversepath; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`); FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);; let COVERING_SPACE_INJECTIVE = prove (`!p:real^M->real^N c s. covering_space (c,p) s /\ path_connected c /\ simply_connected s ==> (!x y. x IN c /\ y IN c /\ p x = p y ==> x = y)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_CONTINUOUS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `(p:real^M->real^N) o (g:real^1->real^M)` th) THEN MP_TAC(SPEC `(p:real^M->real^N) o linepath(x:real^M,x)` th)) THEN SUBGOAL_THEN `(path ((p:real^M->real^N) o linepath(x,x)) /\ path (p o g)) /\ (path_image (p o linepath(x:real^M,x)) SUBSET s /\ path_image (p o g) SUBSET s)` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN ASM_REWRITE_TAC[CONTINUOUS_ON_SING; SEGMENT_REFL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[SEGMENT_REFL] THEN ASM SET_TAC[]]; ALL_TAC] THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN DISCH_THEN(X_CHOOSE_THEN `h1:real^1->real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `h2:real^1->real^M` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPECL [`(p:real^M->real^N) o linepath(x:real^M,x)`; `(p:real^M->real^N) o (g:real^1->real^M)`; `h1:real^1->real^M`; `h2:real^1->real^M`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `pathfinish(linepath(x:real^M,x))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[PATHFINISH_LINEPATH]]; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th])] THEN REWRITE_TAC[pathfinish] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THENL [EXISTS_TAC `(p:real^M->real^N) o (h1:real^1->real^M)`; EXISTS_TAC `(p:real^M->real^N) o (h2:real^1->real^M)`] THEN MAP_EVERY EXISTS_TAC [`interval[vec 0:real^1,vec 1]`; `vec 0:real^1`] THEN REWRITE_TAC[CONNECTED_INTERVAL; ENDS_IN_UNIT_INTERVAL] THEN ASM_REWRITE_TAC[GSYM path; PATH_LINEPATH; GSYM path_image] THEN RULE_ASSUM_TAC(REWRITE_RULE[o_THM]) THEN ASM_REWRITE_TAC[o_THM] THEN ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN ASM_REWRITE_TAC[LINEPATH_REFL; PATH_IMAGE_COMPOSE] THEN (CONJ_TAC THENL [ASM_MESON_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]));; let COVERING_SPACE_HOMEOMORPHISM = prove (`!p:real^M->real^N c s. covering_space (c,p) s /\ path_connected c /\ simply_connected s ==> ?q. homeomorphism (c,s) (p,q)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ASM_MESON_TAC[COVERING_SPACE_IMP_SURJECTIVE]; ASM_MESON_TAC[COVERING_SPACE_INJECTIVE]; ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]]);; (* ------------------------------------------------------------------------- *) (* Results on finiteness of the number of sheets in a covering space. *) (* ------------------------------------------------------------------------- *) let COVERING_SPACE_FIBRE_NO_LIMPT = prove (`!p:real^M->real^N c s a b. covering_space (c,p) s /\ a IN c ==> ~(a limit_point_of {x | x IN c /\ p x = b})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [covering_space]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) a`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN GEN_REWRITE_TAC I [IMP_CONJ] THEN REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool` o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INFINITE]] THEN MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET] `(?a. s SUBSET {a}) ==> FINITE s`) THEN ASM SET_TAC[]);; let COVERING_SPACE_COUNTABLE_SHEETS = prove (`!p:real^M->real^N c s b. covering_space (c,p) s ==> COUNTABLE {x | x IN c /\ p x = b}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[] (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] UNCOUNTABLE_CONTAINS_LIMIT_POINT)) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);; let COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE = prove (`!p:real^M->real^N c s b. covering_space (c,p) s ==> (FINITE {x | x IN c /\ p x = b} <=> compact {x | x IN c /\ p x = b})`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[FINITE_IMP_COMPACT] THEN DISCH_TAC THEN ASM_CASES_TAC `(b:real^N) IN s` THENL [ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `{x | x IN c /\ (p:real^M->real^N) x = b}` o GEN_REWRITE_RULE I [COMPACT_EQ_BOLZANO_WEIERSTRASS]) THEN ASM_REWRITE_TAC[INFINITE; SUBSET_REFL; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^N`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_FIBRE_NO_LIMPT)) THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `{x | x IN c /\ (p:real^M->real^N) x = b} = {}` (fun th -> REWRITE_TAC[th; FINITE_EMPTY]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN ASM SET_TAC[]]);; let COVERING_SPACE_CLOSED_MAP = prove (`!p:real^M->real^N c s t. covering_space (c,p) s /\ (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) /\ closed_in (subtopology euclidean c) t ==> closed_in (subtopology euclidean s) (IMAGE p t)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN]] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:real^N` o last o CONJUNCTS o GEN_REWRITE_RULE I [covering_space]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_THEN(X_CHOOSE_THEN `uu:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `uu:(real^M->bool)->bool = {}` THENL [ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `INTERS {IMAGE (p:real^M->real^N) (u DIFF t) | u IN uu}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE THEN SUBGOAL_THEN `!u. u IN uu ==> ?x. x IN u /\ (p:real^M->real^N) x = y` ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `FINITE (IMAGE (\u. @x. x IN u /\ (p:real^M->real^N) x = y) uu)` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM SET_TAC[]]; X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^M->bool` THEN ASM_SIMP_TAC[LEFT_EXISTS_AND_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `(:real^M) DIFF k` THEN ASM_REWRITE_TAC[GSYM closed] THEN ASM SET_TAC[]]; REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `q /\ r /\ ~s ==> ~(s <=> q /\ r)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[IN_UNIONS] THEN ASM SET_TAC[]]);; let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG = prove (`!p:real^M->real^N c s. covering_space (c,p) s /\ (!b. b IN s ==> b limit_point_of s) ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=> (!t. closed_in (subtopology euclidean c) t ==> closed_in (subtopology euclidean s) (IMAGE p t)))`, let lemma = prove (`!f:num->real^N. (!n. ~(s = v n) ==> DISJOINT s (v n)) ==> (!n. f n IN v n) /\ (!m n. v m = v n <=> m = n) ==> ?n. IMAGE f (:num) INTER s SUBSET {f n}`, ASM_CASES_TAC `?n. s = (v:num->real^N->bool) n` THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS); RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM]) THEN ASM_REWRITE_TAC[]] THEN ASM SET_TAC[]) in REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC COVERING_SPACE_CLOSED_MAP THEN EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `b:real^N` o last o CONJUNCTS o GEN_REWRITE_RULE I [covering_space]) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(b:real^N) limit_point_of t` MP_TAC THENL [MATCH_MP_TAC LIMPT_OF_OPEN_IN THEN ASM_MESON_TAC[]; PURE_REWRITE_TAC[LIMPT_SEQUENTIAL_INJ]] THEN DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `INFINITE(vv:(real^M->bool)->bool)` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_LE_INFINITE)) THEN REWRITE_TAC[le_c] THEN SUBGOAL_THEN `!x. ?v. x IN c /\ (p:real^M->real^N) x = b ==> v IN vv /\ x IN v` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^M->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INFINITE_CARD_LE; le_c; INJECTIVE_ON_ALT] THEN REWRITE_TAC[IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC) THEN UNDISCH_THEN `!u. u IN vv ==> ?q:real^N->real^M. homeomorphism (u,t) (p,q)` (MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN ASM_REWRITE_TAC[SKOLEM_THM; homeomorphism; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `q:num->real^N->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `closed_in (subtopology euclidean s) (IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)))` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CLOSED_IN_LIMPT; SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(p:real^M->real^N) a = b` ASSUME_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(p:real^M->real^N) o (\n:num. q n (y n :real^N)) o (r:num->num)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [MATCH_MP_TAC(GEN_ALL(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] (fst(EQ_IMP_RULE(SPEC_ALL CONTINUOUS_ON_SEQUENTIALLY))))) THEN EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]; REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]; SUBGOAL_THEN `?u. u IN vv /\ (a:real^M) IN u` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?w:real^M->bool. open w /\ u = c INTER w` (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THENL [ASM_MESON_TAC[OPEN_IN_OPEN]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN DISCH_THEN(MP_TAC o SPEC `w:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `INFINITE s ==> !k. s INTER k = s ==> INFINITE(s INTER k)`)) THEN DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INTER_ASSOC]] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN DISCH_THEN(MP_TAC o SPEC `c INTER w:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `\n. (q:num->real^N->real^M) n (y n)` o MATCH_MP lemma) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MESON_TAC[FINITE_SUBSET; FINITE_SING; INTER_COMM]]; SUBGOAL_THEN `IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)) = IMAGE y (:num)` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^N`)) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN EXISTS_TAC `y:num->real^N` THEN ASM SET_TAC[]]);; let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP = prove (`!p:real^M->real^N c s. covering_space (c,p) s /\ connected s /\ ~(?a. s = {a}) ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=> (!t. closed_in (subtopology euclidean c) t ==> closed_in (subtopology euclidean s) (IMAGE p t)))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [SUBGOAL_THEN `c:real^M->bool = {}` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; CLOSED_IN_SUBTOPOLOGY_EMPTY; IMAGE_EQ_EMPTY; NOT_IN_EMPTY]]; MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN ASM SET_TAC[]]);; let COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=> (!k. k SUBSET s /\ compact k ==> compact {x | x IN c /\ p(x) IN k}))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP PROPER_MAP th]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC [GSYM(MATCH_MP COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE th)]) THEN REWRITE_TAC[TAUT `(p <=> q /\ p) <=> (p ==> q)`] THEN ASM_MESON_TAC[COVERING_SPACE_CLOSED_MAP]);; (* ------------------------------------------------------------------------- *) (* Special cases where one or both of the sets is compact. *) (* ------------------------------------------------------------------------- *) let COVERING_SPACE_FINITE_SHEETS = prove (`!p:real^M->real^N c s b. covering_space (c,p) s /\ compact c ==> FINITE {x | x IN c /\ p x = b}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);; let COVERING_SPACE_COMPACT = prove (`!p:real^M->real^N c s. covering_space (c,p) s ==> (compact c <=> compact s /\ (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[covering_space; COMPACT_CONTINUOUS_IMAGE]; MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS THEN ASM_MESON_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A proper (or closed) local homeomorphism is in fact a covering map. *) (* ------------------------------------------------------------------------- *) let PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP = prove (`!p:real^M->real^N c s. IMAGE p c = s /\ (!k. k SUBSET s /\ compact k ==> compact {x | x IN c /\ p x IN k}) /\ (!x. x IN c ==> ?t u q. x IN t /\ open_in (subtopology euclidean c) t /\ open_in (subtopology euclidean s) u /\ homeomorphism (t,u) (p,q)) ==> covering_space (c,p) s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(p:real^M->real^N) continuous_on c` ASSUME_TAC THENL [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN REWRITE_TAC[CONTINUOUS_WITHIN_OPEN; OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[CONTINUOUS_WITHIN_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `w:real^N->bool`) THEN ASM_REWRITE_TAC[IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `y INTER v:real^M->bool` THEN ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[covering_space] THEN SUBGOAL_THEN `!y. y IN s ==> FINITE {x | x IN c /\ (p:real^M->real^N) x = y}` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN EXISTS_TAC `{x | x IN c /\ (p:real^M->real^N) x = y}` THEN REWRITE_TAC[SUBSET_REFL; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM IN_SING] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SING_SUBSET; COMPACT_SING]; X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[limit_point_of; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `v:real^N->bool`; `q:real^N->real^M`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER]) THEN DISCH_THEN(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!y. y IN s ==> ?v uu. y IN v /\ open_in (subtopology euclidean s) v /\ pairwise DISJOINT (IMAGE uu {x | x IN c /\ p x = y}) /\ !x. x IN c /\ (p:real^M->real^N) x = y ==> x IN uu x /\ open_in (subtopology euclidean c) (uu x) /\ ?q. homeomorphism (uu x,v) (p,q)` ASSUME_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?uu:real^M->real^M->bool vv:real^M->real^N->bool. pairwise DISJOINT (IMAGE uu {x | x IN c /\ p x = y}) /\ !x. x IN c /\ (p:real^M->real^N) x = y ==> x IN uu x /\ open_in (subtopology euclidean c) (uu x) /\ open_in (subtopology euclidean s) (vv x) /\ (?q. homeomorphism (uu x,vv x) (p,q))` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `{x | x IN c /\ (p:real^M->real^N) x = y}` FINITE_EQ_BOUNDED_DISCRETE) THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` MP_TAC o CONJUNCT2) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN REWRITE_TAC[GSYM CONJ_ASSOC; REAL_NOT_LT] THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN c /\ (p:real^M->real^N) x = y ==> ?u v. x IN u /\ open_in (subtopology euclidean c) u /\ open_in (subtopology euclidean s) v /\ ?q. homeomorphism (u,v) (p,q)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`uu:real^M->real^M->bool`; `vv:real^M->real^N->bool`] THEN DISCH_TAC THEN EXISTS_TAC `\x:real^M. ball(x,r / &2) INTER uu x` THEN EXISTS_TAC `\x. IMAGE (p:real^M->real^N) (ball(x,r / &2) INTER uu x)` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN CONJ_TAC THENL [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `x':real^M`]) THEN ASM_CASES_TAC `x':real^M = x` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `(!y. y IN s /\ y IN t ==> ~P) ==> P ==> Q ==> DISJOINT (s INTER s') (t INTER t')`) THEN REWRITE_TAC[IN_BALL] THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[OPEN_BALL; ONCE_REWRITE_RULE[INTER_COMM]OPEN_IN_INTER_OPEN]; MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `(vv:real^M->real^N->bool) x` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_IMP_OPEN_MAP)) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN SET_TAC[]]; ALL_TAC] THEN ABBREV_TAC `v = INTERS (IMAGE (vv:real^M->real^N->bool) {x | x IN c /\ (p:real^M->real^N) x = y})` THEN EXISTS_TAC `v:real^N->bool` THEN EXISTS_TAC `\x:real^M. {w | w IN uu x /\ (p:real^M->real^N) w IN v}` THEN REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [EXPAND_TAC "v" THEN REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[HOMEOMORPHISM] THEN ASM SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [EXPAND_TAC "v" THEN MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_GSPEC; FINITE_IMAGE] THEN ASM SET_TAC[]; DISCH_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[pairwise; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `(uu:real^M->real^M->bool) x` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])] THEN ASM SET_TAC[]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN EXPAND_TAC "v" THEN REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM; SUBSET] THEN X_GEN_TAC `z:real^N` THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `x:real^M` th)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `z IN IMAGE p s /\ P z ==> z IN IMAGE p {x | x IN s /\ P(p x)}`) THEN ASM SET_TAC[]]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `v:real^N->bool` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `uu:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?w. y IN w /\ open_in (subtopology euclidean s) w /\ w SUBSET v /\ {x | x IN c /\ (p:real^M->real^N) x IN w} SUBSET UNIONS (IMAGE uu {x | x IN c /\ p x = y})` MP_TAC THENL [SUBGOAL_THEN `?w. y IN w /\ open_in (subtopology euclidean s) w /\ {x | x IN c /\ (p:real^M->real^N) x IN w} SUBSET UNIONS (IMAGE uu {x | x IN c /\ p x = y})` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MESON[] `~(!w. P w /\ Q w ==> ~R w) ==> ?w. P w /\ Q w /\ R w`) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `s INTER ball(y:real^N,inv(&n + &1))`) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[UNIONS_IMAGE; SKOLEM_THM; SET_RULE `~(s SUBSET t) <=> ?x. x IN s /\ ~(x IN t)`] THEN REWRITE_TAC[IN_ELIM_THM; IN_BALL; FORALL_AND_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN X_GEN_TAC `z:num->real^M` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y INSERT IMAGE ((p:real^M->real^N) o (z:num->real^M)) (:num)`) THEN REWRITE_TAC[NOT_IMP] THEN SUBGOAL_THEN `(((p:real^M->real^N) o (z:num->real^M)) --> y) sequentially` ASSUME_TAC THENL [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN TRANS_TAC REAL_LTE_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `inv(&N)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUBSET; FORALL_IN_INSERT; FORALL_IN_IMAGE; o_THM] THEN MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[compact] THEN DISCH_THEN(MP_TAC o SPEC `z:num->real^M`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[IN_INSERT; IN_IMAGE; o_DEF] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `r:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `(p:real^M->real^N) x = y` ASSUME_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(p:real^M->real^N) o (z:num->real^M) o (r:num->num)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `(z:num->real^M) o (r:num->num)`) THEN ASM_REWRITE_TAC[o_THM]; REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPECL [`n:num`; `x:real^M`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN UNDISCH_TAC `open_in (subtopology euclidean c) ((uu:real^M->real^M->bool) x)` THEN REWRITE_TAC[open_in] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN UNDISCH_TAC `(((z:num->real^M) o (r:num->num)) --> x) sequentially` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[LE_REFL]]; EXISTS_TAC `v INTER w:real^N->bool` THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_INTER; INTER_SUBSET] THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `IMAGE (\x:real^M. {w | w IN uu x /\ (p:real^M->real^N) w IN t}) {x | x IN c /\ p x = y}` THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_IMAGE; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE]) THEN EQ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^M` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `(uu:real^M->real^M->bool) x` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[pairwise; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN SET_TAC[]; X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[IMP_IMP] MONO_EXISTS))) THEN GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC LAND_CONV [HOMEOMORPHISM] THEN STRIP_TAC THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN ASM SET_TAC[]]);; let CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP = prove (`!p:real^M->real^N c s. (!x. connected_component c x = {x} ==> c = {x}) /\ IMAGE p c = s /\ (!k. closed_in (subtopology euclidean c) k ==> closed_in (subtopology euclidean s) (IMAGE p k)) /\ (!x. x IN c ==> ?t u q. x IN t /\ open_in (subtopology euclidean c) t /\ open_in (subtopology euclidean s) u /\ homeomorphism (t,u) (p,q)) ==> covering_space (c,p) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER THEN ASM_REWRITE_TAC[SUBSET_REFL]);; let PROPER_LOCAL_HOMEOMORPHISM_GLOBAL = prove (`!f:real^M->real^N s t. path_connected s /\ simply_connected t /\ (s = {} ==> t = {}) /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!x. x IN s ==> ?u v q. x IN u /\ open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean t) v /\ homeomorphism (u,v) (f,q)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHISM; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY] THEN SET_TAC[]; STRIP_TAC] THEN MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s`) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP) THEN DISCH_THEN(MP_TAC o SPEC `s:real^M->bool`) THEN REWRITE_TAC[OPEN_IN_REFL] THEN DISCH_THEN(MP_TAC o MATCH_MP PROPER_MAP o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_IN_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP) THEN REWRITE_TAC[OPEN_IN_REFL]);; let CLOSED_LOCAL_HOMEOMORPHISM_GLOBAL = prove (`!f:real^M->real^N s t. path_connected s /\ simply_connected t /\ (s = {} ==> t = {}) /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ (!x. x IN s ==> ?u v g. x IN u /\ open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean t) v /\ homeomorphism (u,v) (f,g)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHISM; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY] THEN SET_TAC[]; STRIP_TAC] THEN MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `connected_component s (x:real^M) = {}` THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; PATH_CONNECTED_IMP_CONNECTED]; FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s`) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[CLOSED_IN_REFL] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP) THEN REWRITE_TAC[OPEN_IN_REFL]]);; let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP = prove (`!p:real^M->real^N c s. p continuous_on c /\ IMAGE p c = s /\ (!k. k SUBSET s /\ compact k ==> compact {x | x IN c /\ p x IN k}) /\ (!u. open_in (subtopology euclidean c) u ==> open_in (subtopology euclidean s) (IMAGE p u)) /\ (!x. x IN c ==> ?t. x IN t /\ open_in (subtopology euclidean c) t /\ (!y z. y IN t /\ z IN t /\ p y = p z ==> y = z)) ==> covering_space (c,p) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `IMAGE (p:real^M->real^N) t` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[OPEN_IN_TRANS]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]]]);; let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN = prove (`!p:real^M->real^N c s. p continuous_on c /\ IMAGE p c = s /\ (!k. k SUBSET s /\ compact k ==> compact {x | x IN c /\ p x IN k}) /\ (!u. open_in (subtopology euclidean c) u ==> open_in (subtopology euclidean c) {x | x IN c /\ p x IN IMAGE p u}) /\ (!x. x IN c ==> ?t. x IN t /\ open_in (subtopology euclidean c) t /\ (!y z. y IN t /\ z IN t /\ p y = p z ==> y = z)) ==> covering_space (c,p) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_OPEN_MAP THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PROPER_MAP; SUBSET_REFL]);; let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM = prove (`!f:real^M->real^N s t. path_connected s /\ simply_connected t /\ f continuous_on s /\ IMAGE f s = t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ (!x. x IN s ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\ !y z. y IN u /\ z IN u /\ f y = f z ==> y = z) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP THEN ASM_REWRITE_TAC[]);; let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM_GEN = prove (`!f:real^M->real^N s t. path_connected s /\ simply_connected t /\ f continuous_on s /\ IMAGE f s = t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f u}) /\ (!x. x IN s ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\ !y z. y IN u /\ z IN u /\ f y = f z ==> y = z) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* A simply connected covering space is universal. *) (* ------------------------------------------------------------------------- *) let UNIVERSAL_COVERING_SPACE = prove (`!c p:real^M->real^P c' p':real^N->real^P s. covering_space (c,p) s /\ covering_space (c',p') s /\ locally path_connected c /\ simply_connected c /\ connected c' ==> ?q. covering_space (c,q) c' /\ !x. x IN c ==> p'(q x) = p x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^P->bool = {}` THENL [ASM_SIMP_TAC[covering_space; IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[CONTINUOUS_ON_EMPTY]; FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^P` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN STRIP_TAC THEN SUBGOAL_THEN `path_connected(c':real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ; PATH_CONNECTED_EQ_CONNECTED_LPC]; ALL_TAC] THEN SUBGOAL_THEN `locally connected (s:real^P->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED; COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ]; ALL_TAC] THEN SUBGOAL_THEN `?b:real^M b':real^N. b IN c /\ b' IN c' /\ (p:real^M->real^P) b = a /\ p' b' = a` STRIP_ASSUME_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`p':real^N->real^P`; `c':real^N->bool`; `s:real^P->bool`; `p:real^M->real^P`; `c:real^M->bool`; `b':real^N`; `b:real^M`] COVERING_SPACE_LIFT_STRONG) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[covering_space; SUBSET_REFL]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^M->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[covering_space] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN DISCH_THEN(MP_TAC o SPECL [`b':real^N`; `z:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g':real^1->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`p:real^M->real^P`; `c:real^M->bool`; `s:real^P->bool`; `(p':real^N->real^P) o (g':real^1->real^N)`; `b:real^M`] COVERING_SPACE_LIFT_PATH_STRONG) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATH_IMAGE_COMPOSE] THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; REWRITE_TAC[o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`p':real^N->real^P`; `c':real^N->bool`; `s:real^P->bool`; `(p':real^N->real^P) o (g':real^1->real^N)`; `(p':real^N->real^P) o q o (g:real^1->real^M)`; `g':real^1->real^N`; `(q:real^M->real^N) o (g:real^1->real^M)`] COVERING_SPACE_MONODROMY) THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN ANTS_TAC THENL [REWRITE_TAC[o_THM; PATH_IMAGE_COMPOSE] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]; MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [covering_space])) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]; RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]; MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN ASM_SIMP_TAC[o_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]; MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]]; DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `pathfinish(g:real^1->real^M)` THEN ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]]; DISCH_TAC] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?t vv vv'. connected t /\ open_in (subtopology euclidean s) t /\ (p':real^N->real^P) z IN t /\ UNIONS vv = {x:real^M | x IN c /\ p x IN t} /\ (!u. u IN vv ==> open_in (subtopology euclidean c) u) /\ pairwise DISJOINT vv /\ (!u. u IN vv ==> (?r. homeomorphism (u,t) (p,r))) /\ UNIONS vv' = {x:real^N | x IN c' /\ p' x IN t} /\ (!u. u IN vv' ==> open_in (subtopology euclidean c') u) /\ pairwise DISJOINT vv' /\ (!u. u IN vv' ==> (?r'. homeomorphism (u,t) (p',r')))` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `covering_space (c,p:real^M->real^P) s` THEN REWRITE_TAC[covering_space] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `(p':real^N->real^P) z`) THEN ANTS_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC)] THEN UNDISCH_TAC `covering_space (c',p':real^N->real^P) s` THEN REWRITE_TAC[covering_space] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `(p':real^N->real^P) z`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `t':real^P->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `vv':(real^N->bool)->bool` STRIP_ASSUME_TAC)] THEN ABBREV_TAC `u = connected_component (t INTER t') ((p':real^N->real^P) z)` THEN SUBGOAL_THEN `(u:real^P->bool) SUBSET t INTER t'` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`u:real^P->bool`; `{{x | x IN v /\ (p:real^M->real^P) x IN u} | v IN vv}`; `{{x | x IN v /\ (p':real^N->real^P) x IN u} | v IN vv'}`] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `t INTER t':real^P->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER] THEN EXPAND_TAC "u" THEN MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN ASM_MESON_TAC[LOCALLY_INTER_OPEN; LOCALLY_OPEN_SUBSET]; REWRITE_TAC[IN] THEN EXPAND_TAC "u" THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_REWRITE_TAC[IN_INTER]; REWRITE_TAC[SET_RULE `{x | x IN v /\ P x} = v INTER {x | P x}`] THEN ASM_REWRITE_TAC[GSYM INTER_UNIONS] THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET THEN EXISTS_TAC `s:real^P->bool` THEN ASM_SIMP_TAC[SUBSET_REFL] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `t INTER t':real^P->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER] THEN EXPAND_TAC "u" THEN MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN ASM_MESON_TAC[LOCALLY_INTER_OPEN; LOCALLY_OPEN_SUBSET]; REWRITE_TAC[PAIRWISE_IMAGE; SIMPLE_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_IMP)) THEN SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_exists o concl)) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[homeomorphism] th) THEN MP_TAC th THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHISM_OF_SUBSETS)) THEN ASM SET_TAC[]; REWRITE_TAC[SET_RULE `{x | x IN v /\ P x} = v INTER {x | P x}`] THEN ASM_REWRITE_TAC[GSYM INTER_UNIONS] THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET THEN EXISTS_TAC `s:real^P->bool` THEN ASM_SIMP_TAC[SUBSET_REFL] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `t INTER t':real^P->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER] THEN EXPAND_TAC "u" THEN MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN ASM_MESON_TAC[LOCALLY_INTER_OPEN; LOCALLY_OPEN_SUBSET]; REWRITE_TAC[PAIRWISE_IMAGE; SIMPLE_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_IMP)) THEN SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_exists o concl)) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[homeomorphism] th) THEN MP_TAC th THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHISM_OF_SUBSETS)) THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `?v':real^N->bool. v' IN vv' /\ z IN v'` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `v' SUBSET {x | x IN c' /\ (p':real^N->real^P) x IN t}` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean c') (v':real^N->bool) /\ ?r':real^P->real^N. homeomorphism (v',t) (p',r')` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `v':real^N->bool` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!u. u IN vv ==> ?u'. u' IN vv' /\ IMAGE (q:real^M->real^N) u SUBSET u'` ASSUME_TAC THENL [X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `IMAGE (q:real^M->real^N) u SUBSET UNIONS vv'` MP_TAC THENL [ASM_REWRITE_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `~(UNIONS uu = {}) /\ (!u. u IN uu ==> DISJOINT s u \/ DISJOINT s (UNIONS(uu DELETE u))) ==> s SUBSET UNIONS uu ==> ?u. u IN uu /\ s SUBSET u`) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `connected(IMAGE (q:real^M->real^N) u)` MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN UNDISCH_TAC `connected(t:real^P->bool)` THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN REWRITE_TAC[homeomorphic] THEN ASM_MESON_TAC[]; REWRITE_TAC[CONNECTED_OPEN_IN; NOT_EXISTS_THM; TAUT `~(p /\ q /\ r /\ s /\ t) <=> p /\ q /\ r /\ s ==> ~t`] THEN REWRITE_TAC[DE_MORGAN_THM; DISJOINT]] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `c':real^N->bool` THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC OPEN_IN_INTER THEN ASM_SIMP_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM_SIMP_TAC[IN_DELETE]; REWRITE_TAC[GSYM UNION_OVER_INTER] THEN ASM_SIMP_TAC[GSYM UNIONS_INSERT; SET_RULE `a IN s ==> a INSERT (s DELETE a) = s`] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s INTER t = {} ==> (u INTER s) INTER (u INTER t) = {}`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_1] THEN W(MP_TAC o PART_MATCH (lhand o rand) INTER_UNIONS_PAIRWISE_DISJOINT o lhand o snd) THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> {a} UNION (s DELETE a) = s`] THEN SET_TAC[]]; ALL_TAC] THEN EXISTS_TAC `{v:real^M->bool | v IN vv /\ IMAGE (q:real^M->real^N) v SUBSET v'}` THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ASM SET_TAC[]; GEN_REWRITE_TAC I [SUBSET]] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^M) IN UNIONS vv` MP_TAC THENL [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_MONO)) THEN SET_TAC[]; X_GEN_TAC `v:real^M->bool` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `r:real^P->real^M`) THEN EXISTS_TAC `(r:real^P->real^M) o (p':real^N->real^P)` THEN MATCH_MP_TAC HOMEOMORPHISM_EQ THEN MAP_EVERY EXISTS_TAC [`(r':real^P->real^N) o (p:real^M->real^P)`; `(r:real^P->real^M) o (p':real^N->real^P)`] THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Size of fundamental group of a covering space (this could be generalized *) (* with structural properties of the bijections of course). *) (* ------------------------------------------------------------------------- *) let CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT = prove (`!p:real^M->real^N c s a. covering_space(c,p) s /\ path_connected c /\ a IN c ==> fundamental_group(s,p a) =_c {homotopic_paths c g |g| path g /\ path_image g SUBSET c /\ pathstart g = a /\ p(pathfinish g) = p a}`, let tac = REPEAT (FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH)) THEN ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_CONTINUOUS_IMAGE]; ALL_TAC] THEN REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[] in REPEAT STRIP_TAC THEN REWRITE_TAC[fundamental_group] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[eq_c] THEN EXISTS_TAC `homotopic_paths s o ((o) (p:real^M->real^N)) o (@)` THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; EXISTS_UNIQUE_DEF; GSYM CONJ_ASSOC; IMP_CONJ; o_THM; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g ((@) (homotopic_paths c g))` MP_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL]; ABBREV_TAC `h:real^1->real^M = (@) (homotopic_paths c g)` THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN MATCH_MP_TAC(SET_RULE `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`) THEN tac; X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN DISCH_THEN(MP_TAC o SPECL [`h:real^1->real^N`; `a:real^M`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g ((@) (homotopic_paths c g))` MP_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL]; ABBREV_TAC `g':real^1->real^M = (@) (homotopic_paths c g)` THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS] `homotopic_paths s p q ==> !r. homotopic_paths s p r <=> homotopic_paths s q r`) THEN TRANS_TAC HOMOTOPIC_PATHS_TRANS `(p:real^M->real^N) o (g:real^1->real^M)` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]; MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN ASM_REWRITE_TAC[o_THM] THEN tac]; X_GEN_TAC `g:real^1->real^M` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN X_GEN_TAC `g':real^1->real^M` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g ((@) (homotopic_paths c g))` MP_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL]; ABBREV_TAC `k:real^1->real^M = (@) (homotopic_paths c g)` THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g' ((@) (homotopic_paths c g'))` MP_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL]; ABBREV_TAC `k':real^1->real^M = (@) (homotopic_paths c g')` THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN DISCH_THEN(MP_TAC o C AP_THM `(p:real^M->real^N) o (k:real^1->real^M)`) THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN ANTS_TAC THENL [tac; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ o lhand o snd) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [tac; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]]]);; let CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE = prove (`!p:real^M->real^N c s a. covering_space(c,p) s /\ path_connected c /\ a IN c ==> fundamental_group(s,p a) =_c fundamental_group(c,a) *_c {a' | a' IN c /\ p a' = p a}`, let lemma = prove (`!g:real^1->real^N. path g /\ path_image g SUBSET c ==> homotopic_paths c g ((@) (homotopic_paths c g)) /\ path ((@) (homotopic_paths c g)) /\ path_image ((@) (homotopic_paths c g)) SUBSET c /\ pathstart ((@) (homotopic_paths c g)) = pathstart g /\ pathfinish ((@) (homotopic_paths c g)) = pathfinish g`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL]; ASM MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; HOMOTOPIC_PATHS_IMP_SUBSET; HOMOTOPIC_PATHS_IMP_PATHSTART; HOMOTOPIC_PATHS_IMP_PATHFINISH]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `!b:real^M. b IN c ==> ?g. path g /\ path_image g SUBSET c /\ pathstart g = a /\ pathfinish g = b` MP_TAC THENL [ASM_MESON_TAC[path_connected]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^M->real^1->real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M` o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN REWRITE_TAC[EQ_C_BIJECTIONS] THEN REWRITE_TAC[mul_c; FORALL_IN_GSPEC] THEN MAP_EVERY EXISTS_TAC [`\g. homotopic_paths c ((@) g ++ reversepath(f(pathfinish((@) g):real^M))),pathfinish((@) g)`; `\(g,b:real^M). homotopic_paths (c:real^M->bool) ((@) g ++ f b)`] THEN REWRITE_TAC[fundamental_group; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN CONJ_TAC THEN X_GEN_TAC `g:real^1->real^M` THEN REPEAT DISCH_TAC THEN (SUBGOAL_THEN `(pathfinish g:real^M) IN c` ASSUME_TAC THENL [ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]; ALL_TAC]) THEN MP_TAC(ISPEC `g:real^1->real^M` lemma) THEN ABBREV_TAC `g':real^1->real^M = (@) (homotopic_paths c g)` THEN ASM_REWRITE_TAC[GSYM CONJ_ASSOC] THEN STRIP_TAC THEN TRY(X_GEN_TAC `b:real^M` THEN REPEAT DISCH_TAC) THEN (CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`) THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH; SUBSET_PATH_IMAGE_JOIN; PATHSTART_REVERSEPATH; PATH_IMAGE_REVERSEPATH]; ALL_TAC]) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THENL [MP_TAC(ISPEC `g' ++ reversepath(f(pathfinish g')):real^1->real^M` lemma) THEN ASM_SIMP_TAC[PATH_JOIN; SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH; PATH_REVERSEPATH; PATHSTART_REVERSEPATH] THEN ABBREV_TAC `g'':real^1->real^M = (@) (homotopic_paths c (g' ++ reversepath(f(pathfinish(g:real^1->real^M)))))` THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN STRIP_TAC; MP_TAC(ISPEC `g' ++ f(b:real^M):real^1->real^M` lemma) THEN ASM_SIMP_TAC[PATH_JOIN; SUBSET_PATH_IMAGE_JOIN] THEN ABBREV_TAC `g'':real^1->real^M = (@) (homotopic_paths c (g' ++ f(b:real^M):real^1->real^M))` THEN ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PAIR_EQ] THEN STRIP_TAC] THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS] `homotopic_paths s p q ==> !r. homotopic_paths s p r <=> homotopic_paths s q r`) THENL [TRANS_TAC HOMOTOPIC_PATHS_TRANS `(g' ++ reversepath(f(pathfinish g:real^M))) ++ f(pathfinish g):real^1->real^M` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_REFL] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rator o rand) (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] HOMOTOPIC_PATHS_ASSOC) o rator o snd) THEN ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN TRANS_TAC HOMOTOPIC_PATHS_TRANS `g' ++ linepath(pathfinish(f(pathfinish g:real^M)):real^M, pathfinish(f(pathfinish g)))` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_REFL; PATHSTART_REVERSEPATH; PATHSTART_JOIN]; ALL_TAC] THEN TRANS_TAC HOMOTOPIC_PATHS_TRANS `g':real^1->real^M` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM]] THEN ASM_SIMP_TAC[] THEN SUBST1_TAC(SYM(ASSUME `pathfinish g':real^M = pathfinish g`)) THEN MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[]; TRANS_TAC HOMOTOPIC_PATHS_TRANS `(g' ++ f(b:real^M)) ++ reversepath(f b):real^1->real^M` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_REFL; PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATHSTART_REVERSEPATH] THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rator o rand) (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] HOMOTOPIC_PATHS_ASSOC) o rator o snd) THEN ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN TRANS_TAC HOMOTOPIC_PATHS_TRANS `g' ++ linepath(pathstart(f(b:real^M)),pathstart(f b)) :real^1->real^M` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL; PATHSTART_REVERSEPATH; PATHSTART_JOIN]; ALL_TAC] THEN TRANS_TAC HOMOTOPIC_PATHS_TRANS `g':real^1->real^M` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM]] THEN ASM_SIMP_TAC[] THEN SUBST1_TAC(SYM(ASSUME `pathfinish g':real^M = a`)) THEN MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[]]);; let COVERING_SPACE_SELF_FINITE_FUNDAMENTAL_GROUP = prove (`!p s a:real^N. covering_space (s,p) s /\ path_connected s /\ a IN s /\ FINITE(fundamental_group(s,a)) ==> ?q. homeomorphism (s,s) (p,q)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN REPEAT CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[]; ALL_TAC; ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]] THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`] CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(p:real^N->real^N) b`; `b:real^N`] CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS) THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]; DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG)] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`p:real^N->real^N`; `s:real^N->bool`;` s:real^N->bool`; `b:real^N`] CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_CARD_IMP) th) THEN MP_TAC(MATCH_MP CARD_FINITE_CONG th)) THEN ASM_REWRITE_TAC[CARD_MUL_FINITE_EQ; FUNDAMENTAL_GROUP_EQ_EMPTY] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (MESON[FINITE_EMPTY] `s = {} \/ FINITE s ==> FINITE s`)) THEN ASM_SIMP_TAC[CARD_MUL_C] THEN FIRST_ASSUM (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_CARD_IMP)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[NUM_RING `a = a * b <=> a = 0 \/ b = 1`] THEN ASM_SIMP_TAC[CARD_EQ_0; FUNDAMENTAL_GROUP_EQ_EMPTY] THEN ASM_SIMP_TAC[MESON[HAS_SIZE] `FINITE s ==> (CARD s = n <=> s HAS_SIZE n)`] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN ASM SET_TAC[]);; hol-light/Multivariate/polytope.ml000066400000000000000000015255141303454263000176350ustar00rootroot00000000000000(* ========================================================================= *) (* Faces, extreme points, polytopes, polyhedra etc. *) (* ========================================================================= *) needs "Multivariate/paths.ml";; (* ------------------------------------------------------------------------- *) (* Faces of a (usually convex) set. *) (* ------------------------------------------------------------------------- *) parse_as_infix("face_of",(12,"right"));; let face_of = new_definition `t face_of s <=> t SUBSET s /\ convex t /\ !a b x. a IN s /\ b IN s /\ x IN t /\ x IN segment(a,b) ==> a IN t /\ b IN t`;; let FACE_OF_TRANSLATION_EQ = prove (`!a f s:real^N->bool. (IMAGE (\x. a + x) f) face_of (IMAGE (\x. a + x) s) <=> f face_of s`, REWRITE_TAC[face_of] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [FACE_OF_TRANSLATION_EQ];; let FACE_OF_LINEAR_IMAGE = prove (`!f:real^M->real^N c s. linear f /\ (!x y. f x = f y ==> x = y) ==> ((IMAGE f c) face_of (IMAGE f s) <=> c face_of s)`, REWRITE_TAC[face_of; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MP_TAC(end_itlist CONJ (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; add_linear_invariants [FACE_OF_LINEAR_IMAGE];; let FACE_OF_REFL = prove (`!s. convex s ==> s face_of s`, SIMP_TAC[face_of] THEN SET_TAC[]);; let FACE_OF_REFL_EQ = prove (`!s. s face_of s <=> convex s`, SIMP_TAC[face_of] THEN SET_TAC[]);; let EMPTY_FACE_OF = prove (`!s. {} face_of s`, REWRITE_TAC[face_of; CONVEX_EMPTY] THEN SET_TAC[]);; let FACE_OF_EMPTY = prove (`!s. s face_of {} <=> s = {}`, REWRITE_TAC[face_of; SUBSET_EMPTY; NOT_IN_EMPTY] THEN MESON_TAC[CONVEX_EMPTY]);; let FACE_OF_TRANS = prove (`!s t u. s face_of t /\ t face_of u ==> s face_of u`, REWRITE_TAC[face_of] THEN SET_TAC[]);; let FACE_OF_FACE = prove (`!f s t. t face_of s ==> (f face_of t <=> f face_of s /\ f SUBSET t)`, REWRITE_TAC[face_of] THEN SET_TAC[]);; let FACE_OF_SUBSET = prove (`!f s t. f face_of s /\ f SUBSET t /\ t SUBSET s ==> f face_of t`, REWRITE_TAC[face_of] THEN SET_TAC[]);; let FACE_OF_SLICE = prove (`!f s t. f face_of s /\ convex t ==> (f INTER t) face_of (s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[face_of; IN_INTER] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CONVEX_INTER]; ASM_MESON_TAC[]]);; let FACE_OF_INTER = prove (`!s t1 t2. t1 face_of s /\ t2 face_of s ==> (t1 INTER t2) face_of s`, SIMP_TAC[face_of; CONVEX_INTER] THEN SET_TAC[]);; let FACE_OF_INTERS = prove (`!P s. ~(P = {}) /\ (!t. t IN P ==> t face_of s) ==> (INTERS P) face_of s`, REWRITE_TAC[face_of] THEN REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[CONVEX_INTERS]; ASM SET_TAC[]; ASM SET_TAC[]]);; let FACE_OF_INTER_INTER = prove (`!f t f' t'. f face_of t /\ f' face_of t' ==> (f INTER f') face_of (t INTER t')`, REWRITE_TAC[face_of; SUBSET; IN_INTER] THEN MESON_TAC[CONVEX_INTER]);; let FACE_OF_STILLCONVEX = prove (`!s t:real^N->bool. convex s ==> (t face_of s <=> t SUBSET s /\ convex(s DIFF t) /\ t = (affine hull t) INTER s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[face_of] THEN ASM_CASES_TAC `(t:real^N->bool) SUBSET s` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN STRIP_TAC THENL [CONJ_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; open_segment; IN_DIFF] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; SUBSET_DIFF] THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [ASM MESON_TAC[HULL_INC; SUBSET; IN_INTER]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N -> bool = {}` THEN ASM_REWRITE_TAC[IN_INTER; AFFINE_HULL_EMPTY; NOT_IN_EMPTY] THEN MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; OPEN_SEGMENT_ALT] THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `min (&1 / &2) (e / norm(x - y:real^N))` THEN REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTER; IN_CBALL; dist] THEN CONJ_TAC THENL [REWRITE_TAC[NORM_MUL; VECTOR_ARITH `y - ((&1 - u) % y + u % x):real^N = u % (y - x)`] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> abs(min (&1 / &2) e) <= e`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN ASM_SIMP_TAC[HULL_INC]]; CONJ_TAC THENL [ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_INTER THEN ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN SUBGOAL_THEN `!a b x:real^N. a IN s /\ b IN s /\ x IN t /\ x IN segment(a,b) /\ (a IN affine hull t ==> b IN affine hull t) ==> a IN t /\ b IN t` (fun th -> MESON_TAC[th; SEGMENT_SYM]) THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN affine hull t` THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; STRIP_TAC] THEN ASM_CASES_TAC `a:real^N = b` THENL [ASM_MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `(a:real^N) IN (s DIFF t) /\ b IN (s DIFF t)` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[IN_DIFF] THEN ONCE_ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_INTER] THEN UNDISCH_TAC `~((a:real^N) IN affine hull t)` THEN UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN ASM_SIMP_TAC[OPEN_SEGMENT_ALT; CONTRAPOS_THM; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv(&1 - u)) :real^N->real^N`) THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `x < &1 ==> ~(&1 - x = &0)`] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = &1 % a + u % b <=> a = x + --u % b`] THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN ASM_SIMP_TAC[HULL_INC] THEN UNDISCH_TAC `u < &1` THEN CONV_TAC REAL_FIELD; MP_TAC(ISPEC `s DIFF t:real^N->bool` CONVEX_CONTAINS_SEGMENT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[SUBSET; IN_DIFF] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_MESON_TAC[segment; IN_DIFF]]]);; let FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG = prove (`!s a:real^N b. convex(s INTER {x | a dot x = b}) /\ (!x. x IN s ==> a dot x <= b) ==> (s INTER {x | a dot x = b}) face_of s`, MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `c:real^N`; `d:real`] THEN SIMP_TAC[face_of; INTER_SUBSET] THEN STRIP_TAC THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a <= x /\ b <= x /\ ~(a < x) /\ ~(b < x) ==> a = x /\ b = x`) THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN CONJ_TAC THEN DISCH_TAC THEN UNDISCH_TAC `(c:real^N) dot x = d` THEN MATCH_MP_TAC(REAL_ARITH `x < a ==> x = a ==> F`) THEN SUBST1_TAC(REAL_ARITH `d = (&1 - u) * d + u * d`) THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THENL [MATCH_MP_TAC REAL_LTE_ADD2; MATCH_MP_TAC REAL_LET_ADD2] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LMUL_EQ; REAL_SUB_LT]);; let FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG = prove (`!s a:real^N b. convex(s INTER {x | a dot x = b}) /\ (!x. x IN s ==> a dot x >= b) ==> (s INTER {x | a dot x = b}) face_of s`, REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`] FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG) THEN ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);; let FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove (`!s a:real^N b. convex s /\ (!x. x IN s ==> a dot x <= b) ==> (s INTER {x | a dot x = b}) face_of s`, SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG; CONVEX_INTER; CONVEX_HYPERPLANE]);; let FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove (`!s a:real^N b. convex s /\ (!x. x IN s ==> a dot x >= b) ==> (s INTER {x | a dot x = b}) face_of s`, SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG; CONVEX_INTER; CONVEX_HYPERPLANE]);; let FACE_OF_IMP_SUBSET = prove (`!s t. t face_of s ==> t SUBSET s`, SIMP_TAC[face_of]);; let FACE_OF_IMP_CONVEX = prove (`!s t. t face_of s ==> convex t`, SIMP_TAC[face_of]);; let FACE_OF_IMP_CLOSED = prove (`!s t. convex s /\ closed s /\ t face_of s ==> closed t`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[FACE_OF_STILLCONVEX] THEN STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL; CLOSED_INTER]);; let FACE_OF_IMP_COMPACT = prove (`!s t. convex s /\ compact s /\ t face_of s ==> compact t`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_MESON_TAC[BOUNDED_SUBSET; FACE_OF_IMP_SUBSET; FACE_OF_IMP_CLOSED]);; let FACE_OF_INTER_SUBFACE = prove (`!c1 c2 d1 d2:real^N->bool. (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2 /\ d1 face_of c1 /\ d2 face_of c2 ==> (d1 INTER d2) face_of d1 /\ (d1 INTER d2) face_of d2`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET THENL [EXISTS_TAC `c1:real^N->bool`; EXISTS_TAC `c2:real^N->bool`] THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET; INTER_SUBSET] THEN TRANS_TAC FACE_OF_TRANS `c1 INTER c2:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_INTER_INTER]);; let SUBSET_OF_FACE_OF = prove (`!s t u:real^N->bool. t face_of s /\ u SUBSET s /\ ~(DISJOINT t (relative_interior u)) ==> u SUBSET t`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_INTER] THEN ASM_CASES_TAC `c:real^N = b` THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `d:real^N = b + e / norm(b - c) % (b - c)` THEN DISCH_THEN(MP_TAC o SPEC `d:real^N`) THEN ANTS_TAC THENL [EXPAND_TAC "d" THEN CONJ_TAC THENL [REWRITE_TAC[NORM_ARITH `dist(b:real^N,b + e) = norm e`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[VECTOR_ARITH `b + u % (b - c):real^N = (&1 - --u) % b + --u % c`] THEN MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN ASM_SIMP_TAC[HULL_INC]]; STRIP_TAC THEN SUBGOAL_THEN `(d:real^N) IN t /\ c IN t` (fun th -> MESON_TAC[th]) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `b:real^N` THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN SUBGOAL_THEN `~(b:real^N = d)` ASSUME_TAC THENL [EXPAND_TAC "d" THEN REWRITE_TAC[VECTOR_ARITH `b:real^N = b + e <=> e = vec 0`] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ]; ASM_REWRITE_TAC[segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `(e / norm(b - c:real^N)) / (&1 + e / norm(b - c))` THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; REAL_ARITH `&0 < x ==> &0 < &1 + x`; REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < n ==> (&1 + e / n) * n = n + e`; NORM_POS_LT; VECTOR_SUB_EQ; REAL_LE_ADDL] THEN ASM_SIMP_TAC[NORM_POS_LT; REAL_LT_IMP_LE; VECTOR_SUB_EQ] THEN EXPAND_TAC "d" THEN REWRITE_TAC[VECTOR_ARITH `b:real^N = (&1 - u) % (b + e % (b - c)) + u % c <=> (u - e * (&1 - u)) % (b - c) = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_FIELD `&0 < e ==> e / (&1 + e) - e * (&1 - e / (&1 + e)) = &0`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]]);; let FACE_OF_EQ = prove (`!s t u:real^N->bool. t face_of s /\ u face_of s /\ ~(DISJOINT (relative_interior t) (relative_interior u)) ==> t = u`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THENL [MP_TAC(ISPEC `u:real^N->bool` RELATIVE_INTERIOR_SUBSET); MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_SUBSET)] THEN ASM SET_TAC[]);; let FACE_OF_DISJOINT_RELATIVE_INTERIOR = prove (`!f s:real^N->bool. f face_of s /\ ~(f = s) ==> f INTER relative_interior s = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`; `s:real^N->bool`] SUBSET_OF_FACE_OF) THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM SET_TAC[]);; let FACE_OF_DISJOINT_INTERIOR = prove (`!f s:real^N->bool. f face_of s /\ ~(f = s) ==> f INTER interior s = {}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN SET_TAC[]);; let SUBSET_OF_FACE_OF_AFFINE_HULL = prove (`!s t u:real^N->bool. t face_of s /\ convex s /\ u SUBSET s /\ ~DISJOINT (affine hull t) (relative_interior u) ==> u SUBSET t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] FACE_OF_STILLCONVEX) THEN MP_TAC(ISPEC `u:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR = prove (`!s f:real^N->bool. convex s /\ f face_of s /\ ~(f = s) ==> affine hull f INTER relative_interior s = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`; `s:real^N->bool`] SUBSET_OF_FACE_OF_AFFINE_HULL) THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM SET_TAC[]);; let FACE_OF_SUBSET_RELATIVE_BOUNDARY = prove (`!s f:real^N->bool. f face_of s /\ ~(f = s) ==> f SUBSET (s DIFF relative_interior s)`, ASM_SIMP_TAC[SET_RULE `s SUBSET u DIFF t <=> s SUBSET u /\ s INTER t = {}`; FACE_OF_DISJOINT_RELATIVE_INTERIOR; FACE_OF_IMP_SUBSET]);; let FACE_OF_SUBSET_RELATIVE_FRONTIER = prove (`!s f:real^N->bool. f face_of s /\ ~(f = s) ==> f SUBSET relative_frontier s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_SUBSET_RELATIVE_BOUNDARY) THEN REWRITE_TAC[relative_frontier] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let FACE_OF_SUBSET_RELATIVE_FRONTIER_AFF_DIM = prove (`!f s:real^N->bool. f face_of s /\ aff_dim f < aff_dim s ==> f SUBSET relative_frontier s`, MESON_TAC[FACE_OF_SUBSET_RELATIVE_FRONTIER; INT_LT_REFL]);; let FACE_OF_SUBSET_FRONTIER_AFF_DIM = prove (`!f s:real^N->bool. f face_of s /\ aff_dim f < &(dimindex(:N)) ==> f SUBSET frontier s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `interior s:real^N->bool = {}` THENL [ASM_SIMP_TAC[frontier; DIFF_EMPTY] THEN ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET_TRANS; CLOSURE_SUBSET]; TRANS_TAC SUBSET_TRANS `relative_frontier s:real^N->bool` THEN REWRITE_TAC[RELATIVE_FRONTIER_SUBSET_FRONTIER] THEN ASM_MESON_TAC[AFF_DIM_NONEMPTY_INTERIOR; FACE_OF_SUBSET_RELATIVE_FRONTIER_AFF_DIM]]);; let FACE_OF_AFF_DIM_LT = prove (`!f s:real^N->bool. convex s /\ f face_of s /\ ~(f = s) ==> aff_dim f < aff_dim s`, REPEAT GEN_TAC THEN SIMP_TAC[INT_LT_LE; FACE_OF_IMP_SUBSET; AFF_DIM_SUBSET] THEN REWRITE_TAC[IMP_CONJ; CONTRAPOS_THM] THEN ASM_CASES_TAC `f:real^N->bool = {}` THENL [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EMPTY]; REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN MATCH_MP_TAC(SET_RULE `~(f = {}) /\ f SUBSET s ==> ~DISJOINT f s`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR THEN ASM_MESON_TAC[FACE_OF_IMP_SUBSET; AFF_DIM_EQ_AFFINE_HULL; INT_LE_REFL]]);; let FACE_OF_CONVEX_HULLS = prove (`!f s:real^N->bool. FINITE s /\ f SUBSET s /\ DISJOINT (affine hull f) (convex hull (s DIFF f)) ==> (convex hull f) face_of (convex hull s)`, let lemma = prove (`!s x y:real^N. affine s /\ ~(k = &0) /\ ~(k = &1) /\ x IN s /\ inv(&1 - k) % y IN s ==> inv(k) % (x - y) IN s`, REWRITE_TAC[AFFINE_ALT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `inv(k) % (x - y):real^N = (&1 - inv k) % inv(&1 - k) % y + inv(k) % x` (fun th -> ASM_SIMP_TAC[th]) THEN REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH `k % (x - y):real^N = a % b % y + k % x <=> (a * b + k) % y = vec 0`] THEN DISJ1_TAC THEN MAP_EVERY UNDISCH_TAC [`~(k = &0)`; `~(k = &1)`] THEN CONV_TAC REAL_FIELD) in REPEAT STRIP_TAC THEN REWRITE_TAC[face_of] THEN SUBGOAL_THEN `FINITE(f:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_SIMP_TAC[HULL_MONO; CONVEX_CONVEX_HULL] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `w:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `(w:real^N) IN affine hull f` ASSUME_TAC THENL [ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; ALL_TAC] THEN MAP_EVERY UNDISCH_TAC [`(y:real^N) IN convex hull s`; `(x:real^N) IN convex hull s`] THEN REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N->real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `(c:real^N->real) = \x. (&1 - u) * a x + u * b x` THEN SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= c x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "c" THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `sum (s DIFF f:real^N->bool) c = &0` THENL [SUBGOAL_THEN `!x:real^N. x IN (s DIFF f) ==> c x = &0` MP_TAC THENL [MATCH_MP_TAC SUM_POS_EQ_0 THEN ASM_MESON_TAC[FINITE_DIFF; IN_DIFF]; ALL_TAC] THEN EXPAND_TAC "c" THEN ASM_SIMP_TAC[IN_DIFF; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LT; REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`; REAL_ENTIRE; REAL_SUB_0; REAL_LT_IMP_NE] THEN STRIP_TAC THEN CONJ_TAC THENL [EXISTS_TAC `a:real^N->real`; EXISTS_TAC `b:real^N->real`] THEN ASM_SIMP_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th g -> (GEN_REWRITE_TAC RAND_CONV [GSYM th] THEN CONV_TAC SYM_CONV THEN (MATCH_MP_TAC SUM_SUPERSET ORELSE MATCH_MP_TAC VSUM_SUPERSET)) g) THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO]; ALL_TAC] THEN ABBREV_TAC `k = sum (s DIFF f:real^N->bool) c` THEN SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE] THEN EXPAND_TAC "k" THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_DIFF; IN_DIFF]; ALL_TAC] THEN ASM_CASES_TAC `k = &1` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DISJOINT]) THEN MATCH_MP_TAC(TAUT `b ==> ~b ==> c`) THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN EXISTS_TAC `c:real^N->real` THEN ASM_SIMP_TAC[IN_DIFF; SUM_DIFF; VSUM_DIFF] THEN SUBGOAL_THEN `vsum f (\x:real^N. c x % x) = vec 0` SUBST1_TAC THENL [ALL_TAC; EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN ASM_SIMP_TAC[VSUM_ADD; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN REWRITE_TAC[VECTOR_SUB_RZERO]] THEN SUBGOAL_THEN `sum(s DIFF f) c = sum s c - sum f (c:real^N->real)` MP_TAC THENL [ASM_MESON_TAC[SUM_DIFF]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `sum s (c:real^N->real) = &1` SUBST1_TAC THENL [EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN ASM_SIMP_TAC[SUM_ADD; GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&1 = &1 - x <=> x = &0`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`c:real^N->real`;`f:real^N->bool`] SUM_POS_EQ_0) THEN ANTS_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; SUBSET]; ALL_TAC] THEN SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DISJOINT]) THEN MATCH_MP_TAC(TAUT `b ==> ~b ==> c`) THEN EXISTS_TAC `inv(k) % (w - vsum f (\x:real^N. c x % x))` THEN CONJ_TAC THENL [ALL_TAC; SUBGOAL_THEN `w = vsum f (\x:real^N. c x % x) + vsum (s DIFF f) (\x:real^N. c x % x)` SUBST1_TAC THENL [ASM_SIMP_TAC[VSUM_DIFF; VECTOR_ARITH `a + b - a:real^N = b`] THEN EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN ASM_SIMP_TAC[VSUM_ADD; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL]; REWRITE_TAC[VECTOR_ADD_SUB]] THEN ASM_SIMP_TAC[GSYM VSUM_LMUL; FINITE_DIFF] THEN REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN EXISTS_TAC `\x. inv k * (c:real^N->real) x` THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[IN_DIFF; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[SUM_LMUL; ETA_AX; REAL_MUL_LINV]] THEN MATCH_MP_TAC lemma THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[AFFINE_AFFINE_HULL]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM VSUM_LMUL; AFFINE_HULL_FINITE; IN_ELIM_THM] THEN EXISTS_TAC `(\x. inv(&1 - k) * c x):real^N->real` THEN REWRITE_TAC[VECTOR_MUL_ASSOC; SUM_LMUL] THEN MATCH_MP_TAC(REAL_FIELD `~(k = &1) /\ f = &1 - k ==> inv(&1 - k) * f = &1`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `sum(s DIFF f) c = sum s c - sum f (c:real^N->real)` MP_TAC THENL [ASM_MESON_TAC[SUM_DIFF]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `sum s (c:real^N->real) = &1` SUBST1_TAC THENL [EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN ASM_SIMP_TAC[SUM_ADD; GSYM REAL_MUL_ASSOC; SUM_LMUL]; ALL_TAC] THEN REAL_ARITH_TAC);; let FACE_OF_CONVEX_HULL_INSERT = prove (`!f s a:real^N. FINITE s /\ ~(a IN affine hull s) /\ f face_of (convex hull s) ==> f face_of (convex hull (a INSERT s))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_TRANS THEN EXISTS_TAC `convex hull s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN ASM_REWRITE_TAC[FINITE_INSERT; SET_RULE `s SUBSET a INSERT s`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(a IN s) ==> t SUBSET {a} ==> DISJOINT s t`)) THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_SING] THEN SET_TAC[]);; let FACE_OF_AFFINE_TRIVIAL = prove (`!s f:real^N->bool. affine s /\ f face_of s ==> f = {} \/ f = s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `f:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `(b:real^N) IN f` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [face_of]) THEN DISCH_THEN(MP_TAC o SPECL [`&2 % a - b:real^N`; `b:real^N`; `a:real^N`] o CONJUNCT2 o CONJUNCT2) THEN SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[IN_SEGMENT; VECTOR_ARITH `&2 % a - b:real^N = b <=> a = b`] THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `&2 % a - b:real^N = a + &1 % (a - b)`] THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM SET_TAC[]; EXISTS_TAC `&1 / &2` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC]);; let FACE_OF_AFFINE_EQ = prove (`!s:real^N->bool f. affine s ==> (f face_of s <=> f = {} \/ f = s)`, MESON_TAC[FACE_OF_AFFINE_TRIVIAL; EMPTY_FACE_OF; FACE_OF_REFL; AFFINE_IMP_CONVEX]);; let INTERS_FACES_FINITE_BOUND = prove (`!s f:(real^N->bool)->bool. convex s /\ (!c. c IN f ==> c face_of s) ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 /\ INTERS f' = INTERS f`, SUBGOAL_THEN `!s f:(real^N->bool)->bool. convex s /\ (!c. c IN f ==> c face_of s /\ ~(c = s)) ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 /\ INTERS f' = INTERS f` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN ASM_CASES_TAC `(s:real^N->bool) IN f` THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]] THEN FIRST_ASSUM(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC o MATCH_MP (SET_RULE `s IN f ==> f = {s} \/ ?t. ~(t = s) /\ t IN f`)) THENL [EXISTS_TAC `{s:real^N->bool}` THEN SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; SUBSET_REFL; CARD_CLAUSES] THEN ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC)] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `f DELETE (s:real^N->bool)`]) THEN ASM_SIMP_TAC[IN_DELETE; SUBSET_DELETE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `f = (s:real^N->bool) INSERT (f DELETE s)` MP_TAC THENL [ASM SET_TAC[]; DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [th])] THEN REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s INTER t`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_INTERS; IN_DELETE] THEN ASM SET_TAC[]] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `!f':(real^N->bool)->bool. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 ==> ?c. c IN f /\ c INTER (INTERS f') PSUBSET (INTERS f')` THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[PSUBSET; INTER_SUBSET] THEN ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_EXISTS_THM]) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:((real^N->bool)->bool)->real^N->bool` THEN DISCH_TAC THEN CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION `d 0 = {c {} :real^N->bool} /\ !n. d(SUC n) = c(d n) INSERT d n`) THEN SUBGOAL_THEN `!n:num. ~(d n:(real^N->bool)->bool = {})` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. n <= dimindex(:N) + 1 ==> (d n) SUBSET (f:(real^N->bool)->bool) /\ FINITE(d n) /\ CARD(d n) <= n + 1` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; EMPTY_SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`] THEN REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!n. n <= dimindex(:N) ==> (INTERS(d(SUC n)):real^N->bool) PSUBSET INTERS(d n)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERS_INSERT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN ASM_SIMP_TAC[ARITH_RULE `n <= N ==> n <= N + 1`] THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(CONJUNCTS_THEN(K ALL_TAC)) THEN SUBGOAL_THEN `!n. n <= dimindex(:N) + 1 ==> aff_dim(INTERS(d n):real^N->bool) < &(dimindex(:N)) - &n` MP_TAC THENL [INDUCT_TAC THENL [DISCH_TAC THEN REWRITE_TAC[INT_SUB_RZERO] THEN MATCH_MP_TAC INT_LTE_TRANS THEN EXISTS_TAC `aff_dim(s:real^N->bool)` THEN REWRITE_TAC[AFF_DIM_LE_UNIV] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY] o SPEC `0`) THEN DISCH_THEN(X_CHOOSE_TAC `e:real^N->bool`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN MATCH_MP_TAC(SET_RULE `!t. t PSUBSET s /\ u SUBSET t ==> ~(u = s)`) THEN EXISTS_TAC `e:real^N->bool` THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM SET_TAC[]]; DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN MATCH_MP_TAC(INT_ARITH `!d':int. d < d' /\ d' < m - n ==> d < m - (n + &1)`) THEN EXISTS_TAC `aff_dim(INTERS(d(n:num)):real^N->bool)` THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= k + 1 ==> n <= k + 1`] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= m + 1 ==> n <= m`; SET_RULE `s PSUBSET t ==> ~(s = t)`] THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_INTERS THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_IMP_CONVEX THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`]; ALL_TAC] THEN MP_TAC(ISPECL [`INTERS(d(SUC n)):real^N->bool`;`s:real^N->bool`; `INTERS(d(n:num)):real^N->bool`] FACE_OF_FACE) THEN ASM_SIMP_TAC[SET_RULE `s PSUBSET t ==> s SUBSET t`; ARITH_RULE `SUC n <= m + 1 ==> n <= m`] THEN MATCH_MP_TAC(TAUT `a /\ b ==> (a ==> (c <=> b)) ==> c`) THEN CONJ_TAC THEN MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`]]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[INT_NOT_LT] THEN REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH `d - (d + &1):int = -- &1`] THEN REWRITE_TAC[AFF_DIM_GE]);; let INTERS_FACES_FINITE_ALTBOUND = prove (`!s f:(real^N->bool)->bool. (!c. c IN f ==> c face_of s) ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 2 /\ INTERS f' = INTERS f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!f':(real^N->bool)->bool. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 2 ==> ?c. c IN f /\ c INTER (INTERS f') PSUBSET (INTERS f')` THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[PSUBSET; INTER_SUBSET] THEN ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_EXISTS_THM]) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:((real^N->bool)->bool)->real^N->bool` THEN DISCH_TAC THEN CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION `d 0 = {c {} :real^N->bool} /\ !n. d(SUC n) = c(d n) INSERT d n`) THEN SUBGOAL_THEN `!n:num. ~(d n:(real^N->bool)->bool = {})` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. n <= dimindex(:N) + 2 ==> (d n) SUBSET (f:(real^N->bool)->bool) /\ FINITE(d n) /\ CARD(d n) <= n + 1` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; EMPTY_SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`] THEN REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!n. n <= dimindex(:N) + 1 ==> (INTERS(d(SUC n)):real^N->bool) PSUBSET INTERS(d n)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERS_INSERT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN ASM_SIMP_TAC[ARITH_RULE `n <= N + 1 ==> n <= N + 2`] THEN ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(CONJUNCTS_THEN(K ALL_TAC)) THEN SUBGOAL_THEN `!n. n <= dimindex(:N) + 2 ==> aff_dim(INTERS(d n):real^N->bool) <= &(dimindex(:N)) - &n` MP_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[INT_SUB_RZERO; AFF_DIM_LE_UNIV] THEN DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN MATCH_MP_TAC(INT_ARITH `!d':int. d < d' /\ d' <= m - n ==> d <= m - (n + &1)`) THEN EXISTS_TAC `aff_dim(INTERS(d(n:num)):real^N->bool)` THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= k + 2 ==> n <= k + 2`] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_SIMP_TAC[ARITH_RULE `SUC n <= m + 2 ==> n <= m + 1`; SET_RULE `s PSUBSET t ==> ~(s = t)`] THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_INTERS THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_IMP_CONVEX THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`]; ALL_TAC] THEN MP_TAC(ISPECL [`INTERS(d(SUC n)):real^N->bool`;`s:real^N->bool`; `INTERS(d(n:num)):real^N->bool`] FACE_OF_FACE) THEN ASM_SIMP_TAC[SET_RULE `s PSUBSET t ==> s SUBSET t`; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 1`] THEN MATCH_MP_TAC(TAUT `a /\ b ==> (a ==> (c <=> b)) ==> c`) THEN CONJ_TAC THEN MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 2`) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[INT_NOT_LE] THEN REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH `d - (d + &2):int < i <=> -- &1 <= i`] THEN REWRITE_TAC[AFF_DIM_GE]);; let FACES_OF_TRANSLATION = prove (`!s a:real^N. {f | f face_of IMAGE (\x. a + x) s} = IMAGE (IMAGE (\x. a + x)) {f | f face_of s}`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; FACE_OF_TRANSLATION_EQ] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN ONCE_REWRITE_TAC[TRANSLATION_GALOIS] THEN REWRITE_TAC[EXISTS_REFL]);; let FACES_OF_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> {t | t face_of (IMAGE f s)} = IMAGE (IMAGE f) {t | t face_of s}`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[face_of; SUBSET_IMAGE; SET_RULE `{y | (?x. P x /\ y = f x) /\ Q y} = {f x |x| P x /\ Q(f x)}`] THEN REWRITE_TAC[SET_RULE `IMAGE f {x | P x} = {f x | P x}`] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONVEX_LINEAR_IMAGE_EQ th; MATCH_MP OPEN_SEGMENT_LINEAR_IMAGE th; MATCH_MP (SET_RULE `(!x y. f x = f y ==> x = y) ==> (!s x. f x IN IMAGE f s <=> x IN s)`) (CONJUNCT2 th)]));; let FACE_OF_CONIC = prove (`!s f:real^N->bool. conic s /\ f face_of s ==> conic f`, REPEAT GEN_TAC THEN REWRITE_TAC[face_of; conic] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_MESON_TAC[VECTOR_MUL_RZERO]; ALL_TAC] THEN ASM_CASES_TAC `c = &1` THENL [ASM_MESON_TAC[VECTOR_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `?d e. &0 <= d /\ &0 <= e /\ d < &1 /\ &1 < e /\ d < e /\ (d = c \/ e = c)` MP_TAC THENL [FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(c = &1) ==> c < &1 \/ &1 < c`)) THENL [MAP_EVERY EXISTS_TAC [`c:real`; `&2`] THEN ASM_REAL_ARITH_TAC; MAP_EVERY EXISTS_TAC [`&1 / &2`; `c:real`] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(REPEAT_TCL CHOOSE_THEN (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`d % x :real^N`; `e % x:real^N`; `x:real^N`]) THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[IN_SEGMENT]] THEN ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; REAL_LT_IMP_NE] THEN EXISTS_TAC `(&1 - d) / (e - d)` THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = a % x <=> (a - &1) % x = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN UNDISCH_TAC `d:real < e` THEN CONV_TAC REAL_FIELD]);; let FACE_OF_PCROSS = prove (`!f s:real^M->bool f' s':real^N->bool. f face_of s /\ f' face_of s' ==> (f PCROSS f') face_of (s PCROSS s')`, REPEAT GEN_TAC THEN SIMP_TAC[face_of; CONVEX_PCROSS; PCROSS_MONO] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_SEGMENT; FORALL_IN_PCROSS] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[GSYM PASTECART_CMUL; PASTECART_ADD; PASTECART_INJ] THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `a':real^N`; `b:real^M`; `b':real^N`] THEN MAP_EVERY ASM_CASES_TAC [`b:real^M = a`; `b':real^N = a'`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN ASM_MESON_TAC[]);; let FACE_OF_PCROSS_DECOMP = prove (`!s:real^M->bool s':real^N->bool c. c face_of (s PCROSS s') <=> ?f f'. f face_of s /\ f' face_of s' /\ c = f PCROSS f'`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[FACE_OF_PCROSS]] THEN ASM_CASES_TAC `c:real^(M,N)finite_sum->bool = {}` THENL [ASM_MESON_TAC[EMPTY_FACE_OF; PCROSS_EMPTY]; DISCH_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN MAP_EVERY EXISTS_TAC [`IMAGE fstcart (c:real^(M,N)finite_sum->bool)`; `IMAGE sndcart (c:real^(M,N)finite_sum->bool)`] THEN MATCH_MP_TAC(TAUT `(p /\ q ==> r) /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL [STRIP_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `(s:real^M->bool) PCROSS (s':real^N->bool)` THEN ASM_SIMP_TAC[FACE_OF_PCROSS; RELATIVE_INTERIOR_PCROSS] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; LINEAR_FSTCART; LINEAR_SNDCART] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET t ==> ~DISJOINT s t`) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_IMAGE] THEN REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN REWRITE_TAC[face_of] THEN ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o MATCH_MP IMAGE_SUBSET) THEN FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN REPEAT(DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE `s SUBSET (if p then {} else t) ==> s SUBSET t`))) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`pastecart (a:real^M) (y:real^N)`; `pastecart (b:real^M) (y:real^N)`; `pastecart (x:real^M) (y:real^N)`]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_IMAGE; EXISTS_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN UNDISCH_TAC `(c:real^(M,N)finite_sum->bool) SUBSET s PCROSS s'` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `pastecart (x:real^M) (y:real^N)`); MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN REWRITE_TAC[EXISTS_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`pastecart (y:real^M) (a:real^N)`; `pastecart (y:real^M) (b:real^N)`; `pastecart (y:real^M) (x:real^N)`]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_IMAGE; EXISTS_PASTECART] THEN REWRITE_TAC[SNDCART_PASTECART; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN UNDISCH_TAC `(c:real^(M,N)finite_sum->bool) SUBSET s PCROSS s'` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `pastecart (y:real^M) (x:real^N)`)] THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN REWRITE_TAC[IN_SEGMENT; PASTECART_INJ] THEN REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN MESON_TAC[]);; let FACE_OF_PCROSS_EQ = prove (`!f s:real^M->bool f' s':real^N->bool. (f PCROSS f') face_of (s PCROSS s') <=> f = {} \/ f' = {} \/ f face_of s /\ f' face_of s'`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`f:real^M->bool = {}`; `f':real^N->bool = {}`] THEN ASM_REWRITE_TAC[PCROSS_EMPTY; EMPTY_FACE_OF] THEN ASM_REWRITE_TAC[FACE_OF_PCROSS_DECOMP; PCROSS_EQ] THEN MESON_TAC[]);; let HYPERPLANE_FACE_OF_HALFSPACE_LE = prove (`!a:real^N b. {x | a dot x = b} face_of {x | a dot x <= b}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a:real = b <=> a <= b /\ a = b`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_LE]);; let HYPERPLANE_FACE_OF_HALFSPACE_GE = prove (`!a:real^N b. {x | a dot x = b} face_of {x | a dot x >= b}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a:real = b <=> a >= b /\ a = b`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_GE]);; let FACE_OF_HALFSPACE_LE = prove (`!f a:real^N b. f face_of {x | a dot x <= b} <=> f = {} \/ f = {x | a dot x = b} \/ f = {x | a dot x <= b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[FACE_OF_EMPTY]) THEN ASM_SIMP_TAC[FACE_OF_AFFINE_EQ; AFFINE_UNIV; DISJ_ACI] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[EMPTY_FACE_OF; FACE_OF_REFL; CONVEX_HALFSPACE_LE; HYPERPLANE_FACE_OF_HALFSPACE_LE] THEN MATCH_MP_TAC(TAUT `(~r ==> p \/ q) ==> p \/ q \/ r`) THEN DISCH_TAC THEN SUBGOAL_THEN `f face_of {x:real^N | a dot x = b}` MP_TAC THENL [ASM_SIMP_TAC[GSYM FRONTIER_HALFSPACE_LE] THEN ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL RELATIVE_FRONTIER_NONEMPTY_INTERIOR); INTERIOR_HALFSPACE_LE; HALFSPACE_EQ_EMPTY_LT] THEN MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `{x:real^N | a dot x <= b}` THEN ASM_SIMP_TAC[FACE_OF_SUBSET_RELATIVE_FRONTIER] THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED; CLOSED_HALFSPACE_LE] THEN SET_TAC[]; ASM_SIMP_TAC[FACE_OF_AFFINE_EQ; AFFINE_HYPERPLANE]]);; let FACE_OF_HALFSPACE_GE = prove (`!f a:real^N b. f face_of {x | a dot x >= b} <=> f = {} \/ f = {x | a dot x = b} \/ f = {x | a dot x >= b}`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real^N->bool`; `--a:real^N`; `--b:real`] FACE_OF_HALFSPACE_LE) THEN REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);; let RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE = prove (`!s x:real^N. convex s /\ x IN s /\ ~(x IN relative_interior s) ==> ?f. f face_of s /\ ~(f = s) /\ x IN f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER) THEN ASM_SIMP_TAC[relative_frontier; IN_DIFF; REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s INTER {y:real^N | a dot y = a dot x}` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET; real_ge]; SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `(!x. x IN i ==> x IN s /\ ~(x IN t)) ==> ~(i = {}) ==> ~(t = s)`) THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[IN_INTER; REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NE]]]);; let RELATIVE_FRONTIER_OF_CONVEX_CLOSED = prove (`!s:real^N->bool. convex s /\ closed s ==> relative_frontier s = UNIONS {f | f face_of s /\ ~(f = s)}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN ASM_SIMP_TAC[relative_frontier; UNIONS_GSPEC; IN_ELIM_THM; CLOSURE_CLOSED; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [ASM_MESON_TAC[RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE]; ALL_TAC] THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_SUBSET_RELATIVE_BOUNDARY) THEN ASM SET_TAC[]);; let IN_RELATIVE_INTERIOR_OF_FACE = prove (`!s:real^N->bool x. convex s /\ x IN s ==> ?f. f face_of s /\ x IN relative_interior f`, REPEAT STRIP_TAC THEN EXISTS_TAC `INTERS {f | f face_of s /\ (x:real^N) IN f}` THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_INTERS THEN SIMP_TAC[FORALL_IN_GSPEC; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_REFL]; DISCH_TAC] THEN MATCH_MP_TAC(SET_RULE `x IN s /\ ~(x IN s /\ ~(x IN relative_interior s)) ==> x IN relative_interior s`) THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_CONVEX]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(s = t) ==> s SUBSET t /\ t SUBSET s ==> F`)) THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN MATCH_MP_TAC(SET_RULE `f IN t ==> INTERS t SUBSET f`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_TRANS]);; let CONVEX_FACIAL_PARTITION = prove (`!s:real^N->bool. convex s ==> UNIONS {relative_interior f | f face_of s} = s`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[IN_RELATIVE_INTERIOR_OF_FACE; FACE_OF_IMP_SUBSET; SUBSET; RELATIVE_INTERIOR_SUBSET]);; let IN_RELATIVE_INTERIOR_OF_UNIQUE_FACE = prove (`!s:real^N->bool x. convex s /\ x IN s ==> ?!f. f face_of s /\ x IN relative_interior f`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN ASM_SIMP_TAC[IN_RELATIVE_INTERIOR_OF_FACE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]);; let RELATIVE_INTERIOR_SUBSET_OF_PROPER_FACE = prove (`!s t:real^N->bool. convex s /\ t SUBSET s /\ ~(relative_interior t DIFF relative_interior s = {}) ==> ?f. f face_of s /\ ~(f = s) /\ t SUBSET f`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_INTER; IN_DIFF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] RELATIVE_BOUNDARY_POINT_IN_PROPER_FACE) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]);; let CONVEX_RELATIVE_BOUNDARY_SUBSET_OF_PROPER_FACE = prove (`!s t:real^N->bool. convex s /\ ~(s = {}) /\ convex t /\ t SUBSET s DIFF relative_interior s ==> ?f. f face_of s /\ ~(f = s) /\ t SUBSET f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[EMPTY_FACE_OF; SUBSET_REFL]; MATCH_MP_TAC RELATIVE_INTERIOR_SUBSET_OF_PROPER_FACE THEN MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]]);; let RELATIVE_FRONTIER_FACIAL_PARTITION_ALT = prove (`!s:real^N->bool. convex s /\ closed s ==> UNIONS { relative_interior f | f face_of s /\ ~(f = s)} = relative_frontier s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM(MATCH_MP CONVEX_FACIAL_PARTITION th)]) THEN MATCH_MP_TAC(SET_RULE `u UNION s = t /\ DISJOINT u s ==> s = t DIFF u`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[FACE_OF_REFL; GSYM UNIONS_INSERT; SET_RULE `P a ==> f a INSERT {f x | P x /\ ~(x = a)} = {f x | P x}`]; REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[GSYM DISJOINT] THEN ASM_MESON_TAC[FACE_OF_EQ; FACE_OF_REFL]]);; let RELATIVE_FRONTIER_FACIAL_PARTITION = prove (`!s:real^N->bool. convex s /\ closed s ==> UNIONS { relative_interior f | f face_of s /\ aff_dim f < aff_dim s} = relative_frontier s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_FACIAL_PARTITION_ALT] THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> (Q x <=> R x)) ==> {f x | P x /\ Q x} = {f x | P x /\ R x}`) THEN ASM_MESON_TAC[FACE_OF_AFF_DIM_LT; INT_LT_REFL; FACE_OF_REFL]);; let FRONTIER_OF_CONVEX_CLOSED = prove (`!s:real^N->bool. convex s /\ closed s ==> frontier s = UNIONS {f | f face_of s /\ aff_dim f < &(dimindex(:N))}`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[FACE_OF_SUBSET_FRONTIER_AFF_DIM]] THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SYM(MATCH_MP CONVEX_FACIAL_PARTITION th)]) THEN REWRITE_TAC[UNIONS_GSPEC; SUBSET; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC) ASSUME_TAC) THEN EXISTS_TAC `f:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]] THEN REWRITE_TAC[INT_LT_LE; AFF_DIM_LE_UNIV] THEN DISCH_TAC THEN MP_TAC(ISPEC `f:real^N->bool` RELATIVE_INTERIOR_INTERIOR) THEN ASM_REWRITE_TAC[GSYM AFF_DIM_EQ_FULL] THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(ISPECL [`f:real^N->bool`; `s:real^N->bool`] SUBSET_INTERIOR) THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN ASM SET_TAC[]);; let FACE_OF_INTER_AS_INTER_OF_FACE = prove (`!s t f:real^N->bool. convex s /\ convex t /\ f face_of (s INTER t) ==> ?k l. k face_of s /\ l face_of t /\ k INTER l = f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `relative_interior f:real^N->bool = {}` THENL [REPEAT(EXISTS_TAC `{}:real^N->bool`) THEN REWRITE_TAC[EMPTY_FACE_OF] THEN MP_TAC(ISPEC `f:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN REWRITE_TAC[INTER_EMPTY] THEN ASM_MESON_TAC[face_of]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN MAP_EVERY (MP_TAC o C SPEC CONVEX_FACIAL_PARTITION) [`t:real^N->bool`; `s:real^N->bool`] THEN ASM_REWRITE_TAC[EXTENSION; IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[UNIONS_GSPEC] THEN SUBGOAL_THEN `(x:real^N) IN s /\ x IN t` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN MP_TAC(ISPEC `f:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; ASM_REWRITE_TAC[IN_ELIM_THM]] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM EXTENSION] THEN MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s INTER t:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_INTER_INTER] THEN MP_TAC(ISPECL [`k:real^N->bool`; `l:real^N->bool`] INTER_RELATIVE_INTERIOR_SUBSET) THEN ANTS_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_CONVEX]; ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Exposed faces (faces that are intersection with supporting hyperplane). *) (* ------------------------------------------------------------------------- *) parse_as_infix("exposed_face_of",(12,"right"));; let exposed_face_of = new_definition `t exposed_face_of s <=> t face_of s /\ ?a b. s SUBSET {x | a dot x <= b} /\ t = s INTER {x | a dot x = b}`;; let EXPOSED_FACE_OF_IMP_FACE_OF = prove (`!s t:real^N->bool. t exposed_face_of s ==> t face_of s`, SIMP_TAC[exposed_face_of]);; let EMPTY_EXPOSED_FACE_OF = prove (`!s:real^N->bool. {} exposed_face_of s`, GEN_TAC THEN REWRITE_TAC[exposed_face_of; EMPTY_FACE_OF] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1:real`] THEN REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SET_TAC[]);; let EXPOSED_FACE_OF_REFL_EQ = prove (`!s:real^N->bool. s exposed_face_of s <=> convex s`, GEN_TAC THEN REWRITE_TAC[exposed_face_of; FACE_OF_REFL_EQ] THEN ASM_CASES_TAC `convex(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&0:real`] THEN REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SET_TAC[]);; let EXPOSED_FACE_OF_REFL = prove (`!s:real^N->bool. convex s ==> s exposed_face_of s`, REWRITE_TAC[EXPOSED_FACE_OF_REFL_EQ]);; let EXPOSED_FACE_OF = prove (`!s t. t exposed_face_of s <=> t face_of s /\ (t = {} \/ t = s \/ ?a b. ~(a = vec 0) /\ s SUBSET {x:real^N | a dot x <= b} /\ t = s INTER {x | a dot x = b})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF; EMPTY_FACE_OF] THEN ASM_CASES_TAC `t:real^N->bool = s` THEN ASM_REWRITE_TAC[EXPOSED_FACE_OF_REFL_EQ; FACE_OF_REFL_EQ] THEN REWRITE_TAC[exposed_face_of] THEN AP_TERM_TAC THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; MESON_TAC[]] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[DOT_LZERO] THEN SET_TAC[]);; let EXPOSED_FACE_OF_TRANSLATION_EQ = prove (`!a f s:real^N->bool. (IMAGE (\x. a + x) f) exposed_face_of (IMAGE (\x. a + x) s) <=> f exposed_face_of s`, REPEAT GEN_TAC THEN REWRITE_TAC[exposed_face_of; FACE_OF_TRANSLATION_EQ] THEN MP_TAC(ISPEC `\x:real^N. a + x` QUANTIFY_SURJECTION_THM) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [MESON_TAC[VECTOR_ARITH `y + (x - y):real^N = x`]; ALL_TAC] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [last(CONJUNCTS th)]) THEN REWRITE_TAC[end_itlist CONJ (!invariant_under_translation)] THEN REWRITE_TAC[DOT_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_LE_SUB_LADD; GSYM REAL_EQ_SUB_LADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `c:real^N` THEN REWRITE_TAC[] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `b - (c:real^N) dot a`; EXISTS_TAC `b + (c:real^N) dot a`] THEN ASM_REWRITE_TAC[REAL_ARITH `(x + y) - y:real = x`]);; add_translation_invariants [EXPOSED_FACE_OF_TRANSLATION_EQ];; let EXPOSED_FACE_OF_LINEAR_IMAGE = prove (`!f:real^M->real^N c s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> ((IMAGE f c) exposed_face_of (IMAGE f s) <=> c exposed_face_of s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[exposed_face_of] THEN BINOP_TAC THENL [ASM_MESON_TAC[FACE_OF_LINEAR_IMAGE]; ALL_TAC] THEN MP_TAC(ISPEC `f:real^M->real^N` QUANTIFY_SURJECTION_THM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [last(CONJUNCTS th)]) THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_SIMP_TAC[ADJOINT_WORKS] THEN MP_TAC(end_itlist CONJ (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `adjoint(f:real^M->real^N) a` THEN ASM_REWRITE_TAC[]; DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `adjoint(f:real^M->real^N)` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN ASM_SIMP_TAC[ADJOINT_SURJECTIVE; ADJOINT_LINEAR] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN EXISTS_TAC `(g:real^M->real^N) a` THEN ASM_REWRITE_TAC[]]);; let EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove (`!s a:real^N b. convex s /\ (!x. x IN s ==> a dot x <= b) ==> (s INTER {x | a dot x = b}) exposed_face_of s`, SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; exposed_face_of] THEN SET_TAC[]);; let EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove (`!s a:real^N b. convex s /\ (!x. x IN s ==> a dot x >= b) ==> (s INTER {x | a dot x = b}) exposed_face_of s`, REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`] EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE) THEN ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);; let EXPOSED_FACE_OF_INTER = prove (`!s t u:real^N->bool. t exposed_face_of s /\ u exposed_face_of s ==> (t INTER u) exposed_face_of s`, REPEAT GEN_TAC THEN SIMP_TAC[exposed_face_of; FACE_OF_INTER] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a':real^N`; `b':real`; `a:real^N`; `b:real`] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`a + a':real^N`; `b + b':real`] THEN REWRITE_TAC[SET_RULE `(s INTER t1) INTER (s INTER t2) = s INTER u <=> !x. x IN s ==> (x IN t1 /\ x IN t2 <=> x IN u)`] THEN ASM_SIMP_TAC[DOT_LADD; REAL_LE_ADD2; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let EXPOSED_FACE_OF_INTERS = prove (`!P s:real^N->bool. ~(P = {}) /\ (!t. t IN P ==> t exposed_face_of s) ==> INTERS P exposed_face_of s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `P:(real^N->bool)->bool`] INTERS_FACES_FINITE_ALTBOUND) THEN ANTS_TAC THENL [ASM_MESON_TAC[exposed_face_of]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `Q:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN ASM_CASES_TAC `Q:(real^N->bool)->bool = {}` THENL [ASM_SIMP_TAC[INTERS_0] THEN REWRITE_TAC[SET_RULE `INTERS s = UNIV <=> !t. t IN s ==> t = UNIV`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN SUBGOAL_THEN `!t:real^N->bool. t IN Q ==> t exposed_face_of s` MP_TAC THENL [ASM SET_TAC[]; UNDISCH_TAC `FINITE(Q:(real^N->bool)->bool)`] THEN SPEC_TAC(`Q:(real^N->bool)->bool`,`Q:(real^N->bool)->bool`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `P:(real^N->bool)->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INTERS_INSERT] THEN ASM_CASES_TAC `P:(real^N->bool)->bool = {}` THEN ASM_SIMP_TAC[INTERS_0; INTER_UNIV; EXPOSED_FACE_OF_INTER]]);; let EXPOSED_FACE_OF_SUMS = prove (`!s t f:real^N->bool. convex s /\ convex t /\ f exposed_face_of {x + y | x IN s /\ y IN t} ==> ?k l. k exposed_face_of s /\ l exposed_face_of t /\ f = {x + y | x IN k /\ y IN l}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXPOSED_FACE_OF]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `f:real^N->bool = {}` THENL [DISCH_TAC THEN REPEAT (EXISTS_TAC `{}:real^N->bool`) THEN ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF] THEN SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `f = {x + y :real^N | x IN s /\ y IN t}` THENL [DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN ASM_SIMP_TAC[EXPOSED_FACE_OF_REFL]; ALL_TAC] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `z:real`] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM SUBSET_INTER_ABSORPTION]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[EXISTS_IN_GSPEC; IN_INTER] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a0:real^N`; `b0:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN EXISTS_TAC `s INTER {x:real^N | u dot x = u dot a0}` THEN EXISTS_TAC `t INTER {y:real^N | u dot y = u dot b0}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b0:real^N`]) THEN ASM_REWRITE_TAC[DOT_RADD] THEN REAL_ARITH_TAC; MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a0:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[DOT_RADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; IMP_CONJ] THENL [ALL_TAC; SIMP_TAC[IN_INTER; IN_ELIM_THM; DOT_RADD] THEN MESON_TAC[]] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; DOT_RADD] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPECL [`a:real^N`; `b0:real^N`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a0:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[DOT_RADD] THEN ASM_REAL_ARITH_TAC);; let EXPOSED_FACE_OF_PARALLEL = prove (`!t s. t exposed_face_of s <=> t face_of s /\ ?a b. s SUBSET {x:real^N | a dot x <= b} /\ t = s INTER {x | a dot x = b} /\ (~(t = {}) /\ ~(t = s) ==> ~(a = vec 0)) /\ (!w. w IN affine hull s /\ ~(t = s) ==> (w + a) IN affine hull s)`, REPEAT GEN_TAC THEN REWRITE_TAC[exposed_face_of] THEN AP_TERM_TAC THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[]] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`affine hull s:real^N->bool`; `--a:real^N`; `--b:real`] AFFINE_PARALLEL_SLICE) THEN SIMP_TAC[AFFINE_AFFINE_HULL; DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL [MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN REWRITE_TAC[DOT_LZERO; REAL_POS; SET_RULE `{x | T} = UNIV`] THEN SIMP_TAC[SUBSET_UNIV; VECTOR_ADD_RID; REAL_ARITH `~(&0 = &1)`] THEN REWRITE_TAC[EMPTY_GSPEC] THEN ASM_REWRITE_TAC[INTER_EMPTY] THEN MATCH_MP_TAC(TAUT `p ==> p /\ ~(~p /\ q)`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s' INTER t' = {} ==> s SUBSET s' /\ t SUBSET t' ==> s INTER t = {}`)) THEN REWRITE_TAC[HULL_SUBSET] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL]; SUBGOAL_THEN `t:real^N->bool = s` SUBST1_TAC THENL [FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN SUBGOAL_THEN `s SUBSET affine hull (s:real^N->bool)` MP_TAC THENL [REWRITE_TAC[HULL_SUBSET]; ASM SET_TAC[]]; MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&0`] THEN REWRITE_TAC[DOT_LZERO; SET_RULE `{x | T} = UNIV`; REAL_LE_REFL] THEN SET_TAC[]]; FIRST_X_ASSUM(X_CHOOSE_THEN `a':real^N` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b':real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`--a':real^N`; `--b':real`] THEN ASM_REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[REAL_ARITH `b <= a <=> ~(a <= b) \/ a = b`] THEN MATCH_MP_TAC(SET_RULE `!s'. s SUBSET s' /\ s SUBSET (UNIV DIFF (s' INTER {x | P x})) UNION (s' INTER {x | Q x}) ==> s SUBSET {x | ~P x \/ Q x}`) THEN EXISTS_TAC `affine hull s:real^N->bool` THEN ASM_REWRITE_TAC[HULL_SUBSET] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ s SUBSET (UNIV DIFF {x | P x}) UNION {x | Q x} ==> s SUBSET (UNIV DIFF (s' INTER {x | P x})) UNION (s' INTER {x | Q x})`) THEN REWRITE_TAC[HULL_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `{x:real^N | a dot x <= b}` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s' INTER a = s' INTER b ==> s SUBSET s' ==> s INTER b = s INTER a`)) THEN REWRITE_TAC[HULL_SUBSET]; ASM_REWRITE_TAC[VECTOR_NEG_EQ_0]; ONCE_REWRITE_TAC[VECTOR_ARITH `w + --a:real^N = w + &1 % (w - (w + a))`] THEN ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL]]]);; let RELATIVE_BOUNDARY_POINT_IN_EXPOSED_FACE = prove (`!s x:real^N. convex s /\ x IN s /\ ~(x IN relative_interior s) ==> ?f. f exposed_face_of s /\ ~(f = s) /\ x IN f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s INTER {y:real^N | a dot y = a dot x}` THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN CONJ_TAC THENL [MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN ASM_REWRITE_TAC[real_ge]; SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXTENSION; NOT_FORALL_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN SIMP_TAC[IN_INTER; REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NE]]);; (* ------------------------------------------------------------------------- *) (* Extreme points of a set, which are its singleton faces. *) (* ------------------------------------------------------------------------- *) parse_as_infix("extreme_point_of",(12,"right"));; let extreme_point_of = new_definition `x extreme_point_of s <=> x IN s /\ !a b. a IN s /\ b IN s ==> ~(x IN segment(a,b))`;; let EXTREME_POINT_RELATIVE_FRONTIER = prove (`!s x:real^N. convex s /\ x IN s DIFF relative_interior s /\ (!a b. {a,b} SUBSET s DIFF relative_interior s ==> ~(x IN segment(a,b))) ==> x extreme_point_of s`, REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[extreme_point_of] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_DIFF] THEN ASM_MESON_TAC[IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; SUBSET; CLOSURE_INC; SEGMENT_SYM]);; let EXTREME_POINT_OF_STILLCONVEX_IMP = prove (`!s x:real^N. x IN s /\ convex(s DELETE x) ==> x extreme_point_of s`, REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; extreme_point_of; open_segment] THEN REWRITE_TAC[IN_DIFF; IN_DELETE; IN_INSERT; NOT_IN_EMPTY; SUBSET_DELETE] THEN SET_TAC[]);; let EXTREME_POINTS_OF_STILLCONVEX = prove (`!s t:real^N->bool. convex s /\ t SUBSET {x | x extreme_point_of s} ==> convex(s DIFF t)`, REWRITE_TAC[extreme_point_of; open_segment; CONVEX_CONTAINS_SEGMENT] THEN SET_TAC[]);; let EXTREME_POINT_OF_STILLCONVEX = prove (`!s x:real^N. convex s ==> (x extreme_point_of s <=> x IN s /\ convex(s DELETE x))`, REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; extreme_point_of; open_segment] THEN REWRITE_TAC[IN_DIFF; IN_DELETE; IN_INSERT; NOT_IN_EMPTY; SUBSET_DELETE] THEN SET_TAC[]);; let FACE_OF_SING = prove (`!x s. {x} face_of s <=> x extreme_point_of s`, SIMP_TAC[face_of; extreme_point_of; SING_SUBSET; CONVEX_SING; IN_SING] THEN MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]);; let FACE_OF_AFF_DIM_0 = prove (`!s f:real^N->bool. f face_of s /\ aff_dim f = &0 <=> ?a. a extreme_point_of s /\ f = {a}`, REPEAT GEN_TAC THEN REWRITE_TAC[AFF_DIM_EQ_0] THEN MESON_TAC[FACE_OF_SING]);; let EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR = prove (`!s x:real^N. x extreme_point_of s /\ ~(s = {x}) ==> ~(x IN relative_interior s)`, REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN SET_TAC[]);; let EXTREME_POINT_NOT_IN_INTERIOR = prove (`!s x:real^N. x extreme_point_of s ==> ~(x IN interior s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s = {x:real^N}` THEN ASM_SIMP_TAC[EMPTY_INTERIOR_FINITE; FINITE_SING; NOT_IN_EMPTY] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR)) THEN ASM_SIMP_TAC[EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR]);; let EXTREME_POINT_IN_RELATIVE_FRONTIER = prove (`!s x:real^N. x extreme_point_of s /\ ~(s = {x}) ==> x IN relative_frontier s`, SIMP_TAC[EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR; relative_frontier; IN_DIFF] THEN SIMP_TAC[extreme_point_of; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);; let EXTREME_POINT_IN_FRONTIER = prove (`!s x:real^N. x extreme_point_of s ==> x IN frontier s`, SIMP_TAC[frontier; IN_DIFF; EXTREME_POINT_NOT_IN_INTERIOR] THEN SIMP_TAC[extreme_point_of; CLOSURE_INC]);; let EXTREME_POINT_OF_FACE = prove (`!f s v. f face_of s ==> (v extreme_point_of f <=> v extreme_point_of s /\ v IN f)`, REWRITE_TAC[GSYM FACE_OF_SING; GSYM SING_SUBSET; FACE_OF_FACE]);; let EXTREME_POINT_OF_MIDPOINT = prove (`!s x:real^N. convex s ==> (x extreme_point_of s <=> x IN s /\ !a b. a IN s /\ b IN s /\ x = midpoint(a,b) ==> x = a /\ x = b)`, REPEAT STRIP_TAC THEN REWRITE_TAC[extreme_point_of] THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_SIMP_TAC[MIDPOINT_IN_SEGMENT; MIDPOINT_REFL]; ALL_TAC] THEN REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC)) THEN ABBREV_TAC `d = min (&1 - u) u` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x - d / &2 % (b - a):real^N`; `x + d / &2 % (b - a):real^N`]) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN ASM_REWRITE_TAC[VECTOR_ARITH `((&1 - u) % a + u % b) - d / &2 % (b - a):real^N = (&1 - (u - d / &2)) % a + (u - d / &2) % b`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN ASM_REWRITE_TAC[VECTOR_ARITH `((&1 - u) % a + u % b) + d / &2 % (b - a):real^N = (&1 - (u + d / &2)) % a + (u + d / &2) % b`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC; REWRITE_TAC[VECTOR_ARITH `x:real^N = x - d <=> d = vec 0`; VECTOR_ARITH `x:real^N = x + d <=> d = vec 0`] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let EXTREME_POINT_OF_CONVEX_HULL = prove (`!x:real^N s. x extreme_point_of (convex hull s) ==> x IN s`, REPEAT GEN_TAC THEN SIMP_TAC[EXTREME_POINT_OF_STILLCONVEX; CONVEX_CONVEX_HULL] THEN MP_TAC(ISPECL [`convex:(real^N->bool)->bool`; `s:real^N->bool`; `(convex hull s) DELETE (x:real^N)`] HULL_MINIMAL) THEN MP_TAC(ISPECL [`convex:(real^N->bool)->bool`; `s:real^N->bool`] HULL_SUBSET) THEN ASM SET_TAC[]);; let EXTREME_POINTS_OF_CONVEX_HULL = prove (`!s. {x | x extreme_point_of (convex hull s)} SUBSET s`, REWRITE_TAC[SUBSET; IN_ELIM_THM; EXTREME_POINT_OF_CONVEX_HULL]);; let EXTREME_POINT_OF_EMPTY = prove (`!x. ~(x extreme_point_of {})`, REWRITE_TAC[extreme_point_of; NOT_IN_EMPTY]);; let EXTREME_POINT_OF_SING = prove (`!a x. x extreme_point_of {a} <=> x = a`, REWRITE_TAC[extreme_point_of; IN_SING] THEN MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]);; let EXTREME_POINT_OF_TRANSLATION_EQ = prove (`!a:real^N x s. (a + x) extreme_point_of (IMAGE (\x. a + x) s) <=> x extreme_point_of s`, REWRITE_TAC[extreme_point_of] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [EXTREME_POINT_OF_TRANSLATION_EQ];; let EXTREME_POINT_OF_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> ((f x) extreme_point_of (IMAGE f s) <=> x extreme_point_of s)`, REWRITE_TAC[GSYM FACE_OF_SING] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [EXTREME_POINT_OF_LINEAR_IMAGE];; let EXTREME_POINTS_OF_TRANSLATION = prove (`!a s. {x:real^N | x extreme_point_of (IMAGE (\x. a + x) s)} = IMAGE (\x. a + x) {x | x extreme_point_of s}`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN REWRITE_TAC[IN_ELIM_THM; EXTREME_POINT_OF_TRANSLATION_EQ]);; let EXTREME_POINT_OF_INTER = prove (`!x s t. x extreme_point_of s /\ x extreme_point_of t ==> x extreme_point_of (s INTER t)`, REWRITE_TAC[extreme_point_of; IN_INTER] THEN MESON_TAC[]);; let EXTREME_POINT_OF_INTER_GEN = prove (`!x s t. (x extreme_point_of s \/ x extreme_point_of t) /\ x IN s INTER t ==> x extreme_point_of (s INTER t)`, REWRITE_TAC[extreme_point_of; IN_INTER] THEN MESON_TAC[]);; let EXTREME_POINTS_OF_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> {y | y extreme_point_of (IMAGE f s)} = IMAGE f {x | x extreme_point_of s}`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_SEGMENT_LINEAR_IMAGE) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET; extreme_point_of; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FUN_IN_IMAGE; IN_ELIM_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN ASM SET_TAC[]);; let EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove (`!s a b c. (!x. x IN s ==> a dot x <= b) /\ s INTER {x | a dot x = b} = {c} ==> c extreme_point_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG THEN ASM_REWRITE_TAC[CONVEX_SING]);; let EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove (`!s a b c. (!x. x IN s ==> a dot x >= b) /\ s INTER {x | a dot x = b} = {c} ==> c extreme_point_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG THEN ASM_REWRITE_TAC[CONVEX_SING]);; let EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove (`!s a b c:real^N. (!x. x IN s ==> a dot x <= b) /\ s INTER {x | a dot x = b} = {c} ==> {c} exposed_face_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[exposed_face_of] THEN CONJ_TAC THENL [REWRITE_TAC[FACE_OF_SING] THEN MATCH_MP_TAC EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM SET_TAC[]);; let EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove (`!s a b c:real^N. (!x. x IN s ==> a dot x >= b) /\ s INTER {x | a dot x = b} = {c} ==> {c} exposed_face_of s`, REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`; `c:real^N`] EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE) THEN ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);; let EXPOSED_POINT_OF_FURTHEST_POINT = prove (`!s a b:real^N. b IN s /\ (!x. x IN s ==> dist(a,x) <= dist(a,b)) ==> {b} exposed_face_of s`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[DIST_0; NORM_LE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN MAP_EVERY EXISTS_TAC [`b:real^N`; `(b:real^N) dot b`] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[IN_INTER; SING_SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; IN_SING; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[VECTOR_EQ] THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM] THEN UNDISCH_TAC `(b:real^N) dot x = b dot b`] THEN MP_TAC(ISPEC `b - x:real^N` DOT_POS_LE) THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);; let COLLINEAR_EXTREME_POINTS = prove (`!s. collinear s ==> FINITE {x:real^N | x extreme_point_of s} /\ CARD {x | x extreme_point_of s} <= 2`, REWRITE_TAC[GSYM NOT_LT; TAUT `a /\ ~b <=> ~(a ==> b)`] THEN REWRITE_TAC[ARITH_RULE `2 < n <=> 3 <= n`] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSET_STRONG) THEN CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `a:real^N`; `b:real^N`; `c:real^N`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `(a:real^N) extreme_point_of s /\ b extreme_point_of s /\ c extreme_point_of s` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(a:real^N) IN s /\ b IN s /\ c IN s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[extreme_point_of]; ALL_TAC] THEN SUBGOAL_THEN `collinear {a:real^N,b,c}` MP_TAC THENL [MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]; REWRITE_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_IN_SEGMENT] THEN ASM_SIMP_TAC[SEGMENT_CLOSED_OPEN; IN_INSERT; NOT_IN_EMPTY; IN_UNION] THEN ASM_MESON_TAC[extreme_point_of]]);; let EXTREME_POINT_OF_CONIC = prove (`!s x:real^N. conic s /\ x extreme_point_of s ==> x = vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_CONIC) THEN SIMP_TAC[conic; IN_SING; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH `c % x:real^N = x <=> (c - &1) % x = vec 0`] THEN MESON_TAC[REAL_ARITH `&0 <= &0 /\ ~(&1 = &0)`]);; let EXTREME_POINT_OF_CONVEX_HULL_INSERT = prove (`!s a:real^N. FINITE s /\ ~(a IN convex hull s) ==> a extreme_point_of (convex hull (a INSERT s))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_SIMP_TAC[HULL_INC] THEN STRIP_TAC THEN MP_TAC(ISPECL [`{a:real^N}`; `(a:real^N) INSERT s`] FACE_OF_CONVEX_HULLS) THEN ASM_REWRITE_TAC[FINITE_INSERT; AFFINE_HULL_SING; CONVEX_HULL_SING] THEN REWRITE_TAC[FACE_OF_SING] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> a INSERT s DIFF {a} = s`] THEN ASM SET_TAC[]);; let FACE_OF_CONIC_HULL = prove (`!f s:real^N->bool. f face_of s /\ ~(vec 0 IN affine hull s) ==> (conic hull f) face_of (conic hull s)`, REPEAT GEN_TAC THEN SIMP_TAC[face_of; HULL_MONO; CONVEX_CONIC_HULL] THEN STRIP_TAC THEN REWRITE_TAC[IMP_CONJ; CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `x:real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`c:real`; `z:real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`b:real`; `y:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `z:real^N = x` THENL [ASM_REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC] THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `?c. &0 <= c /\ x:real^N = c % y` (fun th -> ASM_MESON_TAC[VECTOR_MUL_ASSOC; REAL_LE_MUL; th]) THEN EXISTS_TAC `b / ((&1 - u) * a + u * c)` THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `z:real^N`) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv((&1 - u) * a + u * c)):real^N->real^N`) THEN SUBGOAL_THEN `&0 < (&1 - u) * a + u * c` ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ENTIRE; REAL_SUB_LT; REAL_LT_IMP_NZ] THEN ASM_MESON_TAC[VECTOR_MUL_LZERO]; REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_LE_DIV; REAL_LT_IMP_LE; VECTOR_MUL_LID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[real_div; REAL_MUL_AC]]; ALL_TAC] THEN ASM_CASES_TAC `a = &0` THENL [ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_LZERO] THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; SEGMENT_REFL; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv(u * c)):real^N->real^N`) THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `z:real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_FIELD `&0 < u /\ ~(c = &0) ==> (inv(u * c) * u) * c = &1`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `y:real^N` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; VECTOR_MUL_LZERO; REAL_LE_REFL; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_LZERO] THEN REWRITE_TAC[IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv((&1 - u) * a)):real^N->real^N`) THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `z:real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_FIELD `u < &1 /\ ~(a = &0) ==> (inv((&1 - u) * a) * (&1 - u)) * a = &1`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `y:real^N` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; VECTOR_MUL_LZERO; REAL_LE_REFL; REAL_LT_IMP_LE; REAL_SUB_LE]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPECL [`a:real`; `b:real`; `c:real`; `x:real^N`; `y:real^N`; `z:real^N`] OPEN_SEGMENT_DESCALE) THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(z IN s) ==> t SUBSET s ==> ~(z IN t)`)) THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `z:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]);; let FACE_OF_CONIC_HULL_REV = prove (`!s f:real^N->bool. f face_of (conic hull s) /\ ~(vec 0 IN affine hull s) ==> f = {vec 0} \/ ?f'. f' face_of s /\ conic hull f' = f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `f = {vec 0:real^N}` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `f INTER affine hull s:real^N->bool` THEN CONJ_TAC THENL [MP_TAC(SPECL [`s:real^N->bool`; `s:real^N->bool`] CONIC_HULL_INTER_AFFINE_HULL) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC FACE_OF_INTER_INTER THEN ASM_SIMP_TAC[FACE_OF_REFL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN ASM_MESON_TAC[FACE_OF_CONIC; CONIC_CONIC_HULL]; SUBGOAL_THEN `!x:real^N. x IN conic hull s /\ x IN f /\ ~(x = vec 0) ==> x IN conic hull (f INTER affine hull s)` ASSUME_TAC THENL [REWRITE_TAC[CONIC_HULL_EXPLICIT; IMP_CONJ; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`c:real`; `x:real^N`] THEN ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FACE_OF_CONIC)) THEN REWRITE_TAC[CONIC_CONIC_HULL] THEN REWRITE_TAC[conic] THEN DISCH_THEN(MP_TAC o SPECL [`c % x:real^N`; `inv c:real`]) THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN REWRITE_TAC[VECTOR_MUL_LID]; REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_SIMP_TAC[CONIC_CONIC_HULL; CONIC_CONTAINS_0]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM SET_TAC[]]]]);; let EXTREME_POINT_OF_CONIC_HULL = prove (`!s x:real^N. ~(vec 0 IN affine hull s) ==> (x extreme_point_of conic hull s <=> x = vec 0 /\ ~(s = {}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM FACE_OF_SING]) THEN DISCH_THEN(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] FACE_OF_CONIC_HULL_REV)) THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [extreme_point_of]) THEN ASM_REWRITE_TAC[SET_RULE `{a} = {b} <=> a = b`] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `x IN s ==> ~(s = {})`)) THEN REWRITE_TAC[CONIC_HULL_EQ_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[CONIC_HULL_EQ_SING]) THEN ASM_MESON_TAC[FACE_OF_EMPTY; NOT_INSERT_EMPTY]; STRIP_TAC THEN ASM_REWRITE_TAC[extreme_point_of; CONIC_HULL_CONTAINS_0] THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `u:real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`b:real`; `v:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; ENDS_NOT_IN_SEGMENT] THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; ENDS_NOT_IN_SEGMENT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `affine hull {u:real^N,v}` o MATCH_MP (SET_RULE `~(z IN s) ==> !t. t SUBSET s ==> ~(z IN t)`)) THEN ASM_SIMP_TAC[HULL_MONO; INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[AFFINE_HULL_0_2_EXPLICIT; IN_SEGMENT; VECTOR_MUL_ASSOC] THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC)) THEN MAP_EVERY EXISTS_TAC [`(&1 - u) * a`; `u * b:real`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_LT_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC]);; let FACE_OF_CONIC_HULL_EQ = prove (`!s f:real^N->bool. ~(vec 0 IN affine hull s) ==> (f face_of (conic hull s) <=> f = {vec 0} /\ ~(s = {}) \/ ?f'. f' face_of s /\ conic hull f' = f)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[] THEN EXISTS_TAC `{}:real^N->bool` THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM_SIMP_TAC[EMPTY_FACE_OF; CONIC_HULL_EMPTY; SUBSET_EMPTY]; ASM_SIMP_TAC[FACE_OF_CONIC_HULL_REV]]; ASM_SIMP_TAC[FACE_OF_SING; EXTREME_POINT_OF_CONIC_HULL]; ASM_MESON_TAC[FACE_OF_CONIC_HULL]]);; let EXTREME_POINT_OF_CBALL = prove (`!a r x:real^N. x extreme_point_of cball(a,r) <=> x IN sphere(a,r)`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[EXTREME_POINT_IN_FRONTIER; FRONTIER_CBALL]; GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_SPHERE_0] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[CBALL_SING; EXTREME_POINT_OF_SING; NORM_EQ_0] THEN STRIP_TAC THEN MATCH_MP_TAC EXTREME_POINT_RELATIVE_FRONTIER THEN ASM_REWRITE_TAC[CONVEX_CBALL; IN_CBALL_0; IN_DIFF; RELATIVE_INTERIOR_CBALL; REAL_LE_REFL; IN_BALL_0; REAL_LT_REFL; INSERT_SUBSET; EMPTY_SUBSET; IN_DIFF] THEN REWRITE_TAC[REAL_ARITH `x <= y /\ ~(x < y) <=> x = y`] THEN ASM_MESON_TAC[DIFFERENT_NORM_3_COLLINEAR_POINTS]]);; (* ------------------------------------------------------------------------- *) (* Closure and (relative) openness of conic hulls etc. *) (* ------------------------------------------------------------------------- *) let CLOSED_IN_CONIC_HULL = prove (`!s t:real^N->bool. compact t /\ ~(vec 0 IN t) /\ t SUBSET s ==> closed_in (subtopology euclidean (conic hull s)) (conic hull t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONIC_HULL_AS_IMAGE] THEN MP_TAC(ISPECL [`\z. drop(fstcart z) % (sndcart z:real^N)`; `{t | &0 <= drop t} PCROSS (t:real^N->bool)`; `IMAGE (\z. drop(fstcart z) % (sndcart z:real^N)) ({t | &0 <= drop t} PCROSS s)`] PROPER_MAP) THEN ASM_SIMP_TAC[IMAGE_SUBSET; SUBSET_PCROSS; SUBSET_REFL] THEN DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(p <=> q /\ r) ==> p ==> q`)) THEN ANTS_TAC THENL [ALL_TAC; SIMP_TAC[CLOSED_IN_REFL]] THEN REWRITE_TAC[GSYM CONIC_HULL_AS_IMAGE] THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN SIMP_TAC[CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN ASM_SIMP_TAC[CLOSED_PCROSS_EQ; COMPACT_IMP_CLOSED] THEN REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]] THEN MP_TAC(ISPECL [`k:real^N->bool`; `vec 0:real^N`] BOUNDED_SUBSET_CBALL) THEN ASM_SIMP_TAC[SUBSET; IN_CBALL_0; COMPACT_IMP_BOUNDED] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[vec 0,lift(r / setdist({vec 0:real^N},t))] PCROSS (t:real^N->bool)` THEN ASM_SIMP_TAC[BOUNDED_PCROSS; BOUNDED_INTERVAL; COMPACT_IMP_BOUNDED] THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN SIMP_TAC[GSYM FORALL_DROP; LIFT_DROP; DROP_VEC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `x:real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; SETDIST_EQ_0_SING; CLOSURE_CLOSED; COMPACT_IMP_CLOSED; SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `a % x:real^N`) THEN ASM_REWRITE_TAC[NORM_MUL; real_abs] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[NORM_ARITH `norm(x:real^N) = dist(vec 0,x)`] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; let CLOSED_CONIC_HULL = prove (`!s:real^N->bool. vec 0 IN relative_interior s \/ compact s /\ ~(vec 0 IN s) ==> closed(conic hull s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONIC_HULL_EQ_AFFINE_HULL; CLOSED_AFFINE_HULL] THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`] CLOSED_IN_CONIC_HULL) THEN ASM_REWRITE_TAC[SUBSET_UNIV; HULL_UNIV; SUBTOPOLOGY_UNIV] THEN ASM_SIMP_TAC[GSYM CLOSED_IN; COMPACT_IMP_CLOSED]);; let CONIC_CLOSURE = prove (`!s:real^N->bool. conic s ==> conic(closure s)`, REWRITE_TAC[conic; CLOSURE_SEQUENTIAL] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num->real^N`) ASSUME_TAC) THEN EXISTS_TAC `\n. c % (a:num->real^N) n` THEN ASM_SIMP_TAC[LIM_ADD; LIM_CMUL]);; let CLOSURE_CONIC_HULL = prove (`!s:real^N->bool. vec 0 IN relative_interior s \/ bounded s /\ ~(vec 0 IN closure s) ==> closure(conic hull s) = conic hull (closure s)`, REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[CONIC_HULL_EQ_AFFINE_HULL; CLOSED_AFFINE_HULL; CLOSURE_CLOSED] THEN CONV_TAC SYM_CONV THEN GEN_REWRITE_TAC RAND_CONV [GSYM AFFINE_HULL_CLOSURE] THEN MATCH_MP_TAC CONIC_HULL_EQ_AFFINE_HULL THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_CLOSURE_SUBSET) THEN ASM SET_TAC[]; REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[HULL_MONO; CLOSURE_SUBSET] THEN MATCH_MP_TAC CLOSED_CONIC_HULL THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]; MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[SUBSET_CLOSURE; HULL_SUBSET] THEN MATCH_MP_TAC CONIC_CLOSURE THEN REWRITE_TAC[CONIC_CONIC_HULL]]]);; let OPEN_IN_SAME_CONIC_HULL = prove (`!u s:real^N->bool. conic u /\ open_in (subtopology euclidean u) s ==> open_in (subtopology euclidean u) (conic hull s DELETE vec 0)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `conic hull s DELETE (vec 0:real^N) = UNIONS {IMAGE (\x. c % x) s | &0 < c} DELETE vec 0` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; REAL_LE_LT; IN_IMAGE; IN_DELETE] THEN MESON_TAC[VECTOR_MUL_EQ_0]; ALL_TAC] THEN MATCH_MP_TAC OPEN_IN_DELETE THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `c:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x:real^N. c % x`; `s:real^N->bool`; `u:real^N->bool`] OPEN_IN_INJECTIVE_LINEAR_IMAGE) THEN ASM_SIMP_TAC[LINEAR_SCALING; VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) THEN ASM_SIMP_TAC[CONIC_IMAGE_MULTIPLE; SUBSET_REFL] THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[conic; SUBSET; REAL_LT_IMP_LE]);; let OPEN_CONIC_HULL = prove (`!s:real^N->bool. open s ==> open(conic hull s DELETE vec 0)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`] OPEN_IN_SAME_CONIC_HULL) THEN ASM_REWRITE_TAC[CONIC_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN]);; let OPEN_IN_CONIC_HULL = prove (`!u s:real^N->bool. open_in (subtopology euclidean (affine hull u)) s ==> open_in (subtopology euclidean (affine hull (conic hull u))) (conic hull s DELETE vec 0)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; EMPTY_DELETE; OPEN_IN_EMPTY] THEN ASM_REWRITE_TAC[AFFINE_HULL_CONIC_HULL] THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY; OPEN_IN_SUBTOPOLOGY_EMPTY] THEN ASM_CASES_TAC `(vec 0:real^N) IN affine hull u` THENL [SUBGOAL_THEN `affine hull (vec 0 INSERT u:real^N->bool) = affine hull u` SUBST1_TAC THENL [MATCH_MP_TAC AFFINE_HULLS_EQ THEN ASM_REWRITE_TAC[INSERT_SUBSET; HULL_SUBSET] THEN MATCH_MP_TAC(SET_RULE `vec 0 INSERT s SUBSET t ==> s SUBSET t`) THEN REWRITE_TAC[HULL_SUBSET]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] OPEN_IN_SAME_CONIC_HULL) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; CONIC_SPAN]]; MP_TAC(ISPECL [`{vec 0:real^N}`; `affine hull u:real^N->bool`] SEPARATING_HYPERPLANE_AFFINE_AFFINE) THEN ASM_REWRITE_TAC[AFFINE_SING; AFFINE_AFFINE_HULL; NOT_INSERT_EMPTY; AFFINE_HULL_EQ_EMPTY; DISJOINT_INSERT; DISJOINT_EMPTY] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; DOT_RZERO] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ p /\ q /\ s`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `b:real` (CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) ASSUME_TAC)) THEN REWRITE_TAC[open_in] THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`) THEN TRANS_TAC SUBSET_TRANS `conic hull (affine hull u):real^N->bool` THEN ASM_SIMP_TAC[HULL_MONO] THEN ONCE_REWRITE_TAC[HULL_INSERT] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN REWRITE_TAC[SPAN_INSERT_0; CONIC_HULL_SUBSET_SPAN]; ALL_TAC] THEN SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN REWRITE_TAC[IN_DELETE; IMP_CONJ; CONIC_HULL_EXPLICIT; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CONIC_HULL_EXPLICIT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x:real^N. x IN s ==> a dot x = b` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `(\y:real^N. lift(a dot y)) continuous (at (c % x))` ASSUME_TAC THENL [REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_at]) THEN DISCH_THEN(MP_TAC o SPEC `a dot (c % x:real^N)`) THEN SUBGOAL_THEN `&0 < c` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN ASM_SIMP_TAC[DOT_RMUL; HULL_INC; REAL_LT_MUL; DIST_LIFT] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(\y:real^N. (b / (a dot y)) % y) continuous (at (c % x))` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID; o_DEF; LIFT_CMUL; real_div] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV) THEN ASM_SIMP_TAC[DOT_RMUL; HULL_INC; REAL_ENTIRE; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `min e (norm(x:real^N))`) THEN ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT] THEN ASM_SIMP_TAC[DOT_RMUL; HULL_INC; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[VECTOR_MUL_LID; REAL_FIELD `&0 < b /\ &0 < c ==> b / (c * b) * c = &1`] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(fun th -> EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `y:real^N` THEN REPEAT DISCH_TAC THEN MP_TAC(SPEC `y:real^N` th)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN UNDISCH_TAC `dist (b / (a dot y) % y:real^N,x) < norm x` THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; DIST_0; REAL_LT_REFL] THEN DISCH_TAC THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`(a dot (y:real^N)) / b`; `(b / (a dot y)) % y:real^N`] THEN SUBGOAL_THEN `&0 < (a:real^N) dot y` ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `!y. &0 < y /\ abs(x - y) < y ==> &0 < x`) THEN EXISTS_TAC `c * b:real` THEN ASM_SIMP_TAC[REAL_LT_MUL]; ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_IMP_LE]] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_FIELD `&0 < a /\ &0 < b ==> a / b * b / a = &1`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!z:real^N. z IN span u /\ a dot z = b ==> z IN affine hull u` MATCH_MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SPAN_MUL; DOT_RMUL; REAL_DIV_RMUL; REAL_LT_IMP_NZ]] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[SPAN_EXPLICIT; AFFINE_HULL_EXPLICIT; IMP_CONJ] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `q:real^N->real`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[DOT_RSUM] THEN SUBGOAL_THEN `sum t (\x:real^N. a dot q x % x) = b * sum t q` SUBST1_TAC THENL [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[HULL_INC; DOT_RMUL; REAL_MUL_SYM]; ASM_SIMP_TAC[REAL_FIELD `&0 < b ==> (b * t = b <=> t = &1)`] THEN STRIP_TAC] THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `q:real^N->real`] THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `sum (t:real^N->bool) q = &1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let CONIC_INTERIOR_INSERT = prove (`!s:real^N->bool. conic s ==> conic(vec 0 INSERT interior s)`, REWRITE_TAC[conic; IN_INTERIOR; SUBSET; IN_BALL; dist; IN_INSERT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`] THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) ASSUME_TAC) THEN EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv(c) % y:real^N`; `c:real`]) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[VECTOR_MUL_LID; REAL_LT_IMP_LE] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs c:real` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM NORM_MUL]] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; VECTOR_SUB_LDISTRIB] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID]);; let CONIC_INTERIOR = prove (`!s:real^N->bool. conic s /\ vec 0 IN interior s ==> conic(interior s)`, MESON_TAC[SET_RULE `a IN s ==> a INSERT s = s`; CONIC_INTERIOR_INSERT]);; let CONIC_RELATIVE_INTERIOR_INSERT = prove (`!s:real^N->bool. conic s ==> conic(vec 0 INSERT relative_interior s)`, REWRITE_TAC[conic; IN_RELATIVE_INTERIOR; SUBSET; IN_INTER; IN_BALL; dist; IN_INSERT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`] THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) ASSUME_TAC) THEN EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`x:real^N`; `&0`]) THEN REWRITE_TAC[REAL_LE_REFL; VECTOR_MUL_LZERO] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`inv(c) % y:real^N`; `c:real`]) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[VECTOR_MUL_LID; REAL_LT_IMP_LE] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SPAN_MUL; AFFINE_HULL_EQ_SPAN; HULL_INC]] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs c:real` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM NORM_MUL]] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; VECTOR_SUB_LDISTRIB] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID]);; let CONIC_RELATIVE_INTERIOR = prove (`!s:real^N->bool. conic s /\ vec 0 IN relative_interior s ==> conic(relative_interior s)`, MESON_TAC[SET_RULE `a IN s ==> a INSERT s = s`; CONIC_RELATIVE_INTERIOR_INSERT]);; let CONIC_HULL_RELATIVE_INTERIOR_SUBSET = prove (`!s:real^N->bool. conic hull (relative_interior s) DELETE (vec 0) SUBSET relative_interior(conic hull s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`) THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET]; MATCH_MP_TAC OPEN_IN_CONIC_HULL THEN REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR]]);; let CONIC_SUBSET_AS_CONIC_HULL = prove (`!s c:real^N->bool. conic c /\ ~(c = {vec 0}) /\ c SUBSET conic hull s ==> conic hull (s INTER c) = c`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN ASM_SIMP_TAC[HULL_MINIMAL; INTER_SUBSET] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c SUBSET k ==> (!x. x IN k ==> x IN c ==> x IN u) ==> c SUBSET u`)) THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`a:real`; `x:real^N`] THEN ASM_CASES_TAC `a % x:real^N = vec 0` THENL [ASM_REWRITE_TAC[GSYM CONIC_HULL_EXPLICIT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CONIC_HULL_CONTAINS_0] THEN SUBGOAL_THEN `?y:real^N. ~(y = vec 0) /\ y IN c` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N` o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; CONIC_HULL_EXPLICIT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real`; `z:real^N`] THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_REWRITE_TAC[REAL_LE_LT; GSYM MEMBER_NOT_EMPTY] THEN STRIP_TAC THEN EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[IN_INTER] THEN SUBGOAL_THEN `z:real^N = inv b % y` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_LINV]; ASM_MESON_TAC[conic; REAL_LT_IMP_LE; REAL_LE_INV_EQ]]; UNDISCH_TAC `~(a % x:real^N = vec 0)` THEN SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN MAP_EVERY EXISTS_TAC [`a:real`; `x:real^N`] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `x:real^N = inv a % a % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_LINV]; ASM_MESON_TAC[conic; REAL_LT_IMP_LE; REAL_LE_INV_EQ]]]);; let RELATIVE_INTERIOR_CONIC_HULL = prove (`!s:real^N->bool. ~(vec 0 IN affine hull s) ==> relative_interior(conic hull s) = conic hull (relative_interior s) DELETE (vec 0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CONIC_HULL_RELATIVE_INTERIOR_SUBSET] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; RELATIVE_INTERIOR_EMPTY; EMPTY_SUBSET] THEN ASM_CASES_TAC `relative_interior (conic hull s):real^N->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_SUBSET] THEN SUBGOAL_THEN `~((vec 0:real^N) IN relative_interior(conic hull s))` ASSUME_TAC THENL [MATCH_MP_TAC EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR THEN ASM_SIMP_TAC[EXTREME_POINT_OF_CONIC_HULL; CONIC_HULL_EQ_SING] THEN ASM_MESON_TAC[IN_SING; HULL_INC]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `~(a IN t) /\ a INSERT t SUBSET s ==> t SUBSET s DELETE a`) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `conic hull ((vec 0 INSERT relative_interior (conic hull s:real^N->bool)) INTER affine hull s)` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s = t ==> t SUBSET s`) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CONIC_SUBSET_AS_CONIC_HULL THEN REPEAT CONJ_TAC THENL [SIMP_TAC[CONIC_RELATIVE_INTERIOR_INSERT; CONIC_CONIC_HULL]; ASM SET_TAC[]; ASM_REWRITE_TAC[INSERT_SUBSET; CONIC_HULL_CONTAINS_0] THEN ASM_REWRITE_TAC[AFFINE_HULL_EQ_EMPTY] THEN TRANS_TAC SUBSET_TRANS `conic hull s:real^N->bool` THEN SIMP_TAC[RELATIVE_INTERIOR_SUBSET; HULL_MONO; HULL_SUBSET]]; MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[CONIC_CONIC_HULL; SET_RULE `~(a IN t) ==> (a INSERT s) INTER t = s INTER t`] THEN TRANS_TAC SUBSET_TRANS `relative_interior s:real^N->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN CONJ_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`] CONIC_HULL_INTER_AFFINE_HULL) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MP_TAC(ISPEC `conic hull s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]; ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `affine hull (conic hull s):real^N->bool` THEN SIMP_TAC[HULL_SUBSET; HULL_MONO] THEN MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL; OPEN_IN_RELATIVE_INTERIOR]]]);; let CONIC_HULL_RELATIVE_INTERIOR = prove (`!s:real^N->bool. ~(vec 0 IN affine hull s) ==> conic hull (relative_interior s) = if relative_interior s = {} then {} else (vec 0) INSERT relative_interior(conic hull s)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY; CONIC_HULL_EMPTY] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_CONIC_HULL] THEN MATCH_MP_TAC(SET_RULE `a IN s ==> s = a INSERT (s DELETE a)`) THEN ASM_REWRITE_TAC[CONIC_HULL_CONTAINS_0]);; let CONIC_HULL_DIFF = prove (`!s t:real^N->bool. ~(vec 0 IN affine hull s) /\ t SUBSET s ==> conic hull (s DIFF t) = if t = s then {} else conic hull s DIFF (conic hull t DELETE vec 0)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIFF_EQ_EMPTY; CONIC_HULL_EMPTY] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_DELETE; CONIC_HULL_EXPLICIT; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[] THENL [EQ_TAC THENL [MESON_TAC[]; STRIP_TAC] THEN EXISTS_TAC `&0` THEN REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; MESON_TAC[]] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[NOT_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`d:real`; `z:real^N`] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `vec 0 IN affine hull {x:real^N,z}` MP_TAC THENL [REWRITE_TAC[AFFINE_HULL_0_2_EXPLICIT] THEN MAP_EVERY EXISTS_TAC [`c:real`; `--d:real`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + --b % y:real^N = vec 0 <=> a = b % y`] THEN REWRITE_TAC[REAL_ARITH `a + --b = &0 <=> a = b`] THEN DISCH_TAC THEN UNDISCH_TAC `c % x:real^N = d % z` THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN ASM_MESON_TAC[VECTOR_MUL_LZERO]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(z IN s) ==> t SUBSET s ==> z IN t ==> F`)) THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]]);; let CONIC_HULL_INTER = prove (`!s t:real^N->bool. ~(vec 0 IN affine hull (s UNION t)) ==> conic hull (s INTER t) = if s INTER t = {} then {} else conic hull s INTER conic hull t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s INTER t:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY] THEN REWRITE_TAC[CONIC_HULL_EXPLICIT] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`d:real`; `y:real^N`] THEN REPEAT DISCH_TAC THEN ASM_CASES_TAC `z:real^N = vec 0` THENL [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `c:real = d` THENL [SUBGOAL_THEN `x:real^N = y` SUBST_ALL_TAC THEN ASM_MESON_TAC[VECTOR_MUL_RZERO; VECTOR_MUL_LCANCEL]; ALL_TAC] THEN SUBGOAL_THEN `vec 0 IN affine hull {x:real^N,y}` MP_TAC THENL [REWRITE_TAC[AFFINE_HULL_0_2_EXPLICIT] THEN MAP_EVERY EXISTS_TAC [`c:real`; `--d:real`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + --b % y:real^N = vec 0 <=> a = b % y`] THEN ASM_REWRITE_TAC[REAL_ARITH `a + --b = &0 <=> a = b`] THEN ASM_MESON_TAC[]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `!q t. ~(z IN s) ==> t SUBSET s ==> z IN t ==> q`)) THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]]);; let INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER = prove (`!s t u:real^N->bool. convex u /\ vec 0 IN relative_interior u /\ s UNION t SUBSET relative_frontier u ==> conic hull s INTER conic hull t = if s = {} \/ t = {} then {} else if s INTER t = {} then {vec 0} else conic hull (s INTER t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; INTER_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; INTER_EMPTY] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; COND_CASES_TAC THEN REWRITE_TAC[SUBSET_INTER] THEN SIMP_TAC[HULL_MONO; INTER_SUBSET; SING_SUBSET] THEN ASM_REWRITE_TAC[CONIC_HULL_CONTAINS_0]] THEN MATCH_MP_TAC(SET_RULE `s DELETE vec 0 SUBSET t /\ vec 0 IN t ==> s SUBSET t`) THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[CONIC_HULL_CONTAINS_0; IN_SING]] THEN TRANS_TAC SUBSET_TRANS `conic hull (s INTER t) DELETE (vec 0:real^N)` THEN CONJ_TAC THENL [ALL_TAC; COND_CASES_TAC THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY] THEN SET_TAC[]] THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; SUBSET; IN_DELETE; IN_INTER] THEN X_GEN_TAC `z:real^N` THEN ASM_CASES_TAC `z:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`d:real`; `y:real^N`] THEN REPEAT DISCH_TAC THEN ASM_CASES_TAC `z:real^N = vec 0` THENL [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `c:real = d` THENL [SUBGOAL_THEN `x:real^N = y` SUBST_ALL_TAC THEN ASM_MESON_TAC[VECTOR_MUL_RZERO; VECTOR_MUL_LCANCEL]; ALL_TAC] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`y:real^N`; `x:real^N`; `z:real^N`; `t:real^N->bool`; `s:real^N->bool`; `d:real`; `c:real`] THEN MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN REPLICATE_TAC 3 (AP_TERM_TAC THEN ABS_TAC) THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[INTER_COMM; UNION_COMM]; REPEAT STRIP_TAC] THEN MP_TAC(ISPECL [`u:real^N->bool`; `vec 0:real^N`; `x:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier]) THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_SEGMENT]] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_MUL_RZERO]; EXISTS_TAC `c / d:real`; RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier]) THEN ASM SET_TAC[]] THEN SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN ASM_REWRITE_TAC[REAL_MUL_LID; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LT_LE] THEN CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_MUL_LZERO]; ALL_TAC] THEN UNDISCH_TAC `z:real^N = c % x` THEN DISCH_THEN(MP_TAC o AP_TERM `(%) (inv d):real^N->real^N`) THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; real_div] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN REWRITE_TAC[real_div; REAL_MUL_SYM]);; let RELATIVE_FRONTIER_CONIC_HULL = prove (`!s:real^N->bool. bounded s /\ ~(vec 0 IN affine hull s) ==> relative_frontier(conic hull s) = if ?a. s = {a} then {vec 0} else conic hull (relative_frontier s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~((vec 0:real^N) IN closure s)` ASSUME_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET_AFFINE_HULL) THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[relative_frontier] THEN ASM_SIMP_TAC[CLOSURE_CONIC_HULL] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_CONIC_HULL] THEN ASM_CASES_TAC `affine(s:real^N->bool)` THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[GEN_REWRITE_RULE I [GSYM RELATIVE_INTERIOR_EQ_CLOSURE] th]) THEN REWRITE_TAC[DIFF_EQ_EMPTY; CONIC_HULL_EMPTY] THEN FIRST_ASSUM(MP_TAC o MATCH_MP AFFINE_BOUNDED_EQ_TRIVIAL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `a:real^N` SUBST_ALL_TAC)) THEN ASM_REWRITE_TAC[CLOSURE_EMPTY; CONIC_HULL_EMPTY; EMPTY_DIFF; CLOSURE_SING; RELATIVE_INTERIOR_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[SET_RULE `{a} = {b} <=> b = a`; EXISTS_REFL] THEN MATCH_MP_TAC(SET_RULE `a IN s ==> s DIFF (s DELETE a) = {a}`) THEN ASM_REWRITE_TAC[CONIC_HULL_CONTAINS_0; CONIC_HULL_EQ_EMPTY] THEN REWRITE_TAC[NOT_INSERT_EMPTY]; COND_CASES_TAC THENL [ASM_MESON_TAC[AFFINE_SING]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) CONIC_HULL_DIFF o rand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[AFFINE_HULL_CLOSURE] THEN MESON_TAC[RELATIVE_INTERIOR_SUBSET; CLOSURE_SUBSET; SUBSET]; ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_CLOSURE]]]);; let CONIC_HULL_RELATIVE_FRONTIER = prove (`!s:real^N->bool. bounded s /\ ~(vec 0 IN affine hull s) ==> conic hull (relative_frontier s) = if ?a. s = {a} then {} else relative_frontier(conic hull s)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_CONIC_HULL] THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[RELATIVE_FRONTIER_SING; CONIC_HULL_EMPTY]);; let INTER_CONIC_HULL = prove (`!s t:real^N->bool. ~(vec 0 IN affine hull (s UNION t)) ==> conic hull s INTER conic hull t = if s = {} \/ t = {} then {} else if s INTER t = {} then {vec 0} else conic hull (s INTER t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{vec 0:real^N}`; `affine hull (s UNION t):real^N->bool`] SEPARATING_HYPERPLANE_AFFINE_AFFINE) THEN REWRITE_TAC[AFFINE_SING; AFFINE_AFFINE_HULL; NOT_INSERT_EMPTY] THEN REWRITE_TAC[AFFINE_HULL_EQ_EMPTY; EMPTY_UNION] THEN ASM_REWRITE_TAC[SET_RULE `DISJOINT {x} s <=> ~(x IN s)`] THEN ASM_CASES_TAC `s:real^N->bool = {} /\ t:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; INTER_EMPTY; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; DOT_RZERO] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `c:real`] THEN ASM_CASES_TAC `b:real = &0` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC INTER_CONIC_HULL_SUBSETS_CONVEX_RELATIVE_FRONTIER THEN EXISTS_TAC `{x:real^N | a dot x <= c}` THEN REWRITE_TAC[CONVEX_HALFSPACE_LE] THEN SUBGOAL_THEN `(vec 0:real^N) IN interior {x | a dot x <= c}` ASSUME_TAC THENL [ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; IN_ELIM_THM; DOT_RZERO]; ALL_TAC] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `a IN s ==> ~(s = {})`)) THEN ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR] THEN ASM_SIMP_TAC[FRONTIER_HALFSPACE_LE; SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[HULL_INC]);; let RELATIVE_INTERIOR_CONIC_HULL_0 = prove (`!s:real^N->bool. convex s ==> (vec 0 IN relative_interior(conic hull s) <=> vec 0 IN relative_interior s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONIC_HULL_EMPTY; RELATIVE_INTERIOR_EMPTY; NOT_IN_EMPTY] THEN ASM_CASES_TAC `(vec 0:real^N) IN affine hull s` THENL [ALL_TAC; ASM_SIMP_TAC[RELATIVE_INTERIOR_CONIC_HULL; IN_DELETE] THEN ASM_MESON_TAC[SUBSET; HULL_INC; RELATIVE_INTERIOR_SUBSET]] THEN ASM_CASES_TAC `conic hull s:real^N->bool = span s` THENL [ALL_TAC; ASM_MESON_TAC[CONIC_HULL_EQ_SPAN; CONIC_HULL_EQ_SPAN_EQ]] THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_AFFINE; AFFINE_SPAN; SPAN_0] THEN ASM_SIMP_TAC[IN_RELATIVE_INTERIOR_IN_OPEN_SEGMENT_EQ] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `(--x:real^N) IN conic hull s` MP_TAC THENL [ASM_SIMP_TAC[SPAN_NEG; SPAN_SUPERSET]; ALL_TAC] THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real` THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_NEG_EQ_0; REAL_LE_LT] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[IN_OPEN_SEGMENT] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN ONCE_REWRITE_TAC[NORM_ARITH `dist(a:real^N,b) = dist(--a,--b)`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[dist; VECTOR_SUB_LZERO; VECTOR_NEG_0; VECTOR_NEG_NEG; VECTOR_SUB_RZERO; VECTOR_ARITH `a % y - --y:real^N = (a + &1) % y`] THEN REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC(REAL_RING `a = b + &1 ==> a * y = b * y + y`) THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[VECTOR_MUL_RZERO; VECTOR_NEG_EQ_0]]);; (* ------------------------------------------------------------------------- *) (* Facets. *) (* ------------------------------------------------------------------------- *) parse_as_infix("facet_of",(12, "right"));; let facet_of = new_definition `f facet_of s <=> f face_of s /\ ~(f = {}) /\ aff_dim f = aff_dim s - &1`;; let FACET_OF_EMPTY = prove (`!s. ~(s facet_of {})`, REWRITE_TAC[facet_of; FACE_OF_EMPTY] THEN CONV_TAC TAUT);; let FACET_OF_REFL = prove (`!s. ~(s facet_of s)`, REWRITE_TAC[facet_of; INT_ARITH `~(x:int = x - &1)`]);; let FACET_OF_IMP_FACE_OF = prove (`!f s. f facet_of s ==> f face_of s`, SIMP_TAC[facet_of]);; let FACET_OF_IMP_SUBSET = prove (`!f s. f facet_of s ==> f SUBSET s`, SIMP_TAC[FACET_OF_IMP_FACE_OF; FACE_OF_IMP_SUBSET]);; let FACET_OF_IMP_PROPER = prove (`!f s. f facet_of s ==> ~(f = {}) /\ ~(f = s)`, REWRITE_TAC[facet_of] THEN MESON_TAC[INT_ARITH `~(x - &1:int = x)`]);; let FACET_OF_TRANSLATION_EQ = prove (`!a:real^N f s. (IMAGE (\x. a + x) f) facet_of (IMAGE (\x. a + x) s) <=> f facet_of s`, REWRITE_TAC[facet_of] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [FACET_OF_TRANSLATION_EQ];; let FACET_OF_LINEAR_IMAGE = prove (`!f:real^M->real^N c s. linear f /\ (!x y. f x = f y ==> x = y) ==> ((IMAGE f c) facet_of (IMAGE f s) <=> c facet_of s)`, REWRITE_TAC[facet_of] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [FACET_OF_LINEAR_IMAGE];; let HYPERPLANE_FACET_OF_HALFSPACE_LE = prove (`!a:real^N b. ~(a = vec 0) ==> {x | a dot x = b} facet_of {x | a dot x <= b}`, SIMP_TAC[facet_of; HYPERPLANE_FACE_OF_HALFSPACE_LE; HYPERPLANE_EQ_EMPTY; AFF_DIM_HYPERPLANE; AFF_DIM_HALFSPACE_LE]);; let HYPERPLANE_FACET_OF_HALFSPACE_GE = prove (`!a:real^N b. ~(a = vec 0) ==> {x | a dot x = b} facet_of {x | a dot x >= b}`, SIMP_TAC[facet_of; HYPERPLANE_FACE_OF_HALFSPACE_GE; HYPERPLANE_EQ_EMPTY; AFF_DIM_HYPERPLANE; AFF_DIM_HALFSPACE_GE]);; let FACET_OF_HALFSPACE_LE = prove (`!f a:real^N b. f facet_of {x | a dot x <= b} <=> ~(a = vec 0) /\ f = {x | a dot x = b}`, REPEAT GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[HYPERPLANE_FACET_OF_HALFSPACE_LE] THEN SIMP_TAC[AFF_DIM_HALFSPACE_LE; facet_of; FACE_OF_HALFSPACE_LE] THEN REWRITE_TAC[TAUT `(p \/ q) /\ ~p /\ r <=> (~p /\ q) /\ r`] THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_REWRITE_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[TAUT `~(~p /\ p)`]) THEN TRY ASM_REAL_ARITH_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[AFF_DIM_UNIV] THEN TRY INT_ARITH_TAC THEN ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[AFF_DIM_HALFSPACE_LE] THEN INT_ARITH_TAC]);; let FACET_OF_HALFSPACE_GE = prove (`!f a:real^N b. f facet_of {x | a dot x >= b} <=> ~(a = vec 0) /\ f = {x | a dot x = b}`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real^N->bool`; `--a:real^N`; `--b:real`] FACET_OF_HALFSPACE_LE) THEN SIMP_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2; VECTOR_NEG_EQ_0; real_ge]);; let EXPOSED_FACET_OF = prove (`!s t:real^N->bool. convex s /\ t facet_of s ==> t exposed_face_of s`, REWRITE_TAC[facet_of] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(relative_interior t:real^N->bool = {})` MP_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; face_of]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] RELATIVE_BOUNDARY_POINT_IN_EXPOSED_FACE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] FACE_OF_SUBSET_RELATIVE_BOUNDARY) THEN ASM_REWRITE_TAC[SUBSET; IN_DIFF] THEN ASM_MESON_TAC[SUBSET; face_of; RELATIVE_INTERIOR_SUBSET; INT_ARITH `~(t:int = t - &1)`]; DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`; `t:real^N->bool`] SUBSET_OF_FACE_OF) THEN ANTS_TAC THENL [ASM_SIMP_TAC[EXPOSED_FACE_OF_IMP_FACE_OF; FACE_OF_IMP_SUBSET] THEN ASM SET_TAC[]; DISCH_TAC] THEN ASM_CASES_TAC `t:real^N->bool = f` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `t:int = s - &1 ==> !f. t < f /\ f < s ==> F`)) THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN DISCH_THEN(MP_TAC o SPEC `aff_dim(f:real^N->bool)`) THEN REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_SIMP_TAC[EXPOSED_FACE_OF_IMP_FACE_OF] THEN CONJ_TAC THENL [ASM_MESON_TAC[exposed_face_of; face_of]; ALL_TAC] THEN MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[exposed_face_of; face_of]);; let OPEN_IN_RELATIVE_FRONTIER_INTERIOR_FACET = prove (`!s f:real^N->bool. convex s /\ f facet_of s ==> open_in (subtopology euclidean (relative_frontier s)) (relative_interior f)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `relative_interior s:real^N->bool = {}` THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; FACET_OF_EMPTY]; POP_ASSUM MP_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `relative_interior f:real^N->bool`] INTER_RELATIVE_FRONTIER_CONIC_HULL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[FACE_OF_SUBSET_RELATIVE_FRONTIER; FACET_OF_REFL; facet_of; SUBSET_TRANS; RELATIVE_INTERIOR_SUBSET]; DISCH_THEN SUBST1_TAC] THEN SUBGOAL_THEN `~(vec 0 IN affine hull (f:real^N->bool))` ASSUME_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN ANTS_TAC THENL [ASM_MESON_TAC[facet_of; FACET_OF_REFL]; ASM SET_TAC[]]; ASM_SIMP_TAC[CONIC_HULL_RELATIVE_INTERIOR]] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; facet_of; face_of]; ALL_TAC] THEN ASM_SIMP_TAC[relative_frontier; SET_RULE `z IN i ==> (c DIFF i) INTER (z INSERT s) = (c DIFF i) INTER s`] THEN REWRITE_TAC[GSYM relative_frontier] THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `affine hull s:real^N->bool` THEN SIMP_TAC[CLOSURE_SUBSET_AFFINE_HULL; relative_frontier; SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`] THEN MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN MP_TAC(ISPEC `conic hull f:real^N->bool` OPEN_IN_RELATIVE_INTERIOR) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[AFFINE_HULL_CONIC_HULL] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[facet_of]; ALL_TAC] THEN MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_REWRITE_TAC[INSERT_SUBSET; AFF_DIM_INSERT] THEN CONJ_TAC THENL [ALL_TAC; INT_ARITH_TAC] THEN ASM_MESON_TAC[face_of; SUBSET; RELATIVE_INTERIOR_SUBSET; SUBSET]);; (* ------------------------------------------------------------------------- *) (* Extreme points of convex closed set with aff_dim <= 2 are closed. *) (* ------------------------------------------------------------------------- *) let CLOSED_EXTREME_POINTS_2D = prove (`!s:real^N->bool. closed s /\ convex s /\ aff_dim s <= &2 ==> closed {x | x extreme_point_of s}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `a:int <= &2 ==> -- &1 <= a ==> a = -- &1 \/ a = &0 \/ &1 <= a`)) THEN REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[EXTREME_POINT_OF_EMPTY; EMPTY_GSPEC; CLOSED_EMPTY]; ASM_REWRITE_TAC[EXTREME_POINT_OF_SING; SING_GSPEC; CLOSED_SING]; MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `relative_frontier s:real^N->bool` THEN REWRITE_TAC[CLOSED_RELATIVE_FRONTIER]] THEN SUBGOAL_THEN `{x:real^N | x extreme_point_of s} = relative_frontier s DIFF UNIONS {relative_interior f | f face_of s /\ aff_dim f = &1}` SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_FACIAL_PARTITION] THEN ASM_SIMP_TAC[AFF_DIM_GE; INT_ARITH `-- &1:int <= f /\ &1 <= s /\ s <= &2 ==> (f < s <=> f = -- &1 /\ &0 <= s \/ f = &0 \/ f = &1 /\ s = &2)`] THEN REWRITE_TAC[UNIONS_UNION; LEFT_OR_DISTRIB; SET_RULE `{f x | P x \/ Q x} = {f x | P x} UNION {f x | Q x}`] THEN MATCH_MP_TAC(SET_RULE `f1 SUBSET f /\ DISJOINT f f0 /\ fn = {} /\ f0 = e ==> e = (fn UNION f0 UNION f1) DIFF f`) THEN REPEAT CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[GSYM DISJOINT] THEN MESON_TAC[FACE_OF_EQ; INT_ARITH `~(&1:int = &0)`]; SIMP_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC; AFF_DIM_EQ_MINUS1; RELATIVE_INTERIOR_EMPTY]; REWRITE_TAC[AFF_DIM_EQ_0; SET_RULE `{f x | P x /\ (?a. x = s a)} = {f (s a) |a| P (s a)}`] THEN REWRITE_TAC[RELATIVE_INTERIOR_SING; FACE_OF_SING; UNIONS_GSPEC] THEN SET_TAC[]]; FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `&1:int <= a ==> a <= &2 ==> a = &1 \/ a = &2`)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [SUBGOAL_THEN `!f:real^N->bool. f face_of s /\ aff_dim f = &1 <=> f = s` (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[FACE_OF_AFF_DIM_LT; INT_LT_REFL; FACE_OF_REFL]; REWRITE_TAC[SET_RULE `{f x | x = a} = {f a}`; UNIONS_1] THEN REWRITE_TAC[relative_frontier; CLOSED_IN_REFL; SET_RULE `(s DIFF i) DIFF i = s DIFF i`]]; FIRST_ASSUM(fun th -> REWRITE_TAC [MATCH_MP (INT_ARITH `s:int = &2 ==> (f = &1 <=> ~(f = -- &1) /\ f = s - &1)`) th]) THEN REWRITE_TAC[AFF_DIM_EQ_MINUS1; GSYM facet_of] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_RELATIVE_FRONTIER_INTERIOR_FACET]]]);; (* ------------------------------------------------------------------------- *) (* Edges, i.e. faces of affine dimension 1. *) (* ------------------------------------------------------------------------- *) parse_as_infix("edge_of",(12, "right"));; let edge_of = new_definition `e edge_of s <=> e face_of s /\ aff_dim e = &1`;; let EDGE_OF_TRANSLATION_EQ = prove (`!a:real^N f s. (IMAGE (\x. a + x) f) edge_of (IMAGE (\x. a + x) s) <=> f edge_of s`, REWRITE_TAC[edge_of] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [EDGE_OF_TRANSLATION_EQ];; let EDGE_OF_LINEAR_IMAGE = prove (`!f:real^M->real^N c s. linear f /\ (!x y. f x = f y ==> x = y) ==> ((IMAGE f c) edge_of (IMAGE f s) <=> c edge_of s)`, REWRITE_TAC[edge_of] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [EDGE_OF_LINEAR_IMAGE];; let EDGE_OF_IMP_SUBSET = prove (`!s t. s edge_of t ==> s SUBSET t`, SIMP_TAC[edge_of; face_of]);; (* ------------------------------------------------------------------------- *) (* Existence of extreme points. *) (* ------------------------------------------------------------------------- *) let EXTREME_POINT_EXISTS_CONVEX = prove (`!s:real^N->bool. compact s /\ convex s /\ ~(s = {}) ==> ?x. x extreme_point_of s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN ASM_REWRITE_TAC[DIST_0; extreme_point_of] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `x:real^N`] DIFFERENT_NORM_3_COLLINEAR_POINTS) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `a <= x /\ b <= x /\ (a < x ==> x < x) /\ (b < x ==> x < x) ==> a = b /\ x = b`) THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN CONJ_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN MATCH_MP_TAC NORM_TRIANGLE_LT THEN REWRITE_TAC[NORM_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < u /\ u < &1 ==> abs u = u /\ abs(&1 - u) = &1 - u`] THEN SUBST1_TAC(REAL_RING `norm(x:real^N) = (&1 - u) * norm x + u * norm x`) THENL [MATCH_MP_TAC REAL_LTE_ADD2; MATCH_MP_TAC REAL_LET_ADD2] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LMUL_EQ; REAL_SUB_LT]);; (* ------------------------------------------------------------------------- *) (* Krein-Milman, the weaker form as in more general spaces first. *) (* ------------------------------------------------------------------------- *) let KREIN_MILMAN = prove (`!s:real^N->bool. convex s /\ compact s ==> s = closure(convex hull {x | x extreme_point_of s})`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[extreme_point_of; NOT_IN_EMPTY; EMPTY_GSPEC] THEN REWRITE_TAC[CONVEX_HULL_EMPTY; CLOSURE_EMPTY]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; extreme_point_of]] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`closure(convex hull {x:real^N | x extreme_point_of s})`; `u:real^N`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN ASM_SIMP_TAC[CONVEX_CLOSURE; CLOSED_CLOSURE; CONVEX_CONVEX_HULL] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. a dot x`; `s:real^N->bool`] CONTINUOUS_ATTAINS_INF) THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT] THEN DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `t = {x:real^N | x IN s /\ a dot x = a dot m}` THEN SUBGOAL_THEN `?x:real^N. x extreme_point_of t` (X_CHOOSE_TAC `v:real^N`) THENL [MATCH_MP_TAC EXTREME_POINT_EXISTS_CONVEX THEN EXPAND_TAC "t" THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; COMPACT_INTER_CLOSED; CLOSED_HYPERPLANE] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(v:real^N) extreme_point_of s` ASSUME_TAC THENL [REWRITE_TAC[GSYM FACE_OF_SING] THEN MATCH_MP_TAC FACE_OF_TRANS THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_SING] THEN EXPAND_TAC "t" THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN ASM_SIMP_TAC[real_ge]; SUBGOAL_THEN `(a:real^N) dot v > b` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN REWRITE_TAC[real_gt; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(a:real^N) dot u` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(a:real^N) dot m` THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `(v:real^N) extreme_point_of t` THEN EXPAND_TAC "t" THEN SIMP_TAC[extreme_point_of; IN_ELIM_THM; REAL_LE_REFL]]);; (* ------------------------------------------------------------------------- *) (* Now the sharper form. *) (* ------------------------------------------------------------------------- *) let KREIN_MILMAN_MINKOWSKI = prove (`!s:real^N->bool. convex s /\ compact s ==> s = convex hull {x | x extreme_point_of s}`, SUBGOAL_THEN `!s:real^N->bool. convex s /\ compact s /\ (vec 0) IN s ==> (vec 0) IN convex hull {x | x extreme_point_of s}` ASSUME_TAC THENL [GEN_TAC THEN WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN ASM_CASES_TAC `(vec 0:real^N) IN relative_interior s` THENL [MP_TAC(ISPEC `s:real^N->bool` KREIN_MILMAN) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `(vec 0:real^N) IN relative_interior s` THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [th]) THEN SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE; CONVEX_CONVEX_HULL] THEN MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` ASSUME_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`] SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY) THEN ASM_REWRITE_TAC[DOT_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `&0`] FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE) THEN ASM_REWRITE_TAC[real_ge] THEN DISCH_TAC THEN SUBGOAL_THEN `(vec 0:real^N) IN convex hull {x | x extreme_point_of (s INTER {x | a dot x = &0})}` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET] THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; GSYM FACE_OF_SING] THEN ASM_MESON_TAC[FACE_OF_TRANS]] THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; COMPACT_INTER_CLOSED; CLOSED_HYPERPLANE; IN_INTER; IN_ELIM_THM; DOT_RZERO] THEN REWRITE_TAC[GSYM NOT_LE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s INTER {x:real^N | a dot x = &0}`; `s:real^N->bool`] DIM_EQ_SPAN) THEN ASM_REWRITE_TAC[INTER_SUBSET; EXTENSION; NOT_FORALL_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `b /\ ~a ==> ~(a <=> b)`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; SPAN_INC; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN span (s INTER {x | a dot x = &0}) ==> a dot x = &0` (fun th -> ASM_MESON_TAC[th; REAL_LT_REFL]) THEN MATCH_MP_TAC SPAN_INDUCT THEN SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[subspace; DOT_RZERO; DOT_RADD; DOT_RMUL; IN_ELIM_THM] THEN CONV_TAC REAL_RING; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN ASM_SIMP_TAC[CONVEX_TRANSLATION_EQ; COMPACT_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[EXTREME_POINTS_OF_TRANSLATION; CONVEX_HULL_TRANSLATION] THEN REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN REWRITE_TAC[UNWIND_THM2]; MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[SUBSET; extreme_point_of; IN_ELIM_THM]]);; let KREIN_MILMAN_EQ = prove (`!s e:real^N->bool. compact s /\ convex s ==> (convex hull e = s <=> e SUBSET s /\ {x | x extreme_point_of s} SUBSET e)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [EXPAND_TAC "s" THEN REWRITE_TAC[HULL_SUBSET; EXTREME_POINTS_OF_CONVEX_HULL]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[]; TRANS_TAC SUBSET_TRANS `convex hull {x:real^N | x extreme_point_of s}` THEN ASM_SIMP_TAC[HULL_MONO] THEN ASM_MESON_TAC[KREIN_MILMAN_MINKOWSKI; SUBSET_REFL]]]);; (* ------------------------------------------------------------------------- *) (* Applying it to convex hulls of explicitly indicated finite sets. *) (* ------------------------------------------------------------------------- *) let KREIN_MILMAN_POLYTOPE = prove (`!s. FINITE s ==> convex hull s = convex hull {x | x extreme_point_of (convex hull s)}`, SIMP_TAC[KREIN_MILMAN_MINKOWSKI; CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT]);; let EXTREME_POINTS_OF_CONVEX_HULL_EQ = prove (`!s:real^N->bool. compact s /\ (!t. t PSUBSET s ==> ~(convex hull t = convex hull s)) ==> {x | x extreme_point_of (convex hull s)} = s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N | x extreme_point_of (convex hull s)}`) THEN MATCH_MP_TAC(SET_RULE `P /\ t SUBSET s ==> (t PSUBSET s ==> ~P) ==> t = s`) THEN REWRITE_TAC[EXTREME_POINTS_OF_CONVEX_HULL] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL]);; let EXTREME_POINT_OF_CONVEX_HULL_EQ = prove (`!s x:real^N. compact s /\ (!t. t PSUBSET s ==> ~(convex hull t = convex hull s)) ==> (x extreme_point_of (convex hull s) <=> x IN s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINTS_OF_CONVEX_HULL_EQ) THEN SET_TAC[]);; let EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT = prove (`!s x:real^N. compact s /\ (!a. a IN s ==> ~(a IN convex hull (s DELETE a))) ==> (x extreme_point_of (convex hull s) <=> x IN s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_EQ THEN ASM_REWRITE_TAC[PSUBSET_MEMBER] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^N`)) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `s SUBSET convex hull (s DELETE (a:real^N))` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull t:real^N->bool` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[HULL_SUBSET]; MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]]);; let EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove (`!s x. ~affine_dependent s ==> (x extreme_point_of (convex hull s) <=> x IN s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; FINITE_IMP_COMPACT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN MESON_TAC[SUBSET; CONVEX_HULL_SUBSET_AFFINE_HULL]);; let EXTREME_POINTS_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove (`!s:real^N->bool. ~affine_dependent s ==> {x | x extreme_point_of convex hull s} = s`, SIMP_TAC[EXTENSION; IN_ELIM_THM; EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT]);; let SIMPLEX_VERTICES_UNIQUE = prove (`!s t:real^N->bool. ~affine_dependent s /\ ~affine_dependent t /\ convex hull s = convex hull t ==> s = t`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN ASM_MESON_TAC[EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT]);; let EXTREME_POINT_OF_CONVEX_HULL_2 = prove (`!a b x. x extreme_point_of (convex hull {a,b}) <=> x = a \/ x = b`, REWRITE_TAC[SET_RULE `x = a \/ x = b <=> x IN {a,b}`] THEN SIMP_TAC[EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT; AFFINE_INDEPENDENT_2]);; let EXTREME_POINT_OF_SEGMENT = prove (`!a b x:real^N. x extreme_point_of segment[a,b] <=> x = a \/ x = b`, REWRITE_TAC[SEGMENT_CONVEX_HULL; EXTREME_POINT_OF_CONVEX_HULL_2]);; let FACE_OF_CONVEX_HULL_SUBSET = prove (`!s t:real^N->bool. compact s /\ t face_of (convex hull s) ==> ?s'. s' SUBSET s /\ t = convex hull s'`, REPEAT STRIP_TAC THEN EXISTS_TAC `{x:real^N | x extreme_point_of t}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL THEN ASM_MESON_TAC[FACE_OF_SING; FACE_OF_TRANS]; MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN ASM_MESON_TAC[FACE_OF_IMP_CONVEX; FACE_OF_IMP_COMPACT; COMPACT_CONVEX_HULL; CONVEX_CONVEX_HULL]]);; let FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove (`!s t:real^N->bool. ~affine_dependent s ==> (t face_of (convex hull s) <=> ?c. c SUBSET s /\ t = convex hull c)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE; FINITE_IMP_COMPACT; FACE_OF_CONVEX_HULL_SUBSET]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN MATCH_MP_TAC(SET_RULE ` !t. u SUBSET t /\ DISJOINT s t ==> DISJOINT s u`) THEN EXISTS_TAC `affine hull (s DIFF c:real^N->bool)` THEN REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN MATCH_MP_TAC DISJOINT_AFFINE_HULL THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]]);; let FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove (`!s t:real^N->bool. ~affine_dependent s ==> (t facet_of (convex hull s) <=> ~(t = {}) /\ ?u. u IN s /\ t = convex hull (s DELETE u))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[facet_of; FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN UNDISCH_TAC `aff_dim(convex hull c:real^N->bool) = aff_dim(s:real^N->bool) - &1` THEN SUBGOAL_THEN `~affine_dependent(c:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_INDEPENDENT_SUBSET]; ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; AFF_DIM_CONVEX_HULL]] THEN REWRITE_TAC[INT_ARITH `x - &1:int = y - &1 - &1 <=> y = x + &1`] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN DISCH_TAC THEN SUBGOAL_THEN `(s DIFF c:real^N->bool) HAS_SIZE 1` MP_TAC THENL [ASM_SIMP_TAC[HAS_SIZE; FINITE_DIFF; CARD_DIFF; AFFINE_INDEPENDENT_IMP_FINITE] THEN ARITH_TAC; CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s DIFF t = {a} ==> t SUBSET s ==> s = a INSERT t`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `CARD((u:real^N) INSERT c) = CARD c + 1` THEN ASM_SIMP_TAC[CARD_CLAUSES; AFFINE_INDEPENDENT_IMP_FINITE] THEN COND_CASES_TAC THENL [ARITH_TAC; DISCH_THEN(K ALL_TAC)] THEN CONJ_TAC THENL [ALL_TAC; AP_TERM_TAC] THEN ASM SET_TAC[]]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN CONJ_TAC THENL [MESON_TAC[DELETE_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[AFF_DIM_CONVEX_HULL] THEN SUBGOAL_THEN `~affine_dependent(s DELETE (u:real^N))` ASSUME_TAC THENL [ASM_MESON_TAC[AFFINE_INDEPENDENT_SUBSET; DELETE_SUBSET]; ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT]] THEN REWRITE_TAC[INT_ARITH `x - &1:int = y - &1 - &1 <=> y = x + &1`] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN ASM_SIMP_TAC[CARD_DELETE; AFFINE_INDEPENDENT_IMP_FINITE] THEN MATCH_MP_TAC(ARITH_RULE `~(s = 0) ==> s = s - 1 + 1`) THEN ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE] THEN ASM SET_TAC[]]);; let FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT = prove (`!s t:real^N->bool. ~affine_dependent s ==> (t facet_of (convex hull s) <=> 2 <= CARD s /\ ?u. u IN s /\ t = convex hull (s DELETE u))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:real^N` THEN ASM_CASES_TAC `t = convex hull (s DELETE (u:real^N))` THEN ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN ASM_CASES_TAC `(u:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `CARD s = 1 + CARD(s DELETE (u:real^N))` SUBST1_TAC THENL [ASM_SIMP_TAC[CARD_DELETE; AFFINE_INDEPENDENT_IMP_FINITE] THEN MATCH_MP_TAC(ARITH_RULE `~(s = 0) ==> s = 1 + s - 1`) THEN ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE] THEN ASM SET_TAC[]; REWRITE_TAC[ARITH_RULE `2 <= 1 + x <=> ~(x = 0)`] THEN ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE; FINITE_DELETE]]);; let SEGMENT_FACE_OF = prove (`!s a b:real^N. segment[a,b] face_of s ==> a extreme_point_of s /\ b extreme_point_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN MATCH_MP_TAC FACE_OF_TRANS THEN EXISTS_TAC `segment[a:real^N,b]` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FACE_OF_SING; EXTREME_POINT_OF_SEGMENT]);; let SEGMENT_EDGE_OF = prove (`!s a b:real^N. segment[a,b] edge_of s ==> ~(a = b) /\ a extreme_point_of s /\ b extreme_point_of s`, REPEAT GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[edge_of; SEGMENT_FACE_OF]] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[SEGMENT_REFL; edge_of; AFF_DIM_SING] THEN INT_ARITH_TAC);; let EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ = prove (`!s a x:real^N. FINITE s /\ ~(a IN affine hull s) ==> (x extreme_point_of (convex hull (a INSERT s)) <=> x = a \/ x extreme_point_of (convex hull s))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFFINE_HULL_CONVEX_HULL] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN ONCE_REWRITE_TAC[HULL_UNION_RIGHT] THEN MP_TAC(ISPEC `convex hull s:real^N->bool` KREIN_MILMAN_MINKOWSKI) THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN DISCH_THEN(MP_TAC o SPEC `{x:real^N | x extreme_point_of convex hull s}`) THEN REWRITE_TAC[EXTREME_POINTS_OF_CONVEX_HULL] THEN ABBREV_TAC `v = {x:real^N | x extreme_point_of (convex hull s)}` THEN DISCH_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [AFFINE_HULL_CONVEX_HULL]) THEN ASM_CASES_TAC `(a:real^N) IN v` THEN ASM_SIMP_TAC[HULL_INC] THEN STRIP_TAC THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN REWRITE_TAC[SET_RULE `{a} UNION s = a INSERT s`] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN ASM SET_TAC[]; STRIP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_INSERT THEN ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; REWRITE_TAC[GSYM FACE_OF_SING] THEN MATCH_MP_TAC FACE_OF_TRANS THEN EXISTS_TAC `convex hull v:real^N->bool` THEN ASM_REWRITE_TAC[FACE_OF_SING] THEN MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN ASM_SIMP_TAC[FINITE_INSERT; AFFINE_HULL_SING; CONVEX_HULL_SING; SET_RULE `~(a IN s) ==> a INSERT s DIFF s = {a}`] THEN ASM SET_TAC[]]]);; let FACE_OF_CONVEX_HULL_INSERT_EQ = prove (`!f s a:real^N. FINITE s /\ ~(a IN affine hull s) ==> (f face_of (convex hull (a INSERT s)) <=> f face_of (convex hull s) \/ ?f'. f' face_of (convex hull s) /\ f = convex hull (a INSERT f'))`, let lemma = prove (`!a b c p:real^N u v w x. x % p = u % a + v % b + w % c ==> !s. u + v + w = x /\ ~(x = &0) /\ affine s /\ a IN s /\ b IN s /\ c IN s ==> p IN s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv x):real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN EXISTS_TAC `affine hull {a:real^N,b,c}` THEN ASM_SIMP_TAC[HULL_MINIMAL; INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`inv x * u:real`; `inv x * v:real`; `inv x * w:real`] THEN REWRITE_TAC[] THEN UNDISCH_TAC `u + v + w:real = x` THEN UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD) in REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FACE_OF_CONVEX_HULL_SUBSET)) THEN ASM_SIMP_TAC[COMPACT_INSERT; FINITE_IMP_COMPACT] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_CASES_TAC `(a:real^N) IN t` THENL [ALL_TAC; DISJ1_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `convex hull ((a:real^N) INSERT s)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]] THEN DISJ2_TAC THEN EXISTS_TAC `(convex hull t) INTER (convex hull s):real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `convex hull ((a:real^N) INSERT s)` THEN SIMP_TAC[INTER_SUBSET; HULL_MONO; SET_RULE `s SUBSET (a INSERT s)`] THEN MATCH_MP_TAC FACE_OF_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_CONVEX_HULL_INSERT THEN ASM_REWRITE_TAC[FACE_OF_REFL_EQ; CONVEX_CONVEX_HULL]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN ASM_SIMP_TAC[INSERT_SUBSET; HULL_INC; INTER_SUBSET] THEN REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM_CASES_TAC `x:real^N = a` THEN ASM_REWRITE_TAC[IN_INSERT] THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL [MATCH_MP_TAC FACE_OF_CONVEX_HULL_INSERT THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(X_CHOOSE_THEN `f':real^N->bool` MP_TAC)] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THEN SPEC_TAC(`f':real^N->bool`,`f:real^N->bool`) THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [UNDISCH_TAC `(f:real^N->bool) face_of convex hull s` THEN ASM_SIMP_TAC[FACE_OF_EMPTY; CONVEX_HULL_EMPTY; FACE_OF_REFL_EQ] THEN REWRITE_TAC[CONVEX_CONVEX_HULL]; ALL_TAC] THEN ASM_CASES_TAC `f:real^N->bool = {}` THENL [ASM_REWRITE_TAC[CONVEX_HULL_SING; FACE_OF_SING] THEN MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_INSERT THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; ALL_TAC] THEN REWRITE_TAC[face_of; CONVEX_CONVEX_HULL] THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[INSERT_SUBSET; HULL_INC; IN_INSERT; CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull s:real^N->bool` THEN ASM_SIMP_TAC[HULL_MONO; SET_RULE `s SUBSET (a INSERT s)`] THEN ASM_MESON_TAC[FACE_OF_IMP_SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[CONVEX_HULL_INSERT_ALT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN X_GEN_TAC `ub:real` THEN STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN X_GEN_TAC `uc:real` THEN STRIP_TAC THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN X_GEN_TAC `ux:real` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN SUBGOAL_THEN `convex hull f:real^N->bool = f` SUBST_ALL_TAC THENL [ASM_MESON_TAC[CONVEX_HULL_EQ]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `v:real` MP_TAC)) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[VECTOR_ARITH `(&1 - ux) % a + ux % x:real^N = (&1 - v) % ((&1 - ub) % a + ub % b) + v % ((&1 - uc) % a + uc % c) <=> ((&1 - ux) - ((&1 - v) * (&1 - ub) + v * (&1 - uc))) % a + (ux % x - (((&1 - v) * ub) % b + (v * uc) % c)) = vec 0`] THEN ASM_CASES_TAC `&1 - ux - ((&1 - v) * (&1 - ub) + v * (&1 - uc)) = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_RING `(&1 - ux) - ((&1 - v) * (&1 - ub) + v * (&1 - uc)) = &0 ==> (&1 - v) * ub + v * uc = ux`)) THEN ASM_CASES_TAC `uc = &0` THENL [UNDISCH_THEN `uc = &0` SUBST_ALL_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH `a + v * &0 = b ==> b = a`)) THEN REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_LCANCEL; REAL_ENTIRE] THEN STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[VECTOR_MUL_LZERO]; ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH]; ALL_TAC] THEN ASM_CASES_TAC `ub = &0` THENL [UNDISCH_THEN `ub = &0` SUBST_ALL_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH `v * &0 + a = b ==> b = a`)) THEN REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_LCANCEL; REAL_ENTIRE] THEN STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[VECTOR_MUL_LZERO]; ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH]; ALL_TAC] THEN DISCH_THEN(fun th -> SUBGOAL_THEN `(b:real^N) IN f /\ (c:real^N) IN f` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC th) THEN ASM_CASES_TAC `ux = &0` THENL [DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `&1 - ux - a = &0 ==> ux = &0 ==> ~(a < &1)`)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(&1 - v) * &1 + v * &1` THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ w <= z /\ ~(x = y /\ w = z) ==> x + w < y + z`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_SUB_LT; REAL_EQ_MUL_LCANCEL] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[REAL_SUB_0; REAL_LT_IMP_NE] THEN REWRITE_TAC[REAL_ARITH `&1 - x = &1 <=> x = &0`] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN ASM_MESON_TAC[VECTOR_MUL_LZERO]; ALL_TAC] THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_CASES_TAC `c:real^N = b` THENL [ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LCANCEL] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `(v * uc) / ux:real` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < x`] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; EXPAND_TAC "ux" THEN REWRITE_TAC[REAL_ARITH `b < a + b <=> &0 < a`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv ux) :real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_ARITH `inv u * v * uc:real = (v * uc) / u`] THEN UNDISCH_TAC `(&1 - v) * ub + v * uc = ux` THEN UNDISCH_TAC `~(ux = &0)` THEN CONV_TAC REAL_FIELD]; DISCH_THEN(MP_TAC o MATCH_MP (VECTOR_ARITH `a + (b - c):real^N = vec 0 ==> a = c + --b`)) THEN REWRITE_TAC[GSYM VECTOR_ADD_ASSOC; GSYM VECTOR_MUL_LNEG] THEN DISCH_THEN(MP_TAC o SPEC `affine hull s:real^N->bool` o MATCH_MP lemma) THEN ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN CONJ_TAC THENL [CONV_TAC REAL_RING; REPEAT CONJ_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CONVEX_HULL_SUBSET_AFFINE_HULL) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let CONVEX_HULL_REDUNDANT_SUBSET_GEN = prove (`!s t:real^N->bool. compact s /\ t SUBSET s /\ DISJOINT (s DIFF t) {x | x extreme_point_of convex hull s} ==> convex hull s = convex hull t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[HULL_MONO] THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MP_TAC(ISPEC `s:real^N->bool` EXTREME_POINTS_OF_CONVEX_HULL) THEN DISCH_THEN(DISJ_CASES_TAC o SPEC `t:real^N->bool` o MATCH_MP (SET_RULE `e SUBSET s ==> !t. e SUBSET t \/ ~DISJOINT e (s DIFF t)`)) THENL [TRANS_TAC SUBSET_TRANS `convex hull s:real^N->bool` THEN REWRITE_TAC[HULL_SUBSET] THEN MP_TAC(ISPEC `convex hull s:real^N->bool` KREIN_MILMAN_MINKOWSKI) THEN ASM_SIMP_TAC[COMPACT_CONVEX_HULL; CONVEX_CONVEX_HULL] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[HULL_MONO]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(SET_RULE `~DISJOINT {x | P x} t ==> (!x. x IN t ==> ~P x) ==> Q`)) THEN ASM SET_TAC[]]);; let CONVEX_HULL_REDUNDANT_SUBSET = prove (`!s t:real^N->bool. compact s /\ t SUBSET s /\ s DIFF t SUBSET interior(convex hull s) ==> convex hull s = convex hull t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_HULL_REDUNDANT_SUBSET_GEN THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `convex hull s:real^N->bool` EXTREME_POINT_NOT_IN_INTERIOR) THEN ASM SET_TAC[]);; let CONVEX_HULL_REDUNDANT_SUBSET_REV = prove (`!s t:real^N->bool. convex hull s = convex hull t ==> DISJOINT (s DIFF t) {x | x extreme_point_of (convex hull s)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` EXTREME_POINTS_OF_CONVEX_HULL) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM SET_TAC[]);; let CONVEX_HULL_INSERT_REDUNDANT_POINT = prove (`!s a b c:real^N. a IN convex hull (c INSERT s) /\ b IN convex hull (c INSERT s) /\ c IN segment(a,b) ==> convex hull (c INSERT s) = convex hull s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_SIMP_TAC[CONVEX_HULL_SING; IN_SING] THEN MESON_TAC[ENDS_NOT_IN_SEGMENT]; DISCH_TAC] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[HULL_MONO; SET_RULE `s SUBSET x INSERT s`] THEN MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[CONVEX_CONVEX_HULL; INSERT_SUBSET; HULL_SUBSET] THEN FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)) THEN ASM_REWRITE_TAC[CONVEX_HULL_INSERT_ALT] THEN REWRITE_TAC[IN_SEGMENT; IN_ELIM_THM] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real`; `x:real^N`] THEN REPEAT DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`v:real`; `y:real^N`] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `w:real` THEN DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `c:real^N = (&1 - w) % ((&1 - u) % c + u % x) + w % ((&1 - v) % c + v % y) <=> (u - w * u) % x + (w * v) % y = ((u - w * u) + w * v) % c`] THEN SUBGOAL_THEN `&0 < u - w * u + w * v` ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `~((&1 - w) * u = &0 /\ w * v = &0) /\ &0 <= (&1 - w) * u /\ &0 <= w * v ==> &0 < u - w * u + w * v`) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE; REAL_ENTIRE] THEN ASM_CASES_TAC `u = &0 /\ v = &0` THENL [ASM_MESON_TAC[VECTOR_MUL_LZERO]; ASM_REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o AP_TERM `(%) (inv(u - w * u + w * v)):real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN SUBGOAL_THEN `inv(u - w * u + w * v) * (u - w * u) = &1 - inv(u - w * u + w * v) * w * v` SUBST1_TAC THENL [UNDISCH_TAC `&0 < u - w * u + w * v` THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC IN_CONVEX_SET] THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN REWRITE_TAC[REAL_ARITH `w * v <= &1 * (u - w * u + w * v) <=> &0 <= (&1 - w) * u`] THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE]);; let CONVEX_HULL_REDUNDANT_POINT = prove (`!s a:real^N. convex hull (s DELETE a) = convex hull s <=> ~(a extreme_point_of convex hull s)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `a extreme_point_of convex hull s ==> {x | x extreme_point_of convex hull s} SUBSET s ==> a IN s`)) THEN REWRITE_TAC[EXTREME_POINTS_OF_CONVEX_HULL; IN_DELETE]; DISJ_CASES_TAC(SET_RULE `s DELETE (a:real^N) = s \/ a IN s`) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `t = s DELETE (a:real^N)` THEN SUBGOAL_THEN `s = (a:real^N) INSERT t` SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[extreme_point_of]] THEN SIMP_TAC[HULL_INC; IN_INSERT] THEN DISCH_TAC THEN MATCH_MP_TAC(GSYM CONVEX_HULL_INSERT_REDUNDANT_POINT) THEN ASM_MESON_TAC[]]);; let HAUSDIST_FRONTIERS_CONVEX = prove (`!s t:real^N->bool. convex s /\ convex t /\ bounded s /\ bounded t ==> hausdist(frontier s,frontier t) = hausdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_LE_REFL] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; FRONTIER_EMPTY; REAL_LE_REFL] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT2 HAUSDIST_CLOSURE)] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 HAUSDIST_CLOSURE)] THEN SUBGOAL_THEN `closure(frontier s):real^N->bool = frontier(closure s) /\ closure(frontier t):real^N->bool = frontier(closure t)` (CONJUNCTS_THEN SUBST1_TAC) THENL [ASM_SIMP_TAC[FRONTIER_CLOSURE_CONVEX] THEN SIMP_TAC[CLOSURE_CLOSED; FRONTIER_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `compact(closure s:real^N->bool) /\ compact(closure t:real^N->bool) /\ convex(closure s:real^N->bool) /\ convex(closure t:real^N->bool) /\ ~(closure s = {}) /\ ~(closure t = {})` MP_TAC THENL [ASM_SIMP_TAC[COMPACT_CLOSURE; CONVEX_CLOSURE; CLOSURE_EQ_EMPTY]; POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN REPEAT STRIP_TAC] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; MP_TAC(ISPECL [`frontier s:real^N->bool`; `frontier t:real^N->bool`] HAUSDIST_CONVEX_HULLS) THEN ASM_SIMP_TAC[GSYM KREIN_MILMAN_FRONTIER; COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_FRONTIER]] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_MESON_TAC[NOT_BOUNDED_UNIV]; ALL_TAC]) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `hausdist(s:real^N->bool,t)`] REAL_HAUSDIST_LE_EQ) THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN STRIP_TAC THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THENL [ALL_TAC; ONCE_REWRITE_TAC[DISJ_SYM] THEN REPEAT(POP_ASSUM MP_TAC) THEN ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN SPEC_TAC(`y:real^N`,`x:real^N`) THEN SPEC_TAC(`t:real^N->bool`,`t:real^N->bool`) THEN SPEC_TAC(`s:real^N->bool`,`s:real^N->bool`) THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `s:real^N->bool`] THEN REPEAT STRIP_TAC] THEN (ASM_CASES_TAC `(x:real^N) IN frontier t` THENL [EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; SETDIST_POS_LE] THEN UNDISCH_TAC `(x:real^N) IN frontier s` THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN ASM_SIMP_TAC[CLOSURE_CLOSED]; ALL_TAC] THEN ASM_CASES_TAC `(x:real^N) IN t` THENL [ALL_TAC; EXISTS_TAC `x:real^N` THEN ASM_SIMP_TAC[SETDIST_SING_FRONTIER; REAL_LE_REFL] THEN UNDISCH_TAC `(x:real^N) IN frontier s` THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN ASM_SIMP_TAC[CLOSURE_CLOSED]] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SUPPORTING_HYPERPLANE_FRONTIER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`t:real^N->bool`; `x:real^N`; `--a:real^N`] RAY_TO_FRONTIER) THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN ANTS_TAC THENL [UNDISCH_TAC `~((x:real^N) IN frontier t)` THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED]; DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `x + d % --a:real^N` THEN DISJ2_TAC THEN CONJ_TAC THENL [UNDISCH_TAC `(x + d % --a:real^N) IN frontier t` THEN ASM_SIMP_TAC[frontier; IN_DIFF; CLOSURE_CLOSED; COMPACT_IMP_CLOSED]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,x + d % --a)` THEN CONJ_TAC THENL [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `setdist({x + d % --a:real^N},{y | a dot x <= a dot y})` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC SETDIST_SUBSET_RIGHT THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN REWRITE_TAC[NOT_INSERT_EMPTY] THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; IN_SING; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + a) = norm a`] THEN MP_TAC(ISPECL [`a:real^N`; `y - (x + d % --a):real^N`] NORM_CAUCHY_SCHWARZ) THEN REWRITE_TAC[DOT_RSUB; DOT_RADD; DOT_RNEG; ONCE_REWRITE_RULE[DIST_SYM] dist; DOT_RMUL] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `ay - (ax + d * --a) <= b ==> ax <= ay ==> d * a <= b`)) THEN ASM_REWRITE_TAC[GSYM NORM_POW_2; NORM_MUL; NORM_NEG] THEN REWRITE_TAC[REAL_ARITH `(d * a pow 2):real = a * d * a`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; NORM_POS_LT] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE]));; (* ------------------------------------------------------------------------- *) (* If we perturb a set little enough, a point stays inside or outside it. *) (* The "inside" needs convexity in general or we could just remove a *) (* thin path to the point without changing the Hausdorff distance at all. *) (* ------------------------------------------------------------------------- *) let HAUSDIST_STILL_OUTSIDE = prove (`!s t x:real^N. bounded s /\ bounded t /\ hausdist(s,t) < setdist({x},s) ==> ~(x IN t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; SETDIST_EMPTY; REAL_LT_REFL] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN ASM_MESON_TAC[REAL_HAUSDIST_LE_EQ; REAL_LE_REFL]);; let HAUSDIST_STILL_INSIDE = prove (`!s t x:real^N. bounded s /\ bounded t /\ convex s /\ convex t /\ ~(t = {}) /\ hausdist(s,t) < setdist({x},(:real^N) DIFF s) ==> x IN t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`; `setdist({x},(:real^N) DIFF s)`; `x:real^N`] HAUSDIST_COMPLEMENTS_CONVEX_EXPLICIT) THEN ASM_REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM; DE_MORGAN_THM; REAL_NOT_LT] THEN CONJ_TAC THENL [ASM_MESON_TAC[HAUSDIST_SYM]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `(y:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]);; let HAUSDIST_STILL_INSIDE_INTERIOR = prove (`!s t x:real^N. bounded s /\ bounded t /\ convex s /\ convex t /\ ~(t = {}) /\ hausdist(s,t) < setdist({x},(:real^N) DIFF s) ==> x IN interior t`, REPEAT STRIP_TAC THEN REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `setdist({x},(:real^N) DIFF s) - hausdist(s:real^N->bool,t)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC HAUSDIST_STILL_INSIDE THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d < f - h ==> f <= d + g ==> h < g`)) THEN REWRITE_TAC[GSYM SETDIST_SINGS; SETDIST_TRIANGLE]);; let HAUSDIST_STILL_NONEMPTY_INTERIOR = prove (`!s:real^N->bool. bounded s /\ convex s /\ ~(interior s = {}) ==> ?e. &0 < e /\ !s'. bounded s' /\ convex s' /\ ~(s' = {}) /\ hausdist(s,s') < e ==> ~(interior s' = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTERIOR] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a:real^N` THEN MATCH_MP_TAC HAUSDIST_STILL_INSIDE_INTERIOR THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ; IN_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; REAL_NOT_LE] THEN ASM_REWRITE_TAC[GSYM IN_BALL; GSYM SUBSET] THEN REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN ASM_MESON_TAC[NOT_BOUNDED_UNIV]);; let HAUSDIST_STILL_SAME_PLACE_STRONG = prove (`!s t x:real^N. bounded s /\ bounded t /\ convex s /\ convex t /\ ~(t = {}) /\ hausdist(s,t) < setdist({x},frontier s) ==> ~(x IN frontier s) /\ ~(x IN frontier t) /\ (x IN t <=> x IN s)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~((x:real^N) IN frontier s)` ASSUME_TAC THENL [ASM_MESON_TAC[SETDIST_SING_IN_SET; REAL_NOT_LT; HAUSDIST_POS_LE]; ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [frontier]) THEN REWRITE_TAC[IN_DIFF; DE_MORGAN_THM] THEN STRIP_TAC THENL [MP_TAC(ISPECL [`closure s:real^N->bool`; `closure t:real^N->bool`; `x:real^N`] HAUSDIST_STILL_OUTSIDE) THEN ASM_SIMP_TAC[HAUSDIST_CLOSURE; BOUNDED_CLOSURE; SETDIST_CLOSURE] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < a ==> a = b ==> x < b`)) THEN MATCH_MP_TAC(CONJUNCT2 SETDIST_FRONTIER); REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET)] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; SUBGOAL_THEN `(x:real^N) IN interior t` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[frontier; IN_DIFF; REWRITE_RULE[SUBSET] INTERIOR_SUBSET]] THEN REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `setdist({x:real^N},frontier s) - hausdist(s:real^N->bool,t)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC HAUSDIST_STILL_INSIDE THEN EXISTS_TAC `interior s:real^N->bool` THEN ASM_SIMP_TAC[BOUNDED_INTERIOR; CONVEX_INTERIOR] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `d < f - h ==> h' = h /\ f <= d + g ==> h' < g`)) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM(CONJUNCT1 HAUSDIST_CLOSURE)] THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN MATCH_MP_TAC CONVEX_CLOSURE_INTERIOR THEN ASM SET_TAC[]; TRANS_TAC REAL_LE_TRANS `setdist({x},(:real^N) DIFF interior s)` THEN REWRITE_TAC[GSYM SETDIST_SINGS; SETDIST_TRIANGLE] THEN REWRITE_TAC[GSYM CLOSURE_COMPLEMENT; SETDIST_CLOSURE] THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(CONJUNCT2 SETDIST_FRONTIER) THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN SET_TAC[]]]);; let HAUSDIST_STILL_SAME_PLACE = prove (`!s t x:real^N. bounded s /\ bounded t /\ convex s /\ convex t /\ ~(t = {}) /\ hausdist(s,t) < setdist({x},frontier s) ==> (x IN t <=> x IN s)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAUSDIST_STILL_SAME_PLACE_STRONG) THEN MESON_TAC[]);; let HAUSDIST_STILL_SAME_PLACE_CONIC_HULL_STRONG = prove (`!s x:real^N. convex s /\ bounded s /\ ~(s = {}) /\ ~(vec 0 IN closure s) /\ ~(x = vec 0) /\ ~(x IN frontier(conic hull s)) ==> ?e. &0 < e /\ !s'. convex s' /\ bounded s' /\ ~(s' = {}) /\ hausdist(s,s') < e ==> ~(x IN frontier(conic hull s')) /\ (x IN conic hull s' <=> x IN conic hull s)`, let lemma = prove (`!a x:real^N s. convex s /\ &0 < a /\ ~(x = vec 0) /\ ~(s = {}) /\ a * norm(x) < setdist({vec 0},s) ==> (x IN conic hull s <=> a % x IN convex hull (vec 0 INSERT s))`, ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[MESON[HULL_HULL; CONVEX_CONVEX_HULL; HULL_P] `(!s. convex s ==> p s) <=> (!s. p (convex hull s))`] THEN REWRITE_TAC[GSYM HULL_INSERT; CONVEX_HULL_EQ_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_INSERT_ALT] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IN_ELIM_THM] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real`; `y:real^N`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `a * u:real`; EXISTS_TAC `inv(a) * u:real`] THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC] THENL [ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `norm(y:real^N)` THEN CONJ_TAC THENL[ASM_MESON_TAC[NORM_POS_LT; VECTOR_MUL_EQ_0]; ALL_TAC] THEN REWRITE_TAC[GSYM NORM_MUL; GSYM VECTOR_MUL_ASSOC] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[NORM_MUL; real_abs; REAL_LT_IMP_LE; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ONCE_REWRITE_TAC[NORM_ARITH `norm(x:real^N) = dist(vec 0,x)`] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]; ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_MUL; REAL_LT_IMP_LE] THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv a):real^N->real^N`) THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; REAL_LT_IMP_NZ]]) in let clemma = prove (`!a x:real^N s. convex s /\ bounded s /\ ~(vec 0 IN closure s) /\ &0 < a /\ ~(x = vec 0) /\ ~(s = {}) /\ a * norm(x) < setdist({vec 0},s) ==> (x IN closure(conic hull s) <=> a % x IN closure(convex hull (vec 0 INSERT s)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real`; `x:real^N`; `closure s:real^N->bool`] lemma) THEN ASM_SIMP_TAC[SETDIST_CLOSURE; CLOSURE_EQ_EMPTY; CONVEX_CLOSURE] THEN ASM_SIMP_TAC[CLOSURE_CONIC_HULL] THEN ASM_SIMP_TAC[GSYM CONVEX_HULL_CLOSURE; BOUNDED_INSERT; CLOSURE_INSERT]) in let ilemma = prove (`!a x:real^N s. convex s /\ &0 < a /\ ~(x = vec 0) /\ ~(s = {}) /\ a * norm(x) < setdist({vec 0},s) ==> (x IN interior(conic hull s) <=> a % x IN interior(convex hull (vec 0 INSERT s)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[IN_INTERIOR] THEN SUBGOAL_THEN `?d. &0 < d /\ !y. y IN ball(x:real^N,d) ==> a * norm y < setdist({vec 0:real^N},s)` STRIP_ASSUME_TAC THENL [EXISTS_TAC `setdist({vec 0:real^N},s) / a - norm(x:real^N)` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; IN_BALL; REAL_LT_SUB_LADD] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; X_GEN_TAC `y:real^N`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC(MESON[] `(!e. &0 < e <=> &0 < a * e) /\ (!e. &0 < e <=> &0 < e / a) /\ (!e. a * e / a = e) /\ (!d e. a * d <= a * e <=> d <= e) /\ ((!d e. d <= e ==> P e ==> P d) /\ (!d e. d <= e ==> Q e ==> Q d)) /\ (!e. &0 < e ==> ?d. &0 < d /\ d <= e /\ (P d <=> Q(a * d))) ==> ((?e. &0 < e /\ P e) <=> (?e. &0 < e /\ Q e))`) THEN ASM_SIMP_TAC[BALL_SCALING; REAL_LT_MUL_EQ; REAL_LE_LMUL_EQ; REAL_LT_IMP_NZ; REAL_LT_RDIV_EQ; REAL_MUL_LZERO; REAL_DIV_LMUL] THEN CONJ_TAC THENL [MESON_TAC[SUBSET_BALL; SUBSET_TRANS]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN EXISTS_TAC `min d (min e (norm(x:real^N)))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LE; REAL_LE_REFL; NORM_POS_LT] THEN MATCH_MP_TAC (MESON[] `(!x. P x ==> (Q x <=> R x)) ==> ((!x. P x ==> Q x) <=> (!x. P x ==> R x))`) THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[BALL_MIN_INTER; IN_INTER] THEN STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `y IN ball(x:real^N,norm x)` THEN REWRITE_TAC[IN_BALL] THEN CONV_TAC NORM_ARITH]) in let flemma = prove (`!a x:real^N s. convex s /\ bounded s /\ ~(vec 0 IN closure s) /\ &0 < a /\ ~(x = vec 0) /\ ~(s = {}) /\ a * norm(x) < setdist({vec 0},s) ==> (x IN frontier(conic hull s) <=> a % x IN frontier(convex hull (vec 0 INSERT s)))`, REWRITE_TAC[frontier; IN_DIFF] THEN SIMP_TAC[GSYM ilemma; GSYM clemma]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < setdist({vec 0:real^N},s)` ASSUME_TAC THENL [REWRITE_TAC[REAL_LT_LE; SETDIST_POS_LE] THEN ASM_MESON_TAC[SETDIST_EQ_0_SING]; ALL_TAC] THEN SUBGOAL_THEN `?a d. &0 < a /\ &0 < d /\ a * norm(x:real^N) < setdist({vec 0:real^N},s) /\ !s'. convex s' /\ bounded s' /\ ~(s' = {}) /\ hausdist(s,s') < d ==> a * norm(x) < setdist({vec 0:real^N},s')` STRIP_ASSUME_TAC THENL [EXISTS_TAC `setdist({vec 0:real^N},s) / &2 / norm(x:real^N)` THEN EXISTS_TAC `setdist({vec 0:real^N},s) / &2` THEN ASM_SIMP_TAC[REAL_HALF; REAL_DIV_RMUL; REAL_LT_IMP_NZ; NORM_POS_LT; REAL_LT_DIV; REAL_ARITH `x / &2 < x <=> &0 < x`] THEN X_GEN_TAC `s':real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`{vec 0:real^N}`; `s':real^N->bool`; `s:real^N->bool`] SETDIST_HAUSDIST_TRIANGLE) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `min (min d (setdist({vec 0:real^N},s))) (setdist({a % x:real^N},frontier (convex hull (vec 0 INSERT s))))` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[SETDIST_POS_LE; SETDIST_EQ_0_SING] THEN SIMP_TAC[CLOSURE_CLOSED; FRONTIER_CLOSED; FRONTIER_EQ_EMPTY] THEN ASM_SIMP_TAC[GSYM flemma; HAUSDIST_REFL] THEN SIMP_TAC[CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN ASM_MESON_TAC[BOUNDED_CONVEX_HULL; BOUNDED_INSERT; NOT_BOUNDED_UNIV]; ALL_TAC] THEN X_GEN_TAC `s':real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`convex hull ((vec 0:real^N) INSERT s)`; `convex hull ((vec 0:real^N) INSERT s')`; `a % x:real^N`] HAUSDIST_STILL_SAME_PLACE_STRONG) THEN ASM_REWRITE_TAC[CONVEX_CONVEX_HULL; BOUNDED_CONVEX_HULL_EQ; BOUNDED_INSERT; CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN W(MP_TAC o PART_MATCH (lhand o rand) HAUSDIST_CONVEX_HULLS o lhand o snd) THEN ASM_SIMP_TAC[BOUNDED_INSERT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN W(MP_TAC o PART_MATCH (lhand o rand) HAUSDIST_INSERT_LE o lhand o snd) THEN ASM_SIMP_TAC[BOUNDED_INSERT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`a:real`; `x:real^N`] lemma) THEN ASM_SIMP_TAC[HAUSDIST_REFL] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(MP_TAC o el 1 o CONJUNCTS) THEN MP_TAC(ISPECL [`a:real`; `x:real^N`; `s':real^N->bool`] flemma) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN MATCH_MP_TAC HAUSDIST_STILL_OUTSIDE THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[BOUNDED_CLOSURE_EQ; HAUSDIST_CLOSURE]);; let HAUSDIST_STILL_SAME_PLACE_CONIC_HULL = prove (`!s x:real^N. convex s /\ bounded s /\ ~(s = {}) /\ ~(vec 0 IN closure s) /\ ~(x IN frontier(conic hull s)) ==> ?e. &0 < e /\ !s'. convex s' /\ bounded s' /\ ~(s' = {}) /\ hausdist(s,s') < e ==> (x IN conic hull s' <=> x IN conic hull s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_SIMP_TAC[CONIC_HULL_CONTAINS_0] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN SUBGOAL_THEN `&0 < setdist({vec 0:real^N},s)` ASSUME_TAC THENL [REWRITE_TAC[REAL_LT_LE; SETDIST_POS_LE] THEN ASM_MESON_TAC[SETDIST_EQ_0_SING]; MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] HAUSDIST_STILL_SAME_PLACE_CONIC_HULL_STRONG) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]]);; let CONVEX_SYMDIFF_CLOSE_TO_FRONTIER = prove (`!s t:real^N->bool e. bounded s /\ convex s /\ ~(s = {}) /\ bounded t /\ convex t /\ ~(t = {}) /\ hausdist(s,t) < e ==> (s DIFF t) UNION (t DIFF s) SUBSET {u + v:real^N | u IN frontier s /\ v IN ball(vec 0,e)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `x:real^N`] HAUSDIST_STILL_SAME_PLACE) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `e:real` o MATCH_MP (REAL_ARITH `a <= b ==> !c. b < c ==> a < c`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] REAL_SETDIST_LT_EXISTS))) THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; FRONTIER_EQ_EMPTY] THEN ANTS_TAC THENL [ASM_MESON_TAC[NOT_BOUNDED_UNIV]; ALL_TAC] THEN REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `x - u:real^N` THEN ASM_REWRITE_TAC[IN_BALL_0; GSYM dist] THEN CONV_TAC VECTOR_ARITH);; (* ------------------------------------------------------------------------- *) (* Polytopes. *) (* ------------------------------------------------------------------------- *) let polytope = new_definition `polytope s <=> ?v. FINITE v /\ s = convex hull v`;; let POLYTOPE_TRANSLATION_EQ = prove (`!a s. polytope (IMAGE (\x:real^N. a + x) s) <=> polytope s`, REWRITE_TAC[polytope] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [POLYTOPE_TRANSLATION_EQ];; let POLYTOPE_LINEAR_IMAGE = prove (`!f:real^M->real^N p. linear f /\ polytope p ==> polytope(IMAGE f p)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[polytope] THEN DISCH_THEN(X_CHOOSE_THEN `s:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; FINITE_IMAGE]);; let POLYTOPE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> (polytope (IMAGE f s) <=> polytope s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[polytope] THEN MP_TAC(ISPEC `f:real^M->real^N` QUANTIFY_SURJECTION_THM) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)[th]) THEN MP_TAC(end_itlist CONJ (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; let POLYTOPE_EMPTY = prove (`polytope {}`, REWRITE_TAC[polytope] THEN MESON_TAC[FINITE_EMPTY; CONVEX_HULL_EMPTY]);; let POLYTOPE_NEGATIONS = prove (`!s:real^N->bool. polytope s ==> polytope(IMAGE (--) s)`, SIMP_TAC[POLYTOPE_LINEAR_IMAGE; LINEAR_NEGATION]);; let POLYTOPE_CONVEX_HULL = prove (`!s. FINITE s ==> polytope(convex hull s)`, REWRITE_TAC[polytope] THEN MESON_TAC[]);; let POLYTOPE_SEGMENT = prove (`!a b:real^N. polytope(segment[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN EXISTS_TAC `{a:real^N,b}` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY]);; let POLYTOPE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. polytope s /\ polytope t ==> polytope(s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN MESON_TAC[CONVEX_HULL_PCROSS; FINITE_PCROSS]);; let POLYTOPE_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. polytope(s PCROSS t) <=> s = {} \/ t = {} \/ polytope s /\ polytope t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; POLYTOPE_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; POLYTOPE_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[POLYTOPE_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] POLYTOPE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] POLYTOPE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let FACE_OF_POLYTOPE_POLYTOPE = prove (`!f s:real^N->bool. polytope s /\ f face_of s ==> polytope f`, REWRITE_TAC[polytope] THEN MESON_TAC[FINITE_SUBSET; FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);; let FINITE_POLYTOPE_FACES = prove (`!s:real^N->bool. polytope s ==> FINITE {f | f face_of s}`, GEN_TAC THEN REWRITE_TAC[polytope; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE ((hull) convex) {t:real^N->bool | t SUBSET v}` THEN ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);; let FINITE_POLYTOPE_FACETS = prove (`!s:real^N->bool. polytope s ==> FINITE {f | f facet_of s}`, REWRITE_TAC[facet_of] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN SIMP_TAC[FINITE_RESTRICT; FINITE_POLYTOPE_FACES]);; let POLYTOPE_INTERVAL = prove (`!a b. polytope(interval[a,b])`, REWRITE_TAC[polytope] THEN MESON_TAC[CLOSED_INTERVAL_AS_CONVEX_HULL]);; let POLYTOPE_SING = prove (`!a. polytope {a}`, MESON_TAC[POLYTOPE_INTERVAL; INTERVAL_SING]);; let POLYTOPE_SCALING = prove (`!c s:real^N->bool. polytope s ==> polytope (IMAGE (\x. c % x) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN DISCH_THEN (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\x:real^N. c % x) u` THEN ASM_SIMP_TAC[CONVEX_HULL_SCALING; FINITE_IMAGE]);; let POLYTOPE_SCALING_EQ = prove (`!s:real^N->bool c. polytope (IMAGE (\x. c % x) s) <=> c = &0 \/ polytope s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[POLYTOPE_SING; POLYTOPE_EMPTY]; EQ_TAC THEN REWRITE_TAC[POLYTOPE_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP POLYTOPE_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let POLYTOPE_AFFINITY_EQ = prove (`!s m c:real^N. polytope (IMAGE (\x. m % x + c) s) <=> m = &0 \/ polytope s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; POLYTOPE_TRANSLATION_EQ; POLYTOPE_SCALING_EQ; IMAGE_o]);; let POLYTOPE_AFFINITY = prove (`!s m c:real^N. polytope s ==> polytope (IMAGE (\x. m % x + c) s)`, SIMP_TAC[POLYTOPE_AFFINITY_EQ]);; let POLYTOPE_SUMS = prove (`!s t:real^N->bool. polytope s /\ polytope t ==> polytope {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `{x + y:real^N | x IN u /\ y IN v}` THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; CONVEX_HULL_SUMS]);; let POLYTOPE_IMP_COMPACT = prove (`!s. polytope s ==> compact s`, SIMP_TAC[polytope; LEFT_IMP_EXISTS_THM; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]);; let POLYTOPE_IMP_CONVEX = prove (`!s. polytope s ==> convex s`, SIMP_TAC[polytope; LEFT_IMP_EXISTS_THM; CONVEX_CONVEX_HULL]);; let POLYTOPE_IMP_CLOSED = prove (`!s. polytope s ==> closed s`, SIMP_TAC[POLYTOPE_IMP_COMPACT; COMPACT_IMP_CLOSED]);; let POLYTOPE_IMP_BOUNDED = prove (`!s. polytope s ==> bounded s`, SIMP_TAC[POLYTOPE_IMP_COMPACT; COMPACT_IMP_BOUNDED]);; let POLYTOPE_1 = prove (`!s:real^1->bool. polytope s <=> ?a b. s = interval[a,b]`, MESON_TAC[IS_INTERVAL_COMPACT; POLYTOPE_IMP_COMPACT; POLYTOPE_IMP_CONVEX; IS_INTERVAL_CONVEX_1; POLYTOPE_INTERVAL]);; let POLYTOPE_AFF_DIM_1 = prove (`!p:real^N->bool. polytope p /\ aff_dim p = &1 <=> ?a b. ~(a = b) /\ p = segment[a,b]`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[POLYTOPE_SEGMENT; AFF_DIM_SEGMENT] THEN MP_TAC(ISPEC `p:real^N->bool` COMPACT_CONVEX_COLLINEAR_SEGMENT) THEN ASM_SIMP_TAC[COLLINEAR_AFF_DIM; INT_LE_REFL] THEN ASM_SIMP_TAC[POLYTOPE_IMP_COMPACT; POLYTOPE_IMP_CONVEX] THEN UNDISCH_TAC `aff_dim(p:real^N->bool) = &1` THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN DISCH_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL] THEN ASM_MESON_TAC[AFF_DIM_SING; INT_ARITH `~(&1:int = &0)`]);; let FACE_OF_POLYTOPE_INSERT_EQ = prove (`!f s a:real^N. polytope s /\ ~(a IN affine hull s) ==> (f face_of convex hull (a INSERT s) <=> f face_of s \/ (?f'. f' face_of s /\ f = convex hull (a INSERT f')))`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; polytope] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `z INSERT i = {z} UNION i`] THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN REWRITE_TAC[SET_RULE `{z} UNION i = z INSERT i`] THEN MP_TAC(ISPECL [`f:real^N->bool`; `c:real^N->bool`; `a:real^N`] FACE_OF_CONVEX_HULL_INSERT_EQ) THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Approximation of bounded convex sets by polytopes. *) (* ------------------------------------------------------------------------- *) let CONVEX_INNER_APPROXIMATION = prove (`!s:real^N->bool e. bounded s /\ convex s /\ &0 < e ==> ?k. FINITE k /\ convex hull k SUBSET s /\ hausdist(convex hull k,s) < e /\ (k = {} ==> s = {})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_SIMP_TAC[FINITE_EMPTY; CONVEX_HULL_EMPTY; HAUSDIST_REFL; SUBSET_REFL]; ALL_TAC] THEN MP_TAC(ISPEC `closure s:real^N->bool` COMPACT_EQ_HEINE_BOREL) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `{ball(x:real^N,e / &2) | x IN s}`) THEN REWRITE_TAC[FORALL_IN_GSPEC; OPEN_BALL] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[IN_BALL; REAL_HALF]; ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN ASM_CASES_TAC `k:real^N->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; SUBSET_EMPTY; CLOSURE_EQ_EMPTY] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[HULL_MINIMAL]; DISCH_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 < e ==> x <= e / &2 ==> x < e`)) THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN UNDISCH_TAC `closure s SUBSET UNIONS (IMAGE (\x:real^N. ball (x,e / &2)) k)` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_SIMP_TAC[IN_SING; HULL_INC]);; let CONVEX_OUTER_APPROXIMATION = prove (`!s:real^N->bool e. bounded s /\ convex s /\ &0 < e ==> ?k. FINITE k /\ s SUBSET convex hull k /\ hausdist(convex hull k,s) < e`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; HAUSDIST_EMPTY; CONVEX_HULL_EMPTY]; ALL_TAC] THEN MP_TAC(ISPECL [`{x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)}`; `e / &2`] CONVEX_INNER_APPROXIMATION) THEN ASM_SIMP_TAC[CONVEX_SUMS; CONVEX_BALL; BOUNDED_SUMS; BOUNDED_BALL] THEN ASM_REWRITE_TAC[REAL_HALF; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[REAL_NOT_LE] (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] REAL_LE_HAUSDIST))) THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; RIGHT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; LEFT_FORALL_IMP_THM] THEN ASM_REWRITE_TAC[REAL_HALF; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT; FORALL_AND_THM] THEN ANTS_TAC THENL [EXISTS_TAC `hausdist(convex hull k, {x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)})` THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL]; ALL_TAC] THEN ANTS_TAC THENL [EXISTS_TAC `hausdist(convex hull k, {x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)})` THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL]; REWRITE_TAC[TAUT `~p \/ q <=> p ==> q`] THEN DISCH_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_SUMS_RCANCEL THEN EXISTS_TAC `ball(vec 0:real^N,e / &2)` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; CONVEX_CONVEX_HULL; BALL_EQ_EMPTY; BOUNDED_BALL; REAL_NOT_LE] THEN ASM_REWRITE_TAC[REAL_HALF; SUBSET] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] REAL_SETDIST_LT_EXISTS))) THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; CONVEX_HULL_EQ_EMPTY; IN_SING] THEN REWRITE_TAC[IN_BALL_0; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `z - y:real^N` THEN ASM_REWRITE_TAC[GSYM dist] THEN CONV_TAC VECTOR_ARITH; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&0 < e ==> x <= e / &2 ==> x < e`)) THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = z + y <=> x - z = y`] THEN REWRITE_TAC[UNWIND_THM1; IN_BALL_0; GSYM dist] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_LT_IMP_LE]] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `x:real^N` THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[REAL_HALF; VECTOR_ADD_RID]]]);; let CONVEX_INNER_POLYTOPE = prove (`!s:real^N->bool e. bounded s /\ convex s /\ &0 < e ==> ?p. polytope p /\ p SUBSET s /\ hausdist(p,s) < e /\ (p = {} ==> s = {})`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC o MATCH_MP CONVEX_INNER_APPROXIMATION) THEN EXISTS_TAC `convex hull k:real^N->bool` THEN ASM_SIMP_TAC[CONVEX_HULL_EQ_EMPTY; POLYTOPE_CONVEX_HULL]);; let CONVEX_OUTER_POLYTOPE = prove (`!s:real^N->bool e. bounded s /\ convex s /\ &0 < e ==> ?p. polytope p /\ s SUBSET p /\ hausdist(p,s) < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC o MATCH_MP CONVEX_OUTER_APPROXIMATION) THEN EXISTS_TAC `convex hull k:real^N->bool` THEN ASM_SIMP_TAC[CONVEX_HULL_EQ_EMPTY; POLYTOPE_CONVEX_HULL]);; (* ------------------------------------------------------------------------- *) (* Polyhedra. *) (* ------------------------------------------------------------------------- *) let polyhedron = new_definition `polyhedron s <=> ?f. FINITE f /\ s = INTERS f /\ (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x | a dot x <= b})`;; let POLYHEDRON_INTER = prove (`!s t:real^N->bool. polyhedron s /\ polyhedron t ==> polyhedron (s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[polyhedron] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f:(real^N->bool)->bool`) (X_CHOOSE_TAC `g:(real^N->bool)->bool`)) THEN EXISTS_TAC `f UNION g:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[SET_RULE `INTERS(f UNION g) = INTERS f INTER INTERS g`] THEN REWRITE_TAC[FINITE_UNION; IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);; let POLYHEDRON_UNIV = prove (`polyhedron(:real^N)`, REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN REWRITE_TAC[INTERS_0; NOT_IN_EMPTY; FINITE_RULES]);; let POLYHEDRON_POSITIVE_ORTHANT = prove (`polyhedron {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`, REWRITE_TAC[polyhedron] THEN EXISTS_TAC `IMAGE (\i. {x:real^N | &0 <= x$i}) (1..dimindex(:N))` THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[INTERS_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG]; X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`--basis k:real^N`; `&0`] THEN ASM_SIMP_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; DOT_BASIS; BASIS_NONZERO] THEN REWRITE_TAC[REAL_ARITH `--x <= &0 <=> &0 <= x`]]);; let POLYHEDRON_INTERS = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> polyhedron s) ==> polyhedron(INTERS f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; POLYHEDRON_UNIV] THEN ASM_SIMP_TAC[INTERS_INSERT; FORALL_IN_INSERT; POLYHEDRON_INTER]);; let POLYHEDRON_EMPTY = prove (`polyhedron({}:real^N->bool)`, REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{{x:real^N | basis 1 dot x <= -- &1}, {x | --(basis 1) dot x <= -- &1}}` THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; INTERS_2; FORALL_IN_INSERT] THEN REWRITE_TAC[NOT_IN_EMPTY; INTER; IN_ELIM_THM; DOT_LNEG] THEN REWRITE_TAC[REAL_ARITH `~(a <= -- &1 /\ --a <= -- &1)`; EMPTY_GSPEC] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`basis 1:real^N`; `-- &1`]; MAP_EVERY EXISTS_TAC [`--(basis 1):real^N`; `-- &1`]] THEN SIMP_TAC[VECTOR_NEG_EQ_0; BASIS_NONZERO; DOT_LNEG; DIMINDEX_GE_1; LE_REFL]);; let POLYHEDRON_HALFSPACE_LE = prove (`!a b. polyhedron {x:real^N | a dot x <= b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[POLYHEDRON_EMPTY; POLYHEDRON_UNIV]; REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{{x:real^N | a dot x <= b}}` THEN REWRITE_TAC[FINITE_SING; INTERS_1; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM_REWRITE_TAC[]]);; let POLYHEDRON_HALFSPACE_GE = prove (`!a b. polyhedron {x:real^N | a dot x >= b}`, REWRITE_TAC[REAL_ARITH `a:real >= b <=> --a <= --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; POLYHEDRON_HALFSPACE_LE]);; let POLYHEDRON_HYPERPLANE = prove (`!a b. polyhedron {x:real^N | a dot x = b}`, REWRITE_TAC[REAL_ARITH `x:real = b <=> x <= b /\ x >= b`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[POLYHEDRON_INTER; POLYHEDRON_HALFSPACE_LE; POLYHEDRON_HALFSPACE_GE]);; let AFFINE_IMP_POLYHEDRON = prove (`!s:real^N->bool. affine s ==> polyhedron s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES) THEN ASM_SIMP_TAC[HULL_P; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC POLYHEDRON_INTERS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[POLYHEDRON_HYPERPLANE]);; let POLYHEDRON_IMP_CLOSED = prove (`!s:real^N->bool. polyhedron s ==> closed s`, REWRITE_TAC[polyhedron; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_INTERS THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[CLOSED_HALFSPACE_LE]);; let POLYHEDRON_IMP_CONVEX = prove (`!s:real^N->bool. polyhedron s ==> convex s`, REWRITE_TAC[polyhedron; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_INTERS THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[CONVEX_HALFSPACE_LE]);; let POLYHEDRON_AFFINE_HULL = prove (`!s. polyhedron(affine hull s)`, SIMP_TAC[AFFINE_IMP_POLYHEDRON; AFFINE_AFFINE_HULL]);; (* ------------------------------------------------------------------------- *) (* Canonical polyedron representation making facial structure explicit. *) (* ------------------------------------------------------------------------- *) let POLYHEDRON_INTER_AFFINE = prove (`!s. polyhedron s <=> ?f. FINITE f /\ s = (affine hull s) INTER (INTERS f) /\ (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b})`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[polyhedron] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN MATCH_MP_TAC(SET_RULE `s = t /\ s SUBSET u ==> s = u INTER t`) THEN REWRITE_TAC[HULL_SUBSET] THEN ASM_REWRITE_TAC[]; STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POLYHEDRON_INTER THEN REWRITE_TAC[POLYHEDRON_AFFINE_HULL] THEN MATCH_MP_TAC POLYHEDRON_INTERS THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[POLYHEDRON_HALFSPACE_LE]]);; let POLYHEDRON_INTER_AFFINE_PARALLEL = prove (`!s:real^N->bool. polyhedron s <=> ?f. FINITE f /\ s = (affine hull s) INTER (INTERS f) /\ (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b} /\ (!x. x IN affine hull s ==> (x + a) IN affine hull s))`, GEN_TAC THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN EQ_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_SIMP_TAC[AFFINE_HULL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY; FINITE_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; INTER_UNIV] THEN DISCH_THEN(ASSUME_TAC o SYM o CONJUNCT2) THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; INTER_UNIV; FINITE_EMPTY]; ALL_TAC] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN MAP_EVERY X_GEN_TAC [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `!h. h IN f /\ ~(affine hull s SUBSET h) ==> ?a' b'. ~(a' = vec 0) /\ affine hull s INTER {x:real^N | a' dot x <= b'} = affine hull s INTER h /\ !w. w IN affine hull s ==> (w + a') IN affine hull s` MP_TAC THENL [GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN REWRITE_TAC[ASSUME `(h:real^N->bool) IN f`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC o GSYM) THEN MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(a:(real^N->bool)->real^N) h`; `(b:(real^N->bool)->real) h`] AFFINE_PARALLEL_SLICE) THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC(TAUT `~p /\ ~q /\ (r ==> r') ==> (p \/ q \/ r ==> r')`) THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_TAC THEN UNDISCH_TAC `~(s:real^N->bool = {})` THEN EXPAND_TAC "s" THEN REWRITE_TAC[GSYM INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ INTERS t = {} ==> INTERS s = {}`) THEN EXISTS_TAC `{affine hull s,h:real^N->bool}` THEN ASM_REWRITE_TAC[INTERS_2] THEN ASM SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `{}:real^N->bool`) THEN MAP_EVERY X_GEN_TAC [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (\h:real^N->bool. {x:real^N | a h dot x <= b h}) {h | h IN f /\ ~(affine hull s SUBSET h)}` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `h:real^N->bool` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(a:(real^N->bool)->real^N) h`; `(b:(real^N->bool)->real) h`] THEN ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[INTERS_IMAGE; IN_INTER; IN_ELIM_THM] THEN ASM_CASES_TAC `(x:real^N) IN affine hull s` THEN ASM_REWRITE_TAC[IN_INTERS] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM SET_TAC[]);; let POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL = prove (`!s. polyhedron s <=> ?f. FINITE f /\ s = (affine hull s) INTER (INTERS f) /\ (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b} /\ (!x. x IN affine hull s ==> (x + a) IN affine hull s)) /\ !f'. f' PSUBSET f ==> s PSUBSET (affine hull s) INTER (INTERS f')`, GEN_TAC THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE_PARALLEL] THEN EQ_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [MESON[HAS_SIZE] `(?f. FINITE f /\ P f) <=> (?n f. f HAS_SIZE n /\ P f)`] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[HAS_SIZE] THEN X_GEN_TAC `f:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(f':(real^N->bool)->bool)`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CARD_PSUBSET]; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM; HAS_SIZE] THEN DISCH_THEN(MP_TAC o SPEC `f':(real^N->bool)->bool`) THEN MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN CONJ_TAC THENL [ASM_MESON_TAC[PSUBSET; FINITE_SUBSET]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = t) ==> s PSUBSET t`) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN ASM SET_TAC[]]);; let POLYHEDRON_INTER_AFFINE_MINIMAL = prove (`!s. polyhedron s <=> ?f. FINITE f /\ s = (affine hull s) INTER (INTERS f) /\ (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b}) /\ !f'. f' PSUBSET f ==> s PSUBSET (affine hull s) INTER (INTERS f')`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL]; REWRITE_TAC[POLYHEDRON_INTER_AFFINE]] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN MESON_TAC[]);; let RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT = prove (`!s:real^N->bool f a b. FINITE f /\ s = affine hull s INTER INTERS f /\ (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') ==> relative_interior s = {x | x IN s /\ !h. h IN f ==> a h dot x < b h}`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR; IN_ELIM_THM] THEN EXISTS_TAC `INTERS {interior h | (h:real^N->bool) IN f}` THEN ASM_SIMP_TAC[SIMPLE_IMAGE; OPEN_INTERS; FINITE_IMAGE; OPEN_INTERIOR; FORALL_IN_IMAGE; IN_INTERS] THEN CONJ_TAC THENL [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o CONJUNCT2) THEN ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; IN_ELIM_THM]; FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN MATCH_MP_TAC(SET_RULE `(!s. s IN f ==> i s SUBSET s) ==> INTERS (IMAGE i f) INTER t SUBSET t INTER INTERS f`) THEN REWRITE_TAC[INTERIOR_SUBSET]]] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (i:real^N->bool)`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[PSUBSET_ALT; IN_INTER; IN_INTERS; IN_DELETE]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot z > b i` ASSUME_TAC THENL [UNDISCH_TAC `~((z:real^N) IN s)` THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN ASM_REWRITE_TAC[REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(z:real^N = x)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?l. &0 < l /\ l < &1 /\ (l % z + (&1 - l) % x:real^N) IN s` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(X_CHOOSE_THEN `e:real` MP_TAC o CONJUNCT2) THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; dist] THEN STRIP_TAC THEN EXISTS_TAC `min (&1 / &2) (e / &2 / norm(z - x:real^N))` THEN REWRITE_TAC[REAL_MIN_LT; REAL_LT_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `x - (l % z + (&1 - l) % x):real^N = --l % (z - x)`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NEG] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 < b /\ b < c ==> abs(min a b) < c`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN REWRITE_TAC[REAL_LT_01; real_div; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&1 - l` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REWRITE_TAC[REAL_ARITH `a < b * (&1 - l) <=> l * b + a < b`] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `l * (a:(real^N->bool)->real^N) i dot z + (a i dot x) * (&1 - l)` THEN ASM_SIMP_TAC[REAL_LT_RADD; REAL_LT_LMUL_EQ; GSYM real_gt] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * (&1 - b) = (&1 - b) * a`] THEN REWRITE_TAC[GSYM DOT_RMUL; GSYM DOT_RADD] THEN ASM SET_TAC[]);; let FACET_OF_POLYHEDRON_EXPLICIT = prove (`!s:real^N->bool f a b. FINITE f /\ s = affine hull s INTER INTERS f /\ (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') ==> !c. c facet_of s <=> ?h. h IN f /\ c = s INTER {x | a h dot x = b h}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[INTER_EMPTY; AFFINE_HULL_EMPTY; SET_RULE `~(s PSUBSET s)`; FACET_OF_EMPTY] THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `h:real^N->bool`) THEN DISCH_THEN (MP_TAC o SPEC `f DELETE (h:real^N->bool)` o last o CONJUNCTS) THEN ASM SET_TAC[]; STRIP_TAC] THEN SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN SUBGOAL_THEN `!h:real^N->bool. h IN f ==> (s INTER {x:real^N | a h dot x = b h}) facet_of s` (LABEL_TAC "face") THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[facet_of] THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN CONJ_TAC THENL [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `f DELETE (h:real^N->bool)`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[PSUBSET_ALT; IN_INTER; IN_INTERS; IN_DELETE]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot z > b h` ASSUME_TAC THENL [UNDISCH_TAC `~((z:real^N) IN s)` THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN ASM_REWRITE_TAC[REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(z:real^N = x)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `h:real^N->bool` th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASSUME_TAC th) THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot x < a h dot z` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `l = (b h - (a:(real^N->bool)->real^N) h dot x) / (a h dot z - a h dot x)` THEN SUBGOAL_THEN `&0 < l /\ l < &1` STRIP_ASSUME_TAC THENL [EXPAND_TAC "l" THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `w:real^N = (&1 - l) % x + l % z:real^N` THEN SUBGOAL_THEN `!i. i IN f /\ ~(i = h) ==> (a:(real^N->bool)->real^N) i dot w < b i` ASSUME_TAC THENL [X_GEN_TAC `i:real^N->bool` THEN STRIP_TAC THEN EXPAND_TAC "w" THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `(&1 - l) * x < (&1 - l) * z /\ l * y <= l * z ==> (&1 - l) * x + l * y < z`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_IMP_LE; REAL_LT_LMUL_EQ; REAL_SUB_LT] THEN UNDISCH_TAC `!t:real^N->bool. t IN f /\ ~(t = h) ==> z IN t` THEN DISCH_THEN(MP_TAC o SPEC `i:real^N->bool`) THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot w = b h` ASSUME_TAC THENL [EXPAND_TAC "w" THEN REWRITE_TAC[VECTOR_ARITH `(&1 - l) % x + l % z:real^N = x + l % (z - x)`] THEN EXPAND_TAC "l" THEN REWRITE_TAC[DOT_RADD; DOT_RSUB; DOT_RMUL] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NE; REAL_SUB_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(w:real^N) IN s` ASSUME_TAC THENL [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN CONJ_TAC THENL [EXPAND_TAC "w" THEN MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `i:real^N->bool = h` THENL [ASM SET_TAC[REAL_LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `convex(i:real^N->bool)` MP_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(i:real^N->bool) IN f`))) THEN REPEAT(DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th])) THEN REWRITE_TAC[CONVEX_HALFSPACE_LE]; ALL_TAC] THEN REWRITE_TAC[CONVEX_ALT] THEN EXPAND_TAC "w" THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1) THEN FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN SUBGOAL_THEN `affine hull (s INTER {x | (a:(real^N->bool)->real^N) h dot x = b h}) = (affine hull s) INTER {x | a h dot x = b h}` SUBST1_TAC THENL [ALL_TAC; SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFFINE_AFFINE_HULL] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN COND_CASES_TAC THENL [ASM SET_TAC[REAL_LT_REFL]; REFL_TAC]] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; MATCH_MP_TAC(SET_RULE `s SUBSET affine hull t /\ affine hull t = t ==> s SUBSET t`) THEN REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_HYPERPLANE] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `?t. &0 < t /\ !j. j IN f /\ ~(j:real^N->bool = h) ==> t * (a j dot y - a j dot w) <= b j - a j dot (w:real^N)` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `f DELETE (h:real^N->bool) = {}` THENL [ASM_REWRITE_TAC[GSYM IN_DELETE; NOT_IN_EMPTY] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]; ALL_TAC] THEN EXISTS_TAC `inf (IMAGE (\j. if &0 < a j dot y - a j dot (w:real^N) then (b j - a j dot w) / (a j dot y - a j dot w) else &1) (f DELETE (h:real^N->bool)))` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_DELETE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_DELETE] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_SUB_LT; REAL_LT_01; COND_ID]; REWRITE_TAC[REAL_SUB_LT] THEN DISCH_TAC] THEN X_GEN_TAC `j:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `a j dot (w:real^N) < a(j:real^N->bool) dot y` THENL [ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_INF_LE_FINITE; REAL_SUB_LT; FINITE_IMAGE; FINITE_DELETE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `j:real^N->bool` THEN ASM_REWRITE_TAC[IN_DELETE; REAL_LE_REFL]; MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ &0 < y ==> x <= y`) THEN ASM_SIMP_TAC[REAL_SUB_LT; GSYM REAL_MUL_RNEG; REAL_LE_MUL_EQ] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN ABBREV_TAC `c:real^N = (&1 - t) % w + t % y` THEN SUBGOAL_THEN `y:real^N = (&1 - inv t) % w + inv(t) % c` SUBST1_TAC THENL [EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_FIELD `&0 < x ==> inv x * (&1 - x) = inv x - &1`] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [EXPAND_TAC "c" THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RING; DISCH_TAC] THEN FIRST_ASSUM(fun t -> GEN_REWRITE_TAC RAND_CONV [t]) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN CONJ_TAC THENL [EXPAND_TAC "c" THEN MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN ASM_SIMP_TAC[HULL_INC]; ALL_TAC] THEN X_GEN_TAC `j:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o C MATCH_MP (ASSUME `(j:real^N->bool) IN f`)) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `j:real^N->bool = h` THEN ASM_SIMP_TAC[REAL_EQ_IMP_LE] THEN EXPAND_TAC "c" THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN REWRITE_TAC[REAL_ARITH `(&1 - t) * x + t * y <= z <=> t * (y - x) <= z - x`] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^N->bool` THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[]] THEN REWRITE_TAC[facet_of] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `~(c:real^N->bool = s)` ASSUME_TAC THENL [ASM_MESON_TAC[INT_ARITH`~(i:int = i - &1)`]; ALL_TAC] THEN SUBGOAL_THEN `~((x:real^N) IN relative_interior s)` ASSUME_TAC THENL [UNDISCH_TAC `~(c:real^N->bool = s)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN s` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN STRIP_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real^N->bool` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot x = b i` ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x <= y /\ ~(x < y) ==> x = y`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `!t:real^N->bool. t IN f ==> x IN t` (MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP (ASSUME `(i:real^N->bool) IN f`)) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `c SUBSET (s INTER {x:real^N | a(i:real^N->bool) dot x = b i})` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]; ALL_TAC] THEN SUBGOAL_THEN `c face_of (s INTER {x:real^N | a(i:real^N->bool) dot x = b i})` ASSUME_TAC THENL [MP_TAC(ISPECL [`c:real^N->bool`; `s:real^N->bool`; `s INTER {x:real^N | a(i:real^N->bool) dot x = b i}`] FACE_OF_FACE) THEN RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `aff_dim(c:real^N->bool) < aff_dim(s INTER {x:real^N | a(i:real^N->bool) dot x = b i})` MP_TAC THENL [MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE]; RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[INT_LT_REFL]]);; let FACE_OF_POLYHEDRON_SUBSET_EXPLICIT = prove (`!s:real^N->bool f a b. FINITE f /\ s = affine hull s INTER INTERS f /\ (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') ==> !c. c face_of s /\ ~(c = {}) /\ ~(c = s) ==> ?h. h IN f /\ c SUBSET (s INTER {x | a h dot x = b h})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [DISCH_THEN(MP_TAC o SYM o CONJUNCT1 o CONJUNCT2) THEN ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; AFFINE_HULL_EQ] THEN MESON_TAC[FACE_OF_AFFINE_TRIVIAL]; ALL_TAC] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP FACET_OF_POLYHEDRON_EXPLICIT) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN SUBGOAL_THEN `!h:real^N->bool. h IN f ==> (s INTER {x:real^N | a h dot x = b h}) face_of s` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN CONJ_TAC THENL [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `~((x:real^N) IN relative_interior s)` ASSUME_TAC THENL [UNDISCH_TAC `~(c:real^N->bool = s)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN s` MP_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP FACE_OF_IMP_SUBSET) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN STRIP_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real^N->bool` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot x = b i` ASSUME_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x <= y /\ ~(x < y) ==> x = y`) THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `!t:real^N->bool. t IN f ==> x IN t` (MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP (ASSUME `(i:real^N->bool) IN f`)) THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]);; let FACE_OF_POLYHEDRON_EXPLICIT = prove (`!s:real^N->bool f a b. FINITE f /\ s = affine hull s INTER INTERS f /\ (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') ==> !c. c face_of s /\ ~(c = {}) /\ ~(c = s) ==> c = INTERS {s INTER {x | a h dot x = b h} |h| h IN f /\ c SUBSET (s INTER {x | a h dot x = b h})}`, let lemma = prove (`!t s. (!a. P a ==> t SUBSET s INTER INTERS {f x | P x}) ==> t SUBSET INTERS {s INTER f x | P x}`, ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP FACET_OF_POLYHEDRON_EXPLICIT) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN SUBGOAL_THEN `!h:real^N->bool. h IN f ==> (s INTER {x:real^N | a h dot x = b h}) face_of s` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN CONJ_TAC THENL [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(z:real^N) IN s` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_INTERS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACE_OF_POLYHEDRON_SUBSET_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL[FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `{s INTER {x | a(h:real^N->bool) dot x = b h} |h| h IN f /\ c SUBSET (s INTER {x:real^N | a h dot x = b h})} = {s INTER {x | a(h:real^N->bool) dot x = b h} |h| h IN f /\ z IN s INTER {x:real^N | a h dot x = b h}}` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x. P x <=> Q x) ==> {f x | P x} = {f x | Q x}`) THEN X_GEN_TAC `h:real^N->bool` THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]]; ALL_TAC] THEN REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `?e. &0 < e /\ !h. h IN f /\ a(h:real^N->bool) dot z < b h ==> ball(z,e) SUBSET {w:real^N | a h dot w < b h}` (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THENL [REWRITE_TAC[SET_RULE `(!h. P h ==> s SUBSET t h) <=> s SUBSET INTERS (IMAGE t {h | P h})`] THEN MATCH_MP_TAC(MESON[OPEN_CONTAINS_BALL] `open s /\ x IN s ==> ?e. &0 < e /\ ball(x,e) SUBSET s`) THEN SIMP_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MATCH_MP_TAC OPEN_INTERS THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_RESTRICT] THEN REWRITE_TAC[OPEN_HALFSPACE_LT]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN ASM_SIMP_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_ELIM_THM; IN_INTER] THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma THEN X_GEN_TAC `i:real^N->bool` THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [th]) THEN MATCH_MP_TAC(SET_RULE `ae SUBSET as /\ ae SUBSET hs /\ b INTER hs SUBSET fs ==> (b INTER ae) SUBSET (as INTER fs) INTER hs`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_GSPEC] THEN ASM SET_TAC[]; SIMP_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `j:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN X_GEN_TAC `j:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) j dot z <= b j` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[REAL_LE_LT]] THEN STRIP_TAC THENL [ASM SET_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(?s. s IN f /\ s SUBSET t) ==> u INTER INTERS f SUBSET t`) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `j:real^N->bool` THEN ASM SET_TAC[REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* More general corollaries from the explicit representation. *) (* ------------------------------------------------------------------------- *) let FACET_OF_POLYHEDRON = prove (`!s:real^N->bool c. polyhedron s /\ c facet_of s ==> ?a b. ~(a = vec 0) /\ s SUBSET {x | a dot x <= b} /\ c = s INTER {x | a dot x = b}`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `i:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(a:(real^N->bool)->real^N) i` THEN EXISTS_TAC `(b:(real^N->bool)->real) i` THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> (s INTER t) SUBSET u`) THEN MATCH_MP_TAC(SET_RULE `t IN f ==> INTERS f SUBSET t`) THEN ASM_MESON_TAC[]);; let FACE_OF_POLYHEDRON = prove (`!s:real^N->bool c. polyhedron s /\ c face_of s /\ ~(c = {}) /\ ~(c = s) ==> c = INTERS {f | f facet_of s /\ c SUBSET f}`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACE_OF_POLYHEDRON_EXPLICIT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]);; let FACE_OF_POLYHEDRON_SUBSET_FACET = prove (`!s:real^N->bool c. polyhedron s /\ c face_of s /\ ~(c = {}) /\ ~(c = s) ==> ?f. f facet_of s /\ c SUBSET f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`] FACE_OF_POLYHEDRON) THEN ASM_CASES_TAC `{f:real^N->bool | f facet_of s /\ c SUBSET f} = {}` THEN ASM SET_TAC[]);; let FACE_OF_POLYHEDRON_FACE_OF_FACET = prove (`!s c:real^N->bool. polyhedron s /\ c face_of s /\ ~(c = {}) /\ ~(c = s) ==> ?f. c face_of f /\ f facet_of s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`] FACE_OF_POLYHEDRON_SUBSET_FACET) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACET_OF_IMP_SUBSET]);; let EXPOSED_FACE_OF_POLYHEDRON = prove (`!s f:real^N->bool. polyhedron s ==> (f exposed_face_of s <=> f face_of s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [SIMP_TAC[exposed_face_of]; ALL_TAC] THEN DISCH_TAC THEN ASM_CASES_TAC `f:real^N->bool = {}` THEN ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF] THEN ASM_CASES_TAC `f:real^N->bool = s` THEN ASM_SIMP_TAC[EXPOSED_FACE_OF_REFL; POLYHEDRON_IMP_CONVEX] THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] FACE_OF_POLYHEDRON) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC EXPOSED_FACE_OF_INTERS THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[FACE_OF_POLYHEDRON_SUBSET_FACET; IN_ELIM_THM] THEN ASM_SIMP_TAC[exposed_face_of; FACET_OF_IMP_FACE_OF] THEN ASM_MESON_TAC[FACET_OF_POLYHEDRON]);; let FACE_OF_POLYHEDRON_POLYHEDRON = prove (`!s:real^N->bool c. polyhedron s /\ c face_of s ==> polyhedron c`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACE_OF_POLYHEDRON_EXPLICIT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `c:real^N->bool = {}` THEN ASM_REWRITE_TAC[POLYHEDRON_EMPTY] THEN ASM_CASES_TAC `c:real^N->bool = s` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC POLYHEDRON_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_ID] THEN MATCH_MP_TAC POLYHEDRON_INTER THEN ASM_REWRITE_TAC[POLYHEDRON_HYPERPLANE]);; let FINITE_POLYHEDRON_FACES = prove (`!s:real^N->bool. polyhedron s ==> FINITE {f | f face_of s}`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[FINITE_DELETE] `!a b. FINITE (s DELETE a DELETE b) ==> FINITE s`) THEN MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `s:real^N->bool`] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{INTERS {s INTER {x:real^N | a(h:real^N->bool) dot x = b h} | h | h IN f'} |f'| f' SUBSET f}` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_DELETE; IN_ELIM_THM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACE_OF_POLYHEDRON_EXPLICIT) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `{h:real^N->bool | h IN f /\ c SUBSET s INTER {x:real^N | a h dot x = b h}}` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_ASSUM ACCEPT_TAC);; let FINITE_POLYHEDRON_EXPOSED_FACES = prove (`!s:real^N->bool. polyhedron s ==> FINITE {f | f exposed_face_of s}`, SIMP_TAC[EXPOSED_FACE_OF_POLYHEDRON; FINITE_POLYHEDRON_FACES]);; let FINITE_POLYHEDRON_EXTREME_POINTS = prove (`!s:real^N->bool. polyhedron s ==> FINITE {v | v extreme_point_of s}`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN ONCE_REWRITE_TAC[SET_RULE `{v} face_of s <=> {v} IN {f | f face_of s}`] THEN MATCH_MP_TAC FINITE_FINITE_PREIMAGE THEN ASM_SIMP_TAC[FINITE_POLYHEDRON_FACES] THEN X_GEN_TAC `f:real^N->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `!a:real^N. ~({a} = f)` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `{v | {v} = {a}} = {a}`; FINITE_SING]);; let FINITE_POLYHEDRON_FACETS = prove (`!s:real^N->bool. polyhedron s ==> FINITE {f | f facet_of s}`, REWRITE_TAC[facet_of] THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN SIMP_TAC[FINITE_RESTRICT; FINITE_POLYHEDRON_FACES]);; let RELATIVE_INTERIOR_OF_POLYHEDRON = prove (`!s:real^N->bool. polyhedron s ==> relative_interior s = s DIFF UNIONS {f | f facet_of s}`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> P x \/ x IN t) /\ (!x. x IN t ==> ~P x) ==> {x | x IN s /\ P x} = s DIFF t`) THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ASM_REWRITE_TAC[UNWIND_THM2; IN_ELIM_THM; IN_INTER] THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> Q x \/ R x) ==> (!x. P x ==> Q x) \/ (?x. P x /\ R x)`) THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_LT] THEN SUBGOAL_THEN `(x:real^N) IN INTERS f` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` MP_TAC THENL [ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN SET_TAC[]]; X_GEN_TAC `h:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN X_GEN_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_REFL]]);; let RELATIVE_BOUNDARY_OF_POLYHEDRON = prove (`!s:real^N->bool. polyhedron s ==> s DIFF relative_interior s = UNIONS {f | f facet_of s}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_OF_POLYHEDRON] THEN MATCH_MP_TAC(SET_RULE `f SUBSET s ==> s DIFF (s DIFF f) = f`) THEN REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[FACET_OF_IMP_SUBSET; SUBSET]);; let RELATIVE_FRONTIER_OF_POLYHEDRON = prove (`!s:real^N->bool. polyhedron s ==> relative_frontier s = UNIONS {f | f facet_of s}`, SIMP_TAC[relative_frontier; POLYHEDRON_IMP_CLOSED; CLOSURE_CLOSED] THEN REWRITE_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON]);; let RELATIVE_FRONTIER_OF_POLYHEDRON_ALT = prove (`!s:real^N->bool. polyhedron s ==> relative_frontier s = UNIONS {f | f face_of s /\ ~(f = s)}`, ASM_SIMP_TAC[RELATIVE_FRONTIER_OF_CONVEX_CLOSED; POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX]);; let FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT = prove (`!s:real^N->bool f a b. FINITE f /\ s = affine hull s INTER INTERS f /\ (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') ==> !h1 h2. h1 IN f /\ h2 IN f /\ s INTER {x | a h1 dot x = b h1} = s INTER {x | a h2 dot x = b h2} ==> h1 = h2`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[AFFINE_HULL_EMPTY; INTER_EMPTY; PSUBSET_IRREFL] THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_MESON_TAC[SET_RULE `~(s = {}) ==> {} PSUBSET s`]; STRIP_TAC] THEN SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYHEDRON_IMP_CONVEX]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC)] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ANTS_TAC THENL [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[PSUBSET_ALT]] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `x:real^N` MP_TAC)) THEN REWRITE_TAC[IN_INTER; IN_INTERS; IN_DELETE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`segment[x:real^N,z]`; `s:real^N->bool`] CONNECTED_INTER_RELATIVE_FRONTIER) THEN PURE_REWRITE_TAC[relative_frontier] THEN ANTS_TAC THENL [REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; AFFINE_AFFINE_HULL; HULL_INC; AFFINE_IMP_CONVEX]; EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[IN_INTER; ENDS_IN_SEGMENT]; EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_DIFF; ENDS_IN_SEGMENT]]; ALL_TAC] THEN PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; CLOSURE_CLOSED; LEFT_IMP_EXISTS_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[IN_DIFF] th) THEN MP_TAC th) THEN ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON] THEN MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN ANTS_TAC THENL [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th])] THEN REWRITE_TAC[SET_RULE `{y | ?x. x IN s /\ y = f x} = IMAGE f s`] THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?k:real^N->bool. k IN f /\ ~(k = h2) /\ a k dot (y:real^N) = b k` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `h:real^N->bool = h2` THENL [EXISTS_TAC `h1:real^N->bool` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `s INTER {x:real^N | a(h1:real^N->bool) dot x = b h1} = s INTER {x | a h2 dot x = b h2}` THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ASM_MESON_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(a:(real^N->bool)->real^N) k dot z < b k /\ a k dot x <= b k` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `y IN segment(x:real^N,z)` MP_TAC THENL [ASM_REWRITE_TAC[IN_OPEN_SEGMENT_ALT] THEN ASM_MESON_TAC[]; REWRITE_TAC[IN_SEGMENT] THEN STRIP_TAC] THEN UNDISCH_TAC `(a:(real^N->bool)->real^N) k dot y = b k` THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `(&1 - u) * x <= (&1 - u) * b /\ u * y < u * b ==> ~((&1 - u) * x + u * y = b)`) THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_SUB_LT]);; let POLYHEDRON_MINIMAL_LEMMA = prove (`!f s:real^N->bool. FINITE f /\ affine hull s INTER INTERS f = s ==> ?f'. FINITE f' /\ f' SUBSET f /\ affine hull s INTER INTERS f' = s /\ (!f''. f'' PSUBSET f' ==> s PSUBSET affine hull s INTER INTERS f'')`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(f:(real^N->bool)->bool)` THEN STRIP_TAC THEN ASM_CASES_TAC `!f'. f' PSUBSET f ==> (s:real^N->bool) PSUBSET affine hull s INTER INTERS f'` THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `f':(real^N->bool)->bool`) THEN ASM_SIMP_TAC[CARD_PSUBSET] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; PSUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ ~(t PSUBSET s) ==> s = t`) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC SUBSET_TRANS `affine hull s INTER INTERS f:real^N->bool` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUBSET_REFL]; ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]]);; let POLYHEDRON = prove (`!s. polyhedron s <=> ?f. FINITE f /\ affine hull s INTER INTERS f = s /\ (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') /\ (!h. h IN f ==> (?a:real^N b. ~(a = vec 0) /\ h = {x | a dot x <= b}))`, GEN_TAC THEN REWRITE_TAC[polyhedron] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `s:real^N->bool`] POLYHEDRON_MINIMAL_LEMMA) THEN ANTS_TAC THENL [CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ u = s ==> t INTER u = s`) THEN REWRITE_TAC[HULL_SUBSET] THEN ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `affine hull s:real^N->bool` AFFINE_IMP_POLYHEDRON) THEN REWRITE_TAC[polyhedron; AFFINE_AFFINE_HULL] THEN DISCH_THEN(X_CHOOSE_THEN `f'':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `f' UNION f'':(real^N->bool)->bool` THEN ASM_REWRITE_TAC[FINITE_UNION; FORALL_IN_UNION; INTERS_UNION] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* A characterization of polyhedra as having finitely many faces. *) (* ------------------------------------------------------------------------- *) let POLYHEDRON_EQ_FINITE_EXPOSED_FACES = prove (`!s:real^N->bool. polyhedron s <=> closed s /\ convex s /\ FINITE {f | f exposed_face_of s}`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX; FINITE_POLYHEDRON_EXPOSED_FACES] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[POLYHEDRON_EMPTY] THEN ABBREV_TAC `f = {h:real^N->bool | h exposed_face_of s /\ ~(h = {}) /\ ~(h = s)}` THEN SUBGOAL_THEN `FINITE(f:(real^N->bool)->bool)` ASSUME_TAC THENL [EXPAND_TAC "f" THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN SUBGOAL_THEN `!h:real^N->bool. h IN f ==> h face_of s /\ ?a b. ~(a = vec 0) /\ s SUBSET {x | a dot x <= b} /\ h = s INTER {x | a dot x = b}` MP_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[EXPOSED_FACE_OF; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `a:(real^N->bool)->real^N` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s = affine hull s INTER INTERS {{x:real^N | a(h:real^N->bool) dot x <= b h} | h IN f}` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC POLYHEDRON_INTER THEN REWRITE_TAC[POLYHEDRON_AFFINE_HULL] THEN MATCH_MP_TAC POLYHEDRON_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; POLYHEDRON_HALFSPACE_LE]] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER; HULL_SUBSET; SET_RULE `s SUBSET INTERS f <=> !h. h IN f ==> s SUBSET h`] THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[SUBSET; IN_INTER; IN_INTERS; FORALL_IN_GSPEC] THEN X_GEN_TAC `p:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N`)] THEN SUBGOAL_THEN `?x:real^N. x IN segment[c,p] /\ x IN (s DIFF relative_interior s)` MP_TAC THENL [MP_TAC(ISPEC `segment[c:real^N,p]` CONNECTED_OPEN_IN) THEN REWRITE_TAC[CONNECTED_SEGMENT; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`segment[c:real^N,p] INTER relative_interior s`; `segment[c:real^N,p] INTER (UNIV DIFF s)`]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[IN_DIFF; NOT_EXISTS_THM] THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `affine hull s:real^N->bool` THEN SIMP_TAC[OPEN_IN_RELATIVE_INTERIOR; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; OPEN_IN_INTER; TOPSPACE_EUCLIDEAN] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_INC; SUBSET]; REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `(:real^N) DIFF s` THEN ASM_REWRITE_TAC[GSYM closed]; MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN ASM_MESON_TAC[ENDS_IN_SEGMENT]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF; IN_INTER; IN_UNIV] THEN ASM_MESON_TAC[ENDS_IN_SEGMENT]]; REWRITE_TAC[IN_SEGMENT; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN ASM_CASES_TAC `l = &0` THEN ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_MUL_LZERO; REAL_SUB_RZERO; VECTOR_MUL_LID; IN_DIFF] THEN ASM_CASES_TAC `l = &1` THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; REAL_SUB_REFL; VECTOR_MUL_LID; IN_DIFF] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC] THEN ABBREV_TAC `x:real^N = (&1 - l) % c + l % p` THEN SUBGOAL_THEN `?h:real^N->bool. h IN f /\ x IN h` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `(&1 - l) % c + l % p:real^N`] SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER) THEN REWRITE_TAC[relative_frontier; IN_DIFF] THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN EXPAND_TAC "f" THEN EXISTS_TAC `s INTER {y:real^N | d dot y = d dot x}` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN ASM_SIMP_TAC[real_ge; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]; ASM SET_TAC[]; REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_MESON_TAC[SUBSET; REAL_LT_REFL; RELATIVE_INTERIOR_SUBSET]]; ALL_TAC] THEN SUBGOAL_THEN `{y:real^N | a(h:real^N->bool) dot y = b h} face_of {y | a h dot y <= b h}` MP_TAC THENL [MATCH_MP_TAC(MESON[] `(t INTER s) face_of t /\ t INTER s = s ==> s face_of t`) THEN CONJ_TAC THENL [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_LE]; SET_TAC[REAL_LE_REFL]]; ALL_TAC] THEN REWRITE_TAC[face_of] THEN DISCH_THEN(MP_TAC o SPECL [`c:real^N`; `p:real^N`; `x:real^N`] o CONJUNCT2 o CONJUNCT2) THEN ASM_SIMP_TAC[IN_ELIM_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET)) THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM SET_TAC[]; REWRITE_TAC[IN_SEGMENT] THEN ASM SET_TAC[]; STRIP_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `h:real^N->bool`; `s:real^N->bool`] SUBSET_OF_FACE_OF) THEN ASM SET_TAC[]);; let POLYHEDRON_EQ_FINITE_FACES = prove (`!s:real^N->bool. polyhedron s <=> closed s /\ convex s /\ FINITE {f | f face_of s}`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX; FINITE_POLYHEDRON_FACES] THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_EXPOSED_FACES] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{f:real^N->bool | f face_of s}` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; exposed_face_of]);; let POLYHEDRON_TRANSLATION_EQ = prove (`!a s. polyhedron (IMAGE (\x:real^N. a + x) s) <=> polyhedron s`, REPEAT STRIP_TAC THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_FACES] THEN REWRITE_TAC[CLOSED_TRANSLATION_EQ] THEN AP_TERM_TAC THEN REWRITE_TAC[CONVEX_TRANSLATION_EQ] THEN AP_TERM_TAC THEN MP_TAC(ISPEC `IMAGE (\x:real^N. a + x)` QUANTIFY_SURJECTION_THM) THEN REWRITE_TAC[SURJECTIVE_IMAGE; EXISTS_REFL; VECTOR_ARITH `a + x:real^N = y <=> x = y - a`] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[FACE_OF_TRANSLATION_EQ] THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN MATCH_MP_TAC(MESON[] `(!x y. Q x y ==> R x y) ==> (!x y. P x /\ P y /\ Q x y ==> R x y)`) THEN REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC);; add_translation_invariants [POLYHEDRON_TRANSLATION_EQ];; let POLYHEDRON_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> (polyhedron (IMAGE f s) <=> polyhedron s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_FACES] THEN BINOP_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]; ALL_TAC] THEN BINOP_TAC THENL [ASM_MESON_TAC[CONVEX_LINEAR_IMAGE_EQ]; ALL_TAC] THEN MP_TAC(ISPEC `IMAGE (f:real^M->real^N)` QUANTIFY_SURJECTION_THM) THEN ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN MP_TAC(ISPEC `f:real^M->real^N` FACE_OF_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM INJECTIVE_IMAGE]) THEN ASM_REWRITE_TAC[IMP_CONJ]);; add_linear_invariants [POLYHEDRON_LINEAR_IMAGE_EQ];; let POLYHEDRON_NEGATIONS = prove (`!s:real^N->bool. polyhedron s ==> polyhedron(IMAGE (--) s)`, GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE_EQ THEN REWRITE_TAC[VECTOR_ARITH `--x:real^N = y <=> x = --y`; EXISTS_REFL] THEN REWRITE_TAC[LINEAR_NEGATION] THEN VECTOR_ARITH_TAC);; let POLYHEDRON_LINEAR_PREIMAGE = prove (`!f:real^M->real^N s. linear f /\ polyhedron s ==> polyhedron {x | f x IN s}`, let lemma = prove (`{x | f x IN INTERS s} = INTERS {{x | f x IN c} | c IN s}`, REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]) in REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [polyhedron] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN ONCE_REWRITE_TAC[lemma] THEN MATCH_MP_TAC POLYHEDRON_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP ADJOINT_CLAUSES th)]) THEN REWRITE_TAC[POLYHEDRON_HALFSPACE_LE]);; (* ------------------------------------------------------------------------- *) (* Relation between polytopes and polyhedra. *) (* ------------------------------------------------------------------------- *) let POLYTOPE_EQ_BOUNDED_POLYHEDRON = prove (`!s:real^N->bool. polytope s <=> polyhedron s /\ bounded s`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[FINITE_POLYTOPE_FACES; POLYHEDRON_EQ_FINITE_FACES; POLYTOPE_IMP_CLOSED; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED]; STRIP_TAC THEN REWRITE_TAC[polytope] THEN EXISTS_TAC `{v:real^N | v extreme_point_of s}` THEN ASM_SIMP_TAC[FINITE_POLYHEDRON_EXTREME_POINTS] THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX]]);; let POLYTOPE_INTER = prove (`!s t. polytope s /\ polytope t ==> polytope(s INTER t)`, SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER; BOUNDED_INTER]);; let POLYTOPE_INTER_POLYHEDRON = prove (`!s t:real^N->bool. polytope s /\ polyhedron t ==> polytope(s INTER t)`, SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER] THEN MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; let POLYHEDRON_INTER_POLYTOPE = prove (`!s t:real^N->bool. polyhedron s /\ polytope t ==> polytope(s INTER t)`, SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER] THEN MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; let POLYTOPE_IMP_POLYHEDRON = prove (`!p. polytope p ==> polyhedron p`, SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON]);; let POLYTOPE_FACET_EXISTS = prove (`!p:real^N->bool. polytope p /\ &0 < aff_dim p ==> ?f. f facet_of p`, GEN_TAC THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN STRIP_TAC THEN MP_TAC(ISPEC `p:real^N->bool` EXTREME_POINT_EXISTS_CONVEX) THEN ASM_SIMP_TAC[POLYTOPE_IMP_COMPACT; POLYTOPE_IMP_CONVEX] THEN DISCH_THEN(X_CHOOSE_TAC `v:real^N`) THEN MP_TAC(ISPECL [`p:real^N->bool`; `{v:real^N}`] FACE_OF_POLYHEDRON_SUBSET_FACET) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_SING; NOT_INSERT_EMPTY] THEN ASM_MESON_TAC[AFF_DIM_SING; INT_LT_REFL]);; let POLYHEDRON_INTERVAL = prove (`!a b. polyhedron(interval[a,b])`, MESON_TAC[POLYTOPE_IMP_POLYHEDRON; POLYTOPE_INTERVAL]);; let POLYHEDRON_CONVEX_HULL = prove (`!s. FINITE s ==> polyhedron(convex hull s)`, SIMP_TAC[POLYTOPE_CONVEX_HULL; POLYTOPE_IMP_POLYHEDRON]);; (* ------------------------------------------------------------------------- *) (* Polytope is union of convex hulls of facets plus any point inside. *) (* ------------------------------------------------------------------------- *) let POLYTOPE_UNION_CONVEX_HULL_FACETS = prove (`!s p:real^N->bool. polytope p /\ &0 < aff_dim p /\ ~(s = {}) /\ s SUBSET p ==> p = UNIONS { convex hull (s UNION f) | f facet_of p}`, let lemma = SET_RULE `{f x | p x} = {y | ?x. p x /\ y = f x}` in MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[] THEN X_GEN_TAC `a:real^N` THEN ONCE_REWRITE_TAC[lemma] THEN GEOM_ORIGIN_TAC `a:real^N` THEN ONCE_REWRITE_TAC[GSYM lemma] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT s)`) THEN SPEC_TAC(`(vec 0:real^N) INSERT s`,`s:real^N->bool`) THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [POLYTOPE_EQ_BOUNDED_POLYHEDRON]) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `f:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull p:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MONO THEN FIRST_ASSUM(MP_TAC o MATCH_MP FACET_OF_IMP_SUBSET) THEN ASM SET_TAC[]; ASM_MESON_TAC[CONVEX_HULL_EQ; POLYHEDRON_IMP_CONVEX; SUBSET_REFL]]] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `v:real^N = vec 0` THENL [MP_TAC(ISPEC `p:real^N->bool` POLYTOPE_FACET_EXISTS) THEN ASM_REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HULL_INC; IN_UNION]; ALL_TAC] THEN SUBGOAL_THEN `?t. &1 < t /\ ~((t % v:real^N) IN p)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `max (&2) ((B + &1) / norm (v:real^N))` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV [GSYM CONTRAPOS_THM]) THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> ~(abs(max (&2) b) <= a)`) THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; NORM_POS_LT] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `(vec 0:real^N) IN p` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`segment[vec 0,t % v:real^N] INTER p`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_INTER_CLOSED; POLYHEDRON_IMP_CLOSED; COMPACT_SEGMENT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN ASM_MESON_TAC[ENDS_IN_SEGMENT]; REWRITE_TAC[IN_INTER; GSYM CONJ_ASSOC; IMP_CONJ] THEN REWRITE_TAC[segment; FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; DIST_0] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; NORM_MUL; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT; LEFT_IMP_EXISTS_THM; REAL_ARITH `&1 < t ==> &0 < abs t`] THEN X_GEN_TAC `u:real` THEN ASM_CASES_TAC `u = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[real_abs] THEN DISCH_TAC] THEN SUBGOAL_THEN `inv(t) <= u` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_INV_LE_1; REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_ARITH `&1 < t ==> &0 <= t`] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; REAL_ARITH `&1 < t ==> ~(t = &0)`]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 < t ==> &0 < t`)) THEN SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN UNDISCH_TAC `inv t <= &0` THEN REWRITE_TAC[REAL_NOT_LE] THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN EXISTS_TAC `convex hull {vec 0:real^N,u % t % v}` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CONVEX_HULL_2; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`&1 - inv(u * t)`; `inv(u * t):real`] THEN REWRITE_TAC[REAL_ARITH `&1 - x + x = &1`; REAL_SUB_LE; REAL_LE_INV_EQ] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_ENTIRE; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LID]] THEN SUBGOAL_THEN `(u % t % v:real^N) IN (p DIFF relative_interior p)` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[RELATIVE_INTERIOR_OF_POLYHEDRON] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `x IN s DIFF (s DIFF t) ==> x IN t`)) THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `(?s. s IN f /\ t SUBSET s) ==> t SUBSET UNIONS f`) THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `f:real^N->bool` THEN ASM_SIMP_TAC[SUBSET_HULL; CONVEX_CONVEX_HULL] THEN ASM_SIMP_TAC[HULL_INC; IN_UNION; INSERT_SUBSET; EMPTY_SUBSET]] THEN ASM_REWRITE_TAC[IN_DIFF; IN_RELATIVE_INTERIOR] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTER; dist] THEN ABBREV_TAC `k = min (e / &2 / norm(t % v:real^N)) (&1 - u)` THEN SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL [EXPAND_TAC "k" THEN REWRITE_TAC[REAL_LT_MIN] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_SIMP_TAC[REAL_HALF; NORM_POS_LT; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(u + k) % t % v:real^N`) THEN REWRITE_TAC[VECTOR_ARITH `u % x - (u + k) % x:real^N = --k % x`] THEN ONCE_REWRITE_TAC[NORM_MUL] THEN REWRITE_TAC[REAL_ABS_NEG; NOT_IMP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN EXPAND_TAC "k" THEN REAL_ARITH_TAC; ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN REPEAT(MATCH_MP_TAC SPAN_MUL) THEN ASM_SIMP_TAC[SPAN_SUPERSET]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u + k:real`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= u /\ &0 < x /\ x <= &1 - u ==> (&0 <= u + x /\ u + x <= &1) /\ ~(u + x <= u)`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "k" THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Finitely generated cone is polyhedral, and hence closed. *) (* ------------------------------------------------------------------------- *) let POLYHEDRON_CONVEX_CONE_HULL = prove (`!s:real^N->bool. FINITE s ==> polyhedron(convex_cone hull s)`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN DISCH_TAC THENL [ASM_REWRITE_TAC[CONVEX_CONE_HULL_EMPTY] THEN ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON; POLYTOPE_SING]; ALL_TAC] THEN SUBGOAL_THEN `polyhedron(convex hull ((vec 0:real^N) INSERT s))` MP_TAC THENL [MATCH_MP_TAC POLYTOPE_IMP_POLYHEDRON THEN REWRITE_TAC[polytope] THEN ASM_MESON_TAC[FINITE_INSERT]; REWRITE_TAC[polyhedron] THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[SKOLEM_THM; RIGHT_IMP_EXISTS_THM]) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `a:(real^N->bool)->real^N` MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `b:(real^N->bool)->real`)] THEN SUBGOAL_THEN `~(f:(real^N->bool)->bool = {})` ASSUME_TAC THENL [DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [INTERS_0]) THEN DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[NOT_BOUNDED_UNIV; BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED; FINITE_INSERT; FINITE_EMPTY]; ALL_TAC] THEN EXISTS_TAC `{h:real^N->bool | h IN f /\ b h = &0}` THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `h:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`(a:(real^N->bool)->real^N) h`; `(b:(real^N->bool)->real) h`] THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull ((vec 0:real^N) INSERT s)` THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; HULL_INC; IN_INSERT]; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> INTERS t SUBSET INTERS s`) THEN SET_TAC[]; MATCH_MP_TAC CONVEX_CONE_INTERS THEN X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[CONVEX_CONE_HALFSPACE_LE]]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_INTERS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!h:real^N->bool. h IN f ==> ?t. &0 < t /\ (t % x) IN h` MP_TAC THENL [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `(b:(real^N->bool)->real) h = &0` THENL [EXISTS_TAC `&1` THEN ASM_SIMP_TAC[REAL_LT_01; VECTOR_MUL_LID]; ALL_TAC] THEN SUBGOAL_THEN `&0 < (b:(real^N->bool)->real) h` ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LT_LE] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN SIMP_TAC[HULL_INC; IN_INSERT; IN_INTERS] THEN DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]]; ALL_TAC] THEN SUBGOAL_THEN `(vec 0:real^N) IN interior h` MP_TAC THENL [SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` SUBST1_TAC THENL [ASM_MESON_TAC[]; ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; IN_ELIM_THM; DOT_RZERO]]; REWRITE_TAC[IN_INTERIOR; SUBSET; IN_BALL_0; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [EXISTS_TAC `&1` THEN ASM_SIMP_TAC[VECTOR_MUL_RZERO; REAL_LT_01; NORM_0]; EXISTS_TAC `e / &2 / norm(x:real^N)` THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:(real^N->bool)->real` THEN DISCH_TAC THEN SUBGOAL_THEN `x:real^N = inv(inf(IMAGE t (f:(real^N->bool)->bool))) % inf(IMAGE t f) % x` SUBST1_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[conic] CONIC_CONVEX_CONE_HULL) THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; REAL_LT_IMP_LE; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(SET_RULE `!s t. s SUBSET t /\ x IN s ==> x IN t`) THEN EXISTS_TAC `convex hull ((vec 0:real^N) INSERT s)` THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_CONE_HULL] THEN ASM_SIMP_TAC[INSERT_SUBSET; HULL_SUBSET; CONVEX_CONE_HULL_CONTAINS_0]; ASM_REWRITE_TAC[IN_INTERS] THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `inf(IMAGE (t:(real^N->bool)->real) f) % x:real^N = (&1 - inf(IMAGE t f) / t h) % vec 0 + (inf(IMAGE t f) / t h) % t h % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RZERO; VECTOR_ADD_LID; REAL_DIV_RMUL; REAL_LT_IMP_NZ]; ALL_TAC] THEN MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_INF_LE_FINITE; REAL_LE_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` SUBST1_TAC THENL [ASM_MESON_TAC[]; ASM_SIMP_TAC[CONVEX_HALFSPACE_LE]]; SUBGOAL_THEN `(vec 0:real^N) IN convex hull (vec 0 INSERT s)` MP_TAC THENL [SIMP_TAC[HULL_INC; IN_INSERT]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_INTERS] THEN ASM_MESON_TAC[]; ASM SET_TAC[REAL_LE_REFL]]]);; let CLOSED_CONVEX_CONE_HULL = prove (`!s:real^N->bool. FINITE s ==> closed(convex_cone hull s)`, MESON_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_CONVEX_CONE_HULL]);; let POLYHEDRON_CONVEX_CONE_HULL_POLYTOPE = prove (`!s:real^N->bool. polytope s ==> polyhedron(convex_cone hull s)`, GEN_TAC THEN REWRITE_TAC[polytope; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `c:real^N->bool = {}` THEN ASM_SIMP_TAC[CONVEX_HULL_EMPTY; CONVEX_CONE_HULL_EMPTY; POLYTOPE_IMP_POLYHEDRON; POLYTOPE_SING] THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY; CONVEX_HULL_EQ_EMPTY] THEN REWRITE_TAC[HULL_HULL] THEN ASM_SIMP_TAC[GSYM CONVEX_CONE_HULL_SEPARATE_NONEMPTY; CONVEX_HULL_EQ_EMPTY; POLYHEDRON_CONVEX_CONE_HULL]);; let POLYHEDRON_CONIC_HULL_POLYTOPE = prove (`!s:real^N->bool. polytope s ==> polyhedron(conic hull s)`, GEN_TAC THEN REWRITE_TAC[polytope; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `c:real^N->bool = {}` THEN ASM_SIMP_TAC[POLYHEDRON_EMPTY; CONVEX_HULL_EMPTY; CONIC_HULL_EMPTY] THEN ASM_SIMP_TAC[GSYM CONVEX_CONE_HULL_SEPARATE_NONEMPTY] THEN ASM_SIMP_TAC[POLYHEDRON_CONVEX_CONE_HULL]);; let CLOSED_CONIC_HULL_STRONG = prove (`!s:real^N->bool. vec 0 IN relative_interior s \/ polytope s \/ compact s /\ ~(vec 0 IN s) ==> closed(conic hull s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_CONIC_HULL] THEN MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN ASM_SIMP_TAC[POLYHEDRON_CONIC_HULL_POLYTOPE]);; let CLOSED_CONVEX_CONE_HULL_STRONG = prove (`!s:real^N->bool. FINITE s \/ polytope s \/ vec 0 IN relative_interior (convex hull s) \/ compact s /\ ~(vec 0 IN convex hull s) ==> closed(convex_cone hull s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONVEX_CONE_HULL_EMPTY; CLOSED_SING] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[CLOSED_CONVEX_CONE_HULL]; ALL_TAC] THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY] THEN DISCH_THEN(fun th -> MATCH_MP_TAC CLOSED_CONIC_HULL_STRONG THEN MP_TAC th) THEN MESON_TAC[COMPACT_CONVEX_HULL; HULL_P; POLYTOPE_IMP_CONVEX]);; (* ------------------------------------------------------------------------- *) (* And conversely, a polyhedral cone is finitely generated. *) (* ------------------------------------------------------------------------- *) let FINITELY_GENERATED_CONIC_POLYHEDRON = prove (`!s:real^N->bool. polyhedron s /\ conic s /\ ~(s = {}) ==> ?c. FINITE c /\ s = convex_cone hull c`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?p:real^N->bool. polytope p /\ vec 0 IN interior p` STRIP_ASSUME_TAC THENL [EXISTS_TAC `interval[--vec 1:real^N,vec 1:real^N]` THEN REWRITE_TAC[POLYTOPE_INTERVAL; INTERIOR_CLOSED_INTERVAL] THEN SIMP_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN SUBGOAL_THEN `polytope(s INTER p:real^N->bool)` MP_TAC THENL [REWRITE_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON] THEN ASM_SIMP_TAC[BOUNDED_INTER; POLYTOPE_IMP_BOUNDED]THEN ASM_SIMP_TAC[POLYHEDRON_INTER; POLYTOPE_IMP_POLYHEDRON]; REWRITE_TAC[polytope] THEN MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUBSET_HULL; POLYHEDRON_IMP_CONVEX; convex_cone] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s INTER p:real^N->bool` THEN REWRITE_TAC[INTER_SUBSET] THEN ASM_REWRITE_TAC[HULL_SUBSET]] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?t. &0 < t /\ (t % x:real^N) IN p` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN REWRITE_TAC[SUBSET; IN_BALL_0; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; REAL_LT_01] THEN ASM_SIMP_TAC[NORM_0]; EXISTS_TAC `e / &2 / norm(x:real^N)` THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `x:real^N = inv t % t % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; REAL_LT_IMP_NZ]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[conic] CONIC_CONVEX_CONE_HULL) THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN EXISTS_TAC `convex hull c:real^N->bool` THEN REWRITE_TAC[CONVEX_HULL_SUBSET_CONVEX_CONE_HULL] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[IN_INTER] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [conic]) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Decomposition of polyhedron into cone plus polytope and more corollaries. *) (* ------------------------------------------------------------------------- *) let POLYHEDRON_POLYTOPE_SUMS = prove (`!s t:real^N->bool. polyhedron s /\ polytope t ==> polyhedron {x + y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_EXPOSED_FACES] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_COMPACT_SUMS THEN ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYTOPE_IMP_COMPACT]; MATCH_MP_TAC CONVEX_SUMS THEN ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX; POLYTOPE_IMP_CONVEX]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{ {x + y:real^N | x IN k /\ y IN l} | k exposed_face_of s /\ l exposed_face_of t}` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `k exposed_face_of s <=> k IN {f | f exposed_face_of s}`] THEN MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN ASM_SIMP_TAC[FINITE_POLYHEDRON_EXPOSED_FACES; POLYTOPE_IMP_POLYHEDRON]; REWRITE_TAC[SUBSET; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EXPOSED_FACE_OF_SUMS THEN ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX; POLYTOPE_IMP_CONVEX]]]);; let POLYHEDRON_AS_CONE_PLUS_CONV = prove (`!s:real^N->bool. polyhedron s <=> ?t u. FINITE t /\ FINITE u /\ s = {x + y | x IN convex_cone hull t /\ y IN convex hull u}`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[polyhedron; LEFT_IMP_EXISTS_THM]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POLYHEDRON_POLYTOPE_SUMS THEN ASM_SIMP_TAC[POLYTOPE_CONVEX_HULL; POLYHEDRON_CONVEX_CONE_HULL]] THEN REWRITE_TAC[polyhedron; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:(real^N->bool)->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN ONCE_REWRITE_TAC[MESON[] `h = {x | P x} <=> {x | P x} = h`] THEN DISCH_TAC THEN ABBREV_TAC `s':real^(N,1)finite_sum->bool = {x | &0 <= drop(sndcart x) /\ !h:real^N->bool. h IN f ==> a h dot (fstcart x) <= b h * drop(sndcart x)}` THEN SUBGOAL_THEN `?t u. FINITE t /\ FINITE u /\ (!y:real^(N,1)finite_sum. y IN t ==> drop(sndcart y) = &0) /\ (!y. y IN u ==> drop(sndcart y) = &1) /\ s' = convex_cone hull (t UNION u)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `s':real^(N,1)finite_sum->bool` FINITELY_GENERATED_CONIC_POLYHEDRON) THEN ANTS_TAC THENL [EXPAND_TAC "s'" THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{ x:real^(N,1)finite_sum | pastecart (vec 0) (--vec 1) dot x <= &0} INSERT { {x | pastecart (a h) (--lift(b h)) dot x <= &0} | (h:real^N->bool) IN f}` THEN REWRITE_TAC[FINITE_INSERT; INTERS_INSERT; SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "s'" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; FORALL_PASTECART; IN_INTER; DOT_PASTECART; INTERS_IMAGE; FSTCART_PASTECART; SNDCART_PASTECART; DOT_1; GSYM drop; DROP_NEG; LIFT_DROP] THEN REWRITE_TAC[DROP_VEC; DOT_LZERO; REAL_MUL_LNEG; GSYM real_sub] THEN REWRITE_TAC[REAL_MUL_LID; REAL_ARITH `x - y <= &0 <=> x <= y`]; EXISTS_TAC `pastecart (vec 0) (--vec 1):real^(N,1)finite_sum` THEN EXISTS_TAC `&0` THEN REWRITE_TAC[PASTECART_EQ_VEC; VECTOR_NEG_EQ_0; VEC_EQ] THEN ARITH_TAC; X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`pastecart (a(h:real^N->bool)) (--lift(b h)):real^(N,1)finite_sum`; `&0`] THEN ASM_SIMP_TAC[PASTECART_EQ_VEC]]; REWRITE_TAC[conic; IN_ELIM_THM; FSTCART_CMUL; SNDCART_CMUL] THEN SIMP_TAC[DROP_CMUL; DOT_RMUL; REAL_LE_MUL] THEN MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^(N,1)finite_sum` THEN REWRITE_TAC[IN_ELIM_THM; FSTCART_VEC; SNDCART_VEC] THEN REWRITE_TAC[DROP_VEC; DOT_RZERO; REAL_LE_REFL; REAL_MUL_RZERO]]; DISCH_THEN(X_CHOOSE_THEN `c:real^(N,1)finite_sum->bool` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`{x:real^(N,1)finite_sum | x IN c /\ drop(sndcart x) = &0}`; `IMAGE (\x. inv(drop(sndcart x)) % x) {x:real^(N,1)finite_sum | x IN c /\ ~(drop(sndcart x) = &0)}`] THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN SIMP_TAC[IN_ELIM_THM; SNDCART_CMUL; DROP_CMUL; REAL_MUL_LINV] THEN SUBGOAL_THEN `!x:real^(N,1)finite_sum. x IN c ==> &0 <= drop(sndcart x)` ASSUME_TAC THENL [GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `(x:real^(N,1)finite_sum) IN s'` MP_TAC THENL [ASM_MESON_TAC[HULL_INC]; EXPAND_TAC "s'"] THEN SIMP_TAC[IN_ELIM_THM]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONE_CONVEX_CONE_HULL; UNION_SUBSET] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; HULL_INC; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^(N,1)finite_sum` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^(N,1)finite_sum`) THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_MUL; HULL_INC; REAL_LE_INV_EQ] THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN STRIP_TAC THENL [MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM]; SUBGOAL_THEN `x:real^(N,1)finite_sum = drop(sndcart x) % inv(drop(sndcart x)) % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_MUL_LID]; MATCH_MP_TAC CONVEX_CONE_HULL_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC HULL_INC THEN REWRITE_TAC[IN_UNION] THEN DISJ2_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^(N,1)finite_sum` THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NZ]]]]; EXISTS_TAC `IMAGE fstcart (t:real^(N,1)finite_sum->bool)` THEN EXISTS_TAC `IMAGE fstcart (u:real^(N,1)finite_sum->bool)` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN SUBGOAL_THEN `s = {x:real^N | pastecart x (vec 1:real^1) IN s'}` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["s"; "s'"] THEN REWRITE_TAC[IN_ELIM_THM; SNDCART_PASTECART; DROP_VEC; REAL_POS] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[FSTCART_PASTECART; IN_ELIM_THM; IN_INTERS; REAL_MUL_RID] THEN ASM SET_TAC[]; ASM_REWRITE_TAC[CONVEX_CONE_HULL_UNION]] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN SIMP_TAC[CONVEX_CONE_HULL_LINEAR_IMAGE; CONVEX_HULL_LINEAR_IMAGE; LINEAR_FSTCART] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:real^(N,1)finite_sum` THEN REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN DISCH_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `b:real^(N,1)finite_sum` THEN REWRITE_TAC[PASTECART_EQ] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; FSTCART_ADD; SNDCART_ADD] THEN ASM_CASES_TAC `fstcart(a:real^(N,1)finite_sum) + fstcart(b:real^(N,1)finite_sum) = z` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `sndcart(a:real^(N,1)finite_sum) = vec 0` SUBST1_TAC THENL [UNDISCH_TAC `(a:real^(N,1)finite_sum) IN convex_cone hull t` THEN SPEC_TAC(`a:real^(N,1)finite_sum`,`a:real^(N,1)finite_sum`) THEN MATCH_MP_TAC HULL_INDUCT THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC] THEN REWRITE_TAC[convex_cone; convex; conic; IN_ELIM_THM] THEN SIMP_TAC[SNDCART_ADD; SNDCART_CMUL; DROP_ADD; DROP_CMUL] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^(N,1)finite_sum` THEN REWRITE_TAC[IN_ELIM_THM; SNDCART_VEC; DROP_VEC]; REWRITE_TAC[VECTOR_ADD_LID]] THEN ASM_CASES_TAC `u:real^(N,1)finite_sum->bool = {}` THENL [ASM_REWRITE_TAC[CONVEX_CONE_HULL_EMPTY; CONVEX_HULL_EMPTY] THEN REWRITE_TAC[IN_SING; NOT_IN_EMPTY] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[SNDCART_VEC; VEC_EQ] THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; IN_ELIM_THM] THEN SUBGOAL_THEN `!y:real^(N,1)finite_sum. y IN convex hull u ==> sndcart y = vec 1` (LABEL_TAC "*") THENL [MATCH_MP_TAC HULL_INDUCT THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC] THEN REWRITE_TAC[convex; IN_ELIM_THM] THEN SIMP_TAC[SNDCART_ADD; SNDCART_CMUL; DROP_ADD; DROP_CMUL] THEN SIMP_TAC[REAL_MUL_RID]; ALL_TAC] THEN EQ_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`c:real`; `d:real^(N,1)finite_sum`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[SNDCART_CMUL; VECTOR_MUL_EQ_0; VECTOR_ARITH `x:real^N = c % x <=> (c - &1) % x = vec 0`] THEN ASM_SIMP_TAC[REAL_SUB_0; VEC_EQ; ARITH_EQ; VECTOR_MUL_LID]; DISCH_TAC THEN ASM_SIMP_TAC[] THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LID] THEN ASM_MESON_TAC[]]]);; let POLYHEDRON_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ polyhedron s ==> polyhedron(IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[POLYHEDRON_AS_CONE_PLUS_CONV; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN EXISTS_TAC `IMAGE (f:real^M->real^N) u` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM_SIMP_TAC[CONVEX_CONE_HULL_LINEAR_IMAGE; CONVEX_HULL_LINEAR_IMAGE] THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_ADD) THEN MESON_TAC[]);; let POLYHEDRON_SUMS = prove (`!s t:real^N->bool. polyhedron s /\ polyhedron t ==> polyhedron {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[POLYHEDRON_AS_CONE_PLUS_CONV] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t1:real^N->bool`; `u1:real^N->bool`; `t2:real^N->bool`; `u2:real^N->bool`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `t1 UNION t2:real^N->bool` THEN EXISTS_TAC `{u + v:real^N | u IN u1 /\ v IN u2}` THEN REWRITE_TAC[CONVEX_CONE_HULL_UNION; CONVEX_HULL_SUMS] THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_UNION] THEN REWRITE_TAC[SET_RULE `{h x y | x IN {f a b | P a /\ Q b} /\ y IN {g a b | R a /\ S b}} = {h (f a b) (g c d) | P a /\ Q b /\ R c /\ S d}`] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_AC]);; let POLYHEDRAL_CONVEX_CONE = prove (`!s:real^N->bool. polyhedron s /\ convex_cone s <=> ?k. FINITE k /\ s = convex_cone hull k`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[POLYHEDRON_CONVEX_CONE_HULL; CONVEX_CONE_CONVEX_CONE_HULL]] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_AS_CONE_PLUS_CONV]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `c:real^N->bool`] THEN ASM_CASES_TAC `c:real^N->bool = {}` THENL [ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x y | x,y | F} = {}`] THEN ASM_MESON_TAC[CONVEX_CONE_NONEMPTY]; DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN EXISTS_TAC `k UNION c:real^N->bool` THEN ASM_REWRITE_TAC[FINITE_UNION] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [EXPAND_TAC "s" THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_CONE_HULL_ADD THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN MESON_TAC[HULL_MONO; SUBSET_UNION; SUBSET_TRANS; CONVEX_HULL_SUBSET_CONVEX_CONE_HULL]; MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]] THEN REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[SUBSET] THEN CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL [ALL_TAC; EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN ASM_SIMP_TAC[HULL_INC; VECTOR_ADD_LID; CONVEX_CONE_HULL_CONTAINS_0]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP POLYHEDRON_IMP_CLOSED) THEN DISCH_THEN(MP_TAC o MATCH_MP CLOSED_APPROACHABLE) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / (norm y + &1) % ((norm y + &1) / e % x + y):real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_CONE_MUL THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; NORM_POS_LE; REAL_POS; REAL_LT_IMP_LE] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`(norm(y:real^N) + &1) / e % x:real^N`; `y:real^N`] THEN ASM_SIMP_TAC[HULL_INC] THEN MATCH_MP_TAC CONVEX_CONE_HULL_MUL THEN ASM_SIMP_TAC[HULL_INC] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONV_TAC NORM_ARITH; REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[NORM_POS_LE; VECTOR_MUL_LID; REAL_FIELD `&0 <= y /\ &0 < e ==> e / (y + &1) * (y + &1) / e = &1`] THEN REWRITE_TAC[NORM_ARITH `dist(x + e:real^N,x) = norm e`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e * z / y < e * &1 ==> abs e / y * z < e`) THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; NORM_ARITH `&0 < abs(norm(y:real^N) + &1)`] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Farkas's lemma (2 variants) and stronger separation for polyhedra. *) (* ------------------------------------------------------------------------- *) let FARKAS_LEMMA = prove (`!A:real^N^M b. (?x:real^N. A ** x = b /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i)) <=> ~(?y:real^M. b dot y < &0 /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= (transp A ** y)$i))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(q ==> ~p) /\ (~p ==> q) ==> (p <=> ~q)`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `y dot ((A:real^N^M) ** x - b) = &0` MP_TAC THENL [ASM_REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO]; ALL_TAC] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[DOT_SYM]) THEN REWRITE_TAC[DOT_RSUB; REAL_SUB_0] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y < &0 ==> &0 <= x ==> ~(x = y)`)) THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; dot] THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[REAL_LE_MUL; IN_NUMSEG; FINITE_NUMSEG]; DISCH_TAC THEN MP_TAC(ISPECL [`{(A:real^N^M) ** (x:real^N) | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`; `b:real^M`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[CONVEX_POSITIVE_ORTHANT; CONVEX_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; POLYHEDRON_POSITIVE_ORTHANT]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[DOT_SYM] THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N`) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO; DOT_RZERO] THEN REWRITE_TAC[real_gt; VEC_COMPONENT; REAL_LE_REFL] THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c / (transp(A:real^N^M) ** (y:real^M))$k % basis k:real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; VECTOR_MATRIX_MUL_TRANSP] THEN ASM_SIMP_TAC[REAL_FIELD `y < &0 ==> x / y * y = x`] THEN REWRITE_TAC[REAL_LT_REFL; real_gt] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = --x * -- inv y`] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_ARITH `&0 <= --x <=> ~(&0 < x)`; REAL_LT_INV_EQ] THEN ASM_REAL_ARITH_TAC]]);; let FARKAS_LEMMA_ALT = prove (`!A:real^N^M b. (?x:real^N. (!i. 1 <= i /\ i <= dimindex(:M) ==> (A ** x)$i <= b$i)) <=> ~(?y:real^M. (!i. 1 <= i /\ i <= dimindex(:M) ==> &0 <= y$i) /\ y ** A = vec 0 /\ b dot y < &0)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `~(p /\ q) /\ (~p ==> q) ==> (p <=> ~q)`) THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `&0 <= (b - (A:real^N^M) ** x) dot y` MP_TAC THENL [REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_SUB_LE]; REWRITE_TAC[DOT_LSUB; REAL_SUB_LE] THEN REWRITE_TAC[REAL_NOT_LE] THEN GEN_REWRITE_TAC RAND_CONV [DOT_SYM] THEN REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN ASM_REWRITE_TAC[DOT_LZERO]]; MP_TAC(ISPECL [`{(A:real^N^M) ** (x:real^N) + s |x,s| !i. 1 <= i /\ i <= dimindex(:M) ==> &0 <= s$i}`; `b:real^M`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [REWRITE_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{f x + y | x,y | P y} = {z + y | z,y | z IN IMAGE (f:real^M->real^N) (:real^M) /\ y IN {w | P w}}`] THEN SIMP_TAC[CONVEX_SUMS; CONVEX_POSITIVE_ORTHANT; CONVEX_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR; CONVEX_UNIV] THEN MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN MATCH_MP_TAC POLYHEDRON_SUMS THEN ASM_SIMP_TAC[POLYHEDRON_LINEAR_IMAGE; POLYHEDRON_UNIV; MATRIX_VECTOR_MUL_LINEAR; POLYHEDRON_POSITIVE_ORTHANT]; POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; REAL_LE_ADDR]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[DOT_SYM] THEN FIRST_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `vec 0:real^M`]) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO; VECTOR_ADD_RID; DOT_RZERO] THEN REWRITE_TAC[real_gt; VEC_COMPONENT; REAL_LE_REFL] THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `k:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `--c / --((y:real^M)$k) % basis k:real^M`]) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; VECTOR_ADD_LID; DOT_RMUL; DOT_BASIS; REAL_FIELD `y < &0 ==> c / --y * y = --c`] THEN SIMP_TAC[REAL_NEG_NEG; REAL_LT_REFL; VECTOR_MUL_COMPONENT; real_gt] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPECL [`c / norm((y:real^M) ** (A:real^N^M)) pow 2 % (transp A ** y)`; `vec 0:real^M`]) THEN SIMP_TAC[VEC_COMPONENT; REAL_LE_REFL; VECTOR_ADD_RID] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN REWRITE_TAC[GSYM VECTOR_MATRIX_MUL_TRANSP; DOT_RMUL] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_POW_2; DOT_EQ_0] THEN REAL_ARITH_TAC]]]);; let SEPARATING_HYPERPLANE_POLYHEDRA = prove (`!s t:real^N->bool. polyhedron s /\ polyhedron t /\ ~(s = {}) /\ ~(t = {}) /\ DISJOINT s t ==> ?a b. ~(a = vec 0) /\ (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{x + y:real^N | x IN s /\ y IN IMAGE (--) t}` SEPARATING_HYPERPLANE_CLOSED_0) THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONVEX_SUMS; CONVEX_NEGATIONS; POLYHEDRON_IMP_CONVEX] THEN CONJ_TAC THENL [MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN MATCH_MP_TAC POLYHEDRON_SUMS THEN ASM_SIMP_TAC[POLYHEDRON_NEGATIONS]; REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `y = --x:real^N <=> --y = x`] THEN REWRITE_TAC[UNWIND_THM1] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = x + y <=> y = --x`] THEN REWRITE_TAC[UNWIND_THM2; VECTOR_NEG_NEG] THEN ASM SET_TAC[]]; REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE; GSYM VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `k:real`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; DOT_RSUB] THEN STRIP_TAC THEN EXISTS_TAC `--a:real^N` THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN MP_TAC(ISPEC `IMAGE (\x:real^N. a dot x) s` INF) THEN MP_TAC(ISPEC `IMAGE (\x:real^N. a dot x) t` SUP) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN MAP_EVERY ABBREV_TAC [`u = inf(IMAGE (\x:real^N. a dot x) s)`; `v = sup(IMAGE (\x:real^N. a dot x) t)`] THEN ANTS_TAC THENL [MP_TAC(GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY] (ASSUME `~(s:real^N->bool = {})`)) THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN EXISTS_TAC `a dot (z:real^N) - k` THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`z:real^N`; `x:real^N`]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; STRIP_TAC] THEN ANTS_TAC THENL [MP_TAC(GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY] (ASSUME `~(t:real^N->bool = {})`)) THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN EXISTS_TAC `a dot (z:real^N) + k` THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `z:real^N`]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; STRIP_TAC] THEN SUBGOAL_THEN `k <= u - v` ASSUME_TAC THENL [REWRITE_TAC[REAL_LE_SUB_LADD] THEN EXPAND_TAC "u" THEN MATCH_MP_TAC REAL_LE_INF THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `k + v <= u <=> v <= u - k`] THEN EXPAND_TAC "v" THEN MATCH_MP_TAC REAL_SUP_LE THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[REAL_ARITH `x - y > k ==> y <= x - k`]; EXISTS_TAC `--((u + v) / &2)` THEN REWRITE_TAC[real_gt] THEN REWRITE_TAC[DOT_LNEG; REAL_LT_NEG2] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `u:real`; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v:real`] THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Relative and absolute frontier of a polytope. *) (* ------------------------------------------------------------------------- *) let RELATIVE_BOUNDARY_OF_CONVEX_HULL = prove (`!s:real^N->bool. ~affine_dependent s ==> (convex hull s) DIFF relative_interior(convex hull s) = UNIONS { convex hull (s DELETE a) | a | a IN s}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC (ARITH_RULE `CARD(s:real^N->bool) = 0 \/ CARD s = 1 \/ 2 <= CARD s`) THENL [ASM_SIMP_TAC[CARD_EQ_0; CONVEX_HULL_EMPTY] THEN SET_TAC[]; DISCH_TAC THEN MP_TAC(HAS_SIZE_CONV `(s:real^N->bool) HAS_SIZE 1`) THEN ASM_SIMP_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM; CONVEX_HULL_SING] THEN REWRITE_TAC[RELATIVE_INTERIOR_SING; DIFF_EQ_EMPTY] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[EMPTY_UNIONS] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_UNWIND_THM2] THEN REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN SET_TAC[]; DISCH_TAC THEN ASM_SIMP_TAC[POLYHEDRON_CONVEX_HULL; RELATIVE_BOUNDARY_OF_POLYHEDRON] THEN ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT] THEN SET_TAC[]]);; let RELATIVE_FRONTIER_OF_CONVEX_HULL = prove (`!s:real^N->bool. ~affine_dependent s ==> relative_frontier(convex hull s) = UNIONS { convex hull (s DELETE a) | a | a IN s}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN ASM_SIMP_TAC[relative_frontier; GSYM RELATIVE_BOUNDARY_OF_CONVEX_HULL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CLOSURE_CLOSED THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);; let FRONTIER_OF_CONVEX_HULL = prove (`!s:real^N->bool. s HAS_SIZE (dimindex(:N) + 1) ==> frontier(convex hull s) = UNIONS { convex hull (s DELETE a) | a | a IN s}`, REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `affine_dependent(s:real^N->bool)` THENL [REWRITE_TAC[frontier] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(convex hull s:real^N->bool) DIFF {}` THEN CONJ_TAC THENL [BINOP_TAC THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EQ_EMPTY; frontier; HAS_SIZE] THEN MATCH_MP_TAC CLOSURE_CLOSED THEN ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]; REWRITE_TAC[DIFF_EMPTY] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [CARATHEODORY_AFF_DIM] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; UNIONS_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `s:real^N->bool` AFFINE_INDEPENDENT_IFF_CARD) THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN REWRITE_TAC[INT_ARITH `(x + &1) - &1:int = x`] THEN DISCH_TAC THEN SUBGOAL_THEN `(t:real^N->bool) PSUBSET s` ASSUME_TAC THENL [ASM_REWRITE_TAC[PSUBSET] THEN DISCH_THEN(MP_TAC o AP_TERM `CARD:(real^N->bool)->num`) THEN MATCH_MP_TAC(ARITH_RULE `t:num < s ==> t = s ==> F`) THEN ASM_REWRITE_TAC[ARITH_RULE `x < n + 1 <=> x <= n`] THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim(s:real^N->bool) + &1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(INT_ARITH `s:int <= n /\ ~(s = n) ==> s + &1 <= n`) THEN ASM_REWRITE_TAC[AFF_DIM_LE_UNIV]; SUBGOAL_THEN `?a:real^N. a IN s /\ ~(a IN t)` MP_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(convex hull t) SUBSET convex hull (s DELETE (a:real^N))` MP_TAC THENL [MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; ASM SET_TAC[]]]; ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; GSYM SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]]]; MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(convex hull s) DIFF relative_interior(convex hull s):real^N->bool` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM RELATIVE_BOUNDARY_OF_CONVEX_HULL; frontier] THEN BINOP_TAC THENL [MATCH_MP_TAC CLOSURE_CLOSED THEN ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN REWRITE_TAC[GSYM AFF_DIM_EQ_FULL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFFINE_INDEPENDENT_IFF_CARD]) THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN INT_ARITH_TAC]; ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON; POLYHEDRON_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY] THEN ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT] THEN REWRITE_TAC[ARITH_RULE `2 <= n + 1 <=> 1 <= n`; DIMINDEX_GE_1] THEN ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Special case of a triangle. *) (* ------------------------------------------------------------------------- *) let RELATIVE_BOUNDARY_OF_TRIANGLE = prove (`!a b c:real^N. ~collinear {a,b,c} ==> convex hull {a,b,c} DIFF relative_interior(convex hull {a,b,c}) = segment[a,b] UNION segment[b,c] UNION segment[c,a]`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = t UNION u UNION s`] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_3_EQ_AFFINE_DEPENDENT]) THEN REWRITE_TAC[DE_MORGAN_THM; SEGMENT_CONVEX_HULL] THEN STRIP_TAC THEN ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_CONVEX_HULL] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; UNIONS_0; UNION_EMPTY] THEN REPEAT BINOP_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]);; let RELATIVE_FRONTIER_OF_TRIANGLE = prove (`!a b c:real^N. ~collinear {a,b,c} ==> relative_frontier(convex hull {a,b,c}) = segment[a,b] UNION segment[b,c] UNION segment[c,a]`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM RELATIVE_BOUNDARY_OF_TRIANGLE; relative_frontier] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CLOSURE_CLOSED THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY]);; let FRONTIER_OF_TRIANGLE = prove (`!a b c:real^2. frontier(convex hull {a,b,c}) = segment[a,b] UNION segment[b,c] UNION segment[c,a]`, REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = t UNION u UNION s`] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; UNION_ACI] THEN SIMP_TAC[GSYM SEGMENT_CONVEX_HULL; frontier; CLOSURE_SEGMENT; INTERIOR_SEGMENT; DIMINDEX_2; LE_REFL; DIFF_EMPTY] THEN REWRITE_TAC[CONVEX_HULL_SING] THEN REWRITE_TAC[SET_RULE `s = s UNION {a} <=> a IN s`; SET_RULE `s = {a} UNION s <=> a IN s`] THEN REWRITE_TAC[ENDS_IN_SEGMENT]; ALL_TAC]) [`b:real^2 = a`; `c:real^2 = a`; `c:real^2 = b`] THEN SUBGOAL_THEN `{a:real^2,b,c} HAS_SIZE (dimindex(:2) + 1)` ASSUME_TAC THENL [SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DIMINDEX_2] THEN CONV_TAC NUM_REDUCE_CONV; ASM_SIMP_TAC[FRONTIER_OF_CONVEX_HULL] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; UNIONS_0; UNION_EMPTY] THEN REPEAT BINOP_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]]);; let INSIDE_OF_TRIANGLE = prove (`!a b c:real^2. inside(segment[a,b] UNION segment[b,c] UNION segment[c,a]) = interior(convex hull {a,b,c})`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE] THEN MATCH_MP_TAC INSIDE_FRONTIER_EQ_INTERIOR THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]);; let INTERIOR_OF_TRIANGLE = prove (`!a b c:real^2. interior(convex hull {a,b,c}) = (convex hull {a,b,c}) DIFF (segment[a,b] UNION segment[b,c] UNION segment[c,a])`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE; frontier] THEN MATCH_MP_TAC(SET_RULE `i SUBSET s /\ c = s ==> i = s DIFF (c DIFF i)`) THEN REWRITE_TAC[INTERIOR_SUBSET] THEN MATCH_MP_TAC CLOSURE_CONVEX_HULL THEN SIMP_TAC[FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]);; (* ------------------------------------------------------------------------- *) (* A ridge is the intersection of precisely two facets. *) (* ------------------------------------------------------------------------- *) let POLYHEDRON_RIDGE_TWO_FACETS = prove (`!p:real^N->bool r. polyhedron p /\ r face_of p /\ ~(r = {}) /\ aff_dim r = aff_dim p - &2 ==> ?f1 f2. f1 face_of p /\ aff_dim f1 = aff_dim p - &1 /\ f2 face_of p /\ aff_dim f2 = aff_dim p - &1 /\ ~(f1 = f2) /\ r SUBSET f1 /\ r SUBSET f2 /\ f1 INTER f2 = r /\ !f. f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f ==> f = f1 \/ f = f2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`p:real^N->bool`; `r:real^N->bool`] FACE_OF_POLYHEDRON) THEN ANTS_TAC THENL [ASM_MESON_TAC[INT_ARITH `~(p:int = p - &2)`]; ALL_TAC] THEN SUBGOAL_THEN `&2 <= aff_dim(p:real^N->bool)` ASSUME_TAC THENL [MP_TAC(ISPEC `r:real^N->bool` AFF_DIM_GE) THEN MP_TAC(ISPEC `r:real^N->bool` AFF_DIM_EQ_MINUS1) THEN ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `{f:real^N->bool | f facet_of p /\ r SUBSET f} = {f | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f}` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN ASM_REWRITE_TAC[IN_ELIM_THM; facet_of] THEN X_GEN_TAC `f:real^N->bool` THEN ASM_CASES_TAC `f:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY; GSYM CONJ_ASSOC] THEN ASM_INT_ARITH_TAC; DISCH_THEN(MP_TAC o SYM)] THEN ASM_CASES_TAC `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f} = {}` THENL [ASM_REWRITE_TAC[INTERS_0] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `aff_dim(r:real^N->bool) = aff_dim(p:real^N->bool) - &2` THEN ASM_REWRITE_TAC[AFF_DIM_UNIV; DIMINDEX_3] THEN MP_TAC(ISPEC `p:real^N->bool` AFF_DIM_LE_UNIV) THEN INT_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `f1:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f} = {f1}` THENL [ASM_REWRITE_TAC[INTERS_1] THEN ASM_MESON_TAC[INT_ARITH `~(x - &2:int = x - &1)`]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f2:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f} = {f1,f2}` THENL [ASM_REWRITE_TAC[INTERS_2] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`f1:real^N->bool`; `f2:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {a,b}) ==> a IN s /\ b IN s ==> ?c. ~(c = a) /\ ~(c = b) /\ c IN s`)) THEN ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f3:real^N->bool` THEN STRIP_TAC THEN DISCH_TAC THEN UNDISCH_TAC `aff_dim(r:real^N->bool) = aff_dim(p:real^N->bool) - &2` THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN MATCH_MP_TAC(INT_ARITH `~(p - &2:int <= x:int) ==> ~(x = p - &2)`) THEN DISCH_TAC THEN SUBGOAL_THEN `~(f1:real^N->bool = {}) /\ ~(f2:real^N->bool = {}) /\ ~(f3:real^N->bool = {})` STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EMPTY]) THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPEC `p:real^N->bool` POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = v <=> v = vec 0`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`p:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `f1:real^N->bool` th) THEN MP_TAC(SPEC `f2:real^N->bool` th) THEN MP_TAC(SPEC `f3:real^N->bool` th)) THEN ASM_REWRITE_TAC[facet_of] THEN DISCH_THEN(X_CHOOSE_THEN `h3:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN DISCH_THEN(X_CHOOSE_THEN `h2:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN DISCH_THEN(X_CHOOSE_THEN `h1:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `~((a:(real^N->bool)->real^N) h1 = a h2) /\ ~(a h2 = a h3) /\ ~(a h1 = a h3)` STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THENL [DISJ_CASES_TAC(REAL_ARITH `b(h1:real^N->bool) <= b h2 \/ b h2 <= b h1`) THENL [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`); FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN AP_TERM_TAC) THENL [SUBGOAL_THEN `f DELETE h2 = h1 INSERT (f DIFF {h1,h2}) /\ f = (h2:real^N->bool) INSERT h1 INSERT (f DIFF {h1,h2})` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `f DELETE h1 = h2 INSERT (f DIFF {h1,h2}) /\ f = (h1:real^N->bool) INSERT h2 INSERT (f DIFF {h1,h2})` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `h1:real^N->bool` th) THEN MP_TAC(SPEC `h2:real^N->bool` th)) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; DISJ_CASES_TAC(REAL_ARITH `b(h2:real^N->bool) <= b h3 \/ b h3 <= b h2`) THENL [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`); FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`)] THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN AP_TERM_TAC) THENL [SUBGOAL_THEN `f DELETE h3 = h2 INSERT (f DIFF {h2,h3}) /\ f = (h3:real^N->bool) INSERT h2 INSERT (f DIFF {h2,h3})` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `f DELETE h2 = h3 INSERT (f DIFF {h2,h3}) /\ f = (h2:real^N->bool) INSERT h3 INSERT (f DIFF {h2,h3})` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `h2:real^N->bool` th) THEN MP_TAC(SPEC `h3:real^N->bool` th)) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; DISJ_CASES_TAC(REAL_ARITH `b(h1:real^N->bool) <= b h3 \/ b h3 <= b h1`) THENL [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`); FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN AP_TERM_TAC) THENL [SUBGOAL_THEN `f DELETE h3 = h1 INSERT (f DIFF {h1,h3}) /\ f = (h3:real^N->bool) INSERT h1 INSERT (f DIFF {h1,h3})` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `f DELETE h1 = h3 INSERT (f DIFF {h1,h3}) /\ f = (h1:real^N->bool) INSERT h3 INSERT (f DIFF {h1,h3})` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `h1:real^N->bool` th) THEN MP_TAC(SPEC `h3:real^N->bool` th)) THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `~({x | a h1 dot x <= b h1} INTER {x | a h2 dot x <= b h2} SUBSET {x | a h3 dot x <= b h3}) /\ ~({x | a h1 dot x <= b h1} INTER {x | a h3 dot x <= b h3} SUBSET {x | a h2 dot x <= b h2}) /\ ~({x | a h2 dot x <= b h2} INTER {x | a h3 dot x <= b h3} SUBSET {x:real^N | a(h1:real^N->bool) dot x <= b h1})` MP_TAC THENL [ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`); FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`); FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SYM th]) THEN MATCH_MP_TAC(SET_RULE `s = t ==> s PSUBSET t ==> F`) THEN AP_TERM_TAC) THENL [SUBGOAL_THEN `f DELETE (h3:real^N->bool) = h1 INSERT h2 INSERT (f DELETE h3) /\ f = h1 INSERT h2 INSERT h3 INSERT (f DELETE h3)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `f DELETE (h2:real^N->bool) = h1 INSERT h3 INSERT (f DELETE h2) /\ f = h2 INSERT h1 INSERT h3 INSERT (f DELETE h2)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `f DELETE (h1:real^N->bool) = h2 INSERT h3 INSERT (f DELETE h1) /\ f = h1 INSERT h2 INSERT h3 INSERT (f DELETE h1)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN REWRITE_TAC[INTERS_INSERT] THEN REWRITE_TAC[GSYM INTER_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?w. (a:(real^N->bool)->real^N) h1 dot w < b h1 /\ a h2 dot w < b h2 /\ a h3 dot w < b h3` (CHOOSE_THEN MP_TAC) THENL [SUBGOAL_THEN `~(relative_interior p :real^N->bool = {})` MP_TAC THENL [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYHEDRON_IMP_CONVEX] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`p:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN r ==> (a h1) dot (x:real^N) = b h1 /\ (a h2) dot x = b h2 /\ (a (h3:real^N->bool)) dot x = b h3` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?z:real^N. z IN r` CHOOSE_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY UNDISCH_TAC [`~((a:(real^N->bool)->real^N) h1 = a h2)`; `~((a:(real^N->bool)->real^N) h1 = a h3)`; `~((a:(real^N->bool)->real^N) h2 = a h3)`; `aff_dim(p:real^N->bool) - &2 <= aff_dim(r:real^N->bool)`] THEN MAP_EVERY (fun t -> FIRST_X_ASSUM(fun th -> MP_TAC(SPEC t th) THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `z:real^N` o CONJUNCT2 o CONJUNCT2)) [`h1:real^N->bool`; `h2:real^N->bool`; `h3:real^N->bool`] THEN SUBGOAL_THEN `(z:real^N) IN (affine hull p)` ASSUME_TAC THENL [MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN UNDISCH_TAC `(z:real^N) IN (affine hull p)` THEN SUBGOAL_THEN `(a h1) dot (z:real^N) = b h1 /\ (a h2) dot z = b h2 /\ (a (h3:real^N->bool)) dot z = b h3` (REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(r:real^N->bool) SUBSET affine hull p` MP_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `~((a:(real^N->bool)->real^N) h1 = vec 0) /\ ~((a:(real^N->bool)->real^N) h2 = vec 0) /\ ~((a:(real^N->bool)->real^N) h3 = vec 0)` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN UNDISCH_TAC `(z:real^N) IN r` THEN POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY SPEC_TAC [`(a:(real^N->bool)->real^N) h1`,`a1:real^N`; `(a:(real^N->bool)->real^N) h2`,`a2:real^N`; `(a:(real^N->bool)->real^N) h3`,`a3:real^N`] THEN REPEAT GEN_TAC THEN GEN_GEOM_ORIGIN_TAC `z:real^N` ["a1"; "a2"; "a3"] THEN REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ADD_LID] THEN REWRITE_TAC[DOT_RADD; IMAGE_CLAUSES; REAL_ARITH `a + b:real <= a <=> b <= &0`; REAL_ARITH `a + b:real < a <=> b < &0`; REAL_ARITH `a + b:real = a <=> b = &0`] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `aff_dim(p:real^N->bool) = &(dim p)` SUBST_ALL_TAC THENL [ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]; ALL_TAC] THEN SUBGOAL_THEN `aff_dim(r:real^N->bool) = &(dim r)` SUBST_ALL_TAC THENL [ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[INT_OF_NUM_ADD; INT_OF_NUM_LE; INT_ARITH `p - &2:int <= q <=> p <= q + &2`]) THEN MP_TAC(ISPECL [`{a1:real^N,a2,a3}`; `r:real^N->bool`] DIM_ORTHOGONAL_SUM) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `p <= r + 2 ==> u <= p /\ 3 <= t ==> ~(u = t + r)`)) THEN SUBGOAL_THEN `affine hull p :real^N->bool = span p` SUBST_ALL_TAC THENL [ASM_MESON_TAC[AFFINE_HULL_EQ_SPAN]; ALL_TAC] THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN] THEN MATCH_MP_TAC DIM_SUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `{a1:real^N,a2,a3}` DEPENDENT_BIGGERSET_GENERAL) THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; ARITH] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[ARITH_RULE `~(3 > x) <=> 3 <= x`] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[DELETE_INSERT; EMPTY_DELETE] THEN REWRITE_TAC[SPAN_2; IN_ELIM_THM; IN_UNIV] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN W(fun (asl,w) -> let fv = frees w and av = [`a1:real^N`; `a2:real^N`; `a3:real^N`] in MAP_EVERY (fun t -> SPEC_TAC(t,t)) (subtract fv av @ av)) THEN REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN MATCH_MP_TAC(MESON[] `(!a1 a2 a3. P a1 a2 a3 ==> P a2 a1 a3 /\ P a3 a1 a2) /\ (!a1 a2 a3. Q a1 a2 a3 ==> ~(P a1 a2 a3)) ==> !a3 a2 a1. P a1 a2 a3 ==> ~(Q a1 a2 a3 \/ Q a2 a1 a3 \/ Q a3 a1 a2)`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (p ==> r) ==> p ==> q /\ r`) THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN REWRITE_TAC[CONJ_ACI] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `u:real` (X_CHOOSE_TAC `v:real`)) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `u = &0` THENL [ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `v = &0 \/ &0 < v \/ &0 < --v`) THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO]; REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b <= &0 <=> &0 <= a * --b`] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN REAL_ARITH_TAC; REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b < &0 <=> &0 < --a * b`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REAL_ARITH_TAC]; ALL_TAC] THEN ASM_CASES_TAC `v = &0` THENL [ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_MUL_LZERO] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `u = &0 \/ &0 < u \/ &0 < --u`) THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO]; REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b <= &0 <=> &0 <= a * --b`] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN REAL_ARITH_TAC; REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b < &0 <=> &0 < --a * b`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REAL_ARITH_TAC]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < u /\ &0 < v \/ &0 < u /\ &0 < --v \/ &0 < --u /\ &0 < v \/ &0 < --u /\ &0 < --v` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; UNDISCH_TAC `~({x | a2 dot x <= &0} INTER {x | a3 dot x <= &0} SUBSET {x:real^N | a1 dot x <= &0})` THEN ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`] THEN REWRITE_TAC[REAL_NEG_ADD; GSYM REAL_MUL_RNEG] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_LT_IMP_LE]; UNDISCH_TAC `~({x | a1 dot x <= &0} INTER {x | a3 dot x <= &0} SUBSET {x:real^N | a2 dot x <= &0})` THEN ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN GEN_TAC THEN REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN MATCH_MP_TAC(REAL_ARITH `(&0 < u * a2 <=> &0 < a2) /\ (&0 < --v * a3 <=> &0 < a3) ==> u * a2 + v * a3 <= &0 /\ a3 <= &0 ==> a2 <= &0`) THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ]; UNDISCH_TAC `~({x | a1 dot x <= &0} INTER {x | a2 dot x <= &0} SUBSET {x:real^N | a3 dot x <= &0})` THEN ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN GEN_TAC THEN REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN MATCH_MP_TAC(REAL_ARITH `(&0 < --u * a2 <=> &0 < a2) /\ (&0 < v * a3 <=> &0 < a3) ==> u * a2 + v * a3 <= &0 /\ a2 <= &0 ==> a3 <= &0`) THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ]; UNDISCH_TAC `(a1:real^N) dot w < &0` THEN ASM_REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < --u * --a /\ &0 < --v * --b ==> ~(u * a + v * b < &0)`) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Lower bounds on then number of 0 and n-1 dimensional faces. *) (* ------------------------------------------------------------------------- *) let POLYTOPE_VERTEX_LOWER_BOUND = prove (`!p:real^N->bool. polytope p ==> aff_dim p + &1 <= &(CARD {v | v extreme_point_of p})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim(convex hull {v:real^N | v extreme_point_of p}) + &1` THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM KREIN_MILMAN_MINKOWSKI; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_COMPACT; INT_LE_REFL]; REWRITE_TAC[AFF_DIM_CONVEX_HULL; GSYM INT_LE_SUB_LADD] THEN MATCH_MP_TAC AFF_DIM_LE_CARD THEN MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON]]);; let POLYTOPE_FACET_LOWER_BOUND = prove (`!p:real^N->bool. polytope p /\ ~(aff_dim p = &0) ==> aff_dim p + &1 <= &(CARD {f | f facet_of p})`, GEN_TAC THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN ASM_SIMP_TAC[AFF_DIM_EMPTY; FACET_OF_EMPTY; EMPTY_GSPEC; CARD_CLAUSES] THEN CONV_TAC INT_REDUCE_CONV THEN STRIP_TAC THEN SUBGOAL_THEN `?n. {f:real^N->bool | f facet_of p} HAS_SIZE n /\ aff_dim p + &1 <= &n` (fun th -> MESON_TAC[th; HAS_SIZE]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN REPEAT STRIP_TAC THEN EXISTS_TAC `CARD {f:real^N->bool | f facet_of p}` THEN ASM_SIMP_TAC[FINITE_POLYTOPE_FACETS; HAS_SIZE] THEN UNDISCH_TAC `~(aff_dim(p:real^N->bool) = &0)` THEN ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN REWRITE_TAC[INT_OF_NUM_EQ] THEN DISCH_TAC THEN MP_TAC(ISPEC `p:real^N->bool` POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL) THEN ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON] THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`H:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = v <=> v = vec 0`] THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN STRIP_TAC THEN MP_TAC(ISPECL [`p:real^N->bool`; `H:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN DISCH_THEN(K ALL_TAC) THEN SUBGOAL_THEN `!h:real^N->bool. h IN H ==> &0 <= b h` ASSUME_TAC THENL [UNDISCH_TAC `(vec 0:real^N) IN p` THEN EXPAND_TAC "p" THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM t]) THEN REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(CARD(H:(real^N->bool)->bool))` THEN CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `~(h <= a) ==> a + 1 <= h`) THEN DISCH_TAC THEN ASM_CASES_TAC `H:(real^N->bool)->bool = {}` THENL [UNDISCH_THEN `H:(real^N->bool)->bool = {}` SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERS_0; INTER_UNIV]) THEN UNDISCH_TAC `~(dim(p:real^N->bool) = 0)` THEN REWRITE_TAC[DIM_EQ_0] THEN EXPAND_TAC "p" THEN REWRITE_TAC[ASSUME `H:(real^N->bool)->bool = {}`; INTERS_0] THEN REWRITE_TAC[INTER_UNIV] THEN ASM_CASES_TAC `?n:real^N. n IN span p /\ ~(n = vec 0)` THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm n % n:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[SPAN_MUL]; ALL_TAC] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `h:real^N->bool`) THEN SUBGOAL_THEN `span(IMAGE (a:(real^N->bool)->real^N) (H DELETE h)) PSUBSET span(p)` MP_TAC THENL [REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN ASM_MESON_TAC[SPAN_ADD; SPAN_SUPERSET; VECTOR_ADD_LID]; DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN REWRITE_TAC[DIM_SPAN] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `h <= p ==> h':num < h ==> ~(h' = p)`)) THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(IMAGE (a:(real^N->bool)->real^N) (H DELETE h))` THEN ASM_SIMP_TAC[DIM_LE_CARD; FINITE_DELETE; FINITE_IMAGE] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(H DELETE (h:real^N->bool))` THEN ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN ASM_SIMP_TAC[CARD_EQ_0] THEN ASM SET_TAC[]]; DISCH_THEN(MP_TAC o MATCH_MP ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN)] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISJ_CASES_TAC(REAL_ARITH `&0 <= (a:(real^N->bool)->real^N) h dot n \/ &0 <= --((a:(real^N->bool)->real^N) h dot n)`) THENL [DISCH_THEN(MP_TAC o SPEC `--(B + &1) / norm(n) % n:real^N`); DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm(n) % n:real^N`)] THEN (ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; REAL_ABS_NEG; REAL_ARITH `~(abs(B + &1) <= B)`] THEN EXPAND_TAC "p" THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN ASM_SIMP_TAC[SPAN_MUL] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `k = {x:real^N | a k dot x <= b k}` SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `k:real^N->bool = h` THEN ASM_REWRITE_TAC[IN_ELIM_THM; DOT_RMUL] THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 <= y ==> x <= y`) THEN ASM_SIMP_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a:(real^N->bool)->real^N) k`) THEN REWRITE_TAC[orthogonal; DOT_SYM] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= --x * y /\ &0 <= z ==> x * y <= z`); MATCH_MP_TAC(REAL_ARITH `&0 <= x * --y /\ &0 <= z ==> x * y <= z`)] THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_ARITH `--a / b:real = --(a / b)`; REAL_NEG_NEG] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SET_RULE `{f | ?h. h IN s /\ f = g h} = IMAGE g s`] THEN MATCH_MP_TAC(ARITH_RULE `m:num = n ==> n <= m`) THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT THEN ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC]]);; (* ------------------------------------------------------------------------- *) (* The notion of n-simplex where n is an integer >= -1. *) (* ------------------------------------------------------------------------- *) parse_as_infix("simplex",(12,"right"));; let simplex = new_definition `n simplex s <=> ?c. ~(affine_dependent c) /\ &(CARD c):int = n + &1 /\ s = convex hull c`;; let SIMPLEX_TRANSLATION_EQ = prove (`!a:real^N s n. n simplex (IMAGE (\x. a + x) s) <=> n simplex s`, REWRITE_TAC[simplex] THEN ONCE_REWRITE_TAC[MESON[HAS_SIZE; AFFINE_INDEPENDENT_IMP_FINITE] `~affine_dependent c /\ P(CARD c) <=> ~affine_dependent c /\ ?n. c HAS_SIZE n /\ P n`] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [SIMPLEX_TRANSLATION_EQ];; let SIMPLEX_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s n. linear f /\ (!x y. f x = f y ==> x = y) ==> (n simplex (IMAGE f s) <=> n simplex s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[simplex] THEN ONCE_REWRITE_TAC[MESON[HAS_SIZE; AFFINE_INDEPENDENT_IMP_FINITE] `~affine_dependent c /\ P(CARD c) <=> ~affine_dependent c /\ ?n. c HAS_SIZE n /\ P n`] THEN MATCH_MP_TAC(MESON[] `!f. (!a. P(f a) <=> Q a) /\ (!b. P b ==> ?a. b = f a) ==> ((?b. P b) <=> (?a. Q a))`) THEN EXISTS_TAC `IMAGE (f:real^M->real^N)` THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY (fun x -> SPEC_TAC(x,x)) [`n:num`; `s:real^N->bool`; `f:real^M->real^N`] THEN GEOM_TRANSFORM_TAC[]; X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `{x | (f:real^M->real^N) x IN d}` THEN SUBGOAL_THEN `(d:real^N->bool) SUBSET convex hull d` MP_TAC THENL [REWRITE_TAC[HULL_SUBSET]; ASM SET_TAC[]]]);; add_linear_invariants [SIMPLEX_LINEAR_IMAGE_EQ];; let SIMPLEX = prove (`n simplex s <=> ?c. FINITE c /\ ~(affine_dependent c) /\ &(CARD c):int = n + &1 /\ s = convex hull c`, REWRITE_TAC[simplex] THEN MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);; let SIMPLEX_CONVEX_HULL = prove (`!c:real^N->bool n. ~affine_dependent c /\ &(CARD c) = n + &1 ==> n simplex (convex hull c)`, REWRITE_TAC[simplex] THEN MESON_TAC[]);; let CONVEX_SIMPLEX = prove (`!n s. n simplex s ==> convex s`, REWRITE_TAC[simplex] THEN MESON_TAC[CONVEX_CONVEX_HULL]);; let COMPACT_SIMPLEX = prove (`!n s. n simplex s ==> compact s`, REWRITE_TAC[SIMPLEX] THEN MESON_TAC[FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);; let CLOSED_SIMPLEX = prove (`!s n. n simplex s ==> closed s`, MESON_TAC[COMPACT_SIMPLEX; COMPACT_IMP_CLOSED]);; let SIMPLEX_IMP_POLYTOPE = prove (`!n s. n simplex s ==> polytope s`, REWRITE_TAC[simplex; polytope] THEN MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);; let SIMPLEX_IMP_POLYHEDRON = prove (`!s n. n simplex s ==> polyhedron s`, MESON_TAC[SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_POLYHEDRON]);; let SIMPLEX_IMP_CONVEX = prove (`!s:real^N->bool n. n simplex s ==> convex s`, MESON_TAC[SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_CONVEX]);; let SIMPLEX_IMP_COMPACT = prove (`!s:real^N->bool n. n simplex s ==> compact s`, MESON_TAC[SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_COMPACT]);; let SIMPLEX_IMP_CLOSED = prove (`!s:real^N->bool n. n simplex s ==> closed s`, MESON_TAC[SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_CLOSED]);; let SIMPLEX_DIM_GE = prove (`!n s. n simplex s ==> -- &1 <= n`, REWRITE_TAC[simplex] THEN INT_ARITH_TAC);; let SIMPLEX_EMPTY = prove (`!n. n simplex {} <=> n = -- &1`, GEN_TAC THEN REWRITE_TAC[SIMPLEX] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; CONJ_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[FINITE_EMPTY; CARD_CLAUSES; AFFINE_INDEPENDENT_EMPTY] THEN INT_ARITH_TAC);; let SIMPLEX_MINUS_1 = prove (`!s. (-- &1) simplex s <=> s = {}`, GEN_TAC THEN REWRITE_TAC[SIMPLEX; INT_ADD_LINV; INT_OF_NUM_EQ] THEN ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN SIMP_TAC[CARD_EQ_0] THEN REWRITE_TAC[NOT_IMP] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; AFFINE_INDEPENDENT_EMPTY] THEN REWRITE_TAC[CONVEX_HULL_EMPTY]);; let AFF_DIM_SIMPLEX = prove (`!s n. n simplex s ==> aff_dim s = n`, REWRITE_TAC[simplex; INT_ARITH `x:int = n + &1 <=> n = x - &1`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_DIM_CONVEX_HULL; AFF_DIM_AFFINE_INDEPENDENT]);; let SIMPLEX_EXTREME_POINTS = prove (`!n s:real^N->bool. n simplex s ==> FINITE {v | v extreme_point_of s} /\ ~(affine_dependent {v | v extreme_point_of s}) /\ &(CARD {v | v extreme_point_of s}) = n + &1 /\ s = convex hull {v | v extreme_point_of s}`, REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLEX; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `{v:real^N | v extreme_point_of s} = c` (fun th -> ASM_REWRITE_TAC[th]) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; EXTREME_POINT_OF_CONVEX_HULL] THEN ABBREV_TAC `c' = {v:real^N | v extreme_point_of (convex hull c)}` THEN DISCH_TAC THEN SUBGOAL_THEN `convex hull c:real^N->bool = convex hull c'` ASSUME_TAC THENL [EXPAND_TAC "c'" THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN ASM_MESON_TAC[HAS_SIZE; FINITE_IMP_COMPACT]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_MEMBER]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN REWRITE_TAC[] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(a:real^N) IN convex hull c'` MP_TAC THENL [ASM_MESON_TAC[HULL_INC]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] CONVEX_HULL_SUBSET_AFFINE_HULL)) THEN SUBGOAL_THEN `c' SUBSET (c DELETE (a:real^N))` MP_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[HULL_MONO; SUBSET]]]);; let SIMPLEX_FACE_OF_SIMPLEX = prove (`!n s f:real^N->bool. n simplex s /\ f face_of s ==> ?m. m <= n /\ m simplex f`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIMPLEX]) THEN REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `?c':real^N->bool. c' SUBSET c /\ f = convex hull c'` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]; ALL_TAC] THEN EXISTS_TAC `&(CARD(c':real^N->bool)) - &1:int` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_SUBSET)) THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN INT_ARITH_TAC; REWRITE_TAC[simplex] THEN EXISTS_TAC `c':real^N->bool` THEN ASM_REWRITE_TAC[INT_ARITH `a - &1 + &1:int = a`] THEN ASM_MESON_TAC[AFFINE_DEPENDENT_MONO]]);; let FACE_OF_SIMPLEX_SUBSET = prove (`!n s f:real^N->bool. n simplex s /\ f face_of s ==> ?c. c SUBSET {x | x extreme_point_of s} /\ f = convex hull c`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN ABBREV_TAC `c = {x:real^N | x extreme_point_of s}` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_MESON_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);; let SUBSET_FACE_OF_SIMPLEX = prove (`!s n c:real^N->bool. n simplex s /\ c SUBSET {x | x extreme_point_of s} ==> (convex hull c) face_of s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN REWRITE_TAC[HAS_SIZE] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `!t. u SUBSET t /\ DISJOINT s t ==> DISJOINT s u`) THEN EXISTS_TAC `affine hull ({v:real^N | v extreme_point_of s} DIFF c)` THEN REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN MATCH_MP_TAC DISJOINT_AFFINE_HULL THEN EXISTS_TAC `{v:real^N | v extreme_point_of s}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let FACES_OF_SIMPLEX = prove (`!n s. n simplex s ==> {f | f face_of s} = {convex hull c | c SUBSET {v | v extreme_point_of s}}`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_SIMPLEX_SUBSET; SUBSET_FACE_OF_SIMPLEX]);; let HAS_SIZE_FACES_OF_SIMPLEX = prove (`!n s:real^N->bool. n simplex s ==> {f | f face_of s} HAS_SIZE 2 EXP (num_of_int(n + &1))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP FACES_OF_SIMPLEX) THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GSYM o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ]; MATCH_MP_TAC HAS_SIZE_POWERSET THEN ASM_REWRITE_TAC[HAS_SIZE; NUM_OF_INT_OF_NUM]] THEN SUBGOAL_THEN `!a b. a SUBSET {v:real^N | v extreme_point_of s} /\ b SUBSET {v | v extreme_point_of s} /\ convex hull a SUBSET convex hull b ==> a SUBSET b` (fun th -> MESON_TAC[th]) THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!s t u. x IN s /\ s SUBSET t /\ t SUBSET u /\ u SUBSET v ==> x IN v`) THEN MAP_EVERY EXISTS_TAC [`convex hull a:real^N->bool`; `convex hull b:real^N->bool`; `affine hull b:real^N->bool`] THEN ASM_SIMP_TAC[HULL_INC; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]);; let FINITE_FACES_OF_SIMPLEX = prove (`!n s. n simplex s ==> FINITE {f | f face_of s}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FACES_OF_SIMPLEX) THEN SIMP_TAC[HAS_SIZE]);; let CARD_FACES_OF_SIMPLEX = prove (`!n s. n simplex s ==> CARD {f | f face_of s} = 2 EXP (num_of_int(n + &1))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FACES_OF_SIMPLEX) THEN SIMP_TAC[HAS_SIZE]);; let CHOOSE_SIMPLEX = prove (`!n. --(&1) <= n /\ n <= &(dimindex(:N)) ==> ?s:real^N->bool. n simplex s`, X_GEN_TAC `d:int` THEN REWRITE_TAC[INT_ARITH `--(&1):int <= n <=> n = --(&1) \/ &0 <= n`] THEN DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC MP_TAC) THENL [ASM_MESON_TAC[SIMPLEX_EMPTY]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INT_OF_NUM_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN REWRITE_TAC[INT_OF_NUM_LE; GSYM DIM_UNIV] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `convex hull ((vec 0:real^N) INSERT c)` THEN REWRITE_TAC[simplex] THEN EXISTS_TAC `(vec 0:real^N) INSERT c` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP INDEPENDENT_NONZERO) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN ASM_SIMP_TAC[CARD_CLAUSES; GSYM INT_OF_NUM_SUC] THEN ASM_SIMP_TAC[INDEPENDENT_IMP_AFFINE_DEPENDENT_0] THEN ASM_MESON_TAC[HAS_SIZE]);; let CHOOSE_SURROUNDING_SIMPLEX = prove (`!a:real^N n. &0 <= n /\ n <= &(dimindex (:N)) ==> ?s. n simplex s /\ a IN relative_interior s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `n:int` CHOOSE_SIMPLEX) THEN ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N->bool`) THEN SUBGOAL_THEN `~(relative_interior c:real^N->bool = {})` MP_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLEX_IMP_CONVEX) THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP AFF_DIM_SIMPLEX) THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN ASM_INT_ARITH_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (\x:real^N. (a - b) + x) c` THEN ASM_REWRITE_TAC[SIMPLEX_TRANSLATION_EQ; RELATIVE_INTERIOR_TRANSLATION] THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH]);; let CHOOSE_SURROUNDING_SIMPLEX_FULL = prove (`!a:real^N. ?s. &(dimindex(:N)) simplex s /\ a IN interior s`, GEN_TAC THEN MP_TAC(ISPECL [`a:real^N`; `&(dimindex(:N)):int`] CHOOSE_SURROUNDING_SIMPLEX) THEN REWRITE_TAC[INT_POS; INT_LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[RELATIVE_INTERIOR_INTERIOR; AFF_DIM_EQ_FULL; AFF_DIM_SIMPLEX]);; let CHOOSE_POLYTOPE = prove (`!n. --(&1) <= n /\ n <= &(dimindex(:N)) ==> ?s:real^N->bool. polytope s /\ aff_dim s = n`, MESON_TAC[CHOOSE_SIMPLEX; SIMPLEX_IMP_POLYTOPE; AFF_DIM_SIMPLEX]);; let SIMPLEX_SING = prove (`!n a:real^N. n simplex {a} <=> n = &0`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP AFF_DIM_SIMPLEX) THEN REWRITE_TAC[AFF_DIM_SING; EQ_SYM_EQ]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[simplex] THEN EXISTS_TAC `{a:real^N}` THEN REWRITE_TAC[AFFINE_INDEPENDENT_1; CONVEX_HULL_SING] THEN REWRITE_TAC[CARD_SING; INT_ADD_LID]]);; let SIMPLEX_ZERO = prove (`!s:real^N->bool. &0 simplex s <=> ?a. s = {a}`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[SIMPLEX_SING]] THEN REWRITE_TAC[simplex; INT_ADD_LID; INT_OF_NUM_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(HAS_SIZE_CONV `(t:real^N->bool) HAS_SIZE 1`) THEN ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; HAS_SIZE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_HULL_SING] THEN MESON_TAC[]);; let SIMPLEX_SEGMENT_CASES = prove (`!a b:real^N. (if a = b then &0 else &1) simplex segment[a,b]`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL; SIMPLEX_SING] THEN REWRITE_TAC[simplex] THEN EXISTS_TAC `{a:real^N,b}` THEN ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_INDEPENDENT_2] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_SING; IN_SING; CARD_SING] THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN INT_ARITH_TAC);; let SIMPLEX_SEGMENT = prove (`!a b. ?n. n simplex segment[a,b]`, MESON_TAC[SIMPLEX_SEGMENT_CASES]);; let POLYTOPE_LOWDIM_IMP_SIMPLEX = prove (`!p:real^N->bool. polytope p /\ aff_dim p <= &1 ==> ?n. n simplex p`, GEN_TAC THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN ASM_REWRITE_TAC[SIMPLEX_EMPTY; EXISTS_REFL; GSYM COLLINEAR_AFF_DIM] THEN STRIP_TAC THEN MP_TAC(ISPEC `p:real^N->bool` COMPACT_CONVEX_COLLINEAR_SEGMENT) THEN ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_COMPACT] THEN MESON_TAC[SIMPLEX_SEGMENT]);; let SIMPLEX_INSERT_DIMPLUS1 = prove (`!n s a:real^N. n simplex s /\ ~(a IN affine hull s) ==> (n + &1) simplex (convex hull (a INSERT s))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simplex]) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[simplex] THEN EXISTS_TAC `(a:real^N) INSERT k` THEN UNDISCH_TAC `~((a:real^N) IN affine hull s)` THEN ASM_SIMP_TAC[AFFINE_HULL_CONVEX_HULL; AFFINE_INDEPENDENT_INSERT] THEN ASM_CASES_TAC `(a:real^N) IN k` THENL [ASM_MESON_TAC[HULL_INC]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_CLAUSES; AFFINE_INDEPENDENT_IMP_FINITE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT]);; let SIMPLEX_INSERT = prove (`!s a:real^N. (?n. n simplex s) /\ ~(a IN affine hull s) ==> ?n. n simplex (convex hull (a INSERT s))`, MESON_TAC[SIMPLEX_INSERT_DIMPLUS1]);; let SIMPLEX_ALT = prove (`!s:real^N->bool i. i simplex s <=> convex s /\ compact s /\ FINITE {v | v extreme_point_of s} /\ &(CARD {v | v extreme_point_of s}) = i + &1 /\ ~affine_dependent {v | v extreme_point_of s}`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SIMPLEX_EXTREME_POINTS; SIMPLEX_IMP_CONVEX; SIMPLEX_IMP_COMPACT]; STRIP_TAC THEN REWRITE_TAC[simplex] THEN EXISTS_TAC `{v:real^N | v extreme_point_of s}` THEN ASM_MESON_TAC[KREIN_MILMAN_MINKOWSKI]]);; let SIMPLEX_ALT1 = prove (`!s:real^N->bool. (&n - &1) simplex s <=> convex s /\ compact s /\ {v | v extreme_point_of s} HAS_SIZE n /\ ~affine_dependent {v | v extreme_point_of s}`, REWRITE_TAC[SIMPLEX_ALT; INT_SUB_ADD; INT_OF_NUM_EQ; HAS_SIZE] THEN CONV_TAC TAUT);; let SIMPLEX_0_NOT_IN_AFFINE_HULL = prove (`!s:real^N->bool. (&n - &1) simplex s /\ ~(vec 0 IN affine hull s) <=> convex s /\ compact s /\ {v | v extreme_point_of s} HAS_SIZE n /\ independent {v | v extreme_point_of s}`, GEN_TAC THEN MP_TAC(ISPEC `s:real^N->bool` KREIN_MILMAN_MINKOWSKI) THEN REWRITE_TAC[independent; DEPENDENT_AFFINE_DEPENDENT_CASES; SIMPLEX_ALT1] THEN MESON_TAC[AFFINE_HULL_CONVEX_HULL]);; (* ------------------------------------------------------------------------- *) (* Simplicial complexes and triangulations. *) (* ------------------------------------------------------------------------- *) let simplicial_complex = new_definition `simplicial_complex c <=> FINITE c /\ (!s. s IN c ==> ?n. n simplex s) /\ (!f s. s IN c /\ f face_of s ==> f IN c) /\ (!s s'. s IN c /\ s' IN c ==> (s INTER s') face_of s /\ (s INTER s') face_of s')`;; let triangulation = new_definition `triangulation(tr:(real^N->bool)->bool) <=> FINITE tr /\ (!t. t IN tr ==> ?n. n simplex t) /\ (!t t'. t IN tr /\ t' IN tr ==> (t INTER t') face_of t /\ (t INTER t') face_of t')`;; let SIMPLICIAL_COMPLEX_TRANSLATION = prove (`!a:real^N tr. simplicial_complex(IMAGE (IMAGE (\x. a + x)) tr) <=> simplicial_complex tr`, REWRITE_TAC[simplicial_complex] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [SIMPLICIAL_COMPLEX_TRANSLATION];; let SIMPLICIAL_COMPLEX_LINEAR_IMAGE = prove (`!f:real^M->real^N tr. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> (simplicial_complex(IMAGE (IMAGE f) tr) <=> simplicial_complex tr)`, REWRITE_TAC[simplicial_complex] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [SIMPLICIAL_COMPLEX_LINEAR_IMAGE];; let TRIANGULATION_TRANSLATION = prove (`!a:real^N tr. triangulation(IMAGE (IMAGE (\x. a + x)) tr) <=> triangulation tr`, REWRITE_TAC[triangulation] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [TRIANGULATION_TRANSLATION];; let TRIANGULATION_LINEAR_IMAGE = prove (`!f:real^M->real^N tr. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> (triangulation(IMAGE (IMAGE f) tr) <=> triangulation tr)`, REWRITE_TAC[triangulation] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [TRIANGULATION_LINEAR_IMAGE];; let SIMPLICIAL_COMPLEX_IMP_TRIANGULATION = prove (`!tr. simplicial_complex tr ==> triangulation tr`, REWRITE_TAC[triangulation; simplicial_complex] THEN MESON_TAC[]);; let TRIANGULATION_SUBSET = prove (`!tr:(real^N->bool)->bool tr'. triangulation tr /\ tr' SUBSET tr ==> triangulation tr'`, REWRITE_TAC[triangulation] THEN MESON_TAC[SUBSET; FINITE_SUBSET]);; let TRIANGULATION_UNION = prove (`!tr1 tr2. triangulation(tr1 UNION tr2) <=> triangulation tr1 /\ triangulation tr2 /\ (!s t. s IN tr1 /\ t IN tr2 ==> s INTER t face_of s /\ s INTER t face_of t)`, REWRITE_TAC[triangulation; FINITE_UNION; IN_UNION] THEN MESON_TAC[INTER_COMM]);; let TRIANGULATION_INTER_SIMPLEX = prove (`!tr t t':real^N->bool. triangulation tr /\ t IN tr /\ t' IN tr ==> t INTER t' = convex hull ({x | x extreme_point_of t} INTER {x | x extreme_point_of t'})`, REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^N->bool`; `t':real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th) [`t:real^N->bool`; `t':real^N->bool`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:int` THEN DISCH_TAC THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN MP_TAC(ISPECL [`m:int`; `t':real^N->bool`; `t INTER t':real^N->bool`] FACE_OF_SIMPLEX_SUBSET) THEN MP_TAC(ISPECL [`n:int`; `t:real^N->bool`; `t INTER t':real^N->bool`] FACE_OF_SIMPLEX_SUBSET) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN DISCH_THEN(X_CHOOSE_THEN `d':real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_INTER; CONVEX_SIMPLEX]] THEN SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; extreme_point_of]] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull {x:real^N | x extreme_point_of (t INTER t')}` THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN ASM_MESON_TAC[COMPACT_INTER; CONVEX_INTER; COMPACT_SIMPLEX; CONVEX_SIMPLEX]; MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [SUBST1_TAC(SYM(ASSUME `convex hull d:real^N->bool = t INTER t'`)); SUBST1_TAC(SYM(ASSUME `convex hull d':real^N->bool = t INTER t'`))] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN ASM SET_TAC[]]);; let TRIANGULATION_SIMPLICIAL_COMPLEX = prove (`!tr. triangulation tr ==> simplicial_complex {f:real^N->bool | ?t. t IN tr /\ f face_of t}`, let lemma = prove (`{f | ?t. t IN tr /\ P f t} = UNIONS (IMAGE (\t. {f | P f t}) tr)`, GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIONS; IN_IMAGE; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_ELIM_THM]) in REWRITE_TAC[triangulation; simplicial_complex] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[lemma] THEN ASM_SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[FINITE_FACES_OF_SIMPLEX]; ASM_MESON_TAC[SIMPLEX_FACE_OF_SIMPLEX]; ASM_MESON_TAC[FACE_OF_TRANS]; ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]]);; let TRIANGULATION_SIMPLEX_FACES = prove (`!s:real^N->bool n d. n simplex s ==> triangulation {c | c face_of s /\ aff_dim c = d}`, REPEAT GEN_TAC THEN REWRITE_TAC[triangulation; IN_ELIM_THM] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | x IN {y | P y} /\ Q x}`] THEN MATCH_MP_TAC FINITE_RESTRICT THEN MATCH_MP_TAC FINITE_POLYTOPE_FACES THEN ASM_MESON_TAC[SIMPLEX_IMP_POLYTOPE]; ASM_MESON_TAC[SIMPLEX_FACE_OF_SIMPLEX]; REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_INTER] THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET; INTER_SUBSET]]);; let TRIANGULATION_SIMPLEX_FACETS = prove (`!s:real^N->bool n. n simplex s ==> triangulation {c | c facet_of s}`, REPEAT STRIP_TAC THEN REWRITE_TAC[facet_of] THEN MATCH_MP_TAC TRIANGULATION_SUBSET THEN EXISTS_TAC `{c:real^N->bool | c face_of s /\ aff_dim c = aff_dim s - &1}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC TRIANGULATION_SIMPLEX_FACES THEN ASM_MESON_TAC[]);; let CELL_COMPLEX_DISJOINT_RELATIVE_INTERIORS = prove (`!c d:real^N->bool. c INTER d face_of c /\ c INTER d face_of d /\ ~(c = d) ==> relative_interior c INTER relative_interior d = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `c INTER d:real^N->bool`FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `d:real^N->bool` th) THEN MP_TAC(SPEC `c:real^N->bool` th)) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY (MP_TAC o C ISPEC RELATIVE_INTERIOR_SUBSET) [`c:real^N->bool`; `d:real^N->bool`] THEN ASM SET_TAC[]);; let TRIANGULATION_DISJOINT_RELATIVE_INTERIORS = prove (`!t c d:real^N->bool. triangulation t /\ c IN t /\ d IN t /\ ~(c = d) ==> relative_interior c INTER relative_interior d = {}`, REWRITE_TAC[triangulation] THEN MESON_TAC[CELL_COMPLEX_DISJOINT_RELATIVE_INTERIORS]);; let SIMPLICIAL_COMPLEX_DISJOINT_RELATIVE_INTERIORS = prove (`!t c d:real^N->bool. simplicial_complex t /\ c IN t /\ d IN t /\ ~(c = d) ==> relative_interior c INTER relative_interior d = {}`, MESON_TAC[TRIANGULATION_DISJOINT_RELATIVE_INTERIORS; SIMPLICIAL_COMPLEX_IMP_TRIANGULATION]);; let NOT_IN_AFFINE_HULL_SURFACE_TRIANGULATION = prove (`!t u z. convex u /\ bounded u /\ z IN interior u /\ triangulation t /\ UNIONS t SUBSET frontier u ==> !c:real^N->bool. c IN t ==> ~(z IN affine hull c)`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure u:real^N->bool`; `c:real^N->bool`] CONVEX_RELATIVE_BOUNDARY_SUBSET_OF_PROPER_FACE) THEN ASM_SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE; CONVEX_CLOSURE] THEN REWRITE_TAC[GSYM relative_frontier; CLOSURE_EQ_EMPTY; NOT_IMP] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_EMPTY; NOT_IN_EMPTY]; ASM_MESON_TAC[triangulation; SIMPLEX_IMP_CONVEX]; MP_TAC(ISPEC `u:real^N->bool` RELATIVE_FRONTIER_NONEMPTY_INTERIOR) THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`closure u:real^N->bool`; `k:real^N->bool`] AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN ASM_SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE; CONVEX_CLOSURE] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR] THEN ASM_MESON_TAC[SUBSET; HULL_MONO]);; let TRIANGULATION_SUBFACES = prove (`!tr:(real^N->bool)->bool tr'. triangulation tr /\ (!c'. c' IN tr' ==> ?c. c IN tr /\ c' face_of c) ==> triangulation tr'`, REPEAT GEN_TAC THEN REWRITE_TAC[triangulation] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `UNIONS {{f:real^N->bool | f face_of c} | c IN tr}` THEN REWRITE_TAC[FINITE_UNIONS; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN CONJ_TAC THENL [ASM_MESON_TAC[FINITE_FACES_OF_SIMPLEX]; ALL_TAC] THEN REWRITE_TAC[UNIONS_IMAGE] THEN ASM SET_TAC[]; ASM_MESON_TAC[SIMPLEX_FACE_OF_SIMPLEX]; ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]]);; (* ------------------------------------------------------------------------- *) (* Subdividing a cell complex (not necessarily simplicial). *) (* ------------------------------------------------------------------------- *) let CELL_COMPLEX_SUBDIVISION_EXISTS = prove (`!m:(real^N->bool)->bool d e. &0 < e /\ FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c. c IN m ==> aff_dim c <= d) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> ?m'. (!c. c IN m' ==> diameter c < e) /\ UNIONS m' = UNIONS m /\ FINITE m' /\ (!c. c IN m' ==> ?d. d IN m /\ c SUBSET d) /\ (!c x. c IN m /\ x IN c ==> ?d. d IN m' /\ x IN d /\ d SUBSET c) /\ (!c. c IN m' ==> polytope c) /\ (!c. c IN m' ==> aff_dim c <= d) /\ (!c1 c2. c1 IN m' /\ c2 IN m' ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2)`, let lemma1 = prove (`a < abs(x - y) ==> &0 < a ==> ?n. integer n /\ (x < n * a /\ n * a < y \/ y < n * a /\ n * a < x)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC INTEGER_EXISTS_BETWEEN_ABS_LT THEN REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_ABS_INV; REAL_ARITH `&0 < x ==> abs x = x`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE]) and lemma2 = prove (`!m:(real^N->bool)->bool d. FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c. c IN m ==> aff_dim c <= d) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> !i. FINITE i ==> ?m'. UNIONS m' = UNIONS m /\ FINITE m' /\ (!c. c IN m' ==> ?d. d IN m /\ c SUBSET d) /\ (!c x. c IN m /\ x IN c ==> ?d. d IN m' /\ x IN d /\ d SUBSET c) /\ (!c. c IN m' ==> polytope c) /\ (!c. c IN m' ==> aff_dim c <= d) /\ (!c1 c2. c1 IN m' /\ c2 IN m' ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\ (!c x y. c IN m' /\ x IN c /\ y IN c ==> !a b. (a,b) IN i ==> a dot x <= b /\ a dot y <= b \/ a dot x >= b /\ a dot y >= b)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY; FORALL_PAIR_THM] THEN CONJ_TAC THENL [EXISTS_TAC `m:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `i:(real^N#real)->bool`] THEN GEN_REWRITE_TAC I [IMP_CONJ] THEN DISCH_THEN(X_CHOOSE_THEN `n:(real^N->bool)->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) MP_TAC) THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN EXISTS_TAC `{c INTER {x:real^N | a dot x <= b} | c IN n} UNION {c INTER {x:real^N | a dot x >= b} | c IN n}` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_UNION; GSYM INTER_UNIONS; GSYM UNION_OVER_INTER] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s) ==> t INTER s = t`) THEN REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[FINITE_UNION; SIMPLE_IMAGE; FINITE_IMAGE]; REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[SUBSET_TRANS; INTER_SUBSET]; REWRITE_TAC[EXISTS_IN_UNION; EXISTS_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[OR_EXISTS_THM] THEN UNDISCH_THEN `!c x:real^N. c IN m /\ x IN c ==> ?d. d IN n /\ x IN d /\ d SUBSET c` (MP_TAC o SPECL [`c:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(a:real^N) dot x`; `b:real`] REAL_LE_TOTAL) THEN REWRITE_TAC[real_ge] THEN ASM SET_TAC[]; REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[POLYTOPE_INTER_POLYHEDRON; POLYHEDRON_HALFSPACE_LE; POLYHEDRON_HALFSPACE_GE]; REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[INT_LE_TRANS; AFF_DIM_SUBSET; INTER_SUBSET]; REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SET_RULE `(s INTER t) INTER (s' INTER t') = (s INTER s') INTER (t INTER t')`] THEN MATCH_MP_TAC FACE_OF_INTER_INTER THEN ASM_SIMP_TAC[] THEN SIMP_TAC[SET_RULE `s INTER s = s`; FACE_OF_REFL; CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE] THEN REWRITE_TAC[INTER; IN_ELIM_THM; HYPERPLANE_FACE_OF_HALFSPACE_LE; HYPERPLANE_FACE_OF_HALFSPACE_GE; REAL_ARITH `a <= b /\ a >= b <=> a = b`; REAL_ARITH `a >= b /\ a <= b <=> a = b`]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_UNION; FORALL_AND_THM; IN_INSERT; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_INTER; IN_ELIM_THM; PAIR_EQ] THEN SIMP_TAC[] THEN ASM_MESON_TAC[]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `bounded(UNIONS m:real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED]; ALL_TAC] THEN REWRITE_TAC[BOUNDED_POS_LT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(ISPECL [`--B / (e / &2 / &(dimindex(:N)))`; `B / (e / &2 / &(dimindex(:N)))`] FINITE_INTSEG) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_HALF; REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN ABBREV_TAC `k = {i | integer i /\ abs(i * e / &2 / &(dimindex(:N))) <= B}` THEN DISCH_TAC THEN MP_TAC(ISPECL [`m:(real^N->bool)->bool`; `d:int`] lemma2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `{ (basis i:real^N,j * e / &2 / &(dimindex(:N))) | i IN 1..dimindex(:N) /\ j IN k}`) THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_NUMSEG] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY] THEN REWRITE_TAC[NOT_LT; DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma1) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN DISCH_THEN(X_CHOOSE_THEN `j:real` (CONJUNCTS_THEN ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^N->bool`; `x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`basis i:real^N`; `j * e / &2 / &(dimindex(:N))`]) THEN ASM_SIMP_TAC[DOT_BASIS; IN_ELIM_THM; NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MAP_EVERY EXISTS_TAC [`i:num`; `j:real`] THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN EXPAND_TAC "k" THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM DISJ_CASES_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a < x /\ x < b ==> abs a <= c /\ abs b <= c ==> abs x <= c`)) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Refining a cell complex to a simplicial complex. *) (* ------------------------------------------------------------------------- *) let SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX_LOWDIM = prove (`!m:(real^N->bool)->bool d. FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c. c IN m ==> aff_dim c <= d) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> ?t. simplicial_complex t /\ (!k. k IN t ==> aff_dim k <= d) /\ UNIONS t = UNIONS m /\ (!c. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f) /\ (!k. k IN t ==> ?c. c IN m /\ k SUBSET c)`, let lemma1 = prove (`!s t u z:real^N. convex s /\ convex t /\ convex u /\ z IN relative_interior s /\ t SUBSET relative_frontier s /\ u SUBSET relative_frontier s ==> convex hull (z INSERT t) INTER convex hull (z INSERT u) = convex hull (z INSERT (t INTER u))`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_INTER] THEN SIMP_TAC[HULL_MONO; INTER_SUBSET; SET_RULE `s SUBSET t ==> z INSERT s SUBSET z INSERT t`] THEN REWRITE_TAC[CONVEX_HULL_INSERT_SEGMENTS] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[INTER_EMPTY; INTER_SUBSET] THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_REWRITE_TAC[INTER_EMPTY; INTER_SUBSET] THEN REWRITE_TAC[SUBSET; IN_INTER; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM_SIMP_TAC[HULL_P] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC)) THEN ASM_CASES_TAC `v:real^N = w` THENL [COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ASM_CASES_TAC `x:real^N = z` THENL [COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN REWRITE_TAC[ENDS_IN_SEGMENT] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; CONVEX_HULL_EQ_EMPTY]; MATCH_MP_TAC(TAUT `F ==> p`)]] THEN SUBGOAL_THEN `~(v:real^N = z) /\ ~(w:real^N = z)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[relative_frontier; SUBSET; IN_DIFF]; ALL_TAC] THEN MP_TAC(ISPECL [`v:real^N`; `z:real^N`; `x:real^N`; `w:real^N`] COLLINEAR_3_TRANS) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR o GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT])) THEN SIMP_TAC[INSERT_AC]; ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN REWRITE_TAC[COLLINEAR_BETWEEN_CASES]] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [RULE_ASSUM_TAC(REWRITE_RULE[GSYM BETWEEN_IN_SEGMENT]) THEN ASM_MESON_TAC[BETWEEN_SYM; BETWEEN_TRANS; BETWEEN_TRANS_2; BETWEEN_ANTISYM]; REWRITE_TAC[BETWEEN_IN_SEGMENT]] THEN STRIP_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`; `w:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[relative_frontier; SUBSET; IN_DIFF]; REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `v:real^N`)] THEN REWRITE_TAC[NOT_IMP] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ONCE_REWRITE_TAC[segment] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[relative_frontier; SUBSET; IN_DIFF]; MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`; `v:real^N`] IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_MESON_TAC[relative_frontier; SUBSET; IN_DIFF]; REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `w:real^N`)] THEN REWRITE_TAC[NOT_IMP] THEN ONCE_REWRITE_TAC[segment] THEN ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[relative_frontier; SUBSET; IN_DIFF]]) in let lemma2 = prove (`!n m:(real^N->bool)->bool. FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c. c IN m ==> aff_dim c <= &n) /\ (!c f. c IN m /\ f face_of c ==> f IN m) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> ?t. simplicial_complex t /\ (!k. k IN t ==> aff_dim k <= &n) /\ UNIONS t = UNIONS m /\ (!c. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f) /\ (!k. k IN t ==> ?c. c IN m /\ k SUBSET c)`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `m:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `n <= 1` THENL [EXISTS_TAC `m:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[simplicial_complex] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC POLYTOPE_LOWDIM_IMP_SIMPLEX THEN ASM_MESON_TAC[INT_OF_NUM_LE; INT_LE_TRANS]; MESON_TAC[SING_SUBSET; UNIONS_1; FINITE_SING; SUBSET_REFL]]; RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 0)`))] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ASM_REWRITE_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN ABBREV_TAC `sk = {c:real^N->bool | c IN m /\ aff_dim c < &n}` THEN DISCH_THEN(MP_TAC o SPEC `sk:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; LT_IMP_LE] THEN REWRITE_TAC[INT_ARITH `x:int <= y - &1 <=> x < y`] THEN ANTS_TAC THENL [EXPAND_TAC "sk" THEN CONJ_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_MESON_TAC[FACE_OF_IMP_SUBSET; AFF_DIM_SUBSET; INT_LET_TRANS]; DISCH_THEN(X_CHOOSE_THEN `sc:(real^N->bool)->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `?t. simplicial_complex t /\ (!k. k IN t ==> aff_dim k <= &n) /\ (!c. c IN m ==> (?f. f SUBSET t /\ c = UNIONS f)) /\ (!k. k IN t ==> (?c:real^N->bool. c IN m /\ k SUBSET c))` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:(real^N->bool)->bool` THEN ASM_CASES_TAC `FINITE(t:(real^N->bool)->bool)` THENL [ALL_TAC; ASM_MESON_TAC[simplicial_complex]] THEN REPLICATE_TAC 2 (MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN MATCH_MP_TAC(TAUT `(q /\ r ==> p) /\ (q ==> q') ==> q /\ r ==> p /\ q' /\ r`) THEN CONJ_TAC THENL [SET_TAC[]; ASM_MESON_TAC[FINITE_SUBSET]]] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [simplicial_complex]) THEN REWRITE_TAC[simplicial_complex; GSYM CONJ_ASSOC] THEN ABBREV_TAC `fat = {c:real^N->bool | c IN m /\ aff_dim c = &n}` THEN SUBGOAL_THEN `(!c:real^N->bool. c IN fat ==> polytope c) /\ (!c. c IN fat ==> convex c) /\ (!c. c IN fat ==> closed c) /\ (!c. c IN fat ==> (@z. z IN relative_interior c) IN relative_interior c)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(TAUT `(p ==> q /\ r) /\ p /\ (q ==> s) ==> p /\ q /\ r /\ s`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_CLOSED]; ASM SET_TAC[]; REPEAT STRIP_TAC THEN CONV_TAC SELECT_CONV THEN ASM_SIMP_TAC[MEMBER_NOT_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY] THEN UNDISCH_TAC `(c:real^N->bool) IN fat` THEN EXPAND_TAC "fat" THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[IN_ELIM_THM] THEN REWRITE_TAC[AFF_DIM_EMPTY] THEN INT_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!k. k IN sc ==> ?t. ~affine_dependent t /\ CARD t <= n /\ aff_dim k < &n /\ k:real^N->bool = convex hull t` (LABEL_TAC "*") THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `?r. r simplex (k:real^N->bool)` CHOOSE_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `r = aff_dim(k:real^N->bool)` THENL [ALL_TAC; ASM_MESON_TAC[AFF_DIM_SIMPLEX]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simplex]) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `t:real^N->bool` THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN MATCH_MP_TAC(INT_ARITH `x:int < n ==> x + &1 <= n`) THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!c k. c IN fat /\ k IN sc /\ k SUBSET relative_frontier c ==> affine hull k INTER relative_interior c:real^N->bool = {}` (LABEL_TAC "-") THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `?f:real^N->bool. f face_of c /\ ~(f = c) /\ k SUBSET f` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?l:real^N->bool. l IN sk /\ k SUBSET l` STRIP_ASSUME_TAC THENL [ASM MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `l INTER c:real^N->bool` THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[SUBSET_INTER]] THEN CONJ_TAC THENL [MATCH_MP_TAC(MESON[INT_LT_REFL] `aff_dim s < aff_dim t ==> ~(s = t)`) THEN TRANS_TAC INT_LET_TRANS `aff_dim(l:real^N->bool)` THEN SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET] THEN ASM SET_TAC[]; TRANS_TAC SUBSET_TRANS `relative_frontier c:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN ASM SET_TAC[]]; MP_TAC(ISPECL [`c:real^N->bool`; `f:real^N->bool`] AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t INTER u = {} ==> s INTER u = {}`) THEN ASM_SIMP_TAC[HULL_MONO]]; ALL_TAC] THEN EXISTS_TAC `sc UNION { convex hull ((@z:real^N. z IN relative_interior c) INSERT k) | c IN fat /\ k IN sc /\ k SUBSET relative_frontier c}` THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[FINITE_UNION] THEN REWRITE_TAC[SET_RULE `A /\ x IN s /\ P x <=> A /\ x IN (s INTER {x | P x})`] THEN MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN ASM_SIMP_TAC[FINITE_INTER] THEN EXPAND_TAC "fat" THEN ASM_SIMP_TAC[FINITE_RESTRICT]; ASM_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC SIMPLEX_INSERT THEN ASM_SIMP_TAC[] THEN REMOVE_THEN "-" (MP_TAC o SPECL [`c:real^N->bool`; `k:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `z IN r ==> a INTER r = {} ==> ~(z IN a)`) THEN ASM_SIMP_TAC[]; REWRITE_TAC[FORALL_IN_UNION; IMP_CONJ] THEN X_GEN_TAC `f:real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_UNION]; ALL_TAC] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN ABBREV_TAC `z:real^N = @z. z IN relative_interior c` THEN SUBGOAL_THEN `(z:real^N) IN relative_interior c` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `i:real^N->bool` THEN SIMP_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ONCE_REWRITE_TAC[SET_RULE `z INSERT i = {z} UNION i`] THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN REWRITE_TAC[SET_RULE `{z} UNION i = z INSERT i`] THEN SUBGOAL_THEN `~((z:real^N) IN affine hull i)` ASSUME_TAC THENL [REMOVE_THEN "-" (MP_TAC o SPECL [`c:real^N->bool`; `k:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `a SUBSET a' /\ z IN r ==> a' INTER r = {} ==> ~(z IN a)`) THEN EXPAND_TAC "k" THEN ASM_REWRITE_TAC[SUBSET_REFL; AFFINE_HULL_CONVEX_HULL]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN DISCH_TAC THEN MP_TAC(ISPECL [`(z:real^N) INSERT i`; `f:real^N->bool`] FACE_OF_CONVEX_HULL_SUBSET) THEN ASM_SIMP_TAC[COMPACT_INSERT; FINITE_IMP_COMPACT] THEN DISCH_THEN(X_CHOOSE_THEN `j:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN ASM_CASES_TAC `(z:real^N) IN j` THENL [DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `convex hull (j DELETE (z:real^N))`] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "k" THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN EXISTS_TAC `j DELETE (z:real^N)` THEN ASM SET_TAC[]; TRANS_TAC SUBSET_TRANS `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "k" THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[SET_RULE `z INSERT i = {z} UNION i`] THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN REWRITE_TAC[SET_RULE `{z} UNION i = z INSERT i`] THEN EXPAND_TAC "f" THEN AP_TERM_TAC THEN ASM SET_TAC[]]; DISJ1_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "k" THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN EXISTS_TAC `j:real^N->bool` THEN ASM SET_TAC[]]; REWRITE_TAC[IN_UNION] THEN MATCH_MP_TAC(MESON[] `(!x y. R x y ==> R y x) /\ (!x y. P x /\ P y ==> R x y) /\ (!x y. P x /\ Q y ==> R x y) /\ (!x y. Q x /\ Q y ==> R x y) ==> !x y. (P x \/ Q x) /\ (P y \/ Q y) ==> R x y`) THEN CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ASM_REWRITE_TAC[]] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`l:real^N->bool`; `c:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN ABBREV_TAC `z:real^N = @z. z IN relative_interior c` THEN SUBGOAL_THEN `(z:real^N) IN relative_interior c` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `l INTER convex hull (z INSERT k):real^N->bool = l INTER convex hull k` SUBST1_TAC THENL [MATCH_MP_TAC INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR THEN EXISTS_TAC `c:real^N->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `relative_frontier c:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?d:real^N->bool. d IN sk /\ l SUBSET d` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `d:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(SET_RULE `d INTER s = {} ==> l SUBSET d ==> DISJOINT l s`) THEN MATCH_MP_TAC(SET_RULE `relative_interior c SUBSET c /\ (c INTER d) INTER relative_interior c = {} ==> d INTER relative_interior c = {}`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN MATCH_MP_TAC FACE_OF_DISJOINT_RELATIVE_INTERIOR THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[INT_LT_REFL] `aff_dim s < aff_dim t ==> ~(s = t)`) THEN TRANS_TAC INT_LET_TRANS `aff_dim(d:real^N->bool)` THEN SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `convex hull k:real^N->bool = k` SUBST1_TAC THENL [MATCH_MP_TAC HULL_P THEN MATCH_MP_TAC POLYTOPE_IMP_CONVEX THEN MATCH_MP_TAC SIMPLEX_IMP_POLYTOPE THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN TRANS_TAC FACE_OF_TRANS `k:real^N->bool` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `i:real^N->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `~((z:real^N) IN affine hull i)` ASSUME_TAC THENL [REMOVE_THEN "-" (MP_TAC o SPECL [`c:real^N->bool`; `k:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `a SUBSET a' /\ z IN r ==> a' INTER r = {} ==> ~(z IN a)`) THEN EXPAND_TAC "k" THEN ASM_REWRITE_TAC[SUBSET_REFL; AFFINE_HULL_CONVEX_HULL]; ALL_TAC] THEN EXPAND_TAC "k" THEN ONCE_REWRITE_TAC[SET_RULE `z INSERT i = {z} UNION i`] THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN REWRITE_TAC[SET_RULE `{z} UNION i = z INSERT i`] THEN ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT; AFFINE_INDEPENDENT_INSERT] THEN EXISTS_TAC `i:real^N->bool` THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `k:real^N->bool`; `d:real^N->bool`; `l:real^N->bool`] THEN STRIP_TAC THEN ABBREV_TAC `z:real^N = @z. z IN relative_interior c` THEN SUBGOAL_THEN `(z:real^N) IN relative_interior c` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `d:real^N->bool = c` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REWRITE_TAC[]; ABBREV_TAC `w:real^N = @z. z IN relative_interior d` THEN SUBGOAL_THEN `(w:real^N) IN relative_interior d` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `convex hull (z INSERT k) INTER convex hull (w INSERT l):real^N->bool = convex hull (z INSERT k) INTER convex hull l` SUBST1_TAC THENL [MATCH_MP_TAC INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR THEN EXISTS_TAC `d:real^N->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `relative_frontier d:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!c. s SUBSET c /\ c INTER d = {} ==> DISJOINT s d`) THEN EXISTS_TAC `c:real^N->bool` THEN CONJ_TAC THENL [MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `relative_frontier c:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `relative_interior c SUBSET c /\ (c INTER d) INTER relative_interior c = {} ==> d INTER relative_interior c = {}`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN MATCH_MP_TAC FACE_OF_DISJOINT_RELATIVE_INTERIOR THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `~(aff_dim (d:real^N->bool) = aff_dim (c:real^N->bool))` ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC INT_LT_IMP_NE THEN EXPAND_TAC "d" THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC POLYTOPE_IMP_CONVEX THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `convex hull l:real^N->bool = l` SUBST1_TAC THENL [MATCH_MP_TAC HULL_P THEN MATCH_MP_TAC POLYTOPE_IMP_CONVEX THEN MATCH_MP_TAC SIMPLEX_IMP_POLYTOPE THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `convex hull (z INSERT k) INTER l:real^N->bool = convex hull k INTER l` SUBST1_TAC THENL [ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC INTER_CONVEX_HULL_INSERT_RELATIVE_EXTERIOR THEN EXISTS_TAC `c:real^N->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `relative_frontier c:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!c. s SUBSET c /\ c INTER d = {} ==> DISJOINT s d`) THEN EXISTS_TAC `d:real^N->bool` THEN CONJ_TAC THENL [TRANS_TAC SUBSET_TRANS `relative_frontier d:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `relative_interior c SUBSET c /\ (c INTER d) INTER relative_interior c = {} ==> d INTER relative_interior c = {}`) THEN REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN MATCH_MP_TAC FACE_OF_DISJOINT_RELATIVE_INTERIOR THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `~(aff_dim (c:real^N->bool) = aff_dim (d:real^N->bool))` ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC INT_LT_IMP_NE THEN EXPAND_TAC "c" THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC POLYTOPE_IMP_CONVEX THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `convex hull k:real^N->bool = k` SUBST1_TAC THENL [MATCH_MP_TAC HULL_P THEN MATCH_MP_TAC POLYTOPE_IMP_CONVEX THEN MATCH_MP_TAC SIMPLEX_IMP_POLYTOPE THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC FACE_OF_TRANS THENL [EXISTS_TAC `k:real^N->bool`; EXISTS_TAC `l:real^N->bool`] THEN (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THENL [REMOVE_THEN "*" (MP_TAC o SPEC `k:real^N->bool`); REMOVE_THEN "*" (MP_TAC o SPEC `l:real^N->bool`)] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `i:real^N->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[SET_RULE `z INSERT i = {z} UNION i`] THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN REWRITE_TAC[SET_RULE `{z} UNION i = z INSERT i`] THEN W(MP_TAC o PART_MATCH (lhand o rand) FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT o snd) THEN (ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `i:real^N->bool` THEN ASM SET_TAC[]]) THEN MATCH_MP_TAC AFFINE_INDEPENDENT_INSERT THEN ASM_REWRITE_TAC[] THENL [REMOVE_THEN "-" (MP_TAC o SPECL [`c:real^N->bool`; `k:real^N->bool`]); REMOVE_THEN "-" (MP_TAC o SPECL [`d:real^N->bool`; `l:real^N->bool`])] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `a SUBSET a' /\ z IN r ==> a' INTER r = {} ==> ~(z IN a)`) THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[SUBSET_REFL; AFFINE_HULL_CONVEX_HULL]] THEN CONJ_TAC THEN MP_TAC(ISPEC `c:real^N->bool` lemma1) THEN DISCH_THEN(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN ASM_REWRITE_TAC[] THEN (ANTS_TAC THENL [ASM_SIMP_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC POLYTOPE_IMP_CONVEX THEN MATCH_MP_TAC SIMPLEX_IMP_POLYTOPE THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) FACE_OF_POLYTOPE_INSERT_EQ o snd) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC THEN DISJ2_TAC THEN EXISTS_TAC `k INTER l:real^N->bool` THEN ASM_MESON_TAC[]] THEN CONJ_TAC THENL [MATCH_MP_TAC SIMPLEX_IMP_POLYTOPE THEN ASM SET_TAC[]; ASM_MESON_TAC[MEMBER_NOT_EMPTY; IN_INTER]]); ASM_SIMP_TAC[FORALL_IN_UNION; INT_LT_IMP_LE] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[AFF_DIM_CONVEX_HULL; AFF_DIM_INSERT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[INT_LT_IMP_LE; INT_ARITH `k:int < n ==> k + &1 <= n`]; X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN ASM_CASES_TAC `(c:real^N->bool) IN sk` THENL [ASM_MESON_TAC[SUBSET; IN_UNION]; ALL_TAC] THEN SUBGOAL_THEN `(c:real^N->bool) IN fat` ASSUME_TAC THENL [EXPAND_TAC "fat" THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(INT_ARITH `x:int <= n /\ ~(x < n) ==> x = n`) THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `{ convex hull ((@z:real^N. z IN relative_interior c) INSERT k) |k| k IN sc /\ k SUBSET relative_frontier c}` THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[IN_UNION] THEN DISJ2_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[CONJ_SYM] SUBSET_ANTISYM_EQ)] THEN CONJ_TAC THEN GEN_REWRITE_TAC I [SUBSET] THENL [REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `k:real^N->bool` THEN REPEAT DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `relative_frontier c:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN ABBREV_TAC `z:real^N = @z. z IN relative_interior c` THEN SUBGOAL_THEN `(z:real^N) IN relative_interior c` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`c:real^N->bool`; `z:real^N`; `x:real^N`] SEGMENT_TO_RELATIVE_FRONTIER) THEN ANTS_TAC THENL [ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED] THEN DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^N->bool)->int` o CONJUNCT2) THEN REWRITE_TAC[AFF_DIM_SING] THEN DISCH_TAC THEN UNDISCH_TAC `(c:real^N->bool) IN fat` THEN EXPAND_TAC "fat" THEN ASM_REWRITE_TAC[IN_ELIM_THM; INT_OF_NUM_EQ]; DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC)] THEN MP_TAC(SPEC `c:real^N->bool` RELATIVE_FRONTIER_OF_POLYHEDRON_ALT) THEN ANTS_TAC THENL [ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON]; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `\s. (y:real^N) IN s`) THEN ASM_REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?g. FINITE g /\ g SUBSET sc /\ f:real^N->bool = UNIONS g` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "sk" THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real^N->bool`; `c:real^N->bool`] FACE_OF_AFF_DIM_LT) THEN ASM SET_TAC[]; DISCH_TAC THEN SUBGOAL_THEN `?k:real^N->bool. k IN sc /\ y IN k /\ k SUBSET f` MP_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS]] THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_SUBSET_RELATIVE_FRONTIER; SUBSET_TRANS]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `c:real^N->bool` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN TRANS_TAC SUBSET_TRANS `relative_frontier c:real^N->bool` THEN ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED] THEN SET_TAC[]]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `&0:int <= d` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INT_OF_NUM_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN STRIP_TAC THEN MP_TAC(ISPECL [`n:num`; `UNIONS {{f:real^N->bool | f face_of c} | c IN m}`] lemma2) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FINITE_UNIONS; FORALL_IN_UNIONS; FORALL_IN_GSPEC; EXISTS_IN_UNIONS] THEN ANTS_TAC THENL [ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE]; ALL_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[FINITE_POLYTOPE_FACES]; ALL_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE]; ALL_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; AFF_DIM_SUBSET; INT_LE_TRANS]; ALL_TAC] THEN ANTS_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN ASM_MESON_TAC[FACE_OF_TRANS]; ALL_TAC] THEN ANTS_TAC THENL [ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:(real^N->bool)->bool` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]; ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET_TRANS]]; STRIP_TAC THEN EXISTS_TAC `m:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[simplicial_complex] THEN CONJ_TAC THENL [SUBGOAL_THEN `!c:real^N->bool. c IN m ==> c = {}` (fun th -> SIMP_TAC[th; IMP_CONJ; SIMPLEX_EMPTY; FACE_OF_EMPTY] THEN MESON_TAC[th]) THEN ASM_MESON_TAC[INT_LE_TRANS; AFF_DIM_POS_LE]; CONJ_TAC THENL [ALL_TAC; MESON_TAC[SUBSET_REFL]] THEN MESON_TAC[SING_SUBSET; UNIONS_1; FINITE_SING]]]);; let SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX = prove (`!m:(real^N->bool)->bool. FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> ?t. simplicial_complex t /\ UNIONS t = UNIONS m /\ (!c. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f) /\ (!k. k IN t ==> ?c. c IN m /\ k SUBSET c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`m:(real^N->bool)->bool`; `&(dimindex(:N)):int`] SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX_LOWDIM) THEN ASM_REWRITE_TAC[AFF_DIM_LE_UNIV]);; let FINE_SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX = prove (`!m:(real^N->bool)->bool e. &0 < e /\ FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> ?t. simplicial_complex t /\ (!k. k IN t ==> diameter k < e) /\ UNIONS t = UNIONS m /\ (!c. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f) /\ (!k. k IN t ==> ?c. c IN m /\ k SUBSET c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`m:(real^N->bool)->bool`; `&(dimindex(:N)):int`; `e:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN ASM_REWRITE_TAC[AFF_DIM_LE_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `n:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `n:(real^N->bool)->bool` SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[REAL_LET_TRANS; DIAMETER_SUBSET; SIMPLEX_IMP_POLYTOPE; POLYTOPE_IMP_BOUNDED]; ALL_TAC; ASM_MESON_TAC[SUBSET_TRANS]] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `{k:real^N->bool | k IN t /\ k SUBSET c}` THEN RULE_ASSUM_TAC(REWRITE_RULE[simplicial_complex]) THEN ASM_SIMP_TAC[FINITE_RESTRICT; SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC]; SET_TAC[]] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `?d. d IN n /\ (x:real^N) IN d /\ d SUBSET c` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?f. FINITE f /\ f SUBSET t /\ d:real^N->bool = UNIONS f` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN UNIONS f` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some results on cell division with full-dimensional cells only. *) (* ------------------------------------------------------------------------- *) let REGULAR_CLOSED_UNIONS_FAT_CELLS_UNIV = prove (`!s u:real^N->bool. closure(interior u) = u /\ FINITE s /\ (!c. c IN s ==> closed c /\ convex c) /\ UNIONS s = u ==> UNIONS {c | c IN s /\ ~(interior c = {})} = u`, let lemma = prove (`!s t:real^N->bool. closed t /\ closure(interior(s UNION t)) = s UNION t /\ closure(interior s) = s /\ closure(interior t) = {} ==> s UNION t = s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] CLOSURE_INTERIOR_UNION_CLOSED) THEN ANTS_TAC THENL [ASM_MESON_TAC[CLOSED_CLOSURE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SET_TAC[]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `u = UNIONS {c | c IN s /\ ~(interior c = {})} UNION UNIONS {c:real^N->bool | c IN s /\ interior c = {}}` SUBST1_TAC THENL [REWRITE_TAC[GSYM UNIONS_UNION] THEN EXPAND_TAC "u" THEN AP_TERM_TAC THEN SET_TAC[]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[GSYM UNIONS_UNION; SET_RULE `{x | x IN s /\ ~P x} UNION {x | x IN s /\ P x} = s`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CLOSED_UNIONS THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM]; MATCH_MP_TAC REGULAR_CLOSED_UNIONS THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; CONVEX_CLOSURE_INTERIOR; CLOSURE_EQ]; REWRITE_TAC[CLOSURE_EQ_EMPTY] THEN MATCH_MP_TAC NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; FINITE_RESTRICT; IN_ELIM_THM]]);; let CONVEX_UNIONS_FULLDIM_CELLS = prove (`!s u:real^N->bool. FINITE s /\ (!c. c IN s ==> closed c /\ convex c) /\ UNIONS s = u /\ convex u ==> UNIONS {c | c IN s /\ aff_dim c = aff_dim u} = u`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `closed(u:real^N->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_UNIONS]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `!c. c IN s ==> aff_dim(c:real^N->bool) = aff_dim(u:real^N->bool)` THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[CLOSURE_CLOSED] `closed s /\ u SUBSET closure s ==> u SUBSET s`) THEN ASM_SIMP_TAC[CLOSED_UNIONS; FINITE_RESTRICT; FORALL_IN_GSPEC] THEN TRANS_TAC SUBSET_TRANS `closure(INTERS {u DIFF c:real^N->bool |c| c IN s /\ aff_dim c < aff_dim u})` THEN CONJ_TAC THENL [MATCH_MP_TAC BAIRE THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; CLOSED_IMP_LOCALLY_COMPACT] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FINITE_IMP_COUNTABLE; FINITE_RESTRICT] THEN X_GEN_TAC `c:real^N->bool` THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `t = s ==> s SUBSET t`) THEN MATCH_MP_TAC DENSE_COMPLEMENT_CONVEX_CLOSED THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET; INTERS_GSPEC; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN SUBGOAL_THEN `?c. c IN s /\ aff_dim(c:real^N->bool) < aff_dim(u:real^N->bool)` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NOT_IMP; INT_LT_LE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(x:real^N) IN u /\ x IN UNIONS s` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_SIMP_TAC[IN_DIFF; INT_NOT_LT; GSYM INT_LE_ANTISYM] THEN DISCH_TAC THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM SET_TAC[]]);; let TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX = prove (`!m:(real^N->bool)->bool d. FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c. c IN m ==> aff_dim c = d) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> ?t. triangulation t /\ (!k. k IN t ==> aff_dim k = d) /\ UNIONS t = UNIONS m /\ (!c. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f) /\ (!k. k IN t ==> ?c. c IN m /\ k SUBSET c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `m:(real^N->bool)->bool` SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX) THEN ASM_REWRITE_TAC[simplicial_complex; triangulation] THEN DISCH_THEN(X_CHOOSE_THEN `t:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{k:real^N->bool | k IN t /\ aff_dim k = d}` THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN UNDISCH_THEN `!c:real^N->bool. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f` (MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `{k:real^N->bool | k IN f /\ aff_dim k = d}` THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN SUBGOAL_THEN `d = aff_dim(c:real^N->bool)` SUBST1_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC CONVEX_UNIONS_FULLDIM_CELLS] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_CLOSED; SIMPLEX_IMP_POLYTOPE]);; let FINE_TRIANGULAR_SUBDIVISION_OF_CELL_COMPLEX = prove (`!m:(real^N->bool)->bool d e. &0 < e /\ FINITE m /\ (!c. c IN m ==> polytope c) /\ (!c. c IN m ==> aff_dim c = d) /\ (!c1 c2. c1 IN m /\ c2 IN m ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) ==> ?t. triangulation t /\ (!k. k IN t ==> diameter k < e) /\ (!k. k IN t ==> aff_dim k = d) /\ UNIONS t = UNIONS m /\ (!c. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f) /\ (!k. k IN t ==> ?c. c IN m /\ k SUBSET c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`m:(real^N->bool)->bool`; `e:real`] FINE_SIMPLICIAL_SUBDIVISION_OF_CELL_COMPLEX) THEN ASM_REWRITE_TAC[simplicial_complex; triangulation] THEN DISCH_THEN(X_CHOOSE_THEN `t:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{k:real^N->bool | k IN t /\ aff_dim k = d}` THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN UNDISCH_THEN `!c:real^N->bool. c IN m ==> ?f. FINITE f /\ f SUBSET t /\ c = UNIONS f` (MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN EXISTS_TAC `{k:real^N->bool | k IN f /\ aff_dim k = d}` THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN SUBGOAL_THEN `d = aff_dim(c:real^N->bool)` SUBST1_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC CONVEX_UNIONS_FULLDIM_CELLS] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_CLOSED; SIMPLEX_IMP_POLYTOPE]);; hol-light/Multivariate/realanalysis.ml000066400000000000000000027162721303454263000204550ustar00rootroot00000000000000(* ========================================================================= *) (* Some analytic concepts for R instead of R^1. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* ========================================================================= *) needs "Library/binomial.ml";; needs "Multivariate/polytope.ml";; needs "Multivariate/measure.ml";; needs "Multivariate/transcendentals.ml";; (* ------------------------------------------------------------------------- *) (* Open-ness and closedness of a set of reals. *) (* ------------------------------------------------------------------------- *) let real_open = new_definition `real_open s <=> !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`;; let real_closed = new_definition `real_closed s <=> real_open((:real) DIFF s)`;; let euclideanreal = new_definition `euclideanreal = topology real_open`;; let REAL_OPEN_EMPTY = prove (`real_open {}`, REWRITE_TAC[real_open; NOT_IN_EMPTY]);; let REAL_OPEN_UNIV = prove (`real_open(:real)`, REWRITE_TAC[real_open; IN_UNIV] THEN MESON_TAC[REAL_LT_01]);; let REAL_OPEN_INTER = prove (`!s t. real_open s /\ real_open t ==> real_open (s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_open; AND_FORALL_THM; IN_INTER] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_MESON_TAC[REAL_LT_TRANS]);; let REAL_OPEN_UNIONS = prove (`(!s. s IN f ==> real_open s) ==> real_open(UNIONS f)`, REWRITE_TAC[real_open; IN_UNIONS] THEN MESON_TAC[]);; let REAL_OPEN_IN = prove (`!s. real_open s <=> open_in euclideanreal s`, GEN_TAC THEN REWRITE_TAC[euclideanreal] THEN CONV_TAC SYM_CONV THEN AP_THM_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 topology_tybij)] THEN REWRITE_TAC[REWRITE_RULE[IN] istopology] THEN REWRITE_TAC[REAL_OPEN_EMPTY; REAL_OPEN_INTER; SUBSET] THEN MESON_TAC[IN; REAL_OPEN_UNIONS]);; let TOPSPACE_EUCLIDEANREAL = prove (`topspace euclideanreal = (:real)`, REWRITE_TAC[topspace; EXTENSION; IN_UNIV; IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[REAL_OPEN_UNIV; IN_UNIV; REAL_OPEN_IN]);; let TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY = prove (`!s. topspace (subtopology euclideanreal s) = s`, REWRITE_TAC[TOPSPACE_EUCLIDEANREAL; TOPSPACE_SUBTOPOLOGY; INTER_UNIV]);; let REAL_CLOSED_IN = prove (`!s. real_closed s <=> closed_in euclideanreal s`, REWRITE_TAC[real_closed; closed_in; TOPSPACE_EUCLIDEANREAL; REAL_OPEN_IN; SUBSET_UNIV]);; let REAL_OPEN_UNION = prove (`!s t. real_open s /\ real_open t ==> real_open(s UNION t)`, REWRITE_TAC[REAL_OPEN_IN; OPEN_IN_UNION]);; let REAL_OPEN_SUBREAL_OPEN = prove (`!s. real_open s <=> !x. x IN s ==> ?t. real_open t /\ x IN t /\ t SUBSET s`, REWRITE_TAC[REAL_OPEN_IN; GSYM OPEN_IN_SUBOPEN]);; let REAL_CLOSED_EMPTY = prove (`real_closed {}`, REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_EMPTY]);; let REAL_CLOSED_UNIV = prove (`real_closed(:real)`, REWRITE_TAC[REAL_CLOSED_IN; GSYM TOPSPACE_EUCLIDEANREAL; CLOSED_IN_TOPSPACE]);; let REAL_CLOSED_UNION = prove (`!s t. real_closed s /\ real_closed t ==> real_closed(s UNION t)`, REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_UNION]);; let REAL_CLOSED_INTER = prove (`!s t. real_closed s /\ real_closed t ==> real_closed(s INTER t)`, REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_INTER]);; let REAL_CLOSED_INTERS = prove (`!f. (!s. s IN f ==> real_closed s) ==> real_closed(INTERS f)`, REWRITE_TAC[REAL_CLOSED_IN] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `f:(real->bool)->bool = {}` THEN ASM_SIMP_TAC[CLOSED_IN_INTERS; INTERS_0] THEN REWRITE_TAC[GSYM TOPSPACE_EUCLIDEANREAL; CLOSED_IN_TOPSPACE]);; let REAL_OPEN_REAL_CLOSED = prove (`!s. real_open s <=> real_closed(UNIV DIFF s)`, SIMP_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; TOPSPACE_EUCLIDEANREAL; SUBSET_UNIV; OPEN_IN_CLOSED_IN_EQ]);; let REAL_OPEN_DIFF = prove (`!s t. real_open s /\ real_closed t ==> real_open(s DIFF t)`, REWRITE_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; OPEN_IN_DIFF]);; let REAL_CLOSED_DIFF = prove (`!s t. real_closed s /\ real_open t ==> real_closed(s DIFF t)`, REWRITE_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; CLOSED_IN_DIFF]);; let REAL_OPEN_INTERS = prove (`!s. FINITE s /\ (!t. t IN s ==> real_open t) ==> real_open(INTERS s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INTERS_INSERT; INTERS_0; REAL_OPEN_UNIV; IN_INSERT] THEN MESON_TAC[REAL_OPEN_INTER]);; let REAL_CLOSED_UNIONS = prove (`!s. FINITE s /\ (!t. t IN s ==> real_closed t) ==> real_closed(UNIONS s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_INSERT; UNIONS_0; REAL_CLOSED_EMPTY; IN_INSERT] THEN MESON_TAC[REAL_CLOSED_UNION]);; let REAL_OPEN = prove (`!s. real_open s <=> open(IMAGE lift s)`, REWRITE_TAC[real_open; open_def; FORALL_IN_IMAGE; FORALL_LIFT; DIST_LIFT; LIFT_IN_IMAGE_LIFT]);; let REAL_CLOSED = prove (`!s. real_closed s <=> closed(IMAGE lift s)`, GEN_TAC THEN REWRITE_TAC[real_closed; REAL_OPEN; closed] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);; let REAL_CLOSED_HALFSPACE_LE = prove (`!a. real_closed {x | x <= a}`, GEN_TAC THEN SUBGOAL_THEN `closed {x | drop x <= a}` MP_TAC THENL [REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_CLOSED] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_CLOSED_HALFSPACE_GE = prove (`!a. real_closed {x | x >= a}`, GEN_TAC THEN SUBGOAL_THEN `closed {x | drop x >= a}` MP_TAC THENL [REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_GE]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_CLOSED] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_OPEN_HALFSPACE_LT = prove (`!a. real_open {x | x < a}`, GEN_TAC THEN SUBGOAL_THEN `open {x | drop x < a}` MP_TAC THENL [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_OPEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_OPEN_HALFSPACE_GT = prove (`!a. real_open {x | x > a}`, GEN_TAC THEN SUBGOAL_THEN `open {x | drop x > a}` MP_TAC THENL [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_GT]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_OPEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; (* ------------------------------------------------------------------------- *) (* Euclidean metric on real numbers. *) (* ------------------------------------------------------------------------- *) let real_euclidean_metric = new_definition `real_euclidean_metric = metric ((:real),\(x,y). abs(y-x))`;; let REAL_EUCLIDEAN_METRIC = prove (`mspace real_euclidean_metric = (:real) /\ (!x y. mdist real_euclidean_metric (x,y) = abs(y-x))`, SUBGOAL_THEN `is_metric_space((:real),\ (x,y). abs(y-x))` MP_TAC THENL [REWRITE_TAC[is_metric_space; IN_UNIV] THEN REAL_ARITH_TAC; SIMP_TAC[real_euclidean_metric; metric_tybij; mspace; mdist]]);; let MTOPOLOGY_REAL_EUCLIDEAN_METRIC = prove (`mtopology real_euclidean_metric = euclideanreal`, REWRITE_TAC[TOPOLOGY_EQ; OPEN_IN_MTOPOLOGY; REAL_EUCLIDEAN_METRIC; GSYM REAL_OPEN_IN; real_open; IN_MBALL; REAL_EUCLIDEAN_METRIC; SUBSET; IN_UNIV]);; let CONTINUOUS_ON_MDIST = prove (`!m a. a:A IN mspace m ==> topcontinuous (mtopology m) euclideanreal (\x. mdist m (a,x))`, INTRO_TAC "!m a; a" THEN REWRITE_TAC[GSYM MTOPOLOGY_REAL_EUCLIDEAN_METRIC; METRIC_TOPCONTINUOUS; REAL_EUCLIDEAN_METRIC; IN_UNIV] THEN INTRO_TAC "![b] e; epos b" THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN INTRO_TAC "!x; x dist" THEN REWRITE_TAC[topcontinuous; TOPSPACE_EUCLIDEANREAL; IN_UNIV; TOPSPACE_MTOPOLOGY; GSYM REAL_OPEN_IN; OPEN_IN_MTOPOLOGY] THEN TRANS_TAC REAL_LET_TRANS `mdist m (b:A,x)` THEN HYP REWRITE_TAC "dist" [] THEN ASM_MESON_TAC[MDIST_REVERSE_TRIANGLE; MDIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Compactness of a set of reals. *) (* ------------------------------------------------------------------------- *) let real_bounded = new_definition `real_bounded s <=> ?B. !x. x IN s ==> abs(x) <= B`;; let REAL_BOUNDED = prove (`real_bounded s <=> bounded(IMAGE lift s)`, REWRITE_TAC[BOUNDED_LIFT; real_bounded]);; let REAL_BOUNDED_POS = prove (`!s. real_bounded s <=> ?B. &0 < B /\ !x. x IN s ==> abs(x) <= B`, REWRITE_TAC[real_bounded] THEN MESON_TAC[REAL_ARITH `&0 < &1 + abs B /\ (x <= B ==> x <= &1 + abs B)`]);; let REAL_BOUNDED_POS_LT = prove (`!s. real_bounded s <=> ?b. &0 < b /\ !x. x IN s ==> abs(x) < b`, REWRITE_TAC[real_bounded] THEN MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);; let REAL_BOUNDED_SUBSET = prove (`!s t. real_bounded t /\ s SUBSET t ==> real_bounded s`, MESON_TAC[REAL_BOUNDED; BOUNDED_SUBSET; IMAGE_SUBSET]);; let REAL_BOUNDED_UNION = prove (`!s t. real_bounded(s UNION t) <=> real_bounded s /\ real_bounded t`, REWRITE_TAC[REAL_BOUNDED; IMAGE_UNION; BOUNDED_UNION]);; let real_compact = new_definition `real_compact s <=> compact(IMAGE lift s)`;; let REAL_COMPACT_IMP_BOUNDED = prove (`!s. real_compact s ==> real_bounded s`, REWRITE_TAC[real_compact; REAL_BOUNDED; COMPACT_IMP_BOUNDED]);; let REAL_COMPACT_IMP_CLOSED = prove (`!s. real_compact s ==> real_closed s`, REWRITE_TAC[real_compact; REAL_CLOSED; COMPACT_IMP_CLOSED]);; let REAL_COMPACT_EQ_BOUNDED_CLOSED = prove (`!s. real_compact s <=> real_bounded s /\ real_closed s`, REWRITE_TAC[real_compact; REAL_BOUNDED; REAL_CLOSED] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; let REAL_COMPACT_UNION = prove (`!s t. real_compact s /\ real_compact t ==> real_compact(s UNION t)`, REWRITE_TAC[real_compact; IMAGE_UNION; COMPACT_UNION]);; let REAL_COMPACT_ATTAINS_INF = prove (`!s. real_compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> x <= y`, REWRITE_TAC[real_compact; COMPACT_ATTAINS_INF]);; let REAL_COMPACT_ATTAINS_SUP = prove (`!s. real_compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> y <= x`, REWRITE_TAC[real_compact; COMPACT_ATTAINS_SUP]);; (* ------------------------------------------------------------------------- *) (* Limits of functions with real range. *) (* ------------------------------------------------------------------------- *) parse_as_infix("--->",(12,"right"));; let tendsto_real = new_definition `(f ---> l) net <=> !e. &0 < e ==> eventually (\x. abs(f(x) - l) < e) net`;; let reallim = new_definition `reallim net f = @l. (f ---> l) net`;; let TENDSTO_REAL = prove (`(s ---> l) = ((lift o s) --> lift l)`, REWRITE_TAC[FUN_EQ_THM; tendsto; tendsto_real; o_THM; DIST_LIFT]);; let REAL_TENDSTO = prove (`(s --> l) = (drop o s ---> drop l)`, REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP; ETA_AX]);; let REALLIM_COMPLEX = prove (`(s ---> l) = ((Cx o s) --> Cx(l))`, REWRITE_TAC[FUN_EQ_THM; tendsto; tendsto_real; o_THM; dist; GSYM CX_SUB; COMPLEX_NORM_CX]);; let REALLIM_UNIQUE = prove (`!net f l l'. ~trivial_limit net /\ (f ---> l) net /\ (f ---> l') net ==> l = l'`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_UNIQUE) THEN REWRITE_TAC[LIFT_EQ]);; let REALLIM_CONST = prove (`!net a. ((\x. a) ---> a) net`, REWRITE_TAC[TENDSTO_REAL; o_DEF; LIM_CONST]);; let REALLIM_LMUL = prove (`!f l c. (f ---> l) net ==> ((\x. c * f x) ---> c * l) net`, REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_CMUL; LIM_CMUL]);; let REALLIM_RMUL = prove (`!f l c. (f ---> l) net ==> ((\x. f x * c) ---> l * c) net`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REALLIM_LMUL]);; let REALLIM_LMUL_EQ = prove (`!net f l c. ~(c = &0) ==> (((\x. c * f x) ---> c * l) net <=> (f ---> l) net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[REALLIM_LMUL] THEN DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP REALLIM_LMUL) THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID; ETA_AX]);; let REALLIM_RMUL_EQ = prove (`!net f l c. ~(c = &0) ==> (((\x. f x * c) ---> l * c) net <=> (f ---> l) net)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REALLIM_LMUL_EQ]);; let REALLIM_NEG = prove (`!net f l. (f ---> l) net ==> ((\x. --(f x)) ---> --l) net`, REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_NEG; LIM_NEG]);; let REALLIM_NEG_EQ = prove (`!net f l. ((\x. --(f x)) ---> --l) net <=> (f ---> l) net`, REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_NEG; LIM_NEG_EQ]);; let REALLIM_ADD = prove (`!net:(A)net f g l m. (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) + g(x)) ---> l + m) net`, REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_ADD; LIM_ADD]);; let REALLIM_SUB = prove (`!net:(A)net f g l m. (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) - g(x)) ---> l - m) net`, REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_SUB; LIM_SUB]);; let REALLIM_MUL = prove (`!net:(A)net f g l m. (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) * g(x)) ---> l * m) net`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_MUL; LIM_COMPLEX_MUL]);; let REALLIM_INV = prove (`!net f l. (f ---> l) net /\ ~(l = &0) ==> ((\x. inv(f x)) ---> inv l) net`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; LIM_COMPLEX_INV; GSYM CX_INJ]);; let REALLIM_DIV = prove (`!net:(A)net f g l m. (f ---> l) net /\ (g ---> m) net /\ ~(m = &0) ==> ((\x. f(x) / g(x)) ---> l / m) net`, SIMP_TAC[real_div; REALLIM_MUL; REALLIM_INV]);; let REALLIM_ABS = prove (`!net f l. (f ---> l) net ==> ((\x. abs(f x)) ---> abs l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto_real] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REALLIM_POW = prove (`!net f l n. (f ---> l) net ==> ((\x. f x pow n) ---> l pow n) net`, REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_pow; REALLIM_CONST; REALLIM_MUL]);; let REALLIM_MAX = prove (`!net:(A)net f g l m. (f ---> l) net /\ (g ---> m) net ==> ((\x. max (f x) (g x)) ---> max l m) net`, REWRITE_TAC[REAL_ARITH `max x y = inv(&2) * ((x + y) + abs(x - y))`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN ASM_SIMP_TAC[REALLIM_ADD; REALLIM_ABS; REALLIM_SUB]);; let REALLIM_MIN = prove (`!net:(A)net f g l m. (f ---> l) net /\ (g ---> m) net ==> ((\x. min (f x) (g x)) ---> min l m) net`, REWRITE_TAC[REAL_ARITH `min x y = inv(&2) * ((x + y) - abs(x - y))`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN ASM_SIMP_TAC[REALLIM_ADD; REALLIM_ABS; REALLIM_SUB]);; let REALLIM_NULL = prove (`!net f l. (f ---> l) net <=> ((\x. f(x) - l) ---> &0) net`, REWRITE_TAC[tendsto_real; REAL_SUB_RZERO]);; let REALLIM_NULL_ADD = prove (`!net:(A)net f g. (f ---> &0) net /\ (g ---> &0) net ==> ((\x. f(x) + g(x)) ---> &0) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_ADD) THEN REWRITE_TAC[REAL_ADD_LID]);; let REALLIM_NULL_LMUL = prove (`!net f c. (f ---> &0) net ==> ((\x. c * f x) ---> &0) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP REALLIM_LMUL) THEN REWRITE_TAC[REAL_MUL_RZERO]);; let REALLIM_NULL_RMUL = prove (`!net f c. (f ---> &0) net ==> ((\x. f x * c) ---> &0) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP REALLIM_RMUL) THEN REWRITE_TAC[REAL_MUL_LZERO]);; let REALLIM_NULL_POW = prove (`!net f n. (f ---> &0) net /\ ~(n = 0) ==> ((\x. f x pow n) ---> &0) net`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `n:num` o MATCH_MP REALLIM_POW) ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_POW_ZERO]);; let REALLIM_NULL_LMUL_EQ = prove (`!net f c. ~(c = &0) ==> (((\x. c * f x) ---> &0) net <=> (f ---> &0) net)`, MESON_TAC[REALLIM_LMUL_EQ; REAL_MUL_RZERO]);; let REALLIM_NULL_RMUL_EQ = prove (`!net f c. ~(c = &0) ==> (((\x. f x * c) ---> &0) net <=> (f ---> &0) net)`, MESON_TAC[REALLIM_RMUL_EQ; REAL_MUL_LZERO]);; let REALLIM_NULL_NEG = prove (`!net f. ((\x. --(f x)) ---> &0) net <=> (f ---> &0) net`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `--x = --(&1) * x`] THEN MATCH_MP_TAC REALLIM_NULL_LMUL_EQ THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let REALLIM_NULL_SUB = prove (`!net:(A)net f g. (f ---> &0) net /\ (g ---> &0) net ==> ((\x. f(x) - g(x)) ---> &0) net`, SIMP_TAC[real_sub; REALLIM_NULL_ADD; REALLIM_NULL_NEG]);; let REALLIM_RE = prove (`!net f l. (f --> l) net ==> ((Re o f) ---> Re l) net`, REWRITE_TAC[REALLIM_COMPLEX] THEN REWRITE_TAC[tendsto; dist; o_THM; GSYM CX_SUB; COMPLEX_NORM_CX] THEN REWRITE_TAC[GSYM RE_SUB; eventually] THEN MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);; let REALLIM_IM = prove (`!net f l. (f --> l) net ==> ((Im o f) ---> Im l) net`, REWRITE_TAC[REALLIM_COMPLEX] THEN REWRITE_TAC[tendsto; dist; o_THM; GSYM CX_SUB; COMPLEX_NORM_CX] THEN REWRITE_TAC[GSYM IM_SUB; eventually] THEN MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);; let REALLIM_TRANSFORM_EVENTUALLY = prove (`!net f g l. eventually (\x. f x = g x) net /\ (f ---> l) net ==> (g ---> l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN SIMP_TAC[o_THM]);; let REALLIM_TRANSFORM = prove (`!net f g l. ((\x. f x - g x) ---> &0) net /\ (f ---> l) net ==> (g ---> l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN REWRITE_TAC[o_DEF; LIFT_NUM; LIFT_SUB; LIM_TRANSFORM]);; let REALLIM_TRANSFORM_EQ = prove (`!net f:A->real g l. ((\x. f x - g x) ---> &0) net ==> ((f ---> l) net <=> (g ---> l) net)`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN REWRITE_TAC[o_DEF; LIFT_NUM; LIFT_SUB; LIM_TRANSFORM_EQ]);; let REAL_SEQ_OFFSET = prove (`!f l k. (f ---> l) sequentially ==> ((\i. f (i + k)) ---> l) sequentially`, REPEAT GEN_TAC THEN SIMP_TAC[TENDSTO_REAL; o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_OFFSET) THEN SIMP_TAC[]);; let REAL_SEQ_OFFSET_REV = prove (`!f l k. ((\i. f (i + k)) ---> l) sequentially ==> (f ---> l) sequentially`, SIMP_TAC[TENDSTO_REAL; o_DEF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SEQ_OFFSET_REV THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[]);; let REALLIM_TRANSFORM_STRADDLE = prove (`!f g h a. eventually (\n. f(n) <= g(n)) net /\ (f ---> a) net /\ eventually (\n. g(n) <= h(n)) net /\ (h ---> a) net ==> (g ---> a) net`, REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_AND_FORALL_THM; tendsto_real; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REAL_ARITH_TAC);; let REALLIM_TRANSFORM_BOUND = prove (`!f g. eventually (\n. abs(f n) <= g n) net /\ (g ---> &0) net ==> (f ---> &0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_AND_FORALL_THM; tendsto_real; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REAL_ARITH_TAC);; let REAL_CONVERGENT_IMP_BOUNDED = prove (`!s l. (s ---> l) sequentially ==> real_bounded (IMAGE s (:num))`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_BOUNDED; TENDSTO_REAL] THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[o_DEF; NORM_LIFT]);; let REALLIM = prove (`(f ---> l) net <=> trivial_limit net \/ !e. &0 < e ==> ?y. (?x. netord(net) x y) /\ !x. netord(net) x y ==> abs(f(x) -l) < e`, REWRITE_TAC[tendsto_real; eventually] THEN MESON_TAC[]);; let REALLIM_NULL_ABS = prove (`!net f. ((\x. abs(f x)) ---> &0) net <=> (f ---> &0) net`, REWRITE_TAC[REALLIM; REAL_SUB_RZERO; REAL_ABS_ABS]);; let REALLIM_WITHIN_LE = prove (`!f:real^N->real l a s. (f ---> l) (at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_WITHIN_LE]);; let REALLIM_WITHIN = prove (`!f:real^N->real l a s. (f ---> l) (at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_WITHIN] THEN MESON_TAC[]);; let REALLIM_AT = prove (`!f l a:real^N. (f ---> l) (at a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_AT] THEN MESON_TAC[]);; let REALLIM_AT_INFINITY = prove (`!f l. (f ---> l) at_infinity <=> !e. &0 < e ==> ?b. !x. norm(x) >= b ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);; let REALLIM_AT_INFINITY_COMPLEX_0 = prove (`!f l. (f ---> l) at_infinity <=> ((f o inv) ---> l) (at(Cx(&0)))`, REWRITE_TAC[REALLIM_COMPLEX; LIM_AT_INFINITY_COMPLEX_0] THEN REWRITE_TAC[o_ASSOC]);; let REALLIM_SEQUENTIALLY = prove (`!s l. (s ---> l) sequentially <=> !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(n) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);; let REALLIM_EVENTUALLY = prove (`!net f l. eventually (\x. f x = l) net ==> (f ---> l) net`, REWRITE_TAC[eventually; REALLIM] THEN MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; let LIM_COMPONENTWISE = prove (`!net f:A->real^N. (f --> l) net <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. (f x)$i) ---> l$i) net`, ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN REWRITE_TAC[TENDSTO_REAL; o_DEF]);; let REALLIM_UBOUND = prove (`!(net:A net) f l b. (f ---> l) net /\ ~trivial_limit net /\ eventually (\x. f x <= b) net ==> l <= b`, REWRITE_TAC[FORALL_DROP; TENDSTO_REAL; LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `net:A net` LIM_DROP_UBOUND) THEN EXISTS_TAC `lift o (f:A->real)` THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP]);; let REALLIM_LBOUND = prove (`!(net:A net) f l b. (f ---> l) net /\ ~trivial_limit net /\ eventually (\x. b <= f x) net ==> b <= l`, ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `net:A net` REALLIM_UBOUND) THEN EXISTS_TAC `\a:A. --(f a:real)` THEN ASM_REWRITE_TAC[REALLIM_NEG_EQ]);; let REALLIM_LE = prove (`!net f g l m. (f ---> l) net /\ (g ---> m) net /\ ~trivial_limit net /\ eventually (\x. f x <= g x) net ==> l <= m`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP REALLIM_SUB o ONCE_REWRITE_RULE[CONJ_SYM]) MP_TAC) THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[GSYM IMP_CONJ_ALT; GSYM CONJ_ASSOC] THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP REALLIM_LBOUND));; let REALLIM_CONST_EQ = prove (`!net:(A net) c d. ((\x. c) ---> d) net <=> trivial_limit net \/ c = d`, REWRITE_TAC[TENDSTO_REAL; LIM_CONST_EQ; o_DEF; LIFT_EQ]);; let REALLIM_SUM = prove (`!net f:A->B->real l s. FINITE s /\ (!i. i IN s ==> ((f i) ---> (l i)) net) ==> ((\x. sum s (\i. f i x)) ---> sum s l) net`, REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; REALLIM_CONST; REALLIM_ADD; IN_INSERT; ETA_AX]);; let REALLIM_NULL_SUM = prove (`!net f:A->B->real s. FINITE s /\ (!a. a IN s ==> ((\x. f x a) ---> &0) net) ==> ((\x. sum s (f x)) ---> &0) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_SUM) THEN REWRITE_TAC[SUM_0; ETA_AX]);; let REALLIM_NULL_COMPARISON = prove (`!net:(A)net f g. eventually (\x. abs(f x) <= g x) net /\ (g ---> &0) net ==> (f ---> &0) net`, REWRITE_TAC[TENDSTO_REAL; LIFT_NUM; o_DEF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `g:A->real` THEN ASM_REWRITE_TAC[NORM_LIFT]);; let CONVERGENT_REAL_BOUNDED_MONOTONE = prove (`!s. real_bounded(IMAGE s (:num)) /\ ((!n. s n <= s(SUC n)) \/ (!n. s(SUC n) <= s n)) ==> ?l. (s ---> l) sequentially`, GEN_TAC THEN REWRITE_TAC[REAL_BOUNDED; GSYM IMAGE_o] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONVERGENT_BOUNDED_MONOTONE_1)) THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP; TENDSTO_REAL; EXISTS_LIFT]);; (* ------------------------------------------------------------------------- *) (* Real series. *) (* ------------------------------------------------------------------------- *) parse_as_infix("real_sums",(12,"right"));; let real_sums = new_definition `(f real_sums l) s <=> ((\n. sum (s INTER (0..n)) f) ---> l) sequentially`;; let real_infsum = new_definition `real_infsum s f = @l. (f real_sums l) s`;; let real_summable = new_definition `real_summable s f = ?l. (f real_sums l) s`;; let REAL_SUMS = prove (`(f real_sums l) = ((lift o f) sums (lift l))`, REWRITE_TAC[FUN_EQ_THM; sums; real_sums; TENDSTO_REAL] THEN SIMP_TAC[LIFT_SUM; FINITE_INTER_NUMSEG; o_DEF]);; let REAL_SUMS_RE = prove (`!f l s. (f sums l) s ==> ((Re o f) real_sums (Re l)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; sums] THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_RE) THEN SIMP_TAC[o_DEF; RE_VSUM; FINITE_INTER_NUMSEG]);; let REAL_SUMS_IM = prove (`!f l s. (f sums l) s ==> ((Im o f) real_sums (Im l)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; sums] THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_IM) THEN SIMP_TAC[o_DEF; IM_VSUM; FINITE_INTER_NUMSEG]);; let REAL_SUMS_COMPLEX = prove (`!f l s. (f real_sums l) s <=> ((Cx o f) sums (Cx l)) s`, REWRITE_TAC[real_sums; sums; REALLIM_COMPLEX] THEN SIMP_TAC[o_DEF; VSUM_CX; FINITE_INTER; FINITE_NUMSEG]);; let REAL_SUMMABLE = prove (`real_summable s f <=> summable s (lift o f)`, REWRITE_TAC[real_summable; summable; REAL_SUMS; GSYM EXISTS_LIFT]);; let REAL_SUMMABLE_COMPLEX = prove (`real_summable s f <=> summable s (Cx o f)`, REWRITE_TAC[real_summable; summable; REAL_SUMS_COMPLEX] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `l:complex`) THEN EXISTS_TAC `Re l` THEN SUBGOAL_THEN `Cx(Re l) = l` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM REAL] THEN MATCH_MP_TAC REAL_SERIES THEN MAP_EVERY EXISTS_TAC [`Cx o (f:num->real)`; `s:num->bool`] THEN ASM_REWRITE_TAC[o_THM; REAL_CX]);; let REAL_SERIES_CAUCHY = prove (`(?l. (f real_sums l) s) <=> (!e. &0 < e ==> ?N. !m n. m >= N ==> abs(sum(s INTER (m..n)) f) < e)`, REWRITE_TAC[REAL_SUMS; SERIES_CAUCHY; GSYM EXISTS_LIFT] THEN SIMP_TAC[NORM_REAL; GSYM drop; DROP_VSUM; FINITE_INTER_NUMSEG] THEN REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);; let REAL_SUMMABLE_CAUCHY = prove (`!f s. real_summable s f <=> !e. &0 < e ==> ?N. !m n. m >= N ==> abs(sum(s INTER (m..n)) f) < e`, REWRITE_TAC[real_summable; GSYM REAL_SERIES_CAUCHY]);; let REAL_SUMS_SUMMABLE = prove (`!f l s. (f real_sums l) s ==> real_summable s f`, REWRITE_TAC[real_summable] THEN MESON_TAC[]);; let REAL_SUMS_INFSUM = prove (`!f s. (f real_sums (real_infsum s f)) s <=> real_summable s f`, REWRITE_TAC[real_infsum; real_summable] THEN MESON_TAC[]);; let REAL_INFSUM_COMPLEX = prove (`!f s. real_summable s f ==> real_infsum s f = Re(infsum s (Cx o f))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_SUMS_INFSUM; REAL_SUMS_COMPLEX] THEN DISCH_THEN(MP_TAC o MATCH_MP INFSUM_UNIQUE) THEN MESON_TAC[RE_CX]);; let REAL_SERIES_FROM = prove (`!f l k. (f real_sums l) (from k) = ((\n. sum(k..n) f) ---> l) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);; let REAL_SERIES_UNIQUE = prove (`!f l l' s. (f real_sums l) s /\ (f real_sums l') s ==> l = l'`, REWRITE_TAC[real_sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; REALLIM_UNIQUE]);; let REAL_INFSUM_UNIQUE = prove (`!f l s. (f real_sums l) s ==> real_infsum s f = l`, MESON_TAC[REAL_SERIES_UNIQUE; REAL_SUMS_INFSUM; real_summable]);; let REAL_SERIES_FINITE = prove (`!f s. FINITE s ==> (f real_sums (sum s f)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[real_sums; REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `s INTER (0..m) = s` (fun th -> ASM_REWRITE_TAC[th; REAL_SUB_REFL; REAL_ABS_NUM]) THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[LE_TRANS]);; let REAL_SUMMABLE_IFF_EVENTUALLY = prove (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) ==> (real_summable k f <=> real_summable k g)`, REWRITE_TAC[REAL_SUMMABLE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; let REAL_SUMMABLE_EQ_EVENTUALLY = prove (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ real_summable k f ==> real_summable k g`, MESON_TAC[REAL_SUMMABLE_IFF_EVENTUALLY]);; let REAL_SUMMABLE_IFF_COFINITE = prove (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) ==> (real_summable s f <=> real_summable t f)`, SIMP_TAC[REAL_SUMMABLE] THEN MESON_TAC[SUMMABLE_IFF_COFINITE]);; let REAL_SUMMABLE_EQ_COFINITE = prove (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ real_summable s f ==> real_summable t f`, MESON_TAC[REAL_SUMMABLE_IFF_COFINITE]);; let REAL_SUMMABLE_FROM_ELSEWHERE = prove (`!f m n. real_summable (from m) f ==> real_summable (from n) f`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_SUMMABLE_EQ_COFINITE) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN ARITH_TAC);; let REAL_SUMMABLE_FROM_ELSEWHERE_EQ = prove (`!n m f. real_summable (from m) f <=> real_summable (from n) f`, MESON_TAC[REAL_SUMMABLE_FROM_ELSEWHERE]);; let REAL_SERIES_GOESTOZERO = prove (`!s x. real_summable s x ==> !e. &0 < e ==> eventually (\n. n IN s ==> abs(x n) < e) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUMMABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_GOESTOZERO) THEN REWRITE_TAC[o_THM; NORM_LIFT]);; let REAL_SUMMABLE_IMP_TOZERO = prove (`!f:num->real k. real_summable k f ==> ((\n. if n IN k then f(n) else &0) ---> &0) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUMMABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN REWRITE_TAC[TENDSTO_REAL] THEN REWRITE_TAC[o_DEF; GSYM LIFT_NUM; GSYM COND_RAND]);; let REAL_SUMMABLE_IMP_BOUNDED = prove (`!f:num->real k. real_summable k f ==> real_bounded (IMAGE f k)`, REWRITE_TAC[REAL_BOUNDED; REAL_SUMMABLE; GSYM IMAGE_o; SUMMABLE_IMP_BOUNDED]);; let REAL_SUMMABLE_IMP_REAL_SUMS_BOUNDED = prove (`!f:num->real k. real_summable (from k) f ==> real_bounded { sum(k..n) f | n IN (:num) }`, REWRITE_TAC[real_summable; real_sums; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);; let REAL_SERIES_0 = prove (`!s. ((\n. &0) real_sums (&0)) s`, REWRITE_TAC[real_sums; SUM_0; REALLIM_CONST]);; let REAL_SERIES_ADD = prove (`!x x0 y y0 s. (x real_sums x0) s /\ (y real_sums y0) s ==> ((\n. x n + y n) real_sums (x0 + y0)) s`, SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_ADD; REALLIM_ADD]);; let REAL_SERIES_SUB = prove (`!x x0 y y0 s. (x real_sums x0) s /\ (y real_sums y0) s ==> ((\n. x n - y n) real_sums (x0 - y0)) s`, SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_SUB; REALLIM_SUB]);; let REAL_SERIES_LMUL = prove (`!x x0 c s. (x real_sums x0) s ==> ((\n. c * x n) real_sums (c * x0)) s`, SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_LMUL; REALLIM_LMUL]);; let REAL_SERIES_RMUL = prove (`!x x0 c s. (x real_sums x0) s ==> ((\n. x n * c) real_sums (x0 * c)) s`, SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_RMUL; REALLIM_RMUL]);; let REAL_SERIES_NEG = prove (`!x x0 s. (x real_sums x0) s ==> ((\n. --(x n)) real_sums (--x0)) s`, SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_NEG; REALLIM_NEG]);; let REAL_SUMS_IFF = prove (`!f g k. (!x. x IN k ==> f x = g x) ==> ((f real_sums l) k <=> (g real_sums l) k)`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);; let REAL_SUMS_EQ = prove (`!f g k. (!x. x IN k ==> f x = g x) /\ (f real_sums l) k ==> (g real_sums l) k`, MESON_TAC[REAL_SUMS_IFF]);; let REAL_SERIES_FINITE_SUPPORT = prove (`!f s k. FINITE (s INTER k) /\ (!x. ~(x IN s INTER k) ==> f x = &0) ==> (f real_sums sum(s INTER k) f) k`, REWRITE_TAC[real_sums; REALLIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `sum (k INTER (0..n)) (f:num->real) = sum(s INTER k) f` (fun th -> ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; th]) THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[IN_INTER; LE_TRANS]);; let REAL_SERIES_DIFFS = prove (`!f k. (f ---> &0) sequentially ==> ((\n. f(n) - f(n + 1)) real_sums f(k)) (from k)`, REWRITE_TAC[real_sums; FROM_INTER_NUMSEG; SUM_DIFFS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (f:num->real) k - f(n + 1)` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN SIMP_TAC[]; GEN_REWRITE_TAC LAND_CONV [GSYM REAL_SUB_RZERO] THEN MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN MATCH_MP_TAC REAL_SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);; let REAL_SERIES_TRIVIAL = prove (`!f. (f real_sums &0) {}`, REWRITE_TAC[real_sums; INTER_EMPTY; SUM_CLAUSES; REALLIM_CONST]);; let REAL_SERIES_RESTRICT = prove (`!f k l:real. ((\n. if n IN k then f(n) else &0) real_sums l) (:num) <=> (f real_sums l) k`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] `sum s f = sum t f /\ sum t f = sum t g ==> sum s f = sum t g`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[]; MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[IN_INTER]]);; let REAL_SERIES_SUM = prove (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = &0) /\ sum s f = l ==> (f real_sums l) k`, REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC [REAL_SERIES_FINITE_SUPPORT]]);; let REAL_SUMS_REINDEX = prove (`!k a l n. ((\x. a(x + k)) real_sums l) (from n) <=> (a real_sums l) (from(n + k))`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; FROM_INTER_NUMSEG] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_OFFSET] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`; ARITH_RULE `N + k:num <= n ==> N <= n + k`]);; let REAL_SERIES_EVEN = prove (`!f l n. (f real_sums l) (from n) <=> ((\i. if EVEN i then f(i DIV 2) else &0) real_sums l) (from (2 * n))`, REWRITE_TAC[REAL_SUMS; o_DEF; COND_RAND; LIFT_NUM] THEN REWRITE_TAC[GSYM SERIES_EVEN]);; let REAL_SERIES_ODD = prove (`!f l n. (f real_sums l) (from n) <=> ((\i. if ODD i then f(i DIV 2) else &0) real_sums l) (from (2 * n + 1))`, REWRITE_TAC[REAL_SUMS; o_DEF; COND_RAND; LIFT_NUM] THEN REWRITE_TAC[GSYM SERIES_ODD]);; let REAL_INFSUM = prove (`!f s. real_summable s f ==> real_infsum s f = drop(infsum s (lift o f))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_SUMS_INFSUM; REAL_SUMS] THEN DISCH_THEN(MP_TAC o MATCH_MP INFSUM_UNIQUE) THEN MESON_TAC[LIFT_DROP]);; let REAL_PARTIAL_SUMS_LE_INFSUM = prove (`!f s n. (!i. i IN s ==> &0 <= f i) /\ real_summable s f ==> sum (s INTER (0..n)) f <= real_infsum s f`, REPEAT GEN_TAC THEN SIMP_TAC[REAL_INFSUM] THEN REWRITE_TAC[REAL_SUMMABLE] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINDER_CONV o RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP PARTIAL_SUMS_DROP_LE_INFSUM) THEN SIMP_TAC[DROP_VSUM; FINITE_INTER; FINITE_NUMSEG; o_DEF; LIFT_DROP; ETA_AX]);; let REAL_PARTIAL_SUMS_LE_INFSUM_GEN = prove (`!f s t. FINITE t /\ t SUBSET s /\ (!i. i IN s ==> &0 <= f i) /\ real_summable s f ==> sum t f <= real_infsum s f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..n)) f` THEN ASM_SIMP_TAC[REAL_PARTIAL_SUMS_LE_INFSUM] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[IN_INTER; IN_DIFF; FINITE_INTER; FINITE_NUMSEG] THEN REWRITE_TAC[SUBSET; IN_NUMSEG; IN_INTER; LE_0] THEN ASM SET_TAC[]);; let REAL_SERIES_TERMS_TOZERO = prove (`!f l n. (f real_sums l) (from n) ==> (f ---> &0) sequentially`, REWRITE_TAC[REAL_SUMS; TENDSTO_REAL; LIFT_NUM; SERIES_TERMS_TOZERO]);; let REAL_SERIES_LE = prove (`!f g s y z. (f real_sums y) s /\ (g real_sums z) s /\ (!i. i IN s ==> f(i) <= g(i)) ==> y <= z`, REWRITE_TAC[REAL_SUMS] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x = drop(lift x)`] THEN MATCH_MP_TAC SERIES_DROP_LE THEN MAP_EVERY EXISTS_TAC [`lift o (f:num->real)`; `lift o (g:num->real)`] THEN ASM_SIMP_TAC[o_THM; LIFT_DROP] THEN ASM_MESON_TAC[]);; let REAL_SERIES_POS = prove (`!f s y. (f real_sums y) s /\ (!i. i IN s ==> &0 <= f(i)) ==> &0 <= y`, REWRITE_TAC[REAL_SUMS] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM LIFT_DROP] THEN MATCH_MP_TAC SERIES_DROP_POS THEN EXISTS_TAC `lift o (f:num->real)` THEN ASM_SIMP_TAC[o_THM; LIFT_DROP] THEN ASM_MESON_TAC[]);; let REAL_SERIES_BOUND = prove (`!f g s a b. (f real_sums a) s /\ (g real_sums b) s /\ (!i. i IN s ==> abs(f i) <= g i) ==> abs(a) <= b`, REWRITE_TAC[REAL_SUMS; GSYM NORM_LIFT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_BOUND THEN EXISTS_TAC `lift o (f:num->real)` THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; let REAL_SERIES_COMPARISON_BOUND = prove (`!f g s a. (g real_sums a) s /\ (!i. i IN s ==> abs(f i) <= g i) ==> ?l. (f real_sums l) s /\ abs(l) <= a`, REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT; GSYM NORM_LIFT] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN MATCH_MP_TAC SERIES_COMPARISON_BOUND THEN EXISTS_TAC `lift o (g:num->real)` THEN ASM_SIMP_TAC[o_THM; LIFT_DROP]);; let REAL_SERIES_MUL = prove (`!x y a b. (x real_sums a) (from 0) /\ (y real_sums b) (from 0) /\ (real_summable (from 0) (\n. abs(x n)) \/ real_summable (from 0) (\n. abs(y n))) ==> ((\n. sum(0..n) (\i. x i * y(n - i))) real_sums (a * b)) (from 0)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x y:real^1. drop x % y`; `lift o (x:num->real)`; `lift o (y:num->real)`; `lift a`; `lift b`] SERIES_BILINEAR) THEN ASM_REWRITE_TAC[GSYM REAL_SUMMABLE; GSYM REAL_SUMS; BILINEAR_DROP_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE [REAL_SUMMABLE; REAL_SUMS; o_DEF; GSYM NORM_1]) THEN ASM_REWRITE_TAC[o_DEF; NORM_LIFT; REAL_SUMS; TENDSTO_REAL; LIFT_SUM] THEN REWRITE_TAC[DROP_CMUL; LIFT_DROP; LIFT_CMUL]);; let REAL_SERIES_MUL_UNIQUE = prove (`!x y a b c. (x real_sums a) (from 0) /\ (y real_sums b) (from 0) /\ ((\n. sum (0..n) (\i. x i * y(n - i))) real_sums c) (from 0) ==> a * b = c`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x y:real^1. drop x % y`; `lift o (x:num->real)`; `lift o (y:num->real)`; `lift a`; `lift b`; `lift c`] SERIES_BILINEAR_UNIQUE) THEN ASM_REWRITE_TAC[GSYM REAL_SUMS; BILINEAR_DROP_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_SUMS; o_DEF; LIFT_SUM; GSYM NORM_1]) THEN ASM_REWRITE_TAC[o_DEF; DROP_CMUL; LIFT_DROP; GSYM LIFT_CMUL] THEN REWRITE_TAC[LIFT_EQ]);; (* ------------------------------------------------------------------------- *) (* Similar combining theorems just for summability. *) (* ------------------------------------------------------------------------- *) let REAL_SUMMABLE_0 = prove (`!s. real_summable s (\n. &0)`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_0]);; let REAL_SUMMABLE_ADD = prove (`!x y s. real_summable s x /\ real_summable s y ==> real_summable s (\n. x n + y n)`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_ADD]);; let REAL_SUMMABLE_SUB = prove (`!x y s. real_summable s x /\ real_summable s y ==> real_summable s (\n. x n - y n)`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_SUB]);; let REAL_SUMMABLE_LMUL = prove (`!s x c. real_summable s x ==> real_summable s (\n. c * x n)`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_LMUL]);; let REAL_SUMMABLE_RMUL = prove (`!s x c. real_summable s x ==> real_summable s (\n. x n * c)`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_RMUL]);; let REAL_SUMMABLE_NEG = prove (`!x s. real_summable s x ==> real_summable s (\n. --(x n))`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_NEG]);; let REAL_SUMMABLE_IFF = prove (`!f g k. (!x. x IN k ==> f x = g x) ==> (real_summable k f <=> real_summable k g)`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SUMS_IFF]);; let REAL_SUMMABLE_EQ = prove (`!f g k. (!x. x IN k ==> f x = g x) /\ real_summable k f ==> real_summable k g`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SUMS_EQ]);; let REAL_SERIES_SUBSET = prove (`!x s t l. s SUBSET t /\ ((\i. if i IN s then x i else &0) real_sums l) t ==> (x real_sums l) s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[real_sums] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let REAL_SUMMABLE_SUBSET = prove (`!x s t. s SUBSET t /\ real_summable t (\i. if i IN s then x i else &0) ==> real_summable s x`, REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_SUBSET]);; let REAL_SUMMABLE_TRIVIAL = prove (`!f. real_summable {} f`, GEN_TAC THEN REWRITE_TAC[real_summable] THEN EXISTS_TAC `&0` THEN REWRITE_TAC[REAL_SERIES_TRIVIAL]);; let REAL_SUMMABLE_RESTRICT = prove (`!f k. real_summable (:num) (\n. if n IN k then f(n) else &0) <=> real_summable k f`, REWRITE_TAC[real_summable; REAL_SERIES_RESTRICT]);; let REAL_SUMS_FINITE_DIFF = prove (`!f t s l. t SUBSET s /\ FINITE t /\ (f real_sums l) s ==> (f real_sums (l - sum t f)) (s DIFF t)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o ISPEC `f:num->real` o MATCH_MP REAL_SERIES_FINITE) THEN ONCE_REWRITE_TAC[GSYM REAL_SERIES_RESTRICT] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_SERIES_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_SUMS_FINITE_UNION = prove (`!f s t l. FINITE t /\ (f real_sums l) s ==> (f real_sums (l + sum (t DIFF s) f)) (s UNION t)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN DISCH_THEN(MP_TAC o ISPEC `f:num->real` o MATCH_MP REAL_SERIES_FINITE) THEN ONCE_REWRITE_TAC[GSYM REAL_SERIES_RESTRICT] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_SERIES_ADD) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF; IN_UNION] THEN MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_SUMS_OFFSET = prove (`!f l m n. (f real_sums l) (from m) /\ m < n ==> (f real_sums (l - sum(m..(n-1)) f)) (from n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC; MATCH_MP_TAC REAL_SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);; let REAL_SUMS_OFFSET_REV = prove (`!f l m n. (f real_sums l) (from m) /\ n < m ==> (f real_sums (l + sum(n..m-1) f)) (from n)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real`; `from m`; `n..m-1`; `l:real`] REAL_SUMS_FINITE_UNION) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN ASM_ARITH_TAC);; let REAL_SUMMABLE_EVEN = prove (`!f n. real_summable (from n) f <=> real_summable (from (2 * n)) (\i. if EVEN i then f(i DIV 2) else &0)`, REWRITE_TAC[real_summable; GSYM REAL_SERIES_EVEN]);; let REAL_SUMMABLE_ODD = prove (`!f n. real_summable (from n) f <=> real_summable (from (2 * n + 1)) (\i. if ODD i then f(i DIV 2) else &0)`, REWRITE_TAC[real_summable; GSYM REAL_SERIES_ODD]);; (* ------------------------------------------------------------------------- *) (* Similar combining theorems for infsum. *) (* ------------------------------------------------------------------------- *) let REAL_INFSUM_0 = prove (`real_infsum s (\i. &0) = &0`, MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN REWRITE_TAC[REAL_SERIES_0]);; let REAL_INFSUM_ADD = prove (`!x y s. real_summable s x /\ real_summable s y ==> real_infsum s (\i. x i + y i) = real_infsum s x + real_infsum s y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN MATCH_MP_TAC REAL_SERIES_ADD THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; let REAL_INFSUM_SUB = prove (`!x y s. real_summable s x /\ real_summable s y ==> real_infsum s (\i. x i - y i) = real_infsum s x - real_infsum s y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN MATCH_MP_TAC REAL_SERIES_SUB THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; let REAL_INFSUM_LMUL = prove (`!s x c. real_summable s x ==> real_infsum s (\n. c * x n) = c * real_infsum s x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN MATCH_MP_TAC REAL_SERIES_LMUL THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; let REAL_INFSUM_RMUL = prove (`!s x c. real_summable s x ==> real_infsum s (\n. x n * c) = real_infsum s x * c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN MATCH_MP_TAC REAL_SERIES_RMUL THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; let REAL_INFSUM_NEG = prove (`!s x. real_summable s x ==> real_infsum s (\n. --(x n)) = --(real_infsum s x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN MATCH_MP_TAC REAL_SERIES_NEG THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; let REAL_INFSUM_EQ = prove (`!f g k. real_summable k f /\ real_summable k g /\ (!x. x IN k ==> f x = g x) ==> real_infsum k f = real_infsum k g`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_infsum] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[REAL_SUMS_EQ; REAL_SUMS_INFSUM]);; let REAL_INFSUM_RESTRICT = prove (`!k a. real_infsum (:num) (\n. if n IN k then a n else &0) = real_infsum k a`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`a:num->real`; `k:num->bool`] REAL_SUMMABLE_RESTRICT) THEN ASM_CASES_TAC `real_summable k a` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN ASM_REWRITE_TAC[REAL_SERIES_RESTRICT; REAL_SUMS_INFSUM]; RULE_ASSUM_TAC(REWRITE_RULE[real_summable; NOT_EXISTS_THM]) THEN ASM_REWRITE_TAC[real_infsum]]);; let REAL_INFSUM_EVEN = prove (`!f n. real_infsum (from n) f = real_infsum (from (2 * n)) (\i. if EVEN i then f(i DIV 2) else &0)`, REWRITE_TAC[real_infsum; GSYM REAL_SERIES_EVEN]);; let REAL_INFSUM_ODD = prove (`!f n. real_infsum (from n) f = real_infsum (from (2 * n + 1)) (\i. if ODD i then f(i DIV 2) else &0)`, REWRITE_TAC[real_infsum; GSYM REAL_SERIES_ODD]);; (* ------------------------------------------------------------------------- *) (* Convergence tests for real series. *) (* ------------------------------------------------------------------------- *) let REAL_SERIES_CAUCHY_UNIFORM = prove (`!P:A->bool f k. (?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> abs(sum(k INTER (0..n)) (f x) - l x) < e) <=> (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x ==> abs(sum(k INTER (m..n)) (f x)) < e)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`P:A->bool`; `\x:A n:num. lift(f x n)`; `k:num->bool`] SERIES_CAUCHY_UNIFORM) THEN SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN REWRITE_TAC[NORM_LIFT; o_DEF; LIFT_DROP; ETA_AX] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `l:A->real`) THEN EXISTS_TAC `lift o (l:A->real)` THEN ASM_SIMP_TAC[o_THM; DIST_LIFT]; DISCH_THEN(X_CHOOSE_TAC `l:A->real^1`) THEN EXISTS_TAC `drop o (l:A->real^1)` THEN ASM_SIMP_TAC[SUM_VSUM; FINITE_INTER; FINITE_NUMSEG] THEN REWRITE_TAC[o_THM; GSYM DROP_SUB; GSYM ABS_DROP] THEN SIMP_TAC[GSYM dist; VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; let REAL_SERIES_COMPARISON = prove (`!f g s. (?l. (g real_sums l) s) /\ (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n) ==> ?l. (f real_sums l) s`, REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `g:num->real` THEN REWRITE_TAC[NORM_LIFT; o_THM] THEN ASM_MESON_TAC[]);; let REAL_SUMMABLE_COMPARISON = prove (`!f g s. real_summable s g /\ (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n) ==> real_summable s f`, REWRITE_TAC[real_summable; REAL_SERIES_COMPARISON]);; let REAL_SERIES_COMPARISON_UNIFORM = prove (`!f g P s. (?l. (g real_sums l) s) /\ (?N. !n x. N <= n /\ n IN s /\ P x ==> abs(f x n) <= g n) ==> ?l:A->real. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> abs(sum(s INTER (0..n)) (f x) - l x) < e`, REPEAT GEN_TAC THEN SIMP_TAC[GE; REAL_SERIES_CAUCHY; REAL_SERIES_CAUCHY_UNIFORM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs (sum (s INTER (m .. n)) g)` THEN CONJ_TAC THENL [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`]; ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);; let REAL_SERIES_RATIO = prove (`!c a s N. c < &1 /\ (!n. n >= N ==> abs(a(SUC n)) <= c * abs(a(n))) ==> ?l:real. (a real_sums l) s`, REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_RATIO THEN REWRITE_TAC[o_THM; NORM_LIFT] THEN ASM_MESON_TAC[]);; let BOUNDED_PARTIAL_REAL_SUMS = prove (`!f:num->real k. real_bounded { sum(k..n) f | n IN (:num) } ==> real_bounded { sum(m..n) f | m IN (:num) /\ n IN (:num) }`, REWRITE_TAC[REAL_BOUNDED] THEN REWRITE_TAC[SET_RULE `IMAGE f {g x | P x} = {f(g x) | P x}`; SET_RULE `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`] THEN SIMP_TAC[LIFT_SUM; FINITE_INTER; FINITE_NUMSEG] THEN REWRITE_TAC[BOUNDED_PARTIAL_SUMS]);; let REAL_SERIES_DIRICHLET = prove (`!f:num->real g N k m. real_bounded { sum (m..n) f | n IN (:num)} /\ (!n. N <= n ==> g(n + 1) <= g(n)) /\ (g ---> &0) sequentially ==> real_summable (from k) (\n. g(n) * f(n))`, REWRITE_TAC[REAL_SUMMABLE; REAL_BOUNDED; TENDSTO_REAL] THEN REWRITE_TAC[LIFT_NUM; LIFT_CMUL; o_DEF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_DIRICHLET THEN MAP_EVERY EXISTS_TAC [`N:num`; `m:num`] THEN ASM_REWRITE_TAC[o_DEF] THEN SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN ASM_REWRITE_TAC[SET_RULE `{lift(f x) | P x} = IMAGE lift {f x | P x}`]);; let REAL_SERIES_ABSCONV_IMP_CONV = prove (`!x:num->real k. real_summable k (\n. abs(x n)) ==> real_summable k x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN EXISTS_TAC `\n:num. abs(x n)` THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; let REAL_SUMS_GP = prove (`!n x. abs(x) < &1 ==> ((\k. x pow k) real_sums (x pow n / (&1 - x))) (from n)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `Cx x`] SUMS_GP) THEN ASM_REWRITE_TAC[REAL_SUMS_COMPLEX; GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; o_DEF; COMPLEX_NORM_CX]);; let REAL_SUMMABLE_GP = prove (`!x k. abs(x) < &1 ==> real_summable k (\n. x pow n)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`Cx x`; `k:num->bool`] SUMMABLE_GP) THEN ASM_REWRITE_TAC[REAL_SUMMABLE_COMPLEX] THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; o_DEF; CX_POW]);; let REAL_SUMMABLE_ZETA = prove (`!n x. &1 < x ==> real_summable (from n) (\k. inv(&k rpow x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `1` THEN REWRITE_TAC[REAL_SUMMABLE_COMPLEX] THEN MP_TAC(ISPECL [`1`; `Cx x`] SUMMABLE_ZETA) THEN ASM_REWRITE_TAC[RE_CX; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ) THEN SIMP_TAC[IN_FROM; cpow; rpow; REAL_OF_NUM_EQ; REAL_OF_NUM_LT; CX_INJ; LE_1; GSYM CX_LOG; GSYM CX_MUL; GSYM CX_EXP; GSYM CX_INV]);; let REAL_SUMMABLE_ZETA_INTEGER = prove (`!n m. 2 <= m ==> real_summable (from n) (\k. inv(&k pow m))`, REWRITE_TAC[REAL_SUMMABLE_COMPLEX; CX_INV; CX_POW; SUMMABLE_ZETA_INTEGER; o_DEF]);; let REAL_ABEL_LEMMA = prove (`!a M r r0. &0 <= r /\ r < r0 /\ (!n. n IN k ==> abs(a n) * r0 pow n <= M) ==> real_summable k (\n. abs(a(n)) * r pow n)`, REWRITE_TAC[REAL_SUMMABLE_COMPLEX] THEN REWRITE_TAC[o_DEF; CX_MUL; CX_ABS] THEN REWRITE_TAC[GSYM CX_MUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABEL_LEMMA THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_MESON_TAC[]);; let REAL_POWER_SERIES_CONV_IMP_ABSCONV = prove (`!a k w z. real_summable k (\n. a(n) * z pow n) /\ abs(w) < abs(z) ==> real_summable k (\n. abs(a(n) * w pow n))`, REWRITE_TAC[REAL_SUMMABLE_COMPLEX; o_DEF; CX_MUL; CX_ABS; CX_POW] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN EXISTS_TAC `Cx z` THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX]);; let POWER_REAL_SERIES_CONV_IMP_ABSCONV_WEAK = prove (`!a k w z. real_summable k (\n. a(n) * z pow n) /\ abs(w) < abs(z) ==> real_summable k (\n. abs(a n) * w pow n)`, REWRITE_TAC[REAL_SUMMABLE_COMPLEX; o_DEF; CX_MUL; CX_ABS; CX_POW] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV_WEAK THEN EXISTS_TAC `Cx z` THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX]);; let REAL_SUMMABLE_MUL_LEFT = prove (`!x y m n p. real_summable (from m) (\n. abs(x n)) /\ real_summable (from n) y ==> real_summable (from p) (\n. sum(0..n) (\i. x i * y(n - i)))`, ONCE_REWRITE_TAC[SPEC `0` REAL_SUMMABLE_FROM_ELSEWHERE_EQ] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_SERIES_ABSCONV_IMP_CONV) THEN UNDISCH_TAC `real_summable (from 0) y` THEN REWRITE_TAC[real_summable; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN EXISTS_TAC `a * b:real` THEN MATCH_MP_TAC REAL_SERIES_MUL THEN ASM_REWRITE_TAC[]);; let REAL_SUMMABLE_MUL_RIGHT = prove (`!x y m n p. real_summable (from m) x /\ real_summable (from n) (\n. abs(y n)) ==> real_summable (from p) (\n. sum(0..n) (\i. x i * y(n - i)))`, ONCE_REWRITE_TAC[SPEC `0` REAL_SUMMABLE_FROM_ELSEWHERE_EQ] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_SERIES_ABSCONV_IMP_CONV) THEN UNDISCH_TAC `real_summable (from 0) x` THEN REWRITE_TAC[real_summable; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN EXISTS_TAC `a * b:real` THEN MATCH_MP_TAC REAL_SERIES_MUL THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Nets for real limit. *) (* ------------------------------------------------------------------------- *) let atreal = new_definition `atreal a = mk_net(\x y. &0 < abs(x - a) /\ abs(x - a) <= abs(y - a))`;; let ATREAL = prove (`!a x y. netord(atreal a) x y <=> &0 < abs(x - a) /\ abs(x - a) <= abs(y - a)`, GEN_TAC THEN NET_PROVE_TAC[atreal] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);; let WITHINREAL_UNIV = prove (`!x. atreal x within (:real) = atreal x`, REWRITE_TAC[within; atreal; IN_UNIV] THEN REWRITE_TAC[ETA_AX; net_tybij]);; let TRIVIAL_LIMIT_ATREAL = prove (`!a. ~(trivial_limit (atreal a))`, X_GEN_TAC `a:real` THEN SIMP_TAC[trivial_limit; ATREAL; DE_MORGAN_THM] THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN ASM_CASES_TAC `b:real = c` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM NOT_EXISTS_THM] THEN SUBGOAL_THEN `~(b:real = a) \/ ~(c = a)` DISJ_CASES_TAC THENL [ASM_MESON_TAC[]; EXISTS_TAC `(a + b) / &2` THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `(a + c) / &2` THEN ASM_REAL_ARITH_TAC]);; let NETLIMIT_WITHINREAL = prove (`!a s. ~(trivial_limit (atreal a within s)) ==> (netlimit (atreal a within s) = a)`, REWRITE_TAC[trivial_limit; netlimit; ATREAL; WITHIN; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!x. ~(&0 < abs(x - a) /\ abs(x - a) <= abs(a - a) /\ x IN s)` ASSUME_TAC THENL [REAL_ARITH_TAC; ASM_MESON_TAC[]]);; let NETLIMIT_ATREAL = prove (`!a. netlimit(atreal a) = a`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN MATCH_MP_TAC NETLIMIT_WITHINREAL THEN SIMP_TAC[TRIVIAL_LIMIT_ATREAL; WITHINREAL_UNIV]);; let EVENTUALLY_WITHINREAL_LE = prove (`!s a p. eventually p (atreal a within s) <=> ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d ==> p(x)`, REWRITE_TAC[eventually; ATREAL; WITHIN; trivial_limit] THEN REWRITE_TAC[MESON[REAL_LT_01; REAL_LT_REFL] `~(!a b:real. a = b)`] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `b:real` MP_TAC)) THENL [DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(b = c) ==> &0 < abs(b - a) \/ &0 < abs(c - a)`)) THEN ASM_MESON_TAC[]; MESON_TAC[REAL_LTE_TRANS]]; DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `?x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d` THENL [DISJ2_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `b:real`) THEN EXISTS_TAC `b:real` THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; DISJ1_TAC THEN MAP_EVERY EXISTS_TAC [`a + d:real`; `a:real`] THEN ASM_SIMP_TAC[REAL_ADD_SUB; REAL_EQ_ADD_LCANCEL_0; REAL_LT_IMP_NZ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real` THEN ASM_CASES_TAC `(x:real) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; let EVENTUALLY_WITHINREAL = prove (`!s a p. eventually p (atreal a within s) <=> ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d ==> p(x)`, REWRITE_TAC[EVENTUALLY_WITHINREAL_LE] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN REWRITE_TAC[APPROACHABLE_LT_LE]);; let EVENTUALLY_ATREAL = prove (`!a p. eventually p (atreal a) <=> ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d ==> p(x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[EVENTUALLY_WITHINREAL; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Usual limit results with real domain and either vector or real range. *) (* ------------------------------------------------------------------------- *) let LIM_WITHINREAL_LE = prove (`!f:real->real^N l a s. (f --> l) (atreal a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_WITHINREAL_LE]);; let LIM_WITHINREAL = prove (`!f:real->real^N l a s. (f --> l) (atreal a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_WITHINREAL] THEN MESON_TAC[]);; let LIM_ATREAL = prove (`!f l:real^N a. (f --> l) (atreal a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_ATREAL] THEN MESON_TAC[]);; let REALLIM_WITHINREAL_LE = prove (`!f l a s. (f ---> l) (atreal a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_WITHINREAL_LE]);; let REALLIM_WITHINREAL = prove (`!f l a s. (f ---> l) (atreal a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_WITHINREAL] THEN MESON_TAC[]);; let REALLIM_ATREAL = prove (`!f l a. (f ---> l) (atreal a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_ATREAL] THEN MESON_TAC[]);; let REALLIM_AT_POSINFINITY = prove (`!f l. (f ---> l) at_posinfinity <=> !e. &0 < e ==> ?b. !x. x >= b ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]);; let REALLIM_AT_NEGINFINITY = prove (`!f l. (f ---> l) at_neginfinity <=> !e. &0 < e ==> ?b. !x. x <= b ==> abs(f(x) - l) < e`, REWRITE_TAC[tendsto_real; EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]);; let LIM_ATREAL_WITHINREAL = prove (`!f l a s. (f --> l) (atreal a) ==> (f --> l) (atreal a within s)`, REWRITE_TAC[LIM_ATREAL; LIM_WITHINREAL] THEN MESON_TAC[]);; let REALLIM_AT_WITHIN = prove (`!f l a s. (f ---> l) (at a) ==> (f ---> l) (at a within s)`, REWRITE_TAC[TENDSTO_REAL; LIM_AT_WITHIN]);; let REALLIM_ATREAL_WITHINREAL = prove (`!f l a s. (f ---> l) (atreal a) ==> (f ---> l) (atreal a within s)`, REWRITE_TAC[REALLIM_ATREAL; REALLIM_WITHINREAL] THEN MESON_TAC[]);; let REALLIM_WITHIN_SUBSET = prove (`!f l a s t. (f ---> l) (at a within s) /\ t SUBSET s ==> (f ---> l) (at a within t)`, REWRITE_TAC[REALLIM_WITHIN; SUBSET] THEN MESON_TAC[]);; let REALLIM_WITHINREAL_SUBSET = prove (`!f l a s t. (f ---> l) (atreal a within s) /\ t SUBSET s ==> (f ---> l) (atreal a within t)`, REWRITE_TAC[REALLIM_WITHINREAL; SUBSET] THEN MESON_TAC[]);; let LIM_WITHINREAL_SUBSET = prove (`!f l a s t. (f --> l) (atreal a within s) /\ t SUBSET s ==> (f --> l) (atreal a within t)`, REWRITE_TAC[LIM_WITHINREAL; SUBSET] THEN MESON_TAC[]);; let REALLIM_ATREAL_ID = prove (`((\x. x) ---> a) (atreal a)`, REWRITE_TAC[REALLIM_ATREAL] THEN MESON_TAC[]);; let REALLIM_WITHINREAL_ID = prove (`!a. ((\x. x) ---> a) (atreal a within s)`, REWRITE_TAC[REALLIM_WITHINREAL] THEN MESON_TAC[]);; let LIM_TRANSFORM_WITHINREAL_SET = prove (`!f a s t. eventually (\x. x IN s <=> x IN t) (atreal a) ==> ((f --> l) (atreal a within s) <=> (f --> l) (atreal a within t))`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_ATREAL; LIM_WITHINREAL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let REALLIM_TRANSFORM_WITHIN_SET = prove (`!f a s t. eventually (\x. x IN s <=> x IN t) (at a) ==> ((f ---> l) (at a within s) <=> (f ---> l) (at a within t))`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; REALLIM_WITHIN] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let REALLIM_TRANSFORM_WITHINREAL_SET = prove (`!f a s t. eventually (\x. x IN s <=> x IN t) (atreal a) ==> ((f ---> l) (atreal a within s) <=> (f ---> l) (atreal a within t))`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_ATREAL; REALLIM_WITHINREAL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let REALLIM_TRANSFORM_WITHIN_SET_IMP = prove (`!f l a s t. eventually (\x. x IN t ==> x IN s) (at a) /\ (f ---> l) (at a within s) ==> (f ---> l) (at a within t)`, REWRITE_TAC[TENDSTO_REAL; LIM_TRANSFORM_WITHIN_SET_IMP]);; let LIM_TRANSFORM_WITHINREAL_SET_IMP = prove (`!f l a s t. eventually (\x. x IN t ==> x IN s) (atreal a) /\ (f --> l) (atreal a within s) ==> (f --> l) (atreal a within t)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; EVENTUALLY_ATREAL; LIM_WITHINREAL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let REALLIM_TRANSFORM_WITHINREAL_SET_IMP = prove (`!f l a s t. eventually (\x. x IN t ==> x IN s) (atreal a) /\ (f ---> l) (atreal a within s) ==> (f ---> l) (atreal a within t)`, REWRITE_TAC[TENDSTO_REAL; LIM_TRANSFORM_WITHINREAL_SET_IMP]);; let REALLIM_COMPOSE_WITHIN = prove (`!net:A net f g s y z. (f ---> y) net /\ eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\ (g ---> z) (atreal y within s) ==> ((g o f) ---> z) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto_real; CONJ_ASSOC] THEN ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EVENTUALLY_WITHINREAL; GSYM DIST_NZ; o_DEF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `x:A` THEN ASM_CASES_TAC `(f:A->real) x = y` THEN ASM_MESON_TAC[REAL_ARITH `abs(x - y) = &0 <=> x = y`; REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`]);; let REALLIM_COMPOSE_AT = prove (`!net:A net f g y z. (f ---> y) net /\ eventually (\w. f w = y ==> g y = z) net /\ (g ---> z) (atreal y) ==> ((g o f) ---> z) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:A net`; `f:A->real`; `g:real->real`; `(:real)`; `y:real`; `z:real`] REALLIM_COMPOSE_WITHIN) THEN ASM_REWRITE_TAC[IN_UNIV; WITHINREAL_UNIV]);; (* ------------------------------------------------------------------------- *) (* Summability of alternating seties. *) (* ------------------------------------------------------------------------- *) let ALTERNATING_SUM_BOUNDS = prove (`!a. (!n. abs(a(SUC n)) <= abs(a n)) /\ (!n. EVEN n ==> &0 <= a n) /\ (!n. ODD n ==> a n <= &0) ==> !m n. (EVEN m ==> &0 <= sum(m..n) a /\ sum(m..n) a <= a(m)) /\ (ODD m ==> a(m) <= sum(m..n) a /\ sum(m..n) a <= &0)`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[LE_EXISTS; NOT_LT] `(!m n:num. n < m ==> P m n) /\ (!n m. P m (m + n)) ==> !m n. P m n`) THEN ASM_SIMP_TAC[GSYM NUMSEG_EMPTY; SUM_CLAUSES; REAL_LE_REFL] THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD_CLAUSES; SUM_SING_NUMSEG; REAL_LE_REFL] THEN SIMP_TAC[SUM_CLAUSES_LEFT; ARITH_RULE `m <= SUC(m + n)`] THEN X_GEN_TAC `m:num` THEN SIMP_TAC[ARITH_RULE `SUC(m + n) = (m + 1) + n`] THEN CONJ_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC o SPEC `m + 1`) THEN ASM_REWRITE_TAC[ODD_ADD; EVEN_ADD; ARITH; NOT_ODD; NOT_EVEN] THEN SIMP_TAC[REAL_LE_ADDR; REAL_ARITH `x + y <= x <=> y <= &0`] THENL [MATCH_MP_TAC(REAL_ARITH `abs b <= abs a /\ &0 <= a ==> b <= s /\ u <= v ==> &0 <= a + s`); MATCH_MP_TAC(REAL_ARITH `abs b <= abs a /\ a <= &0 ==> u <= v /\ s <= b ==> a + s <= &0`)] THEN ASM_SIMP_TAC[GSYM ADD1]);; let ALTERNATING_SUM_BOUND = prove (`!a. (!n. abs(a(SUC n)) <= abs(a n)) /\ (!n. EVEN n ==> &0 <= a n) /\ (!n. ODD n ==> a n <= &0) ==> !m n. abs(sum(m..n) a) <= abs(a m)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ALTERNATING_SUM_BOUNDS) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[GSYM NOT_EVEN] THEN ASM_CASES_TAC `EVEN m` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_SUMMABLE_ALTERNATING_SERIES = prove (`!a m. (!n. abs(a(SUC n)) <= abs(a n)) /\ (!n. EVEN n ==> &0 <= a n) /\ (!n. ODD n ==> a n <= &0) /\ (a ---> &0) sequentially ==> real_summable (from m) a`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUMMABLE_CAUCHY; FROM_INTER_NUMSEG_MAX] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[GE; REAL_SUB_RZERO] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `p:num`] THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `abs(a(MAX m n))` THEN ASM_SIMP_TAC[ALTERNATING_SUM_BOUND] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some real limits involving transcendentals. *) (* ------------------------------------------------------------------------- *) let REALLIM_1_OVER_N_OFFSET = prove (`!a. ((\n. inv(&n + a)) ---> &0) sequentially`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; CX_ADD; LIM_INV_N_OFFSET]);; let REALLIM_1_OVER_N = prove (`((\n. inv(&n)) ---> &0) sequentially`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; LIM_INV_N]);; let REALLIM_1_OVER_POW = prove (`!k. 1 <= k ==> ((\n. inv(&n pow k)) ---> &0) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&n pow 1)` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_ABS_NUM] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LT; MATCH_MP_TAC REAL_POW_MONO] THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1]; REWRITE_TAC[REAL_POW_1; REALLIM_1_OVER_N]]);; let REALLIM_LOG_OVER_N = prove (`((\n. log(&n) / &n) ---> &0) sequentially`, REWRITE_TAC[REALLIM_COMPLEX] THEN MP_TAC LIM_LOG_OVER_N THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[o_DEF; CX_DIV; CX_LOG; REAL_OF_NUM_LT; ARITH_RULE `1 <= n ==> 0 < n`]);; let REALLIM_1_OVER_LOG = prove (`((\n. inv(log(&n))) ---> &0) sequentially`, REWRITE_TAC[REALLIM_COMPLEX] THEN MP_TAC LIM_1_OVER_LOG THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[o_DEF; complex_div; COMPLEX_MUL_LID; CX_INV] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; ARITH_RULE `1 <= n ==> 0 < n`]);; let REALLIM_POWN = prove (`!z. abs(z) < &1 ==> ((\n. z pow n) ---> &0) sequentially`, REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_POW] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POWN THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX]);; let REALLIM_X_TIMES_LOG = prove (`((\x. x * log x) ---> &0) (atreal(&0) within {x | &0 <= x})`, MP_TAC LIM_Z_TIMES_CLOG THEN REWRITE_TAC[REALLIM_WITHINREAL; LIM_AT] THEN REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO; dist; COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN ASM_CASES_TAC `x = &0` THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx x`) THEN ASM_SIMP_TAC[COMPLEX_NORM_MUL; GSYM CX_LOG; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_MUL]);; (* ------------------------------------------------------------------------- *) (* Relations between limits at real and complex limit points. *) (* ------------------------------------------------------------------------- *) let TRIVIAL_LIMIT_WITHINREAL_WITHIN = prove (`trivial_limit(atreal x within s) <=> trivial_limit(at (lift x) within (IMAGE lift s))`, REWRITE_TAC[trivial_limit; AT; WITHIN; ATREAL] THEN REWRITE_TAC[FORALL_LIFT; EXISTS_LIFT; LIFT_EQ; DIST_LIFT] THEN REWRITE_TAC[IN_IMAGE_LIFT_DROP; LIFT_DROP]);; let TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX = prove (`trivial_limit(atreal x within s) <=> trivial_limit(at (Cx x) within (real INTER IMAGE Cx s))`, REWRITE_TAC[trivial_limit; AT; WITHIN; ATREAL] THEN REWRITE_TAC[SET_RULE `x IN real INTER s <=> real x /\ x IN s`] THEN REWRITE_TAC[TAUT `~(p /\ x /\ q) /\ ~(r /\ x /\ s) <=> x ==> ~(p /\ q) /\ ~(r /\ s)`] THEN REWRITE_TAC[FORALL_REAL; MESON[IN_IMAGE; CX_INJ] `Cx x IN IMAGE Cx s <=> x IN s`] THEN REWRITE_TAC[dist; GSYM CX_SUB; o_THM; RE_CX; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(TAUT `~p /\ ~q /\ (r <=> s) ==> (p \/ r <=> q \/ s)`) THEN REPEAT CONJ_TAC THEN TRY EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN CONV_TAC REAL_RING; DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(&1)`]) THEN CONV_TAC COMPLEX_RING; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`Cx a`; `Cx b`] THEN ASM_REWRITE_TAC[CX_INJ] THEN ASM_REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX]; MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN STRIP_TAC THEN SUBGOAL_THEN `?d. &0 < d /\ !z. &0 < abs(z - x) /\ abs(z - x) <= d ==> ~(z IN s)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MESON[] `!a b. P a \/ P b ==> ?x. P x`) THEN MAP_EVERY EXISTS_TAC [`norm(a - Cx x)`; `norm(b - Cx x)`] THEN ASM_REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN UNDISCH_TAC `~(a:complex = b)` THEN NORM_ARITH_TAC; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`x + d:real`; `x - d:real`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> ~(x + d = x - d)`; REAL_ARITH `&0 < d ==> abs((x + d) - x) = d`; REAL_ARITH `&0 < d ==> abs(x - d - x) = d`] THEN ASM_MESON_TAC[]]);; let LIM_WITHINREAL_WITHINCOMPLEX = prove (`(f --> a) (atreal x within s) <=> ((f o Re) --> a) (at(Cx x) within (real INTER IMAGE Cx s))`, REWRITE_TAC[LIM_WITHINREAL; LIM_WITHIN] THEN REWRITE_TAC[SET_RULE `x IN real INTER s <=> real x /\ x IN s`] THEN REWRITE_TAC[IMP_CONJ; FORALL_REAL; MESON[IN_IMAGE; CX_INJ] `Cx x IN IMAGE Cx s <=> x IN s`] THEN REWRITE_TAC[dist; GSYM CX_SUB; o_THM; RE_CX; COMPLEX_NORM_CX]);; let LIM_ATREAL_ATCOMPLEX = prove (`(f --> a) (atreal x) <=> ((f o Re) --> a) (at (Cx x) within real)`, REWRITE_TAC[LIM_ATREAL; LIM_WITHIN] THEN REWRITE_TAC[IMP_CONJ; FORALL_REAL; IN; dist; GSYM CX_SUB; COMPLEX_NORM_CX; o_THM; RE_CX]);; (* ------------------------------------------------------------------------- *) (* Simpler theorems relating limits in real and real^1. *) (* ------------------------------------------------------------------------- *) let LIM_WITHINREAL_WITHIN = prove (`(f --> a) (atreal x within s) <=> ((f o drop) --> a) (at (lift x) within (IMAGE lift s))`, REWRITE_TAC[LIM_WITHINREAL; LIM_WITHIN] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; let LIM_ATREAL_AT = prove (`(f --> a) (atreal x) <=> ((f o drop) --> a) (at (lift x))`, REWRITE_TAC[LIM_ATREAL; LIM_AT; FORALL_LIFT] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; let REALLIM_WITHINREAL_WITHIN = prove (`(f ---> a) (atreal x within s) <=> ((f o drop) ---> a) (at (lift x) within (IMAGE lift s))`, REWRITE_TAC[REALLIM_WITHINREAL; REALLIM_WITHIN] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; let REALLIM_ATREAL_AT = prove (`(f ---> a) (atreal x) <=> ((f o drop) ---> a) (at (lift x))`, REWRITE_TAC[REALLIM_ATREAL; REALLIM_AT; FORALL_LIFT] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; let REALLIM_WITHIN_OPEN = prove (`!f:real^N->real l a s. a IN s /\ open s ==> ((f ---> l) (at a within s) <=> (f ---> l) (at a))`, REWRITE_TAC[TENDSTO_REAL; LIM_WITHIN_OPEN]);; let LIM_WITHIN_REAL_OPEN = prove (`!f:real->real^N l a s. a IN s /\ real_open s ==> ((f --> l) (atreal a within s) <=> (f --> l) (atreal a))`, REWRITE_TAC[LIM_WITHINREAL_WITHIN; LIM_ATREAL_AT; REAL_OPEN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_WITHIN_OPEN THEN ASM SET_TAC[]);; let REALLIM_WITHIN_REAL_OPEN = prove (`!f l a s. a IN s /\ real_open s ==> ((f ---> l) (atreal a within s) <=> (f ---> l) (atreal a))`, REWRITE_TAC[TENDSTO_REAL; LIM_WITHIN_REAL_OPEN]);; let LIM_ATREAL_ZERO = prove (`!f l a. (f --> l) (atreal a) <=> ((\x. f (a + x)) --> l) (atreal (&0))`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_ATREAL_AT; LIFT_NUM; o_DEF] THEN GEN_REWRITE_TAC LAND_CONV [LIM_AT_ZERO] THEN REWRITE_TAC[LIFT_DROP; DROP_ADD]);; let REALLIM_AT_ZERO = prove (`!f l a. (f ---> l) (at a) <=> ((\x. f (a + x)) ---> l) (at (vec 0))`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN GEN_REWRITE_TAC LAND_CONV [LIM_AT_ZERO] THEN REWRITE_TAC[o_DEF]);; let REALLIM_ATREAL_ZERO = prove (`!f l a. (f ---> l) (atreal a) <=> ((\x. f (a + x)) ---> l) (atreal (&0))`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN GEN_REWRITE_TAC LAND_CONV [LIM_ATREAL_ZERO] THEN REWRITE_TAC[o_DEF]);; (* ------------------------------------------------------------------------- *) (* Additional congruence rules for simplifying limits. *) (* ------------------------------------------------------------------------- *) let LIM_CONG_WITHINREAL = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (atreal a within s) <=> ((g --> l) (atreal a within s)))`, SIMP_TAC[LIM_WITHINREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; let LIM_CONG_ATREAL = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (atreal a) <=> ((g --> l) (atreal a)))`, SIMP_TAC[LIM_ATREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; extend_basic_congs [LIM_CONG_WITHINREAL; LIM_CONG_ATREAL];; let REALLIM_CONG_WITHIN = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) ---> l) (at a within s) <=> ((g ---> l) (at a within s)))`, REWRITE_TAC[REALLIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);; let REALLIM_CONG_AT = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) ---> l) (at a) <=> ((g ---> l) (at a)))`, REWRITE_TAC[REALLIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);; extend_basic_congs [REALLIM_CONG_WITHIN; REALLIM_CONG_AT];; let REALLIM_CONG_WITHINREAL = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) ---> l) (atreal a within s) <=> ((g ---> l) (atreal a within s)))`, SIMP_TAC[REALLIM_WITHINREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; let REALLIM_CONG_ATREAL = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) ---> l) (atreal a) <=> ((g ---> l) (atreal a)))`, SIMP_TAC[REALLIM_ATREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; extend_basic_congs [REALLIM_CONG_WITHINREAL; REALLIM_CONG_ATREAL];; (* ------------------------------------------------------------------------- *) (* Real version of Abel limit theorem. *) (* ------------------------------------------------------------------------- *) let REAL_ABEL_LIMIT_THEOREM = prove (`!s a. real_summable s a ==> (!r. abs(r) < &1 ==> real_summable s (\i. a i * r pow i)) /\ ((\r. real_infsum s (\i. a i * r pow i)) ---> real_infsum s a) (atreal (&1) within {z | z <= &1})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`&1`; `s:num->bool`; `Cx o (a:num->real)`] ABEL_LIMIT_THEOREM_1) THEN ASM_REWRITE_TAC[GSYM REAL_SUMMABLE_COMPLEX; REAL_LT_01] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [X_GEN_TAC `r:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx r`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_SUMMABLE_COMPLEX] THEN REWRITE_TAC[o_DEF; CX_MUL; CX_POW]; DISCH_TAC] THEN REWRITE_TAC[REALLIM_COMPLEX; LIM_WITHINREAL_WITHINCOMPLEX] THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN EXISTS_TAC `\z. infsum s (\i. (Cx o a) i * z pow i)` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [REWRITE_TAC[IMP_CONJ; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN REWRITE_TAC[IN; FORALL_REAL] THEN X_GEN_TAC `r:real` THEN REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_ARITH `r <= &1 ==> (&0 < abs(r - &1) <=> r < &1)`] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs(r) < &1` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_INFSUM_COMPLEX; o_THM; RE_CX] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM REAL; o_DEF; CX_MUL; CX_POW] THEN MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN EXISTS_TAC `\n. vsum(s INTER (0..n)) (\i. Cx(a i) * Cx r pow i)` THEN REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN SIMP_TAC[GSYM CX_POW; GSYM CX_MUL; REAL_VSUM; FINITE_INTER; FINITE_NUMSEG; SUMS_INFSUM; REAL_CX; GE] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[LE_REFL]] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[GSYM REAL_SUMMABLE_COMPLEX]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_INFSUM_COMPLEX] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN REWRITE_TAC[LIM_WITHIN] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_LID; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN EXISTS_TAC `min d (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN REWRITE_TAC[IMP_CONJ; IN; FORALL_REAL] THEN REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN X_GEN_TAC `r:real` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_ARITH `r <= &1 ==> (&0 < abs(r - &1) <=> r < &1)`] THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs(r) < &1` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o SPEC `Cx r`) THEN REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(NORM_ARITH `b = a ==> norm(x - a) < e ==> norm(x - b) < e`) THEN REWRITE_TAC[GSYM REAL] THEN MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN EXISTS_TAC `\n. vsum(s INTER (0..n)) (Cx o a)` THEN REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN SIMP_TAC[GSYM CX_POW; GSYM CX_MUL; REAL_VSUM; FINITE_INTER; FINITE_NUMSEG; SUMS_INFSUM; REAL_CX; GE; o_DEF] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[LE_REFL]] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[GSYM REAL_SUMMABLE_COMPLEX]);; (* ------------------------------------------------------------------------- *) (* Continuity of a function into the reals. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("real_continuous",(12,"right"));; let real_continuous = new_definition `f real_continuous net <=> (f ---> f(netlimit net)) net`;; let REAL_CONTINUOUS_TRIVIAL_LIMIT = prove (`!f net. trivial_limit net ==> f real_continuous net`, SIMP_TAC[real_continuous; REALLIM]);; let REAL_CONTINUOUS_WITHIN = prove (`!f x:real^N s. f real_continuous (at x within s) <=> (f ---> f(x)) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous] THEN ASM_CASES_TAC `trivial_limit(at(x:real^N) within s)` THENL [ASM_REWRITE_TAC[REALLIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; let REAL_CONTINUOUS_AT = prove (`!f x. f real_continuous (at x) <=> (f ---> f(x)) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN; IN_UNIV]);; let REAL_CONTINUOUS_WITHINREAL = prove (`!f x s. f real_continuous (atreal x within s) <=> (f ---> f(x)) (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous] THEN ASM_CASES_TAC `trivial_limit(atreal x within s)` THENL [ASM_REWRITE_TAC[REALLIM]; ASM_SIMP_TAC[NETLIMIT_WITHINREAL]]);; let REAL_CONTINUOUS_ATREAL = prove (`!f x. f real_continuous (atreal x) <=> (f ---> f(x)) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; IN_UNIV]);; let CONTINUOUS_WITHINREAL = prove (`!f x s. f continuous (atreal x within s) <=> (f --> f(x)) (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN ASM_CASES_TAC `trivial_limit(atreal x within s)` THENL [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHINREAL]]);; let CONTINUOUS_ATREAL = prove (`!f x. f continuous (atreal x) <=> (f --> f(x)) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHINREAL; IN_UNIV]);; let real_continuous_within = prove (`f real_continuous (at x within s) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. x' IN s /\ dist(x',x) < d ==> abs(f x' - f x) < e)`, REWRITE_TAC[REAL_CONTINUOUS_WITHIN; REALLIM_WITHIN] THEN REWRITE_TAC[GSYM DIST_NZ] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; let real_continuous_at = prove (`f real_continuous (at x) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. dist(x',x) < d ==> abs(f x' - f x) < e)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[real_continuous_within; IN_UNIV]);; let real_continuous_withinreal = prove (`f real_continuous (atreal x within s) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. x' IN s /\ abs(x' - x) < d ==> abs(f x' - f x) < e)`, REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL] THEN REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; let real_continuous_atreal = prove (`f real_continuous (atreal x) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. abs(x' - x) < d ==> abs(f x' - f x) < e)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[real_continuous_withinreal; IN_UNIV]);; let REAL_CONTINUOUS_AT_WITHIN = prove (`!f s x. f real_continuous (at x) ==> f real_continuous (at x within s)`, REWRITE_TAC[real_continuous_within; real_continuous_at] THEN MESON_TAC[]);; let REAL_CONTINUOUS_ATREAL_WITHINREAL = prove (`!f s x. f real_continuous (atreal x) ==> f real_continuous (atreal x within s)`, REWRITE_TAC[real_continuous_withinreal; real_continuous_atreal] THEN MESON_TAC[]);; let REAL_CONTINUOUS_WITHINREAL_SUBSET = prove (`!f s t. f real_continuous (atreal x within s) /\ t SUBSET s ==> f real_continuous (atreal x within t)`, REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL_SUBSET]);; let REAL_CONTINUOUS_WITHIN_SUBSET = prove (`!f s t. f real_continuous (at x within s) /\ t SUBSET s ==> f real_continuous (at x within t)`, REWRITE_TAC[REAL_CONTINUOUS_WITHIN; REALLIM_WITHIN_SUBSET]);; let CONTINUOUS_WITHINREAL_SUBSET = prove (`!f s t. f continuous (atreal x within s) /\ t SUBSET s ==> f continuous (atreal x within t)`, REWRITE_TAC[CONTINUOUS_WITHINREAL; LIM_WITHINREAL_SUBSET]);; let continuous_withinreal = prove (`f continuous (atreal x within s) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. x' IN s /\ abs(x' - x) < d ==> dist(f x',f x) < e)`, REWRITE_TAC[CONTINUOUS_WITHINREAL; LIM_WITHINREAL] THEN REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `d:real` THEN ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[DIST_REFL]);; let continuous_atreal = prove (`f continuous (atreal x) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. abs(x' - x) < d ==> dist(f x',f x) < e)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[continuous_withinreal; IN_UNIV]);; let CONTINUOUS_ATREAL_WITHINREAL = prove (`!f x s. f continuous (atreal x) ==> f continuous (atreal x within s)`, SIMP_TAC[continuous_atreal; continuous_withinreal] THEN MESON_TAC[]);; let CONTINUOUS_CX_ATREAL = prove (`!x. Cx continuous (atreal x)`, GEN_TAC THEN REWRITE_TAC[continuous_atreal; dist] THEN REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_SUB] THEN MESON_TAC[]);; let CONTINUOUS_CX_WITHINREAL = prove (`!s x. Cx continuous (atreal x within s)`, SIMP_TAC[CONTINUOUS_ATREAL_WITHINREAL; CONTINUOUS_CX_ATREAL]);; let REAL_CONTINUOUS_TRANSFORM_WITHIN = prove (`!f g s:real^N->bool x d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist(x',x) < d ==> f x' = g x') /\ f real_continuous at x within s ==> g real_continuous at x within s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_within] THEN STRIP_TAC THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[DIST_REFL]);; let REAL_CONTINUOUS_TRANSFORM_WITHINREAL = prove (`!f g s x d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ abs(x' - x) < d ==> f x' = g x') /\ f real_continuous atreal x within s ==> g real_continuous atreal x within s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_withinreal] THEN STRIP_TAC THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; let REAL_CONTINUOUS_TRANSFORM_AT = prove (`!f g x:real^N d. &0 < d /\ (!x'. dist(x',x) < d ==> f x' = g x') /\ f real_continuous at x ==> g real_continuous at x`, MP_TAC REAL_CONTINUOUS_TRANSFORM_WITHIN THEN REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(:real^N)`) THEN REWRITE_TAC[IN_UNIV; WITHIN_UNIV]);; let REAL_CONTINUOUS_TRANSFORM_ATREAL = prove (`!f g x d. &0 < d /\ (!x'. abs(x' - x) < d ==> f x' = g x') /\ f real_continuous (atreal x) ==> g real_continuous (atreal x)`, MP_TAC REAL_CONTINUOUS_TRANSFORM_WITHINREAL THEN REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(:real)`) THEN REWRITE_TAC[IN_UNIV; WITHINREAL_UNIV]);; (* ------------------------------------------------------------------------- *) (* Arithmetic combining theorems. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_CONST = prove (`!net c. (\x. c) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_CONST]);; let REAL_CONTINUOUS_LMUL = prove (`!f c net. f real_continuous net ==> (\x. c * f(x)) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_LMUL]);; let REAL_CONTINUOUS_RMUL = prove (`!f c net. f real_continuous net ==> (\x. f(x) * c) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_RMUL]);; let REAL_CONTINUOUS_NEG = prove (`!f net. f real_continuous net ==> (\x. --(f x)) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_NEG]);; let REAL_CONTINUOUS_ADD = prove (`!f g net. f real_continuous net /\ g real_continuous net ==> (\x. f(x) + g(x)) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_ADD]);; let REAL_CONTINUOUS_SUB = prove (`!f g net. f real_continuous net /\ g real_continuous net ==> (\x. f(x) - g(x)) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_SUB]);; let REAL_CONTINUOUS_MUL = prove (`!net f g. f real_continuous net /\ g real_continuous net ==> (\x. f(x) * g(x)) real_continuous net`, SIMP_TAC[real_continuous; REALLIM_MUL]);; let REAL_CONTINUOUS_INV = prove (`!net f. f real_continuous net /\ ~(f(netlimit net) = &0) ==> (\x. inv(f x)) real_continuous net`, SIMP_TAC[real_continuous; REALLIM_INV]);; let REAL_CONTINUOUS_DIV = prove (`!net f g. f real_continuous net /\ g real_continuous net /\ ~(g(netlimit net) = &0) ==> (\x. f(x) / g(x)) real_continuous net`, SIMP_TAC[real_continuous; REALLIM_DIV]);; let REAL_CONTINUOUS_POW = prove (`!net f n. f real_continuous net ==> (\x. f(x) pow n) real_continuous net`, SIMP_TAC[real_continuous; REALLIM_POW]);; let REAL_CONTINUOUS_ABS = prove (`!net f. f real_continuous net ==> (\x. abs(f(x))) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_ABS]);; let REAL_CONTINUOUS_MAX = prove (`!f g net. f real_continuous net /\ g real_continuous net ==> (\x. max (f x) (g x)) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_MAX]);; let REAL_CONTINUOUS_MIN = prove (`!f g net. f real_continuous net /\ g real_continuous net ==> (\x. min (f x) (g x)) real_continuous net`, REWRITE_TAC[real_continuous; REALLIM_MIN]);; (* ------------------------------------------------------------------------- *) (* Some of these without netlimit, but with many different cases. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_WITHIN_ID = prove (`!x s. (\x. x) real_continuous (atreal x within s)`, REWRITE_TAC[real_continuous_withinreal] THEN MESON_TAC[]);; let REAL_CONTINUOUS_AT_ID = prove (`!x. (\x. x) real_continuous (atreal x)`, REWRITE_TAC[real_continuous_atreal] THEN MESON_TAC[]);; let REAL_CONTINUOUS_INV_WITHIN = prove (`!f s a. f real_continuous (at a within s) /\ ~(f a = &0) ==> (\x. inv(f x)) real_continuous (at a within s)`, MESON_TAC[REAL_CONTINUOUS_INV; REAL_CONTINUOUS_TRIVIAL_LIMIT; NETLIMIT_WITHIN]);; let REAL_CONTINUOUS_INV_AT = prove (`!f a. f real_continuous (at a) /\ ~(f a = &0) ==> (\x. inv(f x)) real_continuous (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_INV_WITHIN]);; let REAL_CONTINUOUS_INV_WITHINREAL = prove (`!f s a. f real_continuous (atreal a within s) /\ ~(f a = &0) ==> (\x. inv(f x)) real_continuous (atreal a within s)`, MESON_TAC[REAL_CONTINUOUS_INV; REAL_CONTINUOUS_TRIVIAL_LIMIT; NETLIMIT_WITHINREAL]);; let REAL_CONTINUOUS_INV_ATREAL = prove (`!f a. f real_continuous (atreal a) /\ ~(f a = &0) ==> (\x. inv(f x)) real_continuous (atreal a)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_INV_WITHINREAL]);; let REAL_CONTINUOUS_DIV_WITHIN = prove (`!f s a. f real_continuous (at a within s) /\ g real_continuous (at a within s) /\ ~(g a = &0) ==> (\x. f x / g x) real_continuous (at a within s)`, MESON_TAC[REAL_CONTINUOUS_DIV; REAL_CONTINUOUS_TRIVIAL_LIMIT; NETLIMIT_WITHIN]);; let REAL_CONTINUOUS_DIV_AT = prove (`!f a. f real_continuous (at a) /\ g real_continuous (at a) /\ ~(g a = &0) ==> (\x. f x / g x) real_continuous (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_DIV_WITHIN]);; let REAL_CONTINUOUS_DIV_WITHINREAL = prove (`!f s a. f real_continuous (atreal a within s) /\ g real_continuous (atreal a within s) /\ ~(g a = &0) ==> (\x. f x / g x) real_continuous (atreal a within s)`, MESON_TAC[REAL_CONTINUOUS_DIV; REAL_CONTINUOUS_TRIVIAL_LIMIT; NETLIMIT_WITHINREAL]);; let REAL_CONTINUOUS_DIV_ATREAL = prove (`!f a. f real_continuous (atreal a) /\ g real_continuous (atreal a) /\ ~(g a = &0) ==> (\x. f x / g x) real_continuous (atreal a)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_DIV_WITHINREAL]);; (* ------------------------------------------------------------------------- *) (* Composition of (real->real) o (real->real) functions. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_WITHINREAL_COMPOSE = prove (`!f g x s. f real_continuous (atreal x within s) /\ g real_continuous (atreal (f x) within IMAGE f s) ==> (g o f) real_continuous (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_withinreal; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_ATREAL_COMPOSE = prove (`!f g x. f real_continuous (atreal x) /\ g real_continuous (atreal (f x)) ==> (g o f) real_continuous (atreal x)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_atreal; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Composition of (real->real) o (real^N->real) functions. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_WITHIN_COMPOSE = prove (`!f g x s. f real_continuous (at x within s) /\ g real_continuous (atreal (f x) within IMAGE f s) ==> (g o f) real_continuous (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_withinreal; real_continuous_within; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_AT_COMPOSE = prove (`!f g x. f real_continuous (at x) /\ g real_continuous (atreal (f x) within IMAGE f (:real^N)) ==> (g o f) real_continuous (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Composition of (real^N->real) o (real^M->real^N) functions. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE = prove (`!f g x s. f continuous (at x within s) /\ g real_continuous (at (f x) within IMAGE f s) ==> (g o f) real_continuous (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_within; continuous_within; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE = prove (`!f g x. f continuous (at x) /\ g real_continuous (at (f x) within IMAGE f (:real^N)) ==> (g o f) real_continuous (at x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Composition of (real^N->real) o (real->real^N) functions. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE = prove (`!f g x s. f continuous (atreal x within s) /\ g real_continuous (at (f x) within IMAGE f s) ==> (g o f) real_continuous (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_within; continuous_withinreal; real_continuous_withinreal; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_CONTINUOUS_ATREAL_COMPOSE = prove (`!f g x. f continuous (atreal x) /\ g real_continuous (at (f x) within IMAGE f (:real)) ==> (g o f) real_continuous (atreal x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Composition of (real->real^N) o (real->real) functions. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE = prove (`!f g x s. f real_continuous (atreal x within s) /\ g continuous (atreal (f x) within IMAGE f s) ==> (g o f) continuous (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous_within; continuous_withinreal; real_continuous_withinreal; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let CONTINUOUS_REAL_CONTINUOUS_ATREAL_COMPOSE = prove (`!f g x. f real_continuous (atreal x) /\ g continuous (atreal (f x) within IMAGE f (:real)) ==> (g o f) continuous (atreal x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN REWRITE_TAC[CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Composition of (real^M->real^N) o (real->real^M) functions. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHINREAL_COMPOSE = prove (`!f g x s. f continuous (atreal x within s) /\ g continuous (at (f x) within IMAGE f s) ==> (g o f) continuous (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; continuous_withinreal; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let CONTINUOUS_ATREAL_COMPOSE = prove (`!f g x. f continuous (atreal x) /\ g continuous (at (f x) within IMAGE f (:real)) ==> (g o f) continuous (atreal x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHINREAL_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Composition of (real->real^N) o (real^M->real) functions. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE = prove (`!f g x s. f real_continuous (at x within s) /\ g continuous (atreal (f x) within IMAGE f s) ==> (g o f) continuous (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; real_continuous_within; continuous_withinreal; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE = prove (`!f g x. f real_continuous (at x) /\ g continuous (atreal (f x) within IMAGE f (:real^M)) ==> (g o f) continuous (at x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN REWRITE_TAC[CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Continuity of a real->real function on a set. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("real_continuous_on",(12,"right"));; let real_continuous_on = new_definition `f real_continuous_on s <=> !x. x IN s ==> !e. &0 < e ==> ?d. &0 < d /\ !x'. x' IN s /\ abs(x' - x) < d ==> abs(f(x') - f(x)) < e`;; let REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove (`!f s. f real_continuous_on s <=> !x. x IN s ==> f real_continuous (atreal x within s)`, REWRITE_TAC[real_continuous_on; real_continuous_withinreal]);; let REAL_CONTINUOUS_ON_SUBSET = prove (`!f s t. f real_continuous_on s /\ t SUBSET s ==> f real_continuous_on t`, REWRITE_TAC[real_continuous_on; SUBSET] THEN MESON_TAC[]);; let REAL_CONTINUOUS_ON_COMPOSE = prove (`!f g s. f real_continuous_on s /\ g real_continuous_on (IMAGE f s) ==> (g o f) real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN MESON_TAC[IN_IMAGE; REAL_CONTINUOUS_WITHINREAL_COMPOSE]);; let REAL_CONTINUOUS_ON = prove (`!f s. f real_continuous_on s <=> (lift o f o drop) continuous_on (IMAGE lift s)`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHINREAL; CONTINUOUS_WITHIN; FORALL_IN_IMAGE; REALLIM_WITHINREAL_WITHIN; TENDSTO_REAL] THEN REWRITE_TAC[o_THM; LIFT_DROP]);; let REAL_CONTINUOUS_ON_CONST = prove (`!s c. (\x. c) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_CONST]);; let REAL_CONTINUOUS_ON_ID = prove (`!s. (\x. x) real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_ID]);; let REAL_CONTINUOUS_ON_LMUL = prove (`!f c s. f real_continuous_on s ==> (\x. c * f(x)) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_LMUL]);; let REAL_CONTINUOUS_ON_RMUL = prove (`!f c s. f real_continuous_on s ==> (\x. f(x) * c) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_RMUL]);; let REAL_CONTINUOUS_ON_NEG = prove (`!f s. f real_continuous_on s ==> (\x. --(f x)) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_NEG]);; let REAL_CONTINUOUS_ON_ADD = prove (`!f g s. f real_continuous_on s /\ g real_continuous_on s ==> (\x. f(x) + g(x)) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_ADD]);; let REAL_CONTINUOUS_ON_SUB = prove (`!f g s. f real_continuous_on s /\ g real_continuous_on s ==> (\x. f(x) - g(x)) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_SUB]);; let REAL_CONTINUOUS_ON_MUL = prove (`!f g s. f real_continuous_on s /\ g real_continuous_on s ==> (\x. f(x) * g(x)) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_MUL]);; let REAL_CONTINUOUS_ON_POW = prove (`!f n s. f real_continuous_on s ==> (\x. f(x) pow n) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_POW]);; let REAL_CONTINUOUS_ON_INV = prove (`!f s. f real_continuous_on s /\ (!x. x IN s ==> ~(f x = &0)) ==> (\x. inv(f x)) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_INV_WITHINREAL]);; let REAL_CONTINUOUS_ON_DIV = prove (`!f g s. f real_continuous_on s /\ g real_continuous_on s /\ (!x. x IN s ==> ~(g x = &0)) ==> (\x. f x / g x) real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_DIV_WITHINREAL]);; let REAL_CONTINUOUS_ON_ABS = prove (`!f s. f real_continuous_on s ==> (\x. abs(f x)) real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[REAL_CONTINUOUS_ABS]);; let REAL_CONTINUOUS_ON_EQ = prove (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f real_continuous_on s ==> g real_continuous_on s`, SIMP_TAC[real_continuous_on; IMP_CONJ]);; let REAL_CONTINUOUS_ON_UNION = prove (`!f s t. real_closed s /\ real_closed t /\ f real_continuous_on s /\ f real_continuous_on t ==> f real_continuous_on (s UNION t)`, REWRITE_TAC[REAL_CLOSED; REAL_CONTINUOUS_ON; IMAGE_UNION; CONTINUOUS_ON_UNION]);; let REAL_CONTINUOUS_ON_UNION_OPEN = prove (`!f s t. real_open s /\ real_open t /\ f real_continuous_on s /\ f real_continuous_on t ==> f real_continuous_on (s UNION t)`, REWRITE_TAC[REAL_OPEN; REAL_CONTINUOUS_ON; IMAGE_UNION; CONTINUOUS_ON_UNION_OPEN]);; let REAL_CONTINUOUS_ON_CASES = prove (`!P f g s t. real_closed s /\ real_closed t /\ f real_continuous_on s /\ g real_continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) real_continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_ON_CASES_OPEN = prove (`!P f g s t. real_open s /\ real_open t /\ f real_continuous_on s /\ g real_continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) real_continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_UNION_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_SUM = prove (`!net f s. FINITE s /\ (!a. a IN s ==> f a real_continuous net) ==> (\x. sum s (\a. f a x)) real_continuous net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; SUM_CLAUSES; REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_ADD; ETA_AX]);; let REAL_CONTINUOUS_PRODUCT = prove (`!net f s. FINITE s /\ (!a. a IN s ==> f a real_continuous net) ==> (\x. product s (\a. f a x)) real_continuous net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; PRODUCT_CLAUSES; REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_MUL; ETA_AX]);; let REAL_CONTINUOUS_ON_SUM = prove (`!t f s. FINITE s /\ (!a. a IN s ==> f a real_continuous_on t) ==> (\x. sum s (\a. f a x)) real_continuous_on t`, REPEAT GEN_TAC THEN SIMP_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_SUM] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_VSUM) THEN REWRITE_TAC[]);; let REAL_CONTINUOUS_ON_PRODUCT = prove (`!t f s. FINITE s /\ (!a. a IN s ==> f a real_continuous_on t) ==> (\x. product s (\a. f a x)) real_continuous_on t`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; PRODUCT_CLAUSES; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_MUL; ETA_AX]);; let REALLIM_CONTINUOUS_FUNCTION = prove (`!f net g l. f continuous (atreal l) /\ (g ---> l) net ==> ((\x. f(g x)) --> f l) net`, REWRITE_TAC[tendsto_real; tendsto; continuous_atreal; eventually] THEN MESON_TAC[]);; let LIM_REAL_CONTINUOUS_FUNCTION = prove (`!f net g l. f real_continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) ---> f l) net`, REWRITE_TAC[tendsto_real; tendsto; real_continuous_at; eventually] THEN MESON_TAC[]);; let REALLIM_REAL_CONTINUOUS_FUNCTION = prove (`!f net g l. f real_continuous (atreal l) /\ (g ---> l) net ==> ((\x. f(g x)) ---> f l) net`, REWRITE_TAC[tendsto_real; real_continuous_atreal; eventually] THEN MESON_TAC[]);; let REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT = prove (`!f s. real_open s ==> (f real_continuous_on s <=> !x. x IN s ==> f real_continuous atreal x)`, SIMP_TAC[REAL_CONTINUOUS_ATREAL; REAL_CONTINUOUS_WITHINREAL; REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REALLIM_WITHIN_REAL_OPEN]);; let REAL_CONTINUOUS_ATTAINS_SUP = prove (`!f s. real_compact s /\ ~(s = {}) /\ f real_continuous_on s ==> ?x. x IN s /\ (!y. y IN s ==> f y <= f x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`] CONTINUOUS_ATTAINS_SUP) THEN ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM real_compact] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_THM; LIFT_DROP]);; let REAL_CONTINUOUS_ATTAINS_INF = prove (`!f s. real_compact s /\ ~(s = {}) /\ f real_continuous_on s ==> ?x. x IN s /\ (!y. y IN s ==> f x <= f y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`] CONTINUOUS_ATTAINS_INF) THEN ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM real_compact] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_THM; LIFT_DROP]);; (* ------------------------------------------------------------------------- *) (* Real version of uniform continuity. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("real_uniformly_continuous_on",(12,"right"));; let real_uniformly_continuous_on = new_definition `f real_uniformly_continuous_on s <=> !e. &0 < e ==> ?d. &0 < d /\ !x x'. x IN s /\ x' IN s /\ abs(x' - x) < d ==> abs(f x' - f x) < e`;; let REAL_UNIFORMLY_CONTINUOUS_ON = prove (`!f s. f real_uniformly_continuous_on s <=> (lift o f o drop) uniformly_continuous_on (IMAGE lift s)`, REWRITE_TAC[real_uniformly_continuous_on; uniformly_continuous_on] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_THM; DIST_LIFT; LIFT_DROP]);; let REAL_UNIFORMLY_CONTINUOUS_IMP_REAL_CONTINUOUS = prove (`!f s. f real_uniformly_continuous_on s ==> f real_continuous_on s`, REWRITE_TAC[real_uniformly_continuous_on; real_continuous_on] THEN MESON_TAC[]);; let REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY = prove (`!f s. f real_uniformly_continuous_on s <=> !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\ ((\n. x(n) - y(n)) ---> &0) sequentially ==> ((\n. f(x(n)) - f(y(n))) ---> &0) sequentially`, REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; REAL_TENDSTO] THEN REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP; DROP_SUB; DROP_VEC] THEN REWRITE_TAC[FORALL_LIFT_FUN; o_THM; LIFT_DROP]);; let REAL_UNIFORMLY_CONTINUOUS_ON_SUBSET = prove (`!f s t. f real_uniformly_continuous_on s /\ t SUBSET s ==> f real_uniformly_continuous_on t`, REWRITE_TAC[real_uniformly_continuous_on; SUBSET] THEN MESON_TAC[]);; let REAL_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove (`!f g s. f real_uniformly_continuous_on s /\ g real_uniformly_continuous_on (IMAGE f s) ==> (g o f) real_uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN SUBGOAL_THEN `IMAGE lift (IMAGE f s) = IMAGE (lift o f o drop) (IMAGE lift s)` SUBST1_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_ON_COMPOSE)] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP]);; let REAL_UNIFORMLY_CONTINUOUS_ON_CONST = prove (`!s c. (\x. c) real_uniformly_continuous_on s`, REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF; REAL_SUB_REFL; REALLIM_CONST]);; let REAL_UNIFORMLY_CONTINUOUS_ON_LMUL = prove (`!f c s. f real_uniformly_continuous_on s ==> (\x. c * f(x)) real_uniformly_continuous_on s`, REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN REWRITE_TAC[o_DEF; LIFT_CMUL; UNIFORMLY_CONTINUOUS_ON_CMUL]);; let REAL_UNIFORMLY_CONTINUOUS_ON_RMUL = prove (`!f c s. f real_uniformly_continuous_on s ==> (\x. f(x) * c) real_uniformly_continuous_on s`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_LMUL]);; let REAL_UNIFORMLY_CONTINUOUS_ON_ID = prove (`!s. (\x. x) real_uniformly_continuous_on s`, REWRITE_TAC[real_uniformly_continuous_on] THEN MESON_TAC[]);; let REAL_UNIFORMLY_CONTINUOUS_ON_NEG = prove (`!f s. f real_uniformly_continuous_on s ==> (\x. --(f x)) real_uniformly_continuous_on s`, ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_LMUL]);; let REAL_UNIFORMLY_CONTINUOUS_ON_ADD = prove (`!f g s. f real_uniformly_continuous_on s /\ g real_uniformly_continuous_on s ==> (\x. f(x) + g(x)) real_uniformly_continuous_on s`, REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_ADD] THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_ADD]);; let REAL_UNIFORMLY_CONTINUOUS_ON_SUB = prove (`!f g s. f real_uniformly_continuous_on s /\ g real_uniformly_continuous_on s ==> (\x. f(x) - g(x)) real_uniformly_continuous_on s`, REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_SUB] THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SUB]);; let REAL_UNIFORMLY_CONTINUOUS_ON_SUM = prove (`!t f s. FINITE s /\ (!a. a IN s ==> f a real_uniformly_continuous_on t) ==> (\x. sum s (\a. f a x)) real_uniformly_continuous_on t`, REPEAT GEN_TAC THEN SIMP_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_SUM] THEN DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_ON_VSUM) THEN REWRITE_TAC[]);; let REAL_COMPACT_UNIFORMLY_CONTINUOUS = prove (`!f s. f real_continuous_on s /\ real_compact s ==> f real_uniformly_continuous_on s`, REWRITE_TAC[real_compact; REAL_CONTINUOUS_ON; REAL_UNIFORMLY_CONTINUOUS_ON; COMPACT_UNIFORMLY_CONTINUOUS]);; let REAL_COMPACT_CONTINUOUS_IMAGE = prove (`!f s. f real_continuous_on s /\ real_compact s ==> real_compact (IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_compact; REAL_CONTINUOUS_ON] THEN DISCH_THEN(MP_TAC o MATCH_MP COMPACT_CONTINUOUS_IMAGE) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP]);; let REAL_DINI = prove (`!f g s. real_compact s /\ (!n. (f n) real_continuous_on s) /\ g real_continuous_on s /\ (!x. x IN s ==> ((\n. (f n x)) ---> g x) sequentially) /\ (!n x. x IN s ==> f n x <= f (n + 1) x) ==> !e. &0 < e ==> eventually (\n. !x. x IN s ==> abs(f n x - g x) < e) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\n:num. lift o f n o drop`; `lift o g o drop`; `IMAGE lift s`] DINI) THEN ASM_REWRITE_TAC[GSYM real_compact; GSYM REAL_CONTINUOUS_ON] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; REAL_TENDSTO] THEN ASM_SIMP_TAC[GSYM LIFT_SUB; NORM_LIFT]);; (* ------------------------------------------------------------------------- *) (* Continuity versus componentwise continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_COMPONENTWISE = prove (`!net f:A->real^N. f continuous net <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. (f x)$i) real_continuous net`, REWRITE_TAC[real_continuous; continuous; LIM_COMPONENTWISE]);; let REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT = prove (`!z. Re real_continuous (at z) /\ Im real_continuous (at z)`, GEN_TAC THEN MP_TAC(ISPECL [`at(z:complex)`; `\z:complex. z`] CONTINUOUS_COMPONENTWISE) THEN REWRITE_TAC[CONTINUOUS_AT_ID; DIMINDEX_2; FORALL_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; ETA_AX]);; let REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN = prove (`!s z. Re real_continuous (at z within s) /\ Im real_continuous (at z within s)`, MESON_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; REAL_CONTINUOUS_AT_WITHIN]);; let REAL_CONTINUOUS_NORM_AT = prove (`!z. norm real_continuous (at z)`, REWRITE_TAC[real_continuous_at; dist] THEN GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let REAL_CONTINUOUS_NORM_WITHIN = prove (`!s z. norm real_continuous (at z within s)`, MESON_TAC[REAL_CONTINUOUS_NORM_AT; REAL_CONTINUOUS_AT_WITHIN]);; let REAL_CONTINUOUS_DIST_AT = prove (`!a z. (\x. dist(a,x)) real_continuous (at z)`, REWRITE_TAC[real_continuous_at; dist] THEN GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let REAL_CONTINUOUS_DIST_WITHIN = prove (`!a s z. (\x. dist(a,x)) real_continuous (at z within s)`, MESON_TAC[REAL_CONTINUOUS_DIST_AT; REAL_CONTINUOUS_AT_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Derivative of real->real function. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("has_real_derivative",(12,"right"));; parse_as_infix ("real_differentiable",(12,"right"));; parse_as_infix ("real_differentiable_on",(12,"right"));; let has_real_derivative = new_definition `(f has_real_derivative f') net <=> ((\x. inv(x - netlimit net) * (f x - (f(netlimit net) + f' * (x - netlimit net)))) ---> &0) net`;; let real_differentiable = new_definition `f real_differentiable net <=> ?f'. (f has_real_derivative f') net`;; let real_derivative = new_definition `real_derivative f x = @f'. (f has_real_derivative f') (atreal x)`;; let higher_real_derivative = define `higher_real_derivative 0 f = f /\ (!n. higher_real_derivative (SUC n) f = real_derivative (higher_real_derivative n f))`;; let real_differentiable_on = new_definition `f real_differentiable_on s <=> !x. x IN s ==> ?f'. (f has_real_derivative f') (atreal x within s)`;; (* ------------------------------------------------------------------------- *) (* Basic limit definitions in the useful cases. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_WITHINREAL = prove (`(f has_real_derivative f') (atreal a within s) <=> ((\x. (f x - f a) / (x - a)) ---> f') (atreal a within s)`, REWRITE_TAC[has_real_derivative] THEN ASM_CASES_TAC `trivial_limit(atreal a within s)` THENL [ASM_REWRITE_TAC[REALLIM]; ALL_TAC] THEN ASM_SIMP_TAC[NETLIMIT_WITHINREAL] THEN GEN_REWRITE_TAC RAND_CONV [REALLIM_NULL] THEN REWRITE_TAC[REALLIM_WITHINREAL; REAL_SUB_RZERO] THEN SIMP_TAC[REAL_FIELD `&0 < abs(x - a) ==> (fy - fa) / (x - a) - f' = inv(x - a) * (fy - (fa + f' * (x - a)))`]);; let HAS_REAL_DERIVATIVE_ATREAL = prove (`(f has_real_derivative f') (atreal a) <=> ((\x. (f x - f a) / (x - a)) ---> f') (atreal a)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL]);; (* ------------------------------------------------------------------------- *) (* Relation to Frechet derivative. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_FRECHET_DERIVATIVE_WITHIN = prove (`(f has_real_derivative f') (atreal x within s) <=> ((lift o f o drop) has_derivative (\x. f' % x)) (at (lift x) within (IMAGE lift s))`, REWRITE_TAC[has_derivative_within; HAS_REAL_DERIVATIVE_WITHINREAL] THEN REWRITE_TAC[o_THM; LIFT_DROP; LIM_WITHIN; REALLIM_WITHINREAL] THEN SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_IMAGE; DIST_LIFT; GSYM LIFT_SUB; LIFT_DROP; NORM_ARITH `dist(x,vec 0) = norm x`; GSYM LIFT_CMUL; GSYM LIFT_ADD; NORM_LIFT] THEN SIMP_TAC[REAL_FIELD `&0 < abs(y - x) ==> fy - (fx + f' * (y - x)) = (y - x) * ((fy - fx) / (y - x) - f')`] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_ASSOC; REAL_ABS_INV; REAL_ABS_ABS] THEN SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV; REAL_MUL_LID]);; let HAS_REAL_FRECHET_DERIVATIVE_AT = prove (`(f has_real_derivative f') (atreal x) <=> ((lift o f o drop) has_derivative (\x. f' % x)) (at (lift x))`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV; GSYM WITHIN_UNIV] THEN REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN REWRITE_TAC[IMAGE_LIFT_UNIV]);; let HAS_REAL_VECTOR_DERIVATIVE_WITHIN = prove (`(f has_real_derivative f') (atreal x within s) <=> ((lift o f o drop) has_vector_derivative (lift f')) (at (lift x) within (IMAGE lift s))`, REWRITE_TAC[has_vector_derivative; HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; GSYM LIFT_CMUL] THEN REWRITE_TAC[LIFT_DROP; LIFT_EQ; REAL_MUL_SYM]);; let HAS_REAL_VECTOR_DERIVATIVE_AT = prove (`(f has_real_derivative f') (atreal x) <=> ((lift o f o drop) has_vector_derivative (lift f')) (at (lift x))`, REWRITE_TAC[has_vector_derivative; HAS_REAL_FRECHET_DERIVATIVE_AT] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; GSYM LIFT_CMUL] THEN REWRITE_TAC[LIFT_DROP; LIFT_EQ; REAL_MUL_SYM]);; let REAL_DIFFERENTIABLE_AT = prove (`!f a. f real_differentiable (atreal x) <=> (lift o f o drop) differentiable (at(lift x))`, REWRITE_TAC[real_differentiable; HAS_REAL_FRECHET_DERIVATIVE_AT] THEN REWRITE_TAC[differentiable; has_derivative; LINEAR_SCALING] THEN REWRITE_TAC[LINEAR_1; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2]);; let REAL_DIFFERENTIABLE_WITHIN = prove (`!f a s. f real_differentiable (atreal x within s) <=> (lift o f o drop) differentiable (at(lift x) within IMAGE lift s)`, REWRITE_TAC[real_differentiable; HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN REWRITE_TAC[differentiable; has_derivative; LINEAR_SCALING] THEN REWRITE_TAC[LINEAR_1; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2]);; (* ------------------------------------------------------------------------- *) (* Relation to complex derivative. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_COMPLEX_DERIVATIVE_WITHIN = prove (`(f has_real_derivative f') (atreal a within s) <=> ((Cx o f o Re) has_complex_derivative (Cx f')) (at (Cx a) within {z | real z /\ Re z IN s})`, REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_COMPLEX_DERIVATIVE_WITHIN; LIM_WITHIN; IN_ELIM_THM; IMP_CONJ; FORALL_REAL] THEN REWRITE_TAC[RE_CX; dist; GSYM CX_SUB; COMPLEX_NORM_CX; o_THM; GSYM CX_DIV; REALLIM_WITHINREAL] THEN MESON_TAC[]);; let HAS_REAL_COMPLEX_DERIVATIVE_AT = prove (`(f has_real_derivative f') (atreal a) <=> ((Cx o f o Re) has_complex_derivative (Cx f')) (at (Cx a) within real)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; let REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE = prove (`!f s. f real_differentiable_on s <=> !x. x IN s ==> f real_differentiable (atreal x within s)`, REWRITE_TAC[real_differentiable_on; real_differentiable]);; let REAL_DIFFERENTIABLE_ON_REAL_OPEN = prove (`!f s. real_open s ==> (f real_differentiable_on s <=> !x. x IN s ==> ?f'. (f has_real_derivative f') (atreal x))`, REWRITE_TAC[real_differentiable_on; HAS_REAL_DERIVATIVE_WITHINREAL; HAS_REAL_DERIVATIVE_ATREAL] THEN SIMP_TAC[REALLIM_WITHIN_REAL_OPEN]);; let REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_WITHIN = prove (`!f s x. f real_differentiable_on s /\ x IN s ==> f real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE]);; let REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_ATREAL = prove (`!f s x. f real_differentiable_on s /\ real_open s /\ x IN s ==> f real_differentiable (atreal x)`, MESON_TAC[REAL_DIFFERENTIABLE_ON_REAL_OPEN; real_differentiable]);; let HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN = prove (`!f g h s d. &0 < d /\ x IN s /\ (h has_complex_derivative Cx(g)) (at (Cx x) within {z | real z /\ Re(z) IN s}) /\ (!y. y IN s /\ abs(y - x) < d ==> h(Cx y) = Cx(f y)) ==> (f has_real_derivative g) (atreal x within s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`h:complex->complex`; `d:real`] THEN ASM_REWRITE_TAC[IN_ELIM_THM; o_THM; REAL_CX; RE_CX; dist] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `Re w`) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM CX_SUB; COMPLEX_NORM_CX]) THEN ASM_REWRITE_TAC[RE_CX]);; let HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN = prove (`!f g h d. &0 < d /\ (h has_complex_derivative Cx(g)) (at (Cx x) within real) /\ (!y. abs(y - x) < d ==> h(Cx y) = Cx(f y)) ==> (f has_real_derivative g) (atreal x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN THEN MAP_EVERY EXISTS_TAC [`h:complex->complex`; `d:real`] THEN ASM_REWRITE_TAC[IN_UNIV; ETA_AX; SET_RULE `{x | r x} = r`]);; let HAS_COMPLEX_REAL_DERIVATIVE_WITHIN = prove (`!f g h s. x IN s /\ (h has_complex_derivative Cx(g)) (at (Cx x) within {z | real z /\ Re(z) IN s}) /\ (!y. y IN s ==> h(Cx y) = Cx(f y)) ==> (f has_real_derivative g) (atreal x within s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN THEN MAP_EVERY EXISTS_TAC [`h:complex->complex`; `&1`] THEN ASM_SIMP_TAC[REAL_LT_01]);; let HAS_COMPLEX_REAL_DERIVATIVE_AT = prove (`!f g h. (h has_complex_derivative Cx(g)) (at (Cx x) within real) /\ (!y. h(Cx y) = Cx(f y)) ==> (f has_real_derivative g) (atreal x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN THEN EXISTS_TAC `h:complex->complex` THEN ASM_REWRITE_TAC[IN_UNIV; ETA_AX; SET_RULE `{x | r x} = r`]);; let HAS_REAL_DERIVATIVE_FROM_COMPLEX_AT = prove (`!f f' x. (f has_complex_derivative f') (at (Cx x)) /\ (!z. real z ==> real(f z)) ==> ((Re o f o Cx) has_real_derivative (Re f')) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN EXISTS_TAC `f:complex->complex` THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL; REAL_CX; RE_CX]] THEN FIRST_X_ASSUM(ASSUME_TAC o SPEC `real` o MATCH_MP HAS_COMPLEX_DERIVATIVE_AT_WITHIN) THEN SUBGOAL_THEN `real f'` (fun th -> ASM_MESON_TAC[REAL; th]) THEN MATCH_MP_TAC(ISPEC `at (Cx x) within real` REAL_LIM) THEN EXISTS_TAC `\y. ((f:complex->complex) y - f (Cx x)) / (y - Cx x)` THEN ASM_REWRITE_TAC[GSYM HAS_COMPLEX_DERIVATIVE_WITHIN] THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN_REAL; REAL_CX] THEN REWRITE_TAC[WITHIN; AT] THEN REWRITE_TAC[SET_RULE `p /\ x IN real <=> real x /\ p`] THEN SIMP_TAC[REAL_EXISTS; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN ASM_SIMP_TAC[GSYM REAL_EXISTS; GSYM CX_SUB; GSYM CX_DIV; REAL_CX; REAL_DIV; REAL_SUB] THEN REPEAT(EXISTS_TAC `Cx(x + &1)`) THEN REWRITE_TAC[REAL_LE_REFL; REAL_CX; DIST_CX] THEN REAL_ARITH_TAC);; let REAL_DIFFERENTIABLE_FROM_COMPLEX_AT = prove (`!f x. f complex_differentiable at (Cx x) /\ (!z. real z ==> real(f z)) ==> (Re o f o Cx) real_differentiable (atreal x)`, REWRITE_TAC[complex_differentiable; real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_FROM_COMPLEX_AT]);; (* ------------------------------------------------------------------------- *) (* Caratheodory characterization. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL = prove (`!f f' z. (f has_real_derivative f') (atreal z) <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g real_continuous atreal z /\ g(z) = f'`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_RING `w' - z':real = a <=> w' = z' + a`] THEN SIMP_TAC[GSYM FUN_EQ_THM; HAS_REAL_DERIVATIVE_ATREAL; REAL_CONTINUOUS_ATREAL] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `\w. if w = z then f':real else (f(w) - f(z)) / (w - z)` THEN ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; REAL_SUB_REFL] THEN CONV_TAC REAL_FIELD; FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN ASM_SIMP_TAC[REAL_RING `(z + a) - (z + b * (w - w)):real = a`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REALLIM_TRANSFORM)) THEN SIMP_TAC[REALLIM_CONST; REAL_FIELD `~(w = z) ==> x - (x * (w - z)) / (w - z) = &0`]]);; let HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL = prove (`!f f' z s. (f has_real_derivative f') (atreal z within s) <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g real_continuous (atreal z within s) /\ g(z) = f'`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_RING `w' - z':real = a <=> w' = z' + a`] THEN SIMP_TAC[GSYM FUN_EQ_THM; HAS_REAL_DERIVATIVE_WITHINREAL; REAL_CONTINUOUS_WITHINREAL] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `\w. if w = z then f':real else (f(w) - f(z)) / (w - z)` THEN ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; REAL_SUB_REFL] THEN CONV_TAC REAL_FIELD; FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN ASM_SIMP_TAC[REAL_RING `(z + a) - (z + b * (w - w)):real = a`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REALLIM_TRANSFORM)) THEN SIMP_TAC[REALLIM_CONST; REAL_FIELD `~(w = z) ==> x - (x * (w - z)) / (w - z) = &0`]]);; let REAL_DIFFERENTIABLE_CARATHEODORY_ATREAL = prove (`!f z. f real_differentiable atreal z <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g real_continuous atreal z`, SIMP_TAC[real_differentiable; HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL] THEN MESON_TAC[]);; let REAL_DIFFERENTIABLE_CARATHEODORY_WITHINREAL = prove (`!f z s. f real_differentiable (atreal z within s) <=> ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g real_continuous (atreal z within s)`, SIMP_TAC[real_differentiable; HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Property of being an interval (equivalent to convex or connected). *) (* ------------------------------------------------------------------------- *) let is_realinterval = new_definition `is_realinterval s <=> !a b c. a IN s /\ b IN s /\ a <= c /\ c <= b ==> c IN s`;; let IS_REALINTERVAL_IS_INTERVAL = prove (`!s. is_realinterval s <=> is_interval(IMAGE lift s)`, REWRITE_TAC[IS_INTERVAL_1; is_realinterval] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[LIFT_DROP; IN_IMAGE; EXISTS_DROP; UNWIND_THM1] THEN REWRITE_TAC[GSYM FORALL_DROP]);; let IS_REALINTERVAL_CONVEX = prove (`!s. is_realinterval s <=> convex(IMAGE lift s)`, REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_CONVEX_1]);; let IS_REALINTERVAL_CONNECTED = prove (`!s. is_realinterval s <=> connected(IMAGE lift s)`, REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_CONNECTED_1]);; let TRIVIAL_LIMIT_WITHIN_REALINTERVAL = prove (`!s x. is_realinterval s /\ x IN s ==> (trivial_limit(atreal x within s) <=> s = {x})`, REWRITE_TAC[TRIVIAL_LIMIT_WITHINREAL_WITHIN; IS_REALINTERVAL_CONVEX] THEN REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN SIMP_TAC[TRIVIAL_LIMIT_WITHIN_CONVEX] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_SING] THEN MESON_TAC[LIFT_DROP]);; let IS_REALINTERVAL_EMPTY = prove (`is_realinterval {}`, REWRITE_TAC[is_realinterval; NOT_IN_EMPTY]);; let IS_REALINTERVAL_UNION = prove (`!s t. is_realinterval s /\ is_realinterval t /\ ~(s INTER t = {}) ==> is_realinterval(s UNION t)`, REWRITE_TAC[is_realinterval; IN_UNION; IN_INTER; NOT_IN_EMPTY; EXTENSION] THEN MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]);; let IS_REALINTERVAL_UNIV = prove (`is_realinterval (:real)`, REWRITE_TAC[is_realinterval; IN_UNIV]);; let IS_REAL_INTERVAL_CASES = prove (`!s. is_realinterval s <=> s = {} \/ s = (:real) \/ (?a. s = {x | a < x}) \/ (?a. s = {x | a <= x}) \/ (?b. s = {x | x <= b}) \/ (?b. s = {x | x < b}) \/ (?a b. s = {x | a < x /\ x < b}) \/ (?a b. s = {x | a < x /\ x <= b}) \/ (?a b. s = {x | a <= x /\ x < b}) \/ (?a b. s = {x | a <= x /\ x <= b})`, REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_1_CASES] THEN REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_ELIM_THM] THEN REWRITE_TAC[GSYM FORALL_DROP; IN_UNIV; NOT_IN_EMPTY]);; let IS_REALINTERVAL_CLAUSES = prove (`is_realinterval {} /\ is_realinterval (:real) /\ (!a. is_realinterval {x | a < x}) /\ (!a. is_realinterval {x | a <= x}) /\ (!b. is_realinterval {x | x < b}) /\ (!b. is_realinterval {x | x <= b}) /\ (!a b. is_realinterval {x | a < x /\ x < b}) /\ (!a b. is_realinterval {x | a < x /\ x <= b}) /\ (!a b. is_realinterval {x | a <= x /\ x < b}) /\ (!a b. is_realinterval {x | a <= x /\ x <= b})`, REWRITE_TAC[is_realinterval; IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let REAL_CONVEX = prove (`!s. is_realinterval s <=> !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> (u * x + v * y) IN s`, REWRITE_TAC[IS_REALINTERVAL_CONVEX; convex] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE_LIFT_DROP; DROP_ADD; DROP_CMUL; LIFT_DROP]);; let REAL_CONVEX_ALT = prove (`!s. is_realinterval s <=> !x y u. x IN s /\ y IN s /\ &0 <= u /\ u <= &1 ==> ((&1 - u) * x + u * y) IN s`, REWRITE_TAC[IS_REALINTERVAL_CONVEX; CONVEX_ALT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE_LIFT_DROP; DROP_ADD; DROP_CMUL; LIFT_DROP]);; let REAL_MIDPOINT_IN_CONVEX = prove (`!s x y. is_realinterval s /\ x IN s /\ y IN s ==> ((x + y) / &2) IN s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(x + y) / &2 = inv(&2) * x + inv(&2) * y`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [REAL_CONVEX]) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some relations with the complex numbers can also be useful. *) (* ------------------------------------------------------------------------- *) let IS_REALINTERVAL_CONVEX_COMPLEX = prove (`!s. is_realinterval s <=> convex {z | real z /\ Re z IN s}`, GEN_TAC THEN REWRITE_TAC[GSYM IMAGE_CX; IS_REALINTERVAL_CONVEX] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o ISPEC `Cx o drop` o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONVEX_LINEAR_IMAGE)) THEN REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[IMAGE_o] THEN REWRITE_TAC[IMAGE_LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[linear; o_THM; CX_ADD; CX_MUL; DROP_ADD; DROP_CMUL; COMPLEX_CMUL]; DISCH_THEN(MP_TAC o ISPEC `lift o Re` o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONVEX_LINEAR_IMAGE)) THEN REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[IMAGE_o] THEN REWRITE_TAC[o_DEF; RE_CX; SET_RULE `IMAGE (\x. x) s = s`] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[linear; o_THM; RE_CMUL; RE_ADD; RE_MUL_CX; LIFT_ADD; LIFT_CMUL]]);; (* ------------------------------------------------------------------------- *) (* The same tricks to define closed and open intervals. *) (* ------------------------------------------------------------------------- *) let open_real_interval = new_definition `open_real_interval(a:real,b:real) = {x:real | a < x /\ x < b}`;; let closed_real_interval = define `closed_real_interval[a:real,b:real] = {x:real | a <= x /\ x <= b}`;; make_overloadable "real_interval" `:A`;; overload_interface("real_interval",`open_real_interval`);; overload_interface("real_interval",`closed_real_interval`);; let real_interval = prove (`real_interval(a,b) = {x | a < x /\ x < b} /\ real_interval[a,b] = {x | a <= x /\ x <= b}`, REWRITE_TAC[open_real_interval; closed_real_interval]);; let IN_REAL_INTERVAL = prove (`!a b x. (x IN real_interval[a,b] <=> a <= x /\ x <= b) /\ (x IN real_interval(a,b) <=> a < x /\ x < b)`, REWRITE_TAC[real_interval; IN_ELIM_THM]);; let REAL_INTERVAL_INTERVAL = prove (`real_interval[a,b] = IMAGE drop (interval[lift a,lift b]) /\ real_interval(a,b) = IMAGE drop (interval(lift a,lift b))`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; UNWIND_THM1]);; let INTERVAL_REAL_INTERVAL = prove (`interval[a,b] = IMAGE lift (real_interval[drop a,drop b]) /\ interval(a,b) = IMAGE lift (real_interval(drop a,drop b))`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN REWRITE_TAC[EXISTS_DROP; LIFT_DROP; UNWIND_THM1]);; let DROP_IN_REAL_INTERVAL = prove (`(!a b x. drop x IN real_interval[a,b] <=> x IN interval[lift a,lift b]) /\ (!a b x. drop x IN real_interval(a,b) <=> x IN interval(lift a,lift b))`, REWRITE_TAC[REAL_INTERVAL_INTERVAL; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; let LIFT_IN_INTERVAL = prove (`(!a b x. lift x IN interval[a,b] <=> x IN real_interval[drop a,drop b]) /\ (!a b x. lift x IN interval(a,b) <=> x IN real_interval(drop a,drop b))`, REWRITE_TAC[FORALL_DROP; DROP_IN_REAL_INTERVAL; LIFT_DROP]);; let EMPTY_AS_REAL_INTERVAL = prove (`{} = real_interval[&1,&0]`, REWRITE_TAC[REAL_INTERVAL_INTERVAL; LIFT_NUM; GSYM EMPTY_AS_INTERVAL] THEN REWRITE_TAC[IMAGE_CLAUSES]);; let IMAGE_LIFT_REAL_INTERVAL = prove (`IMAGE lift (real_interval[a,b]) = interval[lift a,lift b] /\ IMAGE lift (real_interval(a,b)) = interval(lift a,lift b)`, REWRITE_TAC[REAL_INTERVAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN SET_TAC[]);; let IMAGE_DROP_INTERVAL = prove (`IMAGE drop (interval[a,b]) = real_interval[drop a,drop b] /\ IMAGE drop (interval(a,b)) = real_interval(drop a,drop b)`, REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN SET_TAC[]);; let SUBSET_REAL_INTERVAL = prove (`!a b c d. (real_interval[a,b] SUBSET real_interval[c,d] <=> b < a \/ c <= a /\ a <= b /\ b <= d) /\ (real_interval[a,b] SUBSET real_interval(c,d) <=> b < a \/ c < a /\ a <= b /\ b < d) /\ (real_interval(a,b) SUBSET real_interval[c,d] <=> b <= a \/ c <= a /\ a < b /\ b <= d) /\ (real_interval(a,b) SUBSET real_interval(c,d) <=> b <= a \/ c <= a /\ a < b /\ b <= d)`, let lemma = prove (`IMAGE drop s SUBSET IMAGE drop t <=> s SUBSET t`, SET_TAC[LIFT_DROP]) in REWRITE_TAC[REAL_INTERVAL_INTERVAL; lemma; SUBSET_INTERVAL_1] THEN REWRITE_TAC[LIFT_DROP]);; let REAL_INTERVAL_OPEN_SUBSET_CLOSED = prove (`!a b. real_interval(a,b) SUBSET real_interval[a,b]`, REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; let REAL_INTERVAL_EQ_EMPTY = prove (`(!a b. real_interval[a,b] = {} <=> b < a) /\ (!a b. real_interval(a,b) = {} <=> b <= a)`, REWRITE_TAC[REAL_INTERVAL_INTERVAL; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; LIFT_DROP]);; let REAL_INTERVAL_NE_EMPTY = prove (`(!a b. ~(real_interval[a,b] = {}) <=> a <= b) /\ (!a b. ~(real_interval(a,b) = {}) <=> a < b)`, REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT]);; let REAL_OPEN_CLOSED_INTERVAL = prove (`!a b. real_interval(a,b) = real_interval[a,b] DIFF {a,b}`, SIMP_TAC[EXTENSION; IN_DIFF; IN_REAL_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let REAL_CLOSED_OPEN_INTERVAL = prove (`!a b. a <= b ==> real_interval[a,b] = real_interval(a,b) UNION {a,b}`, SIMP_TAC[EXTENSION; IN_UNION; IN_REAL_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let REAL_CLOSED_REAL_INTERVAL = prove (`!a b. real_closed(real_interval[a,b])`, REWRITE_TAC[REAL_CLOSED; IMAGE_LIFT_REAL_INTERVAL; CLOSED_INTERVAL]);; let REAL_OPEN_REAL_INTERVAL = prove (`!a b. real_open(real_interval(a,b))`, REWRITE_TAC[REAL_OPEN; IMAGE_LIFT_REAL_INTERVAL; OPEN_INTERVAL]);; let REAL_INTERVAL_SING = prove (`!a. real_interval[a,a] = {a} /\ real_interval(a,a) = {}`, REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; let REAL_COMPACT_INTERVAL = prove (`!a b. real_compact(real_interval[a,b])`, REWRITE_TAC[REAL_INTERVAL_INTERVAL; real_compact] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID; COMPACT_INTERVAL]);; let IS_REALINTERVAL_INTERVAL = prove (`!a b. is_realinterval(real_interval(a,b)) /\ is_realinterval(real_interval[a,b])`, REWRITE_TAC[is_realinterval; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; let REAL_BOUNDED_REAL_INTERVAL = prove (`(!a b. real_bounded(real_interval[a,b])) /\ (!a b. real_bounded(real_interval(a,b)))`, REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; REAL_BOUNDED; BOUNDED_INTERVAL]);; let ENDS_IN_REAL_INTERVAL = prove (`(!a b. a IN real_interval[a,b] <=> ~(real_interval[a,b] = {})) /\ (!a b. b IN real_interval[a,b] <=> ~(real_interval[a,b] = {})) /\ (!a b. ~(a IN real_interval(a,b))) /\ (!a b. ~(b IN real_interval(a,b)))`, REWRITE_TAC[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN REAL_ARITH_TAC);; let IMAGE_AFFINITY_REAL_INTERVAL = prove (`!a b m c. IMAGE (\x. m * x + c) (real_interval[a,b]) = (if real_interval[a,b] = {} then {} else if &0 <= m then real_interval[m * a + c,m * b + c] else real_interval[m * b + c,m * a + c])`, REWRITE_TAC[REAL_INTERVAL_INTERVAL; GSYM IMAGE_o; o_DEF; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_DROP; LIFT_DROP; GSYM DROP_CMUL; GSYM DROP_ADD] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o; IMAGE_AFFINITY_INTERVAL] THEN MESON_TAC[IMAGE_CLAUSES]);; let IMAGE_STRETCH_REAL_INTERVAL = prove (`!a b m. IMAGE (\x. m * x) (real_interval[a,b]) = (if real_interval[a,b] = {} then {} else if &0 <= m then real_interval[m * a,m * b] else real_interval[m * b,m * a])`, ONCE_REWRITE_TAC[REAL_ARITH `m * x = m * x + &0`] THEN REWRITE_TAC[IMAGE_AFFINITY_REAL_INTERVAL]);; let REAL_INTERVAL_TRANSLATION = prove (`(!c a b. real_interval[c + a,c + b] = IMAGE (\x. c + x) (real_interval[a,b])) /\ (!c a b. real_interval(c + a,c + b) = IMAGE (\x. c + x) (real_interval(a,b)))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[REAL_ARITH `c + x:real = y <=> x = y - c`; EXISTS_REFL] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; let IN_REAL_INTERVAL_REFLECT = prove (`(!a b x. --x IN real_interval[--b,--a] <=> x IN real_interval[a,b]) /\ (!a b x. --x IN real_interval(--b,--a) <=> x IN real_interval(a,b))`, REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; let REFLECT_REAL_INTERVAL = prove (`(!a b. IMAGE (--) (real_interval[a,b]) = real_interval[--b,--a]) /\ (!a b. IMAGE (--) (real_interval(a,b)) = real_interval(--b,--a))`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_REAL_INTERVAL] THEN ONCE_REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`] THEN REWRITE_TAC[UNWIND_THM1] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Real continuity and differentiability. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_CONTINUOUS = prove (`f real_continuous net <=> (Cx o f) continuous net`, REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX; o_THM]);; let REAL_CONTINUOUS_CONTINUOUS1 = prove (`f real_continuous net <=> (lift o f) continuous net`, REWRITE_TAC[real_continuous; continuous; TENDSTO_REAL; o_THM]);; let REAL_CONTINUOUS_CONTINUOUS_ATREAL = prove (`f real_continuous (atreal x) <=> (lift o f o drop) continuous (at(lift x))`, REWRITE_TAC[REAL_CONTINUOUS_ATREAL; REALLIM_ATREAL_AT; CONTINUOUS_AT; TENDSTO_REAL; o_THM; LIFT_DROP]);; let REAL_CONTINUOUS_CONTINUOUS_WITHINREAL = prove (`f real_continuous (atreal x within s) <=> (lift o f o drop) continuous (at(lift x) within IMAGE lift s)`, REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL_WITHIN] THEN REWRITE_TAC[TENDSTO_REAL; CONTINUOUS_WITHIN; o_THM; LIFT_DROP]);; let REAL_COMPLEX_CONTINUOUS_WITHINREAL = prove (`f real_continuous (atreal x within s) <=> (Cx o f o Re) continuous (at (Cx x) within (real INTER IMAGE Cx s))`, REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX; LIM_WITHINREAL_WITHINCOMPLEX; NETLIMIT_WITHINREAL; GSYM o_ASSOC] THEN ASM_CASES_TAC `trivial_limit(at(Cx x) within (real INTER IMAGE Cx s))` THENL [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX; NETLIMIT_WITHIN; NETLIMIT_WITHINREAL; RE_CX; o_THM]]);; let REAL_COMPLEX_CONTINUOUS_ATREAL = prove (`f real_continuous (atreal x) <=> (Cx o f o Re) continuous (at (Cx x) within real)`, REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX; LIM_ATREAL_ATCOMPLEX; NETLIMIT_ATREAL; GSYM o_ASSOC] THEN ASM_CASES_TAC `trivial_limit(at(Cx x) within real)` THENL [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN; RE_CX; o_THM]]);; let CONTINUOUS_CONTINUOUS_WITHINREAL = prove (`!f x s. f continuous (atreal x within s) <=> (f o drop) continuous (at (lift x) within IMAGE lift s)`, REWRITE_TAC[REALLIM_WITHINREAL_WITHIN; CONTINUOUS_WITHIN; CONTINUOUS_WITHINREAL; o_DEF; LIFT_DROP; LIM_WITHINREAL_WITHIN]);; let CONTINUOUS_CONTINUOUS_ATREAL = prove (`!f x. f continuous (atreal x) <=> (f o drop) continuous (at (lift x))`, REWRITE_TAC[REALLIM_ATREAL_AT; CONTINUOUS_AT; CONTINUOUS_ATREAL; o_DEF; LIFT_DROP; LIM_ATREAL_AT]);; let REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL = prove (`!f x s. f real_continuous (atreal x within s) <=> (f o drop) real_continuous (at (lift x) within IMAGE lift s)`, REWRITE_TAC[REALLIM_WITHINREAL_WITHIN; REAL_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHINREAL; o_DEF; LIFT_DROP; LIM_WITHINREAL_WITHIN]);; let REAL_CONTINUOUS_REAL_CONTINUOUS_ATREAL = prove (`!f x. f real_continuous (atreal x) <=> (f o drop) real_continuous (at (lift x))`, REWRITE_TAC[REALLIM_ATREAL_AT; REAL_CONTINUOUS_AT; REAL_CONTINUOUS_ATREAL; o_DEF; LIFT_DROP; LIM_ATREAL_AT]);; let HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL = prove (`!f f' x s. (f has_real_derivative f') (atreal x within s) ==> f real_continuous (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN; REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN MESON_TAC[REAL; RE_CX; REAL_CX; IN]);; let REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL = prove (`!f x s. f real_differentiable (atreal x within s) ==> f real_continuous (atreal x within s)`, MESON_TAC[HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL; real_differentiable]);; let HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL = prove (`!f f' x. (f has_real_derivative f') (atreal x) ==> f real_continuous (atreal x)`, REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_AT; REAL_COMPLEX_CONTINUOUS_ATREAL; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN]);; let REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL = prove (`!f x. f real_differentiable atreal x ==> f real_continuous atreal x`, MESON_TAC[HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL; real_differentiable]);; let REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON = prove (`!f s. f real_differentiable_on s ==> f real_continuous_on s`, REWRITE_TAC[real_differentiable_on; REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN MESON_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL; real_differentiable]);; let REAL_CONTINUOUS_AT_COMPONENT = prove (`!i a. 1 <= i /\ i <= dimindex(:N) ==> (\x:real^N. x$i) real_continuous at a`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; CONTINUOUS_AT_LIFT_COMPONENT]);; let REAL_CONTINUOUS_AT_TRANSLATION = prove (`!a z f:real^N->real. f real_continuous at (a + z) <=> (\x. f(a + x)) real_continuous at z`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; CONTINUOUS_AT_TRANSLATION]);; add_translation_invariants [REAL_CONTINUOUS_AT_TRANSLATION];; let REAL_CONTINUOUS_AT_LINEAR_IMAGE = prove (`!h:real^N->real^N z f:real^N->real. linear h /\ (!x. norm(h x) = norm x) ==> (f real_continuous at (h z) <=> (\x. f(h x)) real_continuous at z)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; CONTINUOUS_AT_LINEAR_IMAGE]);; add_linear_invariants [REAL_CONTINUOUS_AT_LINEAR_IMAGE];; let REAL_CONTINUOUS_AT_ARG = prove (`!z. ~(real z /\ &0 <= Re z) ==> Arg real_continuous (at z)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; CONTINUOUS_AT_ARG]);; let REAL_CONTINUOUS_TRANSFORM_WITHIN_SET_IMP = prove (`!f a s t. eventually (\x. x IN t ==> x IN s) (at a) /\ f real_continuous (at a within s) ==> f real_continuous (at a within t)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; CONTINUOUS_TRANSFORM_WITHIN_SET_IMP]);; let CONTINUOUS_TRANSFORM_WITHINREAL_SET_IMP = prove (`!f a s t. eventually (\x. x IN t ==> x IN s) (atreal a) /\ f continuous (atreal a within s) ==> f continuous (atreal a within t)`, REWRITE_TAC[CONTINUOUS_WITHINREAL; LIM_TRANSFORM_WITHINREAL_SET_IMP]);; let REAL_CONTINUOUS_TRANSFORM_WITHINREAL_SET_IMP = prove (`!f a s t. eventually (\x. x IN t ==> x IN s) (atreal a) /\ f real_continuous (atreal a within s) ==> f real_continuous (atreal a within t)`, REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_TRANSFORM_WITHINREAL_SET_IMP]);; (* ------------------------------------------------------------------------- *) (* More basics about real derivatives. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_WITHIN_SUBSET = prove (`!f s t x. (f has_real_derivative f') (atreal x within s) /\ t SUBSET s ==> (f has_real_derivative f') (atreal x within t)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET) THEN ASM SET_TAC[]);; let REAL_DIFFERENTIABLE_ON_SUBSET = prove (`!f s t. f real_differentiable_on s /\ t SUBSET s ==> f real_differentiable_on t`, REWRITE_TAC[real_differentiable_on] THEN MESON_TAC[SUBSET; HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);; let REAL_DIFFERENTIABLE_WITHIN_SUBSET = prove (`!f s t. f real_differentiable (atreal x within s) /\ t SUBSET s ==> f real_differentiable (atreal x within t)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);; let HAS_REAL_DERIVATIVE_ATREAL_WITHIN = prove (`!f f' x s. (f has_real_derivative f') (atreal x) ==> (f has_real_derivative f') (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN; HAS_REAL_COMPLEX_DERIVATIVE_AT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET) THEN ASM SET_TAC[]);; let HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN = prove (`!f f' a s. a IN s /\ real_open s ==> ((f has_real_derivative f') (atreal a within s) <=> (f has_real_derivative f') (atreal a))`, REPEAT GEN_TAC THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_REAL_DERIVATIVE_ATREAL; REALLIM_WITHIN_REAL_OPEN]);; let REAL_DIFFERENTIABLE_ATREAL_WITHIN = prove (`!f s z. f real_differentiable (atreal z) ==> f real_differentiable (atreal z within s)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; let HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN = prove (`!f f' g x s d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ abs(x' - x) < d ==> f x' = g x') /\ (f has_real_derivative f') (atreal x within s) ==> (g has_real_derivative f') (atreal x within s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN) THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_CX; RE_CX] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `dist(a,b) < d ==> z <= norm(a - b) ==> z < d`)) THEN W(MP_TAC o PART_MATCH (rand o rand) COMPLEX_NORM_GE_RE_IM o rand o snd) THEN SIMP_TAC[RE_SUB; RE_CX]);; let HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL = prove (`!f f' g x d. &0 < d /\ (!x'. abs(x' - x) < d ==> f x' = g x') /\ (f has_real_derivative f') (atreal x) ==> (g has_real_derivative f') (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN; IN_UNIV]);; let HAS_REAL_DERIVATIVE_ZERO_CONSTANT = prove (`!f s. is_realinterval s /\ (!x. x IN s ==> (f has_real_derivative (&0)) (atreal x within s)) ==> ?c. !x. x IN s ==> f(x) = c`, REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`Cx o f o Re`; `{z | real z /\ Re z IN s}`] HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_REAL; RE_CX; o_THM] THEN ASM_REWRITE_TAC[GSYM IS_REALINTERVAL_CONVEX_COMPLEX] THEN MESON_TAC[RE_CX]);; let HAS_REAL_DERIVATIVE_ZERO_UNIQUE = prove (`!f s c a. is_realinterval s /\ a IN s /\ f a = c /\ (!x. x IN s ==> (f has_real_derivative (&0)) (atreal x within s)) ==> !x. x IN s ==> f(x) = c`, MESON_TAC[HAS_REAL_DERIVATIVE_ZERO_CONSTANT]);; let REAL_DIFF_CHAIN_WITHIN = prove (`!f g f' g' x s. (f has_real_derivative f') (atreal x within s) /\ (g has_real_derivative g') (atreal (f x) within (IMAGE f s)) ==> ((g o f) has_real_derivative (g' * f'))(atreal x within s)`, REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `Cx o (g o f) o Re = (Cx o g o Re) o (Cx o f o Re)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_DEF; RE_CX]; ALL_TAC] THEN REWRITE_TAC[CX_MUL] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_WITHIN THEN ASM_REWRITE_TAC[o_THM; RE_CX] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; o_THM; REAL_CX; RE_CX] THEN SET_TAC[]);; let REAL_DIFF_CHAIN_ATREAL = prove (`!f g f' g' x. (f has_real_derivative f') (atreal x) /\ (g has_real_derivative g') (atreal (f x)) ==> ((g o f) has_real_derivative (g' * f')) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN ASM_MESON_TAC[REAL_DIFF_CHAIN_WITHIN; SUBSET_UNIV; HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);; let HAS_REAL_DERIVATIVE_CHAIN = prove (`!P f g. (!x. P x ==> (g has_real_derivative g'(x)) (atreal x)) ==> (!x s. (f has_real_derivative f') (atreal x within s) /\ P(f x) ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) (atreal x within s)) /\ (!x. (f has_real_derivative f') (atreal x) /\ P(f x) ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) (atreal x))`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_MESON_TAC[REAL_DIFF_CHAIN_WITHIN; REAL_DIFF_CHAIN_ATREAL; HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; let HAS_REAL_DERIVATIVE_CHAIN_UNIV = prove (`!f g. (!x. (g has_real_derivative g'(x)) (atreal x)) ==> (!x s. (f has_real_derivative f') (atreal x within s) ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) (atreal x within s)) /\ (!x. (f has_real_derivative f') (atreal x) ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) (atreal x))`, MP_TAC(SPEC `\x:real. T` HAS_REAL_DERIVATIVE_CHAIN) THEN SIMP_TAC[]);; let REAL_DERIVATIVE_UNIQUE_ATREAL = prove (`!f z f' f''. (f has_real_derivative f') (atreal z) /\ (f has_real_derivative f'') (atreal z) ==> f' = f''`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT] THEN DISCH_THEN(MP_TAC o MATCH_MP FRECHET_DERIVATIVE_UNIQUE_AT) THEN DISCH_THEN(MP_TAC o C AP_THM `vec 1:real^1`) THEN REWRITE_TAC[VECTOR_MUL_RCANCEL; VEC_EQ; ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* Some handy theorems about the actual differentition function. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_DERIVATIVE = prove (`!f f' x. (f has_real_derivative f') (atreal x) ==> real_derivative f x = f'`, REWRITE_TAC[real_derivative] THEN MESON_TAC[REAL_DERIVATIVE_UNIQUE_ATREAL]);; let HAS_REAL_DERIVATIVE_DIFFERENTIABLE = prove (`!f x. (f has_real_derivative (real_derivative f x)) (atreal x) <=> f real_differentiable atreal x`, REWRITE_TAC[real_differentiable; real_derivative] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Arithmetical combining theorems. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_LMUL_WITHIN = prove (`!f f' c x s. (f has_real_derivative f') (atreal x within s) ==> ((\x. c * f(x)) has_real_derivative (c * f')) (atreal x within s)`, REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN REWRITE_TAC[o_DEF; CX_MUL; HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN]);; let HAS_REAL_DERIVATIVE_LMUL_ATREAL = prove (`!f f' c x. (f has_real_derivative f') (atreal x) ==> ((\x. c * f(x)) has_real_derivative (c * f')) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_WITHIN]);; let HAS_REAL_DERIVATIVE_RMUL_WITHIN = prove (`!f f' c x s. (f has_real_derivative f') (atreal x within s) ==> ((\x. f(x) * c) has_real_derivative (f' * c)) (atreal x within s)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_WITHIN]);; let HAS_REAL_DERIVATIVE_RMUL_ATREAL = prove (`!f f' c x. (f has_real_derivative f') (atreal x) ==> ((\x. f(x) * c) has_real_derivative (f' * c)) (atreal x)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_ATREAL]);; let HAS_REAL_DERIVATIVE_CDIV_WITHIN = prove (`!f f' c x s. (f has_real_derivative f') (atreal x within s) ==> ((\x. f(x) / c) has_real_derivative (f' / c)) (atreal x within s)`, SIMP_TAC[real_div; HAS_REAL_DERIVATIVE_RMUL_WITHIN]);; let HAS_REAL_DERIVATIVE_CDIV_ATREAL = prove (`!f f' c x. (f has_real_derivative f') (atreal x) ==> ((\x. f(x) / c) has_real_derivative (f' / c)) (atreal x)`, SIMP_TAC[real_div; HAS_REAL_DERIVATIVE_RMUL_ATREAL]);; let HAS_REAL_DERIVATIVE_ID = prove (`!net. ((\x. x) has_real_derivative &1) net`, REWRITE_TAC[has_real_derivative; TENDSTO_REAL; REAL_ARITH `x - (a + &1 * (x - a)) = &0`] THEN REWRITE_TAC[REAL_MUL_RZERO; LIM_CONST; o_DEF]);; let HAS_REAL_DERIVATIVE_CONST = prove (`!c net. ((\x. c) has_real_derivative &0) net`, REWRITE_TAC[has_real_derivative; REAL_MUL_LZERO; REAL_ADD_RID; REAL_SUB_REFL; REAL_MUL_RZERO; REALLIM_CONST]);; let HAS_REAL_DERIVATIVE_NEG = prove (`!f f' net. (f has_real_derivative f') net ==> ((\x. --(f(x))) has_real_derivative (--f')) net`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_NEG) THEN REWRITE_TAC[REAL_NEG_0; REAL_ARITH `a * (--b - (--c + --d * e:real)) = --(a * (b - (c + d * e)))`]);; let HAS_REAL_DERIVATIVE_ADD = prove (`!f f' g g' net. (f has_real_derivative f') net /\ (g has_real_derivative g') net ==> ((\x. f(x) + g(x)) has_real_derivative (f' + g')) net`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_derivative] THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_ADD) THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `(fx - (fa + f' * (x - a))) + (gx - (ga + g' * (x - a))):real = (fx + gx) - ((fa + ga) + (f' + g') * (x - a))`]);; let HAS_REAL_DERIVATIVE_SUB = prove (`!f f' g g' net. (f has_real_derivative f') net /\ (g has_real_derivative g') net ==> ((\x. f(x) - g(x)) has_real_derivative (f' - g')) net`, SIMP_TAC[real_sub; HAS_REAL_DERIVATIVE_ADD; HAS_REAL_DERIVATIVE_NEG]);; let HAS_REAL_DERIVATIVE_MUL_WITHIN = prove (`!f f' g g' x s. (f has_real_derivative f') (atreal x within s) /\ (g has_real_derivative g') (atreal x within s) ==> ((\x. f(x) * g(x)) has_real_derivative (f(x) * g' + f' * g(x))) (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_MUL_WITHIN) THEN REWRITE_TAC[o_DEF; CX_MUL; CX_ADD; RE_CX]);; let HAS_REAL_DERIVATIVE_MUL_ATREAL = prove (`!f f' g g' x. (f has_real_derivative f') (atreal x) /\ (g has_real_derivative g') (atreal x) ==> ((\x. f(x) * g(x)) has_real_derivative (f(x) * g' + f' * g(x))) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN]);; let HAS_REAL_DERIVATIVE_POW_WITHIN = prove (`!f f' x s n. (f has_real_derivative f') (atreal x within s) ==> ((\x. f(x) pow n) has_real_derivative (&n * f(x) pow (n - 1) * f')) (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP HAS_COMPLEX_DERIVATIVE_POW_WITHIN) THEN REWRITE_TAC[o_DEF; CX_MUL; CX_POW; RE_CX]);; let HAS_REAL_DERIVATIVE_POW_ATREAL = prove (`!f f' x n. (f has_real_derivative f') (atreal x) ==> ((\x. f(x) pow n) has_real_derivative (&n * f(x) pow (n - 1) * f')) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_POW_WITHIN]);; let HAS_REAL_DERIVATIVE_INV_BASIC = prove (`!x. ~(x = &0) ==> ((inv) has_real_derivative (--inv(x pow 2))) (atreal x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_AT] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN THEN EXISTS_TAC `inv:complex->complex` THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_INV_BASIC; CX_INJ; CX_NEG; CX_INV; CX_POW; HAS_COMPLEX_DERIVATIVE_AT_WITHIN] THEN SIMP_TAC[IN; FORALL_REAL; IMP_CONJ; o_DEF; REAL_CX; RE_CX; CX_INV] THEN MESON_TAC[REAL_LT_01]);; let HAS_REAL_DERIVATIVE_INV_WITHIN = prove (`!f f' x s. (f has_real_derivative f') (atreal x within s) /\ ~(f x = &0) ==> ((\x. inv(f(x))) has_real_derivative (--f' / f(x) pow 2)) (atreal x within s)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[REAL_FIELD `~(g = &0) ==> --f / g pow 2 = --inv(g pow 2) * f`] THEN MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_INV_BASIC]);; let HAS_REAL_DERIVATIVE_INV_ATREAL = prove (`!f f' x. (f has_real_derivative f') (atreal x) /\ ~(f x = &0) ==> ((\x. inv(f(x))) has_real_derivative (--f' / f(x) pow 2)) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_INV_WITHIN]);; let HAS_REAL_DERIVATIVE_DIV_WITHIN = prove (`!f f' g g' x s. (f has_real_derivative f') (atreal x within s) /\ (g has_real_derivative g') (atreal x within s) /\ ~(g(x) = &0) ==> ((\x. f(x) / g(x)) has_real_derivative (f' * g(x) - f(x) * g') / g(x) pow 2) (atreal x within s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_INV_WITHIN) THEN UNDISCH_TAC `(f has_real_derivative f') (atreal x within s)` THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_MUL_WITHIN) THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; let HAS_REAL_DERIVATIVE_DIV_ATREAL = prove (`!f f' g g' x. (f has_real_derivative f') (atreal x) /\ (g has_real_derivative g') (atreal x) /\ ~(g(x) = &0) ==> ((\x. f(x) / g(x)) has_real_derivative (f' * g(x) - f(x) * g') / g(x) pow 2) (atreal x)`, ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_DIV_WITHIN]);; let HAS_REAL_DERIVATIVE_SUM = prove (`!f net s. FINITE s /\ (!a. a IN s ==> (f a has_real_derivative f' a) net) ==> ((\x. sum s (\a. f a x)) has_real_derivative (sum s f')) net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; SUM_CLAUSES] THEN SIMP_TAC[HAS_REAL_DERIVATIVE_CONST; HAS_REAL_DERIVATIVE_ADD; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Same thing just for real differentiability. *) (* ------------------------------------------------------------------------- *) let REAL_DIFFERENTIABLE_CONST = prove (`!c net. (\z. c) real_differentiable net`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_CONST]);; let REAL_DIFFERENTIABLE_ID = prove (`!net. (\z. z) real_differentiable net`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_ID]);; let REAL_DIFFERENTIABLE_NEG = prove (`!f net. f real_differentiable net ==> (\z. --(f z)) real_differentiable net`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_NEG]);; let REAL_DIFFERENTIABLE_ADD = prove (`!f g net. f real_differentiable net /\ g real_differentiable net ==> (\z. f z + g z) real_differentiable net`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_ADD]);; let REAL_DIFFERENTIABLE_SUB = prove (`!f g net. f real_differentiable net /\ g real_differentiable net ==> (\z. f z - g z) real_differentiable net`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_SUB]);; let REAL_DIFFERENTIABLE_INV_WITHIN = prove (`!f z s. f real_differentiable (atreal z within s) /\ ~(f z = &0) ==> (\z. inv(f z)) real_differentiable (atreal z within s)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_INV_WITHIN]);; let REAL_DIFFERENTIABLE_MUL_WITHIN = prove (`!f g z s. f real_differentiable (atreal z within s) /\ g real_differentiable (atreal z within s) ==> (\z. f z * g z) real_differentiable (atreal z within s)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN]);; let REAL_DIFFERENTIABLE_DIV_WITHIN = prove (`!f g z s. f real_differentiable (atreal z within s) /\ g real_differentiable (atreal z within s) /\ ~(g z = &0) ==> (\z. f z / g z) real_differentiable (atreal z within s)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_DIV_WITHIN]);; let REAL_DIFFERENTIABLE_POW_WITHIN = prove (`!f n z s. f real_differentiable (atreal z within s) ==> (\z. f z pow n) real_differentiable (atreal z within s)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_POW_WITHIN]);; let REAL_DIFFERENTIABLE_TRANSFORM_WITHIN = prove (`!f g x s d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ abs(x' - x) < d ==> f x' = g x') /\ f real_differentiable (atreal x within s) ==> g real_differentiable (atreal x within s)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN]);; let REAL_DIFFERENTIABLE_TRANSFORM = prove (`!f g s. (!x. x IN s ==> f x = g x) /\ f real_differentiable_on s ==> g real_differentiable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[real_differentiable_on; GSYM real_differentiable] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real->real`; `&1`] THEN ASM_SIMP_TAC[REAL_LT_01]);; let REAL_DIFFERENTIABLE_EQ = prove (`!f g s. (!x. x IN s ==> f x = g x) ==> (f real_differentiable_on s <=> g real_differentiable_on s)`, MESON_TAC[REAL_DIFFERENTIABLE_TRANSFORM]);; let REAL_DIFFERENTIABLE_INV_ATREAL = prove (`!f z. f real_differentiable atreal z /\ ~(f z = &0) ==> (\z. inv(f z)) real_differentiable atreal z`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_INV_ATREAL]);; let REAL_DIFFERENTIABLE_MUL_ATREAL = prove (`!f g z. f real_differentiable atreal z /\ g real_differentiable atreal z ==> (\z. f z * g z) real_differentiable atreal z`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_MUL_ATREAL]);; let REAL_DIFFERENTIABLE_DIV_ATREAL = prove (`!f g z. f real_differentiable atreal z /\ g real_differentiable atreal z /\ ~(g z = &0) ==> (\z. f z / g z) real_differentiable atreal z`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_DIV_ATREAL]);; let REAL_DIFFERENTIABLE_POW_ATREAL = prove (`!f n z. f real_differentiable atreal z ==> (\z. f z pow n) real_differentiable atreal z`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_POW_ATREAL]);; let REAL_DIFFERENTIABLE_TRANSFORM_ATREAL = prove (`!f g x d. &0 < d /\ (!x'. abs(x' - x) < d ==> f x' = g x') /\ f real_differentiable atreal x ==> g real_differentiable atreal x`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL]);; let REAL_DIFFERENTIABLE_COMPOSE_WITHIN = prove (`!f g x s. f real_differentiable (atreal x within s) /\ g real_differentiable (atreal (f x) within IMAGE f s) ==> (g o f) real_differentiable (atreal x within s)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[REAL_DIFF_CHAIN_WITHIN]);; let REAL_DIFFERENTIABLE_COMPOSE_ATREAL = prove (`!f g x. f real_differentiable (atreal x) /\ g real_differentiable (atreal (f x)) ==> (g o f) real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[REAL_DIFF_CHAIN_ATREAL]);; (* ------------------------------------------------------------------------- *) (* Same again for being differentiable on a set. *) (* ------------------------------------------------------------------------- *) let REAL_DIFFERENTIABLE_ON_CONST = prove (`!c s. (\z. c) real_differentiable_on s`, REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_CONST]);; let REAL_DIFFERENTIABLE_ON_ID = prove (`!s. (\z. z) real_differentiable_on s`, REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_ID]);; let REAL_DIFFERENTIABLE_ON_COMPOSE = prove (`!f g s. f real_differentiable_on s /\ g real_differentiable_on (IMAGE f s) ==> (g o f) real_differentiable_on s`, SIMP_TAC[real_differentiable_on; GSYM real_differentiable; FORALL_IN_IMAGE] THEN MESON_TAC[REAL_DIFFERENTIABLE_COMPOSE_WITHIN]);; let REAL_DIFFERENTIABLE_ON_NEG = prove (`!f s. f real_differentiable_on s ==> (\z. --(f z)) real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_NEG]);; let REAL_DIFFERENTIABLE_ON_ADD = prove (`!f g s. f real_differentiable_on s /\ g real_differentiable_on s ==> (\z. f z + g z) real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_ADD]);; let REAL_DIFFERENTIABLE_ON_SUB = prove (`!f g s. f real_differentiable_on s /\ g real_differentiable_on s ==> (\z. f z - g z) real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_SUB]);; let REAL_DIFFERENTIABLE_ON_MUL = prove (`!f g s. f real_differentiable_on s /\ g real_differentiable_on s ==> (\z. f z * g z) real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_MUL_WITHIN]);; let REAL_DIFFERENTIABLE_ON_INV = prove (`!f s. f real_differentiable_on s /\ (!z. z IN s ==> ~(f z = &0)) ==> (\z. inv(f z)) real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_INV_WITHIN]);; let REAL_DIFFERENTIABLE_ON_DIV = prove (`!f g s. f real_differentiable_on s /\ g real_differentiable_on s /\ (!z. z IN s ==> ~(g z = &0)) ==> (\z. f z / g z) real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_DIV_WITHIN]);; let REAL_DIFFERENTIABLE_ON_POW = prove (`!f s n. f real_differentiable_on s ==> (\z. (f z) pow n) real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_POW_WITHIN]);; let REAL_DIFFERENTIABLE_ON_SUM = prove (`!f s k. FINITE k /\ (!a. a IN k ==> (f a) real_differentiable_on s) ==> (\x. sum k (\a. f a x)) real_differentiable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES] THEN SIMP_TAC[REAL_DIFFERENTIABLE_ON_CONST; IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_ADD THEN ASM_SIMP_TAC[ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Derivative (and continuity) theorems for real transcendental functions. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_EXP = prove (`!x. (exp has_real_derivative exp(x)) (atreal x)`, GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN EXISTS_TAC `cexp` THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CEXP; CX_EXP]);; let REAL_DIFFERENTIABLE_AT_EXP = prove (`!x. exp real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_EXP]);; let REAL_DIFFERENTIABLE_WITHIN_EXP = prove (`!s x. exp real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_EXP]);; let REAL_CONTINUOUS_AT_EXP = prove (`!x. exp real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_EXP; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_EXP = prove (`!s x. exp real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_EXP]);; let REAL_CONTINUOUS_ON_EXP = prove (`!s. exp real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_EXP]);; let HAS_REAL_DERIVATIVE_SIN = prove (`!x. (sin has_real_derivative cos(x)) (atreal x)`, GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN EXISTS_TAC `csin` THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CSIN; CX_SIN; CX_COS]);; let REAL_DIFFERENTIABLE_AT_SIN = prove (`!x. sin real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_SIN]);; let REAL_DIFFERENTIABLE_WITHIN_SIN = prove (`!s x. sin real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_SIN]);; let REAL_CONTINUOUS_AT_SIN = prove (`!x. sin real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_SIN; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_SIN = prove (`!s x. sin real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_SIN]);; let REAL_CONTINUOUS_ON_SIN = prove (`!s. sin real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_SIN]);; let HAS_REAL_DERIVATIVE_COS = prove (`!x. (cos has_real_derivative --sin(x)) (atreal x)`, GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN EXISTS_TAC `ccos` THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CCOS; CX_SIN; CX_COS; CX_NEG]);; let REAL_DIFFERENTIABLE_AT_COS = prove (`!x. cos real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_COS]);; let REAL_DIFFERENTIABLE_WITHIN_COS = prove (`!s x. cos real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_COS]);; let REAL_CONTINUOUS_AT_COS = prove (`!x. cos real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_COS; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_COS = prove (`!s x. cos real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_COS]);; let REAL_CONTINUOUS_ON_COS = prove (`!s. cos real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_COS]);; let HAS_REAL_DERIVATIVE_TAN = prove (`!x. ~(cos x = &0) ==> (tan has_real_derivative inv(cos(x) pow 2)) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN EXISTS_TAC `ctan` THEN REWRITE_TAC[CX_INV; CX_POW; CX_COS] THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CTAN; GSYM CX_COS; CX_INJ; CX_TAN]);; let REAL_DIFFERENTIABLE_AT_TAN = prove (`!x. ~(cos x = &0) ==> tan real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_TAN]);; let REAL_DIFFERENTIABLE_WITHIN_TAN = prove (`!s x. ~(cos x = &0) ==> tan real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_TAN]);; let REAL_CONTINUOUS_AT_TAN = prove (`!x. ~(cos x = &0) ==> tan real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_TAN; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_TAN = prove (`!s x. ~(cos x = &0) ==> tan real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_TAN]);; let REAL_CONTINUOUS_ON_TAN = prove (`!s. (!x. x IN s ==> ~(cos x = &0)) ==> tan real_continuous_on s`, MESON_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_TAN]);; let HAS_REAL_DERIVATIVE_LOG = prove (`!x. &0 < x ==> (log has_real_derivative inv(x)) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN MAP_EVERY EXISTS_TAC [`clog`; `x:real`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[CX_INV] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CLOG THEN ASM_REWRITE_TAC[RE_CX]; MATCH_MP_TAC(GSYM CX_LOG) THEN ASM_REAL_ARITH_TAC]);; let REAL_DIFFERENTIABLE_AT_LOG = prove (`!x. &0 < x ==> log real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_LOG]);; let REAL_DIFFERENTIABLE_WITHIN_LOG = prove (`!s x. &0 < x ==> log real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_LOG]);; let REAL_CONTINUOUS_AT_LOG = prove (`!x. &0 < x ==> log real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_LOG; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_LOG = prove (`!s x. &0 < x ==> log real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_LOG]);; let REAL_CONTINUOUS_ON_LOG = prove (`!s. (!x. x IN s ==> &0 < x) ==> log real_continuous_on s`, MESON_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_LOG]);; let HAS_REAL_DERIVATIVE_SQRT = prove (`!x. &0 < x ==> (sqrt has_real_derivative inv(&2 * sqrt x)) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN MAP_EVERY EXISTS_TAC [`csqrt`; `x:real`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[CX_INV; CX_MUL; CX_SQRT; REAL_LT_IMP_LE] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CSQRT THEN ASM_SIMP_TAC[RE_CX]; MATCH_MP_TAC(GSYM CX_SQRT) THEN ASM_REAL_ARITH_TAC]);; let REAL_DIFFERENTIABLE_AT_SQRT = prove (`!x. &0 < x ==> sqrt real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_SQRT]);; let REAL_DIFFERENTIABLE_WITHIN_SQRT = prove (`!s x. &0 < x ==> sqrt real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_SQRT]);; let REAL_CONTINUOUS_AT_SQRT = prove (`!x. &0 < x ==> sqrt real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_SQRT; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_SQRT = prove (`!s x. &0 < x ==> sqrt real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_SQRT]);; let REAL_CONTINUOUS_WITHIN_SQRT_COMPOSE = prove (`!f s a:real^N. f real_continuous (at a within s) /\ (&0 < f a \/ !x. x IN s ==> &0 <= f x) ==> (\x. sqrt(f x)) real_continuous (at a within s)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SQRT_COMPOSE]);; let REAL_CONTINUOUS_AT_SQRT_COMPOSE = prove (`!f a:real^N. f real_continuous (at a) /\ (&0 < f a \/ !x. &0 <= f x) ==> (\x. sqrt(f x)) real_continuous (at a)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN REWRITE_TAC[CONTINUOUS_AT_SQRT_COMPOSE]);; let CONTINUOUS_WITHINREAL_SQRT_COMPOSE = prove (`!f s a. (\x. lift(f x)) continuous (atreal a within s) /\ (&0 < f a \/ !x. x IN s ==> &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous (atreal a within s)`, REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[o_DEF] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_SQRT_COMPOSE THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP]);; let CONTINUOUS_ATREAL_SQRT_COMPOSE = prove (`!f a. (\x. lift(f x)) continuous (atreal a) /\ (&0 < f a \/ !x. &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous (atreal a)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real->real`; `(:real)`; `a:real`] CONTINUOUS_WITHINREAL_SQRT_COMPOSE) THEN REWRITE_TAC[WITHINREAL_UNIV; IN_UNIV]);; let REAL_CONTINUOUS_WITHINREAL_SQRT_COMPOSE = prove (`!f s a. f real_continuous (atreal a within s) /\ (&0 < f a \/ !x. x IN s ==> &0 <= f x) ==> (\x. sqrt(f x)) real_continuous (atreal a within s)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN REWRITE_TAC[CONTINUOUS_WITHINREAL_SQRT_COMPOSE]);; let REAL_CONTINUOUS_ATREAL_SQRT_COMPOSE = prove (`!f a. f real_continuous (atreal a) /\ (&0 < f a \/ !x. &0 <= f x) ==> (\x. sqrt(f x)) real_continuous (atreal a)`, REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN REWRITE_TAC[CONTINUOUS_ATREAL_SQRT_COMPOSE]);; let HAS_REAL_DERIVATIVE_ATN = prove (`!x. (atn has_real_derivative inv(&1 + x pow 2)) (atreal x)`, GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN EXISTS_TAC `catn` THEN REWRITE_TAC[CX_INV; CX_ADD; CX_ATN; CX_POW] THEN ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CATN; IM_CX; REAL_ABS_NUM; REAL_LT_01]);; let REAL_DIFFERENTIABLE_AT_ATN = prove (`!x. atn real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_ATN]);; let REAL_DIFFERENTIABLE_WITHIN_ATN = prove (`!s x. atn real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_ATN]);; let REAL_CONTINUOUS_AT_ATN = prove (`!x. atn real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_ATN; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_ATN = prove (`!s x. atn real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_ATN]);; let REAL_CONTINUOUS_ON_ATN = prove (`!s. atn real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_WITHIN_ATN]);; let HAS_REAL_DERIVATIVE_ASN_COS = prove (`!x. abs(x) < &1 ==> (asn has_real_derivative inv(cos(asn x))) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN MAP_EVERY EXISTS_TAC [`casn`; `&1 - abs x`] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[CX_INV; CX_COS; CX_ASN; REAL_LT_IMP_LE] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CASN THEN ASM_REWRITE_TAC[RE_CX]; MATCH_MP_TAC(GSYM CX_ASN) THEN ASM_REAL_ARITH_TAC]);; let HAS_REAL_DERIVATIVE_ASN = prove (`!x. abs(x) < &1 ==> (asn has_real_derivative inv(sqrt(&1 - x pow 2))) (atreal x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_ASN_COS) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC COS_ASN THEN ASM_REAL_ARITH_TAC);; let REAL_DIFFERENTIABLE_AT_ASN = prove (`!x. abs(x) < &1 ==> asn real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_ASN]);; let REAL_DIFFERENTIABLE_WITHIN_ASN = prove (`!s x. abs(x) < &1 ==> asn real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_ASN]);; let REAL_CONTINUOUS_AT_ASN = prove (`!x. abs(x) < &1 ==> asn real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_ASN; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_ASN = prove (`!s x. abs(x) < &1 ==> asn real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_ASN]);; let HAS_REAL_DERIVATIVE_ACS_SIN = prove (`!x. abs(x) < &1 ==> (acs has_real_derivative --inv(sin(acs x))) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN MAP_EVERY EXISTS_TAC [`cacs`; `&1 - abs x`] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[CX_INV; CX_SIN; CX_ACS; CX_NEG; REAL_LT_IMP_LE] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CACS THEN ASM_REWRITE_TAC[RE_CX]; MATCH_MP_TAC(GSYM CX_ACS) THEN ASM_REAL_ARITH_TAC]);; let HAS_REAL_DERIVATIVE_ACS = prove (`!x. abs(x) < &1 ==> (acs has_real_derivative --inv(sqrt(&1 - x pow 2))) (atreal x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_ACS_SIN) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SIN_ACS THEN ASM_REAL_ARITH_TAC);; let REAL_DIFFERENTIABLE_AT_ACS = prove (`!x. abs(x) < &1 ==> acs real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_ACS]);; let REAL_DIFFERENTIABLE_WITHIN_ACS = prove (`!s x. abs(x) < &1 ==> acs real_differentiable (atreal x within s)`, MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; REAL_DIFFERENTIABLE_AT_ACS]);; let REAL_CONTINUOUS_AT_ACS = prove (`!x. abs(x) < &1 ==> acs real_continuous (atreal x)`, MESON_TAC[HAS_REAL_DERIVATIVE_ACS; HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; let REAL_CONTINUOUS_WITHIN_ACS = prove (`!s x. abs(x) < &1 ==> acs real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_ACS]);; (* ------------------------------------------------------------------------- *) (* Hence differentiation of the norm. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_NORM_AT = prove (`!a:real^N. ~(a = vec 0) ==> (\x. lift(norm x)) differentiable (at a)`, REPEAT STRIP_TAC THEN REWRITE_TAC[vector_norm] THEN SUBGOAL_THEN `(\x:real^N. lift(sqrt(x dot x))) = (lift o sqrt o drop) o (\x. lift(x dot x))` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN REWRITE_TAC[DIFFERENTIABLE_SQNORM_AT; GSYM NORM_POW_2] THEN MP_TAC(ISPEC `norm(a:real^N) pow 2` REAL_DIFFERENTIABLE_AT_SQRT) THEN ASM_SIMP_TAC[REAL_POW_LT; NORM_POS_LT; REAL_DIFFERENTIABLE_AT]);; let DIFFERENTIABLE_ON_NORM = prove (`!s:real^N->bool. ~(vec 0 IN s) ==> (\x. lift(norm x)) differentiable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_NORM_AT THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some somewhat sharper continuity theorems including endpoints. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_WITHIN_SQRT_STRONG = prove (`!x. sqrt real_continuous (atreal x within {t | &0 <= t})`, GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN ASM_CASES_TAC `x IN {t | &0 <= t}` THENL [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`csqrt`; `&1`] THEN REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; REAL_LT_01; CONTINUOUS_WITHIN_CSQRT_POSREAL; SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN SIMP_TAC[CX_SQRT]; MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL [SUBGOAL_THEN `real INTER IMAGE Cx {t | &0 <= t} = real INTER {t | Re t >= &0}` (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; CLOSED_HALFSPACE_RE_GE]) THEN REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN REWRITE_TAC[real_ge; IN; CONJ_ACI]; MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) /\ ~(x IN s) ==> ~(f x IN t INTER IMAGE f s)`) THEN ASM_REWRITE_TAC[CX_INJ]]]);; let REAL_CONTINUOUS_ON_SQRT = prove (`!s. (!x. x IN s ==> &0 <= x) ==> sqrt real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN EXISTS_TAC `{x | &0 <= x}` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_SQRT_STRONG]);; let REAL_CONTINUOUS_WITHIN_ASN_STRONG = prove (`!x. asn real_continuous (atreal x within {t | abs(t) <= &1})`, GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN ASM_CASES_TAC `x IN {t | abs(t) <= &1}` THENL [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`casn`; `&1`] THEN REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; CONTINUOUS_WITHIN_CASN_REAL; REAL_LT_01; SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN SIMP_TAC[CX_ASN]; MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL [SUBGOAL_THEN `real INTER IMAGE Cx {t | abs t <= &1} = real INTER cball(Cx(&0),&1)` (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; CLOSED_CBALL]) THEN REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; IN] THEN MESON_TAC[REAL_NORM]; MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) /\ ~(x IN s) ==> ~(f x IN t INTER IMAGE f s)`) THEN ASM_REWRITE_TAC[CX_INJ]]]);; let REAL_CONTINUOUS_ON_ASN = prove (`!s. (!x. x IN s ==> abs(x) <= &1) ==> asn real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN EXISTS_TAC `{x | abs(x) <= &1}` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_ASN_STRONG]);; let REAL_CONTINUOUS_WITHIN_ACS_STRONG = prove (`!x. acs real_continuous (atreal x within {t | abs(t) <= &1})`, GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN ASM_CASES_TAC `x IN {t | abs(t) <= &1}` THENL [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`cacs`; `&1`] THEN REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; CONTINUOUS_WITHIN_CACS_REAL; REAL_LT_01; SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN SIMP_TAC[CX_ACS]; MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL [SUBGOAL_THEN `real INTER IMAGE Cx {t | abs t <= &1} = real INTER cball(Cx(&0),&1)` (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; CLOSED_CBALL]) THEN REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; IN] THEN MESON_TAC[REAL_NORM]; MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) /\ ~(x IN s) ==> ~(f x IN t INTER IMAGE f s)`) THEN ASM_REWRITE_TAC[CX_INJ]]]);; let REAL_CONTINUOUS_ON_ACS = prove (`!s. (!x. x IN s ==> abs(x) <= &1) ==> acs real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN EXISTS_TAC `{x | abs(x) <= &1}` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_ACS_STRONG]);; (* ------------------------------------------------------------------------- *) (* Differentiation conversion. *) (* ------------------------------------------------------------------------- *) let real_differentiation_theorems = ref [];; let add_real_differentiation_theorems = let ETA_THM = prove (`(f has_real_derivative f') net <=> ((\x. f x) has_real_derivative f') net`, REWRITE_TAC[ETA_AX]) in let ETA_TWEAK = PURE_REWRITE_RULE [IMP_CONJ] o GEN_REWRITE_RULE (LAND_CONV o ONCE_DEPTH_CONV) [ETA_THM] o SPEC_ALL in fun l -> real_differentiation_theorems := !real_differentiation_theorems @ map ETA_TWEAK l;; add_real_differentiation_theorems ([HAS_REAL_DERIVATIVE_LMUL_WITHIN; HAS_REAL_DERIVATIVE_LMUL_ATREAL; HAS_REAL_DERIVATIVE_RMUL_WITHIN; HAS_REAL_DERIVATIVE_RMUL_ATREAL; HAS_REAL_DERIVATIVE_CDIV_WITHIN; HAS_REAL_DERIVATIVE_CDIV_ATREAL; HAS_REAL_DERIVATIVE_ID; HAS_REAL_DERIVATIVE_CONST; HAS_REAL_DERIVATIVE_NEG; HAS_REAL_DERIVATIVE_ADD; HAS_REAL_DERIVATIVE_SUB; HAS_REAL_DERIVATIVE_MUL_WITHIN; HAS_REAL_DERIVATIVE_MUL_ATREAL; HAS_REAL_DERIVATIVE_DIV_WITHIN; HAS_REAL_DERIVATIVE_DIV_ATREAL; HAS_REAL_DERIVATIVE_POW_WITHIN; HAS_REAL_DERIVATIVE_POW_ATREAL; HAS_REAL_DERIVATIVE_INV_WITHIN; HAS_REAL_DERIVATIVE_INV_ATREAL] @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV HAS_REAL_DERIVATIVE_EXP))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV HAS_REAL_DERIVATIVE_SIN))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV HAS_REAL_DERIVATIVE_COS))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN HAS_REAL_DERIVATIVE_TAN))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN HAS_REAL_DERIVATIVE_LOG))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN HAS_REAL_DERIVATIVE_SQRT))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV HAS_REAL_DERIVATIVE_ATN))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN HAS_REAL_DERIVATIVE_ASN))) @ (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN HAS_REAL_DERIVATIVE_ACS))));; let rec REAL_DIFF_CONV = let partfn tm = let l,r = dest_comb tm in mk_pair(lhand l,r) and is_deriv = can (term_match [] `(f has_real_derivative f') net`) in let rec REAL_DIFF_CONV tm = try tryfind (fun th -> PART_MATCH partfn th (partfn tm)) (!real_differentiation_theorems) with Failure _ -> let ith = tryfind (fun th -> PART_MATCH (partfn o repeat (snd o dest_imp)) th (partfn tm)) (!real_differentiation_theorems) in REAL_DIFF_ELIM ith and REAL_DIFF_ELIM th = let tm = concl th in if not(is_imp tm) then th else let t = lhand tm in if not(is_deriv t) then UNDISCH th else REAL_DIFF_ELIM (MATCH_MP th (REAL_DIFF_CONV t)) in REAL_DIFF_CONV;; (* ------------------------------------------------------------------------- *) (* Hence a tactic. *) (* ------------------------------------------------------------------------- *) let REAL_DIFF_TAC = let pth = MESON[] `(f has_real_derivative f') net ==> f' = g' ==> (f has_real_derivative g') net` in W(fun (asl,w) -> let th = MATCH_MP pth (REAL_DIFF_CONV w) in MATCH_MP_TAC(repeat (GEN_REWRITE_RULE I [IMP_IMP]) (DISCH_ALL th)));; let REAL_DIFFERENTIABLE_TAC = let DISCH_FIRST th = DISCH (hd(hyp th)) th in GEN_REWRITE_TAC I [real_differentiable] THEN W(fun (asl,w) -> let th = REAL_DIFF_CONV(snd(dest_exists w)) in let f' = rand(rator(concl th)) in EXISTS_TAC f' THEN (if hyp th = [] then MATCH_ACCEPT_TAC th else let th' = repeat (GEN_REWRITE_RULE I [IMP_IMP] o DISCH_FIRST) (DISCH_FIRST th) in MATCH_MP_TAC th'));; (* ------------------------------------------------------------------------- *) (* Analytic results for real power function. *) (* ------------------------------------------------------------------------- *) let REALLIM_RPOW_COMPOSE = prove (`!net:A net f g l m. (f ---> l) net /\ (g ---> m) net /\ &0 < l ==> ((\x. (f x) rpow (g x)) ---> l rpow m) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\x:A. exp(g x * log(f x))` THEN CONJ_TAC THENL [MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\x:A. &0 < f x` THEN SIMP_TAC[rpow] THEN UNDISCH_TAC `(f ---> l) (net:A net)` THEN REWRITE_TAC[tendsto_real] THEN DISCH_THEN(MP_TAC o SPEC `l:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[rpow] THEN MATCH_MP_TAC(SPEC `exp` REALLIM_REAL_CONTINUOUS_FUNCTION) THEN REWRITE_TAC[REAL_CONTINUOUS_AT_EXP] THEN MATCH_MP_TAC REALLIM_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SPEC `log` REALLIM_REAL_CONTINUOUS_FUNCTION) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_AT_LOG]]);; let REAL_CONTINUOUS_RPOW_COMPOSE_WITHIN = prove (`!f g s a:real^N. f real_continuous (at a within s) /\ g real_continuous (at a within s) /\ &0 < f a ==> (\x. (f x) rpow (g x)) real_continuous (at a within s)`, REWRITE_TAC[REAL_CONTINUOUS_WITHIN; REALLIM_RPOW_COMPOSE]);; let HAS_REAL_DERIVATIVE_RPOW = prove (`!x y. &0 < x ==> ((\x. x rpow y) has_real_derivative y * x rpow (y - &1)) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL THEN EXISTS_TAC `\x. exp(y * log x)` THEN EXISTS_TAC `x:real` THEN ASM_SIMP_TAC[rpow; REAL_ARITH `&0 < x ==> (abs(y - x) < x <=> &0 < y /\ y < &2 * x)`] THEN REAL_DIFF_TAC THEN ASM_SIMP_TAC[REAL_SUB_RDISTRIB; REAL_EXP_SUB; REAL_MUL_LID; EXP_LOG] THEN REAL_ARITH_TAC);; add_real_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (GEN `y:real` (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN (SPEC `y:real` (ONCE_REWRITE_RULE[SWAP_FORALL_THM] HAS_REAL_DERIVATIVE_RPOW))))));; let HAS_REAL_DERIVATIVE_RPOW_RIGHT = prove (`!a x. &0 < a ==> ((\x. a rpow x) has_real_derivative log(a) * a rpow x) (atreal x)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[rpow] THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC);; add_real_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN (SPEC `a:real` HAS_REAL_DERIVATIVE_RPOW_RIGHT))));; let REAL_DIFFERENTIABLE_AT_RPOW = prove (`!x y. ~(x = &0) ==> (\x. x rpow y) real_differentiable atreal x`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_ARITH `~(x = &0) <=> &0 < x \/ &0 < --x`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_TRANSFORM_ATREAL THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `abs x` THENL [EXISTS_TAC `\x. exp(y * log x)` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs x`] THEN CONJ_TAC THENL [X_GEN_TAC `z:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < z` (fun th -> REWRITE_TAC[rpow; th]) THEN ASM_REAL_ARITH_TAC; REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC]; ASM_CASES_TAC `?m n. ODD m /\ ODD n /\ abs y = &m / &n` THENL [EXISTS_TAC `\x. --(exp(y * log(--x)))`; EXISTS_TAC `\x. exp(y * log(--x))`] THEN (ASM_SIMP_TAC[REAL_ARITH `&0 < --x ==> &0 < abs x`] THEN CONJ_TAC THENL [X_GEN_TAC `z:real` THEN DISCH_TAC THEN SUBGOAL_THEN `~(&0 < z) /\ ~(z = &0)` (fun th -> ASM_REWRITE_TAC[rpow; th]) THEN ASM_REAL_ARITH_TAC; REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC])]);; let REAL_DIFFERENTIABLE_AT_RPOW_RIGHT = prove (`!a x. &0 < a ==> (\x. a rpow x) real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_RPOW_RIGHT]);; let REAL_CONTINUOUS_AT_RPOW = prove (`!x y. (x = &0 ==> &0 <= y) ==> (\x. x rpow y) real_continuous (atreal x)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[RPOW_POW; real_pow; REAL_CONTINUOUS_CONST] THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[real_continuous_atreal; RPOW_ZERO] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_ABS_RPOW] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e rpow inv(y)` THEN ASM_SIMP_TAC[RPOW_POS_LT] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e rpow inv y rpow y` THEN CONJ_TAC THENL [MATCH_MP_TAC RPOW_LT2 THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[RPOW_RPOW; REAL_LT_IMP_LE; REAL_MUL_LINV] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LE_REFL]]; ASM_SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; REAL_DIFFERENTIABLE_AT_RPOW]]);; let REAL_CONTINUOUS_WITHIN_RPOW = prove (`!s x y. (x = &0 ==> &0 <= y) ==> (\x. x rpow y) real_continuous (atreal x within s)`, MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_AT_RPOW]);; let REAL_CONTINUOUS_ON_RPOW = prove (`!s y. (&0 IN s ==> &0 <= y) ==> (\x. x rpow y) real_continuous_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN ASM_MESON_TAC[]);; let REAL_CONTINUOUS_AT_RPOW_RIGHT = prove (`!a x. &0 < a ==> (\x. a rpow x) real_continuous (atreal x)`, SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; REAL_DIFFERENTIABLE_AT_RPOW_RIGHT]);; let REALLIM_RPOW = prove (`!net f l n. (f ---> l) net /\ (l = &0 ==> &0 <= n) ==> ((\x. f x rpow n) ---> l rpow n) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC (REWRITE_RULE[] (ISPEC `\x. x rpow n` REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN ASM_REWRITE_TAC[]);; let REALLIM_NULL_POW_EQ = prove (`!net f n. ~(n = 0) ==> (((\x. f x pow n) ---> &0) net <=> (f ---> &0) net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[REALLIM_NULL_POW] THEN DISCH_THEN(MP_TAC o ISPEC `(\x. x rpow (inv(&n))) o abs` o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN REWRITE_TAC[o_THM] THEN ASM_REWRITE_TAC[RPOW_ZERO; REAL_INV_EQ_0; REAL_OF_NUM_EQ; REAL_ABS_NUM] THEN SIMP_TAC[GSYM RPOW_POW; RPOW_RPOW; REAL_ABS_POS; REAL_ABS_RPOW] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN REWRITE_TAC[REALLIM_NULL_ABS; RPOW_POW; REAL_POW_1] THEN DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC REAL_CONTINUOUS_ABS THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID]; MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]]);; let LIM_NULL_COMPLEX_POW_EQ = prove (`!net f n. ~(n = 0) ==> (((\x. f x pow n) --> Cx(&0)) net <=> (f --> Cx(&0)) net)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[COMPLEX_NORM_POW; REAL_TENDSTO; o_DEF; LIFT_DROP] THEN ASM_SIMP_TAC[REALLIM_NULL_POW_EQ; DROP_VEC]);; let LIM_NULL_RPOW = prove (`!net p x:A->real. ((lift o x) --> vec 0) net /\ &0 < p ==> ((\i. lift(x(i) rpow p)) --> vec 0) net`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o ISPEC `lift o (\x. x rpow p) o drop` o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Analytic result for "frac". *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_FRAC = prove (`!x. ~(integer x) ==> (frac has_real_derivative (&1)) (atreal x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL THEN EXISTS_TAC `\y. y - floor x` THEN EXISTS_TAC `min (frac x) (floor x + &1 - x)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_FRAC_POS_LT] THEN REWRITE_TAC[REAL_ARITH `&0 < x + &1 - y <=> y < x + &1`; FLOOR] THEN CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REAL_ARITH_TAC] THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM FRAC_UNIQUE; REAL_ARITH `y - (y - x):real = x`] THEN MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; let REAL_DIFFERENTIABLE_FRAC = prove (`!x. ~(integer x) ==> frac real_differentiable (atreal x)`, REWRITE_TAC[real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_FRAC]);; add_real_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN HAS_REAL_DERIVATIVE_FRAC)));; (* ------------------------------------------------------------------------- *) (* Polynomials are differentiable and continuous. *) (* ------------------------------------------------------------------------- *) let REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL = prove (`!p x. polynomial_function p ==> p real_differentiable atreal x`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC POLYNOMIAL_FUNCTION_INDUCT THEN SIMP_TAC[REAL_DIFFERENTIABLE_CONST; REAL_DIFFERENTIABLE_ID; REAL_DIFFERENTIABLE_ADD; REAL_DIFFERENTIABLE_MUL_ATREAL]);; let REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN = prove (`!p s x. polynomial_function p ==> p real_differentiable atreal x within s`, SIMP_TAC[REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL; REAL_DIFFERENTIABLE_ATREAL_WITHIN]);; let REAL_DIFFERENTIABLE_ON_POLYNOMIAL_FUNCTION = prove (`!p s. polynomial_function p ==> p real_differentiable_on s`, SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN]);; let REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_ATREAL = prove (`!p x. polynomial_function p ==> p real_continuous atreal x`, SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL]);; let REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN = prove (`!p s x. polynomial_function p ==> p real_continuous atreal x within s`, SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL; REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN]);; let REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION = prove (`!p s. polynomial_function p ==> p real_continuous_on s`, SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Intermediate Value Theorem. *) (* ------------------------------------------------------------------------- *) let REAL_IVT_INCREASING = prove (`!f a b y. a <= b /\ f real_continuous_on real_interval[a,b] /\ f a <= y /\ y <= f b ==> ?x. x IN real_interval [a,b] /\ f x = y`, REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `y:real`; `1`] IVT_INCREASING_COMPONENT_ON_1) THEN ASM_REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP; DIMINDEX_1; LE_REFL] THEN REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; EXISTS_IN_IMAGE; LIFT_DROP]);; let REAL_IVT_DECREASING = prove (`!f a b y. a <= b /\ f real_continuous_on real_interval[a,b] /\ f b <= y /\ y <= f a ==> ?x. x IN real_interval [a,b] /\ f x = y`, REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `y:real`; `1`] IVT_DECREASING_COMPONENT_ON_1) THEN ASM_REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP; DIMINDEX_1; LE_REFL] THEN REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; EXISTS_IN_IMAGE; LIFT_DROP]);; let IS_REALINTERVAL_CONTINUOUS_IMAGE = prove (`!s. f real_continuous_on s /\ is_realinterval s ==> is_realinterval(IMAGE f s)`, GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; IS_REALINTERVAL_CONNECTED] THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_CONTINUOUS_IMAGE) THEN REWRITE_TAC[IMAGE_o; REWRITE_RULE[IMAGE_o] IMAGE_LIFT_DROP]);; (* ------------------------------------------------------------------------- *) (* Zeroness (or sign at boundary) of derivative at local extremum. *) (* ------------------------------------------------------------------------- *) let REAL_DERIVATIVE_POS_LEFT_MINIMUM = prove (`!f f' a b e. a < b /\ &0 < e /\ (f has_real_derivative f') (atreal a within real_interval[a,b]) /\ (!x. x IN real_interval[a,b] /\ abs(x - a) < e ==> f a <= f x) ==> &0 <= f'`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; `lift a`; `interval[lift a,lift b]`; `e:real`] DROP_DIFFERENTIAL_POS_AT_MINIMUM) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `b:real`) THEN ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ; REAL_SUB_LT]);; let REAL_DERIVATIVE_NEG_LEFT_MAXIMUM = prove (`!f f' a b e. a < b /\ &0 < e /\ (f has_real_derivative f') (atreal a within real_interval[a,b]) /\ (!x. x IN real_interval[a,b] /\ abs(x - a) < e ==> f x <= f a) ==> f' <= &0`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; `lift a`; `interval[lift a,lift b]`; `e:real`] DROP_DIFFERENTIAL_NEG_AT_MAXIMUM) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `b:real`) THEN ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ; REAL_SUB_LT; REAL_ARITH `f * ba <= &0 <=> &0 <= --f * ba`] THEN REAL_ARITH_TAC);; let REAL_DERIVATIVE_POS_RIGHT_MAXIMUM = prove (`!f f' a b e. a < b /\ &0 < e /\ (f has_real_derivative f') (atreal b within real_interval[a,b]) /\ (!x. x IN real_interval[a,b] /\ abs(x - b) < e ==> f x <= f b) ==> &0 <= f'`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; `lift b`; `interval[lift a,lift b]`; `e:real`] DROP_DIFFERENTIAL_NEG_AT_MAXIMUM) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `a:real`) THEN ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ; REAL_SUB_LT; REAL_ARITH `f * (a - b) <= &0 <=> &0 <= f * (b - a)`]);; let REAL_DERIVATIVE_NEG_RIGHT_MINIMUM = prove (`!f f' a b e. a < b /\ &0 < e /\ (f has_real_derivative f') (atreal b within real_interval[a,b]) /\ (!x. x IN real_interval[a,b] /\ abs(x - b) < e ==> f b <= f x) ==> f' <= &0`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; `lift b`; `interval[lift a,lift b]`; `e:real`] DROP_DIFFERENTIAL_POS_AT_MINIMUM) THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `a:real`) THEN ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP] THEN ONCE_REWRITE_TAC[REAL_ARITH `&0 <= f * (a - b) <=> &0 <= --f * (b - a)`] THEN ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_SUB_LT] THEN REAL_ARITH_TAC);; let REAL_DERIVATIVE_ZERO_MAXMIN = prove (`!f f' x s. x IN s /\ real_open s /\ (f has_real_derivative f') (atreal x) /\ ((!y. y IN s ==> f y <= f x) \/ (!y. y IN s ==> f x <= f y)) ==> f' = &0`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; `lift x`; `IMAGE lift s`] DIFFERENTIAL_ZERO_MAXMIN) THEN ASM_REWRITE_TAC[GSYM HAS_REAL_FRECHET_DERIVATIVE_AT; GSYM REAL_OPEN] THEN ASM_SIMP_TAC[FUN_IN_IMAGE; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN(MP_TAC o C AP_THM `vec 1:real^1`) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; REAL_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Rolle and Mean Value Theorem. *) (* ------------------------------------------------------------------------- *) let REAL_ROLLE = prove (`!f f' a b. a < b /\ f a = f b /\ f real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) ==> (f has_real_derivative f'(x)) (atreal x)) ==> ?x. x IN real_interval(a,b) /\ f'(x) = &0`, REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[REAL_CONTINUOUS_ON; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP; has_vector_derivative] THEN REWRITE_TAC[LIFT_DROP] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1 h:real^1. f'(drop x) % h`; `lift a`; `lift b`] ROLLE) THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN ANTS_TAC THENL [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; LIFT_DROP; GSYM LIFT_CMUL] THEN REWRITE_TAC[REAL_MUL_AC]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o C AP_THM `lift(&1)`) THEN REWRITE_TAC[GSYM LIFT_CMUL; GSYM LIFT_NUM; LIFT_EQ; REAL_MUL_RID]]);; let REAL_MVT = prove (`!f f' a b. a < b /\ f real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) ==> (f has_real_derivative f'(x)) (atreal x)) ==> ?x. x IN real_interval(a,b) /\ f(b) - f(a) = f'(x) * (b - a)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x:real. f(x) - (f b - f a) / (b - a) * x`; `(\x. f'(x) - (f b - f a) / (b - a)):real->real`; `a:real`; `b:real`] REAL_ROLLE) THEN ASM_SIMP_TAC[REAL_FIELD `a < b ==> (fx - fba / (b - a) = &0 <=> fba = fx * (b - a))`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_LMUL; REAL_CONTINUOUS_ON_ID] THEN CONJ_TAC THENL [UNDISCH_TAC `a < b` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_LMUL_ATREAL; HAS_REAL_DERIVATIVE_ID]);; let REAL_MVT_SIMPLE = prove (`!f f' a b. a < b /\ (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) ==> ?x. x IN real_interval(a,b) /\ f(b) - f(a) = f'(x) * (b - a)`, MP_TAC REAL_MVT THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN ASM_MESON_TAC[real_differentiable_on; real_differentiable]; ASM_MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN; REAL_OPEN_REAL_INTERVAL; REAL_INTERVAL_OPEN_SUBSET_CLOSED; HAS_REAL_DERIVATIVE_WITHIN_SUBSET; SUBSET]]);; let REAL_MVT_VERY_SIMPLE = prove (`!f f' a b. a <= b /\ (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) ==> ?x. x IN real_interval[a,b] /\ f(b) - f(a) = f'(x) * (b - a)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real = a` THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_INTERVAL_SING; IN_SING; EXISTS_REFL]; ASM_REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_MVT_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REWRITE_RULE[SUBSET] REAL_INTERVAL_OPEN_SUBSET_CLOSED]]);; let REAL_ROLLE_SIMPLE = prove (`!f f' a b. a < b /\ f a = f b /\ (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) ==> ?x. x IN real_interval(a,b) /\ f'(x) = &0`, MP_TAC REAL_MVT_SIMPLE THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[REAL_RING `a - a = b * (c - d) <=> b = &0 \/ c = d`] THEN ASM_MESON_TAC[REAL_LT_REFL]);; (* ------------------------------------------------------------------------- *) (* Cauchy MVT and l'Hospital's rule. *) (* ------------------------------------------------------------------------- *) let REAL_MVT_CAUCHY = prove (`!f g f' g' a b. a < b /\ f real_continuous_on real_interval[a,b] /\ g real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) ==> (f has_real_derivative f' x) (atreal x) /\ (g has_real_derivative g' x) (atreal x)) ==> ?x. x IN real_interval(a,b) /\ (f b - f a) * g'(x) = (g b - g a) * f'(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. (f:real->real)(x) * (g(b:real) - g(a)) - g(x) * (f(b) - f(a))`; `\x. (f':real->real)(x) * (g(b:real) - g(a)) - g'(x) * (f(b) - f(a))`; `a:real`; `b:real`] REAL_MVT) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_RMUL; HAS_REAL_DERIVATIVE_SUB; HAS_REAL_DERIVATIVE_RMUL_ATREAL] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN UNDISCH_TAC `a < b` THEN CONV_TAC REAL_FIELD);; let LHOSPITAL = prove (`!f g f' g' c l d. &0 < d /\ (!x. &0 < abs(x - c) /\ abs(x - c) < d ==> (f has_real_derivative f'(x)) (atreal x) /\ (g has_real_derivative g'(x)) (atreal x) /\ ~(g'(x) = &0)) /\ (f ---> &0) (atreal c) /\ (g ---> &0) (atreal c) /\ ((\x. f'(x) / g'(x)) ---> l) (atreal c) ==> ((\x. f(x) / g(x)) ---> l) (atreal c)`, SUBGOAL_THEN `!f g f' g' c l d. &0 < d /\ (!x. &0 < abs(x - c) /\ abs(x - c) < d ==> (f has_real_derivative f'(x)) (atreal x) /\ (g has_real_derivative g'(x)) (atreal x) /\ ~(g'(x) = &0)) /\ f(c) = &0 /\ g(c) = &0 /\ (f ---> &0) (atreal c) /\ (g ---> &0) (atreal c) /\ ((\x. f'(x) / g'(x)) ---> l) (atreal c) ==> ((\x. f(x) / g(x)) ---> l) (atreal c)` ASSUME_TAC THENL [REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(!x. abs(x - c) < d ==> f real_continuous atreal x) /\ (!x. abs(x - c) < d ==> g real_continuous atreal x)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `x:real` THEN DISJ_CASES_TAC(REAL_ARITH `x = c \/ &0 < abs(x - c)`) THENL [ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN REWRITE_TAC[real_differentiable] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. &0 < abs(x - c) /\ abs(x - c) < d ==> ~(g x = &0)` STRIP_ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `c < x \/ x < c` DISJ_CASES_TAC THENL [ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`g:real->real`; `g':real->real`; `c:real`; `x:real`] REAL_ROLLE); MP_TAC(ISPECL [`g:real->real`; `g':real->real`; `x:real`; `c:real`] REAL_ROLLE)] THEN ASM_REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN (REPEAT CONJ_TAC THENL [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL; REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC; X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC); ALL_TAC] THEN UNDISCH_TAC `((\x. f' x / g' x) ---> l) (atreal c)` THEN REWRITE_TAC[REALLIM_ATREAL] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN SUBGOAL_THEN `?y. &0 < abs(y - c) /\ abs(y - c) < abs(x - c) /\ (f:real->real) x / g x = f' y / g' y` STRIP_ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_TRANS]] THEN SUBGOAL_THEN `c < x \/ x < c` DISJ_CASES_TAC THENL [ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`f:real->real`; `g:real->real`; `f':real->real`; `g':real->real`; `c:real`; `x:real`] REAL_MVT_CAUCHY); MP_TAC(ISPECL [`f:real->real`; `g:real->real`; `f':real->real`; `g':real->real`; `x:real`; `c:real`] REAL_MVT_CAUCHY)] THEN (ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL; REPEAT STRIP_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_SUB_RZERO] THEN GEN_TAC THEN STRIP_TAC THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC(REAL_FIELD `f * g' = g * f' /\ ~(g = &0) /\ ~(g' = &0) ==> f / g = f' / g'`) THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; CONJ_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]); REPEAT GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\x:real. if x = c then &0 else f(x)`; `\x:real. if x = c then &0 else g(x)`; `f':real->real`; `g':real->real`; `c:real`; `l:real`; `d:real`]) THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN TRY(SIMP_TAC[REALLIM_ATREAL;REAL_ARITH `&0 < abs(x - c) ==> ~(x = c)`] THEN NO_TAC) THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL) THEN EXISTS_TAC `abs(x - c)` THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Darboux's theorem (intermediate value property for derivatives). *) (* ------------------------------------------------------------------------- *) let REAL_DERIVATIVE_IVT_INCREASING = prove (`!f f' a b. a <= b /\ (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) ==> !t. f'(a) <= t /\ t <= f'(b) ==> ?x. x IN real_interval[a,b] /\ f' x = t`, REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN ASM_CASES_TAC `(f':real->real) a = t` THENL [ASM_MESON_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `(f':real->real) b = t` THENL [ASM_MESON_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `b:real = a` THEN ASM_REWRITE_TAC[REAL_LE_ANTISYM] THEN SUBGOAL_THEN `a < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x:real. f x - t * x`; `real_interval[a,b]`] REAL_CONTINUOUS_ATTAINS_INF) THEN ASM_REWRITE_TAC[REAL_INTERVAL_NE_EMPTY; REAL_COMPACT_INTERVAL] THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_SUB THEN SIMP_TAC[REAL_DIFFERENTIABLE_ON_MUL; REAL_DIFFERENTIABLE_ON_ID; REAL_DIFFERENTIABLE_ON_CONST] THEN ASM_MESON_TAC[real_differentiable_on]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPECL [`\x:real. f x - t * x`; `(f':real->real) x - t:real`; `x:real`; `real_interval(a,b)`] REAL_DERIVATIVE_ZERO_MAXMIN) THEN ASM_REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_OPEN_REAL_INTERVAL] THEN ASM_SIMP_TAC[REAL_OPEN_CLOSED_INTERVAL; IN_DIFF] THEN ASM_CASES_TAC `x:real = a` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN MP_TAC(ISPECL[`\x:real. f x - t * x`; `(f':real->real) a - t:real`; `a:real`; `b:real`; `&1`] REAL_DERIVATIVE_POS_LEFT_MINIMUM) THEN ASM_SIMP_TAC[REAL_LT_01; REAL_SUB_LE] THEN MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `x:real = b` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN MP_TAC(ISPECL[`\x:real. f x - t * x`; `(f':real->real) b - t:real`; `a:real`; `b:real`; `&1`] REAL_DERIVATIVE_NEG_RIGHT_MINIMUM) THEN ASM_SIMP_TAC[REAL_LT_01; REAL_SUB_LE] THEN MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN ASM_REWRITE_TAC[REAL_NOT_LE; REAL_SUB_LT] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY]; ALL_TAC] THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN SUBGOAL_THEN `(f has_real_derivative f' x) (atreal x within real_interval(a,b))` MP_TAC THENL [MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `real_interval[a,b]` THEN ASM_SIMP_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED]; MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN THEN REWRITE_TAC[REAL_OPEN_REAL_INTERVAL] THEN ASM_REWRITE_TAC[REAL_OPEN_CLOSED_INTERVAL] THEN ASM SET_TAC[]]);; let REAL_DERIVATIVE_IVT_DECREASING = prove (`!f f' a b t. a <= b /\ (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) ==> !t. f'(b) <= t /\ t <= f'(a) ==> ?x. x IN real_interval[a,b] /\ f' x = t`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. --((f:real->real) x)`; `\x. --((f':real->real) x)`; `a:real`; `b:real`] REAL_DERIVATIVE_IVT_INCREASING) THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG] THEN DISCH_THEN(MP_TAC o SPEC `--t:real`) THEN ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2]);; (* ------------------------------------------------------------------------- *) (* Continuity and differentiability of inverse functions. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_INVERSE_BASIC = prove (`!f g f' t y. (f has_real_derivative f') (atreal (g y)) /\ ~(f' = &0) /\ g real_continuous atreal y /\ real_open t /\ y IN t /\ (!z. z IN t ==> f (g z) = z) ==> (g has_real_derivative inv(f')) (atreal y)`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN; REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC THEN MAP_EVERY EXISTS_TAC [`lift o f o drop`; `\x:real^1. f' % x`; `IMAGE lift t`] THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; LIFT_DROP; LINEAR_COMPOSE_CMUL; LINEAR_ID] THEN REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]);; let HAS_REAL_DERIVATIVE_INVERSE_STRONG = prove (`!f g f' s x. real_open s /\ x IN s /\ f real_continuous_on s /\ (!x. x IN s ==> g (f x) = x) /\ (f has_real_derivative f') (atreal x) /\ ~(f' = &0) ==> (g has_real_derivative inv(f')) (atreal (f x))`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN; REAL_CONTINUOUS_ON] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `lift o f o drop` HAS_DERIVATIVE_INVERSE_STRONG) THEN REWRITE_TAC[FORALL_LIFT; o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`\x:real^1. f' % x`; `IMAGE lift s`] THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN ASM_SIMP_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]);; let HAS_REAL_DERIVATIVE_INVERSE_STRONG_X = prove (`!f g f' s y. real_open s /\ (g y) IN s /\ f real_continuous_on s /\ (!x. x IN s ==> (g(f(x)) = x)) /\ (f has_real_derivative f') (atreal (g y)) /\ ~(f' = &0) /\ f(g y) = y ==> (g has_real_derivative inv(f')) (atreal y)`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN; REAL_CONTINUOUS_ON] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `lift o f o drop` HAS_DERIVATIVE_INVERSE_STRONG_X) THEN REWRITE_TAC[FORALL_LIFT; o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`\x:real^1. f' % x`; `IMAGE lift s`] THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN ASM_SIMP_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Real differentiation of sequences and series. *) (* ------------------------------------------------------------------------- *) let HAS_REAL_DERIVATIVE_SEQUENCE = prove (`!s f f' g'. is_realinterval s /\ (!n x. x IN s ==> (f n has_real_derivative f' n x) (atreal x within s)) /\ (!e. &0 < e ==> ?N. !n x. n >= N /\ x IN s ==> abs(f' n x - g' x) <= e) /\ (?x l. x IN s /\ ((\n. f n x) ---> l) sequentially) ==> ?g. !x. x IN s ==> ((\n. f n x) ---> g x) sequentially /\ (g has_real_derivative g' x) (atreal x within s)`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; IS_REALINTERVAL_CONVEX; TENDSTO_REAL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE lift s`; `\n:num. lift o f n o drop`; `\n:num x:real^1 h:real^1. f' n (drop x) % h`; `\x:real^1 h:real^1. g' (drop x) % h`] HAS_DERIVATIVE_SEQUENCE) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN ANTS_TAC THENL [REWRITE_TAC[IMP_CONJ; RIGHT_EXISTS_AND_THM; RIGHT_FORALL_IMP_THM; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[EXISTS_LIFT; o_THM; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]; REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN(X_CHOOSE_TAC `g:real^1->real^1`) THEN EXISTS_TAC `drop o g o lift` THEN RULE_ASSUM_TAC(REWRITE_RULE[ETA_AX]) THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; let HAS_REAL_DERIVATIVE_SERIES = prove (`!s f f' g' k. is_realinterval s /\ (!n x. x IN s ==> (f n has_real_derivative f' n x) (atreal x within s)) /\ (!e. &0 < e ==> ?N. !n x. n >= N /\ x IN s ==> abs(sum (k INTER (0..n)) (\i. f' i x) - g' x) <= e) /\ (?x l. x IN s /\ ((\n. f n x) real_sums l) k) ==> ?g. !x. x IN s ==> ((\n. f n x) real_sums g x) k /\ (g has_real_derivative g' x) (atreal x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SEQUENCE THEN EXISTS_TAC `\n:num x:real. sum(k INTER (0..n)) (\n. f' n x):real` THEN ASM_SIMP_TAC[ETA_AX; FINITE_INTER_NUMSEG; HAS_REAL_DERIVATIVE_SUM]);; let REAL_DIFFERENTIABLE_BOUND = prove (`!f f' s B. is_realinterval s /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s) /\ abs(f' x) <= B) ==> !x y. x IN s /\ y IN s ==> abs(f x - f y) <= B * abs(x - y)`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; IS_REALINTERVAL_CONVEX; o_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\x h:real^1. f' (drop x) % h`; `IMAGE lift s`; `B:real`] DIFFERENTIABLE_BOUND) THEN ASM_SIMP_TAC[o_DEF; FORALL_IN_IMAGE; LIFT_DROP] THEN ANTS_TAC THENL [X_GEN_TAC `v:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `\h:real^1. f' (v:real) % h` ONORM) THEN SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_SIMP_TAC[NORM_MUL; REAL_LE_RMUL; NORM_POS_LE]; SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; LIFT_DROP] THEN ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM LIFT_SUB; NORM_LIFT]]);; let REAL_TAYLOR_MVT_POS = prove (`!f a x n. a < x /\ (!i t. t IN real_interval[a,x] /\ i <= n ==> ((f i) has_real_derivative f (i + 1) t) (atreal t within real_interval[a,x])) ==> ?t. t IN real_interval(a,x) /\ f 0 x = sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) + f (n + 1) t * (x - a) pow (n + 1) / &(FACT(n + 1))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?B. sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) + B * (x - a) pow (n + 1) = f 0 x` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC(MESON[] `a + (y - a) / x * x:real = y ==> ?b. a + b * x = y`) THEN MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> a + (y - a) / x * x = y`) THEN ASM_REWRITE_TAC[REAL_POW_EQ_0; REAL_SUB_0] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPECL [`\t. sum(0..n) (\i. f i t * (x - t) pow i / &(FACT i)) + B * (x - t) pow (n + 1)`; `\t. (f (n + 1) t * (x - t) pow n / &(FACT n)) - B * &(n + 1) * (x - t) pow n`; `a:real`; `x:real`] REAL_ROLLE_SIMPLE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN REWRITE_TAC[GSYM ADD1; real_pow; REAL_SUB_REFL; REAL_POW_ZERO; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[NOT_SUC; REAL_MUL_RZERO; REAL_DIV_1; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `x = (x + y) + &0 <=> y = &0`] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN SIMP_TAC[ARITH; ARITH_RULE `1 <= i ==> ~(i = 0)`] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]; ALL_TAC] THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[real_sub] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_ADD THEN CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[ADD_SUB] THEN CONV_TAC REAL_RING] THEN REWRITE_TAC[GSYM real_sub] THEN MATCH_MP_TAC(MESON[] `!g'. f' = g' /\ (f has_real_derivative g') net ==> (f has_real_derivative f') net`) THEN EXISTS_TAC `sum (0..n) (\i. f i t * --(&i * (x - t) pow (i - 1)) / &(FACT i) + f (i + 1) t * (x - t) pow i / &(FACT i))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_MUL_WITHIN THEN ASM_SIMP_TAC[ETA_AX] THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH; FACT; REAL_DIV_1; real_pow; REAL_MUL_LZERO; REAL_NEG_0; REAL_MUL_RZERO; REAL_MUL_RID; REAL_ADD_LID] THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; FACT] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[SPECL [`f:num->real`; `1`] SUM_OFFSET_0; LE_1] THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `--(n * x) * (inv n * inv y):real = --(n / n) * x / y`] THEN REWRITE_TAC[REAL_FIELD `--((&n + &1) / (&n + &1)) * x = --x`] THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_OF_NUM_MUL; REAL_OF_NUM_SUC] THEN REWRITE_TAC[GSYM(CONJUNCT2 FACT)] THEN REWRITE_TAC[REAL_ARITH `a * --b + c:real = c - a * b`] THEN REWRITE_TAC[ADD1; GSYM real_div; SUM_DIFFS_ALT; LE_0] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`; FACT] THEN REWRITE_TAC[ADD_CLAUSES] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[REAL_ARITH `a * b / c:real = a / c * b`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `a * x / f - B * k * x = &0 ==> (B * k - a / f) * x = &0`)) THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_SUB_0] THEN ASM_CASES_TAC `x:real = t` THENL [ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LT_REFL]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM ADD1; FACT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; ADD1] THEN SUBGOAL_THEN `~(&(FACT n) = &0)` MP_TAC THENL [REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ]; CONV_TAC REAL_FIELD]);; let REAL_TAYLOR_MVT_NEG = prove (`!f a x n. x < a /\ (!i t. t IN real_interval[x,a] /\ i <= n ==> ((f i) has_real_derivative f (i + 1) t) (atreal t within real_interval[x,a])) ==> ?t. t IN real_interval(x,a) /\ f 0 x = sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) + f (n + 1) t * (x - a) pow (n + 1) / &(FACT(n + 1))`, REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[REAL_NEG_NEG] `(?x:real. P x) <=> (?x. P(--x))`] THEN MP_TAC(SPECL [`\n x. (-- &1) pow n * (f:num->real->real) n (--x)`; `--a:real`; ` --x:real`; `n:num`] REAL_TAYLOR_MVT_POS) THEN REWRITE_TAC[REAL_NEG_NEG] THEN ONCE_REWRITE_TAC[REAL_ARITH `(x * y) * z / w:real = y * (x * z) / w`] THEN REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_ARITH `-- &1 * (--x - --a) = x - a`] THEN REWRITE_TAC[IN_REAL_INTERVAL; real_pow; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `--a < t /\ t < --x <=> x < --t /\ --t < a`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LT_NEG2] THEN MAP_EVERY X_GEN_TAC [`m:num`; `t:real`] THEN STRIP_TAC THEN REWRITE_TAC[REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_LMUL_WITHIN THEN ONCE_REWRITE_TAC[REAL_ARITH `y pow 1 * x:real = x * y`] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REAL_DIFF_TAC THEN REFL_TAC; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (--) (real_interval[--a,--x]) = real_interval[x,a]` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`; UNWIND_THM1] THEN REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; let REAL_TAYLOR = prove (`!f n s B. is_realinterval s /\ (!i x. x IN s /\ i <= n ==> ((f i) has_real_derivative f (i + 1) x) (atreal x within s)) /\ (!x. x IN s ==> abs(f (n + 1) x) <= B) ==> !w z. w IN s /\ z IN s ==> abs(f 0 z - sum (0..n) (\i. f i w * (z - w) pow i / &(FACT i))) <= B * abs(z - w) pow (n + 1) / &(FACT(n + 1))`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `w = z \/ w < z \/ z < w`) THENL [ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; REAL_SUB_REFL; REAL_POW_ZERO; REAL_ABS_0; ARITH; ADD_EQ_0; real_div] THEN REWRITE_TAC[REAL_MUL_LZERO; FACT; REAL_INV_1; REAL_MUL_RZERO] THEN MATCH_MP_TAC(REAL_ARITH `y = &0 ==> abs(x - (x * &1 * &1 + y)) <= &0`) THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN SIMP_TAC[ARITH; LE_1; REAL_MUL_RZERO; REAL_MUL_LZERO]; MP_TAC(ISPECL [`f:num->real->real`; `w:real`; `z:real`; `n:num`] REAL_TAYLOR_MVT_POS) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `real_interval[w,z] SUBSET s` ASSUME_TAC THENL [SIMP_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_MESON_TAC[is_realinterval]; ALL_TAC]; MP_TAC(ISPECL [`f:num->real->real`; `w:real`; `z:real`; `n:num`] REAL_TAYLOR_MVT_NEG) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `real_interval[z,w] SUBSET s` ASSUME_TAC THENL [SIMP_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_MESON_TAC[is_realinterval]; ALL_TAC]] THEN (ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `t:real`] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[REAL_ADD_SUB; REAL_ABS_MUL; REAL_ABS_DIV] THEN REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_POW_LE; REAL_ABS_POS] THEN ASM_MESON_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]));; (* ------------------------------------------------------------------------- *) (* Comparing sums and "integrals" via real antiderivatives. *) (* ------------------------------------------------------------------------- *) let REAL_SUM_INTEGRAL_UBOUND_INCREASING = prove (`!f g m n. m <= n /\ (!x. x IN real_interval[&m,&n + &1] ==> (g has_real_derivative f(x)) (atreal x within real_interval[&m,&n + &1])) /\ (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> f x <= f y) ==> sum(m..n) (\k. f(&k)) <= g(&n + &1) - g(&m)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m..n) (\k. g(&(k + 1)) - g(&k))` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DIFFS_ALT; REAL_OF_NUM_ADD; REAL_LE_REFL]] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real->real`; `f:real->real`; `&k`; `&(k + 1)`] REAL_MVT_SIMPLE) THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; ARITH_RULE `k < k + 1`] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_SUB] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `real_interval[&m,&n + &1]` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]); REWRITE_TAC[SUBSET] THEN GEN_TAC] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[REAL_MUL_RID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC]);; let REAL_SUM_INTEGRAL_UBOUND_DECREASING = prove (`!f g m n. m <= n /\ (!x. x IN real_interval[&m - &1,&n] ==> (g has_real_derivative f(x)) (atreal x within real_interval[&m - &1,&n])) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> f y <= f x) ==> sum(m..n) (\k. f(&k)) <= g(&n) - g(&m - &1)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(m..n) (\k. g(&(k + 1) - &1) - g(&k - &1))` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[SUM_DIFFS_ALT] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN REWRITE_TAC[REAL_LE_REFL]] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`g:real->real`; `f:real->real`; `&k - &1`; `&k`] REAL_MVT_SIMPLE) THEN ASM_REWRITE_TAC[REAL_ARITH `k - &1 < k`] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `real_interval[&m - &1,&n]` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]); REWRITE_TAC[SUBSET] THEN GEN_TAC] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(a + &1) - &1 = a`] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[REAL_ARITH `a * (x - (x - &1)) = a`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC]);; let REAL_SUM_INTEGRAL_LBOUND_INCREASING = prove (`!f g m n. m <= n /\ (!x. x IN real_interval[&m - &1,&n] ==> (g has_real_derivative f(x)) (atreal x within real_interval[&m - &1,&n])) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> f x <= f y) ==> g(&n) - g(&m - &1) <= sum(m..n) (\k. f(&k))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. --((f:real->real) z)`; `\z. --((g:real->real) z)`; `m:num`; `n:num`] REAL_SUM_INTEGRAL_UBOUND_DECREASING) THEN REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; REAL_ARITH `--x - --y:real = --(x - y)`] THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG]);; let REAL_SUM_INTEGRAL_LBOUND_DECREASING = prove (`!f g m n. m <= n /\ (!x. x IN real_interval[&m,&n + &1] ==> (g has_real_derivative f(x)) (atreal x within real_interval[&m,&n + &1])) /\ (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> f y <= f x) ==> g(&n + &1) - g(&m) <= sum(m..n) (\k. f(&k))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\z. --((f:real->real) z)`; `\z. --((g:real->real) z)`; `m:num`; `n:num`] REAL_SUM_INTEGRAL_UBOUND_INCREASING) THEN REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; REAL_ARITH `--x - --y:real = --(x - y)`] THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG]);; let REAL_SUM_INTEGRAL_BOUNDS_INCREASING = prove (`!f g m n. m <= n /\ (!x. x IN real_interval[&m - &1,&n + &1] ==> (g has_real_derivative f x) (atreal x within real_interval[&m - &1,&n + &1])) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> f x <= f y) ==> g(&n) - g(&m - &1) <= sum(m..n) (\k. f(&k)) /\ sum (m..n) (\k. f(&k)) <= g(&n + &1) - g(&m)`, REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_SUM_INTEGRAL_LBOUND_INCREASING; MATCH_MP_TAC REAL_SUM_INTEGRAL_UBOUND_INCREASING] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRY(MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `real_interval[&m - &1,&n + &1]` THEN CONJ_TAC) THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN TRY(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL])) THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; let REAL_SUM_INTEGRAL_BOUNDS_DECREASING = prove (`!f g m n. m <= n /\ (!x. x IN real_interval[&m - &1,&n + &1] ==> (g has_real_derivative f(x)) (atreal x within real_interval[&m - &1,&n + &1])) /\ (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> f y <= f x) ==> g(&n + &1) - g(&m) <= sum(m..n) (\k. f(&k)) /\ sum(m..n) (\k. f(&k)) <= g(&n) - g(&m - &1)`, REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_SUM_INTEGRAL_LBOUND_DECREASING; MATCH_MP_TAC REAL_SUM_INTEGRAL_UBOUND_DECREASING] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRY(MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `real_interval[&m - &1,&n + &1]` THEN CONJ_TAC) THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN TRY(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL])) THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Relating different kinds of real limits. *) (* ------------------------------------------------------------------------- *) let REALLIM_POSINFINITY_SEQUENTIALLY = prove (`!f l. (f ---> l) at_posinfinity ==> ((\n. f(&n)) ---> l) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_POSINFINITY_SEQUENTIALLY) THEN REWRITE_TAC[o_DEF]);; let LIM_ZERO_POSINFINITY = prove (`!f l. ((\x. f(&1 / x)) --> l) (atreal (&0)) ==> (f --> l) at_posinfinity`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_ATREAL; LIM_AT_POSINFINITY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[dist; REAL_SUB_RZERO; real_ge] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&2 / d` THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(z):real`) THEN REWRITE_TAC[real_div; REAL_MUL_LINV; REAL_INV_INV] THEN REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_INV; REAL_LT_INV_EQ] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `a <= z ==> &0 < a ==> &0 < abs z`)); GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `&2 / d <= z ==> &0 < &2 / d ==> inv d < abs z`))] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]);; let LIM_ZERO_NEGINFINITY = prove (`!f l. ((\x. f(&1 / x)) --> l) (atreal (&0)) ==> (f --> l) at_neginfinity`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_ATREAL; LIM_AT_NEGINFINITY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[dist; REAL_SUB_RZERO; real_ge] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `--(&2 / d)` THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(z):real`) THEN REWRITE_TAC[real_div; REAL_MUL_LINV; REAL_INV_INV] THEN REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_INV; REAL_LT_INV_EQ] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `z <= --a ==> &0 < a ==> &0 < abs z`)); GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `z <= --(&2 / d) ==> &0 < &2 / d ==> inv d < abs z`))] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]);; let REALLIM_ZERO_POSINFINITY = prove (`!f l. ((\x. f(&1 / x)) ---> l) (atreal (&0)) ==> (f ---> l) at_posinfinity`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN REWRITE_TAC[o_DEF; LIM_ZERO_POSINFINITY]);; let REALLIM_ZERO_NEGINFINITY = prove (`!f l. ((\x. f(&1 / x)) ---> l) (atreal (&0)) ==> (f ---> l) at_neginfinity`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN REWRITE_TAC[o_DEF; LIM_ZERO_NEGINFINITY]);; (* ------------------------------------------------------------------------- *) (* Real segments (bidirectional intervals). *) (* ------------------------------------------------------------------------- *) let closed_real_segment = define `closed_real_segment[a,b] = {(&1 - u) * a + u * b | &0 <= u /\ u <= &1}`;; let open_real_segment = new_definition `open_real_segment(a,b) = closed_real_segment[a,b] DIFF {a,b}`;; make_overloadable "real_segment" `:A`;; overload_interface("real_segment",`open_real_segment`);; overload_interface("real_segment",`closed_real_segment`);; let real_segment = prove (`real_segment[a,b] = {(&1 - u) * a + u * b | &0 <= u /\ u <= &1} /\ real_segment(a,b) = real_segment[a,b] DIFF {a,b}`, REWRITE_TAC[open_real_segment; closed_real_segment]);; let REAL_SEGMENT_SEGMENT = prove (`(!a b. real_segment[a,b] = IMAGE drop (segment[lift a,lift b])) /\ (!a b. real_segment(a,b) = IMAGE drop (segment(lift a,lift b)))`, REWRITE_TAC[segment; real_segment] THEN SIMP_TAC[IMAGE_DIFF_INJ; DROP_EQ; IMAGE_CLAUSES; LIFT_DROP] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP]);; let SEGMENT_REAL_SEGMENT = prove (`(!a b. segment[a,b] = IMAGE lift (real_segment[drop a,drop b])) /\ (!a b. segment(a,b) = IMAGE lift (real_segment(drop a,drop b)))`, REWRITE_TAC[REAL_SEGMENT_SEGMENT; GSYM IMAGE_o] THEN REWRITE_TAC[o_DEF; IMAGE_ID; LIFT_DROP]);; let IMAGE_LIFT_REAL_SEGMENT = prove (`(!a b. IMAGE lift (real_segment[a,b]) = segment[lift a,lift b]) /\ (!a b. IMAGE lift (real_segment(a,b)) = segment(lift a,lift b))`, REWRITE_TAC[SEGMENT_REAL_SEGMENT; LIFT_DROP]);; let REAL_SEGMENT_INTERVAL = prove (`(!a b. real_segment[a,b] = if a <= b then real_interval[a,b] else real_interval[b,a]) /\ (!a b. real_segment(a,b) = if a <= b then real_interval(a,b) else real_interval(b,a))`, REWRITE_TAC[REAL_SEGMENT_SEGMENT; SEGMENT_1; LIFT_DROP] THEN REWRITE_TAC[REAL_INTERVAL_INTERVAL] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[]);; let REAL_CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove (`!f s. f real_continuous_on s /\ is_realinterval s ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> (!x y. x IN s /\ y IN s /\ x < y ==> f x < f y) \/ (!x y. x IN s /\ y IN s /\ x < y ==> f y < f x))`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; IS_REALINTERVAL_IS_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IFF_MONOTONIC) THEN REWRITE_TAC[FORALL_LIFT; LIFT_IN_IMAGE_LIFT; o_THM; LIFT_DROP; LIFT_EQ]);; let ENDS_IN_REAL_SEGMENT = prove (`!a b. a IN real_segment[a,b] /\ b IN real_segment[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC);; let IS_REAL_INTERVAL_CONTAINS_SEGMENT = prove (`!s. is_realinterval s <=> !a b. a IN s /\ b IN s ==> real_segment[a,b] SUBSET s`, REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; IS_REALINTERVAL_CONVEX] THEN REWRITE_TAC[REAL_SEGMENT_SEGMENT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE_LIFT_DROP]);; let IS_REALINTERVAL_CONTAINS_SEGMENT_EQ = prove (`!s. is_realinterval s <=> !a b. real_segment [a,b] SUBSET s <=> a IN s /\ b IN s`, MESON_TAC[IS_REAL_INTERVAL_CONTAINS_SEGMENT; SUBSET; ENDS_IN_REAL_SEGMENT]);; let IS_REALINTERVAL_CONTAINS_SEGMENT_IMP = prove (`!s a b. is_realinterval s ==> (real_segment [a,b] SUBSET s <=> a IN s /\ b IN s)`, MESON_TAC[IS_REALINTERVAL_CONTAINS_SEGMENT_EQ]);; let IS_REALINTERVAL_SEGMENT = prove (`(!a b. is_realinterval(real_segment[a,b])) /\ (!a b. is_realinterval(real_segment(a,b)))`, REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN MESON_TAC[IS_REALINTERVAL_INTERVAL]);; let IN_REAL_SEGMENT = prove (`(!a b x. x IN real_segment[a,b] <=> a <= x /\ x <= b \/ b <= x /\ x <= a) /\ (!a b x. x IN real_segment(a,b) <=> a < x /\ x < b \/ b < x /\ x < a)`, REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A nice lemma from "Concrete Mathematics" (for example f = sqrt). *) (* ------------------------------------------------------------------------- *) let FLOOR_CONTINUOUS_MONOTONE_FLOOR = prove (`!f s. is_realinterval s /\ f real_continuous_on s /\ (!x y. x IN s /\ y IN s /\ x <= y ==> f x <= f y) /\ (!x. x IN s /\ integer(f x) ==> integer x) ==> !x. floor x IN s /\ x IN s ==> floor(f(floor x)) = floor(f x)`, REWRITE_TAC[is_realinterval; GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[FLOOR_MONO; FLOOR]; ALL_TAC] THEN SIMP_TAC[REAL_LE_FLOOR; FLOOR] THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real->real`; `floor x`; `x:real`; `floor(f(x:real))`] REAL_IVT_INCREASING) THEN ASM_SIMP_TAC[FLOOR; IN_REAL_INTERVAL; REAL_LT_IMP_LE; NOT_IMP] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_MESON_TAC[]; DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `integer y` ASSUME_TAC THENL [ASM_MESON_TAC[FLOOR]; ALL_TAC] THEN SUBGOAL_THEN `floor x = y` (fun th -> ASM_MESON_TAC[th; REAL_LT_REFL]) THEN ASM_REWRITE_TAC[GSYM FLOOR_UNIQUE; GSYM REAL_LT_SUB_RADD] THEN ASM_MESON_TAC[REAL_FLOOR_LE]]);; (* ------------------------------------------------------------------------- *) (* Convex real->real functions. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("real_convex_on",(12,"right"));; let real_convex_on = new_definition `(f:real->real) real_convex_on s <=> !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) ==> f(u * x + v * y) <= u * f(x) + v * f(y)`;; let REAL_CONVEX_ON_EMPTY = prove (`!f. f real_convex_on {}`, REWRITE_TAC[real_convex_on; NOT_IN_EMPTY]);; let REAL_CONVEX_ON = prove (`!f s. f real_convex_on s <=> (f o drop) convex_on (IMAGE lift s)`, REWRITE_TAC[real_convex_on; convex_on] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_THM; LIFT_DROP; DROP_ADD; DROP_CMUL]);; let REAL_CONVEX_ON_EQ = prove (`!f g s. is_realinterval s /\ (!x. x IN s ==> f x = g x) /\ f real_convex_on s ==> g real_convex_on s`, REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_CONVEX_ON] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] CONVEX_ON_EQ)) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]);; let REAL_CONVEX_ON_SING = prove (`!f a. f real_convex_on {a}`, REWRITE_TAC[REAL_CONVEX_ON; IMAGE_CLAUSES; CONVEX_ON_SING]);; let REAL_CONVEX_ON_SUBSET = prove (`!f s t. f real_convex_on t /\ s SUBSET t ==> f real_convex_on s`, REWRITE_TAC[REAL_CONVEX_ON] THEN MESON_TAC[CONVEX_ON_SUBSET; IMAGE_SUBSET]);; let REAL_CONVEX_ADD = prove (`!s f g. f real_convex_on s /\ g real_convex_on s ==> (\x. f(x) + g(x)) real_convex_on s`, REWRITE_TAC[REAL_CONVEX_ON; o_DEF; CONVEX_ADD]);; let REAL_CONVEX_LMUL = prove (`!s c f. &0 <= c /\ f real_convex_on s ==> (\x. c * f(x)) real_convex_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONVEX_ON; o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_CMUL) THEN REWRITE_TAC[]);; let REAL_CONVEX_RMUL = prove (`!s c f. &0 <= c /\ f real_convex_on s ==> (\x. f(x) * c) real_convex_on s`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_CONVEX_LMUL]);; let REAL_CONVEX_CONVEX_COMPOSE = prove (`!f g s:real^N->bool t. f convex_on s /\ g real_convex_on t /\ convex s /\ is_realinterval t /\ IMAGE f s SUBSET t /\ (!x y. x IN t /\ y IN t /\ x <= y ==> g x <= g y) ==> (g o f) convex_on s`, REWRITE_TAC[convex_on; convex; IS_REALINTERVAL_CONVEX; real_convex_on; SUBSET] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; o_DEF] THEN REWRITE_TAC[IN_IMAGE_LIFT_DROP; DROP_ADD; DROP_CMUL; LIFT_DROP] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN ASM_MESON_TAC[REAL_LE_TRANS]);; let REAL_CONVEX_COMPOSE = prove (`!f g. f real_convex_on s /\ g real_convex_on t /\ is_realinterval s /\ is_realinterval t /\ IMAGE f s SUBSET t /\ (!x y. x IN t /\ y IN t /\ x <= y ==> g x <= g y) ==> (g o f) real_convex_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONVEX_ON; GSYM o_ASSOC] THEN MATCH_MP_TAC REAL_CONVEX_CONVEX_COMPOSE THEN EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[GSYM REAL_CONVEX_ON; GSYM IMAGE_o; o_DEF; LIFT_DROP; ETA_AX; GSYM IS_REALINTERVAL_CONVEX]);; let REAL_CONVEX_LOWER = prove (`!f s x y. f real_convex_on s /\ x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> f(u * x + v * y) <= max (f(x)) (f(y))`, REWRITE_TAC[REAL_CONVEX_ON] THEN REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_LOWER) THEN REWRITE_TAC[o_THM; DROP_ADD; DROP_CMUL]);; let REAL_CONVEX_LOCAL_GLOBAL_MINIMUM = prove (`!f s t x. f real_convex_on s /\ x IN t /\ real_open t /\ t SUBSET s /\ (!y. y IN t ==> f(x) <= f(y)) ==> !y. y IN s ==> f(x) <= f(y)`, REWRITE_TAC[REAL_CONVEX_ON; REAL_OPEN] THEN REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP] THEN REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`; `IMAGE lift t`; `x:real^1`] CONVEX_LOCAL_GLOBAL_MINIMUM) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_THM; IMAGE_SUBSET]);; let REAL_CONVEX_DISTANCE = prove (`!s a. (\x. abs(a - x)) real_convex_on s`, REWRITE_TAC[REAL_CONVEX_ON; o_DEF; FORALL_DROP; GSYM DROP_SUB] THEN REWRITE_TAC[drop; GSYM NORM_REAL; GSYM dist; CONVEX_DISTANCE]);; let REAL_CONVEX_ON_JENSEN = prove (`!f s. is_realinterval s ==> (f real_convex_on s <=> !k u x. (!i:num. 1 <= i /\ i <= k ==> &0 <= u(i) /\ x(i) IN s) /\ (sum (1..k) u = &1) ==> f(sum (1..k) (\i. u(i) * x(i))) <= sum (1..k) (\i. u(i) * f(x(i))))`, REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_CONVEX_ON] THEN SIMP_TAC[CONVEX_ON_JENSEN] THEN REPEAT STRIP_TAC THEN SIMP_TAC[o_DEF; DROP_VSUM; FINITE_NUMSEG] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:num->real` THEN REWRITE_TAC[] THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `x:num->real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `lift o (x:num->real)`) THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP] THEN REWRITE_TAC[DROP_CMUL; LIFT_DROP]; X_GEN_TAC `x:num->real^1` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `drop o (x:num->real^1)`) THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP] THEN ASM_REWRITE_TAC[DROP_CMUL; LIFT_DROP; GSYM IN_IMAGE_LIFT_DROP]]);; let REAL_CONVEX_ON_IMP_JENSEN = prove (`!f s k:A->bool u x. f real_convex_on s /\ is_realinterval s /\ FINITE k /\ (!i. i IN k ==> &0 <= u i /\ x i IN s) /\ sum k u = &1 ==> f(sum k (\i. u i * x i)) <= sum k (\i. u i * f(x i))`, REWRITE_TAC[REAL_CONVEX_ON; IS_REALINTERVAL_IS_INTERVAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:A->bool`; `u:A->real`; `\i:A. lift(x i)`] o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CONVEX_ON_IMP_JENSEN)) THEN ASM_REWRITE_TAC[LIFT_IN_IMAGE_LIFT; o_DEF; LIFT_DROP; DROP_VSUM; DROP_CMUL; GSYM IS_INTERVAL_CONVEX_1]);; let REAL_CONVEX_ON_CONTINUOUS = prove (`!f s. real_open s /\ f real_convex_on s ==> f real_continuous_on s`, REWRITE_TAC[REAL_CONVEX_ON; REAL_OPEN; REAL_CONTINUOUS_ON] THEN REWRITE_TAC[CONVEX_ON_CONTINUOUS]);; let REAL_CONVEX_ON_LEFT_SECANT_MUL = prove (`!f s. f real_convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN real_segment[a,b] ==> (f x - f a) * abs(b - a) <= (f b - f a) * abs(x - a)`, REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_LEFT_SECANT_MUL] THEN REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; let REAL_CONVEX_ON_RIGHT_SECANT_MUL = prove (`!f s. f real_convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN real_segment[a,b] ==> (f b - f a) * abs(b - x) <= (f b - f x) * abs(b - a)`, REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_RIGHT_SECANT_MUL] THEN REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; let REAL_CONVEX_ON_LEFT_SECANT = prove (`!f s. f real_convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN real_segment(a,b) ==> (f x - f a) / abs(x - a) <= (f b - f a) / abs(b - a)`, REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_LEFT_SECANT] THEN REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; let REAL_CONVEX_ON_RIGHT_SECANT = prove (`!f s. f real_convex_on s <=> !a b x. a IN s /\ b IN s /\ x IN real_segment(a,b) ==> (f b - f a) / abs(b - a) <= (f b - f x) / abs(b - x)`, REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_RIGHT_SECANT] THEN REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; let REAL_CONVEX_ON_DERIVATIVE_SECANT_IMP = prove (`!f f' s x y. f real_convex_on s /\ real_segment[x,y] SUBSET s /\ (f has_real_derivative f') (atreal x within s) ==> f' * (y - x) <= f y - f x`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN REWRITE_TAC[LIFT_DROP] THEN REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP] `\x. lift(drop(f % x))`)] THEN REWRITE_TAC[GSYM o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT_IMP) THEN REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);; let REAL_CONVEX_ON_SECANT_DERIVATIVE_IMP = prove (`!f f' s x y. f real_convex_on s /\ real_segment[x,y] SUBSET s /\ (f has_real_derivative f') (atreal y within s) ==> f y - f x <= f' * (y - x)`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN REWRITE_TAC[LIFT_DROP] THEN REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP] `\x. lift(drop(f % x))`)] THEN REWRITE_TAC[GSYM o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_SECANT_DERIVATIVE_IMP) THEN REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);; let REAL_CONVEX_ON_DERIVATIVES_IMP = prove (`!f f'x f'y s x y. f real_convex_on s /\ real_segment[x,y] SUBSET s /\ (f has_real_derivative f'x) (atreal x within s) /\ (f has_real_derivative f'y) (atreal y within s) ==> f'x * (y - x) <= f'y * (y - x)`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN REWRITE_TAC[LIFT_DROP] THEN REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP] `\x. lift(drop(f % x))`)] THEN REWRITE_TAC[GSYM o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_DERIVATIVES_IMP) THEN REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);; let REAL_CONVEX_ON_DERIVATIVE_INCREASING_IMP = prove (`!f f'x f'y s x y. f real_convex_on s /\ real_interval[x,y] SUBSET s /\ (f has_real_derivative f'x) (atreal x within s) /\ (f has_real_derivative f'y) (atreal y within s) /\ x < y ==> f'x <= f'y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `f'x:real`; `f'y:real`; `s:real->bool`; `x:real`; `y:real`] REAL_CONVEX_ON_DERIVATIVES_IMP) THEN ASM_REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_RMUL_EQ; REAL_SUB_LT]);; let REAL_CONVEX_ON_DERIVATIVE_SECANT = prove (`!f f' s. is_realinterval s /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) ==> (f real_convex_on s <=> !x y. x IN s /\ y IN s ==> f'(x) * (y - x) <= f y - f x)`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF] `lift o (\x. drop(f % x))`)] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT) THEN REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);; let REAL_CONVEX_ON_SECANT_DERIVATIVE = prove (`!f f' s. is_realinterval s /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) ==> (f real_convex_on s <=> !x y. x IN s /\ y IN s ==> f y - f x <= f'(y) * (y - x))`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF] `lift o (\x. drop(f % x))`)] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_SECANT_DERIVATIVE) THEN REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);; let REAL_CONVEX_ON_DERIVATIVES = prove (`!f f' s. is_realinterval s /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) ==> (f real_convex_on s <=> !x y. x IN s /\ y IN s ==> f'(x) * (y - x) <= f'(y) * (y - x))`, REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF] `lift o (\x. drop(f % x))`)] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVES) THEN REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);; let REAL_CONVEX_ON_DERIVATIVE_INCREASING = prove (`!f f' s. is_realinterval s /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) ==> (f real_convex_on s <=> !x y. x IN s /\ y IN s /\ x <= y ==> f'(x) <= f'(y))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_CONVEX_ON_DERIVATIVES) THEN EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE]; DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y <= x`) THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]); FIRST_X_ASSUM(MP_TAC o SPECL [`y:real`; `x:real`])] THEN ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * (y - x) <= b * (y - x) <=> b * (x - y) <= a * (x - y)`] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE]]);; let HAS_REAL_DERIVATIVE_INCREASING_IMP = prove (`!f f' s a b. is_realinterval s /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) /\ (!x. x IN s ==> &0 <= f'(x)) /\ a IN s /\ b IN s /\ a <= b ==> f(a) <= f(b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `real_interval[a,b] SUBSET s` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [is_realinterval]) THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:real->real`; `f':real->real`; `a:real`; `b:real`] REAL_MVT_VERY_SIMPLE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `s:real->bool` THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM REAL_SUB_LE] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_REAL_ARITH_TAC]]);; let HAS_REAL_DERIVATIVE_INCREASING = prove (`!f f' s. is_realinterval s /\ ~(?a. s = {a}) /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) ==> ((!x. x IN s ==> &0 <= f'(x)) <=> (!x y. x IN s /\ y IN s /\ x <= y ==> f(x) <= f(y)))`, REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[HAS_REAL_DERIVATIVE_INCREASING_IMP]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `atreal x within s` REALLIM_LBOUND) THEN EXISTS_TAC `\y:real. (f y - f x) / (y - x)` THEN ASM_SIMP_TAC[GSYM HAS_REAL_DERIVATIVE_WITHINREAL] THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_WITHIN_REALINTERVAL] THEN REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[REAL_ARITH `&0 < abs(y - x) <=> ~(y = x)`] THEN STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(y:real = x) ==> x < y \/ y < x`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_NEG_NEG; GSYM real_div]] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE]);; let HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP = prove (`!f f' a b. (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) /\ (!x. x IN real_interval(a,b) ==> &0 < f'(x)) /\ a < b ==> f(a) < f(b)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `f':real->real`; `a:real`; `b:real`] REAL_MVT) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_SUB_LT; REAL_LT_MUL]] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; real_differentiable_on]; ASM_MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_SUBSET; SUBSET; REAL_INTERVAL_OPEN_SUBSET_CLOSED; REAL_OPEN_REAL_INTERVAL; HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN]]);; let REAL_CONVEX_ON_SECOND_DERIVATIVE = prove (`!f f' f'' s. is_realinterval s /\ ~(?a. s = {a}) /\ (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) /\ (!x. x IN s ==> (f' has_real_derivative f''(x)) (atreal x within s)) ==> (f real_convex_on s <=> !x. x IN s ==> &0 <= f''(x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `!x y. x IN s /\ y IN s /\ x <= y ==> (f':real->real)(x) <= f'(y)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONVEX_ON_DERIVATIVE_INCREASING; CONV_TAC SYM_CONV THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_INCREASING] THEN ASM_REWRITE_TAC[]);; let REAL_CONVEX_ON_ASYM = prove (`!s f. f real_convex_on s <=> !x y u v. x IN s /\ y IN s /\ x < y /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> f (u * x + v * y) <= u * f x + v * f y`, REPEAT GEN_TAC THEN REWRITE_TAC[real_convex_on] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_WLOG_LT THEN SIMP_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_LID; REAL_LE_REFL] THEN ASM_MESON_TAC[REAL_ADD_SYM]);; let REAL_CONVEX_ON_EXP = prove (`!s. exp real_convex_on s`, GEN_TAC THEN MATCH_MP_TAC REAL_CONVEX_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[SUBSET_UNIV] THEN MP_TAC(ISPECL [`exp`; `exp`; `exp`; `(:real)`] REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN SIMP_TAC[HAS_REAL_DERIVATIVE_EXP; REAL_EXP_POS_LE; HAS_REAL_DERIVATIVE_ATREAL_WITHIN; IS_REALINTERVAL_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC(SET_RULE `&0 IN s /\ &1 IN s /\ ~(&1 = &0) ==> ~(?a. s = {a})`) THEN REWRITE_TAC[IN_UNIV] THEN REAL_ARITH_TAC);; let REAL_CONVEX_ON_RPOW = prove (`!s t. s SUBSET {x | &0 <= x} /\ &1 <= t ==> (\x. x rpow t) real_convex_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONVEX_ON_SUBSET THEN EXISTS_TAC `{x | &0 <= x}` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(\x. x rpow t) real_convex_on {x | &0 < x}` MP_TAC THENL [MP_TAC(ISPECL [`\x. x rpow t`; `\x. t * x rpow (t - &1)`; `\x. t * (t - &1) * x rpow (t - &2)`; `{x | &0 < x}`] REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `&1 IN s /\ &2 IN s /\ ~(&1 = &2) ==> ~(?a. s = {a})`) THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REWRITE_TAC[REAL_ARITH `t - &1 - &1 = t - &2`] THEN ASM_REAL_ARITH_TAC]; DISCH_THEN SUBST1_TAC THEN REPEAT STRIP_TAC THEN REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC RPOW_POS_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]; REWRITE_TAC[REAL_CONVEX_ON_ASYM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `x = &0` THENL [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RPOW_ZERO; REAL_ARITH `&1 <= t ==> ~(t = &0)`] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN ASM_CASES_TAC `v = &0` THEN ASM_SIMP_TAC[RPOW_ZERO; REAL_ARITH `&1 <= t ==> ~(t = &0)`; REAL_MUL_LZERO; REAL_LE_REFL] THEN ASM_SIMP_TAC[RPOW_MUL; REAL_LT_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[RPOW_POS_LE; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `exp(&1 * log v)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[rpow; REAL_LT_LE; REAL_EXP_MONO_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * l <= b * l <=> --l * b <= --l * a`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM LOG_INV; REAL_LT_LE] THEN MATCH_MP_TAC LOG_POS THEN MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_MUL_LID; EXP_LOG; REAL_LT_LE; REAL_LE_REFL]]; ASM_MESON_TAC[REAL_LT_LE; REAL_LET_TRANS]]]);; let REAL_CONVEX_ON_LOG = prove (`!s. s SUBSET {x | &0 < x} ==> (\x. --log x) real_convex_on s`, GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_CONVEX_ON_SUBSET) THEN MP_TAC(ISPECL [`\x. --log x`; `\x:real. --inv(x)`; `\x:real. inv(x pow 2)`; `{x | &0 < x}`] REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LE_INV_EQ; REAL_LE_POW_2] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN MESON_TAC[REAL_ARITH `&0 < a ==> &0 < a + &1 /\ ~(a + &1 = a)`]; REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC]);; let REAL_CONTINUOUS_MIDPOINT_CONVEX = prove (`!f s. f real_continuous_on s /\ is_realinterval s /\ (!x y. x IN s /\ y IN s ==> f ((x + y) / &2) <= (f x + f y) / &2) ==> f real_convex_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONVEX_ON] THEN MATCH_MP_TAC CONTINUOUS_MIDPOINT_CONVEX THEN ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IS_REALINTERVAL_CONVEX] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[midpoint; LIFT_DROP; o_THM; DROP_CMUL; DROP_ADD] THEN ASM_SIMP_TAC[REAL_ARITH `inv(&2) * x = x / &2`]);; (* ------------------------------------------------------------------------- *) (* Some convexity-derived inequalities including AGM and Young's inequality. *) (* ------------------------------------------------------------------------- *) let AGM_GEN = prove (`!a x k:A->bool. FINITE k /\ sum k a = &1 /\ (!i. i IN k ==> &0 <= a i /\ &0 <= x i) ==> product k (\i. x i rpow a i) <= sum k (\i. a i * x i)`, let version1 = prove (`!a x k:A->bool. FINITE k /\ sum k a = &1 /\ (!i. i IN k ==> &0 < a i /\ &0 < x i) ==> product k (\i. x i rpow a i) <= sum k (\i. a i * x i)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ] THEN STRIP_TAC THEN MATCH_MP_TAC LOG_MONO_LE_REV THEN ASM_SIMP_TAC[PRODUCT_POS_LT; RPOW_POS_LT; LOG_PRODUCT; LOG_RPOW; SUM_POS_LT_ALL; REAL_LT_MUL] THEN MP_TAC(ISPECL [`\x. --log x`; `{x | &0 < x}`; `k:A->bool`; `a:A->real`; `x:A->real`] REAL_CONVEX_ON_IMP_JENSEN) THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_CONVEX_ON_LOG; SUBSET_REFL; REAL_LT_IMP_LE; is_realinterval] THEN REWRITE_TAC[REAL_MUL_RNEG; SUM_NEG; REAL_LE_NEG2] THEN DISCH_THEN MATCH_MP_TAC THEN REAL_ARITH_TAC) in let version2 = prove (`!a x k:A->bool. FINITE k /\ sum k a = &1 /\ (!i. i IN k ==> &0 < a i /\ &0 <= x i) ==> product k (\i. x i rpow a i) <= sum k (\i. a i * x i)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `?i:A. i IN k /\ x i = &0` THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = &0 ==> x <= y`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0] THEN ASM_MESON_TAC[REAL_LT_IMP_NZ]]; MATCH_MP_TAC version1 THEN ASM_MESON_TAC[REAL_LT_LE]]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `product {i:A | i IN k /\ ~(a i = &0)} (\i. x i rpow a i) <= sum {i:A | i IN k /\ ~(a i = &0)} (\i. a i * x i)` MP_TAC THENL [MATCH_MP_TAC version2 THEN ASM_SIMP_TAC[FINITE_RESTRICT; REAL_LT_LE; IN_ELIM_THM] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC RAND_CONV [GSYM SUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_REAL_ADD]; MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN BINOP_TAC THENL [MATCH_MP_TAC PRODUCT_SUPERSET; MATCH_MP_TAC SUM_SUPERSET] THEN SIMP_TAC[IN_ELIM_THM; SUBSET_RESTRICT; IMP_CONJ; RPOW_0] THEN REWRITE_TAC[REAL_MUL_LZERO]]);; let AGM_RPOW = prove (`!k:A->bool x n. k HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN k ==> &0 <= x(i)) ==> product k (\i. x(i) rpow (&1 / &n)) <= sum k (\i. x(i) / &n)`, REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\i:A. &1 / &n`; `x:A->real`; `k:A->bool`] AGM_GEN) THEN ASM_SIMP_TAC[SUM_CONST; REAL_LE_DIV; REAL_OF_NUM_LT; LE_1; ARITH; REAL_DIV_LMUL; REAL_OF_NUM_EQ; REAL_POS] THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_AC]);; let AGM_ROOT = prove (`!k:A->bool x n. k HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN k ==> &0 <= x(i)) ==> root n (product k x) <= sum k x / &n`, REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ROOT_PRODUCT; real_div; GSYM SUM_RMUL] THEN ASM_SIMP_TAC[REAL_ROOT_RPOW; GSYM real_div] THEN REWRITE_TAC[REAL_ARITH `inv(x) = &1 / x`] THEN MATCH_MP_TAC AGM_RPOW THEN ASM_REWRITE_TAC[HAS_SIZE]);; let AGM_SQRT = prove (`!x y. &0 <= x /\ &0 <= y ==> sqrt(x * y) <= (x + y) / &2`, REPEAT STRIP_TAC THEN MP_TAC (ISPECL [`{0,1}`; `\n. if n = 0 then (x:real) else y`; `2`] AGM_ROOT) THEN SIMP_TAC[SUM_CLAUSES; PRODUCT_CLAUSES; FINITE_RULES] THEN REWRITE_TAC[ARITH_EQ; IN_INSERT; NOT_IN_EMPTY; HAS_SIZE_CONV`s HAS_SIZE 2 `] THEN ASM_SIMP_TAC[ROOT_2; REAL_MUL_RID; REAL_ADD_RID; REAL_ARITH `x / &2 + y / &2 = (x + y) / &2`] THEN ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`]);; let AGM = prove (`!k:A->bool x n. k HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN k ==> &0 <= x(i)) ==> product k x <= (sum k x / &n) pow n`, REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `root n (product (k:A->bool) x) pow n` THEN CONJ_TAC THENL [ASM_SIMP_TAC[REAL_POW_ROOT; PRODUCT_POS_LE; REAL_LE_REFL]; MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[AGM_ROOT; HAS_SIZE; ROOT_LE_0; PRODUCT_POS_LE]]);; let AGM_2 = prove (`!x y u v. &0 <= x /\ &0 <= y /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> x rpow u * y rpow v <= u * x + v * y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\i. if i = 0 then u:real else v`; `\i. if i = 0 then x:real else y`; `0..SUC 0`] AGM_GEN) THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; PRODUCT_CLAUSES_NUMSEG; ARITH] THEN REWRITE_TAC[FINITE_NUMSEG] THEN ASM_MESON_TAC[]);; let YOUNG_INEQUALITY = prove (`!a b p q. &0 <= a /\ &0 <= b /\ &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 ==> a * b <= a rpow p / p + b rpow q / q`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a rpow p`; `b rpow q`; `inv p:real`; `inv q:real`] AGM_2) THEN ASM_SIMP_TAC[RPOW_RPOW; RPOW_POS_LE; REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_MUL_RINV; RPOW_POW; REAL_POW_1; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC);; let HOELDER = prove (`!k:A->bool a x y. FINITE k /\ sum k a = &1 /\ (!i. i IN k ==> &0 <= a i /\ &0 <= x i /\ &0 <= y i) ==> product k (\i. x i rpow a i) + product k (\i. y i rpow a i) <= product k (\i. (x i + y i) rpow a i)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= product (k:A->bool) (\i. (x i + y i) rpow a i)` MP_TAC THENL [MATCH_MP_TAC PRODUCT_POS_LE THEN ASM_SIMP_TAC[REAL_LE_ADD; RPOW_POS_LE]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0; TAUT `p /\ q <=> ~(p ==> ~q)`; REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x = &0 /\ y = &0 /\ z = &0 ==> x + y <= z`) THEN ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0] THEN ASM_MESON_TAC[REAL_ADD_LID]; GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID]] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM PRODUCT_DIV; GSYM RPOW_DIV; REAL_ARITH `(x + y) / z:real = x / z + y / z`] THEN ASM_SIMP_TAC[GSYM RPOW_PRODUCT] THEN TRANS_TAC REAL_LE_TRANS `sum k (\i:A. a i * (x i / (x i + y i))) + sum k (\i. a i * (y i / (x i + y i)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC AGM_GEN THEN ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_DIV]; ASM_SIMP_TAC[GSYM SUM_ADD]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `s = &1 ==> p = s ==> p <= &1`)) THEN MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN ASM_CASES_TAC `(a:A->real) i = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `i:A`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Some other inequalities where it's handy just to use calculus. *) (* ------------------------------------------------------------------------- *) let RPOW_MINUS1_QUOTIENT_LT = prove (`!a x y. &0 < a /\ ~(a = &1) /\ &0 < x /\ x < y ==> (a rpow x - &1) / x < (a rpow y - &1) / y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. (a rpow x - &1) / x`; `\x. log a * a rpow x / x - (a rpow x - &1) / x pow 2`; `x:real`; `y:real`] HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ASM_SIMP_TAC[rpow] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < z` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `(z:real) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_MUL_RZERO; REAL_FIELD `&0 < x ==> x pow 2 * (a * b / x - c / x pow 2) = a * b * x - c`] THEN REWRITE_TAC[REAL_ARITH `l * a * z - (a - &1) = a * (l * z - &1) + &1`] THEN MP_TAC(ISPECL [`\x. a rpow x * (log a * x - &1) + &1`; `\x. log(a) pow 2 * x * a rpow x`; `&0`; `z:real`] HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP) THEN ASM_REWRITE_TAC[RPOW_0] THEN ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN ASM_SIMP_TAC[RPOW_POS_LT; REAL_LT_POW_2] THEN ASM_SIMP_TAC[GSYM LOG_1; LOG_INJ; REAL_LT_01]]);; let RPOW_MINUS1_QUOTIENT_LE = prove (`!a x y. &0 < a /\ &0 < x /\ x <= y ==> (a rpow x - &1) / x <= (a rpow y - &1) / y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_CASES_TAC `a = &1` THEN ASM_REWRITE_TAC[real_div; RPOW_ONE; REAL_SUB_REFL; REAL_MUL_LZERO; REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_LE_LT; GSYM real_div; RPOW_MINUS1_QUOTIENT_LT]);; let REAL_EXP_LIMIT_RPOW_LT = prove (`!x r s. &0 < r /\ r < s /\ ~(x = &0) /\ x < r ==> (&1 - x / r) rpow r < (&1 - x / s) rpow s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 < s` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < &1 - x / s` ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`(&1 - x / s) rpow (inv r)`; `r:real`; `s:real`] RPOW_MINUS1_QUOTIENT_LT) THEN ASM_SIMP_TAC[RPOW_RPOW; REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_LT_IMP_LE; RPOW_POW; REAL_POW_1; RPOW_POS_LT] THEN ANTS_TAC THENL [ASM_SIMP_TAC[rpow; GSYM REAL_EXP_0; REAL_EXP_INJ] THEN ASM_SIMP_TAC[REAL_ENTIRE; REAL_INV_EQ_0; REAL_LT_IMP_NZ] THEN REWRITE_TAC[REAL_EXP_0] THEN ASM_SIMP_TAC[GSYM LOG_1; LOG_INJ; REAL_LT_01] THEN REWRITE_TAC[REAL_ARITH `a - x = a <=> x = &0`; REAL_DIV_EQ_0] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `(&1 - x / s - &1) / r = --(x / r) / s`] THEN ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_ARITH `--x < a - &1 <=> &1 - x < a`] THEN DISCH_THEN(MP_TAC o SPEC `r:real` o MATCH_MP(MESON[RPOW_LT2] `x < y ==> !z. &0 <= x /\ &0 < z ==> x rpow z < y rpow z`)) THEN ASM_SIMP_TAC[RPOW_RPOW; REAL_LT_IMP_LE; REAL_FIELD `&0 < r ==> (inv r * s) * r = s`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]);; let REAL_EXP_LIMIT_RPOW_LE = prove (`!x r s. &0 <= r /\ r <= s /\ x <= r ==> (&1 - x / r) rpow r <= (&1 - x / s) rpow s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_SUB_RZERO; RPOW_ONE]; ALL_TAC] THEN ASM_CASES_TAC `r:real = s` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_CASES_TAC `r:real = x` THENL [ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_REFL; RPOW_ZERO] THEN STRIP_TAC THEN MATCH_MP_TAC RPOW_POS_LE THEN REWRITE_TAC[REAL_SUB_LE] THEN SUBGOAL_THEN `&0 < s` (fun th -> SIMP_TAC[th; REAL_LE_LDIV_EQ]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[REAL_LE_LT; REAL_EXP_LIMIT_RPOW_LT] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_LT; RPOW_POW; real_pow] THEN ASM_SIMP_TAC[rpow; REAL_SUB_LT; REAL_LT_LDIV_EQ] THEN COND_CASES_TAC THENL [ALL_TAC; MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_REAL_ARITH_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_0] THEN REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC LOG_POS THEN REWRITE_TAC[REAL_ARITH `&1 <= &1 - x / y <=> &0 <= --x / y`] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC);; let REAL_LE_X_SINH = prove (`!x. &0 <= x ==> x <= (exp x - inv(exp x)) / &2`, SUBGOAL_THEN `!a b. a <= b ==> exp a - inv(exp a) - &2 * a <= exp b - inv(exp b) - &2 * b` (MP_TAC o SPEC `&0`) THENL [MP_TAC(ISPECL [`\x. exp x - exp(--x) - &2 * x`; `\x. exp x + exp(--x) - &2`; `(:real)`] HAS_REAL_DERIVATIVE_INCREASING) THEN REWRITE_TAC[IN_ELIM_THM; IS_REALINTERVAL_UNIV; IN_UNIV] THEN ANTS_TAC THENL [CONJ_TAC THENL [SET_TAC[REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN GEN_TAC THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC; SIMP_TAC[REAL_EXP_NEG] THEN DISCH_THEN(fun th -> SIMP_TAC[GSYM th]) THEN X_GEN_TAC `x:real` THEN SIMP_TAC[REAL_EXP_NZ; REAL_FIELD `~(e = &0) ==> e + inv e - &2 = (e - &1) pow 2 / e`] THEN SIMP_TAC[REAL_EXP_POS_LE; REAL_LE_DIV; REAL_LE_POW_2]]; MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[REAL_EXP_0] THEN REAL_ARITH_TAC]);; let REAL_LE_ABS_SINH = prove (`!x. abs x <= abs((exp x - inv(exp x)) / &2)`, GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN ASM_SIMP_TAC[REAL_LE_X_SINH]; MATCH_MP_TAC(REAL_ARITH `~(&0 <= x) /\ --x <= --y ==> abs x <= abs y`) THEN ASM_REWRITE_TAC[REAL_ARITH `--((a - b) / &2) = (b - a) / &2`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(exp(--x) - inv(exp(--x))) / &2` THEN ASM_SIMP_TAC[REAL_LE_X_SINH; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`] THEN REWRITE_TAC[REAL_EXP_NEG; REAL_INV_INV] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Log-convex functions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("log_convex_on",(12,"right"));; let log_convex_on = new_definition `f log_convex_on (s:real^N->bool) <=> (!x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> &0 <= f(u % x + v % y) /\ f(u % x + v % y) <= f(x) rpow u * f(y) rpow v)`;; let LOG_CONVEX_ON_EMPTY = prove (`!f:real^N->real. f log_convex_on {}`, REWRITE_TAC[log_convex_on; NOT_IN_EMPTY]);; let LOG_CONVEX_ON_SUBSET = prove (`!f s t. f log_convex_on t /\ s SUBSET t ==> f log_convex_on s`, REWRITE_TAC[log_convex_on] THEN SET_TAC[]);; let LOG_CONVEX_ON_EQ = prove (`!f g s:real^N->bool. convex s /\ (!x. x IN s ==> f x = g x) /\ f log_convex_on s ==> g log_convex_on s`, REWRITE_TAC[IMP_CONJ] THEN SIMP_TAC[convex; log_convex_on]);; let LOG_CONVEX_IMP_POS = prove (`!f s x:real^N. f log_convex_on s /\ x IN s ==> &0 <= f x`, REWRITE_TAC[log_convex_on] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `x:real^N`; `&0`; `&1`]) THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[]);; let LOG_CONVEX_ON_CONVEX = prove (`!f s:real^N->bool. convex s ==> (f log_convex_on s <=> (!x. x IN s ==> &0 <= f x) /\ !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> f(u % x + v % y) <= f(x) rpow u * f(y) rpow v)`, REWRITE_TAC[convex] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [ASM_MESON_TAC[LOG_CONVEX_IMP_POS]; ASM_MESON_TAC[log_convex_on]; ASM_SIMP_TAC[log_convex_on] THEN ASM_MESON_TAC[]]);; let LOG_CONVEX_ON = prove (`!f s:real^N->bool. convex s /\ (!x. x IN s ==> &0 < f x) ==> (f log_convex_on s <=> (log o f) convex_on s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LOG_CONVEX_ON_CONVEX; REAL_LT_IMP_LE] THEN RULE_ASSUM_TAC(REWRITE_RULE[convex]) THEN REWRITE_TAC[convex_on; o_DEF] THEN GEN_REWRITE_TAC (RAND_CONV o funpow 4 BINDER_CONV o RAND_CONV) [GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; rpow; REAL_EXP_ADD]);; let LOG_CONVEX_IMP_CONVEX = prove (`!f s:real^N->bool. f log_convex_on s ==> f convex_on s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOG_CONVEX_IMP_POS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[log_convex_on]) THEN REWRITE_TAC[convex_on] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`x:real^N`; `y:real^N`; `u:real`; `v:real`]) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC AGM_2 THEN ASM_SIMP_TAC[]);; let LOG_CONVEX_ADD = prove (`!f g s:real^N->bool. f log_convex_on s /\ g log_convex_on s ==> (\x. f x + g x) log_convex_on s`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(CONJUNCTS_THEN(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOG_CONVEX_IMP_POS))) THEN REWRITE_TAC[log_convex_on] THEN FIRST_X_ASSUM(CONJUNCTS_THEN (ASSUME_TAC o REWRITE_RULE[log_convex_on])) THEN REWRITE_TAC[log_convex_on] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_ADD] THEN MP_TAC(ISPEC `0..SUC 0` HOELDER) THEN SIMP_TAC[PRODUCT_CLAUSES_NUMSEG; FINITE_NUMSEG; SUM_CLAUSES_NUMSEG; ARITH] THEN DISCH_THEN(MP_TAC o SPECL [`\i. if i = 0 then u:real else v`; `\i. if i = 0 then (f:real^N->real) x else f y`; `\i. if i = 0 then (g:real^N->real) x else g y`]) THEN REWRITE_TAC[ARITH] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_MESON_TAC[]);; let LOG_CONVEX_MUL = prove (`!f g s:real^N->bool. f log_convex_on s /\ g log_convex_on s ==> (\x. f x * g x) log_convex_on s`, REWRITE_TAC[log_convex_on] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; RPOW_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * (c * d):real = (a * c) * (b * d)`] THEN ASM_SIMP_TAC[REAL_LE_MUL2]);; let MIDPOINT_LOG_CONVEX = prove (`!f s:real^N->bool. (lift o f) continuous_on s /\ convex s /\ (!x. x IN s ==> &0 < f x) /\ (!x y. x IN s /\ y IN s ==> f(midpoint(x,y)) pow 2 <= f(x) * f(y)) ==> f log_convex_on s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LOG_CONVEX_ON] THEN MATCH_MP_TAC CONTINUOUS_MIDPOINT_CONVEX THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SUBGOAL_THEN `lift o log o (f:real^N->real) = (lift o log o drop) o (lift o f)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; IMAGE_o] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_LOG THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE]; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[o_DEF; REAL_ARITH `x <= y / &2 <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_EXP_ADD; MIDPOINT_IN_CONVEX]]);; let LOG_CONVEX_CONST = prove (`!s a. &0 <= a ==> (\x. a) log_convex_on s`, SIMP_TAC[log_convex_on; GSYM RPOW_ADD] THEN IMP_REWRITE_TAC[GSYM RPOW_ADD_ALT] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LE_REFL] THEN REAL_ARITH_TAC);; let LOG_CONVEX_ON_SING = prove (`!f a:real^N. f log_convex_on {a} <=> &0 <= f a`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[LOG_CONVEX_IMP_POS; IN_SING]; DISCH_TAC] THEN MATCH_MP_TAC LOG_CONVEX_ON_EQ THEN EXISTS_TAC `\x:real^N. (f:real^N->real) a` THEN ASM_SIMP_TAC[IN_SING; CONVEX_SING; LOG_CONVEX_CONST]);; let LOG_CONVEX_PRODUCT = prove (`!f s k. FINITE k /\ (!i. i IN k ==> (\x. f x i) log_convex_on s) ==> (\x. product k (f x)) log_convex_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; LOG_CONVEX_CONST; REAL_POS] THEN SIMP_TAC[FORALL_IN_INSERT; LOG_CONVEX_MUL]);; (* ------------------------------------------------------------------------- *) (* Real log-convex functions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("real_log_convex_on",(12,"right"));; let real_log_convex_on = new_definition `(f:real->real) real_log_convex_on s <=> (!x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> &0 <= f(u * x + v * y) /\ f(u * x + v * y) <= f(x) rpow u * f(y) rpow v)`;; let REAL_LOG_CONVEX_ON_EMPTY = prove (`!f. f real_log_convex_on {}`, REWRITE_TAC[real_log_convex_on; NOT_IN_EMPTY]);; let REAL_LOG_CONVEX_ON_SUBSET = prove (`!f s t. f real_log_convex_on t /\ s SUBSET t ==> f real_log_convex_on s`, REWRITE_TAC[real_log_convex_on] THEN SET_TAC[]);; let REAL_LOG_CONVEX_LOG_CONVEX = prove (`!f s. f real_log_convex_on s <=> (f o drop) log_convex_on (IMAGE lift s)`, REWRITE_TAC[real_log_convex_on; log_convex_on] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP]);; let REAL_LOG_CONVEX_ON_EQ = prove (`!f g s. is_realinterval s /\ (!x. x IN s ==> f x = g x) /\ f real_log_convex_on s ==> g real_log_convex_on s`, REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_LOG_CONVEX_LOG_CONVEX] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] LOG_CONVEX_ON_EQ)) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]);; let REAL_LOG_CONVEX_ON_SING = prove (`!f a. f real_log_convex_on {a} <=> &0 <= f a`, REWRITE_TAC[REAL_LOG_CONVEX_LOG_CONVEX; LOG_CONVEX_ON_SING] THEN REWRITE_TAC[IMAGE_CLAUSES; LOG_CONVEX_ON_SING; o_THM; LIFT_DROP]);; let REAL_LOG_CONVEX_IMP_POS = prove (`!f s x. f real_log_convex_on s /\ x IN s ==> &0 <= f x`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; REAL_LOG_CONVEX_LOG_CONVEX] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOG_CONVEX_IMP_POS)) THEN REWRITE_TAC[o_DEF; FORALL_IN_IMAGE; LIFT_DROP]);; let REAL_LOG_CONVEX_ON_CONVEX = prove (`!f s. is_realinterval s ==> (f real_log_convex_on s <=> (!x. x IN s ==> &0 <= f x) /\ !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> f(u * x + v * y) <= f(x) rpow u * f(y) rpow v)`, REWRITE_TAC[REAL_CONVEX] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [ASM_MESON_TAC[REAL_LOG_CONVEX_IMP_POS]; ASM_MESON_TAC[real_log_convex_on]; ASM_SIMP_TAC[real_log_convex_on] THEN ASM_MESON_TAC[]]);; let REAL_LOG_CONVEX_ON = prove (`!f s:real->bool. is_realinterval s /\ (!x. x IN s ==> &0 < f x) ==> (f real_log_convex_on s <=> (log o f) real_convex_on s)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LOG_CONVEX_ON_CONVEX; REAL_LT_IMP_LE] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_CONVEX]) THEN REWRITE_TAC[real_convex_on; o_DEF] THEN GEN_REWRITE_TAC (RAND_CONV o funpow 4 BINDER_CONV o RAND_CONV) [GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; rpow; REAL_EXP_ADD]);; let REAL_LOG_CONVEX_IMP_CONVEX = prove (`!f s:real->bool. f real_log_convex_on s ==> f real_convex_on s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LOG_CONVEX_IMP_POS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[real_log_convex_on]) THEN REWRITE_TAC[real_convex_on] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `u:real`; `v:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`x:real`; `y:real`; `u:real`; `v:real`]) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC AGM_2 THEN ASM_SIMP_TAC[]);; let REAL_LOG_CONVEX_ADD = prove (`!f g s:real->bool. f real_log_convex_on s /\ g real_log_convex_on s ==> (\x. f x + g x) real_log_convex_on s`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(CONJUNCTS_THEN(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LOG_CONVEX_IMP_POS))) THEN REWRITE_TAC[real_log_convex_on] THEN FIRST_X_ASSUM(CONJUNCTS_THEN (ASSUME_TAC o REWRITE_RULE[real_log_convex_on])) THEN REWRITE_TAC[real_log_convex_on] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `u:real`; `v:real`] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_ADD] THEN MP_TAC(ISPEC `0..SUC 0` HOELDER) THEN SIMP_TAC[PRODUCT_CLAUSES_NUMSEG; FINITE_NUMSEG; SUM_CLAUSES_NUMSEG; ARITH] THEN DISCH_THEN(MP_TAC o SPECL [`\i. if i = 0 then u:real else v`; `\i. if i = 0 then (f:real->real) x else f y`; `\i. if i = 0 then (g:real->real) x else g y`]) THEN REWRITE_TAC[ARITH] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_MESON_TAC[]);; let REAL_LOG_CONVEX_MUL = prove (`!f g s:real->bool. f real_log_convex_on s /\ g real_log_convex_on s ==> (\x. f x * g x) real_log_convex_on s`, REWRITE_TAC[real_log_convex_on] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; RPOW_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * (c * d):real = (a * c) * (b * d)`] THEN ASM_SIMP_TAC[REAL_LE_MUL2]);; let MIDPOINT_REAL_LOG_CONVEX = prove (`!f s:real->bool. f real_continuous_on s /\ is_realinterval s /\ (!x. x IN s ==> &0 < f x) /\ (!x y. x IN s /\ y IN s ==> f((x + y) / &2) pow 2 <= f(x) * f(y)) ==> f real_log_convex_on s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LOG_CONVEX_ON] THEN MATCH_MP_TAC REAL_CONTINUOUS_MIDPOINT_CONVEX THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_LOG THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE]; MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN REWRITE_TAC[o_DEF; REAL_ARITH `x <= y / &2 <=> &2 * x <= y`] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_EXP_ADD; REAL_MIDPOINT_IN_CONVEX]]);; let REAL_LOG_CONVEX_CONST = prove (`!s a. &0 <= a ==> (\x. a) real_log_convex_on s`, SIMP_TAC[real_log_convex_on; GSYM RPOW_ADD] THEN IMP_REWRITE_TAC[GSYM RPOW_ADD_ALT] THEN REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LE_REFL] THEN REAL_ARITH_TAC);; let REAL_LOG_CONVEX_PRODUCT = prove (`!f s k. FINITE k /\ (!i. i IN k ==> (\x. f x i) real_log_convex_on s) ==> (\x. product k (f x)) real_log_convex_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_LOG_CONVEX_CONST; REAL_POS] THEN SIMP_TAC[FORALL_IN_INSERT; REAL_LOG_CONVEX_MUL]);; let REAL_LOG_CONVEX_RPOW_RIGHT = prove (`!s a. &0 < a ==> (\x. a rpow x) real_log_convex_on s`, SIMP_TAC[real_log_convex_on; RPOW_POS_LE; REAL_LT_IMP_LE] THEN SIMP_TAC[DROP_ADD; DROP_CMUL; RPOW_ADD; RPOW_RPOW; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_MUL_AC; REAL_LE_REFL]);; let REAL_LOG_CONVEX_LIM = prove (`!net:A net f g s. ~(trivial_limit net) /\ (!x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 ==> ((\i. f i (u * x + v * y)) ---> g(u * x + v * y)) net) /\ eventually (\i. (f i) real_log_convex_on s) net ==> g real_log_convex_on s`, REWRITE_TAC[real_log_convex_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_LE] THEN CONJ_TAC THEN MATCH_MP_TAC(ISPEC `net:A net` REALLIM_LBOUND) THENL [EXISTS_TAC `\i. (f:A->real->real) i (u * x + v * y)`; EXISTS_TAC `\i. (f:A->real->real) i x rpow u * f i y rpow v - f i (u * x + v * y)`] THEN ASM_SIMP_TAC[] THEN TRY CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO))) THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REALLIM_SUB THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[] (ISPEC `\x. x rpow y` REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_AT_RPOW] THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `x:real`; `&1`; `&0`]); FIRST_X_ASSUM(MP_TAC o SPECL [`y:real`; `y:real`; `&1`; `&0`])] THEN ASM_REWRITE_TAC[REAL_POS; REAL_ADD_RID; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* Integrals of real->real functions; measures of real sets. *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_real_integral",(12,"right"));; parse_as_infix("real_integrable_on",(12,"right"));; parse_as_infix("absolutely_real_integrable_on",(12,"right"));; parse_as_infix("has_real_measure",(12,"right"));; let has_real_integral = new_definition `(f has_real_integral y) s <=> ((lift o f o drop) has_integral (lift y)) (IMAGE lift s)`;; let real_integrable_on = new_definition `f real_integrable_on i <=> ?y. (f has_real_integral y) i`;; let real_integral = new_definition `real_integral i f = @y. (f has_real_integral y) i`;; let real_negligible = new_definition `real_negligible s <=> negligible (IMAGE lift s)`;; let absolutely_real_integrable_on = new_definition `f absolutely_real_integrable_on s <=> f real_integrable_on s /\ (\x. abs(f x)) real_integrable_on s`;; let has_real_measure = new_definition `s has_real_measure m <=> ((\x. &1) has_real_integral m) s`;; let real_measurable = new_definition `real_measurable s <=> ?m. s has_real_measure m`;; let real_measure = new_definition `real_measure s = @m. s has_real_measure m`;; let HAS_REAL_INTEGRAL = prove (`(f has_real_integral y) (real_interval[a,b]) <=> ((lift o f o drop) has_integral (lift y)) (interval[lift a,lift b])`, REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL]);; let REAL_INTEGRABLE_INTEGRAL = prove (`!f i. f real_integrable_on i ==> (f has_real_integral (real_integral i f)) i`, REPEAT GEN_TAC THEN REWRITE_TAC[real_integrable_on; real_integral] THEN CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);; let HAS_REAL_INTEGRAL_INTEGRABLE = prove (`!f i s. (f has_real_integral i) s ==> f real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[]);; let HAS_REAL_INTEGRAL_INTEGRAL = prove (`!f s. f real_integrable_on s <=> (f has_real_integral (real_integral s f)) s`, MESON_TAC[REAL_INTEGRABLE_INTEGRAL; HAS_REAL_INTEGRAL_INTEGRABLE]);; let HAS_REAL_INTEGRAL_UNIQUE = prove (`!f i k1 k2. (f has_real_integral k1) i /\ (f has_real_integral k2) i ==> k1 = k2`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_UNIQUE) THEN REWRITE_TAC[LIFT_EQ]);; let REAL_INTEGRAL_UNIQUE = prove (`!f y k. (f has_real_integral y) k ==> real_integral k f = y`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE]);; let HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL = prove (`!f i s. (f has_real_integral i) s <=> f real_integrable_on s /\ real_integral s f = i`, MESON_TAC[REAL_INTEGRABLE_INTEGRAL; REAL_INTEGRAL_UNIQUE; real_integrable_on]);; let REAL_INTEGRAL_EQ_HAS_INTEGRAL = prove (`!s f y. f real_integrable_on s ==> (real_integral s f = y <=> (f has_real_integral y) s)`, MESON_TAC[REAL_INTEGRABLE_INTEGRAL; REAL_INTEGRAL_UNIQUE]);; let REAL_INTEGRABLE_ON = prove (`f real_integrable_on s <=> (lift o f o drop) integrable_on (IMAGE lift s)`, REWRITE_TAC[real_integrable_on; has_real_integral; EXISTS_DROP; integrable_on; LIFT_DROP]);; let ABSOLUTELY_REAL_INTEGRABLE_ON = prove (`f absolutely_real_integrable_on s <=> (lift o f o drop) absolutely_integrable_on (IMAGE lift s)`, REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_ON; absolutely_integrable_on] THEN REWRITE_TAC[o_DEF; LIFT_DROP; NORM_LIFT]);; let REAL_INTEGRAL = prove (`f real_integrable_on s ==> real_integral s f = drop(integral (IMAGE lift s) (lift o f o drop))`, REWRITE_TAC[REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[has_real_integral; LIFT_DROP] THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; let HAS_REAL_INTEGRAL_ALT = prove (`!f s i. (f has_real_integral i) s <=> (!a b. (\x. if x IN s then f x else &0) real_integrable_on real_interval [a,b]) /\ (!e. &0 < e ==> (?B. &0 < B /\ (!a b. real_interval(--B,B) SUBSET real_interval[a,b] ==> abs (real_integral (real_interval[a,b]) (\x. if x IN s then f x else &0) - i) < e)))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [has_real_integral] THEN GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[GSYM FORALL_LIFT; COND_RAND; LIFT_NUM; IN_IMAGE_LIFT_DROP] THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> q')) ==> (p /\ q <=> p /\ q')`) THEN DISCH_TAC THEN REWRITE_TAC[BALL_1] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_LIFT; VECTOR_ADD_LID; VECTOR_SUB_LZERO] THEN REWRITE_TAC[GSYM LIFT_NEG; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[SUBSET_LIFT_IMAGE; NORM_REAL; GSYM drop] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:real` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `b:real` THEN ASM_CASES_TAC `real_interval(--B,B) SUBSET real_interval[a,b]` THEN ASM_REWRITE_TAC[DROP_SUB; LIFT_DROP] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN IMP_REWRITE_TAC[REAL_INTEGRAL] THEN REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; COND_RAND] THEN ASM_REWRITE_TAC[LIFT_NUM; IMAGE_LIFT_REAL_INTERVAL]);; let HAS_REAL_INTEGRAL_IS_0 = prove (`!f s. (!x. x IN s ==> f(x) = &0) ==> (f has_real_integral &0) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral; LIFT_NUM] THEN MATCH_MP_TAC HAS_INTEGRAL_IS_0 THEN ASM_REWRITE_TAC[LIFT_EQ; FORALL_IN_IMAGE; o_THM; LIFT_DROP; GSYM LIFT_NUM]);; let HAS_REAL_INTEGRAL_0 = prove (`!s. ((\x. &0) has_real_integral &0) s`, SIMP_TAC[HAS_REAL_INTEGRAL_IS_0]);; let HAS_REAL_INTEGRAL_0_EQ = prove (`!i s. ((\x. &0) has_real_integral i) s <=> i = &0`, MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_0]);; let HAS_REAL_INTEGRAL_LINEAR = prove (`!f:real->real y s h:real->real. (f has_real_integral y) s /\ linear(lift o h o drop) ==> ((h o f) has_real_integral h(y)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_LINEAR) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let HAS_REAL_INTEGRAL_LMUL = prove (`!(f:real->real) k s c. (f has_real_integral k) s ==> ((\x. c * f(x)) has_real_integral (c * k)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_INTEGRAL_CMUL) THEN REWRITE_TAC[GSYM LIFT_CMUL; o_DEF]);; let HAS_REAL_INTEGRAL_RMUL = prove (`!(f:real->real) k s c. (f has_real_integral k) s ==> ((\x. f(x) * c) has_real_integral (k * c)) s`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[HAS_REAL_INTEGRAL_LMUL]);; let HAS_REAL_INTEGRAL_NEG = prove (`!f k s. (f has_real_integral k) s ==> ((\x. --(f x)) has_real_integral (--k)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_NEG) THEN REWRITE_TAC[o_DEF; LIFT_NEG]);; let HAS_REAL_INTEGRAL_ADD = prove (`!f:real->real g k l s. (f has_real_integral k) s /\ (g has_real_integral l) s ==> ((\x. f(x) + g(x)) has_real_integral (k + l)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN REWRITE_TAC[o_DEF; LIFT_ADD]);; let HAS_REAL_INTEGRAL_SUB = prove (`!f:real->real g k l s. (f has_real_integral k) s /\ (g has_real_integral l) s ==> ((\x. f(x) - g(x)) has_real_integral (k - l)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN REWRITE_TAC[o_DEF; LIFT_SUB]);; let REAL_INTEGRAL_0 = prove (`!s. real_integral s (\x. &0) = &0`, MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_0]);; let REAL_INTEGRAL_ADD = prove (`!f:real->real g s. f real_integrable_on s /\ g real_integrable_on s ==> real_integral s (\x. f x + g x) = real_integral s f + real_integral s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; let REAL_INTEGRAL_LMUL = prove (`!f:real->real c s. f real_integrable_on s ==> real_integral s (\x. c * f(x)) = c * real_integral s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; let REAL_INTEGRAL_RMUL = prove (`!f:real->real c s. f real_integrable_on s ==> real_integral s (\x. f(x) * c) = real_integral s f * c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; let REAL_INTEGRAL_NEG = prove (`!f:real->real s. f real_integrable_on s ==> real_integral s (\x. --f(x)) = --real_integral s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_NEG THEN ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; let REAL_INTEGRAL_SUB = prove (`!f:real->real g s. f real_integrable_on s /\ g real_integrable_on s ==> real_integral s (\x. f x - g x) = real_integral s f - real_integral s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; let REAL_INTEGRABLE_0 = prove (`!s. (\x. &0) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_0]);; let REAL_INTEGRABLE_ADD = prove (`!f:real->real g s. f real_integrable_on s /\ g real_integrable_on s ==> (\x. f x + g x) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_ADD]);; let REAL_INTEGRABLE_LMUL = prove (`!f:real->real c s. f real_integrable_on s ==> (\x. c * f(x)) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_LMUL]);; let REAL_INTEGRABLE_RMUL = prove (`!f:real->real c s. f real_integrable_on s ==> (\x. f(x) * c) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_RMUL]);; let REAL_INTEGRABLE_LMUL_EQ = prove (`!f s c. (\x. c * f x) real_integrable_on s <=> c = &0 \/ f real_integrable_on s`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_LMUL; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_INTEGRABLE_0] THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv c:real` o MATCH_MP REAL_INTEGRABLE_LMUL) THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LID; REAL_MUL_LINV; ETA_AX]);; let REAL_INTEGRABLE_RMUL_EQ = prove (`!f s c. (\x. f x * c) real_integrable_on s <=> c = &0 \/ f real_integrable_on s`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_INTEGRABLE_LMUL_EQ]);; let REAL_INTEGRABLE_NEG = prove (`!f:real->real s. f real_integrable_on s ==> (\x. --f(x)) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_NEG]);; let REAL_INTEGRABLE_SUB = prove (`!f:real->real g s. f real_integrable_on s /\ g real_integrable_on s ==> (\x. f x - g x) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_SUB]);; let REAL_INTEGRABLE_LINEAR = prove (`!f h s. f real_integrable_on s /\ linear(lift o h o drop) ==> (h o f) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_LINEAR]);; let REAL_INTEGRAL_LINEAR = prove (`!f:real->real s h:real->real. f real_integrable_on s /\ linear(lift o h o drop) ==> real_integral s (h o f) = h(real_integral s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC [`(h:real->real) o (f:real->real)`; `s:real->bool`] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_REAL_INTEGRAL_LINEAR] THEN ASM_SIMP_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL; REAL_INTEGRABLE_LINEAR]);; let HAS_REAL_INTEGRAL_SUM = prove (`!f:A->real->real s t. FINITE t /\ (!a. a IN t ==> ((f a) has_real_integral (i a)) s) ==> ((\x. sum t (\a. f a x)) has_real_integral (sum t i)) s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; HAS_REAL_INTEGRAL_0; IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; let REAL_INTEGRAL_SUM = prove (`!f:A->real->real s t. FINITE t /\ (!a. a IN t ==> (f a) real_integrable_on s) ==> real_integral s (\x. sum t (\a. f a x)) = sum t (\a. real_integral s (f a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; let REAL_INTEGRABLE_SUM = prove (`!f:A->real->real s t. FINITE t /\ (!a. a IN t ==> (f a) real_integrable_on s) ==> (\x. sum t (\a. f a x)) real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_SUM]);; let HAS_REAL_INTEGRAL_EQ = prove (`!f:real->real g k s. (!x. x IN s ==> (f(x) = g(x))) /\ (f has_real_integral k) s ==> (g has_real_integral k) s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_IS_0) MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_SUB) THEN SIMP_TAC[REAL_ARITH `x - (x - y:real) = y`; ETA_AX; REAL_SUB_RZERO]);; let REAL_INTEGRABLE_EQ = prove (`!f:real->real g s. (!x. x IN s ==> (f(x) = g(x))) /\ f real_integrable_on s ==> g real_integrable_on s`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_EQ]);; let HAS_REAL_INTEGRAL_EQ_EQ = prove (`!f:real->real g k s. (!x. x IN s ==> (f(x) = g(x))) ==> ((f has_real_integral k) s <=> (g has_real_integral k) s)`, MESON_TAC[HAS_REAL_INTEGRAL_EQ]);; let HAS_REAL_INTEGRAL_NULL = prove (`!f:real->real a b. b <= a ==> (f has_real_integral &0) (real_interval[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral; REAL_INTERVAL_INTERVAL] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `IMAGE (\x. x) s = s`] THEN MATCH_MP_TAC HAS_INTEGRAL_NULL THEN ASM_REWRITE_TAC[CONTENT_EQ_0_1; LIFT_DROP]);; let HAS_REAL_INTEGRAL_NULL_EQ = prove (`!f a b i. b <= a ==> ((f has_real_integral i) (real_interval[a,b]) <=> i = &0)`, ASM_MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_NULL]);; let REAL_INTEGRAL_NULL = prove (`!f a b. b <= a ==> real_integral(real_interval[a,b]) f = &0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_NULL]);; let REAL_INTEGRABLE_ON_NULL = prove (`!f a b. b <= a ==> f real_integrable_on real_interval[a,b]`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_NULL]);; let HAS_REAL_INTEGRAL_EMPTY = prove (`!f. (f has_real_integral &0) {}`, GEN_TAC THEN REWRITE_TAC[EMPTY_AS_REAL_INTERVAL] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_NULL THEN REWRITE_TAC[REAL_POS]);; let HAS_REAL_INTEGRAL_EMPTY_EQ = prove (`!f i. (f has_real_integral i) {} <=> i = &0`, MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_EMPTY]);; let REAL_INTEGRABLE_ON_EMPTY = prove (`!f. f real_integrable_on {}`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_EMPTY]);; let REAL_INTEGRAL_EMPTY = prove (`!f. real_integral {} f = &0`, MESON_TAC[EMPTY_AS_REAL_INTERVAL; REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_EMPTY]);; let HAS_REAL_INTEGRAL_REFL = prove (`!f a. (f has_real_integral &0) (real_interval[a,a])`, REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_NULL THEN REWRITE_TAC[REAL_LE_REFL]);; let REAL_INTEGRABLE_ON_REFL = prove (`!f a. f real_integrable_on real_interval[a,a]`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_REFL]);; let REAL_INTEGRAL_REFL = prove (`!f a. real_integral (real_interval[a,a]) f = &0`, MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_REFL]);; let HAS_REAL_INTEGRAL_CONST = prove (`!a b c. a <= b ==> ((\x. c) has_real_integral (c * (b - a))) (real_interval[a,b])`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL] THEN MP_TAC(ISPECL [`lift a`; `lift b`; `lift c`] HAS_INTEGRAL_CONST) THEN ASM_SIMP_TAC[o_DEF; CONTENT_1; LIFT_DROP; LIFT_CMUL]);; let REAL_INTEGRABLE_CONST = prove (`!a b c. (\x. c) real_integrable_on real_interval[a,b]`, REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_REAL_INTERVAL; o_DEF; INTEGRABLE_CONST]);; let REAL_INTEGRAL_CONST = prove (`!a b c. a <= b ==> real_integral (real_interval [a,b]) (\x. c) = c * (b - a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);; let HAS_REAL_INTEGRAL_BOUND = prove (`!f:real->real a b i B. &0 <= B /\ a <= b /\ (f has_real_integral i) (real_interval[a,b]) /\ (!x. x IN real_interval[a,b] ==> abs(f x) <= B) ==> abs i <= B * (b - a)`, REWRITE_TAC[HAS_REAL_INTEGRAL; REAL_INTERVAL_INTERVAL; GSYM NORM_LIFT] THEN REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN ASM_SIMP_TAC[GSYM CONTENT_1; LIFT_DROP] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN EXISTS_TAC `lift o f o drop` THEN ASM_REWRITE_TAC[o_THM]);; let HAS_REAL_INTEGRAL_LE = prove (`!f g s i j. (f has_real_integral i) s /\ (g has_real_integral j) s /\ (!x. x IN s ==> f x <= g x) ==> i <= j`, REWRITE_TAC[has_real_integral] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC BINOP_CONV [GSYM LIFT_DROP] THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC (ISPECL [`lift o f o drop`; `lift o g o drop`; `IMAGE lift s`] HAS_INTEGRAL_COMPONENT_LE) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; DIMINDEX_1; LE_REFL; o_THM; LIFT_DROP; GSYM drop]);; let REAL_INTEGRAL_LE = prove (`!f:real->real g:real->real s. f real_integrable_on s /\ g real_integrable_on s /\ (!x. x IN s ==> f x <= g x) ==> real_integral s f <= real_integral s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LE THEN ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);; let HAS_REAL_INTEGRAL_POS = prove (`!f:real->real s i. (f has_real_integral i) s /\ (!x. x IN s ==> &0 <= f x) ==> &0 <= i`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\x. &0):real->real`; `f:real->real`; `s:real->bool`; `&0:real`; `i:real`] HAS_REAL_INTEGRAL_LE) THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_0]);; let REAL_INTEGRAL_POS = prove (`!f:real->real s. f real_integrable_on s /\ (!x. x IN s ==> &0 <= f x) ==> &0 <= real_integral s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_POS THEN ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);; let HAS_REAL_INTEGRAL_ISNEG = prove (`!f:real->real s i. (f has_real_integral i) s /\ (!x. x IN s ==> f x <= &0) ==> i <= &0`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `(\x. &0):real->real`; `s:real->bool`; `i:real`; `&0:real`; ] HAS_REAL_INTEGRAL_LE) THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_0]);; let HAS_REAL_INTEGRAL_LBOUND = prove (`!f:real->real a b i. a <= b /\ (f has_real_integral i) (real_interval[a,b]) /\ (!x. x IN real_interval[a,b] ==> B <= f(x)) ==> B * (b - a) <= i`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\x. B):real->real`; `f:real->real`; `real_interval[a,b]`; `B * (b - a):real`; `i:real`] HAS_REAL_INTEGRAL_LE) THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);; let HAS_REAL_INTEGRAL_UBOUND = prove (`!f:real->real a b i. a <= b /\ (f has_real_integral i) (real_interval[a,b]) /\ (!x. x IN real_interval[a,b] ==> f(x) <= B) ==> i <= B * (b - a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `(\x. B):real->real`; `real_interval[a,b]`; `i:real`; `B * (b - a):real`] HAS_REAL_INTEGRAL_LE) THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);; let REAL_INTEGRAL_LBOUND = prove (`!f:real->real a b. a <= b /\ f real_integrable_on real_interval[a,b] /\ (!x. x IN real_interval[a,b] ==> B <= f(x)) ==> B * (b - a) <= real_integral(real_interval[a,b]) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LBOUND THEN EXISTS_TAC `f:real->real` THEN ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);; let REAL_INTEGRAL_UBOUND = prove (`!f:real->real a b. a <= b /\ f real_integrable_on real_interval[a,b] /\ (!x. x IN real_interval[a,b] ==> f(x) <= B) ==> real_integral(real_interval[a,b]) f <= B * (b - a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UBOUND THEN EXISTS_TAC `f:real->real` THEN ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);; let REAL_INTEGRABLE_UNIFORM_LIMIT = prove (`!f a b. (!e. &0 < e ==> ?g. (!x. x IN real_interval[a,b] ==> abs(f x - g x) <= e) /\ g real_integrable_on real_interval[a,b] ) ==> f real_integrable_on real_interval[a,b]`, REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL; GSYM EXISTS_LIFT] THEN REWRITE_TAC[GSYM integrable_on] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[o_THM; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]);; let HAS_REAL_INTEGRAL_NEGLIGIBLE = prove (`!f s t. real_negligible s /\ (!x. x IN (t DIFF s) ==> f x = &0) ==> (f has_real_integral (&0)) t`, REWRITE_TAC[has_real_integral; real_negligible; LIFT_NUM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `IMAGE lift s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[LIFT_IN_IMAGE_LIFT; LIFT_DROP] THEN ASM SET_TAC[LIFT_NUM]);; let HAS_REAL_INTEGRAL_SPIKE = prove (`!f g s t y. real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ (f has_real_integral y) t ==> (g has_real_integral y) t`, REWRITE_TAC[has_real_integral; real_negligible] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[LIFT_IN_IMAGE_LIFT; LIFT_DROP] THEN ASM SET_TAC[LIFT_NUM]);; let HAS_REAL_INTEGRAL_SPIKE_EQ = prove (`!f g s t y. real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> ((f has_real_integral y) t <=> (g has_real_integral y) t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THENL [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_ABS_SUB]);; let REAL_INTEGRABLE_SPIKE = prove (`!f g s t. real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> f real_integrable_on t ==> g real_integrable_on t`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE) THEN ASM_REWRITE_TAC[]);; let REAL_INTEGRABLE_SPIKE_EQ = prove (`!f g s t. real_negligible s /\ (!x. x IN t DIFF s ==> g x = f x) ==> (f real_integrable_on t <=> g real_integrable_on t)`, MESON_TAC[REAL_INTEGRABLE_SPIKE]);; let REAL_INTEGRAL_SPIKE = prove (`!f:real->real g s t. real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> real_integral t f = real_integral t g`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_EQ THEN ASM_MESON_TAC[]);; let REAL_NEGLIGIBLE_SUBSET = prove (`!s:real->bool t:real->bool. real_negligible s /\ t SUBSET s ==> real_negligible t`, REWRITE_TAC[real_negligible] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `IMAGE lift s` THEN ASM_SIMP_TAC[IMAGE_SUBSET]);; let REAL_NEGLIGIBLE_DIFF = prove (`!s t:real->bool. real_negligible s ==> real_negligible(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[SUBSET_DIFF]);; let REAL_NEGLIGIBLE_INTER = prove (`!s t. real_negligible s \/ real_negligible t ==> real_negligible(s INTER t)`, MESON_TAC[REAL_NEGLIGIBLE_SUBSET; INTER_SUBSET]);; let REAL_NEGLIGIBLE_UNION = prove (`!s t:real->bool. real_negligible s /\ real_negligible t ==> real_negligible (s UNION t)`, SIMP_TAC[NEGLIGIBLE_UNION; IMAGE_UNION; real_negligible]);; let REAL_NEGLIGIBLE_UNION_EQ = prove (`!s t:real->bool. real_negligible (s UNION t) <=> real_negligible s /\ real_negligible t`, MESON_TAC[REAL_NEGLIGIBLE_UNION; SUBSET_UNION; REAL_NEGLIGIBLE_SUBSET]);; let REAL_NEGLIGIBLE_SING = prove (`!a:real. real_negligible {a}`, REWRITE_TAC[real_negligible; NEGLIGIBLE_SING; IMAGE_CLAUSES]);; let REAL_NEGLIGIBLE_INSERT = prove (`!a:real s. real_negligible(a INSERT s) <=> real_negligible s`, REWRITE_TAC[real_negligible; NEGLIGIBLE_INSERT; IMAGE_CLAUSES]);; let REAL_NEGLIGIBLE_EMPTY = prove (`real_negligible {}`, REWRITE_TAC[real_negligible; NEGLIGIBLE_EMPTY; IMAGE_CLAUSES]);; let REAL_NEGLIGIBLE_FINITE = prove (`!s. FINITE s ==> real_negligible s`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[REAL_NEGLIGIBLE_EMPTY; REAL_NEGLIGIBLE_INSERT]);; let REAL_NEGLIGIBLE_UNIONS = prove (`!s. FINITE s /\ (!t. t IN s ==> real_negligible t) ==> real_negligible(UNIONS s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; REAL_NEGLIGIBLE_EMPTY; IN_INSERT] THEN SIMP_TAC[REAL_NEGLIGIBLE_UNION]);; let HAS_REAL_INTEGRAL_SPIKE_FINITE = prove (`!f:real->real g s t y. FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ (f has_real_integral y) t ==> (g has_real_integral y) t`, MESON_TAC[HAS_REAL_INTEGRAL_SPIKE; REAL_NEGLIGIBLE_FINITE]);; let HAS_REAL_INTEGRAL_SPIKE_FINITE_EQ = prove (`!f:real->real g s y. FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> ((f has_real_integral y) t <=> (g has_real_integral y) t)`, MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_FINITE]);; let REAL_INTEGRABLE_SPIKE_FINITE = prove (`!f:real->real g s. FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) ==> f real_integrable_on t ==> g real_integrable_on t`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE_FINITE) THEN ASM_REWRITE_TAC[]);; let REAL_NEGLIGIBLE_FRONTIER_INTERVAL = prove (`!a b:real. real_negligible(real_interval[a,b] DIFF real_interval(a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[real_interval; DIFF; IN_ELIM_THM] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{(a:real),b}` THEN ASM_SIMP_TAC[REAL_NEGLIGIBLE_FINITE; FINITE_RULES] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let HAS_REAL_INTEGRAL_SPIKE_INTERIOR = prove (`!f:real->real g a b y. (!x. x IN real_interval(a,b) ==> g x = f x) /\ (f has_real_integral y) (real_interval[a,b]) ==> (g has_real_integral y) (real_interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_REAL_INTEGRAL_SPIKE) THEN EXISTS_TAC `real_interval[a:real,b] DIFF real_interval(a,b)` THEN REWRITE_TAC[REAL_NEGLIGIBLE_FRONTIER_INTERVAL] THEN ASM SET_TAC[]);; let HAS_REAL_INTEGRAL_SPIKE_INTERIOR_EQ = prove (`!f:real->real g a b y. (!x. x IN real_interval(a,b) ==> g x = f x) ==> ((f has_real_integral y) (real_interval[a,b]) <=> (g has_real_integral y) (real_interval[a,b]))`, MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_INTERIOR]);; let REAL_INTEGRABLE_SPIKE_INTERIOR = prove (`!f:real->real g a b. (!x. x IN real_interval(a,b) ==> g x = f x) ==> f real_integrable_on (real_interval[a,b]) ==> g real_integrable_on (real_interval[a,b])`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE_INTERIOR) THEN ASM_REWRITE_TAC[]);; let REAL_INTEGRAL_EQ = prove (`!f g s. (!x. x IN s ==> f x = g x) ==> real_integral s f = real_integral s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{}:real->bool` THEN ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF]);; let REAL_INTEGRAL_EQ_0 = prove (`!f s. (!x. x IN s ==> f x = &0) ==> real_integral s f = &0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `real_integral s (\x. &0)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_INTEGRAL_0]]);; let REAL_INTEGRABLE_CONTINUOUS = prove (`!f a b. f real_continuous_on real_interval[a,b] ==> f real_integrable_on real_interval[a,b]`, REWRITE_TAC[REAL_CONTINUOUS_ON; real_integrable_on; has_real_integral; GSYM integrable_on; GSYM EXISTS_LIFT] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; INTEGRABLE_CONTINUOUS]);; let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS = prove (`!f f' a b. a <= b /\ (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let REAL_INTEGRABLE_SUBINTERVAL = prove (`!f:real->real a b c d. f real_integrable_on real_interval[a,b] /\ real_interval[c,d] SUBSET real_interval[a,b] ==> f real_integrable_on real_interval[c,d]`, REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL] THEN REWRITE_TAC[EXISTS_DROP; GSYM integrable_on; LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`lift a`; `lift b`] THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN ASM_SIMP_TAC[IMAGE_SUBSET]);; let HAS_REAL_INTEGRAL_COMBINE = prove (`!f i j a b c. a <= c /\ c <= b /\ (f has_real_integral i) (real_interval[a,c]) /\ (f has_real_integral j) (real_interval[c,b]) ==> (f has_real_integral (i + j)) (real_interval[a,b])`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL; LIFT_ADD] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `lift c` THEN ASM_REWRITE_TAC[LIFT_DROP]);; let REAL_INTEGRAL_COMBINE = prove (`!f a b c. a <= c /\ c <= b /\ f real_integrable_on (real_interval[a,b]) ==> real_integral(real_interval[a,c]) f + real_integral(real_interval[c,b]) f = real_integral(real_interval[a,b]) f`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; REAL_LE_REFL]);; let REAL_INTEGRABLE_COMBINE = prove (`!f a b c. a <= c /\ c <= b /\ f real_integrable_on real_interval[a,c] /\ f real_integrable_on real_interval[c,b] ==> f real_integrable_on real_interval[a,b]`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_COMBINE]);; let REAL_INTEGRABLE_ON_LITTLE_SUBINTERVALS = prove (`!f:real->real a b. (!x. x IN real_interval[a,b] ==> ?d. &0 < d /\ !u v. x IN real_interval[u,v] /\ (!y. y IN real_interval[u,v] ==> abs(y - x) < d /\ y IN real_interval[a,b]) ==> f real_integrable_on real_interval[u,v]) ==> f real_integrable_on real_interval[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL; EXISTS_DROP; GSYM integrable_on; LIFT_DROP] THEN DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_LITTLE_SUBINTERVALS THEN REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM EXISTS_DROP; FORALL_LIFT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_IN_IMAGE_LIFT]; REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE] THEN X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1` o REWRITE_RULE[SUBSET])) THEN ASM_SIMP_TAC[IN_BALL; FUN_IN_IMAGE; dist; NORM_REAL] THEN REWRITE_TAC[GSYM drop; DROP_SUB; LIFT_DROP] THEN SIMP_TAC[REAL_ABS_SUB]]);; let REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE = prove (`!f a b x. f real_integrable_on real_interval[a,b] /\ x IN real_interval[a,b] /\ f real_continuous (atreal x within real_interval[a,b]) ==> ((\u. real_integral(real_interval[a,u]) f) has_real_derivative f(x)) (atreal x within real_interval[a,b])`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; IMAGE_LIFT_REAL_INTERVAL; REAL_INTEGRABLE_ON; CONTINUOUS_CONTINUOUS_WITHINREAL; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN REWRITE_TAC[REAL_INTERVAL_INTERVAL; IN_IMAGE_LIFT_DROP; GSYM o_ASSOC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE) THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN) THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; LIFT_DROP; o_DEF] THEN REWRITE_TAC[GSYM o_DEF; SET_RULE `IMAGE (\x. x) s = s`] THEN MATCH_MP_TAC REAL_INTEGRAL THEN MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);; let REAL_INTEGRAL_HAS_REAL_DERIVATIVE = prove (`!f:real->real a b. f real_continuous_on real_interval[a,b] ==> !x. x IN real_interval[a,b] ==> ((\u. real_integral(real_interval[a,u]) f) has_real_derivative f(x)) (atreal x within real_interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE THEN ASM_MESON_TAC[REAL_INTEGRABLE_CONTINUOUS; REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]);; let REAL_ANTIDERIVATIVE_CONTINUOUS = prove (`!f a b. (f real_continuous_on real_interval[a,b]) ==> ?g. !x. x IN real_interval[a,b] ==> (g has_real_derivative f(x)) (atreal x within real_interval[a,b])`, MESON_TAC[REAL_INTEGRAL_HAS_REAL_DERIVATIVE]);; let REAL_ANTIDERIVATIVE_INTEGRAL_CONTINUOUS = prove (`!f a b. (f real_continuous_on real_interval[a,b]) ==> ?g. !u v. u IN real_interval[a,b] /\ v IN real_interval[a,b] /\ u <= v ==> (f has_real_integral (g(v) - g(u))) (real_interval[u,v])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ANTIDERIVATIVE_CONTINUOUS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN EXISTS_TAC `real_interval[a:real,b]` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; let HAS_REAL_INTEGRAL_AFFINITY = prove (`!f:real->real i a b m c. (f has_real_integral i) (real_interval[a,b]) /\ ~(m = &0) ==> ((\x. f(m * x + c)) has_real_integral (inv(abs(m)) * i)) (IMAGE (\x. inv m * (x - c)) (real_interval[a,b]))`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL] THEN DISCH_THEN(MP_TAC o SPEC `lift c` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN REWRITE_TAC[DIMINDEX_1; REAL_POW_1; has_real_integral] THEN REWRITE_TAC[o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP; LIFT_CMUL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; LIFT_DROP] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_CMUL; LIFT_SUB] THEN VECTOR_ARITH_TAC);; let REAL_INTEGRABLE_AFFINITY = prove (`!f a b m c. f real_integrable_on real_interval[a,b] /\ ~(m = &0) ==> (\x. f(m * x + c)) real_integrable_on (IMAGE (\x. inv m * (x - c)) (real_interval[a,b]))`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_AFFINITY]);; let HAS_REAL_INTEGRAL_STRETCH = prove (`!f:real->real i a b m. (f has_real_integral i) (real_interval[a,b]) /\ ~(m = &0) ==> ((\x. f(m * x)) has_real_integral (inv(abs(m)) * i)) (IMAGE (\x. inv m * x) (real_interval[a,b]))`, MP_TAC HAS_REAL_INTEGRAL_AFFINITY THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[REAL_ADD_RID; REAL_SUB_RZERO]);; let REAL_INTEGRABLE_STRETCH = prove (`!f a b m. f real_integrable_on real_interval[a,b] /\ ~(m = &0) ==> (\x. f(m * x)) real_integrable_on (IMAGE (\x. inv m * x) (real_interval[a,b]))`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_STRETCH]);; let HAS_REAL_INTEGRAL_REFLECT_LEMMA = prove (`!f:real->real i a b. (f has_real_integral i) (real_interval[a,b]) ==> ((\x. f(--x)) has_real_integral i) (real_interval[--b,--a])`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_REFLECT_LEMMA) THEN REWRITE_TAC[LIFT_NEG; o_DEF; DROP_NEG]);; let HAS_REAL_INTEGRAL_REFLECT = prove (`!f:real->real i a b. ((\x. f(--x)) has_real_integral i) (real_interval[--b,--a]) <=> (f has_real_integral i) (real_interval[a,b])`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_REFLECT_LEMMA) THEN REWRITE_TAC[REAL_NEG_NEG; ETA_AX]);; let REAL_INTEGRABLE_REFLECT = prove (`!f:real->real a b. (\x. f(--x)) real_integrable_on (real_interval[--b,--a]) <=> f real_integrable_on (real_interval[a,b])`, REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_REFLECT]);; let REAL_INTEGRAL_REFLECT = prove (`!f:real->real a b. real_integral (real_interval[--b,--a]) (\x. f(--x)) = real_integral (real_interval[a,b]) f`, REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_REFLECT]);; let HAS_REAL_INTEGRAL_REFLECT_GEN = prove (`!f i s. ((\x. f(--x)) has_real_integral i) s <=> (f has_real_integral i) (IMAGE (--) s)`, REWRITE_TAC[has_real_integral; o_DEF; GSYM DROP_NEG; HAS_INTEGRAL_REFLECT_GEN; GSYM IMAGE_o; GSYM LIFT_NEG]);; let REAL_INTEGRABLE_REFLECT_GEN = prove (`!f s. (\x. f(--x)) real_integrable_on s <=> f real_integrable_on (IMAGE (--) s)`, REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_REFLECT_GEN]);; let REAL_INTEGRAL_REFLECT_GEN = prove (`!f s. real_integral s (\x. f(--x)) = real_integral (IMAGE (--) s) f`, REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_REFLECT_GEN]);; let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR = prove (`!f:real->real f' a b. a <= b /\ f real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) ==> (f has_real_derivative f'(x)) (atreal x)) ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN REWRITE_TAC[REAL_CONTINUOUS_ON; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG = prove (`!f f' s a b. COUNTABLE s /\ a <= b /\ f real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) DIFF s ==> (f has_real_derivative f'(x)) (atreal x)) ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN SUBGOAL_THEN `!x. drop x IN s <=> x IN IMAGE lift s` (fun th -> REWRITE_TAC[th]) THENL [SET_TAC[LIFT_DROP]; ALL_TAC] THEN SUBGOAL_THEN `COUNTABLE s <=> COUNTABLE(IMAGE lift s)` SUBST1_TAC THENL [EQ_TAC THEN SIMP_TAC[COUNTABLE_IMAGE] THEN DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP COUNTABLE_IMAGE) THEN REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP; GSYM IN_DIFF; GSYM CONJ_ASSOC] THEN REWRITE_TAC[REAL_CONTINUOUS_ON; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN REWRITE_TAC[LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG = prove (`!f f' s a b. COUNTABLE s /\ a <= b /\ f real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval[a,b] DIFF s ==> (f has_real_derivative f'(x)) (atreal x)) ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN SIMP_TAC[IN_REAL_INTERVAL; IN_DIFF] THEN REAL_ARITH_TAC);; let REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT = prove (`!f:real->real a b. f real_integrable_on real_interval[a,b] ==> (\x. real_integral (real_interval[a,x]) f) real_continuous_on real_interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_INTEGRABLE_ON]) THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN GEN_REWRITE_TAC I [GSYM DROP_EQ] THEN REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP; GSYM o_DEF] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL THEN MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);; let REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT = prove (`!f:real->real a b. f real_integrable_on real_interval[a,b] ==> (\x. real_integral (real_interval[x,b]) f) real_continuous_on real_interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_INTEGRABLE_ON]) THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN GEN_REWRITE_TAC I [GSYM DROP_EQ] THEN REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP; GSYM o_DEF] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL THEN MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);; let HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL = prove (`!f:real->real a b k y. COUNTABLE k /\ f real_continuous_on real_interval[a,b] /\ f a = y /\ (!x. x IN (real_interval[a,b] DIFF k) ==> (f has_real_derivative &0) (atreal x within real_interval[a,b])) ==> !x. x IN real_interval[a,b] ==> f x = y`, REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN REWRITE_TAC[REAL_CONTINUOUS_ON; IMP_IMP; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN REWRITE_TAC[GSYM IMP_CONJ; LIFT_DROP; has_vector_derivative] THEN REWRITE_TAC[LIFT_NUM; VECTOR_MUL_RZERO] THEN STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `IMAGE lift k`; `lift y`] HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; o_THM; LIFT_DROP; LIFT_EQ; IN_DIFF] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[LIFT_DROP]);; let HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX = prove (`!f:real->real s k c y. is_realinterval s /\ COUNTABLE k /\ f real_continuous_on s /\ c IN s /\ f c = y /\ (!x. x IN (s DIFF k) ==> (f has_real_derivative &0) (atreal x within s)) ==> !x. x IN s ==> f x = y`, REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_CONTINUOUS_ON] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN REWRITE_TAC[REAL_CONTINUOUS_ON; IMP_IMP; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN REWRITE_TAC[GSYM IMP_CONJ; LIFT_DROP; has_vector_derivative] THEN REWRITE_TAC[LIFT_NUM; VECTOR_MUL_RZERO] THEN STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `IMAGE lift k`; `lift c`; `lift y`] HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; o_THM; LIFT_DROP; LIFT_EQ; IN_DIFF] THEN ASM_REWRITE_TAC[LIFT_IN_IMAGE_LIFT; FORALL_IN_IMAGE; LIFT_DROP] THEN ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; LIFT_IN_IMAGE_LIFT]);; let HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL = prove (`!f a b. f real_integrable_on real_interval[a,b] ==> ?k. real_negligible k /\ !x. x IN real_interval[a,b] DIFF k ==> ((\x. real_integral(real_interval[a,x]) f) has_real_derivative f(x)) (atreal x within real_interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL) THEN ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[IN_DIFF; FORALL_IN_IMAGE; IMP_CONJ] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE drop k` THEN ASM_REWRITE_TAC[real_negligible; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN REWRITE_TAC[IN_IMAGE; GSYM LIFT_EQ; LIFT_DROP; UNWIND_THM1] THEN X_GEN_TAC `x:real` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_THM; LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN) THEN EXISTS_TAC `&1` THEN ASM_SIMP_TAC[FUN_IN_IMAGE; REAL_LT_01] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN X_GEN_TAC `y:real` THEN REPEAT DISCH_TAC THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; o_THM] THEN REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL THEN MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_REAL_ARITH_TAC);; let HAS_REAL_INTEGRAL_RESTRICT = prove (`!f:real->real s t. s SUBSET t ==> (((\x. if x IN s then f x else &0) has_real_integral i) t <=> (f has_real_integral i) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral; o_DEF] THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `IMAGE lift t`; `lift i`] HAS_INTEGRAL_RESTRICT) THEN ASM_SIMP_TAC[IMAGE_SUBSET; IN_IMAGE_LIFT_DROP; o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[LIFT_NUM]);; let HAS_REAL_INTEGRAL_RESTRICT_UNIV = prove (`!f:real->real s i. ((\x. if x IN s then f x else &0) has_real_integral i) (:real) <=> (f has_real_integral i) s`, SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT; SUBSET_UNIV]);; let HAS_REAL_INTEGRAL_SPIKE_SET_EQ = prove (`!f s t y. real_negligible(s DIFF t UNION t DIFF s) ==> ((f has_real_integral y) s <=> (f has_real_integral y) t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_EQ THEN EXISTS_TAC `s DIFF t UNION t DIFF s:real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let HAS_REAL_INTEGRAL_SPIKE_SET = prove (`!f s t y. real_negligible(s DIFF t UNION t DIFF s) /\ (f has_real_integral y) s ==> (f has_real_integral y) t`, MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_SET_EQ]);; let REAL_INTEGRABLE_SPIKE_SET = prove (`!f s t. real_negligible(s DIFF t UNION t DIFF s) ==> f real_integrable_on s ==> f real_integrable_on t`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_SET_EQ]);; let REAL_INTEGRABLE_SPIKE_SET_EQ = prove (`!f s t. real_negligible(s DIFF t UNION t DIFF s) ==> (f real_integrable_on s <=> f real_integrable_on t)`, MESON_TAC[REAL_INTEGRABLE_SPIKE_SET; UNION_COMM]);; let REAL_INTEGRAL_SPIKE_SET = prove (`!f s t. real_negligible(s DIFF t UNION t DIFF s) ==> real_integral s f = real_integral t f`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_SET_EQ THEN ASM_MESON_TAC[]);; let HAS_REAL_INTEGRAL_OPEN_INTERVAL = prove (`!f a b y. (f has_real_integral y) (real_interval(a,b)) <=> (f has_real_integral y) (real_interval[a,b])`, REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[HAS_INTEGRAL_OPEN_INTERVAL]);; let REAL_INTEGRABLE_ON_OPEN_INTERVAL = prove (`!f a b. f real_integrable_on real_interval(a,b) <=> f real_integrable_on real_interval[a,b]`, REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_OPEN_INTERVAL]);; let REAL_INTEGRAL_OPEN_INTERVAL = prove (`!f a b. real_integral(real_interval(a,b)) f = real_integral(real_interval[a,b]) f`, REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_OPEN_INTERVAL]);; let HAS_REAL_INTEGRAL_ON_SUPERSET = prove (`!f s t. (!x. ~(x IN s) ==> f x = &0) /\ s SUBSET t /\ (f has_real_integral i) s ==> (f has_real_integral i) t`, REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]);; let REAL_INTEGRABLE_ON_SUPERSET = prove (`!f s t. (!x. ~(x IN s) ==> f x = &0) /\ s SUBSET t /\ f real_integrable_on s ==> f real_integrable_on t`, REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_ON_SUPERSET]);; let REAL_INTEGRABLE_RESTRICT_UNIV = prove (`!f s. (\x. if x IN s then f x else &0) real_integrable_on (:real) <=> f real_integrable_on s`, REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_RESTRICT_UNIV]);; let REAL_INTEGRAL_RESTRICT_UNIV = prove (`!f s. real_integral (:real) (\x. if x IN s then f x else &0) = real_integral s f`, REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT_UNIV]);; let REAL_INTEGRAL_RESTRICT = prove (`!f s t. s SUBSET t ==> real_integral t (\x. if x IN s then f x else &0) = real_integral s f`, SIMP_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT]);; let HAS_REAL_INTEGRAL_RESTRICT_INTER = prove (`!f s t. ((\x. if x IN s then f x else &0) has_real_integral i) t <=> (f has_real_integral i) (s INTER t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[IN_INTER] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; let REAL_INTEGRAL_RESTRICT_INTER = prove (`!f s t. real_integral t (\x. if x IN s then f x else &0) = real_integral (s INTER t) f`, REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT_INTER]);; let REAL_INTEGRABLE_RESTRICT_INTER = prove (`!f s t. (\x. if x IN s then f x else &0) real_integrable_on t <=> f real_integrable_on (s INTER t)`, REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_RESTRICT_INTER]);; let REAL_NEGLIGIBLE_ON_INTERVALS = prove (`!s. real_negligible s <=> !a b:real. real_negligible(s INTER real_interval[a,b])`, GEN_TAC THEN REWRITE_TAC[real_negligible] THEN GEN_REWRITE_TAC LAND_CONV [NEGLIGIBLE_ON_INTERVALS] THEN REWRITE_TAC[FORALL_LIFT; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; let HAS_REAL_INTEGRAL_SUBSET_LE = prove (`!f:real->real s t i j. s SUBSET t /\ (f has_real_integral i) s /\ (f has_real_integral j) t /\ (!x. x IN t ==> &0 <= f x) ==> i <= j`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LE THEN MAP_EVERY EXISTS_TAC [`\x:real. if x IN s then f(x) else &0`; `\x:real. if x IN t then f(x) else &0`; `(:real)`] THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; IN_UNIV] THEN X_GEN_TAC `x:real` THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL]) THEN ASM SET_TAC[]);; let REAL_INTEGRAL_SUBSET_LE = prove (`!f:real->real s t. s SUBSET t /\ f real_integrable_on s /\ f real_integrable_on t /\ (!x. x IN t ==> &0 <= f(x)) ==> real_integral s f <= real_integral t f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUBSET_LE THEN ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);; let REAL_INTEGRABLE_ON_SUBINTERVAL = prove (`!f:real->real s a b. f real_integrable_on s /\ real_interval[a,b] SUBSET s ==> f real_integrable_on real_interval[a,b]`, REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `IMAGE lift s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN ASM_SIMP_TAC[IMAGE_SUBSET]);; let REAL_INTEGRABLE_ON_SUBINTERVAL_GEN = prove (`!f s t. f real_integrable_on s /\ t SUBSET s /\ is_realinterval t ==> f real_integrable_on t`, REWRITE_TAC[REAL_INTEGRABLE_ON; IS_REALINTERVAL_IS_INTERVAL] THEN ONCE_REWRITE_TAC[GSYM SUBSET_LIFT_IMAGE] THEN REWRITE_TAC[INTEGRABLE_ON_SUBINTERVAL_GEN]);; let REAL_INTEGRABLE_STRADDLE = prove (`!f s. (!e. &0 < e ==> ?g h i j. (g has_real_integral i) s /\ (h has_real_integral j) s /\ abs(i - j) < e /\ !x. x IN s ==> g x <= f x /\ f x <= h x) ==> f real_integrable_on s`, REWRITE_TAC[REAL_INTEGRABLE_ON; has_real_integral] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXISTS_DROP; FORALL_IN_IMAGE] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; GSYM DROP_SUB; LIFT_DROP; GSYM ABS_DROP] THEN MAP_EVERY X_GEN_TAC [`g:real->real`; `h:real->real`; `i:real^1`; `j:real^1`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`lift o g o drop`; `lift o h o drop`; `i:real^1`; `j:real^1`] THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP]);; let HAS_REAL_INTEGRAL_STRADDLE_NULL = prove (`!f g s. (!x. x IN s ==> &0 <= f x /\ f x <= g x) /\ (g has_real_integral &0) s ==> (f has_real_integral &0) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRABLE_STRADDLE THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`(\x. &0):real->real`; `g:real->real`; `&0:real`; `&0:real`] THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0; REAL_SUB_REFL; REAL_ABS_NUM]; DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPECL [`f:real->real`; `g:real->real`] HAS_REAL_INTEGRAL_LE); MATCH_MP_TAC(ISPECL [`(\x. &0):real->real`; `f:real->real`] HAS_REAL_INTEGRAL_LE)] THEN EXISTS_TAC `s:real->bool` THEN ASM_SIMP_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL; HAS_REAL_INTEGRAL_0]]);; let HAS_REAL_INTEGRAL_UNION = prove (`!f i j s t. (f has_real_integral i) s /\ (f has_real_integral j) t /\ real_negligible(s INTER t) ==> (f has_real_integral (i + j)) (s UNION t)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral; real_negligible; LIFT_ADD; IMAGE_UNION] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_UNION THEN POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; let HAS_REAL_INTEGRAL_UNIONS = prove (`!f:real->real i t. FINITE t /\ (!s. s IN t ==> (f has_real_integral (i s)) s) /\ (!s s'. s IN t /\ s' IN t /\ ~(s = s') ==> real_negligible(s INTER s')) ==> (f has_real_integral (sum t i)) (UNIONS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral; real_negligible; LIFT_ADD; IMAGE_UNIONS] THEN SIMP_TAC[LIFT_SUM] THEN DISCH_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `\s. lift(i(IMAGE drop s))`; `IMAGE (IMAGE lift) t`] HAS_INTEGRAL_UNIONS) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM; IMAGE_LIFT_DROP; GSYM IMAGE_o] THEN ASM_SIMP_TAC[LIFT_EQ; SET_RULE `(!x y. f x = f y <=> x = y) ==> (IMAGE f s = IMAGE f t <=> s = t) /\ (IMAGE f s INTER IMAGE f t = IMAGE f (s INTER t))`] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[LIFT_DROP]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF; GSYM IMAGE_o; IMAGE_LIFT_DROP]);; let REAL_MONOTONE_CONVERGENCE_INCREASING = prove (`!f:num->real->real g s. (!k. (f k) real_integrable_on s) /\ (!k x. x IN s ==> f k x <= f (SUC k) x) /\ (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) /\ real_bounded {real_integral s (f k) | k IN (:num)} ==> g real_integrable_on s /\ ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; `lift o g o drop`; `IMAGE lift s`] MONOTONE_CONVERGENCE_INCREASING) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN SUBGOAL_THEN `!k:num. real_integral s (f k) = drop(integral (IMAGE lift s) (lift o f k o drop))` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);; let REAL_MONOTONE_CONVERGENCE_DECREASING = prove (`!f:num->real->real g s. (!k. (f k) real_integrable_on s) /\ (!k x. x IN s ==> f (SUC k) x <= f k x) /\ (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) /\ real_bounded {real_integral s (f k) | k IN (:num)} ==> g real_integrable_on s /\ ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; `lift o g o drop`; `IMAGE lift s`] MONOTONE_CONVERGENCE_DECREASING) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN SUBGOAL_THEN `!k:num. real_integral s (f k) = drop(integral (IMAGE lift s) (lift o f k o drop))` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);; let REAL_BEPPO_LEVI_INCREASING = prove (`!f s. (!k. (f k) real_integrable_on s) /\ (!k x. x IN s ==> f k x <= f (SUC k) x) /\ real_bounded {real_integral s (f k) | k IN (:num)} ==> ?g k. real_negligible k /\ !x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; `IMAGE lift s`] BEPPO_LEVI_INCREASING) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN SUBGOAL_THEN `!k:num. real_integral s (f k) = drop(integral (IMAGE lift s) (lift o f k o drop))` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP]);; let REAL_BEPPO_LEVI_DECREASING = prove (`!f s. (!k. (f k) real_integrable_on s) /\ (!k x. x IN s ==> f (SUC k) x <= f k x) /\ real_bounded {real_integral s (f k) | k IN (:num)} ==> ?g k. real_negligible k /\ !x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; `IMAGE lift s`] BEPPO_LEVI_DECREASING) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN SUBGOAL_THEN `!k:num. real_integral s (f k) = drop(integral (IMAGE lift s) (lift o f k o drop))` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP]);; let REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING = prove (`!f s. (!k. (f k) real_integrable_on s) /\ (!k x. x IN s ==> f k x <= f (SUC k) x) /\ real_bounded {real_integral s (f k) | k IN (:num)} ==> ?g k. real_negligible k /\ (!x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially) /\ g real_integrable_on s /\ ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; `IMAGE lift s`] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN SUBGOAL_THEN `!k:num. real_integral s (f k) = drop(integral (IMAGE lift s) (lift o f k o drop))` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP; ETA_AX] THEN SUBGOAL_THEN `real_integral s (drop o g o lift) = drop(integral (IMAGE lift s) (lift o (drop o g o lift) o drop))` SUBST1_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX]; ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; let REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING = prove (`!f s. (!k. (f k) real_integrable_on s) /\ (!k x. x IN s ==> f (SUC k) x <= f k x) /\ real_bounded {real_integral s (f k) | k IN (:num)} ==> ?g k. real_negligible k /\ (!x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially) /\ g real_integrable_on s /\ ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; `IMAGE lift s`] BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN SUBGOAL_THEN `!k:num. real_integral s (f k) = drop(integral (IMAGE lift s) (lift o f k o drop))` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP; ETA_AX] THEN SUBGOAL_THEN `real_integral s (drop o g o lift) = drop(integral (IMAGE lift s) (lift o (drop o g o lift) o drop))` SUBST1_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX]; ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; let REAL_INTEGRAL_ABS_BOUND_INTEGRAL = prove (`!f:real->real g s. f real_integrable_on s /\ g real_integrable_on s /\ (!x. x IN s ==> abs(f x) <= g x) ==> abs(real_integral s f) <= real_integral s g`, SIMP_TAC[REAL_INTEGRAL; GSYM ABS_DROP] THEN SIMP_TAC[REAL_INTEGRABLE_ON; INTEGRAL_NORM_BOUND_INTEGRAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);; let ABSOLUTELY_REAL_INTEGRABLE_LE = prove (`!f:real->real s. f absolutely_real_integrable_on s ==> abs(real_integral s f) <= real_integral s (\x. abs(f x))`, SIMP_TAC[absolutely_real_integrable_on] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; let ABSOLUTELY_REAL_INTEGRABLE_0 = prove (`!s. (\x. &0) absolutely_real_integrable_on s`, REWRITE_TAC[absolutely_real_integrable_on; REAL_ABS_NUM; REAL_INTEGRABLE_0]);; let ABSOLUTELY_REAL_INTEGRABLE_CONST = prove (`!a b c. (\x. c) absolutely_real_integrable_on real_interval[a,b]`, REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_CONST]);; let ABSOLUTELY_REAL_INTEGRABLE_LMUL = prove (`!f s c. f absolutely_real_integrable_on s ==> (\x. c * f(x)) absolutely_real_integrable_on s`, SIMP_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_LMUL; REAL_ABS_MUL]);; let ABSOLUTELY_REAL_INTEGRABLE_RMUL = prove (`!f s c. f absolutely_real_integrable_on s ==> (\x. f(x) * c) absolutely_real_integrable_on s`, SIMP_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_RMUL; REAL_ABS_MUL]);; let ABSOLUTELY_REAL_INTEGRABLE_NEG = prove (`!f s. f absolutely_real_integrable_on s ==> (\x. --f(x)) absolutely_real_integrable_on s`, SIMP_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_NEG; REAL_ABS_NEG]);; let ABSOLUTELY_REAL_INTEGRABLE_ABS = prove (`!f s. f absolutely_real_integrable_on s ==> (\x. abs(f x)) absolutely_real_integrable_on s`, SIMP_TAC[absolutely_real_integrable_on; REAL_ABS_ABS]);; let ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL = prove (`!f:real->real s a b. f absolutely_real_integrable_on s /\ real_interval[a,b] SUBSET s ==> f absolutely_real_integrable_on real_interval[a,b]`, REWRITE_TAC[absolutely_real_integrable_on] THEN MESON_TAC[REAL_INTEGRABLE_ON_SUBINTERVAL]);; let ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV = prove (`!f s. (\x. if x IN s then f x else &0) absolutely_real_integrable_on (:real) <=> f absolutely_real_integrable_on s`, REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_RESTRICT_UNIV; COND_RAND; REAL_ABS_NUM]);; let ABSOLUTELY_REAL_INTEGRABLE_ADD = prove (`!f:real->real g s. f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s ==> (\x. f(x) + g(x)) absolutely_real_integrable_on s`, REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN SIMP_TAC[o_DEF; LIFT_ADD; ABSOLUTELY_INTEGRABLE_ADD]);; let ABSOLUTELY_REAL_INTEGRABLE_SUB = prove (`!f:real->real g s. f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s ==> (\x. f(x) - g(x)) absolutely_real_integrable_on s`, REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN SIMP_TAC[o_DEF; LIFT_SUB; ABSOLUTELY_INTEGRABLE_SUB]);; let ABSOLUTELY_REAL_INTEGRABLE_LINEAR = prove (`!f h s. f absolutely_real_integrable_on s /\ linear(lift o h o drop) ==> (h o f) absolutely_real_integrable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_LINEAR) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let ABSOLUTELY_REAL_INTEGRABLE_SUM = prove (`!f:A->real->real s t. FINITE t /\ (!a. a IN t ==> (f a) absolutely_real_integrable_on s) ==> (\x. sum t (\a. f a x)) absolutely_real_integrable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; ABSOLUTELY_REAL_INTEGRABLE_0; IN_INSERT; ABSOLUTELY_REAL_INTEGRABLE_ADD; ETA_AX]);; let ABSOLUTELY_REAL_INTEGRABLE_MAX = prove (`!f:real->real g:real->real s. f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s ==> (\x. max (f x) (g x)) absolutely_real_integrable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `max a b = &1 / &2 * ((a + b) + abs(a - b))`] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_ABS]);; let ABSOLUTELY_REAL_INTEGRABLE_MIN = prove (`!f:real->real g:real->real s. f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s ==> (\x. min (f x) (g x)) absolutely_real_integrable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `min a b = &1 / &2 * ((a + b) - abs(a - b))`] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_ADD; ABSOLUTELY_REAL_INTEGRABLE_ABS]);; let ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE = prove (`!f s. f absolutely_real_integrable_on s ==> f real_integrable_on s`, SIMP_TAC[absolutely_real_integrable_on]);; let ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS = prove (`!f a b. f real_continuous_on real_interval[a,b] ==> f absolutely_real_integrable_on real_interval[a,b]`, REWRITE_TAC[REAL_CONTINUOUS_ON; ABSOLUTELY_REAL_INTEGRABLE_ON; has_real_integral; GSYM integrable_on; GSYM EXISTS_LIFT] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; ABSOLUTELY_INTEGRABLE_CONTINUOUS]);; let NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE = prove (`!f s. (!x. x IN s ==> &0 <= f(x)) /\ f real_integrable_on s ==> f absolutely_real_integrable_on s`, SIMP_TAC[absolutely_real_integrable_on] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN EXISTS_TAC `f:real->real` THEN ASM_SIMP_TAC[real_abs]);; let ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND = prove (`!f:real->real g s. (!x. x IN s ==> abs(f x) <= g x) /\ f real_integrable_on s /\ g real_integrable_on s ==> f absolutely_real_integrable_on s`, REWRITE_TAC[REAL_INTEGRABLE_ON; ABSOLUTELY_REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; NORM_LIFT]);; let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_BOUND = prove (`!f:real->real g:real->real s. (!x. x IN s ==> abs(f x) <= abs(g x)) /\ f real_integrable_on s /\ g absolutely_real_integrable_on s ==> f absolutely_real_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND THEN EXISTS_TAC `\x:real. abs(g x)` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[absolutely_real_integrable_on]) THEN ASM_REWRITE_TAC[]);; let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_UBOUND = prove (`!f:real->real g:real->real s. (!x. x IN s ==> f x <= g x) /\ f real_integrable_on s /\ g absolutely_real_integrable_on s ==> g absolutely_real_integrable_on s`, REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; o_THM; LIFT_DROP; GSYM drop]);; let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND = prove (`!f:real->real g:real->real s. (!x. x IN s ==> f x <= g x) /\ f absolutely_real_integrable_on s /\ g real_integrable_on s ==> g absolutely_real_integrable_on s`, REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN EXISTS_TAC `lift o f o drop` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; o_THM; LIFT_DROP; GSYM drop]);; let ABSOLUTELY_REAL_INTEGRABLE_INF = prove (`!fs s:real->bool k:A->bool. FINITE k /\ ~(k = {}) /\ (!i. i IN k ==> (\x. fs x i) absolutely_real_integrable_on s) ==> (\x. inf (IMAGE (fs x) k)) absolutely_real_integrable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MIN THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT]);; let ABSOLUTELY_REAL_INTEGRABLE_SUP = prove (`!fs s:real->bool k:A->bool. FINITE k /\ ~(k = {}) /\ (!i. i IN k ==> (\x. fs x i) absolutely_real_integrable_on s) ==> (\x. sup (IMAGE (fs x) k)) absolutely_real_integrable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT]);; let REAL_DOMINATED_CONVERGENCE = prove (`!f:num->real->real g h s. (!k. (f k) real_integrable_on s) /\ h real_integrable_on s /\ (!k x. x IN s ==> abs(f k x) <= h x) /\ (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) ==> g real_integrable_on s /\ ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; `lift o g o drop`; `lift o h o drop`; `IMAGE lift s`] DOMINATED_CONVERGENCE) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF; NORM_LIFT] THEN SUBGOAL_THEN `!k:num. real_integral s (f k) = drop(integral (IMAGE lift s) (lift o f k o drop))` (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) THENL [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; ALL_TAC] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);; let HAS_REAL_MEASURE_HAS_MEASURE = prove (`!s m. s has_real_measure m <=> (IMAGE lift s) has_measure m`, REWRITE_TAC[has_real_measure; has_measure; has_real_integral] THEN REWRITE_TAC[o_DEF; LIFT_NUM]);; let REAL_MEASURABLE_MEASURABLE = prove (`!s. real_measurable s <=> measurable(IMAGE lift s)`, REWRITE_TAC[real_measurable; measurable; HAS_REAL_MEASURE_HAS_MEASURE]);; let REAL_MEASURE_MEASURE = prove (`!s. real_measure s = measure (IMAGE lift s)`, REWRITE_TAC[real_measure; measure; HAS_REAL_MEASURE_HAS_MEASURE]);; let HAS_REAL_MEASURE_MEASURE = prove (`!s. real_measurable s <=> s has_real_measure (real_measure s)`, REWRITE_TAC[real_measure; real_measurable] THEN MESON_TAC[]);; let HAS_REAL_MEASURE_UNIQUE = prove (`!s m1 m2. s has_real_measure m1 /\ s has_real_measure m2 ==> m1 = m2`, REWRITE_TAC[has_real_measure] THEN MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE]);; let REAL_MEASURE_UNIQUE = prove (`!s m. s has_real_measure m ==> real_measure s = m`, MESON_TAC[HAS_REAL_MEASURE_UNIQUE; HAS_REAL_MEASURE_MEASURE; real_measurable]);; let HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE = prove (`!s m. s has_real_measure m <=> real_measurable s /\ real_measure s = m`, REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN MESON_TAC[REAL_MEASURE_UNIQUE]);; let HAS_REAL_MEASURE_IMP_REAL_MEASURABLE = prove (`!s m. s has_real_measure m ==> real_measurable s`, REWRITE_TAC[real_measurable] THEN MESON_TAC[]);; let HAS_REAL_MEASURE = prove (`!s m. s has_real_measure m <=> ((\x. if x IN s then &1 else &0) has_real_integral m) (:real)`, SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; has_real_measure]);; let REAL_MEASURABLE = prove (`!s. real_measurable s <=> (\x. &1) real_integrable_on s`, REWRITE_TAC[real_measurable; real_integrable_on; has_real_measure; EXISTS_DROP; LIFT_DROP]);; let REAL_MEASURABLE_REAL_INTEGRABLE = prove (`real_measurable s <=> (\x. if x IN s then &1 else &0) real_integrable_on UNIV`, REWRITE_TAC[real_measurable; real_integrable_on; HAS_REAL_MEASURE]);; let REAL_MEASURE_REAL_INTEGRAL = prove (`!s. real_measurable s ==> real_measure s = real_integral s (\x. &1)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[GSYM has_real_measure; GSYM HAS_REAL_MEASURE_MEASURE]);; let REAL_MEASURE_REAL_INTEGRAL_UNIV = prove (`!s. real_measurable s ==> real_measure s = real_integral UNIV (\x. if x IN s then &1 else &0)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[GSYM HAS_REAL_MEASURE; GSYM HAS_REAL_MEASURE_MEASURE]);; let REAL_INTEGRAL_REAL_MEASURE = prove (`!s. real_measurable s ==> real_integral s (\x. &1) = real_measure s`, SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; REAL_MEASURE_REAL_INTEGRAL]);; let REAL_INTEGRAL_REAL_MEASURE_UNIV = prove (`!s. real_measurable s ==> real_integral UNIV (\x. if x IN s then &1 else &0) = real_measure s`, SIMP_TAC[REAL_MEASURE_REAL_INTEGRAL_UNIV]);; let HAS_REAL_MEASURE_REAL_INTERVAL = prove (`(!a b. real_interval[a,b] has_real_measure (max (b - a) (&0))) /\ (!a b. real_interval(a,b) has_real_measure (max (b - a) (&0)))`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_INTERVAL; MEASURE_INTERVAL] THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[PRODUCT_1; GSYM drop; LIFT_DROP] THEN REAL_ARITH_TAC);; let REAL_MEASURABLE_REAL_INTERVAL = prove (`(!a b. real_measurable (real_interval[a,b])) /\ (!a b. real_measurable (real_interval(a,b)))`, REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_REAL_INTERVAL]);; let REAL_MEASURE_REAL_INTERVAL = prove (`(!a b. real_measure(real_interval[a,b]) = max (b - a) (&0)) /\ (!a b. real_measure(real_interval(a,b)) = max (b - a) (&0))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN REWRITE_TAC[HAS_REAL_MEASURE_REAL_INTERVAL]);; let REAL_MEASURABLE_INTER = prove (`!s t. real_measurable s /\ real_measurable t ==> real_measurable (s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_INTER) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; let REAL_MEASURABLE_UNION = prove (`!s t. real_measurable s /\ real_measurable t ==> real_measurable (s UNION t)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_UNION) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; let HAS_REAL_MEASURE_DISJOINT_UNION = prove (`!s1 s2 m1 m2. s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ DISJOINT s1 s2 ==> (s1 UNION s2) has_real_measure (m1 + m2)`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; IMAGE_UNION] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_DISJOINT_UNION THEN ASM SET_TAC[LIFT_DROP]);; let REAL_MEASURE_DISJOINT_UNION = prove (`!s t. real_measurable s /\ real_measurable t /\ DISJOINT s t ==> real_measure(s UNION t) = real_measure s + real_measure t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNION; GSYM HAS_REAL_MEASURE_MEASURE]);; let HAS_REAL_MEASURE_POS_LE = prove (`!m s. s has_real_measure m ==> &0 <= m`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; HAS_MEASURE_POS_LE]);; let REAL_MEASURE_POS_LE = prove (`!s. real_measurable s ==> &0 <= real_measure s`, REWRITE_TAC[HAS_REAL_MEASURE_MEASURE; HAS_REAL_MEASURE_POS_LE]);; let HAS_REAL_MEASURE_SUBSET = prove (`!s1 s2 m1 m2. s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ s1 SUBSET s2 ==> m1 <= m2`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPECL [`IMAGE lift s1`; `IMAGE lift s2`] HAS_MEASURE_SUBSET) THEN ASM SET_TAC[HAS_MEASURE_SUBSET]);; let REAL_MEASURE_SUBSET = prove (`!s t. real_measurable s /\ real_measurable t /\ s SUBSET t ==> real_measure s <= real_measure t`, REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN MESON_TAC[HAS_REAL_MEASURE_SUBSET]);; let HAS_REAL_MEASURE_0 = prove (`!s. s has_real_measure &0 <=> real_negligible s`, REWRITE_TAC[real_negligible; HAS_REAL_MEASURE_HAS_MEASURE] THEN REWRITE_TAC[HAS_MEASURE_0]);; let REAL_MEASURE_EQ_0 = prove (`!s. real_negligible s ==> real_measure s = &0`, MESON_TAC[REAL_MEASURE_UNIQUE; HAS_REAL_MEASURE_0]);; let HAS_REAL_MEASURE_EMPTY = prove (`{} has_real_measure &0`, REWRITE_TAC[HAS_REAL_MEASURE_0; REAL_NEGLIGIBLE_EMPTY]);; let REAL_MEASURE_EMPTY = prove (`real_measure {} = &0`, SIMP_TAC[REAL_MEASURE_EQ_0; REAL_NEGLIGIBLE_EMPTY]);; let REAL_MEASURABLE_EMPTY = prove (`real_measurable {}`, REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_EMPTY]);; let REAL_MEASURABLE_REAL_MEASURE_EQ_0 = prove (`!s. real_measurable s ==> (real_measure s = &0 <=> real_negligible s)`, REWRITE_TAC[HAS_REAL_MEASURE_MEASURE; GSYM HAS_REAL_MEASURE_0] THEN MESON_TAC[REAL_MEASURE_UNIQUE]);; let REAL_MEASURABLE_REAL_MEASURE_POS_LT = prove (`!s. real_measurable s ==> (&0 < real_measure s <=> ~real_negligible s)`, SIMP_TAC[REAL_LT_LE; REAL_MEASURE_POS_LE; GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0] THEN REWRITE_TAC[EQ_SYM_EQ]);; let REAL_NEGLIGIBLE_REAL_INTERVAL = prove (`(!a b. real_negligible(real_interval[a,b]) <=> real_interval(a,b) = {}) /\ (!a b. real_negligible(real_interval(a,b)) <=> real_interval(a,b) = {})`, REWRITE_TAC[real_negligible; IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[NEGLIGIBLE_INTERVAL] THEN REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; INTERVAL_EQ_EMPTY_1; LIFT_DROP]);; let REAL_MEASURABLE_UNIONS = prove (`!f. FINITE f /\ (!s. s IN f ==> real_measurable s) ==> real_measurable (UNIONS f)`, REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; IMAGE_UNIONS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE]);; let HAS_REAL_MEASURE_DIFF_SUBSET = prove (`!s1 s2 m1 m2. s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ s2 SUBSET s1 ==> (s1 DIFF s2) has_real_measure (m1 - m2)`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN REPEAT STRIP_TAC THEN SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN MATCH_MP_TAC HAS_MEASURE_DIFF_SUBSET THEN ASM_SIMP_TAC[IMAGE_SUBSET]);; let REAL_MEASURABLE_DIFF = prove (`!s t. real_measurable s /\ real_measurable t ==> real_measurable (s DIFF t)`, SIMP_TAC[REAL_MEASURABLE_MEASURABLE; IMAGE_DIFF_INJ; LIFT_EQ] THEN REWRITE_TAC[MEASURABLE_DIFF]);; let REAL_MEASURE_DIFF_SUBSET = prove (`!s t. real_measurable s /\ real_measurable t /\ t SUBSET s ==> real_measure(s DIFF t) = real_measure s - real_measure t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_DIFF_SUBSET; GSYM HAS_REAL_MEASURE_MEASURE]);; let HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE = prove (`!s t m. s has_real_measure m /\ real_negligible t ==> (s UNION t) has_real_measure m`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN REWRITE_TAC[HAS_MEASURE_UNION_NEGLIGIBLE]);; let HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE = prove (`!s t m. s has_real_measure m /\ real_negligible t ==> (s DIFF t) has_real_measure m`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible] THEN SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN REWRITE_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE]);; let HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE_EQ = prove (`!s t m. real_negligible t ==> ((s UNION t) has_real_measure m <=> s has_real_measure m)`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN REWRITE_TAC[HAS_MEASURE_UNION_NEGLIGIBLE_EQ]);; let HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE_EQ = prove (`!s t m. real_negligible t ==> ((s DIFF t) has_real_measure m <=> s has_real_measure m)`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible] THEN SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN REWRITE_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE_EQ]);; let HAS_REAL_MEASURE_ALMOST = prove (`!s s' t m. s has_real_measure m /\ real_negligible t /\ s UNION t = s' UNION t ==> s' has_real_measure m`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN MAP_EVERY EXISTS_TAC [`IMAGE lift s`; `IMAGE lift t`] THEN ASM SET_TAC[]);; let HAS_REAL_MEASURE_ALMOST_EQ = prove (`!s s' t. real_negligible t /\ s UNION t = s' UNION t ==> (s has_real_measure m <=> s' has_real_measure m)`, MESON_TAC[HAS_REAL_MEASURE_ALMOST]);; let REAL_MEASURABLE_ALMOST = prove (`!s s' t. real_measurable s /\ real_negligible t /\ s UNION t = s' UNION t ==> real_measurable s'`, REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_ALMOST]);; let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION = prove (`!s1 s2 m1 m2. s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ real_negligible(s1 INTER s2) ==> (s1 UNION s2) has_real_measure (m1 + m2)`, REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN SIMP_TAC[IMAGE_INTER_INJ; LIFT_EQ] THEN REWRITE_TAC[HAS_MEASURE_NEGLIGIBLE_UNION]);; let REAL_MEASURE_REAL_NEGLIGIBLE_UNION = prove (`!s t. real_measurable s /\ real_measurable t /\ real_negligible(s INTER t) ==> real_measure(s UNION t) = real_measure s + real_measure t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION; GSYM HAS_REAL_MEASURE_MEASURE]);; let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF = prove (`!s t m. s has_real_measure m /\ real_negligible((s DIFF t) UNION (t DIFF s)) ==> t has_real_measure m`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_ALMOST THEN MAP_EVERY EXISTS_TAC [`s:real->bool`; `(s DIFF t) UNION (t DIFF s):real->bool`] THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF = prove (`!s t. real_measurable s /\ real_negligible((s DIFF t) UNION (t DIFF s)) ==> real_measurable t`, REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF]);; let REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF = prove (`!s t. (real_measurable s \/ real_measurable t) /\ real_negligible((s DIFF t) UNION (t DIFF s)) ==> real_measure s = real_measure t`, MESON_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF; REAL_MEASURE_UNIQUE; UNION_COMM; HAS_REAL_MEASURE_MEASURE]);; let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS = prove (`!m f. FINITE f /\ (!s. s IN f ==> s has_real_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> real_negligible(s INTER t)) ==> (UNIONS f) has_real_measure (sum f m)`, GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; UNIONS_0; UNIONS_INSERT; HAS_REAL_MEASURE_EMPTY] THEN REWRITE_TAC[IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`s:real->bool`; `f:(real->bool)->bool`] THEN STRIP_TAC THEN STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS = prove (`!m f. FINITE f /\ (!s. s IN f ==> s has_real_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> real_negligible(s INTER t)) ==> real_measure(UNIONS f) = sum f m`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS]);; let HAS_REAL_MEASURE_DISJOINT_UNIONS = prove (`!m f. FINITE f /\ (!s. s IN f ==> s has_real_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) ==> (UNIONS f) has_real_measure (sum f m)`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);; let REAL_MEASURE_DISJOINT_UNIONS = prove (`!m f:(real->bool)->bool. FINITE f /\ (!s. s IN f ==> s has_real_measure (m s)) /\ (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) ==> real_measure(UNIONS f) = sum f m`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS]);; let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE = prove (`!f:A->(real->bool) s. FINITE s /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> real_negligible((f x) INTER (f y))) ==> (UNIONS (IMAGE f s)) has_real_measure (sum s (\x. real_measure(f x)))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `sum s (\x. real_measure(f x)) = sum (IMAGE (f:A->real->bool) s) real_measure` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`]) THEN ASM_SIMP_TAC[INTER_ACI; REAL_MEASURABLE_REAL_MEASURE_EQ_0]; MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS THEN ASM_SIMP_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[FINITE_IMAGE; HAS_REAL_MEASURE_MEASURE]]);; let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE = prove (`!f:A->real->bool s. FINITE s /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> real_negligible((f x) INTER (f y))) ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE]);; let HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE = prove (`!f:A->real->bool s. FINITE s /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> (UNIONS (IMAGE f s)) has_real_measure (sum s (\x. real_measure(f x)))`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE THEN ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);; let REAL_MEASURE_DISJOINT_UNIONS_IMAGE = prove (`!f:A->real->bool s. FINITE s /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE]);; let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove (`!f:A->real->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> real_negligible((f x) INTER (f y))) ==> (UNIONS (IMAGE f s)) has_real_measure (sum s (\x. real_measure(f x)))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:A->real->bool`; `{x | x IN s /\ ~((f:A->real->bool) x = {})}`] HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE) THEN ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[NOT_IN_EMPTY]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN REWRITE_TAC[REAL_MEASURE_EMPTY]]);; let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove (`!f:A->real->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> real_negligible((f x) INTER (f y))) ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);; let HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove (`!f:A->real->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> (UNIONS (IMAGE f s)) has_real_measure (sum s (\x. real_measure(f x)))`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);; let REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove (`!f:A->real->bool s. FINITE {x | x IN s /\ ~(f x = {})} /\ (!x. x IN s ==> real_measurable(f x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);; let REAL_MEASURE_UNION = prove (`!s t. real_measurable s /\ real_measurable t ==> real_measure(s UNION t) = real_measure(s) + real_measure(t) - real_measure(s INTER t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t = (s INTER t) UNION (s DIFF t) UNION (t DIFF s)`] THEN ONCE_REWRITE_TAC[REAL_ARITH `a + b - c:real = c + (a - c) + (b - c)`] THEN MP_TAC(ISPECL [`s DIFF t:real->bool`; `t DIFF s:real->bool`] REAL_MEASURE_DISJOINT_UNION) THEN ASM_SIMP_TAC[REAL_MEASURABLE_DIFF] THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s INTER t:real->bool`; `(s DIFF t) UNION (t DIFF s):real->bool`] REAL_MEASURE_DISJOINT_UNION) THEN ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; REAL_MEASURABLE_UNION; REAL_MEASURABLE_INTER] THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL [EXISTS_TAC `real_measure((s DIFF t) UNION (s INTER t):real->bool)`; EXISTS_TAC `real_measure((t DIFF s) UNION (s INTER t):real->bool)`] THEN (CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MEASURE_DISJOINT_UNION THEN ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; REAL_MEASURABLE_INTER]; AP_TERM_TAC] THEN SET_TAC[]));; let REAL_MEASURE_UNION_LE = prove (`!s t. real_measurable s /\ real_measurable t ==> real_measure(s UNION t) <= real_measure s + real_measure t`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_MEASURE_UNION] THEN REWRITE_TAC[REAL_ARITH `a + b - c <= a + b <=> &0 <= c`] THEN MATCH_MP_TAC REAL_MEASURE_POS_LE THEN ASM_SIMP_TAC[REAL_MEASURABLE_INTER]);; let REAL_MEASURE_UNIONS_LE = prove (`!f. FINITE f /\ (!s. s IN f ==> real_measurable s) ==> real_measure(UNIONS f) <= sum f (\s. real_measure s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN REWRITE_TAC[REAL_MEASURE_EMPTY; REAL_LE_REFL] THEN MAP_EVERY X_GEN_TAC [`s:real->bool`; `f:(real->bool)->bool`] THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `real_measure(s) + real_measure(UNIONS f)` THEN ASM_SIMP_TAC[REAL_MEASURE_UNION_LE; REAL_MEASURABLE_UNIONS] THEN REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; let REAL_MEASURE_UNIONS_LE_IMAGE = prove (`!f:A->bool s:A->(real->bool). FINITE f /\ (!a. a IN f ==> real_measurable(s a)) ==> real_measure(UNIONS (IMAGE s f)) <= sum f (\a. real_measure(s a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\k:real->bool. real_measure k)` THEN ASM_SIMP_TAC[REAL_MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN ASM_SIMP_TAC[REAL_MEASURE_POS_LE]);; let REAL_NEGLIGIBLE_OUTER = prove (`!s. real_negligible s <=> !e. &0 < e ==> ?t. s SUBSET t /\ real_measurable t /\ real_measure t < e`, REWRITE_TAC[real_negligible; REAL_MEASURABLE_MEASURABLE; REAL_MEASURE_MEASURE; SUBSET_LIFT_IMAGE; NEGLIGIBLE_OUTER; EXISTS_LIFT_IMAGE]);; let REAL_NEGLIGIBLE_OUTER_LE = prove (`!s. real_negligible s <=> !e. &0 < e ==> ?t. s SUBSET t /\ real_measurable t /\ real_measure t <= e`, REWRITE_TAC[real_negligible; REAL_MEASURABLE_MEASURABLE; REAL_MEASURE_MEASURE; SUBSET_LIFT_IMAGE; NEGLIGIBLE_OUTER_LE; EXISTS_LIFT_IMAGE]);; let REAL_MEASURABLE_INNER_OUTER = prove (`!s. real_measurable s <=> !e. &0 < e ==> ?t u. t SUBSET s /\ s SUBSET u /\ real_measurable t /\ real_measurable u /\ abs(real_measure t - real_measure u) < e`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM]; ALL_TAC] THEN REWRITE_TAC[REAL_MEASURABLE_REAL_INTEGRABLE] THEN MATCH_MP_TAC REAL_INTEGRABLE_STRADDLE THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real->bool`; `u:real->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(\x. if x IN t then &1 else &0):real->real`; `(\x. if x IN u then &1 else &0):real->real`; `real_measure(t:real->bool)`; `real_measure(u:real->bool)`] THEN ASM_REWRITE_TAC[GSYM HAS_REAL_MEASURE; GSYM HAS_REAL_MEASURE_MEASURE] THEN ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN ASM SET_TAC[]);; let HAS_REAL_MEASURE_INNER_OUTER = prove (`!s m. s has_real_measure m <=> (!e. &0 < e ==> ?t. t SUBSET s /\ real_measurable t /\ m - e < real_measure t) /\ (!e. &0 < e ==> ?u. s SUBSET u /\ real_measurable u /\ real_measure u < m + e)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE] THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [REAL_MEASURABLE_INNER_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "u" (MP_TAC o SPEC `e / &2`) THEN REMOVE_THEN "t" (MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ t <= u /\ m - e / &2 < t /\ u < m + e / &2 ==> abs(t - u) < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < x - y) /\ ~(&0 < y - x) ==> x = y`) THEN CONJ_TAC THEN DISCH_TAC THENL [REMOVE_THEN "u" (MP_TAC o SPEC `real_measure(s:real->bool) - m`) THEN ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE]; REMOVE_THEN "t" (MP_TAC o SPEC `m - real_measure(s:real->bool)`) THEN ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN ASM_MESON_TAC[REAL_MEASURE_SUBSET]]);; let HAS_REAL_MEASURE_INNER_OUTER_LE = prove (`!s:real->bool m. s has_real_measure m <=> (!e. &0 < e ==> ?t. t SUBSET s /\ real_measurable t /\ m - e <= real_measure t) /\ (!e. &0 < e ==> ?u. s SUBSET u /\ real_measurable u /\ real_measure u <= m + e)`, REWRITE_TAC[HAS_REAL_MEASURE_INNER_OUTER] THEN MESON_TAC[REAL_ARITH `&0 < e /\ m - e / &2 <= t ==> m - e < t`; REAL_ARITH `&0 < e /\ u <= m + e / &2 ==> u < m + e`; REAL_ARITH `&0 < e <=> &0 < e / &2`; REAL_LT_IMP_LE]);; let HAS_REAL_MEASURE_AFFINITY = prove (`!s m c y. s has_real_measure y ==> (IMAGE (\x. m * x + c) s) has_real_measure abs(m) * y`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN DISCH_THEN(MP_TAC o SPECL [`m:real`; `lift c`] o MATCH_MP HAS_MEASURE_AFFINITY) THEN REWRITE_TAC[DIMINDEX_1; REAL_POW_1; GSYM IMAGE_o] THEN MATCH_MP_TAC EQ_IMP THEN REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN SIMP_TAC[FUN_EQ_THM; FORALL_DROP; o_THM; LIFT_DROP; LIFT_ADD; LIFT_CMUL]);; let HAS_REAL_MEASURE_SCALING = prove (`!s m y. s has_real_measure y ==> (IMAGE (\x. m * x) s) has_real_measure abs(m) * y`, ONCE_REWRITE_TAC[REAL_ARITH `m * x = m * x + &0`] THEN REWRITE_TAC[REAL_ARITH `abs m * x + &0 = abs m * x`] THEN REWRITE_TAC[HAS_REAL_MEASURE_AFFINITY]);; let HAS_REAL_MEASURE_TRANSLATION = prove (`!s m a. s has_real_measure m ==> (IMAGE (\x. a + x) s) has_real_measure m`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a + x = &1 * x + a`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `m = abs(&1) * m`] THEN REWRITE_TAC[HAS_REAL_MEASURE_AFFINITY]);; let REAL_NEGLIGIBLE_TRANSLATION = prove (`!s a. real_negligible s ==> real_negligible (IMAGE (\x. a + x) s)`, SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION]);; let HAS_REAL_MEASURE_TRANSLATION_EQ = prove (`!s m. (IMAGE (\x. a + x) s) has_real_measure m <=> s has_real_measure m`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_TRANSLATION] THEN DISCH_THEN(MP_TAC o SPEC `--a:real` o MATCH_MP HAS_REAL_MEASURE_TRANSLATION) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; REAL_ARITH `--a + a + b:real = b`] THEN SET_TAC[]);; let REAL_NEGLIGIBLE_TRANSLATION_REV = prove (`!s a. real_negligible (IMAGE (\x. a + x) s) ==> real_negligible s`, SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION_EQ]);; let REAL_NEGLIGIBLE_TRANSLATION_EQ = prove (`!s a. real_negligible (IMAGE (\x. a + x) s) <=> real_negligible s`, SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION_EQ]);; let REAL_MEASURABLE_TRANSLATION = prove (`!s. real_measurable (IMAGE (\x. a + x) s) <=> real_measurable s`, REWRITE_TAC[real_measurable; HAS_REAL_MEASURE_TRANSLATION_EQ]);; let REAL_MEASURE_TRANSLATION = prove (`!s. real_measurable s ==> real_measure(IMAGE (\x. a + x) s) = real_measure s`, REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_REWRITE_TAC[HAS_REAL_MEASURE_TRANSLATION_EQ]);; let HAS_REAL_MEASURE_SCALING_EQ = prove (`!s m c. ~(c = &0) ==> ((IMAGE (\x. c * x) s) has_real_measure (abs(c) * m) <=> s has_real_measure m)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c:real)` o MATCH_MP HAS_REAL_MEASURE_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN REWRITE_TAC[GSYM REAL_POW_MUL; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; let REAL_MEASURABLE_SCALING = prove (`!s c. real_measurable s ==> real_measurable (IMAGE (\x. c * x) s)`, REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_SCALING]);; let REAL_MEASURABLE_SCALING_EQ = prove (`!s c. ~(c = &0) ==> (real_measurable (IMAGE (\x. c * x) s) <=> real_measurable s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[REAL_MEASURABLE_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP REAL_MEASURABLE_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID] THEN SET_TAC[]);; let REAL_MEASURE_SCALING = prove (`!s. real_measurable s ==> real_measure(IMAGE (\x. c * x) s) = abs(c) * real_measure s`, REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_REAL_MEASURE_SCALING]);; let HAS_REAL_MEASURE_NESTED_UNIONS = prove (`!s B. (!n. real_measurable(s n)) /\ (!n. real_measure(s n) <= B) /\ (!n. s(n) SUBSET s(SUC n)) ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\ ((\n. real_measure(s n)) ---> real_measure(UNIONS { s(n) | n IN (:num) })) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[REAL_MEASURE_MEASURE] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN MP_TAC(ISPECL [`IMAGE lift o (s:num->real->bool)`; `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN ASM_SIMP_TAC[o_THM; IMAGE_SUBSET] THEN REWRITE_TAC[SET_RULE `{IMAGE f (s n) | P n} = IMAGE (IMAGE f) {s n | P n}`; GSYM IMAGE_UNIONS] THEN SIMP_TAC[REAL_MEASURE_MEASURE; REAL_MEASURABLE_MEASURABLE]);; let REAL_MEASURABLE_NESTED_UNIONS = prove (`!s B. (!n. real_measurable(s n)) /\ (!n. real_measure(s n) <= B) /\ (!n. s(n) SUBSET s(SUC n)) ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_MEASURE_NESTED_UNIONS) THEN SIMP_TAC[]);; let HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS = prove (`!s:num->real->bool B. (!n. real_measurable(s n)) /\ (!m n. ~(m = n) ==> real_negligible(s m INTER s n)) /\ (!n. sum (0..n) (\k. real_measure(s k)) <= B) ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\ ((\n. real_measure(s n)) real_sums real_measure(UNIONS { s(n) | n IN (:num) })) (from 0)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real->bool`; `B:real`] HAS_REAL_MEASURE_NESTED_UNIONS) THEN REWRITE_TAC[real_sums; FROM_0; INTER_UNIV] THEN SUBGOAL_THEN `!n. (UNIONS (IMAGE s (0..n)):real->bool) has_real_measure (sum(0..n) (\k. real_measure(s k)))` MP_TAC THENL [GEN_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE THEN ASM_SIMP_TAC[FINITE_NUMSEG]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN ASSUME_TAC(GEN `n:num` (MATCH_MP REAL_MEASURE_UNIQUE (SPEC `n:num` th)))) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[real_measurable]; ALL_TAC] THEN GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN SUBGOAL_THEN `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real->bool = UNIONS (IMAGE s (:num))` (fun th -> REWRITE_TAC[th] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[]) THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]);; let REAL_NEGLIGIBLE_COUNTABLE_UNIONS = prove (`!s:num->real->bool. (!n. real_negligible(s n)) ==> real_negligible(UNIONS {s(n) | n IN (:num)})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:num->real->bool`; `&0`] HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS) THEN ASM_SIMP_TAC[REAL_MEASURE_EQ_0; SUM_0; REAL_LE_REFL; LIFT_NUM] THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_REAL_MEASURE_0; real_measurable; INTER_SUBSET; REAL_NEGLIGIBLE_SUBSET]; ALL_TAC] THEN SIMP_TAC[GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_SERIES_UNIQUE THEN REWRITE_TAC[LIFT_NUM] THEN MAP_EVERY EXISTS_TAC [`(\k. &0):num->real`; `from 0`] THEN ASM_REWRITE_TAC[REAL_SERIES_0]);; let REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG = prove (`!s:num->real->bool B. (!n. real_measurable(s n)) /\ (!n. real_measure(UNIONS {s k | k <= n}) <= B) ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real->bool`; `B:real`] REAL_MEASURABLE_NESTED_UNIONS) THEN SUBGOAL_THEN `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real->bool = UNIONS (IMAGE s (:num))` (fun th -> REWRITE_TAC[th]) THENL [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; FINITE_NUMSEG]; ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_0]; GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_NUMSEG; LE_0] THEN ARITH_TAC]);; let HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS_BOUNDED = prove (`!s. (!n. real_measurable(s n)) /\ (!m n. ~(m = n) ==> real_negligible(s m INTER s n)) /\ real_bounded(UNIONS { s(n) | n IN (:num) }) ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\ ((\n. real_measure(s n)) real_sums real_measure(UNIONS { s(n) | n IN (:num) })) (from 0)`, REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN REWRITE_TAC[REAL_BOUNDED] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[REAL_MEASURE_MEASURE] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; real_negligible] THEN REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN MP_TAC(ISPEC `IMAGE lift o (s:num->real->bool)` HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN ASM_SIMP_TAC[o_THM; IMAGE_SUBSET] THEN REWRITE_TAC[SET_RULE `{IMAGE f (s n) | P n} = IMAGE (IMAGE f) {s n | P n}`; GSYM IMAGE_UNIONS] THEN ASM_SIMP_TAC[GSYM IMAGE_INTER_INJ; LIFT_EQ] THEN SIMP_TAC[REAL_SUMS; o_DEF; REAL_MEASURE_MEASURE; REAL_MEASURABLE_MEASURABLE]);; let REAL_MEASURABLE_COUNTABLE_UNIONS = prove (`!s B. (!n. real_measurable(s n)) /\ (!n. sum (0..n) (\k. real_measure(s k)) <= B) ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..n) (\k. real_measure(s k:real->bool))` THEN ASM_REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (rand o rand) REAL_MEASURE_UNIONS_LE_IMAGE o rand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN REWRITE_TAC[IN_NUMSEG; LE_0]);; let REAL_MEASURABLE_COUNTABLE_UNIONS_BOUNDED = prove (`!s. (!n. real_measurable(s n)) /\ real_bounded(UNIONS { s(n) | n IN (:num) }) ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; REAL_BOUNDED] THEN SIMP_TAC[IMAGE_INTER_INJ; LIFT_EQ; IMAGE_UNIONS] THEN REWRITE_TAC[SET_RULE `IMAGE f {g x | x IN s} = {f(g x) | x IN s}`] THEN REWRITE_TAC[MEASURABLE_COUNTABLE_UNIONS_BOUNDED]);; let REAL_MEASURABLE_COUNTABLE_INTERS = prove (`!s. (!n. real_measurable(s n)) ==> real_measurable(INTERS { s(n) | n IN (:num) })`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `INTERS { s(n):real->bool | n IN (:num) } = s 0 DIFF (UNIONS {s 0 DIFF s n | n IN (:num)})` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG THEN EXISTS_TAC `real_measure(s 0:real->bool)` THEN ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; LE_0] THEN GEN_TAC THEN MATCH_MP_TAC REAL_MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN MESON_TAC[IN_DIFF]] THEN ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; REAL_MEASURABLE_DIFF; REAL_MEASURABLE_UNIONS]);; let REAL_NEGLIGIBLE_COUNTABLE = prove (`!s. COUNTABLE s ==> real_negligible s`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_negligible] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN ASM_SIMP_TAC[COUNTABLE_IMAGE]);; let REAL_MEASURABLE_COMPACT = prove (`!s. real_compact s ==> real_measurable s`, REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; real_compact; MEASURABLE_COMPACT]);; let REAL_MEASURABLE_OPEN = prove (`!s. real_bounded s /\ real_open s ==> real_measurable s`, REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; REAL_OPEN; REAL_BOUNDED; MEASURABLE_OPEN]);; let HAS_REAL_INTEGRAL_NEGLIGIBLE_EQ = prove (`!f s. (!x. x IN s ==> &0 <= f(x)) ==> ((f has_real_integral &0) s <=> real_negligible {x | x IN s /\ ~(f x = &0)})`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_REAL_INTEGRAL_NEGLIGIBLE THEN EXISTS_TAC `{x | x IN s /\ ~((f:real->real) x = &0)}` THEN ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN MESON_TAC[]] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `UNIONS {{x:real | x IN s /\ abs(f x) >= &1 / (&n + &1)} | n IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM HAS_REAL_MEASURE_0] THEN REWRITE_TAC[HAS_REAL_MEASURE] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_STRADDLE_NULL THEN EXISTS_TAC `\x:real. if x IN s then (&n + &1) * f(x) else &0` THEN CONJ_TAC THENL [REWRITE_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN X_GEN_TAC `x:real` THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POS] THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a <= abs x ==> a <= x`) THEN ASM_SIMP_TAC[]; COND_CASES_TAC THEN REWRITE_TAC[REAL_POS] THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_MUL; REAL_LE_ADD]]; REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN SUBST1_TAC(REAL_ARITH `&0 = (&n + &1) * &0`) THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_ARCH_INV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC)) THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LT_IMP_LE]]);; (* ------------------------------------------------------------------------- *) (* Integration by parts. *) (* ------------------------------------------------------------------------- *) let REAL_INTEGRATION_BY_PARTS = prove (`!f g f' g' a b c. a <= b /\ COUNTABLE c /\ (\x. f x * g x) real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) DIFF c ==> (f has_real_derivative f'(x)) (atreal x) /\ (g has_real_derivative g'(x)) (atreal x)) /\ ((\x. f(x) * g'(x)) has_real_integral ((f b * g b - f a * g a) - y)) (real_interval[a,b]) ==> ((\x. f'(x) * g(x)) has_real_integral y) (real_interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. (f:real->real)(x) * g(x)`; `\x. (f:real->real)(x) * g'(x) + f'(x) * g(x)`; `c:real->bool`; `a:real`; `b:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_MUL_ATREAL] THEN FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_SUB)) THEN REWRITE_TAC[REAL_ARITH `b - a - (b - a - y):real = y`; REAL_ADD_SUB]);; let REAL_INTEGRATION_BY_PARTS_SIMPLE = prove (`!f g f' g' a b. a <= b /\ (!x. x IN real_interval[a,b] ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b]) /\ (g has_real_derivative g'(x)) (atreal x within real_interval[a,b])) /\ ((\x. f(x) * g'(x)) has_real_integral ((f b * g b - f a * g a) - y)) (real_interval[a,b]) ==> ((\x. f'(x) * g(x)) has_real_integral y) (real_interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. (f:real->real)(x) * g(x)`; `\x. (f:real->real)(x) * g'(x) + f'(x) * g(x)`; `a:real`; `b:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN] THEN FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_SUB)) THEN REWRITE_TAC[REAL_ARITH `b - a - (b - a - y):real = y`; REAL_ADD_SUB]);; let REAL_INTEGRABLE_BY_PARTS = prove (`!f g f' g' a b c. COUNTABLE c /\ (\x. f x * g x) real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) DIFF c ==> (f has_real_derivative f'(x)) (atreal x) /\ (g has_real_derivative g'(x)) (atreal x)) /\ (\x. f(x) * g'(x)) real_integrable_on real_interval[a,b] ==> (\x. f'(x) * g(x)) real_integrable_on real_interval[a,b]`, REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b <= a \/ a <= b`) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[real_integrable_on] THEN DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `((f:real->real) b * g b - f a * g a) - y` THEN MATCH_MP_TAC REAL_INTEGRATION_BY_PARTS THEN MAP_EVERY EXISTS_TAC [`f:real->real`; `g':real->real`; `c:real->bool`] THEN ASM_REWRITE_TAC[REAL_ARITH `b - a - ((b - a) - y):real = y`]);; let REAL_INTEGRABLE_BY_PARTS_EQ = prove (`!f g f' g' a b c. COUNTABLE c /\ (\x. f x * g x) real_continuous_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) DIFF c ==> (f has_real_derivative f'(x)) (atreal x) /\ (g has_real_derivative g'(x)) (atreal x)) ==> ((\x. f(x) * g'(x)) real_integrable_on real_interval[a,b] <=> (\x. f'(x) * g(x)) real_integrable_on real_interval[a,b])`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[REAL_INTEGRABLE_BY_PARTS]; DISCH_TAC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_INTEGRABLE_BY_PARTS THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_MESON_TAC[]);; let ABSOLUTE_REAL_INTEGRATION_BY_PARTS = prove (`!f g f' g' a b. a <= b /\ f' absolutely_real_integrable_on real_interval[a,b] /\ g' absolutely_real_integrable_on real_interval[a,b] /\ (!x. x IN real_interval[a,b] ==> (f' has_real_integral f(x)) (real_interval[a,x])) /\ (!x. x IN real_interval[a,b] ==> (g' has_real_integral g(x)) (real_interval[a,x])) ==> (\x. f x * g' x) absolutely_real_integrable_on real_interval[a,b] /\ (\x. f' x * g x) absolutely_real_integrable_on real_interval[a,b] /\ real_integral (real_interval[a,b]) (\x. f x * g' x) + real_integral (real_interval[a,b]) (\x. f' x * g x) = f b * g b - f a * g a`, REWRITE_TAC[FORALL_DROP; ABSOLUTELY_REAL_INTEGRABLE_ON; HAS_REAL_INTEGRAL; GSYM IMAGE_DROP_INTERVAL; DROP_IN_IMAGE_DROP] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID] THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `bilinear (\x y. lift(drop x * drop y))` MP_TAC THENL [REWRITE_TAC[bilinear; linear; FORALL_LIFT; LIFT_DROP; DROP_ADD; DROP_CMUL; GSYM LIFT_ADD; LIFT_EQ; GSYM LIFT_CMUL] THEN REAL_ARITH_TAC; REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTE_INTEGRATION_BY_PARTS) THEN REWRITE_TAC[LIFT_DROP] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_SUB] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN BINOP_TAC THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o lhs o snd) THEN ASM_SIMP_TAC[REAL_INTEGRABLE_ON; GSYM IMAGE_o; o_DEF; IMAGE_ID; LIFT_DROP; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]);; (* ------------------------------------------------------------------------- *) (* Change of variable in real integral (one that we know exists). *) (* ------------------------------------------------------------------------- *) let HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG = prove (`!f g g' a b c d k. COUNTABLE k /\ f real_integrable_on real_interval[c,d] /\ g real_continuous_on real_interval[a,b] /\ IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ (!x. x IN real_interval[a,b] DIFF k ==> (g has_real_derivative g'(x)) (atreal x within real_interval[a,b]) /\ f real_continuous (atreal(g x)) within real_interval[c,d]) /\ a <= b /\ c <= d /\ g a <= g b ==> ((\x. f(g x) * g'(x)) has_real_integral real_integral (real_interval[g a,g b]) f) (real_interval[a,b])`, REPEAT STRIP_TAC THEN ABBREV_TAC `ff = \x. real_integral (real_interval[c,x]) f` THEN MP_TAC(ISPECL [`(ff:real->real) o (g:real->real)`; `\x:real. (f:real->real)(g x) * g'(x)`; `k:real->bool`; `a:real`; `b:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `real_interval [c,d]` THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "ff" THEN MATCH_MP_TAC REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN ASM_REWRITE_TAC[]; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] REAL_INTERVAL_OPEN_SUBSET_CLOSED)) THEN SUBGOAL_THEN `(ff o g has_real_derivative f (g x:real) * g' x) (atreal x within real_interval[a,b])` MP_TAC THENL [MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN; IN_DIFF] THEN MP_TAC(ISPECL [`f:real->real`; `c:real`; `d:real`; `(g:real->real) x`] REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; IN_DIFF] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_SUBSET]; DISCH_THEN(MP_TAC o SPEC `real_interval(a,b)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_DERIVATIVE_WITHIN_SUBSET)) THEN REWRITE_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL] THEN ASM_SIMP_TAC[REALLIM_WITHIN_REAL_OPEN; REAL_OPEN_REAL_INTERVAL] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL]]]; EXPAND_TAC "ff" THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REAL_ARITH `z + w:real = y ==> y - z = w`) THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_SUBINTERVAL))] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_REAL_INTERVAL; SUBSET] THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]]);; let HAS_REAL_INTEGRAL_SUBSTITUTION = prove (`!f g g' a b c d k. COUNTABLE k /\ f real_continuous_on real_interval[c,d] /\ g real_continuous_on real_interval[a,b] /\ IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ (!x. x IN real_interval[a,b] DIFF k ==> (g has_real_derivative g'(x)) (atreal x)) /\ a <= b /\ c <= d /\ g a <= g b ==> ((\x. f(g x) * g'(x)) has_real_integral real_integral (real_interval[g a,g b]) f) (real_interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `c:real`; `d:real`] REAL_INTEGRAL_HAS_REAL_DERIVATIVE) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `h = \u. real_integral (real_interval[c,u]) f` THEN DISCH_TAC THEN MP_TAC(ISPECL [`(h:real->real) o (g:real->real)`; `\x:real. (f:real->real)(g x) * g' x`; `k:real->bool`; `a:real`; `b:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN MP_TAC(ISPECL [`h:real->real`; `f:real->real`; `(g:real->real) a`; `(g:real->real) b`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `x:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_REAL_DERIVATIVE_WITHIN_SUBSET)] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN DISJ2_TAC THEN MATCH_MP_TAC(REAL_ARITH `(c <= ga /\ ga <= d) /\ (c <= gb /\ gb <= d) /\ ga <= gb ==> c <= ga /\ ga <= gb /\ gb <= d`) THEN ASM_REWRITE_TAC[GSYM IN_REAL_INTERVAL] THEN CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL; REAL_LE_REFL]; DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "h" THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_CONTINUOUS_ON_SUBSET)) THEN MATCH_MP_TAC REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN ASM_SIMP_TAC[REAL_INTEGRABLE_CONTINUOUS]; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] REAL_INTERVAL_OPEN_SUBSET_CLOSED)) THEN SUBGOAL_THEN `(h o (g:real->real) has_real_derivative f(g x) * g' x) (atreal x within real_interval[a,b])` MP_TAC THENL [MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[IN_DIFF; HAS_REAL_DERIVATIVE_ATREAL_WITHIN] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real->real) x`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_REAL_DERIVATIVE_WITHIN_SUBSET) THEN ASM_REWRITE_TAC[]; REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_REAL_DERIVATIVE_ATREAL; REALLIM_WITHINREAL_WITHIN; REALLIM_ATREAL_AT] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; TENDSTO_REAL] THEN MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_WITHIN_INTERIOR THEN REWRITE_TAC[INTERIOR_INTERVAL; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN ASM_SIMP_TAC[FUN_IN_IMAGE]]]]);; let REAL_INTEGRAL_SUBSTITUTION = prove (`!f g g' a b c d k. COUNTABLE k /\ f real_continuous_on real_interval[c,d] /\ g real_continuous_on real_interval[a,b] /\ IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ (!x. x IN real_interval[a,b] DIFF k ==> (g has_real_derivative g'(x)) (atreal x)) /\ a <= b /\ c <= d /\ g a <= g b ==> real_integral (real_interval[a,b]) (\x. f(g x) * g'(x)) = real_integral (real_interval[g a,g b]) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_SUBSTITUTION]);; let HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE = prove (`!f g g' a b c d. f real_continuous_on real_interval[c,d] /\ (!x. x IN real_interval[a,b] ==> (g has_real_derivative g'(x)) (atreal x within real_interval[a,b])) /\ IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ a <= b /\ c <= d /\ g a <= g b ==> ((\x. f(g x) * g'(x)) has_real_integral real_integral (real_interval[g a,g b]) f) (real_interval[a,b])`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRAL_HAS_REAL_DERIVATIVE) THEN ABBREV_TAC `h = \u. real_integral (real_interval[c,u]) f` THEN DISCH_TAC THEN MP_TAC(ISPECL [`(h:real->real) o (g:real->real)`; `\x:real. (f:real->real)(g x) * g' x`; `a:real`; `b:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN MP_TAC(ISPECL [`h:real->real`; `f:real->real`; `(g:real->real) a`; `(g:real->real) b`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [X_GEN_TAC `x:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_REAL_DERIVATIVE_WITHIN_SUBSET)] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN DISJ2_TAC THEN MATCH_MP_TAC(REAL_ARITH `(c <= ga /\ ga <= d) /\ (c <= gb /\ gb <= d) /\ ga <= gb ==> c <= ga /\ ga <= gb /\ gb <= d`) THEN ASM_REWRITE_TAC[GSYM IN_REAL_INTERVAL] THEN CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL; REAL_LE_REFL]; DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real->real) x`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_REAL_DERIVATIVE_WITHIN_SUBSET) THEN ASM_REWRITE_TAC[]]);; let REAL_INTEGRAL_SUBSTITUTION_SIMPLE = prove (`!f g g' a b c d. f real_continuous_on real_interval[c,d] /\ (!x. x IN real_interval[a,b] ==> (g has_real_derivative g'(x)) (atreal x within real_interval[a,b])) /\ IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ a <= b /\ c <= d /\ g a <= g b ==> real_integral (real_interval[a,b]) (\x. f(g x) * g'(x)) = real_integral (real_interval[g a,g b]) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE]);; (* ------------------------------------------------------------------------- *) (* Take slice of set s at x$k = t and drop the k'th coordinate. *) (* ------------------------------------------------------------------------- *) let slice = new_definition `slice k t s = IMAGE (dropout k) (s INTER {x | x$k = t})`;; let IN_SLICE = prove (`!s:real^N->bool y:real^M. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (y IN slice k t s <=> pushin k t y IN s)`, SIMP_TAC[slice; IN_IMAGE_DROPOUT; IN_INTER; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[pushin] THEN ASM_SIMP_TAC[LAMBDA_BETA; LT_REFL] THEN MESON_TAC[]);; let INTERVAL_INTER_HYPERPLANE = prove (`!k t a b:real^N. 1 <= k /\ k <= dimindex(:N) ==> interval[a,b] INTER {x | x$k = t} = if a$k <= t /\ t <= b$k then interval[(lambda i. if i = k then t else a$i), (lambda i. if i = k then t else b$i)] else {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_MESON_TAC[NOT_IN_EMPTY]] THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN EQ_TAC THEN STRIP_TAC THENL [ASM_MESON_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_ANTISYM]] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let SLICE_INTERVAL = prove (`!k a b t. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> slice k t (interval[a,b]) = if a$k <= t /\ t <= b$k then interval[(dropout k:real^N->real^M) a,dropout k b] else {}`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[slice; INTERVAL_INTER_HYPERPLANE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN ASM_SIMP_TAC[IMAGE_DROPOUT_CLOSED_INTERVAL; LAMBDA_BETA; REAL_LE_REFL] THEN MATCH_MP_TAC(MESON[] `a = a' /\ b = b' ==> interval[a,b] = interval[a',b']`) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; dropout] THEN SUBGOAL_THEN `!i. i <= dimindex(:M) ==> i <= dimindex(:N) /\ i + 1 <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `1 <= i + 1`] THEN ARITH_TAC]);; let SLICE_DIFF = prove (`!k a s t. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (slice k a:(real^N->bool)->(real^M->bool)) (s DIFF t) = (slice k a s) DIFF (slice k a t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN SIMP_TAC[SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF (t INTER u)`] THEN MATCH_MP_TAC(SET_RULE `(!x y. x IN a /\ y IN a /\ f x = f y ==> x = y) ==> IMAGE f ((s INTER a) DIFF (t INTER a)) = IMAGE f (s INTER a) DIFF IMAGE f (t INTER a)`) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[DROPOUT_EQ]);; let SLICE_UNIV = prove (`!k a. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> slice k a (:real^N) = (:real^M)`, REPEAT STRIP_TAC THEN SIMP_TAC[EXTENSION; IN_UNIV; IN_IMAGE; slice; INTER_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `y:real^M` THEN EXISTS_TAC `(pushin k a:real^M->real^N) y` THEN ASM_SIMP_TAC[DROPOUT_PUSHIN] THEN ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL]);; let SLICE_EMPTY = prove (`!k a. slice k a {} = {}`, REWRITE_TAC[slice; INTER_EMPTY; IMAGE_CLAUSES]);; let SLICE_SUBSET = prove (`!s t k a. s SUBSET t ==> slice k a s SUBSET slice k a t`, REWRITE_TAC[slice] THEN SET_TAC[]);; let SLICE_UNIONS = prove (`!s k a. slice k a (UNIONS s) = UNIONS (IMAGE (slice k a) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[slice; INTER_UNIONS; IMAGE_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; slice]);; let SLICE_UNION = prove (`!k a s t. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (slice k a:(real^N->bool)->(real^M->bool)) (s UNION t) = (slice k a s) UNION (slice k a t)`, REPEAT GEN_TAC THEN REWRITE_TAC[slice; IMAGE_UNION; SET_RULE `(s UNION t) INTER u = (s INTER u) UNION (t INTER u)`] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; slice]);; let SLICE_INTER = prove (`!k a s t. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (slice k a:(real^N->bool)->(real^M->bool)) (s INTER t) = (slice k a s) INTER (slice k a t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN MATCH_MP_TAC(SET_RULE `(!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) ==> IMAGE f ((s INTER t) INTER u) = IMAGE f (s INTER u) INTER IMAGE f (t INTER u)`) THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[DROPOUT_EQ]);; let CONVEX_SLICE = prove (`!k t s. dimindex(:M) < dimindex(:N) /\ convex s ==> convex((slice k t:(real^N->bool)->(real^M->bool)) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_DROPOUT] THEN MATCH_MP_TAC CONVEX_INTER THEN ASM_REWRITE_TAC[CONVEX_STANDARD_HYPERPLANE]);; let COMPACT_SLICE = prove (`!k t s. dimindex(:M) < dimindex(:N) /\ compact s ==> compact((slice k t:(real^N->bool)->(real^M->bool)) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_DROPOUT] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]; MATCH_MP_TAC CLOSED_INTER THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_STANDARD_HYPERPLANE]]);; let CLOSED_SLICE = prove (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ closed s ==> closed((slice k t:(real^N->bool)->(real^M->bool)) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN SUBGOAL_THEN `closed(IMAGE (dropout k:real^N->real^M) (IMAGE (\x. x - t % basis k) (s INTER {x | x$k = t})))` MP_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; dropout] THEN SUBGOAL_THEN `!i. i <= dimindex(:M) ==> i <= dimindex(:N) /\ i + 1 <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; CART_EQ; LAMBDA_BETA; BASIS_COMPONENT; ARITH_RULE `1 <= i + 1`] THEN SIMP_TAC[ARITH_RULE `i:num < k ==> ~(i = k)`; ARITH_RULE `~(i < k) ==> ~(i + 1 = k)`] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO]] THEN MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE THEN EXISTS_TAC `{x:real^N | x$k = &0}` THEN ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE; LINEAR_DROPOUT; ARITH_RULE `m + 1 = n ==> m < n`] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[VECTOR_ARITH `x - t % b:real^N = --(t % b) + x`] THEN ASM_SIMP_TAC[CLOSED_TRANSLATION_EQ; CLOSED_INTER; CLOSED_STANDARD_HYPERPLANE]; MATCH_MP_TAC(SET_RULE `IMAGE f t SUBSET u ==> IMAGE f (s INTER t) SUBSET u`) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; REAL_MUL_RID; REAL_SUB_REFL]; REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DROPOUT_EQ THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[DROPOUT_0; VEC_COMPONENT]]);; let OPEN_SLICE = prove (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ open s ==> open((slice k t:(real^N->bool)->(real^M->bool)) s)`, REWRITE_TAC[OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `closed(slice k t ((:real^N) DIFF s):real^M->bool)` MP_TAC THENL [ASM_SIMP_TAC[CLOSED_SLICE]; ASM_SIMP_TAC[SLICE_DIFF; SLICE_UNIV]]);; let BOUNDED_SLICE = prove (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s ==> bounded((slice k t:(real^N->bool)->(real^M->bool)) s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `(slice k t:(real^N->bool)->(real^M->bool)) (interval[a,b])` THEN ASM_SIMP_TAC[SLICE_SUBSET] THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN MESON_TAC[BOUNDED_EMPTY; BOUNDED_INTERVAL]);; let SLICE_CBALL = prove (`!k t x r. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (slice k t:(real^N->bool)->(real^M->bool)) (cball(x,r)) = if abs(t - x$k) <= r then cball(dropout k x,sqrt(r pow 2 - (t - x$k) pow 2)) else {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN COND_CASES_TAC THENL [ALL_TAC; REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; IN_CBALL] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[dist] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `~(a <= r) ==> a <= b ==> b <= r ==> F`)) THEN ASM_MESON_TAC[VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM; NORM_SUB]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `abs(x) <= r ==> &0 <= r`)) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL] THEN X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[DROPOUT_GALOIS; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[IN_CBALL; IN_INTER; IN_ELIM_THM] THEN ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN ASM_REWRITE_TAC[dist; NORM_LE_SQUARE; GSYM pushin] THEN ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; REAL_ARITH `abs(x) <= r ==> abs(x) <= abs(r)`] THEN REWRITE_TAC[VECTOR_ARITH `(x - y:real^N) dot (x - y) = x dot x + y dot y - &2 * x dot y`] THEN ASM_SIMP_TAC[DOT_DROPOUT; DOT_PUSHIN] THEN MATCH_MP_TAC(REAL_FIELD `a = t * k + b ==> (xx + (yy + t * t) - &2 * a <= r pow 2 <=> xx - k * k + yy - &2 * b <= r pow 2 - (t - k) pow 2)`) THEN SUBGOAL_THEN `y:real^M = dropout k (pushin k t y:real^N)` (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC DROPOUT_PUSHIN THEN ASM_ARITH_TAC; ASM_SIMP_TAC[DOT_DROPOUT] THEN ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN REAL_ARITH_TAC]);; let SLICE_BALL = prove (`!k t x r. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (slice k t:(real^N->bool)->(real^M->bool)) (ball(x,r)) = if abs(t - x$k) < r then ball(dropout k x,sqrt(r pow 2 - (t - x$k) pow 2)) else {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN COND_CASES_TAC THENL [ALL_TAC; REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; IN_BALL] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[dist] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `~(a < r) ==> a <= b ==> b < r ==> F`)) THEN ASM_MESON_TAC[VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM; NORM_SUB]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `abs(x) < r ==> &0 < r`)) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL] THEN X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[DROPOUT_GALOIS; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM] THEN ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN ASM_REWRITE_TAC[dist; NORM_LT_SQUARE; GSYM pushin] THEN ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LT; REAL_SUB_LT; GSYM REAL_LT_SQUARE_ABS; REAL_LT_IMP_LE; REAL_ARITH `abs(x) < r ==> abs(x) < abs(r)`] THEN REWRITE_TAC[VECTOR_ARITH `(x - y:real^N) dot (x - y) = x dot x + y dot y - &2 * x dot y`] THEN ASM_SIMP_TAC[DOT_DROPOUT; DOT_PUSHIN] THEN MATCH_MP_TAC(REAL_FIELD `a = t * k + b ==> (xx + (yy + t * t) - &2 * a < r pow 2 <=> xx - k * k + yy - &2 * b < r pow 2 - (t - k) pow 2)`) THEN SUBGOAL_THEN `y:real^M = dropout k (pushin k t y:real^N)` (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC DROPOUT_PUSHIN THEN ASM_ARITH_TAC; ASM_SIMP_TAC[DOT_DROPOUT] THEN ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Weak but useful versions of Fubini's theorem. *) (* ------------------------------------------------------------------------- *) let FUBINI_CLOSED_INTERVAL = prove (`!k a b:real^N. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ a$k <= b$k ==> ((\t. measure (slice k t (interval[a,b]) :real^M->bool)) has_real_integral (measure(interval[a,b]))) (:real)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY; MEASURE_INTERVAL] THEN REWRITE_TAC[GSYM IN_REAL_INTERVAL] THEN SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT; SUBSET_UNIV] THEN SUBGOAL_THEN `content(interval[a:real^N,b]) = content(interval[dropout k a:real^M,dropout k b]) * (b$k - a$k)` SUBST1_TAC THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST] THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV) [COND_RAND] THEN GEN_REWRITE_TAC RAND_CONV [COND_RATOR] THEN REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC(TAUT `(p <=> p') /\ x = x' ==> (if p then x else y) = (if p' then x' else y)`) THEN CONJ_TAC THENL [SIMP_TAC[dropout; LAMBDA_BETA] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN (ASM_CASES_TAC `i <= dimindex(:N)` THENL [ASM_REWRITE_TAC[]; ASM_ARITH_TAC]) THENL [REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `i:num < k` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUB_ADD]]] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `1..dimindex(:N) = (1..(k-1)) UNION (k INSERT (IMAGE (\x. x + 1) (k..dimindex(:M))))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_UNION; IN_INSERT; IN_IMAGE] THEN ASM_SIMP_TAC[ARITH_RULE `1 <= k ==> (x = y + 1 /\ k <= y /\ y <= n <=> y = x - 1 /\ k + 1 <= x /\ x <= n + 1)`] THEN REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s UNION (x INSERT t) = x INSERT (s UNION t)`] THEN SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_UNION; FINITE_IMAGE] THEN ASM_SIMP_TAC[IN_NUMSEG; IN_UNION; IN_IMAGE; ARITH_RULE `1 <= k ==> ~(k <= k - 1)`] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN MP_TAC(ISPECL [`1`; `k - 1`; `dimindex(:M)`] NUMSEG_COMBINE_R) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN W(MP_TAC o PART_MATCH (lhs o rand) PRODUCT_UNION o lhand o snd) THEN SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; IN_NUMSEG; SET_RULE `DISJOINT s (IMAGE f t) <=> !x. x IN t ==> ~(f x IN s)`] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) PRODUCT_UNION o rand o snd) THEN SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; IN_NUMSEG; SET_RULE `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN ASM_SIMP_TAC[PRODUCT_IMAGE; EQ_ADD_RCANCEL; SUB_ADD] THEN BINOP_TAC THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN SIMP_TAC[dropout; LAMBDA_BETA; o_THM] THEN REPEAT STRIP_TAC THEN BINOP_TAC THEN (W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o rand o snd) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC));; let MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL = prove (`!s a b e. 2 <= dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ measurable s /\ s SUBSET interval[a,b] /\ &0 < e ==> ?f:num->real^N->bool. (!i. (f i) SUBSET interval[a,b] /\ ?c d. c$k <= d$k /\ f i = interval[c,d]) /\ (!i j. ~(i = j) ==> negligible(f i INTER f j)) /\ s SUBSET UNIONS {f n | n IN (:num)} /\ measurable(UNIONS {f n | n IN (:num)}) /\ measure(UNIONS {f n | n IN (:num)}) <= measure s + e`, let lemma = prove (`UNIONS {if n IN s then f n else {} | n IN (:num)} = UNIONS (IMAGE f s)`, SIMP_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM; IN_UNIV; EXISTS_IN_IMAGE] THEN MESON_TAC[NOT_IN_EMPTY]) in REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` (fun th -> SUBST_ALL_TAC(CONJUNCT2 th) THEN ASSUME_TAC(CONJUNCT1 th))) THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM; IN_UNIV]) THEN EXISTS_TAC `\k. if k IN 1..CARD(d:(real^N->bool)->bool) then f k else ({}:real^N->bool)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[REAL_NOT_LT; IN_NUMSEG; REAL_NOT_LE; INTERVAL_EQ_EMPTY]; REWRITE_TAC[EMPTY_SUBSET] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN EXISTS_TAC `(lambda i. if i = k then &0 else &1):real^N` THEN EXISTS_TAC `(lambda i. if i = k then &1 else &0):real^N` THEN REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN CONJ_TAC THENL [SIMP_TAC[LAMBDA_BETA; ASSUME `1 <= k`; ASSUME `k <= dimindex(:N)`; REAL_POS]; ALL_TAC] THEN SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ ~(j = k)` MP_TAC THENL [MATCH_MP_TAC(MESON[] `P(k - 1) \/ P(k + 1) ==> ?i. P i`) THEN ASM_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[lemma]] THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]); MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM; IN_UNIV]) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM SIMPLE_IMAGE]) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT; IN_NUMSEG; REAL_NOT_LE; INTERVAL_EQ_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]] THEN (DISCH_TAC THEN SUBGOAL_THEN `negligible(interior((f:num->real^N->bool) i) INTER interior(f j))` MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_EMPTY]; ALL_TAC] THEN REWRITE_TAC[GSYM INTERIOR_INTER] THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_MEASURE_NEGLIGIBLE_SYMDIFF) THEN SIMP_TAC[INTERIOR_SUBSET; SET_RULE `interior(s) SUBSET s ==> (interior s DIFF s) UNION (s DIFF interior s) = s DIFF interior s`] THEN SUBGOAL_THEN `(?c d. (f:num->real^N->bool) i = interval[c,d]) /\ (?c d. (f:num->real^N->bool) j = interval[c,d])` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[INTER_INTERVAL; NEGLIGIBLE_FRONTIER_INTERVAL; INTERIOR_CLOSED_INTERVAL]));; let REAL_MONOTONE_CONVERGENCE_INCREASING_AE = prove (`!f:num->real->real g s. (!k. (f k) real_integrable_on s) /\ (!k x. x IN s ==> f k x <= f (SUC k) x) /\ (?t. real_negligible t /\ !x. x IN (s DIFF t) ==> ((\k. f k x) ---> g x) sequentially) /\ real_bounded {real_integral s (f k) | k IN (:num)} ==> g real_integrable_on s /\ ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `g real_integrable_on (s DIFF t) /\ ((\k. real_integral (s DIFF t) (f k)) ---> real_integral (s DIFF t) g) sequentially` MP_TAC THENL [MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `!k:num. f k real_integrable_on s` THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_SET; ASM_SIMP_TAC[IN_DIFF]; ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET]; MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_SET_EQ THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; AP_THM_TAC THEN BINOP_TAC THENL [ABS_TAC; ALL_TAC] THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET]] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; let FUBINI_SIMPLE_LEMMA = prove (`!k s:real^N->bool e. &0 < e /\ dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s /\ measurable s /\ (!t. measurable(slice k t s:real^M->bool)) /\ (\t. measure (slice k t s:real^M->bool)) real_integrable_on (:real) ==> real_integral(:real) (\t. measure (slice k t s :real^M->bool)) <= measure s + e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`; `e:real`] MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [SUBGOAL_THEN `1 <= dimindex(:M)` MP_TAC THENL [REWRITE_TAC[DIMINDEX_GE_1]; ASM_ARITH_TAC]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->(real^N->bool)` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!t n:num. measurable((slice k t:(real^N->bool)->real^M->bool) (d n))` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`t:real`; `n:num`] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o CONJUNCT2 o SPEC `n:num`) THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `measure(UNIONS {d n | n IN (:num)}:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`\n t. sum(0..n) (\m. measure((slice k t:(real^N->bool)->real^M->bool) (d m)))`; `\t. measure((slice k t:(real^N->bool)->real^M->bool) (UNIONS {d n | n IN (:num)}))`; `(:real)`] REAL_MONOTONE_CONVERGENCE_INCREASING_AE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [X_GEN_TAC `i:num` THEN MATCH_MP_TAC REAL_INTEGRABLE_SUM THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `j:num`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`k:num`; `u:real^N`; `v:real^N`] FUBINI_CLOSED_INTERVAL) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[real_integrable_on]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC MEASURE_POS_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN EXISTS_TAC `measure(interval[a:real^N,b])` THEN X_GEN_TAC `i:num` THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_INTEGRAL_SUM o rand o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v. u$k <= v$k /\ (d:num->real^N->bool) j = interval[u,v]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_integrable_on] THEN EXISTS_TAC `measure(interval[u:real^N,v])` THEN MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(sum(0..i) (\m. measure(d m:real^N->bool)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN SUBGOAL_THEN `?u v. u$k <= v$k /\ (d:num->real^N->bool) j = interval[u,v]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> abs x <= a`) THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN ASM_MESON_TAC[MEASURE_POS_LE; MEASURABLE_INTERVAL]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o lhand o snd) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_NUMSEG] THEN ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[MEASURABLE_INTERVAL]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]]] THEN EXISTS_TAC `(IMAGE (\i. (interval_lowerbound(d i):real^N)$k) (:num)) UNION (IMAGE (\i. (interval_upperbound(d i):real^N)$k) (:num))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN SIMP_TAC[COUNTABLE_UNION; COUNTABLE_IMAGE; NUM_COUNTABLE]; ALL_TAC] THEN X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_DIFF; IN_UNION; IN_IMAGE] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM] THEN DISCH_TAC THEN MP_TAC(ISPEC `\n:num. (slice k t:(real^N->bool)->real^M->bool) (d n)` HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN ASM_REWRITE_TAC[SLICE_UNIONS] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o CONJUNCT2) THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[GSYM REAL_SUMS; real_sums; FROM_INTER_NUMSEG] THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF]] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `(slice k t:(real^N->bool)->real^M->bool) (interval[a,b])` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SLICE_INTERVAL] THEN MESON_TAC[BOUNDED_INTERVAL; BOUNDED_EMPTY]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[SLICE_SUBSET]]] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(d:num->real^N->bool) i = {}` THENL [ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY; SLICE_EMPTY]; UNDISCH_TAC `~((d:num->real^N->bool) i = {})`] THEN ASM_CASES_TAC `(d:num->real^N->bool) j = {}` THENL [ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY; SLICE_EMPTY]; UNDISCH_TAC `~((d:num->real^N->bool) j = {})`] THEN FIRST_ASSUM(fun th -> MAP_EVERY (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) [SPEC `i:num` th; SPEC `j:num` th]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`w:real^N`; `x:real^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN ASM_SIMP_TAC[SLICE_INTERVAL; INTERVAL_NE_EMPTY] THEN DISCH_TAC THEN DISCH_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]) THEN REWRITE_TAC[INTER_INTERVAL; NEGLIGIBLE_INTERVAL; INTERVAL_EQ_EMPTY] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(l:num = k)` ASSUME_TAC THENL [FIRST_X_ASSUM(CONJUNCTS_THEN (fun th -> MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th))) THEN ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(l:num = k) ==> l < k \/ k < l`)) THENL [EXISTS_TAC `l:num` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[dropout; LAMBDA_BETA]] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EXISTS_TAC `l - 1` THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[dropout; LAMBDA_BETA]] THEN ASM_SIMP_TAC[ARITH_RULE `k < l ==> ~(l - 1 < k)`] THEN ASM_SIMP_TAC[SUB_ADD]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `real_integral (:real) (\t. measure ((slice k t :(real^N->bool)->real^M->bool) (UNIONS {d n | n IN (:num)})))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[SLICE_SUBSET; SLICE_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC MEASURABLE_COUNTABLE_UNIONS_BOUNDED THEN ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `(slice k t:(real^N->bool)->real^M->bool) (interval[a,b])` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SLICE_INTERVAL] THEN MESON_TAC[BOUNDED_INTERVAL; BOUNDED_EMPTY]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[SLICE_SUBSET]]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN EXISTS_TAC `\n. real_integral (:real) (\t. sum (0..n) (\m. measure((slice k t:(real^N->bool)->real^M->bool) (d m))))` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MP_TAC(ISPEC `d:num->(real^N->bool)` HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[a:real^N,b]` THEN REWRITE_TAC[BOUNDED_INTERVAL; UNIONS_SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[GSYM REAL_SUMS] THEN REWRITE_TAC[real_sums; FROM_INTER_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_INTEGRAL_SUM o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v. u$k <= v$k /\ (d:num->real^N->bool) j = interval[u,v]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_integrable_on] THEN EXISTS_TAC `measure(interval[u:real^N,v])` THEN MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN SUBGOAL_THEN `?u v. u$k <= v$k /\ (d:num->real^N->bool) j = interval[u,v]` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]]);; let FUBINI_SIMPLE = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s /\ measurable s /\ (!t. measurable(slice k t s :real^M->bool)) /\ (\t. measure (slice k t s :real^M->bool)) real_integrable_on (:real) ==> measure s = real_integral(:real)(\t. measure (slice k t s :real^M->bool))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[SLICE_EMPTY; MEASURE_EMPTY; REAL_INTEGRAL_0]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN SUBGOAL_THEN `~(interval[a:real^N,b] = {})` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INTERVAL_NE_EMPTY] THEN DISCH_TAC] THEN MATCH_MP_TAC(REAL_ARITH `~(&0 < b - a) /\ ~(&0 < a - b) ==> a:real = b`) THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[] `(!e. x - y = e ==> ~(&0 < e)) ==> ~(&0 < x - y)`) THEN X_GEN_TAC `e:real` THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`k:num`; `s:real^N->bool`; `e / &2`] FUBINI_SIMPLE_LEMMA) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`k:num`; `interval[a:real^N,b] DIFF s`; `e / &2`] FUBINI_SIMPLE_LEMMA) THEN ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [SIMP_TAC[BOUNDED_DIFF; BOUNDED_INTERVAL]; ALL_TAC] THEN CONJ_TAC THENL [ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL]; ALL_TAC] THEN ASM_SIMP_TAC[SLICE_DIFF] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [X_GEN_TAC `t:real` THEN MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL]; DISCH_TAC] THEN SUBGOAL_THEN `!t. measure(slice k t (interval[a:real^N,b]) DIFF slice k t (s:real^N->bool) :real^M->bool) = measure(slice k t (interval[a:real^N,b]):real^M->bool) - measure(slice k t s :real^M->bool)` (fun th -> REWRITE_TAC[th]) THENL [X_GEN_TAC `t:real` THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM_SIMP_TAC[SLICE_SUBSET] THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL]; ALL_TAC] THEN MP_TAC(ISPECL [`k:num`; `a:real^N`; `b:real^N`] FUBINI_CLOSED_INTERVAL) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN ASM_MESON_TAC[real_integrable_on]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LE] THEN ASM_SIMP_TAC[MEASURE_DIFF_SUBSET; MEASURABLE_INTERVAL] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL_SUB o rand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[real_integrable_on]; DISCH_THEN SUBST1_TAC] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN ASM_REAL_ARITH_TAC);; let FUBINI_SIMPLE_ALT = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s /\ measurable s /\ (!t. measurable(slice k t s :real^M->bool)) /\ ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) ==> measure s = B`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `real_integral (:real) (\t. measure (slice k t (s:real^N->bool) :real^M->bool))` THEN CONJ_TAC THENL [MATCH_MP_TAC FUBINI_SIMPLE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[real_integrable_on]; MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]]);; let FUBINI_SIMPLE_COMPACT_STRONG = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ compact s /\ ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) ==> measurable s /\ measure s = B`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; MEASURABLE_COMPACT] THEN GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SLICE THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let FUBINI_SIMPLE_COMPACT = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ compact s /\ ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) ==> measure s = B`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_COMPACT_STRONG) THEN SIMP_TAC[]);; let FUBINI_SIMPLE_CONVEX_STRONG = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s /\ convex s /\ ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) ==> measurable s /\ measure s = B`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_CONVEX] THEN MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MEASURABLE_CONVEX] THEN GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL [MATCH_MP_TAC CONVEX_SLICE; MATCH_MP_TAC BOUNDED_SLICE] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let FUBINI_SIMPLE_CONVEX = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s /\ convex s /\ ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) ==> measure s = B`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_CONVEX_STRONG) THEN SIMP_TAC[]);; let FUBINI_SIMPLE_OPEN_STRONG = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s /\ open s /\ ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) ==> measurable s /\ measure s = B`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_OPEN] THEN MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MEASURABLE_OPEN] THEN GEN_TAC THEN MATCH_MP_TAC MEASURABLE_OPEN THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SLICE; MATCH_MP_TAC OPEN_SLICE] THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let FUBINI_SIMPLE_OPEN = prove (`!k s:real^N->bool. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ bounded s /\ open s /\ ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) ==> measure s = B`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_OPEN_STRONG) THEN SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Scaled integer, and hence rational, values are dense in the reals. *) (* ------------------------------------------------------------------------- *) let REAL_OPEN_SET_RATIONAL = prove (`!s. real_open s /\ ~(s = {}) ==> ?x. rational x /\ x IN s`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN MP_TAC(ISPEC `IMAGE lift s` OPEN_SET_RATIONAL_COORDINATES) THEN ASM_REWRITE_TAC[GSYM REAL_OPEN; IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE] THEN SIMP_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);; let REAL_OPEN_RATIONAL = prove (`!P. real_open {x | P x} /\ (?x. P x) ==> ?x. rational x /\ P x`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `{x:real | P x}` REAL_OPEN_SET_RATIONAL) THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let REAL_OPEN_SET_EXISTS_RATIONAL = prove (`!s. real_open s ==> ((?x. rational x /\ x IN s) <=> (?x. x IN s))`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_MESON_TAC[REAL_OPEN_SET_RATIONAL; GSYM MEMBER_NOT_EMPTY]);; let REAL_OPEN_EXISTS_RATIONAL = prove (`!P. real_open {x | P x} ==> ((?x. rational x /\ P x) <=> (?x. P x))`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_OPEN_SET_EXISTS_RATIONAL) THEN REWRITE_TAC[IN_ELIM_THM]);; (* ------------------------------------------------------------------------- *) (* Hence a criterion for two functions to agree. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_CONST_DYADIC_RATIONALS = prove (`!f:real^M->real^N a. f continuous_on (:real^M) /\ (!x. (!i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i)) ==> f(x) = a) /\ (!x. f(x) = a ==> f(inv(&2) % x) = a) ==> !x. f(x) = a`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `{ inv(&2 pow n) % x:real^M |n,x| !i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i) }`; `a:real^N`] CONTINUOUS_CONSTANT_ON_CLOSURE) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; CLOSURE_DYADIC_RATIONALS; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_INV_1; VECTOR_MUL_LID] THEN ASM_SIMP_TAC[REAL_INV_MUL; GSYM VECTOR_MUL_ASSOC]);; let REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS = prove (`!f a. f real_continuous_on (:real) /\ (!x. integer(x) ==> f(x) = a) /\ (!x. f(x) = a ==> f(x / &2) = a) ==> !x. f(x) = a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`] CONTINUOUS_ON_CONST_DYADIC_RATIONALS) THEN ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IMAGE_LIFT_UNIV] THEN ASM_SIMP_TAC[o_THM; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_EQ; DROP_CMUL; REAL_ARITH `inv(&2) * x = x / &2`] THEN ASM_MESON_TAC[LIFT_DROP]);; let REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR = prove (`!f. f real_continuous_on (:real) /\ (!x y. f(x + y) = f(x) + f(y)) ==> !a x. f(a * x) = a * f(x)`, GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `lift o f o drop` CONTINUOUS_ADDITIVE_IMP_LINEAR) THEN ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IMAGE_LIFT_UNIV] THEN ASM_REWRITE_TAC[linear; GSYM FORALL_DROP; o_THM; DROP_ADD; LIFT_DROP; DROP_CMUL; GSYM LIFT_ADD; GSYM LIFT_CMUL; LIFT_EQ]);; (* ------------------------------------------------------------------------- *) (* Extending a continuous function in a periodic way. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_FLOOR = prove (`!x. ~(integer x) ==> floor real_continuous (atreal x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_continuous_atreal] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `min (x - floor x) ((floor x + &1) - x)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT; REAL_FLOOR_LT_REFL; FLOOR] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x = y ==> abs(x - y) < e`) THEN ASM_REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN MP_TAC(ISPEC `x:real` FLOOR) THEN ASM_REAL_ARITH_TAC);; let REAL_CONTINUOUS_FRAC = prove (`!x. ~(integer x) ==> frac real_continuous (atreal x)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[FRAC_FLOOR] THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_SIMP_TAC[REAL_CONTINUOUS_FLOOR; REAL_CONTINUOUS_AT_ID]);; let REAL_CONTINUOUS_ON_COMPOSE_FRAC = prove (`!f. f real_continuous_on real_interval[&0,&1] /\ f(&1) = f(&0) ==> (f o frac) real_continuous_on (:real)`, REPEAT STRIP_TAC THEN UNDISCH_TAC `f real_continuous_on real_interval[&0,&1]` THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; WITHINREAL_UNIV] THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_CASES_TAC `integer x` THENL [ALL_TAC; MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN ASM_SIMP_TAC[REAL_CONTINUOUS_FRAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [IN_REAL_INTERVAL] o SPEC `frac x`) THEN ASM_SIMP_TAC[FLOOR_FRAC; REAL_LT_IMP_LE] THEN REWRITE_TAC[real_continuous_atreal; real_continuous_withinreal] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (min (frac x) (&1 - frac x))` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FLOOR_FRAC; REAL_FRAC_POS_LT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[real_continuous_atreal; REAL_FRAC_ZERO; REAL_FLOOR_REFL] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o LAND_CONV) [IN_REAL_INTERVAL]) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `&0` th)) THEN REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN REWRITE_TAC[IMP_IMP; real_continuous_withinreal; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `min (&1) (min d1 d2)` THEN ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_MIN; o_DEF] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y < x`) THENL [SUBGOAL_THEN `floor y = floor x` ASSUME_TAC THENL [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN ASM_SIMP_TAC[REAL_FLOOR_REFL] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL; REAL_SUB_REFL] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_REAL_ARITH_TAC)]; SUBGOAL_THEN `floor y = floor x - &1` ASSUME_TAC THENL [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN ASM_SIMP_TAC[REAL_FLOOR_REFL; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL; REAL_SUB_REFL] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_REAL_ARITH_TAC)]]);; let REAL_TIETZE_PERIODIC_INTERVAL = prove (`!f a b. f real_continuous_on real_interval[a,b] /\ f(a) = f(b) ==> ?g. g real_continuous_on (:real) /\ (!x. x IN real_interval[a,b] ==> g(x) = f(x)) /\ (!x. g(x + (b - a)) = g x)`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b:real <= a \/ a < b`) THENL [EXISTS_TAC `\x:real. (f:real->real) a` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_ANTISYM]; EXISTS_TAC `(f:real->real) o (\y. a + (b - a) * y) o frac o (\x. (x - a) / (b - a))` THEN REWRITE_TAC[o_THM] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[real_div; REAL_CONTINUOUS_ON_RMUL; REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE_FRAC THEN ASM_SIMP_TAC[o_THM; REAL_MUL_RZERO; REAL_MUL_RID; REAL_SUB_ADD2; REAL_ADD_RID] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[REAL_CONTINUOUS_ON_LMUL; REAL_CONTINUOUS_ON_ADD; REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LT] THEN REWRITE_TAC[REAL_ARITH `a + (b - a) * x <= b <=> &0 <= (b - a) * (&1 - x)`] THEN ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE]; X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real = b` THENL [ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN ASM_REWRITE_TAC[FRAC_NUM; REAL_MUL_RZERO; REAL_ADD_RID]; SUBGOAL_THEN `frac((x - a) / (b - a)) = (x - a) / (b - a)` SUBST1_TAC THENL [REWRITE_TAC[REAL_FRAC_EQ] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN ASM_REAL_ARITH_TAC; AP_TERM_TAC THEN UNDISCH_TAC `a:real < b` THEN CONV_TAC REAL_FIELD]]; ASM_SIMP_TAC[REAL_FIELD `a < b ==> ((x + b - a) - a) / (b - a) = &1 + (x - a) / (b - a)`] THEN REWRITE_TAC[REAL_FRAC_ADD; FRAC_NUM; FLOOR_FRAC; REAL_ADD_LID]]]);; (* ------------------------------------------------------------------------- *) (* A variant of REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR for intervals. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_ADDITIVE_EXTEND = prove (`!f. f real_continuous_on real_interval[&0,&1] /\ (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 ==> f(x + y) = f(x) + f(y)) ==> ?g. g real_continuous_on (:real) /\ (!x y. g(x + y) = g(x) + g(y)) /\ (!x. x IN real_interval[&0,&1] ==> g x = f x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `f(&0) = &0` ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o ISPECL [`&0`; `&0`]) THEN REWRITE_TAC[REAL_ADD_LID] THEN REAL_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `\x. f(&1) * floor(x) + f(frac x)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [UNDISCH_TAC `f real_continuous_on real_interval[&0,&1]` THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; WITHINREAL_UNIV] THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_CASES_TAC `integer x` THENL [ALL_TAC; MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN CONJ_TAC THEN ASM_SIMP_TAC[REAL_CONTINUOUS_LMUL; REAL_CONTINUOUS_FLOOR; ETA_AX] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ATREAL_COMPOSE) THEN ASM_SIMP_TAC[REAL_CONTINUOUS_FRAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [IN_REAL_INTERVAL] o SPEC `frac x`) THEN ASM_SIMP_TAC[FLOOR_FRAC; REAL_LT_IMP_LE] THEN REWRITE_TAC[real_continuous_atreal; real_continuous_withinreal] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (min (frac x) (&1 - frac x))` THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FLOOR_FRAC; REAL_FRAC_POS_LT] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[real_continuous_atreal; REAL_FRAC_ZERO; REAL_FLOOR_REFL] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o LAND_CONV) [IN_REAL_INTERVAL]) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `&0` th)) THEN REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN REWRITE_TAC[IMP_IMP; real_continuous_withinreal; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `min (&1) (min d1 d2)` THEN ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_MIN] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y < x`) THENL [SUBGOAL_THEN `floor y = floor x` ASSUME_TAC THENL [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN ASM_SIMP_TAC[REAL_FLOOR_REFL] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL] THEN REWRITE_TAC[REAL_ARITH `(a + x) - (a + &0) = x - &0`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; SUBGOAL_THEN `floor y = floor x - &1` ASSUME_TAC THENL [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN ASM_SIMP_TAC[REAL_FLOOR_REFL; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL] THEN REWRITE_TAC[REAL_ARITH `(f1 * (x - &1) + f) - (f1 * x + &0) = f - f1`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]]; REPEAT GEN_TAC THEN REWRITE_TAC[REAL_FLOOR_ADD; REAL_FRAC_ADD] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; FLOOR_FRAC; REAL_LE_ADD] THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `f1 * ((x + y) + &1) + g = (f1 * x + z) + f1 * y + h <=> f1 / &2 + g / &2 = z / &2 + h / &2`] THEN SUBGOAL_THEN `!t. &0 <= t /\ t <= &1 ==> f(t) / &2 = f(t / &2)` ASSUME_TAC THENL [GEN_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`t / &2`; `t / &2`]) THEN REWRITE_TAC[REAL_HALF] THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_REFL; FLOOR_FRAC; REAL_LT_IMP_LE; REAL_ARITH `~(x + y < &1) ==> &0 <= (x + y) - &1`; REAL_ARITH `x < &1 /\ y < &1 ==> (x + y) - &1 <= &1`] THEN MATCH_MP_TAC(MESON[] `f(a + b) = f a + f b /\ f(c + d) = f(c) + f(d) /\ a + b = c + d ==> (f:real->real)(a) + f(b) = f(c) + f(d)`) THEN REPEAT CONJ_TAC THEN TRY REAL_ARITH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY (MP_TAC o C SPEC FLOOR_FRAC) [`x:real`; `y:real`] THEN ASM_REAL_ARITH_TAC; GEN_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_CASES_TAC `x = &1` THEN ASM_REWRITE_TAC[FLOOR_NUM; FRAC_NUM; REAL_MUL_RID; REAL_ADD_RID] THEN STRIP_TAC THEN SUBGOAL_THEN `floor x = &0` ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED]; ASM_REWRITE_TAC[FRAC_FLOOR; REAL_SUB_RZERO]] THEN ASM_REAL_ARITH_TAC]);; let REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL = prove (`!f b. (f ---> &0) (atreal (&0) within {x | &0 <= x}) /\ (!x y. &0 <= x /\ &0 <= y /\ x + y <= b ==> f(x + y) = f(x) + f(y)) ==> !a x. &0 <= x /\ x <= b /\ &0 <= a * x /\ a * x <= b ==> f(a * x) = a * f(x)`, SUBGOAL_THEN `!f. (f ---> &0) (atreal (&0) within {x | &0 <= x}) /\ (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 ==> f(x + y) = f(x) + f(y)) ==> !a x. &0 <= x /\ x <= &1 /\ &0 <= a * x /\ a * x <= &1 ==> f(a * x) = a * f(x)` ASSUME_TAC THENL [SUBGOAL_THEN `!f. f real_continuous_on real_interval[&0,&1] /\ (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 ==> f(x + y) = f(x) + f(y)) ==> !a x. &0 <= x /\ x <= &1 /\ &0 <= a * x /\ a * x <= &1 ==> f(a * x) = a * f(x)` (fun th -> GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC th) THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:real->real` REAL_CONTINUOUS_ADDITIVE_EXTEND) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `g:real->real` REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR) THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[real_continuous_on; IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `y = x \/ y < x \/ x < y`) THENL [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM]; SUBGOAL_THEN `(f:real->real)(y + (x - y)) = f(y) + f(x - y)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ADD_SUB2; REAL_ABS_NEG] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]; SUBGOAL_THEN `(f:real->real)(x + (y - x)) = f(x) + f(y - x)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ADD_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]]]; REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `b < &0 \/ b = &0 \/ &0 < b`) THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_ARITH `a <= x /\ x <= a /\ a <= y /\ y <= a <=> x = a /\ y = a`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&0`; `&0`]) THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_LE_REFL] THEN CONV_TAC REAL_RING; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o ISPEC `(\x. f(b * x)):real->real`) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real` THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN MP_TAC(ISPEC `x / b:real` th)) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < b ==> b * a * x / b = a * x`; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_ARITH `a * x / b:real = (a * x) / b`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC] THEN CONJ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `b * x + b * y <= b <=> &0 <= b * (&1 - (x + y))`; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE]] THEN REWRITE_TAC[REALLIM_WITHINREAL] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN REWRITE_TAC[REAL_SUB_RZERO; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / b:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < b ==> abs b * x = x * b`] THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_LT_RDIV_EQ]]);; (* ------------------------------------------------------------------------- *) (* More Steinhaus variants. *) (* ------------------------------------------------------------------------- *) let STEINHAUS_TRIVIAL = prove (`!s e. ~(negligible s) /\ &0 < e ==> ?x y:real^N. x IN s /\ y IN s /\ ~(x = y) /\ norm(x - y) < e`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN ASM_MESON_TAC[REAL_NOT_LT]);; let REAL_STEINHAUS = prove (`!s. real_measurable s /\ &0 < real_measure s ==> ?d. &0 < d /\ real_interval(--d,d) SUBSET {x - y | x IN s /\ y IN s}`, GEN_TAC THEN SIMP_TAC[IMP_CONJ; REAL_MEASURE_MEASURE] THEN REWRITE_TAC[IMP_IMP; REAL_MEASURABLE_MEASURABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN REWRITE_TAC[SUBSET; BALL_INTERVAL; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN REWRITE_TAC[SET_RULE `{g x y | x IN IMAGE f s /\ y IN IMAGE f t} = {g (f x) (f y) | x IN s /\ y IN t}`] THEN REWRITE_TAC[GSYM LIFT_SUB] THEN REWRITE_TAC[SET_RULE `{lift(f x y) | P x y} = IMAGE lift {f x y | P x y}`; IN_IMAGE_LIFT_DROP; GSYM FORALL_DROP] THEN REWRITE_TAC[DROP_SUB; DROP_VEC; LIFT_DROP; DROP_ADD] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Bernstein polynomials. *) (* ------------------------------------------------------------------------- *) let bernstein = new_definition `bernstein n k x = &(binom(n,k)) * x pow k * (&1 - x) pow (n - k)`;; let BERNSTEIN_CONV = GEN_REWRITE_CONV I [bernstein] THENC COMB2_CONV (RAND_CONV(RAND_CONV NUM_BINOM_CONV)) (RAND_CONV(RAND_CONV NUM_SUB_CONV)) THENC REAL_POLY_CONV;; (* ------------------------------------------------------------------------- *) (* Lemmas about Bernstein polynomials. *) (* ------------------------------------------------------------------------- *) let BERNSTEIN_POS = prove (`!n k x. &0 <= x /\ x <= &1 ==> &0 <= bernstein n k x`, REPEAT STRIP_TAC THEN REWRITE_TAC[bernstein] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC REAL_POW_LE THEN ASM_REAL_ARITH_TAC);; let SUM_BERNSTEIN = prove (`!n. sum (0..n) (\k. bernstein n k x) = &1`, REWRITE_TAC[bernstein; GSYM REAL_BINOMIAL_THEOREM] THEN REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE]);; let BERNSTEIN_LEMMA = prove (`!n x. sum(0..n) (\k. (&k - &n * x) pow 2 * bernstein n k x) = &n * x * (&1 - x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x y. sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k)) = (x + y) pow n` (LABEL_TAC "0") THENL [ASM_REWRITE_TAC[REAL_BINOMIAL_THEOREM]; ALL_TAC] THEN SUBGOAL_THEN `!x y. sum(0..n) (\k. &k * &(binom(n,k)) * x pow (k - 1) * y pow (n - k)) = &n * (x + y) pow (n - 1)` (LABEL_TAC "1") THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_DERIVATIVE_UNIQUE_ATREAL THEN MAP_EVERY EXISTS_TAC [`\x. sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k))`; `x:real`] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG]; ASM_REWRITE_TAC[]] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN SUBGOAL_THEN `!x y. sum(0..n) (\k. &k * &(k - 1) * &(binom(n,k)) * x pow (k - 2) * y pow (n - k)) = &n * &(n - 1) * (x + y) pow (n - 2)` (LABEL_TAC "2") THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_DERIVATIVE_UNIQUE_ATREAL THEN MAP_EVERY EXISTS_TAC [`\x. sum(0..n) (\k. &k * &(binom(n,k)) * x pow (k - 1) * y pow (n - k))`; `x:real`] THEN CONJ_TAC THENL [MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG]; ASM_REWRITE_TAC[]] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[ARITH_RULE `n - 1 - 1 = n - 2`] THEN CONV_TAC REAL_RING; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `(a - b) pow 2 * x = a * (a - &1) * x + (&1 - &2 * b) * a * x + b * b * x`] THEN REWRITE_TAC[SUM_ADD_NUMSEG; SUM_LMUL; SUM_BERNSTEIN] THEN SUBGOAL_THEN `sum(0..n) (\k. &k * bernstein n k x) = &n * x` SUBST1_TAC THENL [REMOVE_THEN "1" (MP_TAC o SPECL [`x:real`; `&1 - x`]) THEN REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE; bernstein; REAL_MUL_RID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `(k * b * xk * y) * x:real = k * b * (x * xk) * y`] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN DISJ_CASES_TAC(ARITH_RULE `k = 0 \/ SUC(k - 1) = k`) THEN ASM_REWRITE_TAC[REAL_MUL_LZERO]; ALL_TAC] THEN SUBGOAL_THEN `sum(0..n) (\k. &k * (&k - &1) * bernstein n k x) = &n * (&n - &1) * x pow 2` SUBST1_TAC THENL [ALL_TAC; CONV_TAC REAL_RING] THEN REMOVE_THEN "2" (MP_TAC o SPECL [`x:real`; `&1 - x`]) THEN REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE; bernstein; REAL_MUL_RID] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LE_1; REAL_MUL_ASSOC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `((((k * k1) * b) * xk) * y) * x2:real = k * k1 * b * y * (x2 * xk)`] THEN REWRITE_TAC[GSYM REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (ARITH_RULE `k = 0 \/ k = 1 \/ 1 <= k /\ 2 + k - 2 = k`) THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; SUB_REFL; REAL_SUB_REFL] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* Explicit Bernstein version of 1D Weierstrass approximation theorem *) (* ------------------------------------------------------------------------- *) let BERNSTEIN_WEIERSTRASS = prove (`!f e. f real_continuous_on real_interval[&0,&1] /\ &0 < e ==> ?N. !n x. N <= n /\ x IN real_interval[&0,&1] ==> abs(f x - sum(0..n) (\k. f(&k / &n) * bernstein n k x)) < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `real_bounded(IMAGE f (real_interval[&0,&1]))` MP_TAC THENL [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; REWRITE_TAC[REAL_BOUNDED_POS; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `M:real` THEN STRIP_TAC] THEN SUBGOAL_THEN `f real_uniformly_continuous_on real_interval[&0,&1]` MP_TAC THENL [ASM_SIMP_TAC[REAL_COMPACT_UNIFORMLY_CONTINUOUS; REAL_COMPACT_INTERVAL]; REWRITE_TAC[real_uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; IN_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `!n x. 0 < n /\ &0 <= x /\ x <= &1 ==> abs(f x - sum(0..n) (\k. f(&k / &n) * bernstein n k x)) <= e / &2 + (&2 * M) / (d pow 2 * &n)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(sum(0..n) (\k. (f x - f(&k / &n)) * bernstein n k x))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG; SUM_LMUL] THEN REWRITE_TAC[SUM_BERNSTEIN; REAL_MUL_RID; REAL_LE_REFL]; ALL_TAC] THEN W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN ASM_SIMP_TAC[BERNSTEIN_POS; REAL_ARITH `&0 <= x ==> abs x = x`] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0..n) (\k. (e / &2 + &2 * M / d pow 2 * (x - &k / &n) pow 2) * bernstein n k x)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[BERNSTEIN_POS] THEN SUBGOAL_THEN `&0 <= &k / &n /\ &k / &n <= &1` STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT] THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE; MULT_CLAUSES]; ALL_TAC] THEN DISJ_CASES_TAC(REAL_ARITH `abs(x - &k / &n) < d \/ d <= abs(x - &k / &n)`) THENL [MATCH_MP_TAC(REAL_ARITH `x < e /\ &0 <= d ==> x <= e + d`) THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= &2 * x <=> &0 <= x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_POW_2; REAL_LE_SQUARE; REAL_LT_IMP_LE]; MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= d ==> x <= e / &2 + d`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= M /\ abs(y) <= M /\ M * &1 <= M * b / d ==> abs(x - y) <= &2 * M / d * b`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_LE_RDIV_EQ] THEN REWRITE_TAC[REAL_MUL_LID; GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC]; REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG; SUM_LMUL] THEN REWRITE_TAC[SUM_BERNSTEIN; REAL_MUL_RID; REAL_LE_LADD] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; REAL_POW_LT; REAL_LT_INV_EQ] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&n pow 2` THEN ASM_SIMP_TAC[GSYM SUM_LMUL; REAL_POW_LT; REAL_OF_NUM_LT; REAL_FIELD `&0 < n ==> n pow 2 * inv(n) = n`] THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_MUL] THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_FIELD `&0 < n ==> n * (x - k * inv n) = n * x - k`] THEN ONCE_REWRITE_TAC[REAL_ARITH `(x - y:real) pow 2 = (y - x) pow 2`] THEN REWRITE_TAC[BERNSTEIN_LEMMA; REAL_ARITH `&n * x <= &n <=> &n * x <= &n * &1 * &1`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]; MP_TAC(ISPEC `(e / &4 * d pow 2) / (&2 * M)` REAL_ARCH_INV) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_LT_MUL] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_MUL_LZERO] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_ARITH `(x * &2 * m) * i = (&2 * m) * (i * x)`] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real`]) THEN ASM_SIMP_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ k < e / &4 ==> x <= e / &2 + k ==> x < e`) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> y <= x ==> y < e`)) THEN ASM_SIMP_TAC[real_div; REAL_LE_LMUL_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_LE]]);; (* ------------------------------------------------------------------------- *) (* General Stone-Weierstrass theorem. *) (* ------------------------------------------------------------------------- *) let STONE_WEIERSTRASS_ALT = prove (`!(P:(real^N->real)->bool) (s:real^N->bool). compact s /\ (!c. P(\x. c)) /\ (!f g. P(f) /\ P(g) ==> P(\x. f x + g x)) /\ (!f g. P(f) /\ P(g) ==> P(\x. f x * g x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. (!x. x IN s ==> f real_continuous (at x within s)) /\ P(f) /\ ~(f x = f y)) ==> !f e. (!x. x IN s ==> f real_continuous (at x within s)) /\ &0 < e ==> ?g. P(g) /\ !x. x IN s ==> abs(f x - g x) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`C = \f. !x:real^N. x IN s ==> f real_continuous at x within s`; `A = \f. C f /\ !e. &0 < e ==> ?g. P(g) /\ !x:real^N. x IN s ==> abs(f x - g x) < e`] THEN SUBGOAL_THEN `!f:real^N->real. C(f) ==> A(f)` MP_TAC THENL [ALL_TAC; MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[]] THEN SUBGOAL_THEN `!c:real. A(\x:real^N. c)` (LABEL_TAC "const") THENL [MAP_EVERY EXPAND_TAC ["A"; "C"] THEN X_GEN_TAC `c:real` THEN ASM_REWRITE_TAC[REAL_CONTINUOUS_CONST] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. c):real^N->real` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0]; ALL_TAC] THEN SUBGOAL_THEN `!f g:real^N->real. A(f) /\ A(g) ==> A(\x. f x + g x)` (LABEL_TAC "add") THENL [MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[REAL_CONTINUOUS_ADD] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2` o CONJUNCT2)) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g':real^N->real` THEN STRIP_TAC THEN X_GEN_TAC `f':real^N->real` THEN STRIP_TAC THEN EXISTS_TAC `(\x. f' x + g' x):real^N->real` THEN ASM_SIMP_TAC[REAL_ARITH `abs(f - f') < e / &2 /\ abs(g - g') < e / &2 ==> abs((f + g) - (f' + g')) < e`]; ALL_TAC] THEN SUBGOAL_THEN `!f:real^N->real. A(f) ==> C(f)` (LABEL_TAC "AC") THENL [EXPAND_TAC "A" THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!f:real^N->real. C(f) ==> real_bounded(IMAGE f s)` (LABEL_TAC "bound") THENL [GEN_TAC THEN EXPAND_TAC "C" THEN REWRITE_TAC[REAL_BOUNDED; GSYM IMAGE_o] THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1] THEN REWRITE_TAC[GSYM CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE]; ALL_TAC] THEN SUBGOAL_THEN `!f g:real^N->real. A(f) /\ A(g) ==> A(\x. f x * g x)` (LABEL_TAC "mul") THENL [MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[REAL_CONTINUOUS_MUL] THEN REWRITE_TAC[IMP_CONJ] THEN MAP_EVERY (DISCH_THEN o LABEL_TAC) ["cf"; "af"; "cg"; "ag"] THEN SUBGOAL_THEN `real_bounded(IMAGE (f:real^N->real) s) /\ real_bounded(IMAGE (g:real^N->real) s)` MP_TAC THENL [ASM_SIMP_TAC[]; REWRITE_TAC[REAL_BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `Bf:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `Bg:real` STRIP_ASSUME_TAC)) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "ag" (MP_TAC o SPEC `e / &2 / Bf`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g':real^N->real` THEN STRIP_TAC THEN REMOVE_THEN "af" (MP_TAC o SPEC `e / &2 / (Bg + e / &2 / Bf)`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_ADD] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\x. f'(x) * g'(x)):real^N->real` THEN ASM_SIMP_TAC[REAL_ARITH `f * g - f' * g':real = f * (g - g') + g' * (f - f')`] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `e = Bf * e / &2 / Bf + (Bg + e / &2 / Bf) * e / &2 / (Bg + e / &2 / Bf)` SUBST1_TAC THENL [MATCH_MP_TAC(REAL_ARITH `a = e / &2 /\ b = e / &2 ==> e = a + b`) THEN CONJ_TAC THEN MAP_EVERY MATCH_MP_TAC [REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_ADD; REAL_HALF]; MATCH_MP_TAC(REAL_ARITH `abs a < c /\ abs b < d ==> abs(a + b) < c + d`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_SIMP_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `!g. abs(g) < Bg /\ abs(g - g') < e ==> abs(g') < Bg + e`) THEN EXISTS_TAC `(g:real^N->real) x` THEN ASM_SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f:real^N->real. A(f) /\ ~(f x = f y)` (LABEL_TAC "sep") THENL [MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN MAP_EVERY EXPAND_TAC ["A"; "C"] THEN ASM_MESON_TAC[REAL_SUB_REFL; REAL_ABS_0]; ALL_TAC] THEN SUBGOAL_THEN `!f. A(f) ==> A(\x:real^N. abs(f x))` (LABEL_TAC "abs") THENL [SUBGOAL_THEN `!f. A(f) /\ (!x. x IN s ==> abs(f x) <= &1 / &4) ==> A(\x:real^N. abs(f x))` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN SUBGOAL_THEN `real_bounded(IMAGE (f:real^N->real) s)` MP_TAC THENL [ASM_SIMP_TAC[]; REWRITE_TAC[REAL_BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `A(\x:real^N. (&4 * B) * abs(inv(&4 * B) * f x)):bool` MP_TAC THENL [USE_THEN "mul" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ABS_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> abs(B) = B`; REAL_LT_INV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_MUL_LID; REAL_LT_IMP_LE]; ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ARITH `&0 < B ==> abs(B) = B`; REAL_LT_INV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID; REAL_ARITH `&0 < B ==> ~(&4 * B = &0)`]]] THEN X_GEN_TAC `f:real^N->real` THEN MAP_EVERY EXPAND_TAC ["A"; "C"] THEN DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL [DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT1) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; o_DEF] REAL_CONTINUOUS_WITHIN_COMPOSE) THEN REWRITE_TAC[real_continuous_withinreal] THEN MESON_TAC[ARITH_RULE `abs(x - y) < d ==> abs(abs x - abs y) < d`]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun t -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC t) THEN DISCH_THEN(MP_TAC o SPEC `min (e / &2) (&1 / &4)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_LT_MIN; FORALL_AND_THM; TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^N->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\x. abs(x - &1 / &2)`; `e / &2`] BERNSTEIN_WEIERSTRASS) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[real_continuous_on; REAL_HALF] THEN MESON_TAC[ARITH_RULE `abs(x - y) < d ==> abs(abs(x - a) - abs(y - a)) < d`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN EXISTS_TAC `\x:real^N. sum(0..n) (\k. abs(&k / &n - &1 / &2) * bernstein n k (&1 / &2 + p x))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [SUBGOAL_THEN `!m c z. P(\x:real^N. sum(0..m) (\k. c k * bernstein (z m) k (&1 / &2 + p x)))` (fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN `!m k. P(\x:real^N. bernstein m k (&1 / &2 + p x))` ASSUME_TAC THENL [ALL_TAC; INDUCT_TAC THEN ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0]] THEN REPEAT GEN_TAC THEN REWRITE_TAC[bernstein] THEN REWRITE_TAC[REAL_ARITH `&1 - (&1 / &2 + p) = &1 / &2 + -- &1 * p`] THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]) THEN SUBGOAL_THEN `!f:real^N->real k. P(f) ==> P(\x. f(x) pow k)` (fun th -> ASM_SIMP_TAC[th]) THEN GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_pow]; REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `!p. abs(abs(p x) - s) < e / &2 /\ abs(f x - p x) < e / &2 ==> abs(abs(f x) - s) < e`) THEN EXISTS_TAC `p:real^N->real` THEN ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC (PAT_CONV `\x. abs(abs x - a) < e`) [REAL_ARITH `x = (&1 / &2 + x) - &1 / &2`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN MATCH_MP_TAC(REAL_ARITH `!f. abs(f) <= &1 / &4 /\ abs(f - p) < &1 / &4 ==> &0 <= &1 / &2 + p /\ &1 / &2 + p <= &1`) THEN EXISTS_TAC `(f:real^N->real) x` THEN ASM_SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `!f:real^N->real g. A(f) /\ A(g) ==> A(\x. max (f x) (g x))` (LABEL_TAC "max") THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `max a b = inv(&2) * (a + b + abs(a + -- &1 * b))`] THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]); ALL_TAC] THEN SUBGOAL_THEN `!f:real^N->real g. A(f) /\ A(g) ==> A(\x. min (f x) (g x))` (LABEL_TAC "min") THENL [ASM_SIMP_TAC[REAL_ARITH `min a b = -- &1 * (max(-- &1 * a) (-- &1 * b))`]; ALL_TAC] THEN SUBGOAL_THEN `!t. FINITE t /\ (!f. f IN t ==> A(f)) ==> A(\x:real^N. sup {f(x) | f IN t})` (LABEL_TAC "sup") THENL [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[FORALL_IN_INSERT; SIMPLE_IMAGE; IMAGE_CLAUSES] THEN ASM_SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real`; `t:(real^N->real)->bool`] THEN ASM_CASES_TAC `t:(real^N->real)->bool = {}` THEN ASM_SIMP_TAC[ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `!t. FINITE t /\ (!f. f IN t ==> A(f)) ==> A(\x:real^N. inf {f(x) | f IN t})` (LABEL_TAC "inf") THENL [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[FORALL_IN_INSERT; SIMPLE_IMAGE; IMAGE_CLAUSES] THEN ASM_SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real`; `t:(real^N->real)->bool`] THEN ASM_CASES_TAC `t:(real^N->real)->bool = {}` THEN ASM_SIMP_TAC[ETA_AX]; ALL_TAC] THEN SUBGOAL_THEN `!f:real^N->real e. C(f) /\ &0 < e ==> ?g. A(g) /\ !x. x IN s ==> abs(f x - g x) < e` ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN EXPAND_TAC "A" THEN CONJ_TAC THENL [FIRST_X_ASSUM ACCEPT_TAC; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`f:real^N->real`; `e / &2`]) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real` THEN EXPAND_TAC "A" THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e / &2` o CONJUNCT2) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[REAL_ARITH `abs(f - h) < e / &2 /\ abs(h - g) < e / &2 ==> abs(f - g) < e`]] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real`; `e:real`] THEN EXPAND_TAC "C" THEN STRIP_TAC THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s ==> ?h:real^N->real. A(h) /\ h(x) = f(x) /\ h(y) = f(y)` MP_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `y:real^N = x` THENL [EXISTS_TAC `\z:real^N. (f:real^N->real) x` THEN ASM_SIMP_TAC[]; SUBGOAL_THEN `?h:real^N->real. A(h) /\ ~(h x = h y)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `\z. (f y - f x) / (h y - h x) * (h:real^N->real)(z) + (f x - (f y - f x) / (h y - h x) * h(x))` THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `~((h:real^N->real) x = h y)` THEN CONV_TAC REAL_FIELD]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f2:real^N->real^N->real^N->real` THEN DISCH_TAC THEN ABBREV_TAC `G = \x y. {z | z IN s /\ (f2:real^N->real^N->real^N->real) x y z < f(z) + e}` THEN SUBGOAL_THEN `!x y:real^N. x IN s /\ y IN s ==> x IN G x y /\ y IN G x y` ASSUME_TAC THENL [EXPAND_TAC "G" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[REAL_LT_ADDR]; ALL_TAC] THEN SUBGOAL_THEN `!x. x IN s ==> ?f1. A(f1) /\ f1 x = f x /\ !y:real^N. y IN s ==> f1 y < f y + e` MP_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN DISCH_THEN(MP_TAC o SPEC `{(G:real^N->real^N->real^N->bool) x y | y IN s}`) THEN REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE; ETA_AX] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN EXPAND_TAC "G" THEN REWRITE_TAC[] THEN X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`lift o (\z:real^N. f2 (x:real^N) (w:real^N) z - f z)`; `s:real^N->bool`; `{x:real^1 | x$1 < e}`] CONTINUOUS_OPEN_IN_PREIMAGE) THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; IN_ELIM_THM] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; o_DEF] THEN REWRITE_TAC[LIFT_SUB; GSYM REAL_CONTINUOUS_CONTINUOUS1; REAL_ARITH `x < y + e <=> x - y < e`] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1; ETA_AX] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:real^N. inf {f2 (x:real^N) (y:real^N) z | y IN t}` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `x = min x x`] THEN REWRITE_TAC[REAL_MIN_INF; INSERT_AC] THEN AP_TERM_TAC THEN ASM SET_TAC[]; REMOVE_THEN "inf" (MP_TAC o SPEC `IMAGE (\y z. (f2:real^N->real^N->real^N->real) x y z) t`) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[SIMPLE_IMAGE; ETA_AX] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF]; SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_INF_LT_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN UNDISCH_TAC `s SUBSET {y:real^N | ?z:real^N. z IN t /\ y IN G (x:real^N) z}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "G" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f1:real^N->real^N->real` THEN DISCH_TAC] THEN ABBREV_TAC `H = \x:real^N. {z:real^N | z IN s /\ f z - e < f1 x z}` THEN SUBGOAL_THEN `!x:real^N. x IN s ==> x IN (H x)` ASSUME_TAC THENL [EXPAND_TAC "H" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[REAL_ARITH `x - e < x <=> &0 < e`]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN DISCH_THEN(MP_TAC o SPEC `{(H:real^N->real^N->bool) x | x IN s}`) THEN REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE; ETA_AX] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN EXPAND_TAC "H" THEN REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`lift o (\z:real^N. f z - f1 (x:real^N) z)`; `s:real^N->bool`; `{x:real^1 | x$1 < e}`] CONTINUOUS_OPEN_IN_PREIMAGE) THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; IN_ELIM_THM] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; o_DEF] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `x - y < z <=> x - z < y`] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LIFT_SUB; GSYM REAL_CONTINUOUS_CONTINUOUS1; REAL_ARITH `x < y + e <=> x - y < e`] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1; ETA_AX] THEN ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:real^N. sup {f1 (x:real^N) z | x IN t}` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REMOVE_THEN "sup" (MP_TAC o SPEC `IMAGE (f1:real^N->real^N->real) t`) THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[SIMPLE_IMAGE; ETA_AX] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SIMPLE_IMAGE; REAL_ARITH `abs(f - s) < e <=> f - e < s /\ s < f + e`] THEN ASM_SIMP_TAC[REAL_SUP_LT_FINITE; REAL_LT_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN UNDISCH_TAC `s SUBSET {y:real^N | ?x:real^N. x IN t /\ y IN H x}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "H" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]);; let STONE_WEIERSTRASS = prove (`!(P:(real^N->real)->bool) (s:real^N->bool). compact s /\ (!f. P(f) ==> !x. x IN s ==> f real_continuous (at x within s)) /\ (!c. P(\x. c)) /\ (!f g. P(f) /\ P(g) ==> P(\x. f x + g x)) /\ (!f g. P(f) /\ P(g) ==> P(\x. f x * g x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P(f) /\ ~(f x = f y)) ==> !f e. (!x. x IN s ==> f real_continuous (at x within s)) /\ &0 < e ==> ?g. P(g) /\ !x. x IN s ==> abs(f x - g x) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Real and complex versions of Stone-Weierstrass theorem. *) (* ------------------------------------------------------------------------- *) let REAL_STONE_WEIERSTRASS_ALT = prove (`!P s. real_compact s /\ (!c. P (\x. c)) /\ (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. f real_continuous_on s /\ P f /\ ~(f x = f y)) ==> !f e. f real_continuous_on s /\ &0 < e ==> ?g. P g /\ !x. x IN s ==> abs(f x - g x) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\f. (P:(real->real)->bool)(f o lift)`; `IMAGE lift s`] STONE_WEIERSTRASS_ALT) THEN ASM_SIMP_TAC[GSYM real_compact; o_DEF] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN ANTS_TAC THENL [X_GEN_TAC `x:real` THEN DISCH_TAC THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[LIFT_EQ] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:real->real) o drop` THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP; ETA_AX] THEN UNDISCH_TAC `g real_continuous_on s` THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[real_continuous_within; continuous_within] THEN REWRITE_TAC[o_THM; LIFT_DROP; DIST_LIFT]; DISCH_THEN(MP_TAC o SPEC `(f:real->real) o drop`) THEN ANTS_TAC THENL [UNDISCH_TAC `f real_continuous_on s` THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[real_continuous_within; continuous_within] THEN REWRITE_TAC[o_THM; LIFT_DROP; DIST_LIFT]; DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^1->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(g:real^1->real) o lift` THEN ASM_REWRITE_TAC[o_DEF]]]);; let REAL_STONE_WEIERSTRASS = prove (`!P s. real_compact s /\ (!f. P f ==> f real_continuous_on s) /\ (!c. P (\x. c)) /\ (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P f /\ ~(f x = f y)) ==> !f e. f real_continuous_on s /\ &0 < e ==> ?g. P g /\ !x. x IN s ==> abs(f x - g x) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC REAL_STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; let COMPLEX_STONE_WEIERSTRASS_ALT = prove (`!P s. compact s /\ (!c. P (\x. c)) /\ (!f. P f ==> P(\x. cnj(f x))) /\ (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P f /\ f continuous_on s /\ ~(f x = f y)) ==> !f:real^N->complex e. f continuous_on s /\ &0 < e ==> ?g. P g /\ !x. x IN s ==> norm(f x - g x) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!f. P f ==> P(\x:real^N. Cx(Re(f x)))` ASSUME_TAC THENL [ASM_SIMP_TAC[CX_RE_CNJ; SIMPLE_COMPLEX_ARITH `x / Cx(&2) = inv(Cx(&2)) * x`]; ALL_TAC] THEN SUBGOAL_THEN `!f. P f ==> P(\x:real^N. Cx(Im(f x)))` ASSUME_TAC THENL [ASM_SIMP_TAC[CX_IM_CNJ; SIMPLE_COMPLEX_ARITH `x - y = x + --Cx(&1) * y /\ x / Cx(&2) = inv(Cx(&2)) * x`] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC ORELSE CONJ_TAC) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`\x. x IN {Re o f | P (f:real^N->complex)}`; `s:real^N->bool`] STONE_WEIERSTRASS_ALT) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN REWRITE_TAC[EXISTS_IN_GSPEC; IMP_IMP; GSYM CONJ_ASSOC] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^N. Cx(c)` THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; RE_CX]; MAP_EVERY X_GEN_TAC [`f:real^N->complex`; `g:real^N->complex`] THEN DISCH_TAC THEN EXISTS_TAC `(\x. f x + g x):real^N->complex` THEN ASM_SIMP_TAC[o_THM; RE_ADD; FUN_EQ_THM]; MAP_EVERY X_GEN_TAC [`f:real^N->complex`; `g:real^N->complex`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. Cx(Re(f x)) * Cx(Re(g x))` THEN ASM_SIMP_TAC[FUN_EQ_THM; RE_CX; o_THM; RE_MUL_CX]; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->complex` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EQ] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THENL [EXISTS_TAC `\x:real^N. Re(f x)` THEN ASM_REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [ALL_TAC; EXISTS_TAC `f:real^N->complex` THEN ASM_REWRITE_TAC[]]; EXISTS_TAC `\x:real^N. Im(f x)` THEN ASM_REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [ALL_TAC; EXISTS_TAC `\x:real^N. Cx(Im(f x))` THEN ASM_SIMP_TAC[RE_CX]]] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN SIMP_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; REAL_CONTINUOUS_AT_WITHIN] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]]; DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `f:real^N->complex` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (fun th -> MP_TAC(ISPEC `Re o (f:real^N->complex)` th) THEN MP_TAC(ISPEC `Im o (f:real^N->complex)` th)) THEN MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r`) THEN CONJ_TAC THENL [CONJ_TAC THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN SIMP_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; REAL_CONTINUOUS_AT_WITHIN] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; ALL_TAC] THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; o_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\x:real^N. Cx(Re(h x)) + ii * Cx(Re(g x))` THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [COMPLEX_EXPAND] THEN MATCH_MP_TAC(NORM_ARITH `norm(x1 - x2) < e / &2 /\ norm(y1 - y2) < e / &2 ==> norm((x1 + y1) - (x2 + y2)) < e`) THEN ASM_SIMP_TAC[GSYM CX_SUB; COMPLEX_NORM_CX; GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL; COMPLEX_NORM_II; REAL_MUL_LID]]);; let COMPLEX_STONE_WEIERSTRASS = prove (`!P s. compact s /\ (!f. P f ==> f continuous_on s) /\ (!c. P (\x. c)) /\ (!f. P f ==> P(\x. cnj(f x))) /\ (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P f /\ ~(f x = f y)) ==> !f:real^N->complex e. f continuous_on s /\ &0 < e ==> ?g. P g /\ !x. x IN s ==> norm(f x - g x) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPLEX_STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Stone-Weierstrass for R^n -> R polynomials. *) (* ------------------------------------------------------------------------- *) let real_polynomial_function_RULES, real_polynomial_function_INDUCT, real_polynomial_function_CASES = new_inductive_definition `(!i. 1 <= i /\ i <= dimindex(:N) ==> real_polynomial_function(\x:real^N. x$i)) /\ (!c. real_polynomial_function(\x:real^N. c)) /\ (!f g. real_polynomial_function f /\ real_polynomial_function g ==> real_polynomial_function(\x:real^N. f x + g x)) /\ (!f g. real_polynomial_function f /\ real_polynomial_function g ==> real_polynomial_function(\x:real^N. f x * g x))`;; let REAL_POLYNOMIAL_FUNCTION_ADD = prove (`!f g. real_polynomial_function f /\ real_polynomial_function g ==> real_polynomial_function(\x. f x + g x)`, REWRITE_TAC[real_polynomial_function_RULES]);; let REAL_POLYNOMIAL_FUNCTION_MUL = prove (`!f g. real_polynomial_function f /\ real_polynomial_function g ==> real_polynomial_function(\x. f x * g x)`, REWRITE_TAC[real_polynomial_function_RULES]);; let REAL_POLYNOMIAL_FUNCTION_NEG = prove (`!f:real^N->real. real_polynomial_function(\x. --(f x)) <=> real_polynomial_function f`, MATCH_MP_TAC(MESON[] `(!x. n(n x) = x) /\ (!x. P x ==> P(n x)) ==> (!x. P(n x) <=> P x)`) THEN REWRITE_TAC[REAL_NEG_NEG; ETA_AX] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `--x:real = --(&1) * x`] THEN ASM_SIMP_TAC[real_polynomial_function_RULES; ETA_AX]);; let REAL_POLYNOMIAL_FUNCTION_SUB = prove (`!f g:real^N->real. real_polynomial_function f /\ real_polynomial_function g ==> real_polynomial_function (\x. f x - g x)`, SIMP_TAC[real_sub; REAL_POLYNOMIAL_FUNCTION_NEG; REAL_POLYNOMIAL_FUNCTION_ADD]);; let REAL_POLYNOMIAL_FUNCTION_SUM = prove (`!f s. FINITE s /\ (!a. a IN s ==> real_polynomial_function(\x. f x a)) ==> real_polynomial_function (\x. sum s (f x))`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[real_polynomial_function_RULES; SUM_CLAUSES; FORALL_IN_INSERT]);; let REAL_POLYNOMIAL_FUNCTION_PRODUCT = prove (`!f s. FINITE s /\ (!a. a IN s ==> real_polynomial_function(\x. f x a)) ==> real_polynomial_function (\x. product s (f x))`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[real_polynomial_function_RULES; PRODUCT_CLAUSES; FORALL_IN_INSERT]);; let REAL_POLYNOMIAL_FUNCTION_POW = prove (`!p n. real_polynomial_function p ==> real_polynomial_function(\x. p(x) pow n)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_polynomial_function_RULES; real_pow]);; let REAL_POLYNOMIAL_FUNCTION_EXPLICIT, REAL_POLYNOMIAL_FUNCTION_EXPLICIT_NZ, REAL_POLYNOMIAL_FUNCTION_EXPLICIT_UNIV = let lemma1,lemma2 = (CONJ_PAIR o prove) (`(!f:real^N->real. (?a:num^N->real. FINITE {k | ~(a k = &0)} /\ f = \x. sum (:num^N) (\k. a(k) * product(1..dimindex(:N)) (\i. x$i pow k$i))) <=> (?(s:num^N->bool) a. FINITE s /\ f = \x. sum s (\k. a(k) * product(1..dimindex(:N)) (\i. x$i pow k$i)))) /\ (!f:real^N->real. (?a:num^N->real. FINITE {k | ~(a k = &0)} /\ f = \x. sum (:num^N) (\k. a(k) * product(1..dimindex(:N)) (\i. x$i pow k$i))) <=> (?(s:num^N->bool) a. FINITE s /\ (!k. k IN s ==> ~(a k = &0)) /\ f = \x. sum s (\k. a(k) * product(1..dimindex(:N)) (\i. x$i pow k$i))))`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (p ==> r) /\ (q ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num^N->real` THEN STRIP_TAC THEN EXISTS_TAC `{k:num^N | ~(a k = &0)}` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ABS_TAC THEN MATCH_MP_TAC SUM_SUPERSET THEN SIMP_TAC[SUBSET_UNIV; IN_ELIM_THM; IN_UNIV; REAL_MUL_LZERO]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:num^N->bool`; `a:num^N->real`] THEN STRIP_TAC THEN EXISTS_TAC `\k. if k IN s then (a:num^N->real) k else &0` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]; ABS_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_SIMP_TAC[SUBSET_UNIV; REAL_MUL_LZERO]]]) in let REAL_POLYNOMIAL_FUNCTION_EXPLICIT_UNIV = prove (`!f:real^N->real. real_polynomial_function f <=> ?a:num^N->real. FINITE {k | ~(a k = &0)} /\ f = \x. sum (:num^N) (\k. a(k) * product(1..dimindex(:N)) (\i. x$i pow k$i))`, REWRITE_TAC[TAUT `(p <=> q) <=> (q ==> p) /\ (p ==> q)`; FORALL_AND_THM] THEN CONJ_TAC THENL [GEN_TAC THEN REWRITE_TAC[lemma1] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:num^N->bool`; `a:num^N->real`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_SUM THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_MUL THEN REWRITE_TAC[real_polynomial_function_RULES] THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_PRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_POW THEN ASM_SIMP_TAC[real_polynomial_function_RULES]; ALL_TAC] THEN MATCH_MP_TAC real_polynomial_function_INDUCT THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[lemma1] THEN EXISTS_TAC `{(lambda i. if i = j then 1 else 0):num^N}` THEN EXISTS_TAC `\k:num^N. &1` THEN REWRITE_TAC[FINITE_SING; SUM_SING; REAL_MUL_LID] THEN ABS_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; COND_RAND; real_pow; PRODUCT_DELTA; IN_NUMSEG; REAL_POW_1]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [X_GEN_TAC `c:real` THEN REWRITE_TAC[lemma1] THEN EXISTS_TAC `{(lambda i. 0):num^N}` THEN EXISTS_TAC `(\k. c):num^N->real` THEN REWRITE_TAC[FINITE_SING; SUM_SING] THEN ABS_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; real_pow; PRODUCT_ONE; REAL_MUL_RID]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a:num^N->real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `b:num^N->real` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(\k. a k + b k):num^N->real` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{k:num^N | ~(a k = &0)} UNION {k:num^N | ~(b k = &0)}` THEN ASM_REWRITE_TAC[FINITE_UNION; SUBSET; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_ADD_RDISTRIB] THEN ABS_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_ADD_GEN THEN REWRITE_TAC[IN_UNIV; REAL_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[FINITE_SUBSET] `FINITE {k | P k} /\ {k | P k /\ Q k} SUBSET {k | P k} ==> FINITE {k | P k /\ Q k}`) THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; DISCH_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[lemma1] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s:num^N->bool` (X_CHOOSE_THEN `a:num^N->real` STRIP_ASSUME_TAC)) (X_CHOOSE_THEN `t:num^N->bool` (X_CHOOSE_THEN `b:num^N->real` STRIP_ASSUME_TAC))) THEN ASM_REWRITE_TAC[GSYM SUM_RMUL] THEN ASM_REWRITE_TAC[GSYM SUM_LMUL] THEN ASM_SIMP_TAC[SUM_SUM_PRODUCT] THEN MP_TAC(GEN `g:num^N#num^N->real` (ISPECL [`(\(k,l). lambda i. k$i + l$i):num^N#num^N->num^N`; `g:num^N#num^N->real`; `{k,l | (k:num^N) IN s /\ (l:num^N) IN t}`; `(:num^N)`] SUM_GROUP)) THEN ASM_SIMP_TAC[FINITE_PRODUCT; SUBSET_UNIV; GSYM lemma1] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN EXISTS_TAC `\m:num^N. sum {(k:num^N,l:num^N) | k IN s /\ l IN t /\ (lambda i. k$i + l$i) = m} (\(k,l). (a:num^N->real) k * b l)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE ((\(k,l). lambda i. k$i + l$i):num^N#num^N->num^N) {k,l | k IN s /\ l IN t}` THEN ASM_SIMP_TAC[FINITE_PRODUCT; FINITE_IMAGE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[CONTRAPOS_THM; SET_RULE `x IN IMAGE f s <=> ~({y | y IN s /\ f y = x} = {})`] THEN GEN_TAC THEN DISCH_THEN(fun th -> MATCH_MP_TAC(MESON[SUM_CLAUSES] `s = {} ==> sum s f = &0`) THEN GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM; IN_ELIM_PAIR_THM; GSYM CONJ_ASSOC]; ABS_TAC THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `m:num^N` THEN REWRITE_TAC[IN_UNIV; GSYM SUM_RMUL] THEN MATCH_MP_TAC(MESON[SUM_EQ] `s = t /\ (!x. x IN t ==> f x = g x) ==> sum s f = sum t g`) THEN REWRITE_TAC[FORALL_IN_GSPEC; EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MATCH_MP_TAC(REAL_RING `p1 * p2:real = p ==> (a * p1) * (b * p2) = (a * b) * p`) THEN ASM_SIMP_TAC[GSYM PRODUCT_MUL_NUMSEG; LAMBDA_BETA; REAL_POW_ADD]]) in let REAL_POLYNOMIAL_FUNCTION_EXPLICIT = prove (`!f:real^N->real. real_polynomial_function f <=> ?(s:num^N->bool) a. FINITE s /\ f = \x. sum s (\k. a(k) * product(1..dimindex(:N)) (\i. x$i pow k$i))`, REWRITE_TAC[GSYM lemma1] THEN REWRITE_TAC[REAL_POLYNOMIAL_FUNCTION_EXPLICIT_UNIV]) in let REAL_POLYNOMIAL_FUNCTION_EXPLICIT_NZ = prove (`!f:real^N->real. real_polynomial_function f <=> ?(s:num^N->bool) a. FINITE s /\ (!k. k IN s ==> ~(a k = &0)) /\ f = \x. sum s (\k. a(k) * product(1..dimindex(:N)) (\i. x$i pow k$i))`, REWRITE_TAC[GSYM lemma2] THEN REWRITE_TAC[REAL_POLYNOMIAL_FUNCTION_EXPLICIT_UNIV]) in REAL_POLYNOMIAL_FUNCTION_EXPLICIT, REAL_POLYNOMIAL_FUNCTION_EXPLICIT_NZ, REAL_POLYNOMIAL_FUNCTION_EXPLICIT_UNIV;; let REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION = prove (`!f x:real^N. real_polynomial_function f ==> f real_continuous at x`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC real_polynomial_function_INDUCT THEN SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_MUL; REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_AT_COMPONENT]);; let STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION = prove (`!f:real^N->real s e. compact s /\ (!x. x IN s ==> f real_continuous at x within s) /\ &0 < e ==> ?g. real_polynomial_function g /\ !x. x IN s ==> abs(f x - g x) < e`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] STONE_WEIERSTRASS) THEN ASM_REWRITE_TAC[real_polynomial_function_RULES] THEN SIMP_TAC[REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION; REAL_CONTINUOUS_AT_WITHIN] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CART_EQ] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x$i` THEN ASM_SIMP_TAC[real_polynomial_function_RULES]);; (* ------------------------------------------------------------------------- *) (* Stone-Weierstrass for real^M->real^N polynomials. *) (* ------------------------------------------------------------------------- *) let vector_polynomial_function = new_definition `vector_polynomial_function (f:real^M->real^N) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> real_polynomial_function(\x. f(x)$i)`;; let REAL_POLYNOMIAL_FUNCTION_DROP = prove (`!f. real_polynomial_function(drop o f) <=> vector_polynomial_function f`, REWRITE_TAC[vector_polynomial_function; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[o_DEF; drop]);; let VECTOR_POLYNOMIAL_FUNCTION_LIFT = prove (`!f. vector_polynomial_function(lift o f) <=> real_polynomial_function f`, REWRITE_TAC[GSYM REAL_POLYNOMIAL_FUNCTION_DROP; o_DEF; LIFT_DROP; ETA_AX]);; let VECTOR_POLYNOMIAL_FUNCTION_CONST = prove (`!c. vector_polynomial_function(\x. c)`, SIMP_TAC[vector_polynomial_function; real_polynomial_function_RULES]);; let VECTOR_POLYNOMIAL_FUNCTION_ID = prove (`vector_polynomial_function(\x. x)`, SIMP_TAC[vector_polynomial_function; real_polynomial_function_RULES]);; let VECTOR_POLYNOMIAL_FUNCTION_COMPONENT = prove (`!f:real^M->real^N i. 1 <= i /\ i <= dimindex(:N) /\ vector_polynomial_function f ==> vector_polynomial_function(\x. lift(f x$i))`, SIMP_TAC[vector_polynomial_function; FORALL_1; DIMINDEX_1; GSYM drop; LIFT_DROP]);; let VECTOR_POLYNOMIAL_FUNCTION_ADD = prove (`!f g:real^M->real^N. vector_polynomial_function f /\ vector_polynomial_function g ==> vector_polynomial_function (\x. f x + g x)`, REWRITE_TAC[vector_polynomial_function] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; real_polynomial_function_RULES]);; let VECTOR_POLYNOMIAL_FUNCTION_MUL = prove (`!f g:real^M->real^N. vector_polynomial_function(lift o f) /\ vector_polynomial_function g ==> vector_polynomial_function (\x. f x % g x)`, REWRITE_TAC[vector_polynomial_function; o_DEF; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[FORALL_1; DIMINDEX_1; GSYM drop; LIFT_DROP; ETA_AX] THEN SIMP_TAC[real_polynomial_function_RULES]);; let VECTOR_POLYNOMIAL_FUNCTION_CMUL = prove (`!f:real^M->real^N c. vector_polynomial_function f ==> vector_polynomial_function (\x. c % f x)`, SIMP_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; VECTOR_POLYNOMIAL_FUNCTION_MUL; ETA_AX; o_DEF]);; let VECTOR_POLYNOMIAL_FUNCTION_NEG = prove (`!f:real^M->real^N. vector_polynomial_function f ==> vector_polynomial_function (\x. --(f x))`, REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`] THEN REWRITE_TAC[VECTOR_POLYNOMIAL_FUNCTION_CMUL]);; let VECTOR_POLYNOMIAL_FUNCTION_SUB = prove (`!f g:real^M->real^N. vector_polynomial_function f /\ vector_polynomial_function g ==> vector_polynomial_function (\x. f x - g x)`, SIMP_TAC[VECTOR_SUB; VECTOR_POLYNOMIAL_FUNCTION_ADD; VECTOR_POLYNOMIAL_FUNCTION_NEG]);; let VECTOR_POLYNOMIAL_FUNCTION_VSUM = prove (`!f:real^M->A->real^N s. FINITE s /\ (!i. i IN s ==> vector_polynomial_function (\x. f x i)) ==> vector_polynomial_function (\x. vsum s (f x))`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; FORALL_IN_INSERT; VECTOR_POLYNOMIAL_FUNCTION_CONST; VECTOR_POLYNOMIAL_FUNCTION_ADD]);; let REAL_VECTOR_POLYNOMIAL_FUNCTION_o = prove (`!f:real^M->real^N g. vector_polynomial_function f /\ real_polynomial_function g ==> real_polynomial_function(g o f)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC real_polynomial_function_INDUCT THEN REWRITE_TAC[o_DEF; real_polynomial_function_RULES] THEN ASM_REWRITE_TAC[GSYM vector_polynomial_function]);; let VECTOR_POLYNOMIAL_FUNCTION_o = prove (`!f:real^M->real^N g:real^N->real^P. vector_polynomial_function f /\ vector_polynomial_function g ==> vector_polynomial_function(g o f)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_VECTOR_POLYNOMIAL_FUNCTION_o)) THEN SIMP_TAC[vector_polynomial_function; o_DEF]);; let REAL_POLYNOMIAL_FUNCTION_1 = prove (`!f. real_polynomial_function f <=> ?a n. f = \x. sum(0..n) (\i. a i * drop x pow i)`, REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC real_polynomial_function_INDUCT THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; FUN_EQ_THM] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`\i. if i = 1 then &1 else &0`; `1`] THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH_EQ; REAL_MUL_LZERO; drop] THEN SIMP_TAC[ARITH; SUM_SING_NUMSEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `c:real` THEN MAP_EVERY EXISTS_TAC [`(\i. c):num->real`; `0`] THEN REWRITE_TAC[SUM_SING_NUMSEG; real_pow] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num->real`; `m:num`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`b:num->real`; `n:num`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY EXISTS_TAC [`\i:num. (if i <= m then a i else &0) + (if i <= n then b i else &0)`; `MAX m n`] THEN GEN_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG] THEN REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN BINOP_TAC THEN BINOP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN ARITH_TAC; REWRITE_TAC[GSYM SUM_RMUL] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN EXISTS_TAC `\k. sum {x | x IN {i,j | i IN 0..m /\ j IN 0..n} /\ FST x + SND x = k} (\(i,j). a i * b j)` THEN EXISTS_TAC `m + n:num` THEN X_GEN_TAC `x:real^1` THEN MP_TAC(ISPECL [`\(i:num,j). i + j`; `\(i,j). (a i * drop x pow i) * (b j * drop x pow j)`; `{i,j | i IN 0..m /\ j IN 0..n}`; `0..m+n`] SUM_GROUP) THEN SIMP_TAC[FINITE_PRODUCT; FINITE_NUMSEG; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET; IN_NUMSEG; LE_0; LE_ADD2] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC(MESON[SUM_EQ] `s = t /\ (!x. x IN t ==> f x = g x) ==> sum s f = sum t g`) THEN SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN SIMP_TAC[IN_ELIM_PAIR_THM; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_POW_ADD] THEN REAL_ARITH_TAC]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM VECTOR_POLYNOMIAL_FUNCTION_LIFT] THEN SIMP_TAC[LIFT_SUM; o_DEF; FINITE_NUMSEG; FORALL_1; DIMINDEX_1] THEN MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; LIFT_CMUL] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_MUL THEN REWRITE_TAC[GSYM REAL_POLYNOMIAL_FUNCTION_DROP; o_DEF; LIFT_DROP] THEN REWRITE_TAC[real_polynomial_function_RULES] THEN SPEC_TAC(`i:num`,`k:num`) THEN REWRITE_TAC[drop] THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_polynomial_function_RULES; real_pow; DIMINDEX_1; ARITH]]);; let CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION = prove (`!f:real^M->real^N x. vector_polynomial_function f ==> f continuous at x`, REWRITE_TAC[vector_polynomial_function; CONTINUOUS_COMPONENTWISE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION THEN ASM_SIMP_TAC[]);; let CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION = prove (`!f:real^M->real^N s. vector_polynomial_function f ==> f continuous_on s`, SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION]);; let HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION = prove (`!p:real^1->real^N. vector_polynomial_function p ==> ?p'. vector_polynomial_function p' /\ !x. (p has_vector_derivative p'(x)) (at x)`, let lemma = prove (`!p:real^1->real. real_polynomial_function p ==> ?p'. real_polynomial_function p' /\ !x. ((p o lift) has_real_derivative (p'(lift x))) (atreal x)`, MATCH_MP_TAC (derive_strong_induction(real_polynomial_function_RULES, real_polynomial_function_INDUCT)) THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; o_DEF; GSYM drop; LIFT_DROP] THEN CONJ_TAC THENL [EXISTS_TAC `\x:real^1. &1` THEN REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ID]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^1. &0` THEN REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_CONST]; ALL_TAC] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `f':real^1->real` STRIP_ASSUME_TAC)) (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `g':real^1->real` STRIP_ASSUME_TAC))) THENL [EXISTS_TAC `\x. (f':real^1->real) x + g' x`; EXISTS_TAC `\x. (f:real^1->real) x * g' x + f' x * g x`] THEN ASM_SIMP_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ADD; HAS_REAL_DERIVATIVE_MUL_ATREAL]) in GEN_TAC THEN REWRITE_TAC[vector_polynomial_function] THEN DISCH_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?q. real_polynomial_function q /\ (!x. ((\x. lift(((p x):real^N)$i)) has_vector_derivative lift(q x)) (at x))` MP_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN REWRITE_TAC[HAS_REAL_VECTOR_DERIVATIVE_AT] THEN REWRITE_TAC[o_DEF; LIFT_DROP; FORALL_DROP]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:num->real^1->real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. (q:num->real^1->real) i x):real^1->real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA; ETA_AX] THEN REWRITE_TAC[has_vector_derivative; has_derivative_at] THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE] THEN X_GEN_TAC `x:real^1` THEN SIMP_TAC[LINEAR_VMUL_DROP; LINEAR_ID] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN REWRITE_TAC[has_vector_derivative; has_derivative_at] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA; REAL_TENDSTO] THEN SIMP_TAC[DROP_ADD; DROP_VEC; LIFT_DROP; DROP_CMUL; DROP_SUB; o_DEF]]);; let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION = prove (`!f:real^M->real^N s e. compact s /\ f continuous_on s /\ &0 < e ==> ?g. vector_polynomial_function g /\ !x. x IN s ==> norm(f x - g x) < e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN REWRITE_TAC[CONTINUOUS_COMPONENTWISE] THEN REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?g. real_polynomial_function g /\ !x. x IN s ==> abs((f:real^M->real^N) x$i - g x) < e / &(dimindex(:N))` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:num->real^M->real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. g i x):real^M->real^N` THEN ASM_SIMP_TAC[vector_polynomial_function; LAMBDA_BETA; ETA_AX] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY; NOT_LT] THEN ASM_SIMP_TAC[IN_NUMSEG; DIMINDEX_GE_1; LAMBDA_BETA; VECTOR_SUB_COMPONENT]]);; let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE = prove (`!f:real^M->real^N s e t. compact s /\ f continuous_on s /\ &0 < e /\ subspace t /\ IMAGE f s SUBSET t ==> ?g. vector_polynomial_function g /\ IMAGE g s SUBSET t /\ !x. x IN s ==> norm(f x - g x) < e`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_BASIS_SUBSPACE) THEN DISCH_THEN(X_CHOOSE_THEN `bas:real^N->bool` MP_TAC) THEN ASM_CASES_TAC `FINITE(bas:real^N->bool)` THENL [ALL_TAC; ASM_MESON_TAC[HAS_SIZE]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ABBREV_TAC `n = CARD(bas:real^N->bool)` THEN REWRITE_TAC[INJECTIVE_ON_ALT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN ASM_SIMP_TAC[REWRITE_RULE[INJECTIVE_ON_ALT] HAS_SIZE_IMAGE_INJ_EQ] THEN REWRITE_TAC[HAS_SIZE; FINITE_NUMSEG; CARD_NUMSEG_1] THEN ASM_CASES_TAC `dim(t:real^N->bool) = n` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` DIM_SUBSET_UNIV) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(\x. lambda i. (f x:real^N) dot (b i)):real^M->real^N`; `s:real^M->bool`; `e:real`] STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST]; DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `(\x. vsum(1..n) (\i. (g x:real^N)$i % b i)):real^M->real^N` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_MUL THEN REWRITE_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; o_DEF] THEN MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_COMPONENT THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_VSUM THEN ASM_SIMP_TAC[SUBSPACE_MUL; FINITE_NUMSEG]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN SUBGOAL_THEN `vsum(IMAGE b (1..n)) (\v. (v dot f x) % v) = (f:real^M->real^N) x` (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THENL [MATCH_MP_TAC ORTHONORMAL_BASIS_EXPAND THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM SET_TAC[]; ASM_SIMP_TAC[REWRITE_RULE[INJECTIVE_ON_ALT] VSUM_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM VSUM_SUB_NUMSEG; o_DEF; GSYM VECTOR_SUB_RDISTRIB] THEN REWRITE_TAC[NORM_LE; GSYM NORM_POW_2] THEN W(MP_TAC o PART_MATCH (lhs o rand) NORM_VSUM_PYTHAGOREAN o lhand o snd) THEN RULE_ASSUM_TAC(REWRITE_RULE[PAIRWISE_IMAGE]) THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise; ORTHOGONAL_MUL; FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_MUL] THEN REWRITE_TAC[NORM_POW_2] THEN GEN_REWRITE_TAC RAND_CONV [dot] THEN SIMP_TAC[GSYM REAL_POW_2; VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[FINITE_NUMSEG; REAL_LE_POW_2] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[UNWIND_THM2] THEN ONCE_REWRITE_TAC[TAUT `p ==> q /\ r <=> p ==> q /\ (q ==> r)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN ASM_SIMP_TAC[LAMBDA_BETA; UNWIND_THM2; IN_NUMSEG] THEN REWRITE_TAC[REAL_MUL_RID; REAL_POW2_ABS; REAL_LE_REFL] THEN ASM_ARITH_TAC]]);; let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_AFFINE = prove (`!f:real^M->real^N s e t. compact s /\ f continuous_on s /\ &0 < e /\ affine t /\ IMAGE f s SUBSET t ==> ?g. vector_polynomial_function g /\ IMAGE g s SUBSET t /\ !x. x IN s ==> norm(f x - g x) < e`, REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY] THENL [MESON_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; NOT_IN_EMPTY]; STRIP_TAC] THEN MP_TAC(ISPEC `t:real^N->bool` AFFINE_TRANSLATION_SUBSPACE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MP_TAC(ISPECL [`(\x. f x - a):real^M->real^N`; `s:real^M->bool`; `e:real`; `u:real^N->bool`] STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST] THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. x - a` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(\x. g x + a):real^M->real^N` THEN ASM_SIMP_TAC[VECTOR_POLYNOMIAL_FUNCTION_ADD; VECTOR_POLYNOMIAL_FUNCTION_CONST; VECTOR_ARITH `a - (b + c):real^N = a - c - b`] THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. a + x` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_AC]);; (* ------------------------------------------------------------------------- *) (* One application is to pick a smooth approximation to a path, or just pick *) (* a smooth path anyway in an open connected set. *) (* ------------------------------------------------------------------------- *) let PATH_VECTOR_POLYNOMIAL_FUNCTION = prove (`!g:real^1->real^N. vector_polynomial_function g ==> path g`, SIMP_TAC[path; CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION]);; let RECTIFIABLE_PATH_VECTOR_POLYNOMIAL_FUNCTION = prove (`!p:real^1->real^N. vector_polynomial_function p ==> rectifiable_path p`, SIMP_TAC[rectifiable_path; PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN REWRITE_TAC[vector_polynomial_function] THEN ONCE_REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN SPEC_TAC(`\x. (p:real^1->real^N) x$i`,`p:real^1->real`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC real_polynomial_function_INDUCT THEN REWRITE_TAC[o_DEF; DIMINDEX_1; FORALL_1; LIFT_ADD] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_CONST; GSYM drop; LIFT_DROP] THEN SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ID; BOUNDED_INTERVAL] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_ADD] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] (ONCE_REWRITE_RULE[CONJ_ASSOC] HAS_BOUNDED_VARIATION_ON_MUL))) THEN REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN REWRITE_TAC[LIFT_CMUL; LIFT_DROP; DROP_CMUL]);; let PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION = prove (`!g:real^1->real^N e. path g /\ &0 < e ==> ?p. vector_polynomial_function p /\ pathstart p = pathstart g /\ pathfinish p = pathfinish g /\ !t. t IN interval[vec 0,vec 1] ==> norm(p t - g t) < e`, REWRITE_TAC[path] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^1->real^N`; `interval[vec 0:real^1,vec 1]`; `e / &4`] STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[COMPACT_INTERVAL; REAL_ARITH `&0 < x / &4 <=> &0 < x`] THEN DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\t. (q:real^1->real^N)(t) + (g(vec 0:real^1) - q(vec 0)) + drop t % ((g(vec 1) - q(vec 1)) - (g(vec 0) - q(vec 0)))` THEN REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN REPEAT CONJ_TAC THENL [SIMP_TAC[vector_polynomial_function; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN REPEAT STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[vector_polynomial_function]) THEN MATCH_MP_TAC(el 2 (CONJUNCTS real_polynomial_function_RULES)) THEN ASM_SIMP_TAC[real_polynomial_function_RULES; drop; DIMINDEX_1; ARITH]; VECTOR_ARITH_TAC; VECTOR_ARITH_TAC; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN MATCH_MP_TAC(NORM_ARITH `norm(x - a) < e / &4 /\ norm b < e / &4 /\ norm c <= &1 * e / &4 /\ norm d <= &1 * e / &4 ==> norm((a + b + c - d) - x:real^N) < e`) THEN ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; NORM_POS_LE] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN ASM_REAL_ARITH_TAC]);; let CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED = prove (`!s:real^N->bool. open s /\ connected s ==> !x y. x IN s /\ y IN s ==> ?g. vector_polynomial_function g /\ path_image g SUBSET s /\ pathstart g = x /\ pathfinish g = y`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_OPEN_PATH_CONNECTED]; REWRITE_TAC[path_connected]] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?e. &0 < e /\ !x. x IN path_image p ==> ball(x:real^N,e) SUBSET s` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `s = (:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN EXISTS_TAC `setdist(path_image p,(:real^N) DIFF s)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN ASM_SIMP_TAC[PATH_IMAGE_NONEMPTY] THEN ASM SET_TAC[]; X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `w:real^N` THEN REWRITE_TAC[IN_BALL; GSYM REAL_NOT_LE] THEN MATCH_MP_TAC(SET_RULE `(w IN (UNIV DIFF s) ==> p) ==> (~p ==> w IN s)`) THEN ASM_SIMP_TAC[SETDIST_LE_DIST]]; MP_TAC(ISPECL [`p:real^1->real^N`; `e:real`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN RULE_ASSUM_TAC (REWRITE_RULE[SUBSET; path_image; FORALL_IN_IMAGE;IN_BALL; dist]) THEN ASM_MESON_TAC[NORM_SUB]]);; (* ------------------------------------------------------------------------- *) (* Lipschitz property for real and vector polynomials. *) (* ------------------------------------------------------------------------- *) let LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION = prove (`!f:real^N->real s. real_polynomial_function f /\ bounded s ==> ?B. &0 < B /\ !x y. x IN s /\ y IN s ==> abs(f x - f y) <= B * norm(x - y)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN ASM_CASES_TAC `bounded(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MATCH_MP_TAC real_polynomial_function_INDUCT THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM_SIMP_TAC[REAL_MUL_LID; GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM]; GEN_TAC THEN EXISTS_TAC `&1` THEN SIMP_TAC[REAL_LT_01; REAL_SUB_REFL; REAL_ABS_NUM; REAL_MUL_LID; NORM_POS_LE]; ALL_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC)) THENL [EXISTS_TAC `B1 + B2:real` THEN ASM_SIMP_TAC[REAL_LT_ADD] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(f - f') <= B1 * n /\ abs(g - g') <= B2 * n ==> abs((f + g) - (f' + g')) <= (B1 + B2) * n`) THEN ASM_SIMP_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `B1 * (abs(g(a:real^N)) + B2 * &2 * B) + B2 * (abs(f a) + B1 * &2 * B)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < abs a + x`) THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `abs((f - f') * g) <= a * n /\ abs((g - g') * f') <= b * n ==> abs(f * g - f' * g') <= (a + b) * n`) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN REWRITE_TAC[REAL_ABS_MUL] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `abs(g x - g a) <= C * norm(x - a) /\ C * norm(x - a:real^N) <= C * B ==> abs(g x) <= abs(g a) + C * B`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC(NORM_ARITH `norm x <= B /\ norm a <= B ==> norm(x - a:real^N) <= &2 * B`) THEN ASM_SIMP_TAC[]]]);; let LIPSCHITZ_VECTOR_POLYNOMIAL_FUNCTION = prove (`!f:real^M->real^N s. vector_polynomial_function f /\ bounded s ==> ?B. &0 < B /\ !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)`, REWRITE_TAC[vector_polynomial_function] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?b. !i. 1 <= i /\ i <= dimindex(:N) ==> &0 < (b:real^N)$i /\ !x y. x IN s /\ y IN s ==> abs((f:real^M->real^N) x$i - f y$i) <= b$i * norm(x - y)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION THEN ASM_SIMP_TAC[LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION]; EXISTS_TAC `&1 + sum(1..dimindex(:N)) (\i. (b:real^N)$i)` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM SUM_RMUL; REAL_MUL_LID] THEN MATCH_MP_TAC(NORM_ARITH `x <= y ==> x <= norm(a:real^N) + y`) THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT]]]);; (* ------------------------------------------------------------------------- *) (* Differentiability of real and vector polynomial functions. *) (* ------------------------------------------------------------------------- *) let DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT = prove (`!f:real^N->real a. real_polynomial_function f ==> (lift o f) differentiable (at a)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC real_polynomial_function_INDUCT THEN REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL] THEN REWRITE_TAC[DIFFERENTIABLE_LIFT_COMPONENT; DIFFERENTIABLE_CONST] THEN SIMP_TAC[DIFFERENTIABLE_ADD] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_MUL_AT THEN ASM_REWRITE_TAC[o_DEF]);; let DIFFERENTIABLE_ON_REAL_POLYNOMIAL_FUNCTION = prove (`!f:real^N->real s. real_polynomial_function f ==> (lift o f) differentiable_on s`, SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT]);; let DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION = prove (`!f:real^M->real^N a. vector_polynomial_function f ==> f differentiable (at a)`, REWRITE_TAC[vector_polynomial_function] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DIFFERENTIABLE_COMPONENTWISE_AT] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT THEN ASM_SIMP_TAC[]);; let DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION = prove (`!f:real^M->real^N s. vector_polynomial_function f ==> f differentiable_on s`, SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION]);; (* ------------------------------------------------------------------------- *) (* Some basic properties of affine real algebraic varieties. *) (* ------------------------------------------------------------------------- *) let CLOSED_ALGEBRAIC_VARIETY = prove (`!f c. real_polynomial_function f ==> closed {x | f x = c}`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ] THEN ONCE_REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING] THEN GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION THEN REWRITE_TAC[GSYM REAL_POLYNOMIAL_FUNCTION_DROP; o_DEF; LIFT_DROP] THEN ASM_REWRITE_TAC[ETA_AX]);; let NEGLIGIBLE_ALGEBRAIC_VARIETY = prove (`!f c. real_polynomial_function f /\ ~(!x. f x = c) ==> negligible {x | f x = c}`, let lemma0 = prove (`negligible {x | INFINITE {a | P a x}} ==> negligible {x | ~negligible {lift a | P a x}}`, MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; INFINITE; CONTRAPOS_THM] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[NEGLIGIBLE_FINITE; FINITE_IMAGE]) in let lemma1 = prove (`!n s a. n <= dimindex(:N) /\ FINITE s /\ ~(!x:real^N. sum s (\k. a(k) * product(1..n) (\i. x$i pow (k i))) = &0) ==> negligible {x:real^N | sum s (\k. a(k) * product(1..n) (\i. x$i pow (k i))) = &0}`, INDUCT_TAC THENL [REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH] THEN SIMP_TAC[SET_RULE `{x | P} = if P then UNIV else {}`; NEGLIGIBLE_EMPTY]; MAP_EVERY X_GEN_TAC [`s:(num->num)->bool`; `a:(num->num)->real`] THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))] THEN SUBGOAL_THEN `closed {x:real^N | sum s (\k. a(k) * product (1..SUC n) (\i. x$i pow (k i))) = &0}` MP_TAC THENL [MATCH_MP_TAC CLOSED_ALGEBRAIC_VARIETY THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_SUM THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_MUL THEN REWRITE_TAC[real_polynomial_function_RULES] THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_PRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_POW THEN MATCH_MP_TAC(CONJUNCT1 real_polynomial_function_RULES) THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN MP_TAC(ISPECL [`\k. (k: num->num) (SUC n)`; `s:(num->num)->bool`] UPPER_BOUND_FINITE_SET) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN MP_TAC(GEN `g:(num->num)->real` (ISPECL [`\k. (k: num->num) (SUC n)`; `g:(num->num)->real`; `s:(num->num)->bool`; `0..m`] SUM_GROUP)) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG; LE_0] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN SIMP_TAC[IN_ELIM_THM] THEN REWRITE_TAC[REAL_MUL_ASSOC; SUM_RMUL] THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_CLOSED) THEN DISCH_THEN(MP_TAC o SPEC `SUC n` o MATCH_MP FUBINI_NEGLIGIBLE_REPLACEMENTS_ALT) THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `SUC n <= dimindex(:N) /\ !i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; ARITH_RULE `1 <= SUC n`] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC lemma0 THEN SIMP_TAC[ARITH_RULE `i <= n ==> ~(i = SUC n)`] THEN REWRITE_TAC[SUM_RMUL; REAL_MUL_ASSOC] THEN REWRITE_TAC[INFINITE; REAL_POLYFUN_FINITE_ROOTS] THEN REWRITE_TAC[MESON[] `~(?y. y IN s /\ ~P y) <=> !i. i IN s ==> P i`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] SUM_EQ_0)) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_NUMSEG; LE_0] THEN DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN SIMP_TAC[IN_ELIM_THM] THEN REWRITE_TAC[REAL_MUL_ASSOC; SUM_RMUL] THEN REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_SUBSET] `!k:num. {x | !i:num. i <= m ==> P i x} SUBSET {x | P k x} /\ negligible {x | P k x} ==> negligible {x:real^N | !i:num. i <= m ==> P i x}`) THEN EXISTS_TAC `j:num` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ASM_MESON_TAC[]]) in let lemma2 = prove (`!f:real^N->real. real_polynomial_function f /\ ~(!x. f x = &0) ==> negligible {x | f x = &0}`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[REAL_POLYNOMIAL_FUNCTION_EXPLICIT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:num^N->bool`; `a:num^N->real`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN MP_TAC(ISPECL [`dimindex(:N)`; `IMAGE (\x:num^N i. x$i) s`; `(a:num^N->real) o (\k. lambda i. k i)`] lemma1) THEN ASM_SIMP_TAC[FINITE_IMAGE; LE_REFL] THEN SIMP_TAC[SUM_IMAGE; FUN_EQ_THM; CART_EQ] THEN REWRITE_TAC[o_DEF; LAMBDA_ETA]) in ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_SUB THEN ASM_REWRITE_TAC[real_polynomial_function_RULES]);; let EMPTY_INTERIOR_ALGEBRAIC_VARIETY = prove (`!f c. real_polynomial_function f /\ ~(!x. f x = c) ==> interior {x:real^N | f(x) = c} = {}`, SIMP_TAC[NEGLIGIBLE_ALGEBRAIC_VARIETY; NEGLIGIBLE_EMPTY_INTERIOR]);; let NOWHERE_DENSE_ALGEBRAIC_VARIETY = prove (`!f c. real_polynomial_function f /\ ~(!x. f x = c) ==> interior(closure {x:real^N | f(x) = c}) = {}`, MESON_TAC[EMPTY_INTERIOR_ALGEBRAIC_VARIETY; CLOSURE_EQ; CLOSED_ALGEBRAIC_VARIETY]);; (* ------------------------------------------------------------------------- *) (* Bernoulli polynomials, defined recursively. We don't explicitly introduce *) (* a definition for Bernoulli numbers, but use "bernoulli n (&0)" for that. *) (* ------------------------------------------------------------------------- *) let bernoulli = define `(!x. bernoulli 0 x = &1) /\ (!n x. bernoulli (n + 1) x = x pow (n + 1) - sum(0..n) (\k. &(binom(n+2,k)) * bernoulli k x) / (&n + &2))`;; let BERNOULLI_CONV = let btm = `bernoulli` in let rec bernoullis n = if n < 0 then [] else if n = 0 then [CONJUNCT1 bernoulli] else let ths = bernoullis (n - 1) in let th1 = SPEC(mk_small_numeral (n - 1)) (CONJUNCT2 bernoulli) in let th2 = CONV_RULE(BINDER_CONV (COMB2_CONV (RAND_CONV(LAND_CONV NUM_ADD_CONV)) (RAND_CONV(LAND_CONV EXPAND_SUM_CONV) THENC NUM_REDUCE_CONV THENC ONCE_DEPTH_CONV NUM_BINOM_CONV THENC REWRITE_CONV ths THENC REAL_POLY_CONV))) th1 in th2::ths in fun tm -> match tm with Comb(Comb(b,n),x) when b = btm -> let th = hd(bernoullis(dest_small_numeral n)) in (REWR_CONV th THENC REAL_POLY_CONV) tm | _ -> failwith "BERNOULLI_CONV";; let BERNOULLI,BERNOULLI_EXPANSION = (CONJ_PAIR o prove) (`(!n x. sum(0..n) (\k. &(binom(n,k)) * bernoulli k x) - bernoulli n x = &n * x pow (n - 1)) /\ (!n x. bernoulli n x = sum(0..n) (\k. &(binom(n,k)) * bernoulli k (&0) * x pow (n - k)))`, let lemma = prove (`(!n x. sum (0..n) (\k. &(binom(n,k)) * B k x) - B n x = &n * x pow (n - 1)) <=> (!x. B 0 x = &1) /\ (!n x. B (n + 1) x = x pow (n + 1) - sum(0..n) (\k. &(binom(n+2,k)) * B k x) / (&n + &2))`, let cth = MESON[num_CASES] `(!n. P n) <=> P 0 /\ (!n. P(SUC n))` in GEN_REWRITE_TAC LAND_CONV [cth] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [cth] THEN SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; BINOM_REFL; BINOM_PENULT; SUC_SUB1] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; REAL_SUB_REFL] THEN SIMP_TAC[ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`; GSYM REAL_OF_NUM_ADD] THEN BINOP_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC REAL_FIELD) in REWRITE_TAC[lemma; bernoulli] THEN SUBGOAL_THEN `!n x. sum(0..n) (\k. &(binom(n,k)) * sum (0..k) (\l. &(binom(k,l)) * bernoulli l (&0) * x pow (k - l))) - sum(0..n) (\k. &(binom(n,k)) * bernoulli k (&0) * x pow (n - k)) = &n * x pow (n - 1)` MP_TAC THENL [REPEAT GEN_TAC THEN MP_TAC(ISPECL [`\n. bernoulli n (&0)`; `n:num`; `x:real`; `&1`] APPELL_SEQUENCE) THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x + &1 = &1 + x`] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM APPELL_SEQUENCE] THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID; GSYM SUM_SUB_NUMSEG] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN REWRITE_TAC[REWRITE_RULE[GSYM lemma] bernoulli] THEN REWRITE_TAC[REAL_POW_ZERO; COND_RAND; COND_RATOR] THEN REWRITE_TAC[ARITH_RULE `i - 1 = 0 <=> i = 0 \/ i = 1`] THEN REWRITE_TAC[MESON[] `(if p \/ q then x else y) = if q then x else if p then x else y`] THEN SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; COND_ID; SUM_DELTA] THEN REWRITE_TAC[IN_NUMSEG; LE_0; BINOM_1] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN ASM_SIMP_TAC[LE_1] THEN REAL_ARITH_TAC; REWRITE_TAC[lemma] THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[ADD1; bernoulli; ARITH_RULE `m < n + 1 <=> m <= n`]]);; let BERNOULLI_ALT = prove (`!n x. sum(0..n) (\k. &(binom(n+1,k)) * bernoulli k x) = (&n + &1) * x pow n`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`SUC n`; `x:real`] BERNOULLI) THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; SUC_SUB1; BINOM_REFL] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC);; let BERNOULLI_ADD = prove (`!n x y. bernoulli n (x + y) = sum(0..n) (\k. &(binom(n,k)) * bernoulli k x * y pow (n - k))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[BERNOULLI_EXPANSION] THEN REWRITE_TAC[APPELL_SEQUENCE]);; let bernoulli_number = prove (`bernoulli 0 (&0) = &1 /\ (!n. bernoulli (n + 1) (&0) = --sum(0..n) (\k. &(binom(n+2,k)) * bernoulli k (&0)) / (&n + &2))`, REWRITE_TAC[bernoulli; REAL_POW_ADD] THEN REAL_ARITH_TAC);; let BERNOULLI_NUMBER = prove (`!n. sum (0..n) (\k. &(binom (n,k)) * bernoulli k (&0)) - bernoulli n (&0) = if n = 1 then &1 else &0`, REWRITE_TAC[BERNOULLI] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH; REAL_MUL_LZERO] THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ARITH_RULE `SUC n = 1 <=> n = 0`] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[real_pow; REAL_MUL_LID] THEN REWRITE_TAC[NOT_SUC; REAL_MUL_LZERO; REAL_MUL_RZERO]);; let BERNOULLI_NUMBER_ALT = prove (`!n. sum(0..n) (\k. &(binom(n+1,k)) * bernoulli k (&0)) = if n = 0 then &1 else &0`, REWRITE_TAC[BERNOULLI_ALT] THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; NOT_SUC] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID]);; let BERNOULLI_SUB_ADD1 = prove (`!n x. bernoulli n (x + &1) - bernoulli n x = &n * x pow (n - 1)`, REWRITE_TAC[BERNOULLI_ADD; REAL_POW_ONE; REAL_MUL_RID] THEN REWRITE_TAC[BERNOULLI]);; let BERNOULLI_1 = prove (`!n. bernoulli n (&1) = if n = 1 then bernoulli n (&0) + &1 else bernoulli n (&0)`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ADD_LID] THEN COND_CASES_TAC THENL [REWRITE_TAC[REAL_ARITH `x = y + &1 <=> x - y = &1`]; ONCE_REWRITE_TAC[GSYM REAL_SUB_0]] THEN REWRITE_TAC[BERNOULLI_SUB_ADD1; REAL_POW_ZERO] THEN ASM_REWRITE_TAC[SUB_REFL; REAL_MUL_RID] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC);; let SUM_OF_POWERS = prove (`!m n. sum(0..n) (\k. &k pow m) = (bernoulli (m + 1) (&n + &1) - bernoulli (m + 1) (&0)) / (&m + &1)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV o RAND_CONV) [GSYM SUC_SUB1] THEN REWRITE_TAC[REAL_FIELD `x = y / (&m + &1) <=> (&m + &1) * x = y`] THEN REWRITE_TAC[GSYM SUM_LMUL; REAL_OF_NUM_SUC; GSYM BERNOULLI_SUB_ADD1] THEN REWRITE_TAC[ADD1; SUM_DIFFS_ALT; LE_0]);; let HAS_REAL_DERIVATIVE_BERNOULLI = prove (`!n x. ((bernoulli n) has_real_derivative (&n * bernoulli (n - 1) x)) (atreal x)`, INDUCT_TAC THEN GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN ONCE_REWRITE_TAC[BERNOULLI_EXPANSION] THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; SUB_REFL; CONJUNCT1 real_pow] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_CONST; REAL_MUL_LZERO; LE_0] THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_CONST; SUC_SUB1; GSYM SUM_LMUL] THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[ADD1; BINOM_TOP_STEP_REAL] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUB; ARITH_RULE `k <= n ==> ~(k = n + 1) /\ (n + 1) - k - 1 = n - k /\ k <= n + 1`] THEN UNDISCH_TAC `k:num <= n` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD);; add_real_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV (SPEC `n:num` HAS_REAL_DERIVATIVE_BERNOULLI))));; let REAL_DIFFERENTIABLE_ON_BERNOULLI = prove (`!n s. (bernoulli n) real_differentiable_on s`, REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; real_differentiable] THEN MESON_TAC[HAS_REAL_DERIVATIVE_BERNOULLI; HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; let REAL_CONTINUOUS_ON_BERNOULLI = prove (`!n s. (bernoulli n) real_continuous_on s`, MESON_TAC[REAL_DIFFERENTIABLE_ON_BERNOULLI; REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON]);; let HAS_REAL_INTEGRAL_BERNOULLI = prove (`!n. ((bernoulli n) has_real_integral (if n = 0 then &1 else &0)) (real_interval[&0,&1])`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`\x. bernoulli (n + 1) x / (&n + &1)`; `bernoulli n`; `&0`; `&1`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN REWRITE_TAC[REAL_POS] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[ADD_SUB; GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD; REWRITE_TAC[BERNOULLI_1; ARITH_RULE `n + 1 = 1 <=> n = 0`] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN REWRITE_TAC[REAL_ADD_LID; ADD_CLAUSES; REAL_DIV_1; REAL_ADD_SUB]]);; let POLYNOMIAL_FUNCTION_BERNOULLI = prove (`!n. polynomial_function(bernoulli n)`, GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN ONCE_REWRITE_TAC[BERNOULLI_EXPANSION] THEN MATCH_MP_TAC POLYNOMIAL_FUNCTION_SUM THEN SIMP_TAC[FINITE_NUMSEG; POLYNOMIAL_FUNCTION_MUL; POLYNOMIAL_FUNCTION_POW; POLYNOMIAL_FUNCTION_ID; POLYNOMIAL_FUNCTION_CONST]);; let BERNOULLI_UNIQUE = prove (`!p n. polynomial_function p /\ (!x. p(x + &1) - p(x) = &n * x pow (n - 1)) /\ (real_integral (real_interval[&0,&1]) p = if n = 0 then &1 else &0) ==> p = bernoulli n`, REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN MP_TAC(SPECL [`\x. p x - bernoulli n x`; `p(&0) - bernoulli n (&0)`] POLYNOMIAL_FUNCTION_FINITE_ROOTS) THEN ASM_SIMP_TAC[POLYNOMIAL_FUNCTION_SUB; POLYNOMIAL_FUNCTION_BERNOULLI; ETA_AX] THEN MATCH_MP_TAC(TAUT `~p /\ (q ==> r) ==> (p <=> ~q) ==> r`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM INFINITE] THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `IMAGE (&) (:num)` THEN SIMP_TAC[INFINITE_IMAGE_INJ; REAL_OF_NUM_EQ; num_INFINITE; SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN CONV_TAC(BINDER_CONV SYM_CONV) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_MESON_TAC[BERNOULLI_SUB_ADD1; REAL_ARITH `p - b:real = p' - b' <=> p' - p = b' - b`]; DISCH_TAC THEN X_GEN_TAC `x:real` THEN ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN EXISTS_TAC `\x. p x - bernoulli n x` THEN EXISTS_TAC `real_interval[&0,&1]` THEN CONJ_TAC THENL [GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `x = x * (&1 - &0)`] THEN ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN REWRITE_TAC[REAL_POS]; GEN_REWRITE_TAC LAND_CONV [GSYM(SPEC `if n = 0 then &1 else &0` REAL_SUB_REFL)] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN REWRITE_TAC[ETA_AX; HAS_REAL_INTEGRAL_BERNOULLI] THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN ASM_SIMP_TAC[REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION]]]);; let BERNOULLI_RAABE_2 = prove (`!n x. bernoulli n ((x + &1) / &2) + bernoulli n (x / &2) = &2 / &2 pow n * bernoulli n x`, GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[bernoulli] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[REAL_LT_POW2; REAL_FIELD `&0 < p ==> (x = &2 / p * y <=> p / &2 * x = y)`] THEN GEN_REWRITE_TAC I [GSYM FUN_EQ_THM] THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC BERNOULLI_UNIQUE THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC POLYNOMIAL_FUNCTION_LMUL THEN MATCH_MP_TAC POLYNOMIAL_FUNCTION_ADD THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] POLYNOMIAL_FUNCTION_o) THEN REWRITE_TAC[POLYNOMIAL_FUNCTION_BERNOULLI; real_div] THEN SIMP_TAC[POLYNOMIAL_FUNCTION_ADD; POLYNOMIAL_FUNCTION_CONST; POLYNOMIAL_FUNCTION_ID; POLYNOMIAL_FUNCTION_RMUL]; REWRITE_TAC[REAL_ARITH `((x + &1) + &1) / &2 = x / &2 + &1`] THEN REWRITE_TAC[REAL_ARITH `a * (x + y) - a * (y + z):real = a * (x - z)`] THEN REWRITE_TAC[BERNOULLI_SUB_ADD1; REAL_POW_DIV] THEN GEN_TAC THEN REWRITE_TAC[REAL_ARITH `a / b * c * d / e:real = c * (a / b / e) * d`] THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC(REAL_RING `b = &1 ==> a * b * c = a * c`) THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_DIV_REFL THEN REWRITE_TAC[REAL_POW_EQ_0] THEN REAL_ARITH_TAC; SUBGOAL_THEN `(bernoulli n) real_integrable_on real_interval[&0,&1 / &2] /\ (bernoulli n) real_integrable_on real_interval[&1 / &2,&1]` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN SIMP_TAC[REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION; POLYNOMIAL_FUNCTION_BERNOULLI]; DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY) o MATCH_MP REAL_INTEGRABLE_INTEGRAL))] THEN REWRITE_TAC[REAL_ARITH `m * (x - c):real = m * x + m * --c`] THEN REWRITE_TAC[IMAGE_AFFINITY_REAL_INTERVAL; IMP_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPECL [`inv(&2)`; `inv(&2)`]) (MP_TAC o SPECL [`inv(&2)`; `&0`])) THEN REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_ADD) THEN DISCH_THEN(MP_TAC o SPEC `&2 pow n / &2` o MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN REWRITE_TAC[REAL_ARITH `&1 / &2 * x + &1 / &2 = (x + &1) / &2`; REAL_ARITH `&1 / &2 * x + &0 = x / &2`] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH `&2 * x + &2 * y = &0 <=> y + x = &0`] THEN IMP_REWRITE_TAC[REAL_INTEGRAL_COMBINE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_BERNOULLI]]);; let BERNOULLI_HALF = prove (`!n. bernoulli n (&1 / &2) = (&2 / &2 pow n - &1) * bernoulli n (&0)`, GEN_TAC THEN MP_TAC(ISPECL [`n:num`; `&1`] BERNOULLI_RAABE_2) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `a + b:real = c * a <=> b = (c - &1) * a`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[BERNOULLI_1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let BERNOULLI_REFLECT = prove (`!n x. bernoulli n (&1 - x) = --(&1) pow n * bernoulli n x`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN SUBGOAL_THEN `!n. sum(0..n) (\k. &(binom(n + 1,k)) * (bernoulli k (&1 - x) - --(&1) pow k * bernoulli k x)) = &0` ASSUME_TAC THENL [REWRITE_TAC[SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_SUB_0; BERNOULLI_ALT] THEN TRANS_TAC EQ_TRANS `--(&1) pow n * (bernoulli (n + 1) x - bernoulli (n + 1) (x - &1))` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`n + 1`; `x - &1`] BERNOULLI_SUB_ADD1) THEN REWRITE_TAC[REAL_ARITH `x - a + a:real = x`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ADD_SUB; REAL_ARITH `&1 - x = --(&1) * (x - &1)`] THEN REWRITE_TAC[REAL_POW_MUL; REAL_MUL_AC; GSYM REAL_OF_NUM_ADD]; MATCH_MP_TAC(REAL_FIELD `z pow 2 = &1 /\ z * x = y ==> z * y = x`) THEN REWRITE_TAC[REAL_POW_POW] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POW_NEG; EVEN_MULT; ARITH; REAL_POW_ONE]; REWRITE_TAC[GSYM SUM_LMUL]] THEN MP_TAC(ISPECL [`SUC n`; `x:real`; `--(&1)`] BERNOULLI_ADD) THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; BINOM_REFL; SUB_REFL] THEN REWRITE_TAC[GSYM real_sub; ADD1; REAL_MUL_LID; CONJUNCT1 real_pow] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `--s' = s ==> s = b - (s' + b * &1)`) THEN REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_RING `--(&1) pow 1 * p = q * r ==> --(b * k * p) = q * b * r * k`) THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN REWRITE_TAC[REAL_POW_NEG] THEN REWRITE_TAC[EVEN_ADD; EVEN_SUB; REAL_POW_ONE; ARITH] THEN ASM_SIMP_TAC[ARITH_RULE `k <= n ==> ~(n + 1 <= k)`] THEN REWRITE_TAC[TAUT `~(~p <=> q) <=> (p <=> q)`]]; MATCH_MP_TAC num_WF THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[bernoulli; CONJUNCT1 real_pow; REAL_MUL_LID] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[LT_SUC_LE] THEN DISCH_THEN (fun th -> FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN ASSUME_TAC th) THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; REAL_ADD_LID] THEN REWRITE_TAC[GSYM ADD1; BINOM_PENULT; GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[REAL_ENTIRE; REAL_SUB_0] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; let BERNOULLI_1_0 = prove (`!n. bernoulli n (&1) = --(&1) pow n * bernoulli n (&0)`, GEN_TAC THEN SUBST1_TAC(REAL_ARITH `&0 = &1 - &1`) THEN REWRITE_TAC[BERNOULLI_REFLECT; REAL_MUL_ASSOC; GSYM REAL_POW_MUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID]);; let BERNOULLI_NUMBER_ZERO = prove (`!n. ODD n /\ ~(n = 1) ==> bernoulli n (&0) = &0`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `n:num` BERNOULLI_1) THEN MP_TAC(SPEC `n:num` BERNOULLI_1_0) THEN ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE; GSYM NOT_ODD] THEN REAL_ARITH_TAC);; let BERNOULLI_EVEN_BOUND = prove (`!n x. EVEN n /\ x IN real_interval[&0,&1] ==> abs(bernoulli n x) <= abs(bernoulli n (&0))`, let lemma = prove (`(!n x. x IN real_interval(&0,&1 / &2) ==> ~(bernoulli (2 * n + 1) x = &0)) /\ (!n x y. x IN real_interval(&0,&1 / &2) /\ y IN real_interval(&0,&1 / &2) /\ bernoulli (2 * n) x = &0 /\ bernoulli (2 * n) y = &0 ==> x = y)`, REWRITE_TAC[AND_FORALL_THM; IN_REAL_INTERVAL] THEN INDUCT_TAC THENL [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV BERNOULLI_CONV) THEN REAL_ARITH_TAC; POP_ASSUM MP_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI; EQ_SYM_EQ]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. bernoulli (2 * SUC n) x / (&2 * &n + &2)`; `bernoulli (2 * n + 1)`; `x:real`; `y:real`] REAL_ROLLE_SIMPLE) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_SUC; ARITH_RULE `2 * SUC n - 1 = 2 * n + 1`] THEN CONV_TAC REAL_FIELD; REWRITE_TAC[IN_REAL_INTERVAL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x. bernoulli (2 * SUC n + 1) x / (&2 * &n + &3)`; `bernoulli (2 * SUC n)`; `&0`; `x:real`] REAL_ROLLE_SIMPLE) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ENTIRE] THEN DISJ1_TAC THEN MATCH_MP_TAC BERNOULLI_NUMBER_ZERO THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ADD1; ARITH] THEN ARITH_TAC; REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN SIMP_TAC[ADD_SUB; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; ADD1] THEN CONV_TAC REAL_FIELD; REWRITE_TAC[IN_REAL_INTERVAL; NOT_EXISTS_THM] THEN X_GEN_TAC `u:real` THEN STRIP_TAC] THEN MP_TAC(ISPECL [`\x. bernoulli (2 * SUC n + 1) x / (&2 * &n + &3)`; `bernoulli (2 * SUC n)`; `x:real`; `&1 / &2`] REAL_ROLLE_SIMPLE) THEN ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[BERNOULLI_HALF] THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN MATCH_MP_TAC BERNOULLI_NUMBER_ZERO THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ADD1; ARITH] THEN ARITH_TAC; REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN SIMP_TAC[ADD_SUB; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; ADD1] THEN CONV_TAC REAL_FIELD; REWRITE_TAC[IN_REAL_INTERVAL; NOT_EXISTS_THM] THEN X_GEN_TAC `v:real` THEN STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real`; `v:real`]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) in REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[bernoulli; REAL_LE_REFL] THEN MP_TAC(ISPECL [`\x. abs(bernoulli n x)`; `real_interval[&0,&1]`] REAL_CONTINUOUS_ATTAINS_SUP) THEN REWRITE_TAC[REAL_COMPACT_INTERVAL; REAL_INTERVAL_NE_EMPTY; REAL_POS] THEN ANTS_TAC THENL [MATCH_MP_TAC REAL_CONTINUOUS_ON_ABS THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC)] THEN ASM_CASES_TAC `z = &0` THEN ASM_SIMP_TAC[] THEN ASM_CASES_TAC `z = &1` THEN ASM_REWRITE_TAC[BERNOULLI_1_0] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID] THEN STRIP_TAC THEN MP_TAC(ISPECL [`bernoulli n`; `&n * bernoulli (n - 1) z`; `z:real`; `real_interval(&0,&1)`] REAL_DERIVATIVE_ZERO_MAXMIN) THEN REWRITE_TAC[REAL_OPEN_REAL_INTERVAL; IN_REAL_INTERVAL] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[HAS_REAL_DERIVATIVE_BERNOULLI] THEN ASM_CASES_TAC `&0 <= bernoulli n z` THENL [DISJ1_TAC; DISJ2_TAC] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_ENTIRE; REAL_OF_NUM_EQ] THEN DISCH_TAC THEN ASM_CASES_TAC `z = &1 / &2` THENL [MATCH_MP_TAC(REAL_ARITH `!z. x <= z /\ z <= &1 * y ==> x <= y`) THEN EXISTS_TAC `abs(bernoulli n (&1 / &2))` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[BERNOULLI_HALF; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 ==> abs(x - &1) <= &1`) THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_POS] THEN MATCH_MP_TAC(REAL_ARITH `&2 pow 1 <= x ==> &2 <= x`) THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 < z /\ z < &1 / &2 \/ &1 / &2 < z /\ z < &1` STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`(n - 2) DIV 2`; `z:real`] (CONJUNCT1 lemma)) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL]; MP_TAC(ISPECL [`(n - 2) DIV 2`; `&1 - z`] (CONJUNCT1 lemma)) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[BERNOULLI_REFLECT]] THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN SUBGOAL_THEN `2 * (n - 2) DIV 2 + 1 = n - 1` (fun th -> ASM_REWRITE_TAC[th]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN UNDISCH_TAC `~(2 * m = 0)` THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_SUB2] THEN SIMP_TAC[DIV_MULT; ARITH_EQ] THEN ARITH_TAC);; let BERNOULLI_NUMBER_EQ_0 = prove (`!n. bernoulli n (&0) = &0 <=> ODD n /\ ~(n = 1)`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BERNOULLI_NUMBER_ZERO] THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[BERNOULLI_CONV `bernoulli 1 (&0)`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_TAC THEN DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`n:num`; `\k. &(binom(n,n - k)) * bernoulli (n - k) (&0)`] REAL_POLYFUN_FINITE_ROOTS) THEN MATCH_MP_TAC(TAUT `q /\ ~p ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [EXISTS_TAC `n:num` THEN SIMP_TAC[IN_NUMSEG; LE_0; LE_REFL; SUB_REFL] THEN REWRITE_TAC[binom; REAL_MUL_RID; bernoulli] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM INFINITE] THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `real_interval[&0,&1]` THEN REWRITE_TAC[real_interval; INFINITE; FINITE_REAL_INTERVAL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`n:num`; `x:real`] BERNOULLI_EVEN_BOUND) THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL; REAL_ARITH `abs x <= abs(&0) <=> x = &0`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN GEN_REWRITE_TAC RAND_CONV [BERNOULLI_EXPANSION] THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN REPEAT(EXISTS_TAC `\k:num. n - k`) THEN SIMP_TAC[IN_NUMSEG; ARITH_RULE `k:num <= n ==> n - (n - k) = k`] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* This is a simple though sub-optimal bound (we can actually get *) (* |B_{2n+1}(x)| <= (2n + 1) / (2 pi) * |B_{2n}(0)| with more work). *) (* ------------------------------------------------------------------------- *) let BERNOULLI_BOUND = prove (`!n x. x IN real_interval[&0,&1] ==> abs(bernoulli n x) <= max (&n / &2) (&1) * abs(bernoulli (2 * n DIV 2) (&0))`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS])] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THENL [REWRITE_TAC[ARITH_RULE `(2 * m) DIV 2 = m`] THEN MATCH_MP_TAC(REAL_ARITH `&1 * y <= max x (&1) * y /\ a <= y ==> a <= max x (&1) * y`) THEN SIMP_TAC[REAL_LE_RMUL; REAL_ABS_POS; REAL_ARITH `y <= max x y`] THEN MATCH_MP_TAC BERNOULLI_EVEN_BOUND THEN ASM_REWRITE_TAC[EVEN_MULT; ARITH]; POP_ASSUM MP_TAC THEN SPEC_TAC(`x:real`,`x:real`) THEN MATCH_MP_TAC(MESON[] `!Q. ((!x. P x /\ Q x ==> R x) ==> (!x. P x ==> R x)) /\ (!x. P x /\ Q x ==> R x) ==> !x. P x ==> R x`) THEN EXISTS_TAC `\x. x IN real_interval[&0,&1 / &2]` THEN CONJ_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `x <= &1 / &2` THEN ASM_SIMP_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `&1 - x`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[BERNOULLI_REFLECT; REAL_ABS_MUL; REAL_ABS_POW] THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_MUL_LID; REAL_POW_ONE]; REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[ARITH_RULE `SUC(2 * m) DIV 2 = m`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[ADD1; REAL_ARITH `(x + &1) + &1 = x + &2`] THEN ASM_CASES_TAC `m = 0` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN CONV_TAC(ONCE_DEPTH_CONV BERNOULLI_CONV) THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`\x. bernoulli (2 * m + 1) x / &(2 * m + 1)`; `bernoulli (2 * m)`; `&0`; `x:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[BERNOULLI_NUMBER_ZERO; ODD_ADD; ODD_MULT; ARITH; ARITH_RULE `2 * m + 1 = 1 <=> m = 0`] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN CONV_TAC REAL_FIELD; DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_FIELD `i = b / (&2 * &m + &1) - &0 / (&2 * &m + &1) <=> b = (&2 * &m + &1) * i`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[real_max; REAL_ARITH `(x + &1) / &2 <= &1 <=> x <= &1`; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN ASM_REWRITE_TAC[ARITH_RULE `2 * m <= 1 <=> m = 0`] THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_div; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ARITH `abs(&2 * &n + &1) = &2 * &n + &1`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `real_integral (real_interval [&0,x]) (\x. abs(bernoulli (2 * m) (&0)))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN SIMP_TAC[REAL_INTEGRABLE_CONST; REAL_INTEGRABLE_CONTINUOUS; REAL_CONTINUOUS_ON_BERNOULLI] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BERNOULLI_EVEN_BOUND THEN REWRITE_TAC[EVEN_MULT; ARITH; IN_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN REWRITE_TAC[REAL_ARITH `a * (x - &0) = x * a`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN ASM_REAL_ARITH_TAC]]]]]);; (* ------------------------------------------------------------------------- *) (* Absolutely integrable functions remain so modified by Bernolli sawtooth. *) (* ------------------------------------------------------------------------- *) let ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC = prove (`!f:real^1->real^N s n. f absolutely_integrable_on s ==> (\x. bernoulli n (frac(drop x)) % f x) absolutely_integrable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\x y:real^N. drop(x) % y`; `\x:real^1. lift(bernoulli n (frac (drop x)))`; `\x. if x IN s then (f:real^1->real^N) x else vec 0`; `(:real^1)`] ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN ASM_REWRITE_TAC[LIFT_DROP; BILINEAR_DROP_MUL] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VECTOR_MUL_RZERO] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `(\x. lift(bernoulli n (frac (drop x)))) = (lift o bernoulli n o drop) o (lift o frac o drop)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `IMAGE lift integer` THEN SIMP_TAC[LEBESGUE_MEASURABLE_UNIV; NEGLIGIBLE_COUNTABLE; COUNTABLE_IMAGE; COUNTABLE_INTEGER] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REWRITE_TAC[FORALL_LIFT; IN_DIFF; IN_UNIV; LIFT_IN_IMAGE_LIFT] THEN REWRITE_TAC[IN] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN REWRITE_TAC[REAL_CONTINUOUS_FRAC]; MP_TAC(SPECL [`n:num`; `(:real)`] REAL_CONTINUOUS_ON_BERNOULLI) THEN REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV]]; REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV; NORM_LIFT] THEN SUBGOAL_THEN `real_compact (IMAGE (bernoulli n) (real_interval[&0,&1]))` MP_TAC THENL [MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[REAL_CONTINUOUS_ON_BERNOULLI; REAL_COMPACT_INTERVAL]; DISCH_THEN(MP_TAC o MATCH_MP REAL_COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN MESON_TAC[FLOOR_FRAC; REAL_LT_IMP_LE]]]);; (* ------------------------------------------------------------------------- *) (* The Euler-Maclaurin summation formula for real and complex functions. *) (* ------------------------------------------------------------------------- *) let REAL_EULER_MACLAURIN = prove (`!f m n p. m <= n /\ (!k x. k <= 2 * p + 1 /\ x IN real_interval[&m,&n] ==> ((f k) has_real_derivative f (k + 1) x) (atreal x within real_interval [&m,&n])) ==> (\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 1) x) real_integrable_on real_interval[&m,&n] /\ sum(m..n) (\i. f 0 (&i)) = real_integral (real_interval [&m,&n]) (f 0) + (f 0 (&m) + f 0 (&n)) / &2 + sum (1..p) (\k. bernoulli (2 * k) (&0) / &(FACT(2 * k)) * (f (2 * k - 1) (&n) - f (2 * k - 1) (&m))) + real_integral (real_interval [&m,&n]) (\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 1) x) / &(FACT(2 * p + 1))`, let lemma = prove (`!f k m n. f real_continuous_on real_interval[&m,&n] /\ m < n ==> ((\x. bernoulli k (frac x) * f x) has_real_integral sum(m..n-1) (\j. real_integral (real_interval[&j,&j + &1]) (\x. bernoulli k (x - &j) * f x))) (real_interval[&m,&n])`, REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; LT_SUC_LE; SUC_SUB1] THEN STRIP_TAC THEN ASM_CASES_TAC `m:num = n` THENL [ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN (**** one ***) ALL_TAC; SUBGOAL_THEN `0 < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CLAUSES_RIGHT] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_ARITH `x <= x + &1`] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LT_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_ARITH `x <= x + &1`; LE_REFL]; ALL_TAC]] THEN MATCH_MP_TAC(MESON[REAL_INTEGRAL_SPIKE; HAS_REAL_INTEGRAL_INTEGRAL; REAL_INTEGRABLE_SPIKE] `!t. g real_integrable_on s /\ real_negligible t /\ (!x. x IN s DIFF t ==> f x = g x) ==> (f has_real_integral (real_integral s g)) s`) THEN EXISTS_TAC `{&n + &1}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM FRAC_UNIQUE] THEN REWRITE_TAC[REAL_ARITH `x - (x - &n) = &n`; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC])) in let step = prove (`!f f' k m n. m < n /\ (!x. x IN real_interval[&m,&n] ==> (f has_real_derivative f' x) (atreal x within real_interval[&m,&n])) /\ f' real_continuous_on real_interval[&m,&n] ==> real_integral (real_interval[&m,&n]) (\x. bernoulli (k + 1) (frac x) * f' x) = (bernoulli (k + 1) (&0) * (f(&n) - f(&m)) + (if k = 0 then sum(m+1..n) (\i. f(&i)) else &0)) - (&k + &1) * real_integral (real_interval[&m,&n]) (\x. bernoulli k (frac x) * f x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `f real_continuous_on real_interval[&m,&n]` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; real_differentiable; REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON]; ASM_SIMP_TAC[REWRITE_RULE[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] lemma]] THEN TRANS_TAC EQ_TRANS `sum(m..n-1) (\j. (bernoulli (k + 1) (&0) * (f (&j + &1) - f (&j)) + (if k = 0 then f (&j + &1) else &0)) - (&k + &1) * real_integral (real_interval[&j,&j + &1]) (\x. bernoulli k (x - &j) * f x))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_INTEGRATION_BY_PARTS_SIMPLE) THEN MAP_EVERY EXISTS_TAC [`f:real->real`; `\x. (&k + &1) * bernoulli k (x - &j)`] THEN REWRITE_TAC[REAL_ADD_SUB; REAL_SUB_REFL; BERNOULLI_1] THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; X_GEN_TAC `x:real` THEN DISCH_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HAS_REAL_DERIVATIVE_WITHIN_SUBSET)] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; ADD_SUB] THEN REAL_ARITH_TAC]; REWRITE_TAC[ARITH_RULE `k + 1 = 1 <=> k = 0`] THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[REAL_ARITH `(b + &1) * f1 - b * f0 - ((b * (f1 - f0) + f1) - w):real = w`]; REWRITE_TAC[REAL_ARITH `b * f1 - b * f0 - ((b * (f1 - f0) + &0) - w) = w`]] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC])]; REWRITE_TAC[SUM_ADD_NUMSEG; SUM_LMUL; SUM_SUB_NUMSEG] THEN AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN REWRITE_TAC[REAL_OF_NUM_ADD; SUM_DIFFS_ALT] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC; ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[SUM_0] THEN REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET); REAL_OF_NUM_ADD] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC]]) in REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `m:num <= n ==> m = n \/ m < n`)) THENL [ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_LE_REFL] THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG; REAL_SUB_REFL; REAL_MUL_LZERO] THEN SIMP_TAC[REAL_INTEGRAL_NULL; REAL_LE_REFL; REAL_ARITH `(x + x) / &2 = x`; REAL_MUL_RZERO; SUM_0; real_div; REAL_MUL_LZERO] THEN REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[real_integrable_on] THEN MP_TAC(ISPECL [`f (2 * p + 1):real->real`; `2 * p + 1`; `m:num`; `n:num`] lemma) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN REWRITE_TAC[real_differentiable] THEN ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LT_IMP_LE] THEN SUBGOAL_THEN `!k:num. k <= 2 * p + 1 ==> (f k) real_differentiable_on real_interval[&m,&n]` ASSUME_TAC THENL [ASM_MESON_TAC[real_differentiable_on]; ALL_TAC] THEN MP_TAC(ISPECL [`(f:num->real->real) 0`; `(f:num->real->real) (0 + 1)`; `0`; `m:num`; `n:num`] step) THEN ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; ARITH_RULE `0 + 1 <= 2 * p + 1`; LE_0] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 bernoulli] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID; ETA_AX] THEN REWRITE_TAC[BERNOULLI_CONV `bernoulli 1 (&0)`] THEN MATCH_MP_TAC(REAL_ARITH `i' = r ==> i' = (-- &1 / &2 * (n - m) + s) - i ==> m + s = i + (m + n) / &2 + r`) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ARITH_RULE `2 * SUC p + 1 = 2 * p + 3`] THEN FIRST_X_ASSUM(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[ARITH_RULE `k <= 2 * p + 1 ==> k <= 2 * p + 3`] THEN DISCH_TAC] THEN ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN AP_TERM_TAC THEN MP_TAC(ISPECL [`(f:num->real->real) (2 * p + 1)`; `(f:num->real->real) ((2 * p + 1) + 1)`; `2 * p + 1`; `m:num`; `n:num`] step) THEN ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; ARITH_RULE `(2 * p + 1) + 1 <= 2 * p + 3`; ARITH_RULE `2 * p + 1 <= 2 * p + 3`] THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_ADD_RID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_FIELD `x = y - ((&2 * &p + &1) + &1) * z <=> z = (y - x) / (&2 * &p + &2)`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `2 * SUC p - 1 = 2 * p + 1`] THEN REWRITE_TAC[ARITH_RULE `(2 * p + 1) + 1 = 2 * SUC p`] THEN REWRITE_TAC[ARITH_RULE `2 * SUC p = SUC(2 * p + 1)`] THEN REWRITE_TAC[ARITH_RULE `SUC(2 * p + 1) + 1 = SUC(SUC(2 * p + 1))`] THEN REWRITE_TAC[FACT; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC(REAL_FIELD `~(t = &0) /\ i2 = &0 - (&2 * &p + &3) * i1 ==> (b * (fn - fm) - i1) / (&2 * &p + &2) / t = b / (((&2 * &p + &1) + &1) * t) * (fn - fm) + i2 / ((((&2 * &p + &1) + &1) + &1) * ((&2 * &p + &1) + &1) * t)`) THEN REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ] THEN MP_TAC(ISPECL [`(f:num->real->real) (SUC(2 * p + 1))`; `(f:num->real->real) (SUC(2 * p + 1) + 1)`; `SUC(2 * p + 1)`; `m:num`; `n:num`] step) THEN ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; NOT_SUC; ARITH_RULE `SUC(2 * p + 1) + 1 <= 2 * p + 3`; ARITH_RULE `SUC(2 * p + 1) <= 2 * p + 3`] THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC; REAL_OF_NUM_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_RID; GSYM REAL_OF_NUM_MUL] THEN DISCH_THEN SUBST1_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN REWRITE_TAC[BERNOULLI_NUMBER_EQ_0] THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ARITH_TAC);; let REAL_EULER_MACLAURIN_ANTIDERIVATIVE = prove (`!f m n p. m <= n /\ (!k x. k <= 2 * p + 2 /\ x IN real_interval[&m,&n] ==> ((f k) has_real_derivative f (k + 1) x) (atreal x within real_interval [&m,&n])) ==> ((\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 2) x) real_integrable_on real_interval[&m,&n]) /\ sum(m..n) (\i. f 1 (&i)) = (f 0 (&n) - f 0 (&m)) + (f 1 (&m) + f 1 (&n)) / &2 + sum (1..p) (\k. bernoulli (2 * k) (&0) / &(FACT(2 * k)) * (f (2 * k) (&n) - f (2 * k) (&m))) + real_integral (real_interval [&m,&n]) (\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 2) x) / &(FACT(2 * p + 1))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n. (f:num->real->real)(SUC n)`; `m:num`; `n:num`; `p:num`] REAL_EULER_MACLAURIN) THEN ASM_SIMP_TAC[ARITH_RULE `k <= 2 * p + 1 ==> SUC k <= 2 * p + 2`; ARITH_RULE `SUC(k + 1) = SUC k + 1`; ARITH_RULE `SUC(2 * p) + 1 = 2 * p + 2`] THEN CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN MP_TAC(ISPECL [`f 0:real->real`; `f (0 + 1):real->real`; `&m`; `&n`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_0] THEN CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[ARITH_RULE `SUC(2 * p) + 1 = 2 * p + 2`] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[ARITH_RULE `1 <= k ==> SUC(2 * k - 1) = 2 * k`]);; let COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE = prove (`!f m n p. m <= n /\ (!k x. k <= 2 * p + 2 /\ &m <= x /\ x <= &n ==> ((f k) has_complex_derivative f (k + 1) (Cx x)) (at(Cx x))) ==> (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * f (2 * p + 2) (Cx(drop x))) integrable_on interval[lift(&m),lift(&n)] /\ vsum(m..n) (\i. f 1 (Cx(&i))) = (f 0 (Cx(&n)) - f 0 (Cx(&m))) + (f 1 (Cx(&m)) + f 1 (Cx(&n))) / Cx(&2) + vsum (1..p) (\k. Cx(bernoulli (2 * k) (&0) / &(FACT(2 * k))) * (f (2 * k) (Cx(&n)) - f (2 * k) (Cx(&m)))) + integral (interval[lift(&m),lift(&n)]) (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * f (2 * p + 2) (Cx(drop x))) / Cx(&(FACT(2 * p + 1)))`, let lemma_re,lemma_im = (CONJ_PAIR o prove) (`((f has_complex_derivative f') (at (Cx x)) ==> ((Re o f o Cx) has_real_derivative (Re f')) (atreal x)) /\ ((f has_complex_derivative f') (at (Cx x)) ==> ((Im o f o Cx) has_real_derivative (Im f')) (atreal x))`, REPEAT GEN_TAC THEN CONJ_TAC THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT; HAS_REAL_DERIVATIVE_ATREAL] THEN REWRITE_TAC[LIM_AT; REALLIM_ATREAL; o_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx y`) THEN ASM_REWRITE_TAC[DIST_CX; dist] THEN REWRITE_TAC[GSYM RE_SUB; GSYM IM_SUB; CX_SUB; GSYM RE_DIV_CX; GSYM IM_SUB; GSYM IM_DIV_CX] THEN MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]) and ilemma = prove (`f integrable_on interval[lift a,lift b] ==> Re(integral (interval[lift a,lift b]) f) = real_integral (real_interval[a,b]) (\x. Re(f(lift x))) /\ Im(integral (interval[lift a,lift b]) f) = real_integral (real_interval[a,b]) (\x. Im(f(lift x)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN ASM_SIMP_TAC[INTEGRAL_COMPONENT] THEN IMP_REWRITE_TAC[REAL_INTEGRAL] THEN REWRITE_TAC[o_DEF; IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN REWRITE_TAC[REAL_INTEGRABLE_ON] THEN REWRITE_TAC[o_DEF; IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[DIMINDEX_2; ARITH]) in REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_EQ] THEN MAP_EVERY (MP_TAC o C SPEC REAL_EULER_MACLAURIN_ANTIDERIVATIVE) [`\n:num. (Im o f n o Cx)`; `\n:num. (Re o f n o Cx)`] THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`; `p:num`]) THEN ASM_SIMP_TAC[lemma_re; lemma_im; HAS_REAL_DERIVATIVE_ATREAL_WITHIN; o_THM; IN_REAL_INTERVAL] THEN SIMP_TAC[RE_VSUM; IM_VSUM; FINITE_NUMSEG] THEN DISCH_THEN(CONJUNCTS_THEN(ASSUME_TAC o CONJUNCT1)) THEN SIMP_TAC[RE_DIV_CX; IM_DIV_CX; RE_VSUM; IM_VSUM; FINITE_NUMSEG; RE_ADD; RE_SUB;IM_ADD; IM_SUB; RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN REWRITE_TAC[DIMINDEX_2; FORALL_2; GSYM RE_DEF; GSYM IM_DEF] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX] THEN ASM_REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM REAL_INTEGRABLE_ON); GSYM IMAGE_LIFT_REAL_INTERVAL]; SIMP_TAC[ilemma] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; LIFT_DROP]]);; (* ------------------------------------------------------------------------- *) (* Specific properties of complex measurable functions. *) (* ------------------------------------------------------------------------- *) let MEASURABLE_ON_COMPLEX_MUL = prove (`!f g:real^N->complex s. f measurable_on s /\ g measurable_on s ==> (\x. f x * g x) measurable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let MEASURABLE_ON_COMPLEX_INV = prove (`!f:real^N->real^2. f measurable_on (:real^N) /\ negligible {x | f x = Cx(&0)} ==> (\x. inv(f x)) measurable_on (:real^N)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[measurable_on; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `g:num->real^N->complex`] THEN STRIP_TAC THEN EXISTS_TAC `k UNION {x:real^N | f x = Cx(&0)}` THEN ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN SUBGOAL_THEN `!n. ?h. h continuous_on (:real^N) /\ !x. x IN {x | g n x IN (:complex) DIFF ball(Cx(&0),inv(&n + &1))} ==> (h:real^N->complex) x = inv(g n x)` MP_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN CONJ_TAC THENL [REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; ETA_AX] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_INV_AT THEN CONJ_TAC THENL [REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; IN_UNIV; IN_DIFF]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_BALL]) THEN SIMP_TAC[CONTRAPOS_THM; DIST_REFL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]]; REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:num->real^N->complex` THEN REWRITE_TAC[FORALL_AND_THM; IN_ELIM_THM; IN_DIFF; IN_UNION; IN_UNIV] THEN REWRITE_TAC[IN_BALL; DE_MORGAN_THM; REAL_NOT_LT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\n. inv((g:num->real^N->complex) n x)` THEN ASM_SIMP_TAC[o_DEF; LIM_COMPLEX_INV] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN SUBGOAL_THEN `&0 < norm((f:real^N->complex) x)` ASSUME_TAC THENL [ASM_REWRITE_TAC[COMPLEX_NORM_NZ]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `norm((f:real^N->complex) x) / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "*")) THEN MP_TAC(SPEC `norm((f:real^N->complex) x) / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N1 + N2 + 1` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; DIST_0] THEN REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH `dist(g,f) < norm(f) / &2 ==> norm(f) / &2 <= norm g`)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < y ==> z <= x ==> z <= y`)) THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; let MEASURABLE_ON_COMPLEX_DIV = prove (`!f g:real^N->complex s. f measurable_on s /\ g measurable_on (:real^N) /\ negligible {x | g(x) = Cx(&0)} ==> (\x. f(x) / g(x)) measurable_on s`, let lemma = prove (`!f g:real^N->complex. f measurable_on (:real^N) /\ g measurable_on (:real^N) /\ negligible {x | g(x) = Cx(&0)} ==> (\x. f(x) / g(x)) measurable_on (:real^N)`, REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div] THEN ASM_SIMP_TAC[MEASURABLE_ON_COMPLEX_MUL; MEASURABLE_ON_COMPLEX_INV]) in REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[IN_UNIV; ETA_AX] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; complex_div; COMPLEX_VEC_0] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]);; let MEASURABLE_ON_CPRODUCT = prove (`!f:A->real^N->complex s t. FINITE t /\ (t = {} ==> lebesgue_measurable s) /\ (!i. i IN t ==> f i measurable_on s) ==> (\x. cproduct t (\i. f i x)) measurable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CPRODUCT_CLAUSES; MEASURABLE_ON_CONST_EQ] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_INSERT_EMPTY] THEN MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN REWRITE_TAC[IMP_IMP] THEN STRIP_TAC THEN ASM_CASES_TAC `k:A->bool = {}` THEN ASM_SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_MUL_RID; ETA_AX] THEN MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[ETA_AX] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Measurable real->real functions. *) (* ------------------------------------------------------------------------- *) parse_as_infix("real_measurable_on",(12,"right"));; let real_measurable_on = new_definition `f real_measurable_on s <=> (lift o f o drop) measurable_on (IMAGE lift s)`;; let real_lebesgue_measurable = new_definition `real_lebesgue_measurable s <=> (\x. if x IN s then &1 else &0) real_measurable_on (:real)`;; let REAL_MEASURABLE_ON_UNIV = prove (`(\x. if x IN s then f(x) else &0) real_measurable_on (:real) <=> f real_measurable_on s`, REWRITE_TAC[real_measurable_on; o_DEF; IMAGE_LIFT_UNIV] THEN SIMP_TAC[COND_RAND; LIFT_NUM; MEASURABLE_ON_UNIV; GSYM IN_IMAGE_LIFT_DROP]);; let REAL_LEBESGUE_MEASURABLE = prove (`!s. real_lebesgue_measurable s <=> lebesgue_measurable (IMAGE lift s)`, REWRITE_TAC[real_lebesgue_measurable; lebesgue_measurable; COND_RAND; COND_RAND; real_measurable_on; indicator; IMAGE_LIFT_UNIV; o_DEF] THEN REWRITE_TAC[LIFT_NUM; IN_IMAGE_LIFT_DROP]);; let REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE = prove (`!f g s. f real_measurable_on s /\ g real_integrable_on s /\ (!x. x IN s ==> abs(f x) <= g x) ==> f real_integrable_on s`, REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);; let REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE = prove (`!f g s k. f real_measurable_on s /\ g real_integrable_on s /\ real_negligible k /\ (!x. x IN s DIFF k ==> abs(f x) <= g x) ==> f real_integrable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. if x IN k then abs(f x) else (g:real->real) x` THEN ASM_SIMP_TAC[COND_RAND; IN_DIFF; LIFT_DROP; REAL_LE_REFL; COND_ID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN MAP_EVERY EXISTS_TAC [`g:real->real`; `k:real->bool`] THEN ASM_SIMP_TAC[IN_DIFF]);; let REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove (`!f g s. f real_measurable_on s /\ g real_integrable_on s /\ (!x. x IN s ==> abs(f x) <= g x) ==> f absolutely_real_integrable_on s`, REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; ABSOLUTELY_REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);; let INTEGRABLE_SUBINTERVALS_IMP_REAL_MEASURABLE = prove (`!f. (!a b. f real_integrable_on real_interval[a,b]) ==> f real_measurable_on (:real)`, REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN ASM_REWRITE_TAC[FORALL_LIFT]);; let INTEGRABLE_IMP_REAL_MEASURABLE = prove (`!f:real->real s. f real_integrable_on s ==> f real_measurable_on s`, REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON] THEN REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE]);; let ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE = prove (`!f s. f absolutely_real_integrable_on s <=> f real_measurable_on s /\ (\x. abs(f x)) real_integrable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_real_integrable_on] THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (b /\ c ==> a) ==> (a /\ c <=> b /\ c)`) THEN REWRITE_TAC[INTEGRABLE_IMP_REAL_MEASURABLE] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC `\x. abs((f:real->real) x)` THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS = prove (`!f g. f real_measurable_on (:real) /\ g real_continuous_on (:real) ==> (g o f) real_measurable_on (:real)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; real_measurable_on] THEN REWRITE_TAC[IMAGE_LIFT_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0 = prove (`!f:real->real g:real->real s. f real_measurable_on s /\ g real_continuous_on (:real) /\ g(&0) = &0 ==> (g o f) real_measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_MESON_TAC[]);; let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL = prove (`!f:real->real g:real->real a b. f real_measurable_on (:real) /\ (!x. f(x) IN real_interval(a,b)) /\ g real_continuous_on real_interval(a,b) ==> (g o f) real_measurable_on (:real)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; `lift a`; `lift b`] MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL) THEN REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON] THEN REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP] THEN ASM SET_TAC[]);; let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET = prove (`!f:real->real g:real->real s. real_closed s /\ f real_measurable_on (:real) /\ (!x. f(x) IN s) /\ g real_continuous_on s ==> (g o f) real_measurable_on (:real)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; `IMAGE lift s`] MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET) THEN REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON; REAL_CLOSED] THEN REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP] THEN ASM SET_TAC[]);; let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0 = prove (`!f:real->real g:real->real s t. real_closed s /\ f real_measurable_on t /\ (!x. f(x) IN s) /\ g real_continuous_on s /\ &0 IN s /\ g(&0) = &0 ==> (g o f) real_measurable_on t`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; `IMAGE lift s`; `IMAGE lift t`] MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0) THEN REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON; REAL_CLOSED] THEN REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN ASM_SIMP_TAC[FUN_IN_IMAGE; LIFT_DROP; GSYM LIFT_NUM]);; let CONTINUOUS_IMP_REAL_MEASURABLE_ON = prove (`!f. f real_continuous_on (:real) ==> f real_measurable_on (:real)`, REWRITE_TAC[REAL_CONTINUOUS_ON; real_measurable_on] THEN REWRITE_TAC[CONTINUOUS_IMP_MEASURABLE_ON; IMAGE_LIFT_UNIV]);; let REAL_MEASURABLE_ON_CONST = prove (`!k:real. (\x. k) real_measurable_on (:real)`, SIMP_TAC[real_measurable_on; o_DEF; MEASURABLE_ON_CONST; IMAGE_LIFT_UNIV]);; let REAL_MEASURABLE_ON_0 = prove (`!s. (\x. &0) real_measurable_on s`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN REWRITE_TAC[REAL_MEASURABLE_ON_CONST; COND_ID]);; let REAL_MEASURABLE_ON_LMUL = prove (`!c f s. f real_measurable_on s ==> (\x. c * f x) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP MEASURABLE_ON_CMUL) THEN REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);; let REAL_MEASURABLE_ON_RMUL = prove (`!c f s. f real_measurable_on s ==> (\x. f x * c) real_measurable_on s`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MEASURABLE_ON_LMUL]);; let REAL_MEASURABLE_ON_NEG = prove (`!f s. f real_measurable_on s ==> (\x. --(f x)) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN REWRITE_TAC[o_DEF; LIFT_NEG; LIFT_DROP]);; let REAL_MEASURABLE_ON_NEG_EQ = prove (`!f s. (\x. --(f x)) real_measurable_on s <=> f real_measurable_on s`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_NEG) THEN REWRITE_TAC[REAL_NEG_NEG; ETA_AX]);; let REAL_MEASURABLE_ON_ABS = prove (`!f s. f real_measurable_on s ==> (\x. abs(f x)) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NORM) THEN REWRITE_TAC[o_DEF; NORM_LIFT]);; let REAL_MEASURABLE_ON_ADD = prove (`!f g s. f real_measurable_on s /\ g real_measurable_on s ==> (\x. f x + g x) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_ADD) THEN REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_DROP]);; let REAL_MEASURABLE_ON_SUB = prove (`!f g s. f real_measurable_on s /\ g real_measurable_on s ==> (\x. f x - g x) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP]);; let REAL_MEASURABLE_ON_MAX = prove (`!f g s. f real_measurable_on s /\ g real_measurable_on s ==> (\x. max (f x) (g x)) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MAX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; o_THM; CART_EQ; LAMBDA_BETA; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[GSYM drop; LIFT_DROP]);; let REAL_MEASURABLE_ON_MIN = prove (`!f g s. f real_measurable_on s /\ g real_measurable_on s ==> (\x. min (f x) (g x)) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MIN) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; o_THM; CART_EQ; LAMBDA_BETA; DIMINDEX_1; FORALL_1] THEN REWRITE_TAC[GSYM drop; LIFT_DROP]);; let REAL_MEASURABLE_ON_MUL = prove (`!f g s. f real_measurable_on s /\ g real_measurable_on s ==> (\x. f x * g x) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);; let REAL_MEASURABLE_ON_SPIKE_SET = prove (`!f:real->real s t. real_negligible (s DIFF t UNION t DIFF s) ==> f real_measurable_on s ==> f real_measurable_on t`, REWRITE_TAC[real_measurable_on; real_negligible] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MEASURABLE_ON_SPIKE_SET THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN SET_TAC[]);; let REAL_MEASURABLE_ON_RESTRICT = prove (`!f s. f real_measurable_on (:real) /\ real_lebesgue_measurable s ==> (\x. if x IN s then f(x) else &0) real_measurable_on (:real)`, REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV] THEN REWRITE_TAC[o_DEF; COND_RAND; LIFT_NUM; GSYM IN_IMAGE_LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_RESTRICT) THEN REWRITE_TAC[]);; let REAL_MEASURABLE_ON_LIMIT = prove (`!f g s k. (!n. (f n) real_measurable_on s) /\ real_negligible k /\ (!x. x IN s DIFF k ==> ((\n. f n x) ---> g x) sequentially) ==> g real_measurable_on s`, REWRITE_TAC[real_measurable_on; real_negligible; TENDSTO_REAL] THEN REWRITE_TAC[o_DEF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC [`\n:num. lift o f n o drop`; `IMAGE lift k`] THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[LIFT_DROP; SET_RULE `(!x. drop(lift x) = x) ==> IMAGE lift s DIFF IMAGE lift t = IMAGE lift (s DIFF t)`] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]);; let ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT = prove (`!f g s. f real_measurable_on s /\ real_bounded (IMAGE f s) /\ g absolutely_real_integrable_on s ==> (\x. f x * g x) absolutely_real_integrable_on s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_BOUNDED_POS]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN EXISTS_TAC `\x. B * abs((g:real->real) x)` THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_MUL; INTEGRABLE_IMP_REAL_MEASURABLE; ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_INTEGRABLE_LMUL; ABSOLUTELY_REAL_INTEGRABLE_ABS] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LE_RMUL; REAL_ABS_POS]);; let REAL_COMPLEX_MEASURABLE_ON = prove (`!f s. f real_measurable_on s <=> (Cx o f o drop) measurable_on (IMAGE lift s)`, ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV; GSYM MEASURABLE_ON_UNIV] THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN REWRITE_TAC[FORALL_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN REWRITE_TAC[o_DEF; IN_IMAGE_LIFT_DROP] THEN REWRITE_TAC[COND_RAND; COND_RATOR; LIFT_NUM; COMPLEX_VEC_0] THEN REWRITE_TAC[RE_CX; IM_CX; COND_ID; MEASURABLE_ON_CONST; LIFT_NUM]);; let REAL_MEASURABLE_ON_INV = prove (`!f. f real_measurable_on (:real) /\ real_negligible {x | f x = &0} ==> (\x. inv(f x)) real_measurable_on (:real)`, GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_MEASURABLE_ON] THEN REWRITE_TAC[o_DEF; CX_INV; IMAGE_LIFT_UNIV] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMPLEX_INV THEN ASM_REWRITE_TAC[CX_INJ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_negligible]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_DIV = prove (`!f g. f real_measurable_on s /\ g real_measurable_on (:real) /\ real_negligible {x | g(x) = &0} ==> (\x. f(x) / g(x)) real_measurable_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_MEASURABLE_ON] THEN REWRITE_TAC[o_DEF; CX_DIV; IMAGE_LIFT_UNIV] THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMPLEX_DIV THEN ASM_REWRITE_TAC[CX_INJ] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_negligible]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_RPOW = prove (`!f r s. f real_measurable_on s /\ &0 < r ==> (\x. f x rpow r) real_measurable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x. f x rpow r) = (\x. x rpow r) o (f:real->real)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN ASM_SIMP_TAC[REAL_CONTINUOUS_ON_RPOW; RPOW_ZERO; REAL_LT_IMP_LE; REAL_LT_IMP_NZ]);; let MEASURABLE_ON_LIFT_RPOW = prove (`!f:real^N->real s y. (\x. lift(f x)) measurable_on s /\ &0 < y ==> (\x. lift(f x rpow y)) measurable_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^N. lift(f x rpow y)) = (lift o (\w. w rpow y) o drop) o (\x. lift(f x))` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV] THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_ON] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[o_DEF; DROP_VEC; RPOW_ZERO; LIFT_NUM; REAL_LT_IMP_NZ]]);; (* ------------------------------------------------------------------------- *) (* Properties of real Lebesgue measurable sets. *) (* ------------------------------------------------------------------------- *) let REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE = prove (`!s. real_measurable s ==> real_lebesgue_measurable s`, REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_MEASURABLE_MEASURABLE; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; let REAL_LEBESGUE_MEASURABLE_EMPTY = prove (`real_lebesgue_measurable {}`, REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; IMAGE_CLAUSES; LEBESGUE_MEASURABLE_EMPTY]);; let REAL_LEBESGUE_MEASURABLE_UNIV = prove (`real_lebesgue_measurable (:real)`, REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; LEBESGUE_MEASURABLE_UNIV]);; let REAL_LEBESGUE_MEASURABLE_COMPACT = prove (`!s. real_compact s ==> real_lebesgue_measurable s`, SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE; REAL_MEASURABLE_COMPACT]);; let REAL_LEBESGUE_MEASURABLE_INTERVAL = prove (`(!a b. real_lebesgue_measurable(real_interval[a,b])) /\ (!a b. real_lebesgue_measurable(real_interval(a,b)))`, SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE; REAL_MEASURABLE_REAL_INTERVAL]);; let REAL_LEBESGUE_MEASURABLE_INTER = prove (`!s t. real_lebesgue_measurable s /\ real_lebesgue_measurable t ==> real_lebesgue_measurable(s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_INTER) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);; let REAL_LEBESGUE_MEASURABLE_UNION = prove (`!s t:real->bool. real_lebesgue_measurable s /\ real_lebesgue_measurable t ==> real_lebesgue_measurable(s UNION t)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_UNION) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);; let REAL_LEBESGUE_MEASURABLE_COMPL = prove (`!s. real_lebesgue_measurable((:real) DIFF s) <=> real_lebesgue_measurable s`, GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN GEN_REWRITE_TAC (RAND_CONV) [GSYM LEBESGUE_MEASURABLE_COMPL] THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);; let REAL_LEBESGUE_MEASURABLE_DIFF = prove (`!s t:real->bool. real_lebesgue_measurable s /\ real_lebesgue_measurable t ==> real_lebesgue_measurable(s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[REAL_LEBESGUE_MEASURABLE_COMPL; REAL_LEBESGUE_MEASURABLE_INTER]);; let REAL_LEBESGUE_MEASURABLE_ON_SUBINTERVALS = prove (`!s. real_lebesgue_measurable s <=> !a b. real_lebesgue_measurable(s INTER real_interval[a,b])`, GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN GEN_REWRITE_TAC LAND_CONV [LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN REWRITE_TAC[FORALL_DROP; GSYM IMAGE_DROP_INTERVAL] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);; let REAL_LEBESGUE_MEASURABLE_CLOSED = prove (`!s. real_closed s ==> real_lebesgue_measurable s`, REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_CLOSED; LEBESGUE_MEASURABLE_CLOSED]);; let REAL_LEBESGUE_MEASURABLE_OPEN = prove (`!s. real_open s ==> real_lebesgue_measurable s`, REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_OPEN; LEBESGUE_MEASURABLE_OPEN]);; let REAL_LEBESGUE_MEASURABLE_UNIONS = prove (`!f. FINITE f /\ (!s. s IN f ==> real_lebesgue_measurable s) ==> real_lebesgue_measurable (UNIONS f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[UNIONS_0; UNIONS_INSERT; REAL_LEBESGUE_MEASURABLE_EMPTY] THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_UNION THEN ASM_SIMP_TAC[]);; let REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT = prove (`!s:num->real->bool. (!n. real_lebesgue_measurable(s n)) ==> real_lebesgue_measurable(UNIONS {s n | n IN (:num)})`, GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT) THEN REWRITE_TAC[IMAGE_UNIONS; SIMPLE_IMAGE] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; let REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS = prove (`!f:(real->bool)->bool. COUNTABLE f /\ (!s. s IN f ==> real_lebesgue_measurable s) ==> real_lebesgue_measurable (UNIONS f)`, GEN_TAC THEN ASM_CASES_TAC `f:(real->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; REAL_LEBESGUE_MEASURABLE_EMPTY] THEN STRIP_TAC THEN MP_TAC(ISPEC `f:(real->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT THEN GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);; let REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS = prove (`!f:(real->bool)->bool. COUNTABLE f /\ (!s. s IN f ==> real_lebesgue_measurable s) ==> real_lebesgue_measurable (INTERS f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERS_UNIONS; REAL_LEBESGUE_MEASURABLE_COMPL] THEN MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; REAL_LEBESGUE_MEASURABLE_COMPL]);; let REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT = prove (`!s:num->real->bool. (!n. real_lebesgue_measurable(s n)) ==> real_lebesgue_measurable(INTERS {s n | n IN (:num)})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]);; let REAL_LEBESGUE_MEASURABLE_INTERS = prove (`!f:(real->bool)->bool. FINITE f /\ (!s. s IN f ==> real_lebesgue_measurable s) ==> real_lebesgue_measurable (INTERS f)`, SIMP_TAC[REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS; FINITE_IMP_COUNTABLE]);; let REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE = prove (`!s. real_bounded s ==> (real_lebesgue_measurable s <=> real_measurable s)`, REWRITE_TAC[REAL_BOUNDED; REAL_LEBESGUE_MEASURABLE; REAL_MEASURABLE_MEASURABLE] THEN REWRITE_TAC[LEBESGUE_MEASURABLE_IFF_MEASURABLE]);; let REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove (`!f s t. s SUBSET t /\ f real_measurable_on t /\ real_lebesgue_measurable s ==> f real_measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN REWRITE_TAC[IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_RESTRICT) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);; let REAL_MEASURABLE_ON_MEASURABLE_SUBSET = prove (`!f s t. s SUBSET t /\ f real_measurable_on t /\ real_measurable s ==> f real_measurable_on s`, MESON_TAC[REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE]);; let REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET = prove (`!f s. f real_continuous_on s /\ real_closed s ==> f real_measurable_on s`, REWRITE_TAC[REAL_CONTINUOUS_ON; REAL_CLOSED; real_measurable_on] THEN REWRITE_TAC[CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET]);; let REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove (`!f s m. f real_continuous_on s DIFF m /\ real_lebesgue_measurable s /\ real_negligible m ==> f real_measurable_on s`, REWRITE_TAC[real_measurable_on; real_negligible; REAL_LEBESGUE_MEASURABLE; REAL_CONTINUOUS_ON] THEN SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN REWRITE_TAC[CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET]);; let REAL_MEASURABLE_ON_CASES = prove (`!P f g s. real_lebesgue_measurable {x | P x} /\ f real_measurable_on s /\ g real_measurable_on s ==> (\x. if P x then f x else g x) real_measurable_on s`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. (if x IN s then if P x then f x else g x else &0) = (if x IN {x | P x} then if x IN s then f x else &0 else &0) + (if x IN (:real) DIFF {x | P x} then if x IN s then g x else &0 else &0)` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN MESON_TAC[REAL_ADD_LID; REAL_ADD_RID]; MATCH_MP_TAC REAL_MEASURABLE_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN ASM_REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_COMPL]]);; (* ------------------------------------------------------------------------- *) (* Various common equivalent forms of function measurability. *) (* ------------------------------------------------------------------------- *) let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LT = prove (`!f. f real_measurable_on (:real) <=> !a. real_lebesgue_measurable {x | f(x) < a}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE = prove (`!f. f real_measurable_on (:real) <=> !a. real_lebesgue_measurable {x | f(x) <= a}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT = prove (`!f. f real_measurable_on (:real) <=> !a. real_lebesgue_measurable {x | f(x) > a}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GE = prove (`!f. f real_measurable_on (:real) <=> !a. real_lebesgue_measurable {x | f(x) >= a}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL = prove (`!f. f real_measurable_on (:real) <=> !a b. real_lebesgue_measurable {x | f(x) IN real_interval(a,b)}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; FORALL_DROP] THEN GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; o_DEF; GSYM IMAGE_DROP_INTERVAL; LIFT_DROP; FORALL_DROP; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL = prove (`!f. f real_measurable_on (:real) <=> !a b. real_lebesgue_measurable {x | f(x) IN real_interval[a,b]}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; FORALL_DROP] THEN GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; o_DEF; GSYM IMAGE_DROP_INTERVAL; LIFT_DROP; FORALL_DROP; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_PREIMAGE_OPEN = prove (`!f. f real_measurable_on (:real) <=> !t. real_open t ==> real_lebesgue_measurable {x | f(x) IN t}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_OPEN; REAL_OPEN] THEN GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `t:real->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE lift t`) THEN ASM_REWRITE_TAC[]; X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE drop t`) THEN ASM_REWRITE_TAC[IMAGE_LIFT_DROP; GSYM IMAGE_o]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THENL [CONV_TAC SYM_CONV; ALL_TAC] THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_IMAGE; o_DEF; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_PREIMAGE_CLOSED = prove (`!f. f real_measurable_on (:real) <=> !t. real_closed t ==> real_lebesgue_measurable {x | f(x) IN t}`, REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; MEASURABLE_ON_PREIMAGE_CLOSED; REAL_CLOSED] THEN GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `t:real->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE lift t`) THEN ASM_REWRITE_TAC[]; X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE drop t`) THEN ASM_REWRITE_TAC[IMAGE_LIFT_DROP; GSYM IMAGE_o]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THENL [CONV_TAC SYM_CONV; ALL_TAC] THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_IMAGE; o_DEF; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; let REAL_MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT = prove (`!f. f real_measurable_on (:real) <=> ?g. (!n. (g n) real_measurable_on (:real)) /\ (!n. FINITE(IMAGE (g n) (:real))) /\ (!x. ((\n. g n x) ---> f x) sequentially)`, GEN_TAC THEN REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `g:num->real^1->real^1` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n:num. drop o g n o lift` THEN REWRITE_TAC[TENDSTO_REAL] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]; GEN_TAC THEN REWRITE_TAC[IMAGE_o; IMAGE_LIFT_UNIV] THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; X_GEN_TAC `x:real` THEN REWRITE_TAC[TENDSTO_REAL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `lift x`) THEN REWRITE_TAC[o_DEF; LIFT_DROP]]; DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n:num. lift o g n o drop` THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[]; GEN_TAC THEN REWRITE_TAC[IMAGE_o; IMAGE_DROP_UNIV] THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; X_GEN_TAC `x:real^1` THEN FIRST_X_ASSUM(MP_TAC o SPEC `drop x`) THEN REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP]]]);; let REAL_LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove (`!f t. f real_measurable_on (:real) /\ real_open t ==> real_lebesgue_measurable {x | f(x) IN t}`, SIMP_TAC[REAL_MEASURABLE_ON_PREIMAGE_OPEN]);; let REAL_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove (`!f t. f real_measurable_on (:real) /\ real_closed t ==> real_lebesgue_measurable {x | f(x) IN t}`, SIMP_TAC[REAL_MEASURABLE_ON_PREIMAGE_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Continuity of measure within a halfspace w.r.t. to the boundary. *) (* ------------------------------------------------------------------------- *) let REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE = prove (`!(s:real^N->bool) a i. measurable s /\ 1 <= i /\ i <= dimindex(:N) ==> (\a. measure(s INTER {x | x$i <= a})) real_continuous atreal a`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1] THEN REWRITE_TAC[continuous_atreal; o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?u v:real^N. abs(measure(s INTER interval[u,v]) - measure s) < e / &2 /\ ~(interval(u,v) = {}) /\ u$i < a /\ a < v$i` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURE_LIMIT) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN EXISTS_TAC `(lambda j. min (a - &1) ((u:real^N)$j)):real^N` THEN EXISTS_TAC `(lambda j. max (a + &1) ((v:real^N)$j)):real^N` THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM (MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN REAL_ARITH_TAC]; ALL_TAC] THEN MP_TAC(ISPECL [`indicator(s:real^N->bool)`; `u:real^N`; `v:real^N`; `u:real^N`; `(lambda j. if j = i then min ((v:real^N)$i) a else v$j):real^N`; `e / &2`] INDEFINITE_INTEGRAL_CONTINUOUS) THEN ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL [ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN REWRITE_TAC[indicator; MESON[] `(if P then if Q then x else y else y) = (if P /\ Q then x else y)`] THEN REWRITE_TAC[GSYM IN_INTER; GSYM MEASURABLE_INTEGRABLE] THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_LE_REFL; REAL_LT_IMP_LE] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (min (a - (u:real^N)$i) ((v:real^N)$i - a))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN X_GEN_TAC `b:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N`; `(lambda j. if j = i then min ((v:real^N)$i) b else v$j):real^N`]) THEN REWRITE_TAC[dist] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_LE_REFL; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [X_GEN_TAC `j:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[NORM_LE_SQUARE; dot; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\j. if j = i then d pow 2 else &0)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG; REAL_LE_REFL]]]; SUBGOAL_THEN `!b. integral (interval[u:real^N, (lambda j. if j = i then min (v$i) b else (v:real^N)$j)]) (indicator s) = lift(measure(s INTER interval[u,v] INTER {x | x$i <= b}))` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN ASM_SIMP_TAC[MEASURE_INTEGRAL; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER; MEASURABLE_INTERVAL; LIFT_DROP] THEN ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT; indicator] THEN REWRITE_TAC[IN_INTER] THEN MESON_TAC[]; REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN SUBGOAL_THEN `!b. measure(s INTER {x:real^N | x$i <= b}) = measure((s INTER interval[u,v]) INTER {x | x$i <= b}) + measure((s DIFF interval[u,v]) INTER {x | x$i <= b})` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTERVAL; MEASURABLE_DIFF] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN SET_TAC[]; REWRITE_TAC[GSYM INTER_ASSOC] THEN MATCH_MP_TAC(REAL_ARITH `abs(nub - nua) < e / &2 ==> abs(mub - mua) < e / &2 ==> abs((mub + nub) - (mua + nua)) < e`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `y < e ==> x <= y ==> x < e`)) THEN SUBGOAL_THEN `abs(measure(s INTER interval [u,v]) - measure s) = measure(s DIFF interval[u:real^N,v])` SUBST1_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x + z = y /\ &0 <= z ==> abs(x - y) = z`) THEN ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN SET_TAC[]; MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a /\ &0 <= y /\ y <= a ==> abs(x - y) <= a`) THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTERVAL; MEASURABLE_DIFF; MEASURE_POS_LE] THEN CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTERVAL; MEASURABLE_DIFF; MEASURE_POS_LE] THEN SET_TAC[]]]]]);; (* ------------------------------------------------------------------------- *) (* Second mean value theorem and monotone integrability. *) (* ------------------------------------------------------------------------- *) let REAL_SECOND_MEAN_VALUE_THEOREM_FULL = prove (`!f g a b. ~(real_interval[a,b] = {}) /\ f real_integrable_on real_interval[a,b] /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) ==> ?c. c IN real_interval[a,b] /\ ((\x. g x * f x) has_real_integral (g(a) * real_integral (real_interval[a,c]) f + g(b) * real_integral (real_interval[c,b]) f)) (real_interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `lift a`; `lift b`] SECOND_MEAN_VALUE_THEOREM_FULL) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN ASM_REAL_ARITH_TAC);; let REAL_SECOND_MEAN_VALUE_THEOREM = prove (`!f g a b. ~(real_interval[a,b] = {}) /\ f real_integrable_on real_interval[a,b] /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) ==> ?c. c IN real_interval[a,b] /\ real_integral (real_interval[a,b]) (\x. g x * f x) = g(a) * real_integral (real_interval[a,c]) f + g(b) * real_integral (real_interval[c,b]) f`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_FULL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; let REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL = prove (`!f g a b u v. ~(real_interval[a,b] = {}) /\ f real_integrable_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) ==> u <= g x /\ g x <= v) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) ==> ?c. c IN real_interval[a,b] /\ ((\x. g x * f x) has_real_integral (u * real_integral (real_interval[a,c]) f + v * real_integral (real_interval[c,b]) f)) (real_interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `lift a`; `lift b`; `u:real`; `v:real`] SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN ASM_REAL_ARITH_TAC);; let REAL_SECOND_MEAN_VALUE_THEOREM_GEN = prove (`!f g a b u v. ~(real_interval[a,b] = {}) /\ f real_integrable_on real_interval[a,b] /\ (!x. x IN real_interval(a,b) ==> u <= g x /\ g x <= v) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) ==> ?c. c IN real_interval[a,b] /\ real_integral (real_interval[a,b]) (\x. g x * f x) = u * real_integral (real_interval[a,c]) f + v * real_integral (real_interval[c,b]) f`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; let REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL = prove (`!f g a b. ~(real_interval[a,b] = {}) /\ f real_integrable_on real_interval[a,b] /\ (!x. x IN real_interval[a,b] ==> &0 <= g x) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) ==> ?c. c IN real_interval[a,b] /\ ((\x. g x * f x) has_real_integral (g(b) * real_integral (real_interval[c,b]) f)) (real_interval[a,b])`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `lift a`; `lift b`] SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN ASM_REAL_ARITH_TAC);; let REAL_SECOND_MEAN_VALUE_THEOREM_BONNET = prove (`!f g a b. ~(real_interval[a,b] = {}) /\ f real_integrable_on real_interval[a,b] /\ (!x. x IN real_interval[a,b] ==> &0 <= g x) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) ==> ?c. c IN real_interval[a,b] /\ real_integral (real_interval[a,b]) (\x. g x * f x) = g(b) * real_integral (real_interval[c,b]) f`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; let REAL_INTEGRABLE_INCREASING_PRODUCT = prove (`!f g a b. f real_integrable_on real_interval[a,b] /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g(x) <= g(y)) ==> (\x. g(x) * f(x)) real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `lift a`; `lift b`] INTEGRABLE_INCREASING_PRODUCT) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM REAL_INTEGRABLE_ON] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; let REAL_INTEGRABLE_INCREASING_PRODUCT_UNIV = prove (`!f g B. f real_integrable_on (:real) /\ (!x y. x <= y ==> g x <= g y) /\ (!x. abs(g x) <= B) ==> (\x. g x * f x) real_integrable_on (:real)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `B:real`] INTEGRABLE_INCREASING_PRODUCT_UNIV) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV; GSYM REAL_INTEGRABLE_ON] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; let REAL_INTEGRABLE_INCREASING = prove (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f(x) <= f(y)) ==> f real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] INTEGRABLE_INCREASING_1) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM REAL_INTEGRABLE_ON] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; let REAL_INTEGRABLE_DECREASING_PRODUCT = prove (`!f g a b. f real_integrable_on real_interval[a,b] /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g(y) <= g(x)) ==> (\x. g(x) * f(x)) real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `lift a`; `lift b`] INTEGRABLE_DECREASING_PRODUCT) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM REAL_INTEGRABLE_ON] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; let REAL_INTEGRABLE_DECREASING_PRODUCT_UNIV = prove (`!f g B. f real_integrable_on (:real) /\ (!x y. x <= y ==> g y <= g x) /\ (!x. abs(g x) <= B) ==> (\x. g x * f x) real_integrable_on (:real)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `B:real`] INTEGRABLE_DECREASING_PRODUCT_UNIV) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV; GSYM REAL_INTEGRABLE_ON] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; let REAL_INTEGRABLE_DECREASING = prove (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f(y) <= f(x)) ==> f real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] INTEGRABLE_DECREASING_1) THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM REAL_INTEGRABLE_ON] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; (* ------------------------------------------------------------------------- *) (* Measurability and absolute integrability of monotone functions. *) (* ------------------------------------------------------------------------- *) let REAL_MEASURABLE_ON_INCREASING_UNIV = prove (`!f. (!x y. x <= y ==> f x <= f y) ==> f real_measurable_on (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE] THEN X_GEN_TAC `y:real` THEN REPEAT_TCL STRIP_THM_THEN ASSUME_TAC (SET_RULE `{x | (f:real->real) x <= y} = {} \/ {x | (f:real->real) x <= y} = UNIV \/ ?a b. f a <= y /\ ~(f b <= y)`) THEN ASM_REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_EMPTY; REAL_LEBESGUE_MEASURABLE_UNIV] THEN MP_TAC(ISPEC `{x | (f:real->real) x <= y}` SUP) THEN REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_TRANS]; ALL_TAC] THEN ABBREV_TAC `s = sup {x | (f:real->real) x <= y}` THEN STRIP_TAC THEN SUBGOAL_THEN `(!x. (f:real->real) x <= y <=> x < s) \/ (!x. (f:real->real) x <= y <=> x <= s)` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `(f:real->real) s <= y` THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE; REAL_LE_ANTISYM; REAL_LE_TOTAL]; ASM_SIMP_TAC[REAL_OPEN_HALFSPACE_LT; REAL_LEBESGUE_MEASURABLE_OPEN]; ASM_SIMP_TAC[REAL_CLOSED_HALFSPACE_LE; REAL_LEBESGUE_MEASURABLE_CLOSED]]);; let REAL_MEASURABLE_ON_INCREASING = prove (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f x <= f y) ==> f real_measurable_on real_interval[a,b]`, REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `real_interval[a,b] = {}` THENL [ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_MEASURABLE_ON_0]; RULE_ASSUM_TAC(REWRITE_RULE[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT])] THEN ABBREV_TAC `g = \x. if x < a then f(a) else if b < x then f(b) else (f:real->real) x` THEN SUBGOAL_THEN `g real_measurable_on real_interval[a,b]` MP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN EXPAND_TAC "g" THEN SIMP_TAC[IN_REAL_INTERVAL; GSYM REAL_NOT_LT]] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN EXISTS_TAC `(:real)` THEN REWRITE_TAC[SUBSET_UNIV; REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING_UNIV THEN EXPAND_TAC "g" THEN ASM_MESON_TAC[REAL_LT_LE; REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM; REAL_NOT_LT; REAL_LT_IMP_LE; REAL_LE_REFL]);; let REAL_MEASURABLE_ON_DECREASING_UNIV = prove (`!f. (!x y. x <= y ==> f y <= f x) ==> f real_measurable_on (:real)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM REAL_MEASURABLE_ON_NEG_EQ] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING_UNIV THEN ASM_SIMP_TAC[REAL_LE_NEG2]);; let REAL_MEASURABLE_ON_DECREASING = prove (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f y <= f x) ==> f real_measurable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM REAL_MEASURABLE_ON_NEG_EQ] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING THEN ASM_SIMP_TAC[REAL_LE_NEG2]);; let ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT = prove (`!f g a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f x <= f y) /\ g absolutely_real_integrable_on real_interval[a,b] ==> (\x. f x * g x) absolutely_real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_INCREASING] THEN REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `abs((f:real->real) a) + abs((f:real->real) b)` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (REAL_ARITH `a <= x /\ x <= b ==> abs x <= abs a + abs b`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LE_TRANS; REAL_LE_REFL]);; let ABSOLUTELY_REAL_INTEGRABLE_INCREASING = prove (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f x <= f y) ==> f absolutely_real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT THEN ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]);; let ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT = prove (`!f g a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f y <= f x) /\ g absolutely_real_integrable_on real_interval[a,b] ==> (\x. f x * g x) absolutely_real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN ASM_SIMP_TAC[REAL_MEASURABLE_ON_DECREASING] THEN REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `abs((f:real->real) a) + abs((f:real->real) b)` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (REAL_ARITH `b <= x /\ x <= a ==> abs x <= abs a + abs b`) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LE_TRANS; REAL_LE_REFL]);; let ABSOLUTELY_REAL_INTEGRABLE_DECREASING = prove (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f y <= f x) ==> f absolutely_real_integrable_on real_interval[a,b]`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT THEN ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]);; (* ------------------------------------------------------------------------- *) (* Real functions of bounded variation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("has_bounded_real_variation_on",(12,"right"));; let has_bounded_real_variation_on = new_definition `f has_bounded_real_variation_on s <=> (lift o f o drop) has_bounded_variation_on (IMAGE lift s)`;; let real_variation = new_definition `real_variation s f = vector_variation (IMAGE lift s) (lift o f o drop)`;; let HAS_BOUNDED_REAL_VARIATION_ON_EQ = prove (`!f g s. (!x. x IN s ==> f x = g x) /\ f has_bounded_real_variation_on s ==> g has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IMP_CONJ; has_bounded_real_variation_on] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_EQ) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_ON_SUBSET = prove (`!f s t. f has_bounded_real_variation_on s /\ t SUBSET s ==> f has_bounded_real_variation_on t`, REWRITE_TAC[has_bounded_real_variation_on] THEN MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; IMAGE_SUBSET]);; let HAS_BOUNDED_REAL_VARIATION_ON_LMUL = prove (`!f c s. f has_bounded_real_variation_on s ==> (\x. c * f x) has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN REWRITE_TAC[o_DEF; LIFT_CMUL; HAS_BOUNDED_VARIATION_ON_CMUL]);; let HAS_BOUNDED_REAL_VARIATION_ON_RMUL = prove (`!f c s. f has_bounded_real_variation_on s ==> (\x. f x * c) has_bounded_real_variation_on s`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_ON_LMUL]);; let HAS_BOUNDED_REAL_VARIATION_ON_NEG = prove (`!f s. f has_bounded_real_variation_on s ==> (\x. --f x) has_bounded_real_variation_on s`, REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_NEG] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_NEG]);; let HAS_BOUNDED_REAL_VARIATION_ON_ADD = prove (`!f g s. f has_bounded_real_variation_on s /\ g has_bounded_real_variation_on s ==> (\x. f x + g x) has_bounded_real_variation_on s`, REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_ADD] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_ADD]);; let HAS_BOUNDED_REAL_VARIATION_ON_SUB = prove (`!f g s. f has_bounded_real_variation_on s /\ g has_bounded_real_variation_on s ==> (\x. f x - g x) has_bounded_real_variation_on s`, REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_SUB] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_SUB]);; let HAS_BOUNDED_REAL_VARIATION_ON_NULL = prove (`!f a b. b <= a ==> f has_bounded_real_variation_on real_interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NULL THEN ASM_REWRITE_TAC[BOUNDED_INTERVAL; CONTENT_EQ_0_1; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_ON_EMPTY = prove (`!f. f has_bounded_real_variation_on {}`, REWRITE_TAC[IMAGE_CLAUSES; has_bounded_real_variation_on] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_EMPTY]);; let HAS_BOUNDED_REAL_VARIATION_ON_ABS = prove (`!f s. f has_bounded_real_variation_on s ==> (\x. abs(f x)) has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NORM) THEN REWRITE_TAC[o_DEF; NORM_REAL; GSYM drop; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_ON_MAX = prove (`!f g s. f has_bounded_real_variation_on s /\ g has_bounded_real_variation_on s ==> (\x. max (f x) (g x)) has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MAX) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_ON_MIN = prove (`!f g s. f has_bounded_real_variation_on s /\ g has_bounded_real_variation_on s ==> (\x. min (f x) (g x)) has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MIN) THEN REWRITE_TAC[o_DEF; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL = prove (`!f a b. f has_bounded_real_variation_on real_interval[a,b] ==> real_bounded(IMAGE f (real_interval[a,b]))`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on; REAL_BOUNDED] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL) THEN REWRITE_TAC[IMAGE_o; IMAGE_DROP_INTERVAL; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_ON_MUL = prove (`!f g s. f has_bounded_real_variation_on s /\ g has_bounded_real_variation_on s /\ is_realinterval s ==> (\x. f x * g x) has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; IS_REALINTERVAL_IS_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MUL) THEN REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);; let REAL_VARIATION_POS_LE = prove (`!f s. f has_bounded_real_variation_on s ==> &0 <= real_variation s f`, REWRITE_TAC[real_variation; has_bounded_real_variation_on] THEN REWRITE_TAC[VECTOR_VARIATION_POS_LE]);; let REAL_VARIATION_GE_ABS_FUNCTION = prove (`!f s a b. f has_bounded_real_variation_on s /\ real_segment[a,b] SUBSET s ==> abs(f b - f a) <= real_variation s f`, REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `lift a`; `lift b`] VECTOR_VARIATION_GE_NORM_FUNCTION) THEN ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_SEGMENT; IMAGE_EQ_EMPTY; IMAGE_SUBSET] THEN REWRITE_TAC[real_variation; o_THM; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]);; let REAL_VARIATION_GE_FUNCTION = prove (`!f s a b. f has_bounded_real_variation_on s /\ real_segment[a,b] SUBSET s ==> f b - f a <= real_variation s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN ASM_MESON_TAC[REAL_VARIATION_GE_ABS_FUNCTION]);; let REAL_VARIATION_MONOTONE = prove (`!f s t. f has_bounded_real_variation_on s /\ t SUBSET s ==> real_variation t f <= real_variation s f`, REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN ASM_SIMP_TAC[IMAGE_SUBSET]);; let REAL_VARIATION_NEG = prove (`!f s. real_variation s (\x. --(f x)) = real_variation s f`, SIMP_TAC[real_variation; o_DEF; LIFT_NEG; VECTOR_VARIATION_NEG]);; let REAL_VARIATION_TRIANGLE = prove (`!f g s. f has_bounded_real_variation_on s /\ g has_bounded_real_variation_on s ==> real_variation s (\x. f x + g x) <= real_variation s f + real_variation s g`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN DISCH_THEN(MP_TAC o MATCH_MP VECTOR_VARIATION_TRIANGLE) THEN REWRITE_TAC[o_DEF; LIFT_ADD]);; let HAS_BOUNDED_REAL_VARIATION_ON_COMBINE = prove (`!f a b c. a <= c /\ c <= b ==> (f has_bounded_real_variation_on real_interval[a,b] <=> f has_bounded_real_variation_on real_interval[a,c] /\ f has_bounded_real_variation_on real_interval[c,b])`, REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `lift c`] HAS_BOUNDED_VARIATION_ON_COMBINE) THEN ASM_REWRITE_TAC[LIFT_DROP; has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL]);; let REAL_VARIATION_COMBINE = prove (`!f a b c. a <= c /\ c <= b /\ f has_bounded_real_variation_on real_interval[a,b] ==> real_variation (real_interval[a,c]) f + real_variation (real_interval[c,b]) f = real_variation (real_interval[a,b]) f`, REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `lift c`] VECTOR_VARIATION_COMBINE) THEN ASM_REWRITE_TAC[LIFT_DROP; real_variation; IMAGE_LIFT_REAL_INTERVAL]);; let REAL_VARIATION_MINUS_FUNCTION_MONOTONE = prove (`!f a b c d. f has_bounded_real_variation_on real_interval[a,b] /\ real_interval[c,d] SUBSET real_interval[a,b] /\ ~(real_interval[c,d] = {}) ==> real_variation (real_interval[c,d]) f - (f d - f c) <= real_variation (real_interval[a,b]) f - (f b - f a)`, REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `lift c`; `lift d`] VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE) THEN ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; real_variation; IMAGE_EQ_EMPTY; IMAGE_SUBSET] THEN REWRITE_TAC[o_THM; LIFT_DROP; DROP_SUB]);; let INCREASING_BOUNDED_REAL_VARIATION = prove (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f x <= f y) ==> f has_bounded_real_variation_on real_interval[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; o_THM; LIFT_DROP] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_MESON_TAC[]);; let INCREASING_REAL_VARIATION = prove (`!f a b. ~(real_interval[a,b] = {}) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f x <= f y) ==> real_variation (real_interval[a,b]) f = f b - f a`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_variation; IMAGE_LIFT_REAL_INTERVAL] THEN MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] INCREASING_VECTOR_VARIATION) THEN REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[LIFT_DROP] THEN ASM_MESON_TAC[]);; let HAS_BOUNDED_REAL_VARIATION_AFFINITY2_EQ = prove (`!m c f s. (\x. f (m * x + c)) has_bounded_real_variation_on IMAGE (\x. inv m * x + --(inv m * c)) s <=> m = &0 \/ f has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] HAS_BOUNDED_VARIATION_AFFINITY2_EQ) THEN REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; let REAL_VARIATION_AFFINITY2 = prove (`!m c f s. real_variation (IMAGE (\x. inv m * x + --(inv m * c)) s) (\x. f (m * x + c)) = if m = &0 then &0 else real_variation s f`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] VECTOR_VARIATION_AFFINITY2) THEN REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_AFFINITY_EQ = prove (`!m c f s. (\x. f (m * x + c)) has_bounded_real_variation_on s <=> m = &0 \/ f has_bounded_real_variation_on IMAGE (\x. m * x + c) s`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] HAS_BOUNDED_VARIATION_AFFINITY_EQ) THEN REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; let REAL_VARIATION_AFFINITY = prove (`!m c f s. real_variation s (\x. f (m * x + c)) = if m = &0 then &0 else real_variation (IMAGE (\x. m * x + c) s) f`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] VECTOR_VARIATION_AFFINITY) THEN REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; let HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ = prove (`!a f s. (\x. f(a + x)) has_bounded_real_variation_on (IMAGE (\x. --a + x) s) <=> f has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] HAS_BOUNDED_VARIATION_TRANSLATION2_EQ) THEN REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; let REAL_VARIATION_TRANSLATION2 = prove (`!a f s. real_variation (IMAGE (\x. --a + x) s) (\x. f(a + x)) = real_variation s f`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] VECTOR_VARIATION_TRANSLATION2) THEN REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; let HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ = prove (`!a f s. (\x. f(a + x)) has_bounded_real_variation_on s <=> f has_bounded_real_variation_on (IMAGE (\x. a + x) s)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] HAS_BOUNDED_VARIATION_TRANSLATION_EQ) THEN REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; let REAL_VARIATION_TRANSLATION = prove (`!a f s. real_variation s (\x. f(a + x)) = real_variation (IMAGE (\x. a + x) s) f`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] VECTOR_VARIATION_TRANSLATION_ALT) THEN REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; let HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ_INTERVAL = prove (`!a f u v. (\x. f(a + x)) has_bounded_real_variation_on real_interval[u,v] <=> f has_bounded_real_variation_on real_interval[a+u,a+v]`, REWRITE_TAC[REAL_INTERVAL_TRANSLATION; HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ]);; let REAL_VARIATION_TRANSLATION_INTERVAL = prove (`!a f u v. real_variation (real_interval[u,v]) (\x. f(a + x)) = real_variation (real_interval[a+u,a+v]) f`, REWRITE_TAC[REAL_INTERVAL_TRANSLATION; REAL_VARIATION_TRANSLATION]);; let HAS_BOUNDED_REAL_VARIATION_TRANSLATION = prove (`!f s a. f has_bounded_real_variation_on s ==> (\x. f(a + x)) has_bounded_real_variation_on (IMAGE (\x. --a + x) s)`, REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ]);; let HAS_BOUNDED_REAL_VARIATION_REFLECT2_EQ = prove (`!f s. (\x. f(--x)) has_bounded_real_variation_on (IMAGE (--) s) <=> f has_bounded_real_variation_on s`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] HAS_BOUNDED_VARIATION_REFLECT2_EQ) THEN REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; DROP_NEG; LIFT_DROP; LIFT_NEG]);; let REAL_VARIATION_REFLECT2 = prove (`!f s. real_variation (IMAGE (--) s) (\x. f(--x)) = real_variation s f`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] VECTOR_VARIATION_REFLECT2) THEN REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; DROP_NEG; LIFT_DROP; LIFT_NEG]);; let HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ = prove (`!f s. (\x. f(--x)) has_bounded_real_variation_on s <=> f has_bounded_real_variation_on (IMAGE (--) s)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] HAS_BOUNDED_VARIATION_REFLECT_EQ) THEN REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; DROP_NEG; LIFT_DROP; LIFT_NEG]);; let REAL_VARIATION_REFLECT = prove (`!f s. real_variation s (\x. f(--x)) = real_variation (IMAGE (--) s) f`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] VECTOR_VARIATION_REFLECT) THEN REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; DROP_NEG; LIFT_DROP; LIFT_NEG]);; let HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ_INTERVAL = prove (`!f u v. (\x. f(--x)) has_bounded_real_variation_on real_interval[u,v] <=> f has_bounded_real_variation_on real_interval[--v,--u]`, REWRITE_TAC[GSYM REFLECT_REAL_INTERVAL; HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ]);; let REAL_VARIATION_REFLECT_INTERVAL = prove (`!f u v. real_variation (real_interval[u,v]) (\x. f(--x)) = real_variation (real_interval[--v,--u]) f`, REWRITE_TAC[GSYM REFLECT_REAL_INTERVAL; REAL_VARIATION_REFLECT]);; let HAS_BOUNDED_REAL_VARIATION_DARBOUX = prove (`!f a b. f has_bounded_real_variation_on real_interval[a,b] <=> ?g h. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> h x <= h y) /\ (!x. f x = g x - h x)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX; IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; GSYM IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THENL [MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`drop o g o lift`; `drop o h o lift`] THEN ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM LIFT_EQ; FORALL_DROP] THEN ASM_REWRITE_TAC[LIFT_DROP; LIFT_SUB]; MAP_EVERY X_GEN_TAC [`g:real->real`; `h:real->real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`lift o g o drop`; `lift o h o drop`] THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN REWRITE_TAC[LIFT_SUB]]);; let HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRICT = prove (`!f a b. f has_bounded_real_variation_on real_interval[a,b] <=> ?g h. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y ==> g x < g y) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y ==> h x < h y) /\ (!x. f x = g x - h x)`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX_STRICT; IMAGE_LIFT_REAL_INTERVAL] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; GSYM IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THENL [MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`drop o g o lift`; `drop o h o lift`] THEN ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM LIFT_EQ; FORALL_DROP] THEN ASM_REWRITE_TAC[LIFT_DROP; LIFT_SUB]; MAP_EVERY X_GEN_TAC [`g:real->real`; `h:real->real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`lift o g o drop`; `lift o h o drop`] THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN REWRITE_TAC[LIFT_SUB]]);; let INCREASING_LEFT_LIMIT = prove (`!f a b c. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f x <= f y) /\ c IN real_interval[a,b] ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`, REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC INCREASING_LEFT_LIMIT_1 THEN EXISTS_TAC `lift b` THEN SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; let DECREASING_LEFT_LIMIT = prove (`!f a b c. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f y <= f x) /\ c IN real_interval[a,b] ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`, REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC DECREASING_LEFT_LIMIT_1 THEN EXISTS_TAC `lift b` THEN SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; let INCREASING_RIGHT_LIMIT = prove (`!f a b c. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f x <= f y) /\ c IN real_interval[a,b] ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC INCREASING_RIGHT_LIMIT_1 THEN EXISTS_TAC `lift a` THEN SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; let DECREASING_RIGHT_LIMIT = prove (`!f a b c. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> f y <= f x) /\ c IN real_interval[a,b] ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC DECREASING_RIGHT_LIMIT_1 THEN EXISTS_TAC `lift a` THEN SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; let HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT = prove (`!f a b c. f has_bounded_real_variation_on real_interval[a,b] /\ c IN real_interval[a,b] ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`, REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT THEN EXISTS_TAC `lift b` THEN ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM o_ASSOC; FUN_IN_IMAGE]);; let HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT = prove (`!f a b c. f has_bounded_real_variation_on real_interval[a,b] /\ c IN real_interval[a,b] ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`, REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT THEN EXISTS_TAC `lift a` THEN ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM o_ASSOC; FUN_IN_IMAGE]);; let REAL_VARIATION_CONTINUOUS_LEFT = prove (`!f a b c. f has_bounded_real_variation_on real_interval[a,b] /\ c IN real_interval[a,b] ==> ((\x. real_variation(real_interval[a,x]) f) real_continuous (atreal c within real_interval[a,c]) <=> f real_continuous (atreal c within real_interval[a,c]))`, REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS_LEFT THEN EXISTS_TAC `lift b` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);; let REAL_VARIATION_CONTINUOUS_RIGHT = prove (`!f a b c. f has_bounded_real_variation_on real_interval[a,b] /\ c IN real_interval[a,b] ==> ((\x. real_variation(real_interval[a,x]) f) real_continuous (atreal c within real_interval[c,b]) <=> f real_continuous (atreal c within real_interval[c,b]))`, REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS_RIGHT THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);; let REAL_VARIATION_CONTINUOUS = prove (`!f a b c. f has_bounded_real_variation_on real_interval[a,b] /\ c IN real_interval[a,b] ==> ((\x. real_variation(real_interval[a,x]) f) real_continuous (atreal c within real_interval[a,b]) <=> f real_continuous (atreal c within real_interval[a,b]))`, REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);; let HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRONG = prove (`!f a b. f has_bounded_real_variation_on real_interval[a,b] ==> ?g h. (!x. f x = g x - h x) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> g x <= g y) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y ==> h x <= h y) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y ==> g x < g y) /\ (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y ==> h x < h y) /\ (!x. x IN real_interval[a,b] /\ f real_continuous (atreal x within real_interval[a,x]) ==> g real_continuous (atreal x within real_interval[a,x]) /\ h real_continuous (atreal x within real_interval[a,x])) /\ (!x. x IN real_interval[a,b] /\ f real_continuous (atreal x within real_interval[x,b]) ==> g real_continuous (atreal x within real_interval[x,b]) /\ h real_continuous (atreal x within real_interval[x,b])) /\ (!x. x IN real_interval[a,b] /\ f real_continuous (atreal x within real_interval[a,b]) ==> g real_continuous (atreal x within real_interval[a,b]) /\ h real_continuous (atreal x within real_interval[a,b]))`, REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`\x. x + real_variation (real_interval[a,x]) f`; `\x. x + real_variation (real_interval[a,x]) f - f x`] THEN REWRITE_TAC[REAL_ARITH `(x + l) - (x + l - f):real = f`] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_VARIATION_MONOTONE; MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN EXISTS_TAC `(f:real->real) a` THEN MATCH_MP_TAC REAL_VARIATION_MINUS_FUNCTION_MONOTONE; MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_VARIATION_MONOTONE; MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN EXISTS_TAC `(f:real->real) a` THEN MATCH_MP_TAC REAL_VARIATION_MINUS_FUNCTION_MONOTONE; MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] REAL_VARIATION_CONTINUOUS_LEFT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] REAL_VARIATION_CONTINUOUS_LEFT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] REAL_VARIATION_CONTINUOUS_RIGHT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] REAL_VARIATION_CONTINUOUS_RIGHT) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] REAL_VARIATION_CONTINUOUS) THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] REAL_VARIATION_CONTINUOUS) THEN ASM_REWRITE_TAC[]] THEN (CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_REAL_VARIATION_ON_SUBSET)); ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN REWRITE_TAC[SUBSET_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC));; let HAS_BOUNDED_REAL_VARIATION_COUNTABLE_DISCONTINUITIES = prove (`!f s. f has_bounded_real_variation_on s /\ is_realinterval s ==> COUNTABLE {x | x IN s /\ ~(f real_continuous atreal x)}`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES) THEN DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP COUNTABLE_IMAGE) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_LIFT; LIFT_DROP; UNWIND_THM1] THEN REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IN_ELIM_THM] THEN REWRITE_TAC[EXISTS_IN_IMAGE; GSYM CONJ_ASSOC; EXISTS_DROP; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);; let REAL_INTEGRABLE_REAL_BOUNDED_VARIATION_PRODUCT = prove (`!f g a b. f real_integrable_on real_interval[a,b] /\ g has_bounded_real_variation_on real_interval[a,b] ==> (\x. g x * f x) real_integrable_on real_interval[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on; REAL_INTEGRABLE_ON] THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; o_DEF; LIFT_CMUL] THEN DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_BOUNDED_VARIATION_PRODUCT) THEN REWRITE_TAC[LIFT_DROP]);; let REAL_LEBESGUE_DIFFERENTIATION_THEOREM = prove (`!f s. is_realinterval s /\ f has_bounded_real_variation_on s ==> real_negligible {x | x IN s /\ ~(f real_differentiable atreal x)}`, REPEAT GEN_TAC THEN REWRITE_TAC[real_negligible] THEN REWRITE_TAC[has_bounded_real_variation_on; IS_REALINTERVAL_IS_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_DIFFERENTIATION_THEOREM) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[REAL_DIFFERENTIABLE_AT] THEN SET_TAC[]);; let REAL_LEBESGUE_DIFFERENTIATION_THEOREM_ALT = prove (`!f s. is_realinterval s /\ f has_bounded_real_variation_on s ==> ?t. t SUBSET s /\ real_negligible t /\ !x. x IN s DIFF t ==> f real_differentiable atreal x`, REPEAT STRIP_TAC THEN EXISTS_TAC `{x | x IN s /\ ~(f real_differentiable atreal x)}` THEN ASM_SIMP_TAC[REAL_LEBESGUE_DIFFERENTIATION_THEOREM; SUBSET_RESTRICT] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN CONV_TAC TAUT);; let REAL_LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING = prove (`!f s. is_realinterval s /\ (!x y. x IN s /\ y IN s /\ x <= y ==> f x <= f y) ==> real_negligible {x | x IN s /\ ~(f real_differentiable atreal x)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] LEBESGUE_DIFFERENTIATION_THEOREM_INCREASING) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[GSYM IS_REALINTERVAL_IS_INTERVAL; o_THM; LIFT_DROP] THEN REWRITE_TAC[real_negligible] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[REAL_DIFFERENTIABLE_AT] THEN SET_TAC[]);; let REAL_LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING = prove (`!f s. is_realinterval s /\ (!x y. x IN s /\ y IN s /\ x <= y ==> f y <= f x) ==> real_negligible {x | x IN s /\ ~(f real_differentiable atreal x)}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] LEBESGUE_DIFFERENTIATION_THEOREM_DECREASING) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[GSYM IS_REALINTERVAL_IS_INTERVAL; o_THM; LIFT_DROP] THEN REWRITE_TAC[real_negligible] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[REAL_DIFFERENTIABLE_AT] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Lebesgue density theorem. This isn't about R specifically, but it's most *) (* naturally stated as a real limit so it ends up here in this file. *) (* ------------------------------------------------------------------------- *) let LEBESGUE_DENSITY_THEOREM = prove (`!s:real^N->bool. lebesgue_measurable s ==> ?k. negligible k /\ !x. ~(x IN k) ==> ((\e. measure(s INTER cball(x,e)) / measure(cball(x,e))) ---> (if x IN s then &1 else &0)) (atreal(&0) within {e | &0 < e})`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_DENSITY_THEOREM_LIFT_CBALL) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[REALLIM_WITHINREAL; LIM_WITHIN] THEN REWRITE_TAC[FORALL_LIFT; IN_ELIM_THM; LIFT_DROP; DIST_1] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RAND] THEN REWRITE_TAC[DROP_VEC]);; hol-light/Multivariate/tarski.ml000066400000000000000000000327351303454263000172540ustar00rootroot00000000000000(* ========================================================================= *) (* Proof that Tarski's axioms for geometry hold in Euclidean space. *) (* ========================================================================= *) needs "Multivariate/convex.ml";; (* ------------------------------------------------------------------------- *) (* Axiom 1 (reflexivity for equidistance). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_1_EUCLIDEAN = prove (`!a b:real^2. dist(a,b) = dist(b,a)`, NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Axiom 2 (transitivity for equidistance). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_2_EUCLIDEAN = prove (`!a b p q r s. dist(a,b) = dist(p,q) /\ dist(a,b) = dist(r,s) ==> dist(p,q) = dist(r,s)`, REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Axiom 3 (identity for equidistance). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_3_EUCLIDEAN = prove (`!a b c. dist(a,b) = dist(c,c) ==> a = b`, NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Axiom 4 (segment construction). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_4_EUCLIDEAN = prove (`!a q b c:real^2. ?x:real^2. between a (q,x) /\ dist(a,x) = dist(b,c)`, GEOM_ORIGIN_TAC `a:real^2` THEN REPEAT GEN_TAC THEN REWRITE_TAC[DIST_0] THEN ASM_CASES_TAC `q:real^2 = vec 0` THENL [ASM_SIMP_TAC[BETWEEN_REFL; VECTOR_CHOOSE_SIZE; DIST_POS_LE]; EXISTS_TAC `--(dist(b:real^2,c) / norm(q) % q):real^2` THEN REWRITE_TAC[between; DIST_0] THEN REWRITE_TAC[dist; NORM_MUL; NORM_NEG; REAL_ABS_DIV; REAL_ABS_NORM; VECTOR_ARITH `q - --(a % q) = (&1 + a) % q`] THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_RING `a = &1 + b ==> a * q = q + b * q`) THEN SIMP_TAC[REAL_ABS_REFL; REAL_POS; REAL_LE_ADD; REAL_LE_DIV; NORM_POS_LE]; ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0]]]);; (* ------------------------------------------------------------------------- *) (* Axiom 5 (five-segments axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_5_EUCLIDEAN = prove (`!a b c x:real^2 a' b' c' x':real^2. ~(a = b) /\ dist(a,b) = dist(a',b') /\ dist(a,c) = dist(a',c') /\ dist(b,c) = dist(b',c') /\ between b (a,x) /\ between b' (a',x') /\ dist(b,x) = dist(b',x') ==> dist(c,x) = dist(c',x')`, let lemma = prove (`!a b x y:real^N. ~(b = a) /\ between b (a,x) /\ between b (a,y) /\ dist(b,x) = dist(b,y) ==> x = y`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] BETWEEN_EXISTS_EXTENSION))) THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `dist(b:real^N,x) = dist(b,y)` THEN ASM_REWRITE_TAC[NORM_ARITH `dist(b:real^N,b + x) = norm x`; NORM_MUL] THEN ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; NORM_EQ_0; real_abs; VECTOR_SUB_EQ]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`; `a':real^2`; `b':real^2`; `c':real^2`] RIGID_TRANSFORMATION_BETWEEN_3) THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_EQ_0; DIST_SYM]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^2` (X_CHOOSE_THEN `f:real^2->real^2` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN SUBST_ALL_TAC) THEN SUBGOAL_THEN `x' = k + (f:real^2->real^2) x` SUBST1_TAC THENL [MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC [`k + (f:real^2->real^2) a`; `k + (f:real^2->real^2) b`]; ALL_TAC] THEN ASM_REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`; BETWEEN_TRANSLATION; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_MESON_TAC[BETWEEN_TRANSLATION; orthogonal_transformation; NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`; ORTHOGONAL_TRANSFORMATION_ISOMETRY; BETWEEN_LINEAR_IMAGE_EQ; DIST_EQ_0; ORTHOGONAL_TRANSFORMATION_INJECTIVE]);; (* ------------------------------------------------------------------------- *) (* Axiom 6 (identity for between-ness). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_6_EUCLIDEAN = prove (`!a b. between b (a,a) ==> a = b`, SIMP_TAC[BETWEEN_REFL_EQ]);; (* ------------------------------------------------------------------------- *) (* Axiom 7 (Pasch's axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_7_EUCLIDEAN = prove (`!a b c p q:real^2. between p (a,c) /\ between q (b,c) ==> ?x. between x (p,b) /\ between x (q,a)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `q:real^2 = c` THENL [ASM_MESON_TAC[BETWEEN_REFL; BETWEEN_SYM]; POP_ASSUM MP_TAC] THEN ASM_CASES_TAC `p:real^2 = a /\ b:real^2 = q` THENL [ASM_MESON_TAC[BETWEEN_REFL; BETWEEN_SYM]; POP_ASSUM MP_TAC] THEN GEOM_ORIGIN_TAC `a:real^2` THEN GEOM_NORMALIZE_TAC `q:real^2` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[BETWEEN_REFL_EQ] THEN REWRITE_TAC[UNWIND_THM2; between; DIST_0] THEN NORM_ARITH_TAC; ALL_TAC] THEN GEOM_BASIS_MULTIPLE_TAC 1 `q:real^2` THEN SIMP_TAC [NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_2; ARITH; REAL_MUL_RID] THEN GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN SIMP_TAC[VECTOR_MUL_LID] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[BETWEEN_SYM] THEN DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC o REWRITE_RULE[BETWEEN_IN_SEGMENT; IN_SEGMENT]) (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BETWEEN_EXISTS_EXTENSION))) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN SUBGOAL_THEN `&0 < &1 - d + e` ASSUME_TAC THENL [ASM_CASES_TAC `d = &1 /\ e = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_eq o concl))) THEN ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN ASM_REWRITE_TAC[VECTOR_ADD_RID; IMP_IMP]; EXISTS_TAC `(&1 - d + e - d * e) / (&1 - d + e) % basis 1:real^2` THEN CONJ_TAC THENL [EXISTS_TAC `e / (&1 - d + e)` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; BASIS_COMPONENT; VEC_COMPONENT; ARITH; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN UNDISCH_TAC `&0 < &1 - d + e` THEN CONV_TAC REAL_FIELD; EXISTS_TAC `(&1 - d + e - d * e) / (&1 - d + e)` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN SUBGOAL_THEN `&0 <= (&1 - d) * (&1 + e) /\ &0 <= d * e` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL; ALL_TAC] THEN ASM_REAL_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Axiom 8 (lower 2-dimensional axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_8_EUCLIDEAN = prove (`?a b c:real^2. ~between b (a,c) /\ ~between c (b,a) /\ ~between a (c,b)`, REWRITE_TAC[GSYM DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[BETWEEN_SYM] THEN REWRITE_TAC[GSYM COLLINEAR_BETWEEN_CASES; COLLINEAR_3_2D] THEN MAP_EVERY EXISTS_TAC [`vec 0:real^2`; `basis 1:real^2`; `basis 2:real^2`] THEN SIMP_TAC[BASIS_COMPONENT; VEC_COMPONENT; DIMINDEX_2; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Axiom 9 (upper 2-dimensional axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_9_EUCLIDEAN = prove (`!p q a b c:real^2. ~(p = q) /\ dist(a,p) = dist(a,q) /\ dist(b,p) = dist(b,q) /\ dist(c,p) = dist(c,q) ==> between b (a,c) \/ between c (b,a) \/ between a (c,b)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[BETWEEN_SYM] THEN REWRITE_TAC[GSYM COLLINEAR_BETWEEN_CASES] THEN REWRITE_TAC[dist; NORM_EQ; NORM_ARITH `~(p = q) <=> ~(norm(p - q) = &0)`] THEN ONCE_REWRITE_TAC[REAL_RING `~(x = &0) <=> ~(x pow 2 = &0)`] THEN REWRITE_TAC[NORM_POW_2; COLLINEAR_3_2D] THEN REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* Axiom 10 (Euclidean axiom). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_10_EUCLIDEAN = prove (`!a b c d t:real^N. between d (a,t) /\ between d (b,c) /\ ~(a = d) ==> ?x y. between b (a,x) /\ between c (a,y) /\ between t (x,y)`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`vec 0:real^N`; `d:real^N`; `t:real^N`] BETWEEN_EXISTS_EXTENSION) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_ARITH `d + u % (d - vec 0):real^N = (&1 + u) % d`] THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(&1 + u) % b:real^N`; `(&1 + u) % c:real^N`] THEN ASM_REWRITE_TAC[between; dist; GSYM VECTOR_SUB_LDISTRIB] THEN ASM_REWRITE_TAC[VECTOR_SUB_LZERO; NORM_NEG; VECTOR_ARITH `b - (&1 + u) % b:real^N = --(u % b)`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_LE_ADD; REAL_POS; real_abs] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; REAL_EQ_MUL_LCANCEL] THEN ASM_REWRITE_TAC[GSYM dist; GSYM between] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Axiom 11 (Continuity). *) (* ------------------------------------------------------------------------- *) let TARSKI_AXIOM_11_EUCLIDEAN = prove (`!X Y:real^2->bool. (?a. !x y. x IN X /\ y IN Y ==> between x (a,y)) ==> (?b. !x y. x IN X /\ y IN Y ==> between b (x,y))`, REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEOM_ORIGIN_TAC `a:real^2` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `!x:real^2. x IN X ==> x = vec 0` THENL [ASM_MESON_TAC[BETWEEN_REFL]; POP_ASSUM MP_TAC] THEN ASM_CASES_TAC `Y:real^2->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN SUBGOAL_THEN `?c:real^2. c IN Y` (CHOOSE_THEN MP_TAC) THENL [ASM SET_TAC[]; REPEAT(POP_ASSUM MP_TAC)] THEN GEOM_BASIS_MULTIPLE_TAC 1 `c:real^2` THEN X_GEN_TAC `c:real` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^2` STRIP_ASSUME_TAC) THEN DISCH_THEN(LABEL_TAC "*") THEN SUBGOAL_THEN `X SUBSET IMAGE (\c. c % basis 1:real^2) {c | &0 <= c} /\ Y SUBSET IMAGE (\c. c % basis 1:real^2) {c | &0 <= c}` MP_TAC THENL [REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^2`; `c % basis 1:real^2`]) THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN ASM_MESON_TAC[VECTOR_MUL_ASSOC; REAL_LE_MUL]; DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `~(z:real^2 = vec 0)` THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPECL [`z:real^2`; `y:real^2`]) THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC] THEN REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN ASM_CASES_TAC `u = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_EQ_0] THEN STRIP_TAC THEN EXISTS_TAC `inv(u) * d:real` THEN ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]]; REWRITE_TAC[SUBSET_IMAGE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t:real->bool` STRIP_ASSUME_TAC)) THEN REMOVE_THEN "*" MP_TAC THEN ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN DISCH_THEN(fun th -> EXISTS_TAC `sup s % basis 1 :real^2` THEN MP_TAC th) THEN REWRITE_TAC[between; dist; NORM_ARITH `norm(vec 0 - x) = norm x`] THEN REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ &0 <= y ==> (abs y = abs x + abs(x - y) <=> x <= y)`] THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= s /\ s <= y ==> abs(x - y) = abs(x - s) + abs(s - y)`) THEN MP_TAC(SPEC `s:real->bool` SUP) THEN ASM_MESON_TAC[IMAGE_EQ_EMPTY; MEMBER_NOT_EMPTY]]);; hol-light/Multivariate/topology.ml000066400000000000000000063104231303454263000176320ustar00rootroot00000000000000(* ========================================================================= *) (* Elementary topology in Euclidean space. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Valentina Bruno 2010 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "Library/card.ml";; needs "Library/iter.ml";; needs "Multivariate/metric.ml";; needs "Multivariate/determinants.ml";; (* ------------------------------------------------------------------------- *) (* The universal Euclidean topology that we use most of the time. *) (* ------------------------------------------------------------------------- *) let open_def = new_definition `open s <=> !x. x IN s ==> ?e. &0 < e /\ !x'. dist(x',x) < e ==> x' IN s`;; let closed = new_definition `closed(s:real^N->bool) <=> open(UNIV DIFF s)`;; let euclidean = new_definition `euclidean = topology open`;; let OPEN_EMPTY = prove (`open {}`, REWRITE_TAC[open_def; NOT_IN_EMPTY]);; let OPEN_UNIV = prove (`open(:real^N)`, REWRITE_TAC[open_def; IN_UNIV] THEN MESON_TAC[REAL_LT_01]);; let OPEN_INTER = prove (`!s t. open s /\ open t ==> open (s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[open_def; AND_FORALL_THM; IN_INTER] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_MESON_TAC[REAL_LT_TRANS]);; let OPEN_UNIONS = prove (`(!s. s IN f ==> open s) ==> open(UNIONS f)`, REWRITE_TAC[open_def; IN_UNIONS] THEN MESON_TAC[]);; let OPEN_EXISTS_IN = prove (`!P Q:A->real^N->bool. (!a. P a ==> open {x | Q a x}) ==> open {x | ?a. P a /\ Q a x}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `open(UNIONS {{x | Q (a:A) (x:real^N)} | P a})` MP_TAC THENL [MATCH_MP_TAC OPEN_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]);; let OPEN_EXISTS = prove (`!Q:A->real^N->bool. (!a. open {x | Q a x}) ==> open {x | ?a. Q a x}`, MP_TAC(ISPEC `\x:A. T` OPEN_EXISTS_IN) THEN REWRITE_TAC[]);; let OPEN_IN = prove (`!s:real^N->bool. open s <=> open_in euclidean s`, GEN_TAC THEN REWRITE_TAC[euclidean] THEN CONV_TAC SYM_CONV THEN AP_THM_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 topology_tybij)] THEN REWRITE_TAC[REWRITE_RULE[IN] istopology] THEN REWRITE_TAC[OPEN_EMPTY; OPEN_INTER; SUBSET] THEN MESON_TAC[IN; OPEN_UNIONS]);; let OPEN_RELATIVE_TO = prove (`!s t:real^N->bool. (open relative_to s) t <=> open_in (subtopology euclidean s) t`, REWRITE_TAC[GSYM OPEN_IN_RELATIVE_TO] THEN REWRITE_TAC[relative_to; OPEN_IN]);; let TOPSPACE_EUCLIDEAN = prove (`topspace euclidean = (:real^N)`, REWRITE_TAC[topspace; EXTENSION; IN_UNIV; IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[OPEN_UNIV; IN_UNIV; OPEN_IN]);; let TOPSPACE_EUCLIDEAN_SUBTOPOLOGY = prove (`!s. topspace (subtopology euclidean s) = s`, REWRITE_TAC[TOPSPACE_EUCLIDEAN; TOPSPACE_SUBTOPOLOGY; INTER_UNIV]);; let OPEN_IN_REFL = prove (`!s:real^N->bool. open_in (subtopology euclidean s) s`, REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; let CLOSED_IN_REFL = prove (`!s:real^N->bool. closed_in (subtopology euclidean s) s`, REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; let CLOSED_IN = prove (`!s:real^N->bool. closed s <=> closed_in euclidean s`, REWRITE_TAC[closed; closed_in; TOPSPACE_EUCLIDEAN; OPEN_IN; SUBSET_UNIV]);; let CLOSED_RELATIVE_TO = prove (`!s t:real^N->bool. (closed relative_to s) t <=> closed_in (subtopology euclidean s) t`, REWRITE_TAC[GSYM CLOSED_IN_RELATIVE_TO] THEN REWRITE_TAC[relative_to; CLOSED_IN]);; let OPEN_UNION = prove (`!s t. open s /\ open t ==> open(s UNION t)`, REWRITE_TAC[OPEN_IN; OPEN_IN_UNION]);; let OPEN_SUBOPEN = prove (`!s. open s <=> !x. x IN s ==> ?t. open t /\ x IN t /\ t SUBSET s`, REWRITE_TAC[OPEN_IN; GSYM OPEN_IN_SUBOPEN]);; let CLOSED_EMPTY = prove (`closed {}`, REWRITE_TAC[CLOSED_IN; CLOSED_IN_EMPTY]);; let CLOSED_UNIV = prove (`closed(UNIV:real^N->bool)`, REWRITE_TAC[CLOSED_IN; GSYM TOPSPACE_EUCLIDEAN; CLOSED_IN_TOPSPACE]);; let CLOSED_UNION = prove (`!s t. closed s /\ closed t ==> closed(s UNION t)`, REWRITE_TAC[CLOSED_IN; CLOSED_IN_UNION]);; let CLOSED_INTER = prove (`!s t. closed s /\ closed t ==> closed(s INTER t)`, REWRITE_TAC[CLOSED_IN; CLOSED_IN_INTER]);; let CLOSED_INTERS = prove (`!f. (!s:real^N->bool. s IN f ==> closed s) ==> closed(INTERS f)`, REWRITE_TAC[CLOSED_IN] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_SIMP_TAC[CLOSED_IN_INTERS; INTERS_0] THEN REWRITE_TAC[GSYM TOPSPACE_EUCLIDEAN; CLOSED_IN_TOPSPACE]);; let CLOSED_FORALL_IN = prove (`!P Q:A->real^N->bool. (!a. P a ==> closed {x | Q a x}) ==> closed {x | !a. P a ==> Q a x}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `closed(INTERS {{x | Q (a:A) (x:real^N)} | P a})` MP_TAC THENL [MATCH_MP_TAC CLOSED_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]]);; let CLOSED_FORALL = prove (`!Q:A->real^N->bool. (!a. closed {x | Q a x}) ==> closed {x | !a. Q a x}`, MP_TAC(ISPEC `\x:A. T` CLOSED_FORALL_IN) THEN REWRITE_TAC[]);; let OPEN_CLOSED = prove (`!s:real^N->bool. open s <=> closed(UNIV DIFF s)`, SIMP_TAC[OPEN_IN; CLOSED_IN; TOPSPACE_EUCLIDEAN; SUBSET_UNIV; OPEN_IN_CLOSED_IN_EQ]);; let OPEN_DIFF = prove (`!s t. open s /\ closed t ==> open(s DIFF t)`, REWRITE_TAC[OPEN_IN; CLOSED_IN; OPEN_IN_DIFF]);; let CLOSED_DIFF = prove (`!s t. closed s /\ open t ==> closed(s DIFF t)`, REWRITE_TAC[OPEN_IN; CLOSED_IN; CLOSED_IN_DIFF]);; let OPEN_INTERS = prove (`!s. FINITE s /\ (!t. t IN s ==> open t) ==> open(INTERS s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INTERS_INSERT; INTERS_0; OPEN_UNIV; IN_INSERT] THEN MESON_TAC[OPEN_INTER]);; let CLOSED_UNIONS = prove (`!s. FINITE s /\ (!t. t IN s ==> closed t) ==> closed(UNIONS s)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_INSERT; UNIONS_0; CLOSED_EMPTY; IN_INSERT] THEN MESON_TAC[CLOSED_UNION]);; let CLOSED_LOCALLY_FINITE_UNIONS = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> closed s) /\ (!x. ?u. open u /\ x IN u /\ FINITE {s | s IN f /\ ~(s INTER u = {})}) ==> closed(UNIONS f)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`euclidean:(real^N)topology`; `f:(real^N->bool)->bool`] CLOSED_IN_LOCALLY_FINITE_UNIONS) THEN REWRITE_TAC[GSYM OPEN_IN; GSYM CLOSED_IN] THEN ASM_REWRITE_TAC[IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Open and closed balls and spheres. *) (* ------------------------------------------------------------------------- *) let ball = new_definition `ball(x,e) = { y | dist(x,y) < e}`;; let cball = new_definition `cball(x,e) = { y | dist(x,y) <= e}`;; let sphere = new_definition `sphere(x,e) = { y | dist(x,y) = e}`;; let IN_BALL = prove (`!x y e. y IN ball(x,e) <=> dist(x,y) < e`, REWRITE_TAC[ball; IN_ELIM_THM]);; let IN_CBALL = prove (`!x y e. y IN cball(x,e) <=> dist(x,y) <= e`, REWRITE_TAC[cball; IN_ELIM_THM]);; let IN_SPHERE = prove (`!x y e. y IN sphere(x,e) <=> dist(x,y) = e`, REWRITE_TAC[sphere; IN_ELIM_THM]);; let IN_BALL_0 = prove (`!x e. x IN ball(vec 0,e) <=> norm(x) < e`, REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; let IN_CBALL_0 = prove (`!x e. x IN cball(vec 0,e) <=> norm(x) <= e`, REWRITE_TAC[IN_CBALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; let IN_SPHERE_0 = prove (`!x e. x IN sphere(vec 0,e) <=> norm(x) = e`, REWRITE_TAC[IN_SPHERE; dist; VECTOR_SUB_LZERO; NORM_NEG]);; let BALL_TRIVIAL = prove (`!x. ball(x,&0) = {}`, REWRITE_TAC[EXTENSION; IN_BALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; let CBALL_TRIVIAL = prove (`!x. cball(x,&0) = {x}`, REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; let CENTRE_IN_CBALL = prove (`!x e. x IN cball(x,e) <=> &0 <= e`, MESON_TAC[IN_CBALL; DIST_REFL]);; let BALL_SUBSET_CBALL = prove (`!x e. ball(x,e) SUBSET cball(x,e)`, REWRITE_TAC[IN_BALL; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);; let SPHERE_SUBSET_CBALL = prove (`!x e. sphere(x,e) SUBSET cball(x,e)`, REWRITE_TAC[IN_SPHERE; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);; let SUBSET_BALL = prove (`!x d e. d <= e ==> ball(x,d) SUBSET ball(x,e)`, REWRITE_TAC[SUBSET; IN_BALL] THEN MESON_TAC[REAL_LTE_TRANS]);; let SUBSET_CBALL = prove (`!x d e. d <= e ==> cball(x,d) SUBSET cball(x,e)`, REWRITE_TAC[SUBSET; IN_CBALL] THEN MESON_TAC[REAL_LE_TRANS]);; let BALL_MAX_UNION = prove (`!a r s. ball(a,max r s) = ball(a,r) UNION ball(a,s)`, REWRITE_TAC[IN_BALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; let BALL_MIN_INTER = prove (`!a r s. ball(a,min r s) = ball(a,r) INTER ball(a,s)`, REWRITE_TAC[IN_BALL; IN_INTER; EXTENSION] THEN REAL_ARITH_TAC);; let CBALL_MAX_UNION = prove (`!a r s. cball(a,max r s) = cball(a,r) UNION cball(a,s)`, REWRITE_TAC[IN_CBALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; let CBALL_MIN_INTER = prove (`!x d e. cball(x,min d e) = cball(x,d) INTER cball(x,e)`, REWRITE_TAC[EXTENSION; IN_INTER; IN_CBALL] THEN REAL_ARITH_TAC);; let BALL_TRANSLATION = prove (`!a x r. ball(a + x,r) = IMAGE (\y. a + y) (ball(x,r))`, REWRITE_TAC[ball] THEN GEOM_TRANSLATE_TAC[]);; let CBALL_TRANSLATION = prove (`!a x r. cball(a + x,r) = IMAGE (\y. a + y) (cball(x,r))`, REWRITE_TAC[cball] THEN GEOM_TRANSLATE_TAC[]);; let SPHERE_TRANSLATION = prove (`!a x r. sphere(a + x,r) = IMAGE (\y. a + y) (sphere(x,r))`, REWRITE_TAC[sphere] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [BALL_TRANSLATION; CBALL_TRANSLATION; SPHERE_TRANSLATION];; let BALL_LINEAR_IMAGE = prove (`!f:real^M->real^N x r. linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) ==> ball(f x,r) = IMAGE f (ball(x,r))`, REWRITE_TAC[ball] THEN GEOM_TRANSFORM_TAC[]);; let CBALL_LINEAR_IMAGE = prove (`!f:real^M->real^N x r. linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) ==> cball(f x,r) = IMAGE f (cball(x,r))`, REWRITE_TAC[cball] THEN GEOM_TRANSFORM_TAC[]);; let SPHERE_LINEAR_IMAGE = prove (`!f:real^M->real^N x r. linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) ==> sphere(f x,r) = IMAGE f (sphere(x,r))`, REWRITE_TAC[sphere] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [BALL_LINEAR_IMAGE; CBALL_LINEAR_IMAGE; SPHERE_LINEAR_IMAGE];; let BALL_SCALING = prove (`!c. &0 < c ==> !x r. ball(c % x,c * r) = IMAGE (\x. c % x) (ball(x,r))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[IN_BALL; DIST_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LT_LMUL_EQ]);; let CBALL_SCALING = prove (`!c. &0 < c ==> !x r. cball(c % x,c * r) = IMAGE (\x. c % x) (cball(x,r))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[IN_CBALL; DIST_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LE_LMUL_EQ]);; let SPHERE_SCALING = prove (`!c. &0 < c ==> !x r. sphere(c % x,c * r) = IMAGE (\x. c % x) (sphere(x,r))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[IN_SPHERE; DIST_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_EQ_MUL_LCANCEL; REAL_LT_IMP_NZ]);; add_scaling_theorems [BALL_SCALING; CBALL_SCALING; SPHERE_SCALING];; let CBALL_DIFF_BALL = prove (`!a r. cball(a,r) DIFF ball(a,r) = sphere(a,r)`, REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let BALL_UNION_SPHERE = prove (`!a r. ball(a,r) UNION sphere(a,r) = cball(a,r)`, REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let SPHERE_UNION_BALL = prove (`!a r. sphere(a,r) UNION ball(a,r) = cball(a,r)`, REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CBALL_DIFF_SPHERE = prove (`!a r. cball(a,r) DIFF sphere(a,r) = ball(a,r)`, REWRITE_TAC[EXTENSION; IN_DIFF; IN_SPHERE; IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let OPEN_BALL = prove (`!x e. open(ball(x,e))`, REWRITE_TAC[open_def; ball; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN MESON_TAC[REAL_SUB_LT; REAL_LT_SUB_LADD; REAL_ADD_SYM; REAL_LET_TRANS; DIST_TRIANGLE_ALT]);; let CENTRE_IN_BALL = prove (`!x e. x IN ball(x,e) <=> &0 < e`, MESON_TAC[IN_BALL; DIST_REFL]);; let OPEN_CONTAINS_BALL = prove (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ ball(x,e) SUBSET s`, REWRITE_TAC[open_def; SUBSET; IN_BALL] THEN REWRITE_TAC[DIST_SYM]);; let OPEN_CONTAINS_BALL_EQ = prove (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ ball(x,e) SUBSET s)`, MESON_TAC[OPEN_CONTAINS_BALL; SUBSET; CENTRE_IN_BALL]);; let BALL_EQ_EMPTY = prove (`!x e. (ball(x,e) = {}) <=> e <= &0`, REWRITE_TAC[EXTENSION; IN_BALL; NOT_IN_EMPTY; REAL_NOT_LT] THEN MESON_TAC[DIST_POS_LE; REAL_LE_TRANS; DIST_REFL]);; let BALL_EMPTY = prove (`!x e. e <= &0 ==> ball(x,e) = {}`, REWRITE_TAC[BALL_EQ_EMPTY]);; let OPEN_CONTAINS_CBALL = prove (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ cball(x,e) SUBSET s`, GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN SUBGOAL_THEN `e / &2 < e` (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS]) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; let OPEN_CONTAINS_CBALL_EQ = prove (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ cball(x,e) SUBSET s)`, MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET; REAL_LT_IMP_LE; CENTRE_IN_CBALL]);; let SPHERE_EQ_EMPTY = prove (`!a:real^N r. sphere(a,r) = {} <=> r < &0`, REWRITE_TAC[sphere; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN MESON_TAC[VECTOR_CHOOSE_DIST; REAL_NOT_LE]);; let SPHERE_EMPTY = prove (`!a:real^N r. r < &0 ==> sphere(a,r) = {}`, REWRITE_TAC[SPHERE_EQ_EMPTY]);; let NEGATIONS_BALL = prove (`!r. IMAGE (--) (ball(vec 0:real^N,r)) = ball(vec 0,r)`, GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_BALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; let NEGATIONS_CBALL = prove (`!r. IMAGE (--) (cball(vec 0:real^N,r)) = cball(vec 0,r)`, GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_CBALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; let NEGATIONS_SPHERE = prove (`!r. IMAGE (--) (sphere(vec 0:real^N,r)) = sphere(vec 0,r)`, GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_SPHERE_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; let ORTHOGONAL_TRANSFORMATION_BALL = prove (`!f:real^N->real^N r. orthogonal_transformation f ==> IMAGE f (ball(vec 0,r)) = ball(vec 0,r)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL_0] THEN MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; let ORTHOGONAL_TRANSFORMATION_CBALL = prove (`!f:real^N->real^N r. orthogonal_transformation f ==> IMAGE f (cball(vec 0,r)) = cball(vec 0,r)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL_0] THEN MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; let ORTHOGONAL_TRANSFORMATION_SPHERE = prove (`!f:real^N->real^N r. orthogonal_transformation f ==> IMAGE f (sphere(vec 0,r)) = sphere(vec 0,r)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPHERE_0] THEN MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; (* ------------------------------------------------------------------------- *) (* Basic "localization" results are handy for connectedness. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_OPEN = prove (`!s:real^N->bool u. open_in (subtopology euclidean u) s <=> ?t. open t /\ (s = u INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; GSYM OPEN_IN] THEN REWRITE_TAC[INTER_ACI]);; let OPEN_IN_INTER_OPEN = prove (`!s t u:real^N->bool. open_in (subtopology euclidean u) s /\ open t ==> open_in (subtopology euclidean u) (s INTER t)`, REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTER_ASSOC] THEN ASM_MESON_TAC[OPEN_INTER]);; let OPEN_IN_OPEN_INTER = prove (`!u s. open s ==> open_in (subtopology euclidean u) (u INTER s)`, REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[]);; let OPEN_OPEN_IN_TRANS = prove (`!s t. open s /\ open t /\ t SUBSET s ==> open_in (subtopology euclidean s) t`, MESON_TAC[OPEN_IN_OPEN_INTER; SET_RULE `t SUBSET s ==> t = s INTER t`]);; let OPEN_SUBSET = prove (`!s t:real^N->bool. s SUBSET t /\ open s ==> open_in (subtopology euclidean t) s`, REWRITE_TAC[GSYM OPEN_RELATIVE_TO; RELATIVE_TO_SUBSET]);; let CLOSED_IN_DIFF_OPEN = prove (`!s t. open t ==> closed_in (subtopology euclidean s) (s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL; OPEN_IN_OPEN_INTER]);; let CLOSED_IN_CLOSED = prove (`!s:real^N->bool u. closed_in (subtopology euclidean u) s <=> ?t. closed t /\ (s = u INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY; GSYM CLOSED_IN] THEN REWRITE_TAC[INTER_ACI]);; let CLOSED_SUBSET_EQ = prove (`!u s:real^N->bool. closed s ==> (closed_in (subtopology euclidean u) s <=> s SUBSET u)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]]);; let CLOSED_IN_INTER_CLOSED = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed t ==> closed_in (subtopology euclidean u) (s INTER t)`, REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTER_ASSOC] THEN ASM_MESON_TAC[CLOSED_INTER]);; let CLOSED_IN_CLOSED_INTER = prove (`!u s. closed s ==> closed_in (subtopology euclidean u) (u INTER s)`, REWRITE_TAC[CLOSED_IN_CLOSED] THEN MESON_TAC[]);; let CLOSED_SUBSET = prove (`!s t:real^N->bool. s SUBSET t /\ closed s ==> closed_in (subtopology euclidean t) s`, REWRITE_TAC[GSYM CLOSED_RELATIVE_TO; RELATIVE_TO_SUBSET]);; let OPEN_IN_DIFF_CLOSED = prove (`!s t. closed t ==> open_in (subtopology euclidean s) (s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_CLOSED_INTER]);; let OPEN_IN_SUBSET_TRANS = prove (`!s t u:real^N->bool. open_in (subtopology euclidean u) s /\ s SUBSET t /\ t SUBSET u ==> open_in (subtopology euclidean t) s`, REWRITE_TAC[GSYM OPEN_RELATIVE_TO; RELATIVE_TO_SUBSET_TRANS]);; let CLOSED_IN_SUBSET_TRANS = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ s SUBSET t /\ t SUBSET u ==> closed_in (subtopology euclidean t) s`, REWRITE_TAC[GSYM CLOSED_RELATIVE_TO; RELATIVE_TO_SUBSET_TRANS]);; let open_in = prove (`!u s:real^N->bool. open_in (subtopology euclidean u) s <=> s SUBSET u /\ !x. x IN s ==> ?e. &0 < e /\ !x'. x' IN u /\ dist(x',x) < e ==> x' IN s`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; GSYM OPEN_IN] THEN EQ_TAC THENL [REWRITE_TAC[open_def] THEN ASM SET_TAC[INTER_SUBSET; IN_INTER]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `d:real^N->real`) THEN EXISTS_TAC `UNIONS {b | ?x:real^N. (b = ball(x,d x)) /\ x IN s}` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_UNIONS THEN ASM_SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM; OPEN_BALL]; GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTER; IN_UNIONS; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET; DIST_REFL; DIST_SYM; IN_BALL]]);; let OPEN_IN_CONTAINS_BALL = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s <=> s SUBSET t /\ !x. x IN s ==> ?e. &0 < e /\ ball(x,e) INTER t SUBSET s`, REWRITE_TAC[open_in; INTER; SUBSET; IN_ELIM_THM; IN_BALL] THEN MESON_TAC[DIST_SYM]);; let OPEN_IN_CONTAINS_CBALL = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s <=> s SUBSET t /\ !x. x IN s ==> ?e. &0 < e /\ cball(x,e) INTER t SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN AP_TERM_TAC THEN REWRITE_TAC[IN_BALL; IN_INTER; SUBSET; IN_CBALL] THEN MESON_TAC[REAL_ARITH `&0 < e ==> &0 < e / &2 /\ (x <= e / &2 ==> x < e)`; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* These "transitivity" results are handy too. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_TRANS = prove (`!s t u. open_in (subtopology euclidean t) s /\ open_in (subtopology euclidean u) t ==> open_in (subtopology euclidean u) s`, ASM_MESON_TAC[OPEN_IN_OPEN; OPEN_IN; OPEN_INTER; INTER_ASSOC]);; let OPEN_IN_TRANS_EQ = prove (`!s t:real^N->bool. (!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) t) <=> open_in (subtopology euclidean s) t`, MESON_TAC[OPEN_IN_TRANS; OPEN_IN_REFL]);; let OPEN_IN_OPEN_TRANS = prove (`!s t. open_in (subtopology euclidean t) s /\ open t ==> open s`, REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] OPEN_IN] THEN REWRITE_TAC[OPEN_IN_TRANS]);; let CLOSED_IN_TRANS = prove (`!s t u. closed_in (subtopology euclidean t) s /\ closed_in (subtopology euclidean u) t ==> closed_in (subtopology euclidean u) s`, ASM_MESON_TAC[CLOSED_IN_CLOSED; CLOSED_IN; CLOSED_INTER; INTER_ASSOC]);; let CLOSED_IN_TRANS_EQ = prove (`!s t:real^N->bool. (!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) t) <=> closed_in (subtopology euclidean s) t`, MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_REFL]);; let CLOSED_IN_CLOSED_TRANS = prove (`!s t. closed_in (subtopology euclidean t) s /\ closed t ==> closed s`, REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] CLOSED_IN] THEN REWRITE_TAC[CLOSED_IN_TRANS]);; let CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET = prove (`!s u v:real^N->bool. closed_in (subtopology euclidean u) (u INTER s) /\ v SUBSET u ==> closed_in (subtopology euclidean v) (v INTER s)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; let OPEN_IN_OPEN_EQ = prove (`!s t. open s ==> (open_in (subtopology euclidean s) t <=> open t /\ t SUBSET s)`, MESON_TAC[OPEN_OPEN_IN_TRANS; OPEN_IN_OPEN_TRANS; open_in]);; let CLOSED_IN_CLOSED_EQ = prove (`!s t. closed s ==> (closed_in (subtopology euclidean s) t <=> closed t /\ t SUBSET s)`, MESON_TAC[CLOSED_SUBSET; CLOSED_IN_CLOSED_TRANS; closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);; (* ------------------------------------------------------------------------- *) (* Also some invariance theorems for relative topology. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_TRANSLATION_EQ = prove (`!a s t. open_in (subtopology euclidean (IMAGE (\x. a + x) t)) (IMAGE (\x. a + x) s) <=> open_in (subtopology euclidean t) s`, REWRITE_TAC[open_in] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [OPEN_IN_TRANSLATION_EQ];; let CLOSED_IN_TRANSLATION_EQ = prove (`!a s t. closed_in (subtopology euclidean (IMAGE (\x. a + x) t)) (IMAGE (\x. a + x) s) <=> closed_in (subtopology euclidean t) s`, REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [CLOSED_IN_TRANSLATION_EQ];; let OPEN_IN_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> (open_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) <=> open_in (subtopology euclidean t) s)`, REWRITE_TAC[open_in; FORALL_IN_IMAGE; IMP_CONJ; SUBSET] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `(!x y. f x = f y ==> x = y) ==> (!x s. f x IN IMAGE f s <=> x IN s)`)) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS) THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B2:real` THEN STRIP_TAC THEN X_GEN_TAC `B1:real` THEN STRIP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP LINEAR_SUB) THEN ASM_REWRITE_TAC[dist; IMP_IMP] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `e / B1:real`; EXISTS_TAC `e * B2:real`] THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC(REAL_ARITH `norm(f x) <= B1 * norm(x) /\ norm(x) * B1 < e ==> norm(f x) < e`) THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]; MATCH_MP_TAC(REAL_ARITH `norm x <= norm (f x :real^N) / B2 /\ norm(f x) / B2 < e ==> norm x < e`) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ]]);; add_linear_invariants [OPEN_IN_INJECTIVE_LINEAR_IMAGE];; let CLOSED_IN_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> (closed_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) <=> closed_in (subtopology euclidean t) s)`, REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [CLOSED_IN_INJECTIVE_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Euclidean metric. *) (* ------------------------------------------------------------------------- *) let euclidean_metric = new_definition `euclidean_metric = metric ((:real^N), dist)`;; let EUCLIDEAN_METRIC = prove (`mdist (euclidean_metric:(real^N)metric) = dist /\ mspace euclidean_metric = (:real^N)`, SUBGOAL_THEN `is_metric_space ((:real^N),dist)` MP_TAC THENL [REWRITE_TAC[is_metric_space; IN_UNIV; DIST_POS_LE; DIST_EQ_0; DIST_SYM; DIST_TRIANGLE]; SIMP_TAC[euclidean_metric; MDIST; MSPACE]]);; let MBALL_EUCLIDEAN = prove (`!x:real^N r. mball euclidean_metric (x,r) = ball(x,r)`, REWRITE_TAC[EXTENSION; IN_MBALL; IN_BALL; EUCLIDEAN_METRIC; IN_UNIV]);; let MCBALL_EUCLIDEAN = prove (`!x:real^N r. mcball euclidean_metric (x,r) = cball(x,r)`, REWRITE_TAC[EXTENSION; IN_MCBALL; IN_CBALL; EUCLIDEAN_METRIC; IN_UNIV]);; let OPEN_IN_EUCLIDEAN = prove (`open_in (mtopology euclidean_metric) = open:(real^N->bool)->bool`, REWRITE_TAC[FUN_EQ_THM; OPEN_IN_MTOPOLOGY; open_def; EUCLIDEAN_METRIC; SUBSET_UNIV; SUBSET; IN_MBALL; IN_UNIV; DIST_SYM]);; let MTOPOLOGY_EUCLIDEAN_METRIC = prove (`mtopology euclidean_metric = euclidean:(real^N)topology`, REWRITE_TAC[TOPOLOGY_EQ; OPEN_IN_EUCLIDEAN; OPEN_IN]);; let CLOSED_IN_EUCLIDEAN = prove (`closed_in (mtopology euclidean_metric) = closed:(real^N->bool)->bool`, REWRITE_TAC[FUN_EQ_THM; MTOPOLOGY_EUCLIDEAN_METRIC; CLOSED_IN]);; (* ------------------------------------------------------------------------- *) (* Manhattan metric. *) (* ------------------------------------------------------------------------- *) let manhattan = new_definition `manhattan = metric ((:real^N), \(x,y). sum (1..dimindex(:N)) (\i. abs(x$i - y$i)))`;; let MANHATTAN = prove (`mspace manhattan = (:real^N) /\ (!x y. mdist manhattan (x:real^N,y) = sum (1..dimindex(:N)) (\i. abs(x$i - y$i)))`, SUBGOAL_THEN `is_metric_space ((:real^N), \(x,y). sum (1..dimindex(:N)) (\i. abs(x$i - y$i)))` (fun th -> SIMP_TAC[th; manhattan; MSPACE; MDIST]) THEN REWRITE_TAC[is_metric_space; IN_UNIV] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[REAL_ABS_POS]; ALL_TAC] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN EQ_TAC THENL [INTRO_TAC "hp" THEN REWRITE_TAC[CART_EQ] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_ZERO] THEN MATCH_MP_TAC SUM_POS_EQ_0_NUMSEG THEN ASM_REWRITE_TAC[REAL_ABS_POS]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0; SUM_0]]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_SUB]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_ADD_NUMSEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Line segments, with open/closed overloading of (a,b) and [a,b]. *) (* ------------------------------------------------------------------------- *) let closed_segment = define `closed_segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1}`;; let open_segment = new_definition `open_segment(a,b) = closed_segment[a,b] DIFF {a,b}`;; let OPEN_SEGMENT_ALT = prove (`!a b:real^N. ~(a = b) ==> open_segment(a,b) = {(&1 - u) % a + u % b | &0 < u /\ u < &1}`, REPEAT STRIP_TAC THEN REWRITE_TAC[open_segment; closed_segment] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN ASM_CASES_TAC `x:real^N = (&1 - u) % a + u % b` THEN ASM_REWRITE_TAC[REAL_LE_LT; VECTOR_ARITH `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`; VECTOR_ARITH `(&1 - u) % a + u % b = b <=> (&1 - u) % (b - a) = vec 0`; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC);; make_overloadable "segment" `:A`;; overload_interface("segment",`open_segment`);; overload_interface("segment",`closed_segment`);; let segment = prove (`segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1} /\ segment(a,b) = segment[a,b] DIFF {a,b}`, REWRITE_TAC[open_segment; closed_segment]);; let SEGMENT_REFL = prove (`(!a. segment[a,a] = {a}) /\ (!a. segment(a,a) = {})`, REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % a = a`] THEN SET_TAC[REAL_POS]);; let IN_SEGMENT = prove (`!a b x:real^N. (x IN segment[a,b] <=> ?u. &0 <= u /\ u <= &1 /\ x = (&1 - u) % a + u % b) /\ (x IN segment(a,b) <=> ~(a = b) /\ ?u. &0 < u /\ u < &1 /\ x = (&1 - u) % a + u % b)`, REPEAT STRIP_TAC THENL [REWRITE_TAC[segment; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM; CONJ_ASSOC]);; let SEGMENT_SYM = prove (`(!a b:real^N. segment[a,b] = segment[b,a]) /\ (!a b:real^N. segment(a,b) = segment(b,a))`, MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN SIMP_TAC[open_segment] THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[INSERT_AC]] THEN REWRITE_TAC[EXTENSION; IN_SEGMENT] THEN REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN TRY ASM_ARITH_TAC THEN VECTOR_ARITH_TAC);; let ENDS_IN_SEGMENT = prove (`!a b. a IN segment[a,b] /\ b IN segment[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THENL [EXISTS_TAC `&0`; EXISTS_TAC `&1`] THEN (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]));; let ENDS_NOT_IN_SEGMENT = prove (`!a b. ~(a IN segment(a,b)) /\ ~(b IN segment(a,b))`, REWRITE_TAC[open_segment] THEN SET_TAC[]);; let SEGMENT_CLOSED_OPEN = prove (`!a b. segment[a,b] = segment(a,b) UNION {a,b}`, REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s ==> s = (s DIFF {a,b}) UNION {a,b}`) THEN REWRITE_TAC[ENDS_IN_SEGMENT]);; let SEGMENT_OPEN_SUBSET_CLOSED = prove (`!a b. segment(a,b) SUBSET segment[a,b]`, REWRITE_TAC[CONJUNCT2(SPEC_ALL segment)] THEN SET_TAC[]);; let MIDPOINT_IN_SEGMENT = prove (`(!a b:real^N. midpoint(a,b) IN segment[a,b]) /\ (!a b:real^N. midpoint(a,b) IN segment(a,b) <=> ~(a = b))`, REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL [ALL_TAC; ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[]] THEN EXISTS_TAC `&1 / &2` THEN REWRITE_TAC[midpoint] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC);; let BETWEEN_IN_SEGMENT = prove (`!x a b:real^N. between x (a,b) <=> x IN segment[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[between] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING] THENL [NORM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN EQ_TAC THENL [DISCH_THEN(ASSUME_TAC o SYM) THEN EXISTS_TAC `dist(a:real^N,x) / dist(a,b)` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; DIST_POS_LT] THEN CONJ_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN NORM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `dist(a:real^N,b)` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_SUB_LDISTRIB; REAL_DIV_LMUL; DIST_EQ_0] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIST_TRIANGLE_EQ] o SYM) THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[dist; REAL_ARITH `(a + b) * &1 - a = b`] THEN VECTOR_ARITH_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN REWRITE_TAC[VECTOR_ARITH `a - ((&1 - u) % a + u % b) = u % (a - b)`; VECTOR_ARITH `((&1 - u) % a + u % b) - b = (&1 - u) % (a - b)`; NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; let IN_SEGMENT_COMPONENT = prove (`!a b x:real^N i. x IN segment[a,b] /\ 1 <= i /\ i <= dimindex(:N) ==> min (a$i) (b$i) <= x$i /\ x$i <= max (a$i) (b$i)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[REAL_ARITH `c <= u * a + t * b <=> u * --a + t * --b <= --c`] THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REAL_ARITH_TAC);; let SEGMENT_TRANSLATION = prove (`(!c a b. segment[c + a,c + b] = IMAGE (\x. c + x) (segment[a,b])) /\ (!c a b. segment(c + a,c + b) = IMAGE (\x. c + x) (segment(a,b)))`, REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (c + a) + u % (c + b) = c + (&1 - u) % a + u % b`] THEN REWRITE_TAC[VECTOR_ARITH `c + a:real^N = c + b <=> a = b`] THEN MESON_TAC[]);; add_translation_invariants [CONJUNCT1 SEGMENT_TRANSLATION; CONJUNCT2 SEGMENT_TRANSLATION];; let CLOSED_SEGMENT_LINEAR_IMAGE = prove (`!f a b. linear f ==> segment[f a,f b] = IMAGE f (segment[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SEGMENT] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN MESON_TAC[]);; add_linear_invariants [CLOSED_SEGMENT_LINEAR_IMAGE];; let OPEN_SEGMENT_LINEAR_IMAGE = prove (`!f:real^M->real^N a b. linear f /\ (!x y. f x = f y ==> x = y) ==> segment(f a,f b) = IMAGE f (segment(a,b))`, REWRITE_TAC[open_segment] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [OPEN_SEGMENT_LINEAR_IMAGE];; let IN_OPEN_SEGMENT = prove (`!a b x:real^N. x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b)`, REPEAT GEN_TAC THEN REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]);; let IN_OPEN_SEGMENT_ALT = prove (`!a b x:real^N. x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b) /\ ~(a = b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING; NOT_IN_EMPTY] THEN ASM_MESON_TAC[IN_OPEN_SEGMENT]);; let COLLINEAR_DIST_IN_CLOSED_SEGMENT = prove (`!a b x. collinear {x,a,b} /\ dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b) ==> x IN segment[a,b]`, REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; COLLINEAR_DIST_BETWEEN]);; let COLLINEAR_DIST_IN_OPEN_SEGMENT = prove (`!a b x. collinear {x,a,b} /\ dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b) ==> x IN segment(a,b)`, REWRITE_TAC[IN_OPEN_SEGMENT] THEN MESON_TAC[COLLINEAR_DIST_IN_CLOSED_SEGMENT; REAL_LT_LE; DIST_SYM]);; let DIST_IN_CLOSED_SEGMENT,DIST_IN_OPEN_SEGMENT = (CONJ_PAIR o prove) (`(!a b x:real^N. x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)) /\ (!a b x:real^N. x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))`, SIMP_TAC[IN_SEGMENT; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; dist; VECTOR_ARITH `((&1 - u) % a + u % b) - a:real^N = u % (b - a) /\ ((&1 - u) % a + u % b) - b = --(&1 - u) % (b - a)`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; NORM_SUB] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THENL [REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `x * y < y <=> x * y < &1 * y`] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let DIST_DECREASES_OPEN_SEGMENT = prove (`!a b c x:real^N. x IN segment(a,b) ==> dist(c,x) < dist(c,a) \/ dist(c,x) < dist(c,b)`, GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN X_GEN_TAC `b:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN SIMP_TAC[NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID; VECTOR_MUL_LID] THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_SEGMENT; dist] THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN SUBGOAL_THEN `norm((c$1 - u) % basis 1:real^N) < norm((c:real^N)$1 % basis 1:real^N) \/ norm((c$1 - u) % basis 1:real^N) < norm((c$1 - &1) % basis 1:real^N)` MP_TAC THENL [SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[NORM_LT; DOT_LMUL; DOT_RMUL; DOT_BASIS; DIMINDEX_GE_1; DOT_LSUB; DOT_RSUB; LE_REFL; VECTOR_MUL_COMPONENT; VEC_COMPONENT; BASIS_COMPONENT; DOT_LZERO; DOT_RZERO; VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);; let DIST_DECREASES_CLOSED_SEGMENT = prove (`!a b c x:real^N. x IN segment[a,b] ==> dist(c,x) <= dist(c,a) \/ dist(c,x) <= dist(c,b)`, REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[DIST_DECREASES_OPEN_SEGMENT; REAL_LE_REFL; REAL_LT_IMP_LE]);; let DIST_IN_CLOSED_SEGMENT_2 = prove (`!a b x y:real^N. x IN segment[a,b] /\ y IN segment[a,b] ==> dist(x,y) <= dist(a,b)`, REWRITE_TAC[IN_SEGMENT; dist] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; VECTOR_ARITH `((&1 - u) % a + u % b) - ((&1 - v) % a + v % b):real^N = (v - u) % (a - b)`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Connectedness. *) (* ------------------------------------------------------------------------- *) let connected = new_definition `connected s <=> ~(?e1 e2. open e1 /\ open e2 /\ s SUBSET (e1 UNION e2) /\ (e1 INTER e2 INTER s = {}) /\ ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`;; let CONNECTED_CLOSED = prove (`!s:real^N->bool. connected s <=> ~(?e1 e2. closed e1 /\ closed e2 /\ s SUBSET (e1 UNION e2) /\ (e1 INTER e2 INTER s = {}) /\ ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`, GEN_TAC THEN REWRITE_TAC[connected] THEN AP_TERM_TAC THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(:real^N) DIFF v`; `(:real^N) DIFF u`] THEN ASM_REWRITE_TAC[GSYM closed; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; let CONNECTED_OPEN_IN = prove (`!s. connected s <=> ~(?e1 e2. open_in (subtopology euclidean s) e1 /\ open_in (subtopology euclidean s) e2 /\ s SUBSET e1 UNION e2 /\ e1 INTER e2 = {} /\ ~(e1 = {}) /\ ~(e2 = {}))`, GEN_TAC THEN REWRITE_TAC[connected; OPEN_IN_OPEN] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]);; let CONNECTED_OPEN_IN_EQ = prove (`!s. connected s <=> ~(?e1 e2. open_in (subtopology euclidean s) e1 /\ open_in (subtopology euclidean s) e2 /\ e1 UNION e2 = s /\ e1 INTER e2 = {} /\ ~(e1 = {}) /\ ~(e2 = {}))`, GEN_TAC THEN REWRITE_TAC[CONNECTED_OPEN_IN] THEN AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]) THEN ASM SET_TAC[]);; let CONNECTED_CLOSED_IN = prove (`!s. connected s <=> ~(?e1 e2. closed_in (subtopology euclidean s) e1 /\ closed_in (subtopology euclidean s) e2 /\ s SUBSET e1 UNION e2 /\ e1 INTER e2 = {} /\ ~(e1 = {}) /\ ~(e2 = {}))`, GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOSED; CLOSED_IN_CLOSED] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]);; let CONNECTED_CLOSED_IN_EQ = prove (`!s. connected s <=> ~(?e1 e2. closed_in (subtopology euclidean s) e1 /\ closed_in (subtopology euclidean s) e2 /\ e1 UNION e2 = s /\ e1 INTER e2 = {} /\ ~(e1 = {}) /\ ~(e2 = {}))`, GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOSED_IN] THEN AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN RULE_ASSUM_TAC(REWRITE_RULE[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]) THEN ASM SET_TAC[]);; let CONNECTED_CLOPEN = prove (`!s. connected s <=> !t. open_in (subtopology euclidean s) t /\ closed_in (subtopology euclidean s) t ==> t = {} \/ t = s`, GEN_TAC THEN REWRITE_TAC[connected; OPEN_IN_OPEN; CLOSED_IN_CLOSED] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV) [GSYM EXISTS_DIFF] THEN ONCE_REWRITE_TAC[TAUT `(~a <=> b) <=> (a <=> ~b)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC; DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> b /\ a /\ c /\ d`] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[GSYM closed] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[TAUT `(a /\ b) /\ (c /\ d) /\ e <=> a /\ c /\ b /\ d /\ e`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; let CONNECTED_CLOSED_SET = prove (`!s:real^N->bool. closed s ==> (connected s <=> ~(?e1 e2. closed e1 /\ closed e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\ e1 UNION e2 = s /\ e1 INTER e2 = {}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONNECTED_CLOSED; CONTRAPOS_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN SET_TAC[]; REWRITE_TAC[CONNECTED_CLOSED_IN; CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN MAP_EVERY X_GEN_TAC [`e1:real^N->bool`; `e2:real^N->bool`; `u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY (C UNDISCH_THEN SUBST_ALL_TAC) [`e1:real^N->bool = s INTER u`; `e2:real^N->bool = s INTER v`] THEN MAP_EVERY EXISTS_TAC [`s INTER u:real^N->bool`; `s INTER v:real^N->bool`] THEN ASM_SIMP_TAC[CLOSED_INTER] THEN ASM SET_TAC[]]);; let CONNECTED_OPEN_SET = prove (`!s:real^N->bool. open s ==> (connected s <=> ~(?e1 e2. open e1 /\ open e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\ e1 UNION e2 = s /\ e1 INTER e2 = {}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[connected; CONTRAPOS_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN SET_TAC[]; REWRITE_TAC[CONNECTED_OPEN_IN; CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN MAP_EVERY X_GEN_TAC [`e1:real^N->bool`; `e2:real^N->bool`; `u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY (C UNDISCH_THEN SUBST_ALL_TAC) [`e1:real^N->bool = s INTER u`; `e2:real^N->bool = s INTER v`] THEN MAP_EVERY EXISTS_TAC [`s INTER u:real^N->bool`; `s INTER v:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]]);; let CONNECTED_IFF_CONNECTABLE_POINTS = prove (`!s:real^N->bool. connected s <=> !a b. a IN s /\ b IN s ==> ?t. connected t /\ t SUBSET s /\ a IN t /\ b IN t`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSET_REFL]; DISCH_TAC] THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`e1:real^N->bool`; `e2:real^N->bool`] THEN REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:real^N`) (X_CHOOSE_TAC `b:real^N`)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN ASM_REWRITE_TAC[connected] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`e1:real^N->bool`; `e2:real^N->bool`] THEN ASM SET_TAC[]);; let CONNECTED_EMPTY = prove (`connected {}`, REWRITE_TAC[connected; INTER_EMPTY]);; let CONNECTED_SING = prove (`!a. connected{a}`, REWRITE_TAC[connected] THEN SET_TAC[]);; let CONNECTED_SEGMENT = prove (`(!a b:real^N. connected(segment[a,b])) /\ (!a b:real^N. connected(segment(a,b)))`, CONJ_TAC THEN REPEAT GEN_TAC THEN (ASM_CASES_TAC `b:real^N = a` THEN ASM_SIMP_TAC[SEGMENT_REFL; CONNECTED_EMPTY; CONNECTED_SING] THEN ASM_SIMP_TAC[connected; OPEN_SEGMENT_ALT; CONJUNCT1 segment; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`e1:real^N->bool`; `e2:real^N->bool`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN PURE_ONCE_REWRITE_TAC[INTER_COMM] THEN PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[IN_INTER; EXISTS_IN_GSPEC; IN_DIFF; GSYM CONJ_ASSOC] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`e2:real^N->bool`; `e1:real^N->bool`; `v:real`; `u:real`] THEN MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM; INTER_COMM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN REWRITE_TAC[UNION_ACI; INTER_ACI] THEN MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\u. (&1 - u) % a + u % b:real^N`; `u:real`; `v:real`; `e1:real^N->bool`; `e2:real^N->bool`] CONNECTED_REAL_LEMMA) THEN ASM_REWRITE_TAC[GSYM open_def; REAL_POS; NOT_IMP] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`e:real`; `x:real`] THEN STRIP_TAC THEN EXISTS_TAC `e / dist(a:real^N,b)` THEN ASM_SIMP_TAC[REAL_LT_DIV; GSYM DIST_NZ] THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ; NORM_NEG; VECTOR_ARITH `((&1 - y) % a + y % b) - ((&1 - x) % a + x % b):real^N = --((y - x) % (a - b))`]; RULE_ASSUM_TAC(REWRITE_RULE[EXTENSION; IN_INTER; IN_ELIM_THM; SUBSET; IN_UNION; NOT_IN_EMPTY]) THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS]]));; let CONNECTED_UNIV = prove (`connected(:real^N)`, ONCE_REWRITE_TAC[CONNECTED_IFF_CONNECTABLE_POINTS] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN EXISTS_TAC `segment[a:real^N,b]` THEN ASM_REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT]);; let CLOPEN = prove (`!s. closed s /\ open s <=> s = {} \/ s = (:real^N)`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[CLOSED_EMPTY; OPEN_EMPTY; CLOSED_UNIV; OPEN_UNIV] THEN MATCH_MP_TAC(REWRITE_RULE[CONNECTED_CLOPEN] CONNECTED_UNIV) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN]);; let CONNECTED_UNIONS = prove (`!P:(real^N->bool)->bool. (!s. s IN P ==> connected s) /\ ~(INTERS P = {}) ==> connected(UNIONS P)`, GEN_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`e1:real^N->bool`; `e2:real^N->bool`] THEN STRIP_TAC THEN UNDISCH_TAC `~(INTERS P :real^N->bool = {})` THEN PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTERS] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(a:real^N) IN e1 \/ a IN e2` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; UNDISCH_TAC `~(e2 INTER UNIONS P:real^N->bool = {})`; UNDISCH_TAC `~(e1 INTER UNIONS P:real^N->bool = {})`] THEN PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_UNIONS] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `!t:real^N->bool. t IN P ==> a IN t` THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`e1:real^N->bool`; `e2:real^N->bool`]) THEN ASM SET_TAC[]);; let CONNECTED_UNION = prove (`!s t:real^N->bool. connected s /\ connected t /\ ~(s INTER t = {}) ==> connected (s UNION t)`, REWRITE_TAC[GSYM UNIONS_2; GSYM INTERS_2] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN ASM SET_TAC[]);; let CONNECTED_DIFF_OPEN_FROM_CLOSED = prove (`!s t u:real^N->bool. s SUBSET t /\ t SUBSET u /\ open s /\ closed t /\ connected u /\ connected(t DIFF s) ==> connected(u DIFF s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN UNDISCH_TAC `connected(t DIFF s:real^N->bool)` THEN SIMP_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v:real^N->bool`; `w:real^N->bool`] THEN MATCH_MP_TAC(MESON[] `(!v w. P v w ==> P w v) /\ (!w v. P v w /\ Q w ==> F) ==> !w v. P v w ==> ~(Q v) /\ ~(Q w)`) THEN CONJ_TAC THENL [SIMP_TAC[CONJ_ACI; INTER_ACI; UNION_ACI]; ALL_TAC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN SIMP_TAC[] THEN MAP_EVERY EXISTS_TAC [`v UNION s:real^N->bool`; `w DIFF t:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_UNION; OPEN_DIFF] THEN ASM SET_TAC[]);; let CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE = prove (`!f:(real^N->bool)->bool f'. pairwise DISJOINT f /\ pairwise DISJOINT f' /\ (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\ (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\ UNIONS f = UNIONS f' ==> f = f'`, GEN_REWRITE_TAC (funpow 2 BINDER_CONV o RAND_CONV) [EXTENSION] THEN MATCH_MP_TAC(MESON[] `(!s t. P s t ==> P t s) /\ (!s t x. P s t /\ x IN s ==> x IN t) ==> (!s t. P s t ==> (!x. x IN s <=> x IN t))`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?t a:real^N. t IN f' /\ a IN s /\ a IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[EXTENSION] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`s:real^N->bool`; `t:real^N->bool`; `f:(real^N->bool)->bool`; `f':(real^N->bool)->bool`] THEN MATCH_MP_TAC(MESON[] `(!f f' s t. P f f' s t ==> P f' f t s) /\ (!f f' s t x. P f f' s t /\ x IN s ==> x IN t) ==> (!f' f t s. P f f' s t ==> (!x. x IN s <=> x IN t))`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REPLICATE_TAC 4 GEN_TAC THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN UNDISCH_TAC `!s:real^N->bool. s IN f ==> open s /\ connected s /\ ~(s = {})` THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_CASES_TAC `(b:real^N) IN t` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `connected(s:real^N->bool)` THEN REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `UNIONS(f' DELETE (t:real^N->bool))`] THEN REPEAT STRIP_TAC THENL [ASM_SIMP_TAC[]; MATCH_MP_TAC OPEN_UNIONS THEN ASM_SIMP_TAC[IN_DELETE]; REWRITE_TAC[GSYM UNIONS_INSERT] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `t INTER u = {} ==> t INTER u INTER s = {}`) THEN REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_DELETE; GSYM DISJOINT] THEN ASM_MESON_TAC[pairwise]; ASM SET_TAC[]; ASM SET_TAC[]]);; let CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL = prove (`!u s t:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ connected(s UNION t) /\ connected(s INTER t) ==> connected s /\ connected t`, GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!s t. P s t ==> P t s) /\ (!s t. P s t ==> Q s) ==> !s t. P s t ==> Q s /\ Q t`) THEN CONJ_TAC THENL [SIMP_TAC[UNION_COMM; INTER_COMM]; REPEAT STRIP_TAC] THEN REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN STRIP_TAC THEN ASM_CASES_TAC `~(s INTER t SUBSET (a:real^N->bool)) /\ ~(s INTER t SUBSET b)` THENL [UNDISCH_TAC `connected(s INTER t:real^N->bool)` THEN ASM_SIMP_TAC[CONNECTED_CLOSED_IN] THEN MAP_EVERY EXISTS_TAC [`t INTER a:real^N->bool`; `t INTER b:real^N->bool`] THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [UNDISCH_TAC `closed_in (subtopology euclidean s) (a:real^N->bool)`; UNDISCH_TAC `closed_in (subtopology euclidean s) (b:real^N->bool)`] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN REWRITE_TAC[] THEN STRIP_TAC THEN UNDISCH_TAC `connected(s UNION t:real^N->bool)` THEN ASM_SIMP_TAC[CONNECTED_CLOSED_IN] THENL [MAP_EVERY EXISTS_TAC [`t UNION a:real^N->bool`; `b:real^N->bool`]; MAP_EVERY EXISTS_TAC [`t UNION b:real^N->bool`; `a:real^N->bool`]] THEN (GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[]] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC; ALL_TAC] THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN (CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_TRANS]; ALL_TAC]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN ASM SET_TAC[])]);; let CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL = prove (`!u s t:real^N->bool. open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t /\ connected(s UNION t) /\ connected(s INTER t) ==> connected s /\ connected t`, GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!s t. P s t ==> P t s) /\ (!s t. P s t ==> Q s) ==> !s t. P s t ==> Q s /\ Q t`) THEN CONJ_TAC THENL [SIMP_TAC[UNION_COMM; INTER_COMM]; REPEAT STRIP_TAC] THEN REWRITE_TAC[CONNECTED_OPEN_IN; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN STRIP_TAC THEN ASM_CASES_TAC `~(s INTER t SUBSET (a:real^N->bool)) /\ ~(s INTER t SUBSET b)` THENL [UNDISCH_TAC `connected(s INTER t:real^N->bool)` THEN ASM_SIMP_TAC[CONNECTED_OPEN_IN] THEN MAP_EVERY EXISTS_TAC [`t INTER a:real^N->bool`; `t INTER b:real^N->bool`] THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [UNDISCH_TAC `open_in (subtopology euclidean s) (a:real^N->bool)`; UNDISCH_TAC `open_in (subtopology euclidean s) (b:real^N->bool)`] THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN REWRITE_TAC[] THEN STRIP_TAC THEN UNDISCH_TAC `connected(s UNION t:real^N->bool)` THEN ASM_SIMP_TAC[CONNECTED_OPEN_IN] THENL [MAP_EVERY EXISTS_TAC [`t UNION a:real^N->bool`; `b:real^N->bool`]; MAP_EVERY EXISTS_TAC [`t UNION b:real^N->bool`; `a:real^N->bool`]] THEN (GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]] THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_UNION THEN CONJ_TAC; ALL_TAC] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN (CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[])]);; let CONNECTED_FROM_CLOSED_UNION_AND_INTER = prove (`!s t:real^N->bool. closed s /\ closed t /\ connected(s UNION t) /\ connected(s INTER t) ==> connected s /\ connected t`, ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL]);; let CONNECTED_FROM_OPEN_UNION_AND_INTER = prove (`!s t:real^N->bool. open s /\ open t /\ connected(s UNION t) /\ connected(s INTER t) ==> connected s /\ connected t`, ONCE_REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL]);; (* ------------------------------------------------------------------------- *) (* Sort of induction principle for connected sets. *) (* ------------------------------------------------------------------------- *) let CONNECTED_INDUCTION = prove (`!P Q s:real^N->bool. connected s /\ (!t a. open_in (subtopology euclidean s) t /\ a IN t ==> ?z. z IN t /\ P z) /\ (!a. a IN s ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ !x y. x IN t /\ y IN t /\ P x /\ P y /\ Q x ==> Q y) ==> !a b. a IN s /\ b IN s /\ P a /\ P b /\ Q a ==> Q b`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`{b:real^N | ?t. open_in (subtopology euclidean s) t /\ b IN t /\ !x. x IN t /\ P x ==> Q x}`; `{b:real^N | ?t. open_in (subtopology euclidean s) t /\ b IN t /\ !x. x IN t /\ P x ==> ~(Q x)}`] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `c:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `c:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ASM SET_TAC[]; REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t INTER u:real^N->bool`; `c:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_INTER] THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]);; let CONNECTED_EQUIVALENCE_RELATION_GEN = prove (`!P R s:real^N->bool. connected s /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!t a. open_in (subtopology euclidean s) t /\ a IN t ==> ?z. z IN t /\ P z) /\ (!a. a IN s ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ !x y. x IN t /\ y IN t /\ P x /\ P y ==> R x y) ==> !a b. a IN s /\ b IN s /\ P a /\ P b ==> R a b`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!a:real^N. a IN s /\ P a ==> !b c. b IN s /\ c IN s /\ P b /\ P c /\ R a b ==> R a c` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION THEN ASM_MESON_TAC[]);; let CONNECTED_INDUCTION_SIMPLE = prove (`!P s:real^N->bool. connected s /\ (!a. a IN s ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ !x y. x IN t /\ y IN t /\ P x ==> P y) ==> !a b. a IN s /\ b IN s /\ P a ==> P b`, MP_TAC(ISPEC `\x:real^N. T` CONNECTED_INDUCTION) THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);; let CONNECTED_EQUIVALENCE_RELATION = prove (`!R s:real^N->bool. connected s /\ (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!a. a IN s ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ !x. x IN t ==> R a x) ==> !a b. a IN s /\ b IN s ==> R a b`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!a:real^N. a IN s ==> !b c. b IN s /\ c IN s /\ R a b ==> R a c` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION_SIMPLE THEN ASM_MESON_TAC[]);; let LOCALLY_CONSTANT_IMP_CONSTANT = prove (`!f:real^N->A s. connected s /\ (!x. x IN s ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ !x'. x' IN u ==> f x' = f x) ==> ?c. !x. x IN s ==> f x = c`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] `(?c. !x. P x ==> f x = c) <=> (!x y. P x /\ P y ==> f x = f y)`] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Limit points. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("limit_point_of",(12,"right"));; let limit_point_of = new_definition `x limit_point_of s <=> !t. x IN t /\ open t ==> ?y. ~(y = x) /\ y IN s /\ y IN t`;; let EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF = prove (`!s. euclidean derived_set_of s = {x:real^N | x limit_point_of s}`, GEN_TAC THEN REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; METRIC_DERIVED_SET_OF; EUCLIDEAN_METRIC; IN_UNIV; limit_point_of; EXTENSION; IN_ELIM_THM; MBALL_EUCLIDEAN] THEN GEN_TAC THEN EQ_TAC THENL [INTRO_TAC "hp; !t; x t" THEN HYP_TAC "t" (REWRITE_RULE[open_def]) THEN HYP_TAC "t: @r. r t" (C MATCH_MP (ASSUME `x:real^N IN t`)) THEN HYP_TAC "hp: @y. neq y dist" (C MATCH_MP (ASSUME `&0 < r`)) THEN EXISTS_TAC `y:real^N` THEN HYP REWRITE_TAC "neq y" [] THEN REMOVE_THEN "t" MATCH_MP_TAC THEN REMOVE_THEN "dist" MP_TAC THEN REWRITE_TAC[IN_BALL; DIST_SYM]; INTRO_TAC "hp; !r; r" THEN REMOVE_THEN "hp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL]]);; let LIMIT_POINT_IN_DERIVED_SET = prove (`!s x:real^N. x limit_point_of s <=> x IN euclidean derived_set_of s`, REWRITE_TAC[EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF; IN_ELIM_THM]);; let LIMPT_SUBSET = prove (`!x s t. x limit_point_of s /\ s SUBSET t ==> x limit_point_of t`, REWRITE_TAC[limit_point_of; SUBSET] THEN MESON_TAC[]);; let LIMPT_APPROACHABLE = prove (`!x s. x limit_point_of s <=> !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[limit_point_of] THEN MESON_TAC[open_def; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; IN_BALL]);; let LIMPT_APPROACHABLE_LE = prove (`!x s. x limit_point_of s <=> !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) <= e`, REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN MATCH_MP_TAC(TAUT `(~a <=> ~b) ==> (a <=> b)`) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> c ==> ~(a /\ b)`; APPROACHABLE_LT_LE]);; let DISCRETE_SET = prove (`!s t:real^N->bool. {x | x IN t /\ x limit_point_of s} = {} <=> !x. x IN t ==> ?e. &0 < e /\ !y. y IN s /\ ~(y = x) ==> e <= norm(y - x)`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN REWRITE_TAC[dist; GSYM REAL_NOT_LE] THEN MESON_TAC[]);; let CLOSED_LIMPT = prove (`!s. closed s <=> !x. x limit_point_of s ==> x IN s`, REWRITE_TAC[closed] THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN REWRITE_TAC[limit_point_of; IN_DIFF; IN_UNIV; SUBSET] THEN MESON_TAC[]);; let LIMPT_EMPTY = prove (`!x. ~(x limit_point_of {})`, REWRITE_TAC[LIMPT_APPROACHABLE; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);; let NO_LIMIT_POINT_IMP_CLOSED = prove (`!s. ~(?x. x limit_point_of s) ==> closed s`, MESON_TAC[CLOSED_LIMPT]);; let CLOSED_POSITIVE_ORTHANT = prove (`closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `--(x:real^N $ i)`) THEN ASM_REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; NOT_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC(TAUT `(a ==> ~c) ==> ~(a /\ b /\ c)`) THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `!b. abs x <= b /\ b <= a ==> ~(a + x < &0)`) THEN EXISTS_TAC `abs((y - x :real^N)$i)` THEN ASM_SIMP_TAC[dist; COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH `x < &0 /\ &0 <= y ==> abs(x) <= abs(y - x)`]);; let FINITE_SET_AVOID = prove (`!a:real^N s. FINITE s ==> ?d. &0 < d /\ !x. x IN s /\ ~(x = a) ==> d <= dist(a,x)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY] THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `x:real^N = a` THEN REWRITE_TAC[IN_INSERT] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `min d (dist(a:real^N,x))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ; REAL_MIN_LE] THEN ASM_MESON_TAC[REAL_LE_REFL]);; let LIMIT_POINT_FINITE = prove (`!s a. FINITE s ==> ~(a limit_point_of s)`, REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LE] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM; REAL_NOT_LE; REAL_NOT_LT; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN MESON_TAC[FINITE_SET_AVOID; DIST_SYM]);; let LIMPT_SING = prove (`!x y:real^N. ~(x limit_point_of {y})`, SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING]);; let LIMIT_POINT_UNION = prove (`!s t x:real^N. x limit_point_of (s UNION t) <=> x limit_point_of s \/ x limit_point_of t`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[LIMPT_SUBSET; SUBSET_UNION]] THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNION] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~a ==> b) ==> a \/ b`) THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min d e`) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let LIMPT_INSERT = prove (`!s x y:real^N. x limit_point_of (y INSERT s) <=> x limit_point_of s`, ONCE_REWRITE_TAC[SET_RULE `y INSERT s = {y} UNION s`] THEN REWRITE_TAC[LIMIT_POINT_UNION] THEN SIMP_TAC[FINITE_SING; LIMIT_POINT_FINITE]);; let LIMPT_DELETE = prove (`!s a x:real^N. x limit_point_of (s DELETE a) <=> x limit_point_of s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`] THEN TRANS_TAC EQ_TRANS `(x:real^N) limit_point_of a INSERT (s DELETE a)` THEN CONJ_TAC THENL [REWRITE_TAC[LIMPT_INSERT]; AP_TERM_TAC THEN ASM SET_TAC[]]);; let LIMIT_POINT_UNIONS = prove (`!f x:real^N. FINITE f ==> (x limit_point_of (UNIONS f) <=> ?s. s IN f /\ x limit_point_of s)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; LIMPT_EMPTY; NOT_IN_EMPTY] THEN SIMP_TAC[UNIONS_INSERT; LIMIT_POINT_UNION; EXISTS_IN_INSERT]);; let LIMPT_OF_LIMPTS = prove (`!x:real^N s. x limit_point_of {y | y limit_point_of s} ==> x limit_point_of s`, REWRITE_TAC[LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `dist(y:real^N,x)`) THEN ASM_SIMP_TAC[DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let CLOSED_LIMPTS = prove (`!s. closed {x:real^N | x limit_point_of s}`, REWRITE_TAC[CLOSED_LIMPT; IN_ELIM_THM; LIMPT_OF_LIMPTS]);; let DISCRETE_IMP_CLOSED = prove (`!s:real^N->bool e. &0 < e /\ (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) ==> closed s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x:real^N. ~(x limit_point_of s)` (fun th -> MESON_TAC[th; CLOSED_LIMPT]) THEN GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `e / &2`) THEN REWRITE_TAC[REAL_HALF; ASSUME `&0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (e / &2) (dist(x:real^N,y))`) THEN ASM_SIMP_TAC[REAL_LT_MIN; DIST_POS_LT; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ASM_REWRITE_TAC[] THEN ASM_NORM_ARITH_TAC);; let LIMPT_OF_UNIV = prove (`!x. x limit_point_of (:real^N)`, GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`x:real^N`; `e / &2`] VECTOR_CHOOSE_DIST) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH);; let LIMPT_OF_OPEN_IN = prove (`!s t x:real^N. open_in (subtopology euclidean s) t /\ x limit_point_of s /\ x IN t ==> x limit_point_of t`, REWRITE_TAC[open_in; SUBSET; LIMPT_APPROACHABLE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let LIMPT_OF_OPEN = prove (`!s x:real^N. open s /\ x IN s ==> x limit_point_of s`, REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN MESON_TAC[LIMPT_OF_OPEN_IN; LIMPT_OF_UNIV]);; let OPEN_IN_SING = prove (`!s a. open_in (subtopology euclidean s) {a} <=> a IN s /\ ~(a limit_point_of s)`, REWRITE_TAC[open_in; LIMPT_APPROACHABLE; SING_SUBSET; IN_SING] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN MESON_TAC[]);; let CLOSED_SING = prove (`!a:real^N. closed {a}`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_INSERT; LIMPT_EMPTY]);; let CLOSED_IN_SING = prove (`!u x:real^N. closed_in (subtopology euclidean u) {x} <=> x IN u`, SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_SING] THEN SET_TAC[]);; let CLOSED_IN_INSERT = prove (`!u s a:real^N. closed_in (subtopology euclidean u) s /\ a IN u ==> closed_in (subtopology euclidean u) (a INSERT s)`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN SIMP_TAC[CLOSED_IN_UNION; CLOSED_IN_SING]);; let LIMIT_POINT_OF_LOCAL_IMP = prove (`!u s t x:real^N. s SUBSET u /\ x limit_point_of s /\ x IN t /\ open_in (subtopology euclidean u) t ==> ?y. ~(y = x) /\ y IN s /\ y IN t`, REWRITE_TAC[limit_point_of; OPEN_IN_OPEN] THEN SET_TAC[]);; let LIMIT_POINT_OF_LOCAL = prove (`!u s x:real^N. s SUBSET u /\ x IN u ==> (x limit_point_of s <=> !t. x IN t /\ open_in (subtopology euclidean u) t ==> ?y. ~(y = x) /\ y IN s /\ y IN t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of; OPEN_IN_OPEN] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] THEN REWRITE_TAC[FORALL_UNWIND_THM2; IN_INTER] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Interior of a set. *) (* ------------------------------------------------------------------------- *) let interior = new_definition `interior s = {x | ?t. open t /\ x IN t /\ t SUBSET s}`;; let EUCLIDEAN_INTERIOR_OF = prove (`!s:real^N->bool. euclidean interior_of s = interior s`, REWRITE_TAC[interior_of; interior; OPEN_IN]);; let INTERIOR_EQ = prove (`!s. (interior s = s) <=> open s`, GEN_TAC THEN REWRITE_TAC[EXTENSION; interior; IN_ELIM_THM] THEN GEN_REWRITE_TAC RAND_CONV [OPEN_SUBOPEN] THEN MESON_TAC[SUBSET]);; let INTERIOR_OPEN = prove (`!s. open s ==> (interior s = s)`, MESON_TAC[INTERIOR_EQ]);; let INTERIOR_EMPTY = prove (`interior {} = {}`, SIMP_TAC[INTERIOR_OPEN; OPEN_EMPTY]);; let INTERIOR_UNIV = prove (`interior(:real^N) = (:real^N)`, SIMP_TAC[INTERIOR_OPEN; OPEN_UNIV]);; let OPEN_INTERIOR = prove (`!s. open(interior s)`, GEN_TAC THEN REWRITE_TAC[interior] THEN GEN_REWRITE_TAC I [OPEN_SUBOPEN] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let INTERIOR_INTERIOR = prove (`!s. interior(interior s) = interior s`, MESON_TAC[INTERIOR_EQ; OPEN_INTERIOR]);; let INTERIOR_SUBSET = prove (`!s. (interior s) SUBSET s`, REWRITE_TAC[SUBSET; interior; IN_ELIM_THM] THEN MESON_TAC[]);; let SUBSET_INTERIOR_EQ = prove (`!s:real^N->bool. s SUBSET interior s <=> open s`, REWRITE_TAC[GSYM INTERIOR_EQ; GSYM SUBSET_ANTISYM_EQ; INTERIOR_SUBSET]);; let SUBSET_INTERIOR = prove (`!s t. s SUBSET t ==> (interior s) SUBSET (interior t)`, REWRITE_TAC[interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let INTERIOR_MAXIMAL = prove (`!s t. t SUBSET s /\ open t ==> t SUBSET (interior s)`, REWRITE_TAC[interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; let INTERIOR_MAXIMAL_EQ = prove (`!s t:real^N->bool. open s ==> (s SUBSET interior t <=> s SUBSET t)`, MESON_TAC[INTERIOR_MAXIMAL; SUBSET_TRANS; INTERIOR_SUBSET]);; let INTERIOR_UNIQUE = prove (`!s t. t SUBSET s /\ open t /\ (!t'. t' SUBSET s /\ open t' ==> t' SUBSET t) ==> (interior s = t)`, MESON_TAC[SUBSET_ANTISYM; INTERIOR_MAXIMAL; INTERIOR_SUBSET; OPEN_INTERIOR]);; let INTERIOR_EQ_UNIV = prove (`!s. interior s = (:real^N) <=> s = (:real^N)`, SIMP_TAC[SET_RULE `s = UNIV <=> UNIV SUBSET s`; OPEN_UNIV; INTERIOR_MAXIMAL_EQ]);; let IN_INTERIOR = prove (`!x s. x IN interior s <=> ?e. &0 < e /\ ball(x,e) SUBSET s`, REWRITE_TAC[interior; IN_ELIM_THM] THEN MESON_TAC[OPEN_CONTAINS_BALL; SUBSET_TRANS; CENTRE_IN_BALL; OPEN_BALL]);; let INTERIOR_INTER = prove (`!s t:real^N->bool. interior(s INTER t) = interior s INTER interior t`, REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; INTERIOR_OF_INTER]);; let INTERIOR_FINITE_INTERS = prove (`!s:(real^N->bool)->bool. FINITE s ==> interior(INTERS s) = INTERS(IMAGE interior s)`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INTERS_0; INTERS_INSERT; INTERIOR_UNIV; IMAGE_CLAUSES] THEN SIMP_TAC[INTERIOR_INTER]);; let INTERIOR_INTERS_SUBSET = prove (`!f. interior(INTERS f) SUBSET INTERS (IMAGE interior f)`, REWRITE_TAC[SUBSET; IN_INTERIOR; IN_INTERS; FORALL_IN_IMAGE] THEN MESON_TAC[]);; let UNION_INTERIOR_SUBSET = prove (`!s t:real^N->bool. interior s UNION interior t SUBSET interior(s UNION t)`, SIMP_TAC[INTERIOR_MAXIMAL_EQ; OPEN_UNION; OPEN_INTERIOR] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t SUBSET t' ==> (s UNION t) SUBSET (s' UNION t')`) THEN REWRITE_TAC[INTERIOR_SUBSET]);; let INTERIOR_EQ_EMPTY = prove (`!s:real^N->bool. interior s = {} <=> !t. open t /\ t SUBSET s ==> t = {}`, MESON_TAC[INTERIOR_MAXIMAL_EQ; SUBSET_EMPTY; OPEN_INTERIOR; INTERIOR_SUBSET]);; let INTERIOR_EQ_EMPTY_ALT = prove (`!s:real^N->bool. interior s = {} <=> !t. open t /\ ~(t = {}) ==> ~(t DIFF s = {})`, GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN SET_TAC[]);; let INTERIOR_LIMIT_POINT = prove (`!s x:real^N. x IN interior s ==> x limit_point_of s`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_INTERIOR; IN_ELIM_THM; SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`x:real^N`; `min d e / &2`] VECTOR_CHOOSE_DIST) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM DIST_EQ_0]; ONCE_REWRITE_TAC[DIST_SYM]] THEN ASM_REAL_ARITH_TAC);; let INTERIOR_SING = prove (`!a:real^N. interior {a} = {}`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[INTERIOR_LIMIT_POINT; LIMPT_SING]);; let INTERIOR_CLOSED_UNION_EMPTY_INTERIOR = prove (`!s t:real^N->bool. closed(s) /\ interior(t) = {} ==> interior(s UNION t) = interior(s)`, REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; CLOSED_IN] THEN REWRITE_TAC[INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF]);; let INTERIOR_UNION_EQ_EMPTY = prove (`!s t:real^N->bool. closed s \/ closed t ==> (interior(s UNION t) = {} <=> interior s = {} /\ interior t = {})`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[SUBSET_UNION; SUBSET_INTERIOR; SUBSET_EMPTY]; ASM_MESON_TAC[UNION_COMM; INTERIOR_CLOSED_UNION_EMPTY_INTERIOR]]);; let INTERIOR_UNIONS_OPEN_SUBSETS = prove (`!s:real^N->bool. UNIONS {t | open t /\ t SUBSET s} = interior s`, GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN SIMP_TAC[OPEN_UNIONS; IN_ELIM_THM] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Closure of a set. *) (* ------------------------------------------------------------------------- *) let closure = new_definition `closure s = s UNION {x | x limit_point_of s}`;; let EUCLIDEAN_CLOSURE_OF = prove (`!s:real^N->bool. euclidean closure_of s = closure s`, GEN_TAC THEN REWRITE_TAC[closure; CLOSURE_OF; TOPSPACE_EUCLIDEAN; INTER_UNIV; EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF]);; let CLOSURE_APPROACHABLE = prove (`!x s. x IN closure(s) <=> !e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e`, REWRITE_TAC[closure; LIMPT_APPROACHABLE; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[DIST_REFL]);; let CLOSURE_NONEMPTY_OPEN_INTER = prove (`!s x:real^N. x IN closure s <=> !t. x IN t /\ open t ==> ~(s INTER t = {})`, REPEAT GEN_TAC THEN REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN REWRITE_TAC[limit_point_of] THEN SET_TAC[]);; let CLOSURE_INTERIOR = prove (`!s:real^N->bool. closure s = UNIV DIFF (interior (UNIV DIFF s))`, REWRITE_TAC[EXTENSION; closure; IN_UNION; IN_DIFF; IN_UNIV; interior; IN_ELIM_THM; limit_point_of; SUBSET] THEN MESON_TAC[]);; let INTERIOR_CLOSURE = prove (`!s:real^N->bool. interior s = UNIV DIFF (closure (UNIV DIFF s))`, REWRITE_TAC[CLOSURE_INTERIOR; COMPL_COMPL]);; let CLOSED_CLOSURE = prove (`!s. closed(closure s)`, REWRITE_TAC[closed; CLOSURE_INTERIOR; COMPL_COMPL; OPEN_INTERIOR]);; let CLOSURE_HULL = prove (`!s. closure s = closed hull s`, GEN_TAC THEN MATCH_MP_TAC(GSYM HULL_UNIQUE) THEN REWRITE_TAC[CLOSED_CLOSURE; SUBSET] THEN REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; CLOSED_LIMPT] THEN MESON_TAC[limit_point_of]);; let CLOSURE_EQ = prove (`!s. (closure s = s) <=> closed s`, SIMP_TAC[CLOSURE_HULL; HULL_EQ; CLOSED_INTERS]);; let CLOSURE_CLOSED = prove (`!s. closed s ==> (closure s = s)`, MESON_TAC[CLOSURE_EQ]);; let CLOSURE_CLOSURE = prove (`!s. closure(closure s) = closure s`, REWRITE_TAC[CLOSURE_HULL; HULL_HULL]);; let CLOSURE_SUBSET = prove (`!s. s SUBSET (closure s)`, REWRITE_TAC[CLOSURE_HULL; HULL_SUBSET]);; let CLOSURE_INC = prove (`!s x:real^N. x IN s ==> x IN closure s`, REWRITE_TAC[GSYM SUBSET; CLOSURE_SUBSET]);; let SUBSET_CLOSURE = prove (`!s t. s SUBSET t ==> (closure s) SUBSET (closure t)`, REWRITE_TAC[CLOSURE_HULL; HULL_MONO]);; let CLOSURE_UNION = prove (`!s t:real^N->bool. closure(s UNION t) = closure s UNION closure t`, REWRITE_TAC[LIMIT_POINT_UNION; closure] THEN SET_TAC[]);; let CLOSURE_UNIONS_SUBSET = prove (`!(f:(real^N->bool)->bool). UNIONS {closure s | s IN f} SUBSET closure(UNIONS f)`, REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]);; let CLOSURE_INTER_SUBSET = prove (`!s t. closure(s INTER t) SUBSET closure(s) INTER closure(t)`, REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]);; let CLOSURE_INTERS_SUBSET = prove (`!f. closure(INTERS f) SUBSET INTERS(IMAGE closure f)`, REWRITE_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]);; let CLOSURE_MINIMAL = prove (`!s t. s SUBSET t /\ closed t ==> (closure s) SUBSET t`, REWRITE_TAC[HULL_MINIMAL; CLOSURE_HULL]);; let CLOSURE_MINIMAL_EQ = prove (`!s t:real^N->bool. closed t ==> (closure s SUBSET t <=> s SUBSET t)`, MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET; CLOSURE_MINIMAL]);; let CLOSURE_UNIQUE = prove (`!s t. s SUBSET t /\ closed t /\ (!t'. s SUBSET t' /\ closed t' ==> t SUBSET t') ==> closure s = t`, REWRITE_TAC[CLOSURE_HULL; HULL_UNIQUE]);; let CLOSURE_EMPTY = prove (`closure {} = {}`, SIMP_TAC[CLOSURE_CLOSED; CLOSED_EMPTY]);; let CLOSURE_UNIV = prove (`closure(:real^N) = (:real^N)`, SIMP_TAC[CLOSURE_CLOSED; CLOSED_UNIV]);; let LIMPT_OF_OPEN_CLOSURE = prove (`!s x:real^N. open s /\ x IN closure s ==> x limit_point_of s`, REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[LIMPT_OF_OPEN]);; let CLOSURE_UNIONS = prove (`!f. FINITE f ==> closure(UNIONS f) = UNIONS {closure s | s IN f}`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; SET_RULE `{f x | x IN {}} = {}`; SET_RULE `{f x | x IN a INSERT s} = (f a) INSERT {f x | x IN s}`] THEN SIMP_TAC[CLOSURE_EMPTY; CLOSURE_UNION]);; let CLOSURE_EQ_EMPTY = prove (`!s. closure s = {} <=> s = {}`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CLOSURE_EMPTY] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN REWRITE_TAC[CLOSURE_SUBSET]);; let CLOSURE_SUBSET_EQ = prove (`!s:real^N->bool. closure s SUBSET s <=> closed s`, GEN_TAC THEN REWRITE_TAC[GSYM CLOSURE_EQ] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let OPEN_INTER_CLOSURE_EQ_EMPTY = prove (`!s t:real^N->bool. open s ==> (s INTER (closure t) = {} <=> s INTER t = {})`, REWRITE_TAC[OPEN_IN; GSYM EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY]);; let CLOSURE_MINIMAL_LOCAL = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean s) u /\ t SUBSET u ==> s INTER closure t SUBSET u`, REPEAT GEN_TAC THEN SIMP_TAC[IMP_CONJ; CLOSED_IN_CLOSED; LEFT_IMP_EXISTS_THM; SUBSET_INTER] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET u`) THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[]);; let CLOSURE_OPEN_IN_INTER_CLOSURE = prove (`!s t u:real^N->bool. open_in (subtopology euclidean u) s /\ t SUBSET u ==> closure(s INTER closure t) = closure(s INTER t)`, REWRITE_TAC[OPEN_IN; GSYM EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[CLOSURE_OF_OPEN_IN_SUBTOPOLOGY_INTER_CLOSURE_OF]);; let OPEN_IN_INTER_CLOSURE_EQ_EMPTY = prove (`!u s t:real^N->bool. open_in (subtopology euclidean u) s /\ t SUBSET u ==> (s INTER closure t = {} <=> s INTER t = {})`, MESON_TAC[CLOSURE_OPEN_IN_INTER_CLOSURE; CLOSURE_EQ_EMPTY]);; let CLOSURE_OPEN_INTER_CLOSURE = prove (`!s t:real^N->bool. open s ==> closure(s INTER closure t) = closure(s INTER t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_IN_INTER_CLOSURE THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV; GSYM OPEN_IN; SUBTOPOLOGY_UNIV]);; let OPEN_INTER_CLOSURE_SUBSET = prove (`!s t:real^N->bool. open s ==> (s INTER (closure t)) SUBSET closure(s INTER t)`, MESON_TAC[CLOSURE_OPEN_INTER_CLOSURE; CLOSURE_SUBSET]);; let OPEN_INTER_CLOSURE_EQ = prove (`!s t:real^N->bool. open s ==> s INTER closure t = s INTER closure(s INTER t)`, REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; OPEN_IN] THEN REWRITE_TAC[OPEN_IN_INTER_CLOSURE_OF_EQ]);; let CLOSURE_OPEN_INTER_SUPERSET = prove (`!s t:real^N->bool. open s /\ s SUBSET closure t ==> closure(s INTER t) = closure s`, REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; OPEN_IN] THEN REWRITE_TAC[CLOSURE_OF_OPEN_IN_INTER_SUPERSET]);; let CLOSURE_COMPLEMENT = prove (`!s:real^N->bool. closure(UNIV DIFF s) = UNIV DIFF interior(s)`, REWRITE_TAC[SET_RULE `s = UNIV DIFF t <=> UNIV DIFF s = t`] THEN REWRITE_TAC[GSYM INTERIOR_CLOSURE]);; let INTERIOR_COMPLEMENT = prove (`!s:real^N->bool. interior(UNIV DIFF s) = UNIV DIFF closure(s)`, REWRITE_TAC[SET_RULE `s = UNIV DIFF t <=> UNIV DIFF s = t`] THEN REWRITE_TAC[GSYM CLOSURE_INTERIOR]);; let CLOSURE_LOCALLY_FINITE_UNIONS = prove (`!f:(real^N->bool)->bool. (!x. ?u. open u /\ x IN u /\ FINITE {s | s IN f /\ ~(s INTER u = {})}) ==> closure(UNIONS f) = UNIONS {closure s | s IN f}`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; CLOSURE_UNIONS_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN CONJ_TAC THENL [MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN MESON_TAC[CLOSURE_SUBSET]; MATCH_MP_TAC CLOSED_LOCALLY_FINITE_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE] THEN X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN REWRITE_TAC[SET_RULE `{y | y IN {f x | x IN s} /\ P y} = IMAGE f {x | x IN s /\ P(f x)}`] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; FINITE_IMAGE]]);; let CONNECTED_INTERMEDIATE_CLOSURE = prove (`!s t:real^N->bool. connected s /\ s SUBSET t /\ t SUBSET closure s ==> connected t`, REPEAT GEN_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `v:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[GSYM DE_MORGAN_THM] THEN STRIP_TAC THENL [SUBGOAL_THEN `(closure s) SUBSET ((:real^N) DIFF u)` MP_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; ALL_TAC]; SUBGOAL_THEN `(closure s) SUBSET ((:real^N) DIFF v)` MP_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; ALL_TAC]] THEN ASM SET_TAC[]);; let CONNECTED_CLOSURE = prove (`!s:real^N->bool. connected s ==> connected(closure s)`, MESON_TAC[CONNECTED_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);; let CONNECTED_UNION_STRONG = prove (`!s t:real^N->bool. connected s /\ connected t /\ ~(closure s INTER t = {}) ==> connected(s UNION t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `p:real^N`) THEN SUBGOAL_THEN `s UNION t = ((p:real^N) INSERT s) UNION t` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let CONNECTED_INSERT = prove (`!s a:real^N. connected s ==> (connected(a INSERT s) <=> s = {} \/ a IN closure s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CLOSURE_EMPTY; CONNECTED_SING] THEN DISCH_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONNECTED_CLOSED; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`{a:real^N}`; `closure s:real^N->bool`]) THEN REWRITE_TAC[CLOSED_CLOSURE; CLOSED_SING] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = s UNION {a}`] THEN MATCH_MP_TAC CONNECTED_UNION_STRONG THEN ASM_REWRITE_TAC[CONNECTED_SING] THEN ASM SET_TAC[]]);; let CONNECTED_INSERT_LIMPT = prove (`!s a:real^N. connected s /\ a limit_point_of s ==> connected(a INSERT s)`, SIMP_TAC[CONNECTED_INSERT; closure; IN_UNION; IN_ELIM_THM]);; let INTERIOR_DIFF = prove (`!s t. interior(s DIFF t) = interior(s) DIFF closure(t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN REWRITE_TAC[INTERIOR_INTER; CLOSURE_INTERIOR] THEN SET_TAC[]);; let LIMPT_OF_CLOSURE = prove (`!x:real^N s. x limit_point_of closure s <=> x limit_point_of s`, REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; LIMIT_POINT_UNION] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> (p \/ q <=> p)`) THEN REWRITE_TAC[LIMPT_OF_LIMPTS]);; let PERFECT_FROM_CLOSURE = prove (`!s:real^N->bool. (!x. x IN closure s ==> x limit_point_of closure s) ==> !x. x IN s ==> x limit_point_of s`, REWRITE_TAC[LIMPT_OF_CLOSURE] THEN MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);; let DENSE_IMP_PERFECT = prove (`!s. closure s = (:real^N) ==> !x. x IN s ==> x limit_point_of s`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC PERFECT_FROM_CLOSURE THEN ASM_REWRITE_TAC[LIMPT_OF_UNIV]);; let CLOSED_IN_LIMPT = prove (`!s t. closed_in (subtopology euclidean t) s <=> s SUBSET t /\ !x:real^N. x limit_point_of s /\ x IN t ==> x IN s`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[IN_INTER] THEN ASM_MESON_TAC[CLOSED_LIMPT; LIMPT_SUBSET; INTER_SUBSET]; STRIP_TAC THEN EXISTS_TAC `closure s :real^N->bool` THEN REWRITE_TAC[CLOSED_CLOSURE] THEN REWRITE_TAC[closure] THEN ASM SET_TAC[]]);; let CLOSED_IN_INTER_CLOSURE = prove (`!s t:real^N->bool. closed_in (subtopology euclidean s) t <=> s INTER closure t = t`, REWRITE_TAC[closure; CLOSED_IN_LIMPT] THEN SET_TAC[]);; let INTERIOR_CLOSURE_IDEMP = prove (`!s:real^N->bool. interior(closure(interior(closure s))) = interior(closure s)`, REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[INTERIOR_OF_CLOSURE_OF_IDEMP]);; let CLOSURE_INTERIOR_IDEMP = prove (`!s:real^N->bool. closure(interior(closure(interior s))) = closure(interior s)`, REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[CLOSURE_OF_INTERIOR_OF_IDEMP]);; let NOWHERE_DENSE_UNION = prove (`!s t:real^N->bool. interior(closure(s UNION t)) = {} <=> interior(closure s) = {} /\ interior(closure t) = {}`, SIMP_TAC[CLOSURE_UNION; INTERIOR_UNION_EQ_EMPTY; CLOSED_CLOSURE]);; let NOWHERE_DENSE = prove (`!s:real^N->bool. interior(closure s) = {} <=> !t. open t /\ ~(t = {}) ==> ?u. open u /\ ~(u = {}) /\ u SUBSET t /\ u INTER s = {}`, GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY_ALT] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THENL [EXISTS_TAC `t DIFF closure s:real^N->bool` THEN ASM_SIMP_TAC[OPEN_DIFF; CLOSED_CLOSURE] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]; FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM SET_TAC[]]);; let INTERIOR_CLOSURE_INTER_OPEN = prove (`!s t:real^N->bool. open s /\ open t ==> interior(closure(s INTER t)) = interior(closure s) INTER interior(closure t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `u = s INTER t <=> s INTER t SUBSET u /\ u SUBSET s /\ u SUBSET t`] THEN SIMP_TAC[SUBSET_INTERIOR; SUBSET_CLOSURE; INTER_SUBSET] THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[OPEN_INTER; OPEN_INTERIOR] THEN REWRITE_TAC[SET_RULE `s SUBSET t <=> s INTER (UNIV DIFF t) = {}`; GSYM INTERIOR_COMPLEMENT] THEN REWRITE_TAC[GSYM INTERIOR_INTER] THEN REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`u INTER s:real^N->bool`; `t:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`] OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);; let CLOSURE_INTERIOR_UNION_CLOSED = prove (`!s t:real^N->bool. closed s /\ closed t ==> closure(interior(s UNION t)) = closure(interior s) UNION closure(interior t)`, REPEAT GEN_TAC THEN REWRITE_TAC[closed] THEN DISCH_THEN(MP_TAC o MATCH_MP INTERIOR_CLOSURE_INTER_OPEN) THEN REWRITE_TAC[CLOSURE_COMPLEMENT; INTERIOR_COMPLEMENT; SET_RULE `(UNIV DIFF s) INTER (UNIV DIFF t) = UNIV DIFF (s UNION t)`] THEN SET_TAC[]);; let REGULAR_OPEN_INTER = prove (`!s t:real^N->bool. interior(closure s) = s /\ interior(closure t) = t ==> interior(closure(s INTER t)) = s INTER t`, MESON_TAC[INTERIOR_CLOSURE_INTER_OPEN; OPEN_INTERIOR]);; let REGULAR_CLOSED_UNION = prove (`!s t:real^N->bool. closure(interior s) = s /\ closure(interior t) = t ==> closure(interior(s UNION t)) = s UNION t`, MESON_TAC[CLOSURE_INTERIOR_UNION_CLOSED; CLOSED_CLOSURE]);; let REGULAR_CLOSED_UNIONS = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!t. t IN f ==> closure(interior t) = t) ==> closure(interior(UNIONS f)) = UNIONS f`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_INSERT; UNIONS_0; INTERIOR_EMPTY; CLOSURE_EMPTY] THEN SIMP_TAC[FORALL_IN_INSERT; REGULAR_CLOSED_UNION]);; let DIFF_CLOSURE_SUBSET = prove (`!s t:real^N->bool. closure(s) DIFF closure t SUBSET closure(s DIFF t)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`(:real^N) DIFF closure t`; `s:real^N->bool`] OPEN_INTER_CLOSURE_SUBSET) THEN REWRITE_TAC[SET_RULE `(UNIV DIFF t) INTER s = s DIFF t`] THEN REWRITE_TAC[GSYM closed; CLOSED_CLOSURE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s DIFF u SUBSET s DIFF t`) THEN REWRITE_TAC[CLOSURE_SUBSET]);; let DENSE_OPEN_INTER = prove (`!s t u:real^N->bool. (open_in (subtopology euclidean u) s /\ t SUBSET u \/ open_in (subtopology euclidean u) t /\ s SUBSET u) ==> (u SUBSET closure (s INTER t) <=> u SUBSET closure s /\ u SUBSET closure t)`, MATCH_MP_TAC(MESON[] `(!s t u. R s t u ==> R t s u) /\ (!s t u. P s t u ==> R s t u) ==> !s t u. P s t u \/ P t s u ==> R s t u`) THEN CONJ_TAC THENL [SIMP_TAC[INTER_COMM; CONJ_ACI]; ALL_TAC] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; SUBSET_CLOSURE; INTER_SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `x:real^N`) ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN REWRITE_TAC[SUBSET; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `y:real^N`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d (e / &2)`) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN CONV_TAC NORM_ARITH);; let DENSE_OPEN_INTERS = prove (`!g s:real^N->bool. FINITE g /\ (!t. t IN g ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t) ==> s SUBSET closure (INTERS g)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INTERS_0; CLOSURE_UNIV; SUBSET_UNIV] THEN REWRITE_TAC[FORALL_IN_INSERT; INTERS_INSERT] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `f:(real^N->bool)->bool`] THEN STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_SIMP_TAC[INTERS_0; INTER_UNIV] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) DENSE_OPEN_INTER o snd) THEN ANTS_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN DISJ1_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `u:real^N->bool`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET o CONJUNCT1) THEN ASM SET_TAC[]);; let SEPARATION_CLOSED_IN_UNION = prove (`!s t:real^N->bool. s INTER closure t = {} /\ t INTER closure s = {} <=> DISJOINT s t /\ closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let SEPARATION_OPEN_IN_UNION = prove (`!s t:real^N->bool. s INTER closure t = {} /\ t INTER closure s = {} <=> DISJOINT s t /\ open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_UNION] THEN REWRITE_TAC[SEPARATION_CLOSED_IN_UNION] THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV[CONJ_SYM] THEN BINOP_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let CONNECTED_SEPARATION,CONNECTED_SEPARATION_ALT = (CONJ_PAIR o prove) (`(!s:real^N->bool. connected s <=> ~(?c1 c2. c1 UNION c2 = s /\ ~(c1 = {}) /\ ~(c2 = {}) /\ c1 INTER closure c2 = {} /\ c2 INTER closure c1 = {})) /\ (!s:real^N->bool. connected s <=> ~(?c1 c2. s SUBSET c1 UNION c2 /\ ~(c1 INTER s = {}) /\ ~(c2 INTER s = {}) /\ c1 INTER closure c2 = {} /\ c2 INTER closure c1 = {}))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (~q ==> p) /\ (r ==> ~p) ==> (p <=> ~q) /\ (p <=> ~r)`) THEN REPEAT CONJ_TAC THENL [REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SET_TAC[]; REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; CONTRAPOS_THM] THEN REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c1:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c2:real^N->bool` THEN SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c1:real^N->bool`; `c2:real^N->bool`] THEN STRIP_TAC THEN REWRITE_TAC[CONNECTED_CLOSED] THEN MAP_EVERY EXISTS_TAC [`closure c1:real^N->bool`; `closure c2:real^N->bool`] THEN REWRITE_TAC[CLOSED_CLOSURE] THEN MP_TAC(ISPEC `c1:real^N->bool` CLOSURE_SUBSET) THEN MP_TAC(ISPEC `c2:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Frontier (aka boundary). *) (* ------------------------------------------------------------------------- *) let frontier = new_definition `frontier s = (closure s) DIFF (interior s)`;; let FRONTIER_CLOSED = prove (`!s. closed(frontier s)`, SIMP_TAC[frontier; CLOSED_DIFF; CLOSED_CLOSURE; OPEN_INTERIOR]);; let FRONTIER_CLOSURES = prove (`!s:real^N->bool. frontier s = (closure s) INTER (closure(UNIV DIFF s))`, let lemma = prove(`s DIFF (UNIV DIFF t) = s INTER t`,SET_TAC[]) in REWRITE_TAC[frontier; INTERIOR_CLOSURE; lemma]);; let EUCLIDEAN_FRONTIER_OF = prove (`!s:real^N->bool. euclidean frontier_of s = frontier s`, REWRITE_TAC[frontier; frontier_of] THEN REWRITE_TAC[EUCLIDEAN_CLOSURE_OF; EUCLIDEAN_INTERIOR_OF]);; let FRONTIER_OPEN_STRADDLE_INTER = prove (`!s u:real^N->bool. open u /\ ~(u INTER frontier s = {}) ==> ~(u INTER s = {}) /\ ~(u DIFF s = {})`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[FRONTIER_CLOSURES] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(s INTER t INTER u = {}) ==> ~(s INTER t = {}) /\ ~(s INTER u = {})`)) THEN MATCH_MP_TAC MONO_AND THEN ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN SET_TAC[]);; let FRONTIER_UNION_INTERIOR = prove (`!s:real^N->bool. frontier s UNION interior s = closure s`, GEN_TAC THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let FRONTIER_STRADDLE = prove (`!a:real^N s. a IN frontier s <=> !e. &0 < e ==> (?x. x IN s /\ dist(a,x) < e) /\ (?x. ~(x IN s) /\ dist(a,x) < e)`, REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES; IN_INTER] THEN REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; limit_point_of; IN_UNIV; IN_DIFF] THEN ASM_MESON_TAC[IN_BALL; SUBSET; OPEN_CONTAINS_BALL; CENTRE_IN_BALL; OPEN_BALL; DIST_REFL]);; let FRONTIER_SUBSET_CLOSED = prove (`!s. closed s ==> (frontier s) SUBSET s`, MESON_TAC[frontier; CLOSURE_CLOSED; SUBSET_DIFF]);; let FRONTIER_EMPTY = prove (`frontier {} = {}`, REWRITE_TAC[frontier; CLOSURE_EMPTY; EMPTY_DIFF]);; let FRONTIER_UNIV = prove (`frontier(:real^N) = {}`, REWRITE_TAC[frontier; CLOSURE_UNIV; INTERIOR_UNIV] THEN SET_TAC[]);; let FRONTIER_SUBSET_EQ = prove (`!s:real^N->bool. (frontier s) SUBSET s <=> closed s`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[FRONTIER_SUBSET_CLOSED] THEN REWRITE_TAC[frontier] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s DIFF t SUBSET u ==> t SUBSET u ==> s SUBSET u`)) THEN REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET_EQ]);; let FRONTIER_COMPLEMENT = prove (`!s:real^N->bool. frontier(UNIV DIFF s) = frontier s`, REWRITE_TAC[frontier; CLOSURE_COMPLEMENT; INTERIOR_COMPLEMENT] THEN SET_TAC[]);; let FRONTIER_DISJOINT_EQ = prove (`!s. (frontier s) INTER s = {} <=> open s`, ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT; OPEN_CLOSED] THEN REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN SET_TAC[]);; let FRONTIER_INTER = prove (`!s t:real^N->bool. frontier(s INTER t) = closure(s INTER t) INTER (frontier s UNION frontier t)`, REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES] THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET; GSYM CLOSURE_UNION; SET_RULE `u SUBSET s /\ u SUBSET t ==> u INTER (s INTER x UNION t INTER y) = u INTER (x UNION y)`] THEN REPLICATE_TAC 2 AP_TERM_TAC THEN SET_TAC[]);; let FRONTIER_INTER_SUBSET = prove (`!s t. frontier(s INTER t) SUBSET frontier(s) UNION frontier(t)`, REWRITE_TAC[FRONTIER_INTER] THEN SET_TAC[]);; let FRONTIER_INTER_CLOSED = prove (`!s t:real^N->bool. closed s /\ closed t ==> frontier(s INTER t) = frontier s INTER t UNION s INTER frontier t`, SIMP_TAC[FRONTIER_INTER; CLOSED_INTER; CLOSURE_CLOSED] THEN REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN SET_TAC[]);; let FRONTIER_UNION_SUBSET = prove (`!s t:real^N->bool. frontier(s UNION t) SUBSET frontier s UNION frontier t`, ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN REWRITE_TAC[SET_RULE `u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)`] THEN REWRITE_TAC[FRONTIER_INTER_SUBSET]);; let FRONTIER_INTERIORS = prove (`!s. frontier s = (:real^N) DIFF interior(s) DIFF interior((:real^N) DIFF s)`, REWRITE_TAC[frontier; CLOSURE_INTERIOR] THEN SET_TAC[]);; let FRONTIER_FRONTIER_SUBSET = prove (`!s:real^N->bool. frontier(frontier s) SUBSET frontier s`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN SIMP_TAC[CLOSURE_CLOSED; FRONTIER_CLOSED] THEN SET_TAC[]);; let INTERIOR_FRONTIER = prove (`!s:real^N->bool. interior(frontier s) = interior(closure s) DIFF closure(interior s)`, REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; INTERIOR_OF_FRONTIER_OF]);; let THIN_FRONTIER_SUBSET = prove (`!s:real^N->bool. interior(frontier s) = {} <=> interior(closure s) SUBSET closure(interior s)`, REWRITE_TAC[INTERIOR_FRONTIER] THEN SET_TAC[]);; let THIN_FRONTIER_CIC = prove (`!s:real^N->bool. interior(frontier s) = {} <=> closure(interior(closure s)) = closure(interior s)`, REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; THIN_FRONTIER_OF_CIC]);; let THIN_FRONTIER_ICI = prove (`!s:real^N->bool. interior(frontier s) = {} <=> interior(closure(interior s)) = interior(closure s)`, REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; THIN_FRONTIER_OF_ICI]);; let INTERIOR_FRONTIER_EMPTY = prove (`!s:real^N->bool. open s \/ closed s ==> interior(frontier s) = {}`, REWRITE_TAC[OPEN_IN; CLOSED_IN; GSYM EUCLIDEAN_INTERIOR_OF] THEN REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; INTERIOR_OF_FRONTIER_OF_EMPTY]);; let FRONTIER_FRONTIER = prove (`!s:real^N->bool. open s \/ closed s ==> frontier(frontier s) = frontier s`, REWRITE_TAC[OPEN_IN; CLOSED_IN; GSYM EUCLIDEAN_FRONTIER_OF] THEN REWRITE_TAC[FRONTIER_OF_FRONTIER_OF]);; let FRONTIER_FRONTIER_FRONTIER = prove (`!s:real^N->bool. frontier(frontier(frontier s)) = frontier(frontier s)`, SIMP_TAC[FRONTIER_FRONTIER; FRONTIER_CLOSED]);; let UNION_FRONTIER = prove (`!s t:real^N->bool. frontier(s) UNION frontier(t) = frontier(s UNION t) UNION frontier(s INTER t) UNION frontier(s) INTER frontier(t)`, let lemma = prove (`!s t x. x IN frontier s /\ x IN interior t ==> x IN frontier(s INTER t)`, REWRITE_TAC[FRONTIER_STRADDLE; IN_INTER; IN_INTERIOR; SUBSET; IN_BALL] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `d:real`)) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min d e:real`) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]) in REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNION_SUBSET; FRONTIER_UNION_SUBSET; FRONTIER_INTER_SUBSET; SET_RULE `s INTER t SUBSET s UNION t`] THEN REWRITE_TAC[GSYM UNION_SUBSET] THEN REWRITE_TAC[SUBSET; IN_UNION] THEN MATCH_MP_TAC(MESON[] `(!s t x. P s x ==> R x s t) /\ (!s t x. R x s t <=> R x t s) ==> (!s t x. P s x \/ P t x ==> R x s t)`) THEN CONJ_TAC THENL [REPEAT STRIP_TAC; REWRITE_TAC[UNION_COMM; INTER_COMM]] THEN ASM_CASES_TAC `(x:real^N) IN frontier t` THEN ASM_REWRITE_TAC[IN_INTER] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [FRONTIER_INTERIORS]) THEN REWRITE_TAC[DE_MORGAN_THM; IN_DIFF; IN_UNIV] THEN GEN_REWRITE_TAC RAND_CONV [DISJ_SYM] THEN MATCH_MP_TAC MONO_OR THEN ASM_SIMP_TAC[lemma] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN SIMP_TAC[lemma; SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`]);; let CONNECTED_INTER_FRONTIER = prove (`!s t:real^N->bool. connected s /\ ~(s INTER t = {}) /\ ~(s DIFF t = {}) ==> ~(s INTER frontier t = {})`, REWRITE_TAC[FRONTIER_INTERIORS] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`s INTER interior t:real^N->bool`; `s INTER (interior((:real^N) DIFF t))`] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_INTERIOR] THEN MAP_EVERY (MP_TAC o C ISPEC INTERIOR_SUBSET) [`t:real^N->bool`; `(:real^N) DIFF t`] THEN ASM SET_TAC[]);; let FRONTIER_NOT_EMPTY = prove (`!s. ~(s = {}) /\ ~(s = (:real^N)) ==> ~(frontier s = {})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_UNIV] THEN ASM SET_TAC[]);; let FRONTIER_EQ_EMPTY = prove (`!s. frontier s = {} <=> s = {} \/ s = (:real^N)`, MESON_TAC[FRONTIER_NOT_EMPTY; FRONTIER_EMPTY; FRONTIER_UNIV]);; let INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER = prove (`!s:real^N->bool. closed s /\ interior s = {} <=> ?t. open t /\ s = frontier t`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC `(:real^N) DIFF s` THEN ASM_SIMP_TAC[OPEN_DIFF; OPEN_UNIV; FRONTIER_COMPLEMENT] THEN ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY]; ASM_SIMP_TAC[FRONTIER_CLOSED; INTERIOR_FRONTIER_EMPTY]]);; let FRONTIER_UNION = prove (`!s t:real^N->bool. closure s INTER closure t = {} ==> frontier(s UNION t) = frontier(s) UNION frontier(t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[FRONTIER_UNION_SUBSET] THEN GEN_REWRITE_TAC RAND_CONV [frontier] THEN REWRITE_TAC[CLOSURE_UNION] THEN MATCH_MP_TAC(SET_RULE `(fs SUBSET cs /\ ft SUBSET ct) /\ k INTER fs = {} /\ k INTER ft = {} ==> (fs UNION ft) SUBSET (cs UNION ct) DIFF k`) THEN CONJ_TAC THENL [REWRITE_TAC[frontier] THEN SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[UNION_COMM] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTER_COMM])] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t = {} ==> s' SUBSET s /\ s' INTER u INTER (UNIV DIFF t) = {} ==> u INTER s' = {}`)) THEN REWRITE_TAC[frontier; SUBSET_DIFF; GSYM INTERIOR_COMPLEMENT] THEN REWRITE_TAC[GSYM INTERIOR_INTER; SET_RULE `(s UNION t) INTER (UNIV DIFF t) = s DIFF t`] THEN MATCH_MP_TAC(SET_RULE `ti SUBSET si ==> (c DIFF si) INTER ti = {}`) THEN SIMP_TAC[SUBSET_INTERIOR; SUBSET_DIFF]);; let CLOSURE_UNION_FRONTIER = prove (`!s:real^N->bool. closure s = s UNION frontier s`, GEN_TAC THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let FRONTIER_INTERIOR_SUBSET = prove (`!s:real^N->bool. frontier(interior s) SUBSET frontier s`, GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_INTERIOR] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t DIFF u`) THEN SIMP_TAC[SUBSET_CLOSURE; INTERIOR_SUBSET]);; let FRONTIER_CLOSURE_SUBSET = prove (`!s:real^N->bool. frontier(closure s) SUBSET frontier s`, GEN_TAC THEN REWRITE_TAC[frontier; CLOSURE_CLOSURE] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u DIFF t SUBSET u DIFF s`) THEN SIMP_TAC[SUBSET_INTERIOR; CLOSURE_SUBSET]);; let SET_DIFF_FRONTIER = prove (`!s:real^N->bool. s DIFF frontier s = interior s`, GEN_TAC THEN REWRITE_TAC[frontier] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; let FRONTIER_INTER_SUBSET_INTER = prove (`!s t:real^N->bool. frontier(s INTER t) SUBSET closure s INTER frontier t UNION frontier s INTER closure t`, REPEAT GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_INTER] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] CLOSURE_INTER_SUBSET) THEN SET_TAC[]);; let COMMON_FRONTIER_DOMAINS = prove (`!s t:real^N->bool. open s /\ open t /\ connected s /\ connected t /\ frontier s = frontier t ==> s = t \/ DISJOINT s t`, REWRITE_TAC[SET_RULE `s = t \/ DISJOINT s t <=> (s SUBSET t \/ DISJOINT s t) /\ (t SUBSET s \/ DISJOINT t s)`] THEN MATCH_MP_TAC(MESON[] `(!x y. P x y ==> P y x) /\ (!x y. P x y ==> Q x y) ==> !x y. P x y ==> Q x y /\ Q y x`) THEN CONJ_TAC THENL [MESON_TAC[]; REPEAT STRIP_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN SET_TAC[]);; let FRONTIER_OPEN_UNION = prove (`!s t:real^N->bool. open s /\ open t /\ DISJOINT s t ==> frontier(s UNION t) = frontier s UNION frontier t`, REWRITE_TAC[DISJOINT; FRONTIER_CLOSURES] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED; OPEN_UNION] THEN REWRITE_TAC[CLOSURE_UNION] THEN SUBGOAL_THEN `(s:real^N->bool) INTER closure t = {} /\ t INTER closure s = {}` MP_TAC THENL [ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let FRONTIER_OPEN_UNIONS = prove (`!f:(real^N->bool)->bool. FINITE f /\ (!s. s IN f ==> open s) /\ pairwise DISJOINT f ==> frontier(UNIONS f) = UNIONS {frontier s | s IN f}`, REWRITE_TAC[IMP_CONJ; SIMPLE_IMAGE] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_0; UNIONS_INSERT] THEN REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; FRONTIER_EMPTY; UNIONS_INSERT] THEN REWRITE_TAC[PAIRWISE_INSERT] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) ASSUME_TAC) THEN MATCH_MP_TAC FRONTIER_OPEN_UNION THEN ASM_SIMP_TAC[OPEN_UNIONS] THEN REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN ASM_MESON_TAC[DISJOINT]);; let CONNECTED_CLOSURE_FROM_FRONTIER = prove (`!s:real^N->bool. connected(frontier s) ==> connected(closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN EXISTS_TAC `connected(closure((:real^N) DIFF s))` THEN MATCH_MP_TAC CONNECTED_FROM_CLOSED_UNION_AND_INTER THEN ASM_REWRITE_TAC[CLOSED_CLOSURE; GSYM FRONTIER_CLOSURES] THEN SUBGOAL_THEN `closure s UNION closure ((:real^N) DIFF s) = (:real^N)` (fun th -> REWRITE_TAC[th; CONNECTED_UNIV]) THEN MATCH_MP_TAC(SET_RULE `s SUBSET closure s /\ (:real^N) DIFF s SUBSET closure((:real^N) DIFF s) ==> closure s UNION closure ((:real^N) DIFF s) = (:real^N)`) THEN REWRITE_TAC[CLOSURE_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Useful nets in Euclidean space. *) (* ------------------------------------------------------------------------- *) parse_as_infix("in_direction",(14,"right"));; let at = new_definition `at a = mk_net(\x y. &0 < dist(x,a) /\ dist(x,a) <= dist(y,a))`;; let at_infinity = new_definition `at_infinity = mk_net(\x y. norm(x) >= norm(y))`;; let at_posinfinity = new_definition `at_posinfinity = mk_net(\x y:real. x >= y)`;; let at_neginfinity = new_definition `at_neginfinity = mk_net(\x y:real. x <= y)`;; let in_direction = new_definition `a in_direction v = (at a) within {b | ?c. &0 <= c /\ (b - a = c % v)}`;; let AT = prove (`!a:real^N x y. netord(at a) x y <=> &0 < dist(x,a) /\ dist(x,a) <= dist(y,a)`, GEN_TAC THEN NET_PROVE_TAC[at] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);; let AT_INFINITY = prove (`!x y. netord at_infinity x y <=> norm(x) >= norm(y)`, NET_PROVE_TAC[at_infinity] THEN REWRITE_TAC[real_ge; REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; let AT_POSINFINITY = prove (`!x y. netord at_posinfinity x y <=> x >= y`, NET_PROVE_TAC[at_posinfinity] THEN REWRITE_TAC[real_ge; REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; let AT_NEGINFINITY = prove (`!x y. netord at_neginfinity x y <=> x <= y`, NET_PROVE_TAC[at_neginfinity] THEN REWRITE_TAC[real_ge; REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; let IN_DIRECTION = prove (`!a v x y. netord(a in_direction v) x y <=> &0 < dist(x,a) /\ dist(x,a) <= dist(y,a) /\ ?c. &0 <= c /\ (x - a = c % v)`, REWRITE_TAC[WITHIN; AT; in_direction; IN_ELIM_THM; CONJ_ACI]);; let WITHIN_UNIV = prove (`!x:real^N. at x within UNIV = at x`, REWRITE_TAC[NET_WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Trivial limits for our common cases. *) (* ------------------------------------------------------------------------- *) let TRIVIAL_LIMIT_WITHIN = prove (`!a:real^N. trivial_limit (at a within s) <=> ~(a limit_point_of s)`, REWRITE_TAC[trivial_limit; LIMPT_APPROACHABLE_LE; WITHIN; AT; DIST_NZ] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MESON_TAC[REAL_LT_01; REAL_LT_REFL; VECTOR_CHOOSE_DIST; DIST_REFL; REAL_LT_IMP_LE]; DISCH_THEN(X_CHOOSE_THEN `b:real^N` (X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `&0 < dist(a,b:real^N) \/ &0 < dist(a,c:real^N)` MP_TAC THEN ASM_MESON_TAC[DIST_TRIANGLE; DIST_SYM; GSYM DIST_NZ; GSYM DIST_EQ_0; REAL_ARITH `x <= &0 + &0 ==> ~(&0 < x)`]]; REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN DISJ2_TAC THEN EXISTS_TAC `a:real^N` THEN SUBGOAL_THEN `?b:real^N. dist(a,b) = e` MP_TAC THENL [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]]);; let TRIVIAL_LIMIT_AT = prove (`!a. ~(trivial_limit (at a))`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_OF_UNIV]);; let TRIVIAL_LIMIT_AT_INFINITY = prove (`~(trivial_limit at_infinity)`, REWRITE_TAC[trivial_limit; AT_INFINITY; real_ge] THEN MESON_TAC[REAL_LE_REFL; VECTOR_CHOOSE_SIZE; REAL_LT_01; REAL_LT_LE]);; let TRIVIAL_LIMIT_AT_POSINFINITY = prove (`~(trivial_limit at_posinfinity)`, REWRITE_TAC[trivial_limit; AT_POSINFINITY; DE_MORGAN_THM] THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; real_ge; REAL_NOT_LE] THEN MESON_TAC[REAL_LT_TOTAL; REAL_LT_ANTISYM]);; let TRIVIAL_LIMIT_AT_NEGINFINITY = prove (`~(trivial_limit at_neginfinity)`, REWRITE_TAC[trivial_limit; AT_NEGINFINITY; DE_MORGAN_THM] THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; real_ge; REAL_NOT_LE] THEN MESON_TAC[REAL_LT_TOTAL; REAL_LT_ANTISYM]);; let LIM_WITHIN_CLOSED_TRIVIAL = prove (`!a s. closed s /\ ~(a IN s) ==> trivial_limit (at a within s)`, REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN MESON_TAC[CLOSED_LIMPT]);; (* ------------------------------------------------------------------------- *) (* The "eventually" property in Euclidean space. *) (* ------------------------------------------------------------------------- *) let EVENTUALLY_WITHIN_LE = prove (`!s a:real^M p. eventually p (at a within s) <=> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> p(x)`, REWRITE_TAC[eventually; AT; WITHIN; TRIVIAL_LIMIT_WITHIN] THEN REWRITE_TAC[LIMPT_APPROACHABLE_LE; DIST_NZ] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LTE_TRANS]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> ~a \/ b`) THEN DISCH_TAC THEN SUBGOAL_THEN `?b:real^M. dist(a,b) = d` MP_TAC THENL [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^M` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]);; let EVENTUALLY_WITHIN = prove (`!s a:real^M p. eventually p (at a within s) <=> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, REWRITE_TAC[EVENTUALLY_WITHIN_LE] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN REWRITE_TAC[APPROACHABLE_LT_LE]);; let EVENTUALLY_WITHIN_TOPOLOGICAL = prove (`!P s a:real^N. eventually P (at a within s) <=> ?t. open t /\ a IN t /\ !x. x IN s INTER (t DELETE a) ==> P x`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(a:real^N,d)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; IN_INTER; IN_DELETE] THEN REWRITE_TAC[IN_BALL; DIST_NZ] THEN ASM_MESON_TAC[DIST_SYM]; DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER; IN_DELETE; DIST_NZ] THEN ASM_MESON_TAC[DIST_SYM]]);; let EVENTUALLY_AT = prove (`!a p. eventually p (at a) <=> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[EVENTUALLY_WITHIN; IN_UNIV]);; let EVENTUALLY_AT_TOPOLOGICAL = prove (`!P a:real^N. eventually P (at a) <=> ?t. open t /\ a IN t /\ !x. x IN t DELETE a ==> P x`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[EVENTUALLY_WITHIN_TOPOLOGICAL; IN_INTER; IN_UNIV]);; let EVENTUALLY_HAPPENS_AT = prove (`!P a:real^N. eventually P (at a) ==> ?b. ~(b = a) /\ P b`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `eventually (\b:real^N. ~(b = a) /\ P b) (at a)` MP_TAC THENL [POP_ASSUM MP_TAC THEN REWRITE_TAC[EVENTUALLY_AT] THEN MESON_TAC[DIST_NZ; DIST_SYM]; DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN SIMP_TAC[TRIVIAL_LIMIT_AT]]);; let EVENTUALLY_AT_INFINITY = prove (`!p. eventually p at_infinity <=> ?b. !x. norm(x) >= b ==> p x`, REWRITE_TAC[eventually; AT_INFINITY; TRIVIAL_LIMIT_AT_INFINITY] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN METIS_TAC[real_ge; REAL_LE_REFL; VECTOR_CHOOSE_SIZE; REAL_ARITH `&0 <= b \/ (!x. x >= &0 ==> x >= b)`]);; let EVENTUALLY_AT_INFINITY_WITHIN = prove (`!p s:real^N->bool. eventually p (at_infinity within s) <=> ?b. !x. x IN s /\ norm(x) >= b ==> p x`, REPEAT GEN_TAC THEN REWRITE_TAC[eventually; WITHIN; AT_INFINITY; trivial_limit] THEN SIMP_TAC[MESON[VEC_EQ; ARITH_RULE `~(1 = 0)`] `~(!a b:real^N. a = b)`] THEN EQ_TAC THENL [DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `max (norm(a:real^N)) (norm(b:real^N))` THEN REWRITE_TAC[REAL_ARITH `x >= max a b <=> x >= a /\ x >= b`] THEN ASM_MESON_TAC[]; MESON_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `?x:real^N. norm(x) >= b /\ x IN s` THENL [ASM_MESON_TAC[real_ge; REAL_LE_REFL; REAL_LE_TRANS]; ALL_TAC] THEN DISJ1_TAC THEN MAP_EVERY EXISTS_TAC [`(abs b + &1) % basis 1:real^N`; `(abs b + &2) % basis 1:real^N`] THEN SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN CONJ_TAC THENL [REAL_ARITH_TAC; X_GEN_TAC `x:real^N`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ (r ==> p) ==> ~(p /\ s) ==> ~(q /\ s) /\ ~(r /\ s)`) THEN REWRITE_TAC[real_ge] THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC]);; let EVENTUALLY_AT_POSINFINITY = prove (`!p. eventually p at_posinfinity <=> ?b. !x. x >= b ==> p x`, REWRITE_TAC[eventually; TRIVIAL_LIMIT_AT_POSINFINITY; AT_POSINFINITY] THEN MESON_TAC[REAL_ARITH `x >= x`]);; let EVENTUALLY_AT_NEGINFINITY = prove (`!p. eventually p at_neginfinity <=> ?b. !x. x <= b ==> p x`, REWRITE_TAC[eventually; TRIVIAL_LIMIT_AT_NEGINFINITY; AT_NEGINFINITY] THEN MESON_TAC[REAL_LE_REFL]);; let EVENTUALLY_AT_INFINITY_POS = prove (`!p:real^N->bool. eventually p at_infinity <=> ?b. &0 < b /\ !x. norm x >= b ==> p x`, GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (abs b + &1 <= x ==> b <= x)`]);; let EVENTUALLY_AT_ZERO = prove (`!P:real^N->bool a. eventually P (at a) <=> eventually (\x. P(a + x)) (at (vec 0))`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^N`) THEN REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_SUB_RZERO]; FIRST_X_ASSUM(MP_TAC o SPEC `x - a:real^N`) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_ADD2]]);; let EVENTUALLY_AT_WITHIN = prove (`!P s a:real^N. eventually P (at a) ==> eventually P (at a within s)`, REWRITE_TAC[EVENTUALLY_AT; EVENTUALLY_WITHIN] THEN MESON_TAC[]);; let EVENTUALLY_WITHIN_INTER_IMP = prove (`!P s t a:real^N. eventually P (at a within s INTER t) <=> eventually (\x. x IN t ==> P x) (at a within s)`, REWRITE_TAC[EVENTUALLY_WITHIN; IN_INTER] THEN MESON_TAC[]);; let EVENTUALLY_WITHIN_IMP = prove (`!P s a:real^N. eventually P (at a within s) <=> eventually (\x. x IN s ==> P x) (at a)`, REWRITE_TAC[EVENTUALLY_WITHIN; EVENTUALLY_AT] THEN MESON_TAC[]);; let EVENTUALLY_WITHIN_ZERO = prove (`!P:real^N->bool s a. eventually P (at a within s) <=> eventually (\x. P(a + x)) (at (vec 0) within IMAGE (\x. x - a) s)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[EVENTUALLY_WITHIN_IMP] THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EVENTUALLY_AT_ZERO] THEN REWRITE_TAC[IN_TRANSLATION_GALOIS_ALT] THEN REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`]);; let IN_INTERIOR_EVENTUALLY = prove (`!s a:real^N. a IN interior s <=> a IN s /\ eventually (\x. x IN s) (at a)`, REWRITE_TAC[IN_INTERIOR; EVENTUALLY_AT; SUBSET; IN_BALL; GSYM DIST_NZ] THEN MESON_TAC[DIST_SYM; DIST_REFL]);; let EVENTUALLY_WITHIN_INTERIOR = prove (`!p s x:real^N. x IN interior s ==> (eventually p (at x within s) <=> eventually p (at x))`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_INTERIOR_EVENTUALLY] THEN MATCH_MP_TAC(TAUT `(p /\ q ==> r) /\ (p /\ r ==> q) ==> p' /\ p ==> (q <=> r)`) THEN REWRITE_TAC[GSYM EVENTUALLY_AND; EVENTUALLY_WITHIN_IMP] THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN SIMP_TAC[]);; let EVENTUALLY_IN_OPEN = prove (`!s a:real^N. open s /\ a IN s ==> eventually (\x. x IN s) (at a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] IN_INTERIOR_EVENTUALLY) THEN ASM_SIMP_TAC[INTERIOR_OPEN]);; let EVENTUALLY_WITHIN_OPEN = prove (`!f l a:real^M s. a IN s /\ open s ==> (eventually P (at a within s) <=> eventually P (at a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EVENTUALLY_WITHIN_INTERIOR THEN ASM_MESON_TAC[INTERIOR_OPEN]);; let EVENTUALLY_WITHIN_OPEN_IN = prove (`!P a s t:real^N->bool. a IN t /\ open_in (subtopology euclidean s) t ==> (eventually P (at a within t) <=> eventually P (at a within s))`, REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[EVENTUALLY_WITHIN_IMP] THEN ONCE_REWRITE_TAC[SET_RULE `x IN s INTER t ==> P <=> x IN t ==> x IN s ==> P`] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_WITHIN_IMP] THEN MATCH_MP_TAC EVENTUALLY_WITHIN_OPEN THEN ASM SET_TAC[]);; let EVENTUALLY_WITHIN_INTERIOR_LOCAL = prove (`!P a s t u:real^N->bool. a IN u /\ u SUBSET t /\ t SUBSET s /\ open_in (subtopology euclidean s) u ==> (eventually P (at a within t) <=> eventually P (at a within s))`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `eventually P (at (a:real^N) within u)` THEN MATCH_MP_TAC(TAUT `(s ==> t) /\ (t ==> u) /\ (u <=> s) ==> (t <=> u) /\ (u <=> s)`) THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[EVENTUALLY_WITHIN_OPEN_IN]] THEN REWRITE_TAC[EVENTUALLY_WITHIN_IMP] THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);; let EVENTUALLY_SCALABLE_PROPERTY = prove (`!P. (!c x:real^N. &0 <= c /\ P x ==> P(c % x)) /\ eventually P (at (vec 0)) ==> !x. P x`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVENTUALLY_AT]) THEN REWRITE_TAC[EVENTUALLY_AT; DIST_0; NORM_POS_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [SUBGOAL_THEN `?y:real^N. norm(y) = d / &2` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC VECTOR_CHOOSE_SIZE THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN ASM_REWRITE_TAC[GSYM NORM_EQ_0] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`&0`; `y:real^N`]) THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL]; FIRST_X_ASSUM(MP_TAC o SPEC `d / &2 / norm(x) % x:real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; NORM_MUL; REAL_DIV_EQ_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_LT_IMP_NZ; REAL_ABS_DIV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`norm(x:real^N) / (d / &2)`; `d / &2 / norm(x) % x:real^N`]) THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_HALF; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; REAL_FIELD `~(n = &0) /\ &0 < d ==> n / (d / &2) * d / &2 / n = &1`] THEN REWRITE_TAC[VECTOR_MUL_LID]]);; let EVENTUALLY_SCALABLE_PROPERTY_EQ = prove (`!P. (!c x:real^N. &0 <= c /\ P x ==> P(c % x)) ==> (eventually P (at (vec 0)) <=> !x. P x)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[ALWAYS_EVENTUALLY] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_SCALABLE_PROPERTY) THEN ASM_SIMP_TAC[]);; let ONORM_LE_EVENTUALLY = prove (`!f:real^M->real^N b. linear f ==> (onorm f <= b <=> eventually (\y. norm(f y) <= b * norm y) (at (vec 0)))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ONORM_LE_EQ] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC EVENTUALLY_SCALABLE_PROPERTY_EQ THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN REWRITE_TAC[NORM_MUL] THEN MESON_TAC[REAL_LE_LMUL; REAL_ABS_POS; REAL_MUL_AC]);; let EVENTUALLY_WITHIN_REFLECT = prove (`!P s a:real^N. eventually (\x. P(--x)) (at(--a) within IMAGE (--) s) <=> eventually P (at a within s)`, REWRITE_TAC[EVENTUALLY_WITHIN; IMP_CONJ; FORALL_IN_IMAGE] THEN REWRITE_TAC[VECTOR_NEG_NEG; NORM_ARITH `dist(--a:real^N,--b) = dist(a,b)`]);; let EVENTUALLY_AT_REFLECT = prove (`!P a:real^N. eventually (\x. P(--x)) (at(--a)) <=> eventually P (at a)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM EVENTUALLY_WITHIN_REFLECT] THEN REWRITE_TAC[REFLECT_UNIV]);; let EVENTUALLY_WITHIN_DELETE = prove (`!P:real^N->bool s a. eventually P (at a within (s DELETE a)) <=> eventually P (at a within s)`, REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; IN_DELETE] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Limits, defined as vacuously true when the limit is trivial. *) (* ------------------------------------------------------------------------- *) parse_as_infix("-->",(12,"right"));; let tendsto = new_definition `(f --> l) net <=> !e. &0 < e ==> eventually (\x. dist(f(x),l) < e) net`;; let lim = new_definition `lim net f = @l. (f --> l) net`;; let LIM = prove (`(f --> l) net <=> trivial_limit net \/ !e. &0 < e ==> ?y. (?x. netord(net) x y) /\ !x. netord(net) x y ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; eventually] THEN MESON_TAC[]);; let TENDSTO_ALT = prove (`!f:A->real^N l net. (f --> l) net <=> (!s. open s /\ l IN s ==> eventually (\x. f x IN s) net)`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN EQ_TAC THENL [INTRO_TAC "hp; !s; open l" THEN HYP_TAC "open" (REWRITE_RULE[open_def]) THEN REMOVE_THEN "l" (HYP_TAC "open: @e. epos subs" o C MATCH_MP) THEN MATCH_MP_TAC EVENTUALLY_MP THEN EXISTS_TAC `\x:A. dist (f x:real^N, l) < e` THEN ASM_SIMP_TAC[EVENTUALLY_TRUE]; INTRO_TAC "hp; !e; epos" THEN SUBGOAL_THEN `!x:A. dist(f (x),l:real^N) < e <=> f x IN ball(l,e)` (fun th -> ASM_SIMP_TAC[th; OPEN_BALL; CENTRE_IN_BALL]) THEN REWRITE_TAC[IN_BALL; DIST_SYM]]);; let TENDSTO_ALT_WITHIN = prove (`!net f:A->real^N l u. l IN u /\ eventually (\x. f x IN u) net ==> ((f --> l) net <=> !s. open_in (subtopology euclidean u) s /\ l IN s ==> eventually (\x. f x IN s) net)`, REPEAT GEN_TAC THEN SIMP_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[IMP_CONJ; IN_INTER; EVENTUALLY_AND] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN REWRITE_TAC[IMP_IMP; GSYM TENDSTO_ALT]);; let LIM_EVENTUALLY_IN_OPEN_IN = prove (`!net f:A->real^N l u s. l IN s /\ open_in (subtopology euclidean u) s /\ eventually (\x. f x IN u) net /\ (f --> l) net ==> eventually (\x. f x IN s) net`, MP_TAC TENDSTO_ALT_WITHIN THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN STRIP_TAC THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let LIM_EVENTUALLY_IN_OPEN = prove (`!net f:A->real^N l s. open s /\ (f --> l) net /\ l IN s ==> eventually (\x. f x IN s) net`, REWRITE_TAC[TENDSTO_ALT] THEN MESON_TAC[]);; let LIMIT_EUCLIDEAN = prove (`!f:A->real^N x net. limit euclidean f x net <=> (f --> x) net`, REWRITE_TAC[limit; TOPSPACE_EUCLIDEAN; IN_UNIV; GSYM OPEN_IN; TENDSTO_ALT]);; let LIM_WITHIN_REFLECT = prove (`!f:real^M->real^N l a s. ((\x. f(--x)) --> l) (at(--a) within IMAGE (--) s) <=> (f --> l) (at a within s)`, REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_REFLECT]);; let LIM_AT_REFLECT = prove (`!f:real^M->real^N l a. ((\x. f(--x)) --> l) (at(--a)) <=> (f --> l) (at a)`, REWRITE_TAC[tendsto; EVENTUALLY_AT_REFLECT]);; let LIM_WITHIN_ZERO = prove (`!f:real^M->real^N l s a. (f --> l) (at a within s) <=> ((\x. f(a + x)) --> l) (at(vec 0) within IMAGE (\x. x - a) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EVENTUALLY_WITHIN_ZERO] THEN REWRITE_TAC[]);; let LIM_WITHIN_DELETE = prove (`!f:real^M->real^N l s a. (f --> l) (at a within (s DELETE a)) <=> (f --> l) (at a within s)`, REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_DELETE]);; (* ------------------------------------------------------------------------- *) (* Show that they yield usual definitions in the various cases. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_LE = prove (`!f:real^M->real^N l a s. (f --> l)(at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LE]);; let LIM_WITHIN = prove (`!f:real^M->real^N l a s. (f --> l) (at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_WITHIN] THEN MESON_TAC[]);; let LIM_AT_LE = prove (`!f l a. (f --> l) (at a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) <= d ==> dist (f x,l) < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_LE; IN_UNIV]);; let LIM_AT = prove (`!f l:real^N a:real^M. (f --> l) (at a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_AT] THEN MESON_TAC[]);; let LIM_AT_INFINITY = prove (`!f l. (f --> l) at_infinity <=> !e. &0 < e ==> ?b. !x. norm(x) >= b ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);; let LIM_AT_INFINITY_POS = prove (`!f l. (f --> l) at_infinity <=> !e. &0 < e ==> ?b. &0 < b /\ !x. norm x >= b ==> dist(f x,l) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY] THEN MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);; let LIM_AT_POSINFINITY = prove (`!f l. (f --> l) at_posinfinity <=> !e. &0 < e ==> ?b. !x. x >= b ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]);; let LIM_AT_NEGINFINITY = prove (`!f l. (f --> l) at_neginfinity <=> !e. &0 < e ==> ?b. !x. x <= b ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]);; let LIM_AT_INFINITY_WITHIN = prove (`!f:real^M->real^N l s. (f --> l) (at_infinity within s) <=> !e. &0 < e ==> ?b. !x. x IN s /\ norm(x) >= b ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY_WITHIN] THEN MESON_TAC[]);; let LIM_AT_INFINITY_WITHIN_POS = prove (`!f:real^M->real^N l s. (f --> l) (at_infinity within s) <=> !e. &0 < e ==> ?b. &0 < b /\ !x. x IN s /\ norm(x) >= b ==> dist(f(x),l) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY_WITHIN] THEN MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);; let LIM_SEQUENTIALLY = prove (`!s l. (s --> l) sequentially <=> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s(n),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);; let LIM_EVENTUALLY = prove (`!net f l. eventually (\x. f x = l) net ==> (f --> l) net`, REWRITE_TAC[eventually; LIM] THEN MESON_TAC[DIST_REFL]);; let LIM_POSINFINITY_SEQUENTIALLY = prove (`!f l. (f --> l) at_posinfinity ==> ((\n. f(&n)) --> l) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_POSINFINITY; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN MP_TAC(ISPEC `B:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; let LIM_INFINITY_POSINFINITY_LIFT = prove (`!f l:real^N. (f --> l) at_infinity ==> ((f o lift) --> l) at_posinfinity`, REWRITE_TAC[LIM_AT_INFINITY; LIM_AT_POSINFINITY; o_THM] THEN REWRITE_TAC[FORALL_DROP; NORM_REAL; GSYM drop; LIFT_DROP] THEN MESON_TAC[REAL_ARITH `x >= b ==> abs(x) >= b`]);; let LIM_SELF_WITHIN = prove (`!f:real^M->real^N s a. (f --> f a) (at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ dist(x,a) < d ==> dist(f x,f a) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[DIST_REFL]);; let LIM_SELF_AT = prove (`!f:real^M->real^N a. (f --> f a) (at a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. dist(x,a) < d ==> dist(f x,f a) < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_SELF_WITHIN; IN_UNIV]);; let LIM_SUBSEQUENCE = prove (`!s r l. (!m n. m < n ==> r(m) < r(n)) /\ (s --> l) sequentially ==> (s o r --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[MONOTONE_BIGGER; LE_TRANS]);; let SEQUENTIAL_LIMIT_URYSOHN = prove (`!s l:real^N. (s --> l) sequentially <=> !r. (!m n. m < n ==> r m < r n) ==> ?q:num->num. (!m n. m < n ==> q m < q n) /\ ((s o r o q) --> l) sequentially`, REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[o_THM]; REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `{n | e <= dist((s:num->real^N) n,l)}` num_INFINITE_EQ) THEN REWRITE_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE] THEN REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`; GSYM NOT_EXISTS_THM] THEN REWRITE_TAC[GSYM NOT_FORALL_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `r:num->num`) THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_REFL] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The expected monotonicity property. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_EMPTY = prove (`!f l x. (f --> l) (at x within {})`, REWRITE_TAC[LIM_WITHIN; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);; let LIM_WITHIN_SUBSET = prove (`!f l a s. (f --> l) (at a within s) /\ t SUBSET s ==> (f --> l) (at a within t)`, REWRITE_TAC[LIM_WITHIN; SUBSET] THEN MESON_TAC[]);; let LIM_UNION = prove (`!f x l s t. (f --> l) (at x within s) /\ (f --> l) (at x within t) ==> (f --> l) (at x within (s UNION t))`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; IN_UNION] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_SIMP_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN EXISTS_TAC `min d1 d2` THEN ASM_MESON_TAC[REAL_LT_MIN]);; let LIM_UNION_UNIV = prove (`!f x l s t. (f --> l) (at x within s) /\ (f --> l) (at x within t) /\ s UNION t = (:real^N) ==> (f --> l) (at x)`, MESON_TAC[LIM_UNION; WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Composition of limits. *) (* ------------------------------------------------------------------------- *) let LIM_COMPOSE_WITHIN = prove (`!net f:A->real^N g:real^N->real^P s y z. (f --> y) net /\ eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\ (g --> z) (at y within s) ==> ((g o f) --> z) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; CONJ_ASSOC] THEN ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; o_DEF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN ASM_MESON_TAC[DIST_REFL]);; let LIM_COMPOSE_AT = prove (`!net f:A->real^N g:real^N->real^P y z. (f --> y) net /\ eventually (\w. f w = y ==> g y = z) net /\ (g --> z) (at y) ==> ((g o f) --> z) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->real^N`; `g:real^N->real^P`; `(:real^N)`; `y:real^N`; `z:real^P`] LIM_COMPOSE_WITHIN) THEN ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Interrelations between restricted and unrestricted limits. *) (* ------------------------------------------------------------------------- *) let LIM_AT_WITHIN = prove (`!f l a s. (f --> l)(at a) ==> (f --> l)(at a within s)`, REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN MESON_TAC[]);; let LIM_WITHIN_OPEN = prove (`!f l a:real^M s. a IN s /\ open s ==> ((f --> l) (at a within s) <=> (f --> l) (at a))`, SIMP_TAC[tendsto; EVENTUALLY_WITHIN_OPEN]);; let LIM_WITHIN_OPEN_IN = prove (`!f:real^M->real^N l a s t. a IN t /\ open_in (subtopology euclidean s) t ==> ((f --> l) (at a within t) <=> (f --> l) (at a within s))`, REWRITE_TAC[tendsto] THEN MESON_TAC[EVENTUALLY_WITHIN_OPEN_IN]);; (* ------------------------------------------------------------------------- *) (* Two-sided limits on R^1. *) (* ------------------------------------------------------------------------- *) let TWO_SIDED_LIMIT_WITHIN = prove (`!f s a l:real^N. (f --> l) (at a within s) <=> (f --> l) (at a within s INTER {x | drop x <= drop a}) /\ (f --> l) (at a within s INTER {x | drop a <= drop x})`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN REWRITE_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[EVENTUALLY_WITHIN_INTER_IMP; GSYM EVENTUALLY_AND] THEN REWRITE_TAC[TAUT `(p ==> r) /\ (q ==> r) <=> p \/ q ==> r`] THEN REWRITE_TAC[IN_ELIM_THM; REAL_LE_TOTAL]);; let TWO_SIDED_LIMIT_AT = prove (`!f a l:real^N. (f --> l) (at a) <=> (f --> l) (at a within {x | drop x <= drop a}) /\ (f --> l) (at a within {x | drop a <= drop x})`, REPEAT GEN_TAC THEN SUBST1_TAC(SYM(ISPEC `a:real^1` WITHIN_UNIV)) THEN REWRITE_TAC[WITHIN_WITHIN; GSYM TWO_SIDED_LIMIT_WITHIN]);; let NON_TRIVIAL_LIMIT_LEFT = prove (`!a. ~trivial_limit (at a within {x | drop x <= drop a})`, GEN_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_APPROACHABLE_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `a - lift e` THEN REWRITE_TAC[IN_ELIM_THM; DIST_1; DROP_SUB; LIFT_DROP; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; let NON_TRIVIAL_LIMIT_RIGHT = prove (`!a. ~trivial_limit (at a within {x | drop a <= drop x})`, GEN_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_APPROACHABLE_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `a + lift e` THEN REWRITE_TAC[IN_ELIM_THM; DIST_1; DROP_ADD; DROP_SUB; LIFT_DROP; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* More limit point characterizations. *) (* ------------------------------------------------------------------------- *) let [LIMPT_SEQUENTIAL; LIMPT_SEQUENTIAL_INJ; LIMPT_SEQUENTIAL_DECREASING] = (CONJUNCTS o prove) (`(!x:real^N s. x limit_point_of s <=> ?f. (!n. f(n) IN (s DELETE x)) /\ (f --> x) sequentially) /\ (!x:real^N s. x limit_point_of s <=> ?f. (!n. f(n) IN (s DELETE x)) /\ (!m n. f m = f n <=> m = n) /\ (f --> x) sequentially) /\ (!x:real^N s. x limit_point_of s <=> ?f. (!n. f(n) IN (s DELETE x)) /\ (!m n. m < n ==> dist(f n,x) < dist(f m,x)) /\ (f --> x) sequentially)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(s ==> r) /\ (r ==> q) /\ (q ==> p) /\ (p ==> s) ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC WLOG_LT THEN ASM_MESON_TAC[REAL_LT_REFL]; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN MESON_TAC[LE_REFL]; REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN SUBGOAL_THEN `?f:num->real^N. (!n. (f n) IN s /\ ~(f n = x) /\ dist(f n,x) < inv(&n + &1)) /\ (!n. dist(f(SUC n),x) < dist(f n,x))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `z:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC; GSYM REAL_LT_MIN] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; GSYM DIST_NZ] THEN REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_DELETE] THEN CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `N:num` THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LTE_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]]]);; let [LIMPT_INFINITE_OPEN; LIMPT_INFINITE_BALL; LIMPT_INFINITE_CBALL] = (CONJUNCTS o prove) (`(!s x:real^N. x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t)) /\ (!s x:real^N. x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e))) /\ (!s x:real^N. x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ (r ==> s) /\ (s ==> q) /\ (p ==> r) ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[limit_point_of; INFINITE; SET_RULE `(?y. ~(y = x) /\ y IN s /\ y IN t) <=> ~(s INTER t SUBSET {x})`] THEN MESON_TAC[FINITE_SUBSET; FINITE_SING]; MESON_TAC[INFINITE_SUPERSET; BALL_SUBSET_CBALL; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; MESON_TAC[INFINITE_SUPERSET; OPEN_CONTAINS_CBALL; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `IMAGE (f:num->real^N) (from N)` THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_FROM; IN_INTER] THEN ASM_MESON_TAC[INFINITE_IMAGE_INJ; INFINITE_FROM]]);; let INFINITE_OPEN_IN = prove (`!u s:real^N->bool. open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u) ==> INFINITE s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Condensation points. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("condensation_point_of",(12,"right"));; let condensation_point_of = new_definition `x condensation_point_of s <=> !t. x IN t /\ open t ==> ~COUNTABLE(s INTER t)`;; let CONDENSATION_POINT_OF_SUBSET = prove (`!x:real^N s t. x condensation_point_of s /\ s SUBSET t ==> x condensation_point_of t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[condensation_point_of] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN ASM SET_TAC[]);; let CONDENSATION_POINT_IMP_LIMPT = prove (`!x s. x condensation_point_of s ==> x limit_point_of s`, REWRITE_TAC[condensation_point_of; LIMPT_INFINITE_OPEN; INFINITE] THEN MESON_TAC[FINITE_IMP_COUNTABLE]);; let CONDENSATION_POINT_INFINITE_BALL,CONDENSATION_POINT_INFINITE_CBALL = (CONJ_PAIR o prove) (`(!s x:real^N. x condensation_point_of s <=> !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e))) /\ (!s x:real^N. x condensation_point_of s <=> !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REWRITE_TAC[condensation_point_of] THEN REPEAT CONJ_TAC THENL [MESON_TAC[OPEN_BALL; CENTRE_IN_BALL]; MESON_TAC[BALL_SUBSET_CBALL; COUNTABLE_SUBSET; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; MESON_TAC[COUNTABLE_SUBSET; OPEN_CONTAINS_CBALL; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]]);; let CONDENSATION_POINT_ALT = prove (`!x:real^N s. x condensation_point_of s <=> !t. COUNTABLE t ==> x limit_point_of (s DIFF t)`, REPEAT GEN_TAC THEN REWRITE_TAC[condensation_point_of] THEN REWRITE_TAC[LIMPT_INFINITE_OPEN; RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:real^N->bool` THEN ASM_CASES_TAC `(x:real^N) IN u /\ open u` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF (t INTER u)`] THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_DIFF_ABSORB o rand o snd) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[INFINITE; FINITE_IMP_COUNTABLE]; ALL_TAC] THEN TRANS_TAC CARD_LET_TRANS `(:num)` THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `t:real^N->bool` THEN SIMP_TAC[CARD_LE_SUBSET; INTER_SUBSET] THEN ASM_REWRITE_TAC[GSYM COUNTABLE_ALT]; ASM_REWRITE_TAC[GSYM COUNTABLE_ALT; GSYM CARD_NOT_LE]]; DISCH_THEN(SUBST1_TAC o MATCH_MP CARD_INFINITE_CONG) THEN ASM_MESON_TAC[INFINITE; FINITE_IMP_COUNTABLE]]; FIRST_X_ASSUM(MP_TAC o SPEC `s INTER u:real^N->bool`) THEN REWRITE_TAC[SET_RULE `(s DIFF s INTER u) INTER u = {}`] THEN ASM_REWRITE_TAC[INFINITE; FINITE_EMPTY]]);; (* ------------------------------------------------------------------------- *) (* Basic arithmetical combining theorems for limits. *) (* ------------------------------------------------------------------------- *) let LIM_LINEAR = prove (`!net:(A)net h f l. (f --> l) net /\ linear h ==> ((\x. h(f x)) --> h l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN ASM_SIMP_TAC[REAL_LT_DIV; dist; GSYM LINEAR_SUB; REAL_LT_RDIV_EQ] THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_MUL_SYM]);; let LIM_CONST = prove (`!net a:real^N. ((\x. a) --> a) net`, SIMP_TAC[LIM; DIST_REFL; trivial_limit] THEN MESON_TAC[]);; let LIM_CMUL = prove (`!f l c. (f --> l) net ==> ((\x. c % f x) --> c % l) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_LINEAR THEN ASM_REWRITE_TAC[REWRITE_RULE[ETA_AX] (MATCH_MP LINEAR_COMPOSE_CMUL LINEAR_ID)]);; let LIM_CMUL_EQ = prove (`!net f l c. ~(c = &0) ==> (((\x. c % f x) --> c % l) net <=> (f --> l) net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_CMUL] THEN DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP LIM_CMUL) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; let LIM_NEG = prove (`!net f l:real^N. (f --> l) net ==> ((\x. --(f x)) --> --l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM; dist] THEN REWRITE_TAC[VECTOR_ARITH `--x - --y = --(x - y:real^N)`; NORM_NEG]);; let LIM_NEG_EQ = prove (`!net f l:real^N. ((\x. --(f x)) --> --l) net <=> (f --> l) net`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; let LIM_ADD = prove (`!net:(A)net f g l m. (f --> l) net /\ (g --> m) net ==> ((\x. f(x) + g(x)) --> l + m) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_HALF; DIST_TRIANGLE_ADD; REAL_LT_ADD2; REAL_LET_TRANS]);; let LIM_ABS = prove (`!net:(A)net f:A->real^N l. (f --> l) net ==> ((\x. lambda i. (abs(f(x)$i))) --> (lambda i. abs(l$i)):real^N) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(x - y) <= norm(a - b) ==> dist(a,b) < e ==> dist(x,y) < e`) THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC);; let LIM_LIFT_ABS_COMPONENT = prove (`!net:(A)net f:A->real^N l k. (f --> l) net ==> ((\x. lift(abs(f(x)$k))) --> lift(abs(l$k))) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[DIST_LIFT] THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH `abs(x - y) <= a ==> a < e ==> abs(abs x - abs y) < e`) THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM]);; let LIM_SUB = prove (`!net:(A)net f g l m. (f --> l) net /\ (g --> m) net ==> ((\x. f(x) - g(x)) --> l - m) net`, REWRITE_TAC[real_sub; VECTOR_SUB] THEN ASM_SIMP_TAC[LIM_ADD; LIM_NEG]);; let LIM_MAX = prove (`!net:(A)net f g l:real^N m:real^N. (f --> l) net /\ (g --> m) net ==> ((\x. lambda i. max (f(x)$i) (g(x)$i)) --> (lambda i. max (l$i) (m$i)):real^N) net`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LIM_ADD) THEN FIRST_ASSUM(MP_TAC o MATCH_MP LIM_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ABS) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP LIM_CMUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);; let LIM_MIN = prove (`!net:(A)net f g l:real^N m:real^N. (f --> l) net /\ (g --> m) net ==> ((\x. lambda i. min (f(x)$i) (g(x)$i)) --> (lambda i. min (l$i) (m$i)):real^N) net`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LIM_NEG)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG o MATCH_MP LIM_MAX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC);; let LIM_NORM = prove (`!net f:A->real^N l. (f --> l) net ==> ((\x. lift(norm(f x))) --> lift(norm l)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; DIST_LIFT] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN NORM_ARITH_TAC);; let LIM_NULL = prove (`!net f l. (f --> l) net <=> ((\x. f(x) - l) --> vec 0) net`, REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO]);; let LIM_NULL_NORM = prove (`!net f. (f --> vec 0) net <=> ((\x. lift(norm(f x))) --> vec 0) net`, REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO; REAL_ABS_NORM; NORM_LIFT]);; let LIM_NULL_CMUL_EQ = prove (`!net f:A->real^N c. ((\x. c % f x) --> vec 0) net <=> c = &0 \/ (f --> vec 0) net`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; LIM_CONST] THEN ASM_MESON_TAC[LIM_CMUL_EQ; VECTOR_MUL_RZERO]);; let LIM_NULL_CMUL = prove (`!net f c. (f --> vec 0) net ==> ((\x. c % f x) --> vec 0) net`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[LIM_NULL_CMUL_EQ; VECTOR_MUL_LZERO; LIM_CONST]);; let LIM_NULL_VMUL_EQ = prove (`!net:A net c v:real^N. ((\x. c x % v) --> vec 0) net <=> v = vec 0 \/ ((\x. lift(c x)) --> vec 0) net`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL; LIM_NULL_CMUL_EQ; NORM_EQ_0] THEN REWRITE_TAC[NORM_LIFT]);; let LIM_NULL_VMUL = prove (`!net:A net c v:real^N. ((\x. lift(c x)) --> vec 0) net ==> ((\x. c x % v) --> vec 0) net`, SIMP_TAC[LIM_NULL_VMUL_EQ]);; let LIM_NULL_NEG = prove (`!net f:A->real^N. ((\x. --(f x)) --> vec 0) net <=> (f --> vec 0) net`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`] THEN REWRITE_TAC[LIM_NULL_CMUL_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let LIM_NULL_ADD = prove (`!net f g:A->real^N. (f --> vec 0) net /\ (g --> vec 0) net ==> ((\x. f x + g x) --> vec 0) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN REWRITE_TAC[VECTOR_ADD_LID]);; let LIM_NULL_SUB = prove (`!net f g:A->real^N. (f --> vec 0) net /\ (g --> vec 0) net ==> ((\x. f x - g x) --> vec 0) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REWRITE_TAC[VECTOR_SUB_RZERO]);; let LIM_NULL_COMPARISON = prove (`!net f g. eventually (\x. norm(f x) <= g x) net /\ ((\x. lift(g x)) --> vec 0) net ==> (f --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN REAL_ARITH_TAC);; let LIM_COMPONENT = prove (`!net f i l:real^N. (f --> l) net ==> ((\a. lift(f(a)$i)) --> lift(l$i)) net`, REWRITE_TAC[LIM; dist; GSYM LIFT_SUB; NORM_LIFT] THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);; let LIM_TRANSFORM_BOUND = prove (`!f g. eventually (\n. norm(f n) <= norm(g n)) net /\ (g --> vec 0) net ==> (f --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN REAL_ARITH_TAC);; let LIM_NULL_CMUL_BOUNDED = prove (`!f g:A->real^N B. eventually (\a. g a = vec 0 \/ abs(f a) <= B) net /\ (g --> vec 0) net ==> ((\n. f n % g n) --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN UNDISCH_TAC `eventually (\a. g a:real^N = vec 0 \/ abs(f a) <= B) (net:(A net))` THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `(g:A->real^N) x = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * e / (abs B + &1)` THEN ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `c * (a / b) = (c * a) / b`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN MATCH_MP_TAC(REAL_ARITH `e * B <= e * abs B /\ &0 < e ==> B * e < e * (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; let LIM_NULL_VMUL_BOUNDED = prove (`!f g:A->real^N B. ((lift o f) --> vec 0) net /\ eventually (\a. f a = &0 \/ norm(g a) <= B) net ==> ((\n. f n % g n) --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN UNDISCH_TAC `eventually(\a. f a = &0 \/ norm((g:A->real^N) a) <= B) net` THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `(f:A->real) x = &0` THEN ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / (abs B + &1) * B` THEN ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `(a / b) * c = (a * c) / b`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN MATCH_MP_TAC(REAL_ARITH `e * B <= e * abs B /\ &0 < e ==> e * B < e * (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; let LIM_VSUM = prove (`!net f:A->B->real^N l s. FINITE s /\ (!i. i IN s ==> ((f i) --> (l i)) net) ==> ((\x. vsum s (\i. f i x)) --> vsum s l) net`, REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; LIM_CONST; LIM_ADD; IN_INSERT; ETA_AX]);; let LIM_NULL_VSUM = prove (`!net f:A->B->real^N s. FINITE s /\ (!a. a IN s ==> ((\x. f x a) --> vec 0) net) ==> ((\x. vsum s (f x)) --> vec 0) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_VSUM) THEN REWRITE_TAC[VSUM_0; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Deducing things about the limit from the elements. *) (* ------------------------------------------------------------------------- *) let LIM_IN_CLOSED_SET = prove (`!net f:A->real^N s l. closed s /\ eventually (\x. f(x) IN s) net /\ ~(trivial_limit net) /\ (f --> l) net ==> l IN s`, REWRITE_TAC[closed] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `~(x IN (UNIV DIFF s)) ==> x IN s`) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `l:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_UNION] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [tendsto]) THEN UNDISCH_TAC `eventually (\x. (f:A->real^N) x IN s) net` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; TAUT `a ==> ~b <=> ~(a /\ b)`] THEN MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_MESON_TAC[DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Need to prove closed(cball(x,e)) before deducing this as a corollary. *) (* ------------------------------------------------------------------------- *) let LIM_NORM_UBOUND = prove (`!net:(A)net f (l:real^N) b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. norm(f x) <= b) net ==> norm(l) <= b`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[eventually] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `?x:A. dist(f(x):real^N,l) < norm(l:real^N) - b /\ norm(f x) <= b` (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN NORM_ARITH_TAC);; let LIM_NORM_LBOUND = prove (`!net:(A)net f (l:real^N) b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= norm(f x)) net ==> b <= norm(l)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[eventually] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `?x:A. dist(f(x):real^N,l) < b - norm(l:real^N) /\ b <= norm(f x)` (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Uniqueness of the limit, when nontrivial. *) (* ------------------------------------------------------------------------- *) let LIM_UNIQUE = prove (`!net:(A)net f l:real^N l'. ~(trivial_limit net) /\ (f --> l) net /\ (f --> l') net ==> (l = l')`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(ASSUME_TAC o REWRITE_RULE[VECTOR_SUB_REFL] o MATCH_MP LIM_SUB) THEN SUBGOAL_THEN `!e. &0 < e ==> norm(l:real^N - l') <= e` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_NORM_UBOUND THEN MAP_EVERY EXISTS_TAC [`net:(A)net`; `\x:A. vec 0 : real^N`] THEN ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE; eventually] THEN ASM_MESON_TAC[trivial_limit]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DIST_NZ; dist] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `norm(l - l':real^N) / &2`) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < norm(l - l':real^N)` THEN REAL_ARITH_TAC]);; let TENDSTO_LIM = prove (`!net f l. ~(trivial_limit net) /\ (f --> l) net ==> lim net f = l`, REWRITE_TAC[lim] THEN MESON_TAC[LIM_UNIQUE]);; let LIM_CONST_EQ = prove (`!net:(A net) c d:real^N. ((\x. c) --> d) net <=> trivial_limit net \/ c = d`, REPEAT GEN_TAC THEN ASM_CASES_TAC `trivial_limit (net:A net)` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[LIM]; ALL_TAC] THEN EQ_TAC THEN SIMP_TAC[LIM_CONST] THEN DISCH_TAC THEN MATCH_MP_TAC(SPEC `net:A net` LIM_UNIQUE) THEN EXISTS_TAC `(\x. c):A->real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);; (* ------------------------------------------------------------------------- *) (* These are special for limits out of the same vector space. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_ID = prove (`!a s. ((\x. x) --> a) (at a within s)`, REWRITE_TAC[LIM_WITHIN] THEN MESON_TAC[]);; let LIM_AT_ID = prove (`!a. ((\x. x) --> a) (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_ID]);; let LIM_AT_ZERO = prove (`!f:real^M->real^N l a. (f --> l) (at a) <=> ((\x. f(a + x)) --> l) (at(vec 0))`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EVENTUALLY_AT_ZERO] THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some unwieldy but occasionally useful theorems about uniform limits. *) (* ------------------------------------------------------------------------- *) let UNIFORM_LIM_ADD = prove (`!net:(A)net P f g l m. (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm((f n x + g n x) - (l n + m n)) < e) net`, REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; let UNIFORM_LIM_SUB = prove (`!net:(A)net P f g l m. (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm((f n x - g n x) - (l n - m n)) < e) net`, REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; (* ------------------------------------------------------------------------- *) (* Limit under bilinear function, uniform version first. *) (* ------------------------------------------------------------------------- *) let UNIFORM_LIM_BILINEAR = prove (`!net:(A)net P (h:real^M->real^N->real^P) f g l m b1 b2. bilinear h /\ eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ eventually (\x. !n. P n ==> norm(m n) <= b2) net /\ (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm(h (f n x) (g n x) - h (l n) (m n)) < e) net`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN REWRITE_TAC[AND_FORALL_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (abs b2 + &1) (e / &2 / (B * (abs b1 + abs b2 + &2)))`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_LT_MIN; REAL_ARITH `&0 < abs x + &1`; REAL_ARITH `&0 < abs x + abs y + &2`] THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `h a b - h c d :real^N = (h a b - h a d) + (h a d - h c d)`] THEN ASM_SIMP_TAC[GSYM BILINEAR_LSUB; GSYM BILINEAR_RSUB] THEN MATCH_MP_TAC NORM_TRIANGLE_LT THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[REAL_LE_ADD2; REAL_LET_TRANS] `(!x y. norm(h x y:real^P) <= B * norm x * norm y) ==> B * norm a * norm b + B * norm c * norm d < e ==> norm(h a b) + norm(h c d) < e`)) THEN MATCH_MP_TAC(REAL_ARITH `x * B < e / &2 /\ y * B < e / &2 ==> B * x + B * y < e`) THEN CONJ_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2 / (B * (abs b1 + abs b2 + &2)) * (abs b1 + abs b2 + &1)` THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_ARITH `a <= b2 ==> a <= abs b1 + abs b2 + &1`] THEN ASM_MESON_TAC[NORM_ARITH `norm(f - l:real^P) < abs b2 + &1 /\ norm(l) <= b1 ==> norm(f) <= abs b1 + abs b2 + &1`]; ONCE_REWRITE_TAC[real_div] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_HALF; GSYM REAL_MUL_ASSOC; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `B * inv x * y < B <=> B * y / x < B * &1`] THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + abs y + &2`] THEN REAL_ARITH_TAC]));; let LIM_BILINEAR = prove (`!net:(A)net (h:real^M->real^N->real^P) f g l m. (f --> l) net /\ (g --> m) net /\ bilinear h ==> ((\x. h (f x) (g x)) --> (h l m)) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `\x:one. T`; `h:real^M->real^N->real^P`; `\n:one. (f:A->real^M)`; `\n:one. (g:A->real^N)`; `\n:one. (l:real^M)`; `\n:one. (m:real^N)`; `norm(l:real^M)`; `norm(m:real^N)`] UNIFORM_LIM_BILINEAR) THEN ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN ASM_REWRITE_TAC[GSYM dist; GSYM tendsto]);; let BILINEAR_EPSILON_DELTA = prove (`!bop:real^M->real^N->real^P a b e. bilinear bop /\ &0 < e ==> ?d. &0 < d /\ !x y. norm(x - a) < d /\ norm(y - b) < d ==> norm(bop x y - bop a b) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`at (pastecart (a:real^M) (b:real^N))`; `bop:real^M->real^N->real^P`; `fstcart:real^(M,N)finite_sum->real^M`; `sndcart:real^(M,N)finite_sum->real^N`; `fstcart(pastecart (a:real^M) (b:real^N))`; `sndcart(pastecart (a:real^M) (b:real^N))`] LIM_BILINEAR) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN MATCH_MP_TAC LIM_LINEAR THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LIM_AT_ID]; REWRITE_TAC[LIM_SELF_AT] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF; GSYM dist] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN W(MP_TAC o PART_MATCH lhand DIST_PASTECART_LE o lhand o snd) THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* It's also sometimes useful to extract the limit point from the net. *) (* ------------------------------------------------------------------------- *) let netlimit = new_definition `netlimit net = @a. !x. ~(netord net x a)`;; let NETLIMIT_WITHIN = prove (`!a:real^N s. ~(trivial_limit (at a within s)) ==> (netlimit (at a within s) = a)`, REWRITE_TAC[trivial_limit; netlimit; AT; WITHIN; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!x:real^N. ~(&0 < dist(x,a) /\ dist(x,a) <= dist(a,a) /\ x IN s)` ASSUME_TAC THENL [ASM_MESON_TAC[DIST_REFL; REAL_NOT_LT]; ASM_MESON_TAC[]]);; let NETLIMIT_AT = prove (`!a. netlimit(at a) = a`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN SIMP_TAC[TRIVIAL_LIMIT_AT; WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Transformation of limit. *) (* ------------------------------------------------------------------------- *) let LIM_TRANSFORM = prove (`!net f g l. ((\x. f x - g x) --> vec 0) net /\ (f --> l) net ==> (g --> l) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; let LIM_TRANSFORM_EVENTUALLY = prove (`!net f g l. eventually (\x. f x = g x) net /\ (f --> l) net ==> (g --> l) net`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP LIM_EVENTUALLY) MP_TAC) THEN MESON_TAC[LIM_TRANSFORM]);; let LIM_TRANSFORM_WITHIN = prove (`!f g x s d. &0 < d /\ (!x'. x' IN s /\ &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ (f --> l) (at x within s) ==> (g --> l) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[LIM_WITHIN] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `d:real` THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; DIST_REFL]);; let LIM_TRANSFORM_AT = prove (`!f g x d. &0 < d /\ (!x'. &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ (f --> l) (at x) ==> (g --> l) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_WITHIN]);; let LIM_TRANSFORM_EQ = prove (`!net f:A->real^N g l. ((\x. f x - g x) --> vec 0) net ==> ((f --> l) net <=> (g --> l) net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THENL [EXISTS_TAC `f:A->real^N` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `g:A->real^N` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]]);; let LIM_TRANSFORM_WITHIN_SET = prove (`!f l a s t. eventually (\x. x IN s <=> x IN t) (at a) ==> ((f --> l) (at a within s) <=> (f --> l) (at a within t))`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; LIM_WITHIN] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let LIM_TRANSFORM_WITHIN_SET_IMP = prove (`!f l a s t. eventually (\x. x IN t ==> x IN s) (at a) /\ (f --> l) (at a within s) ==> (f --> l) (at a within t)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; EVENTUALLY_AT; LIM_WITHIN] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Common case assuming being away from some crucial point like 0. *) (* ------------------------------------------------------------------------- *) let LIM_TRANSFORM_AWAY_WITHIN = prove (`!f:real^M->real^N g a b s. ~(a = b) /\ (!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ (f --> l) (at a within s) ==> (g --> l) (at a within s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `dist(a:real^M,b)`] THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `y:real^M` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]);; let LIM_TRANSFORM_AWAY_AT = prove (`!f:real^M->real^N g a b. ~(a = b) /\ (!x. ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ (f --> l) (at a) ==> (g --> l) (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_AWAY_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Alternatively, within an open set. *) (* ------------------------------------------------------------------------- *) let LIM_TRANSFORM_WITHIN_OPEN = prove (`!f g:real^M->real^N s a l. open s /\ a IN s /\ (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ (f --> l) (at a) ==> (g --> l) (at a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; let LIM_TRANSFORM_WITHIN_OPEN_IN = prove (`!f g:real^M->real^N s t a l. open_in (subtopology euclidean t) s /\ a IN s /\ (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ (f --> l) (at a within t) ==> (g --> l) (at a within t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Limit of linear functions is itself linear. *) (* ------------------------------------------------------------------------- *) let LINEAR_LIMIT = prove (`!net:A net f g:real^M->real^N. ~trivial_limit net /\ eventually (\i. linear(f i)) net /\ (!x. ((\i. f i x) --> g x) net) ==> linear g`, REPEAT STRIP_TAC THEN REWRITE_TAC[linear] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN MATCH_MP_TAC(ISPEC `net:A net` LIM_UNIQUE) THEN EXISTS_TAC `\i. (f:A->real^M->real^N) i (x + y)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\i. (f:A->real^M->real^N) i x + f i y` THEN ASM_SIMP_TAC[LIM_ADD]; MAP_EVERY X_GEN_TAC [`c:real`; `x:real^M`] THEN MATCH_MP_TAC(ISPEC `net:A net` LIM_UNIQUE) THEN EXISTS_TAC `\i. (f:A->real^M->real^N) i (c % x)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\i. c % (f:A->real^M->real^N) i x` THEN ASM_SIMP_TAC[LIM_CMUL]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN SIMP_TAC[linear]);; let LINEAR_SEQUENTIAL_LIMIT = prove (`!f g:real^M->real^N. eventually (\n. linear(f n)) sequentially /\ (!x. ((\n. f n x) --> g x) sequentially) ==> linear g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LINEAR_LIMIT) THEN ASM_MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]);; (* ------------------------------------------------------------------------- *) (* Another quite common idiom of an explicit conditional in a sequence. *) (* ------------------------------------------------------------------------- *) let LIM_CASES_FINITE_SEQUENTIALLY = prove (`!f g l. FINITE {n | P n} ==> (((\n. if P n then f n else g n) --> l) sequentially <=> (g --> l) sequentially)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N + 1` THEN ASM_MESON_TAC[ARITH_RULE `~(x <= n /\ n + 1 <= x)`]);; let LIM_CASES_COFINITE_SEQUENTIALLY = prove (`!f g l. FINITE {n | ~P n} ==> (((\n. if P n then f n else g n) --> l) sequentially <=> (f --> l) sequentially)`, ONCE_REWRITE_TAC[GSYM COND_SWAP] THEN REWRITE_TAC[LIM_CASES_FINITE_SEQUENTIALLY]);; let LIM_CASES_SEQUENTIALLY = prove (`!f g l m. (((\n. if m <= n then f n else g n) --> l) sequentially <=> (f --> l) sequentially) /\ (((\n. if m < n then f n else g n) --> l) sequentially <=> (f --> l) sequentially) /\ (((\n. if n <= m then f n else g n) --> l) sequentially <=> (g --> l) sequentially) /\ (((\n. if n < m then f n else g n) --> l) sequentially <=> (g --> l) sequentially)`, SIMP_TAC[LIM_CASES_FINITE_SEQUENTIALLY; LIM_CASES_COFINITE_SEQUENTIALLY; NOT_LE; NOT_LT; FINITE_NUMSEG_LT; FINITE_NUMSEG_LE]);; (* ------------------------------------------------------------------------- *) (* A congruence rule allowing us to transform limits assuming not at point. *) (* ------------------------------------------------------------------------- *) let LIM_CONG_WITHIN = prove (`(!x. x IN s /\ ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (at a within s) <=> ((g --> l) (at a within s)))`, REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);; let LIM_CONG_AT = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (at a) <=> ((g --> l) (at a)))`, REWRITE_TAC[LIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);; extend_basic_congs [LIM_CONG_WITHIN; LIM_CONG_AT];; (* ------------------------------------------------------------------------- *) (* Useful lemmas on closure and set of possible sequential limits. *) (* ------------------------------------------------------------------------- *) let CLOSURE_SEQUENTIAL = prove (`!s l:real^N. l IN closure(s) <=> ?x. (!n. x(n) IN s) /\ (x --> l) sequentially`, REWRITE_TAC[closure; IN_UNION; LIMPT_SEQUENTIAL; IN_ELIM_THM; IN_DELETE] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `((b ==> c) /\ (~a /\ c ==> b)) /\ (a ==> c) ==> (a \/ b <=> c)`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `\n:num. l:real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);; let CLOSED_CONTAINS_SEQUENTIAL_LIMIT = prove (`!s x l:real^N. closed s /\ (!n. x n IN s) /\ (x --> l) sequentially ==> l IN s`, MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED]);; let CLOSED_SEQUENTIAL_LIMITS = prove (`!s. closed s <=> !x l. (!n. x(n) IN s) /\ (x --> l) sequentially ==> l IN s`, MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED; CLOSED_LIMPT; LIMPT_SEQUENTIAL; IN_DELETE]);; let CLOSED_IN_SEQUENTIAL_LIMITS = prove (`!u s:real^N->bool. closed_in (subtopology euclidean u) s <=> s SUBSET u /\ !x l. (!n. x n IN s) /\ l IN u /\ (x --> l) sequentially ==> l IN s`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN REWRITE_TAC[SUBSET; IN_INTER; CLOSURE_SEQUENTIAL] THEN SET_TAC[]);; let CLOSED_APPROACHABLE = prove (`!x s. closed s ==> ((!e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e) <=> x IN s)`, MESON_TAC[CLOSURE_CLOSED; CLOSURE_APPROACHABLE]);; let IN_CLOSURE_DELETE = prove (`!s x:real^N. x IN closure(s DELETE x) <=> x limit_point_of s`, SIMP_TAC[CLOSURE_APPROACHABLE; LIMPT_APPROACHABLE; IN_DELETE; CONJ_ASSOC]);; let DENSE_LIMIT_POINTS = prove (`!x. {x | x limit_point_of s} = (:real^N) <=> closure s = (:real^N)`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[closure] THEN SET_TAC[]; DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DENSE_IMP_PERFECT) THEN RULE_ASSUM_TAC(REWRITE_RULE[closure]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some other lemmas about sequences. *) (* ------------------------------------------------------------------------- *) let SEQ_OFFSET = prove (`!f l k. (f --> l) sequentially ==> ((\i. f(i + k)) --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN MESON_TAC[ARITH_RULE `N <= n ==> N <= n + k:num`]);; let SEQ_OFFSET_NEG = prove (`!f l k. (f --> l) sequentially ==> ((\i. f(i - k)) --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k:num`]);; let SEQ_OFFSET_REV = prove (`!f l k. ((\i. f(i + k)) --> l) sequentially ==> (f --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k /\ (n - k) + k = n:num`]);; let SEQ_OFFSET_EQ = prove (`!k f l:real^N. ((\i. f (i + k)) --> l) sequentially <=> (f --> l) sequentially`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SEQ_OFFSET_REV; SEQ_OFFSET]);; let CONVERGENT_OFFSET = prove (`!f:num->real^N k. (?l. (f --> l) sequentially) ==> (?l. ((\i. f(i + k)) --> l) sequentially)`, REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SEQ_OFFSET]);; let CONVERGENT_OFFSET_EQ = prove (`!f:num->real^N k. (?l. ((\i. f(i + k)) --> l) sequentially) <=> (?l. (f --> l) sequentially)`, REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[SEQ_OFFSET_EQ]);; let CONVERGENT_OFFSET_REV = prove (`!f:num->real^N k. (?l. ((\i. f(i + k)) --> l) sequentially) ==> (?l. (f --> l) sequentially)`, REWRITE_TAC[CONVERGENT_OFFSET_EQ]);; let SEQ_HARMONIC_OFFSET = prove (`!a. ((\n. lift(inv(&n + a))) --> vec 0) sequentially`, GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC (SPEC `--a:real` REAL_ARCH_SIMPLE) THEN EXISTS_TAC `M + N:num` THEN REWRITE_TAC[DIST_0; NORM_LIFT] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD]) THEN ASM_REAL_ARITH_TAC);; let SEQ_HARMONIC = prove (`((\n. lift(inv(&n))) --> vec 0) sequentially`, MP_TAC(SPEC `&0` SEQ_HARMONIC_OFFSET) THEN REWRITE_TAC[REAL_ADD_RID]);; let SEQ_HARMONIC_RATIO = prove (`!a b. ((\n. lift((&n + a) / (&n + b))) --> vec 1) sequentially`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. vec 1 + (a - b) % lift(inv(&n + b))` THEN SIMP_TAC[LIM_ADD; LIM_CONST; SEQ_HARMONIC_OFFSET; LIM_NULL_CMUL] THEN MP_TAC(ISPEC `abs b + &1` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD);; (* ------------------------------------------------------------------------- *) (* More properties of closed balls. *) (* ------------------------------------------------------------------------- *) let CLOSED_CBALL = prove (`!x:real^N e. closed(cball(x,e))`, REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_CBALL; dist] THEN GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:num->real^N` THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. x - (s:num->real^N) n` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN ASM_SIMP_TAC[LIM_SUB; LIM_CONST; SEQUENTIALLY] THEN MESON_TAC[GE_REFL]);; let CLOSURE_CBALL = prove (`!a:real^N r. closure(cball(a,r)) = cball(a,r)`, REWRITE_TAC[CLOSURE_EQ; CLOSED_CBALL]);; let IN_INTERIOR_CBALL = prove (`!x s. x IN interior s <=> ?e. &0 < e /\ cball(x,e) SUBSET s`, REWRITE_TAC[interior; IN_ELIM_THM] THEN MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET_TRANS; BALL_SUBSET_CBALL; CENTRE_IN_BALL; OPEN_BALL]);; let LIMPT_BALL = prove (`!x:real^N y e. y limit_point_of ball(x,e) <=> &0 < e /\ y IN cball(x,e)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < e` THENL [ALL_TAC; ASM_MESON_TAC[LIMPT_EMPTY; REAL_NOT_LT; BALL_EQ_EMPTY]] THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [MESON_TAC[CLOSED_CBALL; CLOSED_LIMPT; LIMPT_SUBSET; BALL_SUBSET_CBALL]; REWRITE_TAC[IN_CBALL; LIMPT_APPROACHABLE; IN_BALL]] THEN DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[DIST_NZ] THENL [MP_TAC(SPECL [`d:real`; `e:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN GEN_MESON_TAC 0 40 1 [VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; ALL_TAC] THEN MP_TAC(SPECL [`norm(y:real^N - x)`; `d:real`] REAL_DOWN2) THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ; dist]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(y:real^N) - (k / dist(y,x)) % (y - x)` THEN REWRITE_TAC[dist; VECTOR_ARITH `(y - c % z) - y = --c % z`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NEG] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `x - (y - k % (y - x)) = (&1 - k) % (x - y)`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> &0 < abs k`; NORM_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < k /\ k < d ==> abs k < d`] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(x:real^N - y)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[NORM_SUB]] THEN MATCH_MP_TAC(REAL_ARITH `&0 < k /\ k < &1 ==> abs(&1 - k) < &1`) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_MUL_LZERO; REAL_MUL_LID]);; let CLOSURE_BALL = prove (`!x:real^N e. &0 < e ==> (closure(ball(x,e)) = cball(x,e))`, SIMP_TAC[EXTENSION; closure; IN_ELIM_THM; IN_UNION; LIMPT_BALL] THEN REWRITE_TAC[IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let INTERIOR_BALL = prove (`!a r. interior(ball(a,r)) = ball(a,r)`, SIMP_TAC[INTERIOR_OPEN; OPEN_BALL]);; let INTERIOR_CBALL = prove (`!x:real^N e. interior(cball(x,e)) = ball(x,e)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL [ALL_TAC; SUBGOAL_THEN `cball(x:real^N,e) = {} /\ ball(x:real^N,e) = {}` (fun th -> REWRITE_TAC[th; INTERIOR_EMPTY]) THEN REWRITE_TAC[IN_BALL; IN_CBALL; EXTENSION; NOT_IN_EMPTY] THEN CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN MP_TAC(ISPECL [`x:real^N`; `y:real^N`] DIST_POS_LE) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN REWRITE_TAC[BALL_SUBSET_CBALL; OPEN_BALL] THEN X_GEN_TAC `t:real^N->bool` THEN SIMP_TAC[SUBSET; IN_CBALL; IN_BALL; REAL_LT_LE] THEN STRIP_TAC THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o GEN_REWRITE_RULE I [open_def]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `z:real^N = x` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `k:real` o MATCH_MP REAL_DOWN) THEN SUBGOAL_THEN `?w:real^N. dist(w,x) = k` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_SYM]]; RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ]) THEN DISCH_THEN(MP_TAC o SPEC `z + ((d / &2) / dist(z,x)) % (z - x:real^N)`) THEN REWRITE_TAC[dist; VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; GSYM dist; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN ASM_REWRITE_TAC[REAL_ARITH `abs d < d * &2 <=> &0 < d`] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[dist] THEN REWRITE_TAC[VECTOR_ARITH `x - (z + k % (z - x)) = (&1 + k) % (x - z)`] THEN REWRITE_TAC[REAL_NOT_LE; NORM_MUL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; GSYM dist] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]);; let FRONTIER_BALL = prove (`!a e. &0 < e ==> frontier(ball(a,e)) = sphere(a,e)`, SIMP_TAC[frontier; sphere; CLOSURE_BALL; INTERIOR_OPEN; OPEN_BALL; REAL_LT_IMP_LE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let FRONTIER_CBALL = prove (`!a e. frontier(cball(a,e)) = sphere(a,e)`, SIMP_TAC[frontier; sphere; INTERIOR_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; REAL_LT_IMP_LE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let INTERIOR_SPHERE = prove (`!a:real^N r. interior(sphere(a,r)) = {}`, SIMP_TAC[GSYM FRONTIER_CBALL; INTERIOR_FRONTIER_EMPTY; CLOSED_CBALL]);; let CBALL_EQ_EMPTY = prove (`!x e. (cball(x,e) = {}) <=> e < &0`, REWRITE_TAC[EXTENSION; IN_CBALL; NOT_IN_EMPTY; REAL_NOT_LE] THEN MESON_TAC[DIST_POS_LE; DIST_REFL; REAL_LTE_TRANS]);; let CBALL_EMPTY = prove (`!x e. e < &0 ==> cball(x,e) = {}`, REWRITE_TAC[CBALL_EQ_EMPTY]);; let CBALL_EQ_SING = prove (`!x:real^N e. (cball(x,e) = {x}) <=> e = &0`, REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DIST_LE_0]] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `x + (e / &2) % basis 1:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN REWRITE_TAC[dist; VECTOR_ARITH `x - (x + e):real^N = --e`; VECTOR_ARITH `x + e = x <=> e:real^N = vec 0`] THEN REWRITE_TAC[NORM_NEG; NORM_MUL; VECTOR_MUL_EQ_0; NORM_0; VECTOR_SUB_REFL] THEN SIMP_TAC[NORM_BASIS; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);; let CBALL_SING = prove (`!x e. e = &0 ==> cball(x,e) = {x}`, REWRITE_TAC[CBALL_EQ_SING]);; let SPHERE_SING = prove (`!x e. e = &0 ==> sphere(x,e) = {x}`, SIMP_TAC[sphere; DIST_EQ_0; SING_GSPEC]);; let SPHERE_EQ_SING = prove (`!a:real^N r x. sphere(a,r) = {x} <=> x = a /\ r = &0`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPHERE_SING] THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_INSERT_EMPTY] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING] THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!y. (x IN s ==> y IN s /\ ~(y = x)) ==> ~(s = {x})`) THEN EXISTS_TAC `a - (x - a):real^N` THEN REWRITE_TAC[IN_SPHERE] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH);; let HAS_SIZE_SPHERE_1 = prove (`!a:real^N r. sphere(a,r) HAS_SIZE 1 <=> r = &0`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[SPHERE_EQ_SING] THEN MESON_TAC[]);; let IMAGE_AFFINITY_CBALL = prove (`!m c a:real^N r. IMAGE (\x. m % x + c) (cball(a,r)) = if &0 <= r \/ ~(m = &0) then cball(m % a + c,abs m * r) else {}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; CBALL_EQ_EMPTY; GSYM REAL_NOT_LE] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ t = {a} ==> IMAGE (\x. a) s = t`) THEN ASM_REWRITE_TAC[CBALL_TRIVIAL; CBALL_EQ_EMPTY; REAL_NOT_LT]; MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_CBALL; DIST_MUL; NORM_ARITH `dist(x + a:real^N,y + a) = dist(x,y)`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_ABS_NZ] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `inv(m) % (x - c):real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN VECTOR_ARITH_TAC]);; let IMAGE_AFFINITY_BALL = prove (`!m c a:real^N r. IMAGE (\x. m % x + c) (ball(a,r)) = if ~(m = &0) then ball(m % a + c,abs m * r) else if r <= &0 then {} else {c}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; BALL_EQ_EMPTY; GSYM REAL_NOT_LT] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) ==> IMAGE (\x. a) s = {a}`) THEN ASM_REWRITE_TAC[BALL_EQ_EMPTY]; MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_BALL; DIST_MUL; NORM_ARITH `dist(x + a:real^N,y + a) = dist(x,y)`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; GSYM REAL_ABS_NZ] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `inv(m) % (x - c):real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN VECTOR_ARITH_TAC]);; let IMAGE_AFFINITY_SPHERE = prove (`!m c a:real^N r. IMAGE (\x. m % x + c) (sphere(a,r)) = if &0 <= r \/ ~(m = &0) then sphere(m % a + c,abs m * r) else {}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; SPHERE_EQ_EMPTY; GSYM REAL_NOT_LE] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ t = {a} ==> IMAGE (\x. a) s = t`) THEN ASM_SIMP_TAC[SPHERE_SING; SPHERE_EQ_EMPTY; REAL_NOT_LT]; MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_SPHERE; DIST_MUL; NORM_ARITH `dist(x + a:real^N,y + a) = dist(x,y)`] THEN ASM_SIMP_TAC[REAL_EQ_MUL_LCANCEL; REAL_ABS_ZERO; GSYM REAL_ABS_NZ] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `inv(m) % (x - c):real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN VECTOR_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* For points in the interior, localization of limits makes no difference. *) (* ------------------------------------------------------------------------- *) let EVENTUALLY_WITHIN_INTERIOR_INTER = prove (`!p s t x. x IN interior s ==> (eventually p (at x within s INTER t) <=> eventually p (at x within t))`, REWRITE_TAC[EVENTUALLY_WITHIN; IN_INTER; IN_INTERIOR] THEN REPEAT GEN_TAC THEN SIMP_TAC[SUBSET; IN_BALL; LEFT_IMP_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[DIST_SYM]);; let LIM_WITHIN_INTERIOR_INTER = prove (`!f l s x. x IN interior s ==> ((f --> l) (at x within s INTER t) <=> (f --> l) (at x within t))`, SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR_INTER]);; let LIM_WITHIN_INTERIOR = prove (`!f l s x. x IN interior s ==> ((f --> l) (at x within s) <=> (f --> l) (at x))`, SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR]);; let NETLIMIT_WITHIN_INTERIOR = prove (`!s x:real^N. x IN interior s ==> netlimit(at x within s) = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[OPEN_CONTAINS_BALL] (SPEC_ALL OPEN_INTERIOR))) THEN ASM_MESON_TAC[LIMPT_SUBSET; LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_IMP_LE; SUBSET_TRANS; INTERIOR_SUBSET]);; (* ------------------------------------------------------------------------- *) (* A non-singleton connected set is perfect (i.e. has no isolated points). *) (* ------------------------------------------------------------------------- *) let CONNECTED_IMP_PERFECT = prove (`!s x:real^N. connected s /\ ~(?a. s = {a}) /\ x IN s ==> x limit_point_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N}` o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]; REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `cball(x:real^N,e)` THEN REWRITE_TAC[CLOSED_CBALL] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_SING] THEN ASM_MESON_TAC[CENTRE_IN_CBALL; SUBSET; REAL_LT_IMP_LE]; ASM SET_TAC[]]);; let CONNECTED_IMP_PERFECT_CLOSED = prove (`!s x. connected s /\ closed s /\ ~(?a. s = {a}) ==> (x limit_point_of s <=> x IN s)`, MESON_TAC[CONNECTED_IMP_PERFECT; CLOSED_LIMPT]);; let CONNECTED_LIMIT_POINTS_EQ_CLOSURE = prove (`!s:real^N->bool. connected s /\ ~(?a. s = {a}) ==> {x | x limit_point_of s} = closure s`, REPEAT STRIP_TAC THEN REWRITE_TAC[closure] THEN REWRITE_TAC[SET_RULE `l = s UNION l <=> s SUBSET l`] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CONNECTED_IMP_PERFECT]);; let CONNECTED_LIMIT_POINTS = prove (`!s:real^N->bool. connected s ==> connected {x | x limit_point_of s}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a:real^N. s = {a}` THENL [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING; EMPTY_GSPEC; CONNECTED_EMPTY]; ASM_MESON_TAC[CONNECTED_LIMIT_POINTS_EQ_CLOSURE; CONNECTED_CLOSURE]]);; (* ------------------------------------------------------------------------- *) (* Boundedness. *) (* ------------------------------------------------------------------------- *) let bounded = new_definition `bounded s <=> ?a. !x:real^N. x IN s ==> norm(x) <= a`;; let BOUNDED_EMPTY = prove (`bounded {}`, REWRITE_TAC[bounded; NOT_IN_EMPTY]);; let BOUNDED_SUBSET = prove (`!s t. bounded t /\ s SUBSET t ==> bounded s`, MESON_TAC[bounded; SUBSET]);; let BOUNDED_INTERIOR = prove (`!s:real^N->bool. bounded s ==> bounded(interior s)`, MESON_TAC[BOUNDED_SUBSET; INTERIOR_SUBSET]);; let BOUNDED_CLOSURE = prove (`!s:real^N->bool. bounded s ==> bounded(closure s)`, REWRITE_TAC[bounded; CLOSURE_SEQUENTIAL] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MESON_TAC[REWRITE_RULE[eventually] LIM_NORM_UBOUND; TRIVIAL_LIMIT_SEQUENTIALLY; trivial_limit]);; let BOUNDED_CLOSURE_EQ = prove (`!s:real^N->bool. bounded(closure s) <=> bounded s`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSURE] THEN MESON_TAC[BOUNDED_SUBSET; CLOSURE_SUBSET]);; let BOUNDED_CBALL = prove (`!x:real^N e. bounded(cball(x,e))`, REPEAT GEN_TAC THEN REWRITE_TAC[bounded] THEN EXISTS_TAC `norm(x:real^N) + e` THEN REWRITE_TAC[IN_CBALL; dist] THEN NORM_ARITH_TAC);; let BOUNDED_BALL = prove (`!x e. bounded(ball(x,e))`, MESON_TAC[BALL_SUBSET_CBALL; BOUNDED_CBALL; BOUNDED_SUBSET]);; let FINITE_IMP_BOUNDED = prove (`!s:real^N->bool. FINITE s ==> bounded s`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[BOUNDED_EMPTY] THEN REWRITE_TAC[bounded; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) STRIP_ASSUME_TAC) THEN EXISTS_TAC `norm(x:real^N) + abs B` THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH `(y <= b /\ &0 <= x ==> y <= x + abs b) /\ x <= x + abs b`]);; let BOUNDED_NORM_IMAGE = prove (`!s:real^N->bool. bounded s <=> bounded(IMAGE (lift o norm) s)`, REWRITE_TAC[bounded; FORALL_IN_IMAGE; o_THM] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM]);; let BOUNDED_UNION = prove (`!s t. bounded (s UNION t) <=> bounded s /\ bounded t`, REWRITE_TAC[bounded; IN_UNION] THEN MESON_TAC[REAL_LE_MAX]);; let BOUNDED_UNIONS = prove (`!f. FINITE f /\ (!s. s IN f ==> bounded s) ==> bounded(UNIONS f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; BOUNDED_EMPTY; IN_INSERT; UNIONS_INSERT] THEN MESON_TAC[BOUNDED_UNION]);; let BOUNDED_POS = prove (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) <= b`, REWRITE_TAC[bounded] THEN MESON_TAC[REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x <= &1 + abs(y))`]);; let BOUNDED_POS_LT = prove (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) < b`, REWRITE_TAC[bounded] THEN MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);; let BOUNDED_INTER = prove (`!s t. bounded s \/ bounded t ==> bounded (s INTER t)`, MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; let BOUNDED_DIFF = prove (`!s t. bounded s ==> bounded (s DIFF t)`, MESON_TAC[BOUNDED_SUBSET; SUBSET_DIFF]);; let BOUNDED_INSERT = prove (`!x s. bounded(x INSERT s) <=> bounded s`, ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN SIMP_TAC[BOUNDED_UNION; FINITE_IMP_BOUNDED; FINITE_RULES]);; let BOUNDED_SING = prove (`!a. bounded {a}`, REWRITE_TAC[BOUNDED_INSERT; BOUNDED_EMPTY]);; let BOUNDED_DELETE = prove (`!x:real^N s. bounded(s DELETE x) <=> bounded s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN TRANS_TAC EQ_TRANS `bounded((x:real^N) INSERT (s DELETE x))` THEN CONJ_TAC THENL [REWRITE_TAC[BOUNDED_INSERT]; AP_TERM_TAC THEN ASM SET_TAC[]]);; let BOUNDED_INTERS = prove (`!f:(real^N->bool)->bool. (?s:real^N->bool. s IN f /\ bounded s) ==> bounded(INTERS f)`, REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN ASM SET_TAC[]);; let NOT_BOUNDED_UNIV = prove (`~(bounded (:real^N))`, REWRITE_TAC[BOUNDED_POS; NOT_FORALL_THM; NOT_EXISTS_THM; IN_UNIV; DE_MORGAN_THM; REAL_NOT_LE] THEN X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `B + &1` VECTOR_CHOOSE_SIZE) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> &0 <= B + &1`] THEN MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC);; let NOT_OPEN_SING = prove (`!a:real^N. ~(open {a})`, GEN_TAC THEN MP_TAC(ISPEC `{a:real^N}` CLOPEN) THEN REWRITE_TAC[NOT_INSERT_EMPTY; CLOSED_SING] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^N->bool)->bool`) THEN REWRITE_TAC[BOUNDED_SING; NOT_BOUNDED_UNIV]);; let COBOUNDED_IMP_UNBOUNDED = prove (`!s. bounded((:real^N) DIFF s) ==> ~bounded s`, GEN_TAC THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN REWRITE_TAC[GSYM BOUNDED_UNION; SET_RULE `UNIV DIFF s UNION s = UNIV`] THEN REWRITE_TAC[NOT_BOUNDED_UNIV]);; let BOUNDED_LINEAR_IMAGE = prove (`!f:real^M->real^N s. bounded s /\ linear f ==> bounded(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:real`) MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `B2:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN EXISTS_TAC `B2 * B1` THEN ASM_SIMP_TAC[REAL_LT_MUL; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * norm(x:real^M)` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ]);; let BOUNDED_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (bounded (IMAGE f s) <=> bounded s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE BOUNDED_LINEAR_IMAGE));; add_linear_invariants [BOUNDED_LINEAR_IMAGE_EQ];; let BOUNDED_SCALING = prove (`!c s. bounded s ==> bounded (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID]);; let BOUNDED_NEGATIONS = prove (`!s. bounded s ==> bounded (IMAGE (--) s)`, GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `-- &1` o MATCH_MP BOUNDED_SCALING) THEN REWRITE_TAC[bounded; IN_IMAGE; VECTOR_MUL_LNEG; VECTOR_MUL_LID]);; let BOUNDED_TRANSLATION = prove (`!a:real^N s. bounded s ==> bounded (IMAGE (\x. a + x) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `B + norm(a:real^N)` THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN NORM_ARITH_TAC);; let BOUNDED_TRANSLATION_EQ = prove (`!a s. bounded (IMAGE (\x:real^N. a + x) s) <=> bounded s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_TRANSLATION] THEN DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP BOUNDED_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; add_translation_invariants [BOUNDED_TRANSLATION_EQ];; let BOUNDED_SCALING_EQ = prove (`!s:real^N->bool c. bounded (IMAGE (\x. c % x) s) <=> c = &0 \/ bounded s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[BOUNDED_SING; BOUNDED_EMPTY]; EQ_TAC THEN REWRITE_TAC[BOUNDED_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP BOUNDED_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let BOUNDED_AFFINITY_EQ = prove (`!s m c:real^N. bounded (IMAGE (\x. m % x + c) s) <=> m = &0 \/ bounded s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; BOUNDED_TRANSLATION_EQ; BOUNDED_SCALING_EQ; IMAGE_o]);; let BOUNDED_AFFINITY = prove (`!s m c:real^N. bounded s ==> bounded (IMAGE (\x. m % x + c) s)`, SIMP_TAC[BOUNDED_AFFINITY_EQ]);; let BOUNDED_DIFFS = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> bounded {x - y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm x <= a /\ norm y <= b ==> norm(x - y) <= a + b`) THEN ASM_SIMP_TAC[]);; let BOUNDED_SUMS = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> bounded {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm x <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN ASM_SIMP_TAC[]);; let BOUNDED_SUMS_IMAGE = prove (`!f g t. bounded {f x | x IN t} /\ bounded {g x | x IN t} ==> bounded {f x + g x | x IN t}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN SET_TAC[]);; let BOUNDED_SUMS_IMAGES = prove (`!f:A->B->real^N t s. FINITE s /\ (!a. a IN s ==> bounded {f x a | x IN t}) ==> bounded { vsum s (f x) | x IN t}`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES] THEN CONJ_TAC THENL [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{vec 0:real^N}` THEN SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_RULES] THEN SET_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUMS_IMAGE THEN ASM_SIMP_TAC[IN_INSERT]);; let BOUNDED_SUBSET_BALL = prove (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET ball(x,r)`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&2 * B + norm(x:real^N)` THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 < B /\ &0 <= x ==> &0 < &2 * B + x`] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[IN_BALL] THEN UNDISCH_TAC `&0 < B` THEN NORM_ARITH_TAC);; let BOUNDED_SUBSET_CBALL = prove (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET cball(x,r)`, MESON_TAC[BOUNDED_SUBSET_BALL; SUBSET_TRANS; BALL_SUBSET_CBALL]);; let UNBOUNDED_INTER_COBOUNDED = prove (`!s t. ~bounded s /\ bounded((:real^N) DIFF t) ==> ~(s INTER t = {})`, REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (:real^N) DIFF t`] THEN MESON_TAC[BOUNDED_SUBSET]);; let COBOUNDED_INTER_UNBOUNDED = prove (`!s t. bounded((:real^N) DIFF s) /\ ~bounded t ==> ~(s INTER t = {})`, REWRITE_TAC[SET_RULE `s INTER t = {} <=> t SUBSET (:real^N) DIFF s`] THEN MESON_TAC[BOUNDED_SUBSET]);; let SUBSPACE_BOUNDED_EQ_TRIVIAL = prove (`!s:real^N->bool. subspace s ==> (bounded s <=> s = {vec 0})`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_SING] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN ASM_SIMP_TAC[SUBSPACE_0] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[bounded; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm v % v:real^N`) THEN ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC);; let BOUNDED_COMPONENTWISE = prove (`!s:real^N->bool. bounded s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> bounded (IMAGE (\x. lift(x$i)) s)`, GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; NORM_LIFT] THEN EQ_TAC THENL [ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->real` THEN DISCH_TAC THEN EXISTS_TAC `sum(1..dimindex(:N)) b` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. &0)` THEN SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POS] THEN MATCH_MP_TAC SUM_LT_ALL THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY] THEN REWRITE_TAC[NOT_LT; DIMINDEX_GE_1]; REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG]]);; let MBOUNDED_EQ_BOUNDED = prove (`!s:real^N->bool. mbounded euclidean_metric s <=> bounded s`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [POP_ASSUM SUBST_VAR_TAC THEN REWRITE_TAC[MBOUNDED_EMPTY; BOUNDED_EMPTY]; POP_ASSUM (LABEL_TAC "nempty")] THEN REWRITE_TAC[mbounded; bounded; MCBALL_EUCLIDEAN] THEN EQ_TAC THENL [INTRO_TAC "@c b. hp" THEN EXISTS_TAC `norm (c:real^N) + b` THEN HYP_TAC "hp" (REWRITE_RULE[SUBSET]) THEN INTRO_TAC "!x; x" THEN REMOVE_THEN "x" (HYP_TAC "hp: +" o C MATCH_MP) THEN REWRITE_TAC[IN_CBALL] THEN INTRO_TAC "le" THEN TRANS_TAC REAL_LE_TRANS `norm(c:real^N) + dist(c,x)` THEN ASM_REWRITE_TAC[REAL_LE_LADD] THEN CUT_TAC `dist(vec 0, x:real^N) <= dist(vec 0, c) + dist(c, x)` THENL [REWRITE_TAC[DIST_0]; MATCH_ACCEPT_TAC DIST_TRIANGLE]; INTRO_TAC "@a. hp" THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `a:real`] THEN ASM_REWRITE_TAC[SUBSET; IN_CBALL; DIST_0]]);; (* ------------------------------------------------------------------------- *) (* Some theorems on sups and infs using the notion "bounded". *) (* ------------------------------------------------------------------------- *) let BOUNDED_LIFT = prove (`!s. bounded(IMAGE lift s) <=> ?a. !x. x IN s ==> abs(x) <= a`, REWRITE_TAC[bounded; FORALL_LIFT; NORM_LIFT; LIFT_IN_IMAGE_LIFT]);; let BOUNDED_HAS_SUP = prove (`!s. bounded(IMAGE lift s) /\ ~(s = {}) ==> (!x. x IN s ==> x <= sup s) /\ (!b. (!x. x IN s ==> x <= b) ==> sup s <= b)`, REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN MESON_TAC[SUP; REAL_ARITH `abs(x) <= a ==> x <= a`]);; let SUP_INSERT = prove (`!x s. bounded (IMAGE lift s) ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_LE_MAX; REAL_LT_MAX; IN_INSERT] THEN MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; let BOUNDED_HAS_INF = prove (`!s. bounded(IMAGE lift s) /\ ~(s = {}) ==> (!x. x IN s ==> inf s <= x) /\ (!b. (!x. x IN s ==> b <= x) ==> b <= inf s)`, REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN MESON_TAC[INF; REAL_ARITH `abs(x) <= a ==> --a <= x`]);; let INF_INSERT = prove (`!x s. bounded (IMAGE lift s) ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_MIN_LE; REAL_MIN_LT; IN_INSERT] THEN MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; (* ------------------------------------------------------------------------- *) (* Subset and overlapping relations on balls. *) (* ------------------------------------------------------------------------- *) let SUBSET_BALLS = prove (`(!a a':real^N r r'. ball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ (!a a':real^N r r'. ball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ (!a a':real^N r r'. cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0) /\ (!a a':real^N r r'. cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0)`, let lemma = prove (`(!a':real^N r r'. cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0) /\ (!a':real^N r r'. cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0)`, CONJ_TAC THEN (GEOM_ORIGIN_TAC `a':real^N` THEN REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN EQ_TAC THENL [REWRITE_TAC[DIST_0]; NORM_ARITH_TAC] THEN DISJ_CASES_TAC(REAL_ARITH `r < &0 \/ &0 <= r`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISJ1_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `r % basis 1:real^N`) THEN ASM_SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; FIRST_X_ASSUM(MP_TAC o SPEC `(&1 + r / norm(a)) % a:real^N`) THEN SIMP_TAC[dist; VECTOR_ARITH `a - (&1 + x) % a:real^N = --(x % a)`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_NEG; REAL_POS; REAL_LE_DIV; NORM_POS_LE; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`]] THEN UNDISCH_TAC `&0 <= r` THEN NORM_ARITH_TAC)) and tac = DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN ASM_SIMP_TAC[CLOSED_CBALL; CLOSURE_CLOSED; CLOSURE_BALL] in REWRITE_TAC[AND_FORALL_THM] THEN GEOM_ORIGIN_TAC `a':real^N` THEN REPEAT STRIP_TAC THEN (EQ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) THEN MATCH_MP_TAC(SET_RULE `(s = {} <=> q) /\ (s SUBSET t /\ ~(s = {}) /\ ~(t = {}) ==> p) ==> s SUBSET t ==> p \/ q`) THEN REWRITE_TAC[BALL_EQ_EMPTY; CBALL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL [tac; tac; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[lemma] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let INTER_BALLS_EQ_EMPTY = prove (`(!a b:real^N r s. ball(a,r) INTER ball(b,s) = {} <=> r <= &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ (!a b:real^N r s. ball(a,r) INTER cball(b,s) = {} <=> r <= &0 \/ s < &0 \/ r + s <= dist(a,b)) /\ (!a b:real^N r s. cball(a,r) INTER ball(b,s) = {} <=> r < &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ (!a b:real^N r s. cball(a,r) INTER cball(b,s) = {} <=> r < &0 \/ s < &0 \/ r + s < dist(a,b))`, REPEAT STRIP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_CBALL; IN_BALL] THEN (EQ_TAC THENL [ALL_TAC; SPEC_TAC(`b % basis 1:real^N`,`v:real^N`) THEN CONV_TAC NORM_ARITH]) THEN DISCH_THEN(MP_TAC o GEN `c:real` o SPEC `c % basis 1:real^N`) THEN SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1; dist; NORM_NEG; VECTOR_SUB_LZERO; GSYM VECTOR_SUB_RDISTRIB; REAL_MUL_RID] THEN ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `min b r:real` th) THEN MP_TAC(SPEC `max (&0) (b - s:real)` th) THEN MP_TAC(SPEC `(r + (b - s)) / &2` th)) THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Compactness (the definition is the one based on convegent subsequences). *) (* ------------------------------------------------------------------------- *) let compact = new_definition `compact s <=> !f:num->real^N. (!n. f(n) IN s) ==> ?l r. l IN s /\ (!m n:num. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`;; let CONVERGENT_BOUNDED_MONOTONE_1 = prove (`!s. bounded(IMAGE s (:num)) /\ ((!n. drop(s n) <= drop(s(SUC n))) \/ (!n. drop(s(SUC n)) <= drop(s n))) ==> ?l. (s --> l) sequentially`, GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:real`) ASSUME_TAC) THEN MP_TAC(ISPECL [`drop o (s:num->real^1)`; `b:real`] CONVERGENT_BOUNDED_MONOTONE) THEN ASM_REWRITE_TAC[o_DEF; GSYM NORM_1; LIM_SEQUENTIALLY] THEN REWRITE_TAC[DIST_REAL; GSYM drop; GSYM EXISTS_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let CONVERGENT_BOUNDED_INCREASING_1 = prove (`!s b. (!n. drop(s n) <= drop(s(SUC n))) /\ (!n. drop(s n) <= b) ==> ?l. (s --> l) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE_1 THEN ASM_REWRITE_TAC[bounded] THEN EXISTS_TAC `max (abs b) (norm((s:num->real^1) 0))` THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; NORM_1] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC(REAL_ARITH `a <= x /\ x <= b ==> abs x <= max (abs b) (abs a)`) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; let CONVERGENT_BOUNDED_DECREASING_1 = prove (`!s b. (!n. drop(s(SUC n)) <= drop(s n)) /\ (!n. b <= drop(s n)) ==> ?l. (s --> l) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE_1 THEN ASM_REWRITE_TAC[bounded] THEN EXISTS_TAC `max (abs b) (norm((s:num->real^1) 0))` THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; NORM_1] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC(REAL_ARITH `b <= x /\ x <= a ==> abs x <= max (abs b) (abs a)`) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; let COMPACT_REAL_LEMMA = prove (`!s b. (!n:num. abs(s n) <= b) ==> ?l r. (!m n:num. m < n ==> r(m) < r(n)) /\ !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(r n) - l) < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MP_TAC(SPEC `s:num->real` MONOTONE_SUBSEQUENCE) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN ASM_MESON_TAC[]);; let COMPACT_LEMMA = prove (`!s. bounded s /\ (!n. (x:num->real^N) n IN s) ==> !d. d <= dimindex(:N) ==> ?l:real^N r. (!m n. m < n ==> r m < (r:num->num) n) /\ !e. &0 < e ==> ?N. !n i. 1 <= i /\ i <= d ==> N <= n ==> abs(x(r n)$i - l$i) < e`, GEN_TAC THEN REWRITE_TAC[bounded] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:real`) ASSUME_TAC) THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 <=> F`; CONJ_ASSOC] THEN DISCH_TAC THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN STRIP_TAC THEN MP_TAC(SPECL [`\n:num. (x:num->real^N) (r n) $ (SUC d)`; `b:real`] COMPACT_REAL_LEMMA) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; ARITH_RULE `1 <= SUC n`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `y:real` (X_CHOOSE_THEN `s:num->num` STRIP_ASSUME_TAC)) THEN MAP_EVERY EXISTS_TAC [`(lambda k. if k = SUC d then y else (l:real^N)$k):real^N`; `(r:num->num) o (s:num->num)`] THEN ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REPEAT(FIRST_ASSUM(C UNDISCH_THEN (MP_TAC o SPEC `e:real`) o concl)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN FIRST_ASSUM(fun th -> SIMP_TAC[LAMBDA_BETA; MATCH_MP(ARITH_RULE `SUC d <= n ==> !i. 1 <= i /\ i <= SUC d ==> 1 <= i /\ i <= n`) th]) THEN REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRY COND_CASES_TAC THEN ASM_MESON_TAC[MONOTONE_BIGGER; LE_TRANS; ARITH_RULE `N1 + N2 <= n ==> N2 <= n:num /\ N1 <= n`; ARITH_RULE `1 <= i /\ i <= d /\ SUC d <= n ==> ~(i = SUC d) /\ 1 <= SUC d /\ d <= n /\ i <= n`]);; let BOUNDED_CLOSED_IMP_COMPACT = prove (`!s:real^N->bool. bounded s /\ closed s ==> compact s`, REPEAT STRIP_TAC THEN REWRITE_TAC[compact] THEN X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` COMPACT_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CLOSED_SEQUENTIAL_LIMITS]) THEN EXISTS_TAC `(x:num->real^N) o (r:num->num)` THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / &(dimindex(:N))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_NONZERO; REAL_HALF; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[dist] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MATCH_MP (REAL_ARITH `a <= b ==> b < e ==> a < e`) (SPEC_ALL NORM_LE_L1)) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (1..dimindex(:N)) (\k. e / &2 / &(dimindex(:N)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[o_THM; LAMBDA_BETA; vector_sub] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; LE_TRANS]; ASM_SIMP_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_DIV_LMUL; REAL_OF_NUM_EQ; DIMINDEX_NONZERO; REAL_LE_REFL; REAL_LT_LDIV_EQ; ARITH; REAL_OF_NUM_LT; REAL_ARITH `x < x * &2 <=> &0 < x`]]);; (* ------------------------------------------------------------------------- *) (* Completeness. *) (* ------------------------------------------------------------------------- *) let cauchy = new_definition `cauchy (s:num->real^N) <=> !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> dist(s m,s n) < e`;; let complete = new_definition `complete s <=> !f:num->real^N. (!n. f n IN s) /\ cauchy f ==> ?l. l IN s /\ (f --> l) sequentially`;; let CAUCHY = prove (`!s:num->real^N. cauchy s <=> !e. &0 < e ==> ?N. !n. n >= N ==> dist(s n,s N) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL [MESON_TAC[LE_REFL]; DISCH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]);; let CAUCHY_SUBSEQUENCE = prove (`!x:num->real^N r:num->num. (!m n. m < n ==> r m < r n) /\ cauchy x ==> cauchy (x o r)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(MP_TAC o MATCH_MP MONOTONE_BIGGER) THEN REWRITE_TAC[cauchy; o_DEF; GE] THEN MESON_TAC[LE_TRANS]);; let CAUCHY_OFFSET = prove (`!k x:num->real^N. cauchy (\i. x(i + k)) <=> cauchy x`, REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[LE_ADD; LE_TRANS]] THEN MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`]);; let CONVERGENT_IMP_CAUCHY = prove (`!s l. (s --> l) sequentially ==> cauchy s`, REWRITE_TAC[LIM_SEQUENTIALLY; cauchy] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN ASM_MESON_TAC[GE; LE_REFL; DIST_TRIANGLE_HALF_L]);; let CAUCHY_IMP_BOUNDED = prove (`!s:num->real^N. cauchy s ==> bounded {y | ?n. y = s n}`, REWRITE_TAC[cauchy; bounded; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN REWRITE_TAC[GE_REFL] THEN DISCH_TAC THEN SUBGOAL_THEN `!n:num. N <= n ==> norm(s n :real^N) <= norm(s N) + &1` ASSUME_TAC THENL [ASM_MESON_TAC[GE; dist; DIST_SYM; NORM_TRIANGLE_SUB; REAL_ARITH `a <= b + c /\ c < &1 ==> a <= b + &1`]; MP_TAC(ISPECL [`\n:num. norm(s n :real^N)`; `0..N`] UPPER_BOUND_FINITE_SET_REAL) THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; LEFT_IMP_EXISTS_THM] THEN ASM_MESON_TAC[LE_CASES; REAL_ARITH `x <= a \/ x <= b ==> x <= abs a + abs b`]]);; let CAUCHY_CONVERGENT_SUBSEQUENCE = prove (`!x:num->real^N r. cauchy x /\ (!m n. m < n ==> r m < r n) /\ ((x o r) --> l) sequentially ==> (x --> l) sequentially`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_ADD)) THEN DISCH_THEN(MP_TAC o SPEC `\n. (x:num->real^N)(n) - x(r n)`) THEN DISCH_THEN(MP_TAC o SPEC `vec 0: real^N`) THEN ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_ADD2; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cauchy]) THEN REWRITE_TAC[GE; LIM; SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN FIRST_ASSUM(MP_TAC o MATCH_MP MONOTONE_BIGGER) THEN ASM_MESON_TAC[LE_TRANS]);; let COMPACT_IMP_COMPLETE = prove (`!s:real^N->bool. compact s ==> complete s`, GEN_TAC THEN REWRITE_TAC[complete; compact] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:num->real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CAUCHY_CONVERGENT_SUBSEQUENCE THEN ASM_MESON_TAC[]);; let COMPLETE_UNIV = prove (`complete(:real^N)`, REWRITE_TAC[complete; IN_UNIV] THEN X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP BOUNDED_CLOSURE) THEN MP_TAC(ISPEC `closure {y:real^N | ?n:num. y = x n}` COMPACT_IMP_COMPLETE) THEN ASM_SIMP_TAC[BOUNDED_CLOSED_IMP_COMPACT; CLOSED_CLOSURE; complete] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_REWRITE_TAC[closure; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]);; let COMPLETE_EQ_CLOSED = prove (`!s:real^N->bool. complete s <=> closed s`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[complete; CLOSED_LIMPT; LIMPT_SEQUENTIAL] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[CONVERGENT_IMP_CAUCHY; IN_DELETE; LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY]; REWRITE_TAC[complete; CLOSED_SEQUENTIAL_LIMITS] THEN DISCH_TAC THEN X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN MP_TAC(REWRITE_RULE[complete] COMPLETE_UNIV) THEN DISCH_THEN(MP_TAC o SPEC `f:num->real^N`) THEN ASM_REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[]]);; let CONVERGENT_EQ_CAUCHY = prove (`!s. (?l. (s --> l) sequentially) <=> cauchy s`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONVERGENT_IMP_CAUCHY]; REWRITE_TAC[REWRITE_RULE[complete; IN_UNIV] COMPLETE_UNIV]]);; let CONVERGENT_IMP_BOUNDED = prove (`!s l. (s --> l) sequentially ==> bounded (IMAGE s (:num))`, REWRITE_TAC[LEFT_FORALL_IMP_THM; CONVERGENT_EQ_CAUCHY] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN REWRITE_TAC[IMAGE; IN_UNIV]);; let CONVERGENT_BOUNDED_MONOTONE_EQ = prove (`!s. (!n. drop(s n) <= drop(s(SUC n))) \/ (!n. drop(s(SUC n)) <= drop(s n)) ==> ((?l. (s --> l) sequentially) <=> bounded (IMAGE s (:num)))`, MESON_TAC[CONVERGENT_BOUNDED_MONOTONE_1; CONVERGENT_IMP_BOUNDED]);; let CAUCHY_IN_EQ_CAUCHY = prove (`!s:num->real^N. cauchy_in euclidean_metric s <=> cauchy s`, REWRITE_TAC[cauchy; cauchy_in; EUCLIDEAN_METRIC; IN_UNIV; GE]);; let MCOMPLETE_EUCLIDEAN = prove (`mcomplete(euclidean_metric:(real^N)metric)`, REWRITE_TAC[mcomplete; MTOPOLOGY_EUCLIDEAN_METRIC; CAUCHY_IN_EQ_CAUCHY; LIMIT_EUCLIDEAN; CONVERGENT_EQ_CAUCHY]);; (* ------------------------------------------------------------------------- *) (* Cauchy-type criteria for limits at a point. *) (* ------------------------------------------------------------------------- *) let CONVERGENT_EQ_CAUCHY_WITHIN = prove (`!f:real^M->real^N s a. (?l. (f --> l) (at a within s)) <=> (!e. &0 < e ==> ?d. &0 < d /\ !x x'. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d /\ x' IN s /\ &0 < dist(x',a) /\ dist(x',a) < d ==> dist(f x,f x') < e)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; ASM_CASES_TAC `trivial_limit (at (a:real^M) within s)` THENL [ASM_REWRITE_TAC[LIM]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [TRIVIAL_LIMIT_WITHIN]) THEN REWRITE_TAC[LIMPT_SEQUENTIAL; IN_DELETE; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `b:num->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?l. (((f:real^M->real^N) o b) --> l) sequentially` MP_TAC THENL [REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy; o_THM; GE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[DIST_NZ]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN DISCH_THEN(LABEL_TAC "*") THEN REWRITE_TAC[LIM_WITHIN] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tendsto]) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND; o_THM] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(NORM_ARITH `dist(f:real^N,b) < e / &2 ==> dist(b,l) < e / &2 ==> dist(f,l) < e`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM DIST_NZ]]]);; let CONVERGENT_EQ_CAUCHY_AT = prove (`!f:real^M->real^N a. (?l. (f --> l) (at a)) <=> (!e. &0 < e ==> ?d. &0 < d /\ !x x'. &0 < dist(x,a) /\ dist(x,a) < d /\ &0 < dist(x',a) /\ dist(x',a) < d ==> dist(f x,f x') < e)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `a:real^M`] CONVERGENT_EQ_CAUCHY_WITHIN) THEN REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; let CONVERGENT_EQ_ZERO_OSCILLATION = prove (`!f:real^M->real^N a s. (?l. (f --> l) (at a within s)) <=> !e. &0 < e ==> ?u. open u /\ a IN u /\ !x y. x IN (s INTER u) DELETE a /\ y IN (s INTER u) DELETE a ==> dist(f x,f y) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY_WITHIN] THEN REWRITE_TAC[IN_INTER; IN_DELETE] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM DIST_NZ] THENL [DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(a:real^M,d)` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN REWRITE_TAC[IN_BALL] THEN ASM_MESON_TAC[DIST_SYM]; DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M` o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN ASM_REWRITE_TAC[IN_BALL; SUBSET] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[DIST_SYM]]);; (* ------------------------------------------------------------------------- *) (* Total boundedness. *) (* ------------------------------------------------------------------------- *) let COMPACT_IMP_TOTALLY_BOUNDED = prove (`!s:real^N->bool. compact s ==> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\ s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`; SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?x:num->real^N. !n. x(n) IN s /\ !m. m < n ==> ~(dist(x(m),x(n)) < e)` MP_TAC THENL [SUBGOAL_THEN `?x:num->real^N. !n. x(n) = @y. y IN s /\ !m. m < n ==> ~(dist(x(m),y) < e)` MP_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(SUBST1_TAC o SPEC `n:num`) THEN STRIP_TAC THEN CONV_TAC SELECT_CONV THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (x:num->real^N) {m | m < n}`) THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[IN_BALL]; ALL_TAC] THEN REWRITE_TAC[compact; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_THM; NOT_EXISTS_THM; NOT_IMP; NOT_FORALL_THM; NOT_IMP] THEN X_GEN_TAC `N:num` THEN MAP_EVERY EXISTS_TAC [`N:num`; `SUC N`] THEN CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[LT]]);; (* ------------------------------------------------------------------------- *) (* Heine-Borel theorem (following Burkill & Burkill vol. 2) *) (* ------------------------------------------------------------------------- *) let HEINE_BOREL_LEMMA = prove (`!s:real^N->bool. compact s ==> !t. s SUBSET (UNIONS t) /\ (!b. b IN t ==> open b) ==> ?e. &0 < e /\ !x. x IN s ==> ?b. b IN t /\ ball(x,e) SUBSET b`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_ARITH `x <= y ==> x < y + &1`; FORALL_AND_THM; REAL_POS; NOT_FORALL_THM; NOT_IMP; SKOLEM_THM; compact] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `?b:real^N->bool. l IN b /\ b IN t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; IN_UNIONS]; ALL_TAC] THEN SUBGOAL_THEN `?e. &0 < e /\ !z:real^N. dist(z,l) < e ==> z IN b` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_def]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN SUBGOAL_THEN `&0 < e / &2` (fun th -> REWRITE_TAC[th; o_THM] THEN MP_TAC(GEN_REWRITE_RULE I [REAL_ARCH_INV] th)) THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(r:num->num)(N1 + N2)`; `b:real^N->bool`]) THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_R THEN EXISTS_TAC `(f:num->real^N)(r(N1 + N2:num))` THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_MESON_TAC[ARITH_RULE `(~(n = 0) ==> 0 < n)`; LE_ADD; MONOTONE_BIGGER; LT_IMP_LE; LE_TRANS]);; let COMPACT_IMP_HEINE_BOREL = prove (`!s. compact (s:real^N->bool) ==> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `f:(real^N->bool)->bool` o MATCH_MP HEINE_BOREL_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_TAC `B:real^N->real^N->bool`) THEN FIRST_ASSUM(MP_TAC o SPEC `e:real` o MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN ASM_REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[IN_UNIONS; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (B:real^N->real^N->bool) k` THEN ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN ASM_MESON_TAC[IN_BALL]);; (* ------------------------------------------------------------------------- *) (* Bolzano-Weierstrass property. *) (* ------------------------------------------------------------------------- *) let HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. (!f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')) ==> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, REWRITE_TAC[RIGHT_IMP_FORALL_THM; limit_point_of] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> c ==> ~d ==> a ==> ~b`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `f:real^N->real^N->bool`) THEN DISCH_THEN(MP_TAC o SPEC `{t:real^N->bool | ?x:real^N. x IN s /\ (t = f x)}`) THEN REWRITE_TAC[INFINITE; SUBSET; IN_ELIM_THM; IN_UNIONS; NOT_IMP] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:real^N | x IN t /\ (f(x):real^N->bool) IN g}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE_INJ_GENERAL THEN ASM_MESON_TAC[SUBSET]; SIMP_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(u:real^N) IN s` ASSUME_TAC THEN ASM_MESON_TAC[SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Complete the chain of compactness variants. *) (* ------------------------------------------------------------------------- *) let BOLZANO_WEIERSTRASS_IMP_BOUNDED = prove (`!s:real^N->bool. (!t. INFINITE t /\ t SUBSET s ==> ?x. x limit_point_of t) ==> bounded s`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[compact; bounded] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; SKOLEM_THM; NOT_IMP] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_THEN(X_CHOOSE_TAC `beyond:real->real^N`) THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `(f(0) = beyond(&0)) /\ (!n. f(SUC n) = beyond(norm(f n) + &1):real^N)` THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (x:num->real^N) UNIV` THEN SUBGOAL_THEN `!m n. m < n ==> norm((x:num->real^N) m) + &1 < norm(x n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH `b < b + &1`]; ALL_TAC] THEN SUBGOAL_THEN `!m n. ~(m = n) ==> &1 < dist((x:num->real^N) m,x n)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`m:num`; `n:num`] LT_CASES) THEN ASM_MESON_TAC[dist; LT_CASES; NORM_TRIANGLE_SUB; NORM_SUB; REAL_ARITH `x + &1 < y /\ y <= x + d ==> &1 < d`]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[INFINITE_IMAGE_INJ; num_INFINITE; DIST_REFL; REAL_ARITH `~(&1 < &0)`]; REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N` THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN REWRITE_TAC[IN_IMAGE; IN_UNIV; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `dist((x:num->real^N) k,l)`) THEN ASM_SIMP_TAC[DIST_POS_LT] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `m:num = k` THEN ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; REAL_LT_TRANS; REAL_LT_REFL]);; let SEQUENCE_INFINITE_LEMMA = prove (`!f l. (!n. ~(f(n) = l)) /\ (f --> l) sequentially ==> INFINITE {y:real^N | ?n. y = f n}`, REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\y:real^N. dist(y,l)) {y | ?n:num. y = f n}` INF_FINITE) THEN ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE; FINITE_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[LIM_SEQUENTIALLY; LE_REFL; REAL_NOT_LE; DIST_POS_LT]);; let LIMPT_OF_SEQUENCE_SUBSEQUENCE = prove (`!f:num->real^N l. l limit_point_of (IMAGE f (:num)) ==> ?r. (!m n. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inf((inv(&n + &1)) INSERT IMAGE (\k. dist((f:num->real^N) k,l)) {k | k IN 0..n /\ ~(f k = l)})`) THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_INSERT; NOT_INSERT_EMPTY; FINITE_RESTRICT; FINITE_NUMSEG; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN SIMP_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; GSYM DIST_NZ; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `nn:num->num` STRIP_ASSUME_TAC) THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `r 0 = nn 0 /\ (!n. r (SUC n) = nn(r n))` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN REWRITE_TAC[LT_TRANS] THEN X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(r:num->num) n`; `(nn:num->num)(r(n:num))`]) THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_0; REAL_LT_REFL] THEN ARITH_TAC; DISCH_THEN(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER)] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[CONJUNCT1 LE] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&((r:num->num) n) + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(ARITH_RULE `N <= SUC n /\ n <= r n ==> N <= r n + 1`) THEN ASM_REWRITE_TAC[]);; let SEQUENCE_UNIQUE_LIMPT = prove (`!f l l':real^N. (f --> l) sequentially /\ l' limit_point_of {y | ?n. y = f n} ==> l' = l`, REWRITE_TAC[SET_RULE `{y | ?n. y = f n} = IMAGE f (:num)`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:num->real^N) o (r:num->num)` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUBSEQUENCE]);; let BOLZANO_WEIERSTRASS_IMP_CLOSED = prove (`!s:real^N->bool. (!t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t) ==> closed s`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN MAP_EVERY X_GEN_TAC [`f:num->real^N`; `l:real^N`] THEN DISCH_TAC THEN MAP_EVERY (MP_TAC o ISPECL [`f:num->real^N`; `l:real^N`]) [SEQUENCE_UNIQUE_LIMPT; SEQUENCE_INFINITE_LEMMA] THEN MATCH_MP_TAC(TAUT `(~d ==> a /\ ~(b /\ c)) ==> (a ==> b) ==> c ==> d`) THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | ?n:num. y = f n}`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM]; ABBREV_TAC `t = {y:real^N | ?n:num. y = f n}`] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence express everything as an equivalence. *) (* ------------------------------------------------------------------------- *) let COMPACT_EQ_HEINE_BOREL = prove (`!s:real^N->bool. compact s <=> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[COMPACT_IMP_HEINE_BOREL] THEN DISCH_THEN(MP_TAC o MATCH_MP HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS) THEN DISCH_TAC THEN MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN ASM_MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED]);; let COMPACT_IN_IFF_COMPACT = prove (`!s:real^N->bool. s compact_in euclidean <=> compact s`, REWRITE_TAC[compact_in; COMPACT_EQ_HEINE_BOREL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV; GSYM OPEN_IN] THEN ASM_MESON_TAC[]);; let COMPACT_EQ_BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. compact s <=> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[COMPACT_EQ_HEINE_BOREL; HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS]; MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED; BOUNDED_CLOSED_IMP_COMPACT]]);; let COMPACT_EQ_BOUNDED_CLOSED = prove (`!s:real^N->bool. compact s <=> bounded s /\ closed s`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSED_IMP_COMPACT] THEN MESON_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED]);; let COMPACT_IMP_BOUNDED = prove (`!s. compact s ==> bounded s`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; let COMPACT_IMP_CLOSED = prove (`!s. compact s ==> closed s`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; let COMPACT_SEQUENCE_WITH_LIMIT_GEN = prove (`!f l:real^N s. (f --> l) sequentially /\ s SUBSET IMAGE f (:num) ==> compact (l INSERT s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REWRITE_TAC[BOUNDED_INSERT] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_BOUNDED; BOUNDED_SUBSET]; SIMP_TAC[CLOSED_LIMPT; LIMPT_INSERT; IN_INSERT] THEN REWRITE_TAC[IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC SEQUENCE_UNIQUE_LIMPT THEN REWRITE_TAC[SET_RULE `{y | ?n. y = f n} = IMAGE f UNIV`] THEN ASM_MESON_TAC[LIMPT_SUBSET]]);; let COMPACT_SEQUENCE_WITH_LIMIT = prove (`!f l:real^N. (f --> l) sequentially ==> compact (l INSERT IMAGE f (:num))`, MESON_TAC[COMPACT_SEQUENCE_WITH_LIMIT_GEN; SUBSET_REFL]);; let CLOSED_IN_COMPACT = prove (`!s t:real^N->bool. compact s /\ closed_in (subtopology euclidean s) t ==> compact t`, SIMP_TAC[IMP_CONJ; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_EQ] THEN MESON_TAC[BOUNDED_SUBSET]);; let CLOSED_IN_COMPACT_EQ = prove (`!s t. compact s ==> (closed_in (subtopology euclidean s) t <=> compact t /\ t SUBSET s)`, MESON_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);; (* ------------------------------------------------------------------------- *) (* A version of Heine-Borel for subtopology. *) (* ------------------------------------------------------------------------- *) let COMPACT_EQ_HEINE_BOREL_GEN,COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY = (CONJ_PAIR o prove) (`(!c:real^N->bool. compact c <=> !f s. (!t. t IN f ==> open_in (subtopology euclidean s) t) /\ c SUBSET UNIONS f ==> ?f'. f' SUBSET f /\ FINITE f' /\ c SUBSET UNIONS f') /\ (!s:real^N->bool. compact s <=> !f. (!t. t IN f ==> open_in(subtopology euclidean s) t) /\ s SUBSET UNIONS f ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET UNIONS f')`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `c:real^N->bool` THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; DISCH_TAC THEN X_GEN_TAC `f:(real^N->bool)->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{c INTER t:real^N->bool | t IN f}`) THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_IN_OPEN; UNIONS_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`f:(real^N->bool)->bool`; `s:real^N->bool`] THEN REWRITE_TAC[OPEN_IN_OPEN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `m:(real^N->bool)->(real^N->bool)`) ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (m:(real^N->bool)->(real^N->bool)) f`) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\t:real^N->bool. s INTER t) f'` THEN ASM_SIMP_TAC[FINITE_IMAGE; UNIONS_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_IMAGE]) THEN STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET]]);; (* ------------------------------------------------------------------------- *) (* More easy lemmas. *) (* ------------------------------------------------------------------------- *) let COMPACT_CLOSURE = prove (`!s. compact(closure s) <=> bounded s`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; BOUNDED_CLOSURE_EQ]);; let BOLZANO_WEIERSTRASS_CONTRAPOS = prove (`!s t:real^N->bool. compact s /\ t SUBSET s /\ (!x. x IN s ==> ~(x limit_point_of t)) ==> FINITE t`, REWRITE_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; INFINITE] THEN MESON_TAC[]);; let DISCRETE_BOUNDED_IMP_FINITE = prove (`!s:real^N->bool e. &0 < e /\ (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) /\ bounded s ==> FINITE s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `compact(s:real^N->bool)` MP_TAC THENL [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_MESON_TAC[DISCRETE_IMP_CLOSED]; DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL)] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. ball(x,e)) s`) THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; UNIONS_IMAGE; IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL]; ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`]] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_BALL; dist] THEN ASM_MESON_TAC[SUBSET]);; let FINITE_EQ_BOUNDED_DISCRETE = prove (`!s:real^N->bool. FINITE s <=> bounded s /\ ?r. &0 < r /\ !x y. x IN s /\ y IN s /\ norm (y - x) < r ==> x = y`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[FINITE_IMP_BOUNDED]; MESON_TAC[DISCRETE_BOUNDED_IMP_FINITE]] THEN DISCH_TAC THEN ASM_CASES_TAC `{(x:real^N,y) | x IN s /\ y IN s DELETE x} = {}` THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `inf (IMAGE dist {(x:real^N,y) | x IN s /\ y IN s DELETE x})` THEN ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_DELETE; REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN SIMP_TAC[IN_DELETE; DIST_POS_LT; dist] THEN MESON_TAC[REAL_LT_REFL]);; let BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. bounded s /\ INFINITE s ==> ?x. x limit_point_of s`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP NO_LIMIT_POINT_IMP_CLOSED) THEN STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` COMPACT_EQ_BOLZANO_WEIERSTRASS) THEN ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[]);; let BOUNDED_EQ_BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. bounded s <=> !t. t SUBSET s /\ INFINITE t ==> ?x. x limit_point_of t`, MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS; BOUNDED_SUBSET]);; let BOUNDED_EQ_TOTALLY_BOUNDED = prove (`!s:real^N->bool. bounded s <=> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\ s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` COMPACT_IMP_TOTALLY_BOUNDED) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(k:real^N->bool) SUBSET closure s` THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (f:real^N->real^N) k` THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FINITE_IMAGE; UNIONS_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c SUBSET t ==> s SUBSET c /\ (!x. x IN t ==> P x) ==> !x. x IN s ==> P x`)) THEN SIMP_TAC[UNIONS_IMAGE; CLOSURE_SUBSET; EXISTS_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_BALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN MATCH_MP_TAC BOUNDED_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; BOUNDED_BALL]]);; let DISCRETE_EQ_FINITE_BOUNDED = prove (`!s:real^N->bool. bounded s ==> ({x | x limit_point_of s} = {} <=> FINITE s)`, GEN_TAC THEN REWRITE_TAC[BOUNDED_EQ_BOLZANO_WEIERSTRASS] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN MESON_TAC[LIMIT_POINT_FINITE; INFINITE; SUBSET_REFL]);; let DISCRETE_EQ_FINITE_BOUNDED_CLOSED = prove (`!s t:real^N->bool. closed s /\ bounded t /\ t SUBSET s ==> ({x | x IN s /\ x limit_point_of t} = {} <=> FINITE t)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM DISCRETE_EQ_FINITE_BOUNDED] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. P x ==> x IN s) ==> {x | x IN s /\ P x} = {x | P x}`) THEN ASM_MESON_TAC[CLOSED_LIMPT; LIMPT_SUBSET]);; let DISCRETE_EQ_FINITE_COMPACT = prove (`!s t:real^N->bool. compact s /\ t SUBSET s ==> ({x | x IN s /\ x limit_point_of t} = {} <=> FINITE t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DISCRETE_EQ_FINITE_BOUNDED_CLOSED THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);; (* ------------------------------------------------------------------------- *) (* In particular, some common special cases. *) (* ------------------------------------------------------------------------- *) let COMPACT_EMPTY = prove (`compact {}`, REWRITE_TAC[compact; NOT_IN_EMPTY]);; let COMPACT_UNION = prove (`!s t. compact s /\ compact t ==> compact (s UNION t)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_UNION; CLOSED_UNION]);; let COMPACT_INTER = prove (`!s t. compact s /\ compact t ==> compact (s INTER t)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; CLOSED_INTER]);; let COMPACT_INTER_CLOSED = prove (`!s t. compact s /\ closed t ==> compact (s INTER t)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER] THEN MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; let CLOSED_INTER_COMPACT = prove (`!s t. closed s /\ compact t ==> compact (s INTER t)`, MESON_TAC[COMPACT_INTER_CLOSED; INTER_COMM]);; let COMPACT_INTERS = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> compact s) /\ ~(f = {}) ==> compact(INTERS f)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTERS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_INTERS THEN ASM SET_TAC[]);; let FINITE_IMP_CLOSED = prove (`!s. FINITE s ==> closed s`, MESON_TAC[BOLZANO_WEIERSTRASS_IMP_CLOSED; INFINITE; FINITE_SUBSET]);; let FINITE_IMP_CLOSED_IN = prove (`!s t. FINITE s /\ s SUBSET t ==> closed_in (subtopology euclidean t) s`, SIMP_TAC[CLOSED_SUBSET_EQ; FINITE_IMP_CLOSED]);; let FINITE_IMP_COMPACT = prove (`!s. FINITE s ==> compact s`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; FINITE_IMP_CLOSED; FINITE_IMP_BOUNDED]);; let COMPACT_SING = prove (`!a. compact {a}`, SIMP_TAC[FINITE_IMP_COMPACT; FINITE_RULES]);; let COMPACT_INSERT = prove (`!a s. compact s ==> compact(a INSERT s)`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN SIMP_TAC[COMPACT_UNION; COMPACT_SING]);; let CLOSURE_SING = prove (`!x:real^N. closure {x} = {x}`, SIMP_TAC[CLOSURE_CLOSED; CLOSED_SING]);; let CLOSURE_INSERT = prove (`!s a:real^N. closure(a INSERT s) = a INSERT closure s`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN REWRITE_TAC[CLOSURE_UNION; CLOSURE_SING]);; let CLOSURE_DELETE = prove (`!s a:real^N. closure(s DELETE a) = if a limit_point_of s then closure s else closure s DELETE a`, REPEAT GEN_TAC THEN REWRITE_TAC[closure; EXTENSION; IN_UNION; IN_DELETE; IN_ELIM_THM] THEN REWRITE_TAC[LIMPT_DELETE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let CLOSED_INSERT = prove (`!a s. closed s ==> closed(a INSERT s)`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN SIMP_TAC[CLOSED_UNION; CLOSED_SING]);; let CONNECTED_2 = prove (`!a b:real^N. connected {a,b} <=> a = b`, REPEAT GEN_TAC THEN SIMP_TAC[CONNECTED_INSERT; CONNECTED_SING] THEN REWRITE_TAC[CLOSURE_SING] THEN SET_TAC[]);; let COMPACT_CBALL = prove (`!x e. compact(cball(x,e))`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_CBALL; CLOSED_CBALL]);; let COMPACT_FRONTIER_BOUNDED = prove (`!s. bounded s ==> compact(frontier s)`, SIMP_TAC[frontier; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_DIFF; OPEN_INTERIOR; CLOSED_CLOSURE] THEN MESON_TAC[SUBSET_DIFF; BOUNDED_SUBSET; BOUNDED_CLOSURE]);; let COMPACT_FRONTIER = prove (`!s. compact s ==> compact (frontier s)`, MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_FRONTIER_BOUNDED]);; let BOUNDED_FRONTIER = prove (`!s:real^N->bool. bounded s ==> bounded(frontier s)`, MESON_TAC[COMPACT_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);; let FRONTIER_SUBSET_COMPACT = prove (`!s. compact s ==> frontier s SUBSET s`, MESON_TAC[FRONTIER_SUBSET_CLOSED; COMPACT_EQ_BOUNDED_CLOSED]);; let OPEN_DELETE = prove (`!s x. open s ==> open(s DELETE x)`, let lemma = prove(`s DELETE x = s DIFF {x}`,SET_TAC[]) in SIMP_TAC[lemma; OPEN_DIFF; CLOSED_SING]);; let OPEN_IN_DELETE = prove (`!u s a:real^N. open_in (subtopology euclidean u) s ==> open_in (subtopology euclidean u) (s DELETE a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`]]);; let CLOSED_INTERS_COMPACT = prove (`!s:real^N->bool. closed s <=> !e. compact(cball(vec 0,e) INTER s)`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; CLOSED_CBALL; BOUNDED_INTER; BOUNDED_CBALL]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `norm(x:real^N) + &1`) THEN DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &2)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `y:real^N` THEN SIMP_TAC[IN_INTER; IN_CBALL] THEN NORM_ARITH_TAC);; let COMPACT_UNIONS = prove (`!s. FINITE s /\ (!t. t IN s ==> compact t) ==> compact(UNIONS s)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_UNIONS; BOUNDED_UNIONS]);; let COMPACT_DIFF = prove (`!s t. compact s /\ open t ==> compact(s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[COMPACT_INTER_CLOSED; GSYM OPEN_CLOSED]);; let COMPACT_SPHERE = prove (`!a:real^N r. compact(sphere(a,r))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC COMPACT_FRONTIER THEN REWRITE_TAC[COMPACT_CBALL]);; let BOUNDED_SPHERE = prove (`!a:real^N r. bounded(sphere(a,r))`, SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_BOUNDED]);; let CLOSED_SPHERE = prove (`!a r. closed(sphere(a,r))`, SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED]);; let CLOSURE_SPHERE = prove (`!a:real^N r. closure(sphere(a,r)) = sphere(a,r)`, REWRITE_TAC[CLOSURE_EQ; CLOSED_SPHERE]);; let FRONTIER_SPHERE = prove (`!a:real^N r. frontier(sphere(a,r)) = sphere(a,r)`, REWRITE_TAC[frontier; CLOSURE_SPHERE; INTERIOR_SPHERE; DIFF_EMPTY]);; let FRONTIER_SING = prove (`!a:real^N. frontier {a} = {a}`, REWRITE_TAC[frontier; CLOSURE_SING; INTERIOR_SING; DIFF_EMPTY]);; let COMPACT_OPEN = prove (`!s:real^N->bool. compact s /\ open s <=> s = {}`, MESON_TAC[COMPACT_EMPTY; OPEN_EMPTY; COMPACT_IMP_CLOSED; CLOPEN; COMPACT_IMP_BOUNDED; NOT_BOUNDED_UNIV]);; (* ------------------------------------------------------------------------- *) (* Finite intersection property. I could make it an equivalence in fact. *) (* ------------------------------------------------------------------------- *) let COMPACT_IMP_FIP = prove (`!s:real^N->bool f. compact s /\ (!t. t IN f ==> closed t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) ==> ~(s INTER (INTERS f) = {})`, let lemma = prove(`(s = UNIV DIFF t) <=> (UNIV DIFF s = t)`,SET_TAC[]) in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) f`) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[OPEN_DIFF; CLOSED_DIFF; OPEN_UNIV; CLOSED_UNIV; NOT_IMP] THEN CONJ_TAC THENL [UNDISCH_TAC `(s:real^N->bool) INTER INTERS f = {}` THEN ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) g`) THEN ASM_CASES_TAC `FINITE(g:(real^N->bool)->bool)` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTER; IN_INTERS; IN_IMAGE; IN_DIFF; IN_UNIV; NOT_IN_EMPTY; lemma; UNWIND_THM1; IN_UNIONS] THEN SET_TAC[]]);; let CLOSED_IMP_FIP = prove (`!s:real^N->bool f. closed s /\ (!t. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) ==> ~(s INTER (INTERS f) = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `~((s INTER t) INTER u = {}) ==> ~(s INTER u = {})`) THEN MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INTER_COMPACT; COMPACT_EQ_BOUNDED_CLOSED]; REWRITE_TAC[INTER_ASSOC] THEN ONCE_REWRITE_TAC[GSYM INTERS_INSERT]] THEN GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[FINITE_INSERT; INSERT_SUBSET]);; let CLOSED_IMP_FIP_COMPACT = prove (`!s:real^N->bool f. closed s /\ (!t. t IN f ==> compact t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) ==> ~(s INTER (INTERS f) = {})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_SIMP_TAC[SUBSET_EMPTY; INTERS_0; INTER_UNIV] THENL [MESON_TAC[FINITE_EMPTY]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; MEMBER_NOT_EMPTY]);; let CLOSED_FIP = prove (`!f. (!t:real^N->bool. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; let COMPACT_FIP = prove (`!f. (!t:real^N->bool. t IN f ==> compact t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN MATCH_MP_TAC CLOSED_IMP_FIP_COMPACT THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; (* ------------------------------------------------------------------------- *) (* Bounded closed nest property (proof does not use Heine-Borel). *) (* ------------------------------------------------------------------------- *) let BOUNDED_CLOSED_NEST = prove (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ (!m n. m <= n ==> s(n) SUBSET s(m)) /\ bounded(s 0) ==> ?a:real^N. !n:num. a IN s(n)`, GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `compact(s 0:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[BOUNDED_CLOSED_IMP_COMPACT]; ALL_TAC] THEN REWRITE_TAC[compact] THEN DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_0]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC I [TAUT `p <=> ~(~p)`] THEN GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN MP_TAC(ISPECL [`l:real^N`; `(s:num->real^N->bool) N`] CLOSED_APPROACHABLE) THEN ASM_MESON_TAC[SUBSET; LE_REFL; LE_TRANS; LE_CASES; MONOTONE_BIGGER]);; (* ------------------------------------------------------------------------- *) (* Decreasing case does not even need compactness, just completeness. *) (* ------------------------------------------------------------------------- *) let DECREASING_CLOSED_NEST = prove (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ (!m n. m <= n ==> s(n) SUBSET s(m)) /\ (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) ==> ?a:real^N. !n:num. a IN s(n)`, GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?l:real^N. (a --> l) sequentially` MP_TAC THENL [ASM_MESON_TAC[cauchy; GE; SUBSET; LE_TRANS; LE_REFL; complete; COMPLETE_UNIV; IN_UNIV]; ASM_MESON_TAC[LIM_SEQUENTIALLY; CLOSED_APPROACHABLE; SUBSET; LE_REFL; LE_TRANS; LE_CASES]]);; (* ------------------------------------------------------------------------- *) (* Strengthen it to the intersection actually being a singleton. *) (* ------------------------------------------------------------------------- *) let DECREASING_CLOSED_NEST_SING = prove (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ (!m n. m <= n ==> s(n) SUBSET s(m)) /\ (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) ==> ?a:real^N. INTERS {t | ?n:num. t = s n} = {a}`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DECREASING_CLOSED_NEST) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERS; IN_SING; IN_ELIM_THM] THEN ASM_MESON_TAC[DIST_POS_LT; REAL_LT_REFL; SUBSET; LE_CASES]);; (* ------------------------------------------------------------------------- *) (* A version for a more general chain, not indexed by N. *) (* ------------------------------------------------------------------------- *) let BOUNDED_CLOSED_CHAIN = prove (`!f b:real^N->bool. (!s. s IN f ==> closed s /\ ~(s = {})) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) /\ b IN f /\ bounded b ==> ~(INTERS f = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(b INTER (INTERS f):real^N->bool = {})` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?s:real^N->bool. s IN f /\ !t. t IN u ==> s SUBSET t` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN UNDISCH_TAC `(u:(real^N->bool)->bool) SUBSET f` THEN UNDISCH_TAC `FINITE(u:(real^N->bool)->bool)` THEN SPEC_TAC(`u:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:(real^N->bool)->bool`] THEN REWRITE_TAC[INSERT_SUBSET] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Analogous things directly for compactness. *) (* ------------------------------------------------------------------------- *) let COMPACT_CHAIN = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> compact s /\ ~(s = {})) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ~(INTERS f = {})`, GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[INTERS_0] THEN SET_TAC[]; MATCH_MP_TAC BOUNDED_CLOSED_CHAIN THEN ASM SET_TAC[]]);; let COMPACT_NEST = prove (`!s. (!n. compact(s n) /\ ~(s n = {})) /\ (!m n. m <= n ==> s n SUBSET s m) ==> ~(INTERS {s n | n IN (:num)} = {})`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPACT_CHAIN THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Relating convergent subsequences to escaping from a compact set. *) (* ------------------------------------------------------------------------- *) let SEQUENCE_ESCAPES = prove (`!s x:num->real^N. (!n. x n IN s) ==> ((!k. k SUBSET s /\ compact k ==> FINITE {n | x n IN k}) <=> ~(?y r. y IN s /\ (!m n. m < n ==> r m < r n) /\ (x o r --> y) sequentially))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `(p <=> ~q) <=> (~p <=> q)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INFINITE]) THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN DISCH_THEN(MP_TAC o SPEC `(x:num->real^N) o (r:num->num)`) THEN REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN ASM_SIMP_TAC[o_ASSOC; o_THM] THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`y:real^N`; `r:num->num`] THEN STRIP_TAC THEN EXISTS_TAC `y INSERT (IMAGE ((x:num->real^N) o r) (:num))` THEN ASM_SIMP_TAC[COMPACT_SEQUENCE_WITH_LIMIT; INSERT_SUBSET; IMAGE_o] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (r:num->num) (:num)`) THEN REWRITE_TAC[num_FINITE; NOT_IMP; FORALL_IN_IMAGE; IN_UNIV] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n + 1`)) THEN MATCH_MP_TAC(ARITH_RULE `n + 1 <= x ==> x <= n ==> F`) THEN ASM_MESON_TAC[MONOTONE_BIGGER]]);; let SEQUENCE_ESCAPES_ALT = prove (`!s x:num->real^N. (!n. x n IN s) ==> ((!k. k SUBSET s /\ compact k ==> eventually (\n. ~(x n IN k)) sequentially) <=> ~(?y r. y IN s /\ (!m n. m < n ==> r m < r n) /\ (x o r --> y) sequentially))`, REWRITE_TAC[EVENTUALLY_IN_SEQUENTIALLY; SEQUENCE_ESCAPES]);; let CONVERGENT_SUBSEQUENCE = prove (`!s x:num->real^N. (!n. x n IN s) ==> ((?y r. y IN s /\ (!m n. m < n ==> r m < r n) /\ (x o r --> y) sequentially) <=> (?k. k SUBSET s /\ compact k /\ INFINITE {n | x(n) IN k}))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `~` o MATCH_MP SEQUENCE_ESCAPES) THEN REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[NOT_FORALL_THM; INFINITE] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cauchy-type criteria for *uniform* convergence. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONVERGENT_EQ_CAUCHY = prove (`!P s:num->A->real^N. (?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=> (!e. &0 < e ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `l:A->real^N`) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `!x:A. P x ==> cauchy (\n. s n x :real^N)` MP_TAC THENL [REWRITE_TAC[cauchy; GE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:A->real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `N + M:num`; `x:A`]) THEN ASM_REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; let UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT = prove (`!P s:num->A->real^N. (?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=> (!e. &0 < e ==> ?N. !m n x. N <= m /\ N <= n /\ m < n /\ P x ==> dist(s m x,s n x) < e)`, REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC WLOG_LT THEN ASM_SIMP_TAC[DIST_REFL] THEN MESON_TAC[DIST_SYM]);; let UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT = prove (`!P (s:num->A->real^N) l. (!e. &0 < e ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e) /\ (!x. P x ==> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s n x,l x) < e) ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `l':A->real^N`) ASSUME_TAC) THEN SUBGOAL_THEN `!x. P x ==> (l:A->real^N) x = l' x` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. (s:num->A->real^N) n x` THEN REWRITE_TAC[LIM_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Define continuity over a net to take in restrictions of the set. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("continuous",(12,"right"));; let continuous = new_definition `f continuous net <=> (f --> f(netlimit net)) net`;; let CONTINUOUS_TRIVIAL_LIMIT = prove (`!f net. trivial_limit net ==> f continuous net`, SIMP_TAC[continuous; LIM]);; let CONTINUOUS_WITHIN = prove (`!f x:real^M. f continuous (at x within s) <=> (f --> f(x)) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; let LIM_CONTINUOUS_SELF_WITHIN = prove (`!f:real^M->real^N s x y. f continuous (at x within s) /\ f x = y ==> (f --> y) (at x within s)`, REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[]);; let CONTINUOUS_AT = prove (`!f (x:real^N). f continuous (at x) <=> (f --> f(x)) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHIN; IN_UNIV]);; let LIM_CONTINUOUS_SELF_AT = prove (`!f:real^M->real^N x y. f continuous (at x) /\ f x = y ==> (f --> y) (at x)`, REWRITE_TAC[CONTINUOUS_AT] THEN MESON_TAC[]);; let CONTINUOUS_AT_WITHIN = prove (`!f:real^M->real^N x s. f continuous (at x) ==> f continuous (at x within s)`, SIMP_TAC[LIM_AT_WITHIN; CONTINUOUS_AT; CONTINUOUS_WITHIN]);; let CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL = prove (`!a s. closed s /\ ~(a IN s) ==> f continuous (at a within s)`, ASM_SIMP_TAC[continuous; LIM; LIM_WITHIN_CLOSED_TRIVIAL]);; let CONTINUOUS_TRANSFORM_WITHIN = prove (`!f g:real^M->real^N s x d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist(x',x) < d ==> f(x') = g(x')) /\ f continuous (at x within s) ==> g continuous (at x within s)`, REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_TRANSFORM_WITHIN; DIST_REFL]);; let CONTINUOUS_TRANSFORM_AT = prove (`!f g:real^M->real^N x d. &0 < d /\ (!x'. dist(x',x) < d ==> f(x') = g(x')) /\ f continuous (at x) ==> g continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT] THEN MESON_TAC[LIM_TRANSFORM_AT; DIST_REFL]);; let CONTINUOUS_TRANSFORM_WITHIN_OPEN = prove (`!f g:real^M->real^N s a. open s /\ a IN s /\ (!x. x IN s ==> f x = g x) /\ f continuous at a ==> g continuous at a`, MESON_TAC[CONTINUOUS_AT; LIM_TRANSFORM_WITHIN_OPEN]);; let CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN = prove (`!f g:real^M->real^N s t a. open_in (subtopology euclidean t) s /\ a IN s /\ (!x. x IN s ==> f x = g x) /\ f continuous (at a within t) ==> g continuous (at a within t)`, MESON_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_OPEN_IN]);; let CONTINUOUS_TRANSFORM_WITHIN_SET_IMP = prove (`!f a s t. eventually (\x. x IN t ==> x IN s) (at a) /\ f continuous (at a within s) ==> f continuous (at a within t)`, REWRITE_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_SET_IMP]);; (* ------------------------------------------------------------------------- *) (* Derive the epsilon-delta forms, which we often use as "definitions" *) (* ------------------------------------------------------------------------- *) let continuous_within = prove (`f continuous (at x within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`, REWRITE_TAC[CONTINUOUS_WITHIN; LIM_WITHIN] THEN REWRITE_TAC[GSYM DIST_NZ] THEN MESON_TAC[DIST_REFL]);; let continuous_at = prove (`f continuous (at x) <=> !e. &0 < e ==> ?d. &0 < d /\ !x'. dist(x',x) < d ==> dist(f(x'),f(x)) < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[continuous_within; IN_UNIV]);; let CONTINUOUS_WITHIN_COMPARISON = prove (`!f:real^M->real^N g:real^M->real^P s a. g continuous (at a within s) /\ (!x. x IN s ==> dist(f a,f x) <= dist(g a,g x)) ==> f continuous (at a within s)`, ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[continuous_within] THEN MESON_TAC[REAL_LET_TRANS]);; let CONTINUOUS_EQ_CAUCHY_WITHIN = prove (`!f:real^M->real^N s a. f continuous (at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x x'. x IN a INSERT s /\ dist(x,a) < d /\ x' IN a INSERT s /\ dist(x',a) < d ==> dist(f x,f x') < e`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; IN_INSERT] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIST_REFL]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL] THEN ASM_SIMP_TAC[NORM_ARITH `dist(x:real^N,a) < e / &2 ==> dist(a,x) < e`] THEN ASM_SIMP_TAC[NORM_ARITH `dist(x:real^N,a) < e / &2 ==> dist(x,a) < e`] THEN ASM_MESON_TAC[NORM_ARITH `dist(x:real^N,a) < e / &2 /\ dist(y,a) < e / &2 ==> dist(x,y) < e`]);; let CONTINUOUS_EQ_CAUCHY_AT = prove (`!f:real^M->real^N a. f continuous (at a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x x'. dist(x,a) < d /\ dist(x',a) < d ==> dist(f x,f x') < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_EQ_CAUCHY_WITHIN; IN_INSERT; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Versions in terms of open balls. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_BALL = prove (`!f s x. f continuous (at x within s) <=> !e. &0 < e ==> ?d. &0 < d /\ IMAGE f (ball(x,d) INTER s) SUBSET ball(f x,e)`, SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_within; IN_INTER] THEN MESON_TAC[DIST_SYM]);; let CONTINUOUS_AT_BALL = prove (`!f x. f continuous (at x) <=> !e. &0 < e ==> ?d. &0 < d /\ IMAGE f (ball(x,d)) SUBSET ball(f x,e)`, SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_at] THEN MESON_TAC[DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* For setwise continuity, just start from the epsilon-delta definitions. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("continuous_on",(12,"right"));; parse_as_infix ("uniformly_continuous_on",(12,"right"));; let continuous_on = new_definition `f continuous_on s <=> !x. x IN s ==> !e. &0 < e ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`;; let uniformly_continuous_on = new_definition `f uniformly_continuous_on s <=> !e. &0 < e ==> ?d. &0 < d /\ !x x'. x IN s /\ x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`;; let CONTINUOUS_ON_COMPARISON = prove (`!f:real^M->real^N g:real^M->real^P s. g continuous_on s /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(g x,g y)) ==> f continuous_on s`, REWRITE_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);; (* ------------------------------------------------------------------------- *) (* Some simple consequential lemmas. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS = prove (`!f s. f uniformly_continuous_on s ==> f continuous_on s`, REWRITE_TAC[uniformly_continuous_on; continuous_on] THEN MESON_TAC[]);; let CONTINUOUS_AT_IMP_CONTINUOUS_ON = prove (`!f s. (!x. x IN s ==> f continuous (at x)) ==> f continuous_on s`, REWRITE_TAC[continuous_at; continuous_on] THEN MESON_TAC[]);; let CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove (`!f s. f continuous_on s <=> !x. x IN s ==> f continuous (at x within s)`, REWRITE_TAC[continuous_on; continuous_within]);; let CONTINUOUS_ON = prove (`!f (s:real^N->bool). f continuous_on s <=> !x. x IN s ==> (f --> f(x)) (at x within s)`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN]);; let CONTINUOUS_ON_EQ_CONTINUOUS_AT = prove (`!f:real^M->real^N s. open s ==> (f continuous_on s <=> (!x. x IN s ==> f continuous (at x)))`, SIMP_TAC[CONTINUOUS_ON; CONTINUOUS_AT; LIM_WITHIN_OPEN]);; let CONTINUOUS_WITHIN_OPEN_IN = prove (`!f:real^M->real^N a s t. a IN t /\ open_in (subtopology euclidean s) t ==> (f continuous (at a within t) <=> f continuous (at a within s))`, REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_OPEN_IN]);; let CONTINUOUS_WITHIN_SUBSET = prove (`!f s t x. f continuous (at x within s) /\ t SUBSET s ==> f continuous (at x within t)`, REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_SUBSET]);; let CONTINUOUS_ON_SUBSET = prove (`!f s t. f continuous_on s /\ t SUBSET s ==> f continuous_on t`, REWRITE_TAC[CONTINUOUS_ON] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; let UNIFORMLY_CONTINUOUS_ON_SUBSET = prove (`!f s t. f uniformly_continuous_on s /\ t SUBSET s ==> f uniformly_continuous_on t`, REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; let CONTINUOUS_ON_INTERIOR = prove (`!f:real^M->real^N s x. f continuous_on s /\ x IN interior(s) ==> f continuous at x`, REWRITE_TAC[interior; IN_ELIM_THM] THEN MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; CONTINUOUS_ON_SUBSET]);; let CONTINUOUS_ON_EQ = prove (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f continuous_on s ==> g continuous_on s`, SIMP_TAC[continuous_on; IMP_CONJ]);; let UNIFORMLY_CONTINUOUS_ON_EQ = prove (`!f g s. (!x. x IN s ==> f x = g x) /\ f uniformly_continuous_on s ==> g uniformly_continuous_on s`, SIMP_TAC[uniformly_continuous_on; IMP_CONJ]);; let CONTINUOUS_ON_RESTRICT = prove (`!P f g:real^M->real^N s. (!x. x IN s ==> P x) ==> ((\x. if P x then f x else g x) continuous_on s <=> f continuous_on s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN ASM_MESON_TAC[]);; let UNIFORMLY_CONTINUOUS_ON_RESTRICT = prove (`!P f g:real^M->real^N s. (!x. x IN s ==> P x) ==> ((\x. if P x then f x else g x) uniformly_continuous_on s <=> f uniformly_continuous_on s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_EQ) THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_SING = prove (`!f:real^M->real^N a. f continuous_on {a}`, SIMP_TAC[continuous_on; IN_SING; FORALL_UNWIND_THM2; DIST_REFL] THEN MESON_TAC[]);; let CONTINUOUS_ON_EMPTY = prove (`!f:real^M->real^N. f continuous_on {}`, MESON_TAC[CONTINUOUS_ON_SING; EMPTY_SUBSET; CONTINUOUS_ON_SUBSET]);; let CONTINUOUS_ON_NO_LIMPT = prove (`!f:real^M->real^N s. ~(?x. x limit_point_of s) ==> f continuous_on s`, REWRITE_TAC[continuous_on; LIMPT_APPROACHABLE] THEN MESON_TAC[DIST_REFL]);; let CONTINUOUS_ON_FINITE = prove (`!f:real^M->real^N s. FINITE s ==> f continuous_on s`, MESON_TAC[CONTINUOUS_ON_NO_LIMPT; LIMIT_POINT_FINITE]);; let CONTRACTION_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N. (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(x,y)) ==> f continuous_on s`, SIMP_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);; let ISOMETRY_ON_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N. (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) ==> f continuous_on s`, SIMP_TAC[CONTRACTION_IMP_CONTINUOUS_ON; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Characterization of limits and continuity in terms of sequences. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_SEQUENTIALLY = prove (`!f s a:real^N. f continuous (at a within s) <=> !x. (!n. x(n) IN s) /\ (x --> a) sequentially ==> ((f o x) --> f(a)) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH; REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`; REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]);; let CONTINUOUS_AT_SEQUENTIALLY = prove (`!f a:real^N. f continuous (at a) <=> !x. (x --> a) sequentially ==> ((f o x) --> f(a)) sequentially`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_UNIV]);; let CONTINUOUS_ON_SEQUENTIALLY = prove (`!f s:real^N->bool. f continuous_on s <=> !x a. a IN s /\ (!n. x(n) IN s) /\ (x --> a) sequentially ==> ((f o x) --> f(a)) sequentially`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; let UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY, UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT = (CONJ_PAIR o prove) (`(!f:real^M->real^N s. f uniformly_continuous_on s <=> !x y. (!n. x n IN s) /\ (!n. y n IN s) /\ ((\n. x n - y n) --> vec 0) sequentially ==> ((\n. f(x(n)) - f(y(n))) --> vec 0) sequentially) /\ (!f:real^M->real^N s. f uniformly_continuous_on s <=> !e x y. &0 < e /\ (!n. x n IN s) /\ (!n. y n IN s) /\ ((\n. x n - y n) --> vec 0) sequentially ==> ?n. dist(f(x n),f(y n)) < e)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[uniformly_continuous_on; LIM_SEQUENTIALLY; dist] THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN MESON_TAC[]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`e:real`; `x:num->real^M`; `y:num->real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:num->real^M`; `y:num->real^M`]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[NORM_ARITH `dist(x - y:real^N,vec 0) = dist(x,y)`] THEN MESON_TAC[LE_REFL]; REWRITE_TAC[uniformly_continuous_on] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> ~r ==> ~p`] THEN DISCH_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^M` THEN REWRITE_TAC[AND_FORALL_THM; REAL_NOT_LT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[NORM_ARITH `dist(x - y:real^N,vec 0) = dist(y,x)`] THEN TRANS_TAC REAL_LTE_TRANS `inv(&m + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; let [LIM_WITHIN_SEQUENTIALLY; LIM_WITHIN_SEQUENTIALLY_INJ; LIM_WITHIN_SEQUENTIALLY_DECREASING] = (CONJUNCTS o prove) (`(!f:real^M->real^N s a l. (f --> l) (at a within s) <=> !x. (!n. x(n) IN s DELETE a) /\ (x --> a) sequentially ==> ((f o x) --> l) sequentially) /\ (!f:real^M->real^N s a l. (f --> l) (at a within s) <=> !x. (!n. x(n) IN s DELETE a) /\ (!m n. x m = x n <=> m = n) /\ (x --> a) sequentially ==> ((f o x) --> l) sequentially) /\ (!f:real^M->real^N s a l. (f --> l) (at a within s) <=> !x. (!n. x(n) IN s DELETE a) /\ (!m n. m < n ==> dist(x n,a) < dist(x m,a)) /\ (x --> a) sequentially ==> ((f o x) --> l) sequentially)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> s) /\ (q ==> r) /\ (p ==> q) /\ (s ==> p) ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:num->real^M` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_REFL]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:num->real^M` THEN MESON_TAC[]; SIMP_TAC[LIM_WITHIN; LIM_SEQUENTIALLY; GSYM DIST_NZ; o_THM; IN_DELETE] THEN MESON_TAC[]; DISCH_TAC THEN REWRITE_TAC[LIM_WITHIN] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN PURE_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC; REAL_NOT_LT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(!x. P x ==> Q x) ==> (R ==> (?x. P x /\ ~Q x)) ==> R ==> F`)) THEN DISCH_TAC THEN SUBGOAL_THEN `?x. (!n. (x n) IN s /\ ~(x n = a) /\ e <= dist((f:real^M->real^N)(x n),l) /\ dist(x n,a) < inv(&n + &1)) /\ (!n. dist(x(SUC n),a) < dist(x n,a))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_01; DIST_NZ]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN STRIP_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC; GSYM REAL_LT_MIN] THEN REWRITE_TAC[DIST_NZ] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ q /\ s /\ r`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; GSYM DIST_NZ] THEN REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^M` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_DELETE] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `N:num` THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LTE_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; REWRITE_TAC[LIM_SEQUENTIALLY; NOT_FORALL_THM] THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT; o_DEF] THEN MESON_TAC[LE_REFL]]]]);; let LIM_AT_SEQUENTIALLY = prove (`!f:real^M->real^N a l. (f --> l) (at a) <=> !x. (!n. ~(x(n) = a)) /\ (x --> a) sequentially ==> ((f o x) --> l) sequentially`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_SEQUENTIALLY; IN_UNIV; IN_DELETE]);; let CONTINUOUS_WITHIN_SEQUENTIALLY_INJ, CONTINUOUS_WITHIN_SEQUENTIALLY_ALT = (CONJ_PAIR o prove) (`(!f:real^M->real^N s a. f continuous at a within s <=> !x. (!n. x n IN s DELETE a) /\ (!m n. x m = x n <=> m = n) /\ (x --> a) sequentially ==> (f o x --> f a) sequentially) /\ (!f:real^M->real^N s a. (f continuous at a within s) <=> !e x. &0 < e /\ (!n. x n IN s DELETE a) /\ (x --> a) sequentially /\ (!m n. x m = x n <=> m = n) ==> ?n. dist(f(x n),f a) < e)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (~p ==> ~r) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_DELETE]; ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:num->real^M` THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_DEF] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[continuous_within; IN_DELETE] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM; REAL_NOT_LT; TAUT `~(p /\ q) <=> p ==> ~q`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?x. (!n. x n IN s /\ ~(x n = a) /\ dist(x n,a) < inv(&n + &1) /\ e <= dist((f:real^M->real^N) (x n),f a)) /\ (!n. dist(x(SUC n),a) < dist(x n,a))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01]; MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (inv(&(SUC n) + &1)) (dist(x:real^M,a))`)] THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; GSYM DIST_NZ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIST_REFL; REAL_NOT_LT]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!m n. m <= n ==> dist((x:num->real^M) n,a) <= dist(x m,a)` (fun th -> ASM_MESON_TAC[REAL_LET_TRANS; th]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REAL_ARITH_TAC; MATCH_MP_TAC WLOG_LT THEN SUBGOAL_THEN `!m n. m < n ==> dist((x:num->real^M) n,a) < dist(x m,a)` (fun th -> MESON_TAC[th; REAL_LT_REFL]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]);; let CONTINUOUS_AT_SEQUENTIALLY_ALT = prove (`!f:real^M->real^N a. (f continuous at a) <=> !e x. &0 < e /\ (!n. ~(x n = a)) /\ (x --> a) sequentially /\ (!m n. x m = x n <=> m = n) ==> ?n. dist(f(x n),f a) < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_ALT; IN_DELETE; IN_UNIV]);; let CONTINUOUS_AT_SEQUENTIALLY_INJ = prove (`!f:real^M->real^N a. f continuous at a <=> !x. (!n. ~(x n = a)) /\ (!m n. x m = x n <=> m = n) /\ (x --> a) sequentially ==> (f o x --> f a) sequentially`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_INJ; IN_DELETE; IN_UNIV]);; let LIM_CONTINUOUS = prove (`!net f:A->real^N l. f continuous net /\ f(netlimit net) = l ==> (f --> l) net`, MESON_TAC[continuous]);; let LIM_CONTINUOUS_FUNCTION = prove (`!f net g l. f continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) --> f l) net`, REWRITE_TAC[tendsto; continuous_at; eventually] THEN MESON_TAC[]);; let LIM_CONTINUOUS_FUNCTION_WITHIN = prove (`!net f:real^M->real^N g:A->real^M l s. f continuous (at l within s) /\ (g --> l) net /\ eventually (\a. g a IN s) net ==> ((\x. f (g x)) --> f l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; continuous_within] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] `(!x. P x ==> Q x) /\ R ==> !x. P x ==> Q x /\ R`)) THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN REWRITE_TAC[eventually] THEN ASM_MESON_TAC[]);; let LIMIT_POINT_OF_IMAGE_GEN = prove (`!f:real^M->real^N s u x. x limit_point_of s /\ f continuous (at x within s) /\ open u /\ x IN u /\ FINITE {z | z IN s INTER u /\ f z = f x} ==> (f x) limit_point_of (IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_SEQUENTIAL_INJ]) THEN REWRITE_TAC[IN_DELETE; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:num->real^M` THEN STRIP_TAC THEN MP_TAC(SPEC `{n:num | p n IN u /\ ~((f:real^M->real^N)(p n) = f x)}` INFINITE_ENUMERATE_WEAK) THEN REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `{x | P x /\ ~Q x} = {x | P x} DIFF {x | P x /\ Q x}`] THEN MATCH_MP_TAC INFINITE_DIFF_FINITE THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{x | P x} = UNIV DIFF {x | ~P x}`] THEN MATCH_MP_TAC INFINITE_DIFF_FINITE THEN REWRITE_TAC[num_INFINITE] THEN FIRST_ASSUM(MP_TAC o SPEC `u:real^M->bool` o REWRITE_RULE[TENDSTO_ALT]) THEN ASM_REWRITE_TAC[EVENTUALLY_IN_SEQUENTIALLY]; SUBGOAL_THEN `{n:num | p n IN u /\ (f:real^M->real^N)(p n) = f x} = {n | p n IN {z | z IN s INTER u /\ f z = f x}}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC FINITE_FINITE_PREIMAGE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[FINITE_SUBSET; FINITE_SING] `(?a. s SUBSET {a}) ==> FINITE s`) THEN ASM SET_TAC[]]; DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIMPT_SEQUENTIAL] THEN EXISTS_TAC `(f:real^M->real^N) o p o (r:num->num)` THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_WITHIN_SEQUENTIALLY]) THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; o_THM]]);; let LIMIT_POINT_OF_IMAGE = prove (`!f:real^M->real^N s x. x limit_point_of s /\ f continuous (at x within s) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (f x) limit_point_of (IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIMIT_POINT_OF_IMAGE_GEN THEN EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV] THEN MATCH_MP_TAC(MESON[FINITE_SUBSET; FINITE_SING] `(?a. s SUBSET {a}) ==> FINITE s`) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A continuous function distributes over nested compact intersection. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_IMAGE_NESTED_INTERS = prove (`!f:real^M->real^N s. f continuous_on s 0 /\ (!n. compact(s n)) /\ (!n. s(SUC n) SUBSET s n) ==> IMAGE f (INTERS {s n | n IN (:num)}) = INTERS {IMAGE f (s n) | n IN (:num)}`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[INTERS_GSPEC; IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `compact(s 0:real^M->bool)` MP_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[compact]] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN SUBGOAL_THEN `!m n. m <= n ==> (s:num->real^M->bool) n SUBSET s m` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. (x:num->real^M) n IN s 0` ASSUME_TAC THENL [ASM_MESON_TAC[LE_0; SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF; LIM_CONST]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_SEQUENTIALLY]) THEN ASM_REWRITE_TAC[o_THM]; X_GEN_TAC `n:num` THEN SUBGOAL_THEN `closed((s:num->real^M->bool) n)` MP_TAC THENL [ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS]] THEN DISCH_THEN MATCH_MP_TAC THEN EXISTS_TAC `(x:num->real^M) o (r:num->num) o (\i. n + i)` THEN ASM_SIMP_TAC[o_ASSOC; LIM_SUBSEQUENCE; LT_ADD_LCANCEL] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN EXISTS_TAC `(s:num->real^M->bool)(r(n + m:num))` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(ARITH_RULE `n + m:num <= r(n + m) ==> n <= r(n + m)`) THEN ASM_MESON_TAC[MONOTONE_BIGGER]]);; let CONTINUOUS_IMAGE_NESTED_INTERS_GEN = prove (`!f:real^M->real^N s m. f continuous_on s m /\ (!n. m <= n ==> compact(s n)) /\ (!n. m <= n ==> s(SUC n) SUBSET s n) ==> IMAGE f (INTERS {s n | m <= n}) = INTERS {IMAGE f (s n) | m <= n}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(s:num->real^M->bool) o (\i. m + i)`] CONTINUOUS_IMAGE_NESTED_INTERS) THEN ASM_SIMP_TAC[o_THM; ADD_CLAUSES; LE_ADD] THEN SUBGOAL_THEN `!n. m <= n <=> n IN IMAGE (\i. m + i) (:num)` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[LE_ADD; LE_EXISTS]; REWRITE_TAC[INTERS_GSPEC; FORALL_IN_IMAGE]]);; (* ------------------------------------------------------------------------- *) (* Combination results for pointwise continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_CONST = prove (`!net c. (\x. c) continuous net`, REWRITE_TAC[continuous; LIM_CONST]);; let CONTINUOUS_CMUL = prove (`!f c net. f continuous net ==> (\x. c % f(x)) continuous net`, REWRITE_TAC[continuous; LIM_CMUL]);; let CONTINUOUS_NEG = prove (`!f net. f continuous net ==> (\x. --(f x)) continuous net`, REWRITE_TAC[continuous; LIM_NEG]);; let CONTINUOUS_ADD = prove (`!f g net. f continuous net /\ g continuous net ==> (\x. f(x) + g(x)) continuous net`, REWRITE_TAC[continuous; LIM_ADD]);; let CONTINUOUS_SUB = prove (`!f g net. f continuous net /\ g continuous net ==> (\x. f(x) - g(x)) continuous net`, REWRITE_TAC[continuous; LIM_SUB]);; let CONTINUOUS_ABS = prove (`!(f:A->real^N) net. f continuous net ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous net`, REWRITE_TAC[continuous; LIM_ABS]);; let CONTINUOUS_LIFT_ABS_COMPONENT = prove (`!net:(A)net f:A->real^N k. f continuous net ==> (\x. lift(abs(f x$k))) continuous net`, REWRITE_TAC[continuous; LIM_LIFT_ABS_COMPONENT]);; let CONTINUOUS_LIFT_ABS = prove (`!net:(A)net f. (\x. lift(f x)) continuous net ==> (\x. lift(abs(f x))) continuous net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ABS) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);; let CONTINUOUS_MAX = prove (`!(f:A->real^N) (g:A->real^N) net. f continuous net /\ g continuous net ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous net`, REWRITE_TAC[continuous; LIM_MAX]);; let CONTINUOUS_MIN = prove (`!(f:A->real^N) (g:A->real^N) net. f continuous net /\ g continuous net ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous net`, REWRITE_TAC[continuous; LIM_MIN]);; let CONTINUOUS_MAX_1 = prove (`!net:A net f g. (\x. lift(f x)) continuous net /\ (\x. lift(g x)) continuous net ==> (\x. lift(max (f x) (g x))) continuous net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_MAX) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);; let CONTINUOUS_MIN_1 = prove (`!net:A net f g. (\x. lift(f x)) continuous net /\ (\x. lift(g x)) continuous net ==> (\x. lift(min (f x) (g x))) continuous net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_MIN) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);; let CONTINUOUS_VSUM = prove (`!net f s. FINITE s /\ (!a. a IN s ==> (f a) continuous net) ==> (\x. vsum s (\a. f a x)) continuous net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; CONTINUOUS_CONST; CONTINUOUS_ADD; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Same thing for setwise continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_CONST = prove (`!s c. (\x. c) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CONST]);; let CONTINUOUS_ON_CMUL = prove (`!f c s. f continuous_on s ==> (\x. c % f(x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CMUL]);; let CONTINUOUS_ON_NEG = prove (`!f s. f continuous_on s ==> (\x. --(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_NEG]);; let CONTINUOUS_ON_ADD = prove (`!f g s. f continuous_on s /\ g continuous_on s ==> (\x. f(x) + g(x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ADD]);; let CONTINUOUS_ON_SUB = prove (`!f g s. f continuous_on s /\ g continuous_on s ==> (\x. f(x) - g(x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SUB]);; let CONTINUOUS_ON_LIFT_ABS_COMPONENT = prove (`!f:real^M->real^N s. f continuous_on s ==> (\x. lift(abs(f x$k))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_ABS_COMPONENT]);; let CONTINUOUS_ON_LIFT_ABS = prove (`!f s:real^N->bool. (\x. lift(f x)) continuous_on s ==> (\x. lift(abs(f x))) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_ABS THEN ASM_SIMP_TAC[]);; let CONTINUOUS_ON_ABS = prove (`!f:real^M->real^N s. f continuous_on s ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ABS]);; let CONTINUOUS_ON_MAX = prove (`!f:real^M->real^N g:real^M->real^N s. f continuous_on s /\ g continuous_on s ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MAX]);; let CONTINUOUS_ON_MIN = prove (`!f:real^M->real^N g:real^M->real^N s. f continuous_on s /\ g continuous_on s ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MIN]);; let CONTINUOUS_ON_MAX_1 = prove (`!f:real^N->real g s. (\x. lift(f x)) continuous_on s /\ (\x. lift(g x)) continuous_on s ==> (\x. lift(max (f x) (g x))) continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);; let CONTINUOUS_ON_MIN_1 = prove (`!f:real^N->real g s. (\x. lift(f x)) continuous_on s /\ (\x. lift(g x)) continuous_on s ==> (\x. lift(min (f x) (g x))) continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);; let CONTINUOUS_ON_VSUM = prove (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) continuous_on t) ==> (\x. vsum s (\a. f a x)) continuous_on t`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_VSUM]);; let CONTINUOUS_ON_REFLECT = prove (`!f:real^M->real^N s. (\x. f(--x)) continuous_on (IMAGE (--) s) <=> f continuous_on s`, REWRITE_TAC[continuous_on; FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMP_CONJ] THEN REWRITE_TAC[VECTOR_NEG_NEG; NORM_ARITH `dist(--x:real^N,--y) = dist(x,y)`]);; (* ------------------------------------------------------------------------- *) (* Same thing for uniform continuity, using sequential formulations. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_ON_CONST = prove (`!s c. (\x. c) uniformly_continuous_on s`, REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF; VECTOR_SUB_REFL; LIM_CONST]);; let LINEAR_UNIFORMLY_CONTINUOUS_ON = prove (`!f:real^M->real^N s. linear f ==> f uniformly_continuous_on s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[uniformly_continuous_on; dist; GSYM LINEAR_SUB] THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(y - x:real^M)` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_RDIV_EQ; REAL_MUL_SYM]);; let UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on (IMAGE f s) ==> (g o f) uniformly_continuous_on s`, let lemma = prove (`(!y. ((?x. (y = f x) /\ P x) /\ Q y ==> R y)) <=> (!x. P x /\ Q (f x) ==> R (f x))`, MESON_TAC[]) in REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; o_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove (`!f:real^M->real^N g (h:real^N->real^P->real^Q) s. f uniformly_continuous_on s /\ g uniformly_continuous_on s /\ bilinear h /\ bounded(IMAGE f s) /\ bounded(IMAGE g s) ==> (\x. h (f x) (g x)) uniformly_continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; dist] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `!a b c d. (h:real^N->real^P->real^Q) a b - h c d = h (a - c) b + h c (b - d)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_LSUB th]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_RSUB th]) THEN VECTOR_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN UNDISCH_TAC `bounded(IMAGE (g:real^M->real^P) s)` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(g:real^M->real^P) uniformly_continuous_on s` THEN UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on s` THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B1`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`])) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * e / &2 / &2 / B / B2 * B2 + B * B1 * e / &2 / &2 / B / B1` THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `norm(x) <= a /\ norm(y) <= b ==> norm(x + y:real^N) <= a + b`) THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN ASM_REAL_ARITH_TAC]);; let UNIFORMLY_CONTINUOUS_ON_MUL = prove (`!f g:real^M->real^N s. (lift o f) uniformly_continuous_on s /\ g uniformly_continuous_on s /\ bounded(IMAGE (lift o f) s) /\ bounded(IMAGE g s) ==> (\x. f x % g x) uniformly_continuous_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o (f:real^M->real)`; `g:real^M->real^N`; `\c (v:real^N). drop c % v`; `s:real^M->bool`] BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; let UNIFORMLY_CONTINUOUS_ON_CMUL = prove (`!f c s. f uniformly_continuous_on s ==> (\x. c % f(x)) uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL) THEN ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_RZERO]);; let UNIFORMLY_CONTINUOUS_ON_VMUL = prove (`!s:real^M->bool c v:real^N. (lift o c) uniformly_continuous_on s ==> (\x. c x % v) uniformly_continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o ISPEC `\x. (drop x % v:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LINEAR_UNIFORMLY_CONTINUOUS_ON THEN MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]);; let UNIFORMLY_CONTINUOUS_ON_NEG = prove (`!f s. f uniformly_continuous_on s ==> (\x. --(f x)) uniformly_continuous_on s`, ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_CMUL]);; let UNIFORMLY_CONTINUOUS_ON_ADD = prove (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s ==> (\x. f(x) + g(x)) uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN REWRITE_TAC[AND_FORALL_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[VECTOR_ADD_LID] THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; let UNIFORMLY_CONTINUOUS_ON_SUB = prove (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s ==> (\x. f(x) - g(x)) uniformly_continuous_on s`, REWRITE_TAC[VECTOR_SUB] THEN SIMP_TAC[UNIFORMLY_CONTINUOUS_ON_NEG; UNIFORMLY_CONTINUOUS_ON_ADD]);; let UNIFORMLY_CONTINUOUS_ON_VSUM = prove (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) uniformly_continuous_on t) ==> (\x. vsum s (\a. f a x)) uniformly_continuous_on t`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; UNIFORMLY_CONTINUOUS_ON_CONST; UNIFORMLY_CONTINUOUS_ON_ADD; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Identity function is continuous in every sense. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_ID = prove (`!a s. (\x. x) continuous (at a within s)`, REWRITE_TAC[continuous_within] THEN MESON_TAC[]);; let CONTINUOUS_AT_ID = prove (`!a. (\x. x) continuous (at a)`, REWRITE_TAC[continuous_at] THEN MESON_TAC[]);; let CONTINUOUS_ON_ID = prove (`!s. (\x. x) continuous_on s`, REWRITE_TAC[continuous_on] THEN MESON_TAC[]);; let UNIFORMLY_CONTINUOUS_ON_ID = prove (`!s. (\x. x) uniformly_continuous_on s`, REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Continuity of all kinds is preserved under composition. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_COMPOSE = prove (`!f g x s. f continuous (at x within s) /\ g continuous (at (f x) within IMAGE f s) ==> (g o f) continuous (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let CONTINUOUS_AT_COMPOSE = prove (`!f g x. f continuous (at x) /\ g continuous (at (f x)) ==> (g o f) continuous (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[CONTINUOUS_WITHIN_COMPOSE; IN_IMAGE; CONTINUOUS_WITHIN_SUBSET; SUBSET_UNIV; IN_UNIV]);; let CONTINUOUS_ON_COMPOSE = prove (`!f g s. f continuous_on s /\ g continuous_on (IMAGE f s) ==> (g o f) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN MESON_TAC[IN_IMAGE; CONTINUOUS_WITHIN_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Continuity in terms of open preimages. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_OPEN = prove (`!f:real^M->real^N x u. f continuous (at x within u) <=> !t. open t /\ f(x) IN t ==> ?s. open s /\ x IN s /\ !x'. x' IN s /\ x' IN u ==> f(x') IN t`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [open_def] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; DIST_SYM]; DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; let CONTINUOUS_AT_OPEN = prove (`!f:real^M->real^N x. f continuous (at x) <=> !t. open t /\ f(x) IN t ==> ?s. open s /\ x IN s /\ !x'. x' IN s ==> f(x') IN t`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_at] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [open_def] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL]; DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; let CONTINUOUS_ON_OPEN_GEN = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> (f continuous_on s <=> !u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL [REWRITE_TAC[open_in; SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM SET_TAC[]; DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e) INTER t`) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_OPEN; INTER_COMM; OPEN_BALL]; ALL_TAC] THEN REWRITE_TAC[open_in; SUBSET; IN_INTER; IN_ELIM_THM; IN_BALL; IN_IMAGE] THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_MESON_TAC[DIST_REFL; DIST_SYM]]);; let CONTINUOUS_ON_OPEN = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. open_in (subtopology euclidean (IMAGE f s)) t ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_OPEN_GEN THEN REWRITE_TAC[SUBSET_REFL]);; let CONTINUOUS_OPEN_IN_PREIMAGE_GEN = prove (`!f:real^M->real^N s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, MESON_TAC[CONTINUOUS_ON_OPEN_GEN]);; let CONTINUOUS_ON_IMP_OPEN_IN = prove (`!f:real^M->real^N s t. f continuous_on s /\ open_in (subtopology euclidean (IMAGE f s)) t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, MESON_TAC[CONTINUOUS_ON_OPEN]);; let CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET = prove (`!f:real^M->real^N s t u v. f continuous_on s /\ IMAGE f s SUBSET t /\ open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean t) v ==> open_in (subtopology euclidean s) {x | x IN u /\ f x IN v}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Similarly in terms of closed sets. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_CLOSED_GEN = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> (f continuous_on s <=> !u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THENL [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let CONTINUOUS_ON_CLOSED = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. closed_in (subtopology euclidean (IMAGE f s)) t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSED_GEN THEN REWRITE_TAC[SUBSET_REFL]);; let CONTINUOUS_CLOSED_IN_PREIMAGE_GEN = prove (`!f:real^M->real^N s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, MESON_TAC[CONTINUOUS_ON_CLOSED_GEN]);; let CONTINUOUS_ON_IMP_CLOSED_IN = prove (`!f:real^M->real^N s t. f continuous_on s /\ closed_in (subtopology euclidean (IMAGE f s)) t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, MESON_TAC[CONTINUOUS_ON_CLOSED]);; let CONTINUOUS_CLOSED_IN_PREIMAGE_SUBSET = prove (`!f:real^M->real^N s t u v. f continuous_on s /\ IMAGE f s SUBSET t /\ closed_in (subtopology euclidean s) u /\ closed_in (subtopology euclidean t) v ==> closed_in (subtopology euclidean s) {x | x IN u /\ f x IN v}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Half-global and completely global cases. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_OPEN_IN_PREIMAGE = prove (`!f s t. f continuous_on s /\ open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_OPEN]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_CLOSED_IN_PREIMAGE = prove (`!f s t. f continuous_on s /\ closed t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_CLOSED]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_OPEN_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ open s /\ open t ==> open {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN REWRITE_TAC [OPEN_IN_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN ANTS_TAC THENL [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = s INTER t'` SUBST1_TAC THENL [ASM SET_TAC []; ASM_MESON_TAC [OPEN_INTER]]]);; let CONTINUOUS_CLOSED_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ closed s /\ closed t ==> closed {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_CLOSED]) THEN REWRITE_TAC [CLOSED_IN_CLOSED] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN ANTS_TAC THENL [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = s INTER t'` SUBST1_TAC THENL [ASM SET_TAC []; ASM_MESON_TAC [CLOSED_INTER]]]);; let CONTINUOUS_OPEN_PREIMAGE_UNIV = prove (`!f:real^M->real^N s. (!x. f continuous (at x)) /\ open s ==> open {x | f(x) IN s}`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] CONTINUOUS_OPEN_PREIMAGE) THEN ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; let CONTINUOUS_CLOSED_PREIMAGE_UNIV = prove (`!f:real^M->real^N s. (!x. f continuous (at x)) /\ closed s ==> closed {x | f(x) IN s}`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] CONTINUOUS_CLOSED_PREIMAGE) THEN ASM_SIMP_TAC[CLOSED_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; let CONTINUOUS_OPEN_IN_PREIMAGE_EQ = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_OPEN_IN_PREIMAGE] THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; let CONTINUOUS_CLOSED_IN_PREIMAGE_EQ = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. closed t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE] THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [CLOSED_IN_CLOSED] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; let TOPCONTINUOUS_EQ_CONTINUOUS_ON = prove (`!f:real^N->real^M. topcontinuous (subtopology euclidean s) euclidean f <=> f continuous_on s`, GEN_TAC THEN REWRITE_TAC[topcontinuous; CONTINUOUS_OPEN_IN_PREIMAGE_EQ; TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN; GSYM OPEN_IN; IN_UNIV; IN_INTER]);; let RESTRICTION_CONTINUOUS_ON = prove (`!s t f:real^M->real^N. s SUBSET t ==> (RESTRICTION t f continuous_on s <=> f continuous_on s)`, INTRO_TAC "!s t f; sub" THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN SUBGOAL_THEN `!u. {x:real^M | x IN s /\ RESTRICTION t f x:real^N IN u} = {x | x IN s /\ f x IN u}` (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[RESTRICTION] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Linear functions are (uniformly) continuous on any set. *) (* ------------------------------------------------------------------------- *) let LINEAR_LIM_0 = prove (`!f. linear f ==> (f --> vec 0) (at (vec 0))`, REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN ASM_MESON_TAC[REAL_MUL_SYM; REAL_LET_TRANS; REAL_LT_RDIV_EQ]);; let LINEAR_CONTINUOUS_AT = prove (`!f:real^M->real^N a. linear f ==> f continuous (at a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\x. (f:real^M->real^N) (a + x) - f(a)` LINEAR_LIM_0) THEN ANTS_TAC THENL [POP_ASSUM MP_TAC THEN SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM LIM_NULL; CONTINUOUS_AT] THEN GEN_REWRITE_TAC RAND_CONV [LIM_AT_ZERO] THEN SIMP_TAC[]);; let LINEAR_CONTINUOUS_WITHIN = prove (`!f:real^M->real^N s x. linear f ==> f continuous (at x within s)`, SIMP_TAC[CONTINUOUS_AT_WITHIN; LINEAR_CONTINUOUS_AT]);; let LINEAR_CONTINUOUS_ON = prove (`!f:real^M->real^N s. linear f ==> f continuous_on s`, MESON_TAC[LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; let LINEAR_CONTINUOUS_COMPOSE = prove (`!net f:A->real^N g:real^N->real^P. f continuous net /\ linear g ==> (\x. g(f x)) continuous net`, REWRITE_TAC[continuous; LIM_LINEAR]);; let LINEAR_CONTINUOUS_ON_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s. f continuous_on s /\ linear g ==> (\x. g(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; LINEAR_CONTINUOUS_COMPOSE]);; let CONTINUOUS_LIFT_COMPONENT_COMPOSE = prove (`!net f:A->real^N i. f continuous net ==> (\x. lift(f x$i)) continuous net`, REPEAT GEN_TAC THEN SUBGOAL_THEN `linear(\x:real^N. lift (x$i))` MP_TAC THENL [REWRITE_TAC[LINEAR_LIFT_COMPONENT]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN REWRITE_TAC[LINEAR_CONTINUOUS_COMPOSE]);; let CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE = prove (`!f:real^M->real^N s. f continuous_on s ==> (\x. lift (f x$i)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_COMPONENT_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Also bilinear functions, in composition form. *) (* ------------------------------------------------------------------------- *) let BILINEAR_CONTINUOUS_COMPOSE = prove (`!net f:A->real^M g:A->real^N h:real^M->real^N->real^P. f continuous net /\ g continuous net /\ bilinear h ==> (\x. h (f x) (g x)) continuous net`, REWRITE_TAC[continuous; LIM_BILINEAR]);; let BILINEAR_CONTINUOUS_ON_COMPOSE = prove (`!f g h s. f continuous_on s /\ g continuous_on s /\ bilinear h ==> (\x. h (f x) (g x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; BILINEAR_CONTINUOUS_COMPOSE]);; let BILINEAR_CONTINUOUS_ON = prove (`!bop:real^M->real^N->real^P. bilinear bop ==> (\z. bop (fstcart z) (sndcart z)) continuous_on UNIV`, SIMP_TAC[BILINEAR_CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]);; let BILINEAR_DOT = prove (`bilinear (\x y:real^N. lift(x dot y))`, REWRITE_TAC[bilinear; linear; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);; let CONTINUOUS_LIFT_DOT2 = prove (`!net f g:A->real^N. f continuous net /\ g continuous net ==> (\x. lift(f x dot g x)) continuous net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; let CONTINUOUS_ON_LIFT_DOT2 = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on s ==> (\x. lift(f x dot g x)) continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Preservation of compactness and connectedness under continuous function. *) (* ------------------------------------------------------------------------- *) let COMPACT_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ compact s ==> compact(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; compact] THEN STRIP_TAC THEN X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN DISCH_THEN(X_CHOOSE_THEN `l:real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) l` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o SPEC `l:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; let COMPACT_TRANSLATION = prove (`!s a:real^N. compact s ==> compact (IMAGE (\x. a + x) s)`, SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; let COMPACT_TRANSLATION_EQ = prove (`!a s. compact (IMAGE (\x:real^N. a + x) s) <=> compact s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COMPACT_TRANSLATION] THEN DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP COMPACT_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; add_translation_invariants [COMPACT_TRANSLATION_EQ];; let COMPACT_LINEAR_IMAGE = prove (`!f:real^M->real^N s. compact s /\ linear f ==> compact(IMAGE f s)`, SIMP_TAC[LINEAR_CONTINUOUS_ON; COMPACT_CONTINUOUS_IMAGE]);; let COMPACT_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (compact (IMAGE f s) <=> compact s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COMPACT_LINEAR_IMAGE));; add_linear_invariants [COMPACT_LINEAR_IMAGE_EQ];; let CONNECTED_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ connected s ==> connected(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[CONNECTED_CLOPEN; NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `t:real^N->bool` th) THEN MP_TAC(SPEC `IMAGE (f:real^M->real^N) s DIFF t` th)) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN IMAGE f s DIFF t} = s DIFF {x | x IN s /\ f x IN t}` SUBST1_TAC THENL [UNDISCH_TAC `t SUBSET IMAGE (f:real^M->real^N) s` THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_ELIM_THM; SUBSET] THEN MESON_TAC[]; REPEAT STRIP_TAC THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN t}` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[IN_IMAGE; SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; EXTENSION] THEN MESON_TAC[]]);; let CONNECTED_TRANSLATION = prove (`!a s. connected s ==> connected (IMAGE (\x:real^N. a + x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; let CONNECTED_TRANSLATION_EQ = prove (`!a s. connected (IMAGE (\x:real^N. a + x) s) <=> connected s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_TRANSLATION] THEN DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP CONNECTED_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; add_translation_invariants [CONNECTED_TRANSLATION_EQ];; let CONNECTED_LINEAR_IMAGE = prove (`!f:real^M->real^N s. connected s /\ linear f ==> connected(IMAGE f s)`, SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CONTINUOUS_IMAGE]);; let CONNECTED_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (connected (IMAGE f s) <=> connected s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONNECTED_LINEAR_IMAGE));; add_linear_invariants [CONNECTED_LINEAR_IMAGE_EQ];; (* ------------------------------------------------------------------------- *) (* Preservation properties for pasted sets (Cartesian products). *) (* ------------------------------------------------------------------------- *) let BOUNDED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. bounded (s PCROSS t) <=> s = {} \/ t = {} \/ bounded s /\ bounded t`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; BOUNDED_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[bounded; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS; NORM_PASTECART_LE; REAL_LE_ADD2]);; let BOUNDED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. bounded s /\ bounded t ==> bounded (s PCROSS t)`, SIMP_TAC[BOUNDED_PCROSS_EQ]);; let CLOSED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. closed (s PCROSS t) <=> s = {} \/ t = {} \/ closed s /\ closed t`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN MAP_EVERY ASM_CASES_TAC [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; CLOSED_EMPTY; SET_RULE `{f x y |x,y| F} = {}`] THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; LIM_SEQUENTIALLY] THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[IN_ELIM_THM; SKOLEM_THM; FORALL_AND_THM] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[TAUT `((p /\ q) /\ r) /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN ONCE_REWRITE_TAC[MESON[] `(!a b c d e. P a b c d e) <=> (!d e b c a. P a b c d e)`] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; FORALL_AND_THM] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM]] THEN MATCH_MP_TAC MONO_FORALL THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(MESON[] `(?x. P x (\n. x)) ==> (?s x. P x s)`) THEN ASM_MESON_TAC[DIST_PASTECART_CANCEL]; ONCE_REWRITE_TAC[MESON[] `(!x l. P x l) /\ (!y m. Q y m) <=> (!x y l m. P x l /\ Q y m)`] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[dist; PASTECART_SUB] THEN ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]]);; let CLOSED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. closed s /\ closed t ==> closed (s PCROSS t)`, SIMP_TAC[CLOSED_PCROSS_EQ]);; let COMPACT_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. compact (s PCROSS t) <=> s = {} \/ t = {} \/ compact s /\ compact t`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_PCROSS_EQ; BOUNDED_PCROSS_EQ] THEN MESON_TAC[]);; let COMPACT_PCROSS = prove (`!s:real^M->bool t:real^N->bool. compact s /\ compact t ==> compact (s PCROSS t)`, SIMP_TAC[COMPACT_PCROSS_EQ]);; let OPEN_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. open (s PCROSS t) <=> s = {} \/ t = {} \/ open s /\ open t`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; OPEN_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL [REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[DIST_PASTECART_CANCEL]; REWRITE_TAC[OPEN_CLOSED] THEN STRIP_TAC THEN SUBGOAL_THEN `UNIV DIFF {pastecart x y | x IN s /\ y IN t} = {pastecart x y | x IN ((:real^M) DIFF s) /\ y IN (:real^N)} UNION {pastecart x y | x IN (:real^M) /\ y IN ((:real^N) DIFF t)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; FORALL_PASTECART; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]; SIMP_TAC[GSYM PCROSS] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_PCROSS THEN ASM_REWRITE_TAC[CLOSED_UNIV]]]);; let OPEN_PCROSS = prove (`!s:real^M->bool t:real^N->bool. open s /\ open t ==> open (s PCROSS t)`, SIMP_TAC[OPEN_PCROSS_EQ]);; let OPEN_IN_PCROSS = prove (`!s s':real^M->bool t t':real^N->bool. open_in (subtopology euclidean s) s' /\ open_in (subtopology euclidean t) t' ==> open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN ASM_SIMP_TAC[OPEN_PCROSS; EXTENSION; FORALL_PASTECART] THEN REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; let PASTECART_IN_INTERIOR_SUBTOPOLOGY = prove (`!s t u x:real^M y:real^N. pastecart x y IN u /\ open_in (subtopology euclidean (s PCROSS t)) u ==> ?v w. open_in (subtopology euclidean s) v /\ x IN v /\ open_in (subtopology euclidean t) w /\ y IN w /\ (v PCROSS w) SUBSET u`, REWRITE_TAC[open_in; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^M,e / &2) INTER s` THEN EXISTS_TAC `ball(y:real^N,e / &2) INTER t` THEN SUBGOAL_THEN `(x:real^M) IN s /\ (y:real^N) IN t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; PASTECART_IN_PCROSS]; ALL_TAC] THEN ASM_SIMP_TAC[INTER_SUBSET; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN REWRITE_TAC[IN_BALL] THEN REPEAT(CONJ_TAC THENL [MESON_TAC[REAL_SUB_LT; NORM_ARITH `dist(x,y) < e /\ dist(z,y) < e - dist(x,y) ==> dist(x:real^N,z) < e`]; ALL_TAC]) THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_BALL; IN_INTER] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist)] THEN ASM_REAL_ARITH_TAC);; let PASTECART_IN_INTERIOR = prove (`!u x:real^M y:real^N. pastecart x y IN u /\ open u ==> ?v w. open v /\ x IN v /\ open w /\ y IN w /\ (v PCROSS w) SUBSET u`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[GSYM UNIV_PCROSS_UNIV; PASTECART_IN_INTERIOR_SUBTOPOLOGY]);; let OPEN_IN_PCROSS_EQ = prove (`!s s':real^M->bool t t':real^N->bool. open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> s' = {} \/ t' = {} \/ open_in (subtopology euclidean s) s' /\ open_in (subtopology euclidean t) t'`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s':real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN ASM_CASES_TAC `t':real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[OPEN_IN_PCROSS] THEN REPEAT STRIP_TAC THENL [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN UNDISCH_TAC `~(t':real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`); ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN UNDISCH_TAC `~(s':real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^M`)] THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`; `(s':real^M->bool) PCROSS (t':real^N->bool)`; `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN ASM_REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MESON_TAC[]);; let INTERIOR_PCROSS = prove (`!s:real^M->bool t:real^N->bool. interior (s PCROSS t) = (interior s) PCROSS (interior t)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`; `interior((s:real^M->bool) PCROSS (t:real^N->bool))`; `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN REWRITE_TAC[UNIV_PCROSS_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[INTERIOR_SUBSET; SUBSET_TRANS] `s SUBSET interior t ==> s SUBSET t`)) THEN REWRITE_TAC[SUBSET_PCROSS] THEN ASM_MESON_TAC[NOT_IN_EMPTY; INTERIOR_MAXIMAL; SUBSET]; MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[OPEN_PCROSS; OPEN_INTERIOR; PCROSS_MONO; INTERIOR_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Quotient maps are occasionally useful. *) (* ------------------------------------------------------------------------- *) let QUASICOMPACT_OPEN_CLOSED = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} ==> open_in (subtopology euclidean t) u)) <=> (!u. u SUBSET t ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} ==> closed_in (subtopology euclidean t) u)))`, SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN (ANTS_TAC THENL [SET_TAC[]; REPEAT STRIP_TAC]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_RESTRICT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `open_in top x ==> x = y ==> open_in top y`)) THEN ASM SET_TAC[]);; let QUOTIENT_MAP_IMP_CONTINUOUS_OPEN = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) ==> f continuous_on s`, MESON_TAC[OPEN_IN_IMP_SUBSET; CONTINUOUS_ON_OPEN_GEN]);; let QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> closed_in (subtopology euclidean t) u)) ==> f continuous_on s`, MESON_TAC[CLOSED_IN_IMP_SUBSET; CONTINUOUS_ON_CLOSED_GEN]);; let OPEN_MAP_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N s. f continuous_on s /\ (!t. open_in (subtopology euclidean s) t ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) ==> !t. t SUBSET IMAGE f s ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> open_in (subtopology euclidean (IMAGE f s)) t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `t = IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN t}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN ASM_SIMP_TAC[]]);; let CLOSED_MAP_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N s. f continuous_on s /\ (!t. closed_in (subtopology euclidean s) t ==> closed_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) ==> !t. t SUBSET IMAGE f s ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> open_in (subtopology euclidean (IMAGE f s)) t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF {x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN ANTS_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF THEN ASM_SIMP_TAC[CLOSED_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]; REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN ASM_SIMP_TAC[]]);; let CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ (!y. y IN t ==> f(g y) = y) ==> (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u))`, REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(IMAGE (g:real^N->real^M) t) INTER {x | x IN s /\ (f:real^M->real^N) x IN u}`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]; DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = t` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM SET_TAC[]]);; let CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on (IMAGE f s) /\ (!x. x IN s ==> g(f x) = x) ==> (!u. u SUBSET (IMAGE f s) ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean (IMAGE f s)) u))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let QUOTIENT_MAP_OPEN_CLOSED = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) <=> (!u. u SUBSET t ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> closed_in (subtopology euclidean t) u)))`, SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN (ANTS_TAC THENL [SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN REWRITE_TAC[SUBSET_RESTRICT] THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let CONTINUOUS_ON_COMPOSE_QUOTIENT = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ (!v. v SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean t) v)) /\ (g o f) continuous_on s ==> g continuous_on t`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN SUBGOAL_THEN `IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) s SUBSET u` (fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_TAC] THEN X_GEN_TAC `v:real^P->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN v}`) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `open_in top s ==> s = t ==> open_in top t`)) THEN ASM SET_TAC[]);; let LIFT_TO_QUOTIENT_SPACE = prove (`!f:real^M->real^N h:real^M->real^P s t u. IMAGE f s = t /\ (!v. v SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean t) v)) /\ h continuous_on s /\ IMAGE h s = u /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> h x = h y) ==> ?g. g continuous_on t /\ IMAGE g t = u /\ !x. x IN s ==> h(x) = g(f x)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[FUNCTION_FACTORS_LEFT_GEN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^P` THEN DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE_QUOTIENT THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`; `u:real^P->bool`] THEN ASM_SIMP_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_EQ)) THEN ASM_REWRITE_TAC[o_THM]);; let QUOTIENT_MAP_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ (!v. v SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean t) v)) /\ (!v. v SUBSET u ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=> open_in (subtopology euclidean u) v)) ==> !v. v SUBSET u ==> (open_in (subtopology euclidean s) {x | x IN s /\ (g o f) x IN v} <=> open_in (subtopology euclidean u) v)`, REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN SUBGOAL_THEN `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_RESTRICT]]);; let QUOTIENT_MAP_FROM_COMPOSITION = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!v. v SUBSET u ==> (open_in (subtopology euclidean s) {x | x IN s /\ (g o f) x IN v} <=> open_in (subtopology euclidean u) v)) ==> !v. v SUBSET u ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=> open_in (subtopology euclidean u) v)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SUBGOAL_THEN `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[]]);; let QUOTIENT_MAP_FROM_SUBSET = prove (`!f:real^M->real^N s t u. f continuous_on t /\ IMAGE f t SUBSET u /\ s SUBSET t /\ IMAGE f s = u /\ (!v. v SUBSET u ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean u) v)) ==> !v. v SUBSET u ==> (open_in (subtopology euclidean t) {x | x IN t /\ f x IN v} <=> open_in (subtopology euclidean u) v)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC QUOTIENT_MAP_FROM_COMPOSITION THEN MAP_EVERY EXISTS_TAC [`\x:real^M. x`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; o_THM]);; let QUOTIENT_MAP_RESTRICT = prove (`!f:real^M->real^N s t c. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) /\ (open_in (subtopology euclidean t) c \/ closed_in (subtopology euclidean t) c) ==> !u. u SUBSET c ==> (open_in (subtopology euclidean {x | x IN s /\ f x IN c}) {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u} <=> open_in (subtopology euclidean c) u)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC (MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN) th)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) {x | x IN s /\ f x IN c} SUBSET c` ASSUME_TAC THENL [SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET); ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN (MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_MP_TAC(MESON[] `t = s /\ (P s <=> Q s) ==> (P s <=> Q t)`) THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM]]; ALL_TAC]) THEN (EQ_TAC THENL [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) ORELSE MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_SUBSET_TRANS); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) ORELSE MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_TRANS)]) THEN (MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN ORELSE MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN ORELSE ASM_SIMP_TAC[]) THEN ASM SET_TAC[]);; let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ connected t ==> connected s`, REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN UNDISCH_TAC `connected(t:real^N->bool)` THEN SIMP_TAC[CONNECTED_OPEN_IN] THEN MAP_EVERY EXISTS_TAC [`IMAGE (f:real^M->real^N) (s INTER u)`; `IMAGE (f:real^M->real^N) (s INTER v)`] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) (s INTER u) INTER IMAGE f (s INTER v) = {}` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected]] THEN MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (rand o rand) th o snd)) THEN (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN MATCH_MP_TAC(MESON[] `{x | x IN s /\ f x IN IMAGE f u} = u /\ open_in top u ==> open_in top {x | x IN s /\ f x IN IMAGE f u}`) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN ASM SET_TAC[]);; let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN = prove (`!f:real^M->real^N s t c. IMAGE f s = t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ (open_in (subtopology euclidean t) c \/ closed_in (subtopology euclidean t) c) /\ connected c ==> connected {x | x IN s /\ f x IN c}`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] CONNECTED_MONOTONE_QUOTIENT_PREIMAGE)) THEN SUBGOAL_THEN `(c:real^N->bool) SUBSET t` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN EXISTS_TAC `f:real^M->real^N` THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN)) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN REWRITE_TAC[SUBSET_RESTRICT]; ASM SET_TAC[]; MATCH_MP_TAC QUOTIENT_MAP_RESTRICT THEN ASM_MESON_TAC[SUBSET_REFL]; X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* More properties of open and closed maps. *) (* ------------------------------------------------------------------------- *) let CLOSED_MAP_CLOSURES = prove (`!f:real^M->real^N. (!s. closed s ==> closed(IMAGE f s)) <=> (!s. closure(IMAGE f s) SUBSET IMAGE f (closure s))`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; IMAGE_SUBSET]; REWRITE_TAC[GSYM CLOSURE_SUBSET_EQ] THEN ASM_MESON_TAC[CLOSURE_CLOSED]]);; let OPEN_MAP_INTERIORS = prove (`!f:real^M->real^N. (!s. open s ==> open(IMAGE f s)) <=> (!s. IMAGE f (interior s) SUBSET interior(IMAGE f s))`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC INTERIOR_MAXIMAL THEN ASM_SIMP_TAC[OPEN_INTERIOR; INTERIOR_SUBSET; IMAGE_SUBSET]; REWRITE_TAC[GSYM SUBSET_INTERIOR_EQ] THEN ASM_MESON_TAC[INTERIOR_OPEN]]);; let OPEN_MAP_RESTRICT = prove (`!f:real^M->real^N s t t'. (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ t' SUBSET t ==> !u. open_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u ==> open_in (subtopology euclidean t') (IMAGE f u)`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let CLOSED_MAP_RESTRICT = prove (`!f:real^M->real^N s t t'. (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ t' SUBSET t ==> !u. closed_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u ==> closed_in (subtopology euclidean t') (IMAGE f u)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let QUOTIENT_MAP_OPEN_MAP_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) ==> ((!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f k}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let QUOTIENT_MAP_CLOSED_MAP_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) ==> ((!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f k}))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let CLOSED_MAP_IMP_OPEN_MAP = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f u}) ==> (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[CLOSED_IN_REFL]]);; let OPEN_MAP_IMP_CLOSED_MAP = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f u}) ==> (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);; let OPEN_MAP_IFF_CLOSED_MAP_BIJECTIVE = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN ONCE_REWRITE_TAC[closed_in; OPEN_IN_CLOSED_IN_EQ] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN STRIP_TAC THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let OPEN_MAP_FROM_COMPOSITION_SURJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. open_in (subtopology euclidean t) k ==> open_in (subtopology euclidean u) (IMAGE g k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) {x | x IN s /\ f(x) IN k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; let CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. closed_in (subtopology euclidean t) k ==> closed_in (subtopology euclidean u) (IMAGE g k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) {x | x IN s /\ f(x) IN k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; let OPEN_MAP_FROM_COMPOSITION_INJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE f k = {x | x IN t /\ g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; let CLOSED_MAP_FROM_COMPOSITION_INJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE f k = {x | x IN t /\ g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE = prove (`!f:real^M->real^N s t u w. (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k)) /\ closed_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. closed_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u`, REPEAT STRIP_TAC THEN EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]);; let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> (!u w. closed_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. closed_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[OPEN_MAP_CLOSED_SUPERSET_PREIMAGE] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]]);; let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE = prove (`!f:real^M->real^N s t u w. (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ open_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. open_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u`, REPEAT STRIP_TAC THEN EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]);; let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> (!u w. open_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. open_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]]);; let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> (!u y. open_in (subtopology euclidean s) u /\ y IN t /\ {x | x IN s /\ f(x) = y} SUBSET u ==> ?v. open_in (subtopology euclidean t) v /\ y IN v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ] THEN EQ_TAC THEN DISCH_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `{y:real^N}`]) THEN ASM_REWRITE_TAC[SING_SUBSET; IN_SING]; MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS {(vv:real^N->real^N->bool) y | y IN w}` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM SET_TAC[]]]);; let CONNECTED_OPEN_MONOTONE_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!c. open_in (subtopology euclidean s) c ==> open_in (subtopology euclidean t) (IMAGE f c)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) ==> !c. connected c /\ c SUBSET t ==> connected {x | x IN s /\ f x IN c}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_MAP_RESTRICT)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] OPEN_MAP_IMP_QUOTIENT_MAP) THEN SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; SIMP_TAC[SET_RULE `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = {x | x IN s /\ f x = y}`] THEN ASM SET_TAC[]]);; let CONNECTED_CLOSED_MONOTONE_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) ==> !c. connected c /\ c SUBSET t ==> connected {x | x IN s /\ f x IN c}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_MAP_RESTRICT)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] CLOSED_MAP_IMP_QUOTIENT_MAP) THEN SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; SIMP_TAC[SET_RULE `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = {x | x IN s /\ f x = y}`] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Proper maps, including projections out of compact sets. *) (* ------------------------------------------------------------------------- *) let PROPER_MAP = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=> (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ (!a. a IN t ==> compact {x | x IN s /\ f x = a}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[SET_RULE `x = a <=> x IN {a}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SING_SUBSET; COMPACT_SING]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `y:real^N`] THEN REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE] THEN REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; SKOLEM_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_AND_THM] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[UNWIND_THM2; FUN_EQ_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(INTERS {{a | a IN k /\ (f:real^M->real^N) a IN (y INSERT IMAGE (\i. f(x(n + i))) (:num))} | n IN (:num)} = {})` MP_TAC THENL [MATCH_MP_TAC COMPACT_FIP THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[SET_RULE `{x | x IN s INTER k /\ P x} = k INTER {x | x IN s /\ P x}`] THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP SEQ_OFFSET) THEN REWRITE_TAC[ADD_SYM]; REWRITE_TAC[SIMPLE_IMAGE; FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `i:num->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `(x:num->real^M) m` THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN DISJ2_TAC THEN EXISTS_TAC `m - p:num` THEN ASM_MESON_TAC[ARITH_RULE `p <= m ==> p + m - p:num = m`]]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(fun th -> LABEL_TAC "*" th THEN MP_TAC(SPEC `0` th)) THEN REWRITE_TAC[ADD_CLAUSES; IN_INSERT; IN_IMAGE; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (DISJ_CASES_THEN MP_TAC)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN REMOVE_THEN "*" (MP_TAC o SPEC `i + 1`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN ARITH_TAC]; STRIP_TAC THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN X_GEN_TAC `c:(real^M->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!a. a IN k ==> ?g. g SUBSET c /\ FINITE g /\ {x | x IN s /\ (f:real^M->real^N) x = a} SUBSET UNIONS g` MP_TAC THENL [X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN UNDISCH_THEN `!a. a IN t ==> compact {x | x IN s /\ (f:real^M->real^N) x = a}` (MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[COMPACT_EQ_HEINE_BOREL]] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uu:real^N->(real^M->bool)->bool` THEN DISCH_THEN(LABEL_TAC "*")] THEN SUBGOAL_THEN `!a. a IN k ==> ?v. open v /\ a IN v /\ {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET UNIONS(uu a)` MP_TAC THENL [REPEAT STRIP_TAC THEN UNDISCH_THEN `!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE (f:real^M->real^N) k)` (MP_TAC o SPEC `(s:real^M->bool) DIFF UNIONS(uu(a:real^N))`) THEN SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ANTS_TAC THENL [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN MATCH_MP_TAC OPEN_UNIONS THEN ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[] THEN REPEAT ((ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) ORELSE STRIP_TAC) THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM SET_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `vv:real^N->(real^N->bool)` THEN DISCH_THEN(LABEL_TAC "+")] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (vv:real^N->(real^N->bool)) k`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `j:real^N->bool` THEN REPEAT STRIP_TAC THEN EXISTS_TAC `UNIONS(IMAGE (uu:real^N->(real^M->bool)->bool) j)` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FINITE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_UNIONS; IN_ELIM_THM] THEN ASM SET_TAC[]]]);; let PROPER_MAP_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=> (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ (!a. a IN t ==> compact {x | x IN s /\ f x = a})`, REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> (q <=> r /\ s)) /\ (r ==> p) ==> (p /\ q <=> r /\ s)`) THEN REWRITE_TAC[PROPER_MAP] THEN MESON_TAC[CLOSED_IN_REFL; CLOSED_IN_IMP_SUBSET]);; let PROPER_MAP_FROM_COMPACT = prove (`!f:real^M->real^N s k t. f continuous_on s /\ IMAGE f s SUBSET t /\ compact s /\ closed_in (subtopology euclidean t) k ==> compact {x | x IN s /\ f x IN k}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_GEN]);; let PROPER_MAP_FROM_COMPACT_ALT = prove (`!f:real^M->real^N s t. compact s /\ f continuous_on s /\ IMAGE f s SUBSET t ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]);; let PROPER_MAP_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}) ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN s /\ (g o f) x IN k}`, REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN k}`) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let PROPER_MAP_FROM_COMPOSITION_LEFT = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!k. k SUBSET u /\ compact k ==> compact {x | x IN s /\ (g o f) x IN k}) ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}`, REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] COMPACT_CONTINUOUS_IMAGE)) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let PROPER_MAP_FROM_COMPOSITION_RIGHT = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!k. k SUBSET u /\ compact k ==> compact {x | x IN s /\ (g o f) x IN k}) ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`, let lemma = prove (`!s t. closed_in (subtopology euclidean s) t ==> compact s ==> compact t`, MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; CLOSED_IN_CLOSED_EQ]) in REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (g:real^N->real^P) k`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; MATCH_MP_TAC lemma THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);; let PROPER_MAP_FSTCART = prove (`!s:real^M->bool t:real^N->bool k. compact t /\ k SUBSET s /\ compact k ==> compact {z | z IN s PCROSS t /\ fstcart z IN k}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{z | z IN s PCROSS t /\ fstcart z IN k} = (k:real^M->bool) PCROSS (t:real^N->bool)` (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS; FSTCART_PASTECART] THEN ASM SET_TAC[]);; let CLOSED_MAP_FSTCART = prove (`!s:real^M->bool t:real^N->bool c. compact t /\ closed_in (subtopology euclidean (s PCROSS t)) c ==> closed_in (subtopology euclidean s) (IMAGE fstcart c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`] PROPER_MAP) THEN ASM_SIMP_TAC[PROPER_MAP_FSTCART; IMAGE_FSTCART_PCROSS] THEN ASM SET_TAC[]);; let PROPER_MAP_SNDCART = prove (`!s:real^M->bool t:real^N->bool k. compact s /\ k SUBSET t /\ compact k ==> compact {z | z IN s PCROSS t /\ sndcart z IN k}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{z | z IN s PCROSS t /\ sndcart z IN k} = (s:real^M->bool) PCROSS (k:real^N->bool)` (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let CLOSED_MAP_SNDCART = prove (`!s:real^M->bool t:real^N->bool c. compact s /\ closed_in (subtopology euclidean (s PCROSS t)) c ==> closed_in (subtopology euclidean t) (IMAGE sndcart c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`] PROPER_MAP) THEN ASM_SIMP_TAC[PROPER_MAP_SNDCART; IMAGE_SNDCART_PCROSS] THEN ASM SET_TAC[]);; let CLOSED_IN_COMPACT_PROJECTION = prove (`!s:real^M->bool t:real^N->bool u. compact s /\ closed_in (subtopology euclidean (s PCROSS t)) u ==> closed_in (subtopology euclidean t) {y | ?x. x IN s /\ pastecart x y IN u}`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_MAP_SNDCART) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET o CONJUNCT2) THEN REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART; EXISTS_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN SET_TAC[]);; let CLOSED_COMPACT_PROJECTION = prove (`!s:real^M->bool t:real^(M,N)finite_sum->bool. compact s /\ closed t ==> closed {y | ?x. x IN s /\ pastecart x y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{y | ?x:real^M. x IN s /\ pastecart x y IN t} = {y | ?x. x IN s /\ pastecart x y IN ((s PCROSS (:real^N)) INTER t)}` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_INTER] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[CLOSED_UNIV] THEN MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED; INTER_SUBSET]]);; let TUBE_LEMMA = prove (`!s:real^M->bool t:real^N->bool u a. compact s /\ ~(s = {}) /\ {pastecart x a | x IN s} SUBSET u /\ open_in(subtopology euclidean (s PCROSS t)) u ==> ?v. open_in (subtopology euclidean t) v /\ a IN v /\ (s PCROSS v) SUBSET u`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; PCROSS] CLOSED_IN_COMPACT_PROJECTION)) THEN ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `(closed_in top t ==> s DIFF (s DIFF t) = t) /\ s DIFF t SUBSET s /\ P(s DIFF t) ==> closed_in top t ==> ?v. v SUBSET s /\ closed_in top (s DIFF v) /\ P v`) THEN REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = t <=> t SUBSET s`] THEN REWRITE_TAC[SUBSET_DIFF] THEN SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; let TUBE_LEMMA_GEN = prove (`!s t t' u:real^(M,N)finite_sum->bool. compact s /\ ~(s = {}) /\ t SUBSET t' /\ s PCROSS t SUBSET u /\ open_in (subtopology euclidean (s PCROSS t')) u ==> ?v. open_in (subtopology euclidean t') v /\ t SUBSET v /\ s PCROSS v SUBSET u`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a. a IN t ==> ?v. open_in (subtopology euclidean t') v /\ a IN v /\ (s:real^M->bool) PCROSS (v:real^N->bool) SUBSET u` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC TUBE_LEMMA THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (vv:real^N->real^N->bool) t)` THEN ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_IMAGE] THEN REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; FORALL_IN_PCROSS] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real^N`)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Sequential characterizations of proper-ness. *) (* ------------------------------------------------------------------------- *) let PROPER_MAP_SEQUENTIALLY_IMP = prove (`!f:real^M->real^N s t x y. IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!n. x(n) IN s) /\ y IN t /\ ((f o x) --> y) sequentially ==> ?z r. z IN s /\ (!m n. m < n ==> r m < r n) /\ ((x o r) --> z) sequentially`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y INSERT IMAGE ((f:real^M->real^N) o x) (:num)`) THEN ASM_SIMP_TAC[COMPACT_SEQUENCE_WITH_LIMIT; INSERT_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[compact]] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INSERT; IMAGE_o] THEN ASM SET_TAC[]);; let PROPER_MAP_SEQUENTIALLY_REV = prove (`!f:real^M->real^N s t. f continuous_on s /\ (!x y. (!n. x(n) IN s) /\ y IN t /\ ((f o x) --> y) sequentially ==> ?z r. z IN s /\ (!m n. m < n ==> r m < r n) /\ ((x o r) --> z) sequentially) ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`, REPEAT STRIP_TAC THEN REWRITE_TAC[compact; IN_ELIM_THM; AND_FORALL_THM] THEN X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) o (x:num->real^M)`) THEN ASM_REWRITE_TAC[o_THM; LEFT_IMP_EXISTS_THM; GSYM o_ASSOC] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `r:num->num`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(x:num->real^M) o (r:num->num)`; `y:real^N`]) THEN ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN REWRITE_TAC[GSYM o_ASSOC; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:num->num` THEN STRIP_TAC THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CLOSED_CONTAINS_SEQUENTIAL_LIMIT THEN EXISTS_TAC `(f:real^M->real^N) o (x:num->real^M) o r o (q:num->num)` THEN ASM_SIMP_TAC[o_THM; COMPACT_IMP_CLOSED] THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_SEQUENTIALLY]) THEN ASM_REWRITE_TAC[o_THM]);; let PROPER_MAP_SEQUENTIALLY = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=> !x y. (!n. x(n) IN s) /\ y IN t /\ ((f o x) --> y) sequentially ==> ?z r. z IN s /\ (!m n. m < n ==> r m < r n) /\ ((x o r) --> z) sequentially)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC PROPER_MAP_SEQUENTIALLY_IMP THEN ASM_MESON_TAC[]; DISCH_TAC THEN MATCH_MP_TAC PROPER_MAP_SEQUENTIALLY_REV THEN ASM_REWRITE_TAC[]]);; let PROPER_MAP_ESCAPES_IMP = prove (`!f:real^M->real^N s t x. IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!n:num. x n IN s) /\ (!c. c SUBSET s /\ compact c ==> FINITE {n | x n IN c}) ==> (!k. k SUBSET t /\ compact k ==> FINITE {n | f(x n) IN k})`, REPEAT GEN_TAC THEN REPEAT (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `!x. (!n. x n IN s) ==> (!n:num. (f:real^M->real^N) (x n) IN t)` MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SEQUENCE_ESCAPES]] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC; o_DEF] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `r:num->num`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`; `(x:num->real^M) o (r:num->num)`; `y:real^N`] PROPER_MAP_SEQUENTIALLY_IMP) THEN ASM_REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN ASM_SIMP_TAC[o_DEF]);; let PROPER_MAP_ESCAPES = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=> !x. (!n:num. x n IN s) /\ (!c. c SUBSET s /\ compact c ==> FINITE {n | x n IN c}) ==> (!k. k SUBSET t /\ compact k ==> FINITE {n | f(x n) IN k}))`, REPEAT STRIP_TAC THEN SIMP_TAC[IMP_CONJ; SEQUENCE_ESCAPES] THEN ASM_SIMP_TAC[PROPER_MAP_SEQUENTIALLY; IMP_IMP] THEN SUBGOAL_THEN `!x. (!n. x n IN s) ==> (!n:num. (f:real^M->real^N) (x n) IN t)` MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SEQUENCE_ESCAPES]] THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC; o_DEF] THEN EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:num->real^M`; `y:real^N`] THENL [X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(x:num->real^M) o (r:num->num)`; `y:real^N`]) THEN ASM_REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN ASM_SIMP_TAC[o_THM]; STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`y:real^N`; `\n:num. n`] THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Pasting functions together on open sets. *) (* ------------------------------------------------------------------------- *) let PASTING_LEMMA = prove (`!f:A->real^M->real^N g t s k. (!i. i IN k ==> open_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i)) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) /\ (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) ==> g continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ g x IN u} = UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | i IN k}` SUBST1_TAC THENL [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[OPEN_IN_TRANS]]);; let PASTING_LEMMA_EXISTS = prove (`!f:A->real^M->real^N t s k u. s SUBSET UNIONS {t i | i IN k} /\ (!i. i IN k ==> open_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i) /\ IMAGE (f i) (t i) SUBSET u) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA THEN MAP_EVERY EXISTS_TAC [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN ASM SET_TAC[]);; let CONTINUOUS_ON_UNION_LOCAL_OPEN = prove (`!f:real^M->real^N s. open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\i:(real^M->bool). (f:real^M->real^N)`; `f:real^M->real^N`; `\i:(real^M->bool). i`; `s UNION t:real^M->bool`; `{s:real^M->bool,t}`] PASTING_LEMMA) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_UNION]);; let CONTINUOUS_ON_UNION_OPEN = prove (`!f s t. open s /\ open t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; let CONTINUOUS_ON_CASES_LOCAL_OPEN = prove (`!P f g:real^M->real^N s t. open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_CASES_OPEN = prove (`!P f g s t. open s /\ open t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on s UNION t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Likewise on closed sets, with a (local) finiteness condition. *) (* ------------------------------------------------------------------------- *) let PASTING_LEMMA_LOCALLY_FINITE = prove (`!f:A->real^M->real^N g t s k. (!x. x IN s ==> ?v. open_in (subtopology euclidean s) v /\ x IN v /\ FINITE {i | i IN k /\ ~(t i INTER v = {})}) /\ (!i. i IN k ==> closed_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i)) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) /\ (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) ==> g continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ g x IN u} = UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | i IN k}` SUBST1_TAC THENL [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; MATCH_MP_TAC CLOSED_IN_LOCALLY_FINITE_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_TRANS]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{y | y IN {f x | x IN s} /\ P y} = IMAGE f {x | x IN s /\ P(f x)}`] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^M` th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS) THEN X_GEN_TAC `v:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_IMAGE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);; let PASTING_LEMMA_EXISTS_LOCALLY_FINITE = prove (`!f:A->real^M->real^N t s k u. (!x. x IN s ==> ?v. open_in (subtopology euclidean s) v /\ x IN v /\ FINITE {i | i IN k /\ ~(t i INTER v = {})}) /\ s SUBSET UNIONS {t i | i IN k} /\ (!i. i IN k ==> closed_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i) /\ IMAGE (f i) (t i) SUBSET u) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA_LOCALLY_FINITE THEN MAP_EVERY EXISTS_TAC [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN ASM SET_TAC[]);; let PASTING_LEMMA_CLOSED = prove (`!f:A->real^M->real^N g t s k. FINITE k /\ (!i. i IN k ==> closed_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i)) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) /\ (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) ==> g continuous_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:A->real^M->real^N`; `g:real^M->real^N`; `t:A->real^M->bool`; `s:real^M->bool`; `k:A->bool`] PASTING_LEMMA_LOCALLY_FINITE) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[FINITE_RESTRICT]);; let PASTING_LEMMA_EXISTS_CLOSED = prove (`!f:A->real^M->real^N t s k u. FINITE k /\ s SUBSET UNIONS {t i | i IN k} /\ (!i. i IN k ==> closed_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i) /\ IMAGE (f i) (t i) SUBSET u) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA_CLOSED THEN MAP_EVERY EXISTS_TAC [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Closure of halflines, halfspaces and hyperplanes. *) (* ------------------------------------------------------------------------- *) let LIM_LIFT_DOT = prove (`!f:real^M->real^N a. (f --> l) net ==> ((lift o (\y. a dot f(y))) --> lift(a dot l)) net`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a = vec 0:real^N` THENL [ASM_REWRITE_TAC[DOT_LZERO; LIFT_NUM; o_DEF; LIM_CONST]; ALL_TAC] THEN REWRITE_TAC[LIM] THEN MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / norm(a:real^N)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_RDIV_EQ] THEN REWRITE_TAC[dist; o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; NORM_LIFT] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN MESON_TAC[NORM_CAUCHY_SCHWARZ_ABS; REAL_MUL_SYM; REAL_LET_TRANS]);; let CONTINUOUS_AT_LIFT_DOT = prove (`!a:real^N x. (lift o (\y. a dot y)) continuous at x`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_AT; o_THM] THEN MATCH_MP_TAC LIM_LIFT_DOT THEN REWRITE_TAC[LIM_AT] THEN MESON_TAC[]);; let CONTINUOUS_ON_LIFT_DOT = prove (`!s. (lift o (\y. a dot y)) continuous_on s`, SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_DOT]);; let CLOSED_INTERVAL_LEFT = prove (`!b:real^N. closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i <= b$i}`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[dist; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; let CLOSED_INTERVAL_RIGHT = prove (`!a:real^N. closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i}`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[dist; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`]);; let CLOSED_HALFSPACE_LE = prove (`!a:real^N b. closed {x | a dot x <= b}`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `(:real^N)` CONTINUOUS_ON_LIFT_DOT) THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE lift {r | ?x:real^N. (a dot x = r) /\ r <= b}`) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[o_DEF] THEN MESON_TAC[LIFT_DROP]] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `{x | !i. 1 <= i /\ i <= dimindex(:1) ==> (x:real^1)$i <= (lift b)$i}` THEN REWRITE_TAC[CLOSED_INTERVAL_LEFT] THEN SIMP_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_ELIM_THM; IN_INTER; VEC_COMPONENT; DIMINDEX_1; LAMBDA_BETA; o_THM] THEN SIMP_TAC[ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN MESON_TAC[LIFT_DROP]);; let CLOSED_HALFSPACE_GE = prove (`!a:real^N b. closed {x | a dot x >= b}`, REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; CLOSED_HALFSPACE_LE]);; let CLOSED_HYPERPLANE = prove (`!a b. closed {x | a dot x = b}`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REWRITE_TAC[REAL_ARITH `b <= a dot x <=> a dot x >= b`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_LE; CLOSED_HALFSPACE_GE]);; let CLOSURE_HYPERPLANE = prove (`!a b. closure {x | a dot x = b} = {x | a dot x = b}`, SIMP_TAC[CLOSURE_CLOSED; CLOSED_HYPERPLANE]);; let CLOSED_STANDARD_HYPERPLANE = prove (`!k a. closed {x:real^N | x$k = a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CLOSED_HALFSPACE_COMPONENT_LE = prove (`!a k. closed {x:real^N | x$k <= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_LE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CLOSED_HALFSPACE_COMPONENT_GE = prove (`!a k. closed {x:real^N | x$k >= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_GE) THEN ASM_SIMP_TAC[DOT_BASIS]);; (* ------------------------------------------------------------------------- *) (* Openness of halfspaces. *) (* ------------------------------------------------------------------------- *) let OPEN_HALFSPACE_LT = prove (`!a b. open {x | a dot x < b}`, REWRITE_TAC[GSYM REAL_NOT_LE] THEN REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN REWRITE_TAC[GSYM closed; GSYM real_ge; CLOSED_HALFSPACE_GE]);; let OPEN_HALFSPACE_COMPONENT_LT = prove (`!a k. open {x:real^N | x$k < a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_LT) THEN ASM_SIMP_TAC[DOT_BASIS]);; let OPEN_HALFSPACE_GT = prove (`!a b. open {x | a dot x > b}`, REWRITE_TAC[REAL_ARITH `x > y <=> ~(x <= y)`] THEN REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN REWRITE_TAC[GSYM closed; CLOSED_HALFSPACE_LE]);; let OPEN_HALFSPACE_COMPONENT_GT = prove (`!a k. open {x:real^N | x$k > a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_GT) THEN ASM_SIMP_TAC[DOT_BASIS]);; let OPEN_POSITIVE_MULTIPLES = prove (`!s:real^N->bool. open s ==> open {c % x | &0 < c /\ x IN s}`, REWRITE_TAC[open_def; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(c) % y:real^N`) THEN ANTS_TAC THENL [SUBGOAL_THEN `x:real^N = inv c % c % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; REAL_LT_IMP_NZ]; ASM_SIMP_TAC[DIST_MUL; real_abs; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `inv c * x:real = x / c`] THEN ASM_MESON_TAC[REAL_LT_LDIV_EQ; REAL_MUL_SYM]]; DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `c:real` THEN EXISTS_TAC `inv(c) % y:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC]);; let OPEN_INTERVAL_LEFT = prove (`!b:real^N. open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i < b$i}`, GEN_TAC THEN SUBGOAL_THEN `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i < b$i} = INTERS{{x | x$i < (b:real^N)$i} | i IN 1..dimindex(:N)}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_NUMSEG] THEN SET_TAC[]; MATCH_MP_TAC OPEN_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_HALFSPACE_COMPONENT_LT]]);; let OPEN_INTERVAL_RIGHT = prove (`!a:real^N. open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i}`, GEN_TAC THEN SUBGOAL_THEN `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i} = INTERS{{x | (a:real^N)$i < x$i} | i IN 1..dimindex(:N)}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_NUMSEG] THEN SET_TAC[]; MATCH_MP_TAC OPEN_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[FORALL_IN_IMAGE; GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT]]);; let OPEN_POSITIVE_ORTHANT = prove (`open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 < x$i}`, MP_TAC(ISPEC `vec 0:real^N` OPEN_INTERVAL_RIGHT) THEN REWRITE_TAC[VEC_COMPONENT]);; (* ------------------------------------------------------------------------- *) (* Closures and interiors of halfspaces. *) (* ------------------------------------------------------------------------- *) let INTERIOR_HALFSPACE_LE = prove (`!a:real^N b. ~(a = vec 0) ==> interior {x | a dot x <= b} = {x | a dot x < b}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN SIMP_TAC[OPEN_HALFSPACE_LT; SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE] THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[SUBSET; IN_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; REAL_ARITH `&0 < x ==> abs x <= x`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> ~(b + e <= b)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]);; let INTERIOR_HALFSPACE_GE = prove (`!a:real^N b. ~(a = vec 0) ==> interior {x | a dot x >= b} = {x | a dot x > b}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; REAL_ARITH `a > b <=> --a < --b`] THEN ASM_SIMP_TAC[GSYM DOT_LNEG; INTERIOR_HALFSPACE_LE; VECTOR_NEG_EQ_0]);; let INTERIOR_HALFSPACE_COMPONENT_LE = prove (`!a k. interior {x:real^N | x$k <= a} = {x | x$k < a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_LE) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let INTERIOR_HALFSPACE_COMPONENT_GE = prove (`!a k. interior {x:real^N | x$k >= a} = {x | x$k > a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_GE) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let CLOSURE_HALFSPACE_LT = prove (`!a:real^N b. ~(a = vec 0) ==> closure {x | a dot x < b} = {x | a dot x <= b}`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | P x} = {x | ~P x}`] THEN ASM_SIMP_TAC[REAL_ARITH `~(x < b) <=> x >= b`; INTERIOR_HALFSPACE_GE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CLOSURE_HALFSPACE_GT = prove (`!a:real^N b. ~(a = vec 0) ==> closure {x | a dot x > b} = {x | a dot x >= b}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; REAL_ARITH `a > b <=> --a < --b`] THEN ASM_SIMP_TAC[GSYM DOT_LNEG; CLOSURE_HALFSPACE_LT; VECTOR_NEG_EQ_0]);; let CLOSURE_HALFSPACE_COMPONENT_LT = prove (`!a k. closure {x:real^N | x$k < a} = {x | x$k <= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_LT) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let CLOSURE_HALFSPACE_COMPONENT_GT = prove (`!a k. closure {x:real^N | x$k > a} = {x | x$k >= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_GT) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let INTERIOR_HYPERPLANE = prove (`!a b. ~(a = vec 0) ==> interior {x | a dot x = b} = {}`, REWRITE_TAC[REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN REWRITE_TAC[INTERIOR_INTER] THEN ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; INTERIOR_HALFSPACE_GE] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let FRONTIER_HALFSPACE_LE = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x <= b} = {x | a dot x = b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO] THENL [ASM_CASES_TAC `&0 <= b` THEN ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; ASM_SIMP_TAC[frontier; INTERIOR_HALFSPACE_LE; CLOSURE_CLOSED; CLOSED_HALFSPACE_LE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let FRONTIER_HALFSPACE_GE = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x >= b} = {x | a dot x = b}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LE) THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);; let FRONTIER_HALFSPACE_LT = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x < b} = {x | a dot x = b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO] THENL [ASM_CASES_TAC `&0 < b` THEN ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; ASM_SIMP_TAC[frontier; CLOSURE_HALFSPACE_LT; INTERIOR_OPEN; OPEN_HALFSPACE_LT] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let FRONTIER_HALFSPACE_GT = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x > b} = {x | a dot x = b}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LT) THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN REWRITE_TAC[REAL_LT_NEG2; REAL_EQ_NEG2; real_gt]);; let FRONTIER_HALFSPACE_COMPONENT_LE = prove (`!a k. frontier {x:real^N | x$k <= a} = {x | x$k = a}`, SIMP_TAC[frontier; CLOSURE_CLOSED; CLOSED_HALFSPACE_COMPONENT_LE; INTERIOR_HALFSPACE_COMPONENT_LE] THEN REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let FRONTIER_HALFSPACE_COMPONENT_GE = prove (`!a k. frontier {x:real^N | x$k >= a} = {x | x$k = a}`, SIMP_TAC[frontier; CLOSURE_CLOSED; CLOSED_HALFSPACE_COMPONENT_GE; INTERIOR_HALFSPACE_COMPONENT_GE] THEN REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let FRONTIER_HALFSPACE_COMPONENT_LT = prove (`!a k. frontier {x:real^N | x$k < a} = {x | x$k = a}`, SIMP_TAC[frontier; INTERIOR_OPEN; OPEN_HALFSPACE_COMPONENT_LT; CLOSURE_HALFSPACE_COMPONENT_LT] THEN REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let FRONTIER_HALFSPACE_COMPONENT_GT = prove (`!a k. frontier {x:real^N | x$k > a} = {x | x$k = a}`, SIMP_TAC[frontier; INTERIOR_OPEN; OPEN_HALFSPACE_COMPONENT_GT; CLOSURE_HALFSPACE_COMPONENT_GT] THEN REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let INTERIOR_STANDARD_HYPERPLANE = prove (`!k a. interior {x:real^N | x$k = a} = {}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let EMPTY_INTERIOR_LOWDIM = prove (`!s:real^N->bool. dim(s) < dimindex(:N) ==> interior s = {}`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `!t u. s SUBSET t /\ t SUBSET u /\ u = {} ==> s = {}`) THEN MAP_EVERY EXISTS_TAC [`interior(span(s):real^N->bool)`; `interior({x:real^N | a dot x = &0})`] THEN ASM_SIMP_TAC[SUBSET_INTERIOR; SPAN_INC; INTERIOR_HYPERPLANE]);; let DIM_NONEMPTY_INTERIOR = prove (`!s:real^N->bool. ~(interior s = {}) ==> dim s = dimindex(:N)`, MESON_TAC[EMPTY_INTERIOR_LOWDIM; NOT_LE; LE_ANTISYM; DIM_SUBSET_UNIV]);; (* ------------------------------------------------------------------------- *) (* Unboundedness of halfspaces. *) (* ------------------------------------------------------------------------- *) let UNBOUNDED_HALFSPACE_COMPONENT_LE = prove (`!a k. ~bounded {x:real^N | x$k <= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !z:real^N. z$k = z$i` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN EXISTS_TAC `--(&1 + max (abs B) (abs a)) % basis i:real^N` THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; BASIS_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);; let UNBOUNDED_HALFSPACE_COMPONENT_GE = prove (`!a k. ~bounded {x:real^N | x$k >= a}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_NEGATIONS) THEN MP_TAC(SPECL [`--a:real`; `k:num`] UNBOUNDED_HALFSPACE_COMPONENT_LE) THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[VECTOR_NEG_NEG]; REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC]);; let UNBOUNDED_HALFSPACE_COMPONENT_LT = prove (`!a k. ~bounded {x:real^N | x$k < a}`, ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_LT; UNBOUNDED_HALFSPACE_COMPONENT_LE]);; let UNBOUNDED_HALFSPACE_COMPONENT_GT = prove (`!a k. ~bounded {x:real^N | x$k > a}`, ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_GT; UNBOUNDED_HALFSPACE_COMPONENT_GE]);; let BOUNDED_HALFSPACE_LE = prove (`!a:real^N b. bounded {x | a dot x <= b} <=> a = vec 0 /\ b < &0`, GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN SIMP_TAC[DOT_LMUL; DOT_BASIS; VECTOR_MUL_EQ_0; DIMINDEX_GE_1; LE_REFL; BASIS_NONZERO] THEN X_GEN_TAC `a:real` THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `b:real` THENL [REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `&0 <= b` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE; UNBOUNDED_HALFSPACE_COMPONENT_LE]]);; let BOUNDED_HALFSPACE_GE = prove (`!a:real^N b. bounded {x | a dot x >= b} <=> a = vec 0 /\ &0 < b`, REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LE] THEN REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b < &0 <=> &0 < b`]);; let BOUNDED_HALFSPACE_LT = prove (`!a:real^N b. bounded {x | a dot x < b} <=> a = vec 0 /\ b <= &0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `b <= &0` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; BOUNDED_HALFSPACE_LE]]);; let BOUNDED_HALFSPACE_GT = prove (`!a:real^N b. bounded {x | a dot x > b} <=> a = vec 0 /\ &0 <= b`, REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LT] THEN REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b <= &0 <=> &0 <= b`]);; (* ------------------------------------------------------------------------- *) (* Equality of continuous functions on closure and related results. *) (* ------------------------------------------------------------------------- *) let FORALL_IN_INTERMEDIATE_CLOSURE = prove (`!f:real^M->real^N s s' t. closed t /\ f continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\ (!x. x IN s ==> f x IN t) ==> !x. x IN s' ==> f x IN t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `x:real^M`] CLOSURE_SEQUENTIAL) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real^M` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM CLOSURE_EQ]) THEN REWRITE_TAC[CLOSURE_SEQUENTIAL] THEN EXISTS_TAC `(f:real^M->real^N) o (a:num->real^M)` THEN ASM_SIMP_TAC[o_THM] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_SEQUENTIALLY]) THEN ASM SET_TAC[]);; let FORALL_IN_INTERMEDIATE_CLOSURE_EQ = prove (`!f s s' t. closed t /\ f continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s ==> ((!x. x IN s' ==> f x IN t) <=> (!x. x IN s ==> f x IN t))`, MESON_TAC[FORALL_IN_INTERMEDIATE_CLOSURE; SUBSET]);; let CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE = prove (`!f:real^M->real s s' a. (lift o f) continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\ (!x. x IN s ==> f(x) <= a) ==> !x. x IN s' ==> f(x) <= a`, let lemma = prove (`x IN s ==> f x <= a <=> x IN s ==> (lift o f) x IN {y | y$1 <= a}`, REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; LIFT_DROP]) in REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_LE]);; let CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE = prove (`!f:real^M->real s s' a. (lift o f) continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\ (!x. x IN s ==> a <= f(x)) ==> !x. x IN s' ==> a <= f(x)`, let lemma = prove (`x IN s ==> a <= f x <=> x IN s ==> (lift o f) x IN {y | y$1 >= a}`, REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; real_ge; LIFT_DROP]) in REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_GE]);; let CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE = prove (`!f:real^M->real^N s s' a. f continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\ (!x. x IN s ==> f(x) = a) ==> !x. x IN s' ==> f(x) = a`, REWRITE_TAC[SET_RULE `x IN s ==> f x = a <=> x IN s ==> f x IN {a}`] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CLOSED_SING]);; let CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE = prove (`!g h:real^M->real^N s s'. g continuous_on s' /\ h continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\ (!x. x IN s ==> g x = h x) ==> !x. x IN s' ==> g x = h x`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB]);; let FORALL_IN_CLOSURE = prove (`!f:real^M->real^N s t. closed t /\ f continuous_on (closure s) /\ (!x. x IN s ==> f x IN t) ==> (!x. x IN closure s ==> f x IN t)`, MESON_TAC[FORALL_IN_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);; let FORALL_IN_CLOSURE_EQ = prove (`!f s t. closed t /\ f continuous_on closure s ==> ((!x. x IN closure s ==> f x IN t) <=> (!x. x IN s ==> f x IN t))`, MESON_TAC[FORALL_IN_CLOSURE; CLOSURE_SUBSET; SUBSET]);; let SUP_CLOSURE = prove (`!s. sup(IMAGE drop (closure s)) = sup(IMAGE drop s)`, GEN_TAC THEN MATCH_MP_TAC SUP_EQ THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_LE]);; let INF_CLOSURE = prove (`!s. inf(IMAGE drop (closure s)) = inf(IMAGE drop s)`, GEN_TAC THEN MATCH_MP_TAC INF_EQ THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `b <= drop x <=> x IN {x | b <= drop x}`] THEN MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_GE; GSYM real_ge]);; let CONTINUOUS_LE_ON_CLOSURE = prove (`!f:real^M->real s a. (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> f(x) <= a) ==> !x. x IN closure(s) ==> f(x) <= a`, MESON_TAC[CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);; let CONTINUOUS_GE_ON_CLOSURE = prove (`!f:real^M->real s a. (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> a <= f(x)) ==> !x. x IN closure(s) ==> a <= f(x)`, MESON_TAC[CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);; let CONTINUOUS_CONSTANT_ON_CLOSURE = prove (`!f:real^M->real^N s a. f continuous_on closure(s) /\ (!x. x IN s ==> f(x) = a) ==> !x. x IN closure(s) ==> f(x) = a`, MESON_TAC[CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);; let CONTINUOUS_AGREE_ON_CLOSURE = prove (`!g h:real^M->real^N. g continuous_on closure s /\ h continuous_on closure s /\ (!x. x IN s ==> g x = h x) ==> !x. x IN closure s ==> g x = h x`, MESON_TAC[CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);; let CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT = prove (`!f:real^M->real^N s a. f continuous_on s ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x = a}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_SING]);; let CONTINUOUS_CLOSED_PREIMAGE_CONSTANT = prove (`!f:real^M->real^N s. f continuous_on s /\ closed s ==> closed {x | x IN s /\ f(x) = a}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `{x | x IN s /\ (f:real^M->real^N)(x) = a} = {}` THEN ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_SING] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Theorems relating continuity and uniform continuity to closures. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_INTERMEDIATE_CLOSURE = prove (`!f:real^M->real^N s t. t SUBSET closure s /\ (!x. x IN t ==> (f --> f x) (at x within s)) ==> f continuous_on t`, REWRITE_TAC[CONTINUOUS_ON; LIM_SELF_WITHIN] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM (fun th -> MP_TAC(SPEC `x:real^M` th) THEN LABEL_TAC "*" th) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(y:real^M) IN closure s` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN DISCH_THEN(MP_TAC o SPEC `min (d / &2) k:real`) THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^M` STRIP_ASSUME_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT(ANTS_TAC ORELSE DISCH_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN CONV_TAC NORM_ARITH);; let CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ = prove (`!f:real^M->real^N s t. s SUBSET t /\ t SUBSET closure s ==> (f continuous_on t <=> !x. x IN t ==> (f --> f x) (at x within s))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONTINUOUS_ON] THEN ASM_MESON_TAC[LIM_WITHIN_SUBSET]; ASM_MESON_TAC[CONTINUOUS_ON_INTERMEDIATE_CLOSURE]]);; let CONTINUOUS_ON_CLOSURE = prove (`!f:real^M->real^N s. f continuous_on closure s <=> !x e. x IN closure s /\ &0 < e ==> ?d. &0 < d /\ !y. y IN s /\ dist(y,x) < d ==> dist(f y,f x) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[IMP_IMP; GSYM LIM_SELF_WITHIN] THEN MATCH_MP_TAC CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ THEN REWRITE_TAC[CLOSURE_SUBSET; SUBSET_REFL]);; let CONTINUOUS_ON_CLOSURE_SEQUENTIALLY = prove (`!f:real^M->real^N s. f continuous_on closure s <=> !x a. a IN closure s /\ (!n. x n IN s) /\ (x --> a) sequentially ==> ((f o x) --> f a) sequentially`, REWRITE_TAC[CONTINUOUS_ON_CLOSURE] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; GSYM continuous_within] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; let CONTINUOUS_ON_INTERMEDIATE_CLOSURE_POINTWISE = prove (`!f:real^M->real^N s t. s SUBSET t /\ t SUBSET closure s /\ (!x. x IN t ==> f continuous_on (x INSERT s)) ==> f continuous_on t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_INSERT; CONTINUOUS_ON]) THEN ASM_MESON_TAC[LIM_WITHIN_SUBSET; SET_RULE `s SUBSET x INSERT s`]);; let FUNCTION_EXTENSION_POINTWISE = prove (`!f:real^M->real^N s t u. s SUBSET t /\ t SUBSET closure s /\ (!x. x IN t ==> ?g. g continuous_on (x INSERT s) /\ IMAGE g (x INSERT s) SUBSET u /\ (!x. x IN s ==> g x = f x)) ==> ?g. g continuous_on t /\ IMAGE g t SUBSET u /\ (!x. x IN s ==> g x = f x)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_INSERT] THEN DISCH_THEN(X_CHOOSE_TAC `g:real^M->real^M->real^N`) THEN EXISTS_TAC `\x. (g:real^M->real^M->real^N) x x` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_INTERMEDIATE_CLOSURE_POINTWISE THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^M`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN ASM SET_TAC[]);; let FUNCTION_EXTENSION_POINTWISE_ALT = prove (`!f:real^M->real^N s t u. s SUBSET t /\ t SUBSET closure s /\ closed u /\ f continuous_on s /\ IMAGE f s SUBSET u /\ (!x. x IN t DIFF s ==> ?l. (f --> l) (at x within s)) ==> ?g. g continuous_on t /\ IMAGE g t SUBSET u /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_EXISTS_THM]) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_DIFF] THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN SIMP_TAC[] THEN CONJ_TAC THENL [MP_TAC(ISPECL [`\x. if x IN s then (f:real^M->real^N) x else g x`; `s:real^M->bool`; `t:real^M->bool`] CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN SIMP_TAC[EVENTUALLY_WITHIN; VECTOR_SUB_REFL] THEN MESON_TAC[REAL_LT_01]; ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[CONTINUOUS_ON]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(ISPEC `at (x:real^M) within s` LIM_IN_CLOSED_SET) THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[]; REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN SUBGOAL_THEN `(x:real^M) IN closure s` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[closure] THEN ASM SET_TAC[]]]]);; let UNIFORMLY_CONTINUOUS_ON_CLOSURE = prove (`!f:real^M->real^N s. f uniformly_continuous_on s /\ f continuous_on closure s ==> f uniformly_continuous_on closure s`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPECL [`x:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d1 (d / &3)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN DISCH_THEN(X_CHOOSE_THEN `x':real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `x':real^M`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d2 (d / &3)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN DISCH_THEN(X_CHOOSE_THEN `y':real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `y':real^M`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x':real^M`; `y':real^M`]) THEN ASM_MESON_TAC[DIST_SYM; NORM_ARITH `dist(y,x) < d / &3 /\ dist(x',x) < d / &3 /\ dist(y',y) < d / &3 ==> dist(y',x') < d`]);; (* ------------------------------------------------------------------------- *) (* Continuity properties for square roots. We get other forms of this *) (* later (transcendentals.ml and realanalysis.ml) but it's nice to have *) (* them around earlier. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_AT_SQRT = prove (`!a s. &0 < drop a ==> (lift o sqrt o drop) continuous (at a)`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `min (drop a) (e * sqrt(drop a))` THEN ASM_SIMP_TAC[REAL_LT_MIN; SQRT_POS_LT; REAL_LT_MUL; DIST_REAL] THEN X_GEN_TAC `b:real^1` THEN REWRITE_TAC[GSYM drop] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `abs(b - a) < a ==> &0 < b`)) THEN SUBGOAL_THEN `sqrt(drop b) - sqrt(drop a) = (drop b - drop a) / (sqrt(drop a) + sqrt(drop b))` SUBST1_TAC THENL [MATCH_MP_TAC(REAL_FIELD `sa pow 2 = a /\ sb pow 2 = b /\ &0 < sa /\ &0 < sb ==> sb - sa = (b - a) / (sa + sb)`) THEN ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE]; ASM_SIMP_TAC[REAL_ABS_DIV; SQRT_POS_LT; REAL_LT_ADD; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < x ==> abs x = x`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_ADDR; SQRT_POS_LE; REAL_LT_IMP_LE]]);; let CONTINUOUS_WITHIN_LIFT_SQRT = prove (`!a s. (!x. x IN s ==> &0 <= drop x) ==> (lift o sqrt o drop) continuous (at a within s)`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `drop a < &0 \/ drop a = &0 \/ &0 < drop a`) THENL [MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `{x | &0 <= drop x}` THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_NOT_LE] THEN REWRITE_TAC[drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]) THEN ASM_REWRITE_TAC[continuous_within; o_THM; DROP_VEC; SQRT_0; LIFT_NUM] THEN REWRITE_TAC[DIST_0; NORM_LIFT; NORM_REAL; GSYM drop] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(e:real) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN ASM_SIMP_TAC[real_abs; SQRT_POS_LE] THEN SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL [ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; MATCH_MP_TAC SQRT_MONO_LT THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[]]);; let CONTINUOUS_WITHIN_SQRT_COMPOSE = prove (`!f s a:real^N. (\x. lift(f x)) continuous (at a within s) /\ (&0 < f a \/ !x. x IN s ==> &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous (at a within s)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN REPEAT STRIP_TAC THEN (MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF]; ALL_TAC]) THENL [MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP]; MATCH_MP_TAC CONTINUOUS_WITHIN_LIFT_SQRT THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]]);; let CONTINUOUS_AT_SQRT_COMPOSE = prove (`!f a:real^N. (\x. lift(f x)) continuous (at a) /\ (&0 < f a \/ !x. &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous (at a)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `(:real^N)`; `a:real^N`] CONTINUOUS_WITHIN_SQRT_COMPOSE) THEN REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; let CONTINUOUS_ON_LIFT_SQRT = prove (`!s. (!x. x IN s ==> &0 <= drop x) ==> (lift o sqrt o drop) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_LIFT_SQRT]);; let CONTINUOUS_ON_LIFT_SQRT_COMPOSE = prove (`!f:real^N->real s. (lift o f) continuous_on s /\ (!x. x IN s ==> &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_SQRT THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]]);; (* ------------------------------------------------------------------------- *) (* Cauchy continuity, and the extension of functions to closures. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS = prove (`!f:real^M->real^N s. f uniformly_continuous_on s ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; cauchy; o_DEF] THEN MESON_TAC[]);; let CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS = prove (`!f:real^M->real^N s. f continuous_on s /\ closed s ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; CONTINUOUS_ON_SEQUENTIALLY] THEN REWRITE_TAC[complete] THEN MESON_TAC[CONVERGENT_IMP_CAUCHY]);; let CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) ==> !a x. (!n. (x n) IN s) /\ (x --> a) sequentially ==> ?l. ((f o x) --> l) sequentially /\ !y. (!n. (y n) IN s) /\ (y --> a) sequentially ==> ((f o y) --> l) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:num->real^M` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:num->real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `l:real^N = m` (fun th -> ASM_REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (f:real^M->real^N)(x n) - f(y n)` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o SPEC `\n. if EVEN n then x(n DIV 2):real^M else y(n DIV 2)`) THEN REWRITE_TAC[cauchy; o_THM; LIM_SEQUENTIALLY] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC [`((y:num->real^M) --> a) sequentially`; `((x:num->real^M) --> a) sequentially`] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl))) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `2 * (N1 + N2)` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `m DIV 2` th) THEN MP_TAC(SPEC `n DIV 2` th))) THEN REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`2 * n`; `2 * n + 1`]) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN REWRITE_TAC[ARITH_RULE `(2 * n) DIV 2 = n /\ (2 * n + 1) DIV 2 = n`] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO]]);; let CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) ==> ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a:real^M. ?x. a IN closure s ==> (!n. x n IN s) /\ (x --> a) sequentially` MP_TAC THENL [MESON_TAC[CLOSURE_SEQUENTIAL]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `X:real^M->num->real^M` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA) THEN DISCH_THEN(MP_TAC o GEN `a:real^M` o SPECL [`a:real^M`; `(X:real^M->num->real^M) a`]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(!a. P a ==> Q a) ==> ((!a. P a ==> R a) ==> p) ==> ((!a. Q a ==> R a) ==> p)`)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `(\n. a):num->real^M` o CONJUNCT2) THEN ASM_SIMP_TAC[LIM_CONST_EQ; o_DEF; TRIVIAL_LIMIT_SEQUENTIALLY]; STRIP_TAC] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY] THEN MAP_EVERY X_GEN_TAC [`x:num->real^M`; `a:real^M`] THEN STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `(f:real^M->real^N) o (x:num->real^M)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[o_THM]);; let UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove (`!f:real^M->real^N s. f uniformly_continuous_on s ==> ?g. g uniformly_continuous_on closure s /\ (!x. x IN s ==> g x = f x) /\ !h. h continuous_on closure s /\ (!x. x IN s ==> h x = f x) ==> !x. x IN closure s ==> h x = g x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_ON_CLOSURE; UNIFORMLY_CONTINUOUS_ON_EQ]; ASM_MESON_TAC[CONTINUOUS_AGREE_ON_CLOSURE]]);; let CAUCHY_CONTINUOUS_IMP_CONTINUOUS = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) ==> f continuous_on s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(CHOOSE_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CLOSURE_SUBSET; CONTINUOUS_ON_EQ]);; let BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f uniformly_continuous_on s /\ bounded s ==> bounded(IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (g:real^M->real^N) (closure s)` THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_CLOSURE; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE]; MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);; let LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON = prove (`!f:real^M->real^N s. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> f uniformly_continuous_on s`, ONCE_REWRITE_TAC[LIPSCHITZ_ON_POS] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; dist] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `x:real^M`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);; let BOUNDED_LIPSCHITZ_IMAGE = prove (`!f:real^M->real^N s. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) /\ bounded s ==> bounded (IMAGE f s)`, MESON_TAC[BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE; LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON]);; let LIPSCHITZ_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N s. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) ==> f continuous_on s`, SIMP_TAC[LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS]);; let LIPSCHITZ_LIM = prove (`!f:num->real^M->real^N g s b. (!n x y. x IN s /\ y IN s ==> norm(f n x - f n y) <= b * norm(x - y)) /\ (!x. x IN s ==> ((\n. f n x) --> g x) sequentially) ==> !x y. x IN s /\ y IN s ==> norm(g x - g y) <= b * norm(x - y)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LE_REFL; REAL_MUL_RZERO] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN GEN_REWRITE_TAC I [REAL_LE_TRANS_LTE] THEN X_GEN_TAC `c:real` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN ASM_REWRITE_TAC[tendsto; IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `(c - b) / &2 * norm(x - y:real^M)`) THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_HALF; REAL_LT_MUL; NORM_POS_LT; VECTOR_SUB_EQ; GSYM EVENTUALLY_AND] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^M`; `y:real^M`]) THEN ASM_REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC(NORM_ARITH `a + &2 * b <= c ==> norm(fx - fy:real^N) <= a /\ dist(fx,gx) < b /\ dist(fy,gy) < b ==> norm(gx - gy) <= c`) THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC);; let LIPSCHITZ_ON_SUP = prove (`!P:(real^N->real^1)->bool B s. &0 <= B /\ (!f. P f ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) /\ (!x. x IN s ==> ?C. !f. P f ==> drop(f x) <= C) ==> !x y. x IN s /\ y IN s ==> norm(lift(sup {drop(f x) | P f}) - lift(sup {drop(f y) | P f})) <= B * norm(x - y)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!f:real^N->real^1. ~(P f)` THENL [ASM_REWRITE_TAC[SET_RULE `{f x | x | F} = {}`; VECTOR_SUB_REFL] THEN ASM_SIMP_TAC[NORM_0; REAL_LE_MUL; NORM_POS_LE]; ALL_TAC] THEN MP_TAC(SPEC `{drop(f(y:real^N)) | P f}` SUP) THEN MP_TAC(SPEC `{drop(f(x:real^N)) | P f}` SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ABBREV_TAC `fy = sup {drop(f(y:real^N)) | P f}` THEN ABBREV_TAC `fx = sup {drop(f(x:real^N)) | P f}` THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC]) THEN REWRITE_TAC[NORM_1; DROP_SUB; LIFT_DROP; REAL_ARITH `abs(x - y) <= b <=> x <= y + b /\ y <= x + b`] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `f:real^N->real^1` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->real^1`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[NORM_1; DROP_SUB] THEN REAL_ARITH_TAC);; let LIPSCHITZ_ON_INF = prove (`!P:(real^N->real^1)->bool B s. &0 <= B /\ (!f. P f ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) /\ (!x. x IN s ==> ?C. !f. P f ==> C <= drop(f x)) ==> !x y. x IN s /\ y IN s ==> norm(lift(inf {drop(f x) | P f}) - lift(inf {drop(f y) | P f})) <= B * norm(x - y)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `!f:real^N->real^1. ~(P f)` THENL [ASM_REWRITE_TAC[SET_RULE `{f x | x | F} = {}`; VECTOR_SUB_REFL] THEN ASM_SIMP_TAC[NORM_0; REAL_LE_MUL; NORM_POS_LE]; ALL_TAC] THEN MP_TAC(SPEC `{drop(f(y:real^N)) | P f}` INF) THEN MP_TAC(SPEC `{drop(f(x:real^N)) | P f}` INF) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ABBREV_TAC `fy = inf {drop(f(y:real^N)) | P f}` THEN ABBREV_TAC `fx = inf {drop(f(x:real^N)) | P f}` THEN REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC]) THEN REWRITE_TAC[NORM_1; DROP_SUB; LIFT_DROP; REAL_ARITH `abs(x - y) <= b <=> x - b <= y /\ y - b <= x`] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `f:real^N->real^1` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->real^1`)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN ASM_REWRITE_TAC[NORM_1; DROP_SUB] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Occasionally useful invariance properties. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_AT_COMPOSE_EQ = prove (`!f:real^M->real^N g:real^M->real^M h:real^M->real^M. g continuous at x /\ h continuous at (g x) /\ (!y. g(h y) = y) /\ h(g x) = x ==> (f continuous at (g x) <=> (\x. f(g x)) continuous at x)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE] THEN DISCH_TAC THEN SUBGOAL_THEN `((f:real^M->real^N) o (g:real^M->real^M) o (h:real^M->real^M)) continuous at (g(x:real^M))` MP_TAC THENL [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN ASM_REWRITE_TAC[o_DEF]; ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; let CONTINUOUS_AT_TRANSLATION = prove (`!a z f:real^M->real^N. f continuous at (a + z) <=> (\x. f(a + x)) continuous at z`, REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN EXISTS_TAC `\x:real^M. x - a` THEN SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN VECTOR_ARITH_TAC);; add_translation_invariants [CONTINUOUS_AT_TRANSLATION];; let CONTINUOUS_AT_LINEAR_IMAGE = prove (`!h:real^M->real^M z f:real^M->real^N. linear h /\ (!x. norm(h x) = norm x) ==> (f continuous at (h z) <=> (\x. f(h x)) continuous at z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM ORTHOGONAL_TRANSFORMATION]) THEN FIRST_ASSUM(X_CHOOSE_TAC `g:real^M->real^M` o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE) THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN EXISTS_TAC `g:real^M->real^M` THEN RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_TRANSFORMATION]) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; add_linear_invariants [CONTINUOUS_AT_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Interior of an injective image. *) (* ------------------------------------------------------------------------- *) let INTERIOR_IMAGE_SUBSET = prove (`!f:real^M->real^N s. (!x. f continuous at x) /\ (!x y. f x = f y ==> x = y) ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN REWRITE_TAC[interior; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN SUBGOAL_THEN `y IN IMAGE (f:real^M->real^N) s` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `{x | (f:real^M->real^N)(x) IN t}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_MESON_TAC[]; ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Making a continuous function avoid some value in a neighbourhood. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_AVOID = prove (`!f:real^M->real^N x s a. f continuous (at x within s) /\ x IN s /\ ~(f x = a) ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x - a)`) THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN NORM_ARITH_TAC);; let CONTINUOUS_AT_AVOID = prove (`!f:real^M->real^N x a. f continuous (at x) /\ ~(f x = a) ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, MP_TAC CONTINUOUS_WITHIN_AVOID THEN REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(:real^M)`) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; let CONTINUOUS_ON_AVOID = prove (`!f:real^M->real^N x s a. f continuous_on s /\ x IN s /\ ~(f x = a) ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_AVOID THEN ASM_SIMP_TAC[]);; let CONTINUOUS_ON_OPEN_AVOID = prove (`!f:real^M->real^N x s a. f continuous_on s /\ open s /\ x IN s /\ ~(f x = a) ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `open(s:real^M->bool)` THEN ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_AVOID THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Proving a function is constant by proving open-ness of level set. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_LEVELSET_OPEN_IN_CASES = prove (`!f:real^M->real^N s a. connected s /\ f continuous_on s /\ open_in (subtopology euclidean s) {x | x IN s /\ f x = a} ==> (!x. x IN s ==> ~(f x = a)) \/ (!x. x IN s ==> f x = a)`, REWRITE_TAC[SET_RULE `(!x. x IN s ==> ~(f x = a)) <=> {x | x IN s /\ f x = a} = {}`; SET_RULE `(!x. x IN s ==> f x = a) <=> {x | x IN s /\ f x = a} = s`] THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT]);; let CONTINUOUS_LEVELSET_OPEN_IN = prove (`!f:real^M->real^N s a. connected s /\ f continuous_on s /\ open_in (subtopology euclidean s) {x | x IN s /\ f x = a} /\ (?x. x IN s /\ f x = a) ==> (!x. x IN s ==> f x = a)`, MESON_TAC[CONTINUOUS_LEVELSET_OPEN_IN_CASES]);; let CONTINUOUS_LEVELSET_OPEN = prove (`!f:real^M->real^N s a. connected s /\ f continuous_on s /\ open {x | x IN s /\ f x = a} /\ (?x. x IN s /\ f x = a) ==> (!x. x IN s ==> f x = a)`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC CONTINUOUS_LEVELSET_OPEN_IN THEN ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x = a}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some arithmetical combinations (more to prove). *) (* ------------------------------------------------------------------------- *) let OPEN_SCALING = prove (`!s:real^N->bool c. ~(c = &0) /\ open s ==> open(IMAGE (\x. c % x) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e * abs(c)` THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `inv(c) % y:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `x = inv(c) % c % x:real^N` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN ASM_REWRITE_TAC[GSYM dist]]);; let OPEN_SCALING_EQ = prove (`!s:real^N->bool c. open(IMAGE (\x. c % x) s) <=> (c = &0 ==> s = {}) /\ open s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[OPEN_EMPTY; NOT_OPEN_SING]; EQ_TAC THEN ASM_SIMP_TAC[OPEN_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] OPEN_SCALING)) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; REAL_INV_EQ_0; IMAGE_ID]]);; let OPEN_NEGATIONS = prove (`!s:real^N->bool. open s ==> open (IMAGE (--) s)`, SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x` (fun th -> SIMP_TAC[th; OPEN_SCALING; REAL_ARITH `~(--(&1) = &0)`]) THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; let OPEN_TRANSLATION = prove (`!s a:real^N. open s ==> open(IMAGE (\x. a + x) s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. x - a`; `s:real^N->bool`] CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[VECTOR_ARITH `(a + x) - a = x:real^N`; VECTOR_ARITH `a + (x - a) = x:real^N`]);; let OPEN_TRANSLATION_EQ = prove (`!a s. open (IMAGE (\x:real^N. a + x) s) <=> open s`, REWRITE_TAC[open_def] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [OPEN_TRANSLATION_EQ];; let OPEN_AFFINITY_EQ = prove (`!s m c:real^N. open(IMAGE (\x. m % x + c) s) <=> (m = &0 ==> s = {}) /\ open s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; OPEN_TRANSLATION_EQ; OPEN_SCALING_EQ; IMAGE_o]);; let OPEN_AFFINITY = prove (`!s m c:real^N. open s /\ (m = &0 ==> s = {}) ==> open(IMAGE (\x. m % x + c) s)`, SIMP_TAC[OPEN_AFFINITY_EQ]);; let INTERIOR_TRANSLATION = prove (`!a:real^N s. interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (interior s)`, REWRITE_TAC[interior] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [INTERIOR_TRANSLATION];; let OPEN_SUMS = prove (`!s t:real^N->bool. open s \/ open t ==> open {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[open_def] THEN STRIP_TAC THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`); FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[VECTOR_ADD_SYM; VECTOR_ARITH `(z - y) + y:real^N = z`; NORM_ARITH `dist(z:real^N,x + y) < e ==> dist(z - y,x) < e`]);; (* ------------------------------------------------------------------------- *) (* Upper and lower hemicontinuous functions, relation in the case of *) (* preimage map to open and closed maps, and fact that upper and lower *) (* hemicontinuity together imply continuity in the sense of the Hausdorff *) (* metric (at points where the function gives a bounded and nonempty set). *) (* ------------------------------------------------------------------------- *) let UPPER_HEMICONTINUOUS = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) ==> ((!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) <=> (!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ ~(f(x) INTER u = {})}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]; REWRITE_TAC[closed_in]] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let LOWER_HEMICONTINUOUS = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) ==> ((!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) <=> (!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ ~(f(x) INTER u = {})}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) {y | y IN t /\ {x | x IN s /\ f x = y} SUBSET u}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) <=> (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) {y | y IN t /\ {x | x IN s /\ f x = y} SUBSET u}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let UPPER_LOWER_HEMICONTINUOUS_EXPLICIT = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) /\ (!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) /\ (!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) ==> !x e. x IN s /\ &0 < e /\ bounded(f x) /\ ~(f x = {}) ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x,x') < d ==> (!y. y IN f x ==> ?y'. y' IN f x' /\ dist(y,y') < e) /\ (!y'. y' IN f x' ==> ?y. y IN f x /\ dist(y',y) < e)`, REPEAT STRIP_TAC THEN UNDISCH_TAC `!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN DISCH_THEN(MP_TAC o SPEC `t INTER {a + b | a IN (f:real^M->real^N->bool) x /\ b IN ball(vec 0,e)}`) THEN SIMP_TAC[OPEN_SUMS; OPEN_BALL; OPEN_IN_OPEN_INTER] THEN REWRITE_TAC[open_in; SUBSET_RESTRICT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_SIMP_TAC[IN_ELIM_THM; SUBSET_INTER] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1")))] THEN UNDISCH_TAC `!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN ASM_SIMP_TAC[LOWER_HEMICONTINUOUS] THEN DISCH_THEN(MP_TAC o GEN `a:real^N` o SPEC `t INTER ball(a:real^N,e / &2)`) THEN SIMP_TAC[OPEN_BALL; OPEN_IN_OPEN_INTER] THEN MP_TAC(SPEC `closure((f:real^M->real^N->bool) x)` COMPACT_EQ_HEINE_BOREL) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `{ball(a:real^N,e / &2) | a IN (f:real^M->real^N->bool) x}`) THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_BALL] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL [REWRITE_TAC[CLOSURE_APPROACHABLE; SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IN_BALL] THEN ASM_SIMP_TAC[REAL_HALF]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (MESON[CLOSURE_SUBSET; SUBSET_TRANS] `closure s SUBSET t ==> s SUBSET t`)) THEN SUBGOAL_THEN `open_in (subtopology euclidean s) (INTERS {{x | x IN s /\ ~((f:real^M->real^N->bool) x INTER t INTER ball(a,e / &2) = {})} | a IN c})` MP_TAC THENL [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ANTS_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))] THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; REMOVE_THEN "1" (MP_TAC o SPEC `x':real^M`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_BALL] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = a + b <=> x - a = b`; DIST_0; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[dist]] THEN REMOVE_THEN "2" (MP_TAC o SPEC `x':real^M`) THEN ASM_REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN DISCH_THEN(LABEL_TAC "3") THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN UNDISCH_TAC `(f:real^M->real^N->bool) x SUBSET UNIONS (IMAGE (\a. ball (a,e / &2)) c)` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN REMOVE_THEN "3" (MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Connected components, considered as a "connectedness" relation or a set. *) (* ------------------------------------------------------------------------- *) let connected_component = new_definition `connected_component s x y <=> ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t`;; let CONNECTED_COMPONENT_IN = prove (`!s x y. connected_component s x y ==> x IN s /\ y IN s`, REWRITE_TAC[connected_component] THEN SET_TAC[]);; let CONNECTED_COMPONENT_REFL = prove (`!s x:real^N. x IN s ==> connected_component s x x`, REWRITE_TAC[connected_component] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[CONNECTED_SING] THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_REFL_EQ = prove (`!s x:real^N. connected_component s x x <=> x IN s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL] THEN REWRITE_TAC[connected_component] THEN SET_TAC[]);; let CONNECTED_COMPONENT_SYM = prove (`!s x y:real^N. connected_component s x y ==> connected_component s y x`, REWRITE_TAC[connected_component] THEN MESON_TAC[]);; let CONNECTED_COMPONENT_TRANS = prove (`!s x y:real^N. connected_component s x y /\ connected_component s y z ==> connected_component s x z`, REPEAT GEN_TAC THEN REWRITE_TAC[connected_component] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `t:real^N->bool`) (X_CHOOSE_TAC `u:real^N->bool`)) THEN EXISTS_TAC `t UNION u:real^N->bool` THEN ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_OF_SUBSET = prove (`!s t x. s SUBSET t /\ connected_component s x y ==> connected_component t x y`, REWRITE_TAC[connected_component] THEN SET_TAC[]);; let CONNECTED_COMPONENT_SET = prove (`!s x. connected_component s x = { y | ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t}`, REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN REWRITE_TAC[IN; connected_component] THEN MESON_TAC[]);; let CONNECTED_COMPONENT_UNIONS = prove (`!s x. connected_component s x = UNIONS {t | connected t /\ x IN t /\ t SUBSET s}`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_COMPONENT_SUBSET = prove (`!s x. (connected_component s x) SUBSET s`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_CONNECTED_COMPONENT_SET = prove (`!s. connected s <=> !x:real^N. x IN s ==> connected_component s x = s`, GEN_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_UNIONS THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_UNIV = prove (`!x. connected_component(:real^N) x = (:real^N)`, MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; CONNECTED_UNIV; IN_UNIV]);; let CONNECTED_COMPONENT_EQ_UNIV = prove (`!s x. connected_component s x = (:real^N) <=> s = (:real^N)`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONNECTED_COMPONENT_UNIV] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s = UNIV ==> t = UNIV`) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; let CONNECTED_COMPONENT_EQ_SELF = prove (`!s x. connected s /\ x IN s ==> connected_component s x = s`, MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET]);; let CONNECTED_IFF_CONNECTED_COMPONENT = prove (`!s. connected s <=> !x y. x IN s /\ y IN s ==> connected_component s x y`, REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT_SET] THEN REWRITE_TAC[EXTENSION] THEN MESON_TAC[IN; CONNECTED_COMPONENT_IN]);; let CONNECTED_IMP_CONNECTED_COMPONENT = prove (`!s a b:real^N. connected s /\ a IN s /\ b IN s ==> connected_component s a b`, MESON_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);; let CONNECTED_COMPONENT_MAXIMAL = prove (`!s t x:real^N. x IN t /\ connected t /\ t SUBSET s ==> t SUBSET (connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_COMPONENT_MONO = prove (`!s t x. s SUBSET t ==> (connected_component s x) SUBSET (connected_component t x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_CONNECTED_COMPONENT = prove (`!s x. connected(connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN SET_TAC[]);; let CONNECTED_COMPONENT_EQ_EMPTY = prove (`!s x:real^N. connected_component s x = {} <=> ~(x IN s)`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]]);; let CONNECTED_COMPONENT_EMPTY = prove (`!x. connected_component {} x = {}`, REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);; let CONNECTED_COMPONENT_EQ = prove (`!s x y. y IN connected_component s x ==> (connected_component s y = connected_component s x)`, REWRITE_TAC[EXTENSION; IN] THEN MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; let CLOSED_CONNECTED_COMPONENT = prove (`!s x:real^N. closed s ==> closed(connected_component s x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [ALL_TAC; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CLOSED_EMPTY]] THEN REWRITE_TAC[GSYM CLOSURE_EQ] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN SIMP_TAC[CONNECTED_CLOSURE; CONNECTED_CONNECTED_COMPONENT] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; let CONNECTED_COMPONENT_DISJOINT = prove (`!s a b. DISJOINT (connected_component s a) (connected_component s b) <=> ~(a IN connected_component s b)`, REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN REWRITE_TAC[IN] THEN MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; let CONNECTED_COMPONENT_NONOVERLAP = prove (`!s a b:real^N. (connected_component s a) INTER (connected_component s b) = {} <=> ~(a IN s) \/ ~(b IN s) \/ ~(connected_component s a = connected_component s b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC `connected_component s (a:real^N) = connected_component s b` THEN ASM_REWRITE_TAC[INTER_IDEMPOT; CONNECTED_COMPONENT_EQ_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DISJOINT]) THEN REWRITE_TAC[CONNECTED_COMPONENT_DISJOINT]);; let CONNECTED_COMPONENT_OVERLAP = prove (`!s a b:real^N. ~((connected_component s a) INTER (connected_component s b) = {}) <=> a IN s /\ b IN s /\ connected_component s a = connected_component s b`, REWRITE_TAC[CONNECTED_COMPONENT_NONOVERLAP; DE_MORGAN_THM]);; let CONNECTED_COMPONENT_SYM_EQ = prove (`!s x y. connected_component s x y <=> connected_component s y x`, MESON_TAC[CONNECTED_COMPONENT_SYM]);; let CONNECTED_COMPONENT_EQ_EQ = prove (`!s x y:real^N. connected_component s x = connected_component s y <=> ~(x IN s) /\ ~(y IN s) \/ x IN s /\ y IN s /\ connected_component s x y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_REFL; CONNECTED_COMPONENT_SYM]; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]);; let CONNECTED_EQ_CONNECTED_COMPONENT_EQ = prove (`!s. connected s <=> !x y. x IN s /\ y IN s ==> connected_component s x = connected_component s y`, SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);; let CONNECTED_COMPONENT_IDEMP = prove (`!s x:real^N. connected_component (connected_component s x) x = connected_component s x`, REWRITE_TAC[FUN_EQ_THM; connected_component] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL; SUBSET_TRANS; CONNECTED_COMPONENT_SUBSET]);; let CONNECTED_COMPONENT_UNIQUE = prove (`!s c x:real^N. x IN c /\ c SUBSET s /\ connected c /\ (!c'. x IN c' /\ c' SUBSET s /\ connected c' ==> c' SUBSET c) ==> connected_component s x = c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);; let JOINABLE_CONNECTED_COMPONENT_EQ = prove (`!s t x y:real^N. connected t /\ t SUBSET s /\ ~(connected_component s x INTER t = {}) /\ ~(connected_component s y INTER t = {}) ==> connected_component s x = connected_component s y`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC)) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `z:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^N` THEN CONJ_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_SYM]]);; let CONNECTED_COMPONENT_TRANSLATION = prove (`!a s x. connected_component (IMAGE (\x. a + x) s) (a + x) = IMAGE (\x. a + x) (connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [CONNECTED_COMPONENT_TRANSLATION];; let CONNECTED_COMPONENT_LINEAR_IMAGE = prove (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> connected_component (IMAGE f s) (f x) = IMAGE f (connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [CONNECTED_COMPONENT_LINEAR_IMAGE];; let UNIONS_CONNECTED_COMPONENT = prove (`!s:real^N->bool. UNIONS {connected_component s x |x| x IN s} = s`, GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; CONNECTED_COMPONENT_SUBSET] THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]);; let COMPLEMENT_CONNECTED_COMPONENT_UNIONS = prove (`!s x:real^N. s DIFF connected_component s x = UNIONS({connected_component s y | y | y IN s} DELETE (connected_component s x))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s DELETE a ==> DISJOINT a x) ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN SIMP_TAC[CONNECTED_COMPONENT_DISJOINT; CONNECTED_COMPONENT_EQ_EQ] THEN MESON_TAC[IN; SUBSET; CONNECTED_COMPONENT_SUBSET]);; let CLOSED_IN_CONNECTED_COMPONENT = prove (`!s x:real^N. closed_in (subtopology euclidean s) (connected_component s x)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN ASM_REWRITE_TAC[CLOSED_IN_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `closure(connected_component s x):real^N->bool` THEN REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_INTER] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `connected_component s (x:real^N)` THEN REWRITE_TAC[INTER_SUBSET; CONNECTED_CONNECTED_COMPONENT; SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET]]);; let OPEN_IN_CONNECTED_COMPONENT = prove (`!s x:real^N. FINITE {connected_component s x |x| x IN s} ==> open_in (subtopology euclidean s) (connected_component s x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `connected_component s (x:real^N) = s DIFF (UNIONS {connected_component s y |y| y IN s} DIFF connected_component s x)` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s DIFF (s DIFF t)`) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN REWRITE_TAC[UNIONS_DIFF] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `connected_component s y DIFF connected_component s x = connected_component s y \/ connected_component s (y:real^N) DIFF connected_component s x = {}` (DISJ_CASES_THEN SUBST1_TAC) THENL [MATCH_MP_TAC(SET_RULE `(~(s INTER t = {}) ==> s = t) ==> s DIFF t = s \/ s DIFF t = {}`) THEN SIMP_TAC[CONNECTED_COMPONENT_OVERLAP]; REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT]; REWRITE_TAC[CLOSED_IN_EMPTY]]]);; let CONNECTED_COMPONENT_EQUIVALENCE_RELATION = prove (`!R s:real^N->bool. (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!a. a IN s ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ !x. x IN t ==> R a x) ==> !a b. connected_component s a b ==> R a b`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`R:real^N->real^N->bool`; `connected_component s (a:real^N)`] CONNECTED_EQUIVALENCE_RELATION) THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL [X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t INTER connected_component s (a:real^N)` THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] CONNECTED_COMPONENT_SUBSET) THEN SET_TAC[]; DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_IN]]);; let CONNECTED_COMPONENT_INTERMEDIATE_SUBSET = prove (`!t u a:real^N. connected_component u a SUBSET t /\ t SUBSET u ==> connected_component t a = connected_component u a`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; SUBSET]]);; let CONNECTED_UNIONS_STRONG = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> connected s) /\ ~(UNIONS f INTER INTERS {closure s | s IN f} = {}) ==> connected(UNIONS f)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; IN_UNIONS; INTERS_GSPEC; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) ASSUME_TAC)) THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN SUBGOAL_THEN `(z:real^N) IN UNIONS f` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN UNIONS f ==> connected_component (UNIONS f) z x` (fun th -> ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM; th]) THEN REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM; connected_component] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `u UNION c:real^N->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONNECTED_UNION_STRONG THEN ASM SET_TAC[]);; let NOT_CONNECTED_COMPONENT_SEPARATED_UNION = prove (`!s t x y:real^N. s INTER closure t = {} /\ t INTER closure s = {} /\ x IN s /\ y IN t ==> ~connected_component (s UNION t) x y`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[connected_component] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_SEPARATION_ALT]) THEN REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_SEPARATED_UNION = prove (`!s t x:real^N. s INTER closure t = {} /\ t INTER closure s = {} ==> connected_component (s UNION t) x = if x IN s then connected_component s x else if x IN t then connected_component t x else {}`, REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; IN_UNION] THEN SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; CONNECTED_COMPONENT_MONO; SUBSET_UNION] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNION] THEN MATCH_MP_TAC(SET_RULE `connected_component s x SUBSET s /\ (!y. ~(y IN t) ==> y IN s ==> ~(connected_component s x y)) ==> connected_component s x SUBSET t`) THEN SIMP_TAC[CONNECTED_COMPONENT_SUBSET; IN_UNION] THEN ASM_SIMP_TAC[NOT_CONNECTED_COMPONENT_SEPARATED_UNION] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_SIMP_TAC[NOT_CONNECTED_COMPONENT_SEPARATED_UNION]);; let CONNECTED_CONNECTED_DIFF = prove (`!s t:real^N->bool. connected s /\ s SUBSET closure(s DIFF t) /\ (!x. x IN s ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\ connected(u DIFF t)) ==> connected(s DIFF t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF] THEN REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] THEN CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`; `u:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[CLOSURE_NONEMPTY_OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN ONCE_REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[IN_DIFF] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN MATCH_MP_TAC(SET_RULE `P SUBSET Q ==> P x ==> Q x`) THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The set of connected components of a set. *) (* ------------------------------------------------------------------------- *) let components = new_definition `components s = {connected_component s x | x | x:real^N IN s}`;; let COMPONENTS_TRANSLATION = prove (`!a s. components(IMAGE (\x. a + x) s) = IMAGE (IMAGE (\x. a + x)) (components s)`, REWRITE_TAC[components] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);; add_translation_invariants [COMPONENTS_TRANSLATION];; let COMPONENTS_LINEAR_IMAGE = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> components(IMAGE f s) = IMAGE (IMAGE f) (components s)`, REWRITE_TAC[components] THEN GEOM_TRANSFORM_TAC[] THEN SET_TAC[]);; add_linear_invariants [COMPONENTS_LINEAR_IMAGE];; let IN_COMPONENTS = prove (`!u:real^N->bool s. s IN components u <=> ?x. x IN u /\ s = connected_component u x`, REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN EQ_TAC THENL [SET_TAC[];STRIP_TAC THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `x:real^N IN u` THEN SET_TAC[]]);; let CONNECTED_COMPONENTS = prove (`!s a b:real^N. connected_component s a b <=> ?c. c IN components s /\ a IN c /\ b IN c`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `s:real^N->bool` CONNECTED_COMPONENT_SUBSET) THEN REWRITE_TAC[components; EXISTS_IN_GSPEC; SUBSET] THEN REWRITE_TAC[IN] THEN MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]);; let UNIONS_COMPONENTS = prove (`!u:real^N->bool. u = UNIONS (components u)`, REWRITE_TAC[EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC THENL[DISCH_TAC THEN REWRITE_TAC[IN_UNIONS] THEN EXISTS_TAC `connected_component (u:real^N->bool) x` THEN CONJ_TAC THENL [REWRITE_TAC[components] THEN SET_TAC[ASSUME `x:real^N IN u`]; REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SUBGOAL_THEN `?s:real^N->bool. connected s /\ s SUBSET u /\ x IN s` MP_TAC THENL[EXISTS_TAC `{x:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING] THEN POP_ASSUM MP_TAC THEN SET_TAC[]; SET_TAC[]]]; REWRITE_TAC[IN_UNIONS] THEN STRIP_TAC THEN MATCH_MP_TAC (SET_RULE `!x:real^N s u. x IN s /\ s SUBSET u ==> x IN u`) THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS;ASSUME `t:real^N->bool IN components u`] `?y. t:real^N->bool = connected_component u y`) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; let PAIRWISE_DISJOINT_COMPONENTS = prove (`!u:real^N->bool. pairwise DISJOINT (components u)`, GEN_TAC THEN REWRITE_TAC[pairwise;DISJOINT] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN ASSERT_TAC `(?a. s:real^N->bool = connected_component u a) /\ ?b. t:real^N->bool = connected_component u b` THENL [ASM_MESON_TAC[IN_COMPONENTS]; ASM_MESON_TAC[CONNECTED_COMPONENT_NONOVERLAP]]);; let IN_COMPONENTS_NONEMPTY = prove (`!s c. c IN components s ==> ~(c = {})`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; let IN_COMPONENTS_SUBSET = prove (`!s c. c IN components s ==> c SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; let IN_COMPONENTS_CONNECTED = prove (`!s c. c IN components s ==> connected c`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);; let CONNECTED_COMPONENT_IN_COMPONENTS = prove (`!s c x:real^N. connected_component s x IN components s <=> x IN s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[components; IN_ELIM_THM] THEN ASM_MESON_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]]);; let IN_COMPONENTS_MAXIMAL = prove (`!s c:real^N->bool. c IN components s <=> ~(c = {}) /\ c SUBSET s /\ connected c /\ !c'. ~(c' = {}) /\ c SUBSET c' /\ c' SUBSET s /\ connected c' ==> c' = c`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN; SUBSET]; STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(GSYM CONNECTED_COMPONENT_UNIQUE) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]]);; let JOINABLE_COMPONENTS_EQ = prove (`!s t c1 c2. connected t /\ t SUBSET s /\ c1 IN components s /\ c2 IN components s /\ ~(c1 INTER t = {}) /\ ~(c2 INTER t = {}) ==> c1 = c2`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN MESON_TAC[JOINABLE_CONNECTED_COMPONENT_EQ]);; let CLOSED_IN_COMPONENT = prove (`!s c:real^N->bool. c IN components s ==> closed_in (subtopology euclidean s) c`, REWRITE_TAC[components; FORALL_IN_GSPEC; CLOSED_IN_CONNECTED_COMPONENT]);; let CLOSED_COMPONENTS = prove (`!s c. closed s /\ c IN components s ==> closed c`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN SIMP_TAC[CLOSED_CONNECTED_COMPONENT]);; let COMPACT_CONNECTED_COMPONENT = prove (`!s a:real^N. compact s ==> compact(connected_component s a)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_COMPACT) THEN REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT]);; let COMPACT_COMPONENTS = prove (`!s c:real^N->bool. compact s /\ c IN components s ==> compact c`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN MESON_TAC[CLOSED_COMPONENTS; IN_COMPONENTS_SUBSET; BOUNDED_SUBSET]);; let CONTINUOUS_ON_COMPONENTS_GEN = prove (`!f:real^M->real^N s. (!c. c IN components s ==> open_in (subtopology euclidean s) c /\ f continuous_on c) ==> f continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` SUBST1_TAC THENL [CONV_TAC(LAND_CONV(SUBS_CONV [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[OPEN_IN_TRANS]]);; let CONTINUOUS_ON_COMPONENTS_FINITE = prove (`!f:real^M->real^N s. FINITE(components s) /\ (!c. c IN components s ==> f continuous_on c) ==> f continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` SUBST1_TAC THENL [CONV_TAC(LAND_CONV(SUBS_CONV [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_COMPONENT]]);; let COMPONENTS_NONOVERLAP = prove (`!s c c'. c IN components s /\ c' IN components s ==> (c INTER c' = {} <=> ~(c = c'))`, REWRITE_TAC[components; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_NONOVERLAP]);; let COMPONENTS_EQ = prove (`!s c c'. c IN components s /\ c' IN components s ==> (c = c' <=> ~(c INTER c' = {}))`, MESON_TAC[COMPONENTS_NONOVERLAP]);; let COMPONENTS_EQ_EMPTY = prove (`!s. components s = {} <=> s = {}`, GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[components; connected_component; IN_ELIM_THM] THEN SET_TAC[]);; let COMPONENTS_EMPTY = prove (`components {} = {}`, REWRITE_TAC[COMPONENTS_EQ_EMPTY]);; let CONNECTED_EQ_CONNECTED_COMPONENTS_EQ = prove (`!s. connected s <=> !c c'. c IN components s /\ c' IN components s ==> c = c'`, REWRITE_TAC[components; IN_ELIM_THM] THEN MESON_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ]);; let COMPONENTS_EQ_SING,COMPONENTS_EQ_SING_EXISTS = (CONJ_PAIR o prove) (`(!s:real^N->bool. components s = {s} <=> connected s /\ ~(s = {})) /\ (!s:real^N->bool. (?a. components s = {a}) <=> connected s /\ ~(s = {}))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> r) /\ (q <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN ASM_MESON_TAC[IN_SING; COMPONENTS_EQ_EMPTY; NOT_INSERT_EMPTY]; STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_SING] THEN REWRITE_TAC[components; IN_ELIM_THM] THEN ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; MEMBER_NOT_EMPTY]]);; let CONNECTED_EQ_COMPONENTS_SING = prove (`!s:real^N->bool. connected s <=> s = {} \/ components s = {s}`, MESON_TAC[COMPONENTS_EQ_SING; CONNECTED_EMPTY]);; let CONNECTED_EQ_COMPONENTS_SING_EXISTS = prove (`!s:real^N->bool. connected s <=> s = {} \/ (?a. components s = {a})`, MESON_TAC[COMPONENTS_EQ_SING_EXISTS; CONNECTED_EMPTY]);; let CONNECTED_EQ_CARD_COMPONENTS = prove (`!s:real^N->bool. connected s <=> FINITE(components s) /\ CARD(components s) <= 1`, GEN_TAC THEN REWRITE_TAC[CONNECTED_EQ_COMPONENTS_SING_EXISTS] THEN REWRITE_TAC[ARITH_RULE `n <= 1 <=> n = 0 \/ n = 1`] THEN REWRITE_TAC[IMP_IMP; LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[COMPONENTS_EQ_EMPTY]);; let COMPONENTS_UNIV = prove (`components(:real^N) = {(:real^N)}`, REWRITE_TAC[COMPONENTS_EQ_SING; CONNECTED_UNIV; UNIV_NOT_EMPTY]);; let CONNECTED_EQ_COMPONENTS_SUBSET_SING = prove (`!s:real^N->bool. connected s <=> components s SUBSET {s}`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING]);; let CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS = prove (`!s:real^N->bool. connected s <=> ?a. components s SUBSET {a}`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING_EXISTS]);; let IN_COMPONENTS_SELF = prove (`!s:real^N->bool. s IN components s <=> connected s /\ ~(s = {})`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED]; SIMP_TAC[GSYM COMPONENTS_EQ_SING; IN_SING]]);; let COMPONENTS_MAXIMAL = prove (`!s t c:real^N->bool. c IN components s /\ connected t /\ t SUBSET s /\ ~(c INTER t = {}) ==> t SUBSET c`, REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]);; let IN_COMPONENTS_MAXIMAL_ALT = prove (`!s c:real^N->bool. c IN components s <=> ~(c = {}) /\ c SUBSET s /\ connected c /\ (!c'. ~(c INTER c' = {}) /\ c' SUBSET s /\ connected c' ==> c' SUBSET c)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN ASM_MESON_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]);; let COMPONENTS_UNIQUE = prove (`!s:real^N->bool k. UNIONS k = s /\ (!c. c IN k ==> connected c /\ ~(c = {}) /\ !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c) ==> components s = k`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `c:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `x:real^N` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `connected_component s (x:real^N) = c` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION; ASM SET_TAC[]] THEN ASM SET_TAC[]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_SUBSET] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let COMPONENTS_UNIQUE_EQ = prove (`!s:real^N->bool k. components s = k <=> UNIONS k = s /\ (!c. c IN k ==> connected c /\ ~(c = {}) /\ !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM); REWRITE_TAC[COMPONENTS_UNIQUE]] THEN REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; RULE_ASSUM_TAC(REWRITE_RULE[IN_COMPONENTS_MAXIMAL]) THEN ASM_MESON_TAC[SUBSET_EMPTY]]);; let COMPONENTS_UNIQUE_2 = prove (`!s c1 c2:real^N->bool. connected c1 /\ connected c2 /\ c1 UNION c2 = s /\ ~connected s ==> components s = {c1,c2}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c1:real^N->bool = {}` THENL [ASM_MESON_TAC[UNION_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `c2:real^N->bool = {}` THENL [ASM_MESON_TAC[UNION_EMPTY]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC COMPONENTS_UNIQUE THEN ASM_REWRITE_TAC[UNIONS_2; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THENL [MP_TAC(ISPECL [`c:real^N->bool`; `c2:real^N->bool`] CONNECTED_UNION) THEN SUBGOAL_THEN `c UNION c2:real^N->bool = s` SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MP_TAC(ISPECL [`c1:real^N->bool`; `c:real^N->bool`] CONNECTED_UNION) THEN SUBGOAL_THEN `c1 UNION c:real^N->bool = s` SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let EXISTS_COMPONENT_SUPERSET = prove (`!s t:real^N->bool. t SUBSET s /\ ~(s = {}) /\ connected t ==> ?c. c IN components s /\ t SUBSET c`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[EMPTY_SUBSET] THEN ASM_MESON_TAC[COMPONENTS_EQ_EMPTY; MEMBER_NOT_EMPTY]; FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^N` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN EXISTS_TAC `connected_component s (a:real^N)` THEN REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]]]);; let COMPONENTS_INTERMEDIATE_SUBSET = prove (`!s t u:real^N->bool. s IN components u /\ s SUBSET t /\ t SUBSET u ==> s IN components t`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN MESON_TAC[CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; SUBSET; CONNECTED_COMPONENT_REFL; IN; CONNECTED_COMPONENT_SUBSET]);; let COMPONENTS_INTER_COMPONENTS = prove (`!s t c d:real^N->bool. c IN components s /\ d IN components (t INTER c) ==> d IN components(t INTER s)`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL_ALT; SUBSET_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let IN_COMPONENTS_UNIONS_COMPLEMENT = prove (`!s c:real^N->bool. c IN components s ==> s DIFF c = UNIONS(components s DELETE c)`, REWRITE_TAC[components; FORALL_IN_GSPEC; COMPLEMENT_CONNECTED_COMPONENT_UNIONS]);; let CONNECTED_SUBSET_CLOPEN = prove (`!u s c:real^N->bool. closed_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) s /\ connected c /\ c SUBSET u /\ ~(c INTER s = {}) ==> c SUBSET s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`c INTER s:real^N->bool`; `c DIFF s:real^N->bool`]) THEN ASM_REWRITE_TAC[CONJ_ASSOC; SET_RULE `c DIFF s = {} <=> c SUBSET s`] THEN MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN])] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[OPEN_IN_OPEN; CLOSED_IN_CLOSED] THENL [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `(:real^N) DIFF t`] THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; let CLOPEN_UNIONS_COMPONENTS = prove (`!u s:real^N->bool. closed_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) s ==> ?k. k SUBSET components u /\ s = UNIONS k`, REPEAT STRIP_TAC THEN EXISTS_TAC `{c:real^N->bool | c IN components u /\ ~(c INTER s = {})}` THEN REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_SUBSET_CLOPEN THEN EXISTS_TAC `u:real^N->bool` THEN ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]]);; let CLOPEN_IN_COMPONENTS = prove (`!u s:real^N->bool. closed_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) s /\ connected s /\ ~(s = {}) ==> s IN components u`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOPEN_UNIONS_COMPONENTS) THEN DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `k:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N->bool`) THEN ASM_CASES_TAC `k = {c:real^N->bool}` THENL [ASM_MESON_TAC[UNIONS_1; GSYM SING_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `~p ==> p /\ q ==> r`) THEN SUBGOAL_THEN `?c':real^N->bool. c' IN k /\ ~(c = c')` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SET_RULE `a IN s /\ ~(s = {a}) ==> ?b. b IN s /\ ~(b = a)`]; REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `c':real^N->bool`]) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THEN MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN ASM SET_TAC[]]);; let CONNECTED_UNIONS_PAIRWISE = prove (`!f. (!s:real^N->bool. s IN f ==> connected s) /\ pairwise (\s t. ~(s = {}) /\ ~(t = {}) ==> ~(s INTER t = {})) f ==> connected(UNIONS f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS] THEN REWRITE_TAC[SET_RULE `(?c. s SUBSET {c}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN MAP_EVERY X_GEN_TAC [`c1:real^N->bool`; `c2:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`UNIONS f:real^N->bool`; `c1:real^N->bool`; `c2:real^N->bool`] COMPONENTS_EQ) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `?a1:real^N a2:real^N. a1 IN c1 /\ a1 IN UNIONS f /\ a2 IN c2 /\ a2 IN UNIONS f` MP_TAC THENL [REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THEN ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_SUBSET; MEMBER_NOT_EMPTY; SUBSET]; REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM; IMP_CONJ]] THEN MAP_EVERY X_GEN_TAC [`a1:real^N`; `a2:real^N`] THEN DISCH_TAC THEN X_GEN_TAC `s1:real^N->bool` THEN REPEAT DISCH_TAC THEN X_GEN_TAC `s2:real^N->bool` THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN DISCH_THEN(MP_TAC o SPECL [`s1:real^N->bool`; `s2:real^N->bool`]) THEN SUBGOAL_THEN `(s1:real^N->bool) SUBSET c1 /\ (s2:real^N->bool) SUBSET c2` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `UNIONS f:real^N->bool` THEN ASM SET_TAC[]);; let COMPONENTS_SEPARATED_UNION = prove (`!s t:real^N->bool. s INTER closure t = {} /\ t INTER closure s = {} ==> components(s UNION t) = components(s) UNION components(t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[components] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_UNION] THEN BINOP_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[GSYM SUBSET_ANTISYM] THENL [ALL_TAC; ONCE_REWRITE_TAC[UNION_COMM]] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_SEPARATED_UNION]);; let COMPONENTS_COMPLEMENT_FRONTIER = prove (`!s. components((:real^N) DIFF frontier s) = components(interior s) UNION components ((:real^N) DIFF closure s)`, GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES; SET_RULE `UNIV DIFF s INTER t = (UNIV DIFF s) UNION (UNIV DIFF t)`] THEN W(MP_TAC o PART_MATCH (lhand o rand) COMPONENTS_SEPARATED_UNION o lhand o snd) THEN SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; GSYM INTERIOR_COMPLEMENT; OPEN_INTERIOR; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN DISCH_THEN MATCH_MP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN MP_TAC(ISPEC `(:real^N) DIFF s` INTERIOR_SUBSET) THEN SET_TAC[]);; let CARD_LE_COMPONENTS_UNION = prove (`!s t:real^N->bool. components(s UNION t) <=_c components(s) +_c components(t)`, REPEAT GEN_TAC THEN TRANS_TAC CARD_LE_TRANS `components(s:real^N->bool) UNION components t` THEN REWRITE_TAC[UNION_LE_ADD_C] THEN MATCH_MP_TAC(ISPEC `\s t. ~(s INTER t = {})` CARD_LE_RELATIONAL_FULL) THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[EXISTS_IN_UNION; components; FORALL_IN_GSPEC] THEN REWRITE_TAC[FORALL_IN_UNION; EXISTS_IN_GSPEC] THEN CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNION]; MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `d:real^N->bool`; `e:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s UNION t:real^N->bool`; `d:real^N->bool`; `e:real^N->bool`] COMPONENTS_EQ) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(c INTER d = {}) ==> c SUBSET e ==> ~(d INTER e = {})`)) THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN DISCH_THEN(DISJ_CASES_THEN (fun th -> ASSUME_TAC(MATCH_MP IN_COMPONENTS_CONNECTED th) THEN MP_TAC(MATCH_MP IN_COMPONENTS_SUBSET th))) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let FINITE_COMPONENTS_UNION = prove (`!s t:real^N->bool. FINITE(components s) /\ FINITE(components t) ==> FINITE(components(s UNION t))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_ADD_FINITE_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE) THEN REWRITE_TAC[CARD_LE_COMPONENTS_UNION]);; let COUNTABLE_COMPONENTS_UNION = prove (`!s t:real^N->bool. COUNTABLE(components s) /\ COUNTABLE(components t) ==> COUNTABLE(components(s UNION t))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM COUNTABLE_CARD_ADD_EQ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_COUNTABLE) THEN REWRITE_TAC[CARD_LE_COMPONENTS_UNION]);; let MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER_ELEMENTWISE = prove (`!s c1 c2 a b t. c1 IN components((:real^N) DIFF s) /\ c2 IN components((:real^N) DIFF s) /\ a IN c1 /\ b IN c2 /\ frontier c1 = s /\ frontier c2 = s /\ t PSUBSET s ==> connected_component ((:real^N) DIFF t) a b`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC)) THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `((c:real^N) INSERT c1) UNION (c INSERT c2)` THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL [EXISTS_TAC `c1:real^N->bool`; EXISTS_TAC `c2:real^N->bool`] THEN (CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC]) THEN REWRITE_TAC[INSERT_SUBSET; CLOSURE_SUBSET] THEN RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN ASM SET_TAC[]]);; let MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER = prove (`!s t. t PSUBSET s /\ ~(s = (:real^N)) /\ (!c. c IN components((:real^N) DIFF s) ==> frontier c = s) ==> connected((:real^N) DIFF t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN MATCH_MP_TAC(MESON[] `!Q. (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R x y ==> R y x) /\ (?y. P y /\ Q y) /\ (?y. P y /\ ~Q y) /\ (!x y. P x /\ P y /\ Q x /\ ~Q y ==> R x y) ==> (!x y. P x /\ P y ==> R x y)`) THEN EXISTS_TAC `\x:real^N. x IN s` THEN REWRITE_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[connected_component] THEN EXISTS_TAC `a INSERT connected_component ((:real^N) DIFF s) b` THEN REWRITE_TAC[IN_INSERT] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `connected_component ((:real^N) DIFF s) b` THEN REWRITE_TAC[INSERT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[CLOSURE_SUBSET]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `connected_component ((:real^N) DIFF s) b`) THEN REWRITE_TAC[frontier] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[components; IN_ELIM_THM; IN_UNIV; IN_DIFF] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[INSERT_SUBSET; IN_UNIV; IN_DIFF] THEN MP_TAC(ISPECL [`(:real^N) DIFF s`; `b:real^N`] CONNECTED_COMPONENT_SUBSET) THEN ASM SET_TAC[]; DISJ2_TAC THEN REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Continuity implies uniform continuity on a compact domain. *) (* ------------------------------------------------------------------------- *) let COMPACT_UNIFORMLY_EQUICONTINUOUS = prove (`!(fs:(real^M->real^N)->bool) s. (!x e. x IN s /\ &0 < e ==> ?d. &0 < d /\ (!f x'. f IN fs /\ x' IN s /\ dist (x',x) < d ==> dist (f x',f x) < e)) /\ compact s ==> !e. &0 < e ==> ?d. &0 < d /\ !f x x'. f IN fs /\ x IN s /\ x' IN s /\ dist (x',x) < d ==> dist(f x',f x) < e`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real^M->real->real` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN DISCH_THEN(MP_TAC o SPEC `{ ball(x:real^M,d x (e / &2)) | x IN s}`) THEN SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; UNIONS_GSPEC; SUBSET; IN_ELIM_THM] THEN ANTS_TAC THENL [ASM_MESON_TAC[CENTRE_IN_BALL; REAL_HALF]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `u:real^M`; `v:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `v:real^M` th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN ASM_REWRITE_TAC[DIST_REFL] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `w:real^M` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `e / &2`]) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o CONJUNCT2) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; let COMPACT_UNIFORMLY_CONTINUOUS = prove (`!f:real^M->real^N s. f continuous_on s /\ compact s ==> f uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; uniformly_continuous_on] THEN STRIP_TAC THEN MP_TAC(ISPECL [`{f:real^M->real^N}`; `s:real^M->bool`] COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; IN_SING; FORALL_UNWIND_THM2] THEN ASM_MESON_TAC[]);; let CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED = prove (`!f:real^M->real^N s. closed s ==> (f continuous_on s <=> !x. cauchy x /\ (!n. x n IN s) ==> cauchy(f o x))`, MESON_TAC[CAUCHY_CONTINUOUS_IMP_CONTINUOUS; CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS]);; let UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED = prove (`!f:real^M->real^N s. bounded s ==> (f uniformly_continuous_on s <=> !x. cauchy x /\ (!n. x n IN s) ==> cauchy(f o x))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS] THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC UNIFORMLY_CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC UNIFORMLY_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `closure s:real^M->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]);; let CAUCHY_CONTINUOUS_EXTENDS_TO_CAUCHY_CONTINUOUS_CLOSURE = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) ==> ?g. (!x. cauchy x /\ (!n. (x n) IN closure s) ==> cauchy(g o x)) /\ (!x. x IN s ==> g x = f x)`, SIMP_TAC[GSYM CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED; CLOSED_CLOSURE] THEN REWRITE_TAC[CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE]);; let CAUCHY_CONTINUOUS_EQ_EXTENDS_TO_CLOSURE = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) <=> ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE] THEN SIMP_TAC[CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED; CLOSED_CLOSURE] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_SIMP_TAC[o_DEF] THEN REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[CLOSURE_INC]);; let UNIFORMLY_CONTINUOUS_ON_UNION = prove (`!f:real^M->real^N s t. bounded s /\ bounded t /\ f uniformly_continuous_on t /\ f continuous_on (closure s UNION t) ==> f uniformly_continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED; BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN ASM_CASES_TAC `eventually (\n. (x:num->real^M) n IN t) sequentially` THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVENTUALLY_SEQUENTIALLY]) THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (MP_TAC o GEN `n:num` o SPEC `n + k:num`)) THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD] THEN DISCH_TAC THEN UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on t` THEN ASM_SIMP_TAC[UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED] THEN DISCH_THEN(MP_TAC o SPEC `\n. (x:num->real^M)(n + k)`) THEN UNDISCH_TAC `cauchy(x:num->real^M)` THEN ASM_REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(TAUT `(q <=> p) /\ (r <=> s) ==> p ==> (q ==> r) ==> s`) THEN CONJ_TAC THENL [MP_TAC(SPEC `k:num` (INST_TYPE [`:M`,`:N`] CAUCHY_OFFSET)); MP_TAC(SPEC `k:num` CAUCHY_OFFSET)] THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `{n | (x:num->real^M) n IN s}` INFINITE_ENUMERATE_WEAK) THEN REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[INFINITE] THEN DISCH_THEN(MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EVENTUALLY_SEQUENTIALLY]) THEN REWRITE_TAC[CONTRAPOS_THM; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN ASM_MESON_TAC[IN_UNION; ARITH_RULE `~(n <= N /\ N + 1 <= n)`]; DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `?l. l IN closure s /\ ((\n. (x:num->real^M)(r n)) --> l) sequentially` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `closure s:real^M->bool` complete) THEN REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_CLOSURE] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[CLOSURE_INC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CAUCHY_SUBSEQUENCE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `((x:num->real^M) --> l) sequentially` ASSUME_TAC THENL [MATCH_MP_TAC CAUCHY_CONVERGENT_SUBSEQUENCE THEN EXISTS_TAC `r:num->num` THEN ASM_REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONVERGENT_IMP_CAUCHY THEN EXISTS_TAC `(f:real^M->real^N) l` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_SEQUENTIALLY]) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[IN_UNION; CLOSURE_INC]);; (* ------------------------------------------------------------------------- *) (* A uniformly convergent limit of continuous functions is continuous. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_UNIFORM_LIMIT = prove (`!net f:A->real^M->real^N g s. ~(trivial_limit net) /\ eventually (\n. (f n) continuous_on s) net /\ (!e. &0 < e ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) net) ==> g continuous_on s`, REWRITE_TAC[continuous_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:A` THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `x:real^M`) ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `w <= x + y + z ==> x < e / &3 ==> y < e / &3 ==> z < e / &3 ==> w < e`) THEN REWRITE_TAC[dist] THEN SUBST1_TAC(VECTOR_ARITH `(g:real^M->real^N) y - g x = --(f (a:A) y - g y) + (f a x - g x) + (f a y - f a x)`) THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_LADD] THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_REFL]);; let CONTINUOUS_UNIFORMLY_CAUCHY_LIMIT = prove (`!f:num->real^M->real^N s. eventually (\n. f n continuous_on s) sequentially /\ (!e. &0 < e ==> ?N. !m n x. N <= m /\ N <= n /\ x IN s ==> dist (f m x,f n x) < e) ==> ?g. g continuous_on s /\ (!x. x IN s ==> ((\n. f n x) --> g x) sequentially)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN EXISTS_TAC `f:num->real^M->real^N` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[dist]; REWRITE_TAC[LIM_SEQUENTIALLY] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Topological stuff lifted from and dropped to R *) (* ------------------------------------------------------------------------- *) let OPEN_LIFT = prove (`!s. open(IMAGE lift s) <=> !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`, REWRITE_TAC[open_def; FORALL_LIFT; LIFT_IN_IMAGE_LIFT; DIST_LIFT]);; let LIMPT_APPROACHABLE_LIFT = prove (`!x s. (lift x) limit_point_of (IMAGE lift s) <=> !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e`, REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT; LIFT_EQ; DIST_LIFT]);; let CLOSED_LIFT = prove (`!s. closed (IMAGE lift s) <=> !x. (!e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e) ==> x IN s`, GEN_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN ONCE_REWRITE_TAC[FORALL_LIFT] THEN REWRITE_TAC[LIMPT_APPROACHABLE_LIFT; LIFT_EQ; DIST_LIFT; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT]);; let CONTINUOUS_AT_LIFT_RANGE = prove (`!f x. (lift o f) continuous (at x) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. norm(x' - x) < d ==> abs(f x' - f x) < e)`, REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; let CONTINUOUS_ON_LIFT_RANGE = prove (`!f s. (lift o f) continuous_on s <=> !x. x IN s ==> !e. &0 < e ==> ?d. &0 < d /\ (!x'. x' IN s /\ norm(x' - x) < d ==> abs(f x' - f x) < e)`, REWRITE_TAC[continuous_on; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; let CONTINUOUS_LIFT_NORM_COMPOSE = prove (`!net f:A->real^N. f continuous net ==> (\x. lift(norm(f x))) continuous net`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous; tendsto] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN NORM_ARITH_TAC);; let CONTINUOUS_ON_LIFT_NORM_COMPOSE = prove (`!f:real^M->real^N s. f continuous_on s ==> (\x. lift(norm(f x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_NORM_COMPOSE]);; let CONTINUOUS_AT_LIFT_NORM = prove (`!x. (lift o norm) continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE; NORM_LIFT] THEN MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; let CONTINUOUS_ON_LIFT_NORM = prove (`!s. (lift o norm) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE; NORM_LIFT] THEN MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; let PROPER_MAP_NORM_SIMPLE = prove (`!k. compact k ==> compact {x:real^N | lift(norm x) IN k}`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN MESON_TAC[NORM_LIFT; REAL_ABS_NORM]; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN ASM_REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]);; let PROPER_MAP_NORM = prove (`!s t. closed s ==> !k. k SUBSET t /\ compact k ==> compact {x:real^N | x IN s /\ lift(norm x) IN k}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_SIMP_TAC[PROPER_MAP_NORM_SIMPLE]);; let CLOSED_MAP_NORM = prove (`!s:real^N->bool. closed s ==> closed (IMAGE (lift o norm) s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] PROPER_MAP_NORM) THEN REWRITE_TAC[CLOSED_UNIV] THEN SIMP_TAC[PROPER_MAP; SUBSET_UNIV] THEN ASM_SIMP_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV; o_DEF]);; let CONTINUOUS_AT_LIFT_COMPONENT = prove (`!i a. 1 <= i /\ i <= dimindex(:N) ==> (\x:real^N. lift(x$i)) continuous (at a)`, SIMP_TAC[continuous_at; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; let CONTINUOUS_ON_LIFT_COMPONENT = prove (`!i s. 1 <= i /\ i <= dimindex(:N) ==> (\x:real^N. lift(x$i)) continuous_on s`, SIMP_TAC[continuous_on; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; let CONTINUOUS_AT_LIFT_INFNORM = prove (`!x:real^N. (lift o infnorm) continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT; LIM_AT; o_THM; DIST_LIFT] THEN MESON_TAC[REAL_LET_TRANS; dist; REAL_ABS_SUB_INFNORM; INFNORM_LE_NORM]);; let CONTINUOUS_AT_LIFT_DIST = prove (`!a:real^N x. (lift o (\x. dist(a,x))) continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE] THEN MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; REAL_LET_TRANS]);; let CONTINUOUS_ON_LIFT_DIST = prove (`!a s. (lift o (\x. dist(a,x))) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; REAL_LET_TRANS]);; (* ------------------------------------------------------------------------- *) (* Hence some handy theorems on distance, diameter etc. of/from a set. *) (* ------------------------------------------------------------------------- *) let COMPACT_ATTAINS_SUP = prove (`!s. compact (IMAGE lift s) /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> y <= x`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `sup s` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s <= s - e <=> ~(&0 < e)`; REAL_ARITH `x <= s /\ ~(x <= s - e) ==> abs(x - s) < e`]);; let COMPACT_ATTAINS_INF = prove (`!s. compact (IMAGE lift s) /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> x <= y`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `inf s` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s + e <= s <=> ~(&0 < e)`; REAL_ARITH `s <= x /\ ~(s + e <= x) ==> abs(x - s) < e`]);; let CONTINUOUS_ATTAINS_SUP = prove (`!f:real^N->real s. compact s /\ ~(s = {}) /\ (lift o f) continuous_on s ==> ?x. x IN s /\ !y. y IN s ==> f(y) <= f(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_SUP) THEN ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN MESON_TAC[IN_IMAGE]);; let CONTINUOUS_ATTAINS_INF = prove (`!f:real^N->real s. compact s /\ ~(s = {}) /\ (lift o f) continuous_on s ==> ?x. x IN s /\ !y. y IN s ==> f(x) <= f(y)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_INF) THEN ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN MESON_TAC[IN_IMAGE]);; let DISTANCE_ATTAINS_SUP = prove (`!s a. compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> dist(a,y) <= dist(a,x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN REWRITE_TAC[dist] THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]);; (* ------------------------------------------------------------------------- *) (* For *minimal* distance, we only need closure, not compactness. *) (* ------------------------------------------------------------------------- *) let DISTANCE_ATTAINS_INF = prove (`!s a:real^N. closed s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN MP_TAC(ISPECL [`\x:real^N. dist(a,x)`; `cball(a:real^N,dist(b,a)) INTER s`] CONTINUOUS_ATTAINS_INF) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; BOUNDED_INTER; BOUNDED_CBALL; CLOSED_CBALL; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[dist; CONTINUOUS_ON_LIFT_RANGE; IN_INTER; IN_CBALL] THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; REAL_LE_REFL; NORM_SUB; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_INTER; IN_CBALL] THEN ASM_MESON_TAC[DIST_SYM; REAL_LE_TOTAL; REAL_LE_TRANS]]);; (* ------------------------------------------------------------------------- *) (* We can now extend limit compositions to consider the scalar multiplier. *) (* ------------------------------------------------------------------------- *) let LIM_MUL = prove (`!net:(A)net f l:real^N c d. ((lift o c) --> lift d) net /\ (f --> l) net ==> ((\x. c(x) % f(x)) --> (d % l)) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `\x (y:real^N). drop x % y`; `lift o (c:A->real)`; `f:A->real^N`; `lift d`; `l:real^N`] LIM_BILINEAR) THEN ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let LIM_LIFT_POW = prove (`!net:(A)net f l n. ((\a. lift(f a)) --> lift l) net ==> ((\a. lift(f(a) pow n)) --> lift(l pow n)) net`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; LIM_CONST; LIFT_CMUL] THEN MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[o_DEF]);; let LIM_LIFT_PRODUCT = prove (`!net:(A)net f g (t:B->bool). FINITE t /\ (!i. i IN t ==> ((\x. lift(f x i)) --> lift(g i)) net) ==> ((\x. lift(product t (f x))) --> lift(product t g)) net`, REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN REWRITE_TAC[LIM_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN ASM_SIMP_TAC[o_DEF]);; let LIM_VMUL = prove (`!net:(A)net c d v:real^N. ((lift o c) --> lift d) net ==> ((\x. c(x) % v) --> d % v) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[LIM_CONST]);; let CONTINUOUS_VMUL = prove (`!net c v. (lift o c) continuous net ==> (\x. c(x) % v) continuous net`, REWRITE_TAC[continuous; LIM_VMUL; o_THM]);; let CONTINUOUS_MUL = prove (`!net f c. (lift o c) continuous net /\ f continuous net ==> (\x. c(x) % f(x)) continuous net`, REWRITE_TAC[continuous; LIM_MUL; o_THM]);; let CONTINUOUS_ON_VMUL = prove (`!s c v. (lift o c) continuous_on s ==> (\x. c(x) % v) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_VMUL]);; let CONTINUOUS_ON_MUL = prove (`!s c f. (lift o c) continuous_on s /\ f continuous_on s ==> (\x. c(x) % f(x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_MUL]);; let CONTINUOUS_LIFT_POW = prove (`!net f:A->real n. (\x. lift(f x)) continuous net ==> (\x. lift(f x pow n)) continuous net`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[o_DEF]);; let CONTINUOUS_ON_LIFT_POW = prove (`!f:real^N->real s n. (\x. lift(f x)) continuous_on s ==> (\x. lift(f x pow n)) continuous_on s`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF]);; let CONTINUOUS_LIFT_PRODUCT = prove (`!net:(A)net f (t:B->bool). FINITE t /\ (!i. i IN t ==> (\x. lift(f x i)) continuous net) ==> (\x. lift(product t (f x))) continuous net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN REWRITE_TAC[CONTINUOUS_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_SIMP_TAC[o_DEF]);; let CONTINUOUS_ON_LIFT_PRODUCT = prove (`!f:real^N->A->real s t. FINITE t /\ (!i. i IN t ==> (\x. lift(f x i)) continuous_on s) ==> (\x. lift(product t (f x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_PRODUCT]);; (* ------------------------------------------------------------------------- *) (* And so we have continuity of inverse. *) (* ------------------------------------------------------------------------- *) let LIM_INV = prove (`!net:(A)net f l. ((lift o f) --> lift l) net /\ ~(l = &0) ==> ((lift o inv o f) --> lift(inv l)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_THM; DIST_LIFT] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (abs(l) / &2) ((l pow 2 * e) / &2)`) THEN REWRITE_TAC[REAL_LT_MIN] THEN ANTS_TAC THENL [ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:A` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `b:A` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `abs(x - l) * &2 < abs l ==> ~(x = &0)`)) THEN ASM_SIMP_TAC[REAL_SUB_INV; REAL_ABS_DIV; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ; REAL_ENTIRE] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(x - y) * &2 < b * c ==> c * b <= d * &2 ==> abs(y - x) < d`)) THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_POW_2; REAL_MUL_ASSOC; GSYM REAL_ABS_NZ; REAL_LE_RMUL_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `abs(x - y) * &2 < abs y ==> abs y <= &2 * abs x`]);; let CONTINUOUS_INV = prove (`!net f. (lift o f) continuous net /\ ~(f(netlimit net) = &0) ==> (lift o inv o f) continuous net`, REWRITE_TAC[continuous; LIM_INV; o_THM]);; let CONTINUOUS_AT_WITHIN_INV = prove (`!f s a:real^N. (lift o f) continuous (at a within s) /\ ~(f a = &0) ==> (lift o inv o f) continuous (at a within s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `trivial_limit (at (a:real^N) within s)` THENL [ASM_REWRITE_TAC[continuous; LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN; CONTINUOUS_INV]]);; let CONTINUOUS_AT_INV = prove (`!f a. (lift o f) continuous at a /\ ~(f a = &0) ==> (lift o inv o f) continuous at a`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_AT_WITHIN_INV]);; let CONTINUOUS_ON_INV = prove (`!f s. (lift o f) continuous_on s /\ (!x. x IN s ==> ~(f x = &0)) ==> (lift o inv o f) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN_INV]);; (* ------------------------------------------------------------------------- *) (* More preservation properties for pasted sets (Cartesian products). *) (* ------------------------------------------------------------------------- *) let LIM_PASTECART = prove (`!net f:A->real^M g:A->real^N. (f --> a) net /\ (g --> b) net ==> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REWRITE_TAC[dist; PASTECART_SUB] THEN MATCH_MP_TAC(REAL_ARITH `z <= x + y ==> x < e / &2 /\ y < e / &2 ==> z < e`) THEN REWRITE_TAC[NORM_PASTECART_LE]);; let LIM_PASTECART_EQ = prove (`!net f:A->real^M g:A->real^N. ((\x. pastecart (f x) (g x)) --> pastecart a b) net <=> (f --> a) net /\ (g --> b) net`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LIM_PASTECART] THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN REWRITE_TAC[LINEAR_FSTCART; FSTCART_PASTECART; ETA_AX]; FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN REWRITE_TAC[LINEAR_SNDCART; SNDCART_PASTECART; ETA_AX]]);; let CONTINUOUS_PASTECART = prove (`!net f:A->real^M g:A->real^N. f continuous net /\ g continuous net ==> (\x. pastecart (f x) (g x)) continuous net`, REWRITE_TAC[continuous; LIM_PASTECART]);; let CONTINUOUS_ON_PASTECART = prove (`!f:real^M->real^N g:real^M->real^P s. f continuous_on s /\ g continuous_on s ==> (\x. pastecart (f x) (g x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON; LIM_PASTECART]);; let CONTINUOUS_FSTCART = prove (`!net f:A->real^(M,N)finite_sum. f continuous net ==> (\x. fstcart(f x)) continuous net`, SIMP_TAC[LINEAR_CONTINUOUS_COMPOSE; LINEAR_FSTCART]);; let CONTINUOUS_SNDCART = prove (`!net f:A->real^(M,N)finite_sum. f continuous net ==> (\x. sndcart(f x)) continuous net`, SIMP_TAC[LINEAR_CONTINUOUS_COMPOSE; LINEAR_SNDCART]);; let CONTINUOUS_ON_FSTCART = prove (`!f:real^M->real^(N,P)finite_sum. f continuous_on s ==> (\x. fstcart(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_FSTCART]);; let CONTINUOUS_ON_SNDCART = prove (`!f:real^M->real^(N,P)finite_sum. f continuous_on s ==> (\x. sndcart(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SNDCART]);; let CONNECTED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. connected s /\ connected t ==> connected (s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; CONNECTED_IFF_CONNECTED_COMPONENT] THEN DISCH_TAC THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`]) (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; connected_component] THEN X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `c1:real^M->bool` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (\x:real^M. pastecart x y1) c1 UNION IMAGE (\y:real^N. pastecart x2 y) c2` THEN REWRITE_TAC[IN_UNION] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; EXISTS_IN_IMAGE] THEN EXISTS_TAC `x2:real^M` THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_UNION; FORALL_AND_THM; FORALL_IN_IMAGE; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]);; let CONNECTED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. connected (s PCROSS t) <=> s = {} \/ t = {} \/ connected s /\ connected t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[PCROSS_EMPTY; CONNECTED_EMPTY] THEN EQ_TAC THEN SIMP_TAC[CONNECTED_PCROSS] THEN REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `connected (IMAGE fstcart {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]; SUBGOAL_THEN `connected (IMAGE sndcart {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_PCROSS = prove (`!s t a:real^M b:real^N. connected_component (s PCROSS t) (pastecart a b) = connected_component s a PCROSS connected_component t b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^M) IN s /\ (b:real^N) IN t` THENL [MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN REWRITE_TAC[PASTECART_IN_PCROSS; SUBSET_PCROSS; CONNECTED_PCROSS_EQ] THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN X_GEN_TAC `c:real^(M,N)finite_sum->bool` THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN CONJ_TAC THENL [EXISTS_TAC `IMAGE fstcart (c:real^(M,N)finite_sum->bool)`; EXISTS_TAC `IMAGE sndcart (c:real^(M,N)finite_sum->bool)`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PASTECART; EXISTS_PASTECART; IN_IMAGE] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN REWRITE_TAC[PCROSS_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY] THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[]]);; let COMPONENTS_PCROSS = prove (`!s:real^M->bool t:real^N->bool. components(s PCROSS t) = {c PCROSS d | c IN components s /\ d IN components t}`, REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ABS_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN REWRITE_TAC[CONNECTED_COMPONENT_PCROSS] THEN REWRITE_TAC[SET_RULE `{f x y | x IN IMAGE g s /\ y IN IMAGE h t} = {f (g x) (h y) | x IN s /\ y IN t}`] THEN REWRITE_TAC[PCROSS; GSYM SIMPLE_IMAGE; SET_RULE `{f z | z IN {g x y | P x y}} = {f(g x y) | P x y}`] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);; let CLOSURE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. closure (s PCROSS t) = (closure s) PCROSS (closure t)`, REWRITE_TAC[EXTENSION; PCROSS; FORALL_PASTECART] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CLOSURE_APPROACHABLE; EXISTS_PASTECART; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[dist; PASTECART_SUB] THEN EQ_TAC THENL [MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; DISCH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; let LIMPT_PCROSS = prove (`!s:real^M->bool t:real^N->bool x y. x limit_point_of s /\ y limit_point_of t ==> (pastecart x y) limit_point_of (s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; LIMPT_APPROACHABLE; EXISTS_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ; dist; PASTECART_SUB] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; let CLOSED_IN_PCROSS = prove (`!s:real^M->bool s' t:real^N->bool t'. closed_in (subtopology euclidean s) s' /\ closed_in (subtopology euclidean t) t' ==> closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN ASM_SIMP_TAC[CLOSED_PCROSS; EXTENSION; FORALL_PASTECART] THEN REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; let CLOSED_IN_PCROSS_EQ = prove (`!s s':real^M->bool t t':real^N->bool. closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> s' = {} \/ t' = {} \/ closed_in (subtopology euclidean s) s' /\ closed_in (subtopology euclidean t) t'`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s':real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN ASM_CASES_TAC `t':real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[CLOSED_IN_PCROSS] THEN ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; CLOSURE_PCROSS; INTER_PCROSS; PCROSS_EQ; PCROSS_EQ_EMPTY]);; let FRONTIER_PCROSS = prove (`!s:real^M->bool t:real^N->bool. frontier(s PCROSS t) = frontier s PCROSS closure t UNION closure s PCROSS frontier t`, REPEAT GEN_TAC THEN REWRITE_TAC[frontier; CLOSURE_PCROSS; INTERIOR_PCROSS; PCROSS_DIFF] THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; IN_UNION; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence some useful properties follow quite easily. *) (* ------------------------------------------------------------------------- *) let CONNECTED_SCALING = prove (`!s:real^N->bool c. connected s ==> connected (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let CONNECTED_NEGATIONS = prove (`!s:real^N->bool. connected s ==> connected (IMAGE (--) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let CONNECTED_SCALING_EQ = prove (`!s:real^N->bool c. connected (IMAGE (\x. c % x) s) <=> c = &0 \/ connected s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[CONNECTED_SING; CONNECTED_EMPTY]; EQ_TAC THEN REWRITE_TAC[CONNECTED_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP CONNECTED_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let CONNECTED_AFFINITY_EQ = prove (`!s m c:real^N. connected (IMAGE (\x. m % x + c) s) <=> m = &0 \/ connected s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; CONNECTED_TRANSLATION_EQ; CONNECTED_SCALING_EQ; IMAGE_o]);; let CONNECTED_AFFINITY = prove (`!s m c:real^N. connected s ==> connected (IMAGE (\x. m % x + c) s)`, SIMP_TAC[CONNECTED_AFFINITY_EQ]);; let CONNECTED_SUMS = prove (`!s t:real^N->bool. connected s /\ connected t ==> connected {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_PCROSS) THEN DISCH_THEN(MP_TAC o ISPEC `\z. (fstcart z + sndcart z:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; PCROSS] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]);; let COMPACT_SCALING = prove (`!s:real^N->bool c. compact s ==> compact (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let COMPACT_SCALING_EQ = prove (`!s:real^N->bool c. compact (IMAGE (\x. c % x) s) <=> c = &0 \/ compact s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[COMPACT_SING; COMPACT_EMPTY]; EQ_TAC THEN REWRITE_TAC[COMPACT_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP COMPACT_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let COMPACT_NEGATIONS = prove (`!s:real^N->bool. compact s ==> compact (IMAGE (--) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let COMPACT_SUMS = prove (`!s:real^N->bool t. compact s /\ compact t ==> compact {x + y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x + y | x IN s /\ y IN t} = IMAGE (\z. fstcart z + sndcart z :real^N) (s PCROSS t)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; PCROSS] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_FST_SND]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_PCROSS] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; SNDCART_CMUL] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let COMPACT_DIFFERENCES = prove (`!s:real^N->bool t. compact s /\ compact t ==> compact {x - y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = {x + y | x IN s /\ y IN (IMAGE (--) t)}` (fun th -> ASM_SIMP_TAC[th; COMPACT_SUMS; COMPACT_NEGATIONS]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN MESON_TAC[VECTOR_NEG_NEG]);; let COMPACT_AFFINITY_EQ = prove (`!s m c:real^N. compact (IMAGE (\x. m % x + c) s) <=> m = &0 \/ compact s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; COMPACT_TRANSLATION_EQ; COMPACT_SCALING_EQ; IMAGE_o]);; let COMPACT_AFFINITY = prove (`!s m c:real^N. compact s ==> compact (IMAGE (\x. m % x + c) s)`, SIMP_TAC[COMPACT_AFFINITY_EQ]);; (* ------------------------------------------------------------------------- *) (* Hence we get the following. *) (* ------------------------------------------------------------------------- *) let COMPACT_SUP_MAXDISTANCE = prove (`!s:real^N->bool. compact s /\ ~(s = {}) ==> ?x y. x IN s /\ y IN s /\ !u v. u IN s /\ v IN s ==> norm(u - v) <= norm(x - y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN s}`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_DIFFERENCES] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]; REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; NORM_NEG] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* We can state this in terms of diameter of a set. *) (* ------------------------------------------------------------------------- *) let diameter = new_definition `diameter s = if s = {} then &0 else sup {norm(x - y) | x IN s /\ y IN s}`;; let DIAMETER_BOUNDED = prove (`!s. bounded s ==> (!x:real^N y. x IN s /\ y IN s ==> norm(x - y) <= diameter s) /\ (!d. &0 <= d /\ d < diameter s ==> ?x y. x IN s /\ y IN s /\ norm(x - y) > d)`, GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[diameter; NOT_IN_EMPTY; REAL_LET_ANTISYM] THEN MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN ABBREV_TAC `b = sup {norm(x - y:real^N) | x IN s /\ y IN s}` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[NOT_IN_EMPTY; real_gt] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC]; MESON_TAC[REAL_NOT_LE]] THEN SIMP_TAC[VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN MESON_TAC[REAL_ARITH `x <= y + z /\ y <= b /\ z<= b ==> x <= b + b`; NORM_TRIANGLE; NORM_NEG]);; let DIAMETER_BOUNDED_BOUND = prove (`!s x y. bounded s /\ x IN s /\ y IN s ==> norm(x - y) <= diameter s`, MESON_TAC[DIAMETER_BOUNDED]);; let DIAMETER_COMPACT_ATTAINED = prove (`!s:real^N->bool. compact s /\ ~(s = {}) ==> ?x y. x IN s /\ y IN s /\ (norm(x - y) = diameter s)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_SUP_MAXDISTANCE) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `s:real^N->bool` DIAMETER_BOUNDED) THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPACT_EQ_BOUNDED_CLOSED]) THEN ASM_REWRITE_TAC[real_gt] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_MESON_TAC[NORM_POS_LE; REAL_NOT_LT]);; let DIAMETER_TRANSLATION = prove (`!a s. diameter (IMAGE (\x. a + x) s) = diameter s`, REWRITE_TAC[diameter] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [DIAMETER_TRANSLATION];; let DIAMETER_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x. norm(f x) = norm x) ==> diameter(IMAGE f s) = diameter s`, REWRITE_TAC[diameter] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[diameter; IMAGE_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN ASM_MESON_TAC[LINEAR_SUB]);; add_linear_invariants [DIAMETER_LINEAR_IMAGE];; let DIAMETER_EMPTY = prove (`diameter {} = &0`, REWRITE_TAC[diameter]);; let DIAMETER_SING = prove (`!a. diameter {a} = &0`, REWRITE_TAC[diameter; NOT_INSERT_EMPTY; IN_SING] THEN REWRITE_TAC[SET_RULE `{f x y | x = a /\ y = a} = {f a a }`] THEN REWRITE_TAC[SUP_SING; VECTOR_SUB_REFL; NORM_0]);; let DIAMETER_POS_LE = prove (`!s:real^N->bool. bounded s ==> &0 <= diameter s`, REPEAT STRIP_TAC THEN REWRITE_TAC[diameter] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN EXISTS_TAC `&2 * B` THEN ASM_SIMP_TAC[NORM_ARITH `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a:real^N`] o CONJUNCT1) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0]]);; let DIAMETER_SUBSET = prove (`!s t:real^N->bool. s SUBSET t /\ bounded t ==> diameter s <= diameter t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[DIAMETER_EMPTY; DIAMETER_POS_LE] THEN ASM_REWRITE_TAC[diameter] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN EXISTS_TAC `&2 * B` THEN ASM_SIMP_TAC[NORM_ARITH `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]);; let DIAMETER_CLOSURE = prove (`!s:real^N->bool. diameter(closure s) = diameter s`, GEN_TAC THEN ASM_CASES_TAC `bounded(s:real^N->bool)` THENL [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_CLOSURE; CLOSURE_SUBSET] THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_BOUNDED) THEN ABBREV_TAC `d = diameter(closure s) - diameter(s:real^N->bool)` THEN ASM_SIMP_TAC[BOUNDED_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `diameter(closure(s:real^N->bool)) - d / &2` o CONJUNCT2) THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; NOT_EXISTS_THM] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIAMETER_POS_LE) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[CLOSURE_APPROACHABLE; CONJ_ASSOC; AND_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `d / &4`) ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < d / &4 <=> &0 < d`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) (X_CHOOSE_THEN `v:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIAMETER_BOUNDED) THEN DISCH_THEN(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; REWRITE_TAC[diameter; CLOSURE_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUP_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC(MESON[] `(!a b. P a ==> ~(Q b a)) /\ (!a b. P a ==> ~(R b a)) ==> (?x. P x) ==> !b. (!x. Q b x) <=> (!x. R b x)`) THEN SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; GSYM NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[NORM_ARITH `norm(a - y:real^N) = norm(--a + y)`] THEN ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s ==> norm(a + x:real^N) <= b) <=> (!x. x IN IMAGE (\x. a + x) s ==> norm(x) <= b)`] THEN ASM_REWRITE_TAC[GSYM bounded; BOUNDED_TRANSLATION_EQ; BOUNDED_CLOSURE_EQ]]);; let DIAMETER_SUBSET_CBALL_NONEMPTY = prove (`!s:real^N->bool. bounded s /\ ~(s = {}) ==> ?z. z IN s /\ s SUBSET cball(z,diameter s)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN ASM_MESON_TAC[DIAMETER_BOUNDED]);; let DIAMETER_SUBSET_CBALL = prove (`!s:real^N->bool. bounded s ==> ?z. s SUBSET cball(z,diameter s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_MESON_TAC[DIAMETER_SUBSET_CBALL_NONEMPTY; EMPTY_SUBSET]);; let DIAMETER_EQ_0 = prove (`!s:real^N->bool. bounded s ==> (diameter s = &0 <=> s = {} \/ ?a. s = {a})`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY; DIAMETER_SING] THEN REWRITE_TAC[SET_RULE `s = {} \/ (?a. s = {a}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`] DIAMETER_BOUNDED_BOUND) THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let DIAMETER_LE = prove (`!s:real^N->bool. (~(s = {}) \/ &0 <= d) /\ (!x y. x IN s /\ y IN s ==> norm(x - y) <= d) ==> diameter s <= d`, GEN_TAC THEN REWRITE_TAC[diameter] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FORALL_IN_GSPEC]]);; let BOUNDED_AND_DIAMETER_LE = prove (`!s:real^N->bool r. bounded s /\ diameter s <= r <=> &0 <= r /\ !x y. x IN s /\ y IN s ==> dist(x,y) <= r`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= r` THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[DIAMETER_POS_LE; REAL_LE_TRANS]] THEN EQ_TAC THENL [MESON_TAC[DIAMETER_BOUNDED_BOUND; dist; REAL_LE_TRANS]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [ALL_TAC; MATCH_MP_TAC DIAMETER_LE THEN ASM_REWRITE_TAC[GSYM dist]] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(a:real^N,r)` THEN ASM_SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL; dist]);; let DIST_LE_DIAMETER = prove (`!s a b:real^N. bounded s /\ a IN s /\ b IN s ==> dist(a,b) <= diameter s`, MESON_TAC[BOUNDED_AND_DIAMETER_LE; REAL_LE_REFL]);; let DIAMETER_CBALL = prove (`!a:real^N r. diameter(cball(a,r)) = if r < &0 then &0 else &2 * r`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ASM_MESON_TAC[CBALL_EQ_EMPTY; DIAMETER_EMPTY]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LE_MUL; REAL_POS; REAL_NOT_LT] THEN REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm((a + r % basis 1) - (a - r % basis 1):real^N)` THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `(a + r % b) - (a - r % b:real^N) = (&2 * r) % b`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN REWRITE_TAC[BOUNDED_CBALL; IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b /\ dist(a,a - b) = norm b`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC]]);; let DIAMETER_BALL = prove (`!a:real^N r. diameter(ball(a,r)) = if r < &0 then &0 else &2 * r`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; DIAMETER_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; DIAMETER_EMPTY; REAL_MUL_RZERO] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `diameter(cball(a:real^N,r))` THEN CONJ_TAC THENL [SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CLOSURE_BALL; DIAMETER_CLOSURE; BOUNDED_BALL]; ASM_SIMP_TAC[DIAMETER_CBALL]]);; let DIAMETER_SCALING = prove (`!a s:real^N->bool. bounded s ==> diameter(IMAGE (\x. a % x) s) = abs a * diameter s`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIAMETER_EMPTY; IMAGE_CLAUSES; REAL_MUL_RZERO] THEN ASM_CASES_TAC `a = &0` THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; SET_RULE `~(s = {}) ==> IMAGE (\x. a) s = {a}`] THEN REWRITE_TAC[DIAMETER_SING; REAL_ABS_NUM; REAL_MUL_LZERO] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN CONJ_TAC THEN MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[DIAMETER_POS_LE; REAL_LE_MUL; REAL_ABS_POS] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THENL [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_ABS_NZ] THEN ASM_MESON_TAC[DIAMETER_BOUNDED_BOUND]; ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL; VECTOR_SUB_LDISTRIB] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_SIMP_TAC[BOUNDED_SCALING] THEN ASM SET_TAC[]]);; let DIAMETER_AFFINITY = prove (`!s m c:real^N. bounded s ==> diameter(IMAGE (\x. m % x + c) s) = abs m * diameter s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; IMAGE_o; DIAMETER_TRANSLATION] THEN REWRITE_TAC[DIAMETER_SCALING]);; let DIAMETER_SUMS = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> diameter {x + y | x IN s /\ y IN t} <= diameter s + diameter t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; DIAMETER_EMPTY; REAL_ADD_LID; DIAMETER_POS_LE] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; DIAMETER_EMPTY; REAL_ADD_RID; DIAMETER_POS_LE] THEN MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(x - x') <= s /\ norm(y - y') <= t ==> norm((x + y) - (x' + y'):real^N) <= s + t`) THEN ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND]);; let DIAMETER_LE_SUMS_RIGHT = prove (`!s t:real^N->bool. ~(t = {}) /\ bounded s /\ bounded t ==> diameter s <= diameter {x + y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[DIAMETER_POS_LE; BOUNDED_SUMS] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN SUBST1_TAC(VECTOR_ARITH `x - y:real^N = (x + z) - (y + z)`) THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_SIMP_TAC[BOUNDED_SUMS] THEN ASM SET_TAC[]);; let DIAMETER_LE_SUMS_LEFT = prove (`!s t:real^N->bool. ~(s = {}) /\ bounded s /\ bounded t ==> diameter t <= diameter {x + y | x IN s /\ y IN t}`, ONCE_REWRITE_TAC[SUMS_SYM] THEN SIMP_TAC[DIAMETER_LE_SUMS_RIGHT]);; let DIAMETER_UNION_LE = prove (`!s t:real^N->bool. bounded s /\ bounded t /\ ~(s INTER t = {}) ==> diameter(s UNION t) <= diameter s + diameter t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[REAL_LE_ADD; DIAMETER_POS_LE; IN_UNION] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x <= a /\ &0 <= b ==> x <= a + b`) THEN ASM_SIMP_TAC[DIAMETER_POS_LE]; MATCH_MP_TAC(NORM_ARITH `norm(x - z:real^N) <= s /\ norm(y - z) <= t ==> norm(x - y) <= s + t`) THEN CONJ_TAC; MATCH_MP_TAC(NORM_ARITH `norm(x - z:real^N) <= t /\ norm(y - z) <= s ==> norm(x - y) <= s + t`) THEN CONJ_TAC; MATCH_MP_TAC(REAL_ARITH `x <= b /\ &0 <= a ==> x <= a + b`) THEN ASM_SIMP_TAC[DIAMETER_POS_LE]] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_REWRITE_TAC[]);; let LEBESGUE_COVERING_LEMMA = prove (`!s:real^N->bool c. compact s /\ ~(c = {}) /\ s SUBSET UNIONS c /\ (!b. b IN c ==> open b) ==> ?d. &0 < d /\ !t. t SUBSET s /\ diameter t <= d ==> ?b. b IN c /\ t SUBSET b`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN DISCH_THEN(MP_TAC o SPEC `c:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `t:real^N->bool` DIAMETER_SUBSET_CBALL_NONEMPTY) THEN ANTS_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(x:real^N,diameter(t:real^N->bool))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN MAP_EVERY UNDISCH_TAC [`&0 < e`; `diameter(t:real^N->bool) <= e / &2`] THEN NORM_ARITH_TAC);; let LEBESGUE_COVERING_LEMMA_GEN = prove (`!u s c:(real^N->bool)->bool. compact s /\ ~(c = {}) /\ s SUBSET UNIONS c /\ (!b. b IN c ==> open_in (subtopology euclidean u) b) ==> ?d. &0 < d /\ !t. t SUBSET s /\ diameter t <= d ==> ?b. b IN c /\ t SUBSET b`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV) [OPEN_IN_OPEN]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:(real^N->bool)->(real^N->bool)` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN MP_TAC(ISPECL[`s:real^N->bool`; `IMAGE (t:(real^N->bool)->(real^N->bool)) c`] LEBESGUE_COVERING_LEMMA) THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Related results with closure as the conclusion. *) (* ------------------------------------------------------------------------- *) let CLOSED_SCALING = prove (`!s:real^N->bool c. closed s ==> closed (IMAGE (\x. c % x) s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s :real^N->bool = {}` THEN ASM_REWRITE_TAC[CLOSED_EMPTY; IMAGE_CLAUSES] THEN ASM_CASES_TAC `c = &0` THENL [SUBGOAL_THEN `IMAGE (\x:real^N. c % x) s = {(vec 0)}` (fun th -> REWRITE_TAC[th; CLOSED_SING]) THEN ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING; VECTOR_MUL_LZERO] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_IMAGE; SKOLEM_THM] THEN STRIP_TAC THEN X_GEN_TAC `x:num->real^N` THEN X_GEN_TAC `l:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` MP_TAC) THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN EXISTS_TAC `inv(c) % l :real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n:num. inv(c) % x n:real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; MATCH_MP_TAC LIM_CMUL THEN FIRST_ASSUM(fun th -> REWRITE_TAC[SYM(SPEC_ALL th)]) THEN ASM_REWRITE_TAC[ETA_AX]]);; let CLOSED_NEGATIONS = prove (`!s:real^N->bool. closed s ==> closed (IMAGE (--) s)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x:real^N. --(&1) % x) s` SUBST1_TAC THEN SIMP_TAC[CLOSED_SCALING] THEN REWRITE_TAC[VECTOR_ARITH `--(&1) % x = --x`] THEN REWRITE_TAC[ETA_AX]);; let COMPACT_CLOSED_SUMS = prove (`!s:real^N->bool t. compact s /\ closed t ==> closed {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[compact; IN_ELIM_THM; CLOSED_SEQUENTIAL_LIMITS] THEN STRIP_TAC THEN X_GEN_TAC `f:num->real^N` THEN X_GEN_TAC `l:real^N` THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl) o SPEC `a:num->real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `la:real^N` (X_CHOOSE_THEN `sub:num->num` STRIP_ASSUME_TAC)) THEN MAP_EVERY EXISTS_TAC [`la:real^N`; `l - la:real^N`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + (b - a) = b:real^N`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n. (f o (sub:num->num)) n - (a o sub) n:real^N` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[VECTOR_ADD_SUB; o_THM]; ALL_TAC] THEN MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; ETA_AX]);; let CLOSED_COMPACT_SUMS = prove (`!s:real^N->bool t. closed s /\ compact t ==> closed {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `{x + y:real^N | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}` SUBST1_TAC THEN SIMP_TAC[COMPACT_CLOSED_SUMS] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);; let CLOSURE_SUMS = prove (`!s t:real^N->bool. bounded s \/ bounded t ==> closure {x + y | x IN s /\ y IN t} = {x + y | x IN closure s /\ y IN closure t}`, REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; CLOSURE_SEQUENTIAL] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL [REWRITE_TAC[IN_ELIM_THM; IN_DELETE; SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[FORALL_AND_THM] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN ONCE_REWRITE_TAC[MESON[] `(?f x y. P f x y) <=> (?x y f. P f x y)`] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[ETA_AX; UNWIND_THM2] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` compact) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `r:num->num`] THEN STRIP_TAC THEN EXISTS_TAC `z - u:real^N` THEN EXISTS_TAC `(a:num->real^N) o (r:num->num)` THEN EXISTS_TAC `u:real^N` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN EXISTS_TAC `(\n. ((\n. a n + b n) o (r:num->num)) n - (a o r) n) :num->real^N` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(a + b) - a:real^N = b`]; MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `a:num->real^N`; `b:num->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `(\n. a n + b n):num->real^N` THEN ASM_SIMP_TAC[LIM_ADD] THEN ASM_MESON_TAC[]]);; let COMPACT_CLOSED_DIFFERENCES = prove (`!s:real^N->bool t. compact s /\ closed t ==> closed {x - y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = {x + y | x IN s /\ y IN (IMAGE (--) t)}` (fun th -> ASM_SIMP_TAC[th; COMPACT_CLOSED_SUMS; CLOSED_NEGATIONS]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN MESON_TAC[VECTOR_NEG_NEG]);; let CLOSED_COMPACT_DIFFERENCES = prove (`!s:real^N->bool t. closed s /\ compact t ==> closed {x - y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = {x + y | x IN s /\ y IN (IMAGE (--) t)}` (fun th -> ASM_SIMP_TAC[th; CLOSED_COMPACT_SUMS; COMPACT_NEGATIONS]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN MESON_TAC[VECTOR_NEG_NEG]);; let CLOSED_TRANSLATION_EQ = prove (`!a s. closed (IMAGE (\x:real^N. a + x) s) <=> closed s`, REWRITE_TAC[closed] THEN GEOM_TRANSLATE_TAC[]);; let CLOSED_TRANSLATION = prove (`!s a:real^N. closed s ==> closed (IMAGE (\x. a + x) s)`, REWRITE_TAC[CLOSED_TRANSLATION_EQ]);; add_translation_invariants [CLOSED_TRANSLATION_EQ];; let COMPLETE_TRANSLATION_EQ = prove (`!a s. complete(IMAGE (\x:real^N. a + x) s) <=> complete s`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_TRANSLATION_EQ]);; add_translation_invariants [COMPLETE_TRANSLATION_EQ];; let CLOSED_SCALING_EQ = prove (`!s:real^N->bool c. closed (IMAGE (\x. c % x) s) <=> c = &0 \/ closed s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN MESON_TAC[CLOSED_SING; CLOSED_EMPTY]; EQ_TAC THEN REWRITE_TAC[CLOSED_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP CLOSED_SCALING) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let CLOSED_AFFINITY_EQ = prove (`!s m c:real^N. closed (IMAGE (\x. m % x + c) s) <=> m = &0 \/ closed s`, REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; CLOSED_TRANSLATION_EQ; CLOSED_SCALING_EQ; IMAGE_o]);; let CLOSED_AFFINITY = prove (`!s m c:real^N. closed s ==> closed (IMAGE (\x. m % x + c) s)`, SIMP_TAC[CLOSED_AFFINITY_EQ]);; let TRANSLATION_DIFF = prove (`!s t:real^N->bool. IMAGE (\x. a + x) (s DIFF t) = (IMAGE (\x. a + x) s) DIFF (IMAGE (\x. a + x) t)`, REWRITE_TAC[EXTENSION; IN_DIFF; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = a + y <=> y = x - a`] THEN REWRITE_TAC[UNWIND_THM2]);; let CLOSURE_TRANSLATION = prove (`!a s. closure(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (closure s)`, REWRITE_TAC[CLOSURE_INTERIOR] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [CLOSURE_TRANSLATION];; let FRONTIER_TRANSLATION = prove (`!a s. frontier(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (frontier s)`, REWRITE_TAC[frontier] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [FRONTIER_TRANSLATION];; let DIAMETER_LT_SUMS_RIGHT = prove (`!s t:real^N->bool. ~(s = {}) /\ ~(?a. t SUBSET {a}) /\ bounded s /\ bounded t ==> diameter s < diameter {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[GSYM DIAMETER_CLOSURE] THEN SIMP_TAC[CLOSURE_SUMS] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {}) /\ ~(?a. t SUBSET {a}) ==> s SUBSET closure s /\ t SUBSET closure t ==> ~(closure s = {}) /\ ~(?a. closure t SUBSET {a})`)) THEN REWRITE_TAC[CLOSURE_SUBSET; IMP_IMP; GSYM CONJ_ASSOC] THEN MAP_EVERY SPEC_TAC [`closure t:real^N->bool`,`t:real^N->bool`; `closure s:real^N->bool`,`s:real^N->bool`] THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?a b:real^N. a IN t /\ b IN t /\ ~(a = b)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `{x + y:real^N | x IN s /\ y IN t}` DIAMETER_BOUNDED_BOUND) THEN ASM_SIMP_TAC[BOUNDED_SUMS; COMPACT_IMP_BOUNDED; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN MP_TAC(ISPEC `s:real^N->bool` DIAMETER_COMPACT_ATTAINED) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN DISCH_THEN(fun th -> MP_TAC(ISPECL [`x:real^N`; `a:real^N`; `y:real^N`; `b:real^N`] th) THEN MP_TAC(ISPECL [`x:real^N`; `b:real^N`; `y:real^N`; `a:real^N`] th)) THEN ASM_REWRITE_TAC[VECTOR_ARITH `(x + a) - (y + b):real^N = (x - y) + (a - b)`] THEN MP_TAC(ISPECL [`x - y:real^N`; `b - a:real^N`] NORM_INCREASES_ONLINE) THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `(x - y) - (b - a):real^N = (x - y) + (a - b)`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LT]) THEN SPEC_TAC(`diameter {x + y:real^N | x IN s /\ y IN t}`,`d:real`) THEN ASM_REAL_ARITH_TAC);; let DIAMETER_LT_SUMS_LEFT = prove (`!s t:real^N->bool. ~(?a. s SUBSET {a}) /\ ~(t = {}) /\ bounded s /\ bounded t ==> diameter t < diameter {x + y | x IN s /\ y IN t}`, ONCE_REWRITE_TAC[SUMS_SYM] THEN SIMP_TAC[DIAMETER_LT_SUMS_RIGHT]);; (* ------------------------------------------------------------------------- *) (* Separation between points and sets. *) (* ------------------------------------------------------------------------- *) let SEPARATE_POINT_CLOSED = prove (`!s a:real^N. closed s /\ ~(a IN s) ==> ?d. &0 < d /\ !x. x IN s ==> d <= dist(a,x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN EXISTS_TAC `dist(a:real^N,b)` THEN ASM_MESON_TAC[DIST_POS_LT]);; let SEPARATE_COMPACT_CLOSED = prove (`!s t:real^N->bool. compact s /\ closed t /\ s INTER t = {} ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] SEPARATE_POINT_CLOSED) THEN ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `vec 0 = x - y <=> x = y`] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MESON_TAC[NORM_ARITH `dist(vec 0,x - y) = dist(x,y)`]);; let SEPARATE_CLOSED_COMPACT = prove (`!s t:real^N->bool. closed s /\ compact t /\ s INTER t = {} ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, ONCE_REWRITE_TAC[DIST_SYM; INTER_COMM] THEN MESON_TAC[SEPARATE_COMPACT_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Representing sets as the union of a chain of compact sets. *) (* ------------------------------------------------------------------------- *) let CLOSED_UNION_COMPACT_SUBSETS = prove (`!s. closed s ==> ?f:num->real^N->bool. (!n. compact(f n)) /\ (!n. (f n) SUBSET s) /\ (!n. (f n) SUBSET f(n + 1)) /\ UNIONS {f n | n IN (:num)} = s /\ (!k. compact k /\ k SUBSET s ==> ?N. !n. n >= N ==> k SUBSET (f n))`, REPEAT STRIP_TAC THEN EXISTS_TAC `\n. s INTER cball(vec 0:real^N,&n)` THEN ASM_SIMP_TAC[INTER_SUBSET; COMPACT_CBALL; CLOSED_INTER_COMPACT] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_CBALL_0] THEN MESON_TAC[REAL_ARCH_SIMPLE]; X_GEN_TAC `k:real^N->bool` THEN SIMP_TAC[SUBSET_INTER] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]);; let OPEN_UNION_COMPACT_SUBSETS = prove (`!s. open s ==> ?f:num->real^N->bool. (!n. compact(f n)) /\ (!n. (f n) SUBSET s) /\ (!n. (f n) SUBSET interior(f(n + 1))) /\ UNIONS {f n | n IN (:num)} = s /\ (!k. compact k /\ k SUBSET s ==> ?N. !n. n >= N ==> k SUBSET (f n))`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [DISCH_TAC THEN EXISTS_TAC `(\n. {}):num->real^N->bool` THEN ASM_SIMP_TAC[EMPTY_SUBSET; SUBSET_EMPTY; COMPACT_EMPTY] THEN REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; NOT_IN_EMPTY]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN STRIP_TAC] THEN MATCH_MP_TAC(MESON[] `(!f. p1 f /\ p3 f /\ p4 f ==> p5 f) /\ (?f. p1 f /\ p2 f /\ p3 f /\ (p2 f ==> p4 f)) ==> ?f. p1 f /\ p2 f /\ p3 f /\ p4 f /\ p5 f`) THEN CONJ_TAC THENL [X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `{interior(f n):real^N->bool | n IN (:num)}`) THEN REWRITE_TAC[FORALL_IN_GSPEC; OPEN_INTERIOR] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[SUBSET_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `i:num->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(f:num->real^N->bool) m` THEN REWRITE_TAC[INTERIOR_SUBSET] THEN SUBGOAL_THEN `!m n. m <= n ==> (f:num->real^N->bool) m SUBSET f n` (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_MESON_TAC[SUBSET; ADD1; INTERIOR_SUBSET]]; EXISTS_TAC `\n. cball(a,&n) DIFF {x + e | x IN (:real^N) DIFF s /\ e IN ball(vec 0,inv(&n + &1))}` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC COMPACT_DIFF THEN SIMP_TAC[COMPACT_CBALL; OPEN_SUMS; OPEN_BALL]; GEN_TAC THEN MATCH_MP_TAC(SET_RULE `(UNIV DIFF s) SUBSET t ==> c DIFF t SUBSET s`) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; GEN_TAC THEN REWRITE_TAC[INTERIOR_DIFF] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t' SUBSET t ==> (s DIFF t) SUBSET (s' DIFF t')`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERIOR_CBALL; SUBSET; IN_BALL; IN_CBALL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `{x + e | x IN (:real^N) DIFF s /\ e IN cball(vec 0,inv(&n + &2))}` THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL; GSYM OPEN_CLOSED] THEN MATCH_MP_TAC(SET_RULE `t SUBSET t' ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s /\ y IN t'}`) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `t SUBSET t' ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s /\ y IN t'}`) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> x <= a ==> x < b`) THEN MATCH_MP_TAC REAL_LT_INV2 THEN REAL_ARITH_TAC]]; DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_BALL_0] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = y + e <=> e = x - y`] THEN REWRITE_TAC[TAUT `(p /\ q) /\ r <=> r /\ p /\ q`; UNWIND_THM2] THEN REWRITE_TAC[MESON[] `~(?x. ~P x /\ Q x) <=> !x. Q x ==> P x`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `norm(x - a:real^N)` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN CONJ_TAC THENL [REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN UNDISCH_TAC `norm(x - a:real^N) <= &N2` THEN REWRITE_TAC[dist; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `inv(&(N1 + N2) + &1) <= inv(&N1)` MP_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]]]);; (* ------------------------------------------------------------------------- *) (* Closed-graph characterization of continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_CLOSED_GRAPH_GEN = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t ==> closed_in (subtopology euclidean (s PCROSS t)) {pastecart x (f x) | x IN s}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{pastecart (x:real^M) (f x:real^N) | x IN s} = {z | z IN s PCROSS t /\ f(fstcart z) - sndcart z IN {vec 0}}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; IN_SING; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ; VECTOR_SUB_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[GSYM o_DEF; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]]);; let CONTINUOUS_CLOSED_GRAPH_EQ = prove (`!f:real^M->real^N s t. compact t /\ IMAGE f s SUBSET t ==> (f continuous_on s <=> closed_in (subtopology euclidean (s PCROSS t)) {pastecart x (f x) | x IN s})`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_GRAPH_GEN] THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_CLOSED_GEN th]) THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN c} = IMAGE fstcart ({pastecart x (f x) | x IN s} INTER (s PCROSS c))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART; FSTCART_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM; PASTECART_IN_PCROSS; PASTECART_INJ] THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_MAP_FSTCART THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN ASM_REWRITE_TAC[CLOSED_IN_REFL]]);; let CONTINUOUS_CLOSED_GRAPH = prove (`!f:real^M->real^N s. closed s /\ f continuous_on s ==> closed {pastecart x (f x) | x IN s}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `(s:real^M->bool) PCROSS (:real^N)` THEN ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_UNIV] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_GRAPH_GEN THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; let CONTINUOUS_FROM_CLOSED_GRAPH = prove (`!f:real^M->real^N s t. compact t /\ IMAGE f s SUBSET t /\ closed {pastecart x (f x) | x IN s} ==> f continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONTINUOUS_CLOSED_GRAPH_EQ) THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A cute way of denoting open and closed intervals using overloading. *) (* ------------------------------------------------------------------------- *) let open_interval = new_definition `open_interval(a:real^N,b:real^N) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i /\ x$i < b$i}`;; let closed_interval = new_definition `closed_interval(l:(real^N#real^N)list) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> FST(HD l)$i <= x$i /\ x$i <= SND(HD l)$i}`;; make_overloadable "interval" `:A`;; overload_interface("interval",`open_interval`);; overload_interface("interval",`closed_interval`);; let interval = prove (`(interval (a,b) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i /\ x$i < b$i}) /\ (interval [a,b] = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i /\ x$i <= b$i})`, REWRITE_TAC[open_interval; closed_interval; HD; FST; SND]);; let IN_INTERVAL = prove (`(!x:real^N. x IN interval (a,b) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i /\ x$i < b$i) /\ (!x:real^N. x IN interval [a,b] <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i /\ x$i <= b$i)`, REWRITE_TAC[interval; IN_ELIM_THM]);; let IN_INTERVAL_REFLECT = prove (`(!a b x. (--x) IN interval[--b,--a] <=> x IN interval[a,b]) /\ (!a b x. (--x) IN interval(--b,--a) <=> x IN interval(a,b))`, SIMP_TAC[IN_INTERVAL; REAL_LT_NEG2; REAL_LE_NEG2; VECTOR_NEG_COMPONENT] THEN MESON_TAC[]);; let REFLECT_INTERVAL = prove (`(!a b:real^N. IMAGE (--) (interval[a,b]) = interval[--b,--a]) /\ (!a b:real^N. IMAGE (--) (interval(a,b)) = interval(--b,--a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_INTERVAL_REFLECT] THEN MESON_TAC[VECTOR_NEG_NEG]);; let INTERVAL_EQ_EMPTY = prove (`((interval [a:real^N,b] = {}) <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i < a$i) /\ ((interval (a:real^N,b) = {}) <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i <= a$i)`, REWRITE_TAC[EXTENSION; IN_INTERVAL; NOT_IN_EMPTY] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LE_REFL; REAL_NOT_LE]; MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE]; ALL_TAC; MESON_TAC[REAL_LT_TRANS; REAL_NOT_LT]] THEN SUBGOAL_THEN `!a b. ?c. a < b ==> a < c /\ c < b` (MP_TAC o REWRITE_RULE[SKOLEM_THM]) THENL [MESON_TAC[REAL_LT_BETWEEN]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `mid:real->real->real`) THEN DISCH_THEN(MP_TAC o SPEC `(lambda i. mid ((a:real^N)$i) ((b:real^N)$i)):real^N`) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_NOT_LT]);; let INTERVAL_NE_EMPTY = prove (`(~(interval [a:real^N,b] = {}) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) /\ (~(interval (a:real^N,b) = {}) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i)`, REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN MESON_TAC[REAL_NOT_LE]);; let SUBSET_INTERVAL_IMP = prove (`((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) ==> interval[c,d] SUBSET interval[a:real^N,b]) /\ ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i) ==> interval[c,d] SUBSET interval(a:real^N,b)) /\ ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) ==> interval(c,d) SUBSET interval[a:real^N,b]) /\ ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) ==> interval(c,d) SUBSET interval(a:real^N,b))`, REWRITE_TAC[SUBSET; IN_INTERVAL] THEN REPEAT CONJ_TAC THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let INTERVAL_SING = prove (`interval[a,a] = {a} /\ interval(a,a) = {}`, REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_INTERVAL] THEN REWRITE_TAC[REAL_LE_ANTISYM; REAL_LT_ANTISYM; CART_EQ; EQ_SYM_EQ] THEN MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; let SUBSET_INTERVAL = prove (`(interval[c,d] SUBSET interval[a:real^N,b] <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ (interval[c,d] SUBSET interval(a:real^N,b) <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i)) /\ (interval(c,d) SUBSET interval[a:real^N,b] <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ (interval(c,d) SUBSET interval(a:real^N,b) <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i))`, let lemma = prove (`(!x:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> Q i (x$i)) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> R i (x$i))) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> ?y. Q i y) ==> !i y. 1 <= i /\ i <= dimindex(:N) /\ Q i y ==> R i y`, DISCH_TAC THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real` STRIP_ASSUME_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(lambda j. if j = i then y else f j):real^N`) THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[]) in REPEAT STRIP_TAC THEN (MATCH_MP_TAC(TAUT `(~q ==> p) /\ (q ==> (p <=> r)) ==> (p <=> q ==> r)`) THEN CONJ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `s = {} ==> s SUBSET t`) THEN REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_NOT_LT]; ALL_TAC] THEN DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_IMP] THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_BETWEEN; REAL_LE_BETWEEN]; ALL_TAC] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC) THENL [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; ALL_TAC; ALL_TAC] THEN (REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `((c:real^N)$i + min ((a:real^N)$i) ((d:real^N)$i)) / &2`) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `(max ((b:real^N)$i) ((c:real^N)$i) + (d:real^N)$i) / &2`) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]));; let DISJOINT_INTERVAL = prove (`!a b c d:real^N. (interval[a,b] INTER interval[c,d] = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i < a$i \/ d$i < c$i \/ b$i < c$i \/ d$i < a$i)) /\ (interval[a,b] INTER interval(c,d) = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i < a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ (interval(a,b) INTER interval[c,d] = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i <= a$i \/ d$i < c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ (interval(a,b) INTER interval(c,d) = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i <= a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i))`, REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; NOT_IN_EMPTY] THEN REWRITE_TAC[AND_FORALL_THM; NOT_FORALL_THM] THEN REWRITE_TAC[TAUT `~((p ==> q) /\ (p ==> r)) <=> p /\ (~q \/ ~r)`] THEN REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN (EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `(lambda i. (max ((a:real^N)$i) ((c:real^N)$i) + min ((b:real^N)$i) ((d:real^N)$i)) / &2):real^N`) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; DISCH_THEN(fun th -> GEN_TAC THEN MP_TAC th) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN REAL_ARITH_TAC]));; let ENDS_IN_INTERVAL = prove (`(!a b. a IN interval[a,b] <=> ~(interval[a,b] = {})) /\ (!a b. b IN interval[a,b] <=> ~(interval[a,b] = {})) /\ (!a b. ~(a IN interval(a,b))) /\ (!a b. ~(b IN interval(a,b)))`, REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY] THEN REWRITE_TAC[REAL_LE_REFL; REAL_LT_REFL] THEN MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; let ENDS_IN_UNIT_INTERVAL = prove (`vec 0 IN interval[vec 0,vec 1] /\ vec 1 IN interval[vec 0,vec 1] /\ ~(vec 0 IN interval(vec 0,vec 1)) /\ ~(vec 1 IN interval(vec 0,vec 1))`, REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY; VEC_COMPONENT] THEN REWRITE_TAC[REAL_POS]);; let INTER_INTERVAL = prove (`interval[a,b] INTER interval[c,d] = interval[(lambda i. max (a$i) (c$i)),(lambda i. min (b$i) (d$i))]`, REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL] THEN SIMP_TAC[LAMBDA_BETA; REAL_MAX_LE; REAL_LE_MIN] THEN MESON_TAC[]);; let INTERVAL_OPEN_SUBSET_CLOSED = prove (`!a b. interval(a,b) SUBSET interval[a,b]`, REWRITE_TAC[SUBSET; IN_INTERVAL] THEN MESON_TAC[REAL_LT_IMP_LE]);; let OPEN_INTERVAL_LEMMA = prove (`!a b x. a < x /\ x < b ==> ?d. &0 < d /\ !x'. abs(x' - x) < d ==> a < x' /\ x' < b`, REPEAT STRIP_TAC THEN EXISTS_TAC `min (x - a) (b - x)` THEN REWRITE_TAC[REAL_LT_MIN] THEN ASM_REAL_ARITH_TAC);; let OPEN_INTERVAL = prove (`!a:real^N b. open(interval (a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[open_def; interval; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?d. &0 < d /\ !x'. abs(x' - (x:real^N)$i) < d ==> (a:real^N)$i < x' /\ x' < (b:real^N)$i` MP_TAC THENL [ASM_SIMP_TAC[OPEN_INTERVAL_LEMMA]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inf (IMAGE d (1..dimindex(:N)))` THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NOT_INSERT_EMPTY; NUMSEG_EMPTY; ARITH_RULE `n < 1 <=> (n = 0)`; DIMINDEX_NONZERO] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; dist] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; VECTOR_SUB_COMPONENT]);; let CLOSED_INTERVAL = prove (`!a:real^N b. closed(interval [a,b])`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_INTERVAL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`); FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`)] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[dist; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`; REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; let INTERIOR_CLOSED_INTERVAL = prove (`!a:real^N b. interior(interval [a,b]) = interval (a,b)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC INTERIOR_MAXIMAL THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL]] THEN REWRITE_TAC[interior; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL [(let t = `x - (e / &2) % basis i :real^N` in DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t)); (let t = `x + (e / &2) % basis i :real^N` in DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t))] THEN REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_ARITH `x - y - x = --y:real^N`] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; NORM_NEG; REAL_MUL_RID; REAL_ARITH `&0 < e ==> abs(e / &2) < e`] THEN MATCH_MP_TAC(TAUT `~b ==> (a ==> b) ==> ~a`) THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[DE_MORGAN_THM; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THENL [DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `a <= a - b <=> ~(&0 < b)`]; DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH `a + b <= a <=> ~(&0 < b)`]] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; basis; LAMBDA_BETA; REAL_MUL_RID] THEN ASM_REWRITE_TAC[REAL_HALF]);; let INTERIOR_INTERVAL = prove (`(!a b. interior(interval[a,b]) = interval(a,b)) /\ (!a b. interior(interval(a,b)) = interval(a,b))`, SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);; let BOUNDED_CLOSED_INTERVAL = prove (`!a b:real^N. bounded (interval [a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[bounded; interval] THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((a:real^N)$i) + abs((b:real^N)$i))` THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x:real^N)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ARITH `a <= x /\ x <= b ==> abs(x) <= abs(a) + abs(b)`]);; let BOUNDED_INTERVAL = prove (`(!a b. bounded (interval [a,b])) /\ (!a b. bounded (interval (a,b)))`, MESON_TAC[BOUNDED_CLOSED_INTERVAL; BOUNDED_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]);; let NOT_INTERVAL_UNIV = prove (`(!a b. ~(interval[a,b] = UNIV)) /\ (!a b. ~(interval(a,b) = UNIV))`, MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; let COMPACT_INTERVAL = prove (`!a b. compact (interval [a,b])`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL; CLOSED_INTERVAL]);; let OPEN_INTERVAL_MIDPOINT = prove (`!a b:real^N. ~(interval(a,b) = {}) ==> (inv(&2) % (a + b)) IN interval(a,b)`, REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);; let OPEN_CLOSED_INTERVAL_CONVEX = prove (`!a b x y:real^N e. x IN interval(a,b) /\ y IN interval[a,b] /\ &0 < e /\ e <= &1 ==> (e % x + (&1 - e) % y) IN interval(a,b)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(c /\ d ==> a /\ b ==> e) ==> a /\ b /\ c /\ d ==> e`) THEN STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBST1_TAC(REAL_ARITH `(a:real^N)$i = e * a$i + (&1 - e) * a$i`) THEN SUBST1_TAC(REAL_ARITH `(b:real^N)$i = e * b$i + (&1 - e) * b$i`) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL; REAL_SUB_LE]);; let CLOSURE_OPEN_INTERVAL = prove (`!a b:real^N. ~(interval(a,b) = {}) ==> closure(interval(a,b)) = interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CLOSED_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[SUBSET; closure; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~b ==> c) ==> b \/ c`) THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; LIMPT_SEQUENTIAL] THEN ABBREV_TAC `(c:real^N) = inv(&2) % (a + b)` THEN EXISTS_TAC `\n. (x:real^N) + inv(&n + &1) % (c - x)` THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_DELETE] THEN REWRITE_TAC[VECTOR_ARITH `x + a = x <=> a = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0] THEN REWRITE_TAC[VECTOR_SUB_EQ; REAL_ARITH `~(&n + &1 = &0)`] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]] THEN REWRITE_TAC[VECTOR_ARITH `x + a % (y - x) = a % y + (&1 - a) % x`] THEN MATCH_MP_TAC OPEN_CLOSED_INTERVAL_CONVEX THEN CONJ_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [VECTOR_ARITH `x:real^N = x + &0 % (c - x)`] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; DIST_LIFT; REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `N:num <= n` THEN UNDISCH_TAC `~(N = 0)` THEN REWRITE_TAC[GSYM LT_NZ; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT] THEN REAL_ARITH_TAC);; let CLOSURE_INTERVAL = prove (`(!a b. closure(interval[a,b]) = interval[a,b]) /\ (!a b. closure(interval(a,b)) = if interval(a,b) = {} then {} else interval[a,b])`, SIMP_TAC[CLOSURE_CLOSED; CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; CLOSURE_EMPTY]);; let BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC = prove (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval(--a,a)`, REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `B:real`] THEN STRIP_TAC THEN EXISTS_TAC `(lambda i. B + &1):real^N` THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_BOUNDS_LT; VECTOR_NEG_COMPONENT] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_ARITH `x <= y ==> a <= x ==> a < y + &1`]);; let BOUNDED_SUBSET_OPEN_INTERVAL = prove (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval(a,b)`, MESON_TAC[BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC]);; let BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC = prove (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval[--a,a]`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_BALL; IN_INTERVAL; SUBSET; REAL_LT_IMP_LE]);; let BOUNDED_SUBSET_CLOSED_INTERVAL = prove (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval[a,b]`, MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC]);; let FRONTIER_CLOSED_INTERVAL = prove (`!a b. frontier(interval[a,b]) = interval[a,b] DIFF interval(a,b)`, SIMP_TAC[frontier; INTERIOR_CLOSED_INTERVAL; CLOSURE_CLOSED; CLOSED_INTERVAL]);; let FRONTIER_OPEN_INTERVAL = prove (`!a b. frontier(interval(a,b)) = if interval(a,b) = {} then {} else interval[a,b] DIFF interval(a,b)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FRONTIER_EMPTY] THEN ASM_SIMP_TAC[frontier; CLOSURE_OPEN_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);; let INTER_INTERVAL_MIXED_EQ_EMPTY = prove (`!a b c d:real^N. ~(interval(c,d) = {}) ==> (interval(a,b) INTER interval[c,d] = {} <=> interval(a,b) INTER interval(c,d) = {})`, SIMP_TAC[GSYM CLOSURE_OPEN_INTERVAL; OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_INTERVAL]);; let INTERVAL_TRANSLATION = prove (`(!c a b. interval[c + a,c + b] = IMAGE (\x. c + x) (interval[a,b])) /\ (!c a b. interval(c + a,c + b) = IMAGE (\x. c + x) (interval(a,b)))`, REWRITE_TAC[interval] THEN CONJ_TAC THEN GEOM_TRANSLATE_TAC[] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; add_translation_invariants [CONJUNCT1 INTERVAL_TRANSLATION; CONJUNCT2 INTERVAL_TRANSLATION];; let EMPTY_AS_INTERVAL = prove (`{} = interval[vec 1,vec 0]`, SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTERVAL; VEC_COMPONENT] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);; let UNIT_INTERVAL_NONEMPTY = prove (`~(interval[vec 0:real^N,vec 1] = {}) /\ ~(interval(vec 0:real^N,vec 1) = {})`, SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01; REAL_POS]);; let IMAGE_STRETCH_INTERVAL = prove (`!a b:real^N m. IMAGE (\x. lambda k. m(k) * x$k) (interval[a,b]) = if interval[a,b] = {} then {} else interval[(lambda k. min (m(k) * a$k) (m(k) * b$k)):real^N, (lambda k. max (m(k) * a$k) (m(k) * b$k))]`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES] THEN ASM_SIMP_TAC[EXTENSION; IN_IMAGE; CART_EQ; IN_INTERVAL; AND_FORALL_THM; TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`; LAMBDA_BETA; GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC(MESON[] `(!x. p x ==> (q x <=> r x)) ==> ((!x. p x ==> q x) <=> (!x. p x ==> r x))`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(m:num->real) k = &0` THENL [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MAX_ACI; REAL_MIN_ACI] THEN ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_FIELD `~(m = &0) ==> (x = m * y <=> y = x / m)`] THEN REWRITE_TAC[UNWIND_THM2] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(z = &0) ==> &0 < z \/ &0 < --z`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ARITH `--(max a b) = min (--a) (--b)`; REAL_ARITH `--(min a b) = max (--a) (--b)`; real_div; GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN REWRITE_TAC[GSYM real_div]] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN ASM_SIMP_TAC[real_min; real_max; REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC);; let INTERVAL_IMAGE_STRETCH_INTERVAL = prove (`!a b:real^N m. ?u v:real^N. IMAGE (\x. lambda k. m k * x$k) (interval[a,b]) = interval[u,v]`, REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]);; let CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL = prove (`!a b:real^N. ~(interval[a,b] = {}) ==> interval[a,b] = IMAGE (\x:real^N. a + x) (IMAGE (\x. (lambda i. (b$i - a$i) * x$i)) (interval[vec 0:real^N,vec 1]))`, REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_STRETCH_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN REWRITE_TAC[EXTENSION; IN_INTERVAL] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN GEN_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID] THEN MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((!x. P x) <=> (!x. Q x))`) THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let SUMS_INTERVALS = prove (`(!a b c d:real^N. ~(interval[a,b] = {}) /\ ~(interval[c,d] = {}) ==> {x + y | x IN interval[a,b] /\ y IN interval[c,d]} = interval[a+c,b+d]) /\ (!a b c d:real^N. ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) ==> {x + y | x IN interval(a,b) /\ y IN interval(c,d)} = interval(a+c,b+d))`, CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN REWRITE_TAC[UNWIND_THM2; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN (X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC); DISCH_TAC THEN REWRITE_TAC[AND_FORALL_THM; GSYM LAMBDA_SKOLEM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[REAL_ARITH `((a <= y /\ y <= b) /\ c <= x - y /\ x - y <= d <=> max a (x - d) <= y /\ y <= min b (x - c)) /\ ((a < y /\ y < b) /\ c < x - y /\ x - y < d <=> max a (x - d) < y /\ y < min b (x - c))`] THEN REWRITE_TAC[GSYM REAL_LE_BETWEEN; GSYM REAL_LT_BETWEEN]] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));; let PCROSS_INTERVAL = prove (`!a b:real^M c d:real^N. interval[a,b] PCROSS interval[c,d] = interval[pastecart a c,pastecart b d]`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN SIMP_TAC[IN_INTERVAL; pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THEN STRIP_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB] THENL [ASM_ARITH_TAC; DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]]]);; let OPEN_CONTAINS_INTERVAL,OPEN_CONTAINS_OPEN_INTERVAL = (CONJ_PAIR o prove) (`(!s:real^N->bool. open s <=> !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s) /\ (!s:real^N->bool. open s <=> !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; DISCH_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `interval(a:real^N,b)` OPEN_CONTAINS_BALL) THEN REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `x - e / &(dimindex(:N)) % vec 1:real^N` THEN EXISTS_TAC `x + e / &(dimindex(:N)) % vec 1:real^N` THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b SUBSET s ==> x IN i /\ j SUBSET b ==> x IN i /\ j SUBSET s`)) THEN SIMP_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; IN_CBALL; VEC_COMPONENT; VECTOR_ADD_COMPONENT; SUBSET; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `x - e < x /\ x < x + e <=> &0 < e`; REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(x - y) <= e`] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN ASM_SIMP_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]);; let DIAMETER_INTERVAL = prove (`(!a b:real^N. diameter(interval[a,b]) = if interval[a,b] = {} then &0 else norm(b - a)) /\ (!a b:real^N. diameter(interval(a,b)) = if interval(a,b) = {} then &0 else norm(b - a))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_EMPTY; DIAMETER_EMPTY]; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND; ENDS_IN_INTERVAL; BOUNDED_INTERVAL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `diameter(cball(inv(&2) % (a + b):real^N,norm(b - a) / &2))` THEN CONJ_TAC THENL [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_CBALL] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN REWRITE_TAC[GSYM NORM_MUL; REAL_ARITH `x / &2 = abs(inv(&2)) * x`] THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC; REWRITE_TAC[DIAMETER_CBALL] THEN NORM_ARITH_TAC]; DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY] THEN SUBGOAL_THEN `interval[a:real^N,b] = closure(interval(a,b))` SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN ASM_MESON_TAC[DIAMETER_CLOSURE; BOUNDED_INTERVAL]]);; let IMAGE_TWIZZLE_INTERVAL = prove (`!p a b. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) ==> IMAGE ((\x. lambda i. x$(p i)):real^M->real^N) (interval[a,b]) = interval[(lambda i. a$(p i)),(lambda i. b$(p i))]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN SIMP_TAC[IN_INTERVAL; CART_EQ; LAMBDA_BETA] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(lambda i. (y:real^N)$(inverse p i)):real^M` THEN IMP_REWRITE_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_IN_IMAGE]; REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]]);; let EQ_INTERVAL = prove (`(!a b c d:real^N. interval[a,b] = interval[c,d] <=> interval[a,b] = {} /\ interval[c,d] = {} \/ a = c /\ b = d) /\ (!a b c d:real^N. interval[a,b] = interval(c,d) <=> interval[a,b] = {} /\ interval(c,d) = {}) /\ (!a b c d:real^N. interval(a,b) = interval[c,d] <=> interval(a,b) = {} /\ interval[c,d] = {}) /\ (!a b c d:real^N. interval(a,b) = interval(c,d) <=> interval(a,b) = {} /\ interval(c,d) = {} \/ a = c /\ b = d)`, REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN (EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[]]) THEN MATCH_MP_TAC(MESON[] `(p = {} /\ q = {} ==> r) /\ (~(p = {}) /\ ~(q = {}) ==> p = q ==> r) ==> p = q ==> r`) THEN SIMP_TAC[] THENL [REWRITE_TAC[INTERVAL_NE_EMPTY; CART_EQ] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[SUBSET_INTERVAL; GSYM REAL_LE_ANTISYM]; STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN] `closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(s = t)`) THEN ASM_REWRITE_TAC[CLOSED_INTERVAL; OPEN_INTERVAL; NOT_INTERVAL_UNIV]; STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN] `closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(t = s)`) THEN ASM_REWRITE_TAC[CLOSED_INTERVAL; OPEN_INTERVAL; NOT_INTERVAL_UNIV]; REWRITE_TAC[INTERVAL_NE_EMPTY; CART_EQ] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[SUBSET_INTERVAL; GSYM REAL_LE_ANTISYM]]);; let CLOSED_INTERVAL_EQ = prove (`(!a b:real^N. closed(interval[a,b])) /\ (!a b:real^N. closed(interval(a,b)) <=> interval(a,b) = {})`, REWRITE_TAC[CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[CLOSED_EMPTY] THEN MP_TAC(ISPEC `interval(a:real^N,b)` CLOPEN) THEN ASM_REWRITE_TAC[OPEN_INTERVAL] THEN MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; let OPEN_INTERVAL_EQ = prove (`(!a b:real^N. open(interval[a,b]) <=> interval[a,b] = {}) /\ (!a b:real^N. open(interval(a,b)))`, REWRITE_TAC[OPEN_INTERVAL] THEN REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[CLOSED_EMPTY] THEN MP_TAC(ISPEC `interval[a:real^N,b]` CLOPEN) THEN ASM_REWRITE_TAC[CLOSED_INTERVAL] THEN MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; let COMPACT_INTERVAL_EQ = prove (`(!a b:real^N. compact(interval[a,b])) /\ (!a b:real^N. compact(interval(a,b)) <=> interval(a,b) = {})`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL] THEN REWRITE_TAC[CLOSED_INTERVAL_EQ]);; let CLOSED_INTERVAL_DROPOUT = prove (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ a$k <= b$k ==> interval[dropout k a,dropout k b] = IMAGE (dropout k:real^N->real^M) (interval[a,b])`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[EXTENSION; IN_IMAGE_DROPOUT; IN_INTERVAL] THEN X_GEN_TAC `x:real^M` THEN SIMP_TAC[pushin; dropout; LAMBDA_BETA] THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `(a:real^N)$k` THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUB_ADD]]]; DISCH_THEN(X_CHOOSE_TAC `t:real`) THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `i + 1`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THEN REWRITE_TAC[ADD_SUB] THEN ASM_ARITH_TAC]]);; let IMAGE_DROPOUT_CLOSED_INTERVAL = prove (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> IMAGE (dropout k:real^N->real^M) (interval[a,b]) = if a$k <= b$k then interval[dropout k a,dropout k b] else {}`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CLOSED_INTERVAL_DROPOUT; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[INTERVAL_EQ_EMPTY; GSYM REAL_NOT_LE] THEN ASM_MESON_TAC[]);; let EQ_BALLS = prove (`(!a a':real^N r r'. ball(a,r) = ball(a',r') <=> a = a' /\ r = r' \/ r <= &0 /\ r' <= &0) /\ (!a a':real^N r r'. ball(a,r) = cball(a',r') <=> r <= &0 /\ r' < &0) /\ (!a a':real^N r r'. cball(a,r) = ball(a',r') <=> r < &0 /\ r' <= &0) /\ (!a a':real^N r r'. cball(a,r) = cball(a',r') <=> a = a' /\ r = r' \/ r < &0 /\ r' < &0)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT STRIP_TAC THEN (EQ_TAC THENL [ALL_TAC; REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN NORM_ARITH_TAC; ONCE_REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC; REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN NORM_ARITH_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[CLOPEN; BOUNDED_BALL; NOT_BOUNDED_UNIV] `s = t ==> closed s /\ open t /\ bounded t ==> s = {} /\ t = {}`)) THEN REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BOUNDED_BALL; BALL_EQ_EMPTY; CBALL_EQ_EMPTY] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some special cases for intervals in R^1. *) (* ------------------------------------------------------------------------- *) let INTERVAL_CASES_1 = prove (`!x:real^1. x IN interval[a,b] ==> x IN interval(a,b) \/ (x = a) \/ (x = b)`, REWRITE_TAC[CART_EQ; IN_INTERVAL; FORALL_DIMINDEX_1] THEN REAL_ARITH_TAC);; let IN_INTERVAL_1 = prove (`!a b x:real^1. (x IN interval[a,b] <=> drop a <= drop x /\ drop x <= drop b) /\ (x IN interval(a,b) <=> drop a < drop x /\ drop x < drop b)`, REWRITE_TAC[IN_INTERVAL; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN MESON_TAC[]);; let INTERVAL_EQ_EMPTY_1 = prove (`!a b:real^1. (interval[a,b] = {} <=> drop b < drop a) /\ (interval(a,b) = {} <=> drop b <= drop a)`, REWRITE_TAC[INTERVAL_EQ_EMPTY; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN MESON_TAC[]);; let INTERVAL_NE_EMPTY_1 = prove (`(!a b:real^1. ~(interval[a,b] = {}) <=> drop a <= drop b) /\ (!a b:real^1. ~(interval(a,b) = {}) <=> drop a < drop b)`, REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN REAL_ARITH_TAC);; let UNION_INTERVAL_1 = prove (`!a b c:real^1. c IN interval[a,b] ==> interval[a,c] UNION interval[c,b] = interval[a,b]`, REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN REAL_ARITH_TAC);; let SUBSET_INTERVAL_1 = prove (`!a b c d. (interval[a,b] SUBSET interval[c,d] <=> drop b < drop a \/ drop c <= drop a /\ drop a <= drop b /\ drop b <= drop d) /\ (interval[a,b] SUBSET interval(c,d) <=> drop b < drop a \/ drop c < drop a /\ drop a <= drop b /\ drop b < drop d) /\ (interval(a,b) SUBSET interval[c,d] <=> drop b <= drop a \/ drop c <= drop a /\ drop a < drop b /\ drop b <= drop d) /\ (interval(a,b) SUBSET interval(c,d) <=> drop b <= drop a \/ drop c <= drop a /\ drop a < drop b /\ drop b <= drop d)`, REWRITE_TAC[SUBSET_INTERVAL; FORALL_1; DIMINDEX_1; drop] THEN REAL_ARITH_TAC);; let EQ_INTERVAL_1 = prove (`!a b c d:real^1. (interval[a,b] = interval[c,d] <=> drop b < drop a /\ drop d < drop c \/ drop a = drop c /\ drop b = drop d)`, REWRITE_TAC[SET_RULE `s = t <=> s SUBSET t /\ t SUBSET s`] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC);; let DISJOINT_INTERVAL_1 = prove (`!a b c d:real^1. (interval[a,b] INTER interval[c,d] = {} <=> drop b < drop a \/ drop d < drop c \/ drop b < drop c \/ drop d < drop a) /\ (interval[a,b] INTER interval(c,d) = {} <=> drop b < drop a \/ drop d <= drop c \/ drop b <= drop c \/ drop d <= drop a) /\ (interval(a,b) INTER interval[c,d] = {} <=> drop b <= drop a \/ drop d < drop c \/ drop b <= drop c \/ drop d <= drop a) /\ (interval(a,b) INTER interval(c,d) = {} <=> drop b <= drop a \/ drop d <= drop c \/ drop b <= drop c \/ drop d <= drop a)`, REWRITE_TAC[DISJOINT_INTERVAL; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM; UNWIND_THM1; drop]);; let OPEN_CLOSED_INTERVAL_1 = prove (`!a b:real^1. interval(a,b) = interval[a,b] DIFF {a,b}`, REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; let CLOSED_OPEN_INTERVAL_1 = prove (`!a b:real^1. drop a <= drop b ==> interval[a,b] = interval(a,b) UNION {a,b}`, REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; let BALL_1 = prove (`!x:real^1 r. cball(x,r) = interval[x - lift r,x + lift r] /\ ball(x,r) = interval(x - lift r,x + lift r)`, REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL; IN_INTERVAL_1] THEN REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_ADD] THEN REAL_ARITH_TAC);; let SPHERE_1 = prove (`!a:real^1 r. sphere(a,r) = if r < &0 then {} else {a - lift r,a + lift r}`, REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN COND_CASES_TAC THEN REWRITE_TAC[DIST_REAL; GSYM drop; FORALL_DROP] THEN REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC);; let FINITE_SPHERE_1 = prove (`!a:real^1 r. FINITE(sphere(a,r))`, REPEAT GEN_TAC THEN REWRITE_TAC[SPHERE_1] THEN MESON_TAC[FINITE_INSERT; FINITE_EMPTY]);; let FINITE_INTERVAL_1 = prove (`(!a b. FINITE(interval[a,b]) <=> drop b <= drop a) /\ (!a b. FINITE(interval(a,b)) <=> drop b <= drop a)`, REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `interval[a,b] = IMAGE lift {x | drop a <= x /\ x <= drop b}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; LIFT_DROP]; SIMP_TAC[FINITE_IMAGE_INJ_EQ; LIFT_EQ; FINITE_REAL_INTERVAL]]);; let BALL_INTERVAL = prove (`!x:real^1 e. ball(x,e) = interval(x - lift e,x + lift e)`, REWRITE_TAC[EXTENSION; IN_BALL; IN_INTERVAL_1; DIST_REAL] THEN REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; let CBALL_INTERVAL = prove (`!x:real^1 e. cball(x,e) = interval[x - lift e,x + lift e]`, REWRITE_TAC[EXTENSION; IN_CBALL; IN_INTERVAL_1; DIST_REAL] THEN REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; let BALL_INTERVAL_0 = prove (`!e. ball(vec 0:real^1,e) = interval(--lift e,lift e)`, GEN_TAC THEN REWRITE_TAC[BALL_INTERVAL] THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; let CBALL_INTERVAL_0 = prove (`!e. cball(vec 0:real^1,e) = interval[--lift e,lift e]`, GEN_TAC THEN REWRITE_TAC[CBALL_INTERVAL] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; let INTER_INTERVAL_1 = prove (`!a b c d:real^1. interval[a,b] INTER interval[c,d] = interval[lift(max (drop a) (drop c)),lift(min (drop b) (drop d))]`, REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; real_max; real_min] THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN ASM_REAL_ARITH_TAC);; let CLOSED_DIFF_OPEN_INTERVAL_1 = prove (`!a b:real^1. interval[a,b] DIFF interval(a,b) = if interval[a,b] = {} then {} else {a,b}`, REWRITE_TAC[EXTENSION; IN_DIFF; INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; let INTERVAL_1 = prove (`(!a b:real^1. interval[a,b] = if drop a <= drop b then cball(midpoint(a,b),dist(a,b) / &2) else {}) /\ (!a b:real^1. interval(a,b) = if drop a < drop b then ball(midpoint(a,b),dist(a,b) / &2) else {})`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE; REAL_NOT_LT]) THEN ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN REWRITE_TAC[BALL_1; DIST_REAL] THEN ASM_SIMP_TAC[GSYM drop; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ARITH `a <= b ==> abs(a - b) = b - a`] THEN REWRITE_TAC[REAL_ARITH `x / &2 = inv(&2) * x`; LIFT_CMUL] THEN REWRITE_TAC[LIFT_SUB; LIFT_DROP; midpoint] THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ; CONS_11] THEN VECTOR_ARITH_TAC);; let SEGMENT_1 = prove (`(!a b. segment[a,b] = if drop a <= drop b then interval[a,b] else interval[b,a]) /\ (!a b. segment(a,b) = if drop a <= drop b then interval(a,b) else interval(b,a))`, CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN COND_CASES_TAC THEN REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; EXTENSION; GSYM BETWEEN_IN_SEGMENT; between; IN_INTERVAL_1] THEN REWRITE_TAC[GSYM DROP_EQ; DIST_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC);; let OPEN_SEGMENT_1 = prove (`!a b:real^1. open(segment(a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN REWRITE_TAC[OPEN_INTERVAL]);; let INTERVAL_SUBSET_SEGMENT_1 = prove (`!a b:real^1. interval[a,b] SUBSET segment[a,b]`, REWRITE_TAC[SEGMENT_1; GSYM INTERVAL_NE_EMPTY_1] THEN SET_TAC[]);; let SEGMENT_SCALAR_MULTIPLE = prove (`(!a b v. segment[a % v,b % v] = {x % v:real^N | a <= x /\ x <= b \/ b <= x /\ x <= a}) /\ (!a b v. ~(v = vec 0) ==> segment(a % v,b % v) = {x % v:real^N | a < x /\ x < b \/ b < x /\ x < a})`, MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL [REPEAT GEN_TAC THEN MP_TAC(SPECL [`a % basis 1:real^1`; `b % basis 1:real^1`] (CONJUNCT1 SEGMENT_1)) THEN REWRITE_TAC[segment; VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[SET_RULE `{f x % b | p x} = IMAGE (\a. a % b) {f x | p x}`] THEN DISCH_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `IMAGE drop`) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_CMUL] THEN SIMP_TAC[drop; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[REAL_MUL_RID; IMAGE_ID] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN SIMP_TAC[drop; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[open_segment] THEN ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; SET_RULE `(!x y. x % v = y % v <=> x = y) ==> {x % v | P x} DIFF {a % v,b % v} = {x % v | P x /\ ~(x = a) /\ ~(x = b)}`] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let FINITE_INTER_COLLINEAR_OPEN_SEGMENTS = prove (`!a b c d:real^N. collinear{a,b,c} ==> (FINITE(segment(a,b) INTER segment(c,d)) <=> segment(a,b) INTER segment(c,d) = {})`, REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = b - a` THEN POP_ASSUM MP_TAC THEN GEOM_NORMALIZE_TAC `m:real^N` THEN SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; INTER_EMPTY; FINITE_EMPTY] THEN X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM(K ALL_TAC) THEN ASM_CASES_TAC `collinear{vec 0:real^N,&1 % basis 1,y}` THENL [POP_ASSUM MP_TAC THEN SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC(TAUT `~a /\ (b ==> c ==> d) ==> a \/ b ==> a \/ c ==> d`) THEN CONJ_TAC THENL [SIMP_TAC[VECTOR_MUL_LID; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `b:real` THEN DISCH_THEN SUBST_ALL_TAC THEN X_GEN_TAC `a:real` THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_RCANCEL; IMAGE_EQ_EMPTY; FINITE_IMAGE_INJ_EQ; SET_RULE `(!x y. x % v = y % v <=> x = y) ==> {x % v | P x} INTER {x % v | Q x} = IMAGE (\x. x % v) {x | P x /\ Q x}`] THEN REWRITE_TAC[REAL_ARITH `(&0 < x /\ x < &1 \/ &1 < x /\ x < &0) /\ (b < x /\ x < a \/ a < x /\ x < b) <=> max (&0) (min a b) < x /\ x < min (&1) (max a b)`] THEN SIMP_TAC[FINITE_REAL_INTERVAL; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN SIMP_TAC[GSYM REAL_LT_BETWEEN; GSYM NOT_EXISTS_THM] THEN REAL_ARITH_TAC; DISCH_TAC THEN ASM_CASES_TAC `segment(vec 0:real^N,&1 % basis 1) INTER segment (x,y) = {}` THEN ASM_REWRITE_TAC[FINITE_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[open_segment; IN_DIFF; NOT_IN_EMPTY; DE_MORGAN_THM; IN_INTER; IN_INSERT] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `~collinear{vec 0:real^N,&1 % basis 1, y}` THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_LID]) THEN REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{p,x:real^N, y, vec 0, basis 1}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MP_TAC(ISPECL [`{y:real^N,vec 0,basis 1}`; `p:real^N`; `x:real^N`] COLLINEAR_TRIPLES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{p,x,y} = {x,p,y}`] THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM COLLINEAR_4_3] THEN ONCE_REWRITE_TAC[SET_RULE `{p,x,z,w} = {w,z,p,x}`] THEN SIMP_TAC[COLLINEAR_4_3; BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR o GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT])) THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);; let BOUNDED_SEPARATION_1D = prove (`!s:real^N->bool. dimindex(:N) = 1 /\ bounded s ==> (connected((:real^N) DIFF s) <=> s = {})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY; CONNECTED_UNIV] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`{x:real^N | x$1 < (a:real^N)$1}`; `{x:real^N | x$1 > (a:real^N)$1}`] THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT; OPEN_HALFSPACE_COMPONENT_LT] THEN REWRITE_TAC[SUBSET; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNION; IN_DIFF; IN_UNIV] THEN REWRITE_TAC[CONJ_ASSOC; REAL_ARITH `x < a /\ x > a <=> F`] THEN REWRITE_TAC[REAL_ARITH `x < a \/ x > a <=> ~(x = a)`; real_gt] THEN REWRITE_TAC[CONTRAPOS_THM; NOT_FORALL_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `b:real^N = a` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[CART_EQ; DIMINDEX_1; FORALL_1]; FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN ASM_REWRITE_TAC[SUBSET; IN_INTERVAL; DIMINDEX_1; FORALL_1] THEN DISCH_TAC THEN CONJ_TAC THENL [EXISTS_TAC `u - basis 1:real^N`; EXISTS_TAC `v + basis 1:real^N`] THEN FIRST_ASSUM(MP_TAC o SPEC `a:real^N`) THEN (ANTS_TAC THENL [ASM_REWRITE_TAC[]; STRIP_TAC]) THEN (CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV [GSYM CONTRAPOS_THM])] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC)]);; (* ------------------------------------------------------------------------- *) (* Intervals in general, including infinite and mixtures of open and closed. *) (* ------------------------------------------------------------------------- *) let is_interval = new_definition `is_interval(s:real^N->bool) <=> !a b x. a IN s /\ b IN s /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> (a$i <= x$i /\ x$i <= b$i) \/ (b$i <= x$i /\ x$i <= a$i)) ==> x IN s`;; let IS_INTERVAL_INTERVAL = prove (`!a:real^N b. is_interval(interval (a,b)) /\ is_interval(interval [a,b])`, REWRITE_TAC[is_interval; IN_INTERVAL] THEN MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS]);; let IS_INTERVAL_EMPTY = prove (`is_interval {}`, REWRITE_TAC[is_interval; NOT_IN_EMPTY]);; let IS_INTERVAL_UNIV = prove (`is_interval(UNIV:real^N->bool)`, REWRITE_TAC[is_interval; IN_UNIV]);; let IS_INTERVAL_TRANSLATION_EQ = prove (`!a:real^N s. is_interval(IMAGE (\x. a + x) s) <=> is_interval s`, REWRITE_TAC[is_interval] THEN GEOM_TRANSLATE_TAC[] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; add_translation_invariants [IS_INTERVAL_TRANSLATION_EQ];; let IS_INTERVAL_TRANSLATION = prove (`!s a:real^N. is_interval s ==> is_interval(IMAGE (\x. a + x) s)`, REWRITE_TAC[IS_INTERVAL_TRANSLATION_EQ]);; let IS_INTERVAL_POINTWISE = prove (`!s:real^N->bool x. is_interval s /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. a IN s /\ a$i = x$i) ==> x IN s`, REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. ?y:real^N. (!i. 1 <= i /\ i <= n ==> y$i = (x:real^N)$i) /\ y IN s` MP_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THENL [ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN ASM_CASES_TAC `SUC n <= dimindex(:N)` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(lambda i. if i <= n then (y:real^N)$i else (z:real^N)$i):real^N` THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `i = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM_ARITH_TAC; FIRST_X_ASSUM(ASSUME_TAC o CONJUNCT2) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`y:real^N`; `z:real^N`] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]; EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `y:real^N = x` (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[CART_EQ] THEN ASM_MESON_TAC[ARITH_RULE `i <= N /\ ~(SUC n <= N) ==> i <= n`]]; DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[GSYM CART_EQ] THEN MESON_TAC[]]);; let IS_INTERVAL_COMPACT = prove (`!s:real^N->bool. is_interval s /\ compact s <=> ?a b. s = interval[a,b]`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[IS_INTERVAL_INTERVAL; COMPACT_INTERVAL] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN EXISTS_TAC `(lambda i. inf { (x:real^N)$i | x IN s}):real^N` THEN EXISTS_TAC `(lambda i. sup { (x:real^N)$i | x IN s}):real^N` THEN SIMP_TAC[EXTENSION; IN_INTERVAL; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` INF) THEN MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` SUP) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[bounded] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; REAL_ARITH `abs(x) <= B ==> --B <= x /\ x <= B`]; DISCH_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `?a b:real^N. a IN s /\ b IN s /\ a$i <= (x:real^N)$i /\ x$i <= b$i` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] CONTINUOUS_ATTAINS_INF) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] CONTINUOUS_ATTAINS_SUP) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `inf {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_INF THEN ASM SET_TAC[]; EXISTS_TAC `sup {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_SUP_LE THEN ASM SET_TAC[]]; EXISTS_TAC `(lambda j. if j = i then (x:real^N)$i else (a:real^N)$j):real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `(lambda j. if j = i then (b:real^N)$i else (a:real^N)$j):real^N`] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_SIMP_TAC[LAMBDA_BETA]; ALL_TAC] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; let IS_INTERVAL_1 = prove (`!s:real^1->bool. is_interval s <=> !a b x. a IN s /\ b IN s /\ drop a <= drop x /\ drop x <= drop b ==> x IN s`, REWRITE_TAC[is_interval; DIMINDEX_1; FORALL_1; GSYM drop] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MESON_TAC[]);; let IS_INTERVAL_1_CASES = prove (`!s:real^1->bool. is_interval s <=> s = {} \/ s = (:real^1) \/ (?a. s = {x | a < drop x}) \/ (?a. s = {x | a <= drop x}) \/ (?b. s = {x | drop x <= b}) \/ (?b. s = {x | drop x < b}) \/ (?a b. s = {x | a < drop x /\ drop x < b}) \/ (?a b. s = {x | a < drop x /\ drop x <= b}) \/ (?a b. s = {x | a <= drop x /\ drop x < b}) \/ (?a b. s = {x | a <= drop x /\ drop x <= b})`, GEN_TAC THEN REWRITE_TAC[IS_INTERVAL_1] THEN EQ_TAC THENL [DISCH_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN REAL_ARITH_TAC] THEN ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `IMAGE drop s` SUP) THEN MP_TAC(ISPEC `IMAGE drop s` INF) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN ASM_CASES_TAC `?a. !x. x IN s ==> a <= drop x` THEN ASM_CASES_TAC `?b. !x. x IN s ==> drop x <= b` THEN ASM_REWRITE_TAC[] THENL [STRIP_TAC THEN STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`inf(IMAGE drop s) IN IMAGE drop s`; `sup(IMAGE drop s) IN IMAGE drop s`] THENL [REPLICATE_TAC 8 DISJ2_TAC; REPLICATE_TAC 7 DISJ2_TAC THEN DISJ1_TAC; REPLICATE_TAC 6 DISJ2_TAC THEN DISJ1_TAC; REPLICATE_TAC 5 DISJ2_TAC THEN DISJ1_TAC] THEN MAP_EVERY EXISTS_TAC [`inf(IMAGE drop s)`; `sup(IMAGE drop s)`]; STRIP_TAC THEN ASM_CASES_TAC `inf(IMAGE drop s) IN IMAGE drop s` THENL [REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC; DISJ2_TAC THEN DISJ1_TAC] THEN EXISTS_TAC `inf(IMAGE drop s)`; STRIP_TAC THEN ASM_CASES_TAC `sup(IMAGE drop s) IN IMAGE drop s` THENL [REPLICATE_TAC 3 DISJ2_TAC THEN DISJ1_TAC; REPLICATE_TAC 4 DISJ2_TAC THEN DISJ1_TAC] THEN EXISTS_TAC `sup(IMAGE drop s)`; DISJ1_TAC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM]);; let IS_INTERVAL_1_CLAUSES = prove (`is_interval({}:real^1->bool) /\ is_interval (:real^1) /\ (!a. is_interval {x | a < drop x}) /\ (!a. is_interval {x | a <= drop x}) /\ (!b. is_interval {x | drop x < b}) /\ (!b. is_interval {x | drop x <= b}) /\ (!a b. is_interval {x | a < drop x /\ drop x < b}) /\ (!a b. is_interval {x | a < drop x /\ drop x <= b}) /\ (!a b. is_interval {x | a <= drop x /\ drop x < b}) /\ (!a b. is_interval {x | a <= drop x /\ drop x <= b})`, REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let IS_INTERVAL_PCROSS = prove (`!s:real^M->bool t:real^N->bool. is_interval s /\ is_interval t ==> is_interval(s PCROSS t)`, REWRITE_TAC[is_interval; DIMINDEX_FINITE_SUM] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!a b a' b' x x'. P a b x /\ Q a' b' x' ==> R a b x a' b' x') ==> (!a b x. P a b x) /\ (!a' b' x'. Q a' b' x') ==> (!a a' b b' x x'. R a b x a' b' x')`) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ARITH_RULE `x:num <= m ==> x <= m + n`]; FIRST_X_ASSUM(MP_TAC o SPEC `dimindex(:M) + i`) THEN ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ARITH_RULE `x:num <= n ==> m + x <= m + n`; ARITH_RULE `1 <= x ==> 1 <= m + x`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN ASM_ARITH_TAC]);; let IS_INTERVAL_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. is_interval(s PCROSS t) <=> s = {} \/ t = {} \/ is_interval s /\ is_interval t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_PCROSS] THEN REWRITE_TAC[is_interval] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN STRIP_TAC THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `y:real^N`; `b:real^M`; `y:real^N`; `x:real^M`; `y:real^N`]); MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `w:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `a:real^N`; `w:real^M`; `b:real^N`; `w:real^M`; `x:real^N`])] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[pastecart; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `1 <= i /\ i <= m + n /\ ~(i <= m) ==> 1 <= i - m /\ i - m <= n`]);; let IS_INTERVAL_INTER = prove (`!s t:real^N->bool. is_interval s /\ is_interval t ==> is_interval(s INTER t)`, REWRITE_TAC[is_interval; IN_INTER] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[]);; let INTERVAL_SUBSET_IS_INTERVAL = prove (`!s a b:real^N. is_interval s ==> (interval[a,b] SUBSET s <=> interval[a,b] = {} \/ a IN s /\ b IN s)`, REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN ASM_REWRITE_TAC[EMPTY_SUBSET] THEN EQ_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[]);; let INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD = prove (`!s x:real^N. is_interval s /\ x IN s ==> ?a b d. &0 < d /\ x IN interval[a,b] /\ interval[a,b] SUBSET s /\ ball(x,d) INTER s SUBSET interval[a,b]`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. (?y. y IN s /\ y$i = a) /\ (a < x$i \/ a = (x:real^N)$i /\ !y:real^N. y IN s ==> a <= y$i)` MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?b. (?y. y IN s /\ y$i = b) /\ (x$i < b \/ b = (x:real^N)$i /\ !y:real^N. y IN s ==> y$i <= b)` MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN EXISTS_TAC `min (inf (IMAGE (\i. if a$i < x$i then (x:real^N)$i - (a:real^N)$i else &1) (1..dimindex(:N)))) (inf (IMAGE (\i. if x$i < b$i then (b:real^N)$i - x$i else &1) (1..dimindex(:N))))` THEN REWRITE_TAC[REAL_LT_MIN; SUBSET; IN_BALL; IN_INTER] THEN SIMP_TAC[REAL_LT_INF_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE; FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL] THEN REPEAT CONJ_TAC THENL [MESON_TAC[REAL_SUB_LT; REAL_LT_01]; MESON_TAC[REAL_SUB_LT; REAL_LT_01]; ASM_MESON_TAC[REAL_LE_LT]; DISJ2_TAC THEN CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN ASM_MESON_TAC[]; X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN (COND_CASES_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]]) THEN DISCH_TAC THEN MP_TAC(ISPECL [`x - y:real^N`; `i:num`] COMPONENT_LE_NORM) THEN ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);; let IS_INTERVAL_SUMS = prove (`!s t:real^N->bool. is_interval s /\ is_interval t ==> is_interval {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[is_interval] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `a':real^N`; `b:real^N`; `b':real^N`; `y:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPECL [`a:real^N`; `b:real^N`]) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPECL [`a':real^N`; `b':real^N`]) STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IMP_IMP; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `z:real^N = x + y <=> y = z - x`] THEN REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(MESON[] `(?x. P x /\ Q(f x)) ==> (!x. P x ==> x IN s) /\ (!x. Q x ==> x IN t) ==> ?x. x IN s /\ f x IN t`) THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `c <= y - x /\ y - x <= d <=> y - d <= x /\ x <= y - c`] THEN REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=> min a b <= x /\ x <= max a b`] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> (p /\ r) /\ (q /\ s)`] THEN REWRITE_TAC[GSYM REAL_LE_MIN; GSYM REAL_MAX_LE] THEN REWRITE_TAC[GSYM REAL_LE_BETWEEN] THEN REAL_ARITH_TAC);; let IS_INTERVAL_SING = prove (`!a:real^N. is_interval {a}`, SIMP_TAC[is_interval; IN_SING; IMP_CONJ; CART_EQ; REAL_LE_ANTISYM]);; let IS_INTERVAL_SCALING = prove (`!s:real^N->bool c. is_interval s ==> is_interval(IMAGE (\x. c % x) s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` STRIP_ASSUME_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; ASM_REWRITE_TAC[IS_INTERVAL_SING]]; REWRITE_TAC[is_interval; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_REWRITE_TAC (BINOP_CONV o REDEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; VECTOR_MUL_COMPONENT] THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) [`a:real^N`; `b:real^N`] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(SPEC `inv(c) % x:real^N` th)) THEN ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; IN_IMAGE] THEN ANTS_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(c = &0) ==> &0 < c \/ &0 < --c`)) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LE_NEG2] THEN ASM_SIMP_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REAL_ARITH_TAC; DISCH_TAC THEN EXISTS_TAC `inv c % x:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]);; let IS_INTERVAL_SCALING_EQ = prove (`!s:real^N->bool c. is_interval(IMAGE (\x. c % x) s) <=> c = &0 \/ is_interval s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` STRIP_ASSUME_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; ASM_REWRITE_TAC[IS_INTERVAL_SING]]; ASM_REWRITE_TAC[] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP IS_INTERVAL_SCALING) THEN ASM_SIMP_TAC[GSYM IMAGE_o; VECTOR_MUL_ASSOC; o_DEF; REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let IS_INTERVAL_REFLECT = prove (`!s:real^N->bool. is_interval(IMAGE (--) s) <=> is_interval s`, GEN_TAC THEN TRANS_TAC EQ_TRANS `is_interval(IMAGE (\x:real^N. --(&1) % x) s)` THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_MUL_LNEG; VECTOR_MUL_LID] THEN REWRITE_TAC[ETA_AX]; REWRITE_TAC[IS_INTERVAL_SCALING_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let lemma = prove (`!c. &0 < c ==> !s:real^N->bool. is_interval(IMAGE (\x. c % x) s) <=> is_interval s`, SIMP_TAC[IS_INTERVAL_SCALING_EQ; REAL_LT_IMP_NZ]) in add_scaling_theorems [lemma];; let CARD_FRONTIER_INTERVAL_1 = prove (`!s:real^1->bool. is_interval s ==> FINITE(frontier s) /\ CARD(frontier s) <= 2`, let lemma = prove (`~(?a b c. drop a < drop b /\ drop b < drop c /\ a IN s /\ b IN s /\ c IN s) ==> FINITE s /\ CARD(s) <= 2`, ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN REWRITE_TAC[ARITH_RULE `~(n <= 2) <=> 3 <= n`] THEN DISCH_THEN(MP_TAC o MATCH_MP CHOOSE_SUBSET_STRONG) THEN REWRITE_TAC[HAS_SIZE_CONV `t HAS_SIZE 3`] THEN REWRITE_TAC[CONJ_ASSOC; MESON[] `(?t. P t /\ ?x y z. Q x y z /\ t = f x y z) <=> (?x y z. Q x y z /\ P(f x y z))`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; GSYM CONJ_ASSOC; FORALL_LIFT; LIFT_EQ] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN MATCH_MP_TAC(MESON[REAL_LE_TOTAL] `(!m n p:real. P m n p ==> P n p m /\ P n m p) /\ (!m n p. m <= n /\ n <= p ==> P m n p) ==> !m n p. P m n p`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FORALL_DROP; DROP_EQ; LIFT_DROP] THEN REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN MESON_TAC[]) in GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN REWRITE_TAC[NOT_EXISTS_THM; FRONTIER_CLOSURES; IN_INTER] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`] THEN STRIP_TAC THEN MAP_EVERY UNDISCH_TAC [`b IN closure ((:real^1) DIFF s)`; `(a:real^1) IN closure s`; `(c:real^1) IN closure s`] THEN SIMP_TAC[CLOSURE_APPROACHABLE; IN_DIFF; IN_UNIV; DIST_REAL; GSYM drop] THEN DISCH_THEN(MP_TAC o SPEC `(drop c - drop b) / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^1` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(drop b - drop a) / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `min ((drop b - drop a) / &2) ((drop c - drop b) / &2)`) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT; REAL_LT_MIN] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^1` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`; `w:real^1`]) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let UNION_INTERVAL_SUBSET_INTERVAL = prove (`!s a b c d:real^N. is_interval s /\ interval[a,b] SUBSET s /\ interval[c,d] SUBSET s ==> ?u v. interval[a,b] UNION interval[c,d] SUBSET interval[u,v] /\ interval[u,v] SUBSET s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM_REWRITE_TAC[UNION_EMPTY] THEN MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN ASM_CASES_TAC `interval[c:real^N,d] = {}` THENL [ASM_REWRITE_TAC[UNION_EMPTY] THEN MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN REWRITE_TAC[is_interval; GSYM UNION_SUBSET] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(lambda i. min ((a:real^N)$i) ((c:real^N)$i)):real^N` THEN EXISTS_TAC `(lambda i. max ((b:real^N)$i) ((d:real^N)$i)):real^N` THEN SIMP_TAC[UNION_SUBSET; SUBSET_INTERVAL; LAMBDA_BETA] THEN REPEAT(CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN SIMP_TAC[SUBSET; IN_INTERVAL; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(lambda i. min ((a:real^N)$i) ((c:real^N)$i)):real^N` THEN EXISTS_TAC `(lambda i. max ((b:real^N)$i) ((d:real^N)$i)):real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THENL [MAP_EVERY EXISTS_TAC [`a:real^N`; `c:real^N`]; MAP_EVERY EXISTS_TAC [`b:real^N`; `d:real^N`]] THEN SIMP_TAC[LAMBDA_BETA; CONJ_ASSOC] THEN (CONJ_TAC THENL [CONJ_TAC; REAL_ARITH_TAC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_UNION; ENDS_IN_INTERVAL]);; (* ------------------------------------------------------------------------- *) (* Limit component bounds. *) (* ------------------------------------------------------------------------- *) let LIM_COMPONENT_UBOUND = prove (`!net:(A)net f (l:real^N) b k. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. (f x)$k <= b) net /\ 1 <= k /\ k <= dimindex(:N) ==> l$k <= b`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->real^N`; `{y:real^N | basis k dot y <= b}`; `l:real^N`] LIM_IN_CLOSED_SET) THEN ASM_SIMP_TAC[CLOSED_HALFSPACE_LE; IN_ELIM_THM; DOT_BASIS]);; let LIM_COMPONENT_LBOUND = prove (`!net:(A)net f (l:real^N) b k. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= (f x)$k) net /\ 1 <= k /\ k <= dimindex(:N) ==> b <= l$k`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->real^N`; `{y:real^N | b <= basis k dot y}`; `l:real^N`] LIM_IN_CLOSED_SET) THEN ASM_SIMP_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_GE; IN_ELIM_THM; DOT_BASIS]);; let LIM_COMPONENT_EQ = prove (`!net f:A->real^N i l b. (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) /\ ~(trivial_limit net) /\ eventually (\x. f(x)$i = b) net ==> l$i = b`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; EVENTUALLY_AND] THEN MESON_TAC[LIM_COMPONENT_UBOUND; LIM_COMPONENT_LBOUND]);; let LIM_COMPONENT_LE = prove (`!net:(A)net f:A->real^N g:A->real^N k l m. ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ eventually (\x. (f x)$k <= (g x)$k) net /\ 1 <= k /\ k <= dimindex(:N) ==> l$k <= m$k`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; LIM_COMPONENT_LBOUND] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b /\ a ==> c ==> d`] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; LIM_COMPONENT_LBOUND]);; let LIM_DROP_LE = prove (`!net:(A)net f g l m. ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ eventually (\x. drop(f x) <= drop(g x)) net ==> drop l <= drop m`, REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `net:(A)net` LIM_COMPONENT_LE) THEN MAP_EVERY EXISTS_TAC [`f:A->real^1`; `g:A->real^1`] THEN ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; let LIM_DROP_UBOUND = prove (`!net f:A->real^1 l b. (f --> l) net /\ ~(trivial_limit net) /\ eventually (\x. drop(f x) <= b) net ==> drop l <= b`, SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_COMPONENT_UBOUND THEN REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; let LIM_DROP_LBOUND = prove (`!net f:A->real^1 l b. (f --> l) net /\ ~(trivial_limit net) /\ eventually (\x. b <= drop(f x)) net ==> b <= drop l`, SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; let LIMIT_PAIR_DROP_LE = prove (`!net1:(A)net net2:(B)net f g l m. ~(trivial_limit net1) /\ ~(trivial_limit net2) /\ (f --> l) net1 /\ (g --> m) net2 /\ eventually (\x. eventually (\y. drop(f x) <= drop(g y)) net2) net1 ==> drop l <= drop m`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN UNDISCH_TAC `((g:B->real^1) --> m) net2` THEN UNDISCH_TAC `((f:A->real^1) --> l) net1` THEN REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `(drop l - drop m) / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN GEN_REWRITE_TAC LAND_CONV [eventually] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a0:A` (MP_TAC o MATCH_MP (MESON[] `(?x. P x) /\ (!x. P x ==> Q x) ==> ?x. Q x`))) THEN DISCH_THEN(X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o SPEC `(drop l - drop m) / &2`) THEN MP_TAC th) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`; GSYM EVENTUALLY_AND] THEN ASM_REWRITE_TAC[eventually] THEN DISCH_THEN(X_CHOOSE_THEN `b0:B` (MP_TAC o MATCH_MP (MESON[] `(?x. P x) /\ (!x. P x ==> Q x) ==> ?x. Q x`))) THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_1]) THEN REWRITE_TAC[DIST_1] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Also extending closed bounds to closures. *) (* ------------------------------------------------------------------------- *) let IMAGE_CLOSURE_SUBSET = prove (`!f (s:real^N->bool) (t:real^M->bool). f continuous_on closure s /\ closed t /\ IMAGE f s SUBSET t ==> IMAGE f (closure s) SUBSET t`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `closure s SUBSET {x | (f:real^N->real^M) x IN t}` MP_TAC THENL [MATCH_MP_TAC SUBSET_TRANS; SET_TAC []] THEN EXISTS_TAC `{x | x IN closure s /\ (f:real^N->real^M) x IN t}` THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL; SET_TAC[]] THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CLOSURE] THEN MP_TAC (ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);; let CLOSURE_IMAGE_CLOSURE = prove (`!f:real^M->real^N s. f continuous_on closure s ==> closure(IMAGE f (closure s)) = closure(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[SUBSET_CLOSURE; IMAGE_SUBSET; CLOSURE_SUBSET] THEN SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_CLOSURE] THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET]);; let CLOSURE_IMAGE_BOUNDED = prove (`!f:real^M->real^N s. f continuous_on closure s /\ bounded s ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `closure(IMAGE (f:real^M->real^N) (closure s))` THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSURE_IMAGE_CLOSURE]; ALL_TAC] THEN MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]);; let CONTINUOUS_ON_CLOSURE_NORM_LE = prove (`!f:real^N->real^M s x b. f continuous_on (closure s) /\ (!y. y IN s ==> norm(f y) <= b) /\ x IN (closure s) ==> norm(f x) <= b`, REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET cball(vec 0,b)` MP_TAC THENL [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN ASM_REWRITE_TAC [CLOSED_CBALL] THEN ASM SET_TAC []);; let CONTINUOUS_ON_CLOSURE_COMPONENT_LE = prove (`!f:real^N->real^M s x b k. f continuous_on (closure s) /\ (!y. y IN s ==> (f y)$k <= b) /\ x IN (closure s) ==> (f x)$k <= b`, REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k <= b}` MP_TAC THENL [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM SET_TAC[]);; let CONTINUOUS_ON_CLOSURE_COMPONENT_GE = prove (`!f:real^N->real^M s x b k. f continuous_on (closure s) /\ (!y. y IN s ==> b <= (f y)$k) /\ x IN (closure s) ==> b <= (f x)$k`, REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k >= b}` MP_TAC THENL [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC [real_ge]] THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM SET_TAC[real_ge]);; let CONTINUOUS_MAP_CLOSURES_GEN = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. t SUBSET s ==> IMAGE f (s INTER closure t) SUBSET closure(IMAGE f t)`, REWRITE_TAC[SET_RULE `IMAGE f s SUBSET t <=> s SUBSET {x | x IN s /\ f x IN t}`] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [MATCH_MP_TAC CLOSURE_MINIMAL_LOCAL THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `s INTER closure t:real^M->bool` THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET; CLOSED_CLOSURE]; SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INTER; CLOSURE_INC; FUN_IN_IMAGE] THEN ASM_REWRITE_TAC[GSYM SUBSET]]; REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET; SUBSET_RESTRICT] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM SET_TAC[]]);; let CONTINUOUS_MAP_CLOSURES = prove (`!f:real^M->real^N. f continuous_on UNIV <=> !s. IMAGE f (closure s) SUBSET closure(IMAGE f s)`, REWRITE_TAC[CONTINUOUS_MAP_CLOSURES_GEN; SUBSET_UNIV; INTER_UNIV]);; (* ------------------------------------------------------------------------- *) (* Relating images and frontiers. *) (* ------------------------------------------------------------------------- *) let PROPER_MAP_ESCAPES_FROM_IMAGE = prove (`!f:real^M->real^N s t x r a b. IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!n. x n IN s) /\ ~(a IN s) /\ (x --> a) sequentially /\ (!m n. m < n ==> r m < r n) /\ ((f o x o r) --> b) sequentially ==> ~(b IN IMAGE f s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`; `x:num->real^M`] PROPER_MAP_ESCAPES_IMP) THEN ASM_SIMP_TAC[NOT_IMP; SEQUENCE_ESCAPES; NOT_EXISTS_THM] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a':real^M`; `r':num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `a':real^M = a` (fun th -> ASM_MESON_TAC[th]) THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(x:num->real^M) o (r':num->num)` THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; TRIVIAL_LIMIT_SEQUENTIALLY]; W(MP_TAC o PART_MATCH (lhand o rand) SEQUENCE_ESCAPES o rand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN MAP_EVERY EXISTS_TAC [`b:real^N`; `r:num->num`] THEN ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);; let FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ f continuous_on closure s /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) ==> IMAGE f (closure s DIFF s) SUBSET closure(IMAGE f s) DIFF IMAGE f s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `IMAGE f c SUBSET c' /\ IMAGE f (c DIFF i) INTER i' = {} ==> IMAGE f (c DIFF i) SUBSET c' DIFF i'`) THEN CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `s:real^M->bool` o GEN_REWRITE_RULE I [CONTINUOUS_MAP_CLOSURES_GEN]) THEN REWRITE_TAC[CLOSURE_SUBSET; INTER_IDEMPOT]; REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_DIFF] THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC PROPER_MAP_ESCAPES_FROM_IMAGE THEN EXISTS_TAC `t:real^N->bool` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSURE_SEQUENTIAL]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`I:num->num`; `a:real^M`] THEN ASM_REWRITE_TAC[I_O_ID; I_THM] THEN ASM_MESON_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY]]);; let FRONTIER_PROPER_MAP_IMAGE_SUBSET = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ open s /\ f continuous_on closure s /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) ==> IMAGE f (frontier s) SUBSET frontier(IMAGE f s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN) THEN ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN MP_TAC(ISPEC `IMAGE (f:real^M->real^N) s` INTERIOR_SUBSET) THEN SET_TAC[]);; let FRONTIER_CLOPEN_MAP_IMAGE_SUBSET = prove (`!f:real^M->real^N s. closed(IMAGE f (closure s)) /\ open(IMAGE f (interior s)) ==> frontier(IMAGE f s) SUBSET IMAGE f (frontier s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE `IMAGE f i SUBSET i' /\ c' SUBSET IMAGE f c ==> c' DIFF i' SUBSET IMAGE f (c DIFF i)`) THEN CONJ_TAC THENL [MATCH_MP_TAC INTERIOR_MAXIMAL; MATCH_MP_TAC CLOSURE_MINIMAL] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; let FRONTIER_OPEN_MAP_IMAGE_SUBSET = prove (`!f:real^M->real^N s. bounded s /\ f continuous_on closure s /\ open(IMAGE f (interior s)) ==> frontier(IMAGE f s) SUBSET IMAGE f (frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_CLOPEN_MAP_IMAGE_SUBSET THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]);; let FRONTIER_PROPER_CLOPEN_MAP_IMAGE = prove (`!f:real^M->real^N s t. open s /\ IMAGE f s SUBSET t /\ f continuous_on closure s /\ open(IMAGE f s) /\ closed(IMAGE f (closure s)) /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) ==> IMAGE f (frontier s) = frontier(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN ASM_SIMP_TAC[FRONTIER_CLOPEN_MAP_IMAGE_SUBSET; INTERIOR_OPEN] THEN MATCH_MP_TAC FRONTIER_PROPER_MAP_IMAGE_SUBSET THEN ASM_MESON_TAC[]);; let FRONTIER_PROPER_OPEN_MAP_IMAGE = prove (`!f:real^M->real^N s t. bounded s /\ open s /\ open(IMAGE f s) /\ f continuous_on closure s /\ IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) ==> IMAGE f (frontier s) = frontier(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN ASM_SIMP_TAC[FRONTIER_OPEN_MAP_IMAGE_SUBSET; INTERIOR_OPEN] THEN MATCH_MP_TAC FRONTIER_PROPER_MAP_IMAGE_SUBSET THEN ASM_MESON_TAC[]);; let FRONTIER_CLOPEN_MAP_IMAGE = prove (`!f:real^M->real^N s t. open s /\ open(IMAGE f s) /\ closed(IMAGE f (closure s)) /\ f continuous_on closure s /\ (!y. compact {x | x IN s /\ f x = y}) /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) ==> IMAGE f (frontier s) = frontier(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_PROPER_CLOPEN_MAP_IMAGE THEN ASM_REWRITE_TAC[PROPER_MAP_EQ] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Limits relative to a union. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_UNION = prove (`(f --> l) (at x within (s UNION t)) <=> (f --> l) (at x within s) /\ (f --> l) (at x within t)`, REWRITE_TAC[LIM_WITHIN; IN_UNION; AND_FORALL_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `k:real`)) THEN EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_UNION = prove (`!f s t. closed s /\ closed t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REWRITE_TAC[CONTINUOUS_ON; CLOSED_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; let CONTINUOUS_ON_CASES = prove (`!P f g:real^M->real^N s t. closed s /\ closed t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_UNION_LOCAL = prove (`!f:real^M->real^N s. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REWRITE_TAC[CONTINUOUS_ON; CLOSED_IN_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; let CONTINUOUS_ON_CASES_LOCAL = prove (`!P f g:real^M->real^N s t. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_CASES_LE = prove (`!f g:real^M->real^N h s a. f continuous_on {t | t IN s /\ h t <= a} /\ g continuous_on {t | t IN s /\ a <= h t} /\ (lift o h) continuous_on s /\ (!t. t IN s /\ h t = a ==> f t = g t) ==> (\t. if h t <= a then f(t) else g(t)) continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `{t | t IN s /\ (h:real^M->real) t <= a} UNION {t | t IN s /\ a <= h t}` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUBSET; IN_UNION; IN_ELIM_THM; REAL_LE_TOTAL]] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; REAL_LE_ANTISYM] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN CONJ_TAC THENL [SUBGOAL_THEN `{t | t IN s /\ (h:real^M->real) t <= a} = {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ (lift o h) t IN {x | x$1 <= a}}` (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THENL [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; IN_UNION] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]]; SUBGOAL_THEN `{t | t IN s /\ a <= (h:real^M->real) t} = {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ (lift o h) t IN {x | x$1 >= a}}` (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THENL [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; IN_UNION] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE; ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]]]);; let CONTINUOUS_ON_CASES_1 = prove (`!f g:real^1->real^N s a. f continuous_on {t | t IN s /\ drop t <= a} /\ g continuous_on {t | t IN s /\ a <= drop t} /\ (lift a IN s ==> f(lift a) = g(lift a)) ==> (\t. if drop t <= a then f(t) else g(t)) continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN ASM_MESON_TAC[]);; let EXTENSION_FROM_CLOPEN = prove (`!f:real^M->real^N s t u. open_in (subtopology euclidean s) t /\ closed_in (subtopology euclidean s) t /\ f continuous_on t /\ IMAGE f t SUBSET u /\ (u = {} ==> s = {}) ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ !x. x IN t ==> g x = f x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; SUBSET_EMPTY; IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else a` THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `s:real^M->bool = t UNION (s DIFF t)` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`] THEN REWRITE_TAC[CONTINUOUS_ON_CONST; IN_DIFF] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF; MESON_TAC[]] THEN ASM_REWRITE_TAC[CLOSED_IN_REFL]);; let CONTINUOUS_ON_CLOPEN_INDICATOR = prove (`!s t:real^M->bool a b:real^N. (\x. if x IN t then a else b) continuous_on s <=> a = b \/ open_in (subtopology euclidean s) (s INTER t) /\ closed_in (subtopology euclidean s) (s INTER t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[COND_ID; CONTINUOUS_ON_CONST] THEN EQ_TAC THENL [ DISCH_TAC THEN SUBGOAL_THEN `s INTER t = {x:real^M | x IN s /\ (if x IN t then a else b:real^N) IN {a}}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN] THEN EXISTS_TAC `{a:real^N,b}` THEN ASM_REWRITE_TAC[] THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[CLOSED_IN_SING; OPEN_IN_SING; IN_INSERT] THEN SIMP_TAC[LIMIT_POINT_FINITE; FINITE_RULES]; STRIP_TAC THEN SUBST1_TAC(SET_RULE `s:real^M->bool = (s INTER t) UNION (s DIFF t)`) THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REWRITE_TAC[SET_RULE `(s INTER t) UNION (s DIFF t) = s`] THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF s INTER t`] THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]]);; (* ------------------------------------------------------------------------- *) (* Componentwise limits and continuity. *) (* ------------------------------------------------------------------------- *) let LIM_COMPONENTWISE_LIFT = prove (`!net f:A->real^N. (f --> l) net <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. lift((f x)$i)) --> lift(l$i)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH `y <= x ==> x < e ==> y < e`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM LIFT_SUB; NORM_LIFT; GSYM VECTOR_SUB_COMPONENT]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[GSYM IN_NUMSEG; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_EVENTUALLY; FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `x:A` THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist] THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1; CARD_NUMSEG_1; GSYM IN_NUMSEG]]);; let CONTINUOUS_COMPONENTWISE_LIFT = prove (`!net f:A->real^N. f continuous net <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift((f x)$i)) continuous net`, REWRITE_TAC[continuous; GSYM LIM_COMPONENTWISE_LIFT]);; let CONTINUOUS_ON_COMPONENTWISE_LIFT = prove (`!f:real^M->real^N s. f continuous_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift((f x)$i)) continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONTINUOUS_COMPONENTWISE_LIFT] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Various formulations of limits for linear operators. *) (* ------------------------------------------------------------------------- *) let LIM_NULL_ONORM,LIM_NULL_ONORM_COMPONENTWISE = (CONJ_PAIR o prove) (`(!net f:A->real^M->real^N. (!a. linear(f a)) ==> (((\a. lift(onorm(f a))) --> vec 0) net <=> !x. ((\a. f a x) --> vec 0) net)) /\ (!net f:A->real^M->real^N. (!a. linear(f a)) ==> (((\a. lift(onorm(f a))) --> vec 0) net <=> !i. 1 <= i /\ i <= dimindex(:M) ==> ((\a. f a (basis i)) --> vec 0) net))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (p ==> q) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN SIMP_TAC[] THEN CONJ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\a. onorm((f:A->real^M->real^N) a) * norm(x:real^M)` THEN ASM_SIMP_TAC[ONORM; EVENTUALLY_TRUE; LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_VMUL THEN ASM_REWRITE_TAC[]; DISCH_TAC THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\a. sum(1..dimindex(:M)) (\i. norm((f:A->real^M->real^N) a (basis i)))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_SIMP_TAC[ONORM_LE_EQ; NORM_LIFT; real_abs; ONORM_POS_LE] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG; o_DEF] THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG; GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE; COMPONENT_LE_NORM]; REWRITE_TAC[LIFT_SUM] THEN MATCH_MP_TAC LIM_NULL_VSUM THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; GSYM LIM_NULL_NORM; o_DEF]]]);; let LIM_NULL_MATRIX_ONORM = prove (`!net A:A->real^M^N. ((\a. lift(onorm(\x. A a ** x))) --> vec 0) net <=> !x. ((\a. A a ** x) --> vec 0) net`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`net:A net`; `\a x:real^M. (A:A->real^M^N) a ** x`] LIM_NULL_ONORM) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; let LIM_NULL_MATRIX_ONORM_COMPONENTWISE = prove (`!net A:A->real^M^N. ((\a. lift(onorm(\x. A a ** x))) --> vec 0) net <=> !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> ((\a. lift(A a$i$j)) --> vec 0) net`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`net:A net`; `\a x:real^M. (A:A->real^M^N) a ** x`] LIM_NULL_ONORM_COMPONENTWISE) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LIM_COMPONENTWISE_LIFT] THEN SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; LAMBDA_BETA] THEN REWRITE_TAC[VEC_COMPONENT; LIFT_NUM] THEN MESON_TAC[]);; let LIM_NULL_ONORM = prove (`!net f:A->real^M->real^N g:real^M->real^N. (!a. linear(f a)) /\ linear g /\ ((\a. lift(onorm(\x. f a x - g x))) --> vec 0) net ==> ((\a. lift(onorm(f a))) --> lift(onorm g)) net`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_NULL_COMPARISON) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `a:A` THEN REWRITE_TAC[NORM_1; DROP_SUB; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH `f <= g + d /\ g <= f + d ==> abs(f - g) <= d`) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM ONORM_NEG] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [GSYM ONORM_NEG] THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) ONORM_TRIANGLE o rand o snd) THEN ASM_SIMP_TAC[LINEAR_COMPOSE_SUB; LINEAR_COMPOSE_NEG; ETA_AX] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC VECTOR_ARITH);; let LIM_MATRIX_COMPONENTWISE = prove (`!net A:A->real^M^N B. (!x. ((\a. A a ** x) --> B ** x) net) <=> !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> ((\a. lift(A a$i$j)) --> lift(B$i$j)) net`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM LIFT_SUB; GSYM MATRIX_SUB_COMPONENT] THEN REWRITE_TAC[GSYM LIM_NULL_MATRIX_ONORM] THEN REWRITE_TAC[LIM_NULL_MATRIX_ONORM_COMPONENTWISE]);; let CONTINUOUS_MATRIX_COMPONENTWISE = prove (`!net (A:A->real^M^N). (!x. (\a. A a ** x) continuous net) <=> !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M) ==> (\a. lift (A a$i$j)) continuous net`, REWRITE_TAC[continuous; LIM_MATRIX_COMPONENTWISE]);; let CONTINUOUS_ON_MATRIX_COMPONENTWISE = prove (`!A:real^P->real^M^N s. (!x. (\a. A a ** x) continuous_on s) <=> !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex (:M) ==> (\a. lift (A a$i$j)) continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONTINUOUS_MATRIX_COMPONENTWISE] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some more convenient intermediate-value theorem formulations. *) (* ------------------------------------------------------------------------- *) let CONNECTED_IVT_HYPERPLANE = prove (`!s x y:real^N a b. connected s /\ x IN s /\ y IN s /\ a dot x <= b /\ b <= a dot y ==> ?z. z IN s /\ a dot z = b`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`{x:real^N | a dot x < b}`; `{x:real^N | a dot x > b}`]) THEN REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; SUBSET; IN_UNION; REAL_LT_LE; real_gt] THEN ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM]);; let CONNECTED_IVT_COMPONENT = prove (`!s x y:real^N a k. connected s /\ x IN s /\ y IN s /\ 1 <= k /\ k <= dimindex(:N) /\ x$k <= a /\ a <= y$k ==> ?z. z IN s /\ z$k = a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `y:real^N`; `(basis k):real^N`; `a:real`] CONNECTED_IVT_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS]);; (* ------------------------------------------------------------------------- *) (* Rather trivial observation that we can map any connected set on segment. *) (* ------------------------------------------------------------------------- *) let MAPPING_CONNECTED_ONTO_SEGMENT = prove (`!s:real^M->bool a b:real^N. connected s /\ ~(?a. s SUBSET {a}) ==> ?f. f continuous_on s /\ IMAGE f s = segment[a,b]`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(?a. s SUBSET {a}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^M. a + dist(u,x) / (dist(u,x) + dist(v,x)) % (b - a:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST]; REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN MATCH_MP_TAC(SET_RULE `IMAGE f s = {x | P x} ==> IMAGE (\x. a + f x % b) s = {a + u % b:real^N | P u}`) THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_ARITH `~(u:real^N = v) ==> &0 < dist(u,x) + dist(v,x)`] THEN CONJ_TAC THENL [CONV_TAC NORM_ARITH; REWRITE_TAC[IN_IMAGE]] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (\x:real^M. lift(dist(u,x) / (dist(u,x) + dist(v,x)))) s`; `vec 0:real^1`; `vec 1:real^1`; `t:real`; `1`] CONNECTED_IVT_COMPONENT) THEN ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH_LE] THEN REWRITE_TAC[EXISTS_IN_IMAGE; GSYM drop; LIFT_DROP] THEN ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE]; MESON_TAC[]] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[]; EXISTS_TAC `u:real^M` THEN ASM_REWRITE_TAC[DIST_REFL; real_div] THEN REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN REAL_ARITH_TAC; EXISTS_TAC `v:real^M` THEN ASM_REWRITE_TAC[DIST_REFL] THEN ASM_SIMP_TAC[REAL_DIV_REFL; DIST_EQ_0; REAL_ADD_RID] THEN REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]]] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_DIST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[LIFT_ADD; NORM_ARITH `~(u:real^N = v) ==> ~(dist(u,x) + dist(v,x) = &0)`] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]);; (* ------------------------------------------------------------------------- *) (* Also more convenient formulations of monotone convergence. *) (* ------------------------------------------------------------------------- *) let BOUNDED_INCREASING_CONVERGENT = prove (`!s:num->real^1. bounded {s n | n IN (:num)} /\ (!n. drop(s n) <= drop(s(SUC n))) ==> ?l. (s --> l) sequentially`, GEN_TAC THEN REWRITE_TAC[bounded; IN_ELIM_THM; ABS_DROP; LIM_SEQUENTIALLY; dist; DROP_SUB; IN_UNIV; GSYM EXISTS_DROP] THEN DISCH_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISJ1_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; let BOUNDED_DECREASING_CONVERGENT = prove (`!s:num->real^1. bounded {s n | n IN (:num)} /\ (!n. drop(s(SUC n)) <= drop(s(n))) ==> ?l. (s --> l) sequentially`, GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPEC `\n. --((s:num->real^1) n)` BOUNDED_INCREASING_CONVERGENT) THEN ASM_SIMP_TAC[bounded; FORALL_IN_GSPEC; NORM_NEG; DROP_NEG; REAL_LE_NEG2] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Since we'll use some cardinality reasoning, add invariance theorems. *) (* ------------------------------------------------------------------------- *) let card_translation_invariants = (CONJUNCTS o prove) (`(!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s =_c t <=> s =_c t) /\ (!a (s:A->bool) (t:real^N->bool). s =_c IMAGE (\x. a + x) t <=> s =_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s <_c t <=> s <_c t) /\ (!a (s:A->bool) (t:real^N->bool). s <_c IMAGE (\x. a + x) t <=> s <_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s <=_c t <=> s <=_c t) /\ (!a (s:A->bool) (t:real^N->bool). s <=_c IMAGE (\x. a + x) t <=> s <=_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s >_c t <=> s >_c t) /\ (!a (s:A->bool) (t:real^N->bool). s >_c IMAGE (\x. a + x) t <=> s >_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s >=_c t <=> s >=_c t) /\ (!a (s:A->bool) (t:real^N->bool). s >=_c IMAGE (\x. a + x) t <=> s >=_c t)`, REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG] THEN REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]) in add_translation_invariants card_translation_invariants;; let card_linear_invariants = (CONJUNCTS o prove) (`(!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s =_c t <=> s =_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s =_c IMAGE f t <=> s =_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s <_c t <=> s <_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s <_c IMAGE f t <=> s <_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s <=_c t <=> s <=_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s <=_c IMAGE f t <=> s <=_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s >_c t <=> s >_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s >_c IMAGE f t <=> s >_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s >=_c t <=> s >=_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s >=_c IMAGE f t <=> s >=_c t))`, REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG] THEN REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN ASM_MESON_TAC[]) in add_linear_invariants card_linear_invariants;; (* ------------------------------------------------------------------------- *) (* Basic homeomorphism definitions. *) (* ------------------------------------------------------------------------- *) let homeomorphism = new_definition `homeomorphism (s,t) (f,g) <=> (!x. x IN s ==> (g(f(x)) = x)) /\ (IMAGE f s = t) /\ f continuous_on s /\ (!y. y IN t ==> (f(g(y)) = y)) /\ (IMAGE g t = s) /\ g continuous_on t`;; parse_as_infix("homeomorphic",(12,"right"));; let homeomorphic = new_definition `s homeomorphic t <=> ?f g. homeomorphism (s,t) (f,g)`;; let HOMEOMORPHISM = prove (`!s:real^M->bool t:real^N->bool f g. homeomorphism (s,t) (f,g) <=> f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ (!x. x IN s ==> g (f x) = x) /\ (!y. y IN t ==> f (g y) = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN EQ_TAC THEN SIMP_TAC[] THEN SET_TAC[]);; let HOMEOMORPHISM_IMP_HOMEOMORPHIC = prove (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) ==> s homeomorphic t`, REWRITE_TAC[homeomorphic] THEN MESON_TAC[]);; let HOMEOMORPHISM_OF_SUBSETS = prove (`!f g s t s' t'. homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ IMAGE f s' = t' ==> homeomorphism (s',t') (f,g)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_SUBSET) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_OF_SUBSETS_ALT = prove (`!f:real^M->real^N g s t s' t'. homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ (!x. x IN s ==> (f x IN t' <=> x IN s')) ==> homeomorphism (s',t') (f,g)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN FIRST_ASSUM(MP_TAC o el 1 o CONJUNCTS o REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_ID = prove (`!s:real^N->bool. homeomorphism (s,s) ((\x. x),(\x. x))`, REWRITE_TAC[homeomorphism; IMAGE_ID; CONTINUOUS_ON_ID]);; let HOMEOMORPHISM_I = prove (`!s:real^N->bool. homeomorphism (s,s) (I,I)`, REWRITE_TAC[I_DEF; HOMEOMORPHISM_ID]);; let HOMEOMORPHIC_REFL = prove (`!s:real^N->bool. s homeomorphic s`, REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_I]);; let HOMEOMORPHISM_SYM = prove (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) <=> homeomorphism (t,s) (g,f)`, REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);; let HOMEOMORPHIC_SYM = prove (`!s t. s homeomorphic t <=> t homeomorphic s`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);; let HOMEOMORPHISM_COMPOSE = prove (`!f:real^M->real^N g h:real^N->real^P k s t u. homeomorphism (s,t) (f,g) /\ homeomorphism (t,u) (h,k) ==> homeomorphism (s,u) (h o f,g o k)`, SIMP_TAC[homeomorphism; CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM] THEN SET_TAC[]);; let HOMEOMORPHIC_TRANS = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homeomorphic t /\ t homeomorphic u ==> s homeomorphic u`, REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPOSE]);; let HOMEOMORPHISM_EQ = prove (`!f:real^M->real^N g f' g' s t. homeomorphism (s,t) (f,g) /\ (!x. x IN s ==> f' x = f x) /\ (!y. y IN t ==> g' y = g y) ==> homeomorphism (s,t) (f',g')`, REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ]; ASM SET_TAC[]; ASM_MESON_TAC[CONTINUOUS_ON_EQ]; ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]);; let LINEAR_IMP_HOMEOMORPHISM = prove (`!f:real^M->real^N g:real^N->real^M s t. linear f /\ linear g /\ g o f = I /\ IMAGE f s = t ==> homeomorphism (s,t) (f,g)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [FUN_EQ_THM] THEN REWRITE_TAC[o_THM; I_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; let ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM = prove (`!f:real^N->real^N s t. orthogonal_transformation f /\ IMAGE f s = t ==> ?g. orthogonal_transformation g /\ homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_IMP_HOMEOMORPHISM]);; let HOMEOMORPHIC_SELF_IMAGE = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ u SUBSET s ==> IMAGE f u homeomorphic u`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHIC_IMP_CARD_EQ = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> s =_c t`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism; eq_c] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; let HOMEOMORPHIC_FINITENESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (FINITE s <=> FINITE t)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP CARD_FINITE_CONG));; let HOMEOMORPHISM_FINITENESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (FINITE(IMAGE f k) <=> FINITE k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_FINITENESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHIC_INFINITENESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (INFINITE s <=> INFINITE t)`, REWRITE_TAC[INFINITE] THEN MESON_TAC[HOMEOMORPHIC_FINITENESS]);; let HOMEOMORPHISM_INFINITENESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (INFINITE(IMAGE f k) <=> INFINITE k)`, REWRITE_TAC[INFINITE] THEN MESON_TAC[HOMEOMORPHISM_FINITENESS]);; let HOMEOMORPHIC_COUNTABILITY = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (COUNTABLE s <=> COUNTABLE t)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP CARD_COUNTABLE_CONG));; let HOMEOMORPHISM_COUNTABILITY = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (COUNTABLE(IMAGE f k) <=> COUNTABLE k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COUNTABILITY THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHIC_EMPTY = prove (`(!s. (s:real^N->bool) homeomorphic ({}:real^M->bool) <=> s = {}) /\ (!s. ({}:real^M->bool) homeomorphic (s:real^N->bool) <=> s = {})`, REWRITE_TAC[homeomorphic; homeomorphism; IMAGE_CLAUSES; IMAGE_EQ_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[continuous_on; NOT_IN_EMPTY]);; let HOMEOMORPHIC_MINIMAL = prove (`!s t. s homeomorphic t <=> ?f g. (!x. x IN s ==> f(x) IN t /\ (g(f(x)) = x)) /\ (!y. y IN t ==> g(y) IN s /\ (f(g(y)) = y)) /\ f continuous_on s /\ g continuous_on t`, REWRITE_TAC[homeomorphic; homeomorphism; EXTENSION; IN_IMAGE] THEN REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[]);; let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s) homeomorphic s`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; FORALL_IN_IMAGE; FUN_IN_IMAGE] THEN ASM_SIMP_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e * B:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[dist; GSYM LINEAR_SUB] THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> ((IMAGE f s) homeomorphic t <=> s homeomorphic t)`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o MATCH_MP HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF) THEN EQ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]); POP_ASSUM MP_TAC] THEN REWRITE_TAC[IMP_IMP; HOMEOMORPHIC_TRANS]);; let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s homeomorphic (IMAGE f t) <=> s homeomorphic t)`, ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);; add_linear_invariants [HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];; let HOMEOMORPHIC_TRANSLATION_SELF = prove (`!a:real^N s. (IMAGE (\x. a + x) s) homeomorphic s`, REPEAT GEN_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `\x:real^N. x - a` THEN EXISTS_TAC `\x:real^N. a + x` THEN SIMP_TAC[FORALL_IN_IMAGE; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ADD; VECTOR_ADD_SUB] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; let HOMEOMORPHIC_TRANSLATION_LEFT_EQ = prove (`!a:real^N s t. (IMAGE (\x. a + x) s) homeomorphic t <=> s homeomorphic t`, MESON_TAC[HOMEOMORPHIC_TRANSLATION_SELF; HOMEOMORPHIC_SYM; HOMEOMORPHIC_TRANS]);; let HOMEOMORPHIC_TRANSLATION_RIGHT_EQ = prove (`!a:real^N s t. s homeomorphic (IMAGE (\x. a + x) t) <=> s homeomorphic t`, ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ]);; add_translation_invariants [HOMEOMORPHIC_TRANSLATION_LEFT_EQ; HOMEOMORPHIC_TRANSLATION_RIGHT_EQ];; let INVOLUTION_IMP_HOMEOMORPHISM_GEN = prove (`!f:real^N->real^N u s. f continuous_on u /\ s UNION IMAGE f s SUBSET u /\ (!x. x IN s ==> f(f x) = x) ==> homeomorphism(s,IMAGE f s) (f,f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM; SUBSET_REFL] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let INVOLUTION_IMP_HOMEOMORPHISM = prove (`!f:real^N->real^N s. f continuous_on s /\ IMAGE f s SUBSET s /\ (!x. x IN s ==> f(f x) = x) ==> homeomorphism(s,s) (f,f)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`; `s:real^N->bool`] INVOLUTION_IMP_HOMEOMORPHISM_GEN) THEN ASM_REWRITE_TAC[UNION_SUBSET; SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let HOMEOMORPHISM_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) ==> !u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[SUBSET_REFL]);; let HOMEOMORPHIC_PCROSS = prove (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool. s homeomorphic s' /\ t homeomorphic t' ==> (s PCROSS t) homeomorphic (s' PCROSS t')`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:real^M->real^P` (X_CHOOSE_THEN `f':real^P->real^M` STRIP_ASSUME_TAC)) (X_CHOOSE_THEN `g:real^N->real^Q` (X_CHOOSE_THEN `g':real^Q->real^N` STRIP_ASSUME_TAC))) THEN MAP_EVERY EXISTS_TAC [`(\z. pastecart (f(fstcart z)) (g(sndcart z))) :real^(M,N)finite_sum->real^(P,Q)finite_sum`; `(\z. pastecart (f'(fstcart z)) (g'(sndcart z))) :real^(P,Q)finite_sum->real^(M,N)finite_sum`] THEN ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);; let HOMEOMORPHIC_PCROSS_SYM = prove (`!s:real^M->bool t:real^N->bool. (s PCROSS t) homeomorphic (t PCROSS s)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) :real^(M,N)finite_sum->real^(N,M)finite_sum` THEN EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) :real^(N,M)finite_sum->real^(M,N)finite_sum` THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; PASTECART_IN_PCROSS] THEN MESON_TAC[]);; let HOMEOMORPHIC_PCROSS_ASSOC = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. (s PCROSS (t PCROSS u)) homeomorphic ((s PCROSS t) PCROSS u)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC [`\z:real^(M,(N,P)finite_sum)finite_sum. pastecart (pastecart (fstcart z) (fstcart(sndcart z))) (sndcart(sndcart z))`; `\z:real^((M,N)finite_sum,P)finite_sum. pastecart (fstcart(fstcart z)) (pastecart (sndcart(fstcart z)) (sndcart z))`] THEN REWRITE_TAC[FORALL_IN_PCROSS; SUBSET; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN TRY(GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC LINEAR_COMPOSE) THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let HOMEOMORPHIC_SCALING_LEFT = prove (`!c. &0 < c ==> !s t. (IMAGE (\x. c % x) s) homeomorphic t <=> s homeomorphic t`, REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; let HOMEOMORPHIC_SCALING_RIGHT = prove (`!c. &0 < c ==> !s t. s homeomorphic (IMAGE (\x. c % x) t) <=> s homeomorphic t`, REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; let HOMEOMORPHIC_SUBSPACES = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t /\ dim s = dim t ==> s homeomorphic t`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; let HOMEOMORPHIC_FINITE = prove (`!s:real^M->bool t:real^N->bool. FINITE s /\ FINITE t ==> (s homeomorphic t <=> CARD s = CARD t)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN ASM_SIMP_TAC[CARD_EQ_CARD]; STRIP_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`] CARD_EQ_BIJECTIONS) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_FINITE] THEN ASM SET_TAC[]]);; let HOMEOMORPHIC_FINITE_STRONG = prove (`!s:real^M->bool t:real^N->bool. FINITE s \/ FINITE t ==> (s homeomorphic t <=> FINITE s /\ FINITE t /\ CARD s = CARD t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN SIMP_TAC[HOMEOMORPHIC_FINITE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);; let HOMEOMORPHIC_HAS_SIZE = prove (`!s:real^M->bool t:real^N->bool n. s homeomorphic t ==> (s HAS_SIZE n <=> t HAS_SIZE n)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_FINITENESS) THEN ASM_CASES_TAC `FINITE(t:real^N->bool)` THEN ASM_SIMP_TAC[HAS_SIZE] THEN DISCH_TAC THEN ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);; let HOMEOMORPHISM_HAS_SIZE_EQ = prove (`!f:real^M->real^N g s t k n. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> ((IMAGE f k) HAS_SIZE n <=> k HAS_SIZE n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_HAS_SIZE THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHIC_SING = prove (`!a:real^M b:real^N. {a} homeomorphic {b}`, SIMP_TAC[HOMEOMORPHIC_FINITE; FINITE_SING; CARD_SING]);; let HOMEOMORPHIC_PCROSS_SING = prove (`(!s:real^M->bool a:real^N. s homeomorphic (s PCROSS {a})) /\ (!s:real^M->bool a:real^N. s homeomorphic ({a} PCROSS s))`, MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [MESON_TAC[HOMEOMORPHIC_PCROSS_SYM; HOMEOMORPHIC_TRANS]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN EXISTS_TAC `\x. (pastecart x a:real^(M,N)finite_sum)` THEN EXISTS_TAC `fstcart:real^(M,N)finite_sum->real^M` THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN SIMP_TAC[FSTCART_PASTECART]);; let LIFT_TO_QUOTIENT_SPACE_UNIQUE = prove (`!f:real^M->real^N g:real^M->real^P s t u. IMAGE f s = t /\ IMAGE g s = u /\ (!v. v SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean t) v)) /\ (!v. v SUBSET u ==> (open_in (subtopology euclidean s) {x | x IN s /\ g x IN v} <=> open_in (subtopology euclidean u) v)) /\ (!x y. x IN s /\ y IN s ==> (f x = f y <=> g x = g y)) ==> t homeomorphic u`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^P`; `s:real^M->bool`; `t:real^N->bool`; `u:real^P->bool`] LIFT_TO_QUOTIENT_SPACE) THEN MP_TAC(ISPECL [`g:real^M->real^P`; `f:real^M->real^N`; `s:real^M->bool`; `u:real^P->bool`; `t:real^N->bool`] LIFT_TO_QUOTIENT_SPACE) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] CONTINUOUS_ON_OPEN_GEN) THEN ASM_SIMP_TAC[SUBSET_REFL] THEN DISCH_THEN SUBST1_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; DISCH_THEN(X_CHOOSE_THEN `h:real^P->real^N` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPECL [`g:real^M->real^P`; `s:real^M->bool`; `u:real^P->bool`] CONTINUOUS_ON_OPEN_GEN) THEN ASM_SIMP_TAC[SUBSET_REFL] THEN DISCH_THEN SUBST1_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; DISCH_THEN(X_CHOOSE_THEN `k:real^N->real^P` STRIP_ASSUME_TAC)] THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC [`k:real^N->real^P`; `h:real^P->real^N`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let HOMOEOMORPHISM_PASTE = prove (`!f:real^M->real^N g f' g' s t s' t'. homeomorphism (s,t) (f,g) /\ homeomorphism (s',t') (f',g') /\ (open_in (subtopology euclidean (s UNION s')) s /\ open_in (subtopology euclidean (s UNION s')) s' /\ open_in (subtopology euclidean (t UNION t')) t /\ open_in (subtopology euclidean (t UNION t')) t' \/ closed_in (subtopology euclidean (s UNION s')) s /\ closed_in (subtopology euclidean (s UNION s')) s' /\ closed_in (subtopology euclidean (t UNION t')) t /\ closed_in (subtopology euclidean (t UNION t')) t') /\ (!x. x IN s INTER s' ==> f' x = f x) /\ (!y. y IN t INTER t' ==> g' y = g y) ==> ?h k. homeomorphism (s UNION s',t UNION t') (h,k) /\ (!x. x IN s ==> h x = f x) /\ (!x. x IN s' ==> h x = f' x) /\ (!y. y IN t ==> k y = g y) /\ (!y. y IN t' ==> k y = g' y) /\ IMAGE h s = t /\ IMAGE h s' = t' /\ IMAGE k t = s /\ IMAGE k t' = s' /\ IMAGE h (s INTER s') = t INTER t' /\ IMAGE h (s DIFF s') = t DIFF t' /\ IMAGE h (s' DIFF s) = t' DIFF t /\ IMAGE k (t INTER t') = s INTER s' /\ IMAGE k (t DIFF t') = s DIFF s' /\ IMAGE k (t' DIFF t) = s' DIFF s`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else f' x` THEN EXISTS_TAC `\x. if x IN t then (g:real^N->real^M) x else g' x` THEN REWRITE_TAC[IN_UNION] THEN MATCH_MP_TAC(TAUT `(p /\ q /\ s /\ t /\ v) /\ (r /\ u) ==> (p /\ q /\ r /\ s /\ t /\ u) /\ v`) THEN CONJ_TAC THENL [REPEAT CONJ_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THEN (FIRST_X_ASSUM DISJ_CASES_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN; MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]));; (* ------------------------------------------------------------------------- *) (* Domain of a continuous function is homeomorphic to its graph. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHISM_GRAPH_EXPLICIT = prove (`!f:real^M->real^N s. homeomorphism (s,{pastecart x (f x) | x IN s}) ((\x. pastecart x (f x)),fstcart) <=> f continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN EQ_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [SUBGOAL_THEN `(f:real^M->real^N) = sndcart o (\x. pastecart x (f x))` SUBST1_TAC THENL [SIMP_TAC[o_DEF; SNDCART_PASTECART; ETA_AX]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; REWRITE_TAC[FSTCART_PASTECART]; SET_TAC[]; ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID]; REWRITE_TAC[FORALL_IN_GSPEC; FSTCART_PASTECART]; REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IN_ELIM_THM; EXISTS_PASTECART; FORALL_PASTECART] THEN REWRITE_TAC[FSTCART_PASTECART; PASTECART_INJ] THEN MESON_TAC[]; SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART]]);; let HOMEOMORPHISM_GRAPH = prove (`!f:real^M->real^N s. (?g. homeomorphism (s,{pastecart x (f x) | x IN s}) ((\x. pastecart x (f x)),g)) <=> f continuous_on s`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM HOMEOMORPHISM_GRAPH_EXPLICIT] THEN MESON_TAC[]] THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `sndcart o (\x. pastecart x ((f:real^M->real^N) x))` THEN ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; o_THM; SNDCART_PASTECART]);; let HOMEOMORPHIC_GRAPH = prove (`!f:real^M->real^N s. f continuous_on s ==> {pastecart x (f x) | x IN s} homeomorphic s`, ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[GSYM HOMEOMORPHISM_GRAPH_EXPLICIT; homeomorphic] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Inverse function property for open/closed maps. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_INVERSE_OPEN_MAP = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) ==> g continuous_on t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] CONTINUOUS_ON_OPEN_GEN) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN ASM SET_TAC[]);; let CONTINUOUS_ON_INVERSE_CLOSED_MAP = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) ==> g continuous_on t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] CONTINUOUS_ON_CLOSED_GEN) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]);; let CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) ==> g continuous_on t`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[PROPER_MAP; SUBSET_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);; let HOMEOMORPHISM_INJECTIVE_OPEN_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN ASM_MESON_TAC[]);; let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);; let HOMEOMORPHISM_IMP_OPEN_MAP = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = {y | y IN t /\ g(y) IN u}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]);; let HOMEOMORPHISM_IMP_CLOSED_MAP = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = {y | y IN t /\ g(y) IN u}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_IMP_CLOSED_IN THEN ASM_REWRITE_TAC[]]);; let HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((?g. homeomorphism (s,t) (f,g)) <=> !u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN ASM_REWRITE_TAC[]]);; let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((?g. homeomorphism (s,t) (f,g)) <=> !u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN ASM_MESON_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN ASM_REWRITE_TAC[]]);; let INJECTIVE_MAP_OPEN_IFF_CLOSED = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `?g:real^N->real^M. homeomorphism (s,t) (f,g)` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Transformation theorems for open, interior etc. under homeomorphism. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHISM_OPEN_IN_EQ = prove (`!f:real^M->real^N g s t u v. homeomorphism (s,t) (f,g) /\ u SUBSET s /\ v SUBSET s ==> (open_in (subtopology euclidean (IMAGE f u)) (IMAGE f v) <=> open_in (subtopology euclidean u) v)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `v = IMAGE (g:real^N->real^M) (IMAGE f v)` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `IMAGE (f:real^M->real^N) u`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM]]; MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `u:real^M->bool`] THEN ASM_REWRITE_TAC[]] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_OPENNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (open_in (subtopology euclidean t) (IMAGE f k) <=> open_in (subtopology euclidean s) k)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "t" THEN MATCH_MP_TAC HOMEOMORPHISM_OPEN_IN_EQ THEN MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`] THEN ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[]);; let HOMEOMORPHISM_CLOSED_IN_EQ = prove (`!f:real^M->real^N g s t u v. homeomorphism (s,t) (f,g) /\ u SUBSET s /\ v SUBSET s ==> (closed_in (subtopology euclidean (IMAGE f u)) (IMAGE f v) <=> closed_in (subtopology euclidean u) v)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `v = IMAGE (g:real^N->real^M) (IMAGE f v)` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `IMAGE (f:real^M->real^N) u`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM]]; MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `u:real^M->bool`] THEN ASM_REWRITE_TAC[]] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_CLOSEDNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (closed_in (subtopology euclidean t) (IMAGE f k) <=> closed_in (subtopology euclidean s) k)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "t" THEN MATCH_MP_TAC HOMEOMORPHISM_CLOSED_IN_EQ THEN MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`] THEN ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[]);; let HOMEOMORPHISM_DERIVED_SET_OF = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ u SUBSET s ==> IMAGE f ((subtopology euclidean s) derived_set_of u) = (subtopology euclidean t) derived_set_of (IMAGE f u)`, REWRITE_TAC[derived_set_of; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `IMAGE f s = t /\ (!x. x IN s ==> (Q(f x) <=> P x)) ==> IMAGE f {x | x IN s /\ P x} = {y | y IN t /\ Q y}`) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM_MESON_TAC[homeomorphism]; DISCH_TAC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[MESON[OPEN_IN_IMP_SUBSET] `open_in (subtopology euclidean t) s <=> s SUBSET t /\ open_in (subtopology euclidean t) s`] THEN EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_SUBSET_IMAGE; IMP_CONJ] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OPENNESS)) THEN ASM_SIMP_TAC[EXISTS_IN_IMAGE] THEN DISCH_THEN(K ALL_TAC) THEN GEN_TAC THEN DISCH_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_CLOSURE_OF = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ u SUBSET s ==> IMAGE f ((subtopology euclidean s) closure_of u) = (subtopology euclidean t) closure_of (IMAGE f u)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_OF_ALT; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; IMAGE_UNION] THEN BINOP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_DERIVED_SET_OF THEN ASM_MESON_TAC[]]);; let HOMEOMORPHISM_INTERIOR_OF = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ u SUBSET s ==> IMAGE f ((subtopology euclidean s) interior_of u) = (subtopology euclidean t) interior_of (IMAGE f u)`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERIOR_OF_CLOSURE_OF; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN W(MP_TAC o PART_MATCH (lhand o rand) IMAGE_DIFF_INJ_ALT o lhand o snd) THEN REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY] THEN ANTS_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN BINOP_TAC THENL [ASM_MESON_TAC[homeomorphism]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN SIMP_TAC[SUBSET_DIFF] THEN DISCH_THEN(K ALL_TAC) THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_FRONTIER_OF = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ u SUBSET s ==> IMAGE f ((subtopology euclidean s) frontier_of u) = (subtopology euclidean t) frontier_of (IMAGE f u)`, REPEAT STRIP_TAC THEN REWRITE_TAC[FRONTIER_OF_CLOSURES] THEN SUBGOAL_THEN `!u v. u SUBSET s /\ v SUBSET s ==> IMAGE (f:real^M->real^N) (u INTER v) = IMAGE f u INTER IMAGE f v` (fun th -> W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY] THEN DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SUBGOAL_THEN `t DIFF IMAGE (f:real^M->real^N) u = IMAGE f (s DIFF u)` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; BINOP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_CLOSURE_OF THEN EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[SUBSET_DIFF]]);; let HOMEOMORPHISM_CLOSURE = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ u SUBSET s ==> t INTER closure (IMAGE f u) = IMAGE f (s INTER closure u)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_CLOSURE_OF) THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN ASM_SIMP_TAC[SET_RULE `u SUBSET s ==> s INTER u = u`] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_CONNECTED_COMPONENT = prove (`!f:real^M->real^N g s t x. homeomorphism (s,t) (f,g) /\ x IN s ==> connected_component (IMAGE f s) (f x) = IMAGE f (connected_component s x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]; MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `IMAGE (g:real^N->real^M) d SUBSET connected_component s x` MP_TAC THENL [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN ASM SET_TAC[]]]);; let HOMEOMORPHISM_COMPONENTS = prove (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) ==> components t = IMAGE (IMAGE f) (components s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[homeomorphism]) THEN EXPAND_TAC "t" THEN REWRITE_TAC[components] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN REWRITE_TAC[SET_RULE `IMAGE f {g x | x IN s} = {f(g x) | x IN s}`] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN ASM_MESON_TAC[HOMEOMORPHISM_CONNECTED_COMPONENT]);; let LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP = prove (`!f:real^M->real^N s t. (!x. x IN s ==> ?u v g. x IN u /\ open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean t) v /\ homeomorphism (u,v) (f,g)) ==> !u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `w:real^N->bool`; `g:real^N->real^M`] THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (u INTER v)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN TRANS_TAC OPEN_IN_TRANS `w:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_IMP_OPEN_MAP)) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_MESON_TAC[OPEN_IN_INTER; OPEN_IN_REFL; OPEN_IN_IMP_SUBSET]);; let DERIVED_SET_OF_TRANSLATION = prove (`!a:real^N u s. (subtopology euclidean (IMAGE (\x. a + x) u)) derived_set_of (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (subtopology euclidean u derived_set_of s)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[DERIVED_SET_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SIMP_TAC[GSYM IMAGE_INTER_INJ; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN MATCH_MP_TAC HOMEOMORPHISM_DERIVED_SET_OF THEN EXISTS_TAC `\x:real^N. --a + x` THEN REWRITE_TAC[INTER_SUBSET] THEN REWRITE_TAC[HOMEOMORPHISM] THEN SIMP_TAC[FORALL_IN_IMAGE; SUBSET] THEN REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^N = x`] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN SET_TAC[]);; add_translation_invariants [DERIVED_SET_OF_TRANSLATION];; let CLOSURE_OF_TRANSLATION = prove (`!a:real^N u s. (subtopology euclidean (IMAGE (\x. a + x) u)) closure_of (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (subtopology euclidean u closure_of s)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[CLOSURE_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SIMP_TAC[GSYM IMAGE_INTER_INJ; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN MATCH_MP_TAC HOMEOMORPHISM_CLOSURE_OF THEN EXISTS_TAC `\x:real^N. --a + x` THEN REWRITE_TAC[INTER_SUBSET] THEN REWRITE_TAC[HOMEOMORPHISM] THEN SIMP_TAC[FORALL_IN_IMAGE; SUBSET] THEN REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^N = x`] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN SET_TAC[]);; add_translation_invariants [CLOSURE_OF_TRANSLATION];; let INTERIOR_OF_TRANSLATION = prove (`!a:real^N u s. (subtopology euclidean (IMAGE (\x. a + x) u)) interior_of (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (subtopology euclidean u interior_of s)`, REWRITE_TAC[INTERIOR_OF_CLOSURE_OF; CLOSURE_OF_TRANSLATION; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; GSYM TRANSLATION_DIFF]);; add_translation_invariants [INTERIOR_OF_TRANSLATION];; let FRONTIER_OF_TRANSLATION = prove (`!a:real^N u s. (subtopology euclidean (IMAGE (\x. a + x) u)) frontier_of (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (subtopology euclidean u frontier_of s)`, REWRITE_TAC[frontier_of; CLOSURE_OF_TRANSLATION; INTERIOR_OF_TRANSLATION; GSYM TRANSLATION_DIFF]);; add_translation_invariants [FRONTIER_OF_TRANSLATION];; let DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N u s. linear f /\ (!x y. f x = f y ==> x = y) ==> (subtopology euclidean (IMAGE f u)) derived_set_of (IMAGE f s) = IMAGE f (subtopology euclidean u derived_set_of s)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[DERIVED_SET_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN MATCH_MP_TAC HOMEOMORPHISM_DERIVED_SET_OF THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; add_linear_invariants [DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE];; let CLOSURE_OF_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N u s. linear f /\ (!x y. f x = f y ==> x = y) ==> (subtopology euclidean (IMAGE f u)) closure_of (IMAGE f s) = IMAGE f (subtopology euclidean u closure_of s)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[CLOSURE_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN MATCH_MP_TAC HOMEOMORPHISM_CLOSURE_OF THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; add_linear_invariants [CLOSURE_OF_INJECTIVE_LINEAR_IMAGE];; let FRONTIER_OF_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N u s. linear f /\ (!x y. f x = f y ==> x = y) ==> (subtopology euclidean (IMAGE f u)) frontier_of (IMAGE f s) = IMAGE f (subtopology euclidean u frontier_of s)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[FRONTIER_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN MATCH_MP_TAC HOMEOMORPHISM_FRONTIER_OF THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; add_linear_invariants [FRONTIER_OF_INJECTIVE_LINEAR_IMAGE];; let INTERIOR_OF_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N u s. linear f /\ (!x y. f x = f y ==> x = y) ==> (subtopology euclidean (IMAGE f u)) interior_of (IMAGE f s) = IMAGE f (subtopology euclidean u interior_of s)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[INTERIOR_OF_RESTRICT] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN MATCH_MP_TAC HOMEOMORPHISM_INTERIOR_OF THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; add_linear_invariants [INTERIOR_OF_INJECTIVE_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Relatively weak hypotheses if the domain of the function is compact. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_IMP_CLOSED_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ compact s ==> !u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)`, SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN EXPAND_TAC "t" THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]);; let CONTINUOUS_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ compact s ==> !u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_IMP_CLOSED_MAP THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_ON_INVERSE = prove (`!f:real^M->real^N g s. f continuous_on s /\ compact s /\ (!x. x IN s ==> (g(f(x)) = x)) ==> g continuous_on (IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN SUBGOAL_THEN `IMAGE g (IMAGE (f:real^M->real^N) s) = s` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]; REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET]]);; let HOMEOMORPHISM_COMPACT = prove (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> ?g. homeomorphism(s,t) (f,g)`, REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[EXTENSION; homeomorphism] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[CONTINUOUS_ON_INVERSE; IN_IMAGE]);; let HOMEOMORPHIC_COMPACT = prove (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> s homeomorphic t`, REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPACT]);; (* ------------------------------------------------------------------------- *) (* Lemmas about composition of homeomorphisms. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (?h. homeomorphism (s,u) (g o f,h)) ==> (?f'. homeomorphism (s,t) (f,f')) /\ (?g'. homeomorphism (t,u) (g,g'))`, REPEAT GEN_TAC THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_SURJECTIVE THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[homeomorphism; o_THM]; REWRITE_TAC[homeomorphism; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g':real^P->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(h:real^P->real^M) o (g:real^N->real^P)` THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; let HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ (?h. homeomorphism (s,u) (g o f,h)) ==> (?f'. homeomorphism (s,t) (f,f')) /\ (?g'. homeomorphism (t,u) (g,g'))`, REPEAT GEN_TAC THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_INJECTIVE THEN MAP_EVERY EXISTS_TAC [`g:real^N->real^P`; `u:real^P->bool`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[homeomorphism; o_THM]; REWRITE_TAC[homeomorphism; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) o (h:real^P->real^M)` THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Preservation of topological properties. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_COMPACTNESS = prove (`!s t. s homeomorphic t ==> (compact s <=> compact t)`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);; let HOMEOMORPHIC_CONNECTEDNESS = prove (`!s t. s homeomorphic t ==> (connected s <=> connected t)`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);; let HOMEOMORPHISM_COMPACTNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (compact(IMAGE f k) <=> compact k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACTNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_CONNECTEDNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (connected(IMAGE f k) <=> connected k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Results on translation, scaling etc. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_SCALING = prove (`!s:real^N->bool c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MAP_EVERY EXISTS_TAC [`\x:real^N. c % x`; `\x:real^N. inv(c) % x`] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN SIMP_TAC[VECTOR_MUL_LID; IN_IMAGE; REAL_MUL_LID] THEN MESON_TAC[]);; let HOMEOMORPHIC_TRANSLATION = prove (`!s a:real^N. s homeomorphic (IMAGE (\x. a + x) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MAP_EVERY EXISTS_TAC [`\x:real^N. a + x`; `\x:real^N. --a + x`] THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN SIMP_TAC[VECTOR_ADD_ASSOC; VECTOR_ADD_LINV; VECTOR_ADD_RINV; FORALL_IN_IMAGE; VECTOR_ADD_LID] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; let HOMEOMORPHIC_AFFINITY = prove (`!s a:real^N c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x + a) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[AFFINITY_SCALING_TRANSLATION] THEN TRANS_TAC HOMEOMORPHIC_TRANS `IMAGE (\x:real^N. c % x) s` THEN ASM_SIMP_TAC[HOMEOMORPHIC_TRANSLATION; IMAGE_o; HOMEOMORPHIC_SCALING]);; let [HOMEOMORPHIC_BALLS; HOMEOMORPHIC_CBALLS; HOMEOMORPHIC_SPHERES] = (CONJUNCTS o prove) (`(!a:real^N b:real^N d e. &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e)) /\ (!a:real^N b:real^N d e. &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e)) /\ (!a:real^N b:real^N d e. &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `\x:real^N. b + (e / d) % (x - a)` THEN EXISTS_TAC `\x:real^N. a + (d / e) % (x - b)` THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; IN_BALL; IN_CBALL; IN_SPHERE] THEN REWRITE_TAC[dist; VECTOR_ARITH `a - (a + b) = --b:real^N`; NORM_NEG] THEN REWRITE_TAC[real_div; VECTOR_ARITH `a + d % ((b + e % (x - a)) - b) = (&1 - d * e) % a + (d * e) % x`] THEN ONCE_REWRITE_TAC[REAL_ARITH `(e * d') * (d * e') = (d * d') * (e * e')`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID; REAL_SUB_REFL] THEN REWRITE_TAC[NORM_MUL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ARITH `&0 < x ==> (abs x = x)`] THEN GEN_REWRITE_TAC(BINOP_CONV o BINDER_CONV o funpow 2 RAND_CONV) [GSYM REAL_MUL_RID] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID; GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; NORM_SUB] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Homeomorphism of one-point compactifications. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS = prove (`!f:real^M->real^N g:real^N->real^M s t a b. compact s /\ compact t /\ a IN s /\ b IN t /\ homeomorphism (s DELETE a,t DELETE b) (f,g) ==> ?f' g'. homeomorphism (s,t) (f',g') /\ f' a = b /\ g' b = a /\ (!x. x IN s DELETE a ==> f' x = f x) /\ (!y. y IN t DELETE b ==> g' y = g y)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t <=> p /\ (q /\ s) /\ r /\ t`] THEN MATCH_MP_TAC(MESON[] `(!f g. P f /\ R f g ==> Q f g) /\ (?f. P f /\ ?g. R f g) ==> ?f g. R f g /\ P f /\ Q f g`) THEN CONJ_TAC THENL [REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(f':real^M->real^N) (g(y:real^N)) = y` MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `\x. if x = a then b else (f:real^M->real^N) x` THEN SIMP_TAC[IN_DELETE] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^M = a` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`b:real^N`; `e:real`] CENTRE_IN_BALL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `closed_in (subtopology euclidean s) { x | x IN (s DELETE a) /\ (f:real^M->real^N)(x) IN t DIFF ball(b,e)}` MP_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBGOAL_THEN `{x | x IN s DELETE a /\ f x IN t DIFF ball(b,e)} = IMAGE (g:real^N->real^M) (t DIFF ball (b,e))` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_DIFF; OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[closed_in; open_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(MP_TAC o SPEC `a:real^M` o last o CONJUNCTS) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF; IN_DELETE] THEN SIMP_TAC[IMP_CONJ; DE_MORGAN_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM SET_TAC[]]; UNDISCH_TAC `(f:real^M->real^N) continuous_on (s DELETE a)` THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN REWRITE_TAC[continuous_within] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (dist(a:real^M,x))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ] THEN ASM_MESON_TAC[REAL_LT_REFL]]);; let HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS = prove (`!s:real^M->bool t:real^N->bool a b. compact s /\ compact t /\ a IN s /\ b IN t /\ (s DELETE a) homeomorphic (t DELETE b) ==> s homeomorphic t`, REWRITE_TAC[homeomorphic] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS))) THEN ASM_MESON_TAC[]);; let BOUNDED_IMAGE_IN_COMPACTIFICATION = prove (`!f:real^M->real^N g u s t c. homeomorphism (u,s DIFF t) (f,g) /\ compact s /\ closed u /\ c SUBSET u ==> (bounded c <=> closure(IMAGE f c) INTER t = {})`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPACT_CLOSURE] THEN SUBGOAL_THEN `closure(c:real^M->bool) SUBSET u` ASSUME_TAC THENL [ASM_SIMP_TAC[CLOSURE_MINIMAL]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `closure c:real^M->bool` o MATCH_MP(REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_COMPACTNESS)) THEN ASM_SIMP_TAC[CLOSURE_MINIMAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN REWRITE_TAC[GSYM CLOSURE_EQ] THEN MATCH_MP_TAC(SET_RULE `closure(IMAGE f c) SUBSET closure(IMAGE f (closure c)) /\ IMAGE f (closure c) SUBSET s DIFF t ==> closure (IMAGE f (closure c)) = IMAGE f (closure c) ==> closure (IMAGE f c) INTER t = {}`) THEN SIMP_TAC[IMAGE_SUBSET; CLOSURE_SUBSET; SUBSET_CLOSURE] THEN RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]; FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool` o MATCH_MP(REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE)) THEN ASM_SIMP_TAC[CLOSURE_MINIMAL; SET_RULE `c SUBSET u ==> u INTER c = c`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[COMPACT_INTER_CLOSED; CLOSED_CLOSURE; SET_RULE `k INTER t = {} ==> (s DIFF t) INTER k = s INTER k`]]);; (* ------------------------------------------------------------------------- *) (* Homeomorphisms between open intervals in real^1 and then in real^N. *) (* Could prove similar things for closed intervals, but they drop out of *) (* later stuff in "convex.ml" even more easily. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_OPEN_INTERVALS_1 = prove (`!a b c d. drop a < drop b /\ drop c < drop d ==> interval(a,b) homeomorphic interval(c,d)`, SUBGOAL_THEN `!a b. drop a < drop b ==> interval(vec 0:real^1,vec 1) homeomorphic interval(a,b)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `(\x. a + drop x % (b - a)):real^1->real^1` THEN EXISTS_TAC `(\x. inv(drop b - drop a) % (x - a)):real^1->real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; DROP_SUB] THEN REWRITE_TAC[REAL_ARITH `inv b * a:real = a / b`] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT; REAL_LT_ADDR; REAL_EQ_LDIV_EQ; REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_MUL; REAL_MUL_LZERO; REAL_ADD_SUB; REAL_LT_RMUL_EQ; REAL_ARITH `a + x < b <=> x < &1 * (b - a)`] THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]; MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]]; REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `d:real^1`]) THEN ASM_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_TRANS]]);; let HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1 = prove (`!a b. drop a < drop b ==> interval(a,b) homeomorphic (:real^1)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:real^1`; `b:real^1`; `--vec 1:real^1`; `vec 1:real^1`] HOMEOMORPHIC_OPEN_INTERVALS_1) THEN ASM_REWRITE_TAC[DROP_VEC; DROP_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_UNIV] THEN EXISTS_TAC `\x:real^1. inv(&1 - norm x) % x` THEN EXISTS_TAC `\y. if &0 <= drop y then inv(&1 + drop y) % y else inv(&1 - drop y) % y` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN REWRITE_TAC[DROP_NEG; DROP_VEC; DROP_CMUL; NORM_REAL; GSYM drop] THEN SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LE_MUL_EQ; REAL_ARITH `--a < x /\ x < a ==> &0 < a - abs x`] THEN SIMP_TAC[real_abs; VECTOR_MUL_ASSOC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; X_GEN_TAC `y:real^1` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; REAL_BOUNDS_LT] THEN REWRITE_TAC[DROP_CMUL; REAL_ABS_MUL; REAL_ABS_INV] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < abs(&1 + x)`; REAL_ARITH `~(&0 <= x) ==> &0 < abs(&1 - x)`] THEN (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[NORM_REAL; VECTOR_MUL_ASSOC] THEN REWRITE_TAC[GSYM drop; DROP_CMUL; REAL_ABS_MUL] THEN ASM_REWRITE_TAC[real_abs; REAL_LE_INV_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 <= &1 + x`; REAL_ARITH `~(&0 <= x) ==> &0 <= &1 - x`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC] THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_SUB; LIFT_DROP] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_SUB THEN SIMP_TAC[CONTINUOUS_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]; REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC]; SUBGOAL_THEN `(:real^1) = {x | x$1 >= &0} UNION {x | x$1 <= &0}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_CASES THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE; IN_ELIM_THM] THEN REWRITE_TAC[GSYM drop; REAL_NOT_LE; real_ge; REAL_LET_ANTISYM] THEN SIMP_TAC[REAL_LE_ANTISYM; REAL_SUB_RZERO; REAL_ADD_RID] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_ADD; LIFT_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_SUB; CONTINUOUS_CONST] THEN ASM_REAL_ARITH_TAC]]);; let HOMEOMORPHIC_OPEN_INTERVALS = prove (`!a b:real^N c d:real^N. (interval(a,b) = {} <=> interval(c,d) = {}) ==> interval(a,b) homeomorphic interval(c,d)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(c:real^N,d) = {}` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic interval(lift((c:real^N)$i),lift((d:real^N)$i))` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVALS_1; LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN EXISTS_TAC `(\x. lambda i. drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; EXISTS_TAC `interval(lift((c:real^N)$i),lift((d:real^N)$i))`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; let HOMEOMORPHIC_OPEN_INTERVAL_UNIV = prove (`!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) homeomorphic (:real^N)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic (:real^1)` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN EXISTS_TAC `(\x. lambda i. drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP; IN_UNIV] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; EXISTS_TAC `(:real^1)`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; IN_UNIV] THEN ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; let HOMEOMORPHIC_BALL_UNIV = prove (`!a:real^N r. &0 < r ==> ball(a,r) homeomorphic (:real^N)`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?y:real^N. r = norm(y)` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_LT_IMP_LE]; POP_ASSUM MP_TAC] THEN REWRITE_TAC[NORM_POS_LT] THEN GEOM_NORMALIZE_TAC `y:real^N` THEN SIMP_TAC[] THEN GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `\z:real^N. inv(&1 - norm(z)) % z` THEN EXISTS_TAC `\z:real^N. inv(&1 + norm(z)) % z` THEN REWRITE_TAC[IN_BALL; IN_UNIV; DIST_0; VECTOR_MUL_ASSOC; VECTOR_MUL_EQ_0; VECTOR_ARITH `a % x:real^N = x <=> (a - &1) % x = vec 0`] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> abs(&1 - x) = &1 - x`] THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; X_GEN_TAC `y:real^N` THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= y ==> inv(abs(&1 + y)) * z = z / (&1 + y)`] THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= y ==> &0 < &1 + y`] THEN CONJ_TAC THENL [REAL_ARITH_TAC; DISJ1_TAC] THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN MP_TAC(ISPEC `y:real^N` NORM_POS_LE) THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_INV THEN SIMP_TAC[IN_BALL_0; REAL_SUB_0; REAL_ARITH `x < &1 ==> ~(&1 = x)`] THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_ID]; MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_INV THEN SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`] THEN REWRITE_TAC[o_DEF; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_ID]]);; (* ------------------------------------------------------------------------- *) (* Cardinalities of various useful sets. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_EUCLIDEAN = prove (`(:real^N) =_c (:real)`, MATCH_MP_TAC CARD_EQ_CART THEN REWRITE_TAC[real_INFINITE]);; let UNCOUNTABLE_EUCLIDEAN = prove (`~COUNTABLE(:real^N)`, MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]);; let CARD_EQ_INTERVAL = prove (`(!a b:real^N. ~(interval(a,b) = {}) ==> interval[a,b] =_c (:real)) /\ (!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) =_c (:real))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; TRANS_TAC CARD_LE_TRANS `interval(a:real^N,b)` THEN SIMP_TAC[CARD_LE_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]; TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);; let UNCOUNTABLE_INTERVAL = prove (`(!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval[a,b])) /\ (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval(a,b)))`, SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_INTERVAL]);; let COUNTABLE_OPEN_INTERVAL = prove (`!a b. COUNTABLE(interval(a,b)) <=> interval(a,b) = {}`, MESON_TAC[COUNTABLE_EMPTY; UNCOUNTABLE_INTERVAL]);; let CARD_EQ_OPEN = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> s =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `interval[a:real^N,b]` THEN ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_INTERVAL]]);; let UNCOUNTABLE_OPEN = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(COUNTABLE s)`, SIMP_TAC[CARD_EQ_OPEN; CARD_EQ_REAL_IMP_UNCOUNTABLE]);; let CARD_EQ_BALL = prove (`!a:real^N r. &0 < r ==> ball(a,r) =_c (:real)`, SIMP_TAC[CARD_EQ_OPEN; OPEN_BALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT]);; let CARD_EQ_CBALL = prove (`!a:real^N r. &0 < r ==> cball(a,r) =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; TRANS_TAC CARD_LE_TRANS `ball(a:real^N,r)` THEN SIMP_TAC[CARD_LE_SUBSET; BALL_SUBSET_CBALL] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_BALL]]);; let FINITE_IMP_NOT_OPEN = prove (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> ~(open s)`, MESON_TAC[UNCOUNTABLE_OPEN; FINITE_IMP_COUNTABLE]);; let OPEN_IMP_INFINITE = prove (`!s. open s ==> s = {} \/ INFINITE s`, MESON_TAC[FINITE_IMP_NOT_OPEN; INFINITE]);; let EMPTY_INTERIOR_FINITE = prove (`!s:real^N->bool. FINITE s ==> interior s = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_INTERIOR) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] FINITE_IMP_NOT_OPEN) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[INTERIOR_SUBSET]);; let FINITE_CBALL = prove (`!a:real^N r. FINITE(cball(a,r)) <=> r <= &0`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[CBALL_EMPTY; REAL_LT_IMP_LE; FINITE_EMPTY] THEN ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[CBALL_TRIVIAL; FINITE_SING; REAL_LE_REFL] THEN EQ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP EMPTY_INTERIOR_FINITE) THEN REWRITE_TAC[INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);; let FINITE_BALL = prove (`!a:real^N r. FINITE(ball(a,r)) <=> r <= &0`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `r <= &0` THEN ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; FINITE_EMPTY] THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] FINITE_IMP_NOT_OPEN)) THEN REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);; let CARD_EQ_CONNECTED = prove (`!s a b:real^N. connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, GEOM_ORIGIN_TAC `b:real^N` THEN GEOM_NORMALIZE_TAC `a:real^N` THEN REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE]; TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN SIMP_TAC[UNIT_INTERVAL_NONEMPTY; CARD_EQ_INTERVAL]; REWRITE_TAC[LE_C] THEN EXISTS_TAC `\x:real^N. lift(a dot x)` THEN SIMP_TAC[FORALL_LIFT; LIFT_EQ; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `a:real^N`] THEN ASM_REWRITE_TAC[DOT_RZERO]]]);; let UNCOUNTABLE_CONNECTED = prove (`!s a b:real^N. connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM_MESON_TAC[]);; let CARD_LT_IMP_DISCONNECTED = prove (`!s x:real^N. s <_c (:real) /\ x IN s ==> connected_component s x = {x}`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !a b. a IN s /\ b IN s /\ ~(a = b) ==> F`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN MP_TAC(ISPECL [`connected_component s (x:real^N)`; `a:real^N`; `b:real^N`] CARD_EQ_CONNECTED) THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN DISCH_TAC THEN UNDISCH_TAC `(s:real^N->bool) <_c (:real)` THEN REWRITE_TAC[CARD_NOT_LT] THEN TRANS_TAC CARD_LE_TRANS `connected_component s (x:real^N)` THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; let COUNTABLE_IMP_DISCONNECTED = prove (`!s x:real^N. COUNTABLE s /\ x IN s ==> connected_component s x = {x}`, SIMP_TAC[CARD_LT_IMP_DISCONNECTED; COUNTABLE_IMP_CARD_LT_REAL]);; let CONNECTED_CARD_EQ_IFF_NONTRIVIAL = prove (`!s:real^N->bool. connected s ==> (s =_c (:real) <=> ~(?a. s SUBSET {a}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_SING] THEN ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_IMP_COUNTABLE]);; let CONNECTED_CARD_LT_IFF_TRIVIAL = prove (`!s:real^N->bool. connected s ==> (s <_c (:real) <=> ?a. s SUBSET {a})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_CARD_EQ_IFF_NONTRIVIAL) THEN MATCH_MP_TAC(TAUT `(~p <=> q) ==> (p <=> ~r) ==> (q <=> r)`) THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_NOT_LE; DE_MORGAN_THM] THEN MATCH_MP_TAC(TAUT `~p ==> (p \/ q <=> q)`) THEN REWRITE_TAC[CARD_NOT_LT] THEN TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]);; let SMALL_IMP_TOTALLY_DISCONNECTED = prove (`!s:real^N->bool. s <_c (:real) ==> components s = IMAGE (\x. {x}) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[components; SIMPLE_IMAGE] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `s x /\ (?a. s SUBSET {a}) ==> s = {x}`) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN SIMP_TAC[GSYM CONNECTED_CARD_LT_IFF_TRIVIAL; CONNECTED_CONNECTED_COMPONENT] THEN TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; let FINITE_IMP_TOTALLY_DISCONNECTED = prove (`!s:real^N->bool. FINITE s ==> components s = IMAGE (\x. {x}) s`, SIMP_TAC[SMALL_IMP_TOTALLY_DISCONNECTED; FINITE_IMP_COUNTABLE; COUNTABLE_IMP_CARD_LT_REAL]);; (* ------------------------------------------------------------------------- *) (* "Iff" forms of constancy of function from connected set into a set that *) (* is smaller than R, or countable, or finite, or disconnected, or discrete. *) (* ------------------------------------------------------------------------- *) let [CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; CONTINUOUS_FINITE_RANGE_CONSTANT_EQ] = (CONJUNCTS o prove) (`(!s. connected s <=> !f:real^M->real^N t. f continuous_on s /\ IMAGE f s SUBSET t /\ (!y. y IN t ==> connected_component t y = {y}) ==> ?a. !x. x IN s ==> f x = a) /\ (!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ (!x. x IN s ==> ?e. &0 < e /\ !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) ==> ?a. !x. x IN s ==> f x = a) /\ (!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ FINITE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a)`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC(TAUT `(s ==> t) /\ (t ==> u) /\ (u ==> v) /\ (v ==> s) ==> (s <=> t) /\ (s <=> u) /\ (s <=> v)`) THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^M` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN EXISTS_TAC `(f:real^M->real^N) x` THEN MATCH_MP_TAC(SET_RULE `IMAGE f s SUBSET {a} ==> !y. y IN s ==> f y = a`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN ASM SET_TAC[]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_REFL] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `(!y. y IN s /\ f y IN connected_component (IMAGE f s) a ==> f y = a) /\ connected_component (IMAGE f s) a SUBSET (IMAGE f s) /\ connected_component (IMAGE f s) a a ==> connected_component (IMAGE f s) a = {a}`) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN MP_TAC(ISPEC `connected_component (IMAGE (f:real^M->real^N) s) (f x)` CONNECTED_CLOSED) THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`cball((f:real^M->real^N) x,e / &2)`; `(:real^N) DIFF ball((f:real^M->real^N) x,e)`] THEN REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; CLOSED_CBALL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_CBALL; IN_UNION; IN_DIFF; IN_BALL; IN_UNIV] THEN MATCH_MP_TAC(MESON[SUBSET; CONNECTED_COMPONENT_SUBSET] `(!x. x IN s ==> P x) ==> (!x. x IN connected_component s y ==> P x)`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t INTER u = {}`) THEN REWRITE_TAC[IN_BALL; IN_CBALL; IN_DIFF; IN_UNIV] THEN UNDISCH_TAC `&0 < e` THEN CONV_TAC NORM_ARITH; EXISTS_TAC `(f:real^M->real^N) x` THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_HALF; REAL_LT_IMP_LE; IN_INTER] THEN REWRITE_TAC[IN] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL_EQ; FUN_IN_IMAGE]; EXISTS_TAC `(f:real^M->real^N) y` THEN ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist]]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MATCH_MP_TAC th) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `IMAGE (f:real^M->real^N) s DELETE (f x) = {}` THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `inf{norm(z - f x) |z| z IN IMAGE (f:real^M->real^N) s DELETE (f x)}` THEN REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; FINITE_DELETE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_DELETE; NORM_POS_LT; VECTOR_SUB_EQ; IN_IMAGE] THEN MESON_TAC[REAL_LE_REFL]; REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `(\x. if x IN t then vec 0 else basis 1):real^M->real^N`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^N,basis 1}` THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[]; SUBGOAL_THEN `?a b:real^M. a IN s /\ a IN t /\ b IN s /\ ~(b IN t)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; DISCH_THEN(CHOOSE_THEN MP_TAC)] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `a:real^M` th) THEN MP_TAC(SPEC `b:real^M` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC(RAND_CONV SYM_CONV) THEN SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; REAL_LE_REFL]]]);; let CONTINUOUS_DISCONNECTED_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ IMAGE f s SUBSET t /\ (!y. y IN t ==> connected_component t y = {y}) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]);; let CONTINUOUS_DISCRETE_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ (!x. x IN s ==> ?e. &0 < e /\ !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) ==> ?a. !x. x IN s ==> f x = a`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[IMP_IMP; GSYM CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ]);; let CONTINUOUS_FINITE_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ FINITE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]);; let CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ = prove (`!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ COUNTABLE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; REWRITE_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_SIMP_TAC[COUNTABLE_IMP_DISCONNECTED; SUBSET_REFL]);; let CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ = prove (`!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ (IMAGE f s) <_c (:real) ==> ?a. !x. x IN s ==> f x = a`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; REWRITE_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_SIMP_TAC[CARD_LT_IMP_DISCONNECTED; SUBSET_REFL]);; let CONTINUOUS_COUNTABLE_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ COUNTABLE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]);; let CONTINUOUS_CARD_LT_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ (IMAGE f s) <_c (:real) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ]);; (* ------------------------------------------------------------------------- *) (* Homeomorphism of hyperplanes. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_HYPERPLANES = prove (`!a:real^N b c:real^N d. ~(a = vec 0) /\ ~(c = vec 0) ==> {x | a dot x = b} homeomorphic {x | c dot x = d}`, let lemma = prove (`~(a = vec 0) ==> {x:real^N | a dot x = b} homeomorphic {x:real^N | x$1 = &0}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^N. a dot c = b` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `b / (a:real^N)$k % basis k:real^N` THEN ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; REAL_DIV_RMUL]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ABBREV_TAC `p = {x:real^N | x$1 = &0}` THEN GEOM_ORIGIN_TAC `c:real^N` THEN REWRITE_TAC[VECTOR_ADD_RID; DOT_RADD; DOT_RZERO; REAL_EQ_ADD_LCANCEL_0; REAL_ADD_RID] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a:real^N = vec 0)` THEN GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; REAL_ENTIRE] THEN SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1] THEN EXPAND_TAC "p" THEN REWRITE_TAC[HOMEOMORPHIC_REFL]]) in REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0}` THEN ASM_SIMP_TAC[lemma] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN ASM_SIMP_TAC[lemma]);; let HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE = prove (`!a:real^N b k c. ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) ==> {x | a dot x = b} homeomorphic {x:real^N | x$k = c}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x:real^N | x$k = c} = {x | basis k dot x = c}` SUBST1_TAC THENL [ASM_SIMP_TAC[DOT_BASIS]; MATCH_MP_TAC HOMEOMORPHIC_HYPERPLANES] THEN ASM_SIMP_TAC[BASIS_NONZERO]);; let HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE = prove (`!a:real^N b k c. ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) ==> {x:real^N | x$k = c} homeomorphic {x | a dot x = b}`, ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE]);; let HOMEOMORPHIC_HYPERPLANE_UNIV = prove (`!a b. ~(a = vec 0) /\ dimindex(:N) = dimindex(:M) + 1 ==> {x:real^N | a dot x = b} homeomorphic (:real^M)`, REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis(dimindex(:N)) dot x = &0}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANES; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN EXISTS_TAC `(\x. lambda i. if i <= dimindex(:M) then x$i else &0) :real^M->real^N` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; REWRITE_TAC[SUBSET_UNIV]; MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN ASM_SIMP_TAC[DOT_BASIS; LAMBDA_BETA; LE_REFL; ARITH_RULE `1 <= n + 1`; ARITH_RULE `~(m + 1 <= m)`]; ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; LE_REFL; CART_EQ; ARITH_RULE `1 <= n + 1`] THEN GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i = dimindex(:M) + 1` THEN ASM_REWRITE_TAC[COND_ID] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; IN_UNIV; LE_REFL; ARITH_RULE `i <= n ==> i <= n + 1`]]);; (* ------------------------------------------------------------------------- *) (* "Isometry" (up to constant bounds) of injective linear map etc. *) (* ------------------------------------------------------------------------- *) let CAUCHY_ISOMETRIC = prove (`!f s e x. &0 < e /\ subspace s /\ linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ (!n. x(n) IN s) /\ cauchy(f o x) ==> cauchy x`, REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[CAUCHY; dist; o_THM] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN DISCH_THEN(fun th -> X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `d * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_MUL_SYM; REAL_LET_TRANS; SUBSPACE_SUB; REAL_LT_LDIV_EQ]);; let COMPLETE_ISOMETRIC_IMAGE = prove (`!f:real^M->real^N s e. &0 < e /\ subspace s /\ linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ complete s ==> complete(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[complete; EXISTS_IN_IMAGE] THEN STRIP_TAC THEN X_GEN_TAC `g:num->real^N` THEN REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM FUN_EQ_THM] THEN REWRITE_TAC[GSYM o_DEF] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ASM_MESON_TAC[CAUCHY_ISOMETRIC; LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_SEQUENTIALLY]);; let INJECTIVE_IMP_ISOMETRIC = prove (`!f:real^M->real^N s. closed s /\ subspace s /\ linear f /\ (!x. x IN s /\ (f x = vec 0) ==> (x = vec 0)) ==> ?e. &0 < e /\ !x. x IN s ==> norm(f x) >= e * norm(x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s SUBSET {vec 0 :real^M}` THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_LID; real_ge] THEN ASM_MESON_TAC[SUBSET; IN_SING; NORM_0; LINEAR_0; REAL_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_SING] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`{(f:real^M->real^N) x | x IN s /\ norm(x) = norm(a:real^M)}`; `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBST1_TAC(SET_RULE `{f x | x IN s /\ norm(x) = norm(a:real^M)} = IMAGE (f:real^M->real^N) (s INTER {x | norm x = norm a})`) THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{x:real^M | norm x = norm(a:real^M)} = frontier(cball(vec 0,norm a))` SUBST1_TAC THENL [ASM_SIMP_TAC[FRONTIER_CBALL; NORM_POS_LT; dist; VECTOR_SUB_LZERO; NORM_NEG; sphere]; ASM_SIMP_TAC[COMPACT_FRONTIER; COMPACT_CBALL]]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M` MP_TAC) THEN REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_LZERO; NORM_NEG] THEN STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN EXISTS_TAC `norm((f:real^M->real^N) b) / norm(b)` THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_DIV; NORM_POS_LT; NORM_EQ_0]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^M = vec 0` THENL [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN REWRITE_TAC[NORM_0; REAL_MUL_RZERO; real_ge; REAL_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(norm(a:real^M) / norm(x)) % x:real^M`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_MESON_TAC[subspace]; ALL_TAC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; real_ge] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT] THEN REWRITE_TAC[real_div; REAL_MUL_AC]);; let CLOSED_INJECTIVE_IMAGE_SUBSPACE = prove (`!f s. subspace s /\ linear f /\ (!x. x IN s /\ f(x) = vec 0 ==> x = vec 0) /\ closed s ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED] THEN MATCH_MP_TAC COMPLETE_ISOMETRIC_IMAGE THEN ASM_REWRITE_TAC[COMPLETE_EQ_CLOSED] THEN MATCH_MP_TAC INJECTIVE_IMP_ISOMETRIC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Relating linear images to open/closed/interior/closure. *) (* ------------------------------------------------------------------------- *) let OPEN_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!y. ?x. f x = y) ==> !s. open s ==> open(IMAGE f s)`, GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o GEN `k:num` o SPEC `basis k:real^N`) THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `b:num->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `bounded(IMAGE (b:num->real^M) (1..dimindex(:N)))` MP_TAC THENL [SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / B / &(dimindex(:N))` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN ABBREV_TAC `u = y - (f:real^M->real^N) x` THEN EXISTS_TAC `x + vsum(1..dimindex(:N)) (\i. (u:real^N)$i % b i):real^M` THEN ASM_SIMP_TAC[LINEAR_ADD; LINEAR_VSUM; FINITE_NUMSEG; o_DEF; LINEAR_CMUL; BASIS_EXPANSION] THEN CONJ_TAC THENL [EXPAND_TAC "u" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_ARITH `dist(x + y,x) = norm y`] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(dist(y,(f:real^M->real^N) x) * &(dimindex(:N))) * B` THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN GEN_REWRITE_TAC(RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; dist] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN ASM_SIMP_TAC[COMPONENT_LE_NORM]);; let OPEN_BIJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> (open(IMAGE f s) <=> open s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE]] THEN SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; add_linear_invariants [OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];; let OPEN_INVERTIBLE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ invertible(matrix f) /\ open s ==> open(IMAGE f s)`, SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; MATRIX_INVERTIBLE] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN GEN_TAC THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[]);; let CLOSED_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> !s. closed s ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (:real^M)` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) (:real^M)`; `IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s)`] CONTINUOUS_CLOSED_IN_PREIMAGE) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_I]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN REWRITE_TAC[EXTENSION; o_THM; I_THM] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSPACE THEN ASM_REWRITE_TAC[IN_UNIV; SUBSPACE_UNIV; CLOSED_UNIV] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o AP_TERM `g:real^N->real^M`) THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM]) THEN ASM_MESON_TAC[LINEAR_0]]);; let CLOSED_INJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (closed(IMAGE f s) <=> closed s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]] THEN SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; add_linear_invariants [CLOSED_INJECTIVE_LINEAR_IMAGE_EQ];; let CLOSURE_LINEAR_IMAGE_SUBSET = prove (`!f:real^M->real^N s. linear f ==> IMAGE f (closure s) SUBSET closure(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; LINEAR_CONTINUOUS_ON]);; let CLOSURE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE; CLOSED_CLOSURE]);; add_linear_invariants [CLOSURE_INJECTIVE_LINEAR_IMAGE];; let CLOSURE_BOUNDED_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ bounded s ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]);; let LINEAR_INTERIOR_IMAGE_SUBSET = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, MESON_TAC[INTERIOR_IMAGE_SUBSET; LINEAR_CONTINUOUS_AT]);; let LINEAR_IMAGE_SUBSET_INTERIOR = prove (`!f:real^M->real^N s. linear f /\ (!y. ?x. f x = y) ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN ASM_SIMP_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE; OPEN_INTERIOR; IMAGE_SUBSET; INTERIOR_SUBSET]);; let INTERIOR_BIJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> interior(IMAGE f s) = IMAGE f (interior s)`, REWRITE_TAC[interior] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [INTERIOR_BIJECTIVE_LINEAR_IMAGE];; let FRONTIER_BIJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, REWRITE_TAC[frontier] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [FRONTIER_BIJECTIVE_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Corollaries, reformulations and special cases for M = N. *) (* ------------------------------------------------------------------------- *) let IN_INTERIOR_LINEAR_IMAGE = prove (`!f:real^M->real^N g s x. linear f /\ linear g /\ (f o g = I) /\ x IN interior s ==> (f x) IN interior (IMAGE f s)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LINEAR_IMAGE_SUBSET_INTERIOR) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]);; let LINEAR_OPEN_MAPPING = prove (`!f:real^M->real^N g. linear f /\ linear g /\ (f o g = I) ==> !s. open s ==> open(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[]);; let INTERIOR_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> interior(IMAGE f s) = IMAGE f (interior s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; let INTERIOR_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!y. ?x. f x = y) ==> interior(IMAGE f s) = IMAGE f (interior s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; let CLOSURE_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!y. ?x. f x = y) ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; let FRONTIER_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; let FRONTIER_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N. linear f /\ (!y. ?x. f x = y) ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; let COMPLETE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> !s. complete s ==> complete(IMAGE f s)`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE]);; let COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (complete(IMAGE f s) <=> complete s)`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]);; add_linear_invariants [COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ];; let LIMPT_INJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> ((f x) limit_point_of (IMAGE f s) <=> x limit_point_of s)`, REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS); MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THENL [FIRST_X_ASSUM(MP_TAC o SPEC `e * B:real`); FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`)] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; dist; GSYM LINEAR_SUB] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; add_linear_invariants [LIMPT_INJECTIVE_LINEAR_IMAGE_EQ];; let LIMPT_TRANSLATION_EQ = prove (`!a s x. (a + x) limit_point_of (IMAGE (\y. a + y) s) <=> x limit_point_of s`, REWRITE_TAC[limit_point_of] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [LIMPT_TRANSLATION_EQ];; let OPEN_OPEN_LEFT_PROJECTION = prove (`!s t:real^(M,N)finite_sum->bool. open s /\ open t ==> open {x | x IN s /\ ?y. pastecart x y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ ?y. (pastecart x y:real^(M,N)finite_sum) IN t} = s INTER IMAGE fstcart t` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN MESON_TAC[FSTCART_PASTECART; PASTECART_FST_SND]; MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] OPEN_SURJECTIVE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN MESON_TAC[FSTCART_PASTECART]]);; let OPEN_OPEN_RIGHT_PROJECTION = prove (`!s t:real^(M,N)finite_sum->bool. open s /\ open t ==> open {y | y IN s /\ ?x. pastecart x y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{y | y IN s /\ ?x. (pastecart x y:real^(M,N)finite_sum) IN t} = s INTER IMAGE sndcart t` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN MESON_TAC[SNDCART_PASTECART; PASTECART_FST_SND]; MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] OPEN_SURJECTIVE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN MESON_TAC[SNDCART_PASTECART]]);; (* ------------------------------------------------------------------------- *) (* Even more special cases. *) (* ------------------------------------------------------------------------- *) let INTERIOR_SCALING = prove (`!s:real^N->bool c. interior (IMAGE (\x. c % x) s) = if c = &0 then {} else IMAGE (\x. c % x) (interior s)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THENL [MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN EXISTS_TAC `interior {vec 0:real^N}` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]; REWRITE_TAC[INTERIOR_SING]]; MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; LINEAR_SCALING]]);; let INTERIOR_AFFINITY = prove (`!s m c:real^N. interior(IMAGE (\x. m % x + c) s) = if m = &0 then {} else IMAGE (\x. m % x + c) (interior s)`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; IMAGE_o] THEN REWRITE_TAC[INTERIOR_TRANSLATION; INTERIOR_SCALING] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES]);; let CLOSURE_SCALING = prove (`!s:real^N->bool c. closure(IMAGE (\x. c % x) s) = IMAGE (\x. c % x) (closure s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CLOSURE_EMPTY; IMAGE_CLAUSES] THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; CLOSURE_EQ_EMPTY; CLOSURE_SING; IMAGE_CONST] THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; LINEAR_SCALING]);; let CLOSURE_AFFINITY = prove (`!s m c:real^N. closure(IMAGE (\x. m % x + c) s) = IMAGE (\x. m % x + c) (closure s)`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; IMAGE_o] THEN REWRITE_TAC[CLOSURE_TRANSLATION; CLOSURE_SCALING] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES]);; let FRONTIER_SCALING = prove (`!s:real^N->bool c. frontier (IMAGE (\x. c % x) s) = if c = &0 /\ s = (:real^N) then {vec 0} else IMAGE (\x. c % x) (frontier s)`, REPEAT GEN_TAC THEN REWRITE_TAC[frontier; CLOSURE_SCALING; INTERIOR_SCALING] THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; IMAGE_CONST] THENL [REWRITE_TAC[CLOSURE_EQ_EMPTY; DIFF_EMPTY] THEN ASM_REWRITE_TAC[GSYM frontier; FRONTIER_EQ_EMPTY] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[COND_ID] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CLOSURE_EMPTY; EMPTY_DIFF] THEN SET_TAC[]; CONV_TAC SYM_CONV THEN MATCH_MP_TAC IMAGE_DIFF_INJ THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL]]);; let FRONTIER_AFFINITY = prove (`!s m c:real^N. frontier (IMAGE (\x. m % x + c) s) = if m = &0 /\ s = (:real^N) then {c} else IMAGE (\x. m % x + c) (frontier s)`, REPEAT GEN_TAC THEN REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; FRONTIER_TRANSLATION; FRONTIER_SCALING; IMAGE_o] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID]);; let INTERIOR_NEGATIONS = prove (`!s. interior(IMAGE (--) s) = IMAGE (--) (interior s)`, GEN_TAC THEN MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; let SYMMETRIC_INTERIOR = prove (`!s:real^N->bool. (!x. x IN s ==> --x IN s) ==> !x. x IN interior s ==> (--x) IN interior s`, REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN REWRITE_TAC[GSYM INTERIOR_NEGATIONS] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; let CLOSURE_NEGATIONS = prove (`!s. closure(IMAGE (--) s) = IMAGE (--) (closure s)`, GEN_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; let SYMMETRIC_CLOSURE = prove (`!s:real^N->bool. (!x. x IN s ==> --x IN s) ==> !x. x IN closure s ==> (--x) IN closure s`, REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN REWRITE_TAC[GSYM CLOSURE_NEGATIONS] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; (* ------------------------------------------------------------------------- *) (* Some properties of a canonical subspace. *) (* ------------------------------------------------------------------------- *) let SUBSPACE_SUBSTANDARD = prove (`!d. subspace {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, GEN_TAC THEN ASM_CASES_TAC `d <= dimindex(:N)` THENL [MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN SIMP_TAC[subspace; IN_ELIM_THM; REAL_MUL_RZERO; REAL_ADD_LID; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT]; ASM_SIMP_TAC[ARITH_RULE `~(d:num <= e) ==> (d < i /\ i <= e <=> F)`] THEN REWRITE_TAC[SET_RULE `{x | T} = UNIV`; SUBSPACE_UNIV]]);; let CLOSED_SUBSTANDARD = prove (`!d. closed {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, GEN_TAC THEN SUBGOAL_THEN `{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} = INTERS {{x | basis i dot x = &0} | d < i /\ i <= dimindex(:N)}` SUBST1_TAC THENL [ALL_TAC; SIMP_TAC[CLOSED_INTERS; CLOSED_HYPERPLANE; IN_ELIM_THM; LEFT_IMP_EXISTS_THM]] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN SIMP_TAC[DOT_BASIS] THEN MESON_TAC[]);; let DIM_SUBSTANDARD = prove (`!d. d <= dimindex(:N) ==> (dim {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} = d)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `IMAGE (basis:num->real^N) (1..d)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN MESON_TAC[BASIS_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`; NOT_LT]; ALL_TAC; MATCH_MP_TAC INDEPENDENT_MONO THEN EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN REWRITE_TAC[INDEPENDENT_STDBASIS]THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS; BASIS_INJ]] THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`; SPAN_STDBASIS] THEN SUBGOAL_THEN `IMAGE basis (1 .. 0) :real^N->bool = {}` SUBST1_TAC THENL [REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; ARITH]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[SPAN_EMPTY; SUBSET; IN_ELIM_THM; IN_SING] THEN SIMP_TAC[CART_EQ; VEC_COMPONENT]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x - (x$(SUC d)) % basis(SUC d) :real^N`) THEN ANTS_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `d < i ==> 1 <= i`)) THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_SUB_REFL] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN ASM_MESON_TAC[ARITH_RULE `d < i /\ ~(i = SUC d) ==> SUC d < i`]; ALL_TAC] THEN DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH `x = (x - (x$(SUC d)) % basis(SUC d)) + x$(SUC d) % basis(SUC d) :real^N`) THEN MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_MONO; SUBSET_IMAGE; SUBSET; SUBSET_NUMSEG; LE_REFL; LE]; MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN MESON_TAC[LE_REFL; ARITH_RULE `1 <= SUC d`]]);; (* ------------------------------------------------------------------------- *) (* Hence closure and completeness of all subspaces. *) (* ------------------------------------------------------------------------- *) let CLOSED_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> closed s`, REPEAT STRIP_TAC THEN ABBREV_TAC `d = dim(s:real^N->bool)` THEN MP_TAC(MATCH_MP DIM_SUBSTANDARD (ISPEC `s:real^N->bool` DIM_SUBSET_UNIV)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`; `s:real^N->bool`] SUBSPACE_ISOMORPHISM) THEN ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(ISPEC `f:real^N->real^N` CLOSED_INJECTIVE_IMAGE_SUBSPACE) THEN ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD; CLOSED_SUBSTANDARD] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINEAR_0]] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[VEC_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`]);; let COMPLETE_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> complete s`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_SUBSPACE]);; let CLOSED_SPAN = prove (`!s. closed(span s)`, SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]);; let CLOSURE_SUBSET_SPAN = prove (`!s:real^N->bool. closure s SUBSET span s`, GEN_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_SPAN; SPAN_INC]);; let DIM_CLOSURE = prove (`!s:real^N->bool. dim(closure s) = dim s`, GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN]; ALL_TAC] THEN MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN; SPAN_INC]);; let CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. closed s /\ f continuous_on s /\ (!e. bounded {x | x IN s /\ norm(f x) <= e}) ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_INTERS_COMPACT] THEN REWRITE_TAC[SET_RULE `cball(vec 0,e) INTER IMAGE (f:real^M->real^N) s = IMAGE f (s INTER {x | x IN s /\ f x IN cball(vec 0,e)})`] THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_CBALL_0]; ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CBALL]]]);; let CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE = prove (`!f:real^M->real^N s t. closed s /\ s SUBSET t /\ subspace t /\ linear f /\ (!x. x IN t /\ f(x) = vec 0 ==> x = vec 0) ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`] INJECTIVE_IMP_ISOMETRIC) THEN ASM_SIMP_TAC[CLOSED_SUBSPACE; real_ge] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(vec 0:real^M,e / B)` THEN REWRITE_TAC[BOUNDED_CBALL] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0; REAL_LE_RDIV_EQ] THEN ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);; let BASIS_COORDINATES_LIPSCHITZ = prove (`!b:real^N->bool. independent b ==> ?B. &0 < B /\ !c v. v IN b ==> abs(c v) <= B * norm(vsum b (\v. c(v) % v))`, X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP INDEPENDENT_BOUND) THEN FIRST_ASSUM(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ABBREV_TAC `n = CARD(k:real^N->bool)` THEN MP_TAC(ISPECL [`(\x. vsum(1..n) (\i. x$i % b i)):real^N->real^N`; `span(IMAGE basis (1..n)):real^N->bool`] INJECTIVE_IMP_ISOMETRIC) THEN REWRITE_TAC[SUBSPACE_SPAN] THEN ANTS_TAC THENL [CONJ_TAC THENL [SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_VMUL_COMPONENT THEN SIMP_TAC[LINEAR_ID] THEN ASM_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPAN_IMAGE_BASIS]) THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N->num`) THEN SUBGOAL_THEN `vsum(1..n) (\i. (x:real^N)$i % b i:real^N) = vsum k (\v. x$(c v) % v)` SUBST1_TAC THENL [MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN MAP_EVERY EXISTS_TAC [`b:num->real^N`; `c:real^N->num`] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN DISCH_THEN(MP_TAC o SPEC `\v:real^N. (x:real^N)$(c v)` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[CART_EQ; FORALL_IN_IMAGE; VEC_COMPONENT] THEN ASM_MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(B:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN MAP_EVERY X_GEN_TAC [`c:real^N->real`; `j:num`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rand o rand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`) THEN SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA] THEN ANTS_TAC THENL [MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = v /\ u <= y ==> x >= y ==> u <= v`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN DISCH_THEN(K ALL_TAC)] THEN REWRITE_TAC[o_THM]; GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN MP_TAC(ISPECL [`(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`; `j:num`] COMPONENT_LE_NORM) THEN SUBGOAL_THEN `1 <= j /\ j <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[]]]);; let COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ s INTER t SUBSET {vec 0} ==> ?B. &0 < B /\ !x y. x IN s /\ y IN t ==> norm(x) <= B * norm(x + y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPEC `b UNION c:real^N->bool` BASIS_COORDINATES_LIPSCHITZ) THEN ASM_SIMP_TAC[INDEPENDENT_UNION] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(sum (b:real^N->bool) norm + &1) * B` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_ARITH `&0 <= x ==> &0 < x + &1`; SUM_POS_LE; NORM_POS_LE] THEN SUBGOAL_THEN `DISJOINT (b:real^N->bool) c` ASSUME_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s INTER t SUBSET {z} ==> b SUBSET s /\ c SUBSET t /\ ~(z IN b) ==> DISJOINT b c`)) THEN ASM_MESON_TAC[SPAN_INC; INDEPENDENT_NONZERO]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN MP_TAC(ISPEC `c:real^N->bool` SPAN_FINITE) THEN MP_TAC(ISPEC `b:real^N->bool` SPAN_FINITE) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN X_GEN_TAC `a':real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x. if x IN b then (a:real^N->real) x else a' x`) THEN ASM_SIMP_TAC[VSUM_UNION] THEN REWRITE_TAC[FORALL_IN_UNION] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `DISJOINT b c ==> !x. x IN c ==> ~(x IN b)`)) THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= b * y /\ x <= s * b * y ==> x <= ((s + &1) * b) * y`) THEN ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE; GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] NORM_MUL] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);; let BASIS_COORDINATES_CONTINUOUS = prove (`!b:real^N->bool e. independent b /\ &0 < e ==> ?d. &0 < d /\ !c. norm(vsum b (\v. c(v) % v)) < d ==> !v. v IN b ==> abs(c v) < e`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN X_GEN_TAC `c:real^N->real` THEN DISCH_TAC THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(vsum b (\v:real^N. c v % v))` THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);; (* ------------------------------------------------------------------------- *) (* Affine transformations of intervals. *) (* ------------------------------------------------------------------------- *) let AFFINITY_INVERSES = prove (`!m c. ~(m = &0) ==> (\x. m % x + c) o (\x. inv(m) % x + (--(inv(m) % c))) = I /\ (\x. inv(m) % x + (--(inv(m) % c))) o (\x. m % x + c) = I`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_RNEG] THEN SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let REAL_AFFINITY_LE = prove (`!m c x y. &0 < m ==> (m * x + c <= y <=> x <= inv(m) * y + --(c / m))`, REWRITE_TAC[REAL_ARITH `m * x + c <= y <=> x * m <= y - c`] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC);; let REAL_LE_AFFINITY = prove (`!m c x y. &0 < m ==> (y <= m * x + c <=> inv(m) * y + --(c / m) <= x)`, REWRITE_TAC[REAL_ARITH `y <= m * x + c <=> y - c <= x * m`] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC);; let REAL_AFFINITY_LT = prove (`!m c x y. &0 < m ==> (m * x + c < y <=> x < inv(m) * y + --(c / m))`, SIMP_TAC[REAL_LE_AFFINITY; GSYM REAL_NOT_LE]);; let REAL_LT_AFFINITY = prove (`!m c x y. &0 < m ==> (y < m * x + c <=> inv(m) * y + --(c / m) < x)`, SIMP_TAC[REAL_AFFINITY_LE; GSYM REAL_NOT_LE]);; let REAL_AFFINITY_EQ = prove (`!m c x y. ~(m = &0) ==> (m * x + c = y <=> x = inv(m) * y + --(c / m))`, CONV_TAC REAL_FIELD);; let REAL_EQ_AFFINITY = prove (`!m c x y. ~(m = &0) ==> (y = m * x + c <=> inv(m) * y + --(c / m) = x)`, CONV_TAC REAL_FIELD);; let VECTOR_AFFINITY_EQ = prove (`!m c x y. ~(m = &0) ==> (m % x + c = y <=> x = inv(m) % y + --(inv(m) % c))`, SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; real_div; VECTOR_NEG_COMPONENT; REAL_AFFINITY_EQ] THEN REWRITE_TAC[REAL_MUL_AC]);; let VECTOR_EQ_AFFINITY = prove (`!m c x y. ~(m = &0) ==> (y = m % x + c <=> inv(m) % y + --(inv(m) % c) = x)`, SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; real_div; VECTOR_NEG_COMPONENT; REAL_EQ_AFFINITY] THEN REWRITE_TAC[REAL_MUL_AC]);; let IMAGE_AFFINITY_INTERVAL = prove (`!a b:real^N m c. IMAGE (\x. m % x + c) (interval[a,b]) = if interval[a,b] = {} then {} else if &0 <= m then interval[m % a + c,m % b + c] else interval[m % b + c,m % a + c]`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[REAL_LE_LT] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; COND_ID] THEN REWRITE_TAC[INTERVAL_SING] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN ASM_SIMP_TAC[EXTENSION; IN_IMAGE; REAL_ARITH `&0 < --x ==> ~(&0 < x)`] THENL [ALL_TAC; ONCE_REWRITE_TAC[VECTOR_ARITH `x = m % y + c <=> c = (--m) % y + x`]] THEN ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; REAL_LT_IMP_NZ; UNWIND_THM1] THEN SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_INV_EQ]) THEN SIMP_TAC[REAL_AFFINITY_LE; REAL_LE_AFFINITY; real_div] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_INV_INV] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_NEGNEG] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> (inv m * x) * m = x`] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some matrix identities are easier to deduce for invertible matrices. We *) (* can then extend by continuity, which is why this material needs to be *) (* here after basic topological notions have been defined. *) (* ------------------------------------------------------------------------- *) let LIM_LIFT_DET = prove (`!(A:A->real^N^N) (B:real^N^N) net. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> ((\x. lift(A x$i$j)) --> lift(B$i$j)) net) ==> ((\x. lift(det(A x))) --> lift(det B)) net`, REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN SIMP_TAC[LIFT_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG; o_DEF] THEN MATCH_MP_TAC LIM_VSUM THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; LIFT_CMUL; IN_ELIM_THM] THEN X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN MATCH_MP_TAC LIM_CMUL THEN MATCH_MP_TAC LIM_LIFT_PRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG]);; let LIM_COFACTOR = prove (`!net A:A->real^N^N B. (!x. ((\a. A a ** x) --> B ** x) net) ==> !x. ((\a. cofactor(A a) ** x) --> cofactor B ** x) net`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[dot; LIFT_SUM; o_DEF] THEN MATCH_MP_TAC LIM_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`k:num`; `l:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_CASES_TAC `k:num = i /\ l:num = j` THEN ASM_REWRITE_TAC[LIM_CONST] THEN ASM_CASES_TAC `k:num = i \/ l:num = j` THEN ASM_REWRITE_TAC[LIM_CONST] THEN FIRST_X_ASSUM(MP_TAC o SPEC `basis l:real^N`) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPONENT) THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[LAMBDA_BETA]);; let LIM_MATRIX_TRANSP = prove (`!net A:A->real^M^N B. (!x. ((\a. transp(A a) ** x) --> transp B ** x) net) <=> (!x. ((\a. A a ** x) --> B ** x) net)`, REWRITE_TAC[LIM_MATRIX_COMPONENTWISE; TRANSP_COMPONENT] THEN MESON_TAC[]);; let LIM_MATRIX_INV = prove (`!net A:A->real^N^N B. (!x. ((\a. A a ** x) --> B ** x) net) /\ ~(det B = &0) ==> !x. ((\a. matrix_inv(A a) ** x) --> matrix_inv B ** x) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\a:A. (inv(det(A a:real^N^N)) %% transp(cofactor(A a))) ** (x:real^N)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\a:A. ~(det(A a:real^N^N) = &0)` THEN SIMP_TAC[MATRIX_INV_COFACTOR; VECTOR_SUB_REFL] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_MATRIX_COMPONENTWISE]) THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_LIFT_DET) THEN REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `abs(det(B:real^N^N))`) THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[DIST_LIFT] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[MATRIX_INV_COFACTOR; MATRIX_VECTOR_LMUL] THEN MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_LIFT_DET THEN ASM_REWRITE_TAC[GSYM LIM_MATRIX_COMPONENTWISE]; SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[LIM_MATRIX_TRANSP] THEN MATCH_MP_TAC LIM_COFACTOR THEN ASM_REWRITE_TAC[]]]);; let CONTINUOUS_LIFT_DET = prove (`!(A:A->real^N^N) net. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (\x. lift(A x$i$j)) continuous net) ==> (\x. lift(det(A x))) continuous net`, REWRITE_TAC[continuous; LIM_LIFT_DET]);; let CONTINUOUS_ON_LIFT_DET = prove (`!A:real^M->real^N^N s. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (\x. lift(A x$i$j)) continuous_on s) ==> (\x. lift(det(A x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_DET]);; let CONTINUOUS_DET_EXPLICIT = prove (`!A:real^N^N e. &0 < e ==> ?d. &0 < d /\ !A':real^N^N. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> abs(A'$i$j - A$i$j) < d) ==> abs(det A' - det A) < e`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN PURE_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[SKOLEM_THM; REAL_NOT_LT; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `L:num->real^N^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`L:num->real^N^N`; `A:real^N^N`; `sequentially`] LIM_LIFT_DET) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&n + &1)` THEN ASM_SIMP_TAC[GSYM LIFT_SUB; NORM_LIFT; REAL_LT_IMP_LE] THEN REWRITE_TAC[EVENTUALLY_TRUE; SEQ_HARMONIC_OFFSET]; REWRITE_TAC[LIM_SEQUENTIALLY; NOT_IMP; DIST_LIFT] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LE_REFL; REAL_NOT_LT]]);; let NEARBY_INVERTIBLE_MATRIX = prove (`!A:real^N^N. ?e. &0 < e /\ !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% mat 1)`, GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` CHARACTERISTIC_POLYNOMIAL) THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`dimindex(:N)`; `a:num->real`] REAL_POLYFUN_FINITE_ROOTS) THEN MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP FINITE_IMAGE) THEN DISCH_THEN(MP_TAC o MATCH_MP LIMIT_POINT_FINITE) THEN DISCH_THEN(MP_TAC o SPEC `lift(&0)`) THEN REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN REWRITE_TAC[DIST_LIFT; LIFT_EQ; REAL_SUB_RZERO; NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN MP_TAC(SPEC `--x:real` th)) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `--x:real`) THEN ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_ABS_NEG] THEN ONCE_REWRITE_TAC[GSYM INVERTIBLE_NEG] THEN REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN REWRITE_TAC[GSYM MATRIX_CMUL_ADD_LDISTRIB; GSYM MATRIX_CMUL_ASSOC] THEN REWRITE_TAC[MATRIX_CMUL_LID; MATRIX_ADD_SYM]);; let NEARBY_INVERTIBLE_MATRIX_GEN = prove (`!A B:real^N^N. invertible B ==> ?e. &0 < e /\ !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% B)`, REWRITE_TAC[INVERTIBLE_DET_NZ] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `matrix_inv(B:real^N^N) ** (A:real^N^N)` NEARBY_INVERTIBLE_MATRIX) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) (det(matrix_inv(B:real^N^N)))`) THEN REWRITE_TAC[GSYM DET_MUL; REAL_MUL_RZERO; MATRIX_ADD_LDISTRIB] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[MATRIX_MUL_RMUL] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[MATRIX_MUL_LINV]);; let MATRIX_WLOG_INVERTIBLE = prove (`!P. (!A:real^N^N. invertible A ==> P A) /\ (!A:real^N^N. ?d. &0 < d /\ closed {x | x IN cball(vec 0,d) /\ P(A + drop x %% mat 1)}) ==> !A:real^N^N. P A`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^1` o GEN_REWRITE_RULE I [CLOSED_LIMPT]) THEN ASM_SIMP_TAC[IN_ELIM_THM; DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN ANTS_TAC THENL [ALL_TAC; CONV_TAC TAUT] THEN MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_LIFT; IN_ELIM_THM] THEN REWRITE_TAC[GSYM LIFT_NUM; IN_CBALL_0; NORM_LIFT; DIST_LIFT] THEN REWRITE_TAC[REAL_SUB_RZERO; LIFT_EQ; LIFT_DROP] THEN EXISTS_TAC `min d ((min e k) / &2)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; let SYLVESTER_DETERMINANT_IDENTITY = prove (`!A:real^N^M B:real^M^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, let lemma1 = prove (`!A:real^N^N B:real^N^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `det((mat 1 + A ** B) ** A:real^N^N) = det(A ** (mat 1 + B ** A))` MP_TAC THENL [REWRITE_TAC[MATRIX_ADD_RDISTRIB; MATRIX_ADD_LDISTRIB] THEN REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID; MATRIX_MUL_ASSOC]; REWRITE_TAC[DET_MUL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INVERTIBLE_DET_NZ]) THEN CONV_TAC REAL_RING]; X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; CONTINUOUS_CONST] THEN SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN REWRITE_TAC[LIFT_DROP; CONTINUOUS_AT_ID]]) in let lemma2 = prove (`!A:real^N^M B:real^M^N. dimindex(:M) <= dimindex(:N) ==> det(mat 1 + A ** B) = det(mat 1 + B ** A)`, REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`A':real^N^N = lambda i j. if i <= dimindex(:M) then (A:real^N^M)$i$j else &0`; `B':real^N^N = lambda i j. if j <= dimindex(:M) then (B:real^M^N)$i$j else &0`] THEN MP_TAC(ISPECL [`A':real^N^N`; `B':real^N^N`] lemma1) THEN SUBGOAL_THEN `(B':real^N^N) ** (A':real^N^N) = (B:real^M^N) ** (A:real^N^M)` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; FINITE_NUMSEG; SUBSET_NUMSEG; LE_REFL; TAUT `(p /\ q) /\ ~(p /\ r) <=> p /\ q /\ ~r`]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {p | p permutes 1..dimindex(:N) /\ !i. dimindex(:M) < i ==> p i = i} (\p. sign p * product (1..dimindex(:N)) (\i. (mat 1 + (A':real^N^N) ** (B':real^N^N))$i$p i))` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; SIMP_TAC[IN_ELIM_THM; IMP_CONJ]] THEN X_GEN_TAC `p:num->num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE; PRODUCT_EQ_0_NUMSEG] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `k:num` o CONJUNCT1 o GEN_REWRITE_RULE I [permutes]) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; REAL_ADD_LID] THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; GSYM NOT_LT]] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN EXISTS_TAC `\f:num->num. f` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THENL [REWRITE_TAC[MESON[] `(?!x. P x /\ x = y) <=> P y`] THEN CONJ_TAC THENL [MATCH_MP_TAC PERMUTES_SUBSET THEN EXISTS_TAC `1..dimindex(:M)` THEN ASM_REWRITE_TAC[SUBSET_NUMSEG; LE_REFL]; X_GEN_TAC `k:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [permutes]) THEN ASM_REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; NOT_LE]]; MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC PERMUTES_SUPERSET THEN EXISTS_TAC `1..dimindex(:N)` THEN ASM_REWRITE_TAC[IN_DIFF; IN_NUMSEG] THEN ASM_MESON_TAC[NOT_LE]; DISCH_TAC] THEN AP_TERM_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `m:num <= n ==> n = m + (n - m)`)) THEN SIMP_TAC[PRODUCT_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN MATCH_MP_TAC(REAL_RING `x = y /\ z = &1 ==> x = y * z`) THEN CONJ_TAC THENL [MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`p:num->num`; `1..dimindex(:M)`] PERMUTES_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `(p:num->num) i <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN ASM_SIMP_TAC[LAMBDA_BETA]; MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG THEN ASM_SIMP_TAC[ARITH_RULE `n + 1 <= i ==> n < i`] THEN ASM_SIMP_TAC[ARITH_RULE `m:num <= n ==> m + (n - m) = n`] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN ASM_SIMP_TAC[REAL_EQ_ADD_LCANCEL_0; matrix_mul; LAMBDA_BETA] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `m + 1 <= i ==> ~(i <= m)`]]]) in REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE `dimindex(:M) <= dimindex(:N) \/ dimindex(:N) <= dimindex(:M)`) THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[]);; let COFACTOR_MATRIX_MUL = prove (`!A B:real^N^N. cofactor(A ** B) = cofactor(A) ** cofactor(B)`, MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL [ASM_SIMP_TAC[COFACTOR_MATRIX_INV; GSYM INVERTIBLE_DET_NZ; INVERTIBLE_MATRIX_MUL] THEN REWRITE_TAC[DET_MUL; MATRIX_MUL_LMUL] THEN REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_CMUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN ASM_SIMP_TAC[MATRIX_INV_MUL]; GEN_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]]; X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN MATCH_MP_TAC CLOSED_FORALL THEN GEN_TAC] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN REWRITE_TAC[CART_EQ] THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; cofactor; LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN (MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC]) THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; CONTINUOUS_CONST] THEN REPEAT(W(fun (asl,w) -> let t = find_term is_cond w in ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN TRY(MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN STRIP_TAC) THEN REWRITE_TAC[LIFT_CMUL] THEN TRY(MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_CONST]) THEN REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_CONST; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; let DET_COFACTOR = prove (`!A:real^N^N. det(cofactor A) = det(A) pow (dimindex(:N) - 1)`, MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN X_GEN_TAC `A:real^N^N` THENL [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_FIELD `~(a = &0) ==> a * x = a * y ==> x = y`)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN REWRITE_TAC[GSYM DET_MUL; MATRIX_MUL_RIGHT_COFACTOR] THEN REWRITE_TAC[DET_CMUL; GSYM(CONJUNCT2 real_pow); DET_I; REAL_MUL_RID] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`]; ALL_TAC] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_LIFT_POW] THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID] THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REPEAT(W(fun (asl,w) -> let t = find_term is_cond w in ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; let INVERTIBLE_COFACTOR = prove (`!A:real^N^N. invertible(cofactor A) <=> dimindex(:N) = 1 \/ invertible A`, SIMP_TAC[DET_COFACTOR; INVERTIBLE_DET_NZ; REAL_POW_EQ_0; DE_MORGAN_THM; DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`; DISJ_ACI]);; let COFACTOR_COFACTOR = prove (`!A:real^N^N. 2 <= dimindex(:N) ==> cofactor(cofactor A) = (det(A) pow (dimindex(:N) - 2)) %% A`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN X_GEN_TAC `A:real^N^N` THENL [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] COFACTOR_MATRIX_MUL) THEN REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; COFACTOR_CMUL; COFACTOR_I] THEN REWRITE_TAC[COFACTOR_TRANSP] THEN DISCH_THEN(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; TRANSP_MATRIX_CMUL] THEN REWRITE_TAC[TRANSP_MAT] THEN DISCH_THEN(MP_TAC o AP_TERM `(\x. x ** A):real^N^N->real^N^N`) THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LEFT_COFACTOR] THEN REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N^N. inv(det(A:real^N^N)) %% x`) THEN ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_LINV; MATRIX_CMUL_LID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[REAL_POW_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; POP_ASSUM(K ALL_TAC)] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN REWRITE_TAC[CART_EQ] THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL [REPLICATE_TAC 2 (ONCE_REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REPEAT(W(fun (asl,w) -> let t = find_term is_cond w in ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST]))); REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_LIFT_POW THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC; ALL_TAC]] THEN REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_CMUL; CONTINUOUS_AT_ID]);; let RANK_COFACTOR_EQ_FULL = prove (`!A:real^N^N. rank(cofactor A) = dimindex(:N) <=> dimindex(:N) = 1 \/ rank A = dimindex(:N)`, REWRITE_TAC[RANK_EQ_FULL_DET; DET_COFACTOR; REAL_POW_EQ_0] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN CONV_TAC TAUT);; let COFACTOR_EQ_0 = prove (`!A:real^N^N. cofactor A = mat 0 <=> rank(A) < dimindex(:N) - 1`, let lemma1 = prove (`!A:real^N^N. rank(A) < dimindex(:N) - 1 ==> cofactor A = mat 0`, GEN_TAC THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN SIMP_TAC[CART_EQ; cofactor; MAT_COMPONENT; LAMBDA_BETA; COND_ID] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[DET_EQ_0_RANK] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `r < n - 1 ==> s <= r + 1 ==> s < n`)) THEN REWRITE_TAC[RANK_ROW; rows] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim (basis n INSERT {row i ((lambda k l. if l = n then &0 else (A:real^N^N)$k$l) :real^N^N) | i IN (1..dimindex(:N)) DELETE m})` THEN CONJ_TAC THENL [MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `m IN s /\ (!i. i IN s DELETE m ==> f i = g i) /\ f m = a ==> {f i | i IN s} SUBSET a INSERT {g i | i IN s DELETE m}`) THEN ASM_SIMP_TAC[IN_NUMSEG; IN_DELETE; row; LAMBDA_BETA; basis; LAMBDA_ETA]; REWRITE_TAC[DIM_INSERT] THEN MATCH_MP_TAC(ARITH_RULE `n <= k ==> (if p then n else n + 1) <= k + 1`) THEN MATCH_MP_TAC(MESON[DIM_LINEAR_IMAGE_LE; DIM_SUBSET; LE_TRANS] `(?f. linear f /\ t SUBSET IMAGE f s) ==> dim t <= dim s`) THEN EXISTS_TAC `(\x. lambda i. if i = n then &0 else x$i) :real^N->real^N` THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG; IN_DELETE] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA]]]) and lemma2 = prove (`!A:real^N^N. rank A < dimindex(:N) ==> ?n x. 1 <= n /\ n <= dimindex(:N) /\ rank A < rank((lambda i. if i = n then x else row i A):real^N^N)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?n. 1 <= n /\ n <= dimindex(:N) /\ row n (A:real^N^N) IN span {row j A | j IN (1..dimindex(:N)) DELETE n}` MP_TAC THENL [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN ASM_REWRITE_TAC[DET_EQ_0_RANK; RANK_TRANSP] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN SIMP_TAC[matrix_vector_mul; transp; VEC_COMPONENT; LAMBDA_BETA] THEN DISCH_TAC THEN SUBGOAL_THEN `row n A = vsum ((1..dimindex(:N)) DELETE n) (\i. --((c:real^N)$i / c$n) % row i (A:real^N^N))` SUBST1_TAC THENL [ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; REAL_DIV_REFL] THEN REWRITE_TAC[VECTOR_ARITH `n = x - -- &1 % n <=> x:real^N = vec 0`] THEN SIMP_TAC[VSUM_COMPONENT; row; VECTOR_MUL_COMPONENT; LAMBDA_BETA; CART_EQ; REAL_ARITH `--(x / y) * z:real = --(inv y) * z * x`] THEN ASM_SIMP_TAC[SUM_LMUL; VEC_COMPONENT; REAL_MUL_RZERO]; MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `span {row j (A:real^N^N) | j IN (1..dimindex(:N)) DELETE n} PSUBSET (:real^N)` MP_TAC THENL [REWRITE_TAC[PSUBSET; SUBSET_UNIV] THEN DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN REWRITE_TAC[DIM_UNIV] THEN MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n - 1 ==> ~(x = n)`) THEN REWRITE_TAC[DIMINDEX_GE_1; DIM_SPAN] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIM_LE_CARD o lhand o snd) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN ASM_SIMP_TAC[CARD_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN REWRITE_TAC[CARD_NUMSEG_1; LE_REFL]; DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s PSUBSET UNIV ==> ?x. ~(x IN s)`)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN SUBGOAL_THEN `!A:real^N^N. rows A = row n A INSERT {row j A | j IN (1..dimindex (:N)) DELETE n}` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[rows; IN_DELETE; IN_NUMSEG] THEN ASM SET_TAC[]; ASM_SIMP_TAC[DIM_INSERT]] THEN COND_CASES_TAC THENL [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `x IN span s ==> x = y /\ s = t ==> ~(y IN span t) ==> q`)) THEN ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA]; MATCH_MP_TAC(ARITH_RULE `s = t ==> s < t + 1`) THEN AP_TERM_TAC THEN REWRITE_TAC[row]] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA; CART_EQ]]]) in GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[lemma1] THEN DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `r <= n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN ARITH_TAC; REWRITE_TAC[RANK_EQ_FULL_DET] THEN MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN REWRITE_TAC[MAT_EQ; ARITH_EQ]; DISCH_TAC] THEN MP_TAC(ISPEC `A:real^N^N` lemma2) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `n - 1 < n <=> 1 <= n`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `n - 1 < k ==> k <= MIN n n ==> k = n`)) THEN REWRITE_TAC[RANK_BOUND; RANK_EQ_FULL_DET] THEN MP_TAC(GEN `A:real^N^N` (ISPECL [`A:real^N^N`; `n:num`] DET_COFACTOR_EXPANSION)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN SIMP_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `m:num`) THEN ASM_SIMP_TAC[MAT_COMPONENT; COND_ID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA]) THEN ASM_MESON_TAC[]);; let RANK_COFACTOR_EQ_1 = prove (`!A:real^N^N. rank(cofactor A) = 1 <=> dimindex(:N) = 1 \/ rank A = dimindex(:N) - 1`, GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [ASM_MESON_TAC[RANK_COFACTOR_EQ_FULL]; ASM_REWRITE_TAC[]] THEN EQ_TAC THENL [ASM_CASES_TAC `cofactor A:real^N^N = mat 0` THEN ASM_REWRITE_TAC[RANK_0; ARITH_EQ] THEN DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `~(r < n - 1) /\ ~(r = n) /\ r <= MIN n n ==> r = n - 1`) THEN ASM_REWRITE_TAC[RANK_BOUND; GSYM COFACTOR_EQ_0] THEN MP_TAC(ISPEC `A:real^N^N` RANK_COFACTOR_EQ_FULL) THEN ASM_REWRITE_TAC[]; DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `~(n = 0) /\ n <= 1 ==> n = 1`) THEN ASM_REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0; LT_REFL] THEN MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] RANK_SYLVESTER) THEN ASM_REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; RANK_TRANSP] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a = n - 1 ==> 1 <= n ==> a < n`)) THEN ASM_SIMP_TAC[GSYM DET_EQ_0_RANK; DIMINDEX_GE_1] THEN DISCH_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; RANK_0] THEN ARITH_TAC]);; let RANK_COFACTOR = prove (`!A:real^N^N. rank(cofactor A) = if rank(A) = dimindex(:N) then dimindex(:N) else if rank(A) = dimindex(:N) - 1 then 1 else 0`, GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_FULL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_1] THEN REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0] THEN MATCH_MP_TAC(ARITH_RULE `r <= MIN n n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN ASM_REWRITE_TAC[RANK_BOUND]);; let SAME_EIGENVALUES_TRANSP = prove (`!A:real^N^N c. (?v. ~(v = vec 0) /\ transp(A) ** v = c % v) <=> (?v. ~(v = vec 0) /\ A ** v = c % v)`, REPEAT GEN_TAC THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN REWRITE_TAC[TRANSP_MATRIX_SUB; TRANSP_MATRIX_CMUL; TRANSP_MAT]);; let SAME_EIGENVALUES_SIMILAR = prove (`!S:real^N^N A c. invertible S ==> ((?v. ~(v = vec 0) /\ (matrix_inv S ** A ** S) ** v = c % v) <=> (?v. ~(v = vec 0) /\ A ** v = c % v))`, REPEAT STRIP_TAC THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT] THEN AP_THM_TAC THEN AP_TERM_TAC THEN TRANS_TAC EQ_TRANS `det(matrix_inv S ** (A - c %% mat 1) ** (S:real^N^N))` THEN CONJ_TAC THENL [AP_TERM_TAC; ASM_SIMP_TAC[DET_SIMILAR]] THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB; MATRIX_SUB_RDISTRIB] THEN REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN ASM_SIMP_TAC[MATRIX_INV; MATRIX_MUL_LID]);; let SAME_EIGENVALUES_MATRIX_MUL = prove (`!A B:real^N^N c. (?v. ~(v = vec 0) /\ (A ** B) ** v = c % v) <=> (?v. ~(v = vec 0) /\ (B ** A) ** v = c % v)`, REPEAT GEN_TAC THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[MATRIX_CMUL_LZERO; MATRIX_SUB_RZERO; DET_MUL; REAL_MUL_SYM] THEN SUBGOAL_THEN `A:real^N^N = --c %% (inv(--c) %% A)` SUBST1_TAC THENL [ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; MATRIX_CMUL_LID; REAL_MUL_RINV; REAL_NEG_EQ_0]; ONCE_REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL]] THEN REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1; MATRIX_CMUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID; GSYM MATRIX_CMUL_ADD_LDISTRIB] THEN REWRITE_TAC[DET_CMUL] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[MATRIX_ADD_SYM] THEN REWRITE_TAC[SYLVESTER_DETERMINANT_IDENTITY]);; let SAME_EIGENVECTORS_MATRIX_INV = prove (`!A:real^N^N c v. transp A = A ==> (matrix_inv A ** v = c % v <=> A ** v = inv(c) % v)`, SUBGOAL_THEN `!A:real^N^N c v. transp A = A ==> A ** v = c % v ==> matrix_inv A ** v = inv(c) % v` MP_TAC THENL [REPEAT STRIP_TAC; MESON_TAC[REAL_INV_INV; MATRIX_INV_INV; SYMMETRIC_MATRIX_INV]] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [ASM_MESON_TAC[VECTOR_MUL_LZERO; REAL_INV_0; MATRIX_VECTOR_MUL_INV_EQ_0]; ASM_REWRITE_TAC[]] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o LAND_CONV) [GSYM MATRIX_INV_MUL_INNER]) THEN ASM_REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM SYMMETRIC_MATRIX_INV_RMUL] THEN ASM_REWRITE_TAC[MATRIX_TRANSP_MUL; GSYM MATRIX_VECTOR_MUL_ASSOC; TRANSP_MATRIX_INV; MATRIX_VECTOR_MUL_RMUL] THEN DISCH_THEN(MP_TAC o AP_TERM `(%) (inv c * inv c):real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_FIELD `~(c = &0) ==> inv c * inv c * c * c = &1`] THEN REWRITE_TAC[VECTOR_MUL_LID; REAL_MUL_RID]);; let NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP = prove (`!A:real^N^N. transp A ** A = A ** transp A ==> !c v. transp A ** v = c % v <=> A ** v = c % v`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN ONCE_REWRITE_TAC[MESON[MATRIX_VECTOR_LMUL; MATRIX_VECTOR_MUL_LID] `c % v = (c %% mat 1:real^N^N) ** v`] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_MAT] THEN REWRITE_TAC[GSYM TRANSP_MATRIX_CMUL; GSYM TRANSP_MATRIX_SUB] THEN MATCH_MP_TAC NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT THEN REWRITE_TAC[TRANSP_MATRIX_SUB; TRANSP_MATRIX_CMUL; TRANSP_MAT] THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB] THEN REWRITE_TAC[MATRIX_SUB_RDISTRIB] THEN ASM_REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_SUB; MATRIX_CMUL_ADD_LDISTRIB] THEN REWRITE_TAC[MATRIX_CMUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[MATRIX_ADD_AC]);; let NORMAL_MATRIX_SAME_EIGENVECTORS_TRANSP = prove (`!A:real^N^N. transp A ** A = A ** transp A ==> !v. ((?c. transp A ** v = c % v) <=> (?c. A ** v = c % v))`, MESON_TAC[NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP]);; (* ------------------------------------------------------------------------- *) (* Not in so many words, but combining this with intermediate value theorem *) (* implies the determinant is an open map. *) (* ------------------------------------------------------------------------- *) let DET_OPEN_MAP = prove (`!A:real^N^N e. &0 < e ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < det A) /\ (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > det A)`, let lemma1 = prove (`!A:real^N^N i e. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 /\ &0 < e ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < &0) /\ (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > &0)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `det(A:real^N^N) = &0` ASSUME_TAC THENL [ASM_MESON_TAC[DET_ZERO_ROW]; ALL_TAC] THEN MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[INVERTIBLE_DET_NZ]] THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> x < &0 \/ &0 < x`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN (CONJ_TAC THENL [EXISTS_TAC `A + min d e / &2 %% mat 1:real^N^N`; EXISTS_TAC `(lambda j. if j = i then --(&1) % row i (A + min d e / &2 %% mat 1:real^N^N) else row j (A + min d e / &2 %% mat 1:real^N^N)) :real^N^N`]) THEN ASM_SIMP_TAC[DET_ROW_MUL; MESON[] `(if j = i then f i else f j) = f j`] THEN REWRITE_TAC[row; LAMBDA_ETA] THEN ASM_REWRITE_TAC[real_gt; GSYM row] THEN TRY(CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT; VECTOR_MUL_COMPONENT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_SIMP_TAC[row; LAMBDA_BETA; VEC_COMPONENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC) and lemma2 = prove (`!A:real^N^N x:real^N i. 1 <= i /\ i <= dimindex(:N) /\ x$i = &1 ==> det(lambda k. if k = i then transp A ** x else row k A) = det A`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `det(lambda k. if k = i then row i (A:real^N^N) + (transp A ** x - row i A) else row k A)` THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `r + (x - r):real^N = x`]; ALL_TAC] THEN MATCH_MP_TAC DET_ROW_SPAN THEN SUBGOAL_THEN `transp(A:real^N^N) ** x - row i A = vsum ((1..dimindex(:N)) DELETE i) (\k. x$k % row k A)` SUBST1_TAC THENL [SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_SUB_COMPONENT; row; transp; LAMBDA_BETA; matrix_vector_mul; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_AC]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_DELETE; IN_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) in REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `cofactor(A:real^N^N) = mat 0` THENL [MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN REWRITE_TAC[MAT_EQ; ARITH_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?c i. 1 <= i /\ i <= dimindex(:N) /\ c$i = &1 /\ transp(A:real^N^N) ** c = vec 0` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN ASM_REWRITE_TAC[DET_TRANSP] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[VEC_COMPONENT; NOT_IMP; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `inv(c$i) % c:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV] THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; VECTOR_MUL_RZERO]; ALL_TAC] THEN MP_TAC(ISPECL [`(lambda k. if k = i then transp A ** c else row k (A:real^N^N)):real^N^N`; `i:num`; `min e (e / &(dimindex(:N)) / (&1 + norm(&2 % basis i - c:real^N)))`] lemma1) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN ANTS_TAC THENL [ASM_SIMP_TAC[row; CART_EQ; VEC_COMPONENT; LAMBDA_BETA]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN ABBREV_TAC `A':real^N^N = lambda k. if k = i then vec 0 else row k (A:real^N^N)` THEN DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(lambda k. if k = i then transp(B:real^N^N) ** (&2 % basis i - c) else row k B):real^N^N` THEN ASM_SIMP_TAC[lemma2; BASIS_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; REAL_ARITH `&2 * x - x = x`] THEN (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN (COND_CASES_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; row]] THEN SUBGOAL_THEN `(A:real^N^N)$k$l = (transp(A':real^N^N) ** (&2 % basis i - c:real^N))$l` SUBST1_TAC THENL [ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[COND_RAND; COND_RATOR] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[SUM_CASES; FINITE_NUMSEG; SUM_0; REAL_ADD_LID] THEN ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN UNDISCH_TAC `transp(A:real^N^N) ** (c:real^N) = vec 0` THEN ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT; matrix_vector_mul; LAMBDA_BETA; row; transp] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[REAL_MUL_RNEG; SUM_NEG] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM TRANSP_MATRIX_SUB; GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB]] THEN ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN TRANS_TAC REAL_LET_TRANS `abs((B - A':real^N^N)$r$l) * (&1 + norm(&2 % basis i - c:real^N))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= &1 + b`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM]; ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; GSYM REAL_LT_RDIV_EQ; NORM_ARITH `&0 < &1 + norm(x:real^N)`]]); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN SIMP_TAC[CART_EQ; MAT_COMPONENT; COND_ID] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_gt] THEN DISCH_THEN(X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC (X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC))) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ x < &0`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN (CONJ_TAC THENL [EXISTS_TAC `(lambda m n. if m = i /\ n = j then (A:real^N^N)$i$j - e / (&1 + abs(cofactor A$i$j)) else A$m$n):real^N^N`; EXISTS_TAC `(lambda m n. if m = i /\ n = j then (A:real^N^N)$i$j + e / (&1 + abs(cofactor A$i$j)) else A$m$n):real^N^N`]) THEN (CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `abs(a - e - a) = abs e`; REAL_ARITH `abs((a + e) - a) = abs e`] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_ABS] THEN ASM_SIMP_TAC[REAL_ARITH `abs(&1 + abs x) = &1 + abs x`; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ &0 < e * x ==> abs e < e * (&1 + x)`) THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MP_TAC(GEN `A:real^N^N` (SPECL [`A:real^N^N`; `i:num`] DET_COFACTOR_EXPANSION)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN ASM_SIMP_TAC[GSYM SUM_SUB_NUMSEG; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `p - A$i$j * cofactor A$i$j = --(A$i$j * cofactor A$i$j - p)`] THEN REWRITE_TAC[SUM_NEG; REAL_ARITH `a * b - c * d:real = b * (a - c) + c * (b - d)`] THEN REWRITE_TAC[SUM_ADD_NUMSEG; REAL_NEG_ADD] THEN MATCH_MP_TAC(REAL_ARITH `b = &0 /\ &0 < a ==> &0 < a + b`) THEN (CONJ_TAC THENL [REWRITE_TAC[REAL_NEG_EQ_0] THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[GSYM SUM_NEG; GSYM REAL_MUL_RNEG] THEN MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC(MESON[REAL_LT_IMP_LE; REAL_LE_REFL] `(?i. P i /\ &0 < f i /\ (!j. P j /\ ~(j = i) ==> f j = &0)) ==> (!j. P j ==> &0 <= f j) /\ (?j. P j /\ &0 < f j)`) THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; IN_NUMSEG; REAL_NEG_0] THEN REWRITE_TAC[REAL_ARITH `a - (a + e):real = --e`; REAL_ARITH `a - (a - e):real = e`; REAL_NEG_NEG] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REWRITE_TAC[REAL_ARITH `&0 < a * --b <=> &0 < --a * b`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_NEG_GT0] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Existence of eigenvectors. The proof is only in this file because it uses *) (* a few simple results about continuous functions (at least *) (* CONTINUOUS_ON_LIFT_DOT2, CONTINUOUS_ATTAINS_SUP and CLOSED_SUBSPACE). *) (* ------------------------------------------------------------------------- *) let SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE = prove (`!f:real^N->real^N s. linear f /\ adjoint f = f /\ subspace s /\ ~(s = {vec 0}) /\ (!x. x IN s ==> f x IN s) ==> ?v c. v IN s /\ norm(v) = &1 /\ f(v) = c % v`, let lemma = prove (`!a b. (!x. a * x <= b * x pow 2) ==> &0 <= b ==> a = &0`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(fun t -> MP_TAC(SPEC `&1` t) THEN MP_TAC(SPEC `-- &1` t)) THEN ASM_REAL_ARITH_TAC; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a / &2 / b`) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < b ==> (b * (a / b) pow 2) = a pow 2 / b`] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN REWRITE_TAC[REAL_LT_SQUARE; REAL_ARITH `(a * a) / &2 <= (a / &2) pow 2 <=> ~(&0 < a * a)`]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. (f x) dot x`; `s INTER sphere(vec 0:real^N,&1)`] CONTINUOUS_ATTAINS_SUP) THEN REWRITE_TAC[EXISTS_IN_GSPEC; FORALL_IN_GSPEC; o_DEF] THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT2; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_ID] THEN ASM_SIMP_TAC[COMPACT_SPHERE; CLOSED_INTER_COMPACT; CLOSED_SUBSPACE] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN ASM_SIMP_TAC[SUBSPACE_0; IN_SPHERE_0; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(norm x) % x:real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_SUB_RZERO; NORM_MUL] THEN ASM_SIMP_TAC[SUBSPACE_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N` THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN ABBREV_TAC `c = (f:real^N->real^N) v dot v` THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]] THEN ABBREV_TAC `p = \x y:real^N. c * (x dot y) - (f x) dot y` THEN SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= p x x` (LABEL_TAC "POSDEF") THENL [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "p" THEN REWRITE_TAC[] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN DISCH_TAC THEN ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO; REAL_SUB_LE; REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(norm x) % x:real^N`) THEN ASM_SIMP_TAC[SUBSPACE_MUL] THEN ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL; REAL_ABS_INV; DOT_RMUL] THEN ASM_SIMP_TAC[REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; DOT_LMUL] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; DOT_POS_LT] THEN REWRITE_TAC[GSYM NORM_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!y:real^N. y IN s ==> !a. p v y * a <= p y y * a pow 2` MP_TAC THENL [REPEAT STRIP_TAC THEN REMOVE_THEN "POSDEF" (MP_TAC o SPEC `v - (&2 * a) % y:real^N`) THEN EXPAND_TAC "p" THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN ASM_SIMP_TAC[LINEAR_SUB; LINEAR_CMUL] THEN REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN SUBGOAL_THEN `f y dot (v:real^N) = f v dot y` SUBST1_TAC THENL [ASM_MESON_TAC[ADJOINT_CLAUSES; DOT_SYM]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REWRITE_TAC[NORM_POW_2] THEN MATCH_MP_TAC(REAL_ARITH `&4 * (z - y) = x ==> &0 <= x ==> y <= z`) THEN REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING; DISCH_THEN(MP_TAC o GEN `y:real^N` o DISCH `(y:real^N) IN s` o MATCH_MP lemma o C MP (ASSUME `(y:real^N) IN s`) o SPEC `y:real^N`) THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "p" THEN REWRITE_TAC[GSYM DOT_LMUL; GSYM DOT_LSUB] THEN DISCH_THEN(MP_TAC o SPEC `c % v - f v:real^N`) THEN ASM_SIMP_TAC[SUBSPACE_MUL; SUBSPACE_SUB; DOT_EQ_0; VECTOR_SUB_EQ]]);; let SELF_ADJOINT_HAS_EIGENVECTOR = prove (`!f:real^N->real^N. linear f /\ adjoint f = f ==> ?v c. norm(v) = &1 /\ f(v) = c % v`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC(SET_RULE `!a. ~(a IN s) ==> ~(UNIV = s)`) THEN EXISTS_TAC `vec 1:real^N` THEN REWRITE_TAC[IN_SING; VEC_EQ; ARITH_EQ]);; let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE = prove (`!f:real^N->real^N s. linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s) ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ independent b /\ span b = s /\ b HAS_SIZE dim s`, let lemma = prove (`!f:real^N->real^N s. linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s) ==> ?b. b SUBSET s /\ b HAS_SIZE dim s /\ pairwise orthogonal b /\ (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_SIMP_TAC[HAS_SIZE_CLAUSES; NOT_IN_EMPTY; PAIRWISE_EMPTY; EMPTY_SUBSET]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DIM_EQ_0]) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE `~(s SUBSET {a}) ==> ~(s = {a})`)) THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N` MP_TAC) THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | y IN s /\ orthogonal v y}`) THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM] THEN MP_TAC(ISPECL [`span {v:real^N}`; `s:real^N->bool`] DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN ASM_REWRITE_TAC[SUBSPACE_SPAN; IN_SING; FORALL_UNWIND_THM2] THEN ANTS_TAC THENL [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN ASM_REWRITE_TAC[DIM_SPAN; DIM_SING; ARITH_RULE `n < n + 1`] THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN REWRITE_TAC[orthogonal] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(f:real^N->real^N) v dot x` THEN CONJ_TAC THENL [ASM_MESON_TAC[ADJOINT_CLAUSES]; ASM_MESON_TAC[DOT_LMUL; REAL_MUL_RZERO]]; DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(v:real^N) INSERT b` THEN ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[PAIRWISE_INSERT] THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE; SUBSET; IN_ELIM_THM]) THEN CONJ_TAC THENL [ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD1] THEN ASM_MESON_TAC[ORTHOGONAL_REFL]; RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN ASM_MESON_TAC[ORTHOGONAL_SYM]]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] lemma) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_SUBSET_SUBSPACE]; MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_REWRITE_TAC[LE_REFL]]]);; let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS = prove (`!f:real^N->real^N. linear f /\ adjoint f = f ==> ?b. pairwise orthogonal b /\ (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ independent b /\ span b = (:real^N) /\ b HAS_SIZE (dimindex(:N))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV; SUBSET_UNIV]);; let EIGENVALUE_LOWERBOUND_DOT = prove (`!A:real^N^N a. transp A = A /\ (!c v. A ** v = c % v /\ ~(v = vec 0) ==> a <= c) ==> !x. a * norm(x) pow 2 <= x dot (A ** x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN ASM_REWRITE_TAC[ADJOINT_MATRIX; MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `b:real^N->bool` ORTHONORMAL_BASIS_EXPAND_DOT) THEN ASM_SIMP_TAC[NORM_POW_2; IN_UNIV] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[INDEPENDENT_IMP_FINITE] THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N`) THEN ONCE_REWRITE_TAC[GSYM DOT_MATRIX_TRANSP_LMUL] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real`)) THEN ASM_REWRITE_TAC[DOT_LMUL; REAL_ARITH `x * c * x:real = c * x * x`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_SQUARE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `norm(v:real^N) = &1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let EIGENVALUE_LOWERBOUND_DOT_EQ = prove (`!A:real^N^N a. transp A = A ==> ((!c v. A ** v = c % v /\ ~(v = vec 0) ==> a <= c) <=> (!x. a * norm(x) pow 2 <= x dot (A ** x)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MATCH_MP_TAC EIGENVALUE_LOWERBOUND_DOT THEN ASM_MESON_TAC[]; MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[DOT_RMUL; GSYM NORM_POW_2] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_POW_2; NORM_EQ_0]]);; (* ------------------------------------------------------------------------- *) (* Diagonalization of symmetric matrix. *) (* ------------------------------------------------------------------------- *) let SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT = prove (`!A:real^N^N. transp A = A ==> ?P d. orthogonal_matrix P /\ transp P ** A ** P = (lambda i j. if i = j then d i else &0)`, let lemma1 = prove (`!A:real^N^N P:real^N^N d. A ** P = P ** (lambda i j. if i = j then d i else &0) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> A ** column i P = d i % column i P`, SIMP_TAC[CART_EQ; matrix_mul; matrix_vector_mul; LAMBDA_BETA; column; VECTOR_MUL_COMPONENT] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[REAL_MUL_SYM]) in let lemma2 = prove (`!A:real^N^N P:real^N^N d. orthogonal_matrix P /\ transp P ** A ** P = (lambda i j. if i = j then d i else &0) <=> orthogonal_matrix P /\ !i. 1 <= i /\ i <= dimindex(:N) ==> A ** column i P = d i % column i P`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM lemma1; orthogonal_matrix] THEN ABBREV_TAC `D:real^N^N = lambda i j. if i = j then d i else &0` THEN MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]) in REPEAT STRIP_TAC THEN REWRITE_TAC[lemma2] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN ASM_SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR; MATRIX_OF_MATRIX_VECTOR_MUL] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ASM_REWRITE_TAC[IN_NUMSEG; TAUT `p /\ q /\ x = y ==> a = b <=> p /\ q /\ ~(a = b) ==> ~(x = y)`] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[PAIRWISE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[pairwise; IN_NUMSEG] THEN STRIP_TAC THEN EXISTS_TAC `transp(lambda i. f i):real^N^N` THEN SIMP_TAC[COLUMN_TRANSP; ORTHOGONAL_MATRIX_TRANSP] THEN SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; row] THEN SIMP_TAC[LAMBDA_ETA; LAMBDA_BETA; pairwise; IN_NUMSEG] THEN ASM_MESON_TAC[]);; let SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE = prove (`!A:real^N^N. transp A = A ==> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[diagonal_matrix; LAMBDA_BETA]);; let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE = prove (`!A:real^N^N. transp A = A <=> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE] THEN REWRITE_TAC[orthogonal_matrix] THEN DISCH_THEN(X_CHOOSE_THEN `P:real^N^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `D:real^N^N = transp P ** (A:real^N^N) ** P` THEN SUBGOAL_THEN `A:real^N^N = P ** (D:real^N^N) ** transp P` SUBST1_TAC THENL [EXPAND_TAC "D" THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]; REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC] THEN ASM_MESON_TAC[TRANSP_DIAGONAL_MATRIX]]);; let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT = prove (`!A:real^N^N. transp A = A <=> ?P D. orthogonal_matrix P /\ diagonal_matrix D /\ A = transp P ** D ** P`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC(MESON[TRANSP_TRANSP; ORTHOGONAL_MATRIX_TRANSP] `(!P. orthogonal_matrix P ==> (A(transp P) <=> B P)) ==> ((?P. orthogonal_matrix P /\ A P) <=> (?P. orthogonal_matrix P /\ B P))`) THEN X_GEN_TAC `P:real^N^N` THEN DISCH_TAC THEN REWRITE_TAC[TRANSP_TRANSP] THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `(P:real^N^N) ** (A:real^N^N) ** transp P`; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Hence deduce more general results using diagonalization. *) (* ------------------------------------------------------------------------- *) let TRACE_MATRIX_INV_LMUL = prove (`!A:real^N^M. trace(matrix_inv A ** A) = &(rank A)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM RANK_MATRIX_INV_LMUL] THEN SUBGOAL_THEN `(matrix_inv(A:real^N^M) ** A) ** (matrix_inv A ** A) = matrix_inv A ** A` MP_TAC THENL [REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV_MUL_INNER]; MP_TAC(ISPEC `A:real^N^M` SYMMETRIC_MATRIX_INV_LMUL)] THEN SPEC_TAC(`matrix_inv(A:real^N^M) ** A`,`A:real^N^N`) THEN GEN_TAC THEN REWRITE_TAC[SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_IMP_INVERTIBLE; RANK_SIMILAR; GSYM ORTHOGONAL_MATRIX_INV; TRACE_SIMILAR; INVERTIBLE_MATRIX_INV; GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LCANCEL] THEN ASM_SIMP_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_RCANCEL; ORTHOGONAL_MATRIX_IMP_INVERTIBLE] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_INV; ORTHOGONAL_MATRIX_IMP_INVERTIBLE] THEN REWRITE_TAC[MATRIX_MUL_RID] THEN ASM_SIMP_TAC[DIAGONAL_MATRIX_MUL_EXPLICIT; RANK_DIAGONAL_MATRIX; trace] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; REAL_RING `x * x = x <=> x = &0 \/ x = &1`] THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG; FINITE_RESTRICT] THEN REWRITE_TAC[SUM_RESTRICT_SET] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN ASM_MESON_TAC[]);; let TRACE_MATRIX_INV_RMUL = prove (`!A:real^N^M. trace(A ** matrix_inv A) = &(rank A)`, ONCE_REWRITE_TAC[GSYM TRACE_TRANSP] THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_MATRIX_INV] THEN REWRITE_TAC[TRACE_MATRIX_INV_LMUL; RANK_TRANSP]);; let IDEMPOTENT_MATRIX_TRACE_EQ_RANK = prove (`!A:real^N^N. A ** A = A ==> trace A = &(rank A)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM MATRIX_INV_MUL_INNER] THEN ONCE_REWRITE_TAC[TRACE_MUL_CYCLIC] THEN ASM_REWRITE_TAC[TRACE_MATRIX_INV_LMUL]);; let POSITIVE_SEMIDEFINITE_EIGENVALUES = prove (`!A:real^N^N. positive_semidefinite A <=> transp A = A /\ !c v. A ** v = c % v /\ ~(v = vec 0) ==> &0 <= c`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[positive_semidefinite]; FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N` o CONJUNCT2 o REWRITE_RULE[positive_semidefinite]) THEN ASM_SIMP_TAC[DOT_RMUL; REAL_LE_MUL_EQ; DOT_POS_LT]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC POSITIVE_SEMIDEFINITE_SIMILAR THEN MATCH_MP_TAC POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `transp(P:real^N^N) ** basis i` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_VECTOR_MUL_ASSOC] THEN REWRITE_TAC[MATRIX_MUL_RID; GSYM MATRIX_VECTOR_MUL_RMUL] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN ASM_SIMP_TAC[LAMBDA_BETA; vector_mul; matrix_vector_mul; basis; CART_EQ] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID]; DISCH_THEN(MP_TAC o AP_TERM `(**) P :real^N->real^N`) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; BASIS_NONZERO]]]);; let POSITIVE_DEFINITE_EIGENVALUES = prove (`!A:real^N^N. positive_definite A <=> transp A = A /\ !c v. A ** v = c % v /\ ~(v = vec 0) ==> &0 < c`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[positive_definite]; FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N` o CONJUNCT2 o REWRITE_RULE[positive_definite]) THEN ASM_SIMP_TAC[DOT_RMUL; REAL_LT_MUL_EQ; DOT_POS_LT]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC POSITIVE_DEFINITE_SIMILAR THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_IMP_INVERTIBLE] THEN MATCH_MP_TAC POSITIVE_DEFINITE_DIAGONAL_MATRIX THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `transp(P:real^N^N) ** basis i` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_VECTOR_MUL_ASSOC] THEN REWRITE_TAC[MATRIX_MUL_RID; GSYM MATRIX_VECTOR_MUL_RMUL] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN ASM_SIMP_TAC[LAMBDA_BETA; vector_mul; matrix_vector_mul; basis; CART_EQ] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID]; DISCH_THEN(MP_TAC o AP_TERM `(**) P :real^N->real^N`) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; BASIS_NONZERO]]]);; let POSITIVE_SEMIDEFINITE_COVARIANCE_EQ, POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT = (CONJ_PAIR o prove) (`(!A:real^N^N. positive_semidefinite A <=> ?S:real^N^N. A = transp S ** S) /\ (!A:real^N^N. positive_semidefinite A <=> ?S:real^N^N. positive_semidefinite S /\ A = transp S ** S)`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (q ==> p) /\ (p ==> r) ==> (p <=> q) /\ (p <=> r)`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `S:real^N^N` SUBST1_TAC) THEN REWRITE_TAC[positive_semidefinite; MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_TRANSP; DOT_POS_LE]; ALL_TAC] THEN REWRITE_TAC[positive_semidefinite] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN EXISTS_TAC `transp P ** ((lambda i j. sqrt((D:real^N^N)$i$j)):real^N^N) ** (P:real^N^N)` THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; transp; LAMBDA_BETA] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [diagonal_matrix]) THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> &0 <= (D:real^N^N)$i$j` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `j:num = i` THENL [UNDISCH_TAC `!x:real^N. &0 <= x dot (A ** x)` THEN EXPAND_TAC "A" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_TRANSP] THEN DISCH_THEN(MP_TAC o SPEC `transp(P:real^N^N) ** basis i`) THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_VECTOR_MUL_ASSOC] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LID; MATRIX_MUL_RID] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; DOT_BASIS] THEN ASM_SIMP_TAC[column; LAMBDA_BETA]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [diagonal_matrix]) THEN ASM_MESON_TAC[]]; CONJ_TAC THENL [REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN X_GEN_TAC `x:real^N` THEN SPEC_TAC(`(P:real^N^N) ** (x:real^N)`,`y:real^N`) THEN SIMP_TAC[matrix_vector_mul; dot; LAMBDA_BETA] THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [diagonal_matrix]) THEN DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_CASES_TAC `j:num = i` THEN ASM_SIMP_TAC[SQRT_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_REFL] THEN ONCE_REWRITE_TAC[REAL_ARITH `y * a * y:real = a * y * y`] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_SQUARE; SQRT_POS_LE]; EXPAND_TAC "A" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN AP_TERM_TAC THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN REWRITE_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; column; dot] THEN FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[SQRT_0] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_MUL_LZERO]]]);; let POSITIVE_SEMIDEFINITE_SQRT_EQ = prove (`!A:real^N^N. positive_semidefinite A <=> ?S:real^N^N. positive_semidefinite S /\ A = S ** S`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT] THEN REWRITE_TAC[positive_semidefinite] THEN MESON_TAC[]);; let POSITIVE_SEMIDEFINITE_SQRT = prove (`!A:real^N^N. positive_semidefinite A ==> ?S:real^N^N. A = S ** S`, ONCE_REWRITE_TAC[POSITIVE_SEMIDEFINITE_SQRT_EQ] THEN MESON_TAC[]);; let POSITIVE_DEFINITE_COVARIANCE_EQ = prove (`!A:real^N^N. positive_definite A <=> ?S:real^N^N. invertible S /\ transp S ** S = A`, REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN MESON_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP]);; let POSITIVE_DEFINITE_COVARIANCE_EQ_ALT = prove (`!A:real^N^N. positive_definite A <=> ?S. positive_definite S /\ transp S ** S = A`, GEN_TAC THEN REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT] THEN MESON_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP]);; let DET_POSITIVE_SEMIDEFINITE = prove (`!A:real^N^N. positive_semidefinite A ==> &0 <= det A`, ONCE_REWRITE_TAC[POSITIVE_SEMIDEFINITE_SQRT_EQ] THEN SIMP_TAC[DET_MUL; DET_TRANSP; REAL_LE_SQUARE; LEFT_IMP_EXISTS_THM]);; let DET_POSITIVE_DEFINITE = prove (`!A:real^N^N. positive_definite A ==> &0 < det A`, SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; REAL_LT_LE; DET_POSITIVE_SEMIDEFINITE; INVERTIBLE_DET_NZ]);; let POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY = prove (`!A:real^N^N i j. positive_semidefinite A /\ 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> A$i$j pow 2 <= A$i$i * A$j$j`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP POSITIVE_SEMIDEFINITE_SUBMATRIX_2) THEN DISCH_THEN(MP_TAC o MATCH_MP DET_POSITIVE_SEMIDEFINITE) THEN REWRITE_TAC[DET_2; VECTOR_2] THEN FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[positive_semidefinite] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN SIMP_TAC[CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC`i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[transp; LAMBDA_BETA] THEN REAL_ARITH_TAC);; let TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE = prove (`!A:real^N^N. positive_semidefinite A ==> trace(transp A ** A) <= trace(A) pow 2`, REPEAT STRIP_TAC THEN SIMP_TAC[trace; matrix_mul; LAMBDA_BETA; transp; REAL_POW_2] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY]);; let TRACE_SQUARE_POSITIVE_SEMIDEFINITE_LE = prove (`!A:real^N^N. positive_semidefinite A ==> trace(A ** A) <= trace(A) pow 2`, MESON_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC; TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE]);; let TRACE_MUL_POSITIVE_SEMIDEFINITE_LE = prove (`!A B:real^N^N. positive_semidefinite A /\ positive_semidefinite B ==> trace(A ** B) <= trace(A) * trace(B)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`A:real^N^N`; `B:real^N^N`] TRACE_COVARIANCE_CAUCHY_SCHWARZ) THEN MATCH_MP_TAC(REAL_ARITH `x = y /\ w <= z ==> x <= w ==> y <= z`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[SQRT_POS_LE; TRACE_COVARIANCE_POS_LE] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LSQRT THEN ASM_SIMP_TAC[TRACE_POSITIVE_SEMIDEFINITE] THEN ASM_SIMP_TAC[TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE]);; let POSITIVE_SEMIDEFINITE_ZERO_ROW = prove (`!A:real^N^N i. positive_semidefinite A /\ 1 <= i /\ i <= dimindex(:N) /\ A$i$i = &0 ==> row i A = vec 0`, REPEAT STRIP_TAC THEN SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`A:real^N^N`; `i:num`; `j:num`] POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY) THEN ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LE_POW_2; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN CONV_TAC REAL_RING);; let POSITIVE_SEMIDEFINITE_ZERO_COLUMN = prove (`!A:real^N^N i. positive_semidefinite A /\ 1 <= i /\ i <= dimindex(:N) /\ A$i$i = &0 ==> column i A = vec 0`, REPEAT STRIP_TAC THEN SIMP_TAC[CART_EQ; column; LAMBDA_BETA; VEC_COMPONENT] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN MP_TAC(ISPECL [`A:real^N^N`; `j:num`; `i:num`] POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY) THEN ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_LE_POW_2; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN CONV_TAC REAL_RING);; let POSITIVE_SEMIDEFINITE_TRACE_EQ_0 = prove (`!A:real^N^N. positive_semidefinite A ==> (trace A = &0 <=> A = mat 0)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[TRACE_0] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[MATRIX_EQUAL_ROWS] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [trace]) THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUM_POS_EQ_0_NUMSEG)) THEN ASM_SIMP_TAC[DIAGONAL_POSITIVE_SEMIDEFINITE; ROW_0] THEN ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_ZERO_ROW]);; let COVARIANCE_MATRIX_EQ_SQUARE = prove (`!A:real^N^N. transp A ** A = A ** A <=> transp A = A`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `transp A - A:real^N^N` POSITIVE_SEMIDEFINITE_COVARIANCE) THEN DISCH_THEN(MP_TAC o MATCH_MP POSITIVE_SEMIDEFINITE_TRACE_EQ_0) THEN REWRITE_TAC[COVARIANCE_MATRIX_EQ_0; MATRIX_SUB_EQ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[TRANSP_MATRIX_SUB; TRANSP_TRANSP] THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB] THEN ASM_REWRITE_TAC[MATRIX_SUB_RDISTRIB; MATRIX_SUB_REFL; MATRIX_SUB_RZERO] THEN REWRITE_TAC[TRACE_SUB; REAL_SUB_0] THEN ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRACE_TRANSP]);; let TRACE_MUL_POSITIVE_SEMIDEFINITE,TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0 = (CONJ_PAIR o prove) (`(!A:real^N^N B:real^N^N. positive_semidefinite A /\ positive_semidefinite B ==> &0 <= trace(A ** B)) /\ (!A:real^N^N B:real^N^N. positive_semidefinite A /\ positive_semidefinite B ==> (trace(A ** B) = &0 <=> A ** B = mat 0))`, let lemma = prove (`!A:real^N^N B:real^N^N. trace((transp A ** A) ** (transp B ** B)) = trace(transp(A ** transp B) ** (A ** transp B))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM TRACE_MUL_CYCLIC] THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; GSYM MATRIX_MUL_ASSOC]) in REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN STRIP_TAC THEN SIMP_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`; TRACE_0] THEN ASM_REWRITE_TAC[lemma] THEN SIMP_TAC[POSITIVE_SEMIDEFINITE_TRACE_EQ_0; POSITIVE_SEMIDEFINITE_COVARIANCE; TRACE_POSITIVE_SEMIDEFINITE; COVARIANCE_MATRIX_EQ_0] THEN DISCH_TAC THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_LZERO; MATRIX_MUL_RZERO]);; let TRACE_MUL_POSITIVE_SEMIDEFINITE_DEFINITE_EQ_0 = prove (`!A:real^N^N B:real^N^N. positive_semidefinite A /\ positive_definite B ==> (trace(A ** B) = &0 <=> A = mat 0)`, SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; MATRIX_ENTIRE; TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0]);; let TRACE_MUL_POSITIVE_DEFINITE_SEMIDEFINITE_EQ_0 = prove (`!A:real^N^N B:real^N^N. positive_definite A /\ positive_semidefinite B ==> (trace(A ** B) = &0 <=> B = mat 0)`, SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; MATRIX_ENTIRE; TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0]);; let POSITIVE_SEMIDEFINITE_AND_ORTHOGONAL = prove (`!A:real^N^N. positive_semidefinite A /\ orthogonal_matrix A ==> A = mat 1`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [positive_semidefinite]) THEN REWRITE_TAC[SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `D:real^N^N = mat 1` (fun th -> ASM_MESON_TAC[MATRIX_MUL_LID; orthogonal_matrix; th]) THEN SUBGOAL_THEN `positive_semidefinite(D:real^N^N) /\ orthogonal_matrix D` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o AP_TERM `\X:real^N^N. Q ** X ** transp(Q:real^N^N)`) THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM orthogonal_matrix]) THEN ASM_MESON_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP; POSITIVE_SEMIDEFINITE_SIMILAR; TRANSP_TRANSP]; DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] DIAGONAL_POSITIVE_SEMIDEFINITE)) (MP_TAC o CONJUNCT1 o REWRITE_RULE[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED]))] THEN FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN SIMP_TAC[LAMBDA_BETA; NORM_EQ_SQUARE; row; dot; CART_EQ] THEN REWRITE_TAC[MESON[] `(if i = j then x else y:real) * (if i = j then a else b) = (if j = i then x * a else y * b)`] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_POS; FINITE_NUMSEG] THEN SIMP_TAC[mat; LAMBDA_BETA; IN_NUMSEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SUBGOAL_THEN `!x. x * x = &1 /\ &0 <= x ==> x = &1` (fun th -> MESON_TAC[th]) THEN REWRITE_TAC[REAL_RING `x * x = &1 <=> x = &1 \/ x = -- &1`] THEN REAL_ARITH_TAC);; let POSITIVE_SEMIDEFINITE_INV = prove (`!A:real^N^N. positive_semidefinite(matrix_inv A) <=> positive_semidefinite A`, SUBGOAL_THEN `!A:real^N^N. positive_semidefinite A ==> positive_semidefinite(matrix_inv A)` MP_TAC THENL [GEN_TAC; MESON_TAC[MATRIX_INV_INV]] THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `S:real^N^N` SUBST1_TAC) THEN REWRITE_TAC[MATRIX_INV_COVARIANCE] THEN MESON_TAC[TRANSP_TRANSP]);; let POSITIVE_DEFINITE_INV = prove (`!A:real^N^N. positive_definite(matrix_inv A) <=> positive_definite A`, REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; POSITIVE_SEMIDEFINITE_INV; INVERTIBLE_MATRIX_INV]);; let POSITIVE_DEFINITE_COFACTOR = prove (`!A:real^N^N. positive_definite A ==> positive_definite(cofactor A)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP POSITIVE_DEFINITE_IMP_INVERTIBLE) THEN REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP COFACTOR_MATRIX_INV) THEN MATCH_MP_TAC POSITIVE_DEFINITE_CMUL THEN ASM_SIMP_TAC[POSITIVE_DEFINITE_TRANSP; POSITIVE_DEFINITE_INV] THEN ASM_SIMP_TAC[DET_POSITIVE_DEFINITE]);; let POSITIVE_SEMIDEFINITE_COFACTOR = prove (`!A:real^N^N. positive_semidefinite A ==> positive_semidefinite(cofactor A)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[positive_semidefinite] THEN ASM_SIMP_TAC[GSYM COFACTOR_TRANSP; POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC] THEN X_GEN_TAC `v:real^N` THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO; REAL_LE_REFL] THEN SUBGOAL_THEN `!x. x IN closure(interval(vec 0,vec 1)) ==> lift(v dot (cofactor(A + drop x %% mat 1:real^N^N) ** v)) IN {t | &0 <= drop t}` MP_TAC THENL [MATCH_MP_TAC FORALL_IN_CLOSURE; REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN SIMP_TAC[CLOSURE_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN REWRITE_TAC[DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]] THEN REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN SIMP_TAC[CLOSURE_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN REWRITE_TAC[cofactor; CONTINUOUS_ON_CONST] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN SIMP_TAC[LAMBDA_BETA] THEN MAP_EVERY X_GEN_TAC [`k:num`; `l:num`] THEN STRIP_TAC THEN ASM_CASES_TAC `k:num = i /\ l:num = j` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM_CASES_TAC `k:num = i \/ l:num = j` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_DROP; o_DEF; CONTINUOUS_ON_ID]; REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN MP_TAC (ISPECL [`A:real^N^N`; `x:real`] NEARBY_POSITIVE_DEFINITE_MATRIX) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP POSITIVE_DEFINITE_COFACTOR) THEN ASM_SIMP_TAC[positive_definite; REAL_LT_IMP_LE]]);; let POSITIVE_DEFINITE_COFACTOR_EQ = prove (`!A:real^N^N. positive_definite A <=> positive_definite(cofactor A) /\ &0 < det A`, GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [ASM_SIMP_TAC[COFACTOR_1_GEN; DET_1_GEN; POSITIVE_DEFINITE_ID] THEN ASM_SIMP_TAC[POSITIVE_DEFINITE_1_GEN]; EQ_TAC THEN SIMP_TAC[POSITIVE_DEFINITE_COFACTOR; DET_POSITIVE_DEFINITE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP POSITIVE_DEFINITE_COFACTOR) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN SIMP_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN ASM_SIMP_TAC[COFACTOR_COFACTOR] THEN DISCH_THEN(MP_TAC o SPEC `inv(det(A:real^N^N) pow (dimindex (:N) - 2))` o MATCH_MP(REWRITE_RULE[IMP_CONJ] POSITIVE_DEFINITE_CMUL)) THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; MATRIX_CMUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; MATRIX_CMUL_LID]]);; let POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE = prove (`!A:real^N^N. positive_semidefinite A <=> ?!S. positive_semidefinite S /\ A = transp S ** S`, GEN_TAC THEN EQ_TAC THENL [DISCH_TAC; MESON_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT]] THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN CONJ_TAC THENL [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`S:real^N^N`; `U:real^N^N`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ONCE_REWRITE_TAC[GSYM MATRIX_SUB_EQ] THEN ONCE_REWRITE_TAC[GSYM COVARIANCE_MATRIX_EQ_0] THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB] THEN REWRITE_TAC[TRANSP_MATRIX_SUB; MATRIX_SUB_RDISTRIB] THEN ASM_REWRITE_TAC[MATRIX_SUB_EQ] THEN SUBGOAL_THEN `transp(U:real^N^N) ** (S:real^N^N) = A` ASSUME_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[MATRIX_SUB_REFL] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[MATRIX_SUB_EQ] THEN GEN_REWRITE_TAC BINOP_CONV [GSYM TRANSP_TRANSP] THEN ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ASM_REWRITE_TAC[TRANSP_TRANSP] THEN ASM_MESON_TAC[positive_semidefinite]] THEN SUBGOAL_THEN `transp(S:real^N^N) = S /\ transp(U:real^N^N) = U` MP_TAC THENL [ASM_MESON_TAC[positive_semidefinite]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`O:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`P:real^N^N`; `C:real^N^N`] THEN STRIP_TAC THEN ABBREV_TAC `Q = (P:real^N^N) ** transp(O:real^N^N)` THEN SUBGOAL_THEN `(Q:real^N^N) ** (D ** D) = (C ** C) ** Q` MP_TAC THENL [UNDISCH_TAC `transp(S:real^N^N) ** S = A` THEN UNDISCH_TAC `transp(U:real^N^N) ** U = A` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN REWRITE_TAC[MESON[MATRIX_MUL_ASSOC] `(A ** (Q:real^N^N)) ** (Q':real^N^N) ** C = (A:real^N^N) ** (Q ** Q') ** (C:real^N^N)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN DISCH_THEN(MP_TAC o AP_TERM `\X:real^N^N. (P:real^N^N) ** X ** transp(O:real^N^N)`) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN ASM_SIMP_TAC[TRANSP_DIAGONAL_MATRIX]; TRANS_TAC (TAUT `!q. (p ==> q) /\ (q ==> r) ==> p ==> r`) `(Q:real^N^N) ** (D:real^N^N) = C ** (Q:real^N^N)` THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM (SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX])) THEN SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN REPLICATE_TAC 2 (REWRITE_TAC[MESON[REAL_MUL_LZERO] `(if a = b then x else &0) * y = if b = a then x * y else &0`] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN REWRITE_TAC[MESON[REAL_MUL_RZERO] `u * (if p then x else &0) = if p then u * x else &0`] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun t -> STRIP_TAC THEN MP_TAC t THEN ASM_REWRITE_TAC[]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `j:num` THEN DISCH_THEN(fun t -> STRIP_TAC THEN MP_TAC t THEN ASM_REWRITE_TAC[]) THEN MATCH_MP_TAC(REAL_RING `(c + d = &0 ==> c = &0 /\ d = &0) ==> q * d * d = (c * c) * q ==> q * d = c * q`) THEN MATCH_MP_TAC(REAL_FIELD `&0 <= c /\ &0 <= d ==> c + d = &0 ==> c = &0 /\ d = &0`) THEN CONJ_TAC THEN MATCH_MP_TAC DIAGONAL_POSITIVE_SEMIDEFINITE THEN ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR_EQ; ORTHOGONAL_MATRIX_IMP_INVERTIBLE]; DISCH_TAC THEN ASM_REWRITE_TAC[TRANSP_TRANSP; MATRIX_TRANSP_MUL] THEN ASM_REWRITE_TAC[MESON[MATRIX_MUL_ASSOC] `(A ** (Q:real^N^N)) ** (Q':real^N^N) ** C = (A:real^N^N) ** (Q ** Q') ** (C:real^N^N)`] THEN UNDISCH_THEN `transp(U:real^N^N) ** U = A` (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[TRANSP_TRANSP; MATRIX_TRANSP_MUL] THEN EXPAND_TAC "Q" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]]]);; let POSITIVE_SEMIDEFINITE_SQRT_UNIQUE = prove (`!A:real^N^N. positive_semidefinite A <=> ?!S. positive_semidefinite S /\ A = S ** S`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE] THEN REWRITE_TAC[positive_semidefinite] THEN MESON_TAC[]);; let POSITIVE_SEMIDEFINITE_MUL_EQ = prove (`!A:real^N^N B:real^N^N. positive_semidefinite A /\ positive_semidefinite B ==> (positive_semidefinite(A ** B) <=> A ** B = B ** A)`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `transp(A ** (B:real^N^N)) = A ** B` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[MATRIX_TRANSP_MUL; positive_semidefinite]] THEN EQ_TAC THENL [MESON_TAC[positive_semidefinite]; DISCH_TAC] THEN MP_TAC(ISPEC `A:real^N^N` POSITIVE_SEMIDEFINITE_SQRT_EQ) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `S:real^N^N` THEN STRIP_TAC THEN SUBGOAL_THEN `positive_semidefinite(S ** (B:real^N^N) ** S)` MP_TAC THENL [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR; positive_semidefinite]; ASM_REWRITE_TAC[POSITIVE_SEMIDEFINITE_EIGENVALUES]] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN STRIP_TAC THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ASM_MESON_TAC[SAME_EIGENVALUES_MATRIX_MUL]);; let POSITIVE_SEMIDEFINITE_MUL = prove (`!A:real^N^N B:real^N^N. positive_semidefinite A /\ positive_semidefinite B /\ A ** B = B ** A ==> positive_semidefinite(A ** B)`, SIMP_TAC[POSITIVE_SEMIDEFINITE_MUL_EQ]);; let POSITIVE_DEFINITE_MUL_EQ = prove (`!A:real^N^N B:real^N^N. positive_definite A /\ positive_definite B ==> (positive_definite(A ** B) <=> A ** B = B ** A)`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `transp(A ** (B:real^N^N)) = A ** B` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[MATRIX_TRANSP_MUL; positive_definite]] THEN EQ_TAC THENL [MESON_TAC[positive_definite]; DISCH_TAC] THEN MP_TAC(ISPEC `A:real^N^N` POSITIVE_SEMIDEFINITE_SQRT_EQ) THEN ASM_SIMP_TAC[POSITIVE_DEFINITE_IMP_POSITIVE_SEMIDEFINITE] THEN DISCH_THEN(X_CHOOSE_THEN `S:real^N^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `positive_definite(S ** (B:real^N^N) ** S)` MP_TAC THENL [ASM_MESON_TAC[POSITIVE_DEFINITE_SIMILAR; positive_definite; POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; INVERTIBLE_MATRIX_MUL]; ASM_REWRITE_TAC[POSITIVE_DEFINITE_EIGENVALUES]] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN STRIP_TAC THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ASM_MESON_TAC[SAME_EIGENVALUES_MATRIX_MUL]);; let POSITIVE_DEFINITE_MUL = prove (`!A:real^N^N B:real^N^N. positive_definite A /\ positive_definite B /\ A ** B = B ** A ==> positive_definite(A ** B)`, SIMP_TAC[POSITIVE_DEFINITE_MUL_EQ]);; let COMMUTING_WITH_SQUARE_ROOT_MATRIX = prove (`!A S B:real^N^N. positive_semidefinite S /\ S ** S = A /\ A ** B = B ** A ==> S ** B = B ** S`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `S:real^N^N` SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT) THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM_MESON_TAC[positive_semidefinite]; ALL_TAC] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN UNDISCH_TAC `(A:real^N^N) ** (B:real^N^N) = B ** A` THEN SUBGOAL_THEN `!C. (C:real^N^N) ** (B:real^N^N) = B ** C <=> (Q ** C ** transp(Q:real^N^N)) ** (Q ** B ** transp(Q:real^N^N)) = (Q ** B ** transp(Q:real^N^N)) ** (Q ** C ** transp(Q:real^N^N))` (fun th -> ONCE_REWRITE_TAC[th]) THENL [GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o AP_TERM `\X:real^N^N. Q ** X ** transp(Q:real^N^N)`); DISCH_THEN(MP_TAC o AP_TERM `\X:real^N^N. transp(Q:real^N^N) ** X ** Q`)] THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN REPEAT AP_TERM_TAC THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RID] THEN REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]; ALL_TAC] THEN SUBGOAL_THEN `(Q:real^N^N) ** (S:real^N^N) ** transp Q = D` ASSUME_TAC THENL [EXPAND_TAC "S" THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN REPEAT AP_TERM_TAC THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RID]; ALL_TAC] THEN SUBGOAL_THEN `(Q:real^N^N) ** (A:real^N^N) ** transp Q = (D:real^N^N) ** D` ASSUME_TAC THENL [EXPAND_TAC "A" THEN EXPAND_TAC "D" THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN REPEAT AP_TERM_TAC THEN EXPAND_TAC "S" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_RID]; ALL_TAC] THEN GEN_REWRITE_TAC BINOP_CONV [EQ_SYM_EQ] THEN ASM_SIMP_TAC[COMMUTING_WITH_DIAGONAL_MATRIX; DIAGONAL_MATRIX_MUL] THEN ASM_SIMP_TAC[DIAGONAL_MATRIX_MUL_COMPONENT] THEN REWRITE_TAC[REAL_RING `x * x:real = y * y <=> x = y \/ x = --y`] THEN SUBGOAL_THEN `positive_semidefinite(D:real^N^N)` ASSUME_TAC THENL [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR; TRANSP_TRANSP; ORTHOGONAL_MATRIX_IMP_INVERTIBLE; INVERTIBLE_TRANSP]; ASM_SIMP_TAC[DIAGONAL_POSITIVE_SEMIDEFINITE; REAL_ARITH `&0 <= x /\ &0 <= y ==> (x = y \/ x = --y <=> x = y)`]]);; let POSITIVE_SEMIDEFINITE_MUL_EIGENVALUES = prove (`!A B:real^N^N. positive_semidefinite A /\ positive_semidefinite B ==> !c v. (A ** B) ** v = c % v /\ ~(v = vec 0) ==> &0 <= c`, REPEAT GEN_TAC THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN STRIP_TAC THEN REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[SAME_EIGENVALUES_MATRIX_MUL] THEN ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o BINDER_CONV o RAND_CONV o funpow 4 LAND_CONV) [GSYM TRANSP_TRANSP] THEN ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN REWRITE_TAC[TRANSP_TRANSP; GSYM MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MESON_TAC[POSITIVE_SEMIDEFINITE_EIGENVALUES; POSITIVE_SEMIDEFINITE_COVARIANCE]);; let POSITIVE_SEMIDEFINITE_2_DET = prove (`!A:real^2^2. positive_semidefinite A <=> transp A = A /\ &0 <= A$1$1 /\ &0 <= A$2$2 /\ &0 <= det A`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[DIAGONAL_POSITIVE_SEMIDEFINITE; DIMINDEX_2; ARITH] THEN MESON_TAC[DET_POSITIVE_SEMIDEFINITE; positive_semidefinite]; STRIP_TAC THEN ASM_REWRITE_TAC[positive_semidefinite]] THEN SIMP_TAC[matrix_vector_mul; DOT_2; FORALL_VECTOR_2; VECTOR_2; ARITH; LAMBDA_BETA; DIMINDEX_2; SUM_2] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DET_2]) THEN SUBGOAL_THEN `(A:real^2^2)$2$1 = A$1$2` SUBST1_TAC THENL [ASM_MESON_TAC[TRANSP_COMPONENT]; REWRITE_TAC[REAL_SUB_LE]] THEN ASM_CASES_TAC `(A:real^2^2)$2$2 = &0` THENL [DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x <= a ==> &0 <= x /\ a = &0 ==> x = &0`)) THEN ASM_REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `y * a * y:real = a * y * y`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_SQUARE]; DISCH_TAC] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `(A:real^2^2)$2$2` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_LE] THEN REWRITE_TAC[REAL_ARITH `c * (x * (a * x + b * y) + y * (b * x + c * y)) = (b * x + c * y) pow 2 + (a * c - b pow 2) * x pow 2`] THEN MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN ASM_REAL_ARITH_TAC);; let POSITIVE_SEMIDEFINITE_2 = prove (`!A:real^2^2. positive_semidefinite A <=> A$2$1 = A$1$2 /\ &0 <= A$1$1 /\ &0 <= A$2$2 /\ A$1$2 pow 2 <= A$1$1 * A$2$2`, REPEAT GEN_TAC THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_2_DET; DET_2] THEN SIMP_TAC[CART_EQ; FORALL_2; TRANSP_COMPONENT; DIMINDEX_2] THEN ASM_CASES_TAC `(A:real^2^2)$2$1 = A$1$2` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let POSITIVE_DEFINITE_2_DET = prove (`!A:real^2^2. positive_definite A <=> transp A = A /\ &0 < A$1$1 /\ &0 < A$2$2 /\ &0 < det A`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[DIAGONAL_POSITIVE_DEFINITE; DIMINDEX_2; ARITH] THEN MESON_TAC[DET_POSITIVE_DEFINITE; positive_definite]; STRIP_TAC THEN ASM_SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE]] THEN ASM_REWRITE_TAC[POSITIVE_SEMIDEFINITE_2_DET; INVERTIBLE_DET_NZ] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_LT_IMP_LE]);; let POSITIVE_DEFINITE_2 = prove (`!A:real^2^2. positive_definite A <=> A$2$1 = A$1$2 /\ &0 < A$1$1 /\ &0 < A$2$2 /\ A$1$2 pow 2 < A$1$1 * A$2$2`, REPEAT GEN_TAC THEN REWRITE_TAC[POSITIVE_DEFINITE_2_DET; DET_2] THEN SIMP_TAC[CART_EQ; FORALL_2; TRANSP_COMPONENT; DIMINDEX_2] THEN ASM_CASES_TAC `(A:real^2^2)$2$1 = A$1$2` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_LE_NORM_MATRIX_MUL_DET = prove (`!A B:real^N^N. (!x. norm(A ** x) <= norm(B ** x)) ==> abs(det A) <= abs(det B)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `det(B:real^N^N) = &0` THENL [ASM_REWRITE_TAC[DET_0; REAL_ARITH `abs x <= abs(&0) <=> x = &0`] THEN REWRITE_TAC[GSYM HOMOGENEOUS_LINEAR_EQUATIONS_DET] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM HOMOGENEOUS_LINEAR_EQUATIONS_DET]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[NORM_ARITH `norm(x:real^N) <= &0 <=> x = vec 0`; NORM_0]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ; GSYM REAL_ABS_DIV] THEN REWRITE_TAC[real_div; GSYM DET_MATRIX_INV; GSYM DET_MUL] THEN SUBGOAL_THEN `!x:real^N. norm(((A:real^N^N) ** matrix_inv B) ** x) <= norm(x)` MP_TAC THENL [X_GEN_TAC `x:real^N` THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN TRANS_TAC REAL_LE_TRANS `norm(B ** matrix_inv(B:real^N^N) ** (x:real^N))` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_MUL_RINV] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LID; REAL_LE_REFL]; POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`(A:real^N^N) ** matrix_inv(B:real^N^N)`,`A:real^N^N`)] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ABS_NUM] THEN REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN TRANS_TAC REAL_LE_TRANS `det(transp(A:real^N^N) ** A)` THEN CONJ_TAC THENL [REWRITE_TAC[DET_MUL; DET_TRANSP] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!x. norm(transp A ** (A:real^N^N) ** x) <= norm(x)` MP_TAC THENL [X_GEN_TAC `y:real^N` THEN TRANS_TAC REAL_LE_TRANS `norm((A:real^N^N) ** (y:real^N))` THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`(A:real^N^N) ** (y:real^N)`,`x:real^N`) THEN GEN_TAC THEN ASM_CASES_TAC `transp(A:real^N^N) ** x = vec 0` THEN ASM_REWRITE_TAC[NORM_0; NORM_POS_LE] THEN MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `norm(transp(A:real^N^N) ** x)` THEN ASM_REWRITE_TAC[NORM_POS_LT; NORM_POW_2; GSYM REAL_POW_2] THEN REWRITE_TAC[DOT_MATRIX_TRANSP_LMUL] THEN W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[NORM_POS_LE]; REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; REAL_POW_ONE] THEN MP_TAC(ISPEC `A:real^N^N` POSITIVE_SEMIDEFINITE_COVARIANCE) THEN POP_ASSUM(K ALL_TAC) THEN SPEC_TAC(`transp(A:real^N^N) ** A`,`A:real^N^N`)] THEN GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC) THEN REWRITE_TAC[SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[DET_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = (a * c) * b`] THEN ONCE_REWRITE_TAC[GSYM DET_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[DET_I; REAL_MUL_LID] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= &1 ==> x <= &1`) THEN ASM_SIMP_TAC[DET_DIAGONAL; GSYM PRODUCT_ABS; FINITE_NUMSEG] THEN MATCH_MP_TAC PRODUCT_LE_1 THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG; REAL_ABS_POS] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `transp(Q:real^N^N) ** basis k`) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM orthogonal_matrix]) THEN ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC; NORM_BASIS; ORTHOGONAL_MATRIX_NORM; ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS] THEN MP_TAC(ISPECL [`column k (D:real^N^N)`; `k:num`] COMPONENT_LE_NORM) THEN ASM_SIMP_TAC[column; LAMBDA_BETA] THEN REAL_ARITH_TAC);; let DET_LE_ONORM_POW = prove (`!A:real^N^N. abs(det A) <= onorm(\x. A ** x) pow (dimindex(:N))`, REPEAT GEN_TAC THEN TRANS_TAC REAL_LE_TRANS `abs(det(onorm(\x. (A:real^N^N) ** x) %% mat 1:real^N^N))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_NORM_MATRIX_MUL_DET THEN REWRITE_TAC[MATRIX_VECTOR_LMUL; NORM_MUL; MATRIX_VECTOR_MUL_LID] THEN MP_TAC(ISPEC `\x. (A:real^N^N) ** x` ONORM) THEN SIMP_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR; real_abs; ONORM_POS_LE]; REWRITE_TAC[DET_CMUL; DET_I; REAL_MUL_RID; REAL_LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x <= x`) THEN SIMP_TAC[REAL_POW_LE; ONORM_POS_LE; MATRIX_VECTOR_MUL_LINEAR]]);; let ONORM_INVERSE_DET_LE_ONORM_POW = prove (`!A:real^N^N. invertible A ==> onorm(\x. matrix_inv A ** x) * det A <= onorm(\x. A ** x) pow (dimindex(:N) - 1)`, SUBGOAL_THEN `!A:real^N^N. invertible A /\ transp A = A ==> onorm(\x. matrix_inv A ** x) * det A <= onorm(\x. A ** x) pow (dimindex(:N) - 1)` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `transp(A:real^N^N) ** A`) THEN ASM_REWRITE_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP] THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN ASM_SIMP_TAC[MATRIX_INV_MUL; INVERTIBLE_TRANSP; MATRIX_INV_TRANSP] THEN REWRITE_TAC[ONORM_COVARIANCE_ALT] THEN REWRITE_TAC[ONORM_COVARIANCE; DET_MUL; DET_TRANSP] THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_POW_MUL; REAL_POW_POW] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> abs x <= abs y ==> x <= y`) THEN MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC ONORM_POS_LE THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN UNDISCH_TAC `invertible(A:real^N^N)` THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `onorm(\x. matrix_inv(D:real^N^N) ** x) * det(D)` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THENL [ASM_SIMP_TAC[MATRIX_INV_MUL; INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP; GSYM MATRIX_VECTOR_MUL_ASSOC] THEN MP_TAC(ISPECL [`\x:real^N. matrix_inv(Q:real^N^N) ** x`; `\x:real^N. matrix_inv(D:real^N^N) ** matrix_inv(transp Q:real^N^N) ** x`] ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT) THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION; o_DEF] THEN ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_INV_EQ] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(ISPECL [`\x:real^N. matrix_inv(D:real^N^N) ** x`; `\x:real^N. matrix_inv(transp Q:real^N^N) ** x`] ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT) THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION] THEN ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_INV_EQ; ORTHOGONAL_MATRIX_TRANSP]; REWRITE_TAC[DET_MUL] THEN ONCE_REWRITE_TAC[REAL_ARITH `q' * d * q:real = (q' * q) * d`] THEN ONCE_REWRITE_TAC[GSYM DET_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[DET_I; REAL_MUL_LID]]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `onorm(\x. (D:real^N^N) ** x) pow (dimindex(:N) - 1)` THEN CONJ_TAC THENL [REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `Q:real^N^N` o concl))); MATCH_MP_TAC(REAL_ARITH `y:real = x ==> x <= y`) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN MP_TAC(ISPECL [`\x:real^N. transp(Q:real^N^N) ** x`; `\x:real^N. (D:real^N^N) ** (Q:real^N^N) ** x`] ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT) THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION; o_DEF] THEN ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(ISPECL [`\x:real^N. (D:real^N^N) ** x`; `\x:real^N. (Q:real^N^N) ** x`] ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT) THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION]] THEN ASM_SIMP_TAC[ONORM_DIAGONAL_MATRIX; DET_DIAGONAL; DIAGONAL_MATRIX_INV] THEN MP_TAC(ISPEC `D:real^N^N` INVERTIBLE_DIAGONAL_MATRIX) THEN ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN DISCH_TAC THEN SUBGOAL_THEN `sup {abs((matrix_inv D:real^N^N)$i$i) | i IN 1..dimindex (:N)} = inv (inf {abs(D$i$i) | i IN 1..dimindex (:N)})` SUBST1_TAC THENL [ASM_SIMP_TAC[DIAGONAL_MATRIX_INV_EXPLICIT] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_SUP_LE THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; GSYM REAL_ABS_NZ] THEN ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN MATCH_MP_TAC INF_LE_ELEMENT THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN CONJ_TAC THENL [MESON_TAC[REAL_ABS_POS]; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]; MP_TAC(ISPEC `IMAGE (\i. abs((D:real^N^N)$i$i)) (1..dimindex(:N))` INF_FINITE) THEN SIMP_TAC[SIMPLE_IMAGE; REAL_LE_SUP_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ABS_INV; REAL_LE_REFL]]; REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_LDIV_EQ o snd) THEN SIMP_TAC[SIMPLE_IMAGE; REAL_LT_INF_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; GSYM REAL_ABS_NZ] THEN DISCH_THEN SUBST1_TAC] THEN MP_TAC(ISPEC `IMAGE (\i. abs((D:real^N^N)$i$i)) (1..dimindex(:N))` INF_FINITE) THEN SIMP_TAC[SIMPLE_IMAGE; REAL_LE_SUP_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`\i. (D:real^N^N)$i$i`; `1..dimindex(:N)`; `n:num`] PRODUCT_DELETE) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= a * b ==> x <= b * a`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[GSYM PRODUCT_ABS; REAL_ABS_POS; FINITE_NUMSEG; FINITE_DELETE] THEN SUBGOAL_THEN `dimindex(:N) - 1 = CARD((1..dimindex(:N)) DELETE n)` SUBST1_TAC THENL [ASM_SIMP_TAC[CARD_DELETE; FINITE_NUMSEG; CARD_NUMSEG_1]; SIMP_TAC[GSYM PRODUCT_CONST; FINITE_DELETE; FINITE_NUMSEG]] THEN MATCH_MP_TAC PRODUCT_LE THEN REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_POS] THEN SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; let ONORM_INVERSE_DET_LE_ONORM_POW_ALT = prove (`!f g:real^N->real^N. linear f /\ linear g /\ f o g = I ==> onorm f * det(matrix g) <= onorm g pow (dimindex(:N) - 1)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(g:real^N->real^N) o f = I` ASSUME_TAC THENL [ASM_MESON_TAC[LINEAR_INVERSE_LEFT]; ALL_TAC] THEN MP_TAC(ISPEC `matrix(g:real^N->real^N)` ONORM_INVERSE_DET_LE_ONORM_POW) THEN ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL; MATRIX_INVERTIBLE] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MP_TAC(ISPEC `f:real^N->real^N` MATRIX_VECTOR_MUL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]);; let HADAMARD_INEQUALITY_PSD = prove (`!A:real^N^N. positive_semidefinite A ==> det A <= product(1..dimindex(:N)) (\i. A$i$i)`, SIMP_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`B:real^N^N`; `A:real^N^N`] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN REWRITE_TAC[DET_MUL; DET_TRANSP; REAL_ABS_MUL] THEN TRANS_TAC REAL_LE_TRANS `product(1..dimindex(:N)) (\i. norm(column i (A:real^N^N))) pow 2` THEN REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS; REAL_ABS_ABS] THEN SIMP_TAC[HADAMARD_INEQUALITY_COLUMN; REAL_ARITH `x <= y ==> x <= abs y`] THEN REWRITE_TAC[GSYM PRODUCT_MUL_NUMSEG; REAL_POW_2] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[ROW_MATRIX_MUL; MATRIX_MUL_COMPONENT] THEN REWRITE_TAC[NORM_POW_2; dot; matrix_vector_mul; transp; column] THEN ASM_SIMP_TAC[LAMBDA_BETA]);; let POSITIVE_DEFINITE_NEARBY = prove (`!A:real^N^N. positive_definite A ==> ?e. &0 < e /\ !B. transp B = B /\ onorm(\x. (B - A) ** x) < e ==> positive_definite B`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{c | ?v. ~(v = vec 0) /\ (A:real^N^N) ** v = c % v}` INF_FINITE) THEN REWRITE_TAC[FINITE_EIGENVALUES] THEN ANTS_TAC THENL [MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` SELF_ADJOINT_HAS_EIGENVECTOR) THEN RULE_ASSUM_TAC(REWRITE_RULE[positive_definite]) THEN ASM_REWRITE_TAC[ADJOINT_MATRIX; MATRIX_VECTOR_MUL_LINEAR] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN MATCH_MP_TAC MONO_AND THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ]; ABBREV_TAC `a = inf {c | ?v. ~(v = vec 0) /\ (A:real^N^N) ** v = c % v}` THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN STRIP_TAC] THEN EXISTS_TAC `a:real` THEN CONJ_TAC THENL [ASM_MESON_TAC[POSITIVE_DEFINITE_EIGENVALUES]; ALL_TAC] THEN X_GEN_TAC `B:real^N^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[positive_definite] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `B:real^N^N = (B - A) + A` SUBST1_TAC THENL [REWRITE_TAC[MATRIX_SUB; GSYM MATRIX_ADD_ASSOC; MATRIX_ADD_LNEG] THEN REWRITE_TAC[MATRIX_ADD_RID]; REWRITE_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD]] THEN MATCH_MP_TAC(REAL_ARITH `!b. abs x < b /\ b <= y ==> &0 < x + y`) THEN EXISTS_TAC `a * norm(x:real^N) pow 2` THEN CONJ_TAC THENL [W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ_ABS o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN ONCE_REWRITE_TAC[REAL_ARITH `(a:real) * x pow 2 = x * a * x`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; NORM_POS_LT] THEN TRANS_TAC REAL_LET_TRANS `onorm(\x. (B - A:real^N^N) ** x) * norm(x:real^N)` THEN SIMP_TAC[ONORM; MATRIX_VECTOR_MUL_LINEAR] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT]; MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] EIGENVALUE_LOWERBOUND_DOT) THEN ASM_MESON_TAC[positive_definite]]);; let (POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY, POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY_ALT) = (CONJ_PAIR o prove) (`(!A:real^N^N. positive_definite A <=> ?B:real^N^N. transp B ** A ** B = mat 1) /\ (!A:real^N^N. positive_definite A <=> ?B:real^N^N. invertible B /\ transp B ** A ** B = mat 1)`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (p ==> r) /\ (q ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ONCE_REWRITE_TAC[POSITIVE_DEFINITE_COVARIANCE_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `matrix_inv(B:real^N^N)` THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV; MATRIX_MUL_RID] THEN SIMP_TAC[TRANSP_MATRIX_INV; MATRIX_MUL_ASSOC; INVERTIBLE_MATRIX_INV] THEN ASM_SIMP_TAC[MATRIX_INV; INVERTIBLE_TRANSP; MATRIX_MUL_LID]; DISCH_THEN(CHOOSE_THEN MP_TAC) THEN DISCH_THEN(MP_TAC o AP_TERM `positive_definite:real^N^N->bool`) THEN SIMP_TAC[POSITIVE_DEFINITE_SIMILAR_EQ; POSITIVE_DEFINITE_ID]]);; let POSITIVE_DEFINITE_EVENTUALLY = prove (`!A:real^N^N. transp A = A ==> ?a. !x. a <= x ==> positive_definite(A + x %% mat 1)`, REPEAT STRIP_TAC THEN EXISTS_TAC `onorm(\x. (A:real^N^N) ** x) + &1` THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN ASM_SIMP_TAC[TRANSP_MATRIX_ADD; positive_definite; TRANSP_MATRIX_CMUL; TRANSP_MAT; MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD; MATRIX_VECTOR_LMUL; DOT_RMUL; MATRIX_VECTOR_MUL_LID] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(x) < y ==> &0 < x + y`) THEN W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ_ABS o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN TRANS_TAC REAL_LET_TRANS `norm(x:real^N) * onorm(\y. (A:real^N^N) ** y) * norm(x)` THEN SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE; ONORM; MATRIX_VECTOR_MUL_LINEAR] THEN SIMP_TAC[GSYM NORM_POW_2; REAL_ARITH `(a:real) * x pow 2 = x * a * x`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_RMUL_EQ; NORM_POS_LT] THEN ASM_SIMP_TAC[REAL_ARITH `a + &1 <= x ==> a < x`]);; let POSITIVE_SEMIDEFINITE_HADAMARD_PRODUCT, POSITIVE_DEFINITE_HADAMARD_PRODUCT = (CONJ_PAIR o prove) (`(!A:real^N^N B:real^N^N. positive_semidefinite A /\ positive_semidefinite B ==> positive_semidefinite((lambda i j. A$i$j * B$i$j):real^N^N)) /\ (!A:real^N^N B:real^N^N. positive_definite A /\ positive_definite B ==> positive_definite((lambda i j. A$i$j * B$i$j):real^N^N))`, REPEAT STRIP_TAC THEN (SUBGOAL_THEN `transp(A:real^N^N) = A /\ transp(B:real^N^N) = B` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[positive_semidefinite; positive_definite]; REWRITE_TAC[positive_semidefinite; positive_definite]] THEN CONJ_TAC THENL [SIMP_TAC[CART_EQ; TRANSP_COMPONENT; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN BINOP_TAC THEN ASM_MESON_TAC[TRANSP_COMPONENT]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN ABBREV_TAC `D:real^N^N = (lambda i j. if i = j then (x:real^N)$i else &0)` THEN SUBGOAL_THEN `(?A':real^N^N. transp A' = A' /\ A' ** A' = A) /\ (?B':real^N^N. transp B' = B' /\ B' ** B' = B)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SQRT_EQ; positive_semidefinite; POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE]; ALL_TAC]) THENL [MATCH_MP_TAC REAL_LE_TRANS; MATCH_MP_TAC REAL_LTE_TRANS] THEN EXISTS_TAC `trace(transp(A' ** D ** B') ** ((A':real^N^N) ** D ** (B':real^N^N)))` THEN (CONJ_TAC THENL [ASM_REWRITE_TAC[TRACE_COVARIANCE_POS_LT; TRACE_COVARIANCE_POS_LE]; MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN EXPAND_TAC "D" THEN SIMP_TAC[trace; dot; MATRIX_MUL_COMPONENT; LAMBDA_BETA; TRANSP_COMPONENT; MATRIX_VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN SIMP_TAC[SUM_DELTA] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN SIMP_TAC[SUM_DELTA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(B:real^N^N)$j$i = B$i$j` (fun th -> REWRITE_TAC[th; REAL_MUL_AC]) THEN ASM_MESON_TAC[TRANSP_COMPONENT]]) THEN SUBGOAL_THEN `invertible(A':real^N^N) /\ invertible(B':real^N^N)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[INVERTIBLE_MATRIX_MUL; POSITIVE_DEFINITE_IMP_INVERTIBLE]; ASM_SIMP_TAC[MATRIX_ENTIRE]] THEN EXPAND_TAC "D" THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; MAT_COMPONENT] THEN REWRITE_TAC[MESON[] `(if p then a else z) = (if p then b else z) <=> p ==> a = b`] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN UNDISCH_TAC `~(x:real^N = vec 0)` THEN SIMP_TAC[FORALL_UNWIND_THM1; CART_EQ; VEC_COMPONENT]);; (* ------------------------------------------------------------------------- *) (* Polar decomposition. *) (* ------------------------------------------------------------------------- *) let RIGHT_POLAR_DECOMPOSITION = prove (`!A:real^N^N. ?U:real^N^N P:real^N^N. orthogonal_matrix U /\ positive_semidefinite P /\ U ** P = A`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `transp(A:real^N^N) ** A` SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT) THEN ASM_REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> ((A:real^N^N) ** (transp P ** (basis i:real^N))) dot (A ** (transp P ** basis j)) = (D:real^N^N)$i$j` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `\M:real^N^N. (P:real^N^N) ** M ** transp P`) THEN REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM TRANSP_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; MATRIX_MUL_ASSOC] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN SPEC_TAC(`(A:real^N^N) ** transp(P:real^N^N)`,`B:real^N^N`) THEN ASM_SIMP_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN; LAMBDA_BETA; MATRIX_VECTOR_MUL_BASIS]; ALL_TAC] THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> &0 <= (D:real^N^N)$i$j` ASSUME_TAC THENL [REPEAT GEN_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_MESON_TAC[DOT_POS_LE; diagonal_matrix; REAL_LE_REFL]; ALL_TAC] THEN ABBREV_TAC `b = { inv(sqrt((D:real^N^N)$i$i)) % ((A:real^N^N) ** (transp P ** (basis i:real^N))) |i| i IN 1..dimindex(:N) /\ ~((D:real^N^N)$i$i = &0)}` THEN MP_TAC(ISPECL [`b:real^N->bool`; `(:real^N)`] ORTHONORMAL_EXTENSION) THEN REWRITE_TAC[UNION_UNIV; SPAN_UNIV] THEN MATCH_MP_TAC(TAUT `(p /\ q) /\ (q ==> s ==> r) ==> (p /\ q ==> s) ==> r`) THEN CONJ_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[pairwise; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[ORTHOGONAL_MUL] THEN REPEAT DISJ2_TAC THEN ASM_SIMP_TAC[orthogonal] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[diagonal_matrix]) THEN ASM_MESON_TAC[]; REWRITE_TAC[NORM_EQ_SQUARE; DOT_LMUL; DOT_RMUL; REAL_POS] THEN ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_FIELD `s pow 2 = x /\ ~(x = &0) ==> inv s * inv s * x = &1`) THEN ASM_SIMP_TAC[SQRT_POW2]]; DISCH_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`{i | i IN 1..dimindex(:N) /\ (D:real^N^N)$i$i = &0}`; `c:real^N->bool`] CARD_EQ_BIJECTION) THEN ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN REWRITE_TAC[FINITE_UNION] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [MP_TAC(ISPECL [`(:real^N)`; `b UNION c:real^N->bool`] BASIS_CARD_EQ_DIM) THEN ASM_REWRITE_TAC[SUBSET_UNIV; FINITE_UNION; DIM_UNIV] THEN ANTS_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N`)) THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_SIMP_TAC[CARD_UNION; GSYM DISJOINT] THEN MATCH_MP_TAC(ARITH_RULE `s + b:num = n ==> c + b = n ==> s = c`)] THEN SUBGOAL_THEN `CARD(b:real^N->bool) = CARD {i | i IN 1..dimindex(:N) /\ ~((D:real^N^N)$i$i = &0)}` SUBST1_TAC THENL [EXPAND_TAC "b" THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[IMAGE_ID; CARD_IMAGE_EQ_INJ; FINITE_RESTRICT; FINITE_NUMSEG] THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[ORTHOGONAL_REFL] `orthogonal x y /\ ~(x = vec 0) ==> ~(x:real^N = y)`) THEN CONJ_TAC THENL [REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM_SIMP_TAC[orthogonal] THEN ASM_MESON_TAC[diagonal_matrix]; DISCH_TAC THEN UNDISCH_TAC `!x:real^N. x IN b ==> norm x = &1` THEN EXPAND_TAC "b" THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[IN_NUMSEG; NORM_0] THEN REAL_ARITH_TAC]; GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC CARD_UNION_EQ THEN REWRITE_TAC[FINITE_NUMSEG] THEN SET_TAC[]]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN REWRITE_TAC[IN_NUMSEG; RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[TAUT `p ==> q ==> r ==> s <=> p /\ q /\ r ==> s`] THEN REWRITE_TAC[INJECTIVE_ON_ALT]] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `U:real^N^N = lambda i. if (D:real^N^N)$i$i = &0 then f i else inv(sqrt(D$i$i)) % (A ** transp(P:real^N^N) ** basis i)` THEN MAP_EVERY EXISTS_TAC [`transp(U:real^N^N) ** P:real^N^N`; `transp(P:real^N^N) ** (lambda i j. sqrt((D:real^N^N)$j$i)) ** P`] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC ORTHOGONAL_MATRIX_MUL THEN ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP] THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS] THEN EXPAND_TAC "U" THEN SIMP_TAC[LAMBDA_BETA; row; LAMBDA_ETA] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THENL [STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; REWRITE_TAC[NORM_MUL; REAL_ABS_INV]] THEN MATCH_MP_TAC(REAL_FIELD `~(x = &0) /\ y = x ==> inv x * y = &1`) THEN ASM_REWRITE_TAC[REAL_ABS_ZERO; SQRT_EQ_0] THEN ASM_SIMP_TAC[real_abs; SQRT_POS_LE] THEN ASM_SIMP_TAC[NORM_EQ_SQUARE; SQRT_POW_2; SQRT_POS_LE]; X_GEN_TAC `j:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN MAP_EVERY ASM_CASES_TAC [`(D:real^N^N)$i$i = &0`; `(D:real^N^N)$j$j = &0`] THEN ASM_SIMP_TAC[IN_UNION] THEN REPEAT(CONJ_TAC THENL [EXPAND_TAC "b" THEN REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[]; ALL_TAC]) THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT b c ==> x IN b /\ y IN c ==> ~(x = y)`)) THEN EXPAND_TAC "b" THEN REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `DISJOINT b c ==> x IN b /\ y IN c ==> ~(y = x)`)) THEN EXPAND_TAC "b" THEN REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[]; MATCH_MP_TAC(MESON[ORTHOGONAL_REFL] `orthogonal x y /\ ~(x = vec 0) ==> ~(x = y)`) THEN CONJ_TAC THENL [REWRITE_TAC[ORTHOGONAL_MUL] THEN REPEAT DISJ2_TAC THEN ASM_SIMP_TAC[orthogonal] THEN ASM_MESON_TAC[diagonal_matrix]; ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; SQRT_EQ_0] THEN ASM_SIMP_TAC[GSYM DOT_EQ_0]]]]; MATCH_MP_TAC POSITIVE_SEMIDEFINITE_SIMILAR THEN MATCH_MP_TAC POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX THEN ASM_SIMP_TAC[SQRT_POS_LE; LAMBDA_BETA] THEN FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN SIMP_TAC[diagonal_matrix; LAMBDA_BETA; SQRT_0]; RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN GEN_REWRITE_TAC LAND_CONV [MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN TRANS_TAC EQ_TRANS `(A:real^N^N) ** transp P ** (P:real^N^N)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[MATRIX_MUL_RID]] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [matrix_mul] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; transp] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND; SQRT_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN EXPAND_TAC "U" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN ASM_SIMP_TAC[transp; SQRT_POW2; REAL_FIELD `~(s = &0) /\ sqrt s pow 2 = s ==> (inv(sqrt s) * x) * sqrt s = x`] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`])) THEN ASM_REWRITE_TAC[DOT_EQ_0; REAL_LE_REFL; MATRIX_VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; transp; SQRT_0; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; REAL_MUL_RZERO]]);; let LEFT_POLAR_DECOMPOSITION = prove (`!A:real^N^N. ?U:real^N^N P:real^N^N. orthogonal_matrix U /\ positive_semidefinite P /\ P ** U = A`, GEN_TAC THEN MP_TAC(ISPEC `transp(A:real^N^N)` RIGHT_POLAR_DECOMPOSITION) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN REWRITE_TAC[TRANSP_TRANSP] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MAP_EVERY EXISTS_TAC [`transp U:real^N^N`; `transp P:real^N^N`] THEN ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP; POSITIVE_SEMIDEFINITE_TRANSP] THEN REWRITE_TAC[MATRIX_TRANSP_MUL]);; let RIGHT_POLAR_DECOMPOSITION_INVERTIBLE = prove (`!A:real^N^N. invertible A <=> ?U:real^N^N P:real^N^N. orthogonal_matrix U /\ positive_definite P /\ U ** P = A`, GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN UNDISCH_TAC `invertible(A:real^N^N)` THEN ASM_SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; INVERTIBLE_MATRIX_MUL]; DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_SIMP_TAC[INVERTIBLE_MATRIX_MUL; ORTHOGONAL_MATRIX_IMP_INVERTIBLE; POSITIVE_DEFINITE_IMP_INVERTIBLE]]);; let LEFT_POLAR_DECOMPOSITION_INVERTIBLE = prove (`!A:real^N^N. invertible A <=> ?U:real^N^N P:real^N^N. orthogonal_matrix U /\ positive_definite P /\ P ** U = A`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INVERTIBLE_TRANSP] THEN REWRITE_TAC[RIGHT_POLAR_DECOMPOSITION_INVERTIBLE] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN REWRITE_TAC[TRANSP_TRANSP] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MAP_EVERY EXISTS_TAC [`transp U:real^N^N`; `transp P:real^N^N`] THEN ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP; POSITIVE_DEFINITE_TRANSP] THEN REWRITE_TAC[MATRIX_TRANSP_MUL]);; let NORMAL_RIGHT_POLAR_DECOMPOSITION = prove (`!A U P:real^N^N. orthogonal_matrix U /\ positive_semidefinite P /\ U ** P = A ==> (transp A ** A = A ** transp A <=> P ** U = U ** P)`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [UNDISCH_TAC `transp A ** A:real^N^N = A ** transp A` THEN EXPAND_TAC "A" THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN EXPAND_TAC "A" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN DISCH_TAC THEN MP_TAC(ISPEC `transp P ** P:real^N^N` POSITIVE_SEMIDEFINITE_SQRT_UNIQUE) THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE; EXISTS_UNIQUE_DEF] THEN DISCH_THEN(MP_TAC o SPECL [`P:real^N^N`; `(U:real^N^N) ** (P:real^N^N) ** transp U`] o CONJUNCT2) THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [th]) THEN ASM_MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_RID]] THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ASM_MESON_TAC[positive_semidefinite]; ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR; TRANSP_TRANSP]; ASM_REWRITE_TAC[] THEN EXPAND_TAC "A" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_TRANSP_MUL] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN ASM_MESON_TAC[positive_semidefinite]]; EXPAND_TAC "A" THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [SYM th]) THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[positive_semidefinite; orthogonal_matrix]) THEN ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_RID]]);; let NORMAL_LEFT_POLAR_DECOMPOSITION = prove (`!A U P:real^N^N. orthogonal_matrix U /\ positive_semidefinite P /\ P ** U = A ==> (transp A ** A = A ** transp A <=> P ** U = U ** P)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`transp A:real^N^N`; `transp U:real^N^N`; `transp P:real^N^N`] NORMAL_RIGHT_POLAR_DECOMPOSITION) THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_TRANSP; POSITIVE_SEMIDEFINITE_TRANSP] THEN ASM_REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; MESON[TRANSP_TRANSP] `transp(A:real^N^N) = transp B <=> A = B`] THEN MESON_TAC[]);; let NORMAL_BIPOLAR_DECOMPOSITION = prove (`!A:real^N^N. transp A ** A = A ** transp A <=> ?U P. orthogonal_matrix U /\ positive_semidefinite P /\ U ** P = A /\ P ** U = A`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[NORMAL_RIGHT_POLAR_DECOMPOSITION; RIGHT_POLAR_DECOMPOSITION]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix; positive_semidefinite]) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]]);; let LEFT_POLAR_DECOMPOSITION_UNIQUE = prove (`!A:real^N^N. ?!P. ?U. orthogonal_matrix U /\ positive_semidefinite P /\ P ** U = A`, GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` LEFT_POLAR_DECOMPOSITION) THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MAP_EVERY X_GEN_TAC [`S:real^N^N`; `P:real^N^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `U:real^N^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `V:real^N^N` STRIP_ASSUME_TAC)) THEN MP_TAC(ISPEC `transp(transp A) ** transp A:real^N^N` POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE) THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE] THEN REWRITE_TAC[TRANSP_TRANSP; EXISTS_UNIQUE_DEF] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [UNDISCH_THEN `(S:real^N^N) ** (U:real^N^N) = A` (SUBST1_TAC o SYM); UNDISCH_THEN `(P:real^N^N) ** (V:real^N^N) = A` (SUBST1_TAC o SYM)] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC; MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]);; let RIGHT_POLAR_DECOMPOSITION_UNIQUE = prove (`!A:real^N^N. ?!P. ?U. orthogonal_matrix U /\ positive_semidefinite P /\ U ** P = A`, GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MAP_EVERY X_GEN_TAC [`S:real^N^N`; `P:real^N^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `U:real^N^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `V:real^N^N` STRIP_ASSUME_TAC)) THEN MP_TAC(ISPEC `transp(A:real^N^N) ** A:real^N^N` POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE) THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE] THEN REWRITE_TAC[TRANSP_TRANSP; EXISTS_UNIQUE_DEF] THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [UNDISCH_THEN `(U:real^N^N) ** (S:real^N^N) = A` (SUBST1_TAC o SYM); UNDISCH_THEN `(V:real^N^N) ** (P:real^N^N) = A` (SUBST1_TAC o SYM)] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC; MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]);; let LEFT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE = prove (`!A:real^N^N U V P S. invertible A /\ orthogonal_matrix U /\ positive_semidefinite P /\ orthogonal_matrix V /\ positive_semidefinite S /\ P ** U = A /\ S ** V = A ==> P = S /\ U = V`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `P:real^N^N = S` SUBST_ALL_TAC THENL [ASM_MESON_TAC[LEFT_POLAR_DECOMPOSITION_UNIQUE]; REWRITE_TAC[]] THEN ASM_MESON_TAC[MATRIX_MUL_LCANCEL; INVERTIBLE_MATRIX_MUL]);; let RIGHT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE = prove (`!A:real^N^N U V P S. invertible A /\ orthogonal_matrix U /\ positive_semidefinite P /\ orthogonal_matrix V /\ positive_semidefinite S /\ U ** P = A /\ V ** S = A ==> P = S /\ U = V`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `P:real^N^N = S` SUBST_ALL_TAC THENL [ASM_MESON_TAC[RIGHT_POLAR_DECOMPOSITION_UNIQUE]; REWRITE_TAC[]] THEN ASM_MESON_TAC[MATRIX_MUL_RCANCEL; INVERTIBLE_MATRIX_MUL]);; let COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL = prove (`!A B:real^N^N. transp A ** A = transp B ** B <=> ?U. orthogonal_matrix U /\ U ** A = B`, REPEAT GEN_TAC THEN EQ_TAC THENL [MP_TAC(ISPEC `B:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`V:real^N^N`; `Q:real^N^N`] THEN STRIP_TAC THEN MAP_EVERY EXPAND_TAC ["A"; "B"] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN DISCH_TAC THEN MP_TAC(ISPEC `transp(P:real^N^N) ** P` POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE) THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE; EXISTS_UNIQUE_DEF] THEN DISCH_THEN(MP_TAC o SPECL [`P:real^N^N`; `Q:real^N^N`] o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN EXISTS_TAC `(V:real^N^N) ** transp(U:real^N^N)` THEN ASM_MESON_TAC[orthogonal_matrix; ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP; MATRIX_MUL_ASSOC; MATRIX_MUL_RID]; REWRITE_TAC[orthogonal_matrix] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ASM_MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_RID]]);; let COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL_ALT = prove (`!A B:real^N^N. A ** transp A = B ** transp B <=> ?U. orthogonal_matrix U /\ A ** U = B`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`transp A:real^N^N`; `transp B:real^N^N`] COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL) THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRANSP_EQ] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_EQ] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN MESON_TAC[ORTHOGONAL_MATRIX_TRANSP; TRANSP_TRANSP]);; let NORMAL_MATRIX_SIMILAR_TRANSP = prove (`!A:real^N^N. transp A ** A = A ** transp A <=> ?U. orthogonal_matrix U /\ U ** transp A = A`, REWRITE_TAC[GSYM COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL] THEN MESON_TAC[TRANSP_TRANSP]);; let NORMAL_MATRIX_SIMILAR_TRANSP_ALT = prove (`!A:real^N^N. transp A ** A = A ** transp A <=> ?U. orthogonal_matrix U /\ transp A ** U = A`, GEN_TAC THEN MP_TAC(ISPEC `transp A:real^N^N` NORMAL_MATRIX_SIMILAR_TRANSP) THEN REWRITE_TAC[TRANSP_TRANSP] THEN MESON_TAC[ORTHOGONAL_MATRIX_TRANSP; MATRIX_TRANSP_MUL; TRANSP_TRANSP]);; let MATRIX_DIAGONALIZABLE = prove (`!A:real^N^N. ?P D Q. orthogonal_matrix P /\ diagonal_matrix D /\ orthogonal_matrix Q /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= D$i$i) /\ A = P ** D ** Q`, GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`U:real^N^N`; `S:real^N^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MP_TAC(ISPEC `S:real^N^N` SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT) THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC] THEN MAP_EVERY X_GEN_TAC [`V:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN MAP_EVERY EXISTS_TAC [`(U:real^N^N) ** transp(V:real^N^N)`; `D:real^N^N`; `V:real^N^N`] THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP] THEN UNDISCH_TAC `positive_semidefinite(transp(V:real^N^N) ** D ** V)` THEN ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_SIMILAR_EQ; ORTHOGONAL_MATRIX_IMP_INVERTIBLE; POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ]);; (* ------------------------------------------------------------------------- *) (* Infinite sums of vectors. Allow general starting point (and more). *) (* ------------------------------------------------------------------------- *) parse_as_infix("sums",(12,"right"));; let sums = new_definition `(f sums l) s = ((\n. vsum(s INTER (0..n)) f) --> l) sequentially`;; let infsum = new_definition `infsum s f = @l. (f sums l) s`;; let summable = new_definition `summable s f = ?l. (f sums l) s`;; let SUMS_SUMMABLE = prove (`!f l s. (f sums l) s ==> summable s f`, REWRITE_TAC[summable] THEN MESON_TAC[]);; let SUMS_INFSUM = prove (`!f s. (f sums (infsum s f)) s <=> summable s f`, REWRITE_TAC[infsum; summable] THEN MESON_TAC[]);; let SUMS_LIM = prove (`!f:num->real^N s. (f sums lim sequentially (\n. vsum (s INTER (0..n)) f)) s <=> summable s f`, GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL [MESON_TAC[summable]; REWRITE_TAC[summable; sums] THEN STRIP_TAC THEN REWRITE_TAC[lim] THEN ASM_MESON_TAC[]]);; let SERIES_FROM = prove (`!f l k. (f sums l) (from k) = ((\n. vsum(k..n) f) --> l) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);; let SERIES_UNIQUE = prove (`!f:num->real^N l l' s. (f sums l) s /\ (f sums l') s ==> (l = l')`, REWRITE_TAC[sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_UNIQUE]);; let INFSUM_UNIQUE = prove (`!f:num->real^N l s. (f sums l) s ==> infsum s f = l`, MESON_TAC[SERIES_UNIQUE; SUMS_INFSUM; summable]);; let SERIES_TERMS_TOZERO = prove (`!f l n. (f sums l) (from n) ==> (f --> vec 0) sequentially`, REPEAT GEN_TAC THEN SIMP_TAC[sums; LIM_SEQUENTIALLY; FROM_INTER_NUMSEG] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `m - 1` th) THEN MP_TAC(SPEC `m:num` th)) THEN SUBGOAL_THEN `0 < m /\ n <= m` (fun th -> SIMP_TAC[VSUM_CLAUSES_RIGHT; th]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let SERIES_FINITE = prove (`!f s. FINITE s ==> (f sums (vsum s f)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `s INTER (0..m) = s` (fun th -> ASM_REWRITE_TAC[th; DIST_REFL]) THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[LE_TRANS]);; let SERIES_FINITE_EQ = prove (`!f:num->real^N s y. FINITE s ==> ((f sums y) s <=> vsum s f = y)`, MESON_TAC[SERIES_FINITE; SERIES_UNIQUE]);; let SERIES_LINEAR = prove (`!f h l s. (f sums l) s /\ linear h ==> ((\n. h(f n)) sums h l) s`, SIMP_TAC[sums; LIM_LINEAR; FINITE_INTER; FINITE_NUMSEG; GSYM(REWRITE_RULE[o_DEF] LINEAR_VSUM)]);; let SERIES_0 = prove (`!s. ((\n. vec 0) sums (vec 0)) s`, REWRITE_TAC[sums; VSUM_0; LIM_CONST]);; let SERIES_ADD = prove (`!x x0 y y0 s. (x sums x0) s /\ (y sums y0) s ==> ((\n. x n + y n) sums (x0 + y0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_ADD; LIM_ADD]);; let SERIES_SUB = prove (`!x x0 y y0 s. (x sums x0) s /\ (y sums y0) s ==> ((\n. x n - y n) sums (x0 - y0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_SUB; LIM_SUB]);; let SERIES_CMUL = prove (`!x x0 c s. (x sums x0) s ==> ((\n. c % x n) sums (c % x0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_LMUL; LIM_CMUL]);; let SERIES_NEG = prove (`!x x0 s. (x sums x0) s ==> ((\n. --(x n)) sums (--x0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_NEG; LIM_NEG]);; let SUMS_IFF = prove (`!f g k. (!x. x IN k ==> f x = g x) ==> ((f sums l) k <=> (g sums l) k)`, REPEAT STRIP_TAC THEN REWRITE_TAC[sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);; let SUMS_EQ = prove (`!f g k. (!x. x IN k ==> f x = g x) /\ (f sums l) k ==> (g sums l) k`, MESON_TAC[SUMS_IFF]);; let SUMS_0 = prove (`!f:num->real^N s. (!n. n IN s ==> f n = vec 0) ==> (f sums vec 0) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n:num. vec 0:real^N` THEN ASM_SIMP_TAC[SERIES_0]);; let SERIES_FINITE_SUPPORT = prove (`!f:num->real^N s k. FINITE (s INTER k) /\ (!x. x IN k /\ ~(x IN s) ==> f x = vec 0) ==> (f sums vsum (s INTER k) f) k`, REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `vsum (k INTER (0..n)) (f:num->real^N) = vsum(s INTER k) f` (fun th -> ASM_REWRITE_TAC[DIST_REFL; th]) THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[IN_INTER; LE_TRANS]);; let SERIES_COMPONENT = prove (`!f s l:real^N k. (f sums l) s /\ 1 <= k /\ k <= dimindex(:N) ==> ((\i. lift(f(i)$k)) sums lift(l$k)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[GSYM LIFT_SUM; GSYM VSUM_COMPONENT; FINITE_INTER; FINITE_NUMSEG] THEN ASM_SIMP_TAC[o_DEF; LIM_COMPONENT]);; let SERIES_DIFFS = prove (`!f:num->real^N k. (f --> vec 0) sequentially ==> ((\n. f(n) - f(n + 1)) sums f(k)) (from k)`, REWRITE_TAC[sums; FROM_INTER_NUMSEG; VSUM_DIFFS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (f:num->real^N) k - f(n + 1)` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN SIMP_TAC[]; GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);; let SERIES_TRIVIAL = prove (`!f. (f sums vec 0) {}`, REWRITE_TAC[sums; INTER_EMPTY; VSUM_CLAUSES; LIM_CONST]);; let SERIES_RESTRICT = prove (`!f k l:real^N. ((\n. if n IN k then f(n) else vec 0) sums l) (:num) <=> (f sums l) k`, REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] `vsum s f = vsum t f /\ vsum t f = vsum t g ==> vsum s f = vsum t g`) THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN SET_TAC[]; MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_INTER]]);; let SERIES_VSUM = prove (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = vec 0) /\ vsum s f = l ==> (f sums l) k`, REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL [ASM SET_TAC []; ASM_MESON_TAC [SERIES_FINITE_SUPPORT]]);; let SUMS_REINDEX = prove (`!k a l:real^N n. ((\x. a(x + k)) sums l) (from n) <=> (a sums l) (from(n + k))`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM VSUM_OFFSET] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`; ARITH_RULE `N + k:num <= n ==> N <= n + k`]);; let SUMS_REINDEX_GEN = prove (`!k a l:real^N s. ((\x. a(x + k)) sums l) s <=> (a sums l) (IMAGE (\i. i + k) s)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN MP_TAC(ISPECL [`k:num`; `\i. if i IN IMAGE (\i. i + k) s then (a:num->real^N) i else vec 0`; `l:real^N`; `0`] SUMS_REINDEX) THEN REWRITE_TAC[FROM_0] THEN SIMP_TAC[EQ_ADD_RCANCEL; SET_RULE `(!x y:num. x + k = y + k <=> x = y) ==> ((x + k) IN IMAGE (\i. i + k) s <=> x IN s)`] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; IN_FROM; ADD_CLAUSES] THEN SUBGOAL_THEN `!x:num. x IN IMAGE (\i. i + k) s ==> k <= x` MP_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE] THEN ARITH_TAC; SET_TAC[]]);; let SERIES_EVEN = prove (`!f l:real^N n. (f sums l) (from n) <=> ((\i. if EVEN i then f(i DIV 2) else vec 0) sums l) (from (2 * n))`, let lemma = prove (`vsum(2 * m..n) (\i. if EVEN i then f i else vec 0):real^N = vsum(m..n DIV 2) (\i. f(2 * i))`, TRANS_TAC EQ_TRANS `vsum (2 * m..2 * (n DIV 2) + 1) (\i. if EVEN i then f i else vec 0):real^N` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[VSUM_PAIR] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN; VECTOR_ADD_RID]] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET_NUMSEG] THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN SUBGOAL_THEN `p = 2 * n DIV 2 + 1` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN]) in REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_FROM; lemma] THEN REWRITE_TAC[ARITH_RULE `(2 * i) DIV 2 = i`; ETA_AX] THEN REWRITE_TAC[tendsto] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN ABBREV_TAC `P m <=> dist(vsum (n..m) f:real^N,l) < e` THEN POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `2 * N` THEN ASM_SIMP_TAC[GSYM LE_RDIV_EQ; ARITH_EQ] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `2 * n`) THEN REWRITE_TAC[ARITH_RULE `(2 * n) DIV 2 = n`] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC);; let SERIES_ODD = prove (`!f l:real^N n. (f sums l) (from n) <=> ((\i. if ODD i then f(i DIV 2) else vec 0) sums l) (from (2 * n + 1))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SERIES_EVEN] THEN REWRITE_TAC[GSYM SUMS_REINDEX] THEN REWRITE_TAC[ODD_ADD; ARITH_ODD; NOT_ODD] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[ARITH_RULE `(2 * m + 1) DIV 2 = m`] THEN REWRITE_TAC[ARITH_RULE `(2 * m) DIV 2 = m`]);; (* ------------------------------------------------------------------------- *) (* Similar combining theorems just for summability. *) (* ------------------------------------------------------------------------- *) let SUMMABLE_LINEAR = prove (`!f h s. summable s f /\ linear h ==> summable s (\n. h(f n))`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_LINEAR]);; let SUMMABLE_0 = prove (`!s. summable s (\n. vec 0)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_0]);; let SUMMABLE_ADD = prove (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n + y n)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_ADD]);; let SUMMABLE_SUB = prove (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n - y n)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUB]);; let SUMMABLE_CMUL = prove (`!s x c. summable s x ==> summable s (\n. c % x n)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_CMUL]);; let SUMMABLE_NEG = prove (`!x s. summable s x ==> summable s (\n. --(x n))`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_NEG]);; let SUMMABLE_IFF = prove (`!f g k. (!x. x IN k ==> f x = g x) ==> (summable k f <=> summable k g)`, REWRITE_TAC[summable] THEN MESON_TAC[SUMS_IFF]);; let SUMMABLE_EQ = prove (`!f g k. (!x. x IN k ==> f x = g x) /\ summable k f ==> summable k g`, REWRITE_TAC[summable] THEN MESON_TAC[SUMS_EQ]);; let SUMMABLE_COMPONENT = prove (`!f:num->real^N s k. summable s f /\ 1 <= k /\ k <= dimindex(:N) ==> summable s (\i. lift(f(i)$k))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^N` o REWRITE_RULE[summable]) THEN REWRITE_TAC[summable] THEN EXISTS_TAC `lift((l:real^N)$k)` THEN ASM_SIMP_TAC[SERIES_COMPONENT]);; let SERIES_SUBSET = prove (`!x s t l. s SUBSET t /\ ((\i. if i IN s then x i else vec 0) sums l) t ==> (x sums l) s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[sums] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let SUMMABLE_SUBSET = prove (`!x s t. s SUBSET t /\ summable t (\i. if i IN s then x i else vec 0) ==> summable s x`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUBSET]);; let SUMMABLE_TRIVIAL = prove (`!f:num->real^N. summable {} f`, GEN_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[SERIES_TRIVIAL]);; let SUMMABLE_RESTRICT = prove (`!f:num->real^N k. summable (:num) (\n. if n IN k then f(n) else vec 0) <=> summable k f`, REWRITE_TAC[summable; SERIES_RESTRICT]);; let SUMS_FINITE_DIFF = prove (`!f:num->real^N t s l. t SUBSET s /\ FINITE t /\ (f sums l) s ==> (f sums (l - vsum t f)) (s DIFF t)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let SUMS_FINITE_UNION = prove (`!f:num->real^N s t l. FINITE t /\ (f sums l) s ==> (f sums (l + vsum (t DIFF s) f)) (s UNION t)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN DISCH_THEN(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF; IN_UNION] THEN MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let SUMS_OFFSET = prove (`!f l:real^N m n. (f sums l) (from m) /\ 0 < n /\ m <= n ==> (f sums l - vsum (m..n - 1) f) (from n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC; MATCH_MP_TAC SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);; let SUMS_OFFSET_REV = prove (`!f:num->real^N l m n. (f sums l) (from m) /\ 0 < m /\ n <= m ==> (f sums (l + vsum(n..m-1) f)) (from n)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `from m`; `n..m-1`; `l:real^N`] SUMS_FINITE_UNION) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN ASM_ARITH_TAC);; let SUMMABLE_REINDEX = prove (`!k a n. summable (from n) (\x. a (x + k)) <=> summable (from(n + k)) a`, REWRITE_TAC[summable; GSYM SUMS_REINDEX]);; let SUMMABLE_EVEN = prove (`!f:num->real^N n. summable (from n) f <=> summable (from (2 * n)) (\i. if EVEN i then f(i DIV 2) else vec 0)`, REWRITE_TAC[summable; GSYM SERIES_EVEN]);; let SUMMABLE_ODD = prove (`!f:num->real^N n. summable (from n) f <=> summable (from (2 * n + 1)) (\i. if ODD i then f(i DIV 2) else vec 0)`, REWRITE_TAC[summable; GSYM SERIES_ODD]);; let SERIES_DROP_LE = prove (`!f g s a b. (f sums a) s /\ (g sums b) s /\ (!x. x IN s ==> drop(f x) <= drop(g x)) ==> drop a <= drop b`, REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^1)` THEN EXISTS_TAC `\n. vsum (s INTER (0..n)) (g:num->real^1)` THEN ASM_REWRITE_TAC[DROP_VSUM] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; o_THM; IN_INTER; IN_NUMSEG]);; let SERIES_DROP_POS = prove (`!f s a. (f sums a) s /\ (!x. x IN s ==> &0 <= drop(f x)) ==> &0 <= drop a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\n. vec 0):num->real^1`; `f:num->real^1`; `s:num->bool`; `vec 0:real^1`; `a:real^1`] SERIES_DROP_LE) THEN ASM_SIMP_TAC[SUMS_0; DROP_VEC]);; let SERIES_BOUND = prove (`!f:num->real^N g s a b. (f sums a) s /\ ((lift o g) sums (lift b)) s /\ (!i. i IN s ==> norm(f i) <= g i) ==> norm(a) <= b`, REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^N)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..m)) g` THEN CONJ_TAC THEN ASM_SIMP_TAC[VSUM_NORM_LE; IN_INTER; FINITE_NUMSEG; FINITE_INTER] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM sums]) THEN UNDISCH_TAC `((lift o g) sums lift b) s` THEN GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN REWRITE_TAC[GSYM FROM_0] THEN DISCH_THEN(MP_TAC o SPEC `m + 1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `0 < m + 1`; o_DEF; ADD_SUB] THEN REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN REWRITE_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SERIES_DROP_POS)) THEN REWRITE_TAC[DROP_SUB; LIFT_DROP; ONCE_REWRITE_RULE[INTER_COMM] (GSYM INTER); REAL_SUB_LE] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_REFL] THEN ASM_MESON_TAC[NORM_ARITH `norm(x:real^N) <= y ==> &0 <= y`]);; (* ------------------------------------------------------------------------- *) (* Similar combining theorems for infsum. *) (* ------------------------------------------------------------------------- *) let INFSUM_LINEAR = prove (`!f h s. summable s f /\ linear h ==> infsum s (\n. h(f n)) = h(infsum s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_0 = prove (`infsum s (\i. vec 0) = vec 0`, MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[SERIES_0]);; let INFSUM_ADD = prove (`!x y s. summable s x /\ summable s y ==> infsum s (\i. x i + y i) = infsum s x + infsum s y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_ADD THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_SUB = prove (`!x y s. summable s x /\ summable s y ==> infsum s (\i. x i - y i) = infsum s x - infsum s y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_SUB THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_CMUL = prove (`!s x c. summable s x ==> infsum s (\n. c % x n) = c % infsum s x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_NEG = prove (`!s x. summable s x ==> infsum s (\n. --(x n)) = --(infsum s x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_NEG THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_EQ = prove (`!f g k. summable k f /\ summable k g /\ (!x. x IN k ==> f x = g x) ==> infsum k f = infsum k g`, REPEAT STRIP_TAC THEN REWRITE_TAC[infsum] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[SUMS_EQ; SUMS_INFSUM]);; let INFSUM_RESTRICT = prove (`!k a:num->real^N. infsum (:num) (\n. if n IN k then a n else vec 0) = infsum k a`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`a:num->real^N`; `k:num->bool`] SUMMABLE_RESTRICT) THEN ASM_CASES_TAC `summable k (a:num->real^N)` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [MATCH_MP_TAC INFSUM_UNIQUE THEN ASM_REWRITE_TAC[SERIES_RESTRICT; SUMS_INFSUM]; RULE_ASSUM_TAC(REWRITE_RULE[summable; NOT_EXISTS_THM]) THEN ASM_REWRITE_TAC[infsum]]);; let PARTIAL_SUMS_COMPONENT_LE_INFSUM = prove (`!f:num->real^N s k n. 1 <= k /\ k <= dimindex(:N) /\ (!i. i IN s ==> &0 <= (f i)$k) /\ summable s f ==> (vsum (s INTER (0..n)) f)$k <= (infsum s f)$k`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `vsum (s INTER (0..n)) (f:num->real^N)$k - (infsum s f)$k`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N + n:num`)) THEN REWRITE_TAC[LE_ADD; REAL_NOT_LT; dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((vsum (s INTER (0..N + n)) f - infsum s f:real^N)$k)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH `s < a /\ a <= b ==> a - s <= abs(b - s)`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN SIMP_TAC[NUMSEG_ADD_SPLIT; LE_0; UNION_OVER_INTER] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhand o rand o snd) THEN ANTS_TAC THENL [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; DISJOINT; EXTENSION] THEN REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LE_ADDR; VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[VSUM_COMPONENT] THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);; let PARTIAL_SUMS_DROP_LE_INFSUM = prove (`!f s n. (!i. i IN s ==> &0 <= drop(f i)) /\ summable s f ==> drop(vsum (s INTER (0..n)) f) <= drop(infsum s f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC PARTIAL_SUMS_COMPONENT_LE_INFSUM THEN ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL; GSYM drop]);; let INFSUM_EVEN = prove (`!f:num->real^N n. infsum (from n) f = infsum (from (2 * n)) (\i. if EVEN i then f(i DIV 2) else vec 0)`, REWRITE_TAC[infsum; GSYM SERIES_EVEN]);; let INFSUM_ODD = prove (`!f:num->real^N n. infsum (from n) f = infsum (from (2 * n + 1)) (\i. if ODD i then f(i DIV 2) else vec 0)`, REWRITE_TAC[infsum; GSYM SERIES_ODD]);; (* ------------------------------------------------------------------------- *) (* Cauchy criterion for series. *) (* ------------------------------------------------------------------------- *) let SEQUENCE_CAUCHY_WLOG = prove (`!P s. (!m n:num. P m /\ P n ==> dist(s m,s n) < e) <=> (!m n. P m /\ P n /\ m <= n ==> dist(s m,s n) < e)`, MESON_TAC[DIST_SYM; LE_CASES]);; let VSUM_DIFF_LEMMA = prove (`!f:num->real^N k m n. m <= n ==> vsum(k INTER (0..n)) f - vsum(k INTER (0..m)) f = vsum(k INTER (m+1..n)) f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `k INTER (0..n)`; `k INTER (0..m)`] VSUM_DIFF) THEN ANTS_TAC THENL [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC (SET_RULE `s SUBSET t ==> (u INTER s SUBSET u INTER t)`) THEN REWRITE_TAC[SUBSET; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `(k INTER s) DIFF (k INTER t) = k INTER (s DIFF t)`] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC]);; let NORM_VSUM_TRIVIAL_LEMMA = prove (`!e. &0 < e ==> (P ==> norm(vsum(s INTER (m..n)) f) < e <=> P ==> n < m \/ norm(vsum(s INTER (m..n)) f) < e)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n:num < m` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [GSYM NUMSEG_EMPTY]) THEN ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0; INTER_EMPTY]);; let SERIES_CAUCHY = prove (`!f s. (?l. (f sums l) s) = !e. &0 < e ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; CONVERGENT_EQ_CAUCHY; cauchy] THEN REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN REWRITE_TAC[NOT_LT; ARITH_RULE `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> N + 1 <= m + 1 /\ m + 1 <= n`] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN ASM_ARITH_TAC);; let SUMMABLE_CAUCHY = prove (`!f s. summable s f <=> !e. &0 < e ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`, REWRITE_TAC[summable; GSYM SERIES_CAUCHY]);; let SUMMABLE_IFF_EVENTUALLY = prove (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) ==> (summable k f <=> summable k g)`, REWRITE_TAC[summable; SERIES_CAUCHY] THEN REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (fun th -> EXISTS_TAC `N0 + N1:num` THEN MP_TAC th)) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER; IN_NUMSEG] THEN REPEAT STRIP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let SUMMABLE_EQ_EVENTUALLY = prove (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ summable k f ==> summable k g`, MESON_TAC[SUMMABLE_IFF_EVENTUALLY]);; let SUMMABLE_IFF_COFINITE = prove (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) ==> (summable s f <=> summable t f)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUMMABLE_RESTRICT] THEN MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:num.x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN REWRITE_TAC[ARITH_RULE `N + 1 <= n <=> ~(n <= N)`] THEN ASM SET_TAC[]);; let SUMMABLE_EQ_COFINITE = prove (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ summable s f ==> summable t f`, MESON_TAC[SUMMABLE_IFF_COFINITE]);; let SUMMABLE_FROM_ELSEWHERE = prove (`!f m n. summable (from m) f ==> summable (from n) f`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ_COFINITE) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN ARITH_TAC);; let SUMMABLE_FROM_ELSEWHERE_EQ = prove (`!n m f:num->real^N. summable (from m) f <=> summable (from n) f`, MESON_TAC[SUMMABLE_FROM_ELSEWHERE]);; (* ------------------------------------------------------------------------- *) (* Uniform vesion of Cauchy criterion. *) (* ------------------------------------------------------------------------- *) let SERIES_CAUCHY_UNIFORM = prove (`!P f:A->num->real^N k. (?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(vsum(k INTER (0..n)) (f x), l x) < e) <=> (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x ==> norm(vsum(k INTER (m..n)) (f x)) < e)`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; UNIFORMLY_CONVERGENT_EQ_CAUCHY; cauchy] THEN ONCE_REWRITE_TAC[MESON[] `(!m n:num y. N <= m /\ N <= n /\ P y ==> Q m n y) <=> (!y. P y ==> !m n. N <= m /\ N <= n ==> Q m n y)`] THEN REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN REWRITE_TAC[NOT_LT; ARITH_RULE `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> N + 1 <= m + 1 /\ m + 1 <= n`] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* So trivially, terms of a convergent series go to zero. *) (* ------------------------------------------------------------------------- *) let SERIES_GOESTOZERO = prove (`!s x. summable s x ==> !e. &0 < e ==> eventually (\n. n IN s ==> norm(x n) < e) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[summable; SERIES_CAUCHY] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`]) THEN ASM_SIMP_TAC[NUMSEG_SING; GE; SET_RULE `n IN s ==> s INTER {n} = {n}`] THEN REWRITE_TAC[VSUM_SING]);; let SUMMABLE_IMP_TOZERO = prove (`!f:num->real^N k. summable k f ==> ((\n. if n IN k then f(n) else vec 0) --> vec 0) sequentially`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUMMABLE_RESTRICT] THEN REWRITE_TAC[summable; LIM_SEQUENTIALLY; INTER_UNIV; sums] THEN DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `n - 1` th) THEN MP_TAC(SPEC `n:num` th)) THEN ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> N <= n /\ N <= n - 1`] THEN ABBREV_TAC `m = n - 1` THEN SUBGOAL_THEN `n = SUC m` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC NORM_ARITH);; let SUMMABLE_IMP_BOUNDED = prove (`!f:num->real^N k. summable k f ==> bounded (IMAGE f k)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_IMP_LE; NORM_0]);; let SUMMABLE_IMP_SUMS_BOUNDED = prove (`!f:num->real^N k. summable (from k) f ==> bounded { vsum(k..n) f | n IN (:num) }`, REWRITE_TAC[summable; sums; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Comparison test. *) (* ------------------------------------------------------------------------- *) let SERIES_COMPARISON = prove (`!f g s. (?l. ((lift o g) sums l) s) /\ (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) ==> ?l:real^N. (f sums l) s`, REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_CAUCHY] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num /\ m <= x ==> x >= N1`]; ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num ==> m >= N2`]]);; let SUMMABLE_COMPARISON = prove (`!f g s. summable s (lift o g) /\ (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) ==> summable s f`, REWRITE_TAC[summable; SERIES_COMPARISON]);; let SERIES_LIFT_ABSCONV_IMP_CONV = prove (`!x:num->real^N k. summable k (\n. lift(norm(x n))) ==> summable k x`, REWRITE_TAC[summable] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `\n:num. norm(x n:real^N)` THEN ASM_REWRITE_TAC[o_DEF; REAL_LE_REFL] THEN ASM_MESON_TAC[]);; let SUMMABLE_SUBSET_ABSCONV = prove (`!x:num->real^N s t. summable s (\n. lift(norm(x n))) /\ t SUBSET s ==> summable t (\n. lift(norm(x n)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `\n:num. norm(x n:real^N)` THEN ASM_REWRITE_TAC[o_DEF; GSYM summable] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; NORM_LIFT; REAL_ABS_NORM; NORM_0; NORM_POS_LE]);; let SERIES_COMPARISON_BOUND = prove (`!f:num->real^N g s a. (g sums a) s /\ (!i. i IN s ==> norm(f i) <= drop(g i)) ==> ?l. (f sums l) s /\ norm(l) <= drop a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] SUMMABLE_COMPARISON) THEN REWRITE_TAC[o_DEF; LIFT_DROP; GE; ETA_AX; summable] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[FROM_0; INTER_UNIV; sums]) THEN MATCH_MP_TAC SERIES_BOUND THEN MAP_EVERY EXISTS_TAC [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] THEN ASM_REWRITE_TAC[sums; o_DEF; LIFT_DROP; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Uniform version of comparison test. *) (* ------------------------------------------------------------------------- *) let SERIES_COMPARISON_UNIFORM = prove (`!f g P s. (?l. ((lift o g) sums l) s) /\ (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= g n) ==> ?l:A->real^N. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(vsum(s INTER (0..n)) (f x), l x) < e`, REPEAT GEN_TAC THEN SIMP_TAC[GE; SERIES_CAUCHY; SERIES_CAUCHY_UNIFORM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`]; ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);; (* ------------------------------------------------------------------------- *) (* Ratio test. *) (* ------------------------------------------------------------------------- *) let SERIES_RATIO = prove (`!c a s N. c < &1 /\ (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n))) ==> ?l:real^N. (a sums l) s`, REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON THEN DISJ_CASES_TAC(REAL_ARITH `c <= &0 \/ &0 < c`) THENL [EXISTS_TAC `\n:num. &0` THEN REWRITE_TAC[o_DEF; LIFT_NUM] THEN CONJ_TAC THENL [MESON_TAC[SERIES_0]; ALL_TAC] THEN EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm(a(n - 1):real^N)` THEN CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N + 1 <= n ==> SUC(n - 1) = n /\ N <= n - 1`]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= --c * x ==> c * x <= &0`) THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN UNDISCH_TAC `c <= &0` THEN REAL_ARITH_TAC; ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`))] THEN EXISTS_TAC `\n. norm(a(N):real^N) * c pow (n - N)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; EXISTS_TAC `N:num` THEN SIMP_TAC[GE; LE_EXISTS; IMP_CONJ; ADD_SUB2; LEFT_IMP_EXISTS_THM] THEN SUBGOAL_THEN `!d:num. norm(a(N + d):real^N) <= norm(a N) * c pow d` (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_RID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm((a:num->real^N) (N + d))` THEN ASM_SIMP_TAC[LE_ADD] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]] THEN GEN_REWRITE_TAC I [SERIES_CAUCHY] THEN X_GEN_TAC `e:real` THEN SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER; NORM_LIFT; FINITE_NUMSEG] THEN DISCH_TAC THEN SIMP_TAC[SUM_LMUL; FINITE_INTER; FINITE_NUMSEG] THEN ASM_CASES_TAC `(a:num->real^N) N = vec 0` THENL [ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_ABS_NUM]; ALL_TAC] THEN MP_TAC(SPECL [`c:real`; `((&1 - c) * e) / norm((a:num->real^N) N)`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_SUB_LT; NORM_POS_LT; GE] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `N + M:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(norm((a:num->real^N) N) * sum(m..n) (\i. c pow (i - N)))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN ASM_SIMP_TAC[SUM_POS_LE; FINITE_INTER_NUMSEG; REAL_POW_LE] THEN MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[REAL_POW_LE] THEN REWRITE_TAC[FINITE_INTER_NUMSEG; FINITE_NUMSEG] THEN REWRITE_TAC[IN_INTER; IN_DIFF] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN DISJ_CASES_TAC(ARITH_RULE `n:num < m \/ m <= n`) THENL [ASM_SIMP_TAC[SUM_TRIV_NUMSEG; REAL_ABS_NUM; REAL_MUL_RZERO]; ALL_TAC] THEN SUBGOAL_THEN `m = 0 + m /\ n = (n - m) + m` (CONJUNCTS_THEN SUBST1_TAC) THENL [UNDISCH_TAC `m:num <= n` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SUM_OFFSET] THEN UNDISCH_TAC `N + M:num <= m` THEN SIMP_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `(i + (N + M) + d) - N:num = (M + d) + i`] THEN ONCE_REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[SUM_LMUL; SUM_GP] THEN ASM_SIMP_TAC[LT; REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_POW] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ABS_DIV; REAL_POW_LT; REAL_ARITH `&0 < c /\ c < &1 ==> &0 < abs c /\ &0 < abs(&1 - c)`; REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x <= &1 /\ &1 <= e ==> abs(c pow 0 - x) < e`) THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_1_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_ARITH `c < &1 ==> x * abs(&1 - c) = (&1 - c) * x`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD; REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `(((a * b) * c) * d) * e = (e * ((a * b) * c)) * d`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_MUL_LID; REAL_ARITH `&0 < c ==> abs c = c`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `xm < e ==> &0 <= (d - &1) * e ==> xm <= d * e`)) THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [REWRITE_TAC[REAL_SUB_LE; GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE_1 THEN MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT]]);; let SUMMABLE_RATIO = prove (`!c a:num->real^N s N. c < &1 /\ (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n))) ==> summable s a`, REWRITE_TAC[summable; SERIES_RATIO]);; let SUMMABLE_REAL_GP = prove (`!x k. abs x < &1 ==> summable k (\n. lift(x pow n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_RATIO THEN MAP_EVERY EXISTS_TAC [`abs x`; `0`] THEN ASM_REWRITE_TAC[NORM_LIFT; real_pow; REAL_ABS_MUL; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Ostensibly weaker versions of the boundedness of partial sums. *) (* ------------------------------------------------------------------------- *) let BOUNDED_PARTIAL_SUMS = prove (`!f:num->real^N k. bounded { vsum(k..n) f | n IN (:num) } ==> bounded { vsum(m..n) f | m IN (:num) /\ n IN (:num) }`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `bounded { vsum(0..n) f:real^N | n IN (:num) }` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[bounded] THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `sum { i:num | i < k} (\i. norm(f i:real^N)) + B` THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num < k` THENL [MATCH_MP_TAC(REAL_ARITH `!y. x <= y /\ y <= a /\ &0 < b ==> x <= a + b`) THEN EXISTS_TAC `sum (0..i) (\i. norm(f i:real^N))` THEN ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG; FINITE_NUMSEG_LT; NORM_POS_LE] THEN REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k = 0` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= B /\ &0 <= b ==> x <= b + B`) THEN ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG_LT; NORM_POS_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`f:num->real^N`; `0`; `k:num`; `i:num`] VSUM_COMBINE_L) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[NUMSEG_LT] THEN MATCH_MP_TAC(NORM_ARITH `norm(x) <= a /\ norm(y) <= b ==> norm(x + y) <= a + b`) THEN ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP BOUNDED_DIFFS (W CONJ th)) THEN MP_TAC th) THEN REWRITE_TAC[IMP_IMP; GSYM BOUNDED_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] BOUNDED_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `m:num`; `n:num`] THEN DISCH_THEN SUBST1_TAC THEN ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `n:num < m` THENL [DISJ2_TAC THEN REPEAT(EXISTS_TAC `vsum(0..0) (f:num->real^N)`) THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; VECTOR_SUB_REFL] THEN MESON_TAC[]; ALL_TAC] THEN DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`vsum(0..n) (f:num->real^N)`; `vsum(0..(m-1)) (f:num->real^N)`] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:num->real^N`; `0`; `m:num`; `n:num`] VSUM_COMBINE_L) THEN ANTS_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* General Dirichlet convergence test (could make this uniform on a set). *) (* ------------------------------------------------------------------------- *) let SUMMABLE_BILINEAR_PARTIAL_PRE = prove (`!f g h:real^M->real^N->real^P l k. bilinear h /\ ((\n. h (f(n + 1)) (g(n))) --> l) sequentially /\ summable (from k) (\n. h (f(n + 1) - f(n)) (g(n))) ==> summable (from k) (\n. h (f n) (g(n) - g(n - 1)))`, REPEAT GEN_TAC THEN REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE th]) THEN DISCH_THEN(X_CHOOSE_TAC `l':real^P`) THEN EXISTS_TAC `l - (h:real^M->real^N->real^P) (f k) (g(k - 1)) - l'` THEN REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN REPEAT(MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]));; let SERIES_DIRICHLET_BILINEAR = prove (`!f g h:real^M->real^N->real^P k m p l. bilinear h /\ bounded { vsum (m..n) f | n IN (:num)} /\ summable (from p) (\n. lift(norm(g(n + 1) - g(n)))) /\ ((\n. h (g(n + 1)) (vsum(1..n) f)) --> l) sequentially ==> summable (from k) (\n. h (g n) (f n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `1` THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\n. (h:real^M->real^N->real^P) (g n) (vsum (1..n) f - vsum (1..n-1) f)` THEN SIMP_TAC[IN_FROM; GSYM NUMSEG_RREC] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; ARITH_RULE `1 <= n ==> ~(n <= n - 1)`] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RSUB] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `p:num` THEN MP_TAC(ISPECL [`g:num->real^M`; `\n. vsum(1..n) f:real^N`; `h:real^M->real^N->real^P`; `l:real^P`; `p:num`] SUMMABLE_BILINEAR_PARTIAL_PRE) THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `summable (from p) (lift o (\n. C * B * norm(g(n + 1) - g(n):real^M)))` MP_TAC THENL [ASM_SIMP_TAC[o_DEF; LIFT_CMUL; SUMMABLE_CMUL]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUMMABLE_COMPARISON) THEN EXISTS_TAC `0` THEN REWRITE_TAC[IN_FROM; GE; LE_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `C * norm(g(n + 1) - g(n):real^M) * norm(vsum (1..n) f:real^N)` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);; let SERIES_DIRICHLET = prove (`!f:num->real^N g N k m. bounded { vsum (m..n) f | n IN (:num)} /\ (!n. N <= n ==> g(n + 1) <= g(n)) /\ ((lift o g) --> vec 0) sequentially ==> summable (from k) (\n. g(n) % f(n))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `lift o (g:num->real)`; `\x y:real^N. drop x % y`] SERIES_DIRICHLET_BILINEAR) THEN REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`m:num`; `N:num`; `vec 0:real^N`] THEN CONJ_TAC THENL [REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN FIRST_ASSUM(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN REWRITE_TAC[o_THM] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC SUMMABLE_EQ_EVENTUALLY THEN EXISTS_TAC `\n. lift(g(n) - g(n + 1))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_ARITH `b <= a ==> abs(b - a) = a - b`]; REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG; VSUM_DIFFS; LIFT_SUB] THEN REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN EXISTS_TAC `lift(g(N:num)) - vec 0` THEN MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]]; MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN ASM_REWRITE_TAC[o_DEF] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Rearranging absolutely convergent series. *) (* ------------------------------------------------------------------------- *) let SERIES_INJECTIVE_IMAGE_STRONG = prove (`!x:num->real^N s f. summable (IMAGE f s) (\n. lift(norm(x n))) /\ (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) ==> ((\n. vsum (IMAGE f s INTER (0..n)) x - vsum (s INTER (0..n)) (x o f)) --> vec 0) sequentially`, let lemma = prove (`!f:A->real^N s t. FINITE s /\ FINITE t ==> vsum s f - vsum t f = vsum (s DIFF t) f - vsum (t DIFF s) f`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN ASM_SIMP_TAC[VSUM_DIFF; INTER_SUBSET] THEN REWRITE_TAC[INTER_COMM] THEN VECTOR_ARITH_TAC) in REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUMMABLE_CAUCHY]) THEN SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN SIMP_TAC[real_abs; SUM_POS_LE; NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[dist; GE; VECTOR_SUB_RZERO; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `g:num->num`) THEN MP_TAC(ISPECL [`g:num->num`; `0..N`] UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN DISCH_THEN(X_CHOOSE_TAC `P:num`) THEN EXISTS_TAC `MAX N P` THEN X_GEN_TAC `n:num` THEN SIMP_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) VSUM_IMAGE o rand o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER]; DISCH_THEN(SUBST1_TAC o SYM)] THEN W(MP_TAC o PART_MATCH (lhand o rand) lemma o rand o lhand o snd) THEN SIMP_TAC[FINITE_INTER; FINITE_IMAGE; FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm a < e / &2 /\ norm b < e / &2 ==> norm(a - b:real^N) < e`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN SIMP_TAC[FINITE_DIFF; FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC REAL_LET_TRANS THENL [EXISTS_TAC `sum(IMAGE (f:num->num) s INTER (N..n)) (\i. norm(x i :real^N))` THEN ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ f(x) IN n /\ ~(x IN m) ==> f x IN t) ==> (IMAGE f s INTER n) DIFF (IMAGE f (s INTER m)) SUBSET IMAGE f s INTER t`) THEN ASM_SIMP_TAC[IN_NUMSEG; LE_0; NOT_LE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[GSYM NOT_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV [GSYM CONTRAPOS_THM]) THEN ASM_SIMP_TAC[] THEN ASM_ARITH_TAC; MP_TAC(ISPECL [`f:num->num`; `0..n`] UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN EXISTS_TAC `sum(IMAGE (f:num->num) s INTER (N..p)) (\i. norm(x i :real^N))` THEN ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN n /\ ~(f x IN m) ==> f x IN t) ==> (IMAGE f (s INTER n) DIFF (IMAGE f s) INTER m) SUBSET (IMAGE f s INTER t)`) THEN ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN ASM_ARITH_TAC]);; let SERIES_INJECTIVE_IMAGE = prove (`!x:num->real^N s f l. summable (IMAGE f s) (\n. lift(norm(x n))) /\ (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) ==> (((x o f) sums l) s <=> (x sums l) (IMAGE f s))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[sums] THEN MATCH_MP_TAC LIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN MATCH_MP_TAC SERIES_INJECTIVE_IMAGE_STRONG THEN ASM_REWRITE_TAC[]);; let SERIES_REARRANGE_EQ = prove (`!x:num->real^N s p l. summable s (\n. lift(norm(x n))) /\ p permutes s ==> (((x o p) sums l) s <=> (x sums l) s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`x:num->real^N`; `s:num->bool`; `p:num->num`; `l:real^N`] SERIES_INJECTIVE_IMAGE) THEN ASM_SIMP_TAC[PERMUTES_IMAGE] THEN ASM_MESON_TAC[PERMUTES_INJECTIVE]);; let SERIES_REARRANGE = prove (`!x:num->real^N s p l. summable s (\n. lift(norm(x n))) /\ p permutes s /\ (x sums l) s ==> ((x o p) sums l) s`, MESON_TAC[SERIES_REARRANGE_EQ]);; let SUMMABLE_REARRANGE = prove (`!x s p. summable s (\n. lift(norm(x n))) /\ p permutes s ==> summable s (x o p)`, MESON_TAC[SERIES_LIFT_ABSCONV_IMP_CONV; summable; SERIES_REARRANGE]);; (* ------------------------------------------------------------------------- *) (* Some general theorems about series averages, convolutions etc. *) (* ------------------------------------------------------------------------- *) let TOEPLITZ_BILINEAR_SERIES_NULL = prove (`!(bop:real^M->real^N->real^P) a x m b. bilinear bop /\ (x --> vec 0) sequentially /\ (!p. ((\n. a n p) --> vec 0) sequentially) /\ (!n. sum (0..n) (\i. norm(a n i)) <= b) ==> ((\n. vsum(m..n) (\i. bop (a n i) (x i))) --> vec 0) sequentially`, ONCE_REWRITE_TAC[MESON[] `(!p a x m b. P p a x m b) <=> (!p b a m x. P p a x m b)`] THEN REPLICATE_TAC 3 GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!m. P 0 ==> P m) /\ P 0 ==> !m. P m`) THEN CONJ_TAC THENL [X_GEN_TAC `m:num` THEN DISCH_TAC THEN X_GEN_TAC `x:num->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\i. if i < m then vec 0 else (x:num->real^N) i`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `m:num` THEN SIMP_TAC[GSYM NOT_LE]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; IN_NUMSEG; LE_0; LE_REFL] THEN SIMP_TAC[GSYM NOT_LE; IMP_CONJ] THEN ASM_MESON_TAC[BILINEAR_RZERO]]; REPEAT STRIP_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / B / (&2 * abs b + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &2 * abs b + &1`] THEN REWRITE_TAC[DIST_0; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `((\n. vsum(0..m) (\i. (bop:real^M->real^N->real^P) (a n i) (x i))) --> vec 0) sequentially` MP_TAC THENL [MATCH_MP_TAC LIM_NULL_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `(x:num->real^N) k` o MATCH_MP BILINEAR_LZERO) THEN MP_TAC(ISPECL [`sequentially`; `bop:real^M->real^N->real^P`] LIM_BILINEAR) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[LIM_CONST]; REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; DIST_0; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN EXISTS_TAC `MAX m p` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[ARITH_RULE `MAX a b <= n <=> a <= n /\ b <= n`] THEN STRIP_TAC THEN SUBGOAL_THEN `0 <= m + 1 /\ m <= n` MP_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP VSUM_COMBINE_R th)])] THEN MATCH_MP_TAC(NORM_ARITH `norm(x:real^N) < e / &2 /\ norm(y) <= e / &2 ==> norm(x + y) < e`) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN TRANS_TAC REAL_LE_TRANS `sum(m + 1..n) (\i. norm((a:num->num->real^M) n i)) * e / (&2 * abs b + &1)` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH `x < e / b / c ==> x <= e * inv c * inv b`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ONCE_REWRITE_TAC[REAL_ARITH `s * e / b <= e / &2 <=> e * (&2 * s) / b <= e * &1`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &2 * abs b + &1`] THEN MATCH_MP_TAC(REAL_ARITH `x <= b ==> &2 * x <= &1 * (&2 * abs b + &1)`) THEN TRANS_TAC REAL_LE_TRANS `sum(0..n) (\i. norm((a:num->num->real^M) n i))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN REWRITE_TAC[SUBSET; NORM_POS_LE; IN_NUMSEG; FINITE_NUMSEG] THEN ARITH_TAC]);; let TOEPLITZ_BILINEAR_SERIES = prove (`!(bop:real^M->real^N->real^P) a x m r l i b. bilinear bop /\ (x --> l) sequentially /\ (!p. ((\n. a n p) --> vec 0) sequentially) /\ (((\n. vsum(r..n) (\i. a n i))) --> i) sequentially /\ (!n. sum (0..n) (\i. norm(a n i)) <= b) ==> ((\n. vsum(m..n) (\i. bop (a n i) (x i))) --> bop i l) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`bop:real^M->real^N->real^P`; `a:num->num->real^M`; `\n. (x:num->real^N) n - l`; `m:num`; `b:real`] TOEPLITZ_BILINEAR_SERIES_NULL) THEN ASM_REWRITE_TAC[GSYM LIM_NULL] THEN GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN ASM_SIMP_TAC[BILINEAR_RSUB; VSUM_SUB_NUMSEG] THEN REWRITE_TAC[VECTOR_ARITH `x - l - (x - b):real^N = --(l - b)`] THEN REWRITE_TAC[LIM_NULL_NEG; GSYM LIM_NULL] THEN ASM_SIMP_TAC[GSYM BILINEAR_LSUM; FINITE_NUMSEG] THEN MP_TAC(ISPECL [`sequentially`; `bop:real^M->real^N->real^P`] LIM_BILINEAR) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[LIM_CONST] THEN UNDISCH_TAC `((\n. vsum(r..n) (\j. (a:num->num->real^M) n j)) --> i) sequentially` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`r:num`; `m:num`] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[VECTOR_SUB_REFL; LIM_CONST] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM LIM_NULL_NEG] THEN REWRITE_TAC[VECTOR_NEG_SUB]; MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\k. --(vsum(m..n-1) (\j. (a:num->num->real^M) k j))` THEN ASM_SIMP_TAC[LIM_NULL_VSUM; FINITE_NUMSEG; LIM_NULL_NEG] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[VECTOR_ARITH `--x:real^N = y - z <=> x + y = z`] THEN MATCH_MP_TAC VSUM_COMBINE_L THEN ASM_ARITH_TAC]);; let LIM_BILINEAR_CONVOLUTION = prove (`!(bop:real^M->real^N->real^P) x y m k a b. bilinear bop /\ (x --> a) sequentially /\ (y --> b) sequentially ==> ((\n. inv(&n + k) % vsum(m..n) (\i. bop (x i) (y(n - i)))) --> bop a b) sequentially`, REPEAT STRIP_TAC THEN REWRITE_TAC[tendsto] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`a:real^M`; `b:real^N`; `e / &4`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] BILINEAR_EPSILON_DELTA)) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `eventually (\n. m + 1 <= n /\ norm(x n - a:real^M) < d /\ norm(y n - b:real^N) < d) sequentially` MP_TAC THENL [REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]; RULE_ASSUM_TAC(REWRITE_RULE[tendsto; dist]) THEN ASM_SIMP_TAC[]]; GEN_REWRITE_TAC LAND_CONV [EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN SUBGOAL_THEN `m + 1 <= N` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN ARITH_TAC; FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `m + 1 <= n ==> 1 <= n`))] THEN MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\n. max (&(2 * N + 1)) (--k) <= &n /\ (dist(inv (&n + k) % vsum(m..N-1) (\i. bop (x i) (y (n - i))),vec 0) < e / &4 /\ dist(inv (&n + k) % vsum((n-N)+1..n) (\i. (bop:real^M->real^N->real^P) (x i) (y (n - i))),vec 0) < e / &4) /\ dist(inv (&n + k) % vsum(N..n-N) (\i. bop (x i) (y (n - i))),bop a b) < e / &2` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_MAX_LE; REAL_OF_NUM_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(NORM_ARITH `x + y + z:real^N = w ==> (dist(x,vec 0) < e / &4 /\ dist(z,vec 0) < e / &4) /\ dist(y,a) < e / &2 ==> dist(w,a) < e`) THEN REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN AP_TERM_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_COMBINE_R o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC VSUM_COMBINE_L THEN FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EVENTUALLY_AND; ARCH_EVENTUALLY_LE] THEN CONJ_TAC THENL [CONJ_TAC THEN (SUBGOAL_THEN `&0 < e / &4` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN SPEC_TAC(`e / &4`,`e:real`) THEN REWRITE_TAC[GSYM tendsto] THEN REWRITE_TAC[GSYM VSUM_LMUL] THENL [ALL_TAC; MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. vsum (0..N-1) (\i. inv (&n + k) % (bop:real^M->real^N->real^P) (x (n - i)) (y i))` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N + 1` THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [VSUM_REFLECT] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> n - (n - N + 1) = N - 1`] THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REPEAT AP_TERM_TAC THEN ASM_ARITH_TAC; ALL_TAC]] THEN MATCH_MP_TAC LIM_NULL_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN REWRITE_TAC[o_DEF; SEQ_HARMONIC_OFFSET] THEN UNDISCH_TAC `(y --> (b:real^N)) sequentially` THEN UNDISCH_TAC `(x --> (a:real^M)) sequentially` THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `A:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `C * A * B:real` THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN DISJ2_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE]; MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\n. max (&1 - k) (&2 * &N + &1) <= &n /\ dist(inv(&n + (&1 - &2 * &N)) % vsum(N..n - N) (\i. bop (x i) (y (n - i))),bop a b) < e / &4 /\ dist(lift((&n + k) / (&n + (&1 - &2 * &N))),vec 1) < &1 / &4 /\ dist((&n + (&1 - &2 * &N)) / (&n + k) % (bop:real^M->real^N->real^P) a b,bop a b) < e / &8` THEN REWRITE_TAC[EVENTUALLY_AND; ARCH_EVENTUALLY_LE] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `dist(ab',ab) < e / &8 ==> dist(s,ab') <= &3 * e / &8 ==> dist(s:real^N,ab) < e / &2`)) THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN REWRITE_TAC[dist; GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_SUB_LDISTRIB] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ARITH `&1 - k <= n ==> abs(n + k) = n + k`] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_ARITH `&1 - k <= n ==> &0 < n + k`] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(inv(&n + &1 - &2 * &N))` THEN REWRITE_TAC[GSYM NORM_MUL; VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN REWRITE_TAC[REAL_ABS_INV; REAL_INV_EQ_0; GSYM REAL_ABS_NZ] THEN ASM_SIMP_TAC[REAL_MUL_LINV; GSYM dist; VECTOR_MUL_LID; REAL_ARITH `x + &1 <= n ==> ~(n + &1 - x = &0)`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e / &4 ==> e * &2 / &3 <= e * nk * nn ==> x <= nn * (&3 * inv(&8) * e) * nk`)) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_LIFT; GSYM LIFT_NUM]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(x - &1) < &1 / &4 ==> y = x ==> &2 / &3 <= y`)) THEN REWRITE_TAC[real_div] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2 * N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&n + &1 - &2 * &N)` THEN SIMP_TAC[dist; GSYM NORM_MUL; VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE [GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL]) THEN ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_MUL_RINV; VECTOR_MUL_LID; REAL_ARITH `x + &1 <= n ==> ~(n + &1 - x = &0)`] THEN SUBGOAL_THEN `&n + &1 - &2 * &N = &(((n - N) + 1) - N)` SUBST1_TAC THENL [MATCH_MP_TAC(REAL_ARITH `x + &1 = y + z ==> x + &1 - z = y`) THEN UNDISCH_TAC `&2 * &N + &1 <= &n` THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_LE] THEN ARITH_TAC; REWRITE_TAC[GSYM VSUM_CONST_NUMSEG; GSYM VSUM_SUB_NUMSEG]] THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN REWRITE_TAC[GSYM CARD_NUMSEG; REAL_ABS_NUM] THEN MATCH_MP_TAC SUM_BOUND_LT_ALL THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE [REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE]) THEN ASM_ARITH_TAC; X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPEC `i:num` th) THEN MP_TAC(ISPEC `n - i:num` th)) THEN ASM_SIMP_TAC[REAL_OF_NUM_LE] THEN ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]]]; MP_TAC(REAL_ARITH `&0 < &1 / &4`) THEN SPEC_TAC(`&1 / &4`,`e:real`) THEN REWRITE_TAC[GSYM tendsto; SEQ_HARMONIC_RATIO]; SUBGOAL_THEN `&0 < e / &8` MP_TAC THENL [ASM_REAL_ARITH_TAC; SPEC_TAC(`e / &8`,`e:real`)] THEN REWRITE_TAC[GSYM tendsto] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[o_DEF; SEQ_HARMONIC_RATIO; LIFT_NUM]]]);; let LIM_CESARO = prove (`!a l:real^N m k. (a --> l) sequentially ==> ((\n. inv(&n + k) % vsum(m..n) a) --> l) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\y:real^N x. drop x % y`; `a:num->real^N`; `(\n. vec 1):num->real^1`; `m:num`; `k:real`; `l:real^N`; `vec 1:real^1`] LIM_BILINEAR_CONVOLUTION) THEN ASM_REWRITE_TAC[BILINEAR_MUL_DROP; LIM_CONST; DROP_VEC; VECTOR_MUL_LID] THEN REWRITE_TAC[ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Multiplication (in a general bilinear sense) of series. *) (* ------------------------------------------------------------------------- *) let SERIES_BILINEAR = prove (`!bop:real^M->real^N->real^P x y a b. bilinear bop /\ (x sums a) (from 0) /\ (y sums b) (from 0) /\ (summable (from 0) (\n. lift(norm(x n))) \/ summable (from 0) (\n. lift(norm(y n)))) ==> ((\n. vsum(0..n) (\i. bop (x i) (y(n - i)))) sums bop a b) (from 0)`, let lemma = prove (`!bop:real^M->real^N->real^P x y a b. bilinear bop /\ (x sums a) (from 0) /\ (y sums b) (from 0) /\ summable (from 0) (\n. lift(norm(x n))) ==> ((\n. vsum(0..n) (\i. bop (x i) (y(n - i)))) sums bop a b) (from 0)`, REWRITE_TAC[SERIES_FROM] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN ASM_SIMP_TAC[BILINEAR_VSUM_CONVOLUTION_1] THEN ONCE_REWRITE_TAC[VSUM_REFLECT] THEN REWRITE_TAC[CONJUNCT1 LT; SUB_0] THEN MP_TAC(ISPECL [`bop:real^M->real^N->real^P`; `\n i. (x:num->real^M) (n - i)`; `\m. vsum(0..m) y - b:real^N`; `0`] TOEPLITZ_BILINEAR_SERIES_NULL) THEN ASM_REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[GSYM LIM_NULL] THEN CONJ_TAC THENL [X_GEN_TAC `p:num` THEN MATCH_MP_TAC SEQ_OFFSET_REV THEN EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[ADD_SUB; ETA_AX] THEN MATCH_MP_TAC SERIES_TERMS_TOZERO THEN REWRITE_TAC[SERIES_FROM] THEN MAP_EVERY EXISTS_TAC [`a:real^M`; `0`] THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [summable]) THEN REWRITE_TAC[SERIES_FROM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l:real^1` THEN DISCH_TAC THEN MP_TAC(ISPECL [`\n. vsum(0..n) (\i. lift(norm((x:num->real^M) i)))`; `l:real^1`] CONVERGENT_IMP_BOUNDED) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= b ==> y <= b`) THEN REWRITE_TAC[NORM_1; DROP_VSUM; o_DEF; LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUM_REFLECT] THEN REWRITE_TAC[CONJUNCT1 LT; SUB_0; REAL_ABS_REFL] THEN SIMP_TAC[SUM_POS_LE_NUMSEG; NORM_POS_LE]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN ASM_SIMP_TAC[BILINEAR_RSUB; VSUM_SUB_NUMSEG] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `s - l - (s' - ab):real^N = (s - s') + --(l - ab)`] THEN MATCH_MP_TAC LIM_NULL_ADD THEN CONJ_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN GEN_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN SIMP_TAC[ARITH_RULE `i:num <= n ==> n - (n - i) = i`]; ASM_SIMP_TAC[GSYM BILINEAR_LSUM; FINITE_NUMSEG; GSYM BILINEAR_LSUB] THEN REWRITE_TAC[LIM_NULL_NEG] THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `b:real^N` o MATCH_MP BILINEAR_LZERO) THEN MP_TAC(ISPECL [`sequentially`; `bop:real^M->real^N->real^P`] LIM_BILINEAR) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[LIM_CONST] THEN ONCE_REWRITE_TAC[VSUM_REFLECT] THEN REWRITE_TAC[CONJUNCT1 LT; SUB_0; GSYM LIM_NULL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN ASM_ARITH_TAC]]) in REPEAT STRIP_TAC THEN ASM_SIMP_TAC[lemma] THEN MP_TAC(ISPECL [`\x y. (bop:real^M->real^N->real^P) y x`; `y:num->real^N`; `x:num->real^M`; `b:real^N`; `a:real^M`] lemma) THEN ASM_REWRITE_TAC[BILINEAR_SWAP] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMS_EQ) THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [VSUM_REFLECT] THEN REWRITE_TAC[CONJUNCT1 LT; SUB_0] THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_NUMSEG; ARITH_RULE `i:num <= n ==> n - (n - i) = i`]);; let SERIES_BILINEAR_UNIQUE = prove (`!bop:real^M->real^N->real^P x y a b c. bilinear bop /\ (x sums a) (from 0) /\ (y sums b) (from 0) /\ ((\n. vsum (0..n) (\i. bop (x i) (y(n - i)))) sums c) (from 0) ==> bop a b = c`, REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_FROM] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s ==> t <=> p ==> p /\ q /\ r ==> s ==> t`] THEN DISCH_TAC THEN DISCH_THEN(LABEL_TAC "*" o SPECL [`0`; `&0:real`] o MATCH_MP LIM_BILINEAR_CONVOLUTION) THEN DISCH_THEN(MP_TAC o SPECL [`0`; `&0:real`] o MATCH_MP LIM_CESARO) THEN REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[IMP_IMP; REAL_ADD_RID] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_VSUM_CONVOLUTION_2 th]) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] LIM_UNIQUE) THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]);; let SUMMABLE_BILINEAR_LEFT = prove (`!bop:real^M->real^N->real^P x y m n p. bilinear bop /\ summable (from m) (\n. lift(norm(x n))) /\ summable (from n) y ==> summable (from p) (\n. vsum(0..n) (\i. bop (x i) (y(n - i))))`, ONCE_REWRITE_TAC[SPEC `0` SUMMABLE_FROM_ELSEWHERE_EQ] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SERIES_LIFT_ABSCONV_IMP_CONV) THEN UNDISCH_TAC `summable (from 0) (y:num->real^N)` THEN REWRITE_TAC[summable; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN EXISTS_TAC `(bop:real^M->real^N->real^P) a b` THEN MATCH_MP_TAC SERIES_BILINEAR THEN ASM_REWRITE_TAC[]);; let SUMMABLE_BILINEAR_RIGHT = prove (`!bop:real^M->real^N->real^P x y m n p. bilinear bop /\ summable (from m) x /\ summable (from n) (\n. lift(norm(y n))) ==> summable (from p) (\n. vsum(0..n) (\i. bop (x i) (y(n - i))))`, ONCE_REWRITE_TAC[SPEC `0` SUMMABLE_FROM_ELSEWHERE_EQ] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SERIES_LIFT_ABSCONV_IMP_CONV) THEN UNDISCH_TAC `summable (from 0) (x:num->real^M)` THEN REWRITE_TAC[summable; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(bop:real^M->real^N->real^P) a b` THEN MATCH_MP_TAC SERIES_BILINEAR THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Relate Cauchy sequences to summability or absolute convergence. *) (* ------------------------------------------------------------------------- *) let CAUCHY_EQ_SUMMABLE = prove (`!x:num->real^N. cauchy x <=> summable (from 0) (\n. x(n + 1) - x n)`, REWRITE_TAC[cauchy; SUMMABLE_CAUCHY; FROM_0; INTER_UNIV] THEN GEN_TAC THEN REWRITE_TAC[VSUM_DIFFS_ALT] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THENL [REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0; GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; MATCH_MP_TAC WLOG_LT THEN ASM_REWRITE_TAC[DIST_REFL] THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN REWRITE_TAC[ADD1] THEN CONV_TAC NORM_ARITH]);; let CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE = prove (`!x:num->real^N. cauchy x ==> ?r. (!m n. m < n ==> r m < r n) /\ summable (from 0) (\n. lift(dist(x(r(n + 1)),x(r n))))`, REWRITE_TAC[cauchy] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `N:num->num`) THEN SUBGOAL_THEN `?r:num->num. (!n. N n <= r n) /\ (!n. r(n) < r(SUC n))` MP_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[ARITH_RULE `a <= x /\ b < x <=> MAX a (SUC b) <= x`] THEN MESON_TAC[LE_REFL]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num`] THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS]; ALL_TAC] THEN MATCH_MP_TAC SUMMABLE_COMPARISON THEN EXISTS_TAC `\n. inv(&2 pow n)` THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; REAL_INV_POW] THEN MATCH_MP_TAC SUMMABLE_REAL_GP THEN CONV_TAC REAL_RAT_REDUCE_CONV; EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_DIST] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[ADD1] THEN ARITH_TAC]);; let ABSOLUTELY_SUMMABLE_IMP_CAUCHY = prove (`!x:num->real^N. summable (from 0) (\n. lift(dist(x(n + 1),x n))) ==> cauchy x`, REPEAT STRIP_TAC THEN REWRITE_TAC[CAUCHY_EQ_SUMMABLE] THEN MATCH_MP_TAC SERIES_LIFT_ABSCONV_IMP_CONV THEN ASM_REWRITE_TAC[GSYM dist]);; let COMPLETE_ABSOLUTELY_SUMMABLE = prove (`!s:real^N->bool. complete s <=> !f. (!n. f n IN s) /\ summable (from 0) (\n. lift(dist(f(n + 1),f n))) ==> ?l. l IN s /\ (f --> l) sequentially`, GEN_TAC THEN REWRITE_TAC[complete] THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_SUMMABLE_IMP_CAUCHY THEN ASM_REWRITE_TAC[]; DISCH_TAC THEN X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:num->real^N) o (r:num->num)`) THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[CAUCHY_CONVERGENT_SUBSEQUENCE]]);; (* ------------------------------------------------------------------------- *) (* Banach fixed point theorem (not really topological...) *) (* ------------------------------------------------------------------------- *) let BANACH_FIX = prove (`!f s c. complete s /\ ~(s = {}) /\ &0 <= c /\ c < &1 /\ (IMAGE f s) SUBSET s /\ (!x y. x IN s /\ y IN s ==> dist(f(x),f(y)) <= c * dist(x,y)) ==> ?!x:real^N. x IN s /\ (f x = x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `dist((f:real^N->real^N) x,f y) <= c * dist(x,y)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_ARITH `a <= c * a <=> &0 <= --a * (&1 - c)`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_SUB_LT; real_div] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ARITH `&0 <= --x <=> ~(&0 < x)`] THEN MESON_TAC[DIST_POS_LT]] THEN STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION `(z 0 = @x:real^N. x IN s) /\ (!n. z(SUC n) = f(z n))`) THEN SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_IMAGE]; ALL_TAC] THEN UNDISCH_THEN `z 0 = @x:real^N. x IN s` (K ALL_TAC) THEN SUBGOAL_THEN `?x:real^N. x IN s /\ (z --> x) sequentially` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `e = dist(f(a:real^N),a)` THEN SUBGOAL_THEN `~(&0 < e)` (fun th -> ASM_MESON_TAC[th; DIST_POS_LT]) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN SUBGOAL_THEN `dist(f(z N),a:real^N) < e / &2 /\ dist(f(z(N:num)),f(a)) < e / &2` (fun th -> ASM_MESON_TAC[th; DIST_TRIANGLE_HALF_R; REAL_LT_REFL]) THEN CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N <= SUC N`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `c * dist((z:num->real^N) N,a)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x < y /\ c * x <= &1 * x ==> c * x < y`) THEN ASM_SIMP_TAC[LE_REFL; REAL_LE_RMUL; DIST_POS_LE; REAL_LT_IMP_LE]] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [complete]) THEN ASM_REWRITE_TAC[CAUCHY] THEN SUBGOAL_THEN `!n. dist(z(n):real^N,z(SUC n)) <= c pow n * dist(z(0),z(1))` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[real_pow; ARITH; REAL_MUL_LID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * dist(z(n):real^N,z(SUC n))` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL]; ALL_TAC] THEN SUBGOAL_THEN `!m n:num. (&1 - c) * dist(z(m):real^N,z(m+n)) <= c pow m * dist(z(0),z(1)) * (&1 - c pow n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_RZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_SUB_LE; REAL_POW_1_LE; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - c) * (dist(z m:real^N,z(m + n)) + dist(z(m + n),z(m + SUC n)))` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; REAL_LT_IMP_LE; DIST_TRIANGLE] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `c * x <= y ==> c * x' + y <= y' ==> c * (x + x') <= y'`)) THEN REWRITE_TAC[REAL_ARITH `q + a * b * (&1 - x) <= a * b * (&1 - y) <=> q <= a * b * (x - y)`] THEN REWRITE_TAC[ADD_CLAUSES; real_pow] THEN REWRITE_TAC[REAL_ARITH `a * b * (d - c * d) = (&1 - c) * a * d * b`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM REAL_POW_ADD; REAL_MUL_ASSOC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_CASES_TAC `(z:num->real^N) 0 = z 1` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `n:num`]) THEN REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_CASES_TAC `(z:num->real^N) 0 = z n` THEN ASM_REWRITE_TAC[DIST_REFL; REAL_NOT_LE] THEN ASM_SIMP_TAC[REAL_LT_MUL; DIST_POS_LT; REAL_SUB_LT]; ALL_TAC] THEN MP_TAC(SPECL [`c:real`; `e * (&1 - c) / dist((z:num->real^N) 0,z 1)`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_SUB_LT; DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[real_div; GE; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM real_div; DIST_POS_LT] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN DISCH_TAC THEN REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST_ALL_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH `d < e ==> x <= d ==> x < e`)) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `d:num`]) THEN MATCH_MP_TAC(REAL_ARITH `(c * d) * e <= (c * d) * &1 ==> x * y <= c * d * e ==> y * x <= c * d`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_ARITH `&0 <= x ==> &1 - x <= &1`]);; (* ------------------------------------------------------------------------- *) (* Edelstein fixed point theorem. *) (* ------------------------------------------------------------------------- *) let EDELSTEIN_FIX = prove (`!f s. compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(f(x),f(y)) < dist(x,y)) ==> ?!x:real^N. x IN s /\ f x = x`, MAP_EVERY X_GEN_TAC [`g:real^N->real^N`; `s:real^N->bool`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]] THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s ==> dist((g:real^N->real^N)(x),g(y)) <= dist(x,y)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DIST_REFL; REAL_LE_LT]; ALL_TAC] THEN ASM_CASES_TAC `?x:real^N. x IN s /\ ~(g x = x)` THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `y = (g:real^N->real^N) x` THEN SUBGOAL_THEN `(y:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_PCROSS o W CONJ) THEN REWRITE_TAC[compact; PCROSS] THEN (STRIP_ASSUME_TAC o prove_general_recursive_function_exists) `?f:num->real^N->real^N. (!z. f 0 z = z) /\ (!z n. f (SUC n) z = g(f n z))` THEN SUBGOAL_THEN `!n z. z IN s ==> (f:num->real^N->real^N) n z IN s` STRIP_ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m n w z. m <= n /\ w IN s /\ z IN s ==> dist((f:num->real^N->real^N) n w,f n z) <= dist(f m w,f m z)` ASSUME_TAC THENL [REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `\n:num. pastecart (f n (x:real^N)) (f n y:real^N)`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`l:real^(N,N)finite_sum`; `s:num->num`] THEN REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST_ALL_TAC) THEN SUBGOAL_THEN `(\x:real^(N,N)finite_sum. fstcart x) continuous_on UNIV /\ (\x:real^(N,N)finite_sum. sndcart x) continuous_on UNIV` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[ETA_AX; LINEAR_FSTCART; LINEAR_SNDCART]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th))) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(fun th -> CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B") th THEN MP_TAC(MATCH_MP LIM_SUB th)) THEN REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "AB") THEN SUBGOAL_THEN `!n. dist(a:real^N,b) <= dist((f:num->real^N->real^N) n x,f n y)` STRIP_ASSUME_TAC THENL [X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN USE_THEN "AB" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o MATCH_MP th)) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN MATCH_MP_TAC(NORM_ARITH `dist(fx,fy) <= dist(x,y) ==> ~(dist(fx - fy,a - b) < dist(a,b) - dist(x,y))`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num` o MATCH_MP MONOTONE_BIGGER) THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `b:real^N = a` SUBST_ALL_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN ABBREV_TAC `e = dist(a,b) - dist((g:real^N->real^N) a,g b)` THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_SUB_LT]; ALL_TAC] THEN SUBGOAL_THEN `?n. dist((f:num->real^N->real^N) n x,a) < e / &2 /\ dist(f n y,b) < e / &2` STRIP_ASSUME_TAC THENL [MAP_EVERY (fun s -> USE_THEN s (MP_TAC o SPEC `e / &2` o REWRITE_RULE[LIM_SEQUENTIALLY])) ["A"; "B"] THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `(s:num->num) (M + N)` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `dist(f (SUC n) x,(g:real^N->real^N) a) + dist((f:num->real^N->real^N) (SUC n) y,g b) < e` MP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `dist(x,y) < e ==> dist(g x,g y) <= dist(x,y) ==> dist(g x,g y) < e`)) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `SUC n` (ASSUME `!n. dist (a:real^N,b) <= dist ((f:num->real^N->real^N) n x,f n y)`)) THEN EXPAND_TAC "e" THEN NORM_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (f:num->real^N->real^N) (SUC(s n)) x` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(g:real^N->real^N) continuous_on s` MP_TAC THENL [REWRITE_TAC[continuous_on] THEN ASM_MESON_TAC[REAL_LET_TRANS]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[]; SUBGOAL_THEN `!n. (f:num->real^N->real^N) (SUC n) x = f n y` (fun th -> ASM_SIMP_TAC[th]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Simple n-ary generalizations of Banach and Edelstein theorems. *) (* ------------------------------------------------------------------------- *) let BANACH_FIX_ITER = prove (`!f s:real^N->bool c n. complete s /\ ~(s = {}) /\ &0 <= c /\ c < &1 /\ IMAGE f s SUBSET s /\ (!x y. x IN s /\ y IN s ==> dist (ITER n f x,ITER n f y) <= c * dist (x,y)) ==> ?!x. x IN s /\ f x = x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`ITER n f:real^N->real^N`; `s:real^N->bool`; `c:real`] BANACH_FIX) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER_POINTLESS; IMAGE_I; IMAGE_o] THEN ASM SET_TAC[]; REWRITE_TAC[EXISTS_UNIQUE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (fun t -> ASSUME_TAC t THEN MP_TAC(SPEC `(f:real^N->real^N) x` t))) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[ITER_ALT; ITER]; STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER]]);; let EDELSTEIN_FIX_ITER = prove (`!f s n. compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(ITER n f x,ITER n f y) < dist(x,y)) ==> ?!x:real^N. x IN s /\ f x = x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`ITER n f:real^N->real^N`; `s:real^N->bool`] EDELSTEIN_FIX) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER_POINTLESS; IMAGE_I; IMAGE_o] THEN ASM SET_TAC[]; REWRITE_TAC[EXISTS_UNIQUE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (fun t -> ASSUME_TAC t THEN MP_TAC(SPEC `(f:real^N->real^N) x` t))) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[ITER_ALT; ITER]; STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER]]);; (* ------------------------------------------------------------------------- *) (* Dini's theorem. *) (* ------------------------------------------------------------------------- *) let DINI = prove (`!f:num->real^N->real^1 g s. compact s /\ (!n. (f n) continuous_on s) /\ g continuous_on s /\ (!x. x IN s ==> ((\n. (f n x)) --> g x) sequentially) /\ (!n x. x IN s ==> drop(f n x) <= drop(f (n + 1) x)) ==> !e. &0 < e ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) sequentially`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x:real^N m n:num. x IN s /\ m <= n ==> drop(f m x) <= drop(f n x)` ASSUME_TAC THENL [GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[ADD1] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n:num x:real^N. x IN s ==> drop(f n x) <= drop(g x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN EXISTS_TAC `\m:num. (f:num->real^N->real^1) n x` THEN EXISTS_TAC `\m:num. (f:num->real^N->real^1) m x` THEN ASM_SIMP_TAC[LIM_CONST; TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[LIM_SEQUENTIALLY; dist]) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\n. { x | x IN s /\ norm((f:num->real^N->real^1) n x - g x) < e}) (:num)`) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; SUBSET_UNION; UNIONS_IMAGE] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY] THEN SIMP_TAC[SUBSET; IN_UNIV; IN_ELIM_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM IN_BALL_0] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN ASM_SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_SUB; ETA_AX]; DISCH_THEN(X_CHOOSE_THEN `k:num->bool` (CONJUNCTS_THEN2 (MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) (LABEL_TAC "*"))) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `m <= n /\ n <= g ==> abs(m - g) < e ==> abs(n - g) < e`) THEN ASM_MESON_TAC[LE_TRANS]]);; (* ------------------------------------------------------------------------- *) (* Closest point of a (closed) set to a point. *) (* ------------------------------------------------------------------------- *) let closest_point = new_definition `closest_point s a = @x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`;; let CLOSEST_POINT_EXISTS = prove (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s /\ !y. y IN s ==> dist(a,closest_point s a) <= dist(a,y)`, REWRITE_TAC[closest_point] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN REWRITE_TAC[DISTANCE_ATTAINS_INF]);; let CLOSEST_POINT_IN_SET = prove (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s`, MESON_TAC[CLOSEST_POINT_EXISTS]);; let CLOSEST_POINT_LE = prove (`!s a x. closed s /\ x IN s ==> dist(a,closest_point s a) <= dist(a,x)`, MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; let CLOSEST_POINT_SELF = prove (`!s x:real^N. x IN s ==> closest_point s x = x`, REPEAT STRIP_TAC THEN REWRITE_TAC[closest_point] THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[DIST_LE_0; DIST_REFL]; STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL; DIST_POS_LE]]);; let CLOSEST_POINT_REFL = prove (`!s x:real^N. closed s /\ ~(s = {}) ==> (closest_point s x = x <=> x IN s)`, MESON_TAC[CLOSEST_POINT_IN_SET; CLOSEST_POINT_SELF]);; let DIST_CLOSEST_POINT_LIPSCHITZ = prove (`!s x y:real^N. closed s /\ ~(s = {}) ==> abs(dist(x,closest_point s x) - dist(y,closest_point s y)) <= dist(x,y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSEST_POINT_EXISTS) THEN DISCH_THEN(fun th -> CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `closest_point s (y:real^N)`) (SPEC `x:real^N` th) THEN CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `closest_point s (x:real^N)`) (SPEC `y:real^N` th)) THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let CONTINUOUS_AT_DIST_CLOSEST_POINT = prove (`!s x:real^N. closed s /\ ~(s = {}) ==> (\x. lift(dist(x,closest_point s x))) continuous (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; let CONTINUOUS_ON_DIST_CLOSEST_POINT = prove (`!s t. closed s /\ ~(s = {}) ==> (\x. lift(dist(x,closest_point s x))) continuous_on t`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_DIST_CLOSEST_POINT]);; let UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT = prove (`!s t:real^N->bool. closed s /\ ~(s = {}) ==> (\x. lift(dist(x,closest_point s x))) uniformly_continuous_on t`, REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; let SEGMENT_TO_CLOSEST_POINT = prove (`!s a:real^N. closed s /\ ~(s = {}) ==> segment(a,closest_point s a) INTER s = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN MATCH_MP_TAC(TAUT `(r ==> ~p) ==> p /\ q ==> ~r`) THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS; REAL_NOT_LT; DIST_SYM]);; let SEGMENT_TO_POINT_EXISTS = prove (`!s a:real^N. closed s /\ ~(s = {}) ==> ?b. b IN s /\ segment(a,b) INTER s = {}`, MESON_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]);; let CLOSEST_POINT_IN_INTERIOR = prove (`!s x:real^N. closed s /\ ~(s = {}) ==> ((closest_point s x) IN interior s <=> x IN interior s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `closest_point s (x:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `closest_point s x - (min (&1) (e / norm(closest_point s x - x))) % (closest_point s x - x):real^N`] CLOSEST_POINT_LE) THEN ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE]; REWRITE_TAC[NORM_MUL; REAL_ARITH `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);; let CLOSEST_POINT_IN_FRONTIER = prove (`!s x:real^N. closed s /\ ~(s = {}) /\ ~(x IN interior s) ==> (closest_point s x) IN frontier s`, SIMP_TAC[frontier; IN_DIFF; CLOSEST_POINT_IN_INTERIOR] THEN SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSURE_CLOSED]);; let CLOSEST_POINT_FRONTIER = prove (`!s x:real^N. ~(x IN interior s) ==> closest_point (frontier s) x = closest_point (closure s) x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[FRONTIER_EMPTY; CLOSURE_EMPTY] THEN ASM_CASES_TAC `s = (:real^N)` THEN ASM_REWRITE_TAC[INTERIOR_UNIV; IN_UNIV] THEN DISCH_TAC THEN REWRITE_TAC[closest_point] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[] THEN EQ_TAC THEN STRIP_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[frontier; IN_DIFF]; ALL_TAC] THEN X_GEN_TAC `z:real^N` THEN ASM_CASES_TAC `(z:real^N) IN interior s` THENL [DISCH_THEN(K ALL_TAC); ASM_MESON_TAC[frontier; IN_DIFF]] THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN MP_TAC(ISPECL [`segment[x:real^N,z]`; `interior s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN PURE_REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; NOT_IMP] THEN REWRITE_TAC[IN_INTER; IN_DIFF; NOT_IMP] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT]; EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT]; DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N`) THEN REWRITE_TAC[NOT_IMP] THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] FRONTIER_INTERIOR_SUBSET)) THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; frontier; IN_DIFF]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LE] THEN TRANS_TAC REAL_LET_TRANS `dist(x:real^N,z)` THEN ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM]]; CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[frontier; IN_DIFF]] THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN DISCH_TAC THEN MP_TAC(ISPECL [`segment[x:real^N,y]`; `interior s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN PURE_REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; NOT_IMP] THEN REWRITE_TAC[IN_INTER; IN_DIFF; NOT_IMP] THEN REPEAT CONJ_TAC THENL [EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT]; EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT]; DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN REWRITE_TAC[NOT_IMP] THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] FRONTIER_INTERIOR_SUBSET)) THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; frontier; IN_DIFF]; ALL_TAC] THEN ASM_CASES_TAC `z:real^N = x` THEN ASM_REWRITE_TAC[REAL_NOT_LE; DIST_REFL; GSYM DIST_NZ] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `z IN segment(x:real^N,y)` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIST_IN_OPEN_SEGMENT; DIST_SYM]] THEN ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[frontier; IN_DIFF]]]);; (* ------------------------------------------------------------------------- *) (* More general infimum of distance between two sets. *) (* ------------------------------------------------------------------------- *) let setdist = new_definition `setdist(s,t) = if s = {} \/ t = {} then &0 else inf {dist(x,y) | x IN s /\ y IN t}`;; let SETDIST_EMPTY = prove (`(!t. setdist({},t) = &0) /\ (!s. setdist(s,{}) = &0)`, REWRITE_TAC[setdist]);; let SETDIST_POS_LE = prove (`!s t. &0 <= setdist(s,t)`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_INF THEN REWRITE_TAC[FORALL_IN_GSPEC; DIST_POS_LE] THEN ASM SET_TAC[]);; let SETDIST_POS_LT = prove (`!s t:real^N->bool. &0 < setdist(s,t) <=> ~(setdist(s,t) = &0)`, REWRITE_TAC[REAL_LT_LE; SETDIST_POS_LE] THEN REAL_ARITH_TAC);; let SETDIST_SUBSETS_EQ = prove (`!s t s' t':real^N->bool. s' SUBSET s /\ t' SUBSET t /\ (!x y. x IN s /\ y IN t ==> ?x' y'. x' IN s' /\ y' IN t' /\ dist(x',y') <= dist(x,y)) ==> setdist(s',t') = setdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_CASES_TAC `s':real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_CASES_TAC `t':real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `s':real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `t':real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC INF_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);; let REAL_LE_SETDIST = prove (`!s t:real^N->bool d. ~(s = {}) /\ ~(t = {}) /\ (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) ==> d <= setdist(s,t)`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[setdist] THEN MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN ASM_MESON_TAC[]);; let SETDIST_LE_DIST = prove (`!s t x y:real^N. x IN s /\ y IN t ==> setdist(s,t) <= dist(x,y)`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN ASM_MESON_TAC[]);; let REAL_LE_SETDIST_EQ = prove (`!d s t:real^N->bool. d <= setdist(s,t) <=> (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) /\ (s = {} \/ t = {} ==> d <= &0)`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY; NOT_IN_EMPTY] THEN ASM_MESON_TAC[REAL_LE_SETDIST; SETDIST_LE_DIST; REAL_LE_TRANS]);; let REAL_SETDIST_LT_EXISTS = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ setdist(s,t) < b ==> ?x y. x IN s /\ y IN t /\ dist(x,y) < b`, REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SETDIST_EQ] THEN MESON_TAC[]);; let SETDIST_REFL = prove (`!s:real^N->bool. setdist(s,s) = &0`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[setdist; REAL_LE_REFL]; ALL_TAC] THEN ASM_MESON_TAC[SETDIST_LE_DIST; MEMBER_NOT_EMPTY; DIST_REFL]);; let SETDIST_SYM = prove (`!s t. setdist(s,t) = setdist(t,s)`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist; DISJ_SYM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[DIST_SYM]);; let SETDIST_TRIANGLE = prove (`!s a t:real^N->bool. setdist(s,t) <= setdist(s,{a}) + setdist({a},t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_LID; SETDIST_POS_LE] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_RID; SETDIST_POS_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `dist(x:real^N,y)` THEN ASM_SIMP_TAC[SETDIST_LE_DIST] THEN CONV_TAC NORM_ARITH);; let SETDIST_SINGS = prove (`!x y. setdist({x},{y}) = dist(x,y)`, REWRITE_TAC[setdist; NOT_INSERT_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x y | x IN {a} /\ y IN {b}} = {f a b}`] THEN SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);; let SETDIST_SCALING = prove (`!a s t:real^N->bool. setdist(IMAGE (\x. a % x) s,IMAGE (\x. a % x) t) = abs a * setdist(s,t)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; SETDIST_EMPTY; IMAGE_CLAUSES] THEN ASM_CASES_TAC `a = &0` THENL [ASM_SIMP_TAC[VECTOR_MUL_LZERO; SETDIST_REFL; SET_RULE `~(s = {}) ==> IMAGE (\x. a) s = {a}`] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN MATCH_MP_TAC INF_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE; DIST_MUL] THEN X_GEN_TAC `c:real` THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ] THEN CONV_TAC SYM_CONV THEN W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_INF_EQ o lhand o snd) THEN REWRITE_TAC[FORALL_IN_GSPEC; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MESON_TAC[DIST_POS_LE]]);; let SETDIST_UNIFORMLY_CONTINUOUS_ON,SETDIST_UNIFORMLY_CONTINUOUS_ON_ALT = (CONJ_PAIR o prove) (`(!f:real^M->real^N s. f uniformly_continuous_on s <=> !e. &0 < e ==> ?d. &0 < d /\ !t t'. t SUBSET s /\ t' SUBSET s /\ setdist(t',t) < d ==> setdist(IMAGE f t',IMAGE f t) < e) /\ (!f:real^M->real^N s. f uniformly_continuous_on s <=> !e. &0 < e ==> ?d. &0 < d /\ !t t'. t SUBSET s /\ t' SUBSET s /\ bounded t /\ bounded t' /\ setdist(t',t) < d ==> setdist(IMAGE f t',IMAGE f t) < e)`, CONJ_TAC THEN (REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `t':real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_CASES_TAC `t:real^M->bool = {}` THEN ASM_SIMP_TAC[SETDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `t':real^M->bool = {}` THEN ASM_SIMP_TAC[SETDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN MP_TAC(ISPECL [`t':real^M->bool`; `t:real^M->bool`; `d / &2`] REAL_SETDIST_LT_EXISTS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:real^M`; `x:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[REAL_ARITH `x < d / &2 /\ &0 < d ==> x < d`] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e / &2 ==> x <= e / &2`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_SIMP_TAC[IN_SING; FUN_IN_IMAGE]; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REWRITE_TAC[GSYM SETDIST_SINGS] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{f x} = IMAGE f {x}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SING_SUBSET; BOUNDED_SING]]));; let th = prove (`!c. &0 < c ==> !s t. setdist(IMAGE (\x. c % x) s,IMAGE (\x. c % x) t) = c * setdist(s,t)`, SIMP_TAC[SETDIST_SCALING; REAL_ARITH `&0 < c ==> abs c = c`]) in add_scaling_theorems [th];; let SETDIST_LIPSCHITZ = prove (`!s t x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SETDIST_SINGS] THEN REWRITE_TAC[REAL_ARITH `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN MESON_TAC[SETDIST_TRIANGLE; SETDIST_SYM]);; let CONTINUOUS_AT_LIFT_SETDIST = prove (`!s x:real^N. (\y. lift(setdist({y},s))) continuous (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; let CONTINUOUS_ON_LIFT_SETDIST = prove (`!s t:real^N->bool. (\y. lift(setdist({y},s))) continuous_on t`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_SETDIST]);; let UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST = prove (`!s t:real^N->bool. (\y. lift(setdist({y},s))) uniformly_continuous_on t`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; let SETDIST_DIFFERENCES = prove (`!s t. setdist(s,t) = setdist({vec 0},{x - y:real^N | x IN s /\ y IN t})`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist; NOT_INSERT_EMPTY; SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2; DIST_0] THEN REWRITE_TAC[dist] THEN MESON_TAC[]);; let SETDIST_SUBSET_RIGHT = prove (`!s t u:real^N->bool. ~(t = {}) /\ t SUBSET u ==> setdist(s,u) <= setdist(s,t)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY; SETDIST_POS_LE; REAL_LE_REFL] THEN ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MESON_TAC[DIST_POS_LE]);; let SETDIST_SUBSET_LEFT = prove (`!s t u:real^N->bool. ~(s = {}) /\ s SUBSET t ==> setdist(t,u) <= setdist(s,u)`, MESON_TAC[SETDIST_SUBSET_RIGHT; SETDIST_SYM]);; let SETDIST_CLOSURE = prove (`(!s t:real^N->bool. setdist(closure s,t) = setdist(s,t)) /\ (!s t:real^N->bool. setdist(s,closure t) = setdist(s,t))`, GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN REWRITE_TAC[] THEN REWRITE_TAC[MESON[REAL_LE_ANTISYM] `x:real = y <=> !d. d <= x <=> d <= y`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; CLOSURE_EMPTY; NOT_IN_EMPTY] THEN MATCH_MP_TAC(SET_RULE `s SUBSET c /\ (!y. Q y /\ (!x. x IN s ==> P x y) ==> (!x. x IN c ==> P x y)) ==> ((!x y. x IN c /\ Q y ==> P x y) <=> (!x y. x IN s /\ Q y ==> P x y))`) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE THEN ASM_REWRITE_TAC[o_DEF; dist] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; let SETDIST_FRONTIER = prove (`(!s t:real^N->bool. DISJOINT s t ==> setdist(frontier s,t) = setdist(s,t)) /\ (!s t:real^N->bool. DISJOINT s t ==> setdist(s,frontier t) = setdist(s,t))`, MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [MESON_TAC[SETDIST_SYM; DISJOINT_SYM]; ALL_TAC] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1 SETDIST_CLOSURE)] THEN MATCH_MP_TAC SETDIST_SUBSETS_EQ THEN REWRITE_TAC[frontier; IN_DIFF; SUBSET_DIFF; SUBSET_REFL] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN interior s` THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`segment[x:real^N,y]`; `s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `x:real^N`; EXISTS_TAC `y:real^N`] THEN ASM_REWRITE_TAC[IN_INTER; IN_DIFF; ENDS_IN_SEGMENT] THEN MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN SIMP_TAC[IN_INTER; frontier; IN_DIFF] THEN MESON_TAC[DIST_IN_CLOSED_SEGMENT]]);; let SETDIST_COMPACT_CLOSED = prove (`!s t:real^N->bool. compact s /\ closed t /\ ~(s = {}) /\ ~(t = {}) ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(MESON[] `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN SIMP_TAC[SETDIST_LE_DIST] THEN ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; DIST_0; GSYM CONJ_ASSOC] THEN REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let SETDIST_CLOSED_COMPACT = prove (`!s t:real^N->bool. closed s /\ compact t /\ ~(s = {}) /\ ~(t = {}) ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(MESON[] `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN SIMP_TAC[SETDIST_LE_DIST] THEN ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; DIST_0; GSYM CONJ_ASSOC] THEN REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let SETDIST_EQ_0_COMPACT_CLOSED = prove (`!s t:real^N->bool. compact s /\ closed t ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN EQ_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[DIST_EQ_0]; REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[SETDIST_LE_DIST; DIST_EQ_0]]);; let SETDIST_EQ_0_CLOSED_COMPACT = prove (`!s t:real^N->bool. closed s /\ compact t ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, ONCE_REWRITE_TAC[SETDIST_SYM] THEN SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED] THEN SET_TAC[]);; let SETDIST_EQ_0_BOUNDED = prove (`!s t:real^N->bool. (bounded s \/ bounded t) ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(closure(s) INTER closure(t) = {}))`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] `setdist(s,t) = setdist(closure s,closure t)`] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; SETDIST_EQ_0_CLOSED_COMPACT; COMPACT_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY]);; let SETDIST_TRANSLATION = prove (`!a:real^N s t. setdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = setdist(s,t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SETDIST_DIFFERENCES] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = {f (g x) (g y) | x IN s /\ y IN t}`] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; add_translation_invariants [SETDIST_TRANSLATION];; let SETDIST_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x. norm(f x) = norm x) ==> setdist(IMAGE f s,IMAGE f t) = setdist(s,t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = {f (g x) (g y) | x IN s /\ y IN t}`] THEN FIRST_X_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN ASM_REWRITE_TAC[]);; add_linear_invariants [SETDIST_LINEAR_IMAGE];; let SETDIST_UNIQUE = prove (`!s t a b:real^N d. a IN s /\ b IN t /\ dist(a,b) = d /\ (!x y. x IN s /\ y IN t ==> dist(a,b) <= dist(x,y)) ==> setdist(s,t) = d`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [ASM_MESON_TAC[SETDIST_LE_DIST]; MATCH_MP_TAC REAL_LE_SETDIST THEN ASM SET_TAC[]]);; let SETDIST_UNIV = prove (`(!s. setdist(s,(:real^N)) = &0) /\ (!t. setdist((:real^N),t) = &0)`, GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN REWRITE_TAC[] THEN X_GEN_TAC `s:real^N->bool` THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN MATCH_MP_TAC SETDIST_UNIQUE THEN REWRITE_TAC[IN_UNIV; DIST_EQ_0; RIGHT_EXISTS_AND_THM] THEN ASM_REWRITE_TAC[UNWIND_THM1; DIST_REFL; DIST_POS_LE; MEMBER_NOT_EMPTY]);; let SETDIST_ZERO = prove (`!s t:real^N->bool. ~(DISJOINT s t) ==> setdist(s,t) = &0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN MATCH_MP_TAC(MESON[] `(?a. P a a) ==> ?a b. P a b`) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ p /\ q /\ s`] THEN REWRITE_TAC[DIST_EQ_0; UNWIND_THM2; DIST_REFL; DIST_POS_LE] THEN ASM SET_TAC[]);; let SETDIST_ZERO_STRONG = prove (`!s t:real^N->bool. ~(DISJOINT (closure s) (closure t)) ==> setdist(s,t) = &0`, MESON_TAC[SETDIST_CLOSURE; SETDIST_ZERO]);; let SETDIST_FRONTIERS = prove (`!s t:real^N->bool. setdist(s,t) = if DISJOINT s t then setdist(frontier s,frontier t) else &0`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SETDIST_ZERO] THEN ASM_SIMP_TAC[GSYM SETDIST_FRONTIER] THEN ASM_CASES_TAC `DISJOINT s (frontier t:real^N->bool)` THENL [ASM_MESON_TAC[SETDIST_FRONTIER]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1 SETDIST_CLOSURE)] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SETDIST_SUBSETS_EQ THEN REWRITE_TAC[frontier; SUBSET_DIFF; SUBSET_REFL; IN_DIFF] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(x:real^N) IN interior s` THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN MP_TAC(ISPECL [`segment[x:real^N,y]`; `interior s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `x:real^N`; EXISTS_TAC `y:real^N`] THEN ASM_REWRITE_TAC[IN_INTER; IN_DIFF; ENDS_IN_SEGMENT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `y IN u ==> u INTER v = {} ==> ~(y IN v)`)) THEN REWRITE_TAC[INTERIOR_CLOSURE; SET_RULE `s INTER (UNIV DIFF t) = {} <=> s SUBSET t`] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN SIMP_TAC[IN_INTER; GSYM frontier; GSYM IN_DIFF] THEN MESON_TAC[FRONTIER_INTERIOR_SUBSET; SUBSET; DIST_IN_CLOSED_SEGMENT]]);; let SETDIST_SING_FRONTIER = prove (`!s x:real^N. ~(x IN s) ==> setdist({x},frontier s) = setdist({x},s)`, MESON_TAC[SET_RULE `DISJOINT {x} s <=> ~(x IN s)`; SETDIST_FRONTIER]);; let SETDIST_CLOSEST_POINT = prove (`!a:real^N s. closed s /\ ~(s = {}) ==> setdist({a},s) = dist(a,closest_point s a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; IN_SING; UNWIND_THM2] THEN EXISTS_TAC `closest_point s (a:real^N)` THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS; DIST_SYM]);; let SETDIST_EQ_0_SING = prove (`(!s x:real^N. setdist({x},s) = &0 <=> s = {} \/ x IN closure s) /\ (!s x:real^N. setdist(s,{x}) = &0 <=> s = {} \/ x IN closure s)`, SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_SING; CLOSURE_SING] THEN SET_TAC[]);; let SETDIST_EQ_0_CLOSED = prove (`!s x. closed s ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_SING] THEN SET_TAC[]);; let SETDIST_EQ_0_CLOSED_IN = prove (`!u s x. closed_in (subtopology euclidean u) s /\ x IN u ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, REWRITE_TAC[SETDIST_EQ_0_SING; CLOSED_IN_INTER_CLOSURE] THEN SET_TAC[]);; let SETDIST_SING_IN_SET = prove (`!x s. x IN s ==> setdist({x},s) = &0`, SIMP_TAC[SETDIST_EQ_0_SING; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);; let SETDIST_SING_FRONTIER_CASES = prove (`!s x:real^N. setdist({x},s) = if x IN s then &0 else setdist({x},frontier s)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; SETDIST_SING_FRONTIER]);; let SETDIST_SING_TRIANGLE = prove (`!s x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_SUB_REFL; REAL_ABS_NUM; DIST_POS_LE] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_NEG_SUB] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a - b <= c <=> a - c <= b`; REAL_ARITH `--a <= b - c <=> c - a <= b`] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN SIMP_TAC[IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THENL [MATCH_MP_TAC(NORM_ARITH `a <= dist(y:real^N,z) ==> a - dist(x,y) <= dist(x,z)`); MATCH_MP_TAC(NORM_ARITH `a <= dist(x:real^N,z) ==> a - dist(x,y) <= dist(y,z)`)] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; let SETDIST_LE_SING = prove (`!s t x:real^N. x IN s ==> setdist(s,t) <= setdist({x},t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_SUBSET_LEFT THEN ASM SET_TAC[]);; let SETDIST_BALLS = prove (`(!a b:real^N r s. setdist(ball(a,r),ball(b,s)) = if r <= &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ (!a b:real^N r s. setdist(ball(a,r),cball(b,s)) = if r <= &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ (!a b:real^N r s. setdist(cball(a,r),ball(b,s)) = if r < &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ (!a b:real^N r s. setdist(cball(a,r),cball(b,s)) = if r < &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s)))`, REWRITE_TAC[MESON[] `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; SETDIST_EMPTY; DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] `setdist(s,t) = setdist(closure s,closure t)`] THEN SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN REWRITE_TAC[SETDIST_CLOSURE] THEN MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT GEN_TAC] THEN REWRITE_TAC[real_max; REAL_SUB_LE] THEN COND_CASES_TAC THEN SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; CBALL_EQ_EMPTY; INTER_BALLS_EQ_EMPTY] THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_CASES_TAC `b:real^N = a` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_REFL]) THEN ASM_CASES_TAC `r = &0 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[CBALL_SING; SETDIST_SINGS] THEN REAL_ARITH_TAC; STRIP_TAC] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; IN_CBALL] THEN CONV_TAC NORM_ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `dist(a + r / dist(a,b) % (b - a):real^N, b - s / dist(a,b) % (b - a))` THEN CONJ_TAC THENL [MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a + x) = norm x`; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[dist; VECTOR_ARITH `(a + d % (b - a)) - (b - e % (b - a)):real^N = (&1 - d - e) % (a - b)`] THEN REWRITE_TAC[NORM_MUL; REAL_ARITH `&1 - r / y - s / y = &1 - (r + s) / y`] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; NORM_EQ_0; REAL_FIELD `~(n = &0) ==> (&1 - x / n) * n = n - x`] THEN REWRITE_TAC[GSYM dist] THEN ASM_REAL_ARITH_TAC]);; let OPEN_TRANSLATION_SUBSET_PREIMAGE = prove (`!s t:real^N->bool. compact s /\ open t ==> open {a | IMAGE (\x. a + x) s SUBSET t}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; EMPTY_SUBSET; UNIV_GSPEC; OPEN_UNIV] THEN ASM_CASES_TAC `t = (:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC; OPEN_UNIV] THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN EXISTS_TAC `setdist(IMAGE (\x. a + x) s,(:real^N) DIFF t)` THEN REWRITE_TAC[SETDIST_POS_LT; SUBSET; IN_BALL; IN_ELIM_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_TRANSLATION_EQ; GSYM OPEN_CLOSED] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[REAL_NOT_LT] `x < y ==> (~p ==> y <= x) ==> p`)) THEN DISCH_TAC THEN SUBST1_TAC(NORM_ARITH `dist(a:real^N,b) = dist(a + c,b + c)`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A nice characterization of uniform continuity via setdist. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_ON_SETDIST = prove (`!f:real^M->real^N s t t'. f uniformly_continuous_on s /\ t SUBSET s /\ t' SUBSET s /\ setdist(t,t') = &0 ==> setdist(IMAGE f t,IMAGE f t') = &0`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^M->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; SETDIST_EMPTY] THEN ASM_CASES_TAC `t':real^M->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; SETDIST_EMPTY] THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN PURE_REWRITE_TAC[GSYM SETDIST_POS_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [uniformly_continuous_on]) THEN DISCH_THEN(MP_TAC o SPEC `setdist(IMAGE (f:real^M->real^N) t,IMAGE f t')`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`t:real^M->bool`; `t':real^M->bool`; `d:real`] REAL_SETDIST_LT_EXISTS) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `x:real^M`]) THEN ASM_REWRITE_TAC[REAL_NOT_LT; NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_SIMP_TAC[FUN_IN_IMAGE]);; let UNIFORMLY_CONTINUOUS_ON_SETDIST_EQ = prove (`!f:real^M->real^N s. f uniformly_continuous_on s <=> !t t'. t SUBSET s /\ t' SUBSET s /\ setdist(t,t') = &0 ==> setdist(IMAGE f t,IMAGE f t') = &0`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[UNIFORMLY_CONTINUOUS_ON_SETDIST]; DISCH_TAC] THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `!P. (!x y. R x y ==> R y x) /\ (!x y. P x ==> R x y) /\ (!x y. ~P x /\ ~P y ==> R x y) ==> !x y. R x y`) THEN EXISTS_TAC `\x. ?B. INFINITE {n:num | norm((f:real^M->real^N) (x n)) <= B}` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM LIM_NULL_NEG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_SIMP_TAC[VECTOR_NEG_SUB]; ALL_TAC] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num->real^M`; `y:num->real^M`] THEN REWRITE_TAC[NOT_EXISTS_THM; INFINITE; AND_FORALL_THM] THEN REWRITE_TAC[GSYM INFINITE; GSYM FINITE_UNION] THEN DISCH_TAC THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE; GSYM NOT_FORALL_THM] THEN DISCH_TAC THENL [SUBGOAL_THEN `?l r. (!m n. m < n ==> r m < r n) /\ ((\n. (f:real^M->real^N) (x((r:num->num) n))) --> l) sequentially` (REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` (MP_TAC o MATCH_MP INFINITE_ENUMERATE)) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `IMAGE r UNIV = {x | P x} ==> !n. P(r n)`)) THEN MP_TAC(ISPEC `cball(vec 0:real^N,B)` compact) THEN REWRITE_TAC[COMPACT_CBALL; IN_CBALL_0] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) o x o (r:num->num)`) THEN ASM_REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(r:num->num) o (q:num->num)` THEN ASM_SIMP_TAC[o_DEF]; REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`IMAGE ((x:num->real^M) o r) {n:num | N <= n}`; `IMAGE ((y:num->real^M) o r) {n:num | N <= n}`]) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[NOT_IMP; GSYM SETDIST_POS_LT] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN GEN_REWRITE_TAC I [REAL_LE_TRANS_LT] THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `b:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `(r:num->num) (MAX N n)`)) THEN REWRITE_TAC[LE_REFL; dist; VECTOR_SUB_RZERO] THEN ANTS_TAC THENL [TRANS_TAC LE_TRANS `MAX N n` THEN CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[MONOTONE_BIGGER]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS)] THEN REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THEN REPLICATE_TAC 2 (MATCH_MP_TAC FUN_IN_IMAGE) THEN REWRITE_TAC[IN_ELIM_THM] THEN ARITH_TAC; TRANS_TAC REAL_LTE_TRANS `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN REWRITE_TAC[IMAGE_EQ_EMPTY; CONJ_ASSOC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH `!xn l. dist(xm,l) < e / &4 /\ dist(xn,l) < e / &4 /\ e <= dist(xn,yn) ==> e / &2 <= dist(xm:real^N,yn)`) THEN EXISTS_TAC `(f:real^M->real^N)(x((r:num->num) n))` THEN EXISTS_TAC `l:real^N` THEN ASM_SIMP_TAC[]]]; MP_TAC(ISPEC `\(r:num->num) n. @m. !k. k < n ==> (r:num->num) k < m /\ e <= dist(f(y(r k)),f(x m)) /\ e <= dist((f:real^M->real^N)(x(r k)),f(y m))` (MATCH_MP WF_REC WF_num)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` (LABEL_TAC "*")) THEN SUBGOAL_THEN `!n k. k < n ==> (r:num->num) k < r n /\ e <= dist(f(y(r k)),f(x (r n))) /\ e <= dist((f:real^M->real^N)(x(r k)),f(y (r n)))` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN REMOVE_THEN "*" (SUBST1_TAC o SPEC `n:num`) THEN CONV_TAC SELECT_CONV THEN SUBGOAL_THEN `bounded (IMAGE ((f:real^M->real^N) o x o (r:num->num)) {k | k < n} UNION IMAGE ((f:real^M->real^N) o y o (r:num->num)) {k | k < n})` MP_TAC THENL [MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_UNION] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC; o_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `B + e:real`) THEN SUBGOAL_THEN `FINITE(IMAGE (r:num->num) {k | k < n})` MP_TAC THENL [SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; ALL_TAC] THEN DISCH_THEN(MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[FORALL_IN_IMAGE; LEFT_IMP_EXISTS_THM; FORALL_IN_GSPEC] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MP_TAC(SPECL [`0`; `m:num`] FINITE_NUMSEG) THEN REWRITE_TAC[IMP_IMP; GSYM FINITE_UNION] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[INFINITE; num_INFINITE] `FINITE s ==> ~(s = (:num))`)) THEN REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; IN_ELIM_THM; LE_0] THEN REWRITE_TAC[REAL_NOT_LE; NOT_LE] THEN ASM_MESON_TAC[LET_TRANS; NORM_ARITH `norm x <= B /\ B + e < norm y ==> e <= dist(x:real^N,y)`]; REMOVE_THEN "*" (K ALL_TAC) ] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`IMAGE ((x:num->real^M) o r) (:num)`; `IMAGE ((y:num->real^M) o r) (:num)`]) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM IMAGE_o; o_DEF] THEN REWRITE_TAC[NOT_IMP; GSYM SETDIST_POS_LT] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN GEN_REWRITE_TAC I [REAL_LE_TRANS_LT] THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `b:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `(r:num->num) (MAX N n)`)) THEN REWRITE_TAC[LE_REFL; dist; VECTOR_SUB_RZERO] THEN ANTS_TAC THENL [TRANS_TAC LE_TRANS `MAX N n` THEN CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[MONOTONE_BIGGER]]; MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS)] THEN REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN SET_TAC[]; TRANS_TAC REAL_LTE_TRANS `e:real` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN REWRITE_TAC[IMAGE_EQ_EMPTY; CONJ_ASSOC; UNIV_NOT_EMPTY] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM_METIS_TAC[LT_CASES; DIST_SYM]]]);; (* ------------------------------------------------------------------------- *) (* Use set distance for an easy proof of separation properties etc. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_SEPARATED_UNION = prove (`!s t:real^N->bool. &0 < setdist(s,t) ==> open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t`, MATCH_MP_TAC(MESON[] `(!s t. P s t ==> P t s) /\ (!s t. Q t s ==> R s t) /\ (!s t. P s t ==> Q s t) ==> !s t. P s t ==> Q s t /\ R s t`) THEN CONJ_TAC THENL [REWRITE_TAC[SETDIST_SYM]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[UNION_COMM]; ALL_TAC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `{x + y:real^N | x IN s /\ y IN ball(vec 0,setdist(s,t))}` THEN SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; SUBSET_UNION] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; VECTOR_ADD_RID] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `DISJOINT t u ==> (s UNION t) INTER u SUBSET s`) THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN t ==> ~(x IN s)`] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `x:real^N`; `x + y:real^N`] SETDIST_LE_DIST) THEN ASM_SIMP_TAC[NORM_ARITH `~(p <= dist(x:real^N,x + y)) <=> norm y < p`]]);; let CLOSED_IN_SEPARATED_UNION = prove (`!s t:real^N->bool. &0 < setdist(s,t) ==> closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_UNION] THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SEPARATED_UNION) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SETDIST_POS_LT]) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] SETDIST_ZERO)) THEN SET_TAC[]);; let COMPACT_IN_SEPARATED_UNION = prove (`!s t:real^N->bool. compact(s UNION t) /\ &0 < setdist(s,t) ==> compact s /\ compact t`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SEPARATED_UNION) THEN ASM_MESON_TAC[CLOSED_IN_COMPACT]);; let CONNECTED_IMP_NONSEPARATED_UNION = prove (`!s t:real^N->bool. connected(s UNION t) ==> setdist(s,t) = &0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] SETDIST_ZERO)) THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM SETDIST_POS_LT]) THEN REWRITE_TAC[CONNECTED_CLOSED_IN] THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP CLOSED_IN_SEPARATED_UNION) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let SEPARATION_CLOSURES = prove (`!s t:real^N->bool. s INTER closure(t) = {} /\ t INTER closure(s) = {} ==> ?u v. DISJOINT u v /\ open u /\ open v /\ s SUBSET u /\ t SUBSET v`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `(:real^N)`] THEN ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `{x | x IN (:real^N) /\ lift(setdist({x},t) - setdist({x},s)) IN {x | &0 < x$1}}` THEN EXISTS_TAC `{x | x IN (:real^N) /\ lift(setdist({x},t) - setdist({x},s)) IN {x | x$1 < &0}}` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN SIMP_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN SIMP_TAC[OPEN_HALFSPACE_COMPONENT_LT; OPEN_UNIV] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ y = &0 /\ ~(x = &0) ==> &0 < x - y`); REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = &0 /\ ~(y = &0) ==> x - y < &0`)] THEN ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_BOUNDED; BOUNDED_SING] THEN ASM_SIMP_TAC[CLOSED_SING; CLOSURE_CLOSED; NOT_INSERT_EMPTY; REWRITE_RULE[SUBSET] CLOSURE_SUBSET; SET_RULE `{a} INTER s = {} <=> ~(a IN s)`] THEN ASM SET_TAC[]);; let SEPARATION_NORMAL = prove (`!s t:real^N->bool. closed s /\ closed t /\ s INTER t = {} ==> ?u v. open u /\ open v /\ s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN MATCH_MP_TAC SEPARATION_CLOSURES THEN ASM_SIMP_TAC[CLOSURE_CLOSED] THEN ASM SET_TAC[]);; let SEPARATION_NORMAL_LOCAL_CLOSURES = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ DISJOINT s t ==> ?s' t'. open_in (subtopology euclidean u) s' /\ open_in (subtopology euclidean u) t' /\ s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' /\ DISJOINT (subtopology euclidean u closure_of s') (subtopology euclidean u closure_of t')`, REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `u:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET; CLOSURE_OF_EMPTY] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `{}:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET; CLOSURE_OF_EMPTY] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},s) < setdist({x},t) / &2}` THEN EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},t) < setdist({x},s) / &2}` THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 < x <=> &0 < drop(lift x)`] THEN REWRITE_TAC[SET_RULE `{x | x IN u /\ &0 < drop(f x)} = {x | x IN u /\ f x IN {x | &0 < drop x}}`] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN REWRITE_TAC[drop; GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT] THEN SIMP_TAC[LIFT_SUB; LIFT_CMUL; ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_LIFT_SETDIST]; ALL_TAC] THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL [SIMP_TAC[SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; REAL_HALF] THEN REWRITE_TAC[SETDIST_POS_LT] THEN CONJ_TAC THEN MATCH_MP_TAC(MESON[] `(!x. P x ==> Q x) /\ (!x. P x /\ Q x ==> R x) ==> (!x. P x ==> Q x /\ R x)`) THEN (CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; SUBSET]; ALL_TAC]) THEN MP_TAC(ISPEC `u:real^N->bool` SETDIST_EQ_0_CLOSED_IN) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `x < y / &2 ==> y < x / &2 ==> &0 <= x ==> F`)) THEN ASM_REWRITE_TAC[SETDIST_POS_LE]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!s' t'. s' INTER t' = {} /\ (s SUBSET s' /\ t SUBSET t') ==> s INTER t = {}`) THEN MAP_EVERY EXISTS_TAC [`{x:real^N | x IN u /\ setdist({x},s) <= setdist({x},t) / &2}`; `{x:real^N | x IN u /\ setdist({x},t) <= setdist({x},s) / &2}`] THEN CONJ_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `x <= y / &2 ==> y <= x / &2 ==> &0 <= x ==> x = &0 /\ y = &0`)) THEN ASM_REWRITE_TAC[SETDIST_POS_LE] THEN MP_TAC(ISPEC `u:real^N->bool` SETDIST_EQ_0_CLOSED_IN) THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]; CONJ_TAC THEN MATCH_MP_TAC CLOSURE_OF_MINIMAL THEN SIMP_TAC[SUBSET; REAL_LT_IMP_LE; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 <= x <=> &0 <= drop(lift x)`] THEN REWRITE_TAC[SET_RULE `{x | x IN u /\ &0 <= drop(f x)} = {x | x IN u /\ f x IN {x | &0 <= drop x}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE] THEN SIMP_TAC[LIFT_SUB; LIFT_CMUL; ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_LIFT_SETDIST]]);; let SEPARATION_NORMAL_LOCAL = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} ==> ?s' t'. open_in (subtopology euclidean u) s' /\ open_in (subtopology euclidean u) t' /\ s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {}`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN DISCH_THEN(MP_TAC o MATCH_MP SEPARATION_NORMAL_LOCAL_CLOSURES) THEN MESON_TAC[]);; let SEPARATION_NORMAL_CLOSURES = prove (`!s t:real^N->bool. closed s /\ closed t /\ DISJOINT s t ==> ?s' t'. open s' /\ open t' /\ s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' /\ DISJOINT (closure s') (closure t')`, REWRITE_TAC[CLOSED_IN; OPEN_IN; GSYM EUCLIDEAN_CLOSURE_OF] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[SEPARATION_NORMAL_LOCAL_CLOSURES]);; let SEPARATION_NORMAL_COMPACT = prove (`!s t:real^N->bool. compact s /\ closed t /\ s INTER t = {} ==> ?u v. open u /\ compact(closure u) /\ open v /\ s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `t UNION ((:real^N) DIFF ball(vec 0,r))`] SEPARATION_NORMAL) THEN ASM_SIMP_TAC[CLOSED_UNION; GSYM OPEN_CLOSED; OPEN_BALL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSURE; ASM SET_TAC[]] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,r)` THEN REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]);; let SEPARATION_HAUSDORFF = prove (`!x:real^N y. ~(x = y) ==> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`{x:real^N}`; `{y:real^N}`] SEPARATION_NORMAL) THEN REWRITE_TAC[SING_SUBSET; CLOSED_SING] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let SEPARATION_T2 = prove (`!x:real^N y. ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[SEPARATION_HAUSDORFF] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[]);; let SEPARATION_T1 = prove (`!x:real^N y. ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ ~(y IN u) /\ ~(x IN v) /\ y IN v`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_SIMP_TAC[SEPARATION_T2; EXTENSION; NOT_IN_EMPTY; IN_INTER]; ALL_TAC] THEN MESON_TAC[]);; let SEPARATION_T0 = prove (`!x:real^N y. ~(x = y) <=> ?u. open u /\ ~(x IN u <=> y IN u)`, MESON_TAC[SEPARATION_T1]);; let CLOSED_IN_EQ_CONTINUOUS_LEVELSET = prove (`!u s a. closed_in (subtopology euclidean u) s <=> ?f:real^M->real^N. f continuous_on u /\ {x | x IN u /\ f x = a} = s`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `t:real^M->bool = {}` THENL [EXISTS_TAC `(\x. a + basis 1):real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`] THEN ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `(\x. a + setdist({x},t) % basis 1):real^M->real^N` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_LIFT_SETDIST]; REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; SETDIST_EQ_0_SING] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN SET_TAC[]]; EXPAND_TAC "s" THEN REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_SING]]);; let CLOSED_EQ_CONTINUOUS_LEVELSET = prove (`!s a. closed s <=> ?f:real^M->real^N. f continuous_on (:real^M) /\ {x | f x = a} = s`, ONCE_REWRITE_TAC[SET_RULE `{x | P x} = {x | x IN UNIV /\ P x}`] THEN REWRITE_TAC[GSYM CLOSED_IN_EQ_CONTINUOUS_LEVELSET] THEN REWRITE_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV]);; let CONNECTED = prove (`!s:real^N->bool. connected s <=> ~(?e1 e2. open e1 /\ open e2 /\ s SUBSET (e1 UNION e2) /\ e1 INTER e2 = {} /\ ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`, GEN_TAC THEN EQ_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THENL [REWRITE_TAC[connected] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SET_TAC[]; REWRITE_TAC[CONNECTED_SEPARATION; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c1:real^N->bool`; `c2:real^N->bool`] THEN STRIP_TAC THEN MP_TAC (ISPECL [`c1:real^N->bool`; `c2:real^N->bool`] SEPARATION_CLOSURES) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Connectedness of the intersection of a chain. *) (* ------------------------------------------------------------------------- *) let CONNECTED_CHAIN = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> compact s /\ connected s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> connected(INTERS f)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; CONNECTED_UNIV] THEN ABBREV_TAC `c:real^N->bool = INTERS f` THEN SUBGOAL_THEN `compact(c:real^N->bool)` ASSUME_TAC THENL [EXPAND_TAC "c" THEN MATCH_MP_TAC COMPACT_INTERS THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CONNECTED_CLOSED_SET; COMPACT_IMP_CLOSED; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`a:real^N->bool`; `b:real^N->bool`] SEPARATION_NORMAL) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `?k:real^N->bool. k IN f` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?n:real^N->bool. open n /\ k SUBSET n` MP_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET_BALL; COMPACT_IMP_BOUNDED; OPEN_BALL]; REWRITE_TAC[UNIONS_SUBSET] THEN STRIP_TAC] THEN MP_TAC(ISPEC `k:real^N->bool` COMPACT_IMP_HEINE_BOREL) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `(u UNION v:real^N->bool) INSERT {n DIFF s | s IN f}`) THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[OPEN_UNION; OPEN_DIFF; COMPACT_IMP_CLOSED; NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[UNIONS_INSERT] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[IN_UNION] THEN ASM_CASES_TAC `(x:real^N) IN c` THENL [ASM SET_TAC[]; DISJ2_TAC] THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN UNDISCH_TAC `~((x:real^N) IN c)` THEN SUBST1_TAC(SYM(ASSUME `INTERS f:real^N->bool = c`)) THEN REWRITE_TAC[IN_INTERS; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[SUBSET_INSERT_DELETE] THEN SUBGOAL_THEN `FINITE(g DELETE (u UNION v:real^N->bool))` MP_TAC THENL [ASM_REWRITE_TAC[FINITE_DELETE]; REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN REWRITE_TAC[FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?j:real^N->bool. j IN f /\ UNIONS(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)` STRIP_ASSUME_TAC THENL [ASM_CASES_TAC `f':(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; EMPTY_SUBSET] THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?j:real^N->bool. j IN f' /\ UNIONS(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN SUBGOAL_THEN `!s t:real^N->bool. s IN f' /\ t IN f' ==> s SUBSET t \/ t SUBSET s` MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN UNDISCH_TAC `~(f':(real^N->bool)->bool = {})` THEN UNDISCH_TAC `FINITE(f':(real^N->bool)->bool)` THEN SPEC_TAC(`f':(real^N->bool)->bool`,`f':(real^N->bool)->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[] THEN REWRITE_TAC[EXISTS_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_INSERT] THEN POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY X_GEN_TAC [`i:real^N->bool`; `f:(real^N->bool)->bool`] THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; NOT_IN_EMPTY; UNIONS_0; UNION_EMPTY; SUBSET_REFL] THEN DISCH_THEN(fun th -> REPEAT DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `j:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(n DIFF j) SUBSET (n DIFF i) \/ (n DIFF i:real^N->bool) SUBSET (n DIFF j)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `j:real^N->bool` o CONJUNCT2) THEN ASM SET_TAC[]; DISJ1_TAC THEN ASM SET_TAC[]; DISJ2_TAC THEN EXISTS_TAC `j:real^N->bool` THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `(j INTER k:real^N->bool) SUBSET (u UNION v)` ASSUME_TAC THENL [MATCH_MP_TAC(SET_RULE `k SUBSET (u UNION v) UNION (n DIFF j) ==> (j INTER k) SUBSET (u UNION v)`) THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `UNIONS g :real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `UNIONS((u UNION v:real^N->bool) INSERT (g DELETE (u UNION v)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[UNIONS_INSERT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `connected(j INTER k:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`; INTER_COMM]; REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let CONNECTED_CHAIN_GEN = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> closed s /\ connected s) /\ (?s. s IN f /\ compact s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> connected(INTERS f)`, GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `INTERS f = INTERS(IMAGE (\t:real^N->bool. s INTER t) f)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; INTERS_IMAGE] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_CHAIN THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[COMPACT_INTER_CLOSED] THEN CONJ_TAC THENL [X_GEN_TAC `t:real^N->bool`; ASM SET_TAC[]] THEN DISCH_TAC THEN SUBGOAL_THEN `s INTER t:real^N->bool = s \/ s INTER t = t` (DISJ_CASES_THEN SUBST1_TAC) THEN ASM SET_TAC[]]);; let CONNECTED_NEST = prove (`!s. (!n. compact(s n) /\ connected(s n)) /\ (!m n. m <= n ==> s n SUBSET s m) ==> connected(INTERS {s n | n IN (:num)})`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CHAIN THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; let CONNECTED_NEST_GEN = prove (`!s. (!n. closed(s n) /\ connected(s n)) /\ (?n. compact(s n)) /\ (!m n. m <= n ==> s n SUBSET s m) ==> connected(INTERS {s n | n IN (:num)})`, GEN_TAC THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN MATCH_MP_TAC CONNECTED_CHAIN_GEN THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM; EXISTS_IN_GSPEC] THEN MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hausdorff distance between sets. *) (* ------------------------------------------------------------------------- *) let hausdist = new_definition `hausdist(s:real^N->bool,t:real^N->bool) = let ds = {setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} in if ~(ds = {}) /\ (?b. !d. d IN ds ==> d <= b) then sup ds else &0`;; let HAUSDIST_POS_LE = prove (`!s t:real^N->bool. &0 <= hausdist(s,t)`, REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_SUP THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (!x. x IN s ==> P x) ==> ?y. y IN s /\ P y`) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE]);; let HAUSDIST_POS_LT = prove (`!s t:real^N->bool. &0 < hausdist(s,t) <=> ~(hausdist(s,t) = &0)`, REWRITE_TAC[REAL_LT_LE; HAUSDIST_POS_LE] THEN REAL_ARITH_TAC);; let REAL_ABS_HAUSDIST = prove (`!s t:real^N->bool. abs(hausdist(s,t)) = hausdist(s,t)`, REWRITE_TAC[real_abs; HAUSDIST_POS_LE]);; let HAUSDIST_REFL = prove (`!s:real^N->bool. hausdist(s,s) = &0`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE] THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_SUP_LE THEN REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; REAL_LE_REFL]);; let HAUSDIST_SYM = prove (`!s t:real^N->bool. hausdist(s,t) = hausdist(t,s)`, REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM] THEN REWRITE_TAC[]);; let HAUSDIST_EMPTY = prove (`(!t:real^N->bool. hausdist ({},t) = &0) /\ (!s:real^N->bool. hausdist (s,{}) = &0)`, REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x | x IN {}} = {}`; UNION_EMPTY] THEN REWRITE_TAC[SET_RULE `{c |x| x IN s} = {} <=> s = {}`] THEN X_GEN_TAC `s:real^N->bool` THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> {c |x| x IN s} = {c}`] THEN REWRITE_TAC[SUP_SING; COND_ID]);; let HAUSDIST_SINGS = prove (`!x y:real^N. hausdist({x},{y}) = dist(x,y)`, REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`] THEN REWRITE_TAC[DIST_SYM; UNION_IDEMPOT; SUP_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN MESON_TAC[REAL_LE_REFL]);; let HAUSDIST_SCALING = prove (`!a s t:real^N->bool. hausdist(IMAGE (\x. a % x) s,IMAGE (\x. a % x) t) = abs a * hausdist(s,t)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; HAUSDIST_EMPTY; IMAGE_CLAUSES] THEN ASM_CASES_TAC `a = &0` THENL [ASM_SIMP_TAC[VECTOR_MUL_LZERO; HAUSDIST_REFL; SET_RULE `~(s = {}) ==> IMAGE (\x. a) s = {a}`] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[hausdist; SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN REWRITE_TAC[SET_RULE `{a % x} = IMAGE (\x:real^N. a % x) {x}`] THEN REWRITE_TAC[SETDIST_SCALING; SET_RULE `{(c:real) * f x t | x IN s} UNION {c * f x s | x IN t} = IMAGE (\x. c * x) ({f x t | x IN s} UNION {f x s | x IN t})`] THEN ABBREV_TAC `ds = {setdist({y:real^N},t) | y IN s} UNION {setdist ({y},s) | y IN t}` THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN ASM_CASES_TAC `ds:real->bool = {}` THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; REAL_MUL_RZERO; FORALL_IN_IMAGE] THEN GEN_REWRITE_TAC RAND_CONV [COND_RAND] THEN MATCH_MP_TAC(MESON[] `y = b /\ (p <=> q) /\ (p /\ q ==> x = a) ==> (if p then x else y) = (if q then a else b)`) THEN REWRITE_TAC[REAL_MUL_RZERO] THEN CONJ_TAC THENL [EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THENL [EXISTS_TAC `b / abs a`; EXISTS_TAC `abs a * b`] THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN ASM_MESON_TAC[REAL_MUL_SYM]; DISCH_TAC THEN MATCH_MP_TAC SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN X_GEN_TAC `c:real` THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_SUP_LE_EQ THEN ASM_REWRITE_TAC[]]);; let th = prove (`!c. &0 < c ==> !s t. hausdist(IMAGE (\x. c % x) s,IMAGE (\x. c % x) t) = c * hausdist(s,t)`, SIMP_TAC[HAUSDIST_SCALING; REAL_ARITH `&0 < c ==> abs c = c`]) in add_scaling_theorems [th];; let HAUSDIST_EQ = prove (`!s t:real^M->bool s' t':real^N->bool. (!b. (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= b) <=> (!x. x IN s' ==> setdist({x},t') <= b) /\ (!y. y IN t' ==> setdist({y},s') <= b)) ==> hausdist(s,t) = hausdist(s',t')`, REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN MATCH_MP_TAC(MESON[] `(p <=> p') /\ s = s' ==> (if p then s else &0) = (if p' then s' else &0)`) THEN CONJ_TAC THENL [BINOP_TAC THENL [PURE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`]; AP_TERM_TAC THEN ABS_TAC]; MATCH_MP_TAC SUP_EQ] THEN PURE_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[GSYM DE_MORGAN_THM] THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `--(&1):real`) THEN SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> ~(x <= --(&1))`] THEN SET_TAC[]);; let HAUSDIST_TRANSLATION = prove (`!a s t:real^N->bool. hausdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = hausdist(s,t)`, REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN REWRITE_TAC[SET_RULE `{a + x:real^N} = IMAGE (\x. a + x) {x}`] THEN REWRITE_TAC[SETDIST_TRANSLATION]);; add_translation_invariants [HAUSDIST_TRANSLATION];; let HAUSDIST_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x. norm(f x) = norm x) ==> hausdist(IMAGE f s,IMAGE f t) = hausdist(s,t)`, REPEAT STRIP_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN ONCE_REWRITE_TAC[SET_RULE `{(f:real^M->real^N) x} = IMAGE f {x}`] THEN ASM_SIMP_TAC[SETDIST_LINEAR_IMAGE]);; add_linear_invariants [HAUSDIST_LINEAR_IMAGE];; let HAUSDIST_CLOSURE = prove (`(!s t:real^N->bool. hausdist(closure s,t) = hausdist(s,t)) /\ (!s t:real^N->bool. hausdist(s,closure t) = hausdist(s,t))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_EQ THEN GEN_TAC THEN BINOP_TAC THEN REWRITE_TAC[SETDIST_CLOSURE] THEN PURE_ONCE_REWRITE_TAC[SET_RULE `(!x. P x ==> Q x) <=> (!x. P x ==> x IN {x | Q x})`] THEN MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN REWRITE_TAC[EMPTY_GSPEC; CONTINUOUS_ON_ID; CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x <= b <=> drop(lift x) <= b`] THEN REWRITE_TAC[SET_RULE `{x | drop(lift(f x)) <= b} = {x | x IN UNIV /\ lift(f x) IN {x | drop x <= b}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_LIFT_SETDIST] THEN REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]);; let REAL_HAUSDIST_LE = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= b) ==> hausdist(s,t) <= b`, REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC REAL_SUP_LE THEN ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN ASM_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]);; let REAL_HAUSDIST_LE_SUMS = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ s SUBSET {y + z | y IN t /\ z IN cball(vec 0,b)} /\ t SUBSET {y + z | y IN s /\ z IN cball(vec 0,b)} ==> hausdist(s,t) <= b`, REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_MESON_TAC[SETDIST_LE_DIST; REAL_LE_TRANS; IN_SING]);; let REAL_LE_HAUSDIST = prove (`!s t:real^N->bool a b c z. ~(s = {}) /\ ~(t = {}) /\ (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= c) /\ (z IN s /\ a <= setdist({z},t) \/ z IN t /\ a <= setdist({z},s)) ==> a <= hausdist(s,t)`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL [MATCH_MP_TAC REAL_LE_SUP THEN ASM_SIMP_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM]] THEN EXISTS_TAC `max b c:real` THEN ASM_SIMP_TAC[REAL_LE_MAX] THEN ASM SET_TAC[]);; let SETDIST_LE_HAUSDIST = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> setdist(s,t) <= hausdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN REWRITE_TAC[CONJ_ASSOC] THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SETDIST_LE_SING; MEMBER_NOT_EMPTY]] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN CONJ_TAC THEN EXISTS_TAC `b:real` THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS; SETDIST_LE_DIST; MEMBER_NOT_EMPTY; IN_SING; DIST_SYM]);; let SETDIST_SING_LE_HAUSDIST = prove (`!s t x:real^N. bounded s /\ bounded t /\ x IN s ==> setdist({x},t) <= hausdist(s,t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_OR_THM; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN CONJ_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM dist] THEN GEN_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `~(t:real^N->bool = {})`; UNDISCH_TAC `~(s:real^N->bool = {})`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THENL [ALL_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; let SETDIST_HAUSDIST_TRIANGLE = prove (`!s t u:real^N->bool. ~(t = {}) /\ bounded t /\ bounded u ==> setdist(s,u) <= setdist(s,t) + hausdist(t,u)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN ASM_SIMP_TAC[SETDIST_EMPTY; REAL_LE_ADD; REAL_ADD_LID; SETDIST_POS_LE; HAUSDIST_POS_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= b + c <=> a - c <= b`] THEN ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ; NOT_INSERT_EMPTY; IN_SING] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN TRANS_TAC REAL_LE_TRANS `setdist({x:real^N},u)` THEN ASM_SIMP_TAC[SETDIST_LE_SING] THEN MP_TAC(ISPECL [`u:real^N->bool`; `x:real^N`; `y:real^N`] SETDIST_SING_TRIANGLE) THEN MATCH_MP_TAC(REAL_ARITH `yu <= z ==> abs(xu - yu) <= d ==> xu <= d + z`) THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_REWRITE_TAC[]);; let HAUSDIST_SETDIST_TRIANGLE = prove (`!s t u:real^N->bool. ~(t = {}) /\ bounded s /\ bounded t ==> setdist(s,u) <= hausdist(s,t) + setdist(t,u)`, ONCE_REWRITE_TAC[SETDIST_SYM; HAUSDIST_SYM] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN SIMP_TAC[SETDIST_HAUSDIST_TRIANGLE]);; let REAL_LT_HAUSDIST_POINT_EXISTS = prove (`!s t x:real^N d. bounded s /\ bounded t /\ ~(t = {}) /\ hausdist(s,t) < d /\ x IN s ==> ?y. y IN t /\ dist(x,y) < d`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`; `d:real`] REAL_SETDIST_LT_EXISTS) THEN REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN TRANS_TAC REAL_LET_TRANS `hausdist(s:real^N->bool,t)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_REWRITE_TAC[]);; let HAUSDIST_UNIFORMLY_CONTINUOUS_ON = prove (`!f:real^M->real^N s. f uniformly_continuous_on s <=> !e. &0 < e ==> ?d. &0 < d /\ !t t'. t SUBSET s /\ t' SUBSET s /\ bounded t /\ bounded t' /\ hausdist(t',t) < d ==> hausdist(IMAGE f t',IMAGE f t) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `t':real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_CASES_TAC `t:real^M->bool = {}` THEN ASM_SIMP_TAC[HAUSDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `t':real^M->bool = {}` THEN ASM_SIMP_TAC[HAUSDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN CONJ_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THENL [MP_TAC(ISPECL [`t':real^M->bool`; `t:real^M->bool`; `x:real^M`; `d / &2`] REAL_LT_HAUSDIST_POINT_EXISTS); MP_TAC(ISPECL [`t:real^M->bool`; `t':real^M->bool`; `x:real^M`; `d / &2`] REAL_LT_HAUSDIST_POINT_EXISTS)] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `x:real^M`]) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[REAL_ARITH `x < d / &2 /\ &0 < d ==> x < d`] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e / &2 ==> x <= e / &2`) THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_SIMP_TAC[IN_SING; FUN_IN_IMAGE]; MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN REWRITE_TAC[GSYM HAUSDIST_SINGS] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{f x} = IMAGE f {x}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SING_SUBSET; BOUNDED_SING]]);; let SUBSET_COMPACT_HAUSDIST_LIMIT = prove (`!f s t:real^N->bool. compact s /\ ~(s = {}) /\ (!n. t SUBSET f n) /\ (!n. bounded(f n)) /\ ((\n. lift(hausdist (f n,s))) --> vec 0) sequentially ==> t SUBSET s`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `setdist({x:real^N},s) = &0` MP_TAC THENL [GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`]; ASM_SIMP_TAC[SETDIST_EQ_0_SING; CLOSURE_CLOSED; COMPACT_IMP_CLOSED]] THEN PURE_REWRITE_TAC[GSYM SETDIST_POS_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `setdist({x:real^N},s)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[DIST_0; NORM_LIFT; REAL_ABS_HAUSDIST; LE_REFL] THEN REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]);; let UPPER_LOWER_HEMICONTINUOUS = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) /\ (!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) /\ (!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) ==> !x e. x IN s /\ &0 < e /\ bounded(f x) ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x,x') < d ==> hausdist(f x,f x') < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(f:real^M->real^N->bool) x = {}` THENL [ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`] o MATCH_MP UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `t INTER ball(vec 0:real^N,r)` o CONJUNCT1 o CONJUNCT2) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ASM_SIMP_TAC[SUBSET_INTER; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x':real^M`)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `(f:real^M->real^N->bool) x' = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; IN_SING; REAL_LT_IMP_LE]);; let HAUSDIST_NONTRIVIAL = prove (`!s t:real^N->bool. bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = sup({setdist ({x},t) | x IN s} UNION {setdist ({y},s) | y IN t})`, REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN ASM_SIMP_TAC[EMPTY_UNION; SIMPLE_IMAGE; IMAGE_EQ_EMPTY] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let HAUSDIST_NONTRIVIAL_ALT = prove (`!s t:real^N->bool. bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = max (sup {setdist ({x},t) | x IN s}) (sup {setdist ({y},s) | y IN t})`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL] THEN MATCH_MP_TAC SUP_UNION THEN ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN CONJ_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let REAL_HAUSDIST_LE_EQ = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ bounded s /\ bounded t ==> (hausdist(s,t) <= b <=> (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= b))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL_ALT; REAL_MAX_LE] THEN BINOP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x <= b) <=> (!y. y IN {f x | x IN s} ==> y <= b)`] THEN MATCH_MP_TAC REAL_SUP_LE_EQ THEN ASM_REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let HAUSDIST_UNION_LE = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u /\ ~(t = {}) /\ ~(u = {}) ==> hausdist(s UNION t,s UNION u) <= hausdist(t,u)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ; BOUNDED_UNION; EMPTY_UNION] THEN REWRITE_TAC[FORALL_IN_UNION] THEN SIMP_TAC[SETDIST_SING_IN_SET; IN_UNION; HAUSDIST_POS_LE] THEN ASM_SIMP_TAC[GSYM REAL_HAUSDIST_LE_EQ; BOUNDED_UNION; EMPTY_UNION] THEN CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL [TRANS_TAC REAL_LE_TRANS `setdist({x:real^N},u)`; TRANS_TAC REAL_LE_TRANS `setdist({x:real^N},t)`] THEN ASM_SIMP_TAC[SETDIST_SUBSET_RIGHT; SUBSET_UNION] THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_REWRITE_TAC[]);; let HAUSDIST_INSERT_LE = prove (`!s t a:real^N. bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(a INSERT s,a INSERT t) <= hausdist(s,t)`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN ASM_SIMP_TAC[HAUSDIST_UNION_LE; NOT_INSERT_EMPTY; BOUNDED_SING]);; let HAUSDIST_COMPACT_EXISTS = prove (`!s t:real^N->bool. bounded s /\ compact t /\ ~(t = {}) ==> !x. x IN s ==> ?y. y IN t /\ dist(x,y) <= hausdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN ASM_SIMP_TAC[COMPACT_SING; COMPACT_IMP_CLOSED; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; UNWIND_THM2; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let HAUSDIST_TRIANGLE = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u /\ ~(t = {}) ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)`, ONCE_REWRITE_TAC[GSYM(CONJUNCT1 HAUSDIST_CLOSURE)] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT2 HAUSDIST_CLOSURE)] THEN ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM CLOSURE_EQ_EMPTY] THEN REPEAT GEN_TAC THEN MAP_EVERY (fun t -> SPEC_TAC(mk_comb(`closure:(real^N->bool)->real^N->bool`,t),t)) [`u:real^N->bool`; `t:real^N->bool`; `s:real^N->bool`] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_ADD_LID] THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_ADD_RID] THEN ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ; COMPACT_IMP_BOUNDED] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [HAUSDIST_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`u:real^N->bool`; `t:real^N->bool`; `s:real^N->bool`] THEN MATCH_MP_TAC(MESON[] `(!s t u. P s t u ==> P u t s) /\ (!s t u. P s t u ==> Q s t u) ==> (!s t u. P s t u ==> Q s t u /\ Q u t s)`) THEN CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI]; REPEAT GEN_TAC THEN STRIP_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?y:real^N. y IN t /\ dist(x,y) <= hausdist(s,t)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN SUBGOAL_THEN `?z:real^N. z IN u /\ dist(y,z) <= hausdist(t,u)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH `dist(y,z) <= b ==> dist(x,y) <= a /\ s <= dist(x,z) ==> s <= a + b`)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; let HAUSDIST_COMPACT_SUMS = prove (`!s t:real^N->bool. bounded s /\ compact t /\ ~(t = {}) ==> s SUBSET {y + z | y IN t /\ z IN cball(vec 0,hausdist(s,t))}`, REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[GSYM dist; HAUSDIST_COMPACT_EXISTS]);; let HAUSDIST_SUMS_LE = prove (`!s t u v:real^N->bool. bounded s /\ bounded t /\ bounded u /\ bounded v ==> hausdist({x + y | x IN s /\ y IN t},{x + y | x IN u /\ y IN v}) <= hausdist(s,u) + hausdist(t,v)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 HAUSDIST_CLOSURE)] THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT2 HAUSDIST_CLOSURE)] THEN SIMP_TAC[CLOSURE_SUMS] THEN ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE] THEN MAP_EVERY (fun t -> SPEC_TAC(mk_comb(`closure:(real^N->bool)->real^N->bool`,t),t)) [`v:real^N->bool`; `u:real^N->bool`; `t:real^N->bool`; `s:real^N->bool`] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `{x + y:real^N | x IN s /\ y IN t} = {}` THEN ASM_SIMP_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_LE_ADD] THEN ASM_CASES_TAC `{x + y:real^N | x IN u /\ y IN v} = {}` THEN ASM_SIMP_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_LE_ADD] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THENL [MP_TAC(ISPECL [`t:real^N->bool`; `v:real^N->bool`] HAUSDIST_COMPACT_EXISTS) THEN MP_TAC(ISPECL [`s:real^N->bool`; `u:real^N->bool`] HAUSDIST_COMPACT_EXISTS); MP_TAC(ISPECL [`v:real^N->bool`; `t:real^N->bool`] HAUSDIST_COMPACT_EXISTS) THEN MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`] HAUSDIST_COMPACT_EXISTS)] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `a:real^N`)]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `b:real^N`)]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN TRANS_TAC REAL_LE_TRANS `dist(a + b:real^N,c + d)` THEN (CONJ_TAC THENL [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LT])) THEN CONV_TAC NORM_ARITH]));; let HAUSDIST_SUMS_LE_LCANCEL = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u ==> hausdist({x + y | x IN s /\ y IN t},{x + y | x IN s /\ y IN u}) <= hausdist(t,u)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) HAUSDIST_SUMS_LE o lhand o snd) THEN ASM_REWRITE_TAC[HAUSDIST_REFL; REAL_ADD_LID]);; let HAUSDIST_SUMS_LE_RCANCEL = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u ==> hausdist({x + y | x IN s /\ y IN u},{x + y | x IN t /\ y IN u}) <= hausdist(s,t)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) HAUSDIST_SUMS_LE o lhand o snd) THEN ASM_REWRITE_TAC[HAUSDIST_REFL; REAL_ADD_RID]);; let HAUSDIST_TRANS = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u /\ ~(t = {}) ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)`, let lemma = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u /\ ~(s = {}) /\ ~(t = {}) /\ ~(u = {}) ==> !x. x IN s ==> setdist({x},u) <= hausdist(s,t) + hausdist(t,u)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `closure t:real^N->bool`] HAUSDIST_COMPACT_EXISTS) THEN ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`closure t:real^N->bool`; `closure u:real^N->bool`] HAUSDIST_COMPACT_EXISTS) THEN ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z)` THEN CONJ_TAC THENL [ASM_MESON_TAC[SETDIST_CLOSURE; SETDIST_LE_DIST; IN_SING]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y) + dist(y,z)` THEN REWRITE_TAC[DIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_LID; HAUSDIST_POS_LE] THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_RID; HAUSDIST_POS_LE] THEN ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ] THEN ASM_MESON_TAC[lemma; HAUSDIST_SYM; SETDIST_SYM; REAL_ADD_SYM]);; let HAUSDIST_EQ_0 = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> (hausdist(s,t) = &0 <=> s = {} \/ t = {} \/ closure s = closure t)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE; REAL_HAUSDIST_LE_EQ] THEN SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN ASM_REWRITE_TAC[SETDIST_EQ_0_SING; GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN SIMP_TAC[FORALL_IN_CLOSURE_EQ; CLOSED_CLOSURE; CONTINUOUS_ON_ID]);; let HAUSDIST_COMPACT_NONTRIVIAL = prove (`!s t:real^N->bool. compact s /\ compact t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = inf {e | &0 <= e /\ s SUBSET {x + y | x IN t /\ norm y <= e} /\ t SUBSET {x + y | x IN s /\ norm y <= e}}`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[GSYM dist] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; IN_SING; REAL_LT_IMP_LE]; REPEAT STRIP_TAC THEN EXISTS_TAC `hausdist(s:real^N->bool,t)` THEN ASM_REWRITE_TAC[HAUSDIST_POS_LE] THEN ASM_MESON_TAC[DIST_SYM; HAUSDIST_SYM; HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]]);; let HAUSDIST_BALLS = prove (`(!a b:real^N r s. hausdist(ball(a,r),ball(b,s)) = if r <= &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ (!a b:real^N r s. hausdist(ball(a,r),cball(b,s)) = if r <= &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s)) /\ (!a b:real^N r s. hausdist(cball(a,r),ball(b,s)) = if r < &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ (!a b:real^N r s. hausdist(cball(a,r),cball(b,s)) = if r < &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s))`, REWRITE_TAC[MESON[] `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; HAUSDIST_EMPTY; DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] `hausdist(s,t) = hausdist(closure s,closure t)`] THEN SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN REWRITE_TAC[HAUSDIST_CLOSURE] THEN MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT STRIP_TAC] THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; BOUNDED_CBALL; CBALL_EQ_EMPTY; REAL_NOT_LT] THEN MATCH_MP_TAC SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN REWRITE_TAC[MESON[CBALL_SING] `{a} = cball(a:real^N,&0)`] THEN ASM_REWRITE_TAC[SETDIST_BALLS; REAL_LT_REFL] THEN X_GEN_TAC `c:real` THEN REWRITE_TAC[IN_CBALL] THEN EQ_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_REWRITE_TAC[DIST_SYM; DIST_REFL; REAL_MAX_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `a + r % basis 1:real^N`) (MP_TAC o SPEC `a + s % basis 1:real^N`)) THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `a - r / dist(a,b) % (b - a):real^N`) (MP_TAC o SPEC `b - s / dist(a,b) % (a - b):real^N`)) THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH `b - e % (a - b) - a:real^N = (&1 + e) % (b - a)`] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN REWRITE_TAC[NORM_SUB; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let HAUSDIST_ALT = prove (`!s t:real^N->bool. bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = sup {abs(setdist({x},s) - setdist({x},t)) | x IN (:real^N)}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM(CONJUNCT2 SETDIST_CLOSURE); GSYM CLOSURE_EQ_EMPTY; MESON[HAUSDIST_CLOSURE] `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; COMPACT_IMP_BOUNDED] THEN MATCH_MP_TAC SUP_EQ THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC; IN_UNIV] THEN REWRITE_TAC[REAL_ARITH `abs(y - x) <= b <=> x <= y + b /\ y <= x + b`] THEN GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN BINOP_TAC THEN (EQ_TAC THENL [ALL_TAC; MESON_TAC[SETDIST_SING_IN_SET; REAL_ADD_LID]]) THEN DISCH_TAC THEN X_GEN_TAC `z:real^N` THENL [MP_TAC(ISPECL[`{z:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT); MP_TAC(ISPECL[`{z:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL [MP_TAC(ISPECL[`{y:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT); MP_TAC(ISPECL[`{y:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `dist(z:real^N,x)` THEN ASM_SIMP_TAC[SETDIST_LE_DIST; IN_SING] THEN UNDISCH_TAC `dist(y:real^N,x) <= b` THEN CONV_TAC NORM_ARITH);; let DIAMETERS_HAUSDIST_BOUND = prove (`!s t:real^N->bool. bounded s /\ ~(s = {}) /\ bounded t /\ ~(t = {}) ==> abs(diameter s - diameter t) <= &2 * hausdist(s,t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIAMETER_CLOSURE] THEN MP_TAC(ISPECL [`vec 0:real^N`; `hausdist(s:real^N->bool,t)`] DIAMETER_CBALL) THEN ASM_SIMP_TAC[HAUSDIST_POS_LE; GSYM REAL_NOT_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `x <= y + e /\ y <= x + e ==> abs(x - y) <= e`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) DIAMETER_SUMS o rand o snd) THEN ASM_SIMP_TAC[BOUNDED_CBALL; BOUNDED_CLOSURE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC DIAMETER_SUBSET THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL; BOUNDED_CLOSURE] THEN ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY]);; let CONTINUOUS_DIAMETER = prove (`!s:real^N->bool e. bounded s /\ ~(s = {}) /\ &0 < e ==> ?d. &0 < d /\ !t. bounded t /\ ~(t = {}) /\ hausdist(s,t) < d ==> abs(diameter s - diameter t) < e`, REPEAT STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LET_TRANS `&2 * hausdist(s:real^N->bool,t)` THEN ASM_SIMP_TAC[DIAMETERS_HAUSDIST_BOUND] THEN ASM_REAL_ARITH_TAC);; let CONNECTED_HAUSDIST_LIMIT = prove (`!s k:real^N->bool. (!n. bounded(s n) /\ connected(s n) /\ ~(s n = {})) /\ compact k /\ ((\n. lift (hausdist(s n,k))) --> vec 0) sequentially ==> connected k`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `compact(k1:real^N->bool) /\ compact(k2:real^N->bool)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN ABBREV_TAC `e = setdist(k1:real^N->bool,k2)` THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [EXPAND_TAC "e" THEN REWRITE_TAC[SETDIST_POS_LT] THEN ASM_SIMP_TAC[SETDIST_EQ_0_CLOSED_COMPACT; COMPACT_IMP_CLOSED]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; DIST_1; DROP_VEC; LIFT_DROP; REAL_SUB_RZERO] THEN REWRITE_TAC[real_abs; HAUSDIST_POS_LE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC `n:num`) THEN REWRITE_TAC[connected] THEN MAP_EVERY EXISTS_TAC [`{x + y:real^N | x IN k1 /\ y IN ball(vec 0,e / &2)}`; `{x + y:real^N | x IN k2 /\ y IN ball(vec 0,e / &2)}`] THEN SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SET_RULE `{f x y | x IN s /\ y IN t} UNION {f x y | x IN s' /\ y IN t} = {f x y | x IN s UNION s' /\ y IN t}`] THEN MP_TAC(ISPECL [`(s:num->real^N->bool) n`; `k:real^N->bool`] HAUSDIST_COMPACT_SUMS) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s SUBSET {f x y | x IN k /\ y IN t} ==> s SUBSET {f x y | x IN k /\ y IN u}`) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x y a b. (x IN s /\ y IN t) /\ a IN u /\ b IN u ==> ~(f x a = f y b)) ==> {f x a | x IN s /\ a IN u} INTER {f x a | x IN t /\ a IN u} INTER v = {}`) THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN REWRITE_TAC[IN_BALL_0] THEN MATCH_MP_TAC(NORM_ARITH `e <= dist(x:real^N,y) ==> norm a < e / &2 /\ norm b < e / &2 ==> ~(x + a = y + b)`) THEN ASM_MESON_TAC[SETDIST_LE_DIST]; ALL_TAC] THEN CONJ_TAC THEN REWRITE_TAC[SET_RULE `~(s INTER t = {}) <=> ?x. x IN s /\ x IN t`] THEN REWRITE_TAC[EXISTS_IN_GSPEC; IN_BALL_0] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `~(k = {}) ==> (!x. x IN k ==> ?y. R x y /\ P y) ==> ?x y. (x IN k /\ P y) /\ R x y`)) THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[] `!x:real^N. (?y. P(y - x)) ==> ?y. P y`) THEN EXISTS_TAC `x:real^N` THEN REWRITE_TAC[VECTOR_SUB_ADD2] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]);; let HAUSDIST_COMPACT_INTERS_LIMIT = prove (`!s:num->(real^N->bool). (!n. compact(s n)) /\ (!n. s(SUC n) SUBSET s n) ==> ((\n. lift(hausdist(s n,INTERS {s i | i IN (:num)}))) --> vec 0) sequentially`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!m n. m <= n ==> (s:num->real^N->bool) n SUBSET s m` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `?n. (s:num->real^N->bool) n = {}` THENL [FIRST_X_ASSUM(X_CHOOSE_TAC `N:num`) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `(s:num->real^N->bool) n = {}` SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[HAUSDIST_EMPTY; LIFT_NUM]]; RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM])] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `?r:num->num. (!n. e <= hausdist(s(r n):real^N->bool,INTERS {s i | i IN (:num)})) /\ (!n. r n < r (SUC n))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `n + 1`) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[DIST_0; NORM_LIFT] THEN SIMP_TAC[real_abs; HAUSDIST_POS_LE; REAL_NOT_LT] THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n:num. ?x:real^N. x IN s(r n) /\ e / &2 <= setdist({x},INTERS {s i | i IN (:num)})` MP_TAC THENL [GEN_TAC THEN MP_TAC(ISPECL [`(s:num->real^N->bool)(r(n:num))`; `INTERS {s i | i IN (:num)}:real^N->bool`; `e / &2`] REAL_HAUSDIST_LE) THEN ASM_SIMP_TAC[COMPACT_NEST] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ e <= x ==> ~(x <= e / &2)`] THEN REWRITE_TAC[TAUT `~(p /\ q) <=> q ==> ~p`] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_TOTAL]] THEN SIMP_TAC[SETDIST_SING_IN_SET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC)] THEN MP_TAC(ISPEC `s 0:real^N->bool` compact) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_0]; REWRITE_TAC[NOT_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`y:real^N`; `k:num->num`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; REAL_NOT_LT; o_THM] THEN TRANS_TAC REAL_LE_TRANS `setdist({(x:num->real^N)(k(n:num))}, INTERS {s i | i IN (:num)})` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[IN_SING; INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `setdist({y},(s:num->real^N->bool) n)`) THEN ASM_SIMP_TAC[SETDIST_POS_LT; SETDIST_EQ_0_CLOSED; COMPACT_IMP_CLOSED] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `MAX N n`)) THEN REWRITE_TAC[o_THM; NOT_IMP; REAL_NOT_LT] THEN CONJ_TAC THENL [ARITH_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[IN_SING] THEN MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN EXISTS_TAC `(s:num->real^N->bool)((r:num->num)(k(MAX N n)))` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN TRANS_TAC LE_TRANS `MAX N n` THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN SPEC_TAC(`MAX N n`,`m:num`) THEN X_GEN_TAC `m:num` THEN TRANS_TAC LE_TRANS `(k:num->num) m` THEN ASM_SIMP_TAC[MONOTONE_BIGGER] THEN SPEC_TAC(`(k:num->num) m`,`p:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hausdorff metric inherits completeness, total boundedness, compactness. *) (* ------------------------------------------------------------------------- *) let COMPLETE_HAUSDIST_UNIV = prove (`!f:num->(real^N->bool). (!n. bounded(f n) /\ ~(f n = {})) /\ (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> hausdist(f m,f n) < e) ==> ?s. compact s /\ ~(s = {}) /\ ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially`, SUBGOAL_THEN `!f:num->(real^N->bool). (!n. bounded(f n) /\ ~(f n = {})) /\ (!m n. m <= n ==> hausdist(f m,f n) < inv(&2 pow m)) ==> ?s. bounded s /\ ~(s = {}) /\ ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially` ASSUME_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(?s. P(closure s)) ==> ?s. P s`) THEN REWRITE_TAC[COMPACT_CLOSURE; HAUSDIST_CLOSURE; CLOSURE_EQ_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `N:num->num`) THEN SUBGOAL_THEN `?r:num->num. (!n. N n <= r n) /\ (!n. r(n) < r(SUC n))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN REWRITE_TAC[ARITH_RULE `a <= x /\ b < x <=> MAX a (SUC b) <= x`] THEN MESON_TAC[LE_REFL]; FIRST_X_ASSUM(MP_TAC o SPEC `(f:num->(real^N->bool)) o (r:num->num)`) THEN ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE] THEN SUBGOAL_THEN `!i j. i <= j ==> (r:num->num) i <= r j` (fun th -> ASM_MESON_TAC[LE_TRANS; th]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[LT_IMP_LE] THEN ARITH_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. hausdist((f:num->(real^N->bool)) n,f(r n))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM dist; DIST_LIFT] THEN REWRITE_TAC[REAL_ARITH `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [HAUSDIST_SYM]; ALL_TAC] THEN MATCH_MP_TAC HAUSDIST_TRIANGLE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_HAUSDIST] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `(N:num->num) M` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LT_TRANS `inv(&2 pow M)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(ARITH_RULE `a:num <= n /\ n <= r ==> n >= a /\ r >= a`) THEN ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS]]]]] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `s:real^N->bool = {l | ?x:num->real^N. (!n. x n IN f n) /\ (!n. dist(x n,x(SUC n)) < inv(&2 pow n)) /\ (x --> l) sequentially}` THEN EXISTS_TAC `s:real^N->bool` THEN SUBGOAL_THEN `!n. f n SUBSET {x + y:real^N | x IN s /\ y IN cball(vec 0,&2 / &2 pow n)}` ASSUME_TAC THENL [X_GEN_TAC `k:num` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?x. x k:real^N = a /\ (!n. x n IN f n) /\ (!n. dist(x n,x (SUC n)) < inv(&2 pow n))` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `?y. y 0 = a /\ (!n. y n IN f(k + n)) /\ (!n. dist(y n:real^N,y(SUC n)) < inv(&2 pow (k + n)))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE_FIXED THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN EXISTS_TAC `(f:num->(real^N->bool)) (k + n)` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `?z. z 0 = a /\ (!n. z n IN f(k - n)) /\ (!n. dist(z n:real^N,z(SUC n)) < inv(&2 pow (k - SUC n)))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE_FIXED THEN ASM_REWRITE_TAC[SUB_0] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN DISCH_TAC THEN ASM_CASES_TAC `k:num <= n` THENL [EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_LT_POW2] THEN ASM_MESON_TAC[ARITH_RULE `k <= n ==> k - SUC n = k - n`]; MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN EXISTS_TAC `(f:num->(real^N->bool)) (k - n)` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN EXISTS_TAC `\n. if k <= n then (y:num->real^N)(n - k) else z(k - n)` THEN ASM_REWRITE_TAC[LE_REFL; SUB_REFL] THEN CONJ_TAC THEN X_GEN_TAC `n:num` THENL [ASM_MESON_TAC[ARITH_RULE `(k:num <= n ==> k + (n - k) = n) /\ (~(k <= n) ==> k - (k - n) = n)`]; ALL_TAC] THEN ASM_CASES_TAC `SUC n = k` THEN ASM_REWRITE_TAC[LE_REFL] THENL [ASM_SIMP_TAC[ARITH_RULE `SUC n = k ==> ~(k <= n)`; SUB_REFL] THEN ASM_SIMP_TAC[ARITH_RULE `SUC n = k ==> k - n = SUC 0`] THEN SUBST1_TAC(SYM(ASSUME `(z:num->real^N) 0 = a`)) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `SUC n = k ==> n = k - SUC 0`)) THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `k <= SUC n <=> k <= n` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`] THEN ASM_MESON_TAC[ARITH_RULE `k:num <= n ==> k + n - k = n`]; ASM_SIMP_TAC[ARITH_RULE `~(k <= n) ==> k - n = SUC(k - SUC n)`] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_MESON_TAC[ARITH_RULE `~(k <= n) ==> k - SUC(k - SUC n) = n`]]; ALL_TAC] THEN SUBGOAL_THEN `cauchy(x:num->real^N)` MP_TAC THENL [MATCH_MP_TAC ABSOLUTELY_SUMMABLE_IMP_CAUCHY THEN REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC SUMMABLE_COMPARISON THEN EXISTS_TAC `\n. inv(&2 pow n)` THEN ASM_SIMP_TAC[NORM_LIFT; REAL_ABS_DIST; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_INV_POW; o_DEF] THEN MATCH_MP_TAC SUMMABLE_REAL_GP THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `l:real^N = x + y <=> y = l - x`] THEN REWRITE_TAC[UNWIND_THM2] THEN ASM_REWRITE_TAC[IN_CBALL_0] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. a - (x:num->real^N) n` THEN ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY; LIM_CONST] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBST1_TAC(SYM(ASSUME `(x:num->real^N) k = a`)) THEN TRANS_TAC REAL_LE_TRANS `norm(vsum (k..m - 1) (\i. (x:num->real^N)(i + 1) - x i))` THEN CONJ_TAC THENL [REWRITE_TAC[VSUM_DIFFS_ALT] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `k + 1 <= m ==> m - 1 + 1 = m /\ k <= m - 1`) th]) THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG]] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN TRANS_TAC REAL_LE_TRANS `sum (k..m-1) (\i. inv(&2 pow i))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[GSYM ADD1; REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[REAL_INV_POW; SUM_GP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= inv y ==> x / (&1 / &2) <= &2 / y`) THEN REWRITE_TAC[REAL_POW_DIV; REAL_POW_ONE] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 * y - &1 * x <= y`) THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p /\ r) ==> p /\ q /\ r`) THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `!n. s SUBSET {x + y:real^N | x IN f n /\ y IN cball(vec 0,&2 / &2 pow n)}` ASSUME_TAC THENL [X_GEN_TAC `n:num` THEN EXPAND_TAC "s" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `l:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `l:real^N = x + y <=> y = l - x`] THEN REWRITE_TAC[UNWIND_THM2] THEN EXISTS_TAC `(x:num->real^N) n` THEN ASM_REWRITE_TAC[IN_CBALL_0] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\m. (x:num->real^N) m - x n` THEN ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY; LIM_CONST] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `norm(vsum (n..m - 1) (\i. (x:num->real^N)(i + 1) - x i))` THEN CONJ_TAC THENL [REWRITE_TAC[VSUM_DIFFS_ALT] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `n + 1 <= m ==> m - 1 + 1 = m /\ n <= m - 1`) th]) THEN REWRITE_TAC[REAL_LE_REFL]; MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG]] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN TRANS_TAC REAL_LE_TRANS `sum (n..m-1) (\i. inv(&2 pow i))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[GSYM ADD1; REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[REAL_INV_POW; SUM_GP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= inv y ==> x / (&1 / &2) <= &2 / y`) THEN REWRITE_TAC[REAL_POW_DIV; REAL_POW_ONE] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 * y - &1 * x <= y`) THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{x + y:real^N | x IN f n /\ y IN cball(vec 0,&2 / &2 pow n)}` THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL]; DISCH_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0; NORM_LIFT; REAL_ABS_HAUSDIST] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e / &2`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV; REAL_HALF] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `inv i < e / &2 ==> x <= &2 / i ==> x < e`)) THEN TRANS_TAC REAL_LE_TRANS `&2 / &2 pow m` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_ARITH `&2 / x <= &2 / y <=> inv x <= inv y`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; let COMPLETE_HAUSDIST = prove (`!f:num->(real^N->bool) c. closed c /\ (!n. bounded(f n) /\ ~(f n = {}) /\ f n SUBSET c) /\ (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> hausdist(f m,f n) < e) ==> ?s. compact s /\ ~(s = {}) /\ s SUBSET c /\ ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:num->(real^N->bool)` COMPLETE_HAUSDIST_UNIV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CLOSURE_CLOSED) THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL; DIST_0; NORM_LIFT; REAL_ABS_HAUSDIST] THEN DISCH_TAC THEN SUBGOAL_THEN `?y. y IN (f:num->(real^N->bool)) n /\ dist(y,x) < e` MP_TAC THENL [ONCE_REWRITE_TAC[DIST_SYM]; ASM SET_TAC[]] THEN MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ASM_MESON_TAC[HAUSDIST_SYM]);; let TOTALLY_BOUNDED_HAUSDIST = prove (`!s:real^N->bool e. bounded s /\ &0 < e ==> ?k. FINITE k /\ (!u. u IN k ==> ~(u = {}) /\ u SUBSET s) /\ (!t. t SUBSET s /\ ~(t = {}) ==> ?u. u IN k /\ hausdist(t,u) < e)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` COMPACT_IMP_TOTALLY_BOUNDED) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{s INTER {x + y:real^N | x IN c /\ y IN ball(vec 0,e / &4)} | c SUBSET k} DELETE {}` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_DELETE; IMP_CONJ; INTER_SUBSET] THEN REWRITE_TAC[FINITE_DELETE; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE; EXISTS_IN_IMAGE] THEN X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT DISCH_TAC THEN EXISTS_TAC `{x:real^N | x IN k /\ ~(ball(x,e / &4) INTER t = {})}` THEN REWRITE_TAC[SUBSET_RESTRICT; IN_ELIM_THM] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `~(s INTER t = {}) <=> ?x. x IN t /\ x IN s`] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN SUBGOAL_THEN `?x:real^N. x IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE `closure s SUBSET u ==> !x. x IN t /\ t SUBSET s /\ s SUBSET closure s ==> x IN u`)) THEN ASM_REWRITE_TAC[CLOSURE_SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_BALL_0]] THEN SUBGOAL_THEN `(y:real^N) IN closure s` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `z - y:real^N` THEN ASM_REWRITE_TAC[GSYM dist; VECTOR_SUB_ADD2]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[HAUSDIST_EMPTY; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `closure s SUBSET t ==> ~(closure s = {}) ==> ~(t = {})`)) THEN ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; EMPTY_UNIONS; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[BALL_EQ_EMPTY; REAL_ARITH `&0 < e ==> ~(e / &4 <= &0)`] THEN REWRITE_TAC[NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `~(s INTER t = {}) <=> ?x. x IN t /\ x IN s`] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN SUBGOAL_THEN `?x:real^N. x IN t` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC]; REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_CBALL; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]; REWRITE_TAC[SET_RULE `s INTER t SUBSET u <=> !x. x IN t ==> x IN s ==> x IN u`] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL; DIST_0] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s INTER t = {}) ==> ?x. x IN t /\ x IN s`)) THEN REWRITE_TAC[IN_CBALL_0; IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = z + w <=> x - z = w`] THEN REWRITE_TAC[UNWIND_THM1] THEN MAP_EVERY UNDISCH_TAC [`norm(y:real^N) < e / &4`; `dist(x:real^N,z) < e / &4`] THEN CONV_TAC NORM_ARITH] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE `closure s SUBSET u ==> !x. x IN t /\ t SUBSET s /\ s SUBSET closure s ==> x IN u`)) THEN ASM_REWRITE_TAC[CLOSURE_SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `x - y:real^N` THEN REWRITE_TAC[VECTOR_SUB_ADD2] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_BALL; DIST_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_BALL]);; let COMPACT_HAUSDIST = prove (`!f:num->(real^N->bool) c. compact c /\ (!n. ~(f n = {}) /\ f n SUBSET c) ==> ?r s. (!m n. m < n ==> r m < r n) /\ compact s /\ ~(s = {}) /\ s SUBSET c /\ ((\n. lift(hausdist(f(r n),s))) --> vec 0) sequentially`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?r. (!n. INFINITE {i | hausdist(f(r n),f i) < inv(&2 pow n)}) /\ (!n. r n < r(SUC n) /\ hausdist((f:num->(real^N->bool))(r n),f(r(SUC n))) < inv(&2 pow n))` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [MP_TAC(ISPECL [`c:real^N->bool`; `&1 / &2`] TOTALLY_BOUNDED_HAUSDIST) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `UNIONS {{i | hausdist((f:num->(real^N->bool)) i,u) < &1 / &2} | u IN k} = (:num)` MP_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (MESON[INFINITE; num_INFINITE] `s = (:num) ==> ~FINITE s`))] THEN REWRITE_TAC[FINITE_UNIONS] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM INFINITE] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INFINITE_SUPERSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < &1 / &2 ==> z <= x + y ==> y < &1 / &2 ==> z < &1`)) THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [HAUSDIST_SYM] THEN MATCH_MP_TAC HAUSDIST_TRIANGLE THEN ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `m:num`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`c:real^N->bool`; `inv(&2 pow (n + 2))`] TOTALLY_BOUNDED_HAUSDIST) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; REAL_LT_INV_EQ; REAL_LT_POW2] THEN DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `INFINITE (UNIONS {{i | hausdist (f m,f i) < inv(&2 pow n) /\ m < i /\ hausdist((f:num->(real^N->bool)) i,u) < inv(&2 pow (n + 2))} | u IN k})` MP_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `0..m` o MATCH_MP (REWRITE_RULE[IMP_CONJ] INFINITE_DIFF_FINITE)) THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INFINITE_SUPERSET) THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN REWRITE_TAC[LE_0; NOT_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[INFINITE; FINITE_UNIONS] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM INFINITE] THEN FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [INFINITE]) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] INFINITE_SUPERSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `q:num` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < n2 ==> inv(&2) * n1 = n2 /\ z <= x + y ==> y < n2 ==> z < n1`)) THEN REWRITE_TAC[GSYM REAL_INV_MUL; GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [HAUSDIST_SYM] THEN MATCH_MP_TAC HAUSDIST_TRIANGLE THEN ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET]; ALL_TAC] THEN EXISTS_TAC `r:num->num` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS]; MATCH_MP_TAC COMPLETE_HAUSDIST] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN CONJ_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ASM_REWRITE_TAC[REAL_POW_INV; GE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN MATCH_MP_TAC WLOG_LT THEN ASM_REWRITE_TAC[HAUSDIST_REFL] THEN CONJ_TAC THENL [MESON_TAC[HAUSDIST_SYM]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT STRIP_TAC THEN TRANS_TAC REAL_LET_TRANS `sum(m..n-1) (\i. hausdist((f:num->real^N->bool)(r(i + 1)),f(r i)))` THEN CONJ_TAC THENL [FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o GEN_REWRITE_RULE I [LT_EXISTS]) THEN REWRITE_TAC[ARITH_RULE `(m + SUC d) - 1 = m + d`] THEN SPEC_TAC(`d:num`,`d:num`) THEN MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ADD_CLAUSES; SUM_CLAUSES_NUMSEG; NUMSEG_SING; SUM_SING] THEN CONJ_TAC THENL [MESON_TAC[ADD1; REAL_LE_REFL; HAUSDIST_SYM]; ALL_TAC] THEN X_GEN_TAC `d:num` THEN REWRITE_TAC[ARITH_RULE `m <= SUC(m + d)`] THEN MATCH_MP_TAC(REAL_ARITH `h' <= h + e ==> h <= d ==> h' <= d + e`) THEN REWRITE_TAC[GSYM ADD1; ADD_CLAUSES] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [HAUSDIST_SYM] THEN MATCH_MP_TAC HAUSDIST_TRIANGLE THEN ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN TRANS_TAC REAL_LET_TRANS `sum (m..n-1) (\i. inv(&2 pow i))` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[GSYM ADD1; REAL_LT_IMP_LE]; ALL_TAC] THEN REWRITE_TAC[REAL_INV_POW; SUM_GP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `inv i < e ==> x <= inv(&2) * inv i ==> x / (&1 / &2) < e`)) THEN REWRITE_TAC[REAL_POW_DIV; REAL_POW_ONE] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ y <= z ==> &1 * y - &1 * x <= z`) THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[GSYM(CONJUNCT2 real_pow); REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Isometries are embeddings, and even surjective in the compact case. *) (* ------------------------------------------------------------------------- *) let ISOMETRY_IMP_OPEN_MAP = prove (`!f:real^M->real^N s t u. IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) /\ open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)`, REWRITE_TAC[open_in; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IMP_CONJ] THEN EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]);; let ISOMETRY_IMP_EMBEDDING = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN ASM_SIMP_TAC[ISOMETRY_ON_IMP_CONTINUOUS_ON] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; REPEAT STRIP_TAC] THEN MATCH_MP_TAC ISOMETRY_IMP_OPEN_MAP THEN ASM_MESON_TAC[]);; let ISOMETRY_IMP_HOMEOMORPHISM_COMPACT = prove (`!f s:real^N->bool. compact s /\ IMAGE f s SUBSET s /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) ==> ?g. homeomorphism (s,s) (f,g)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^N) s = s` (fun th -> ASM_MESON_TAC[th; ISOMETRY_IMP_EMBEDDING]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOMETRY_ON_IMP_CONTINUOUS_ON) THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `setdist({x},IMAGE (f:real^N->real^N) s) = &0` MP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN REWRITE_TAC[SETDIST_POS_LE] THEN DISCH_TAC THEN (X_CHOOSE_THEN `z:num->real^N` STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) `z 0 = (x:real^N) /\ !n. z(SUC n) = f(z n)` THEN SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN DISCH_THEN(MP_TAC o SPEC `z:num->real^N`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `setdist({x},IMAGE (f:real^N->real^N) s)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPECL [`N:num`; `N + 1`])) THEN ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[REAL_NOT_LT; o_THM]] THEN SUBGOAL_THEN `(r:num->num) N < r (N + 1)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z(SUC d))` THEN CONJ_TAC THENL [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN SPEC_TAC(`(r:num->num) N`,`m:num`) THEN INDUCT_TAC THEN ASM_MESON_TAC[ADD_CLAUSES]; REWRITE_TAC[SETDIST_EQ_0_SING; IMAGE_EQ_EMPTY] THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED; NOT_IN_EMPTY; COMPACT_CONTINUOUS_IMAGE; CLOSURE_CLOSED]]);; (* ------------------------------------------------------------------------- *) (* Urysohn's lemma (for real^N, where the proof is easy using distances). *) (* ------------------------------------------------------------------------- *) let URYSOHN_LOCAL_STRONG = prove (`!s t u a b. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} /\ ~(a = b) ==> ?f:real^N->real^M. f continuous_on u /\ (!x. x IN u ==> f(x) IN segment[a,b]) /\ (!x. x IN u ==> (f x = a <=> x IN s)) /\ (!x. x IN u ==> (f x = b <=> x IN t))`, let lemma = prove (`!s t u a b. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} /\ ~(s = {}) /\ ~(t = {}) /\ ~(a = b) ==> ?f:real^N->real^M. f continuous_on u /\ (!x. x IN u ==> f(x) IN segment[a,b]) /\ (!x. x IN u ==> (f x = a <=> x IN s)) /\ (!x. x IN u ==> (f x = b <=> x IN t))`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real^N. a + setdist({x},s) / (setdist({x},s) + setdist({x},t)) % (b - a:real^M)` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(!x:real^N. x IN u ==> (setdist({x},s) = &0 <=> x IN s)) /\ (!x:real^N. x IN u ==> (setdist({x},t) = &0 <=> x IN t))` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[SETDIST_EQ_0_SING] THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` CLOSED_IN_CLOSED); MP_TAC(ISPEC `t:real^N->bool` CLOSED_IN_CLOSED)] THEN DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN ASM_MESON_TAC[CLOSURE_CLOSED; INTER_SUBSET; SUBSET_CLOSURE; SUBSET; IN_INTER; CLOSURE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN u ==> &0 < setdist({x},s) + setdist({x},t)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN REWRITE_TAC[SETDIST_POS_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC) THEN REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF] THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; LEFT_OR_DISTRIB; VECTOR_ARITH `a + x % (b - a):real^N = (&1 - u) % a + u % b <=> (x - u) % (b - a) = vec 0`; EXISTS_OR_THM] THEN DISJ1_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[REAL_SUB_0; UNWIND_THM1] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; SETDIST_POS_LE; REAL_LE_LDIV_EQ; REAL_ARITH `a <= &1 * (a + b) <=> &0 <= b`]; REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`]; REWRITE_TAC[VECTOR_ARITH `a + x % (b - a):real^N = b <=> (x - &1) % (b - a) = vec 0`]] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_SUB_0; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `x:real = x + y <=> y = &0`] THEN ASM_REWRITE_TAC[]) in MATCH_MP_TAC(MESON[] `(!s t. P s t <=> P t s) /\ (!s t. ~(s = {}) /\ ~(t = {}) ==> P s t) /\ P {} {} /\ (!t. ~(t = {}) ==> P {} t) ==> !s t. P s t`) THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN REWRITE_TAC[SEGMENT_SYM; INTER_COMM; CONJ_ACI; EQ_SYM_EQ]; SIMP_TAC[lemma]; REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. midpoint(a,b)):real^N->real^M` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; CONTINUOUS_ON_CONST; MIDPOINT_IN_SEGMENT] THEN REWRITE_TAC[midpoint] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN UNDISCH_TAC `~(a:real^M = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN VECTOR_ARITH_TAC; REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = u` THENL [EXISTS_TAC `(\x. b):real^N->real^M` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; ENDS_IN_SEGMENT; IN_UNIV; CONTINUOUS_ON_CONST]; SUBGOAL_THEN `?c:real^N. c IN u /\ ~(c IN t)` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`{c:real^N}`; `t:real^N->bool`; `u:real^N->bool`; `midpoint(a,b):real^M`; `b:real^M`] lemma) THEN ASM_REWRITE_TAC[CLOSED_IN_SING; MIDPOINT_EQ_ENDPOINT] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NOT_IN_EMPTY] THEN X_GEN_TAC `f:real^N->real^M` THEN STRIP_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `segment[midpoint(a,b):real^M,b] SUBSET segment[a,b]` MP_TAC THENL [REWRITE_TAC[SUBSET; IN_SEGMENT; midpoint] THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(&1 + u) / &2` THEN ASM_REWRITE_TAC[] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN VECTOR_ARITH_TAC; ASM SET_TAC[]]; SUBGOAL_THEN `~(a IN segment[midpoint(a,b):real^M,b])` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP DIST_IN_CLOSED_SEGMENT) THEN REWRITE_TAC[DIST_MIDPOINT] THEN UNDISCH_TAC `~(a:real^M = b)` THEN NORM_ARITH_TAC]]]);; let URYSOHN_LOCAL = prove (`!s t u a b. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} ==> ?f:real^N->real^M. f continuous_on u /\ (!x. x IN u ==> f(x) IN segment[a,b]) /\ (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^M = b` THENL [EXISTS_TAC `(\x. b):real^N->real^M` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; CONTINUOUS_ON_CONST]; MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`; `a:real^M`; `b:real^M`] URYSOHN_LOCAL_STRONG) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SET_TAC[]]);; let URYSOHN_STRONG = prove (`!s t a b. closed s /\ closed t /\ s INTER t = {} /\ ~(a = b) ==> ?f:real^N->real^M. f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ (!x. f x = a <=> x IN s) /\ (!x. f x = b <=> x IN t)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP URYSOHN_LOCAL_STRONG) THEN REWRITE_TAC[IN_UNIV]);; let URYSOHN = prove (`!s t a b. closed s /\ closed t /\ s INTER t = {} ==> ?f:real^N->real^M. f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN (MP_TAC o ISPECL [`a:real^M`; `b:real^M`] o MATCH_MP URYSOHN_LOCAL) THEN REWRITE_TAC[IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Density of points with rational, or just dyadic rational, coordinates. *) (* ------------------------------------------------------------------------- *) let CLOSURE_DYADIC_RATIONALS = prove (`closure { inv(&2 pow n) % x |n,x| !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) } = (:real^N)`, REWRITE_TAC[EXTENSION; CLOSURE_APPROACHABLE; IN_UNIV; EXISTS_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; REAL_POW_INV; REAL_LT_RDIV_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA; FLOOR; dist; NORM_MUL] THEN MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) (SPEC_ALL NORM_LE_L1)) THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&(dimindex(:N)) * inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN SIMP_TAC[REAL_ABS_MUL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH; REAL_FIELD `~(a = &0) ==> inv a * b - x = inv a * (b - a * x)`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_LE_REFL; REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NUM] THEN MP_TAC(SPEC `&2 pow n * (x:real^N)$k` FLOOR) THEN REAL_ARITH_TAC);; let CLOSURE_RATIONAL_COORDINATES = prove (`closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } = (:real^N)`, MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN EXISTS_TAC `closure { inv(&2 pow n) % x:real^N |n,x| !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CLOSURE_DYADIC_RATIONALS]] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[RATIONAL_CLOSED]);; let CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET = prove (`!s:real^N->bool. open s ==> closure(s INTER { inv(&2 pow n) % x | n,x | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; let CLOSURE_RATIONALS_IN_OPEN_SET = prove (`!s:real^N->bool. open s ==> closure(s INTER { inv(&2 pow n) % x | n,x | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; (* ------------------------------------------------------------------------- *) (* Various separability-type properties. *) (* ------------------------------------------------------------------------- *) let UNIV_SECOND_COUNTABLE = prove (`?b. COUNTABLE b /\ (!c. c IN b ==> open c) /\ !s:real^N->bool. open s ==> ?u. u SUBSET b /\ s = UNIONS u`, EXISTS_TAC `IMAGE (\(v:real^N,q). ball(v,q)) ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS rational)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_CROSS THEN REWRITE_TAC[COUNTABLE_RATIONAL] THEN MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | P x} = P`]; REWRITE_TAC[FORALL_IN_IMAGE; CROSS; FORALL_IN_GSPEC; OPEN_BALL]; REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[UNIONS_0; EMPTY_SUBSET]; ALL_TAC] THEN EXISTS_TAC `{c | c IN IMAGE (\(v:real^N,q). ball(v,q)) ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS rational) /\ c SUBSET s}` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_IN_IMAGE] THEN REWRITE_TAC[CROSS; EXISTS_PAIR_THM; EXISTS_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC(REWRITE_RULE[EXTENSION; IN_UNIV] CLOSURE_RATIONAL_COORDINATES) THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `e / &4`]) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `?x. rational x /\ e / &3 < x /\ x < e / &2` (X_CHOOSE_THEN `q:real` STRIP_ASSUME_TAC) THENL [MP_TAC(ISPECL [`&5 / &12 * e`; `e / &12`] RATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN SIMP_TAC[] THEN REAL_ARITH_TAC; EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[IN]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; ASM_REAL_ARITH_TAC]]]);; let UNIV_SECOND_COUNTABLE_SEQUENCE = prove (`?b:num->real^N->bool. (!m n. b m = b n <=> m = n) /\ (!n. open(b n)) /\ (!s. open s ==> ?k. s = UNIONS {b n | n IN k})`, X_CHOOSE_THEN `bb:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN MP_TAC(ISPEC `bb:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN SUBGOAL_THEN `INFINITE {ball(vec 0:real^N,inv(&n + &1)) | n IN (:num)}` MP_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(REWRITE_RULE [RIGHT_IMP_FORALL_THM; IMP_IMP] INFINITE_IMAGE_INJ) THEN REWRITE_TAC[num_INFINITE] THEN MATCH_MP_TAC WLOG_LT THEN SIMP_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `inv(&n + &1) % basis 1:real^N`) THEN REWRITE_TAC[IN_BALL; DIST_0; NORM_MUL; REAL_ABS_INV] THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_REFL] THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; REWRITE_TAC[INFINITE; SIMPLE_IMAGE] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE UNIONS {u | u SUBSET bb} :(real^N->bool)->bool` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET] THEN GEN_REWRITE_TAC I [SUBSET] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[OPEN_BALL]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_IMAGE; LEFT_AND_EXISTS_THM; SUBSET_UNIV] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLE_IMAGE]]);; let SUBSET_SECOND_COUNTABLE = prove (`!s:real^N->bool. ?b. COUNTABLE b /\ (!c. c IN b ==> ~(c = {}) /\ open_in(subtopology euclidean s) c) /\ !t. open_in(subtopology euclidean s) t ==> ?u. u SUBSET b /\ t = UNIONS u`, GEN_TAC THEN SUBGOAL_THEN `?b. COUNTABLE b /\ (!c:real^N->bool. c IN b ==> open_in(subtopology euclidean s) c) /\ !t. open_in(subtopology euclidean s) t ==> ?u. u SUBSET b /\ t = UNIONS u` STRIP_ASSUME_TAC THENL [X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN EXISTS_TAC `{s INTER c :real^N->bool | c IN B}` THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; OPEN_IN_OPEN_INTER] THEN REWRITE_TAC[OPEN_IN_OPEN] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `?b. b SUBSET B /\ u:real^N->bool = UNIONS b` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `b:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INTER_UNIONS] THEN AP_TERM_TAC THEN SET_TAC[]; EXISTS_TAC `b DELETE ({}:real^N->bool)` THEN ASM_SIMP_TAC[COUNTABLE_DELETE; IN_DELETE; SUBSET_DELETE] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u DELETE ({}:real^N->bool)` THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[EXTENSION; IN_UNIONS] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[IN_DELETE] THEN SET_TAC[]]);; let SEPARABLE = prove (`!s:real^N->bool. ?t. COUNTABLE t /\ t SUBSET s /\ s SUBSET closure t`, MP_TAC SUBSET_SECOND_COUNTABLE THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `B:(real^N->bool)->bool` (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:(real^N->bool)->real^N` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (f:(real^N->bool)->real^N) B` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_THEN `!t:real^N->bool. open_in (subtopology euclidean s) t ==> (?u. u SUBSET B /\ t = UNIONS u)` (MP_TAC o SPEC `s INTER ball(x:real^N,e)`) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:(real^N->bool)->bool` THEN ASM_CASES_TAC `b:(real^N->bool)->bool = {}` THENL [MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN ASM_REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; UNIONS_0] THEN ASM_MESON_TAC[CENTRE_IN_BALL]; STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `(f:(real^N->bool)->real^N) c`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN MATCH_MP_TAC(TAUT `a /\ c ==> (a /\ b <=> c) ==> b`) THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[]]]);; let OPEN_SET_RATIONAL_COORDINATES = prove (`!s. open s /\ ~(s = {}) ==> ?x:real^N. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } INTER (s:real^N->bool) = {})` MP_TAC THENL [ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; INTER_UNIV]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; CLOSURE_APPROACHABLE; IN_INTER; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o REWRITE_RULE[open_def]) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let OPEN_COUNTABLE_UNION_OPEN_INTERVALS, OPEN_COUNTABLE_UNION_CLOSED_INTERVALS = (CONJ_PAIR o prove) (`(!s:real^N->bool. open s ==> ?D. COUNTABLE D /\ (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval(a,b)) /\ UNIONS D = s) /\ (!s:real^N->bool. open s ==> ?D. COUNTABLE D /\ (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval[a,b]) /\ UNIONS D = s)`, REPEAT STRIP_TAC THENL [EXISTS_TAC `{i | i IN IMAGE (\(a:real^N,b). interval(a,b)) ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ i SUBSET s}`; EXISTS_TAC `{i | i IN IMAGE (\(a:real^N,b). interval[a,b]) ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ i SUBSET s}`] THEN (SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_CROSS; COUNTABLE_RATIONAL_COORDINATES] THEN REWRITE_TAC[IN_ELIM_THM; UNIONS_GSPEC; IMP_CONJ; GSYM CONJ_ASSOC] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_CROSS; IN_ELIM_THM] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SET_TAC[]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[open_def]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?a b. rational a /\ rational b /\ a < (x:real^N)$i /\ (x:real^N)$i < b /\ abs(b - a) < e / &(dimindex(:N))` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[SUBSET; IN_INTERVAL; REAL_LT_IMP_LE] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[dist] THEN MP_TAC(ISPEC `y - x:real^N` NORM_LE_L1) THEN MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; CARD_NUMSEG_1] THEN REWRITE_TAC[DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));; let LINDELOF = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> open s) ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?b. COUNTABLE b /\ (!c:real^N->bool. c IN b ==> open c) /\ (!s. open s ==> ?u. u SUBSET b /\ s = UNIONS u)` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[UNIV_SECOND_COUNTABLE]; ALL_TAC] THEN ABBREV_TAC `d = {s:real^N->bool | s IN b /\ ?u. u IN f /\ s SUBSET u}` THEN SUBGOAL_THEN `COUNTABLE d /\ UNIONS f :real^N->bool = UNIONS d` STRIP_ASSUME_TAC THENL [EXPAND_TAC "d" THEN ASM_SIMP_TAC[COUNTABLE_RESTRICT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!s:real^N->bool. ?u. s IN d ==> u IN f /\ s SUBSET u` MP_TAC THENL [EXPAND_TAC "d" THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:(real^N->bool)->(real^N->bool)` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (g:(real^N->bool)->(real^N->bool)) d` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; UNIONS_IMAGE] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; let LINDELOF_OPEN_IN = prove (`!f u:real^N->bool. (!s. s IN f ==> open_in (subtopology euclidean u) s) ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:(real^N->bool)->real^N->bool` THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (v:(real^N->bool)->real^N->bool) f` LINDELOF) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!f'. f' SUBSET f ==> UNIONS f' = (u:real^N->bool) INTER UNIONS (IMAGE v f')` MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_REFL]]);; let COUNTABLE_DISJOINT_OPEN_IN_SUBSETS = prove (`!f:(real^N->bool)->bool u. (!s. s IN f ==> open_in (subtopology euclidean u) s) /\ pairwise DISJOINT f ==> COUNTABLE f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINDELOF_OPEN_IN) THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `({}:real^N->bool) INSERT g` THEN ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN REWRITE_TAC[SUBSET; IN_INSERT] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[EXTENSION; SUBSET] THEN REWRITE_TAC[IN_UNIONS; pairwise] THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[]);; let COUNTABLE_DISJOINT_OPEN_SUBSETS = prove (`!f. (!s:real^N->bool. s IN f ==> open s) /\ pairwise DISJOINT f ==> COUNTABLE f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `(:real^N)`] COUNTABLE_DISJOINT_OPEN_IN_SUBSETS) THEN ASM_SIMP_TAC[GSYM OPEN_IN; SUBTOPOLOGY_UNIV]);; let COUNTABLE_DISJOINT_NONEMPTY_INTERIOR_SUBSETS = prove (`!f:(real^N->bool)->bool. (!s. s IN f /\ interior s = {} ==> s = {}) /\ pairwise DISJOINT f ==> COUNTABLE f`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE interior (f:(real^N->bool)->bool)` COUNTABLE_DISJOINT_OPEN_SUBSETS) THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_INTERIOR] THEN ANTS_TAC THENL [REWRITE_TAC[PAIRWISE_IMAGE]; MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC COUNTABLE_IMAGE_INJ_EQ THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN REWRITE_TAC[GSYM pairwise]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_IMP)) THEN MATCH_MP_TAC(MESON[] `(!s:real^N->bool. interior s SUBSET s) /\ (!s t. interior s SUBSET s /\ interior t SUBSET t ==> P s t) ==> !s:real^N->bool t:real^N->bool. P s t`) THEN (CONJ_TAC THENL [REWRITE_TAC[INTERIOR_SUBSET]; ALL_TAC]) THEN REPEAT(FIRST_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM]) THEN SET_TAC[]);; let COUNTABLE_COMPACT_OPEN_IN = prove (`!u:real^N->bool. COUNTABLE {c | compact c /\ open_in (subtopology euclidean u) c}`, GEN_TAC THEN MP_TAC(ISPEC `u:real^N->bool` SUBSET_SECOND_COUNTABLE) THEN DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE UNIONS {t:(real^N->bool)->bool | t SUBSET b /\ FINITE t}` THEN ASM_SIMP_TAC[COUNTABLE_FINITE_SUBSETS; COUNTABLE_IMAGE] THEN GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_IMAGE; IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `open_in (subtopology euclidean u) (c:real^N->bool)`)) THEN DISCH_THEN(X_CHOOSE_THEN `t:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:(real^N->bool)->bool` o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL [X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let COUNTABLE_CLOPEN_IN = prove (`!u:real^N->bool. compact u ==> COUNTABLE {c | closed_in (subtopology euclidean u) c /\ open_in (subtopology euclidean u) c}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `{c:real^N->bool | compact c /\ open_in (subtopology euclidean u) c}` THEN REWRITE_TAC[COUNTABLE_COMPACT_OPEN_IN; SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CLOSED_IN_COMPACT]);; let CARD_EQ_OPEN_SETS = prove (`{s:real^N->bool | open s} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN TRANS_TAC CARD_LE_TRANS `{s:(real^N->bool)->bool | s SUBSET b}` THEN CONJ_TAC THENL [REWRITE_TAC[LE_C] THEN EXISTS_TAC `UNIONS:((real^N->bool)->bool)->real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; TRANS_TAC CARD_LE_TRANS `{s | s SUBSET (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_POWERSET THEN ASM_REWRITE_TAC[GSYM COUNTABLE_ALT]; REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC] THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM; CARD_EQ_REAL]]]; REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN EXISTS_TAC `\x. ball(x % basis 1:real^N,&1)` THEN REWRITE_TAC[OPEN_BALL; GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[NORM_ARITH `dist(p:real^N,q) + &1 <= &1 <=> p = q`] THEN REWRITE_TAC[VECTOR_MUL_RCANCEL; EQ_SYM_EQ] THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; let CARD_EQ_CLOSED_SETS = prove (`{s:real^N->bool | closed s} =_c (:real)`, SUBGOAL_THEN `{s:real^N->bool | closed s} = IMAGE (\s. (:real^N) DIFF s) {s | open s}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; GSYM OPEN_CLOSED] THEN MESON_TAC[COMPL_COMPL]; TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | open s}` THEN REWRITE_TAC[CARD_EQ_OPEN_SETS] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN SET_TAC[]]);; let CARD_EQ_COMPACT_SETS = prove (`{s:real^N->bool | compact s} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_CLOSED_SETS] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_CLOSED]; REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN EXISTS_TAC `\x. {x % basis 1:real^N}` THEN REWRITE_TAC[COMPACT_SING; SET_RULE `{x} = {y} <=> x = y`] THEN SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; let COUNTABLE_NON_CONDENSATION_POINTS = prove (`!s:real^N->bool. COUNTABLE(s DIFF {x | x condensation_point_of s})`, REPEAT STRIP_TAC THEN REWRITE_TAC[condensation_point_of] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN EXISTS_TAC `s INTER UNIONS { u:real^N->bool | u IN b /\ COUNTABLE(s INTER u)}` THEN REWRITE_TAC[INTER_UNIONS; IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RESTRICT]; SIMP_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?u:real^N->bool. x IN u /\ u IN b /\ u SUBSET t` MP_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `s INTER t:real^N->bool` THEN ASM SET_TAC[]]);; let COUNTABLE_NON_LIMIT_POINTS = prove (`!s:real^N->bool. COUNTABLE(s DIFF {x | x limit_point_of s})`, GEN_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `s DIFF {x:real^N | x condensation_point_of s}` THEN REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS] THEN MATCH_MP_TAC(SET_RULE `(!x. Q x ==> P x) ==> s DIFF {x | P x} SUBSET s DIFF {x | Q x}`) THEN REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT]);; let COUNTABLE_ISOLATED_SET = prove (`!s:real^N->bool. (!a. a IN s ==> ~(a limit_point_of s)) ==> COUNTABLE s`, GEN_TAC THEN DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE `(!x. x IN s ==> ~(P x)) ==> s = s DIFF {x | P x}`)) THEN REWRITE_TAC[COUNTABLE_NON_LIMIT_POINTS]);; let CARD_EQ_CONDENSATION_POINTS_IN_SET = prove (`!s:real^N->bool. ~(COUNTABLE s) ==> {x | x IN s /\ x condensation_point_of s} =_c s`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_EQ_TRANS `(s DIFF {x | x condensation_point_of s}) +_c {x:real^N | x IN s /\ x condensation_point_of s}` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_ADD_ABSORB_LEFT THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o CONJ (SPEC `s:real^N->bool` COUNTABLE_NON_CONDENSATION_POINTS) o MATCH_MP FINITE_IMP_COUNTABLE) THEN REWRITE_TAC[GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]; REWRITE_TAC[INFINITE_CARD_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS) THEN REWRITE_TAC[GSYM COUNTABLE_ALT; COUNTABLE_NON_CONDENSATION_POINTS]]; ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN W(MP_TAC o PART_MATCH (rand o rand) CARD_DISJOINT_UNION o rand o snd) THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]]);; let LIMPT_OF_CONDENSATION_POINTS,CONDENSATION_POINT_OF_CONDENSATION_POINTS = (CONJ_PAIR o prove) (`(!x:real^N s. x limit_point_of {y | y condensation_point_of s} <=> x condensation_point_of s) /\ (!x:real^N s. x condensation_point_of {y | y condensation_point_of s} <=> x condensation_point_of s)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (q ==> p) /\ (p ==> r) ==> (q <=> p) /\ (r <=> p)`) THEN REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT] THEN CONJ_TAC THENL [REWRITE_TAC[LIMPT_APPROACHABLE; CONDENSATION_POINT_INFINITE_BALL] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SIMP_TAC[SUBSET; IN_INTER; IN_BALL] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; ONCE_REWRITE_TAC[CONDENSATION_POINT_INFINITE_BALL] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[CARD_EQ_CONDENSATION_POINTS_IN_SET; CARD_COUNTABLE_CONG] `~COUNTABLE s ==> ~COUNTABLE {x | x IN s /\ x condensation_point_of s}`)) THEN REWRITE_TAC[UNCOUNTABLE_REAL; CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CONDENSATION_POINT_OF_SUBSET; INTER_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN EXISTS_TAC `closure(s INTER ball(x:real^N,e / &2))` THEN CONJ_TAC THENL [REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN ASM_SIMP_TAC[CONDENSATION_POINT_IMP_LIMPT]; TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]]);; let CLOSED_CONDENSATION_POINTS = prove (`!s:real^N->bool. closed {x | x condensation_point_of s}`, SIMP_TAC[CLOSED_LIMPT; LIMPT_OF_CONDENSATION_POINTS; IN_ELIM_THM]);; let CANTOR_BENDIXSON_GEN = prove (`!s:real^N->bool. ?t u. closed_in (subtopology euclidean s) t /\ (!x. x IN t ==> x condensation_point_of t) /\ COUNTABLE u /\ s = t UNION u`, GEN_TAC THEN EXISTS_TAC `s INTER {x:real^N | x condensation_point_of s}` THEN EXISTS_TAC `s DIFF {x:real^N | x condensation_point_of s}` THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CONDENSATION_POINTS] THEN REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[condensation_point_of] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN MP_TAC(ISPEC `s:real^N->bool` COUNTABLE_NON_CONDENSATION_POINTS) THEN REWRITE_TAC[IMP_IMP; GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[]);; let CANTOR_BENDIXSON = prove (`!s:real^N->bool. closed s ==> ?t u. closed t /\ (!x. x IN t ==> x limit_point_of t) /\ COUNTABLE u /\ s = t UNION u`, MESON_TAC[CLOSED_IN_CLOSED_TRANS; CANTOR_BENDIXSON_GEN; CONDENSATION_POINT_IMP_LIMPT]);; (* ------------------------------------------------------------------------- *) (* A discrete set is countable, and an uncountable set has a limit point. *) (* ------------------------------------------------------------------------- *) let DISCRETE_IMP_COUNTABLE = prove (`!s:real^N->bool. (!x. x IN s ==> ?e. &0 < e /\ !y. y IN s /\ ~(y = x) ==> e <= norm(y - x)) ==> COUNTABLE s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. x IN s ==> ?q. (!i. 1 <= i /\ i <= dimindex(:N) ==> rational(q$i)) /\ !y:real^N. y IN s /\ ~(y = x) ==> norm(x - q) < norm(y - q)` MP_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(SET_RULE `x IN (:real^N)`) THEN REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:real^N->real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `{ x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`; `(:num)`] CARD_LE_TRANS) THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REWRITE_RULE[COUNTABLE; ge_c] COUNTABLE_RATIONAL_COORDINATES] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `q:real^N->real^N` THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_ANTISYM]]);; let UNCOUNTABLE_CONTAINS_LIMIT_POINT = prove (`!s. ~(COUNTABLE s) ==> ?x. x IN s /\ x limit_point_of s`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] DISCRETE_IMP_COUNTABLE)) THEN REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LT; dist] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A closed local homeomorphism is proper: it actually has finite preimages. *) (* ------------------------------------------------------------------------- *) let CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN = prove (`!f:real^M->real^N s t. (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ (!w x. open_in (subtopology euclidean s) w /\ x IN w ==> ?u. open_in (subtopology euclidean s) u /\ {x} PSUBSET u /\ u SUBSET w /\ f continuous_on u /\ (!x'. x' IN u /\ ~(x' = x) ==> ~(f x' = f x))) ==> !y. FINITE {x | x IN s /\ f x = y}`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(SPEC `s:real^M->bool` th)) THEN REWRITE_TAC[CLOSED_IN_REFL] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN SUBGOAL_THEN `!z. z IN s /\ (f:real^M->real^N) z = b ==> ?r. &0 < r /\ f continuous_on s INTER ball(z,r) /\ !z'. z' IN s /\ z' IN cball(z,&2 * r) /\ ~(z' = z) ==> ~(f z' = b)` (LABEL_TAC "*") THENL [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^M->bool`; `x:real^M`]) THEN ASM_SIMP_TAC[OPEN_IN_REFL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^M->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[SUBSET; IN_INTER] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `r / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_CBALL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_AS_INJECTIVE_IMAGE)) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_CBALL; dist] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = x` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(y:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(f:real^M->real^N) y = b` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; REWRITE_TAC[INJECTIVE_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real^M` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `(!n:num. a n IN s) /\ (!n. (f:real^M->real^N) (a n) = b)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REMOVE_THEN "*" (MP_TAC o GEN_REWRITE_RULE I [SET_RULE `(!x. P x ==> Q x) <=> (!x. x IN {z | P z} ==> Q x)`]) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->real` STRIP_ASSUME_TAC) THEN ABBREV_TAC `u:num->real^M->bool = \n. s INTER ball(a n,r n)` THEN SUBGOAL_THEN `!n. open_in (subtopology euclidean s) ((u:num->real^M->bool) n)` ASSUME_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL]; ALL_TAC] THEN SUBGOAL_THEN `!n. (a:num->real^M) n IN u n` ASSUME_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n:num. (f:real^M->real^N) continuous_on u n` ASSUME_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?x:num->real^M. (!n. x n IN u n /\ ~(f(x n) = b)) /\ (!n. dist(f(x(SUC n)):real^N,b) < dist(f(x n),b) / &2)` STRIP_ASSUME_TAC THENL [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`(u:num->real^M->bool) 0`; `a 0:real^M`]) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{z | z IN u(SUC n) /\ (f:real^M->real^N) z IN ball(b,dist(f x,b) / &2)}`; `(a:num->real^M) (SUC n)`]) THEN ASM_SIMP_TAC[IN_ELIM_THM; CENTRE_IN_BALL; REAL_HALF; GSYM DIST_NZ] THEN ANTS_TAC THENL [TRANS_TAC OPEN_IN_TRANS `u(SUC n):real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]; REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL] THEN SET_TAC[]]]; ALL_TAC] THEN SUBGOAL_THEN `!n. (x:num->real^M) n IN s` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `(((f:real^M->real^N) o (x:num->real^M)) --> b) sequentially` ASSUME_TAC THENL [REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e / dist((f:real^M->real^N)(x 0),b)`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_POW_INV; REAL_LT_DIV; DIST_POS_LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; DIST_POS_LT] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)) THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_POW2; o_THM] THEN TRANS_TAC REAL_LE_TRANS `dist ((f:real^M->real^N) (x n),b) * &2 pow n` THEN ASM_SIMP_TAC[REAL_LE_LMUL; DIST_POS_LE; REAL_POW_MONO; REAL_ARITH `&1 <= &2`] THEN SPEC_TAC(`n:num`,`m:num`) THEN INDUCT_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_LE_REFL; REAL_MUL_RID; real_pow] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_LE_RMUL_EQ; REAL_LT_POW2] THEN ASM_SIMP_TAC[REAL_ARITH `x < y / &2 ==> x * &2 <= y`]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN `x:real^M` o SPECL [`s:real^M->bool`; `x:real^M`]) THEN REWRITE_TAC[OPEN_IN_REFL] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (x:num->real^M) (:num)`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CLOSED_IN_SEQUENTIAL_LIMITS] THEN DISCH_THEN(MP_TAC o SPECL [`(f:real^M->real^N) o (x:num->real^M)`; `b:real^N`] o CONJUNCT2) THEN ASM_REWRITE_TAC[o_THM; NOT_IMP] THEN ASM SET_TAC[]] THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(f:real^M->real^N) z = b` ASSUME_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN ASM_SIMP_TAC[o_ASSOC; LIM_SUBSEQUENCE; TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION_WITHIN THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `{z} PSUBSET s ==> z IN s`)) THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC LIM_EVENTUALLY_IN_OPEN_IN THEN MAP_EVERY EXISTS_TAC [`z:real^M`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN ASM_REWRITE_TAC[]]; SUBGOAL_THEN `?N. z = (a:num->real^M) N` (X_CHOOSE_THEN `N:num` SUBST_ALL_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `eventually (\n. (x:num->real^M)(r n) IN u(N:num)) sequentially` MP_TAC THENL [MATCH_MP_TAC LIM_EVENTUALLY_IN_OPEN_IN THEN MAP_EVERY EXISTS_TAC [`(a:num->real^M) N`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M + N + 1`)) THEN REWRITE_TAC[ARITH_RULE `M <= M + N + 1`] THEN SUBGOAL_THEN `(x:num->real^M)(r(M + N + 1)) IN u(r(M + N + 1))` MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `DISJOINT s t ==> x IN t ==> ~(x IN s)`) THEN SUBGOAL_THEN `~(r(M + N + 1) = N)` MP_TAC THENL [MATCH_MP_TAC(ARITH_RULE `M + N + 1 <= r(M + N + 1) ==> ~(r(M + N + 1) = N)`) THEN ASM_MESON_TAC[MONOTONE_BIGGER]; ALL_TAC] THEN SPEC_TAC(`r(M + N + 1):num`,`N':num`) THEN GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "u" THEN MATCH_MP_TAC(SET_RULE `DISJOINT t u ==> DISJOINT (s INTER t) (s INTER u)`) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`N:num`; `(a:num->real^M) N'`] th) THEN MP_TAC(SPECL [`N':num`; `(a:num->real^M) N`] th)) THEN ASM_REWRITE_TAC[IN_BALL; IN_CBALL; DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN CONV_TAC NORM_ARITH]]);; let CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER = prove (`!f:real^M->real^N s t. (!x. connected_component s x = {x} ==> s = {x}) /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ (!x. x IN s ==> ?u v g. x IN u /\ open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean t) v /\ homeomorphism (u,v) (f,g)) ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s SUBSET t` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_REFL; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN ASM_SIMP_TAC[PROPER_MAP] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC FINITE_IMP_COMPACT THEN ASM_CASES_TAC `?a:real^M. s = {a}` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` SUBST1_TAC) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{a:real^M}` THEN REWRITE_TAC[SUBSET_RESTRICT; FINITE_SING]; SUBGOAL_THEN `!x:real^M. x IN s ==> {x} PSUBSET connected_component s x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[SING_SUBSET; PSUBSET] THEN REWRITE_TAC[IN] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL] THEN ASM_MESON_TAC[]; FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM])] THEN UNDISCH_THEN `!x:real^M. connected_component s x = {x} ==> s = {x}` (K ALL_TAC)] THEN SPEC_TAC(`y:real^N`,`y:real^N`) THEN MATCH_MP_TAC CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN SUBGOAL_THEN `(x:real^M) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; HOMEOMORPHISM] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `g:real^N->real^M`] THEN STRIP_TAC THEN EXISTS_TAC `u INTER w:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; INTER_SUBSET; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ ~(s SUBSET {a}) ==> {a} PSUBSET s`) THEN ASM_REWRITE_TAC[IN_INTER] THEN MATCH_MP_TAC(MESON[INFINITE; FINITE_SING; FINITE_SUBSET] `INFINITE s ==> ~(s SUBSET {x})`) THEN MATCH_MP_TAC INFINITE_OPEN_IN THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER] THEN EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[IN_INTER] THEN MATCH_MP_TAC LIMPT_SUBSET THEN EXISTS_TAC `connected_component s (x:real^M)` THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN REWRITE_TAC[IN; CONNECTED_CONNECTED_COMPONENT] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* The Brouwer reduction theorem. *) (* ------------------------------------------------------------------------- *) let BROUWER_REDUCTION_THEOREM_GEN = prove (`!P s:real^N->bool. (!f. (!n. closed(f n) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n)) ==> P(INTERS {f n | n IN (:num)})) /\ closed s /\ P s ==> ?t. t SUBSET s /\ closed t /\ P t /\ (!u. u SUBSET s /\ closed u /\ P u ==> ~(u PSUBSET t))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?b:num->real^N->bool. (!m n. b m = b n <=> m = n) /\ (!n. open (b n)) /\ (!s. open s ==> (?k. s = UNIONS {b n | n IN k}))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[UNIV_SECOND_COUNTABLE_SEQUENCE]; ALL_TAC] THEN X_CHOOSE_THEN `a:num->real^N->bool` MP_TAC (prove_recursive_functions_exist num_RECURSION `a 0 = (s:real^N->bool) /\ (!n. a(SUC n) = if ?u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} then @u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} else a(n))`) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "base") (LABEL_TAC "step")) THEN EXISTS_TAC `INTERS {a n :real^N->bool | n IN (:num)}` THEN SUBGOAL_THEN `!n. (a:num->real^N->bool)(SUC n) SUBSET a(n)` ASSUME_TAC THENL [GEN_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. (a:num->real^N->bool) n SUBSET s` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!n. closed((a:num->real^N->bool) n) /\ P(a n)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CLOSED_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[PSUBSET_ALT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[INTERS_GSPEC; EXISTS_IN_GSPEC; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?n. x IN (b:num->real^N->bool)(n) /\ t INTER b n = {}` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `(:real^N) DIFF t` OPEN_CONTAINS_BALL) THEN ASM_REWRITE_TAC[GSYM closed] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> t INTER s = {}`] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball(x:real^N,e)`) THEN ASM_REWRITE_TAC[OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:num->bool` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_UNIONS; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN SET_TAC[]; REMOVE_THEN "step" (MP_TAC o SPEC `n:num`) THEN COND_CASES_TAC THENL [DISCH_THEN(ASSUME_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]]]);; let BROUWER_REDUCTION_THEOREM = prove (`!P s:real^N->bool. (!f. (!n. compact(f n) /\ ~(f n = {}) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n)) ==> P(INTERS {f n | n IN (:num)})) /\ compact s /\ ~(s = {}) /\ P s ==> ?t. t SUBSET s /\ compact t /\ ~(t = {}) /\ P t /\ (!u. u SUBSET s /\ closed u /\ ~(u = {}) /\ P u ==> ~(u PSUBSET t))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\t:real^N->bool. ~(t = {}) /\ t SUBSET s /\ P t`; `s:real^N->bool`] BROUWER_REDUCTION_THEOREM_GEN) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_REFL] THEN ANTS_TAC THENL [GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!n. compact((f:num->real^N->bool) n)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[] THEN SET_TAC[]; ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]]);; let MINIMAL_CONTINUUM = prove (`!t s:real^N->bool. t SUBSET s /\ compact s /\ connected s ==> ?u. t SUBSET u /\ u SUBSET s /\ compact u /\ connected u /\ !v. v SUBSET u /\ t SUBSET v /\ compact v /\ connected v ==> v = u`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_MESON_TAC[COMPACT_EMPTY; CONNECTED_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET]; ALL_TAC] THEN MP_TAC(ISPECL [`\u:real^N->bool. t SUBSET u /\ connected u`; `s:real^N->bool`] BROUWER_REDUCTION_THEOREM) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET_INTERS] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_NEST THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `(v SUBSET u /\ p ==> v = u) <=> (v SUBSET u /\ p ==> ~(v PSUBSET u))`] THEN GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The Arzela-Ascoli theorem. *) (* ------------------------------------------------------------------------- *) let SUBSEQUENCE_DIAGONALIZATION_LEMMA = prove (`!P:num->(num->A)->bool. (!i r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ P i (r o k)) /\ (!i r:num->A k1 k2 N. P i (r o k1) /\ (!j. N <= j ==> ?j'. j <= j' /\ k2 j = k1 j') ==> P i (r o k2)) ==> !r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ (!i. P i (r o k))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [SKOLEM_THM] THEN REWRITE_TAC[FORALL_AND_THM; TAUT `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN DISCH_THEN(X_CHOOSE_THEN `kk:num->(num->A)->num->num` STRIP_ASSUME_TAC) THEN X_GEN_TAC `r:num->A` THEN (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) `(rr 0 = (kk:num->(num->A)->num->num) 0 r) /\ (!n. rr(SUC n) = rr n o kk (SUC n) (r o rr n))` THEN EXISTS_TAC `\n. (rr:num->num->num) n n` THEN REWRITE_TAC[ETA_AX] THEN SUBGOAL_THEN `(!i. (!m n. m < n ==> (rr:num->num->num) i m < rr i n)) /\ (!i. (P:num->(num->A)->bool) i (r o rr i))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[o_ASSOC] THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!i j n. i <= j ==> (rr:num->num->num) i n <= rr j n` ASSUME_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`j:num`,`j:num`) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[FORALL_UNWIND_THM2] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LE_TRANS)) THEN REWRITE_TAC[o_THM] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[LE_LT] `!f:num->num. (!m n. m < n ==> f m < f n) ==> (!m n. m <= n ==> f m <= f n)`) o SPEC `i + d:num`) THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN ASM_SIMP_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `(rr:num->num->num) n m` THEN ASM_MESON_TAC[LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `!m n i. n <= m ==> ?j. i <= j /\ (rr:num->num->num) m i = rr n j` ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `i:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(rr:num->num->num) i` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `i:num` THEN ASM_MESON_TAC[]] THEN SUBGOAL_THEN `!p d i. ?j. i <= j /\ (rr:num->num->num) (p + d) i = rr p j` (fun th -> MESON_TAC[LE_EXISTS; th]) THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "+") THEN X_GEN_TAC `i:num` THEN ASM_REWRITE_TAC[o_THM] THEN REMOVE_THEN "+" (MP_TAC o SPEC `(kk:num->(num->A)->num->num) (SUC(p + d)) ((r:num->A) o (rr:num->num->num) (p + d)) i`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN SPEC_TAC(`i:num`,`i:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; let FUNCTION_CONVERGENT_SUBSEQUENCE = prove (`!f:num->real^M->real^N s M. COUNTABLE s /\ (!n x. x IN s ==> norm(f n x) <= M) ==> ?k. (!m n:num. m < n ==> k m < k n) /\ !x. x IN s ==> ?l. ((\n. f (k n) x) --> l) sequentially`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [EXISTS_TAC `\n:num. n` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^M->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `X:num->real^M` THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(ISPEC `\i r. ?l. ((\n. ((f:num->real^M->real^N) o (r:num->num)) n ((X:num->real^M) i)) --> l) sequentially` SUBSEQUENCE_DIAGONALIZATION_LEMMA) THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_UNIV] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN MATCH_ACCEPT_TAC] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN MAP_EVERY X_GEN_TAC [`i:num`; `r:num->num`] THEN MP_TAC(ISPEC `cball(vec 0:real^N,M)` compact) THEN REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `\n. (f:num->real^M->real^N) ((r:num->num) n) (X(i:num))`) THEN ASM_REWRITE_TAC[IN_CBALL_0; o_DEF] THEN MESON_TAC[]; REPEAT GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY; GE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN ASM_MESON_TAC[LE_TRANS; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`]]);; let ARZELA_ASCOLI = prove (`!f:num->real^M->real^N s M. compact s /\ (!n x. x IN s ==> norm(f n x) <= M) /\ (!x e. x IN s /\ &0 < e ==> ?d. &0 < d /\ !n y. y IN s /\ norm(x - y) < d ==> norm(f n x - f n y) < e) ==> ?g. g continuous_on s /\ ?r. (!m n:num. m < n ==> r m < r n) /\ !e. &0 < e ==> ?N. !n x. n >= N /\ x IN s ==> norm(f(r n) x - g x) < e`, REPEAT STRIP_TAC THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC(MESON[] `(!k g. V k g ==> N g) /\ (?k. M k /\ ?g. V k g) ==> ?g. N g /\ ?k. M k /\ V k g`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`k:num->num`; `g:real^M->real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN EXISTS_TAC `(f:num->real^M->real^N) o (k:num->num)` THEN ASM_SIMP_TAC[EVENTUALLY_SEQUENTIALLY; o_THM; TRIVIAL_LIMIT_SEQUENTIALLY; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN EXISTS_TAC `0` THEN REWRITE_TAC[continuous_on; dist] THEN ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN MP_TAC(ISPECL [`IMAGE (f:num->real^M->real^N) (:num)`; `s:real^M->bool`] COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN ANTS_TAC THENL [REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`)] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; dist] THEN DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[NORM_SUB]) THEN REWRITE_TAC[GSYM dist; UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN X_CHOOSE_THEN `r:real^M->bool` STRIP_ASSUME_TAC (ISPEC `s:real^M->bool` SEPARABLE) THEN MP_TAC(ISPECL [`f:num->real^M->real^N`; `r:real^M->bool`; `M:real`] FUNCTION_CONVERGENT_SUBSEQUENCE) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num->num` THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^M. ball(x,d)) r`) THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure r:real^M->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL]; DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC)] THEN REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `M:real^M->num` THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPECL [`M:real^M->num`; `t:real^M->bool`] UPPER_BOUND_FINITE_SET) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:real^M`] THEN STRIP_TAC THEN UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^M. ball (x,d)) t)` THEN REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_BALL; LEFT_IMP_EXISTS_THM; dist] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(f (k(m:num)) y - f (k m) x) < e / &3 /\ norm(f (k n) y - f (k n) x) < e / &3 /\ norm(f (k m) y - f (k n) y) < e / &3 ==> norm(f (k m) x - f (k n) x :real^M) < e`) THEN ASM_SIMP_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_REWRITE_TAC[dist; GE] THEN ASM_MESON_TAC[SUBSET; LE_TRANS]);; let ARZELA_ASCOLI_LIPSCHITZ = prove (`!f:num->real^M->real^N s t b. compact s /\ bounded t /\ (!n x. x IN s ==> ~(IMAGE (f n) s INTER t = {})) /\ (!n x y. x IN s /\ y IN s ==> norm(f n x - f n y) <= b * norm(x - y)) ==> ?g. (!x y. x IN s /\ y IN s ==> norm(g x - g y) <= b * norm(x - y)) /\ ?r. (!m n. m < n ==> r m < r n) /\ !e. &0 < e ==> ?N. !n:num x. n >= N /\ x IN s ==> norm(f (r n) x - g x) < e`, REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP MONO_EXISTS (ISPECL [`f:num->real^M->real^N`; `s:real^M->bool`] ARZELA_ASCOLI)) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^M->bool`; `s:real^M->bool`] BOUNDED_DIFFS) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM; FORALL_IN_GSPEC] THEN X_GEN_TAC `C:real` THEN STRIP_TAC THEN EXISTS_TAC `B + abs b * C:real` THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN DISCH_TAC THEN SUBGOAL_THEN `~(IMAGE ((f:num->real^M->real^N) n) s INTER t = {})` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^M`; `y:real^M`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(y) <= b /\ a <= c ==> norm(x - y:real^M) <= a ==> norm(x) <= b + c`) THEN ASM_SIMP_TAC[] THEN TRANS_TAC REAL_LE_TRANS `abs b * norm(x - y:real^M)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC; MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN STRIP_TAC THEN EXISTS_TAC `e / (abs b + &1)` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_ARITH `&0 < abs b + &1`] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN MAP_EVERY X_GEN_TAC [`n:num`; `y:real^M`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^M`; `y:real^M`]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC]; REWRITE_TAC[RIGHT_AND_EXISTS_THM; dist; GE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIPSCHITZ_LIM THEN EXISTS_TAC `(f:num->real^M->real^N) o (r:num->num)` THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; dist; o_DEF] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Basics about "local" properties in general. *) (* ------------------------------------------------------------------------- *) let locally = new_definition `locally P (s:real^N->bool) <=> !w x. open_in (subtopology euclidean s) w /\ x IN w ==> ?u v. open_in (subtopology euclidean s) u /\ P v /\ x IN u /\ u SUBSET v /\ v SUBSET w`;; let LOCALLY_MONO = prove (`!P Q s. (!t. P t ==> Q t) /\ locally P s ==> locally Q s`, REWRITE_TAC[locally] THEN MESON_TAC[]);; let LOCALLY_OPEN_SUBSET = prove (`!P s t:real^N->bool. locally P s /\ open_in (subtopology euclidean s) t ==> locally P t`, REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[open_in; SUBSET]);; let [LOCALLY_LOCALLY;LOCALLY_ON_OPEN_SUBSETS; LOCALLY_ON_NBDS] = (CONJUNCTS o prove) (`(!P:(real^N->bool)->bool. locally (locally P) = locally P) /\ (!P s:real^N->bool. locally P s <=> !a. a IN s ==> ?v. open_in (subtopology euclidean s) v /\ a IN v /\ locally P v) /\ (!P s:real^N->bool. locally P s <=> !a. a IN s ==> ?u v. open_in (subtopology euclidean s) u /\ a IN u /\ u SUBSET v /\ v SUBSET s /\ locally P v)`, REWRITE_TAC[FUN_EQ_THM; AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`P:(real^N->bool)->bool`; `s:real^N->bool`] THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> s) /\ (s ==> r) /\ (r ==> p) ==> (q <=> p) /\ (p <=> r) /\ (p <=> s)`) THEN REPEAT CONJ_TAC THENL [DISCH_TAC THEN ONCE_REWRITE_TAC[locally] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `v:real^N->bool`) THEN ASM_MESON_TAC[SUBSET_REFL; LOCALLY_OPEN_SUBSET]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [locally] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN REWRITE_TAC[OPEN_IN_REFL] THEN MESON_TAC[]; DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[locally] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u INTER v:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN ASM_MESON_TAC[OPEN_IN_SUBTOPOLOGY_INTER_SUBSET; OPEN_IN_INTER; OPEN_IN_TRANS; OPEN_IN_REFL; OPEN_IN_IMP_SUBSET]]);; let LOCALLY_AND_SUBSET = prove (`!s:real^N->bool. locally P s <=> locally (\t. t SUBSET s /\ P t) s`, GEN_TAC THEN REWRITE_TAC[locally] THEN MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]);; let LOCALLY_AND_OPEN_IN = prove (`!P s:real^N->bool. locally (\u. open_in (subtopology euclidean s) u /\ P u) s <=> !v x. open_in (subtopology euclidean s) v /\ x IN v ==> ?u. open_in (subtopology euclidean s) u /\ P u /\ x IN u /\ u SUBSET v`, REWRITE_TAC[locally] THEN MESON_TAC[SUBSET]);; let LOCALLY_AND_SMALL_LT,LOCALLY_AND_SMALL_LE = (CONJ_PAIR o prove) (`(!P:(real^N->bool)->bool e. &0 < e ==> locally P = locally (\s. P s /\ bounded s /\ diameter s < e)) /\ (!P:(real^N->bool)->bool e. &0 < e ==> locally P = locally (\s. P s /\ bounded s /\ diameter s <= e))`, REWRITE_TAC[AND_FORALL_THM; FUN_EQ_THM; RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`P:(real^N->bool)->bool`; `e:real`; `s:real^N->bool`] THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `((q ==> r) /\ (r ==> p)) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN CONJ_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN SIMP_TAC[REAL_LT_IMP_LE]; REWRITE_TAC[locally] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w INTER ball(a:real^N,e / &4)`; `a:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[SUBSET_INTER; REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `diameter(ball(a:real^N,e / &4))` THEN ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN REWRITE_TAC[DIAMETER_BALL] THEN ASM_REAL_ARITH_TAC]);; let LOCALLY_OPEN_BASIS = prove (`!P s:real^N->bool. locally (\u. open_in (subtopology euclidean s) u /\ P u) s <=> ?b. COUNTABLE b /\ (!c. c IN b ==> ~(c = {}) /\ open_in (subtopology euclidean s) c /\ P c) /\ (!t. open_in (subtopology euclidean s) t ==> ?u. u SUBSET b /\ t = UNIONS u)`, REWRITE_TAC[LOCALLY_AND_OPEN_IN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [STRIP_TAC; ASM SET_TAC[]] THEN SUBGOAL_THEN `!n. ?c. COUNTABLE c /\ UNIONS c = s /\ !u. u IN c ==> ~(u = {}) /\ open_in (subtopology euclidean s) u /\ P u /\ ?x. x IN s /\ x IN u /\ u SUBSET ball(x:real^N,inv(&n + &1))` MP_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_ASSUM(MP_TAC o GEN `x:real^N` o SPECL [`s INTER ball(x:real^N,inv(&n + &1))`; `x:real^N`]) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->real^N->bool` THEN DISCH_TAC THEN MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `c SUBSET t ==> (!x. x IN t ==> P x) ==> !x. x IN c ==> P x`)) THEN REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_EMPTY; EMPTY_SUBSET] THEN ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN X_GEN_TAC `c:num->(real^N->bool)->bool` THEN STRIP_TAC THEN EXISTS_TAC `UNIONS {c n | n IN (:num)}:(real^N->bool)->bool` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE]; REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM SET_TAC[]; X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `{t:real^N->bool | t IN UNIONS {c n | n IN (:num)} /\ t SUBSET v}` THEN CONJ_TAC THENL [SET_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM] THEN CONJ_TAC THENL [GEN_REWRITE_TAC I [SUBSET]; SET_TAC[]] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN MP_TAC(ISPEC `r / &2` ARCH_EVENTUALLY_INV1) THEN ASM_REWRITE_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN SUBGOAL_THEN `(a:real^N) IN UNIONS (c(n:num))` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `t:real^N->bool`]) THEN ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN TRANS_TAC SUBSET_TRANS `ball(a:real^N,r) INTER s` THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `x IN ball(b:real^N,inv(&n + &1)) /\ a IN ball(b,inv(&n + &1))` MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_BALL]] THEN UNDISCH_TAC `inv (&n + &1) < r / &2` THEN CONV_TAC NORM_ARITH]);; let LOCALLY_AND_OPEN_IN_IDEMPOT = prove (`!P s:real^N->bool. locally (\u. open_in (subtopology euclidean s) u /\ locally (\v. open_in (subtopology euclidean u) v /\ P v) u) s <=> locally (\u. open_in (subtopology euclidean s) u /\ P u) s`, REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_AND_OPEN_IN] THEN EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN ASM_MESON_TAC[OPEN_IN_TRANS; SUBSET]; EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`v INTER w:real^N->bool`; `y:real^N`]) THEN SUBGOAL_THEN `(v:real^N->bool) SUBSET w /\ w SUBSET s` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `(y:real^N) IN w` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER]] THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_INTER; OPEN_IN_TRANS]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER]]);; let LOCALLY_IMP_COUNTABLE_UNION_OF = prove (`!P s:real^N->bool. locally P s ==> (COUNTABLE UNION_OF P) s`, REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN DISCH_THEN (MP_TAC o GEN `x:real^N` o SPECL [`s:real^N->bool`; `x:real^N`]) THEN REWRITE_TAC[OPEN_IN_REFL; RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN DISCH_TAC THEN REWRITE_TAC[UNION_OF] THEN MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (v:real^N->real^N->bool) t` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);; let LOCALLY_IMP_FINITE_UNION_OF = prove (`!P s:real^N->bool. compact s /\ locally P s ==> (FINITE UNION_OF P) s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN DISCH_THEN (MP_TAC o GEN `x:real^N` o SPECL [`s:real^N->bool`; `x:real^N`]) THEN REWRITE_TAC[OPEN_IN_REFL; RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN DISCH_TAC THEN REWRITE_TAC[UNION_OF] THEN FIRST_ASSUM(MP_TAC o SPEC `IMAGE (u:real^N->real^N->bool) s` o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (v:real^N->real^N->bool) t` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[]);; let LOCALLY_DIFF_CLOSED = prove (`!P s t:real^N->bool. locally P s /\ closed_in (subtopology euclidean s) t ==> locally P (s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]);; let LOCALLY_CLOSED_IN_EXPLICIT = prove (`!s v a:real^N. a IN v /\ open_in (subtopology euclidean s) v ==> ?u. a IN u /\ open_in (subtopology euclidean s) u /\ u SUBSET v /\ (subtopology euclidean s) closure_of u SUBSET v`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN STRIP_TAC THEN EXISTS_TAC `s INTER ball(a:real^N,r)` THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN DISCH_TAC THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER s SUBSET v ==> c SUBSET b ==> s INTER c SUBSET v`)) THEN ASM_SIMP_TAC[GSYM CLOSURE_BALL; EUCLIDEAN_CLOSURE_OF] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]);; let LOCALLY_CLOSED_IN = prove (`!s:real^N->bool. locally (closed_in (subtopology euclidean s)) s`, REWRITE_TAC[locally] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_CLOSED_IN_EXPLICIT) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN EXISTS_TAC `(subtopology euclidean s) closure_of u:real^N->bool` THEN ASM_REWRITE_TAC[CLOSED_IN_CLOSURE_OF] THEN ASM_SIMP_TAC[CLOSURE_OF_SUBSET; OPEN_IN_SUBSET]);; let LOCALLY_EMPTY = prove (`!P. locally P {}`, REWRITE_TAC[locally] THEN MESON_TAC[open_in; SUBSET; NOT_IN_EMPTY]);; let LOCALLY_SING = prove (`!P a. locally P {a} <=> P {a}`, REWRITE_TAC[locally; open_in] THEN REWRITE_TAC[SET_RULE `(w SUBSET {a} /\ P) /\ x IN w <=> w = {a} /\ x = a /\ P`] THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2; IN_SING] THEN REWRITE_TAC[SET_RULE `(u SUBSET {a} /\ P) /\ Q /\ a IN u /\ u SUBSET v /\ v SUBSET {a} <=> u = {a} /\ v = {a} /\ P /\ Q`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; IN_SING] THEN REWRITE_TAC[FORALL_UNWIND_THM2; MESON[REAL_LT_01] `?x. &0 < x`]);; let LOCALLY_INTER = prove (`!P:(real^N->bool)->bool. (!s t. P s /\ P t ==> P(s INTER t)) ==> !s t. locally P s /\ locally P t ==> locally P (s INTER t)`, GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[locally; OPEN_IN_OPEN] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; MESON[] `(!w x. (?t. P t /\ w = f t) /\ Q w x ==> R w x) <=> (!t x. P t /\ Q (f t) x ==> R (f t) x)`] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c /\ Q a b c /\ R a b c) <=> (?b c a. Q a b c /\ P a b c /\ R a b c)`] THEN REWRITE_TAC[AND_FORALL_THM; UNWIND_THM2; IN_INTER] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:real^N->bool` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u1:real^N->bool` (X_CHOOSE_THEN `v1:real^N->bool` STRIP_ASSUME_TAC)) (X_CHOOSE_THEN `u2:real^N->bool` (X_CHOOSE_THEN `v2:real^N->bool` STRIP_ASSUME_TAC))) THEN EXISTS_TAC `u1 INTER u2:real^N->bool` THEN EXISTS_TAC `v1 INTER v2:real^N->bool` THEN ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);; let LOCALLY_INTER_OPEN = prove (`!P s t u:real^N->bool. locally P s /\ open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t ==> locally P (s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[locally; IN_INTER] THEN MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN DISCH_THEN(MP_TAC o SPECL [`t INTER v:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s INTER t:real^N->bool` THEN CONJ_TAC THENL [SUBGOAL_THEN `t INTER v:real^N->bool = (s INTER t) INTER v` (fun th -> ASM_SIMP_TAC[th; OPEN_IN_INTER; OPEN_IN_REFL]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]]; REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]]);; let LOCALLY_OPEN_INTER = prove (`!P s t u:real^N->bool. locally P t /\ open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t ==> locally P (s INTER t)`, ONCE_REWRITE_TAC[INTER_COMM] THEN MESON_TAC[LOCALLY_INTER_OPEN]);; let LOCALLY_PCROSS = prove (`!P Q R. (!s:real^M->bool t:real^N->bool. P s /\ Q t ==> R(s PCROSS t)) ==> (!s t. locally P s /\ locally Q t ==> locally R (s PCROSS t))`, REPEAT STRIP_TAC THEN REWRITE_TAC[locally; FORALL_PASTECART] THEN MAP_EVERY X_GEN_TAC [`w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP PASTECART_IN_INTERIOR_SUBTOPOLOGY (ONCE_REWRITE_RULE[CONJ_SYM] th))) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`] o GEN_REWRITE_RULE I [locally]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `y:real^N`] o GEN_REWRITE_RULE I [locally]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `v'':real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`u':real^M->bool`; `u'':real^M->bool`] THEN STRIP_TAC THEN EXISTS_TAC `(u':real^M->bool) PCROSS (v':real^N->bool)` THEN EXISTS_TAC `(u'':real^M->bool) PCROSS (v'':real^N->bool)` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS; PCROSS_MONO; OPEN_IN_PCROSS] THEN ASM_MESON_TAC[PCROSS_MONO; SUBSET_TRANS]);; let HOMEOMORPHISM_LOCALLY = prove (`!P Q f:real^N->real^M g. (!s t. homeomorphism (s,t) (f,g) ==> (P s <=> Q t)) ==> (!s t. homeomorphism (s,t) (f,g) ==> (locally P s <=> locally Q t))`, let lemma = prove (`!P Q f g. (!s t. P s /\ homeomorphism (s,t) (f,g) ==> Q t) ==> (!s:real^N->bool t:real^M->bool. locally P s /\ homeomorphism (s,t) (f,g) ==> locally Q t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`IMAGE (g:real^M->real^N) w`; `(g:real^M->real^N) y`]) THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN SUBGOAL_THEN `IMAGE (g:real^M->real^N) w = {x | x IN s /\ f(x) IN w}` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`IMAGE (f:real^N->real^M) u`; `IMAGE (f:real^N->real^M) v`] THEN CONJ_TAC THENL [SUBGOAL_THEN `IMAGE (f:real^N->real^M) u = {x | x IN t /\ g(x) IN u}` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[homeomorphism] THEN REWRITE_TAC[homeomorphism] THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))); ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]) in REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; TAUT `p ==> q /\ r ==> s <=> p /\ r ==> q ==> s`] lemma) THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]);; let HOMEOMORPHIC_LOCALLY = prove (`!P Q. (!s:real^N->bool t:real^M->bool. s homeomorphic t ==> (P s <=> Q t)) ==> (!s t. s homeomorphic t ==> (locally P s <=> locally Q t))`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!a b c d. P a b c d) <=> (!c d a b. P a b c d)`] THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_LOCALLY THEN ASM_MESON_TAC[homeomorphic]);; let LOCALLY_TRANSLATION = prove (`!P:(real^N->bool)->bool. (!a s. P (IMAGE (\x. a + x) s) <=> P s) ==> (!a s. locally P (IMAGE (\x. a + x) s) <=> locally P s)`, GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MP_TAC(ISPECL [`P:(real^N->bool)->bool`; `P:(real^N->bool)->bool`; `\x:real^N. a + x`; `\x:real^N. --a + x`] HOMEOMORPHISM_LOCALLY) THEN REWRITE_TAC[homeomorphism] THEN SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x /\ a + --a + x = x`] THEN MESON_TAC[]);; let LOCALLY_INJECTIVE_LINEAR_IMAGE = prove (`!P:(real^N->bool)->bool Q:(real^M->bool)->bool. (!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (P (IMAGE f s) <=> Q s)) ==> (!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (locally P (IMAGE f s) <=> locally Q s))`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN ASM_CASES_TAC `linear(f:real^M->real^N) /\ (!x y. f x = f y ==> x = y)` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`Q:(real^M->bool)->bool`; `P:(real^N->bool)->bool`; `f:real^M->real^N`; `g:real^N->real^M`] HOMEOMORPHISM_LOCALLY) THEN ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN MESON_TAC[]);; let LOCALLY_OPEN_MAP_IMAGE = prove (`!P Q f:real^M->real^N s. f continuous_on s /\ (!t. open_in (subtopology euclidean s) t ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) /\ (!t. t SUBSET s /\ P t ==> Q(IMAGE f t)) /\ locally P s ==> locally Q (IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[locally] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN FIRST_ASSUM(MP_TAC o SPEC `w:real^N->bool` o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `?x. x IN s /\ (f:real^M->real^N) x = y` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{x | x IN s /\ (f:real^M->real^N) x IN w}`; `x:real^M`]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`IMAGE (f:real^M->real^N) u`; `IMAGE (f:real^M->real^N) v`] THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; let LOCALLY_FINE_COVERING_COMPACT = prove (`!P s:real^N->bool e. compact s /\ locally P s /\ &0 < e ==> ?f. FINITE f /\ UNIONS f = s /\ !c. c IN f ==> P c /\ bounded c /\ diameter c <= e`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN FIRST_ASSUM(SUBST1_TAC o SPEC `P:(real^N->bool)->bool` o MATCH_MP LOCALLY_AND_SMALL_LE) THEN DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_IMP_FINITE_UNION_OF) THEN REWRITE_TAC[UNION_OF] THEN MESON_TAC[]);; let LOCALLY_COUNTABLE = prove (`!s:real^N->bool. locally COUNTABLE s <=> COUNTABLE s`, GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o GEN `x:real^N` o SPECL [`s:real^N->bool`; `x:real^N`]) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[OPEN_IN_REFL] THEN MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `vu:real^N->real^N->bool`] THEN DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `UNIONS(IMAGE (u:real^N->real^N->bool) s)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET; COUNTABLE_SUBSET]; DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `w:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[COUNTABLE_SUBSET; OPEN_IN_IMP_SUBSET]]);; let LOCALLY_CONSTANT = prove (`!f:real^N->A s. connected s ==> (locally (\u. ?c. !x. x IN u ==> f x = c) s <=> ?c. !x. x IN s ==> f x = c)`, REPEAT STRIP_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL [DISCH_TAC; MESON_TAC[SUBSET; OPEN_IN_IMP_SUBSET]] THEN MATCH_MP_TAC LOCALLY_CONSTANT_IMP_CONSTANT THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN MESON_TAC[SUBSET]);; let [LOCALLY_CONTINUOUS_ON; LOCALLY_CONTINUOUS_ON_ALT; LOCALLY_CONTINUOUS_ON_EXPLICIT] = (CONJUNCTS o prove) (`(!f:real^M->real^N s. locally (\u. f continuous_on u) s <=> f continuous_on s) /\ (!f:real^M->real^N s. f continuous_on s <=> !x. x IN s ==> ?u v. open_in (subtopology euclidean s) u /\ x IN u /\ u SUBSET v /\ f continuous_on v) /\ (!f:real^M->real^N s. f continuous_on s <=> !x. x IN s ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\ f continuous_on u)`, REWRITE_TAC[AND_FORALL_THM; locally] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (s ==> p) /\ (r ==> s) ==> (p <=> s) /\ (s <=> q) /\ (s <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[OPEN_IN_REFL]; MESON_TAC[CONTINUOUS_ON_SUBSET]; MESON_TAC[CONTINUOUS_ON_SUBSET; OPEN_IN_IMP_SUBSET; SUBSET_REFL]; REWRITE_TAC[CONTINUOUS_ON] THEN MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[LIM_WITHIN_OPEN_IN]]);; (* ------------------------------------------------------------------------- *) (* Local compactness. *) (* ------------------------------------------------------------------------- *) let LOCALLY_COMPACT = prove (`!s:real^N->bool. locally compact s <=> !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\ open_in (subtopology euclidean s) u /\ compact v`, GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN MESON_TAC[SUBSET_INTER]; MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN EXISTS_TAC `cball(x:real^N,e) INTER v` THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL; COMPACT_INTER; COMPACT_CBALL; IN_INTER] THEN MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]]);; let LOCALLY_COMPACT_ALT = prove (`!s:real^N->bool. locally compact s <=> !x. x IN s ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\ compact(closure u) /\ closure u SUBSET s`, GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL; COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; let LOCALLY_COMPACT_INTER_CBALL = prove (`!s:real^N->bool. locally compact s <=> !x. x IN s ==> ?e. &0 < e /\ closed(cball(x,e) INTER s)`, GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT; OPEN_IN_CONTAINS_CBALL] THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `cball(x:real^N,e) INTER s = cball (x,e) INTER v` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[COMPACT_CBALL; COMPACT_INTER; COMPACT_IMP_CLOSED]; X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `ball(x:real^N,e) INTER s` THEN EXISTS_TAC `cball(x:real^N,e) INTER s` THEN REWRITE_TAC[GSYM OPEN_IN_CONTAINS_CBALL] THEN ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET] THEN ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; BOUNDED_CBALL] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN MESON_TAC[SUBSET; IN_INTER; BALL_SUBSET_CBALL]]);; let LOCALLY_COMPACT_INTER_CBALLS = prove (`!s:real^N->bool. locally compact s <=> !x. x IN s ==> ?e. &0 < e /\ !d. d <= e ==> closed(cball(x,d) INTER s)`, GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_REFL]] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `cball(x:real^N,d) INTER s = cball(x,d) INTER cball(x,e) INTER s` SUBST1_TAC THENL [REWRITE_TAC[GSYM INTER_ASSOC; GSYM CBALL_MIN_INTER] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[CLOSED_INTER; CLOSED_CBALL]]);; let LOCALLY_COMPACT_COMPACT = prove (`!s:real^N->bool. locally compact s <=> !k. k SUBSET s /\ compact k ==> ?u v. k SUBSET u /\ u SUBSET v /\ v SUBSET s /\ open_in (subtopology euclidean s) u /\ compact v`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_COMPACT] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SING_SUBSET; COMPACT_SING]] THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM] o check (is_forall o concl)) THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. k INTER u x) k`) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `UNIONS(IMAGE (u:real^N->real^N->bool) t)` THEN EXISTS_TAC `UNIONS(IMAGE (v:real^N->real^N->bool) t)` THEN REPEAT CONJ_TAC THENL [ALL_TAC; ALL_TAC; ALL_TAC; MATCH_MP_TAC OPEN_IN_UNIONS; MATCH_MP_TAC COMPACT_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE]] THEN ASM SET_TAC[]]);; let LOCALLY_COMPACT_COMPACT_ALT = prove (`!s:real^N->bool. locally compact s <=> !k. k SUBSET s /\ compact k ==> ?u. k SUBSET u /\ open_in (subtopology euclidean s) u /\ compact(closure u) /\ closure u SUBSET s`, GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL; COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; let LOCALLY_COMPACT_COMPACT_SUBOPEN = prove (`!s:real^N->bool. locally compact s <=> !k t. k SUBSET s /\ compact k /\ open t /\ k SUBSET t ==> ?u v. k SUBSET u /\ u SUBSET v /\ u SUBSET t /\ v SUBSET s /\ open_in (subtopology euclidean s) u /\ compact v`, GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN EQ_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`u INTER t:real^N->bool`; `closure(u INTER t:real^N->bool)`] THEN REWRITE_TAC[CLOSURE_SUBSET; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; TRANS_TAC SUBSET_TRANS `closure(u:real^N->bool)` THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN TRANS_TAC SUBSET_TRANS `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; ASM_SIMP_TAC[OPEN_IN_INTER_OPEN]; REWRITE_TAC[COMPACT_CLOSURE] THEN ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; SUBSET_TRANS; COMPACT_IMP_BOUNDED]]; FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `(:real^N)`]) THEN ASM_REWRITE_TAC[OPEN_UNIV; SUBSET_UNIV]]);; let OPEN_IMP_LOCALLY_COMPACT = prove (`!s:real^N->bool. open s ==> locally compact s`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`ball(x:real^N,e)`; `cball(x:real^N,e)`] THEN ASM_REWRITE_TAC[BALL_SUBSET_CBALL; CENTRE_IN_BALL; COMPACT_CBALL] THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[OPEN_BALL] THEN ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]);; let CLOSED_IMP_LOCALLY_COMPACT = prove (`!s:real^N->bool. closed s ==> locally compact s`, REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`s INTER ball(x:real^N,&1)`; `s INTER cball(x:real^N,&1)`] THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET; REAL_LT_01] THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN MP_TAC(ISPECL [`x:real^N`; `&1`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);; let IS_INTERVAL_LOCALLY_COMPACT_INTERVAL = prove (`!s:real^N->bool. is_interval s ==> locally (\k. ?a b. k = interval[a,b]) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[locally] THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`ww:real^N->bool`; `x:real^N`; `w:real^N->bool`] THEN ASM_CASES_TAC `s INTER w:real^N->bool = ww` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `e:real`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN STRIP_TAC THEN EXISTS_TAC `s INTER ball(x:real^N,e) INTER interval(c,d)` THEN EXISTS_TAC `interval[a:real^N,b] INTER interval[c:real^N,d]` THEN EXISTS_TAC `ball(x:real^N,e) INTER interval(c,d)` THEN ASM_SIMP_TAC[OPEN_INTERVAL; OPEN_INTER; OPEN_BALL; IN_INTER] THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [REWRITE_TAC[INTER_INTERVAL] THEN MESON_TAC[]; MP_TAC(ISPECL [`c:real^N`; `d:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM SET_TAC[]]);; let IS_INTERVAL_IMP_LOCALLY_COMPACT = prove (`!s:real^N->bool. is_interval s ==> locally compact s`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP IS_INTERVAL_LOCALLY_COMPACT_INTERVAL) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; COMPACT_INTERVAL]);; let LOCALLY_COMPACT_UNIV = prove (`locally compact (:real^N)`, SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; OPEN_UNIV]);; let LOCALLY_COMPACT_INTER = prove (`!s t:real^N->bool. locally compact s /\ locally compact t ==> locally compact (s INTER t)`, MATCH_MP_TAC LOCALLY_INTER THEN REWRITE_TAC[COMPACT_INTER]);; let LOCALLY_COMPACT_OPEN_IN = prove (`!s t:real^N->bool. open_in (subtopology euclidean s) t /\ locally compact s ==> locally compact t`, REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; OPEN_IMP_LOCALLY_COMPACT]);; let LOCALLY_COMPACT_CLOSED_IN = prove (`!s t:real^N->bool. closed_in (subtopology euclidean s) t /\ locally compact s ==> locally compact t`, REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; CLOSED_IMP_LOCALLY_COMPACT]);; let LOCALLY_COMPACT_DELETE = prove (`!s a:real^N. locally compact s ==> locally compact (s DELETE a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_COMPACT_OPEN_IN THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL]);; let SIGMA_COMPACT = prove (`!s:real^N->bool. locally compact s ==> ?f. COUNTABLE f /\ (!t. t IN f ==> compact t) /\ UNIONS f = s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_IMP_COUNTABLE_UNION_OF) THEN REWRITE_TAC[UNION_OF]);; let HOMEOMORPHIC_LOCAL_COMPACTNESS = prove (`!s t:real^N->bool. s homeomorphic t ==> (locally compact s <=> locally compact t)`, MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN REWRITE_TAC[HOMEOMORPHIC_COMPACTNESS]);; let LOCALLY_COMPACT_TRANSLATION_EQ = prove (`!a:real^N s. locally compact (IMAGE (\x. a + x) s) <=> locally compact s`, MATCH_MP_TAC LOCALLY_TRANSLATION THEN REWRITE_TAC[COMPACT_TRANSLATION_EQ]);; add_translation_invariants [LOCALLY_COMPACT_TRANSLATION_EQ];; let LOCALLY_COMPACT_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (locally compact (IMAGE f s) <=> locally compact s)`, MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN REWRITE_TAC[COMPACT_LINEAR_IMAGE_EQ]);; add_linear_invariants [LOCALLY_COMPACT_LINEAR_IMAGE_EQ];; let HOMEOMORPHISM_LOCAL_COMPACTNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (locally compact (IMAGE f k) <=> locally compact k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_LOCAL_COMPACTNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let LOCALLY_CLOSED = prove (`!s:real^N->bool. locally closed s <=> locally compact s`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[LOCALLY_MONO; COMPACT_IMP_CLOSED]] THEN REWRITE_TAC[locally] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `u INTER ball(x:real^N,&1)` THEN EXISTS_TAC `v INTER cball(x:real^N,&1)` THEN ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL] THEN ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN MP_TAC(ISPEC `x:real^N` BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);; let LOCALLY_COMPACT_CLOSED_UNION = prove (`!s t u:real^N->bool. locally compact s /\ locally compact t /\ closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t ==> locally compact (s UNION t)`, SUBGOAL_THEN `!s t:real^N->bool. locally compact s /\ locally compact t /\ closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t ==> locally compact (s UNION t)` MP_TAC THENL [ALL_TAC; REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[CLOSED_IN_SUBSET_TRANS; SUBSET_UNION; UNION_SUBSET; CLOSED_IN_IMP_SUBSET]] THEN REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL; IN_UNION] THEN INTRO_TAC "lcs lct cs ct" THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (TAUT `p \/ q ==> p /\ q \/ p /\ ~q \/ q /\ ~p`)) THENL [REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN SIMP_TAC[SET_RULE `u INTER (s UNION t) = u INTER s UNION u INTER t`] THEN MATCH_MP_TAC CLOSED_UNION THEN REWRITE_TAC[CBALL_MIN_INTER] THEN ASM_MESON_TAC[CLOSED_CBALL; CLOSED_INTER; INTER_ACI]; REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REMOVE_THEN "ct" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in]); REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REMOVE_THEN "cs" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in])] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; IN_DIFF; IN_UNION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THENL [SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) = cball(x,d) INTER cball (x,e) INTER s` SUBST1_TAC THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) = cball(x,d) INTER cball (x,e) INTER t` SUBST1_TAC THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC]] THEN ASM_MESON_TAC[CLOSED_INTER; CLOSED_CBALL]);; let LOCALLY_COMPACT_OPEN_UNIONS = prove (`!f:(real^N->bool)->bool u. (!c. c IN f ==> locally compact c) /\ (!c. c IN f ==> open_in (subtopology euclidean u) c) ==> locally compact (UNIONS f)`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_ALT; FORALL_IN_UNIONS] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `t:real^N->bool` o GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV) [LOCALLY_COMPACT_ALT]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET]] THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]);; let LOCALLY_COMPACT_OPEN_UNION = prove (`!s t:real^N->bool u. locally compact s /\ locally compact t /\ open_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) t ==> locally compact (s UNION t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{s:real^N->bool,t}`; `u:real^N->bool`] LOCALLY_COMPACT_OPEN_UNIONS) THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_2]);; let LOCALLY_COMPACT_PCROSS = prove (`!s:real^M->bool t:real^N->bool. locally compact s /\ locally compact t ==> locally compact (s PCROSS t)`, MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[COMPACT_PCROSS]);; let LOCALLY_COMPACT_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. locally compact (s PCROSS t) <=> s = {} \/ t = {} \/ locally compact s /\ locally compact t`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; PCROSS_EMPTY; LOCALLY_EMPTY] THEN MATCH_MP_TAC(TAUT `(~p ==> s) /\ (~q ==> r) ==> p \/ q \/ r /\ s`) THEN CONJ_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `a:real^M`; X_GEN_TAC `b:real^N`] THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_COMPACT_INTER)) THENL [DISCH_THEN(MP_TAC o SPEC `{a:real^M} PCROSS (:real^N)`); DISCH_THEN(MP_TAC o SPEC `(:real^M) PCROSS {b:real^N}`)] THEN ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_UNIV; CLOSED_SING; INTER_PCROSS; INTER_UNIV; SET_RULE `a IN s ==> s INTER {a} = {a}`] THEN ASM_MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_LOCAL_COMPACTNESS]);; let OPEN_IN_LOCALLY_COMPACT = prove (`!s t:real^N->bool. locally compact s ==> (open_in (subtopology euclidean s) t <=> t SUBSET s /\ !k. compact k /\ k SUBSET s ==> open_in (subtopology euclidean k) (k INTER t))`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN EXISTS_TAC `t INTER u:real^N->bool` THEN ASM_REWRITE_TAC[IN_INTER; INTER_SUBSET] THEN MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `closure u:real^N->bool`) THEN ANTS_TAC THENL [SUBGOAL_THEN `(closure u:real^N->bool) SUBSET v` MP_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; REWRITE_TAC[COMPACT_CLOSURE] THEN ASM_MESON_TAC[SUBSET_TRANS; BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]]; REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]]);; let LOCALLY_COMPACT_PROPER_IMAGE_EQ = prove (`!f:real^M->real^N s. f continuous_on s /\ (!k. k SUBSET (IMAGE f s) /\ compact k ==> compact {x | x IN s /\ f x IN k}) ==> (locally compact s <=> locally compact (IMAGE f s))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `IMAGE (f:real^M->real^N) s`] PROPER_MAP) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_ALT]) THEN DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}`) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?v. open_in (subtopology euclidean (IMAGE f s)) v /\ y IN v /\ {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET u` MP_TAC THENL [GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o LAND_CONV) [GSYM SING_SUBSET] THEN MATCH_MP_TAC CLOSED_MAP_OPEN_SUPERSET_PREIMAGE THEN ASM_REWRITE_TAC[SING_SUBSET; IN_SING]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `closure v SUBSET IMAGE (f:real^M->real^N) (closure u)` ASSUME_TAC THENL [TRANS_TAC SUBSET_TRANS `closure(IMAGE (f:real^M->real^N) u)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUBSET_CLOSURE THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]; CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]]; REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_ALT]) THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `closure v:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN v}` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN SUBGOAL_THEN `closure {x | x IN s /\ f x IN v} SUBSET {x | x IN s /\ (f:real^M->real^N) x IN closure v}` ASSUME_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN MP_TAC(ISPEC `v:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET]]]);; let LOCALLY_COMPACT_PROPER_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ (!k. k SUBSET (IMAGE f s) /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ locally compact s ==> locally compact (IMAGE f s)`, MESON_TAC[LOCALLY_COMPACT_PROPER_IMAGE_EQ]);; let LOCALLY_COMPACT_PROPER_CONTINUOUS_PREIMAGE = prove (`!f:real^M->real^N s t c. f continuous_on s /\ IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ locally compact c /\ c SUBSET t ==> locally compact {x | x IN s /\ f x IN c}`, REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `k:real^N->bool`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{x | x IN s /\ (f:real^M->real^N) x IN u}`; `{x | x IN s /\ (f:real^M->real^N) x IN k}`] THEN REPLICATE_TAC 3 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL [SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN u} = {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]);; let MUMFORD_LEMMA = prove (`!f:real^M->real^N s t y. f continuous_on s /\ IMAGE f s SUBSET t /\ locally compact s /\ y IN t /\ compact {x | x IN s /\ f x = y} ==> ?u v. open_in (subtopology euclidean s) u /\ open_in (subtopology euclidean t) v /\ {x | x IN s /\ f x = y} SUBSET u /\ y IN v /\ IMAGE f u SUBSET v /\ (!k. k SUBSET v /\ compact k ==> compact {x | x IN u /\ f x IN k})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}` o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT]) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `(closure u:real^M->bool) SUBSET v` ASSUME_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; ALL_TAC] THEN SUBGOAL_THEN `compact(closure u:real^M->bool)` ASSUME_TAC THENL [ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN SUBGOAL_THEN `!b. open_in (subtopology euclidean t) b /\ y IN b ==> u INTER {x | x IN s /\ (f:real^M->real^N) x IN b} PSUBSET closure u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}` MP_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[PSUBSET] THEN SIMP_TAC[CLOSURE_SUBSET; SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`] THEN MATCH_MP_TAC(MESON[] `!P. ~P s /\ P t ==> ~(s = t)`) THEN EXISTS_TAC `\a. !k. k SUBSET b /\ compact k ==> compact {x | x IN a /\ (f:real^M->real^N) x IN k}` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`; `b:real^N->bool`]) THEN ASM_REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN ANTS_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM SET_TAC[]; ASM SET_TAC[]]; X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN closure u INTER {x | x IN s /\ f x IN b} /\ f x IN k} = v INTER {x | x IN closure u /\ (f:real^M->real^N) x IN k}` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_INTER_CLOSED] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_CLOSURE] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]]; DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `t INTER ball(y:real^N,inv(&n + &1))`) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN SIMP_TAC[CLOSURE_SUBSET; SET_RULE `u SUBSET u' ==> (u INTER t PSUBSET u' INTER t <=> ?x. x IN u' /\ ~(x IN u) /\ x IN t)`] THEN REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; IN_BALL; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `closure u:real^M->bool` compact) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^M`; `r:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) l = y` ASSUME_TAC THENL [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [SUBGOAL_THEN `(f:real^M->real^N) continuous_on closure u` MP_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[o_THM]; REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN TRANS_TAC REAL_LT_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LT_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `l:real^M`)) THEN REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `e:real` THEN STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN ASM_REWRITE_TAC[LE_REFL; o_THM] THEN ASM SET_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Locally compact sets are closed in an open set and are homeomorphic *) (* to an absolutely closed set if we have one more dimension to play with. *) (* ------------------------------------------------------------------------- *) let LOCALLY_COMPACT_OPEN_INTER_CLOSURE = prove (`!s:real^N->bool. locally compact s ==> ?t. open t /\ s = t INTER closure s`, GEN_TAC THEN SIMP_TAC[LOCALLY_COMPACT; OPEN_IN_OPEN; CLOSED_IN_CLOSED] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; TAUT `p /\ x = y /\ q <=> x = y /\ p /\ q`] THEN ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN REWRITE_TAC[UNWIND_THM2] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (u:real^N->real^N->bool) s)` THEN ASM_SIMP_TAC[CLOSED_CLOSURE; OPEN_UNIONS; FORALL_IN_IMAGE] THEN REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `UNIONS {v INTER s | v | v IN IMAGE (u:real^N->real^N->bool) s}` THEN CONJ_TAC THENL [SIMP_TAC[UNIONS_GSPEC; EXISTS_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f(g x) = f'(g x)) ==> {f x | x IN IMAGE g s} = {f' x | x IN IMAGE g s}`) THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET_INTER; INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure((u:real^N->real^N->bool) x INTER s)` THEN ASM_SIMP_TAC[OPEN_INTER_CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(v:real^N->real^N->bool) x` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);; let LOCALLY_COMPACT_CLOSED_IN_OPEN = prove (`!s:real^N->bool. locally compact s ==> ?t. open t /\ closed_in (subtopology euclidean t) s`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM SUBST1_TAC THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]);; let LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED = prove (`!s:real^M->bool. locally compact s ==> ?t:real^(M,N)finite_sum->bool f. closed t /\ homeomorphism (s,t) (f,fstcart)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `closed(s:real^M->bool)` THENL [EXISTS_TAC `(s:real^M->bool) PCROSS {vec 0:real^N}` THEN EXISTS_TAC `\x. (pastecart x (vec 0):real^(M,N)finite_sum)` THEN ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_SING; HOMEOMORPHISM] THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN SIMP_TAC[FSTCART_PASTECART]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN DISJ_CASES_TAC(SET_RULE `t = (:real^M) \/ ~((:real^M) DIFF t = {})`) THENL [ASM_MESON_TAC[CLOSURE_EQ; INTER_UNIV]; ALL_TAC] THEN ABBREV_TAC `f:real^M->real^(M,N)finite_sum = \x. pastecart x (inv(setdist({x},(:real^M) DIFF t)) % vec 1)` THEN SUBGOAL_THEN `homeomorphism (t,IMAGE (f:real^M->real^(M,N)finite_sum) t) (f,fstcart)` ASSUME_TAC THENL [SIMP_TAC[HOMEOMORPHISM; SUBSET_REFL; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(TAUT `(r ==> q /\ s) /\ r /\ p ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [SET_TAC[]; EXPAND_TAC "f"] THEN SIMP_TAC[FSTCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN REWRITE_TAC[SETDIST_EQ_0_SING; CONTINUOUS_ON_LIFT_SETDIST] THEN ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN]; ALL_TAC] THEN EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) s` THEN EXISTS_TAC `f:real^M->real^(M,N)finite_sum` THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) t` THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC [`fstcart:real^(M,N)finite_sum->real^M`; `t:real^M->bool`] THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]; SUBGOAL_THEN `IMAGE (f:real^M->real^(M,N)finite_sum) t = {z | (setdist({fstcart z},(:real^M) DIFF t) % sndcart z) IN {vec 1}}` SUBST1_TAC THENL [EXPAND_TAC "f" THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE; IN_INTER; GSYM CONJ_ASSOC; UNWIND_THM1; IN_SING] THEN REWRITE_TAC[CART_EQ; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN MP_TAC(ISPECL [`(:real^M) DIFF t`; `x:real^M`] (CONJUNCT1 SETDIST_EQ_0_SING)) THEN ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN] THEN ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> (y = inv x * &1 <=> x * y = &1)`] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING] THEN X_GEN_TAC `z:real^(M,N)finite_sum` THEN MATCH_MP_TAC CONTINUOUS_MUL THEN SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_SNDCART; o_DEF] THEN SUBGOAL_THEN `(\z:real^(M,N)finite_sum. lift(setdist({fstcart z},(:real^M) DIFF t))) = (\x. lift (setdist ({x},(:real^M) DIFF t))) o fstcart` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART] THEN REWRITE_TAC[CONTINUOUS_AT_LIFT_SETDIST]]]; MATCH_MP_TAC HOMEOMORPHISM_OF_SUBSETS THEN MAP_EVERY EXISTS_TAC [`t:real^M->bool`; `IMAGE (f:real^M->real^(M,N)finite_sum) t`] THEN ASM SET_TAC[]]);; let LOCALLY_COMPACT_CLOSED_INTER_OPEN = prove (`!s:real^N->bool. locally compact s <=> ?t u. closed t /\ open u /\ s = t INTER u`, MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT; LOCALLY_COMPACT_INTER; INTER_COMM; CLOSED_CLOSURE; LOCALLY_COMPACT_OPEN_INTER_CLOSURE]);; let LOCALLY_COMPACT_CLOSED_DIFF = prove (`!s:real^N->bool. locally compact s <=> ?t u. closed t /\ closed u /\ t DIFF u = s`, GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_CLOSED_INTER_OPEN] THEN MATCH_MP_TAC(MESON[COMPL_COMPL] `(!t u. P t u <=> Q t (UNIV DIFF u)) ==> ((?t u. P t u) <=> (?t u. Q t u))`) THEN REWRITE_TAC[GSYM OPEN_CLOSED; SET_RULE `t DIFF (UNIV DIFF s) = t INTER s`] THEN REWRITE_TAC[EQ_SYM_EQ]);; let LOCALLY_COMPACT_CLOSURE_DIFF = prove (`!s:real^N->bool. locally compact s <=> closed(closure s DIFF s)`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[LOCALLY_COMPACT_CLOSED_INTER_OPEN; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN SUBGOAL_THEN `closure(c INTER u) DIFF (c INTER u):real^N->bool = closure(c INTER u) INTER (c DIFF u)` (fun t -> ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSED_DIFF; CLOSED_INTER; t]) THEN MP_TAC(SET_RULE `c:real^N->bool = (c INTER u) UNION (c DIFF u)`) THEN DISCH_THEN(MP_TAC o AP_TERM `closure:(real^N->bool)->real^N->bool`) THEN ASM_SIMP_TAC[CLOSURE_UNION; CLOSURE_CLOSED; CLOSED_DIFF] THEN SET_TAC[]; DISCH_TAC THEN SUBGOAL_THEN `s:real^N->bool = closure s DIFF (closure(s) DIFF s)` SUBST1_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]; REWRITE_TAC[LOCALLY_COMPACT_CLOSED_DIFF] THEN ASM_MESON_TAC[CLOSED_CLOSURE]]]);; (* ------------------------------------------------------------------------- *) (* F_sigma and G_delta sets. *) (* ------------------------------------------------------------------------- *) let gdelta = new_definition `gdelta(s:real^N->bool) <=> (COUNTABLE INTERSECTION_OF open) s`;; let fsigma = new_definition `fsigma (s:real^N->bool) <=> (COUNTABLE UNION_OF closed) s`;; let FSIGMA_UNIONS_COMPACT = prove (`!s:real^N->bool. fsigma s <=> (COUNTABLE UNION_OF compact) s`, GEN_TAC THEN REWRITE_TAC[fsigma; UNION_OF] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[COMPACT_IMP_CLOSED]] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!c:real^N->bool. ?g. c IN u ==> COUNTABLE g /\ (!t. t IN g ==> compact t) /\ UNIONS g = c` MP_TAC THENL [ASM_MESON_TAC[SIGMA_COMPACT; CLOSED_IMP_LOCALLY_COMPACT]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:(real^N->bool)->(real^N->bool)->bool` THEN STRIP_TAC THEN EXISTS_TAC`UNIONS {(f:(real^N->bool)->(real^N->bool)->bool) c | c IN u}` THEN REWRITE_TAC[SIMPLE_IMAGE] THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE]; ASM SET_TAC[]]);; let GDELTA_COMPLEMENT = prove (`!s. gdelta((:real^N) DIFF s) <=> fsigma s`, GEN_TAC THEN REWRITE_TAC[gdelta; fsigma; UNION_OF; INTERSECTION_OF] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\s. (:real^N) DIFF s) g` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED; GSYM closed] THEN ONCE_REWRITE_TAC[INTERS_UNIONS; UNIONS_INTERS] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN ASM_REWRITE_TAC[COMPL_COMPL; SET_RULE `{x | x IN s} = s`]);; let FSIGMA_ASCENDING = prove (`!s:real^N->bool. fsigma s <=> ?c. (!n. compact(c n)) /\ (!n. c n SUBSET c(SUC n)) /\ UNIONS {c n | n IN (:num)} = s`, REWRITE_TAC[FSIGMA_UNIONS_COMPACT] THEN SIMP_TAC[COUNTABLE_UNION_OF_ASCENDING; COMPACT_EMPTY; COMPACT_UNION]);; let FSIGMA_COMPLEMENT = prove (`!s. fsigma((:real^N) DIFF s) <=> gdelta s`, ONCE_REWRITE_TAC[GSYM GDELTA_COMPLEMENT] THEN REWRITE_TAC[COMPL_COMPL]);; let GDELTA_DESCENDING = prove (`!s:real^N->bool. gdelta s <=> ?u. (!n. open(u n)) /\ (!n. u(SUC n) SUBSET u n) /\ INTERS {u n | n IN (:num)} = s`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[GSYM FSIGMA_COMPLEMENT; FSIGMA_ASCENDING] THEN DISCH_THEN(X_CHOOSE_THEN `u:num->real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n:num. (:real^N) DIFF u n` THEN ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED; SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`] THEN REWRITE_TAC[INTERS_UNIONS; SET_RULE `{g y | y IN {f x | x IN UNIV}} = {g(f x) | x IN UNIV}`] THEN ASM_REWRITE_TAC[COMPL_COMPL]; DISCH_THEN(X_CHOOSE_THEN `u:num->real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN EXISTS_TAC `{u n | n IN (:num)}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM]]);; let GDELTA_TRANSLATION = prove (`!a:real^N s. gdelta (IMAGE (\x. a + x) s) <=> gdelta s`, REWRITE_TAC[gdelta; INTERSECTION_OF] THEN GEOM_TRANSLATE_TAC[]);; let FSIGMA_TRANSLATION = prove (`!a:real^N s. fsigma (IMAGE (\x. a + x) s) <=> fsigma s`, REWRITE_TAC[fsigma; UNION_OF] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [GDELTA_TRANSLATION; FSIGMA_TRANSLATION];; let GDELTA_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (gdelta(IMAGE f s) <=> gdelta s)`, REWRITE_TAC[gdelta; INTERSECTION_OF] THEN GEOM_TRANSFORM_TAC[]);; let FSIGMA_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (fsigma(IMAGE f s) <=> fsigma s)`, REWRITE_TAC[fsigma; UNION_OF] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [GDELTA_LINEAR_IMAGE; FSIGMA_LINEAR_IMAGE];; let FSIGMA_LOCALLY_COMPACT = prove (`!s:real^N->bool. locally compact s ==> fsigma s`, MESON_TAC[fsigma; UNION_OF; SIGMA_COMPACT; COMPACT_IMP_CLOSED]);; let OPEN_IMP_FSIGMA = prove (`!s:real^N->bool. open s ==> fsigma s`, MESON_TAC[OPEN_IMP_LOCALLY_COMPACT; FSIGMA_LOCALLY_COMPACT]);; let CLOSED_IMP_FSIGMA = prove (`!s:real^N->bool. closed s ==> fsigma s`, MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT; FSIGMA_LOCALLY_COMPACT]);; let CLOSED_IMP_GDELTA = prove (`!s:real^N->bool. closed s ==> gdelta s`, REWRITE_TAC[closed; GSYM FSIGMA_COMPLEMENT; OPEN_IMP_FSIGMA]);; let FSIGMA_SING = prove (`!x:real^N. fsigma {x}`, SIMP_TAC[CLOSED_IMP_FSIGMA; CLOSED_SING]);; let GDELTA_SING = prove (`!x:real^N. gdelta {x}`, SIMP_TAC[CLOSED_IMP_GDELTA; CLOSED_SING]);; let OPEN_IMP_GDELTA = prove (`!s:real^N->bool. open s ==> gdelta s`, REPEAT STRIP_TAC THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN EXISTS_TAC `{s:real^N->bool}` THEN ASM_REWRITE_TAC[COUNTABLE_SING; FORALL_IN_INSERT; INTERS_1] THEN REWRITE_TAC[NOT_IN_EMPTY]);; let GDELTA_EMPTY = prove (`gdelta {}`, SIMP_TAC[OPEN_IMP_GDELTA; OPEN_EMPTY]);; let FSIGMA_EMPTY = prove (`fsigma {}`, SIMP_TAC[CLOSED_IMP_FSIGMA; CLOSED_EMPTY]);; let GDELTA_UNIV = prove (`gdelta (:real^N)`, SIMP_TAC[OPEN_IMP_GDELTA; OPEN_UNIV]);; let FSIGMA_UNIV = prove (`fsigma (:real^N)`, SIMP_TAC[CLOSED_IMP_FSIGMA; CLOSED_UNIV]);; let GDELTA_INTERS = prove (`!g:(real^N->bool)->bool. COUNTABLE g /\ (!u. u IN g ==> gdelta u) ==> gdelta(INTERS g)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:(real^N->bool)->(real^N->bool)->bool` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS {(h:(real^N->bool)->(real^N->bool)->bool) u | u IN g}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE]; REWRITE_TAC[FORALL_IN_UNIONS] THEN ASM SET_TAC[]; ASM SET_TAC[]]);; let GDELTA_INTER = prove (`!s t:real^N->bool. gdelta s /\ gdelta t ==> gdelta(s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN MATCH_MP_TAC GDELTA_INTERS THEN REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let GDELTA_DIFF = prove (`!s t:real^N->bool. gdelta s /\ fsigma t ==> gdelta(s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[GDELTA_INTER; GDELTA_COMPLEMENT]);; let FSIGMA_UNIONS = prove (`!g:(real^N->bool)->bool. COUNTABLE g /\ (!u. u IN g ==> fsigma u) ==> fsigma(UNIONS g)`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS_INTERS; FSIGMA_COMPLEMENT] THEN MATCH_MP_TAC GDELTA_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; GDELTA_COMPLEMENT; FORALL_IN_IMAGE; COUNTABLE_IMAGE]);; let COUNTABLE_IMP_FSIGMA = prove (`!s:real^N->bool. COUNTABLE s ==> fsigma s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s = UNIONS {{x:real^N} | x IN s}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; MATCH_MP_TAC FSIGMA_UNIONS] THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN REWRITE_TAC[FSIGMA_SING]);; let FSIGMA_UNION = prove (`!s t:real^N->bool. fsigma s /\ fsigma t ==> fsigma(s UNION t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN MATCH_MP_TAC FSIGMA_UNIONS THEN REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY] THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let GDELTA_UNION = prove (`!s t:real^N->bool. gdelta s /\ gdelta t ==> gdelta(s UNION t)`, REPEAT GEN_TAC THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `g:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) (X_CHOOSE_THEN `h:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM))) THEN EXISTS_TAC `IMAGE (\(s:real^N->bool,t). s UNION t) (g CROSS h)` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; OPEN_UNION; FORALL_PAIR_THM; IN_CROSS] THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[INTERS_IMAGE; IN_UNION] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_CROSS; IN_ELIM_THM; IN_UNION; IN_INTERS] THEN MESON_TAC[]);; let FSIGMA_INTER = prove (`!s t:real^N->bool. fsigma s /\ fsigma t ==> fsigma(s INTER t)`, REWRITE_TAC[GSYM GDELTA_COMPLEMENT; SET_RULE `s INTER t = UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t))`] THEN REWRITE_TAC[COMPL_COMPL; GDELTA_UNION]);; let FSIGMA_DIFF = prove (`!s t:real^N->bool. fsigma s /\ gdelta t ==> fsigma(s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[FSIGMA_INTER; FSIGMA_COMPLEMENT]);; let GDELTA_UNIONS = prove (`!g:(real^N->bool)->bool. FINITE g /\ (!u. u IN g ==> gdelta u) ==> gdelta(UNIONS g)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; GDELTA_EMPTY] THEN SIMP_TAC[UNIONS_INSERT; FORALL_IN_INSERT; GDELTA_UNION]);; let FSIGMA_INTERS = prove (`!g:(real^N->bool)->bool. FINITE g /\ (!u. u IN g ==> fsigma u) ==> fsigma(INTERS g)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[INTERS_0; FSIGMA_UNIV] THEN SIMP_TAC[INTERS_INSERT; FORALL_IN_INSERT; FSIGMA_INTER]);; let OPEN_IN_FSIGMA = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s /\ fsigma t ==> fsigma s`, REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FSIGMA_INTER THEN ASM_SIMP_TAC[OPEN_IMP_FSIGMA]);; let CLOSED_IN_FSIGMA = prove (`!s t:real^N->bool. closed_in (subtopology euclidean t) s /\ fsigma t ==> fsigma s`, REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FSIGMA_INTER THEN ASM_SIMP_TAC[CLOSED_IMP_FSIGMA]);; let OPEN_IN_GDELTA = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s /\ gdelta t ==> gdelta s`, REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTER THEN ASM_SIMP_TAC[OPEN_IMP_GDELTA]);; let CLOSED_IN_GDELTA = prove (`!s t:real^N->bool. closed_in (subtopology euclidean t) s /\ gdelta t ==> gdelta s`, REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTER THEN ASM_SIMP_TAC[CLOSED_IMP_GDELTA]);; let GDELTA_LOCALLY_COMPACT = prove (`!s:real^N->bool. locally compact s ==> gdelta s`, GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTER THEN ASM_SIMP_TAC[OPEN_IMP_GDELTA; CLOSED_IMP_GDELTA; CLOSED_CLOSURE]);; let FSIGMA_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ fsigma s ==> fsigma (IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FSIGMA_UNIONS_COMPACT]) THEN REWRITE_TAC[UNION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[IMAGE_UNIONS] THEN MATCH_MP_TAC FSIGMA_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC CLOSED_IMP_FSIGMA THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let HOMEOMORPHIC_FSIGMANESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (fsigma s <=> fsigma t)`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[FSIGMA_CONTINUOUS_IMAGE]);; let HOMEOMORPHISM_FSIGMANESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (fsigma(IMAGE f k) <=> fsigma k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_FSIGMANESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let FSIGMA_FSIGMA_PROJECTION = prove (`!s:real^M->bool t:real^(M,N)finite_sum->bool. IMAGE fstcart t SUBSET s /\ fsigma t ==> fsigma {y | ?x. x IN s /\ pastecart x y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{y:real^N | ?x:real^M. x IN s /\ pastecart x y IN t} = IMAGE sndcart t` SUBST1_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART; EXISTS_PASTECART; FSTCART_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN MESON_TAC[]; MATCH_MP_TAC FSIGMA_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON]]);; let CONTINUOUS_FSIGMA_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ fsigma s /\ fsigma t ==> fsigma {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fsigma]) THEN REWRITE_TAC[UNION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `!t. t IN g ==> closed_in (subtopology euclidean s) {x | x IN s /\ (f:real^M->real^N) x IN t}` MP_TAC THENL [ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE]; REWRITE_TAC[CLOSED_IN_CLOSED]] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:(real^N->bool)->(real^M->bool)` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ f x IN UNIONS g} = s INTER (UNIONS (IMAGE (u:(real^N->bool)->(real^M->bool)) g))` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC FSIGMA_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FSIGMA_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; CLOSED_IMP_FSIGMA]);; let CONTINUOUS_GDELTA_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ gdelta s /\ gdelta t ==> gdelta {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gdelta]) THEN REWRITE_TAC[INTERSECTION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; IN_UNIV; SET_RULE `{x | x IN s} = s`] THEN SUBGOAL_THEN `!t. t IN g ==> open_in (subtopology euclidean s) {x | x IN s /\ (f:real^M->real^N) x IN t}` MP_TAC THENL [ASM_MESON_TAC[CONTINUOUS_OPEN_IN_PREIMAGE]; REWRITE_TAC[OPEN_IN_OPEN]] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:(real^N->bool)->(real^M->bool)` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ f x IN INTERS g} = s INTER (INTERS (IMAGE (u:(real^N->bool)->(real^M->bool)) g))` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC GDELTA_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTERS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; OPEN_IMP_GDELTA]);; let FSIGMA_PROPER_PREIMAGE = prove (`!f:real^M->real^N s t. (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) ==> (!k. k SUBSET t /\ fsigma k ==> fsigma {x | x IN s /\ f x IN k})`, REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[FSIGMA_UNIONS_COMPACT; UNION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN EXISTS_TAC `IMAGE (\c. {x | x IN s /\ (f:real^M->real^N) x IN c}) g` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; UNIONS_IMAGE] THEN CONJ_TAC THENL [REPEAT STRIP_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; let FSIGMA_PCROSS = prove (`!s:real^M->bool t:real^N->bool. fsigma s /\ fsigma t ==> fsigma(s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[fsigma; UNION_OF] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:(real^M->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) (X_CHOOSE_THEN `g:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM))) THEN EXISTS_TAC `{(s PCROSS t):real^(M,N)finite_sum->bool | s IN f /\ t IN g}` THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; CLOSED_PCROSS] THEN ASM_SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT] THEN REWRITE_TAC[UNIONS_GSPEC; EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM] THEN ASM SET_TAC[]);; let FSIGMA_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. fsigma(s PCROSS t) <=> s = {} \/ t = {} \/ fsigma s /\ fsigma t`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[FSIGMA_PCROSS; PCROSS_EMPTY; FSIGMA_EMPTY] THEN MATCH_MP_TAC(TAUT `(~p /\ ~q ==> r) ==> p \/ q \/ r`) THEN STRIP_TAC THEN CONJ_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] FSIGMA_CONTINUOUS_IMAGE); MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] FSIGMA_CONTINUOUS_IMAGE)] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS]);; let GDELTA_PCROSS = prove (`!s:real^M->bool t:real^N->bool. gdelta s /\ gdelta t ==> gdelta(s PCROSS t)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s PCROSS t = (s PCROSS (:real^N)) INTER ((:real^M) PCROSS t)` SUBST1_TAC THENL [REWRITE_TAC[INTER_PCROSS; INTER_UNIV]; ALL_TAC] THEN MATCH_MP_TAC GDELTA_INTER THEN CONJ_TAC THENL [UNDISCH_TAC `gdelta(s:real^M->bool)`; UNDISCH_TAC `gdelta(t:real^N->bool)`] THEN REWRITE_TAC[gdelta; INTERSECTION_OF; LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `f:(real^M->bool)->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN EXISTS_TAC `IMAGE (\s:real^M->bool. s PCROSS (:real^N)) f`; X_GEN_TAC `f:(real^N->bool)->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN EXISTS_TAC `IMAGE (\s:real^N->bool. (:real^M) PCROSS s) f`] THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; OPEN_PCROSS; OPEN_UNIV] THEN REWRITE_TAC[INTERS_IMAGE; EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; IN_UNIV] THEN SET_TAC[]);; let GDELTA_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. gdelta(s PCROSS t) <=> s = {} \/ t = {} \/ gdelta s /\ gdelta t`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[GDELTA_PCROSS; PCROSS_EMPTY; GDELTA_EMPTY] THEN MATCH_MP_TAC(TAUT `(~p /\ ~q ==> r) ==> p \/ q \/ r`) THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `~(t:real^N->bool = {})`; UNDISCH_TAC `~(s:real^M->bool = {})`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `y:real^N`; X_GEN_TAC `x:real^M`] THEN DISCH_TAC THENL [SUBGOAL_THEN `s = {x | x IN (:real^M) /\ pastecart x (y:real^N) IN (s PCROSS t)}` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `t = {y | y IN (:real^N) /\ pastecart (x:real^M) y IN (s PCROSS t)}` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC]] THEN MATCH_MP_TAC CONTINUOUS_GDELTA_PREIMAGE THEN ASM_REWRITE_TAC[GDELTA_UNIV] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; let CARD_EQ_GDELTA_SETS = prove (`{s:real^N->bool | gdelta s} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `IMAGE INTERS {g | COUNTABLE g /\ g SUBSET {s:real^N->bool | open s}}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; IN_IMAGE; gdelta; INTERSECTION_OF; IN_ELIM_THM] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; TRANS_TAC CARD_LE_TRANS `{g | COUNTABLE g /\ g SUBSET {s:real^N->bool | open s}}` THEN REWRITE_TAC[CARD_LE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN MATCH_MP_TAC CARD_EQ_COUNTABLE_SUBSETS_SUBREAL THEN SUBGOAL_THEN `{s:real^N->bool | open s} =_c (:real)` MP_TAC THENL [REWRITE_TAC[CARD_EQ_OPEN_SETS]; SIMP_TAC[CARD_EQ_IMP_LE]] THEN DISCH_THEN(SUBST1_TAC o MATCH_MP CARD_INFINITE_CONG) THEN REWRITE_TAC[real_INFINITE]]; TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_CLOSED_SETS]; MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; CLOSED_IMP_GDELTA]]]);; let CARD_EQ_FSIGMA_SETS = prove (`{s:real^N->bool | fsigma s} =_c (:real)`, TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | gdelta s}` THEN REWRITE_TAC[CARD_EQ_GDELTA_SETS] THEN REWRITE_TAC[EQ_C_BIJECTIONS] THEN REPEAT(EXISTS_TAC `\s. (:real^N) DIFF s`) THEN SIMP_TAC[IN_ELIM_THM; FSIGMA_COMPLEMENT; GDELTA_COMPLEMENT] THEN SET_TAC[]);; let GDELTA_POINTS_OF_CONVERGENCE_WITHIN = prove (`!f:real^M->real^N s. gdelta {x | ?l. (f --> l) (at x within s)}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `{a | ?l. ((f:real^M->real^N) --> l) (at a within s)} = INTERS {UNIONS {u | open u /\ ?b. !x y. x IN (s INTER u) DELETE b /\ y IN (s INTER u) DELETE b ==> dist(f x,f y) < inv(&n + &1)} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[CONVERGENT_EQ_ZERO_OSCILLATION; EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; INTERS_GSPEC; UNIONS_GSPEC; IN_UNIV] THEN X_GEN_TAC `a:real^M` THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(&n + &1)`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MESON_TAC[]; MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `b:real^M = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `u INTER ball(a:real^M,dist(b,a))` THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL; IN_DELETE; GSYM DIST_NZ] THEN REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER; IN_DELETE] THEN ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]]; MATCH_MP_TAC GDELTA_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC OPEN_IMP_GDELTA THEN MATCH_MP_TAC OPEN_UNIONS THEN SET_TAC[]]);; let GDELTA_POINTS_OF_CONVERGENCE_AT = prove (`!f:real^M->real^N. gdelta {x | ?l. (f --> l) (at x)}`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[GDELTA_POINTS_OF_CONVERGENCE_WITHIN]);; let GDELTA_POINTS_OF_CONTINUITY_WITHIN = prove (`!f:real^M->real^N s. ?t. gdelta t /\ {x | x IN s /\ f continuous (at x within s)} = s INTER t`, REPEAT GEN_TAC THEN EXISTS_TAC `INTERS {UNIONS {u | open u /\ !x y. x IN s INTER u /\ y IN s INTER u ==> norm((f:real^M->real^N) x - f y) < inv(&n + &1)} | n IN (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC GDELTA_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IMP_GDELTA THEN MATCH_MP_TAC OPEN_UNIONS THEN SIMP_TAC[IN_ELIM_THM]; REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER] THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; UNIONS_GSPEC; IN_UNIV] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[continuous_within] THEN W(MP_TAC o PART_MATCH (rand o rand) FORALL_POS_MONO_1_EQ o rand o snd) THEN ANTS_TAC THENL [MESON_TAC[REAL_LT_TRANS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MAP_EVERY X_GEN_TAC [`y:real^M`; `z:real^M`] THEN REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `z:real^M` th)) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; dist] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist]]]);; let GDELTA_POINTS_OF_CONTINUITY = prove (`!f:real^M->real^N. gdelta {x | f continuous at x}`, GEN_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] GDELTA_POINTS_OF_CONTINUITY_WITHIN) THEN SIMP_TAC[WITHIN_UNIV; IN_UNIV; INTER_UNIV; LEFT_IMP_EXISTS_THM]);; (* ------------------------------------------------------------------------- *) (* Lavrentiev extension theorem. *) (* ------------------------------------------------------------------------- *) let LAVRENTIEV = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ gdelta t ==> ?u g. gdelta u /\ s SUBSET u /\ u SUBSET closure s /\ g continuous_on u /\ IMAGE g u SUBSET t /\ !x. x IN s ==> g x = f x`, let lemma = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ closed t ==> ?u g. gdelta u /\ s SUBSET u /\ u SUBSET closure s /\ g continuous_on u /\ IMAGE g u SUBSET t /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN ABBREV_TAC `u = {x | x IN closure s /\ ?l. ((f:real^M->real^N) --> l) (at x within s)}` THEN EXISTS_TAC `u:real^M->bool` THEN SUBGOAL_THEN `!x. x IN u ==> ?l. ((f:real^M->real^N) --> l) (at x within s) /\ (x IN s ==> f x = l)` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[CONTINUOUS_WITHIN; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; ASM SET_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM]] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(s:real^M->bool) SUBSET u` ASSUME_TAC THENL [EXPAND_TAC "u" THEN MATCH_MP_TAC(SET_RULE `s SUBSET t /\ (!x. x IN s ==> P x) ==> s SUBSET {x | x IN t /\ P x}`) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN ASM_MESON_TAC[CONTINUOUS_WITHIN; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; ASM_REWRITE_TAC[]] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "u" THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC GDELTA_INTER THEN REWRITE_TAC[GDELTA_POINTS_OF_CONVERGENCE_WITHIN] THEN SIMP_TAC[CLOSED_CLOSURE; CLOSED_IMP_GDELTA]; ASM SET_TAC[]; MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`; `u:real^M->bool`] CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN EXISTS_TAC `f:real^M->real^N` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `closure s = s /\ t SUBSET closure s ==> t SUBSET s`) THEN ASM_REWRITE_TAC[CLOSURE_EQ] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[LIM_WITHIN] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `e:real`) ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(x:real^M) IN closure s` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) y` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `y:real^M = x` THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_NZ]; ASM SET_TAC[]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL[`f:real^M->real^N`; `s:real^M->bool`; `closure t:real^N->bool`] lemma) THEN ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET]; ONCE_REWRITE_TAC[SWAP_EXISTS_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{x | x IN u /\ (g:real^M->real^N) x IN t}` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_GDELTA_PREIMAGE THEN ASM_REWRITE_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; ASM SET_TAC[]]);; let LAVRENTIEV_HOMEOMORPHISM = prove (`!f:real^M->real^N f' s s'. homeomorphism (s,s') (f,f') ==> ?u u' g g'. gdelta u /\ s SUBSET u /\ u SUBSET closure s /\ gdelta u' /\ s' SUBSET u' /\ u' SUBSET closure s' /\ (!x. x IN s ==> g x = f x) /\ (!x. x IN s' ==> g' x = f' x) /\ homeomorphism (u,u') (g,g')`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^N)`] LAVRENTIEV) THEN ASM_REWRITE_TAC[GDELTA_UNIV; SUBSET_UNIV; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f':real^N->real^M`; `s':real^N->bool`; `(:real^M)`] LAVRENTIEV) THEN ASM_REWRITE_TAC[GDELTA_UNIV; SUBSET_UNIV; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `g':real^N->real^M`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{x | x IN v /\ (g:real^M->real^N) x IN v'}`; `{x | x IN v' /\ (g':real^N->real^M) x IN v}`; `g:real^M->real^N`; `g':real^N->real^M`] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_GDELTA_PREIMAGE]; ALL_TAC] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC])) THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ p' /\ q' /\ r' <=> (r /\ r') /\ (p /\ p' ==> q /\ q') /\ (p /\ p')`] THEN CONJ_TAC THENL [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]] THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM IN_SING] THEN MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THENL [EXISTS_TAC `s:real^M->bool`; EXISTS_TAC `s':real^N->bool`] THEN REWRITE_TAC[IN_SING; VECTOR_SUB_EQ; CLOSED_SING] THEN (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; let LAVRENTIEV_HOMEOMORPHISM_SELF = prove (`!f:real^N->real^N f' s. homeomorphism (s,s) (f,f') ==> ?u g g'. gdelta u /\ s SUBSET u /\ u SUBSET closure s /\ (!x. x IN s ==> g x = f x /\ g' x = f' x) /\ homeomorphism (u,u) (g,g')`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` MP_TAC) THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^N->real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION `h 0 = u /\ (!n. h(SUC n) = h n INTER IMAGE g (h n) INTER {x:real^N | x IN u /\ g x IN h n})`) THEN EXISTS_TAC `INTERS {h n:real^N->bool | n IN (:num)}` THEN SUBGOAL_THEN `!n. (h:num->real^N->bool) n SUBSET u` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC GDELTA_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC GDELTA_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTER THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN CONJ_TAC THENL [SUBGOAL_THEN `IMAGE (g:real^N->real^N) (h(n:num)) = {x | x IN v /\ g' x IN h n}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_GDELTA_PREIMAGE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC; IN_UNIV] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `!a. a IN s /\ f a SUBSET t ==> INTERS {f x | x IN s} SUBSET t`) THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[IN_UNIV]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!a. a IN s /\ f a SUBSET t ==> INTERS {f x | x IN s} SUBSET t`) THEN EXISTS_TAC `0` THEN ASM SET_TAC[]; MATCH_MP_TAC(SET_RULE `!a. a IN s /\ f a SUBSET t ==> INTERS {f x | x IN s} SUBSET t`) THEN EXISTS_TAC `SUC 0` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!n. P(SUC n) ==> Q n) ==> (!n. P n) ==> (!n. Q n)`) THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_IMAGE; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(fun th -> EXISTS_TAC `(g':real^N->real^N) x` THEN CONJ_TAC THEN MP_TAC th) THENL [DISCH_THEN(MP_TAC o SPEC `SUC 0`); MATCH_MP_TAC(MESON[] `(!n. P(SUC n) ==> Q n) ==> (!n. P n) ==> (!n. Q n)`)] THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]]]);; let HOMEOMORPHIC_GDELTANESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (gdelta s <=> gdelta t)`, let lemma = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> gdelta s ==> gdelta t`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN MAP_EVERY X_GEN_TAC [`f':real^M->real^N`; `g':real^N->real^M`] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN SUBGOAL_THEN `t = {x | x IN v /\ (g':real^N->real^M) x IN s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_GDELTA_PREIMAGE THEN ASM_SIMP_TAC[]) in REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC lemma THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; let HOMEOMORPHISM_GDELTANESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (gdelta(IMAGE f k) <=> gdelta k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_GDELTANESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Effective countability of closed or open chains. *) (* ------------------------------------------------------------------------- *) let EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS = prove (`!f v:real^N->bool. (!s. s IN f ==> closed_in (subtopology euclidean v) s \/ open_in (subtopology euclidean v) s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ UNIONS f' = UNIONS f`, let lemma = prove (`!f v:real^N->bool. (!s. s IN f ==> closed_in (subtopology euclidean v) s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ UNIONS f' = UNIONS f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `?s:real^N->bool. s IN f /\ !s'. s' IN f ==> s' SUBSET s` THENL [FIRST_X_ASSUM(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{s:real^N->bool}` THEN ASM_REWRITE_TAC[COUNTABLE_SING; SING_SUBSET; UNIONS_1] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `\(s:real^N->bool,t). s IN f /\ t IN f /\ s SUBSET t` TOSET_COFINAL_WOSET) THEN SUBGOAL_THEN `fl(\(s:real^N->bool,t). s IN f /\ t IN f /\ s SUBSET t) = f` ASSUME_TAC THENL [REWRITE_TAC[fl; FUN_EQ_THM] THEN ASM_MESON_TAC[IN]; ALL_TAC] THEN ASM_REWRITE_TAC[toset; poset] THEN ANTS_TAC THENL [ASM_MESON_TAC[IN; SUBSET_REFL; SUBSET_TRANS; SUBSET_ANTISYM]; DISCH_THEN(X_CHOOSE_THEN `w:((real^N->bool)#(real^N->bool)->bool)` STRIP_ASSUME_TAC)] THEN FIRST_ASSUM(MP_TAC o MATCH_MP FL_SUBSET) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `f':(real^N->bool)->bool = fl w` THEN DISCH_TAC THEN EXISTS_TAC `f':(real^N->bool)->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC(ISPEC `v:real^N->bool` SUBSET_SECOND_COUNTABLE) THEN DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_LE_COUNTABLE)) THEN MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN EXISTS_TAC `\b c:real^N->bool. DISJOINT b c /\ !c'. c' IN f' /\ c PSUBSET c' ==> ~(DISJOINT b c')` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `(s SUBSET t \/ t SUBSET s) /\ ~(s PSUBSET t) /\ ~(t PSUBSET s) ==> s = t`) THEN ASM_MESON_TAC[SUBSET]] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\c':real^N->bool. c' IN f' /\ c PSUBSET c'` o last o CONJUNCTS o GEN_REWRITE_RULE I [woset]) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?c':real^N->bool. c' IN f /\ ~(c' SUBSET c)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `c PSUBSET (c':real^N->bool)` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?c'':real^N->bool. c'' IN f' /\ c' SUBSET c''` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `c':real^N->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `?p:real^N. p IN c' /\ ~(p IN c)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean v) (v DIFF c:real^N->bool)` (ANTE_RES_THEN MP_TAC) THENL [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `bb:(real^N->bool)->bool` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `(p:real^N) IN v DIFF c` MP_TAC THENL [ASM_MESON_TAC[SUBSET; IN_DIFF; CLOSED_IN_IMP_SUBSET]; ASM_REWRITE_TAC[IN_UNIONS]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN UNDISCH_TAC `w SUBSET (\(s:real^N->bool,t). s IN f /\ t IN f /\ s SUBSET t)` THEN GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `(c':real^N->bool),(d:real^N->bool)`) THEN ASM_SIMP_TAC[IN] THEN ASM SET_TAC[]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{s:real^N->bool | s IN f /\ closed_in (subtopology euclidean v) s}`; `v:real^N->bool`] lemma) THEN MP_TAC(ISPECL [`{s:real^N->bool | s IN f /\ open_in (subtopology euclidean v) s}`; `v:real^N->bool`] LINDELOF_OPEN_IN) THEN ASM_SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `fo:(real^N->bool)->bool` THEN STRIP_TAC THEN X_GEN_TAC `fc:(real^N->bool)->bool` THEN STRIP_TAC THEN EXISTS_TAC `fo UNION fc:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[COUNTABLE_UNION] THEN ASM SET_TAC[]);; let COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN = prove (`!f v:real^N->bool. ~(f = {}) /\ (!s. s IN f ==> closed_in (subtopology euclidean v) s \/ open_in (subtopology euclidean v) s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(n) SUBSET u(SUC n)) /\ UNIONS {u n | n IN (:num)} = UNIONS f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `UNIONS f:real^N->bool = {}` THENL [EXISTS_TAC `(\n. {}):num->real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EMPTY_UNIONS]) THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]; MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `v:real^N->bool`] EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `f':(real^N->bool)->bool` COUNTABLE_ASCENDING_CHAIN) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[UNIONS_0; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]);; let EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS = prove (`!f v:real^N->bool. (!s. s IN f ==> closed_in (subtopology euclidean v) s \/ open_in (subtopology euclidean v) s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ INTERS f' = INTERS f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `f SUBSET {v:real^N->bool}` THENL [EXISTS_TAC `f:(real^N->bool)->bool` THEN ASM_MESON_TAC[COUNTABLE_SUBSET; COUNTABLE_SING; SUBSET_REFL]; ALL_TAC] THEN MP_TAC(ISPECL [`IMAGE (\s:real^N->bool. v DIFF s) f`; `v:real^N->bool`] EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_IMAGE_2] THEN ANTS_TAC THENL [ASM_MESON_TAC[SET_RULE `s SUBSET t ==> v DIFF t SUBSET v DIFF s`; OPEN_IN_REFL; CLOSED_IN_REFL; CLOSED_IN_DIFF; OPEN_IN_DIFF]; REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:(real^N->bool)->bool` THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THENL [DISCH_THEN(MP_TAC o SYM o last o CONJUNCTS) THEN ASM_REWRITE_TAC[EMPTY_UNIONS; IMAGE_CLAUSES; UNIONS_0] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `(!u. u IN f ==> v DIFF u = {}) ==> (!u. u IN f ==> u SUBSET v) ==> !u. u IN f ==> u = v`)) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ASM_REWRITE_TAC[GSYM IN_SING; GSYM SUBSET]]; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `!v. s SUBSET v /\ t SUBSET v /\ v DIFF s = v DIFF t ==> s = t`) THEN EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[DIFF_INTERS; SIMPLE_IMAGE] THEN CONJ_TAC THEN MATCH_MP_TAC INTERS_SUBSET THEN (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET; SUBSET]]]);; let COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN = prove (`!f v:real^N->bool. ~(f = {}) /\ (!s. s IN f ==> closed_in (subtopology euclidean v) s \/ open_in (subtopology euclidean v) s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(SUC n) SUBSET u n) /\ INTERS {u n | n IN (:num)} = INTERS f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `INTERS f = (:real^N)` THENL [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERS_EQ_UNIV]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM IN_SING] THEN ASM_SIMP_TAC[GSYM SUBSET; SET_RULE `~(f = {}) ==> (f SUBSET {a} <=> f = {a})`] THEN DISCH_TAC THEN EXISTS_TAC `(\n. UNIV):num->real^N->bool` THEN REWRITE_TAC[IN_SING; SUBSET_REFL; INTERS_EQ_UNIV; FORALL_IN_GSPEC]; MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `v:real^N->bool`] EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `f':(real^N->bool)->bool` COUNTABLE_DESCENDING_CHAIN) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[INTERS_0]; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]]);; let EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> closed s \/ open s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ UNIONS f' = UNIONS f`, REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS]);; let COUNTABLE_ASCENDING_CLOPEN_CHAIN = prove (`!f:(real^N->bool)->bool. ~(f = {}) /\ (!s. s IN f ==> closed s \/ open s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(n) SUBSET u(SUC n)) /\ UNIONS {u n | n IN (:num)} = UNIONS f`, REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN]);; let EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> closed s \/ open s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ INTERS f' = INTERS f`, REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS]);; let COUNTABLE_DESCENDING_CLOPEN_CHAIN = prove (`!f:(real^N->bool)->bool. ~(f = {}) /\ (!s. s IN f ==> closed s \/ open s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ?u. (!n. u(n) IN f) /\ (!n. u(SUC n) SUBSET u n) /\ INTERS {u n | n IN (:num)} = INTERS f`, REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN REWRITE_TAC[COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN]);; let FSIGMA_UNIONS_CLOPEN_CHAIN = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> closed s \/ open s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> fsigma(UNIONS f)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS) THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC FSIGMA_UNIONS THEN ASM_MESON_TAC[SUBSET; CLOSED_IMP_FSIGMA; OPEN_IMP_FSIGMA]);; let GDELTA_INTERS_CLOPEN_CHAIN = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> closed s \/ open s) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> gdelta(INTERS f)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS) THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC GDELTA_INTERS THEN ASM_MESON_TAC[SUBSET; CLOSED_IMP_GDELTA; OPEN_IMP_GDELTA]);; let CANTOR_BAIRE_STATIONARY_PRINCIPLE = prove (`!f:A->real^N->bool v w. woset w /\ ~COUNTABLE w /\ (!v. v inseg w /\ ~(v = w) ==> COUNTABLE v) /\ (!i. i IN fl w ==> closed_in (subtopology euclidean v) (f i) \/ open_in (subtopology euclidean v) (f i)) /\ (!i j. w(i,j) ==> f j SUBSET f i) ==> ?k. k IN fl w /\ !i. w(k,i) ==> f i = f k`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (f:A->real^N->bool) (fl w)`; `v:real^N->bool`] EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS) THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE_2; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [UNDISCH_TAC `woset(w:A#A->bool)` THEN REWRITE_TAC[woset; IN] THEN ASM_MESON_TAC[]; REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `k:A->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`w:A#A->bool`; `UNIONS {linseg w (a:A) | a IN k}`] INSEG_LINSEG) THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ ~q /\ (r ==> s) ==> (p <=> q \/ r) ==> s`) THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC UNION_INSEG THEN GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV) [GSYM IN] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[LINSEG_INSEG]; DISCH_THEN(MP_TAC o AP_TERM `COUNTABLE:(A#A->bool)->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COUNTABLE_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `a:A` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[LINSEG_INSEG] THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `(a:A,a)`) THEN REWRITE_TAC[linseg; less] THEN UNDISCH_TAC `woset(w:A#A->bool)` THEN REWRITE_TAC[woset] THEN ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:A` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN X_GEN_TAC `b:A` THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM SUBSET_ANTISYM_EQ] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s = INTERS f ==> !x. x IN f ==> s SUBSET x`)) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `b:A`) THEN REWRITE_TAC[fl; IN] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN REWRITE_TAC[SUBSET_INTERS; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:A` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [UNIONS_GSPEC]) THEN DISCH_THEN(MP_TAC o C AP_THM `(a,a):A#A`) THEN REWRITE_TAC[linseg; IN_ELIM_THM] THEN REWRITE_TAC[IN; less; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `c:A`) THEN UNDISCH_TAC `woset(w:A#A->bool)` THEN REWRITE_TAC[woset; IN] THEN ASM_MESON_TAC[IN; SUBSET]]]);; (* ------------------------------------------------------------------------- *) (* Very basics about Borel sets. *) (* ------------------------------------------------------------------------- *) let borel_RULES,borel_INDUCT,borel_CASES = new_inductive_definition `(!s. open s ==> borel s) /\ (!s. borel s ==> borel((:real^N) DIFF s)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> borel s) ==> borel(UNIONS u))`;; let BOREL_INDUCT_COMPACT = prove (`!P. (!s. compact s ==> P s) /\ (!s. P s ==> P ((:real^N) DIFF s)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) ==> !a. borel a ==> P a`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC borel_INDUCT THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_LOCALLY_COMPACT) THEN DISCH_THEN(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[]);; let BOREL_INDUCT_COMPACT_DIFF = prove (`!P. (!s. compact s ==> P s) /\ (!s t. P s /\ P t ==> P(s DIFF t)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) ==> !a:real^N->bool. borel a ==> P a`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC borel_INDUCT THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[OPEN_UNIV]; X_GEN_TAC `s:real^N->bool`] THEN DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_LOCALLY_COMPACT) THEN DISCH_THEN(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[]);; let BOREL_INDUCT_COMPACT_ALT = prove (`!P. (!s. compact s ==> P s) /\ (!s. P s ==> P((:real^N) DIFF s)) /\ (!u. COUNTABLE u /\ ~(u = {}) /\ (!s. s IN u ==> P s) ==> P(INTERS u)) ==> !a:real^N->bool. borel a ==> P a`, GEN_TAC THEN INTRO_TAC "C D I" THEN MATCH_MP_TAC BOREL_INDUCT_COMPACT THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN ASM_SIMP_TAC[UNIONS_0; COMPACT_EMPTY] THEN REWRITE_TAC[UNIONS_INTERS] THEN USE_THEN "D" MATCH_MP_TAC THEN USE_THEN "I" MATCH_MP_TAC THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY]);; let BOREL_INDUCT_UNIONS_INTERS = prove (`!P. (!s. open s ==> P s) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (INTERS u)) ==> !a:real^N->bool. borel a ==> P a`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!a. borel a ==> P a /\ P((:real^N) DIFF a)` (fun th -> MESON_TAC[th]) THEN MATCH_MP_TAC borel_INDUCT THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[OPEN_CLOSED] THEN DISCH_THEN(MP_TAC o MATCH_MP CLOSED_IMP_GDELTA) THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_SIMP_TAC[]; SIMP_TAC[COMPL_COMPL]; X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[DIFF_UNIONS] THEN REWRITE_TAC[GSYM INTERS_INSERT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[COUNTABLE_INSERT; COUNTABLE_IMAGE; SIMPLE_IMAGE] THEN REWRITE_TAC[FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[OPEN_UNIV]]);; let BOREL_INDUCT_COMPACT_UNIONS_INTERS = prove (`!P. (!s. compact s ==> P s) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (INTERS u)) ==> !a:real^N->bool. borel a ==> P a`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_INDUCT_UNIONS_INTERS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_LOCALLY_COMPACT) THEN DISCH_THEN(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[]);; let BOREL_INDUCT_CLOSED_UNIONS_INTERS = prove (`!P. (!s. closed s ==> P s) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (INTERS u)) ==> !a:real^N->bool. borel a ==> P a`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_INDUCT_COMPACT_UNIONS_INTERS THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED]);; let BOREL_INDUCT_OPEN_UNIONS_INTERS = prove (`!P. (!s. open s ==> P s) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (INTERS u)) ==> !a:real^N->bool. borel a ==> P a`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_INDUCT_CLOSED_UNIONS_INTERS THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IMP_GDELTA) THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN ASM_MESON_TAC[]);; let OPEN_IMP_BOREL = prove (`!s:real^N->bool. open s ==> borel s`, REWRITE_TAC[borel_RULES]);; let BOREL_COMPLEMENT = prove (`!s. borel((:real^N) DIFF s) <=> borel s`, MESON_TAC[COMPL_COMPL; borel_RULES]);; let BOREL_UNIONS = prove (`!u. COUNTABLE u /\ (!s:real^N->bool. s IN u ==> borel s) ==> borel(UNIONS u)`, REWRITE_TAC[borel_RULES]);; let BOREL_INTERS = prove (`!u. COUNTABLE u /\ (!s:real^N->bool. s IN u ==> borel s) ==> borel(INTERS u)`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERS_UNIONS] THEN REWRITE_TAC[BOREL_COMPLEMENT; SIMPLE_IMAGE] THEN MATCH_MP_TAC BOREL_UNIONS THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; BOREL_COMPLEMENT]);; let BOREL_EMPTY = prove (`borel {}`, SIMP_TAC[OPEN_IMP_BOREL; OPEN_EMPTY]);; let BOREL_UNIV = prove (`borel(:real^N)`, SIMP_TAC[OPEN_IMP_BOREL; OPEN_UNIV]);; let BOREL_UNION = prove (`!s t:real^N->bool. borel s /\ borel t ==> borel(s UNION t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN MATCH_MP_TAC BOREL_UNIONS THEN REWRITE_TAC[COUNTABLE_INSERT; FORALL_IN_INSERT] THEN ASM_REWRITE_TAC[COUNTABLE_EMPTY; NOT_IN_EMPTY]);; let BOREL_INTER = prove (`!s t:real^N->bool. borel s /\ borel t ==> borel(s INTER t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN MATCH_MP_TAC BOREL_INTERS THEN REWRITE_TAC[COUNTABLE_INSERT; FORALL_IN_INSERT] THEN ASM_REWRITE_TAC[COUNTABLE_EMPTY; NOT_IN_EMPTY]);; let BOREL_DIFF = prove (`!s t:real^N->bool. borel s /\ borel t ==> borel(s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[BOREL_INTER; BOREL_COMPLEMENT]);; let CLOSED_IMP_BOREL = prove (`!s:real^N->bool. closed s ==> borel s`, GEN_TAC THEN REWRITE_TAC[closed] THEN DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_BOREL) THEN REWRITE_TAC[BOREL_COMPLEMENT]);; let COMPACT_IMP_BOREL = prove (`!s:real^N->bool. compact s ==> borel s`, SIMP_TAC[CLOSED_IMP_BOREL; COMPACT_IMP_CLOSED]);; let FSIGMA_IMP_BOREL = prove (`!s:real^N->bool. fsigma s ==> borel s`, GEN_TAC THEN REWRITE_TAC[fsigma; UNION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[BOREL_UNIONS; CLOSED_IMP_BOREL]);; let GDELTA_IMP_BOREL = prove (`!s:real^N->bool. gdelta s ==> borel s`, GEN_TAC THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[BOREL_INTERS; OPEN_IMP_BOREL]);; let LOCALLY_COMPACT_IMP_BOREL = prove (`!s:real^N->bool. locally compact s ==> borel s`, SIMP_TAC[FSIGMA_IMP_BOREL; FSIGMA_LOCALLY_COMPACT]);; let OPEN_IN_BOREL = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s /\ borel t ==> borel s`, REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOREL_INTER THEN ASM_SIMP_TAC[OPEN_IMP_BOREL]);; let CLOSED_IN_BOREL = prove (`!s t:real^N->bool. closed_in (subtopology euclidean t) s /\ borel t ==> borel s`, REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOREL_INTER THEN ASM_SIMP_TAC[CLOSED_IMP_BOREL]);; let CONTINUOUS_BOREL_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ borel s /\ borel t ==> borel {x | x IN s /\ f x IN t}`, let lemma = prove (`{x | x IN s /\ f x IN UNIONS u} = UNIONS {{x | x IN s /\ f x IN t} | t IN u}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC borel_INDUCT THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_BOREL THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[BOREL_DIFF; SET_RULE `{x | x IN s /\ f x IN UNIV DIFF t} = s DIFF {x | x IN s /\ f x IN t}`]; REPEAT STRIP_TAC THEN REWRITE_TAC[lemma] THEN MATCH_MP_TAC BOREL_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE]]);; let HOMEOMORPHIC_BORELNESS = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (borel s <=> borel t)`, let lemma = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> borel s ==> borel t`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN MAP_EVERY X_GEN_TAC [`f':real^M->real^N`; `g':real^N->real^M`] THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN SUBGOAL_THEN `t = {x | x IN v /\ (g':real^N->real^M) x IN s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN ASM_SIMP_TAC[GDELTA_IMP_BOREL]) in REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC lemma THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; let BOREL_TRANSLATION = prove (`!a:real^N s. borel (IMAGE (\x. a + x) s) <=> borel s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORELNESS THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [BOREL_TRANSLATION];; let BOREL_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (borel(IMAGE f s) <=> borel s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORELNESS THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN ASM_REWRITE_TAC[]);; add_linear_invariants [BOREL_LINEAR_IMAGE];; let HOMEOMORPHISM_BORELNESS = prove (`!f:real^M->real^N g s t k. homeomorphism (s,t) (f,g) /\ k SUBSET s ==> (borel(IMAGE f k) <=> borel k)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORELNESS THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);; let BOREL_PCROSS = prove (`!s:real^M->bool t:real^N->bool. borel s /\ borel t ==> borel(s PCROSS t)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `s PCROSS t = (s PCROSS (:real^N)) INTER ((:real^M) PCROSS t)` SUBST1_TAC THENL [REWRITE_TAC[INTER_PCROSS; INTER_UNIV]; ALL_TAC] THEN MATCH_MP_TAC BOREL_INTER THEN CONJ_TAC THENL [UNDISCH_TAC `borel(s:real^M->bool)` THEN SPEC_TAC(`s:real^M->bool`,`s:real^M->bool`); UNDISCH_TAC `borel(t:real^N->bool)` THEN SPEC_TAC(`t:real^N->bool`,`t:real^N->bool`)] THEN MATCH_MP_TAC borel_INDUCT THEN REWRITE_TAC[PCROSS_DIFF] THEN SIMP_TAC[OPEN_PCROSS; OPEN_UNIV; OPEN_IMP_BOREL; BOREL_DIFF] THEN REWRITE_TAC[PCROSS_UNIONS] THEN SIMP_TAC[BOREL_UNIONS; FORALL_IN_IMAGE; SIMPLE_IMAGE; COUNTABLE_IMAGE]);; let BOREL_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. borel(s PCROSS t) <=> s = {} \/ t = {} \/ borel s /\ borel t`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[BOREL_PCROSS; PCROSS_EMPTY; BOREL_EMPTY] THEN MATCH_MP_TAC(TAUT `(~p /\ ~q ==> r) ==> p \/ q \/ r`) THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `~(t:real^N->bool = {})`; UNDISCH_TAC `~(s:real^M->bool = {})`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `y:real^N`; X_GEN_TAC `x:real^M`] THEN DISCH_TAC THENL [SUBGOAL_THEN `s = {x | x IN (:real^M) /\ pastecart x (y:real^N) IN (s PCROSS t)}` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `t = {y | y IN (:real^N) /\ pastecart (x:real^M) y IN (s PCROSS t)}` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC]] THEN MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN ASM_REWRITE_TAC[BOREL_UNIV] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; let LAVRENTIEV_BOREL = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t /\ borel t ==> ?u g. borel u /\ s SUBSET u /\ u SUBSET closure s /\ g continuous_on u /\ IMAGE g u SUBSET t /\ !x. x IN s ==> g x = f x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL[`f:real^M->real^N`; `s:real^M->bool`; `closure t:real^N->bool`] LAVRENTIEV) THEN ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSED_IMP_GDELTA] THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET]; ONCE_REWRITE_TAC[SWAP_EXISTS_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{x | x IN u /\ (g:real^M->real^N) x IN t}` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN ASM_SIMP_TAC[GDELTA_IMP_BOREL]; ASM SET_TAC[]; ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Baire functions. We only define these for finite indices, since I can't *) (* imagine ever using any indexed by higher ordinals. But this means *) (* that "borel_measurable" is strictly stronger than "baire n for some n". *) (* ------------------------------------------------------------------------- *) let baire = define `(baire 0 s (f:real^M->real^N) <=> f continuous_on s) /\ (baire (SUC n) s f <=> ?g. (!k. baire n s (g k)) /\ (!x. x IN s ==> ((\k. g k x) --> f x) sequentially))`;; let BAIRE_MONO = prove (`!f:real^M->real^N s m n. baire m s f /\ m <= n ==> baire n s f`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ_ALT] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REPEAT(CONJ_TAC THENL [CONV_TAC TAUT; ALL_TAC]) THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[baire] THEN EXISTS_TAC `(\k. f):num->real^M->real^N` THEN ASM_SIMP_TAC[LIM_CONST]);; let CONTINUOUS_ON_IMP_BAIRE = prove (`!f:real^M->real^N s n. f continuous_on s ==> baire n s f`, REWRITE_TAC[GSYM(CONJUNCT1 baire)] THEN MESON_TAC[BAIRE_MONO; LE_0]);; let BAIRE_SUBSET = prove (`!f:real^M->real^N s t n. baire n s f /\ t SUBSET s ==> baire n t f`, ONCE_REWRITE_TAC[MESON[] `(!f s t n. P f s t n) <=> (!s t n f. P f s t n)`] THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[baire; CONTINUOUS_ON_SUBSET] THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SUBSET]);; let BAIRE_EQ = prove (`!f:real^M->real^N g s n. (!x. x IN s ==> f x = g x) /\ baire n s f ==> baire n s g`, ONCE_REWRITE_TAC[MESON[] `(!f g s n. P f g s n) <=> (!s n f g. P f g s n)`] THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[baire; CONTINUOUS_ON_EQ] THEN MESON_TAC[]);; let BAIRE_CONST = prove (`!s:real^M->bool n a:real^N. baire n s (\x. a)`, SIMP_TAC[CONTINUOUS_ON_IMP_BAIRE; CONTINUOUS_ON_CONST]);; let BAIRE_PASTECART = prove (`!f:real^M->real^N g:real^M->real^P s n. baire n s f /\ baire n s g ==> baire n s (\x. pastecart (f x) (g x))`, ONCE_REWRITE_TAC[MESON[] `(!f g s n. P f g s n) <=> (!s n f g. P f g s n)`] THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[baire; CONTINUOUS_ON_PASTECART] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^P`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `k:num->real^M->real^P` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\n:num x:real^M. pastecart (h n x:real^N) (k n x:real^P)` THEN ASM_SIMP_TAC[ETA_AX; LIM_PASTECART]);; let BAIRE_COMPOSE_CONTINUOUS = prove (`!f:real^M->real^N g:real^N->real^P s k. f continuous_on s /\ baire k (IMAGE f s) g ==> baire k s (g o f)`, GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_SIMP_TAC[baire; CONTINUOUS_ON_COMPOSE; FORALL_IN_IMAGE] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `g:real^N->real^P` THEN DISCH_THEN(X_CHOOSE_THEN `h:num->real^N->real^P` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n. (h:num->real^N->real^P) n o (f:real^M->real^N)` THEN ASM_SIMP_TAC[o_THM]);; let BAIRE_CONTINUOUS_COMPOSE_UNIV = prove (`!f:real^N->real^P g:real^M->real^N s n. f continuous_on (:real^N) /\ baire n s g ==> baire n s (f o g)`, ONCE_REWRITE_TAC[MESON[] `(!f g s n. P f g s n) <=> (!f s n g. P f g s n)`] THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[baire] THENL [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; X_GEN_TAC `g:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n. (f:real^N->real^P) o ((h:num->real^M->real^N) n)` THEN ASM_SIMP_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE [CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV; o_DEF]) THEN ASM_SIMP_TAC[o_THM]]);; let BAIRE_CMUL = prove (`!f:real^M->real^N s c n. baire n s f ==> baire n s (\x. c % f x)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ; o_DEF] BAIRE_CONTINUOUS_COMPOSE_UNIV) THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);; let BAIRE_BILINEAR = prove (`!bop:real^N->real^P->real^Q f g s:real^M->bool n. bilinear bop /\ baire n s f /\ baire n s g ==> baire n s (\x. bop (f x) (g x))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP BAIRE_PASTECART) THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_CONTINUOUS_ON) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BAIRE_CONTINUOUS_COMPOSE_UNIV) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]);; let BAIRE_ADD = prove (`!f g:real^M->real^N s n. baire n s f /\ baire n s g ==> baire n s (\x. f x + g x)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BAIRE_PASTECART) THEN SUBGOAL_THEN `(\z. (fstcart z:real^N) + sndcart z) continuous_on UNIV` MP_TAC THENL [SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BAIRE_CONTINUOUS_COMPOSE_UNIV) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]]);; let BAIRE_SUB = prove (`!f g:real^M->real^N s n. baire n s f /\ baire n s g ==> baire n s (\x. f x - g x)`, REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --(&1) % y`] THEN SIMP_TAC[BAIRE_CMUL; BAIRE_ADD]);; let BAIRE_MUL = prove (`!f g:real^M->real^N s n. baire n s (\x. lift(f x)) /\ baire n s g ==> baire n s (\x. f x % g x)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[BILINEAR_DROP_MUL] (ISPEC `\x y:real^N. drop x % y` BAIRE_BILINEAR))) THEN REWRITE_TAC[LIFT_DROP]);; let BAIRE_VSUM = prove (`!f:A->real^M->real^N s t n. FINITE t /\ (!i. i IN t ==> baire n s (f i)) ==> baire n s (\x. vsum t (\i. f i x))`, GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; BAIRE_CONST; BAIRE_ADD; FORALL_IN_INSERT; ETA_AX]);; let BAIRE_PRODUCT = prove (`!f:A->real^N->real s t n. FINITE t /\ (!i. i IN t ==> baire n s (\x. lift(f i x))) ==> baire n s (\x. lift(product t (\i. f i x)))`, GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; BAIRE_CONST; LIFT_CMUL; BAIRE_MUL; FORALL_IN_INSERT; ETA_AX]);; let BAIRE_NORM = prove (`!f:real^M->real^N s n. baire n s f ==> baire n s (\x. lift(norm(f x)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF; o_ASSOC] THEN MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM]);; let BAIRE_MAX = prove (`!f g:real^N->real s n. baire n s (\x. lift(f x)) /\ baire n s (\x. lift(g x)) ==> baire n s (\x. lift(max (f x) (g x)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `max x y = inv(&2) * (x + y) + inv(&2) * abs(x - y)`] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN MATCH_MP_TAC BAIRE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC BAIRE_CMUL THEN ASM_SIMP_TAC[BAIRE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN MATCH_MP_TAC BAIRE_NORM THEN ASM_SIMP_TAC[BAIRE_SUB; LIFT_SUB]);; let BAIRE_MIN = prove (`!f g:real^N->real s n. baire n s (\x. lift(f x)) /\ baire n s (\x. lift(g x)) ==> baire n s (\x. lift(min (f x) (g x)))`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `min x y = inv(&2) * (x + y) - inv(&2) * abs(x - y)`] THEN REWRITE_TAC[LIFT_ADD; LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN MATCH_MP_TAC BAIRE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC BAIRE_CMUL THEN ASM_SIMP_TAC[BAIRE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN MATCH_MP_TAC BAIRE_NORM THEN ASM_SIMP_TAC[BAIRE_SUB; LIFT_SUB]);; let BAIRE_COMPONENTWISE = prove (`!f:real^M->real^N s n. baire n s f <=> !i. 1 <= i /\ i <= dimindex(:N) ==> baire n s (\x. lift(f x$i))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; o_DEF] BAIRE_CONTINUOUS_COMPOSE_UNIV)) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT]; POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`f:real^M->real^N`; `n:num`]] THEN INDUCT_TAC THEN GEN_TAC THEN REWRITE_TAC[baire; GSYM CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:num->num->real^M->real^1` THEN STRIP_TAC THEN EXISTS_TAC `(\n:num x. lambda i. drop((g:num->num->real^M->real^1) i n x)) :num->real^M->real^N` THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT]] THEN ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]);; let BAIRE_UNIFORM_LIMIT = prove (`!f g:real^M->real^N s k. eventually (\n. baire k s (f n)) sequentially /\ (!e. &0 < e ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) sequentially) ==> baire k s g`, ONCE_REWRITE_TAC[MESON[] `(!f g s k. P f g s k) <=> (!s k f g. P f g s k)`] THEN GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[baire] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN EXISTS_TAC `f:num->real^M->real^N` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`f:num->real^M->real^N`; `g:real^M->real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `!n. ?m. baire (SUC k) s (f m) /\ !x. x IN s ==> norm((f:num->real^M->real^N) m x - g x) < inv(&2 pow (n + 1))` MP_TAC THENL [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow (n + 1))`) THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN UNDISCH_TAC `eventually (\n. baire (SUC k) s (f n:real^M->real^N)) sequentially` THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[LE_REFL]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN ABBREV_TAC `h = \n x. (f:num->real^M->real^N) (r(n + 1)) x - f (r n) x` THEN SUBGOAL_THEN `!n x. x IN s ==> norm((h:num->real^M->real^N) n x) < inv(&2 pow n)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`n + 1`; `x:real^M`] th) THEN MP_TAC(SPECL [`n:num`; `x:real^M`] th)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `a + b <= c ==> norm(f - g:real^N) < a ==> norm(f' - g) < b ==> norm(f' - f) < c`) THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2]; ALL_TAC] THEN SUBGOAL_THEN `!n:num. ?d:num->real^M->real^N. (!m. baire k s (d m)) /\ (!m x. norm(d m x) <= &(dimindex(:N)) / &2 pow n) /\ (!x. x IN s ==> ((\m. d m x) --> h n x) sequentially)` MP_TAC THENL [X_GEN_TAC `n:num` THEN SUBGOAL_THEN `baire (SUC k) s ((h:num->real^M->real^N) n)` MP_TAC THENL [EXPAND_TAC "h" THEN REWRITE_TAC[] THEN MATCH_MP_TAC BAIRE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; REWRITE_TAC[baire; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `d:num->real^M->real^N` THEN STRIP_TAC THEN EXISTS_TAC `(\m x. lambda i. min (max (--inv(&2 pow n)) ((d m x:real^N)$i)) (inv(&2 pow n))) :num->real^M->real^N` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[BAIRE_COMPONENTWISE] THEN X_GEN_TAC `i:num` THEN SIMP_TAC[LAMBDA_BETA] THEN STRIP_TAC THEN MATCH_MP_TAC BAIRE_MIN THEN REWRITE_TAC[BAIRE_CONST] THEN MATCH_MP_TAC BAIRE_MAX THEN REWRITE_TAC[BAIRE_CONST] THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[BAIRE_COMPONENTWISE]) THEN ASM_SIMP_TAC[]; REPEAT GEN_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[real_div; GSYM SUM_CONST; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < a ==> abs(min (max (--a) x) a) <= a`) THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\k. (d:num->real^M->real^N) k x` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\m. norm((d:num->real^M->real^N) m x - h n x) < inv(&2 pow n) - norm(h n x)` THEN RULE_ASSUM_TAC(REWRITE_RULE[tendsto; dist]) THEN ASM_SIMP_TAC[REAL_SUB_LT] THEN X_GEN_TAC `m:num` THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (NORM_ARITH `norm(x - y:real^N) < a - norm y ==> norm(x) <= a`)) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x <= n ==> x = min (max (--n) x) n`) THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `d:num->num->real^M->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `!m x. x IN s ==> summable (from 0) (\n. (d:num->num->real^M->real^N) n m x)` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_COMPARISON THEN EXISTS_TAC `\n. &(dimindex(:N)) / &2 pow n` THEN ASM_SIMP_TAC[o_DEF] THEN REWRITE_TAC[real_div; LIFT_CMUL; REAL_INV_POW] THEN MATCH_MP_TAC SUMMABLE_CMUL THEN MATCH_MP_TAC SUMMABLE_REAL_GP THEN CONV_TAC REAL_RAT_REDUCE_CONV; REWRITE_TAC[summable; RIGHT_IMP_EXISTS_THM; SKOLEM_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `t:num->real^M->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `g = \x. (f:num->real^M->real^N) (r 0) x + (g x - f (r 0) x)` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC VECTOR_ARITH; MATCH_MP_TAC BAIRE_ADD THEN ASM_REWRITE_TAC[ETA_AX]] THEN REWRITE_TAC[baire] THEN EXISTS_TAC `t:num->real^M->real^N` THEN SUBGOAL_THEN `!e. &0 < e ==> eventually (\n. !x i. x IN s ==> norm(vsum (0..n) (\m. (d:num->num->real^M->real^N) m i x) - t i x) < e) sequentially` (LABEL_TAC "*") THENL [X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e / &2 / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; EVENTUALLY_SEQUENTIALLY] THEN SIMP_TAC[REAL_POW_INV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `j:num`] THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\m. --vsum(n+1..m) (\q. (d:num->num->real^M->real^N) q j x)` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN MATCH_MP_TAC LIM_NEG THEN REWRITE_TAC[GSYM SERIES_FROM] THEN SUBST1_TAC(ARITH_RULE `n = (n + 1) - 1`) THEN REWRITE_TAC[ARITH_RULE `(n + 1) - 1 + 1 = n + 1`] THEN MATCH_MP_TAC SUMS_OFFSET THEN ASM_SIMP_TAC[] THEN ARITH_TAC; REWRITE_TAC[NORM_NEG] THEN MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\m. sum(n + 1..m) (\q. &(dimindex (:N)) / &2 pow q) <= e / &2` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [X_GEN_TAC `m:num` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC VSUM_NORM_LE THEN ASM_SIMP_TAC[FINITE_NUMSEG]; REWRITE_TAC[real_div; SUM_LMUL; SUM_GP; REAL_INV_POW] THEN REWRITE_TAC[GSYM real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_HALF; REAL_MUL_RZERO; REAL_LT_IMP_LE] THEN TRANS_TAC REAL_LE_TRANS `&(dimindex (:N)) / &2 pow N` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM ADD1; real_pow] THEN MATCH_MP_TAC(REAL_ARITH `x <= a /\ &0 <= y ==> (&1 / &2 * x - &1 / &2 * y) * &2 <= a`) THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_POW] THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `j:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n x. vsum (0..n) (\m. (d:num->num->real^M->real^N) m j x)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN MATCH_MP_TAC BAIRE_VSUM THEN ASM_REWRITE_TAC[FINITE_NUMSEG; ETA_AX]; X_GEN_TAC `e:real` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN SIMP_TAC[]]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[tendsto] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `((\n. vsum(0..n) (\m. (h:num->real^M->real^N) m x)) --> (g(x) - f (r 0:num) x)) sequentially` MP_TAC THENL [EXPAND_TAC "h" THEN REWRITE_TAC[VSUM_DIFFS_ALT; LE_0] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&2 pow ((n + 1) + 1))` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; EVENTUALLY_TRUE] THEN REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = 2 + n`] THEN REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN REWRITE_TAC[tendsto] THEN REWRITE_TAC[DIST_0; NORM_LIFT; REAL_INV_POW] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC ARCH_EVENTUALLY_POW_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[tendsto] THEN REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN GEN_REWRITE_TAC LAND_CONV [EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN REWRITE_TAC[LE_REFL; IMP_CONJ] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_FORALL_THM] THEN DISCH_THEN(LABEL_TAC "+") THEN SUBGOAL_THEN `((\i. vsum(0..N) (\m. (d:num->num->real^M->real^N) m i x) - vsum (0..N) (\m. h m x)) --> vec 0) sequentially` MP_TAC THENL [REWRITE_TAC[GSYM VSUM_SUB_NUMSEG] THEN MATCH_MP_TAC LIM_NULL_VSUM THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; GSYM LIM_NULL]; REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`]] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `i:num` THEN REMOVE_THEN "+" (MP_TAC o SPEC `i:num`) THEN REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; let BAIRE_UNIFORM_APPROXIMATION = prove (`!f:real^M->real^N s k. baire k s f <=> !e. &0 < e ==> ?g. baire k s g /\ !x. x IN s ==> norm(g x - f x) < e`, REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0]; FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`)] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN X_GEN_TAC `g:num->real^M->real^N` THEN STRIP_TAC THEN MATCH_MP_TAC BAIRE_UNIFORM_LIMIT THEN EXISTS_TAC `g:num->real^M->real^N` THEN ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ARCH_EVENTUALLY_INV1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_TRANS]);; let FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN = prove (`!f:real^M->real^N g s t u. IMAGE f s SUBSET t /\ open_in (subtopology euclidean t) u /\ (!n. (g n) continuous_on s) /\ (!x. x IN s ==> ((\n. g n x) --> f x) sequentially) ==> ?c. COUNTABLE c /\ (!t. t IN c ==> closed_in (subtopology euclidean s) t) /\ UNIONS c = {x | x IN s /\ f(x) IN u}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN ASM_SIMP_TAC[SET_RULE `IMAGE f s SUBSET t ==> (x IN s /\ f x IN t INTER v <=> x IN s /\ f x IN v)`] THEN ASM_CASES_TAC `v = (:real^N)` THENL [EXISTS_TAC `{s:real^M->bool}` THEN ASM_REWRITE_TAC[COUNTABLE_SING; UNIONS_1; IN_UNIV] THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; CLOSED_IN_REFL] THEN SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `{INTERS {{x | x IN s /\ lift(setdist({(g:num->real^M->real^N) n x},(:real^N) DIFF v)) IN {x | drop x >= e}} |n| N <= n} |N,e| N IN (:num) /\ e IN {r | rational r /\ &0 < r}}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[NUM_COUNTABLE] THEN SIMP_TAC[REWRITE_RULE[IN] COUNTABLE_RESTRICT; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`N:num`; `e:real`] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN SIMP_TAC[LE_REFL; SET_RULE `N:num <= N ==> ~({f n | N <= n} = {})`] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_GE] THEN SUBGOAL_THEN `(\x. lift(setdist({g n x},(:real^N) DIFF v))) = (\y. lift(setdist({y},(:real^N) DIFF v))) o (g:num->real^M->real^N) n` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[real_ge]; MESON_TAC[LE_REFL]] THEN TRANS_TAC EQ_TRANS `&0 < setdist({(f:real^M->real^N) x},(:real^N) DIFF v)` THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM RATIONAL_BETWEEN_EQ]; REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON [RATIONAL_CLOSED] `(!x. Q x ==> P(x / &2)) /\ (!x. P x ==> Q(x / &2)) ==> ((?x. rational x /\ P x) <=> (?y. rational y /\ Q y))`) THEN CONJ_TAC THEN X_GEN_TAC `q:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `q / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; IMP_IMP] THENL [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `q < d2 ==> abs(d1 - d2) <= x ==> x < q / &2 ==> q / &2 <= d1`)); REWRITE_TAC[GSYM EVENTUALLY_AND] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `abs(d1 - d2) <= x ==> x < q / &2 /\ q <= d1 ==> q / &2 < d2`)] THEN REWRITE_TAC[SETDIST_SING_TRIANGLE]]);; let FSIGMA_BAIRE1_PREIMAGE_OPEN = prove (`!f:real^M->real^N s u. fsigma s /\ open u /\ baire 1 s f ==> fsigma {x | x IN s /\ f(x) IN u}`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[num_CONV `1`; baire] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:num->real^M->real^N`; `s:real^M->bool`; `(:real^N)`; `u:real^N->bool`] FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN) THEN ASM_REWRITE_TAC[SUBSET_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN DISCH_THEN(X_CHOOSE_THEN `c:(real^M->bool)->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FSIGMA_UNIONS THEN ASM_MESON_TAC[CLOSED_IN_FSIGMA]);; let GDELTA_BAIRE1_PREIMAGE_CLOSED = prove (`!f:real^M->real^N s c. gdelta s /\ closed c /\ baire 1 s f ==> gdelta {x | x IN s /\ f(x) IN c}`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[num_CONV `1`; baire] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `g:num->real^M->real^N`; `s:real^M->bool`; `(:real^N)`; `(:real^N) DIFF c`] FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN) THEN ASM_REWRITE_TAC[SUBSET_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN ASM_REWRITE_TAC[GSYM closed; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ f x IN c} = s DIFF {x | x IN s /\ f x IN UNIV DIFF c}`] THEN ASM_REWRITE_TAC[DIFF_UNIONS] THEN MATCH_MP_TAC GDELTA_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_GDELTA THEN EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]);; (* ------------------------------------------------------------------------- *) (* Delta_n sets (defined via "baire" on indicator, not a special constant). *) (* We can then express Sigma_n and Pi_n using "COUNTABLE UNION_OF ..." and *) (* "COUNTABLE INTERSECTION_OF ...". While a bit verbose, and breaking down *) (* for the 0 case, it is adequate for use in occasional lemmas. *) (* ------------------------------------------------------------------------- *) let BAIRE_INDICATOR_EMPTY = prove (`!n. baire n u (indicator {})`, REWRITE_TAC[indicator; NOT_IN_EMPTY; BAIRE_CONST]);; let BAIRE_INDICATOR_UNIV = prove (`!n. baire n u (indicator (:real^N))`, REWRITE_TAC[indicator; IN_UNIV; BAIRE_CONST]);; let BAIRE_INDICATOR_REFL = prove (`!u:real^N->bool n. baire n u (indicator u)`, REPEAT GEN_TAC THEN MATCH_MP_TAC BAIRE_EQ THEN EXISTS_TAC `indicator(:real^N)` THEN CONJ_TAC THEN SIMP_TAC[indicator; IN_UNIV; BAIRE_CONST]);; let BAIRE_INDICATOR_COMPLEMENT = prove (`!u s:real^N->bool n. baire n u (indicator(u DIFF s)) <=> baire n u (indicator s)`, REPEAT GEN_TAC THEN EQ_TAC THEN MP_TAC(ISPECL [`u:real^N->bool`; `n:num`; `vec 1:real^1`] BAIRE_CONST) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BAIRE_SUB) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] BAIRE_EQ) THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[indicator; IN_DIFF; IN_UNIV] THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO]);; let BAIRE_INDICATOR_COMPLEMENT_UNIV = prove (`!u s n. baire n u (indicator((:real^N) DIFF s)) <=> baire n u (indicator s)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM BAIRE_INDICATOR_COMPLEMENT] THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] BAIRE_EQ) THEN SIMP_TAC[indicator; IN_DIFF; IN_UNIV]);; let BAIRE_INDICATOR_INTER = prove (`!u s t:real^N->bool n. baire n u (indicator s) /\ baire n u (indicator t) ==> baire n u (indicator(s INTER t))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN ONCE_REWRITE_TAC[GSYM LIFT_DROP] THEN DISCH_THEN(MP_TAC o MATCH_MP BAIRE_MUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[indicator; FUN_EQ_THM; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN REWRITE_TAC[VECTOR_MUL_RZERO]);; let BAIRE_INDICATOR_UNION = prove (`!u s t:real^N->bool n. baire n u (indicator s) /\ baire n u (indicator t) ==> baire n u (indicator(s UNION t))`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP BAIRE_INDICATOR_INTER th) THEN MP_TAC(MATCH_MP BAIRE_ADD th)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BAIRE_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[indicator; FUN_EQ_THM; IN_INTER; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_SUB_RZERO; VECTOR_ADD_RID; VECTOR_ADD_LID; VECTOR_ADD_SUB]);; let BAIRE_INDICATOR_DIFF = prove (`!u s t:real^N->bool n. baire n u (indicator s) /\ baire n u (indicator t) ==> baire n u (indicator(s DIFF t))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE_EQ THEN EXISTS_TAC `indicator(s INTER (u DIFF t):real^N->bool)` THEN ASM_SIMP_TAC[BAIRE_INDICATOR_INTER; BAIRE_INDICATOR_COMPLEMENT] THEN SIMP_TAC[indicator; IN_INTER; IN_DIFF; IN_UNIV; IN_UNIV]);; let BAIRE_INDICATOR_INTERS = prove (`!f n. FINITE f /\ (!s. s IN f ==> baire n u (indicator s)) ==> baire n u (indicator(INTERS f))`, GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT; INTERS_0; INTERS_INSERT] THEN ASM_SIMP_TAC[BAIRE_INDICATOR_UNIV; BAIRE_INDICATOR_INTER]);; let BAIRE_INDICATOR_UNIONS = prove (`!f n. FINITE f /\ (!s. s IN f ==> baire n u (indicator s)) ==> baire n u (indicator(UNIONS f))`, GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT; UNIONS_0; UNIONS_INSERT] THEN ASM_SIMP_TAC[BAIRE_INDICATOR_EMPTY; BAIRE_INDICATOR_UNION]);; let BAIRE0_INDICATOR = prove (`!s. baire 0 (:real^N) (indicator s) <=> s = {} \/ s = (:real^N)`, GEN_TAC THEN REWRITE_TAC[baire] THEN EQ_TAC THENL [DISCH_TAC THEN MP_TAC(ISPECL [`indicator(s:real^N->bool)`; `(:real^N)`] CONTINUOUS_FINITE_RANGE_CONSTANT) THEN ASM_REWRITE_TAC[CONNECTED_UNIV; IN_UNIV; EXTENSION; NOT_IN_EMPTY] THEN REWRITE_TAC[indicator] THEN ANTS_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^1,vec 1}` THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[]; SUBGOAL_THEN `~(vec 0:real^1 = vec 1)` MP_TAC THENL [REWRITE_TAC[VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV; SET_TAC[]]]; STRIP_TAC THEN ASM_REWRITE_TAC[indicator; IN_UNIV; NOT_IN_EMPTY] THEN REWRITE_TAC[CONTINUOUS_ON_CONST]]);; let COUNTABLE_UNION_OF_BAIRE0_INDICATOR = prove (`!s. (COUNTABLE UNION_OF baire 0 (:real^N) o indicator) s <=> s = {} \/ s = (:real^N)`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[UNION_OF; o_THM; BAIRE0_INDICATOR] THEN SET_TAC[]; DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN ASM_REWRITE_TAC[BAIRE0_INDICATOR; o_THM]]);; let COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR = prove (`!s. (COUNTABLE INTERSECTION_OF baire 0 (:real^N) o indicator) s <=> s = {} \/ s = (:real^N)`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[INTERSECTION_OF; o_THM; BAIRE0_INDICATOR] THEN SET_TAC[]; DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN ASM_REWRITE_TAC[BAIRE0_INDICATOR; o_THM]]);; let BAIRE1_INDICATOR = prove (`!s. baire 1 (:real^N) (indicator s) <=> fsigma s /\ gdelta s`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [REWRITE_TAC[GSYM FSIGMA_COMPLEMENT] THEN CONJ_TAC THENL [SUBGOAL_THEN `s = {x | x IN (:real^N) /\ indicator s x IN (UNIV DELETE vec 0)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; indicator; IN_UNIV; IN_DELETE] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC]; SUBGOAL_THEN `(:real^N) DIFF s = {x | x IN (:real^N) /\ indicator s x IN (UNIV DELETE vec 1)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; indicator; IN_UNIV; IN_DELETE] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[VEC_EQ; IN_DIFF; IN_UNIV] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC]] THEN MATCH_MP_TAC FSIGMA_BAIRE1_PREIMAGE_OPEN THEN ASM_SIMP_TAC[ETA_AX; FSIGMA_UNIV; OPEN_DELETE; OPEN_UNIV]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM FSIGMA_COMPLEMENT]) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[FSIGMA_ASCENDING; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `d:num->real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[num_CONV `1`; baire] THEN SUBGOAL_THEN `!n:num. ?f:real^N->real^1. f continuous_on UNIV /\ (!x. x IN c n ==> f x = vec 1) /\ (!x. x IN d n ==> f x = vec 0)` MP_TAC THENL [X_GEN_TAC `n:num` THEN MP_TAC(ISPECL [`(c:num->real^N->bool) n`; `(d:num->real^N->bool) n`; `vec 1:real^1`; `vec 0:real^1`] URYSOHN) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ANTS_TAC THENL [ASM SET_TAC[]; MESON_TAC[]]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^N->real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THENL [SUBGOAL_THEN `?n. x IN (c:num->real^N->bool) n` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC]; SUBGOAL_THEN `?n. x IN (d:num->real^N->bool) n` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC]] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THENL [SUBGOAL_THEN `!m n. m <= n ==> (c:num->real^N->bool) m SUBSET c n` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]]; SUBGOAL_THEN `!m n. m <= n ==> (d:num->real^N->bool) m SUBSET d n` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]]] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[SUBSET_REFL; SUBSET_TRANS]]]);; let GDELTA_BAIRE = prove (`!s. gdelta s <=> (COUNTABLE INTERSECTION_OF baire 1 (:real^N) o indicator) s`, GEN_TAC THEN REWRITE_TAC[INTERSECTION_OF; o_THM] THEN EQ_TAC THENL [REWRITE_TAC[gdelta; INTERSECTION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[BAIRE1_INDICATOR; OPEN_IMP_FSIGMA; OPEN_IMP_GDELTA]; REWRITE_TAC[BAIRE1_INDICATOR] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC GDELTA_INTERS THEN ASM_SIMP_TAC[]]);; let FSIGMA_BAIRE = prove (`!s. fsigma s <=> (COUNTABLE UNION_OF baire 1 (:real^N) o indicator) s`, GEN_TAC THEN REWRITE_TAC[UNION_OF; o_THM] THEN EQ_TAC THENL [REWRITE_TAC[fsigma; UNION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[BAIRE1_INDICATOR; CLOSED_IMP_FSIGMA; CLOSED_IMP_GDELTA]; REWRITE_TAC[BAIRE1_INDICATOR] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC FSIGMA_UNIONS THEN ASM_SIMP_TAC[]]);; let CLOSED_IMP_BAIRE1_INDICATOR = prove (`!s. closed s ==> baire 1 (:real^N) (indicator s)`, SIMP_TAC[BAIRE1_INDICATOR; CLOSED_IMP_FSIGMA; CLOSED_IMP_GDELTA]);; let OPEN_IMP_BAIRE1_INDICATOR = prove (`!s. open s ==> baire 1 (:real^N) (indicator s)`, SIMP_TAC[BAIRE1_INDICATOR; OPEN_IMP_FSIGMA; OPEN_IMP_GDELTA]);; let BAIRE_INDICATOR_CONTINUOUS_PREIMAGE = prove (`!f:real^M->real^N s t u k. baire k u (indicator t) /\ f continuous_on s /\ IMAGE f s SUBSET u ==> baire k s (indicator {x | x IN s /\ f x IN t})`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE_EQ THEN EXISTS_TAC `indicator t o (f:real^M->real^N)` THEN CONJ_TAC THENL [SIMP_TAC[indicator; IN_ELIM_THM; o_THM]; ALL_TAC] THEN MATCH_MP_TAC BAIRE_COMPOSE_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[BAIRE_SUBSET]);; let BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV = prove (`!f s k. baire k (:real^N) (indicator s) /\ f continuous_on (:real^M) ==> baire k (:real^M) (indicator {x | f x IN s})`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | f x IN s} = {x | x IN UNIV /\ f x IN s}`] THEN MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE THEN ASM_MESON_TAC[SUBSET_UNIV]);; let BAIRE_INDICATOR_TRANSLATION = prove (`!a s k. baire k (:real^N) (indicator (IMAGE (\x. a + x) s)) <=> baire k (:real^N) (indicator s)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `s = {x:real^N | a + x IN IMAGE (\x. a + x) s}` SUBST1_TAC THENL [MATCH_MP_TAC(SET_RULE `(!x y. f x = f y ==> x = y) ==> s = {x | f x IN IMAGE f s}`) THEN CONV_TAC VECTOR_ARITH; MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]]; SUBGOAL_THEN `IMAGE (\x:real^N. a + x) s = {x | x - a IN s}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_TRANSLATION_GALOIS; IN_ELIM_THM]; MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]]]);; let BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE = prove (`!f s k. 1 <= k /\ linear f /\ (!x y. f x = f y ==> x = y) ==> (baire k (:real^N) (indicator (IMAGE f s)) <=> baire k (:real^M) (indicator s))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]; SUBGOAL_THEN `?g:real^N->real^M. linear g /\ g o f = I` MP_TAC THENL [ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]; ALL_TAC] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = IMAGE f UNIV INTER {x | g x IN s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC BAIRE_INDICATOR_INTER THEN ASM_SIMP_TAC[BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV; LINEAR_CONTINUOUS_ON] THEN MATCH_MP_TAC BAIRE_MONO THEN EXISTS_TAC `1` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IMP_BAIRE1_INDICATOR THEN MATCH_MP_TAC CLOSED_SUBSPACE THEN MATCH_MP_TAC SUBSPACE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[SUBSPACE_UNIV]]);; let BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE = prove (`!f s k. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> (baire k (:real^N) (indicator (IMAGE f s)) <=> baire k (:real^M) (indicator s))`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `k = 0` THENL [ASM_REWRITE_TAC[BAIRE0_INDICATOR] THEN ASM SET_TAC[]; MATCH_MP_TAC BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LE_1]]);; add_translation_invariants [BAIRE_INDICATOR_TRANSLATION];; add_linear_invariants [BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE];; let COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION = prove (`!a s k. (COUNTABLE UNION_OF baire k (:real^N) o indicator) (IMAGE (\x. a + x) s) <=> (COUNTABLE UNION_OF baire k (:real^N) o indicator) s`, GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC COUNTABLE_UNION_OF_BIJECTIVE_IMAGE THEN REWRITE_TAC[o_THM; BAIRE_INDICATOR_TRANSLATION] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN REWRITE_TAC[VECTOR_ADD_SUB]);; add_translation_invariants [COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION];; let COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION = prove (`!a s k. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) (IMAGE (\x. a + x) s) <=> (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s`, GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE THEN REWRITE_TAC[o_THM; BAIRE_INDICATOR_TRANSLATION] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN REWRITE_TAC[VECTOR_ADD_SUB]);; add_translation_invariants [COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION];; let COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE = prove (`!f s k. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> ((COUNTABLE UNION_OF baire k (:real^N) o indicator) (IMAGE f s) <=> (COUNTABLE UNION_OF baire k (:real^M) o indicator) s)`, GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_UNION_OF_BIJECTIVE_IMAGE THEN ASM_REWRITE_TAC[o_THM] THEN GEN_TAC THEN MATCH_MP_TAC BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[]);; add_linear_invariants [COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE];; let COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE = prove (`!f s k. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> ((COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) (IMAGE f s) <=> (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s)`, GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE THEN ASM_REWRITE_TAC[o_THM] THEN GEN_TAC THEN MATCH_MP_TAC BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[]);; add_linear_invariants [COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* The reduction theorem for Sigma_n sets and consequences. *) (* ------------------------------------------------------------------------- *) let FSIGMA_REDUCTION_GEN_ALT = prove (`!s:num->real^N->bool k. (!n. (COUNTABLE UNION_OF baire k (:real^N) o indicator) (s n)) ==> ?t. (!n. (COUNTABLE UNION_OF baire k (:real^N) o indicator) (t n)) /\ (!n. t n SUBSET s n) /\ pairwise (\m n. DISJOINT (t m) (t n)) (:num) /\ UNIONS {t n | n IN (:num)} = UNIONS {s n | n IN (:num)}`, GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC GENERAL_REDUCTION_THEOREM THEN REWRITE_TAC[o_THM; BAIRE_INDICATOR_EMPTY; BAIRE_INDICATOR_UNION; BAIRE_INDICATOR_DIFF]);; let FSIGMA_REDUCTION_GEN_2 = prove (`!s t k. (COUNTABLE UNION_OF baire k (:real^N) o indicator) s /\ (COUNTABLE UNION_OF baire k (:real^N) o indicator) t ==> ?s' t'. (COUNTABLE UNION_OF baire k (:real^N) o indicator) s' /\ (COUNTABLE UNION_OF baire k (:real^N) o indicator) t' /\ s' SUBSET s /\ t' SUBSET t /\ DISJOINT s' t' /\ s' UNION t' = s UNION t`, ONCE_REWRITE_TAC[MESON[] `(!s t k. P s t k) <=> (!k s t. P s t k)`] THEN GEN_TAC THEN MATCH_MP_TAC GENERAL_REDUCTION_THEOREM_2 THEN REWRITE_TAC[o_THM; BAIRE_INDICATOR_EMPTY; BAIRE_INDICATOR_UNION; BAIRE_INDICATOR_DIFF]);; let FSIGMA_REDUCTION = prove (`!s:num->real^N->bool. (!n. fsigma(s n)) ==> ?t. (!n. fsigma(t n)) /\ (!n. t n SUBSET s n) /\ pairwise (\m n. DISJOINT (t m) (t n)) (:num) /\ UNIONS {t n | n IN (:num)} = UNIONS {s n | n IN (:num)}`, REWRITE_TAC[FSIGMA_BAIRE; FSIGMA_REDUCTION_GEN_ALT]);; let BAIRE_INDICATOR_SUC,BAIRE_INDICATOR_DELTA,FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT, FSIGMA_REDUCTION_GEN,GDELTA_SEPARATION_GEN = let clemma = MESON[BAIRE_INDICATOR_COMPLEMENT; o_THM] `(baire k (:real^N) o indicator) ((:real^N) DIFF s) = (baire k (:real^N) o indicator) s` in let slemma = prove (`!s t k. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s /\ (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) t /\ DISJOINT s t ==> ?u. (COUNTABLE UNION_OF baire k (:real^N) o indicator) u /\ (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) u /\ s SUBSET u /\ DISJOINT u t`, GEN_REWRITE_TAC (funpow 3 BINDER_CONV o LAND_CONV o ONCE_DEPTH_CONV) [COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN REWRITE_TAC[clemma] THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> (UNIV DIFF s) UNION (UNIV DIFF t) = UNIV`] THEN ONCE_REWRITE_TAC[SET_RULE `s SUBSET t <=> UNIV DIFF t SUBSET UNIV DIFF s`] THEN REWRITE_TAC[MESON[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] `((!s. P(UNIV DIFF s)) <=> (!s. P s)) /\ ((?s. P(UNIV DIFF s)) <=> (?s. P s))`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[ETA_AX; CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP FSIGMA_REDUCTION_GEN_2) THEN ASM_REWRITE_TAC[SET_RULE `DISJOINT s t /\ s UNION t = UNIV <=> s = UNIV DIFF t`] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ONCE_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN ASM_REWRITE_TAC[clemma; ETA_AX]) in let [BAIRE_INDICATOR_SUC; BAIRE_INDICATOR_DELTA; FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT] = (CONJUNCTS o prove) (`(!s n. 1 <= n ==> ((COUNTABLE UNION_OF COUNTABLE INTERSECTION_OF baire n (:real^N) o indicator) s /\ (COUNTABLE INTERSECTION_OF COUNTABLE UNION_OF baire n (:real^N) o indicator) s <=> baire (n + 1) (:real^N) (indicator s))) /\ (!s n. (COUNTABLE UNION_OF baire n (:real^N) o indicator) s /\ (COUNTABLE INTERSECTION_OF baire n (:real^N) o indicator) s <=> baire n (:real^N) (indicator s)) /\ (!f u n. 1 <= n /\ baire (n + 1) (:real^N) (f:real^N->real^1) /\ open u ==> (COUNTABLE UNION_OF COUNTABLE INTERSECTION_OF baire n (:real^N) o indicator) {x | f x IN u})`, GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o BINDER_CONV) [METIS[num_CASES] `(!n. P n) <=> P 0 /\ (!n. P(SUC n))`] THEN REWRITE_TAC[BAIRE0_INDICATOR; COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR; COUNTABLE_UNION_OF_BAIRE0_INDICATOR] THEN REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[MESON[] `(!f u n. P f u n) <=> (!f n u. P f u n)`] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THENL [REWRITE_TAC[GSYM FSIGMA_BAIRE; GSYM GDELTA_BAIRE] THEN REWRITE_TAC[GSYM BAIRE1_INDICATOR]; REWRITE_TAC[ARITH_RULE `1 <= SUC n`]] THEN X_GEN_TAC `k:num` THEN SUBST1_TAC(ARITH_RULE `1 <= k <=> 2 <= SUC k`) THEN ABBREV_TAC `k1 = SUC k` THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "Lk") (CONJUNCTS_THEN2 (LABEL_TAC "L0") (LABEL_TAC "L2"))) THEN SUBGOAL_THEN `!s. (COUNTABLE UNION_OF COUNTABLE INTERSECTION_OF (baire k1 (:real^N) o indicator)) s /\ (COUNTABLE INTERSECTION_OF COUNTABLE UNION_OF (baire k1 (:real^N) o indicator)) s ==> baire (SUC k1) (:real^N) (indicator s)` (LABEL_TAC "L1") THENL [GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [COUNTABLE_UNION_OF_COMPLEMENT] THEN REWRITE_TAC[COMPL_COMPL; clemma; ETA_AX] THEN W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_ASCENDING o lhand o lhand o snd) THEN W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_ASCENDING o rand o lhand o rand o snd) THEN REPLICATE_TAC 2 (ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN REWRITE_TAC[o_THM; BAIRE_INDICATOR_EMPTY]; MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_UNION THEN REWRITE_TAC[BAIRE_INDICATOR_UNION; o_THM]]; DISCH_THEN SUBST1_TAC]) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `t:num->real^N->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `u:num->real^N->bool` STRIP_ASSUME_TAC)) THEN MP_TAC(GEN `m:num` (ISPECL [`(t:num->real^N->bool) m`; `(u:num->real^N->bool) m`; `k1:num`] slemma)) THEN DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ASM_REWRITE_TAC[CONJ_ASSOC; SKOLEM_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `v:num->real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[baire] THEN EXISTS_TAC `indicator o (v:num->real^N->bool)` THEN ASM_REWRITE_TAC[o_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[indicator] THEN MATCH_MP_TAC LIM_EVENTUALLY THENL [SUBGOAL_THEN `(x:real^N) IN UNIONS {t n | n IN (:num)}` MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC]; SUBGOAL_THEN `(x:real^N) IN UNIONS {u n | n IN (:num)}` MP_TAC THENL [ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]; ALL_TAC]] THEN SIMP_TAC[UNIONS_GSPEC; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THENL [SUBGOAL_THEN `(t:num->real^N->bool) N SUBSET t m` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]]; SUBGOAL_THEN `(u:num->real^N->bool) N SUBSET u m` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]]] THEN UNDISCH_TAC `N:num <= m` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`m:num`; `N:num`] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`f:real^N->real^1`; `v:real^1->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[baire; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[IN_UNIV; ARITH] THEN X_GEN_TAC `g:num->real^N->real^1` THEN STRIP_TAC THEN ASM_CASES_TAC `v = (:real^1)` THENL [ASM_REWRITE_TAC[IN_UNIV; UNIV_GSPEC] THEN MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN REWRITE_TAC[o_THM; BAIRE_INDICATOR_UNIV]; REWRITE_TAC[UNION_OF]] THEN EXISTS_TAC `{INTERS {{x | x IN (:real^N) /\ lift(setdist({(g:num->real^N->real^1) n x}, (:real^1) DIFF v)) IN {x | drop x >= e}} |n| N <= n} |N,e| N IN (:num) /\ e IN {r | rational r /\ &0 < r}}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[NUM_COUNTABLE] THEN SIMP_TAC[REWRITE_RULE[IN] COUNTABLE_RESTRICT; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`N:num`; `e:real`] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | x IN UNIV /\ f x IN {y | P y}} = {x | x IN UNIV /\ f x IN {y | ~P y}}`] THEN REWRITE_TAC[real_ge; REAL_NOT_LE] THEN REWRITE_TAC[clemma; ETA_AX] THEN ASM_CASES_TAC `k = 0` THENL [SUBGOAL_THEN `k1 = 1` SUBST_ALL_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM FSIGMA_BAIRE] THEN MATCH_MP_TAC FSIGMA_BAIRE1_PREIMAGE_OPEN THEN REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT; FSIGMA_UNIV] THEN SUBGOAL_THEN `(\x. lift(setdist({g n x},(:real^1) DIFF v))) = (\y. lift(setdist({y},(:real^1) DIFF v))) o (g:num->real^N->real^1) n` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; REMOVE_THEN "L2" (MP_TAC o SPECL [`(\y. lift(setdist({y},(:real^1) DIFF v))) o (g:num->real^N->real^1) n`; `{x | drop x < e}`]) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; REWRITE_TAC[o_THM; IN_UNIV] THEN REMOVE_THEN "Lk" MP_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[o_DEF] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO) THEN X_GEN_TAC `s:real^N->bool` THEN SIMP_TAC[COUNTABLE_UNION_OF_INC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTERSECTION_OF_MONO) THEN REWRITE_TAC[COUNTABLE_UNION_OF_INC]]]; GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[IN_UNIV; LIFT_DROP; real_ge] THEN TRANS_TAC EQ_TRANS `&0 < setdist({(f:real^N->real^1) x},(:real^1) DIFF v)` THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM RATIONAL_BETWEEN_EQ]; REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON [RATIONAL_CLOSED] `(!x. Q x ==> P(x / &2)) /\ (!x. P x ==> Q(x / &2)) ==> ((?x. rational x /\ P x) <=> (?y. rational y /\ Q y))`) THEN CONJ_TAC THEN X_GEN_TAC `q:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `q / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; IMP_IMP] THENL [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM (MATCH_MP_TAC o MATCH_MP (REAL_ARITH `q < d2 ==> abs(d1 - d2) <= x ==> x < q / &2 ==> q / &2 <= d1`)); REWRITE_TAC[GSYM EVENTUALLY_AND] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `abs(d1 - d2) <= x ==> x < q / &2 /\ q <= d1 ==> q / &2 < d2`)] THEN REWRITE_TAC[SETDIST_SING_TRIANGLE]]; DISCH_THEN(LABEL_TAC "L3")] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [GEN_TAC THEN EQ_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `s = {x:real^N | indicator s x IN (UNIV DIFF {vec 0})}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_SING] THEN REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VEC_EQ; ARITH_EQ]; REMOVE_THEN "L3" MATCH_MP_TAC THEN ASM_SIMP_TAC[ETA_AX; OPEN_DIFF; CLOSED_SING; OPEN_UNIV]]; ONCE_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COUNTABLE_UNION_OF_COMPLEMENT] THEN REWRITE_TAC[COMPL_COMPL; ETA_AX; clemma] THEN SUBGOAL_THEN `(:real^N) DIFF s = {x | indicator s x IN (UNIV DIFF {vec 1})}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_SING] THEN REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VEC_EQ; ARITH_EQ]; REMOVE_THEN "L3" MATCH_MP_TAC THEN ASM_SIMP_TAC[ETA_AX; OPEN_DIFF; CLOSED_SING; OPEN_UNIV]]]; DISCH_THEN(LABEL_TAC "L4")] THEN GEN_TAC THEN EQ_TAC THEN SIMP_TAC[COUNTABLE_UNION_OF_INC; COUNTABLE_INTERSECTION_OF_INC; o_THM] THEN USE_THEN "L4" (fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM COUNTABLE_UNION_OF_IDEMPOT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO); GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM COUNTABLE_INTERSECTION_OF_IDEMPOT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTERSECTION_OF_MONO)] THEN REWRITE_TAC[o_THM] THEN USE_THEN "L4" (fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN SIMP_TAC[]) in let FSIGMA_REDUCTION_GEN = prove (`!s k. (!n. (COUNTABLE UNION_OF baire k (:real^N) o indicator) (s n)) /\ UNIONS {s n | n IN (:num)} = (:real^N) ==> ?t. (!n. baire k (:real^N) (indicator(t n))) /\ (!n. t n SUBSET s n) /\ pairwise (\m n. DISJOINT (t m) (t n)) (:num) /\ UNIONS {t n | n IN (:num)} = (:real^N)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP FSIGMA_REDUCTION_GEN_ALT) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:num->real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[GSYM BAIRE_INDICATOR_DELTA] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN SUBGOAL_THEN `(:real^N) DIFF v n = UNIONS(IMAGE v (:num) DIFF {v n})` SUBST1_TAC THENL [W(MP_TAC o PART_MATCH (rand o rand) DIFF_UNIONS_PAIRWISE_DISJOINT o rand o snd) THEN REWRITE_TAC[PAIRWISE_IMAGE; UNIONS_1] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_IMP)) THEN SIMP_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[GSYM SIMPLE_IMAGE]]; MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN ASM_REWRITE_TAC[clemma; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE; ETA_AX] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (v:num->real^N->bool) (:num)` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN SET_TAC[]]) in let GDELTA_SEPARATION_GEN = prove (`!s t k. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s /\ (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) t /\ DISJOINT s t ==> ?u. baire k (:real^N) (indicator u) /\ s SUBSET u /\ DISJOINT u t`, REWRITE_TAC[GSYM BAIRE_INDICATOR_DELTA; GSYM CONJ_ASSOC] THEN REWRITE_TAC[slemma]) in BAIRE_INDICATOR_SUC,BAIRE_INDICATOR_DELTA,FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT, FSIGMA_REDUCTION_GEN,GDELTA_SEPARATION_GEN;; let COUNTABLE_UNION_OF_BAIRE_INDICATOR = prove (`!s k. (COUNTABLE UNION_OF baire k (:real^N) o indicator) s ==> baire (k + 1) (:real^N) (indicator s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 0` THENL [ASM_REWRITE_TAC[COUNTABLE_UNION_OF_BAIRE0_INDICATOR] THEN STRIP_TAC THEN ASM_REWRITE_TAC[BAIRE_INDICATOR_UNIV; BAIRE_INDICATOR_EMPTY]; ASM_SIMP_TAC[LE_1; GSYM BAIRE_INDICATOR_SUC] THEN SIMP_TAC[COUNTABLE_INTERSECTION_OF_INC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO) THEN REWRITE_TAC[COUNTABLE_INTERSECTION_OF_INC]]);; let COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR = prove (`!s k. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s ==> baire (k + 1) (:real^N) (indicator s)`, ONCE_REWRITE_TAC[GSYM BAIRE_INDICATOR_COMPLEMENT] THEN REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT; FORALL_DIFF] THEN REWRITE_TAC[o_DEF; BAIRE_INDICATOR_COMPLEMENT] THEN REWRITE_TAC[REWRITE_RULE[o_DEF] COUNTABLE_UNION_OF_BAIRE_INDICATOR]);; let GDELTA_SEPARATION = prove (`!s t:real^N->bool. gdelta s /\ gdelta t /\ DISJOINT s t ==> ?u. fsigma u /\ gdelta u /\ s SUBSET u /\ DISJOINT u t`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP; GDELTA_BAIRE] THEN DISCH_THEN(MP_TAC o MATCH_MP GDELTA_SEPARATION_GEN) THEN REWRITE_TAC[GSYM GDELTA_BAIRE; BAIRE1_INDICATOR; CONJ_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Basics on Borel measurability. We define it as "Baire function" and later *) (* prove (BOREL_MEASURABLE_PREIMAGE_BOREL) that it is equivalent to another *) (* natural definition when the domain is a Borel set. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("borel_measurable_on",(12,"right"));; let borel_measurable_RULES,borel_measurable_INDUCT,borel_measurable_CASES = new_inductive_definition `(!f:real^M->real^N s. f continuous_on s ==> f borel_measurable_on s) /\ (!(f:num->real^M->real^N) g s. (!n. f n borel_measurable_on s) /\ (!x. x IN s ==> ((\n. f n x) --> g x) sequentially) ==> g borel_measurable_on s)`;; let CONTINUOUS_IMP_BOREL_MEASURABLE_ON = prove (`!f:real^M->real^N s. f continuous_on s ==> f borel_measurable_on s`, REWRITE_TAC[borel_measurable_RULES]);; let BAIRE_IMP_BOREL_MEASURABLE = prove (`!f:real^M->real^N s n. baire n s f ==> f borel_measurable_on s`, ONCE_REWRITE_TAC[MESON[] `(!f s n. P f s n) <=> (!n f s. P f s n)`] THEN INDUCT_TAC THEN REWRITE_TAC[baire; CONTINUOUS_IMP_BOREL_MEASURABLE_ON] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `g:num->real^M->real^N` THEN ASM_SIMP_TAC[]);; let BOREL_MEASURABLE_ON_SUBSET = prove (`!f:real^M->real^N s t. f borel_measurable_on s /\ t SUBSET s ==> f borel_measurable_on t`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC borel_measurable_INDUCT THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC(CONJUNCT1 borel_measurable_RULES) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN ASM_MESON_TAC[SUBSET]]);; let BOREL_MEASURABLE_EQ = prove (`!f:real^M->real^N g s. (!x. x IN s ==> f x = g x) /\ f borel_measurable_on s ==> g borel_measurable_on s`, ONCE_REWRITE_TAC[CONJ_SYM] THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_EQ; CONTINUOUS_IMP_BOREL_MEASURABLE_ON]; X_GEN_TAC `f:num->real^M->real^N` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `f:num->real^M->real^N` THEN ASM_MESON_TAC[]]);; let BOREL_MEASURABLE_PASTECART = prove (`!f:real^M->real^N g:real^M->real^P s. f borel_measurable_on s /\ g borel_measurable_on s ==> (\x. pastecart (f x) (g x)) borel_measurable_on s`, GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL [REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN ONCE_REWRITE_TAC[MESON[] `(!f s g. P f s g) <=> (!g s f. P f s g)`] THEN REWRITE_TAC[IMP_CONJ_ALT; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC borel_measurable_INDUCT THEN ASM_SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON; CONTINUOUS_ON_PASTECART] THEN MAP_EVERY X_GEN_TAC [`h:num->real^M->real^P`; `g:real^M->real^P`; `s:real^M->bool`] THEN STRIP_TAC THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `\n:num x:real^M. pastecart (f x:real^N) (h n x:real^P)` THEN ASM_SIMP_TAC[LIM_PASTECART; LIM_CONST]; MAP_EVERY X_GEN_TAC [`f:num->real^M->real^N`; `g:real^M->real^N`; `s:real^M->bool`] THEN STRIP_TAC THEN X_GEN_TAC `h:real^M->real^P` THEN DISCH_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `\n:num x:real^M. pastecart (f n x:real^N) (h x:real^P)` THEN ASM_SIMP_TAC[LIM_PASTECART; LIM_CONST]]);; let BOREL_MEASURABLE_CONTINUOUS_COMPOSE = prove (`!f:real^N->real^P g:real^M->real^N s. f continuous_on (:real^N) /\ g borel_measurable_on s ==> (f o g) borel_measurable_on s`, REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; SUBSET_UNIV; CONTINUOUS_ON_SUBSET; CONTINUOUS_IMP_BOREL_MEASURABLE_ON]; MAP_EVERY X_GEN_TAC [`g:num->real^M->real^N`; `h:real^M->real^N`; `s:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `\n. (f:real^N->real^P) o (g:num->real^M->real^N) n` THEN ASM_SIMP_TAC[o_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE [CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV; o_DEF]) THEN ASM_SIMP_TAC[]]);; let BOREL_MEASURABLE_CMUL = prove (`!f:real^M->real^N s c. f borel_measurable_on s ==> (\x. c % f x) borel_measurable_on s`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ; o_DEF] BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);; let BOREL_MEASURABLE_BILINEAR = prove (`!bop:real^N->real^P->real^Q f g s:real^M->bool. bilinear bop /\ f borel_measurable_on s /\ g borel_measurable_on s ==> (\x. bop (f x) (g x)) borel_measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_PASTECART) THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_CONTINUOUS_ON) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]);; let BOREL_MEASURABLE_ADD = prove (`!f g:real^M->real^N s. f borel_measurable_on s /\ g borel_measurable_on s ==> (\x. f x + g x) borel_measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_PASTECART) THEN SUBGOAL_THEN `(\z. (fstcart z:real^N) + sndcart z) continuous_on UNIV` MP_TAC THENL [SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]]);; let BOREL_MEASURABLE_SUB = prove (`!f g:real^M->real^N s. f borel_measurable_on s /\ g borel_measurable_on s ==> (\x. f x - g x) borel_measurable_on s`, REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --(&1) % y`] THEN SIMP_TAC[BOREL_MEASURABLE_CMUL; BOREL_MEASURABLE_ADD]);; let BOREL_MEASURABLE_CONST = prove (`!s:real^M->bool c:real^N. (\x. c) borel_measurable_on s`, SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON; CONTINUOUS_ON_CONST]);; let BOREL_MEASURABLE_VSUM = prove (`!f:A->real^M->real^N s t. FINITE t /\ (!i. i IN t ==> f i borel_measurable_on s) ==> (\x. vsum t (\i. f i x)) borel_measurable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; BOREL_MEASURABLE_CONST; BOREL_MEASURABLE_ADD; FORALL_IN_INSERT; ETA_AX]);; let BOREL_MEASURABLE_MUL = prove (`!f g:real^M->real^N s. (\x. lift(f x)) borel_measurable_on s /\ g borel_measurable_on s ==> (\x. f x % g x) borel_measurable_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[BILINEAR_DROP_MUL] (ISPEC `\x y:real^N. drop x % y` BOREL_MEASURABLE_BILINEAR))) THEN REWRITE_TAC[LIFT_DROP]);; let BOREL_MEASURABLE_NORM = prove (`!f:real^M->real^N s. f borel_measurable_on s ==> (\x. lift(norm(f x))) borel_measurable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF; o_ASSOC] THEN MATCH_MP_TAC BOREL_MEASURABLE_CONTINUOUS_COMPOSE THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM]);; let BOREL_MEASURABLE_MAX = prove (`!f g:real^N->real s n. (\x. lift(f x)) borel_measurable_on s /\ (\x. lift(g x)) borel_measurable_on s ==> (\x. lift(max (f x) (g x))) borel_measurable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `max x y = inv(&2) * (x + y) + inv(&2) * abs(x - y)`] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN MATCH_MP_TAC BOREL_MEASURABLE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_CMUL THEN ASM_SIMP_TAC[BOREL_MEASURABLE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN MATCH_MP_TAC BOREL_MEASURABLE_NORM THEN ASM_SIMP_TAC[BOREL_MEASURABLE_SUB; LIFT_SUB]);; let BOREL_MEASURABLE_MIN = prove (`!f g:real^N->real s n. (\x. lift(f x)) borel_measurable_on s /\ (\x. lift(g x)) borel_measurable_on s ==> (\x. lift(min (f x) (g x))) borel_measurable_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `min x y = inv(&2) * (x + y) - inv(&2) * abs(x - y)`] THEN REWRITE_TAC[LIFT_ADD; LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN MATCH_MP_TAC BOREL_MEASURABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_CMUL THEN ASM_SIMP_TAC[BOREL_MEASURABLE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN MATCH_MP_TAC BOREL_MEASURABLE_NORM THEN ASM_SIMP_TAC[BOREL_MEASURABLE_SUB; LIFT_SUB]);; let BOREL_MEASURABLE_PRODUCT = prove (`!f:A->real^N->real s t. FINITE t /\ (!i. i IN t ==> (\x. lift(f i x)) borel_measurable_on s) ==> (\x. lift(product t (\i. f i x))) borel_measurable_on s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; BOREL_MEASURABLE_CONST; LIFT_CMUL; BOREL_MEASURABLE_MUL; FORALL_IN_INSERT; ETA_AX]);; let BOREL_MEASURABLE_COMPONENTWISE = prove (`!f:real^M->real^N s. f borel_measurable_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift(f x$i)) borel_measurable_on s`, REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `(f:real^M->real^N) borel_measurable_on s` THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ; o_DEF] BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT]; SUBGOAL_THEN `!n. ((\x. lambda i. if i < n then (f:real^M->real^N) x $i else &0) :real^M->real^N) borel_measurable_on s` MP_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `SUC(dimindex(:N))`) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; LT_SUC_LE]] THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT; BOREL_MEASURABLE_CONST] THEN ASM_CASES_TAC `1 <= n /\ n <= dimindex(:N)` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `f borel_measurable_on s ==> f = g ==> g borel_measurable_on s`)) THEN ASM_SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_ARITH_TAC] THEN FIRST_ASSUM(MP_TAC o check ((not) o is_conj o concl)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_PASTECART) THEN SUBGOAL_THEN `((\z. lambda i. if i < n then fstcart z$i else if i = n then sndcart z$1 else &0) :real^(N,1)finite_sum->real^N) continuous_on UNIV` MP_TAC THENL [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`i:num < n`; `i:num = n`] THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[FUN_EQ_THM; LAMBDA_BETA; CART_EQ] THEN REWRITE_TAC[LT; GSYM drop; LIFT_DROP] THEN MESON_TAC[]]]);; let BOREL_BOREL_MEASURABLE_PREIMAGE = prove (`!f:real^M->real^N s t. f borel_measurable_on s /\ borel s /\ borel t ==> borel {x | x IN s /\ f x IN t}`, GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] THEN MATCH_MP_TAC BOREL_INDUCT_OPEN_UNIONS_INTERS THEN CONJ_TAC THENL [X_GEN_TAC `u:real^N->bool`; REWRITE_TAC[IMP_IMP] THEN CONJ_TAC THEN X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THENL [SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN UNIONS u} = UNIONS {{x | x IN s /\ f x IN t} | t IN u}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC BOREL_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE]; ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN ASM_SIMP_TAC[INTERS_0; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN INTERS u} = INTERS {{x | x IN s /\ f x IN t} | t IN u}` SUBST1_TAC THENL [REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC BOREL_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE]]] THEN ONCE_REWRITE_TAC[TAUT `p ==> q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`u:real^N->bool`; `s:real^M->bool`; `f:real^M->real^N`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_BOREL THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN ASM_REWRITE_TAC[]; MAP_EVERY X_GEN_TAC [`g:num->real^M->real^N`; `f:real^M->real^N`; `s:real^M->bool`] THEN STRIP_TAC THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC] THEN ASM_CASES_TAC `v = (:real^N)` THEN ASM_REWRITE_TAC[SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN v} = UNIONS {INTERS {{x | x IN s /\ lift(setdist({(g:num->real^M->real^N) n x},(:real^N) DIFF v)) IN {x | drop x > e}} |n| N <= n} |N,e| N IN (:num) /\ e IN {r | rational r /\ &0 < r}}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM] THEN REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[real_gt]; MESON_TAC[LE_REFL]] THEN TRANS_TAC EQ_TRANS `&0 < setdist({(f:real^M->real^N) x},(:real^N) DIFF v)` THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM RATIONAL_BETWEEN_EQ]; REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EVENTUALLY_SEQUENTIALLY] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON [RATIONAL_CLOSED] `(!x. Q x ==> P(x / &2)) /\ (!x. P x ==> Q(x / &2)) ==> ((?x. rational x /\ P x) <=> (?y. rational y /\ Q y))`) THEN CONJ_TAC THEN X_GEN_TAC `q:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `q / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; IMP_IMP] THENL [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `q < d2 ==> abs(d1 - d2) <= x ==> x < q / &2 ==> q / &2 < d1`)); REWRITE_TAC[GSYM EVENTUALLY_AND] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `abs(d1 - d2) <= x ==> x < q / &2 /\ q < d1 ==> q / &2 < d2`)] THEN REWRITE_TAC[SETDIST_SING_TRIANGLE]; MATCH_MP_TAC BOREL_UNIONS THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[NUM_COUNTABLE] THEN SIMP_TAC[REWRITE_RULE[IN] COUNTABLE_RESTRICT; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_GSPEC]] THEN MAP_EVERY X_GEN_TAC [`N:num`; `e:real`] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ lift(setdist({g n x},t)) IN u} = {x | x IN s /\ g n x IN {y | lift(setdist({y},t)) IN u}}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN REWRITE_TAC[CONTINUOUS_AT_LIFT_SETDIST; drop] THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT]]);; let BOREL_MEASURABLE_INDICATOR = prove (`!s. indicator s borel_measurable_on (:real^N) <=> borel s`, REWRITE_TAC[FORALL_AND_THM; TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `s = {x | x IN (:real^N) /\ indicator s x IN {vec 1}}` SUBST1_TAC THENL [REWRITE_TAC[indicator; EXTENSION; IN_ELIM_THM; IN_SING; IN_UNIV] THEN REWRITE_TAC[COND_RAND; COND_RATOR; VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]; MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN ASM_REWRITE_TAC[ETA_AX; BOREL_UNIV] THEN SIMP_TAC[CLOSED_IMP_BOREL; CLOSED_SING]]; ALL_TAC] THEN MATCH_MP_TAC BOREL_INDUCT_COMPACT_ALT THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE_IMP_BOREL_MEASURABLE THEN EXISTS_TAC `1` THEN REWRITE_TAC[BAIRE1_INDICATOR] THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_GDELTA; CLOSED_IMP_FSIGMA]; X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[INDICATOR_COMPLEMENT; BOREL_MEASURABLE_SUB; ETA_AX; CONTINUOUS_IMP_BOREL_MEASURABLE_ON; CONTINUOUS_ON_CONST]; X_GEN_TAC `u:(real^N->bool)->bool` THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPEC `u:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:num->real^N->bool` SUBST1_TAC) THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `\n x:real^N. lift(product(0..n) (\m. drop(indicator (c m) x)))` THEN REWRITE_TAC[IN_UNIV] THEN CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_PRODUCT THEN ASM_SIMP_TAC[LIFT_DROP; ETA_AX; FINITE_NUMSEG]; X_GEN_TAC `x:real^N` THEN REWRITE_TAC[indicator; INTERS_IMAGE; IN_UNIV; IN_ELIM_THM] THEN ASM_CASES_TAC `!n:num. (x:real^N) IN c n` THEN ASM_REWRITE_TAC[DROP_VEC; PRODUCT_ONE; LIM_CONST; LIFT_NUM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ; PRODUCT_EQ_0_NUMSEG] THEN EXISTS_TAC `N:num` THEN ASM_REWRITE_TAC[LIFT_DROP; LE_0]]]);; let BOREL_MEASURABLE_ON_INDICATOR = prove (`!s t:real^N->bool. borel s ==> (indicator t borel_measurable_on s <=> borel(s INTER t))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [SUBGOAL_THEN `s INTER t = {x:real^N | x IN s /\ indicator t x IN {vec 1}}` SUBST1_TAC THENL [REWRITE_TAC[indicator; EXTENSION; IN_ELIM_THM; IN_INTER; IN_SING] THEN REWRITE_TAC[COND_RAND; COND_RATOR; VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]; MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN ASM_SIMP_TAC[ETA_AX; CLOSED_IMP_BOREL; CLOSED_SING]]; MATCH_MP_TAC BOREL_MEASURABLE_EQ THEN EXISTS_TAC `indicator(s INTER t:real^N->bool)` THEN CONJ_TAC THENL [SIMP_TAC[indicator; IN_INTER]; MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN ASM_REWRITE_TAC[BOREL_MEASURABLE_INDICATOR]]]);; let BOREL_MEASURABLE_PREIMAGE_BOREL = prove (`!f:real^M->real^N s. borel s /\ f borel_measurable_on s <=> !t. borel t ==> borel {x | x IN s /\ f x IN t}`, let lemma0 = prove (`!f:real^M->real^1 n m. integer m /\ m / &2 pow n <= drop(f x) /\ drop(f x) < (m + &1) / &2 pow n /\ abs(m) <= &2 pow (2 * n) ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x) = lift(m / &2 pow n)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum {m} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x)` THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in let lemma1 = prove (`!f:real^M->real^1 s. borel s /\ (!a b. borel {x | x IN s /\ a <= drop(f x) /\ drop(f x) < b}) ==> f borel_measurable_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN REWRITE_TAC[IN_UNIV] THEN EXISTS_TAC `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} (\k. k / &2 pow n % indicator {y:real^M | k / &2 pow n <= drop(f y) /\ drop(f y) < (k + &1) / &2 pow n} x)` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC BOREL_MEASURABLE_VSUM THEN REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_CMUL THEN ASM_SIMP_TAC[BOREL_MEASURABLE_ON_INDICATOR; ETA_AX; SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`]; X_GEN_TAC `x:real^M` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MP_TAC(ISPECL [`&2`; `abs(drop((f:real^M->real^1) x))`] REAL_ARCH_POW) THEN ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN REWRITE_TAC[REAL_POW_INV] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^M)))` THEN SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^M->real^1) x) < e` MP_TAC THENL [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ; REAL_OF_NUM_EQ; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e * &2 pow N2` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; MATCH_MP_TAC(NORM_ARITH `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN MATCH_MP_TAC lemma0 THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE; INTEGER_CLOSED] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x < e ==> e <= d ==> x <= d`))] THEN MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC]) in REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[BOREL_BOREL_MEASURABLE_PREIMAGE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(:real^N)`) THEN REWRITE_TAC[BOREL_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC I [BOREL_MEASURABLE_COMPONENTWISE] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN ASM_REWRITE_TAC[LIFT_DROP] THEN REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ a <= f x$k /\ f x$k < b} = {x | x IN s /\ f x IN ({y | a <= y$k} INTER {y | y$k < b})}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC BOREL_INTER THEN SIMP_TAC[OPEN_IMP_BOREL; OPEN_HALFSPACE_COMPONENT_LT] THEN SIMP_TAC[CLOSED_IMP_BOREL; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]);; let BOREL_MEASURABLE_EXTENSION = prove (`!f:real^M->real^N s t. f borel_measurable_on s /\ IMAGE f s SUBSET t /\ borel t ==> ?g. g borel_measurable_on (:real^M) /\ (~(t = {}) ==> IMAGE g (:real^M) SUBSET t) /\ (!x. x IN s ==> g x = f x)`, let version1 = prove (`!f:real^M->real^N s. f borel_measurable_on s ==> ?u g. borel u /\ s SUBSET u /\ u SUBSET closure s /\ g borel_measurable_on u /\ (!x. x IN s ==> g x = f x)`, MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^N)`] LAVRENTIEV) THEN ASM_REWRITE_TAC[GDELTA_UNIV; SUBSET_UNIV] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON; GDELTA_IMP_BOREL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`f:num->real^M->real^N`; `g:real^M->real^N`; `s:real^M->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:num->real^M->bool`; `h:num->real^M->real^N`] THEN STRIP_TAC THEN ABBREV_TAC `v = {x | x IN INTERS {u n | n IN (:num)} /\ ?l. ((\n. (h:num->real^M->real^N) n x) --> l) sequentially}` THEN EXISTS_TAC `v:real^M->bool` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [SUBGOAL_THEN `v = INTERS {UNIONS {INTERS { INTERS {{x:real^M | x IN INTERS {u n | n IN (:num)} /\ h m x - h n x IN ball(vec 0:real^N,e)} |m| N <= m} |n| N <= n} | N IN (:num)} | e IN {q | q IN rational /\ &0 < q}}` SUBST1_TAC THENL [EXPAND_TAC "v" THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN REWRITE_TAC[IN_BALL_0; NORM_ARITH `norm(x - y:real^N) = dist(x,y)`] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; GE] THEN X_GEN_TAC `x:real^M` THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `!n. x IN (u:num->real^M->bool) n` THEN ASM_REWRITE_TAC[IN] THENL [ALL_TAC; MESON_TAC[RATIONAL_CLOSED; REAL_LT_01; LE_REFL]] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`&0`; `e:real`] RATIONAL_BETWEEN) THEN ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC BOREL_INTERS THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_RATIONAL; COUNTABLE_RESTRICT; FORALL_IN_IMAGE] THEN X_GEN_TAC `q:real` THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOREL_UNIONS THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[IN_UNIV] THEN MATCH_MP_TAC BOREL_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC BOREL_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN ASM_SIMP_TAC[BOREL_INTERS; FORALL_IN_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; OPEN_IMP_BOREL; OPEN_BALL] THEN MATCH_MP_TAC BOREL_MEASURABLE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THENL [EXISTS_TAC `(u:num->real^M->bool) n`; EXISTS_TAC `(u:num->real^M->bool) m`] THEN ASM_REWRITE_TAC[ETA_AX] THEN ASM SET_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; INTERS_GSPEC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `(g:real^M->real^N) x`] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN ASM_SIMP_TAC[EVENTUALLY_TRUE]; DISCH_TAC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. ?l. x IN v ==> ((\n. (h:num->real^M->real^N) n x) --> l) sequentially` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `h:num->real^M->real^N` THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN EXISTS_TAC `(u:num->real^M->bool) n` THEN ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (h:num->real^M->real^N) n x` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_SIMP_TAC[EVENTUALLY_TRUE]; FIRST_X_ASSUM MATCH_MP_TAC] THEN ASM SET_TAC[]]) in let version2 = prove (`!f:real^M->real^N s t. f borel_measurable_on s /\ IMAGE f s SUBSET t /\ borel t ==> ?u g. borel u /\ s SUBSET u /\ u SUBSET closure s /\ g borel_measurable_on u /\ IMAGE g u SUBSET t /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] version1) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{x | x IN u /\ (g:real^M->real^N) x IN t}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN ASM_REWRITE_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]; MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN EXISTS_TAC `u:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT]; ASM SET_TAC[]; ASM SET_TAC[]]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_SIMP_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON; CONTINUOUS_ON_CONST]; STRIP_TAC] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] version2) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `g:real^M->real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN EXISTS_TAC `\x. if x IN u then (g:real^M->real^N) x else c` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN W(MP_TAC o PART_MATCH (rand o lhand) BOREL_MEASURABLE_PREIMAGE_BOREL o snd) THEN REWRITE_TAC[BOREL_UNIV; IN_UNIV] THEN DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | (if x IN u then (g:real^M->real^N) x else c) IN v} = {x | x IN u /\ g x IN v} UNION (if c IN v then UNIV DIFF u else {})` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM SET_TAC[]; MATCH_MP_TAC BOREL_UNION THEN ASM_SIMP_TAC[BOREL_BOREL_MEASURABLE_PREIMAGE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[BOREL_EMPTY; BOREL_COMPLEMENT]]);; let BOREL_MEASURABLE_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s. f borel_measurable_on s /\ g borel_measurable_on IMAGE f s ==> g o f borel_measurable_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^N->real^P`; `IMAGE (f:real^M->real^N) s`; `(:real^P)`] BOREL_MEASURABLE_EXTENSION) THEN ASM_REWRITE_TAC[SUBSET_UNIV; BOREL_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^P` THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_EQ THEN EXISTS_TAC `(h:real^N->real^P) o (f:real^M->real^N)` THEN REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN UNDISCH_TAC `(f:real^M->real^N) borel_measurable_on s` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`s:real^M->bool`; `f:real^M->real^N`] THEN ABBREV_TAC `t = (:real^N)` THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN UNDISCH_TAC `(h:real^N->real^P) borel_measurable_on t` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:real^N->bool`; `h:real^N->real^P`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL [ASM_MESON_TAC[BOREL_MEASURABLE_CONTINUOUS_COMPOSE; CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; MAP_EVERY X_GEN_TAC [`g:num->real^N->real^P`; `h:real^N->real^P`; `t:real^N->bool`] THEN ASM_CASES_TAC `t = (:real^N)` THEN ASM_REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC `\n. (g:num->real^N->real^P) n o (f:real^M->real^N)` THEN ASM_SIMP_TAC[o_THM] THEN ASM SET_TAC[]]);; let BOREL_MEASURABLE_CASES = prove (`!f g:real^M->real^N s t. f borel_measurable_on s /\ g borel_measurable_on (t DIFF s) /\ borel s ==> (\x. if x IN s then f x else g x) borel_measurable_on t`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `(:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOREL_MEASURABLE_EXTENSION)) THEN FIRST_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] BOREL_MEASURABLE_EXTENSION)) THEN ASM_REWRITE_TAC[SUBSET_UNIV; BOREL_UNIV; IN_DIFF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f':real^M->real^N` THEN STRIP_TAC THEN X_GEN_TAC `g':real^M->real^N` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_EQ THEN EXISTS_TAC `(\x. drop(indicator s x) % f' x + (&1 - drop(indicator s x)) % g' x) :real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[DROP_VEC; REAL_SUB_REFL; REAL_SUB_RZERO] THEN CONV_TAC VECTOR_ARITH; MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN EXISTS_TAC `(:real^M)` THEN REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC BOREL_MEASURABLE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_MUL THEN ASM_SIMP_TAC[LIFT_DROP; ETA_AX; BOREL_MEASURABLE_INDICATOR; LIFT_SUB; BOREL_MEASURABLE_CONST; BOREL_MEASURABLE_SUB]]);; let BOREL_MEASURABLE_RESTRICT = prove (`!f:real^M->real^N s. f borel_measurable_on s /\ borel s ==> (\x. if x IN s then f x else vec 0) borel_measurable_on (:real^M)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_CASES THEN ASM_REWRITE_TAC[BOREL_MEASURABLE_CONST]);; (* ------------------------------------------------------------------------- *) (* Analytic sets. *) (* ------------------------------------------------------------------------- *) let analytic = new_definition `analytic s = suslin compact s`;; let COMPACT_IMP_ANALYTIC = prove (`!s. compact s ==> analytic s`, REWRITE_TAC[analytic; REWRITE_RULE[IN; SUBSET] SUSLIN_SUPERSET]);; let ANALYTIC_EMPTY = prove (`analytic({}:real^N->bool)`, SIMP_TAC[COMPACT_EMPTY; COMPACT_IMP_ANALYTIC]);; let ANALYTIC_UNIONS = prove (`!u:(real^N->bool)->bool. COUNTABLE u /\ (!s. s IN u ==> analytic s) ==> analytic(UNIONS u)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; ANALYTIC_EMPTY] THEN REWRITE_TAC[analytic] THEN MATCH_MP_TAC SUSLIN_UNIONS THEN ASM_REWRITE_TAC[GSYM analytic]);; let ANALYTIC_UNION = prove (`!s t:real^N->bool. analytic s /\ analytic t ==> analytic(s UNION t)`, REWRITE_TAC[analytic; SUSLIN_UNION]);; let LOCALLY_COMPACT_IMP_ANALYTIC = prove (`!s:real^N->bool. locally compact s ==> analytic s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC ANALYTIC_UNIONS THEN ASM_SIMP_TAC[COMPACT_IMP_ANALYTIC]);; let OPEN_IMP_ANALYTIC = prove (`!s:real^N->bool. open s ==> analytic s`, SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; LOCALLY_COMPACT_IMP_ANALYTIC]);; let CLOSED_IMP_ANALYTIC = prove (`!s:real^N->bool. closed s ==> analytic s`, SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; LOCALLY_COMPACT_IMP_ANALYTIC]);; let ANALYTIC_UNIV = prove (`analytic(:real^N)`, SIMP_TAC[LOCALLY_COMPACT_IMP_ANALYTIC; LOCALLY_COMPACT_UNIV]);; let ANALYTIC_INTERS = prove (`!u:(real^N->bool)->bool. COUNTABLE u /\ (!s. s IN u ==> analytic s) ==> analytic(INTERS u)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; ANALYTIC_UNIV] THEN REWRITE_TAC[analytic] THEN MATCH_MP_TAC SUSLIN_INTERS THEN ASM_REWRITE_TAC[GSYM analytic]);; let ANALYTIC_INTER = prove (`!s t:real^N->bool. analytic s /\ analytic t ==> analytic(s INTER t)`, REWRITE_TAC[analytic; SUSLIN_INTER]);; let OPEN_IN_ANALYTIC = prove (`!s t:real^N->bool. open_in (subtopology euclidean t) s /\ analytic t ==> analytic s`, REPEAT GEN_TAC THEN SIMP_TAC[IMP_CONJ; OPEN_IN_OPEN; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[ANALYTIC_INTER; OPEN_IMP_ANALYTIC]);; let CLOSED_IN_ANALYTIC = prove (`!s t:real^N->bool. closed_in (subtopology euclidean t) s /\ analytic t ==> analytic s`, REPEAT GEN_TAC THEN SIMP_TAC[IMP_CONJ; CLOSED_IN_CLOSED; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[ANALYTIC_INTER; CLOSED_IMP_ANALYTIC]);; let BOREL_IMP_ANALYTIC = prove (`!s:real^N->bool. borel s ==> analytic s`, MATCH_MP_TAC BOREL_INDUCT_COMPACT_UNIONS_INTERS THEN REWRITE_TAC[COMPACT_IMP_ANALYTIC; ANALYTIC_UNIONS; ANALYTIC_INTERS]);; let GDELTA_IMP_ANALYTIC = prove (`!s:real^N->bool. gdelta s ==> analytic s`, SIMP_TAC[BOREL_IMP_ANALYTIC; GDELTA_IMP_BOREL]);; let FSIGMA_IMP_ANALYTIC = prove (`!s:real^N->bool. fsigma s ==> analytic s`, SIMP_TAC[BOREL_IMP_ANALYTIC; FSIGMA_IMP_BOREL]);; let ANALYTIC_PCROSS = prove (`!s:real^M->bool t:real^N->bool. analytic s /\ analytic t ==> analytic(s PCROSS t)`, let lemma = prove (`!s:real^M->bool t:real^N->bool. analytic s /\ compact t ==> analytic(s PCROSS t)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[analytic] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM SUSLIN_SUSLIN] THEN ONCE_REWRITE_TAC[suslin] THEN REWRITE_TAC[IN; IN_ELIM_THM; GSYM analytic] THEN DISCH_THEN(X_CHOOSE_THEN `f:num list->real^M->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN EXISTS_TAC `\l. (f:num list->real^M->bool) l PCROSS (t:real^N->bool)` THEN ASM_SIMP_TAC[COMPACT_PCROSS; COMPACT_IMP_ANALYTIC] THEN REWRITE_TAC[suslin_operation; PCROSS_UNIONS; PCROSS_INTERS; SET_RULE `{f y | y IN {g x | P x}} = {f(g x) | P x}`] THEN REWRITE_TAC[SET_RULE `{f x | P x} = {} <=> ~(?x. P x)`] THEN REWRITE_TAC[MESON[LE_REFL] `?n. 1 <= n`]) in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[analytic] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM SUSLIN_SUSLIN] THEN ONCE_REWRITE_TAC[suslin] THEN REWRITE_TAC[IN; IN_ELIM_THM; GSYM analytic] THEN DISCH_THEN(X_CHOOSE_THEN `f:num list->real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN EXISTS_TAC `\l. (s:real^M->bool) PCROSS (f:num list->real^N->bool) l` THEN ASM_SIMP_TAC[lemma] THEN REWRITE_TAC[suslin_operation; PCROSS_UNIONS; PCROSS_INTERS; SET_RULE `{f y | y IN {g x | P x}} = {f(g x) | P x}`] THEN REWRITE_TAC[SET_RULE `{f x | P x} = {} <=> ~(?x. P x)`] THEN REWRITE_TAC[MESON[LE_REFL] `?n. 1 <= n`]);; let ANALYTIC_BOREL_MEASURABLE_PREIMAGE = prove (`!f:real^M->real^N s t. f borel_measurable_on s /\ analytic s /\ analytic t ==> analytic {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^N)`] BOREL_MEASURABLE_EXTENSION) THEN ASM_REWRITE_TAC[SUBSET_UNIV; BOREL_UNIV; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = s INTER {x | x IN (:real^M) /\ g x IN t}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC ANALYTIC_INTER THEN ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC [`analytic(t:real^N->bool)`; `(g:real^M->real^N) borel_measurable_on (:real^M)`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN REWRITE_TAC[analytic] THEN GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV) [GSYM SUSLIN_SUSLIN] THEN GEN_REWRITE_TAC (BINOP_CONV o RATOR_CONV) [suslin] THEN GEN_REWRITE_TAC BINOP_CONV [GSYM IN] THEN SPEC_TAC(`t:real^N->bool`,`t:real^N->bool`) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `c:num list->real^N->bool` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN] THEN DISCH_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [IN] THEN REWRITE_TAC[GSYM analytic; IN_ELIM_THM] THEN EXISTS_TAC `\l:num list. {x | x IN UNIV /\ (g:real^M->real^N) x IN c l}` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_IMP_ANALYTIC THEN MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN ASM_SIMP_TAC[COMPACT_IMP_BOREL; BOREL_UNIV]; GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[suslin_operation; IN_ELIM_THM] THEN REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN MP_TAC LE_REFL THEN SET_TAC[]]);; let ANALYTIC_CONTINUOUS_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ analytic s /\ analytic t ==> analytic {x | x IN s /\ f x IN t}`, SIMP_TAC[ANALYTIC_BOREL_MEASURABLE_PREIMAGE; CONTINUOUS_IMP_BOREL_MEASURABLE_ON]);; let ANALYTIC_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. analytic s /\ f continuous_on s ==> analytic(IMAGE f s)`, let lemma = prove (`!f:real^M->real^N s. f continuous_on (:real^M) /\ analytic s ==> analytic(IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[analytic] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUSLIN_REGULAR o rator o lhand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_INTERS THEN ASM SET_TAC[]; DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV) [th])] THEN REWRITE_TAC[suslin; IN_ELIM_THM; IN] THEN DISCH_THEN(X_CHOOSE_THEN `t:num list->real^M->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST1_TAC THEN EXISTS_TAC `IMAGE (f:real^M->real^N) o (t:num list->real^M->bool)` THEN REWRITE_TAC[suslin_operation; o_DEF] THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; REWRITE_TAC[IMAGE_UNIONS]] THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN X_GEN_TAC `s:num->num` THEN REWRITE_TAC[o_THM; IN_UNIV] THEN W(MP_TAC o PART_MATCH (lhand o rand) CONTINUOUS_IMAGE_NESTED_INTERS_GEN o lhand o snd) THEN ASM_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[GSYM LENGTH_EQ_NIL; LENGTH_LIST_OF_SEQ; LE_1] THEN ASM_ARITH_TAC]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = IMAGE sndcart {x | x IN s PCROSS (:real^N) /\ (f(fstcart x) - sndcart x) IN {vec 0}}` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_SUB_EQ; IN_SING; EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IN_ELIM_THM; EXISTS_PASTECART; FORALL_PASTECART] THEN REWRITE_TAC[SNDCART_PASTECART; PASTECART_INJ; FSTCART_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN MESON_TAC[]; MATCH_MP_TAC lemma THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN MATCH_MP_TAC ANALYTIC_CONTINUOUS_PREIMAGE THEN ASM_SIMP_TAC[ANALYTIC_PCROSS; ANALYTIC_UNIV] THEN SIMP_TAC[CLOSED_SING; CLOSED_IMP_ANALYTIC] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; UNIV_NOT_EMPTY]]);; let HOMEOMORPHIC_ANALYTICITY = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> (analytic s <=> analytic t)`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[ANALYTIC_CONTINUOUS_IMAGE]);; let ANALYTIC_TRANSLATION = prove (`!a:real^N s. analytic (IMAGE (\x. a + x) s) <=> analytic s`, REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANALYTICITY THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; add_translation_invariants [ANALYTIC_TRANSLATION];; let ANALYTIC_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (analytic(IMAGE f s) <=> analytic s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANALYTICITY THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN ASM_REWRITE_TAC[]);; add_linear_invariants [ANALYTIC_LINEAR_IMAGE];; let ANALYTIC_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. analytic(s PCROSS t) <=> s = {} \/ t = {} \/ analytic s /\ analytic t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; ANALYTIC_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; ANALYTIC_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[ANALYTIC_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPEC `fstcart:real^(M,N)finite_sum->real^M` ANALYTIC_CONTINUOUS_IMAGE); MP_TAC(ISPEC `sndcart:real^(M,N)finite_sum->real^N` ANALYTIC_CONTINUOUS_IMAGE)] THEN DISCH_THEN(MP_TAC o SPEC `(s:real^M->bool) PCROSS (t:real^N->bool)`) THEN ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let ANALYTIC_BOREL_MEASURABLE_IMAGE = prove (`!f:real^M->real^N s. analytic s /\ f borel_measurable_on s ==> analytic(IMAGE f s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = IMAGE sndcart {x | x IN s PCROSS (:real^N) /\ (f(fstcart x) - sndcart x) IN {vec 0}}` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_SUB_EQ; IN_SING; EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IN_ELIM_THM; EXISTS_PASTECART; FORALL_PASTECART] THEN REWRITE_TAC[SNDCART_PASTECART; PASTECART_INJ; FSTCART_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN MESON_TAC[]; MATCH_MP_TAC ANALYTIC_CONTINUOUS_IMAGE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN MATCH_MP_TAC ANALYTIC_BOREL_MEASURABLE_PREIMAGE THEN ASM_SIMP_TAC[ANALYTIC_PCROSS; ANALYTIC_UNIV] THEN SIMP_TAC[CLOSED_SING; CLOSED_IMP_ANALYTIC] THEN MATCH_MP_TAC BOREL_MEASURABLE_SUB THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_IMP_BOREL_MEASURABLE_ON; LINEAR_SNDCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC BOREL_MEASURABLE_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; CONTINUOUS_IMP_BOREL_MEASURABLE_ON] THEN ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; UNIV_NOT_EMPTY]]);; let CARD_EQ_ANALYTIC_SETS = prove (`{s:real^N->bool | analytic s} =_c (:real)`, REWRITE_TAC[analytic] THEN REWRITE_TAC[ETA_AX; SET_RULE `{x | s x} = s`] THEN MATCH_MP_TAC CARD_SUSLIN_EQ THEN GEN_REWRITE_TAC LAND_CONV [SET_RULE `s = {x | s x}`] THEN REWRITE_TAC[CARD_EQ_COMPACT_SETS]);; let CARD_EQ_BOREL_SETS = prove (`{s:real^N->bool | borel s} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | analytic s}` THEN SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_ANALYTIC_SETS] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; BOREL_IMP_ANALYTIC]; TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | compact s}` THEN SIMP_TAC[CARD_EQ_IMP_LE; ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_COMPACT_SETS] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_BOREL]]);; let CARD_EQ_BOREL_MEASURABLE_FUNCTIONS = prove (`{f:real^M->real^N | f borel_measurable_on UNIV} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `{(\x. c):real^M->real^N | c IN UNIV}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[FUN_EQ_THM]; MATCH_MP_TAC CARD_LE_SUBSET THEN SIMP_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; BOREL_MEASURABLE_CONST]]] THEN X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN TRANS_TAC CARD_LE_TRANS `{s:real^M->bool | borel s} ^_c (B:(real^N->bool)->bool)` THEN ASM_SIMP_TAC[CARD_EQ_BOREL_SETS; CARD_EQ_IMP_LE; CARD_EXP_LE_REAL] THEN REWRITE_TAC[le_c; exp_c; IN_ELIM_THM] THEN EXISTS_TAC `\f:real^M->real^N b. if b IN B then {x | x IN UNIV /\ f x IN b} else @y. F` THEN ASM_SIMP_TAC[BOREL_BOREL_MEASURABLE_PREIMAGE; OPEN_IMP_BOREL; OPEN_UNIV] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN PURE_REWRITE_TAC[DIST_NZ] THEN DISCH_TAC THEN SUBGOAL_THEN `?b. b IN B /\ f(x:real^M) IN b /\ b SUBSET ball(f x:real^N,dist(f x,g x))` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`(f:real^M->real^N) x`; `dist((f:real^M->real^N) x,g x)`] OPEN_BALL) THEN MP_TAC(ISPECL [`(f:real^M->real^N) x`; `dist((f:real^M->real^N) x,g x)`] CENTRE_IN_BALL) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o C AP_THM `b:real^N->bool`)] THEN ASM_REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^M->real^N) x` o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_BALL; REAL_LT_REFL]);; let CARD_EQ_BAIRE_FUNCTIONS = prove (`{f:real^M->real^N | baire k UNIV f} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `{f:real^M->real^N | f borel_measurable_on UNIV}` THEN SIMP_TAC[CARD_EQ_BOREL_MEASURABLE_FUNCTIONS; CARD_EQ_IMP_LE] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; BAIRE_IMP_BOREL_MEASURABLE]; TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `{(\x. c):real^M->real^N | c IN UNIV}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[FUN_EQ_THM]; MATCH_MP_TAC CARD_LE_SUBSET THEN SIMP_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; BAIRE_CONST]]]);; (* ------------------------------------------------------------------------- *) (* Some Borel variants of the measurability of the Banach indicatrix. *) (* ------------------------------------------------------------------------- *) let FSIGMA_PREIMAGE_CARD_GE = prove (`!f:real^M->real^N s n. f continuous_on s /\ fsigma s ==> fsigma {y | FINITE {x | x IN s /\ f x = y} ==> n <= CARD {x | x IN s /\ f x = y}}`, REPEAT STRIP_TAC THEN REWRITE_TAC[CHOOSE_SUBSET_EQ] THEN REWRITE_TAC[SET_RULE `t SUBSET {x | x IN s /\ P x} /\ Q t <=> t SUBSET s /\ Q t /\ (!x. x IN t ==> P x)`] THEN SUBGOAL_THEN `{y | ?t. t SUBSET s /\ t HAS_SIZE n /\ (!x. x IN t ==> f x = y)} = UNIONS (IMAGE (\b. INTERS (IMAGE (IMAGE (f:real^M->real^N)) b)) {b | b SUBSET {s INTER ball(a,r) | (!i. 1 <= i /\ i <= dimindex(:M) ==> rational(a$i)) /\ rational r} /\ b HAS_SIZE n /\ pairwise DISJOINT b})` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC FSIGMA_UNIONS THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[HAS_SIZE] THEN REWRITE_TAC[SET_RULE `b SUBSET s /\ (FINITE b /\ Q b) /\ R b <=> b IN {c | c SUBSET s /\ FINITE c} /\ Q b /\ R b`] THEN MATCH_MP_TAC COUNTABLE_RESTRICT THEN MATCH_MP_TAC COUNTABLE_FINITE_SUBSETS THEN ONCE_REWRITE_TAC[SET_RULE `{f x y | P x /\ Q y} = {f x y | x IN {z | P z} /\ y IN Q}`] THEN MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN REWRITE_TAC[COUNTABLE_RATIONAL_COORDINATES; COUNTABLE_RATIONAL]; REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; HAS_SIZE] THEN X_GEN_TAC `b:(real^M->bool)->bool` THEN STRIP_TAC THEN MATCH_MP_TAC FSIGMA_INTERS THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b SUBSET c ==> (!x. x IN c ==> P x) ==> (!x. x IN b ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `r:real`] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC FSIGMA_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[FSIGMA_INTER; OPEN_IMP_FSIGMA; OPEN_BALL] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]]] THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; INTERS_IMAGE] THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN(X_CHOOSE_THEN `b:(real^M->bool)->bool` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[IN_IMAGE] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:(real^M->bool)->real^M` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (p:(real^M->bool)->real^M) b` THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; SUBSET] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `(!x. x IN b ==> Q x) ==> (!x. x IN b ==> Q x ==> P x) ==> (!x. x IN b ==> P x)`)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b SUBSET c ==> (!x. x IN c ==> P x) ==> (!x. x IN b ==> P x)`)) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN SET_TAC[]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]]] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `t:real^M->bool` FINITE_EQ_BOUNDED_DISCRETE) THEN ASM_CASES_TAC `FINITE(t:real^M->bool)` THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[HAS_SIZE]] THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC o CONJUNCT2) THEN MP_TAC(ISPECL [`&0`; `r / &4`] RATIONAL_BETWEEN) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `q:real` THEN STRIP_TAC THEN SUBGOAL_THEN `!x. x IN t ==> ?a. (!i. 1 <= i /\ i <= dimindex(:M) ==> rational(a$i)) /\ x IN ball(a:real^M,q)` MP_TAC THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MP_TAC(ISPECL [`x:real^M`; `{a:real^M | !i. 1 <= i /\ i <= dimindex(:M) ==> rational(a$i)}`] CLOSURE_APPROACHABLE) THEN REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; IN_UNIV; IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC `q:real`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[DIST_SYM]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^M->real^M` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (\x. s INTER ball((a:real^M->real^M) x,q)) t` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE `(!s. P s ==> y IN IMAGE f (g s)) ==> (!s. P s ==> ~(g s = {}))`)) THEN SUBGOAL_THEN `pairwise (\x y. DISJOINT (s INTER ball ((a:real^M->real^M) x,q)) (s INTER ball(a y,q))) t` MP_TAC THENL [REWRITE_TAC[pairwise] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. ~(x IN t /\ x IN u)) ==> DISJOINT (s INTER t) (s INTER u)`) THEN SUBGOAL_THEN `x IN ball(a x,q) /\ y IN ball(a y:real^M,q)` MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN ASM_REWRITE_TAC[IN_BALL] THEN UNDISCH_TAC `q < r / &4` THEN CONV_TAC NORM_ARITH; REWRITE_TAC[PAIRWISE_IMAGE] THEN SIMP_TAC[pairwise] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SET_RULE `~(s = {}) /\ ~(t = {}) /\ DISJOINT s t ==> ~(s = t)`]]]);; let GDELTA_PREIMAGE_CARD_LE = prove (`!f:real^M->real^N s n. f continuous_on s /\ fsigma s ==> gdelta {y | FINITE {x | x IN s /\ f x = y} /\ CARD {x | x IN s /\ f x = y} <= n}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = UNIV DIFF {x | P x ==> ~Q x}`] THEN REWRITE_TAC[GDELTA_COMPLEMENT; ARITH_RULE `~(m <= n) <=> SUC n <= m`] THEN ASM_SIMP_TAC[FSIGMA_PREIMAGE_CARD_GE]);; let BOREL_PREIMAGE_HAS_SIZE = prove (`!f:real^M->real^N s n. f continuous_on s /\ fsigma s ==> borel {y | {x | x IN s /\ f x = y} HAS_SIZE n}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[HAS_SIZE_0; SET_RULE `{y | {x | x IN s /\ f x = y} = {}} = UNIV DIFF IMAGE f s`] THEN REWRITE_TAC[BOREL_COMPLEMENT] THEN MATCH_MP_TAC FSIGMA_IMP_BOREL THEN ASM_MESON_TAC[FSIGMA_CONTINUOUS_IMAGE]; REWRITE_TAC[HAS_SIZE] THEN FIRST_ASSUM(fun th -> REWRITE_TAC [MATCH_MP(ARITH_RULE `~(n = 0) ==> (x = n <=> x <= n /\ ~(x <= n - 1))`) th])] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ ~R x} = {x | P x /\ Q x} DIFF {x | P x /\ R x}`] THEN MATCH_MP_TAC BOREL_DIFF THEN CONJ_TAC THEN MATCH_MP_TAC GDELTA_IMP_BOREL THEN MATCH_MP_TAC GDELTA_PREIMAGE_CARD_LE THEN ASM_REWRITE_TAC[]);; let BOREL_PREIMAGE_FINITE = prove (`!f:real^M->real^N s. f continuous_on s /\ fsigma s ==> borel {y | FINITE {x | x IN s /\ f x = y}}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{y | FINITE {x | x IN s /\ (f:real^M->real^N) x = y}} = UNIONS {{y | {x | x IN s /\ f x = y} HAS_SIZE n} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[HAS_SIZE]; MATCH_MP_TAC BOREL_UNIONS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; BOREL_PREIMAGE_HAS_SIZE] THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]]);; let BOREL_PREIMAGE_INFINITE = prove (`!f:real^M->real^N s. f continuous_on s /\ fsigma s ==> borel {y | INFINITE {x | x IN s /\ f x = y}}`, REWRITE_TAC[INFINITE; SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN REWRITE_TAC[BOREL_COMPLEMENT; BOREL_PREIMAGE_FINITE]);; (* ------------------------------------------------------------------------- *) (* Forms of the Baire property of dense sets. *) (* ------------------------------------------------------------------------- *) let BAIRE = prove (`!g s:real^N->bool. locally compact s /\ COUNTABLE g /\ (!t. t IN g ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t) ==> s SUBSET closure(INTERS g)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; CLOSURE_UNIV; SUBSET_UNIV] THEN MP_TAC(ISPEC `g:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`COUNTABLE(g:(real^N->bool)->bool)`; `~(g:(real^N->bool)->bool = {})`] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^N->bool` SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN REWRITE_TAC[SUBSET; CLOSURE_NONEMPTY_OPEN_INTER] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\n:num u:real^N->bool. open_in (subtopology euclidean s) u /\ ~(u = {}) /\ u SUBSET v`; `\n:num u v:real^N->bool. ?c. compact c /\ v SUBSET c /\ c SUBSET u /\ c SUBSET (g n)`] DEPENDENT_CHOICE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXISTS_TAC `s INTER v:real^N->bool` THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`n:num`; `w:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o SPEC `n:num`) THEN SUBGOAL_THEN `?b:real^N. b IN w /\ b IN g(n:num)` STRIP_ASSUME_TAC THENL [UNDISCH_TAC `open_in (subtopology euclidean s) (w:real^N->bool)` THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN UNDISCH_TAC `s SUBSET closure((g:num->real^N->bool) n)` THEN REWRITE_TAC[SUBSET; CLOSURE_NONEMPTY_OPEN_INTER] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^N` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `t:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN DISCH_THEN(MP_TAC o SPECL [`w INTER (g:num->real^N->bool) n`; `b:real^N`]) THEN ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; IN_INTER] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]; REWRITE_TAC[SKOLEM_THM; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:num->real^N->bool`; `c:num->real^N->bool`] THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN EXISTS_TAC `INTERS {c n:real^N->bool | n IN (:num)}` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM SET_TAC[]]);; let BAIRE_ALT = prove (`!g s:real^N->bool. locally compact s /\ ~(s = {}) /\ COUNTABLE g /\ UNIONS g = s ==> ?t u. t IN g /\ open_in (subtopology euclidean s) u /\ ~(u = {}) /\ u SUBSET (closure t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (\t:real^N->bool. s DIFF closure t) g`; `s:real^N->bool`] BAIRE) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(TAUT `~q /\ (~r ==> p) ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (t = {} ==> closure t = {}) /\ t = {} ==> ~(s SUBSET closure t)`) THEN ASM_SIMP_TAC[CLOSURE_EMPTY] THEN MATCH_MP_TAC(SET_RULE `i SUBSET s /\ s DIFF i = s ==> i = {}`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[DIFF_INTERS] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN REWRITE_TAC[SET_RULE `{s INTER closure t | t IN g} = {s INTER t | t IN IMAGE closure g}`] THEN SIMP_TAC[GSYM INTER_UNIONS; SET_RULE `s INTER t = s <=> s SUBSET t`] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[CLOSURE_SUBSET]; REWRITE_TAC[NOT_EXISTS_THM] THEN STRIP_TAC THEN X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE; OPEN_IN_REFL]; REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^N->bool`; `s INTER ball(x:real^N,e)`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; SUBSET; IN_INTER; IN_BALL; IN_DIFF] THEN MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN ASM_MESON_TAC[DIST_SYM; EXTENSION; IN_INTER; NOT_IN_EMPTY]]]);; let NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN = prove (`!u g:(real^N->bool)->bool. locally compact u /\ COUNTABLE g /\ (!s. s IN g ==> closed_in (subtopology euclidean u) s /\ (subtopology euclidean u) interior_of s = {}) ==> (subtopology euclidean u) interior_of (UNIONS g) = {}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERIOR_OF_EMPTY; UNIONS_0] THEN MP_TAC(ISPECL [`{u DIFF s:real^N->bool | s IN g}`; `u:real^N->bool`] BAIRE) THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[INTERIOR_OF_CLOSURE_OF] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN MATCH_MP_TAC(SET_RULE `c SUBSET d ==> P /\ u DIFF c = {} ==> u SUBSET d`) THEN REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN REWRITE_TAC[SET_RULE `u INTER (u DIFF s) = u DIFF s`] THEN SET_TAC[]; REWRITE_TAC[INTERIOR_OF_CLOSURE_OF; CLOSURE_OF_SUBTOPOLOGY] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN MATCH_MP_TAC(SET_RULE `c SUBSET d ==> u SUBSET c ==> u DIFF u INTER d = {}`) THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[DIFF_UNIONS; SIMPLE_IMAGE; SUBSET_INTER; SUBSET_REFL] THEN MATCH_MP_TAC INTERS_SUBSET THEN REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]);; let NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED = prove (`!g:(real^N->bool)->bool. COUNTABLE g /\ (!s. s IN g ==> closed s /\ interior s = {}) ==> interior(UNIONS g) = {}`, MP_TAC(ISPEC `(:real^N)` NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN) THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; EUCLIDEAN_INTERIOR_OF; GSYM CLOSED_IN] THEN REWRITE_TAC[LOCALLY_COMPACT_UNIV]);; let NOWHERE_DENSE_COUNTABLE_UNIONS = prove (`!g:(real^N->bool)->bool. COUNTABLE g /\ (!s. s IN g ==> interior(closure s) = {}) ==> interior(UNIONS g) = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE closure (g:(real^N->bool)->bool)` NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; CLOSED_CLOSURE] THEN MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN MESON_TAC[CLOSURE_SUBSET]);; (* ------------------------------------------------------------------------- *) (* Some cute Baire applications from Silverman's paper in AMM vol. 102 *) (* "Intervals Contained in Arithmetic Combinations of Sets". These are *) (* somewhat like the Steinhaus/Piccard theorems. There are other variants. *) (* ------------------------------------------------------------------------- *) let SILVERMAN_STEINHAUSLIKE = prove (`!s t:real^N->bool. gdelta s /\ gdelta t /\ (:real^N) SUBSET closure s /\ (:real^N) SUBSET closure t ==> {x + y | x IN s /\ y IN t} = (:real^N)`, REPEAT GEN_TAC THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:(real^N->bool)->bool` STRIP_ASSUME_TAC) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) STRIP_ASSUME_TAC) THEN REWRITE_TAC[SET_RULE `{f x y | x IN s /\ y IN t} = UNIV <=> !z. ?x y. x IN s /\ y IN t /\ f x y = z`] THEN X_GEN_TAC `r:real^N` THEN ASM_CASES_TAC `d:(real^N->bool)->bool = {}` THENL [SUBGOAL_THEN `t = (:real^N)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_UNIV] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[VECTOR_ARITH `x + y:real^N = r <=> y = r - x`] THEN REWRITE_TAC[UNWIND_THM2; MEMBER_NOT_EMPTY] THEN DISCH_TAC THEN UNDISCH_TAC `(:real^N) SUBSET closure s` THEN ASM_REWRITE_TAC[CLOSURE_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`c UNION IMAGE (IMAGE (\x:real^N. r - x)) d`; `(:real^N)`] BAIRE) THEN ASM_SIMP_TAC[LOCALLY_COMPACT_UNIV; COUNTABLE_UNION; COUNTABLE_IMAGE] THEN REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_IMAGE] THEN SUBGOAL_THEN `(\x:real^N. r - x) = (\x. r + x) o (--)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF] THEN ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN ASM_SIMP_TAC[IMAGE_o; OPEN_NEGATIONS; OPEN_TRANSLATION] THEN CONJ_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THENL [TRANS_TAC SUBSET_TRANS `closure(s:real^N->bool)`; SUBGOAL_THEN `(:real^N) = IMAGE (\x. r + x) (IMAGE (--) (:real^N))` SUBST1_TAC THENL [REWRITE_TAC[GSYM IMAGE_o] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV; o_DEF; EXISTS_REFL; VECTOR_ARITH `r + --x:real^N = y <=> x = r - y`]; REWRITE_TAC[CLOSURE_NEGATIONS; CLOSURE_TRANSLATION] THEN REPLICATE_TAC 2 (MATCH_MP_TAC IMAGE_SUBSET) THEN TRANS_TAC SUBSET_TRANS `closure(t:real^N->bool)`]] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]; DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `UNIV SUBSET s ==> ~(s = {})`)) THEN REWRITE_TAC[CLOSURE_EQ_EMPTY; INTERS_UNION] THEN ASM_SIMP_TAC[GSYM(REWRITE_RULE[INJECTIVE_ON_ALT] IMAGE_INTERS); VECTOR_ARITH `r - x:real^N = r - y <=> x = y`] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_IN_IMAGE; IN_INTER] THEN MESON_TAC[VECTOR_ARITH `(r - x) + x:real^N = r`]]);; let DENSE_GDELTA_IMP_LARGE = prove (`!s:real^N->bool. gdelta s /\ (:real^N) SUBSET closure s ==> s =_c (:real)`, GEN_TAC THEN ASM_CASES_TAC `FINITE(s:real^N->bool)` THENL [ASM_SIMP_TAC[FINITE_IMP_CLOSED; CLOSURE_CLOSED] THEN ASM_MESON_TAC[EUCLIDEAN_SPACE_INFINITE; INFINITE; FINITE_SUBSET]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THEN TRANS_TAC CARD_LE_TRANS `(:real^N)` THENL [REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; CONJ_TAC THENL [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`] SILVERMAN_STEINHAUSLIKE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN TRANS_TAC CARD_LE_TRANS `IMAGE (\(x:real^N,y). x + y) (s *_c s)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[mul_c; CARD_LE_REFL; SET_RULE `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`]; TRANS_TAC CARD_LE_TRANS `((s:real^N->bool) *_c s)` THEN REWRITE_TAC[CARD_LE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_SQUARE_INFINITE THEN ASM_REWRITE_TAC[INFINITE]]]]);; let NOT_GDELTA_DENSE_COUNTABLE = prove (`!s. COUNTABLE s /\ closure s = (:real^N) ==> ~(gdelta s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DENSE_GDELTA_IMP_LARGE) THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE]);; (* ------------------------------------------------------------------------- *) (* Finding borel subsets where a function is injective (mainly looking *) (* ahead to measure theory but maybe of some independent interest). *) (* ------------------------------------------------------------------------- *) let GDELTA_CONTINUOUS_FUNCTION_MINIMA = prove (`!f:real^M->real^N s. f continuous_on s /\ compact s ==> gdelta {x | x IN s /\ !y. y IN s /\ f x = f y ==> x = y \/ ?k. 1 <= k /\ k <= dimindex(:M) /\ (!i. 1 <= i /\ i < k ==> x$i <= y$i) /\ x$k < y$k}`, let lemma = prove (`(?n. inv(&n + &1) <= x) <=> &0 < x`, TRANS_TAC EQ_TRANS `~(!n. ~(inv(&n + &1) <= x))` THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (rand o rand) FORALL_POS_MONO_1_EQ o rand o lhand o snd) THEN ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[REAL_NOT_LE; GSYM REAL_LE_TRANS_LT]) in REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ !y. y IN s /\ (f:real^M->real^N) x = f y ==> x = y \/ ?k. 1 <= k /\ k <= dimindex(:M) /\ (!i. 1 <= i /\ i < k ==> x$i <= y$i) /\ x$k < y$k} = s DIFF UNIONS {{x | ?t. t IN s /\ pastecart t x IN ({z | z IN s PCROSS s /\ (f(fstcart z) - f(sndcart z)) IN {vec 0}} INTER UNIONS {{z | z IN s PCROSS s /\ (sndcart z - fstcart z) IN ({a | a$k >= inv(&n + &1)} INTER INTERS {{a | a$i >= &0} | i IN 1..k-1})} | k IN 1..dimindex(:M)})} | n IN (:num)}` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_SING; IN_UNIV; INTERS_GSPEC] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; real_ge; VECTOR_SUB_EQ] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `(y:real^M) IN s` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_CASES_TAC `(f:real^M->real^N) x = f y` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[GSYM NOT_EXISTS_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; lemma] THEN REWRITE_TAC[TAUT `(p /\ q) /\ r /\ s <=> p /\ q /\ s /\ r`] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; REAL_SUB_LE; REAL_SUB_LT] THEN REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= k - 1 <=> 1 <= i /\ i < k`] THEN MATCH_MP_TAC(TAUT `(p ==> ~r) /\ (~p ==> q \/ r) /\ ~(q /\ r) ==> (p \/ q <=> ~r)`) THEN SIMP_TAC[REAL_LT_REFL] THEN CONJ_TAC THENL [REWRITE_TAC[OR_EXISTS_THM; CART_EQ; NOT_FORALL_THM; IN_NUMSEG] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[IMP_IMP; REAL_LE_REFL; ARITH_RULE `k <= N ==> (m < k /\ (1 <= m /\ m <= N) <=> 1 <= m /\ m < k)`] THEN DISCH_THEN(K ALL_TAC) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN ASM_CASES_TAC `m:num = n` THEN ASM_REWRITE_TAC[] THENL [REAL_ARITH_TAC; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(m:num = n) ==> m < n \/ n < m`)) THEN STRIP_TAC THENL [UNDISCH_TAC `(x:real^M)$m < (y:real^M)$m`; UNDISCH_TAC `(y:real^M)$n < (x:real^M)$n`] THEN REWRITE_TAC[REAL_NOT_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN MATCH_MP_TAC GDELTA_INTER THEN ASM_SIMP_TAC[CLOSED_IMP_GDELTA; COMPACT_IMP_CLOSED] THEN REWRITE_TAC[GDELTA_COMPLEMENT] THEN MATCH_MP_TAC FSIGMA_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `k:num` THEN MATCH_MP_TAC CLOSED_IMP_FSIGMA THEN MATCH_MP_TAC CLOSED_COMPACT_PROJECTION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_INTER THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CLOSED_UNIONS THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_SIMP_TAC[CLOSED_PCROSS; COMPACT_IMP_CLOSED] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_SUB; CLOSED_SING] THENL [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN MATCH_MP_TAC CLOSED_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE]]]);; let GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS = prove (`!f:real^M->real^N s. f continuous_on s /\ compact s ==> ?t. gdelta t /\ t SUBSET s /\ IMAGE f t = IMAGE f s /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] GDELTA_CONTINUOUS_FUNCTION_MINIMA) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `P s ==> gdelta s ==> ?t. gdelta t /\ P t`) THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ (!z. z IN s ==> ?a. {x | x IN t /\ f x = f z} = {a}) ==> t SUBSET s /\ IMAGE f t = IMAGE f s /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`) THEN REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN SUBGOAL_THEN `!n. n <= dimindex(:M) ==> ?x. x IN s /\ (!y. y IN s /\ f x = f y ==> (!i. 1 <= i /\ i <= n ==> x$i = y$i) \/ (?k. 1 <= k /\ k <= n /\ (!i. 1 <= i /\ i < k ==> x$i <= y$i) /\ x$k < y$k)) /\ (f:real^M->real^N) x = f z` (MP_TAC o SPEC `dimindex(:M)`) THENL [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `1 <= k /\ k <= 0 <=> F`] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `m:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE `SUC n <= m ==> n <= m /\ n < m`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^M. x$(SUC m)`; `{x | x IN s /\ (f:real^M->real^N) x IN {f z}} INTER INTERS {{x | x$i = (y:real^M)$i} | i IN 1..m}`] CONTINUOUS_ATTAINS_INF) THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; CONTINUOUS_ON_ID] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC COMPACT_INTER_CLOSED THEN CONJ_TAC THENL [MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_SIMP_TAC[CLOSED_IN_SING; FUN_IN_IMAGE; SUBSET_REFL]; MATCH_MP_TAC CLOSED_INTERS THEN SIMP_TAC[FORALL_IN_GSPEC; CLOSED_STANDARD_HYPERPLANE]]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^M` THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTER; INTERS_GSPEC; IN_SING]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER; INTERS_GSPEC; IN_SING] THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:real^M` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `w:real^M`)) THEN REPEAT(ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN FIRST_X_ASSUM(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL [REWRITE_TAC[LE; CONJ_ASSOC] THEN REWRITE_TAC[LEFT_OR_DISTRIB; RIGHT_OR_DISTRIB] THEN REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_OR_THM; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `1 <= k /\ k = SUC n <=> k = SUC n /\ 1 <= k`] THEN REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_AND_THM; FORALL_UNWIND_THM2; IMP_CONJ; UNWIND_THM2; ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[LT_SUC_LE; IMP_IMP] THEN ASM_SIMP_TAC[REAL_LE_REFL; DISJ_ASSOC] THEN DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `x = w \/ x < w <=> x <= w`] THEN ASM_MESON_TAC[]; DISCH_THEN(fun th -> DISJ2_TAC THEN MP_TAC th) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN ASM_SIMP_TAC[ARITH_RULE `j <= n ==> j <= SUC n`] THEN ASM_MESON_TAC[LE_TRANS; LT_IMP_LE]]]; REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !b. b IN s ==> b = a`] THEN ASM_SIMP_TAC[CART_EQ; IN_ELIM_THM] THEN X_GEN_TAC `b:real^M` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^M`)) THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^M`) THEN ASM_SIMP_TAC[CART_EQ] THEN REWRITE_TAC[GSYM CART_EQ] THEN ASM_CASES_TAC `b:real^M = a` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ s) /\ r`] THEN ONCE_REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`] THEN DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `i:num = j` THENL [ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(i:num = j) ==> i < j \/ j < i`)) THEN ASM_MESON_TAC[REAL_NOT_LT]]);; let BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN = prove (`!f:real^M->real^N u. COUNTABLE u /\ (!k. k IN u ==> compact k /\ f continuous_on k) ==> ?t. borel t /\ t SUBSET UNIONS u /\ IMAGE f t = IMAGE f (UNIONS u) /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:(real^M->bool)->bool = {}` THENL [EXISTS_TAC `{}:real^M->bool` THEN ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY; BOREL_EMPTY; SUBSET_REFL]; ALL_TAC] THEN MP_TAC(ISPEC `u:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN SUBGOAL_THEN `!n. ?t. gdelta t /\ t SUBSET (c(n:num)) /\ IMAGE (f:real^M->real^N) t = IMAGE f (c n) /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y` MP_TAC THENL [ASM_SIMP_TAC[GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS]; REWRITE_TAC[INJECTIVE_ON_ALT; SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `d:num->real^M->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN EXISTS_TAC `UNIONS {d n DIFF UNIONS(IMAGE (\m. {x | x IN d n /\ f(x) IN IMAGE (f:real^M->real^N) (d m)}) {m | m < n}) | n IN (:num)}` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC BOREL_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC BOREL_DIFF THEN ASM_SIMP_TAC[GDELTA_IMP_BOREL] THEN MATCH_MP_TAC BOREL_UNIONS THEN SIMP_TAC[FINITE_IMP_COUNTABLE; FINITE_IMAGE; FINITE_NUMSEG_LT] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN ASM_SIMP_TAC[GDELTA_IMP_BOREL] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_IMP_BOREL THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SIMPLE_IMAGE] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN ASM SET_TAC[]; TRANS_TAC EQ_TRANS `IMAGE (f:real^M->real^N) (UNIONS (IMAGE d (:num)))` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_UNIONS] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_UNIV] THEN GEN_REWRITE_TAC RAND_CONV [num_WOP] THEN REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC WLOG_LT THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[UNIONS_IMAGE] THEN ASM SET_TAC[]]);; let BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS = prove (`!f:real^M->real^N s. f continuous_on s /\ fsigma s ==> ?t. borel t /\ t SUBSET s /\ IMAGE f t = IMAGE f s /\ !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FSIGMA_UNIONS_COMPACT]) THEN REWRITE_TAC[UNION_OF] THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN MATCH_MP_TAC BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN THEN ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Several variants of paracompactness. *) (* ------------------------------------------------------------------------- *) let PARACOMPACT = prove (`!s c. (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c ==> ?c'. s SUBSET UNIONS c' /\ (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ (!x. x IN s ==> ?v. open v /\ x IN v /\ FINITE {u | u IN c' /\ ~(u INTER v = {})})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN s ==> ?t u. x IN u /\ open u /\ closure u SUBSET t /\ t IN c` MP_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_CONTAINS_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^N,e)` THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; CLOSURE_BALL]; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N->bool`; `e:real^N->real^N->bool`] THEN STRIP_TAC] THEN MP_TAC(ISPEC `IMAGE (e:real^N->real^N->bool) s` LINDELOF) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `k:real^N->bool = {}` THENL [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `k:real^N->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` SUBST_ALL_TAC) THEN STRIP_TAC THEN EXISTS_TAC `{ f(a n:real^N) DIFF UNIONS {closure(e(a m)):real^N->bool | m < n} | n IN (:num)}` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_DIFF THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; EXISTS_TAC `f((a:num->real^N) n):real^N->bool` THEN ASM SET_TAC[]]; REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?n. x IN (f((a:num->real^N) n):real^N->bool)` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a:num->real^N) n`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]; GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `e((a:num->real^N) n):real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{u | (?n. u = f n) /\ P u} = IMAGE f {n |n| P(f n) /\ n IN (:num)}`] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `u SUBSET t ==> (s DIFF t) INTER u = {}`) THEN REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC] THEN ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]);; let PARACOMPACT_CLOSED_IN = prove (`!u:real^N->bool s c. closed_in (subtopology euclidean u) s /\ (!t:real^N->bool. t IN c ==> open_in (subtopology euclidean u) t) /\ s SUBSET UNIONS c ==> ?c'. s SUBSET UNIONS c' /\ (!v. v IN c' ==> open_in (subtopology euclidean u) v /\ ?t. t IN c /\ v SUBSET t) /\ (!x. x IN u ==> ?v. open_in (subtopology euclidean u) v /\ x IN v /\ FINITE {n | n IN c' /\ ~(n INTER v = {})})`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uu:(real^N->bool)->(real^N->bool)` THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN MP_TAC(ISPECL [`u:real^N->bool`; `((:real^N) DIFF k) INSERT IMAGE (uu:(real^N->bool)->(real^N->bool)) c`] PARACOMPACT) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE; UNIONS_INSERT; FORALL_IN_INSERT; EXISTS_IN_IMAGE; EXISTS_IN_INSERT; GSYM closed] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{u INTER v:real^N->bool | v IN d /\ ~(v INTER k = {})}` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u INTER v:real^N->bool` THEN ASM_REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `{y | y IN {f x | P x} /\ Q y} = IMAGE f {x | P x /\ Q(f x)}`] THEN MATCH_MP_TAC FINITE_IMAGE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);; let PARACOMPACT_CLOSED = prove (`!s:real^N->bool c. closed s /\ (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c ==> ?c'. s SUBSET UNIONS c' /\ (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ (!x. ?v. open v /\ x IN v /\ FINITE {u | u IN c' /\ ~(u INTER v = {})})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`; `c:(real^N->bool)->bool`] PARACOMPACT_CLOSED_IN) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Partitions of unity subordinate to locally finite open coverings. *) (* ------------------------------------------------------------------------- *) let SUBORDINATE_PARTITION_OF_UNITY = prove (`!c s. s SUBSET UNIONS c /\ (!u. u IN c ==> open u) /\ (!x. x IN s ==> ?v. open v /\ x IN v /\ FINITE {u | u IN c /\ ~(u INTER v = {})}) ==> ?f:(real^N->bool)->real^N->real. (!u. u IN c ==> (lift o f u) continuous_on s /\ !x. x IN s ==> &0 <= f u x) /\ (!x u. u IN c /\ x IN s /\ ~(x IN u) ==> f u x = &0) /\ (!x. x IN s ==> sum c (\u. f u x) = &1) /\ (!x. x IN s ==> ?n. open n /\ x IN n /\ FINITE {u | u IN c /\ ~(!x. x IN n ==> f u x = &0)})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `?u:real^N->bool. u IN c /\ s SUBSET u` THENL [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN EXISTS_TAC `\v:real^N->bool x:real^N. if v = u then &1 else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; o_DEF; REAL_POS; REAL_OF_NUM_EQ; ARITH_EQ; MESON[] `(if p then q else T) <=> p ==> q`] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST; COND_ID; SUM_DELTA] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `ball(x:real^N,&1)` THEN REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{u:real^N->bool}` THEN REWRITE_TAC[FINITE_SING; SUBSET; IN_ELIM_THM; IN_SING] THEN X_GEN_TAC `v:real^N->bool` THEN ASM_CASES_TAC `v:real^N->bool = u` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EXISTS_TAC `\u:real^N->bool x:real^N. if x IN s then setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)) else &0` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN SIMP_TAC[SUM_POS_LE; SETDIST_POS_LE; REAL_LE_DIV] THEN SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[SUM_RMUL] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN ASM_CASES_TAC `(u:real^N->bool) IN c` THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[real_div; REAL_ENTIRE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(y:real^N) IN u` THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; REAL_MUL_LZERO] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!v x:real^N. v IN c /\ x IN s /\ x IN v ==> &0 < setdist({x},s DIFF v)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF v:real^N->bool`; `x:real^N`] SETDIST_EQ_0_CLOSED_IN) THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; GSYM OPEN_CLOSED] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNION] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN s ==> &0 < sum c (\v. setdist ({x},s DIFF v))` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[SETDIST_POS_LE] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN ASM_CASES_TAC `(x:real^N) IN u` THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[REAL_LT_IMP_NZ]]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_REFL; o_DEF] THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\x:real^N. lift(setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)))` THEN SIMP_TAC[] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[CONTINUOUS_ON_LIFT_SETDIST; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)) THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN MAP_EVERY EXISTS_TAC [`\x:real^N. lift(sum {v | v IN c /\ ~(v INTER n = {})} (\v. setdist({x},s DIFF v)))`; `s INTER n:real^N->bool`] THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC SETDIST_SING_IN_SET THEN ASM SET_TAC[]; ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN ASM_SIMP_TAC[CONTINUOUS_AT_LIFT_SETDIST; CONTINUOUS_AT_WITHIN]]);; hol-light/Multivariate/transcendentals.ml000066400000000000000000013123551303454263000211470ustar00rootroot00000000000000(* ========================================================================= *) (* Complex transcendentals and their real counterparts. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* ========================================================================= *) needs "Multivariate/measure.ml";; needs "Multivariate/canal.ml";; prioritize_complex();; (* ------------------------------------------------------------------------- *) (* The complex exponential function. *) (* ------------------------------------------------------------------------- *) let cexp = new_definition `cexp z = infsum (from 0) (\n. z pow n / Cx(&(FACT n)))`;; let CEXP_0 = prove (`cexp(Cx(&0)) = Cx(&1)`, REWRITE_TAC[cexp] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MP_TAC(ISPECL [`\i. Cx(&0) pow i / Cx(&(FACT i))`; `{0}`; `from 0`] SERIES_FINITE_SUPPORT) THEN SIMP_TAC[FROM_0; INTER_UNIV; FINITE_INSERT; FINITE_RULES] THEN ANTS_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[IN_SING; NOT_SUC] THEN REWRITE_TAC[complex_div; complex_pow; COMPLEX_MUL_LZERO; COMPLEX_VEC_0]; REWRITE_TAC[VSUM_SING; FACT; COMPLEX_DIV_1; complex_pow]]);; let CEXP_CONVERGES_UNIFORMLY_CAUCHY = prove (`!R e. &0 < e /\ &0 < R ==> ?N. !m n z. m >= N /\ norm(z) <= R ==> norm(vsum(m..n) (\i. z pow i / Cx(&(FACT i)))) < e`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`&1 / &2`; `\i. Cx(R) pow i / Cx(&(FACT i))`; `from 0`] SERIES_RATIO) THEN REWRITE_TAC[SERIES_CAUCHY; LEFT_FORALL_IMP_THM] THEN MP_TAC(SPEC `&2 * norm(Cx(R))` REAL_ARCH_SIMPLE) THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (c ==> d) ==> a ==> (b ==> c) ==> d`) THEN CONJ_TAC THENL [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN SIMP_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `(z * zn) * (is * ik) <= (&1 * inv(&2)) * zn * ik <=> &0 <= (&1 - (&2 * z) * is) * zn * ik`] THEN MATCH_MP_TAC REAL_LE_MUL THEN SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; REAL_SUB_LE; REAL_LE_INV_EQ; REAL_ABS_POS] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LT_0] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[FROM_0; INTER_UNIV] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[GSYM CX_DIV; GSYM CX_POW; VSUM_CX_NUMSEG; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN SUBGOAL_THEN `abs (sum (m..n) (\i. R pow i / &(FACT i))) = sum (m..n) (\i. R pow i / &(FACT i))` SUBST1_TAC THENL [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE;REAL_LT_DIV; REAL_OF_NUM_LT; FACT_LT; REAL_POW_LT]; ALL_TAC] THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN SIMP_TAC[REAL_ABS_NUM; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; FACT_LT] THEN ASM_SIMP_TAC[REAL_POW_LE2; NORM_POS_LE]]);; let CEXP_CONVERGES = prove (`!z. ((\n. z pow n / Cx(&(FACT n))) sums cexp(z)) (from 0)`, GEN_TAC THEN REWRITE_TAC[cexp; SUMS_INFSUM; summable; SERIES_CAUCHY] THEN REWRITE_TAC[FROM_0; INTER_UNIV] THEN MP_TAC(SPEC `norm(z:complex) + &1` CEXP_CONVERGES_UNIFORMLY_CAUCHY) THEN SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 < x + &1`; NORM_POS_LE] THEN MESON_TAC[REAL_ARITH `x <= x + &1`]);; let CEXP_CONVERGES_UNIQUE = prove (`!w z. ((\n. z pow n / Cx(&(FACT n))) sums w) (from 0) <=> w = cexp(z)`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CEXP_CONVERGES] THEN DISCH_THEN(MP_TAC o C CONJ (SPEC `z:complex` CEXP_CONVERGES)) THEN REWRITE_TAC[SERIES_UNIQUE]);; let CEXP_CONVERGES_UNIFORMLY = prove (`!R e. &0 < R /\ &0 < e ==> ?N. !n z. n >= N /\ norm(z) < R ==> norm(vsum(0..n) (\i. z pow i / Cx(&(FACT i))) - cexp(z)) <= e`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`R:real`; `e / &2`] CEXP_CONVERGES_UNIFORMLY_CAUCHY) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `z:complex`] THEN STRIP_TAC THEN MP_TAC(SPEC `z:complex` CEXP_CONVERGES) THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY; FROM_0; INTER_UNIV; dist] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `n + M + 1`)) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n + 1`; `n + M + 1`; `z:complex`]) THEN ASM_SIMP_TAC[ARITH_RULE `(n >= N ==> n + 1 >= N) /\ M <= n + M + 1`] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; VSUM_ADD_SPLIT; LE_0] THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `i:num`)) THEN NORM_ARITH_TAC);; let HAS_COMPLEX_DERIVATIVE_CEXP = prove (`!z. (cexp has_complex_derivative cexp(z)) (at z)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`ball(Cx(&0),norm(z:complex) + &1)`; `\n z. z pow n / Cx(&(FACT n))`; `\n z. if n = 0 then Cx(&0) else z pow (n-1) / Cx(&(FACT(n-1)))`; `cexp:complex->complex`; `(from 0)`] HAS_COMPLEX_DERIVATIVE_SERIES) THEN REWRITE_TAC[CONVEX_BALL; OPEN_BALL; IN_BALL; dist] THEN SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; IN_BALL; dist; COMPLEX_SUB_LZERO; COMPLEX_SUB_RZERO; NORM_NEG] THEN ANTS_TAC THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH; complex_div; COMPLEX_MUL_LZERO] THEN MP_TAC(SPECL [`&n + &1`; `&0`] CX_INJ) THEN REWRITE_TAC[NOT_SUC; SUC_SUB1; GSYM REAL_OF_NUM_SUC; FACT; CX_ADD; CX_MUL; GSYM REAL_OF_NUM_MUL; COMPLEX_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `~(&n + &1 = &0)`] THEN ABBREV_TAC `a = inv(Cx(&(FACT n)))` THEN CONV_TAC COMPLEX_FIELD; REPEAT STRIP_TAC THEN MP_TAC(SPECL [`norm(z:complex) + &1`; `e:real`] CEXP_CONVERGES_UNIFORMLY) THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN MAP_EVERY X_GEN_TAC [`n:num`; `w:complex`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n - 1`; `w:complex`]) THEN ASM_SIMP_TAC[ARITH_RULE `n >= m + 1 ==> n - 1 >= m`] THEN REWRITE_TAC[FROM_0; INTER_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN `0..n = 0 INSERT (IMAGE SUC (0..n-1))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_INSERT; IN_IMAGE; IN_NUMSEG] THEN INDUCT_TAC THEN REWRITE_TAC[LE_0; NOT_SUC; SUC_INJ; UNWIND_THM1] THEN UNDISCH_TAC `n >= N + 1` THEN ARITH_TAC; ALL_TAC] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[IN_IMAGE; NOT_SUC; COMPLEX_ADD_LID] THEN SIMP_TAC[VSUM_IMAGE; FINITE_NUMSEG; SUC_INJ] THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_NUMSEG; NOT_SUC; o_THM; SUC_SUB1]; MAP_EVERY EXISTS_TAC [`Cx(&0)`; `cexp(Cx(&0))`] THEN REWRITE_TAC[CEXP_CONVERGES; COMPLEX_NORM_0] THEN SIMP_TAC[REAL_ARITH `&0 <= z ==> &0 < z + &1`; NORM_POS_LE]; DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` MP_TAC) THEN REWRITE_TAC[CEXP_CONVERGES_UNIQUE] THEN STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`g:complex->complex`; `&1`] THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ANTS_TAC THENL [REAL_ARITH_TAC; SIMP_TAC[]]] THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:complex` THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN NORM_ARITH_TAC]);; let COMPLEX_DIFFERENTIABLE_AT_CEXP = prove (`!z. cexp complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CEXP]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CEXP = prove (`!s z. cexp complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CEXP]);; let CONTINUOUS_AT_CEXP = prove (`!z. cexp continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CEXP; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CEXP = prove (`!s z. cexp continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CEXP]);; let CONTINUOUS_ON_CEXP = prove (`!s. cexp continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CEXP]);; let HOLOMORPHIC_ON_CEXP = prove (`!s. cexp holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CEXP]);; (* ------------------------------------------------------------------------- *) (* Add it to the database. *) (* ------------------------------------------------------------------------- *) add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV HAS_COMPLEX_DERIVATIVE_CEXP)));; (* ------------------------------------------------------------------------- *) (* Hence the main results. *) (* ------------------------------------------------------------------------- *) let CEXP_ADD_MUL = prove (`!w z. cexp(w + z) * cexp(--z) = cexp(w)`, GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `(!x. P x) <=> (!x. x IN UNIV ==> P x)`] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE THEN EXISTS_TAC `Cx(&0)` THEN REWRITE_TAC[OPEN_UNIV; CONVEX_UNIV; IN_UNIV] THEN REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_NEG_0; CEXP_0; COMPLEX_MUL_RID] THEN GEN_TAC THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; let CEXP_NEG_RMUL = prove (`!z. cexp(z) * cexp(--z) = Cx(&1)`, MP_TAC(SPEC `Cx(&0)` CEXP_ADD_MUL) THEN MATCH_MP_TAC MONO_FORALL THEN SIMP_TAC[COMPLEX_ADD_LID; CEXP_0]);; let CEXP_NEG_LMUL = prove (`!z. cexp(--z) * cexp(z) = Cx(&1)`, ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[CEXP_NEG_RMUL]);; let CEXP_NEG = prove (`!z. cexp(--z) = inv(cexp z)`, MP_TAC CEXP_NEG_LMUL THEN MATCH_MP_TAC MONO_FORALL THEN CONV_TAC COMPLEX_FIELD);; let CEXP_ADD = prove (`!w z. cexp(w + z) = cexp(w) * cexp(z)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`w:complex`; `z:complex`] CEXP_ADD_MUL) THEN MP_TAC(SPEC `z:complex` CEXP_NEG_LMUL) THEN CONV_TAC COMPLEX_FIELD);; let CEXP_SUB = prove (`!w z. cexp(w - z) = cexp(w) / cexp(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[complex_sub; complex_div; CEXP_ADD; CEXP_NEG]);; let CEXP_NZ = prove (`!z. ~(cexp(z) = Cx(&0))`, MP_TAC CEXP_NEG_LMUL THEN MATCH_MP_TAC MONO_FORALL THEN CONV_TAC COMPLEX_FIELD);; let CEXP_N = prove (`!n x. cexp(Cx(&n) * x) = cexp(x) pow n`, INDUCT_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; CX_ADD] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; complex_pow; CEXP_0] THEN ASM_REWRITE_TAC[COMPLEX_ADD_RDISTRIB; CEXP_ADD; COMPLEX_MUL_LID] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; let CEXP_VSUM = prove (`!f s. FINITE s ==> cexp(vsum s f) = cproduct s (\x. cexp(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; CPRODUCT_CLAUSES; CEXP_ADD; COMPLEX_VEC_0; CEXP_0]);; let LIM_CEXP_MINUS_1 = prove (`((\z. (cexp(z) - Cx(&1)) / z) --> Cx(&1)) (at (Cx(&0)))`, MP_TAC(COMPLEX_DIFF_CONV `((\z. cexp(z) - Cx(&1)) has_complex_derivative f') (at(Cx(&0)))`) THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT; CEXP_0; COMPLEX_SUB_REFL] THEN REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_SUB_RZERO]);; (* ------------------------------------------------------------------------- *) (* Crude bounds on complex exponential function, usable to get tighter ones. *) (* ------------------------------------------------------------------------- *) let CEXP_BOUND_BLEMMA = prove (`!B. (!z. norm(z) <= &1 / &2 ==> norm(cexp z) <= B) ==> !z. norm(z) <= &1 / &2 ==> norm(cexp z) <= &1 + B / &2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`cexp`; `cexp`; `cball(Cx(&0),&1 / &2)`; `B:real`] COMPLEX_DIFFERENTIABLE_BOUND) THEN ASM_SIMP_TAC[CONVEX_CBALL; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG; HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CEXP] THEN DISCH_THEN(MP_TAC o SPECL [`z:complex`; `Cx(&0)`]) THEN REWRITE_TAC[COMPLEX_NORM_0; CEXP_0; COMPLEX_SUB_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(y) = &1 /\ d <= e ==> norm(x - y) <= d ==> norm(x) <= &1 + e`) THEN REWRITE_TAC[COMPLEX_NORM_CX; real_div; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LE_LMUL THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN POP_ASSUM MP_TAC THEN NORM_ARITH_TAC);; let CEXP_BOUND_HALF = prove (`!z. norm(z) <= &1 / &2 ==> norm(cexp z) <= &2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE cexp (cball(Cx(&0),&1 / &2))`; `Cx(&0)`] DISTANCE_ATTAINS_SUP) THEN SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; COMPACT_CBALL; CONTINUOUS_ON_CEXP; IMAGE_EQ_EMPTY; CBALL_EQ_EMPTY; FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `w:complex` o MATCH_MP CEXP_BOUND_BLEMMA) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let CEXP_BOUND_LEMMA = prove (`!z. norm(z) <= &1 / &2 ==> norm(cexp z) <= &1 + &2 * norm(z)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`cexp`; `cexp`; `cball(Cx(&0),&1 / &2)`; `&2`] COMPLEX_DIFFERENTIABLE_BOUND) THEN ASM_SIMP_TAC[CONVEX_CBALL; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG; HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CEXP; CEXP_BOUND_HALF] THEN DISCH_THEN(MP_TAC o SPECL [`z:complex`; `Cx(&0)`]) THEN REWRITE_TAC[COMPLEX_NORM_0; CEXP_0; COMPLEX_SUB_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(y) = &1 ==> norm(x - y) <= d ==> norm(x) <= &1 + d`) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]);; (* ------------------------------------------------------------------------- *) (* Complex trig functions. *) (* ------------------------------------------------------------------------- *) let ccos = new_definition `ccos z = (cexp(ii * z) + cexp(--ii * z)) / Cx(&2)`;; let csin = new_definition `csin z = (cexp(ii * z) - cexp(--ii * z)) / (Cx(&2) * ii)`;; let CSIN_0 = prove (`csin(Cx(&0)) = Cx(&0)`, REWRITE_TAC[csin; COMPLEX_MUL_RZERO; COMPLEX_SUB_REFL] THEN CONV_TAC COMPLEX_FIELD);; let CCOS_0 = prove (`ccos(Cx(&0)) = Cx(&1)`, REWRITE_TAC[ccos; COMPLEX_MUL_RZERO; CEXP_0] THEN CONV_TAC COMPLEX_FIELD);; let CSIN_CIRCLE = prove (`!z. csin(z) pow 2 + ccos(z) pow 2 = Cx(&1)`, GEN_TAC THEN REWRITE_TAC[csin; ccos] THEN MP_TAC(SPEC `ii * z` CEXP_NEG_LMUL) THEN REWRITE_TAC[COMPLEX_MUL_LNEG] THEN CONV_TAC COMPLEX_FIELD);; let CSIN_ADD = prove (`!w z. csin(w + z) = csin(w) * ccos(z) + ccos(w) * csin(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN CONV_TAC COMPLEX_FIELD);; let CCOS_ADD = prove (`!w z. ccos(w + z) = ccos(w) * ccos(z) - csin(w) * csin(z)`, REPEAT GEN_TAC THEN REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN CONV_TAC COMPLEX_FIELD);; let CSIN_NEG = prove (`!z. csin(--z) = --(csin(z))`, REWRITE_TAC[csin; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN CONV_TAC COMPLEX_FIELD);; let CCOS_NEG = prove (`!z. ccos(--z) = ccos(z)`, REWRITE_TAC[ccos; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN CONV_TAC COMPLEX_FIELD);; let CSIN_DOUBLE = prove (`!z. csin(Cx(&2) * z) = Cx(&2) * csin(z) * ccos(z)`, REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CSIN_ADD] THEN CONV_TAC COMPLEX_RING);; let CCOS_DOUBLE = prove (`!z. ccos(Cx(&2) * z) = (ccos(z) pow 2) - (csin(z) pow 2)`, REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN CONV_TAC COMPLEX_RING);; let CSIN_SUB = prove (`!w z. csin(w - z) = csin(w) * ccos(z) - ccos(w) * csin(z)`, REWRITE_TAC[complex_sub; COMPLEX_MUL_RNEG; CSIN_ADD; CSIN_NEG; CCOS_NEG]);; let CCOS_SUB = prove (`!w z. ccos(w - z) = ccos(w) * ccos(z) + csin(w) * csin(z)`, REWRITE_TAC[complex_sub; CCOS_ADD; CSIN_NEG; CCOS_NEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG]);; let COMPLEX_MUL_CSIN_CSIN = prove (`!w z. csin(w) * csin(z) = (ccos(w - z) - ccos(w + z)) / Cx(&2)`, REWRITE_TAC[CCOS_ADD; CCOS_SUB] THEN CONV_TAC COMPLEX_RING);; let COMPLEX_MUL_CSIN_CCOS = prove (`!w z. csin(w) * ccos(z) = (csin(w + z) + csin(w - z)) / Cx(&2)`, REWRITE_TAC[CSIN_ADD; CSIN_SUB] THEN CONV_TAC COMPLEX_RING);; let COMPLEX_MUL_CCOS_CSIN = prove (`!w z. ccos(w) * csin(z) = (csin(w + z) - csin(w - z)) / Cx(&2)`, REWRITE_TAC[CSIN_ADD; CSIN_SUB] THEN CONV_TAC COMPLEX_RING);; let COMPLEX_MUL_CCOS_CCOS = prove (`!w z. ccos(w) * ccos(z) = (ccos(w - z) + ccos(w + z)) / Cx(&2)`, REWRITE_TAC[CCOS_ADD; CCOS_SUB] THEN CONV_TAC COMPLEX_RING);; let COMPLEX_ADD_CSIN = prove (`!w z. csin(w) + csin(z) = Cx(&2) * csin((w + z) / Cx(&2)) * ccos((w - z) / Cx(&2))`, SIMP_TAC[COMPLEX_MUL_CSIN_CCOS; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN REPEAT GEN_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; let COMPLEX_SUB_CSIN = prove (`!w z. csin(w) - csin(z) = Cx(&2) * csin((w - z) / Cx(&2)) * ccos((w + z) / Cx(&2))`, SIMP_TAC[COMPLEX_MUL_CSIN_CCOS; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[complex_sub; GSYM CSIN_NEG] THEN BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; let COMPLEX_ADD_CCOS = prove (`!w z. ccos(w) + ccos(z) = Cx(&2) * ccos((w + z) / Cx(&2)) * ccos((w - z) / Cx(&2))`, SIMP_TAC[COMPLEX_MUL_CCOS_CCOS; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [COMPLEX_ADD_SYM] THEN BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; let COMPLEX_SUB_CCOS = prove (`!w z. ccos(w) - ccos(z) = Cx(&2) * csin((w + z) / Cx(&2)) * csin((z - w) / Cx(&2))`, SIMP_TAC[COMPLEX_MUL_CSIN_CSIN; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN REPEAT GEN_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; let CCOS_DOUBLE_CCOS = prove (`!z. ccos(Cx(&2) * z) = Cx(&2) * ccos z pow 2 - Cx(&1)`, GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN MP_TAC(SPEC `z:complex` CSIN_CIRCLE) THEN CONV_TAC COMPLEX_RING);; let CCOS_DOUBLE_CSIN = prove (`!z. ccos(Cx(&2) * z) = Cx(&1) - Cx(&2) * csin z pow 2`, GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN MP_TAC(SPEC `z:complex` CSIN_CIRCLE) THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* Euler and de Moivre formulas. *) (* ------------------------------------------------------------------------- *) let CEXP_EULER = prove (`!z. cexp(ii * z) = ccos(z) + ii * csin(z)`, REWRITE_TAC[ccos; csin] THEN CONV_TAC COMPLEX_FIELD);; let DEMOIVRE = prove (`!z n. (ccos z + ii * csin z) pow n = ccos(Cx(&n) * z) + ii * csin(Cx(&n) * z)`, REWRITE_TAC[GSYM CEXP_EULER; GSYM CEXP_N] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* Real exponential function. Same names as old Library/transc.ml. *) (* ------------------------------------------------------------------------- *) let exp = new_definition `exp(x) = Re(cexp(Cx x))`;; let CNJ_CEXP = prove (`!z. cnj(cexp z) = cexp(cnj z)`, GEN_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN MAP_EVERY EXISTS_TAC [`\n. cnj(z pow n / Cx(&(FACT n)))`; `from 0`] THEN CONJ_TAC THENL [REWRITE_TAC[SUMS_CNJ; CEXP_CONVERGES]; REWRITE_TAC[CNJ_DIV; CNJ_CX; CNJ_POW; CEXP_CONVERGES]]);; let REAL_EXP = prove (`!z. real z ==> real(cexp z)`, SIMP_TAC[REAL_CNJ; CNJ_CEXP]);; let CX_EXP = prove (`!x. Cx(exp x) = cexp(Cx x)`, REWRITE_TAC[exp] THEN MESON_TAC[REAL; REAL_CX; REAL_EXP]);; let REAL_EXP_ADD = prove (`!x y. exp(x + y) = exp(x) * exp(y)`, REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_ADD; CEXP_ADD]);; let REAL_EXP_0 = prove (`exp(&0) = &1`, REWRITE_TAC[GSYM CX_INJ; CX_EXP; CEXP_0]);; let REAL_EXP_ADD_MUL = prove (`!x y. exp(x + y) * exp(--x) = exp(y)`, ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_ADD; CX_NEG; CEXP_ADD_MUL]);; let REAL_EXP_NEG_MUL = prove (`!x. exp(x) * exp(--x) = &1`, REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_NEG; CEXP_NEG_RMUL]);; let REAL_EXP_NEG_MUL2 = prove (`!x. exp(--x) * exp(x) = &1`, REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_NEG; CEXP_NEG_LMUL]);; let REAL_EXP_NEG = prove (`!x. exp(--x) = inv(exp(x))`, REWRITE_TAC[GSYM CX_INJ; CX_INV; CX_EXP; CX_NEG; CEXP_NEG]);; let REAL_EXP_N = prove (`!n x. exp(&n * x) = exp(x) pow n`, REWRITE_TAC[GSYM CX_INJ; CX_EXP; CX_POW; CX_MUL; CEXP_N]);; let REAL_EXP_SUB = prove (`!x y. exp(x - y) = exp(x) / exp(y)`, REWRITE_TAC[GSYM CX_INJ; CX_SUB; CX_DIV; CX_EXP; CEXP_SUB]);; let REAL_EXP_NZ = prove (`!x. ~(exp(x) = &0)`, REWRITE_TAC[GSYM CX_INJ; CX_EXP; CEXP_NZ]);; let REAL_EXP_POS_LE = prove (`!x. &0 <= exp(x)`, GEN_TAC THEN SUBST1_TAC(REAL_ARITH `x = x / &2 + x / &2`) THEN REWRITE_TAC[REAL_EXP_ADD; REAL_LE_SQUARE]);; let REAL_EXP_POS_LT = prove (`!x. &0 < exp(x)`, REWRITE_TAC[REAL_LT_LE; REAL_EXP_NZ; REAL_EXP_POS_LE]);; let REAL_EXP_LE_X = prove (`!x. &1 + x <= exp(x)`, GEN_TAC THEN ASM_CASES_TAC `&1 + x < &0` THENL [MP_TAC(SPEC `x:real` REAL_EXP_POS_LT) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[exp; RE_DEF] THEN MATCH_MP_TAC(MATCH_MP (ONCE_REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] LIM_COMPONENT_LBOUND) (REWRITE_RULE[sums] (SPEC `Cx x` CEXP_CONVERGES))) THEN SIMP_TAC[DIMINDEX_2; ARITH; TRIVIAL_LIMIT_SEQUENTIALLY; VSUM_COMPONENT; EVENTUALLY_SEQUENTIALLY; FROM_0; INTER_UNIV] THEN REWRITE_TAC[GSYM CX_DIV; GSYM RE_DEF; RE_CX; GSYM CX_POW] THEN EXISTS_TAC `1` THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[real_pow; REAL_POW_1; REAL_DIV_1; REAL_LE_ADDR; REAL_ADD_ASSOC] THEN SUBGOAL_THEN `!n. &0 <= sum(2*1..2*n+1) (\k. x pow k / &(FACT k))` ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC[SUM_PAIR] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM ADD1; real_pow; FACT; GSYM REAL_OF_NUM_MUL] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; FACT_NZ; NOT_SUC; REAL_FIELD `~(k = &0) /\ ~(f = &0) ==> p / f + (x * p) / (k * f) = p / f * (&1 + x / k)`] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_ARITH `&0 <= a + b <=> --a <= b`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; LT_0; REAL_OF_NUM_LT] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_REAL_ARITH_TAC]; RULE_ASSUM_TAC(REWRITE_RULE[MULT_CLAUSES]) THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MP_TAC(SPEC `n - 1` EVEN_OR_ODD) THEN ASM_SIMP_TAC[EVEN_EXISTS; ODD_EXISTS; ARITH_RULE `1 <= n ==> (n - 1 = d <=> n = SUC d)`] THEN STRIP_TAC THENL [ASM_MESON_TAC[ADD1]; ALL_TAC] THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(2 * n) = 2 * n + 1`] THEN ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[ARITH_RULE `SUC(2 * m + 1) = 2 * (m + 1)`]] THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN ASM_SIMP_TAC[GSYM REAL_POW_POW; REAL_POW_LE; REAL_LE_POW_2]);; let REAL_EXP_LT_1 = prove (`!x. &0 < x ==> &1 < exp(x)`, MP_TAC REAL_EXP_LE_X THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let REAL_EXP_MONO_IMP = prove (`!x y. x < y ==> exp(x) < exp(y)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_SUB_LT] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_EXP_LT_1) THEN SIMP_TAC[REAL_EXP_SUB; REAL_LT_RDIV_EQ; REAL_EXP_POS_LT; REAL_MUL_LID]);; let REAL_EXP_MONO_LT = prove (`!x y. exp(x) < exp(y) <=> x < y`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `(x < y ==> f < g) /\ (x = y ==> f = g) /\ (y < x ==> g < f) ==> (f < g <=> x < y)`) THEN SIMP_TAC[REAL_EXP_MONO_IMP]);; let REAL_EXP_MONO_LE = prove (`!x y. exp(x) <= exp(y) <=> x <= y`, REWRITE_TAC[GSYM REAL_NOT_LT; REAL_EXP_MONO_LT]);; let REAL_EXP_INJ = prove (`!x y. (exp(x) = exp(y)) <=> (x = y)`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; REAL_EXP_MONO_LE]);; let REAL_EXP_EQ_1 = prove (`!x. exp(x) = &1 <=> x = &0`, ONCE_REWRITE_TAC[GSYM REAL_EXP_0] THEN REWRITE_TAC[REAL_EXP_INJ]);; let REAL_ABS_EXP = prove (`!x. abs(exp x) = exp x`, REWRITE_TAC[real_abs; REAL_EXP_POS_LE]);; let REAL_EXP_SUM = prove (`!f s. FINITE s ==> exp(sum s f) = product s (\x. exp(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; PRODUCT_CLAUSES; REAL_EXP_ADD; REAL_EXP_0]);; let REAL_EXP_BOUND_LEMMA = prove (`!x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `Cx x` CEXP_BOUND_LEMMA) THEN REWRITE_TAC[GSYM CX_EXP; COMPLEX_NORM_CX; RE_CX] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Real trig functions, their reality, derivatives of complex versions. *) (* ------------------------------------------------------------------------- *) let sin = new_definition `sin(x) = Re(csin(Cx x))`;; let cos = new_definition `cos(x) = Re(ccos(Cx x))`;; let CNJ_CSIN = prove (`!z. cnj(csin z) = csin(cnj z)`, REWRITE_TAC[csin; CNJ_DIV; CNJ_SUB; CNJ_MUL; CNJ_CX; CNJ_CEXP; CNJ_NEG; CNJ_II; COMPLEX_NEG_NEG] THEN CONV_TAC COMPLEX_FIELD);; let CNJ_CCOS = prove (`!z. cnj(ccos z) = ccos(cnj z)`, REWRITE_TAC[ccos; CNJ_DIV; CNJ_ADD; CNJ_MUL; CNJ_CX; CNJ_CEXP; CNJ_NEG; CNJ_II; COMPLEX_NEG_NEG; COMPLEX_ADD_AC]);; let REAL_SIN = prove (`!z. real z ==> real(csin z)`, SIMP_TAC[REAL_CNJ; CNJ_CSIN]);; let REAL_COS = prove (`!z. real z ==> real(ccos z)`, SIMP_TAC[REAL_CNJ; CNJ_CCOS]);; let CX_SIN = prove (`!x. Cx(sin x) = csin(Cx x)`, REWRITE_TAC[sin] THEN MESON_TAC[REAL; REAL_CX; REAL_SIN]);; let CX_COS = prove (`!x. Cx(cos x) = ccos(Cx x)`, REWRITE_TAC[cos] THEN MESON_TAC[REAL; REAL_CX; REAL_COS]);; let HAS_COMPLEX_DERIVATIVE_CSIN = prove (`!z. (csin has_complex_derivative ccos z) (at z)`, GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[csin; ccos] THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIFFERENTIABLE_AT_CSIN = prove (`!z. csin complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSIN]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CSIN = prove (`!s z. csin complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CSIN]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV HAS_COMPLEX_DERIVATIVE_CSIN)));; let HAS_COMPLEX_DERIVATIVE_CCOS = prove (`!z. (ccos has_complex_derivative --csin z) (at z)`, GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[csin; ccos] THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIFFERENTIABLE_AT_CCOS = prove (`!z. ccos complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CCOS]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CCOS = prove (`!s z. ccos complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CCOS]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV HAS_COMPLEX_DERIVATIVE_CCOS)));; let CONTINUOUS_AT_CSIN = prove (`!z. csin continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSIN; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CSIN = prove (`!s z. csin continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CSIN]);; let CONTINUOUS_ON_CSIN = prove (`!s. csin continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CSIN]);; let HOLOMORPHIC_ON_CSIN = prove (`!s. csin holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CSIN]);; let CONTINUOUS_AT_CCOS = prove (`!z. ccos continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CCOS; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CCOS = prove (`!s z. ccos continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CCOS]);; let CONTINUOUS_ON_CCOS = prove (`!s. ccos continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CCOS]);; let HOLOMORPHIC_ON_CCOS = prove (`!s. ccos holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CCOS]);; (* ------------------------------------------------------------------------- *) (* Slew of theorems for compatibility with old transc.ml file. *) (* ------------------------------------------------------------------------- *) let SIN_0 = prove (`sin(&0) = &0`, REWRITE_TAC[GSYM CX_INJ; CX_SIN; CSIN_0]);; let COS_0 = prove (`cos(&0) = &1`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CCOS_0]);; let SIN_CIRCLE = prove (`!x. (sin(x) pow 2) + (cos(x) pow 2) = &1`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_POW; CSIN_CIRCLE]);; let SIN_ADD = prove (`!x y. sin(x + y) = sin(x) * cos(y) + cos(x) * sin(y)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_MUL; CSIN_ADD]);; let COS_ADD = prove (`!x y. cos(x + y) = cos(x) * cos(y) - sin(x) * sin(y)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CCOS_ADD]);; let SIN_NEG = prove (`!x. sin(--x) = --(sin(x))`, REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_NEG; CSIN_NEG]);; let COS_NEG = prove (`!x. cos(--x) = cos(x)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_NEG; CCOS_NEG]);; let SIN_DOUBLE = prove (`!x. sin(&2 * x) = &2 * sin(x) * cos(x)`, REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_MUL; CSIN_DOUBLE]);; let COS_DOUBLE = prove (`!x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)`, SIMP_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_SUB; CX_MUL; CX_POW; CCOS_DOUBLE]);; let COS_DOUBLE_COS = prove (`!x. cos(&2 * x) = &2 * cos(x) pow 2 - &1`, MP_TAC SIN_CIRCLE THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[COS_DOUBLE] THEN REAL_ARITH_TAC);; let (SIN_BOUND,COS_BOUND) = (CONJ_PAIR o prove) (`(!x. abs(sin x) <= &1) /\ (!x. abs(cos x) <= &1)`, CONJ_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN MAP_EVERY (MP_TAC o C SPEC REAL_LE_SQUARE) [`sin x`; `cos x`] THEN REAL_ARITH_TAC);; let SIN_BOUNDS = prove (`!x. --(&1) <= sin(x) /\ sin(x) <= &1`, MP_TAC SIN_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let COS_BOUNDS = prove (`!x. --(&1) <= cos(x) /\ cos(x) <= &1`, MP_TAC COS_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let COS_ABS = prove (`!x. cos(abs x) = cos(x)`, REWRITE_TAC[real_abs] THEN MESON_TAC[COS_NEG]);; let SIN_SUB = prove (`!w z. sin(w - z) = sin(w) * cos(z) - cos(w) * sin(z)`, REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_SUB; CX_MUL; CSIN_SUB]);; let COS_SUB = prove (`!w z. cos(w - z) = cos(w) * cos(z) + sin(w) * sin(z)`, REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_SUB; CX_ADD; CX_MUL; CCOS_SUB]);; let REAL_MUL_SIN_SIN = prove (`!x y. sin(x) * sin(y) = (cos(x - y) - cos(x + y)) / &2`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_MUL_CSIN_CSIN]);; let REAL_MUL_SIN_COS = prove (`!x y. sin(x) * cos(y) = (sin(x + y) + sin(x - y)) / &2`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_MUL_CSIN_CCOS]);; let REAL_MUL_COS_SIN = prove (`!x y. cos(x) * sin(y) = (sin(x + y) - sin(x - y)) / &2`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_MUL_CCOS_CSIN]);; let REAL_MUL_COS_COS = prove (`!x y. cos(x) * cos(y) = (cos(x - y) + cos(x + y)) / &2`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_MUL_CCOS_CCOS]);; let REAL_ADD_SIN = prove (`!x y. sin(x) + sin(y) = &2 * sin((x + y) / &2) * cos((x - y) / &2)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_ADD_CSIN]);; let REAL_SUB_SIN = prove (`!x y. sin(x) - sin(y) = &2 * sin((x - y) / &2) * cos((x + y) / &2)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_SUB_CSIN]);; let REAL_ADD_COS = prove (`!x y. cos(x) + cos(y) = &2 * cos((x + y) / &2) * cos((x - y) / &2)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_ADD_CCOS]);; let REAL_SUB_COS = prove (`!x y. cos(x) - cos(y) = &2 * sin((x + y) / &2) * sin((y - x) / &2)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN REWRITE_TAC[COMPLEX_SUB_CCOS]);; let COS_DOUBLE_SIN = prove (`!x. cos(&2 * x) = &1 - &2 * sin x pow 2`, GEN_TAC THEN REWRITE_TAC[REAL_RING `&2 * x = x + x`; COS_ADD] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Get a nice real/imaginary separation in Euler's formula. *) (* ------------------------------------------------------------------------- *) let EULER = prove (`!z. cexp(z) = Cx(exp(Re z)) * (Cx(cos(Im z)) + ii * Cx(sin(Im z)))`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EXPAND] THEN REWRITE_TAC[CEXP_ADD; CEXP_EULER; GSYM CX_SIN; GSYM CX_COS; GSYM CX_EXP]);; let RE_CEXP = prove (`!z. Re(cexp z) = exp(Re z) * cos(Im z)`, REWRITE_TAC[EULER; RE_ADD; RE_MUL_CX; RE_MUL_II; IM_CX; RE_CX] THEN REAL_ARITH_TAC);; let IM_CEXP = prove (`!z. Im(cexp z) = exp(Re z) * sin(Im z)`, REWRITE_TAC[EULER; IM_ADD; IM_MUL_CX; IM_MUL_II; IM_CX; RE_CX] THEN REAL_ARITH_TAC);; let RE_CSIN = prove (`!z. Re(csin z) = (exp(Im z) + exp(--(Im z))) / &2 * sin(Re z)`, GEN_TAC THEN REWRITE_TAC[csin] THEN SIMP_TAC[COMPLEX_FIELD `x / (Cx(&2) * ii) = ii * --(x / Cx(&2))`] THEN REWRITE_TAC[IM_MUL_II; IM_DIV_CX; RE_NEG; IM_SUB; IM_CEXP; RE_MUL_II; COMPLEX_MUL_LNEG; IM_NEG] THEN REWRITE_TAC[REAL_NEG_NEG; SIN_NEG] THEN CONV_TAC REAL_RING);; let IM_CSIN = prove (`!z. Im(csin z) = (exp(Im z) - exp(--(Im z))) / &2 * cos(Re z)`, GEN_TAC THEN REWRITE_TAC[csin] THEN SIMP_TAC[COMPLEX_FIELD `x / (Cx(&2) * ii) = ii * --(x / Cx(&2))`] THEN REWRITE_TAC[IM_MUL_II; RE_DIV_CX; RE_NEG; RE_SUB; RE_CEXP; RE_MUL_II; COMPLEX_MUL_LNEG; IM_NEG] THEN REWRITE_TAC[REAL_NEG_NEG; COS_NEG] THEN CONV_TAC REAL_RING);; let RE_CCOS = prove (`!z. Re(ccos z) = (exp(Im z) + exp(--(Im z))) / &2 * cos(Re z)`, GEN_TAC THEN REWRITE_TAC[ccos] THEN REWRITE_TAC[RE_DIV_CX; RE_ADD; RE_CEXP; COMPLEX_MUL_LNEG; RE_MUL_II; IM_MUL_II; RE_NEG; IM_NEG; COS_NEG] THEN REWRITE_TAC[REAL_NEG_NEG] THEN CONV_TAC REAL_RING);; let IM_CCOS = prove (`!z. Im(ccos z) = (exp(--(Im z)) - exp(Im z)) / &2 * sin(Re z)`, GEN_TAC THEN REWRITE_TAC[ccos] THEN REWRITE_TAC[IM_DIV_CX; IM_ADD; IM_CEXP; COMPLEX_MUL_LNEG; RE_MUL_II; IM_MUL_II; RE_NEG; IM_NEG; SIN_NEG] THEN REWRITE_TAC[REAL_NEG_NEG] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Some special intermediate value theorems over the reals. *) (* ------------------------------------------------------------------------- *) let IVT_INCREASING_RE = prove (`!f a b y. a <= b /\ (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ Re(f(Cx a)) <= y /\ y <= Re(f(Cx b)) ==> ?x. a <= x /\ x <= b /\ Re(f(Cx x)) = y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(f:complex->complex) o Cx o drop`; `lift a`; `lift b`; `y:real`; `1`] IVT_INCREASING_COMPONENT_1) THEN REWRITE_TAC[EXISTS_DROP; GSYM drop; LIFT_DROP; o_THM; GSYM RE_DEF] THEN ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM CONJ_ASSOC; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN ASM_SIMP_TAC[o_THM] THEN REWRITE_TAC[continuous_at; o_THM] THEN REWRITE_TAC[dist; GSYM CX_SUB; GSYM DROP_SUB; COMPLEX_NORM_CX] THEN REWRITE_TAC[GSYM ABS_DROP] THEN MESON_TAC[]);; let IVT_DECREASING_RE = prove (`!f a b y. a <= b /\ (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ Re(f(Cx b)) <= y /\ y <= Re(f(Cx a)) ==> ?x. a <= x /\ x <= b /\ Re(f(Cx x)) = y`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN REWRITE_TAC[GSYM RE_NEG] THEN MATCH_MP_TAC IVT_INCREASING_RE THEN ASM_SIMP_TAC[CONTINUOUS_NEG; RE_NEG; REAL_LE_NEG2]);; let IVT_INCREASING_IM = prove (`!f a b y. a <= b /\ (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ Im(f(Cx a)) <= y /\ y <= Im(f(Cx b)) ==> ?x. a <= x /\ x <= b /\ Im(f(Cx x)) = y`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN REWRITE_TAC[SYM(CONJUNCT2(SPEC_ALL RE_MUL_II))] THEN MATCH_MP_TAC IVT_DECREASING_RE THEN ASM_SIMP_TAC[CONTINUOUS_COMPLEX_MUL; ETA_AX; CONTINUOUS_CONST] THEN ASM_REWRITE_TAC[RE_MUL_II; REAL_LE_NEG2]);; let IVT_DECREASING_IM = prove (`!f a b y. a <= b /\ (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ Im(f(Cx b)) <= y /\ y <= Im(f(Cx a)) ==> ?x. a <= x /\ x <= b /\ Im(f(Cx x)) = y`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN REWRITE_TAC[GSYM IM_NEG] THEN MATCH_MP_TAC IVT_INCREASING_IM THEN ASM_SIMP_TAC[CONTINUOUS_NEG; IM_NEG; REAL_LE_NEG2]);; (* ------------------------------------------------------------------------- *) (* Some minimal properties of real logs help to define complex logs. *) (* ------------------------------------------------------------------------- *) let log_def = new_definition `log y = @x. exp(x) = y`;; let EXP_LOG = prove (`!x. &0 < x ==> exp(log x) = x`, REPEAT STRIP_TAC THEN REWRITE_TAC[log_def] THEN CONV_TAC SELECT_CONV THEN SUBGOAL_THEN `?y. --inv(x) <= y /\ y <= x /\ Re(cexp(Cx y)) = x` MP_TAC THENL [ALL_TAC; MESON_TAC[CX_EXP; RE_CX]] THEN MATCH_MP_TAC IVT_INCREASING_RE THEN SIMP_TAC[GSYM CX_EXP; RE_CX; CONTINUOUS_AT_CEXP] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> --y <= x`) THEN ASM_SIMP_TAC[REAL_LT_INV_EQ]; ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_EXP_NEG; REAL_INV_INV; REAL_LT_INV_EQ]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&1 + x <= y ==> x <= y`) THEN ASM_SIMP_TAC[REAL_EXP_LE_X; REAL_LE_INV_EQ; REAL_LT_IMP_LE]);; let LOG_EXP = prove (`!x. log(exp x) = x`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN SIMP_TAC[EXP_LOG; REAL_EXP_POS_LT]);; let REAL_EXP_LOG = prove (`!x. (exp(log x) = x) <=> &0 < x`, MESON_TAC[EXP_LOG; REAL_EXP_POS_LT]);; let LOG_MUL = prove (`!x y. &0 < x /\ &0 < y ==> (log(x * y) = log(x) + log(y))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN ASM_SIMP_TAC[REAL_EXP_ADD; REAL_LT_MUL; EXP_LOG]);; let LOG_INJ = prove (`!x y. &0 < x /\ &0 < y ==> (log(x) = log(y) <=> x = y)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_INJ] THEN ASM_SIMP_TAC[EXP_LOG]);; let LOG_1 = prove (`log(&1) = &0`, ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN REWRITE_TAC[REAL_EXP_0; REAL_EXP_LOG; REAL_LT_01]);; let LOG_INV = prove (`!x. &0 < x ==> (log(inv x) = --(log x))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN ASM_SIMP_TAC[REAL_EXP_NEG; EXP_LOG; REAL_LT_INV_EQ]);; let LOG_DIV = prove (`!x y. &0 < x /\ &0 < y ==> log(x / y) = log(x) - log(y)`, SIMP_TAC[real_div; real_sub; LOG_MUL; LOG_INV; REAL_LT_INV_EQ]);; let LOG_MONO_LT = prove (`!x y. &0 < x /\ &0 < y ==> (log(x) < log(y) <=> x < y)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LT] THEN ASM_SIMP_TAC[EXP_LOG]);; let LOG_MONO_LT_IMP = prove (`!x y. &0 < x /\ x < y ==> log(x) < log(y)`, MESON_TAC[LOG_MONO_LT; REAL_LT_TRANS]);; let LOG_MONO_LT_REV = prove (`!x y. &0 < x /\ &0 < y /\ log x < log y ==> x < y`, MESON_TAC[LOG_MONO_LT]);; let LOG_MONO_LE = prove (`!x y. &0 < x /\ &0 < y ==> (log(x) <= log(y) <=> x <= y)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG]);; let LOG_MONO_LE_IMP = prove (`!x y. &0 < x /\ x <= y ==> log(x) <= log(y)`, MESON_TAC[LOG_MONO_LE; REAL_LT_IMP_LE; REAL_LTE_TRANS]);; let LOG_MONO_LE_REV = prove (`!x y. &0 < x /\ &0 < y /\ log x <= log y ==> x <= y`, MESON_TAC[LOG_MONO_LE]);; let LOG_POW = prove (`!n x. &0 < x ==> (log(x pow n) = &n * log(x))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_POW_LT]);; let LOG_LE_STRONG = prove (`!x. &0 < &1 + x ==> log(&1 + x) <= x`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; REAL_EXP_LE_X]);; let LOG_LE = prove (`!x. &0 <= x ==> log(&1 + x) <= x`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; REAL_EXP_LE_X]);; let LOG_LT_X = prove (`!x. &0 < x ==> log(x) < x`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LT] THEN ASM_SIMP_TAC[EXP_LOG] THEN MP_TAC(SPEC `x:real` REAL_EXP_LE_X) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let LOG_POS = prove (`!x. &1 <= x ==> &0 <= log(x)`, REWRITE_TAC[GSYM LOG_1] THEN SIMP_TAC[LOG_MONO_LE; ARITH_RULE `&1 <= x ==> &0 < x`; REAL_LT_01]);; let LOG_POS_LT = prove (`!x. &1 < x ==> &0 < log(x)`, REWRITE_TAC[GSYM LOG_1] THEN SIMP_TAC[LOG_MONO_LT; ARITH_RULE `&1 < x ==> &0 < x`; REAL_LT_01]);; let LOG_PRODUCT = prove (`!f:A->real s. FINITE s /\ (!x. x IN s ==> &0 < f x) ==> log(product s f) = sum s (\x. log(f x))`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; SUM_CLAUSES; LOG_1; FORALL_IN_INSERT; LOG_MUL; PRODUCT_POS_LT]);; (* ------------------------------------------------------------------------- *) (* Deduce periodicity just from derivative and zero values. *) (* ------------------------------------------------------------------------- *) let SIN_NEARZERO = prove (`?x. &0 < x /\ !y. &0 < y /\ y <= x ==> &0 < sin(y)`, MP_TAC(SPEC `&1 / &2` (CONJUNCT2 (REWRITE_RULE[has_complex_derivative; HAS_DERIVATIVE_AT_ALT] (ISPEC `Cx(&0)` HAS_COMPLEX_DERIVATIVE_CSIN)))) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CSIN_0; COMPLEX_SUB_RZERO; CCOS_0; COMPLEX_MUL_LZERO; COMPLEX_MUL_LID] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx y`) THEN ASM_REWRITE_TAC[GSYM CX_SIN; COMPLEX_NORM_CX; GSYM CX_SUB] THEN ASM_REAL_ARITH_TAC);; let SIN_NONTRIVIAL = prove (`?x. &0 < x /\ ~(sin x = &0)`, MESON_TAC[REAL_LE_REFL; REAL_LT_REFL; SIN_NEARZERO]);; let COS_NONTRIVIAL = prove (`?x. &0 < x /\ ~(cos x = &1)`, MP_TAC SIN_NONTRIVIAL THEN MATCH_MP_TAC MONO_EXISTS THEN MP_TAC SIN_CIRCLE THEN MATCH_MP_TAC MONO_FORALL THEN CONV_TAC REAL_FIELD);; let COS_DOUBLE_BOUND = prove (`!x. &0 <= cos x ==> &2 * (&1 - cos x) <= &1 - cos(&2 * x)`, REWRITE_TAC[COS_DOUBLE_COS] THEN REWRITE_TAC[REAL_ARITH `&2 * (&1 - a) <= &1 - (&2 * b - &1) <=> b <= &1 * a`] THEN SIMP_TAC[REAL_POW_2; REAL_LE_RMUL; COS_BOUNDS]);; let COS_GOESNEGATIVE_LEMMA = prove (`!x. cos(x) < &1 ==> ?n. cos(&2 pow n * x) < &0`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> p) ==> p`) THEN REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `!n. &2 pow n * (&1 - cos x) <= &1 - cos(&2 pow n * x)` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * (&1 - cos(&2 pow n * x))` THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL; REAL_POS; COS_DOUBLE_BOUND]; MP_TAC(ISPEC `&1 / (&1 - cos(x))` REAL_ARCH_POW2) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN REAL_ARITH_TAC]);; let COS_GOESNEGATIVE = prove (`?x. &0 < x /\ cos(x) < &0`, X_CHOOSE_TAC `x:real` COS_NONTRIVIAL THEN MP_TAC(SPEC `x:real` COS_GOESNEGATIVE_LEMMA) THEN ANTS_TAC THENL [MP_TAC(SPEC `x:real` COS_BOUNDS) THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[REAL_LT_MUL; REAL_POW_LT; REAL_ARITH `&0 < &2`]]);; let COS_HASZERO = prove (`?x. &0 < x /\ cos(x) = &0`, X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC COS_GOESNEGATIVE THEN SUBGOAL_THEN `?x. &0 <= x /\ x <= z /\ Re(ccos(Cx x)) = &0` MP_TAC THENL [MATCH_MP_TAC IVT_DECREASING_RE THEN ASM_SIMP_TAC[GSYM CX_COS; RE_CX; REAL_LT_IMP_LE; COS_0; REAL_POS] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; HAS_COMPLEX_DERIVATIVE_CCOS]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM CX_COS; RE_CX] THEN MESON_TAC[COS_0; REAL_LE_LT; REAL_ARITH `~(&1 = &0)`]]);; let SIN_HASZERO = prove (`?x. &0 < x /\ sin(x) = &0`, X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC COS_HASZERO THEN EXISTS_TAC `&2 * x` THEN ASM_SIMP_TAC[SIN_DOUBLE] THEN ASM_REAL_ARITH_TAC);; let SIN_HASZERO_MINIMAL = prove (`?p. &0 < p /\ sin p = &0 /\ !x. &0 < x /\ x < p ==> ~(sin x = &0)`, X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC SIN_NEARZERO THEN MP_TAC(ISPECL [`{z | z IN IMAGE Cx {x | x >= e} /\ csin z IN {Cx(&0)}}`; `Cx(&0)`] DISTANCE_ATTAINS_INF) THEN ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; IMP_CONJ] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_SING; real_ge; GSYM CX_COS; CX_INJ] THEN REWRITE_TAC[dist; GSYM CX_SUB; GSYM CX_SIN; CX_INJ; COMPLEX_NORM_CX] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[REAL_ARITH `abs(&0 - x) = abs x`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; X_GEN_TAC `x:real` THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real`))] THEN ASM_REAL_ARITH_TAC] THEN X_CHOOSE_TAC `a:real` SIN_HASZERO THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `Cx a` THEN ASM_REWRITE_TAC[IN_SING; IN_IMAGE; IN_ELIM_THM; GSYM CX_SIN] THEN ASM_MESON_TAC[REAL_ARITH `x >= w \/ x <= w`; REAL_LT_REFL]] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN REWRITE_TAC[CONTINUOUS_ON_CSIN; CLOSED_SING] THEN SUBGOAL_THEN `IMAGE Cx {x | x >= e} = {z | Im(z) = &0} INTER {z | Re(z) >= e}` (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_HALFSPACE_IM_EQ; CLOSED_HALFSPACE_RE_GE]) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[FORALL_COMPLEX; COMPLEX_EQ; RE; IM; RE_CX; IM_CX] THEN MESON_TAC[]);; let pi = new_definition `pi = @p. &0 < p /\ sin(p) = &0 /\ !x. &0 < x /\ x < p ==> ~(sin(x) = &0)`;; let PI_WORKS = prove (`&0 < pi /\ sin(pi) = &0 /\ !x. &0 < x /\ x < pi ==> ~(sin x = &0)`, REWRITE_TAC[pi] THEN CONV_TAC SELECT_CONV THEN REWRITE_TAC[SIN_HASZERO_MINIMAL]);; (* ------------------------------------------------------------------------- *) (* Now more relatively easy consequences. *) (* ------------------------------------------------------------------------- *) let PI_POS = prove (`&0 < pi`, REWRITE_TAC[PI_WORKS]);; let PI_POS_LE = prove (`&0 <= pi`, REWRITE_TAC[REAL_LE_LT; PI_POS]);; let PI_NZ = prove (`~(pi = &0)`, SIMP_TAC[PI_POS; REAL_LT_IMP_NZ]);; let REAL_ABS_PI = prove (`abs pi = pi`, REWRITE_TAC[real_abs; PI_POS_LE]);; let SIN_PI = prove (`sin(pi) = &0`, REWRITE_TAC[PI_WORKS]);; let SIN_POS_PI = prove (`!x. &0 < x /\ x < pi ==> &0 < sin(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC SIN_NEARZERO THEN MP_TAC(ISPECL [`csin`; `e:real`; `x:real`; `&0`] IVT_DECREASING_RE) THEN ASM_SIMP_TAC[NOT_IMP; CONTINUOUS_AT_CSIN; GSYM CX_SIN; RE_CX; SIN_0] THEN ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LET_ANTISYM; PI_WORKS; REAL_LET_TRANS; REAL_LTE_TRANS]);; let COS_PI2 = prove (`cos(pi / &2) = &0`, MP_TAC(SYM(SPEC `pi / &2` SIN_DOUBLE)) THEN REWRITE_TAC[REAL_HALF; SIN_PI; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH] THEN MATCH_MP_TAC(REAL_ARITH `&0 < y ==> y = &0 \/ z = &0 ==> z = &0`) THEN MATCH_MP_TAC SIN_POS_PI THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let COS_PI = prove (`cos(pi) = -- &1`, ONCE_REWRITE_TAC[REAL_ARITH `pi = &2 * pi / &2`] THEN REWRITE_TAC[COS_DOUBLE_COS; COS_PI2] THEN REAL_ARITH_TAC);; let SIN_PI2 = prove (`sin(pi / &2) = &1`, MP_TAC(SPEC `pi / &2` SIN_CIRCLE) THEN REWRITE_TAC[COS_PI2; REAL_POW_2; REAL_ADD_RID; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_RING `x * x = &1 <=> x = &1 \/ x = -- &1`] THEN MP_TAC(SPEC `pi / &2` SIN_POS_PI) THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let SIN_COS = prove (`!x. sin(x) = cos(pi / &2 - x)`, REWRITE_TAC[COS_SUB; COS_PI2; SIN_PI2] THEN REAL_ARITH_TAC);; let COS_SIN = prove (`!x. cos(x) = sin(pi / &2 - x)`, REWRITE_TAC[SIN_SUB; COS_PI2; SIN_PI2] THEN REAL_ARITH_TAC);; let SIN_PERIODIC_PI = prove (`!x. sin(x + pi) = --(sin(x))`, REWRITE_TAC[SIN_ADD; SIN_PI; COS_PI] THEN REAL_ARITH_TAC);; let COS_PERIODIC_PI = prove (`!x. cos(x + pi) = --(cos(x))`, REWRITE_TAC[COS_ADD; SIN_PI; COS_PI] THEN REAL_ARITH_TAC);; let SIN_PERIODIC = prove (`!x. sin(x + &2 * pi) = sin(x)`, REWRITE_TAC[REAL_MUL_2; REAL_ADD_ASSOC; SIN_PERIODIC_PI; REAL_NEG_NEG]);; let COS_PERIODIC = prove (`!x. cos(x + &2 * pi) = cos(x)`, REWRITE_TAC[REAL_MUL_2; REAL_ADD_ASSOC; COS_PERIODIC_PI; REAL_NEG_NEG]);; let SIN_NPI = prove (`!n. sin(&n * pi) = &0`, INDUCT_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_MUL_LID; REAL_ADD_RDISTRIB; REAL_NEG_0; SIN_PERIODIC_PI; REAL_MUL_LZERO; SIN_0]);; let COS_NPI = prove (`!n. cos(&n * pi) = --(&1) pow n`, INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LZERO; COS_0; COS_PERIODIC_PI; REAL_MUL_LID; REAL_MUL_LNEG; GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB]);; let COS_POS_PI2 = prove (`!x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN MP_TAC(ISPECL [`ccos`; `&0`; `x:real`; `&0`] IVT_DECREASING_RE) THEN ASM_SIMP_TAC[CONTINUOUS_AT_CCOS; REAL_LT_IMP_LE; GSYM CX_COS; RE_CX] THEN REWRITE_TAC[COS_0; REAL_POS] THEN DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN MP_TAC(SPEC `y:real` SIN_DOUBLE) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN MATCH_MP_TAC(last(CONJUNCTS PI_WORKS)) THEN REPEAT(POP_ASSUM MP_TAC) THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[COS_0] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let SIN_POS_PI2 = prove (`!x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REAL_ARITH_TAC);; let COS_POS_PI = prove (`!x. --(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)`, GEN_TAC THEN MP_TAC(SPEC `abs x` COS_POS_PI2) THEN REWRITE_TAC[COS_ABS] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[COS_0] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let COS_POS_PI_LE = prove (`!x. --(pi / &2) <= x /\ x <= pi / &2 ==> &0 <= cos(x)`, REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[COS_PI2; COS_NEG; COS_POS_PI]);; let SIN_POS_PI_LE = prove (`!x. &0 <= x /\ x <= pi ==> &0 <= sin(x)`, REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SIN_0; SIN_PI; SIN_POS_PI]);; let SIN_PIMUL_EQ_0 = prove (`!n. sin(n * pi) = &0 <=> integer(n)`, SUBGOAL_THEN `!n. integer n ==> sin(n * pi) = &0 /\ ~(cos(n * pi) = &0)` ASSUME_TAC THENL [REWRITE_TAC[INTEGER_CASES] THEN GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN ASM_SIMP_TAC[REAL_MUL_LNEG; COS_NPI; SIN_NPI; SIN_NEG; COS_NEG; REAL_POW_EQ_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN SUBST1_TAC(last(CONJUNCTS(SPEC `n:real` FLOOR_FRAC))) THEN ASM_SIMP_TAC[REAL_ADD_RDISTRIB; FLOOR; SIN_ADD; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[REAL_ADD_LID; REAL_ENTIRE; FLOOR] THEN DISCH_TAC THEN MP_TAC(SPEC `frac n * pi` SIN_POS_PI) THEN ASM_SIMP_TAC[REAL_LT_REFL; GSYM REAL_LT_RDIV_EQ; GSYM REAL_LT_LDIV_EQ; PI_POS; REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN MP_TAC(SPEC `n:real` FLOOR_FRAC) THEN ASM_CASES_TAC `frac n = &0` THEN ASM_REWRITE_TAC[FLOOR; REAL_ADD_RID] THEN ASM_REAL_ARITH_TAC);; let SIN_EQ_0 = prove (`!x. sin(x) = &0 <=> ?n. integer n /\ x = n * pi`, GEN_TAC THEN MP_TAC(SPEC `x / pi` SIN_PIMUL_EQ_0) THEN SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; GSYM REAL_EQ_LDIV_EQ; PI_POS] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1]);; let COS_EQ_0 = prove (`!x. cos(x) = &0 <=> ?n. integer n /\ x = (n + &1 / &2) * pi`, GEN_TAC THEN REWRITE_TAC[COS_SIN; SIN_EQ_0] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `--n:real` THEN ASM_REWRITE_TAC[INTEGER_NEG] THEN ASM_REAL_ARITH_TAC);; let SIN_ZERO_PI = prove (`!x. sin(x) = &0 <=> (?n. x = &n * pi) \/ (?n. x = --(&n * pi))`, REWRITE_TAC[SIN_EQ_0; INTEGER_CASES] THEN MESON_TAC[REAL_MUL_LNEG]);; let COS_ZERO_PI = prove (`!x. cos(x) = &0 <=> (?n. x = (&n + &1 / &2) * pi) \/ (?n. x = --((&n + &1 / &2) * pi))`, GEN_TAC THEN REWRITE_TAC[COS_EQ_0; INTEGER_CASES; RIGHT_OR_DISTRIB] THEN REWRITE_TAC[EXISTS_OR_THM; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN SIMP_TAC[UNWIND_THM2] THEN EQ_TAC THEN DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `n:num` SUBST1_TAC)) THENL [DISJ1_TAC THEN EXISTS_TAC `n:num`; ASM_CASES_TAC `n = 0` THENL [DISJ1_TAC THEN EXISTS_TAC `0`; DISJ2_TAC THEN EXISTS_TAC `n - 1`]; DISJ1_TAC THEN EXISTS_TAC `n:num`; DISJ2_TAC THEN EXISTS_TAC `n + 1`] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_ADD; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN REAL_ARITH_TAC);; let SIN_ZERO = prove (`!x. (sin(x) = &0) <=> (?n. EVEN n /\ x = &n * (pi / &2)) \/ (?n. EVEN n /\ x = --(&n * (pi / &2)))`, REWRITE_TAC[SIN_ZERO_PI; EVEN_EXISTS; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[GSYM REAL_OF_NUM_MUL; REAL_ARITH `(&2 * x) * y / &2 = x * y`]);; let COS_ZERO = prove (`!x. cos(x) = &0 <=> (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/ (?n. ~EVEN n /\ (x = --(&n * (pi / &2))))`, REWRITE_TAC[COS_ZERO_PI; NOT_EVEN; ODD_EXISTS; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_SUC; REAL_ARITH `(&2 * x + &1) * y / &2 = (x + &1 / &2) * y`]);; let COS_ONE_2PI = prove (`!x. (cos(x) = &1) <=> (?n. x = &n * &2 * pi) \/ (?n. x = --(&n * &2 * pi))`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `sin(x)` o MATCH_MP (REAL_RING `c = &1 ==> !s. s pow 2 + c pow 2 = &1 ==> s = &0`)) THEN REWRITE_TAC[SIN_ZERO_PI; SIN_CIRCLE] THEN DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC)) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[COS_NEG; COS_NPI; REAL_POW_NEG] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_POW_ONE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[EVEN_EXISTS]) THEN REWRITE_TAC[OR_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; FIRST_X_ASSUM (DISJ_CASES_THEN CHOOSE_TAC) THEN ASM_REWRITE_TAC[COS_NEG; REAL_MUL_ASSOC; REAL_OF_NUM_MUL; COS_NPI; REAL_POW_NEG; EVEN_MULT; ARITH; REAL_POW_ONE]]);; let SIN_COS_SQRT = prove (`!x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_UNIQUE THEN ASM_REWRITE_TAC[SIN_CIRCLE; REAL_EQ_SUB_LADD]);; let SIN_EQ_0_PI = prove (`!x. --pi < x /\ x < pi /\ sin(x) = &0 ==> x = &0`, GEN_TAC THEN REWRITE_TAC[SIN_EQ_0; CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC)) THEN ASM_REWRITE_TAC[REAL_ARITH `--p < n * p /\ n * p < p <=> -- &1 * p < n * p /\ n * p < &1 * p`] THEN SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ; REAL_LT_RMUL_EQ; PI_POS] THEN MP_TAC(SPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let COS_TREBLE_COS = prove (`!x. cos(&3 * x) = &4 * cos(x) pow 3 - &3 * cos x`, GEN_TAC THEN REWRITE_TAC[COS_ADD; REAL_ARITH `&3 * x = &2 * x + x`] THEN REWRITE_TAC[SIN_DOUBLE; COS_DOUBLE_COS] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; let COS_PI6 = prove (`cos(pi / &6) = sqrt(&3) / &2`, MP_TAC(ISPEC `pi / &6` COS_TREBLE_COS) THEN REWRITE_TAC[REAL_ARITH `&3 * x / &6 = x / &2`; COS_PI2] THEN REWRITE_TAC[REAL_RING `&0 = &4 * c pow 3 - &3 * c <=> c = &0 \/ (&2 * c) pow 2 = &3`] THEN SUBGOAL_THEN `&0 < cos(pi / &6)` ASSUME_TAC THENL [MATCH_MP_TAC COS_POS_PI THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `sqrt`) THEN ASM_SIMP_TAC[POW_2_SQRT; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_POS] THEN REAL_ARITH_TAC]);; let SIN_PI6 = prove (`sin(pi / &6) = &1 / &2`, MP_TAC(SPEC `pi / &6` SIN_CIRCLE) THEN REWRITE_TAC[COS_PI6] THEN SIMP_TAC[REAL_POW_DIV; SQRT_POW_2; REAL_POS] THEN MATCH_MP_TAC(REAL_FIELD `~(s + &1 / &2 = &0) ==> s pow 2 + &3 / &2 pow 2 = &1 ==> s = &1 / &2`) THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x + &1 / &2 = &0)`) THEN MATCH_MP_TAC SIN_POS_PI THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let SIN_POS_PI_REV = prove (`!x. &0 <= x /\ x <= &2 * pi /\ &0 < sin x ==> &0 < x /\ x < pi`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[SIN_0; REAL_LT_REFL] THEN ASM_CASES_TAC `x = pi` THEN ASM_REWRITE_TAC[SIN_PI; REAL_LT_REFL] THEN ASM_CASES_TAC `x = &2 * pi` THEN ASM_REWRITE_TAC[SIN_NPI; REAL_LT_REFL] THEN REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < sin(&2 * pi - x)` MP_TAC THENL [MATCH_MP_TAC SIN_POS_PI THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SIN_SUB; SIN_NPI; COS_NPI] THEN ASM_REAL_ARITH_TAC]);; let SIN_PI3 = prove (`sin(pi / &3) = sqrt(&3) / &2`, REWRITE_TAC[SIN_DOUBLE; COS_PI6; SIN_PI6; REAL_ARITH `x / &3 = &2 * x / &6`] THEN REAL_ARITH_TAC);; let COS_PI3 = prove (`cos(pi / &3) = &1 / &2`, REWRITE_TAC[COS_DOUBLE_COS; COS_PI6; REAL_ARITH `x / &3 = &2 * x / &6`] THEN SIMP_TAC[REAL_POW_DIV; SQRT_POW_2; REAL_POS; REAL_ARITH `&2 * s / &2 pow 2 - &1 = &1 / &2 <=> s = &3`]);; let CEXP_II_PI = prove (`cexp(ii * Cx pi) = --Cx(&1)`, REWRITE_TAC[EULER; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN REWRITE_TAC[REAL_NEG_0; SIN_PI; COS_PI; REAL_EXP_0] THEN REWRITE_TAC[CX_NEG] THEN SIMPLE_COMPLEX_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Prove totality of trigs. *) (* ------------------------------------------------------------------------- *) let SIN_TOTAL_POS = prove (`!y. &0 <= y /\ y <= &1 ==> ?x. &0 <= x /\ x <= pi / &2 /\ sin(x) = y`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`csin`; `&0`; `pi / &2`; `y:real`] IVT_INCREASING_RE) THEN ASM_REWRITE_TAC[GSYM CX_SIN; RE_CX; SIN_0; SIN_PI2] THEN SIMP_TAC[CONTINUOUS_AT_CSIN; PI_POS; REAL_ARITH `&0 < x ==> &0 <= x / &2`]);; let SINCOS_TOTAL_PI2 = prove (`!x y. &0 <= x /\ &0 <= y /\ x pow 2 + y pow 2 = &1 ==> ?t. &0 <= t /\ t <= pi / &2 /\ x = cos t /\ y = sin t`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `y:real` SIN_TOTAL_POS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `x pow 2 + y pow 2 = &1 ==> (&1 < y ==> &1 pow 2 < y pow 2) /\ &0 <= x * x ==> y <= &1`)) THEN SIMP_TAC[REAL_LE_SQUARE; REAL_POW_LT2; REAL_POS; ARITH]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `x = cos t \/ x = --(cos t)` MP_TAC THENL [MP_TAC(SPEC `t:real` SIN_CIRCLE); MP_TAC(SPEC `t:real` COS_POS_PI_LE)] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; let SINCOS_TOTAL_PI = prove (`!x y. &0 <= y /\ x pow 2 + y pow 2 = &1 ==> ?t. &0 <= t /\ t <= pi /\ x = cos t /\ y = sin t`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `&0 <= x \/ &0 <= --x`) THENL [MP_TAC(SPECL [`x:real`; `y:real`] SINCOS_TOTAL_PI2); MP_TAC(SPECL [`--x:real`; `y:real`] SINCOS_TOTAL_PI2)] THEN ASM_REWRITE_TAC[REAL_POW_NEG; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `t:real`; EXISTS_TAC `pi - t`] THEN ASM_REWRITE_TAC[SIN_SUB; COS_SUB; SIN_PI; COS_PI] THEN ASM_REAL_ARITH_TAC);; let SINCOS_TOTAL_2PI = prove (`!x y. x pow 2 + y pow 2 = &1 ==> ?t. &0 <= t /\ t < &2 * pi /\ x = cos t /\ y = sin t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &1 /\ y = &0` THENL [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[SIN_0; COS_0] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN DISJ_CASES_TAC(REAL_ARITH `&0 <= y \/ &0 <= --y`) THENL [MP_TAC(SPECL [`x:real`; `y:real`] SINCOS_TOTAL_PI); MP_TAC(SPECL [`x:real`; `--y:real`] SINCOS_TOTAL_PI)] THEN ASM_REWRITE_TAC[REAL_POW_NEG; ARITH] THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `t:real`; EXISTS_TAC `&2 * pi - t`] THEN ASM_REWRITE_TAC[SIN_SUB; COS_SUB; SIN_NPI; COS_NPI] THENL [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REPEAT(POP_ASSUM MP_TAC) THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[SIN_0; COS_0] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let CIRCLE_SINCOS = prove (`!x y. x pow 2 + y pow 2 = &1 ==> ?t. x = cos(t) /\ y = sin(t)`, MESON_TAC[SINCOS_TOTAL_2PI]);; (* ------------------------------------------------------------------------- *) (* Polar representation. *) (* ------------------------------------------------------------------------- *) let CX_PI_NZ = prove (`~(Cx pi = Cx(&0))`, SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; PI_POS]);; let COMPLEX_UNIMODULAR_POLAR = prove (`!z. (norm z = &1) ==> ?x. z = complex(cos(x),sin(x))`, GEN_TAC THEN DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow):real->num->real`) THEN REWRITE_TAC[complex_norm] THEN SIMP_TAC[REAL_POW_2; REWRITE_RULE[REAL_POW_2] SQRT_POW_2; REAL_LE_SQUARE; REAL_LE_ADD] THEN REWRITE_TAC[GSYM REAL_POW_2; REAL_MUL_LID] THEN DISCH_THEN(X_CHOOSE_TAC `t:real` o MATCH_MP CIRCLE_SINCOS) THEN EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM]);; let SIN_INTEGER_2PI = prove (`!n. integer n ==> sin((&2 * pi) * n) = &0`, REWRITE_TAC[SIN_EQ_0; REAL_ARITH `(&2 * pi) * n = (&2 * n) * pi`] THEN MESON_TAC[INTEGER_CLOSED]);; let SIN_INTEGER_PI = prove (`!n. integer n ==> sin (n * pi) = &0`, REWRITE_TAC[INTEGER_CASES] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LNEG; SIN_NPI; SIN_NEG; REAL_NEG_0]);; let COS_INTEGER_2PI = prove (`!n. integer n ==> cos((&2 * pi) * n) = &1`, REWRITE_TAC[INTEGER_CASES; REAL_ARITH `(&2 * pi) * n = (&2 * n) * pi`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_OF_NUM_MUL] THEN SIMP_TAC[COS_NEG; COS_NPI; REAL_POW_NEG; REAL_MUL_LNEG; ARITH; EVEN_MULT; REAL_POW_ONE]);; let SINCOS_PRINCIPAL_VALUE = prove (`!x. ?y. (--pi < y /\ y <= pi) /\ (sin(y) = sin(x) /\ cos(y) = cos(x))`, GEN_TAC THEN EXISTS_TAC `pi - (&2 * pi) * frac((pi - x) / (&2 * pi))` THEN CONJ_TAC THENL [SIMP_TAC[REAL_ARITH `--p < p - x <=> x < (&2 * p) * &1`; REAL_ARITH `p - x <= p <=> (&2 * p) * &0 <= x`; REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_LT_MUL; PI_POS; REAL_OF_NUM_LT; ARITH; FLOOR_FRAC]; REWRITE_TAC[FRAC_FLOOR; REAL_SUB_LDISTRIB] THEN SIMP_TAC[REAL_DIV_LMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH; REAL_LT_IMP_NZ; PI_POS; REAL_ARITH `a - (a - b - c):real = b + c`; SIN_ADD; COS_ADD] THEN SIMP_TAC[FLOOR_FRAC; SIN_INTEGER_2PI; COS_INTEGER_2PI] THEN CONV_TAC REAL_RING]);; let CEXP_COMPLEX = prove (`!r t. cexp(complex(r,t)) = Cx(exp r) * complex(cos t,sin t)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EXPAND] THEN REWRITE_TAC[RE; IM; CEXP_ADD; CEXP_EULER; CX_EXP] THEN REWRITE_TAC[COMPLEX_TRAD; CX_SIN; CX_COS]);; let NORM_COSSIN = prove (`!t. norm(complex(cos t,sin t)) = &1`, REWRITE_TAC[complex_norm; RE; IM] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[SIN_CIRCLE; SQRT_1]);; let NORM_CEXP = prove (`!z. norm(cexp z) = exp(Re z)`, REWRITE_TAC[FORALL_COMPLEX; CEXP_COMPLEX; COMPLEX_NORM_MUL] THEN REWRITE_TAC[NORM_COSSIN; RE; COMPLEX_NORM_CX] THEN MP_TAC REAL_EXP_POS_LT THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let NORM_CEXP_II = prove (`!t. norm (cexp (ii * Cx t)) = &1`, REWRITE_TAC [NORM_CEXP; RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0]);; let NORM_CEXP_IMAGINARY = prove (`!z. norm(cexp z) = &1 ==> Re(z) = &0`, REWRITE_TAC[NORM_CEXP; REAL_EXP_EQ_1]);; let CEXP_EQ_1 = prove (`!z. cexp z = Cx(&1) <=> Re(z) = &0 /\ ?n. integer n /\ Im(z) = &2 * n * pi`, REWRITE_TAC[FORALL_COMPLEX; CEXP_COMPLEX; RE; IM] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:complex->real`) THEN SIMP_TAC[COMPLEX_NORM_MUL; CX_EXP; NORM_CEXP; RE_CX; COMPLEX_NORM_CX] THEN REWRITE_TAC[NORM_COSSIN; REAL_ABS_NUM; REAL_ABS_EXP; REAL_MUL_RID] THEN REWRITE_TAC[REAL_EXP_EQ_1] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_EXP_0; COMPLEX_MUL_LID] THEN REWRITE_TAC[COMPLEX_EQ; RE; IM; RE_CX; IM_CX] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIN_EQ_0]) THEN DISCH_THEN(X_CHOOSE_THEN `m:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN EXISTS_TAC `m / &2` THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN ONCE_REWRITE_TAC[GSYM INTEGER_ABS] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [GSYM COS_ABS]) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [integer]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN SIMP_TAC[real_abs; PI_POS; REAL_LT_IMP_LE; COS_NPI] THEN REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[EVEN_EXISTS]) THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_ARITH `(&2 * x) / &2 = x`] THEN REWRITE_TAC[INTEGER_CLOSED]; DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC (X_CHOOSE_TAC `n:real`)) THEN ASM_SIMP_TAC[REAL_EXP_0; COMPLEX_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_ARITH `&2 * x * y = (&2 * y) * x`] THEN ASM_SIMP_TAC[SIN_INTEGER_2PI; COS_INTEGER_2PI] THEN SIMPLE_COMPLEX_ARITH_TAC]);; let CEXP_EQ = prove (`!w z. cexp w = cexp z <=> ?n. integer n /\ w = z + Cx(&2 * n * pi) * ii`, SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(z = Cx(&0)) ==> (w = z <=> w / z = Cx(&1))`] THEN REWRITE_TAC[GSYM CEXP_SUB; CEXP_EQ_1; RE_SUB; IM_SUB; REAL_SUB_0] THEN SIMP_TAC[COMPLEX_EQ; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN REWRITE_TAC[REAL_NEG_0; REAL_ADD_RID; REAL_EQ_SUB_RADD] THEN MESON_TAC[REAL_ADD_SYM]);; let COMPLEX_EQ_CEXP = prove (`!w z. abs(Im w - Im z) < &2 * pi /\ cexp w = cexp z ==> w = z`, SIMP_TAC[CEXP_NZ; GSYM CEXP_SUB; CEXP_EQ_1; COMPLEX_FIELD `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> (a = b <=> a / b = Cx(&1))`] THEN REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `abs(Im w - Im z) < &2 * pi` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM IM_SUB; REAL_ABS_MUL; REAL_ABS_PI; REAL_ABS_NUM] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_LT_RMUL_EQ; PI_POS] THEN MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> ~(&2 * x < &2)`) THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `~(w:complex = z)` THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX; REAL_MUL_LZERO; REAL_MUL_RZERO]);; let CEXP_INTEGER_2PI = prove (`!n. integer n ==> cexp(Cx(&2 * n * pi) * ii) = Cx(&1)`, REWRITE_TAC[CEXP_EQ_1; IM_MUL_II; RE_MUL_II; RE_CX; IM_CX] THEN REWRITE_TAC[REAL_NEG_0] THEN MESON_TAC[]);; let SIN_COS_EQ = prove (`!x y. sin y = sin x /\ cos y = cos x <=> ?n. integer n /\ y = x + &2 * n * pi`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`ii * Cx y`; `ii * Cx x`] CEXP_EQ) THEN REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS] THEN REWRITE_TAC[COMPLEX_RING `ii * y = ii * x + z * ii <=> y = x + z`] THEN REWRITE_TAC[GSYM CX_ADD; CX_INJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COMPLEX_EQ; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; REAL_NEG_0; REAL_ADD_LID; REAL_ADD_RID] THEN MESON_TAC[]);; let SIN_COS_INJ = prove (`!x y. sin x = sin y /\ cos x = cos y /\ abs(x - y) < &2 * pi ==> x = y`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM CX_INJ] THEN MATCH_MP_TAC(COMPLEX_RING `ii * x = ii * y ==> x = y`) THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN ASM_REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS] THEN ASM_REWRITE_TAC[IM_MUL_II; RE_CX]);; let CEXP_II_NE_1 = prove (`!x. &0 < x /\ x < &2 * pi ==> ~(cexp(ii * Cx x) = Cx(&1))`, GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[CEXP_EQ_1] THEN REWRITE_TAC[RE_MUL_II; IM_CX; IM_MUL_II; IM_CX; REAL_NEG_0; RE_CX] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN UNDISCH_TAC `&0 < &2 * n * pi` THEN ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL] THEN MP_TAC(ISPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `&2 * n * pi < &2 * pi ==> &0 < (&1 - n) * &2 * pi`)) THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN ASM_REAL_ARITH_TAC);; let CSIN_EQ_0 = prove (`!z. csin z = Cx(&0) <=> ?n. integer n /\ z = Cx(n * pi)`, GEN_TAC THEN REWRITE_TAC[csin; COMPLEX_MUL_LNEG; CEXP_NEG] THEN SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(z = Cx(&0)) ==> ((z - inv z) / (Cx(&2) * ii) = Cx(&0) <=> z pow 2 = Cx(&1))`] THEN REWRITE_TAC[GSYM CEXP_N; CEXP_EQ_1] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II] THEN REWRITE_TAC[COMPLEX_EQ; IM_CX; RE_CX; RIGHT_AND_EXISTS_THM] THEN EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC);; let CCOS_EQ_0 = prove (`!z. ccos z = Cx(&0) <=> ?n. integer n /\ z = Cx((n + &1 / &2) * pi)`, GEN_TAC THEN MP_TAC(SPEC `z - Cx(pi / &2)` CSIN_EQ_0) THEN REWRITE_TAC[CSIN_SUB; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2] THEN SIMP_TAC[COMPLEX_RING `s * Cx(&0) - c * Cx(&1) = Cx(&0) <=> c = Cx(&0)`] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; COMPLEX_EQ_SUB_RADD; CX_ADD] THEN REWRITE_TAC[REAL_ARITH `&1 / &2 * x = x / &2`]);; let CCOS_EQ_1 = prove (`!z. ccos z = Cx(&1) <=> ?n. integer n /\ z = Cx(&2 * n * pi)`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [COMPLEX_RING `z = Cx(&2) * z / Cx(&2)`] THEN REWRITE_TAC[CCOS_DOUBLE_CSIN; COMPLEX_RING `a - Cx(&2) * s pow 2 = a <=> s = Cx(&0)`] THEN REWRITE_TAC[CSIN_EQ_0; CX_MUL] THEN EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN CONV_TAC COMPLEX_RING);; let CSIN_EQ_1 = prove (`!z. csin z = Cx(&1) <=> ?n. integer n /\ z = Cx((&2 * n + &1 / &2) * pi)`, GEN_TAC THEN MP_TAC(SPEC `z - Cx(pi / &2)` CCOS_EQ_1) THEN REWRITE_TAC[CCOS_SUB; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2] THEN SIMP_TAC[COMPLEX_RING `s * Cx(&0) + c * Cx(&1) = Cx(&1) <=> c = Cx(&1)`] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; COMPLEX_EQ_SUB_RADD; CX_ADD] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_ARITH `&1 / &2 * x = x / &2`]);; let CSIN_EQ_MINUS1 = prove (`!z. csin z = --Cx(&1) <=> ?n. integer n /\ z = Cx((&2 * n + &3 / &2) * pi)`, GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `z:complex = --w <=> --z = w`] THEN REWRITE_TAC[GSYM CSIN_NEG; CSIN_EQ_1] THEN REWRITE_TAC[COMPLEX_RING `--z:complex = w <=> z = --w`] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[GSYM CX_NEG; CX_INJ] THEN EXISTS_TAC `--(n + &1)` THEN ASM_SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; let CCOS_EQ_MINUS1 = prove (`!z. ccos z = --Cx(&1) <=> ?n. integer n /\ z = Cx((&2 * n + &1) * pi)`, GEN_TAC THEN MP_TAC(SPEC `z - Cx(pi / &2)` CSIN_EQ_1) THEN REWRITE_TAC[CSIN_SUB; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2] THEN SIMP_TAC[COMPLEX_RING `s * Cx(&0) - c * Cx(&1) = Cx(&1) <=> c = --Cx(&1)`] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; COMPLEX_EQ_SUB_RADD; GSYM CX_ADD] THEN DISCH_TAC THEN EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[CX_INJ] THEN REAL_ARITH_TAC);; let COS_EQ_1 = prove (`!x. cos x = &1 <=> ?n. integer n /\ x = &2 * n * pi`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CCOS_EQ_1]);; let SIN_EQ_1 = prove (`!x. sin x = &1 <=> ?n. integer n /\ x = (&2 * n + &1 / &2) * pi`, REWRITE_TAC[GSYM CX_INJ; CX_SIN; CSIN_EQ_1]);; let SIN_EQ_MINUS1 = prove (`!x. sin x = --(&1) <=> ?n. integer n /\ x = (&2 * n + &3 / &2) * pi`, REWRITE_TAC[GSYM CX_INJ; CX_NEG; CX_SIN; CSIN_EQ_MINUS1]);; let COS_EQ_MINUS1 = prove (`!x. cos x = --(&1) <=> ?n. integer n /\ x = (&2 * n + &1) * pi`, REWRITE_TAC[GSYM CX_INJ; CX_NEG; CX_COS; CCOS_EQ_MINUS1]);; let DIST_CEXP_II_1 = prove (`!z. norm(cexp(ii * Cx t) - Cx(&1)) = &2 * abs(sin(t / &2))`, GEN_TAC THEN REWRITE_TAC[NORM_EQ_SQUARE] THEN CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[GSYM NORM_POW_2]] THEN REWRITE_TAC[CEXP_EULER; COMPLEX_SQNORM; GSYM CX_COS; GSYM CX_SIN] THEN REWRITE_TAC[IM_ADD; RE_ADD; IM_SUB; RE_SUB; IM_MUL_II; RE_MUL_II] THEN REWRITE_TAC[RE_CX; IM_CX; REAL_POW2_ABS; REAL_POW_MUL] THEN MP_TAC(ISPEC `t / &2` COS_DOUBLE_SIN) THEN REWRITE_TAC[REAL_ARITH `&2 * t / &2 = t`] THEN MP_TAC(SPEC `t:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; let CX_SINH = prove (`Cx((exp x - inv(exp x)) / &2) = --ii * csin(ii * Cx x)`, REWRITE_TAC[csin; COMPLEX_RING `--ii * ii * z = z /\ ii * ii * z = --z`] THEN REWRITE_TAC[CEXP_NEG; GSYM CX_EXP; GSYM CX_INV; CX_SUB; CX_DIV] THEN CONV_TAC COMPLEX_FIELD);; let CX_COSH = prove (`Cx((exp x + inv(exp x)) / &2) = ccos(ii * Cx x)`, REWRITE_TAC[ccos; COMPLEX_RING `--ii * ii * z = z /\ ii * ii * z = --z`] THEN REWRITE_TAC[CEXP_NEG; GSYM CX_EXP; GSYM CX_INV; CX_ADD; CX_DIV] THEN CONV_TAC COMPLEX_FIELD);; let NORM_CCOS_POW_2 = prove (`!z. norm(ccos z) pow 2 = cos(Re z) pow 2 + (exp(Im z) - inv(exp(Im z))) pow 2 / &4`, REWRITE_TAC[FORALL_COMPLEX; RE; IM] THEN REWRITE_TAC[COMPLEX_TRAD; CCOS_ADD; COMPLEX_SQNORM] THEN SIMP_TAC[RE_SUB; IM_SUB; GSYM CX_COS; GSYM CX_SIN; IM_MUL_CX; RE_MUL_CX] THEN REWRITE_TAC[ccos; csin; CEXP_NEG; COMPLEX_FIELD `--ii * ii * z = z /\ ii * ii * z = --z /\ z / (Cx(&2) * ii) = --(ii * z / Cx(&2))`] THEN REWRITE_TAC[RE_ADD; RE_SUB; IM_ADD; IM_SUB; RE_MUL_II; IM_MUL_II; RE_DIV_CX; IM_DIV_CX; RE_NEG; IM_NEG] THEN REWRITE_TAC[GSYM CX_EXP; GSYM CX_INV; IM_CX; RE_CX] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN MP_TAC(SPEC `y:real` REAL_EXP_NZ) THEN CONV_TAC REAL_FIELD);; let NORM_CSIN_POW_2 = prove (`!z. norm(csin z) pow 2 = (exp(&2 * Im z) + inv(exp(&2 * Im z)) - &2 * cos(&2 * Re z)) / &4`, REWRITE_TAC[FORALL_COMPLEX; RE; IM] THEN REWRITE_TAC[COMPLEX_TRAD; CSIN_ADD; COMPLEX_SQNORM] THEN SIMP_TAC[RE_ADD; IM_ADD; GSYM CX_SIN; GSYM CX_SIN; IM_MUL_CX; RE_MUL_CX; GSYM CX_COS] THEN REWRITE_TAC[ccos; csin; CEXP_NEG; COMPLEX_FIELD `--ii * ii * z = z /\ ii * ii * z = --z /\ z / (Cx(&2) * ii) = --(ii * z / Cx(&2))`] THEN REWRITE_TAC[RE_ADD; RE_SUB; IM_ADD; IM_SUB; RE_MUL_II; IM_MUL_II; RE_DIV_CX; IM_DIV_CX; RE_NEG; IM_NEG] THEN REWRITE_TAC[GSYM CX_EXP; GSYM CX_INV; IM_CX; RE_CX] THEN REWRITE_TAC[REAL_EXP_N; COS_DOUBLE] THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN MP_TAC(SPEC `y:real` REAL_EXP_NZ) THEN CONV_TAC REAL_FIELD);; let CSIN_EQ = prove (`!w z. csin w = csin z <=> ?n. integer n /\ (w = z + Cx(&2 * n * pi) \/ w = --z + Cx((&2 * n + &1) * pi))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_0] THEN REWRITE_TAC[COMPLEX_SUB_CSIN; COMPLEX_ENTIRE; CSIN_EQ_0; CCOS_EQ_0] THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; OR_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:real` THEN ASM_CASES_TAC `integer(n)` THEN ASM_REWRITE_TAC[COMPLEX_FIELD `a / Cx(&2) = b <=> a = Cx(&2) * b`] THEN REWRITE_TAC[GSYM CX_MUL; REAL_ARITH `&2 * (n + &1 / &2) * pi = (&2 * n + &1) * pi`] THEN CONV_TAC COMPLEX_RING);; let CCOS_EQ = prove (`!w z. ccos(w) = ccos(z) <=> ?n. integer n /\ (w = z + Cx(&2 * n * pi) \/ w = --z + Cx(&2 * n * pi))`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV SYM_CONV) THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_0] THEN REWRITE_TAC[COMPLEX_SUB_CCOS; COMPLEX_ENTIRE; CSIN_EQ_0] THEN REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; OR_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:real` THEN ASM_CASES_TAC `integer(n)` THEN ASM_REWRITE_TAC[CX_MUL] THEN CONV_TAC COMPLEX_RING);; let SIN_EQ = prove (`!x y. sin x = sin y <=> ?n. integer n /\ (x = y + &2 * n * pi \/ x = --y + (&2 * n + &1) * pi)`, REWRITE_TAC[GSYM CX_INJ; CX_SIN; CSIN_EQ] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG; CX_INJ]);; let COS_EQ = prove (`!x y. cos x = cos y <=> ?n. integer n /\ (x = y + &2 * n * pi \/ x = --y + &2 * n * pi)`, REWRITE_TAC[GSYM CX_INJ; CX_COS; CCOS_EQ] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG; CX_INJ]);; let NORM_CCOS_LE = prove (`!z. norm(ccos z) <= exp(norm z)`, GEN_TAC THEN REWRITE_TAC[ccos] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN MATCH_MP_TAC(NORM_ARITH `norm(a) + norm(b) <= d ==> norm(a + b) <= d`) THEN REWRITE_TAC[NORM_CEXP; COMPLEX_MUL_LNEG; RE_NEG; REAL_EXP_NEG] THEN REWRITE_TAC[COMPLEX_NORM_CX; RE_MUL_II; REAL_ABS_NUM] THEN MATCH_MP_TAC(REAL_ARITH `exp(&0) = &1 /\ (exp(&0) <= w \/ exp(&0) <= z) /\ (w <= u /\ z <= u) ==> w + z <= &2 * u`) THEN REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN REWRITE_TAC[REAL_EXP_0] THEN MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC);; let NORM_CCOS_PLUS1_LE = prove (`!z. norm(Cx(&1) + ccos z) <= &2 * exp(norm z)`, GEN_TAC THEN REWRITE_TAC[ccos] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_RING `Cx(&1) + (z + z') / Cx(&2) = (Cx(&2) + z + z') / Cx(&2)`] THEN REWRITE_TAC[REAL_ARITH `x / &2 <= &2 * y <=> x <= &4 * y`] THEN MATCH_MP_TAC(NORM_ARITH `norm(a) + norm(b) + norm(c) <= d ==> norm(a + b + c) <= d`) THEN REWRITE_TAC[NORM_CEXP; COMPLEX_MUL_LNEG; RE_NEG; REAL_EXP_NEG] THEN REWRITE_TAC[COMPLEX_NORM_CX; RE_MUL_II; REAL_ABS_NUM] THEN MATCH_MP_TAC(REAL_ARITH `exp(&0) = &1 /\ (exp(&0) <= w \/ exp(&0) <= z) /\ (w <= u /\ z <= u) ==> &2 + w + z <= &4 * u`) THEN REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN REWRITE_TAC[REAL_EXP_0] THEN MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Taylor series for complex exponential. *) (* ------------------------------------------------------------------------- *) let TAYLOR_CEXP = prove (`!n z. norm(cexp z - vsum(0..n) (\k. z pow k / Cx(&(FACT k)))) <= exp(abs(Re z)) * (norm z) pow (n + 1) / &(FACT n)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`\k:num. cexp`; `n:num`; `segment[Cx(&0),z]`; `exp(abs(Re z))`] COMPLEX_TAYLOR) THEN REWRITE_TAC[CONVEX_SEGMENT; NORM_CEXP; REAL_EXP_MONO_LE] THEN ANTS_TAC THENL [REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL [GEN_REWRITE_TAC(RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID]; ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0; VECTOR_MUL_RZERO] THEN REWRITE_TAC[VECTOR_ADD_LID; COMPLEX_CMUL; COMPLEX_NORM_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN REWRITE_TAC[RE_MUL_CX; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `z:complex`]) THEN SIMP_TAC[ENDS_IN_SEGMENT; COMPLEX_SUB_RZERO; CEXP_0; COMPLEX_MUL_LID]]);; (* ------------------------------------------------------------------------- *) (* Approximation to e. *) (* ------------------------------------------------------------------------- *) let E_APPROX_32 = prove (`abs(exp(&1) - &5837465777 / &2147483648) <= inv(&2 pow 32)`, MP_TAC(ISPECL [`14`; `Cx(&1)`] TAYLOR_CEXP) THEN SIMP_TAC[RE_CX; REAL_ABS_NUM; GSYM CX_EXP; GSYM CX_DIV; GSYM CX_SUB; COMPLEX_POW_ONE; COMPLEX_NORM_CX] THEN CONV_TAC(ONCE_DEPTH_CONV EXPAND_VSUM_CONV) THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; COMPLEX_NORM_CX] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Taylor series for complex sine and cosine. *) (* ------------------------------------------------------------------------- *) let TAYLOR_CSIN_RAW = prove (`!n z. norm(csin z - vsum(0..n) (\k. if ODD k then --ii * (ii * z) pow k / Cx(&(FACT k)) else Cx(&0))) <= exp(abs(Im z)) * (norm z) pow (n + 1) / &(FACT n)`, MP_TAC TAYLOR_CEXP THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[csin] THEN REWRITE_TAC[COMPLEX_FIELD `a / (Cx(&2) * ii) - b = (a - Cx(&2) * ii * b) / (Cx(&2) * ii)`] THEN FIRST_ASSUM(fun th -> MP_TAC(SPEC `ii * z` th) THEN MP_TAC(SPEC `--ii * z` th)) THEN REWRITE_TAC[COMPLEX_MUL_LNEG; RE_NEG; REAL_ABS_NEG; RE_MUL_II] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; NORM_NEG; COMPLEX_NORM_II; REAL_ABS_NUM; REAL_MUL_RID; REAL_MUL_LID; REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN MATCH_MP_TAC(NORM_ARITH `sp - sn = s2 ==> norm(en - sn) <= d ==> norm(ep - sp) <= d ==> norm(ep - en - s2) <= &2 * d`) THEN SIMP_TAC[GSYM VSUM_SUB; GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_POW_NEG; GSYM NOT_EVEN] THEN ASM_CASES_TAC `EVEN k` THEN ASM_REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[COMPLEX_RING `Cx(&2) * ii * --(ii * z) = Cx(&2) * z`] THEN SIMPLE_COMPLEX_ARITH_TAC);; let TAYLOR_CSIN = prove (`!n z. norm(csin z - vsum(0..n) (\k. --Cx(&1) pow k * z pow (2 * k + 1) / Cx(&(FACT(2 * k + 1))))) <= exp(abs(Im z)) * norm(z) pow (2 * n + 3) / &(FACT(2 * n + 2))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`SUC(2 * n + 1)`; `z:complex`] TAYLOR_CSIN_RAW) THEN SIMP_TAC[VSUM_CLAUSES_NUMSEG; VSUM_PAIR_0; ODD_ADD; ODD_MULT; ARITH_ODD; LE_0; ODD; COMPLEX_ADD_LID; COMPLEX_ADD_RID] THEN SIMP_TAC[ARITH_RULE `SUC(2 * n + 1) = 2 * n + 2`; GSYM ADD_ASSOC; ARITH] THEN MATCH_MP_TAC(NORM_ARITH `s = t ==> norm(x - s) <= e ==> norm(x - t) <= e`) THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_POW_MUL; complex_div; COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_POW_ADD; GSYM COMPLEX_POW_POW] THEN REWRITE_TAC[COMPLEX_POW_II_2] THEN CONV_TAC COMPLEX_RING);; let CSIN_CONVERGES = prove (`!z. ((\n. --Cx(&1) pow n * z pow (2 * n + 1) / Cx(&(FACT(2 * n + 1)))) sums csin(z)) (from 0)`, GEN_TAC THEN REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. exp(abs(Im z)) * norm z pow (2 * n + 3) / &(FACT(2 * n + 2))` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[TAYLOR_CSIN] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN REWRITE_TAC[ARITH_RULE `2 * n + 3 = SUC(2 * n + 2)`; real_div] THEN REWRITE_TAC[LIFT_CMUL; real_pow] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN MP_TAC(MATCH_MP SERIES_TERMS_TOZERO (SPEC `z:complex` CEXP_CONVERGES)) THEN GEN_REWRITE_TAC LAND_CONV [LIM_NULL_NORM] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_NUM; GSYM LIFT_CMUL; GSYM real_div] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; let TAYLOR_CCOS_RAW = prove (`!n z. norm(ccos z - vsum(0..n) (\k. if EVEN k then (ii * z) pow k / Cx(&(FACT k)) else Cx(&0))) <= exp(abs(Im z)) * (norm z) pow (n + 1) / &(FACT n)`, MP_TAC TAYLOR_CEXP THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[ccos] THEN REWRITE_TAC[COMPLEX_FIELD `a / Cx(&2) - b = (a - Cx(&2) * b) / Cx(&2)`] THEN FIRST_ASSUM(fun th -> MP_TAC(SPEC `ii * z` th) THEN MP_TAC(SPEC `--ii * z` th)) THEN REWRITE_TAC[COMPLEX_MUL_LNEG; RE_NEG; REAL_ABS_NEG; RE_MUL_II] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; NORM_NEG; COMPLEX_NORM_II; REAL_ABS_NUM; REAL_MUL_RID; REAL_MUL_LID; REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN MATCH_MP_TAC(NORM_ARITH `sp + sn = s2 ==> norm(en - sn) <= d ==> norm(ep - sp) <= d ==> norm((ep + en) - s2) <= &2 * d`) THEN SIMP_TAC[GSYM VSUM_ADD; GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_POW_NEG; GSYM NOT_EVEN] THEN ASM_CASES_TAC `EVEN k` THEN ASM_REWRITE_TAC[COMPLEX_ADD_RINV; COMPLEX_MUL_RZERO] THEN SIMPLE_COMPLEX_ARITH_TAC);; let TAYLOR_CCOS = prove (`!n z. norm(ccos z - vsum(0..n) (\k. --Cx(&1) pow k * z pow (2 * k) / Cx(&(FACT(2 * k))))) <= exp(abs(Im z)) * norm(z) pow (2 * n + 2) / &(FACT(2 * n + 1))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`2 * n + 1`; `z:complex`] TAYLOR_CCOS_RAW) THEN SIMP_TAC[VSUM_PAIR_0; EVEN_ADD; EVEN_MULT; ARITH_EVEN; LE_0; EVEN; COMPLEX_ADD_LID; COMPLEX_ADD_RID] THEN SIMP_TAC[ARITH_RULE `(2 * n + 1) + 1 = 2 * n + 2`] THEN MATCH_MP_TAC(NORM_ARITH `s = t ==> norm(x - s) <= e ==> norm(x - t) <= e`) THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_POW_MUL; complex_div; COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_POW_POW; COMPLEX_POW_II_2]);; let CCOS_CONVERGES = prove (`!z. ((\n. --Cx(&1) pow n * z pow (2 * n) / Cx(&(FACT(2 * n)))) sums ccos(z)) (from 0)`, GEN_TAC THEN REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. exp(abs(Im z)) * norm z pow (2 * n + 2) / &(FACT(2 * n + 1))` THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[TAYLOR_CCOS] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN REWRITE_TAC[ARITH_RULE `2 * n + 2 = SUC(2 * n + 1)`; real_div] THEN REWRITE_TAC[LIFT_CMUL; real_pow] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN MP_TAC(MATCH_MP SERIES_TERMS_TOZERO (SPEC `z:complex` CEXP_CONVERGES)) THEN GEN_REWRITE_TAC LAND_CONV [LIM_NULL_NORM] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_NUM; GSYM LIFT_CMUL; GSYM real_div] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* The argument of a complex number, where 0 <= arg(z) < 2 pi *) (* ------------------------------------------------------------------------- *) let Arg_DEF = new_definition `Arg z = if z = Cx(&0) then &0 else @t. &0 <= t /\ t < &2 * pi /\ z = Cx(norm(z)) * cexp(ii * Cx t)`;; let ARG_0 = prove (`Arg(Cx(&0)) = &0`, REWRITE_TAC[Arg_DEF]);; let ARG = prove (`!z. &0 <= Arg(z) /\ Arg(z) < &2 * pi /\ z = Cx(norm z) * cexp(ii * Cx(Arg z))`, GEN_TAC THEN REWRITE_TAC[Arg_DEF] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_MUL_LZERO] THEN SIMP_TAC[REAL_LE_REFL; REAL_LT_MUL; PI_POS; REAL_ARITH `&0 < &2`] THEN CONV_TAC SELECT_CONV THEN MP_TAC(SPECL [`Re(z) / norm z`; `Im(z) / norm z`] SINCOS_TOTAL_2PI) THEN ASM_SIMP_TAC[COMPLEX_SQNORM; COMPLEX_NORM_ZERO; REAL_FIELD `~(z = &0) /\ x pow 2 + y pow 2 = z pow 2 ==> (x / z) pow 2 + (y / z) pow 2 = &1`] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD `~(z = &0) ==> (x / z = y <=> x = z * y)`] THEN REWRITE_TAC[COMPLEX_EQ; RE_MUL_CX; IM_MUL_CX; CEXP_EULER; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; GSYM CX_SIN; GSYM CX_COS; RE_CX; IM_CX] THEN REAL_ARITH_TAC);; let COMPLEX_NORM_EQ_1_CEXP = prove (`!z. norm z = &1 <=> (?t. z = cexp(ii * Cx t))`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [NORM_CEXP; RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0] THEN MP_TAC (SPEC `z:complex` ARG) THEN ASM_REWRITE_TAC [COMPLEX_MUL_LID] THEN MESON_TAC[]);; let ARG_UNIQUE = prove (`!a r z. &0 < r /\ Cx r * cexp(ii * Cx a) = z /\ &0 <= a /\ a < &2 * pi ==> Arg z = a`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM CX_INJ] THEN MATCH_MP_TAC(COMPLEX_RING `ii * x = ii * y ==> x = y`) THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL [REWRITE_TAC[IM_MUL_II; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < p /\ &0 <= y /\ y < p ==> abs(x - y) < p`) THEN ASM_SIMP_TAC[ARG]; MATCH_MP_TAC(COMPLEX_RING `!a b. Cx a = Cx b /\ ~(Cx b = Cx(&0)) /\ Cx a * w = Cx b * z ==> w = z`) THEN MAP_EVERY EXISTS_TAC [`norm(z:complex)`; `r:real`] THEN ASM_REWRITE_TAC[GSYM ARG] THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ] THEN EXPAND_TAC "z" THEN REWRITE_TAC[NORM_CEXP_II; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC]);; let ARG_MUL_CX = prove (`!r z. &0 < r ==> Arg(Cx r * z) = Arg(z)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO] THEN MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `r * norm(z:complex)` THEN ASM_REWRITE_TAC[CX_MUL; GSYM COMPLEX_MUL_ASSOC; GSYM ARG] THEN ASM_SIMP_TAC[REAL_LT_MUL; COMPLEX_NORM_NZ]);; let ARG_DIV_CX = prove (`!r z. &0 < r ==> Arg(z / Cx r) = Arg(z)`, REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN SIMP_TAC[GSYM CX_INV; ARG_MUL_CX; REAL_LT_INV_EQ]);; let ARG_LT_NZ = prove (`!z. &0 < Arg z <=> ~(Arg z = &0)`, MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let ARG_LE_PI = prove (`!z. Arg z <= pi <=> &0 <= Im z`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_REWRITE_TAC[Arg_DEF; IM_CX; REAL_LE_REFL; PI_POS_LE]; ALL_TAC] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [ARG] THEN ASM_SIMP_TAC[IM_MUL_CX; CEXP_EULER; REAL_LE_MUL_EQ; COMPLEX_NORM_NZ] THEN REWRITE_TAC[IM_ADD; GSYM CX_SIN; GSYM CX_COS; IM_CX; IM_MUL_II; RE_CX] THEN REWRITE_TAC[REAL_ADD_LID] THEN EQ_TAC THEN SIMP_TAC[ARG; SIN_POS_PI_LE] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 < sin(&2 * pi - Arg z)` MP_TAC THENL [MATCH_MP_TAC SIN_POS_PI THEN MP_TAC(SPEC `z:complex` ARG) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SIN_SUB; SIN_NPI; COS_NPI] THEN REAL_ARITH_TAC]);; let ARG_LT_PI = prove (`!z. &0 < Arg z /\ Arg z < pi <=> &0 < Im z`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_REWRITE_TAC[Arg_DEF; IM_CX; REAL_LT_REFL; PI_POS_LE]; ALL_TAC] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [ARG] THEN ASM_SIMP_TAC[IM_MUL_CX; CEXP_EULER; REAL_LT_MUL_EQ; COMPLEX_NORM_NZ] THEN REWRITE_TAC[IM_ADD; GSYM CX_SIN; GSYM CX_COS; IM_CX; IM_MUL_II; RE_CX] THEN REWRITE_TAC[REAL_ADD_LID] THEN EQ_TAC THEN SIMP_TAC[SIN_POS_PI] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_CASES_TAC `Arg z = &0` THEN ASM_REWRITE_TAC[SIN_0; REAL_LT_REFL] THEN ASM_SIMP_TAC[ARG; REAL_ARITH `~(x = &0) ==> (&0 < x <=> &0 <= x)`] THEN DISCH_TAC THEN SUBGOAL_THEN `&0 <= sin(&2 * pi - Arg z)` MP_TAC THENL [MATCH_MP_TAC SIN_POS_PI_LE THEN MP_TAC(SPEC `z:complex` ARG) THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[SIN_SUB; SIN_NPI; COS_NPI] THEN REAL_ARITH_TAC]);; let ARG_EQ_0 = prove (`!z. Arg z = &0 <=> real z /\ &0 <= Re z`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_REWRITE_TAC[REAL_CX; RE_CX; Arg_DEF; REAL_LE_REFL]; ALL_TAC] THEN CONV_TAC(RAND_CONV(SUBS_CONV[last(CONJUNCTS(SPEC `z:complex` ARG))])) THEN ASM_SIMP_TAC[RE_MUL_CX; REAL_MUL_CX; REAL_LE_MUL_EQ; COMPLEX_NORM_NZ] THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; CEXP_EULER] THEN REWRITE_TAC[real; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; GSYM CX_SIN; GSYM CX_COS; RE_CX; IM_CX] THEN REWRITE_TAC[REAL_ADD_RID; REAL_ADD_LID; REAL_NEG_0] THEN EQ_TAC THEN SIMP_TAC[SIN_0; COS_0; REAL_POS] THEN ASM_CASES_TAC `Arg z = pi` THENL [ASM_REWRITE_TAC[COS_PI] THEN REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(SPEC `z:complex` ARG) THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH `&0 <= x /\ x < &2 * pi ==> --pi < x /\ x < pi \/ --pi < x - pi /\ x - pi < pi`)) THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIN_EQ_0_PI] THEN UNDISCH_TAC `~(Arg z = pi)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `x = pi <=> x - pi = &0`] THEN MATCH_MP_TAC SIN_EQ_0_PI THEN ASM_REWRITE_TAC[SIN_SUB; SIN_PI] THEN REAL_ARITH_TAC);; let ARG_NUM = prove (`!n. Arg(Cx(&n)) = &0`, REWRITE_TAC[ARG_EQ_0; REAL_CX; RE_CX; REAL_POS]);; let ARG_EQ_PI = prove (`!z. Arg z = pi <=> real z /\ Re z < &0`, SIMP_TAC[ARG; PI_POS; REAL_ARITH `&0 < pi /\ &0 <= z ==> (z = pi <=> z <= pi /\ ~(z = &0) /\ ~(&0 < z /\ z < pi))`] THEN REWRITE_TAC[ARG_EQ_0; ARG; ARG_LT_PI; ARG_LE_PI; real] THEN REAL_ARITH_TAC);; let ARG_EQ_0_PI = prove (`!z. Arg z = &0 \/ Arg z = pi <=> real z`, REWRITE_TAC[ARG_EQ_0; ARG_EQ_PI; real] THEN REAL_ARITH_TAC);; let ARG_INV = prove (`!z. ~(real z /\ &0 <= Re z) ==> Arg(inv z) = &2 * pi - Arg z`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; REAL_LE_REFL] THEN REWRITE_TAC[real] THEN STRIP_TAC THEN MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `inv(norm(z:complex))` THEN ASM_SIMP_TAC[COMPLEX_NORM_NZ; REAL_LT_INV_EQ] THEN REWRITE_TAC[CX_SUB; CX_MUL; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN SUBST1_TAC(SPEC `Cx(&2) * Cx pi` CEXP_EULER) THEN REWRITE_TAC[GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS] THEN REWRITE_TAC[SIN_NPI; COS_NPI; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID; CX_INV; GSYM COMPLEX_INV_MUL] THEN REWRITE_TAC[GSYM ARG] THEN MP_TAC(SPEC `z:complex` ARG_EQ_0) THEN ASM_REWRITE_TAC[real] THEN MP_TAC(SPEC `z:complex` ARG) THEN REAL_ARITH_TAC);; let ARG_EQ = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> (Arg w = Arg z <=> ?x. &0 < x /\ w = Cx(x) * z)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[ARG_MUL_CX]] THEN DISCH_TAC THEN MAP_EVERY (MP_TAC o CONJUNCT2 o CONJUNCT2 o C SPEC ARG) [`z:complex`; `w:complex`] THEN ASM_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(fun th -> CONV_TAC(SUBS_CONV(CONJUNCTS th))) THEN EXISTS_TAC `norm(w:complex) / norm(z:complex)` THEN ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_NORM_NZ; CX_DIV] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_NORM_ZERO; CX_INJ]);; let ARG_INV_EQ_0 = prove (`!z. Arg(inv z) = &0 <=> Arg z = &0`, GEN_TAC THEN REWRITE_TAC[ARG_EQ_0; REAL_INV_EQ] THEN MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN REWRITE_TAC[real] THEN DISCH_TAC THEN ASM_REWRITE_TAC[complex_inv; RE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> x * inv(x pow 2) = inv x`] THEN REWRITE_TAC[REAL_LE_INV_EQ]);; let ARG_LE_DIV_SUM = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) /\ Arg(w) <= Arg(z) ==> Arg(z) = Arg(w) + Arg(z / w)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a:real = b + c <=> c = a - b`] THEN MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `norm(z / w)`THEN ASM_SIMP_TAC[ARG; REAL_ARITH `&0 <= a /\ a < &2 * pi /\ &0 <= b /\ b <= a ==> a - b < &2 * pi`] THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; CX_DIV] THEN ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_NORM_NZ] THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB; CEXP_SUB; CX_SUB] THEN REWRITE_TAC[complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_RING `(a * b) * (c * d):complex = (a * c) * (b * d)`] THEN REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN ASM_SIMP_TAC[GSYM ARG]);; let ARG_LE_DIV_SUM_EQ = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> (Arg(w) <= Arg(z) <=> Arg(z) = Arg(w) + Arg(z / w))`, MESON_TAC[ARG_LE_DIV_SUM; REAL_LE_ADDR; ARG]);; let REAL_SUB_ARG = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> Arg w - Arg z = if Arg(z) <= Arg(w) then Arg(w / z) else Arg(w / z) - &2 * pi`, REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [MP_TAC(ISPECL [`z:complex`; `w:complex`] ARG_LE_DIV_SUM) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; MP_TAC(ISPECL [`w:complex`; `z:complex`] ARG_LE_DIV_SUM) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[REAL_ARITH `a - (a + b):real = --b`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM COMPLEX_INV_DIV] THEN MATCH_MP_TAC(REAL_ARITH `x = &2 * pi - y ==> --x = y - &2 * pi`) THEN MATCH_MP_TAC ARG_INV THEN REWRITE_TAC[GSYM ARG_EQ_0] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN REWRITE_TAC[ARG_INV_EQ_0] THEN MP_TAC(ISPECL [`w:complex`; `z:complex`] ARG_LE_DIV_SUM) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; let REAL_ADD_ARG = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> Arg(w) + Arg(z) = if Arg w + Arg z < &2 * pi then Arg(w * z) else Arg(w * z) + &2 * pi`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`w * z:complex`; `z:complex`] REAL_SUB_ARG) THEN MP_TAC(SPECL [`z:complex`; `w * z:complex`] ARG_LE_DIV_SUM_EQ) THEN ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_FIELD `~(z = Cx(&0)) ==> (w * z) / z = w`] THEN ASM_CASES_TAC `Arg (w * z) = Arg z + Arg w` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[ARG; REAL_ADD_SYM]; SIMP_TAC[REAL_ARITH `wz - z = w - &2 * pi <=> w + z = wz + &2 * pi`] THEN REWRITE_TAC[REAL_ARITH `w + p < p <=> ~(&0 <= w)`; ARG]]);; let ARG_MUL = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> Arg(w * z) = if Arg w + Arg z < &2 * pi then Arg w + Arg z else (Arg w + Arg z) - &2 * pi`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_ADD_ARG) THEN REAL_ARITH_TAC);; let ARG_CNJ = prove (`!z. Arg(cnj z) = if real z /\ &0 <= Re z then Arg z else &2 * pi - Arg z`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[CNJ_CX; ARG_0; REAL_CX; RE_CX; REAL_LE_REFL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_IMP_CNJ] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Arg(inv z)` THEN CONJ_TAC THENL [REWRITE_TAC[COMPLEX_INV_CNJ] THEN ASM_SIMP_TAC[GSYM CX_POW; ARG_DIV_CX; REAL_POW_LT; COMPLEX_NORM_NZ]; ASM_SIMP_TAC[ARG_INV]]);; let ARG_REAL = prove (`!z. real z ==> Arg z = if &0 <= Re z then &0 else pi`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARG_EQ_PI; ARG_EQ_0] THEN ASM_REAL_ARITH_TAC);; let ARG_CEXP = prove (`!z. &0 <= Im z /\ Im z < &2 * pi ==> Arg(cexp(z)) = Im z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `exp(Re z)` THEN ASM_REWRITE_TAC[CX_EXP; GSYM CEXP_ADD; REAL_EXP_POS_LT] THEN REWRITE_TAC[GSYM COMPLEX_EXPAND]);; (* ------------------------------------------------------------------------- *) (* Properties of 2-D rotations, and their interpretation using cexp. *) (* ------------------------------------------------------------------------- *) let rotate2d = new_definition `(rotate2d:real->real^2->real^2) t x = vector[x$1 * cos(t) - x$2 * sin(t); x$1 * sin(t) + x$2 * cos(t)]`;; let LINEAR_ROTATE2D = prove (`!t. linear(rotate2d t)`, SIMP_TAC[linear; CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; rotate2d] THEN REAL_ARITH_TAC);; let ROTATE2D_ADD_VECTORS = prove (`!t w z. rotate2d t (w + z) = rotate2d t w + rotate2d t z`, SIMP_TAC[LINEAR_ADD; LINEAR_ROTATE2D]);; let ROTATE2D_SUB = prove (`!t w z. rotate2d t (w - z) = rotate2d t w - rotate2d t z`, SIMP_TAC[LINEAR_SUB; LINEAR_ROTATE2D]);; let NORM_ROTATE2D = prove (`!t z. norm(rotate2d t z) = norm z`, REWRITE_TAC[NORM_EQ; rotate2d; DIMINDEX_2; DOT_2; VECTOR_2] THEN REPEAT GEN_TAC THEN MP_TAC(ISPEC `t:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; let ROTATE2D_0 = prove (`!t. rotate2d t (Cx(&0)) = Cx(&0)`, REWRITE_TAC[GSYM COMPLEX_NORM_ZERO; NORM_ROTATE2D; COMPLEX_NORM_0]);; let ROTATE2D_EQ_0 = prove (`!t z. rotate2d t z = Cx(&0) <=> z = Cx(&0)`, REWRITE_TAC[GSYM COMPLEX_NORM_ZERO; NORM_ROTATE2D]);; let ROTATE2D_ZERO = prove (`!z. rotate2d (&0) z = z`, REWRITE_TAC[rotate2d; SIN_0; COS_0] THEN REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2] THEN REAL_ARITH_TAC);; let ORTHOGONAL_TRANSFORMATION_ROTATE2D = prove (`!t. orthogonal_transformation(rotate2d t)`, REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; LINEAR_ROTATE2D; NORM_ROTATE2D]);; let ROTATE2D_POLAR = prove (`!r t s. rotate2d t (vector[r * cos(s); r * sin(s)]) = vector[r * cos(t + s); r * sin(t + s)]`, SIMP_TAC[rotate2d; DIMINDEX_2; VECTOR_2; CART_EQ; FORALL_2] THEN REWRITE_TAC[SIN_ADD; COS_ADD] THEN REAL_ARITH_TAC);; let MATRIX_ROTATE2D = prove (`!t. matrix(rotate2d t) = vector[vector[cos t;--(sin t)]; vector[sin t; cos t]]`, SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_ROTATE2D] THEN SIMP_TAC[matrix_vector_mul; rotate2d; CART_EQ; DIMINDEX_2; FORALL_2; LAMBDA_BETA; VECTOR_2; ARITH; SUM_2] THEN REAL_ARITH_TAC);; let DET_MATRIX_ROTATE2D = prove (`!t. det(matrix(rotate2d t)) = &1`, GEN_TAC THEN REWRITE_TAC[MATRIX_ROTATE2D; DET_2; VECTOR_2] THEN MP_TAC(SPEC `t:real` SIN_CIRCLE) THEN REAL_ARITH_TAC);; let ROTATION_ROTATE2D = prove (`!f. orthogonal_transformation f /\ det(matrix f) = &1 ==> ?t. &0 <= t /\ t < &2 * pi /\ f = rotate2d t`, REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX] THEN REWRITE_TAC[matrix_mul; orthogonal_matrix; transp] THEN SIMP_TAC[DIMINDEX_2; SUM_2; FORALL_2; LAMBDA_BETA; ARITH; CART_EQ; mat; DET_2] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(matrix f)$1$1 pow 2 + (matrix f)$2$1 pow 2 = &1 /\ (matrix f)$1$2 = --((matrix f)$2$1) /\ (matrix f:real^2^2)$2$2 = (matrix f)$1$1` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC REAL_RING; FIRST_X_ASSUM(MP_TAC o MATCH_MP SINCOS_TOTAL_2PI) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_MATRIX THEN ASM_REWRITE_TAC[LINEAR_ROTATE2D; MATRIX_ROTATE2D] THEN ASM_SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2]]);; let ROTATE2D_ADD = prove (`!s t x. rotate2d (s + t) x = rotate2d s (rotate2d t x)`, SIMP_TAC[CART_EQ; rotate2d; LAMBDA_BETA; DIMINDEX_2; ARITH; FORALL_2; VECTOR_2] THEN REWRITE_TAC[SIN_ADD; COS_ADD] THEN REAL_ARITH_TAC);; let ROTATE2D_COMPLEX = prove (`!t z. rotate2d t z = cexp(ii * Cx t) * z`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [complex_mul] THEN REWRITE_TAC[CEXP_EULER; rotate2d; GSYM CX_SIN; GSYM CX_COS; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; IM_CX; RE_CX] THEN REWRITE_TAC[CART_EQ; FORALL_2; VECTOR_2; DIMINDEX_2] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN REAL_ARITH_TAC);; let ROTATE2D_PI2 = prove (`!z. rotate2d (pi / &2) z = ii * z`, REWRITE_TAC[ROTATE2D_COMPLEX; CEXP_EULER; SIN_PI2; COS_PI2; GSYM CX_SIN; GSYM CX_COS] THEN CONV_TAC COMPLEX_RING);; let ROTATE2D_PI = prove (`!z. rotate2d pi z = --z`, REWRITE_TAC[ROTATE2D_COMPLEX; CEXP_EULER; SIN_PI; COS_PI; GSYM CX_SIN; GSYM CX_COS] THEN CONV_TAC COMPLEX_RING);; let ROTATE2D_NPI = prove (`!n z. rotate2d (&n * pi) z = --Cx(&1) pow n * z`, REWRITE_TAC[ROTATE2D_COMPLEX; CEXP_EULER; SIN_NPI; COS_NPI; GSYM CX_SIN; GSYM CX_COS; CX_NEG; CX_POW] THEN CONV_TAC COMPLEX_RING);; let ROTATE2D_2PI = prove (`!z. rotate2d (&2 * pi) z = z`, REWRITE_TAC[ROTATE2D_NPI] THEN CONV_TAC COMPLEX_RING);; let ARG_ROTATE2D = prove (`!t z. ~(z = Cx(&0)) /\ &0 <= t + Arg z /\ t + Arg z < &2 * pi ==> Arg(rotate2d t z) = t + Arg z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `norm(z:complex)` THEN ASM_SIMP_TAC[ARG; ROTATE2D_COMPLEX; REAL_LE_ADD; COMPLEX_NORM_NZ] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ARG] THEN REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; let ARG_ROTATE2D_UNIQUE = prove (`!t a z. ~(z = Cx(&0)) /\ Arg(rotate2d t z) = a ==> ?n. integer n /\ t = &2 * n * pi + (a - Arg z)`, REPEAT STRIP_TAC THEN MP_TAC(last(CONJUNCTS(ISPEC `rotate2d t z` ARG))) THEN ASM_REWRITE_TAC[NORM_ROTATE2D] THEN REWRITE_TAC[ROTATE2D_COMPLEX] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [ARG] THEN ASM_REWRITE_TAC[COMPLEX_RING `a * z * b = z * c <=> z = Cx(&0) \/ a * b = c`; CX_INJ; COMPLEX_NORM_ZERO; GSYM CEXP_ADD; CEXP_EQ] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; CX_INJ; COMPLEX_RING `ii * t + ii * z = ii * a + n * ii <=> t = n + (a - z)`]);; let ARG_ROTATE2D_UNIQUE_2PI = prove (`!s t z. ~(z = Cx(&0)) /\ &0 <= s /\ s < &2 * pi /\ &0 <= t /\ t < &2 * pi /\ Arg(rotate2d s z) = Arg(rotate2d t z) ==> s = t`, REPEAT STRIP_TAC THEN ABBREV_TAC `a = Arg(rotate2d t z)` THEN MP_TAC(ISPECL [`s:real`; `a:real`; `z:complex`] ARG_ROTATE2D_UNIQUE) THEN MP_TAC(ISPECL [`t:real`; `a:real`; `z:complex`] ARG_ROTATE2D_UNIQUE) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SIN_COS_INJ THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SIN_COS_EQ; REAL_RING `x + az:real = (y + az) + z <=> x - y = z`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN ASM_MESON_TAC[INTEGER_CLOSED]; ASM_REAL_ARITH_TAC]);; let COMPLEX_DIV_ROTATION = prove (`!f w z. orthogonal_transformation f /\ det(matrix f) = &1 ==> f w / f z = w / z`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ROTATION_ROTATE2D) THEN DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[ROTATE2D_COMPLEX] THEN SIMP_TAC[complex_div; COMPLEX_INV_MUL; CEXP_NZ; COMPLEX_FIELD `~(a = Cx(&0)) ==> (a * w) * (inv a * z) = w * z`]);; let th = prove (`!f w z. linear f /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:2) ==> det(matrix f) = &1) ==> f w / f z = w / z`, REWRITE_TAC[CONJ_ASSOC; GSYM ORTHOGONAL_TRANSFORMATION; DIMINDEX_2; LE_REFL; COMPLEX_DIV_ROTATION]) in add_linear_invariants [th];; let th = prove (`!f t z. linear f /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:2) ==> det(matrix f) = &1) ==> rotate2d t (f z) = f(rotate2d t z)`, REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `f:complex->complex` ROTATION_ROTATE2D) THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[GSYM ROTATE2D_ADD] THEN REWRITE_TAC[REAL_ADD_SYM]) in add_linear_invariants [th];; let ROTATION_ROTATE2D_EXISTS_GEN = prove (`!x y. ?t. &0 <= t /\ t < &2 * pi /\ norm(y) % rotate2d t x = norm(x) % y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`norm(y:real^2) % x:real^2`; `norm(x:real^2) % y:real^2`] ROTATION_EXISTS) THEN ASM_REWRITE_TAC[DIMINDEX_2; NORM_MUL; ARITH; REAL_ABS_NORM; EQT_INTRO(SPEC_ALL REAL_MUL_SYM); CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^2->real^2` (CONJUNCTS_THEN ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP ROTATION_ROTATE2D) THEN MATCH_MP_TAC MONO_EXISTS THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D]);; let ROTATION_ROTATE2D_EXISTS = prove (`!x y. norm x = norm y ==> ?t. &0 <= t /\ t < &2 * pi /\ rotate2d t x = y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `norm(y:complex) = &0` THENL [ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `&0` THEN SIMP_TAC[REAL_LT_MUL; PI_POS; REAL_OF_NUM_LT; ARITH; REAL_LE_REFL] THEN ASM_MESON_TAC[COMPLEX_NORM_ZERO; ROTATE2D_0]; DISCH_TAC THEN MP_TAC(ISPECL [`x:complex`; `y:complex`] ROTATION_ROTATE2D_EXISTS_GEN) THEN ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL]]);; let ROTATION_ROTATE2D_EXISTS_ORTHOGONAL = prove (`!e1 e2. norm(e1) = &1 /\ norm(e2) = &1 /\ orthogonal e1 e2 ==> e1 = rotate2d (pi / &2) e2 \/ e2 = rotate2d (pi / &2) e1`, REWRITE_TAC[NORM_EQ_1; orthogonal] THEN SIMP_TAC[DOT_2; CART_EQ; FORALL_2; DIMINDEX_2; rotate2d; VECTOR_2] THEN REWRITE_TAC[COS_PI2; SIN_PI2; REAL_MUL_RZERO; REAL_ADD_RID; REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_MUL_RID] THEN CONV_TAC REAL_RING);; let ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED = prove (`!e1 e2. norm(e1) = &1 /\ norm(e2) = &1 /\ orthogonal e1 e2 /\ &0 < e1$1 * e2$2 - e1$2 * e2$1 ==> e2 = rotate2d (pi / &2) e1`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP ROTATION_ROTATE2D_EXISTS_ORTHOGONAL) THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[DOT_2; CART_EQ; FORALL_2; DIMINDEX_2; rotate2d; VECTOR_2] THEN REWRITE_TAC[COS_PI2; SIN_PI2; REAL_MUL_RZERO; REAL_ADD_RID; REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `--x * x - y * y <= &0 <=> &0 <= x * x + y * y`] THEN MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_LE_SQUARE]);; let ROTATE2D_EQ = prove (`!t x y. rotate2d t x = rotate2d t y <=> x = y`, MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE; ORTHOGONAL_TRANSFORMATION_ROTATE2D]);; let ROTATE2D_SUB_ARG = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> rotate2d(Arg w - Arg z) = rotate2d(Arg(w / z))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_SUB_ARG] THEN COND_CASES_TAC THEN REWRITE_TAC[real_sub; ROTATE2D_ADD; FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[ROTATE2D_COMPLEX] THEN REWRITE_TAC[EULER; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; COS_NEG; SIN_NEG] THEN REWRITE_TAC[SIN_NPI; COS_NPI; REAL_EXP_NEG; REAL_EXP_0; CX_NEG] THEN REWRITE_TAC[COMPLEX_NEG_0; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_MUL_LID]);; let ROTATION_MATRIX_ROTATE2D = prove (`!t. rotation_matrix(matrix(rotate2d t))`, SIMP_TAC[ROTATION_MATRIX_2; MATRIX_ROTATE2D; VECTOR_2] THEN MESON_TAC[SIN_CIRCLE; REAL_ADD_SYM]);; let ROTATION_MATRIX_ROTATE2D_EQ = prove (`!A:real^2^2. rotation_matrix A <=> ?t. A = matrix(rotate2d t)`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; ROTATION_MATRIX_ROTATE2D] THEN REWRITE_TAC[ROTATION_MATRIX_2; MATRIX_ROTATE2D] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP SINCOS_TOTAL_2PI) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Homotopy of linear maps of various kinds where the homotopy stays inside *) (* that class of linear maps. *) (* ------------------------------------------------------------------------- *) let NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION = prove (`!f:real^N->real^N. orthogonal_transformation f /\ det(matrix f) = &1 ==> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) f I`, let lemma0 = prove (`!a x:real^N. 2 <= dimindex(:N) /\ a IN span {basis 1,basis 2} ==> reflect_along (vector[a$1; a$2]:real^2) (lambda i. x$i) = (lambda i. reflect_along a x$i)`, REPEAT STRIP_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; reflect_along; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; DIMINDEX_2; FORALL_2; VECTOR_2; ARITH] THEN CONJ_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN REWRITE_TAC[dot] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; FORALL_2; DIMINDEX_2; LAMBDA_BETA; ARITH; VECTOR_2; SUBSET_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `(1 <= i /\ i <= n) /\ ~(1 <= i /\ i <= 2) <=> 1 <= i /\ 3 <= i /\ i <= n`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SPAN_2]) THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO]) THEN ASM_ARITH_TAC) in let lemma1 = prove (`!a b:real^2 r. ~(a = vec 0) /\ ~(b = vec 0) ==> homotopic_with orthogonal_transformation ((:real^2),(:real^2)) (reflect_along a o reflect_along b) I`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `reflect_along (a:real^2) o reflect_along b` ROTATION_ROTATE2D) THEN ANTS_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ROTOINVERSION_MATRIX_REFLECT_ALONG)) THEN REWRITE_TAC[rotoinversion_matrix] THEN SIMP_TAC[ORTHOGONAL_MATRIX_MATRIX; ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG; ORTHOGONAL_TRANSFORMATION_COMPOSE; MATRIX_COMPOSE; LINEAR_REFLECT_ALONG; DET_MUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV; DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_REWRITE_TAC[homotopic_with] THEN EXISTS_TAC `\z. rotate2d (drop(fstcart z) * t) (sndcart z)` THEN SIMP_TAC[ORTHOGONAL_TRANSFORMATION_ROTATE2D; SNDCART_PASTECART; ETA_AX; FSTCART_PASTECART; DROP_VEC; I_THM; NORM_ROTATE2D; REAL_MUL_LZERO; REAL_MUL_LID; SUBSET; FORALL_IN_IMAGE; IN_UNIV; FORALL_IN_PCROSS; IN_SPHERE_0; ROTATE2D_ZERO] THEN REWRITE_TAC[ROTATE2D_COMPLEX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP; CX_MUL] THEN ONCE_REWRITE_TAC[COMPLEX_RING `ii * x * t = (ii * t) * x`] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART]]) in let lemma2 = prove (`!a b:real^N r. 2 <= dimindex(:N) /\ ~(a = vec 0) /\ ~(b = vec 0) /\ {a,b} SUBSET span {basis 1,basis 2} ==> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) (reflect_along a o reflect_along b) I`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `homotopic_with orthogonal_transformation ((:real^N),(:real^N)) ((\z. (lambda i. if i <= 2 then (fstcart z)$i else (sndcart z)$i):real^N) o (\z. pastecart (((reflect_along (vector [(a:real^N)$1; a$2]) o reflect_along (vector [(b:real^N)$1; b$2])) :real^2->real^2)(fstcart z)) (sndcart z)) o (\z:real^N. pastecart ((lambda i. z$i) :real^2) z)) ((\z. (lambda i. if i <= 2 then (fstcart z)$i else (sndcart z)$i):real^N) o I o (\z:real^N. pastecart ((lambda i. z$i) :real^2) z))` MP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `(:real^2) PCROSS (:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN ONCE_REWRITE_TAC[LINEAR_COMPONENTWISE] THEN SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i <= 2` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; SNDCART_CMUL] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `(:real^2) PCROSS (:real^N)` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; PASTECART_IN_PCROSS] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN MATCH_MP_TAC LINEAR_PASTECART THEN REWRITE_TAC[LINEAR_ID] THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]] THEN SUBGOAL_THEN `I = \z:real^(2,N)finite_sum. pastecart (fstcart z) (sndcart z)` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_FST_SND; I_DEF]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_PCROSS THEN EXISTS_TAC `orthogonal_transformation:(real^2->real^2)->bool` THEN EXISTS_TAC `\f:real^N->real^N. f = I` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM I_DEF; ETA_AX] THEN MATCH_MP_TAC lemma1 THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INSERT_SUBSET]) THEN REWRITE_TAC[SING_SUBSET; SPAN_2; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(REPEAT_TCL STRIP_THM_THEN SUBST_ALL_TAC) THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN REWRITE_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; DIMINDEX_2; FORALL_2; VECTOR_2] THEN SIMP_TAC[BASIS_COMPONENT; ARITH; DIMINDEX_2; VEC_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (s ==> p) ==> a /\ ~p /\ ~q ==> ~s /\ ~r`) THEN SIMP_TAC[REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_MUL_RID; REAL_ADD_LID; REAL_ADD_RID]; REWRITE_TAC[HOMOTOPIC_WITH_REFL; SUBSET_UNIV; I_DEF] THEN REWRITE_TAC[CONTINUOUS_ON_ID]; SIMP_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; LAMBDA_BETA; DIMINDEX_2; ARITH; I_THM] THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; NORM_EQ] THEN X_GEN_TAC `f:real^2->real^2` THEN GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [linear]) THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; X_GEN_TAC `v:real^N` THEN REWRITE_TAC[dot; GSYM REAL_POW_2] THEN SUBGOAL_THEN `dimindex(:N) = 2 + (dimindex(:N) - 2)` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN BINOP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[dot; DIMINDEX_2; GSYM REAL_POW_2]) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (v:real^N)$i):real^2`) THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `2 <= n ==> !i. i <= 2 ==> i <= n`)) THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_2]; ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> 2 + n - 2 = n`] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[ARITH_RULE `2 + 1 <= i ==> 1 <= i`; LAMBDA_BETA; DIMINDEX_2] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]]; MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN REWRITE_TAC[IN_UNIV; GSYM FUN_EQ_THM] THEN SIMP_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; LAMBDA_BETA; DIMINDEX_2; ARITH; I_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE[INSERT_SUBSET; EMPTY_SUBSET]) THEN ASM_SIMP_TAC[lemma0] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_2; ARITH; COND_ID] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(a:real^N)$i = &0 /\ (b:real^N)$i = &0` ASSUME_TAC THENL [FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[SPAN_2; IN_ELIM_THM; IN_UNIV] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN (REAL_ARITH_TAC ORELSE ASM_ARITH_TAC); ASM_REWRITE_TAC[reflect_along; VECTOR_SUB_COMPONENT; REAL_MUL_RZERO; VECTOR_MUL_COMPONENT; REAL_SUB_RZERO]]]) in let lemma3 = prove (`!a b:real^N r. ~(a = vec 0) /\ ~(b = vec 0) ==> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) (reflect_along a o reflect_along b) I`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [ASM_SIMP_TAC[o_DEF; I_DEF; REFLECT_ALONG_1D; VECTOR_NEG_NEG] THEN REWRITE_TAC[HOMOTOPIC_WITH_REFL; SUBSET_UNIV; CONTINUOUS_ON_ID] THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID]; FIRST_X_ASSUM(MP_TAC o MATCH_MP(ARITH_RULE `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN MP_TAC(ISPECL [`span{a:real^N,b}`; `span{basis 1:real^N,basis 2}`] ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE) THEN REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[DIM_INSERT; SPAN_SING; SPAN_EMPTY; IN_SING; DIM_EMPTY] THEN MATCH_MP_TAC(ARITH_RULE `m <= 2 /\ n = 2 ==> m <= n`) THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[BASIS_NONZERO; ARITH] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o AP_TERM `(\x:real^N. x$1)`)) THEN ASM_SIMP_TAC[BASIS_COMPONENT; VECTOR_MUL_COMPONENT; ARITH; DIMINDEX_GE_1] THEN REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `f:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC)] THEN SUBGOAL_THEN `homotopic_with orthogonal_transformation ((:real^N),(:real^N)) (g o (f o (reflect_along a o reflect_along b) o (g:real^N->real^N)) o f) (g o (f o I o (g:real^N->real^N)) o f)` MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_ASSOC] THEN ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID]] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_CONTINUOUS_ON] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_CONTINUOUS_ON] THEN ASM_REWRITE_TAC[I_O_ID] THEN MP_TAC(ISPEC `f:real^N->real^N` REFLECT_ALONG_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_TRANSFORMATION] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `!h:real^N->real^N. orthogonal_transformation (g o h o (f:real^N->real^N)) <=> orthogonal_transformation h` (fun th -> REWRITE_TAC[th; ETA_AX]) THENL [GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN DISCH_TAC THEN SUBGOAL_THEN `h:real^N->real^N = f o (g o h o f) o (g:real^N->real^N)` SUBST1_TAC THENL [ALL_TAC; ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE]] THEN ASM_REWRITE_TAC[o_ASSOC] THEN ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID]; ALL_TAC] THEN SUBGOAL_THEN `(f:real^N->real^N) o (reflect_along a o reflect_along b) o g = reflect_along (f a) o reflect_along (f b)` SUBST1_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN ASM_REWRITE_TAC[o_DEF]; MATCH_MP_TAC lemma2 THEN RULE_ASSUM_TAC (REWRITE_RULE[GSYM NORM_EQ_0; ORTHOGONAL_TRANSFORMATION]) THEN ASM_REWRITE_TAC[GSYM NORM_EQ_0] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE; IMAGE_CLAUSES] THEN REWRITE_TAC[SPAN_INC]]) in GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`f:real^N->real^N`; `dimindex(:N)`] ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS) THEN ASM_REWRITE_TAC[ARITH_RULE `n:num <= a + n`] THEN DISCH_THEN(X_CHOOSE_THEN `l:(real^N)list` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `ALL (\v:real^N. ~(v = vec 0)) l` THEN UNDISCH_TAC `orthogonal_transformation(f:real^N->real^N)` THEN MATCH_MP_TAC(TAUT `r /\ (p /\ q ==> s) ==> r ==> p ==> q ==> s`) THEN ASM_REWRITE_TAC[IMP_IMP] THEN SPEC_TAC(`l:(real^N)list`,`l:(real^N)list`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN GEN_TAC THEN WF_INDUCT_TAC `LENGTH(l:(real^N)list)` THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`l:(real^N)list`,`l:(real^N)list`) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALL; ITLIST; HOMOTOPIC_WITH_REFL] THEN REWRITE_TAC[REWRITE_RULE[GSYM I_DEF] CONTINUOUS_ON_ID; ORTHOGONAL_TRANSFORMATION_I; SUBSET_UNIV] THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALL; ITLIST; I_O_ID; DET_MATRIX_REFLECT_ALONG] THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG] THEN CONJ_TAC THENL [MESON_TAC[REAL_ARITH `~(-- &1 = &1)`]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`b:real^N`; `l:(real^N)list`] THEN REPLICATE_TAC 2 (DISCH_THEN(K ALL_TAC)) THEN DISCH_THEN(MP_TAC o SPEC `l:(real^N)list`) THEN REWRITE_TAC[LENGTH; ARITH_RULE `n < SUC(SUC n)`] THEN SIMP_TAC[LINEAR_COMPOSE; LINEAR_REFLECT_ALONG; MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG; ORTHOGONAL_TRANSFORMATION_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN MP_TAC th) THEN ASM_SIMP_TAC[DET_MUL; DET_MATRIX_REFLECT_ALONG; REAL_ARITH `-- &1 * -- &1 * x = x`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN GEN_REWRITE_TAC RAND_CONV [MESON[I_O_ID] `f = I o f`] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN ABBREV_TAC `g = ITLIST (\v:real^N h. reflect_along v o h) l I` THEN SUBGOAL_THEN `(\f:real^N->real^N. orthogonal_transformation (f o g)) = orthogonal_transformation` SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC lemma3 THEN ASM_REWRITE_TAC[]] THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `f:real^N->real^N` THEN EQ_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN DISCH_TAC THEN MP_TAC(ISPEC `g:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `f = ((f:real^N->real^N) o (g:real^N->real^N)) o h` SUBST1_TAC THENL [ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID]; ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE]]);; let HOMOTOPIC_SPECIAL_ORTHOGONAL_TRANSFORMATIONS, HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS = (CONJ_PAIR o prove) (`(!f g. homotopic_with (\h. orthogonal_transformation h /\ det(matrix h) = det(matrix f)) ((:real^N),(:real^N)) f g <=> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) f g) /\ !f g. homotopic_with orthogonal_transformation ((:real^N),(:real^N)) f g <=> orthogonal_transformation f /\ orthogonal_transformation g /\ det(matrix f) = det(matrix g)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(u ==> s) /\ (s ==> t) /\ (t ==> u) ==> (u <=> t) /\ (t <=> s)`) THEN REPEAT CONJ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN MESON_TAC[]; STRIP_TAC THEN MP_TAC(ISPEC `g:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(f:real^N->real^N) = g o (h:real^N->real^N) o f /\ g = g o I` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_CONTINUOUS_ON] THEN SUBGOAL_THEN `!k:real^N->real^N. orthogonal_transformation (g o k) <=> orthogonal_transformation k` (fun th -> REWRITE_TAC[th; ETA_AX]) THENL [GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN DISCH_THEN (MP_TAC o SPEC `h:real^N->real^N` o MATCH_MP (ONCE_REWRITE_RULE [IMP_CONJ_ALT] ORTHOGONAL_TRANSFORMATION_COMPOSE)) THEN ASM_SIMP_TAC[o_ASSOC; I_O_ID]; MATCH_MP_TAC NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION THEN REPEAT(FIRST_X_ASSUM(MP_TAC o AP_TERM `\f:real^N->real^N. det(matrix f)`)) THEN ASM_SIMP_TAC[MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR; ORTHOGONAL_TRANSFORMATION_COMPOSE; DET_MUL; MATRIX_I; DET_I]]; REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN MP_TAC(ISPECL [`\t. lift( det(matrix((k:real^(1,N)finite_sum->real^N) o pastecart t)))`; `interval[vec 0:real^1,vec 1]`] CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN SIMP_TAC[matrix; LAMBDA_BETA; o_DEF] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_UNIV]; X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `u:real^1` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; LIFT_EQ] THEN SUBGOAL_THEN `orthogonal_transformation ((k:real^(1,N)finite_sum->real^N) o pastecart t) /\ orthogonal_transformation (k o pastecart u)` MP_TAC THENL [ASM_SIMP_TAC[o_DEF]; ALL_TAC] THEN DISCH_THEN(CONJUNCTS_THEN (STRIP_ASSUME_TAC o MATCH_MP DET_ORTHOGONAL_MATRIX o MATCH_MP ORTHOGONAL_MATRIX_MATRIX)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; REWRITE_TAC[o_DEF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM])) THEN REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; GSYM LIFT_EQ]]]);; let HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_SPHERE = prove (`!f g r. &0 < r ==> (homotopic_with orthogonal_transformation (sphere(vec 0,r),sphere(vec 0,r)) f g <=> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) f g)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_RESTRICT THEN REPEAT(EXISTS_TAC `(:real^N)`) THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE; DIST_0] THEN MESON_TAC[ORTHOGONAL_TRANSFORMATION]] THEN REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\z. norm(sndcart z) / r % (h:real^(1,N)finite_sum->real^N) (pastecart (fstcart z) (r / norm(sndcart z) % sndcart z))` THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; FORALL_IN_PCROSS; IN_UNIV; FSTCART_PASTECART; SNDCART_PASTECART] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:real^1`; `x:real^N`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN DISCH_THEN(MP_TAC o MATCH_MP LINEAR_CMUL) THEN SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[VECTOR_MUL_LZERO] THEN STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; VECTOR_MUL_LZERO; real_div; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; VECTOR_MUL_LID; REAL_FIELD `~(x = &0) /\ &0 < r ==> (x * inv r) * r * inv x = &1`]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN MAP_EVERY X_GEN_TAC [`a:real^1`; `x:real^N`] THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_REWRITE_TAC[CONTINUOUS_WITHIN; SNDCART_PASTECART] THEN REWRITE_TAC[NORM_0; real_div; REAL_MUL_LZERO; VECTOR_MUL_LZERO] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `(norm o sndcart):real^(1,N)finite_sum->real` THEN CONJ_TAC THENL [SIMP_TAC[EVENTUALLY_WITHIN; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_UNIV] THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN MAP_EVERY X_GEN_TAC [`b:real^1`; `y:real^N`] THEN STRIP_TAC THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_SIMP_TAC[NORM_0; VECTOR_MUL_LZERO; REAL_MUL_LZERO; REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `b:real^1`) THEN ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o MATCH_MP LINEAR_CMUL) THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_MUL; REAL_ABS_NORM] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_LE_REFL; REAL_FIELD `&0 < r /\ ~(y = &0) ==> (y * inv(abs r)) * (abs r * inv y) * y = y`]; MATCH_MP_TAC(MESON[CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN] `f continuous at a /\ f a = l ==> (f --> l) (at a within s)`) THEN REWRITE_TAC[o_DEF; SNDCART_PASTECART; NORM_0; LIFT_NUM] THEN SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; LINEAR_CONTINUOUS_AT; LINEAR_SNDCART]]; MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; real_div] THEN ONCE_REWRITE_TAC[REAL_ARITH `norm(x:real^N) * inv r = inv r * norm x`] THEN SIMP_TAC[LIFT_CMUL; CONTINUOUS_CMUL; CONTINUOUS_LIFT_NORM_COMPOSE; LINEAR_CONTINUOUS_WITHIN; LINEAR_SNDCART] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_SNDCART] THEN REWRITE_TAC[o_DEF; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; LINEAR_CONTINUOUS_WITHIN; LINEAR_SNDCART; o_DEF] THEN ASM_REWRITE_TAC[NORM_EQ_0; SNDCART_PASTECART]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `r / norm(x) % x:real^N`]) THEN ASM_SIMP_TAC[IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; real_div; REAL_ABS_INV; REAL_ABS_MUL; REAL_ARITH `&0 < r ==> abs r = r`; REAL_FIELD `&0 < r /\ ~(x = &0) ==> (r * inv x) * x = r`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_TRANSFORM_WITHIN_SET_IMP) THEN REWRITE_TAC[EVENTUALLY_AT] THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_IN_PCROSS; IN_UNIV] THEN EXISTS_TAC `r:real` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`b:real^1`; `y:real^N`] THEN STRIP_TAC THEN ASM_SIMP_TAC[IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_ABS_MUL; REAL_ARITH `&0 < r ==> abs r = r`; REAL_RING `(r * x) * y = r <=> r = &0 \/ x * y = &1`; REAL_LT_IMP_NZ; REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`; NORM_EQ_0] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_INV_0; REAL_MUL_RZERO; VECTOR_MUL_LZERO] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[DIST_LE_PASTECART; REAL_LET_TRANS] `dist(pastecart a b,pastecart c d) < r ==> dist(b,d) < r`)) THEN ASM_SIMP_TAC[DIST_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_ABS_MUL; REAL_ARITH `&0 < r ==> abs r = r`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_DIV_RMUL; NORM_EQ_0; REAL_LT_REFL]]]);; let HOMOTOPIC_LINEAR_MAPS = prove (`!f g. homotopic_with linear ((:real^M),(:real^N)) f g <=> linear f /\ linear g`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HOMOTOPIC_WITH_IMP_PROPERTY] THEN STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN EXISTS_TAC `\z. (&1 - drop(fstcart z)) % (f:real^M->real^N) (sndcart z) + drop(fstcart z) % (g:real^M->real^N) (sndcart z)` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; SUBSET_UNIV; VECTOR_MUL_LID; VECTOR_MUL_LZERO; REAL_SUB_RZERO; REAL_SUB_REFL; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_SUB; LIFT_DROP; CONTINUOUS_ON_SUB; LINEAR_FSTCART; ETA_AX; LINEAR_SNDCART; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_COMPOSE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_COMPOSE_CMUL THEN ASM_REWRITE_TAC[]]);; let HOMOTOPIC_LINEAR_POSITIVE_SEMIDEFINITE_MAPS = prove (`!f g. homotopic_with (\f. linear f /\ positive_semidefinite(matrix f)) ((:real^N),(:real^N)) f g <=> linear f /\ linear g /\ positive_semidefinite(matrix f) /\ positive_semidefinite(matrix g)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[]; REWRITE_TAC[homotopic_with]] THEN EXISTS_TAC `\z. (&1 - drop(fstcart z)) % (f:real^N->real^N) (sndcart z) + drop(fstcart z) % (g:real^N->real^N) (sndcart z)` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; SUBSET_UNIV; VECTOR_MUL_LID; VECTOR_MUL_LZERO; REAL_SUB_RZERO; REAL_SUB_REFL; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_SUB; LIFT_DROP; CONTINUOUS_ON_SUB; LINEAR_FSTCART; ETA_AX; LINEAR_SNDCART; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN ASM_SIMP_TAC[LINEAR_COMPOSE_ADD; MATRIX_ADD; LINEAR_COMPOSE_CMUL; MATRIX_CMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC POSITIVE_SEMIDEFINITE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC POSITIVE_SEMIDEFINITE_CMUL THEN ASM_REWRITE_TAC[REAL_SUB_LE]]);; let HOMOTOPIC_LINEAR_POSITIVE_DEFINITE_MAPS = prove (`!f g. homotopic_with (\f. linear f /\ positive_definite(matrix f)) ((:real^N),(:real^N)) f g <=> linear f /\ linear g /\ positive_definite(matrix f) /\ positive_definite(matrix g)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[]; REWRITE_TAC[homotopic_with]] THEN EXISTS_TAC `\z. (&1 - drop(fstcart z)) % (f:real^N->real^N) (sndcart z) + drop(fstcart z) % (g:real^N->real^N) (sndcart z)` THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; SUBSET_UNIV; VECTOR_MUL_LID; VECTOR_MUL_LZERO; REAL_SUB_RZERO; REAL_SUB_REFL; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_SUB; LIFT_DROP; CONTINUOUS_ON_SUB; LINEAR_FSTCART; ETA_AX; LINEAR_SNDCART; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN ASM_SIMP_TAC[LINEAR_COMPOSE_ADD; MATRIX_ADD; LINEAR_COMPOSE_CMUL; MATRIX_CMUL] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO; MATRIX_CMUL_LZERO; MATRIX_ADD_RID; MATRIX_CMUL_LID] THEN ASM_CASES_TAC `t = &1` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; MATRIX_CMUL_LZERO; MATRIX_ADD_LID; MATRIX_CMUL_LID] THEN MATCH_MP_TAC POSITIVE_DEFINITE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC POSITIVE_DEFINITE_CMUL THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; let HOMOTOPIC_RESTRICTED_LINEAR_MAPS = prove (`!f g b. homotopic_with (\f. linear f /\ real_sgn(det(matrix f)) = b) ((:real^N),(:real^N)) f g <=> linear f /\ linear g /\ real_sgn(det(matrix f)) = b /\ real_sgn(det(matrix g)) = b`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `b = &0` THENL [ASM_REWRITE_TAC[REAL_SGN_EQ] THEN STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN EXISTS_TAC `(\x. vec 0):real^N->real^N` THEN GEN_REWRITE_TAC LAND_CONV [HOMOTOPIC_WITH_SYM] THEN REWRITE_TAC[homotopic_with] THEN CONJ_TAC THENL [EXISTS_TAC `\z. drop(fstcart z) % (f:real^N->real^N) (sndcart z)`; EXISTS_TAC `\z. drop(fstcart z) % (g:real^N->real^N) (sndcart z)`] THEN REWRITE_TAC[SUBSET_UNIV; FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; MATRIX_CMUL] THEN ASM_REWRITE_TAC[DET_CMUL; REAL_MUL_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_FSTCART; ETA_AX; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `(?fu fp. linear fu /\ linear fp /\ orthogonal_transformation fu /\ positive_definite(matrix fp) /\ (f:real^N->real^N) = fu o fp) /\ (?gu gp. linear gu /\ linear gp /\ orthogonal_transformation gu /\ positive_definite(matrix gp) /\ (g:real^N->real^N) = gu o gp)` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL [MP_TAC(ISPEC `matrix(f:real^N->real^N)` RIGHT_POLAR_DECOMPOSITION_INVERTIBLE); MP_TAC(ISPEC `matrix(g:real^N->real^N)` RIGHT_POLAR_DECOMPOSITION_INVERTIBLE)] THEN REWRITE_TAC[INVERTIBLE_DET_NZ] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM REAL_SGN_EQ] THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC(MESON[] `(!M. P M ==> Q(\x:real^N. M ** x)) ==> (?M. P M) ==> (?f. Q f)`) THEN GEN_TAC) THEN SIMP_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION; MATRIX_VECTOR_MUL_LINEAR; MATRIX_OF_MATRIX_VECTOR_MUL] THEN STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[MATRIX_WORKS]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE THEN EXISTS_TAC `\h. linear h /\ positive_definite(matrix h:real^N^N)` THEN EXISTS_TAC `\h. orthogonal_transformation h /\ det(matrix h:real^N^N) = det (matrix fu:real^N^N)` THEN EXISTS_TAC `(:real^N)` THEN SIMP_TAC[SUBSET_UNIV] THEN REPEAT CONJ_TAC THENL [UNDISCH_THEN `real_sgn(det(matrix f:real^N^N)) = b` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_COMPOSE; MATRIX_COMPOSE; DET_MUL; REAL_SGN_MUL; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[real_sgn; DET_POSITIVE_DEFINITE]; ASM_REWRITE_TAC[HOMOTOPIC_LINEAR_POSITIVE_DEFINITE_MAPS]; REWRITE_TAC[HOMOTOPIC_SPECIAL_ORTHOGONAL_TRANSFORMATIONS] THEN ASM_REWRITE_TAC[HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS] THEN ONCE_REWRITE_TAC[REAL_EQ_SGN_ABS] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC(REAL_ARITH `(a = &1 \/ a = -- &1) /\ (b = &1 \/ b = -- &1) ==> abs a = abs b`) THEN CONJ_TAC THEN MATCH_MP_TAC DET_ORTHOGONAL_MATRIX THEN ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MATRIX]] THEN UNDISCH_TAC `real_sgn(det(matrix f:real^N^N)) = b` THEN UNDISCH_THEN `real_sgn(det(matrix g:real^N^N)) = b` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN ASM_REWRITE_TAC[DET_MUL; REAL_SGN_MUL] THEN MATCH_MP_TAC(REAL_RING `x = &1 /\ y = &1 ==> a * x = b * y ==> a = b`) THEN ASM_SIMP_TAC[REAL_SGN_EQ; DET_POSITIVE_DEFINITE; real_gt]]);; let HOMOTOPIC_INVERTIBLE_LINEAR_MAPS_ALT = prove (`!f g. homotopic_with (\h. linear h /\ invertible(matrix h)) ((:real^N),(:real^N)) f g <=> linear f /\ linear g /\ &0 < real_sgn(det(matrix f)) * real_sgn(det(matrix g))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `linear f /\ linear g /\ invertible(matrix(f:real^N->real^N)) /\ invertible(matrix(g:real^N->real^N))` THENL [POP_ASSUM MP_TAC THEN REWRITE_TAC[INVERTIBLE_DET_NZ] THEN STRIP_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `~p ==> (q ==> p) /\ (r ==> p) ==> (q <=> r)`)) THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[INVERTIBLE_DET_NZ; DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_SGN_0] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL]]] THEN ASM_REWRITE_TAC[] THEN TRANS_TAC EQ_TRANS `homotopic_with (\h. linear h /\ real_sgn(det(matrix h)) = real_sgn(det(matrix f))) ((:real^N),(:real^N)) f g` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[HOMOTOPIC_RESTRICTED_LINEAR_MAPS] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 REAL_SGN_EQ)] THEN MP_TAC(ISPEC `det(matrix(f:real^N->real^N))` REAL_SGN_CASES) THEN MP_TAC(ISPEC `det(matrix(g:real^N->real^N))` REAL_SGN_CASES) THEN STRIP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN REWRITE_TAC[homotopic_with] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM(CONJUNCT1 REAL_SGN_EQ)] THEN EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM_REWRITE_TAC[REAL_SGN_EQ] THEN X_GEN_TAC `h:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN SUBGOAL_THEN `(\t. lift(det(matrix((h:real^(1,N)finite_sum->real^N) o pastecart t)))) continuous_on interval[vec 0,vec 1]` MP_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN SIMP_TAC[matrix; LAMBDA_BETA; o_THM] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_UNIV]; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONNECTED_CONTINUOUS_IMAGE)) THEN REWRITE_TAC[CONNECTED_INTERVAL] THEN REWRITE_TAC[GSYM CONVEX_CONNECTED_1; CONVEX_CONTAINS_SEGMENT] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; o_DEF] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `t:real^1`) THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> ~(f x = vec 0)) /\ (~P ==> vec 0 IN t) ==> t SUBSET IMAGE f s ==> P`) THEN ASM_SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC] THEN SPEC_TAC(`det(matrix(\x. (h:real^(1,N)finite_sum->real^N) (pastecart t x)))`, `a:real`) THEN SPEC_TAC(`det(matrix(f:real^N->real^N))`,`b:real`) THEN REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1; LIFT_DROP] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let HOMOTOPIC_INVERTIBLE_LINEAR_MAPS = prove (`!f g. homotopic_with (\h. linear h /\ invertible(matrix h)) ((:real^N),(:real^N)) f g <=> linear f /\ linear g /\ &0 < det(matrix f) * det(matrix g)`, REPEAT GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_INVERTIBLE_LINEAR_MAPS_ALT] THEN REWRITE_TAC[GSYM REAL_SGN_MUL; REAL_SGN_INEQS]);; (* ------------------------------------------------------------------------- *) (* "If and only if" variants of unrestricted homotopy characterization *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_LINEAR_MAPS_EQ = prove (`!f g:real^N->real^N. linear f /\ linear g ==> (homotopic_with (\x. T) ((:real^N) DELETE vec 0,(:real^N) DELETE vec 0) f g <=> &0 < det(matrix f) * det(matrix g))`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[HOMOTOPIC_LINEAR_MAPS_ALT] THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `g:real^N->real^N`] HOMOTOPIC_INVERTIBLE_LINEAR_MAPS) THEN ASM_REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET_PCROSS] THEN SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_DELETE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`) THEN ASM_SIMP_TAC[IMP_CONJ; MATRIX_INVERTIBLE] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[I_THM] THEN ASM_MESON_TAC[LINEAR_0]]);; let HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_EQ = prove (`!f g:real^N->real^N. orthogonal_transformation f /\ orthogonal_transformation g ==> (homotopic_with (\x. T) (sphere (vec 0,&1),sphere (vec 0,&1)) f g <=> det(matrix f) = det(matrix g))`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [MATCH_MP_TAC HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_IMP THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC HOMOTOPIC_WITH_MONO THEN EXISTS_TAC `orthogonal_transformation:(real^N->real^N)->bool` THEN SIMP_TAC[HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_SPHERE; REAL_LT_01] THEN ASM_REWRITE_TAC[HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS]]);; let HOMOTOPIC_ANTIPODAL_IDENTITY_MAP = prove (`homotopic_with (\x. T) (sphere(vec 0,&1),sphere(vec 0,&1)) (\x:real^N. --x) (\x. x) <=> EVEN(dimindex(:N))`, SIMP_TAC[HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS_EQ; ORTHOGONAL_TRANSFORMATION_NEG; ORTHOGONAL_TRANSFORMATION_ID] THEN SIMP_TAC[MATRIX_NEG; LINEAR_ID; DET_NEG; MATRIX_ID; DET_I] THEN REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Complex tangent function. *) (* ------------------------------------------------------------------------- *) let ctan = new_definition `ctan z = csin z / ccos z`;; let CTAN_0 = prove (`ctan(Cx(&0)) = Cx(&0)`, REWRITE_TAC[ctan; CSIN_0; CCOS_0; COMPLEX_DIV_1]);; let CTAN_NEG = prove (`!z. ctan(--z) = --(ctan z)`, REWRITE_TAC[ctan; CSIN_NEG; CCOS_NEG; complex_div; COMPLEX_MUL_LNEG]);; let CTAN_ADD = prove (`!w z. ~(ccos(w) = Cx(&0)) /\ ~(ccos(z) = Cx(&0)) /\ ~(ccos(w + z) = Cx(&0)) ==> ctan(w + z) = (ctan w + ctan z) / (Cx(&1) - ctan(w) * ctan(z))`, REPEAT GEN_TAC THEN REWRITE_TAC[ctan; CSIN_ADD; CCOS_ADD] THEN CONV_TAC COMPLEX_FIELD);; let CTAN_DOUBLE = prove (`!z. ~(ccos(z) = Cx(&0)) /\ ~(ccos(Cx(&2) * z) = Cx(&0)) ==> ctan(Cx(&2) * z) = (Cx(&2) * ctan z) / (Cx(&1) - ctan(z) pow 2)`, SIMP_TAC[COMPLEX_MUL_2; CTAN_ADD; COMPLEX_POW_2]);; let CTAN_SUB = prove (`!w z. ~(ccos(w) = Cx(&0)) /\ ~(ccos(z) = Cx(&0)) /\ ~(ccos(w - z) = Cx(&0)) ==> ctan(w - z) = (ctan w - ctan z) / (Cx(&1) + ctan(w) * ctan(z))`, SIMP_TAC[complex_sub; CTAN_ADD; CCOS_NEG; CTAN_NEG] THEN REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG]);; let COMPLEX_ADD_CTAN = prove (`!w z. ~(ccos(w) = Cx(&0)) /\ ~(ccos(z) = Cx(&0)) ==> ctan(w) + ctan(z) = csin(w + z) / (ccos(w) * ccos(z))`, REWRITE_TAC[ctan; CSIN_ADD] THEN CONV_TAC COMPLEX_FIELD);; let COMPLEX_SUB_CTAN = prove (`!w z. ~(ccos(w) = Cx(&0)) /\ ~(ccos(z) = Cx(&0)) ==> ctan(w) - ctan(z) = csin(w - z) / (ccos(w) * ccos(z))`, REWRITE_TAC[ctan; CSIN_SUB] THEN CONV_TAC COMPLEX_FIELD);; (* ------------------------------------------------------------------------- *) (* Analytic properties of tangent function. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_CTAN = prove (`!z. ~(ccos z = Cx(&0)) ==> (ctan has_complex_derivative (inv(ccos(z) pow 2))) (at z)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[ctan] THEN COMPLEX_DIFF_TAC THEN MP_TAC(SPEC `z:complex` CSIN_CIRCLE) THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; let COMPLEX_DIFFERENTIABLE_AT_CTAN = prove (`!z. ~(ccos z = Cx(&0)) ==> ctan complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CTAN]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CTAN = prove (`!s z. ~(ccos z = Cx(&0)) ==> ctan complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CTAN]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN HAS_COMPLEX_DERIVATIVE_CTAN)));; let CONTINUOUS_AT_CTAN = prove (`!z. ~(ccos z = Cx(&0)) ==> ctan continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CTAN; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CTAN = prove (`!s z. ~(ccos z = Cx(&0)) ==> ctan continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CTAN]);; let CONTINUOUS_ON_CTAN = prove (`!s. (!z. z IN s ==> ~(ccos z = Cx(&0))) ==> ctan continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CTAN]);; let HOLOMORPHIC_ON_CTAN = prove (`!s. (!z. z IN s ==> ~(ccos z = Cx(&0))) ==> ctan holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CTAN]);; (* ------------------------------------------------------------------------- *) (* Real tangent function. *) (* ------------------------------------------------------------------------- *) let tan_def = new_definition `tan(x) = Re(ctan(Cx x))`;; let CNJ_CTAN = prove (`!z. cnj(ctan z) = ctan(cnj z)`, REWRITE_TAC[ctan; CNJ_DIV; CNJ_CSIN; CNJ_CCOS]);; let REAL_TAN = prove (`!z. real z ==> real(ctan z)`, SIMP_TAC[REAL_CNJ; CNJ_CTAN]);; let CX_TAN = prove (`!x. Cx(tan x) = ctan(Cx x)`, REWRITE_TAC[tan_def] THEN MESON_TAC[REAL; REAL_CX; REAL_TAN]);; let tan = prove (`!x. tan x = sin x / cos x`, REWRITE_TAC[GSYM CX_INJ; CX_DIV; CX_TAN; CX_SIN; CX_COS; ctan]);; let TAN_0 = prove (`tan(&0) = &0`, REWRITE_TAC[GSYM CX_INJ; CX_TAN; CTAN_0]);; let TAN_PI = prove (`tan(pi) = &0`, REWRITE_TAC[tan; SIN_PI; real_div; REAL_MUL_LZERO]);; let TAN_NPI = prove (`!n. tan(&n * pi) = &0`, REWRITE_TAC[tan; SIN_NPI; real_div; REAL_MUL_LZERO]);; let TAN_NEG = prove (`!x. tan(--x) = --(tan x)`, REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_NEG; CTAN_NEG]);; let TAN_PERIODIC_PI = prove (`!x. tan(x + pi) = tan(x)`, REWRITE_TAC[tan; SIN_PERIODIC_PI; COS_PERIODIC_PI; real_div] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_INV_NEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let TAN_PERIODIC_NPI = prove (`!x n. tan(x + &n * pi) = tan(x)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN ASM_REWRITE_TAC[REAL_ADD_ASSOC; TAN_PERIODIC_PI]);; let TAN_ADD = prove (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) ==> tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y))`, REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CTAN_ADD; CX_DIV; CX_ADD; CX_SUB; CX_MUL]);; let TAN_SUB = prove (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x - y) = &0) ==> tan(x - y) = (tan(x) - tan(y)) / (&1 + tan(x) * tan(y))`, REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CX_ADD; CTAN_SUB; CX_DIV; CX_ADD; CX_SUB; CX_MUL]);; let TAN_DOUBLE = prove (`!x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) ==> tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2))`, SIMP_TAC[REAL_MUL_2; TAN_ADD; REAL_POW_2]);; let REAL_ADD_TAN = prove (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) ==> tan(x) + tan(y) = sin(x + y) / (cos(x) * cos(y))`, REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CX_MUL; CX_ADD; CX_DIV] THEN REWRITE_TAC[COMPLEX_ADD_CTAN]);; let REAL_SUB_TAN = prove (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) ==> tan(x) - tan(y) = sin(x - y) / (cos(x) * cos(y))`, REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CX_MUL; CX_SUB; CX_DIV] THEN REWRITE_TAC[COMPLEX_SUB_CTAN]);; let TAN_PI4 = prove (`tan(pi / &4) = &1`, REWRITE_TAC[tan; SIN_COS; REAL_ARITH `p / &2 - p / &4 = p / &4`] THEN MATCH_MP_TAC REAL_DIV_REFL THEN REWRITE_TAC[COS_EQ_0; PI_NZ; REAL_FIELD `p / &4 = (n + &1 / &2) * p <=> p = &0 \/ n = -- &1 / &4`] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_ABS_INTEGER_LEMMA)) THEN REAL_ARITH_TAC);; let TAN_POS_PI2 = prove (`!x. &0 < x /\ x < pi / &2 ==> &0 < tan x`, REPEAT STRIP_TAC THEN REWRITE_TAC[tan] THEN MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC THENL [MATCH_MP_TAC SIN_POS_PI; MATCH_MP_TAC COS_POS_PI] THEN ASM_REAL_ARITH_TAC);; let TAN_POS_PI2_LE = prove (`!x. &0 <= x /\ x < pi / &2 ==> &0 <= tan x`, REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[TAN_0; TAN_POS_PI2]);; let COS_TAN = prove (`!x. abs(x) < pi / &2 ==> cos(x) = &1 / sqrt(&1 + tan(x) pow 2)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_FIELD `sqrt(s) pow 2 = s /\ c pow 2 * s = &1 /\ ~(&1 + c * sqrt s = &0) ==> c = &1 / sqrt s`) THEN SUBGOAL_THEN `&0 < &1 + tan x pow 2` ASSUME_TAC THENL [MP_TAC(SPEC `tan x` REAL_LE_SQUARE) THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [REWRITE_TAC[tan] THEN MATCH_MP_TAC(REAL_FIELD `s pow 2 + c pow 2 = &1 /\ &0 < c ==> c pow 2 * (&1 + (s / c) pow 2) = &1`) THEN ASM_SIMP_TAC[SIN_CIRCLE; COS_POS_PI; REAL_BOUNDS_LT]; MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(&1 + x = &0)`) THEN ASM_SIMP_TAC[SIN_CIRCLE; COS_POS_PI; REAL_BOUNDS_LT; SQRT_POS_LT; REAL_LT_MUL]]);; let SIN_TAN = prove (`!x. abs(x) < pi / &2 ==> sin(x) = tan(x) / sqrt(&1 + tan(x) pow 2)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a / b = a * &1 / b`] THEN ASM_SIMP_TAC[GSYM COS_TAN] THEN ASM_SIMP_TAC[tan; REAL_DIV_RMUL; REAL_LT_IMP_NZ; COS_POS_PI; REAL_BOUNDS_LT]);; (* ------------------------------------------------------------------------- *) (* Monotonicity theorems for the basic trig functions. *) (* ------------------------------------------------------------------------- *) let SIN_MONO_LT = prove (`!x y. --(pi / &2) <= x /\ x < y /\ y <= pi / &2 ==> sin(x) < sin(y)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN REWRITE_TAC[REAL_SUB_SIN; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC SIN_POS_PI; MATCH_MP_TAC COS_POS_PI] THEN ASM_REAL_ARITH_TAC);; let SIN_MONO_LE = prove (`!x y. --(pi / &2) <= x /\ x <= y /\ y <= pi / &2 ==> sin(x) <= sin(y)`, MESON_TAC[SIN_MONO_LT; REAL_LE_LT]);; let SIN_MONO_LT_EQ = prove (`!x y. --(pi / &2) <= x /\ x <= pi / &2 /\ --(pi / &2) <= y /\ y <= pi / &2 ==> (sin(x) < sin(y) <=> x < y)`, MESON_TAC[REAL_NOT_LE; SIN_MONO_LT; SIN_MONO_LE]);; let SIN_MONO_LE_EQ = prove (`!x y. --(pi / &2) <= x /\ x <= pi / &2 /\ --(pi / &2) <= y /\ y <= pi / &2 ==> (sin(x) <= sin(y) <=> x <= y)`, MESON_TAC[REAL_NOT_LE; SIN_MONO_LT; SIN_MONO_LE]);; let SIN_INJ_PI = prove (`!x y. --(pi / &2) <= x /\ x <= pi / &2 /\ --(pi / &2) <= y /\ y <= pi / &2 /\ sin(x) = sin(y) ==> x = y`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[SIN_MONO_LE_EQ]);; let COS_MONO_LT = prove (`!x y. &0 <= x /\ x < y /\ y <= pi ==> cos(y) < cos(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN REWRITE_TAC[REAL_SUB_COS; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REAL_ARITH_TAC);; let COS_MONO_LE = prove (`!x y. &0 <= x /\ x <= y /\ y <= pi ==> cos(y) <= cos(x)`, MESON_TAC[COS_MONO_LT; REAL_LE_LT]);; let COS_MONO_LT_EQ = prove (`!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi ==> (cos(x) < cos(y) <=> y < x)`, MESON_TAC[REAL_NOT_LE; COS_MONO_LT; COS_MONO_LE]);; let COS_MONO_LE_EQ = prove (`!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi ==> (cos(x) <= cos(y) <=> y <= x)`, MESON_TAC[REAL_NOT_LE; COS_MONO_LT; COS_MONO_LE]);; let COS_INJ_PI = prove (`!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi /\ cos(x) = cos(y) ==> x = y`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[COS_MONO_LE_EQ]);; let REAL_ABS_COS_MONO_LE_EQ = prove (`!x y. abs(x) <= pi / &2 /\ abs(y) <= pi / &2 ==> (abs(cos x) <= abs(cos y) <=> abs y <= abs x)`, MAP_EVERY (fun t -> MATCH_MP_TAC(MESON[REAL_LE_NEGTOTAL] `(!x. P(--x) <=> P x) /\ (!x. &0 <= x ==> P x) ==> !x. P x`) THEN REWRITE_TAC[REAL_ABS_NEG; COS_NEG] THEN X_GEN_TAC t THEN DISCH_TAC) [`x:real`; `y:real`] THEN SIMP_TAC[REWRITE_RULE[REAL_BOUNDS_LE] COS_POS_PI_LE; REAL_ARITH `&0 <= cos x ==> abs(cos x) = cos x`] THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC COS_MONO_LE_EQ THEN ASM_REAL_ARITH_TAC);; let TAN_MONO_LT = prove (`!x y. --(pi / &2) < x /\ x < y /\ y < pi / &2 ==> tan(x) < tan(y)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM REAL_SUB_LT] THEN SUBGOAL_THEN `&0 < cos(x) /\ &0 < cos(y)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC COS_POS_PI; ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_SUB_TAN] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN MATCH_MP_TAC SIN_POS_PI] THEN ASM_REAL_ARITH_TAC);; let TAN_MONO_LE = prove (`!x y. --(pi / &2) < x /\ x <= y /\ y < pi / &2 ==> tan(x) <= tan(y)`, REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[TAN_MONO_LT]);; let TAN_MONO_LT_EQ = prove (`!x y. --(pi / &2) < x /\ x < pi / &2 /\ --(pi / &2) < y /\ y < pi / &2 ==> (tan(x) < tan(y) <=> x < y)`, MESON_TAC[REAL_NOT_LE; TAN_MONO_LT; TAN_MONO_LE]);; let TAN_MONO_LE_EQ = prove (`!x y. --(pi / &2) < x /\ x < pi / &2 /\ --(pi / &2) < y /\ y < pi / &2 ==> (tan(x) <= tan(y) <=> x <= y)`, MESON_TAC[REAL_NOT_LE; TAN_MONO_LT; TAN_MONO_LE]);; let TAN_BOUND_PI2 = prove (`!x. abs(x) < pi / &4 ==> abs(tan x) < &1`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM TAN_PI4] THEN REWRITE_TAC[GSYM TAN_NEG; REAL_ARITH `abs(x) < a <=> --a < x /\ x < a`] THEN CONJ_TAC THEN MATCH_MP_TAC TAN_MONO_LT THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let TAN_COT = prove (`!x. tan(pi / &2 - x) = inv(tan x)`, REWRITE_TAC[tan; SIN_SUB; COS_SUB; SIN_PI2; COS_PI2; REAL_INV_DIV] THEN GEN_TAC THEN BINOP_TAC THEN REAL_ARITH_TAC);; let REAL_ABS_SIN_BOUND_LT = prove (`!x. ~(x = &0) ==> abs(sin x) < abs x`, MATCH_MP_TAC(MESON[SIN_NEG; REAL_ABS_NEG; REAL_LT_NEGTOTAL] `(!x. &0 < x ==> abs(sin x) < abs x) ==> !x. ~(x = &0) ==> abs(sin x) < abs x`) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `a < x ==> a < abs x`) THEN MATCH_MP_TAC(REAL_ARITH `abs s <= &1 /\ (x <= &1 ==> abs(s) < x) ==> abs s < x`) THEN REWRITE_TAC[SIN_BOUND] THEN DISCH_TAC THEN MP_TAC(SPECL [`1`; `Cx x`] TAYLOR_CSIN) THEN REWRITE_TAC[num_CONV `1`; VSUM_CLAUSES_NUMSEG; IM_CX] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_ABS_NUM; REAL_EXP_0; COMPLEX_POW_1; complex_pow; COMPLEX_DIV_1] THEN REWRITE_TAC[GSYM CX_SIN; GSYM CX_MUL; GSYM CX_NEG; GSYM CX_POW; GSYM CX_DIV; GSYM CX_SUB; GSYM CX_ADD; REAL_MUL_LID; COMPLEX_NORM_CX] THEN MATCH_MP_TAC(REAL_ARITH `a < x /\ e < a ==> abs(s - (x + -- &1 * a)) <= e ==> abs s < x`) THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 < y /\ x <= y pow 1 ==> x / &6 < y`); MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x <= y ==> x / &24 < y / &6`)] THEN ASM_SIMP_TAC[REAL_POW_LT] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REAL_ARITH_TAC);; let REAL_ABS_SIN_BOUND_LE = prove (`!x. abs(sin x) <= abs x`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[REAL_ABS_SIN_BOUND_LT; REAL_LT_IMP_LE; SIN_0; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Approximation to pi. *) (* ------------------------------------------------------------------------- *) let SIN_PI6_STRADDLE = prove (`!a b. &0 <= a /\ a <= b /\ b <= &4 /\ sin(a / &6) <= &1 / &2 /\ &1 / &2 <= sin(b / &6) ==> a <= pi /\ pi <= b`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPECL [`pi / &6`; `b / &6`] SIN_MONO_LE_EQ) THEN MP_TAC(SPECL [`a / &6`; `pi / &6`] SIN_MONO_LE_EQ) THEN ASM_REWRITE_TAC[SIN_PI6] THEN SUBGOAL_THEN `!x. &0 < x /\ x < &7 / &5 ==> &0 < sin x` MP_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`0`; `Cx(x)`] TAYLOR_CSIN) THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_DIV_1; COMPLEX_POW_1; complex_pow] THEN REWRITE_TAC[COMPLEX_MUL_LID; GSYM CX_SIN; GSYM CX_SUB] THEN REWRITE_TAC[IM_CX; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_EXP_0] THEN MATCH_MP_TAC(REAL_ARITH `e + d < a ==> abs(s - a) <= d ==> e < s`) THEN ASM_SIMP_TAC[real_abs; real_pow; REAL_MUL_LID; REAL_LT_IMP_LE] THEN SIMP_TAC[REAL_ARITH `&0 + x pow 3 / &2 < x <=> x * x pow 2 < x * &2`] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `(&7 / &5) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT2; ARITH_EQ; REAL_LT_IMP_LE] THEN CONV_TAC REAL_RAT_REDUCE_CONV; DISCH_THEN(MP_TAC o SPEC `pi`) THEN SIMP_TAC[SIN_PI; REAL_LT_REFL; PI_POS; REAL_NOT_LT] THEN ASM_REAL_ARITH_TAC]);; let PI_APPROX_32 = prove (`abs(pi - &13493037705 / &4294967296) <= inv(&2 pow 32)`, REWRITE_TAC[REAL_ARITH `abs(x - a) <= e <=> a - e <= x /\ x <= a + e`] THEN MATCH_MP_TAC SIN_PI6_STRADDLE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL [MP_TAC(SPECL [`5`; `Cx(&1686629713 / &3221225472)`] TAYLOR_CSIN); MP_TAC(SPECL [`5`; `Cx(&6746518853 / &12884901888)`] TAYLOR_CSIN)] THEN SIMP_TAC[COMPLEX_NORM_CX; GSYM CX_POW; GSYM CX_DIV; GSYM CX_MUL; GSYM CX_NEG; VSUM_CX; FINITE_NUMSEG; GSYM CX_SIN; GSYM CX_SUB] THEN REWRITE_TAC[IM_CX; REAL_ABS_NUM; REAL_EXP_0] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; GSYM REAL_POW_POW] THEN REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_MUL; real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN CONV_TAC(ONCE_DEPTH_CONV HORNER_SUM_CONV) THEN REAL_ARITH_TAC);; let PI2_BOUNDS = prove (`&0 < pi / &2 /\ pi / &2 < &2`, MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Complex logarithms (the conventional principal value). *) (* ------------------------------------------------------------------------- *) let clog = new_definition `clog z = @w. cexp(w) = z /\ --pi < Im(w) /\ Im(w) <= pi`;; let EXISTS_COMPLEX' = prove (`!P. (?z. P (Re z) (Im z)) <=> ?x y. P x y`, MESON_TAC[RE; IM; COMPLEX]);; let CLOG_WORKS = prove (`!z. ~(z = Cx(&0)) ==> cexp(clog z) = z /\ --pi < Im(clog z) /\ Im(clog z) <= pi`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[clog] THEN CONV_TAC SELECT_CONV THEN MP_TAC(SPEC `z / Cx(norm z)` COMPLEX_UNIMODULAR_POLAR) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN ASM_SIMP_TAC[REAL_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `x:real` SINCOS_PRINCIPAL_VALUE) THEN DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `complex(log(norm(z:complex)),y)` THEN ASM_REWRITE_TAC[RE; IM; CEXP_COMPLEX] THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN ASM_SIMP_TAC[EXP_LOG; COMPLEX_NORM_NZ; COMPLEX_DIV_LMUL; COMPLEX_NORM_ZERO; CX_INJ]);; let CEXP_CLOG = prove (`!z. ~(z = Cx(&0)) ==> cexp(clog z) = z`, SIMP_TAC[CLOG_WORKS]);; let CLOG_CEXP = prove (`!z. --pi < Im(z) /\ Im(z) <= pi ==> clog(cexp z) = z`, REPEAT STRIP_TAC THEN REWRITE_TAC[clog] THEN MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `w:complex` THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[CEXP_EQ] THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_LZERO] THEN SUBGOAL_THEN `abs(n * pi) < &1 * pi` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LT_RMUL_EQ; PI_POS; REAL_ABS_PI] THEN ASM_MESON_TAC[REAL_ABS_INTEGER_LEMMA; REAL_NOT_LT]);; let CLOG_EQ = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> (clog w = clog z <=> w = z)`, MESON_TAC[CEXP_CLOG]);; let CLOG_UNIQUE = prove (`!w z. --pi < Im(z) /\ Im(z) <= pi /\ cexp(z) = w ==> clog w = z`, MESON_TAC[CLOG_CEXP]);; let RE_CLOG = prove (`!z. ~(z = Cx(&0)) ==> Re(clog z) = log(norm z)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o AP_TERM `norm:complex->real` o MATCH_MP CEXP_CLOG) THEN REWRITE_TAC[NORM_CEXP] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[LOG_EXP]);; let EXISTS_COMPLEX_ROOT = prove (`!a n. ~(n = 0) ==> ?z. z pow n = a`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a = Cx(&0)` THENL [EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_POW_ZERO]; EXISTS_TAC `cexp(clog(a) / Cx(&n))` THEN REWRITE_TAC[GSYM CEXP_N] THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ; CEXP_CLOG]]);; (* ------------------------------------------------------------------------- *) (* Derivative of clog away from the branch cut. *) (* ------------------------------------------------------------------------- *) let HAS_COMPLEX_DERIVATIVE_CLOG = prove (`!z. (Im(z) = &0 ==> &0 < Re(z)) ==> (clog has_complex_derivative inv(z)) (at z)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X THEN EXISTS_TAC `cexp` THEN EXISTS_TAC `{w | --pi < Im(w) /\ Im(w) < pi}` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `z = Cx(&0)` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CEXP; CEXP_CLOG; CLOG_CEXP; REAL_LT_IMP_LE] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN MATCH_MP_TAC OPEN_INTER THEN REWRITE_TAC[REAL_ARITH `--x < w <=> w > --x`] THEN REWRITE_TAC[OPEN_HALFSPACE_IM_LT; OPEN_HALFSPACE_IM_GT]; ASM_SIMP_TAC[CLOG_WORKS]; ASM_SIMP_TAC[CLOG_WORKS; REAL_LT_LE] THEN DISCH_THEN(fun th -> FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o MATCH_MP CEXP_CLOG) THEN POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN ASM_REWRITE_TAC[EULER; COS_PI; SIN_PI; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[COMPLEX_ADD_RID; CX_NEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[COMPLEX_MUL_RID; IM_NEG; IM_CX; RE_NEG; RE_CX] THEN MP_TAC(SPEC `Re(clog z)` REAL_EXP_POS_LT) THEN REAL_ARITH_TAC; ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_CEXP; CEXP_CLOG]]);; let COMPLEX_DIFFERENTIABLE_AT_CLOG = prove (`!z. (Im(z) = &0 ==> &0 < Re(z)) ==> clog complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CLOG]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CLOG = prove (`!s z. (Im(z) = &0 ==> &0 < Re(z)) ==> clog complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CLOG]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN HAS_COMPLEX_DERIVATIVE_CLOG)));; let CONTINUOUS_AT_CLOG = prove (`!z. (Im(z) = &0 ==> &0 < Re(z)) ==> clog continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CLOG; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CLOG = prove (`!s z. (Im(z) = &0 ==> &0 < Re(z)) ==> clog continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CLOG]);; let CONTINUOUS_ON_CLOG = prove (`!s. (!z. z IN s /\ Im(z) = &0 ==> &0 < Re(z)) ==> clog continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CLOG]);; let HOLOMORPHIC_ON_CLOG = prove (`!s. (!z. z IN s /\ Im(z) = &0 ==> &0 < Re(z)) ==> clog holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CLOG]);; (* ------------------------------------------------------------------------- *) (* Relation to real log. *) (* ------------------------------------------------------------------------- *) let CX_LOG = prove (`!z. &0 < z ==> Cx(log z) = clog(Cx z)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM(MATCH_MP EXP_LOG th)]) THEN REWRITE_TAC[CX_EXP] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_CX] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Quadrant-type results for clog. *) (* ------------------------------------------------------------------------- *) let RE_CLOG_POS_LT = prove (`!z. ~(z = Cx(&0)) ==> (abs(Im(clog z)) < pi / &2 <=> &0 < Re(z))`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) MP_TAC) THEN SIMP_TAC[RE_CEXP; REAL_LT_MUL_EQ; REAL_EXP_POS_LT] THEN SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--p < x /\ x <= p ==> --(p / &2) < x /\ x < p / &2 \/ --(p / &2) <= p + x /\ p + x <= p / &2 \/ --(p / &2) <= x - p /\ x - p <= p / &2`)) THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN (FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI) ORELSE FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI_LE)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[COS_ADD; COS_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC);; let RE_CLOG_POS_LE = prove (`!z. ~(z = Cx(&0)) ==> (abs(Im(clog z)) <= pi / &2 <=> &0 <= Re(z))`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) MP_TAC) THEN SIMP_TAC[RE_CEXP; REAL_LE_MUL_EQ; REAL_EXP_POS_LT] THEN SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--p < x /\ x <= p ==> --(p / &2) <= x /\ x <= p / &2 \/ --(p / &2) < p + x /\ p + x < p / &2 \/ --(p / &2) < x - p /\ x - p < p / &2`)) THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN (FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI) ORELSE FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI_LE)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[COS_ADD; COS_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC);; let IM_CLOG_POS_LT = prove (`!z. ~(z = Cx(&0)) ==> (&0 < Im(clog z) /\ Im(clog z) < pi <=> &0 < Im(z))`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) MP_TAC) THEN SIMP_TAC[IM_CEXP; REAL_LT_MUL_EQ; REAL_EXP_POS_LT] THEN SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--p < x /\ x <= p ==> &0 < x /\ x < p \/ &0 <= x + p /\ x + p <= p \/ &0 <= x - p /\ x - p <= p`)) THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN (FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI) ORELSE FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI_LE)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[SIN_ADD; SIN_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC);; let IM_CLOG_POS_LE = prove (`!z. ~(z = Cx(&0)) ==> (&0 <= Im(clog z) <=> &0 <= Im(z))`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN DISCH_THEN(CONJUNCTS_THEN2 (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) MP_TAC) THEN SIMP_TAC[IM_CEXP; REAL_LE_MUL_EQ; REAL_EXP_POS_LT] THEN SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--p < x /\ x <= p ==> &0 <= x /\ x <= p \/ &0 < x + p /\ x + p < p \/ &0 < p - x /\ p - x < p`)) THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN (FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI) ORELSE FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI_LE)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[SIN_ADD; SIN_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC);; let RE_CLOG_POS_LT_IMP = prove (`!z. &0 < Re(z) ==> abs(Im(clog z)) < pi / &2`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_SIMP_TAC[RE_CLOG_POS_LT; RE_CX; REAL_LT_REFL]);; let IM_CLOG_POS_LT_IMP = prove (`!z. &0 < Im(z) ==> &0 < Im(clog z) /\ Im(clog z) < pi`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_SIMP_TAC[IM_CLOG_POS_LT; IM_CX; REAL_LT_REFL]);; let IM_CLOG_EQ_0 = prove (`!z. ~(z = Cx(&0)) ==> (Im(clog z) = &0 <=> &0 < Re(z) /\ Im(z) = &0)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_ARITH `z = &0 <=> &0 <= z /\ ~(&0 < z)`] THEN ASM_SIMP_TAC[GSYM RE_CLOG_POS_LT; GSYM IM_CLOG_POS_LE; GSYM IM_CLOG_POS_LT] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let IM_CLOG_EQ_PI = prove (`!z. ~(z = Cx(&0)) ==> (Im(clog z) = pi <=> Re(z) < &0 /\ Im(z) = &0)`, SIMP_TAC[PI_POS; RE_CLOG_POS_LE; IM_CLOG_POS_LE; IM_CLOG_POS_LT; CLOG_WORKS; REAL_ARITH `&0 < pi ==> (x = pi <=> (&0 <= x /\ x <= pi) /\ ~(abs x <= pi / &2) /\ ~(&0 < x /\ x < pi))`] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Various properties. *) (* ------------------------------------------------------------------------- *) let CNJ_CLOG = prove (`!z. (Im z = &0 ==> &0 < Re z) ==> cnj(clog z) = clog(cnj z)`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL] THEN DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN REWRITE_TAC[GSYM CNJ_CEXP] THEN ASM_SIMP_TAC[CEXP_CLOG; CNJ_EQ_CX; IM_CNJ] THEN MATCH_MP_TAC(REAL_ARITH `(--p < x /\ x <= p) /\ (--p < y /\ y <= p) /\ ~(x = p /\ y = p) ==> abs(--x - y) < &2 * p`) THEN ASM_SIMP_TAC[IM_CLOG_EQ_PI; CNJ_EQ_CX; CLOG_WORKS] THEN ASM_REAL_ARITH_TAC);; let CLOG_INV = prove (`!z. (Im(z) = &0 ==> &0 < Re z) ==> clog(inv z) = --(clog z)`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN ASM_SIMP_TAC[CEXP_CLOG; CEXP_NEG; COMPLEX_INV_EQ_0] THEN REWRITE_TAC[IM_NEG; REAL_SUB_RNEG] THEN MATCH_MP_TAC(REAL_ARITH `--pi < x /\ x <= pi /\ --pi < y /\ y <= pi /\ ~(x = pi /\ y = pi) ==> abs(x + y) < &2 * pi`) THEN ASM_SIMP_TAC[CLOG_WORKS; COMPLEX_INV_EQ_0; IM_CLOG_EQ_PI] THEN UNDISCH_TAC `Im z = &0 ==> &0 < Re z` THEN ASM_CASES_TAC `Im z = &0` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let CLOG_1 = prove (`clog(Cx(&1)) = Cx(&0)`, REWRITE_TAC[GSYM CEXP_0] THEN MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_CX] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let CLOG_NEG_1 = prove (`clog(--Cx(&1)) = ii * Cx pi`, MATCH_MP_TAC COMPLEX_EQ_CEXP THEN REWRITE_TAC[GSYM CX_NEG] THEN SIMP_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN; IM_MUL_II; IM_CX; RE_CX] THEN REWRITE_TAC[COS_PI; SIN_PI; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN SIMP_TAC[CLOG_WORKS; COMPLEX_RING `~(Cx(-- &1) = Cx(&0))`; REAL_ARITH `--pi < x /\ x <= pi ==> abs(x - pi) < &2 * pi`]);; let CLOG_II = prove (`clog ii = ii * Cx(pi / &2)`, MP_TAC(SPEC `ii * Cx(pi / &2)` CLOG_CEXP) THEN SIMP_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN; IM_MUL_II; IM_CX; RE_CX] THEN REWRITE_TAC[COS_PI2; SIN_PI2] THEN ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_MUL_RID]]);; let CLOG_NEG_II = prove (`clog(--ii) = --ii * Cx(pi / &2)`, GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_FIELD `--ii = inv ii`] THEN SIMP_TAC[CLOG_INV; RE_II; IM_II; REAL_OF_NUM_EQ; ARITH; CLOG_II] THEN REWRITE_TAC[COMPLEX_MUL_LNEG]);; (* ------------------------------------------------------------------------- *) (* Relation between square root and exp/log, and hence its derivative. *) (* ------------------------------------------------------------------------- *) let CSQRT_CEXP_CLOG = prove (`!z. ~(z = Cx(&0)) ==> csqrt z = cexp(clog(z) / Cx(&2))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CSQRT_UNIQUE THEN REWRITE_TAC[GSYM CEXP_N; RE_CEXP; IM_CEXP] THEN ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ; ARITH; CEXP_CLOG] THEN SIMP_TAC[REAL_LT_MUL_EQ; REAL_EXP_POS_LT; REAL_LE_MUL_EQ] THEN REWRITE_TAC[REAL_ENTIRE; REAL_EXP_NZ; IM_DIV_CX] THEN FIRST_ASSUM(STRIP_ASSUME_TAC o CONJUNCT2 o MATCH_MP CLOG_WORKS) THEN FIRST_X_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL [DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI THEN ASM_REAL_ARITH_TAC; DISJ2_TAC THEN ASM_REWRITE_TAC[COS_PI2; SIN_PI2; REAL_POS]]);; let CNJ_CSQRT = prove (`!z. (Im z = &0 ==> &0 <= Re(z)) ==> cnj(csqrt z) = csqrt(cnj z)`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[CSQRT_0; CNJ_CX] THEN DISCH_TAC THEN SUBGOAL_THEN `Im z = &0 ==> &0 < Re(z)` ASSUME_TAC THENL [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[COMPLEX_EQ; IM_CX; RE_CX] THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL] THEN ASM_SIMP_TAC[CSQRT_CEXP_CLOG; CNJ_CEXP; CNJ_CLOG; CNJ_DIV; CNJ_EQ_CX; CNJ_CX]]);; let HAS_COMPLEX_DERIVATIVE_CSQRT = prove (`!z. (Im z = &0 ==> &0 < Re(z)) ==> (csqrt has_complex_derivative inv(Cx(&2) * csqrt z)) (at z)`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[IM_CX; RE_CX; REAL_LT_REFL] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\z. cexp(clog(z) / Cx(&2))`; `norm(z:complex)`] THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CSQRT_CEXP_CLOG THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; COMPLEX_DIFF_TAC THEN ASM_SIMP_TAC[GSYM CSQRT_CEXP_CLOG] THEN UNDISCH_TAC `~(z = Cx(&0))` THEN MP_TAC(SPEC `z:complex` CSQRT) THEN CONV_TAC COMPLEX_FIELD]);; let COMPLEX_DIFFERENTIABLE_AT_CSQRT = prove (`!z. (Im z = &0 ==> &0 < Re(z)) ==> csqrt complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSQRT]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CSQRT = prove (`!s z. (Im z = &0 ==> &0 < Re(z)) ==> csqrt complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CSQRT]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN HAS_COMPLEX_DERIVATIVE_CSQRT)));; let CONTINUOUS_AT_CSQRT = prove (`!z. (Im z = &0 ==> &0 < Re(z)) ==> csqrt continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSQRT; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CSQRT = prove (`!s z. (Im z = &0 ==> &0 < Re(z)) ==> csqrt continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CSQRT]);; let CONTINUOUS_ON_CSQRT = prove (`!s. (!z. z IN s /\ Im z = &0 ==> &0 < Re(z)) ==> csqrt continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CSQRT]);; let HOLOMORPHIC_ON_CSQRT = prove (`!s. (!z. z IN s /\ Im(z) = &0 ==> &0 < Re(z)) ==> csqrt holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CSQRT]);; let CONTINUOUS_WITHIN_CSQRT_POSREAL = prove (`!z. csqrt continuous (at z within {w | real w /\ &0 <= Re(w)})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `Im z = &0 ==> &0 < Re(z)` THENL [ASM_SIMP_TAC[CONTINUOUS_WITHIN_CSQRT]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN REWRITE_TAC[REAL_ARITH `x <= &0 <=> x < &0 \/ x = &0`] THEN STRIP_TAC THENL [MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_REAL_SET; CLOSED_INTER; IN_INTER; IN_ELIM_THM; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE] THEN ASM_REAL_ARITH_TAC; SUBGOAL_THEN `z = Cx(&0)` SUBST_ALL_TAC THENL [ASM_REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX]; ALL_TAC] THEN REWRITE_TAC[continuous_within] THEN REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_REAL; RE_CX] THEN SIMP_TAC[GSYM CX_SQRT; REAL_LE_REFL] THEN SIMP_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX; SQRT_0; REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `(e:real) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL [ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; ASM_SIMP_TAC[real_abs; SQRT_POS_LE]] THEN MATCH_MP_TAC SQRT_MONO_LT THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Complex powers. *) (* ------------------------------------------------------------------------- *) parse_as_infix("cpow",(24,"left"));; let cpow = new_definition `w cpow z = if w = Cx(&0) then Cx(&0) else cexp(z * clog w)`;; let CPOW_0 = prove (`!z. Cx(&0) cpow z = Cx(&0)`, REWRITE_TAC[cpow]);; let CPOW_N = prove (`!z. z cpow (Cx(&n)) = if z = Cx(&0) then Cx(&0) else z pow n`, GEN_TAC THEN REWRITE_TAC[cpow] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CEXP_N; CEXP_CLOG]);; let CPOW_1 = prove (`!z. Cx(&1) cpow z = Cx(&1)`, REWRITE_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; CLOG_1] THEN REWRITE_TAC[CEXP_0; COMPLEX_MUL_RZERO]);; let CPOW_ADD = prove (`!w z1 z2. w cpow (z1 + z2) = w cpow z1 * w cpow z2`, REPEAT GEN_TAC THEN REWRITE_TAC[cpow] THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO] THEN REWRITE_TAC[COMPLEX_ADD_RDISTRIB; CEXP_ADD]);; let CPOW_SUC = prove (`!w z. w cpow (z + Cx(&1)) = w * w cpow z`, REPEAT GEN_TAC THEN REWRITE_TAC[CPOW_ADD; CPOW_N] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_MUL_SYM]);; let CPOW_NEG = prove (`!w z. w cpow (--z) = inv(w cpow z)`, REPEAT GEN_TAC THEN REWRITE_TAC[cpow] THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_INV_0] THEN REWRITE_TAC[COMPLEX_MUL_LNEG; CEXP_NEG]);; let CPOW_SUB = prove (`!w z1 z2. w cpow (z1 - z2) = w cpow z1 / w cpow z2`, REWRITE_TAC[complex_sub; complex_div; CPOW_ADD; CPOW_NEG]);; let CEXP_MUL_CPOW = prove (`!w z. --pi < Im w /\ Im w <= pi ==> cexp(w * z) = cexp(w) cpow z`, SIMP_TAC[cpow; CEXP_NZ; CLOG_CEXP] THEN REWRITE_TAC[COMPLEX_MUL_SYM]);; let CPOW_EQ_0 = prove (`!w z. w cpow z = Cx(&0) <=> w = Cx(&0)`, REPEAT GEN_TAC THEN REWRITE_TAC[cpow] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CEXP_NZ]);; let NORM_CPOW_REAL = prove (`!w z. real w /\ &0 < Re w ==> norm(w cpow z) = exp(Re z * log(Re w))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL]) THEN RULE_ASSUM_TAC(REWRITE_RULE[RE_CX]) THEN ASM_SIMP_TAC[cpow; CX_INJ; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[NORM_CEXP; GSYM CX_LOG; RE_MUL_CX; RE_CX]);; let CPOW_REAL_REAL = prove (`!w z. real w /\ real z /\ &0 < Re w ==> w cpow z = Cx(exp(Re z * log(Re w)))`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL])) THEN RULE_ASSUM_TAC(REWRITE_RULE[RE_CX]) THEN ASM_SIMP_TAC[cpow; CX_INJ; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[NORM_CEXP; GSYM CX_LOG; RE_MUL_CX; RE_CX; CX_EXP; CX_MUL]);; let NORM_CPOW_REAL_MONO = prove (`!w z1 z2. real w /\ &1 < Re w ==> (norm(w cpow z1) <= norm(w cpow z2) <=> Re(z1) <= Re(z2))`, SIMP_TAC[NORM_CPOW_REAL; REAL_ARITH `&1 < x ==> &0 < x`] THEN SIMP_TAC[REAL_EXP_MONO_LE; REAL_LE_RMUL_EQ; LOG_POS_LT]);; let CPOW_MUL_REAL = prove (`!x y z. real x /\ real y /\ &0 <= Re x /\ &0 <= Re y ==> (x * y) cpow z = x cpow z * y cpow z`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL])) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[RE_CX; IM_CX] THEN REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; CPOW_0] THEN ASM_SIMP_TAC[cpow; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN REWRITE_TAC[GSYM CEXP_ADD; GSYM COMPLEX_ADD_LDISTRIB] THEN ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_ADD; GSYM CX_MUL; REAL_LT_MUL] THEN ASM_SIMP_TAC[LOG_MUL]);; let HAS_COMPLEX_DERIVATIVE_CPOW = prove (`!s z. (Im z = &0 ==> &0 < Re z) ==> ((\z. z cpow s) has_complex_derivative (s * z cpow (s - Cx(&1)))) (at z)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[IM_CX; RE_CX; REAL_LT_REFL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[cpow] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN MAP_EVERY EXISTS_TAC [`\z. cexp (s * clog z)`; `norm(z:complex)`] THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN CONJ_TAC THENL [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; REAL_LT_REFL]; COMPLEX_DIFF_TAC THEN ASM_REWRITE_TAC[CEXP_SUB; COMPLEX_SUB_RDISTRIB] THEN ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_MUL_LID] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (GEN `s:complex` (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN (SPEC `s:complex` HAS_COMPLEX_DERIVATIVE_CPOW)))));; let HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT = prove (`!w z. ~(w = Cx(&0)) ==> ((\z. w cpow z) has_complex_derivative clog(w) * w cpow z) (at z)`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[cpow] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (GEN `s:complex` (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN (SPEC `s:complex` HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT)))));; let COMPLEX_DIFFERENTIABLE_CPOW_RIGHT = prove (`!w z. (\z. w cpow z) complex_differentiable (at z)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `w = Cx(&0)` THENL [ASM_REWRITE_TAC[cpow; COMPLEX_DIFFERENTIABLE_CONST]; REWRITE_TAC[complex_differentiable] THEN ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT]]);; let HOLOMORPHIC_ON_CPOW_RIGHT = prove (`!w f s. f holomorphic_on s ==> (\z. w cpow (f z)) holomorphic_on s`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_CPOW_RIGHT; COMPLEX_DIFFERENTIABLE_AT_WITHIN]);; let CONTINUOUS_ON_CPOW_RIGHT = prove (`!w f s. f continuous_on s ==> (\z. w cpow (f z)) continuous_on s`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_CPOW_RIGHT; COMPLEX_DIFFERENTIABLE_AT_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Product rule. *) (* ------------------------------------------------------------------------- *) let CLOG_MUL = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> clog(w * z) = if Im(clog w + clog z) <= --pi then (clog(w) + clog(z)) + ii * Cx(&2 * pi) else if Im(clog w + clog z) > pi then (clog(w) + clog(z)) - ii * Cx(&2 * pi) else clog(w) + clog(z)`, REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN MATCH_MP_TAC CLOG_UNIQUE THEN ASM_SIMP_TAC[CEXP_ADD; CEXP_SUB; CEXP_EULER; CEXP_CLOG; CONJ_ASSOC; GSYM CX_SIN; GSYM CX_COS; COS_NPI; SIN_NPI] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN TRY(CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOG_WORKS)) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IM_ADD; IM_SUB; IM_MUL_II; RE_CX] THEN REAL_ARITH_TAC);; let CLOG_MUL_SIMPLE = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) /\ --pi < Im(clog(w)) + Im(clog(z)) /\ Im(clog(w)) + Im(clog(z)) <= pi ==> clog(w * z) = clog(w) + clog(z)`, SIMP_TAC[CLOG_MUL; IM_ADD] THEN REAL_ARITH_TAC);; let CLOG_MUL_CX = prove (`(!x z. &0 < x /\ ~(z = Cx(&0)) ==> clog(Cx x * z) = Cx(log x) + clog z) /\ (!x z. &0 < x /\ ~(z = Cx(&0)) ==> clog(z * Cx x) = clog z + Cx(log x))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CX_LOG] THEN MATCH_MP_TAC CLOG_MUL_SIMPLE THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; GSYM CX_LOG] THEN ASM_SIMP_TAC[IM_CX; REAL_ADD_LID; REAL_ADD_RID; CLOG_WORKS]);; let CLOG_MUL_POS = prove (`!w z. &0 < Re w /\ &0 < Re z ==> clog(w * z) = clog w + clog z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOG_MUL_SIMPLE THEN MATCH_MP_TAC(TAUT `(p /\ q) /\ (p /\ q ==> r) ==> p /\ q /\ r`) THEN CONJ_TAC THENL [ASM_MESON_TAC[RE_CX; REAL_LT_REFL]; STRIP_TAC] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) < pi / &2 /\ abs(y) < pi / &2 ==> --pi < x + y /\ x + y <= pi`) THEN ASM_SIMP_TAC[RE_CLOG_POS_LT]);; let CLOG_DIV_POS = prove (`!w z. &0 < Re w /\ &0 < Re z ==> clog(w / z) = clog w - clog z`, ASM_SIMP_TAC[complex_div; CLOG_MUL_POS; CLOG_INV; RE_COMPLEX_INV_GT_0] THEN REWRITE_TAC[complex_sub]);; let CLOG_NEG = prove (`!z. ~(z = Cx(&0)) ==> clog(--z) = if Im(z) <= &0 /\ ~(Re(z) < &0 /\ Im(z) = &0) then clog(z) + ii * Cx(pi) else clog(z) - ii * Cx(pi)`, REPEAT STRIP_TAC THEN SUBST1_TAC(SIMPLE_COMPLEX_ARITH `--z = --Cx(&1) * z`) THEN ASM_SIMP_TAC[CLOG_MUL; COMPLEX_RING `~(--Cx(&1) = Cx(&0))`] THEN REWRITE_TAC[CLOG_NEG_1; IM_ADD; IM_MUL_II; RE_CX] THEN ASM_SIMP_TAC[CLOG_WORKS; REAL_ARITH `--p < x /\ x <= p ==> ~(p + x <= --p)`] THEN REWRITE_TAC[REAL_ARITH `p + x > p <=> &0 < x`] THEN ASM_SIMP_TAC[GSYM IM_CLOG_EQ_PI] THEN ONCE_REWRITE_TAC[REAL_ARITH `Im z <= &0 <=> ~(&0 < Im z)`] THEN ASM_SIMP_TAC[GSYM IM_CLOG_POS_LT] THEN ASM_SIMP_TAC[CLOG_WORKS; REAL_ARITH `x <= p ==> (x < p <=> ~(x = p))`] THEN REWRITE_TAC[TAUT `~(a /\ ~b) /\ ~b <=> ~a /\ ~b`] THEN ASM_CASES_TAC `Im(clog z) = pi` THEN ASM_REWRITE_TAC[PI_POS] THEN ASM_CASES_TAC `&0 < Im(clog z)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CX_MUL] THEN CONV_TAC COMPLEX_RING);; let CLOG_MUL_II = prove (`!z. ~(z = Cx(&0)) ==> clog(ii * z) = if &0 <= Re(z) \/ Im(z) < &0 then clog(z) + ii * Cx(pi / &2) else clog(z) - ii * Cx(&3 * pi / &2)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOG_MUL; II_NZ; CLOG_II] THEN REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX] THEN ASM_SIMP_TAC[CLOG_WORKS; REAL_ARITH `--p < x /\ x <= p ==> ~(p / &2 + x <= --p)`] THEN REWRITE_TAC[REAL_ARITH `p / &2 + x > p <=> p / &2 < x`] THEN REWRITE_TAC[REAL_ARITH `Im z < &0 <=> ~(&0 <= Im z)`] THEN ASM_SIMP_TAC[GSYM RE_CLOG_POS_LE; GSYM IM_CLOG_POS_LE] THEN MATCH_MP_TAC(MESON[] `(p <=> ~q) /\ x = a /\ y = b ==> ((if p then x else y) = (if q then b else a))`) THEN CONJ_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; REWRITE_TAC[CX_MUL; CX_DIV] THEN CONV_TAC COMPLEX_RING]);; (* ------------------------------------------------------------------------- *) (* Unwinding number gives another version of log-product formula. *) (* Note that in this special case the unwinding number is -1, 0 or 1. *) (* ------------------------------------------------------------------------- *) let unwinding = new_definition `unwinding(z) = (z - clog(cexp z)) / (Cx(&2 * pi) * ii)`;; let UNWINDING_2PI = prove (`Cx(&2 * pi) * ii * unwinding(z) = z - clog(cexp z)`, REWRITE_TAC[unwinding; COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC COMPLEX_DIV_LMUL THEN REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; II_NZ] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let CLOG_MUL_UNWINDING = prove (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> clog(w * z) = clog(w) + clog(z) - Cx(&2 * pi) * ii * unwinding(clog w + clog z)`, REWRITE_TAC[UNWINDING_2PI; COMPLEX_RING `w + z - ((w + z) - c) = c:complex`] THEN ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG]);; (* ------------------------------------------------------------------------- *) (* Complex arctangent (branch cut gives standard bounds in real case). *) (* ------------------------------------------------------------------------- *) let catn = new_definition `catn z = (ii / Cx(&2)) * clog((Cx(&1) - ii * z) / (Cx(&1) + ii * z))`;; let CATN_0 = prove (`catn(Cx(&0)) = Cx(&0)`, REWRITE_TAC[catn; COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO; COMPLEX_ADD_RID] THEN REWRITE_TAC[COMPLEX_DIV_1; CLOG_1; COMPLEX_MUL_RZERO]);; let IM_COMPLEX_DIV_LEMMA = prove (`!z. Im((Cx(&1) - ii * z) / (Cx(&1) + ii * z)) = &0 <=> Re z = &0`, REWRITE_TAC[IM_COMPLEX_DIV_EQ_0] THEN REWRITE_TAC[complex_mul; IM; RE; IM_CNJ; RE_CNJ; RE_CX; IM_CX; RE_II; IM_II; RE_SUB; RE_ADD; IM_SUB; IM_ADD] THEN REAL_ARITH_TAC);; let RE_COMPLEX_DIV_LEMMA = prove (`!z. &0 < Re((Cx(&1) - ii * z) / (Cx(&1) + ii * z)) <=> norm(z) < &1`, REWRITE_TAC[RE_COMPLEX_DIV_GT_0; NORM_LT_SQUARE; REAL_LT_01] THEN REWRITE_TAC[GSYM NORM_POW_2; COMPLEX_SQNORM] THEN REWRITE_TAC[complex_mul; IM; RE; IM_CNJ; RE_CNJ; RE_CX; IM_CX; RE_II; IM_II; RE_SUB; RE_ADD; IM_SUB; IM_ADD] THEN REAL_ARITH_TAC);; let CTAN_CATN = prove (`!z. ~(z pow 2 = --Cx(&1)) ==> ctan(catn z) = z`, REPEAT STRIP_TAC THEN REWRITE_TAC[catn; ctan; csin; ccos; COMPLEX_RING `--i * i / Cx(&2) * z = --(i * i) / Cx(&2) * z`; COMPLEX_RING `i * i / Cx(&2) * z = (i * i) / Cx(&2) * z`] THEN REWRITE_TAC[COMPLEX_POW_II_2; GSYM COMPLEX_POW_2] THEN REWRITE_TAC[COMPLEX_RING `--Cx(&1) / Cx(&2) * x = --(Cx(&1) / Cx(&2) * x)`; CEXP_NEG] THEN SUBGOAL_THEN `~(cexp(Cx(&1) / Cx(&2) * (clog((Cx(&1) - ii * z) / (Cx(&1) + ii * z)))) pow 2 = --Cx(&1))` ASSUME_TAC THENL [REWRITE_TAC[GSYM CEXP_N; CEXP_SUB; COMPLEX_RING `Cx(&2) * Cx(&1) / Cx(&2) * z = z`] THEN ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_POW_II_2; COMPLEX_FIELD `~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> ~(w / z = Cx(&0))`; COMPLEX_FIELD `~(w = Cx(&0)) ==> (x / w = y <=> x = y * w)`; COMPLEX_FIELD `ii pow 2 = --Cx(&1) /\ ~(z pow 2 = --Cx(&1)) ==> ~(Cx(&1) - ii * z = Cx(&0)) /\ ~(Cx(&1) + ii * z = Cx(&0))`] THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN REWRITE_TAC[COMPLEX_RING `-- --Cx (&1) / Cx (&2) = Cx(&1) / Cx(&2)`] THEN ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(z = Cx(&0)) /\ ~(z pow 2 = --Cx(&1)) ==> ((inv(z) - z) / (Cx(&2) * ii)) / ((inv(z) + z) / Cx(&2)) = inv ii * ((Cx(&1) - z pow 2) / (Cx(&1) + z pow 2))`] THEN ASM_SIMP_TAC[GSYM CEXP_N; CEXP_SUB; COMPLEX_RING `Cx(&2) * Cx(&1) / Cx(&2) * z = z`] THEN ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_FIELD `~(z pow 2 = --Cx(&1)) ==> ~((Cx(&1) - ii * z) / (Cx(&1) + ii * z) = Cx(&0))`] THEN UNDISCH_TAC `~(z pow 2 = --Cx(&1))` THEN CONV_TAC COMPLEX_FIELD);; let CATN_CTAN = prove (`!z. abs(Re z) < pi / &2 ==> catn(ctan z) = z`, REPEAT STRIP_TAC THEN REWRITE_TAC[catn; ctan; csin; ccos] THEN ASM_SIMP_TAC[COMPLEX_FIELD `ii * (a / (Cx(&2) * ii)) / (b / Cx(&2)) = a / b`] THEN SIMP_TAC[COMPLEX_FIELD `ii / Cx(&2) * x = y <=> x = Cx(&2) * --(ii * y)`] THEN SUBGOAL_THEN `~(cexp(ii * z) pow 2 = --Cx(&1))` ASSUME_TAC THENL [SUBGOAL_THEN `--Cx(&1) = cexp(ii * Cx pi)` SUBST1_TAC THENL [REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN REWRITE_TAC[GSYM CEXP_N; CEXP_EQ] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `Im`) THEN REWRITE_TAC[IM_MUL_CX; IM_MUL_II; IM_ADD; RE_CX; IM_II; REAL_MUL_RID] THEN MATCH_MP_TAC(REAL_ARITH `abs(z) < p / &2 /\ (w = &0 \/ abs(w) >= &2 * p) ==> ~(&2 * z = p + w)`) THEN ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_PI; REAL_ABS_NUM] THEN SIMP_TAC[real_ge; REAL_MUL_ASSOC; REAL_LE_RMUL_EQ; PI_POS] THEN REWRITE_TAC[REAL_ENTIRE; PI_NZ] THEN MP_TAC(SPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ASM_SIMP_TAC[CEXP_NEG; CEXP_NZ; COMPLEX_MUL_LNEG; COMPLEX_FIELD `~(w = Cx(&0)) /\ ~(w pow 2 = --Cx(&1)) ==> (Cx(&1) - (w - inv w) / (w + inv w)) / (Cx(&1) + (w - inv w) / (w + inv w)) = inv(w) pow 2`] THEN REWRITE_TAC[GSYM CEXP_N; GSYM CEXP_NEG] THEN MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_MUL_CX; IM_NEG; IM_MUL_II] THEN ASM_REAL_ARITH_TAC]);; let RE_CATN_BOUNDS = prove (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> abs(Re(catn z)) < pi / &2`, REWRITE_TAC[catn; complex_div; GSYM CX_INV; GSYM COMPLEX_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[RE_MUL_II; IM_MUL_CX] THEN MATCH_MP_TAC(REAL_ARITH `abs x < p ==> abs(--(inv(&2) * x)) < p / &2`) THEN MATCH_MP_TAC(REAL_ARITH `(--p < x /\ x <= p) /\ ~(x = p) ==> abs x < p`) THEN SUBGOAL_THEN `~(z = ii) /\ ~(z = --ii)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN SUBST1_TAC th) THEN REWRITE_TAC[RE_II; IM_II; RE_NEG; IM_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM complex_div] THEN CONJ_TAC THENL [SUBGOAL_THEN `~((Cx(&1) - ii * z) / (Cx(&1) + ii * z) = Cx(&0))` (fun th -> MESON_TAC[th; CLOG_WORKS]) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(ISPEC `clog((Cx(&1) - ii * z) / (Cx(&1) + ii * z))` EULER) THEN ASM_REWRITE_TAC[SIN_PI; COS_PI; CX_NEG] THEN REWRITE_TAC[COMPLEX_RING `x = y * (--Cx(&1) + z * Cx(&0)) <=> x + y = Cx(&0)`] THEN REWRITE_TAC[CX_EXP] THEN ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_FIELD `~(z = ii) /\ ~(z = --ii) ==> ~((Cx(&1) - ii * z) / (Cx(&1) + ii * z) = Cx(&0))`] THEN REWRITE_TAC[GSYM CX_EXP] THEN DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN REWRITE_TAC[IM_ADD; IM_CX; REAL_ADD_RID; IM_COMPLEX_DIV_LEMMA] THEN DISCH_TAC THEN UNDISCH_TAC `Re z = &0 ==> abs (Im z) < &1` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `ii * z = --Cx(Im z)` SUBST_ALL_TAC THENL [ASM_REWRITE_TAC[COMPLEX_EQ; RE_NEG; IM_NEG; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; REAL_NEG_0]; ALL_TAC] THEN UNDISCH_TAC `Im(clog((Cx(&1) - --Cx(Im z)) / (Cx(&1) + --Cx(Im z)))) = pi` THEN REWRITE_TAC[COMPLEX_SUB_RNEG; GSYM complex_sub] THEN REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; GSYM CX_DIV] THEN SUBGOAL_THEN `&0 < (&1 + Im z) / (&1 - Im z)` ASSUME_TAC THENL [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[GSYM CX_LOG; IM_CX; PI_NZ]]);; let HAS_COMPLEX_DERIVATIVE_CATN = prove (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> (catn has_complex_derivative inv(Cx(&1) + z pow 2)) (at z)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(z = ii) /\ ~(z = --ii)` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN SUBST1_TAC th) THEN REWRITE_TAC[RE_II; IM_II; RE_NEG; IM_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[catn] THEN COMPLEX_DIFF_TAC THEN REWRITE_TAC[RE_SUB; RE_ADD; IM_SUB; IM_ADD; RE_CX; RE_MUL_II; IM_CX; IM_MUL_II] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IM_COMPLEX_DIV_LEMMA; RE_COMPLEX_DIV_LEMMA] THEN SIMP_TAC[complex_norm] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_ADD_LID; POW_2_SQRT_ABS]; REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD]);; let COMPLEX_DIFFERENTIABLE_AT_CATN = prove (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> catn complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CATN]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CATN = prove (`!s z. (Re z = &0 ==> abs(Im z) < &1) ==> catn complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CATN]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN HAS_COMPLEX_DERIVATIVE_CATN)));; let CONTINUOUS_AT_CATN = prove (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> catn continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CATN; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CATN = prove (`!s z. (Re z = &0 ==> abs(Im z) < &1) ==> catn continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CATN]);; let CONTINUOUS_ON_CATN = prove (`!s. (!z. z IN s /\ Re z = &0 ==> abs(Im z) < &1) ==> catn continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CATN]);; let HOLOMORPHIC_ON_CATN = prove (`!s. (!z. z IN s /\ Re z = &0 ==> abs(Im z) < &1) ==> catn holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CATN]);; (* ------------------------------------------------------------------------- *) (* Real arctangent. *) (* ------------------------------------------------------------------------- *) let atn = new_definition `atn(x) = Re(catn(Cx x))`;; let CX_ATN = prove (`!x. Cx(atn x) = catn(Cx x)`, GEN_TAC THEN REWRITE_TAC[atn; catn; GSYM REAL; real] THEN REWRITE_TAC[complex_div; IM_MUL_II; GSYM CX_INV; GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[RE_MUL_CX; REAL_ARITH `inv(&2) * x = &0 <=> x = &0`] THEN MATCH_MP_TAC NORM_CEXP_IMAGINARY THEN SUBGOAL_THEN `~(Cx(&1) - ii * Cx(x) = Cx(&0)) /\ ~(Cx(&1) + ii * Cx(x) = Cx(&0))` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN REWRITE_TAC[RE_ADD; RE_SUB; RE_MUL_II; IM_CX; RE_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN ASM_SIMP_TAC[CEXP_SUB; CEXP_CLOG; COMPLEX_FIELD `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> ~(a * inv b = Cx(&0))`] THEN REWRITE_TAC[GSYM complex_div; COMPLEX_NORM_DIV] THEN MATCH_MP_TAC(REAL_FIELD `~(b = &0) /\ a = b ==> a / b = &1`) THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO] THEN MATCH_MP_TAC(MESON[COMPLEX_NORM_CNJ] `cnj a = b ==> norm a = norm b`) THEN REWRITE_TAC[CNJ_SUB; CNJ_MUL; CNJ_MUL; CNJ_II; CNJ_CX] THEN CONV_TAC COMPLEX_RING);; let ATN_TAN = prove (`!y. tan(atn y) = y`, GEN_TAC THEN REWRITE_TAC[tan_def; atn] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Re(ctan(catn(Cx y)))` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CX_ATN; RE_CX]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM RE_CX] THEN AP_TERM_TAC THEN MATCH_MP_TAC CTAN_CATN THEN MATCH_MP_TAC(COMPLEX_RING `~(z = ii) /\ ~(z = --ii) ==> ~(z pow 2 = --Cx(&1))`) THEN CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN REWRITE_TAC[IM_II; IM_CX; IM_NEG] THEN REAL_ARITH_TAC);; let ATN_BOUND = prove (`!y. abs(atn y) < pi / &2`, GEN_TAC THEN REWRITE_TAC[atn] THEN MATCH_MP_TAC RE_CATN_BOUNDS THEN REWRITE_TAC[IM_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let ATN_BOUNDS = prove (`!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2)`, MP_TAC ATN_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let TAN_ATN = prove (`!x. --(pi / &2) < x /\ x < pi / &2 ==> atn(tan(x)) = x`, REPEAT STRIP_TAC THEN REWRITE_TAC[tan_def; atn] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Re(catn(ctan(Cx x)))` THEN CONJ_TAC THENL [REWRITE_TAC[GSYM CX_TAN; RE_CX]; ALL_TAC] THEN GEN_REWRITE_TAC RAND_CONV [GSYM RE_CX] THEN AP_TERM_TAC THEN MATCH_MP_TAC CATN_CTAN THEN REWRITE_TAC[RE_CX] THEN ASM_REAL_ARITH_TAC);; let ATN_0 = prove (`atn(&0) = &0`, GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM TAN_0] THEN MATCH_MP_TAC TAN_ATN THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let ATN_1 = prove (`atn(&1) = pi / &4`, MP_TAC(AP_TERM `atn` TAN_PI4) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC TAN_ATN THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let ATN_NEG = prove (`!x. atn(--x) = --(atn x)`, GEN_TAC THEN MP_TAC(SPEC `atn(x)` TAN_NEG) THEN REWRITE_TAC[ATN_TAN] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC TAN_ATN THEN MP_TAC(SPEC `x:real` ATN_BOUNDS) THEN REAL_ARITH_TAC);; let ATN_MONO_LT = prove (`!x y. x < y ==> atn(x) < atn(y)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [GSYM ATN_TAN] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN SIMP_TAC[TAN_MONO_LE; ATN_BOUNDS]);; let ATN_MONO_LT_EQ = prove (`!x y. atn(x) < atn(y) <=> x < y`, MESON_TAC[REAL_NOT_LE; REAL_LE_LT; ATN_MONO_LT]);; let ATN_MONO_LE_EQ = prove (`!x y. atn(x) <= atn(y) <=> x <= y`, REWRITE_TAC[GSYM REAL_NOT_LT; ATN_MONO_LT_EQ]);; let ATN_INJ = prove (`!x y. (atn x = atn y) <=> (x = y)`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; ATN_MONO_LE_EQ]);; let ATN_POS_LT = prove (`&0 < atn(x) <=> &0 < x`, MESON_TAC[ATN_0; ATN_MONO_LT_EQ]);; let ATN_POS_LE = prove (`&0 <= atn(x) <=> &0 <= x`, MESON_TAC[ATN_0; ATN_MONO_LE_EQ]);; let ATN_LT_PI4_POS = prove (`!x. x < &1 ==> atn(x) < pi / &4`, SIMP_TAC[GSYM ATN_1; ATN_MONO_LT]);; let ATN_LT_PI4_NEG = prove (`!x. --(&1) < x ==> --(pi / &4) < atn(x)`, SIMP_TAC[GSYM ATN_1; GSYM ATN_NEG; ATN_MONO_LT]);; let ATN_LT_PI4 = prove (`!x. abs(x) < &1 ==> abs(atn x) < pi / &4`, GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `(&0 < x ==> &0 < y) /\ (x < &0 ==> y < &0) /\ ((x = &0) ==> (y = &0)) /\ (x < a ==> y < b) /\ (--a < x ==> --b < y) ==> abs(x) < a ==> abs(y) < b`) THEN SIMP_TAC[ATN_LT_PI4_POS; ATN_LT_PI4_NEG; ATN_0] THEN CONJ_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ATN_0] THEN SIMP_TAC[ATN_MONO_LT]);; let ATN_LE_PI4 = prove (`!x. abs(x) <= &1 ==> abs(atn x) <= pi / &4`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ATN_LT_PI4] THEN DISJ2_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `(abs(x) = a) ==> (x = a) \/ (x = --a)`)) THEN ASM_REWRITE_TAC[ATN_1; ATN_NEG] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NEG] THEN SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS]);; let COS_ATN_NZ = prove (`!x. ~(cos(atn(x)) = &0)`, GEN_TAC THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI THEN REWRITE_TAC[ATN_BOUNDS]);; let TAN_SEC = prove (`!x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)`, MP_TAC SIN_CIRCLE THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[tan] THEN CONV_TAC REAL_FIELD);; let COS_ATN = prove (`!x. cos(atn x) = &1 / sqrt(&1 + x pow 2)`, SIMP_TAC[COS_TAN; ATN_BOUND; ATN_TAN]);; let SIN_ATN = prove (`!x. sin(atn x) = x / sqrt(&1 + x pow 2)`, SIMP_TAC[SIN_TAN; ATN_BOUND; ATN_TAN]);; let ATN_ABS = prove (`!x. atn(abs x) = abs(atn x)`, GEN_TAC THEN REWRITE_TAC[real_abs; ATN_POS_LE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ATN_NEG]);; let ATN_ADD = prove (`!x y. abs(atn x + atn y) < pi / &2 ==> atn(x) + atn(y) = atn((x + y) / (&1 - x * y))`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `atn((tan(atn x) + tan(atn y)) / (&1 - tan(atn x) * tan(atn y)))` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[ATN_TAN]] THEN W(MP_TAC o PART_MATCH (rand o rand) TAN_ADD o rand o rand o snd) THEN ANTS_TAC THENL [REWRITE_TAC[COS_ATN_NZ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI THEN ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC TAN_ATN THEN ASM_REAL_ARITH_TAC]);; let ATN_INV = prove (`!x. &0 < x ==> atn(inv x) = pi / &2 - atn x`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `atn(inv(tan(atn x)))` THEN CONJ_TAC THENL [REWRITE_TAC[ATN_TAN]; REWRITE_TAC[GSYM TAN_COT]] THEN MATCH_MP_TAC TAN_ATN THEN REWRITE_TAC[ATN_BOUNDS; REAL_ARITH `--(p / &2) < p / &2 - x /\ p / &2 - x < p / &2 <=> &0 < x /\ x < p`] THEN ASM_REWRITE_TAC[ATN_POS_LT] THEN MP_TAC(SPEC `x:real` ATN_BOUNDS) THEN ASM_REAL_ARITH_TAC);; let ATN_ADD_SMALL = prove (`!x y. abs(x * y) < &1 ==> (atn(x) + atn(y) = atn((x + y) / (&1 - x * y)))`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`x = &0`; `y = &0`] THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_DIV_1; REAL_ADD_LID; REAL_ADD_RID; ATN_0] THEN MATCH_MP_TAC ATN_ADD THEN MATCH_MP_TAC(REAL_ARITH `abs(x) < p - abs(y) \/ abs(y) < p - abs(x) ==> abs(x + y) < p`) THEN REWRITE_TAC[GSYM ATN_ABS] THEN ASM_SIMP_TAC[GSYM ATN_INV; REAL_ARITH `~(x = &0) ==> &0 < abs x`; ATN_MONO_LT_EQ; REAL_ARITH `inv x = &1 / x`; REAL_LT_RDIV_EQ] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Machin-like formulas for pi. *) (* ------------------------------------------------------------------------- *) let [MACHIN; MACHIN_EULER; MACHIN_GAUSS] = (CONJUNCTS o prove) (`(&4 * atn(&1 / &5) - atn(&1 / &239) = pi / &4) /\ (&5 * atn(&1 / &7) + &2 * atn(&3 / &79) = pi / &4) /\ (&12 * atn(&1 / &18) + &8 * atn(&1 / &57) - &5 * atn(&1 / &239) = pi / &4)`, REPEAT CONJ_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(fun tm -> if is_binop `( * ):real->real->real` tm then LAND_CONV(RAND_CONV(TOP_DEPTH_CONV num_CONV)) tm else failwith "")) THEN REWRITE_TAC[real_sub; GSYM REAL_MUL_RNEG; GSYM ATN_NEG] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_ADD_LID] THEN CONV_TAC(DEPTH_CONV (fun tm -> let th1 = PART_MATCH (lhand o rand) ATN_ADD_SMALL tm in let th2 = MP th1 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th1)))) in CONV_RULE(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV)) th2)) THEN REWRITE_TAC[ATN_1]);; (* ------------------------------------------------------------------------- *) (* Some bound theorems where a bit of simple calculus is handy. *) (* ------------------------------------------------------------------------- *) let ATN_ABS_LE_X = prove (`!x. abs(atn x) <= abs x`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`catn`; `\z. inv(Cx(&1) + z pow 2)`; `real`; `&1`] COMPLEX_MVT) THEN REWRITE_TAC[CONVEX_REAL; IN] THEN ANTS_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[real] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CATN THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; GEN_TAC THEN REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_ADD; GSYM CX_INV; COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MP_TAC(SPEC `Re z` REAL_LE_SQUARE) THEN REAL_ARITH_TAC]; DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(x)`]) THEN REWRITE_TAC[GSYM CX_ATN; COMPLEX_SUB_RZERO; REAL_CX; ATN_0] THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_MUL_LID]]);; let ATN_LE_X = prove (`!x. &0 <= x ==> atn(x) <= x`, MP_TAC ATN_ABS_LE_X THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let TAN_ABS_GE_X = prove (`!x. abs(x) < pi / &2 ==> abs(x) <= abs(tan x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(atn(tan x))` THEN REWRITE_TAC[ATN_ABS_LE_X] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC TAN_ATN THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Probably not very useful, but for compatibility with old analysis theory. *) (* ------------------------------------------------------------------------- *) let TAN_TOTAL = prove (`!y. ?!x. --(pi / &2) < x /\ x < (pi / &2) /\ tan(x) = y`, MESON_TAC[TAN_ATN; ATN_TAN; ATN_BOUNDS]);; let TAN_TOTAL_POS = prove (`!y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ tan(x) = y`, MESON_TAC[ATN_TAN; ATN_BOUNDS; ATN_POS_LE]);; let TAN_TOTAL_LEMMA = prove (`!y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `atn(y + &1)` THEN REWRITE_TAC[ATN_TAN; ATN_BOUNDS; ATN_POS_LT] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some slightly ad hoc lemmas useful here. *) (* ------------------------------------------------------------------------- *) let RE_POW_2 = prove (`Re(z pow 2) = Re(z) pow 2 - Im(z) pow 2`, REWRITE_TAC[COMPLEX_POW_2; complex_mul; RE] THEN REAL_ARITH_TAC);; let IM_POW_2 = prove (`Im(z pow 2) = &2 * Re(z) * Im(z)`, REWRITE_TAC[COMPLEX_POW_2; complex_mul; IM] THEN REAL_ARITH_TAC);; let ABS_SQUARE_LT_1 = prove (`!x. x pow 2 < &1 <=> abs(x) < &1`, ONCE_REWRITE_TAC[GSYM REAL_ABS_NUM] THEN REWRITE_TAC[REAL_LT_SQUARE_ABS] THEN REAL_ARITH_TAC);; let ABS_SQUARE_LE_1 = prove (`!x. x pow 2 <= &1 <=> abs(x) <= &1`, ONCE_REWRITE_TAC[GSYM REAL_ABS_NUM] THEN REWRITE_TAC[REAL_LT_SQUARE_ABS; GSYM REAL_NOT_LT] THEN REAL_ARITH_TAC);; let ABS_SQUARE_EQ_1 = prove (`!x. x pow 2 = &1 <=> abs(x) = &1`, REWRITE_TAC[REAL_RING `x pow 2 = &1 <=> x = &1 \/ x = -- &1`] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Inverse sine. *) (* ------------------------------------------------------------------------- *) let casn = new_definition `casn z = --ii * clog(ii * z + csqrt(Cx(&1) - z pow 2))`;; let CASN_BODY_LEMMA = prove (`!z. ~(ii * z + csqrt(Cx(&1) - z pow 2) = Cx(&0))`, GEN_TAC THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_FIELD);; let CSIN_CASN = prove (`!z. csin(casn z) = z`, GEN_TAC THEN REWRITE_TAC[csin; casn; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; COMPLEX_NEG_NEG] THEN REWRITE_TAC[COMPLEX_POW_II_2; GSYM COMPLEX_POW_2] THEN REWRITE_TAC[COMPLEX_NEG_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN REWRITE_TAC[CEXP_NEG] THEN ASM_SIMP_TAC[CASN_BODY_LEMMA; CEXP_CLOG; COMPLEX_FIELD `~(z = Cx(&0)) ==> ((z - inv z) / (Cx(&2) * ii) = c <=> z pow 2 - Cx(&1) = Cx(&2) * ii * c * z)`] THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_FIELD);; let CASN_CSIN = prove (`!z. abs(Re z) < pi / &2 \/ (abs(Re z) = pi / &2 /\ Im z = &0) ==> casn(csin z) = z`, GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[csin; casn; COMPLEX_MUL_LNEG; CEXP_NEG] THEN SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(z = Cx(&0)) ==> Cx(&1) - ((z - inv z) / (Cx(&2) * ii)) pow 2 = ((z + inv z) / Cx(&2)) pow 2`] THEN SUBGOAL_THEN `csqrt(((cexp(ii * z) + inv(cexp(ii * z))) / Cx(&2)) pow 2) = (cexp(ii * z) + inv(cexp(ii * z))) / Cx(&2)` SUBST1_TAC THENL [MATCH_MP_TAC POW_2_CSQRT THEN REWRITE_TAC[GSYM CEXP_NEG] THEN REWRITE_TAC[complex_div; GSYM CX_INV; RE_MUL_CX; IM_MUL_CX] THEN REWRITE_TAC[REAL_ARITH `&0 < r * inv(&2) \/ r * inv(&2) = &0 /\ &0 <= i * inv(&2) <=> &0 < r \/ r = &0 /\ &0 <= i`] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_CEXP; IM_CEXP] THEN REWRITE_TAC[RE_MUL_II; RE_NEG; IM_MUL_II; IM_NEG] THEN REWRITE_TAC[SIN_NEG; COS_NEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_MUL_RNEG; GSYM real_sub] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL [DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_EXP_POS_LT] THEN MATCH_MP_TAC COS_POS_PI THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; DISJ2_TAC THEN ASM_REWRITE_TAC[SIN_PI2; COS_PI2] THEN REWRITE_TAC[REAL_EXP_NEG; REAL_EXP_0; REAL_INV_1; REAL_SUB_REFL] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL; REAL_ENTIRE] THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `abs(x) = p ==> x = p \/ x = --p`)) THEN REWRITE_TAC[COS_PI2; COS_NEG] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SIMP_TAC[COMPLEX_FIELD `ii * (a - b) / (Cx(&2) * ii) + (a + b) / Cx(&2) = a`] THEN SIMP_TAC[COMPLEX_FIELD `--(ii * w) = z <=> w = ii * z`] THEN MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_MUL_II] THEN MP_TAC PI_POS THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; let CASN_UNIQUE = prove (`!w z. csin(z) = w /\ (abs(Re z) < pi / &2 \/ (abs(Re z) = pi / &2 /\ Im z = &0)) ==> casn w = z`, MESON_TAC[CASN_CSIN]);; let CASN_0 = prove (`casn(Cx(&0)) = Cx(&0)`, REWRITE_TAC[casn; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_POW_2; COMPLEX_SUB_RZERO; CSQRT_1; CLOG_1; COMPLEX_MUL_RZERO]);; let CASN_1 = prove (`casn(Cx(&1)) = Cx(pi / &2)`, REWRITE_TAC[casn; GSYM CX_POW; GSYM CX_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CSQRT_0; COMPLEX_MUL_RID; COMPLEX_ADD_RID] THEN REWRITE_TAC[CLOG_II] THEN CONV_TAC COMPLEX_RING);; let CASN_NEG_1 = prove (`casn(--Cx(&1)) = --Cx(pi / &2)`, REWRITE_TAC[casn; GSYM CX_NEG; GSYM CX_POW; GSYM CX_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CSQRT_0; COMPLEX_MUL_RID; COMPLEX_ADD_RID] THEN REWRITE_TAC[CX_NEG; COMPLEX_MUL_RID; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[CLOG_NEG_II] THEN CONV_TAC COMPLEX_RING);; let HAS_COMPLEX_DERIVATIVE_CASN = prove (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> (casn has_complex_derivative inv(ccos(casn z))) (at z)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC THEN EXISTS_TAC `csin` THEN REWRITE_TAC[CSIN_CASN; HAS_COMPLEX_DERIVATIVE_CSIN; CONTINUOUS_AT_CSIN] THEN EXISTS_TAC `ball(z:complex,&1)` THEN REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING `ccos z = Cx(&0) ==> csin(z) pow 2 + ccos(z) pow 2 = Cx(&1) ==> csin(z) pow 2 = Cx(&1)`)) THEN REWRITE_TAC[CSIN_CASN; CSIN_CIRCLE] THEN REWRITE_TAC[COMPLEX_RING `z pow 2 = Cx(&1) <=> z = Cx(&1) \/ z = --Cx(&1)`] THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[RE_CX; IM_CX; RE_NEG; IM_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[casn] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ADD THEN SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN SIMP_TAC[CONTINUOUS_COMPLEX_POW; CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN MATCH_MP_TAC CONTINUOUS_AT_CSQRT THEN REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN ASM_SIMP_TAC[REAL_LE_SQUARE; REAL_ARITH `&0 <= x ==> &0 < &1 + x`] THEN REWRITE_TAC[REAL_ARITH `&0 < &1 - x * x <=> x pow 2 < &1 pow 2`] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_SIMP_TAC[REAL_ABS_POS; REAL_ABS_NUM; ARITH]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_AT_CLOG THEN REWRITE_TAC[IM_ADD; IM_MUL_II; RE_ADD; RE_MUL_II] THEN ASM_CASES_TAC `Im z = &0` THENL [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[csqrt] THEN ASM_REWRITE_TAC[IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2; REAL_MUL_RZERO; REAL_SUB_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&0 <= &1 - (z pow 2 - &0) <=> z pow 2 <= &1 pow 2`; GSYM REAL_LE_SQUARE_ABS] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_NUM; RE; REAL_ADD_LID] THEN MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[REAL_ARITH `&0 < &1 - (z pow 2 - &0) <=> z pow 2 < &1 pow 2`; GSYM REAL_LT_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[csqrt; IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2] THEN REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[RE; IM] THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN SIMP_TAC[REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; REAL_POS] THEN REWRITE_TAC[RE; IM; REAL_ADD_LID; REAL_ARITH `&0 < --x + y <=> x < y`] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `&0 < --x + y <=> x < y`] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN REWRITE_TAC[REAL_POW_2; REAL_ARITH `a < (n + &1 - (b - a)) / &2 <=> (a + b) - &1 < n`] THEN REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN REAL_ARITH_TAC);; let COMPLEX_DIFFERENTIABLE_AT_CASN = prove (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> casn complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CASN]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CASN = prove (`!s z. (Im z = &0 ==> abs(Re z) < &1) ==> casn complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CASN]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN HAS_COMPLEX_DERIVATIVE_CASN)));; let CONTINUOUS_AT_CASN = prove (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> casn continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CASN; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CASN = prove (`!s z. (Im z = &0 ==> abs(Re z) < &1) ==> casn continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CASN]);; let CONTINUOUS_ON_CASN = prove (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> casn continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CASN]);; let HOLOMORPHIC_ON_CASN = prove (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> casn holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CASN]);; (* ------------------------------------------------------------------------- *) (* Inverse cosine. *) (* ------------------------------------------------------------------------- *) let cacs = new_definition `cacs z = --ii * clog(z + ii * csqrt(Cx(&1) - z pow 2))`;; let CACS_BODY_LEMMA = prove (`!z. ~(z + ii * csqrt(Cx(&1) - z pow 2) = Cx(&0))`, GEN_TAC THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_FIELD);; let CCOS_CACS = prove (`!z. ccos(cacs z) = z`, GEN_TAC THEN REWRITE_TAC[ccos; cacs; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; COMPLEX_NEG_NEG] THEN REWRITE_TAC[COMPLEX_POW_II_2; GSYM COMPLEX_POW_2] THEN REWRITE_TAC[COMPLEX_NEG_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN REWRITE_TAC[CEXP_NEG] THEN ASM_SIMP_TAC[CACS_BODY_LEMMA; CEXP_CLOG; COMPLEX_POW_II_2; COMPLEX_FIELD `~(z = Cx(&0)) ==> ((z + inv z) / Cx(&2) = c <=> z pow 2 + Cx(&1) = Cx(&2) * c * z)`] THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_FIELD);; let CACS_CCOS = prove (`!z. &0 < Re z /\ Re z < pi \/ Re(z) = &0 /\ &0 <= Im(z) \/ Re(z) = pi /\ Im(z) <= &0 ==> cacs(ccos z) = z`, GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[ccos; cacs; COMPLEX_MUL_LNEG; CEXP_NEG] THEN SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(z = Cx(&0)) ==> Cx(&1) - ((z + inv z) / Cx(&2)) pow 2 = --(((z - inv z) / Cx(&2)) pow 2)`] THEN SUBGOAL_THEN `csqrt(--(((cexp(ii * z) - inv(cexp(ii * z))) / Cx(&2)) pow 2)) = --ii * (cexp(ii * z) - inv(cexp(ii * z))) / Cx(&2)` SUBST1_TAC THENL [SIMP_TAC[COMPLEX_FIELD `--(x pow 2) = (--ii * x) pow 2`] THEN MATCH_MP_TAC POW_2_CSQRT THEN REWRITE_TAC[GSYM CEXP_NEG] THEN REWRITE_TAC[complex_div; GSYM CX_INV; RE_MUL_CX; IM_MUL_CX; RE_NEG; IM_NEG; COMPLEX_MUL_LNEG; RE_MUL_II; IM_MUL_II; RE_SUB; IM_SUB] THEN REWRITE_TAC[REAL_NEG_NEG; REAL_NEG_EQ_0] THEN REWRITE_TAC[REAL_ARITH `&0 < r * inv(&2) \/ r * inv(&2) = &0 /\ &0 <= --(i * inv(&2)) <=> &0 < r \/ r = &0 /\ &0 <= --i`] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_CEXP; IM_CEXP] THEN REWRITE_TAC[RE_MUL_II; RE_NEG; IM_MUL_II; IM_NEG] THEN REWRITE_TAC[SIN_NEG; COS_NEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_MUL_RNEG; GSYM real_sub; REAL_SUB_RNEG; REAL_NEG_SUB] THEN REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_EXP_POS_LT; REAL_LT_MUL_EQ] THEN POP_ASSUM(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[SIN_POS_PI] THEN DISJ2_TAC THEN REWRITE_TAC[SIN_PI; REAL_MUL_RZERO; COS_PI; SIN_0; COS_0] THEN REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RNEG] THEN REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_EXP_MONO_LE] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[COMPLEX_FIELD `(e + e') / Cx(&2) + ii * --ii * (e - e') / Cx(&2) = e`] THEN SIMP_TAC[COMPLEX_FIELD `--(ii * w) = z <=> w = ii * z`] THEN MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_MUL_II] THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC);; let CACS_UNIQUE = prove (`!w z. ccos z = w /\ (&0 < Re z /\ Re z < pi \/ Re(z) = &0 /\ &0 <= Im(z) \/ Re(z) = pi /\ Im(z) <= &0) ==> cacs(w) = z`, MESON_TAC[CACS_CCOS]);; let CACS_0 = prove (`cacs(Cx(&0)) = Cx(pi / &2)`, MATCH_MP_TAC CACS_UNIQUE THEN REWRITE_TAC[RE_CX; IM_CX; GSYM CX_COS; COS_PI2] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let CACS_1 = prove (`cacs(Cx(&1)) = Cx(&0)`, MATCH_MP_TAC CACS_UNIQUE THEN REWRITE_TAC[RE_CX; IM_CX; GSYM CX_COS; COS_0; REAL_LE_REFL]);; let CACS_NEG_1 = prove (`cacs(--Cx(&1)) = Cx pi`, MATCH_MP_TAC CACS_UNIQUE THEN REWRITE_TAC[RE_CX; IM_CX; GSYM CX_COS; COS_PI; CX_NEG; REAL_LE_REFL]);; let HAS_COMPLEX_DERIVATIVE_CACS = prove (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> (cacs has_complex_derivative --inv(csin(cacs z))) (at z)`, REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NEG_INV] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC THEN EXISTS_TAC `ccos` THEN REWRITE_TAC[CCOS_CACS; HAS_COMPLEX_DERIVATIVE_CCOS; CONTINUOUS_AT_CCOS] THEN EXISTS_TAC `ball(z:complex,&1)` THEN REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN CONJ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING `--(csin z) = Cx(&0) ==> csin(z) pow 2 + ccos(z) pow 2 = Cx(&1) ==> ccos(z) pow 2 = Cx(&1)`)) THEN REWRITE_TAC[CCOS_CACS; CSIN_CIRCLE] THEN REWRITE_TAC[COMPLEX_RING `z pow 2 = Cx(&1) <=> z = Cx(&1) \/ z = --Cx(&1)`] THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[RE_CX; IM_CX; RE_NEG; IM_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[cacs] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN SIMP_TAC[CONTINUOUS_COMPLEX_POW; CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN MATCH_MP_TAC CONTINUOUS_AT_CSQRT THEN REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN ASM_SIMP_TAC[REAL_LE_SQUARE; REAL_ARITH `&0 <= x ==> &0 < &1 + x`] THEN REWRITE_TAC[REAL_ARITH `&0 < &1 - x * x <=> x pow 2 < &1 pow 2`] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_SIMP_TAC[REAL_ABS_POS; REAL_ABS_NUM; ARITH]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_AT_CLOG THEN REWRITE_TAC[IM_ADD; IM_MUL_II; RE_ADD; RE_MUL_II] THEN ASM_CASES_TAC `Im z = &0` THENL [ASM_REWRITE_TAC[csqrt] THEN ASM_REWRITE_TAC[IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2; REAL_MUL_RZERO; REAL_SUB_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&0 <= &1 - (z pow 2 - &0) <=> z pow 2 <= &1 pow 2`; GSYM REAL_LE_SQUARE_ABS] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_NUM; RE; REAL_ADD_LID] THEN REWRITE_TAC[GSYM real_sub; IM; REAL_SUB_LT; REAL_SUB_RZERO] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> x = &0 ==> &0 < y`) THEN MATCH_MP_TAC SQRT_POS_LT THEN ASM_SIMP_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1]; ALL_TAC] THEN REWRITE_TAC[csqrt; IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2] THEN REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[RE; IM] THENL [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN SIMP_TAC[REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; REAL_POS] THEN REWRITE_TAC[RE; IM; REAL_ADD_LID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a + b = &0 ==> a = --b`)) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN SIMP_TAC[SQRT_POW_2; REAL_POW_NEG; ARITH; REAL_LE_SQUARE; REAL_LE_ADD; REAL_POS] THEN REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a + b = &0 ==> a = --b`)) THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN SUBGOAL_THEN `&0 < (norm(Cx (&1) - z pow 2) + &1 - (Re z pow 2 - Im z pow 2)) / &2` ASSUME_TAC THENL [REWRITE_TAC[REAL_ARITH `&0 < (x + y - z) / &2 <=> z - y < x`] THEN REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_POW_NEG; ARITH; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_POW_2; REAL_ARITH `a = (n + &1 - (b - a)) / &2 <=> (a + b) - &1 = n`] THEN REWRITE_TAC[complex_norm] THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN SIMP_TAC[SQRT_POW_2; REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE; REAL_LE_ADD] THEN REWRITE_TAC[RE_SUB; RE_CX; RE_POW_2; IM_SUB; IM_CX; IM_POW_2] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN REAL_ARITH_TAC);; let COMPLEX_DIFFERENTIABLE_AT_CACS = prove (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> cacs complex_differentiable at z`, REWRITE_TAC[complex_differentiable] THEN MESON_TAC[HAS_COMPLEX_DERIVATIVE_CACS]);; let COMPLEX_DIFFERENTIABLE_WITHIN_CACS = prove (`!s z. (Im z = &0 ==> abs(Re z) < &1) ==> cacs complex_differentiable (at z within s)`, MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; COMPLEX_DIFFERENTIABLE_AT_CACS]);; add_complex_differentiation_theorems (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN HAS_COMPLEX_DERIVATIVE_CACS)));; let CONTINUOUS_AT_CACS = prove (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> cacs continuous at z`, MESON_TAC[HAS_COMPLEX_DERIVATIVE_CACS; HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; let CONTINUOUS_WITHIN_CACS = prove (`!s z. (Im z = &0 ==> abs(Re z) < &1) ==> cacs continuous (at z within s)`, MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CACS]);; let CONTINUOUS_ON_CACS = prove (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> cacs continuous_on s`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CACS]);; let HOLOMORPHIC_ON_CACS = prove (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> cacs holomorphic_on s`, REWRITE_TAC [holomorphic_on] THEN MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CACS]);; (* ------------------------------------------------------------------------- *) (* Some crude range theorems (could be sharpened). *) (* ------------------------------------------------------------------------- *) let CASN_RANGE_LEMMA = prove (`!z. abs (Re z) < &1 ==> &0 < Re(ii * z + csqrt(Cx(&1) - z pow 2))`, REPEAT STRIP_TAC THEN REWRITE_TAC[RE_ADD; RE_MUL_II] THEN REWRITE_TAC[REAL_ARITH `&0 < --i + r <=> i < r`] THEN REWRITE_TAC[csqrt; IM_SUB; RE_SUB; COMPLEX_POW_2; RE_CX; IM_CX] THEN REWRITE_TAC[complex_mul; RE; IM] THEN REWRITE_TAC[GSYM complex_mul] THEN REWRITE_TAC[REAL_ARITH `r * i + i * r = &2 * r * i`] THEN REWRITE_TAC[REAL_SUB_LZERO; REAL_NEG_EQ_0; REAL_ABS_NEG] THEN REWRITE_TAC[REAL_NEG_SUB; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH] THEN MAP_EVERY ASM_CASES_TAC [`Re z = &0`; `Im z = &0`] THEN ASM_REWRITE_TAC[REAL_SUB_LZERO; REAL_SUB_RZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[RE; SQRT_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THENL [REWRITE_TAC[REAL_ARITH `&1 - (&0 - z) = &1 + z`] THEN SIMP_TAC[REAL_LE_ADD; REAL_POS; REAL_LE_SQUARE; RE] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN REAL_ARITH_TAC; SUBGOAL_THEN `Re(z) pow 2 < &1 pow 2` MP_TAC THENL [ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[REAL_ABS_POS; REAL_ABS_NUM; ARITH]; REWRITE_TAC[REAL_POW_ONE] THEN STRIP_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RE] THEN TRY(MATCH_MP_TAC SQRT_POS_LT) THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_RSQRT THEN REWRITE_TAC[REAL_POW_2; REAL_ARITH `a < (n + &1 - (b - a)) / &2 <=> (a + b) - &1 < n`] THEN REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX] THEN REWRITE_TAC[complex_mul; RE; IM] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN REAL_ARITH_TAC]);; let CACS_RANGE_LEMMA = prove (`!z. abs(Re z) < &1 ==> &0 < Im(z + ii * csqrt(Cx(&1) - z pow 2))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `--z:complex` CASN_RANGE_LEMMA) THEN ASM_SIMP_TAC[IM_NEG; RE_NEG; IM_ADD; RE_ADD; IM_MUL_II; RE_MUL_II; COMPLEX_POW_NEG; ARITH; REAL_ABS_NEG] THEN REAL_ARITH_TAC);; let RE_CASN = prove (`!z. Re(casn z) = Im(clog(ii * z + csqrt(Cx(&1) - z pow 2)))`, REWRITE_TAC[casn; COMPLEX_MUL_LNEG; RE_NEG; RE_MUL_II; REAL_NEGNEG]);; let RE_CACS = prove (`!z. Re(cacs z) = Im(clog(z + ii * csqrt(Cx(&1) - z pow 2)))`, REWRITE_TAC[cacs; COMPLEX_MUL_LNEG; RE_NEG; RE_MUL_II; REAL_NEGNEG]);; let CASN_BOUNDS = prove (`!z. abs(Re z) < &1 ==> abs(Re(casn z)) < pi / &2`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[RE_CASN] THEN MATCH_MP_TAC RE_CLOG_POS_LT_IMP THEN ASM_SIMP_TAC[CASN_RANGE_LEMMA]);; let CACS_BOUNDS = prove (`!z. abs(Re z) < &1 ==> &0 < Re(cacs z) /\ Re(cacs z) < pi`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[RE_CACS] THEN MATCH_MP_TAC IM_CLOG_POS_LT_IMP THEN ASM_SIMP_TAC[CACS_RANGE_LEMMA]);; let RE_CACS_BOUNDS = prove (`!z. --pi < Re(cacs z) /\ Re(cacs z) <= pi`, REWRITE_TAC[RE_CACS] THEN SIMP_TAC[CLOG_WORKS; CACS_BODY_LEMMA]);; let RE_CACS_BOUND = prove (`!z. abs(Re(cacs z)) <= pi`, MP_TAC RE_CACS_BOUNDS THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; let RE_CASN_BOUNDS = prove (`!z. --pi < Re(casn z) /\ Re(casn z) <= pi`, REWRITE_TAC[RE_CASN] THEN SIMP_TAC[CLOG_WORKS; CASN_BODY_LEMMA]);; let RE_CASN_BOUND = prove (`!z. abs(Re(casn z)) <= pi`, MP_TAC RE_CASN_BOUNDS THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Interrelations between the two functions. *) (* ------------------------------------------------------------------------- *) let CCOS_CASN_NZ = prove (`!z. ~(z pow 2 = Cx(&1)) ==> ~(ccos(casn z) = Cx(&0))`, REWRITE_TAC[ccos; casn; CEXP_NEG; COMPLEX_RING `ii * --ii * z = z`; COMPLEX_RING `--ii * --ii * z = --z`] THEN SIMP_TAC[CEXP_CLOG; CASN_BODY_LEMMA; COMPLEX_FIELD `~(x = Cx(&0)) ==> ((x + inv(x)) / Cx(&2) = Cx(&0) <=> x pow 2 = --Cx(&1))`] THEN SIMP_TAC[CSQRT; COMPLEX_FIELD `s pow 2 = Cx(&1) - z pow 2 ==> ((ii * z + s) pow 2 = --Cx(&1) <=> ii * s * z = Cx(&1) - z pow 2)`] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(COMPLEX_RING `~(x pow 2 + y pow 2 = Cx(&0)) ==> ~(ii * x = y)`) THEN REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_RING);; let CSIN_CACS_NZ = prove (`!z. ~(z pow 2 = Cx(&1)) ==> ~(csin(cacs z) = Cx(&0))`, REWRITE_TAC[csin; cacs; CEXP_NEG; COMPLEX_RING `ii * --ii * z = z`; COMPLEX_RING `--ii * --ii * z = --z`] THEN SIMP_TAC[CEXP_CLOG; CACS_BODY_LEMMA; COMPLEX_FIELD `~(x = Cx(&0)) ==> ((x - inv(x)) / (Cx(&2) * ii) = Cx(&0) <=> x pow 2 = Cx(&1))`] THEN SIMP_TAC[CSQRT; COMPLEX_FIELD `s pow 2 = Cx(&1) - z pow 2 ==> ((z + ii * s) pow 2 = Cx(&1) <=> ii * s * z = Cx(&1) - z pow 2)`] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(COMPLEX_RING `~(x pow 2 + y pow 2 = Cx(&0)) ==> ~(ii * x = y)`) THEN REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_RING);; let CCOS_CSIN_CSQRT = prove (`!z. &0 < cos(Re z) \/ cos(Re z) = &0 /\ Im(z) * sin(Re z) <= &0 ==> ccos(z) = csqrt(Cx(&1) - csin(z) pow 2)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CSQRT_UNIQUE THEN REWRITE_TAC[COMPLEX_EQ_SUB_LADD] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[CSIN_CIRCLE] THEN REWRITE_TAC[RE_CCOS; IM_CCOS] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_HALF; REAL_LT_ADD; REAL_EXP_POS_LT] THEN DISJ2_TAC THEN REWRITE_TAC[REAL_MUL_RZERO] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_ARITH `x * y <= &0 ==> &0 <= --x * y`)) THEN REWRITE_TAC[REAL_MUL_POS_LE] THEN SIMP_TAC[REAL_ARITH `x / &2 = &0 <=> x = &0`; REAL_LT_RDIV_EQ; REAL_ADD_LID; REAL_SUB_LT; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_MUL_LZERO; REAL_SUB_0; REAL_EXP_MONO_LT; REAL_LT_SUB_RADD; REAL_EXP_INJ] THEN REAL_ARITH_TAC);; let CSIN_CCOS_CSQRT = prove (`!z. &0 < sin(Re z) \/ sin(Re z) = &0 /\ &0 <= Im(z) * cos(Re z) ==> csin(z) = csqrt(Cx(&1) - ccos(z) pow 2)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CSQRT_UNIQUE THEN REWRITE_TAC[COMPLEX_EQ_SUB_LADD] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_ADD_SYM] CSIN_CIRCLE] THEN REWRITE_TAC[RE_CSIN; IM_CSIN] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_HALF; REAL_LT_ADD; REAL_EXP_POS_LT] THEN DISJ2_TAC THEN REWRITE_TAC[REAL_MUL_RZERO] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[REAL_MUL_POS_LE] THEN SIMP_TAC[REAL_ARITH `x / &2 = &0 <=> x = &0`; REAL_LT_RDIV_EQ; REAL_ADD_LID; REAL_SUB_LT; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_MUL_LZERO; REAL_SUB_0; REAL_EXP_MONO_LT; REAL_LT_SUB_RADD; REAL_EXP_INJ] THEN REAL_ARITH_TAC);; let CASN_CACS_SQRT_POS = prove (`!z. (&0 < Re z \/ Re z = &0 /\ &0 <= Im z) ==> casn(z) = cacs(csqrt(Cx(&1) - z pow 2))`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[casn; cacs] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_RING `w = z ==> ii * z + s = s + ii * w`) THEN MATCH_MP_TAC CSQRT_UNIQUE THEN ASM_REWRITE_TAC[CSQRT] THEN CONV_TAC COMPLEX_RING);; let CACS_CASN_SQRT_POS = prove (`!z. (&0 < Re z \/ Re z = &0 /\ &0 <= Im z) ==> cacs(z) = casn(csqrt(Cx(&1) - z pow 2))`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[casn; cacs] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_RING `w = z ==> z + ii * s = ii * s + w`) THEN MATCH_MP_TAC CSQRT_UNIQUE THEN ASM_REWRITE_TAC[CSQRT] THEN CONV_TAC COMPLEX_RING);; let CSIN_CACS = prove (`!z. &0 < Re z \/ Re(z) = &0 /\ &0 <= Im z ==> csin(cacs z) = csqrt(Cx(&1) - z pow 2)`, GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM CSIN_CASN] THEN AP_TERM_TAC THEN MATCH_MP_TAC CACS_CASN_SQRT_POS THEN ASM_REWRITE_TAC[]);; let CCOS_CASN = prove (`!z. &0 < Re z \/ Re(z) = &0 /\ &0 <= Im z ==> ccos(casn z) = csqrt(Cx(&1) - z pow 2)`, GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM CCOS_CACS] THEN AP_TERM_TAC THEN MATCH_MP_TAC CASN_CACS_SQRT_POS THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Real arcsin. *) (* ------------------------------------------------------------------------- *) let asn = new_definition `asn(x) = Re(casn(Cx x))`;; let REAL_ASN = prove (`!z. real z /\ abs(Re z) <= &1 ==> real(casn z)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SPEC_TAC(`Re z`,`x:real`) THEN REWRITE_TAC[real; casn; COMPLEX_MUL_LNEG; IM_NEG; IM_MUL_II] THEN GEN_TAC THEN REWRITE_TAC[RE_CX; REAL_NEG_EQ_0] THEN DISCH_TAC THEN MATCH_MP_TAC NORM_CEXP_IMAGINARY THEN SIMP_TAC[CEXP_CLOG; CASN_BODY_LEMMA; NORM_EQ_SQUARE] THEN REWRITE_TAC[DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN ASM_SIMP_TAC[GSYM CX_POW; GSYM CX_SUB; GSYM CX_SQRT; REAL_SUB_LE; ABS_SQUARE_LE_1; RE_CX; IM_CX; REAL_NEG_0; REAL_ADD_LID; SQRT_POW_2] THEN REAL_ARITH_TAC);; let CX_ASN = prove (`!x. abs(x) <= &1 ==> Cx(asn x) = casn(Cx x)`, REWRITE_TAC[asn] THEN MESON_TAC[REAL; RE_CX; REAL_CX; REAL_ASN]);; let SIN_ASN = prove (`!y. --(&1) <= y /\ y <= &1 ==> sin(asn(y)) = y`, REWRITE_TAC[REAL_ARITH `--(&1) <= y /\ y <= &1 <=> abs(y) <= &1`] THEN ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ASN; CX_SIN; CSIN_CASN]);; let ASN_SIN = prove (`!x. --(pi / &2) <= x /\ x <= pi / &2 ==> asn(sin(x)) = x`, ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ASN; SIN_BOUND; CX_SIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CASN_CSIN THEN REWRITE_TAC[IM_CX; RE_CX] THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);; let ASN_BOUNDS_LT = prove (`!y. --(&1) < y /\ y < &1 ==> --(pi / &2) < asn(y) /\ asn(y) < pi / &2`, GEN_TAC THEN REWRITE_TAC[asn] THEN MP_TAC(SPEC `Cx y` CASN_BOUNDS) THEN REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC);; let ASN_0 = prove (`asn(&0) = &0`, REWRITE_TAC[asn; CASN_0; RE_CX]);; let ASN_1 = prove (`asn(&1) = pi / &2`, REWRITE_TAC[asn; CASN_1; RE_CX]);; let ASN_NEG_1 = prove (`asn(-- &1) = --(pi / &2)`, REWRITE_TAC[asn; CX_NEG; CASN_NEG_1; RE_CX; RE_NEG]);; let ASN_BOUNDS = prove (`!y. --(&1) <= y /\ y <= &1 ==> --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN MAP_EVERY MP_TAC [ASN_1; ASN_NEG_1; SPEC `y:real` ASN_BOUNDS_LT] THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let ASN_BOUNDS_PI2 = prove (`!x. &0 <= x /\ x <= &1 ==> &0 <= asn x /\ asn x <= pi / &2`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`&0`; `asn x`] SIN_MONO_LE_EQ) THEN ASM_SIMP_TAC[SIN_0; SIN_ASN; REAL_ARITH `&0 <= x ==> --(&1) <= x`] THEN MP_TAC(SPEC `x:real` ASN_BOUNDS) THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC);; let ASN_NEG = prove (`!x. -- &1 <= x /\ x <= &1 ==> asn(--x) = --asn(x)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM(MATCH_MP SIN_ASN th)]) THEN REWRITE_TAC[GSYM SIN_NEG] THEN MATCH_MP_TAC ASN_SIN THEN REWRITE_TAC[REAL_ARITH `--a <= --x /\ --x <= a <=> --a <= x /\ x <= a`] THEN ASM_SIMP_TAC[ASN_BOUNDS]);; let COS_ASN_NZ = prove (`!x. --(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)`, ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ASN; CX_COS; REAL_ARITH `--(&1) < x /\ x < &1 ==> abs(x) <= &1`] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CCOS_CASN_NZ THEN SIMP_TAC[COMPLEX_RING `x pow 2 = Cx(&1) <=> x = Cx(&1) \/ x = --Cx(&1)`] THEN REWRITE_TAC[GSYM CX_NEG; CX_INJ] THEN ASM_REAL_ARITH_TAC);; let ASN_MONO_LT_EQ = prove (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (asn(x) < asn(y) <=> x < y)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sin(asn(x)) < sin(asn(y))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SIN_MONO_LT_EQ THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THEN MATCH_MP_TAC ASN_BOUNDS; BINOP_TAC THEN MATCH_MP_TAC SIN_ASN] THEN ASM_REAL_ARITH_TAC);; let ASN_MONO_LE_EQ = prove (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (asn(x) <= asn(y) <=> x <= y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_SIMP_TAC[ASN_MONO_LT_EQ]);; let ASN_MONO_LT = prove (`!x y. --(&1) <= x /\ x < y /\ y <= &1 ==> asn(x) < asn(y)`, MP_TAC ASN_MONO_LT_EQ THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REAL_ARITH_TAC);; let ASN_MONO_LE = prove (`!x y. --(&1) <= x /\ x <= y /\ y <= &1 ==> asn(x) <= asn(y)`, MP_TAC ASN_MONO_LE_EQ THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REAL_ARITH_TAC);; let COS_ASN = prove (`!x. --(&1) <= x /\ x <= &1 ==> cos(asn x) = sqrt(&1 - x pow 2)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM SQRT_UNIQUE) THEN ASM_SIMP_TAC[ASN_BOUNDS; COS_POS_PI_LE; REAL_EQ_SUB_RADD] THEN ASM_MESON_TAC[SIN_ASN; SIN_CIRCLE; REAL_ADD_SYM]);; (* ------------------------------------------------------------------------- *) (* Real arccosine. *) (* ------------------------------------------------------------------------- *) let acs = new_definition `acs(x) = Re(cacs(Cx x))`;; let REAL_ACS = prove (`!z. real z /\ abs(Re z) <= &1 ==> real(cacs z)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SPEC_TAC(`Re z`,`x:real`) THEN REWRITE_TAC[real; cacs; COMPLEX_MUL_LNEG; IM_NEG; IM_MUL_II] THEN GEN_TAC THEN REWRITE_TAC[RE_CX; REAL_NEG_EQ_0] THEN DISCH_TAC THEN MATCH_MP_TAC NORM_CEXP_IMAGINARY THEN SIMP_TAC[CEXP_CLOG; CACS_BODY_LEMMA; NORM_EQ_SQUARE] THEN REWRITE_TAC[DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN ASM_SIMP_TAC[GSYM CX_POW; GSYM CX_SUB; GSYM CX_SQRT; REAL_SUB_LE; ABS_SQUARE_LE_1; RE_CX; IM_CX; REAL_NEG_0; REAL_ADD_LID; SQRT_POW_2] THEN REAL_ARITH_TAC);; let CX_ACS = prove (`!x. abs(x) <= &1 ==> Cx(acs x) = cacs(Cx x)`, REWRITE_TAC[acs] THEN MESON_TAC[REAL; RE_CX; REAL_CX; REAL_ACS]);; let COS_ACS = prove (`!y. --(&1) <= y /\ y <= &1 ==> cos(acs(y)) = y`, REWRITE_TAC[REAL_ARITH `--(&1) <= y /\ y <= &1 <=> abs(y) <= &1`] THEN ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ACS; CX_COS; CCOS_CACS]);; let ACS_COS = prove (`!x. &0 <= x /\ x <= pi ==> acs(cos(x)) = x`, ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ACS; COS_BOUND; CX_COS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CACS_CCOS THEN REWRITE_TAC[IM_CX; RE_CX] THEN ASM_REAL_ARITH_TAC);; let ACS_BOUNDS_LT = prove (`!y. --(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi`, GEN_TAC THEN REWRITE_TAC[acs] THEN MP_TAC(SPEC `Cx y` CACS_BOUNDS) THEN REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC);; let ACS_0 = prove (`acs(&0) = pi / &2`, REWRITE_TAC[acs; CACS_0; RE_CX]);; let ACS_1 = prove (`acs(&1) = &0`, REWRITE_TAC[acs; CACS_1; RE_CX]);; let ACS_NEG_1 = prove (`acs(-- &1) = pi`, REWRITE_TAC[acs; CX_NEG; CACS_NEG_1; RE_CX; RE_NEG]);; let ACS_BOUNDS = prove (`!y. --(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN MAP_EVERY MP_TAC [ACS_1; ACS_NEG_1; SPEC `y:real` ACS_BOUNDS_LT] THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; let ACS_NEG = prove (`!x. -- &1 <= x /\ x <= &1 ==> acs(--x) = pi - acs(x)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM(MATCH_MP COS_ACS th)]) THEN ONCE_REWRITE_TAC[GSYM COS_NEG] THEN REWRITE_TAC[GSYM COS_PERIODIC_PI] THEN REWRITE_TAC[REAL_ARITH `--x + y:real = y - x`] THEN MATCH_MP_TAC ACS_COS THEN SIMP_TAC[REAL_ARITH `&0 <= p - x /\ p - x <= p <=> &0 <= x /\ x <= p`] THEN ASM_SIMP_TAC[ACS_BOUNDS]);; let SIN_ACS_NZ = prove (`!x. --(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)`, ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ACS; CX_SIN; REAL_ARITH `--(&1) < x /\ x < &1 ==> abs(x) <= &1`] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CSIN_CACS_NZ THEN SIMP_TAC[COMPLEX_RING `x pow 2 = Cx(&1) <=> x = Cx(&1) \/ x = --Cx(&1)`] THEN REWRITE_TAC[GSYM CX_NEG; CX_INJ] THEN ASM_REAL_ARITH_TAC);; let ACS_MONO_LT_EQ = prove (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (acs(x) < acs(y) <=> y < x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `cos(acs(y)) < cos(acs(x))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC COS_MONO_LT_EQ THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THEN MATCH_MP_TAC ACS_BOUNDS; BINOP_TAC THEN MATCH_MP_TAC COS_ACS] THEN ASM_REAL_ARITH_TAC);; let ACS_MONO_LE_EQ = prove (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (acs(x) <= acs(y) <=> y <= x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_SIMP_TAC[ACS_MONO_LT_EQ]);; let ACS_MONO_LT = prove (`!x y. --(&1) <= x /\ x < y /\ y <= &1 ==> acs(y) < acs(x)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`y:real`; `x:real`] ACS_MONO_LT_EQ) THEN REAL_ARITH_TAC);; let ACS_MONO_LE = prove (`!x y. --(&1) <= x /\ x <= y /\ y <= &1 ==> acs(y) <= acs(x)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`y:real`; `x:real`] ACS_MONO_LE_EQ) THEN REAL_ARITH_TAC);; let SIN_ACS = prove (`!x. --(&1) <= x /\ x <= &1 ==> sin(acs x) = sqrt(&1 - x pow 2)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM SQRT_UNIQUE) THEN ASM_SIMP_TAC[ACS_BOUNDS; SIN_POS_PI_LE; REAL_EQ_SUB_RADD] THEN ASM_MESON_TAC[COS_ACS; SIN_CIRCLE]);; let ACS_INJ = prove (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (acs x = acs y <=> x = y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_SIMP_TAC[ACS_MONO_LE_EQ] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Some interrelationships among the real inverse trig functions. *) (* ------------------------------------------------------------------------- *) let ACS_ATN = prove (`!x. -- &1 < x /\ x < &1 ==> acs(x) = pi / &2 - atn(x / sqrt(&1 - x pow 2))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x:real = p - y <=> y - (p - x) = &0`] THEN MATCH_MP_TAC SIN_EQ_0_PI THEN ASM_SIMP_TAC[ATN_BOUND; ACS_BOUNDS; REAL_LT_IMP_LE; REAL_ARITH `abs(x) < pi / &2 /\ &0 <= y /\ y <= pi ==> --pi < x - (pi / &2 - y) /\ x - (pi / &2 - y) < pi`] THEN SUBGOAL_THEN `tan(atn(x / sqrt(&1 - x pow 2))) = tan(pi / &2 - acs x)` MP_TAC THENL [REWRITE_TAC[TAN_COT; ATN_TAN] THEN REWRITE_TAC[tan] THEN ASM_SIMP_TAC[SIN_ACS; COS_ACS; REAL_LT_IMP_LE; REAL_INV_DIV]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_SUB_0] THEN ASM_SIMP_TAC[SIN_ACS_NZ; GSYM SIN_COS; COS_ATN_NZ; REAL_SUB_TAN; REAL_FIELD `~(y = &0) /\ ~(z = &0) ==> (x / (y * z) = &0 <=> x = &0)`]);; let ASN_PLUS_ACS = prove (`!x. -- &1 <= x /\ x <= &1 ==> asn(x) + acs(x) = pi / &2`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x + y:real = p <=> x = p - y`] THEN MATCH_MP_TAC SIN_INJ_PI THEN ASM_SIMP_TAC[SIN_PI2; COS_PI2; SIN_SUB; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN ASM_SIMP_TAC[SIN_ASN; COS_ACS; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `--p <= p - x <=> x <= &2 * p`; REAL_ARITH `p - x <= p <=> &0 <= x`] THEN ASM_SIMP_TAC[ASN_BOUNDS; ACS_BOUNDS; REAL_ARITH `&2 * x / &2 = x`]);; let ASN_ACS = prove (`!x. -- &1 <= x /\ x <= &1 ==> asn(x) = pi / &2 - acs(x)`, SIMP_TAC[REAL_EQ_SUB_LADD; ASN_PLUS_ACS]);; let ACS_ASN = prove (`!x. -- &1 <= x /\ x <= &1 ==> acs(x) = pi / &2 - asn(x)`, SIMP_TAC[ASN_ACS] THEN REAL_ARITH_TAC);; let ASN_ATN = prove (`!x. -- &1 < x /\ x < &1 ==> asn(x) = atn(x / sqrt(&1 - x pow 2))`, SIMP_TAC[ASN_ACS; REAL_LT_IMP_LE; ACS_ATN] THEN REAL_ARITH_TAC);; let ASN_ACS_SQRT_POS = prove (`!x. &0 <= x /\ x <= &1 ==> asn(x) = acs(sqrt(&1 - x pow 2))`, REPEAT STRIP_TAC THEN REWRITE_TAC[asn; acs] THEN ASM_SIMP_TAC[CX_SQRT; REAL_SUB_LE; REAL_POW_1_LE; CX_SUB; CX_POW] THEN AP_TERM_TAC THEN MATCH_MP_TAC CASN_CACS_SQRT_POS THEN ASM_REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC);; let ASN_ACS_SQRT_NEG = prove (`!x. -- &1 <= x /\ x <= &0 ==> asn(x) = --acs(sqrt(&1 - x pow 2))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x = --y <=> (--x:real) = y`] THEN ASM_SIMP_TAC[GSYM ASN_NEG; REAL_ARITH `x <= &0 ==> x <= &1`] THEN ONCE_REWRITE_TAC[REAL_ARITH `(x:real) pow 2 = (--x) pow 2`] THEN MATCH_MP_TAC ASN_ACS_SQRT_POS THEN ASM_REAL_ARITH_TAC);; let ACS_ASN_SQRT_POS = prove (`!x. &0 <= x /\ x <= &1 ==> acs(x) = asn(sqrt(&1 - x pow 2))`, REPEAT STRIP_TAC THEN REWRITE_TAC[asn; acs] THEN ASM_SIMP_TAC[CX_SQRT; REAL_SUB_LE; REAL_POW_1_LE; CX_SUB; CX_POW] THEN AP_TERM_TAC THEN MATCH_MP_TAC CACS_CASN_SQRT_POS THEN ASM_REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC);; let ACS_ASN_SQRT_NEG = prove (`!x. -- &1 <= x /\ x <= &0 ==> acs(x) = pi - asn(sqrt(&1 - x pow 2))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `--x:real` ACS_ASN_SQRT_POS) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[REAL_POW_NEG; ARITH]] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_NEG_NEG] THEN MATCH_MP_TAC ACS_NEG THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* More delicate continuity results for arcsin and arccos. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_CASN_REAL = prove (`casn continuous_on {w | real w /\ abs(Re w) <= &1}`, MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `IMAGE csin {z | real z /\ abs(Re z) <= pi / &2}` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN REWRITE_TAC[CONTINUOUS_ON_CSIN] THEN CONJ_TAC THENL [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(Cx(&0),pi / &2)` THEN REWRITE_TAC[BOUNDED_CBALL; SUBSET; IN_ELIM_THM; IN_CBALL] THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; real] THEN X_GEN_TAC `z:complex` THEN MP_TAC(SPEC `z:complex` COMPLEX_NORM_LE_RE_IM) THEN REAL_ARITH_TAC; SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`; GSYM REAL_BOUNDS_LE] THEN SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]; SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CASN_CSIN THEN REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC]; SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX; IN_IMAGE] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN EXISTS_TAC `Cx(asn x)` THEN ASM_SIMP_TAC[RE_CX; ASN_BOUNDS; REAL_BOUNDS_LE; REAL_CX; SIN_ASN; GSYM CX_SIN] THEN ASM_MESON_TAC[REAL_BOUNDS_LE; ASN_BOUNDS]]);; let CONTINUOUS_WITHIN_CASN_REAL = prove (`!z. casn continuous (at z within {w | real w /\ abs(Re w) <= &1})`, GEN_TAC THEN ASM_CASES_TAC `z IN {w | real w /\ abs(Re w) <= &1}` THENL [ASM_SIMP_TAC[REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] CONTINUOUS_ON_CASN_REAL]; MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN ASM_SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]);; let CONTINUOUS_ON_CACS_REAL = prove (`cacs continuous_on {w | real w /\ abs(Re w) <= &1}`, MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `IMAGE ccos {z | real z /\ &0 <= Re z /\ Re z <= pi}` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN REWRITE_TAC[CONTINUOUS_ON_CCOS] THEN CONJ_TAC THENL [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(Cx(&0),&2 * pi)` THEN REWRITE_TAC[BOUNDED_CBALL; SUBSET; IN_ELIM_THM; IN_CBALL] THEN REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; real] THEN X_GEN_TAC `z:complex` THEN MP_TAC(SPEC `z:complex` COMPLEX_NORM_LE_RE_IM) THEN REAL_ARITH_TAC; SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]; SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CACS_CCOS THEN REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC]; SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX; IN_IMAGE] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN EXISTS_TAC `Cx(acs x)` THEN ASM_SIMP_TAC[RE_CX; ACS_BOUNDS; REAL_BOUNDS_LE; REAL_CX; COS_ACS; GSYM CX_COS]]);; let CONTINUOUS_WITHIN_CACS_REAL = prove (`!z. cacs continuous (at z within {w | real w /\ abs(Re w) <= &1})`, GEN_TAC THEN ASM_CASES_TAC `z IN {w | real w /\ abs(Re w) <= &1}` THENL [ASM_SIMP_TAC[REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] CONTINUOUS_ON_CACS_REAL]; MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN ASM_SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]);; (* ------------------------------------------------------------------------- *) (* Some limits, most involving sequences of transcendentals. *) (* ------------------------------------------------------------------------- *) let LIM_CX_OVER_CEXP = prove (`((\x. Cx x / cexp(Cx x)) --> Cx(&0)) at_posinfinity`, ONCE_REWRITE_TAC[LIM_NULL_COMPLEX_NORM] THEN REWRITE_TAC[LIM_AT_POSINFINITY; real_ge] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `max (&1) (&1 + &2 * log (&2 / e))` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN REWRITE_TAC[dist; COMPLEX_SUB_RZERO; COMPLEX_NORM_CX; REAL_ABS_NORM] THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CEXP; COMPLEX_NORM_CX; RE_CX] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EXP_POS_LT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = x / &2 + x / &2`] THEN REWRITE_TAC[REAL_EXP_ADD; REAL_ARITH `x / e < y * y <=> x / &2 * &2 / e < y * y`] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC(REAL_ARITH `&1 <= x /\ &1 + x / &2 <= y ==> abs x / &2 < y`) THEN ASM_REWRITE_TAC[REAL_EXP_LE_X]; ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE]; MATCH_MP_TAC LOG_MONO_LT_REV THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LOG_EXP; REAL_ARITH `&1 <= x ==> &0 < x`; REAL_EXP_POS_LT] THEN ASM_REAL_ARITH_TAC]);; let LIM_Z_TIMES_CLOG = prove (`((\z. z * clog z) --> Cx(&0)) (at (Cx(&0)))`, ONCE_REWRITE_TAC[SPEC `clog z` COMPLEX_EXPAND] THEN REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN CONJ_TAC THENL [SIMP_TAC[RE_CLOG] THEN MP_TAC LIM_CX_OVER_CEXP THEN REWRITE_TAC[LIM_AT_POSINFINITY; LIM_AT; dist; COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[real_ge] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_CEXP; RE_CX] THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN EXISTS_TAC `inv(exp b)` THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_EXP_POS_LT] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `log(inv(norm(z:complex)))`) THEN ASM_SIMP_TAC[LOG_INV; EXP_LOG; REAL_LT_INV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_div; REAL_INV_INV; REAL_ABS_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN GEN_REWRITE_TAC I [GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; REAL_EXP_NEG] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN REWRITE_TAC[LIM_AT_ID] THEN EXISTS_TAC `pi` THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_II; COMPLEX_NORM_CX] THEN REWRITE_TAC[EVENTUALLY_AT; dist; COMPLEX_SUB_0; COMPLEX_NORM_NZ] THEN SIMP_TAC[CLOG_WORKS; REAL_MUL_LID; REAL_ABS_BOUNDS; REAL_LT_IMP_LE] THEN MESON_TAC[REAL_LT_01]]);; let LIM_LOG_OVER_Z = prove (`((\z. clog z / z) --> Cx(&0)) at_infinity`, SIMP_TAC[LIM_AT_INFINITY_COMPLEX_0; o_DEF; complex_div; COMPLEX_INV_INV; CLOG_INV] THEN ONCE_REWRITE_TAC[COMPLEX_RING `clog(inv z) * z = z * (clog z + clog(inv z)) - z * clog z`] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_SUB THEN REWRITE_TAC[LIM_Z_TIMES_CLOG] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN REWRITE_TAC[LIM_AT_ID] THEN EXISTS_TAC `&2 * pi` THEN REWRITE_TAC[EVENTUALLY_AT; dist; COMPLEX_SUB_RZERO; COMPLEX_NORM_NZ] THEN EXISTS_TAC `&1` THEN SIMP_TAC[REAL_LT_01] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EXPAND] THEN ASM_SIMP_TAC[RE_ADD; RE_CLOG; REAL_LT_INV_EQ; COMPLEX_INV_EQ_0; COMPLEX_NORM_INV; LOG_INV; COMPLEX_NORM_NZ] THEN REWRITE_TAC[REAL_ADD_RINV; COMPLEX_ADD_LID; COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_II; COMPLEX_NORM_CX; IM_ADD] THEN MATCH_MP_TAC(REAL_ARITH `--pi < x /\ x <= pi /\ --pi < y /\ y <= pi ==> &1 * abs(x + y) <= &2 * pi`) THEN ASM_SIMP_TAC[CLOG_WORKS; COMPLEX_INV_EQ_0]);; let LIM_LOG_OVER_POWER = prove (`!s. &0 < Re s ==> ((\x. clog(Cx x) / (Cx x) cpow s) --> Cx(&0)) at_posinfinity`, REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT_POSINFINITY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[real_ge] THEN MP_TAC(REWRITE_RULE[LIM_AT_POSINFINITY] LIM_CX_OVER_CEXP) THEN DISCH_THEN(MP_TAC o SPEC `Re s * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL; real_ge; dist; COMPLEX_SUB_RZERO] THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_CEXP; RE_CX] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `max (&1) (exp((abs B + &1) / Re s))` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[NORM_CPOW_REAL; COMPLEX_NORM_DIV; REAL_CX; RE_CX; GSYM CX_LOG; COMPLEX_NORM_CX; real_abs; LOG_POS] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `Re s` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `Re s * log x`) THEN ASM_SIMP_TAC[real_abs; REAL_LE_MUL; LOG_POS; REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs b + &1 <= x * y ==> b <= y * x`) THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG]);; let LIM_LOG_OVER_X = prove (`((\x. clog(Cx x) / Cx x) --> Cx(&0)) at_posinfinity`, MP_TAC(SPEC `Cx(&1)` LIM_LOG_OVER_POWER) THEN REWRITE_TAC[CPOW_N; RE_CX; REAL_LT_01; COMPLEX_POW_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; CX_INJ] THEN EXISTS_TAC `&1` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let LIM_LOG_OVER_POWER_N = prove (`!s. &0 < Re s ==> ((\n. clog(Cx(&n)) / Cx(&n) cpow s) --> Cx(&0)) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN ASM_SIMP_TAC[LIM_LOG_OVER_POWER]);; let LIM_LOG_OVER_N = prove (`((\n. clog(Cx(&n)) / Cx(&n)) --> Cx(&0)) sequentially`, MP_TAC(SPEC `Cx(&1)` LIM_LOG_OVER_POWER_N) THEN SIMP_TAC[RE_CX; REAL_LT_01] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; CPOW_N; CX_INJ] THEN EXISTS_TAC `1` THEN SIMP_TAC[COMPLEX_POW_1; REAL_OF_NUM_EQ; ARITH_RULE `1 <= n <=> ~(n = 0)`]);; let LIM_1_OVER_POWER = prove (`!s. &0 < Re s ==> ((\n. Cx(&1) / Cx(&n) cpow s) --> Cx(&0)) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_COMPLEX_BOUND THEN EXISTS_TAC `\n. clog(Cx(&n)) / Cx(&n) cpow s` THEN ASM_SIMP_TAC[LIM_LOG_OVER_POWER_N] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MP_TAC(ISPEC `exp(&1)` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN ASM_CASES_TAC `N = 0` THENL [ASM_SIMP_TAC[GSYM REAL_NOT_LT; REAL_EXP_POS_LT]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[complex_div; COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LT_NZ] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; let LIM_INV_Z_OFFSET = prove (`!z. ((\w. inv(w + z)) --> Cx(&0)) at_infinity`, GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY_COMPLEX_0; o_DEF] THEN SIMP_TAC[COMPLEX_INV_DIV; COMPLEX_FIELD `~(w = Cx(&0)) ==> inv w + z = (Cx(&1) + w * z) / w`] THEN GEN_REWRITE_TAC LAND_CONV [COMPLEX_FIELD `Cx(&0) = Cx(&0) / (Cx(&1) + Cx(&0) * z)`] THEN MATCH_MP_TAC LIM_COMPLEX_DIV THEN REWRITE_TAC[COMPLEX_RING `~(Cx(&1) + Cx(&0) * z = Cx(&0))`] THEN CONJ_TAC THEN LIM_TAC);; let LIM_INV_Z = prove (`((\z. inv(z)) --> Cx(&0)) at_infinity`, ONCE_REWRITE_TAC[MESON[COMPLEX_ADD_RID] `inv z = inv(z + Cx(&0))`] THEN REWRITE_TAC[LIM_INV_Z_OFFSET]);; let LIM_INV_X_OFFSET = prove (`!z. ((\x. inv(Cx x + z)) --> Cx(&0)) at_posinfinity`, GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN REWRITE_TAC[LIM_INV_Z_OFFSET]);; let LIM_INV_X = prove (`((\x. inv(Cx x)) --> Cx(&0)) at_posinfinity`, MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN REWRITE_TAC[REWRITE_RULE[ETA_AX] LIM_INV_Z]);; let LIM_INV_N_OFFSET = prove (`!z. ((\n. inv(Cx(&n) + z)) --> Cx(&0)) sequentially`, GEN_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN REWRITE_TAC[LIM_INV_X_OFFSET]);; let LIM_1_OVER_N = prove (`((\n. Cx(&1) / Cx(&n)) --> Cx(&0)) sequentially`, MP_TAC(SPEC `Cx(&1)` LIM_1_OVER_POWER) THEN SIMP_TAC[RE_CX; REAL_LT_01] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; CPOW_N; CX_INJ] THEN EXISTS_TAC `1` THEN SIMP_TAC[COMPLEX_POW_1; REAL_OF_NUM_EQ; ARITH_RULE `1 <= n <=> ~(n = 0)`]);; let LIM_INV_N = prove (`((\n. inv(Cx(&n))) --> Cx(&0)) sequentially`, MP_TAC LIM_1_OVER_N THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID]);; let LIM_INV_Z_POW_OFFSET = prove (`!z n. 1 <= n ==> ((\w. inv(w + z) pow n) --> Cx(&0)) at_infinity`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `Cx(&0) = Cx(&0) pow n` SUBST1_TAC THENL [ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1]; MATCH_MP_TAC LIM_COMPLEX_POW THEN REWRITE_TAC[LIM_INV_Z_OFFSET]]);; let LIM_INV_Z_POW = prove (`!n. 1 <= n ==> ((\z. inv(z) pow n) --> Cx(&0)) at_infinity`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `Cx(&0) = Cx(&0) pow n` SUBST1_TAC THENL [ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1]; MATCH_MP_TAC LIM_COMPLEX_POW THEN REWRITE_TAC[REWRITE_RULE[ETA_AX] LIM_INV_Z]]);; let LIM_INV_X_POW_OFFSET = prove (`!z n. 1 <= n ==> ((\x. inv(Cx x + z) pow n) --> Cx(&0)) at_posinfinity`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN ASM_SIMP_TAC[LIM_INV_Z_POW_OFFSET]);; let LIM_INV_X_POW = prove (`!n. 1 <= n ==> ((\x. inv(Cx x) pow n) --> Cx(&0)) at_posinfinity`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN ASM_SIMP_TAC[LIM_INV_Z_POW]);; let LIM_INV_N_POW_OFFSET = prove (`!z m. 1 <= m ==> ((\n. inv(Cx(&n) + z) pow m) --> Cx(&0)) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN ASM_SIMP_TAC[LIM_INV_X_POW_OFFSET]);; let LIM_INV_N_POW = prove (`!m. 1 <= m ==> ((\n. inv(Cx(&n)) pow m) --> Cx(&0)) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN ASM_SIMP_TAC[LIM_INV_X_POW]);; let LIM_1_OVER_LOG = prove (`((\n. Cx(&1) / clog(Cx(&n))) --> Cx(&0)) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN X_CHOOSE_TAC `N:num` (SPEC `exp(inv e)` REAL_ARCH_SIMPLE) THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[dist; COMPLEX_SUB_RZERO; COMPLEX_MUL_LID; complex_div] THEN SUBGOAL_THEN `0 < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE [GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD]) THEN ASM_SIMP_TAC[GSYM CX_LOG; COMPLEX_NORM_CX; COMPLEX_NORM_INV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `a < x ==> a < abs x`) THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LT] THEN ASM_SIMP_TAC[EXP_LOG] THEN ASM_REAL_ARITH_TAC);; let LIM_N_TIMES_POWN = prove (`!z. norm(z) < &1 ==> ((\n. Cx(&n) * z pow n) --> Cx(&0)) sequentially`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_SIMP_TAC[COMPLEX_POW_ZERO; LIM_CASES_FINITE_SEQUENTIALLY; LIM_CONST; COND_RAND; FINITE_SING; SING_GSPEC; COMPLEX_MUL_RZERO] THEN MP_TAC LIM_LOG_OVER_N THEN REWRITE_TAC[LIM_SEQUENTIALLY; dist; COMPLEX_SUB_RZERO] THEN DISCH_THEN(MP_TAC o SPEC `log(inv(norm(z:complex))) / &2`) THEN ASM_SIMP_TAC[LOG_POS_LT; REAL_INV_1_LT; COMPLEX_NORM_NZ; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "+")) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN EXISTS_TAC `MAX 1 (MAX N1 N2)` THEN REWRITE_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LE_1; GSYM CX_DIV; COMPLEX_NORM_CX; REAL_ABS_DIV; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH; real_abs; LOG_POS; REAL_OF_NUM_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `a / b * &2 = (&2 * a) / b`] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LT] THEN ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_OF_NUM_LT; LE_1; REAL_LT_INV_EQ; COMPLEX_NORM_NZ] THEN REWRITE_TAC[REAL_POW_INV] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_POW_LT; COMPLEX_NORM_NZ; COMPLEX_NORM_MUL; COMPLEX_NORM_NUM; COMPLEX_NORM_POW] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N2)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&n)` THEN ASM_SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&n` THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_OF_NUM_LT; LE_1] THEN ASM_REAL_ARITH_TAC);; let LIM_N_OVER_POWN = prove (`!z. &1 < norm(z) ==> ((\n. Cx(&n) / z pow n) --> Cx(&0)) sequentially`, ASM_SIMP_TAC[complex_div; GSYM COMPLEX_POW_INV; COMPLEX_NORM_INV; REAL_INV_LT_1; LIM_N_TIMES_POWN]);; let LIM_POWN = prove (`!z. norm(z) < &1 ==> ((\n. z pow n) --> Cx(&0)) sequentially`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\n. Cx(&n) * z pow n` THEN ASM_SIMP_TAC[LIM_N_TIMES_POWN] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `a <= n * a <=> &0 <= (n - &1) * a`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[NORM_POS_LE; REAL_SUB_LE; REAL_OF_NUM_LE]);; let LIM_CSIN_OVER_X = prove (`((\z. csin z / z) --> Cx(&1)) (at (Cx(&0)))`, ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN EXISTS_TAC `\z. cexp(Cx(abs(Im z))) * z pow 2 / Cx(&2)` THEN REWRITE_TAC[EVENTUALLY_AT] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; dist; COMPLEX_SUB_RZERO] THEN X_GEN_TAC `z:complex` THEN SIMP_TAC[COMPLEX_NORM_NZ] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `norm(z:complex)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ; GSYM COMPLEX_NORM_MUL] THEN ASM_SIMP_TAC[COMPLEX_FIELD `~(z = Cx(&0)) ==> z * (s / z - Cx(&1)) = s - z`] THEN REWRITE_TAC[GSYM CX_EXP; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN REWRITE_TAC[GSYM real_abs] THEN MP_TAC(ISPECL [`0`; `z:complex`] TAYLOR_CSIN) THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN REWRITE_TAC[COMPLEX_NORM_POW] THEN REAL_ARITH_TAC; LIM_TAC THEN TRY(CONV_TAC COMPLEX_RING) THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN REWRITE_TAC[CONTINUOUS_AT; LIM_AT; dist; COMPLEX_SUB_RZERO; IM_CX; REAL_ABS_NUM; COMPLEX_NORM_CX; REAL_ABS_ABS] THEN MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]]);; (* ------------------------------------------------------------------------- *) (* Roots of unity. *) (* ------------------------------------------------------------------------- *) let COMPLEX_ROOT_POLYFUN = prove (`!n z a. 1 <= n ==> (z pow n = a <=> vsum(0..n) (\i. (if i = 0 then --a else if i = n then Cx(&1) else Cx(&0)) * z pow i) = Cx(&0))`, ASM_SIMP_TAC[VSUM_CLAUSES_RIGHT; LE_1; LE_0] THEN SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN ASM_SIMP_TAC[LE_1; ARITH_RULE `1 <= n /\ 1 <= i /\ i <= n - 1 ==> ~(i = n)`] THEN REWRITE_TAC[COMPLEX_MUL_LZERO; complex_pow; COMPLEX_MUL_RID] THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0; VECTOR_ADD_RID] THEN REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_RING);; let COMPLEX_ROOT_UNITY = prove (`!n j. ~(n = 0) ==> cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) pow n = Cx(&1)`, REWRITE_TAC[GSYM CEXP_N; CX_DIV] THEN ASM_SIMP_TAC[CX_INJ; complex_div; REAL_OF_NUM_EQ; COMPLEX_FIELD `~(n = Cx(&0)) ==> n * t * p * ii * j * inv(n) = j * (ii * t * p)`] THEN REWRITE_TAC[CEXP_N; GSYM CX_MUL] THEN REWRITE_TAC[CEXP_EULER; GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS] THEN REWRITE_TAC[COS_NPI; SIN_NPI; REAL_POW_NEG; COMPLEX_MUL_RZERO; REAL_POW_ONE; ARITH_EVEN; COMPLEX_ADD_RID; COMPLEX_POW_ONE]);; let COMPLEX_ROOT_UNITY_EQ = prove (`!n j k. ~(n = 0) ==> (cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) = cexp(Cx(&2) * Cx pi * ii * Cx(&k / &n)) <=> (j == k) (mod n))`, REPEAT STRIP_TAC THEN REWRITE_TAC[CEXP_EQ; num_congruent; CX_MUL] THEN REWRITE_TAC[COMPLEX_RING `t * p * ii * j = t * p * ii * k + (t * n * p) * ii <=> (t * p * ii = Cx(&0)) \/ j - k = n`] THEN SIMP_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ; PI_NZ; REAL_OF_NUM_EQ; ARITH] THEN REWRITE_TAC[GSYM CX_SUB; CX_INJ] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `~(n = &0) ==> (j / n - k / n = m <=> j - k = n * m)`] THEN REWRITE_TAC[int_congruent] THEN REWRITE_TAC[int_eq; int_sub_th; int_mul_th; int_of_num_th] THEN MESON_TAC[int_abstr; int_rep]);; let COMPLEX_ROOT_UNITY_EQ_1 = prove (`!n j. ~(n = 0) ==> (cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) = Cx(&1) <=> n divides j)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `Cx(&1) = cexp(Cx(&2) * Cx pi * ii * Cx(&n / &n))` SUBST1_TAC THENL [ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; COMPLEX_MUL_RID] THEN ONCE_REWRITE_TAC[COMPLEX_RING `t * p * ii = ii * t * p`] THEN REWRITE_TAC[CEXP_EULER; GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS] THEN REWRITE_TAC[COS_NPI; SIN_NPI] THEN SIMPLE_COMPLEX_ARITH_TAC; ASM_SIMP_TAC[COMPLEX_ROOT_UNITY_EQ] THEN CONV_TAC NUMBER_RULE]);; let FINITE_CARD_COMPLEX_ROOTS_UNITY = prove (`!n. 1 <= n ==> FINITE {z | z pow n = Cx(&1)} /\ CARD {z | z pow n = Cx(&1)} <= n`, REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[COMPLEX_ROOT_POLYFUN] THEN MATCH_MP_TAC COMPLEX_POLYFUN_ROOTBOUND THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_SIMP_TAC[IN_NUMSEG; LE_1; LE_0; LE_REFL] THEN CONV_TAC COMPLEX_RING);; let FINITE_COMPLEX_ROOTS_UNITY = prove (`!n. ~(n = 0) ==> FINITE {z | z pow n = Cx(&1)}`, SIMP_TAC[FINITE_CARD_COMPLEX_ROOTS_UNITY; LE_1]);; let FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT = prove (`!n. 1 <= n ==> FINITE {cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) | j | j < n} /\ CARD {cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) | j | j < n} = n`, let lemma = prove (* So we don't need to load number theories yet *) (`!x y n:num. (x == y) (mod n) /\ x < y + n /\ y < x + n ==> x = y`, REWRITE_TAC[num_congruent; GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_LT] THEN REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN REWRITE_TAC[INT_ARITH `x < y + n /\ y < x + n <=> abs(x - y:int) < n`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[int_congruent] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:int`) MP_TAC) THEN ONCE_REWRITE_TAC[GSYM INT_SUB_0] THEN ASM_SIMP_TAC[INT_ABS_MUL; INT_ENTIRE; INT_ABS_NUM; INT_ARITH `n * x:int < n <=> n * x < n * &1`] THEN DISJ_CASES_TAC(INT_ARITH `&n:int = &0 \/ &0:int < &n`) THEN ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC) in REWRITE_TAC[GSYM HAS_SIZE] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[HAS_SIZE_NUMSEG_LT; COMPLEX_ROOT_UNITY_EQ; LE_1] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let COMPLEX_ROOTS_UNITY = prove (`!n. 1 <= n ==> {z | z pow n = Cx(&1)} = {cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) | j | j < n}`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBSET_LE THEN ASM_SIMP_TAC[FINITE_CARD_COMPLEX_ROOTS_UNITY; FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT] THEN GEN_REWRITE_TAC LAND_CONV [SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_SIMP_TAC[COMPLEX_ROOT_UNITY; LE_1]);; let CARD_COMPLEX_ROOTS_UNITY = prove (`!n. 1 <= n ==> CARD {z | z pow n = Cx(&1)} = n`, SIMP_TAC[COMPLEX_ROOTS_UNITY; FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT]);; let HAS_SIZE_COMPLEX_ROOTS_UNITY = prove (`!n. 1 <= n ==> {z | z pow n = Cx(&1)} HAS_SIZE n`, SIMP_TAC[HAS_SIZE; CARD_COMPLEX_ROOTS_UNITY; FINITE_COMPLEX_ROOTS_UNITY; LE_1]);; let COMPLEX_NOT_ROOT_UNITY = prove (`!n. 1 <= n ==> ?u. norm u = &1 /\ ~(u pow n = Cx(&1))`, GEN_TAC THEN DISCH_TAC THEN ABBREV_TAC `u = cexp (Cx pi * ii * Cx (&1 / &n))` THEN EXISTS_TAC `u : complex` THEN CONJ_TAC THEN EXPAND_TAC "u" THEN REWRITE_TAC [NORM_CEXP; RE_MUL_CX; RE_II; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_EXP_0] THEN EXPAND_TAC "u" THEN REWRITE_TAC[GSYM CEXP_N] THEN ASM_SIMP_TAC[CX_DIV; LE_1; CX_INJ; REAL_OF_NUM_EQ; COMPLEX_FIELD `~(n = Cx(&0)) ==> n * p * i * Cx(&1) / n = i * p`] THEN REWRITE_TAC[CEXP_EULER; RE_CX; IM_CX; GSYM CX_COS; GSYM CX_SIN] THEN REWRITE_TAC[COS_PI; SIN_PI] THEN CONV_TAC COMPLEX_RING);; (* ------------------------------------------------------------------------- *) (* Relation between clog and Arg, and hence continuity of Arg. *) (* ------------------------------------------------------------------------- *) let ARG_CLOG = prove (`!z. &0 < Arg z ==> Arg z = Im(clog(--z)) + pi`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_REWRITE_TAC[Arg_DEF; REAL_LT_REFL]; ALL_TAC] THEN DISCH_TAC THEN MP_TAC(last(CONJUNCTS(SPEC `z:complex` ARG))) THEN ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD `~(z = Cx(&0)) ==> (w = z * a <=> a = w / z)`] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) (cexp(--(ii * Cx pi)))`) THEN REWRITE_TAC[GSYM CEXP_ADD] THEN DISCH_THEN(MP_TAC o AP_TERM `clog`) THEN W(MP_TAC o PART_MATCH (lhs o rand) CLOG_CEXP o lhand o lhand o snd) THEN REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX; IM_NEG] THEN ASM_SIMP_TAC[REAL_LT_ADDR; ARG; REAL_ARITH `z < &2 * pi ==> --pi + z <= pi`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CEXP_NEG; CEXP_EULER] THEN REWRITE_TAC[GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN REWRITE_TAC[CX_NEG; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; SIMPLE_COMPLEX_ARITH `inv(--Cx(&1)) * z / w = --z / w`] THEN DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN REWRITE_TAC[IM_ADD; IM_NEG; IM_MUL_II; RE_CX] THEN MATCH_MP_TAC(REAL_RING `w = z ==> --pi + x = w ==> x = z + pi`) THEN REWRITE_TAC[complex_div] THEN W(MP_TAC o PART_MATCH (lhs o rand) CLOG_MUL_SIMPLE o rand o lhand o snd) THEN ASM_SIMP_TAC[CX_INJ; REAL_INV_EQ_0; COMPLEX_NORM_ZERO; COMPLEX_NEG_EQ_0; GSYM CX_INV; GSYM CX_LOG; REAL_LT_INV_EQ; COMPLEX_NORM_NZ; IM_CX] THEN ASM_SIMP_TAC[REAL_ADD_RID; CLOG_WORKS; COMPLEX_NEG_EQ_0] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IM_ADD; IM_CX; REAL_ADD_RID]);; let CONTINUOUS_AT_ARG = prove (`!z. ~(real z /\ &0 <= Re z) ==> (Cx o Arg) continuous (at z)`, let lemma = prove (`(\z. Cx(Im(f z) + pi)) = (Cx o Im) o (\z. f z + ii * Cx pi)`, REWRITE_TAC[FUN_EQ_THM; o_DEF; IM_ADD; IM_CX; IM_MUL_II; RE_CX]) in REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_AT] THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN EXISTS_TAC `\z. Cx(Im(clog(--z)) + pi)` THEN EXISTS_TAC `(:complex) DIFF {z | real z /\ &0 <= Re z}` THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM; GSYM closed] THEN ASM_SIMP_TAC[o_THM; ARG_CLOG; ARG_LT_NZ; ARG_EQ_0] THEN CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{z | P z /\ Q z} = P INTER {z | Q z}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_REAL; GSYM real_ge; CLOSED_HALFSPACE_RE_GE]; REWRITE_TAC[GSYM CONTINUOUS_AT; lemma] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN REWRITE_TAC[CONTINUOUS_AT_CX_IM] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM ETA_AX] THEN SIMP_TAC[CONTINUOUS_NEG; CONTINUOUS_AT_ID] THEN MATCH_MP_TAC CONTINUOUS_AT_CLOG THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[real; IM_NEG; RE_NEG] THEN REAL_ARITH_TAC]);; let CONTINUOUS_ON_ARG = prove (`!s. (!z. z IN s /\ real z ==> Re z < &0) ==> (Cx o Arg) continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_ARG THEN ASM_MESON_TAC[REAL_NOT_LE]);; let CONTINUOUS_WITHIN_UPPERHALF_ARG = prove (`!z. ~(z = Cx(&0)) ==> (Cx o Arg) continuous (at z) within {z | &0 <= Im z}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `real z /\ &0 <= Re z` THEN ASM_SIMP_TAC[CONTINUOUS_AT_ARG; CONTINUOUS_AT_WITHIN] THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [real]) MP_TAC) THEN SUBGOAL_THEN `~(Re z = &0)` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `~(z = Cx(&0))` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX]; GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT]] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `rotate2d (pi / &2) z` CONTINUOUS_AT_ARG) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[ROTATE2D_PI2; real; IM_MUL_II]; ALL_TAC] THEN REWRITE_TAC[continuous_at; continuous_within] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN REWRITE_TAC[o_THM; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN SUBGOAL_THEN `Arg z = &0` ASSUME_TAC THENL [ASM_SIMP_TAC[ARG_EQ_0; real; REAL_LT_IMP_LE]; ALL_TAC] THEN ASM_CASES_TAC `Arg w = &0` THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN SUBGOAL_THEN `&0 < Arg w` ASSUME_TAC THENL [ASM_REWRITE_TAC[ARG; REAL_LT_LE]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `rotate2d (pi / &2) w`) THEN ASM_REWRITE_TAC[GSYM ROTATE2D_SUB; NORM_ROTATE2D] THEN MP_TAC(ISPECL [`pi / &2`; `z:complex`] ARG_ROTATE2D) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC(REAL_ARITH `w' = p + w ==> abs(w' - p) < e ==> abs(w - &0) < e`) THEN MATCH_MP_TAC ARG_ROTATE2D THEN CONJ_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `&0 < Arg w` THEN ASM_REWRITE_TAC[Arg_DEF; REAL_LT_REFL]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ARG_LE_PI]) THEN MP_TAC(SPEC `w:complex` ARG) THEN REAL_ARITH_TAC]);; let CONTINUOUS_ON_UPPERHALF_ARG = prove (`(Cx o Arg) continuous_on ({z | &0 <= Im z} DIFF {Cx(&0)})`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_DIFF; IN_SING; IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_WITHIN_UPPERHALF_ARG) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_WITHIN_SUBSET) THEN SET_TAC[]);; let CONTINUOUS_ON_COMPOSE_ARG = prove (`!s p:real->real^N. (p o drop) continuous_on interval[vec 0,lift(&2 * pi)] /\ p(&2 * pi) = p(&0) /\ ~(Cx(&0) IN s) ==> (\z. p(Arg z)) continuous_on s`, let ulemma = prove (`!s. s INTER {z | &0 <= Im z} UNION s INTER {z | Im z <= &0} = s`, SET_TAC[REAL_LE_TOTAL]) in REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\z. if &0 <= Im z then p(Arg z) else p(&2 * pi - Arg(cnj z)):real^N` THEN REWRITE_TAC[IN_UNIV; IN_SING; IN_DIFF] THEN CONJ_TAC THENL [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARG_CNJ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_SUB2] THEN SUBGOAL_THEN `Arg z = &0` (fun th -> ASM_REWRITE_TAC[REAL_SUB_RZERO; th]) THEN ASM_REWRITE_TAC[ARG_EQ_0]; GEN_REWRITE_TAC RAND_CONV [GSYM ulemma] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REWRITE_TAC[ulemma] THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_HALFSPACE_IM_LE; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_IM_GE] THEN REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_SING; IN_ELIM_THM] THEN SIMP_TAC[GSYM CONJ_ASSOC; REAL_LE_ANTISYM; TAUT `~(p /\ ~p)`] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV) [GSYM o_DEF] THEN SUBGOAL_THEN `(p:real->real^N) = (p o drop) o lift` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM o_ASSOC] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; o_THM; DROP_VEC] THEN SIMP_TAC[ARG; REAL_LT_IMP_LE]; REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [GSYM o_DEF] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CNJ; o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM; IN_DIFF] THEN SIMP_TAC[IN_SING; CNJ_EQ_0; IM_CNJ; REAL_NEG_GE0] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; o_THM; DROP_VEC] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN MP_TAC(SPEC `cnj z` ARG) THEN REAL_ARITH_TAC]; REWRITE_TAC[GSYM ARG_EQ_0_PI; GSYM real; ARG_CNJ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_SUB2; REAL_SUB_RZERO] THEN ASM_REWRITE_TAC[REAL_ARITH `&2 * x - x = x`]]]);; let OPEN_ARG_LTT = prove (`!s t. &0 <= s /\ t <= &2 * pi ==> open {z | s < Arg z /\ Arg z < t}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`Cx o Arg`; `(:complex) DIFF {z | real z /\ &0 <= Re z}`; `{z | Re(z) > s} INTER {z | Re(z) < t}`] CONTINUOUS_OPEN_PREIMAGE) THEN ASM_SIMP_TAC[OPEN_INTER; OPEN_HALFSPACE_RE_GT; OPEN_HALFSPACE_RE_LT] THEN ANTS_TAC THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM; CONTINUOUS_AT_ARG]; REWRITE_TAC[GSYM closed] THEN REWRITE_TAC[SET_RULE `{z | P z /\ Q z} = P INTER {z | Q z}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_REAL; GSYM real_ge; CLOSED_HALFSPACE_RE_GE]]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION] THEN ASM_SIMP_TAC[IN_DIFF; IN_INTER; IN_UNIV; IN_ELIM_THM; o_THM; RE_CX; GSYM ARG_EQ_0] THEN ASM_REAL_ARITH_TAC]);; let OPEN_ARG_GT = prove (`!t. open {z | t < Arg z}`, GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `t < &0 \/ &0 <= t`) THENL [SUBGOAL_THEN `{z | t < Arg z} = (:complex)` (fun th -> SIMP_TAC[th; OPEN_UNIV]) THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_ELIM_THM] THEN MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC; MP_TAC(ISPECL [`t:real`; `&2 * pi`] OPEN_ARG_LTT) THEN ASM_REWRITE_TAC[ARG; REAL_LE_REFL]]);; let CLOSED_ARG_LE = prove (`!t. closed {z | Arg z <= t}`, REWRITE_TAC[closed; DIFF; IN_UNIV; IN_ELIM_THM] THEN REWRITE_TAC[REAL_NOT_LE; OPEN_ARG_GT]);; (* ------------------------------------------------------------------------- *) (* Relation between Arg and arctangent in upper halfplane. *) (* ------------------------------------------------------------------------- *) let ARG_ATAN_UPPERHALF = prove (`!z. &0 < Im z ==> Arg(z) = pi / &2 - atn(Re z / Im z)`, GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[IM_CX; REAL_LT_REFL] THEN DISCH_TAC THEN MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `norm(z:complex)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN CONJ_TAC THENL [ALL_TAC; MP_TAC(ISPEC `Re z / Im z` ATN_BOUNDS) THEN REAL_ARITH_TAC] THEN REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS] THEN REWRITE_TAC[SIN_SUB; COS_SUB; SIN_PI2; COS_PI2] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; SIN_ATN; COS_ATN] THEN SUBGOAL_THEN `sqrt(&1 + (Re z / Im z) pow 2) = norm(z) / Im z` SUBST1_TAC THENL [MATCH_MP_TAC SQRT_UNIQUE THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_POW_DIV; COMPLEX_SQNORM] THEN UNDISCH_TAC `&0 < Im z` THEN CONV_TAC REAL_FIELD; REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; real_div] THEN REWRITE_TAC[COMPLEX_EQ; RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II; RE_ADD; IM_ADD; RE_CX; IM_CX] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM COMPLEX_NORM_NZ]) THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD]);; (* ------------------------------------------------------------------------- *) (* Real n'th roots. Regardless of whether n is odd or even, we totalize by *) (* setting root_n(-x) = -root_n(x), which makes some convenient facts hold. *) (* ------------------------------------------------------------------------- *) let root = new_definition `root(n) x = real_sgn(x) * exp(log(abs x) / &n)`;; let ROOT_0 = prove (`!n. root n (&0) = &0`, REWRITE_TAC[root; REAL_SGN_0; REAL_MUL_LZERO]);; let ROOT_1 = prove (`!n. root n (&1) = &1`, REWRITE_TAC[root; REAL_ABS_NUM; LOG_1; real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[real_sgn; REAL_EXP_0] THEN REAL_ARITH_TAC);; let ROOT_2 = prove (`!x. root 2 x = sqrt x`, GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN REWRITE_TAC[root; REAL_SGN_MUL; REAL_POW_MUL; REAL_SGN_REAL_SGN] THEN REWRITE_TAC[REAL_SGN_POW_2; GSYM REAL_SGN_POW] THEN SIMP_TAC[real_sgn; REAL_EXP_POS_LT; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `(&0 < abs x <=> ~(x = &0)) /\ ~(abs x < &0)`] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ABS_NUM; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_EXP_N; REAL_ARITH `&2 * x / &2 = x`] THEN ASM_SIMP_TAC[EXP_LOG; REAL_ARITH `&0 < abs x <=> ~(x = &0)`]);; let ROOT_NEG = prove (`!n x. root n (--x) = --(root n x)`, REWRITE_TAC[root; REAL_SGN_NEG; REAL_ABS_NEG; REAL_MUL_LNEG]);; let ROOT_WORKS = prove (`!n x. real_sgn(root n x) = real_sgn x /\ (root n x) pow n = if n = 0 then &1 else real_sgn(x) pow n * abs x`, REWRITE_TAC[root; REAL_SGN_MUL; REAL_POW_MUL; GSYM REAL_EXP_N] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_INV_0; REAL_EXP_0; REAL_MUL_RID; real_pow; REAL_SGN_REAL_SGN] THEN REWRITE_TAC[real_sgn; REAL_LT_01; REAL_MUL_RID] THEN ASM_SIMP_TAC[REAL_EXP_POS_LT; REAL_MUL_RID; GSYM REAL_ABS_NZ; GSYM real_div; REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_POW_ZERO; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[EXP_LOG; GSYM REAL_ABS_NZ]);; let REAL_POW_ROOT = prove (`!n x. ODD n \/ ~(n = 0) /\ &0 <= x ==> (root n x) pow n = x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ROOT_WORKS] THENL [FIRST_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_pow] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_SGN_ABS] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN REWRITE_TAC[REWRITE_RULE[REAL_SGN_POW] REAL_SGN_POW_2] THEN REWRITE_TAC[real_sgn; GSYM REAL_ABS_NZ] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL; REAL_POW_ONE] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[real_sgn; REAL_LT_LE] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_POW_ZERO; REAL_POW_ONE] THEN ASM_REAL_ARITH_TAC]);; let ROOT_POS_LT = prove (`!n x. &0 < x ==> &0 < root n x`, REPEAT STRIP_TAC THEN REWRITE_TAC[root] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_EXP_POS_LT; REAL_SGN_INEQS]);; let ROOT_POS_LE = prove (`!n x. &0 <= x ==> &0 <= root n x`, MESON_TAC[REAL_LE_LT; ROOT_POS_LT; ROOT_0; REAL_LT_REFL]);; let ROOT_LT_0 = prove (`!n x. &0 < root n x <=> &0 < x`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ROOT_POS_LT] THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`; GSYM ROOT_NEG] THEN REWRITE_TAC[ROOT_POS_LE]);; let ROOT_LE_0 = prove (`!n x. &0 <= root n x <=> &0 <= x`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ROOT_POS_LE] THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`; GSYM ROOT_NEG] THEN REWRITE_TAC[ROOT_POS_LT]);; let ROOT_EQ_0 = prove (`!n x. root n x = &0 <=> x = &0`, REWRITE_TAC[root; REAL_ENTIRE; REAL_EXP_NZ; REAL_SGN_INEQS]);; let REAL_ROOT_MUL = prove (`!n x y. root n (x * y) = root n x * root n y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; ROOT_0] THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; ROOT_0] THEN REWRITE_TAC[root; REAL_SGN_MUL; REAL_ABS_MUL] THEN ASM_SIMP_TAC[LOG_MUL; GSYM REAL_ABS_NZ; real_div] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_EXP_ADD] THEN REAL_ARITH_TAC);; let REAL_ROOT_POW_GEN = prove (`!m n x y. root n (x pow m) = (root n x) pow m`, INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_ROOT_MUL; ROOT_1; real_pow]);; let REAL_ROOT_POW = prove (`!n x. ODD n \/ ~(n = 0) /\ &0 <= x ==> root n (x pow n) = x`, SIMP_TAC[REAL_ROOT_POW_GEN; REAL_POW_ROOT]);; let ROOT_UNIQUE = prove (`!n x y. y pow n = x /\ (ODD n \/ ~(n = 0) /\ &0 <= y) ==> root n x = y`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN UNDISCH_THEN `(y:real) pow n = x` (SUBST_ALL_TAC o SYM) THEN MATCH_MP_TAC REAL_ROOT_POW THEN ASM_REWRITE_TAC[]);; let REAL_ROOT_INV = prove (`!n x. root n (inv x) = inv(root n x)`, REPEAT GEN_TAC THEN REWRITE_TAC[root; REAL_SGN_INV; REAL_INV_SGN] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_SGN_0; REAL_MUL_LZERO; REAL_INV_0] THEN REWRITE_TAC[REAL_INV_MUL; REAL_INV_SGN; REAL_ABS_INV] THEN ASM_SIMP_TAC[GSYM REAL_EXP_NEG; LOG_INV; GSYM REAL_ABS_NZ] THEN REWRITE_TAC[real_div; REAL_MUL_LNEG]);; let REAL_ROOT_DIV = prove (`!n x y. root n (x / y) = root n x / root n y`, SIMP_TAC[real_div; REAL_ROOT_MUL; REAL_ROOT_INV]);; let ROOT_MONO_LT = prove (`!n x y. ~(n = 0) /\ x < y ==> root n x < root n y`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `!x y. &0 <= x /\ x < y ==> root n x < root n y` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[ROOT_WORKS; ROOT_LE_0] THEN ASM_REWRITE_TAC[real_sgn] THEN REPEAT (COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_ONE; REAL_POW_ZERO]) THEN ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= x` THEN ASM_SIMP_TAC[] THEN ASM_CASES_TAC `&0 <= y` THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE; ROOT_LE_0]; FIRST_X_ASSUM(MP_TAC o SPECL [`--y:real`; `--x:real`]) THEN REWRITE_TAC[ROOT_NEG] THEN ASM_REAL_ARITH_TAC]]);; let ROOT_MONO_LE = prove (`!n x y. x <= y ==> root n x <= root n y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[root; real_div; REAL_INV_0; REAL_MUL_RZERO; REAL_EXP_0; REAL_MUL_RID] THEN REWRITE_TAC[real_sgn] THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[REAL_LE_LT; ROOT_0; ROOT_MONO_LT]]);; let ROOT_MONO_LT_EQ = prove (`!n x y. ~(n = 0) ==> (root n x < root n y <=> x < y)`, MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; let ROOT_MONO_LE_EQ = prove (`!n x y. ~(n = 0) ==> (root n x <= root n y <=> x <= y)`, MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; let ROOT_INJ = prove (`!n x y. ~(n = 0) ==> (root n x = root n y <=> x = y)`, SIMP_TAC[GSYM REAL_LE_ANTISYM; ROOT_MONO_LE_EQ]);; let REAL_ROOT_LE = prove (`!n x y. ~(n = 0) /\ &0 <= y ==> (root n x <= y <=> x <= y pow n)`, MESON_TAC[REAL_ROOT_POW; REAL_POW_LE; ROOT_MONO_LE_EQ]);; let REAL_LE_ROOT = prove (`!n x y. ~(n = 0) /\ &0 <= x ==> (x <= root n y <=> x pow n <= y)`, MESON_TAC[REAL_ROOT_POW; REAL_POW_LE; ROOT_MONO_LE_EQ]);; let LOG_ROOT = prove (`!n x. ~(n = 0) /\ &0 < x ==> log(root n x) = log x / &n`, SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM LOG_POW; ROOT_POS_LT; REAL_POW_ROOT; REAL_LT_IMP_LE]);; let ROOT_EXP_LOG = prove (`!n x. ~(n = 0) /\ &0 < x ==> root n x = exp(log x / &n)`, SIMP_TAC[root; real_sgn; real_abs; REAL_LT_IMP_LE; REAL_MUL_LID]);; let ROOT_PRODUCT = prove (`!n f s. FINITE s ==> root n (product s f) = product s (\i. root n (f i))`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; REAL_ROOT_MUL; ROOT_1]);; let SQRT_PRODUCT = prove (`!f s. FINITE s ==> sqrt(product s f) = product s (\i. sqrt(f i))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES; SQRT_MUL; SQRT_1]);; (* ------------------------------------------------------------------------- *) (* Real power function. This involves a few arbitrary choices. *) (* *) (* The value of x^y is unarguable when x > 0. *) (* *) (* We make 0^0 = 1 to agree with "pow", but otherwise 0^y = 0. *) (* *) (* There is a sensible real value for (-x)^(p/q) where q is odd and either *) (* p is even [(-x)^y = x^y] or odd [(-x)^y = -x^y]. *) (* *) (* In all other cases, we return (-x)^y = -x^y. This is meaningless but at *) (* least it covers half the cases above without another case split. *) (* *) (* As for laws of indices, we do have x^-y = 1/x^y. Of course we can't have *) (* x^(yz) = x^y^z or x^(y+z) = x^y x^z since then (-1)^(1/2)^2 = -1. *) (* ------------------------------------------------------------------------- *) parse_as_infix("rpow",(24,"left"));; let rpow = new_definition `x rpow y = if &0 < x then exp(y * log x) else if x = &0 then if y = &0 then &1 else &0 else if ?m n. ODD(m) /\ ODD(n) /\ (abs y = &m / &n) then --(exp(y * log(--x))) else exp(y * log(--x))`;; let RPOW_POW = prove (`!x n. x rpow &n = x pow n`, REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_ZERO; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[EXP_LOG; REAL_ARITH `~(&0 < x) /\ ~(x = &0) ==> &0 < --x`] THEN REWRITE_TAC[REAL_POW_NEG; REAL_ABS_NUM] THEN SUBGOAL_THEN `(?p q. ODD(p) /\ ODD(q) /\ &n = &p / &q) <=> ODD n` (fun th -> SIMP_TAC[th; GSYM NOT_ODD; REAL_NEG_NEG; COND_ID]) THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [REPEAT GEN_TAC THEN ASM_CASES_TAC `q = 0` THEN ASM_REWRITE_TAC[ARITH_ODD] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `~(q = &0) ==> (n = p / q <=> q * n = p)`] THEN REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN ASM_MESON_TAC[ODD_MULT]; DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`n:num`; `1`] THEN ASM_REWRITE_TAC[REAL_DIV_1; ARITH_ODD]]);; let RPOW_0 = prove (`!x. x rpow &0 = &1`, REWRITE_TAC[RPOW_POW; real_pow]);; let RPOW_NEG = prove (`!x y. x rpow (--y) = inv(x rpow y)`, REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LNEG; REAL_EXP_NEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_NEG_EQ_0] THENL [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_0; REAL_INV_1]; REWRITE_TAC[REAL_ABS_NEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_NEG]]);; let RPOW_ZERO = prove (`!y. &0 rpow y = if y = &0 then &1 else &0`, REWRITE_TAC[rpow; REAL_LT_REFL]);; let RPOW_POS_LT = prove (`!x y. &0 < x ==> &0 < x rpow y`, SIMP_TAC[rpow; REAL_EXP_POS_LT]);; let RPOW_POS_LE = prove (`!x y. &0 <= x ==> &0 <= x rpow y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[RPOW_ZERO] THEN MESON_TAC[REAL_POS]; ASM_SIMP_TAC[RPOW_POS_LT; REAL_LE_LT]]);; let RPOW_LT2 = prove (`!x y z. &0 <= x /\ x < y /\ &0 < z ==> x rpow z < y rpow z`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[RPOW_ZERO; REAL_LT_IMP_NZ; RPOW_POS_LT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[rpow] THEN ASM_CASES_TAC `&0 < x /\ &0 < y` THENL [ALL_TAC; MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[REAL_EXP_MONO_LT; REAL_LT_LMUL_EQ] THEN MATCH_MP_TAC LOG_MONO_LT_IMP THEN ASM_REAL_ARITH_TAC);; let RPOW_LE2 = prove (`!x y z. &0 <= x /\ x <= y /\ &0 <= z ==> x rpow z <= y rpow z`, REPEAT GEN_TAC THEN ASM_CASES_TAC `z = &0` THEN ASM_REWRITE_TAC[RPOW_POW; real_pow; REAL_LE_REFL] THEN ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[RPOW_LT2; REAL_LE_LT]);; let REAL_ABS_RPOW = prove (`!x y. abs(x rpow y) = abs(x) rpow y`, REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_LT_REFL] THENL [REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_ABS_ZERO] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ABS_EXP; REAL_ARITH `&0 < x ==> abs x = x`] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_EXP] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_REAL_ARITH_TAC);; let RPOW_ONE = prove (`!z. &1 rpow z = &1`, REWRITE_TAC[rpow; REAL_LT_01; LOG_1; REAL_MUL_RZERO; REAL_EXP_0]);; let RPOW_RPOW = prove (`!x y z. &0 <= x ==> x rpow y rpow z = x rpow (y * z)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[RPOW_ZERO; REAL_ENTIRE] THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[RPOW_ZERO; RPOW_ONE]; SIMP_TAC[rpow; REAL_EXP_POS_LT; LOG_EXP] THEN REWRITE_TAC[REAL_MUL_AC]]);; let RPOW_LNEG = prove (`!x y. --x rpow y = if ?m n. ODD m /\ ODD n /\ abs y = &m / &n then --(x rpow y) else x rpow y`, REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_NEG_0; REAL_ABS_NUM; REAL_LT_REFL] THENL [ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_NEG_0; COND_ID] THEN REWRITE_TAC[REAL_ARITH `abs(&0) = m / n <=> m * inv n = &0`] THEN SIMP_TAC[REAL_ENTIRE; REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN MESON_TAC[ODD]; ASM_SIMP_TAC[REAL_ARITH `~(x = &0) ==> (&0 < --x <=> ~(&0 < x))`] THEN ASM_REWRITE_TAC[REAL_NEG_EQ_0] THEN ASM_CASES_TAC `&0 < x` THEN ASM_REWRITE_TAC[REAL_NEG_NEG; COND_ID]]);; let RPOW_EQ_0 = prove (`!x y. x rpow y = &0 <=> x = &0 /\ ~(y = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_EXP_NZ]) THEN REAL_ARITH_TAC);; let RPOW_MUL = prove (`!x y z. (x * y) rpow z = x rpow z * y rpow z`, SUBGOAL_THEN `!x y z. &0 <= x /\ &0 <= y ==> (x * y) rpow z = x rpow z * y rpow z` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `z = &0` THEN ASM_REWRITE_TAC[RPOW_POW; real_pow; REAL_MUL_LID] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; RPOW_ZERO] THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; RPOW_ZERO] THEN SIMP_TAC[rpow; REAL_LT_MUL; LOG_MUL; REAL_ADD_LDISTRIB; REAL_EXP_ADD]; REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN (ANTE_RES_THEN (MP_TAC o SPEC `z:real`)) (REAL_ARITH `&0 <= x /\ &0 <= y \/ &0 <= x /\ &0 <= --y \/ &0 <= --x /\ &0 <= y \/ &0 <= --x /\ &0 <= --y`) THEN REWRITE_TAC[RPOW_LNEG; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_EQ_NEG2]]);; let RPOW_INV = prove (`!x y. inv(x) rpow y = inv(x rpow y)`, REPEAT GEN_TAC THEN REWRITE_TAC[rpow; REAL_LT_INV_EQ] THEN SIMP_TAC[LOG_INV; REAL_MUL_RNEG; REAL_EXP_NEG] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[REAL_INV_EQ_0] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_1; REAL_INV_0]) THEN ASM_SIMP_TAC[GSYM REAL_INV_NEG; LOG_INV; REAL_ARITH `~(&0 < x) /\ ~(x = &0) ==> &0 < --x`] THEN REWRITE_TAC[REAL_MUL_RNEG; REAL_EXP_NEG; REAL_INV_NEG]);; let REAL_INV_RPOW = prove (`!x y. inv(x rpow y) = inv(x) rpow y`, REWRITE_TAC[RPOW_INV]);; let RPOW_DIV = prove (`!x y z. (x / y) rpow z = x rpow z / y rpow z`, REWRITE_TAC[real_div; RPOW_MUL; RPOW_INV]);; let RPOW_PRODUCT = prove (`!s:A->bool x y. FINITE s ==> (product s x) rpow y = product s (\i. x i rpow y)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[PRODUCT_CLAUSES; RPOW_MUL; RPOW_ONE]);; let RPOW_ADD = prove (`!x y z. &0 < x ==> x rpow (y + z) = x rpow y * x rpow z`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[rpow; REAL_ADD_RDISTRIB; REAL_EXP_ADD]);; let RPOW_SUB = prove (`!x y z. &0 < x ==> x rpow (y - z) = x rpow y / x rpow z`, SIMP_TAC[real_sub; RPOW_ADD; RPOW_NEG; real_div]);; let RPOW_ADD_ALT = prove (`!x y z. &0 <= x /\ (x = &0 /\ y + z = &0 ==> y = &0 \/ z = &0) ==> x rpow (y + z) = x rpow y * x rpow z`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[REAL_LE_LT; RPOW_ADD] THEN REWRITE_TAC[RPOW_ZERO] THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_ADD_LID] THEN ASM_CASES_TAC `y + z = &0` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let RPOW_SUB_ALT = prove (`!x y z. &0 <= x /\ (x = &0 /\ y = z ==> y = &0 \/ z = &0) ==> x rpow (y - z) = x rpow y / x rpow z`, REPEAT STRIP_TAC THEN REWRITE_TAC[real_sub; real_div; GSYM RPOW_NEG] THEN MATCH_MP_TAC RPOW_ADD_ALT THEN ASM_REAL_ARITH_TAC);; let RPOW_SQRT = prove (`!x. &0 <= x ==> x rpow (&1 / &2) = sqrt x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_RING `x pow 2 = y pow 2 /\ (x + y = &0 ==> x = &0 /\ y = &0) ==> x = y`) THEN CONJ_TAC THENL [ASM_SIMP_TAC[SQRT_POW_2] THEN ASM_SIMP_TAC[GSYM RPOW_POW; RPOW_RPOW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[RPOW_POW; REAL_POW_1]; MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y ==> x + y = &0 ==> x = &0 /\ y = &0`) THEN ASM_SIMP_TAC[SQRT_POS_LE; RPOW_POS_LE]]);; let RPOW_MONO_LE = prove (`!a b x. &1 <= x /\ a <= b ==> x rpow a <= x rpow b`, SIMP_TAC[rpow; REAL_ARITH `&1 <= x ==> &0 < x`] THEN SIMP_TAC[REAL_EXP_MONO_LE; LOG_POS; REAL_LE_RMUL]);; let RPOW_MONO_LT = prove (`!a b x. &1 < x /\ a < b ==> x rpow a < x rpow b`, SIMP_TAC[rpow; REAL_ARITH `&1 < x ==> &0 < x`] THEN SIMP_TAC[REAL_EXP_MONO_LT; LOG_POS_LT; REAL_LT_RMUL]);; let RPOW_MONO_LE_EQ = prove (`!a b x. &1 < x ==> (x rpow a <= x rpow b <=> a <= b)`, MESON_TAC[RPOW_MONO_LT; RPOW_MONO_LE; REAL_NOT_LT; REAL_LT_IMP_LE]);; let RPOW_MONO_LT_EQ = prove (`!a b x. &1 < x ==> (x rpow a < x rpow b <=> a < b)`, SIMP_TAC[GSYM REAL_NOT_LE; RPOW_MONO_LE_EQ]);; let RPOW_INJ = prove (`!x y z. &0 < x ==> (x rpow y = x rpow z <=> x = &1 \/ y = z)`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `x = &1 \/ &1 < x \/ x < &1`) THEN ASM_SIMP_TAC[RPOW_ONE; REAL_LT_IMP_NE] THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EQ_INV2]] THEN ASM_SIMP_TAC[REAL_INV_RPOW; GSYM REAL_LE_ANTISYM; RPOW_MONO_LE_EQ; REAL_INV_1_LT]);; let RPOW_LE_1 = prove (`!x y. &1 <= x /\ &0 <= y ==> &1 <= x rpow y`, MESON_TAC[RPOW_0; RPOW_MONO_LE]);; let RPOW_LT_1 = prove (`!x y. &1 < x /\ &0 < y ==> &1 < x rpow y`, MESON_TAC[RPOW_0; RPOW_MONO_LT]);; let RPOW_MONO_INV = prove (`!a b x. &0 < x /\ x <= &1 /\ b <= a ==> x rpow a <= x rpow b`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; RPOW_POS_LT; GSYM RPOW_INV] THEN MATCH_MP_TAC RPOW_MONO_LE THEN ASM_SIMP_TAC[REAL_INV_1_LE]);; let RPOW_1_LE = prove (`!a x. &0 <= x /\ x <= &1 /\ &0 <= a ==> x rpow a <= &1`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 rpow a` THEN CONJ_TAC THENL [MATCH_MP_TAC RPOW_LE2 THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[RPOW_ONE; REAL_LE_REFL]]);; let REAL_ROOT_RPOW = prove (`!n x. ~(n = 0) /\ (&0 <= x \/ ODD n) ==> root n x = x rpow (inv(&n))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[ROOT_0; RPOW_ZERO; REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN ASM_CASES_TAC `&0 <= x` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [ASM_SIMP_TAC[ROOT_EXP_LOG; rpow; REAL_LT_LE] THEN AP_TERM_TAC THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[rpow] THEN COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH]] THEN MATCH_MP_TAC ROOT_UNIQUE THEN ASM_REWRITE_TAC[REAL_POW_NEG; GSYM REAL_EXP_N; GSYM NOT_ODD] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `~(n = &0) ==> n * &1 / n * x = x`] THEN ONCE_REWRITE_TAC[REAL_ARITH `--x:real = y <=> x = --y`] THEN MATCH_MP_TAC EXP_LOG THEN ASM_REAL_ARITH_TAC]);; let LOG_RPOW = prove (`!x y. &0 < x ==> log(x rpow y) = y * log x`, SIMP_TAC[rpow; LOG_EXP]);; let LOG_SQRT = prove (`!x. &0 < x ==> log(sqrt x) = log x / &2`, SIMP_TAC[GSYM RPOW_SQRT; LOG_RPOW; REAL_LT_IMP_LE] THEN REAL_ARITH_TAC);; let RPOW_ADD_INTEGER = prove (`!x m n. integer m /\ integer n /\ ~(x = &0 /\ m + n = &0 /\ ~(n = &0)) ==> x rpow (m + n) = x rpow m * x rpow n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[RPOW_ZERO] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[is_int; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `p:num` THEN DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC) THEN X_GEN_TAC `q:num` THEN DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC) THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM REAL_NEG_ADD; RPOW_NEG; RPOW_POW; REAL_OF_NUM_ADD; REAL_POW_ADD; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `--x + y:real = y - x`; GSYM real_sub] THEN REWRITE_TAC[REAL_OF_NUM_SUB_CASES] THEN COND_CASES_TAC THEN REWRITE_TAC[RPOW_NEG; RPOW_POW] THEN ASM_SIMP_TAC[REAL_POW_SUB; ARITH_RULE `~(p:num <= q) ==> q <= p`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REAL_ARITH_TAC);; let NORM_CPOW = prove (`!w z. real w /\ &0 < Re w ==> norm(w cpow z) = norm(w) rpow (Re z)`, REPEAT GEN_TAC THEN SIMP_TAC[NORM_CPOW_REAL; rpow; COMPLEX_NORM_NZ] THEN ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL] THEN SIMP_TAC[REAL_NORM; real_abs; REAL_LT_IMP_LE]);; let REAL_MAX_RPOW = prove (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z ==> max (x rpow z) (y rpow z) = (max x y) rpow z`, MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[REAL_ARITH `max x y:real = max y x`]; ALL_TAC] THEN SIMP_TAC[RPOW_LE2; REAL_ARITH `max x y:real = if x <= y then y else x`]);; let REAL_MIN_RPOW = prove (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z ==> min (x rpow z) (y rpow z) = (min x y) rpow z`, MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[REAL_ARITH `min x y:real = min y x`]; ALL_TAC] THEN SIMP_TAC[RPOW_LE2; REAL_ARITH `min x y:real = if x <= y then x else y`]);; (* ------------------------------------------------------------------------- *) (* Summability of zeta function series. *) (* ------------------------------------------------------------------------- *) let SUMMABLE_ZETA = prove (`!n z. &1 < Re z ==> summable (from n) (\k. inv(Cx(&k) cpow z))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `1` THEN MATCH_MP_TAC SERIES_ABSCONV_IMP_CONV THEN MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\k. Cx(inv(&k rpow (Re z)))` THEN CONJ_TAC THENL [SIMP_TAC[IN_FROM; NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LE_1; COMPLEX_NORM_INV; rpow]; POP_ASSUM MP_TAC THEN SPEC_TAC(`Re z`,`x:real`)] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[summable] THEN MATCH_MP_TAC(MESON[] `(?x. P(Cx x)) ==> ?x. P x`) THEN REWRITE_TAC[SERIES_CX_LIFT] THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG; LIM_SEQUENTIALLY; DIST_REAL] THEN REWRITE_TAC[GSYM drop; LIFT_DROP; VSUM_REAL; o_DEF] THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN EXISTS_TAC `&2 rpow x / (&1 - (&1 / &2) rpow (x - &1))` THEN CONJ_TAC THENL [ALL_TAC; DISJ1_TAC THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[REAL_LE_INV_EQ; RPOW_POS_LE; REAL_POS] THEN REWRITE_TAC[FINITE_NUMSEG; SUBSET_NUMSEG] THEN ASM_ARITH_TAC] THEN X_GEN_TAC `n:num` THEN TRANS_TAC REAL_LE_TRANS `sum(1..2 EXP n) (\k. inv(&k rpow x))` THEN CONJ_TAC THENL [SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_LE_INV_EQ; RPOW_POS_LE; REAL_POS; real_abs] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[REAL_LE_INV_EQ; RPOW_POS_LE; REAL_POS] THEN SIMP_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; LE_REFL; LT_POW2_REFL; LT_IMP_LE]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `sum(0..n) (\k. &2 rpow x / &2 rpow (&k * (x - &1)))` THEN CONJ_TAC THENL [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[EXP; SUM_SING_NUMSEG; REAL_MUL_LZERO; RPOW_0; REAL_INV_RPOW; REAL_DIV_1] THEN MATCH_MP_TAC RPOW_LE2 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`\k. inv(&k rpow x)`; `1`; `2 EXP n`; `2 EXP n`] SUM_ADD_SPLIT) THEN ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[MULT_2; EXP]] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `sum (2 EXP n + 1..2 EXP n + 2 EXP n) (\k. inv(&2 pow n rpow x))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH; RPOW_POS_LT] THEN MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[RPOW_POW; REAL_OF_NUM_POW; REAL_OF_NUM_LE; LE_0] THEN ASM_ARITH_TAC; REWRITE_TAC[SUM_CONST_NUMSEG; ARITH_RULE `((n + n) + 1) - (n + 1) = n`; GSYM REAL_OF_NUM_POW; REAL_INV_POW; REAL_POW_2] THEN REWRITE_TAC[real_div; GSYM RPOW_NEG] THEN SIMP_TAC[GSYM RPOW_POW; RPOW_RPOW; REAL_POS; GSYM RPOW_ADD; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC RPOW_MONO_LE THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_REAL_ARITH_TAC]; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM RPOW_RPOW; REAL_POS; real_div; RPOW_POW] THEN REWRITE_TAC[REAL_INV_POW; SUM_LMUL] THEN REWRITE_TAC[SUM_GP] THEN REWRITE_TAC[CONJUNCT1 LT; CONJUNCT1 real_pow] THEN MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[RPOW_POS_LE; REAL_POS] THEN COND_CASES_TAC THENL [MATCH_MP_TAC(TAUT `F ==> p`) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `x = &1 ==> &1 <= x`)) THEN REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_INV_LT_1 THEN MATCH_MP_TAC RPOW_LT_1 THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LID; RPOW_INV] THEN REWRITE_TAC[REAL_ARITH `a / b <= inv b <=> a * inv b <= &1 * inv b`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ARITH `&1 - x <= &1 <=> &0 <= x`; REAL_LE_INV_EQ] THEN SIMP_TAC[REAL_POW_LE; REAL_LE_DIV; REAL_POS; REAL_SUB_LE; RPOW_POS_LE; REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN MATCH_MP_TAC RPOW_LE_1 THEN ASM_REAL_ARITH_TAC]]);; let SUMMABLE_ZETA_INTEGER = prove (`!n m. 2 <= m ==> summable (from n) (\k. inv(Cx(&k) pow m))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `1` THEN MP_TAC(SPECL [`1`; `Cx(&m)`] SUMMABLE_ZETA) THEN ASM_SIMP_TAC[RE_CX; REAL_OF_NUM_LT; ARITH_RULE `2 <= n ==> 1 < n`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ) THEN SIMP_TAC[IN_FROM; CPOW_N; CX_INJ; REAL_OF_NUM_EQ; LE_1]);; (* ------------------------------------------------------------------------- *) (* Formulation of loop homotopy in terms of maps out of S^1 *) (* ------------------------------------------------------------------------- *) let HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS = prove (`!f:complex->real^N g s. homotopic_with (\h. T) (sphere(vec 0,&1),s) f g ==> homotopic_loops s (f o cexp o (\t. Cx(&2 * pi * drop t) * ii)) (g o cexp o (\t. Cx(&2 * pi * drop t) * ii))`, REWRITE_TAC[homotopic_loops; sphere; DIST_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN EXISTS_TAC `{z:complex | norm z = &1}` THEN REWRITE_TAC[pathstart; pathfinish; o_THM; DROP_VEC] THEN ONCE_REWRITE_TAC[REAL_ARITH `&2 * pi * n = &2 * n * pi`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_ELIM_THM] THEN ASM_SIMP_TAC[CEXP_INTEGER_2PI; INTEGER_CLOSED] THEN REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] NORM_CEXP_II] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN REWRITE_TAC[CX_MUL] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN SIMP_TAC[CONTINUOUS_ON_CX_DROP; CONTINUOUS_ON_ID]);; let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS = prove (`!p q s:real^N->bool. homotopic_loops s p q ==> homotopic_with (\h. T) (sphere(vec 0,&1),s) (p o (\z. lift(Arg z / (&2 * pi)))) (q o (\z. lift(Arg z / (&2 * pi))))`, let ulemma = prove (`!s. s INTER (UNIV PCROSS {z | &0 <= Im z}) UNION s INTER (UNIV PCROSS {z | Im z <= &0}) = s`, REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_INTER; IN_UNION; PASTECART_IN_PCROSS] THEN SET_TAC[REAL_LE_TOTAL]) in REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops; sphere; DIST_0] THEN GEN_REWRITE_TAC LAND_CONV [homotopic_with] THEN SIMP_TAC[pathstart; pathfinish; LEFT_IMP_EXISTS_THM; HOMOTOPIC_WITH] THEN X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN EXISTS_TAC `\w. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart w) (lift(Arg(sndcart w) / (&2 * pi))))` THEN ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `(\z. if &0 <= Im(sndcart z) then h (pastecart (fstcart z) (lift(Arg(sndcart z) / (&2 * pi)))) else h (pastecart (fstcart z) (vec 1 - lift(Arg(cnj(sndcart z)) / (&2 * pi))))) :real^(1,2)finite_sum->real^N` THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`t:real^1`; `z:complex`] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARG_CNJ] THEN COND_CASES_TAC THENL [ASM_MESON_TAC[real; REAL_LE_REFL]; ALL_TAC] THEN SIMP_TAC[PI_POS; LIFT_SUB; LIFT_NUM; REAL_FIELD `&0 < pi ==> (&2 * pi - z) / (&2 * pi) = &1 - z / (&2 * pi)`] THEN REWRITE_TAC[VECTOR_ARITH `a - (a - b):real^N = b`]; GEN_REWRITE_TAC RAND_CONV [GSYM ulemma] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REWRITE_TAC[ulemma] THEN SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_HALFSPACE_IM_LE; CLOSED_UNIV; CLOSED_PCROSS; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_IM_GE] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_INTER; IN_DIFF; FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV; IN_SING; IN_ELIM_THM; GSYM CONJ_ASSOC; REAL_LE_ANTISYM; TAUT `~(p /\ ~p)`] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[GSYM ARG_EQ_0_PI; GSYM real; ARG_CNJ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[REAL_ARITH `&2 * x - x = x`; COND_ID; GSYM LIFT_NUM; PI_POS; GSYM LIFT_SUB; REAL_FIELD `&0 < pi ==> &1 - pi / (&2 * pi) = pi / (&2 * pi)`] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_SUB_RZERO; REAL_DIV_REFL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ; PI_NZ] THEN SIMP_TAC[real_div; REAL_MUL_LZERO; REAL_SUB_REFL; REAL_SUB_RZERO] THEN ASM_SIMP_TAC[LIFT_NUM]] THEN GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV) [GSYM o_DEF] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN REWRITE_TAC[real_div; REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `z:complex`] THEN SIMP_TAC[IN_DIFF; IN_ELIM_THM; IN_SING] THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART; FSTCART_PASTECART] THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; REAL_MUL_LZERO; REAL_MUL_LID; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN SIMP_TAC[ARG; REAL_LT_IMP_LE]; MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[real_div; REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CNJ] THEN REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN MAP_EVERY X_GEN_TAC [`t:real^1`; `z:complex`] THEN SIMP_TAC[IN_DIFF; IN_ELIM_THM; IN_SING] THEN SIMP_TAC[IM_CNJ; REAL_NEG_GE0; CNJ_EQ_0] THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART; FSTCART_PASTECART] THEN SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; LIFT_DROP] THEN REWRITE_TAC[REAL_ARITH `&0 <= &1 - x /\ &1 - x <= &1 <=> &0 <= x /\ x <= &1`] THEN SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; REAL_MUL_LZERO; REAL_MUL_LID; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN SIMP_TAC[ARG; REAL_LT_IMP_LE]]]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; IN_ELIM_THM] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `IMAGE h s SUBSET t ==> y IN s ==> h y IN t`)) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTERVAL_1; LIFT_DROP] THEN SIMP_TAC[DROP_VEC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; ARG; REAL_LT_IMP_LE]]);; let SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS, SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP = (CONJ_PAIR o prove) (`(!s:real^N->bool. simply_connected s <=> !f g:complex->real^N. f continuous_on sphere(vec 0,&1) /\ IMAGE f (sphere(vec 0,&1)) SUBSET s /\ g continuous_on sphere(vec 0,&1) /\ IMAGE g (sphere(vec 0,&1)) SUBSET s ==> homotopic_with (\h. T) (sphere(vec 0,&1),s) f g) /\ (!s:real^N->bool. simply_connected s <=> path_connected s /\ !f:real^2->real^N. f continuous_on sphere(vec 0,&1) /\ IMAGE f (sphere(vec 0,&1)) SUBSET s ==> ?a. homotopic_with (\h. T) (sphere(vec 0,&1),s) f (\x. a))`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[simply_connected] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`f:complex->real^N`; `g:complex->real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(f:complex->real^N) o cexp o (\t. Cx(&2 * pi * drop t) * ii)`; `(g:complex->real^N) o cexp o (\t. Cx(&2 * pi * drop t) * ii)`]) THEN ONCE_REWRITE_TAC[TAUT `p1 /\ q1 /\ r1 /\ p2 /\ q2 /\ r2 <=> (p1 /\ r1 /\ q1) /\ (p2 /\ r2 /\ q2)`] THEN REWRITE_TAC[GSYM HOMOTOPIC_LOOPS_REFL] THEN ASM_SIMP_TAC[HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS; HOMOTOPIC_WITH_REFL] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN REWRITE_TAC[IN_SPHERE_0; LIFT_DROP; o_DEF] THEN X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN ASM_REWRITE_TAC[COMPLEX_MUL_LID] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> &2 * pi * x / (&2 * pi) = x`] THEN ASM_MESON_TAC[COMPLEX_MUL_SYM]; DISCH_TAC THEN CONJ_TAC THENL [REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(\x. a):complex->real^N`; `(\x. b):complex->real^N`]) THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN (MP_TAC o MATCH_MP HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS) THEN REWRITE_TAC[o_DEF; LINEPATH_REFL]; X_GEN_TAC `f:complex->real^N` THEN STRIP_TAC THEN EXISTS_TAC `f(Cx(&1)):real^N` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]; STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) o (\z. lift(Arg z / (&2 * pi)))`) THEN ANTS_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `p:real^1->real^N`] HOMOTOPIC_LOOPS_REFL) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS) THEN SIMP_TAC[HOMOTOPIC_WITH_REFL]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; o_DEF] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&1)` o CONJUNCT2) THEN REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[LINEPATH_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_LOOPS_TRANS) THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTERVAL_1; FORALL_LIFT; LIFT_DROP; DROP_VEC] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_CASES_TAC `t = &1` THENL [ASM_REWRITE_TAC[REAL_ARITH `&2 * pi * &1 = &2 * &1 * pi`] THEN SIMP_TAC[CEXP_INTEGER_2PI; INTEGER_CLOSED; ARG_NUM] THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN ASM_MESON_TAC[pathstart; pathfinish]; AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> (t = x / (&2 * pi) <=> x = &2 * pi * t)`] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Im(Cx (&2 * pi * t) * ii)` THEN CONJ_TAC THENL [MATCH_MP_TAC ARG_CEXP; ALL_TAC] THEN SIMP_TAC[IM_MUL_II; RE_CX; REAL_ARITH `a < &2 * pi <=> a < &2 * pi * &1`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_LMUL_EQ; REAL_OF_NUM_LT; ARITH; PI_POS; REAL_LT_IMP_LE; REAL_POS; REAL_LE_MUL] THEN ASM_REWRITE_TAC[REAL_LT_LE]]]]);; let HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS = prove (`!s:real^M->bool t:real^N->bool. s homotopy_equivalent t ==> (simply_connected s <=> simply_connected t)`, REWRITE_TAC[SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS] THEN REWRITE_TAC[HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY]);; (* ------------------------------------------------------------------------- *) (* Integration via polar coordinates. *) (* ------------------------------------------------------------------------- *) let HAS_DERIVATIVE_POLAR = prove (`!z. ((\w. Cx(Re w) * cexp(ii * Cx(Im w))) has_derivative (\h. vector[vector[cos(Im z); --Re(z) * sin(Im z)]; vector[sin(Im z); Re z * cos(Im z)]] ** h)) (at z)`, X_GEN_TAC `z:complex` THEN MP_TAC(ISPECL [`\z. ii * Cx(Im z)`; `cexp`; `\z. ii * Cx(Im z)`; `\h. cexp(ii * Cx(Im z)) * h`; `z:complex`] DIFF_CHAIN_AT) THEN REWRITE_TAC[GSYM has_complex_derivative; HAS_COMPLEX_DERIVATIVE_CEXP] THEN ANTS_TAC THENL [MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN MATCH_MP_TAC LINEAR_COMPLEX_LMUL THEN GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN REWRITE_TAC[LINEAR_CX_IM]; REWRITE_TAC[o_DEF] THEN DISCH_TAC] THEN MP_TAC(ISPECL [`complex_mul`; `Cx o Re`; `\z. cexp (ii * Cx (Im z))`; `Cx o Re`; `\x. cexp(ii * Cx (Im z)) * ii * Cx(Im x)`; `z:complex`] HAS_DERIVATIVE_BILINEAR_AT) THEN SIMP_TAC[BILINEAR_COMPLEX_MUL; LINEAR_CX_RE; HAS_DERIVATIVE_LINEAR] THEN ASM_REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `h:complex` THEN REWRITE_TAC[matrix_vector_mul] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN SIMP_TAC[DIMINDEX_2; FORALL_2; SUM_2; VECTOR_2] THEN REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF] THEN REWRITE_TAC[COMPLEX_RING `a * e * ii * z:complex = a * ii * z * e`] THEN REWRITE_TAC[RE_ADD; IM_ADD; RE_MUL_CX; IM_MUL_CX; RE_CEXP; IM_CEXP; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN REWRITE_TAC[REAL_NEG_0; REAL_EXP_0; RE_II; REAL_MUL_LZERO] THEN REWRITE_TAC[IM_II; REAL_MUL_LNEG; REAL_MUL_LID] THEN REAL_ARITH_TAC);; let HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_POLAR = prove (`!f:complex->real^N b. f absolutely_integrable_on (:complex) /\ integral (:complex) f = b <=> (\z. Re z % f(Cx(Re z) * cexp(ii * Cx(Im z)))) absolutely_integrable_on {z | &0 <= Re z /\ &0 <= Im z /\ Im z <= &2 * pi} /\ integral {z | &0 <= Re z /\ &0 <= Im z /\ Im z <= &2 * pi} (\z. Re z % f(Cx(Re z) * cexp(ii * Cx(Im z)))) = b`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:complex->real^N`; `\z. Cx(Re z) * cexp(ii * Cx(Im z))`; `\z h. (vector[vector[cos(Im z); --Re(z) * sin(Im z)]; vector[sin(Im z); Re z * cos(Im z)]]:real^2^2) ** h`; `{z:complex | &0 < Re z /\ &0 < Im z /\ Im z < &2 * pi}`] HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES) THEN REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; IN_ELIM_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN SUBGOAL_THEN `IMAGE (\z. Cx (Re z) * cexp (ii * Cx (Im z))) {z | &0 < Re z /\ &0 < Im z /\ Im z < &2 * pi} = {z | Im z = &0 ==> Re z < &0}` SUBST1_TAC THENL [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IM_MUL_CX; IM_CEXP] THEN CONJ_TAC THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THENL [ASM_SIMP_TAC[REAL_ENTIRE; REAL_EXP_NZ; REAL_LT_IMP_NZ] THEN REWRITE_TAC[IM_II; REAL_MUL_LID] THEN DISCH_TAC THEN MP_TAC(ISPEC `Im z - pi` SIN_EQ_0_PI) THEN ASM_REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI; REAL_SUB_0] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[CEXP_II_PI; RE_MUL_CX; RE_NEG; RE_CX] THEN ASM_REAL_ARITH_TAC; EXISTS_TAC `complex(norm z,Arg z)` THEN REWRITE_TAC[RE; IM] THEN POP_ASSUM MP_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[IM_CX; RE_CX; REAL_LT_REFL; COMPLEX_NORM_NZ] THEN REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN MP_TAC(SPEC `z:complex` ARG) THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARG_EQ_0; real] THEN REAL_ARITH_TAC]; ALL_TAC] THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REPEAT(MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC) THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_CONVEX THEN REWRITE_TAC[IM_DEF; RE_DEF; CONVEX_HALFSPACE_COMPONENT_LT; REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT]; SIMP_TAC[HAS_DERIVATIVE_POLAR; HAS_DERIVATIVE_AT_WITHIN]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(AP_TERM `Arg` th) THEN MP_TAC(AP_TERM `\z:complex. norm z` th)) THEN ASM_SIMP_TAC[ARG_MUL_CX; IN_ELIM_THM] THEN ASM_SIMP_TAC[ARG_CEXP; IM_MUL_II; RE_CX; REAL_LT_IMP_LE] THEN REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP_II; REAL_MUL_RID] THEN ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ARITH `&0 < x ==> abs x = x`] THEN SIMP_TAC[COMPLEX_EQ]]; DISCH_THEN(MP_TAC o SPEC `b:real^N`) THEN REWRITE_TAC[DET_2; VECTOR_2; SIN_CIRCLE; REAL_MUL_RID; REAL_ARITH `c * r * c - (--r * s) * s:real = r * (s pow 2 + c pow 2)`] THEN MATCH_MP_TAC(TAUT `(p <=> p') /\ (q <=> q') ==> (q <=> p) ==> (p' <=> q')`) THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; GSYM INTEGRAL_RESTRICT_UNIV] THEN MATCH_MP_TAC(MESON[ABSOLUTELY_INTEGRABLE_SPIKE_EQ; INTEGRAL_SPIKE] `!s. negligible s /\ (!x. x IN t DIFF s ==> g x = f x) ==> (f absolutely_integrable_on t /\ integral t f = b <=> g absolutely_integrable_on t /\ integral t g = b)`) THENL [EXISTS_TAC `{z | Im z = &0}`; EXISTS_TAC `{z | Re z = &0} UNION {z | Im z = &0} UNION {z | Im z = &2 * pi}`] THEN ASM_REWRITE_TAC[IM_DEF; RE_DEF; NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_STANDARD_HYPERPLANE] THEN SIMP_TAC[GSYM IM_DEF; GSYM RE_DEF; IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN X_GEN_TAC `z:complex` THEN SIMP_TAC[REAL_LT_LE] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REAL_ARITH_TAC]);; let ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_POLAR = prove (`!f:complex->real^N b. f absolutely_integrable_on (:complex) <=> (\z. Re z % f(Cx(Re z) * cexp(ii * Cx(Im z)))) absolutely_integrable_on {z | &0 <= Re z /\ &0 <= Im z /\ Im z <= &2 * pi}`, MESON_TAC[HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_POLAR]);; let FUBINI_POLAR = prove (`!f:complex->real^N. f absolutely_integrable_on (:complex) ==> negligible {r | &0 <= drop r /\ ~((\t. drop r % f(Cx(drop r) * cexp(ii * Cx(drop t)))) absolutely_integrable_on interval[vec 0,lift(&2 * pi)])} /\ (\r. integral (interval[vec 0,lift(&2 * pi)]) (\t. drop r % f(Cx(drop r) * cexp(ii * Cx(drop t))))) absolutely_integrable_on {r | &0 <= drop r} /\ integral {r | &0 <= drop r} (\r. integral (interval[vec 0,lift(&2 * pi)]) (\t. drop r % f(Cx(drop r) * cexp(ii * Cx(drop t))))) = integral (:complex) f`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:complex->real^N`; `integral UNIV (f:complex->real^N)`] HAS_ABSOLUTE_INTEGRAL_CHANGE_OF_VARIABLES_POLAR) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; GSYM INTEGRAL_RESTRICT_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN ABBREV_TAC `g = \x. if &0 <= Re x /\ &0 <= Im x /\ Im x <= &2 * pi then Re x % (f:complex->real^N) (Cx(Re x) * cexp(ii * Cx(Im x))) else vec 0` THEN REWRITE_TAC[IN_UNIV; ETA_AX] THEN STRIP_TAC THEN ABBREV_TAC `h:real^(1,1)finite_sum->complex = \x. lambda i. x$i` THEN ABBREV_TAC `k:complex->real^(1,1)finite_sum = \x. lambda i. x$i` THEN SUBGOAL_THEN `(!x:complex. h(k x) = x) /\ (!y:real^(1,1)finite_sum. k(h y) = y)` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["h"; "k"] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_2; ARITH; DIMINDEX_1]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (h:real^(1,1)finite_sum->complex) UNIV = UNIV /\ IMAGE (k:complex->real^(1,1)finite_sum) UNIV = UNIV` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `(g:complex->real^N) o (h:real^(1,1)finite_sum->complex)` FUBINI_HAS_ABSOLUTE_INTEGRAL) THEN ANTS_TAC THENL [MP_TAC(ISPECL [`g:complex->real^N`; `(:real^(1,1)finite_sum)`; `\n:num. n`] ABSOLUTELY_INTEGRABLE_TWIZZLE_EQ) THEN REWRITE_TAC[PERMUTES_ID; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_2] THEN CONV_TAC NUM_REDUCE_CONV THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN ASM_REWRITE_TAC[]; MP_TAC(ISPECL [`g:complex->real^N`; `(:real^(1,1)finite_sum)`; `\n:num. n`] INTEGRAL_TWIZZLE_EQ) THEN REWRITE_TAC[PERMUTES_ID; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_2] THEN CONV_TAC NUM_REDUCE_CONV THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN SUBGOAL_THEN `!x y. ((g:complex->real^N) o h) (pastecart x y) = g(complex(drop x,drop y))` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN EXPAND_TAC "h" THEN SIMP_TAC[pastecart; CART_EQ; LAMBDA_BETA; DIMINDEX_1; DIMINDEX_2; ARITH; DIMINDEX_FINITE_SUM] THEN REWRITE_TAC[FORALL_2; ARITH] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN REWRITE_TAC[drop]; ALL_TAC] THEN EXPAND_TAC "g" THEN REWRITE_TAC[RE; IM] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN X_GEN_TAC `r:real^1` THEN ASM_CASES_TAC `&0 <= drop r` THEN ASM_REWRITE_TAC[LIFT_DROP]; MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `r:real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN ASM_CASES_TAC `&0 <= drop r` THEN ASM_REWRITE_TAC[INTEGRAL_0; IN_INTERVAL_1; LIFT_DROP; DROP_VEC]; DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `r:real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN ASM_CASES_TAC `&0 <= drop r` THEN ASM_REWRITE_TAC[INTEGRAL_0; IN_INTERVAL_1; LIFT_DROP; DROP_VEC]]);; let FUBINI_TONELLI_POLAR = prove (`!f:complex->real^N. f measurable_on (:complex) ==> (f absolutely_integrable_on (:complex) <=> negligible {r | &0 <= drop r /\ ~((\t. drop r % f(Cx(drop r) * cexp(ii * Cx(drop t)))) absolutely_integrable_on interval[vec 0,lift(&2 * pi)])} /\ (\r. integral (interval[vec 0,lift(&2 * pi)]) (\t. drop r % lift(norm(f(Cx(drop r) * cexp(ii * Cx(drop t))))))) integrable_on {r | &0 <= drop r})`, REPEAT GEN_TAC THEN DISCH_TAC THEN ABBREV_TAC `g = \x. if &0 <= Re x /\ &0 <= Im x /\ Im x <= &2 * pi then Re x % (f:complex->real^N) (Cx(Re x) * cexp(ii * Cx(Im x))) else vec 0` THEN ABBREV_TAC `h:real^(1,1)finite_sum->complex = \x. lambda i. x$i` THEN ABBREV_TAC `k:complex->real^(1,1)finite_sum = \x. lambda i. x$i` THEN SUBGOAL_THEN `(!x:complex. h(k x) = x) /\ (!y:real^(1,1)finite_sum. k(h y) = y)` STRIP_ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["h"; "k"] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_2; ARITH; DIMINDEX_1]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (h:real^(1,1)finite_sum->complex) UNIV = UNIV /\ IMAGE (k:complex->real^(1,1)finite_sum) UNIV = UNIV` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `(g:complex->real^N) o (h:real^(1,1)finite_sum->complex)` FUBINI_TONELLI) THEN ANTS_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN o snd) THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_FINITE_SUM; DIMINDEX_1; ARITH] THEN ANTS_TAC THENL [CONJ_TAC THENL [EXPAND_TAC "h"; ASM_MESON_TAC[]] THEN SIMP_TAC[linear; LAMBDA_BETA; DIMINDEX_2; DIMINDEX_FINITE_SUM; DIMINDEX_1; ARITH; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; DISCH_THEN SUBST1_TAC] THEN EXPAND_TAC "g" THEN REWRITE_TAC[REWRITE_RULE[IN] MEASURABLE_ON_UNIV] THEN GEN_REWRITE_TAC RAND_CONV [SET_RULE `(\x. P x) = {x | P x}`] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN EXISTS_TAC `{z | &0 < Re z /\ &0 < Im z /\ Im z < &2 * pi}` THEN CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{z | Re z = &0} UNION {z | Im z = &0} UNION {z | Im z = &2 * pi}` THEN REWRITE_TAC[IM_DEF; RE_DEF; NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_STANDARD_HYPERPLANE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF; IN_UNION] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `lebesgue_measurable {z | &0 < Re z /\ &0 < Im z /\ Im z < &2 * pi}` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN REPEAT(MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC) THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_CONVEX THEN REWRITE_TAC[IM_DEF; RE_DEF; CONVEX_HALFSPACE_COMPONENT_LT; REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT]; ALL_TAC] THEN MATCH_MP_TAC MEASURABLE_ON_MUL THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[RE_DEF; LINEAR_LIFT_COMPONENT]; GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF]] THEN MATCH_MP_TAC MEASURABLE_ON_CONTINUOUS_COMPOSE THEN EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV; SUBSET_UNIV] THEN CONJ_TAC THENL [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN X_GEN_TAC `z:complex` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[differentiable] THEN MP_TAC(SPEC `z:complex` HAS_DERIVATIVE_POLAR) THEN MESON_TAC[]; X_GEN_TAC `k:complex->bool` THEN DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE THEN MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_PREIMAGE THEN EXISTS_TAC `\z h. (vector[vector[cos(Im z); --Re(z) * sin(Im z)]; vector[sin(Im z); Re z * cos(Im z)]]:real^2^2) ** h` THEN ASM_REWRITE_TAC[RANK_EQ_FULL_DET; MATRIX_OF_MATRIX_VECTOR_MUL] THEN REWRITE_TAC[DET_2; VECTOR_2; SIN_CIRCLE; REAL_MUL_RID; REAL_ARITH `c * r * c - (--r * s) * s:real = r * (s pow 2 + c pow 2)`] THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[REAL_LT_IMP_NZ] THEN DISCH_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_AT_WITHIN THEN REWRITE_TAC[HAS_DERIVATIVE_POLAR]]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [GEN_REWRITE_TAC RAND_CONV [ABSOLUTELY_INTEGRABLE_CHANGE_OF_VARIABLES_POLAR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM th]) THEN CONV_TAC SYM_CONV THEN EXPAND_TAC "h" THEN REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_TWIZZLE_EQ THEN REWRITE_TAC[PERMUTES_ID; DIMINDEX_2; DIMINDEX_1; DIMINDEX_FINITE_SUM] THEN CONV_TAC NUM_REDUCE_CONV; SUBGOAL_THEN `!x y. ((g:complex->real^N) o h) (pastecart x y) = g(complex(drop x,drop y))` (fun th -> REWRITE_TAC[th]) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN EXPAND_TAC "h" THEN SIMP_TAC[pastecart; CART_EQ; LAMBDA_BETA; DIMINDEX_1; DIMINDEX_2; ARITH; DIMINDEX_FINITE_SUM] THEN REWRITE_TAC[FORALL_2; ARITH] THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN REWRITE_TAC[drop]; ALL_TAC] THEN EXPAND_TAC "g" THEN REWRITE_TAC[RE; IM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; GSYM INTEGRABLE_RESTRICT_UNIV] THEN BINOP_TAC THENL [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `r:real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `&0 <= drop r` THEN ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0] THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC]; AP_THM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `r:real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `&0 <= drop r` THEN ASM_REWRITE_TAC[NORM_0; LIFT_NUM; INTEGRAL_0] THEN GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0; LIFT_NUM] THEN ASM_REWRITE_TAC[NORM_MUL; LIFT_CMUL; real_abs]]]);; hol-light/Multivariate/vectors.ml000066400000000000000000016204771303454263000174530ustar00rootroot00000000000000(* ========================================================================= *) (* Real vectors in Euclidean space, and elementary linear algebra. *) (* *) (* (c) Copyright, John Harrison 1998-2008 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "Multivariate/misc.ml";; (* ------------------------------------------------------------------------- *) (* Some common special cases. *) (* ------------------------------------------------------------------------- *) let FORALL_1 = prove (`(!i. 1 <= i /\ i <= 1 ==> P i) <=> P 1`, MESON_TAC[LE_ANTISYM]);; let FORALL_2 = prove (`!P. (!i. 1 <= i /\ i <= 2 ==> P i) <=> P 1 /\ P 2`, MESON_TAC[ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`]);; let FORALL_3 = prove (`!P. (!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`, MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3`]);; let FORALL_4 = prove (`!P. (!i. 1 <= i /\ i <= 4 ==> P i) <=> P 1 /\ P 2 /\ P 3 /\ P 4`, MESON_TAC[ARITH_RULE `1 <= i /\ i <= 4 <=> i = 1 \/ i = 2 \/ i = 3 \/ i = 4`]);; let SUM_1 = prove (`sum(1..1) f = f(1)`, REWRITE_TAC[SUM_SING_NUMSEG]);; let SUM_2 = prove (`!t. sum(1..2) t = t(1) + t(2)`, REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; let SUM_3 = prove (`!t. sum(1..3) t = t(1) + t(2) + t(3)`, REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; let SUM_4 = prove (`!t. sum(1..4) t = t(1) + t(2) + t(3) + t(4)`, SIMP_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Basic componentwise operations on vectors. *) (* ------------------------------------------------------------------------- *) let vector_add = new_definition `(vector_add:real^N->real^N->real^N) x y = lambda i. x$i + y$i`;; let vector_sub = new_definition `(vector_sub:real^N->real^N->real^N) x y = lambda i. x$i - y$i`;; let vector_neg = new_definition `(vector_neg:real^N->real^N) x = lambda i. --(x$i)`;; overload_interface ("+",`(vector_add):real^N->real^N->real^N`);; overload_interface ("-",`(vector_sub):real^N->real^N->real^N`);; overload_interface ("--",`(vector_neg):real^N->real^N`);; prioritize_real();; let prioritize_vector = let ty = `:real^N` in fun () -> prioritize_overload ty;; (* ------------------------------------------------------------------------- *) (* Also the scalar-vector multiplication. *) (* ------------------------------------------------------------------------- *) parse_as_infix("%",(21,"right"));; let vector_mul = new_definition `((%):real->real^N->real^N) c x = lambda i. c * x$i`;; (* ------------------------------------------------------------------------- *) (* Vectors corresponding to small naturals. Perhaps should overload "&"? *) (* ------------------------------------------------------------------------- *) let vec = new_definition `(vec:num->real^N) n = lambda i. &n`;; (* ------------------------------------------------------------------------- *) (* Dot products. *) (* ------------------------------------------------------------------------- *) parse_as_infix("dot",(20,"right"));; let dot = new_definition `(x:real^N) dot (y:real^N) = sum(1..dimindex(:N)) (\i. x$i * y$i)`;; let DOT_1 = prove (`(x:real^1) dot (y:real^1) = x$1 * y$1`, REWRITE_TAC[dot; DIMINDEX_1; SUM_1]);; let DOT_2 = prove (`(x:real^2) dot (y:real^2) = x$1 * y$1 + x$2 * y$2`, REWRITE_TAC[dot; DIMINDEX_2; SUM_2]);; let DOT_3 = prove (`(x:real^3) dot (y:real^3) = x$1 * y$1 + x$2 * y$2 + x$3 * y$3`, REWRITE_TAC[dot; DIMINDEX_3; SUM_3]);; let DOT_4 = prove (`(x:real^4) dot (y:real^4) = x$1 * y$1 + x$2 * y$2 + x$3 * y$3 + x$4 * y$4`, REWRITE_TAC[dot; DIMINDEX_4; SUM_4]);; (* ------------------------------------------------------------------------- *) (* A naive proof procedure to lift really trivial arithmetic stuff from R. *) (* ------------------------------------------------------------------------- *) let VECTOR_ARITH_TAC = let RENAMED_LAMBDA_BETA th = if fst(dest_fun_ty(type_of(funpow 3 rand (concl th)))) = aty then INST_TYPE [aty,bty; bty,aty] LAMBDA_BETA else LAMBDA_BETA in POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE DISCH_TAC ORELSE EQ_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[dot; GSYM SUM_ADD_NUMSEG; GSYM SUM_SUB_NUMSEG; GSYM SUM_LMUL; GSYM SUM_RMUL; GSYM SUM_NEG] THEN (MATCH_MP_TAC SUM_EQ_NUMSEG ORELSE MATCH_MP_TAC SUM_EQ_0_NUMSEG ORELSE GEN_REWRITE_TAC ONCE_DEPTH_CONV [CART_EQ]) THEN REWRITE_TAC[AND_FORALL_THM] THEN TRY EQ_TAC THEN TRY(MATCH_MP_TAC MONO_FORALL) THEN GEN_TAC THEN REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`; TAUT `(a ==> b) \/ (a ==> c) <=> a ==> b \/ c`] THEN TRY(MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`)) THEN REWRITE_TAC[vector_add; vector_sub; vector_neg; vector_mul; vec] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP(RENAMED_LAMBDA_BETA th) th]) THEN REAL_ARITH_TAC;; let VECTOR_ARITH tm = prove(tm,VECTOR_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Obvious "component-pushing". *) (* ------------------------------------------------------------------------- *) let VEC_COMPONENT = prove (`!k i. (vec k :real^N)$i = &k`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ASM_SIMP_TAC[vec; CART_EQ; LAMBDA_BETA]]);; let VECTOR_ADD_COMPONENT = prove (`!x:real^N y i. (x + y)$i = x$i + y$i`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ASM_SIMP_TAC[vector_add; CART_EQ; LAMBDA_BETA]]);; let VECTOR_SUB_COMPONENT = prove (`!x:real^N y i. (x - y)$i = x$i - y$i`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ASM_SIMP_TAC[vector_sub; CART_EQ; LAMBDA_BETA]]);; let VECTOR_NEG_COMPONENT = prove (`!x:real^N i. (--x)$i = --(x$i)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ASM_SIMP_TAC[vector_neg; CART_EQ; LAMBDA_BETA]]);; let VECTOR_MUL_COMPONENT = prove (`!c x:real^N i. (c % x)$i = c * x$i`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ASM_SIMP_TAC[vector_mul; CART_EQ; LAMBDA_BETA]]);; let COND_COMPONENT = prove (`(if b then x else y)$i = if b then x$i else y$i`, MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some frequently useful arithmetic lemmas over vectors. *) (* ------------------------------------------------------------------------- *) let VECTOR_ADD_SYM = VECTOR_ARITH `!x y:real^N. x + y = y + x`;; let VECTOR_ADD_LID = VECTOR_ARITH `!x. vec 0 + x = x`;; let VECTOR_ADD_RID = VECTOR_ARITH `!x. x + vec 0 = x`;; let VECTOR_SUB_REFL = VECTOR_ARITH `!x. x - x = vec 0`;; let VECTOR_ADD_LINV = VECTOR_ARITH `!x. --x + x = vec 0`;; let VECTOR_ADD_RINV = VECTOR_ARITH `!x. x + --x = vec 0`;; let VECTOR_SUB_RADD = VECTOR_ARITH `!x y. x - (x + y) = --y:real^N`;; let VECTOR_NEG_SUB = VECTOR_ARITH `!x:real^N y. --(x - y) = y - x`;; let VECTOR_SUB_EQ = VECTOR_ARITH `!x y. (x - y = vec 0) <=> (x = y)`;; let VECTOR_MUL_ASSOC = VECTOR_ARITH `!a b x. a % (b % x) = (a * b) % x`;; let VECTOR_MUL_LID = VECTOR_ARITH `!x. &1 % x = x`;; let VECTOR_MUL_LZERO = VECTOR_ARITH `!x. &0 % x = vec 0`;; let VECTOR_SUB_ADD = VECTOR_ARITH `(x - y) + y = x:real^N`;; let VECTOR_SUB_ADD2 = VECTOR_ARITH `y + (x - y) = x:real^N`;; let VECTOR_ADD_LDISTRIB = VECTOR_ARITH `c % (x + y) = c % x + c % y`;; let VECTOR_SUB_LDISTRIB = VECTOR_ARITH `c % (x - y) = c % x - c % y`;; let VECTOR_ADD_RDISTRIB = VECTOR_ARITH `(a + b) % x = a % x + b % x`;; let VECTOR_SUB_RDISTRIB = VECTOR_ARITH `(a - b) % x = a % x - b % x`;; let VECTOR_ADD_SUB = VECTOR_ARITH `(x + y:real^N) - x = y`;; let VECTOR_EQ_ADDR = VECTOR_ARITH `(x + y = x) <=> (y = vec 0)`;; let VECTOR_SUB = VECTOR_ARITH `x - y = x + --(y:real^N)`;; let VECTOR_SUB_RZERO = VECTOR_ARITH `x - vec 0 = x`;; let VECTOR_MUL_RZERO = VECTOR_ARITH `c % vec 0 = vec 0`;; let VECTOR_NEG_MINUS1 = VECTOR_ARITH `--x = (--(&1)) % x`;; let VECTOR_ADD_ASSOC = VECTOR_ARITH `(x:real^N) + y + z = (x + y) + z`;; let VECTOR_SUB_LZERO = VECTOR_ARITH `vec 0 - x = --x`;; let VECTOR_NEG_NEG = VECTOR_ARITH `--(--(x:real^N)) = x`;; let VECTOR_MUL_LNEG = VECTOR_ARITH `--c % x = --(c % x)`;; let VECTOR_MUL_RNEG = VECTOR_ARITH `c % --x = --(c % x)`;; let VECTOR_NEG_0 = VECTOR_ARITH `--(vec 0) = vec 0`;; let VECTOR_NEG_EQ_0 = VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;; let VECTOR_EQ_NEG2 = VECTOR_ARITH `!x y:real^N. --x = --y <=> x = y`;; let VECTOR_ADD_AC = VECTOR_ARITH `(m + n = n + m:real^N) /\ ((m + n) + p = m + n + p) /\ (m + n + p = n + m + p)`;; let VEC_EQ = prove (`!m n. (vec m = vec n) <=> (m = n)`, SIMP_TAC[CART_EQ; VEC_COMPONENT; REAL_OF_NUM_EQ] THEN MESON_TAC[LE_REFL; DIMINDEX_GE_1]);; (* ------------------------------------------------------------------------- *) (* Analogous theorems for set-sums. *) (* ------------------------------------------------------------------------- *) let SUMS_SYM = prove (`!s t:real^N->bool. {x + y | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);; let SUMS_ASSOC = prove (`!s t u:real^N->bool. {w + z | w IN {x + y | x IN s /\ y IN t} /\ z IN u} = {x + v | x IN s /\ v IN {y + z | y IN t /\ z IN u}}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Infinitude of Euclidean space. *) (* ------------------------------------------------------------------------- *) let EUCLIDEAN_SPACE_INFINITE = prove (`INFINITE(:real^N)`, REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `vec:num->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_IMAGE_INJ)) THEN REWRITE_TAC[VEC_EQ; SET_RULE `{x | f x IN UNIV} = UNIV`] THEN REWRITE_TAC[GSYM INFINITE; num_INFINITE]);; (* ------------------------------------------------------------------------- *) (* Properties of the dot product. *) (* ------------------------------------------------------------------------- *) let DOT_SYM = VECTOR_ARITH `!x y. x dot y = y dot x`;; let DOT_LADD = VECTOR_ARITH `!x y z. (x + y) dot z = (x dot z) + (y dot z)`;; let DOT_RADD = VECTOR_ARITH `!x y z. x dot (y + z) = (x dot y) + (x dot z)`;; let DOT_LSUB = VECTOR_ARITH `!x y z. (x - y) dot z = (x dot z) - (y dot z)`;; let DOT_RSUB = VECTOR_ARITH `!x y z. x dot (y - z) = (x dot y) - (x dot z)`;; let DOT_LMUL = VECTOR_ARITH `!c x y. (c % x) dot y = c * (x dot y)`;; let DOT_RMUL = VECTOR_ARITH `!c x y. x dot (c % y) = c * (x dot y)`;; let DOT_LNEG = VECTOR_ARITH `!x y. (--x) dot y = --(x dot y)`;; let DOT_RNEG = VECTOR_ARITH `!x y. x dot (--y) = --(x dot y)`;; let DOT_LZERO = VECTOR_ARITH `!x. (vec 0) dot x = &0`;; let DOT_RZERO = VECTOR_ARITH `!x. x dot (vec 0) = &0`;; let DOT_POS_LE = prove (`!x. &0 <= x dot x`, SIMP_TAC[dot; SUM_POS_LE_NUMSEG; REAL_LE_SQUARE]);; let DOT_EQ_0 = prove (`!x:real^N. ((x dot x = &0) <=> (x = vec 0))`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DOT_LZERO]] THEN SIMP_TAC[dot; CART_EQ; vec; LAMBDA_BETA] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[REAL_ENTIRE] `x * x = &0`)] THEN MATCH_MP_TAC SUM_POS_EQ_0_NUMSEG THEN ASM_REWRITE_TAC[REAL_LE_SQUARE]);; let DOT_POS_LT = prove (`!x. (&0 < x dot x) <=> ~(x = vec 0)`, REWRITE_TAC[REAL_LT_LE; DOT_POS_LE] THEN MESON_TAC[DOT_EQ_0]);; let FORALL_DOT_EQ_0 = prove (`(!y. (!x. x dot y = &0) <=> y = vec 0) /\ (!x. (!y. x dot y = &0) <=> x = vec 0)`, MESON_TAC[DOT_LZERO; DOT_RZERO; DOT_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Some trivial theorems about mapping R^n itself. *) (* ------------------------------------------------------------------------- *) let REFLECT_UNIV = prove (`IMAGE (--) (:real^N) = (:real^N)`, MP_TAC(VECTOR_ARITH `!x:real^N. --(--x) = x`) THEN SET_TAC[]);; let TRANSLATION_UNIV = prove (`!a. IMAGE (\x. a + x) (:real^N) = (:real^N)`, GEN_TAC THEN MP_TAC(VECTOR_ARITH `!x. a + (x - a):real^N = x`) THEN SET_TAC[]);; let TRANSLATION_SUBSET_GALOIS_RIGHT = prove (`!s t a:real^N. s SUBSET IMAGE (\x. a + x) t <=> IMAGE (\x. --a + x) s SUBSET t`, REPEAT GEN_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. f(g x) = x) /\ (!y. g(f y) = y) ==> (s SUBSET IMAGE f t <=> IMAGE g s SUBSET t)`) THEN REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH);; let TRANSLATION_SUBSET_GALOIS_LEFT = prove (`!s t a:real^N. IMAGE (\x. a + x) s SUBSET t <=> s SUBSET IMAGE (\x. --a + x) t`, REWRITE_TAC[TRANSLATION_SUBSET_GALOIS_RIGHT; VECTOR_NEG_NEG]);; let TRANSLATION_GALOIS = prove (`!s t a:real^N. s = IMAGE (\x. a + x) t <=> t = IMAGE (\x. --a + x) s`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[TRANSLATION_SUBSET_GALOIS_RIGHT; VECTOR_NEG_NEG] THEN REWRITE_TAC[CONJ_ACI]);; let IN_TRANSLATION_GALOIS = prove (`!s a b:real^N. b IN IMAGE (\x. a + x) s <=> (b - a) IN s`, REWRITE_TAC[GSYM SING_SUBSET; TRANSLATION_SUBSET_GALOIS_RIGHT] THEN REWRITE_TAC[VECTOR_ARITH `b - a:real^N = --a + b`] THEN SET_TAC[]);; let IN_TRANSLATION_GALOIS_ALT = prove (`!s a b:real^N. (a + b) IN s <=> b IN IMAGE (\x. --a + x) s`, REWRITE_TAC[GSYM SING_SUBSET; TRANSLATION_SUBSET_GALOIS_RIGHT] THEN REWRITE_TAC[IMAGE_CLAUSES; VECTOR_NEG_NEG]);; (* ------------------------------------------------------------------------- *) (* Introduce norms, but defer many properties till we get square roots. *) (* ------------------------------------------------------------------------- *) make_overloadable "norm" `:A->real`;; overload_interface("norm",`vector_norm:real^N->real`);; let vector_norm = new_definition `norm x = sqrt(x dot x)`;; (* ------------------------------------------------------------------------- *) (* Useful for the special cases of 1 dimension. *) (* ------------------------------------------------------------------------- *) let FORALL_DIMINDEX_1 = prove (`(!i. 1 <= i /\ i <= dimindex(:1) ==> P i) <=> P 1`, MESON_TAC[DIMINDEX_1; LE_ANTISYM]);; (* ------------------------------------------------------------------------- *) (* The collapse of the general concepts to the real line R^1. *) (* ------------------------------------------------------------------------- *) let VECTOR_ONE = prove (`!x:real^1. x = lambda i. x$1`, SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[DIMINDEX_1; LE_ANTISYM]);; let FORALL_REAL_ONE = prove (`(!x:real^1. P x) <=> (!x. P(lambda i. x))`, EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^1)$1`) THEN REWRITE_TAC[GSYM VECTOR_ONE]);; let NORM_REAL = prove (`!x:real^1. norm(x) = abs(x$1)`, REWRITE_TAC[vector_norm; dot; DIMINDEX_1; SUM_SING_NUMSEG; GSYM REAL_POW_2; POW_2_SQRT_ABS]);; (* ------------------------------------------------------------------------- *) (* Metric function. *) (* ------------------------------------------------------------------------- *) override_interface("dist",`distance:real^N#real^N->real`);; let dist = new_definition `dist(x,y) = norm(x - y)`;; let DIST_REAL = prove (`!x:real^1 y. dist(x,y) = abs(x$1 - y$1)`, SIMP_TAC[dist; NORM_REAL; vector_sub; LAMBDA_BETA; LE_REFL; DIMINDEX_1]);; (* ------------------------------------------------------------------------- *) (* A connectedness or intermediate value lemma with several applications. *) (* ------------------------------------------------------------------------- *) let CONNECTED_REAL_LEMMA = prove (`!f:real->real^N a b e1 e2. a <= b /\ f(a) IN e1 /\ f(b) IN e2 /\ (!e x. a <= x /\ x <= b /\ &0 < e ==> ?d. &0 < d /\ !y. abs(y - x) < d ==> dist(f(y),f(x)) < e) /\ (!y. y IN e1 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e1) /\ (!y. y IN e2 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e2) /\ ~(?x. a <= x /\ x <= b /\ f(x) IN e1 /\ f(x) IN e2) ==> ?x. a <= x /\ x <= b /\ ~(f(x) IN e1) /\ ~(f(x) IN e2)`, let tac = ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TOTAL; REAL_LE_ANTISYM] in REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `\c. !x. a <= x /\ x <= c ==> (f(x):real^N) IN e1` REAL_COMPLETE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [tac; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN SUBGOAL_THEN `a <= x /\ x <= b` STRIP_ASSUME_TAC THENL [tac; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!z. a <= z /\ z < x ==> (f(z):real^N) IN e1` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]; ALL_TAC] THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e1` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[REAL_ARITH `z <= x + e /\ e < d ==> z < x \/ abs(z - x) < d`; REAL_ARITH `&0 < e ==> ~(x + e <= x)`; REAL_DOWN]; SUBGOAL_THEN `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e2` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(SPECL [`x - a`; `d:real`] REAL_DOWN2) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_LE; REAL_SUB_LT]; ALL_TAC] THEN ASM_MESON_TAC[REAL_ARITH `e < x - a ==> a <= x - e`; REAL_ARITH `&0 < e /\ x <= b ==> x - e <= b`; REAL_ARITH `&0 < e /\ e < d ==> x - e < x /\ abs((x - e) - x) < d`]]);; (* ------------------------------------------------------------------------- *) (* One immediately useful corollary is the existence of square roots! *) (* ------------------------------------------------------------------------- *) let SQUARE_BOUND_LEMMA = prove (`!x. x < (&1 + x) * (&1 + x)`, GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN MAP_EVERY (fun t -> MP_TAC(SPEC t REAL_LE_SQUARE)) [`x:real`; `&1 + x`] THEN REAL_ARITH_TAC);; let SQUARE_CONTINUOUS = prove (`!x e. &0 < e ==> ?d. &0 < d /\ !y. abs(y - x) < d ==> abs(y * y - x * x) < e`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO] THEN EXISTS_TAC `inv(&1 + inv(e))` THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_ADD; REAL_LT_01] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&1 + inv(e)) * inv(&1 + inv(e))` THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LT_MUL2; REAL_ABS_POS] THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; SQUARE_BOUND_LEMMA; REAL_LT_INV_EQ]; MP_TAC(SPECL [`abs(x)`; `e / (&3 * abs(x))`] REAL_DOWN2)THEN ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[REAL_ARITH `x * x - y * y = (x - y) * (x + y)`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d * &3 * abs(x)` THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE] THEN MAP_EVERY UNDISCH_TAC [`abs (y - x) < d`; `d < abs(x)`] THEN REAL_ARITH_TAC]);; let SQRT_WORKS_GEN = prove (`!x. real_sgn(sqrt x) = real_sgn x /\ sqrt(x) pow 2 = abs x`, GEN_TAC THEN REWRITE_TAC[sqrt] THEN CONV_TAC SELECT_CONV THEN SUBGOAL_THEN `!x. &0 < x ==> ?y. &0 < y /\ y pow 2 = x` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\u. lambda i. u):real->real^1`; `&0`; `&1 + x`; `{u:real^1 | u$1 * u$1 < x}`; `{u:real^1 | u$1 * u$1 > x}`] CONNECTED_REAL_LEMMA) THEN SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_1; DIST_REAL; IN_ELIM_THM] THEN REWRITE_TAC[REAL_POW_2; REAL_ARITH `~(x < y) /\ ~(x > y) <=> x = y`] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_LE; REAL_ENTIRE]] THEN ASM_REWRITE_TAC[real_gt; SQUARE_BOUND_LEMMA; REAL_MUL_LZERO] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_ANTISYM]] THEN MESON_TAC[SQUARE_CONTINUOUS; REAL_SUB_LT; REAL_ARITH `abs(z2 - x2) < y - x2 ==> z2 < y`; REAL_ARITH `abs(z2 - x2) < x2 - y ==> y < z2`]; ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_SGN_0; REAL_SGN_EQ; UNWIND_THM2] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN FIRST_X_ASSUM(MP_TAC o SPEC `abs x`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `real_sgn x * y` THEN ASM_REWRITE_TAC[REAL_POW_MUL; GSYM REAL_SGN_POW; REAL_SGN_POW_2] THEN REWRITE_TAC[REAL_SGN_MUL; REAL_SGN_REAL_SGN] THEN ASM_SIMP_TAC[real_sgn; REAL_ARITH `&0 < abs x <=> ~(x = &0)`] THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID]]);; let SQRT_UNIQUE_GEN = prove (`!x y. real_sgn y = real_sgn x /\ y pow 2 = abs x ==> sqrt x = y`, REPEAT GEN_TAC THEN MP_TAC(GSYM(SPEC `x:real` SQRT_WORKS_GEN)) THEN SIMP_TAC[REAL_RING `x pow 2 = y pow 2 <=> x:real = y \/ x = --y`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[IMP_CONJ_ALT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_SGN_NEG] THEN SIMP_TAC[REAL_ARITH `--x = x <=> x = &0`; REAL_SGN_EQ; REAL_NEG_0; SQRT_0]);; let SQRT_NEG = prove (`!x. sqrt(--x) = --sqrt(x)`, GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN REWRITE_TAC[REAL_SGN_NEG; REAL_POW_NEG; REAL_ABS_NEG; ARITH] THEN REWRITE_TAC[SQRT_WORKS_GEN]);; let REAL_SGN_SQRT = prove (`!x. real_sgn(sqrt x) = real_sgn x`, REWRITE_TAC[SQRT_WORKS_GEN]);; let SQRT_WORKS = prove (`!x. &0 <= x ==> &0 <= sqrt(x) /\ sqrt(x) pow 2 = x`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` SQRT_WORKS_GEN) THEN REWRITE_TAC[real_sgn] THEN ASM_REAL_ARITH_TAC);; let SQRT_POS_LE = prove (`!x. &0 <= x ==> &0 <= sqrt(x)`, MESON_TAC[SQRT_WORKS]);; let SQRT_POW_2 = prove (`!x. &0 <= x ==> sqrt(x) pow 2 = x`, MESON_TAC[SQRT_WORKS]);; let SQRT_POW2 = prove (`!x. sqrt(x) pow 2 = x <=> &0 <= x`, MESON_TAC[REAL_POW_2; REAL_LE_SQUARE; SQRT_POW_2]);; let SQRT_MUL = prove (`!x y. sqrt(x * y) = sqrt x * sqrt y`, REPEAT GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN REWRITE_TAC[REAL_SGN_MUL; REAL_POW_MUL; SQRT_WORKS_GEN; REAL_ABS_MUL]);; let SQRT_INV = prove (`!x. sqrt (inv x) = inv(sqrt x)`, GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN REWRITE_TAC[REAL_SGN_INV; REAL_POW_INV; REAL_ABS_INV; SQRT_WORKS_GEN]);; let SQRT_DIV = prove (`!x y. sqrt (x / y) = sqrt x / sqrt y`, REWRITE_TAC[real_div; SQRT_MUL; SQRT_INV]);; let SQRT_LT_0 = prove (`!x. &0 < sqrt x <=> &0 < x`, REWRITE_TAC[GSYM real_gt; GSYM REAL_SGN_EQ; REAL_SGN_SQRT]);; let SQRT_EQ_0 = prove (`!x. sqrt x = &0 <=> x = &0`, ONCE_REWRITE_TAC[GSYM REAL_SGN_EQ] THEN REWRITE_TAC[REAL_SGN_SQRT]);; let SQRT_LE_0 = prove (`!x. &0 <= sqrt x <=> &0 <= x`, REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN REWRITE_TAC[SQRT_LT_0; SQRT_EQ_0]);; let SQRT_MONO_LT = prove (`!x y. x < y ==> sqrt(x) < sqrt(y)`, SUBGOAL_THEN `!x y. &0 <= x /\ x < y ==> sqrt x < sqrt y` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN EXISTS_TAC `2` THEN ASM_REWRITE_TAC[SQRT_WORKS_GEN; SQRT_LE_0] THEN ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= x` THEN ASM_SIMP_TAC[] THEN ASM_CASES_TAC `&0 <= y` THENL [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE; SQRT_LE_0]; FIRST_X_ASSUM(MP_TAC o SPECL [`--y:real`; `--x:real`]) THEN REWRITE_TAC[SQRT_NEG] THEN ASM_REAL_ARITH_TAC]]);; let SQRT_MONO_LE = prove (`!x y. x <= y ==> sqrt(x) <= sqrt(y)`, MESON_TAC[REAL_LE_LT; SQRT_MONO_LT]);; let SQRT_MONO_LT_EQ = prove (`!x y. sqrt(x) < sqrt(y) <=> x < y`, MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);; let SQRT_MONO_LE_EQ = prove (`!x y. sqrt(x) <= sqrt(y) <=> x <= y`, MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);; let SQRT_INJ = prove (`!x y. sqrt(x) = sqrt(y) <=> x = y`, SIMP_TAC[GSYM REAL_LE_ANTISYM; SQRT_MONO_LE_EQ]);; let SQRT_POS_LT = prove (`!x. &0 < x ==> &0 < sqrt(x)`, MESON_TAC[REAL_LT_LE; SQRT_POS_LE; SQRT_EQ_0]);; let REAL_LE_LSQRT = prove (`!x y. &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`, MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);; let REAL_LE_RSQRT = prove (`!x y. x pow 2 <= y ==> x <= sqrt(y)`, MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE; REAL_POW_2; REAL_LE_SQUARE; REAL_LE_TRANS; POW_2_SQRT]);; let REAL_LT_LSQRT = prove (`!x y. &0 <= y /\ x < y pow 2 ==> sqrt x < y`, MESON_TAC[SQRT_MONO_LT; REAL_POW_LE; POW_2_SQRT]);; let REAL_LT_RSQRT = prove (`!x y. x pow 2 < y ==> x < sqrt(y)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x < a ==> x < a`) THEN REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LT THEN ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; let SQRT_EVEN_POW2 = prove (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`, SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; DIV_MULT; ARITH_EQ] THEN MESON_TAC[SQRT_UNIQUE; REAL_POW_POW; MULT_SYM; REAL_POW_LE; REAL_POS]);; let REAL_DIV_SQRT = prove (`!x. &0 <= x ==> x / sqrt(x) = sqrt(x)`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SQRT_0; real_div; REAL_MUL_LZERO]] THEN ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; SQRT_POS_LT; GSYM REAL_POW_2] THEN ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE]);; let REAL_RSQRT_LE = prove (`!x y. &0 <= x /\ &0 <= y /\ x <= sqrt y ==> x pow 2 <= y`, MESON_TAC[REAL_POW_LE2; SQRT_POW_2]);; let REAL_LSQRT_LE = prove (`!x y. &0 <= x /\ sqrt x <= y ==> x <= y pow 2`, MESON_TAC[REAL_POW_LE2; SQRT_POS_LE; REAL_LE_TRANS; SQRT_POW_2]);; let REAL_SQRT_POW_2 = prove (`!x. sqrt x pow 2 = abs x`, REWRITE_TAC[SQRT_WORKS_GEN]);; (* ------------------------------------------------------------------------- *) (* Hence derive more interesting properties of the norm. *) (* ------------------------------------------------------------------------- *) let NORM_0 = prove (`norm(vec 0) = &0`, REWRITE_TAC[vector_norm; DOT_LZERO; SQRT_0]);; let NORM_POS_LE = prove (`!x. &0 <= norm x`, GEN_TAC THEN SIMP_TAC[DOT_POS_LE; vector_norm; SQRT_POS_LE]);; let NORM_NEG = prove (`!x. norm(--x) = norm x`, REWRITE_TAC[vector_norm; DOT_LNEG; DOT_RNEG; REAL_NEG_NEG]);; let NORM_SUB = prove (`!x y. norm(x - y) = norm(y - x)`, MESON_TAC[NORM_NEG; VECTOR_NEG_SUB]);; let NORM_MUL = prove (`!a x. norm(a % x) = abs(a) * norm x`, REWRITE_TAC[vector_norm; DOT_LMUL; DOT_RMUL; REAL_MUL_ASSOC] THEN REWRITE_TAC[SQRT_MUL; GSYM REAL_POW_2; REAL_SQRT_POW_2]);; let NORM_EQ_0_DOT = prove (`!x. (norm x = &0) <=> (x dot x = &0)`, SIMP_TAC[vector_norm; SQRT_EQ_0; DOT_POS_LE]);; let NORM_EQ_0 = prove (`!x. (norm x = &0) <=> (x = vec 0)`, SIMP_TAC[vector_norm; DOT_EQ_0; SQRT_EQ_0; DOT_POS_LE]);; let NORM_POS_LT = prove (`!x. &0 < norm x <=> ~(x = vec 0)`, MESON_TAC[REAL_LT_LE; NORM_POS_LE; NORM_EQ_0]);; let NORM_POW_2 = prove (`!x. norm(x) pow 2 = x dot x`, SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);; let NORM_EQ_0_IMP = prove (`!x. (norm x = &0) ==> (x = vec 0)`, MESON_TAC[NORM_EQ_0]);; let NORM_LE_0 = prove (`!x. norm x <= &0 <=> (x = vec 0)`, MESON_TAC[REAL_LE_ANTISYM; NORM_EQ_0; NORM_POS_LE]);; let VECTOR_MUL_EQ_0 = prove (`!a x. (a % x = vec 0) <=> (a = &0) \/ (x = vec 0)`, REWRITE_TAC[GSYM NORM_EQ_0; NORM_MUL; REAL_ABS_ZERO; REAL_ENTIRE]);; let VECTOR_MUL_LCANCEL = prove (`!a x y. (a % x = a % y) <=> (a = &0) \/ (x = y)`, MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_LDISTRIB; VECTOR_SUB_EQ]);; let VECTOR_MUL_RCANCEL = prove (`!a b x. (a % x = b % x) <=> (a = b) \/ (x = vec 0)`, MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_RDISTRIB; REAL_SUB_0; VECTOR_SUB_EQ]);; let VECTOR_MUL_LCANCEL_IMP = prove (`!a x y. ~(a = &0) /\ (a % x = a % y) ==> (x = y)`, MESON_TAC[VECTOR_MUL_LCANCEL]);; let VECTOR_MUL_RCANCEL_IMP = prove (`!a b x. ~(x = vec 0) /\ (a % x = b % x) ==> (a = b)`, MESON_TAC[VECTOR_MUL_RCANCEL]);; let NORM_CAUCHY_SCHWARZ = prove (`!(x:real^N) y. x dot y <= norm(x) * norm(y)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`norm(x:real^N) = &0`; `norm(y:real^N) = &0`] THEN ASM_SIMP_TAC[NORM_EQ_0_IMP; DOT_LZERO; DOT_RZERO; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_POS_LE) THEN REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2; REAL_POW_2; REAL_LE_REFL] THEN REWRITE_TAC[DOT_SYM; REAL_ARITH `&0 <= y * (y * x * x - x * d) - x * (y * d - x * y * y) <=> x * y * d <= x * y * x * y`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LE; NORM_POS_LE]);; let NORM_CAUCHY_SCHWARZ_ABS = prove (`!x:real^N y. abs(x dot y) <= norm(x) * norm(y)`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_CAUCHY_SCHWARZ) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `--(y:real^N)` th)) THEN REWRITE_TAC[DOT_RNEG; NORM_NEG] THEN REAL_ARITH_TAC);; let REAL_ABS_NORM = prove (`!x. abs(norm x) = norm x`, REWRITE_TAC[NORM_POS_LE; REAL_ABS_REFL]);; let NORM_CAUCHY_SCHWARZ_DIV = prove (`!x:real^N y. abs((x dot y) / (norm x * norm y)) <= &1`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; real_div; REAL_INV_1; DOT_LZERO; DOT_RZERO; REAL_ABS_NUM; REAL_POS] THEN ASM_SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_LT_MUL; REAL_ABS_INV; NORM_POS_LT; REAL_ABS_MUL; REAL_ABS_NORM] THEN REWRITE_TAC[REAL_MUL_LID; NORM_CAUCHY_SCHWARZ_ABS]);; let NORM_TRIANGLE = prove (`!x y. norm(x + y) <= norm(x) + norm(y)`, REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN SIMP_TAC[GSYM vector_norm; DOT_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN REWRITE_TAC[DOT_LADD; DOT_RADD; REAL_POW_2; GSYM NORM_POW_2] THEN SIMP_TAC[NORM_CAUCHY_SCHWARZ; DOT_SYM; REAL_ARITH `d <= x * y ==> (x * x + d) + (d + y * y) <= (x + y) * (x + y)`]);; let NORM_TRIANGLE_SUB = prove (`!x y:real^N. norm(x) <= norm(y) + norm(x - y)`, MESON_TAC[NORM_TRIANGLE; VECTOR_SUB_ADD2]);; let NORM_TRIANGLE_LE = prove (`!x y. norm(x) + norm(y) <= e ==> norm(x + y) <= e`, MESON_TAC[REAL_LE_TRANS; NORM_TRIANGLE]);; let NORM_TRIANGLE_LT = prove (`!x y. norm(x) + norm(y) < e ==> norm(x + y) < e`, MESON_TAC[REAL_LET_TRANS; NORM_TRIANGLE]);; let COMPONENT_LE_NORM = prove (`!x:real^N i. abs(x$i) <= norm x`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !x:real^N. x$i = x$k` STRIP_ASSUME_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[vector_norm] THEN MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[GSYM REAL_ABS_POW] THEN REWRITE_TAC[real_abs; REAL_POW_2; REAL_LE_SQUARE] THEN SUBGOAL_THEN `x$k * (x:real^N)$k = sum(1..dimindex(:N)) (\i. if i = k then x$k * x$k else &0)` SUBST1_TAC THENL [REWRITE_TAC[SUM_DELTA] THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_SQUARE]);; let NORM_BOUND_COMPONENT_LE = prove (`!x:real^N e. norm(x) <= e ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= e`, MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);; let NORM_BOUND_COMPONENT_LT = prove (`!x:real^N e. norm(x) < e ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) < e`, MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);; let NORM_LE_L1 = prove (`!x:real^N. norm x <= sum(1..dimindex(:N)) (\i. abs(x$i))`, REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm; dot] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN REWRITE_TAC[REAL_POW_2] THEN SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; REAL_LE_SQUARE; REAL_ABS_POS] THEN SPEC_TAC(`dimindex(:N)`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THEN SIMP_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH `a2 <= a * a /\ &0 <= a * b /\ b2 <= b * b ==> a2 + b2 <= (a + b) * (a + b)`) THEN ASM_SIMP_TAC[SUM_POS_LE; REAL_LE_MUL; REAL_ABS_POS; FINITE_NUMSEG] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC);; let REAL_ABS_SUB_NORM = prove (`abs(norm(x) - norm(y)) <= norm(x - y)`, REWRITE_TAC[REAL_ARITH `abs(x - y) <= a <=> x <= y + a /\ y <= x + a`] THEN MESON_TAC[NORM_TRIANGLE_SUB; NORM_SUB]);; let NORM_LE = prove (`!x y. norm(x) <= norm(y) <=> x dot x <= y dot y`, REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE]);; let NORM_LT = prove (`!x y. norm(x) < norm(y) <=> x dot x < y dot y`, REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LT_EQ; DOT_POS_LE]);; let NORM_EQ = prove (`!x y. (norm x = norm y) <=> (x dot x = y dot y)`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; NORM_LE]);; let NORM_EQ_1 = prove (`!x. norm(x) = &1 <=> x dot x = &1`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN SIMP_TAC[vector_norm; SQRT_INJ; DOT_POS_LE; REAL_POS]);; let NORM_LE_COMPONENTWISE = prove (`!x:real^N y:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= abs(y$i)) ==> norm(x) <= norm(y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LE; dot] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS]);; let NORM_EQ_COMPONENTWISE = prove (`!x:real^N y:real^N. (!i. 1 <= i /\ i <= dimindex (:N) ==> abs(x$i) = abs(y$i)) ==> norm x = norm y`, SIMP_TAC[GSYM REAL_LE_ANTISYM; NORM_LE_COMPONENTWISE]);; let L1_LE_NORM = prove (`!x:real^N. sum(1..dimindex(:N)) (\i. abs(x$i)) <= sqrt(&(dimindex(:N))) * norm x`, let lemma = prove (`!x n. &n * sum(1..n) (\i. x i pow 2) - (sum(1..n) x) pow 2 = sum(1..n) (\i. sum(i+1..n) (\j. (x i - x j) pow 2))`, GEN_TAC THEN CONV_TAC(BINDER_CONV SYM_CONV) THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; ARITH_RULE `1 <= SUC n`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[ARITH_RULE `i <= n ==> i + 1 <= SUC n`; SUM_TRIV_NUMSEG; ARITH_RULE `~(n + 1 <= n)`; ARITH_RULE `n < SUC n + 1`] THEN ASM_REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `(x - y) pow 2 = (x pow 2 + y pow 2) - &2 * x * y`] THEN REWRITE_TAC[SUM_ADD_NUMSEG; SUM_SUB_NUMSEG; SUM_LMUL; SUM_RMUL; GSYM REAL_OF_NUM_SUC; SUM_CONST_NUMSEG; ADD_SUB] THEN REAL_ARITH_TAC) in GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs x <= abs y ==> x <= y`) THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; SQRT_POS_LE; REAL_POS] THEN REWRITE_TAC[REAL_LE_SQUARE_ABS; REAL_POW_MUL] THEN SIMP_TAC[SQRT_POW_2; REAL_POS; NORM_POW_2; dot] THEN REWRITE_TAC[GSYM REAL_POW_2] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_POW2_ABS] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[lemma] THEN SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_LE_POW_2]);; let DIST_INCREASES_ONLINE = prove (`!a b d. ~(d = vec 0) ==> dist(a,b + d) > dist(a,b) \/ dist(a,b - d) > dist(a,b)`, REWRITE_TAC[dist; vector_norm; real_gt; GSYM NORM_POS_LT] THEN SIMP_TAC[SQRT_MONO_LT_EQ; DOT_POS_LE; SQRT_LT_0] THEN REWRITE_TAC[DOT_RSUB; DOT_RADD; DOT_LSUB; DOT_LADD] THEN REAL_ARITH_TAC);; let NORM_INCREASES_ONLINE = prove (`!a:real^N d. ~(d = vec 0) ==> norm(a + d) > norm(a) \/ norm(a - d) > norm(a)`, MP_TAC(ISPEC `vec 0 :real^N` DIST_INCREASES_ONLINE) THEN REWRITE_TAC[dist; VECTOR_SUB_LZERO; NORM_NEG]);; (* ------------------------------------------------------------------------- *) (* Squaring equations and inequalities involving norms. *) (* ------------------------------------------------------------------------- *) let DOT_SQUARE_NORM = prove (`!x. x dot x = norm(x) pow 2`, SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);; let NORM_EQ_SQUARE = prove (`!x:real^N. norm(x) = a <=> &0 <= a /\ x dot x = a pow 2`, REWRITE_TAC[DOT_SQUARE_NORM] THEN ONCE_REWRITE_TAC[REAL_RING `x pow 2 = a pow 2 <=> x = a \/ x + a = &0`] THEN GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);; let NORM_LE_SQUARE = prove (`!x:real^N. norm(x) <= a <=> &0 <= a /\ x dot x <= a pow 2`, REWRITE_TAC[DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);; let NORM_GE_SQUARE = prove (`!x:real^N. norm(x) >= a <=> a <= &0 \/ x dot x >= a pow 2`, REWRITE_TAC[real_ge; DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);; let NORM_LT_SQUARE = prove (`!x:real^N. norm(x) < a <=> &0 < a /\ x dot x < a pow 2`, REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN REAL_ARITH_TAC);; let NORM_GT_SQUARE = prove (`!x:real^N. norm(x) > a <=> a < &0 \/ x dot x > a pow 2`, REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`; NORM_LE_SQUARE] THEN REAL_ARITH_TAC);; let NORM_LT_SQUARE_ALT = prove (`!x:real^N. norm(x) < a <=> &0 <= a /\ x dot x < a pow 2`, REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THENL [ASM_REWRITE_TAC[real_ge] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[DOT_POS_LE]; ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* General linear decision procedure for normed spaces. *) (* ------------------------------------------------------------------------- *) let NORM_ARITH = let find_normedterms = let augment_norm b tm acc = match tm with Comb(Const("vector_norm",_),v) -> insert (b,v) acc | _ -> acc in let rec find_normedterms tm acc = match tm with Comb(Comb(Const("real_add",_),l),r) -> find_normedterms l (find_normedterms r acc) | Comb(Comb(Const("real_mul",_),c),n) -> if not (is_ratconst c) then acc else augment_norm (rat_of_term c >=/ Int 0) n acc | _ -> augment_norm true tm acc in find_normedterms in let lincomb_neg t = mapf minus_num t in let lincomb_cmul c t = if c =/ Int 0 then undefined else mapf (( */ ) c) t in let lincomb_add l r = combine (+/) (fun x -> x =/ Int 0) l r in let lincomb_sub l r = lincomb_add l (lincomb_neg r) in let lincomb_eq l r = lincomb_sub l r = undefined in let rec vector_lincomb tm = match tm with Comb(Comb(Const("vector_add",_),l),r) -> lincomb_add (vector_lincomb l) (vector_lincomb r) | Comb(Comb(Const("vector_sub",_),l),r) -> lincomb_sub (vector_lincomb l) (vector_lincomb r) | Comb(Comb(Const("%",_),l),r) -> lincomb_cmul (rat_of_term l) (vector_lincomb r) | Comb(Const("vector_neg",_),t) -> lincomb_neg (vector_lincomb t) | Comb(Const("vec",_),n) when is_numeral n && dest_numeral n =/ Int 0 -> undefined | _ -> (tm |=> Int 1) in let vector_lincombs tms = itlist (fun t fns -> if can (assoc t) fns then fns else let f = vector_lincomb t in try let _,f' = find (fun (_,f') -> lincomb_eq f f') fns in (t,f')::fns with Failure _ -> (t,f)::fns) tms [] in let rec replacenegnorms fn tm = match tm with Comb(Comb(Const("real_add",_),l),r) -> BINOP_CONV (replacenegnorms fn) tm | Comb(Comb(Const("real_mul",_),c),n) when rat_of_term c RAND_CONV fn tm | _ -> REFL tm in let flip v eq = if defined eq v then (v |-> minus_num(apply eq v)) eq else eq in let rec allsubsets s = match s with [] -> [[]] | (a::t) -> let res = allsubsets t in map (fun b -> a::b) res @ res in let evaluate env lin = foldr (fun x c s -> s +/ c */ apply env x) lin (Int 0) in let rec solve (vs,eqs) = match (vs,eqs) with [],[] -> (0 |=> Int 1) | _,eq::oeqs -> let v = hd(intersect vs (dom eq)) in let c = apply eq v in let vdef = lincomb_cmul (Int(-1) // c) eq in let eliminate eqn = if not(defined eqn v) then eqn else lincomb_add (lincomb_cmul (apply eqn v) vdef) eqn in let soln = solve (subtract vs [v],map eliminate oeqs) in (v |-> evaluate soln (undefine v vdef)) soln in let rec combinations k l = if k = 0 then [[]] else match l with [] -> [] | h::t -> map (fun c -> h::c) (combinations (k - 1) t) @ combinations k t in let vertices vs eqs = let vertex cmb = let soln = solve(vs,cmb) in map (fun v -> tryapplyd soln v (Int 0)) vs in let rawvs = mapfilter vertex (combinations (length vs) eqs) in let unset = filter (forall (fun c -> c >=/ Int 0)) rawvs in itlist (insert' (forall2 (=/))) unset [] in let subsumes l m = forall2 (fun x y -> abs_num x <=/ abs_num y) l m in let rec subsume todo dun = match todo with [] -> dun | v::ovs -> let dun' = if exists (fun w -> subsumes w v) dun then dun else v::(filter (fun w -> not(subsumes v w)) dun) in subsume ovs dun' in let NORM_CMUL_RULE = let MATCH_pth = (MATCH_MP o prove) (`!b x. b >= norm(x) ==> !c. abs(c) * b >= norm(c % x)`, SIMP_TAC[NORM_MUL; real_ge; REAL_LE_LMUL; REAL_ABS_POS]) in fun c th -> ISPEC(term_of_rat c) (MATCH_pth th) in let NORM_ADD_RULE = let MATCH_pth = (MATCH_MP o prove) (`!b1 b2 x1 x2. b1 >= norm(x1) /\ b2 >= norm(x2) ==> b1 + b2 >= norm(x1 + x2)`, REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN ASM_SIMP_TAC[REAL_LE_ADD2]) in fun th1 th2 -> MATCH_pth (CONJ th1 th2) in let INEQUALITY_CANON_RULE = CONV_RULE(LAND_CONV REAL_POLY_CONV) o CONV_RULE(LAND_CONV REAL_RAT_REDUCE_CONV) o GEN_REWRITE_RULE I [REAL_ARITH `s >= t <=> s - t >= &0`] in let NORM_CANON_CONV = let APPLY_pth1 = GEN_REWRITE_CONV I [VECTOR_ARITH `x:real^N = &1 % x`] and APPLY_pth2 = GEN_REWRITE_CONV I [VECTOR_ARITH `x - y:real^N = x + --y`] and APPLY_pth3 = GEN_REWRITE_CONV I [VECTOR_ARITH `--x:real^N = -- &1 % x`] and APPLY_pth4 = GEN_REWRITE_CONV I [VECTOR_ARITH `&0 % x:real^N = vec 0`; VECTOR_ARITH `c % vec 0:real^N = vec 0`] and APPLY_pth5 = GEN_REWRITE_CONV I [VECTOR_ARITH `c % (d % x) = (c * d) % x`] and APPLY_pth6 = GEN_REWRITE_CONV I [VECTOR_ARITH `c % (x + y) = c % x + c % y`] and APPLY_pth7 = GEN_REWRITE_CONV I [VECTOR_ARITH `vec 0 + x = x`; VECTOR_ARITH `x + vec 0 = x`] and APPLY_pth8 = GEN_REWRITE_CONV I [VECTOR_ARITH `c % x + d % x = (c + d) % x`] THENC LAND_CONV REAL_RAT_ADD_CONV THENC GEN_REWRITE_CONV TRY_CONV [VECTOR_ARITH `&0 % x = vec 0`] and APPLY_pth9 = GEN_REWRITE_CONV I [VECTOR_ARITH `(c % x + z) + d % x = (c + d) % x + z`; VECTOR_ARITH `c % x + (d % x + z) = (c + d) % x + z`; VECTOR_ARITH `(c % x + w) + (d % x + z) = (c + d) % x + (w + z)`] THENC LAND_CONV(LAND_CONV REAL_RAT_ADD_CONV) and APPLY_ptha = GEN_REWRITE_CONV I [VECTOR_ARITH `&0 % x + y = y`] and APPLY_pthb = GEN_REWRITE_CONV I [VECTOR_ARITH `c % x + d % y = c % x + d % y`; VECTOR_ARITH `(c % x + z) + d % y = c % x + (z + d % y)`; VECTOR_ARITH `c % x + (d % y + z) = c % x + (d % y + z)`; VECTOR_ARITH `(c % x + w) + (d % y + z) = c % x + (w + (d % y + z))`] and APPLY_pthc = GEN_REWRITE_CONV I [VECTOR_ARITH `c % x + d % y = d % y + c % x`; VECTOR_ARITH `(c % x + z) + d % y = d % y + (c % x + z)`; VECTOR_ARITH `c % x + (d % y + z) = d % y + (c % x + z)`; VECTOR_ARITH `(c % x + w) + (d % y + z) = d % y + ((c % x + w) + z)`] and APPLY_pthd = GEN_REWRITE_CONV TRY_CONV [VECTOR_ARITH `x + vec 0 = x`] in let headvector tm = match tm with Comb(Comb(Const("vector_add",_),Comb(Comb(Const("%",_),l),v)),r) -> v | Comb(Comb(Const("%",_),l),v) -> v | _ -> failwith "headvector: non-canonical term" in let rec VECTOR_CMUL_CONV tm = ((APPLY_pth5 THENC LAND_CONV REAL_RAT_MUL_CONV) ORELSEC (APPLY_pth6 THENC BINOP_CONV VECTOR_CMUL_CONV)) tm and VECTOR_ADD_CONV tm = try APPLY_pth7 tm with Failure _ -> try APPLY_pth8 tm with Failure _ -> match tm with Comb(Comb(Const("vector_add",_),lt),rt) -> let l = headvector lt and r = headvector rt in if l < r then (APPLY_pthb THENC RAND_CONV VECTOR_ADD_CONV THENC APPLY_pthd) tm else if r < l then (APPLY_pthc THENC RAND_CONV VECTOR_ADD_CONV THENC APPLY_pthd) tm else (APPLY_pth9 THENC ((APPLY_ptha THENC VECTOR_ADD_CONV) ORELSEC RAND_CONV VECTOR_ADD_CONV THENC APPLY_pthd)) tm | _ -> REFL tm in let rec VECTOR_CANON_CONV tm = match tm with Comb(Comb(Const("vector_add",_),l),r) -> let lth = VECTOR_CANON_CONV l and rth = VECTOR_CANON_CONV r in let th = MK_COMB(AP_TERM (rator(rator tm)) lth,rth) in CONV_RULE (RAND_CONV VECTOR_ADD_CONV) th | Comb(Comb(Const("%",_),l),r) -> let rth = AP_TERM (rator tm) (VECTOR_CANON_CONV r) in CONV_RULE (RAND_CONV(APPLY_pth4 ORELSEC VECTOR_CMUL_CONV)) rth | Comb(Comb(Const("vector_sub",_),l),r) -> (APPLY_pth2 THENC VECTOR_CANON_CONV) tm | Comb(Const("vector_neg",_),t) -> (APPLY_pth3 THENC VECTOR_CANON_CONV) tm | Comb(Const("vec",_),n) when is_numeral n && dest_numeral n =/ Int 0 -> REFL tm | _ -> APPLY_pth1 tm in fun tm -> match tm with Comb(Const("vector_norm",_),e) -> RAND_CONV VECTOR_CANON_CONV tm | _ -> failwith "NORM_CANON_CONV" in let REAL_VECTOR_COMBO_PROVER = let pth_zero = prove(`norm(vec 0:real^N) = &0`,REWRITE_TAC[NORM_0]) and tv_n = mk_vartype "N" in fun translator (nubs,ges,gts) -> let sources = map (rand o rand o concl) nubs and rawdests = itlist (find_normedterms o lhand o concl) (ges @ gts) [] in if not (forall fst rawdests) then failwith "Sanity check" else let dests = setify (map snd rawdests) in let srcfuns = map vector_lincomb sources and destfuns = map vector_lincomb dests in let vvs = itlist (union o dom) (srcfuns @ destfuns) [] in let n = length srcfuns in let nvs = 1--n in let srccombs = zip srcfuns nvs in let consider d = let coefficients x = let inp = if defined d x then 0 |=> minus_num(apply d x) else undefined in itlist (fun (f,v) g -> if defined f x then (v |-> apply f x) g else g) srccombs inp in let equations = map coefficients vvs and inequalities = map (fun n -> (n |=> Int 1)) nvs in let plausiblevertices f = let flippedequations = map (itlist flip f) equations in let constraints = flippedequations @ inequalities in let rawverts = vertices nvs constraints in let check_solution v = let f = itlist2 (|->) nvs v (0 |=> Int 1) in forall (fun e -> evaluate f e =/ Int 0) flippedequations in let goodverts = filter check_solution rawverts in let signfixups = map (fun n -> if mem n f then -1 else 1) nvs in map (map2 (fun s c -> Int s */ c) signfixups) goodverts in let allverts = itlist (@) (map plausiblevertices (allsubsets nvs)) [] in subsume allverts [] in let compute_ineq v = let ths = mapfilter (fun (v,t) -> if v =/ Int 0 then fail() else NORM_CMUL_RULE v t) (zip v nubs) in INEQUALITY_CANON_RULE (end_itlist NORM_ADD_RULE ths) in let ges' = mapfilter compute_ineq (itlist ((@) o consider) destfuns []) @ map INEQUALITY_CANON_RULE nubs @ ges in let zerodests = filter (fun t -> dom(vector_lincomb t) = []) (map snd rawdests) in REAL_LINEAR_PROVER translator (map (fun t -> INST_TYPE [last(snd(dest_type(type_of t))),tv_n] pth_zero) zerodests, map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC LAND_CONV REAL_POLY_CONV)) ges', map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC LAND_CONV REAL_POLY_CONV)) gts) in let REAL_VECTOR_INEQ_PROVER = let pth = prove (`norm(x) = n ==> norm(x) >= &0 /\ n >= norm(x)`, DISCH_THEN(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[real_ge; NORM_POS_LE] THEN REAL_ARITH_TAC) in let NORM_MP = MATCH_MP pth in fun translator (ges,gts) -> let ntms = itlist find_normedterms (map (lhand o concl) (ges @ gts)) [] in let lctab = vector_lincombs (map snd (filter (not o fst) ntms)) in let asl = map (fun (t,_) -> ASSUME(mk_eq(mk_icomb(mk_const("vector_norm",[]),t), genvar `:real`))) lctab in let replace_conv = GEN_REWRITE_CONV TRY_CONV asl in let replace_rule = CONV_RULE (LAND_CONV (replacenegnorms replace_conv)) in let ges' = itlist (fun th ths -> CONJUNCT1(NORM_MP th)::ths) asl (map replace_rule ges) and gts' = map replace_rule gts and nubs = map (CONJUNCT2 o NORM_MP) asl in let th1 = REAL_VECTOR_COMBO_PROVER translator (nubs,ges',gts') in let th2 = INST (map (fun th -> let l,r = dest_eq(concl th) in (l,r)) asl) th1 in itlist PROVE_HYP (map (REFL o lhand o concl) asl) th2 in let REAL_VECTOR_PROVER = let rawrule = GEN_REWRITE_RULE I [REAL_ARITH `x = &0 <=> x >= &0 /\ --x >= &0`] in let splitequation th acc = let th1,th2 = CONJ_PAIR(rawrule th) in th1::CONV_RULE(LAND_CONV REAL_POLY_NEG_CONV) th2::acc in fun translator (eqs,ges,gts) -> REAL_VECTOR_INEQ_PROVER translator (itlist splitequation eqs ges,gts) in let pth = prove (`(!x y:real^N. x = y <=> norm(x - y) <= &0) /\ (!x y:real^N. ~(x = y) <=> ~(norm(x - y) <= &0))`, REWRITE_TAC[NORM_LE_0; VECTOR_SUB_EQ]) in let conv1 = GEN_REWRITE_CONV TRY_CONV [pth] in let conv2 tm = (conv1 tm,conv1(mk_neg tm)) in let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] THENC REAL_RAT_REDUCE_CONV THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [dist] THENC GEN_NNF_CONV true (conv1,conv2) and pure = GEN_REAL_ARITH REAL_VECTOR_PROVER in fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; let NORM_ARITH_TAC = CONV_TAC NORM_ARITH;; let ASM_NORM_ARITH_TAC = REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN NORM_ARITH_TAC;; (* ------------------------------------------------------------------------- *) (* There are no non-trivial homomorphisms R->R *) (* ------------------------------------------------------------------------- *) let HOMOMORPHISM_REAL_TO_REAL = prove (`!f:real->real. (!x y. f(x + y) = f x + f y) /\ (!x y. f(x * y) = f x * f y) <=> (f = \x. &0) \/ (f = \x. x)`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LZERO] THEN REWRITE_TAC[FUN_EQ_THM; TAUT `p \/ q <=> ~p ==> q`] THEN REWRITE_TAC[NOT_FORALL_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `(f:real->real)(&0) = &0` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_EQ_ADD_LCANCEL_0]; ALL_TAC] THEN SUBGOAL_THEN `(f:real->real)(&1) = &1` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_MUL_LID; REAL_RING `x = y * x <=> y = &1 \/ x = &0`]; FIRST_X_ASSUM(CHOOSE_THEN (K ALL_TAC))] THEN SUBGOAL_THEN `!x. (f:real->real)(--x) = --(f x)` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_ARITH `x:real = --y <=> x + y = &0`]; ALL_TAC] THEN SUBGOAL_THEN `!x y. (f:real->real)(x - y) = f x - f y` ASSUME_TAC THENL [ASM_REWRITE_TAC[real_sub]; ALL_TAC] THEN SUBGOAL_THEN `!x. (f:real->real) x = &0 <=> x = &0` ASSUME_TAC THENL [GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN ASM_CASES_TAC `x:real = &0` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(f:real->real)(inv x * x) = f(&1)` MP_TAC THENL [ASM_MESON_TAC[REAL_MUL_LINV]; ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `!x y. (f:real->real) x = f y <=> x = y` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_SUB_0]; ALL_TAC] THEN SUBGOAL_THEN `!x y. x <= y ==> (f:real->real) x <= f y` ASSUME_TAC THENL [REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM th]) THEN SPEC_TAC(`y - x:real`,`z:real`) THEN GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SQRT_POW2] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]; ALL_TAC] THEN SUBGOAL_THEN `!x y. (f:real->real) x <= f y <=> x <= y` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM]; ALL_TAC] THEN SUBGOAL_THEN `!x y. (f:real->real) x < f y <=> x < y` ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM REAL_NOT_LE]; ALL_TAC] THEN SUBGOAL_THEN `!n. (f:real->real)(&n) = &n` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD]; ALL_TAC] THEN SUBGOAL_THEN `!x. integer x ==> f x = x` ASSUME_TAC THENL [REWRITE_TAC[is_int] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x. rational x ==> f x = x` ASSUME_TAC THENL [REWRITE_TAC[rational; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real`; `x:real`; `y:real`] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> (z = x / y <=> y * z = x)`] THEN TRANS_TAC EQ_TRANS `(f:real->real) y * f(x / y)` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN ASM_SIMP_TAC[REAL_DIV_LMUL]; ALL_TAC] THEN X_GEN_TAC `x:real` THEN MATCH_MP_TAC(REAL_ARITH `~(x < y) /\ ~(y < x) ==> x:real = y`) THEN CONJ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `q:real` MP_TAC o MATCH_MP RATIONAL_BETWEEN) THEN ASM_MESON_TAC[REAL_LT_ANTISYM]);; (* ------------------------------------------------------------------------- *) (* Dot product in terms of the norm rather than conversely. *) (* ------------------------------------------------------------------------- *) let DOT_NORM = prove (`!x y. x dot y = (norm(x + y) pow 2 - norm(x) pow 2 - norm(y) pow 2) / &2`, REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_SYM] THEN REAL_ARITH_TAC);; let DOT_NORM_NEG = prove (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`, REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);; let DOT_NORM_SUB = prove (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`, REWRITE_TAC[NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Equality of vectors in terms of dot products. *) (* ------------------------------------------------------------------------- *) let VECTOR_EQ = prove (`!x y. (x = y) <=> (x dot x = x dot y) /\ (y dot y = x dot x)`, REPEAT GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DOT_EQ_0] THEN SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Hence more metric properties. *) (* ------------------------------------------------------------------------- *) let DIST_REFL = prove (`!x. dist(x,x) = &0`, NORM_ARITH_TAC);; let DIST_SYM = prove (`!x y. dist(x,y) = dist(y,x)`, NORM_ARITH_TAC);; let DIST_POS_LE = prove (`!x y. &0 <= dist(x,y)`, NORM_ARITH_TAC);; let REAL_ABS_DIST = prove (`!x y:real^N. abs(dist(x,y)) = dist(x,y)`, NORM_ARITH_TAC);; let DIST_TRIANGLE = prove (`!x:real^N y z. dist(x,z) <= dist(x,y) + dist(y,z)`, NORM_ARITH_TAC);; let DIST_TRIANGLE_ALT = prove (`!x y z. dist(y,z) <= dist(x,y) + dist(x,z)`, NORM_ARITH_TAC);; let DIST_EQ_0 = prove (`!x y. (dist(x,y) = &0) <=> (x = y)`, NORM_ARITH_TAC);; let DIST_POS_LT = prove (`!x y. ~(x = y) ==> &0 < dist(x,y)`, NORM_ARITH_TAC);; let DIST_NZ = prove (`!x y. ~(x = y) <=> &0 < dist(x,y)`, NORM_ARITH_TAC);; let DIST_TRIANGLE_LE = prove (`!x y z e. dist(x,z) + dist(y,z) <= e ==> dist(x,y) <= e`, NORM_ARITH_TAC);; let DIST_TRIANGLE_LT = prove (`!x y z e. dist(x,z) + dist(y,z) < e ==> dist(x,y) < e`, NORM_ARITH_TAC);; let DIST_TRIANGLE_HALF_L = prove (`!x1 x2 y. dist(x1,y) < e / &2 /\ dist(x2,y) < e / &2 ==> dist(x1,x2) < e`, NORM_ARITH_TAC);; let DIST_TRIANGLE_HALF_R = prove (`!x1 x2 y. dist(y,x1) < e / &2 /\ dist(y,x2) < e / &2 ==> dist(x1,x2) < e`, NORM_ARITH_TAC);; let DIST_TRIANGLE_ADD = prove (`!x x' y y'. dist(x + y,x' + y') <= dist(x,x') + dist(y,y')`, NORM_ARITH_TAC);; let DIST_MUL = prove (`!x y c. dist(c % x,c % y) = abs(c) * dist(x,y)`, REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL]);; let DIST_TRIANGLE_ADD_HALF = prove (`!x x' y y':real^N. dist(x,x') < e / &2 /\ dist(y,y') < e / &2 ==> dist(x + y,x' + y') < e`, NORM_ARITH_TAC);; let DIST_LE_0 = prove (`!x y. dist(x,y) <= &0 <=> x = y`, NORM_ARITH_TAC);; let DIST_EQ = prove (`!w x y z. dist(w,x) = dist(y,z) <=> dist(w,x) pow 2 = dist(y,z) pow 2`, REWRITE_TAC[dist; NORM_POW_2; NORM_EQ]);; let DIST_0 = prove (`!x. dist(x,vec 0) = norm(x) /\ dist(vec 0,x) = norm(x)`, NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Bounding distances between scaled versions of vectors. *) (* ------------------------------------------------------------------------- *) let DIST_RESCALE = prove (`!a x y:real^N. norm(x) = norm(y) ==> dist(a % x,y) = dist(x,a % y)`, SIMP_TAC[dist; NORM_EQ_SQUARE; NORM_POS_LE; NORM_POW_2] THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN CONV_TAC REAL_RING);; let DIST_DESCALE = prove (`!a b x y:real^N. &0 <= a /\ &0 <= b /\ norm(x) = norm(y) ==> dist(a % x,b % y) >= min a b * dist(x,y)`, MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_ARITH `min a b:real = min b a`]; ALL_TAC] THEN SIMP_TAC[real_min] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[dist; NORM_GE_SQUARE; REAL_POW_MUL; NORM_POW_2] THEN DISJ2_TAC THEN REWRITE_TAC[real_ge] THEN REWRITE_TAC[VECTOR_ARITH `(x - y:real^N) dot (x - y) = (x dot x + y dot y) - &2 * x dot y`] THEN ASM_REWRITE_TAC[GSYM NORM_POW_2; NORM_MUL; real_abs; REAL_ARITH `a pow 2 * ((y pow 2 + y pow 2) - &2 * d) <= ((a * y) pow 2 + (b * y) pow 2) - &2 * e <=> &2 * (e - a pow 2 * d) <= (b pow 2 - a pow 2) * y pow 2`] THEN REWRITE_TAC[DOT_LMUL] THEN REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[REAL_POW2_ABS; REAL_MUL_ASSOC; GSYM REAL_SUB_RDISTRIB] THEN MATCH_MP_TAC(REAL_ARITH `abs a <= b ==> a <= b`) THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN TRANS_TAC REAL_LE_TRANS `abs (&2 * (a * b - a pow 2)) * norm(x:real^N) * norm(y:real^N)` THEN SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS; NORM_CAUCHY_SCHWARZ_ABS] THEN ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN REWRITE_TAC[REAL_ARITH `(a * b - a pow 2):real = a * (b - a)`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_SUB_LE] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_ARITH `(b pow 2 - a pow 2):real = (a + b) * (b - a)`] THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Sums of vectors. *) (* ------------------------------------------------------------------------- *) let NEUTRAL_VECTOR_ADD = prove (`neutral(+) = vec 0:real^N`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[VECTOR_ARITH `x + y = y <=> x = vec 0`; VECTOR_ARITH `x + y = x <=> y = vec 0`]);; let MONOIDAL_VECTOR_ADD = prove (`monoidal((+):real^N->real^N->real^N)`, REWRITE_TAC[monoidal; NEUTRAL_VECTOR_ADD] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; let vsum = new_definition `(vsum:(A->bool)->(A->real^N)->real^N) s f = lambda i. sum s (\x. f(x)$i)`;; let VSUM_CLAUSES = prove (`(!f. vsum {} f = vec 0) /\ (!x f s. FINITE s ==> (vsum (x INSERT s) f = if x IN s then vsum s f else f(x) + vsum s f))`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CLAUSES] THEN SIMP_TAC[VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT]);; let VSUM = prove (`!f s. FINITE s ==> vsum s f = iterate (+) s f`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[VSUM_CLAUSES; ITERATE_CLAUSES; MONOIDAL_VECTOR_ADD] THEN REWRITE_TAC[NEUTRAL_VECTOR_ADD]);; let VSUM_EQ_0 = prove (`!f s. (!x:A. x IN s ==> (f(x) = vec 0)) ==> (vsum s f = vec 0)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; vec; SUM_EQ_0]);; let VSUM_0 = prove (`vsum s (\x. vec 0) = vec 0`, SIMP_TAC[VSUM_EQ_0]);; let VSUM_LMUL = prove (`!f c s. vsum s (\x. c % f(x)) = c % vsum s f`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_LMUL]);; let VSUM_RMUL = prove (`!c s v. vsum s (\x. c x % v) = (sum s c) % v`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_RMUL]);; let VSUM_ADD = prove (`!f g s. FINITE s ==> (vsum s (\x. f x + g x) = vsum s f + vsum s g)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_ADD]);; let VSUM_SUB = prove (`!f g s. FINITE s ==> (vsum s (\x. f x - g x) = vsum s f - vsum s g)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_SUB_COMPONENT; SUM_SUB]);; let VSUM_CONST = prove (`!c s. FINITE s ==> (vsum s (\n. c) = &(CARD s) % c)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_CONST; VECTOR_MUL_COMPONENT]);; let VSUM_COMPONENT = prove (`!s f i. 1 <= i /\ i <= dimindex(:N) ==> ((vsum s (f:A->real^N))$i = sum s (\x. f(x)$i))`, SIMP_TAC[vsum; LAMBDA_BETA]);; let VSUM_IMAGE = prove (`!f g s. FINITE s /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> (vsum (IMAGE f s) g = vsum s (g o f))`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN ASM_REWRITE_TAC[o_DEF]);; let VSUM_UNION = prove (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> (vsum (s UNION t) f = vsum s f + vsum t f)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_UNION; VECTOR_ADD_COMPONENT]);; let VSUM_DIFF = prove (`!f s t. FINITE s /\ t SUBSET s ==> (vsum (s DIFF t) f = vsum s f - vsum t f)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DIFF; VECTOR_SUB_COMPONENT]);; let VSUM_DELETE = prove (`!f s a. FINITE s /\ a IN s ==> vsum (s DELETE a) f = vsum s f - f a`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DELETE; VECTOR_SUB_COMPONENT]);; let VSUM_INCL_EXCL = prove (`!s t (f:A->real^N). FINITE s /\ FINITE t ==> vsum s f + vsum t f = vsum (s UNION t) f + vsum (s INTER t) f`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN SIMP_TAC[SUM_INCL_EXCL]);; let VSUM_NEG = prove (`!f s. vsum s (\x. --f x) = --vsum s f`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_NEG; VECTOR_NEG_COMPONENT]);; let VSUM_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (vsum s f = vsum s g)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]);; let VSUM_SUPERSET = prove (`!f:A->real^N u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0)) ==> (vsum v f = vsum u f)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_SUPERSET]);; let VSUM_SUPPORT = prove (`!f:A->real^N s. vsum {x | x IN s /\ ~(f x = vec 0)} f = vsum s f`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN SET_TAC[]);; let VSUM_UNIV = prove (`!f:A->real^N s. support (+) f (:A) SUBSET s ==> vsum s f = vsum (:A) f`, REWRITE_TAC[support; NEUTRAL_VECTOR_ADD] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VSUM_SUPPORT] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let VSUM_EQ_SUPERSET = prove (`!f s t:A->bool. FINITE t /\ t SUBSET s /\ (!x. x IN t ==> (f x = g x)) /\ (!x. x IN s /\ ~(x IN t) ==> f(x) = vec 0) ==> vsum s f = vsum t g`, MESON_TAC[VSUM_SUPERSET; VSUM_EQ]);; let VSUM_UNION_RZERO = prove (`!f:A->real^N u v. (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0)) ==> (vsum (u UNION v) f = vsum u f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM SET_TAC[]);; let VSUM_UNION_LZERO = prove (`!f:A->real^N u v. (!x. x IN u /\ ~(x IN v) ==> (f(x) = vec 0)) ==> (vsum (u UNION v) f = vsum v f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM SET_TAC[]);; let VSUM_RESTRICT = prove (`!f s. vsum s (\x. if x IN s then f(x) else vec 0) = vsum s f`, REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[]);; let VSUM_RESTRICT_SET = prove (`!P s f. vsum {x | x IN s /\ P x} f = vsum s (\x. if P x then f x else vec 0)`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_RESTRICT_SET; COND_COMPONENT]);; let VSUM_CASES = prove (`!s P f g. FINITE s ==> vsum s (\x:A. if P x then (f x):real^N else g x) = vsum {x | x IN s /\ P x} f + vsum {x | x IN s /\ ~P x} g`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CASES; COND_COMPONENT]);; let VSUM_SING = prove (`!f x. vsum {x} f = f(x)`, SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; VECTOR_ADD_RID]);; let VSUM_NORM = prove (`!f s. FINITE s ==> norm(vsum s f) <= sum s (\x. norm(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NORM_0; REAL_LE_REFL] THEN NORM_ARITH_TAC);; let VSUM_NORM_LE = prove (`!s f:A->real^N g. FINITE s /\ (!x. x IN s ==> norm(f x) <= g(x)) ==> norm(vsum s f) <= sum s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\x:A. norm(f x :real^N))` THEN ASM_SIMP_TAC[VSUM_NORM; SUM_LE]);; let VSUM_NORM_TRIANGLE = prove (`!s f b. FINITE s /\ sum s (\a. norm(f a)) <= b ==> norm(vsum s f) <= b`, MESON_TAC[VSUM_NORM; REAL_LE_TRANS]);; let VSUM_NORM_BOUND = prove (`!s f b. FINITE s /\ (!x:A. x IN s ==> norm(f(x)) <= b) ==> norm(vsum s f) <= &(CARD s) * b`, SIMP_TAC[GSYM SUM_CONST; VSUM_NORM_LE]);; let VSUM_CLAUSES_NUMSEG = prove (`(!m. vsum(m..0) f = if m = 0 then f(0) else vec 0) /\ (!m n. vsum(m..SUC n) f = if m <= SUC n then vsum(m..n) f + f(SUC n) else vsum(m..n) f)`, REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_SING; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_AC]);; let VSUM_CLAUSES_RIGHT = prove (`!f m n. 0 < n /\ m <= n ==> vsum(m..n) f = vsum(m..n-1) f + (f n):real^N`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[LT_REFL; VSUM_CLAUSES_NUMSEG; SUC_SUB1]);; let VSUM_CMUL_NUMSEG = prove (`!f c m n. vsum (m..n) (\x. c % f x) = c % vsum (m..n) f`, SIMP_TAC[VSUM_LMUL; FINITE_NUMSEG]);; let VSUM_EQ_NUMSEG = prove (`!f g m n. (!x. m <= x /\ x <= n ==> (f x = g x)) ==> (vsum(m .. n) f = vsum(m .. n) g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG]);; let VSUM_IMAGE_GEN = prove (`!f:A->B g s. FINITE s ==> (vsum s g = vsum (IMAGE f s) (\y. vsum {x | x IN s /\ (f(x) = y)} g))`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_IMAGE_GEN]);; let VSUM_GROUP = prove (`!f:A->B g s t. FINITE s /\ IMAGE f s SUBSET t ==> vsum t (\y. vsum {x | x IN s /\ f(x) = y} g) = vsum s g`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_GROUP]);; let VSUM_GROUP_RELATION = prove (`!R:A->B->bool g s t. FINITE s /\ (!x. x IN s ==> ?!y. y IN t /\ R x y) ==> vsum t (\y. vsum {x | x IN s /\ R x y} g) = vsum s g`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_GROUP_RELATION]);; let VSUM_VMUL = prove (`!f v s. (sum s f) % v = vsum s (\x. f(x) % v)`, REWRITE_TAC[VSUM_RMUL]);; let VSUM_DELTA = prove (`!s a. vsum s (\x. if x = a then b else vec 0) = if a IN s then b else vec 0`, SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN SIMP_TAC[VEC_COMPONENT; SUM_DELTA]);; let VSUM_ADD_NUMSEG = prove (`!f g m n. vsum(m..n) (\i. f i + g i) = vsum(m..n) f + vsum(m..n) g`, SIMP_TAC[VSUM_ADD; FINITE_NUMSEG]);; let VSUM_SUB_NUMSEG = prove (`!f g m n. vsum(m..n) (\i. f i - g i) = vsum(m..n) f - vsum(m..n) g`, SIMP_TAC[VSUM_SUB; FINITE_NUMSEG]);; let VSUM_ADD_SPLIT = prove (`!f m n p. m <= n + 1 ==> vsum(m..n + p) f = vsum(m..n) f + vsum(n + 1..n + p) f`, SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_ADD_COMPONENT; SUM_ADD_SPLIT]);; let VSUM_VSUM_PRODUCT = prove (`!s:A->bool t:A->B->bool x. FINITE s /\ (!i. i IN s ==> FINITE(t i)) ==> vsum s (\i. vsum (t i) (x i)) = vsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN SIMP_TAC[SUM_SUM_PRODUCT] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; let VSUM_IMAGE_NONZERO = prove (`!d:B->real^N i:A->B s. FINITE s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = vec 0) ==> vsum (IMAGE i s) d = vsum s (d o i)`, GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[IMAGE_CLAUSES; VSUM_CLAUSES; FINITE_IMAGE] THEN MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `vsum s ((d:B->real^N) o (i:A->B)) = vsum (IMAGE i s) d` SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[VECTOR_ARITH `a = x + a <=> x = vec 0`] THEN ASM_MESON_TAC[IN_IMAGE]);; let VSUM_UNION_NONZERO = prove (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = vec 0) ==> vsum (s UNION t) f = vsum s f + vsum t f`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN SIMP_TAC[VEC_COMPONENT; SUM_UNION_NONZERO]);; let VSUM_UNIONS_NONZERO = prove (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\ (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 ==> f x = vec 0) ==> vsum (UNIONS s) f = vsum s (\t. vsum t f)`, GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; VSUM_CLAUSES; IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN STRIP_TAC THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);; let VSUM_CLAUSES_LEFT = prove (`!f m n. m <= n ==> vsum(m..n) f = f m + vsum(m + 1..n) f`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN SIMP_TAC[VEC_COMPONENT; SUM_CLAUSES_LEFT]);; let VSUM_DIFFS = prove (`!m n. vsum(m..n) (\k. f(k) - f(k + 1)) = if m <= n then f(m) - f(n + 1) else vec 0`, GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE] THEN ASM_CASES_TAC `m = SUC n` THEN ASM_REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_LID] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM ADD1] THEN VECTOR_ARITH_TAC);; let VSUM_DIFFS_ALT = prove (`!m n. vsum(m..n) (\k. f(k + 1) - f(k)) = if m <= n then f(n + 1) - f(m) else vec 0`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN SIMP_TAC[VSUM_NEG; VSUM_DIFFS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]);; let VSUM_DELETE_CASES = prove (`!x f s. FINITE(s:A->bool) ==> vsum(s DELETE x) f = if x IN s then vsum s f - f x else vsum s f`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) th]) THEN ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN VECTOR_ARITH_TAC);; let VSUM_EQ_GENERAL = prove (`!s:A->bool t:B->bool (f:A->real^N) g h. (!y. y IN t ==> ?!x. x IN s /\ h x = y) /\ (!x. x IN s ==> h x IN t /\ g(h x) = f x) ==> vsum s f = vsum t g`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN EXISTS_TAC `h:A->B` THEN ASM_MESON_TAC[]);; let VSUM_EQ_GENERAL_INVERSES = prove (`!s t (f:A->real^N) (g:B->real^N) h k. (!y. y IN t ==> k y IN s /\ h (k y) = y) /\ (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x) ==> vsum s f = vsum t g`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN MAP_EVERY EXISTS_TAC [`h:A->B`; `k:B->A`] THEN ASM_MESON_TAC[]);; let VSUM_NORM_ALLSUBSETS_BOUND = prove (`!f:A->real^N p e. FINITE p /\ (!q. q SUBSET p ==> norm(vsum q f) <= e) ==> sum p (\x. norm(f x)) <= &2 * &(dimindex(:N)) * e`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum p (\x:A. sum (1..dimindex(:N)) (\i. abs((f x:real^N)$i)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[NORM_LE_L1]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o lhand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `&2 * &n * e = &n * &2 * e`] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {x:A | x IN p /\ &0 <= (f x:real^N)$k} (\x. abs((f x)$k)) + sum {x | x IN p /\ (f x)$k < &0} (\x. abs((f x)$k))` THEN CONJ_TAC THENL [MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= a`) THEN MATCH_MP_TAC SUM_UNION_EQ THEN ASM_SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `x:A` THEN ASM_CASES_TAC `(x:A) IN p` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x <= e /\ y <= e ==> x + y <= &2 * e`) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_ABS_NEG] THEN CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH `!g. sum s g = sum s f /\ sum s g <= e ==> sum s f <= e`) THENL [EXISTS_TAC `\x. ((f:A->real^N) x)$k`; EXISTS_TAC `\x. --(((f:A->real^N) x)$k)`] THEN (CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC]) THEN ASM_SIMP_TAC[GSYM VSUM_COMPONENT; SUM_NEG; FINITE_RESTRICT] THEN MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> x <= e`) THEN REWRITE_TAC[REAL_ABS_NEG] THEN MATCH_MP_TAC(REAL_ARITH `abs((vsum q f)$k) <= norm(vsum q f) /\ norm(vsum q f) <= e ==> abs((vsum q f)$k) <= e`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SET_TAC[]);; let DOT_LSUM = prove (`!s f y. FINITE s ==> (vsum s f) dot y = sum s (\x. f(x) dot y)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_LZERO; DOT_LADD]);; let DOT_RSUM = prove (`!s f x. FINITE s ==> x dot (vsum s f) = sum s (\y. x dot f(y))`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_RZERO; DOT_RADD]);; let VSUM_OFFSET = prove (`!p f m n. vsum(m + p..n + p) f = vsum(m..n) (\i. f (i + p))`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET]);; let VSUM_OFFSET_0 = prove (`!f m n. m <= n ==> vsum(m..n) f = vsum(0..n - m) (\i. f (i + m))`, SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET_0]);; let VSUM_TRIV_NUMSEG = prove (`!f m n. n < m ==> vsum(m..n) f = vec 0`, SIMP_TAC[GSYM NUMSEG_EMPTY; VSUM_CLAUSES]);; let VSUM_CONST_NUMSEG = prove (`!c m n. vsum(m..n) (\n. c) = &((n + 1) - m) % c`, SIMP_TAC[VSUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);; let VSUM_SUC = prove (`!f m n. vsum (SUC n..SUC m) f = vsum (n..m) (f o SUC)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `SUC n..SUC m = IMAGE SUC (n..m)` SUBST1_TAC THENL [REWRITE_TAC [ADD1; NUMSEG_OFFSET_IMAGE] THEN REWRITE_TAC [ONE; ADD_SUC; ADD_0; ETA_AX]; SIMP_TAC [VSUM_IMAGE; FINITE_NUMSEG; SUC_INJ]]);; let VSUM_BIJECTION = prove (`!f:A->real^N p s:A->bool. (!x. x IN s ==> p(x) IN s) /\ (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) ==> vsum s f = vsum s (f o p)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_GENERAL THEN EXISTS_TAC `p:A->A` THEN ASM_REWRITE_TAC[o_THM]);; let VSUM_PARTIAL_SUC = prove (`!f g:num->real^N m n. vsum (m..n) (\k. f(k) % (g(k + 1) - g(k))) = if m <= n then f(n + 1) % g(n + 1) - f(m) % g(m) - vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k + 1)) else vec 0`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL [VECTOR_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN VECTOR_ARITH_TAC);; let VSUM_PARTIAL_PRE = prove (`!f g:num->real^N m n. vsum (m..n) (\k. f(k) % (g(k) - g(k - 1))) = if m <= n then f(n + 1) % g(n) - f(m) % g(m - 1) - vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k)) else vec 0`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:num->real`; `\k. (g:num->real^N)(k - 1)`; `m:num`; `n:num`] VSUM_PARTIAL_SUC) THEN REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[]);; let VSUM_COMBINE_L = prove (`!f m n p. 0 < n /\ m <= n /\ n <= p + 1 ==> vsum(m..n - 1) f + vsum(n..p) f = vsum(m..p) f`, SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_L]);; let VSUM_COMBINE_R = prove (`!f m n p. m <= n + 1 /\ n <= p ==> vsum(m..n) f + vsum(n + 1..p) f = vsum(m..p) f`, SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_R]);; let VSUM_INJECTION = prove (`!f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> vsum s (f o p) = vsum s f`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_INJECTION) THEN SIMP_TAC[CART_EQ; VSUM_COMPONENT; o_DEF]);; let VSUM_SWAP = prove (`!f s t. FINITE s /\ FINITE t ==> vsum s (\i. vsum t (f i)) = vsum t (\j. vsum s (\i. f i j))`, SIMP_TAC[CART_EQ; VSUM_COMPONENT] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhs o snd) THEN ASM_REWRITE_TAC[]);; let VSUM_SWAP_NUMSEG = prove (`!a b c d f. vsum (a..b) (\i. vsum (c..d) (f i)) = vsum (c..d) (\j. vsum (a..b) (\i. f i j))`, REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);; let VSUM_ADD_GEN = prove (`!f g s. FINITE {x | x IN s /\ ~(f x = vec 0)} /\ FINITE {x | x IN s /\ ~(g x = vec 0)} ==> vsum s (\x. f x + g x) = vsum s f + vsum s g`, REPEAT GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[CART_EQ; vsum; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN REPEAT GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_ADD_GEN THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[VEC_COMPONENT]);; let VSUM_CASES_1 = prove (`!s a. FINITE s /\ a IN s ==> vsum s (\x. if x = a then y else f(x)) = vsum s f + (y - f a)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_CASES] THEN ASM_SIMP_TAC[GSYM DELETE; VSUM_DELETE] THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN REWRITE_TAC[VSUM_SING] THEN VECTOR_ARITH_TAC);; let VSUM_SING_NUMSEG = prove (`vsum(n..n) f = f n`, REWRITE_TAC[NUMSEG_SING; VSUM_SING]);; let VSUM_1 = prove (`vsum(1..1) f = f(1)`, REWRITE_TAC[VSUM_SING_NUMSEG]);; let VSUM_2 = prove (`!t. vsum(1..2) t = t(1) + t(2)`, REWRITE_TAC[num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; let VSUM_3 = prove (`!t. vsum(1..3) t = t(1) + t(2) + t(3)`, REWRITE_TAC[num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);; let VSUM_4 = prove (`!t. vsum(1..4) t = t(1) + t(2) + t(3) + t(4)`, SIMP_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);; let VSUM_PAIR = prove (`!f:num->real^N m n. vsum(2*m..2*n+1) f = vsum(m..n) (\i. f(2*i) + f(2*i+1))`, SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_ADD_COMPONENT; SUM_PAIR]);; let VSUM_PAIR_0 = prove (`!f:num->real^N n. vsum(0..2*n+1) f = vsum(0..n) (\i. f(2*i) + f(2*i+1))`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `0`; `n:num`] VSUM_PAIR) THEN ASM_REWRITE_TAC[ARITH]);; let VSUM_REFLECT = prove (`!x m n. vsum(m..n) x = if n < m then vec 0 else vsum(0..n-m) (\i. x(n - i))`, REPEAT GEN_TAC THEN SIMP_TAC[VSUM; FINITE_NUMSEG] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP ITERATE_REFLECT MONOIDAL_VECTOR_ADD] THEN REWRITE_TAC[NEUTRAL_VECTOR_ADD]);; (* ------------------------------------------------------------------------- *) (* Add useful congruences to the simplifier. *) (* ------------------------------------------------------------------------- *) let th = prove (`(!f g s. (!x. x IN s ==> f(x) = g(x)) ==> vsum s (\i. f(i)) = vsum s g) /\ (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) ==> vsum(a..b) (\i. f(i)) = vsum(a..b) g) /\ (!f g p. (!x. p x ==> f x = g x) ==> vsum {y | p y} (\i. f(i)) = vsum {y | p y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; (* ------------------------------------------------------------------------- *) (* A conversion for evaluation of `vsum(m..n) f` for numerals m and n. *) (* ------------------------------------------------------------------------- *) let EXPAND_VSUM_CONV = let [pth_0; pth_1; pth_2] = (CONJUNCTS o prove) (`(n < m ==> vsum(m..n) (f:num->real^N) = vec 0) /\ vsum(m..m) (f:num->real^N) = f m /\ (m <= n ==> vsum (m..n) (f:num->real^N) = f m + vsum (m + 1..n) f)`, REWRITE_TAC[VSUM_CLAUSES_LEFT; VSUM_SING_NUMSEG; VSUM_TRIV_NUMSEG]) and ns_tm = `..` and f_tm = `f:num->real^N` and m_tm = `m:num` and n_tm = `n:num` and n_ty = `:N` in let rec conv tm = let smn,ftm = dest_comb tm in let s,mn = dest_comb smn in if not(is_const s && fst(dest_const s) = "vsum") then failwith "EXPAND_VSUM_CONV" else let mtm,ntm = dest_binop ns_tm mn in let m = dest_numeral mtm and n = dest_numeral ntm in let nty = hd(tl(snd(dest_type(snd(dest_fun_ty(type_of ftm)))))) in let ilist = [nty,n_ty] in let ifn = inst ilist and tfn = INST_TYPE ilist in if n < m then let th1 = INST [ftm,ifn f_tm; mtm,m_tm; ntm,n_tm] (tfn pth_0) in MP th1 (EQT_ELIM(NUM_LT_CONV(lhand(concl th1)))) else if n = m then CONV_RULE (RAND_CONV(TRY_CONV BETA_CONV)) (INST [ftm,ifn f_tm; mtm,m_tm] (tfn pth_1)) else let th1 = INST [ftm,ifn f_tm; mtm,m_tm; ntm,n_tm] (tfn pth_2) in let th2 = MP th1 (EQT_ELIM(NUM_LE_CONV(lhand(concl th1)))) in CONV_RULE (RAND_CONV(COMB2_CONV (RAND_CONV(TRY_CONV BETA_CONV)) (LAND_CONV(LAND_CONV NUM_ADD_CONV) THENC conv))) th2 in conv;; (* ------------------------------------------------------------------------- *) (* Basis vectors in coordinate directions. *) (* ------------------------------------------------------------------------- *) let basis = new_definition `basis k = lambda i. if i = k then &1 else &0`;; let NORM_BASIS = prove (`!k. 1 <= k /\ k <= dimindex(:N) ==> (norm(basis k :real^N) = &1)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[basis; dot; vector_norm] THEN GEN_REWRITE_TAC RAND_CONV [GSYM SQRT_1] THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (1..dimindex(:N)) (\i. if i = k then &1 else &0)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG THEN ASM_SIMP_TAC[LAMBDA_BETA; IN_NUMSEG; EQ_SYM_EQ] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG]]);; let NORM_BASIS_1 = prove (`norm(basis 1) = &1`, SIMP_TAC[NORM_BASIS; ARITH_EQ; ARITH_RULE `1 <= k <=> ~(k = 0)`; DIMINDEX_NONZERO]);; let VECTOR_CHOOSE_SIZE = prove (`!c. &0 <= c ==> ?x:real^N. norm(x) = c`, REPEAT STRIP_TAC THEN EXISTS_TAC `c % basis 1 :real^N` THEN ASM_REWRITE_TAC[NORM_MUL; real_abs; NORM_BASIS_1; REAL_MUL_RID]);; let VECTOR_CHOOSE_DIST = prove (`!x e. &0 <= e ==> ?y:real^N. dist(x,y) = e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^N. norm(c) = e` CHOOSE_TAC THENL [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE]; ALL_TAC] THEN EXISTS_TAC `x - c:real^N` THEN REWRITE_TAC[dist] THEN ASM_REWRITE_TAC[VECTOR_ARITH `x - (x - c) = c:real^N`]);; let BASIS_INJ = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ (basis i :real^N = basis j) ==> (i = j)`, SIMP_TAC[basis; CART_EQ; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; ARITH_EQ]);; let BASIS_INJ_EQ = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (basis i:real^N = basis j <=> i = j)`, MESON_TAC[BASIS_INJ]);; let BASIS_NE = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> ~(basis i :real^N = basis j)`, MESON_TAC[BASIS_INJ]);; let BASIS_COMPONENT = prove (`!k i. 1 <= i /\ i <= dimindex(:N) ==> ((basis k :real^N)$i = if i = k then &1 else &0)`, SIMP_TAC[basis; LAMBDA_BETA] THEN MESON_TAC[]);; let BASIS_EXPANSION = prove (`!x:real^N. vsum(1..dimindex(:N)) (\i. x$i % basis i) = x`, SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_RID]);; let BASIS_EXPANSION_UNIQUE = prove (`!f x:real^N. (vsum(1..dimindex(:N)) (\i. f(i) % basis i) = x) <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> f(i) = x$i)`, SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN REPEAT GEN_TAC THEN REWRITE_TAC[COND_RAND; REAL_MUL_RZERO; REAL_MUL_RID] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG]);; let DOT_BASIS = prove (`!x:real^N i. 1 <= i /\ i <= dimindex(:N) ==> ((basis i) dot x = x$i) /\ (x dot (basis i) = x$i)`, SIMP_TAC[dot; basis; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID; REAL_MUL_RID]);; let DOT_BASIS_BASIS = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (basis i:real^N) dot (basis j) = if i = j then &1 else &0`, SIMP_TAC[DOT_BASIS; BASIS_COMPONENT]);; let DOT_BASIS_BASIS_UNEQUAL = prove (`!i j. ~(i = j) ==> (basis i) dot (basis j) = &0`, SIMP_TAC[basis; dot; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[SUM_0; REAL_MUL_RZERO; REAL_MUL_LZERO; COND_ID]);; let BASIS_EQ_0 = prove (`!i. (basis i :real^N = vec 0) <=> ~(i IN 1..dimindex(:N))`, SIMP_TAC[CART_EQ; BASIS_COMPONENT; VEC_COMPONENT; IN_NUMSEG] THEN MESON_TAC[REAL_ARITH `~(&1 = &0)`]);; let BASIS_NONZERO = prove (`!k. 1 <= k /\ k <= dimindex(:N) ==> ~(basis k :real^N = vec 0)`, REWRITE_TAC[BASIS_EQ_0; IN_NUMSEG]);; let VECTOR_EQ_LDOT = prove (`!y z. (!x. x dot y = x dot z) <=> y = z`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);; let VECTOR_EQ_RDOT = prove (`!x y. (!z. x dot z = y dot z) <=> x = y`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);; (* ------------------------------------------------------------------------- *) (* Orthogonality. *) (* ------------------------------------------------------------------------- *) let orthogonal = new_definition `orthogonal x y <=> (x dot y = &0)`;; let ORTHOGONAL_0 = prove (`!x. orthogonal (vec 0) x /\ orthogonal x (vec 0)`, REWRITE_TAC[orthogonal; DOT_LZERO; DOT_RZERO]);; let ORTHOGONAL_REFL = prove (`!x. orthogonal x x <=> x = vec 0`, REWRITE_TAC[orthogonal; DOT_EQ_0]);; let ORTHOGONAL_SYM = prove (`!x y. orthogonal x y <=> orthogonal y x`, REWRITE_TAC[orthogonal; DOT_SYM]);; let ORTHOGONAL_LNEG = prove (`!x y. orthogonal (--x) y <=> orthogonal x y`, REWRITE_TAC[orthogonal; DOT_LNEG; REAL_NEG_EQ_0]);; let ORTHOGONAL_RNEG = prove (`!x y. orthogonal x (--y) <=> orthogonal x y`, REWRITE_TAC[orthogonal; DOT_RNEG; REAL_NEG_EQ_0]);; let ORTHOGONAL_MUL = prove (`(!a x y:real^N. orthogonal (a % x) y <=> a = &0 \/ orthogonal x y) /\ (!a x y:real^N. orthogonal x (a % y) <=> a = &0 \/ orthogonal x y)`, REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE]);; let ORTHOGONAL_BASIS = prove (`!x:real^N i. 1 <= i /\ i <= dimindex(:N) ==> (orthogonal (basis i) x <=> (x$i = &0))`, REPEAT STRIP_TAC THEN SIMP_TAC[orthogonal; dot; basis; LAMBDA_BETA] THEN REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID]);; let ORTHOGONAL_BASIS_BASIS = prove (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (orthogonal (basis i :real^N) (basis j) <=> ~(i = j))`, ASM_SIMP_TAC[ORTHOGONAL_BASIS] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN MESON_TAC[REAL_ARITH `~(&1 = &0)`]);; let ORTHOGONAL_CLAUSES = prove (`(!a. orthogonal a (vec 0)) /\ (!a x c. orthogonal a x ==> orthogonal a (c % x)) /\ (!a x. orthogonal a x ==> orthogonal a (--x)) /\ (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x + y)) /\ (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x - y)) /\ (!a. orthogonal (vec 0) a) /\ (!a x c. orthogonal x a ==> orthogonal (c % x) a) /\ (!a x. orthogonal x a ==> orthogonal (--x) a) /\ (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x + y) a) /\ (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x - y) a)`, REWRITE_TAC[orthogonal; DOT_RNEG; DOT_RMUL; DOT_RADD; DOT_RSUB; DOT_LZERO; DOT_RZERO; DOT_LNEG; DOT_LMUL; DOT_LADD; DOT_LSUB] THEN SIMP_TAC[] THEN REAL_ARITH_TAC);; let ORTHOGONAL_RVSUM = prove (`!f:A->real^N s x. FINITE s /\ (!y. y IN s ==> orthogonal x (f y)) ==> orthogonal x (vsum s f)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);; let ORTHOGONAL_LVSUM = prove (`!f:A->real^N s y. FINITE s /\ (!x. x IN s ==> orthogonal (f x) y) ==> orthogonal (vsum s f) y`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);; let NORM_ADD_PYTHAGOREAN = prove (`!a b:real^N. orthogonal a b ==> norm(a + b) pow 2 = norm(a) pow 2 + norm(b) pow 2`, SIMP_TAC[NORM_POW_2; orthogonal; DOT_LADD; DOT_RADD; DOT_SYM] THEN REAL_ARITH_TAC);; let NORM_VSUM_PYTHAGOREAN = prove (`!k u:A->real^N. FINITE k /\ pairwise (\i j. orthogonal (u i) (u j)) k ==> norm(vsum k u) pow 2 = sum k (\i. norm(u i) pow 2)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[PAIRWISE_INSERT] THEN REWRITE_TAC[pairwise] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NORM_ADD_PYTHAGOREAN THEN MATCH_MP_TAC ORTHOGONAL_RVSUM THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Explicit vector construction from lists. *) (* ------------------------------------------------------------------------- *) let VECTOR_1 = prove (`(vector[x]:A^1)$1 = x`, SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_1; ARITH; LENGTH; EL; HD; TL]);; let VECTOR_2 = prove (`(vector[x;y]:A^2)$1 = x /\ (vector[x;y]:A^2)$2 = y`, SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_2; ARITH; LENGTH; EL] THEN REWRITE_TAC[num_CONV `1`; HD; TL; EL]);; let VECTOR_3 = prove (`(vector[x;y;z]:A^3)$1 = x /\ (vector[x;y;z]:A^3)$2 = y /\ (vector[x;y;z]:A^3)$3 = z`, SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; ARITH; LENGTH; EL] THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; HD; TL; EL]);; let VECTOR_4 = prove (`(vector[w;x;y;z]:A^4)$1 = w /\ (vector[w;x;y;z]:A^4)$2 = x /\ (vector[w;x;y;z]:A^4)$3 = y /\ (vector[w;x;y;z]:A^4)$4 = z`, SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_4; ARITH; LENGTH; EL] THEN REWRITE_TAC[num_CONV `3`; num_CONV `2`; num_CONV `1`; HD; TL; EL]);; let FORALL_VECTOR_1 = prove (`(!v:A^1. P v) <=> !x. P(vector[x])`, EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(v:A^1)$1`) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ; FORALL_1; VECTOR_1; DIMINDEX_1]);; let FORALL_VECTOR_2 = prove (`(!v:A^2. P v) <=> !x y. P(vector[x;y])`, EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(v:A^2)$1`; `(v:A^2)$2`]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ; FORALL_2; VECTOR_2; DIMINDEX_2]);; let FORALL_VECTOR_3 = prove (`(!v:A^3. P v) <=> !x y z. P(vector[x;y;z])`, EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(v:A^3)$1`; `(v:A^3)$2`; `(v:A^3)$3`]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ; FORALL_3; VECTOR_3; DIMINDEX_3]);; let FORALL_VECTOR_4 = prove (`(!v:A^4. P v) <=> !w x y z. P(vector[w;x;y;z])`, EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(v:A^4)$1`; `(v:A^4)$2`; `(v:A^4)$3`; `(v:A^4)$4`]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ; FORALL_4; VECTOR_4; DIMINDEX_4]);; let EXISTS_VECTOR_1 = prove (`(?v:A^1. P v) <=> ?x. P(vector[x])`, REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[FORALL_VECTOR_1]);; let EXISTS_VECTOR_2 = prove (`(?v:A^2. P v) <=> ?x y. P(vector[x;y])`, REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[FORALL_VECTOR_2]);; let EXISTS_VECTOR_3 = prove (`(?v:A^3. P v) <=> ?x y z. P(vector[x;y;z])`, REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[FORALL_VECTOR_3]);; let EXISTS_VECTOR_4 = prove (`(?v:A^4. P v) <=> ?w x y z. P(vector[w;x;y;z])`, REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[FORALL_VECTOR_4]);; let VECTOR_EXPAND_1 = prove (`!x:real^1. x = vector[x$1]`, SIMP_TAC[CART_EQ; DIMINDEX_1; FORALL_1; VECTOR_1]);; let VECTOR_EXPAND_2 = prove (`!x:real^2. x = vector[x$1;x$2]`, SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2]);; let VECTOR_EXPAND_3 = prove (`!x:real^3. x = vector[x$1;x$2;x$3]`, SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3]);; let VECTOR_EXPAND_4 = prove (`!x:real^4. x = vector[x$1;x$2;x$3;x$4]`, SIMP_TAC[CART_EQ; DIMINDEX_4; FORALL_4; VECTOR_4]);; (* ------------------------------------------------------------------------- *) (* Linear functions. *) (* ------------------------------------------------------------------------- *) let linear = new_definition `linear (f:real^M->real^N) <=> (!x y. f(x + y) = f(x) + f(y)) /\ (!c x. f(c % x) = c % f(x))`;; let LINEAR_COMPOSE_CMUL = prove (`!f c. linear f ==> linear (\x. c % f(x))`, SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let LINEAR_COMPOSE_NEG = prove (`!f. linear f ==> linear (\x. --(f(x)))`, SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let LINEAR_COMPOSE_NEG_EQ = prove (`!f:real^M->real^N. linear(\x. --(f x)) <=> linear f`, MATCH_MP_TAC(MESON[] `(!x. P x ==> P(f x)) /\ (!x. f(f x) = x) ==> (!x. P(f x) <=> P x)`) THEN REWRITE_TAC[LINEAR_COMPOSE_NEG; VECTOR_NEG_NEG; ETA_AX]);; let LINEAR_COMPOSE_ADD = prove (`!f g. linear f /\ linear g ==> linear (\x. f(x) + g(x))`, SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let LINEAR_COMPOSE_SUB = prove (`!f g. linear f /\ linear g ==> linear (\x. f(x) - g(x))`, SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let LINEAR_COMPOSE = prove (`!f g. linear f /\ linear g ==> linear (g o f)`, SIMP_TAC[linear; o_THM]);; let LINEAR_ID = prove (`linear (\x. x)`, REWRITE_TAC[linear]);; let LINEAR_I = prove (`linear I`, REWRITE_TAC[I_DEF; LINEAR_ID]);; let LINEAR_ZERO = prove (`linear (\x. vec 0)`, REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let LINEAR_NEGATION = prove (`linear(--)`, REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);; let LINEAR_COMPOSE_VSUM = prove (`!f s. FINITE s /\ (!a. a IN s ==> linear(f a)) ==> linear(\x. vsum s (\a. f a x))`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; LINEAR_ZERO] THEN ASM_SIMP_TAC[ETA_AX; IN_INSERT; LINEAR_COMPOSE_ADD]);; let LINEAR_VMUL_COMPONENT = prove (`!f:real^M->real^N v k. linear f /\ 1 <= k /\ k <= dimindex(:N) ==> linear (\x. f(x)$k % v)`, SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let LINEAR_0 = prove (`!f. linear f ==> (f(vec 0) = vec 0)`, MESON_TAC[VECTOR_MUL_LZERO; linear]);; let LINEAR_CMUL = prove (`!f c x. linear f ==> (f(c % x) = c % f(x))`, SIMP_TAC[linear]);; let LINEAR_NEG = prove (`!f x. linear f ==> (f(--x) = --(f x))`, ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[LINEAR_CMUL]);; let LINEAR_ADD = prove (`!f x y. linear f ==> (f(x + y) = f(x) + f(y))`, SIMP_TAC[linear]);; let LINEAR_SUB = prove (`!f x y. linear f ==> (f(x - y) = f(x) - f(y))`, SIMP_TAC[VECTOR_SUB; LINEAR_ADD; LINEAR_NEG]);; let LINEAR_VSUM = prove (`!f g s. linear f /\ FINITE s ==> (f(vsum s g) = vsum s (f o g))`, GEN_TAC THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES] THEN FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP LINEAR_0 th; MATCH_MP LINEAR_ADD th; o_THM]));; let LINEAR_VSUM_MUL = prove (`!f s c v. linear f /\ FINITE s ==> f(vsum s (\i. c i % v i)) = vsum s (\i. c(i) % f(v i))`, SIMP_TAC[LINEAR_VSUM; o_DEF; LINEAR_CMUL]);; let LINEAR_INJECTIVE_0 = prove (`!f. linear f ==> ((!x y. (f(x) = f(y)) ==> (x = y)) <=> (!x. (f(x) = vec 0) ==> (x = vec 0)))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN MESON_TAC[VECTOR_SUB_RZERO]);; let LINEAR_BOUNDED = prove (`!f:real^M->real^N. linear f ==> ?B. !x. norm(f x) <= B * norm(x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `sum(1..dimindex(:M)) (\i. norm((f:real^M->real^N)(basis i)))` THEN GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM BASIS_EXPANSION] THEN ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC VSUM_NORM_LE THEN SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; IN_NUMSEG] THEN ASM_SIMP_TAC[o_DEF; NORM_MUL; LINEAR_CMUL] THEN ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; COMPONENT_LE_NORM]);; let LINEAR_BOUNDED_POS = prove (`!f:real^M->real^N. linear f ==> ?B. &0 < B /\ !x. norm(f x) <= B * norm(x)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP LINEAR_BOUNDED) THEN EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC);; let SYMMETRIC_LINEAR_IMAGE = prove (`!f s. (!x. x IN s ==> --x IN s) /\ linear f ==> !x. x IN (IMAGE f s) ==> --x IN (IMAGE f s)`, REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[GSYM LINEAR_NEG] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Bilinear functions. *) (* ------------------------------------------------------------------------- *) let bilinear = new_definition `bilinear f <=> (!x. linear(\y. f x y)) /\ (!y. linear(\x. f x y))`;; let BILINEAR_SWAP = prove (`!op:real^M->real^N->real^P. bilinear(\x y. op y x) <=> bilinear op`, REWRITE_TAC[bilinear; ETA_AX] THEN MESON_TAC[]);; let BILINEAR_LADD = prove (`!h x y z. bilinear h ==> h (x + y) z = (h x z) + (h y z)`, SIMP_TAC[bilinear; linear]);; let BILINEAR_RADD = prove (`!h x y z. bilinear h ==> h x (y + z) = (h x y) + (h x z)`, SIMP_TAC[bilinear; linear]);; let BILINEAR_LMUL = prove (`!h c x y. bilinear h ==> h (c % x) y = c % (h x y)`, SIMP_TAC[bilinear; linear]);; let BILINEAR_RMUL = prove (`!h c x y. bilinear h ==> h x (c % y) = c % (h x y)`, SIMP_TAC[bilinear; linear]);; let BILINEAR_LNEG = prove (`!h x y. bilinear h ==> h (--x) y = --(h x y)`, ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_LMUL]);; let BILINEAR_RNEG = prove (`!h x y. bilinear h ==> h x (--y) = --(h x y)`, ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_RMUL]);; let BILINEAR_LZERO = prove (`!h x. bilinear h ==> h (vec 0) x = vec 0`, ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN SIMP_TAC[GSYM BILINEAR_LADD; VECTOR_ADD_LID]);; let BILINEAR_RZERO = prove (`!h x. bilinear h ==> h x (vec 0) = vec 0`, ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN SIMP_TAC[GSYM BILINEAR_RADD; VECTOR_ADD_LID]);; let BILINEAR_LSUB = prove (`!h x y z. bilinear h ==> h (x - y) z = (h x z) - (h y z)`, SIMP_TAC[VECTOR_SUB; BILINEAR_LNEG; BILINEAR_LADD]);; let BILINEAR_RSUB = prove (`!h x y z. bilinear h ==> h x (y - z) = (h x y) - (h x z)`, SIMP_TAC[VECTOR_SUB; BILINEAR_RNEG; BILINEAR_RADD]);; let BILINEAR_LSUM = prove (`!bop:real^M->real^N->real^P f s:A->bool y. bilinear bop /\ FINITE s ==> bop(vsum s f) y = vsum s (\i. bop (f i) y)`, REWRITE_TAC[bilinear] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:real^N`) THEN DISCH_THEN(MP_TAC o ISPECL [`f:A->real^M`; `s:A->bool`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] LINEAR_VSUM)) THEN ASM_REWRITE_TAC[o_DEF]);; let BILINEAR_RSUM = prove (`!bop:real^M->real^N->real^P f s:A->bool x. bilinear bop /\ FINITE s ==> bop x (vsum s f) = vsum s (\i. bop x (f i))`, REWRITE_TAC[bilinear] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^M`) THEN DISCH_THEN(MP_TAC o ISPECL [`f:A->real^N`; `s:A->bool`] o MATCH_MP (REWRITE_RULE[IMP_CONJ] LINEAR_VSUM)) THEN ASM_REWRITE_TAC[o_DEF]);; let BILINEAR_VSUM = prove (`!h:real^M->real^N->real^P. bilinear h /\ FINITE s /\ FINITE t ==> h (vsum s f) (vsum t g) = vsum (s CROSS t) (\(i,j). h (f i) (g j))`, REPEAT GEN_TAC THEN SIMP_TAC[bilinear; ETA_AX] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_VSUM o SPEC_ALL) THEN SIMP_TAC[] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; VSUM_VSUM_PRODUCT] THEN REWRITE_TAC[GSYM CROSS]);; let BILINEAR_BOUNDED = prove (`!h:real^M->real^N->real^P. bilinear h ==> ?B. !x y. norm(h x y) <= B * norm(x) * norm(y)`, REPEAT STRIP_TAC THEN EXISTS_TAC `sum ((1..dimindex(:M)) CROSS (1..dimindex(:N))) (\(i,j). norm((h:real^M->real^N->real^P) (basis i) (basis j)))` THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINOP_CONV) [GSYM BASIS_EXPANSION] THEN ASM_SIMP_TAC[BILINEAR_VSUM; FINITE_NUMSEG] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC VSUM_NORM_LE THEN SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; FORALL_PAIR_THM; IN_CROSS] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_LMUL; NORM_MUL] THEN ASM_SIMP_TAC[BILINEAR_RMUL; NORM_MUL; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_SIMP_TAC[COMPONENT_LE_NORM; REAL_ABS_POS; REAL_LE_MUL2]);; let BILINEAR_BOUNDED_POS = prove (`!h. bilinear h ==> ?B. &0 < B /\ !x y. norm(h x y) <= B * norm(x) * norm(y)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP BILINEAR_BOUNDED) THEN EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN REPEAT(MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]) THEN REAL_ARITH_TAC);; let BILINEAR_VSUM_PARTIAL_SUC = prove (`!f g h:real^M->real^N->real^P m n. bilinear h ==> vsum (m..n) (\k. h (f k) (g(k + 1) - g(k))) = if m <= n then h (f(n + 1)) (g(n + 1)) - h (f m) (g m) - vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k + 1))) else vec 0`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL [ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC);; let BILINEAR_VSUM_PARTIAL_PRE = prove (`!f g h:real^M->real^N->real^P m n. bilinear h ==> vsum (m..n) (\k. h (f k) (g(k) - g(k - 1))) = if m <= n then h (f(n + 1)) (g(n)) - h (f m) (g(m - 1)) - vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k))) else vec 0`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`f:num->real^M`; `\k. (g:num->real^N)(k - 1)`; `m:num`; `n:num`] o MATCH_MP BILINEAR_VSUM_PARTIAL_SUC) THEN REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[]);; let BILINEAR_VSUM_CONVOLUTION_1 = prove (`!bop:real^M->real^N->real^P a b n. bilinear bop ==> vsum(0..n) (\m. vsum (0..m) (\i. bop (a i) (b(m - i)))) = vsum(0..n) (\m. bop (a m) (vsum(0..n-m) b))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_RSUM; FINITE_NUMSEG] THEN SIMP_TAC[VSUM_VSUM_PRODUCT; FINITE_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN EXISTS_TAC `(\(x,y). y,x - y):num#num->num#num` THEN EXISTS_TAC `(\(x,y). x + y,x):num#num->num#num` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ; IN_NUMSEG; LE_0] THEN ARITH_TAC);; let BILINEAR_VSUM_CONVOLUTION_2 = prove (`!bop:real^M->real^N->real^P a b n. bilinear bop ==> vsum(0..n) (\m. vsum(0..m) (\k. vsum(0..k) (\i. bop (a i) (b(k-i))))) = vsum(0..n) (\m. bop (vsum(0..m) a) (vsum(0..n-m) b))`, REPEAT STRIP_TAC THEN ABBREV_TAC `summery:(num->real^P)->real^P = vsum(0..n)` THEN ASM_SIMP_TAC[BILINEAR_LSUM; FINITE_NUMSEG] THEN ASM_SIMP_TAC[BILINEAR_RSUM; FINITE_NUMSEG] THEN SIMP_TAC[VSUM_VSUM_PRODUCT; FINITE_NUMSEG] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[VSUM_VSUM_PRODUCT; FINITE_NUMSEG; FINITE_PRODUCT_DEPENDENT] THEN MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN EXISTS_TAC `(\(m,k,i). (n-m)+i,i,k - i):num#num#num->num#num#num` THEN EXISTS_TAC `(\(a,b,c). n-(a-b),b+c,b):num#num#num->num#num#num` THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_NUMSEG; LE_0; PAIR_EQ] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Adjoints. *) (* ------------------------------------------------------------------------- *) let adjoint = new_definition `adjoint(f:real^M->real^N) = @f'. !x y. f(x) dot y = x dot f'(y)`;; let ADJOINT_WORKS = prove (`!f:real^M->real^N. linear f ==> !x y. f(x) dot y = x dot (adjoint f)(y)`, GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[adjoint] THEN CONV_TAC SELECT_CONV THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `y:real^N` THEN EXISTS_TAC `(lambda i. (f:real^M->real^N) (basis i) dot y):real^M` THEN X_GEN_TAC `x:real^M` THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN SIMP_TAC[dot; LAMBDA_BETA; VSUM_COMPONENT; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN ASM_SIMP_TAC[o_THM; VECTOR_MUL_COMPONENT; LINEAR_CMUL; REAL_MUL_ASSOC]);; let ADJOINT_LINEAR = prove (`!f:real^M->real^N. linear f ==> linear(adjoint f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[linear; GSYM VECTOR_EQ_LDOT] THEN ASM_SIMP_TAC[DOT_RMUL; DOT_RADD; GSYM ADJOINT_WORKS]);; let ADJOINT_CLAUSES = prove (`!f:real^M->real^N. linear f ==> (!x y. x dot (adjoint f)(y) = f(x) dot y) /\ (!x y. (adjoint f)(y) dot x = y dot f(x))`, MESON_TAC[ADJOINT_WORKS; DOT_SYM]);; let ADJOINT_ADJOINT = prove (`!f:real^M->real^N. linear f ==> adjoint(adjoint f) = f`, SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_LDOT; ADJOINT_CLAUSES; ADJOINT_LINEAR]);; let ADJOINT_UNIQUE = prove (`!f f'. linear f /\ (!x y. f'(x) dot y = x dot f(y)) ==> f' = adjoint f`, SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_RDOT; ADJOINT_CLAUSES]);; let ADJOINT_COMPOSE = prove (`!f g:real^N->real^N. linear f /\ linear g ==> adjoint(f o g) = adjoint g o adjoint f`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN ASM_SIMP_TAC[LINEAR_COMPOSE; o_THM; ADJOINT_CLAUSES]);; let SELF_ADJOINT_COMPOSE = prove (`!f g:real^N->real^N. linear f /\ linear g /\ adjoint f = f /\ adjoint g = g ==> (adjoint(f o g) = f o g <=> f o g = g o f)`, SIMP_TAC[ADJOINT_COMPOSE] THEN MESON_TAC[]);; let SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS = prove (`!f:real^N->real^N v w a b. linear f /\ adjoint f = f /\ f v = a % v /\ f w = b % w /\ ~(a = b) ==> orthogonal v w`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`v:real^N`; `w:real^N`] o MATCH_MP ADJOINT_WORKS) THEN ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; orthogonal; REAL_EQ_MUL_RCANCEL]);; let ORTHOGONAL_PROJECTION_ALT = prove (`!f:real^N->real^N. linear f ==> ((!x y. orthogonal (f x - x) (f x - f y)) <=> (!x y. orthogonal (f x - x) (f y)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x - y:real^N`) THEN ASM_SIMP_TAC[LINEAR_SUB; VECTOR_ARITH `x - (x - y):real^N = y`]);; let ORTHOGONAL_PROJECTION_EQ_SELF_ADJOINT_IDEMPOTENT = prove (`!f:real^N->real^N. linear f ==> ((!x y. orthogonal (f x - x) (f x - f y)) <=> adjoint f = f /\ f o f = f)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_PROJECTION_ALT] THEN EQ_TAC THENL [REPEAT STRIP_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN FIRST_X_ASSUM(fun th -> MP_TAC(ISPECL [`x:real^N`; `y:real^N`] th) THEN MP_TAC(ISPECL [`y:real^N`; `x:real^N`] th)) THEN REWRITE_TAC[orthogonal; DOT_LSUB] THEN REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC; REWRITE_TAC[FUN_EQ_THM; o_THM] THEN X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(f:real^N->real^N) x`; `f x - x:real^N`]) THEN ASM_SIMP_TAC[LINEAR_SUB; ORTHOGONAL_REFL; VECTOR_SUB_EQ]]; REWRITE_TAC[FUN_EQ_THM; o_THM] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GSYM o MATCH_MP ADJOINT_WORKS) THEN ASM_SIMP_TAC[orthogonal; LINEAR_SUB; VECTOR_SUB_REFL; DOT_LZERO]]);; (* ------------------------------------------------------------------------- *) (* Some basics about Lipschitz functions. *) (* ------------------------------------------------------------------------- *) let LIPSCHITZ_ON_POS = prove (`!f:real^M->real^N s. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) <=> (?B. &0 < B /\ !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y))`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` (fun th -> EXISTS_TAC `abs B + &1` THEN MP_TAC th)) THEN REWRITE_TAC[REAL_ARITH `&0 < abs B + &1`] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC);; let LIPSCHITZ_POS = prove (`!f:real^M->real^N. (?B. !x y. norm(f x - f y) <= B * norm(x - y)) <=> (?B. &0 < B /\ !x y. norm(f x - f y) <= B * norm(x - y))`, GEN_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] LIPSCHITZ_ON_POS) THEN REWRITE_TAC[IN_UNIV]);; let LIPSCHITZ_ON_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s t. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) /\ (?B. !x y. x IN t /\ y IN t ==> norm(g x - g y) <= B * norm(x - y)) /\ IMAGE f s SUBSET t ==> ?B. !x y. x IN s /\ y IN s ==> norm(g(f x) - g(f y)) <= B * norm(x - y)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC; SUBSET; FORALL_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ONCE_REWRITE_TAC[LIPSCHITZ_ON_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN EXISTS_TAC `B * C:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `C * norm((f:real^M->real^N) x - f y)` THEN ASM_SIMP_TAC[REAL_ARITH `(B * C) * d:real = C * B * d`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ]);; let LINEAR_IMP_LIPSCHITZ = prove (`!f:real^M->real^N x y. linear f ==> ?B. !x y. norm(f x - f y) <= B * norm(x - y)`, SIMP_TAC[GSYM LINEAR_SUB] THEN MESON_TAC[LINEAR_BOUNDED]);; let LIPSCHITZ_ON_COMPONENTWISE = prove (`!f:real^M->real^N s. (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ?B. !x y. x IN s /\ y IN s ==> abs(f x$i - f y$i) <= B * norm(x - y)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN EQ_TAC THENL [MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:num->real` THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN DISCH_TAC THEN EXISTS_TAC `sum(1..dimindex(:N)) B` THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Matrix notation. NB: an MxN matrix is of type real^N^M, not real^M^N. *) (* We could define a special type if we're going to use them a lot. *) (* ------------------------------------------------------------------------- *) overload_interface ("--",`(matrix_neg):real^N^M->real^N^M`);; overload_interface ("+",`(matrix_add):real^N^M->real^N^M->real^N^M`);; overload_interface ("-",`(matrix_sub):real^N^M->real^N^M->real^N^M`);; make_overloadable "**" `:A->B->C`;; overload_interface ("**",`(vector_matrix_mul):real^M->real^N^M->real^N`);; overload_interface ("**",`(matrix_mul):real^N^M->real^P^N->real^P^M`);; overload_interface ("**",`(matrix_vector_mul):real^N^M->real^N->real^M`);; parse_as_infix("%%",(21,"right"));; prioritize_real();; let matrix_cmul = new_definition `((%%):real->real^N^M->real^N^M) c A = lambda i j. c * A$i$j`;; let matrix_neg = new_definition `!A:real^N^M. --A = lambda i j. --(A$i$j)`;; let matrix_add = new_definition `!A:real^N^M B:real^N^M. A + B = lambda i j. A$i$j + B$i$j`;; let matrix_sub = new_definition `!A:real^N^M B:real^N^M. A - B = lambda i j. A$i$j - B$i$j`;; let matrix_mul = new_definition `!A:real^N^M B:real^P^N. A ** B = lambda i j. sum(1..dimindex(:N)) (\k. A$i$k * B$k$j)`;; let matrix_vector_mul = new_definition `!A:real^N^M x:real^N. A ** x = lambda i. sum(1..dimindex(:N)) (\j. A$i$j * x$j)`;; let vector_matrix_mul = new_definition `!A:real^N^M x:real^M. x ** A = lambda j. sum(1..dimindex(:M)) (\i. A$i$j * x$i)`;; let mat = new_definition `(mat:num->real^N^M) k = lambda i j. if i = j then &k else &0`;; let transp = new_definition `(transp:real^N^M->real^M^N) A = lambda i j. A$j$i`;; let row = new_definition `(row:num->real^N^M->real^N) i A = lambda j. A$i$j`;; let column = new_definition `(column:num->real^N^M->real^M) j A = lambda i. A$i$j`;; let rows = new_definition `rows(A:real^N^M) = { row i A | 1 <= i /\ i <= dimindex(:M)}`;; let columns = new_definition `columns(A:real^N^M) = { column i A | 1 <= i /\ i <= dimindex(:N)}`;; let MATRIX_CMUL_COMPONENT = prove (`!c A:real^N^M i. (c %% A)$i$j = c * A$i$j`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_SIMP_TAC[matrix_cmul; CART_EQ; LAMBDA_BETA]);; let MATRIX_ADD_COMPONENT = prove (`!A B:real^N^M i j. (A + B)$i$j = A$i$j + B$i$j`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_SIMP_TAC[matrix_add; LAMBDA_BETA]);; let MATRIX_SUB_COMPONENT = prove (`!A B:real^N^M i j. (A - B)$i$j = A$i$j - B$i$j`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_SIMP_TAC[matrix_sub; LAMBDA_BETA]);; let MATRIX_NEG_COMPONENT = prove (`!A:real^N^M i j. (--A)$i$j = --(A$i$j)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_SIMP_TAC[matrix_neg; LAMBDA_BETA]);; let TRANSP_COMPONENT = prove (`!A:real^N^M i j. (transp A)$i$j = A$j$i`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ (!A:real^M^N. A$i = A$k) /\ (!z:real^N. z$i = z$k)` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:M) /\ (!A:real^N^M. A$j = A$l) /\ (!z:real^M. z$j = z$l)` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN ASM_SIMP_TAC[transp; LAMBDA_BETA]);; let MAT_COMPONENT = prove (`!n i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) ==> (mat n:real^N^M)$i$j = if i = j then &n else &0`, SIMP_TAC[mat; LAMBDA_BETA]);; let MAT_0_COMPONENT = prove (`!i j. (mat 0:real^N^M)$i$j = &0`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_SIMP_TAC[mat; COND_ID; LAMBDA_BETA]);; let MAT_CMUL = prove (`!a. mat a = &a %% mat 1`, SIMP_TAC[CART_EQ; MAT_COMPONENT; MATRIX_CMUL_COMPONENT] THEN MESON_TAC[REAL_MUL_RID; REAL_MUL_RZERO]);; let ROW_0 = prove (`!i. row i (mat 0:real^N^N) = vec 0`, SIMP_TAC[MAT_0_COMPONENT; CART_EQ; row; VEC_COMPONENT; LAMBDA_BETA]);; let COLUMN_0 = prove (`!i. column i (mat 0:real^N^N) = vec 0`, SIMP_TAC[MAT_0_COMPONENT; CART_EQ; column; VEC_COMPONENT; LAMBDA_BETA]);; let MATRIX_CMUL_ASSOC = prove (`!a b X:real^M^N. a %% (b %% X) = (a * b) %% X`, SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_ASSOC]);; let MATRIX_CMUL_LID = prove (`!X:real^M^N. &1 %% X = X`, SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_LID]);; let MATRIX_ADD_SYM = prove (`!A:real^N^M B. A + B = B + A`, SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);; let MATRIX_ADD_ASSOC = prove (`!A:real^N^M B C. A + (B + C) = (A + B) + C`, SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);; let MATRIX_ADD_LID = prove (`!A. mat 0 + A = A`, SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_LID]);; let MATRIX_ADD_RID = prove (`!A. A + mat 0 = A`, SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_RID]);; let MATRIX_ADD_LNEG = prove (`!A. --A + A = mat 0`, SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_LINV]);; let MATRIX_ADD_RNEG = prove (`!A. A + --A = mat 0`, SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_RINV]);; let MATRIX_SUB = prove (`!A:real^N^M B. A - B = A + --B`, SIMP_TAC[matrix_neg; matrix_add; matrix_sub; CART_EQ; LAMBDA_BETA; real_sub]);; let MATRIX_SUB_REFL = prove (`!A. A - A = mat 0`, REWRITE_TAC[MATRIX_SUB; MATRIX_ADD_RNEG]);; let MATRIX_SUB_EQ = prove (`!A B:real^N^M. A - B = mat 0 <=> A = B`, SIMP_TAC[CART_EQ; MAT_COMPONENT; MATRIX_SUB_COMPONENT; COND_ID; REAL_SUB_0]);; let MATRIX_SUB_ADD = prove (`!A B:real^N^M. (A - B) + B = A`, REWRITE_TAC[CART_EQ; MATRIX_ADD_COMPONENT; MATRIX_SUB_COMPONENT] THEN REAL_ARITH_TAC);; let MATRIX_SUB_ADD2 = prove (`!A B:real^N^M. A + (B - A) = B`, REWRITE_TAC[CART_EQ; MATRIX_ADD_COMPONENT; MATRIX_SUB_COMPONENT] THEN REAL_ARITH_TAC);; let MATRIX_ADD_LDISTRIB = prove (`!A:real^N^M B:real^P^N C. A ** (B + C) = A ** B + A ** C`, SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA; GSYM SUM_ADD_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN ASM_SIMP_TAC[LAMBDA_BETA; REAL_ADD_LDISTRIB]);; let MATRIX_MUL_LID = prove (`!A:real^N^M. mat 1 ** A = A`, REWRITE_TAC[matrix_mul; GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] (SPEC_ALL mat)] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);; let MATRIX_MUL_RID = prove (`!A:real^N^M. A ** mat 1 = A`, REWRITE_TAC[matrix_mul; mat] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID]);; let MATRIX_MUL_ASSOC = prove (`!A:real^N^M B:real^P^N C:real^Q^P. A ** B ** C = (A ** B) ** C`, REPEAT GEN_TAC THEN SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);; let MATRIX_MUL_LZERO = prove (`!A. (mat 0:real^N^M) ** (A:real^P^N) = mat 0`, SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO] THEN REWRITE_TAC[SUM_0]);; let MATRIX_MUL_RZERO = prove (`!A. (A:real^N^M) ** (mat 0:real^P^N) = mat 0`, SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO] THEN REWRITE_TAC[SUM_0]);; let MATRIX_ADD_RDISTRIB = prove (`!A:real^N^M B C:real^P^N. (A + B) ** C = A ** C + B ** C`, SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);; let MATRIX_SUB_LDISTRIB = prove (`!A:real^N^M B C:real^P^N. A ** (B - C) = A ** B - A ** C`, SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_SUB_LDISTRIB; SUM_SUB_NUMSEG]);; let MATRIX_SUB_RDISTRIB = prove (`!A:real^N^M B C:real^P^N. (A - B) ** C = A ** C - B ** C`, SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);; let MATRIX_MUL_LMUL = prove (`!A:real^N^M B:real^P^N c. (c %% A) ** B = c %% (A ** B)`, SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL]);; let MATRIX_MUL_RMUL = prove (`!A:real^N^M B:real^P^N c. A ** (c %% B) = c %% (A ** B)`, SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[REAL_ARITH `A * c * B:real = c * A * B`] THEN REWRITE_TAC[SUM_LMUL]);; let MATRIX_CMUL_ADD_LDISTRIB = prove (`!A:real^N^M B c. c %% (A + B) = c %% A + c %% B`, SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ADD_LDISTRIB]);; let MATRIX_CMUL_SUB_LDISTRIB = prove (`!A:real^N^M B c. c %% (A - B) = c %% A - c %% B`, SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_SUB_LDISTRIB]);; let MATRIX_CMUL_ADD_RDISTRIB = prove (`!A:real^N^M b c. (b + c) %% A = b %% A + c %% A`, SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ADD_RDISTRIB]);; let MATRIX_CMUL_SUB_RDISTRIB = prove (`!A:real^N^M b c. (b - c) %% A = b %% A - c %% A`, SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_SUB_RDISTRIB]);; let MATRIX_CMUL_RZERO = prove (`!c. c %% mat 0 = mat 0`, SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO]);; let MATRIX_CMUL_LZERO = prove (`!A. &0 %% A = mat 0`, SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO]);; let MATRIX_NEG_MINUS1 = prove (`!A:real^N^M. --A = --(&1) %% A`, REWRITE_TAC[matrix_cmul; matrix_neg; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1]);; let MATRIX_ADD_AC = prove (`(A:real^N^M) + B = B + A /\ (A + B) + C = A + (B + C) /\ A + (B + C) = B + (A + C)`, MESON_TAC[MATRIX_ADD_ASSOC; MATRIX_ADD_SYM]);; let MATRIX_NEG_ADD = prove (`!A B:real^N^M. --(A + B) = --A + --B`, SIMP_TAC[matrix_neg; matrix_add; CART_EQ; LAMBDA_BETA; REAL_NEG_ADD]);; let MATRIX_NEG_SUB = prove (`!A B:real^N^M. --(A - B) = B - A`, SIMP_TAC[matrix_neg; matrix_sub; CART_EQ; LAMBDA_BETA; REAL_NEG_SUB]);; let MATRIX_NEG_0 = prove (`--(mat 0) = mat 0`, SIMP_TAC[CART_EQ; mat; matrix_neg; LAMBDA_BETA; REAL_NEG_0; COND_ID]);; let MATRIX_SUB_RZERO = prove (`!A:real^N^M. A - mat 0 = A`, SIMP_TAC[CART_EQ; mat; matrix_sub; LAMBDA_BETA; REAL_SUB_RZERO; COND_ID]);; let MATRIX_SUB_LZERO = prove (`!A:real^N^M. mat 0 - A = --A`, SIMP_TAC[CART_EQ; mat; matrix_sub; matrix_neg; LAMBDA_BETA; REAL_SUB_LZERO; COND_ID]);; let MATRIX_NEG_EQ_0 = prove (`!A:real^N^M. --A = mat 0 <=> A = mat 0`, SIMP_TAC[CART_EQ; matrix_neg; mat; LAMBDA_BETA; REAL_NEG_EQ_0; COND_ID]);; let MATRIX_VECTOR_MUL_ASSOC = prove (`!A:real^N^M B:real^P^N x:real^P. A ** B ** x = (A ** B) ** x`, REPEAT GEN_TAC THEN SIMP_TAC[matrix_mul; matrix_vector_mul; CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);; let MATRIX_VECTOR_MUL_LID = prove (`!x:real^N. mat 1 ** x = x`, REWRITE_TAC[matrix_vector_mul; GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] (SPEC_ALL mat)] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);; let MATRIX_VECTOR_MUL_LZERO = prove (`!x:real^N. mat 0 ** x = vec 0`, SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO; SUM_0]);; let MATRIX_VECTOR_MUL_RZERO = prove (`!A:real^M^N. A ** vec 0 = vec 0`, SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO; SUM_0]);; let MATRIX_VECTOR_MUL_ADD_LDISTRIB = prove (`!A:real^M^N x:real^M y. A ** (x + y) = A ** x + A ** y`, SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_ADD_COMPONENT; LAMBDA_BETA; SUM_ADD_NUMSEG; REAL_ADD_LDISTRIB]);; let MATRIX_VECTOR_MUL_SUB_LDISTRIB = prove (`!A:real^M^N x:real^M y. A ** (x - y) = A ** x - A ** y`, SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_SUB_COMPONENT; LAMBDA_BETA; SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB]);; let MATRIX_VECTOR_MUL_ADD_RDISTRIB = prove (`!A:real^M^N B x:real^M. (A + B) ** x = (A ** x) + (B ** x)`, SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_add; LAMBDA_BETA; VECTOR_ADD_COMPONENT; REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);; let MATRIX_VECTOR_MUL_SUB_RDISTRIB = prove (`!A:real^M^N B x:real^M. (A - B) ** x = (A ** x) - (B ** x)`, SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_sub; LAMBDA_BETA; VECTOR_SUB_COMPONENT; REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);; let MATRIX_VECTOR_MUL_RMUL = prove (`!A:real^M^N x:real^M c. A ** (c % x) = c % (A ** x)`, SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; matrix_vector_mul; LAMBDA_BETA] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_AC]);; let MATRIX_MUL_LNEG = prove (`!A:real^N^M B:real^P^N. (--A) ** B = --(A ** B)`, REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_LMUL]);; let MATRIX_MUL_RNEG = prove (`!A:real^N^M B:real^P^N. A ** --B = --(A ** B)`, REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_RMUL]);; let MATRIX_NEG_NEG = prove (`!A:real^N^M. --(--A) = A`, SIMP_TAC[CART_EQ; MATRIX_NEG_COMPONENT; REAL_NEG_NEG]);; let MATRIX_TRANSP_MUL = prove (`!A B. transp(A ** B) = transp(B) ** transp(A)`, SIMP_TAC[matrix_mul; transp; CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[REAL_MUL_AC]);; let TRANSP_EQ_0 = prove (`!A:real^N^M. transp A = mat 0 <=> A = mat 0`, REWRITE_TAC[MAT_0_COMPONENT; CART_EQ; TRANSP_COMPONENT] THEN MESON_TAC[]);; let SYMMETRIC_MATRIX_MUL = prove (`!A B:real^N^N. transp(A) = A /\ transp(B) = B ==> (transp(A ** B) = A ** B <=> A ** B = B ** A)`, SIMP_TAC[MATRIX_TRANSP_MUL] THEN MESON_TAC[]);; let MATRIX_EQ = prove (`!A:real^N^M B. (A = B) = !x:real^N. A ** x = B ** x`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o GEN `i:num` o SPEC `(basis i):real^N`) THEN SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA; basis] THEN SIMP_TAC[SUM_DELTA; COND_RAND; REAL_MUL_RZERO] THEN REWRITE_TAC[TAUT `(if p then b else T) <=> p ==> b`] THEN SIMP_TAC[REAL_MUL_RID; IN_NUMSEG]);; let MATRIX_EQ_0 = prove (`!A:real^N^N. A = mat 0 <=> !x. A ** x = vec 0`, REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LZERO]);; let MATRIX_VECTOR_MUL_COMPONENT = prove (`!A:real^N^M x k. 1 <= k /\ k <= dimindex(:M) ==> ((A ** x)$k = (A$k) dot x)`, SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; dot]);; let DOT_LMUL_MATRIX = prove (`!A:real^N^M x:real^M y:real^N. (x ** A) dot y = x dot (A ** y)`, SIMP_TAC[dot; matrix_vector_mul; vector_matrix_mul; dot; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);; let TRANSP_MATRIX_CMUL = prove (`!A:real^M^N c. transp(c %% A) = c %% transp A`, SIMP_TAC[CART_EQ; transp; MATRIX_CMUL_COMPONENT; LAMBDA_BETA]);; let TRANSP_MATRIX_ADD = prove (`!A B:real^N^M. transp(A + B) = transp A + transp B`, SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_add]);; let TRANSP_MATRIX_SUB = prove (`!A B:real^N^M. transp(A - B) = transp A - transp B`, SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_sub]);; let TRANSP_MATRIX_NEG = prove (`!A:real^N^M. transp(--A) = --(transp A)`, SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_neg]);; let TRANSP_MAT = prove (`!n. transp(mat n) = mat n`, SIMP_TAC[transp; mat; LAMBDA_BETA; CART_EQ; EQ_SYM_EQ]);; let TRANSP_TRANSP = prove (`!A:real^N^M. transp(transp A) = A`, SIMP_TAC[CART_EQ; transp; LAMBDA_BETA]);; let SYMMETRIC_MATRIX_SIMILAR = prove (`!A B:real^N^N. transp B = B ==> transp(transp A ** B ** A) = transp A ** B ** A`, SIMP_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC]);; let TRANSP_EQ = prove (`!A B:real^M^N. transp A = transp B <=> A = B`, MESON_TAC[TRANSP_TRANSP]);; let ROW_TRANSP = prove (`!A:real^N^M i. 1 <= i /\ i <= dimindex(:N) ==> row i (transp A) = column i A`, SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);; let COLUMN_TRANSP = prove (`!A:real^N^M i. 1 <= i /\ i <= dimindex(:M) ==> column i (transp A) = row i A`, SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);; let ROWS_TRANSP = prove (`!A:real^N^M. rows(transp A) = columns A`, REWRITE_TAC[rows; columns; EXTENSION; IN_ELIM_THM] THEN MESON_TAC[ROW_TRANSP]);; let COLUMNS_TRANSP = prove (`!A:real^N^M. columns(transp A) = rows A`, MESON_TAC[TRANSP_TRANSP; ROWS_TRANSP]);; let VECTOR_MATRIX_MUL_TRANSP = prove (`!A:real^M^N x:real^N. x ** A = transp A ** x`, REWRITE_TAC[matrix_vector_mul; vector_matrix_mul; transp] THEN SIMP_TAC[LAMBDA_BETA; CART_EQ]);; let MATRIX_VECTOR_MUL_TRANSP = prove (`!A:real^M^N x:real^M. A ** x = x ** transp A`, REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP]);; let ROWS_NONEMPTY = prove (`!A:real^N^M. ~(rows A = {})`, REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY; GSYM numseg; NUMSEG_EMPTY] THEN REWRITE_TAC[NOT_LT; DIMINDEX_GE_1]);; let COLUMNS_NONEMPTY = prove (`!A:real^N^M. ~(columns A = {})`, REWRITE_TAC[columns] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY; GSYM numseg; NUMSEG_EMPTY] THEN REWRITE_TAC[NOT_LT; DIMINDEX_GE_1]);; let FINITE_ROWS = prove (`!A:real^N^M. FINITE(rows A)`, REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);; let FINITE_COLUMNS = prove (`!A:real^N^M. FINITE(columns A)`, REWRITE_TAC[columns] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);; let CARD_ROWS_LE = prove (`!A:real^M^N. CARD(rows A) <= dimindex(:N)`, GEN_TAC THEN REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM numseg] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[CARD_IMAGE_LE; FINITE_NUMSEG]);; let CARD_COLUMNS_LE = prove (`!A:real^M^N. CARD(columns A) <= dimindex(:M)`, GEN_TAC THEN REWRITE_TAC[columns] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM numseg] THEN GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[CARD_IMAGE_LE; FINITE_NUMSEG]);; let MATRIX_EQUAL_ROWS = prove (`!A B:real^N^M. A = B <=> !i. 1 <= i /\ i <= dimindex(:M) ==> row i A = row i B`, SIMP_TAC[row; CART_EQ; LAMBDA_BETA]);; let MATRIX_EQUAL_COLUMNS = prove (`!A B:real^N^M. A = B <=> !i. 1 <= i /\ i <= dimindex(:N) ==> column i A = column i B`, SIMP_TAC[column; CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]);; let MATRIX_CMUL_EQ_0 = prove (`!A:real^M^N c. c %% A = mat 0 <=> c = &0 \/ A = mat 0`, SIMP_TAC[CART_EQ; MATRIX_CMUL_COMPONENT; MAT_COMPONENT; COND_ID] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[REAL_ENTIRE]);; let MAT_EQ = prove (`!m n. mat m = mat n <=> m = n`, SIMP_TAC[CART_EQ; MAT_COMPONENT] THEN REPEAT STRIP_TAC THEN MESON_TAC[REAL_OF_NUM_EQ; DIMINDEX_GE_1; LE_REFL]);; let MATRIX_VECTOR_LMUL = prove (`!A:real^M^N c x:real^M. (c %% A) ** x = c % (A ** x)`, SIMP_TAC[matrix_cmul; CART_EQ; LAMBDA_BETA; matrix_vector_mul; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL]);; let MATRIX_VECTOR_MUL_LNEG = prove (`!A:real^M^N x:real^M. --A ** x = --(A ** x)`, REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_VECTOR_LMUL] THEN CONV_TAC VECTOR_ARITH);; let MATRIX_VECTOR_MUL_RNEG = prove (`!A:real^M^N x:real^M. A ** --x = --(A ** x)`, REWRITE_TAC[VECTOR_NEG_MINUS1; MATRIX_VECTOR_MUL_RMUL] THEN CONV_TAC VECTOR_ARITH);; let COLUMN_MATRIX_MUL = prove (`!A:real^N^M B:real^P^N. 1 <= i /\ i <= dimindex(:P) ==> column i (A ** B) = A ** column i B`, SIMP_TAC[column; matrix_mul; matrix_vector_mul; LAMBDA_BETA; CART_EQ]);; let ROW_MATRIX_MUL = prove (`!A:real^N^M B:real^P^N. 1 <= i /\ i <= dimindex(:M) ==> row i (A ** B) = transp B ** row i A`, SIMP_TAC[GSYM COLUMN_TRANSP] THEN SIMP_TAC[MATRIX_TRANSP_MUL; COLUMN_MATRIX_MUL]);; (* ------------------------------------------------------------------------- *) (* Two sometimes fruitful ways of looking at matrix-vector multiplication. *) (* ------------------------------------------------------------------------- *) let MATRIX_MUL_DOT = prove (`!A:real^N^M x. A ** x = lambda i. A$i dot x`, REWRITE_TAC[matrix_vector_mul; dot] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);; let MATRIX_MUL_VSUM = prove (`!A:real^N^M x. A ** x = vsum(1..dimindex(:N)) (\i. x$i % column i A)`, SIMP_TAC[matrix_vector_mul; CART_EQ; VSUM_COMPONENT; LAMBDA_BETA; VECTOR_MUL_COMPONENT; column; REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* Slightly gruesome lemmas: better to define sums over vectors really... *) (* ------------------------------------------------------------------------- *) let VECTOR_COMPONENTWISE = prove (`!x:real^N. x = lambda j. sum(1..dimindex(:N)) (\i. x$i * (basis i :real^N)$j)`, SIMP_TAC[CART_EQ; LAMBDA_BETA; basis] THEN ONCE_REWRITE_TAC[ARITH_RULE `(m:num = n) <=> (n = m)`] THEN SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN REWRITE_TAC[REAL_MUL_RID; COND_ID]);; let LINEAR_COMPONENTWISE_EXPANSION = prove (`!f:real^M->real^N. linear(f) ==> !x j. 1 <= j /\ j <= dimindex(:N) ==> (f x $j = sum(1..dimindex(:M)) (\i. x$i * f(basis i)$j))`, REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [VECTOR_COMPONENTWISE] THEN SPEC_TAC(`dimindex(:M)`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH] THENL [REWRITE_TAC[GSYM vec] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM VECTOR_MUL_LZERO] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[vec; LAMBDA_BETA]; REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN SIMP_TAC[GSYM VECTOR_MUL_COMPONENT; ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN SIMP_TAC[GSYM VECTOR_ADD_COMPONENT; ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN SIMP_TAC[VECTOR_MUL_COMPONENT]]);; (* ------------------------------------------------------------------------- *) (* Invertible matrices (not assumed square, but it's vacuous otherwise). *) (* ------------------------------------------------------------------------- *) let invertible = new_definition `invertible(A:real^N^M) <=> ?A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;; let INVERTIBLE_I = prove (`invertible(mat 1:real^N^N)`, REWRITE_TAC[invertible] THEN MESON_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID]);; let INVERTIBLE_NEG = prove (`!A:real^N^M. invertible(--A) <=> invertible A`, REWRITE_TAC[invertible] THEN MESON_TAC[MATRIX_MUL_LNEG; MATRIX_MUL_RNEG; MATRIX_NEG_NEG]);; let INVERTIBLE_CMUL = prove (`!A:real^N^M c. invertible(c %% A) <=> ~(c = &0) /\ invertible(A)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[invertible; MATRIX_MUL_LZERO; MATRIX_CMUL_LZERO; MAT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN REWRITE_TAC[invertible; MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `B:real^M^N` STRIP_ASSUME_TAC) THENL [EXISTS_TAC `c %% B:real^M^N`; EXISTS_TAC `inv c %% B:real^M^N`] THEN ASM_REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_RINV; MATRIX_CMUL_LID]);; let INVERTIBLE_MAT = prove (`!a. invertible(mat a:real^N^N) <=> ~(a = 0)`, ONCE_REWRITE_TAC[MAT_CMUL] THEN REWRITE_TAC[INVERTIBLE_CMUL; INVERTIBLE_I; REAL_OF_NUM_EQ]);; let MATRIX_ENTIRE = prove (`(!A:real^N^M B:real^P^N. invertible A ==> (A ** B = mat 0 <=> B = mat 0)) /\ (!A:real^N^M B:real^P^N. invertible B ==> (A ** B = mat 0 <=> A = mat 0))`, REWRITE_TAC[invertible] THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `A':real^M^N` STRIP_ASSUME_TAC); DISCH_THEN(X_CHOOSE_THEN `B':real^N^P` STRIP_ASSUME_TAC)] THEN EQ_TAC THEN SIMP_TAC[MATRIX_MUL_LZERO; MATRIX_MUL_RZERO] THENL [DISCH_THEN(MP_TAC o AP_TERM `(**) A':real^P^M->real^P^N`) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RZERO]; DISCH_THEN(MP_TAC o AP_TERM `\C:real^P^M. C ** (B':real^N^P)`) THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID; MATRIX_MUL_LZERO]]);; (* ------------------------------------------------------------------------- *) (* Correspondence between matrices and linear operators. *) (* ------------------------------------------------------------------------- *) let matrix = new_definition `(matrix:(real^M->real^N)->real^M^N) f = lambda i j. f(basis j)$i`;; let MATRIX_COMPONENT = prove (`!f:real^M->real^N i j. 1 <= j /\ j <= dimindex(:M) ==> (matrix f)$i$j = f (basis j)$i`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ (!A:real^M^N. A$i = A$k) /\ (!z:real^N. z$i = z$k)` STRIP_ASSUME_TAC THENL [REWRITE_TAC[finite_index] THEN MESON_TAC[FINITE_INDEX_WORKS]; ASM_SIMP_TAC[matrix; LAMBDA_BETA]]);; let MATRIX_VECTOR_MUL_LINEAR = prove (`!A:real^N^M. linear(\x. A ** x)`, REWRITE_TAC[linear; matrix_vector_mul] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL; REAL_ADD_LDISTRIB] THEN REWRITE_TAC[REAL_ADD_AC; REAL_MUL_AC]);; let MATRIX_WORKS = prove (`!f:real^M->real^N. linear f ==> !x. matrix f ** x = f(x)`, REWRITE_TAC[matrix; matrix_vector_mul] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM LINEAR_COMPONENTWISE_EXPANSION]);; let MATRIX_VECTOR_MUL = prove (`!f:real^M->real^N. linear f ==> f = \x. matrix f ** x`, SIMP_TAC[FUN_EQ_THM; MATRIX_WORKS]);; let MATRIX_OF_MATRIX_VECTOR_MUL = prove (`!A:real^N^M. matrix(\x. A ** x) = A`, SIMP_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LINEAR; MATRIX_WORKS]);; let MATRIX_COMPOSE = prove (`!f g. linear f /\ linear g ==> (matrix(g o f) = matrix g ** matrix f)`, SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_COMPOSE; GSYM MATRIX_VECTOR_MUL_ASSOC; o_THM]);; let MATRIX_0 = prove (`matrix(\x. vec 0):real^M^N = mat 0`, SIMP_TAC[matrix; CART_EQ; MAT_COMPONENT; LAMBDA_BETA; COND_ID; VEC_COMPONENT]);; let MATRIX_VECTOR_COLUMN = prove (`!A:real^N^M x. A ** x = vsum(1..dimindex(:N)) (\i. x$i % (transp A)$i)`, REWRITE_TAC[matrix_vector_mul; transp] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_MUL_COMPONENT] THEN REWRITE_TAC[REAL_MUL_AC]);; let MATRIX_MUL_COMPONENT = prove (`!i. 1 <= i /\ i <= dimindex(:P) ==> ((A:real^N^P) ** (B:real^M^N))$i = transp B ** A$i`, SIMP_TAC[matrix_mul; LAMBDA_BETA; matrix_vector_mul; vector_matrix_mul; transp; CART_EQ] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[REAL_MUL_AC]);; let ADJOINT_MATRIX = prove (`!A:real^N^M. adjoint(\x. A ** x) = (\x. transp A ** x)`, GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN REPEAT GEN_TAC THEN SIMP_TAC[transp; dot; LAMBDA_BETA; matrix_vector_mul; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN GEN_REWRITE_TAC LAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);; let MATRIX_ADJOINT = prove (`!f. linear f ==> matrix(adjoint f) = transp(matrix f)`, GEN_TAC THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [MATCH_MP MATRIX_VECTOR_MUL th]) THEN REWRITE_TAC[ADJOINT_MATRIX; MATRIX_OF_MATRIX_VECTOR_MUL]);; let MATRIX_ID = prove (`matrix(\x. x) = mat 1`, SIMP_TAC[MATRIX_EQ; LINEAR_ID; MATRIX_WORKS; MATRIX_VECTOR_MUL_LID]);; let MATRIX_I = prove (`matrix I = mat 1`, REWRITE_TAC[I_DEF; MATRIX_ID]);; let LINEAR_EQ_MATRIX = prove (`!f g. linear f /\ linear g /\ matrix f = matrix g ==> f = g`, REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MATRIX_VECTOR_MUL)) THEN ASM_REWRITE_TAC[]);; let MATRIX_CMUL = prove (`!f:real^M->real^N c. linear f ==> matrix(\x. c % f x) = c %% matrix f`, SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_COMPOSE_CMUL; MATRIX_VECTOR_LMUL]);; let MATRIX_NEG = prove (`!f:real^M->real^N. linear f ==> matrix(\x. --(f x)) = --(matrix f)`, SIMP_TAC[GSYM MATRIX_NEG_MINUS1; VECTOR_NEG_MINUS1; MATRIX_CMUL]);; let MATRIX_ADD = prove (`!f g:real^M->real^N. linear f /\ linear g ==> matrix(\x. f x + g x) = matrix f + matrix g`, REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_ADD_RDISTRIB] THEN SIMP_TAC[MATRIX_WORKS; LINEAR_COMPOSE_ADD]);; let MATRIX_SELF_ADJOINT = prove (`!f. linear f ==> (adjoint f = f <=> transp(matrix f) = matrix f)`, SIMP_TAC[GSYM MATRIX_ADJOINT] THEN MESON_TAC[LINEAR_EQ_MATRIX; ADJOINT_LINEAR]);; let LINEAR_MATRIX_EXISTS = prove (`!f:real^M->real^N. linear f <=> ?A:real^M^N. f = \x. A ** x`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN EXISTS_TAC `matrix(f:real^M->real^N)` THEN ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL]);; let LINEAR_1_GEN = prove (`!f:real^N->real^N. dimindex(:N) = 1 ==> (linear f <=> ?c. f = \x. c % x)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID] THEN ASM_SIMP_TAC[FUN_EQ_THM; CART_EQ; FORALL_1] THEN EXISTS_TAC `(f:real^N->real^N)(basis 1)$1` THEN REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM VECTOR_MUL_COMPONENT] THEN X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [linear]) THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; FORALL_1; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; ARITH; REAL_MUL_RID]);; let LINEAR_1 = prove (`!f:real^1->real^1. linear f <=> ?c. f = \x. c % x`, SIMP_TAC[LINEAR_1_GEN; DIMINDEX_1]);; let SYMMETRIC_MATRIX = prove (`!A:real^N^N. transp A = A <=> adjoint(\x. A ** x) = \x. A ** x`, SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR] THEN REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL]);; let DOT_MATRIX_TRANSP_LMUL = prove (`!A x y:real^N. (transp A ** x) dot y = x dot (A ** y)`, REWRITE_TAC[REWRITE_RULE[FUN_EQ_THM] (GSYM ADJOINT_MATRIX)] THEN SIMP_TAC[ADJOINT_CLAUSES; MATRIX_VECTOR_MUL_LINEAR]);; let DOT_MATRIX_TRANSP_RMUL = prove (`!A x y:real^N. x dot (transp A ** y) = (A ** x) dot y`, ONCE_REWRITE_TAC[DOT_SYM] THEN REWRITE_TAC[DOT_MATRIX_TRANSP_LMUL]);; let SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS = prove (`!A:real^N^N v w a b. transp A = A /\ A ** v = a % v /\ A ** w = b % w /\ ~(a = b) ==> orthogonal v w`, REPEAT GEN_TAC THEN REWRITE_TAC[SYMMETRIC_MATRIX] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS)) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; let MATRIX_INJECTIVE_0 = prove (`!m:real^M^N. (!x y:real^M. m ** x = m ** y ==> x = y) <=> (!x:real^M. m ** x = vec 0 ==> x = vec 0)`, GEN_TAC THEN MATCH_MP_TAC LINEAR_INJECTIVE_0 THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; (* ------------------------------------------------------------------------- *) (* Operator norm. *) (* ------------------------------------------------------------------------- *) let onorm = new_definition `onorm (f:real^M->real^N) = sup { norm(f x) | norm(x) = &1 }`;; let NORM_BOUND_GENERALIZE = prove (`!f:real^M->real^N b. linear f ==> ((!x. norm(x) = &1 ==> norm(f x) <= b) <=> (!x. norm(f x) <= b * norm(x)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_MUL_RID]] THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `x:real^M = vec 0` THENL [ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN ASM_MESON_TAC[LINEAR_0; NORM_0; REAL_LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; real_div] THEN MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c ==> b * a <= c`) THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_MUL] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]);; let ONORM_DOT = prove (`!f:real^M->real^N. onorm f = sup {f x dot y | norm x = &1 /\ norm y = &1}`, REPEAT STRIP_TAC THEN REWRITE_TAC[onorm] THEN MATCH_MP_TAC SUP_EQ THEN X_GEN_TAC `b:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN EQ_TAC THEN DISCH_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN TRANS_TAC REAL_LE_TRANS `norm((f:real^M->real^N) x) * norm(y:real^N)` THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ] THEN ASM_SIMP_TAC[REAL_MUL_RID]; FIRST_ASSUM(fun th -> MP_TAC(ISPECL [`basis 1:real^M`; `--basis 1:real^N`] th) THEN MP_TAC(ISPECL [`basis 1:real^M`; `basis 1:real^N`] th)) THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; NORM_NEG] THEN REWRITE_TAC[DOT_RNEG; IMP_IMP] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (REAL_ARITH `x <= b /\ --x <= b ==> &0 <= b`)) THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `(f:real^M->real^N) x = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `inv(norm((f:real^M->real^N) x)) % f x`]) THEN ASM_REWRITE_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; GSYM NORM_POW_2; REAL_FIELD `~(x = &0) ==> inv x * x pow 2 = x`]]);; let ONORM = prove (`!f:real^M->real^N. linear f ==> (!x. norm(f x) <= onorm f * norm(x)) /\ (!b. (!x. norm(f x) <= b * norm(x)) ==> onorm f <= b)`, GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `{ norm((f:real^M->real^N) x) | norm(x) = &1 }` SUP) THEN SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN ASM_SIMP_TAC[NORM_BOUND_GENERALIZE; GSYM onorm; GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; LINEAR_BOUNDED; REAL_POS]);; let ONORM_LE_EQ = prove (`!f:real^M->real^N b. linear f ==> (onorm f <= b <=> !x. norm(f x) <= b * norm x)`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [TRANS_TAC REAL_LE_TRANS `onorm(f:real^M->real^N) * norm(x:real^M)` THEN ASM_SIMP_TAC[ONORM; REAL_LE_RMUL; NORM_POS_LE]; ASM_MESON_TAC[ONORM]]);; let ONORM_POS_LE = prove (`!f. linear f ==> &0 <= onorm f`, MESON_TAC[ONORM; VECTOR_CHOOSE_SIZE; REAL_POS; REAL_MUL_RID; NORM_POS_LE; REAL_LE_TRANS]);; let ONORM_EQ_0 = prove (`!f:real^M->real^N. linear f ==> ((onorm f = &0) <=> (!x. f x = vec 0))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `f:real^M->real^N` ONORM) THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; ONORM_POS_LE; NORM_0; REAL_MUL_LZERO; NORM_LE_0; REAL_LE_REFL]);; let ONORM_CONST = prove (`!y:real^N. onorm(\x:real^M. y) = norm(y)`, GEN_TAC THEN REWRITE_TAC[onorm] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sup {norm(y:real^N)}` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(?x. P x) ==> {f y | x | P x} = {f y}`) THEN EXISTS_TAC `basis 1 :real^M` THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; MATCH_MP_TAC REAL_SUP_UNIQUE THEN SET_TAC[REAL_LE_REFL]]);; let ONORM_POS_LT = prove (`!f. linear f ==> (&0 < onorm f <=> ~(!x. f x = vec 0))`, SIMP_TAC[GSYM ONORM_EQ_0; ONORM_POS_LE; REAL_ARITH `(&0 < x <=> ~(x = &0)) <=> &0 <= x`]);; let ONORM_COMPOSE = prove (`!f g. linear f /\ linear g ==> onorm(f o g) <= onorm f * onorm g`, MESON_TAC[ONORM; LINEAR_COMPOSE; o_THM; REAL_MUL_ASSOC; REAL_LE_TRANS; ONORM; REAL_LE_LMUL; ONORM_POS_LE]);; let ONORM_CMUL = prove (`!f:real^M->real^N c. linear f ==> onorm(\x. c % f x) = abs c * onorm f`, SUBGOAL_THEN `!f:real^M->real^N c. linear f ==> onorm(\x. c % f x) <= abs c * onorm f` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ONORM_LE_EQ; LINEAR_COMPOSE_CMUL] THEN GEN_TAC THEN REWRITE_TAC[NORM_MUL; GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_ABS_POS; ONORM]; REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[REAL_ABS_NUM; REAL_MUL_LZERO; ONORM_POS_LE; LINEAR_COMPOSE_CMUL] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\x. c % (f:real^M->real^N) x`; `inv c:real`]) THEN ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN REWRITE_TAC[REAL_ABS_INV; VECTOR_MUL_LID; ETA_AX] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ]]);; let ONORM_NEG = prove (`!f:real^M->real^N. onorm(\x. --f x) = onorm f`, REWRITE_TAC[onorm; NORM_NEG]);; let ONORM_TRIANGLE = prove (`!f:real^M->real^N g. linear f /\ linear g ==> onorm(\x. f x + g x) <= onorm f + onorm g`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o MATCH_MP ONORM o MATCH_MP LINEAR_COMPOSE_ADD) THEN REWRITE_TAC[REAL_ADD_RDISTRIB] THEN ASM_MESON_TAC[REAL_LE_ADD2; REAL_LE_TRANS; NORM_TRIANGLE; ONORM]);; let ONORM_TRIANGLE_LE = prove (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) <= e ==> onorm(\x. f x + g x) <= e`, MESON_TAC[REAL_LE_TRANS; ONORM_TRIANGLE]);; let ONORM_TRIANGLE_LT = prove (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) < e ==> onorm(\x. f x + g x) < e`, MESON_TAC[REAL_LET_TRANS; ONORM_TRIANGLE]);; let ONORM_ID = prove (`onorm(\x:real^N. x) = &1`, REWRITE_TAC[onorm] THEN SUBGOAL_THEN `{norm(x:real^N) | norm x = &1} = {&1}` (fun th -> REWRITE_TAC[th; SUP_SING]) THEN SUBGOAL_THEN `norm(basis 1:real^N) = &1` MP_TAC THENL [SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; SET_TAC[]]);; let ONORM_I = prove (`onorm(I:real^N->real^N) = &1`, REWRITE_TAC[I_DEF; ONORM_ID]);; let ONORM_INVERSE_FUNCTION_BOUND = prove (`!f g:real^M->real^N. linear f /\ linear g /\ f o g = I ==> &1 <= onorm f * onorm g`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `onorm:(real^M->real^M)->real`) THEN REWRITE_TAC[ONORM_I] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC ONORM_COMPOSE THEN ASM_REWRITE_TAC[]);; let ONORM_ADJOINT = prove (`!f:real^N->real^N. linear f ==> onorm(adjoint f) = onorm f`, REPEAT STRIP_TAC THEN REWRITE_TAC[ONORM_DOT] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [DOT_SYM] THEN ASM_SIMP_TAC[GSYM ADJOINT_WORKS] THEN AP_TERM_TAC THEN SET_TAC[]);; let ONORM_COMPOSE_ADJOINT_LEFT = prove (`!f:real^N->real^N. linear f ==> onorm(adjoint f o f) = onorm f pow 2`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[REAL_POW_2; ONORM_COMPOSE; ADJOINT_LINEAR; ONORM_ADJOINT]; MATCH_MP_TAC REAL_RSQRT_LE THEN ASM_SIMP_TAC[LINEAR_COMPOSE; ADJOINT_LINEAR; ONORM_POS_LE] THEN ASM_SIMP_TAC[ONORM_LE_EQ] THEN X_GEN_TAC `x:real^N` THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [vector_norm] THEN REWRITE_TAC[GSYM SQRT_MUL] THEN MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[NORM_POW_2] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ADJOINT_WORKS th]) THEN W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN SIMP_TAC[GSYM NORM_POW_2; REAL_ARITH `(x:real) * y pow 2 = y * x * y`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN MP_TAC(ISPEC `adjoint f o (f:real^N->real^N)` ONORM) THEN ASM_SIMP_TAC[LINEAR_COMPOSE; ADJOINT_LINEAR; o_DEF]]);; let ONORM_COMPOSE_ADJOINT_RIGHT = prove (`!f:real^N->real^N. linear f ==> onorm(f o adjoint f) = onorm f pow 2`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `adjoint f:real^N->real^N` ONORM_COMPOSE_ADJOINT_LEFT) THEN ASM_SIMP_TAC[ADJOINT_LINEAR; ADJOINT_ADJOINT; ONORM_ADJOINT]);; let ONORM_TRANSP = prove (`!A:real^N^N. onorm(\x. transp A ** x) = onorm(\x. A ** x)`, REWRITE_TAC[GSYM ADJOINT_MATRIX] THEN SIMP_TAC[ONORM_ADJOINT; MATRIX_VECTOR_MUL_LINEAR]);; let ONORM_COVARIANCE = prove (`!A:real^N^N. onorm(\x. (transp A ** A) ** x) = onorm(\x. A ** x) pow 2`, GEN_TAC THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` ONORM_COMPOSE_ADJOINT_LEFT) THEN REWRITE_TAC[ADJOINT_MATRIX; MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC]);; let ONORM_COVARIANCE_ALT = prove (`!A:real^N^N. onorm(\x. (A ** transp A) ** x) = onorm(\x. A ** x) pow 2`, GEN_TAC THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` ONORM_COMPOSE_ADJOINT_RIGHT) THEN REWRITE_TAC[ADJOINT_MATRIX; MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC]);; (* ------------------------------------------------------------------------- *) (* It's handy to "lift" from R to R^1 and "drop" from R^1 to R. *) (* ------------------------------------------------------------------------- *) let lift = new_definition `(lift:real->real^1) x = lambda i. x`;; let drop = new_definition `(drop:real^1->real) x = x$1`;; let LIFT_COMPONENT = prove (`!x. (lift x)$1 = x`, SIMP_TAC[lift; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);; let LIFT_DROP = prove (`(!x. lift(drop x) = x) /\ (!x. drop(lift x) = x)`, SIMP_TAC[lift; drop; CART_EQ; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);; let IMAGE_LIFT_DROP = prove (`(!s. IMAGE (lift o drop) s = s) /\ (!s. IMAGE (drop o lift) s = s)`, REWRITE_TAC[o_DEF; LIFT_DROP] THEN SET_TAC[]);; let IN_IMAGE_LIFT_DROP = prove (`(!x s. x IN IMAGE lift s <=> drop x IN s) /\ (!x s. x IN IMAGE drop s <=> lift x IN s)`, REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; let FORALL_LIFT = prove (`(!x. P x) = (!x. P(lift x))`, MESON_TAC[LIFT_DROP]);; let EXISTS_LIFT = prove (`(?x. P x) = (?x. P(lift x))`, MESON_TAC[LIFT_DROP]);; let FORALL_DROP = prove (`(!x. P x) = (!x. P(drop x))`, MESON_TAC[LIFT_DROP]);; let EXISTS_DROP = prove (`(?x. P x) = (?x. P(drop x))`, MESON_TAC[LIFT_DROP]);; let FORALL_LIFT_FUN = prove (`!P:(A->real^1)->bool. (!f. P f) <=> (!f. P(lift o f))`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `f:A->real^1` THEN FIRST_X_ASSUM(MP_TAC o SPEC `drop o (f:A->real^1)`) THEN REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);; let FORALL_DROP_FUN = prove (`!P:(A->real)->bool. (!f. P f) <=> (!f. P(drop o f))`, REWRITE_TAC[FORALL_LIFT_FUN; o_DEF; LIFT_DROP; ETA_AX]);; let EXISTS_LIFT_FUN = prove (`!P:(A->real^1)->bool. (?f. P f) <=> (?f. P(lift o f))`, ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[FORALL_LIFT_FUN]);; let EXISTS_DROP_FUN = prove (`!P:(A->real)->bool. (?f. P f) <=> (?f. P(drop o f))`, ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[FORALL_DROP_FUN]);; let LIFT_EQ = prove (`!x y. (lift x = lift y) <=> (x = y)`, MESON_TAC[LIFT_DROP]);; let DROP_EQ = prove (`!x y. (drop x = drop y) <=> (x = y)`, MESON_TAC[LIFT_DROP]);; let LIFT_IN_IMAGE_LIFT = prove (`!x s. (lift x) IN (IMAGE lift s) <=> x IN s`, REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; let FORALL_LIFT_IMAGE = prove (`!P. (!s. P s) <=> (!s. P(IMAGE lift s))`, MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; let EXISTS_LIFT_IMAGE = prove (`!P. (?s. P s) <=> (?s. P(IMAGE lift s))`, MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; let SUBSET_LIFT_IMAGE = prove (`!s t. IMAGE lift s SUBSET IMAGE lift t <=> s SUBSET t`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);; let FORALL_DROP_IMAGE = prove (`!P. (!s. P s) <=> (!s. P(IMAGE drop s))`, MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; let EXISTS_DROP_IMAGE = prove (`!P. (?s. P s) <=> (?s. P(IMAGE drop s))`, MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; let SUBSET_DROP_IMAGE = prove (`!s t. IMAGE drop s SUBSET IMAGE drop t <=> s SUBSET t`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP IMAGE_SUBSET) THEN REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);; let DROP_IN_IMAGE_DROP = prove (`!x s. (drop x) IN (IMAGE drop s) <=> x IN s`, REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; let LIFT_NUM = prove (`!n. lift(&n) = vec n`, SIMP_TAC[CART_EQ; lift; vec; LAMBDA_BETA]);; let LIFT_ADD = prove (`!x y. lift(x + y) = lift x + lift y`, SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_ADD_COMPONENT]);; let LIFT_SUB = prove (`!x y. lift(x - y) = lift x - lift y`, SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_SUB_COMPONENT]);; let LIFT_CMUL = prove (`!x c. lift(c * x) = c % lift(x)`, SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_MUL_COMPONENT]);; let LIFT_NEG = prove (`!x. lift(--x) = --(lift x)`, SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_NEG_COMPONENT]);; let LIFT_EQ_CMUL = prove (`!x. lift x = x % vec 1`, REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID]);; let SUM_VSUM = prove (`!f s. sum s f = drop(vsum s(lift o f))`, SIMP_TAC[vsum; drop; LAMBDA_BETA; DIMINDEX_1; ARITH] THEN REWRITE_TAC[o_THM; GSYM drop; LIFT_DROP; ETA_AX]);; let VSUM_REAL = prove (`!f s. vsum s f = lift(sum s (drop o f))`, REWRITE_TAC[o_DEF; SUM_VSUM; LIFT_DROP; ETA_AX]);; let LIFT_SUM = prove (`!k x. lift(sum k x) = vsum k (lift o x)`, REWRITE_TAC[SUM_VSUM; LIFT_DROP]);; let DROP_VSUM = prove (`!k x. drop(vsum k x) = sum k (drop o x)`, REWRITE_TAC[VSUM_REAL; LIFT_DROP]);; let DROP_LAMBDA = prove (`!x. drop(lambda i. x i) = x 1`, SIMP_TAC[drop; LAMBDA_BETA; DIMINDEX_1; LE_REFL]);; let DROP_VEC = prove (`!n. drop(vec n) = &n`, MESON_TAC[LIFT_DROP; LIFT_NUM]);; let DROP_ADD = prove (`!x y. drop(x + y) = drop x + drop y`, MESON_TAC[LIFT_DROP; LIFT_ADD]);; let DROP_SUB = prove (`!x y. drop(x - y) = drop x - drop y`, MESON_TAC[LIFT_DROP; LIFT_SUB]);; let DROP_CMUL = prove (`!x c. drop(c % x) = c * drop(x)`, MESON_TAC[LIFT_DROP; LIFT_CMUL]);; let DROP_NEG = prove (`!x. drop(--x) = --(drop x)`, MESON_TAC[LIFT_DROP; LIFT_NEG]);; let NORM_1 = prove (`!x. norm x = abs(drop x)`, REWRITE_TAC[drop; NORM_REAL]);; let DIST_1 = prove (`!x y. dist(x,y) = abs(drop x - drop y)`, REWRITE_TAC[dist; DROP_SUB; NORM_1]);; let NORM_1_POS = prove (`!x. &0 <= drop x ==> norm x = drop x`, SIMP_TAC[NORM_1; real_abs]);; let NORM_LIFT = prove (`!x. norm(lift x) = abs(x)`, SIMP_TAC[lift; NORM_REAL; LIFT_COMPONENT]);; let DIST_LIFT = prove (`!x y. dist(lift x,lift y) = abs(x - y)`, REWRITE_TAC[DIST_REAL; LIFT_COMPONENT]);; let ABS_DROP = prove (`!x. norm x = abs(drop x)`, REWRITE_TAC[FORALL_LIFT; LIFT_DROP; NORM_LIFT]);; let LINEAR_VMUL_DROP = prove (`!f v. linear f ==> linear (\x. drop(f x) % v)`, SIMP_TAC[drop; LINEAR_VMUL_COMPONENT; DIMINDEX_1; LE_REFL]);; let LINEAR_FROM_REALS = prove (`!f:real^1->real^N. linear f ==> f = \x. drop x % column 1 (matrix f)`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN SIMP_TAC[CART_EQ; matrix_vector_mul; vector_mul; LAMBDA_BETA; DIMINDEX_1; SUM_SING_NUMSEG; drop; column] THEN REWRITE_TAC[REAL_MUL_AC]);; let LINEAR_TO_REALS = prove (`!f:real^N->real^1. linear f ==> f = \x. lift(row 1 (matrix f) dot x)`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN SIMP_TAC[CART_EQ; matrix_vector_mul; dot; LAMBDA_BETA; DIMINDEX_1; SUM_SING_NUMSEG; lift; row; LE_ANTISYM]);; let LINEAR_FROM_1 = prove (`!f:real^1->real^N. linear f <=> ?c. f = \x. drop x % c`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[LINEAR_FROM_REALS]; ALL_TAC] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]);; let DROP_EQ_0 = prove (`!x. drop x = &0 <=> x = vec 0`, REWRITE_TAC[GSYM DROP_EQ; DROP_VEC]);; let DROP_WLOG_LE = prove (`(!x y. P x y <=> P y x) /\ (!x y. drop x <= drop y ==> P x y) ==> (!x y. P x y)`, MESON_TAC[REAL_LE_TOTAL]);; let IMAGE_LIFT_UNIV = prove (`IMAGE lift (:real) = (:real^1)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);; let IMAGE_DROP_UNIV = prove (`IMAGE drop (:real^1) = (:real)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);; let LINEAR_LIFT_DOT = prove (`!a. linear(\x. lift(a dot x))`, REWRITE_TAC[linear; DOT_RMUL; DOT_RADD; LIFT_ADD; LIFT_CMUL]);; let LINEAR_TO_1 = prove (`!f:real^N->real^1. linear f <=> ?a. f = \x. lift(a dot x)`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_LIFT_DOT] THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_TO_REALS) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; let LINEAR_LIFT_COMPONENT = prove (`!k. linear(\x:real^N. lift(x$k))`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ !z:real^N. z$k = z$j` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; MP_TAC(ISPEC `basis j:real^N` LINEAR_LIFT_DOT) THEN ASM_SIMP_TAC[DOT_BASIS]]);; let BILINEAR_DROP_MUL = prove (`bilinear (\x y:real^N. drop x % y)`, REWRITE_TAC[bilinear; linear] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; let BILINEAR_MUL_DROP = prove (`bilinear(\y:real^N x. drop x % y)`, GEN_REWRITE_TAC I [GSYM BILINEAR_SWAP] THEN REWRITE_TAC[BILINEAR_DROP_MUL]);; let BILINEAR_LIFT_MUL = prove (`bilinear (\x y. lift(drop x * drop y))`, REWRITE_TAC[linear; bilinear; GSYM DROP_EQ; LIFT_DROP; DROP_ADD; DROP_CMUL] THEN REAL_ARITH_TAC);; let LINEAR_COMPONENTWISE = prove (`!f:real^M->real^N. linear f <=> !i. 1 <= i /\ i <= dimindex(:N) ==> linear(\x. lift(f(x)$i))`, REPEAT GEN_TAC THEN REWRITE_TAC[linear] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN SIMP_TAC[GSYM LIFT_CMUL; GSYM LIFT_ADD; LIFT_EQ] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN MESON_TAC[]);; let DROP_BASIS = prove (`!i. drop(basis i) = if i = 1 then &1 else &0`, REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN SIMP_TAC[basis; lift; CART_EQ; LAMBDA_BETA; DIMINDEX_1; FORALL_1] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Indicator (characteristic) functions into real^1. *) (* ------------------------------------------------------------------------- *) let indicator = new_definition `indicator s :real^M->real^1 = \x. if x IN s then vec 1 else vec 0`;; let DROP_INDICATOR = prove (`!s x. drop(indicator s x) = if x IN s then &1 else &0`, REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC]);; let DROP_INDICATOR_POS_LE = prove (`!s x. &0 <= drop(indicator s x)`, REWRITE_TAC[DROP_INDICATOR] THEN REAL_ARITH_TAC);; let DROP_INDICATOR_LE_1 = prove (`!s x. drop(indicator s x) <= &1`, REWRITE_TAC[DROP_INDICATOR] THEN REAL_ARITH_TAC);; let DROP_INDICATOR_ABS_LE_1 = prove (`!s x. abs(drop(indicator s x)) <= &1`, REWRITE_TAC[DROP_INDICATOR] THEN REAL_ARITH_TAC);; let INDICATOR_COMPLEMENT = prove (`!s. indicator((:real^N) DIFF s) = \x. vec 1 - indicator s x`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; indicator] THEN X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[IN_UNIV; IN_DIFF; VECTOR_SUB_REFL; VECTOR_SUB_RZERO]);; (* ------------------------------------------------------------------------- *) (* Pasting vectors. *) (* ------------------------------------------------------------------------- *) let LINEAR_FSTCART = prove (`linear fstcart`, SIMP_TAC[linear; fstcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM; ARITH_RULE `x <= a ==> x <= a + b:num`]);; let LINEAR_SNDCART = prove (`linear sndcart`, SIMP_TAC[linear; sndcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM; ARITH_RULE `x <= a ==> x <= a + b:num`; ARITH_RULE `x <= b ==> x + a <= a + b:num`]);; let FSTCART_VEC = prove (`!n. fstcart(vec n) = vec n`, SIMP_TAC[vec; fstcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM; ARITH_RULE `m <= n:num ==> m <= n + p`]);; let FSTCART_ADD = prove (`!x:real^(M,N)finite_sum y. fstcart(x + y) = fstcart(x) + fstcart(y)`, REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);; let FSTCART_CMUL = prove (`!x:real^(M,N)finite_sum c. fstcart(c % x) = c % fstcart(x)`, REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);; let FSTCART_NEG = prove (`!x:real^(M,N)finite_sum. --(fstcart x) = fstcart(--x)`, ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN REWRITE_TAC[FSTCART_CMUL]);; let FSTCART_SUB = prove (`!x:real^(M,N)finite_sum y. fstcart(x - y) = fstcart(x) - fstcart(y)`, REWRITE_TAC[VECTOR_SUB; FSTCART_NEG; FSTCART_ADD]);; let FSTCART_VSUM = prove (`!k x. FINITE k ==> (fstcart(vsum k x) = vsum k (\i. fstcart(x i)))`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; FSTCART_ADD; FSTCART_VEC]);; let SNDCART_VEC = prove (`!n. sndcart(vec n) = vec n`, SIMP_TAC[vec; sndcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM; ARITH_RULE `x <= a ==> x <= a + b:num`; ARITH_RULE `x <= b ==> x + a <= a + b:num`]);; let SNDCART_ADD = prove (`!x:real^(M,N)finite_sum y. sndcart(x + y) = sndcart(x) + sndcart(y)`, REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);; let SNDCART_CMUL = prove (`!x:real^(M,N)finite_sum c. sndcart(c % x) = c % sndcart(x)`, REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);; let SNDCART_NEG = prove (`!x:real^(M,N)finite_sum. --(sndcart x) = sndcart(--x)`, ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN REWRITE_TAC[SNDCART_CMUL]);; let SNDCART_SUB = prove (`!x:real^(M,N)finite_sum y. sndcart(x - y) = sndcart(x) - sndcart(y)`, REWRITE_TAC[VECTOR_SUB; SNDCART_NEG; SNDCART_ADD]);; let SNDCART_VSUM = prove (`!k x. FINITE k ==> (sndcart(vsum k x) = vsum k (\i. sndcart(x i)))`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; SNDCART_ADD; SNDCART_VEC]);; let PASTECART_VEC = prove (`!n. pastecart (vec n) (vec n) = vec n`, REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC; FSTCART_PASTECART; SNDCART_PASTECART]);; let PASTECART_ADD = prove (`!x1 y1 x2:real^M y2:real^N. pastecart x1 y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)`, REWRITE_TAC[PASTECART_EQ; FSTCART_ADD; SNDCART_ADD; FSTCART_PASTECART; SNDCART_PASTECART]);; let PASTECART_CMUL = prove (`!x1 y1 c. pastecart (c % x1) (c % y1) = c % pastecart x1 y1`, REWRITE_TAC[PASTECART_EQ; FSTCART_CMUL; SNDCART_CMUL; FSTCART_PASTECART; SNDCART_PASTECART]);; let PASTECART_NEG = prove (`!x:real^M y:real^N. pastecart (--x) (--y) = --(pastecart x y)`, ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN REWRITE_TAC[PASTECART_CMUL]);; let PASTECART_SUB = prove (`!x1 y1 x2:real^M y2:real^N. pastecart x1 y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)`, REWRITE_TAC[VECTOR_SUB; GSYM PASTECART_NEG; PASTECART_ADD]);; let PASTECART_VSUM = prove (`!k x y. FINITE k ==> (pastecart (vsum k x) (vsum k y) = vsum k (\i. pastecart (x i) (y i)))`, SIMP_TAC[PASTECART_EQ; FSTCART_VSUM; SNDCART_VSUM; FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);; let PASTECART_EQ_VEC = prove (`!x y n. pastecart x y = vec n <=> x = vec n /\ y = vec n`, REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC; FSTCART_PASTECART; SNDCART_PASTECART]);; let NORM_FSTCART = prove (`!x. norm(fstcart x) <= norm x`, GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO; SUM_ADD_SPLIT; REAL_LE_ADDR; SUM_POS_LE; FINITE_NUMSEG; REAL_LE_SQUARE; ARITH_RULE `x <= a ==> x <= a + b:num`; ARITH_RULE `~(d = 0) ==> 1 <= d + 1`]);; let DIST_FSTCART = prove (`!x y. dist(fstcart x,fstcart y) <= dist(x,y)`, REWRITE_TAC[dist; GSYM FSTCART_SUB; NORM_FSTCART]);; let NORM_SNDCART = prove (`!x. norm(sndcart x) <= norm x`, GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO; SUM_ADD_SPLIT; ARITH_RULE `x <= a ==> x <= a + b:num`; ARITH_RULE `~(d = 0) ==> 1 <= d + 1`] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; SUM_POS_LE; FINITE_NUMSEG; REAL_LE_ADDL; REAL_LE_SQUARE]);; let DIST_SNDCART = prove (`!x y. dist(sndcart x,sndcart y) <= dist(x,y)`, REWRITE_TAC[dist; GSYM SNDCART_SUB; NORM_SNDCART]);; let DOT_PASTECART = prove (`!x1 x2 y1 y2. (pastecart x1 x2) dot (pastecart y1 y2) = x1 dot y1 + x2 dot y2`, SIMP_TAC[pastecart; dot; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `~(d = 0) ==> 1 <= d + 1`; DIMINDEX_NONZERO; REAL_LE_LADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; REAL_LE_REFL]);; let SQNORM_PASTECART = prove (`!x y. norm(pastecart x y) pow 2 = norm(x) pow 2 + norm(y) pow 2`, REWRITE_TAC[NORM_POW_2; DOT_PASTECART]);; let NORM_PASTECART = prove (`!x y. norm(pastecart x y) = sqrt(norm(x) pow 2 + norm(y) pow 2)`, REWRITE_TAC[NORM_EQ_SQUARE] THEN SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_LE_ADD; REAL_LE_POW_2] THEN REWRITE_TAC[DOT_PASTECART; NORM_POW_2]);; let NORM_PASTECART_LE = prove (`!x y. norm(pastecart x y) <= norm(x) + norm(y)`, REPEAT GEN_TAC THEN MATCH_MP_TAC TRIANGLE_LEMMA THEN REWRITE_TAC[NORM_POS_LE; NORM_POW_2; DOT_PASTECART; REAL_LE_REFL]);; let DIST_PASTECART_LE = prove (`!x1 y1 x2 y2. dist(pastecart x1 y1,pastecart x2 y2) <= dist(x1,x2) + dist(y1,y2)`, REWRITE_TAC[dist; PASTECART_SUB; NORM_PASTECART_LE]);; let NORM_LE_PASTECART = prove (`!x:real^M y:real^N. norm(x) <= norm(pastecart x y) /\ norm(y) <= norm(pastecart x y)`, REPEAT GEN_TAC THEN REWRITE_TAC[NORM_PASTECART] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[REAL_LE_ADDL; REAL_LE_ADDR; REAL_LE_POW_2]);; let DIST_LE_PASTECART = prove (`!x1 y1 x2 y2. dist(x1,x2) <= dist(pastecart x1 y1,pastecart x2 y2) /\ dist(y1,y2) <= dist(pastecart x1 y1,pastecart x2 y2)`, REWRITE_TAC[dist; PASTECART_SUB; NORM_LE_PASTECART]);; let NORM_PASTECART_0 = prove (`(!x. norm(pastecart x (vec 0)) = norm x) /\ (!y. norm(pastecart (vec 0) y) = norm y)`, REWRITE_TAC[NORM_EQ_SQUARE; NORM_POW_2; NORM_POS_LE] THEN REWRITE_TAC[DOT_PASTECART; DOT_LZERO; REAL_ADD_LID; REAL_ADD_RID]);; let DIST_PASTECART_CANCEL = prove (`(!x x' y. dist(pastecart x y,pastecart x' y) = dist(x,x')) /\ (!x y y'. dist(pastecart x y,pastecart x y') = dist(y,y'))`, REWRITE_TAC[dist; PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART_0]);; let LINEAR_PASTECART = prove (`!f:real^M->real^N g:real^M->real^P. linear f /\ linear g ==> linear (\x. pastecart (f x) (g x))`, SIMP_TAC[linear; PASTECART_ADD; GSYM PASTECART_CMUL]);; let LINEAR_PASTECART_EQ = prove (`!f:real^M->real^N g:real^M->real^P. linear (\x. pastecart (f x) (g x)) <=> linear f /\ linear g`, REWRITE_TAC[linear; PASTECART_ADD; GSYM PASTECART_CMUL] THEN REWRITE_TAC[PASTECART_INJ] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Drop the k'th coordinate, or insert t at the k'th coordinate. *) (* ------------------------------------------------------------------------- *) let dropout = new_definition `(dropout k:real^M->real^N) x = lambda i. if i < k /\ i <= dimindex(:M) then x$i else if i + 1 <= dimindex(:M) then x$(i + 1) else &0`;; let pushin = new_definition `pushin k t x = lambda i. if i < k then x$i else if i = k then t else x$(i - 1)`;; let DROPOUT_PUSHIN = prove (`!k t x. dimindex(:M) + 1 = dimindex(:N) ==> (dropout k:real^N->real^M) (pushin k t x) = x`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN ASM_SIMP_TAC[CART_EQ; dropout; pushin; LAMBDA_BETA; ARITH_RULE `1 <= n + 1`; ADD_SUB; ARITH_RULE `m <= n ==> m <= n + 1 /\ m + 1 <= n + 1`] THEN ARITH_TAC);; let PUSHIN_DROPOUT = prove (`!k x. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> pushin k (x$k) ((dropout k:real^N->real^M) x) = x`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(ASSUME_TAC o GSYM)) THEN ASM_SIMP_TAC[CART_EQ; dropout; pushin; LAMBDA_BETA; ARITH_RULE `i <= n + 1 ==> i - 1 <= n`] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[LT_REFL] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(i:num = k) ==> i < k \/ k < i`)) THEN ASM_SIMP_TAC[ARITH_RULE `i:num < k ==> ~(k < i)`] THEN W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o lhand o snd) THEN (ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC]) THEN ASM_SIMP_TAC[ARITH_RULE `k < i ==> ~(i - 1 < k)`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN TRY AP_TERM_TAC THEN ASM_ARITH_TAC);; let DROPOUT_GALOIS = prove (`!k x:real^N y:real^M. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (y = dropout k x <=> (?t. x = pushin k t y))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `(x:real^N)$k` THEN ASM_SIMP_TAC[PUSHIN_DROPOUT]; DISCH_THEN(X_CHOOSE_THEN `t:real` SUBST1_TAC) THEN ASM_SIMP_TAC[DROPOUT_PUSHIN]]);; let IN_IMAGE_DROPOUT = prove (`!x s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (x IN IMAGE (dropout k:real^N->real^M) s <=> ?t. (pushin k t x) IN s)`, SIMP_TAC[IN_IMAGE; DROPOUT_GALOIS] THEN MESON_TAC[]);; let DROPOUT_EQ = prove (`!x y k. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ x$k = y$k /\ (dropout k:real^N->real^M) x = dropout k y ==> x = y`, SIMP_TAC[CART_EQ; dropout; VEC_COMPONENT; LAMBDA_BETA; IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `k:num`] THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE `~(i:num = k) ==> i < k \/ k < i`)) THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[]; FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `k < i ==> ~(i - 1 < k)`]] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC);; let DROPOUT_0 = prove (`dropout k (vec 0:real^N) = vec 0`, SIMP_TAC[dropout; VEC_COMPONENT; CART_EQ; COND_ID; LAMBDA_BETA]);; let DOT_DROPOUT = prove (`!k x y:real^N. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (dropout k x:real^M) dot (dropout k y) = x dot y - x$k * y$k`, REPEAT STRIP_TAC THEN SIMP_TAC[dot; dropout; LAMBDA_BETA] THEN REWRITE_TAC[TAUT `(if p then x else y:real) * (if p then a else b) = (if p then x * a else y * b)`] THEN SIMP_TAC[SUM_CASES; FINITE_NUMSEG; FINITE_RESTRICT] THEN REWRITE_TAC[REAL_MUL_LZERO; SUM_0; REAL_ADD_RID; IN_ELIM_THM] THEN SUBGOAL_THEN `(!i. i IN 1..dimindex(:M) /\ i < k /\ i <= dimindex(:N) <=> i IN 1..k-1) /\ (!i. (i IN 1..dimindex(:M) /\ ~(i < k /\ i <= dimindex(:N))) /\ i + 1 <= dimindex(:N) <=> i IN k..dimindex(:M))` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SIMPLE_IMAGE; IMAGE_ID] THEN REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN W(MP_TAC o PART_MATCH (rhs o rand) SUM_UNION o lhs o snd) THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_NUMSEG; DISJOINT_NUMSEG] THEN ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN MP_TAC(ISPECL [`\i. (x:real^N)$i * (y:real^N)$i`; `1..dimindex(:N)`; `k:num`] SUM_DELETE) THEN ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_UNION; IN_DELETE] THEN ASM_ARITH_TAC);; let DOT_PUSHIN = prove (`!k a b x y:real^M. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) ==> (pushin k a x:real^N) dot (pushin k b y) = x dot y + a * b`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(dropout k (pushin k a (x:real^M):real^N):real^M) dot (dropout k (pushin k b (y:real^M):real^N):real^M) + a * b` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[DROPOUT_PUSHIN]] THEN ASM_SIMP_TAC[DOT_DROPOUT] THEN MATCH_MP_TAC(REAL_RING `a':real = a /\ b' = b ==> x = x - a' * b' + a * b`) THEN ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL]);; let DROPOUT_ADD = prove (`!k x y:real^N. dropout k (x + y) = dropout k x + dropout k y`, SIMP_TAC[dropout; VECTOR_ADD_COMPONENT; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID]));; let DROPOUT_SUB = prove (`!k x y:real^N. dropout k (x - y) = dropout k x - dropout k y`, SIMP_TAC[dropout; VECTOR_SUB_COMPONENT; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_RZERO]));; let DROPOUT_MUL = prove (`!k c x:real^N. dropout k (c % x) = c % dropout k x`, SIMP_TAC[dropout; VECTOR_MUL_COMPONENT; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO]));; let LINEAR_DROPOUT = prove (`!k. linear(dropout k :real^N->real^M)`, REWRITE_TAC[linear; DROPOUT_ADD; DROPOUT_MUL]);; let LINEAR_PUSHIN = prove (`!k. linear(pushin k (&0))`, SIMP_TAC[linear; pushin; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A bit of linear algebra. *) (* ------------------------------------------------------------------------- *) let subspace = new_definition `subspace s <=> vec(0) IN s /\ (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\ (!c x. x IN s ==> (c % x) IN s)`;; let span = new_definition `span s = subspace hull s`;; let dependent = new_definition `dependent s <=> ?a. a IN s /\ a IN span(s DELETE a)`;; let independent = new_definition `independent s <=> ~(dependent s)`;; (* ------------------------------------------------------------------------- *) (* Closure properties of subspaces. *) (* ------------------------------------------------------------------------- *) let SUBSPACE_UNIV = prove (`subspace(UNIV:real^N->bool)`, REWRITE_TAC[subspace; IN_UNIV]);; let SUBSPACE_IMP_NONEMPTY = prove (`!s. subspace s ==> ~(s = {})`, REWRITE_TAC[subspace] THEN SET_TAC[]);; let SUBSPACE_0 = prove (`subspace s ==> vec(0) IN s`, SIMP_TAC[subspace]);; let SUBSPACE_ADD = prove (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x + y) IN s`, SIMP_TAC[subspace]);; let SUBSPACE_MUL = prove (`!x c s. subspace s /\ x IN s ==> (c % x) IN s`, SIMP_TAC[subspace]);; let SUBSPACE_NEG = prove (`!x s. subspace s /\ x IN s ==> (--x) IN s`, SIMP_TAC[VECTOR_ARITH `--x = --(&1) % x`; SUBSPACE_MUL]);; let SUBSPACE_SUB = prove (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x - y) IN s`, SIMP_TAC[VECTOR_SUB; SUBSPACE_ADD; SUBSPACE_NEG]);; let SUBSPACE_VSUM = prove (`!s f t. subspace s /\ FINITE t /\ (!x. x IN t ==> f(x) IN s) ==> (vsum t f) IN s`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[VSUM_CLAUSES; SUBSPACE_0; IN_INSERT; SUBSPACE_ADD]);; let SUBSPACE_LINEAR_IMAGE = prove (`!f s. linear f /\ subspace s ==> subspace(IMAGE f s)`, REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[linear; LINEAR_0]);; let SUBSPACE_LINEAR_PREIMAGE = prove (`!f s. linear f /\ subspace s ==> subspace {x | f(x) IN s}`, REWRITE_TAC[subspace; IN_ELIM_THM] THEN MESON_TAC[linear; LINEAR_0]);; let SUBSPACE_TRIVIAL = prove (`subspace {vec 0}`, SIMP_TAC[subspace; IN_SING] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let SUBSPACE_INTER = prove (`!s t. subspace s /\ subspace t ==> subspace (s INTER t)`, REWRITE_TAC[subspace; IN_INTER] THEN MESON_TAC[]);; let SUBSPACE_INTERS = prove (`!f. (!s. s IN f ==> subspace s) ==> subspace(INTERS f)`, SIMP_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_INTERS]);; let LINEAR_INJECTIVE_0_SUBSPACE = prove (`!f:real^M->real^N s. linear f /\ subspace s ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> (!x. x IN s /\ f x = vec 0 ==> x = vec 0))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN ASM_MESON_TAC[VECTOR_SUB_RZERO; SUBSPACE_SUB; SUBSPACE_0]);; let SUBSPACE_UNION_CHAIN = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ subspace(s UNION t) ==> s SUBSET t \/ t SUBSET s`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s SUBSET t \/ t SUBSET s <=> ~(?x y. x IN s /\ ~(x IN t) /\ y IN t /\ ~(y IN s))`] THEN STRIP_TAC THEN SUBGOAL_THEN `(x + y:real^N) IN s UNION t` MP_TAC THENL [MATCH_MP_TAC SUBSPACE_ADD THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN ASM_MESON_TAC[SUBSPACE_SUB; VECTOR_ARITH `(x + y) - x:real^N = y /\ (x + y) - y = x`]]);; let SUBSPACE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t ==> subspace(s PCROSS t)`, REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS] THEN SIMP_TAC[]);; let SUBSPACE_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. subspace(s PCROSS t) <=> subspace s /\ subspace t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN EQ_TAC THEN REWRITE_TAC[SUBSPACE_PCROSS] THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART]; MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Lemmas. *) (* ------------------------------------------------------------------------- *) let SPAN_SPAN = prove (`!s. span(span s) = span s`, REWRITE_TAC[span; HULL_HULL]);; let SPAN_MONO = prove (`!s t. s SUBSET t ==> span s SUBSET span t`, REWRITE_TAC[span; HULL_MONO]);; let SUBSPACE_SPAN = prove (`!s. subspace(span s)`, GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC P_HULL THEN SIMP_TAC[subspace; IN_INTERS]);; let NONEMPTY_SPAN = prove (`!s:real^N->bool. ~(span s = {})`, SIMP_TAC[SUBSPACE_IMP_NONEMPTY; SUBSPACE_SPAN]);; let SPAN_CLAUSES = prove (`(!a s. a IN s ==> a IN span s) /\ (vec(0) IN span s) /\ (!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s) /\ (!x c s. x IN span s ==> (c % x) IN span s)`, MESON_TAC[span; HULL_SUBSET; SUBSET; SUBSPACE_SPAN; subspace]);; let SPAN_INDUCT = prove (`!s h. (!x. x IN s ==> x IN h) /\ subspace h ==> !x. x IN span(s) ==> h(x)`, REWRITE_TAC[span] THEN MESON_TAC[SUBSET; HULL_MINIMAL; IN]);; let SPAN_EMPTY = prove (`span {} = {vec 0}`, REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_UNIQUE THEN SIMP_TAC[subspace; SUBSET; IN_SING; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let INDEPENDENT_EMPTY = prove (`independent {}`, REWRITE_TAC[independent; dependent; NOT_IN_EMPTY]);; let INDEPENDENT_NONZERO = prove (`!s. independent s ==> ~(vec 0 IN s)`, REWRITE_TAC[independent; dependent] THEN MESON_TAC[SPAN_CLAUSES]);; let INDEPENDENT_MONO = prove (`!s t. independent t /\ s SUBSET t ==> independent s`, REWRITE_TAC[independent; dependent] THEN ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);; let DEPENDENT_MONO = prove (`!s t:real^N->bool. dependent s /\ s SUBSET t ==> dependent t`, ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> ~r /\ q ==> ~p`] THEN REWRITE_TAC[GSYM independent; INDEPENDENT_MONO]);; let SPAN_SUBSPACE = prove (`!b s. b SUBSET s /\ s SUBSET (span b) /\ subspace s ==> (span b = s)`, MESON_TAC[SUBSET_ANTISYM; span; HULL_MINIMAL]);; let SPAN_INDUCT_ALT = prove (`!s h. h(vec 0) /\ (!c x y. x IN s /\ h(y) ==> h(c % x + y)) ==> !x:real^N. x IN span(s) ==> h(x)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o prove_inductive_relations_exist o concl) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x:real^N. x IN span(s) ==> g(x)` (fun th -> ASM_MESON_TAC[th]) THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN REWRITE_TAC[IN; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN ASM_MESON_TAC[IN; VECTOR_ADD_LID; VECTOR_ADD_ASSOC; VECTOR_ADD_SYM; VECTOR_MUL_LID; VECTOR_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* Individual closure properties. *) (* ------------------------------------------------------------------------- *) let SPAN_SUPERSET = prove (`!x. x IN s ==> x IN span s`, MESON_TAC[SPAN_CLAUSES]);; let SPAN_INC = prove (`!s. s SUBSET span s`, REWRITE_TAC[SUBSET; SPAN_SUPERSET]);; let SPAN_UNION_SUBSET = prove (`!s t. span s UNION span t SUBSET span(s UNION t)`, REWRITE_TAC[span; HULL_UNION_SUBSET]);; let SPAN_UNIV = prove (`span(:real^N) = (:real^N)`, SIMP_TAC[SPAN_INC; SET_RULE `UNIV SUBSET s ==> s = UNIV`]);; let SPAN_0 = prove (`vec(0) IN span s`, MESON_TAC[SUBSPACE_SPAN; SUBSPACE_0]);; let SPAN_ADD = prove (`!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s`, MESON_TAC[SUBSPACE_SPAN; SUBSPACE_ADD]);; let SPAN_MUL = prove (`!x c s. x IN span s ==> (c % x) IN span s`, MESON_TAC[SUBSPACE_SPAN; SUBSPACE_MUL]);; let SPAN_MUL_EQ = prove (`!x:real^N c s. ~(c = &0) ==> ((c % x) IN span s <=> x IN span s)`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[SPAN_MUL] THEN SUBGOAL_THEN `(inv(c) % c % x:real^N) IN span s` MP_TAC THENL [ASM_SIMP_TAC[SPAN_MUL]; ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]]);; let SPAN_NEG = prove (`!x s. x IN span s ==> (--x) IN span s`, MESON_TAC[SUBSPACE_SPAN; SUBSPACE_NEG]);; let SPAN_NEG_EQ = prove (`!x s. --x IN span s <=> x IN span s`, MESON_TAC[SPAN_NEG; VECTOR_NEG_NEG]);; let SPAN_SUB = prove (`!x y s. x IN span s /\ y IN span s ==> (x - y) IN span s`, MESON_TAC[SUBSPACE_SPAN; SUBSPACE_SUB]);; let SPAN_VSUM = prove (`!s f t. FINITE t /\ (!x. x IN t ==> f(x) IN span(s)) ==> (vsum t f) IN span(s)`, MESON_TAC[SUBSPACE_SPAN; SUBSPACE_VSUM]);; let SPAN_ADD_EQ = prove (`!s x y. x IN span s ==> ((x + y) IN span s <=> y IN span s)`, MESON_TAC[SPAN_ADD; SPAN_SUB; VECTOR_ARITH `(x + y) - x:real^N = y`]);; let SPAN_EQ_SELF = prove (`!s. span s = s <=> subspace s`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSPACE_SPAN]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_SUBSPACE THEN ASM_REWRITE_TAC[SUBSET_REFL; SPAN_INC]);; let SPAN_OF_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> span s = s`, REWRITE_TAC[SPAN_EQ_SELF]);; let SPAN_SUBSET_SUBSPACE = prove (`!s t:real^N->bool. s SUBSET t /\ subspace t ==> span s SUBSET t`, MESON_TAC[SPAN_MONO; SPAN_EQ_SELF]);; let SUBSPACE_TRANSLATION_SELF = prove (`!s a. subspace s /\ a IN s ==> IMAGE (\x. a + x) s = s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM SPAN_EQ_SELF]) THEN ASM_SIMP_TAC[SPAN_ADD_EQ; SPAN_CLAUSES] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]);; let SUBSPACE_TRANSLATION_SELF_EQ = prove (`!s a:real^N. subspace s ==> (IMAGE (\x. a + x) s = s <=> a IN s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[SUBSPACE_TRANSLATION_SELF] THEN DISCH_THEN(MP_TAC o AP_TERM `\s. (a:real^N) IN s`) THEN REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^N` THEN ASM_MESON_TAC[subspace; VECTOR_ADD_RID]);; let SUBSPACE_SUMS = prove (`!s t. subspace s /\ subspace t ==> subspace {x + y | x IN s /\ y IN t}`, REWRITE_TAC[subspace; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[VECTOR_ADD_LID]; ONCE_REWRITE_TAC[VECTOR_ARITH `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN ASM_MESON_TAC[]; REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN ASM_MESON_TAC[]]);; let SPAN_UNION = prove (`!s t. span(s UNION t) = {x + y:real^N | x IN span s /\ y IN span t}`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN SIMP_TAC[SUBSPACE_SUMS; SUBSPACE_SPAN] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_RID]; MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_LID]]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_ADD THEN ASM_MESON_TAC[SPAN_MONO; SUBSET_UNION; SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Mapping under linear image. *) (* ------------------------------------------------------------------------- *) let SPAN_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f ==> (span(IMAGE f s) = IMAGE f (span s))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN ASM_SIMP_TAC[SUBSPACE_SPAN; SUBSPACE_LINEAR_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[SPAN_SUPERSET; SUBSET]; SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[SET_RULE `(\x. f x IN span(s)) = {x | f(x) IN span s}`] THEN ASM_SIMP_TAC[SUBSPACE_LINEAR_PREIMAGE; SUBSPACE_SPAN] THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[SPAN_SUPERSET; SUBSET; IN_IMAGE]]);; let DEPENDENT_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (dependent(IMAGE f s) <=> dependent s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^M` THEN ASM_CASES_TAC `(a:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(f:real^M->real^N) a IN span(IMAGE f (s DELETE a))` THEN CONJ_TAC THENL [AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN ASM SET_TAC[]]);; let DEPENDENT_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ dependent(s) ==> dependent(IMAGE f s)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s DELETE f a = IMAGE f (s DELETE a)` (fun th -> ASM_SIMP_TAC[FUN_IN_IMAGE; SPAN_LINEAR_IMAGE; th]) THEN ASM SET_TAC[]);; let INDEPENDENT_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (independent(IMAGE f s) <=> independent s)`, REWRITE_TAC[independent; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN REWRITE_TAC[DEPENDENT_LINEAR_IMAGE_EQ]);; (* ------------------------------------------------------------------------- *) (* The key breakdown property. *) (* ------------------------------------------------------------------------- *) let SPAN_BREAKDOWN = prove (`!b s a:real^N. b IN s /\ a IN span s ==> ?k. (a - k % b) IN span(s DELETE b)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a:real^N = b`; ALL_TAC] THEN ASM_MESON_TAC[SPAN_CLAUSES; IN_DELETE; VECTOR_ARITH `(a - &1 % a = vec 0) /\ (a - &0 % b = a) /\ ((x + y) - (k1 + k2) % b = (x - k1 % b) + (y - k2 % b)) /\ (c % x - (c * k) % y = c % (x - k % y))`]);; let SPAN_BREAKDOWN_EQ = prove (`!a:real^N s. (x IN span(a INSERT s) <=> (?k. (x - k % a) IN span s))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o CONJ(SET_RULE `(a:real^N) IN (a INSERT s)`)) THEN DISCH_THEN(MP_TAC o MATCH_MP SPAN_BREAKDOWN) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN SPEC_TAC(`x - k % a:real^N`,`y:real^N`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN SUBST1_TAC(VECTOR_ARITH `x = (x - k % a) + k % a:real^N`) THEN MATCH_MP_TAC SPAN_ADD THEN ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; SPAN_CLAUSES]]);; let SPAN_INSERT_0 = prove (`!s. span(vec 0 INSERT s) = span s`, SIMP_TAC[EXTENSION; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]);; let SPAN_SING = prove (`!a. span {a} = {u % a | u IN (:real)}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ]);; let SPAN_2 = prove (`!a b. span {a,b} = {u % a + v % b | u IN (:real) /\ v IN (:real)}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);; let SPAN_3 = prove (`!a b c. span {a,b,c} = {u % a + v % b + w % c | u IN (:real) /\ v IN (:real) /\ w IN (:real)}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);; (* ------------------------------------------------------------------------- *) (* Hence some "reversal" results. *) (* ------------------------------------------------------------------------- *) let IN_SPAN_INSERT = prove (`!a b:real^N s. a IN span(b INSERT s) /\ ~(a IN span s) ==> b IN span(a INSERT s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`b:real^N`; `(b:real^N) INSERT s`; `a:real^N`] SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN ASM_CASES_TAC `k = &0` THEN ASM_REWRITE_TAC[VECTOR_ARITH `a - &0 % b = a`; DELETE_INSERT] THENL [ASM_MESON_TAC[SPAN_MONO; SUBSET; DELETE_SUBSET]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `inv(k)` o MATCH_MP SPAN_MUL) THEN ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH `b:real^N = inv(k) % a - (inv(k) % a - &1 % b)`) THEN MATCH_MP_TAC SPAN_SUB THEN ASM_MESON_TAC[SPAN_CLAUSES; IN_INSERT; SUBSET; IN_DELETE; SPAN_MONO]);; let IN_SPAN_DELETE = prove (`!a b s. a IN span s /\ ~(a IN span (s DELETE b)) ==> b IN span (a INSERT (s DELETE b))`, ASM_MESON_TAC[IN_SPAN_INSERT; SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);; let EQ_SPAN_INSERT_EQ = prove (`!s x y:real^N. (x - y) IN span s ==> span(x INSERT s) = span(y INSERT s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; EXTENSION] THEN ASM_MESON_TAC[SPAN_ADD; SPAN_SUB; SPAN_MUL; VECTOR_ARITH `(z - k % y) - k % (x - y) = z - k % x`; VECTOR_ARITH `(z - k % x) + k % (x - y) = z - k % y`]);; (* ------------------------------------------------------------------------- *) (* Transitivity property. *) (* ------------------------------------------------------------------------- *) let SPAN_TRANS = prove (`!x y:real^N s. x IN span(s) /\ y IN span(x INSERT s) ==> y IN span(s)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`x:real^N`; `(x:real^N) INSERT s`; `y:real^N`] SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN SUBST1_TAC(VECTOR_ARITH `y:real^N = (y - k % x) + k % x`) THEN MATCH_MP_TAC SPAN_ADD THEN ASM_SIMP_TAC[SPAN_MUL] THEN ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);; (* ------------------------------------------------------------------------- *) (* An explicit expansion is sometimes needed. *) (* ------------------------------------------------------------------------- *) let SPAN_EXPLICIT = prove (`!(p:real^N -> bool). span p = {y | ?s u. FINITE s /\ s SUBSET p /\ vsum s (\v. u v % v) = y}`, GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SPAN_SUPERSET; SPAN_MUL]] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL [EXISTS_TAC `{}:real^N->bool` THEN REWRITE_TAC[FINITE_RULES; VSUM_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`] THEN STRIP_TAC THEN EXISTS_TAC `(x:real^N) INSERT s` THEN EXISTS_TAC `\y. if y = x then (if x IN s then (u:real^N->real) y + c else c) else u y` THEN ASM_SIMP_TAC[FINITE_INSERT; IN_INSERT; VSUM_CLAUSES] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`)) THEN ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_DELETE; IN_DELETE] THEN MATCH_MP_TAC(VECTOR_ARITH `y = z ==> (c + d) % x + y = d % x + c % x + z`); AP_TERM_TAC] THEN MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[IN_DELETE]);; let DEPENDENT_EXPLICIT = prove (`!p. dependent (p:real^N -> bool) <=> ?s u. FINITE s /\ s SUBSET p /\ (?v. v IN s /\ ~(u v = &0)) /\ vsum s (\v. u v % v) = vec 0`, GEN_TAC THEN REWRITE_TAC[dependent; SPAN_EXPLICIT; IN_ELIM_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`; `u:real^N->real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(a:real^N) INSERT s`; `\y. if y = a then -- &1 else (u:real^N->real) y`; `a:real^N`] THEN ASM_REWRITE_TAC[IN_INSERT; INSERT_SUBSET; FINITE_INSERT] THEN CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC REAL_RAT_REDUCE_CONV] THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `-- &1 % a + s = vec 0 <=> a = s`] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN MATCH_MP_TAC VSUM_EQ THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`; `a:real^N`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `s DELETE (a:real^N)`; `\i. --((u:real^N->real) i) / (u a)`] THEN ASM_SIMP_TAC[VSUM_DELETE; FINITE_DELETE] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[VECTOR_MUL_LNEG; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL; VSUM_NEG; VECTOR_MUL_RNEG; VECTOR_MUL_RZERO] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN VECTOR_ARITH_TAC]);; let DEPENDENT_FINITE = prove (`!s:real^N->bool. FINITE s ==> (dependent s <=> ?u. (?v. v IN s /\ ~(u v = &0)) /\ vsum s (\v. u(v) % v) = vec 0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[DEPENDENT_EXPLICIT] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN EXISTS_TAC `\v:real^N. if v IN t then u(v) else &0` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]; GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; let SPAN_FINITE = prove (`!s:real^N->bool. FINITE s ==> span s = {y | ?u. vsum s (\v. u v % v) = y}`, REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC `\x:real^N. if x IN t then u(x) else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]; X_GEN_TAC `u:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; (* ------------------------------------------------------------------------- *) (* Standard bases are a spanning set, and obviously finite. *) (* ------------------------------------------------------------------------- *) let SPAN_STDBASIS = prove (`span {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} = UNIV`, REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let HAS_SIZE_STDBASIS = prove (`{basis i :real^N | 1 <= i /\ i <= dimindex(:N)} HAS_SIZE dimindex(:N)`, ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[GSYM numseg; HAS_SIZE_NUMSEG_1; IN_NUMSEG] THEN MESON_TAC[BASIS_INJ]);; let FINITE_STDBASIS = prove (`FINITE {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`, MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);; let CARD_STDBASIS = prove (`CARD {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} = dimindex(:N)`, MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);; let IN_SPAN_IMAGE_BASIS = prove (`!x:real^N s. x IN span(IMAGE basis s) <=> !i. 1 <= i /\ i <= dimindex(:N) /\ ~(i IN s) ==> x$i = &0`, REPEAT GEN_TAC THEN EQ_TAC THENL [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; REAL_MUL_RZERO; REAL_ADD_RID] THEN SIMP_TAC[FORALL_IN_IMAGE; BASIS_COMPONENT] THEN MESON_TAC[]; DISCH_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM] THEN EXISTS_TAC `(IMAGE basis ((1..dimindex(:N)) INTER s)):real^N->bool` THEN SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `\v:real^N. x dot v` THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN REWRITE_TAC[IN_INTER; IN_NUMSEG] THEN MESON_TAC[BASIS_INJ]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]] THEN REWRITE_TAC[o_DEF] THEN SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[MESON[] `(if x = y then p else q) = (if y = x then p else q)`] THEN SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_INTER; IN_NUMSEG; DOT_BASIS] THEN ASM_MESON_TAC[REAL_MUL_RID]]);; let INDEPENDENT_STDBASIS = prove (`independent {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`, REWRITE_TAC[independent; dependent] THEN ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN SUBGOAL_THEN `IMAGE basis {i | 1 <= i /\ i <= dimindex(:N)} DELETE (basis k:real^N) = IMAGE basis ({i | 1 <= i /\ i <= dimindex(:N)} DELETE k)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[BASIS_INJ]; ALL_TAC] THEN REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[IN_DELETE; BASIS_COMPONENT; REAL_OF_NUM_EQ; ARITH]);; let INDEPENDENT_BASIS_IMAGE = prove (`!k. independent(IMAGE basis k:real^N->bool) <=> k SUBSET 1..dimindex(:N) `, REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP INDEPENDENT_NONZERO) THEN REWRITE_TAC[SET_RULE `~(a IN IMAGE f s) <=> !x. x IN s ==> ~(f x = a)`; BASIS_EQ_0; GSYM SUBSET]; MATCH_MP_TAC INDEPENDENT_MONO THEN EXISTS_TAC `{basis i:real^N | 1 <= i /\ i <= dimindex(:N)}` THEN REWRITE_TAC[INDEPENDENT_STDBASIS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC IMAGE_SUBSET THEN ASM_REWRITE_TAC[GSYM numseg]]);; (* ------------------------------------------------------------------------- *) (* This is useful for building a basis step-by-step. *) (* ------------------------------------------------------------------------- *) let INDEPENDENT_INSERT = prove (`!a:real^N s. independent(a INSERT s) <=> if a IN s then independent s else independent s /\ ~(a IN span s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_SIMP_TAC[SET_RULE `x IN s ==> (x INSERT s = s)`] THEN EQ_TAC THENL [DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET; IN_INSERT]; POP_ASSUM MP_TAC THEN REWRITE_TAC[independent; dependent] THEN ASM_MESON_TAC[IN_INSERT; SET_RULE `~(a IN s) ==> ((a INSERT s) DELETE a = s)`]]; ALL_TAC] THEN REWRITE_TAC[independent; dependent; NOT_EXISTS_THM] THEN STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> ((a INSERT s) DELETE a = s)`] THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) /\ ~(b = a) ==> ((a INSERT s) DELETE b = a INSERT (s DELETE b))`] THEN ASM_MESON_TAC[IN_SPAN_INSERT; SET_RULE `b IN s ==> (b INSERT (s DELETE b) = s)`]);; (* ------------------------------------------------------------------------- *) (* The degenerate case of the Exchange Lemma. *) (* ------------------------------------------------------------------------- *) let SPANNING_SUBSET_INDEPENDENT = prove (`!s t:real^N->bool. t SUBSET s /\ independent s /\ s SUBSET span(t) ==> (s = t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);; (* ------------------------------------------------------------------------- *) (* The general case of the Exchange Lemma, the key to what follows. *) (* ------------------------------------------------------------------------- *) let EXCHANGE_LEMMA = prove (`!s t:real^N->bool. FINITE t /\ independent s /\ s SUBSET span t ==> ?t'. t' HAS_SIZE (CARD t) /\ s SUBSET t' /\ t' SUBSET (s UNION t) /\ s SUBSET (span t')`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(t DIFF s :real^N->bool)` THEN ASM_CASES_TAC `(s:real^N->bool) SUBSET t` THENL [ASM_MESON_TAC[HAS_SIZE; SUBSET_UNION]; ALL_TAC] THEN ASM_CASES_TAC `t SUBSET (s:real^N->bool)` THENL [ASM_MESON_TAC[SPANNING_SUBSET_INDEPENDENT; HAS_SIZE]; ALL_TAC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[SUBSET] o check(is_neg o concl)) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `s SUBSET span(t DELETE (b:real^N))` THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`t DELETE (b:real^N)`; `s:real^N->bool`]) THEN ASM_REWRITE_TAC[SET_RULE `s DELETE a DIFF t = (s DIFF t) DELETE a`] THEN ASM_SIMP_TAC[CARD_DELETE; FINITE_DIFF; IN_DIFF; FINITE_DELETE; CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN ANTS_TAC THENL [UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(b:real^N) INSERT u` THEN ASM_SIMP_TAC[SUBSET_INSERT; INSERT_SUBSET; IN_UNION] THEN CONJ_TAC THENL [UNDISCH_TAC `(u:real^N->bool) HAS_SIZE CARD(t:real^N->bool) - 1` THEN SIMP_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN STRIP_TAC THEN COND_CASES_TAC THENL [ASM_MESON_TAC[SUBSET; IN_UNION; IN_DELETE]; ALL_TAC] THEN ASM_MESON_TAC[ARITH_RULE `~(n = 0) ==> (SUC(n - 1) = n)`; CARD_EQ_0; MEMBER_NOT_EMPTY]; ALL_TAC] THEN CONJ_TAC THENL [UNDISCH_TAC `u SUBSET s UNION t DELETE (b:real^N)` THEN SET_TAC[]; ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT]]; ALL_TAC] THEN UNDISCH_TAC `~(s SUBSET span (t DELETE (b:real^N)))` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((a:real^N) IN t)` ASSUME_TAC THENL [ASM_MESON_TAC[IN_DELETE; SPAN_CLAUSES]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(a:real^N) INSERT (t DELETE b)`; `s:real^N->bool`]) THEN ANTS_TAC THENL [ASM_SIMP_TAC[SET_RULE `a IN s ==> ((a INSERT (t DELETE b) DIFF s) = (t DIFF s) DELETE b)`] THEN ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE; FINITE_DIFF; IN_DIFF] THEN ASM_SIMP_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`; CARD_EQ_0; FINITE_DIFF] THEN UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_RULES; FINITE_DELETE] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `b:real^N` THEN ASM_MESON_TAC[IN_SPAN_DELETE; SUBSET; SPAN_MONO; SET_RULE `t SUBSET (b INSERT (a INSERT (t DELETE b)))`]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; CARD_DELETE; FINITE_DELETE; IN_DELETE; ARITH_RULE `(SUC(n - 1) = n) <=> ~(n = 0)`; CARD_EQ_0] THEN UNDISCH_TAC `(b:real^N) IN t` THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* This implies corresponding size bounds. *) (* ------------------------------------------------------------------------- *) let INDEPENDENT_SPAN_BOUND = prove (`!s t. FINITE t /\ independent s /\ s SUBSET span(t) ==> FINITE s /\ CARD(s) <= CARD(t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP EXCHANGE_LEMMA) THEN ASM_MESON_TAC[HAS_SIZE; CARD_SUBSET; FINITE_SUBSET]);; let INDEPENDENT_BOUND = prove (`!s:real^N->bool. independent s ==> FINITE s /\ CARD(s) <= dimindex(:N)`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM CARD_STDBASIS] THEN MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN ASM_REWRITE_TAC[FINITE_STDBASIS; SPAN_STDBASIS; SUBSET_UNIV]);; let DEPENDENT_BIGGERSET = prove (`!s:real^N->bool. (FINITE s ==> CARD(s) > dimindex(:N)) ==> dependent s`, MP_TAC INDEPENDENT_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);; let INDEPENDENT_IMP_FINITE = prove (`!s:real^N->bool. independent s ==> FINITE s`, SIMP_TAC[INDEPENDENT_BOUND]);; (* ------------------------------------------------------------------------- *) (* Explicit formulation of independence. *) (* ------------------------------------------------------------------------- *) let INDEPENDENT_EXPLICIT = prove (`!b:real^N->bool. independent b <=> FINITE b /\ !c. vsum b (\v. c(v) % v) = vec 0 ==> !v. v IN b ==> c(v) = &0`, GEN_TAC THEN ASM_CASES_TAC `FINITE(b:real^N->bool)` THENL [ALL_TAC; ASM_MESON_TAC[INDEPENDENT_BOUND]] THEN ASM_SIMP_TAC[independent; DEPENDENT_FINITE] THEN MESON_TAC[]);; let INDEPENDENT_SING = prove (`!x. independent {x} <=> ~(x = vec 0)`, REWRITE_TAC[INDEPENDENT_INSERT; NOT_IN_EMPTY; SPAN_EMPTY] THEN REWRITE_TAC[INDEPENDENT_EMPTY] THEN SET_TAC[]);; let DEPENDENT_SING = prove (`!x. dependent {x} <=> x = vec 0`, MESON_TAC[independent; INDEPENDENT_SING]);; let DEPENDENT_2 = prove (`!a b:real^N. dependent {a,b} <=> if a = b then a = vec 0 else ?x y. x % a + y % b = vec 0 /\ ~(x = &0 /\ y = &0)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DEPENDENT_SING; SET_RULE `{x,x} = {x}`] THEN SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; EXISTS_IN_INSERT] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(u:real^N->real) a`; `(u:real^N->real) b`] THEN ASM_REWRITE_TAC[]; MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN DISCH_TAC THEN EXISTS_TAC `\v:real^N. if v = a then x else if v = b then y else z:real` THEN ASM_MESON_TAC[]]);; let DEPENDENT_3 = prove (`!a b c:real^N. ~(a = b) /\ ~(a = c) /\ ~(b = c) ==> (dependent {a,b,c} <=> ?x y z. x % a + y % b + z % c = vec 0 /\ ~(x = &0 /\ y = &0 /\ z = &0))`, REPEAT STRIP_TAC THEN SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; IN_INSERT] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(u:real^N->real) a`; `(u:real^N->real) b`; `(u:real^N->real) c`]; MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `z:real`] THEN DISCH_TAC THEN EXISTS_TAC `\v:real^N. if v = a then x else if v = b then y else z:real`] THEN ASM_MESON_TAC[]);; let INDEPENDENT_2 = prove (`!a b:real^N x y. independent{a,b} /\ ~(a = b) ==> (x % a + y % b = vec 0 <=> x = &0 /\ y = &0)`, SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_2] THEN MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);; let INDEPENDENT_3 = prove (`!a b c:real^N x y z. independent{a,b,c} /\ ~(a = b) /\ ~(a = c) /\ ~(b = c) ==> (x % a + y % b + z % c = vec 0 <=> x = &0 /\ y = &0 /\ z = &0)`, SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_3] THEN MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);; (* ------------------------------------------------------------------------- *) (* Hence we can create a maximal independent subset. *) (* ------------------------------------------------------------------------- *) let MAXIMAL_INDEPENDENT_SUBSET_EXTEND = prove (`!s v:real^N->bool. s SUBSET v /\ independent s ==> ?b. s SUBSET b /\ b SUBSET v /\ independent b /\ v SUBSET (span b)`, REPEAT GEN_TAC THEN WF_INDUCT_TAC `dimindex(:N) - CARD(s:real^N->bool)` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `v SUBSET (span(s:real^N->bool))` THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N) INSERT s`) THEN REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[INSERT_SUBSET]] THEN SUBGOAL_THEN `independent ((a:real^N) INSERT s)` ASSUME_TAC THENL [ASM_REWRITE_TAC[INDEPENDENT_INSERT; COND_ID]; ALL_TAC] THEN ASM_REWRITE_TAC[INSERT_SUBSET] THEN MATCH_MP_TAC(ARITH_RULE `(b = a + 1) /\ b <= n ==> n - b < n - a`) THEN ASM_SIMP_TAC[CARD_CLAUSES; INDEPENDENT_BOUND] THEN ASM_MESON_TAC[SPAN_SUPERSET; ADD1]);; let MAXIMAL_INDEPENDENT_SUBSET = prove (`!v:real^N->bool. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b)`, MP_TAC(SPEC `EMPTY:real^N->bool` MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN REWRITE_TAC[EMPTY_SUBSET; INDEPENDENT_EMPTY]);; (* ------------------------------------------------------------------------- *) (* A kind of closed graph property for linearity. *) (* ------------------------------------------------------------------------- *) let LINEAR_SUBSPACE_GRAPH = prove (`!f:real^M->real^N. linear f <=> subspace {pastecart x (f x) | x IN (:real^M)}`, REWRITE_TAC[linear; subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM(SPEC `0` PASTECART_VEC); IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_INJ; UNWIND_THM1; PASTECART_ADD; GSYM PASTECART_CMUL] THEN MESON_TAC[VECTOR_MUL_LZERO]);; (* ------------------------------------------------------------------------- *) (* Notion of dimension. *) (* ------------------------------------------------------------------------- *) let dim = new_definition `dim v = @n. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\ b HAS_SIZE n`;; let BASIS_EXISTS = prove (`!v. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\ b HAS_SIZE (dim v)`, GEN_TAC THEN REWRITE_TAC[dim] THEN CONV_TAC SELECT_CONV THEN MESON_TAC[MAXIMAL_INDEPENDENT_SUBSET; HAS_SIZE; INDEPENDENT_BOUND]);; let BASIS_EXISTS_FINITE = prove (`!v. ?b. FINITE b /\ b SUBSET v /\ independent b /\ v SUBSET (span b) /\ b HAS_SIZE (dim v)`, MESON_TAC[BASIS_EXISTS; INDEPENDENT_IMP_FINITE]);; let BASIS_SUBSPACE_EXISTS = prove (`!s:real^N->bool. subspace s ==> ?b. FINITE b /\ b SUBSET s /\ independent b /\ span b = s /\ b HAS_SIZE dim s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN ASM_MESON_TAC[SPAN_EQ_SELF; SPAN_MONO; INDEPENDENT_IMP_FINITE]);; (* ------------------------------------------------------------------------- *) (* Consequences of independence or spanning for cardinality. *) (* ------------------------------------------------------------------------- *) let INDEPENDENT_CARD_LE_DIM = prove (`!v b:real^N->bool. b SUBSET v /\ independent b ==> FINITE b /\ CARD(b) <= dim v`, MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);; let SPAN_CARD_GE_DIM = prove (`!v b:real^N->bool. v SUBSET (span b) /\ FINITE b ==> dim(v) <= CARD(b)`, MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);; let BASIS_CARD_EQ_DIM = prove (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b ==> FINITE b /\ (CARD b = dim v)`, MESON_TAC[LE_ANTISYM; INDEPENDENT_CARD_LE_DIM; SPAN_CARD_GE_DIM]);; let BASIS_HAS_SIZE_DIM = prove (`!v b. independent b /\ span b = v ==> b HAS_SIZE (dim v)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC BASIS_CARD_EQ_DIM THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SPAN_INC]);; let DIM_UNIQUE = prove (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b /\ b HAS_SIZE n ==> (dim v = n)`, MESON_TAC[BASIS_CARD_EQ_DIM; HAS_SIZE]);; let DIM_LE_CARD = prove (`!s. FINITE s ==> dim s <= CARD s`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_REWRITE_TAC[SPAN_INC; SUBSET_REFL]);; (* ------------------------------------------------------------------------- *) (* More lemmas about dimension. *) (* ------------------------------------------------------------------------- *) let DIM_UNIV = prove (`dim(:real^N) = dimindex(:N)`, MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN REWRITE_TAC[SUBSET_UNIV; SPAN_STDBASIS; HAS_SIZE_STDBASIS; INDEPENDENT_STDBASIS]);; let DIM_SUBSET = prove (`!s t:real^N->bool. s SUBSET t ==> dim(s) <= dim(t)`, MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; SUBSET; HAS_SIZE]);; let DIM_SUBSET_UNIV = prove (`!s:real^N->bool. dim(s) <= dimindex(:N)`, GEN_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; let BASIS_HAS_SIZE_UNIV = prove (`!b. independent b /\ span b = (:real^N) ==> b HAS_SIZE (dimindex(:N))`, REWRITE_TAC[GSYM DIM_UNIV; BASIS_HAS_SIZE_DIM]);; (* ------------------------------------------------------------------------- *) (* Converses to those. *) (* ------------------------------------------------------------------------- *) let CARD_GE_DIM_INDEPENDENT = prove (`!v b:real^N->bool. b SUBSET v /\ independent b /\ dim v <= CARD(b) ==> v SUBSET (span b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a:real^N. ~(a IN v /\ ~(a IN span b))` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `independent((a:real^N) INSERT b)` ASSUME_TAC THENL [ASM_MESON_TAC[INDEPENDENT_INSERT]; ALL_TAC] THEN MP_TAC(ISPECL [`v:real^N->bool`; `(a:real^N) INSERT b`] INDEPENDENT_CARD_LE_DIM) THEN ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; INDEPENDENT_BOUND] THEN ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; ARITH_RULE `x <= y ==> ~(SUC y <= x)`]);; let CARD_LE_DIM_SPANNING = prove (`!v b:real^N->bool. v SUBSET (span b) /\ FINITE b /\ CARD(b) <= dim v ==> independent b`, REPEAT STRIP_TAC THEN REWRITE_TAC[independent; dependent] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `dim(v:real^N->bool) <= CARD(b DELETE (a:real^N))` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[CARD_DELETE] THEN MATCH_MP_TAC (ARITH_RULE `b <= n /\ ~(b = 0) ==> ~(n <= b - 1)`) THEN ASM_SIMP_TAC[CARD_EQ_0] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_SIMP_TAC[FINITE_DELETE] THEN REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `a:real^N` THEN ASM_SIMP_TAC[SET_RULE `a IN b ==> (a INSERT (b DELETE a) = b)`] THEN ASM_MESON_TAC[SUBSET]);; let CARD_EQ_DIM = prove (`!v b. b SUBSET v /\ b HAS_SIZE (dim v) ==> (independent b <=> v SUBSET (span b))`, REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN MESON_TAC[CARD_LE_DIM_SPANNING; CARD_GE_DIM_INDEPENDENT]);; (* ------------------------------------------------------------------------- *) (* More general size bound lemmas. *) (* ------------------------------------------------------------------------- *) let INDEPENDENT_BOUND_GENERAL = prove (`!s:real^N->bool. independent s ==> FINITE s /\ CARD(s) <= dim(s)`, MESON_TAC[INDEPENDENT_CARD_LE_DIM; INDEPENDENT_BOUND; SUBSET_REFL]);; let DEPENDENT_BIGGERSET_GENERAL = prove (`!s:real^N->bool. (FINITE s ==> CARD(s) > dim(s)) ==> dependent s`, MP_TAC INDEPENDENT_BOUND_GENERAL THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);; let DIM_SPAN = prove (`!s:real^N->bool. dim(span s) = dim s`, GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC DIM_SUBSET THEN MESON_TAC[SUBSET; SPAN_SUPERSET]] THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN MATCH_MP_TAC SPAN_MONO THEN ASM_REWRITE_TAC[]);; let DIM_INSERT_0 = prove (`!s:real^N->bool. dim(vec 0 INSERT s) = dim s`, ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN REWRITE_TAC[SPAN_INSERT_0]);; let DIM_EQ_CARD = prove (`!s:real^N->bool. independent s ==> dim s = CARD s`, REPEAT STRIP_TAC THEN MP_TAC (ISPECL [`span s:real^N->bool`; `s:real^N->bool`] BASIS_CARD_EQ_DIM) THEN ASM_SIMP_TAC[SUBSET_REFL; SPAN_INC; DIM_SPAN]);; let DEPENDENT_EQ_DIM_LT_CARD = prove (`!s:real^N->bool. dependent s <=> FINITE s ==> dim s < CARD s`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[GSYM GT; DEPENDENT_BIGGERSET_GENERAL] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[GSYM independent; NOT_IMP] THEN STRIP_TAC THEN MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SPAN_INC] THEN ASM_ARITH_TAC);; let INDEPENDENT_EQ_DIM_EQ_CARD = prove (`!s:real^N->bool. independent s <=> FINITE s /\ dim s = CARD s`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[DIM_EQ_CARD; INDEPENDENT_IMP_FINITE] THEN SIMP_TAC[DEPENDENT_EQ_DIM_LT_CARD; independent; LT_REFL]);; let SUBSET_LE_DIM = prove (`!s t:real^N->bool. s SUBSET (span t) ==> dim s <= dim t`, MESON_TAC[DIM_SPAN; DIM_SUBSET]);; let SPAN_EQ_DIM = prove (`!s t. span s = span t ==> dim s = dim t`, MESON_TAC[DIM_SPAN]);; let SPANS_IMAGE = prove (`!f b v. linear f /\ v SUBSET (span b) ==> (IMAGE f v) SUBSET span(IMAGE f b)`, SIMP_TAC[SPAN_LINEAR_IMAGE; IMAGE_SUBSET]);; let DIM_LINEAR_IMAGE_LE = prove (`!f:real^M->real^N s. linear f ==> dim(IMAGE f s) <= dim s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^M->bool` BASIS_EXISTS) THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (f:real^M->real^N) b)` THEN ASM_SIMP_TAC[CARD_IMAGE_LE] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_MESON_TAC[SPAN_LINEAR_IMAGE; SPANS_IMAGE; SUBSET_IMAGE; FINITE_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Some stepping theorems. *) (* ------------------------------------------------------------------------- *) let DIM_EMPTY = prove (`dim({}:real^N->bool) = 0`, MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{}:real^N->bool` THEN REWRITE_TAC[SUBSET_REFL; SPAN_EMPTY; INDEPENDENT_EMPTY; HAS_SIZE_0; EMPTY_SUBSET]);; let DIM_INSERT = prove (`!x:real^N s. dim(x INSERT s) = if x IN span s then dim s else dim s + 1`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [MATCH_MP_TAC SPAN_EQ_DIM THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_MESON_TAC[SPAN_TRANS; SUBSET; SPAN_MONO; IN_INSERT]; ALL_TAC] THEN X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `(x:real^N) INSERT b` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[INSERT_SUBSET] THEN ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT; SPAN_SUPERSET]; REWRITE_TAC[SUBSET; SPAN_BREAKDOWN_EQ] THEN ASM_MESON_TAC[SUBSET]; REWRITE_TAC[INDEPENDENT_INSERT] THEN ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN]; RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; ADD1] THEN ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN]]);; let DIM_SING = prove (`!x. dim{x} = if x = vec 0 then 0 else 1`, REWRITE_TAC[DIM_INSERT; DIM_EMPTY; SPAN_EMPTY; IN_SING; ARITH]);; let DIM_EQ_0 = prove (`!s:real^N->bool. dim s = 0 <=> s SUBSET {vec 0}`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MATCH_MP_TAC(SET_RULE `~(?b. ~(b = a) /\ {b} SUBSET s) ==> s SUBSET {a}`) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIM_SUBSET); MATCH_MP_TAC(ARITH_RULE `!m. m = 0 /\ n <= m ==> n = 0`) THEN EXISTS_TAC `dim{vec 0:real^N}` THEN ASM_SIMP_TAC[DIM_SUBSET]] THEN ASM_REWRITE_TAC[DIM_SING; ARITH]);; (* ------------------------------------------------------------------------- *) (* Choosing a subspace of a given dimension. *) (* ------------------------------------------------------------------------- *) let CHOOSE_SUBSPACE_OF_SUBSPACE = prove (`!s:real^N->bool n. n <= dim s ==> ?t. subspace t /\ t SUBSET span s /\ dim t = n`, GEN_TAC THEN INDUCT_TAC THENL [DISCH_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN REWRITE_TAC[SUBSPACE_TRIVIAL; DIM_SING; SING_SUBSET; SPAN_0]; DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `span (s:real^N->bool) SUBSET span t` THENL [SUBGOAL_THEN `dim(s:real^N->bool) = dim(t:real^N->bool)` MP_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC SPAN_EQ_DIM THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM_REWRITE_TAC[SUBSPACE_SPAN]; FIRST_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC o MATCH_MP(SET_RULE `~(s SUBSET t) ==> ?a. a IN s /\ ~(a IN t)`)) THEN EXISTS_TAC `span((y:real^N) INSERT t)` THEN REWRITE_TAC[SUBSPACE_SPAN] THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM_REWRITE_TAC[SUBSPACE_SPAN] THEN ASM SET_TAC[]; ASM_REWRITE_TAC[DIM_SPAN; DIM_INSERT; ADD1]]]]);; let SUBSPACE_EXISTS = prove (`!n. n <= dimindex(:N) ==> ?s:real^N->bool. subspace s /\ dim s = n`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Relation between bases and injectivity/surjectivity of map. *) (* ------------------------------------------------------------------------- *) let SPANNING_SURJECTIVE_IMAGE = prove (`!f:real^M->real^N s. UNIV SUBSET (span s) /\ linear f /\ (!y. ?x. f(x) = y) ==> UNIV SUBSET span(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^N) UNIV` THEN ASM_SIMP_TAC[SPANS_IMAGE] THEN REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN ASM_MESON_TAC[]);; let INDEPENDENT_INJECTIVE_IMAGE_GEN = prove (`!f:real^M->real^N s. independent s /\ linear f /\ (!x y. x IN span s /\ y IN span s /\ f(x) = f(y) ==> x = y) ==> independent (IMAGE f s)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[independent; DEPENDENT_EXPLICIT] THEN REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[MESON[] `(?s u. ((?t. p t /\ s = f t) /\ q s u) /\ r s u) <=> (?t u. p t /\ q (f t) u /\ r (f t) u)`] THEN REWRITE_TAC[EXISTS_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^N->real`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MAP_EVERY EXISTS_TAC [`t:real^M->bool`; `(u:real^N->real) o (f:real^M->real^N)`] THEN ASM_REWRITE_TAC[o_THM] THEN FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; REWRITE_TAC[SPAN_0]; ASM_SIMP_TAC[LINEAR_VSUM] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN ASM_SIMP_TAC[o_DEF; LINEAR_CMUL] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[SPAN_SUPERSET; SUBSET]]);; let INDEPENDENT_INJECTIVE_IMAGE = prove (`!f:real^M->real^N s. independent s /\ linear f /\ (!x y. (f(x) = f(y)) ==> (x = y)) ==> independent (IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Picking an orthogonal replacement for a spanning set. *) (* ------------------------------------------------------------------------- *) let VECTOR_SUB_PROJECT_ORTHOGONAL = prove (`!b:real^N x. b dot (x - ((b dot x) / (b dot b)) % b) = &0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b = vec 0 :real^N` THENL [ASM_REWRITE_TAC[DOT_LZERO]; ALL_TAC] THEN ASM_SIMP_TAC[DOT_RSUB; DOT_RMUL] THEN ASM_SIMP_TAC[REAL_SUB_REFL; REAL_DIV_RMUL; DOT_EQ_0]);; let BASIS_ORTHOGONAL = prove (`!b:real^N->bool. FINITE b ==> ?c. FINITE c /\ CARD c <= CARD b /\ span c = span b /\ pairwise orthogonal c`, REWRITE_TAC[pairwise; orthogonal] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [EXISTS_TAC `{}:real^N->bool` THEN REWRITE_TAC[FINITE_RULES; NOT_IN_EMPTY; LE_REFL]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N->bool`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) STRIP_ASSUME_TAC) THEN EXISTS_TAC `(a - vsum c (\x. ((x dot a) / (x dot x)) % x):real^N) INSERT c` THEN ASM_SIMP_TAC[FINITE_RULES; CARD_CLAUSES] THEN REPEAT CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[EXTENSION; SPAN_BREAKDOWN_EQ] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN REWRITE_TAC[VECTOR_ARITH `a - (x - y):real^N = y + (a - x)`] THEN MATCH_MP_TAC SPAN_ADD_EQ THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_SIMP_TAC[SPAN_SUPERSET]; REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[]; FIRST_X_ASSUM SUBST_ALL_TAC; FIRST_X_ASSUM SUBST_ALL_TAC; ASM_MESON_TAC[]] THEN REWRITE_TAC[DOT_LSUB; DOT_RSUB; REAL_SUB_0] THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`)) THEN ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `s = &0 /\ a = b ==> b = a + s`) THEN ASM_SIMP_TAC[DOT_LSUM; DOT_RSUM; FINITE_DELETE] THEN (CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_0 THEN ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; IN_DELETE; REAL_MUL_RZERO; REAL_MUL_LZERO]; W(MP_TAC o PART_MATCH (lhand o rand) REAL_DIV_RMUL o lhand o snd) THEN REWRITE_TAC[DOT_SYM] THEN MATCH_MP_TAC(TAUT `(p ==> q) ==> (~p ==> q) ==> q`) THEN SIMP_TAC[] THEN SIMP_TAC[DOT_EQ_0; DOT_RZERO; DOT_LZERO] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]])]);; let ORTHOGONAL_BASIS_EXISTS = prove (`!v:real^N->bool. ?b. independent b /\ b SUBSET span v /\ v SUBSET span b /\ b HAS_SIZE dim v /\ pairwise orthogonal b`, GEN_TAC THEN MP_TAC(ISPEC `v:real^N->bool` BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(SPEC `b:real^N->bool` BASIS_ORTHOGONAL) THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `span(v):real^N->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO]; ASM_MESON_TAC[LE_TRANS; HAS_SIZE; DIM_SPAN]]; ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC; SPAN_SPAN; SPAN_MONO]; RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN CONJ_TAC THENL [ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO; SUBSET_TRANS; SPAN_INC]]);; let SPAN_EQ = prove (`!s t. span s = span t <=> s SUBSET span t /\ t SUBSET span s`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN MESON_TAC[SUBSET_TRANS; SPAN_SPAN; SPAN_MONO; SPAN_INC]);; let SPAN_EQ_INSERT = prove (`!s x. span(x INSERT s) = span s <=> x IN span s`, REWRITE_TAC[SPAN_EQ; INSERT_SUBSET] THEN MESON_TAC[SPAN_INC; SUBSET; SET_RULE `s SUBSET (x INSERT s)`]);; let SPAN_SPECIAL_SCALE = prove (`!s a x:real^N. span((a % x) INSERT s) = if a = &0 then span s else span(x INSERT s)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; SPAN_INSERT_0] THEN REWRITE_TAC[SPAN_EQ; SUBSET; FORALL_IN_INSERT] THEN SIMP_TAC[SPAN_MUL; SPAN_SUPERSET; IN_INSERT] THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ] THEN EXISTS_TAC `inv a:real` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN REWRITE_TAC[SPAN_0; VECTOR_SUB_REFL]);; (* ------------------------------------------------------------------------- *) (* We can extend a linear basis-basis injection to the whole set. *) (* ------------------------------------------------------------------------- *) let LINEAR_INDEP_IMAGE_LEMMA = prove (`!f b. linear(f:real^M->real^N) /\ FINITE b /\ independent (IMAGE f b) /\ (!x y. x IN b /\ y IN b /\ (f x = f y) ==> (x = y)) ==> !x. x IN span b ==> (f(x) = vec 0) ==> (x = vec 0)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV) [IMP_IMP] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [SIMP_TAC[IN_SING; SPAN_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN STRIP_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ANTS_TAC THENL [ASM_MESON_TAC[INDEPENDENT_MONO; IMAGE_CLAUSES; SUBSET; IN_INSERT]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MP_TAC(ISPECL [`a:real^M`; `(a:real^M) INSERT b`; `x:real^M`] SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN SIMP_TAC[ASSUME `~((a:real^M) IN b)`; SET_RULE `~(a IN b) ==> ((a INSERT b) DELETE a = b)`] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN SUBGOAL_THEN `(f:real^M->real^N)(x - k % a) IN span(IMAGE f b)` MP_TAC THENL [ASM_MESON_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE]; ALL_TAC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_SUB th]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN ASM_REWRITE_TAC[VECTOR_ARITH `vec 0 - k % x = (--k) % x`] THEN ASM_CASES_TAC `k = &0` THENL [ASM_MESON_TAC[VECTOR_ARITH `x - &0 % y = x`]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `--inv(k)` o MATCH_MP SPAN_MUL) THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN SIMP_TAC[REAL_NEGNEG; REAL_MUL_LINV; ASSUME `~(k = &0)`] THEN REWRITE_TAC[VECTOR_MUL_LID] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) a`) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) (a INSERT b) DELETE f a = IMAGE f ((a INSERT b) DELETE a)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_INSERT] THEN ASM_MESON_TAC[IN_INSERT]; ALL_TAC] THEN ASM_REWRITE_TAC[DELETE_INSERT] THEN SIMP_TAC[SET_RULE `~(a IN b) ==> (b DELETE a = b)`; ASSUME `~(a:real^M IN b)`] THEN SIMP_TAC[IMAGE_CLAUSES; IN_INSERT]);; (* ------------------------------------------------------------------------- *) (* We can extend a linear mapping from basis. *) (* ------------------------------------------------------------------------- *) let LINEAR_INDEPENDENT_EXTEND_LEMMA = prove (`!f b. FINITE b ==> independent b ==> ?g:real^M->real^N. (!x y. x IN span b /\ y IN span b ==> (g(x + y) = g(x) + g(y))) /\ (!x c. x IN span b ==> (g(c % x) = c % g(x))) /\ (!x. x IN b ==> (g x = f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY; INDEPENDENT_INSERT] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN SIMP_TAC[SPAN_EMPTY] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `h = \z:real^M. @k. (z - k % a) IN span b` THEN SUBGOAL_THEN `!z:real^M. z IN span(a INSERT b) ==> (z - h(z) % a) IN span(b) /\ !k. (z - k % a) IN span(b) ==> (k = h(z))` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [EXPAND_TAC "h" THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[SPAN_BREAKDOWN_EQ]; ALL_TAC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SPAN_SUB) THEN REWRITE_TAC[VECTOR_ARITH `(z - a % v) - (z - b % v) = (b - a) % v`] THEN ASM_CASES_TAC `k = (h:real^M->real) z` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `inv(k - (h:real^M->real) z)` o MATCH_MP SPAN_MUL) THEN ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_ASSOC; REAL_SUB_0] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID]; ALL_TAC] THEN REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN GEN_REWRITE_TAC LAND_CONV [FORALL_AND_THM] THEN STRIP_TAC THEN EXISTS_TAC `\z:real^M. h(z) % (f:real^M->real^N)(a) + g(z - h(z) % a)` THEN REPEAT CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN SUBGOAL_THEN `(h:real^M->real)(x + y) = h(x) + h(y)` ASSUME_TAC THENL [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_ARITH `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_ADD THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[VECTOR_ARITH `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC; MAP_EVERY X_GEN_TAC [`x:real^M`; `c:real`] THEN STRIP_TAC THEN SUBGOAL_THEN `(h:real^M->real)(c % x) = c * h(x)` ASSUME_TAC THENL [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[VECTOR_ARITH `c % x - (c * k) % a = c % (x - k % a)`] THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[VECTOR_ARITH `c % x - (c * k) % a = c % (x - k % a)`] THEN ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INSERT] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THENL [SUBGOAL_THEN `&1 = h(a:real^M)` (SUBST1_TAC o SYM) THENL [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `a - &1 % a = vec 0`; SPAN_0] THENL [ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; IN_INSERT]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^M`; `vec 0:real^M`]) THEN REWRITE_TAC[SPAN_0; VECTOR_ADD_LID] THEN REWRITE_TAC[VECTOR_ARITH `(a = a + a) <=> (a = vec 0)`] THEN DISCH_THEN SUBST1_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `&0 = h(x:real^M)` (SUBST1_TAC o SYM) THENL [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN ASM_MESON_TAC[SUBSET; IN_INSERT; SPAN_SUPERSET]);; let LINEAR_INDEPENDENT_EXTEND = prove (`!f b. independent b ==> ?g:real^M->real^N. linear g /\ (!x. x IN b ==> (g x = f x))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`b:real^M->bool`; `(:real^M)`] MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN ASM_REWRITE_TAC[SUBSET_UNIV; UNIV_SUBSET] THEN REWRITE_TAC[EXTENSION; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`] LINEAR_INDEPENDENT_EXTEND_LEMMA) THEN ASM_SIMP_TAC[INDEPENDENT_BOUND; linear] THEN ASM_MESON_TAC[SUBSET]);; (* ------------------------------------------------------------------------- *) (* Linear functions are equal on a subspace if they are on a spanning set. *) (* ------------------------------------------------------------------------- *) let SUBSPACE_KERNEL = prove (`!f. linear f ==> subspace {x | f(x) = vec 0}`, REWRITE_TAC[subspace; IN_ELIM_THM] THEN SIMP_TAC[LINEAR_ADD; LINEAR_CMUL; VECTOR_ADD_LID; VECTOR_MUL_RZERO] THEN MESON_TAC[LINEAR_0]);; let LINEAR_EQ_0_SPAN = prove (`!f:real^M->real^N b. linear f /\ (!x. x IN b ==> f(x) = vec 0) ==> !x. x IN span(b) ==> f(x) = vec 0`, REPEAT GEN_TAC THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[IN] THEN MP_TAC(ISPEC `f:real^M->real^N` SUBSPACE_KERNEL) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]);; let LINEAR_EQ_0 = prove (`!f b s. linear f /\ s SUBSET (span b) /\ (!x. x IN b ==> f(x) = vec 0) ==> !x. x IN s ==> f(x) = vec 0`, MESON_TAC[LINEAR_EQ_0_SPAN; SUBSET]);; let LINEAR_EQ = prove (`!f g b s. linear f /\ linear g /\ s SUBSET (span b) /\ (!x. x IN b ==> f(x) = g(x)) ==> !x. x IN s ==> f(x) = g(x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN STRIP_TAC THEN MATCH_MP_TAC LINEAR_EQ_0 THEN ASM_MESON_TAC[LINEAR_COMPOSE_SUB]);; let LINEAR_EQ_STDBASIS = prove (`!f:real^M->real^N g. linear f /\ linear g /\ (!i. 1 <= i /\ i <= dimindex(:M) ==> f(basis i) = g(basis i)) ==> f = g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. x IN UNIV ==> (f:real^M->real^N) x = g x` (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN MATCH_MP_TAC LINEAR_EQ THEN EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; let SUBSPACE_LINEAR_FIXED_POINTS = prove (`!f:real^N->real^N. linear f ==> subspace {x | f(x) = x}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC SUBSPACE_KERNEL THEN ASM_SIMP_TAC[LINEAR_COMPOSE_SUB; LINEAR_ID]);; (* ------------------------------------------------------------------------- *) (* Similar results for bilinear functions. *) (* ------------------------------------------------------------------------- *) let BILINEAR_EQ = prove (`!f:real^M->real^N->real^P g b c s. bilinear f /\ bilinear g /\ s SUBSET (span b) /\ t SUBSET (span c) /\ (!x y. x IN b /\ y IN c ==> f x y = g x y) ==> !x y. x IN s /\ y IN t ==> f x y = g x y`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x:real^M. x IN span b ==> !y:real^N. y IN span c ==> (f x y :real^P = g x y)` (fun th -> ASM_MESON_TAC[th; SUBSET]) THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC; ASM_SIMP_TAC[BILINEAR_LADD; BILINEAR_LMUL] THEN ASM_MESON_TAC[BILINEAR_LZERO]] THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RMUL] THEN ASM_MESON_TAC[BILINEAR_RZERO]);; let BILINEAR_EQ_STDBASIS = prove (`!f:real^M->real^N->real^P g. bilinear f /\ bilinear g /\ (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) ==> f (basis i) (basis j) = g (basis i) (basis j)) ==> f = g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x y. x IN UNIV /\ y IN UNIV ==> (f:real^M->real^N->real^P) x y = g x y` (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN MATCH_MP_TAC BILINEAR_EQ THEN EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Detailed theorems about left and right invertibility in general case. *) (* ------------------------------------------------------------------------- *) let LEFT_INVERTIBLE_TRANSP = prove (`!A:real^N^M. (?B:real^N^M. B ** transp A = mat 1) <=> (?B:real^M^N. A ** B = mat 1)`, MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);; let RIGHT_INVERTIBLE_TRANSP = prove (`!A:real^N^M. (?B:real^N^M. transp A ** B = mat 1) <=> (?B:real^M^N. B ** A = mat 1)`, MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);; let INVERTIBLE_TRANSP = prove (`!A:real^N^M. invertible(transp A) <=> invertible A`, GEN_TAC THEN REWRITE_TAC[invertible] THEN GEN_REWRITE_TAC LAND_CONV [MESON[TRANSP_TRANSP] `(?A:real^M^N. P A) <=> (?A:real^N^M. P(transp A))`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_MAT] THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRANSP_EQ] THEN MESON_TAC[]);; let LINEAR_INJECTIVE_LEFT_INVERSE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> ?g. linear g /\ g o f = I`, REWRITE_TAC[INJECTIVE_LEFT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?h. linear(h:real^N->real^M) /\ !x. x IN IMAGE (f:real^M->real^N) {basis i | 1 <= i /\ i <= dimindex(:M)} ==> h x = g x` MP_TAC THENL [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE THEN ASM_MESON_TAC[INJECTIVE_LEFT_INVERSE; INDEPENDENT_STDBASIS]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN ASM_MESON_TAC[]]);; let LINEAR_INJECTIVE_LEFT_INVERSE_EQ = prove (`!f:real^M->real^N. linear f ==> ((!x y. f x = f y ==> x = y) <=> ?g. linear g /\ g o f = I)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]; REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]]);; let LINEAR_SURJECTIVE_RIGHT_INVERSE = prove (`!f:real^M->real^N. linear f /\ (!y. ?x. f x = y) ==> ?g. linear g /\ f o g = I`, REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?h. linear(h:real^N->real^M) /\ !x. x IN {basis i | 1 <= i /\ i <= dimindex(:N)} ==> h x = g x` MP_TAC THENL [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN REWRITE_TAC[INDEPENDENT_STDBASIS]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN ASM_MESON_TAC[]]);; let LINEAR_SURJECTIVE_RIGHT_INVERSE_EQ = prove (`!f:real^M->real^N. linear f ==> ((!y. ?x. f x = y) <=> ?g. linear g /\ f o g = I)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[LINEAR_SURJECTIVE_RIGHT_INVERSE]; REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]]);; let MATRIX_LEFT_INVERTIBLE_INJECTIVE = prove (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> !x y:real^N. A ** x = A ** y ==> x = y`, GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^M. (B:real^M^N) ** x`) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; DISCH_TAC THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^M) ** x` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `matrix(g):real^M^N` THEN REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);; let MATRIX_LEFT_INVERTIBLE_KER = prove (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> !x. A ** x = vec 0 ==> x = vec 0`, GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN MATCH_MP_TAC LINEAR_INJECTIVE_0 THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; let MATRIX_RIGHT_INVERTIBLE_SURJECTIVE = prove (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> !y:real^M. ?x. A ** x = y`, GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN X_GEN_TAC `y:real^M` THEN EXISTS_TAC `(B:real^M^N) ** (y:real^M)` THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; DISCH_TAC THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^M) ** x` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `matrix(g):real^M^N` THEN REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);; let MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS = prove (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> !c. vsum(1..dimindex(:N)) (\i. c(i) % column i A) = vec 0 ==> !i. 1 <= i /\ i <= dimindex(:N) ==> c(i) = &0`, GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_KER; MATRIX_MUL_VSUM] THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `c:num->real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. c(i)):real^N`); X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\i. (x:real^N)$i`)] THEN ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; VEC_COMPONENT]);; let MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS = prove (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> !c. vsum(1..dimindex(:M)) (\i. c(i) % row i A) = vec 0 ==> !i. 1 <= i /\ i <= dimindex(:M) ==> c(i) = &0`, ONCE_REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS] THEN SIMP_TAC[COLUMN_TRANSP]);; let MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS = prove (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> span(columns A) = (:real^M)`, GEN_TAC THEN REWRITE_TAC[MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN REWRITE_TAC[MATRIX_MUL_VSUM; EXTENSION; IN_UNIV] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^M` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM)) THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN REWRITE_TAC[columns; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SPEC_TAC(`y:real^M`,`y:real^M`) THEN MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL [EXISTS_TAC `vec 0 :real^N` THEN SIMP_TAC[VEC_COMPONENT; VECTOR_MUL_LZERO; VSUM_0]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`c:real`; `y1:real^M`; `y2:real^M`] THEN REWRITE_TAC[columns; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM))) THEN EXISTS_TAC `(lambda j. if j = i then c + (x:real^N)$i else x$j):real^N` THEN SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)` SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_RDISTRIB; VECTOR_ADD_ASSOC] THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[FINITE_DELETE; IN_DELETE; FINITE_NUMSEG; LAMBDA_BETA; IN_NUMSEG]);; let MATRIX_LEFT_INVERTIBLE_SPAN_ROWS = prove (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> span(rows A) = (:real^N)`, MESON_TAC[RIGHT_INVERTIBLE_TRANSP; COLUMNS_TRANSP; MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS]);; let MATRIX_LEFT_INVERTIBLE_NULLSPACE = prove (`!A:real^M^N. (?B:real^N^M. B ** A = mat 1) <=> (!x. A ** x = vec 0 ==> x = vec 0)`, GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN MATCH_MP_TAC LINEAR_INJECTIVE_0 THEN SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR]);; (* ------------------------------------------------------------------------- *) (* An injective map real^N->real^N is also surjective. *) (* ------------------------------------------------------------------------- *) let LINEAR_INJECTIVE_IMP_SURJECTIVE = prove (`!f:real^N->real^N. linear f /\ (!x y. (f(x) = f(y)) ==> (x = y)) ==> !y. ?x. f(x) = y`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `UNIV SUBSET span(IMAGE (f:real^N->real^N) b)` MP_TAC THENL [MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN ASM_MESON_TAC[INDEPENDENT_INJECTIVE_IMAGE; LE_REFL; SUBSET_UNIV; CARD_IMAGE_INJ]; ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN ASM_MESON_TAC[SUBSET; IN_IMAGE; IN_UNIV]]);; (* ------------------------------------------------------------------------- *) (* And vice versa. *) (* ------------------------------------------------------------------------- *) let LINEAR_SURJECTIVE_IMP_INJECTIVE = prove (`!f:real^N->real^N. linear f /\ (!y. ?x. f(x) = y) ==> !x y. (f(x) = f(y)) ==> (x = y)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!x. x IN span b ==> (f:real^N->real^N) x = vec 0 ==> x = vec 0` (fun th -> ASM_MESON_TAC[th; LINEAR_INJECTIVE_0; SUBSET; IN_UNIV]) THEN MATCH_MP_TAC LINEAR_INDEP_IMAGE_LEMMA THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN EXISTS_TAC `(:real^N)` THEN ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE; SPAN_LINEAR_IMAGE] THEN REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN ASM_MESON_TAC[CARD_IMAGE_LE; SUBSET; IN_UNIV]; ALL_TAC] THEN SUBGOAL_THEN `dim(:real^N) <= CARD(IMAGE (f:real^N->real^N) b)` MP_TAC THENL [MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE] THEN ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `IMAGE (f:real^N->real^N) UNIV` THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN ASM_REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o ISPEC `f:real^N->real^N` o MATCH_MP CARD_IMAGE_LE) THEN ASM_REWRITE_TAC[IMP_IMP; LE_ANTISYM] THEN DISCH_TAC THEN MP_TAC(ISPECL [`b:real^N->bool`; `IMAGE (f:real^N->real^N) b`; `f:real^N->real^N`] SURJECTIVE_IFF_INJECTIVE_GEN) THEN ASM_SIMP_TAC[FINITE_IMAGE; INDEPENDENT_BOUND; SUBSET_REFL] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN MESON_TAC[]);; let LINEAR_SURJECTIVE_IFF_INJECTIVE = prove (`!f:real^N->real^N. linear f ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`, MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE; LINEAR_SURJECTIVE_IMP_INJECTIVE]);; (* ------------------------------------------------------------------------- *) (* Hence either is enough for isomorphism. *) (* ------------------------------------------------------------------------- *) let LEFT_RIGHT_INVERSE_EQ = prove (`!f:A->A g h. f o g = I /\ g o h = I ==> f = h`, MESON_TAC[o_ASSOC; I_O_ID]);; let ISOMORPHISM_EXPAND = prove (`!f g. f o g = I /\ g o f = I <=> (!x. f(g x) = x) /\ (!x. g(f x) = x)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; let LINEAR_INJECTIVE_ISOMORPHISM = prove (`!f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);; let LINEAR_SURJECTIVE_ISOMORPHISM = prove (`!f:real^N->real^N. linear f /\ (!y. ?x. f x = y) ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_IMP_INJECTIVE) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);; (* ------------------------------------------------------------------------- *) (* Left and right inverses are the same for R^N->R^N. *) (* ------------------------------------------------------------------------- *) let LINEAR_INVERSE_LEFT = prove (`!f:real^N->real^N f'. linear f /\ linear f' ==> ((f o f' = I) <=> (f' o f = I))`, SUBGOAL_THEN `!f:real^N->real^N f'. linear f /\ linear f' /\ (f o f' = I) ==> (f' o f = I)` (fun th -> MESON_TAC[th]) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_ISOMORPHISM) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Moreover, a one-sided inverse is automatically linear. *) (* ------------------------------------------------------------------------- *) let LEFT_INVERSE_LINEAR = prove (`!f g:real^N->real^N. linear f /\ (g o f = I) ==> linear g`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)` CHOOSE_TAC THENL [MATCH_MP_TAC LINEAR_INJECTIVE_ISOMORPHISM THEN ASM_MESON_TAC[]; SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);; let RIGHT_INVERSE_LINEAR = prove (`!f g:real^N->real^N. linear f /\ (f o g = I) ==> linear g`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN STRIP_TAC THEN SUBGOAL_THEN `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)` CHOOSE_TAC THENL [ASM_MESON_TAC[LINEAR_SURJECTIVE_ISOMORPHISM]; ALL_TAC] THEN SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Without (ostensible) constraints on types, though dimensions must match. *) (* ------------------------------------------------------------------------- *) let LEFT_RIGHT_INVERSE_LINEAR = prove (`!f g:real^M->real^N. linear f /\ g o f = I /\ f o g = I ==> linear g`, REWRITE_TAC[linear; FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]);; let LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> ?g. linear g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BIJECTIVE_LEFT_RIGHT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LEFT_RIGHT_INVERSE_LINEAR THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; let LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ = prove (`!f:real^M->real^N. linear f ==> ((!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) <=> ?g. linear g /\ f o g = I /\ g o f = I)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC; MESON_TAC[]] THEN ASM METIS_TAC[LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE]);; let LINEAR_INJECTIVE_LEFT_RIGHT_INVERSE_EQ = prove (`!f:real^N->real^N. linear f ==> ((!x y. f x = f y ==> x = y) <=> (?g. linear g /\ f o g = I /\ g o f = I))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ) THEN ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; let LINEAR_SURJECTIVE_LEFT_RIGHT_INVERSE_EQ = prove (`!f:real^N->real^N. linear f ==> ((!y. ?x. f x = y) <=> (?g. linear g /\ f o g = I /\ g o f = I))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ) THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; (* ------------------------------------------------------------------------- *) (* The same result in terms of square matrices. *) (* ------------------------------------------------------------------------- *) let MATRIX_LEFT_RIGHT_INVERSE = prove (`!A:real^N^N A':real^N^N. (A ** A' = mat 1) <=> (A' ** A = mat 1)`, SUBGOAL_THEN `!A:real^N^N A':real^N^N. (A ** A' = mat 1) ==> (A' ** A = mat 1)` (fun th -> MESON_TAC[th]) THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\x:real^N. A:(real^N^N) ** x` LINEAR_SURJECTIVE_ISOMORPHISM) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN ANTS_TAC THENL [X_GEN_TAC `x:real^N` THEN EXISTS_TAC `(A':real^N^N) ** (x:real^N)` THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `matrix (f':real^N->real^N) ** (A:real^N^N) = mat 1` MP_TAC THENL [ASM_SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; GSYM MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; ALL_TAC] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o AP_TERM `(\m:real^N^N. m ** (A':real^N^N))`) THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_RID; MATRIX_MUL_LID] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Invertibility of matrices and corresponding linear functions. *) (* ------------------------------------------------------------------------- *) let MATRIX_LEFT_INVERTIBLE = prove (`!f:real^M->real^N. linear f ==> ((?B:real^N^M. B ** matrix f = mat 1) <=> (?g. linear g /\ g o f = I))`, GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MATCH_MP MATRIX_VECTOR_MUL th]) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; EXISTS_TAC `matrix(g:real^N->real^M)` THEN ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);; let MATRIX_RIGHT_INVERTIBLE = prove (`!f:real^M->real^N. linear f ==> ((?B:real^N^M. matrix f ** B = mat 1) <=> (?g. linear g /\ f o g = I))`, GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [MATCH_MP MATRIX_VECTOR_MUL th]) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; EXISTS_TAC `matrix(g:real^N->real^M)` THEN ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);; let INVERTIBLE_LEFT_INVERSE = prove (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. B ** A = mat 1`, MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);; let INVERTIBLE_RIGHT_INVERSE = prove (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. A ** B = mat 1`, MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);; let MATRIX_INVERTIBLE = prove (`!f:real^M->real^N. linear f ==> (invertible(matrix f) <=> ?g. linear g /\ f o g = I /\ g o f = I)`, REPEAT STRIP_TAC THEN REWRITE_TAC[invertible] THEN REWRITE_TAC[FUN_EQ_THM; MATRIX_EQ; MATRIX_VECTOR_MUL_LID; I_THM; o_THM] THEN ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `A:real^N^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:real^N. (A:real^N^M) ** x` THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]; DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `matrix(g:real^N->real^M)` THEN ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);; let INVERTIBLE_EQ_INJECTIVE_AND_SURJECTIVE = prove (`!m:real^M^N. invertible m <=> (!x y:real^M. m ** x = m ** y ==> x = y) /\ IMAGE (\x. m ** x) (:real^M) = (:real^N)`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `\x:real^M. (m:real^M^N) ** x` MATRIX_INVERTIBLE) THEN REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[GSYM LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ; MATRIX_VECTOR_MUL_LINEAR] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Left-invertible linear transformation has a lower bound. *) (* ------------------------------------------------------------------------- *) let LINEAR_INVERTIBLE_BOUNDED_BELOW_POS = prove (`!f:real^M->real^N g. linear f /\ linear g /\ (g o f = I) ==> ?B. &0 < B /\ !x. B * norm(x) <= norm(f x)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `g:real^N->real^M` LINEAR_BOUNDED_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv B:real` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(B) * norm(((g:real^N->real^M) o (f:real^M->real^N)) x)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[I_THM; REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN ASM_SIMP_TAC[o_THM; REAL_LE_LDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]);; let LINEAR_INVERTIBLE_BOUNDED_BELOW = prove (`!f:real^M->real^N g. linear f /\ linear g /\ (g o f = I) ==> ?B. !x. B * norm(x) <= norm(f x)`, MESON_TAC[LINEAR_INVERTIBLE_BOUNDED_BELOW_POS]);; let LINEAR_INJECTIVE_BOUNDED_BELOW_POS = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> ?B. &0 < B /\ !x. norm(x) * B <= norm(f x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC LINEAR_INVERTIBLE_BOUNDED_BELOW_POS THEN ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]);; (* ------------------------------------------------------------------------- *) (* Preservation of dimension by injective map. *) (* ------------------------------------------------------------------------- *) let DIM_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> dim(IMAGE f s) = dim s`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIM_LINEAR_IMAGE_LE]; ALL_TAC] THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim(IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; LE_REFL]; MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]]);; let LINEAR_INJECTIVE_DIMINDEX_LE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> dimindex(:M) <= dimindex(:N)`, REWRITE_TAC[GSYM DIM_UNIV] THEN REPEAT GEN_TAC THEN DISCH_THEN (SUBST1_TAC o SYM o SPEC `(:real^M)` o MATCH_MP DIM_INJECTIVE_LINEAR_IMAGE) THEN MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; let LINEAR_SURJECTIVE_DIMINDEX_LE = prove (`!f:real^M->real^N. linear f /\ (!y. ?x. f x = y) ==> dimindex(:N) <= dimindex(:M)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE THEN EXISTS_TAC `g:real^N->real^M` THEN ASM_MESON_TAC[]);; let LINEAR_BIJECTIVE_DIMINDEX_EQ = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> dimindex(:M) = dimindex(:N)`, REWRITE_TAC[GSYM LE_ANTISYM] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE; MATCH_MP_TAC LINEAR_SURJECTIVE_DIMINDEX_LE] THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[]);; let INVERTIBLE_IMP_SQUARE_MATRIX = prove (`!A:real^N^M. invertible A ==> dimindex(:M) = dimindex(:N)`, GEN_TAC THEN REWRITE_TAC[invertible; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `B:real^M^N` THEN STRIP_TAC THEN MATCH_MP_TAC LINEAR_BIJECTIVE_DIMINDEX_EQ THEN EXISTS_TAC `\x:real^M. (B:real^M^N) ** x` THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE; GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Considering an n-element vector as an n-by-1 or 1-by-n matrix. *) (* ------------------------------------------------------------------------- *) let rowvector = new_definition `(rowvector:real^N->real^N^1) v = lambda i j. v$j`;; let columnvector = new_definition `(columnvector:real^N->real^1^N) v = lambda i j. v$i`;; let TRANSP_COLUMNVECTOR = prove (`!v. transp(columnvector v) = rowvector v`, SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);; let TRANSP_ROWVECTOR = prove (`!v. transp(rowvector v) = columnvector v`, SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);; let DOT_ROWVECTOR_COLUMNVECTOR = prove (`!A:real^N^M v:real^N. columnvector(A ** v) = A ** columnvector v`, REWRITE_TAC[rowvector; columnvector; matrix_mul; matrix_vector_mul] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);; let DOT_MATRIX_PRODUCT = prove (`!x y:real^N. x dot y = (rowvector x ** columnvector y)$1$1`, REWRITE_TAC[matrix_mul; columnvector; rowvector; dot] THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_1; LE_REFL]);; let DOT_MATRIX_VECTOR_MUL = prove (`!A:real^N^N B:real^N^N x:real^N y:real^N. (A ** x) dot (B ** y) = ((rowvector x) ** (transp(A) ** B) ** (columnvector y))$1$1`, REWRITE_TAC[DOT_MATRIX_PRODUCT] THEN ONCE_REWRITE_TAC[GSYM TRANSP_COLUMNVECTOR] THEN REWRITE_TAC[DOT_ROWVECTOR_COLUMNVECTOR; MATRIX_TRANSP_MUL] THEN REWRITE_TAC[MATRIX_MUL_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Rank of a matrix. Equivalence of row and column rank is taken from *) (* George Mackiw's paper, Mathematics Magazine 1995, p. 285. *) (* ------------------------------------------------------------------------- *) let MATRIX_VECTOR_MUL_IN_COLUMNSPACE = prove (`!A:real^M^N x:real^M. (A ** x) IN span(columns A)`, REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_VECTOR_COLUMN; columns] THEN MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; transp; LAMBDA_BETA] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM; column] THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]);; let SUBSPACE_ORTHOGONAL_TO_VECTOR = prove (`!x. subspace {y | orthogonal x y}`, SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);; let SUBSPACE_ORTHOGONAL_TO_VECTORS = prove (`!s. subspace {y | (!x. x IN s ==> orthogonal x y)}`, SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);; let ORTHOGONAL_TO_SPAN = prove (`!s x. (!y. y IN s ==> orthogonal x y) ==> !y. y IN span(s) ==> orthogonal x y`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN ASM_SIMP_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM]);; let ORTHOGONAL_TO_SPAN_EQ = prove (`!s x. (!y. y IN span(s) ==> orthogonal x y) <=> (!y. y IN s ==> orthogonal x y)`, MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_TO_SPAN]);; let ORTHOGONAL_TO_SPANS_EQ = prove (`!s t. (!x y. x IN span(s) /\ y IN span(t) ==> orthogonal x y) <=> (!x y. x IN s /\ y IN t ==> orthogonal x y)`, MESON_TAC[ORTHOGONAL_TO_SPAN_EQ; ORTHOGONAL_SYM]);; let ORTHOGONAL_NULLSPACE_ROWSPACE = prove (`!A:real^M^N x y:real^M. A ** x = vec 0 /\ y IN span(rows A) ==> orthogonal x y`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; rows; FORALL_IN_GSPEC] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `\y:real^N. y$k`) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; VEC_COMPONENT; row; dot; orthogonal; LAMBDA_BETA] THEN REWRITE_TAC[REAL_MUL_SYM]);; let NULLSPACE_INTER_ROWSPACE = prove (`!A:real^M^N x:real^M. A ** x = vec 0 /\ x IN span(rows A) <=> x = vec 0`, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[ORTHOGONAL_NULLSPACE_ROWSPACE; ORTHOGONAL_REFL]; SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; SPAN_0]]);; let MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE = prove (`!A:real^M^N x y:real^M. x IN span(rows A) /\ y IN span(rows A) /\ A ** x = A ** y ==> x = y`, ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NULLSPACE_INTER_ROWSPACE] THEN ASM_SIMP_TAC[SPAN_SUB]);; let DIM_ROWS_LE_DIM_COLUMNS = prove (`!A:real^M^N. dim(rows A) <= dim(columns A)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC (ISPEC `span(rows(A:real^M^N))` BASIS_EXISTS) THEN SUBGOAL_THEN `FINITE(IMAGE (\x:real^M. (A:real^M^N) ** x) b) /\ CARD (IMAGE (\x:real^M. (A:real^M^N) ** x) b) <= dim(span(columns A))` MP_TAC THENL [MATCH_MP_TAC INDEPENDENT_CARD_LE_DIM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; MATRIX_VECTOR_MUL_IN_COLUMNSPACE] THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN SUBGOAL_THEN `span(b) = span(rows(A:real^M^N))` SUBST1_TAC THENL [ALL_TAC; ASM_MESON_TAC[MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE]] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN ASM_SIMP_TAC[SPAN_MONO]; DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM) o GEN_REWRITE_RULE I [HAS_SIZE]) THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC (ISPEC `A:real^M^N` MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE) THEN ASM SET_TAC[]]);; let rank = new_definition `rank(A:real^M^N) = dim(columns A)`;; let RANK_ROW = prove (`!A:real^M^N. rank(A) = dim(rows A)`, GEN_TAC THEN REWRITE_TAC[rank] THEN MP_TAC(ISPEC `A:real^M^N` DIM_ROWS_LE_DIM_COLUMNS) THEN MP_TAC(ISPEC `transp(A:real^M^N)` DIM_ROWS_LE_DIM_COLUMNS) THEN REWRITE_TAC[ROWS_TRANSP; COLUMNS_TRANSP] THEN ARITH_TAC);; let RANK_TRANSP = prove (`!A:real^M^N. rank(transp A) = rank A`, GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [RANK_ROW] THEN REWRITE_TAC[rank; COLUMNS_TRANSP]);; let MATRIX_VECTOR_MUL_BASIS = prove (`!A:real^M^N k. 1 <= k /\ k <= dimindex(:M) ==> A ** (basis k) = column k A`, SIMP_TAC[CART_EQ; column; MATRIX_VECTOR_MUL_COMPONENT; DOT_BASIS; LAMBDA_BETA]);; let COLUMNS_IMAGE_BASIS = prove (`!A:real^M^N. columns A = IMAGE (\x. A ** x) {basis i | 1 <= i /\ i <= dimindex(:M)}`, GEN_TAC THEN REWRITE_TAC[columns] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN SIMP_TAC[IN_ELIM_THM; MATRIX_VECTOR_MUL_BASIS]);; let RANK_DIM_IM = prove (`!A:real^M^N. rank A = dim(IMAGE (\x. A ** x) (:real^M))`, GEN_TAC THEN REWRITE_TAC[rank] THEN MATCH_MP_TAC SPAN_EQ_DIM THEN REWRITE_TAC[COLUMNS_IMAGE_BASIS] THEN SIMP_TAC[SPAN_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SPAN_SPAN] THEN REWRITE_TAC[SPAN_STDBASIS]);; let DIM_EQ_SPAN = prove (`!s t:real^N->bool. s SUBSET t /\ dim t <= dim s ==> span s = span t`, REPEAT STRIP_TAC THEN X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN MP_TAC(ISPECL [`span t:real^N->bool`; `b:real^N->bool`] CARD_GE_DIM_INDEPENDENT) THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_REWRITE_TAC[DIM_SPAN] THEN ASM_MESON_TAC[SPAN_MONO; SPAN_SPAN; SUBSET_TRANS; SUBSET_ANTISYM]);; let DIM_EQ_FULL = prove (`!s:real^N->bool. dim s = dimindex(:N) <=> span s = (:real^N)`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN EQ_TAC THEN SIMP_TAC[DIM_UNIV] THEN DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_UNIV] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV] THEN ASM_MESON_TAC[LE_REFL; DIM_SPAN]);; let DIM_PSUBSET = prove (`!s t. (span s) PSUBSET (span t) ==> dim s < dim t`, ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN SIMP_TAC[PSUBSET; DIM_SUBSET; LT_LE] THEN MESON_TAC[EQ_IMP_LE; DIM_EQ_SPAN; SPAN_SPAN]);; let RANK_BOUND = prove (`!A:real^M^N. rank(A) <= MIN (dimindex(:M)) (dimindex(:N))`, GEN_TAC THEN REWRITE_TAC[ARITH_RULE `x <= MIN a b <=> x <= a /\ x <= b`] THEN CONJ_TAC THENL [REWRITE_TAC[DIM_SUBSET_UNIV; RANK_ROW]; REWRITE_TAC[DIM_SUBSET_UNIV; rank]]);; let FULL_RANK_INJECTIVE = prove (`!A:real^M^N. rank A = dimindex(:M) <=> (!x y:real^M. A ** x = A ** y ==> x = y)`, REWRITE_TAC[GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_SPAN_ROWS] THEN REWRITE_TAC[RANK_ROW; DIM_EQ_FULL]);; let FULL_RANK_SURJECTIVE = prove (`!A:real^M^N. rank A = dimindex(:N) <=> (!y:real^N. ?x:real^M. A ** x = y)`, REWRITE_TAC[GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; RANK_TRANSP]);; let RANK_I = prove (`rank(mat 1:real^N^N) = dimindex(:N)`, REWRITE_TAC[FULL_RANK_INJECTIVE; MATRIX_VECTOR_MUL_LID]);; let MATRIX_FULL_LINEAR_EQUATIONS = prove (`!A:real^M^N b:real^N. rank A = dimindex(:N) ==> ?x. A ** x = b`, SIMP_TAC[FULL_RANK_SURJECTIVE]);; let MATRIX_NONFULL_LINEAR_EQUATIONS_EQ = prove (`!A:real^M^N. (?x. ~(x = vec 0) /\ A ** x = vec 0) <=> ~(rank A = dimindex(:M))`, REPEAT GEN_TAC THEN REWRITE_TAC[FULL_RANK_INJECTIVE] THEN SIMP_TAC[LINEAR_INJECTIVE_0; MATRIX_VECTOR_MUL_LINEAR] THEN MESON_TAC[]);; let MATRIX_NONFULL_LINEAR_EQUATIONS = prove (`!A:real^M^N. ~(rank A = dimindex(:M)) ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`, REWRITE_TAC[MATRIX_NONFULL_LINEAR_EQUATIONS_EQ]);; let MATRIX_TRIVIAL_LINEAR_EQUATIONS = prove (`!A:real^M^N. dimindex(:N) < dimindex(:M) ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_NONFULL_LINEAR_EQUATIONS THEN MATCH_MP_TAC(ARITH_RULE `!a. x <= MIN b a /\ a < b ==> ~(x = b)`) THEN EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[RANK_BOUND]);; let RANK_EQ_0 = prove (`!A:real^M^N. rank A = 0 <=> A = mat 0`, REWRITE_TAC[RANK_DIM_IM; DIM_EQ_0; SUBSET; FORALL_IN_IMAGE; IN_SING; IN_UNIV] THEN GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN SIMP_TAC[CART_EQ; MATRIX_MUL_DOT; VEC_COMPONENT; LAMBDA_BETA; mat] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_DOT_EQ_0; COND_ID] THEN REWRITE_TAC[CART_EQ; VEC_COMPONENT]);; let RANK_0 = prove (`rank(mat 0) = 0`, REWRITE_TAC[RANK_EQ_0]);; let RANK_MUL_LE_RIGHT = prove (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(B)`, REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim(IMAGE (\y. (A:real^N^M) ** y) (IMAGE (\x. (B:real^P^N) ** x) (:real^P)))` THEN REWRITE_TAC[RANK_DIM_IM] THEN CONJ_TAC THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF; MATRIX_VECTOR_MUL_ASSOC; LE_REFL]; MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]]);; let RANK_MUL_LE_LEFT = prove (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(A)`, ONCE_REWRITE_TAC[GSYM RANK_TRANSP] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN REWRITE_TAC[RANK_MUL_LE_RIGHT]);; let SPAN_COLUMNSPACE = prove (`!A:real^M^N. span(columns A) = {y | ?x. A ** x = y}`, GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[MATRIX_VECTOR_MUL_IN_COLUMNSPACE]] THEN SPEC_TAC(`y:real^N`,`y:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[columns; FORALL_IN_GSPEC] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[IN] THEN EXISTS_TAC `basis i:real^M` THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS]; REWRITE_TAC[subspace; IN] THEN MESON_TAC[MATRIX_VECTOR_MUL_RZERO; MATRIX_VECTOR_MUL_RMUL; MATRIX_VECTOR_MUL_ADD_LDISTRIB]]);; let MATRIX_AUGMENTED_LINEAR_EQUATIONS = prove (`!A:real^N^M y:real^N. (?x. transp A ** x = y) <=> rank(pastecart A (rowvector y)) = rank A`, REWRITE_TAC[RANK_ROW; rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM numseg; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN SIMP_TAC[GSYM ADD1; NUMSEG_REC; ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[IMAGE_CLAUSES; DIM_INSERT] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `(?x. f x = y) <=> y IN {z | ?x. f x = z}`] THEN REWRITE_TAC[GSYM SPAN_COLUMNSPACE; COLUMNS_TRANSP] THEN SUBGOAL_THEN `IMAGE (\i. row i (pastecart (A:real^N^M) (rowvector(y:real^N)))) (1..dimindex (:M)) = rows A` SUBST1_TAC THENL [REWRITE_TAC[rows] THEN MATCH_MP_TAC(SET_RULE `{x | P x} = s /\ (!x. x IN s ==> f x = g x) ==> IMAGE f s = {g x | P x}`) THEN SIMP_TAC[numseg; FORALL_IN_GSPEC; row; pastecart; LAMBDA_BETA; CART_EQ; LAMBDA_ETA; DIMINDEX_FINITE_SUM; ARITH_RULE `i:num <= n ==> i <= n + m`]; REWRITE_TAC[ETA_AX; GSYM SIMPLE_IMAGE; IN_NUMSEG; GSYM rows]] THEN SUBGOAL_THEN `row (SUC(dimindex(:M))) (pastecart (A:real^N^M) (rowvector(y:real^N))) = y` SUBST1_TAC THENL [SIMP_TAC[row; pastecart; CART_EQ; LAMBDA_BETA; DIMINDEX_1; rowvector; DIMINDEX_FINITE_SUM; DIMINDEX_GE_1; ARITH_RULE `1 <= SUC m`; ARITH_RULE `1 <= m ==> SUC m <= m + 1`; LAMBDA_ETA; ARITH_RULE `~(SUC m <= m) /\ SUC m - m = 1`; DIMINDEX_1; ARITH]; COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Some bounds on components etc. relative to operator norm. *) (* ------------------------------------------------------------------------- *) let NORM_COLUMN_LE_ONORM = prove (`!A:real^N^M i. norm(column i A) <= onorm(\x. A ** x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[column] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$i = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^M) ** x` ONORM) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN(MP_TAC o SPEC `basis l:real^N` o CONJUNCT1) THEN ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; NORM_BASIS; column; REAL_MUL_RID]);; let MATRIX_COMPONENT_LE_ONORM = prove (`!A:real^N^M i j. abs(A$i$j) <= onorm(\x. A ** x)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(column l (A:real^N^M))` THEN REWRITE_TAC[NORM_COLUMN_LE_ONORM] THEN MP_TAC(ISPECL [`column l (A:real^N^M)`; `k:num`] COMPONENT_LE_NORM) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN ASM_SIMP_TAC[column; LAMBDA_BETA; REAL_LE_REFL]);; let COMPONENT_LE_ONORM = prove (`!f:real^M->real^N i j. linear f ==> abs(matrix f$i$j) <= onorm f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MATCH_MP MATRIX_VECTOR_MUL th]) THEN REWRITE_TAC[MATRIX_COMPONENT_LE_ONORM]);; let ONORM_LE_MATRIX_COMPONENT_SUM = prove (`!A:real^N^M. onorm(\x. A ** x) <= sum (1..dimindex(:M)) (\i. sum(1..dimindex(:N)) (\j. abs(A$i$j)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 (MATCH_MP ONORM (SPEC_ALL MATRIX_VECTOR_MUL_LINEAR))) THEN X_GEN_TAC `x:real^N` THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[matrix_vector_mul; LAMBDA_BETA] THEN W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN SIMP_TAC[REAL_ABS_MUL; REAL_LE_LMUL; COMPONENT_LE_NORM; REAL_ABS_POS]);; let ONORM_LE_MATRIX_COMPONENT = prove (`!A:real^N^M B. (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) ==> abs(A$i$j) <= B) ==> onorm(\x. A ** x) <= &(dimindex(:M)) * &(dimindex(:N)) * B`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 (MATCH_MP ONORM (SPEC_ALL MATRIX_VECTOR_MUL_LINEAR))) THEN X_GEN_TAC `x:real^N` THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_POW_2] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[MATRIX_MUL_DOT; LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ_ABS o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[]);; let MATRIX_RATIONAL_APPROXIMATION = prove (`!A:real^N^M e. &0 < e ==> ?B. (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) ==> rational(B$i$j)) /\ onorm(\x. (A - B) ** x) < e`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) ==> ?q. rational(q) /\ abs(q - (A:real^N^M)$i$j) < e / &2 / &(dimindex(:M)) / &(dimindex(:N))` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_APPROXIMATION THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; REAL_HALF]; ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; LAMBDA_SKOLEM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real^N^M` THEN GEN_REWRITE_TAC (BINOP_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[GSYM MATRIX_SUB_COMPONENT] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN TRANS_TAC REAL_LET_TRANS `&(dimindex(:M)) * &(dimindex(:N)) * e / &2 / &(dimindex(:M)) / &(dimindex(:N))` THEN CONJ_TAC THENL [MATCH_MP_TAC ONORM_LE_MATRIX_COMPONENT THEN ASM_MESON_TAC[MATRIX_SUB_COMPONENT; REAL_ABS_SUB; REAL_LT_IMP_LE]; SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; DIMINDEX_NONZERO] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Basic lemmas about hyperplanes and halfspaces. *) (* ------------------------------------------------------------------------- *) let HYPERPLANE_EQ_EMPTY = prove (`!a:real^N b. {x | a dot x = b} = {} <=> a = vec 0 /\ ~(b = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL [MESON_TAC[]; DISCH_THEN(MP_TAC o SPEC `b / (a dot a) % a:real^N`) THEN ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0]]);; let HYPERPLANE_EQ_UNIV = prove (`!a b. {x | a dot x = b} = (:real^N) <=> a = vec 0 /\ b = &0`, REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL [MESON_TAC[]; DISCH_THEN(MP_TAC o SPEC `(b + &1) / (a dot a) % a:real^N`) THEN ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);; let HALFSPACE_EQ_EMPTY_LT = prove (`!a:real^N b. {x | a dot x < b} = {} <=> a = vec 0 /\ b <= &0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);; let HALFSPACE_EQ_EMPTY_GT = prove (`!a:real^N b. {x | a dot x > b} = {} <=> a = vec 0 /\ b >= &0`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LT) THEN SIMP_TAC[real_gt; DOT_LNEG; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let HALFSPACE_EQ_EMPTY_LE = prove (`!a:real^N b. {x | a dot x <= b} = {} <=> a = vec 0 /\ b < &0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);; let HALFSPACE_EQ_EMPTY_GE = prove (`!a:real^N b. {x | a dot x >= b} = {} <=> a = vec 0 /\ b > &0`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LE) THEN SIMP_TAC[real_ge; DOT_LNEG; REAL_LE_NEG2; VECTOR_NEG_EQ_0] THEN DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A non-injective linear function maps into a hyperplane. *) (* ------------------------------------------------------------------------- *) let ADJOINT_INJECTIVE = prove (`!f:real^M->real^N. linear f ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=> (!y. ?x. f x = y))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS o MATCH_MP ADJOINT_LINEAR) THEN FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS) THEN ASM_REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; GSYM FULL_RANK_SURJECTIVE] THEN ASM_SIMP_TAC[MATRIX_ADJOINT; RANK_TRANSP]);; let ADJOINT_SURJECTIVE = prove (`!f:real^M->real^N. linear f ==> ((!y. ?x. adjoint f x = y) <=> (!x y. f x = f y ==> x = y))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM(MATCH_MP ADJOINT_ADJOINT th)]) THEN ASM_SIMP_TAC[ADJOINT_INJECTIVE; ADJOINT_LINEAR]);; let ADJOINT_INJECTIVE_INJECTIVE = prove (`!f:real^N->real^N. linear f ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=> (!x y. f x = f y ==> x = y))`, SIMP_TAC[ADJOINT_INJECTIVE] THEN MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE; LINEAR_SURJECTIVE_IMP_INJECTIVE]);; let ADJOINT_INJECTIVE_INJECTIVE_0 = prove (`!f:real^N->real^N. linear f ==> ((!x. adjoint f x = vec 0 ==> x = vec 0) <=> (!x. f x = vec 0 ==> x = vec 0))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ADJOINT_INJECTIVE_INJECTIVE) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ADJOINT_LINEAR) THEN ASM_MESON_TAC[LINEAR_INJECTIVE_0]);; let TRANSP_INJECTIVE = prove (`!m:real^M^N. (!x y:real^N. transp m ** x = transp m ** y ==> x = y) <=> IMAGE (\x. m ** x) (:real^M) = (:real^N)`, GEN_TAC THEN MP_TAC(ISPEC `\x:real^M. (m:real^M^N) ** x` ADJOINT_INJECTIVE) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; ADJOINT_MATRIX] THEN SET_TAC[]);; let TRANSP_SURJECTIVE = prove (`!m:real^M^N. IMAGE (\x. transp m ** x) (:real^N) = (:real^M) <=> (!x y:real^M. m ** x = m ** y ==> x = y)`, REWRITE_TAC[GSYM TRANSP_INJECTIVE; TRANSP_TRANSP]);; let LINEAR_SINGULAR_INTO_HYPERPLANE = prove (`!f:real^N->real^N. linear f ==> (~(!x y. f(x) = f(y) ==> x = y) <=> ?a. ~(a = vec 0) /\ !x. a dot f(x) = &0)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_SIMP_TAC[ADJOINT_WORKS; FORALL_DOT_EQ_0] THEN REWRITE_TAC[MESON[] `(?a. ~p a /\ q a) <=> ~(!a. q a ==> p a)`] THEN ASM_SIMP_TAC[ADJOINT_INJECTIVE_INJECTIVE_0; LINEAR_INJECTIVE_0]);; let LINEAR_SINGULAR_IMAGE_HYPERPLANE = prove (`!f:real^N->real^N. linear f /\ ~(!x y. f(x) = f(y) ==> x = y) ==> ?a. ~(a = vec 0) /\ !s. IMAGE f s SUBSET {x | a dot x = &0}`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; let LOWDIM_EXPAND_DIMENSION = prove (`!s:real^N->bool n. dim s <= n /\ n <= dimindex(:N) ==> ?t. dim(t) = n /\ span s SUBSET span t`, GEN_TAC THEN GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o LAND_CONV) [LE_EXISTS] THEN SIMP_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN INDUCT_TAC THENL [MESON_TAC[ADD_CLAUSES; SUBSET_REFL]; ALL_TAC] THEN REWRITE_TAC[ARITH_RULE `s + SUC d <= n <=> s + d < n`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN SUBGOAL_THEN `~(span t = (:real^N))` MP_TAC THENL [REWRITE_TAC[GSYM DIM_EQ_FULL] THEN ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_UNIV; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(a:real^N) INSERT t` THEN ASM_REWRITE_TAC[DIM_INSERT; ADD1] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `span(t:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]);; let LOWDIM_EXPAND_BASIS = prove (`!s:real^N->bool n. dim s <= n /\ n <= dimindex(:N) ==> ?b. b HAS_SIZE n /\ independent b /\ span s SUBSET span b`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC o MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN MP_TAC(ISPEC `t:real^N->bool` BASIS_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SPAN_SPAN; SUBSET_TRANS; SPAN_MONO]);; (* ------------------------------------------------------------------------- *) (* Orthogonal bases, Gram-Schmidt process, and related theorems. *) (* ------------------------------------------------------------------------- *) let SPAN_DELETE_0 = prove (`!s:real^N->bool. span(s DELETE vec 0) = span s`, GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[DELETE_SUBSET; SPAN_MONO] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `span((vec 0:real^N) INSERT (s DELETE vec 0))` THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; SIMP_TAC[SUBSET; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]]);; let DIM_BASIS_IMAGE = prove (`!k. dim(IMAGE basis k:real^N->bool) = CARD((1..dimindex(:N)) INTER k)`, GEN_TAC THEN TRANS_TAC EQ_TRANS `dim(IMAGE basis ((1..dimindex(:N)) INTER k):real^N->bool)` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN ONCE_REWRITE_TAC[GSYM SPAN_DELETE_0] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE `(!x. ~(f x = a) <=> x IN k) ==> IMAGE f s DELETE a = IMAGE f (k INTER s) DELETE a`) THEN REWRITE_TAC[BASIS_EQ_0]; W(MP_TAC o PART_MATCH (lhand o rand) DIM_EQ_CARD o lhand o snd) THEN REWRITE_TAC[INDEPENDENT_BASIS_IMAGE; INTER_SUBSET] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER; IN_NUMSEG] THEN MESON_TAC[BASIS_INJ]]);; let SPAN_IMAGE_SCALE = prove (`!c s. (!x. x IN s ==> ~(c x = &0)) ==> span (IMAGE (\x:real^N. c(x) % x) s) = span s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[SPAN_MUL; SPAN_SUPERSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `x:real^N = inv(c x) % c x % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]);; let DIM_IMAGE_SCALE = prove (`!c s:real^N->bool. (!x. x IN s ==> ~(c x = &0)) ==> dim(IMAGE (\x. c x % x) s) = dim s`, ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN SIMP_TAC[SPAN_IMAGE_SCALE]);; let PAIRWISE_ORTHOGONAL_INDEPENDENT = prove (`!s:real^N->bool. pairwise orthogonal s /\ ~(vec 0 IN s) ==> independent s`, REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[independent; dependent] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN REWRITE_TAC[SUBSET; IN_DELETE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `\x:real^N. a dot x`) THEN ASM_SIMP_TAC[DOT_RSUM; DOT_RMUL; REAL_MUL_RZERO; SUM_0] THEN ASM_MESON_TAC[DOT_EQ_0]);; let PAIRWISE_ORTHOGONAL_IMP_FINITE = prove (`!s:real^N->bool. pairwise orthogonal s ==> FINITE s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `independent (s DELETE (vec 0:real^N))` MP_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC PAIRWISE_MONO THEN EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[SUBSET; IN_DELETE]; DISCH_THEN(MP_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN REWRITE_TAC[FINITE_DELETE]]);; let GRAM_SCHMIDT_STEP = prove (`!s a x. pairwise orthogonal s /\ x IN span s ==> orthogonal x (a - vsum s (\b:real^N. (b dot a) / (b dot b) % b))`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `x:real^N`] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN REWRITE_TAC[orthogonal; DOT_RSUB] THEN ASM_SIMP_TAC[DOT_RSUM] THEN REWRITE_TAC[REAL_SUB_0; DOT_RMUL] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum s (\y:real^N. if y = x then y dot a else &0)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; DOT_SYM]; ALL_TAC] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DOT_LMUL; REAL_MUL_RZERO] THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_SIMP_TAC[REAL_DIV_RMUL; DOT_EQ_0; DOT_LZERO; REAL_MUL_RZERO]);; let ORTHOGONAL_EXTENSION = prove (`!s t:real^N->bool. pairwise orthogonal s ==> ?u. pairwise orthogonal (s UNION u) /\ span (s UNION u) = span (s UNION t)`, let lemma = prove (`!t s:real^N->bool. FINITE t /\ FINITE s /\ pairwise orthogonal s ==> ?u. pairwise orthogonal (s UNION u) /\ span (s UNION u) = span (s UNION t)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN ASM_REWRITE_TAC[UNION_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `a' = a - vsum s (\b:real^N. (b dot a) / (b dot b) % b)` THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a':real^N) INSERT s`) THEN ASM_REWRITE_TAC[FINITE_INSERT] THEN ANTS_TAC THENL [SUBGOAL_THEN `!x:real^N. x IN s ==> a' dot x = &0` (fun th -> REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[DOT_SYM; th]) THEN REPEAT STRIP_TAC THEN EXPAND_TAC "a'" THEN REWRITE_TAC[GSYM orthogonal] THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN ASM_SIMP_TAC[pairwise; orthogonal; SPAN_CLAUSES]; DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(a':real^N) INSERT u` THEN ASM_REWRITE_TAC[SET_RULE `s UNION a INSERT u = a INSERT s UNION u`] THEN REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN MATCH_MP_TAC EQ_SPAN_INSERT_EQ THEN EXPAND_TAC "a'" THEN REWRITE_TAC[VECTOR_ARITH `a - x - a:real^N = --x`] THEN MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_UNION]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPEC `span t:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`] lemma) THEN ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE; PAIRWISE_ORTHOGONAL_IMP_FINITE]; MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[SPAN_UNION]]);; let ORTHOGONAL_EXTENSION_STRONG = prove (`!s t:real^N->bool. pairwise orthogonal s ==> ?u. DISJOINT u (vec 0 INSERT s) /\ pairwise orthogonal (s UNION u) /\ span (s UNION u) = span (s UNION t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u DIFF ((vec 0:real^N) INSERT s)` THEN REPEAT CONJ_TAC THENL [SET_TAC[]; FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] PAIRWISE_MONO)) THEN SET_TAC[]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC BINOP_CONV [GSYM SPAN_DELETE_0] THEN AP_TERM_TAC THEN SET_TAC[]]);; let ORTHONORMAL_EXTENSION = prove (`!s t:real^N->bool. pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1) ==> ?u. DISJOINT u s /\ pairwise orthogonal (s UNION u) /\ (!x. x IN u ==> norm x = &1) /\ span(s UNION u) = span(s UNION t)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION_STRONG) THEN REWRITE_TAC[SET_RULE `DISJOINT u s <=> !x. x IN u ==> ~(x IN s)`] THEN REWRITE_TAC[IN_INSERT; DE_MORGAN_THM; pairwise] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) u` THEN REWRITE_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `norm(x:real^N) = &1` THEN ASM_SIMP_TAC[REAL_INV_1; VECTOR_MUL_LID] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `inv(norm x) % x:real^N`]) THEN ASM_REWRITE_TAC[IN_UNION; VECTOR_MUL_EQ_0; REAL_SUB_0; REAL_INV_EQ_1; VECTOR_ARITH `x:real^N = a % x <=> (a - &1) % x = vec 0`] THEN ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM_MESON_TAC[VECTOR_MUL_RZERO]; ASM_REWRITE_TAC[orthogonal; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0] THEN ASM_REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0]]; REWRITE_TAC[IN_UNION; IN_IMAGE] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN REWRITE_TAC[GSYM orthogonal] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_UNION] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM SET_TAC[]; ASM_SIMP_TAC[NORM_MUL; REAL_MUL_LINV; NORM_EQ_0; REAL_ABS_INV; REAL_ABS_NORM]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SPAN_EQ; UNION_SUBSET] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE; SPAN_SUPERSET; SPAN_MUL; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `x:real^N = norm(x) % inv(norm x) % x` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID]; MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[]]]);; let VECTOR_IN_ORTHOGONAL_SPANNINGSET = prove (`!a. ?s. a IN s /\ pairwise orthogonal s /\ span s = (:real^N)`, GEN_TAC THEN MP_TAC(ISPECL [`{a:real^N}`; `(IMAGE basis (1..dimindex(:N))):real^N->bool`] ORTHOGONAL_EXTENSION) THEN REWRITE_TAC[PAIRWISE_SING] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{a:real^N} UNION u` THEN ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ s SUBSET t ==> t = UNIV`) THEN EXISTS_TAC `span {basis i:real^N | 1 <= i /\ i <= dimindex (:N)}` THEN CONJ_TAC THENL [REWRITE_TAC[SPAN_STDBASIS]; MATCH_MP_TAC SPAN_MONO] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; GSYM IN_NUMSEG] THEN SET_TAC[]);; let VECTOR_IN_ORTHOGONAL_BASIS = prove (`!a. ~(a = vec 0) ==> ?s. a IN s /\ ~(vec 0 IN s) /\ pairwise orthogonal s /\ independent s /\ s HAS_SIZE (dimindex(:N)) /\ span s = (:real^N)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `a:real^N` VECTOR_IN_ORTHOGONAL_SPANNINGSET) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise; IN_DELETE]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_DELETE_0]; DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]]);; let VECTOR_IN_ORTHONORMAL_BASIS = prove (`!a. norm a = &1 ==> ?s. a IN s /\ pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1) /\ independent s /\ s HAS_SIZE (dimindex(:N)) /\ span s = (:real^N)`, GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP VECTOR_IN_ORTHOGONAL_BASIS) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) s` THEN CONJ_TAC THENL [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_MESON_TAC[ORTHOGONAL_CLAUSES]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]] THEN UNDISCH_THEN `span s = (:real^N)` (SUBST1_TAC o SYM) THEN MATCH_MP_TAC SPAN_IMAGE_SCALE THEN REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[HAS_SIZE]);; let BESSEL_INEQUALITY = prove (`!s x:real^N. pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1) ==> sum s (\e. (e dot x) pow 2) <= norm(x) pow 2`, REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN MP_TAC(ISPEC `x - vsum s (\e. (e dot x) % e):real^N` DOT_POS_LE) THEN REWRITE_TAC[NORM_POW_2; VECTOR_ARITH `(a - b:real^N) dot (a - b) = a dot a + b dot b - &2 * b dot a`] THEN ASM_SIMP_TAC[DOT_LSUM; REAL_POW_2; DOT_LMUL] THEN MATCH_MP_TAC(REAL_ARITH `t = s ==> &0 <= x + t - &2 * s ==> s <= x`) THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `e:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[DOT_RSUM] THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum s (\k:real^N. if k = e then e dot x else &0)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:real^N` THEN DISCH_TAC THEN REWRITE_TAC[DOT_RMUL] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC[REAL_RING `a * x = a <=> a = &0 \/ x = &1`] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real^N`) THEN ASM_REWRITE_TAC[NORM_EQ_SQUARE] THEN REAL_ARITH_TAC; RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN ASM_SIMP_TAC[REAL_ENTIRE]]);; (* ------------------------------------------------------------------------- *) (* Analogous theorems for existence of orthonormal basis for a subspace. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_SPANNINGSET_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ span b = s`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL[`{}:real^N->bool`; `b:real^N->bool`] ORTHOGONAL_EXTENSION) THEN REWRITE_TAC[PAIRWISE_EMPTY; UNION_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_SUBSPACE THEN ASM_REWRITE_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_MESON_TAC[SPAN_INC]]);; let ORTHOGONAL_BASIS_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> ?b. ~(vec 0 IN b) /\ b SUBSET s /\ pairwise orthogonal b /\ independent b /\ b HAS_SIZE (dim s) /\ span b = s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_SPANNINGSET_SUBSPACE) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `b DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise; IN_DELETE]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_DELETE_0]; DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]]);; let ORTHONORMAL_BASIS_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ (!x. x IN b ==> norm x = &1) /\ independent b /\ b HAS_SIZE (dim s) /\ span b = s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_BASIS_SUBSPACE) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) b` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SPAN_MUL; SPAN_INC; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_MESON_TAC[ORTHOGONAL_CLAUSES]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]] THEN UNDISCH_THEN `span b = (s:real^N->bool)` (SUBST1_TAC o SYM) THEN MATCH_MP_TAC SPAN_IMAGE_SCALE THEN REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[HAS_SIZE]);; let ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN = prove (`!s t:real^N->bool. span s PSUBSET span t ==> ?x. ~(x = vec 0) /\ x IN span t /\ (!y. y IN span s ==> orthogonal x y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN REWRITE_TAC[SUBSPACE_SPAN] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC)) THEN MP_TAC(ISPECL [`b:real^N->bool`; `{u:real^N}`] ORTHOGONAL_EXTENSION) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `ns:real^N->bool` MP_TAC) THEN ASM_CASES_TAC `ns SUBSET (vec 0:real^N) INSERT b` THENL [DISCH_THEN(MP_TAC o AP_TERM `(IN) (u:real^N)` o CONJUNCT2) THEN SIMP_TAC[SPAN_SUPERSET; IN_UNION; IN_SING] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN SUBGOAL_THEN `~(u IN span (b UNION {vec 0:real^N}))` MP_TAC THENL [ASM_REWRITE_TAC[SET_RULE `s UNION {a} = a INSERT s`; SPAN_INSERT_0]; MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`) THEN MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s SUBSET t) ==> ?z. z IN s /\ ~(z IN t)`)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INSERT; DE_MORGAN_THM] THEN X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_THEN(MP_TAC o SPEC `n:real^N`) THEN ASM_REWRITE_TAC[IN_UNION] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN EXISTS_TAC `n:real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SUBGOAL_THEN `(n:real^N) IN span (b UNION ns)` MP_TAC THENL [MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:real^N`,`n:real^N`) THEN REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN ASM_REWRITE_TAC[SET_RULE `s UNION {a} SUBSET t <=> s SUBSET t /\ a IN t`] THEN ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]]; MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[SET_RULE `(\y. orthogonal n y) = {y | orthogonal n y}`] THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN ASM SET_TAC[]]);; let ORTHOGONAL_TO_SUBSPACE_EXISTS = prove (`!s:real^N->bool. dim s < dimindex(:N) ==> ?x. ~(x = vec 0) /\ !y. y IN s ==> orthogonal x y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN) THEN ANTS_TAC THENL [REWRITE_TAC[PSUBSET]; MESON_TAC[SPAN_SUPERSET]] THEN REWRITE_TAC[SPAN_UNIV; SUBSET_UNIV] THEN ASM_MESON_TAC[DIM_SPAN; DIM_UNIV; LT_REFL]);; let ORTHOGONAL_TO_VECTOR_EXISTS = prove (`!x:real^N. 2 <= dimindex(:N) ==> ?y. ~(y = vec 0) /\ orthogonal x y`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{x:real^N}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN SIMP_TAC[DIM_SING; IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN ANTS_TAC THENL [ASM_ARITH_TAC; MESON_TAC[ORTHOGONAL_SYM]]);; let SPAN_NOT_UNIV_ORTHOGONAL = prove (`!s. ~(span s = (:real^N)) ==> ?a. ~(a = vec 0) /\ !x. x IN span s ==> a dot x = &0`, REWRITE_TAC[GSYM DIM_EQ_FULL; GSYM LE_ANTISYM; DIM_SUBSET_UNIV; NOT_LE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM orthogonal] THEN MATCH_MP_TAC ORTHOGONAL_TO_SUBSPACE_EXISTS THEN ASM_REWRITE_TAC[DIM_SPAN]);; let SPAN_NOT_UNIV_SUBSET_HYPERPLANE = prove (`!s. ~(span s = (:real^N)) ==> ?a. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`, REWRITE_TAC[SUBSET; IN_ELIM_THM; SPAN_NOT_UNIV_ORTHOGONAL]);; let LOWDIM_SUBSET_HYPERPLANE = prove (`!s. dim s < dimindex(:N) ==> ?a:real^N. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_NOT_UNIV_SUBSET_HYPERPLANE THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN ASM_REWRITE_TAC[NOT_LE; DIM_SPAN; DIM_UNIV]);; let VECTOR_EQ_DOT_SPAN = prove (`!b x y:real^N. (!v. v IN b ==> v dot x = v dot y) /\ x IN span b /\ y IN span b ==> x = y`, ONCE_REWRITE_TAC[GSYM REAL_SUB_0; GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DOT_RSUB; GSYM ORTHOGONAL_REFL; GSYM orthogonal] THEN MESON_TAC[ORTHOGONAL_TO_SPAN; SPAN_SUB; ORTHOGONAL_SYM]);; let ORTHONORMAL_BASIS_EXPAND = prove (`!b x:real^N. pairwise orthogonal b /\ (!v. v IN b ==> norm v = &1) /\ x IN span b ==> vsum b (\v. (v dot x) % v) = x`, REWRITE_TAC[NORM_EQ_1] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_EQ_DOT_SPAN THEN EXISTS_TAC `b:real^N->bool` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN ASM_SIMP_TAC[SPAN_VSUM; SPAN_MUL; DOT_RSUM; DOT_RMUL; SPAN_SUPERSET] THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN TRANS_TAC EQ_TRANS `sum b (\w:real^N. if w = v then v dot x else &0)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_MUL_RZERO]);; let ORTHONORMAL_BASIS_EXPAND_DOT = prove (`!b x y:real^N. pairwise orthogonal b /\ (!v. v IN b ==> norm v = &1) /\ (x IN span b \/ y IN span b) ==> sum b (\v. (v dot x) * (v dot y)) = x dot y`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `b:real^N->bool` ORTHONORMAL_BASIS_EXPAND) THENL [DISCH_THEN(MP_TAC o SPEC `x:real^N`); DISCH_THEN(MP_TAC o SPEC `y:real^N`)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN ASM_SIMP_TAC[DOT_LSUM; DOT_RSUM; PAIRWISE_ORTHOGONAL_IMP_FINITE] THEN REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[REAL_MUL_SYM; DOT_SYM]);; let ORTHONORMAL_BASIS_EXPAND_NORM = prove (`!b x:real^N. pairwise orthogonal b /\ (!v. v IN b ==> norm v = &1) /\ x IN span b ==> sum b (\v. (v dot x) pow 2) = norm x pow 2`, ASM_SIMP_TAC[REAL_POW_2; ORTHONORMAL_BASIS_EXPAND_DOT; NORM_POW_2]);; (* ------------------------------------------------------------------------- *) (* Independent and orthogonal subspaces. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_IMP_INDEPENDENT_SUBSPACES = prove (`!s t:real^N->bool. (!a b. a IN s /\ b IN t ==> orthogonal a b) ==> s INTER t SUBSET {vec 0}`, REWRITE_TAC[SUBSET; IN_INTER; IN_SING] THEN MESON_TAC[ORTHOGONAL_REFL]);; let INDEPENDENT_SUBSPACES_ALT = prove (`!s t:real^N->bool. subspace s /\ subspace t ==> (s INTER t SUBSET {vec 0} <=> s INTER t = {vec 0})`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[SING_SUBSET; IN_INTER; SUBSPACE_0]);; let INDEPENDENT_SUBSPACES_0 = prove (`!s t:real^N->bool. subspace s /\ subspace t ==> (s INTER t SUBSET {vec 0} <=> !x y. x IN s /\ y IN t /\ x + y = vec 0 ==> x = vec 0 /\ y = vec 0)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_INTER; IN_SING] THEN ONCE_REWRITE_TAC[MESON[VECTOR_NEG_NEG] `(!x y:real^N. P x y) <=> (!x y. P x (--y))`] THEN ASM_SIMP_TAC[MESON[SUBSPACE_NEG; VECTOR_NEG_NEG] `subspace t ==> ((--x:real^N) IN t <=> x IN t)`] THEN REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_ARITH `x + --y:real^N = vec 0 <=> x = y`] THEN MESON_TAC[]);; let INDEPENDENT_SUBSPACES = prove (`!s t:real^N->bool. subspace s /\ subspace t ==> (s INTER t SUBSET {vec 0} <=> !x y x' y'. x IN s /\ x' IN s /\ y IN t /\ y' IN t /\ x + y = x' + y' ==> x = x' /\ y = y')`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INDEPENDENT_SUBSPACES_0] THEN EQ_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THENL [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SUBSPACE_SUB] THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC VECTOR_ARITH; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_RID]]);; let ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE = prove (`!s t x y x' y':real^N. (!a b. a IN s /\ b IN t ==> orthogonal a b) /\ x IN span s /\ x' IN span s /\ y IN span t /\ y' IN span t /\ x + y = x' + y' ==> x = x' /\ y = y'`, REWRITE_TAC[VECTOR_ARITH `x + y:real^N = x' + y' <=> x - x' = y' - y`] THEN ONCE_REWRITE_TAC[GSYM ORTHOGONAL_TO_SPANS_EQ] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = x' /\ y:real^N = y' <=> x - x' = vec 0 /\ y' - y = vec 0`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN ASM_MESON_TAC[ORTHOGONAL_CLAUSES; ORTHOGONAL_SYM]);; let ORTHOGONAL_SUBSPACE_DECOMP_EXISTS = prove (`!s x:real^N. ?y z. y IN span s /\ (!w. w IN span s ==> orthogonal z w) /\ x = y + z`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC `vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN EXISTS_TAC `x - vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC SPAN_VSUM THEN ASM_SIMP_TAC[INDEPENDENT_IMP_FINITE; SPAN_CLAUSES]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN ASM_SIMP_TAC[]; VECTOR_ARITH_TAC]);; let ORTHOGONAL_SUBSPACE_DECOMP = prove (`!s x. ?!(y,z). y IN span s /\ z IN {z:real^N | !x. x IN span s ==> orthogonal z x} /\ x = y + z`, REWRITE_TAC[EXISTS_UNIQUE_DEF; IN_ELIM_THM] THEN REWRITE_TAC[EXISTS_PAIRED_THM; FORALL_PAIRED_THM] THEN REWRITE_TAC[FORALL_PAIR_THM; ORTHOGONAL_SUBSPACE_DECOMP_EXISTS] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `{z:real^N | !x. x IN span s ==> orthogonal z x}`] THEN ASM_SIMP_TAC[SPAN_CLAUSES; IN_ELIM_THM] THEN ASM_MESON_TAC[SPAN_CLAUSES; ORTHOGONAL_SYM]);; (* ------------------------------------------------------------------------- *) (* Existence of isometry between subspaces of same dimension. *) (* ------------------------------------------------------------------------- *) let ISOMETRY_SUBSET_SUBSPACE = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t /\ dim s <= dim t ==> ?f. linear f /\ IMAGE f s SUBSET t /\ (!x. x IN s ==> norm(f x) = norm(x))`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN ASM_REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_LE_INJ) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_ALT] THEN X_GEN_TAC `fb:real^M->real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`] LINEAR_INDEPENDENT_EXTEND) THEN ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM; INJECTIVE_ON_ALT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]; UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[SPAN_FINITE] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN ASM_SIMP_TAC[LINEAR_CMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o rand o snd) THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[]; REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL] THEN MATCH_MP_TAC SUM_EQ THEN ASM SET_TAC[]]]);; let ISOMETRIES_SUBSPACES = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t /\ dim s = dim t ==> ?f g. linear f /\ linear g /\ IMAGE f s = t /\ IMAGE g t = s /\ (!x. x IN s ==> norm(f x) = norm x) /\ (!y. y IN t ==> norm(g y) = norm y) /\ (!x. x IN s ==> g(f x) = x) /\ (!y. y IN t ==> f(g y) = y)`, REPEAT STRIP_TAC THEN ABBREV_TAC `n = dim(t:real^N->bool)` THEN MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_EQ_BIJECTIONS) THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`fb:real^M->real^N`; `gb:real^N->real^M`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`gb:real^N->real^M`; `c:real^N->bool`] LINEAR_INDEPENDENT_EXTEND) THEN MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`] LINEAR_INDEPENDENT_EXTEND) THEN ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN AP_TERM_TAC THEN ASM SET_TAC[]; REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN AP_TERM_TAC THEN ASM SET_TAC[]; UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[SPAN_FINITE] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN ASM_SIMP_TAC[LINEAR_CMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o rand o snd) THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[]; REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL]]; UNDISCH_THEN `span c:real^N->bool = t` (SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[SPAN_FINITE] THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^N`; `u:real^N->real`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN ASM_SIMP_TAC[LINEAR_CMUL] THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o rand o snd) THEN W(MP_TAC o PART_MATCH (lhand o rand) NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[]; REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL]]; REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN MATCH_MP_TAC SPAN_INDUCT THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0]; REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN MATCH_MP_TAC SPAN_INDUCT THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0]]);; let ISOMETRY_SUBSPACES = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t /\ dim s = dim t ==> ?f:real^M->real^N. linear f /\ IMAGE f s = t /\ (!x. x IN s ==> norm(f x) = norm(x))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);; let ISOMETRY_UNIV_SUBSPACE = prove (`!s. subspace s /\ dimindex(:M) = dim s ==> ?f:real^M->real^N. linear f /\ IMAGE f (:real^M) = s /\ (!x. norm(f x) = norm(x))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^M)`; `s:real^N->bool`] ISOMETRY_SUBSPACES) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);; let ISOMETRY_UNIV_SUPERSET_SUBSPACE = prove (`!s. subspace s /\ dim s <= dimindex(:M) /\ dimindex(:M) <= dimindex(:N) ==> ?f:real^M->real^N. linear f /\ s SUBSET (IMAGE f (:real^M)) /\ (!x. norm(f x) = norm(x))`, GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`(:real^M)`; `span t:real^N->bool`] ISOMETRY_SUBSPACES) THEN ASM_REWRITE_TAC[SUBSPACE_SPAN; SUBSPACE_UNIV; DIM_UNIV; DIM_SPAN] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_UNIV] THEN ASM_MESON_TAC[SUBSET; SPAN_INC]);; let ISOMETRY_UNIV_UNIV = prove (`dimindex(:M) <= dimindex(:N) ==> ?f:real^M->real^N. linear f /\ (!x. norm(f x) = norm(x))`, DISCH_TAC THEN MP_TAC(ISPEC `{vec 0:real^N}`ISOMETRY_UNIV_SUPERSET_SUBSPACE) THEN ASM_REWRITE_TAC[SUBSPACE_TRIVIAL] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC(ARITH_RULE `x = 0 /\ 1 <= y ==> x <= y`) THEN ASM_REWRITE_TAC[DIM_EQ_0; DIMINDEX_GE_1] THEN SET_TAC[]);; let SUBSPACE_ISOMORPHISM = prove (`!s t. subspace s /\ subspace t /\ dim(s) = dim(t) ==> ?f:real^M->real^N. linear f /\ (IMAGE f s = t) /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> (x = y))`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ISOMETRY_SUBSPACES) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE] THEN MESON_TAC[NORM_EQ_0]);; let ISOMORPHISMS_UNIV_UNIV = prove (`dimindex(:M) = dimindex(:N) ==> ?f:real^M->real^N g. linear f /\ linear g /\ (!x. norm(f x) = norm x) /\ (!y. norm(g y) = norm y) /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)`, REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. lambda i. x$i):real^M->real^N` THEN EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN SIMP_TAC[vector_norm; dot; LAMBDA_BETA] THEN SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN FIRST_ASSUM SUBST1_TAC THEN SIMP_TAC[LAMBDA_BETA] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[LAMBDA_BETA]);; (* ------------------------------------------------------------------------- *) (* Properties of special hyperplanes. *) (* ------------------------------------------------------------------------- *) let SUBSPACE_HYPERPLANE = prove (`!a. subspace {x:real^N | a dot x = &0}`, SIMP_TAC[subspace; DOT_RADD; DOT_RMUL; IN_ELIM_THM; REAL_ADD_LID; REAL_MUL_RZERO; DOT_RZERO]);; let SUBSPACE_SPECIAL_HYPERPLANE = prove (`!k. subspace {x:real^N | x$k = &0}`, SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);; let SPECIAL_HYPERPLANE_SPAN = prove (`!k. 1 <= k /\ k <= dimindex(:N) ==> {x:real^N | x$k = &0} = span(IMAGE basis ((1..dimindex(:N)) DELETE k))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SPAN_SUBSPACE THEN ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_SIMP_TAC[BASIS_COMPONENT; IN_DELETE]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN SIMP_TAC[SPAN_FINITE; FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `\v:real^N. x dot v` THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhs o snd) THEN ANTS_TAC THENL [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN MESON_TAC[BASIS_INJ]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; DOT_BASIS] THEN REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]]);; let DIM_SPECIAL_HYPERPLANE = prove (`!k. 1 <= k /\ k <= dimindex(:N) ==> dim {x:real^N | x$k = &0} = dimindex(:N) - 1`, SIMP_TAC[SPECIAL_HYPERPLANE_SPAN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DELETE k)` THEN REWRITE_TAC[SUBSET_REFL; SPAN_INC] THEN CONJ_TAC THENL [MATCH_MP_TAC INDEPENDENT_MONO THEN EXISTS_TAC `{basis i:real^N | 1 <= i /\ i <= dimindex(:N)}` THEN REWRITE_TAC[INDEPENDENT_STDBASIS; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG; IN_ELIM_THM] THEN MESON_TAC[]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN MESON_TAC[BASIS_INJ]; ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG; CARD_DELETE; FINITE_IMAGE; IN_NUMSEG; CARD_NUMSEG_1]]]);; let LOWDIM_EQ_INTER_HYPERPLANE = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ t SUBSET s /\ dim t + 1 = dim s ==> ?a. ~(a = vec 0) /\ {x | a dot x = &0} INTER s = t`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`] ORTHONORMAL_EXTENSION) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN SUBGOAL_THEN `span(b UNION s):real^N->bool = s` SUBST1_TAC THENL [TRANS_TAC EQ_TRANS `span(s:real^N->bool)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN ASM SET_TAC[]; ASM_MESON_TAC[SPAN_OF_SUBSPACE]]; STRIP_TAC] THEN UNDISCH_TAC `dim(t:real^N->bool) + 1 = dim(s:real^N->bool)` THEN MAP_EVERY EXPAND_TAC ["s"; "t"] THEN REWRITE_TAC[DIM_SPAN] THEN SUBGOAL_THEN `~((vec 0:real^N) IN b UNION c)` MP_TAC THENL [ASM_MESON_TAC[IN_UNION; NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; ASM_SIMP_TAC[DIM_EQ_CARD; PAIRWISE_ORTHOGONAL_INDEPENDENT; IN_UNION; DE_MORGAN_THM]] THEN SUBGOAL_THEN `FINITE(b UNION c:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[PAIRWISE_ORTHOGONAL_IMP_FINITE]; ASM_SIMP_TAC[FINITE_UNION; CARD_UNION; GSYM(ONCE_REWRITE_RULE[INTER_COMM] DISJOINT)]] THEN STRIP_TAC THEN STRIP_TAC THEN REWRITE_TAC[EQ_ADD_LCANCEL] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN MP_TAC(HAS_SIZE_CONV `(c:real^N->bool) HAS_SIZE 1`) THEN ASM_REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_SING]) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s /\ (!x. x IN t ==> x IN h) /\ (!x. x IN s /\ ~(x IN t) ==> ~(x IN h)) ==> h INTER s = t`) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXPAND_TAC ["s"; "t"] THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM; GSYM orthogonal] THEN MATCH_MP_TAC ORTHOGONAL_TO_SPAN THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SET_RULE `s UNION {a} = a INSERT s`]) THEN REWRITE_TAC[PAIRWISE_INSERT] THEN ASM SET_TAC[]; DISCH_TAC] THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; SET_RULE `s UNION {a} = a INSERT s`] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`] THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO; IMP_CONJ] THEN DISCH_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `a dot (x - c % a:real^N) = &0` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[DOT_RSUB; DOT_RMUL]] THEN ASM_SIMP_TAC[REAL_SUB_0; REAL_ENTIRE; DOT_EQ_0]);; let LOWDIM_EQ_HYPERPLANE = prove (`!s. dim s = dimindex(:N) - 1 ==> ?a:real^N. ~(a = vec 0) /\ span s = {x | a dot x = &0}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `span s:real^N->bool`] LOWDIM_EQ_INTER_HYPERPLANE) THEN ASM_REWRITE_TAC[SUBSPACE_SPAN; SUBSPACE_UNIV; SUBSET_UNIV; INTER_UNIV] THEN ASM_SIMP_TAC[DIM_SPAN; SUB_ADD; DIMINDEX_GE_1; DIM_UNIV] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* More theorems about dimensions of different subspaces. *) (* ------------------------------------------------------------------------- *) let DIM_IMAGE_KERNEL_GEN = prove (`!f:real^M->real^N s. linear f /\ subspace s ==> dim(IMAGE f s) + dim {x | x IN s /\ f x = vec 0} = dim(s)`, REPEAT STRIP_TAC THEN MP_TAC (ISPEC `{x | x IN s /\ (f:real^M->real^N) x = vec 0}` BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`v:real^M->bool`; `s:real^M->bool`] MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `span(w:real^M->bool) = s` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th] THEN ASSUME_TAC th) THENL [ASM_SIMP_TAC[SPAN_SUBSPACE]; ALL_TAC] THEN SUBGOAL_THEN `subspace {x | x IN s /\ (f:real^M->real^N) x = vec 0}` ASSUME_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_KERNEL]; ALL_TAC] THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x = vec 0} = span v` ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET_ANTISYM; SPAN_SUBSET_SUBSPACE; SUBSPACE_KERNEL]; ALL_TAC] THEN ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN SUBGOAL_THEN `!x. x IN span(w DIFF v) /\ (f:real^M->real^N) x = vec 0 ==> x = vec 0` (LABEL_TAC "*") THENL [MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ (!x. x IN s /\ x IN t /\ P x ==> Q x) ==> (!x. x IN s /\ P x ==> Q x)`) THEN EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_MONO; SUBSET_DIFF]; ALL_TAC] THEN ASM_SIMP_TAC[SPAN_FINITE; IN_ELIM_THM; IMP_CONJ; FINITE_DIFF; INDEPENDENT_IMP_FINITE; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN X_GEN_TAC `u:real^M->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[SET_RULE `y IN s /\ f y = a <=> y IN {x | x IN s /\ f x = a}`] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `t:real^M->real`) THEN MP_TAC(ISPEC `w:real^M->bool` INDEPENDENT_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(\x. if x IN w DIFF v then --u x else t x):real^M->real`) THEN ASM_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES; INDEPENDENT_IMP_FINITE] THEN REWRITE_TAC[SET_RULE `{x | x IN w /\ x IN (w DIFF v)} = w DIFF v`] THEN SIMP_TAC[ASSUME `(v:real^M->bool) SUBSET w`; SET_RULE `v SUBSET w ==> {x | x IN w /\ ~(x IN (w DIFF v))} = v`] THEN ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VSUM_NEG; VECTOR_ADD_LINV] THEN DISCH_THEN(fun th -> MATCH_MP_TAC VSUM_EQ_0 THEN MP_TAC th) THEN REWRITE_TAC[REAL_NEG_EQ_0; VECTOR_MUL_EQ_0; IN_DIFF] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x y. x IN (w DIFF v) /\ y IN (w DIFF v) /\ (f:real^M->real^N) x = f y ==> x = y` ASSUME_TAC THENL [REMOVE_THEN "*" MP_TAC THEN ASM_SIMP_TAC[GSYM LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN MP_TAC(ISPEC `w DIFF v:real^M->bool` SPAN_INC) THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = span(IMAGE f (w DIFF v))` SUBST1_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSPACE_LINEAR_IMAGE; SPAN_MONO; IMAGE_SUBSET; SUBSET_TRANS; SUBSET_DIFF; SPAN_EQ_SELF]] THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN UNDISCH_TAC `span w:real^M->bool = s` THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) [IN_UNIV; SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM; FINITE_IMAGE; FINITE_DIFF; ASSUME `independent(w:real^M->bool)`] THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN X_GEN_TAC `u:real^M->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `g:real^N->real^M`) THEN EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE; LINEAR_VSUM] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[o_DEF] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN SIMP_TAC[SUBSET_DIFF; FINITE_DIFF; INDEPENDENT_IMP_FINITE; LINEAR_CMUL; IN_DIFF; TAUT `a /\ ~(a /\ ~b) <=> a /\ b`; ASSUME `independent(w:real^M->bool)`; ASSUME `linear(f:real^M->real^N)`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM SET_TAC[]; SUBGOAL_THEN `independent(IMAGE (f:real^M->real^N) (w DIFF v))` ASSUME_TAC THENL [MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET_DIFF]; ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o lhand o lhand o snd) THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[FINITE_DIFF; CARD_DIFF; INDEPENDENT_IMP_FINITE] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUB_ADD THEN ASM_MESON_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]]]);; let DIM_IMAGE_KERNEL = prove (`!f:real^M->real^N. linear f ==> dim(IMAGE f (:real^M)) + dim {x | f x = vec 0} = dimindex(:M)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] DIM_IMAGE_KERNEL_GEN) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);; let DIM_SUMS_INTER = prove (`!s t:real^N->bool. subspace s /\ subspace t ==> dim {x + y | x IN s /\ y IN t} + dim(s INTER t) = dim(s) + dim(t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s INTER t:real^N->bool` BASIS_EXISTS) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`] MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`b:real^N->bool`; `t:real^N->bool`] MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(c:real^N->bool) INTER d = b` ASSUME_TAC THENL [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(ISPEC `c:real^N->bool` independent) THEN ASM_REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(x:real^N) IN span b` MP_TAC THENL [ASM_MESON_TAC[SUBSET; IN_INTER; SPAN_INC]; MP_TAC(ISPECL [`b:real^N->bool`; `c DELETE (x:real^N)`] SPAN_MONO) THEN ASM SET_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `dim (s INTER t:real^N->bool) = CARD(b:real^N->bool) /\ dim s = CARD c /\ dim t = CARD d /\ dim {x + y:real^N | x IN s /\ y IN t} = CARD(c UNION d:real^N->bool)` (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL [ALL_TAC; ASM_SIMP_TAC[CARD_UNION_GEN; INDEPENDENT_IMP_FINITE] THEN MATCH_MP_TAC(ARITH_RULE `b:num <= c ==> (c + d) - b + b = c + d`) THEN ASM_SIMP_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC DIM_UNIQUE THENL [EXISTS_TAC `b:real^N->bool`; EXISTS_TAC `c:real^N->bool`; EXISTS_TAC `d:real^N->bool`; EXISTS_TAC `c UNION d:real^N->bool`] THEN ASM_SIMP_TAC[HAS_SIZE; INDEPENDENT_IMP_FINITE; FINITE_UNION] THEN REWRITE_TAC[UNION_SUBSET; GSYM CONJ_ASSOC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_RID] THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_LID] THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL [MP_TAC(ISPECL[`c:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO); MP_TAC(ISPECL[`d:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO)] THEN REWRITE_TAC[SUBSET_UNION] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[INDEPENDENT_EXPLICIT; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN X_GEN_TAC `a:real^N->real` THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN ASM_SIMP_TAC[VSUM_UNION; SET_RULE `DISJOINT c (d DIFF c)`; INDEPENDENT_IMP_FINITE; FINITE_DIFF; FINITE_UNION] THEN DISCH_TAC THEN SUBGOAL_THEN `(vsum (d DIFF c) (\v:real^N. a v % v)) IN span b` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH `a + b = vec 0 ==> b = --a`)) THEN MATCH_MP_TAC SUBSPACE_NEG THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SUBSPACE_VSUM THEN ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `e:real^N->real`) THEN MP_TAC(ISPEC `c:real^N->bool` INDEPENDENT_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `(\x. if x IN b then a x + e x else a x):real^N->real`)) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES] THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB; GSYM DIFF] THEN ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> {x | x IN c /\ x IN b} = b`] THEN ASM_SIMP_TAC[VSUM_ADD; INDEPENDENT_IMP_FINITE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(a + b) + c:real^N = (a + c) + b`] THEN ASM_SIMP_TAC[GSYM VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE; SET_RULE `DISJOINT b (c DIFF b)`] THEN ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> b UNION (c DIFF b) = c`] THEN DISCH_TAC THEN SUBGOAL_THEN `!v:real^N. v IN (c DIFF b) ==> a v = &0` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `d:real^N->bool` INDEPENDENT_EXPLICIT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N->real`)) THEN SUBGOAL_THEN `d:real^N->bool = b UNION (d DIFF c)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE; SET_RULE `c INTER d = b ==> DISJOINT b (d DIFF c)`] THEN SUBGOAL_THEN `vsum b (\x:real^N. a x % x) = vsum c (\x. a x % x)` (fun th -> ASM_REWRITE_TAC[th]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0] THEN ASM_MESON_TAC[]);; let DIM_UNION_INTER = prove (`!s t:real^N->bool. subspace s /\ subspace t ==> dim(s UNION t) + dim(s INTER t) = dim s + dim t`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM DIM_SPAN] THEN MP_TAC(ISPECL [`span s:real^N->bool`; `span t:real^N->bool`] DIM_SUMS_INTER) THEN ASM_SIMP_TAC[SPAN_UNION; SUBSPACE_SPAN; SPAN_OF_SUBSPACE]);; let DIM_KERNEL_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P. linear f /\ linear g ==> dim {x | (g o f) x = vec 0} <= dim {x | f(x) = vec 0} + dim {y | g(y) = vec 0}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{x | (f:real^M->real^N) x = vec 0}` BASIS_EXISTS_FINITE) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?c. FINITE c /\ IMAGE f c SUBSET {y | g(y):real^P = vec 0} /\ independent (IMAGE (f:real^M->real^N) c) /\ IMAGE f (:real^M) INTER {y | g(y) = vec 0} SUBSET span(IMAGE f c) /\ (!x y. x IN c /\ y IN c ==> (f x = f y <=> x = y)) /\ (IMAGE f c) HAS_SIZE dim (IMAGE f (:real^M) INTER {y | g(y) = vec 0})` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (:real^M) INTER {x | (g:real^N->real^P) x = vec 0}` BASIS_EXISTS_FINITE) THEN REWRITE_TAC[SUBSET_INTER; GSYM CONJ_ASSOC; EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`] IMAGE_INJECTIVE_IMAGE_OF_SUBSET) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim(span(b UNION c:real^M->bool))` THEN CONJ_TAC THENL [MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; o_THM] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN SUBGOAL_THEN `(f:real^M->real^N) x IN span(IMAGE f c)` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `x:real^M = y + (x - y)`) THEN MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL [ASM_MESON_TAC[SUBSET_UNION; SPAN_MONO; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN EXISTS_TAC `{x | (f:real^M->real^N) x = vec 0}` THEN CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[LINEAR_SUB; VECTOR_SUB_EQ]; ASM_MESON_TAC[SUBSET_TRANS; SUBSET_UNION; SPAN_MONO]]; REWRITE_TAC[DIM_SPAN] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(b UNION c:real^M->bool)` THEN ASM_SIMP_TAC[DIM_LE_CARD; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(b:real^M->bool) + CARD(c:real^M->bool)` THEN ASM_SIMP_TAC[CARD_UNION_LE] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL [ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim(IMAGE (f:real^M->real^N) c)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[DIM_EQ_CARD] THEN ASM_MESON_TAC[CARD_IMAGE_INJ; LE_REFL]; ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]]]);; let DIM_ORTHOGONAL_SUM = prove (`!s t:real^N->bool. (!x y. x IN s /\ y IN t ==> x dot y = &0) ==> dim(s UNION t) = dim(s) + dim(t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN REWRITE_TAC[SPAN_UNION] THEN SIMP_TAC[GSYM DIM_SUMS_INTER; SUBSPACE_SPAN] THEN REWRITE_TAC[ARITH_RULE `x = x + y <=> y = 0`] THEN REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER] THEN SUBGOAL_THEN `!x:real^N. x IN span s ==> !y:real^N. y IN span t ==> x dot y = &0` MP_TAC THENL [MATCH_MP_TAC SPAN_INDUCT THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC SPAN_INDUCT THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN SIMP_TAC[subspace; IN_ELIM_THM; DOT_RMUL; DOT_RADD; DOT_RZERO] THEN REAL_ARITH_TAC; SIMP_TAC[subspace; IN_ELIM_THM; DOT_LMUL; DOT_LADD; DOT_LZERO] THEN REAL_ARITH_TAC]; REWRITE_TAC[IN_SING] THEN MESON_TAC[DOT_EQ_0]]);; let DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ s SUBSET t ==> dim {y | y IN t /\ !x. x IN s ==> orthogonal x y} + dim s = dim t`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) DIM_ORTHOGONAL_SUM o lhand o snd) THEN ANTS_TAC THENL [SIMP_TAC[IN_ELIM_THM; orthogonal] THEN MESON_TAC[DOT_SYM]; DISCH_THEN(SUBST1_TAC o SYM)] THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN REWRITE_TAC[SPAN_UNION; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_SYM] THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH `x:real^N = y + z ==> z = x - y`)) THEN MATCH_MP_TAC SUBSPACE_SUB THEN ASM_MESON_TAC[SUBSET; SPAN_EQ_SELF]; ASM_MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_SYM]]);; let DIM_SPECIAL_SUBSPACE = prove (`!k. dim {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) /\ i IN k ==> x$i = &0} = CARD((1..dimindex(:N)) DIFF k)`, GEN_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DIFF k)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN SIMP_TAC[BASIS_COMPONENT; IN_DIFF; IN_NUMSEG] THEN MESON_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_CASES_TAC `(x:real^N)$j = &0` THEN ASM_REWRITE_TAC[SPAN_0; VECTOR_MUL_LZERO] THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `j:num` THEN REWRITE_TAC[IN_NUMSEG; IN_DIFF] THEN ASM_MESON_TAC[]; MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ; IN_DIFF; IN_NUMSEG; BASIS_NONZERO]; SIMP_TAC[HAS_SIZE; FINITE_IMAGE; FINITE_DIFF; FINITE_NUMSEG] THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN SIMP_TAC[FINITE_DIFF; FINITE_NUMSEG; IMP_CONJ; RIGHT_FORALL_IMP_THM; SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ; IN_DIFF; IN_NUMSEG; BASIS_NONZERO]]);; let INDEPENDENT_UNION = prove (`!s t:real^N->bool. independent s /\ independent t /\ (span s) INTER (span t) SUBSET {vec 0} ==> independent(s UNION t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(vec 0:real^N) IN s` THENL [ASM_MESON_TAC[INDEPENDENT_NONZERO]; ALL_TAC] THEN SIMP_TAC[INDEPENDENT_EQ_DIM_EQ_CARD; FINITE_UNION] THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN REWRITE_TAC[span] THEN ONCE_REWRITE_TAC[HULL_UNION] THEN REWRITE_TAC[GSYM span; DIM_SPAN] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`span s:real^N->bool`; `span t:real^N->bool`] DIM_UNION_INTER) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIM_SUBSET) THEN SIMP_TAC[DIM_SING; SUBSPACE_SPAN; LE; ADD_CLAUSES] THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[DIM_SPAN] THEN MATCH_MP_TAC CARD_UNION THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `s' INTER t' SUBSET {z} ==> s SUBSET s' /\ t SUBSET t' /\ ~(z IN s) ==> s INTER t = {}`)) THEN ASM_REWRITE_TAC[SPAN_INC]);; (* ------------------------------------------------------------------------- *) (* More injective/surjective versus dimension variants. *) (* ------------------------------------------------------------------------- *) let LINEAR_INJECTIVE_ON_IFF_DIM = prove (`!f:real^M->real^N s. linear f /\ subspace s ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> dim(IMAGE f s) = dim s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] DIM_IMAGE_KERNEL_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ARITH_RULE `m:num = m + n <=> n = 0`] THEN ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE; DIM_EQ_0] THEN SET_TAC[]);; let DIM_INJECTIVE_ON_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ subspace s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> dim(IMAGE f s) = dim s`, MESON_TAC[LINEAR_INJECTIVE_ON_IFF_DIM]);; let DIM_EQ_SUBSPACES = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ s SUBSET t /\ dim t <= dim s ==> s = t`, MESON_TAC[DIM_EQ_SPAN; SPAN_EQ_SELF]);; let DIM_EQ_SUBSPACE = prove (`!s t:real^N->bool. subspace s /\ subspace t /\ s SUBSET t ==> (dim s = dim t <=> s = t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC DIM_EQ_SUBSPACES THEN ASM_REWRITE_TAC[LE_REFL]);; let LINEAR_SURJECTIVE_ON_IFF_DIM = prove (`!f:real^M->real^N s t. linear f /\ subspace s /\ subspace t /\ IMAGE f s SUBSET t ==> (IMAGE f s = t <=> dim(IMAGE f s) = dim t)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIM_EQ_SUBSPACE THEN ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE]);; let LINEAR_INJECTIVE_IMP_SURJECTIVE_ON = prove (`!f:real^M->real^N s t. linear f /\ subspace s /\ subspace t /\ IMAGE f s SUBSET t /\ dim t <= dim s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> IMAGE f s = t`, REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_SURJECTIVE_ON_IFF_DIM] THEN ASM_SIMP_TAC[DIM_SUBSET; GSYM LE_ANTISYM] THEN ASM_SIMP_TAC[LINEAR_INJECTIVE_ON_IFF_DIM] THEN ASM_SIMP_TAC[DIM_INJECTIVE_ON_LINEAR_IMAGE; INJECTIVE_ON_ALT]);; let LINEAR_SURJECTIVE_IFF_INJECTIVE_ON = prove (`!f:real^M->real^N s t. linear f /\ subspace s /\ subspace t /\ IMAGE f s SUBSET t /\ dim s = dim t ==> (IMAGE f s = t <=> !x y. x IN s /\ y IN s /\ f x = f y ==> x = y)`, SIMP_TAC[LINEAR_SURJECTIVE_ON_IFF_DIM; LINEAR_INJECTIVE_ON_IFF_DIM]);; let LINEAR_INJECTIVE_IFF_DIM = prove (`!f:real^M->real^N. linear f ==> ((!x y. f x = f y ==> x = y) <=> dim(IMAGE f (:real^M)) = dimindex(:M))`, SIMP_TAC[GSYM LINEAR_INJECTIVE_ON_IFF_DIM; GSYM DIM_UNIV; SUBSPACE_UNIV] THEN REWRITE_TAC[IN_UNIV]);; let LINEAR_SURJECTIVE_IFF_DIM = prove (`!f:real^M->real^N. linear f ==> ((!y. ?x. f x = y) <=> dim(IMAGE f (:real^M)) = dimindex(:N))`, SIMP_TAC[DIM_EQ_FULL; SPAN_LINEAR_IMAGE; SPAN_UNIV] THEN SET_TAC[]);; let LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN = prove (`!f:real^M->real^N. dimindex(:M) = dimindex(:N) /\ linear f ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`, SIMP_TAC[LINEAR_INJECTIVE_IFF_DIM; LINEAR_SURJECTIVE_IFF_DIM] THEN MESON_TAC[]);; let MATRIX_INVERTIBLE_LEFT_GEN = prove (`!f:real^M->real^N. linear f /\ dimindex(:N) <= dimindex(:M) ==> (invertible(matrix f) <=> ?g. linear g /\ g o f = I)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_INVERTIBLE] THEN ASM_SIMP_TAC[GSYM LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ; GSYM LINEAR_INJECTIVE_LEFT_INVERSE_EQ] THEN REWRITE_TAC[TAUT `(p /\ q <=> p) <=> p ==> (q <=> p)`] THEN DISCH_TAC THEN MATCH_MP_TAC LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN THEN ASM_REWRITE_TAC[GSYM LE_ANTISYM] THEN MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE THEN ASM_MESON_TAC[]);; let MATRIX_INVERTIBLE_LEFT = prove (`!f:real^N->real^N. linear f ==> (invertible(matrix f) <=> ?g. linear g /\ g o f = I)`, SIMP_TAC[MATRIX_INVERTIBLE_LEFT_GEN; LE_REFL]);; let MATRIX_INVERTIBLE_RIGHT_GEN = prove (`!f:real^M->real^N. linear f /\ dimindex(:M) <= dimindex(:N) ==> (invertible(matrix f) <=> ?g. linear g /\ f o g = I)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_INVERTIBLE] THEN ASM_SIMP_TAC[GSYM LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE_EQ; GSYM LINEAR_SURJECTIVE_RIGHT_INVERSE_EQ] THEN REWRITE_TAC[TAUT `(q /\ p <=> p) <=> p ==> (p <=> q)`] THEN DISCH_TAC THEN MATCH_MP_TAC LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN THEN ASM_REWRITE_TAC[GSYM LE_ANTISYM] THEN MATCH_MP_TAC LINEAR_SURJECTIVE_DIMINDEX_LE THEN ASM_MESON_TAC[]);; let MATRIX_INVERTIBLE_RIGHT = prove (`!f:real^N->real^N. linear f ==> (invertible(matrix f) <=> ?g. linear g /\ f o g = I)`, SIMP_TAC[MATRIX_INVERTIBLE_RIGHT_GEN; LE_REFL]);; (* ------------------------------------------------------------------------- *) (* More about product spaces. *) (* ------------------------------------------------------------------------- *) let PASTECART_AS_ORTHOGONAL_SUM = prove (`!x:real^M y:real^N. pastecart x y = pastecart x (vec 0) + pastecart (vec 0) y`, REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID; VECTOR_ADD_RID]);; let PCROSS_AS_ORTHOGONAL_SUM = prove (`!s:real^M->bool t:real^N->bool. s PCROSS t = {u + v | u IN IMAGE (\x. pastecart x (vec 0)) s /\ v IN IMAGE (\y. pastecart (vec 0) y) t}`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [PASTECART_AS_ORTHOGONAL_SUM] THEN SET_TAC[]);; let DIM_PCROSS = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t ==> dim(s PCROSS t) = dim s + dim t`, REPEAT STRIP_TAC THEN REWRITE_TAC[PCROSS_AS_ORTHOGONAL_SUM] THEN W(MP_TAC o PART_MATCH (lhand o lhand o rand) DIM_SUMS_INTER o lhand o snd) THEN ANTS_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC SUBSPACE_LINEAR_IMAGE; MATCH_MP_TAC(ARITH_RULE `c = d /\ b = 0 ==> a + b = c ==> a = d`) THEN CONJ_TAC THENL [BINOP_TAC THEN MATCH_MP_TAC DIM_INJECTIVE_LINEAR_IMAGE THEN SIMP_TAC[PASTECART_INJ]; REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER; IN_IMAGE; IN_SING] THEN REWRITE_TAC[PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[FSTCART_VEC; SNDCART_VEC]]] THEN ASM_REWRITE_TAC[linear; GSYM PASTECART_VEC] THEN REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; PASTECART_INJ] THEN VECTOR_ARITH_TAC);; let SPAN_PCROSS_SUBSET = prove (`!s:real^M->bool t:real^N->bool. span(s PCROSS t) SUBSET (span s) PCROSS (span t)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN SIMP_TAC[SUBSPACE_PCROSS; SUBSPACE_SPAN; PCROSS_MONO; SPAN_INC]);; let SPAN_PCROSS = prove (`!s:real^M->bool t:real^N->bool. ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t) ==> span(s PCROSS t) = (span s) PCROSS (span t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SPAN_PCROSS_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN ONCE_REWRITE_TAC[PASTECART_AS_ORTHOGONAL_SUM] THEN SUBGOAL_THEN `(!x:real^M. x IN span s ==> pastecart x (vec 0) IN span(s PCROSS t)) /\ (!y:real^N. y IN span t ==> pastecart (vec 0) y IN span(s PCROSS t))` (fun th -> ASM_MESON_TAC[th; SPAN_ADD]) THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[IN_ELIM_THM] THEN (CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]; REWRITE_TAC[subspace; IN_ELIM_THM; PASTECART_VEC; SPAN_0] THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP SPAN_ADD) THEN REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID]; DISCH_THEN(MP_TAC o MATCH_MP SPAN_MUL) THEN SIMP_TAC[GSYM PASTECART_CMUL; VECTOR_MUL_RZERO]]]) THENL [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN SUBGOAL_THEN `pastecart x (vec 0) = pastecart (x:real^M) (y:real^N) - pastecart (vec 0) y` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC; MATCH_MP_TAC SPAN_SUB THEN ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]]; X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN SUBGOAL_THEN `pastecart (vec 0) y = pastecart (x:real^M) (y:real^N) - pastecart x (vec 0)` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC; MATCH_MP_TAC SPAN_SUB THEN ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]]]);; let DIM_PCROSS_STRONG = prove (`!s:real^M->bool t:real^N->bool. ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t) ==> dim(s PCROSS t) = dim s + dim t`, ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN SIMP_TAC[SPAN_PCROSS; DIM_PCROSS; SUBSPACE_SPAN]);; let SPAN_SUMS = prove (`!s t:real^N->bool. ~(s = {}) /\ ~(t = {}) /\ vec 0 IN (s UNION t) ==> span {x + y | x IN s /\ y IN t} = {x + y | x IN span s /\ y IN span t}`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SPAN_UNION] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_GSPEC] THEN SIMP_TAC[SPAN_ADD; IN_UNION; SPAN_SUPERSET] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [IN_UNION]) THENL [UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN SUBST1_TAC(VECTOR_ARITH `x:real^N = (x + y) - (vec 0 + y)`) THEN MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[VECTOR_ADD_RID]; MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[VECTOR_ADD_LID]; UNDISCH_TAC `~(s:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN SUBST1_TAC(VECTOR_ARITH `x:real^N = (y + x) - (y + vec 0)`) THEN MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* More about rank from the rank/nullspace formula. *) (* ------------------------------------------------------------------------- *) let RANK_NULLSPACE = prove (`!A:real^M^N. rank A + dim {x | A ** x = vec 0} = dimindex(:M)`, GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN MATCH_MP_TAC DIM_IMAGE_KERNEL THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; let RANK_SYLVESTER = prove (`!A:real^N^M B:real^P^N. rank(A) + rank(B) <= rank(A ** B) + dimindex(:N)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE `!ia ib iab p:num. ra + ia = n /\ rb + ib = p /\ rab + iab = p /\ iab <= ia + ib ==> ra + rb <= rab + n`) THEN MAP_EVERY EXISTS_TAC [`dim {x | (A:real^N^M) ** x = vec 0}`; `dim {x | (B:real^P^N) ** x = vec 0}`; `dim {x | ((A:real^N^M) ** (B:real^P^N)) ** x = vec 0}`; `dimindex(:P)`] THEN REWRITE_TAC[RANK_NULLSPACE] THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] DIM_KERNEL_COMPOSE) THEN CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; let RANK_GRAM = prove (`!A:real^M^N. rank(transp A ** A) = rank A`, GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE `!n n' k. r + n:num = k /\ r' + n' = k /\ n = n' ==> r = r'`) THEN MAP_EVERY EXISTS_TAC [`dim {x | (transp A ** (A:real^M^N)) ** x = vec 0}`; `dim {x | (A:real^M^N) ** x = vec 0}`; `dimindex(:M)`] THEN REWRITE_TAC[RANK_NULLSPACE] THEN AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN SIMP_TAC[SUBSET; IN_ELIM_THM; GSYM MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_RZERO] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o AP_TERM `(dot) (x:real^M)`) THEN ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP; DOT_RZERO] THEN REWRITE_TAC[DOT_EQ_0]);; let RANK_TRIANGLE = prove (`!A B:real^M^N. rank(A + B) <= rank(A) + rank(B)`, REPEAT GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN MP_TAC(ISPECL [`IMAGE (\x. (A:real^M^N) ** x) (:real^M)`; `IMAGE (\x. (B:real^M^N) ** x) (:real^M)`] DIM_SUMS_INTER) THEN ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE; SUBSPACE_UNIV; MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(ARITH_RULE `x:num <= y ==> x <= y + z`) THEN MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; MATRIX_VECTOR_MUL_ADD_RDISTRIB] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);; let COVARIANCE_MATRIX_EQ_0 = prove (`!A:real^N^M. transp A ** A = mat 0 <=> A = mat 0`, REWRITE_TAC[GSYM RANK_EQ_0; RANK_GRAM]);; let MATRIX_MUL_COVARIANCE_LCANCEL = prove (`!A:real^N^P B C:real^M^N. (transp A ** A) ** B = (transp A ** A) ** C <=> A ** B = A ** C`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[GSYM MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM MATRIX_SUB_EQ] THEN GEN_REWRITE_TAC RAND_CONV [GSYM COVARIANCE_MATRIX_EQ_0] THEN MATCH_MP_TAC(MESON[MATRIX_MUL_RZERO] `(?C:real^M^N. C ** A = B) ==> A = mat 0 ==> B = mat 0`) THEN EXISTS_TAC `transp(B - C:real^M^N)` THEN REWRITE_TAC[TRANSP_MATRIX_SUB; MATRIX_TRANSP_MUL] THEN REWRITE_TAC[MATRIX_SUB_LDISTRIB; MATRIX_SUB_RDISTRIB] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC]);; let MATRIX_MUL_COVARIANCE_RCANCEL = prove (`!A:real^P^N B C:real^N^M. B ** (A ** transp A) = C ** (A ** transp A) <=> B ** A = C ** A`, ONCE_REWRITE_TAC[GSYM TRANSP_EQ] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN REWRITE_TAC[MATRIX_MUL_COVARIANCE_LCANCEL]);; let MATRIX_VECTOR_MUL_COVARIANCE_EQ_0 = prove (`!A:real^M^N x. (transp A ** A) ** x = vec 0 <=> A ** x = vec 0`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN EQ_TAC THEN SIMP_TAC[MATRIX_VECTOR_MUL_RZERO] THEN DISCH_THEN(MP_TAC o AP_TERM `(dot) (x:real^M)`) THEN REWRITE_TAC[DOT_MATRIX_TRANSP_RMUL; DOT_RZERO] THEN REWRITE_TAC[DOT_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Inverse matrices. These are actually, in general, Moore-Penrose *) (* pseudoinverses, but collapse to the usual inverse in the invertible case. *) (* The extra generality gives some cleaner theorems (e.g. MATRIX_INV_INV) *) (* and might have some other applications one day. *) (* ------------------------------------------------------------------------- *) let matrix_inv = new_definition `matrix_inv (A:real^M^N) = matrix(\y. @x. (!w. A ** w = vec 0 ==> orthogonal x w) /\ (!z. orthogonal (y - A ** x) (A ** z)))`;; let MOORE_PENROSE_PSEUDOINVERSE,MOORE_PENROSE_PSEUDOINVERSE_UNIQUE = let lemma_existence = prove (`!f:real^M->real^N y. linear f ==> ?x. (!w. f w = vec 0 ==> orthogonal x w) /\ (!z. orthogonal (y - f x) (f z))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?u. !z. orthogonal (y - (f:real^M->real^N) u) (f z)` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`IMAGE (f:real^M->real^N) UNIV`; `y:real^N`] ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_LINEAR_IMAGE; SUBSPACE_UNIV] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_ARITH `y:real^N = x + z <=> y - x = z`]; MP_TAC(ISPECL [`{v | (f:real^M->real^N) v = vec 0}`; `u:real^M`] ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_KERNEL] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `y:real^N = x + z <=> y - x = z`] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^M` STRIP_ASSUME_TAC) THEN EXPAND_TAC "w" THEN ASM_SIMP_TAC[LINEAR_SUB; VECTOR_SUB_RZERO]]) and lemma_uniqueness = prove (`!A:real^M^N u v y. (!w. A ** w = vec 0 ==> orthogonal u w) /\ (!z. orthogonal (y - A ** u) (A ** z)) /\ (!w. A ** w = vec 0 ==> orthogonal v w) /\ (!z. orthogonal (y - A ** v) (A ** z)) ==> u = v`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN MATCH_MP_TAC(last(CONJUNCTS ORTHOGONAL_CLAUSES)) THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN (SUBGOAL_THEN `(A:real^M^N) ** (u - v:real^M) = (y - A ** v) - (y - A ** u)` MP_TAC THENL [SIMP_TAC[MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN CONV_TAC VECTOR_ARITH; DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th])]) THEN ASM_MESON_TAC[ORTHOGONAL_CLAUSES]) in let MOORE_PENROSE_PSEUDOINVERSE = prove (`!A:real^M^N y. (!w. A ** w = vec 0 ==> orthogonal (matrix_inv A ** y) w) /\ (!z. orthogonal (y - A ** (matrix_inv A ** y)) (A ** z))`, REPEAT GEN_TAC THEN REWRITE_TAC[matrix_inv] THEN MP_TAC(ISPEC `\x:real^M. (A:real^M^N) ** x` lemma_existence) THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN DISCH_THEN(MP_TAC o GEN `y:real^N` o SELECT_RULE o SPEC `y:real^N`) THEN ABBREV_TAC `f y = @x. (!w. (A:real^M^N) ** w = vec 0 ==> orthogonal x w) /\ (!z. orthogonal (y - A ** x) (A ** z))` THEN REWRITE_TAC[FORALL_AND_THM; ETA_AX] THEN STRIP_TAC THEN SUBGOAL_THEN `linear(f:real^N->real^M)` ASSUME_TAC THENL [ALL_TAC; ASM_SIMP_TAC[MATRIX_WORKS]] THEN REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma_uniqueness THEN EXISTS_TAC `A:real^M^N` THENL [EXISTS_TAC `x + y:real^N`; EXISTS_TAC `c % x:real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[ORTHOGONAL_CLAUSES; MATRIX_VECTOR_MUL_RMUL; GSYM VECTOR_SUB_LDISTRIB; MATRIX_VECTOR_MUL_ADD_LDISTRIB; VECTOR_ARITH `(x + y) - (u + v):real^N = (x - u) + (y - v)`]) in let MOORE_PENROSE_PSEUDOINVERSE_UNIQUE = prove (`!A:real^M^N x y. (!w. A ** w = vec 0 ==> orthogonal x w) /\ (!z. orthogonal (y - A ** x) (A ** z)) ==> matrix_inv A ** y = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma_uniqueness THEN EXISTS_TAC `A:real^M^N` THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[MOORE_PENROSE_PSEUDOINVERSE]) in MOORE_PENROSE_PSEUDOINVERSE,MOORE_PENROSE_PSEUDOINVERSE_UNIQUE;; let MATRIX_INV_MUL_INNER = prove (`!A:real^M^N. A ** matrix_inv A ** A = A`, SIMP_TAC[MATRIX_EQ; MATRIX_MUL_ASSOC; GSYM MATRIX_VECTOR_MUL_ASSOC] THEN REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN GEN_REWRITE_TAC RAND_CONV [GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN REWRITE_TAC[MOORE_PENROSE_PSEUDOINVERSE]);; let SYMMETRIC_MATRIX_INV_RMUL = prove (`!A:real^M^N. transp(A ** matrix_inv A) = A ** matrix_inv A`, GEN_TAC THEN MP_TAC(ISPEC `\x:real^N. ((A:real^M^N) ** matrix_inv A) ** x` ORTHOGONAL_PROJECTION_EQ_SELF_ADJOINT_IDEMPOTENT) THEN SIMP_TAC[ADJOINT_MATRIX; ORTHOGONAL_PROJECTION_ALT; MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LINEAR; o_DEF; FUN_EQ_THM; GSYM MATRIX_EQ] THEN MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`) THEN ONCE_REWRITE_TAC[GSYM ORTHOGONAL_LNEG] THEN REWRITE_TAC[VECTOR_NEG_SUB; GSYM MATRIX_VECTOR_MUL_ASSOC] THEN REWRITE_TAC[MOORE_PENROSE_PSEUDOINVERSE]);; let MATRIX_INV_INV = prove (`!A:real^M^N. matrix_inv (matrix_inv A) = A`, REWRITE_TAC[MATRIX_EQ] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MOORE_PENROSE_PSEUDOINVERSE_UNIQUE THEN MP_TAC(ISPEC `A:real^M^N` MOORE_PENROSE_PSEUDOINVERSE) THEN REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N`; `x:real^M`]) THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO; ORTHOGONAL_SYM; MATRIX_VECTOR_MUL_RZERO]; ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_LDISTRIB; VECTOR_SUB_EQ] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; GSYM MATRIX_MUL_ASSOC] THEN REWRITE_TAC[MATRIX_INV_MUL_INNER]]);; let MATRIX_INV_EQ = prove (`!A B:real^M^N. matrix_inv A = matrix_inv B <=> A = B`, MESON_TAC[MATRIX_INV_INV]);; let MATRIX_INV_MUL_OUTER = prove (`!A:real^M^N. matrix_inv A ** A ** matrix_inv A = matrix_inv A`, GEN_TAC THEN MP_TAC(ISPEC `matrix_inv(A:real^M^N)` MATRIX_INV_MUL_INNER) THEN REWRITE_TAC[MATRIX_INV_INV]);; let SYMMETRIC_MATRIX_INV_LMUL = prove (`!A:real^M^N. transp(matrix_inv A ** A) = matrix_inv A ** A`, GEN_TAC THEN MP_TAC(ISPEC `matrix_inv(A:real^M^N)` SYMMETRIC_MATRIX_INV_RMUL) THEN REWRITE_TAC[MATRIX_INV_INV]);; let MATRIX_INV_UNIQUE_STRONG = prove (`!A:real^M^N X. A ** X ** A = A /\ X ** A ** X = X /\ transp(A ** X) = A ** X /\ transp(X ** A) = X ** A ==> matrix_inv A = X`, REPEAT STRIP_TAC THEN MAP_EVERY (ASSUME_TAC o ISPEC `A:real^M^N`) [MATRIX_INV_MUL_OUTER; SYMMETRIC_MATRIX_INV_RMUL; MATRIX_INV_MUL_INNER; SYMMETRIC_MATRIX_INV_LMUL] THEN ABBREV_TAC `Y = matrix_inv(A:real^M^N)` THEN POP_ASSUM(K ALL_TAC) THEN CONV_TAC SYM_CONV THEN SUBGOAL_THEN `(X:real^N^M) ** (A:real^M^N) ** X = Y ** A ** Y` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN TRANS_TAC EQ_TRANS `(X:real^N^M) ** (A:real^M^N) ** (Y:real^N^M)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN TRANS_TAC EQ_TRANS `transp(X:real^N^M) ** transp(A ** (Y:real^N^M) ** A)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM MATRIX_TRANSP_MUL]; ALL_TAC] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC]; REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN TRANS_TAC EQ_TRANS `transp(A ** (Y:real^N^M) ** A) ** transp(X:real^N^M)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[GSYM MATRIX_TRANSP_MUL]; ALL_TAC] THEN ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM MATRIX_TRANSP_MUL] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC]]);; let MATRIX_INV_TRANSP = prove (`!A:real^M^N. matrix_inv (transp A) = transp(matrix_inv A)`, GEN_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN REWRITE_TAC[TRANSP_EQ; GSYM MATRIX_MUL_ASSOC] THEN REWRITE_TAC[MATRIX_INV_MUL_INNER; MATRIX_INV_MUL_OUTER; SYMMETRIC_MATRIX_INV_RMUL; SYMMETRIC_MATRIX_INV_LMUL]);; let TRANSP_MATRIX_INV = prove (`!A:real^M^N. transp(matrix_inv A) = matrix_inv(transp A)`, REWRITE_TAC[MATRIX_INV_TRANSP]);; let SYMMETRIC_MATRIX_INV = prove (`!A:real^N^N. transp(matrix_inv A) = matrix_inv A <=> transp A = A`, REWRITE_TAC[TRANSP_MATRIX_INV; MATRIX_INV_EQ]);; let MATRIX_INV_0 = prove (`matrix_inv(mat 0:real^M^N) = mat 0`, MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN REWRITE_TAC[MATRIX_MUL_LZERO; MATRIX_MUL_RZERO; TRANSP_MAT]);; let MATRIX_INV_EQ_0 = prove (`!A:real^M^N. matrix_inv A = mat 0 <=> A = mat 0`, MESON_TAC[MATRIX_INV_0; MATRIX_INV_INV]);; let MATRIX_INV_CMUL = prove (`!c A:real^M^N. matrix_inv (c %% A) = inv(c) %% matrix_inv A`, REPEAT GEN_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL; TRANSP_MATRIX_CMUL] THEN REWRITE_TAC[MATRIX_CMUL_ASSOC; MATRIX_INV_MUL_INNER; MATRIX_INV_MUL_OUTER; SYMMETRIC_MATRIX_INV_RMUL; SYMMETRIC_MATRIX_INV_LMUL] THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[REAL_INV_0; MATRIX_CMUL_LZERO; REAL_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV; REAL_MUL_LID]);; let MATRIX_INV = prove (`!A:real^N^M. invertible A ==> A ** matrix_inv A = mat 1 /\ matrix_inv A ** A = mat 1`, GEN_TAC THEN REWRITE_TAC[invertible] THEN DISCH_THEN(X_CHOOSE_THEN `B:real^M^N` STRIP_ASSUME_TAC) THEN MP_TAC(AP_TERM `\A:real^N^M. (B:real^M^N) ** A` (ISPEC `A:real^N^M` MATRIX_INV_MUL_INNER)) THEN MP_TAC(AP_TERM `\A:real^N^M. A ** (B:real^M^N)` (ISPEC `A:real^N^M` MATRIX_INV_MUL_INNER)) THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN SIMP_TAC[MATRIX_MUL_LID]);; let MATRIX_INV_LEFT = prove (`!A:real^N^N. matrix_inv A ** A = mat 1 <=> invertible A`, MESON_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_INV]);; let MATRIX_INV_RIGHT = prove (`!A:real^N^N. A ** matrix_inv A = mat 1 <=> invertible A`, MESON_TAC[INVERTIBLE_RIGHT_INVERSE; MATRIX_INV]);; let MATRIX_MUL_LCANCEL = prove (`!A:real^M^N B:real^P^M C. invertible A ==> (A ** B = A ** C <=> B = C)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP MATRIX_INV) THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `matrix_mul (matrix_inv(A:real^M^N)):real^P^N->real^P^M`) THEN ASM_SIMP_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]);; let MATRIX_MUL_RCANCEL = prove (`!A B:real^M^N C:real^P^M. invertible C ==> (A ** C = B ** C <=> A = B)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP MATRIX_INV) THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `\A:real^P^N. A ** matrix_inv(C:real^P^M)`) THEN ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]);; let RANK_INVERTIBLE_RMUL = prove (`!A:real^M^N B:real^P^M. invertible B ==> rank(A ** B) = rank A`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM; RANK_MUL_LE_LEFT] THEN TRANS_TAC LE_TRANS `rank(((A:real^M^N) ** (B:real^P^M)) ** matrix_inv B)` THEN REWRITE_TAC[RANK_MUL_LE_LEFT] THEN ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV] THEN REWRITE_TAC[LE_REFL; MATRIX_MUL_RID]);; let RANK_INVERTIBLE_LMUL = prove (`!A:real^M^N B:real^P^M. invertible A ==> rank(A ** B) = rank B`, ONCE_REWRITE_TAC[GSYM RANK_TRANSP] THEN SIMP_TAC[MATRIX_TRANSP_MUL; RANK_INVERTIBLE_RMUL; INVERTIBLE_TRANSP]);; let RANK_CMUL = prove (`!A:real^N^M c. rank(c %% A) = if c = &0 then 0 else rank A`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MATRIX_CMUL_LZERO; RANK_0] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM MATRIX_MUL_LID] THEN REWRITE_TAC[GSYM MATRIX_MUL_LMUL] THEN MATCH_MP_TAC RANK_INVERTIBLE_LMUL THEN ASM_REWRITE_TAC[INVERTIBLE_CMUL; INVERTIBLE_I]);; let RANK_NEG = prove (`!A:real^N^M. rank(--A) = rank A`, REWRITE_TAC[MATRIX_NEG_MINUS1; RANK_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let MATRIX_INV_UNIQUE = prove (`!A:real^N^M B. A ** B = mat 1 /\ B ** A = mat 1 ==> matrix_inv A = B`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN ASM_REWRITE_TAC[TRANSP_MAT; MATRIX_MUL_RID]);; let MATRIX_INV_I = prove (`matrix_inv(mat 1:real^N^N) = mat 1`, MATCH_MP_TAC MATRIX_INV_UNIQUE THEN REWRITE_TAC[MATRIX_MUL_LID]);; let INVERTIBLE_MATRIX_INV = prove (`!A:real^M^N. invertible(matrix_inv A) <=> invertible A`, MESON_TAC[MATRIX_INV_INV; MATRIX_INV; invertible]);; let MATRIX_INV_UNIQUE_LEFT = prove (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv B = A`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);; let MATRIX_INV_UNIQUE_RIGHT = prove (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv A = B`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);; let MATRIX_INV_COVARIANCE = prove (`!A:real^M^N. matrix_inv(transp A ** A) = matrix_inv(A) ** transp(matrix_inv A)`, GEN_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MESON[MATRIX_MUL_ASSOC; MATRIX_TRANSP_MUL] `(A:real^M^N) ** transp B ** transp C ** (D:real^P^Q) = A ** transp(C ** B) ** D`] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_LMUL; SYMMETRIC_MATRIX_INV_RMUL] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV_MUL_INNER] THEN REWRITE_TAC[EQT_ELIM(REWRITE_CONV[MATRIX_MUL_ASSOC] `(A:real^M^N) ** B ** C ** (D:real^P^Q) = (A ** B ** C) ** D`)] THEN REWRITE_TAC[MATRIX_INV_MUL_OUTER] THEN MATCH_MP_TAC(MESON[] `y = x ==> x = y /\ y = x`) THEN ONCE_REWRITE_TAC[GSYM SYMMETRIC_MATRIX_INV_RMUL] THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV_MUL_INNER] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_LMUL]);; let COVARIANCE_MATRIX_INV = prove (`!A:real^M^N. transp(matrix_inv A) ** matrix_inv A = matrix_inv(A ** transp A)`, ONCE_REWRITE_TAC[GSYM MATRIX_INV_EQ] THEN REWRITE_TAC[MATRIX_INV_INV; MATRIX_INV_COVARIANCE]);; let NORMAL_MATRIX_INV = prove (`!A:real^N^N. transp(matrix_inv A) ** matrix_inv A = matrix_inv A ** transp(matrix_inv A) <=> transp A ** A = A ** transp A`, REWRITE_TAC[GSYM MATRIX_INV_COVARIANCE; COVARIANCE_MATRIX_INV] THEN REWRITE_TAC[MATRIX_INV_EQ] THEN MESON_TAC[]);; let MATRIX_INV_COVARIANCE_RMUL = prove (`!A:real^M^N. matrix_inv(transp A ** A) ** transp A = matrix_inv A`, REWRITE_TAC[MATRIX_INV_COVARIANCE] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_RMUL; MATRIX_INV_MUL_OUTER]);; let MATRIX_INV_COVARIANCE_LMUL = prove (`!A:real^M^N. transp(A) ** matrix_inv(A ** transp A) = matrix_inv A`, REWRITE_TAC[GSYM COVARIANCE_MATRIX_INV] THEN REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; MATRIX_MUL_ASSOC] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_LMUL; GSYM MATRIX_MUL_ASSOC] THEN REWRITE_TAC[MATRIX_INV_MUL_OUTER]);; let RANK_SIMILAR = prove (`!A:real^N^N U:real^M^N. invertible U ==> rank(matrix_inv U ** A ** U) = rank A`, SIMP_TAC[RANK_INVERTIBLE_RMUL; RANK_INVERTIBLE_LMUL; INVERTIBLE_MATRIX_INV]);; let RANK_MATRIX_INV = prove (`!A:real^M^N. rank(matrix_inv A) = rank A`, GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM MATRIX_INV_MUL_INNER] THEN REWRITE_TAC[MATRIX_INV_INV] THEN MATCH_MP_TAC(MESON[LE_TRANS] `rank(A ** B ** C) <= rank(B ** C) /\ rank(B ** C) <= rank B ==> rank(A ** B ** C) <= rank B`) THEN REWRITE_TAC[RANK_MUL_LE_RIGHT; RANK_MUL_LE_LEFT]);; let RANK_MATRIX_INV_RMUL = prove (`!A:real^M^N. rank(A ** matrix_inv A) = rank A`, GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN REWRITE_TAC[RANK_MUL_LE_LEFT] THEN GEN_REWRITE_TAC LAND_CONV [GSYM RANK_MATRIX_INV] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM MATRIX_INV_MUL_OUTER] THEN REWRITE_TAC[RANK_MUL_LE_RIGHT]);; let RANK_MATRIX_INV_LMUL = prove (`!A:real^M^N. rank(matrix_inv A ** A) = rank A`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM RANK_TRANSP] THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_MATRIX_INV; RANK_MATRIX_INV_RMUL]);; let MATRIX_INV_MULTIPLE_TRANP_RIGHT = prove (`!A:real^M^N. matrix_inv A = matrix_inv A ** transp(matrix_inv A) ** transp A`, REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; SYMMETRIC_MATRIX_INV_RMUL] THEN REWRITE_TAC[MATRIX_INV_MUL_OUTER]);; let MATRIX_TRANSP_MULTIPLE_INV_RIGHT = prove (`!A:real^M^N. transp A = transp A ** A ** matrix_inv A`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM MATRIX_INV_MUL_INNER] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_RMUL] THEN REWRITE_TAC[MATRIX_MUL_ASSOC]);; let MATRIX_INV_MULTIPLE_TRANP_LEFT = prove (`!A:real^M^N. matrix_inv A = transp A ** transp(matrix_inv A) ** matrix_inv A`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MATRIX_INV_MUL_OUTER] THEN REWRITE_TAC[MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_LMUL]);; let MATRIX_TRANSP_MULTIPLE_INV_LEFT = prove (`!A:real^M^N. transp A = matrix_inv A ** A ** transp A`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM MATRIX_INV_MUL_INNER] THEN ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_LMUL] THEN REWRITE_TAC[MATRIX_MUL_ASSOC]);; let MATRIX_VECTOR_MUL_INV_EQ_0 = prove (`!A:real^M^N. matrix_inv A ** x = vec 0 <=> transp A ** x = vec 0`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [ONCE_REWRITE_TAC[MATRIX_TRANSP_MULTIPLE_INV_RIGHT]; ONCE_REWRITE_TAC[MATRIX_INV_MULTIPLE_TRANP_RIGHT]] THEN ASM_REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_RZERO]);; let KERNEL_MATRIX_INV = prove (`!A:real^M^N. {x | matrix_inv A ** x = vec 0} = {x | transp A ** x = vec 0}`, REWRITE_TAC[MATRIX_VECTOR_MUL_INV_EQ_0]);; let IMAGE_MATRIX_INV = prove (`!A:real^M^N. IMAGE (\x:real^N. matrix_inv A ** x) UNIV = IMAGE (\x. transp A ** x) UNIV`, GEN_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THENL [ONCE_REWRITE_TAC[MATRIX_INV_MULTIPLE_TRANP_LEFT]; ONCE_REWRITE_TAC[MATRIX_TRANSP_MULTIPLE_INV_LEFT]] THEN REWRITE_TAC[IN_UNIV; IN_IMAGE; GSYM MATRIX_VECTOR_MUL_ASSOC] THEN MESON_TAC[]);; let COMMUTING_MATRIX_INV_COVARIANCE = prove (`!A:real^M^N. matrix_inv(transp A ** A) ** (transp A ** A) = (transp A ** A) ** matrix_inv(transp A ** A)`, GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM SYMMETRIC_MATRIX_INV_RMUL] THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_MATRIX_INV; TRANSP_TRANSP]);; let COMMUTING_MATRIX_INV_NORMAL = prove (`!A:real^N^N. transp A ** A = A ** transp A ==> matrix_inv A ** A = A ** matrix_inv A`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM MATRIX_INV_COVARIANCE_RMUL] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM MATRIX_INV_COVARIANCE_LMUL] THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN ONCE_REWRITE_TAC[COMMUTING_MATRIX_INV_COVARIANCE] THEN ASM_REWRITE_TAC[MATRIX_MUL_ASSOC]);; let MATRIX_MUL_INV_EQ_0 = prove (`!A:real^P^N B:real^N^M. matrix_inv A ** matrix_inv B = mat 0 <=> B ** A = mat 0`, let lemma = prove (`!A:real^P^N B:real^N^M. B ** A = mat 0 ==> matrix_inv A ** matrix_inv B = mat 0`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [MATRIX_INV_MULTIPLE_TRANP_RIGHT] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MATRIX_INV_MULTIPLE_TRANP_LEFT] THEN ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV) [GSYM MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[MATRIX_MUL_LZERO; MATRIX_MUL_RZERO; TRANSP_MAT]) in REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN REWRITE_TAC[MATRIX_INV_INV]);; let MATRIX_INV_IDEMPOTENT = prove (`!A:real^N^N. transp A = A /\ A ** A = A ==> matrix_inv A = A`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN ASM_REWRITE_TAC[MATRIX_TRANSP_MUL]);; let IDEMPOTENT_MATRIX_MUL_LINV = prove (`!A:real^N^M. (matrix_inv A ** A) ** (matrix_inv A ** A) = matrix_inv A ** A`, GEN_TAC THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV_MUL_OUTER]);; let IDEMPOTENT_MATRIX_MUL_RINV = prove (`!A:real^N^M. (A ** matrix_inv A) ** (A ** matrix_inv A) = A ** matrix_inv A`, GEN_TAC THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV_MUL_INNER]);; let MATRIX_INV_MUL_LINV = prove (`!A:real^N^M. matrix_inv(matrix_inv A ** A) = matrix_inv A ** A`, GEN_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_TRANSP_MUL; TRANSP_MATRIX_INV] THEN REWRITE_TAC[MATRIX_INV_MUL_INNER; MATRIX_INV_MUL_OUTER] THEN REWRITE_TAC[GSYM TRANSP_MATRIX_INV; GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_LMUL]);; let MATRIX_INV_MUL_RINV = prove (`!A:real^N^M. matrix_inv(A ** matrix_inv A) = A ** matrix_inv A`, GEN_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE_STRONG THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_TRANSP_MUL; TRANSP_MATRIX_INV] THEN REWRITE_TAC[MATRIX_INV_MUL_INNER; MATRIX_INV_MUL_OUTER] THEN REWRITE_TAC[GSYM TRANSP_MATRIX_INV; GSYM MATRIX_TRANSP_MUL] THEN REWRITE_TAC[SYMMETRIC_MATRIX_INV_RMUL]);; (* ------------------------------------------------------------------------- *) (* Infinity norm. *) (* ------------------------------------------------------------------------- *) let infnorm = define `infnorm (x:real^N) = sup { abs(x$i) | 1 <= i /\ i <= dimindex(:N) }`;; let NUMSEG_DIMINDEX_NONEMPTY = prove (`?i. i IN 1..dimindex(:N)`, REWRITE_TAC[MEMBER_NOT_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);; let INFNORM_SET_IMAGE = prove (`{abs(x$i) | 1 <= i /\ i <= dimindex(:N)} = IMAGE (\i. abs(x$i)) (1..dimindex(:N))`, REWRITE_TAC[numseg] THEN SET_TAC[]);; let INFNORM_SET_LEMMA = prove (`FINITE {abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N)} /\ ~({abs(x$i) | 1 <= i /\ i <= dimindex(:N)} = {})`, SIMP_TAC[INFNORM_SET_IMAGE; FINITE_NUMSEG; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);; let INFNORM_POS_LE = prove (`!x. &0 <= infnorm x`, REWRITE_TAC[infnorm] THEN SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN REWRITE_TAC[INFNORM_SET_IMAGE; NUMSEG_DIMINDEX_NONEMPTY; EXISTS_IN_IMAGE; REAL_ABS_POS]);; let INFNORM_TRIANGLE = prove (`!x y. infnorm(x + y) <= infnorm x + infnorm y`, REWRITE_TAC[infnorm] THEN SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN REWRITE_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; GSYM IN_NUMSEG] THEN MESON_TAC[NUMSEG_DIMINDEX_NONEMPTY; REAL_ARITH `abs(x + y) - abs(x) <= abs(y)`]);; let INFNORM_EQ_0 = prove (`!x. infnorm x = &0 <=> x = vec 0`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_POS_LE] THEN SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN SIMP_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE; CART_EQ; VEC_COMPONENT] THEN REWRITE_TAC[IN_NUMSEG; REAL_ARITH `abs(x) <= &0 <=> x = &0`]);; let INFNORM_0 = prove (`infnorm(vec 0) = &0`, REWRITE_TAC[INFNORM_EQ_0]);; let INFNORM_NEG = prove (`!x. infnorm(--x) = infnorm x`, GEN_TAC THEN REWRITE_TAC[infnorm] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[REAL_ABS_NEG; VECTOR_NEG_COMPONENT]);; let INFNORM_SUB = prove (`!x y. infnorm(x - y) = infnorm(y - x)`, MESON_TAC[INFNORM_NEG; VECTOR_NEG_SUB]);; let REAL_ABS_SUB_INFNORM = prove (`abs(infnorm x - infnorm y) <= infnorm(x - y)`, MATCH_MP_TAC(REAL_ARITH `nx <= n + ny /\ ny <= n + nx ==> abs(nx - ny) <= n`) THEN MESON_TAC[INFNORM_SUB; VECTOR_SUB_ADD2; INFNORM_TRIANGLE; VECTOR_ADD_SYM]);; let REAL_ABS_INFNORM = prove (`!x. abs(infnorm x) = infnorm x`, REWRITE_TAC[real_abs; INFNORM_POS_LE]);; let COMPONENT_LE_INFNORM = prove (`!x:real^N i. 1 <= i /\ i <= dimindex (:N) ==> abs(x$i) <= infnorm x`, REPEAT GEN_TAC THEN REWRITE_TAC[infnorm] THEN MP_TAC(SPEC `{ abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N) }` SUP_FINITE) THEN REWRITE_TAC[INFNORM_SET_LEMMA] THEN SIMP_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; IN_NUMSEG]);; let INFNORM_MUL_LEMMA = prove (`!a x. infnorm(a % x) <= abs a * infnorm x`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [infnorm] THEN SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN REWRITE_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE] THEN SIMP_TAC[REAL_ABS_MUL; VECTOR_MUL_COMPONENT; IN_NUMSEG] THEN SIMP_TAC[COMPONENT_LE_INFNORM; REAL_LE_LMUL; REAL_ABS_POS]);; let INFNORM_MUL = prove (`!a x:real^N. infnorm(a % x) = abs a * infnorm x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INFNORM_0; REAL_ABS_0; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_MUL_LEMMA] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM VECTOR_MUL_LID] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP REAL_MUL_LINV) THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(a) * abs(inv a) * infnorm(a % x:real^N)` THEN ASM_SIMP_TAC[INFNORM_MUL_LEMMA; REAL_LE_LMUL; REAL_ABS_POS] THEN ASM_SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_ABS_MUL; REAL_MUL_RINV] THEN REAL_ARITH_TAC);; let INFNORM_POS_LT = prove (`!x. &0 < infnorm x <=> ~(x = vec 0)`, MESON_TAC[REAL_LT_LE; INFNORM_POS_LE; INFNORM_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Prove that it differs only up to a bound from Euclidean norm. *) (* ------------------------------------------------------------------------- *) let INFNORM_LE_NORM = prove (`!x. infnorm(x) <= norm(x)`, SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[COMPONENT_LE_NORM]);; let NORM_LE_INFNORM = prove (`!x:real^N. norm(x) <= sqrt(&(dimindex(:N))) * infnorm(x)`, GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o funpow 2 RAND_CONV) [GSYM CARD_NUMSEG_1] THEN REWRITE_TAC[vector_norm] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN SIMP_TAC[DOT_POS_LE; SQRT_POS_LE; REAL_POS; REAL_LE_MUL; INFNORM_POS_LE; SQRT_POW_2; REAL_POW_MUL] THEN REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs(y)`) THEN SIMP_TAC[infnorm; REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Equality in Cauchy-Schwarz and triangle inequalities. *) (* ------------------------------------------------------------------------- *) let NORM_CAUCHY_SCHWARZ_EQ = prove (`!x:real^N y. x dot y = norm(x) * norm(y) <=> norm(x) % y = norm(y) % x`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; DOT_LZERO; DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_EQ_0) THEN REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2; REAL_POW_2; VECTOR_SUB_EQ] THEN REWRITE_TAC[DOT_SYM; REAL_ARITH `y * (y * x * x - x * d) - x * (y * d - x * y * y) = &2 * x * y * (x * y - d)`] THEN ASM_SIMP_TAC[REAL_ENTIRE; NORM_EQ_0; REAL_SUB_0; REAL_OF_NUM_EQ; ARITH] THEN REWRITE_TAC[EQ_SYM_EQ]);; let NORM_CAUCHY_SCHWARZ_ABS_EQ = prove (`!x:real^N y. abs(x dot y) = norm(x) * norm(y) <=> norm(x) % y = norm(y) % x \/ norm(x) % y = --norm(y) % x`, SIMP_TAC[REAL_ARITH `&0 <= a ==> (abs x = a <=> x = a \/ --x = a)`; REAL_LE_MUL; NORM_POS_LE; GSYM DOT_RNEG] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [GSYM NORM_NEG] THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_EQ] THEN REWRITE_TAC[NORM_NEG] THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; let NORM_TRIANGLE_EQ = prove (`!x y:real^N. norm(x + y) = norm(x) + norm(y) <=> norm(x) % y = norm(y) % x`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQ] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `norm(x + y:real^N) pow 2 = (norm(x) + norm(y)) pow 2` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_RING `x pow 2 = y pow 2 <=> x = y \/ x + y = &0`] THEN MAP_EVERY (MP_TAC o C ISPEC NORM_POS_LE) [`x + y:real^N`; `x:real^N`; `y:real^N`] THEN REAL_ARITH_TAC; REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; REAL_ARITH `(x + y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`] THEN REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC]);; let DIST_TRIANGLE_EQ = prove (`!x y z. dist(x,z) = dist(x,y) + dist(y,z) <=> norm (x - y) % (y - z) = norm (y - z) % (x - y)`, REWRITE_TAC[GSYM NORM_TRIANGLE_EQ] THEN NORM_ARITH_TAC);; let NORM_CROSS_MULTIPLY = prove (`!a b x y:real^N. a % x = b % y /\ &0 < a /\ &0 < b ==> norm y % x = norm x % y`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_RZERO] THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID; NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_MUL_AC]);; (* ------------------------------------------------------------------------- *) (* Collinearity. *) (* ------------------------------------------------------------------------- *) let collinear = new_definition `collinear s <=> ?u. !x y. x IN s /\ y IN s ==> ?c. x - y = c % u`;; let COLLINEAR_ALT2 = prove (`!s:real^N->bool. collinear s <=> ?u v. !x. x IN s ==> ?c. x - u = c % v`, GEN_TAC THEN REWRITE_TAC[collinear] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [SET_TAC[]; ALL_TAC] THEN MESON_TAC[VECTOR_ARITH `x - u:real^N = c % v /\ y - u = d % v ==> x - y = (c - d) % v`]);; let COLLINEAR_ALT = prove (`!s:real^N->bool. collinear s <=> ?u v. !x. x IN s ==> ?c. x = u + c % v`, REWRITE_TAC[COLLINEAR_ALT2] THEN MESON_TAC[VECTOR_ARITH `x - u:real^N = c % v <=> x = u + c % v`]);; let COLLINEAR_SUBSET = prove (`!s t. collinear t /\ s SUBSET t ==> collinear s`, REWRITE_TAC[collinear] THEN SET_TAC[]);; let COLLINEAR_EMPTY = prove (`collinear {}`, REWRITE_TAC[collinear; NOT_IN_EMPTY]);; let COLLINEAR_SING = prove (`!x. collinear {x}`, SIMP_TAC[collinear; IN_SING; VECTOR_SUB_REFL] THEN MESON_TAC[VECTOR_MUL_LZERO]);; let COLLINEAR_2 = prove (`!x y:real^N. collinear {x,y}`, REPEAT GEN_TAC THEN REWRITE_TAC[collinear; IN_INSERT; NOT_IN_EMPTY] THEN EXISTS_TAC `x - y:real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `&0`; EXISTS_TAC `&1`; EXISTS_TAC `-- &1`; EXISTS_TAC `&0`] THEN VECTOR_ARITH_TAC);; let COLLINEAR_SMALL = prove (`!s. FINITE s /\ CARD s <= 2 ==> collinear s`, REWRITE_TAC[ARITH_RULE `s <= 2 <=> s = 0 \/ s = 1 \/ s = 2`] THEN REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COLLINEAR_EMPTY; COLLINEAR_SING; COLLINEAR_2]);; let COLLINEAR_3 = prove (`!x y z. collinear {x,y,z} <=> collinear {vec 0,x - y,z - y}`, REPEAT GEN_TAC THEN REWRITE_TAC[collinear; FORALL_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM; NOT_IN_EMPTY] THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[VECTOR_ARITH `x - y = (x - y) - vec 0`; VECTOR_ARITH `y - x = vec 0 - (x - y)`; VECTOR_ARITH `x - z:real^N = (x - y) - (z - y)`]);; let COLLINEAR_LEMMA = prove (`!x y:real^N. collinear {vec 0,x,y} <=> x = vec 0 \/ y = vec 0 \/ ?c. y = c % x`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN ASM_REWRITE_TAC[collinear] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real^N` (fun th -> MP_TAC(SPECL [`x:real^N`; `vec 0:real^N`] th) THEN MP_TAC(SPECL [`y:real^N`; `vec 0:real^N`] th))) THEN REWRITE_TAC[IN_INSERT; VECTOR_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` SUBST_ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` SUBST_ALL_TAC) THEN EXISTS_TAC `e / d` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN ASM_SIMP_TAC[REAL_DIV_RMUL]; STRIP_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `&0`; EXISTS_TAC `-- &1`; EXISTS_TAC `--c`; EXISTS_TAC `&1`; EXISTS_TAC `&0`; EXISTS_TAC `&1 - c`; EXISTS_TAC `c:real`; EXISTS_TAC `c - &1`; EXISTS_TAC `&0`] THEN VECTOR_ARITH_TAC]);; let COLLINEAR_LEMMA_ALT = prove (`!x y. collinear {vec 0,x,y} <=> x = vec 0 \/ ?c. y = c % x`, REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[VECTOR_MUL_LZERO]);; let COLLINEAR_SPAN = prove (`!a b:real^N. collinear{vec 0,a,b} <=> a = vec 0 \/ b IN span {a}`, REWRITE_TAC[SPAN_SING; COLLINEAR_LEMMA_ALT] THEN SET_TAC[]);; let NORM_CAUCHY_SCHWARZ_EQUAL = prove (`!x y:real^N. abs(x dot y) = norm(x) * norm(y) <=> collinear {vec 0,x,y}`, REPEAT GEN_TAC THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_ABS_EQ] THEN MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2; NORM_0; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN NO_TAC) THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN EQ_TAC THENL [STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv(norm(x:real^N))):real^N->real^N`); FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (--inv(norm(x:real^N))):real^N->real^N`)] THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_MUL_LNEG; VECTOR_MUL_LID; VECTOR_ARITH `--x = --y <=> x:real^N = y`] THEN MESON_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC(MESON[] `t = a \/ t = b ==> t % x = a % x \/ t % x = b % x`) THEN REWRITE_TAC[GSYM REAL_MUL_LNEG; REAL_ARITH `x * c = d * x <=> x * (c - d) = &0`] THEN ASM_REWRITE_TAC[REAL_ENTIRE; NORM_EQ_0] THEN REAL_ARITH_TAC]);; let DOT_CAUCHY_SCHWARZ_EQUAL = prove (`!x y:real^N. (x dot y) pow 2 = (x dot x) * (y dot y) <=> collinear {vec 0,x,y}`, REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ (u:real = v <=> x = abs y) ==> (u = v <=> x = y)`) THEN SIMP_TAC[NORM_POS_LE; REAL_LE_MUL] THEN REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[REAL_POW_MUL; NORM_POW_2]);; let COLLINEAR_3_EXPAND = prove (`!a b c:real^N. collinear{a,b,c} <=> a = c \/ ?u. b = u % a + (&1 - u) % c`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN ASM_CASES_TAC `a:real^N = c` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `b:real^N = c` THEN ASM_REWRITE_TAC[VECTOR_ARITH `u % c + (&1 - u) % c = c`] THENL [EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC; AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC]);; let COLLINEAR_TRIPLES = prove (`!s a b:real^N. ~(a = b) ==> (collinear(a INSERT b INSERT s) <=> !x. x IN s ==> collinear{a,b,x})`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] COLLINEAR_SUBSET)) THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[SET_RULE `{a,b,x} = {a,x,b}`] THEN ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN DISCH_TAC THEN SUBGOAL_THEN `!x:real^N. x IN (a INSERT b INSERT s) ==> ?u. x = u % a + (&1 - u) % b` MP_TAC THENL [ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN CONJ_TAC THENL [EXISTS_TAC `&1` THEN VECTOR_ARITH_TAC; EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC]; POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN REWRITE_TAC[collinear] THEN EXISTS_TAC `b - a:real^N` THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN MP_TAC(SPEC `y:real^N` th)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `(u % a + (&1 - u) % b) - (v % a + (&1 - v) % b):real^N = (v - u) % (b - a)`] THEN MESON_TAC[]]]);; let COLLINEAR_4_3 = prove (`!a b c d:real^N. ~(a = b) ==> (collinear {a,b,c,d} <=> collinear{a,b,c} /\ collinear{a,b,d})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{c:real^N,d}`; `a:real^N`; `b:real^N`] COLLINEAR_TRIPLES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; let COLLINEAR_3_TRANS = prove (`!a b c d:real^N. collinear{a,b,c} /\ collinear{b,c,d} /\ ~(b = c) ==> collinear{a,b,d}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{b:real^N,c,a,d}` THEN ASM_SIMP_TAC[COLLINEAR_4_3] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]);; let ORTHOGONAL_TO_ORTHOGONAL_2D = prove (`!x y z:real^2. ~(x = vec 0) /\ orthogonal x y /\ orthogonal x z ==> collinear {vec 0,y,z}`, REWRITE_TAC[orthogonal; GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN REWRITE_TAC[DOT_2] THEN CONV_TAC REAL_RING);; let COLLINEAR_3_2D = prove (`!x y z:real^2. collinear{x,y,z} <=> (z$1 - x$1) * (y$2 - x$2) = (y$1 - x$1) * (z$2 - x$2)`, ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);; let COLLINEAR_3_DOT_MULTIPLES = prove (`!a b c:real^N. collinear {a,b,c} <=> ((b - a) dot (b - a)) % (c - a) = ((c - a) dot (b - a)) % (b - a)`, REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC; DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_SUB_REFL]; ONCE_REWRITE_TAC[COLLINEAR_3] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN REWRITE_TAC[GSYM DOT_EQ_0; DOT_RSUB; DOT_LSUB; DOT_RMUL; DOT_LMUL] THEN REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING]);; let ORTHOGONAL_AND_COLLINEAR = prove (`!x y:real^N. orthogonal x y /\ collinear{vec 0,x,y} <=> x = vec 0 \/ y = vec 0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[ORTHOGONAL_0; COLLINEAR_2; SET_RULE `{a,a,b} = {a,b}`] THEN ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[ORTHOGONAL_0; COLLINEAR_2; SET_RULE `{a,b,a} = {a,b}`] THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN ASM_SIMP_TAC[COLLINEAR_LEMMA_ALT; LEFT_IMP_EXISTS_THM] THEN ASM_REWRITE_TAC[ORTHOGONAL_MUL; ORTHOGONAL_REFL] THEN ASM_MESON_TAC[VECTOR_MUL_LZERO]);; (* ------------------------------------------------------------------------- *) (* Between-ness. *) (* ------------------------------------------------------------------------- *) let between = new_definition `between x (a,b) <=> dist(a,b) = dist(a,x) + dist(x,b)`;; let BETWEEN_REFL = prove (`!a b. between a (a,b) /\ between b (a,b) /\ between a (a,a)`, REWRITE_TAC[between] THEN NORM_ARITH_TAC);; let BETWEEN_REFL_EQ = prove (`!a x. between x (a,a) <=> x = a`, REWRITE_TAC[between] THEN NORM_ARITH_TAC);; let BETWEEN_SYM = prove (`!a b x. between x (a,b) <=> between x (b,a)`, REWRITE_TAC[between] THEN NORM_ARITH_TAC);; let BETWEEN_ANTISYM = prove (`!a b c. between a (b,c) /\ between b (a,c) ==> a = b`, REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);; let BETWEEN_TRANS = prove (`!a b c d. between a (b,c) /\ between d (a,c) ==> between d (b,c)`, REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);; let BETWEEN_TRANS_2 = prove (`!a b c d. between a (b,c) /\ between d (a,b) ==> between a (c,d)`, REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);; let BETWEEN_TRANSLATION = prove (`!a x y. between (a + x) (a + y,a + z) <=> between x (y,z)`, REWRITE_TAC[between] THEN NORM_ARITH_TAC);; let BETWEEN_NORM = prove (`!a b x:real^N. between x (a,b) <=> norm(x - a) % (b - x) = norm(b - x) % (x - a)`, REPEAT GEN_TAC THEN REWRITE_TAC[between; DIST_TRIANGLE_EQ] THEN REWRITE_TAC[NORM_SUB] THEN VECTOR_ARITH_TAC);; let BETWEEN_DOT = prove (`!a b x:real^N. between x (a,b) <=> (x - a) dot (b - x) = norm(x - a) * norm(b - x)`, REWRITE_TAC[BETWEEN_NORM; NORM_CAUCHY_SCHWARZ_EQ]);; let BETWEEN_EXISTS_EXTENSION = prove (`!a b x:real^N. between b (a,x) /\ ~(b = a) ==> ?d. &0 <= d /\ x = b + d % (b - a)`, REPEAT GEN_TAC THEN REWRITE_TAC[BETWEEN_NORM] THEN STRIP_TAC THEN EXISTS_TAC `norm(x - b:real^N) / norm(b - a)` THEN SIMP_TAC[REAL_LE_DIV; NORM_POS_LE] THEN FIRST_X_ASSUM (MP_TAC o AP_TERM `(%) (inv(norm(b - a:real^N))):real^N->real^N`) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ] THEN VECTOR_ARITH_TAC);; let BETWEEN_IMP_COLLINEAR = prove (`!a b x:real^N. between x (a,b) ==> collinear {a,x,b}`, REPEAT GEN_TAC THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THEN TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2] THEN NO_TAC)) [`x:real^N = a`; `x:real^N = b`; `a:real^N = b`] THEN ONCE_REWRITE_TAC[COLLINEAR_3; BETWEEN_NORM] THEN DISCH_TAC THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN REPEAT DISJ2_TAC THEN EXISTS_TAC `--(norm(b - x:real^N) / norm(x - a))` THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(x - a:real^N)` THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RNEG] THEN ASM_SIMP_TAC[REAL_DIV_LMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN VECTOR_ARITH_TAC);; let BETWEEN_CMUL_LIFT = prove (`!a b c v:real^N. between (c % v) (a % v,b % v) <=> v = vec 0 \/ between (lift c) (lift a,lift b)`, REWRITE_TAC[between; dist; GSYM VECTOR_SUB_RDISTRIB; GSYM LIFT_SUB; NORM_MUL; GSYM REAL_ADD_RDISTRIB; NORM_LIFT] THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN CONV_TAC REAL_RING);; let BETWEEN_1 = prove (`!a b x. between x (a,b) <=> drop a <= drop x /\ drop x <= drop b \/ drop b <= drop x /\ drop x <= drop a`, REWRITE_TAC[between; DIST_REAL; GSYM drop] THEN REAL_ARITH_TAC);; let COLLINEAR_BETWEEN_CASES = prove (`!a b c:real^N. collinear {a,b,c} <=> between a (b,c) \/ between b (c,a) \/ between c (a,b)`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[BETWEEN_IMP_COLLINEAR; INSERT_AC]] THEN REWRITE_TAC[COLLINEAR_ALT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^N`; `v:real^N`] THEN REWRITE_TAC[VECTOR_SUB_RZERO; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[BETWEEN_TRANSLATION; BETWEEN_CMUL_LIFT] THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BETWEEN_1; LIFT_DROP] THEN REAL_ARITH_TAC);; let COLLINEAR_BETWEEN_CASES_2 = prove (`!a b c d:real^N. between c (a,b) /\ between d (a,b) ==> between d (a,c) \/ between d (c,b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN ASM_SIMP_TAC[BETWEEN_REFL_EQ] THEN DISCH_TAC THEN SUBGOAL_THEN `collinear {a:real^N,b,c,d}` MP_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) COLLINEAR_TRIPLES o snd) THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[BETWEEN_IMP_COLLINEAR; INSERT_AC]; REWRITE_TAC[COLLINEAR_ALT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^N`; `v:real^N`] THEN DISCH_THEN(fun th -> REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC th) THEN REWRITE_TAC[VECTOR_SUB_RZERO; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[BETWEEN_TRANSLATION; BETWEEN_CMUL_LIFT] THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BETWEEN_1; LIFT_DROP] THEN REAL_ARITH_TAC]);; let BETWEEN_RESTRICTED_CASES = prove (`!a b c x:real^N. between x (a,b) /\ between x (a,c) /\ ~(x = a) ==> between b (a,c) \/ between c (a,b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `collinear{a:real^N,x,b,c}` MP_TAC THENL [W(MP_TAC o PART_MATCH (lhand o rand) COLLINEAR_TRIPLES o snd) THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[BETWEEN_IMP_COLLINEAR; INSERT_AC]; REWRITE_TAC[COLLINEAR_ALT; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`z:real^N`; `v:real^N`] THEN DISCH_THEN(fun th -> REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC th) THEN REWRITE_TAC[VECTOR_SUB_RZERO; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN ASM_REWRITE_TAC[BETWEEN_TRANSLATION] THEN ASM_REWRITE_TAC[BETWEEN_CMUL_LIFT; VECTOR_MUL_RCANCEL; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[BETWEEN_1; LIFT_DROP] THEN REAL_ARITH_TAC]);; let COLLINEAR_DIST_BETWEEN = prove (`!a b x. collinear {x,a,b} /\ dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b) ==> between x (a,b)`, SIMP_TAC[COLLINEAR_BETWEEN_CASES; between; DIST_SYM] THEN NORM_ARITH_TAC);; let BETWEEN_COLLINEAR_DIST_EQ = prove (`!a b x:real^N. between x (a,b) <=> collinear {a, x, b} /\ dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)`, REPEAT GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[BETWEEN_IMP_COLLINEAR] THEN REWRITE_TAC[between] THEN NORM_ARITH_TAC; MESON_TAC[COLLINEAR_DIST_BETWEEN; INSERT_AC]]);; let COLLINEAR_1 = prove (`!s:real^1->bool. collinear s`, GEN_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `(vec 0:real^1) INSERT (vec 1) INSERT s` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN REWRITE_TAC[VEC_EQ; ARITH_EQ] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN REWRITE_TAC[between; DIST_REAL; GSYM drop; DROP_VEC; REAL_ABS_NUM] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Midpoint between two points. *) (* ------------------------------------------------------------------------- *) let midpoint = new_definition `midpoint(a,b) = inv(&2) % (a + b)`;; let MIDPOINT_REFL = prove (`!x. midpoint(x,x) = x`, REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);; let MIDPOINT_SYM = prove (`!a b. midpoint(a,b) = midpoint(b,a)`, REWRITE_TAC[midpoint; VECTOR_ADD_SYM]);; let DIST_MIDPOINT = prove (`!a b. dist(a,midpoint(a,b)) = dist(a,b) / &2 /\ dist(b,midpoint(a,b)) = dist(a,b) / &2 /\ dist(midpoint(a,b),a) = dist(a,b) / &2 /\ dist(midpoint(a,b),b) = dist(a,b) / &2`, REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);; let MIDPOINT_EQ_ENDPOINT = prove (`!a b. (midpoint(a,b) = a <=> a = b) /\ (midpoint(a,b) = b <=> a = b) /\ (a = midpoint(a,b) <=> a = b) /\ (b = midpoint(a,b) <=> a = b)`, REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);; let BETWEEN_MIDPOINT = prove (`!a b. between (midpoint(a,b)) (a,b) /\ between (midpoint(a,b)) (b,a)`, REWRITE_TAC[between; midpoint] THEN NORM_ARITH_TAC);; let MIDPOINT_LINEAR_IMAGE = prove (`!f a b. linear f ==> midpoint(f a,f b) = f(midpoint(a,b))`, SIMP_TAC[midpoint; LINEAR_ADD; LINEAR_CMUL]);; let COLLINEAR_MIDPOINT = prove (`!a b. collinear{a,midpoint(a,b),b}`, REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_3_EXPAND; midpoint] THEN DISJ2_TAC THEN EXISTS_TAC `&1 / &2` THEN VECTOR_ARITH_TAC);; let MIDPOINT_COLLINEAR = prove (`!a b c:real^N. ~(a = c) ==> (b = midpoint(a,c) <=> collinear{a,b,c} /\ dist(a,b) = dist(b,c))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) /\ (b ==> (a <=> c)) ==> (a <=> b /\ c)`) THEN SIMP_TAC[COLLINEAR_MIDPOINT] THEN ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN STRIP_TAC THEN ASM_REWRITE_TAC[midpoint; dist] THEN REWRITE_TAC [VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (&1 - u) % (a - c)`; VECTOR_ARITH `(u % a + (&1 - u) % c) - c = u % (a - c)`; VECTOR_ARITH `u % a + (&1 - u) % c = inv (&2) % (a + c) <=> (u - &1 / &2) % (a - c) = vec 0`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_EQ_MUL_RCANCEL; NORM_EQ_0; VECTOR_SUB_EQ; VECTOR_MUL_EQ_0] THEN REAL_ARITH_TAC);; let MIDPOINT_BETWEEN = prove (`!a b c:real^N. b = midpoint (a,c) <=> between b (a,c) /\ dist (a,b) = dist (b,c)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = c` THENL [ASM_SIMP_TAC[BETWEEN_REFL_EQ; MIDPOINT_REFL; DIST_SYM]; ALL_TAC] THEN EQ_TAC THEN SIMP_TAC[BETWEEN_MIDPOINT; DIST_MIDPOINT] THEN ASM_MESON_TAC[MIDPOINT_COLLINEAR; BETWEEN_IMP_COLLINEAR]);; let DROP_MIDPOINT = prove (`!x y. drop(midpoint(x,y)) = (drop x + drop y) / &2`, REWRITE_TAC[midpoint; DROP_ADD; DROP_CMUL] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* General "one way" lemma for properties preserved by injective map. *) (* ------------------------------------------------------------------------- *) let WLOG_LINEAR_INJECTIVE_IMAGE_2 = prove (`!P Q. (!f s. P s /\ linear f ==> Q(IMAGE f s)) /\ (!g t. Q t /\ linear g ==> P(IMAGE g t)) ==> !f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> !s. Q(IMAGE f s) <=> P s`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`]) THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID]);; let WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT = prove (`!P Q f s. (!h u. P u /\ linear h ==> Q(IMAGE h u)) /\ (!g t. Q t /\ linear g ==> P(IMAGE g t)) /\ linear f /\ (!x y. f x = f y ==> x = y) ==> (Q(IMAGE f s) <=> P s)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] WLOG_LINEAR_INJECTIVE_IMAGE_2) THEN ASM_REWRITE_TAC[]);; let WLOG_LINEAR_INJECTIVE_IMAGE = prove (`!P. (!f s. P s /\ linear f ==> P(IMAGE f s)) ==> !f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> !s. P(IMAGE f s) <=> P s`, GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LINEAR_INJECTIVE_IMAGE_2 THEN ASM_REWRITE_TAC[]);; let WLOG_LINEAR_INJECTIVE_IMAGE_ALT = prove (`!P f s. (!g t. P t /\ linear g ==> P(IMAGE g t)) /\ linear f /\ (!x y. f x = f y ==> x = y) ==> (P(IMAGE f s) <=> P s)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] WLOG_LINEAR_INJECTIVE_IMAGE) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Inference rule to apply it conveniently. *) (* *) (* |- !f s. P s /\ linear f ==> P(IMAGE f s) [or /\ commuted] *) (* --------------------------------------------------------------- *) (* |- !f s. linear f /\ (!x y. f x = f y ==> x = y) *) (* ==> (Q(IMAGE f s) <=> P s) *) (* ------------------------------------------------------------------------- *) let LINEAR_INVARIANT_RULE th = let [f;s] = fst(strip_forall(concl th)) in let (rm,rn) = dest_fun_ty (type_of f) in let m = last(snd(dest_type rm)) and n = last(snd(dest_type rn)) in let th' = INST_TYPE [m,n; n,m] th in let th0 = CONJ th th' in let th1 = try MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2 th0 with Failure _ -> MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2 (GEN_REWRITE_RULE (BINOP_CONV o ONCE_DEPTH_CONV) [CONJ_SYM] th0) in GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_FORALL_THM] th1;; (* ------------------------------------------------------------------------- *) (* Immediate application. *) (* ------------------------------------------------------------------------- *) let SUBSPACE_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (subspace (IMAGE f s) <=> subspace s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE SUBSPACE_LINEAR_IMAGE));; (* ------------------------------------------------------------------------- *) (* Storage of useful "invariance under linear map / translation" theorems. *) (* ------------------------------------------------------------------------- *) let invariant_under_linear = ref([]:thm list);; let invariant_under_translation = ref([]:thm list);; let scaling_theorems = ref([]:thm list);; (* ------------------------------------------------------------------------- *) (* Some building-blocks for "union/intersection of" invariance theorems. *) (* ------------------------------------------------------------------------- *) let COUNTABLE_UNION_OF_BIJECTIVE_IMAGE = prove (`!(f:A->B) P P'. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) /\ (!s. P' (IMAGE f s) <=> P s) ==> (!s. (COUNTABLE UNION_OF P') (IMAGE f s) <=> (COUNTABLE UNION_OF P) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_OF] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:(B->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\s. {x | (f:A->B) x IN s}) u` THEN ASM_SIMP_TAC[UNIONS_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `u:(A->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (IMAGE (f:A->B)) u` THEN ASM_SIMP_TAC[UNIONS_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]);; let COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE = prove (`!(f:A->B) P P'. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) /\ (!s. P' (IMAGE f s) <=> P s) ==> (!s. (COUNTABLE INTERSECTION_OF P') (IMAGE f s) <=> (COUNTABLE INTERSECTION_OF P) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERSECTION_OF] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:(B->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\s. {x | (f:A->B) x IN s}) u` THEN ASM_SIMP_TAC[INTERS_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `u:(A->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (IMAGE (f:A->B)) u` THEN ASM_SIMP_TAC[INTERS_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Scaling theorems and derivation from linear invariance. *) (* ------------------------------------------------------------------------- *) let AFFINITY_SCALING_TRANSLATION = prove (`!m c:real^N. (\x. m % x + c) = (\x. c + x) o (\x. m % x)`, REWRITE_TAC[o_DEF; VECTOR_ADD_SYM]);; let LINEAR_SCALING = prove (`!c. linear(\x:real^N. c % x)`, REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);; let INJECTIVE_SCALING = prove (`!c. (!x y:real^N. c % x = c % y ==> x = y) <=> ~(c = &0)`, GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN ASM_CASES_TAC `c:real = &0` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN REWRITE_TAC[VEC_EQ; ARITH]);; let SURJECTIVE_SCALING = prove (`!c. (!y:real^N. ?x. c % x = y) <=> ~(c = &0)`, ASM_SIMP_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE; LINEAR_SCALING] THEN REWRITE_TAC[INJECTIVE_SCALING]);; let SCALING_INVARIANT = let pths = (CONJUNCTS o UNDISCH o prove) (`&0 < c ==> linear(\x:real^N. c % x) /\ (!x y:real^N. c % x = c % y ==> x = y) /\ (!y:real^N. ?x. c % x = y)`, SIMP_TAC[REAL_LT_IMP_NZ; LINEAR_SCALING; INJECTIVE_SCALING; SURJECTIVE_SCALING]) and sc_tm = `\x:real^N. c % x` and sa_tm = `&0:real < c` and c_tm = `c:real` in fun th -> let ith = BETA_RULE(ISPEC sc_tm th) in let avs,bod = strip_forall(concl ith) in let cjs = conjuncts(lhand bod) in let cths = map (fun t -> find(fun th -> aconv (concl th) t) pths) cjs in let oth = MP (SPECL avs ith) (end_itlist CONJ cths) in GEN c_tm (DISCH sa_tm (GENL avs oth));; (* ------------------------------------------------------------------------- *) (* Augmentation of the lists. The "add_linear_invariants" also updates *) (* the scaling theorems automatically, so only a few of those will need *) (* to be added explicitly. *) (* ------------------------------------------------------------------------- *) let add_scaling_theorems thl = (scaling_theorems := (!scaling_theorems) @ thl);; let add_linear_invariants thl = ignore(mapfilter (fun th -> add_scaling_theorems[SCALING_INVARIANT th]) thl); (invariant_under_linear := (!invariant_under_linear) @ thl);; let add_translation_invariants thl = (invariant_under_translation := (!invariant_under_translation) @ thl);; (* ------------------------------------------------------------------------- *) (* Start with some basic set equivalences. *) (* We give them all an injectivity hypothesis even if it's not necessary. *) (* For just the intersection theorem we add surjectivity (more manageable *) (* than assuming that the set isn't empty). *) (* ------------------------------------------------------------------------- *) let th_sets = prove (`!f. (!x y. f x = f y ==> x = y) ==> (if p then f x else f y) = f(if p then x else y) /\ (if p then IMAGE f s else IMAGE f t) = IMAGE f (if p then s else t) /\ (f x) INSERT (IMAGE f s) = IMAGE f (x INSERT s) /\ (IMAGE f s) DELETE (f x) = IMAGE f (s DELETE x) /\ (IMAGE f s) INTER (IMAGE f t) = IMAGE f (s INTER t) /\ (IMAGE f s) UNION (IMAGE f t) = IMAGE f (s UNION t) /\ UNIONS(IMAGE (IMAGE f) u) = IMAGE f (UNIONS u) /\ (IMAGE f s) DIFF (IMAGE f t) = IMAGE f (s DIFF t) /\ (IMAGE f s (f x) <=> s x) /\ ((f x) IN (IMAGE f s) <=> x IN s) /\ ((f o xs) (n:num) = f(xs n)) /\ ((f o pt) (tt:real^1) = f(pt tt)) /\ (IMAGE (f o g) k = IMAGE f (IMAGE g k)) /\ (DISJOINT (IMAGE f s) (IMAGE f t) <=> DISJOINT s t) /\ ((IMAGE f s) SUBSET (IMAGE f t) <=> s SUBSET t) /\ ((IMAGE f s) PSUBSET (IMAGE f t) <=> s PSUBSET t) /\ (IMAGE f s = IMAGE f t <=> s = t) /\ ((IMAGE f s) HAS_SIZE n <=> s HAS_SIZE n) /\ (FINITE(IMAGE f s) <=> FINITE s) /\ (INFINITE(IMAGE f s) <=> INFINITE s) /\ (COUNTABLE(IMAGE f s) <=> COUNTABLE s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_UNIONS; IMAGE_o] THEN REWRITE_TAC[o_THM; MESON[IN] `IMAGE f s y <=> y IN IMAGE f s`] THEN REPLICATE_TAC 2 (CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[INFINITE; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN REPLICATE_TAC 11 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[HAS_SIZE] THEN ASM_MESON_TAC[COUNTABLE_IMAGE_INJ_EQ; FINITE_IMAGE_INJ_EQ; CARD_IMAGE_INJ]) in let f = `f:real^M->real^N` and imf = `IMAGE (f:real^M->real^N)` and a = `a:real^N` and ima = `IMAGE (\x:real^N. a + x)` and vth = VECTOR_ARITH `!x y. a + x:real^N = a + y ==> x = y` in let th1 = UNDISCH(ISPEC f th_sets) and th1' = UNDISCH (GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC imf th_sets)) and th2 = MATCH_MP th_sets vth and th2' = MATCH_MP (BETA_RULE(GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC ima th_sets))) vth in let fn a th = GENL (a::subtract (frees(concl th)) [a]) th in add_linear_invariants(map (fn f o DISCH_ALL) (CONJUNCTS th1 @ CONJUNCTS th1')), add_translation_invariants(map (fn a) (CONJUNCTS th2 @ CONJUNCTS th2'));; let th_set = prove (`!f:A->B s. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> INTERS (IMAGE (IMAGE f) s) = IMAGE f (INTERS s)`, REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in let th_vec = prove (`!a:real^N s. INTERS (IMAGE (IMAGE (\x. a + x)) s) = IMAGE (\x. a + x) (INTERS s)`, REPEAT GEN_TAC THEN MATCH_MP_TAC th_set THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]) in add_linear_invariants [th_set],add_translation_invariants[th_vec];; (* ------------------------------------------------------------------------- *) (* Now add arithmetical equivalences. *) (* ------------------------------------------------------------------------- *) let SAME_NORM_SAME_DOT = prove (`!f:real^M->real^N g:real^M->real^P x y. linear f /\ linear g /\ (!x. norm(f x) = norm(g x)) ==> (f x) dot (f y) = (g x) dot (g y)`, REWRITE_TAC[NORM_EQ] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x + y:real^M`) THEN REPEAT(FIRST_X_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_ADD th])) THEN ASM_REWRITE_TAC[DOT_LADD; DOT_RADD] THEN REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC);; let PRESERVES_NORM_PRESERVES_DOT = prove (`!f:real^M->real^N x y. linear f /\ (!x. norm(f x) = norm x) ==> (f x) dot (f y) = x dot y`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `\x:real^M. x`] SAME_NORM_SAME_DOT) THEN ASM_SIMP_TAC[LINEAR_ID]);; let PRESEVES_NORM_PRESERVES_DIST = prove (`!f:real^M->real^N. linear f /\ (!x. norm(f x) = norm x) ==> !x y. dist(f x,f y) = dist(x,y)`, REWRITE_TAC[dist] THEN MESON_TAC[LINEAR_SUB]);; let PRESERVES_NORM_INJECTIVE = prove (`!f:real^M->real^N. linear f /\ (!x. norm(f x) = norm x) ==> !x y. f x = f y ==> x = y`, SIMP_TAC[LINEAR_INJECTIVE_0; GSYM NORM_EQ_0]);; let ORTHOGONAL_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N x y. linear f /\ (!x. norm(f x) = norm x) ==> (orthogonal (f x) (f y) <=> orthogonal x y)`, SIMP_TAC[orthogonal; PRESERVES_NORM_PRESERVES_DOT]);; let NORMAL_MATRIX_IFF_SAME_NORM_TRANSP,NORMAL_MATRIX_IFF_SAME_DOT_TRANSP = (CONJ_PAIR o prove) (`(!A:real^N^N. transp A ** A = A ** transp A <=> !x. norm(transp A ** x) = norm(A ** x)) /\ (!A:real^N^N. transp A ** A = A ** transp A <=> !x y. (transp A ** x) dot (transp A ** y) = (A ** x) dot (A ** y))`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC (TAUT `(q <=> r) /\ (p <=> r) ==> (p <=> q) /\ (p <=> r)`) THEN CONJ_TAC THENL [EQ_TAC THENL [ALL_TAC; SIMP_TAC[NORM_EQ]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SAME_NORM_SAME_DOT THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]; REWRITE_TAC[DOT_MATRIX_TRANSP_RMUL] THEN GEN_REWRITE_TAC (RAND_CONV o funpow 2 BINDER_CONV o RAND_CONV) [GSYM DOT_MATRIX_TRANSP_LMUL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM DOT_LSUB] THEN REWRITE_TAC[FORALL_DOT_EQ_0; MATRIX_VECTOR_MUL_ASSOC] THEN REWRITE_TAC[GSYM MATRIX_EQ_0; GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN REWRITE_TAC[MATRIX_SUB_EQ] THEN MESON_TAC[]]);; let NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT = prove (`!A x:real^N. transp A ** A = A ** transp A ==> (transp A ** x = vec 0 <=> A ** x = vec 0)`, REWRITE_TAC[GSYM NORM_EQ_0] THEN MESON_TAC[NORMAL_MATRIX_IFF_SAME_NORM_TRANSP]);; let NORMAL_MATRIX_KERNEL_TRANSP = prove (`!A:real^N^N. transp A ** A = A ** transp A ==> {x | transp A ** x = vec 0} = {x | A ** x = vec 0}`, SIMP_TAC[EXTENSION; IN_ELIM_THM; NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT]);; add_linear_invariants [GSYM LINEAR_ADD; GSYM LINEAR_CMUL; GSYM LINEAR_SUB; GSYM LINEAR_NEG; MIDPOINT_LINEAR_IMAGE; MESON[] `!f:real^M->real^N x. (!x. norm(f x) = norm x) ==> norm(f x) = norm x`; PRESERVES_NORM_PRESERVES_DOT; MESON[dist; LINEAR_SUB] `!f:real^M->real^N x y. linear f /\ (!x. norm(f x) = norm x) ==> dist(f x,f y) = dist(x,y)`; MESON[] `!f:real^M->real^N x y. (!x y. f x = f y ==> x = y) ==> (f x = f y <=> x = y)`; SUBSPACE_LINEAR_IMAGE_EQ; ORTHOGONAL_LINEAR_IMAGE_EQ; SPAN_LINEAR_IMAGE; DEPENDENT_LINEAR_IMAGE_EQ; INDEPENDENT_LINEAR_IMAGE_EQ; DIM_INJECTIVE_LINEAR_IMAGE];; add_translation_invariants [VECTOR_ARITH `!a x y. a + x:real^N = a + y <=> x = y`; NORM_ARITH `!a x y. dist(a + x,a + y) = dist(x,y)`; VECTOR_ARITH `!a x y. &1 / &2 % ((a + x) + (a + y)) = a + &1 / &2 % (x + y)`; VECTOR_ARITH `!a x y. inv(&2) % ((a + x) + (a + y)) = a + inv(&2) % (x + y)`; VECTOR_ARITH `!a x y. (a + x) - (a + y):real^N = x - y`; (EQT_ELIM o (REWRITE_CONV[midpoint] THENC(EQT_INTRO o NORM_ARITH))) `!a x y. midpoint(a + x,a + y) = a + midpoint(x,y)`; (EQT_ELIM o (REWRITE_CONV[between] THENC(EQT_INTRO o NORM_ARITH))) `!a x y z. between (a + x) (a + y,a + z) <=> between x (y,z)`];; let th = prove (`!a s b c:real^N. (a + b) + c IN IMAGE (\x. a + x) s <=> (b + c) IN s`, REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `(a + b) + c:real^N = a + x <=> x = b + c`] THEN MESON_TAC[]) in add_translation_invariants [th];; (* ------------------------------------------------------------------------- *) (* A few for lists. *) (* ------------------------------------------------------------------------- *) let MEM_TRANSLATION = prove (`!a:real^N x l. MEM (a + x) (MAP (\x. a + x) l) <=> MEM x l`, REWRITE_TAC[MEM_MAP; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN MESON_TAC[]);; add_translation_invariants [MEM_TRANSLATION];; let MEM_LINEAR_IMAGE = prove (`!f:real^M->real^N x l. linear f /\ (!x y. f x = f y ==> x = y) ==> (MEM (f x) (MAP f l) <=> MEM x l)`, REWRITE_TAC[MEM_MAP] THEN MESON_TAC[]);; add_linear_invariants [MEM_LINEAR_IMAGE];; let LENGTH_TRANSLATION = prove (`!a:real^N l. LENGTH(MAP (\x. a + x) l) = LENGTH l`, REWRITE_TAC[LENGTH_MAP]) in add_translation_invariants [LENGTH_TRANSLATION];; let LENGTH_LINEAR_IMAGE = prove (`!f:real^M->real^N l. linear f ==> LENGTH(MAP f l) = LENGTH l`, REWRITE_TAC[LENGTH_MAP]) in add_linear_invariants [LENGTH_LINEAR_IMAGE];; let CONS_TRANSLATION = prove (`!a:real^N h t. CONS ((\x. a + x) h) (MAP (\x. a + x) t) = MAP (\x. a + x) (CONS h t)`, REWRITE_TAC[MAP]) in add_translation_invariants [CONS_TRANSLATION];; let CONS_LINEAR_IMAGE = prove (`!f:real^M->real^N h t. linear f ==> CONS (f h) (MAP f t) = MAP f (CONS h t)`, REWRITE_TAC[MAP]) in add_linear_invariants [CONS_LINEAR_IMAGE];; let APPEND_TRANSLATION = prove (`!a:real^N l1 l2. APPEND (MAP (\x. a + x) l1) (MAP (\x. a + x) l2) = MAP (\x. a + x) (APPEND l1 l2)`, REWRITE_TAC[MAP_APPEND]) in add_translation_invariants [APPEND_TRANSLATION];; let APPEND_LINEAR_IMAGE = prove (`!f:real^M->real^N l1 l2. linear f ==> APPEND (MAP f l1) (MAP f l2) = MAP f (APPEND l1 l2)`, REWRITE_TAC[MAP_APPEND]) in add_linear_invariants [APPEND_LINEAR_IMAGE];; let REVERSE_TRANSLATION = prove (`!a:real^N l. REVERSE(MAP (\x. a + x) l) = MAP (\x. a + x) (REVERSE l)`, REWRITE_TAC[MAP_REVERSE]) in add_translation_invariants [REVERSE_TRANSLATION];; let REVERSE_LINEAR_IMAGE = prove (`!f:real^M->real^N l. linear f ==> REVERSE(MAP f l) = MAP f (REVERSE l)`, REWRITE_TAC[MAP_REVERSE]) in add_linear_invariants [REVERSE_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* A few scaling theorems that don't come from invariance theorems. Most are *) (* artificially weak with 0 < c hypotheses, so we don't bind them to names. *) (* ------------------------------------------------------------------------- *) let DOT_SCALING = prove (`!c. &0 < c ==> !x y. (c % x) dot (c % y) = c pow 2 * (x dot y)`, REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN REAL_ARITH_TAC) in add_scaling_theorems [DOT_SCALING];; let DIST_SCALING = prove (`!c. &0 < c ==> !x y. dist(c % x,c % y) = c * dist(x,y)`, SIMP_TAC[DIST_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in add_scaling_theorems [DIST_SCALING];; let ORTHOGONAL_SCALING = prove (`!c. &0 < c ==> !x y. orthogonal (c % x) (c % y) <=> orthogonal x y`, REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL] THEN CONV_TAC REAL_FIELD) in add_scaling_theorems [ORTHOGONAL_SCALING];; let NORM_SCALING = prove (`!c. &0 < c ==> !x. norm(c % x) = c * norm x`, SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in add_scaling_theorems [NORM_SCALING];; add_scaling_theorems [REAL_ARITH `!c. &0 < c ==> !a b. a * c * b = c * a * b`; REAL_ARITH `!c. &0 < c ==> !a b. c * a + c * b = c * (a + b)`; REAL_ARITH `!c. &0 < c ==> !a b. c * a - c * b = c * (a - b)`; REAL_FIELD `!c. &0 < c ==> !a b. c * a = c * b <=> a = b`; MESON[REAL_LT_LMUL_EQ] `!c. &0 < c ==> !a b. c * a < c * b <=> a < b`; MESON[REAL_LE_LMUL_EQ] `!c. &0 < c ==> !a b. c * a <= c * b <=> a <= b`; MESON[REAL_LT_LMUL_EQ; real_gt] `!c. &0 < c ==> !a b. c * a > c * b <=> a > b`; MESON[REAL_LE_LMUL_EQ; real_ge] `!c. &0 < c ==> !a b. c * a >= c * b <=> a >= b`; MESON[REAL_POW_MUL] `!c. &0 < c ==> !a n. (c * a) pow n = c pow n * a pow n`; REAL_ARITH `!c. &0 < c ==> !a b n. a * c pow n * b = c pow n * a * b`; REAL_ARITH `!c. &0 < c ==> !a b n. c pow n * a + c pow n * b = c pow n * (a + b)`; REAL_ARITH `!c. &0 < c ==> !a b n. c pow n * a - c pow n * b = c pow n * (a - b)`; MESON[REAL_POW_LT; REAL_EQ_LCANCEL_IMP; REAL_LT_IMP_NZ] `!c. &0 < c ==> !a b n. c pow n * a = c pow n * b <=> a = b`; MESON[REAL_LT_LMUL_EQ; REAL_POW_LT] `!c. &0 < c ==> !a b n. c pow n * a < c pow n * b <=> a < b`; MESON[REAL_LE_LMUL_EQ; REAL_POW_LT] `!c. &0 < c ==> !a b n. c pow n * a <= c pow n * b <=> a <= b`; MESON[REAL_LT_LMUL_EQ; real_gt; REAL_POW_LT] `!c. &0 < c ==> !a b n. c pow n * a > c pow n * b <=> a > b`; MESON[REAL_LE_LMUL_EQ; real_ge; REAL_POW_LT] `!c. &0 < c ==> !a b n. c pow n * a >= c pow n * b <=> a >= b`];; (* ------------------------------------------------------------------------- *) (* Theorem deducing quantifier mappings from surjectivity. *) (* ------------------------------------------------------------------------- *) let QUANTIFY_SURJECTION_THM = prove (`!f:A->B. (!y. ?x. f x = y) ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\ (!P. (?x. P x) <=> (?x. P (f x))) /\ (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\ (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s)))) /\ (!P. {x | P x} = IMAGE f {x | P(f x)})`, GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SURJECTIVE_RIGHT_INVERSE] THEN DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN SUBGOAL_THEN `!s. IMAGE (f:A->B) (IMAGE g s) = s` ASSUME_TAC THENL [ASM SET_TAC[]; CONJ_TAC THENL [ASM MESON_TAC[]; ASM SET_TAC[]]]);; let QUANTIFY_SURJECTION_HIGHER_THM = prove (`!f:A->B. (!y. ?x. f x = y) ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\ (!P. (?x. P x) <=> (?x. P (f x))) /\ (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\ (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s))) /\ (!Q. (!s. Q s) <=> (!s. Q(IMAGE (IMAGE f) s))) /\ (!Q. (?s. Q s) <=> (?s. Q(IMAGE (IMAGE f) s))) /\ (!P. (!g:real^1->B. P g) <=> (!g. P(f o g))) /\ (!P. (?g:real^1->B. P g) <=> (?g. P(f o g))) /\ (!P. (!g:num->B. P g) <=> (!g. P(f o g))) /\ (!P. (?g:num->B. P g) <=> (?g. P(f o g))) /\ (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\ (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\ ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\ (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\ (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`, GEN_TAC THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN ASM_REWRITE_TAC[GSYM SURJECTIVE_FORALL_THM; GSYM SURJECTIVE_EXISTS_THM; GSYM SURJECTIVE_IMAGE_THM; SURJECTIVE_IMAGE; SURJECTIVE_MAP] THEN REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM SKOLEM_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Apply such quantifier and set expansions once per level at depth. *) (* In the PARTIAL version, avoid expanding named variables in list. *) (* ------------------------------------------------------------------------- *) let PARTIAL_EXPAND_QUANTS_CONV avoid th = let ath,sth = CONJ_PAIR th in let conv1 = GEN_REWRITE_CONV I [ath] and conv2 = GEN_REWRITE_CONV I [sth] in let conv1' tm = let th = conv1 tm in if mem (fst(dest_var(fst(dest_abs(rand tm))))) avoid then failwith "Not going to expand this variable" else th in let rec conv tm = ((conv1' THENC BINDER_CONV conv) ORELSEC (conv2 THENC RAND_CONV(RAND_CONV(ABS_CONV(BINDER_CONV(LAND_CONV conv))))) ORELSEC SUB_CONV conv) tm in conv;; let EXPAND_QUANTS_CONV = PARTIAL_EXPAND_QUANTS_CONV [];; hol-light/Multivariate/wlog.ml000066400000000000000000000441441303454263000167240ustar00rootroot00000000000000(* ========================================================================= *) (* Geometric "without loss of generality" tactics to pick convenient coords. *) (* ========================================================================= *) needs "Multivariate/determinants.ml";; needs "Multivariate/convex.ml";; (* ------------------------------------------------------------------------- *) (* Flyspeck definition of plane, and its invariance theorems. *) (* ------------------------------------------------------------------------- *) let plane = new_definition `plane x = (?u v w. ~(collinear {u,v,w}) /\ x = affine hull {u,v,w})`;; let PLANE_TRANSLATION_EQ = prove (`!a:real^N s. plane(IMAGE (\x. a + x) s) <=> plane s`, REWRITE_TAC[plane] THEN GEOM_TRANSLATE_TAC[]);; let PLANE_TRANSLATION = prove (`!a:real^N s. plane s ==> plane(IMAGE (\x. a + x) s)`, REWRITE_TAC[PLANE_TRANSLATION_EQ]);; add_translation_invariants [PLANE_TRANSLATION_EQ];; let PLANE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N p. linear f /\ (!x y. f x = f y ==> x = y) ==> (plane(IMAGE f p) <=> plane p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[plane] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `?u. u IN IMAGE f (:real^M) /\ ?v. v IN IMAGE f (:real^M) /\ ?w. w IN IMAGE (f:real^M->real^N) (:real^M) /\ ~collinear {u, v, w} /\ IMAGE f p = affine hull {u, v, w}` THEN CONJ_TAC THENL [REWRITE_TAC[RIGHT_AND_EXISTS_THM; IN_IMAGE; IN_UNIV] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{u,v,w} SUBSET IMAGE (f:real^M->real^N) p` MP_TAC THENL [ASM_REWRITE_TAC[HULL_SUBSET]; SET_TAC[]]; REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[SET_RULE `{f a,f b,f c} = IMAGE f {a,b,c}`] THEN ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN BINOP_TAC THENL [ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ]; ASM SET_TAC[]]]);; let PLANE_LINEAR_IMAGE = prove (`!f:real^M->real^N p. linear f /\ plane p /\ (!x y. f x = f y ==> x = y) ==> plane(IMAGE f p)`, MESON_TAC[PLANE_LINEAR_IMAGE_EQ]);; add_linear_invariants [PLANE_LINEAR_IMAGE_EQ];; (* ------------------------------------------------------------------------- *) (* Rotating and translating so a given plane in R^3 becomes {x | x$3 = &0}. *) (* ------------------------------------------------------------------------- *) let ROTATION_PLANE_HORIZONTAL = prove (`!s. plane s ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ IMAGE f (IMAGE (\x. a + x) s) = {z:real^3 | z$3 = &0}`, let lemma = prove (`span {z:real^3 | z$3 = &0} = {z:real^3 | z$3 = &0}`, REWRITE_TAC[SPAN_EQ_SELF; subspace; IN_ELIM_THM] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [plane]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC]) [`a:real^3 = b`; `a:real^3 = c`; `b:real^3 = c`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN ASM_SIMP_TAC[AFFINE_HULL_INSERT_SPAN; IN_INSERT; NOT_IN_EMPTY] THEN EXISTS_TAC `--a:real^3` THEN REWRITE_TAC[SET_RULE `IMAGE (\x:real^3. --a + x) {a + x | x | x IN s} = IMAGE (\x. --a + a + x) s`] THEN REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^3 = x`; IMAGE_ID] THEN REWRITE_TAC[SET_RULE `{x - a:real^x | x = b \/ x = c} = {b - a,c - a}`] THEN MP_TAC(ISPEC `span{b - a:real^3,c - a}` ROTATION_LOWDIM_HORIZONTAL) THEN REWRITE_TAC[DIMINDEX_3] THEN ANTS_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD{b - a:real^3,c - a}` THEN SIMP_TAC[DIM_SPAN; DIM_LE_CARD; FINITE_RULES] THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^3->real^3` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN GEN_REWRITE_TAC RAND_CONV [GSYM lemma] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN CONJ_TAC THENL [ASM_MESON_TAC[IMAGE_SUBSET; SPAN_INC; SUBSET_TRANS]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`{z:real^3 | z$3 = &0}`; `(:real^3)`] DIM_EQ_SPAN) THEN REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3; lemma] THEN MATCH_MP_TAC(TAUT `~r /\ (~p ==> q) ==> (q ==> r) ==> p`) THEN REWRITE_TAC[ARITH_RULE `~(x <= 2) <=> 3 <= x`] THEN REWRITE_TAC[EXTENSION; SPAN_UNIV; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `vector[&0;&0;&1]:real^3`) THEN REWRITE_TAC[IN_UNIV; VECTOR_3] THEN REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim {b - a:real^3,c - a}` THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL; DIM_INJECTIVE_LINEAR_IMAGE; ORTHOGONAL_TRANSFORMATION_INJECTIVE]] THEN MP_TAC(ISPEC `{b - a:real^3,c - a}` INDEPENDENT_BOUND_GENERAL) THEN SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`; ARITH] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [SET_RULE `{a,b,c} = {b,a,c}`]) THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[independent; CONTRAPOS_THM; dependent] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; RIGHT_OR_DISTRIB] THEN REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {a,b} DELETE b = {a}`; SET_RULE `~(a = b) ==> {a,b} DELETE a = {b}`; VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`] THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN ONCE_REWRITE_TAC[VECTOR_SUB_EQ] THEN MESON_TAC[COLLINEAR_LEMMA; INSERT_AC]);; let ROTATION_HORIZONTAL_PLANE = prove (`!p. plane p ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ IMAGE (\x. a + x) (IMAGE f {z:real^3 | z$3 = &0}) = p`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP ROTATION_PLANE_HORIZONTAL) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^3` (X_CHOOSE_THEN `f:real^3->real^3` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(X_CHOOSE_THEN `g:real^3->real^3` STRIP_ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE) THEN MAP_EVERY EXISTS_TAC [`--a:real^3`; `g:real^3->real^3`] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^3 = x`] THEN MATCH_MP_TAC(REAL_RING `!f. f * g = &1 /\ f = &1 ==> g = &1`) THEN EXISTS_TAC `det(matrix(f:real^3->real^3))` THEN REWRITE_TAC[GSYM DET_MUL] THEN ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN ASM_REWRITE_TAC[o_DEF; MATRIX_ID; DET_I]);; (* ------------------------------------------------------------------------- *) (* Apply plane rotation to a goal. *) (* ------------------------------------------------------------------------- *) let GEOM_HORIZONTAL_PLANE_RULE = let ifn = MATCH_MP (TAUT `(p ==> (x <=> x')) /\ (~p ==> (x <=> T)) ==> (x' ==> x)`) and pth = prove (`!a f. orthogonal_transformation (f:real^N->real^N) ==> ((!P. (!x. P x) <=> (!x. P (a + f x))) /\ (!P. (?x. P x) <=> (?x. P (a + f x))) /\ (!Q. (!s. Q s) <=> (!s. Q (IMAGE (\x. a + x) (IMAGE f s)))) /\ (!Q. (?s. Q s) <=> (?s. Q (IMAGE (\x. a + x) (IMAGE f s))))) /\ (!P. {x | P x} = IMAGE (\x. a + x) (IMAGE f {x | P(a + f x)}))`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPEC `(\x. a + x) o (f:real^N->real^N)` QUANTIFY_SURJECTION_THM) THEN REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; VECTOR_ARITH `a + (x - a:real^N) = x`]) and cth = prove (`!a f. {} = IMAGE (\x:real^3. a + x) (IMAGE f {})`, REWRITE_TAC[IMAGE_CLAUSES]) and oth = prove (`!f:real^3->real^3. orthogonal_transformation f /\ det(matrix f) = &1 ==> linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:3) ==> det(matrix f) = &1)`, GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) and fth = MESON[] `(!a f. q a f ==> (p <=> p' a f)) ==> ((?a f. q a f) ==> (p <=> !a f. q a f ==> p' a f))` in fun tm -> let x,bod = dest_forall tm in let th1 = EXISTS_GENVAR_RULE (UNDISCH(ISPEC x ROTATION_HORIZONTAL_PLANE)) in let [a;f],tm1 = strip_exists(concl th1) in let [th_orth;th_det;th_im] = CONJUNCTS(ASSUME tm1) in let th2 = PROVE_HYP th_orth (UNDISCH(ISPECL [a;f] pth)) in let th3 = (EXPAND_QUANTS_CONV(ASSUME(concl th2)) THENC SUBS_CONV[GSYM th_im; ISPECL [a;f] cth]) bod in let th4 = PROVE_HYP th2 th3 in let th5 = TRANSLATION_INVARIANTS a in let th6 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [ASSUME(concl th5)] th4 in let th7 = PROVE_HYP th5 th6 in let th8s = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in let th9 = LINEAR_INVARIANTS f th8s in let th10 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [th9] th7 in let th11 = if intersect (frees(concl th10)) [a;f] = [] then PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th10) else MP (MATCH_MP fth (GENL [a;f] (DISCH_ALL th10))) th1 in let th12 = REWRITE_CONV[ASSUME(mk_neg(hd(hyp th11)))] bod in let th13 = ifn(CONJ (DISCH_ALL th11) (DISCH_ALL th12)) in let th14 = MATCH_MP MONO_FORALL (GEN x th13) in GEN_REWRITE_RULE (TRY_CONV o LAND_CONV) [FORALL_SIMP] th14;; let GEOM_HORIZONTAL_PLANE_TAC p = W(fun (asl,w) -> let avs,bod = strip_forall w and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in let avs,bod = strip_forall w in MAP_EVERY X_GEN_TAC avs THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [p])) THEN SPEC_TAC(p,p) THEN W(MATCH_MP_TAC o GEOM_HORIZONTAL_PLANE_RULE o snd));; (* ------------------------------------------------------------------------- *) (* Injection from real^2 -> real^3 plane with zero last coordinate. *) (* ------------------------------------------------------------------------- *) let pad2d3d = new_definition `(pad2d3d:real^2->real^3) x = lambda i. if i < 3 then x$i else &0`;; let FORALL_PAD2D3D_THM = prove (`!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))`, GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[pad2d3d] THEN SIMP_TAC[LAMBDA_BETA; DIMINDEX_3; ARITH; LT_REFL]; FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (y:real^3)$i):real^2`) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SIMP_TAC[CART_EQ; pad2d3d; DIMINDEX_3; ARITH; LAMBDA_BETA; DIMINDEX_2; ARITH_RULE `i < 3 <=> i <= 2`] THEN REWRITE_TAC[ARITH_RULE `i <= 3 <=> i <= 2 \/ i = 3`] THEN ASM_MESON_TAC[]]);; let QUANTIFY_PAD2D3D_THM = prove (`(!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))) /\ (!P. (?y:real^3. y$3 = &0 /\ P y) <=> (?x. P(pad2d3d x)))`, REWRITE_TAC[MESON[] `(?y. P y) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[GSYM FORALL_PAD2D3D_THM] THEN MESON_TAC[]);; let LINEAR_PAD2D3D = prove (`linear pad2d3d`, REWRITE_TAC[linear; pad2d3d] THEN SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH; ARITH_RULE `i < 3 ==> i <= 2`] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REAL_ARITH_TAC);; let INJECTIVE_PAD2D3D = prove (`!x y. pad2d3d x = pad2d3d y ==> x = y`, SIMP_TAC[CART_EQ; pad2d3d; LAMBDA_BETA; DIMINDEX_3; DIMINDEX_2] THEN REWRITE_TAC[ARITH_RULE `i < 3 <=> i <= 2`] THEN MESON_TAC[ARITH_RULE `i <= 2 ==> i <= 3`]);; let NORM_PAD2D3D = prove (`!x. norm(pad2d3d x) = norm x`, SIMP_TAC[NORM_EQ; DOT_2; DOT_3; pad2d3d; LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Apply 3D->2D conversion to a goal. Take care to preserve variable names. *) (* ------------------------------------------------------------------------- *) let PAD2D3D_QUANTIFY_CONV = let gv = genvar `:real^2` in let pth = CONV_RULE (BINOP_CONV(BINDER_CONV(RAND_CONV(GEN_ALPHA_CONV gv)))) QUANTIFY_PAD2D3D_THM in let conv1 = GEN_REWRITE_CONV I [pth] and dest_quant tm = try dest_forall tm with Failure _ -> dest_exists tm in fun tm -> let th = conv1 tm in let name = fst(dest_var(fst(dest_quant tm))) in let ty = snd(dest_var(fst(dest_quant(rand(concl th))))) in CONV_RULE(RAND_CONV(GEN_ALPHA_CONV(mk_var(name,ty)))) th;; let PAD2D3D_TAC = let pad2d3d_tm = `pad2d3d` and pths = [LINEAR_PAD2D3D; INJECTIVE_PAD2D3D; NORM_PAD2D3D] and cth = prove (`{} = IMAGE pad2d3d {} /\ vec 0 = pad2d3d(vec 0)`, REWRITE_TAC[IMAGE_CLAUSES] THEN MESON_TAC[LINEAR_PAD2D3D; LINEAR_0]) in let lasttac = GEN_REWRITE_TAC REDEPTH_CONV [LINEAR_INVARIANTS pad2d3d_tm pths] in fun gl -> (GEN_REWRITE_TAC ONCE_DEPTH_CONV [cth] THEN CONV_TAC(DEPTH_CONV PAD2D3D_QUANTIFY_CONV) THEN lasttac) gl;; (* ------------------------------------------------------------------------- *) (* Rotating so a given line from the origin becomes the x-axis. *) (* ------------------------------------------------------------------------- *) let ROTATION_HORIZONTAL_LINE = prove (`!a:real^N. ?b f. orthogonal_transformation f /\ det(matrix f) = &1 /\ f b = a /\ (!k. 1 < k /\ k <= dimindex(:N) ==> b$k = &0)`, GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [MAP_EVERY EXISTS_TAC [`a:real^N`; `\x:real^N. x`] THEN ASM_SIMP_TAC[DET_I; MATRIX_ID; ORTHOGONAL_TRANSFORMATION_ID; LTE_ANTISYM]; EXISTS_TAC `norm(a:real^N) % (basis 1):real^N` THEN SIMP_TAC[VECTOR_MUL_COMPONENT; LT_IMP_LE; BASIS_COMPONENT] THEN SIMP_TAC[ARITH_RULE `1 < k ==> ~(k = 1)`; REAL_MUL_RZERO] THEN MATCH_MP_TAC ROTATION_EXISTS THEN SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN REWRITE_TAC[REAL_ABS_NORM; REAL_MUL_RID] THEN MATCH_MP_TAC(ARITH_RULE `~(n = 1) /\ 1 <= n ==> 2 <= n`) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1]]);; let GEOM_HORIZONTAL_LINE_RULE = let pth = prove (`!f. orthogonal_transformation (f:real^N->real^N) ==> (vec 0 = f(vec 0) /\ {} = IMAGE f {}) /\ ((!P. (!x. P x) <=> (!x. P (f x))) /\ (!P. (?x. P x) <=> (?x. P (f x))) /\ (!Q. (!s. Q s) <=> (!s. Q (IMAGE f s))) /\ (!Q. (?s. Q s) <=> (?s. Q (IMAGE f s)))) /\ (!P. {x | P x} = IMAGE f {x | P(f x)})`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_CLAUSES] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN MESON_TAC[LINEAR_0]; MATCH_MP_TAC QUANTIFY_SURJECTION_THM THEN ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]]) and oth = prove (`!f:real^N->real^N. orthogonal_transformation f /\ det(matrix f) = &1 ==> linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) /\ (2 <= dimindex(:N) ==> det(matrix f) = &1)`, GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) and sth = prove (`((!k. 1 < k /\ k <= dimindex(:2) ==> b$k = &0) <=> b$2 = &0) /\ ((!k. 1 < k /\ k <= dimindex(:3) ==> b$k = &0) <=> b$2 = &0 /\ b$3 = &0)`, REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH_RULE `k <= 3 <=> k = 3 \/ k <= 2`; ARITH_RULE `k <= 2 <=> k = 2 \/ ~(1 < k)`] THEN MESON_TAC[ARITH_RULE `1 < 2 /\ 1 < 3`]) in let sfn = GEN_REWRITE_RULE ONCE_DEPTH_CONV [sth] in fun tm -> let x,bod = dest_forall tm in let th1 = EXISTS_GENVAR_RULE (sfn(ISPEC x ROTATION_HORIZONTAL_LINE)) in let [a;f],tm1 = strip_exists(concl th1) in let th_orth,th2 = CONJ_PAIR(ASSUME tm1) in let th_det,th2a = CONJ_PAIR th2 in let th_works,th_zero = CONJ_PAIR th2a in let thc,thq = CONJ_PAIR(PROVE_HYP th2 (UNDISCH(ISPEC f pth))) in let th3 = CONV_RULE(RAND_CONV(SUBS_CONV(GSYM th_works::CONJUNCTS thc))) (EXPAND_QUANTS_CONV(ASSUME(concl thq)) bod) in let th4 = PROVE_HYP thq th3 in let thps = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in let th5 = LINEAR_INVARIANTS f thps in let th6 = PROVE_HYP th_orth (GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [th5] th4) in let ntm = mk_forall(a,mk_imp(concl th_zero,rand(concl th6))) in let th7 = MP(SPEC a (ASSUME ntm)) th_zero in let th8 = DISCH ntm (EQ_MP (SYM th6) th7) in if intersect (frees(concl th8)) [a;f] = [] then let th9 = PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th8) in let th10 = DISCH ntm (GEN x (UNDISCH th9)) in CONV_RULE(LAND_CONV (GEN_ALPHA_CONV x)) th10 else let mtm = list_mk_forall([a;f],mk_imp(hd(hyp th8),rand(concl th6))) in let th9 = EQ_MP (SYM th6) (UNDISCH(SPECL [a;f] (ASSUME mtm))) in let th10 = itlist SIMPLE_CHOOSE [a;f] (DISCH mtm th9) in let th11 = GEN x (PROVE_HYP th1 th10) in MATCH_MP MONO_FORALL th11;; let GEOM_HORIZONTAL_LINE_TAC l (asl,w as gl) = let avs,bod = strip_forall w and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in (MAP_EVERY X_GEN_TAC avs THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [l])) THEN SPEC_TAC(l,l) THEN W(MATCH_MP_TAC o GEOM_HORIZONTAL_LINE_RULE o snd)) gl;; hol-light/Multivariate/wlog_examples.ml000066400000000000000000001027741303454263000206260ustar00rootroot00000000000000(* ========================================================================= *) (* Examples of using the "without loss of generality" tactics. *) (* ========================================================================= *) needs "Multivariate/wlog.ml";; (* ------------------------------------------------------------------------- *) (* Example 1. *) (* ------------------------------------------------------------------------- *) let lemma = prove (`(?y. y pow 2 = a) <=> &0 <= a`, MESON_TAC[SQRT_POW_2; REAL_LE_SQUARE; REAL_POW_2]);; let TRUONG_1 = prove (`!u1:real^3 u2 p a b. ~(u1 = u2) /\ plane p /\ {u1,u2} SUBSET p /\ dist(u1,u2) <= a + b /\ abs(a - b) < dist(u1,u2) /\ &0 <= a /\ &0 <= b ==> (?d1 d2. {d1, d2} SUBSET p /\ &1 / &2 % (d1 + d2) IN affine hull {u1, u2} /\ dist(d1,u1) = a /\ dist(d1,u2) = b /\ dist(d2,u1) = a /\ dist(d2,u2) = b)`, (*** First, rotate the plane p to the special case z$3 = &0 ***) GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN (*** Now reshuffle the goal to have explicit restricted quantifiers ***) ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d ==> e <=> c /\ a /\ b /\ d ==> e`] THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN (*** Now replace quantifiers over real^3 with those over real^2 ***) PAD2D3D_TAC THEN (*** Tidy the goal a little ***) REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN (*** Choose u1 as the origin ***) GEOM_ORIGIN_TAC `u1:real^2` THEN (*** Rotate the point u2 onto the x-axis ***) GEOM_HORIZONTAL_LINE_TAC `u2:real^2` THEN (*** Only now introduce coordinates ***) X_GEN_TAC `u2:real^2` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; NORM_NEG] THEN SIMP_TAC[GSYM real_gt; NORM_GT_SQUARE; NORM_EQ_SQUARE; NORM_LE_SQUARE] THEN REWRITE_TAC[real_gt; REAL_ARITH `~(abs x < &0)`] THEN ASM_SIMP_TAC[DOT_2; REAL_MUL_RZERO; REAL_ADD_RID; CART_EQ; DIMINDEX_2; FORALL_2; AFFINE_HULL_2; CART_EQ; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; VEC_COMPONENT; ARITH; IN_ELIM_THM; VECTOR_ADD_COMPONENT; REAL_SUB_RZERO; REAL_ADD_LID; REAL_POW2_ABS] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) STRIP_ASSUME_TAC) THEN REWRITE_TAC[EXISTS_VECTOR_2] THEN MATCH_MP_TAC(MESON[] `(?x y:real. P x y x (--y)) ==> (?x y x' y'. P x y x' y')`) THEN SIMP_TAC[AFFINE_HULL_2; IN_ELIM_THM; CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; ARITH] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; REAL_ADD_RINV] THEN ASM_SIMP_TAC[REAL_FIELD `~(a = &0) ==> (u + v = &1 /\ b = v * a <=> u = &1 - b / a /\ v = b / a)`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN ABBREV_TAC `u = (u2:real^2)$1` THEN REWRITE_TAC[REAL_ARITH `x + --y * --y:real = x + y * y`] THEN REWRITE_TAC[TAUT `a /\ b /\ a /\ b <=> a /\ b`] THEN (*** Now finally dive in and solve the algebraic problem ***) ASM_SIMP_TAC[REAL_FIELD `~(u = &0) ==> (x * x + y * y = a pow 2 /\ (x - u) * (x - u) + y * y = b pow 2 <=> x = (u pow 2 + a pow 2 - b pow 2) / (&2 * u) /\ y pow 2 = b pow 2 - (x - u) pow 2)`] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; lemma] THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_FIELD `(u pow 2 + a - b) / (&2 * u) - u = (a - b - u pow 2) / (&2 * u)`] THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_ARITH `~(u = &0) ==> &0 < abs(&2 * u)`] THEN REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_LE_SQUARE_ABS] THEN (*** Can just use SOS: this proof was found by SOS_RULE ***) MAP_EVERY UNDISCH_TAC [`u * u <= (a + b) pow 2`; `(a - b) pow 2 < u * u`] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_MUL) THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Definition of "opposite" for example 2, and its invariance theorems. *) (* ------------------------------------------------------------------------- *) let opposite = new_definition `opposite a b p <=> (&1 / &2 % (a + b)) IN p /\ (!x y:real^N. {x,y} SUBSET p ==> (x - y) dot (a - b) = &0)`;; let OPPOSITE_TRANSLATION_EQ = prove (`!c a b p. opposite (c + a) (c + b) (IMAGE (\x. c + x) p) <=> opposite a b p`, REWRITE_TAC[opposite] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [OPPOSITE_TRANSLATION_EQ];; let OPPOSITE_LINEAR_IMAGE_EQ = prove (`!f a b p. linear f /\ (!x. norm(f x) = norm x) ==> (opposite (f a) (f b) (IMAGE f p) <=> opposite a b p)`, SIMP_TAC[opposite; INSERT_SUBSET; EMPTY_SUBSET; GSYM orthogonal] THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[GSYM LINEAR_ADD; GSYM LINEAR_SUB; ORTHOGONAL_LINEAR_IMAGE_EQ] THEN SIMP_TAC[GSYM LINEAR_CMUL; IN_IMAGE] THEN MESON_TAC[PRESERVES_NORM_INJECTIVE]);; add_linear_invariants [OPPOSITE_LINEAR_IMAGE_EQ];; (* ------------------------------------------------------------------------- *) (* Example 2. *) (* ------------------------------------------------------------------------- *) let AFFINE_PLANE = prove (`!p. plane p ==> affine p`, SIMP_TAC[plane; LEFT_IMP_EXISTS_THM; AFFINE_AFFINE_HULL]);; let lemma = prove (`!a b:real^2. a$2 <= &0 /\ &0 <= b$2 ==> ?x. x IN convex hull {a,b} /\ x$2 = &0`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `a <= &0 /\ &0 <= b ==> a = &0 /\ b = &0 \/ &0 < b - a`)) THENL [EXISTS_TAC `a:real^2` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT]; REWRITE_TAC[CONVEX_HULL_2_ALT; EXISTS_IN_GSPEC] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH] THEN EXISTS_TAC `--(a$2) / ((b:real^2)$2 - (a:real^2)$2)` THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_RMUL; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC]);; let TRUONG_OPPOSITE_LEMMA = prove (`!p a b bb m x y:real^3. plane p /\ {a, b, bb, m, x, y} SUBSET p /\ ~(x = y) /\ m IN affine hull {x,y} /\ midpoint(b,bb) = m ==> ~(convex hull {a, b} INTER affine hull {x, y} = {}) \/ ~(convex hull {a, bb} INTER affine hull {x, y} = {})`, (*** Make the plane p the xy-plane ***) GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN (*** Rewrite with explicit restricted quantifiers ***) REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(K ALL_TAC) THEN (*** Now replace quantifiers over real^3 with those over real^2 ***) PAD2D3D_TAC THEN (*** Let x be the origin, and y on the x-axis ***) GEOM_ORIGIN_TAC `x:real^2` THEN GEOM_HORIZONTAL_LINE_TAC `y:real^2` THEN (*** Make a few simplifications ***) GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN ASM_SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VEC_COMPONENT] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN SIMP_TAC[midpoint; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN (*** Show aff{x,y} is now exactly the x-axis ***) SUBGOAL_THEN `affine hull {vec 0,y} = {u:real^2 | u$2 = &0}` SUBST1_TAC THENL [MATCH_MP_TAC HULL_UNIQUE THEN REWRITE_TAC[affine; INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_2; ARITH; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; REAL_MUL_RZERO; REAL_ADD_RID] THEN X_GEN_TAC `s:real^2->bool` THEN STRIP_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real^2` THEN DISCH_TAC THEN SUBGOAL_THEN `u = (&1 - u$1 / (y:real^2)$1) % vec 0 + (u$1 / (y:real^2)$1) % y` SUBST1_TAC THENL [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN ASM_SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH; FORALL_2; REAL_MUL_RZERO; REAL_DIV_RMUL]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; ALL_TAC] THEN (*** Simplify a bit more ***) SIMP_TAC[IN_ELIM_THM; REAL_ARITH `inv(&2) * (x + y) = &0 <=> y = --x`] THEN REPEAT STRIP_TAC THEN (*** Finally, make a 4-way case split then apply the lemma to each ***) REWRITE_TAC[SET_RULE `~(s INTER t = {}) <=> ?x. x IN s /\ x IN t`] THEN REWRITE_TAC[IN_ELIM_THM] THEN FIRST_ASSUM(MP_TAC o SPEC `(a:real^2)$2` o MATCH_MP (REAL_ARITH `b' = --b ==> !a. a <= &0 /\ &0 <= b \/ a <= &0 /\ &0 <= b' \/ b <= &0 /\ &0 <= a \/ b' <= &0 /\ &0 <= a`)) THEN MESON_TAC[lemma; SET_RULE `{a,b} = {b,a}`]);; let TRUONG_OPPOSITE_THM = prove (`!a b bb x y:real^3 p. ~(x = y) /\ plane p /\ {a, b, x, y} SUBSET p /\ opposite b bb (affine hull {x, y}) ==> ~(convex hull {a, b} INTER affine hull {x, y} = {}) \/ ~(convex hull {a, bb} INTER affine hull {x, y} = {})`, REWRITE_TAC[opposite; INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC TRUONG_OPPOSITE_LEMMA THEN MAP_EVERY EXISTS_TAC [`p:real^3->bool`; `&1 / &2 % (b + bb):real^3`] THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; midpoint] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_PLANE) THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN EXISTS_TAC `affine hull {x:real^3,y}` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET]; DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH `bb:real^3 = -- &1 % b + &2 % &1 / &2 % (b + bb)`) THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[affine]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Affsign variants for example 3, and invariance theorems. *) (* ------------------------------------------------------------------------- *) let lin_combo = new_definition `lin_combo V f = vsum V (\v. f v % (v:real^N))`;; let affsign = new_definition `affsign sgn s t (v:real^A) <=> (?f. (v = lin_combo (s UNION t) f) /\ (!w. t w ==> sgn (f w)) /\ (sum (s UNION t) f = &1))`;; let sgn_gt = new_definition `sgn_gt = (\t. (&0 < t))`;; let sgn_ge = new_definition `sgn_ge = (\t. (&0 <= t))`;; let sgn_lt = new_definition `sgn_lt = (\t. (t < &0))`;; let sgn_le = new_definition `sgn_le = (\t. (t <= &0))`;; let aff_gt_def = new_definition `aff_gt = affsign sgn_gt`;; let aff_ge_def = new_definition `aff_ge = affsign sgn_ge`;; let aff_lt_def = new_definition `aff_lt = affsign sgn_lt`;; let aff_le_def = new_definition `aff_le = affsign sgn_le`;; let AFFSIGN = prove (`affsign sgn s t = {y | ?f. y = vsum (s UNION t) (\v. f v % v) /\ (!w. w IN t ==> sgn(f w)) /\ sum (s UNION t) f = &1}`, REWRITE_TAC[FUN_EQ_THM; affsign; lin_combo; IN_ELIM_THM] THEN REWRITE_TAC[IN]);; let AFFSIGN_ALT = prove (`affsign sgn s t = {y | ?f. (!w. w IN (s UNION t) ==> w IN t ==> sgn(f w)) /\ sum (s UNION t) f = &1 /\ vsum (s UNION t) (\v. f v % v) = y}`, REWRITE_TAC[SET_RULE `(w IN (s UNION t) ==> w IN t ==> P w) <=> (w IN t ==> P w)`] THEN REWRITE_TAC[AFFSIGN; EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);; let IN_AFFSIGN = prove (`y IN affsign sgn s t <=> ?u. (!x. x IN t ==> sgn(u x)) /\ sum (s UNION t) u = &1 /\ vsum (s UNION t) (\x. u(x) % x) = y`, REWRITE_TAC[AFFSIGN; IN_ELIM_THM] THEN SET_TAC[]);; let AFFSIGN_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N sgn s t v. linear f /\ (!x y. f x = f y ==> x = y) ==> (affsign sgn (IMAGE f s) (IMAGE f t) = IMAGE f (affsign sgn s t))`, let lemma0 = prove (`vsum s (\x. u x % x) = vsum {x | x IN s /\ ~(u x = &0)} (\x. u x % x)`, MATCH_MP_TAC VSUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[TAUT `p /\ ~(p /\ ~q) <=> p /\ q`] THEN SIMP_TAC[o_THM; VECTOR_MUL_LZERO]) in let lemma1 = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (sum(IMAGE f s) u = &1 /\ vsum(IMAGE f s) (\x. u x % x) = y <=> sum s (u o f) = &1 /\ f(vsum s (\x. (u o f) x % x)) = y)`, REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o funpow 3 lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN MATCH_MP_TAC(MESON[] `(p ==> z = x) ==> (p /\ x = y <=> p /\ z = y)`) THEN DISCH_TAC THEN ONCE_REWRITE_TAC[lemma0] THEN SUBGOAL_THEN `{y | y IN IMAGE (f:real^M->real^N) s /\ ~(u y = &0)} = IMAGE f {x | x IN s /\ ~(u(f x) = &0)}` SUBST1_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN SUBGOAL_THEN `FINITE {x | x IN s /\ ~(u((f:real^M->real^N) x) = &0)}` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD; o_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; GSYM LINEAR_CMUL]]) in REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_AFFSIGN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; IN_AFFSIGN] THEN REWRITE_TAC[GSYM IMAGE_UNION] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma1 th]) THEN X_GEN_TAC `y:real^N` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `vsum (s UNION t) (\x. (u o (f:real^M->real^N)) x % x)` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `(u:real^N->real) o (f:real^M->real^N)` THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[o_THM]; MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `u:real^M->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; let AFF_GE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_ge (IMAGE f s) (IMAGE f t) = IMAGE f (aff_ge s t)`, REWRITE_TAC[aff_ge_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; let AFF_GT_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_gt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_gt s t)`, REWRITE_TAC[aff_gt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; let AFF_LE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_le (IMAGE f s) (IMAGE f t) = IMAGE f (aff_le s t)`, REWRITE_TAC[aff_le_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; let AFF_LT_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> aff_lt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_lt s t)`, REWRITE_TAC[aff_lt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; add_linear_invariants [AFFSIGN_INJECTIVE_LINEAR_IMAGE; AFF_GE_INJECTIVE_LINEAR_IMAGE; AFF_GT_INJECTIVE_LINEAR_IMAGE; AFF_LE_INJECTIVE_LINEAR_IMAGE; AFF_LT_INJECTIVE_LINEAR_IMAGE];; let IN_AFFSIGN_TRANSLATION = prove (`!sgn s t a v:real^N. affsign sgn s t v ==> affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) (a + v)`, REPEAT GEN_TAC THEN REWRITE_TAC[affsign; lin_combo] THEN ONCE_REWRITE_TAC[SET_RULE `(!x. s x ==> p x) <=> (!x. x IN s ==> p x)`] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` (CONJUNCTS_THEN2 SUBST_ALL_TAC STRIP_ASSUME_TAC)) THEN EXISTS_TAC `\x. (f:real^N->real)(x - a)` THEN ASM_REWRITE_TAC[GSYM IMAGE_UNION] THEN REPEAT CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[FORALL_IN_IMAGE; ETA_AX; VECTOR_ARITH `(a + x) - a:real^N = x`]; W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN ASM_REWRITE_TAC[o_DEF; VECTOR_ADD_SUB; ETA_AX]] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `a + vsum {x | x IN s UNION t /\ ~(f x = &0)} (\v:real^N. f v % v)` THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum (IMAGE (\x:real^N. a + x) {x | x IN s UNION t /\ ~(f x = &0)}) (\v. f(v - a) % v)` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; VECTOR_MUL_EQ_0] THEN REWRITE_TAC[VECTOR_ADD_SUB] THEN SET_TAC[]] THEN SUBGOAL_THEN `FINITE {x:real^N | x IN s UNION t /\ ~(f x = &0)}` ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rhs o snd) THEN ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[o_DEF; VECTOR_ADD_SUB] THEN ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VSUM_RMUL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[]);; let AFFSIGN_TRANSLATION = prove (`!a:real^N sgn s t. affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (affsign sgn s t)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP IN_AFFSIGN_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; IMAGE_ID] THEN DISCH_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `--a + x:real^N` THEN ASM_REWRITE_TAC[IN] THEN VECTOR_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN REWRITE_TAC[IN] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP IN_AFFSIGN_TRANSLATION) THEN REWRITE_TAC[]]);; let AFF_GE_TRANSLATION = prove (`!a:real^N s t. aff_ge (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_ge s t)`, REWRITE_TAC[aff_ge_def; AFFSIGN_TRANSLATION]);; let AFF_GT_TRANSLATION = prove (`!a:real^N s t. aff_gt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_gt s t)`, REWRITE_TAC[aff_gt_def; AFFSIGN_TRANSLATION]);; let AFF_LE_TRANSLATION = prove (`!a:real^N s t. aff_le (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_le s t)`, REWRITE_TAC[aff_le_def; AFFSIGN_TRANSLATION]);; let AFF_LT_TRANSLATION = prove (`!a:real^N s t. aff_lt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = IMAGE (\x. a + x) (aff_lt s t)`, REWRITE_TAC[aff_lt_def; AFFSIGN_TRANSLATION]);; add_translation_invariants [AFFSIGN_TRANSLATION; AFF_GE_TRANSLATION; AFF_GT_TRANSLATION; AFF_LE_TRANSLATION; AFF_LT_TRANSLATION];; (* ------------------------------------------------------------------------- *) (* Example 3. *) (* ------------------------------------------------------------------------- *) let NOT_COPLANAR_NOT_COLLINEAR = prove (`!v1 v2 v3 w:real^N. ~coplanar {v1, v2, v3, w} ==> ~collinear {v1, v2, v3}`, REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar; CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN EXISTS_TAC `w:real^N` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN REPEAT CONJ_TAC THEN MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN EXISTS_TAC `affine hull {x:real^N,y}` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; let AFFSIGN = prove (`affsign sgn s t = {y | ?f. y = vsum (s UNION t) (\v. f v % v) /\ (!w. w IN t ==> sgn(f w)) /\ sum (s UNION t) f = &1}`, REWRITE_TAC[FUN_EQ_THM; affsign; lin_combo; IN_ELIM_THM] THEN REWRITE_TAC[IN]);; let IN_AFFSIGN = prove (`y IN affsign sgn s t <=> ?u. (!x. x IN (s UNION t) ==> x IN t ==> sgn(u x)) /\ sum (s UNION t) u = &1 /\ vsum (s UNION t) (\x. u(x) % x) = y`, REWRITE_TAC[AFFSIGN; IN_ELIM_THM] THEN SET_TAC[]);; let LEMMA = prove (`!v1 v2 v3 w:real^3 p. plane p /\ {v1, v2, v3} SUBSET p /\ ~coplanar {v1, v2, v3, w} ==> (?n n'. norm(n - n') = &1 /\ (!x. x IN aff_ge {v1, v2, v3} {w} <=> (?xx h. xx IN affine hull {v1, v2, v3} /\ &0 <= h /\ x - xx = h % (n - n'))) /\ (!x y. {x, y} SUBSET affine hull {v1, v2, v3} ==> (n - n') dot (x - y) = &0))`, GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN MAP_EVERY (fun t -> ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC]) [`v1:real^3 = v2`; `v1:real^3 = v3`; `v2:real^3 = v3`; `v1:real^3 = w`; `v2:real^3 = w`; `v3:real^3 = w`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN SUBGOAL_THEN `~((w:real^3)$3 = &0)` ASSUME_TAC THENL [DISCH_TAC THEN UNDISCH_TAC `~coplanar{v1:real^3,v2,v3,w}` THEN REWRITE_TAC[coplanar] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [plane]) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM]; ALL_TAC] THEN SUBGOAL_THEN `(vec 0:real^3) IN affine hull {v1,v2,v3}` ASSUME_TAC THENL [MP_TAC(ISPEC `{v1:real^3,v2,v3}` DEPENDENT_BIGGERSET_GENERAL) THEN ANTS_TAC THENL [DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GT] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `dim {z:real^3 | z$3 = &0}` THEN CONJ_TAC THENL [MATCH_MP_TAC DIM_SUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_3; ARITH] THEN REWRITE_TAC[GSYM NOT_LE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP NOT_COPLANAR_NOT_COLLINEAR) THEN REWRITE_TAC[] THEN MATCH_MP_TAC COLLINEAR_SMALL THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES]; ALL_TAC] THEN REWRITE_TAC[DEPENDENT_AFFINE_DEPENDENT_CASES] THEN ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3; NOT_COPLANAR_NOT_COLLINEAR]; ALL_TAC] THEN SUBGOAL_THEN `affine hull {v1,v2,v3} = {z:real^3 | z$3 = &0}` ASSUME_TAC THENL [ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN MATCH_MP_TAC(SET_RULE `!s. t SUBSET u /\ s SUBSET t /\ u SUBSET s ==> t = u`) THEN EXISTS_TAC `span {x - v1:real^3 | x IN {v2,v3}}` THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET] THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE; DIMINDEX_3; ARITH] THEN ASM_SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM]; ALL_TAC] THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN MATCH_MP_TAC SPAN_MONO THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[SPAN_SUB; SPAN_INC; IN_INSERT; SUBSET]; ALL_TAC] THEN MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH; REAL_SUB_REFL]; REWRITE_TAC[independent] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] DEPENDENT_IMP_AFFINE_DEPENDENT)) THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3; NOT_COPLANAR_NOT_COLLINEAR]; SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_3; ARITH] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[CARD_IMAGE_INJ; FINITE_INSERT; FINITE_RULES; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY; ARITH]]; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ &0 < --x`)) THENL [EXISTS_TAC `basis 3:real^3`; EXISTS_TAC `--(basis 3):real^3`] THEN ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_3; ARITH; IN_ELIM_THM; DOT_BASIS; NORM_NEG; DOT_LNEG; DIMINDEX_3; ARITH; VECTOR_SUB_COMPONENT; REAL_SUB_REFL; REAL_NEG_0] THEN X_GEN_TAC `x:real^3` THEN REWRITE_TAC[aff_ge_def; IN_AFFSIGN; sgn_ge] THEN REWRITE_TAC[SET_RULE `{a,b,c} UNION {d} = {a,b,c,d}`] THEN REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN; REAL_LE_ADD; FINITE_INSERT; CONJUNCT1 FINITE_RULES; REAL_ARITH `&0 <= x / &2 <=> &0 <= x`; RIGHT_EXISTS_AND_THM] THEN ASM_REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ARITH `x - y:real^3 = z <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN REWRITE_TAC[REAL_ARITH `&1 = x + y <=> x + y = &1`] THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL [MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`; `h:real`] THEN STRIP_TAC THEN EXISTS_TAC `a % v1 + b % v2 + c % v3 + h % ((w:real^3)$1 % basis 1 + w$2 % basis 2):real^3` THEN EXISTS_TAC `h * (w:real^3)$3` THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; GSYM VECTOR_ADD_ASSOC] THEN REPLICATE_TAC 4 AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID]; MAP_EVERY X_GEN_TAC [`y:real^3`; `h:real`] THEN STRIP_TAC THEN UNDISCH_TAC `(vec 0:real^3) IN affine hull {v1,v2,v3}` THEN SUBGOAL_THEN `(y - h / (w:real^3)$3 % (w$1 % basis 1 + w$2 % basis 2)) IN affine hull {v1:real^3,v2,v3}` MP_TAC THENL [ASM_SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; BASIS_COMPONENT; ARITH; DIMINDEX_3] THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; CONJUNCT1 FINITE_RULES; AFFINE_HULL_FINITE_STEP; IN_ELIM_THM] THEN REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ARITH `x - y:real^3 = z <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `&1 = x + y <=> x + y = &1`] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`a':real`; `b':real`; `c':real`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SYM)) THEN MAP_EVERY EXISTS_TAC [`a + (&1 - (a + b + c + h / (w:real^3)$3)) * a'`; `b + (&1 - (a + b + c + h / (w:real^3)$3)) * b'`; `c + (&1 - (a + b + c + h / (w:real^3)$3)) * c'`; `h / (w:real^3)$3`] THEN ASM_REWRITE_TAC[REAL_ARITH `(a + x * a') + (b + x * b') + (c + x * c') + h:real = (a + b + c + h) + x * (a' + b' + c')`] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `(a + x * a') % v1 + (b + x * b') % v2 + (c + x * c') % v3 + h:real^N = (a % v1 + b % v2 + c % v3) + x % (a' % v1 + b' % v2 + c' % v3) + h`] THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[VECTOR_ARITH `(x + a) + y:real^3 = a + z <=> x + y = z`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM VECTOR_ADD_ASSOC] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_RMUL; REAL_LT_IMP_NZ]; MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`; `h:real`] THEN STRIP_TAC THEN EXISTS_TAC `a % v1 + b % v2 + c % v3 + h % ((w:real^3)$1 % basis 1 + w$2 % basis 2):real^3` THEN EXISTS_TAC `h * --((w:real^3)$3)` THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN REWRITE_TAC[VECTOR_ARITH `(x * --y) % --z:real^N = (x * y) % z`] THEN ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; GSYM VECTOR_ADD_ASSOC] THEN REPLICATE_TAC 4 AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID]; MAP_EVERY X_GEN_TAC [`y:real^3`; `h:real`] THEN STRIP_TAC THEN UNDISCH_TAC `(vec 0:real^3) IN affine hull {v1,v2,v3}` THEN SUBGOAL_THEN `(y - h / --((w:real^3)$3) % (w$1 % basis 1 + w$2 % basis 2)) IN affine hull {v1:real^3,v2,v3}` MP_TAC THENL [ASM_SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; BASIS_COMPONENT; ARITH; DIMINDEX_3] THEN REAL_ARITH_TAC; ALL_TAC] THEN SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; CONJUNCT1 FINITE_RULES; AFFINE_HULL_FINITE_STEP; IN_ELIM_THM] THEN REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ARITH `x - y:real^3 = z <=> x = y + z`] THEN REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[REAL_ARITH `&1 = x + y <=> x + y = &1`] THEN MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`a':real`; `b':real`; `c':real`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SYM)) THEN MAP_EVERY EXISTS_TAC [`a + (&1 - (a + b + c + h / --((w:real^3)$3))) * a'`; `b + (&1 - (a + b + c + h / --((w:real^3)$3))) * b'`; `c + (&1 - (a + b + c + h / --((w:real^3)$3))) * c'`; `h / --((w:real^3)$3)`] THEN ASM_REWRITE_TAC[REAL_ARITH `(a + x * a') + (b + x * b') + (c + x * c') + h:real = (a + b + c + h) + x * (a' + b' + c')`] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VECTOR_ARITH `(a + x * a') % v1 + (b + x * b') % v2 + (c + x * c') % v3 + h:real^N = (a % v1 + b % v2 + c % v3) + x % (a' % v1 + b' % v2 + c' % v3) + h`] THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN REWRITE_TAC[VECTOR_ARITH `(x + a) + y:real^3 = a + z <=> x + y = z`] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM VECTOR_ADD_ASSOC] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_RNEG] THEN REWRITE_TAC[VECTOR_MUL_RNEG; VECTOR_MUL_LNEG; GSYM real_div] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_RMUL; REAL_LT_IMP_NZ]]);; let THEOREM = prove (`!v1 v2 v3 w:real^3. ~coplanar {v1, v2, v3, w} ==> (?nor. norm nor = &1 /\ (!x. x IN aff_ge {v1, v2, v3} {w} <=> (?xx h. xx IN affine hull {v1, v2, v3} /\ &0 <= h /\ x = xx + h % nor)) /\ (!x y. {x, y} SUBSET affine hull {v1, v2, v3} ==> nor dot (x - y) = &0))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^3 = y + h % z <=> x - y = h % z`] THEN MATCH_MP_TAC(MESON[] `(?a b. P(a - b)) ==> ?a:real^3. P a`) THEN MATCH_MP_TAC LEMMA THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `affine hull {v1:real^3,v2,v3}` THEN REWRITE_TAC[HULL_SUBSET; plane] THEN ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR]);; hol-light/Ntrie/000077500000000000000000000000001303454263000140265ustar00rootroot00000000000000hol-light/Ntrie/ntrie.ml000066400000000000000000000403201303454263000155000ustar00rootroot00000000000000(* ========================================================================= *) (* Computations with finite sets of nums. *) (* *) (* (c) Copyright, Clelia Lomuto, Marco Maggesi, 2009. *) (* Distributed with HOL Light under same license terms *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* This file defines some conversions that operate on finite sets of nums *) (* represented literally in a trie-like structure (we call them `ntries'). *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* Example: *) (* # NTRIE_COMPUTE NTRIE_REDUCE_CONV *) (* `{10, 1001, 3} INTER {3, 7, 10} SUBSET {10, 10000} UNION {3, 33}`;; *) (* val it : thm = *) (* |- {10, 1001, 3} INTER {3, 7, 10} SUBSET {10, 10000} UNION {3, 33} <=> T *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* Constructors for the ntrie representation of a set of nums. *) (* ------------------------------------------------------------------------- *) let NEMPTY = new_definition `NEMPTY:num->bool = {}`;; let NZERO = new_definition `NZERO = {_0}`;; let NNODE = new_definition `!s t. NNODE s t = IMAGE BIT0 s UNION IMAGE BIT1 t`;; let NTRIE = new_definition `!s:num->bool. NTRIE s = s`;; let NTRIE_RELATIONS = prove (`NNODE NEMPTY NEMPTY = NEMPTY /\ NNODE NZERO NEMPTY = NZERO`, REWRITE_TAC[NEMPTY; NZERO; NNODE; EXTENSION; NOT_IN_EMPTY; IN_INSERT; IN_UNION; IN_IMAGE] THEN MESON_TAC[ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* Membership. *) (* ------------------------------------------------------------------------- *) let NTRIE_IN = prove (`(!s n. NUMERAL n IN NTRIE s <=> n IN s) /\ (!n. ~(n IN NEMPTY)) /\ (!n. n IN NZERO <=> n = _0) /\ (!s t. _0 IN NNODE s t <=> _0 IN s) /\ (!s t n. BIT0 n IN NNODE s t <=> n IN s) /\ (!s t n. BIT1 n IN NNODE s t <=> n IN t)`, REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE; NOT_IN_EMPTY; IN_INSERT; IN_UNION; IN_IMAGE; ARITH_EQ] THEN MESON_TAC[]);; let NTRIE_IN_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_IN in REWR_CONV tth THENC REWRITE_CONV[pths; CONJUNCT2 ARITH_EQ];; (* ------------------------------------------------------------------------- *) (* Inclusion. *) (* ------------------------------------------------------------------------- *) let NTRIE_SUBSET = prove (`(!s t. NTRIE s SUBSET NTRIE t <=> s SUBSET t) /\ (!s. NEMPTY SUBSET s) /\ (!s:num->bool. s SUBSET s) /\ ~(NZERO SUBSET NEMPTY) /\ (!s t. NNODE s t SUBSET NEMPTY <=> s SUBSET NEMPTY /\ t SUBSET NEMPTY) /\ (!s t. NNODE s t SUBSET NZERO <=> s SUBSET NZERO /\ t SUBSET NEMPTY) /\ (!s t. NZERO SUBSET NNODE s t <=> NZERO SUBSET s) /\ (!s1 s2 t1 t2. NNODE s1 t1 SUBSET NNODE s2 t2 <=> s1 SUBSET s2 /\ t1 SUBSET t2)`, REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE; EMPTY_SUBSET; SUBSET_REFL; SING_SUBSET; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; NOT_IN_EMPTY; IN_INSERT; IN_UNION; IN_IMAGE; ARITH_EQ] THENL [MESON_TAC[]; MESON_TAC[ARITH_EQ]; MESON_TAC[]; EQ_TAC] THENL [ALL_TAC; MESON_TAC[ARITH_EQ]] THEN STRIP_TAC THEN CONJ_TAC THEN GEN_TAC THENL [POP_ASSUM (MP_TAC o SPEC `BIT0 x`); POP_ASSUM (MP_TAC o SPEC `BIT1 x`)] THEN REWRITE_TAC[ARITH_EQ] THEN MESON_TAC[]);; let NTRIE_SUBSET_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_SUBSET in REWR_CONV tth THENC REWRITE_CONV[pths];; (* ------------------------------------------------------------------------- *) (* Equality. *) (* ------------------------------------------------------------------------- *) let NTRIE_EQ = prove (`(!s t. NTRIE s = NTRIE t <=> s = t) /\ (!s:num->bool. s = s) /\ ~(NZERO = NEMPTY) /\ ~(NEMPTY = NZERO) /\ (!s t. NNODE s t = NEMPTY <=> s = NEMPTY /\ t = NEMPTY) /\ (!s t. NEMPTY = NNODE s t <=> s = NEMPTY /\ t = NEMPTY) /\ (!s t. NNODE s t = NZERO <=> s = NZERO /\ t = NEMPTY) /\ (!s t. NZERO = NNODE s t <=> s = NZERO /\ t = NEMPTY) /\ (!s1 s2 t1 t2. NNODE s1 t1 = NNODE s2 t2 <=> s1 = s2 /\ t1 = t2)`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; NTRIE_SUBSET; NEMPTY; NZERO] THEN SET_TAC[]);; let NTRIE_EQ_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_EQ in REWR_CONV tth THENC REWRITE_CONV[pths];; (* ------------------------------------------------------------------------- *) (* Singleton. *) (* ------------------------------------------------------------------------- *) let NTRIE_SING = prove (`(!n. {NUMERAL n} = NTRIE {n}) /\ {_0} = NZERO /\ (!n. {BIT0 n} = if n = _0 then NZERO else NNODE {n} NEMPTY) /\ (!n. {BIT1 n} = NNODE NEMPTY {n})`, REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE; IMAGE_CLAUSES; UNION_EMPTY] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_ZERO]);; let NTRIE_SING_CONV = let tth,pths = CONJ_PAIR NTRIE_SING in REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths; CONJUNCT2 ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* Insertion. *) (* ------------------------------------------------------------------------- *) let NTRIE_INSERT = prove (`(!s n. NUMERAL n INSERT NTRIE s = NTRIE (n INSERT s)) /\ (!n. n INSERT NEMPTY = {n}) /\ _0 INSERT NZERO = NZERO /\ (!s t n. _0 INSERT NNODE s t = NNODE (_0 INSERT s) t) /\ (!n. BIT0 n INSERT NZERO = if n = _0 then NZERO else NNODE (n INSERT NZERO) NEMPTY) /\ (!n. BIT1 n INSERT NZERO = NNODE NZERO {n}) /\ (!s t n. BIT0 n INSERT NNODE s t = NNODE (n INSERT s) t) /\ (!s t n. BIT1 n INSERT NNODE s t = NNODE s (n INSERT t))`, REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[ARITH_EQ]);; let NTRIE_INSERT_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_INSERT in REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths; CONJUNCT2 NTRIE_SING; CONJUNCT2 ARITH_EQ]);; (* ------------------------------------------------------------------------- *) (* Union. *) (* ------------------------------------------------------------------------- *) let NTRIE_UNION = prove (`(!s t. NTRIE s UNION NTRIE t = NTRIE (s UNION t)) /\ (!s. s UNION NEMPTY = s) /\ (!s. NEMPTY UNION s = s) /\ NZERO UNION NZERO = NZERO /\ (!s t. NNODE s t UNION NZERO = NNODE (s UNION NZERO) t) /\ (!s t. NZERO UNION NNODE s t = NNODE (s UNION NZERO) t) /\ (!s t r q. NNODE s t UNION NNODE r q = NNODE (s UNION r) (t UNION q))`, REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN REWRITE_TAC[UNION_EMPTY; INSERT_UNION; NOT_IN_EMPTY; IN_INSERT; IN_UNION; IN_IMAGE; EXTENSION] THEN MESON_TAC[ARITH_EQ]);; let NTRIE_UNION_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_UNION in REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths]);; (* ------------------------------------------------------------------------- *) (* Intersection. *) (* Warning: rewriting with this theorem generates ntries which are not *) (* "minimal". It has to be used in conjuction with NTRIE_RELATIONS. *) (* ------------------------------------------------------------------------- *) let NTRIE_INTER = prove (`(!s t. NTRIE s INTER NTRIE t = NTRIE (s INTER t)) /\ (!s. NEMPTY INTER s = NEMPTY) /\ (!s. s INTER NEMPTY = NEMPTY) /\ NZERO INTER NZERO = NZERO /\ (!s t. NZERO INTER NNODE s t = NZERO INTER s) /\ (!s t. NNODE s t INTER NZERO = NZERO INTER s) /\ (!s1 s2 t1 t2. NNODE s1 t1 INTER NNODE s2 t2 = NNODE (s1 INTER s2) (t1 INTER t2))`, REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE; INTER_EMPTY; INSERT_INTER; NOT_IN_EMPTY; IN_INSERT] THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[IN_UNION; IN_IMAGE; ARITH_EQ] THEN ASM_MESON_TAC[]; COND_CASES_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[ARITH_EQ]; REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; IN_IMAGE] THEN MESON_TAC[ARITH_EQ]]);; let NTRIE_INTER_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_INTER in REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths; NTRIE_RELATIONS]);; (* ------------------------------------------------------------------------- *) (* Deleting an element. *) (* Warning: rewriting with this theorem generates ntries which are not *) (* "minimal". It has to be used in conjuction with NTRIE_RELATIONS. *) (* ------------------------------------------------------------------------- *) let NTRIE_DELETE = prove (`(!s n. NTRIE s DELETE NUMERAL n = NTRIE (s DELETE n)) /\ (!n. NEMPTY DELETE n = NEMPTY) /\ (!n. NZERO DELETE n = if n = _0 then NEMPTY else NZERO) /\ (!s t. NNODE s t DELETE _0 = NNODE (s DELETE _0) t) /\ (!s t n. NNODE s t DELETE BIT0 n = NNODE (s DELETE n) t) /\ (!s t n. NNODE s t DELETE BIT1 n = NNODE s (t DELETE n))`, REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_DELETE; IN_UNION; IN_IMAGE; NOT_IN_EMPTY; IN_INSERT] THEN ASM_MESON_TAC[ARITH_EQ]);; let NTRIE_DELETE_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_DELETE in REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths; NTRIE_RELATIONS]);; (* ------------------------------------------------------------------------- *) (* Disjoint. *) (* ------------------------------------------------------------------------- *) let NTRIE_DISJOINT = prove (`(!s t. DISJOINT (NTRIE s) (NTRIE t) <=> DISJOINT s t) /\ (!s. DISJOINT s NEMPTY) /\ (!s. DISJOINT NEMPTY s) /\ ~DISJOINT NZERO NZERO /\ (!s t. DISJOINT NZERO (NNODE s t) <=> DISJOINT s NZERO) /\ (!s t. DISJOINT (NNODE s t) NZERO <=> DISJOINT s NZERO) /\ (!s1 s2 t1 t2. DISJOINT (NNODE s1 t1) (NNODE s2 t2) <=> DISJOINT s1 s2 /\ DISJOINT t1 t2)`, REWRITE_TAC[NTRIE; DISJOINT; GSYM NEMPTY; NTRIE_INTER; INTER_ACI; NTRIE_EQ]);; let NTRIE_DISJOINT_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_DISJOINT in REWR_CONV tth THENC REWRITE_CONV[pths];; (* ------------------------------------------------------------------------- *) (* Difference. *) (* ------------------------------------------------------------------------- *) let NTRIE_DIFF = prove (`(!s t. NTRIE s DIFF NTRIE t = NTRIE (s DIFF t)) /\ (!s. NEMPTY DIFF s = NEMPTY) /\ (!s. s DIFF NEMPTY = s) /\ NZERO DIFF NZERO = NEMPTY /\ (!s t. NZERO DIFF NNODE s t = NZERO DIFF s) /\ (!s t. NNODE s t DIFF NZERO = NNODE (s DIFF NZERO) t) /\ (!s1 t1 s2 t2. NNODE s1 t1 DIFF NNODE s2 t2 = NNODE (s1 DIFF s2) (t1 DIFF t2))`, REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE; EMPTY_DIFF; DIFF_EMPTY; DIFF_EQ_EMPTY; EXTENSION; NOT_IN_EMPTY; IN_INSERT; IN_DIFF; IN_UNION; IN_IMAGE] THEN MESON_TAC[ARITH_EQ]);; let NTRIE_DIFF_CONV : conv = let tth,pths = CONJ_PAIR NTRIE_DIFF in REWR_CONV tth THENC REWRITE_CONV[pths];; (* ------------------------------------------------------------------------- *) (* Image. *) (* ------------------------------------------------------------------------- *) let NTRIE_IMAGE_DEF = new_definition `!f acc s. NTRIE_IMAGE f acc s = IMAGE f s UNION acc`;; let NTRIE_IMAGE = prove (`(!f acc. NTRIE_IMAGE f acc NEMPTY = acc) /\ (!f acc. NTRIE_IMAGE f acc NZERO = f _0 INSERT acc) /\ (!f acc s t. NTRIE_IMAGE f acc (NNODE s t) = NTRIE_IMAGE (\n. f (BIT1 n)) (NTRIE_IMAGE (\n. f (BIT0 n)) acc s) t)`, REWRITE_TAC[NEMPTY; NZERO; NNODE; NTRIE_IMAGE_DEF; GSYM IMAGE_o; o_DEF; IMAGE_UNION; IMAGE_CLAUSES; UNION_EMPTY; INSERT_UNION] THEN REPEAT STRIP_TAC THENL [COND_CASES_TAC THEN ASM SET_TAC[]; SET_TAC[]]);; let IMAGE_EQ_NTRIE_IMAGE = prove (`!f s. IMAGE f (NTRIE s) = NTRIE_IMAGE (\n. f (NUMERAL n)) {} s`, REWRITE_TAC [NUMERAL; NTRIE; ETA_AX; NTRIE_IMAGE_DEF; UNION_EMPTY]);; let NTRIE_IMAGE_CONV : conv -> conv = let [c1;c2;c3] = map REWR_CONV (CONJUNCTS NTRIE_IMAGE) in fun cnv -> let rec conv tm = (c1 ORELSEC (c2 THENC LAND_CONV (TRY_CONV BETA_CONV THENC cnv)) ORELSEC (c3 THENC RATOR_CONV (ONCE_DEPTH_CONV BETA_CONV THENC RAND_CONV conv) THENC conv)) tm in REWR_CONV IMAGE_EQ_NTRIE_IMAGE THENC (ONCE_DEPTH_CONV BETA_CONV) THENC conv;; (* ------------------------------------------------------------------------- *) (* Decoding of a set in ntrie form to the usual literal representation. *) (* ------------------------------------------------------------------------- *) let NTRIE_DECODE_CONV : conv = let NTRIE_DECODE_THM = prove (`!s. NTRIE s = NTRIE_IMAGE NUMERAL {} s`, REWRITE_TAC[NTRIE; NUMERAL; NTRIE_IMAGE_DEF; UNION_EMPTY; IMAGE] THEN SET_TAC[]) and [c1;c2;c3] = map REWR_CONV (CONJUNCTS NTRIE_IMAGE) in let rec conv tm = (c1 ORELSEC (c2 THENC LAND_CONV (TRY_CONV BETA_CONV)) ORELSEC (c3 THENC RATOR_CONV (ONCE_DEPTH_CONV BETA_CONV THENC RAND_CONV conv) THENC conv)) tm in REWR_CONV NTRIE_DECODE_THM THENC conv;; (* ------------------------------------------------------------------------- *) (* Encoding of a set from the usual literal form to the ntrie form. *) (* ------------------------------------------------------------------------- *) let NTRIE_ENCODE_CONV : conv= let itm = `(INSERT):num->(num->bool)->num->bool` and th = prove (`{} = NTRIE NEMPTY`, REWRITE_TAC[NTRIE; NEMPTY]) in let cnv1 = REWR_CONV th and cnv2 cnv tm = let fn,arg = dest_comb tm in if rator fn <> itm then fail () else AP_TERM fn (cnv arg) in let rec conv tm = (cnv1 ORELSEC (cnv2 conv THENC NTRIE_INSERT_CONV)) tm in conv;; (* ------------------------------------------------------------------------- *) (* Final hack-together. *) (* ------------------------------------------------------------------------- *) let NTRIE_REL_CONV : conv = let gconv_net = itlist (uncurry net_of_conv) [`NTRIE s = NTRIE t`, NTRIE_EQ_CONV; `NTRIE s SUBSET NTRIE t`, NTRIE_SUBSET_CONV; `DISJOINT (NTRIE s) (NTRIE t)`, NTRIE_DISJOINT_CONV; `NUMERA n IN NTRIE s`, NTRIE_IN_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let NTRIE_RED_CONV : conv = let gconv_net = itlist (uncurry net_of_conv) [`NTRIE s = NTRIE t`, NTRIE_EQ_CONV; `NTRIE s SUBSET NTRIE t`, NTRIE_SUBSET_CONV; `DISJOINT (NTRIE s) (NTRIE t)`, NTRIE_DISJOINT_CONV; `NUMERA n IN NTRIE s`, NTRIE_IN_CONV; `NUMERAL n INSERT NTRIE s`, NTRIE_INSERT_CONV; `NTRIE s UNION NTRIE t`, NTRIE_UNION_CONV; `NTRIE s INTER NTRIE t`, NTRIE_INTER_CONV; `NTRIE s DELETE NUMERAL n`, NTRIE_DELETE_CONV; `NTRIE s DIFF NTRIE t`, NTRIE_DIFF_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let NTRIE_REDUCE_CONV = DEPTH_CONV NTRIE_RED_CONV;; let NTRIE_REDUCE_TAC = CONV_TAC NTRIE_REDUCE_CONV;; let NTRIE_COMPUTE (cnv : conv) : conv = ONCE_DEPTH_CONV NTRIE_ENCODE_CONV THENC cnv THENC ONCE_DEPTH_CONV NTRIE_DECODE_CONV;; hol-light/Ntrie/ntrie_tests.ml000066400000000000000000000231401303454263000167230ustar00rootroot00000000000000(* -*- holl -*- *) (* ========================================================================= *) (* Conversions for ntries. *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* NTRIE_IN_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_IN_CONV `2 IN NTRIE NEMPTY`;; NTRIE_IN_CONV `0 IN NTRIE NZERO`;; NTRIE_IN_CONV `0 IN NTRIE (NNODE NZERO NZERO)`;; NTRIE_IN_CONV `0 IN NTRIE (NNODE NZERO NZERO)`;; NTRIE_IN_CONV `1 IN NTRIE NZERO`;; NTRIE_IN_CONV `1 IN NTRIE (NNODE NEMPTY NZERO)`;; NTRIE_IN_CONV `1 IN NTRIE (NNODE NZERO NEMPTY)`;; NTRIE_IN_CONV `1 IN NTRIE (NNODE NZERO NZERO)`;; NTRIE_IN_CONV `2 IN NTRIE (NNODE NZERO NZERO)`;; NTRIE_IN_CONV `3 IN NTRIE (NNODE NZERO NZERO)`;; (* ------------------------------------------------------------------------- *) (* NTRIE_EQ_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_EQ_CONV `NTRIE NEMPTY = NTRIE NZERO`;; NTRIE_EQ_CONV `NTRIE NZERO = NTRIE NZERO`;; NTRIE_EQ_CONV `NTRIE (NNODE NZERO NEMPTY) = NTRIE NZERO`;; NTRIE_EQ_CONV `NTRIE (NNODE NEMPTY NZERO) = NTRIE NZERO`;; NTRIE_EQ_CONV `NTRIE (NNODE NZERO NEMPTY) = NTRIE (NNODE NZERO NZERO)`;; NTRIE_EQ_CONV `NTRIE (NNODE NEMPTY NZERO) = NTRIE (NNODE NZERO NZERO)`;; NTRIE_EQ_CONV `NTRIE (NNODE NEMPTY NEMPTY) = NTRIE NEMPTY`;; (* ------------------------------------------------------------------------- *) (* NTRIE_SUBSET_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_SUBSET_CONV `NTRIE NZERO SUBSET NTRIE NEMPTY`;; NTRIE_SUBSET_CONV `NTRIE NEMPTY SUBSET NTRIE NZERO`;; NTRIE_SUBSET_CONV `NTRIE (NNODE NZERO NEMPTY) SUBSET NTRIE (NNODE NZERO NZERO)`;; NTRIE_SUBSET_CONV `NTRIE (NNODE NEMPTY NZERO) SUBSET NTRIE (NNODE NZERO NZERO)`;; (* ------------------------------------------------------------------------- *) (* NTRIE_DISJOINT_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_DISJOINT_CONV `DISJOINT (NTRIE NEMPTY) (NTRIE NEMPTY)`;; NTRIE_DISJOINT_CONV `DISJOINT (NTRIE (NNODE NEMPTY NZERO)) (NTRIE (NNODE NZERO NEMPTY))`;; NTRIE_DISJOINT_CONV `DISJOINT (NTRIE (NNODE NEMPTY NZERO)) (NTRIE (NNODE NEMPTY NZERO))`;; (* ------------------------------------------------------------------------- *) (* NTRIE_SING_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_SING_CONV `{10}`;; NTRIE_SING_CONV `{1000}`;; NTRIE_SING_CONV `{100000}`;; (* ------------------------------------------------------------------------- *) (* NTRIE_INSERT_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_INSERT_CONV `2 INSERT NTRIE NEMPTY`;; NTRIE_INSERT_CONV `0 INSERT NTRIE NZERO`;; NTRIE_INSERT_CONV `NUMERAL (BIT1 _0) INSERT NTRIE NZERO`;; NTRIE_INSERT_CONV `NUMERAL (BIT0 _0) INSERT NTRIE (NNODE NZERO NZERO)`;; NTRIE_INSERT_CONV `NUMERAL _0 INSERT NTRIE (NNODE NZERO NZERO)`;; NTRIE_INSERT_CONV `NUMERAL (BIT1 _0) INSERT NTRIE (NNODE NZERO NZERO)`;; NTRIE_INSERT_CONV `NUMERAL (BIT0 _0) INSERT NTRIE NZERO`;; NTRIE_INSERT_CONV `NUMERAL (BIT0 (BIT1 (BIT1 _0))) INSERT NTRIE NZERO`;; (* ------------------------------------------------------------------------- *) (* NTRIE_UNION_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_UNION_CONV `NTRIE NEMPTY UNION NTRIE NEMPTY`;; NTRIE_UNION_CONV `NTRIE NEMPTY UNION NTRIE NZERO`;; NTRIE_UNION_CONV `NTRIE (NNODE NZERO NZERO) UNION NTRIE NZERO`;; NTRIE_UNION_CONV `NTRIE (NNODE NEMPTY NZERO) UNION NTRIE NZERO`;; NTRIE_UNION_CONV `NTRIE (NNODE NZERO NEMPTY) UNION NTRIE NZERO`;; (* ------------------------------------------------------------------------- *) (* NTRIE_INTER_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_INTER_CONV `NTRIE NEMPTY INTER NTRIE NEMPTY`;; NTRIE_INTER_CONV `NTRIE NEMPTY INTER NTRIE NZERO`;; NTRIE_INTER_CONV `NTRIE (NNODE NZERO NZERO) INTER NTRIE NZERO`;; NTRIE_INTER_CONV `NTRIE (NNODE NEMPTY NZERO) INTER NTRIE NZERO`;; NTRIE_INTER_CONV `NTRIE (NNODE NZERO NEMPTY) INTER NTRIE NZERO`;; NTRIE_INTER_CONV `NTRIE (NNODE NEMPTY NEMPTY) INTER NTRIE (NNODE NEMPTY NEMPTY)`;; (* ------------------------------------------------------------------------- *) (* NTRIE_DELETE_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_DELETE_CONV `NTRIE NEMPTY DELETE 0`;; NTRIE_DELETE_CONV `NTRIE NZERO DELETE 0`;; NTRIE_DELETE_CONV `NTRIE (NNODE NZERO NEMPTY) DELETE 0`;; NTRIE_DELETE_CONV `NTRIE (NNODE NEMPTY NZERO) DELETE 0`;; NTRIE_DELETE_CONV `NTRIE (NNODE NEMPTY NZERO) DELETE 1`;; NTRIE_DELETE_CONV `NTRIE (NNODE NZERO NEMPTY) DELETE 1`;; (* ------------------------------------------------------------------------- *) (* NTRIE_DIFF_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_DIFF_CONV `NTRIE NEMPTY DIFF NTRIE NZERO`;; NTRIE_DIFF_CONV `NTRIE NZERO DIFF NTRIE NZERO`;; NTRIE_DIFF_CONV `NTRIE (NNODE NZERO NEMPTY) DIFF NTRIE (NNODE NZERO NEMPTY)`;; NTRIE_DIFF_CONV `NTRIE (NNODE NEMPTY NZERO) DIFF NTRIE (NNODE NZERO NEMPTY)`;; NTRIE_DIFF_CONV `NTRIE (NNODE NZERO NZERO) DIFF NTRIE (NNODE NEMPTY NZERO)`;; NTRIE_DIFF_CONV `NTRIE (NNODE NZERO NZERO) DIFF NTRIE (NNODE NZERO NEMPTY)`;; (* ------------------------------------------------------------------------- *) (* NTRIE_IMAGE_CONV *) (* ------------------------------------------------------------------------- *) NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE NEMPTY)`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE NZERO)`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NZERO NEMPTY))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NZERO NZERO))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NEMPTY NZERO))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NEMPTY NEMPTY))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE (NNODE NEMPTY NZERO) NEMPTY))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE NEMPTY)`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE NZERO)`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NZERO NEMPTY))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NZERO NZERO))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NEMPTY NZERO))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NEMPTY NEMPTY))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE (NNODE NEMPTY NZERO) NEMPTY))`;; NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NEMPTY (NNODE NEMPTY NZERO)))`;; (* ------------------------------------------------------------------------- *) (* NTRIE_DECODE *) (* ------------------------------------------------------------------------- *) NTRIE_DECODE_CONV `NTRIE NEMPTY`;; NTRIE_DECODE_CONV `NTRIE NZERO`;; NTRIE_DECODE_CONV `NTRIE (NNODE NZERO NEMPTY)`;; NTRIE_DECODE_CONV `NTRIE (NNODE NZERO NZERO)`;; NTRIE_DECODE_CONV `NTRIE (NNODE NEMPTY NZERO)`;; NTRIE_DECODE_CONV `NTRIE (NNODE NEMPTY NEMPTY)`;; NTRIE_DECODE_CONV `NTRIE (NNODE (NNODE NEMPTY NZERO) NEMPTY)`;; (* ------------------------------------------------------------------------- *) (* NTRIE_ENCODE *) (* ------------------------------------------------------------------------- *) NTRIE_ENCODE_CONV `{}:num->bool`;; NTRIE_ENCODE_CONV `{1,2,3}`;; ONCE_DEPTH_CONV NTRIE_ENCODE_CONV `{1,2,3} UNION {3,4,5}`;; (* ------------------------------------------------------------------------- *) (* Final hack-together. *) (* ------------------------------------------------------------------------- *) NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} UNION ({3,4} UNION {6,7} UNION {1,7})`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} INTER ({3,4} UNION {6,7} UNION {1,7})`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} DIFF ({3,4} UNION {6,7} UNION {1,7})`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} DIFF ({3,4} UNION {6,7} INTER {1,7})`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `3 IN {1,2,3} INTER ({3,4} UNION {6,7} UNION {1,7})`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `11 IN {1,2,3} INTER ({3,4} UNION {6,7} UNION {1,7})`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} = {3,2,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} = {3,2,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} = {3,2,1,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} DELETE 2 = {3,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} SUBSET {3,2,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,7} SUBSET {3,2,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} SUBSET {3,2,1,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} PSUBSET {3,2,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} PSUBSET {3,2,0,5}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `DISJOINT {12,3,2,1} {3,2,7,9}`;; NTRIE_COMPUTE NTRIE_REDUCE_CONV `DISJOINT {12,3,1} {2,7,9}`;; hol-light/Permutation/000077500000000000000000000000001303454263000152545ustar00rootroot00000000000000hol-light/Permutation/DOC.txt000066400000000000000000000115171303454263000164270ustar00rootroot00000000000000 THEORY OF PERMUTATIONS ON LISTS (c) Marco Maggesi , 2005-2007 Distributed with HOL Light under same license terms The present library provides a simple theory about permutations on lists. Some theorems and definition provided by this contribution are listed below. Changes (since version distributed with HOL-Light 2.20) ======================================================= - An implementation of the Quick Sort algorithm (file qsort.ml). - Some new useful theorems (e.g., LIST_UNIQ_COUNT PERMUTED_COUNT PERMUTATION_COUNT). - Several proofs have been rewritten in a clearer/faster. - Removed (but kept in legacy.ml for now) several theorems falling in one or more of the following categories: * boring trivialities, * intermediate lemmas used only to prove stronger results, * things that were supposed to be useful but have not been actually used, * other unfortunate/unloved/misspelled stuff. Some theorems proved in this library ==================================== Additional definitions about lists ---------------------------------- DELETE1 |- (!x. DELETE1 x [] = []) /\ (!x h t. DELETE1 x (h :: t) = (if x = h then t else h :: DELETE1 x t)) COUNT |- (!x. COUNT x [] = 0) /\ (!x h t. COUNT x (h :: t) = (if x = h then SUC (COUNT x t) else COUNT x t)) LIST_UNIQ |- LIST_UNIQ [] /\ (!x. LIST_UNIQ [x]) /\ (!x xs. LIST_UNIQ (x :: xs) <=> ~MEM x xs /\ LIST_UNIQ xs) Definition of permuted lists ---------------------------- let PERMUTED_RULES, PERMUTED_INDUCT, PERMUTED_CASES = new_inductive_definition `[] PERMUTED [] /\ (!h t1 t2. t1 PERMUTED t2 ==> h :: t1 PERMUTED h :: t2) /\ (!l1 l2 l3. l1 PERMUTED l2 /\ l2 PERMUTED l3 ==> l1 PERMUTED l3) /\ (!x y t. x :: y :: t PERMUTED y :: x :: t)`;; Some theorems about permuted lists ---------------------------------- PERMUTED_RFL |- !l. l PERMUTED l PERMUTED_SYM |- !xs l2. xs PERMUTED l2 <=> l2 PERMUTED xs PERMUTED_TRS |- !xs l2 l3. xs PERMUTED l2 /\ l2 PERMUTED l3 ==> xs PERMUTED l3 PERMUTED_NIL_EQ_NIL |- (!l. [] PERMUTED l <=> l = []) /\ (!l. l PERMUTED [] <=> l = []) PERMUTED_MAP |- !f l1 l2. l1 PERMUTED l2 ==> MAP f l1 PERMUTED MAP f l2 PERMUTED_LENGTH |- !l1 l2. l1 PERMUTED l2 ==> LENGTH l1 = LENGTH l2 PERMUTED_MEM |- !a l1 l2. l1 PERMUTED l2 ==> (MEM a l1 <=> MEM a l2) PERMUTED_SWAP_HEAD |- !a b l. a :: b :: l PERMUTED b :: a :: l PERMUTED_CONS_DELETE1 |- !a l. MEM a l ==> l PERMUTED a :: DELETE1 a l PERMUTED_DELETE1 |- (!h t l. h :: t PERMUTED l <=> MEM h l /\ t PERMUTED DELETE1 h l) /\ (!h t l. l PERMUTED h :: t <=> MEM h l /\ DELETE1 h l PERMUTED t) PERMUTED_COUNT |- !l1 l2. l1 PERMUTED l2 <=> (!x. COUNT x l1 = COUNT x l2) PERMUTED_TAIL |- !h t1 t2. h :: t1 PERMUTED h :: t2 <=> t1 PERMUTED t2 PERMUTED_LIST_UNIQ |- !xs ys. xs PERMUTED ys ==> (LIST_UNIQ xs <=> LIST_UNIQ ys) PERMUTED_ALL |- !P xs ys. xs PERMUTED ys ==> (ALL P xs <=> ALL P ys) Definition of permutation ------------------------- REVPERM |- REVPERM 0 = [] /\ REVPERM (SUC n) = n :: REVPERM n PERMUTATION |- !l. PERMUTATION l <=> REVPERM (LENGTH l) PERMUTED l Theorems about finite permutations ---------------------------------- PERMUTATION_NIL |- PERMUTATION [] PERMUTATION_LIST_UNIQ |- !l. PERMUTATION l ==> LIST_UNIQ l PERMUTATION_MEM |- !l. PERMUTATION l ==> (!i. MEM i l <=> i < LENGTH l) PERMUTATION_COUNT |- !l. PERMUTATION l <=> (!x. COUNT x l = (if x set_of_list l = {n | n < LENGTH l} MEM_PERMUTATION |- !l. (!n. n < LENGTH l ==> MEM n l) ==> PERMUTATION l PERMUTATION_UNIQ_LT |- !l. PERMUTATION l <=> LIST_UNIQ l /\ (!n. MEM n l ==> n < LENGTH l) Quick sort ---------- QSORT |- (!le. QSORT le [] = []) /\ (!le h t. QSORT le (h :: t) = APPEND (QSORT le (FILTER (\x. ~le h x) t)) (h :: QSORT le (FILTER (\x. le h x) t))) COUNT_QSORT |- !le x l. COUNT x (QSORT le l) = COUNT x l QSORT_PERMUTED |- !le l. QSORT le l PERMUTED l ALL_QSORT |- !P le l. ALL P (QSORT le l) <=> ALL P l LENGTH_QSORT |- !le l. LENGTH (QSORT le l) = LENGTH l MEM_QSORT |- !le l x. MEM x (QSORT le l) <=> MEM x l ORDERED_QSORT |- !le l. (!x y. le x y \/ le y x) /\ (!x y z. le x y \/ le y z ==> le x z) ==> ORDERED le (QSORT le l) hol-light/Permutation/make.ml000066400000000000000000000015311303454263000165230ustar00rootroot00000000000000(* ========================================================================= *) (* Permuted lists, finite permutations and quick sort. *) (* *) (* Author: Marco Maggesi *) (* University of Florence, Italy *) (* http://www.math.unifi.it/~maggesi/ *) (* *) (* (c) Copyright, Marco Maggesi, 2005-2007 *) (* ========================================================================= *) loadt "Permutation/morelist.ml";; loadt "Permutation/permuted.ml";; loadt "Permutation/permutation.ml";; loadt "Permutation/qsort.ml";; hol-light/Permutation/morelist.ml000066400000000000000000000253121303454263000174470ustar00rootroot00000000000000(* ========================================================================= *) (* More definitions and theorems and tactics about lists. *) (* *) (* Author: Marco Maggesi *) (* University of Florence, Italy *) (* http://www.math.unifi.it/~maggesi/ *) (* *) (* (c) Copyright, Marco Maggesi, 2005-2007 *) (* ========================================================================= *) parse_as_infix ("::",(23,"right"));; override_interface("::",`CONS`);; (* ------------------------------------------------------------------------- *) (* Some handy tactics. *) (* ------------------------------------------------------------------------- *) let ASSERT_TAC tm = SUBGOAL_THEN tm ASSUME_TAC;; let SUFFICE_TAC thl tm = SUBGOAL_THEN tm (fun th -> MESON_TAC (th :: thl));; let LIST_CASES_TAC = let th = prove (`!P. P [] /\ (!h t. P (h :: t)) ==> !l. P l`, GEN_TAC THEN STRIP_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC []) in MATCH_MP_TAC th THEN CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN GEN_TAC];; (* ------------------------------------------------------------------------- *) (* Occasionally useful stuff. *) (* ------------------------------------------------------------------------- *) let NULL_EQ_NIL = prove (`!l. NULL l <=> l = []`, LIST_CASES_TAC THEN REWRITE_TAC [NULL; NOT_CONS_NIL]);; let NULL_LENGTH = prove (`!l. NULL l <=> LENGTH l = 0`, LIST_CASES_TAC THEN REWRITE_TAC [NULL; LENGTH; NOT_SUC]);; let LENGTH_FILTER_LE = prove (`!f l:A list. LENGTH (FILTER f l) <= LENGTH l`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [FILTER; LENGTH; LE_0] THEN COND_CASES_TAC THEN ASM_SIMP_TAC [LENGTH; LE_SUC; ARITH_RULE `n<=m ==> n<= SUC m`]);; (* ------------------------------------------------------------------------- *) (* Well-founded induction on lists. *) (* ------------------------------------------------------------------------- *) let list_WF = prove (`!P. (!l. (!l'. LENGTH l' < LENGTH l ==> P l') ==> P l) ==> (!l:A list. P l)`, MP_TAC (ISPEC `LENGTH:A list->num` WF_MEASURE) THEN REWRITE_TAC [WF_IND; MEASURE]);; (* ------------------------------------------------------------------------- *) (* Delete one element from a list. *) (* ------------------------------------------------------------------------- *) let DELETE1 = define `(!x. DELETE1 x [] = []) /\ (!x h t. DELETE1 x (h :: t) = if x = h then t else h :: DELETE1 x t)`;; let DELETE1_ID = prove (`!x l. ~MEM x l ==> DELETE1 x l = l`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [NOT_CONS_NIL; CONS_11]);; let DELETE1_APPEND = prove (`!x l1 l2. DELETE1 x (APPEND l1 l2) = if MEM x l1 then APPEND (DELETE1 x l1) l2 else APPEND l1 (DELETE1 x l2)`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND; DELETE1; MEM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MEM; APPEND] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; let FILTER_DELETE1 = prove (`!P x l. FILTER P (DELETE1 x l) = if P x then DELETE1 x (FILTER P l) else FILTER P l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REPEAT (REWRITE_TAC [DELETE1; FILTER] THEN COND_CASES_TAC) THEN ASM_MESON_TAC []);; let LENGTH_DELETE1 = prove (`!l x:A. LENGTH (DELETE1 x l) = if MEM x l then PRE (LENGTH l) else LENGTH l`, LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; LENGTH; DELETE1] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[PRE; LENGTH] THEN COND_CASES_TAC THEN REWRITE_TAC [ARITH_RULE `SUC (PRE n)=n <=> ~(n=0)`; LENGTH_EQ_NIL] THEN ASM_MESON_TAC [MEM]);; let MEM_DELETE1_MEM_IMP = prove (`!h t x. MEM x (DELETE1 h t) ==> MEM x t`, GEN_TAC THEN LIST_INDUCT_TAC THEN GEN_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN COND_CASES_TAC THEN REWRITE_TAC [MEM] THEN STRIP_TAC THEN ASM_SIMP_TAC []);; let NOT_MEM_DELETE1 = prove (`!t h x. ~MEM x t ==> ~MEM x (DELETE1 h t)`, LIST_INDUCT_TAC THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN COND_CASES_TAC THEN REWRITE_TAC [MEM; DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC []);; let MEM_DELETE1 = prove (`!l x y:A. MEM x l /\ ~(x = y) ==> MEM x (DELETE1 y l)`, LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN GEN_TAC THEN GEN_TAC THEN COND_CASES_TAC THENL [EXPAND_TAC "h" THEN MESON_TAC []; REWRITE_TAC [MEM] THEN ASM_MESON_TAC []]);; let ALL_DELETE1_ALL_IMP = prove (`!P x l. P x /\ ALL P (DELETE1 x l) ==> ALL P l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL; DELETE1] THEN COND_CASES_TAC THEN ASM_SIMP_TAC [ALL]);; (* ------------------------------------------------------------------------- *) (* Counting occurrences of a given element in a list. *) (* ------------------------------------------------------------------------- *) let COUNT = define `(!x. COUNT x [] = 0) /\ (!x h t. COUNT x (CONS h t) = if x=h then SUC (COUNT x t) else COUNT x t)`;; let COUNT_LENGTH_FILTER = prove (`!x l. COUNT x l = LENGTH (FILTER ((=) x) l)`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [COUNT; FILTER; LENGTH] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [LENGTH]);; let COUNT_FILTER = prove (`!P x l. COUNT x (FILTER P l) = if P x then COUNT x l else 0`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REPEAT (ASM_REWRITE_TAC [COUNT; FILTER] THEN COND_CASES_TAC) THEN ASM_MESON_TAC []);; let COUNT_APPEND = prove (`!x l1 l2. COUNT x (APPEND l1 l2) = COUNT x l1 + COUNT x l2`, REWRITE_TAC [COUNT_LENGTH_FILTER; LENGTH_APPEND; FILTER_APPEND]);; let COUNT_LE_LENGTH = prove (`!x l. COUNT x l <= LENGTH l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [COUNT; LENGTH; LE_REFL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC [LE_SUC; ARITH_RULE `n<=m ==> n <= SUC m`]);; let COUNT_ZERO = prove (`!x l. COUNT x l = 0 <=> ~MEM x l`, GEN_TAC THEN REWRITE_TAC [COUNT_LENGTH_FILTER; LENGTH_EQ_NIL] THEN LIST_INDUCT_TAC THEN REWRITE_TAC [FILTER; MEM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [NOT_CONS_NIL]);; let MEM_COUNT = prove (`!x l. MEM x l <=> ~(COUNT x l = 0)`, MESON_TAC [COUNT_ZERO]);; let COUNT_DELETE1 = prove (`!y x l. COUNT y (DELETE1 (x:A) l) = if y=x /\ MEM x l then PRE (COUNT y l) else COUNT y l`, REWRITE_TAC [COUNT_LENGTH_FILTER; FILTER_DELETE1] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MEM_FILTER; LENGTH_DELETE1]);; (* ------------------------------------------------------------------------- *) (* Duplicates in a list. *) (* ------------------------------------------------------------------------- *) let LIST_UNIQ_RULES, LIST_UNIQ_INDUCT, LIST_UNIQ_CASES = new_inductive_definition `LIST_UNIQ [] /\ (!x xs. LIST_UNIQ xs /\ ~MEM x xs ==> LIST_UNIQ (x :: xs))`;; let LIST_UNIQ = prove (`LIST_UNIQ [] /\ (!x. LIST_UNIQ [x]) /\ (!x xs. LIST_UNIQ (x :: xs) <=> ~MEM x xs /\ LIST_UNIQ xs)`, SIMP_TAC [LIST_UNIQ_RULES; MEM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [ONCE_REWRITE_TAC [ISPEC `h :: t` LIST_UNIQ_CASES] THEN REWRITE_TAC [CONS_11; NOT_CONS_NIL] THEN DISCH_THEN (CHOOSE_THEN CHOOSE_TAC) THEN ASM_REWRITE_TAC []; SIMP_TAC [LIST_UNIQ_RULES]]);; let LIST_UNIQ_EQ_PAIRWISE_DISTINCT = prove (`LIST_UNIQ = PAIRWISE (\x y. ~(x = y))`, REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC list_INDUCT THEN ASM_REWRITE_TAC[LIST_UNIQ; PAIRWISE] THEN SIMP_TAC[GSYM ALL_MEM] THEN MESON_TAC[]);; (* !!! forse e' meglio con IMP? *) (* Magari LIST_UNIQ_COUNT + COUNT_LIST_UNIQ *) let LIST_UNIQ_COUNT = prove (`!l. LIST_UNIQ l <=> (!x:A. COUNT x l = if MEM x l then 1 else 0)`, let IFF_EXPAND = MESON [] `(p <=> q) <=> (p ==> q) /\ (q ==> p)` in REWRITE_TAC [IFF_EXPAND; FORALL_AND_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC LIST_UNIQ_INDUCT THEN REWRITE_TAC [COUNT; MEM] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ONE]; LIST_INDUCT_TAC THEN REWRITE_TAC [LIST_UNIQ; COUNT; MEM] THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `h:A`) THEN SIMP_TAC [MEM_COUNT; ONE; SUC_INJ] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `x:A`) THEN REWRITE_TAC [MEM_COUNT] THEN ARITH_TAC]);; let LIST_UNIQ_DELETE1 = prove (`!l x. LIST_UNIQ l ==> LIST_UNIQ (DELETE1 x l)`, LIST_INDUCT_TAC THEN GEN_TAC THEN REWRITE_TAC [LIST_UNIQ; DELETE1] THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC [LIST_UNIQ; NOT_MEM_DELETE1]);; let DELETE1_LIST_UNIQ = prove (`!l x:A. ~MEM x (DELETE1 x l) /\ LIST_UNIQ (DELETE1 x l) ==> LIST_UNIQ l`, LIST_INDUCT_TAC THEN REWRITE_TAC [LIST_UNIQ; DELETE1; MEM] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [MEM; LIST_UNIQ] THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC [MEM_DELETE1]; FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC []]);; let LIST_UNIQ_APPEND = prove (`!l m. LIST_UNIQ (APPEND l m) <=> LIST_UNIQ l /\ LIST_UNIQ m /\ !x. ~(MEM x l /\ MEM x m)`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; LIST_UNIQ; MEM; MEM_APPEND] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Lists and finite sets. *) (* ------------------------------------------------------------------------- *) let CARD_LENGTH = prove (`!l:A list. CARD (set_of_list l) <= LENGTH l`, LIST_INDUCT_TAC THEN SIMP_TAC [set_of_list; CARD_CLAUSES; LENGTH; FINITE_SET_OF_LIST; ARITH] THEN COND_CASES_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `LENGTH (t:A list)` THEN ASM_REWRITE_TAC [] THEN ARITH_TAC; ASM_REWRITE_TAC [LE_SUC]]);; let LIST_UNIQ_CARD_LENGTH = prove (`!l:A list. LIST_UNIQ l <=> CARD (set_of_list l) = LENGTH l`, LIST_INDUCT_TAC THEN SIMP_TAC [LIST_UNIQ; set_of_list; FINITE_SET_OF_LIST; LENGTH; CARD_CLAUSES; IN_SET_OF_LIST] THEN FIRST_X_ASSUM SUBST1_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SUC_INJ] THEN MP_TAC (SPEC `t:A list` CARD_LENGTH) THEN ARITH_TAC);; let LIST_UNIQ_LIST_OF_SET = prove (`!s. FINITE s ==> LIST_UNIQ(list_of_set s)`, SIMP_TAC[LIST_UNIQ_CARD_LENGTH; SET_OF_LIST_OF_SET; LENGTH_LIST_OF_SET]);; hol-light/Permutation/nummax.ml000066400000000000000000000070171303454263000171200ustar00rootroot00000000000000(* ========================================================================= *) (* Maximum of two nums and of a list of nums. *) (* *) (* Author: Marco Maggesi *) (* University of Florence, Italy *) (* http://www.math.unifi.it/~maggesi/ *) (* *) (* (c) Copyright, Marco Maggesi, 2005-2007 *) (* ========================================================================= *) needs "Permutation/morelist.ml";; (* ------------------------------------------------------------------------- *) (* Maximum of two nums. *) (* ------------------------------------------------------------------------- *) let MAX_LT = prove (`!m n p. MAX m n < p <=> m < p /\ n < p`, REWRITE_TAC [MAX] THEN ARITH_TAC);; let MAX_LE = prove (`!m n p. MAX m n <= p <=> m <= p /\ n <= p`, REWRITE_TAC [MAX] THEN ARITH_TAC);; let LT_MAX = prove (`!m n p. p < MAX m n <=> p < m \/ p < n`, REWRITE_TAC [MAX] THEN ARITH_TAC);; let LE_MAX = prove (`!m n p. p <= MAX m n <=> p <= m \/ p <= n`, REWRITE_TAC [MAX] THEN ARITH_TAC);; let MAX_SYM = prove (`!m n. MAX n m = MAX m n`, MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [EQ_TAC THEN SIMP_TAC []; SIMP_TAC [MAX] THEN ARITH_TAC]);; let MAX_ASSOC = prove (`!m n p. MAX (MAX m n) p = MAX m (MAX n p)`, REPEAT GEN_TAC THEN REWRITE_TAC [MAX] THEN ASM_CASES_TAC `m <= n` THEN ASM_REWRITE_TAC [] THEN ASM_CASES_TAC `n <= p` THEN ASM_REWRITE_TAC [] THENL [SUBGOAL_THEN `m <= p` (fun th -> REWRITE_TAC [th]) THEN MATCH_MP_TAC LE_TRANS THEN ASM_MESON_TAC []; SUBGOAL_THEN `~(m <= p)` (fun th -> REWRITE_TAC [th]) THEN FIRST_X_ASSUM MP_TAC THEN FIRST_X_ASSUM MP_TAC THEN ARITH_TAC]);; let MAX_ACI = prove (`(!m n. MAX n m = MAX m n) /\ (!m n p. MAX (MAX m n) p = MAX m (MAX n p)) /\ (!m n p. MAX m (MAX n p) = MAX n (MAX m p)) /\ (!m. MAX m m = m) /\ (!m n. MAX m (MAX m n) = MAX m n)`, SUBGOAL_THEN `!n. MAX n n = n` ASSUME_TAC THENL [REWRITE_TAC [MAX] THEN ARITH_TAC; ASM_MESON_TAC [MAX_SYM; MAX_ASSOC]]);; let MAX_0 = prove (`(!n. MAX n 0 = n) /\ (!n. MAX 0 n = n)`, REWRITE_TAC [MAX_SYM] THEN REWRITE_TAC [MAX] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Maximum of a list of nums. *) (* ------------------------------------------------------------------------- *) let MAXL = define `MAXL [] = 0 /\ (!h t. MAXL (CONS h t) = MAX h (MAXL t))`;; let MAXL_LE = prove (`!l n. MAXL l <= n <=> ALL (\m. m <= n) l`, LIST_INDUCT_TAC THEN REWRITE_TAC [ALL; MAXL; LE_0] THEN ASM_SIMP_TAC [MAX_LE]);; let LT_MAXL = prove (`!l n. n < MAXL l <=> EX (\m. n < m) l`, LIST_INDUCT_TAC THEN ASM_SIMP_TAC [EX; MAXL; NOT_LT; LE_0; LT_MAX]);; let LE_MAXL = prove (`!n l. MEM n l ==> n <= MAXL l`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; MAXL] THEN STRIP_TAC THEN ASM_SIMP_TAC [LE_REFL; LE_MAX]);; let MEM_MAXL = prove (`!l. ~NULL l ==> MEM (MAXL l) l`, REWRITE_TAC [NULL_EQ_NIL] THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; MAXL; NOT_CONS_NIL] THEN ASM_CASES_TAC `t:num list=[]` THEN ASM_REWRITE_TAC[MAXL; MAX_0] THEN ASM_MESON_TAC [MAX]);; hol-light/Permutation/permutation.ml000066400000000000000000000115321303454263000201570ustar00rootroot00000000000000(* ========================================================================= *) (* Permuted lists and finite permutations. *) (* *) (* Author: Marco Maggesi *) (* University of Florence, Italy *) (* http://www.math.unifi.it/~maggesi/ *) (* *) (* (c) Copyright, Marco Maggesi, 2005-2007 *) (* ========================================================================= *) needs "Permutation/permuted.ml";; (* ------------------------------------------------------------------------- *) (* Permutation that reverse a list. *) (* ------------------------------------------------------------------------- *) let REVPERM = define `REVPERM 0 = [] /\ REVPERM (SUC n) = n :: REVPERM n`;; let MEM_REVPERM = prove (`!n m. MEM m (REVPERM n) <=> m < n`, INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; MEM; LT]);; let LIST_UNIQ_REVPERM = prove (`!n. LIST_UNIQ (REVPERM n)`, INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; LIST_UNIQ; MEM_REVPERM] THEN ARITH_TAC);; let DELETE1_REVPERM = prove (`!n. DELETE1 n (REVPERM (SUC n)) = REVPERM n`, INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; DELETE1; MEM]);; let COUNT_REVPERM = prove (`!n i. COUNT i (REVPERM n) = if i < n then 1 else 0`, INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; COUNT] THEN ARITH_TAC);; let SET_OF_LIST_REVPERM = prove (`!n. set_of_list (REVPERM n) = {m | m < n}`, INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; set_of_list; LT; EMPTY_GSPEC; EXTENSION; IN_INSERT; IN_ELIM_THM; NOT_IN_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Permutations. *) (* ------------------------------------------------------------------------- *) let PERMUTATION = new_definition `!l. PERMUTATION l <=> REVPERM (LENGTH l) PERMUTED l`;; let PERMUTATION_NIL = prove (`PERMUTATION []`, REWRITE_TAC [PERMUTATION; LENGTH; REVPERM; PERMUTED_RULES]);; let PERMUTATION_LIST_UNIQ = prove (`!l. PERMUTATION l ==> LIST_UNIQ l`, MESON_TAC [PERMUTATION; PERMUTED_LIST_UNIQ; LIST_UNIQ_REVPERM]);; let PERMUTATION_MEM = prove (`!l. PERMUTATION l ==> (!i. MEM i l <=> i < LENGTH l)`, REWRITE_TAC [PERMUTATION] THEN MESON_TAC [MEM_REVPERM; PERMUTED_MEM]);; let PERMUTATION_COUNT = prove (`!l. PERMUTATION l <=> (!x. COUNT x l = if x < LENGTH l then 1 else 0)`, REWRITE_TAC [PERMUTATION; PERMUTED_COUNT; COUNT_REVPERM] THEN MESON_TAC[]);; let LIST_UNIQ_PERMUTED_SET_OF_LIST = prove (`!l1 l2. LIST_UNIQ l1 /\ LIST_UNIQ l2 ==> (l1 PERMUTED l2 <=> set_of_list l1 = set_of_list l2)`, REWRITE_TAC [LIST_UNIQ_COUNT] THEN REPEAT STRIP_TAC THEN REWRITE_TAC [EXTENSION; IN_SET_OF_LIST; PERMUTED_COUNT; MEM_COUNT] THEN ASM_REWRITE_TAC [] THEN MESON_TAC []);; let PERMUTED_LENGTH_MEM = prove (`!l l':A list. LIST_UNIQ l /\ LENGTH l = LENGTH l' /\ (!x. MEM x l <=> MEM x l') ==> l PERMUTED l'`, REWRITE_TAC[GSYM IN_SET_OF_LIST; GSYM EXTENSION] THEN ASM_MESON_TAC[LIST_UNIQ_CARD_LENGTH; LIST_UNIQ_PERMUTED_SET_OF_LIST]);; let PERMUTATION_SET_OF_LIST = prove (`!l. PERMUTATION l <=> set_of_list l = {n | n < LENGTH l}`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [REWRITE_TAC [GSYM SET_OF_LIST_REVPERM] THEN ASM_MESON_TAC [LIST_UNIQ_PERMUTED_SET_OF_LIST; PERMUTATION; PERMUTED_LIST_UNIQ; LIST_UNIQ_REVPERM]; REWRITE_TAC [PERMUTATION] THEN ASSERT_TAC `LIST_UNIQ (l:num list)` THENL [REWRITE_TAC [LIST_UNIQ_CARD_LENGTH] THEN FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC [CARD_NUMSEG_LT]; ASM_SIMP_TAC [SET_OF_LIST_REVPERM; LIST_UNIQ_REVPERM; LIST_UNIQ_PERMUTED_SET_OF_LIST]]]);; let MEM_PERMUTATION = prove (`!l. (!n. n < LENGTH l ==> MEM n l) ==> PERMUTATION l`, REPEAT STRIP_TAC THEN REWRITE_TAC [PERMUTATION_SET_OF_LIST] THEN MATCH_MP_TAC (GSYM CARD_SUBSET_LE) THEN REWRITE_TAC [FINITE_SET_OF_LIST; CARD_NUMSEG_LT; CARD_LENGTH] THEN ASM_SIMP_TAC [SUBSET; IN_ELIM_THM; IN_SET_OF_LIST]);; let LIST_UNIQ_MEM_PERMUTATION = prove (`!l. LIST_UNIQ l /\ (!n. MEM n l ==> n < LENGTH l) ==> PERMUTATION l`, REWRITE_TAC [LIST_UNIQ_CARD_LENGTH; PERMUTATION_SET_OF_LIST] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_SUBSET_LE THEN ASM_REWRITE_TAC [FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM; IN_SET_OF_LIST; CARD_NUMSEG_LT; LE_REFL]);; let PERMUTATION_UNIQ_LT = prove (`!l. PERMUTATION l <=> LIST_UNIQ l /\ (!n. MEM n l ==> n < LENGTH l)`, MESON_TAC [PERMUTATION_LIST_UNIQ; PERMUTATION_MEM; LIST_UNIQ_MEM_PERMUTATION]);; hol-light/Permutation/permuted.ml000066400000000000000000000156721303454263000174460ustar00rootroot00000000000000(* ========================================================================= *) (* Permuted lists. *) (* *) (* Author: Marco Maggesi *) (* University of Florence, Italy *) (* http://www.math.unifi.it/~maggesi/ *) (* *) (* (c) Copyright, Marco Maggesi, 2005-2007 *) (* ========================================================================= *) needs "Permutation/morelist.ml";; parse_as_infix("PERMUTED",(12,"right"));; (* ------------------------------------------------------------------------- *) (* Permuted lists. *) (* ------------------------------------------------------------------------- *) let PERMUTED_RULES, PERMUTED_INDUCT, PERMUTED_CASES = new_inductive_definition `[] PERMUTED [] /\ (!h t1 t2. t1 PERMUTED t2 ==> h :: t1 PERMUTED h :: t2) /\ (!l1 l2 l3. l1 PERMUTED l2 /\ l2 PERMUTED l3 ==> l1 PERMUTED l3) /\ (!x y t. x :: y :: t PERMUTED y :: x :: t)`;; let PERMUTED_INDUCT_STRONG = derive_strong_induction(PERMUTED_RULES,PERMUTED_INDUCT);; let PERMUTED_RFL = prove (`!l. l PERMUTED l`, LIST_INDUCT_TAC THEN ASM_SIMP_TAC [PERMUTED_RULES]);; let PERMUTED_SYM = prove (`!(xs:A list) l2. xs PERMUTED l2 <=> l2 PERMUTED xs`, SUFFICE_TAC [] `!(xs:A list) l2. xs PERMUTED l2 ==> l2 PERMUTED xs` THEN MATCH_MP_TAC PERMUTED_INDUCT THEN ASM_MESON_TAC [PERMUTED_RULES]);; let PERMUTED_TRS = prove (`!xs l2 l3. xs PERMUTED l2 /\ l2 PERMUTED l3 ==> xs PERMUTED l3`, MESON_TAC [PERMUTED_RULES]);; let PERMUTED_TRS_TAC tm : tactic = MATCH_MP_TAC PERMUTED_TRS THEN EXISTS_TAC tm THEN CONJ_TAC ;; let PERMUTED_TAIL_IMP = prove (`!h t1 t2. t1 PERMUTED t2 ==> h :: t1 PERMUTED h :: t2`, SIMP_TAC [PERMUTED_RULES]);; let PERMUTED_MAP = prove (`!f l1 l2. l1 PERMUTED l2 ==> MAP f l1 PERMUTED MAP f l2`, GEN_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT THEN REWRITE_TAC [MAP; PERMUTED_RULES]);; let PERMUTED_LENGTH = prove (`!l1 l2. l1 PERMUTED l2 ==> LENGTH l1 = LENGTH l2`, MATCH_MP_TAC PERMUTED_INDUCT THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [LENGTH]);; let PERMUTED_SWAP_HEAD = prove (`!a b l. a :: b :: l PERMUTED b :: a :: l`, REWRITE_TAC [PERMUTED_RULES]);; let PERMUTED_MEM = prove (`!(a:A) l1 l2. l1 PERMUTED l2 ==> (MEM a l1 <=> MEM a l2)`, GEN_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT THEN REWRITE_TAC [MEM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);; let PERMUTED_ALL = prove (`!P xs ys. xs PERMUTED ys ==> (ALL P xs <=> ALL P ys)`, GEN_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT THEN REWRITE_TAC [ALL] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN MESON_TAC[]);; let PERMUTED_NIL_EQ_NIL = prove (`(!l:A list. [] PERMUTED l <=> l = []) /\ (!l:A list. l PERMUTED [] <=> l = [])`, SUFFICE_TAC [PERMUTED_SYM] `!l:A list. [] PERMUTED l <=> l = []` THEN LIST_CASES_TAC THEN ASM_REWRITE_TAC [NOT_CONS_NIL; PERMUTED_RFL] THEN MESON_TAC [PERMUTED_LENGTH; LENGTH; NOT_SUC]);; let PERMUTED_SINGLETON = prove (`(!(x:A) l. [x] PERMUTED l <=> l = [x]) /\ (!(x:A) l. l PERMUTED [x] <=> l = [x])`, SUFFICE_TAC [PERMUTED_LENGTH; PERMUTED_RFL] `!l1 l2. l1 PERMUTED l2 ==> LENGTH l1 = LENGTH l2 /\ (!x. l1 = [x:A] <=> l2 = [x])` THEN MATCH_MP_TAC PERMUTED_INDUCT THEN SIMP_TAC [PERMUTED_NIL_EQ_NIL; LENGTH; NOT_CONS_NIL; CONS_11; SUC_INJ; GSYM LENGTH_EQ_NIL]);; let PERMUTED_CONS_DELETE1 = prove (`!(a:A) l. MEM a l ==> l PERMUTED a :: DELETE1 a l`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN COND_CASES_TAC THEN ASM_MESON_TAC [PERMUTED_RFL; PERMUTED_TAIL_IMP; PERMUTED_SWAP_HEAD; PERMUTED_TRS]);; let PERMUTED_COUNT = prove (`!l1 l2. l1 PERMUTED l2 <=> (!x:A. COUNT x l1 = COUNT x l2)`, let IFF_EXPAND = MESON [] `(p <=> q) <=> (p ==> q) /\ (q ==> p)` in REWRITE_TAC [IFF_EXPAND; FORALL_AND_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC PERMUTED_INDUCT THEN REWRITE_TAC [COUNT] THEN ASM_MESON_TAC []; ALL_TAC] THEN LIST_INDUCT_TAC THEN REWRITE_TAC [COUNT; PERMUTED_NIL_EQ_NIL] THENL [LIST_CASES_TAC THEN REWRITE_TAC [COUNT; NOT_CONS_NIL] THEN MESON_TAC [NOT_SUC]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ASSERT_TAC `MEM (h:A) l2` THENL [FIRST_X_ASSUM (MP_TAC o SPEC `h:A`) THEN REWRITE_TAC[MEM_COUNT] THEN ARITH_TAC; ALL_TAC] THEN ASSERT_TAC `(h:A) :: t PERMUTED h :: DELETE1 h l2` THENL [MATCH_MP_TAC PERMUTED_TAIL_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [COUNT_DELETE1] THEN GEN_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `x:A`) THEN ARITH_TAC; ASM_MESON_TAC [PERMUTED_CONS_DELETE1; PERMUTED_SYM; PERMUTED_TRS]]);; let PERMUTED_TAIL = prove (`!x t1 t2. x :: t1 PERMUTED x :: t2 <=> t1 PERMUTED t2`, REPEAT GEN_TAC THEN REWRITE_TAC [PERMUTED_COUNT; COUNT] THEN MESON_TAC [SUC_INJ]);; let PERMUTED_DELETE1_L = prove (`!(h:A) t l. h :: t PERMUTED l <=> MEM h l /\ t PERMUTED DELETE1 h l`, MESON_TAC [PERMUTED_MEM; MEM; PERMUTED_TAIL; PERMUTED_CONS_DELETE1; PERMUTED_SYM; PERMUTED_TRS]);; let PERMUTED_DELETE1_R = prove (`!(h:A) t l. l PERMUTED h :: t <=> MEM h l /\ DELETE1 h l PERMUTED t`, MESON_TAC [PERMUTED_SYM; PERMUTED_DELETE1_L]);; let PERMUTED_LIST_UNIQ = prove (`!xs ys. xs PERMUTED ys ==> (LIST_UNIQ xs <=> LIST_UNIQ ys)`, SIMP_TAC [PERMUTED_COUNT; LIST_UNIQ_COUNT; MEM_COUNT]);; let PERMUTED_IMP_PAIRWISE = prove (`!(P:A->A->bool) l l'. (!x y. P x y ==> P y x) /\ l PERMUTED l' /\ PAIRWISE P l ==> PAIRWISE P l'`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT_STRONG THEN ASM_SIMP_TAC[PAIRWISE; ALL] THEN MESON_TAC[PERMUTED_ALL]);; let PERMUTED_PAIRWISE = prove (`!(P:A->A->bool) l l. (!x y. P x y ==> P y x) /\ l PERMUTED l' ==> (PAIRWISE P l <=> PAIRWISE P l')`, MESON_TAC[PERMUTED_IMP_PAIRWISE; PERMUTED_SYM]);; let PERMUTED_APPEND_SWAP = prove (`!l1 l2. (APPEND l1 l2) PERMUTED (APPEND l2 l1)`, REWRITE_TAC[PERMUTED_COUNT; COUNT_APPEND] THEN ARITH_TAC);; let PERMUTED_APPEND_LCANCEL = prove (`!l1 l2 l3:A list. (APPEND l1 l2) PERMUTED (APPEND l1 l3) <=> l2 PERMUTED l3`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; PERMUTED_TAIL]);; let PERMUTED_APPEND_RCANCEL = prove (`!l1 l2 l3:A list. (APPEND l1 l3) PERMUTED (APPEND l2 l3) <=> l1 PERMUTED l2`, MESON_TAC[PERMUTED_APPEND_SWAP; PERMUTED_APPEND_LCANCEL; PERMUTED_TRS; PERMUTED_SYM]);; let PERMUTED_APPEND_CONG = prove (`!l1 l1' l2 l2'. l1 PERMUTED l1' /\ l2 PERMUTED l2' ==> (APPEND l1 l2) PERMUTED (APPEND l1' l2')`, MESON_TAC[PERMUTED_APPEND_LCANCEL; PERMUTED_APPEND_RCANCEL; PERMUTED_TRS]);; hol-light/Permutation/qsort.ml000066400000000000000000000113551303454263000167630ustar00rootroot00000000000000(* ========================================================================= *) (* Quick sort algorithm. *) (* *) (* Author: Marco Maggesi *) (* University of Florence, Italy *) (* http://www.math.unifi.it/~maggesi/ *) (* *) (* (c) Copyright, Marco Maggesi, 2005-2007 *) (* ========================================================================= *) needs "Permutation/permuted.ml";; (* ------------------------------------------------------------------------- *) (* Ordered lists. *) (* ------------------------------------------------------------------------- *) let ORDERED_RULES, ORDERED_INDUCT, ORDERED_CASES = new_inductive_definition `(!le. ORDERED le []) /\ (!le h t. ORDERED le t /\ ALL (le h) t ==> ORDERED le (CONS h t))`;; let ORDERED_CONS = prove (`!le (h:A) t. ORDERED le (h :: t) <=> (ORDERED le t /\ ALL (le h) t)`, SUBGOAL_THEN `!le (h:A) t. ORDERED le (h :: t) ==> (ORDERED le t /\ ALL (le h) t)` (fun th -> MESON_TAC [th; ORDERED_RULES]) THEN REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o ONCE_REWRITE_RULE [ORDERED_CASES]) THEN REWRITE_TAC [NOT_CONS_NIL; CONS_11] THEN MESON_TAC []);; let ORDERED_APPEND = prove (`!l1 l2:A list. ORDERED le (APPEND l1 l2) <=> ORDERED le l1 /\ ORDERED le l2 /\ ALL (\x. ALL (le x) l2) l1`, SUBGOAL_THEN `(!l1 l2:A list. ORDERED le (APPEND l1 l2) ==> ORDERED le l1 /\ ORDERED le l2 /\ ALL (\x. ALL (le x) l2) l1) /\ (!l1 l2. ORDERED le l1 /\ ORDERED le l2 /\ ALL (\x. ALL (le x) l2) l1 ==> ORDERED le (APPEND l1 l2))` (fun th -> MESON_TAC [th]) THEN CONJ_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND; ALL; ORDERED_RULES; ORDERED_CONS] THEN ASM_SIMP_TAC [ORDERED_CONS; ALL_APPEND] THEN ASM_MESON_TAC [ALL_APPEND]);; let ORDERED_PAIRWISE = prove (`ORDERED = PAIRWISE`, REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[PAIRWISE; ORDERED_RULES] THEN SIMP_TAC[ORDERED_CONS] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Quick Sort. *) (* ------------------------------------------------------------------------- *) let QSORT = let PROVE_RECURSIVE_FUNCTION_EXISTS_TAC : tactic = fun g -> let th = pure_prove_recursive_function_exists (snd g) in MATCH_MP_TAC (DISCH_ALL th) g in new_specification ["QSORT"] (prove (`?f. (!le. f le [] = [] : A list) /\ (!le h t. f le (CONS h t) = APPEND (f le (FILTER (\x. ~le h x) t)) (CONS h (f le (FILTER (\x. le h x) t))))`, REWRITE_TAC [GSYM SKOLEM_THM; AND_FORALL_THM] THEN GEN_TAC THEN PROVE_RECURSIVE_FUNCTION_EXISTS_TAC THEN EXISTS_TAC `MEASURE (LENGTH:A list -> num)` THEN REWRITE_TAC [WF_MEASURE; MEASURE; LENGTH; FILTER] THEN REWRITE_TAC [LT_SUC_LE; LENGTH_FILTER_LE]));; let COUNT_QSORT = prove (`!le x l. COUNT x (QSORT le l) = COUNT x l`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC list_WF THEN LIST_INDUCT_TAC THEN REWRITE_TAC [QSORT; COUNT; LENGTH; LT_SUC_LE; COUNT_APPEND] THEN DISCH_TAC THEN ASM_SIMP_TAC [COUNT; LENGTH_FILTER_LE] THEN REWRITE_TAC [COUNT_FILTER] THEN REPEAT (ASM_REWRITE_TAC [ADD; ADD_SUC; ADD_0] THEN COND_CASES_TAC) THEN ASM_MESON_TAC[ADD_SUC]);; let QSORT_PERMUTED = prove (`!le (l:A list). QSORT le l PERMUTED l`, REWRITE_TAC [PERMUTED_COUNT; COUNT_QSORT]);; let ALL_QSORT = prove (`!P le l. ALL P (QSORT le l) <=> ALL P l`, MESON_TAC [QSORT_PERMUTED; PERMUTED_ALL]);; let LENGTH_QSORT = prove (`!le l. LENGTH (QSORT le l) = LENGTH l`, MESON_TAC [QSORT_PERMUTED; PERMUTED_LENGTH]);; let MEM_QSORT = prove (`!le l x. MEM x (QSORT le l) <=> MEM x l`, MESON_TAC [QSORT_PERMUTED; PERMUTED_MEM]);; let ORDERED_QSORT = prove (`!le (l:A list). (!x y. le x y \/ le y x) /\ (!x y z. le x y \/ le y z ==> le x z) ==> ORDERED le (QSORT le l)`, REWRITE_TAC [GSYM RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC list_WF THEN LIST_CASES_TAC THEN REWRITE_TAC [QSORT; LENGTH; ORDERED_RULES; LT_SUC_LE] THEN DISCH_TAC THEN REWRITE_TAC [ORDERED_APPEND; ORDERED_CONS; ALL; ALL_QSORT; ALL_T] THEN ASM_SIMP_TAC [LENGTH_FILTER_LE] THEN REWRITE_TAC [GSYM ALL_MEM] THEN ASM_MESON_TAC[]);; (* Example: REWRITE_CONV [QSORT; ARITH_LE; ARITH_LT; FILTER; APPEND] `QSORT (<=) [12;3;5;1;23;2;1]`;; *) hol-light/Proofrecording/000077500000000000000000000000001303454263000157275ustar00rootroot00000000000000hol-light/Proofrecording/README000066400000000000000000000164001303454263000166100ustar00rootroot00000000000000***************************************************** **** **** **** PROOF OBJECTS FOR HOL-LIGHT **** **** EXPORTATION TO COQ **** **** **** **** Steven Obua (obua@in.tum.de) **** **** Technische Universität München **** **** February 2005 **** **** and **** **** Chantal Keller (keller@lix.polytechnique.fr)**** **** Laboratoire d'Informatique de Polytechnique **** **** January 2010 **** **** **** ***************************************************** LICENSE: The usual Hol-light license applies. ******************************************** * How to set up proof objects in Hol-light * ******************************************** There are two environment variables that need to be set in order to generate and save proof objects. Example: export HOLPROOFOBJECTS=EXTENDED export HOLPROOFEXPORTDIR=/home/obua/tmp/holproofexport 1. HOLPROOFOBJECTS This environment variable switches proof objects on and off. In addition, it allows to choose between two different modes of proof objects. It can have one of four different values: NONE, BASIC, EXTENDED, COQ. If it is not set or different from those three values (the check is case-sensitive), NONE is assumed. NONE Proof objects are switched off. BASIC Proof objects are switched on. EXTENDED Proof objects are switched on. In contrast to BASIC, not only the hol-light kernel generates proof objects, but also selected theorem generating functions (like SYM) generate proof objects, replacing and therefore abbreviating the primitive proof objects. If you want to generate proof objects, the EXTENDED mode is the recommended one. Hol-light needs much less memory in EXTENDED mode than in BASIC mode, and it generates more compact proof objects on disk, too. The BASIC mode might be useful if the proof object importer does not understand the EXTENDED proof objects, but only the BASIC proof objects. The proof object importer that comes with Isabelle/HOL understands EXTENDED proof objects. 2. HOLPROOFEXPORTDIR If proof objects are switched on, this environment variable needs to point to a writeable directory, otherwise an exception is thrown when the user tries to save his proof objects. After setting these environment variables, see the following instructions. ******************************************************* * How to build a "proof objects" version of HOL Light * ******************************************************* Just go into the following subdirectory, which starts empty except for the Makefile: Proofrecording/hol_light and type "make" (or "make hol" etc. if building an image). This will (1) Copy all the core HOL Light files into this directory (2) Copy those that need to be radically changed from ../diffs (3) Systematically change "prove" into named "nprove" calls Now you should just be able to start HOL Light as usual, but from within this directory "Proofrecording/hol_light", and the various proof recording options will be available to you; see below. Note that the "unix" library is needed. If on a platform like Cygwin where dynamic loading isn't supported, you need to use a standalone image with both the "unix" and "num" libraries preinstalled, e.g. by ocamlmktop -o ocamlnumunix nums.cma unix.cma ************************************ * Using proof objects in Hol-light * ************************************ There are basically three commands that are at your disposal for dealing with proof objects: 1. save_thm : string -> thm -> thm "save_thm n th" saves the proof of the given theorem th under the given name n in the proof database. It returns as a value the unmodified theorem. 2. nprove: string -> term * tactic -> thm "nprove n x" calls "prove x", saves the proof of the resulting theorem under the given name n in the proof database, and returns the theorem. 3. export_saved_proofs: (string option) -> unit "export_saved_proofs (Some )" saves the whole current proof database to the subdirectory $HOLPROOFEXPORTDIR/hollight/. For "export_saved_proofs None" the destination directory is $HOLPROOFEXPORTDIR/hollight/hollight. ********************************************************* * No built-in equality of theorems (and proofs) anymore * ********************************************************* With the introduction of proof objects, theorems now not only consist of a list of assumptions and a conclusion, but of a proof object as well. Therefore even if theorems A and B state the same proposition, they might not be equal under built-in equality "=", because the proof for A might differ from the proof of B. Therefore built-in equality for theorems is now forbidden, a comparison "A = B" fails with the following message: Exception: Invalid_argument "equal: functional value". If theorems need to be compared, the function equals_thm: thm -> thm -> bool can be used. This function only compares assumptions and conclusion, and ignores the proof object. *************************************** * Eporting the proof objects into Coq * *************************************** It is now possible to export the proof objects in a format that is readable for Coq, such that the theorems can be re-checked and used in Coq. The differences with the standard exportation system are: 1. Set the environment variable HOLPROOFOBJECTS to COQ: COQ The same as for EXTENDED, but proof objects are not exported to an XML format but to a format that is readable by Coq. 2. To start HOL-Light, the ocamlgraph and str libraries are needed. You have to install ocamlgraph, then use a standalone image with both these libraries preinstalled. This can be done automatically by executing make top The top-level that is created has the name top. 3. In addition with the commands save_thm and nprove, you dispose of three commands to perform the exportation: - export_saved_proofs: unit -> unit "export_saved_proofs ()" saves the whole current proof database to the subdirectory $HOLPROOFEXPORTDIR/hollight/hollight. - export_one_proof: string -> unit "export_one_proof "foobar"" saves the proof of the theorem foobar to the subdirectory $HOLPROOFEXPORTDIR/hollight/hollight. - export_list: string list -> unit "export_list l" saves the proofs of all the theorems of l to the subdirectory $HOLPROOFEXPORTDIR/hollight/hollight. 4. To exploit the theorems that have been exported, you have to download the Coq's interface at . A README file explains how to use it. ******************** * Acknowledgements * ******************** Thanks to Sebastian Skalberg for his tremendous help with porting his HOL4 code to Hol-light. Thanks to Tobias Nipkow for his idea on how to detect calls to the built-in equality of theorems during runtime, and thanks to Virgile Prevosto for his proposal on how to statically detect calls to the built-in equality on theorems. Last, but not least, thanks to John Harrison for including and integrating this proof object stuff in his very nice and clean Hol-light distribution. hol-light/Proofrecording/diffs/000077500000000000000000000000001303454263000170225ustar00rootroot00000000000000hol-light/Proofrecording/diffs/basics.ml000066400000000000000000000400661303454263000206260ustar00rootroot00000000000000(* ========================================================================= *) (* More syntax constructors, and prelogical utilities like matching. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Create probably-fresh variable *) (* ------------------------------------------------------------------------- *) let genvar = let gcounter = ref 0 in fun ty -> let count = !gcounter in (gcounter := count + 1; mk_var("_"^(string_of_int count),ty));; (* ------------------------------------------------------------------------- *) (* Convenient functions for manipulating types. *) (* ------------------------------------------------------------------------- *) let dest_fun_ty ty = match ty with Tyapp("fun",[ty1;ty2]) -> (ty1,ty2) | _ -> failwith "dest_fun_ty";; let rec occurs_in ty bigty = bigty = ty or is_type bigty && exists (occurs_in ty) (snd(dest_type bigty));; let rec tysubst alist ty = try rev_assoc ty alist with Failure _ -> if is_vartype ty then ty else let tycon,tyvars = dest_type ty in mk_type(tycon,map (tysubst alist) tyvars);; (* ------------------------------------------------------------------------- *) (* A bit more syntax. *) (* ------------------------------------------------------------------------- *) let bndvar tm = try fst(dest_abs tm) with Failure _ -> failwith "bndvar: Not an abstraction";; let body tm = try snd(dest_abs tm) with Failure _ -> failwith "body: Not an abstraction";; let list_mk_comb(h,t) = rev_itlist (C (curry mk_comb)) t h;; let list_mk_abs(vs,bod) = itlist (curry mk_abs) vs bod;; let strip_comb = rev_splitlist dest_comb;; let strip_abs = splitlist dest_abs;; (* ------------------------------------------------------------------------- *) (* Generic syntax to deal with some binary operators. *) (* *) (* Note that "mk_binary" only works for monomorphic functions. *) (* ------------------------------------------------------------------------- *) let is_binary s tm = match tm with Comb(Comb(Const(s',_),_),_) -> s' = s | _ -> false;; let dest_binary s tm = match tm with Comb(Comb(Const(s',_),l),r) when s' = s -> (l,r) | _ -> failwith "dest_binary";; let mk_binary s = let c = mk_const(s,[]) in fun (l,r) -> try mk_comb(mk_comb(c,l),r) with Failure _ -> failwith "mk_binary";; (* ------------------------------------------------------------------------- *) (* Produces a sequence of variants, considering previous inventions. *) (* ------------------------------------------------------------------------- *) let rec variants av vs = if vs = [] then [] else let vh = variant av (hd vs) in vh::(variants (vh::av) (tl vs));; (* ------------------------------------------------------------------------- *) (* Gets all variables (free and/or bound) in a term. *) (* ------------------------------------------------------------------------- *) let variables = let rec vars(acc,tm) = if is_var tm then insert tm acc else if is_const tm then acc else if is_abs tm then let v,bod = dest_abs tm in vars(insert v acc,bod) else let l,r = dest_comb tm in vars(vars(acc,l),r) in fun tm -> vars([],tm);; (* ------------------------------------------------------------------------- *) (* General substitution (for any free expression). *) (* ------------------------------------------------------------------------- *) let subst = let rec ssubst ilist tm = if ilist = [] then tm else try fst (find ((aconv tm) o snd) ilist) with Failure _ -> match tm with Comb(f,x) -> let f' = ssubst ilist f and x' = ssubst ilist x in if f' == f && x' == x then tm else mk_comb(f',x') | Abs(v,bod) -> let ilist' = filter (not o (vfree_in v) o snd) ilist in mk_abs(v,ssubst ilist' bod) | _ -> tm in fun ilist -> let theta = filter (fun (s,t) -> Pervasives.compare s t <> 0) ilist in if theta = [] then (fun tm -> tm) else let ts,xs = unzip theta in fun tm -> let gs = variants (variables tm) (map (genvar o type_of) xs) in let tm' = ssubst (zip gs xs) tm in if tm' == tm then tm else vsubst (zip ts gs) tm';; (* ------------------------------------------------------------------------- *) (* Alpha conversion term operation. *) (* ------------------------------------------------------------------------- *) let alpha v tm = let v0,bod = try dest_abs tm with Failure _ -> failwith "alpha: Not an abstraction"in if v = v0 then tm else if type_of v = type_of v0 && not (vfree_in v bod) then mk_abs(v,vsubst[v,v0]bod) else failwith "alpha: Invalid new variable";; (* ------------------------------------------------------------------------- *) (* Type matching. *) (* ------------------------------------------------------------------------- *) let rec type_match vty cty sofar = if is_vartype vty then try if rev_assoc vty sofar = cty then sofar else failwith "type_match" with Failure "find" -> (cty,vty)::sofar else let vop,vargs = dest_type vty and cop,cargs = dest_type cty in if vop = cop then itlist2 type_match vargs cargs sofar else failwith "type_match";; (* ------------------------------------------------------------------------- *) (* Conventional matching version of mk_const (but with a sanity test). *) (* ------------------------------------------------------------------------- *) let mk_mconst(c,ty) = try let uty = get_const_type c in let mat = type_match uty ty [] in let con = mk_const(c,mat) in if type_of con = ty then con else fail() with Failure _ -> failwith "mk_const: generic type cannot be instantiated";; (* ------------------------------------------------------------------------- *) (* Like mk_comb, but instantiates type variables in rator if necessary. *) (* ------------------------------------------------------------------------- *) let mk_icomb(tm1,tm2) = let "fun",[ty;_] = dest_type (type_of tm1) in let tyins = type_match ty (type_of tm2) [] in mk_comb(inst tyins tm1,tm2);; (* ------------------------------------------------------------------------- *) (* Instantiates types for constant c and iteratively makes combination. *) (* ------------------------------------------------------------------------- *) let list_mk_icomb cname args = let atys,_ = nsplit dest_fun_ty args (get_const_type cname) in let tyin = itlist2 (fun g a -> type_match g (type_of a)) atys args [] in list_mk_comb(mk_const(cname,tyin),args);; (* ------------------------------------------------------------------------- *) (* Free variables in assumption list and conclusion of a theorem. *) (* ------------------------------------------------------------------------- *) let thm_frees th = let asl,c = dest_thm th in itlist (union o frees) asl (frees c);; (* ------------------------------------------------------------------------- *) (* Is one term free in another? *) (* ------------------------------------------------------------------------- *) let rec free_in tm1 tm2 = if aconv tm1 tm2 then true else if is_comb tm2 then let l,r = dest_comb tm2 in free_in tm1 l or free_in tm1 r else if is_abs tm2 then let bv,bod = dest_abs tm2 in not (vfree_in bv tm1) && free_in tm1 bod else false;; (* ------------------------------------------------------------------------- *) (* Searching for terms. *) (* ------------------------------------------------------------------------- *) let rec find_term p tm = if p tm then tm else if is_abs tm then find_term p (body tm) else if is_comb tm then let l,r = dest_comb tm in try find_term p l with Failure _ -> find_term p r else failwith "find_term";; let find_terms = let rec accum tl p tm = let tl' = if p tm then insert tm tl else tl in if is_abs tm then accum tl' p (body tm) else if is_comb tm then accum (accum tl' p (rator tm)) p (rand tm) else tl' in accum [];; (* ------------------------------------------------------------------------- *) (* General syntax for binders. *) (* *) (* NB! The "mk_binder" function expects polytype "A", which is the domain. *) (* ------------------------------------------------------------------------- *) let is_binder s tm = match tm with Comb(Const(s',_),Abs(_,_)) -> s' = s | _ -> false;; let dest_binder s tm = match tm with Comb(Const(s',_),Abs(x,t)) when s' = s -> (x,t) | _ -> failwith "dest_binder";; let mk_binder op = let c = mk_const(op,[]) in fun (v,tm) -> mk_comb(inst [type_of v,aty] c,mk_abs(v,tm));; (* ------------------------------------------------------------------------- *) (* Syntax for binary operators. *) (* ------------------------------------------------------------------------- *) let is_binop op tm = match tm with Comb(Comb(op',_),_) -> op' = op | _ -> false;; let dest_binop op tm = match tm with Comb(Comb(op',l),r) when op' = op -> (l,r) | _ -> failwith "dest_binop";; let mk_binop op tm1 = let f = mk_comb(op,tm1) in fun tm2 -> mk_comb(f,tm2);; let list_mk_binop op = end_itlist (mk_binop op);; let binops op = striplist (dest_binop op);; (* ------------------------------------------------------------------------- *) (* Some common special cases *) (* ------------------------------------------------------------------------- *) let is_conj = is_binary "/\\";; let dest_conj = dest_binary "/\\";; let conjuncts = striplist dest_conj;; let is_imp = is_binary "==>";; let dest_imp = dest_binary "==>";; let is_forall = is_binder "!";; let dest_forall = dest_binder "!";; let strip_forall = splitlist dest_forall;; let is_exists = is_binder "?";; let dest_exists = dest_binder "?";; let strip_exists = splitlist dest_exists;; let is_disj = is_binary "\\/";; let dest_disj = dest_binary "\\/";; let disjuncts = striplist dest_disj;; let is_neg tm = try fst(dest_const(rator tm)) = "~" with Failure _ -> false;; let dest_neg tm = try let n,p = dest_comb tm in if fst(dest_const n) = "~" then p else fail() with Failure _ -> failwith "dest_neg";; let is_uexists = is_binder "?!";; let dest_uexists = dest_binder "?!";; let dest_cons = dest_binary "CONS";; let is_cons = is_binary "CONS";; let dest_list tm = try let tms,nil = splitlist dest_cons tm in if fst(dest_const nil) = "NIL" then tms else fail() with Failure _ -> failwith "dest_list";; let is_list = can dest_list;; (* ------------------------------------------------------------------------- *) (* Syntax for numerals. *) (* ------------------------------------------------------------------------- *) let dest_numeral = let rec dest_num tm = if try fst(dest_const tm) = "_0" with Failure _ -> false then num_0 else let l,r = dest_comb tm in let n = num_2 */ dest_num r in let cn = fst(dest_const l) in if cn = "BIT0" then n else if cn = "BIT1" then n +/ num_1 else fail() in fun tm -> try let l,r = dest_comb tm in if fst(dest_const l) = "NUMERAL" then dest_num r else fail() with Failure _ -> failwith "dest_numeral";; (* ------------------------------------------------------------------------- *) (* Syntax for generalized abstractions. *) (* *) (* These are here because they are used by the preterm->term translator; *) (* preterms regard generalized abstractions as an atomic notion. This is *) (* slightly unclean --- for example we need locally some operations on *) (* universal quantifiers --- but probably simplest. It has to go somewhere! *) (* ------------------------------------------------------------------------- *) let dest_gabs = let dest_geq = dest_binary "GEQ" in fun tm -> try if is_abs tm then dest_abs tm else let l,r = dest_comb tm in if not (fst(dest_const l) = "GABS") then fail() else let ltm,rtm = dest_geq(snd(strip_forall(body r))) in rand ltm,rtm with Failure _ -> failwith "dest_gabs: Not a generalized abstraction";; let is_gabs = can dest_gabs;; let mk_gabs = let mk_forall(v,t) = let cop = mk_const("!",[type_of v,aty]) in mk_comb(cop,mk_abs(v,t)) in let list_mk_forall(vars,bod) = itlist (curry mk_forall) vars bod in let mk_geq(t1,t2) = let p = mk_const("GEQ",[type_of t1,aty]) in mk_comb(mk_comb(p,t1),t2) in fun (tm1,tm2) -> if is_var tm1 then mk_abs(tm1,tm2) else let fvs = frees tm1 in let fty = mk_fun_ty (type_of tm1) (type_of tm2) in let f = variant (frees tm1 @ frees tm2) (mk_var("f",fty)) in let bod = mk_abs(f,list_mk_forall(fvs,mk_geq(mk_comb(f,tm1),tm2))) in mk_comb(mk_const("GABS",[fty,aty]),bod);; let list_mk_gabs(vs,bod) = itlist (curry mk_gabs) vs bod;; let strip_gabs = splitlist dest_gabs;; (* ------------------------------------------------------------------------- *) (* Syntax for let terms. *) (* ------------------------------------------------------------------------- *) let dest_let tm = try let l,aargs = strip_comb tm in if fst(dest_const l) <> "LET" then fail() else let vars,lebod = strip_gabs (hd aargs) in let eqs = zip vars (tl aargs) in let le,bod = dest_comb lebod in if fst(dest_const le) = "LET_END" then eqs,bod else fail() with Failure _ -> failwith "dest_let: not a let-term";; let is_let = can dest_let;; let mk_let(assigs,bod) = let lefts,rights = unzip assigs in let lend = mk_comb(mk_const("LET_END",[type_of bod,aty]),bod) in let lbod = list_mk_gabs(lefts,lend) in let ty1,ty2 = dest_fun_ty(type_of lbod) in let ltm = mk_const("LET",[ty1,aty; ty2,bty]) in list_mk_comb(ltm,lbod::rights);; (* ------------------------------------------------------------------------- *) (* Useful function to create stylized arguments using numbers. *) (* ------------------------------------------------------------------------- *) let make_args = let rec margs n s avoid tys = if tys = [] then [] else let v = variant avoid (mk_var(s^(string_of_int n),hd tys)) in v::(margs (n + 1) s (v::avoid) (tl tys)) in fun s avoid tys -> if length tys = 1 then [variant avoid (mk_var(s,hd tys))] else margs 0 s avoid tys;; (* ------------------------------------------------------------------------- *) (* Director strings down a term. *) (* ------------------------------------------------------------------------- *) let find_path = let rec find_path p tm = if p tm then [] else if is_abs tm then "b"::(find_path p (body tm)) else try "r"::(find_path p (rand tm)) with Failure _ -> "l"::(find_path p (rator tm)) in fun p tm -> implode(find_path p tm);; let follow_path = let rec follow_path s tm = match s with [] -> tm | "l"::t -> follow_path t (rator tm) | "r"::t -> follow_path t (rand tm) | _::t -> follow_path t (body tm) in fun s tm -> follow_path (explode s) tm;; hol-light/Proofrecording/diffs/bool.ml000066400000000000000000000413341303454263000203140ustar00rootroot00000000000000(* ========================================================================= *) (* Boolean theory including (intuitionistic) defs of logical connectives. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2006 *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Set up parse status of basic and derived logical constants. *) (* ------------------------------------------------------------------------- *) parse_as_prefix "~";; map parse_as_binder ["\\"; "!"; "?"; "?!"];; map parse_as_infix ["==>",(4,"right"); "\\/",(6,"right"); "/\\",(8,"right")];; (* ------------------------------------------------------------------------- *) (* Set up more orthodox notation for equations and equivalence. *) (* ------------------------------------------------------------------------- *) parse_as_infix("<=>",(2,"right"));; override_interface ("<=>",`(=):bool->bool->bool`);; parse_as_infix("=",(12,"right"));; (* ------------------------------------------------------------------------- *) (* Special syntax for Boolean equations (IFF). *) (* ------------------------------------------------------------------------- *) let is_iff tm = match tm with Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> true | _ -> false;; let dest_iff tm = match tm with Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> (l,r) | _ -> failwith "dest_iff";; let mk_iff = let eq_tm = `(<=>)` in fun (l,r) -> mk_comb(mk_comb(eq_tm,l),r);; (* ------------------------------------------------------------------------- *) (* Rule allowing easy instantiation of polymorphic proformas. *) (* ------------------------------------------------------------------------- *) let PINST tyin tmin = let iterm_fn = INST (map (I F_F (inst tyin)) tmin) and itype_fn = INST_TYPE tyin in fun th -> try iterm_fn (itype_fn th) with Failure _ -> failwith "PINST";; (* ------------------------------------------------------------------------- *) (* Useful derived deductive rule. *) (* ------------------------------------------------------------------------- *) let PROVE_HYP ath bth = if exists (aconv (concl ath)) (hyp bth) then EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath else bth;; (* ------------------------------------------------------------------------- *) (* Rules for T *) (* ------------------------------------------------------------------------- *) let T_DEF = new_basic_definition `T = ((\p:bool. p) = (\p:bool. p))`;; let TRUTH = EQ_MP (SYM T_DEF) (REFL `\p:bool. p`);; let EQT_ELIM th = try EQ_MP (SYM th) TRUTH with Failure _ -> failwith "EQT_ELIM";; let EQT_INTRO = let t = `t:bool` and T = `T` in let pth = let th1 = DEDUCT_ANTISYM_RULE (ASSUME t) TRUTH in let th2 = EQT_ELIM(ASSUME(concl th1)) in DEDUCT_ANTISYM_RULE th2 th1 in fun th -> EQ_MP (INST[concl th,t] pth) th;; (* ------------------------------------------------------------------------- *) (* Rules for /\ *) (* ------------------------------------------------------------------------- *) let AND_DEF = new_basic_definition `(/\) = \p q. (\f:bool->bool->bool. f p q) = (\f. f T T)`;; let mk_conj = mk_binary "/\\";; let list_mk_conj = end_itlist (curry mk_conj);; let CONJ = let f = `f:bool->bool->bool` and p = `p:bool` and q = `q:bool` in let pth = let pth = ASSUME p and qth = ASSUME q in let th1 = MK_COMB(AP_TERM f (EQT_INTRO pth),EQT_INTRO qth) in let th2 = ABS f th1 in let th3 = BETA_RULE (AP_THM (AP_THM AND_DEF p) q) in EQ_MP (SYM th3) th2 in fun th1 th2 -> substitute_proof ( let th = INST [concl th1,p; concl th2,q] pth in PROVE_HYP th2 (PROVE_HYP th1 th)) (proof_CONJ (proof_of th1) (proof_of th2));; let CONJUNCT1 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = EQ_MP th2 (ASSUME `P /\ Q`) in EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). p`)) in fun th -> substitute_proof ( try let l,r = dest_conj(concl th) in PROVE_HYP th (INST [l,P; r,Q] pth) with Failure _ -> failwith "CONJUNCT1") (proof_CONJUNCT1 (proof_of th));; let CONJUNCT2 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = EQ_MP th2 (ASSUME `P /\ Q`) in EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). q`)) in fun th -> substitute_proof ( try let l,r = dest_conj(concl th) in PROVE_HYP th (INST [l,P; r,Q] pth) with Failure _ -> failwith "CONJUNCT2") (proof_CONJUNCT2 (proof_of th));; let CONJ_PAIR th = try CONJUNCT1 th,CONJUNCT2 th with Failure _ -> failwith "CONJ_PAIR: Not a conjunction";; let CONJUNCTS = striplist CONJ_PAIR;; (* ------------------------------------------------------------------------- *) (* Rules for ==> *) (* ------------------------------------------------------------------------- *) let IMP_DEF = new_basic_definition `(==>) = \p q. p /\ q <=> p`;; let mk_imp = mk_binary "==>";; let MP = let p = `p:bool` and q = `q:bool` in let pth = let th1 = BETA_RULE (AP_THM (AP_THM IMP_DEF p) q) in let th2 = EQ_MP th1 (ASSUME `p ==> q`) in CONJUNCT2 (EQ_MP (SYM th2) (ASSUME `p:bool`)) in fun ith th -> let ant,con = dest_imp (concl ith) in if aconv ant (concl th) then PROVE_HYP th (PROVE_HYP ith (INST [ant,p; con,q] pth)) else failwith "MP: theorems do not agree";; let DISCH = let p = `p:bool` and q = `q:bool` in let pth = SYM(BETA_RULE (AP_THM (AP_THM IMP_DEF p) q)) in fun a th -> substitute_proof ( let th1 = CONJ (ASSUME a) th in let th2 = CONJUNCT1 (ASSUME (concl th1)) in let th3 = DEDUCT_ANTISYM_RULE th1 th2 in let th4 = INST [a,p; concl th,q] pth in EQ_MP th4 th3) (proof_DISCH (proof_of th) a);; let rec DISCH_ALL th = try DISCH_ALL (DISCH (hd (hyp th)) th) with Failure _ -> th;; let UNDISCH th = try MP th (ASSUME(rand(rator(concl th)))) with Failure _ -> failwith "UNDISCH";; let rec UNDISCH_ALL th = if is_imp (concl th) then UNDISCH_ALL (UNDISCH th) else th;; let IMP_ANTISYM_RULE th1 th2 = substitute_proof (DEDUCT_ANTISYM_RULE (UNDISCH th2) (UNDISCH th1)) (proof_IMPAS (proof_of th2) (proof_of th1));; let ADD_ASSUM tm th = MP (DISCH tm th) (ASSUME tm);; let EQ_IMP_RULE th = try let l,r = dest_eq(concl th) in DISCH l (EQ_MP th (ASSUME l)), DISCH r (EQ_MP(SYM th)(ASSUME r)) with Failure _ -> failwith "EQ_IMP_RULE";; let IMP_TRANS th1 th2 = try let ant = rand(rator(concl th1)) in DISCH ant (MP th2 (MP th1 (ASSUME ant))) with Failure _ -> failwith "IMP_TRANS";; (* ------------------------------------------------------------------------- *) (* Rules for ! *) (* ------------------------------------------------------------------------- *) let FORALL_DEF = new_basic_definition `(!) = \P:A->bool. P = \x. T`;; let mk_forall = mk_binder "!";; let list_mk_forall(vs,bod) = itlist (curry mk_forall) vs bod;; let SPEC = let P = `P:A->bool` and x = `x:A` in let pth = let th1 = EQ_MP(AP_THM FORALL_DEF `P:A->bool`) (ASSUME `(!)(P:A->bool)`) in let th2 = AP_THM (CONV_RULE BETA_CONV th1) `x:A` in let th3 = CONV_RULE (RAND_CONV BETA_CONV) th2 in DISCH_ALL (EQT_ELIM th3) in fun tm th -> (substitute_proof (try let abs = rand(concl th) in CONV_RULE BETA_CONV (MP (PINST [snd(dest_var(bndvar abs)),aty] [abs,P; tm,x] pth) th) with Failure _ -> failwith "SPEC") (proof_SPEC tm (proof_of th)));; let SPECL tms th = try rev_itlist SPEC tms th with Failure _ -> failwith "SPECL";; let SPEC_VAR th = let bv = variant (thm_frees th) (bndvar(rand(concl th))) in bv,SPEC bv th;; let rec SPEC_ALL th = if is_forall(concl th) then SPEC_ALL(snd(SPEC_VAR th)) else th;; let ISPEC t th = let x,_ = try dest_forall(concl th) with Failure _ -> failwith "ISPEC: input theorem not universally quantified" in let tyins = try type_match (snd(dest_var x)) (type_of t) [] with Failure _ -> failwith "ISPEC can't type-instantiate input theorem" in try SPEC t (INST_TYPE tyins th) with Failure _ -> failwith "ISPEC: type variable(s) free in assumptions";; let ISPECL tms th = try if tms = [] then th else let avs = fst (chop_list (length tms) (fst(strip_forall(concl th)))) in let tyins = itlist2 type_match (map (snd o dest_var) avs) (map type_of tms) [] in SPECL tms (INST_TYPE tyins th) with Failure _ -> failwith "ISPECL";; let GEN = let P = `P:A->bool` and true_tm = `T` in let pth = let th1 = ASSUME `P = \x:A. T` in let th2 = AP_THM FORALL_DEF `P:A->bool` in DISCH_ALL (EQ_MP (SYM(CONV_RULE(RAND_CONV BETA_CONV) th2)) th1) in fun x th -> substitute_proof ( try let th1 = ABS x (EQT_INTRO th) in let tm1 = mk_abs(mk_var("x",type_of x),true_tm) in let th2 = TRANS th1 (REFL tm1) in let th3 = PINST [snd(dest_var x),aty] [rand(rator(concl th1)),P] pth in MP th3 th2 with Failure _ -> failwith "GEN") (proof_GEN (proof_of th) x);; let GENL = itlist GEN;; let GEN_ALL th = let asl,c = dest_thm th in let vars = subtract (frees c) (freesl asl) in GENL vars th;; (* ------------------------------------------------------------------------- *) (* Rules for ? *) (* ------------------------------------------------------------------------- *) let EXISTS_DEF = new_basic_definition `(?) = \P:A->bool. !q. (!x. P x ==> q) ==> q`;; let mk_exists = mk_binder "?";; let list_mk_exists(vs,bod) = itlist (curry mk_exists) vs bod;; let EXISTS = let P = `P:A->bool` and x = `x:A` and PX = `(P:A->bool) x` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in let th2 = SPEC `x:A` (ASSUME `!x:A. P x ==> Q`) in let th3 = DISCH `!x:A. P x ==> Q` (MP th2 (ASSUME `(P:A->bool) x`)) in DISCH_ALL (EQ_MP (SYM th1) (GEN `Q:bool` th3)) in fun (etm,stm) th -> substitute_proof ( try let qf,abs = dest_comb etm in let bth = BETA_CONV(mk_comb(abs,stm)) in let cth = PINST [type_of stm,aty] [abs,P; stm,x] pth in MP cth (EQ_MP (SYM bth) th) with Failure _ -> failwith "EXISTS") (proof_EXISTS etm stm (proof_of th));; let SIMPLE_EXISTS v th = EXISTS (mk_exists(v,concl th),v) th;; let CHOOSE = let P = `P:A->bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in let th2 = SPEC `Q:bool` (UNDISCH(fst(EQ_IMP_RULE th1))) in DISCH_ALL (DISCH `(?) (P:A->bool)` (UNDISCH th2)) in fun (v,th1) th2 -> substitute_proof ( try let abs = rand(concl th1) in let bv,bod = dest_abs abs in let cmb = mk_comb(abs,v) in let pat = vsubst[v,bv] bod in let th3 = CONV_RULE BETA_CONV (ASSUME cmb) in let th4 = GEN v (DISCH cmb (MP (DISCH pat th2) th3)) in let th5 = PINST [snd(dest_var v),aty] [abs,P; concl th2,Q] pth in MP (MP th5 th4) th1 with Failure _ -> failwith "CHOOSE") (proof_CHOOSE v (proof_of th1) (proof_of th2));; let SIMPLE_CHOOSE v th = CHOOSE(v,ASSUME (mk_exists(v,hd(hyp th)))) th;; (* ------------------------------------------------------------------------- *) (* Rules for \/ *) (* ------------------------------------------------------------------------- *) let OR_DEF = new_basic_definition `(\/) = \p q. !r. (p ==> r) ==> (q ==> r) ==> r`;; let mk_disj = mk_binary "\\/";; let list_mk_disj = end_itlist (curry mk_disj);; let DISJ1 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = MP (ASSUME `P ==> t`) (ASSUME `P:bool`) in let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in DISCH_ALL (EQ_MP (SYM th2) th4) in fun th tm -> substitute_proof ( try MP (INST [concl th,P; tm,Q] pth) th with Failure _ -> failwith "DISJ1") (proof_DISJ1 (proof_of th) tm);; let DISJ2 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = MP (ASSUME `Q ==> t`) (ASSUME `Q:bool`) in let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in DISCH_ALL (EQ_MP (SYM th2) th4) in fun tm th -> substitute_proof ( try MP (INST [tm,P; concl th,Q] pth) th with Failure _ -> failwith "DISJ2") (proof_DISJ2 (proof_of th) tm);; let DISJ_CASES = let P = `P:bool` and Q = `Q:bool` and R = `R:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = SPEC `R:bool` (EQ_MP th2 (ASSUME `P \/ Q`)) in UNDISCH (UNDISCH th3) in fun th0 th1 th2 -> substitute_proof ( try let c1 = concl th1 and c2 = concl th2 in if not (aconv c1 c2) then failwith "DISJ_CASES" else let l,r = dest_disj (concl th0) in let th = INST [l,P; r,Q; c1,R] pth in PROVE_HYP (DISCH r th2) (PROVE_HYP (DISCH l th1) (PROVE_HYP th0 th)) with Failure _ -> failwith "DISJ_CASES") (proof_DISJCASES (proof_of th0) (proof_of th1) (proof_of th2));; let SIMPLE_DISJ_CASES th1 th2 = DISJ_CASES (ASSUME(mk_disj(hd(hyp th1),hd(hyp th2)))) th1 th2;; (* ------------------------------------------------------------------------- *) (* Rules for negation and falsity. *) (* ------------------------------------------------------------------------- *) let F_DEF = new_basic_definition `F = !p:bool. p`;; let NOT_DEF = new_basic_definition `(~) = \p. p ==> F`;; let mk_neg = let neg_tm = `(~)` in fun tm -> try mk_comb(neg_tm,tm) with Failure _ -> failwith "mk_neg";; let NOT_ELIM = let P = `P:bool` in let pth = CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P) in fun th -> substitute_proof ( try EQ_MP (INST [rand(concl th),P] pth) th with Failure _ -> failwith "NOT_ELIM") (proof_NOTE (proof_of th));; let NOT_INTRO = let P = `P:bool` in let pth = SYM(CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P)) in fun th -> substitute_proof ( try EQ_MP (INST [rand(rator(concl th)),P] pth) th with Failure _ -> failwith "NOT_ELIM") (proof_NOTI (proof_of th));; let EQF_INTRO = let P = `P:bool` in let pth = let th1 = NOT_ELIM (ASSUME `~ P`) and th2 = DISCH `F` (SPEC P (EQ_MP F_DEF (ASSUME `F`))) in DISCH_ALL (IMP_ANTISYM_RULE th1 th2) in fun th -> try MP (INST [rand(concl th),P] pth) th with Failure _ -> failwith "EQF_INTRO";; let EQF_ELIM = let P = `P:bool` in let pth = let th1 = EQ_MP (ASSUME `P = F`) (ASSUME `P:bool`) in let th2 = DISCH P (SPEC `F` (EQ_MP F_DEF th1)) in DISCH_ALL (NOT_INTRO th2) in fun th -> try MP (INST [rand(rator(concl th)),P] pth) th with Failure _ -> failwith "EQF_ELIM";; let CONTR = let P = `P:bool` and f_tm = `F` in let pth = SPEC P (EQ_MP F_DEF (ASSUME `F`)) in fun tm th -> substitute_proof ( if concl th <> f_tm then failwith "CONTR" else PROVE_HYP th (INST [tm,P] pth)) (proof_CONTR (proof_of th) tm);; (* ------------------------------------------------------------------------- *) (* Rules for unique existence. *) (* ------------------------------------------------------------------------- *) let EXISTS_UNIQUE_DEF = new_basic_definition `(?!) = \P:A->bool. ((?) P) /\ (!x y. P x /\ P y ==> x = y)`;; let mk_uexists = mk_binder "?!";; let EXISTENCE = let P = `P:A->bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_UNIQUE_DEF P) in let th2 = UNDISCH (fst(EQ_IMP_RULE th1)) in DISCH_ALL (CONJUNCT1 th2) in fun th -> try let abs = rand(concl th) in let ty = snd(dest_var(bndvar abs)) in MP (PINST [ty,aty] [abs,P] pth) th with Failure _ -> failwith "EXISTENCE";; hol-light/Proofrecording/diffs/depgraph.ml000066400000000000000000000044001303454263000211440ustar00rootroot00000000000000module Label = struct type t = string let compare = String.compare let hash s = let n = String.length s in let p = 9 in if n >= p then try int_of_string (String.sub s p (n-p)) with | Failure _ -> n else n let equal a b = a = b end module Dep = struct include Graph.Imperative.Digraph.ConcreteBidirectional(Label) let graph_attributes _ = [] let default_vertex_attributes _ = [] let vertex_name v = V.label v let vertex_attributes _ = [] let get_subgraph _ = None let default_edge_attributes _ = [] let edge_attributes _ = [] let add_thm dep thm = add_vertex dep (V.create thm) let add_dep dep thm1 thm2 = let v1 = V.create thm1 in let v2 = V.create thm2 in if ((mem_vertex dep v1) && (mem_vertex dep v2)) then add_edge dep v1 v2 let min_max_moy_in_deg dep = let max = ref 0 in let lab_max = ref "" in let min = ref 1073741823 in let lab_min = ref "" in let nb = ref 0 in let sum = ref 0 in let calc v = let deg = in_degree dep v in if deg < !min then ( min := deg; lab_min := V.label v ); if deg > !max then ( max := deg; lab_max := V.label v ); incr nb; sum := !sum + deg in iter_vertex calc dep; let moy = (float_of_int !sum) /. (float_of_int !nb) in (!min, !lab_min, !max, !lab_max, moy) let min_max_moy_out_deg dep = let max = ref 0 in let lab_max = ref "" in let min = ref 1073741823 in let lab_min = ref "" in let nb = ref 0 in let sum = ref 0 in let calc v = let deg = out_degree dep v in if deg < !min then ( min := deg; lab_min := V.label v ); if deg > !max then ( max := deg; lab_max := V.label v ); incr nb; sum := !sum + deg in iter_vertex calc dep; let moy = (float_of_int !sum) /. (float_of_int !nb) in (!min, !lab_min, !max, !lab_max, moy) end module Dep_top = struct include Graph.Topological.Make(Dep) let iter_top f dep = iter (fun v -> f (Dep.V.label v)) dep end module Dep_dot = struct include Graph.Graphviz.Dot(Dep) let output_dot name dep = let file = open_out name in output_graph file dep; close_out file end hol-light/Proofrecording/diffs/equal.ml000066400000000000000000000264671303454263000205020ustar00rootroot00000000000000(* ========================================================================= *) (* Basic equality reasoning including conversionals. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* ========================================================================= *) type conv = term->thm;; (* ------------------------------------------------------------------------- *) (* A bit more syntax. *) (* ------------------------------------------------------------------------- *) let lhand = rand o rator;; let lhs = fst o dest_eq;; let rhs = snd o dest_eq;; (* ------------------------------------------------------------------------- *) (* Similar to variant, but even avoids constants, and ignores types. *) (* ------------------------------------------------------------------------- *) let mk_primed_var = let rec svariant avoid s = if mem s avoid or (can get_const_type s && not(is_hidden s)) then svariant avoid (s^"'") else s in fun avoid v -> let s,ty = dest_var v in let s' = svariant (mapfilter (fst o dest_var) avoid) s in mk_var(s',ty);; (* ------------------------------------------------------------------------- *) (* General case of beta-conversion. *) (* ------------------------------------------------------------------------- *) let BETA_CONV tm = try BETA tm with Failure _ -> try let f,arg = dest_comb tm in let v = bndvar f in INST [arg,v] (BETA (mk_comb(f,v))) with Failure _ -> failwith "BETA_CONV: Not a beta-redex";; (* ------------------------------------------------------------------------- *) (* A few very basic derived equality rules. *) (* ------------------------------------------------------------------------- *) let AP_TERM tm th = try MK_COMB(REFL tm,th) with Failure _ -> failwith "AP_TERM";; let AP_THM th tm = try MK_COMB(th,REFL tm) with Failure _ -> failwith "AP_THM";; let SYM th = substitute_proof (let tm = concl th in let l,r = dest_eq tm in let lth = REFL l in EQ_MP (MK_COMB(AP_TERM (rator (rator tm)) th,lth)) lth) (proof_SYM (proof_of th));; let ALPHA tm1 tm2 = try TRANS (REFL tm1) (REFL tm2) with Failure _ -> failwith "ALPHA";; let ALPHA_CONV v tm = let res = alpha v tm in ALPHA tm res;; let GEN_ALPHA_CONV v tm = if is_abs tm then ALPHA_CONV v tm else let b,abs = dest_comb tm in AP_TERM b (ALPHA_CONV v abs);; let MK_BINOP op (lth,rth) = MK_COMB(AP_TERM op lth,rth);; (* ------------------------------------------------------------------------- *) (* Terminal conversion combinators. *) (* ------------------------------------------------------------------------- *) let (NO_CONV:conv) = fun tm -> failwith "NO_CONV";; let (ALL_CONV:conv) = REFL;; (* ------------------------------------------------------------------------- *) (* Combinators for sequencing, trying, repeating etc. conversions. *) (* ------------------------------------------------------------------------- *) let ((THENC):conv -> conv -> conv) = fun conv1 conv2 t -> let th1 = conv1 t in let th2 = conv2 (rand(concl th1)) in TRANS th1 th2;; let ((ORELSEC):conv -> conv -> conv) = fun conv1 conv2 t -> try conv1 t with Failure _ -> conv2 t;; let (FIRST_CONV:conv list -> conv) = end_itlist (fun c1 c2 -> c1 ORELSEC c2);; let (EVERY_CONV:conv list -> conv) = fun l -> itlist (fun c1 c2 -> c1 THENC c2) l ALL_CONV;; let REPEATC = let rec REPEATC conv t = ((conv THENC (REPEATC conv)) ORELSEC ALL_CONV) t in (REPEATC:conv->conv);; let (CHANGED_CONV:conv->conv) = fun conv tm -> let th = conv tm in let l,r = dest_eq (concl th) in if aconv l r then failwith "CHANGED_CONV" else th;; let TRY_CONV conv = conv ORELSEC ALL_CONV;; (* ------------------------------------------------------------------------- *) (* Subterm conversions. *) (* ------------------------------------------------------------------------- *) let (RATOR_CONV:conv->conv) = fun conv tm -> let l,r = dest_comb tm in AP_THM (conv l) r;; let (RAND_CONV:conv->conv) = fun conv tm -> let l,r = dest_comb tm in AP_TERM l (conv r);; let LAND_CONV = RATOR_CONV o RAND_CONV;; let (COMB2_CONV: conv->conv->conv) = fun lconv rconv tm -> let l,r = dest_comb tm in MK_COMB(lconv l,rconv r);; let COMB_CONV = W COMB2_CONV;; let (ABS_CONV:conv->conv) = fun conv tm -> let v,bod = dest_abs tm in let th = conv bod in try ABS v th with Failure _ -> let gv = genvar(type_of v) in let gbod = vsubst[gv,v] bod in let gth = ABS gv (conv gbod) in let gtm = concl gth in let l,r = dest_eq gtm in let v' = variant (frees gtm) v in let l' = alpha v' l and r' = alpha v' r in EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth;; let BINDER_CONV conv tm = try ABS_CONV conv tm with Failure _ -> RAND_CONV(ABS_CONV conv) tm;; let SUB_CONV = fun conv -> (COMB_CONV conv) ORELSEC (ABS_CONV conv) ORELSEC REFL;; let BINOP_CONV conv tm = let lop,r = dest_comb tm in let op,l = dest_comb lop in MK_COMB(AP_TERM op (conv l),conv r);; (* ------------------------------------------------------------------------- *) (* Depth conversions; internal use of a failure-propagating `Boultonized' *) (* version to avoid a great deal of reuilding of terms. *) (* ------------------------------------------------------------------------- *) let (ONCE_DEPTH_CONV: conv->conv), (DEPTH_CONV: conv->conv), (REDEPTH_CONV: conv->conv), (TOP_DEPTH_CONV: conv->conv), (TOP_SWEEP_CONV: conv->conv) = let THENQC conv1 conv2 tm = try let th1 = conv1 tm in try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 with Failure _ -> th1 with Failure _ -> conv2 tm and THENCQC conv1 conv2 tm = let th1 = conv1 tm in try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 with Failure _ -> th1 and COMB_QCONV conv tm = let l,r = dest_comb tm in try let th1 = conv l in try let th2 = conv r in MK_COMB(th1,th2) with Failure _ -> AP_THM th1 r with Failure _ -> AP_TERM l (conv r) in let rec REPEATQC conv tm = THENCQC conv (REPEATQC conv) tm in let SUB_QCONV conv tm = if is_abs tm then ABS_CONV conv tm else COMB_QCONV conv tm in let rec ONCE_DEPTH_QCONV conv tm = (conv ORELSEC (SUB_QCONV (ONCE_DEPTH_QCONV conv))) tm and DEPTH_QCONV conv tm = THENQC (SUB_QCONV (DEPTH_QCONV conv)) (REPEATQC conv) tm and REDEPTH_QCONV conv tm = THENQC (SUB_QCONV (REDEPTH_QCONV conv)) (THENCQC conv (REDEPTH_QCONV conv)) tm and TOP_DEPTH_QCONV conv tm = THENQC (REPEATQC conv) (THENCQC (SUB_QCONV (TOP_DEPTH_QCONV conv)) (THENCQC conv (TOP_DEPTH_QCONV conv))) tm and TOP_SWEEP_QCONV conv tm = THENQC (REPEATQC conv) (SUB_QCONV (TOP_SWEEP_QCONV conv)) tm in (fun c -> TRY_CONV (ONCE_DEPTH_QCONV c)), (fun c -> TRY_CONV (DEPTH_QCONV c)), (fun c -> TRY_CONV (REDEPTH_QCONV c)), (fun c -> TRY_CONV (TOP_DEPTH_QCONV c)), (fun c -> TRY_CONV (TOP_SWEEP_QCONV c));; (* ------------------------------------------------------------------------- *) (* Apply at leaves of op-tree; NB any failures at leaves cause failure. *) (* ------------------------------------------------------------------------- *) let rec DEPTH_BINOP_CONV op conv tm = try let l,r = dest_binop op tm in let lth = DEPTH_BINOP_CONV op conv l and rth = DEPTH_BINOP_CONV op conv r in MK_COMB(AP_TERM op lth,rth) with Failure "dest_binop" -> conv tm;; (* ------------------------------------------------------------------------- *) (* Follow a path. *) (* ------------------------------------------------------------------------- *) let PATH_CONV = let rec path_conv s cnv = match s with [] -> cnv | "l"::t -> RATOR_CONV (path_conv t cnv) | "r"::t -> RAND_CONV (path_conv t cnv) | _::t -> ABS_CONV (path_conv t cnv) in fun s cnv -> path_conv (explode s) cnv;; (* ------------------------------------------------------------------------- *) (* Follow a pattern *) (* ------------------------------------------------------------------------- *) let PAT_CONV = let rec PCONV xs pat conv = if mem pat xs then conv else if not(exists (fun x -> free_in x pat) xs) then ALL_CONV else if is_comb pat then COMB2_CONV (PCONV xs (rator pat) conv) (PCONV xs (rand pat) conv) else ABS_CONV (PCONV xs (body pat) conv) in fun pat -> let xs,pbod = strip_abs pat in PCONV xs pbod;; (* ------------------------------------------------------------------------- *) (* Symmetry conversion. *) (* ------------------------------------------------------------------------- *) let SYM_CONV tm = try let th1 = SYM(ASSUME tm) in let tm' = concl th1 in let th2 = SYM(ASSUME tm') in DEDUCT_ANTISYM_RULE th2 th1 with Failure _ -> failwith "SYM_CONV";; (* ------------------------------------------------------------------------- *) (* Conversion to a rule. *) (* ------------------------------------------------------------------------- *) let CONV_RULE (conv:conv) th = EQ_MP (conv(concl th)) th;; (* ------------------------------------------------------------------------- *) (* Substitution conversion. *) (* ------------------------------------------------------------------------- *) let SUBS_CONV ths tm = try if ths = [] then REFL tm else let lefts = map (lhand o concl) ths in let gvs = map (genvar o type_of) lefts in let pat = subst (zip gvs lefts) tm in let abs = list_mk_abs(gvs,pat) in let th = rev_itlist (fun y x -> CONV_RULE (RAND_CONV BETA_CONV THENC LAND_CONV BETA_CONV) (MK_COMB(x,y))) ths (REFL abs) in if rand(concl th) = tm then REFL tm else th with Failure _ -> failwith "SUBS_CONV";; (* ------------------------------------------------------------------------- *) (* Get a few rules. *) (* ------------------------------------------------------------------------- *) let BETA_RULE = CONV_RULE(REDEPTH_CONV BETA_CONV);; let GSYM = CONV_RULE(ONCE_DEPTH_CONV SYM_CONV);; let SUBS ths = CONV_RULE (SUBS_CONV ths);; (* ------------------------------------------------------------------------- *) (* A cacher for conversions. *) (* ------------------------------------------------------------------------- *) let CACHE_CONV = let ALPHA_HACK tm th = let tm' = lhand(concl th) in if tm' = tm then th else TRANS (ALPHA tm tm') th in fun conv -> let net = ref empty_net in fun tm -> try tryfind (ALPHA_HACK tm) (lookup tm (!net)) with Failure _ -> let th = conv tm in (net := enter [] (tm,th) (!net); th);; hol-light/Proofrecording/diffs/hol.ml000066400000000000000000000216461303454263000201470ustar00rootroot00000000000000(* ========================================================================= *) (* HOL LIGHT *) (* *) (* Modern OCaml version of the HOL theorem prover *) (* *) (* John Harrison *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) let hol_version = "2.20++";; let hol_dir = ref (try Sys.getenv "HOLLIGHT_DIR" with Not_found -> Sys.getcwd());; (* ------------------------------------------------------------------------- *) (* Should eventually change to "ref(Filename.temp_dir_name)". *) (* However that's not available in 3.08, which is still the default *) (* in Cygwin, and I don't want to force people to upgrade Ocaml. *) (* ------------------------------------------------------------------------- *) let temp_path = ref "/tmp";; (* ------------------------------------------------------------------------- *) (* Load in parsing extensions. *) (* For Ocaml < 3.10, use the built-in camlp4 *) (* and for Ocaml >= 3.10, use camlp5 instead. *) (* ------------------------------------------------------------------------- *) if let v = String.sub Sys.ocaml_version 0 4 in v = "3.10" or v = "3.11" then (Topdirs.dir_directory "+camlp5"; Topdirs.dir_load Format.std_formatter "camlp5o.cma") else (Topdirs.dir_load Format.std_formatter "camlp4o.cma");; Topdirs.dir_load Format.std_formatter (Filename.concat (!hol_dir) "pa_j.cmo");; (* ------------------------------------------------------------------------- *) (* Load files from system and/or user-settable directories. *) (* Paths map initial "$/" to !hol_dir dynamically; use $$ to get the actual *) (* $ character at the start of a directory. *) (* ------------------------------------------------------------------------- *) let use_file s = if Toploop.use_file Format.std_formatter s then () else (Format.print_string("Error in included file "^s); Format.print_newline());; let hol_expand_directory s = if s = "$" or s = "$/" then !hol_dir else if s = "$$" then "$" else if String.length s <= 2 then s else if String.sub s 0 2 = "$$" then (String.sub s 1 (String.length s - 1)) else if String.sub s 0 2 = "$/" then Filename.concat (!hol_dir) (String.sub s 2 (String.length s - 2)) else s;; let load_path = ref ["."; "$"];; let loaded_files = ref [];; let file_on_path p s = if not (Filename.is_relative s) then s else let p' = List.map hol_expand_directory p in let d = List.find (fun d -> Sys.file_exists(Filename.concat d s)) p' in Filename.concat (if d = "." then Sys.getcwd() else d) s;; let load_on_path p s = let s' = file_on_path p s in let fileid = (Filename.basename s',Digest.file s') in (use_file s'; loaded_files := fileid::(!loaded_files));; let loads s = load_on_path ["$"] s;; let loadt s = load_on_path (!load_path) s;; let needs s = let s' = file_on_path (!load_path) s in let fileid = (Filename.basename s',Digest.file s') in if List.mem fileid (!loaded_files) then Format.print_string("File \""^s^"\" already loaded\n") else loadt s;; (* ------------------------------------------------------------------------- *) (* Various tweaks to OCaml and general library functions. *) (* ------------------------------------------------------------------------- *) loads "system.ml";; (* Set up proper parsing and load bignums *) loads "lib.ml";; (* Various useful general library functions *) (* ------------------------------------------------------------------------- *) (* The logical core. *) (* ------------------------------------------------------------------------- *) loads "type.ml";; (* Abstract type of HOL types *) loads "term.ml";; (* Abstract type of HOL terms *) loads "proofobjects_init.ml";; (* Proof recording infrastructure *) loads "thm.ml";; (* Abstract type of HOL theorems: deductive system! *) (* ------------------------------------------------------------------------- *) (* Some extra support stuff needed outside the core. *) (* ------------------------------------------------------------------------- *) loads "basics.ml";; (* Additional syntax operations and other utilities *) loads "nets.ml";; (* Term nets for fast matchability-based lookup *) (* ------------------------------------------------------------------------- *) (* The interface. *) (* ------------------------------------------------------------------------- *) loads "preterm.ml";; (* Preterms and their interconversion with terms *) loads "parser.ml";; (* Lexer and parser *) loads "printer.ml";; (* Crude prettyprinter *) (* ------------------------------------------------------------------------- *) (* Higher level deductive system. *) (* ------------------------------------------------------------------------- *) loads "equal.ml";; (* Basic equality reasoning and conversionals *) loads "bool.ml";; (* Boolean theory and basic derived rules *) loads "drule.ml";; (* Additional derived rules *) loads "tactics.ml";; (* Tactics, tacticals and goal stack *) loads "itab.ml";; (* Toy prover for intuitionistic logic *) loads "simp.ml";; (* Basic rewriting and simplification tools. *) loads "theorems.ml";; (* Additional theorems (mainly for quantifiers) etc. *) loads "ind_defs.ml";; (* Derived rules for inductive definitions *) loads "class.ml";; (* Classical reasoning: Choice and Extensionality *) loads "trivia.ml";; (* Some very basic theories, e.g. type ":1" *) loads "canon.ml";; (* Tools for putting terms in canonical forms *) loads "meson.ml";; (* First order automation: MESON (model elimination) *) loads "quot.ml";; (* Derived rules for defining quotient types *) loads "recursion.ml";; (* Tools for primitive recursion on inductive types *) (* ------------------------------------------------------------------------- *) (* Mathematical theories and additional proof tools. *) (* ------------------------------------------------------------------------- *) loads "pair.ml";; (* Theory of pairs *) loads "nums.ml";; (* Axiom of Infinity, definition of natural numbers *) loads "arith.ml";; (* Natural number arithmetic *) loads "wf.ml";; (* Theory of wellfounded relations *) loads "calc_num.ml";; (* Calculation with natural numbers *) loads "normalizer.ml";; (* Polynomial normalizer for rings and semirings *) loads "grobner.ml";; (* Groebner basis procedure for most semirings. *) loads "ind_types.ml";; (* Tools for defining inductive types *) loads "lists.ml";; (* Theory of lists *) loads "realax.ml";; (* Definition of real numbers *) loads "calc_int.ml";; (* Calculation with integer-valued reals *) loads "realarith.ml";; (* Universal linear real decision procedure *) loads "real.ml";; (* Derived properties of reals *) loads "calc_rat.ml";; (* Calculation with rational-valued reals *) loads "int.ml";; (* Definition of integers *) loads "sets.ml";; (* Basic set theory. *) loads "iterate.ml"; (* Iterated operations *) loads "cart.ml";; (* Finite Cartesian products *) loads "define.ml";; (* Support for general recursive definitions *) (* ------------------------------------------------------------------------- *) (* The help system. *) (* ------------------------------------------------------------------------- *) loads "help.ml";; (* Online help using the entries in Help directory *) loads "database.ml";; (* List of name-theorem pairs for search system *) hol-light/Proofrecording/diffs/proofobjects_coq.ml000066400000000000000000002016271303454263000227250ustar00rootroot00000000000000(* ======================================================================================== *) (* Proof-objects for HOL-light, exportation to Coq *) (* *) (* Steven Obua, TU Mnchen, December 2004 *) (* Chantal Keller, Laboratoire d'Informatique de Polytechnique (France), January 2010 *) (* *) (* based on Sebastian Skalberg's HOL4 proof-objects *) (* ======================================================================================== *) #load "unix.cma";; #load "depgraph.cma";; module type Proofobject_primitives = sig type proof val proof_REFL : term -> proof val proof_TRANS : proof * proof -> proof val proof_MK_COMB : proof * proof -> proof val proof_ASSUME : term -> proof val proof_EQ_MP : proof -> proof -> proof val proof_IMPAS : proof -> proof -> proof val proof_DISCH : proof -> term -> proof val proof_DEDUCT_ANTISYM_RULE : proof * term -> proof * term -> proof val proof_BETA : term -> proof val proof_ABS : term -> proof -> proof val proof_INST_TYPE : (hol_type * hol_type) list -> proof -> proof val proof_INST : (term * term) list -> proof -> proof val proof_new_definition : string -> hol_type -> term -> proof val proof_CONJ : proof -> proof -> proof val proof_CONJUNCT1 : proof -> proof val proof_CONJUNCT2 : proof -> proof val proof_new_basic_type_definition : string -> string * string -> term * term -> proof -> proof val proof_SPEC : term -> proof -> proof val proof_SYM : proof -> proof val proof_GEN : proof -> term -> proof val proof_DISJ1 : proof -> term -> proof val proof_DISJ2 : proof -> term -> proof val proof_NOTI : proof -> proof val proof_NOTE : proof -> proof val proof_CONTR : proof -> term -> proof val proof_DISJCASES : proof -> proof -> proof -> proof val proof_CHOOSE : term -> proof -> proof -> proof val proof_EXISTS : term -> term -> proof -> proof val new_axiom_name : string -> string val proof_new_axiom : string -> term -> proof val save_proof : string -> proof -> (term option) -> unit val proof_database : unit -> ((string * proof * (term option)) list) val export_saved_proofs : unit -> unit val export_one_proof : string -> unit val export_list : string list -> unit end;; module Proofobjects : Proofobject_primitives = struct let THEORY_NAME = "hollight";; (****** Utilities ******) (* this is a little bit dangerous, because the function is not injective, but I guess one can live with that *) let modify = function | "/" -> "_slash_" | "\\" -> "_backslash_" | "=" -> "_equal_" | ">" -> "_greaterthan_" | "<" -> "_lessthan_" | "?" -> "_questionmark_" | "!" -> "_exclamationmark_" | "*" -> "_star_" | "~" -> "_tilde_" | "," -> "_comma_" | "@" -> "_at_" | "+" -> "_plus_" | "-" -> "_minus_" | "%" -> "_percent_" | "$" -> "_dollar_" | "." -> "_dot_" | "'" -> "_quote_" | "|" -> "_pipe_" | ":" -> "_colon_" | s -> s;; let mfc s = implode (map modify (explode s));; let ensure_export_directory thyname = let dir = Sys.getenv "HOLPROOFEXPORTDIR" in let dirsub = Filename.concat dir "hollight" in let dirsubsub = Filename.concat dirsub thyname in let mk d = if Sys.file_exists d then () else Unix.mkdir d 509 in mk dir; mk dirsub; mk dirsubsub; dirsubsub;; (****** Proofs ******) type proof_info_rec = {disk_info: (string * string) option ref; status: int ref; references: int ref; queued: bool ref};; type proof_info = Info of proof_info_rec;; type proof = | Proof of (proof_info * proof_content * (unit -> unit)) and proof_content = | Prefl of term | Pbeta of string * hol_type * term | Pinstt of proof * (string * hol_type) list | Pabs of proof * string * hol_type | Pdisch of proof * term | Phyp of term | Pspec of proof * term | Pinst of proof * (string * hol_type * term) list | Pgen of proof * string * hol_type | Psym of proof | Ptrans of proof * proof | Pcomb of proof * proof | Peqmp of proof * proof | Pexists of proof * term * term | Pchoose of string * hol_type * proof * proof | Pconj of proof * proof | Pconjunct1 of proof | Pconjunct2 of proof | Pdisj1 of proof * term | Pdisj2 of proof * term | Pdisjcases of proof * proof * proof | Pnoti of proof | Pnote of proof | Pcontr of proof * term | Pimpas of proof * proof | Paxm of string * term | Pdef of string * hol_type * term | Ptyintro of hol_type * string * hol_type list * string * string * term;; let content_of (Proof (_,p,_)) = p;; let inc_references (Proof(Info{references=r},_,_) as p) = incr r; p;; let mk_proof p = Proof(Info {disk_info = ref None; status = ref 0; references = ref 0; queued = ref false}, p, fun () -> ());; let global_ax_counter = let counter = ref 1 in let f = fun () -> (incr counter; !counter - 1) in f;; let new_axiom_name n = "ax_"^n^"_"^(string_of_int (global_ax_counter () ));; (* corresponds to REFL *) let proof_REFL t = mk_proof (Prefl t);; (* corresponds to TRANS, with a simple improvment *) let proof_TRANS (p,q) = match (content_of p, content_of q) with | (Prefl _,_) -> q | (_, Prefl _) -> p | _ -> mk_proof (Ptrans (inc_references p, inc_references q));; (* corresponds to MK_COMB -> Pcomb *) let proof_MK_COMB (p1,p2) = match (content_of p1, content_of p2) with | (Prefl tm1, Prefl tm2) -> mk_proof (Prefl (mk_comb (tm1, tm2))) | _ -> mk_proof (Pcomb (inc_references p1, inc_references p2));; (* corresponds to ASSUME -> Phyp *) let proof_ASSUME t = mk_proof (Phyp t);; (* corresponds to EQ_MP, with a simple improvment *) let proof_EQ_MP p q = match content_of p with | Prefl _ -> q | _ -> mk_proof (Peqmp(inc_references p, inc_references q));; (* corresponds to IMP_ANTISYM_RULE th1 th2 not a base rule used only in the extended mode *) (* A1 |- t1 ==> t2 A2 |- t2 ==> t1 *) (* ------------------------------------- IMP_ANTISYM_RULE *) (* A1 u A2 |- t1 <=> t2 *) let proof_IMPAS p1 p2 = mk_proof (Pimpas (inc_references p1, inc_references p2));; (* corresponds to DISCH not a base rule used only in the extended mode *) (* A |- t *) (* -------------------- DISCH `u` *) (* A - {u} |- u ==> t *) let proof_DISCH p t = mk_proof (Pdisch(inc_references p, t));; (* corresponds to DEDUCT_ANTISYM_RULE *) (* made with IMPAS and DISCH (whereas in HOL-Light IMPAS is made with DAR and UNDISCH...) *) (* A |- p B |- q *) (* ---------------------------------- *) (* (A - {q}) u (B - {p}) |- p <=> q *) let proof_DEDUCT_ANTISYM_RULE (p1,t1) (p2,t2) = proof_IMPAS (proof_DISCH p1 t2) (proof_DISCH p2 t1);; (* BETA is a base rule *) let proof_BETA tm = try let f,_ = dest_comb tm in let v,bod = dest_abs f in let (x, ty) = dest_var v in mk_proof (Pbeta (x, ty, bod)) with | _ -> failwith "proof_BETA" (* corresponds to ABS, with a simple improvment *) let proof_ABS x p = match x with | Var(s, ty) -> mk_proof (Pabs(inc_references p, s, ty)) | _ -> failwith "proof_ABS: not a variable";; (* corresponds to INST_TYPE -> Pinstt *) let proof_INST_TYPE s p = mk_proof (Pinstt(inc_references p, List.map ( fun (ty1, ty2) -> match ty2 with | Tyvar s -> (s, ty1) | _ -> failwith "proof_INST_TYPE: some redex is not a type variable" ) s));; (* corresponds to INST *) let proof_INST s p = mk_proof (Pinst(inc_references p, List.map ( fun (t1, t2) -> match t2 with | Var(s, ty) -> (s, ty, t1) | _ -> failwith "proof_INST: some redex is not a term variable" ) s));; (* proof_new_definition is called in Thm.new_basic_definition. This latter helps to define basic concepts such as T, AND... (almost everything in Bool)... and to define derived rules!! -> Pdef *) let proof_new_definition cname ty t = mk_proof (Pdef (cname, ty, t));; (* proof_new_axiom is called in Thm.new_axiom. This latter transforms a term of type bool into a theorem. The main three axioms are ETA_AX, SELECT_AX and INFINITY_AX. The other axiom is ax (in drule.ml) -> Paxm *) let proof_new_axiom axname t = mk_proof (Paxm (axname, t));; (* corresponds to CONJ not a base rule used only in the extended mode *) let proof_CONJ p1 p2 = mk_proof (Pconj (inc_references p1, inc_references p2));; (* corresponds to CONJUNCT1 not a base rule used only in the extended mode also used in Thm.new_basic_definition *) let proof_CONJUNCT1 p = mk_proof (Pconjunct1 (inc_references p));; (* corresponds to CONJUNCT2 not a base rule used only in the extended mode also used in Thm.new_basic_definition *) let proof_CONJUNCT2 p = mk_proof (Pconjunct2 (inc_references p));; (* used only in Thm.new_basic_definition for the same purpose as for CONJUNCTi -> Ptyintro *) let proof_new_basic_type_definition tyname (absname, repname) (pt,tt) _ = let rty = type_of tt in let tyvars = sort (<=) (type_vars_in_term pt) in mk_proof(Ptyintro(rty, tyname, tyvars, absname, repname, pt));; (* ---- used only in substitute_proof calls ---- *) (* corresponds to Bool.SPEC, the !-elimination rule *) let proof_SPEC s p = mk_proof (Pspec(inc_references p, s));; (* corresponds to Equal.SYM, the symmetry rule *) let proof_SYM p = mk_proof (Psym(inc_references p));; (* corresponds to Bool.GEN, the !-introduction rule *) let proof_GEN p a = match a with | Var(s, ty) -> mk_proof (Pgen(inc_references p, s, ty)) | _ -> failwith "proof_GEN: not a term variable";; (* corresponds to Bool.DISJ1, the \/-left introduction rule *) let proof_DISJ1 p a = mk_proof (Pdisj1 (inc_references p, a));; (* corresponds to Bool.DISJ2, the \/-right introduction rule *) let proof_DISJ2 p a = mk_proof (Pdisj2 (inc_references p, a));; (* corresponds to Bool.NOT_INTRO, the following rule: *) (* A |- t ==> F *) (* -------------- NOT_INTRO *) (* A |- ~t *) let proof_NOTI p = mk_proof (Pnoti (inc_references p));; (* corresponds to Bool.NOT_ELIM, the following rule: *) (* A |- ~t *) (* -------------- NOT_ELIM *) (* A |- t ==> F *) let proof_NOTE p = mk_proof (Pnote (inc_references p));; (* corresponds to Bool.CONTR, the intuitionistic F-elimination rule: *) (* A |- F *) (* -------- CONTR `t` *) (* A |- t *) let proof_CONTR p a = mk_proof (Pcontr (inc_references p, a));; (* corresponds to Bool.DISJ_CASES, the \/-elimination rule: *) (* A |- t1 \/ t2 A1 u {t1} |- t A2 u {t2} |- t *) (* ------------------------------------------------------ DISJ_CASES *) (* A u A1 u A2 |- t *) let proof_DISJCASES p q r = mk_proof (Pdisjcases (inc_references p, inc_references q, inc_references r));; (* corresponds to Bool.CHOOSE, the ?-elimination rule: *) (* A1 |- ?x. s[x] A2 |- t *) (* ------------------------------- CHOOSE (`v`,(A1 |- ?x. s)) *) (* A1 u (A2 - {s[v/x]}) |- t *) (* Where v is not free in A2 - {s[v/x]} or t. *) let proof_CHOOSE a p q = let (x,ty) = dest_var a in mk_proof (Pchoose (x, ty, inc_references p, inc_references q));; (* corresponds to Bool.EXISTS, the ?-introduction rule: *) (* A |- p[u/x] *) (* ------------- EXISTS (`?x. p`,`u`) *) (* A |- ?x. p *) (* x is p, y is u *) let proof_EXISTS etm y p = let _,x = dest_comb etm in mk_proof (Pexists (inc_references p, x, y));; (****** Utilities for exportation ******) let content_of (Proof (_,x,_)) = x;; let disk_info_of (Proof(Info {disk_info=di},_,_)) = !di;; let set_disk_info_of (Proof(Info {disk_info=di},_,_)) thyname thmname = di := Some (thyname,thmname);; let reset_disk_info_of1 ((Proof(Info {disk_info=di}, _, _)) as p) = di := None; p;; let reset_disk_info_of2 (Proof(Info {disk_info=di}, _, _)) = di := None;; let references (Proof (Info info,_,_)) = !(info.references);; let glob_counter = ref 0;; let get_counter () = incr glob_counter; !glob_counter;; let get_iname = string_of_int o get_counter;; let next_counter () = !glob_counter;; let trivial p = match (content_of p) with | Prefl _ -> true | Pbeta _ -> true | Paxm _ -> true | Phyp _ -> true | _ -> false;; let do_share p = references p > 1 && not (trivial p);; (****** Types and terms modification ******) let idT = Hashtbl.create 17;; let defT = Hashtbl.create 17;; let idT_ref = ref 1;; let defT_ref = ref 1;; let make_idT x = try Hashtbl.find idT x with | Not_found -> let n = !idT_ref in incr idT_ref; Hashtbl.add idT x n; n;; let make_defT x = try Hashtbl.find defT x with | Not_found -> let n = !defT_ref in incr defT_ref; Hashtbl.add defT x n; n;; type ntype = | Ntvar of int | Nbool | Nnum | Narrow of ntype * ntype | Ntdef of int * ntype list;; let rec hol_type2ntype = function | Tyvar x -> Ntvar (make_idT x) | Tyapp (s, _) when s = "bool" -> Nbool (* | Tyapp (s, _) when s = "ind" -> Nnum *) | Tyapp (s, l) when s = "fun" -> (match l with | [a;b] -> Narrow (hol_type2ntype a, hol_type2ntype b) | _ -> failwith "hol_type2ntype: wrong number of arguments for fun") | Tyapp (s, l) -> Ntdef (make_defT s, List.map hol_type2ntype l);; let idV = Hashtbl.create 17;; let defV = Hashtbl.create 17;; let idV_ref = ref 1;; let defV_ref = ref 1;; let make_idV x X = try fst (Hashtbl.find idV x) with | Not_found -> let n = !idV_ref in incr idV_ref; Hashtbl.add idV x (n,X); n;; let make_defV x X f = try let (a,_,_) = (Hashtbl.find defV x) in a with | Not_found -> let n = !defV_ref in incr defV_ref; Hashtbl.add defV x (n,X,f); n;; type ncst = | Heq of ntype | Heps of ntype | Hand | Hor | Hnot | Himp | Htrue | Hfalse | Hforall of ntype | Hexists of ntype;; type nterm = | Ndbr of int | Nvar of int * ntype | Ncst of ncst | Ndef of int * ntype | Napp of nterm * nterm | Nabs of ntype * nterm;; let rec ext_var x (ty: ntype) i = function | [] -> Nvar (make_idV x ty, ty) | (y,typ)::l -> if ((x = y) && (ty = typ)) then Ndbr i else ext_var x ty (i+1) l;; let rec term2nterm l = function | Var (x, ty) -> ext_var x (hol_type2ntype ty) 0 l | Comb (t1, t2) -> Napp (term2nterm l t1, term2nterm l t2) | Abs (t1, t2) -> (match t1 with | Var (x, ty) -> let typ = hol_type2ntype ty in Nabs (typ, term2nterm ((x,typ)::l) t2) | _ -> failwith "term2nterm: first argument of an abstraction is not a variable") | Const (s, ty) when s = "=" -> (match hol_type2ntype ty with | Narrow(a, _) -> Ncst (Heq a) | _ -> failwith "term2nterm: constant = must have arrow type") | Const (s, ty) when s = "@" -> (match hol_type2ntype ty with | Narrow(_, a) -> Ncst (Heps a) | _ -> failwith "term2nterm: constant @ must have arrow type") | Const (s, ty) when s = "/\\" -> Ncst Hand | Const (s, ty) when s = "\\/" -> Ncst Hor | Const (s, ty) when s = "~" -> Ncst Hnot | Const (s, ty) when s = "==>" -> Ncst Himp | Const (s, ty) when s = "T" -> Ncst Htrue | Const (s, ty) when s = "F" -> Ncst Hfalse | Const (s, ty) when s = "_FALSITY_" -> Ncst Hfalse | Const (s, ty) when s = "!" -> (match hol_type2ntype ty with | Narrow(Narrow (a, _), _) -> Ncst (Hforall a) | _ -> failwith "term2nterm: constant ! must have arrow type") | Const (s, ty) when s = "?" -> (match hol_type2ntype ty with | Narrow(Narrow (a, _), _) -> Ncst (Hexists a) | _ -> failwith "term2nterm: constant ? must have arrow type") | Const (s, ty) -> let typ = hol_type2ntype ty in Ndef(make_defV s typ true, typ);; let term2nterm t = term2nterm [] t;; (****** Proof exportation ******) let rec print_list out str snil scons = function | [] -> out snil | t::q -> out "("; out scons; out " "; str t; out " "; print_list out str snil scons q; out ")";; let print_names out x = out (string_of_int x); out "%positive";; let print_type (out: string -> unit) ty = let rec print_ntype = function | Ntvar x -> out "(TVar "; print_names out x; out ")" | Nbool -> out "Bool" | Nnum -> out "Num" | Narrow(a, b) -> out "("; print_ntype a; out " --> "; print_ntype b; out ")" | Ntdef(s, l) -> out "(TDef "; print_names out s; out " "; print_list out print_ntype "Tnil" "Tcons" l; out ")" in print_ntype ty;; let print_cst out = function | Heq ty -> out "(Heq "; print_type out ty; out ")" | Heps ty -> out "(Heps "; print_type out ty; out ")" | Hand -> out "Hand" | Hor -> out "Hor" | Hnot -> out "Hnot" | Himp -> out "Himp" | Htrue -> out "Htrue" | Hfalse -> out "Hfalse" | Hforall ty -> out "(Hforall "; print_type out ty; out ")" | Hexists ty -> out "(Hexists "; print_type out ty; out ")";; let print_term out t = let rec print_nterm = function | Ndbr n -> out "(Dbr "; out (string_of_int n); out ")" | Nvar(x, ty) -> out "(Var "; print_names out x; out " "; print_type out ty; out ")" | Ncst c -> out "(Cst "; print_cst out c; out ")" | Ndef(a, ty) -> out "(Def "; print_names out a; out " "; print_type out ty; out ")" | Napp(t1, t2) -> out "(App "; print_nterm t1; out " "; print_nterm t2; out ")" | Nabs(ty, t) -> out "(Abs "; print_type out ty; out " "; print_nterm t; out ")" in print_nterm t;; (* Exportation *) let total = ref 0;; type nproof_content = | Nprefl of nterm | Npbeta of int * ntype * nterm | Npinstt of nproof_content * (int * ntype) list | Npabs of nproof_content * int * ntype | Npdisch of nproof_content * nterm | Nphyp of nterm | Npspec of nproof_content * nterm | Npinst of nproof_content * (int * ntype * nterm) list | Npgen of nproof_content * int * ntype | Npsym of nproof_content | Nptrans of nproof_content * nproof_content | Npcomb of nproof_content * nproof_content | Npeqmp of nproof_content * nproof_content | Npexists of nproof_content * nterm * nterm | Npchoose of int * ntype * nproof_content * nproof_content | Npconj of nproof_content * nproof_content | Npconjunct1 of nproof_content | Npconjunct2 of nproof_content | Npdisj1 of nproof_content * nterm | Npdisj2 of nproof_content * nterm | Npdisjcases of nproof_content * nproof_content * nproof_content | Npnoti of nproof_content | Npnote of nproof_content | Npcontr of nproof_content * nterm | Npimpas of nproof_content * nproof_content | Npaxm of string * nterm | Npdef of int * ntype * nterm | Nptyintro of ntype * ntype * int * int * nterm | Nfact of string;; let the_types = Hashtbl.create 17;; let count_types = ref (-1);; let share_types out ty = let rec share_types ty = try Hashtbl.find the_types ty with | Not_found -> incr count_types; let name = THEORY_NAME^"_type_"^(string_of_int !count_types) in (match ty with | Narrow(a,b) -> let n1 = share_types a in let n2 = share_types b in out "\nDefinition "; out name; out " := "; out n1; out " --> "; out n2; out "." | Ntdef(i,l) -> let names = List.map share_types l in out "\nDefinition "; out name; out " := TDef "; print_names out i; out " "; print_list out out "Tnil" "Tcons" names; out "." | t -> out "\nDefinition "; out name; out " := "; print_type out t; out "."); Hashtbl.add the_types ty name; name in share_types ty;; let the_terms = Hashtbl.create 17;; let count_terms = ref (-1);; let share_csts out out_types name = function | Heq a -> let n = share_types out_types a in out "\nDefinition "; out name; out " := Cst (Heq "; out n; out ")." | Heps a -> let n = share_types out_types a in out "\nDefinition "; out name; out " := Cst (Heps "; out n; out ")." | Hand -> out "\nDefinition "; out name; out " := Cst Hand." | Hor -> out "\nDefinition "; out name; out " := Cst Hor." | Hnot -> out "\nDefinition "; out name; out " := Cst Hnot." | Himp -> out "\nDefinition "; out name; out " := Cst Himp." | Htrue -> out "\nDefinition "; out name; out " := Cst Htrue." | Hfalse -> out "\nDefinition "; out name; out " := Cst Hfalse." | Hforall a -> let n = share_types out_types a in out "\nDefinition "; out name; out " := Cst (Hforall "; out n; out ")." | Hexists a -> let n = share_types out_types a in out "\nDefinition "; out name; out " := Cst (Hexists "; out n; out ")." let share_terms out out_types tm = let rec share_terms tm = try Hashtbl.find the_terms tm with | Not_found -> incr count_terms; let name = THEORY_NAME^"_term_"^(string_of_int !count_terms) in (match tm with | Napp(t1,t2) -> let n1 = share_terms t1 in let n2 = share_terms t2 in out "\nDefinition "; out name; out " := App "; out n1; out " "; out n2; out "." | Nabs(ty,t) -> let n = share_terms t in let ny = share_types out_types ty in out "\nDefinition "; out name; out " := Abs "; out ny; out " "; out n; out "." | Nvar(i,ty) -> let ny = share_types out_types ty in out "\nDefinition "; out name; out " := Var "; print_names out i; out " "; out ny; out "." | Ndef(i,ty) -> let ny = share_types out_types ty in out "\nDefinition "; out name; out " := Def "; print_names out i; out " "; out ny; out "." | Ncst c -> share_csts out out_types name c | t -> out "\nDefinition "; out name; out " := "; print_term out t; out "."); Hashtbl.add the_terms tm name; name in share_terms tm;; let export_proof out share_type share_term p = let rec wp = function | Nprefl tm -> let tm2 = share_term tm in out "(Prefl "; out tm2; out ")" | Npbeta (n, ty, tm) -> let tm2 = share_term tm in let ty2 = share_type ty in out "(Pbeta "; print_names out n; out " "; out ty2; out " "; out tm2; out ")" | Npinstt(p,lambda) -> out "(Pinstt "; wp p; out " "; print_list out (fun (s, ty) -> let ty2 = share_type ty in out "("; print_names out s; out ", "; out ty2; out ")") "nil" "cons" lambda; out ")" | Npabs(p,x,ty) -> let ty2 = share_type ty in out "(Pabs "; wp p; out " "; print_names out x; out " "; out ty2; out ")" | Npdisch(p,tm) -> let tm2 = share_term tm in out "(Pdisch "; wp p; out " "; out tm2; out ")" | Nphyp tm -> let tm2 = share_term tm in out "(Phyp "; out tm2; out ")" | Npaxm(_, _) -> () | Npdef(_, _, _) -> () | Nptyintro(_, _, _, _, _) -> () | Npspec(p,t) -> let t2 = share_term t in out "(Pspec "; wp p; out " "; out t2; out ")" | Npinst(p,theta) -> out "(Pinst "; wp p; out " "; print_list out (fun (s, ty, t) -> let t2 = share_term t in let ty2 = share_type ty in out "("; print_names out s; out ", "; out ty2; out ", "; out t2; out ")") "nil" "cons" theta; out ")" | Npgen(p,x,ty) -> let ty2 = share_type ty in out "(Pgen "; wp p; out " "; print_names out x; out " "; out ty2; out ")" | Npsym p -> out "(Psym "; wp p; out ")" | Nptrans(p1,p2) -> out "(Ptrans "; wp p1; out " "; wp p2; out ")" | Npcomb(p1,p2) -> out "(Pcomb "; wp p1; out " "; wp p2; out ")" | Npeqmp(p1,p2) -> out "(Peqmp "; wp p1; out " "; wp p2; out ")" | Npexists(p,ex,w) -> let ex2 = share_term ex in let w2 = share_term w in out "(Pexists "; wp p; out " "; out ex2; out " "; out w2; out ")" | Npchoose(x,ty,p1,p2) -> let ty2 = share_type ty in out "(Pchoose "; print_names out x; out " "; out ty2; out " "; wp p1; out " "; wp p2; out ")" | Npconj(p1,p2) -> out "(Pconj "; wp p1; out " "; wp p2; out ")" | Npimpas(p1,p2) -> out "(Pimpas "; wp p1; out " "; wp p2; out ")" | Npconjunct1 p -> out "(Pconjunct1 "; wp p; out ")" | Npconjunct2 p -> out "(Pconjunct2 "; wp p; out ")" | Npdisj1(p,tm) -> let tm2 = share_term tm in out "(Pdisj1 "; wp p; out " "; out tm2; out ")" | Npdisj2(p,tm) -> let tm2 = share_term tm in out "(Pdisj2 "; wp p; out " "; out tm2; out ")" | Npdisjcases(p1,p2,p3) -> out "(Pdisjcases "; wp p1; out " "; wp p2; out " "; wp p3; out ")" | Npnoti p -> out "(Pnoti "; wp p; out ")" | Npnote p -> out "(Pnote "; wp p; out ")" | Npcontr(p,tm) -> let tm2 = share_term tm in out "(Pcontr "; wp p; out " "; out tm2; out ")" | Nfact(thm) -> out "(Poracle "; out thm; out "_def)" in wp p;; let export_ht out share_term h t thmname = out "\n\n\nDefinition "; out thmname; out "_h := "; (match h with | [] -> out "hyp_empty" | _ -> print_list out (fun tm -> let tm2 = share_term tm in out tm2) "nil" "cons" h); out ".\n\nDefinition "; out thmname; out "_t := "; let t2 = share_term t in out t2; out ".";; let export_lemma out share_type share_term p thmname = out "\n\nLemma "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.\nProof.\n vm_cast_no_check (proof2deriv_correct "; export_proof out share_type share_term p; out ").\nQed.";; let export_lemma_def out tree thmname = out "\n\nLemma "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.\nProof.\n vm_cast_no_check (proof2deriv_correct "; out tree; out ").\nQed.";; let export_sig out thmname = out "\n\nDefinition "; out thmname; out "_def := my_exist "; out thmname; out "_lemma.";; let export_def out thmname = out "\n\nParameter "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.";; let export_tdef out thmname = out "\n\nParameter "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.";; let export_axiom out thmname = out "\n\nAxiom "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.";; (* Transforming a proof into a derivation *) let rec opt_nth n l = match (n, l) with | 0, (x::_) -> Some x | 0, [] -> None | p, (_::l) -> opt_nth (p-1) l | _, _ -> None;; let type_cst = function | Heq a -> Narrow(a, Narrow(a, Nbool)) | Heps a -> Narrow(Narrow(a, Nbool), a) | Hand -> Narrow(Nbool, Narrow(Nbool, Nbool)) | Hor -> Narrow(Nbool, Narrow(Nbool, Nbool)) | Hnot -> Narrow(Nbool, Nbool) | Himp -> Narrow(Nbool, Narrow(Nbool, Nbool)) | Htrue -> Nbool | Hfalse -> Nbool | Hforall a -> Narrow(Narrow(a, Nbool), Nbool) | Hexists a -> Narrow(Narrow(a, Nbool), Nbool);; let rec infer g = function | Ndbr n -> opt_nth n g | Nvar (_, a) -> Some a | Ncst c -> Some (type_cst c) | Ndef (_, a) -> Some a | Napp (t1, t2) -> (match infer g t1, infer g t2 with | Some (Narrow (u1, u2)), Some v -> if u1 = v then Some u2 else None | _, _ -> None) | Nabs (a, u) -> (match infer (a::g) u with | Some b -> Some (Narrow (a, b)) | None -> None);; let rec close_aux t x a i = match t with | Ndbr n -> Ndbr (if n < i then n else n+1) | Nvar (y, b) -> if ((x = y) && (a = b)) then Ndbr i else Nvar (y, b) | Napp (t1, t2) -> Napp (close_aux t1 x a i, close_aux t2 x a i) | Nabs (b, u) -> Nabs(b, close_aux u x a (i+1)) | u -> u;; let close t x a = close_aux t x a 0;; let rec subst_idt_type_aux x = function | [] -> Ntvar x | (y,a)::q -> if x = y then a else subst_idt_type_aux x q;; let rec subst_idt_type t s = match t with | Ntvar x -> subst_idt_type_aux x s | Ntdef (a, l) -> Ntdef (a, subst_idt_list_type l s) | Narrow (a, b) -> Narrow (subst_idt_type a s, subst_idt_type b s) | u -> u and subst_idt_list_type l s = List.map (fun t -> subst_idt_type t s) l;; let rec subst_idt t s = match t with | Nvar (x, y) -> Nvar (x, subst_idt_type y s) | Ncst (Heq a) -> Ncst (Heq (subst_idt_type a s)) | Ncst (Heps a) -> Ncst (Heps (subst_idt_type a s)) | Ncst (Hforall a) -> Ncst (Hforall (subst_idt_type a s)) | Ncst (Hexists a) -> Ncst (Hexists(subst_idt_type a s)) | Ndef (c, d) -> Ndef (c, subst_idt_type d s) | Napp (t1, t2) -> Napp (subst_idt t1 s, subst_idt t2 s) | Nabs (a, t) -> Nabs (subst_idt_type a s, subst_idt t s) | u -> u;; let subst_idt_context g s = List.map (fun a -> subst_idt_type a s) g;; let rec subst_idv_aux x y s = match s with | [] -> Nvar (x, y) | (z, t, u)::q -> if ((x = z) && (y = t)) then u else subst_idv_aux x y q;; let rec subst_idv t s = match t with | Nvar (x, y) -> subst_idv_aux x y s | Napp (t1, t2) -> Napp (subst_idv t1 s, subst_idv t2 s) | Nabs (a, t) -> Nabs (a, subst_idv t s) | u -> u;; let rec wf_substitution_idv = function | [] -> true | (_,y,t)::q -> match infer [] t with | Some z -> if (y = z) then wf_substitution_idv q else false | None -> false;; let rec is_not_free x y = function | Nvar (z, t) -> (x != z) or (not (y = t)) | Napp (t1, t2) -> (is_not_free x y t1) && (is_not_free x y t2) | Nabs (_, u) -> is_not_free x y u | _ -> true;; let rec lift_term u i j = match u with | Ndbr n -> if n >= i then Ndbr (j + n) else Ndbr n | Napp (u1, u2) -> Napp (lift_term u1 i j, lift_term u2 i j) | Nabs (a, t) -> Nabs (a, lift_term t (i+1) j) | u -> u;; let rec subst_db t n u = match t with | Ndbr i -> if i < n then Ndbr i else if i = n then u else Ndbr (i-1) | Napp (t1, t2) -> Napp (subst_db t1 n u, subst_db t2 n u) | Nabs (a, t) -> Nabs (a, subst_db t (n+1) (lift_term u 0 1)) | u -> u;; let nopen t u = subst_db t 0 u;; let heq a t u = Napp (Napp (Ncst (Heq a), t), u);; let hequiv t u = Napp (Napp (Ncst (Heq Nbool), t), u);; let himp t u = Napp (Napp (Ncst Himp, t), u);; let hand t u = Napp (Napp (Ncst Hand, t), u);; let hor t u = Napp (Napp (Ncst Hor, t), u);; let hnot t = Napp (Ncst Hnot, t);; let htrue = Ncst Htrue;; let hfalse = Ncst Hfalse;; let hforall a p = Napp (Ncst (Hforall a), Nabs (a, p));; let hexists a p = Napp (Ncst (Hexists a), Nabs (a, p));; let hyp_empty = [];; let rec hyp_remove e = function | [] -> [] | t::q -> if (e = t) then q else t::(hyp_remove e q);; let rec hyp_add e = function | [] -> [e] | t::q -> if (e = t) then t::q else t::(hyp_add e q);; let hyp_union l m = List.fold_left (fun n e -> hyp_add e n) m l;; let hyp_map f l = List.fold_left (fun m e -> hyp_add (f e) m) [] l;; let hyp_singl e = [e];; let rec hyp_is_not_free x y = function | [] -> true | t::q -> (is_not_free x y t) && (hyp_is_not_free x y q);; let hyp_subst_idt h s = hyp_map (fun t -> subst_idt t s) h;; let hyp_subst_idv h s = hyp_map (fun t -> subst_idv t s) h;; let rec eq_type a b = match (a,b) with | Ntvar i, Ntvar j -> i = j | Nbool, Nbool -> true | Nnum, Nnum -> true | Narrow(a1, b1), Narrow(a2, b2) -> (eq_type a1 a2) && (eq_type b1 b2) | Ntdef(i,l), Ntdef(j,m) -> (i = j) && (eq_list_type l m) | _, _ -> false and eq_list_type l m = match (l,m) with | [], [] -> true | t1::q1, t2::q2 -> (eq_type t1 t2) && (eq_list_type q1 q2) | _, _ -> false;; let eq_cst a b = match (a,b) with | Heq a, Heq b -> eq_type a b | Heps a, Heps b -> eq_type a b | Hand, Hand -> true | Hor, Hor -> true | Hnot, Hnot -> true | Himp, Himp -> true | Htrue, Htrue -> true | Hfalse, Hfalse -> true | Hforall a, Hforall b -> eq_type a b | Hexists a, Hexists b -> eq_type a b | _, _ -> false;; let rec eq_term a b = match (a,b) with | Ndbr i, Ndbr j -> i = j | Nvar(i,a), Nvar(j,b) -> (i = j) && (eq_type a b) | Ncst c, Ncst d -> eq_cst c d | Ndef(i,a), Ndef(j,b) -> (i = j) && (eq_type a b) | Napp(a1,b1), Napp(a2,b2) -> (eq_term a1 a2) && (eq_term b1 b2) | Nabs(t1,a1), Nabs(t2,a2) -> (eq_type t1 t2) && (eq_term a1 a2) | _, _ -> false;; let derivs = Hashtbl.create 17;; let rec proof2deriv = function | Nprefl t -> (match infer [] t with | Some a -> Some (hyp_empty, heq a t t) | None -> (print_string "Nprefl\n"); None) | Npbeta (x, y, t) -> (match infer [] t with | Some a -> Some (hyp_empty, heq a (Napp (Nabs (y, close t x y), Nvar (x, y))) t) | None -> (print_string "Npbeta\n"); None) | Npinstt (q, l) -> (match proof2deriv q with | Some (h,v) -> Some (hyp_subst_idt h l, subst_idt v l) | None -> (print_string "Npinstt\n"); None) | Npabs (q, x, y) -> (match proof2deriv q with | Some (h, t) -> (match t with | Napp (Napp (Ncst (Heq a), t1), t2) -> if hyp_is_not_free x y h then Some (h, heq (Narrow (y, a)) (Nabs (y, close t1 x y)) (Nabs (y, close t2 x y))) else ((print_string "Npabs\n"); None) | _ -> (print_string "Npabs\n"); None) | None -> (print_string "Npabs\n"); None) | Npdisch (q, t) -> (match proof2deriv q, infer [] t with | Some (h, u), Some Nbool -> Some (hyp_remove t h, himp t u) | _, _ -> (print_string "Npdisch\n"); None) | Nphyp t -> (match infer [] t with | Some Nbool -> Some (hyp_singl t, t) | _ -> (print_string "Nphyp\n"); None) | Npspec (q, t) -> (match proof2deriv q, infer [] t with | Some (h, u), Some a -> (match u with | Napp (Ncst (Hforall b), Nabs (c, v)) -> if ((eq_type a b) && (eq_type b c)) then Some (h, nopen v t) else ((print_string "Npspec\n"); None) | _ -> (print_string "Npspec\n"); None) | _, _ -> (print_string "Npspec\n"); None) | Npinst (q, l) -> (match proof2deriv q, wf_substitution_idv l with | Some (h, v), true -> Some (hyp_subst_idv h l, subst_idv v l) | _, _ -> (print_string "Npinst\n"); None) | Npgen (q, x, y) -> (match proof2deriv q with | Some (h, t) -> if hyp_is_not_free x y h then Some (h, hforall y (close t x y)) else ((print_string "Npgen\n"); None) | None -> (print_string "Npgen\n"); None) | Npsym q -> (match proof2deriv q with | Some (h, t) -> (match t with | Napp (Napp (Ncst (Heq a), u), v) -> Some (h, heq a v u) | _ -> (print_string "Npsym\n"); None) | None -> (print_string "Npsym\n"); None) | Nptrans (q1, q2) -> (match proof2deriv q1, proof2deriv q2 with | Some (h1, t1), Some (h2, t2) -> (match t1, t2 with | Napp (Napp (Ncst (Heq a), u1), u2), Napp (Napp (Ncst (Heq b), v2), v3) -> if ((eq_type a b) && (eq_term u2 v2)) then Some (hyp_union h1 h2, heq a u1 v3) else ((print_string "Nptrans\n"); None) | _, _ -> (print_string "Nptrans\n"); None) | _, _ -> (print_string "Nptrans\n"); None) | Npcomb (q1, q2) -> (match proof2deriv q1, proof2deriv q2 with | Some (h1, t1), Some (h2, t2) -> (match t1, t2 with | Napp (Napp (Ncst (Heq (Narrow (a, b))), f), g), Napp (Napp (Ncst (Heq c), u), v) -> if (eq_type a c) then Some (hyp_union h1 h2, heq b (Napp (f, u)) (Napp (g, v))) else ((print_string "Npcomb\n"); None) | _, _ -> (print_string "Npcomb\n"); None) | _, _ -> (print_string "Npcomb\n"); None) | Npeqmp (q1, q2) -> (match proof2deriv q1, proof2deriv q2 with | Some (h1, t1), Some (h2, t2) -> (match t1 with | Napp (Napp (Ncst (Heq Nbool), a), b) -> if (eq_term a t2) then Some (hyp_union h1 h2, b) else ((print_string "Npeqmp\n"); None) | _ -> (print_string "Npeqmp\n"); None) | _, _ -> (print_string "Npeqmp\n"); None) | Npexists (q, b, t) -> (match proof2deriv q, b, infer [] t with | Some (h, u), Nabs (bb, a), Some aa -> if ((eq_type aa bb) && (eq_term (nopen a t) u)) then Some (h, hexists aa a) else ((print_string "Npexists\n"); None) | _, _, _ -> (print_string "Npexists\n"); None) | Npchoose (v, aa, q1, q2) -> (match proof2deriv q1, proof2deriv q2 with | Some (h1, t), Some (h2, c) -> (match t with | Napp (Ncst (Hexists bb), Nabs (cc, a)) -> let s = hyp_remove (nopen a (Nvar (v, aa))) h2 in if ((eq_type aa bb) && (eq_type bb cc) && (hyp_is_not_free v aa s) && (is_not_free v aa c) && (is_not_free v aa a)) then Some (hyp_union h1 s, c) else ((print_string "Npchoose\n"); None) | _ -> (print_string "Npchoose\n"); None) | _, _ -> (print_string "Npchoose\n"); None) | Npconj (q1, q2) -> (match proof2deriv q1, proof2deriv q2 with | Some (h1, a), Some (h2, b) -> Some (hyp_union h1 h2, hand a b) | _, _ -> (print_string "Npconj\n"); None) | Npconjunct1 q -> (match proof2deriv q with | Some (h, v) -> (match v with | Napp (Napp (Ncst Hand, t), u) -> Some (h, t) | _ -> (print_string "Npconjunct1\n"); None) | _ -> (print_string "Npconjunct1\n"); None) | Npconjunct2 q -> (match proof2deriv q with | Some (h, v) -> (match v with | Napp (Napp (Ncst Hand, t), u) -> Some (h, u) | _ -> (print_string "Npconjunct2\n"); None) | _ -> (print_string "Npconjunct2\n"); None) | Npdisj1 (q, b) -> (match proof2deriv q, infer [] b with | Some (h, a), Some Nbool -> Some (h, hor a b) | _, _ -> (print_string "Npdisj1\n"); None) | Npdisj2 (q, a) -> (match proof2deriv q, infer [] a with | Some (h, b), Some Nbool -> Some (h, hor a b) | _, _ -> (print_string "Npdisj1\n"); None) | Npdisjcases (q1, q2, q3) -> (match proof2deriv q1, proof2deriv q2, proof2deriv q3 with | Some (h1, t), Some (h2, c1), Some (h3, c2) -> (match t with | Napp (Napp (Ncst Hor, a), b) -> if (eq_term c1 c2) then Some (hyp_union h1 (hyp_union (hyp_remove a h2) (hyp_remove b h3)), c1) else ((print_string "Npdisjcases\n"); None) | _ -> (print_string "Npdisjcases\n"); None) | _, _, _ -> (print_string "Npisjcases\n"); None) | Npnoti q -> (match proof2deriv q with | Some (h, t) -> (match t with | Napp (Napp (Ncst Himp, a), Ncst Hfalse) -> Some (h, hnot a) | _ -> (print_string "Npnoti\n"); None) | _ -> (print_string "Npnoti\n"); None) | Npnote q -> (match proof2deriv q with | Some (h, t) -> (match t with | Napp (Ncst Hnot, a) -> Some (h, himp a hfalse) | _ -> (print_string "Npnote\n"); None) | _ -> (print_string "Npnote\n"); None) | Npcontr (q, a) -> (match proof2deriv q, infer [] a with | Some (h, t), Some Nbool -> (match t with | Ncst Hfalse -> Some (hyp_remove (hnot a) h, a) | _ -> (print_string "Npcontr\n"); None) | _, _ -> (print_string "Npcontr\n"); None) | Npimpas (q1, q2) -> (match proof2deriv q1, proof2deriv q2 with | Some (h1, t), Some (h2, u) -> (match t, u with | Napp (Napp (Ncst Himp, a1), b1), Napp (Napp (Ncst Himp, b2), a2) -> if ((eq_term a1 a2) && (eq_term b1 b2)) then Some (hyp_union h1 h2, hequiv b1 a1) else ((print_string ("Npimpas1; 1: "^(string_of_bool (eq_term a1 a2))^"; 2: "^(string_of_bool (eq_term b1 b2))^"\n")); let out = print_string in print_term out a1; out "\n"; print_term out a2; out "\n"; print_term out b1; out "\n"; print_term out b2; out "\n"; None) | _, _ -> (print_string "Npimpas2\n"); None) | _, _ -> (print_string "Npimpas3\n"); None) | Nfact thm -> (try Some (Hashtbl.find derivs thm) with | Not_found -> (print_string ("Nfact "^thm^"\n")); None) | Npdef (i, a, t) -> Some (hyp_empty, heq a (Ndef (i, a)) t) | Npaxm (_, t) -> Some (hyp_empty, t) | Nptyintro (rty, aty, mk_name, dest_name, p) -> let mk_type = Narrow(rty, aty) in let dest_type = Narrow(aty, rty) in let a_name = make_idV "a" aty in let a = Nvar(a_name, aty) in let r_name = make_idV "r" rty in let r = Nvar(r_name, rty) in Some (hyp_empty, hand (heq aty (Napp (Ndef (mk_name, mk_type), Napp (Ndef (dest_name, dest_type), a))) a) (hequiv (Napp (p, r)) (heq rty (Napp (Ndef (dest_name, dest_type), Napp (Ndef (mk_name, mk_type), r))) r)));; (* Dealing with dependencies *) let rec make_dependencies_aux dep_graph proof_of_thm = function | [] -> () | (thmname, p, c_opt)::il -> incr total; let wdi thm = Depgraph.Dep.add_dep dep_graph thm thmname; Nfact thm in let write_proof p il = let rec share_info_of p il = match (disk_info_of p) with | Some (thyname,thmname) -> Some(thyname,thmname,il) | None -> if do_share p then let name = THEORY_NAME^"_"^(get_iname ()) in set_disk_info_of p THEORY_NAME name; Depgraph.Dep.add_thm dep_graph name; Some(THEORY_NAME,name,(name,p,None)::il) else None and wp' il = function | Prefl tm -> Nprefl (term2nterm tm), il | Pbeta(x, ty, tm) -> let typ = hol_type2ntype ty in Npbeta(make_idV x typ , typ, term2nterm tm), il | Pinstt(p,lambda) -> let p', res = wp il p in Npinstt(p', List.map ( fun (s,ty) -> (make_idT s, hol_type2ntype ty) ) lambda), res | Pabs(p,x,ty) -> let p', res = wp il p in let typ = hol_type2ntype ty in Npabs(p',make_idV x typ,typ), res | Pdisch(p,tm) -> let p', res = wp il p in Npdisch(p', term2nterm tm), res | Phyp tm -> Nphyp (term2nterm tm), il | Paxm(th,tm) -> Npaxm(th, term2nterm tm), il | Pdef(name,ty,tm) -> let typ = hol_type2ntype ty in Npdef(make_defV name typ true, typ, term2nterm tm), il | Ptyintro(rty2, tyname, tyvars, absname, repname, pt) -> let rty = hol_type2ntype rty2 in let new_name = make_defT tyname in let ntyvars = List.map hol_type2ntype tyvars in let aty = Ntdef(new_name, ntyvars) in let mk_name = make_defV absname (Narrow(rty, aty)) false in let dest_name = make_defV repname (Narrow(aty, rty)) false in Nptyintro(rty, aty, mk_name, dest_name, term2nterm pt), il | Pspec(p,t) -> let p', res = wp il p in Npspec(p', term2nterm t), res | Pinst(p,theta) -> let p', res = wp il p in Npinst(p', List.map ( fun (s,ty,te) -> let typ = hol_type2ntype ty in (make_idV s typ, typ, term2nterm te) ) theta), res | Pgen(p,x,ty) -> let p', res = wp il p in let typ = hol_type2ntype ty in Npgen(p', make_idV x typ, typ), res | Psym p -> let p', res = wp il p in Npsym p', res | Ptrans(p1,p2) -> let p1', il' = wp il p1 in let p2', res = wp il' p2 in Nptrans(p1', p2'), res | Pcomb(p1,p2) -> let p1', il' = wp il p1 in let p2', res = wp il' p2 in Npcomb(p1', p2'), res | Peqmp(p1,p2) -> let p1', il' = wp il p1 in let p2', res = wp il' p2 in Npeqmp(p1', p2'), res | Pexists(p,ex,w) -> let p', res = wp il p in Npexists(p', term2nterm ex, term2nterm w), res | Pchoose(x,ty,p1,p2) -> let p1', il' = wp il p1 in let p2', res = wp il' p2 in let typ = hol_type2ntype ty in Npchoose(make_idV x typ, typ, p1', p2'), res | Pconj(p1,p2) -> let p1', il' = wp il p1 in let p2', res = wp il' p2 in Npconj(p1', p2'), res | Pimpas(p1,p2) -> let p1', il' = wp il p1 in let p2', res = wp il' p2 in Npimpas(p1', p2'), res | Pconjunct1 p -> let p', res = wp il p in Npconjunct1 p', res | Pconjunct2 p -> let p', res = wp il p in Npconjunct2 p', res | Pdisj1(p,tm) -> let p', res = wp il p in Npdisj1(p', term2nterm tm), res | Pdisj2(p,tm) -> let p', res = wp il p in Npdisj2(p', term2nterm tm), res | Pdisjcases(p1,p2,p3) -> let p1', il' = wp il p1 in let p2', il'' = wp il' p2 in let p3', res = wp il'' p3 in Npdisjcases(p1', p2', p3'), res | Pnoti p -> let p', res = wp il p in Npnoti p', res | Pnote p -> let p', res = wp il p in Npnote p', res | Pcontr(p,tm) -> let p', res = wp il p in Npcontr(p', term2nterm tm), res and wp il p = match share_info_of p il with | Some(_, thmname, il') -> wdi thmname, il' | None -> wp' il (content_of p) in match disk_info_of p with | Some(_, thmname') -> if thmname' = thmname then wp' il (content_of p) else (wdi thmname', il) | None -> wp' il (content_of p) in let p', il = write_proof p il in set_disk_info_of p THEORY_NAME thmname; Hashtbl.add proof_of_thm thmname p'; make_dependencies_aux dep_graph proof_of_thm il;; let make_dependencies out out_share out_sharet new_file count_thms path ((thmname, pr, _) as p) = let dep_graph = Depgraph.Dep.create () in let proof_of_thm = Hashtbl.create (references pr) in Depgraph.Dep.add_thm dep_graph thmname; make_dependencies_aux dep_graph proof_of_thm [p]; let share_type ty = share_types out_sharet ty in let share_term ty = share_terms out_share out_sharet ty in if thmname = (THEORY_NAME^"_DEF_T") then ( match content_of pr with | Pdef (_, _, t) -> let tm = hequiv htrue (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_T" thmname; export_sig out thmname | _ -> () ) else if thmname = (THEORY_NAME^"_DEF__slash__backslash_") then ( match content_of pr with | Pdef (_, _, t) -> let tm = heq (Narrow (Nbool, Narrow (Nbool, Nbool))) (Ncst Hand) (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_AND" thmname; export_sig out thmname | _ -> () ) else if thmname = (THEORY_NAME^"_DEF__equal__equal__greaterthan_") then ( match content_of pr with | Pdef (_, _, t) -> let tm = heq (Narrow (Nbool, Narrow (Nbool, Nbool))) (Ncst Himp) (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_IMP" thmname; export_sig out thmname | _ -> () ) else if thmname = (THEORY_NAME^"_DEF__exclamationmark_") then ( match content_of pr with | Pdef (_, a, t) -> let a2 = hol_type2ntype a in (match a2 with | Narrow (Narrow (b, _), _) -> let tm = heq a2 (Ncst (Hforall b)) (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_FORALL" thmname; export_sig out thmname | _ -> ()) | _ -> () ) else if thmname = (THEORY_NAME^"_DEF__questionmark_") then ( match content_of pr with | Pdef (_, a, t) -> let a2 = hol_type2ntype a in (match a2 with | Narrow (Narrow (b, _), _) -> let tm = heq a2 (Ncst (Hexists b)) (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_EXISTS" thmname; export_sig out thmname | _ -> ()) | _ -> () ) else if thmname = (THEORY_NAME^"_DEF__backslash__slash_") then ( match content_of pr with | Pdef (_, _, t) -> let tm = heq (Narrow (Nbool, Narrow (Nbool, Nbool))) (Ncst Hor) (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_OR" thmname; export_sig out thmname | _ -> () ) else if thmname = (THEORY_NAME^"_DEF_F") then ( match content_of pr with | Pdef (_, _, t) -> let tm = hequiv (Ncst Hfalse) (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_F" thmname; export_sig out thmname | _ -> () ) else if thmname = (THEORY_NAME^"_DEF__tilde_") then ( match content_of pr with | Pdef(_, _, t) -> let tm = heq (Narrow (Nbool, Nbool)) (Ncst Hnot) (term2nterm t) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "DEF_NOT" thmname; export_sig out thmname | _ -> () ) else if thmname = (THEORY_NAME^"_DEF__FALSITY_") then ( let tm = heq Nbool (Ncst Hfalse) (Ncst Hfalse) in Hashtbl.add derivs thmname (hyp_empty, tm); export_ht out share_term hyp_empty tm thmname; export_lemma_def out "(Prefl (Cst Hfalse))" thmname; export_sig out thmname ) else if thmname = (THEORY_NAME^"_ax__1") then ( match content_of pr with | Paxm (_, tm) -> let tm2 = term2nterm tm in Hashtbl.add derivs thmname (hyp_empty, tm2); export_ht out share_term hyp_empty tm2 thmname; export_lemma_def out "ETA_AX" thmname; export_sig out thmname | _ -> () ) else if thmname = (THEORY_NAME^"_ax__2") then ( match content_of pr with | Paxm (_, tm) -> let tm2 = term2nterm tm in Hashtbl.add derivs thmname (hyp_empty, tm2); export_ht out share_term hyp_empty tm2 thmname; export_lemma_def out "SELECT_AX" thmname; export_sig out thmname | _ -> () ) else ( Depgraph.Dep_top.iter_top ( fun thm -> incr count_thms; if !count_thms = 1000 then (count_thms := 0; new_file ()); (try let p = Hashtbl.find proof_of_thm thm in (match proof2deriv p with | Some (h, t) -> Hashtbl.add derivs thm (h, t); export_ht out share_term h t thm; (match p with | Npdef _ -> export_def out thm | Nptyintro _ -> export_tdef out thm | Npaxm _ -> export_axiom out thm | _ -> export_lemma out share_type share_term p thm); export_sig out thm | None -> failwith ("Erreur make_dependencies "^thm^" de "^thmname^": no derivation associated to the proof\n")) with | Not_found -> failwith ("Erreur make_dependencies "^thm^": proof_of_thm not found\n")); ) dep_graph ); ;; let the_proof_database = ref ([]:(string*proof*(term option)) list);; Random.self_init;; let rec search_proof_name n db = match db with [] -> n | ((m, _, _)::db') -> if n=m then n^"_"^(string_of_int (Random.int 1073741823)) else search_proof_name n db' let save_proof name p c_opt = let name' = search_proof_name name (!the_proof_database) in the_proof_database := (name', p, c_opt)::(!the_proof_database);; let proof_database () = !the_proof_database;; (* Utilities to define Coq interpretation functions *) let ut = Hashtbl.create 17;; let ask_ut () = try ( let filein = Pervasives.open_in "interpretation.txt" in let line = ref 0 in try while true do incr line; let s1 = input_line filein in incr line; let s2 = input_line filein in Hashtbl.add ut s1 s2 done with | End_of_file -> close_in filein | _ -> failwith ("Error line "^(string_of_int !line)^".") ) with | Sys_error _ -> () ;; let tc_regexp = Str.regexp "\?[0-9]*";; let make_tc_parameter out x n = if Str.string_match tc_regexp x 0 then ( let i = Str.match_end () in if i <> String.length x then ( out "\nParameter "; out THEORY_NAME; out "_idT_"; out (mfc x); out " : Type.\nParameter "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); out " : "; out THEORY_NAME; out "_idT_"; out (mfc x); out "." ) ) else ( out "\nParameter "; out THEORY_NAME; out "_idT_"; out (mfc x); out " : Type.\nParameter "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); out " : "; out THEORY_NAME; out "_idT_"; out (mfc x); out "." );; let make_tc_list out x n = if Str.string_match tc_regexp x 0 then ( let i = Str.match_end () in if i <> String.length x then ( out "\n("; out (string_of_int n); out ", mkTT "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); out ")::" ) ) else ( out "\n("; out (string_of_int n); out ", mkTT "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); out ")::" );; let defT_ut = Hashtbl.create 17;; let make_tdt_parameter out x _ = try ( let y = Hashtbl.find ut x in Hashtbl.add defT_ut x y ) with | Not_found -> ( out "\nParameter "; out THEORY_NAME; out "_defT_"; out (mfc x); out " : Type."; out "\nParameter "; out THEORY_NAME; out "_defT_inhab_"; out (mfc x); out " : "; out THEORY_NAME; out "_defT_"; out (mfc x); out ".\n"; Hashtbl.add defT_ut x ("fun _ => mkTT "^THEORY_NAME^"_defT_inhab_"^(mfc x)) );; let make_tdt_list out x n = try ( let s = Hashtbl.find defT_ut x in out "\n("; out (string_of_int n); out ", "; out s; out ")::"; ) with | Not_found -> ( out "\n("; out (string_of_int n); out ", fun _ => mkTT tt)::" );; let se_regexp = Str.regexp "_[0-9]*";; let make_se_parameter out x (_,ty) = if Str.string_match se_regexp x 0 then ( let i = Str.match_end () in if i <> String.length x then ( out "\nParameter "; out THEORY_NAME; out "_idV_"; out (mfc x); out " : tr_type tc tdt "; print_type out ty; out "." ) ) else ( out "\nParameter "; out THEORY_NAME; out "_idV_"; out (mfc x); out " : tr_type tc tdt "; print_type out ty; out "." );; let make_se_list out x (n,ty) = if Str.string_match se_regexp x 0 then ( let i = Str.match_end () in if i <> String.length x then ( out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " "; out THEORY_NAME; out "_idV_"; out (mfc x); out ")::" ) ) else ( out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " "; out THEORY_NAME; out "_idV_"; out (mfc x); out ")::" );; let defV_ut = Hashtbl.create 17;; let make_sdt_parameter out x (_,ty,_) = if ((x <> "T") && (x <> "/\\") && (x <> "==>") && (x <> "!") && (x <> "?") && (x <> "\\/") && (x <> "F") && (x <> "~") && (x <> "_FALSITY_")) then ( try ( let y = Hashtbl.find ut x in Hashtbl.add defV_ut x y ) with | Not_found -> ( out "\nParameter "; out THEORY_NAME; out "_defV_"; out (mfc x); out " : tr_type tc tdt "; print_type out ty; out "." ) );; let make_sdt_list out x (n,ty,_) = try ( let s = Hashtbl.find defV_ut x in out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " ("; out s; out "))::" ) with | Not_found -> ( if ((x <> "T") && (x <> "/\\") && (x <> "==>") && (x <> "!") && (x <> "?") && (x <> "\\/") && (x <> "F") && (x <> "~") && (x <> "_FALSITY_")) then ( out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " "; out THEORY_NAME; out "_defV_"; out (mfc x); out ")::" ) );; (* Main function: list of proofs exportation *) let export_list thmname_list = total := 0; let path = ensure_export_directory THEORY_NAME in let rec proof_of_thm acc acc2 = function | [] -> acc, acc2 | (s,p,c)::q -> if List.mem s thmname_list then proof_of_thm ((THEORY_NAME^"_"^(mfc s), reset_disk_info_of1 p, c)::acc) (acc2+1) q else match content_of p with | Paxm _ | Pdef _ | Ptyintro _ -> proof_of_thm ((THEORY_NAME^"_"^(mfc s), reset_disk_info_of1 p, c)::acc) (acc2+1) q | _ -> proof_of_thm acc acc2 q in let l, total_thms = proof_of_thm [] 0 (proof_database ()) in let count_thms = ref 0 in let count_files = ref 1 in (* Main file *) let file = ref (open_out (Filename.concat path (THEORY_NAME^"_1.v"))) in let count_file = ref 0 in let out s = (output_string !file s; incr count_file; if !count_file = 1000 then (count_file := 0; flush !file)) in out "(*** This file has been automatically generated from HOL-Light source files. ***)\n\nRequire Export List NArith.\nRequire Export hol deriv proof.\n\n"; (* Temporary file *) let (file_temp_name, file_temp_aux) = Filename.open_temp_file (THEORY_NAME^"_") ".v" in let file_temp = ref file_temp_aux in let count_file_temp = ref 0 in let out_temp s = (output_string !file_temp s; incr count_file_temp; if !count_file_temp = 1000 then (count_file_temp := 0; flush !file_temp)) in let move_temp () = (try close_out !file_temp with | Sys_error s -> raise (Sys_error ("move_temp1: "^s))); (try let buf = Pervasives.open_in file_temp_name in (try while true do out "\n"; let l = input_line buf in out l done with | End_of_file -> close_in buf) with | Sys_error s -> raise (Sys_error ("move_temp3: "^s))) in (* New file *) let new_file () = move_temp (); file_temp := open_out file_temp_name; incr count_files; close_out !file; file := open_out (Filename.concat path (THEORY_NAME^"_"^(string_of_int !count_files)^".v")); out "(*** This file has been automatically generated from HOL-Light source files. ***)\n\nRequire Export "; out THEORY_NAME; out "_"; out (string_of_int (!count_files-1)); out ".\n\n" in (* Coq files generation *) let date1 = Unix.time () in List.iter (make_dependencies out_temp out out new_file count_thms path) l; let date2 = Unix.time () in move_temp (); close_out !file; (* Makefile *) let make = open_out (Filename.concat path "Makefile") in let out = output_string make in out "# This file has been automatically generated from HOL-Light source files.\n\nCOQ=ssrcoq\nFLAGS=-dont-load-proofs -dump-glob /dev/null -compile\n\nSRC="; for i = 1 to !count_files do out " "; out THEORY_NAME; out "_"; out (string_of_int i); out ".v"; done; out "\nOBJ=$(SRC:.v=.vo)\nGLOB=$(SRC:.v=.glob)\n\n\nall: $(OBJ)\n\n\n%.vo: %.v\n\t$(COQ) $(FLAGS) $(^:.v=)\n\n\nclean:\n\trm -f $(OBJ) $(GLOB) *~"; close_out make; (* Interpretation *) let interp = open_out (Filename.concat path "interpretation.v") in let out = output_string interp in out "(*** This file has been automatically generated from HOL-Light source files. ***)\n\nRequire Import ssreflect eqtype ssrnat ssrbool.\nRequire Import List NArith ZArith.ZOdiv_def.\nRequire Import hol cast typing translation axioms.\n\nOpen Local Scope positive_scope.\n\n"; ask_ut (); (* tc *) Hashtbl.iter (make_tc_parameter out) idT; out "\n\nDefinition tc_list :="; Hashtbl.iter (make_tc_list out) idT; out "\nnil.\n\nDefinition tc := list_tc2tc tc_list.\n\n"; (* tdt *) Hashtbl.iter (make_tdt_parameter out) defT; out "\n\nDefinition tdt_list : list_tdt :="; Hashtbl.iter (make_tdt_list out) defT; out "\nnil.\n\nDefinition tdt := list_tdt2tdt tdt_list.\n\n"; (* se *) Hashtbl.iter (make_se_parameter out) idV; out "\n\nDefinition se_list :="; Hashtbl.iter (make_se_list out) idV; out "\nnil.\n\nDefinition se := list_se2se se_list.\n\n"; (* sdt *) Hashtbl.iter (make_sdt_parameter out) defV; out "\n\nDefinition sdt_list :="; Hashtbl.iter (make_sdt_list out) defV; out "\nnil.\n\nDefinition sdt := list_sdt2sdt sdt_list."; close_out interp; print_string "Generated "; print_int !total; print_string " facts for "; print_int total_thms; print_string " theorems.\n"; print_string "Exportation duration: "; print_float (date2 -. date1); print_string "s.\n" ;; (* Main function: all proofs exportation *) let export_saved_proofs () = export_list (List.map (fun (s,_,_) -> s) (proof_database ()));; (* Main function: one proof exportation *) let export_one_proof name = export_list [name];; end;; include Proofobjects;; hol-light/Proofrecording/diffs/proofobjects_dummy.ml000066400000000000000000000075051303454263000232750ustar00rootroot00000000000000(* ========================================================================= *) (* Proof-objects for HOL-light *) (* *) (* Steven Obua, TU München, December 2004 *) (* *) (* based on Sebastian Skalberg's HOL4 proof-objects *) (* *) (* dummy proof objects, is used when proof objects are switched off, *) (* the real thing can be found in proofobjects_trt.ml *) (* ========================================================================= *) module type Proofobject_primitives = sig type proof val proof_REFL : term -> proof val proof_TRANS : proof * proof -> proof val proof_MK_COMB : proof * proof -> proof val proof_ASSUME : term -> proof val proof_EQ_MP : proof -> proof -> proof val proof_IMPAS : proof -> proof -> proof val proof_DISCH : proof -> term -> proof val proof_DEDUCT_ANTISYM_RULE : proof * term -> proof * term -> proof val proof_BETA : term -> proof val proof_ABS : term -> proof -> proof val proof_INST_TYPE : (hol_type * hol_type) list -> proof -> proof val proof_INST : (term * term) list -> proof -> proof val proof_new_definition : string -> hol_type -> term -> proof val proof_CONJ : proof -> proof -> proof val proof_CONJUNCT1 : proof -> proof val proof_CONJUNCT2 : proof -> proof val proof_new_basic_type_definition : string -> string * string -> term * term -> proof -> proof val proof_SPEC : term -> proof -> proof val proof_SYM : proof -> proof val proof_GEN : proof -> term -> proof val proof_DISJ1 : proof -> term -> proof val proof_DISJ2 : proof -> term -> proof val proof_NOTI : proof -> proof val proof_NOTE : proof -> proof val proof_CONTR : proof -> term -> proof val proof_DISJCASES : proof -> proof -> proof -> proof val proof_CHOOSE : term -> proof -> proof -> proof val proof_EXISTS : term -> term -> proof -> proof val new_axiom_name : string -> string val proof_new_axiom : string -> term -> proof val save_proof : string -> proof -> (term option) -> unit val proof_database : unit -> ((string * proof * (term option)) list) val export_proofs : string option -> (string * proof * (term option)) list -> unit val export_saved_proofs : string option -> unit end;; module Proofobjects : Proofobject_primitives = struct type proof = unit -> unit let dummy () x = x;; let proof_REFL _ = dummy () let proof_TRANS _ = dummy () let proof_MK_COMB _ = dummy () let proof_ASSUME _ = dummy () let proof_EQ_MP _ _ = dummy () let proof_IMPAS _ _ = dummy () let proof_DISCH _ _ = dummy () let proof_DEDUCT_ANTISYM_RULE _ _ = dummy () let proof_BETA _ = dummy () let proof_ABS _ _ = dummy () let proof_INST_TYPE _ _ = dummy () let proof_INST _ _ = dummy () let proof_new_definition _ _ _ = dummy () let proof_CONJ _ _ = dummy () let proof_CONJUNCT1 _ = dummy () let proof_CONJUNCT2 _ = dummy () let proof_new_basic_type_definition _ _ _ _ = dummy () let proof_SPEC _ _ = dummy () let proof_SYM _ = dummy () let proof_GEN _ _ = dummy () let proof_DISJ1 _ _ = dummy () let proof_DISJ2 _ _ = dummy () let proof_NOTI _ = dummy () let proof_NOTE _ = dummy () let proof_CONTR _ _ = dummy () let proof_DISJCASES _ _ _ = dummy () let proof_CHOOSE _ _ _ = dummy () let proof_EXISTS _ _ _ = dummy () let new_axiom_name _ = "" let proof_new_axiom _ _ = dummy () let save_proof _ _ _ = () let proof_database _ = [] let export_proofs _ _ = () let export_saved_proofs _ = () end;; include Proofobjects;; hol-light/Proofrecording/diffs/proofobjects_init.ml000066400000000000000000000010211303454263000230700ustar00rootroot00000000000000let (use_proofobjects, use_extended_proofobjects, use_coq) = try let n = Sys.getenv "HOLPROOFOBJECTS" in if n = "BASIC" then (true, false, false) else if n = "EXTENDED" then (true, true, false) else if n = "COQ" then (true, true, true) else (false, false, false) with Not_found -> (false, false, false);; let _ = if use_proofobjects then if use_coq then loads "proofobjects_coq.ml" else loads "proofobjects_trt.ml" else loads "proofobjects_dummy.ml";; hol-light/Proofrecording/diffs/proofobjects_trt.ml000066400000000000000000000764721303454263000227640ustar00rootroot00000000000000(* ========================================================================= *) (* Proof-objects for HOL-light *) (* *) (* Steven Obua, TU München, December 2004 *) (* *) (* based on Sebastian Skalberg's HOL4 proof-objects *) (* ========================================================================= *) #load "unix.cma";; module type Proofobject_primitives = sig type proof val proof_REFL : term -> proof val proof_TRANS : proof * proof -> proof val proof_MK_COMB : proof * proof -> proof val proof_ASSUME : term -> proof val proof_EQ_MP : proof -> proof -> proof val proof_IMPAS : proof -> proof -> proof val proof_DISCH : proof -> term -> proof val proof_DEDUCT_ANTISYM_RULE : proof * term -> proof * term -> proof val proof_BETA : term -> proof val proof_ABS : term -> proof -> proof val proof_INST_TYPE : (hol_type * hol_type) list -> proof -> proof val proof_INST : (term * term) list -> proof -> proof val proof_new_definition : string -> hol_type -> term -> proof val proof_CONJ : proof -> proof -> proof val proof_CONJUNCT1 : proof -> proof val proof_CONJUNCT2 : proof -> proof val proof_new_basic_type_definition : string -> string * string -> term * term -> proof -> proof val proof_SPEC : term -> proof -> proof val proof_SYM : proof -> proof val proof_GEN : proof -> term -> proof val proof_DISJ1 : proof -> term -> proof val proof_DISJ2 : proof -> term -> proof val proof_NOTI : proof -> proof val proof_NOTE : proof -> proof val proof_CONTR : proof -> term -> proof val proof_DISJCASES : proof -> proof -> proof -> proof val proof_CHOOSE : term -> proof -> proof -> proof val proof_EXISTS : term -> term -> proof -> proof val new_axiom_name : string -> string val proof_new_axiom : string -> term -> proof val save_proof : string -> proof -> (term option) -> unit val proof_database : unit -> ((string * proof * (term option)) list) val export_proofs : string option -> (string * proof * (term option)) list -> unit val export_saved_proofs : string option -> unit end;; module Proofobjects : Proofobject_primitives = struct let writeln s p = p;; (* let q = s^"\n" in (output stdout q 0 (String.length q); p);;*) type tag = string type proof_info_rec = {disk_info: (string * string) option ref; status: int ref; references: int ref; queued: bool ref} type proof_info = Info of proof_info_rec type ('a, 'b) libsubst_rec = {redex:'a; residue:'b} type ('a, 'b) libsubst = (('a,'b) libsubst_rec) list let pair2libsubstrec = fun (a,b) -> {redex=b;residue=a} (* note: not all of the proof_content constructors are actually used, some are just legacy from the HOL4 proof objects *) type proof = Proof of (proof_info * proof_content * (unit -> unit)) and proof_content = Prefl of term | Pinstt of proof * ((hol_type,hol_type) libsubst) | Psubst of proof list * term * proof | Pabs of proof * term | Pdisch of proof * term | Pmp of proof * proof | Phyp of term | Paxm of string * term | Pdef of string * string * term | Ptmspec of string * string list * proof | Ptydef of string * string * proof | Ptyintro of string * string * string * string * term * term * proof | Poracle of tag * term list * term | Pdisk | Pspec of proof * term | Pinst of proof * (term,term) libsubst | Pgen of proof * term | Pgenabs of proof * term option * term list | Psym of proof | Ptrans of proof * proof | Pcomb of proof * proof | Peqmp of proof * proof | Peqimp of proof | Pexists of proof * term * term | Pchoose of term * proof * proof | Pconj of proof * proof | Pconjunct1 of proof | Pconjunct2 of proof | Pdisj1 of proof * term | Pdisj2 of proof * term | Pdisjcases of proof * proof * proof | Pnoti of proof | Pnote of proof | Pcontr of proof * term | Pimpas of proof * proof let THEORY_NAME = "hollight" let content_of (Proof (_,p,_)) = p let inc_references (Proof(Info{references=r},_,_) as p) = ( let old = !r in r := old + 1; p) let concat = String.concat "" let dummy_fun () = () let mk_proof p = Proof(Info {disk_info = ref None; status = ref 0; references = ref 0; queued = ref false},p, dummy_fun) let global_ax_counter = let counter = ref 1 in let f = fun () -> (let x = !counter in counter := !counter+1; x) in f let new_axiom_name n = concat["ax_"; n; "_"; string_of_int(global_ax_counter())] let proof_REFL t = writeln "REFL" (mk_proof (Prefl t)) let proof_TRANS (p,q) = writeln "TRANS" ( match (content_of p, content_of q) with (Prefl _,_) -> q | (_, Prefl _) -> p | _ -> mk_proof (Ptrans (inc_references p, inc_references q))) let proof_MK_COMB (p1,p2) = writeln "MK_COMB" ( (match (content_of p1, content_of p2) with (Prefl tm1, Prefl tm2) -> proof_REFL (mk_comb (tm1, tm2)) | _ -> mk_proof (Pcomb (inc_references p1, inc_references p2)))) let proof_ASSUME t = writeln "ASSUME "(mk_proof (Phyp t)) let proof_EQ_MP p q = writeln "EQ_MP" ( (match content_of p with Prefl _ -> q | _ -> mk_proof (Peqmp(inc_references p, inc_references q)))) let proof_IMPAS p1 p2 = writeln "IMPAS" ( mk_proof (Pimpas (inc_references p1, inc_references p2))) let proof_DISCH p t = writeln "DISCH" (mk_proof (Pdisch(inc_references p,t))) let proof_DEDUCT_ANTISYM_RULE (p1,t1) (p2,t2) = writeln "DEDUCT_ANTISYM_RULE" ( proof_IMPAS (proof_DISCH p1 t2) (proof_DISCH p2 t1)) let proof_BETA t = writeln "BETA" (mk_proof (Prefl t)) let proof_ABS x p = writeln "ABS" ( (match (content_of p) with Prefl tm -> proof_REFL (mk_abs(x,tm)) | _ -> mk_proof (Pabs(inc_references p,x)))) let proof_INST_TYPE s p = writeln "INST_TYPE" (mk_proof (Pinstt(inc_references p, map pair2libsubstrec s))) let proof_INST s p = writeln "INST" (mk_proof (Pinst(inc_references p, map pair2libsubstrec s))) let proof_new_definition cname _ t = writeln "new_definition" (mk_proof (Pdef (THEORY_NAME, cname, t))) let proof_new_axiom axname t = writeln "new_axiom" (mk_proof (Paxm (axname, t))) let proof_CONJ p1 p2 = writeln "CONJ" (mk_proof (Pconj (inc_references p1, inc_references p2))) let proof_CONJUNCT1 p = writeln "CONJUNCT1" (mk_proof (Pconjunct1 (inc_references p))) let proof_CONJUNCT2 p = writeln "CONJUNCT2" (mk_proof (Pconjunct2 (inc_references p))) let proof_new_basic_type_definition tyname (absname, repname) (pt,tt) p = writeln "new_basic_type_definition" ( mk_proof(Ptyintro (THEORY_NAME, tyname, absname, repname, pt, tt,inc_references p))) (* ---- used only in substitute_proof calls ---- *) let proof_SPEC s p = writeln "SPEC" (mk_proof (Pspec(inc_references p, s))) let proof_SYM p = writeln "SYM" (mk_proof (Psym(inc_references p))) let proof_GEN p a = writeln "GEN" (mk_proof (Pgen(inc_references p, a))) let proof_DISJ1 p a = writeln "DISJ1" (mk_proof (Pdisj1 (inc_references p, a))) let proof_DISJ2 p a = writeln "DISJ2" (mk_proof (Pdisj2 (inc_references p, a))) let proof_NOTI p = writeln "NOTI" (mk_proof (Pnoti (inc_references p))) let proof_NOTE p = writeln "NOTE" (mk_proof (Pnote (inc_references p))) let proof_CONTR p a = writeln "CONTR" (mk_proof (Pcontr (inc_references p, a))) let proof_DISJCASES p q r = writeln "DISJCASES" (mk_proof (Pdisjcases (inc_references p, inc_references q, inc_references r))) let proof_CHOOSE a p q = writeln "CHOOSE" (mk_proof (Pchoose (a, inc_references p, inc_references q))) let proof_EXISTS x y p = writeln "EXISTS" (mk_proof (Pexists (inc_references p, x, y))) (* ---- formerly known as proofio.ml ---- *) let ensure_export_directory thyname = let dir = Sys.getenv "HOLPROOFEXPORTDIR" in let dirsub = Filename.concat dir "hollight" in let dirsubsub = Filename.concat dirsub thyname in let mk d = if Sys.file_exists d then () else Unix.mkdir d 509 in (mk dir; mk dirsub; mk dirsubsub; dirsubsub);; (* ---- Useful functions on terms ---- *) let rec types_of tm = if is_var tm then [type_of tm] else if is_const tm then [type_of tm] else if is_comb tm then let (f,a) = dest_comb tm in union (types_of f) (types_of a) else let (x,a) = dest_abs tm in insert (type_of x) (types_of a);; let beta_conv tm = try let (f,arg) = dest_comb tm in let (v,bod) = dest_abs f in vsubst [(arg,v)] bod with Failure _ -> failwith "beta_conv: Not a beta-redex";; let eta_conv tm = try (let (v, bod) = dest_abs tm in let (f, arg) = dest_comb bod in if (arg = v && (not(vfree_in v f))) then f else failwith "") with Failure _ -> failwith "eta_conv: Not an eta-redex";; let rec be_contract tm = let rec bec tm = try try Some (beta_conv tm) with Failure _ -> Some (eta_conv tm) with Failure _ -> if is_comb tm then (let (f,x) = dest_comb tm in match bec f with Some f' -> Some (mk_comb(f',x)) | None -> (match bec x with Some x' -> Some (mk_comb(f,x')) | None -> None)) else if is_abs tm then (let (x,body) = dest_abs tm in (match bec body with Some body' -> Some (mk_abs(x,body')) | None -> None)) else None in (match bec tm with Some tm' -> be_contract tm' | None -> tm);; let rec polymorphic x = if is_vartype x then true else exists polymorphic (snd (dest_type x)) (* ---- From Lib etc. ---- *) let rec append = fun xlist l -> (match xlist with [] -> l | (x::xs) -> x::(append xs l));; let assoc1 item = let rec assc = (function (((key,_) as e)::rst) -> if item=key then Some e else assc rst | [] -> None) in assc;; let rec listconcat = function [] -> [] | (l::ls) -> append l (listconcat ls);; let listnull = function [] -> true | _ -> false;; (* ---- exported ---- *) let encodeXMLEntities m = m;;let encodeXMLEntities s = let len = String.length s in let encodeChar = function '<' -> "<" | '>' -> ">" | '&' -> "&" | '\'' -> "'" | '"' -> """ | c -> String.make 1 c in let rec encodeStr i = if (i out (encodeXMLEntities x);; let content_of (Proof (_,x,_)) = x;; let rec explode_subst = function [] -> [] | ({redex=x;residue=y}::rest) -> x::y::(explode_subst rest);; let rec app f = function [] -> () | (x::l) -> (f x; app f l);; let disk_info_of (Proof(Info {disk_info=di},_,_)) = !di;; let set_disk_info_of (Proof(Info {disk_info=di},_,_)) thyname thmname = di := Some (thyname,thmname);; let references (Proof (Info info,_,_)) = !(info.references);; let wrap b e s = b^s^e;; let xml_empty_tag = wrap "<" "/>";; let xml_start_tag = wrap "<" ">";; let xml_end_tag = wrap "";; let xml_attr attr = itlist (function (tag,v) -> function s -> concat[" ";tag;"=\"";v;"\"";s] ) attr "";; let xml_element tag attr children = let header = tag ^ (xml_attr attr) in (if listnull children then xml_empty_tag header else wrap (xml_start_tag header) (xml_end_tag tag) (concat children));; let id_to_atts curthy id = [("n", encodeXMLEntities id)];; (* There is only one theory in Hol-Light, therefore id_to_atts is superfluous *) let glob_counter = ref 1;; let get_counter () = let res = !glob_counter in glob_counter := res + 1; res;; let get_iname = string_of_int o get_counter;; let next_counter () = !glob_counter;; let trivial p = match (content_of p) with Prefl _ -> true | Paxm _ -> true | Pdisk -> true | Phyp _ -> true | Poracle _ -> true | _ -> false;; let do_share p = references p > 1 && not (trivial p);; exception Err of string*string;; (* ---- The General List Formerly Known As Net ---- *) type 'a exprnet = (('a list) ref) * ('a -> ('a list)) let empty_net f () = (ref [], f);; let rec lookup'_net net x = match net with [] -> raise Not_found | (a::l) -> if (a = x) then 0 else 1+(lookup'_net l x);; let lookup_net (net,f) x = lookup'_net (!net) x;; let insert'_net (net,f) x = try lookup'_net !net x; () with Not_found -> ((net := (!net)@[x]);());; let rec insert_net ((net,f) as n) x = (app (insert_net n) (f x); insert'_net n x);; let to_list_net (net,f) = !net;; (* ---- The Type Net (it's not a net any more!) ---- *) type yy_net = hol_type exprnet;; let yy_empty = empty_net (function x -> if is_type x then snd (dest_type x) else []);; let yy_lookup = lookup_net;; let yy_output_types out thyname net = let all_types = to_list_net net in let rec xml_index ty = xml_element "tyi" [("i",string_of_int (yy_lookup net ty))] [] and xml_const id = xml_element "tyc" (id_to_atts thyname id) [] and out_type ty = if is_vartype ty then out (xml_element "tyv" [("n",encodeXMLEntities (dest_vartype ty))] []) else ( match dest_type ty with (id, []) -> out (xml_const id) | (id, tl) -> out (xml_element "tya" [] ((xml_const id)::(map xml_index tl))) ) in out ""; app out_type all_types; out "";; let yy_insert = insert_net;; (* ---- The Term Net (it's not a net anymore!) ---- *) type mm_net = term exprnet;; let mm_empty = empty_net ( function tm -> if is_abs tm then (let (x,b) = dest_abs tm in [x; b]) else if is_comb tm then (let (s,t) = dest_comb tm in [s; t]) else []) let mm_lookup net x = lookup_net net (be_contract x);; let mm_insert net x = insert_net net (be_contract x);; let mm_output_terms out thyname types net = let all_terms = to_list_net net in let xml_type ty = xml_element "tyi" [("i",string_of_int (yy_lookup types ty))] [] in let xml_index tm = xml_element "tmi" [("i",string_of_int (mm_lookup net tm))] [] in let out_term tm = if is_var tm then let (name,ty) = dest_var tm in out (xml_element "tmv" [("n",encodeXMLEntities name);("t", string_of_int (yy_lookup types ty))] []) else if is_const tm then let (name, ty) = (dest_const tm) in let general_ty = get_const_type name in let atts = [("n",encodeXMLEntities name)] in if polymorphic general_ty then out (xml_element "tmc" (atts@[("t",string_of_int (yy_lookup types ty))]) []) else out (xml_element "tmc" atts []) else if is_comb tm then let (f,a) = dest_comb tm in out (xml_element "tma" [("f", string_of_int (mm_lookup net f));("a",string_of_int (mm_lookup net a))] []) else let (x,a) = dest_abs tm in out (xml_element "tml" [("x", string_of_int (mm_lookup net x));("a",string_of_int (mm_lookup net a))] []) in out ""; app out_term all_terms; out "";; (* ---- collect_types_terms ---- *) let collect_types_terms thyname out prf c_opt = let will_be_shared prf = ( match disk_info_of prf with Some _ -> true | None -> do_share prf) in let types = yy_empty () in let terms = mm_empty () in let insert_type ty = yy_insert types ty in let insert_term tm = (mm_insert terms tm; app (yy_insert types) (types_of tm)) in let rec ct' prf = (match content_of prf with Pinstt(prf,tsubst) -> (app (function {redex=x;residue=u}->(insert_type x; insert_type u)) tsubst; ct prf) | Psubst(prfs,tm,prf) -> (insert_term tm; ct prf; app ct prfs) | Pabs(prf,tm) -> (insert_term tm; ct prf) | Pdisch(prf,tm) -> (insert_term tm; ct prf) | Pmp(prf1,prf2) -> (ct prf1; ct prf2) | Poracle(_,tms,tm) -> (insert_term tm; app insert_term tms) | Pdef(_,_,tm) -> insert_term tm | Ptmspec(_,_,prf) -> ct prf | Ptydef(_,_,prf) -> ct prf | Ptyintro(_,_,_,_,pt,tt,prf) -> (insert_term pt; insert_term tt;ct prf) | Pspec(prf,tm) -> (insert_term tm; ct prf) | Pinst(prf,subst) -> (app (fun{redex=x;residue=u}->(insert_term x; insert_term u)) subst; ct prf) | Pgen(prf,tm) -> (insert_term tm; ct prf) | Pgenabs(prf,tm_opt,tms) -> (match tm_opt with Some tm -> insert_term tm | None -> (); app insert_term tms; ct prf) | Psym prf -> ct prf | Ptrans(prf1,prf2) -> (ct prf1; ct prf2) | Pcomb(prf1,prf2) -> (ct prf1; ct prf2) | Peqmp(prf1,prf2) -> (ct prf1; ct prf2) | Peqimp prf -> ct prf | Pexists(prf,ex,w) -> (insert_term ex; insert_term w; ct prf) | Pchoose(v,prf1,prf2) -> (insert_term v; ct prf1; ct prf2) | Pconj(prf1,prf2) -> (ct prf1; ct prf2) | Pconjunct1 prf -> ct prf | Pconjunct2 prf -> ct prf | Pdisj1(prf,tm) -> (insert_term tm; ct prf) | Pdisj2(prf,tm) -> (insert_term tm; ct prf) | Pdisjcases(prf1,prf2,prf3) -> (ct prf1; ct prf2; ct prf3) | Pnoti prf -> ct prf | Pnote prf -> ct prf | Pcontr(prf,tm) -> (insert_term tm; ct prf) | Prefl tm -> insert_term tm | Phyp tm -> insert_term tm | Pdisk -> () | Paxm (_,tm) -> insert_term tm | Pimpas (prf1,prf2) -> (ct prf1; ct prf2)) and ct prf = if will_be_shared prf then () else ct' prf in let _ = ct' prf in let _ = (match c_opt with Some c -> insert_term c | None -> ()) in let _ = yy_output_types out thyname types in let _ = mm_output_terms out thyname types terms in (types,terms);; let rec export_proof path thyname thmname p c_opt il = let outchannel = open_out (Filename.concat path (thmname^".prf")) in let out = output_string outchannel in let nout = encodeXMLEntitiesOut out in let _ = out "" in let (types,terms) = collect_types_terms thyname out p c_opt in let wti att tm = (out " "; out att; out "=\""; out (string_of_int (mm_lookup terms tm)); out "\"") in let wt tm = try (out "") with Not_found -> raise (Err("export_proof","Term not found!")) in let wty ty = try (out "") with Not_found -> raise (Err("export_proof","Type not found!")) in let wdi thy thm = (out "") in let write_proof p il = (let rec share_info_of p il = (match (disk_info_of p) with Some (thyname,thmname) -> Some(thyname,thmname,il) | None -> if do_share p then let name = get_iname() in set_disk_info_of p thyname name; Some(thyname,name,(name,p,None)::il) else None ) and dump str il prfs = (let _ = out (xml_start_tag str) in let res = rev_itlist (function p -> function il -> wp il p) prfs il in let _ = out (xml_end_tag str) in res) and wp' il = (function (Prefl tm) -> (out ""; il) | (Pinstt(p,lambda)) -> (let _ = out "" in let res = wp il p in let _ = app wty (explode_subst lambda) in let _ = out "" in res) | (Psubst(ps,t,p)) -> (let _ = (out "") in let il' = wp il p in let res = rev_itlist (function p -> function il -> wp il p) ps il' in let _ = out "" in res) | (Pabs(p,t)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Pdisch(p,tm)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Pmp(p1,p2)) -> dump "pmp" il [p1;p2] | (Phyp tm) -> (out ""; il) | (Paxm(name,tm)) -> (out ""; il) | (Pdef(seg,name,tm)) -> (out ""; il) | (Ptmspec(seg,names,p)) -> (let _ = (out "") in let res = wp il p in let _ = app (function s -> (out "")) names in let _ = out "" in res) | (Ptydef(seg,name,p)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Ptyintro(seg,name,abs,rep,pt,tt,p)) -> (let _ = (out "") in let _ = wt pt in let _ = wt tt in let res = wp il p in let _ = out "" in res) | (Poracle(tg,asl,c)) -> raise (Err("export_proof", "sorry, oracle export is not implemented!")) (* (out ""; app (function s -> (out "")) (Tag.oracles_of tg); wt c; app wt asl; out ""; il)*) | (Pspec(p,t)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Pinst(p,theta)) -> (let _ = out "" in let res = wp il p in let _ = app wt (explode_subst theta) in let _ = out "" in res) | (Pgen(p,x)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Pgenabs(p,opt,vl)) -> (let _ = out " wti "i" c | None -> ()) in let _ = out ">" in let res = wp il p in let _ = app wt vl in let _ = out "" in res) | (Psym p) -> dump "psym" il [p] | (Ptrans(p1,p2)) -> dump "ptrans" il [p1;p2] | (Pcomb(p1,p2)) -> dump "pcomb" il [p1;p2] | (Peqmp(p1,p2)) -> dump "peqmp" il [p1;p2] | (Peqimp p) -> dump "peqimp" il [p] | (Pexists(p,ex,w)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Pchoose(v,p1,p2)) -> (let _ = (out "") in let il' = wp il p1 in let res = wp il' p2 in let _ = out "" in res) | (Pconj(p1,p2)) -> dump "pconj" il [p1;p2] | (Pimpas(p1,p2)) -> dump "pimpas" il [p1;p2] | (Pconjunct1 p) -> dump "pconjunct1" il [p] | (Pconjunct2 p) -> dump "pconjunct2" il [p] | (Pdisj1(p,tm)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Pdisj2(p,tm)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | (Pdisjcases(p1,p2,p3)) -> dump "pdisjcases" il [p1;p2;p3] | (Pnoti p) -> dump "pnoti" il [p] | (Pnote p) -> dump "pnote" il [p] | (Pcontr(p,tm)) -> (let _ = (out "") in let res = wp il p in let _ = out "" in res) | Pdisk -> raise (Err("wp'","shouldn't try to write pdisk")) ) and wp il p = (let res = match (share_info_of p il) with Some(thyname',thmname,il') -> (wdi thyname' thmname; il') | None -> wp' il (content_of p) in res) in let res = (match disk_info_of p with Some(thyname',thmname') -> if thyname' = thyname & thmname' = thmname then wp' il (content_of p) else (wdi thyname' thmname'; il) | None -> wp' il (content_of p)) in res) in let il = write_proof p il in let _ = (match c_opt with Some c -> wt c | None -> ()) in let _ = (out "\n";(close_out outchannel)) in let _ = set_disk_info_of p thyname thmname in match il with [] -> () (* everything has been written *) | ((thmname',prf,c_opt)::rest) -> export_proof path thyname thmname' prf c_opt rest;; let export_proofs theory_name l' = let theory_name = match theory_name with None -> THEORY_NAME | Some n -> n in let path = ensure_export_directory theory_name in let ostrm = open_out (Filename.concat path "facts.lst") in let out = output_string ostrm in let _ = app (function (s,_,_) -> out (s^"\n")) l' in let _ = flush ostrm in let _ = (match l' with [] -> () | ((thmname,p,c_opt)::rest) -> export_proof path theory_name thmname p c_opt rest) in let num_int_thms = next_counter() - 1 in let _ = out ((string_of_int num_int_thms)^"\n");(close_out ostrm) in ();; let the_proof_database = ref ([]:(string*proof*(term option)) list);; exception Duplicate_proof_name;; let rec search_proof_name n db = match db with [] -> () | ((m, a, b)::db') -> if n=m then (raise Duplicate_proof_name) else search_proof_name n db' let save_proof name p c_opt = let _ = search_proof_name name (!the_proof_database) in (the_proof_database := (name, p, c_opt)::(!the_proof_database));; let proof_database () = !the_proof_database;; (* this is a little bit dangerous, because the function is not injective, but I guess one can live with that *) let make_filesystem_compatible s = let modify = function | "/" -> "_slash_" | "\\" -> "_backslash_" | "=" -> "_equal_" | ">" -> "_greaterthan_" | "<" -> "_lessthan_" | "?" -> "_questionmark_" | "!" -> "_exclamationmark_" | "*" -> "_star_" | s -> s in implode (map modify (explode s));; let export_saved_proofs thy = let context = rev (proof_database ()) in export_proofs thy (map (function (s,p,c) -> (make_filesystem_compatible s,p,c)) context);; end;; include Proofobjects;; hol-light/Proofrecording/diffs/tactics.ml000066400000000000000000001020241303454263000210050ustar00rootroot00000000000000(* ========================================================================= *) (* System of tactics (slightly different from any traditional LCF method). *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2006 *) (* ========================================================================= *) let null_inst = ([],[],[] :instantiation);; let null_meta = (([]:term list),null_inst);; (* ------------------------------------------------------------------------- *) (* A goal has labelled assumptions, and the hyps are now thms. *) (* ------------------------------------------------------------------------- *) type goal = (string * thm) list * term;; let equals_goal ((a,w):goal) ((a',w'):goal) = forall2 (fun (s,th) (s',th') -> s = s' && equals_thm th th') a a' && w = w';; (* ------------------------------------------------------------------------- *) (* A justification function for a goalstate [A1 ?- g1; ...; An ?- gn], *) (* starting from an initial goal A ?- g, is a function f such that for any *) (* instantiation @: *) (* *) (* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A@ |- g@ *) (* ------------------------------------------------------------------------- *) type justification = instantiation -> thm list -> thm;; (* ------------------------------------------------------------------------- *) (* The goalstate stores the subgoals, justification, current instantiation, *) (* and a list of metavariables. *) (* ------------------------------------------------------------------------- *) type goalstate = (term list * instantiation) * goal list * justification;; (* ------------------------------------------------------------------------- *) (* A goalstack is just a list of goalstates. Could go for more... *) (* ------------------------------------------------------------------------- *) type goalstack = goalstate list;; (* ------------------------------------------------------------------------- *) (* A refinement, applied to a goalstate [A1 ?- g1; ...; An ?- gn] *) (* yields a new goalstate with updated justification function, to *) (* give a possibly-more-instantiated version of the initial goal. *) (* ------------------------------------------------------------------------- *) type refinement = goalstate -> goalstate;; (* ------------------------------------------------------------------------- *) (* A tactic, applied to a goal A ?- g, returns: *) (* *) (* o A list of new metavariables introduced *) (* o An instantiation (%) *) (* o A list of subgoals *) (* o A justification f such that for any instantiation @ we have *) (* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A(%;@) |- g(%;@) *) (* ------------------------------------------------------------------------- *) type tactic = goal -> goalstate;; type thm_tactic = thm -> tactic;; type thm_tactical = thm_tactic -> thm_tactic;; (* ------------------------------------------------------------------------- *) (* Apply instantiation to a goal. *) (* ------------------------------------------------------------------------- *) let (inst_goal:instantiation->goal->goal) = fun p (thms,w) -> map (I F_F INSTANTIATE_ALL p) thms,instantiate p w;; (* ------------------------------------------------------------------------- *) (* Perform a sequential composition (left first) of instantiations. *) (* ------------------------------------------------------------------------- *) let (compose_insts :instantiation->instantiation->instantiation) = fun ((pats1,tmin1,tyin1) as i1) ((pats2,tmin2,tyin2) as i2) -> let tmin = map (instantiate i2 F_F inst tyin2) tmin1 and tyin = map (type_subst tyin2 F_F I) tyin1 in let tmin' = filter (fun (_,x) -> not (can (rev_assoc x) tmin)) tmin2 and tyin' = filter (fun (_,a) -> not (can (rev_assoc a) tyin)) tyin2 in pats1@pats2,tmin@tmin',tyin@tyin';; (* ------------------------------------------------------------------------- *) (* Construct A,_FALSITY_ |- p; contortion so falsity is the last element. *) (* ------------------------------------------------------------------------- *) let _FALSITY_ = new_definition `_FALSITY_ = F`;; let mk_fthm = let pth = UNDISCH(fst(EQ_IMP_RULE _FALSITY_)) and qth = ASSUME `_FALSITY_` in fun (asl,c) -> PROVE_HYP qth (itlist ADD_ASSUM (rev asl) (CONTR c pth));; (* ------------------------------------------------------------------------- *) (* Validity checking of tactics. This cannot be 100% accurate without making *) (* arbitrary theorems, but "mk_fthm" brings us quite close. *) (* ------------------------------------------------------------------------- *) let (VALID:tactic->tactic) = let fake_thm (asl,w) = let asms = itlist (union o hyp o snd) asl [] in mk_fthm(asms,w) and false_tm = `_FALSITY_` in fun tac (asl,w) -> let ((mvs,i),gls,just as res) = tac (asl,w) in let ths = map fake_thm gls in let asl',w' = dest_thm(just null_inst ths) in let asl'',w'' = inst_goal i (asl,w) in let maxasms = itlist (fun (_,th) -> union (insert (concl th) (hyp th))) asl'' [] in if aconv w' w'' && forall (C mem maxasms) (subtract asl' [false_tm]) then res else failwith "VALID: Invalid tactic";; (* ------------------------------------------------------------------------- *) (* Various simple combinators for tactics, identity tactic etc. *) (* ------------------------------------------------------------------------- *) let (THEN),(THENL) = let propagate_empty i [] = [] and propagate_thm th i [] = INSTANTIATE_ALL i th in let compose_justs n just1 just2 i ths = let ths1,ths2 = chop_list n ths in (just1 i ths1)::(just2 i ths2) in let rec seqapply l1 l2 = match (l1,l2) with ([],[]) -> null_meta,[],propagate_empty | ((tac:tactic)::tacs),((goal:goal)::goals) -> let ((mvs1,insts1),gls1,just1 as gstate1) = tac goal in let goals' = map (inst_goal insts1) goals in let ((mvs2,insts2),gls2,just2 as gstate2) = seqapply tacs goals' in ((union mvs1 mvs2,compose_insts insts1 insts2), gls1@gls2,compose_justs (length gls1) just1 just2) | _,_ -> failwith "seqapply: Length mismatch" in let justsequence just1 just2 insts2 i ths = just1 (compose_insts insts2 i) (just2 i ths) in let tacsequence ((mvs1,insts1),gls1,just1 as gstate1) tacl = let ((mvs2,insts2),gls2,just2 as gstate2) = seqapply tacl gls1 in let jst = justsequence just1 just2 insts2 in let just = if gls2 = [] then propagate_thm (jst null_inst []) else jst in ((union mvs1 mvs2,compose_insts insts1 insts2),gls2,just) in let (then_: tactic -> tactic -> tactic) = fun tac1 tac2 g -> let _,gls,_ as gstate = tac1 g in tacsequence gstate (replicate tac2 (length gls)) and (thenl_: tactic -> tactic list -> tactic) = fun tac1 tac2l g -> let _,gls,_ as gstate = tac1 g in if gls = [] then tacsequence gstate [] else tacsequence gstate tac2l in then_,thenl_;; let ((ORELSE): tactic -> tactic -> tactic) = fun tac1 tac2 g -> try tac1 g with Failure _ -> tac2 g;; let (FAIL_TAC: string -> tactic) = fun tok g -> failwith tok;; let (NO_TAC: tactic) = FAIL_TAC "NO_TAC";; let (ALL_TAC:tactic) = fun g -> null_meta,[g],fun _ [th] -> th;; let TRY tac = tac ORELSE ALL_TAC;; let rec REPEAT tac g = ((tac THEN REPEAT tac) ORELSE ALL_TAC) g;; let EVERY tacl = itlist (fun t1 t2 -> t1 THEN t2) tacl ALL_TAC;; let (FIRST: tactic list -> tactic) = fun tacl g -> end_itlist (fun t1 t2 -> t1 ORELSE t2) tacl g;; let MAP_EVERY tacf lst = EVERY (map tacf lst);; let MAP_FIRST tacf lst = FIRST (map tacf lst);; let (CHANGED_TAC: tactic -> tactic) = fun tac g -> let (meta,gl,_ as gstate) = tac g in if meta = null_meta && length gl = 1 && equals_goal (hd gl) g then failwith "CHANGED_TAC" else gstate;; let rec REPLICATE_TAC n tac = if n <= 0 then ALL_TAC else tac THEN (REPLICATE_TAC (n - 1) tac);; (* ------------------------------------------------------------------------- *) (* Combinators for theorem continuations / "theorem tacticals". *) (* ------------------------------------------------------------------------- *) let ((THEN_TCL): thm_tactical -> thm_tactical -> thm_tactical) = fun ttcl1 ttcl2 ttac -> ttcl1 (ttcl2 ttac);; let ((ORELSE_TCL): thm_tactical -> thm_tactical -> thm_tactical) = fun ttcl1 ttcl2 ttac th -> try ttcl1 ttac th with Failure _ -> ttcl2 ttac th;; let rec REPEAT_TCL ttcl ttac th = ((ttcl THEN_TCL (REPEAT_TCL ttcl)) ORELSE_TCL I) ttac th;; let (REPEAT_GTCL: thm_tactical -> thm_tactical) = let rec REPEAT_GTCL ttcl ttac th g = try ttcl (REPEAT_GTCL ttcl ttac) th g with Failure _ -> ttac th g in REPEAT_GTCL;; let (ALL_THEN: thm_tactical) = I;; let (NO_THEN: thm_tactical) = fun ttac th -> failwith "NO_THEN";; let EVERY_TCL ttcll = itlist (fun t1 t2 -> t1 THEN_TCL t2) ttcll ALL_THEN;; let FIRST_TCL ttcll = end_itlist (fun t1 t2 -> t1 ORELSE_TCL t2) ttcll;; (* ------------------------------------------------------------------------- *) (* Tactics to augment assumption list. Note that to allow "ASSUME p" for *) (* any assumption "p", these add a PROVE_HYP in the justification function, *) (* just in case. *) (* ------------------------------------------------------------------------- *) let (LABEL_TAC: string -> thm_tactic) = fun s thm (asl,w) -> null_meta,[(s,thm)::asl,w], fun i [th] -> PROVE_HYP (INSTANTIATE_ALL i thm) th;; let ASSUME_TAC = LABEL_TAC "";; (* ------------------------------------------------------------------------- *) (* Manipulation of assumption list. *) (* ------------------------------------------------------------------------- *) let (FIND_ASSUM: thm_tactic -> term -> tactic) = fun ttac t ((asl,w) as g) -> ttac(snd(find (fun (_,th) -> concl th = t) asl)) g;; let (POP_ASSUM: thm_tactic -> tactic) = fun ttac -> function (((_,th)::asl),w) -> ttac th (asl,w) | _ -> failwith "POP_ASSUM: No assumption to pop";; let (ASSUM_LIST: (thm list -> tactic) -> tactic) = fun aslfun (asl,w) -> aslfun (map snd asl) (asl,w);; let (POP_ASSUM_LIST: (thm list -> tactic) -> tactic) = fun asltac (asl,w) -> asltac (map snd asl) ([],w);; let (EVERY_ASSUM: thm_tactic -> tactic) = fun ttac -> ASSUM_LIST (MAP_EVERY ttac);; let (FIRST_ASSUM: thm_tactic -> tactic) = fun ttac (asl,w as g) -> tryfind (fun (_,th) -> ttac th g) asl;; let (RULE_ASSUM_TAC :(thm->thm)->tactic) = fun rule (asl,w as gl) -> (POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY (fun (s,th) -> LABEL_TAC s (rule th)) (rev asl)) (asl,w);; (* ------------------------------------------------------------------------- *) (* Operate on assumption identified by a label. *) (* ------------------------------------------------------------------------- *) let (USE_THEN:string->thm_tactic->tactic) = fun s ttac (asl,w as gl) -> let th = try assoc s asl with Failure _ -> failwith("USE_TAC: didn't find assumption "^s) in ttac th gl;; let (REMOVE_THEN:string->thm_tactic->tactic) = fun s ttac (asl,w as gl) -> let th = try assoc s asl with Failure _ -> failwith("USE_TAC: didn't find assumption "^s) in let asl1,asl2 = chop_list(index s (map fst asl)) asl in let asl' = asl1 @ tl asl2 in ttac th (asl',w);; (* ------------------------------------------------------------------------- *) (* General tool to augment a required set of theorems with assumptions. *) (* ------------------------------------------------------------------------- *) let (ASM :(thm list -> tactic)->(thm list -> tactic)) = fun tltac ths (asl,w as g) -> tltac (map snd asl @ ths) g;; (* ------------------------------------------------------------------------- *) (* Basic tactic to use a theorem equal to the goal. Does *no* matching. *) (* ------------------------------------------------------------------------- *) let (ACCEPT_TAC: thm_tactic) = let propagate_thm th i [] = INSTANTIATE_ALL i th in fun th (asl,w) -> if aconv (concl th) w then null_meta,[],propagate_thm th else failwith "ACCEPT_TAC";; (* ------------------------------------------------------------------------- *) (* Create tactic from a conversion. This allows the conversion to return *) (* |- p rather than |- p = T on a term "p". It also eliminates any goals of *) (* the form "T" automatically. *) (* ------------------------------------------------------------------------- *) let (CONV_TAC: conv -> tactic) = let t_tm = `T` in fun conv ((asl,w) as g) -> let th = conv w in let tm = concl th in if aconv tm w then ACCEPT_TAC th g else let l,r = dest_eq tm in if not(aconv l w) then failwith "CONV_TAC: bad equation" else if r = t_tm then ACCEPT_TAC(EQT_ELIM th) g else let th' = SYM th in null_meta,[asl,r],fun i [th] -> EQ_MP (INSTANTIATE_ALL i th') th;; (* ------------------------------------------------------------------------- *) (* Tactics for equality reasoning. *) (* ------------------------------------------------------------------------- *) let (REFL_TAC: tactic) = fun ((asl,w) as g) -> try ACCEPT_TAC(REFL(rand w)) g with Failure _ -> failwith "REFL_TAC";; let (ABS_TAC: tactic) = fun (asl,w) -> try let l,r = dest_eq w in let lv,lb = dest_abs l and rv,rb = dest_abs r in let avoids = itlist (union o thm_frees o snd) asl (frees w) in let v = mk_primed_var avoids lv in null_meta,[asl,mk_eq(vsubst[v,lv] lb,vsubst[v,rv] rb)], fun i [th] -> let ath = ABS v th in EQ_MP (ALPHA (concl ath) (instantiate i w)) ath with Failure _ -> failwith "ABS_TAC";; let (MK_COMB_TAC: tactic) = fun (asl,gl) -> try let l,r = dest_eq gl in let f,x = dest_comb l and g,y = dest_comb r in null_meta,[asl,mk_eq(f,g); asl,mk_eq(x,y)], fun _ [th1;th2] -> MK_COMB(th1,th2) with Failure _ -> failwith "MK_COMB_TAC";; let (AP_TERM_TAC: tactic) = let tac = MK_COMB_TAC THENL [REFL_TAC; ALL_TAC] in fun gl -> try tac gl with Failure _ -> failwith "AP_TERM_TAC";; let (AP_THM_TAC: tactic) = let tac = MK_COMB_TAC THENL [ALL_TAC; REFL_TAC] in fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; let (BINOP_TAC: tactic) = let tac = MK_COMB_TAC THENL [AP_TERM_TAC; ALL_TAC] in fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; let (SUBST1_TAC: thm_tactic) = fun th -> CONV_TAC(SUBS_CONV [th]);; let SUBST_ALL_TAC rth = SUBST1_TAC rth THEN RULE_ASSUM_TAC (SUBS [rth]);; let BETA_TAC = CONV_TAC(REDEPTH_CONV BETA_CONV);; (* ------------------------------------------------------------------------- *) (* Just use an equation to substitute if possible and uninstantiable. *) (* ------------------------------------------------------------------------- *) let SUBST_VAR_TAC th = try let asm,eq = dest_thm th in let l,r = dest_eq eq in if aconv l r then ALL_TAC else if not (subset (frees eq) (freesl asm)) then fail() else if (is_const l or is_var l) && not(free_in l r) then SUBST_ALL_TAC th else if (is_const r or is_var r) && not(free_in r l) then SUBST_ALL_TAC(SYM th) else fail() with Failure _ -> failwith "SUBST_VAR_TAC";; (* ------------------------------------------------------------------------- *) (* Basic logical tactics. *) (* ------------------------------------------------------------------------- *) let (DISCH_TAC: tactic) = let f_tm = `F` in fun (asl,w) -> try let ant,c = dest_imp w in let th1 = ASSUME ant in null_meta,[("",th1)::asl,c], fun i [th] -> DISCH (instantiate i ant) th with Failure _ -> try let ant = dest_neg w in let th1 = ASSUME ant in null_meta,[("",th1)::asl,f_tm], fun i [th] -> NOT_INTRO(DISCH (instantiate i ant) th) with Failure _ -> failwith "DISCH_TAC";; let (MP_TAC: thm_tactic) = fun thm (asl,w) -> null_meta,[asl,mk_imp(concl thm,w)], fun i [th] -> MP th (INSTANTIATE_ALL i thm);; let (EQ_TAC: tactic) = fun (asl,w) -> try let l,r = dest_eq w in null_meta,[asl, mk_imp(l,r); asl, mk_imp(r,l)], fun _ [th1; th2] -> IMP_ANTISYM_RULE th1 th2 with Failure _ -> failwith "EQ_TAC";; let (UNDISCH_TAC: term -> tactic) = fun tm (asl,w) -> try let sthm,asl' = remove (fun (_,asm) -> aconv (concl asm) tm) asl in let thm = snd sthm in null_meta,[asl',mk_imp(tm,w)], fun i [th] -> MP th (INSTANTIATE_ALL i thm) with Failure _ -> failwith "UNDISCH_TAC";; let (SPEC_TAC: term * term -> tactic) = fun (t,x) (asl,w) -> try null_meta,[asl, mk_forall(x,subst[x,t] w)], fun i [th] -> SPEC (instantiate i t) th with Failure _ -> failwith "SPEC_TAC";; let (X_GEN_TAC: term -> tactic) = fun x' -> if not(is_var x') then failwith "X_GEN_TAC" else fun (asl,w) -> try let x,bod = dest_forall w in let avoids = itlist (union o thm_frees o snd) asl (frees w) in if mem x' avoids then failwith "X_GEN_TAC" else let afn = CONV_RULE(GEN_ALPHA_CONV x) in null_meta,[asl,vsubst[x',x] bod], fun i [th] -> afn (GEN x' th) with Failure _ -> failwith "X_GEN_TAC";; let (GEN_TAC: tactic) = fun (asl,w) -> try let x = fst(dest_forall w) in let avoids = itlist (union o thm_frees o snd) asl (frees w) in let x' = mk_primed_var avoids x in X_GEN_TAC x' (asl,w) with Failure _ -> failwith "GEN_TAC";; let (EXISTS_TAC: term -> tactic) = fun t (asl,w) -> try let v,bod = dest_exists w in null_meta,[asl,vsubst[t,v] bod], fun i [th] -> EXISTS (instantiate i w,instantiate i t) th with Failure _ -> failwith "EXISTS_TAC";; let (X_CHOOSE_TAC: term -> thm_tactic) = fun x' xth -> try let xtm = concl xth in let x,bod = dest_exists xtm in let pat = vsubst[x',x] bod in let xth' = ASSUME pat in fun (asl,w) -> let avoids = itlist (union o frees o concl o snd) asl (union (frees w) (thm_frees xth)) in if mem x' avoids then failwith "X_CHOOSE_TAC" else null_meta,[("",xth')::asl,w], fun i [th] -> CHOOSE(x',INSTANTIATE_ALL i xth) th with Failure _ -> failwith "X_CHOOSE_TAC";; let (CHOOSE_TAC: thm_tactic) = fun xth -> try let x = fst(dest_exists(concl xth)) in fun (asl,w) -> let avoids = itlist (union o thm_frees o snd) asl (union (frees w) (thm_frees xth)) in let x' = mk_primed_var avoids x in X_CHOOSE_TAC x' xth (asl,w) with Failure _ -> failwith "CHOOSE_TAC";; let (CONJ_TAC: tactic) = fun (asl,w) -> try let l,r = dest_conj w in null_meta,[asl,l; asl,r],fun _ [th1;th2] -> CONJ th1 th2 with Failure _ -> failwith "CONJ_TAC";; let (DISJ1_TAC: tactic) = fun (asl,w) -> try let l,r = dest_disj w in null_meta,[asl,l],fun i [th] -> DISJ1 th (instantiate i r) with Failure _ -> failwith "DISJ1_TAC";; let (DISJ2_TAC: tactic) = fun (asl,w) -> try let l,r = dest_disj w in null_meta,[asl,r],fun i [th] -> DISJ2 (instantiate i l) th with Failure _ -> failwith "DISJ2_TAC";; let (DISJ_CASES_TAC: thm_tactic) = fun dth -> try let dtm = concl dth in let l,r = dest_disj dtm in let thl = ASSUME l and thr = ASSUME r in fun (asl,w) -> null_meta,[("",thl)::asl,w; ("",thr)::asl,w], fun i [th1;th2] -> DISJ_CASES (INSTANTIATE_ALL i dth) th1 th2 with Failure _ -> failwith "DISJ_CASES_TAC";; let (CONTR_TAC: thm_tactic) = let propagate_thm th i [] = INSTANTIATE_ALL i th in fun cth (asl,w) -> try let th = CONTR w cth in null_meta,[],propagate_thm th with Failure _ -> failwith "CONTR_TAC";; let (MATCH_ACCEPT_TAC:thm_tactic) = let propagate_thm th i [] = INSTANTIATE_ALL i th in let rawtac th (asl,w) = try let ith = PART_MATCH I th w in null_meta,[],propagate_thm ith with Failure _ -> failwith "ACCEPT_TAC" in fun th -> REPEAT GEN_TAC THEN rawtac th;; let (MATCH_MP_TAC :thm_tactic) = fun th -> let sth = try let tm = concl th in let avs,bod = strip_forall tm in let ant,con = dest_imp bod in let th1 = SPECL avs (ASSUME tm) in let th2 = UNDISCH th1 in let evs = filter (fun v -> vfree_in v ant && not (vfree_in v con)) avs in let th3 = itlist SIMPLE_CHOOSE evs (DISCH tm th2) in let tm3 = hd(hyp th3) in MP (DISCH tm (GEN_ALL (DISCH tm3 (UNDISCH th3)))) th with Failure _ -> failwith "MATCH_MP_TAC: Bad theorem" in let match_fun = PART_MATCH (snd o dest_imp) sth in fun (asl,w) -> try let xth = match_fun w in let lant = fst(dest_imp(concl xth)) in null_meta,[asl,lant], fun i [th] -> MP (INSTANTIATE_ALL i xth) th with Failure _ -> failwith "MATCH_MP_TAC: No match";; (* ------------------------------------------------------------------------- *) (* Theorem continuations. *) (* ------------------------------------------------------------------------- *) let (CONJUNCTS_THEN2:thm_tactic->thm_tactic->thm_tactic) = fun ttac1 ttac2 cth -> let c1,c2 = dest_conj(concl cth) in fun gl -> let ti,gls,jfn = (ttac1(ASSUME c1) THEN ttac2(ASSUME c2)) gl in let jfn' i ths = let th1,th2 = CONJ_PAIR(INSTANTIATE_ALL i cth) in PROVE_HYP th1 (PROVE_HYP th2 (jfn i ths)) in ti,gls,jfn';; let (CONJUNCTS_THEN: thm_tactical) = W CONJUNCTS_THEN2;; let (DISJ_CASES_THEN2:thm_tactic->thm_tactic->thm_tactic) = fun ttac1 ttac2 cth -> DISJ_CASES_TAC cth THENL [POP_ASSUM ttac1; POP_ASSUM ttac2];; let (DISJ_CASES_THEN: thm_tactical) = W DISJ_CASES_THEN2;; let (DISCH_THEN: thm_tactic -> tactic) = fun ttac -> DISCH_TAC THEN POP_ASSUM ttac;; let (X_CHOOSE_THEN: term -> thm_tactical) = fun x ttac th -> X_CHOOSE_TAC x th THEN POP_ASSUM ttac;; let (CHOOSE_THEN: thm_tactical) = fun ttac th -> CHOOSE_TAC th THEN POP_ASSUM ttac;; (* ------------------------------------------------------------------------- *) (* Various derived tactics and theorem continuations. *) (* ------------------------------------------------------------------------- *) let STRIP_THM_THEN = FIRST_TCL [CONJUNCTS_THEN; DISJ_CASES_THEN; CHOOSE_THEN];; let (ANTE_RES_THEN: thm_tactical) = fun ttac ante -> ASSUM_LIST (EVERY o (mapfilter (fun imp -> ttac (MATCH_MP imp ante))));; let (IMP_RES_THEN: thm_tactical) = fun ttac imp -> ASSUM_LIST (EVERY o (mapfilter (fun ante -> ttac (MATCH_MP imp ante))));; let STRIP_ASSUME_TAC = let DISCARD_TAC th = let tm = concl th in fun (asl,w as g) -> if exists (fun a -> aconv tm (concl(snd a))) asl then ALL_TAC g else failwith "DISCARD_TAC: not already present" in (REPEAT_TCL STRIP_THM_THEN) (fun gth -> FIRST [CONTR_TAC gth; ACCEPT_TAC gth; DISCARD_TAC gth; ASSUME_TAC gth]);; let STRUCT_CASES_TAC = REPEAT_TCL STRIP_THM_THEN (fun th -> SUBST1_TAC th ORELSE ASSUME_TAC th);; let STRIP_GOAL_THEN ttac = FIRST [GEN_TAC; CONJ_TAC; DISCH_THEN ttac];; let (STRIP_TAC: tactic) = fun g -> try STRIP_GOAL_THEN STRIP_ASSUME_TAC g with Failure _ -> failwith "STRIP_TAC";; let (UNDISCH_THEN:term->thm_tactic->tactic) = fun tm ttac (asl,w) -> let thp,asl' = remove (fun (_,th) -> aconv (concl th) tm) asl in ttac (snd thp) (asl',w);; let FIRST_X_ASSUM ttac = FIRST_ASSUM(fun th -> UNDISCH_THEN (concl th) ttac);; (* ------------------------------------------------------------------------- *) (* Subgoaling and freezing variables (latter is especially useful now). *) (* ------------------------------------------------------------------------- *) let (SUBGOAL_THEN: term -> thm_tactic -> tactic) = fun wa ttac (asl,w) -> let meta,gl,just = ttac (ASSUME wa) (asl,w) in meta,(asl,wa)::gl,fun i l -> PROVE_HYP (hd l) (just i (tl l));; let SUBGOAL_TAC s tm prfs = match prfs with p::ps -> (warn (ps <> []) "SUBGOAL_TAC: additional subproofs ignored"; SUBGOAL_THEN tm (LABEL_TAC s) THENL [p; ALL_TAC]) | [] -> failwith "SUBGOAL_TAC: no subproof given";; let (FREEZE_THEN :thm_tactical) = fun ttac th -> SUBGOAL_THEN (concl th) ttac THENL [ACCEPT_TAC th; ALL_TAC];; (* ------------------------------------------------------------------------- *) (* Metavariable tactics. *) (* ------------------------------------------------------------------------- *) let (X_META_EXISTS_TAC: term -> tactic) = fun t (asl,w) -> try if not (is_var t) then fail() else let v,bod = dest_exists w in ([t],null_inst),[asl,vsubst[t,v] bod], fun i [th] -> EXISTS (instantiate i w,instantiate i t) th with Failure _ -> failwith "X_META_EXISTS_TAC";; let META_EXISTS_TAC ((asl,w) as gl) = let v = fst(dest_exists w) in let avoids = itlist (union o frees o concl o snd) asl (frees w) in let v' = mk_primed_var avoids v in X_META_EXISTS_TAC v' gl;; let (META_SPEC_TAC: term -> thm -> tactic) = fun t thm (asl,w) -> let sth = SPEC t thm in ([t],null_inst),[(("",sth)::asl),w], fun i [th] -> PROVE_HYP (SPEC (instantiate i t) thm) th;; (* ------------------------------------------------------------------------- *) (* If all else fails! *) (* ------------------------------------------------------------------------- *) let (CHEAT_TAC:tactic) = fun (asl,w) -> ACCEPT_TAC(mk_thm([],w)) (asl,w);; (* ------------------------------------------------------------------------- *) (* Intended for time-consuming rules; delays evaluation till it sees goal. *) (* ------------------------------------------------------------------------- *) let RECALL_ACCEPT_TAC r a g = ACCEPT_TAC(time r a) g;; (* ------------------------------------------------------------------------- *) (* Split off antecedent of antecedent as a subgoal. *) (* ------------------------------------------------------------------------- *) let ANTS_TAC = let tm1 = `p /\ (q ==> r)` and tm2 = `p ==> q` in let th1,th2 = CONJ_PAIR(ASSUME tm1) in let th = itlist DISCH [tm1;tm2] (MP th2 (MP(ASSUME tm2) th1)) in MATCH_MP_TAC th THEN CONJ_TAC;; (* ------------------------------------------------------------------------- *) (* A printer for goals etc. *) (* ------------------------------------------------------------------------- *) let (print_goal:goal->unit) = let print_hyp n (s,th) = open_hbox(); print_string " "; print_as 3 (string_of_int n); print_string " ["; print_qterm (concl th); print_string "]"; (if not (s = "") then (print_string (" ("^s^")")) else ()); close_box(); print_newline() in let rec print_hyps n asl = if asl = [] then () else (print_hyp n (hd asl); print_hyps (n + 1) (tl asl)) in fun (asl,w) -> print_newline(); if asl <> [] then (print_hyps 0 (rev asl); print_newline()) else (); print_qterm w; print_newline();; let (print_goalstack:goalstack->unit) = let print_goalstate k gs = let (_,gl,_) = gs in let n = length gl in let s = if n = 0 then "No subgoals" else (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") ^" ("^(string_of_int n)^" total)" in print_string s; print_newline(); if gl = [] then () else do_list (print_goal o C el gl) (rev(0--(k-1))) in fun l -> if l = [] then print_string "Empty goalstack" else if tl l = [] then let (_,gl,_ as gs) = hd l in print_goalstate 1 gs else let (_,gl,_ as gs) = hd l and (_,gl0,_) = hd(tl l) in let p = length gl - length gl0 in let p' = if p < 1 then 1 else p + 1 in print_goalstate p' gs;; (* ------------------------------------------------------------------------- *) (* Convert a tactic into a refinement on head subgoal in current state. *) (* ------------------------------------------------------------------------- *) let (by:tactic->refinement) = fun tac ((mvs,inst),gls,just) -> let g = hd gls and ogls = tl gls in let ((newmvs,newinst),subgls,subjust) = tac g in let n = length subgls in let mvs' = union newmvs mvs and inst' = compose_insts inst newinst and gls' = subgls @ map (inst_goal newinst) ogls in let just' i ths = let i' = compose_insts inst' i in let cths,oths = chop_list n ths in let sths = (subjust i cths) :: oths in just i' sths in (mvs',inst'),gls',just';; (* ------------------------------------------------------------------------- *) (* Rotate the goalstate either way. *) (* ------------------------------------------------------------------------- *) let (rotate:int->refinement) = let rotate_p (meta,sgs,just) = let sgs' = (tl sgs)@[hd sgs] in let just' i ths = let ths' = (last ths)::(butlast ths) in just i ths' in (meta,sgs',just') and rotate_n (meta,sgs,just) = let sgs' = (last sgs)::(butlast sgs) in let just' i ths = let ths' = (tl ths)@[hd ths] in just i ths' in (meta,sgs',just') in fun n -> if n > 0 then funpow n rotate_p else funpow (-n) rotate_n;; (* ------------------------------------------------------------------------- *) (* Perform refinement proof, tactic proof etc. *) (* ------------------------------------------------------------------------- *) let (mk_goalstate:goal->goalstate) = fun (asl,w) -> if type_of w = bool_ty then null_meta,[asl,w], (fun inst [th] -> INSTANTIATE_ALL inst th) else failwith "mk_goalstate: Non-boolean goal";; let (TAC_PROOF : goal * tactic -> thm) = fun (g,tac) -> let gstate = mk_goalstate g in let _,sgs,just = by tac gstate in if sgs = [] then just null_inst [] else failwith "TAC_PROOF: Unsolved goals";; let prove(t,tac) = let th = TAC_PROOF(([],t),tac) in let t' = concl th in if t' = t then th else try EQ_MP (ALPHA t' t) th with Failure _ -> failwith "prove: justification generated wrong theorem";; let nprove n s = let th = prove s in save_thm n th;; (* ------------------------------------------------------------------------- *) (* Interactive "subgoal package" stuff. *) (* ------------------------------------------------------------------------- *) let current_goalstack = ref ([] :goalstack);; let (refine:refinement->goalstack) = fun r -> let l = !current_goalstack in let h = hd l in let res = r h :: l in current_goalstack := res; !current_goalstack;; let flush_goalstack() = let l = !current_goalstack in current_goalstack := [hd l];; let e tac = refine(by(VALID tac));; let r n = refine(rotate n);; let set_goal(asl,w) = current_goalstack := [mk_goalstate(map (fun t -> "",ASSUME t) asl,w)]; !current_goalstack;; let g t = let fvs = sort (<) (map (fst o dest_var) (frees t)) in (if fvs <> [] then let errmsg = end_itlist (fun s t -> s^", "^t) fvs in warn true ("Free variables in goal: "^errmsg) else ()); set_goal([],t);; let b() = let l = !current_goalstack in if length l = 1 then failwith "Can't back up any more" else current_goalstack := tl l; !current_goalstack;; let p() = !current_goalstack;; let top_realgoal() = let (_,((asl,w)::_),_)::_ = !current_goalstack in asl,w;; let top_goal() = let asl,w = top_realgoal() in map (concl o snd) asl,w;; let top_thm() = let (_,[],f)::_ = !current_goalstack in f null_inst [];; (* ------------------------------------------------------------------------- *) (* Install the goal-related printers. *) (* ------------------------------------------------------------------------- *) #install_printer print_goal;; #install_printer print_goalstack;; hol-light/Proofrecording/diffs/thm.ml000066400000000000000000000344111303454263000201470ustar00rootroot00000000000000(* ========================================================================= *) (* Abstract type of theorems and primitive inference rules. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* A few bits of general derived syntax. *) (* ------------------------------------------------------------------------- *) let rator tm = match tm with Comb(l,r) -> l | _ -> failwith "rator: Not a combination";; let rand tm = match tm with Comb(l,r) -> r | _ -> failwith "rand: Not a combination";; (* ------------------------------------------------------------------------- *) (* Syntax operations for equations. *) (* ------------------------------------------------------------------------- *) let dest_eq tm = match tm with Comb(Comb(Const("=",_),l),r) -> l,r | _ -> failwith "dest_eq";; let is_eq tm = match tm with Comb(Comb(Const("=",_),_),_) -> true | _ -> false;; let mk_eq = let eq = mk_const("=",[]) in fun (l,r) -> try let ty = type_of l in let eq_tm = inst [ty,aty] eq in mk_comb(mk_comb(eq_tm,l),r) with Failure _ -> failwith "mk_eq";; (* ------------------------------------------------------------------------- *) (* Useful to have term union modulo alpha-conversion for assumption lists. *) (* ------------------------------------------------------------------------- *) let rec ordav env x1 x2 = match env with [] -> Pervasives.compare x1 x2 | (t1,t2 as tp)::oenv -> if Pervasives.compare x1 t1 = 0 then if Pervasives.compare x2 t2 = 0 then 0 else -1 else if Pervasives.compare x2 t2 = 0 then 1 else ordav oenv x1 x2 let rec orda env tm1 tm2 = if tm1 == tm2 && env = [] then 0 else match (tm1,tm2) with Var(x1,ty1),Var(x2,ty2) -> ordav env tm1 tm2 | Const(x1,ty1),Const(x2,ty2) -> Pervasives.compare tm1 tm2 | Comb(s1,t1),Comb(s2,t2) -> let c = orda env s1 s2 in if c <> 0 then c else orda env t1 t2 | Abs(Var(_,ty1) as x1,t1),Abs(Var(_,ty2) as x2,t2) -> let c = Pervasives.compare ty1 ty2 in if c <> 0 then c else orda ((x1,x2)::env) t1 t2 | Const(_,_),_ -> -1 | _,Const(_,_) -> 1 | Var(_,_),_ -> -1 | _,Var(_,_) -> 1 | Comb(_,_),_ -> -1 | _,Comb(_,_) -> 1 let alphaorder = orda [] let rec term_union l1 l2 = match (l1,l2) with ([],l2) -> l2 | (l1,[]) -> l1 | (h1::t1,h2::t2) -> let c = alphaorder h1 h2 in if c = 0 then h1::(term_union t1 t2) else if c < 0 then h1::(term_union t1 l2) else h2::(term_union l1 t2) let rec term_remove t l = match l with s::ss -> let c = alphaorder t s in if c > 0 then let ss' = term_remove t ss in if ss' == ss then l else s::ss' else if c = 0 then ss else l | [] -> l let rec term_image f l = match l with h::t -> let h' = f h and t' = term_image f t in if h' == h && t' == t then l else term_union [h'] t' | [] -> l (* ------------------------------------------------------------------------- *) (* The abstract type of theorems. *) (* ------------------------------------------------------------------------- *) module type Hol_thm_primitives = sig type thm val dest_thm : thm -> term list * term val hyp : thm -> term list val concl : thm -> term val REFL : term -> thm val TRANS : thm -> thm -> thm val MK_COMB : thm * thm -> thm val ABS : term -> thm -> thm val BETA : term -> thm val ASSUME : term -> thm val EQ_MP : thm -> thm -> thm val DEDUCT_ANTISYM_RULE : thm -> thm -> thm val INST_TYPE : (hol_type * hol_type) list -> thm -> thm val INST : (term * term) list -> thm -> thm val axioms : unit -> thm list val new_axiom : term -> thm val new_basic_definition : term -> thm val new_basic_type_definition : string -> string * string -> thm -> thm * thm val equals_thm : thm -> thm -> bool val le_thm : thm -> thm -> bool val less_thm : thm -> thm -> bool val proof_of : thm -> proof val substitute_proof : thm -> proof -> thm val save_thm : string -> thm -> thm end;; (* ------------------------------------------------------------------------- *) (* This is the implementation of those primitives. *) (* ------------------------------------------------------------------------- *) module Hol : Hol_thm_primitives = struct type thm = Sequent of (term list * term * proof) (* ------------------------------------------------------------------------- *) (* Basic theorem destructors. *) (* ------------------------------------------------------------------------- *) let dest_thm (Sequent(asl,c,_)) = (asl,c) let hyp (Sequent(asl,c,_)) = asl let concl (Sequent(asl,c,_)) = c (* ------------------------------------------------------------------------- *) (* Basic equality properties; TRANS is derivable but included for efficiency *) (* ------------------------------------------------------------------------- *) let REFL tm = Sequent([],mk_eq (tm, tm), proof_REFL tm) let TRANS (Sequent(asl1,c1,p1)) (Sequent(asl2,c2,p2)) = match (c1,c2) with Comb((Comb(Const("=",_),l) as eql),m1),Comb(Comb(Const("=",_),m2),r) when alphaorder m1 m2 = 0 -> Sequent(term_union asl1 asl2,mk_comb (eql, r),proof_TRANS (p1,p2)) | _ -> failwith "TRANS" (* ------------------------------------------------------------------------- *) (* Congruence properties of equality. *) (* ------------------------------------------------------------------------- *) let MK_COMB(Sequent(asl1,c1,p1),Sequent(asl2,c2,p2)) = match (c1,c2) with Comb(Comb(Const("=",_),l1),r1),Comb(Comb(Const("=",_),l2),r2) -> (match type_of l1 with Tyapp("fun",[ty;_]) when Pervasives.compare ty (type_of l2) = 0 -> Sequent(term_union asl1 asl2, mk_eq (mk_comb (l1, l2), mk_comb(r1, r2)), proof_MK_COMB (p1,p2)) | _ -> failwith "MK_COMB: types do not agree") | _ -> failwith "MK_COMB: not both equations" let ABS v (Sequent(asl,c,p)) = match (v,c) with Var(_,_),Comb(Comb(Const("=",_),l),r) when not(exists (vfree_in v) asl) -> Sequent(asl,mk_eq (mk_abs (v, l), mk_abs (v, r)),proof_ABS v p) | _ -> failwith "ABS";; (* ------------------------------------------------------------------------- *) (* Trivial case of lambda calculus beta-conversion. *) (* ------------------------------------------------------------------------- *) let BETA tm = match tm with Comb(Abs(v,bod),arg) when Pervasives.compare arg v = 0 -> Sequent([],mk_eq (tm, bod), proof_BETA tm) | _ -> failwith "BETA: not a trivial beta-redex" (* ------------------------------------------------------------------------- *) (* Rules connected with deduction. *) (* ------------------------------------------------------------------------- *) let ASSUME tm = if Pervasives.compare (type_of tm) bool_ty = 0 then Sequent([tm],tm, proof_ASSUME tm) else failwith "ASSUME: not a proposition" let EQ_MP (Sequent(asl1,eq,p1)) (Sequent(asl2,c,p2)) = match eq with Comb(Comb(Const("=",_),l),r) when alphaorder l c = 0 -> Sequent(term_union asl1 asl2,r, proof_EQ_MP p1 p2) | _ -> failwith "EQ_MP" let DEDUCT_ANTISYM_RULE (Sequent(asl1,c1,p1)) (Sequent(asl2,c2,p2)) = let asl1' = term_remove c2 asl1 and asl2' = term_remove c1 asl2 in Sequent(term_union asl1' asl2',mk_eq (c1, c2), proof_DEDUCT_ANTISYM_RULE (p1,c1) (p2,c2)) (* ------------------------------------------------------------------------- *) (* Type and term instantiation. *) (* ------------------------------------------------------------------------- *) let INST_TYPE theta (Sequent(asl,c,p)) = let inst_fn = inst theta in Sequent(term_image inst_fn asl,inst_fn c, proof_INST_TYPE theta p) let INST theta (Sequent(asl,c,p)) = let inst_fun = vsubst theta in Sequent(term_image inst_fun asl,inst_fun c, proof_INST theta p) (* ------------------------------------------------------------------------- *) (* Handling of axioms. *) (* ------------------------------------------------------------------------- *) let the_axioms = ref ([]:thm list) let axioms() = !the_axioms let new_axiom tm = if Pervasives.compare (type_of tm) bool_ty = 0 then let axname = new_axiom_name "" in let p = proof_new_axiom (axname) tm in let th = Sequent([],tm,p) in (the_axioms := th::(!the_axioms); save_proof axname p (Some tm); th) else failwith "new_axiom: Not a proposition" (* ------------------------------------------------------------------------- *) (* Handling of (term) definitions. *) (* ------------------------------------------------------------------------- *) let the_definitions = ref ([]:thm list) let definitions() = !the_definitions let new_basic_definition tm = match tm with Comb(Comb(Const("=",_),(Var(cname,ty) as l)),r) -> if not(freesin [] r) then failwith "new_definition: term not closed" else if not (subset (type_vars_in_term r) (tyvars ty)) then failwith "new_definition: Type variables not reflected in constant" else let c = new_constant(cname,ty); mk_const (cname, []) in let p = proof_new_definition cname ty r in let concl = mk_eq (c, r) in save_proof ("DEF_"^cname) p (Some concl); let dth = Sequent([],concl,p) in the_definitions := dth::(!the_definitions); dth | _ -> failwith "new_basic_definition" (* ------------------------------------------------------------------------- *) (* Handling of type definitions. *) (* *) (* This function now involves no logical constants beyond equality. *) (* *) (* |- P t *) (* --------------------------- *) (* |- abs(rep a) = a *) (* |- P r = (rep(abs r) = r) *) (* *) (* Where "abs" and "rep" are new constants with the nominated names. *) (* ------------------------------------------------------------------------- *) let new_basic_type_definition tyname (absname,repname) (Sequent(asl,c,p)) = if exists (can get_const_type) [absname; repname] then failwith "new_basic_type_definition: Constant(s) already in use" else if not (asl = []) then failwith "new_basic_type_definition: Assumptions in theorem" else let P,x = try dest_comb c with Failure _ -> failwith "new_basic_type_definition: Not a combination" in if not(freesin [] P) then failwith "new_basic_type_definition: Predicate is not closed" else let tyvars = sort (<=) (type_vars_in_term P) in let _ = try new_type(tyname,length tyvars) with Failure _ -> failwith "new_basic_type_definition: Type already defined" in let aty = mk_type(tyname,tyvars) and rty = type_of x in let absty = mk_type("fun",[rty;aty]) and repty = mk_type("fun",[aty;rty]) in let abs = (new_constant(absname,absty); mk_const(absname,[])) and rep = (new_constant(repname,repty); mk_const(repname,[])) in let a = mk_var("a",aty) and r = mk_var("r",rty) in let ax1 = mk_eq (mk_comb(abs,mk_comb(rep,a)), a) in let ax2 = mk_eq (mk_comb(P,r), mk_eq (mk_comb(rep,mk_comb(abs,r)), r)) in let tp = proof_new_basic_type_definition tyname (absname, repname) (P,x) p in let tname = "TYDEF_"^tyname in save_proof tname tp None; Sequent([],ax1,proof_CONJUNCT1 tp), Sequent([],ax2,proof_CONJUNCT2 tp) (* ------------------------------------------------------------------------- *) (* Dealing with proof objects. *) (* ------------------------------------------------------------------------- *) let substitute_proof = if use_extended_proofobjects then fun (Sequent (asl, c, p)) pnew -> Sequent (asl, c, pnew) else fun th p -> th;; let equals_thm (Sequent (p1,c1,_)) (Sequent (p2,c2,_)) = (p1 = p2) && (c1 = c2) let le_thm (Sequent (p1,c1,_)) (Sequent (p2,c2,_)) = (p1, c1) <= (p2, c2) let less_thm (Sequent (p1, c1,_)) (Sequent (p2, c2,_)) = (p1, c1) < (p2, c2) let proof_of (Sequent(_,_,p)) = p let save_thm name th = (save_proof name (proof_of th) (Some (concl th)); th) end;; include Hol;; (* ------------------------------------------------------------------------- *) (* Tests for alpha-convertibility (equality ignoring names in abstractions). *) (* ------------------------------------------------------------------------- *) let aconv s t = alphaorder s t = 0;; (* ------------------------------------------------------------------------- *) (* Comparison function on theorems. Currently the same as equality, but *) (* it's useful to separate because in the proof-recording version it isn't. *) (* ------------------------------------------------------------------------- *) let equals_thm th th' = dest_thm th = dest_thm th';; hol-light/Proofrecording/hol_light/000077500000000000000000000000001303454263000177005ustar00rootroot00000000000000hol-light/Proofrecording/hol_light/Help000077700000000000000000000000001303454263000220262../../Help/ustar00rootroot00000000000000hol-light/Proofrecording/hol_light/Makefile000066400000000000000000000161101303454263000213370ustar00rootroot00000000000000############################################################################### # Makefile for HOL Light # # # # Simple "make" just builds the camlp4 syntax extension "pa_j.cmo", which is # # necessary to load the HOL Light core into the OCaml toplevel. # # # # The later options such as "make hol" create standalone images, but only # # work under Linux when the "ckpt" checkpointing program is installed. # # # # See the README file for more detailed information about the build process. # # # # Thanks to Carl Witty for 3.07 and 3.08 ports of pa_j.ml and this process. # ############################################################################### # Installation directory for standalone binaries. Set here to the user's # binary directory. You may want to change it to something like /usr/local/bin BINDIR=${HOME}/bin # This is the list of source files in the HOL Light core HOLSRC=system.ml lib.ml type.ml term.ml thm.ml basics.ml nets.ml \ preterm.ml parser.ml printer.ml equal.ml bool.ml drule.ml \ tactics.ml itab.ml simp.ml theorems.ml ind_defs.ml class.ml \ trivia.ml canon.ml meson.ml quot.ml recursion.ml pair.ml \ nums.ml arith.ml wf.ml calc_num.ml normalizer.ml grobner.ml \ ind_types.ml lists.ml realax.ml calc_int.ml realarith.ml \ real.ml calc_rat.ml int.ml sets.ml iterate.ml cart.ml define.ml \ help.ml database.ml update_database.ml # Build the camlp4 syntax extension file (camlp5 for OCaml >= 3.10) pa_j.cmo: sources pa_j.ml; if test `ocamlc -version | cut -c1-4` = "3.10" -o `ocamlc -version | cut -c1-4` = "3.11" ; \ then ocamlc -c -pp "camlp5r pa_lexer.cmo pa_extend.cmo q_MLast.cmo" -I +camlp5 pa_j.ml; \ else ocamlc -c -pp "camlp4r pa_extend.cmo q_MLast.cmo" -I +camlp4 pa_j.ml; \ fi # Copy over and modify the sources sources:; cp ../../*.ml .; \ cp -f ../diffs/*.ml .; \ java -jar ../tools/nametheorems.jar *.ml; \ rm *.ml.old # Choose an appropriate camlp4 or camlp5 syntax extension. # # For OCaml < 3.10 (OCAML_BINARY_VERSION = "0"), this uses the built-in # camlp4, and in general there are different versions for each OCaml version # # For OCaml >= 3.10 (OCAML_BINARY_VERSION = "1"), this uses the separate # program camlp5. Now the appropriate syntax extensions is determined based # on the camlp5 version, currently just versions < 6.00 and >= 6.00 OCAML_VERSION=`ocamlc -version | cut -c1-4` OCAML_BINARY_VERSION=`ocamlc -version | cut -c3` CAMLP5_BINARY_VERSION=`camlp5 -v 2>&1 | cut -f3 -d' ' | cut -c1` pa_j.ml: pa_j_3.07.ml pa_j_3.08.ml pa_j_3.09.ml pa_j_3.1x_5.xx.ml pa_j_3.1x_6.xx.ml; \ if test ${OCAML_BINARY_VERSION} = "0" ; \ then cp pa_j_${OCAML_VERSION}.ml pa_j.ml ; \ else cp pa_j_3.1x_${CAMLP5_BINARY_VERSION}.xx.ml pa_j.ml; \ fi # Compile depgraph depgraph.ml:; cp ../diffs/depgraph.ml . depgraph: depgraph.ml; ocamlc -a -I +ocamlgraph graph.cma -o depgraph.cma depgraph.ml # Create a top-level using str and depgraph top: depgraph; ocamlmktop -o top -I +ocamlgraph graph.cma depgraph.cma str.cma # Build a standalone hol image called "hol" (needs Linux and ckpt program) hol: pa_j.cmo ${HOLSRC} update_database.ml; \ if test `uname` = Linux; then \ echo -e '#use "make.ml";;\nloadt "update_database.ml";;\nself_destruct "";;' | ckpt -a SIGUSR1 -n hol.snapshot ocaml;\ mv hol.snapshot hol; \ else \ echo '******************************************************'; \ echo 'FAILURE: Image build assumes Linux and ckpt program'; \ echo '******************************************************'; \ fi # Build an image with multivariate calculus preloaded. hol.multivariate: ./hol \ Library/card.ml Library/permutations.ml Multivariate/misc.ml \ Library/products.ml Library/floor.ml Multivariate/vectors.ml \ Multivariate/determinants.ml Multivariate/topology.ml \ Multivariate/convex.ml Multivariate/polytope.ml \ Multivariate/dimension.ml Multivariate/derivatives.ml \ Multivariate/clifford.ml Multivariate/integration.ml \ Multivariate/measure.ml \ Multivariate/multivariate_database.ml update_database.ml; \ echo -e 'loadt "Multivariate/make.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with multivariate analysis";;' | ./hol; mv hol.snapshot hol.multivariate; # Build an image with analysis and SOS procedure preloaded hol.sosa: ./hol \ Library/analysis.ml Library/transc.ml \ Examples/sos.ml update_database.ml; \ echo -e 'loadt "Library/analysis.ml";;\nloadt "Library/transc.ml";;\nloadt "Examples/sos.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with analysis and SOS";;' | ./hol; mv hol.snapshot hol.sosa; # Build an image with cardinal arithmetic preloaded hol.card: ./hol Library/card.ml; update_database.ml; \ echo -e 'loadt "Library/card.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with cardinal arithmetic";;' | ./hol; mv hol.snapshot hol.card; # Build an image with multivariate-based complex analysis preloaded hol.complex: ./hol.multivariate \ Library/binomial.ml Library/iter.ml Multivariate/complexes.ml \ Multivariate/canal.ml Multivariate/transcendentals.ml \ Multivariate/realanalysis.ml Multivariate/cauchy.ml \ Multivariate/complex_database.ml update_database.ml; \ echo -e 'loadt "Multivariate/complexes.ml";;\nloadt "Multivariate/canal.ml";;\nloadt "Multivariate/transcendentals.ml";;\nloadt "Multivariate/realanalysis.ml";;\nloadt "Multivariate/cauchy.ml";;\nloadt "Multivariate/complex_database.ml";;\nloadt "update_database.ml";;\nself_destruct "Preloaded with multivariate-based complex analysis";;' | ./hol.multivariate; mv hol.snapshot hol.complex; # Build all those all: hol hol.multivariate hol.sosa hol.card hol.complex; # Build binaries and copy them to binary directory install: hol hol.multivariate hol.sosa hol.card hol.complex; cp hol hol.multivariate hol.sosa hol.card hol.complex ${BINDIR} # Clean up all generated files clean:; rm -f *.ml *.ml.old pa_j.cmi pa_j.cmo hol hol.multivariate hol.sosa hol.card clean_all: clean; rm -f *~ *.cma *.cmi *.cmo top top.exe hol-light/Proofrecording/tools/000077500000000000000000000000001303454263000170675ustar00rootroot00000000000000hol-light/Proofrecording/tools/Makefile000066400000000000000000000052741303454263000205370ustar00rootroot00000000000000# Thanks to Carl Witty for 3.07 and 3.08 ports of pa_j.ml and this make procedure OCAMLC=ocamlc -dtypes -g -pp "camlp4o ./init.cmo ./pa_j.cmo" -I +campl4 nums.cma unix.cma CAMLP4O=camlp4o ./init.cmo ./pa_j.cmo pa_j.cmo: pa_j.ml; ocamlc -c -pp 'camlp4r pa_extend.cmo q_MLast.cmo' -I `which camlp4 | sed -e 's/bin\/camlp4/lib\/ocaml\/camlp4/'` pa_j.ml pa_j.ml: pa_j_3.04.ml pa_j_3.06.ml pa_j_3.07+2.ml; cp pa_j_`ocamlc -version`.ml pa_j.ml clean:; rm -f pa_j.ml pa_j.cmi pa_j.cmo init.cmo : init.ml ocamlc -I +camlp4 -c ./init.ml core.out : srccore init.cmo pa_j.cmo $(OCAMLC) -o core.out core.ml srccore :; cat startcore.ml > core.ml cat lib.ml >> core.ml cat lib2.ml >> core.ml cat type.ml >> core.ml cat term.ml >> core.ml cat proofobjects_init.ml >> core.ml cat proofobjects_dummy.ml >> core.ml cat thm.ml >> core.ml cat basics.ml >> core.ml cat nets.ml >> core.ml cat preterm.ml >> core.ml cat parser.ml >> core.ml cat printer.ml >> core.ml cat equal.ml >> core.ml cat bool.ml >> core.ml cat drule.ml >> core.ml cat tactics.ml >> core.ml cat itab.ml >> core.ml cat simp.ml >> core.ml cat theorems.ml >> core.ml cat ind-defs.ml >> core.ml cat class.ml >> core.ml cat trivia.ml >> core.ml cat canon.ml >> core.ml cat meson.ml >> core.ml cat quot.ml >> core.ml cat recursion.ml >> core.ml cat pair.ml >> core.ml cat num.ml >> core.ml cat arith.ml >> core.ml cat wf.ml >> core.ml cat calc_num.ml >> core.ml cat normalizer.ml >> core.ml cat grobner.ml >> core.ml cat ind-types.ml >> core.ml cat list.ml >> core.ml cat realax.ml >> core.ml cat calc_int.ml >> core.ml cat realarith.ml >> core.ml cat real.ml >> core.ml cat calc_rat.ml >> core.ml cat int.ml >> core.ml cat sets.ml >> core.ml cat Examples/analysis.ml >> core.ml cat Examples/transc.ml >> core.ml cat Complex/complex.ml >> core.ml cat Complex/cpoly.ml >> core.ml cat Complex/fundamental.ml >> core.ml cat Complex/quelim.ml >> core.ml cat Complex/polyconv.ml >> core.ml cat Complex/grobner.ml >> core.ml cat Complex/real.ml >> core.ml srcexamples:; cat Complex/quelim_examples.ml >> core.ml cat Examples/binomial.ml >> core.ml cat Examples/wo.ml >> core.ml cat Examples/card.ml >> core.ml cat Examples/cong.ml >> core.ml cat Examples/cooper.ml >> core.ml cat Examples/floor.ml >> core.ml cat Examples/forster.ml >> core.ml cat Examples/lagrange.ml >> core.ml cat Examples/mccarthy.ml >> core.ml cat Examples/multivariate.ml >> core.ml cat Examples/multiwf.ml >> core.ml cat Examples/prime.ml >> core.ml cat Examples/pell.ml >> core.ml cat Examples/poly.ml >> core.ml cat Examples/polylog.ml >> core.ml cat Examples/rectypes.ml >> core.ml cat Examples/rstc.ml >> core.ml cat Examples/reduct.ml >> core.ml hol-light/Proofrecording/tools/detecteq.jar000066400000000000000000000165341303454263000213740ustar00rootroot00000000000000PKC‹D2 META-INF/þÊPKPKC‹D2META-INF/MANIFEST.MFóMÌËLK-.Ñ K-*ÎÌϳR0Ô3àår.JM,IMÑuª ˜ê(h—æ)øf&åW—¤æ+xæ%ëiòrù&fæé:ç$[)¸¤–¤&—¸òrñrPKk³¨ZZPKÈbD2DetectEq$Annotation.class}TkOÓP~Î6ÖnÁ&w§¢n€ ï Èt:’èSF’ÒnÝ™ ÿ†o|ñ‹ÆŒD€?Êø¾m¹‹KÖçyoç<}NÛß~ü0Š÷I\ÅX÷p_Áƒ$¢SññQiÜ%FßúpqYß4z°„;PÿPK(htÔ¡×PKÈbD2DetectEq$Interval.classeQËnÓ@=ãGœ¤n›¾ ¥´˜ªbY„H–RXP eã„)uåØ­ãVâˆ×?PXfSD„ıæ£g&$jkîœ9÷øÞ3׿ÿüø `Õ"r¸\€² WT¸ê`ÕÁšƒëVÆR@ø„{iÒ0²D w'ŒÃì.AÅ÷ýê.³µä9…“uê·›2Ý š™ézÒ ¢Ý Õy@ZÙ~ØÈûq&Ó“ pý8–i- :ÉÌLý¾Ìd+{p´:ÔlÑ…b+(´’öaÊÚ™«Ô‚“`3 â››üp«JË"QýÏ¥˜x)P|’§-ù0T†Æ‡í6”Ú…‹.ò(¸(ª0†‚ƒŠÀÔ9W¥ÿë Ìþ£jÚeÿÖfEM*?¬2‡ƒ€“?ƒÝ žâ`Ó»Áåbœª ¢Ï÷Yï;„·Øƒá-õ`zË=XgZ=ɨj¯PbôúzLqA£9Ö] 24ºHd’Ç ÓWf”«ÆÍ_°·×¿± ×gLZ„Ö)³®Ù’büÛìùSØÆèð¶ÕÈ,±º#Ç+œðšóxƒ[x‹Ûx‡{xm|À3|Ô7)÷ýŒnÒÀ%,Ò­§X"gð]ÖW0£ç¨r×0ü_PKj6áëÞïPKÈbD2DetectEq$MLFile.classuTkWUÝ7™dÂ0„‡!UkmCxIAÄBÐB©¦ TAÄCèÔ0Äåàƒ~í_ÕUñQײ.AKp‰«Ë¯úüþuß Û`Öš{oÎÝ眽Ï93üýË}½XÓЊ±´à9 Ïã¢<«˜ÐÀ%¹LÊå²Fó *^Ô •ÑiW5„‘‘–)ÓpM./Éåei~¥†€³*^«u™ƦÑg9}—­œ9" ¬®!à[ä,ÛÜh*ƒŠ®•ë›-˜æ”‘'28jÙ–;&I<¤sŽa&œS >ÃÓÅõe³0k,çhiÌ8Y#7g,ùÿШ¸×-æ Ned=mÛfa"gllÈü‘Ì%Ó5³îä»gÊf÷Y¶@û‰Óv¾èθÓX'@›|/kæ]˱7TQ$_0óFÁ”Œ2ŽóN1/àOH®bS ”¶]³°iä¤ÚJ¶##à ‹OšTeM¸­œuX3]–D:ÝY¦’3ìµ>r°ì5é”%Q×!n¹Èb·UaÆ‹««fA–=‘îdtÞ¡^mÆ)²f¹á#6½ÒYÇ)tëhC»Šy¯aAÇ#ˆ ´þO%¤Ã£:^Ç¢Ž7¤kºYŒª†êè@\Å›¼«’/c¼¥ãm,QëÉ$„ä–‘Õ±SÇ VuœG?gà¡æ 4Ǹ¶|ƒw,ú±©Ò7ÎÁEq>r¦½æ^÷úv…5£¾Nibq\Ö.Í9D…ŽòÑIËûYáDæáÌ#Õ–ÎjS¹?Œ4òyÓfÒXb¢ºã•n†\§lhNœ8gO rBb<Æ7»•ß?6òÇ~{;ÆUáÃÃG,ð‘ۗ܇HvíÁ—ì*Áÿþ¯¡=(,tíó5ëNÞƒR‚:ß]B(YBÍ.]|xœëi„¸~È°¡£Ÿ0ͧ8‹[Hâ3~ >'Læ¥Á¼w’ô±8‡£uzä½ ‡Ž'Ið/~¼ÜÍä´…}ÔîAWFý)ÿX\’º¿A¹Çn6h·qúá…XG|uÚõv¥Äëç·„ˆ+K©-¿¸óÏïeçNà´ÄõôHÔ±¬!~ø€Û¨Å"Ó±!%ªtlãœTU†ÑÀ-ÔF¥¡@O4p³„Æù-…Zÿ¤®¦Š¬SP¹þÀT;ìÔ.«ÿ#ëýÉì`{úqDY‚~V¾Ž÷’¾›T¥{)´ðNÏxôkcÏzôÏSr™~†±|reeÙý±K^BóoßCôn…YЋö³Ç ¥ìSÉÖ†/›£>…'¹7òÔ‚+8à sïEè_PKÂÊøÔ5PKÈbD2DetectEq.class•X xå~ÿììÎì:dBËBŽM"¢$…6šhÜ$“dq³ö bÑÚ‚½kOl«–Úb«m‘#IMA< ^õè¡m­ÕZ[{ßµwéûÍnv!l|ž><ùþoþùîs–'þûÀ15êzpÅø’€/ûp/îì+¾êÃ×pÀ‡6ÜïE7ú°‡|8Œ#†äÅ°ðuøxRÚŒø†£:Ž‰GÁƒŽËù¢ìÁðMpBÀIùP‡Ç{B°'{J,ø–€§u<ãÃB<+œÏ ömÑûÁ¾+à{:ž7ð‚5ø¾èø¡HyQÇt¼äÃR¼(&þXØ_ì/~‚W üTŒz͇Ÿáç:^×ñ ¹ÿ¥áW>4 C“8ök¿Ññ[¿“xüÞÀ üÑÀŸ üYÇ_ üÕÀþfàïþaàŸþeàßþcà¿N †R†Ê3”ËPš¡Ü†òJ7”a(¯®|º:GÁÓÖº&¶Ì–HÄŽ5‡ƒñ¸וIî–HÂŽí†|+"‘h"˜E#¤Lôt|‰+LßÒº-¸#X›L„µ1»Ï¾¾v}êe£‚7±3M©àS:ÊìMFº)°(-0ŒôÕ¶'b¡H)<ËC‘P¢IÁU^±QAkŽöÐêÉ­¡ˆ½69ÐeÇ6»Ä«5Ú o ÆBòœ¾Ôý!Jöµ®²vwbõv Ôâ×…f”Ÿ¥me²·×Ž5Šâ_ ÿÈ=m"B=f{"É7G1.‡Æj††UžMÞ˜1r~6êŽ1y‰Eâ_Žàä%êhÄ@0ÑÝoÇrEº-õŠ¤*¨PœS£9ŒÅíÓs½2m_(Z›ô4Ÿ²²BR5ÔX1XÅ R4kúIJ˜ßp¯Sˆ…gÉUpEÏ0¥OºìêJö2­«¯ï¶E 7ŸnH|³0uÍÿ—[&ðÌł;%|Ùð®«ÖPiªFl×ÕrS]¨š=ÉH¢¡T¢r‘®.6Õ ‹ÝY9gë½h‰ &Œ«H«P+U³èYÅ"+­n*e‘IÉ•Ò©Ò^jéQ˜:Á„V˜W^SÉ]SYQZ¾µrWuÏÌ …uE£aS­Vk*ø"Ù–Œ'ÆQg/Ó y-FlGš¹ËP.àm_4G8v•¡›QSYN³v¥”íríªŠVUÁøšcW'#Ψó†dÝÅ™J6N<Ù•ˆõÛb':ííD†¸Ìƒx<ÚMΘ½£3{œ“£I#ÕöW¨—CÃ'ì¡HÜŽQ–WìXŸ-ƒoÌ€Ó´:b˜_Fv( S–‹ÞöD¹LÜ}±à`?M+Ã3œ\×µÍq¨0S¤Ù¥^”%Ë PjÛ‘¾D¿³g¹±<ÝýÁØ JÐÊ[*šÏ`jæ+U§‡â«B}!‡¬¹b3Ùzì05*Ì,oi©˜xqz%ºéD”ä$%QaöN¬ï†³ªøÈqœc‡ŠéQhJyN¡‹OçWÚííI;Ò-klâíyVƒ´í\­7$Ĩmv’MŠi¹=òPW0g{*Y"@K}äEÓŸ ­Îrð°lQÈåóÄa6ѱrÏ-Y?½1)§¼'¦«O ^ëv>±$ñ-ò…KÚéÅ+²¸‚=R”ƒ”!äñÐ öY.§}’NÏñ¥“Ó’Âò3wŸÜeïÒÛMnÝÝáhÜ>³«wÆ6ýpE“‰Ì¦&×z125å+íÍŠ²(kÜñ3ÌÉ“=ž}Ú¤%ó´òœ/Ä\ÎòAgŸTOœ¾ŸÇ˜Ë_=üå‚!Û—˜!ûÍ9¹âœSÉ'Œñi±lXžîÊa¨û‰ä!Nèã)¤nC‚˜™"B;œ{î×´€U m™kùŒÊ!äíÃìÊCp@Û‹üJq÷¦ýðîQjÿ©W²¦ÃC8ƒšfò'Î,ÂÙ˜Ãç(u4–.ó°78ºËð6ìrts­§ußLÝ.ùјÖ}'&é¾%ŽnÏô ÓV̼Ï1â…q6ÌãÓ|Ú°€úËøo!Êy'6”RúxñvÚ Ö2ÖÔd¬á7GÚšWI-ò6Óã2W½V¬„÷Ø>\Æ£X«ãµ¯Áíw᜽XäwkC0IÙæw{RØÚ@õò÷žz¹*p“ªün’šG0y?\{4~0½:f¸iB! ÎÂÅ´j±ËÐLl®ÆzÂvÒtàRÇ£&ZXKo߉ݔ´ŒØCÌEþzÜ‚wQžË/5ñ„^îìÝxý4ä;ˆœô7¯Ž4^~¡Õ¢ c…mtÐZ[}nu@P±Š4yÇ ñßhp[SÉß Ï~ÌE1”ø‘©Ö4y7uþmÿ©GåÚhÐüZ`Ó…´z3DÞfÎ:‚ÙΓó°éŒsÆ¿ÈAS¨ Æþ•az¼#˜ Ä_ƒ‡w“N¢Åïq¸âtžÝUoQÆt/ôëDŠ:Ç¿¢€_c6©+fsÁT>8ÉåM¬1 ±]‹|¬C³6“Y(eæÊ°Õ¸K°‘9Ý„­¸ Ìf/3ÆvãVfðj|×à³|s®Å!ñºðGÁK¯ÃÆèUúTúÕl„Ô|lã÷pŸZÂþ•ºèe–±ÞÏ|»•NRyÎsj@—<ãø ±Q£ü§A ne]ä!_Uà#N%•ªΌݬ8Ž²KÜ´`S]|Œì9?Noù›ª$<Ë;éœ £XØQÐ3Œò¶ÊªT¬­>)Ò•›ªüЉWUŸ<õZ`£(hÐ\õîb·_cاúµbw ˜•S}í{Ü óë~-ç2©VêóqŠк)œaÓéçÚXÁ©RÇL\Î^듥̂DÁ-–ùN,å»õ)ì¥ìöšt‡‹ÎÅíø4½ÉúéÅg˜ÇOueùøæéQÔtTºê¬Úaœ×:ö°ˆm£¨ë cñÚQ,éÅÒŽªaÔã|©ÿê\Àºg5.;ˆ†tÓXN¿Âr6Ì.E/ê8ˆ‹‡±b+Êt‚±?Éx?Ƙ=Î=ð¹#Å3x’Õ0V‘7s’I¼ä¸2]‡7²KîÚ”8âNg¥åSÇ­¸‹ñžŽÃø1Ù÷:™rÑ‚Û±ÙÓhÇmN~ÜäêÄçq÷¸ŠüBf->ëÌ?à€~k:\Ö%#xK{‡fµ8§ÛºÔ9=Öer‚×j%r Š¢ôk…xP®²ËÛ;tëŠöÃjoï(ðXuëJBÃÚHèµ6ú¬«ϱ:Mk3a¾µ…p’µ•p²u5au a¡ÕIhY×YAÂ)Ví(“ ¡œ\Lr6c·ÙbNü¥ŒÈ<ígdeóIµvs2èãÙϳ€gÆÿPKµtLô˜ ‰PKÈbD2RegexTestHarness.class}UywUÿ M;étZ …¶”m( )–FDË*"µ@¤›Ý¤ ÔIò’ &3aò‚AÅ WÜÅ ¿ÓzÒ9Çà‡Rï}iÂœ6µË»ïÝ}Ÿ¿ÿùó/ƒøÕÀF <ƒ1>Æù˜Ð1©ãµ0¦ ´`Ú@3fZ ?«c®¯ã²Žyí ã ëÚðß®¸ŽƒxÞd)›¥|$u¤ ¤ù‘á[–oN7ÂxË@ù0\†^†7YŸF‘2Œóß ãmV\Öq[Ç;š§F.Œ\Ö½aß²c9ÛÍĦ¥ï¸™SDŒOÎÎhØ”ð5ôT9/v®”N _¤¦„>ñé[Já»vT™JÒÉÅ|‘åØd•Ä\y[&³ÂoÄ5V%±Í´WrS´+ZN;®#ÏhhŠöÏi {)¡aó¨ãŠñR>!ü;‘ì¼—´ss¶ïð{’Y§È´)¶0#Šò¢í»¢X$#¡¼í·]Ñ«ëÃV–l?sKCg²†vvjJ½’Ÿd!”vÓdoo=?çœ÷äyd¤œéxœ€&Ç#¾íu¾øDÚVð=ÒWdO5t$s^Q¬ÓêƺIÇÚ˜Y§‰ã8ab˜‹|Äq‚‚l\6ÊLÐßr0–õò"æ%J6Ýr 9'“•±”")ÄÍ’säíjÑeY²ÉwùxÏij8¢a÷ÿ&AÇïペWÄV½ÓÐ;l»®'­•T Ëq %i¥IÙ>ËćøÈÄǸkâÜÕñ©‰ÏØüçøÂÄ—Œ>ŒA1 RídYÇ=_ákÏᨉçñ /P*†K¾/\i©i°œâI+€TS :¾5ñ¾'bÜRjɬ°¤(K«Ïĸ«a[ŸU”¶/)&Ë–@J”ÉõqŸýÿ‰ŠgÙ$'ÜÔŽŸqŸÚžüÂ1êòqÏRSµCè_¸š[ÖVžPOR9‘¸Au"ÑÆ}Ý­7ßêð26 `úvQŠ<µªW’ÁV$’ ;O­Úb ‚‡t ‘u¨jiIÎÈ9F>ÛêámÑõœÄ–^õ(aÀ:/~åh|C¢ì—¡hœ£9Å«AC÷Kˆ„“^¾ FèðÆ®7Ü^GƒüÃYÛŸ¦inR4z²ÍÖy2VÛ¡´Ã¤ÍF‹®9ã{¥AÕ9 ×°“Û8™MªÍjOàíöúµÀà ›Ác  Í¥‚Ôó RÇ+HmF°¯ :OÒ+FPcì¡ehè² §”ZF†pšN³Ê€q†`+^ÂÙUá³ôÏ4c›Vд‚Ð ’:Єͤm Ém h3ð2Î)8\sEkW®£yþ1Zæ#ú2ÂËh]‚ñ.-Â|ŒöùetD6W°åP[ T© “lo[„QÁö%tÕ.Ý"©®ìXBï"ÿuW°s »ªv“â©k ö(RwôˆB:ÑEïc´kGѳì}yíDë%j7ýöPîw×.JÒnâ݃1X˜Ã>$°wp¿á JHéè&Ú+¡×ýŸÇ•š‹õ*Ý£4òÏõEìª`ïÄnZÊMÂï£K¤¯öÚ_ÁÈÁÚë)~=]%´„èÃÿXDôw´‘®H¿ŠËÉñôRÉ€(­Ÿ¼ÀõÉ,õÕ5ê)ƒ¿2«~¬vO›Jù!Î÷#…h!ÑZr:”óC„;FÂÇë]`ÔCÕðªê›KÿPK7ÒEÏe PKC‹D2 META-INF/þÊPKC‹D2k³¨ZZ=META-INF/MANIFEST.MFPKÈbD2(htÔ¡×ÙDetectEq$Annotation.classPKÈbD2j6áëÞïÁDetectEq$Interval.classPKÈbD2ÂÊøÔ5äDetectEq$MLFile.classPKÈbD2µtLô˜ ‰\ DetectEq.classPKÈbD27ÒEÏe 0RegexTestHarness.classPKÌzhol-light/Proofrecording/tools/detecteq_readme.txt000066400000000000000000000064431303454263000227520ustar00rootroot00000000000000************************************************************** * Detecting uses of built-in equality of theorems statically * ************************************************************** The ocaml compiler has a switch for outputting type information into an annotation file. This annotation file can then be checked for example for expressions of type "thm -> thm -> bool" etc. Drawback: You have to compile the Hol-light sources. This section describes the necessary changes for compiling and how to run the equality detection tool. Copy tools/Makefile, tools/startcore.ml and tools/init.ml to your hol_light directory. For "make core.out" changes to certain files are necessary: - remove '#install_printer' from end of "lib.ml" - remove '#install_printer's from end of "printer.ml" - remove '#install_printer's from end of "tactics.ml" - remove history type from "Complex/grobner.ml", because it is already in "grobner.ml" - in proofobjects_init.ml, remove the final lines let _ = if use_proofobjects then loads "proofobjects_trt.ml" else loads "proofobjects_dummy.ml";; - in parser.ml, replace the code for "Hook to allow installation of user parsers" by: let try_user_parser x = let install_parser, delete_parser, installed_parsers, try_user_parser = let rec try_parsers ps i = if ps = [] then raise Noparse else try snd(hd ps) i with Noparse -> try_parsers (tl ps) i in let parser_list = ref [] in (fun dat -> parser_list := dat::(!parser_list)) , (fun (key,_) -> try parser_list := snd (remove (fun (key',_) -> key = key') (!parser_list)) with Failure _ -> ()), (fun () -> !parser_list), (fun i -> try_parsers (!parser_list) i) in try_user_parser x;; Now run the equality detection tool (many thanks to Virgile Prevosto, who had the idea for how to write such a tool): - change to the hol_light directory - run "make core.out" to produce core.ml, core.out and core.annot - the core.annot file contains information that can be used to find critical uses of equalities on theorems: run "java -jar ../tools/detecteq.jar . > criticaleq.txt" The java program will not terminate, but wait for input at the end, therefore check the criticaleq.txt file if the detection has finished, for example by "tail criticaleq.txt", and observing the final line "count: ..." - the file "criticaleq.txt" will now contain a list of lines extracted from core.annot, where there could be a critical use of equality on theorems (this list is not necessarily complete, but seems to be). The line numbers are calculated from the core.annot file (the line numbers in the core.annot file are wrong and are corrected by the tool) and refer to lines in core.ml. - after making the necessary changes, run again "make core.out" - you can run now "ocamlrun -b core.out": This will fail with an exception, if the program flow encounters a critical theorem equality that has not been removed, printing a stacktrace with line numbers. Unfortunately, there is something (a bug in ocaml?) that causes the lines numbers to be wrong. To convert a wrongly reported line to the correct one, run "java -jar ../tools/detecteq.jar", wait for it to finish, and then input the wrong line number. It will output the correct line number. hol-light/Proofrecording/tools/init.ml000066400000000000000000000007571303454263000203750ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Set up a quotation expander for my `...` quotes. *) (* ------------------------------------------------------------------------- *) let quotexpander s = if String.sub s 0 1 = ":" then "parse_type \""^ (String.escaped (String.sub s 1 (String.length s - 1)))^"\"" else "parse_term \""^(String.escaped s)^"\"";; Quotation.add "tot" (Quotation.ExStr (fun x -> quotexpander));; hol-light/Proofrecording/tools/nametheorems.jar000066400000000000000000000046621303454263000222640ustar00rootroot00000000000000PK¯pI2 META-INF/þÊPKPK¯pI2META-INF/MANIFEST.MFÈ¡€ ÐÎÆ?\ÔÓ`1j2`ÑÙopN696ƒï|ñ9äx’TsP‘˜y„ÞvZÍ…°R0ÓûÇ`;h¶‡ÁE_²¼R) ,ìm«•ÃÈf¾Qd„…ý¢\(i¥ÕPKÄv7˜]^PK‡pI2NamedTheorem.classVû[ç~ÇÝ6£®‹ˆÙ(•e@@Å[ bC¹h„HÖ$ÕawÆ,»›ÝY5iÒôbzMíý‚mcbIIÚ´1Ø•joilÓ«Mû{iŸ>ýúS›¾ß·Ë²àæi¾9sæ|ç¼ç=xó¿W®hÃ_ýè†ëÇZäÅqJ§uœÏÇý¸Oˆãƒ:žš§t|HÇÓBü°Žhø¨Žé8«ã×ñ ŸÔñ) ŸöãV|Fó~„„û>«ãœx~N|ù¼†/hø¢a|ÉÛñe _ÑðU?Åûf|M(¿."OŠ×óU”¾!^¿Y…oá9t<ïÇ …/ý؇oë˜Òñ¢Žï蘊—„—Åõ—u|WÇ÷ÄýWt|_ øŽW5\R÷NNžƯi˜ÑpY‘ɦӉX:Ÿrí¬¥W×µF“¶‚šþ“Ö)«=ï:Éöû¬Ü¸TïRàÛí¤w¯O¤ù¨µ;§õÚ~'eæ'Fíìpá~°?³’G­¬#Þ‹JÕwr ÖôZv|xÜNgí :­Ê=êd†2VŒ6["…ÈI+5Ö>äfÔØ®æ›UDëð÷´ˆTᣞµ­øH:§MŒ¿ÝDžp’2ͦJª"CÌI¦F1IÎXŠˆIN%ÇhtFK§NÙY÷¬ÈY•d=E e'•H+¨®ˆA'l»`¬$wÒÆI·tdAÔDÊ& >‘°È®®d°T“#ò›¨Þé¬#9¨)YfwDªiàï9³3®“Nå4üÞ','¥ 6R›¬¿•cEõݱd±/üCé|6f t Ö•ºMx0pz ü³æ0oàǸ¢â¹`àÆa¶WÒv üWÙ’äè”H?là¡QX ‡W2î8ÏQy¦äéÊ3iOyœ§š•£œDés\éñÞ|"ag ü?ãŶt2nàçø…_âuÞ‰fvd¹÷‚RÄø•8Þ`+P¿âRA)ì¯øµˆ9‚ ü' @‡ñˆ†7 ü¿£ÃÓV6EÀ]aÙ ”ÂM¤­)ì¤Â~oà Þgàø£‚õ%Óx>“tb–k [•l‡ÜÞNI¶Ã›Hó& ƒ^ìkš©á¶¶6Çk¾x:e·…KoÑ}Xtj<,»:Np³ÄÛ3^¾KDra%Ê;dYYž´cn]½‡JÍɸŠ1YÝH3ÑùbãVv?­ÕHos·Ø(ùÑ\±/j¨ª4Yµ‘ÞÊ|öcy+™[1Á÷ÅM:Îcõ’®8ô+´ÅIZ¹#ûåvÓ2¢“©åsõxΕ““λ7m ‚´-±»«+¨ygÌvWìòEþnV‰Ñ!vT0—¼±d:ÇDê+ÕºD¹7Ò{°ù(îàßÆnþC° Ubš(U‰áS‡"öÏ÷ó­Oî&xÍ9(¯É }<}R©¢boI `Pºá+^£õ*>7{v×›³Xu!³~ž@øª„¤^:«(Óoÿ=è½Tr]KWÀˆÿ9Ö#€:ÊaTËPµÒáFÜOÄ"èfÁ :\ zþ¥ dÐ= ëT5ž˜BkC`¿”M!Ü8~uõÏamC CjwNÁozxÉWÀwÅ\‚WÇÜzÂk ¸Û°—ÿtôð½” ˆa`;ÀQ ¶·v –‹¬Vñ“C•ºsæ<´>zK°jþIÐÂ’´2ã­,Cóng®Ø‚mèäÏÜÉÜîbvÛñîÆÓ¸Ïb—dÃdvGè%ÊÌ=¼‘ˆž8‡c’ ?ÎòÖù¨½XÄ4mg=f0 ¡î4ƒë¤ÐaƒRh2ƒÕRØh×KyÕ,æU+óÒÔi¨žWV´í¾²¶íÁŠEá*§•(ʘ®Îç¶ÜeßoèÂBÑ9Ô‘öú`YÜÆO-,ÉÆ‘ÜNƒp´uwÌaÓà6ó½1Ú2‡÷ÌaK—Êb4uyCÞëðMãFÈ;H—/从Õ!5IJ4Oc>äótvi30Õ—a†´y´L¢c­ÅÐA:©i@³bí%ùtƒmo,»×ùÿîí ©‹¶w–lï*IÛ…äS;/6Ë0âÛÝ#Óo7Ö=!öÞŽ¥ý0Š ’\±T¹VL®”.ÎBî'ýQvÌ î ›Û"MMž}ñ ñ ù%ÎÎ §ç*çäoœ”á˜ÂÃJ#Ž+Mü{ÛKé`QÄ#,T¯Ââ]~Þ’]å¥ï×i³ªlC¼Pb%Âx –½QYÍÝ” Ö.üãpØ›}øNâQökRn6DŸ’(:òEêDßF=¬X-×.¢½Œã‚ÙzAQ°«D0óØ%wÈ2ÛÝ4`™g±'¸·d»DÞF¦BU Ñ ÐVB줼ƒ$ÄÅMè£vq¹D‘aº(¯ã±ÒÈ%°/ºÎóÏà{ç°ÿ2:DL¥l24žY‰#÷?PKä9¦Ã1PK¯pI2 META-INF/þÊPK¯pI2Äv7˜]^=META-INF/MANIFEST.MFPK‡pI2ä9¦Ã1ÜNamedTheorem.classPK½ßhol-light/Proofrecording/tools/src/000077500000000000000000000000001303454263000176565ustar00rootroot00000000000000hol-light/Proofrecording/tools/src/DetectEq.java000066400000000000000000000161031303454263000222200ustar00rootroot00000000000000import java.io.*; import java.util.regex.Pattern; import java.util.regex.Matcher; import java.util.ArrayList; import java.util.TreeMap; import java.util.TreeSet; public class DetectEq { static class Annotation { String type; String op; String code; int from, to, line, true_line; void print () { System.out.println("from: "+from+", to: "+to+ ", type: "+type+", op: "+op); System.out.println("line: "+true_line+", code: "+code); System.out.println(""); } public boolean equals(Annotation a) { return a.from == from && a.to == to; } } static void skip (StringBuffer s) { for (int i=0; i) (.*thm.*) -> bool"), Pattern.compile("(.*injust.*) (\\*|->) (.*injust.*) -> bool"), Pattern.compile("(.*lineq.*) (\\*|->) (.*lineq.*) -> bool"), Pattern.compile("(.*goal.*) (\\*|->) (.*goal.*) -> bool") }; static Pattern typattern = Pattern.compile(".*(thm|injust|lineq|goal).*"); static String thm_funcs[] = { "union", "intersect", "subtract", "subset", "set_eq", "unions", "assoc", "rev_assoc", "assoc2", "uniq", "setify", "set_insert", "set_merge", "munion", "msubtract", "assocd", "rev_assocd", "apply", "|->", "dom", "graph" }; static void readtype(String s, Annotation a) { String t1, t2; s = s.trim(); for (int i=0; i 0 && ((Annotation)array.get(array.size()-1)).equals(a))) { array.add(a); if (a.type != null) a.print(); // } } } while (a != null); Annotation as[] = new Annotation[array.size()]; for (int i=0; i= to) || (from <= y.from && to >= y.from)) return 0; if (from < y.from) return -1; else if (from > y.from) return 1; else if (to < y.to) return -1; else return 1; } } static class MLFile { File f; byte[] data; TreeMap lines; MLFile (File f) throws Exception { this.f = f; data = new byte[(int)f.length()]; FileInputStream in = new FileInputStream(f); in.read(data); in.close(); prepareLineLookup(); } void prepareLineLookup() { lines = new TreeMap(); int line = 1; int from = 0; for (int i=0; i "+as[i].true_line); //as[i].print(); continue mainloop; } } System.out.println("line not found"); } while (true); } } hol-light/Proofrecording/tools/src/NamedTheorem.java000066400000000000000000000075211303454263000230760ustar00rootroot00000000000000import java.io.*; import java.util.*; public class NamedTheorem { public static int proofcounter; public static Hashtable table = new Hashtable(1000, 0.3f); /** * @param w * @return skips the leading part of w that consists only of spaces and returns the rest */ public static String skipSpace(String w) { for (int i=0; i= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '_' || (i > 0 && c >= '0' && c <= '9'))) return w.substring(0,i); } return w; } /** * Checks if a line is to be replaced and returns the necessary information to do it. * @param line the line * @return null, if no replacement, otherwise a pair (n,r) so that n is the name of the theorem and r * is the trailing rest of the line */ public static String[] filter (String line) { line = skipSpace(line); String l = readWord(line); if (l.equals("let")) { line = line.substring(l.length()); line = skipSpace(line); String w = readWord(line); line = skipSpace(line.substring(w.length())); if (line.length() > 1 && line.charAt(0) == '=') { line = skipSpace(line.substring(1)); String p = readWord(line); line = line.substring(p.length()); if (p.equals("prove") && (line.equals("") || line.startsWith(" ") || line.startsWith("("))) { return new String[] {w, line}; } } } return null; } public static boolean ignore (String x) { return x.startsWith("pth") || x.startsWith("bth") || x.startsWith("nth") || x.startsWith("tth") || x.startsWith("lem") || x.startsWith("thm") || x.startsWith("rthm"); } public static void convert(String filename) throws IOException { File f = new File(filename); File fnew = new File(filename+".old"); f.renameTo(fnew); LineNumberReader reader = new LineNumberReader(new FileReader(fnew)); PrintWriter writer = new PrintWriter(new FileWriter(f)); do { String line = reader.readLine(); if (line == null) break; String proofinfo[] = filter(line); if (proofinfo == null) writer.println(line); else { String proofname = proofinfo[0]; proofcounter++; if (ignore(proofname)) { System.out.println("warning: ignoring '"+proofname+"' in "+filename); writer.println(line); } else if (table.get(proofname) != null) { System.out.println("warning: duplicate '"+proofname+"' in "+filename); writer.println(line); } else { writer.println("let "+proofname+" = nprove \""+ proofname+"\""+proofinfo[1]); table.put(proofname, proofname); } } } while (true); reader.close(); writer.close(); } public static void main(String args[]) throws IOException { proofcounter = 0; for (int i=0; i/Minisat/README for other instruction. We use zChaff instead of Minisat because Minisat is buggy. Therefore see also /Minisat/zc2mso/README. b) You need install the ocamlgraph library - http://ocamlgraph.lri.fr/. We suppose that you install it in /ocamlgraph. We use the ocamlgraph library for topological sorting. Dependency on this library will be probably eliminated in some future release. c) You need Squolem - http://www.cprover.org/qbv/download.html, please download the latest version. We suppose that a name of Squolem's binary is squolem2 and is on your PATH. Installation ============ Just copy QBF directory into HOL Light's directory. Using ===== After you load HOL Light, write the following command: #use "QBF/make.ml";; Then you can use prove_qbf function for proving valid QBF instances: # let xor = `!x y. ?w. w <=> ((x /\ ~y) \/ (~x /\ y))`;; val xor : term = `!x y. ?w. w <=> x /\ ~y \/ ~x /\ y` # prove_qbf xor;; TRUE Number of extensions: 4 val it : thm = |- !x y. ?w. w <=> x /\ ~y \/ ~x /\ y Or you can load QBF from QDimacs input file. # let qbf = readQDimacs "/impl02.qdimacs";; val qbf : term = `?v_1 v_2 v_3. !v_4. ?v_5 v_6 v_7. !v_8. ?v_9 v_10. (~v_9 \/ v_10) /\ (v_8 \/ ~v_10 \/ v_6) /\ (v_8 \/ ~v_6 \/ v_10) /\ (v_8 \/ ~v_9 \/ v_7) /\ (v_8 \/ ~v_7 \/ v_9) /\ (~v_8 \/ ~v_10 \/ v_7) /\ (~v_8 \/ ~v_7 \/ v_10) /\ (~v_8 \/ ~v_9 \/ v_5) /\ (~v_8 \/ ~v_5 \/ v_9) /\ (~v_4 \/ ~v_6 \/ v_2) /\ (~v_4 \/ ~v_2 \/ v_6) /\ (~v_4 \/ ~v_5 \/ v_3) /\ (~v_4 \/ ~v_3 \/ v_5) /\ (v_4 \/ ~v_6 \/ v_3) /\ (v_4 \/ ~v_3 \/ v_6) /\ (v_4 \/ ~v_5 \/ v_1) /\ (v_4 \/ ~v_1 \/ v_5) /\ v_1` # prove_qbf qbf;; TRUE Number of extensions: 22 val it : thm = |- ?v_1 v_2 v_3. !v_4. ?v_5 v_6 v_7. !v_8. ?v_9 v_10. (~v_9 \/ v_10) /\ (v_8 \/ ~v_10 \/ v_6) /\ (v_8 \/ ~v_6 \/ v_10) /\ (v_8 \/ ~v_9 \/ v_7) /\ (v_8 \/ ~v_7 \/ v_9) /\ (~v_8 \/ ~v_10 \/ v_7) /\ (~v_8 \/ ~v_7 \/ v_10) /\ (~v_8 \/ ~v_9 \/ v_5) /\ (~v_8 \/ ~v_5 \/ v_9) /\ (~v_4 \/ ~v_6 \/ v_2) /\ (~v_4 \/ ~v_2 \/ v_6) /\ (~v_4 \/ ~v_5 \/ v_3) /\ (~v_4 \/ ~v_3 \/ v_5) /\ (v_4 \/ ~v_6 \/ v_3) /\ (v_4 \/ ~v_3 \/ v_6) /\ (v_4 \/ ~v_5 \/ v_1) /\ (v_4 \/ ~v_1 \/ v_5) /\ v_1 Or you can use prove_all_qbf function. It reads all QDimacs files in the given directory and try to prove them and returns an array of theorems. # prove_all_qbf "";; There are two Boolean flags that can affect verbosity of the output: a) show_progress - default false, if set true (show_progress := true), progress of proving the model term is shown (in %). It is useful for long proofs. One can see how much work is already done. b) show_timing - default false, if set true, many timings of several parts of the code are shown. For meaning see the code. hol-light/QBF/make.ml000066400000000000000000000006111303454263000146220ustar00rootroot00000000000000(* ========================================================================= *) (* Ondrej Kuncar's HOL Light QBF code. *) (* ========================================================================= *) #load "ocamlgraph/graph.cma";; #directory "+ocamlgraph";; loads "Minisat/make.ml";; loads "QBF/mygraph.ml";; loads "QBF/qbfr.ml";; loads "QBF/qbf.ml";; hol-light/QBF/mygraph.ml000066400000000000000000000006431303454263000153610ustar00rootroot00000000000000unset_jrh_lexer;; module Intvertex = struct type t = int let compare : t -> t -> int = Pervasives.compare let hash = Hashtbl.hash let equal = (=) let default = 0 end;; module Gr = Graph.Imperative.Digraph.ConcreteBidirectional(Intvertex);; module Topo = Graph.Topological.Make(Gr);; let make_vertex var_index = Gr.V.create var_index;; let dest_vertex var_index = Gr.V.label var_index;; set_jrh_lexer;; hol-light/QBF/qbf.ml000066400000000000000000001133551303454263000144670ustar00rootroot00000000000000(* ====================================================== *) (* Squolem proof reconstruction *) (* (c) Copyright, OndÅ™ej KunÄar 2010-11 *) (* ====================================================== *) set_jrh_lexer;; let show_progress = ref false;; let show_timing = ref false;; let delete_qbf_tempfiles = ref true;; type quantifier = Existential of term | Universal of term;; let make_variable index = if index <= 0 then failwith "Variable of index 0 or lesser is not allowed" else mk_var ("v_"^(string_of_int index), bool_ty) ;; let make_literal index = if index < 0 then mk_neg (make_variable (-index)) else make_variable index ;; let destroy_variable var = let var_string = string_of_term var in int_of_string (String.sub var_string 2 (String.length var_string -2)) ;; let destroy_literal lit = match is_neg lit with true -> - destroy_variable (dest_neg lit) | false -> destroy_variable lit ;; let get_quant_var quantifier = match quantifier with Existential t -> t | Universal t -> t ;; let has_quant tm = Pervasives.(||) (is_exists tm) (is_forall tm) ;; let dest_quant tm = if is_exists tm then dest_exists tm else dest_forall tm ;; module type Qbfcontextsig = sig type variables = (int,unit) Hashtbl.t;; type extensions = (int,term) Hashtbl.t;; type quantifiers = quantifier list;; type aux_variables = int list;; type q_levels = int array;; type context = { (** all variables, i.e, variables in a formula and auxiliary variables from extensions *) variables:variables; extensions:extensions; mutable aux_variables:aux_variables; (** quantifiers prefix in bottom-up ordering *) mutable quantifiers:quantifiers; mutable q_levels:q_levels; mutable q_ordered_levels:q_levels };; val create_context : int -> context (** quantifiers must be in bottom-up ordering *) val set_quantifiers : context -> quantifiers -> unit val check_variable : context -> int -> unit val check_fresh_variable : context -> int -> unit val add_universal_variable : context -> int -> unit val add_existential_variable : context -> int -> unit val add_extension : context -> int -> term -> unit val add_conclusion_eq : context -> int -> term -> unit val get_extensions : context -> (term * term) list val get_extension : context -> int -> term val get_quantifiers : context -> quantifiers val get_aux_variables : context -> aux_variables val make_quantifiers_levels : context -> unit val make_ordered_quantifiers_levels : context -> unit val lt_levels : context -> int -> int -> bool val lt_ordered_levels : context -> int -> int -> bool end;; module Qbfcontext : Qbfcontextsig = struct type variables = (int,unit) Hashtbl.t;; type extensions = (int,term) Hashtbl.t;; type quantifiers = quantifier list;; type aux_variables = int list;; type q_levels = int array;; type context = { variables:variables; extensions:extensions; mutable aux_variables:aux_variables; mutable quantifiers:quantifiers; mutable q_levels:q_levels; mutable q_ordered_levels:q_levels };; let create_context var_count = { variables = Hashtbl.create (2*var_count); extensions = Hashtbl.create var_count; aux_variables = []; quantifiers = []; q_levels = Array.make 0 0; q_ordered_levels = Array.make 0 0 } ;; let set_quantifiers context quants = context.quantifiers <- quants ;; let check_variable context var_index = if not (Hashtbl.mem context.variables var_index) then failwith ((string_of_int var_index)^" is undefined variable") ;; let check_fresh_variable context var_index = if Hashtbl.mem context.variables var_index then failwith ((string_of_int var_index)^" is not a fresh variable") ;; let add_universal_variable context var_index = check_fresh_variable context var_index; Hashtbl.add context.variables var_index () ;; let add_existential_variable context var_index = check_fresh_variable context var_index; Hashtbl.add context.variables var_index (); Hashtbl.add context.extensions var_index `T` ;; let add_aux_variable context var_index = check_fresh_variable context var_index; Hashtbl.add context.variables var_index (); context.aux_variables <- var_index::context.aux_variables ;; let add_aux_quantifier context var_index free_variables = let quantifier = Existential (make_variable var_index) in let rec remove_from_list l ls = match ls with [] -> [] | l'::ls' when l'=l -> ls' | l'::ls'-> l'::remove_from_list l ls' in let rec insert_quantifier quantifiers free_variables = match free_variables with [] -> quantifier::quantifiers | _ -> match quantifiers with q::qs -> q::(insert_quantifier qs (remove_from_list (get_quant_var q) free_variables)) | [] -> failwith "add_aux_quantifier: logic error" in context.quantifiers <- List.rev ((insert_quantifier (List.rev context.quantifiers) free_variables)) ;; let add_extension context var_index formula = add_aux_variable context var_index; add_aux_quantifier context var_index (variables formula); Hashtbl.add context.extensions var_index formula ;; let add_conclusion_eq context var_index formula = Hashtbl.replace context.extensions var_index formula ;; let get_extension context var_index = Hashtbl.find context.extensions var_index ;; let get_extensions context = Hashtbl.fold (fun f s l -> (make_variable f,s)::l) context.extensions [] ;; let get_quantifiers context = context.quantifiers ;; let get_aux_variables context = context.aux_variables ;; let make_quantifiers_levels_inter context = let quantifiers = context.quantifiers in let rec loop arr quants level = match quants with [] -> arr | q::qs -> arr.(((destroy_variable o get_quant_var) q) - 1) <- level; loop arr qs (level - 1) in let arr = Array.make (List.length quantifiers) 0 in let arr' = loop arr quantifiers (List.length quantifiers) in arr' ;; let make_quantifiers_levels context = context.q_levels <- make_quantifiers_levels_inter context ;; let make_ordered_quantifiers_levels context = context.q_ordered_levels <- make_quantifiers_levels_inter context ;; let lt_levels context v1 v2 = context.q_levels.(v1-1) < context.q_levels.(v2-1) ;; let lt_ordered_levels context v1 v2 = context.q_ordered_levels.(v1-1) < context.q_ordered_levels.(v2-1) ;; end;; open Qbfcontext;; let rec strip_quantifiers tm = if is_forall tm then let (var,tm') = dest_forall tm in let (q',body) = (strip_quantifiers tm') in ((Universal var)::q',body) else if is_exists tm then let (var,tm') = dest_exists tm in let (q',body) = (strip_quantifiers tm') in ((Existential var)::q',body) else ([],tm) ;; (** strip quantifiers in bottom-up ordering *) let strip_quantifiers_r tm = let rec loop tm acc = if is_forall tm then let (var,tm') = dest_forall tm in loop tm' ((Universal var)::acc) else if is_exists tm then let (var,tm') = dest_exists tm in loop tm' ((Existential var)::acc) else (acc,tm) in loop tm [] ;; (** strip quantifiers in bottom-up ordering *) let strip_quantifiers_rx tm = let rec loop tm acc = if is_forall tm then let (var,tm') = dest_forall tm in loop tm' ((true, var)::acc) else if is_exists tm then let (var,tm') = dest_exists tm in loop tm' ((false, var)::acc) else (acc,tm) in loop tm [] ;; let quantifiers_fold_left exist_fn universal_fn thm quantifiers = let quant_fn thm quantifier = match quantifier with Universal var -> universal_fn var thm | Existential var -> exist_fn var thm in List.fold_left quant_fn thm quantifiers ;; let is_negated lit_ind = lit_ind < 0;; let read_index token_stream = let index_token = Stream.next token_stream in match index_token with Genlex.Int index -> index | _ -> failwith "Bad index of variable" ;; let var = abs;; let read_extension_ite context new_var_index token_stream = let x_v_i = read_index token_stream in let y_v_i = read_index token_stream in let z_v_i = read_index token_stream in check_variable context (var x_v_i); check_variable context (var y_v_i); check_variable context (var z_v_i); let x_v = make_literal x_v_i in let y_v = make_literal y_v_i in let z_v = make_literal z_v_i in let formula = mk_disj (mk_conj (x_v,y_v),mk_conj(mk_neg x_v,z_v)) in add_extension context new_var_index formula; ;; let read_extension_and context new_var_index token_stream = let rec read_conjucts context token_stream = let lit_ind = read_index token_stream in if lit_ind = 0 then [] else begin check_variable context (var lit_ind); (make_literal lit_ind)::(read_conjucts context token_stream) end in let conjucts = read_conjucts context token_stream in let conjucts' = match conjucts with [] -> `T` | _ -> list_mk_conj conjucts in add_extension context new_var_index conjucts'; ;; let read_extension_line context token_stream = let new_var_index = read_index token_stream in let extension_type = Stream.next token_stream in match extension_type with Genlex.Kwd "I" -> read_extension_ite context new_var_index token_stream | Genlex.Kwd "A" -> read_extension_and context new_var_index token_stream | _ -> failwith "Unknown type of extension line" ;; let read_header context token_stream = match Stream.next token_stream with Genlex.Kwd "QBCertificate" -> () | _ -> failwith "Missing header" ;; let read_resolution_line context token_stream = failwith "Resolution line: not yet implemented!"; () ;; let rec read_equalities context token_stream = try let exist_var_i = read_index token_stream in check_variable context exist_var_i; let extension_var_i = read_index token_stream in check_variable context (var extension_var_i); let extension_var = make_literal extension_var_i in add_conclusion_eq context exist_var_i extension_var; read_equalities context token_stream with Stream.Failure -> () ;; let read_conlude_line context token_stream = match Stream.next token_stream with Genlex.Kwd "VALID" -> read_equalities context token_stream | Genlex.Kwd "INVALID" -> failwith "INVALID formula: not yet implemted!" | _ -> failwith "Unknown type of conclusion" ;; let read_certificate context token_stream = read_header context token_stream; let rec read_line context token_stream = match Stream.next token_stream with Genlex.Kwd "E" -> read_extension_line context token_stream; read_line context token_stream | Genlex.Kwd "R" -> read_resolution_line context token_stream; read_line context token_stream | Genlex.Kwd "CONCLUDE" -> read_conlude_line context token_stream | _ -> failwith "Unknown type of line" in read_line context token_stream ;; let PROPAGATE_FORALL = let MONO_FORALL_B = (UNDISCH o prove) (`(!x:bool. A x ==> B x) ==> (!) A ==> (!) B`, STRIP_TAC THEN GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV) [GSYM ETA_AX] THEN ASM_MESON_TAC[]) in let a_tm = rand(lhand(concl MONO_FORALL_B)) and b_tm = rand(rand(concl MONO_FORALL_B)) and h_tm = hd(hyp MONO_FORALL_B) in fun v1 -> let ath = GEN_ALPHA_CONV v1 h_tm in let atm = rand(concl ath) in let pth = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) MONO_FORALL_B in fun thm -> let tm = concl thm in let ip,q = dest_comb tm in let i,p = dest_comb ip in let pabs = mk_abs(v1,p) and qabs = mk_abs(v1,q) in let th1 = AP_TERM i (BETA(mk_comb(pabs,v1))) in let th2 = MK_COMB(th1,BETA(mk_comb(qabs,v1))) in let th3 = GEN v1 (EQ_MP (SYM th2) thm) in let th4 = INST [pabs,a_tm; qabs,b_tm] pth in PROVE_HYP th3 th4;; let PROPAGATE_RIGHT = let MONO_EXISTS_RIGHT_B = (UNDISCH o prove) (`(A ==> B(x:bool)) ==> A ==> (?) B`, ASM_CASES_TAC `A:bool` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN MESON_TAC[]) in let a_tm = lhand(concl MONO_EXISTS_RIGHT_B) and b_tm = rand(rand(concl MONO_EXISTS_RIGHT_B)) and h_tm = hd(hyp MONO_EXISTS_RIGHT_B) in let x_tm = rand(rand h_tm) in fun v thm -> let tm = concl thm in let ip,q = dest_comb tm in let qabs = mk_abs(v,q) in let th1 = AP_TERM ip (BETA(mk_comb(qabs,v))) in let th2 = EQ_MP (SYM th1) thm in let th3 = INST [rand ip,a_tm; qabs,b_tm; v,x_tm] MONO_EXISTS_RIGHT_B in PROVE_HYP th2 th3;; let PROPAGATE_LEFT = let MONO_EXISTS_LEFT_B = (UNDISCH o prove) (`(!x:bool. A x ==> B) ==> (?) A ==> B`, ASM_CASES_TAC `B:bool` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM ETA_AX] THEN MESON_TAC[]) in let a_tm = rand(lhand(concl MONO_EXISTS_LEFT_B)) and b_tm = rand(concl MONO_EXISTS_LEFT_B) and h_tm = hd(hyp MONO_EXISTS_LEFT_B) in fun v -> let ath = GEN_ALPHA_CONV v h_tm in let atm = rand(concl ath) in let pth = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) MONO_EXISTS_LEFT_B in fun thm -> let tm = concl thm in let ip,q = dest_comb tm in let i,p = dest_comb ip in let pabs = mk_abs(v,p) in let th1 = AP_THM (AP_TERM i (BETA(mk_comb(pabs,v)))) q in let th2 = GEN v (EQ_MP (SYM th1) thm) in let th3 = INST [pabs,a_tm; q,b_tm] pth in PROVE_HYP th2 th3;; let PROPAGATE_QUANTIFIERS_R thm ext_quants quants = let rec propagate_both thm ext_quants quants = match (ext_quants,quants) with | ((Universal v1)::ext_quantss,(Universal v2)::quantss) -> propagate_both (PROPAGATE_FORALL v1 thm) ext_quantss quantss | (_,_) -> (thm,ext_quants,quants) in let rec propagate_right thm quants = match quants with | (Existential v)::quantss -> propagate_right (PROPAGATE_RIGHT v thm) quantss | _ -> (thm,quants) in let rec propagate_left thm ext_quants = match ext_quants with | (Existential v)::ext_quantss -> propagate_left (PROPAGATE_LEFT v thm) ext_quantss | _ -> (thm,ext_quants) in let rec propagate thm ext_quants quants = match (ext_quants,quants) with | ([],[]) -> thm | (_,((Existential _)::_)) -> let (thm',quants') = propagate_right thm quants in let (thm'',ext_quants') = propagate_left thm' ext_quants in propagate thm'' ext_quants' quants' | (((Existential _)::_),_) -> let (thm',ext_quants') = propagate_left thm ext_quants in propagate thm' ext_quants' quants | ((Universal _)::_,(Universal _)::_) -> let (thm',ext_quants',quants') = propagate_both thm ext_quants quants in propagate thm' ext_quants' quants' | _ -> failwith "PROPAGATE_QUANTIFIERS_R: logic error" in propagate thm ext_quants quants ;; let order_quantifiers context = let add_var vertices graph var_index = Gr.add_vertex graph (make_vertex var_index); let extension_vars = variables (get_extension context var_index) in let add_ext_var ext_var = let ext_var_index = destroy_variable ext_var in if Hashtbl.mem vertices ext_var_index then Gr.add_edge graph (make_vertex ext_var_index) (make_vertex var_index) in List.iter add_ext_var extension_vars in let rec is_sorted var_index_list = let is_sorted_var var_index = let extension_vars = variables (get_extension context var_index) in List.fold_left (fun ret var -> ret && lt_levels context (destroy_variable var) var_index) true extension_vars in match var_index_list with [] -> true | var::vars -> if is_sorted_var var then is_sorted vars else false in (** exists is in up-bottom ordering *) let rec order_exists quantifiers exists = let order_exists' tail = if is_sorted exists then List.fold_left (fun tail var_index -> (Existential (make_variable var_index))::tail) tail exists else let graph = Gr.create () in let vertices = Hashtbl.create (List.length exists) in List.iter (fun var -> Hashtbl.add vertices var ()) exists; List.iter (fun var -> add_var vertices graph var) exists; Topo.fold (fun vertex tail -> (Existential (make_variable (dest_vertex vertex)))::tail) graph tail in match quantifiers with [] -> order_exists' [] | (Universal v)::qs -> order_exists' ((Universal v)::order qs) | (Existential v)::qs -> order_exists qs ((destroy_variable v)::exists) and order quantifiers = match quantifiers with [] -> [] | (Universal v)::qs -> (Universal v)::order qs | (Existential v)::qs -> order_exists ((Existential v)::qs) [] in set_quantifiers context (order (get_quantifiers context)); make_ordered_quantifiers_levels context ;; let match_time = ref 0.0;; let lift_time = ref 0.0;; let gen_time = ref 0.0;; let test_time = ref 0.0;; let timex label f x = if not (!show_timing) then f x else let start_time = Sys.time() in try let result = f x in let finish_time = Sys.time() in report("CPU time (user): "^(string_of_float(finish_time -. start_time))^" ("^label^")"); result with e -> let finish_time = Sys.time() in Format.print_string("Failed after (user) CPU time of "^ (string_of_float(finish_time -. start_time))^" ("^label^")"^": "); raise e;; let my_time f x time_var = if not (!show_timing) then f x else let start_time = Sys.time() in try let result = f x in let finish_time = Sys.time() in time_var := !time_var +. (finish_time -. start_time); result with e -> let finish_time = Sys.time() in time_var := !time_var +. (finish_time -. start_time); raise e;; let report_time label time_var = if !show_timing then report("CPU time (user): "^(string_of_float(!time_var))^" ("^label^")"); ;; let FORALL_SIMP2 = prove (`t = (!x:bool. t)`, ITAUT_TAC);; let ADD_MISSING_UNIVERSALS th quants = let rec add_u quants tm = match quants with | [] -> REFL tm | q::qs -> match q with | Existential _ -> BINDER_CONV (add_u qs) tm | Universal v -> if Pervasives.(||) (not (has_quant tm)) (Pervasives.compare ((fst o dest_quant) tm) v != 0) then let renamed_rewr = EQ_MP (ONCE_DEPTH_CONV (ALPHA_CONV v) (concl FORALL_SIMP2)) FORALL_SIMP2 in (PURE_ONCE_REWRITE_CONV [renamed_rewr] THENC BINDER_CONV (add_u qs)) tm else BINDER_CONV (add_u qs) tm in EQ_MP (add_u (rev quants) (concl th)) th ;; let AX_UXU = (UNDISCH o prove) (`(!x:bool. p x /\ q ==> r x) ==> (!) p /\ q ==> (!) r`, let AX_UXU = MESON [] `(!x:bool. ((A x /\ B)==>C x))==>(((!x:bool. A x) /\ B)==> !x:bool. C x)` in DISCH_THEN(MP_TAC o MATCH_MP AX_UXU) THEN REWRITE_TAC[ETA_AX]) and AX_EXE = (UNDISCH o prove) (`(!x:bool. p x /\ q ==> r x) ==> (?) p /\ q ==> (?) r`, let AX_EXE = MESON [] `(!x:bool. ((A x /\ B)==>C x))==>(((?x:bool. A x) /\ B)==> ?x:bool. C x)` in DISCH_THEN(MP_TAC o MATCH_MP AX_EXE) THEN REWRITE_TAC[ETA_AX]);; let LIFT_LEFT ax = let p_tm = rand(lhand(lhand(concl ax))) and q_tm = rand(lhand(concl ax)) and r_tm = rand(rand(concl ax)) and h_tm = hd(hyp ax) in fun var -> let ath = GEN_ALPHA_CONV var h_tm in let atm = rand(concl ath) in let ax' = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) ax in fun th -> let tm = concl th in let ipq,r = dest_comb tm in let i,pq = dest_comb ipq in let ap,q = dest_comb pq in let a,p = dest_comb ap in let pabs = mk_abs(var,p) and rabs = mk_abs(var,r) in let th1 = AP_THM (AP_TERM a (BETA(mk_comb(pabs,var)))) q in let th2 = MK_COMB(AP_TERM i th1,BETA(mk_comb(rabs,var))) in let th3 = GEN var (EQ_MP (SYM th2) th) in let th4 = INST [pabs,p_tm; q,q_tm; rabs,r_tm] ax' in PROVE_HYP th3 th4;; let AX_XUU = (UNDISCH o prove) (`(!x:bool. p /\ q x ==> r x) ==> p /\ (!) q ==> (!) r`, let AX_XUU = MESON [] `(!x:bool. ((A /\ B x)==>C x))==>((A /\ !x:bool. B x)==> !x:bool. C x)` in DISCH_THEN(MP_TAC o MATCH_MP AX_XUU) THEN REWRITE_TAC[ETA_AX]) and AX_XEE = (UNDISCH o prove) (`(!x:bool. p /\ q x ==> r x) ==> p /\ (?) q ==> (?) r`, let AX_XEE = MESON [] `(!x:bool. ((A /\ B x)==>C x))==>((A /\ ?x:bool. B x)==> ?x:bool. C x)` in DISCH_THEN(MP_TAC o MATCH_MP AX_XEE) THEN REWRITE_TAC[ETA_AX]);; let LIFT_RIGHT ax = let p_tm = lhand(lhand(concl ax)) and q_tm = rand(rand(lhand(concl ax))) and r_tm = rand(rand(concl ax)) and h_tm = hd(hyp ax) in fun var -> let ath = GEN_ALPHA_CONV var h_tm in let atm = rand(concl ath) in let ax' = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) ax in fun th -> let tm = concl th in let ipq,r = dest_comb tm in let i,pq = dest_comb ipq in let ap,q = dest_comb pq in let a,p = dest_comb ap in let qabs = mk_abs(var,q) and rabs = mk_abs(var,r) in let th1 = AP_TERM ap (BETA(mk_comb(qabs,var))) in let th2 = MK_COMB(AP_TERM i th1,BETA(mk_comb(rabs,var))) in let th3 = GEN var (EQ_MP (SYM th2) th) in let th4 = INST [p,p_tm; qabs,q_tm; rabs,r_tm] ax' in PROVE_HYP th3 th4;; let AX_UUU = (UNDISCH o prove) (`(!x:bool. p x /\ q x ==> r x) ==> (!) p /\ (!) q ==> (!) r`, let AX_UUU = MESON [] `(!x:bool. ((A x /\ B x)==>C x))==>(((!x:bool. A x) /\ !x:bool. B x)==> !x:bool. C x)` in DISCH_THEN(MP_TAC o MATCH_MP AX_UUU) THEN REWRITE_TAC[ETA_AX]) and AX_EUE = (UNDISCH o prove) (`(!x:bool. p x /\ q x ==> r x) ==> (?) p /\ (!) q ==> (?) r`, let AX_EUE = MESON [] `(!x:bool. ((A x /\ B x)==>C x))==>(((?x:bool. A x) /\ !x:bool. B x)==> ?x:bool. C x)` in DISCH_THEN(MP_TAC o MATCH_MP AX_EUE) THEN REWRITE_TAC[ETA_AX]) and AX_UEE = (UNDISCH o prove) (`(!x:bool. p x /\ q x ==> r x) ==> (!) p /\ (?) q ==> (?) r`, let AX_UEE = MESON [] `(!x:bool. ((A x /\ B x)==>C x))==>(((!x:bool. A x) /\ ?x:bool. B x)==> ?x:bool. C x)` in DISCH_THEN(MP_TAC o MATCH_MP AX_UEE) THEN REWRITE_TAC[ETA_AX]);; let LIFT_BOTH ax = let p_tm = rand(lhand(lhand(concl ax))) and q_tm = rand(rand(lhand(concl ax))) and r_tm = rand(rand(concl ax)) and h_tm = hd(hyp ax) in fun var -> let ath = GEN_ALPHA_CONV var h_tm in let atm = rand(concl ath) in let ax' = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) ax in fun th -> let tm = concl th in let ipq,r = dest_comb tm in let i,pq = dest_comb ipq in let ap,q = dest_comb pq in let a,p = dest_comb ap in let pabs = mk_abs(var,p) and qabs = mk_abs(var,q) and rabs = mk_abs(var,r) in let th0 = AP_TERM a (BETA(mk_comb(pabs,var))) in let th1 = MK_COMB(th0,BETA(mk_comb(qabs,var))) in let th2 = MK_COMB(AP_TERM i th1,BETA(mk_comb(rabs,var))) in let th3 = GEN var (EQ_MP (SYM th2) th) in let th4 = INST [pabs,p_tm; qabs,q_tm; rabs,r_tm] ax' in PROVE_HYP th3 th4;; let solve_quantifiers context conjuction = let solve_right_quantifier thm quant2 = match quant2 with | Universal v2 -> LIFT_RIGHT AX_XUU v2 thm | Existential v2 -> LIFT_RIGHT AX_XEE v2 thm in let solve_left_quantifier thm quant1 = match quant1 with | Universal v1 -> LIFT_LEFT AX_UXU v1 thm | Existential v1 -> LIFT_LEFT AX_EXE v1 thm in let solve_both_quantifiers thm quant1 quant2 = match (quant1,quant2) with (Universal v1, Universal v2) -> LIFT_BOTH AX_UUU v1 thm | (Existential v1, Universal v2) -> LIFT_BOTH AX_EUE v1 thm | (Universal v1, Existential v2) -> LIFT_BOTH AX_UEE v1 thm | _ -> failwith "Logic error in solve_quantifier" in let rec loop thm quants1 quants2 = match (quants1,quants2) with | ([],[]) -> thm | (qs1,[]) -> List.fold_left solve_left_quantifier thm qs1 | ([],qs2) -> List.fold_left solve_right_quantifier thm qs2 | (quant1::qs1,quant2::qs2) -> let quant_var1 = get_quant_var quant1 in let quant_var2 = get_quant_var quant2 in if quant_var1 = quant_var2 then let thm' = solve_both_quantifiers thm quant1 quant2 in loop thm' qs1 qs2 else if lt_ordered_levels context (destroy_variable quant_var1) (destroy_variable quant_var2) then let thm' = solve_right_quantifier thm quant2 in loop thm' (quant1::qs1) qs2 else let thm' = solve_left_quantifier thm quant1 in loop thm' qs1 (quant2::qs2) in let conclusion = concl conjuction in let (conj1,conj2) = dest_conj conclusion in let (quants1,body1) = strip_quantifiers_r conj1 in let (quants2,body2) = strip_quantifiers_r conj2 in let rew_thm = loop (DISCH_ALL (ASSUME (mk_conj (body1,body2)))) quants1 quants2 in (*print_thm rew_thm; print_newline (); print_thm conjuction; print_newline ();*) my_time (MP rew_thm) conjuction match_time ;; let make_quantified_model_equality = let pth = MESON[] `?x:bool. x = t` in let t_tm = rand(body(rand(concl pth))) in fun quantifier_data (exist_var,right_side) -> let free_vars = frees right_side in let n = quantifier_data exist_var in let quants = sort (decreasing quantifier_data) (filter (fun v -> quantifier_data v > n) free_vars) in let exist_eq_thm = INST[right_side,t_tm] (CONV_RULE(GEN_ALPHA_CONV exist_var) pth) in let ret = GENL quants exist_eq_thm in (* print_thm ret; print_endline ""; *) ret ;; let construct_model context equalities = match equalities with [] -> `T` | (eq::eqs) -> List.fold_left (C (curry mk_conj)) eq eqs ;; let construct_model_thm context equalities = let eq_length = List.length equalities in let progress = ref 1 in let print_progress () = print_endline ((string_of_int o int_of_float) (((float_of_int !progress)/.(float_of_int eq_length))*.100.0)) in let construct model eq = let ret = solve_quantifiers context (CONJ eq model) in if !show_progress then begin progress := !progress + 1; print_progress (); end; ret in let rec construct_recursively eqs = match eqs with [] -> failwith "Sanity check failure" | [e] -> e | [e1;e2] -> construct e1 e2 | _ -> let n = length eqs in let eqs1,eqs2 = chop_list (length eqs / 2) eqs in construct (construct_recursively eqs1) (construct_recursively eqs2) in if equalities = [] then quantifiers_fold_left SIMPLE_EXISTS GEN TRUTH (get_quantifiers context) else PURE_REWRITE_RULE[GSYM CONJ_ASSOC] (construct_recursively equalities);; let make_model context = let model_equalities = get_extensions context in let model = construct_model context (List.map mk_eq model_equalities) in let quantifier_list = map (function Universal v -> v | Existential v -> v) (get_quantifiers context) in let quantifier_table = itlist2 (|->) quantifier_list (1--length quantifier_list) undefined in let quantifier_data = apply quantifier_table in let quantified_equalities = timex "make_quantified_equalities" (List.map (make_quantified_model_equality quantifier_data)) model_equalities in let model_thm = match_time := 0.0; lift_time := 0.0; gen_time := 0.0; test_time := 0.0; print_endline ("Number of extensions: "^ (string_of_int (List.length model_equalities))); let ret = timex "construct_model_thm" (construct_model_thm context) quantified_equalities in report_time "lift" lift_time; report_time "match" match_time; report_time "gen" gen_time; report_time "test" test_time; ret in (*let model_thm = construct_model_thm context (List.map (make_quantified_model_equality context) model_equalities) in*) (model, model_thm) ;; let check_and_preprocess context formula = match frees formula with [ _ ] -> failwith "Formula has free variables" | _ -> let nnf_thm = NNF_CONV formula in let prenex_thm = TRANS nnf_thm (PRENEX_CONV (rhs (concl nnf_thm))) in let cnf_thm = TRANS prenex_thm (CNF_CONV (rhs (concl prenex_thm))) in let rec check_and_made_rename formula index rename = let rename_quantifier constr destr add_fresh_variable = let (var,destr_formula) = destr formula in if type_of var <> bool_ty then failwith ((string_of_term var)^" is not of bool type"); add_fresh_variable context index; let formula2 = check_and_made_rename destr_formula (index+1) ((make_variable index,var)::rename) in constr (make_variable index,formula2) in if is_forall formula then rename_quantifier mk_forall dest_forall add_universal_variable else if is_exists formula then rename_quantifier mk_exists dest_exists add_existential_variable else vsubst rename formula in let prenex_formula = rhs (concl cnf_thm) in let ret = TRANS cnf_thm (ALPHA prenex_formula (check_and_made_rename prenex_formula 1 [])) in let (quantifiers',_) = strip_quantifiers_r (rhs (concl ret)) in set_quantifiers context quantifiers'; ret ;; let get_temp_file () = Filename.open_temp_file "qbf" "" ;; let split_disjuncts body = List.fold_right (fun c d -> (disjuncts c) :: d) (conjuncts body) [] ;; let string_of_literal lit = string_of_int (destroy_literal lit); ;; type prefix = Exists of term list | Forall of term list;; let rec strip_quantifiers_as_prefix formula = if is_forall formula then let (quants,formula') = strip_forall formula in let (quants',body) = strip_quantifiers_as_prefix formula' in ((Forall quants)::quants',body) else if is_exists formula then let (quants,formula') = strip_exists formula in let (quants',body) = strip_quantifiers_as_prefix formula' in ((Exists quants)::quants',body) else ([],formula) ;; let make_input context formula var_count = let (file_name,file_stream) = get_temp_file () in try let (quantifiers_list, body) = strip_quantifiers_as_prefix formula in let clause_count = length(conjuncts body) in let disjuncts_list = split_disjuncts body in let out s = output_string file_stream s in let formula_string = Str.global_replace (Str.regexp_string "\n") "\nc " (string_of_term formula) in out "c "; out formula_string;out "\n"; out "c\n"; out "p cnf "; out (string_of_int var_count); out " "; out (string_of_int clause_count); out "\n"; let print_quantifiers q = let print_vars q = List.iter (fun var -> (out(string_of_literal var); out " ")) q; out "0\n" in match q with Exists vars -> out "e "; print_vars vars | Forall vars -> out "a "; print_vars vars in List.iter (fun q -> print_quantifiers q) quantifiers_list; List.iter (fun l -> (List.iter (fun lit -> (out(string_of_literal lit); out " ")) l; out "0\n")) disjuncts_list; close_out file_stream; file_name with x -> close_out file_stream; raise x ;; let execute_squolem input_file_name = let exec_name = "squolem2 -c " ^ input_file_name in let _ = Sys.command exec_name in input_file_name ^ ".qbc" ;; let parse_certificate context certificate_file_name = let file_channel = Pervasives.open_in certificate_file_name in let token_stream = (Genlex.make_lexer ["I";"A";"QBCertificate";"VALID";"INVALID";"E";"R";"CONCLUDE"] (Stream.of_channel file_channel)) in read_certificate context token_stream let print_model context = let (model, model_thm) = make_model context in print_endline (string_of_term model); print_endline (string_of_thm model_thm) ;; let print_quantifiers context = let print_quantifier quant = match quant with Existential v -> print_string "E "; print_term v; print_string " " | Universal v -> print_string "F "; print_term v; print_string " " in List.iter print_quantifier (get_quantifiers context); print_newline () ;; let ZSAT_PROVE' = let ASSOC_EQ_CONV th = let assoc_canon = ASSOC_CONV th in fun tm -> let l,r = dest_eq tm in TRANS (assoc_canon l) (SYM(assoc_canon r)) in let opacs = [`\/`,ASSOC_EQ_CONV DISJ_ASSOC; `/\`,ASSOC_EQ_CONV CONJ_ASSOC; `<=>`,ASSOC_EQ_CONV(TAUT `(t1 <=> t2 <=> t3) <=> ((t1 <=> t2) <=> t3)`)] in let rec ASSOC_BALANCE_CONV tm = match tm with Comb(Comb(op,l),r) when can (assoc op) opacs -> let tms = striplist (dest_binop op) tm in let n = length tms in if n <= 1 then failwith "sanity check failure" else if n = 2 then BINOP_CONV ASSOC_BALANCE_CONV tm else let tms1,tms2 = chop_list (n / 2) tms in let tm1 = list_mk_binop op tms1 and tm2 = list_mk_binop op tms2 in let th = assoc op opacs (mk_eq(tm,mk_binop op tm1 tm2)) in CONV_RULE (RAND_CONV (BINOP_CONV ASSOC_BALANCE_CONV)) th | _ -> REFL tm in let conv = DEPTH_BINOP_CONV `(/\)` (NNFC_CONV THENC CNF_CONV) in fun tm -> let th = COMB2_CONV (RAND_CONV conv) ASSOC_BALANCE_CONV tm in let tm' = rand(concl th) in EQ_MP (SYM th) (ZSAT_PROVE tm');; let build_proof context prenex_thm = let formula = rhs (concl prenex_thm) in let (quants,formula_body) = strip_quantifiers_r formula in timex "make_q_levels" make_quantifiers_levels context; (*print_quantifiers context;*) timex "order_qs" order_quantifiers context; (*print_quantifiers context;*) let (model, model_thm) = timex "make_model" make_model context in let sat_formula = mk_imp (model,formula_body) in let proved_sat_formula = timex "sat" ZSAT_PROVE' sat_formula in let q_propagated_formula = timex "propagate" (PROPAGATE_QUANTIFIERS_R proved_sat_formula (get_quantifiers context)) quants in let (model_quantifiers,_) = strip_quantifiers_r (concl model_thm) in let proved_formula = if List.length model_quantifiers != List.length (get_quantifiers context) then MP q_propagated_formula (timex "add_missing" (ADD_MISSING_UNIVERSALS model_thm) (get_quantifiers context)) else (*MP q_propagated_formula model_thm*) MP q_propagated_formula (timex "add_missing" (ADD_MISSING_UNIVERSALS model_thm) (get_quantifiers context)) in EQ_MP (GSYM prenex_thm) proved_formula ;; let prove_qbf formula = let var_count = length (variables formula) in let context = create_context var_count in let prenex_thm = timex "prep" (check_and_preprocess context) formula in let input_file_name = timex "make_input" (make_input context (rand (concl prenex_thm))) var_count in let output_file_name = timex "ex_squolem" execute_squolem input_file_name in let _ = timex "parse_cert" (parse_certificate context) output_file_name in let thm = timex "build_proof" (build_proof context) prenex_thm in (if !delete_qbf_tempfiles then (Sys.remove input_file_name; Sys.remove output_file_name) else ()); thm ;; let prove_all_qbf dir = let filter_array f a = let l = Array.to_list a in let ll = List.filter f l in Array.of_list ll in let raw_files = Sys.readdir dir in let files = filter_array (fun name -> Filename.check_suffix name ".qdimacs") raw_files in let run_prover file_name = let name = Filename.chop_suffix file_name ".qdimacs" in print_endline name; let formula = readQDimacs (dir^"/"^file_name) in let formula_thm = prove_qbf formula in (name,formula_thm) in Array.map run_prover files ;; hol-light/QBF/qbfr.ml000066400000000000000000000055261303454263000146510ustar00rootroot00000000000000(* Code for reading QDicams. *) (* Based on Minisat/dimacs_tools.ml *) (* from HOL Light distribution. *) exception Read_dimacs_error;; let prefix = ref "v_" let intToPrefixedLiteral n = if n >= 0 then mk_var(((!prefix) ^ (string_of_int n)), bool_ty) else mk_neg(mk_var((!prefix) ^ (string_of_int(abs n)), bool_ty)) let buildClause l = List.fold_left (fun t n -> mk_disj(intToPrefixedLiteral n, t)) (intToPrefixedLiteral (hd l)) (tl l) let rec dropLine ins = match Stream.peek ins with Some '\n' -> Stream.junk ins | Some _ -> (Stream.junk ins; dropLine ins) | None -> raise Read_dimacs_error let rec stripPreamble ins = match Stream.peek ins with Some 'c' -> (dropLine ins; stripPreamble ins) | Some 'p' -> (dropLine ins; stripPreamble ins) | Some _ -> Some () | None -> None let rec getIntClause lex acc = match (try Stream.next lex with Stream.Failure -> Genlex.Kwd "EOF" (* EOF *)) with (Genlex.Int 0) -> Some acc | (Genlex.Int i) -> getIntClause lex (i::acc) | (Genlex.Kwd "EOF") -> if List.length acc = 0 then None else Some acc | _ -> raise Read_dimacs_error let rec getIntClause2 lex acc = match Stream.next lex with (Genlex.Int 0) -> acc | (Genlex.Int i) -> i::(getIntClause2 lex acc) | _ -> raise Read_dimacs_error let getTerms lex start_acc = let rec loop acc = match getIntClause lex [] with Some ns -> loop (mk_conj(buildClause ns,acc)) | None -> Some acc in match getIntClause lex start_acc with Some ns -> loop (buildClause ns) | None -> None type qs = Qe of int list | Qa of int list;; let read_quant lex = let rec loop acc = match Stream.next lex with Genlex.Kwd "e" -> let vars = getIntClause2 lex [] in let (acc',var) = loop acc in ((Qe vars)::acc',var) | Genlex.Kwd "a" -> let vars = getIntClause2 lex [] in let (acc',var) = loop acc in ((Qa vars)::acc',var) | Genlex.Int i -> (acc,i) | _ -> raise Read_dimacs_error in loop [] let var_map l = List.map intToPrefixedLiteral l let add_quantifiers quant body = List.fold_right (fun quants b -> match quants with Qa l -> list_mk_forall (var_map l,b) | Qe l -> list_mk_exists (var_map l,b) ) quant body let readTerms ins = match stripPreamble ins with Some _ -> let lex = (Genlex.make_lexer ["EOF";"e";"a"] ins) in let (quant,var) = read_quant lex in ( match getTerms lex [var] with Some body -> Some (add_quantifiers quant body) | None -> None ) | None -> None let readQDimacs filename = let inf = open_in filename in let ins = Stream.of_channel inf in let term = readTerms ins in (close_in inf; match term with Some t -> t | None -> raise Read_dimacs_error) hol-light/QUICK_REFERENCE.txt000066400000000000000000002650201303454263000157450ustar00rootroot00000000000000thm: REFL `x` gives `|- x = x` TRANS `ASM1 |- a = b` `ASM2 |- b = c` gives `ASM1+ASM2 |- a = c` MK_COMB (`ASM1 |- f = g`, `ASM2 |- a = b`) gives `ASM1+ASM2 |- (f a) = (g b)` ABS `x` `ASM1{-x} |- a=b` gives `ASM1 |- \x.a = \x.b` BETA is useless; use BETA_CONV ASSUME `a` gives `a |- a` EQ_MP `ASM1 |- a = b` `ASM2 |- a` gives `ASM1+ASM2 |- b` DEDUCT_ANTISYM_RULE `ASM1 |- a` `ASM2 |- b` gives `(ASM1-{b})+(ASM2-{a}) |- a=b` INST_TYPE instantiation theorem gives a new theorem with type variables instantiated INST instantiation theorem gives a new theorem with variables instantiated equal: BETA_CONV `(\x. A) y` gives `|- (\x. A) y = A[y/x]` AP_TERM `f` `ASM1 |- a = b` gives `ASM1 |- (f a) = (f b)` AP_THM `ASM1 |- f = g` `a` gives `ASM1 |- (f a) = (g a)` SYM `ASM1 |- a = b` gives `ASM1 |- b = a` ALPHA `(\x.x)` `(\y.y)` gives `|- (\x.x) = (\y.y)` ALPHA_CONV `y` `(\x.x)` gives `|- (\x.x) = (\y.y)` GEN_ALPHA_CONV `y` `!x. P[x]` gives `|- (!x. P[x]) = (!y. P[y])` (it looks inside one level of application) MK_BINOP `(+)` (`ASM1 |- a = b`, `ASM2 |- c = d`) gives `ASM1+ASM2 |- a + c = b + d` A conversion takes a term and returns an equality theorem with the term on the lhs (or it fails). NO_CONV is a conversion which always fails. ALL_CONV is a conversion which always succeeds without changing the term. c1 THENC c2 rewrites with c1 then c2. c1 ORELSEC c2 rewrites with c1; if it fails, it rewrites with c2 instead. FIRST_CONV [c1;...;cn] rewrites with the first non-failing conversion in the list. EVERY_CONV [c1;...;cn] rewrites with the first conversion, then the second, then ... then the last. REPEATC c rewrites with c until it fails (and returns the result of the last successful rewrite). CHANGED_CONV c rewrites with c, but fails if the result is alpha-equivalent to the original term. TRY_CONV c rewrites with c; if it fails, it does not change the term (and does not fail). RATOR_CONV c uses the conversion to rewrite the operator of a combination. RAND_CONV c uses the conversion to rewrite the operand of a combination. LAND_CONV c uses the conversion to rewrite the first argument of a binary function. COMB2_CONV c1 c2 uses c1 to rewrite the operator and c2 to rewrite the operand of a combination. COMB_CONV c rewrites both the operator and operand of a combination with c. ABS_CONV c rewrites the body of an abstraction with c. BINDER_CONV c rewrites the body of an abstraction or of a binder/abstraction combination. SUB_CONV c either rewrites both parts of a combination, or the body of an abstraction, or does nothing (it never fails). BINOP_CONV c rewrites both arguments of a binary function. THENQC c1 c2 is like (c1 THENC c2) ORELSEC c1 ORELSEC c2 THENCQC c1 c2 is like (c1 THENC c2) ORELSEC c1 REPEATQC c rewrites with c one or more times, until it fails (returning the last succeeding rewrite; if the initial rewrite fails, then REPEATQC fails) COMB2_QCONV c1 c2 is like (RATOR_CONV c1 THENC RAND_CONV c2) ORELSEC RATOR_CONV c1 ORELSEC RAND_CONV c2 COMB_QCONV c = COMB2_QCONV c c SUB_QCONV c is like ABS_CONV c ORELSEC COMB_QCONV c ONCE_DEPTH_QCONV c uses c to rewrite all maximal applicable terms (terms which are not properly contained in another applicable term). Fails if c does not apply to any terms. DEPTH_QCONV c repeatedly rewrites with c (in a single bottom-up sweep), failing if c does not apply anywhere. REDEPTH_QCONV c rewrites with c (in a bottom-up sweep); after any successful rewrite, it starts over again at the leaves of the new term. Fails if c does not apply anywhere. TOP_DEPTH_QCONV c repeatedly rewrites with c top-to-bottom; recursively do something like: do (rewrite current until no change) then rewrite children with TOP_DEPTH_QCONV until no change TOP_SWEEP_QCONV c rewrite with c top-to-bottom; something like: (rewrite current until no change) then rewrite children with TOP_SWEEP_QCONV ONCE_DEPTH_CONV, DEPTH_CONV, REDEPTH_CONV, TOP_DEPTH_CONV, TOP_SWEEP_CONV: like the QCONV variants, except they never fail SINGLE_DEPTH_CONV c rewrites maximal applicable subterms with c, then rewrites parents of changed terms bottom-up DEPTH_BINOP_CONV op c For example, DEPTH_BINOP_CONV `+` c rewrites x,y,z,w in `(x + ((y + z) + w))` (fails if any of these rewrites fail) PATH_CONV path c For example, PATH_CONV ["b";"l";"r";"r"] c rewrites the operand of the operand of the operator of the abstraction body with c. SYM_CONV rewrites `a = b` to `b = a` CONV_RULE c th uses c to rewrite the conclusion of the theorem (and return a new theorem). SUBS_CONV ths is a conversion. It takes its list of equality theorems and rewrites (anywhere in its argument term) any lhs to its corresponding rhs (matching with alpha-equivalence). BETA_RULE takes a theorem, does all possible beta reductions, and returns the new theorem. GSYM applies symmetry on all outermost equalities in the conclusion of a theorem. SUBS applies SUBS_CONV to the conclusion of a theorem. CACHE_CONV c is equivalent to c, except that it caches all conversion applications. bool: PINST tyin tmin th instantiates types in th according to tyin and terms according to tmin. PROVE_HYP th1 th2 If the conclusion of th1 is a hypothesis of th2, then returns th2 except that this hypothesis is replaced by the hypotheses of th1; otherwise returns th2 unchanged. T_DEF: `T = ((\x:bool. x) = (\x:bool. x))` TRUTH: `|- T` EQT_ELIM `ASM1 |- a = T` gives `ASM1 |- a` EQT_INTRO `ASM1 |- a` gives `ASM1 |- a = T` AND_DEF: `(/\) = \t1 t2. (\f:bool->bool->bool. f t1 t2) = (\f. f T T)` CONJ `ASM1 |- a` `ASM2 |- b` gives `ASM1+ASM2 |- a /\ b` CONJUNCT1 `ASM |- a /\ b` gives `ASM1 |- a` CONJUNCT2 `ASM |- a /\ b` gives `ASM1 |- b` CONJ_PAIR th = (CONJUNCT1 th, CONJUNCT2 th) CONJUNCTS th gives a list of theorems, one for each conjunct of the conclusion of th (no matter how they are associated) IMP_DEF: `(==>) = \t1 t2. t1 /\ t2 = t1` MP `ASM1 |- a ==> b` `ASM2 |- a` gives `ASM1+ASM2 |- b` DISCH `a` `ASM,a |- b` gives `ASM |- a ==> b` DISCH_ALL repeats DISCH until there are no more hypotheses. UNDISCH `ASM |- a ==> b` gives `ASM,a |- b` UNDISCH_ALL repeats UNDISCH until the conclusion is not an implication IMP_ANTISYM_RULE `ASM1 |- a ==> b` `ASM2 |- b ==> a` gives `ASM1+ASM2 |- a = b` ADD_ASSUM `a` `ASM |- b` gives `ASM,a |- b` EQ_IMP_RULE `ASM |- (a:bool) = b` gives (`ASM |- a ==> b`, `ASM |- b ==> a`) IMP_TRANS `ASM1 |- a ==> b` `ASM2 |- b ==> c` gives `ASM1+ASM2 |- a ==> c` FORALL_DEF: `(!) = \P:A->bool. P = \x. T` SPEC `a` `ASM |- !x.P[x]` gives `ASM |- P[a]` SPECL [`a`;`b`;`c`] `ASM |- !x y z.P[x,y,z]` gives `ASM |- P[a,b,c]` SPEC_VAR `ASM |- !x.P[x]` gives (`x17`, `ASM |- P[x17]`) SPEC_ALL repeats SPEC_VAR until the conclusion is not a "forall", and returns the final theorem. ISPEC is like SPEC, except that the specialized term may be an instance of the type of the quantified variable (in which case the theorem is type-instantiated first), rather than matching exactly. ISPECL is like SPECL with type instantiations. GEN `x` `ASM |- P[x]` gives `ASM |- !x. P[x]` (if x is not free in ASM) GENL [`x`;`y`;`z`] `ASM |- P[x,y,z]` gives `ASM |- !x y z. P[x,y,z]` GEN_ALL generalizes over all variables free in the conclusion but not in the assumptions EXISTS_DEF: `(?) = \P:A->bool. !Q. (!x. P x ==> Q) ==> Q` EXISTS (`?x. P[x]`,`a`) `ASM |- P[a]` gives `ASM |- ?x. P[x]` SIMPLE_EXISTS `x` `ASM |- P[x]` gives `ASM |- ?x. P[x]` CHOOSE (`x`,`ASM1 |- ?y.P[y]`) `ASM2,P[x] |- a` gives `ASM1+ASM2 |- a` SIMPLE_CHOOSE `x` `ASM,P[x] |- a` gives `ASM,?x.P[x] |- a` (P[x] must be the first hypothesis) OR_DEF: `(\/) = \t1 t2. !t. (t1 ==> t) ==> (t2 ==> t) ==> t` DISJ1 `ASM |- a` `b` gives `ASM |- a \/ b` DISJ2 `a` `ASM |- b` gives `ASM |- a \/ b` DISJ_CASES `ASM1 |- a \/ b` `ASM2,a |- c` `ASM3,b |- c` gives `ASM1,ASM2,ASM3 |- c` SIMPLE_DISJ_CASES `ASM1,a |- c` `ASM2,b |- c` gives `ASM1,ASM2,a \/ b |- c` (a and b must be the first hypotheses) F_DEF: `F = !t:bool. t` NOT_DEF: `(~) = \t. t ==> F` NOT_ELIM `ASM |- ~a` gives `ASM |- a ==> F` NOT_INTRO `ASM |- a ==> F` gives `ASM |- ~a` EQF_INTRO `ASM |- ~a` gives `ASM |- a = F` EQF_ELIM `ASM |- a = F` gives `ASM |- ~a` NEG_DISCH `a` `ASM,a |- F` gives `ASM |- ~a` (if the conclusion of the initial theorem is not F, then NEG_DISCH acts like DISCH) CONTR `a` `ASM |- F` gives `ASM |- a` EXISTS_UNIQUE_DEF: `(?!) = \P:A->bool. ((?) P) /\ (!x y. ((P x) /\ (P y)) ==> (x = y))` EXISTENCE `ASM |- ?!x. P[x]` gives `ASM |- ?x. P[x]` drule: MK_CONJ `ASM1 |- a = b` `ASM2 |- c = d` gives `ASM1,ASM2 |- a /\ c = b /\ d` MK_DISJ `ASM1 |- a = b` `ASM2 |- c = d` gives `ASM1,ASM2 |- a \/ c = b \/ d` MK_FORALL `x` `ASM |- a = b` gives `ASM |- (!x.a) = (!x.b)` MK_EXISTS `x` `ASM |- a = b` gives `ASM |- (?x.a) = (?x.b)` BETAS_CONV (n:int) is a conversion which rewrites with BETA_CONV n times. (so BETAS_CONV 3 rewrites `(\x y z.P[x,y,z]) a b c` to `P[a,b,c]`) INSTANTIATE takes an "instantiation" and a theorem and instantiates the theorem. (I haven't figured out yet what an "instantiation" is.) INSTANTIATE_ALL has the same type as INSTANTIATE. For the rest of the file, I will treat '@' as a metavariable for an instantiation (written postfix). For instance, I may mention the terms `a ==> b`, `a@`, and `b@`; this means that `a@ ==> b@` is an instantiation of `a ==> b`. In some cases where I use this notation, universal quantification is allowed; that is, where I mention terms `a` and `a@`, the implementation would allow `!x. P[x]` and `P[b]`. PART_MATCH partfn th tm matches (partfn (concl (SPEC_ALL th))) against tm and instantiates the theorem appropriately. MATCH_MP ith th is like MP, except it uses matching instead of requiring an exact match. HIGHER_REWRITE_CONV ths top A conversion which finds the first largest (if top == true) or smallest (if top == false) subterm which matches (using higher-order matching) a lhs of a conclusion in ths, and rewrites it. tactics: t1 THEN t2 Apply t1, then apply t2 to all subgoals created. t THENL [t1;t2;...;tn] Apply t, then apply t1 to the first subgoal, ..., tn to the last subgoal (there must be exactly n subgoals). t1 ORELSE t2 Apply t1; if it fails, apply T2. FAIL_TAC s A tactic which always fails (with error message s). NO_TAC A tactic which always fails. ALL_TAC A tactic which does nothing (the identity tactic). TRY t = tac ORELSE ALL_TAC REPEAT t Apply t, then apply it again to all subgoals, etc.; until it fails. EVERY [t1;...;tn] = t1 THEN ... THEN tn FIRST [t1;...;tn] = t1 ORELSE ... ORELSE tn MAP_EVERY tf [x1;...;xn] = tf x1 THEN ... THEN tf xn MAP_FIRST tf [x1;...;xn] = tf x1 ORELSE ... ORELSE tf xn CHANGED_TAC t Apply t; fail if the result is a single subgoal which is equal to the original goal (warning: does not use alpha-equivalence!) A "theorem tactic" is a function from theorems to tactics. A "theorem tactical" is a function from theorem tactics to theorem tactics. Equivalently: a theorem tactical is a function from theorem tactics and theorems to tactics. In other words, a theorem tactic takes a theorem and does something to the current goal using that theorem. A theorem tactical takes a theorem tactic and a theorem and does something to the current goal. Typically, it will preprocess the theorem somehow before handing the result to the theorem tactic. (In fact, the tactical may apply the theorem tactic multiple times, sequentially or in parallel (in different subgoals).) The functions in this section manipulate theorem tacticals. I will write out pseudo-definitions of these functions that pretend that a theorem tactical is a function from theorems to theorems which happens to side-effect the goal; remember that the actual type is very different than this. (thtc1 THEN_TCL thtc2) tht th = tht (thtc1 (thtc2 th)) (thtc1 ORELSE_TCL thtc2) tht th = (tht (thtc1 th)) ORELSE (tht (thtc2 th)) ALL_THEN = I (all_then is the theorem tactical which does nothing to the theorem before handing it to the theorem tactic) NO_THEN theorem tactical which always fails REPEAT_TCL thtc = (thtc THEN_TCL (REPEAT_TCL thtc)) ORELSE_TCL ALL_THEN REPEAT_GTCL ??? I don't understand why REPEAT_GTCL is different than REPEAT_TCL. Fortunately, REPEAT_GTCL is never used, so it can't be very important :-) EVERY_TCL [thtc1;...;thtcn] = thtc1 THEN_TCL ... THEN_TCL thtcn FIRST_TCL [thtc1;...;thtcn] = thtc1 ORELSE_TCL ... ORELSE_TCL thtcn LABEL_TAC s th Adds th as a new assumption, with label s. (Assumes that any hypotheses of th are also hypotheses of the goal.) ASSUME_TAC = LABEL_TAC "" USE_ASSUM s tht Find the first assumption with label s (call this assumption th). Applies tactic (tht th). FIND_ASSUM tht tm Find the first assumption whose conclusion is equal (not alpha-equivalent!) to tm (call this assumption th). Applies tactic (tht th). POP_ASSUM tht Call the first (most recently added) assumption th. Removes th from assumption list, and applies tactic (tht th). ASSUM_LIST thlt Applies tactic (thlt thl), where thl is the list of assumptions. POP_ASSUM_LIST thlt Applies tactic (thlt thl) after removing all assumptions, where thl is the list of assumptions. EVERY_ASSUM tht = ASSUM_LIST (MAP_EVERY tht) (* This is not the actual definition; I think it is equivalent. *) FIRST_ASSUM tht = ASSUM_LIST (MAP_FIRST tht) RULE_ASSUM_TAC thth Replaces every assumption with thth applied to that assumption. ASM thlt thl Applies tactic (thlt (asm @ thl)), where asm is the list of assumptions. ACCEPT_TAC th A tactic which solves the current goal, assuming the conclusion of th is alpha-equivalent to the goal. CONV_TAC c Create tactic from a conversion. This allows the conversion to return |- p rather than |- p = T on a term "p". It also eliminates any goals of the form "T" automatically. REFL_TAC Accepts if the current goal is of the form `a = a`. ABS_TAC Converts goal `(\x. a) = (\x. b)` to `a = b`. MK_COMB_TAC Converts goal `f a = g b` to `f = g` and `a = b`. AP_TERM_TAC Converts goal `f a = f b` to `a = b`. AP_THM_TAC Converts goal `f a = g a` to `f = g`. BINOP_TAC Converts goal `f a b = f c d` to `a = c` and `b = d`. SUBST1_TAC `|- a = b` Converts goal `P[a]` to `P[b]` SUBST_ALL_TAC `|- a = b` Rewrites `a` to `b` in goal and all assumptions. BETA_TAC Does all possible beta-reductions in goal. DISCH_TAC Converts goal `a ==> b` to `b` and adds `a` as a new assumption. (Treats goal `~a` as `a ==> F`.) MP_TAC `|- a` Converts goal `b` to `a ==> b`. EQ_TAC Converts goal `(a:bool) = b` to `a ==> b` and `b ==> a`. UNDISCH_TAC `a` Finds an assumption with a conclusion alpha-equivalent to `a`. Removes this assumption, and converts goal `b` to `a ==> b`. SPEC_TAC (`x`,`a`) Converts goal `P[a]` to `!x. P[x]` X_GEN_TAC `x` Converts goal `!y. P[y]` to `P[x]` GEN_TAC Converts goal `!x. P[x]` to `P[x]` EXISTS_TAC `a` Converts goal `?x. P[x]` to `P[a]` X_CHOOSE_TAC `x` `|- ?y. P[y]` Adds a new assumption `P[x]` CHOOSE_TAC `|- ?x. P[x]` Adds a new assumption `P[x]` CONJ_TAC Converts goal `a /\ b` to `a` and `b` DISJ1_TAC Converts goal `a \/ b` to `a` DISJ2_TAC Converts goal `a \/ b` to `b` DISJ_CASES_TAC `|- a \/ b` Creates two subgoals. Adds assumption `a` in one subgoal, `b` in the other. CONTR_TAC `|- F` Accepts the goal. MATCH_ACCEPT_TAC `|- a` First applies (REPEAT GEN_TAC), then accepts if the conclusion is an instance of `a` MATCH_MP_TAC `|- a ==> b` Converts a goal `b@` into `a@`. CONJUNCTS_THEN2 tht1 tht2 `|- a /\ b` Applies tactic (tht1 `|- a`) THEN (tht2 `|- b`) CONJUNCTS_THEN tht `|- a /\ b` Applies tactic (tht `|- a`) THEN (tht `|- b`) DISJ_CASES_THEN2 tht1 tht2 `|- a \/ b` Generates two subgoals. Applies (tht1 `|- a`) in one subgoal, (tht2 `|- b`) in the other. DISJ_CASES_THEN tht `|- a \/ b` Generates two subgoals. Applies (tht `|- a`) in one subgoal, (tht `|- b`) in the other. DISCH_THEN tht Converts goal `a ==> b` to `b`, then applies tactic (tht `|- a`). (Treats `~a` as `a ==> F`) X_CHOOSE_THEN `x` tht `|- ?y. P[y]` Applies tactic (tht `|- P[x]`) CHOOSE_THEN tht `|- ?x. P[x]` Applies tactic (tht `|- P[x]`) STRIP_THM_THEN = FIRST_TCL [CONJUNCTS_THEN; DISJ_CASES_THEN; CHOOSE_THEN] (That is, it acts like CONJUNCTS_THEN, DISJ_CASES_THEN, or CHOOSE_THEN, depending on whether the theorem is a conjunction, disjunction, or exists.) ANTE_RES_THEN tht `|- a@` For every assumption `|- a ==> b`, applies tactic (tht `|- b@`) IMP_RES_THEN tht `|- a ==> b` For every assumption `|- a@`, applies tactic (tht `|- b@`) STRIP_ASSUME_TAC th Starts with (REPEAT_TCL STRIP_THM_THEN) applied to th. Call the resulting theorem(s) gth. If gth is `F`, or equal to the goal, then solve the goal; if gth is already an assumption, do nothing; otherwise, add gth as an assumption. STRUCT_CASES_TAC th Starts with (REPEAT_TCL STRIP_THM_THEN) applied to th. Call the resulting theorem(s) gth. If gth is an equality, then use it to rewrite the goal; otherwise, add gth as an assumption. STRIP_GOAL_THEN tht = FIRST [GEN_TAC; CONJ_TAC; DISCH_THEN tht] (If the current goal is a forall, then generalize; if it is a conjunction, prove the two cases separately; if it is an implication `a ==> b` then convert to `b` and apply (tht `a`).) STRIP_TAC = STRIP_GOAL_THEN STRIP_ASSUME_TAC ABBREV_TAC `x = a` Rewrites `a` to `x` in the goal and all assumptions, then adds `a = x` as a new assumption. EXPAND_TAC `x` Finds the first assumption of the form `a = x`, rewrites `x` to `a` in the goal, and beta-reduces the goal. UNDISCH_THEN `a` tht Finds an assumption `|- a`, removes the assumption, and applies the tactic (tht `|- a`) FIRST_X_ASSUM tht Like FIRST_ASSUM, but removes the assumption successfully used by the tactic. SUBGOAL_THEN `a` tht Creates two subgoals. In the first, changes the goal to `a`. In the second, applies tactic (tht `|- a`). FREEZE_THEN tht `|- a` Applies tactic (tht `|- a`) (while "freezing variables"? Does this have something to do with metavariables? I don't understand this...) (???) X_META_EXISTS_TAC `x` Converts goal `?y. P[y]` to `P[x]`, where `x` is a metavariable. META_EXISTS_TAC Converts goal `?x. P[x]` to `P[x]`, where `x` is a metavariable. META_SPEC_TAC `x` `!y. P[y]` adds a new assumption `P[x]`, where `x` is a metavariable. CHEAT_TAC Introduce the goal as a new axiom, then solve the goal. RECALL_ACCEPT_TAC f x = ACCEPT_TAC (f x) As a side-effect, prints out the time taken to compute (f x); delays this computation until it is required. ANTS_TAC Converts goal `(p ==> q) ==> r` to `p` and `q ==> r` itab: ITAUT_TAC Intuitionistic theorem prover: understands and,forall,implies,not,iff (boolean equality),or,exists,T,F; applies a long list of rules dealing with the above types of terms until it runs out of rules to apply or proves the theorem. Either succeeds or leaves the goal state unchanged. ITAUT `a` gives `|-a` if ITAUT can prove it. CONTRAPOS `|- a ==> b` gives `|- ~b ==> ~a` simp: REWR_CONV `|- a = b` A conversion which rewrites `a@` to `b@` A conditional rewrite is a conversion which produces a theorem of the form `|- P ==> (a = b)`. This rewrites `a` to `b` under the condition `P`. Previous conversionals cannot deal with conditional rewrites. IMP_REWR_CONV `|- P ==> (a = b)` A conversion which rewrites `a@` to `b@` under the condition `P@`. ORDERED_REWR_CONV ord `|- a = b` A conversion which rewrites `a@` to `b@` if (ord `a@` `b@`) (otherwise it fails) ORDERED_IMP_REWR_CONV ord `|- P ==> (a = b)` A conversion which rewrites `a@` to `b@` under the condition `P@` if (ord `a@` `b@`) term_order An ordering function which is AC-compatible for any binary operator. net_of_thm rep `|- P ==> (a = b)` (or `|- a = b`) net Adds a component to net which matches a term and returns a conversion rewriting that term. If rep is true and `a` appears in `b`, then it rewrites `(a = b)` to `T`. If rep is true and the rewrite is permutative, then it uses an ordered rewrite to rewrite `a` to `b`. If neither of the above is true, then it uses an ordinary rewrite. Conditional rewrites are entered as level 3; unconditional as level 1. net_of_conv tm conv net Adds a component to net which matches tm and returns conv. Entered as level 2. net_of_cong th net Adds a component to net for a congruence rule. (This is a rule of the form `P1 ==> (P2 ==> (...(Pn ==> (a = b))))` ). Entered at level 4. mk_rewrites cf th rew_list Prepends rewrites for th to new_list I will describe the action in terms of a notional add_rew function. (add_rew l `|- !x. P[x]`) --> (add_rew l `|- P[x]`) (add_rew l `|- P1 /\ P2`) --> (add_rew l `|- P1`), (add_rew l `|- P2`) if cf, then (add_rew l `|- P1 ==> P2`) --> (add_rew (`P1`::l) `|- P2`) (add_rew l `|- a = b`) adds a conditional rewrite with conditions l (if l is empty, this is an unconditional rewrite; if cf is false, then l is always empty) (add_rew l `|- ~(a = b)`) --> (add_rew l `|- (a = b) = F`), (add_rew l `|- (b = a) = F`) (add_rew l `|- ~a`) --> (add_rew l `|- a = F`) If none of the above hold, (add_rew l `|- a`) --> (add_rew l `|- a = T`) REWRITES_CONV net `a` Looks up `a` in the net, and applies the resulting conversion to `a`. There's a lot of generality in the simpset data structure which is not used; I'm not going to try to understand the general-purpose operation, but only the portions of it which are actually used in HOL Light. Of the four fields in the simpset data structure, only the first ever changes: the second is always basic_prover, the third is always the empty list, and the fourth is always (mk_rewrites true). The first field is a conversion net. basic_prover strat ss lev `a` Tries to prove `|- a`. Succeeds if `a` = `T`, or if (strat ss lev `a`) proves `|- a = T`. (* None of the following are ever called. ss_of_thms thms ss Augments a simpset with a list of theorems (using the rewrite maker from the simpset to add the theorems to the conversion net). ss_of_conv keytm conv ss Augments a simpset with a conversion (using (net_of_conv keytm conv) to add the conversion to the conversion net). ss_of_prover newprover ss Replaces the prover in the simpset with newprover. ss_of_provers newprovers ss Prepends newprovers to the list of subprovers in the simpset. ss_of_maker newmaker ss Replaces the rewrite maker in the simpset with newmaker. *) AUGMENT_SIMPSET th ss Uses the rewrite maker from the simpset (always (mk_rewrites true)) to create a list of rewrite theorems from th; use (net_of_thm true) to add these theorems to the conversion net in the simpset. Note: IMP_REWRITES_CONV and GEN_SUB_CONV have a different signature than what I am documenting; if you ever want to call them directly, look at the source. I will first describe the meaning of these functions; then I will describe their implementation. (IMP_REWRITES_CONV strat ss lev) is a conversion which looks up the term in the ss conversion net. It tries unconditional rewrites before conditional rewrites. It will only accept a conditional rewrite if (strat ss (lev-1)) can rewrite the condition to `T`. (GEN_SUB_CONV strat ss lev) rewrites combinations and abstractions in a depth-first manner by calling (strat ss lev) on subterms. It has special handling for if-then-else and implications; it adds the condition to the simpset before simplifying the rest of the expression. Both of these functions fail if they perform no rewrites. IMP_REWRITES_CONV strat ss lev Try to find a conversion for tm at level < 4 (i.e., not a congruence rule) which is either unconditional or (if lev > 0) such that the condition can be rewritten to `T` by (strat ss (lev-1)). RUN_SUB_CONV -- called only by GEN_SUB_CONV; not documented. GEN_SUB_CONV strat ss lev Try to find a congruence rule for tm (i.e., a rule at level 4). The conclusion of a congruence rule is of the form `A[x1,...,xn] = A[x1',...,xn']`, so tm must be of the form `A[a1,...,an]`. Each hypothesis of a congruence rule is either of the form `xi = xi'` or `P[x1',...,x(i-1)'] ==> (xi = xi')`. In the former case, use (strat ss lev) to rewrite `a1` to `a1'`; in the latter case, use AUGMENT_SIMPSET to add `P[a1',...,a(i-1)']` to ss (getting ss') and use (strat ss' lev) for the rewrite. Combine all of these rewrites to rewrite `A[a1,...,an]` to `A[a1',...,an']`. If this fails, then if tm is `f a`, then use (strat ss lev) to rewrite `f` to `g` and `a` to `b` and return `|- f a = g b`. If tm is `\x. a[x]`, then use (strat ss lev) to rewrite `a[x]` to `b[x]` and return `|- (\x. a[x]) = (\x. b[x])`. Throughout GEN_SUB_CONV (in both the congruence rule case, and the combination case), if the call to strat fails to rewrite `a`, then it rewrites `a` to `a`; but if all the calls to strat fail (so that GEN_SUB_CONV would rewrite tm to tm), GEN_SUB_CONV fails instead. Note that there are only two congruence rules used in HOL Light: one for rewriting `if g then t else e` and one for rewriting `p ==> q`. ONCE_DEPTH_SQCONV ss lev = (IMP_REWRITES_CONV ONCE_DEPTH_SQCONV ss lev) ORELSEC (GEN_SUB_CONV ONCE_DEPTH_SQCONF ss lev) DEPTH_SQCONV ss lev = THENQC (GEN_SUB_CONV DEPTH_SQCONV ss lev) (IMP_REWRITES_CONV DEPTH_SQCONV ss lev) REDEPTH_SQCONV ss lev = REPEATQC (DEPTH_CONV ss lev) TOP_DEPTH_SQCONV ss lev = REPEATQC ((IMP_REWRITES_CONV TOP_DEPTH_SQCONV ss lev) ORELSEC (GEN_SUB_CONV TOP_DEPTH_SQCONV ss lev)) TOP_SWEEP_SQCONV ss lev = THENQC (REPEATC (IMP_REWRITES_CONV TOP_SWEEP_SQCONV ss lev)) (GEN_SUB_CONV TOP_SWEEP_SQCONV ss lev) Basic rewrites: There is a global set of "basic rewrites". These are canonicalized with (mk_rewrites false) (so there is no handling of conditional rewrites), and added to a basic conversion net. set_basic_rewrites thl: sets the "basic rewrite" set to thl extend_basic_rewrites thl: adds thl to the "basic rewrite" set basic_rewrites (): retrieves the (canonicalized) "basic rewrite" set basic_net (): retrieves the conversion net for the "basic rewrite" set There is also a set of basic congruences; since HOL has only two congruence rules, I won't bother documenting set_basic_congs, extend_basic_congs, basic_congs. GENERAL_REWRITE_CONV rep cnvl net thl Canonicalizes thl with (mk_rewrites false), adds these conversions to net with (net_of_thm rep) (giving final_net), and then rewrites with (cnvl (REWRITES_CONV final_net)). GEN_REWRITE_CONV cnvl thl = GENERAL_REWRITE_CONV false cnvl empty_net thl PURE_REWRITE_CONV thl = GENERAL_REWRITE_CONV true TOP_DEPTH_CONV empty_net thl REWRITE_CONV thl = GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net()) thl PURE_ONCE_REWRITE_CONV thl = GENERAL_REWRITE_CONV false ONCE_DEPTH_CONV empty_net thl ONCE_REWRITE_CONV thl = GENERAL_REWRITE_CONV false ONCE_DEPTH_CONV (basic_net()) thl LIMITED_REWRITE_CONV n thl Rewrite n times with (GEN_REWRITE_CONV ONCE_DEPTH_CONV ths THENC GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net()) []) GEN_REWRITE_RULE cnvl thl = CONV_RULE(GEN_REWRITE_CONV cnvl thl) PURE_REWRITE_RULE thl = CONV_RULE(PURE_REWRITE_CONV thl) REWRITE_RULE thl = CONV_RULE(REWRITE_CONV thl) PURE_ONCE_REWRITE_RULE thl = CONV_RULE(PURE_ONCE_REWRITE_CONV thl) ONCE_REWRITE_RULE thl = CONV_RULE(ONCE_REWRITE_CONV thl) PURE_ASM_REWRITE_RULE, ASM_REWRITE_RULE, PURE_ONCE_ASM_REWRITE_RULE, ONCE_ASM_REWRITE_RULE As non-"ASM_", but adds theorem hypotheses to the rewrite list. GEN_REWRITE_TAC, PURE_REWRITE_TAC, REWRITE_TAC, PURE_ONCE_REWRITE_TAC, ONCE_REWRITE_TAC As "_RULE", but use CONV_TAC instead of CONV_RULE. PURE_ASM_REWRITE_TAC, ASM_REWRITE_TAC, PURE_ONCE_ASM_REWRITE_TAC, ONCE_ASM_REWRITE_TAC As non-"ASM_", but adds current assumptions to the rewrite list. GEN_SIMPLIFY_CONV strat ss lev thl Use AUGMENT_SIMPSET to add thl to ss (giving ss'); then do TRY_CONV (strat ss' lev) ONCE_SIMPLIFY_CONV ss = GEN_SIMPLIFY_CONV ONCE_DEPTH_SQCONV ss 1 SIMPLIFY_CONV ss = GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV ss 3 empty_ss: an empty simpset (no conversions in the conversion net) basic_ss thl Canonicalizes thl with (mk_rewrites true), then adds the rewrites to (basic_net()) with (net_of_thm true). Also adds the basic congruences. Returns the resulting simpset. SIMP_CONV = SIMPLIFY_CONV (basic_ss []) PURE_SIMP_CONV = SIMPLIFY_CONV empty_ss ONCE_SIMP_CONV = ONCE_SIMPLIFY_CONV (basic_ss []) thl SIMP_RULE, PURE_SIMP_RULE, ONCE_SIMP_RULE As "_CONV", but calls CONV_RULE SIMP_TAC, PURE_SIMP_TAC, ONCE_SIMP_TAC As "_CONV", but calls CONV_TAC ASM_SIMP_TAC, PURE_ASM_SIMP_TAC, ONCE_ASM_SIMP_TAC As non-"ASM_", but adds current assumptions to the rewrite list theorems: val ( EQ_REFL ) : thm = |- !x. x = x val ( EQ_REFL_T ) : thm = |- !x. (x = x) = T val ( EQ_SYM ) : thm = |- !x y. (x = y) ==> (y = x) val ( EQ_SYM_EQ ) : thm = |- !x y. (x = y) = y = x val ( EQ_TRANS ) : thm = |- !x y z. (x = y) /\ (y = z) ==> (x = z) val ( REFL_CLAUSE ) : thm = |- !x. (x = x) = T AC thl `a = b` Returns `|- a = b` or fails; succeeds if ordered rewriting using thl can rewrite `a = b` to `T` or `c = c` val ( BETA_THM ) : thm = |- !f y. (\x. f x) y = f y val ( ABS_SIMP ) : thm = |- !t1 t2. (\x. t1) t2 = t1 val ( CONJ_ASSOC ) : thm = |- !t1 t2 t3. t1 /\ t2 /\ t3 = (t1 /\ t2) /\ t3 val ( CONJ_SYM ) : thm = |- !t1 t2. t1 /\ t2 = t2 /\ t1 val ( CONJ_ACI ) : thm = |- (p /\ q = q /\ p) /\ ((p /\ q) /\ r = p /\ q /\ r) /\ (p /\ q /\ r = q /\ p /\ r) /\ (p /\ p = p) /\ (p /\ p /\ q = p /\ q) val ( DISJ_ASSOC ) : thm = |- !t1 t2 t3. t1 \/ t2 \/ t3 = (t1 \/ t2) \/ t3 val ( DISJ_SYM ) : thm = |- !t1 t2. t1 \/ t2 = t2 \/ t1 val ( DISJ_ACI ) : thm = |- (p \/ q = q \/ p) /\ ((p \/ q) \/ r = p \/ q \/ r) /\ (p \/ q \/ r = q \/ p \/ r) /\ (p \/ p = p) /\ (p \/ p \/ q = p \/ q) val ( FORALL_SIMP ) : thm = |- !t. (!x. t) = t val ( EXISTS_SIMP ) : thm = |- !t. (?x. t) = t val ( EQ_CLAUSES ) : thm = |- !t. ((T = t) = t) /\ ((t = T) = t) /\ ((F = t) = ~t) /\ ((t = F) = ~t) val ( NOT_CLAUSES_WEAK ) : thm = |- (~T = F) /\ (~F = T) val ( AND_CLAUSES ) : thm = |- !t. (T /\ t = t) /\ (t /\ T = t) /\ (F /\ t = F) /\ (t /\ F = F) /\ (t /\ t = t) val ( OR_CLAUSES ) : thm = |- !t. (T \/ t = T) /\ (t \/ T = T) /\ (F \/ t = t) /\ (t \/ F = t) /\ (t \/ t = t) val ( IMP_CLAUSES ) : thm = |- !t. (T ==> t = t) /\ (t ==> T = T) /\ (F ==> t = T) /\ (t ==> t = T) /\ (t ==> F = ~t) REFL_CLAUSE, EQ_CLAUSES, NOT_CLAUSES_WEAK, AND_CLAUSES, OR_CLAUSES, IMP_CLAUSES, FORALL_SIMP, EXISTS_SIMP, BETA_THM, and `((x = x) ==> p) = p` are all "basic rewrites". val ( EXISTS_UNIQUE_THM ) : thm = |- !P. (?!x. P x) = (?x. P x) /\ (!x x'. P x /\ P x' ==> (x = x')) val ( EXISTS_REFL ) : thm = |- !a. ?x. x = a val ( EXISTS_UNIQUE_REFL ) : thm = |- !a. ?!x. x = a val ( EXISTS_UNIQUE_ALT ) : thm = |- !P. (?!x. P x) = (?x. !y. P y = x = y) val ( UNWIND_THM1 ) : thm = |- !P a. (?x. (a = x) /\ P x) = P a val ( UNWIND_THM2 ) : thm = |- !P a. (?x. (x = a) /\ P x) = P a val ( SWAP_FORALL_THM ) : thm = |- !P. (!x y. P x y) = (!y x. P x y) val ( SWAP_EXISTS_THM ) : thm = |- !P. (?x y. P x y) = (?y x. P x y) val ( FORALL_AND_THM ) : thm = |- !P Q. (!x. P x /\ Q x) = (!x. P x) /\ (!x. Q x) val ( AND_FORALL_THM ) : thm = |- !P Q. (!x. P x) /\ (!x. Q x) = (!x. P x /\ Q x) val ( LEFT_AND_FORALL_THM ) : thm = |- !P Q. (!x. P x) /\ Q = (!x. P x /\ Q) val ( RIGHT_AND_FORALL_THM ) : thm = |- !P Q. P /\ (!x. Q x) = (!x. P /\ Q x) val ( EXISTS_OR_THM ) : thm = |- !P Q. (?x. P x \/ Q x) = (?x. P x) \/ (?x. Q x) val ( OR_EXISTS_THM ) : thm = |- !P Q. (?x. P x) \/ (?x. Q x) = (?x. P x \/ Q x) val ( LEFT_OR_EXISTS_THM ) : thm = |- !P Q. (?x. P x) \/ Q = (?x. P x \/ Q) val ( RIGHT_OR_EXISTS_THM ) : thm = |- !P Q. P \/ (?x. Q x) = (?x. P \/ Q x) val ( LEFT_EXISTS_AND_THM ) : thm = |- !P Q. (?x. P x /\ Q) = (?x. P x) /\ Q val ( RIGHT_EXISTS_AND_THM ) : thm = |- !P Q. (?x. P /\ Q x) = P /\ (?x. Q x) val ( TRIV_EXISTS_AND_THM ) : thm = |- !P Q. (?x. P /\ Q) = (?x. P) /\ (?x. Q) val ( LEFT_AND_EXISTS_THM ) : thm = |- !P Q. (?x. P x) /\ Q = (?x. P x /\ Q) val ( RIGHT_AND_EXISTS_THM ) : thm = |- !P Q. P /\ (?x. Q x) = (?x. P /\ Q x) val ( TRIV_AND_EXISTS_THM ) : thm = |- !P Q. (?x. P) /\ (?x. Q) = (?x. P /\ Q) val ( TRIV_FORALL_OR_THM ) : thm = |- !P Q. (!x. P \/ Q) = (!x. P) \/ (!x. Q) val ( TRIV_OR_FORALL_THM ) : thm = |- !P Q. (!x. P) \/ (!x. Q) = (!x. P \/ Q) val ( RIGHT_IMP_FORALL_THM ) : thm = |- !P Q. P ==> (!x. Q x) = (!x. P ==> Q x) val ( RIGHT_FORALL_IMP_THM ) : thm = |- !P Q. (!x. P ==> Q x) = P ==> (!x. Q x) val ( LEFT_IMP_EXISTS_THM ) : thm = |- !P Q. (?x. P x) ==> Q = (!x. P x ==> Q) val ( LEFT_FORALL_IMP_THM ) : thm = |- !P Q. (!x. P x ==> Q) = (?x. P x) ==> Q val ( TRIV_FORALL_IMP_THM ) : thm = |- !P Q. (!x. P ==> Q) = (?x. P) ==> (!x. Q) val ( TRIV_EXISTS_IMP_THM ) : thm = |- !P Q. (?x. P ==> Q) = (!x. P) ==> (?x. Q) ind-defs: RIGHT_BETAS [`x`;`y`] `|- f = \x y. A[x,y]` gives `|- f x y = A[x,y]` HALF_BETA_EXPAND [`x`;`y`] `|- f = \x y. A[x,y]` gives `|- !x y. f x y = A[x,y]` SIMPLE_DISJ_PAIR `P \/ Q |- R` gives (`P |- R`, `Q |- R`) FORALL_IMPS_CONV Rewrites `!x y. P[x,y] ==> Q` to `(?x y. P[x,y]) ==> Q` AND_IMPS_CONV Rewrites: (* (!x1..xn. P1[xs] ==> Q[xs]) /\ ... /\ (!x1..xn. Pm[xs] ==> Q[xs]) *) (* -> (!x1..xn. P1[xs] \/ ... \/ Pm[xs] ==> Q[xs]) *) EXISTS_EQUATION `x = a` `ASM,x = a |- P[x]` gives `ASM |- ?x. P[x]` val ( MONO_AND ) : thm = |- (A ==> B) /\ (C ==> D) ==> A /\ C ==> B /\ D val ( MONO_OR ) : thm = |- (A ==> B) /\ (C ==> D) ==> A \/ C ==> B \/ D val ( MONO_IMP ) : thm = |- (B ==> A) /\ (C ==> D) ==> (A ==> C) ==> B ==> D val ( MONO_NOT ) : thm = |- (B ==> A) ==> ~A ==> ~B val ( MONO_FORALL ) : thm = |- (!x. P x ==> Q x) ==> (!x. P x) ==> (!x. Q x) val ( MONO_EXISTS ) : thm = |- (!x. P x ==> Q x) ==> (?x. P x) ==> (?x. Q x) BACKCHAIN_TAC: "Simplified version of MATCH_MP_TAC to avoid quantifier troubles." MONO_ABS_TAC: (* ?- (\x. P[x]) x1 .. xn ==> (\y. Q[y]) x1 .. xn *) (* ================================================== *) (* ?- !x1. P[x1] x2 .. xn ==> Q[x1] x2 .. xn *) mono_tactics: A global variable holding a set of tactics for proving monotonicity. APPLY_MONOTAC Prove `a ==> a` automatically; otherwise, select a tactic from mono_tactics and apply it. MONO_STEP_TAC = REPEAT GEN_TAC THEN APPLY_MONOTAC MONO_TAC = REPEAT MONO_STEP_TAC THEN ASM_REWRITE_TAC[] class: This is an axiom: val ( ETA_AX ) : thm = |- !t. (\x. t x) = t ETA_CONV Rewrites `(\x. f x)` to `f` val ( EQ_EXT ) : thm = |- !f g. (!x. f x = g x) ==> (f = g) val ( FUN_EQ_THM ) : thm = |- !f g. (f = g) = (!x. f x = g x) EXT `|- (!x. f x = g x)` gives `|- f = x` This is an axiom: val ( SELECT_AX ) : thm = |- !P x. P x ==> P ((@) P) val ( EXISTS_THM ) : thm = |- (?) = (\P. P ((@) P)) SELECT_INTRO `|- P a` gives `|- P ((@) P)` SELECT_RULE `|- ?x. P[x]` gives `|- P[ @x. P[x] ]` SELECT_ELIM `|- P ((@) P)` (`x`, `P x |- a`) gives `|- a` SELECT_CONV rewrites `P[ @x. P[x] ]` to `?x. P[x]` val ( SELECT_REFL ) : thm = |- !x. (@y. y = x) = x val ( SELECT_UNIQUE ) : thm = |- !P x. (!y. P y = y = x) ==> ((@) P = x) SELECT_REFL is a "basic rewrite". new_specification ["foo";"bar";"baz"] `?x y z.P[x,y,z]` Defines "foo", "bar", and "baz" as new constants, and returns a theorem `|- P[foo,bar,baz]` simple_new_specification th Like new_specification, but gets the new constant names from the bound variable names in the theorem. new_type_definition "newtype" ("newtypeABS","newtypeREP") `|- ?x. P[x]` Creates a new type "newtype", which is isomorphic to a subset of the type of the bound variable `x` ("oldtype"). Creates new constants "newtypeABS", which maps from oldtype to newtype, and "newtypeREP", which maps from newtype to oldtype. Returns a theorem `|- (!(a:newtype). newtypeABS (newtypeREP a) = a) /\ (!(r:oldtype). P[r] = (newtypeREP (newtypeABS r) = r))` val ( EXCLUDED_MIDDLE ) : thm = |- !t. t \/ ~t val ( BOOL_CASES_AX ) : thm = |- !t. (t = T) \/ (t = F) BOOL_CASES_TAC `a` Creates two subgoals. In the first, rewrite `a` to `T` within the goal; in the second, rewrite `a` to `F`. ASM_CASES_TAC `a` Creates two subgoals. In the first, add `a` as an assumption; in the second, add `~a` as an assumption. TAUT tm Tries to prove the term. Starts with (REPEAT GEN_TAC), then rewrites with the basic rewrites and does case splits on free boolean variables using BOOL_CASES_TAC. val ( DE_MORGAN_THM ) : thm = |- !t1 t2. (~(t1 /\ t2) = ~t1 \/ ~t2) /\ (~(t1 \/ t2) = ~t1 /\ ~t2) val ( NOT_CLAUSES ) : thm = |- (!t. ~~t = t) /\ (~T = F) /\ (~F = T) val ( NOT_IMP ) : thm = |- !t1 t2. ~(t1 ==> t2) = t1 /\ ~t2 val ( CONTRAPOS_THM ) : thm = |- !t1 t2. ~t1 ==> ~t2 = t2 ==> t1 NOT_CLAUSES is a "basic rewrite". CCONTR `a` `~a |- F` gives `|- a` CONTRAPOS_CONV rewrites `a ==> b` to `~b ==> ~a` val ( NOT_EXISTS_THM ) : thm = |- !P. ~(?x. P x) = (!x. ~P x) val ( EXISTS_NOT_THM ) : thm = |- !P. (?x. ~P x) = ~(!x. P x) val ( NOT_FORALL_THM ) : thm = |- !P. ~(!x. P x) = (?x. ~P x) val ( FORALL_NOT_THM ) : thm = |- !P. (!x. ~P x) = ~(?x. P x) val ( LEFT_FORALL_OR_THM ) : thm = |- !P Q. (!x. P x \/ Q) = (!x. P x) \/ Q val ( RIGHT_FORALL_OR_THM ) : thm = |- !P Q. (!x. P \/ Q x) = P \/ (!x. Q x) val ( LEFT_OR_FORALL_THM ) : thm = |- !P Q. (!x. P x) \/ Q = (!x. P x \/ Q) val ( RIGHT_OR_FORALL_THM ) : thm = |- !P Q. P \/ (!x. Q x) = (!x. P \/ Q x) val ( LEFT_IMP_FORALL_THM ) : thm = |- !P Q. (!x. P x) ==> Q = (?x. P x ==> Q) val ( LEFT_EXISTS_IMP_THM ) : thm = |- !P Q. (?x. P x ==> Q) = (!x. P x) ==> Q val ( RIGHT_IMP_EXISTS_THM ) : thm = |- !P Q. P ==> (?x. Q x) = (?x. P ==> Q x) val ( RIGHT_EXISTS_IMP_THM ) : thm = |- !P Q. (?x. P ==> Q x) = P ==> (?x. Q x) This is the definition of COND, also known as if-then-else. That is, if the parser sees "if c then t else e", it transforms it into "COND c t e". (Actually, it does the same for "c => t | e".) val ( COND_DEF ) : thm = |- COND = (\t t1 t2. @x. ((t = T) ==> (x = t1)) /\ ((t = F) ==> (x = t2))) val ( COND_CLAUSES ) : thm = |- !t1 t2. ((if T then t1 else t2) = t1) /\ ((if F then t1 else t2) = t2) COND_CLAUSES is a "basic rewrite". val ( COND_EXPAND ) : thm = |- !b t1 t2. (if b then t1 else t2) = (~b \/ t1) /\ (b \/ t2) val ( COND_ID ) : thm = |- !b t. (if b then t else t) = t val ( COND_RAND ) : thm = |- !b f x y. f (if b then x else y) = (if b then f x else f y) val ( COND_RATOR ) : thm = |- !b f g x. (if b then f else g) x = (if b then f x else g x) val ( COND_ABS ) : thm = |- !b f g. (\x. if b then f x else g x) = (if b then f else g) val ( MONO_COND ) : thm = |- (A ==> B) /\ (C ==> D) ==> (if b then A else C) ==> (if b then B else D) MONO_COND will automatically be used by MONO_TAC to prove monotonicity for COND expressions. val ( COND_ELIM_THM ) : thm = |- P (if c then x else y) = (c ==> P x) /\ (~c ==> P y) COND_ELIM_CONV rewrites `P[if c then x else y]` to `(c ==> P[x]) /\ (~c ==> P[y])` COND_CASES_TAC does a case split on a COND expression in the goal. If the goal is `P[if c then x else y]`, then in one subgoal, it adds an assumption `c` and changes the goal to `P[x]` (and then rewrites `c` to `T` in the goal). In the other subgoal, it adds an assumption `~c`, changes the goal to `P[y]`, and rewrites `c` to `F`. (If `c` has the form `~d`, then instead, it adds an assumption `d` and rewrites `d` to `T`.) val ( SKOLEM_THM ) : thm = |- !P. (!x. ?y. P x y) = (?y. !x. P x (y x)) val ( UNIQUE_SKOLEM_ALT ) : thm = |- !P. (!x. ?!y. P x y) = (?f. !x y. P x y = f x = y) val ( UNIQUE_SKOLEM_THM ) : thm = |- !P. (!x. ?!y. P x y) = (?!f. !x. P x (f x)) The theorem `|- (if x = x then y else z) = y` is a "basic rewrite". This is the definition of `(o)`, the function composition operator. val o_DEF : thm = |- !f g. f o g = (\x. f (g x)) This is the definition of `I`, the identity function. val ( I_DEF ) : thm = |- I = (\x. x) val o_THM : thm = |- !f g x. (f o g) x = f (g x) val o_ASSOC : thm = |- !f g h. f o g o h = (f o g) o h val ( I_THM ) : thm = |- !x. I x = x val ( I_O_ID ) : thm = |- !f. (I o f = f) /\ (f o I = f) val ( EXISTS_ONE_REP ) : thm = |- ?b. b This defines a new type "one", with one element; and functions that map between bool and one (where the single element of "one" maps to `T`). val one_tydef : thm = |- (!a. one_ABS (one_REP a) = a) /\ (!r. r = one_REP (one_ABS r) = r) This is the definition of "one", the name of the sole value of type "one". val one_DEF : thm = |- one = (@x. T) val one : thm = |- !v. v = one val one_axiom : thm = |- !f g. f = g val one_Axiom : thm = |- !e. ?!fn. fn one = e canon: PRESIMP_CONV is a conversion which simplifies literal `T` and `F` as the arguments of not,and,or,implies,equality, etc.; and moves connectives out of quantifiers whenever possible. NNF_CONV and NNFC_CONV move negations inward past and,or,implies,forall, exists,exists_unique,iff. These conversions also eliminate iff and implication. (There are two possible ways to eliminate iff; NNF_CONV uses the method which makes DNF smaller, and NNFC_CONV uses the method which makes CNF smaller.) SKOLEM_CONV moves existential quantifiers outward past or,and,forall. (skolemizing when an existential moves past a universal). Does not handle existentials inside negations. PRENEX_CONV moves universal quantifiers outward past or,and. MINISCOPE_FORALL moves universal quantifiers inward past or,and,forall. (For instance, `!x y. P x y \/ Q y` would become `!y. (!x. P x y) \/ Q y`.) PROP_CNF_CONV uses DeMorgan's laws and associativity to move to conjunctive normal form. PROP_DNF_CONV uses DeMorgan's laws and associativity to move to disjunctive normal form. REFUTE_THEN tht changes the goal from `p` to `F` and runs tht on the assumption `|- ~p`. SPLIT_TAC lev Starts by replacing any assumption `|- a /\ b` with separate assumptions `|- a` and `|- b`. Then, up to lev levels deep, it removes an assumption `|- a \/ b`, splits into two subgoals, adds assumption `|- a` in one subgoal, and adds assumption `|- b` in the other. EQ_ABS_CONV rewrites `f = \x y z. A[x,y,z]` to `!x y z. f x y z = A[x,y,z]`. It never fails. DELAMB_CONV repeatedly rewrites `(\x. s x) = t` to `!x. s x = t x` (and similarly if the lambda is on the right) and applies beta reduction until no more progress can be made. It never fails. I'm not documenting GEN_FOL_CONV. FOL_CONV takes a term and makes sure that for every constant, whenever it is used, it is always applied to the same number of arguments. It does this by finding the minimal number of arguments for each constant; anywhere it is applied to more arguments, the application `f x1 ... xn` is changed to `I (f x1 ... x(n-1)) xn` (this process is repeated, if necessary). ASM_FOL_TAC Uses the technique of FOL_CONV, but applies throughout the entire goalstate (goal and assumptions). meson: A general first-order theorem prover. ASM_MESON_TAC thl Tries to prove the goal using meson; uses the assumptions and the theorems in thl. MESON_TAC thl Tries to prove the goal using meson; ignores assumptions. GEN_MESON_TAC min max step thl Like MESON_TAC but with explicit start (min), finish (max) and step (step) for the iterative deepening. quot: define_quotient_type "newtype" ("newtypeABS","newtypeREP") `\x y. P[x,y]` Defines a new type "newtype" with a bijection to a subset of "oldtype->bool" (where "oldtype" is the type of `x`). This subset is defined by the predicate `\s. ?x. s = \y. P[x,y]`. (If `P[x,y]` is symmetric, reflexive, and transitive, then "newtype" is isomorphic to the quotient of "oldtype" by P.) Along with the new type, it also defines new constants "newtypeABS" and "newtypeREP", and returns theorems: (`|- newtypeABS (newtypeREP a) = a`, `|- (?x. r = (\x y. P[x,y]) x) = newtypeREP (newtypeABS r) = r`) lift_function: (* Given a welldefinedness theorem for a curried function f, of the form: *) (* *) (* |- !x1 x1' .. xn xn'. (x1 == x1') /\ ... /\ (xn == xn') *) (* ==> (f x1 .. xn == f x1' .. f nx') *) (* *) (* where each "==" is either equality or some fixed binary relation R, a *) (* new operator called "opname" is introduced which lifts "f" up to the *) (* R-equivalence classes. Two theorems are returned: the actual definition *) (* and a useful consequence for lifting theorems. *) (* *) (* The function also needs the second (more complicated) type bijection, and *) (* the reflexivity and transitivity (not symmetry!) of the equivalence *) (* relation. The use also gives a name for the new function. *) lift_theorem: (* Lifts a theorem. This can be done by higher order rewriting alone. *) (* *) (* NB! All and only the first order variables must be bound by quantifiers. *) recursion.ml: Functions for defining recursive functions. Mostly subsumed by "define", but sometimes useful for efficiency or other reasons. pair.ml: This is the definition of LET. val ( LET_DEF ) : thm = |- !f x. LET f x = f x This is the definition of LET_END. val ( LET_END_DEF ) : thm = |- !t. LET_END t = t This is the definition of GABS. val ( GABS_DEF ) : thm = |- !P. GABS P = (@) P This is the definition of GEQ. val ( GEQ_DEF ) : thm = |- !a b. GEQ a b = a = b LET, LET_END, GABS, and GEQ are syntactic markers used by the parser and printer, so that you can read in a let expression, or an extended lambda expression, and print it back out. The term `let x = 3 and y = 4 in x+y` would be parsed as `LET (\x y. LET_END (x+y)) 3 4`. This is the definition of mk_pair. val mk_pair_def : thm = |- !x y. mk_pair x y = (\a b. (a = x) /\ (b = y)) val ( PAIR_EXISTS_THM ) : thm = |- ?x a b. x = mk_pair a b This defines a new type (a,b)prod, which is in bijection with a subset of the type `a->b->bool` (the range of the function mk_pair). val prod_tybij : thm = |- (!a. ABS_prod (REP_prod a) = a) /\ (!r. (?a b. r = mk_pair a b) = REP_prod (ABS_prod r) = r) val ( REP_ABS_PAIR ) : thm = |- !x y. REP_prod (ABS_prod (mk_pair x y)) = mk_pair x y This defines the infix "," (comma) operator. val ( COMMA_DEF ) : thm = |- !x y. x,y = ABS_prod (mk_pair x y) This defines the FST function. val ( FST_DEF ) : thm = |- !p. FST p = (@x. ?y. p = x,y) This defines the SND function. val ( SND_DEF ) : thm = |- !p. SND p = (@y. ?x. p = x,y) val ( PAIR_EQ ) : thm = |- !x y a b. (x,y = a,b) = (x = a) /\ (y = b) val ( PAIR_SURJECTIVE ) : thm = |- !p. ?x y. p = x,y val ( FST ) : thm = |- !x y. FST (x,y) = x val ( SND ) : thm = |- !x y. SND (x,y) = y val ( PAIR ) : thm = |- !x. FST x,SND x = x FST, SND, and PAIR are "basic rewrites". This defines the CURRY function. val ( CURRY_DEF ) : thm = |- !f x y. CURRY f x y = f (x,y) This defines the UNCURRY function. val ( UNCURRY_DEF ) : thm = |- !f x y. UNCURRY f (x,y) = f x y This defines the PASSOC function. val ( PASSOC_DEF ) : thm = |- !f x y z. PASSOC f (x,y,z) = f ((x,y),z) Let me describe extended lambda expressions. The "variable" for a lambda expression can actually be an arbitrary expression; `(\P[x,y]. Q[x,y])` is taken to mean: `@f. !x y. (f (P[x,y])) = Q[x,y]` This makes perfect sense for pairs; for instance, `\(x,y).x` is equal to `FST`. It also makes sense in other situations: `\(x+&1).x` is equal to `\x.x-&1`. Other cases are stranger: `\(x*2).x` is a function which divides even numbers by 2, but its behavior on odd numbers is undefined. Extended binders of all sorts are defined by extension. `!(x*2).P[x]` means `(!) (\(x*2).P[x])`; the value of this expression may not be determined, since it may depend on the (unspecified) behavior of the lambda term on odd arguments. `!(x,y).P[x,y]` is perfectly meaningful, although not necessarily useful; it means the same thing as `!x y.P[x,y]`. `let (x,y) = (1,2) in x+y` also has the expected meaning. I said above that `(\P[x,y]. Q[x,y])` is taken to mean: `@f. !x y. (f (P[x,y])) = Q[x,y]` However, to allow these functions to be printed back out in the same syntax they were read in, special markers are used. GABS is defined to equal `(@)`, and GEQ is defined to equal `(=)`, so the internal form of the above is actually `GABS (\f. !x y. GEQ (f (P[x,y])) Q[x,y])`. PAIRED_BETA_CONV handles beta reduction of extended lambda expressions whose arguments are pairs. GEN_PAIR_TAC converts a goal of the form `!x. P[x]` (where `x` has a pair type) to `P[(FST x, SND x)]`; but a comment says that rewriting with FORALL_PAIR_THM (below) is better. val ( FORALL_PAIR_THM ) : thm = |- (!p. P p) = (!p1 p2. P (p1,p2)) val ( EXISTS_PAIR_THM ) : thm = |- (?p. P p) = (?p1 p2. P (p1,p2)) let_CONV reduces a "let" expression. (Again, it handles extended definitions, if they only use pairs.) LET_TAC replaces "let x = t in p[x]" in goal with "p[x]" given a new hypothesis "t = x". GEN_BETA_CONV reduces generalized beta-redexes such as `(\(x,y). x + y) (1,2)` num.ml: We define a new type, "ind"; we are going to axiomatize that "ind" has an infinite number of elements. This is the definition of ONE_ONE. val ( ONE_ONE ) : thm = |- !f. ONE_ONE f = (!x1 x2. (f x1 = f x2) ==> (x1 = x2)) This is the definition of ONTO. val ( ONTO ) : thm = |- !f. ONTO f = (!y. ?x. y = f x) This is an axiom! (Note that `f` has type `ind->ind`.) val ( INFINITY_AX ) : thm = |- ?f. ONE_ONE f /\ ~ONTO f val ( IND_SUC_0_EXISTS ) : thm = |- ?f z. (!x1 x2. (f x1 = f x2) = x1 = x2) /\ (!x. ~(f x = z)) Now we define constants IND_SUC and IND_0, using new_specification with IND_SUC_0_EXISTS. These are the two theorems returned. val ( IND_SUC_INJ ) : thm = |- !x1 x2. (IND_SUC x1 = IND_SUC x2) = x1 = x2 val ( IND_SUC_0 ) : thm = |- !x. ~(IND_SUC x = IND_0) Now define the natural number representations as a subset of ind, using the inductive definition `NUM_REP IND_0 /\ (!i. NUM_REP i ==> NUM_REP (IND_SUC i))` This returns the following theorems: val ( NUM_REP_RULES ) : thm = |- NUM_REP IND_0 /\ (!i. NUM_REP i ==> NUM_REP (IND_SUC i)) val ( NUM_REP_INDUCT ) : thm = |- !NUM_REP'. NUM_REP' IND_0 /\ (!i. NUM_REP' i ==> NUM_REP' (IND_SUC i)) ==> (!a. NUM_REP a ==> NUM_REP' a) val ( NUM_REP_CASES ) : thm = |- !a. NUM_REP a = (a = IND_0) \/ (?i. (a = IND_SUC i) /\ NUM_REP i) Now we define the type "num", which has a bijection with the NUM_REP subset of ind. This gives the following theorems: val num_tydef : thm * thm = (|- mk_num (dest_num a) = a, |- NUM_REP r = dest_num (mk_num r) = r) This is the definition of _0. val ( ZERO_DEF ) : thm = |- _0 = mk_num IND_0 This is the definition of SUC. val ( SUC_DEF ) : thm = |- !n. SUC n = mk_num (IND_SUC (dest_num n)) val ( NOT_SUC ) : thm = |- !n. ~(SUC n = _0) val ( SUC_INJ ) : thm = |- !m n. (SUC m = SUC n) = m = n val num_INDUCTION : thm = |- !P. P _0 /\ (!n. P n ==> P (SUC n)) ==> (!n. P n) val num_Axiom : thm = |- !e f. ?!fn. (fn _0 = e) /\ (!n. fn (SUC n) = f (fn n) n) This is the definition of NUMERAL. The HOL Light parser reads decimal numbers and turns them internally into terms starting with NUMERAL; then the printer turns them back into decimal numbers. val ( NUMERAL ) : thm = |- !n. NUMERAL n = n Now we can use the decimal number 0, rather than the symbol _0; we prove new versions of the above four theorems, replacing _0 with 0. (We give them the same names as the old theorems, which are now inaccessible.) val ( NOT_SUC ) : thm = |- !n. ~(SUC n = 0) val ( SUC_INJ ) : thm = |- !m n. (SUC m = SUC n) = m = n val num_INDUCTION : thm = |- !P. P 0 /\ (!n. P n ==> P (SUC n)) ==> (!n. P n) val num_Axiom : thm = |- !e f. ?!fn. (fn 0 = e) /\ (!n. fn (SUC n) = f (fn n) n) INDUCT_TAC takes a goal `!x. P[x]` and creates subgoals `P[0]` and `P[SUC n]` (the latter with an assumption `P[n]`). val num_RECURSION : thm = |- !e f. ?fn. (fn 0 = e) /\ (!n. fn (SUC n) = f (fn n) n) val num_CASES : thm = |- !m. (m = 0) \/ (?n. m = SUC n) arith.ml: This is the definition of PRE (predecessor). val ( PRE ) : thm = |- (PRE 0 = 0) /\ (!n. PRE (SUC n) = n) This is the definition of (+). val ( ADD ) : thm = |- (!n. 0 + n = n) /\ (!m n. SUC m + n = SUC (m + n)) val ( ADD_0 ) : thm = |- !m. m + 0 = m val ( ADD_SUC ) : thm = |- !m n. m + SUC n = SUC (m + n) val ( ADD_CLAUSES ) : thm = |- (!n. 0 + n = n) /\ (!m. m + 0 = m) /\ (!m n. SUC m + n = SUC (m + n)) /\ (!m n. m + SUC n = SUC (m + n)) val ( ADD_SYM ) : thm = |- !m n. m + n = n + m val ( ADD_ASSOC ) : thm = |- !m n p. m + n + p = (m + n) + p val ( ADD_AC ) : thm = |- (m + n = n + m) /\ ((m + n) + p = m + n + p) /\ (m + n + p = n + m + p) val ( ADD_EQ_0 ) : thm = |- !m n. (m + n = 0) = (m = 0) /\ (n = 0) val ( EQ_ADD_LCANCEL ) : thm = |- !m n p. (m + n = m + p) = n = p val ( EQ_ADD_RCANCEL ) : thm = |- !m n p. (m + p = n + p) = m = n val ( EQ_ADD_LCANCEL_0 ) : thm = |- !m n. (m + n = m) = n = 0 val ( EQ_ADD_RCANCEL_0 ) : thm = |- !m n. (m + n = n) = m = 0 These are the definitions of BIT0 and BIT1. The HOL Light parser parses decimal numbers into terms made of 0, BIT0, and BIT1, surrounded by NUMERAL. val ( BIT0 ) : thm = |- !n. BIT0 n = n + n val ( BIT1 ) : thm = |- !n. BIT1 n = SUC (n + n) val ( BIT0_THM ) : thm = |- !n. NUMERAL (BIT0 n) = NUMERAL n + NUMERAL n val ( BIT1_THM ) : thm = |- !n. NUMERAL (BIT1 n) = SUC (NUMERAL n + NUMERAL n) val ( ONE ) : thm = |- 1 = SUC 0 val ( TWO ) : thm = |- 2 = SUC 1 val ( ADD1 ) : thm = |- !m. SUC m = m + 1 This is the definition of (*) val ( MULT ) : thm = |- (!n. 0 * n = 0) /\ (!m n. SUC m * n = m * n + n) val ( MULT_0 ) : thm = |- !m. m * 0 = 0 val ( MULT_SUC ) : thm = |- !m n. m * SUC n = m + m * n val ( MULT_CLAUSES ) : thm = |- (!n. 0 * n = 0) /\ (!m. m * 0 = 0) /\ (!n. 1 * n = n) /\ (!m. m * 1 = m) /\ (!m n. SUC m * n = m * n + n) /\ (!m n. m * SUC n = m + m * n) val ( MULT_SYM ) : thm = |- !m n. m * n = n * m val ( LEFT_ADD_DISTRIB ) : thm = |- !m n p. m * (n + p) = m * n + m * p val ( RIGHT_ADD_DISTRIB ) : thm = |- !m n p. (m + n) * p = m * p + n * p val ( MULT_ASSOC ) : thm = |- !m n p. m * n * p = (m * n) * p val ( MULT_AC ) : thm = |- (m * n = n * m) /\ ((m * n) * p = m * n * p) /\ (m * n * p = n * m * p) val ( MULT_EQ_0 ) : thm = |- !m n. (m * n = 0) = (m = 0) \/ (n = 0) val ( EQ_MULT_LCANCEL ) : thm = |- !m n p. (m * n = m * p) = (m = 0) \/ (n = p) val ( EQ_MULT_RCANCEL ) : thm = |- !m n p. (m * p = n * p) = (m = n) \/ (p = 0) val ( MULT_2 ) : thm = |- !n. 2 * n = n + n val ( MULT_EQ_1 ) : thm = |- !m n. (m * n = 1) = (m = 1) /\ (n = 1) This is the definition of EXP (exponentiation). val ( EXP ) : thm = |- (!m. m EXP 0 = 1) /\ (!m n. m EXP SUC n = m * m EXP n) val ( EXP_EQ_0 ) : thm = |- !m n. (m EXP n = 0) = (m = 0) /\ ~(n = 0) val ( EXP_ADD ) : thm = |- !m n p. m EXP (n + p) = m EXP n * m EXP p val ( EXP_ONE ) : thm = |- !n. 1 EXP n = 1 val ( EXP_1 ) : thm = |- !n. n EXP 1 = n val ( EXP_2 ) : thm = |- !n. n EXP 2 = n * n val ( MULT_EXP ) : thm = |- !p m n. (m * n) EXP p = m EXP p * n EXP p val ( EXP_MULT ) : thm = |- !m n p. m EXP (n * p) = m EXP n EXP p This is the definition of (<=) val ( LE ) : thm = |- (!m. m <= 0 = m = 0) /\ (!m n. m <= SUC n = (m = SUC n) \/ m <= n) This is the definition of (<) val ( LT ) : thm = |- (!m. m < 0 = F) /\ (!m n. m < SUC n = (m = n) \/ m < n) This is the definition of (>=) val ( GE ) : thm = |- !n m. m >= n = n <= m This is the definition of (>) val ( GT ) : thm = |- !n m. m > n = n < m val ( LE_SUC_LT ) : thm = |- !m n. SUC m <= n = m < n val ( LT_SUC_LE ) : thm = |- !m n. m < SUC n = m <= n val ( LE_SUC ) : thm = |- !m n. SUC m <= SUC n = m <= n val ( LT_SUC ) : thm = |- !m n. SUC m < SUC n = m < n val ( LE_0 ) : thm = |- !n. 0 <= n val ( LT_0 ) : thm = |- !n. 0 < SUC n val ( LE_REFL ) : thm = |- !n. n <= n val ( LT_REFL ) : thm = |- !n. ~(n < n) val ( LE_ANTISYM ) : thm = |- !m n. m <= n /\ n <= m = m = n val ( LT_ANTISYM ) : thm = |- !m n. ~(m < n /\ n < m) val ( LET_ANTISYM ) : thm = |- !m n. ~(m <= n /\ n < m) val ( LTE_ANTISYM ) : thm = |- !m n. ~(m < n /\ n <= m) val ( LE_TRANS ) : thm = |- !m n p. m <= n /\ n <= p ==> m <= p val ( LT_TRANS ) : thm = |- !m n p. m < n /\ n < p ==> m < p val ( LET_TRANS ) : thm = |- !m n p. m <= n /\ n < p ==> m < p val ( LTE_TRANS ) : thm = |- !m n p. m < n /\ n <= p ==> m < p val ( LE_CASES ) : thm = |- !m n. m <= n \/ n <= m val ( LT_CASES ) : thm = |- !m n. m < n \/ n < m \/ (m = n) val ( LET_CASES ) : thm = |- !m n. m <= n \/ n < m val ( LTE_CASES ) : thm = |- !m n. m < n \/ n <= m val ( LE_LT ) : thm = |- !m n. m <= n = m < n \/ (m = n) val ( LT_LE ) : thm = |- !m n. m < n = m <= n /\ ~(m = n) val ( NOT_LE ) : thm = |- !m n. ~(m <= n) = n < m val ( NOT_LT ) : thm = |- !m n. ~(m < n) = n <= m val ( LT_IMP_LE ) : thm = |- !m n. m < n ==> m <= n val ( EQ_IMP_LE ) : thm = |- !m n. (m = n) ==> m <= n val ( LE_EXISTS ) : thm = |- !m n. m <= n = (?d. n = m + d) val ( LT_EXISTS ) : thm = |- !m n. m < n = (?d. n = m + SUC d) val ( LE_ADD ) : thm = |- !m n. m <= m + n val ( LE_ADDR ) : thm = |- !m n. n <= m + n val ( LT_ADD ) : thm = |- !m n. m < m + n = 0 < n val ( LT_ADDR ) : thm = |- !m n. n < m + n = 0 < m val ( LE_ADD_LCANCEL ) : thm = |- !m n p. m + n <= m + p = n <= p val ( LE_ADD_RCANCEL ) : thm = |- !m n p. m + p <= n + p = m <= n val ( LT_ADD_LCANCEL ) : thm = |- !m n p. m + n < m + p = n < p val ( LT_ADD_RCANCEL ) : thm = |- !m n p. m + p < n + p = m < n val ( LE_ADD2 ) : thm = |- !m n p q. m <= p /\ n <= q ==> m + n <= p + q val ( LET_ADD2 ) : thm = |- !m n p q. m <= p /\ n < q ==> m + n < p + q val ( LTE_ADD2 ) : thm = |- !m n p q. m < p /\ n <= q ==> m + n < p + q val ( LT_ADD2 ) : thm = |- !m n p q. m < p /\ n < q ==> m + n < p + q val ( LT_MULT ) : thm = |- !m n. 0 < m * n = 0 < m /\ 0 < n val ( LE_MULT2 ) : thm = |- !m n p q. m <= n /\ p <= q ==> m * p <= n * q val ( LT_LMULT ) : thm = |- !m n p. ~(m = 0) /\ n < p ==> m * n < m * p val ( LE_MULT_LCANCEL ) : thm = |- !m n p. m * n <= m * p = (m = 0) \/ n <= p val ( LE_MULT_RCANCEL ) : thm = |- !m n p. m * p <= n * p = m <= n \/ (p = 0) val ( LT_MULT_LCANCEL ) : thm = |- !m n p. m * n < m * p = ~(m = 0) /\ n < p val ( LT_MULT_RCANCEL ) : thm = |- !m n p. m * p < n * p = m < n /\ ~(p = 0) val ( EQ_SUC ) : thm = |- !m n. (SUC m = SUC n) = m = n val ( LT_MULT2 ) : thm = |- !m n p q. m < n /\ p < q ==> m * p < n * q val ( LE_SQUARE_REFL ) : thm = |- !n. n <= n * n val num_WF : thm = |- !P. (!n. (!m. m < n ==> P m) ==> P n) ==> (!n. P n) val num_WOP : thm = |- !P. (?n. P n) = (?n. P n /\ (!m. m < n ==> ~P m)) val num_MAX : thm = |- !P. (?x. P x) /\ (?M. !x. P x ==> x <= M) = (?m. P m /\ (!x. P x ==> x <= m)) These are the definitions of EVEN and ODD. val ( EVEN ) : thm = |- (EVEN 0 = T) /\ (!n. EVEN (SUC n) = ~EVEN n) val ( ODD ) : thm = |- (ODD 0 = F) /\ (!n. ODD (SUC n) = ~ODD n) val ( NOT_EVEN ) : thm = |- !n. ~EVEN n = ODD n val ( NOT_ODD ) : thm = |- !n. ~ODD n = EVEN n val ( EVEN_OR_ODD ) : thm = |- !n. EVEN n \/ ODD n val ( EVEN_AND_ODD ) : thm = |- !n. ~(EVEN n /\ ODD n) val ( EVEN_ADD ) : thm = |- !m n. EVEN (m + n) = EVEN m = EVEN n val ( EVEN_MULT ) : thm = |- !m n. EVEN (m * n) = EVEN m \/ EVEN n val ( EVEN_EXP ) : thm = |- !m n. EVEN (m EXP n) = EVEN m /\ ~(n = 0) val ( ODD_ADD ) : thm = |- !m n. ODD (m + n) = ~(ODD m = ODD n) val ( ODD_MULT ) : thm = |- !m n. ODD (m * n) = ODD m /\ ODD n val ( ODD_EXP ) : thm = |- !m n. ODD (m EXP n) = ODD m \/ (n = 0) val ( EVEN_DOUBLE ) : thm = |- !n. EVEN (2 * n) val ( ODD_DOUBLE ) : thm = |- !n. ODD (SUC (2 * n)) val ( EVEN_EXISTS_LEMMA ) : thm = |- !n. (EVEN n ==> (?m. n = 2 * m)) /\ (~EVEN n ==> (?m. n = SUC (2 * m))) val ( EVEN_EXISTS ) : thm = |- !n. EVEN n = (?m. n = 2 * m) val ( ODD_EXISTS ) : thm = |- !n. ODD n = (?m. n = SUC (2 * m)) This is the definition of (-). Note that according to this definition, if a (m - n + n = m) val ( SUB_ADD_LCANCEL ) : thm = |- !m n p. (m + n) - (m + p) = n - p val ( SUB_ADD_RCANCEL ) : thm = |- !m n p. (m + p) - (n + p) = m - n val ( LEFT_SUB_DISTRIB ) : thm = |- !m n p. m * (n - p) = m * n - m * p val ( RIGHT_SUB_DISTRIB ) : thm = |- !m n p. (m - n) * p = m * p - n * p This is the definition of FACT (factorial). val ( FACT ) : thm = |- (FACT 0 = 1) /\ (!n. FACT (SUC n) = SUC n * FACT n) val ( FACT_LT ) : thm = |- !n. 0 < FACT n val ( FACT_LE ) : thm = |- !n. 1 <= FACT n val ( FACT_MONO ) : thm = |- !m n. m <= n ==> FACT m <= FACT n val ( DIVMOD_EXIST ) : thm = |- !m n. ~(n = 0) ==> (?q r. (m = q * n + r) /\ r < n) This is the simultaneous definition, using new_specification, of DIV and MOD. val ( DIVISION ) : thm = |- !m n. ~(n = 0) ==> (m = m DIV n * n + m MOD n) /\ m MOD n < n val ( DIVMOD_UNIQ_LEMMA ) : thm = |- !m n q1 r1 q2 r2. ((m = q1 * n + r1) /\ r1 < n) /\ (m = q2 * n + r2) /\ r2 < n ==> (q1 = q2) /\ (r1 = r2) val ( DIVMOD_UNIQ ) : thm = |- !m n q r. (m = q * n + r) /\ r < n ==> (m DIV n = q) /\ (m MOD n = r) val ( MOD_UNIQ ) : thm = |- !m n q r. (m = q * n + r) /\ r < n ==> (m MOD n = r) val ( DIV_UNIQ ) : thm = |- !m n q r. (m = q * n + r) /\ r < n ==> (m DIV n = q) val ( MOD_MULT ) : thm = |- !m n. ~(m = 0) ==> ((m * n) MOD m = 0) val ( DIV_MULT ) : thm = |- !m n. ~(m = 0) ==> ((m * n) DIV m = n) val ( DIV_DIV ) : thm = |- !m n p. ~(n * p = 0) ==> (m DIV n DIV p = m DIV (n * p)) val ( MOD_LT ) : thm = |- !m n. m < n ==> (m MOD n = m) val ( MOD_EQ ) : thm = |- !m n p q. (m = n + q * p) ==> (m MOD p = n MOD p) val ( DIV_MOD ) : thm = |- !m n p. ~(n * p = 0) ==> ((m DIV n) MOD p = (m MOD (n * p)) DIV n) val ( DIV_1 ) : thm = |- !n. n DIV 1 = n val ( EXP_LT_0 ) : thm = |- !n x. 0 < x EXP n = ~(x = 0) \/ (n = 0) val ( DIV_LE ) : thm = |- !m n. ~(n = 0) ==> m DIV n <= m val ( DIV_MUL_LE ) : thm = |- !m n. n * m DIV n <= m val ( DIV_0 ) : thm = |- !n. ~(n = 0) ==> (0 DIV n = 0) val ( MOD_0 ) : thm = |- !n. ~(n = 0) ==> (0 MOD n = 0) val ( DIV_LT ) : thm = |- !m n. m < n ==> (m DIV n = 0) val ( MOD_MOD ) : thm = |- !m n p. ~(n * p = 0) ==> (m MOD (n * p) MOD n = m MOD n) val ( MOD_MOD_REFL ) : thm = |- !m n. ~(n = 0) ==> (m MOD n MOD n = m MOD n) val ( DIV_MULT2 ) : thm = |- !m n p. ~(m * p = 0) ==> ((m * n) DIV (m * p) = n DIV p) val ( MOD_MULT2 ) : thm = |- !m n p. ~(m * p = 0) ==> ((m * n) MOD (m * p) = m * n MOD p) val ( MOD_1 ) : thm = |- !n. n MOD 1 = 0 val ( MOD_EXISTS ) : thm = |- !m n. (?q. m = n * q) = (if n = 0 then m = 0 else m MOD n = 0) val ( LT_EXP ) : thm = |- !x m n. x EXP m < x EXP n = 2 <= x /\ m < n \/ (x = 0) /\ ~(m = 0) /\ (n = 0) val ( LE_EXP ) : thm = |- !x m n. x EXP m <= x EXP n = (if x = 0 then (m = 0) ==> (n = 0) else (x = 1) \/ m <= n) val ( DIV_MONO ) : thm = |- !m n p. ~(p = 0) /\ m <= n ==> m DIV p <= n DIV p val ( DIV_MONO_LT ) : thm = |- !m n p. ~(p = 0) /\ m + p <= n ==> m DIV p < n DIV p val ( LE_LDIV ) : thm = |- !a b n. ~(a = 0) /\ b <= a * n ==> b DIV a <= n val ( LE_RDIV_EQ ) : thm = |- !a b n. ~(a = 0) ==> (n <= b DIV a = a * n <= b) val ( LE_LDIV_EQ ) : thm = |- !a b n. ~(a = 0) ==> (b DIV a <= n = b < a * (n + 1)) val ( DIV_EQ_0 ) : thm = |- !m n. ~(n = 0) ==> ((m DIV n = 0) = m < n) val ( MOD_EQ_0 ) : thm = |- !m n. ~(n = 0) ==> ((m MOD n = 0) = (?q. m = q * n)) val ( EVEN_MOD ) : thm = |- !n. EVEN n = n MOD 2 = 0 val ( ODD_MOD ) : thm = |- !n. ODD n = n MOD 2 = 1 val ( MOD_MULT_RMOD ) : thm = |- !m n p. ~(n = 0) ==> ((m * p MOD n) MOD n = (m * p) MOD n) val ( MOD_MULT_LMOD ) : thm = |- !m n p. ~(n = 0) ==> ((m MOD n * p) MOD n = (m * p) MOD n) val ( MOD_MULT_MOD2 ) : thm = |- !m n p. ~(n = 0) ==> ((m MOD n * p MOD n) MOD n = (m * p) MOD n) val ( MOD_EXP_MOD ) : thm = |- !m n p. ~(n = 0) ==> ((m MOD n) EXP p MOD n = m EXP p MOD n) val ( MOD_MULT_ADD ) : thm = |- !m n p. (m * n + p) MOD n = p MOD n val ( MOD_ADD_MOD ) : thm = |- !a b n. ~(n = 0) ==> ((a MOD n + b MOD n) MOD n = (a + b) MOD n) val ( DIV_ADD_MOD ) : thm = |- !a b n. ~(n = 0) ==> (((a + b) MOD n = a MOD n + b MOD n) = (a + b) DIV n = a DIV n + b DIV n) val ( DIV_REFL ) : thm = |- !n. ~(n = 0) ==> (n DIV n = 1) val ( MOD_LE ) : thm = |- !m n. ~(n = 0) ==> m MOD n <= m val ( DIV_MONO2 ) : thm = |- !m n p. ~(p = 0) /\ p <= m ==> n DIV m <= n DIV p val ( SUB_ELIM_THM ) : thm = |- P (a - b) = (!d. ((b = a + d) ==> P 0) /\ ((a = b + d) ==> P d)) SUB_ELIM_CONV rewrites with SUB_ELIM_THM (directly above). SUB_ELIM_TAC takes a goal `P[a-b]` and creates two subgoals. In the first, the goal is changed to `P[0]`, `b` is rewritten to `a+d` throughout the goal state, and an assumption `b = a+d` is added. In the second, the goal is changed to `P[d]`, `a` is rewritten to `b+d` throughout the goal state, and an assumption `a=b+d` is added. val ( PRE_ELIM_THM ) : thm = |- P (PRE n) = (!m. ((n = 0) ==> P 0) /\ ((n = SUC m) ==> P m)) PRE_ELIM_CONV rewrites with PRE_ELIM_THM (directly above). PRE_ELIM_TAC takes a goal `P[PRE n]` and creates two subgoals. In the first, the goal is changed to `P[0]`, `n` is rewritten to `0` throughout the goal state, and an assumption `n=0` is added. In the second, the goal is changed to `P[m]`, `n` is rewritten to `SUC m` throughout the goal state, and an assumption `n = SUC m` is added. val ( DIVMOD_ELIM_THM ) : thm = |- ~(n = 0) ==> (P (m DIV n) (m MOD n) = (!q r. (m = q * n + r) /\ r < n ==> P q r)) DIVMOD_ELIM_TAC finds either a subterm `m DIV n` or `m MOD n` in the current goal. It uses these to view the goal as `P[m DIV n,m MOD n]`. It then changes the goal to `~(n = 0) /\ ((m = q*n + r) /\ r < n ==> P[q;r]` NUM_CANCEL_CONV rewrites `(c+(b+a)) = (b+d)+a` to `c=d` LE_IMP `|- a <= b` gives (GEN_ALL `|- b <= p ==> a <= p`) wf.ml: This is the definition of WF. val ( WF ) : thm = |- !(<<). WF (<<) = (!P. (?x. P x) ==> (?x. P x /\ (!y. y << x ==> ~P y))) val ( WF_EQ ) : thm = |- WF (<<) = (!P. (?x. P x) = (?x. P x /\ (!y. y << x ==> ~P y))) val ( WF_IND ) : thm = |- WF (<<) = (!P. (!x. (!y. y << x ==> P y) ==> P x) ==> (!x. P x)) val ( WF_DCHAIN ) : thm = |- WF (<<) = ~(?s. !n. s (SUC n) << s n) val ( WF_UREC ) : thm = |- WF (<<) ==> (!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> (!f g. (!x. f x = H f x) /\ (!x. g x = H g x) ==> (f = g))) val ( WF_UREC_WF ) : thm = |- (!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> (!f g. (!x. f x = H f x) /\ (!x. g x = H g x) ==> (f = g))) ==> WF (<<) val ( WF_REC ) : thm = |- WF (<<) ==> (!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> (?f. !x. f x = H f x)) val ( WF_REC_WF ) : thm = |- (!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> (?f. !x. f x = H f x)) ==> WF (<<) val ( WF_EREC ) : thm = |- WF (<<) ==> (!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> (?!f. !x. f x = H f x)) val ( WF_SUBSET ) : thm = |- (!x y. x << y ==> x <<< y) /\ WF (<<<) ==> WF (<<) val ( WF_MEASURE_GEN ) : thm = |- !m. WF (<<) ==> WF (\x x'. m x << m x') val ( WF_LEX_DEPENDENT ) : thm = |- !R S. WF R /\ (!a. WF (S a)) ==> WF (\(r1,s1). \(r2,s2). R r1 r2 \/ (r1 = r2) /\ S r1 s1 s2) val ( WF_LEX ) : thm = |- !R S. WF R /\ WF S ==> WF (\(r1,s1). \(r2,s2). R r1 r2 \/ (r1 = r2) /\ S s1 s2) val ( WF_POINTWISE ) : thm = |- WF (<<) /\ WF (<<<) ==> WF (\(x1,y1). \(x2,y2). x1 << x2 /\ y1 <<< y2) val ( WF_num ) : thm = |- WF (<) val ( WF_REC_num ) : thm = |- !H. (!f g n. (!m. m < n ==> (f m = g m)) ==> (H f n = H g n)) ==> (?f. !n. f n = H f n) This is the definition of measure. val measure : thm = |- !m. measure m = (\x y. m x < m y) val ( WF_MEASURE ) : thm = |- !m. WF (measure m) val ( WF_REFL ) : thm = |- !x. WF (<<) ==> ~(x << x) val ( WF_REC_TAIL ) : thm = |- !P g h. ?f. !x. f x = (if P x then f (g x) else h x) WF_INDUCT_THEN WF_INDUCT_TAC Perform wellfounded induction over a nominated measure function. Sometimes avoids explicit "!n t. size(t) = n ==> ..." goal. calc_num.ml: mangle takes a theorem and rewrites its conclusion to elide NUMERAL. val ( ARITH_ZERO ) : thm = |- (NUMERAL 0 = 0) /\ (BIT0 _0 = _0) val ( ARITH_SUC ) : thm = |- (!n. SUC (NUMERAL n) = NUMERAL (SUC n)) /\ (SUC _0 = BIT1 _0) /\ (!n. SUC (BIT0 n) = BIT1 n) /\ (!n. SUC (BIT1 n) = BIT0 (SUC n)) val ( ARITH_PRE ) : thm = |- (!n. PRE (NUMERAL n) = NUMERAL (PRE n)) /\ (PRE _0 = _0) /\ (!n. PRE (BIT0 n) = (if n = _0 then _0 else BIT1 (PRE n))) /\ (!n. PRE (BIT1 n) = BIT0 n) val ( ARITH_ADD ) : thm = |- (!m n. NUMERAL m + NUMERAL n = NUMERAL (m + n)) /\ (_0 + _0 = _0) /\ (!n. _0 + BIT0 n = BIT0 n) /\ (!n. _0 + BIT1 n = BIT1 n) /\ (!n. BIT0 n + _0 = BIT0 n) /\ (!n. BIT1 n + _0 = BIT1 n) /\ (!m n. BIT0 m + BIT0 n = BIT0 (m + n)) /\ (!m n. BIT0 m + BIT1 n = BIT1 (m + n)) /\ (!m n. BIT1 m + BIT0 n = BIT1 (m + n)) /\ (!m n. BIT1 m + BIT1 n = BIT0 (SUC (m + n))) val ( ARITH_MULT ) : thm = |- (!m n. NUMERAL m * NUMERAL n = NUMERAL (m * n)) /\ (_0 * _0 = _0) /\ (!n. _0 * BIT0 n = _0) /\ (!n. _0 * BIT1 n = _0) /\ (!n. BIT0 n * _0 = _0) /\ (!n. BIT1 n * _0 = _0) /\ (!m n. BIT0 m * BIT0 n = BIT0 (BIT0 (m * n))) /\ (!m n. BIT0 m * BIT1 n = BIT0 m + BIT0 (BIT0 (m * n))) /\ (!m n. BIT1 m * BIT0 n = BIT0 n + BIT0 (BIT0 (m * n))) /\ (!m n. BIT1 m * BIT1 n = BIT1 m + BIT0 n + BIT0 (BIT0 (m * n))) val ( ARITH_EXP ) : thm = |- (!m n. NUMERAL m EXP NUMERAL n = NUMERAL (m EXP n)) /\ (_0 EXP _0 = BIT1 _0) /\ (!m. BIT0 m EXP _0 = BIT1 _0) /\ (!m. BIT1 m EXP _0 = BIT1 _0) /\ (!n. _0 EXP BIT0 n = _0 EXP n * _0 EXP n) /\ (!m n. BIT0 m EXP BIT0 n = BIT0 m EXP n * BIT0 m EXP n) /\ (!m n. BIT1 m EXP BIT0 n = BIT1 m EXP n * BIT1 m EXP n) /\ (!n. _0 EXP BIT1 n = _0) /\ (!m n. BIT0 m EXP BIT1 n = BIT0 m * BIT0 m EXP n * BIT0 m EXP n) /\ (!m n. BIT1 m EXP BIT1 n = BIT1 m * BIT1 m EXP n * BIT1 m EXP n) val ( ARITH_EVEN ) : thm = |- (!n. EVEN (NUMERAL n) = EVEN n) /\ (EVEN _0 = T) /\ (!n. EVEN (BIT0 n) = T) /\ (!n. EVEN (BIT1 n) = F) val ( ARITH_ODD ) : thm = |- (!n. ODD (NUMERAL n) = ODD n) /\ (ODD _0 = F) /\ (!n. ODD (BIT0 n) = F) /\ (!n. ODD (BIT1 n) = T) val ( ARITH_LE ) : thm = |- (!m n. NUMERAL m <= NUMERAL n = m <= n) /\ (_0 <= _0 = T) /\ (!n. BIT0 n <= _0 = n = _0) /\ (!n. BIT1 n <= _0 = F) /\ (!n. _0 <= BIT0 n = T) /\ (!n. _0 <= BIT1 n = T) /\ (!m n. BIT0 m <= BIT0 n = m <= n) /\ (!m n. BIT0 m <= BIT1 n = m <= n) /\ (!m n. BIT1 m <= BIT0 n = m < n) /\ (!m n. BIT1 m <= BIT1 n = m <= n) val ( ARITH_LT ) : thm = |- (!m n. NUMERAL m < NUMERAL n = m < n) /\ (_0 < _0 = F) /\ (!n. BIT0 n < _0 = F) /\ (!n. BIT1 n < _0 = F) /\ (!n. _0 < BIT0 n = _0 < n) /\ (!n. _0 < BIT1 n = T) /\ (!m n. BIT0 m < BIT0 n = m < n) /\ (!m n. BIT0 m < BIT1 n = m <= n) /\ (!m n. BIT1 m < BIT0 n = m < n) /\ (!m n. BIT1 m < BIT1 n = m < n) val ( ARITH_GE ) : thm = |- (!m n. NUMERAL n >= NUMERAL m = n >= m) /\ _0 >= _0 /\ (!n. _0 >= BIT0 n = n = _0) /\ (!n. ~(_0 >= BIT1 n)) /\ (!n. BIT0 n >= _0) /\ (!n. BIT1 n >= _0) /\ (!m n. BIT0 n >= BIT0 m = n >= m) /\ (!m n. BIT1 n >= BIT0 m = n >= m) /\ (!m n. BIT0 n >= BIT1 m = n > m) /\ (!m n. BIT1 n >= BIT1 m = n >= m) val ( ARITH_GT ) : thm = |- (!m n. NUMERAL n > NUMERAL m = n > m) /\ ~(_0 > _0) /\ (!n. ~(_0 > BIT0 n)) /\ (!n. ~(_0 > BIT1 n)) /\ (!n. BIT0 n > _0 = n > _0) /\ (!n. BIT1 n > _0) /\ (!m n. BIT0 n > BIT0 m = n > m) /\ (!m n. BIT1 n > BIT0 m = n >= m) /\ (!m n. BIT0 n > BIT1 m = n > m) /\ (!m n. BIT1 n > BIT1 m = n > m) val ( ARITH_EQ ) : thm = |- (!m n. (NUMERAL m = NUMERAL n) = m = n) /\ ((_0 = _0) = T) /\ (!n. (BIT0 n = _0) = n = _0) /\ (!n. (BIT1 n = _0) = F) /\ (!n. (_0 = BIT0 n) = _0 = n) /\ (!n. (_0 = BIT1 n) = F) /\ (!m n. (BIT0 m = BIT0 n) = m = n) /\ (!m n. (BIT0 m = BIT1 n) = F) /\ (!m n. (BIT1 m = BIT0 n) = F) /\ (!m n. (BIT1 m = BIT1 n) = m = n) val ( ARITH_SUB ) : thm = |- (!m n. NUMERAL m - NUMERAL n = NUMERAL (m - n)) /\ (_0 - _0 = _0) /\ (!n. _0 - BIT0 n = _0) /\ (!n. _0 - BIT1 n = _0) /\ (!n. BIT0 n - _0 = BIT0 n) /\ (!n. BIT1 n - _0 = BIT1 n) /\ (!m n. BIT0 m - BIT0 n = BIT0 (m - n)) /\ (!m n. BIT0 m - BIT1 n = PRE (BIT0 (m - n))) /\ (!m n. BIT1 m - BIT0 n = (if n <= m then BIT1 (m - n) else _0)) /\ (!m n. BIT1 m - BIT1 n = BIT0 (m - n)) val ( ARITH ) : thm = |- ((NUMERAL 0 = 0) /\ (BIT0 _0 = _0)) /\ ((!n. SUC (NUMERAL n) = NUMERAL (SUC n)) /\ (SUC _0 = BIT1 _0) /\ (!n. SUC (BIT0 n) = BIT1 n) /\ (!n. SUC (BIT1 n) = BIT0 (SUC n))) /\ ((!n. PRE (NUMERAL n) = NUMERAL (PRE n)) /\ (PRE _0 = _0) /\ (!n. PRE (BIT0 n) = (if n = _0 then _0 else BIT1 (PRE n))) /\ (!n. PRE (BIT1 n) = BIT0 n)) /\ ((!m n. NUMERAL m + NUMERAL n = NUMERAL (m + n)) /\ (_0 + _0 = _0) /\ (!n. _0 + BIT0 n = BIT0 n) /\ (!n. _0 + BIT1 n = BIT1 n) /\ (!n. BIT0 n + _0 = BIT0 n) /\ (!n. BIT1 n + _0 = BIT1 n) /\ (!m n. BIT0 m + BIT0 n = BIT0 (m + n)) /\ (!m n. BIT0 m + BIT1 n = BIT1 (m + n)) /\ (!m n. BIT1 m + BIT0 n = BIT1 (m + n)) /\ (!m n. BIT1 m + BIT1 n = BIT0 (SUC (m + n)))) /\ ((!m n. NUMERAL m * NUMERAL n = NUMERAL (m * n)) /\ (_0 * _0 = _0) /\ (!n. _0 * BIT0 n = _0) /\ (!n. _0 * BIT1 n = _0) /\ (!n. BIT0 n * _0 = _0) /\ (!n. BIT1 n * _0 = _0) /\ (!m n. BIT0 m * BIT0 n = BIT0 (BIT0 (m * n))) /\ (!m n. BIT0 m * BIT1 n = BIT0 m + BIT0 (BIT0 (m * n))) /\ (!m n. BIT1 m * BIT0 n = BIT0 n + BIT0 (BIT0 (m * n))) /\ (!m n. BIT1 m * BIT1 n = BIT1 m + BIT0 n + BIT0 (BIT0 (m * n)))) /\ ((!m n. NUMERAL m EXP NUMERAL n = NUMERAL (m EXP n)) /\ (_0 EXP _0 = BIT1 _0) /\ (!m. BIT0 m EXP _0 = BIT1 _0) /\ (!m. BIT1 m EXP _0 = BIT1 _0) /\ (!n. _0 EXP BIT0 n = _0 EXP n * _0 EXP n) /\ (!m n. BIT0 m EXP BIT0 n = BIT0 m EXP n * BIT0 m EXP n) /\ (!m n. BIT1 m EXP BIT0 n = BIT1 m EXP n * BIT1 m EXP n) /\ (!n. _0 EXP BIT1 n = _0) /\ (!m n. BIT0 m EXP BIT1 n = BIT0 m * BIT0 m EXP n * BIT0 m EXP n) /\ (!m n. BIT1 m EXP BIT1 n = BIT1 m * BIT1 m EXP n * BIT1 m EXP n)) /\ ((!n. EVEN (NUMERAL n) = EVEN n) /\ (EVEN _0 = T) /\ (!n. EVEN (BIT0 n) = T) /\ (!n. EVEN (BIT1 n) = F)) /\ ((!n. ODD (NUMERAL n) = ODD n) /\ (ODD _0 = F) /\ (!n. ODD (BIT0 n) = F) /\ (!n. ODD (BIT1 n) = T)) /\ ((!m n. (NUMERAL m = NUMERAL n) = m = n) /\ ((_0 = _0) = T) /\ (!n. (BIT0 n = _0) = n = _0) /\ (!n. (BIT1 n = _0) = F) /\ (!n. (_0 = BIT0 n) = _0 = n) /\ (!n. (_0 = BIT1 n) = F) /\ (!m n. (BIT0 m = BIT0 n) = m = n) /\ (!m n. (BIT0 m = BIT1 n) = F) /\ (!m n. (BIT1 m = BIT0 n) = F) /\ (!m n. (BIT1 m = BIT1 n) = m = n)) /\ ((!m n. NUMERAL m <= NUMERAL n = m <= n) /\ (_0 <= _0 = T) /\ (!n. BIT0 n <= _0 = n = _0) /\ (!n. BIT1 n <= _0 = F) /\ (!n. _0 <= BIT0 n = T) /\ (!n. _0 <= BIT1 n = T) /\ (!m n. BIT0 m <= BIT0 n = m <= n) /\ (!m n. BIT0 m <= BIT1 n = m <= n) /\ (!m n. BIT1 m <= BIT0 n = m < n) /\ (!m n. BIT1 m <= BIT1 n = m <= n)) /\ ((!m n. NUMERAL m < NUMERAL n = m < n) /\ (_0 < _0 = F) /\ (!n. BIT0 n < _0 = F) /\ (!n. BIT1 n < _0 = F) /\ (!n. _0 < BIT0 n = _0 < n) /\ (!n. _0 < BIT1 n = T) /\ (!m n. BIT0 m < BIT0 n = m < n) /\ (!m n. BIT0 m < BIT1 n = m <= n) /\ (!m n. BIT1 m < BIT0 n = m < n) /\ (!m n. BIT1 m < BIT1 n = m < n)) /\ ((!m n. NUMERAL n >= NUMERAL m = n >= m) /\ _0 >= _0 /\ (!n. _0 >= BIT0 n = n = _0) /\ (!n. ~(_0 >= BIT1 n)) /\ (!n. BIT0 n >= _0) /\ (!n. BIT1 n >= _0) /\ (!m n. BIT0 n >= BIT0 m = n >= m) /\ (!m n. BIT1 n >= BIT0 m = n >= m) /\ (!m n. BIT0 n >= BIT1 m = n > m) /\ (!m n. BIT1 n >= BIT1 m = n >= m)) /\ ((!m n. NUMERAL n > NUMERAL m = n > m) /\ ~(_0 > _0) /\ (!n. ~(_0 > BIT0 n)) /\ (!n. ~(_0 > BIT1 n)) /\ (!n. BIT0 n > _0 = n > _0) /\ (!n. BIT1 n > _0) /\ (!m n. BIT0 n > BIT0 m = n > m) /\ (!m n. BIT1 n > BIT0 m = n >= m) /\ (!m n. BIT0 n > BIT1 m = n > m) /\ (!m n. BIT1 n > BIT1 m = n > m)) /\ (!m n. NUMERAL m - NUMERAL n = NUMERAL (m - n)) /\ (_0 - _0 = _0) /\ (!n. _0 - BIT0 n = _0) /\ (!n. _0 - BIT1 n = _0) /\ (!n. BIT0 n - _0 = BIT0 n) /\ (!n. BIT1 n - _0 = BIT1 n) /\ (!m n. BIT0 m - BIT0 n = BIT0 (m - n)) /\ (!m n. BIT0 m - BIT1 n = PRE (BIT0 (m - n))) /\ (!m n. BIT1 m - BIT0 n = (if n <= m then BIT1 (m - n) else _0)) /\ (!m n. BIT1 m - BIT1 n = BIT0 (m - n)) NUM_SUC_CONV rewrites a term of the form `SUC k`, where k is a numeral. NUM_ADD_CONV rewrites a term of the form `j + k`, where j and k are numerals. NUM_SUC_CONV' and NUM_ADD_CONV' are the same, except that they expect numerals without the NUMERAL tag. NUM_PRE_CONV rewrites a term of the form `PRE k`, where k is a numeral. NUM_REL_CONV rewrites a term of the form `j OP k`, where j and k are numerals, and op is (<), (<=), (>), (>=), (=). NUM_REL_CONV' is the same, except that it expects numerals without the NUMERAL tag and does not deal with (>) or (>=). NUM_EQ_CONV, NUM_LE_CONV, NUM_LT_CONV, NUM_GE_CONV, NUM_GT_CONV Like NUM_REL_CONV, but only works if the op matches the conversion name. (You could always use NUM_REL_CONV instead of these, unless you deliberately want to fail on the wrong op. These will be very slightly more efficient.) NUM_EVEN_CONV, NUM_ODD_CONV rewrite terms of the form `EVEN k` and `ODD k` respectively, where k is a numeral. NUM_SUB_CONV rewrites a term of the form `j - k`, where j and k are numerals. NUM_MULT_CONV rewrites a term of the form `j * k`, where j and k are numerals. NUM_MULT_CONV' is the same, except that it expects numerals without the NUMERAL tag. NUM_EXP_CONV rewrites a term of the form `j EXP k`, where j and k are numerals. NUM_DIV_CONV and NUM_MOD_CONV rewrite terms of the forms `j DIV k` and `j MOD k` respectively, where j and k are numerals. NUM_DIVMOD_CONV (j:Num.num) (k:Num.num) produces a theorem `|- (J DIV K = JDIVK) /\ (J MOD K = JMODK)`, where J and K are the numerals for j and k, and JDIVK and JMODK are the appropriate numerals. (NUM_DIV_CONV and NUM_MID_CONV each call this function; if you need to compute both DIV and MOD, it's about twice as fast to do both together with NUM_DIVMOD_CONV.) NUM_FACT_CONV rewrites terms of the form `FACT k` where k is a numeral. NUM_RED_CONV reduces `SUC j`, `PRE j`, `FACT j`, `j < k`, `j <= k`, `j > k`, `j >= k`, `j = k`, `EVEN j`, `ODD j`, `j + k`, `j - k`, `j * k`, `j EXP k`, `j DIV k`, or `j MOD k` (where j and k are numerals). NUM_REDUCE_CONV reduces the above numeral expressions depth-first throughout the expression. NUM_REDUCE_TAC reduces numeral expressions in the goal. num_CONV rewrites `j` to `SUC (J-1)`, where J-1 is the numeral for j - 1. EXPAND_CASES_CONV rewrites `!n. n < 5 ==> P[n]` to `P[0] /\ P[1] /\ P[2] /\ P[3] /\ P[4]` ind-types.ml: val ( INJ_INVERSE2 ) : thm = |- !P. (!x1 y1 x2 y2. (P x1 y1 = P x2 y2) = (x1 = x2) /\ (y1 = y2)) ==> (?X Y. !x y. (X (P x y) = x) /\ (Y (P x y) = y)) This is the definition of NUMPAIR. val ( NUMPAIR ) : thm = |- !x y. NUMPAIR x y = 2 EXP x * (2 * y + 1) val ( NUMPAIR_INJ_LEMMA ) : thm = |- !x1 y1 x2 y2. (NUMPAIR x1 y1 = NUMPAIR x2 y2) ==> (x1 = x2) val ( NUMPAIR_INJ ) : thm = |- !x1 y1 x2 y2. (NUMPAIR x1 y1 = NUMPAIR x2 y2) = (x1 = x2) /\ (y1 = y2) This is the simultaneous definition of NUMFST and NUMSND (using new_specification). val ( NUMPAIR_DEST ) : thm = |- !x y. (NUMFST (NUMPAIR x y) = x) /\ (NUMSND (NUMPAIR x y) = y) This is the definition of NUMSUM. val ( NUMSUM ) : thm = |- !b x. NUMSUM b x = (if b then SUC (2 * x) else 2 * x) val ( NUMSUM_INJ ) : thm = |- !b1 x1 b2 x2. (NUMSUM b1 x1 = NUMSUM b2 x2) = (b1 = b2) /\ (x1 = x2) This is the simultaneous definition of NUMLEFT and NUMRIGHT (using new_specification). val ( NUMSUM_DEST ) : thm = |- !x y. (NUMLEFT (NUMSUM x y) = x) /\ (NUMRIGHT (NUMSUM x y) = y) This is the definition of INJN. val ( INJN ) : thm = |- !m. INJN m = (\n a. n = m) val ( INJN_INJ ) : thm = |- !n1 n2. (INJN n1 = INJN n2) = n1 = n2 This is the definition of INJA. val ( INJA ) : thm = |- !a. INJA a = (\n b. b = a) val ( INJA_INJ ) : thm = |- !a1 a2. (INJA a1 = INJA a2) = a1 = a2 This is the definition of INJF. val ( INJF ) : thm = |- !f. INJF f = (\n. f (NUMFST n) (NUMSND n)) val ( INJF_INJ ) : thm = |- !f1 f2. (INJF f1 = INJF f2) = f1 = f2 This is the definition of INJP. val ( INJP ) : thm = |- !f1 f2. INJP f1 f2 = (\n a. if NUMLEFT n then f1 (NUMRIGHT n) a else f2 (NUMRIGHT n) a) val ( INJP_INJ ) : thm = |- !f1 f1' f2 f2'. (INJP f1 f2 = INJP f1' f2') = (f1 = f1') /\ (f2 = f2') These are the definitions of ZCONSTR and ZBOT. val ( ZCONSTR ) : thm = |- !c i r. ZCONSTR c i r = INJP (INJN (SUC c)) (INJP (INJA i) (INJF r)) val ( ZBOT ) : thm = |- ZBOT = INJP (INJN 0) (@z. T) val ( ZCONSTR_ZBOT ) : thm = |- !c i r. ~(ZCONSTR c i r = ZBOT) This is the definition (via new_inductive_definition) of ZRECSPACE_ZBOT. val ( ZRECSPACE_RULES ) : thm = |- ZRECSPACE ZBOT /\ (!c i r. (!n. ZRECSPACE (r n)) ==> ZRECSPACE (ZCONSTR c i r)) val ( ZRECSPACE_INDUCT ) : thm = |- !ZRECSPACE'. ZRECSPACE' ZBOT /\ (!c i r. (!n. ZRECSPACE' (r n)) ==> ZRECSPACE' (ZCONSTR c i r)) ==> (!a. ZRECSPACE a ==> ZRECSPACE' a) val ( ZRECSPACE_CASES ) : thm = |- !a. ZRECSPACE a = (a = ZBOT) \/ (?c i r. (a = ZCONSTR c i r) /\ (!n. ZRECSPACE (r n))) This is the definition of a new type, "(A)recspace"; and its in and out functions, "_mk_rec" and "_dest_rec". val recspace_tydef : thm * thm = (|- _mk_rec (_dest_rec a) = a, |- ZRECSPACE r = _dest_rec (_mk_rec r) = r) These are the definitions of BOTTOM and CONSTR. val ( BOTTOM ) : thm = |- BOTTOM = _mk_rec ZBOT val ( CONSTR ) : thm = |- !c i r. CONSTR c i r = _mk_rec (ZCONSTR c i (\n. _dest_rec (r n))) val ( MK_REC_INJ ) : thm = |- !x y. (_mk_rec x = _mk_rec y) ==> ZRECSPACE x /\ ZRECSPACE y ==> (x = y) val ( DEST_REC_INJ ) : thm = |- !x y. (_dest_rec x = _dest_rec y) = x = y val ( CONSTR_BOT ) : thm = |- !c i r. ~(CONSTR c i r = BOTTOM) val ( CONSTR_INJ ) : thm = |- !c1 i1 r1 c2 i2 r2. (CONSTR c1 i1 r1 = CONSTR c2 i2 r2) = (c1 = c2) /\ (i1 = i2) /\ (r1 = r2) val ( CONSTR_IND ) : thm = |- !P. P BOTTOM /\ (!c i r. (!n. P (r n)) ==> P (CONSTR c i r)) ==> (!x. P x) val ( CONSTR_REC ) : thm = |- !Fn. ?f. !c i r. f (CONSTR c i r) = Fn c i r (\n. f (r n)) This is the definition of FCONS. val ( FCONS ) : thm = |- (!a f. FCONS a f 0 = a) /\ (!a f n. FCONS a f (SUC n) = f n) val ( FCONS_UNDO ) : thm = |- !f. f = FCONS (f 0) (f o SUC) This is the definition of FNIL. val ( FNIL ) : thm = |- !n. FNIL n = (@x. T) sucivate 5 = `SUC (SUC (SUC (SUC (SUC 0))))` (for example) SCRUB_EQUATION `x = a` `x = a |- P[x]` gives `|- P[a]` list.ml: LIST_INDUCT_TAC takes a goal of the form `!l. P[l]` and creates two subgoals: `P[ [] ]` and `P[CONS h t]`. The latter subgoal has a new assumption `P[t]`. Definitions of list-related functions: val ( HD ) : thm = |- HD (CONS h t) = h val ( TL ) : thm = |- TL (CONS h t) = t val ( APPEND ) : thm = |- (!l. APPEND [] l = l) /\ (!h t l. APPEND (CONS h t) l = CONS h (APPEND t l)) val ( REVERSE ) : thm = |- (REVERSE [] = []) /\ (REVERSE (CONS x l) = APPEND (REVERSE l) [x]) val ( LENGTH ) : thm = |- (LENGTH [] = 0) /\ (!h t. LENGTH (CONS h t) = SUC (LENGTH t)) val ( MAP ) : thm = |- (!f. MAP f [] = []) /\ (!f h t. MAP f (CONS h t) = CONS (f h) (MAP f t)) val ( LAST ) : thm = |- LAST (CONS h t) = (if t = [] then h else LAST t) val ( REPLICATE ) : thm = |- (REPLICATE 0 x = []) /\ (REPLICATE (SUC n) x = CONS x (REPLICATE n x)) val ( NULL ) : thm = |- (NULL [] = T) /\ (NULL (CONS h t) = F) val ( ALL ) : thm = |- (ALL P [] = T) /\ (ALL P (CONS h t) = P h /\ ALL P t) val ( EX ) : thm = |- (EX P [] = F) /\ (EX P (CONS h t) = P h \/ EX P t) val ( ITLIST ) : thm = |- (ITLIST f [] b = b) /\ (ITLIST f (CONS h t) b = f h (ITLIST f t b)) val ( MEM ) : thm = |- (MEM x [] = F) /\ (MEM x (CONS h t) = (x = h) \/ MEM x t) val ( ALL2_DEF ) : thm = |- (ALL2 P [] l2 = l2 = []) /\ (ALL2 P (CONS h1 t1) l2 = (if l2 = [] then F else P h1 (HD l2) /\ ALL2 P t1 (TL l2))) val ( MAP2_DEF ) : thm = |- (MAP2 f [] l = []) /\ (MAP2 f (CONS h1 t1) l = CONS (f h1 (HD l)) (MAP2 f t1 (TL l))) val ( EL ) : thm = |- (EL 0 l = HD l) /\ (EL (SUC n) l = EL n (TL l)) val ( FILTER ) : thm = |- (FILTER P [] = []) /\ (FILTER P (CONS h t) = (if P h then CONS h (FILTER P t) else FILTER P t)) val ( ASSOC ) : thm = |- ASSOC a (CONS h t) = (if FST h = a then SND h else ASSOC a t) val ( ITLIST2_DEF ) : thm = |- (ITLIST2 f [] l2 b = b) /\ (ITLIST2 f (CONS h1 t1) l2 b = f h1 (HD l2) (ITLIST2 f t1 (TL l2) b)) val ( ZIP_DEF ) : thm = |- (ZIP [] l2 = []) /\ (ZIP (CONS h1 t1) l2 = CONS (h1,HD l2) (ZIP t1 (TL l2))) More convenient forms of some of the above: val ( ALL2 ) : thm = |- (ALL2 P [] [] = T) /\ (ALL2 P (CONS h1 t1) [] = F) /\ (ALL2 P [] (CONS h2 t2) = F) /\ (ALL2 P (CONS h1 t1) (CONS h2 t2) = P h1 h2 /\ ALL2 P t1 t2) val ( MAP2 ) : thm = |- (MAP2 f [] [] = []) /\ (MAP2 f (CONS h1 t1) (CONS h2 t2) = CONS (f h1 h2) (MAP2 f t1 t2)) val ( ITLIST2 ) : thm = |- (ITLIST2 f [] [] b = b) /\ (ITLIST2 f (CONS h1 t1) (CONS h2 t2) b = f h1 h2 (ITLIST2 f t1 t2 b)) val ( ZIP ) : thm = |- (ZIP [] [] = []) /\ (ZIP (CONS h1 t1) (CONS h2 t2) = CONS (h1,h2) (ZIP t1 t2)) val ( NOT_CONS_NIL ) : thm = |- !h t. ~(CONS h t = []) val ( LAST_CLAUSES ) : thm = |- (LAST [h] = h) /\ (LAST (CONS h (CONS k t)) = LAST (CONS k t)) val ( APPEND_NIL ) : thm = |- !l. APPEND l [] = l val ( APPEND_ASSOC ) : thm = |- !l m n. APPEND l (APPEND m n) = APPEND (APPEND l m) n val ( REVERSE_APPEND ) : thm = |- !l m. REVERSE (APPEND l m) = APPEND (REVERSE m) (REVERSE l) val ( REVERSE_REVERSE ) : thm = |- !l. REVERSE (REVERSE l) = l val ( CONS_11 ) : thm = |- !h1 h2 t1 t2. (CONS h1 t1 = CONS h2 t2) = (h1 = h2) /\ (t1 = t2) val list_CASES : thm = |- !l. (l = []) \/ (?h t. l = CONS h t) val ( LENGTH_APPEND ) : thm = |- !l m. LENGTH (APPEND l m) = LENGTH l + LENGTH m val ( MAP_APPEND ) : thm = |- !f l1 l2. MAP f (APPEND l1 l2) = APPEND (MAP f l1) (MAP f l2) val ( LENGTH_MAP ) : thm = |- !l f. LENGTH (MAP f l) = LENGTH l val ( LENGTH_EQ_NIL ) : thm = |- !l. (LENGTH l = 0) = l = [] val ( MAP_o ) : thm = |- !f g l. MAP (g o f) l = MAP g (MAP f l) val ( MAP_EQ ) : thm = |- !f g l. ALL (\x. f x = g x) l ==> (MAP f l = MAP g l) val ( ALL_IMP ) : thm = |- !P Q l. (!x. MEM x l /\ P x ==> Q x) /\ ALL P l ==> ALL Q l val ( NOT_EX ) : thm = |- !P l. ~EX P l = ALL (\x. ~P x) l val ( NOT_ALL ) : thm = |- !P l. ~ALL P l = EX (\x. ~P x) l val ( ALL_MAP ) : thm = |- !P f l. ALL P (MAP f l) = ALL (P o f) l val ( ALL_T ) : thm = |- !l. ALL (\x. T) l val ( MAP_EQ_ALL2 ) : thm = |- !l m. ALL2 (\x y. f x = f y) l m ==> (MAP f l = MAP f m) val ( ALL2_MAP ) : thm = |- !P f l. ALL2 P (MAP f l) l = ALL (\a. P (f a) a) l val ( MAP_EQ_DEGEN ) : thm = |- !l f. ALL (\x. f x = x) l ==> (MAP f l = l) val ( ALL2_AND_RIGHT ) : thm = |- !l m P Q. ALL2 (\x y. P x /\ Q x y) l m = ALL P l /\ ALL2 Q l m val ( ITLIST_EXTRA ) : thm = |- !l. ITLIST f (APPEND l [a]) b = ITLIST f l (f a b) val ( ALL_MP ) : thm = |- !P Q l. ALL (\x. P x ==> Q x) l /\ ALL P l ==> ALL Q l val ( FORALL_ALL ) : thm = |- !l. (!x. ALL (P x) l) = ALL (\a. !x. P x a) l val ( AND_ALL ) : thm = |- !l. ALL P l /\ ALL Q l = ALL (\x. P x /\ Q x) l val ( EX_IMP ) : thm = |- !P Q l. (!x. MEM x l /\ P x ==> Q x) /\ EX P l ==> EX Q l val ( ALL_MEM ) : thm = |- !P l. (!x. MEM x l ==> P x) = ALL P l val ( LENGTH_REPLICATE ) : thm = |- !n x. LENGTH (REPLICATE n x) = n val ( EX_MAP ) : thm = |- !P f l. EX P (MAP f l) = EX (P o f) l val ( EXISTS_EX ) : thm = |- !P l. (?x. EX (P x) l) = EX (\s. ?x. P x s) l val ( FORALL_ALL ) : thm = |- !P l. (!x. ALL (P x) l) = ALL (\s. !x. P x s) l val ( MEM_APPEND ) : thm = |- !x l1 l2. MEM x (APPEND l1 l2) = MEM x l1 \/ MEM x l2 val ( MEM_MAP ) : thm = |- !f y l. MEM y (MAP f l) = (?x. MEM x l /\ (y = f x)) val ( FILTER_APPEND ) : thm = |- !P l1 l2. FILTER P (APPEND l1 l2) = APPEND (FILTER P l1) (FILTER P l2) val ( FILTER_MAP ) : thm = |- !P f l. FILTER P (MAP f l) = MAP f (FILTER (P o f) l) val ( MEM_FILTER ) : thm = |- !P l x. MEM x (FILTER P l) = P x /\ MEM x l val ( EX_MEM ) : thm = |- !P l. EX P l = (?x. P x /\ MEM x l) val ( MAP_FST_ZIP ) : thm = |- !l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP FST (ZIP l1 l2) = l1) val ( MAP_SND_ZIP ) : thm = |- !l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP SND (ZIP l1 l2) = l2) val ( MEM_ASSOC ) : thm = |- !l x. MEM (x,ASSOC x l) l = MEM x (MAP FST l) val ( ALL_APPEND ) : thm = |- !P l1 l2. ALL P (APPEND l1 l2) = ALL P l1 /\ ALL P l2 val ( MEM_EL ) : thm = |- !l n. n < LENGTH l ==> MEM (EL n l) l val ( ALL2_MAP2 ) : thm = |- !l m. ALL2 P (MAP f l) (MAP g m) = ALL2 (\x y. P (f x) (g y)) l m val ( AND_ALL2 ) : thm = |- !P Q l m. ALL2 P l m /\ ALL2 Q l m = ALL2 (\x y. P x y /\ Q x y) l m val ( ALL2_ALL ) : thm = |- !P l. ALL2 P l l = ALL (\x. P x x) l val ( APPEND_EQ_NIL ) : thm = |- !l m. (APPEND l m = []) = (l = []) /\ (m = []) val ( MONO_ALL ) : thm = |- (!x. P x ==> Q x) ==> ALL P l ==> ALL Q l val ( MONO_ALL2 ) : thm = |- (!x y. P x y ==> Q x y) ==> ALL2 P l l' ==> ALL2 Q l l' MONO_ALL and MONO_ALL2 will automatically be used by MONO_TAC. LIST_CONV conv uses conv to rewrite every member of a (literal) list. realax.ml: The operators +,-,*,<,<=,>,>= are overloaded; there are versions for num, real, int. If an expression does not make it clear which type is used, they default to the current "prioritized" type. pioritize_num() sets operator overloading to default to the type num. This is the definition of dist. val dist : thm = |- !n m. dist (m,n) = m - n + n - m val ( DIST_REFL ) : thm = |- !n. dist (n,n) = 0 val ( DIST_LZERO ) : thm = |- !n. dist (0,n) = n val ( DIST_RZERO ) : thm = |- !n. dist (n,0) = n val ( DIST_SYM ) : thm = |- !m n. dist (m,n) = dist (n,m) val ( DIST_LADD ) : thm = |- !m p n. dist (m + n,m + p) = dist (n,p) val ( DIST_RADD ) : thm = |- !m p n. dist (m + p,n + p) = dist (m,n) val ( DIST_LADD_0 ) : thm = |- !m n. dist (m + n,m) = n val ( DIST_RADD_0 ) : thm = |- !m n. dist (m,m + n) = n val ( DIST_LMUL ) : thm = |- !m n p. m * dist (n,p) = dist (m * n,m * p) val ( DIST_RMUL ) : thm = |- !m n p. dist (m,n) * p = dist (m * p,n * p) val ( DIST_EQ_0 ) : thm = |- !m n. (dist (m,n) = 0) = m = n val ( DIST_ELIM_THM ) : thm = |- P (dist (x,y)) = (!d. ((x = y + d) ==> P d) /\ ((y = x + d) ==> P d)) hol-light/Quaternions/000077500000000000000000000000001303454263000152555ustar00rootroot00000000000000hol-light/Quaternions/COPYING000066400000000000000000000025031303454263000163100ustar00rootroot00000000000000 Copyright (c) Marco Maggesi 2014 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: o Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. o Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hol-light/Quaternions/make.ml000066400000000000000000000020331303454263000165220ustar00rootroot00000000000000(* ========================================================================= *) (* Quaternionic calculus. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) needs "Multivariate/derivatives.ml";; needs "Multivariate/complexes.ml";; prioritize_real ();; loadt "Quaternions/misc.hl";; (* Miscellanea *) loadt "Quaternions/quaternion.hl";; (* Basic definitions about quaternions *) loadt "Quaternions/qcalc.hl";; (* Computing with literal quaternions *) loadt "Quaternions/qnormalizer.hl";; (* Normalization of quat. polynomials *) loadt "Quaternions/qanal.hl";; (* Quaternionic analysis *) loadt "Quaternions/qderivative.hl";; (* Differential of quat. functions *) loadt "Quaternions/qisom.hl";; (* Space isometries via quaternions *) hol-light/Quaternions/misc.hl000066400000000000000000000062141303454263000165400ustar00rootroot00000000000000(* ========================================================================= *) (* Miscellanea. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Instrument classical tactics to attach label to generated hypothesis. *) (* ------------------------------------------------------------------------- *) let INDUCT_TAC = let IND_TAC = MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC in fun (asl,w as gl) -> let s = fst (dest_var (fst (dest_forall w))) in (IND_TAC THENL [ALL_TAC; GEN_TAC THEN DISCH_THEN (LABEL_TAC("ind_"^s))]) gl;; (* ------------------------------------------------------------------------- *) (* Further tactics that promote the use of labeled hypothesis. *) (* ------------------------------------------------------------------------- *) let CASES_TAC s tm = let th = SPEC tm EXCLUDED_MIDDLE in DISJ_CASES_THEN2 (LABEL_TAC s) (LABEL_TAC ("not_"^s)) th;; (* ------------------------------------------------------------------------- *) (* Further tactics for structuring the proof flow. *) (* ------------------------------------------------------------------------- *) let MP_LIST_TAC = MP_TAC o end_itlist CONJ;; (* ------------------------------------------------------------------------- *) (* Lemmata about vectors and euclidean geometry. *) (* ------------------------------------------------------------------------- *) let VECTOR_EQ_1 = prove (`!u v:real^1. u = v <=> u$1 = v$1`, REWRITE_TAC[CART_EQ; DIMINDEX_1; FORALL_1]);; let VECTOR_EQ_2 = prove (`!u v:real^2. u = v <=> u$1 = v$1 /\ u$2 = v$2`, REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2]);; let VECTOR_EQ_3 = prove (`!u v:real^3. u = v <=> u$1 = v$1 /\ u$2 = v$2 /\ u$3 = v$3`, REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3]);; let VECTOR_EQ_4 = prove (`!u v:real^4. u = v <=> u$1 = v$1 /\ u$2 = v$2 /\ u$3 = v$3 /\ u$4 = v$4`, REWRITE_TAC[CART_EQ; DIMINDEX_4; FORALL_4]);; let DOT_LBASIS = prove (`!i x:real^N. 1 <= i /\ i <= dimindex(:N) ==> basis i dot x = x$i`, INTRO_TAC "!i x; ihp" THEN REWRITE_TAC[dot] THEN TRANS_TAC EQ_TRANS `sum {i} (\j. (basis i:real^N)$j * (x:real^N)$j)` THEN CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_SING; BASIS_COMPONENT; REAL_MUL_LID]] THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM_REWRITE_TAC[SING_SUBSET; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_SING] THEN INTRO_TAC "jhp neq" THEN ASM_SIMP_TAC[BASIS_COMPONENT; REAL_MUL_LZERO]);; let DOT_RBASIS = prove (`!x:real^N i. 1 <= i /\ i <= dimindex(:N) ==> x dot basis i = x$i`, MESON_TAC[DOT_SYM; DOT_LBASIS]);; let VECTOR_NORM_SQNORM_UNIT = prove (`!x:real^N. norm x pow 2 = &1 <=> norm x = &1`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_POW_ONE] THEN REWRITE_TAC[REAL_ARITH `a pow 2 = &1 <=> (a - &1) * (a + &1) = &0`; REAL_ENTIRE] THEN CONV_TAC NORM_ARITH);; hol-light/Quaternions/qanal.hl000066400000000000000000000501401303454263000166760ustar00rootroot00000000000000(* ========================================================================= *) (* Quaternionic analysis. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) prioritize_quat();; (* ------------------------------------------------------------------------- *) (* Lemmata on quaternions. *) (* ------------------------------------------------------------------------- *) let QUAT_SQNORM_MUL = prove (`!q. norm q pow 2 = Re(cnj q * q)`, REWRITE_TAC[QUAT_SQNORM; quat_cnj; quat_mul; QUAT_COMPONENTS] THEN GEN_TAC THEN CONV_TAC(BINOP_CONV REAL_POLY_CONV) THEN REFL_TAC);; let QUAT_INV_POW = prove (`!x n. inv (x pow n) = inv x pow n`, GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[quat_pow; QUAT_INV_1]; GEN_REWRITE_TAC RAND_CONV [quat_pow] THEN ASM_REWRITE_TAC[QUAT_POW_SUC_ALT; QUAT_INV_MUL]]);; let QUAT_NORM_IMG = prove (`!x. Re x = &0 ==> x pow 2 = --(Hx(norm x) pow 2)`, REWRITE_TAC[QUAT_NORM_POW_2] THEN REWRITE_TAC[QUAT_POW_2; FORALL_QUAT; QUAT_EQ] THEN REWRITE_TAC[quat_mul; QUAT_COMPONENTS; HX_COMPONENTS; QUAT_NEG_COMPONENTS; QUAT_CNJ_COMPONENTS; CNJ_QUAT] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Quat-specific uniform limit composition theorems. *) (* ------------------------------------------------------------------------- *) let UNIFORM_LIM_QUAT_MUL = prove (`!net:(A)net P f g l m b1 b2. eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ eventually (\x. !n. P n ==> norm(m n) <= b2) net /\ (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm(f n x * g n x - l n * m n) < e) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o CONJ BILINEAR_QUAT_MUL) THEN REWRITE_TAC[UNIFORM_LIM_BILINEAR]);; let UNIFORM_LIM_QUAT_INV = prove (`!net:(A)net P f l b. (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ &0 < b /\ eventually (\x. !n. P n ==> b <= norm(l n)) net ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm(inv(f n x) - inv(l n)) < e) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC `\x. !n. P n ==> b <= norm(l n) /\ b / &2 <= norm((f:B->A->quat) n x) /\ norm(f n x - l n) < e * b pow 2 / &2` THEN REWRITE_TAC[TAUT `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL [X_GEN_TAC `x:A` THEN STRIP_TAC THEN X_GEN_TAC `n:B` THEN DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:B`) THEN ASM_REWRITE_TAC[]) THEN REPEAT DISCH_TAC THEN SUBGOAL_THEN `~((f:B->A->quat) n x = Hx(&0)) /\ ~(l n = Hx(&0))` STRIP_ASSUME_TAC THENL [CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[NORM_HX]) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!p q. ~(p = Hx(&0)) /\ ~(q = Hx(&0)) ==> inv p - inv q = inv p * (q - p) * inv q` (fun th -> ASM_SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC QUAT_MUL_LCANCEL THEN EXISTS_TAC `p:quat` THEN ASM_SIMP_TAC[QUAT_SUB_LDISTRIB; QUAT_MUL_ASSOC; QUAT_MUL_RINV; QUAT_MUL_LID] THEN MATCH_MP_TAC QUAT_MUL_RCANCEL THEN EXISTS_TAC `q:quat` THEN ASM_SIMP_TAC[QUAT_SUB_RDISTRIB; GSYM QUAT_MUL_ASSOC; QUAT_MUL_LINV; QUAT_MUL_RID; QUAT_MUL_LID]; ALL_TAC] THEN REWRITE_TAC[QUAT_NORM_MUL; QUAT_NORM_INV] THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `norm ((l:B->quat) n)` THEN ASM_SIMP_TAC[QUAT_NORM_NZ; QUAT_NORM_ZERO; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `norm ((f:B->A->quat) n x)` THEN ASM_SIMP_TAC[QUAT_NORM_NZ; QUAT_NORM_ZERO; REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN REWRITE_TAC [REAL_ARITH `(a * e) * b = e * a * b:real`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `b pow 2 / &2 = b / &2 * b`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `b / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[NORM_ARITH `b <= norm l /\ norm(f - l) < b / &2 ==> b / &2 <= norm f`]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_HALF; REAL_POW_LT; REAL_LT_MUL]]]);; (* ------------------------------------------------------------------------- *) (* The usual non-uniform versions. *) (* ------------------------------------------------------------------------- *) let LIM_QUAT_MUL = prove (`!net:(A)net f g l m. (f --> l) net /\ (g --> m) net ==> ((\x. f x * g x) --> l * m) net`, SIMP_TAC[LIM_BILINEAR; BILINEAR_QUAT_MUL]);; let LIM_QUAT_INV = prove (`!net:(A)net f l. (f --> l) net /\ ~(l = Hx(&0)) ==> ((\x. inv(f x)) --> inv(l)) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `\x:one. T`; `\n:one. (f:A->quat)`; `\n:one. (l:quat)`; `norm(l:quat)`] UNIFORM_LIM_QUAT_INV) THEN ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN ASM_REWRITE_TAC[GSYM dist; GSYM tendsto; QUAT_NORM_NZ]);; let LIM_QUAT_POW = prove (`!net:(A)net f l n. (f --> l) net ==> ((\x. f(x) pow n) --> l pow n) net`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[LIM_QUAT_MUL; quat_pow; LIM_CONST]);; let LIM_QUAT_LMUL = prove (`!f l c. (f --> l) net ==> ((\x:A. c * f x) --> c * l) net`, SIMP_TAC[LIM_QUAT_MUL; LIM_CONST]);; let LIM_QUAT_RMUL = prove (`!f l c. (f --> l) net ==> ((\x:A. f x * c) --> l * c) net`, SIMP_TAC[LIM_QUAT_MUL; LIM_CONST]);; (* ------------------------------------------------------------------------- *) (* Special cases of null limits. *) (* ------------------------------------------------------------------------- *) let LIM_NULL_QUAT_NEG = prove (`!net f. (f --> Hx(&0)) net ==> ((\x:A. --(f x)) --> Hx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN REWRITE_TAC[QUAT_NEG_0]);; let LIM_NULL_QUAT_ADD = prove (`!net f g. (f --> Hx(&0)) net /\ (g --> Hx(&0)) net ==> ((\x:A. f x + g x) --> Hx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN REWRITE_TAC[QUAT_ADD_LID]);; let LIM_NULL_QUAT_SUB = prove (`!net f g. (f --> Hx(&0)) net /\ (g --> Hx(&0)) net ==> ((\x:A. f x - g x) --> Hx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REWRITE_TAC[QUAT_SUB_REFL]);; let LIM_NULL_QUAT_MUL = prove (`!net f g. (f --> Hx(&0)) net /\ (g --> Hx(&0)) net ==> ((\x:A. f x * g x) --> Hx(&0)) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_QUAT_MUL) THEN REWRITE_TAC[QUAT_MUL_LZERO]);; let LIM_NULL_QUAT_LMUL = prove (`!net f c. (f --> Hx(&0)) net ==> ((\x:A. c * f x) --> Hx(&0)) net`, REPEAT STRIP_TAC THEN SUBST1_TAC(QUAT_POLY `Hx(&0) = c * Hx(&0)`) THEN ASM_SIMP_TAC[LIM_QUAT_LMUL]);; let LIM_NULL_QUAT_RMUL = prove (`!net f c. (f --> Hx(&0)) net ==> ((\x:A. f x * c) --> Hx(&0)) net`, REPEAT STRIP_TAC THEN SUBST1_TAC(QUAT_POLY `Hx(&0) = Hx(&0) * c`) THEN ASM_SIMP_TAC[LIM_QUAT_RMUL]);; let LIM_NULL_QUAT_POW = prove (`!net f n. (f --> Hx(&0)) net /\ ~(n = 0) ==> ((\x:A. (f x) pow n) --> Hx(&0)) net`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP LIM_QUAT_POW) THEN ASM_REWRITE_TAC[QUAT_POW_ZERO]);; let LIM_NULL_QUAT_BOUND = prove (`!net:(A)net f g. eventually (\n. norm (f n) <= norm (g n)) net /\ (g --> Hx(&0)) net ==> (f --> Hx(&0)) net`, REWRITE_TAC[GSYM QUAT_VEC_0; LIM_TRANSFORM_BOUND]);; let SUMS_QUAT_0 = prove (`!f s. (!n. n IN s ==> f n = Hx(&0)) ==> (f sums Hx(&0)) s`, REWRITE_TAC[GSYM QUAT_VEC_0; SUMS_0]);; let LIM_NULL_QUAT_RMUL_BOUNDED = prove (`!f g. (f --> Hx(&0)) net /\ eventually (\a:A. norm(g a) <= B) net ==> ((\z. f(z) * g(z)) --> Hx(&0)) net`, REWRITE_TAC[GSYM QUAT_VEC_0] THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[QUAT_NORM_MUL; LIFT_CMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[o_DEF; NORM_LIFT; REAL_ABS_NORM] THEN MATCH_MP_TAC EVENTUALLY_MONO THEN ASM_MESON_TAC[]);; let LIM_NULL_QUAT_LMUL_BOUNDED = prove (`!net:(A)net f g. eventually (\a. norm(f a) <= B) net /\ (g --> Hx(&0)) net ==> ((\z. f(z) * g(z)) --> Hx(&0)) net`, REWRITE_TAC[GSYM QUAT_VEC_0] THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN REWRITE_TAC[QUAT_NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[o_DEF; NORM_LIFT; REAL_ABS_NORM] THEN MATCH_MP_TAC EVENTUALLY_MONO THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Bound results for real and imaginary components of limits. *) (* ------------------------------------------------------------------------- *) let LIM_QUAT_RE_UBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. Re(f x) <= b) net ==> Re(l) <= b`, REWRITE_TAC[QUAT_RE_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `1`] LIM_COMPONENT_UBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let LIM_IM1_UBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. Im1(f x) <= b) net ==> Im1(l) <= b`, REWRITE_TAC[QUAT_IM1_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `2`] LIM_COMPONENT_UBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let LIM_IM2_UBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. Im2(f x) <= b) net ==> Im2(l) <= b`, REWRITE_TAC[QUAT_IM2_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `3`] LIM_COMPONENT_UBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let LIM_IM3_UBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. Im3(f x) <= b) net ==> Im3(l) <= b`, REWRITE_TAC[QUAT_IM3_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `4`] LIM_COMPONENT_UBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let QUAT_LIM_UBOUND_COMPONENTS = end_itlist CONJ [LIM_QUAT_RE_UBOUND; LIM_IM1_UBOUND; LIM_IM2_UBOUND; LIM_IM3_UBOUND];; let LIM_QUAT_RE_LBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= Re(f x)) net ==> b <= Re(l)`, REWRITE_TAC[QUAT_RE_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `1`] LIM_COMPONENT_LBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let LIM_IM1_LBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= Im1(f x)) net ==> b <= Im1(l)`, REWRITE_TAC[QUAT_IM1_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `2`] LIM_COMPONENT_LBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let LIM_IM2_LBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= Im2(f x)) net ==> b <= Im2(l)`, REWRITE_TAC[QUAT_IM2_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `3`] LIM_COMPONENT_LBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let LIM_IM3_LBOUND = prove (`!net:(A)net f l b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= Im3(f x)) net ==> b <= Im3(l)`, REWRITE_TAC[QUAT_IM3_DEF] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->quat`; `l:quat`; `b:real`; `4`] LIM_COMPONENT_LBOUND) THEN ASM_REWRITE_TAC[DIMINDEX_4; ARITH]);; let QUAT_LIM_LBOUND_COMPONENTS = end_itlist CONJ [LIM_QUAT_RE_LBOUND; LIM_IM1_LBOUND; LIM_IM2_LBOUND; LIM_IM3_LBOUND];; (* ------------------------------------------------------------------------- *) (* Left and right multiplication of series. *) (* ------------------------------------------------------------------------- *) let SERIES_QUAT_LMUL = prove (`!f l c s. (f sums l) s ==> ((\x. c * f x) sums c * l) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[LINEAR_QUAT_LMUL]);; let SERIES_QUAT_RMUL = prove (`!f l c s. (f sums l) s ==> ((\x. f x * c) sums l * c) s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `((\x. (\y. y * c) (f x)) sums (\y. y * c) l) s` (fun th -> MP_TAC th THEN REWRITE_TAC[]) THEN MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[LINEAR_QUAT_RMUL]);; let SUMMABLE_QUAT_LMUL = prove (`!f c s. summable s f ==> summable s (\x. c * f x)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_QUAT_LMUL]);; let SUMMABLE_QUAT_RMUL = prove (`!f c s. summable s f ==> summable s (\x. f x * c)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_QUAT_RMUL]);; (* ------------------------------------------------------------------------- *) (* Quat-specific continuity closures. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_QUAT_MUL = prove (`!net:(A)net f g. f continuous net /\ g continuous net ==> (\x. f(x) * g(x)) continuous net`, SIMP_TAC[continuous; LIM_QUAT_MUL]);; let CONTINUOUS_QUAT_INV = prove (`!net:(A)net f. f continuous net /\ ~(f(netlimit net) = Hx(&0)) ==> (\x. inv(f x)) continuous net`, SIMP_TAC[continuous; LIM_QUAT_INV]);; let CONTINUOUS_QUAT_POW = prove (`!net:(A)net f n. f continuous net ==> (\x. f(x) pow n) continuous net`, SIMP_TAC[continuous; LIM_QUAT_POW]);; (* ------------------------------------------------------------------------- *) (* Write away the netlimit, which is otherwise a bit tedious. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_QUAT_INV_WITHIN = prove (`!f s a. f continuous (at a within s) /\ ~(f a = Hx(&0)) ==> (\x:real^N. inv(f x)) continuous (at a within s)`, MESON_TAC[CONTINUOUS_QUAT_INV; CONTINUOUS_TRIVIAL_LIMIT; NETLIMIT_WITHIN]);; let CONTINUOUS_QUAT_INV_AT = prove (`!f a. f continuous (at a) /\ ~(f a = Hx(&0)) ==> (\x:real^N. inv(f x)) continuous (at a)`, SIMP_TAC[CONTINUOUS_QUAT_INV; NETLIMIT_AT]);; (* ------------------------------------------------------------------------- *) (* Also prove "on" variants as needed. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_QUAT_MUL = prove (`!f g s. f continuous_on s /\ g continuous_on s ==> (\x:real^N. f(x) * g(x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_QUAT_MUL]);; let CONTINUOUS_ON_QUAT_LMUL = prove (`!f:real^N->quat s. f continuous_on s ==> (\x. c * f(x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON] THEN SIMP_TAC[LIM_QUAT_MUL; LIM_CONST]);; let CONTINUOUS_ON_QUAT_RMUL = prove (`!f:real^N->quat s. f continuous_on s ==> (\x. f(x) * c) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON] THEN SIMP_TAC[LIM_QUAT_MUL; LIM_CONST]);; let CONTINUOUS_ON_QUAT_INV = prove (`!f:real^N->quat. f continuous_on s /\ (!x. x IN s ==> ~(f x = Hx(&0))) ==> (\x. inv(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_QUAT_INV_WITHIN]);; let CONTINUOUS_ON_QUAT_POW = prove (`!f n s. f continuous_on s ==> (\x:real^N. f(x) pow n) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_QUAT_POW]);; (* ------------------------------------------------------------------------- *) (* Continuity of the norm. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_AT_HX_NORM = prove (`!z:real^N. (\z. Hx(norm z)) continuous at z`, REWRITE_TAC[continuous_at; dist; GSYM HX_SUB; NORM_HX] THEN MESON_TAC[NORM_ARITH `norm(a - b:real^N) < d ==> abs(norm a - norm b) < d`]);; let CONTINUOUS_WITHIN_HX_NORM = prove (`!z:real^N s. (\z. Hx(norm z)) continuous (at z within s)`, SIMP_TAC[CONTINUOUS_AT_HX_NORM; CONTINUOUS_AT_WITHIN]);; let CONTINUOUS_ON_HX_NORM = prove (`!s. (\z:real^N. Hx(norm z)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_HX_NORM]);; let CONTINUOUS_AT_HX_DOT = prove (`!c z:real^N. (\z. Hx(c dot z)) continuous at z`, REPEAT GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear; DOT_RADD; DOT_RMUL; HX_ADD; QUAT_CMUL; HX_MUL]);; let CONTINUOUS_WITHIN_HX_DOT = prove (`!c z:real^N s. (\z. Hx(c dot z)) continuous (at z within s)`, SIMP_TAC[CONTINUOUS_AT_HX_DOT; CONTINUOUS_AT_WITHIN]);; let CONTINUOUS_ON_HX_DOT = prove (`!s c:real^N. (\z. Hx(c dot z)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_HX_DOT]);; (* ------------------------------------------------------------------------- *) (* Continuity switching range between quat and real^1 *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_HX_DROP = prove (`!net f. f continuous net ==> (\x:A. Hx(drop(f x))) continuous net`, REWRITE_TAC[continuous; tendsto] THEN REWRITE_TAC[dist; GSYM HX_SUB; NORM_HX; GSYM DROP_SUB] THEN REWRITE_TAC[GSYM ABS_DROP]);; let CONTINUOUS_ON_HX_DROP = prove (`!f s. f continuous_on s ==> (\x:real^N. Hx(drop(f x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_HX_DROP]);; let CONTINUOUS_HX_LIFT = prove (`!f. (\x:A. Hx(f x)) continuous net <=> (\x. lift(f x)) continuous net`, REWRITE_TAC[continuous; LIM; dist; GSYM HX_SUB; GSYM LIFT_SUB] THEN REWRITE_TAC[NORM_HX; NORM_LIFT]);; let CONTINUOUS_ON_HX_LIFT = prove (`!f s. (\x:real^N. Hx(f x)) continuous_on s <=> (\x. lift(f x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_HX_LIFT]);; (* ------------------------------------------------------------------------- *) (* Linearity and continuity of the components. *) (* ------------------------------------------------------------------------- *) let LINEAR_QUAT_COMPONENTS = prove (`linear(Hx o Re) /\ linear(Hx o Im1) /\ linear(Hx o Im2) /\ linear(Hx o Im3)`, REWRITE_TAC[linear; o_THM; QUAT_ADD_COMPONENTS; QUAT_CMUL_COMPONENTS; HX_ADD; HX_MUL; QUAT_CMUL]);; let CONTINUOUS_AT_QUAT_COMPONENTS = prove (`(!q. (Hx o Re) continuous at q) /\ (!q. (Hx o Im1) continuous at q) /\ (!q. (Hx o Im2) continuous at q) /\ (!q. (Hx o Im3) continuous at q)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[LINEAR_QUAT_COMPONENTS]);; let CONTINUOUS_ON_QUAT_COMPONENTS = prove (`(!s. (Hx o Re) continuous_on s) /\ (!s. (Hx o Im1) continuous_on s) /\ (!s. (Hx o Im2) continuous_on s) /\ (!s. (Hx o Im3) continuous_on s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_QUAT_COMPONENTS]);; hol-light/Quaternions/qcalc.hl000066400000000000000000000164551303454263000167000ustar00rootroot00000000000000(* ========================================================================= *) (* Computing with literal quaternions. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Conversions performing computations on literal quaternions with *) (* rational components, i.e., terms of the form `quat(x,y,z,w)` where *) (* x,y,z,w are literal rational numbers (e.g. `&2 / &3`). We adopt the *) (* following name convention RAT_QUAT_op_CONV (op = ADD, MUL, NEG, etc). *) (* *) (* N.B.: In quaternions.hl are available other conversion for constant *) (* rational quaternions (terms of the form `Hx(x)` where x is a literal *) (* rational number. Those conversions are named with the convention *) (* QUAT_RAT_op_CONV. *) (* ------------------------------------------------------------------------- *) let dest_quat tm = let quat_tm = `quat` in let f,p = dest_comb tm in if f <> quat_tm then failwith "dest_quat" else let tm1,p1 = dest_pair p in let tm2,p2 = dest_pair p1 in let tm3,tm4 = dest_pair p2 in (tm1,tm2,tm3,tm4);; let CNJ_QUAT = prove (`!x y z w. cnj(quat(x,y,z,w)) = quat(x, --y, --z, --w)`, REWRITE_TAC[QUAT_EQ; QUAT_CNJ_COMPONENTS; QUAT_COMPONENTS]);; let QUAT_COMPONENTS_CONV conv = RAND_CONV (LAND_CONV conv THENC RAND_CONV (LAND_CONV conv THENC RAND_CONV (BINOP_CONV conv)));; let RAT_QUAT_EQ_CONV : conv = let qth_eq = prove (`!x1 x2 x3 x4 y1 y2 y3 y4. quat(x1,x2,x3,x4) = quat(y1,y2,y3,y4) <=> x1 = y1 /\ x2 = y2 /\ x3 = y3 /\ x4 = y4`, REWRITE_TAC[QUAT_EQ; QUAT_COMPONENTS]) in let th1,th2 = CONJ_PAIR (TAUT `(F /\ p <=> F) /\ (T /\ p <=> p)`) in let c1,c2 = REWR_CONV th1, REWR_CONV th2 in REWR_CONV qth_eq THENC LAND_CONV REAL_RAT_EQ_CONV THENC (c1 ORELSEC (c2 THENC LAND_CONV REAL_RAT_EQ_CONV THENC (c1 ORELSEC (c2 THENC LAND_CONV REAL_RAT_EQ_CONV THENC (c1 ORELSEC (c2 THENC REAL_RAT_EQ_CONV))))));; let RAT_QUAT_ADD_CONV : conv = let qth_add = prove (`!x1 x2 x3 x4 y1 y2 y3 y4. quat(x1,x2,x3,x4) + quat(y1,y2,y3,y4) = quat(x1+y1,x2+y2,x3+y3,x4+y4)`, REWRITE_TAC[quat_add; QUAT_EQ; QUAT_COMPONENTS]) in REWR_CONV qth_add THENC QUAT_COMPONENTS_CONV REAL_RAT_ADD_CONV;; let RAT_QUAT_NEG_CONV : conv = let qth_neg = prove (`!x1 x2 x3 x4. -- quat(x1,x2,x3,x4) = quat(--x1, --x2, --x3, --x4)`, REWRITE_TAC[quat_neg; QUAT_EQ; QUAT_COMPONENTS]) in REWR_CONV qth_neg THENC QUAT_COMPONENTS_CONV REAL_RAT_NEG_CONV;; let RAT_QUAT_SUB_CONV : conv = let qth_sub = prove (`!x1 x2 x3 x4 y1 y2 y3 y4. quat(x1,x2,x3,x4) - quat(y1,y2,y3,y4) = quat(x1-y1,x2-y2,x3-y3,x4-y4)`, REWRITE_TAC[quat_sub; quat_neg; quat_add; real_sub; QUAT_EQ; QUAT_COMPONENTS]) in REWR_CONV qth_sub THENC QUAT_COMPONENTS_CONV REAL_RAT_SUB_CONV;; let RAT_QUAT_MUL_CONV : conv = let qth_mul = prove (`!x1 x2 x3 x4 y1 y2 y3 y4. quat(x1,x2,x3,x4) * quat(y1,y2,y3,y4) = quat(x1 * y1 - x2 * y2 - x3 * y3 - x4 * y4, x1 * y2 + x2 * y1 + x3 * y4 - x4 * y3, x1 * y3 - x2 * y4 + x3 * y1 + x4 * y2, x1 * y4 + x2 * y3 - x3 * y2 + x4 * y1)`, REWRITE_TAC[quat_mul; QUAT_EQ; QUAT_COMPONENTS]) in REWR_CONV qth_mul THENC QUAT_COMPONENTS_CONV REAL_RAT_REDUCE_CONV;; let RAT_QUAT_INV_CONV : conv = let qth_inv = prove (`!x1 x2 x3 x4. inv (quat(x1,x2,x3,x4)) = quat( x1 / (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2), --x2 / (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2), --x3 / (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2), --x4 / (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2))`, REWRITE_TAC[quat_inv; QUAT_EQ; QUAT_COMPONENTS]) in REWR_CONV qth_inv THENC QUAT_COMPONENTS_CONV REAL_RAT_REDUCE_CONV;; let RAT_QUAT_POW_CONV : conv = let n = `n:num` and Z = `_0` and x = `x:quat` and y = `y:quat` and z = `z:quat` and t = `t:quat` and bit0 = `BIT0` and mul = `quat_mul` in let th_pow = prove (`(x pow NUMERAL n = x pow n )/\ (x pow _0 = quat(&1,&0,&0,&0)) /\ (x pow n = y ==> y * y = z ==> x pow BIT0 n = z) /\ (x pow n = y ==> y * y = z ==> x * z = t ==> x pow BIT1 n = t)`, REWRITE_TAC[NUMERAL; DENUMERAL quat_pow; GSYM HX_DEF] THEN CONJ_TAC THEN REPEAT (DISCH_THEN (SUBST1_TAC o GSYM)) THEN REWRITE_TAC[BIT0; BIT1; quat_pow; QUAT_POW_ADD]) in let [pth0; pth1; pth2; pth3] = CONJUNCTS th_pow in let pow = `quat_pow` in let dest_pow = dest_binop pow in let rec QUAT_POW l r = if r = Z then INST [l,x] pth1 else let b,r' = dest_comb r in if b = bit0 then let th1 = QUAT_POW l r' in let tm1 = rand(concl th1) in let th2 = RAT_QUAT_MUL_CONV (mk_binop mul tm1 tm1) in let tm2 = rand(concl th2) in MP (MP (INST [l,x; r',n; tm1,y; tm2,z] pth2) th1) th2 else let th1 = QUAT_POW l r' in let tm1 = rand(concl th1) in let th2 = RAT_QUAT_MUL_CONV (mk_binop mul tm1 tm1) in let tm2 = rand(concl th2) in let th3 = RAT_QUAT_MUL_CONV (mk_binop mul l tm2) in let tm3 = rand(concl th3) in MP (MP (MP (INST [l,x; r',n; tm1,y; tm2,z; tm3,t] pth3) th1) th2) th3 in fun tm -> let th0 = REWR_CONV pth0 tm in let l,r = dest_pow(rand(concl th0)) in TRANS th0 (QUAT_POW l r);; let RAT_QUAT_CNJ_CONV : conv = let neg_tm = `real_neg` and cnj_tm = `quat_cnj` and x_tm = `x:real` and y_tm = `y:real` and y'_tm = `y':real` and z_tm = `z:real` and z'_tm = `z':real` and w_tm = `w:real` and w'_tm = `w':real` and cnj_th = prove (`--y=y' ==> --z=z' ==> --w=w' ==> cnj(quat(x,y,z,w)) = quat(x, y', z', w')`, SIMP_TAC[CNJ_QUAT]) in fun tm -> let op,q = dest_comb tm in if op <> cnj_tm then failwith "RAT_QUAT_CNJ_CONV" else let x,y,z,w = dest_quat q in let yth = REAL_RAT_NEG_CONV (mk_comb(neg_tm,y)) and zth = REAL_RAT_NEG_CONV (mk_comb(neg_tm,z)) and wth = REAL_RAT_NEG_CONV (mk_comb(neg_tm,w)) in let y' = rand(concl yth) and z' = rand(concl zth) and w' = rand(concl wth) in let th = INST[x,x_tm;y,y_tm;z,z_tm;w,w_tm;y',y'_tm;z',z'_tm;w',w'_tm] cnj_th in MP (MP (MP th yth) zth) wth;; let RAT_QUAT_RED_CONV = let gconv_net = itlist (uncurry net_of_conv) [`quat x = quat y`,RAT_QUAT_EQ_CONV; `quat x + quat y`,RAT_QUAT_ADD_CONV; `quat x - quat y`,RAT_QUAT_SUB_CONV; `quat x * quat y`,RAT_QUAT_MUL_CONV; `inv (quat x)`,RAT_QUAT_INV_CONV; `quat x pow n`,RAT_QUAT_POW_CONV; `cnj(quat x)`,RAT_QUAT_CNJ_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let RAT_QUAT_REDUCE_CONV = DEPTH_CONV RAT_QUAT_RED_CONV;; let RAT_QUAT_REDUCE_TAC = CONV_TAC RAT_QUAT_REDUCE_CONV;; let QUAT_TRAD_CONV : conv = REWR_CONV QUAT_TRAD THENC GEN_REWRITE_CONV DEPTH_CONV [QUAT_MUL_RID; QUAT_MUL_RZERO; QUAT_ADD_LID; QUAT_ADD_RID];; let RATIONAL_QUAT_CONV : conv = GEN_REWRITE_CONV DEPTH_CONV [HX_DEF; quat_ii; quat_jj; quat_kk] THENC RAT_QUAT_REDUCE_CONV THENC QUAT_TRAD_CONV;; hol-light/Quaternions/qderivative.hl000066400000000000000000000056551303454263000201400ustar00rootroot00000000000000(* ========================================================================= *) (* General results about differential for quaternionic functions. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) let QUAT_HAS_DERIVATIVE_CONST = prove (`!net p. ((\q:real^N. p) has_derivative (\q. Hx(&0))) net`, REWRITE_TAC[HAS_DERIVATIVE_CONST; GSYM QUAT_VEC_0]);; let QUAT_HAS_DERIVATIVE_RMUL = prove (`!net p. ((\q. q * p) has_derivative (\q. q * p)) net`, SIMP_TAC[HAS_DERIVATIVE_LINEAR; LINEAR_QUAT_RMUL]);; let QUAT_HAS_DERIVATIVE_MUL_AT = prove (`!f f' g g' q. (f has_derivative f') (at q) /\ (g has_derivative g') (at q) ==> ((\x:quat. f x * g x) has_derivative (\x. f q * g' x + f' x * g q)) (at q)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_BILINEAR_AT THEN ASM_REWRITE_TAC [HAS_DERIVATIVE_BILINEAR_AT; BILINEAR_QUAT_MUL]);; let QUAT_HAS_DERIVATIVE_MUL_WITHIN = prove (`!f f' g g' q s. (f has_derivative f') (at q within s) /\ (g has_derivative g') (at q within s) ==> ((\x:quat. f x * g x) has_derivative (\x. f q * g' x + f' x * g q)) (at q within s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_BILINEAR_WITHIN THEN ASM_REWRITE_TAC [HAS_DERIVATIVE_BILINEAR_WITHIN; BILINEAR_QUAT_MUL]);; let QUAT_HAS_DERIVATIVE_SQUARE = prove (`!q0. ((\q. q * q) has_derivative (\q. q0 * q + q * q0)) (at q0)`, GEN_TAC THEN SUBGOAL_THEN `((\x. (\q. q) x * (\q. q) x) has_derivative (\d. (\q. q) q0 * (\q. q) d + (\q. q) d * (\q. q) q0)) (at q0)` MP_TAC THENL [SIMP_TAC[HAS_DERIVATIVE_BILINEAR_AT; HAS_DERIVATIVE_ID; BILINEAR_QUAT_MUL]; REWRITE_TAC[]]);; let QUAT_HAS_DERIVATIVE_POW = prove (`!q0 n. ((\q. q pow n) has_derivative (\q. vsum (1..n) (\i. q0 pow (n - i) * q * q0 pow (i - 1)))) (at q0)`, GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[quat_pow; NUMSEG_CONV `1..0`; VSUM_CLAUSES; QUAT_VEC_0] THEN MATCH_ACCEPT_TAC QUAT_HAS_DERIVATIVE_CONST; ALL_TAC] THEN REWRITE_TAC[quat_pow; VSUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`; SUB_REFL; QUAT_MUL_LID; ARITH_RULE `SUC n - 1 = n`] THEN SUBGOAL_THEN `!q. vsum (1..n) (\i. q0 pow (SUC n - i) * q * q0 pow (i - 1)) = q0 * vsum (1..n) (\i. q0 pow (n - i) * q * q0 pow (i - 1))` (fun th -> REWRITE_TAC[th]) THENL [GEN_TAC THEN SIMP_TAC[FINITE_NUMSEG; GSYM VSUM_QUAT_LMUL] THEN MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[IN_NUMSEG; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `x <= n ==> SUC n - x = SUC (n - x)`; quat_pow; GSYM QUAT_MUL_ASSOC]; LABEL_TAC "id" (ISPEC `(at (q0:quat))` HAS_DERIVATIVE_ID) THEN HYP MP_LIST_TAC "id ind_n" [BILINEAR_QUAT_MUL] THEN DISCH_THEN (MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_AT) THEN REWRITE_TAC[]]);; hol-light/Quaternions/qisom.hl000066400000000000000000000321331303454263000167340ustar00rootroot00000000000000(* ========================================================================= *) (* Quaternions for describing 3D isometries. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* We need the definition of cross product 3D. *) (* ------------------------------------------------------------------------- *) needs "Multivariate/cross.ml";; (* ------------------------------------------------------------------------- *) (* HIm *) (* ------------------------------------------------------------------------- *) let HIM_DEF = new_definition `HIm(q:quat) : real^3 = vector[q$2;q$3;q$4]`;; let HIM = prove (`!x y z w. HIm(quat(x,y,z,w)):real^3 = vector[y;z;w]`, REWRITE_TAC[HIM_DEF; quat; VECTOR_4]);; let HIM_COMPONENT = prove (`(!q. HIm q $ 1 = Im1 q) /\ (!q. HIm q $ 2 = Im2 q) /\ (!q. HIm q $ 3 = Im3 q)`, REWRITE_TAC[FORALL_QUAT; HIM; QUAT_COMPONENTS; VECTOR_3]);; let HIM_EQ = prove (`!p q. HIm p = HIm q <=> Im1 p = Im1 q /\ Im2 p = Im2 q /\ Im3 p = Im3 q`, REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; HIM_COMPONENT]);; let HIM_HX = prove (`!a. HIm(Hx a) = vec 0`, REWRITE_TAC[HX_DEF; HIM; CART_EQ; DIMINDEX_3; VEC_COMPONENT; DIMINDEX_3; FORALL_3; VECTOR_3]);; let HIM_CNJ = prove (`!q. HIm(cnj q) = -- HIm q`, REWRITE_TAC[CART_EQ; QUAT_CNJ_COMPONENTS; HIM_COMPONENT; VECTOR_NEG_COMPONENT; DIMINDEX_3; FORALL_3; VECTOR_3]);; let HIM_MUL_HX = prove (`(!a q. HIm(Hx a * q) = a % HIm q) /\ (!a q. HIm(q * Hx a) = a % HIm q)`, REWRITE_TAC[CART_EQ; VECTOR_MUL_COMPONENT; HIM_COMPONENT; DIMINDEX_3; FORALL_3; VECTOR_3; MUL_HX_COMPONENTS] THEN MESON_TAC[REAL_MUL_SYM]);; let HIM_ADD = prove (`!p q. HIm(p + q) = HIm p + HIm q`, REWRITE_TAC[CART_EQ; VECTOR_ADD_COMPONENT; DIMINDEX_3] THEN REWRITE_TAC[FORALL_3; HIM_COMPONENT; QUAT_ADD_COMPONENTS]);; let HIM_NEG = prove (`!q. HIm(--q) = --HIm q`, REWRITE_TAC[CART_EQ; VECTOR_NEG_COMPONENT; DIMINDEX_3] THEN REWRITE_TAC[FORALL_3; HIM_COMPONENT; QUAT_NEG_COMPONENTS]);; let HIM_SUB = prove (`!p q. HIm(p - q) = HIm p - HIm q`, REWRITE_TAC[CART_EQ; VECTOR_SUB_COMPONENT; DIMINDEX_3] THEN REWRITE_TAC[FORALL_3; HIM_COMPONENT; QUAT_SUB_COMPONENTS]);; let HIM_VSUM = prove (`!f s. FINITE s ==> HIm(vsum s f) = vsum s (\x:A. HIm(f x))`, REPEAT STRIP_TAC THEN REWRITE_TAC[CART_EQ] THEN ASM_SIMP_TAC[VSUM_COMPONENT] THEN REWRITE_TAC[DIMINDEX_3; FORALL_3; HIM_COMPONENT] THEN ASM_SIMP_TAC[QUAT_VSUM_COMPONENTS]);; let CMUL_HIM = prove (`!c q. c % HIm q = HIm(Hx c * q)`, REWRITE_TAC[GSYM QUAT_CMUL; VECTOR_EQ_3; HIM_DEF; VECTOR_3; VECTOR_MUL_COMPONENT]);; let LINEAR_HIM = prove (`linear(HIm)`, REWRITE_TAC[linear; HIM_ADD; CMUL_HIM; QUAT_CMUL]);; (* ------------------------------------------------------------------------- *) (* Hv *) (* ------------------------------------------------------------------------- *) let HV = new_definition `Hv(x:real^3) = quat(&0,x$1,x$2,x$3)`;; let HV_COMPONENTS = prove (`(!x. Re(Hv(x)) = &0) /\ (!x. Im1(Hv(x)) = x$1) /\ (!x. Im2(Hv(x)) = x$2) /\ (!x. Im3(Hv(x)) = x$3)`, REWRITE_TAC[HV; QUAT_COMPONENTS; VECTOR_4]);; let HV_VEC = prove (`!n. Hv(vec n) = quat(&0, &n, &n, &n)`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; QUAT_COMPONENTS; VEC_COMPONENT]);; let HV_EQ_ZERO = prove (`!v. Hv v = Hx(&0) <=> v = vec 0`, GEN_TAC THEN REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; HX_COMPONENTS] THEN REWRITE_TAC[VECTOR_EQ_3; VEC_COMPONENT]);; let HV_ZERO = prove (`Hv(vec 0) = Hx(&0)`, REWRITE_TAC[HV_EQ_ZERO]);; let HV_VECTOR = prove (`!x y z. Hv(vector[x;y;z]) = quat(&0,x,y,z)`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; QUAT_COMPONENTS; VECTOR_3]);; let HV_BASIS = prove (`Hv(basis 1) = ii /\ Hv(basis 2) = jj /\ Hv(basis 3) = kk`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; QUAT_UNITS_COMPONENTS] THEN SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH_LE; ARITH_LT; ARITH_EQ]);; let HV_ADD = prove (`!x y. Hv(x + y) = Hv x + Hv y`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; QUAT_ADD_COMPONENTS; VECTOR_ADD_COMPONENT; REAL_ADD_LID]);; let HV_NEG = prove (`!x. Hv(--x) = --Hv x`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; QUAT_NEG_COMPONENTS; VECTOR_NEG_COMPONENT; REAL_NEG_0]);; let HV_SUB = prove (`!x y. Hv(x - y) = Hv x - Hv y`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; QUAT_SUB_COMPONENTS; VECTOR_SUB_COMPONENT; REAL_SUB_RZERO]);; let HV_CMUL = prove (`!a x. Hv(a % x) = Hx a * Hv x`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; MUL_HX_COMPONENTS; REAL_MUL_RZERO; VECTOR_MUL_COMPONENT]);; let HV_VSUM = prove (`!f s. FINITE s ==> Hv(vsum s f) = vsum s (\x:A. Hv(f x))`, REPEAT STRIP_TAC THEN REWRITE_TAC[QUAT_EQ] THEN ASM_SIMP_TAC[HV_COMPONENTS; QUAT_VSUM_COMPONENTS; SUM_0] THEN ASM_SIMP_TAC[VSUM_COMPONENT; DIMINDEX_3; ARITH]);; let HV_INJ = prove (`!x y. Hv x = Hv y <=> x = y`, REWRITE_TAC[QUAT_EQ; HV_COMPONENTS] THEN REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3]);; let LINEAR_HV = prove (`linear(Hv)`, REWRITE_TAC[linear; HV_ADD; HV_CMUL; QUAT_CMUL]);; let HIM_HV = prove (`!x. HIm(Hv x) = x`, REWRITE_TAC[HIM; HV; CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_MUL_COMPONENT; VECTOR_3]);; let CNJ_HV = prove (`!v. cnj(Hv v) = --Hv v`, REWRITE_TAC[QUAT_EQ; QUAT_CNJ_COMPONENTS; HV_COMPONENTS; QUAT_NEG_COMPONENTS; REAL_NEG_0]);; let HV_HIM = prove (`!q. Hv(HIm q) = quat(&0, Im1 q, Im2 q, Im3 q)`, REWRITE_TAC[FORALL_QUAT; HIM; HV; QUAT_COMPONENTS; VECTOR_3]);; let HV_HIM_EQ = prove (`!q. Hv(HIm q) = q <=> Re q = &0`, GEN_TAC THEN REWRITE_TAC[QUAT_EQ; HV_COMPONENTS; HIM_COMPONENT] THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; let DOT_HV = prove (`!u v. Hv u dot Hv v = u dot v`, REWRITE_TAC[DOT_3; QUAT_DOT; HV_COMPONENTS; REAL_MUL_LZERO; REAL_ADD_LID]);; let NORM_HV = prove (`!v. norm (Hv v) = norm v`, REWRITE_TAC[vector_norm; DOT_HV]);; (* ------------------------------------------------------------------------- *) (* Geometric interpretation of product of imaginary quaternions. *) (* ------------------------------------------------------------------------- *) let MUL_HV_EQ_CROSS_DOT = prove (`!x y. Hv x * Hv y = Hv(x cross y) - Hx (x dot y)`, REWRITE_TAC[QUAT_EQ; QUAT_SUB_COMPONENTS; HV_COMPONENTS; HX_COMPONENTS; quat_mul; QUAT_COMPONENTS; CROSS_COMPONENTS; DOT_3] THEN CONV_TAC REAL_RING);; (* ------------------------------------------------------------------------- *) (* Representing orthogonal transformations as conjugation or congruence with *) (* a quaternion. *) (* ------------------------------------------------------------------------- *) let ORTHOGONAL_TRANSFORMATION_QUAT_CONGRUENCE = time prove (`!q. norm q = &1 ==> orthogonal_transformation (\x. HIm(cnj q * Hv x * q))`, INTRO_TAC "!q; qnorm" THEN REWRITE_TAC[orthogonal_transformation; linear] THEN CONJ_TAC THENL [CONJ_TAC THEN REPEAT STRIP_TAC THENL [REWRITE_TAC[HV_ADD; QUAT_ADD_LDISTRIB; QUAT_ADD_RDISTRIB; HIM_ADD]; REWRITE_TAC[CMUL_HIM; HV_CMUL] THEN AP_TERM_TAC THEN CONV_TAC QUAT_POLY]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[DOT_3; HIM_COMPONENT; quat_mul; HV_COMPONENTS; QUAT_COMPONENTS; QUAT_CNJ_COMPONENTS] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_NORM_SQNORM_UNIT] THEN REWRITE_TAC[QUAT_SQNORM] THEN CONV_TAC REAL_RING);; let ORTHOGONAL_TRANSFORMATION_QUAT_CONJUGATION = prove (`!q. ~(q = Hx(&0)) ==> orthogonal_transformation (\x. HIm(inv q * Hv x * q))`, INTRO_TAC "!q; qnz" THEN SUBGOAL_THEN `?c p. q = Hx c * p /\ norm p = &1` (DESTRUCT_TAC "@c p. qeq pnorm") THENL [MAP_EVERY EXISTS_TAC [`norm (q:quat)`; `inv (Hx (norm q)) * q`] THEN REWRITE_TAC[QUAT_NORM_MUL; QUAT_NORM_INV; REAL_ABS_NORM; QUAT_MUL_ASSOC; NORM_HX; GSYM HX_INV; GSYM HX_MUL] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LINV; QUAT_NORM_ZERO; QUAT_MUL_LID]; ALL_TAC] THEN REMOVE_THEN "qeq" SUBST_ALL_TAC THEN REMOVE_THEN "qnz" (DESTRUCT_TAC "cnz pnz" o REWRITE_RULE[QUAT_ENTIRE; HX_INJ; DE_MORGAN_THM]) THEN REWRITE_TAC[QUAT_INV_MUL; GSYM HX_INV] THEN ASM_SIMP_TAC[QUAT_INV_EQ_CNJ] THEN CONV_TAC (ONCE_DEPTH_CONV (CHANGED_CONV QUAT_POLY_CONV)) THEN ASM_SIMP_TAC[REAL_MUL_RINV; QUAT_MUL_LID; ORTHOGONAL_TRANSFORMATION_QUAT_CONGRUENCE]);; let REFLECT_ALONG_EQ_QUAT_PRODUCT = time prove (`!v x. norm v = &1 ==> reflect_along v x = HIm(Hv v * Hv x * Hv v)`, INTRO_TAC "!v x; vnorm" THEN REWRITE_TAC[reflect_along] THEN SUBGOAL_THEN `v:real^3 dot v = &1` SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM NORM_EQ_1]; REWRITE_TAC[REAL_DIV_1]] THEN REWRITE_TAC[VECTOR_EQ_3; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; HIM_COMPONENT; quat_mul; HV_COMPONENTS; QUAT_COMPONENTS; DOT_3] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NORM_EQ_1; DOT_3] THEN CONV_TAC REAL_RING);; let REFLECT_ALONG_EQ_QUAT_CONJUGATION = prove (`!v. ~(v = vec 0) ==> reflect_along v = \x. -- HIm(inv (Hv v) * Hv x * Hv v)`, REWRITE_TAC[FUN_EQ_THM] THEN INTRO_TAC "!v; vnz; !x" THEN SUBGOAL_THEN `?c u:real^3. v = c % u /\ norm u = &1` (DESTRUCT_TAC "@c u. veq unorm") THENL [MAP_EVERY EXISTS_TAC [`norm (v:real^3)`; `inv (norm (v:real^3)) % v`] THEN REWRITE_TAC[VECTOR_MUL_ASSOC; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID]; ALL_TAC] THEN REMOVE_THEN "veq" SUBST_ALL_TAC THEN REMOVE_THEN "vnz" MP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN INTRO_TAC "cnz unz" THEN ASM_SIMP_TAC[REFLECT_ALONG_SCALE] THEN ASM_SIMP_TAC[REFLECT_ALONG_EQ_QUAT_PRODUCT] THEN REWRITE_TAC[GSYM HIM_NEG; HV_CMUL; QUAT_INV_MUL; GSYM HX_INV] THEN AP_TERM_TAC THEN CONV_TAC (BINOP_CONV QUAT_POLY_CONV) THEN ASM_SIMP_TAC[REAL_FIELD `~(c = &0) ==> -- &1 * c * inv c = -- &1`] THEN SUBGOAL_THEN `inv (Hv u) = --Hv u` SUBST1_TAC THENL [ONCE_REWRITE_TAC[QUAT_INV_CNJ] THEN ASM_REWRITE_TAC[CNJ_HV; NORM_HV; REAL_POW_ONE; QUAT_INV_1; QUAT_MUL_LID]; CONV_TAC QUAT_POLY]);; let ORTHOGONAL_TRANSFORMATION_AS_QUAT_CONJUGATION = prove (`!f. orthogonal_transformation f ==> (?q. norm q = &1 /\ ((!x. f x = HIm(inv q * Hv x * q)) \/ (!x. f x = -- HIm(inv q * Hv x * q))))`, INTRO_TAC "!f; orth" THEN MP_TAC (ISPECL [`f:real^3->real^3`;`3`] ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[DIMINDEX_3] THEN ARITH_TAC; ALL_TAC] THEN INTRO_TAC "@l. len hp feq" THEN HYP MP_LIST_TAC "hp feq" [] THEN POP_ASSUM_LIST (K ALL_TAC) THEN ABBREV_TAC `n = LENGTH (l:(real^3)list)` THEN POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> SPEC_TAC (t,t)) [`f:real^3->real^3`; `l:(real^3)list`; `n:num`] THEN INDUCT_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[LENGTH_EQ_NIL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ALL; ITLIST] THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `Hx(&1)` THEN REWRITE_TAC[NORM_HX; REAL_ABS_1; I_THM; QUAT_INV_1; QUAT_MUL_LID; QUAT_MUL_RID; HIM_HV]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[LENGTH_EQ_CONS] THEN INTRO_TAC "@h t. leq len; all feq" THEN REMOVE_THEN "ind_n" (fun ind_n -> REMOVE_THEN "len" (MP_TAC o MATCH_MP ind_n)) THEN REMOVE_THEN "leq" SUBST_ALL_TAC THEN REMOVE_THEN "all" MP_TAC THEN REWRITE_TAC[ALL] THEN INTRO_TAC "hnz tnz" THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `g = ITLIST (\v:real^3 h. reflect_along v o h) t I` THEN DISCH_THEN (fun ant -> POP_ASSUM (MP_TAC o MATCH_MP ant)) THEN INTRO_TAC "@q. qnorm hp" THEN SUBGOAL_THEN `!x. Hv(HIm((inv q * Hv x) * q)) = (inv q * Hv x) * q` (LABEL_TAC "rel") THENL [GEN_TAC THEN ASM_SIMP_TAC[QUAT_INV_EQ_CNJ] THEN REWRITE_TAC[HV_HIM_EQ; quat_mul; QUAT_COMPONENTS; QUAT_CNJ_COMPONENTS; HV_COMPONENTS] THEN CONV_TAC REAL_RING; ALL_TAC] THEN ABBREV_TAC `p = Hx(inv (norm h)) * Hv h` THEN EXISTS_TAC `q * p : quat` THEN POP_ASSUM (LABEL_TAC "p") THEN REWRITE_TAC[ITLIST; o_THM] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[QUAT_NORM_MUL; REAL_MUL_LID] THEN EXPAND_TAC "p" THEN REWRITE_TAC[QUAT_NORM_MUL; NORM_HX; REAL_ABS_INV; REAL_ABS_NORM; NORM_HV] THEN HYP SIMP_TAC "hnz" [REAL_MUL_LINV; NORM_EQ_0]; ALL_TAC] THEN HYP SIMP_TAC "hnz" [REFLECT_ALONG_EQ_QUAT_CONJUGATION] THEN REMOVE_THEN "hp" (DESTRUCT_TAC "hp|hp") THENL [DISJ2_TAC; DISJ1_TAC] THEN GEN_TAC THEN HYP REWRITE_TAC "hp" [] THEN REWRITE_TAC[HV_NEG; QUAT_MUL_LNEG; QUAT_MUL_RNEG; HIM_NEG; VECTOR_NEG_NEG] THEN AP_TERM_TAC THEN TRY AP_TERM_TAC THEN MAP_EVERY (fun s -> REMOVE_THEN s (K ALL_TAC)) ["feq"; "tnz"; "hp"] THEN REMOVE_THEN "p" (SUBST1_TAC o GSYM) THEN REWRITE_TAC[QUAT_INV_MUL; GSYM HX_INV; REAL_INV_INV] THEN CONV_TAC (BINOP_CONV QUAT_POLY_CONV) THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; QUAT_MUL_LID; QUAT_MUL_ASSOC]);; hol-light/Quaternions/qnormalizer.hl000066400000000000000000000326431303454263000201550ustar00rootroot00000000000000(* ========================================================================= *) (* Canonical polynomial form for quaternionic expressions. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) let QUAT_MUL_HX_MUL_SYM = prove (`(!x y a. x * (Hx a * y) = Hx a * (x * y))`, REWRITE_TAC[QUAT_MUL_ASSOC; QUAT_MUL_HX_SYM]);; let QUAT_POLY_CONV : conv = (* ---------------------------------------------------------------------- *) (* Syntax for binary and unary operators on quaternions. *) (* ---------------------------------------------------------------------- *) let is_quat_real = let hx_tm = `Hx` in fun tm -> is_comb tm && rator tm = hx_tm in let is_quat_add = is_binop `(+):quat->quat->quat` in let mk_quat_add = mk_binop `(+):quat->quat->quat` in let dest_quat_add = dest_binop `(+):quat->quat->quat` in let is_quat_mul = is_binop `quat_mul` in let dest_quat_mul = dest_binop `quat_mul` in let is_quat_pow = is_binop `quat_pow` in let dest_quat_pow = dest_binop `quat_pow` in (* ---------------------------------------------------------------------- *) (* Monomial multiplication. *) (* ---------------------------------------------------------------------- *) let POW_MUL_FUSE_CONV : conv = let th1 = prove (`(!x m n. x:quat pow m * x pow n = x pow (m + n)) /\ (!x n. x:quat * x pow n = x pow (n + 1)) /\ (!x n. x:quat pow n * x = x pow (n + 1)) /\ (!x. x:quat * x = x pow 2)`, REWRITE_TAC[QUAT_POW_ADD; QUAT_POW_1; QUAT_POW_2] THEN REWRITE_TAC[GSYM quat_pow; GSYM QUAT_POW_SUC_ALT]) in GEN_REWRITE_CONV I [th1] THENC RAND_CONV NUM_NORMALIZE_CONV in let POW_MONOMIAL_MUL_FUSE_CONV : conv = let assoc = REWR_CONV QUAT_MUL_ASSOC and pow_fuse = TRY_CONV POW_MUL_FUSE_CONV in fun tm -> if can (dest_quat_mul o snd o dest_quat_mul) tm then (TRY_CONV (assoc THENC LAND_CONV POW_MUL_FUSE_CONV)) tm else pow_fuse tm in let MONOMIAL_MUL_CONV : conv = let assoc_dx = TRY_CONV (REWR_CONV (GSYM QUAT_MUL_ASSOC)) in let rec monomial_mul tm = if can (dest_quat_mul o fst o dest_quat_mul) tm then (assoc_dx THENC RAND_CONV monomial_mul) tm else POW_MONOMIAL_MUL_FUSE_CONV tm in monomial_mul in (* ---------------------------------------------------------------------- *) (* Term multiplication. *) (* ---------------------------------------------------------------------- *) let TERM_MUL_CONV : conv = let conv0 = REWR_CONV QUAT_MUL_LID in let [conv1;conv2;conv3;conv4;conv5] = (map REWR_CONV o CONJUNCTS o prove) (`(!a b x y. (Hx a * x) * (Hx b * y) = Hx (a * b) * x * y) /\ (!a b x. (Hx a * x) * Hx b = Hx (a * b) * x) /\ (!a b x. Hx a * (Hx b * x) = Hx (a * b) * x) /\ (!a x y. (Hx a * x) * y = Hx a * x * y) /\ (!a x y. x * (Hx a * y) = Hx a * x * y)`, REWRITE_TAC[HX_MUL; QUAT_MUL_ASSOC] THEN ONCE_REWRITE_TAC[QUAT_MUL_HX_MUL_SYM; QUAT_MUL_HX_SYM] THEN REWRITE_TAC[HX_MUL; QUAT_MUL_ASSOC]) in REWR_CONV QUAT_MUL_LZERO ORELSEC REWR_CONV QUAT_MUL_RZERO ORELSEC conv0 ORELSEC REWR_CONV QUAT_MUL_RID ORELSEC (REWR_CONV (GSYM HX_MUL) THENC RAND_CONV REAL_POLY_CONV) ORELSEC (((conv1 THENC RAND_CONV MONOMIAL_MUL_CONV) ORELSEC conv2 ORELSEC conv3) THENC LAND_CONV (RAND_CONV REAL_POLY_CONV) THENC TRY_CONV conv0) ORELSEC ((conv4 ORELSEC conv5) THENC RAND_CONV MONOMIAL_MUL_CONV) ORELSEC REWR_CONV QUAT_MUL_HX_SYM ORELSEC MONOMIAL_MUL_CONV in let TERMS_FUSE_ADD_CONV : conv = let th1 = prove (`!x y q. Hx x * q + Hx y * q = Hx(x+y) * q`, REWRITE_TAC[HX_ADD; QUAT_ADD_RDISTRIB]) and th2 = prove (`!x q. Hx x * q + q = Hx(x + &1) * q`, REWRITE_TAC[HX_ADD; QUAT_ADD_RDISTRIB; QUAT_MUL_LID]) and th3 = prove (`!x q. q + Hx x * q = Hx(&1 + x) * q`, REWRITE_TAC[HX_ADD; QUAT_ADD_RDISTRIB; QUAT_MUL_LID]) in (REWR_CONV QUAT_ADD_LID ORELSEC REWR_CONV QUAT_ADD_RID ORELSEC (REWR_CONV (GSYM HX_ADD) THENC RAND_CONV REAL_POLY_CONV) ORELSEC ((REWR_CONV th1 ORELSEC REWR_CONV th2 ORELSEC REWR_CONV th3) THENC LAND_CONV (RAND_CONV REAL_POLY_CONV)) ORELSEC REWR_CONV (GSYM QUAT_MUL_2)) THENC (REWR_CONV QUAT_MUL_LID ORELSEC REWR_CONV QUAT_MUL_LZERO ORELSEC ALL_CONV) in (* ---------------------------------------------------------------------- *) (* Monomial and term comparison. *) (* ---------------------------------------------------------------------- *) let dest_literal_quat_pow tm = try let b,e = dest_quat_pow tm in (b,dest_numeral e) with Failure _ -> (tm,num_1) in let pow_compare tm1 tm2 = let b1,e1 = dest_literal_quat_pow tm1 and b2,e2 = dest_literal_quat_pow tm2 in let c = compare b1 b2 in if c <> 0 then c else compare e1 e2 in let rec mon_compare tm1 tm2 = match is_quat_mul tm1, is_quat_mul tm2 with | true,true -> let c = pow_compare (lhand tm1) (lhand tm2) in if c <> 0 then c else mon_compare (rand tm1) (rand tm2) | true,false -> 1 | false,true -> -1 | false,false -> pow_compare tm1 tm2 in let mon_of_term tm = try let c,m = dest_quat_mul tm in if is_quat_real c then m else tm with Failure _ -> tm in let term_compare tm1 tm2 = match is_quat_real tm1, is_quat_real tm2 with | true, false -> -1 | false, true -> 1 | true, true -> 0 | false,false -> mon_compare (mon_of_term tm1) (mon_of_term tm2) in (* ---------------------------------------------------------------------- *) (* Term insertion. *) (* ---------------------------------------------------------------------- *) let insert_term_th = prove (`!p q r. p + (q + r) = q + (p + r)`, REWRITE_TAC[QUAT_ADD_AC]) in let rec INSERT_TERM tm tms : thm = let ptm = mk_quat_add tm tms in try REWR_CONV QUAT_ADD_LID ptm with Failure _ -> try let tm1,tms = dest_quat_add tms in match term_compare tm tm1 with | 0 -> (REWR_CONV QUAT_ADD_ASSOC THENC LAND_CONV (REWR_CONV (TERMS_FUSE_ADD_CONV (mk_quat_add tm tm1))) THENC TRY_CONV (REWR_CONV QUAT_ADD_LID)) ptm | c when c > 0 -> (REWR_CONV insert_term_th THENC RAND_CONV INSERT_TERM_CONV THENC TRY_CONV (REWR_CONV QUAT_ADD_RID)) ptm | _ -> ALL_CONV ptm with Failure _ -> match term_compare tm tms with | 0 -> TERMS_FUSE_ADD_CONV ptm | c when c > 0 -> REWR_CONV QUAT_ADD_SYM ptm | _ -> ALL_CONV ptm and INSERT_TERM_CONV tm = try let tm,tms = dest_quat_add tm in INSERT_TERM tm tms with Failure _ -> ALL_CONV tm in (* ---------------------------------------------------------------------- *) (* Addition. *) (* ---------------------------------------------------------------------- *) let th_add1 = prove (`!p q r:quat. (p + q) + (r + s) = (p + r) + (q + s)`, REWRITE_TAC[QUAT_ADD_AC]) in let th_add2 = prove (`!p q r:quat. (p + q) + (r + s) = p + (q + (r + s))`, REWRITE_TAC[QUAT_ADD_AC]) in let th_add3 = prove (`!p q r:quat. (p + q) + (r + s) = r + ((p + q) + s)`, REWRITE_TAC[QUAT_ADD_AC]) in let rec PRE_ADD_CONV tm = let tm1,tm2 = dest_quat_add tm in if is_quat_add tm1 then let htm1,ttm1 = dest_quat_add tm1 in if is_quat_add tm2 then let htm2,ttm2 = dest_quat_add tm2 in match term_compare htm1 htm2 with | 0 -> (REWR_CONV th_add1 THENC LAND_CONV TERMS_FUSE_ADD_CONV THENC ((REWR_CONV QUAT_ADD_LID THENC PRE_ADD_CONV) ORELSEC RAND_CONV PRE_ADD_CONV THENC TRY_CONV (REWR_CONV QUAT_ADD_RID))) tm | c when c < 0 -> (REWR_CONV th_add2 THENC RAND_CONV PRE_ADD_CONV) tm | c when c > 0 -> (REWR_CONV th_add3 THENC RAND_CONV PRE_ADD_CONV) tm else (REWR_CONV QUAT_ADD_SYM THENC INSERT_TERM_CONV) tm else INSERT_TERM_CONV tm in (* ---------------------------------------------------------------------- *) (* Multiplication. *) (* ---------------------------------------------------------------------- *) let LDISTRIB_CONV : conv = let DIST_CONV = REWR_CONV QUAT_ADD_LDISTRIB in let rec LDISTRIB_CONV tm = ((DIST_CONV THENC LAND_CONV TERM_MUL_CONV THENC RAND_CONV (LDISTRIB_CONV)) ORELSEC TERM_MUL_CONV) tm in LDISTRIB_CONV in let RDISTRIB_CONV : conv = let DIST_CONV = REWR_CONV QUAT_ADD_RDISTRIB in let rec RDISTRIB_CONV tm = ((DIST_CONV THENC LAND_CONV TERM_MUL_CONV THENC RAND_CONV (RDISTRIB_CONV)) ORELSEC TERM_MUL_CONV) tm in RDISTRIB_CONV in let th_mul = prove (`!p q r s:quat. (p + q) * (r + s) = p * r + ((p * s + q * r) + q * s)`, REWRITE_TAC[QUAT_ADD_LDISTRIB; QUAT_ADD_RDISTRIB; QUAT_ADD_AC]) in let BINOP_CONV2 conv1 conv2 = LAND_CONV conv1 THENC RAND_CONV conv2 in let rec PRE_MUL_CONV tm = let l,r = dest_quat_mul tm in if not (is_quat_add l) then LDISTRIB_CONV tm else if not (is_quat_add r) then RDISTRIB_CONV tm else (REWR_CONV th_mul THENC BINOP_CONV2 TERM_MUL_CONV (BINOP_CONV2 (BINOP_CONV2 LDISTRIB_CONV RDISTRIB_CONV THENC PRE_ADD_CONV) PRE_MUL_CONV THENC PRE_ADD_CONV)) tm in (* ---------------------------------------------------------------------- *) (* Power. *) (* ---------------------------------------------------------------------- *) let PRE_POW_CONV : conv = let QUAT_POW_DENUMERAL = prove (`x pow NUMERAL n = x pow n`, REWRITE_TAC[NUMERAL]) and QUAT_POW_BIT0 = prove (`!x n. x pow BIT0 n = (x * x) pow n`, REPEAT GEN_TAC THEN REWRITE_TAC[BIT0; QUAT_POW_ADD] THEN REWRITE_TAC[GSYM QUAT_POW_2; QUAT_POW_POW; MULT_SYM]) and QUAT_POW_BIT1 = prove (`!x n. x pow BIT1 n = x * (x * x) pow n`, REPEAT GEN_TAC THEN REWRITE_TAC[BIT1; quat_pow; QUAT_POW_ADD] THEN REWRITE_TAC[GSYM QUAT_POW_2; QUAT_POW_POW; MULT_SYM]) and QUAT_POW_0 = prove (`!x. x pow _0 = Hx(&1)`, REWRITE_TAC[DENUMERAL quat_pow; NUMERAL]) in let rec PRE_POW_CONV tm = (REWR_CONV QUAT_POW_0 ORELSEC (REWR_CONV QUAT_POW_BIT0 THENC LAND_CONV PRE_MUL_CONV THENC PRE_POW_CONV) ORELSEC (REWR_CONV QUAT_POW_BIT1 THENC RAND_CONV (LAND_CONV PRE_MUL_CONV THENC PRE_POW_CONV) THENC PRE_MUL_CONV) ORELSEC ALL_CONV) tm in REWR_CONV QUAT_POW_DENUMERAL THENC PRE_POW_CONV in (* ---------------------------------------------------------------------- *) (* Glue all together. *) (* ---------------------------------------------------------------------- *) let rec POLY_CONV tm = if is_quat_add tm then ADD_CONV tm else if is_quat_mul tm then MUL_CONV tm else if is_quat_pow tm then POW_CONV tm else ALL_CONV tm and ADD_CONV tm = (BINOP_CONV POLY_CONV THENC PRE_ADD_CONV) tm and MUL_CONV tm = (BINOP_CONV POLY_CONV THENC PRE_MUL_CONV) tm and POW_CONV tm = (LAND_CONV POLY_CONV THENC RAND_CONV NUM_NORMALIZE_CONV THENC TRY_CONV PRE_POW_CONV) tm in (* ---------------------------------------------------------------------- *) (* Initial normalization. *) (* ---------------------------------------------------------------------- *) let QUAT_DESUGAR_CONV = let QUAT_DESUGAR_CLAUSES = prove (`(!x. Hx (&0) + x = x) /\ (!x. --x = Hx (-- &1) * x) /\ (!x y. x - y = x + Hx (-- &1) * y) /\ (!x. Hx (&1) * x = x) /\ (!x. x * Hx (&1) = x) /\ (!x. Hx (&0) * x = Hx (&0)) /\ (!x. x * Hx (&0) = Hx (&0)) /\ (!x. x pow 0 = Hx (&1)) /\ (!x y. cnj (x + y) = cnj x + cnj y) /\ (!x y. cnj (x * y) = cnj y * cnj x) /\ (!x. cnj (inv x) = inv (cnj x)) /\ (!x n. cnj (x pow n) = cnj x pow n) /\ (!a. cnj (Hx a) = Hx a) /\ cnj ii = Hx(-- &1) * ii /\ cnj jj = Hx(-- &1) * jj /\ cnj kk = Hx(-- &1) * kk`, REWRITE_TAC[QUAT_POLY_CLAUSES; QUAT_CNJ_ADD; QUAT_CNJ_MUL; QUAT_CNJ_INV; QUAT_CNJ_POW; CNJ_HX; QUAT_CNJ_UNITS]) in REWRITE_CONV[QUAT_DESUGAR_CLAUSES] in (* ---------------------------------------------------------------------- *) (* Main call. *) (* ---------------------------------------------------------------------- *) QUAT_DESUGAR_CONV THENC POLY_CONV;; (* ------------------------------------------------------------------------- *) (* Some handy rules derived from QUAT_POLY_CONV. *) (* ------------------------------------------------------------------------- *) let QUAT_EQ_CONV : conv = BINOP_CONV QUAT_POLY_CONV THENC REWR_CONV REFL_CLAUSE;; let QUAT_POLY tm = prove(tm, REPEAT GEN_TAC THEN CONV_TAC QUAT_EQ_CONV);; hol-light/Quaternions/quaternion.hl000066400000000000000000001325141303454263000177750ustar00rootroot00000000000000(* ========================================================================= *) (* The type "real^4" regarded as the quaternions. *) (* *) (* Copyright (c) 2014 Marco Maggesi *) (* ========================================================================= *) new_type_abbrev("quat",`:real^4`);; make_overloadable "Re" `:real^N->real`;; make_overloadable "ii" `:real^N`;; make_overloadable "cnj" `:real^N->real^N`;; make_overloadable "real" `:real^N->bool`;; overload_interface("Re",mk_mconst("Re",`:complex->real`));; overload_interface("ii",mk_mconst("ii",`:complex`));; overload_interface("cnj",mk_mconst("cnj",`:complex->complex`));; overload_interface("real",mk_mconst("real",`:complex->bool`));; let prioritize_quat() = overload_interface("--",`vector_neg:quat->quat`); overload_interface("+",`vector_add:quat->quat->quat`); overload_interface("-",`vector_sub:quat->quat->quat`); overload_interface("*",`quat_mul:quat->quat->quat`); overload_interface("pow",`quat_pow:quat->num->quat`); overload_interface("inv",`quat_inv:quat->quat`); overload_interface("Re",`quat_Re:quat->real`); overload_interface("ii",`quat_ii:quat`); overload_interface("cnj",`quat_cnj:quat->quat`); overload_interface("real",`quat_real:quat->bool`);; prioritize_quat();; (* ------------------------------------------------------------------------- *) (* Real components of a quaternion. *) (* ------------------------------------------------------------------------- *) let QUAT_RE_DEF = new_definition `Re(x:quat) = x$1`;; let QUAT_IM1_DEF = new_definition `Im1(x:quat) = x$2`;; let QUAT_IM2_DEF = new_definition `Im2(x:quat) = x$3`;; let QUAT_IM3_DEF = new_definition `Im3(x:quat) = x$4`;; let QUAT_COMPONENTS_DEF = end_itlist CONJ [QUAT_RE_DEF; QUAT_IM1_DEF; QUAT_IM2_DEF; QUAT_IM3_DEF];; (* ------------------------------------------------------------------------- *) (* Real injection and imaginary units. *) (* ------------------------------------------------------------------------- *) let quat = new_definition `quat(x,y,z,w) = vector[x;y;z;w]:quat`;; let HX_DEF = new_definition `Hx(a) = quat(a,&0,&0,&0)`;; let quat_ii = new_definition `ii = quat(&0,&1,&0,&0)`;; let quat_jj = new_definition `jj = quat(&0,&0,&1,&0)`;; let quat_kk = new_definition `kk = quat(&0,&0,&0,&1)`;; (* ------------------------------------------------------------------------- *) (* Quaternionic mulplication. *) (* ------------------------------------------------------------------------- *) let quat_mul = new_definition `p * q = quat(Re p * Re q - Im1 p * Im1 q - Im2 p * Im2 q - Im3 p * Im3 q, Re p * Im1 q + Im1 p * Re q + Im2 p * Im3 q - Im3 p * Im2 q, Re p * Im2 q - Im1 p * Im3 q + Im2 p * Re q + Im3 p * Im1 q, Re p * Im3 q + Im1 p * Im2 q - Im2 p * Im1 q + Im3 p * Re q)`;; let quat_inv = new_definition `inv q = quat( Re q / (Re q pow 2 + Im1 q pow 2 + Im2 q pow 2 + Im3 q pow 2), --(Im1 q) / (Re q pow 2 + Im1 q pow 2 + Im2 q pow 2 + Im3 q pow 2), --(Im2 q) / (Re q pow 2 + Im1 q pow 2 + Im2 q pow 2 + Im3 q pow 2), --(Im3 q) / (Re q pow 2 + Im1 q pow 2 + Im2 q pow 2 + Im3 q pow 2))`;; let quat_pow = define `(q pow 0 = Hx(&1)) /\ (!n. q pow (SUC n) = q * q pow n)`;; (* ------------------------------------------------------------------------- *) (* Various handy rewrites. *) (* ------------------------------------------------------------------------- *) let QUAT_COMPONENTS = prove (` Re(quat(x,y,z,w)) = x /\ Im1(quat(x,y,z,w)) = y /\ Im2(quat(x,y,z,w)) = z /\ Im3(quat(x,y,z,w)) = w`, REWRITE_TAC[QUAT_COMPONENTS_DEF; quat; VECTOR_4]);; let HX_COMPONENTS = prove (`(!a. Re(Hx a) = a) /\ (!a. Im1(Hx a) = &0) /\ (!a. Im2(Hx a) = &0) /\ (!a. Im3(Hx a) = &0)`, REWRITE_TAC[HX_DEF; QUAT_COMPONENTS]);; let QUAT_UNITS_COMPONENTS = prove ( `Re(ii:quat) = &0 /\ Im1(ii:quat) = &1 /\ Im2(ii:quat) = &0 /\ Im3(ii:quat) = &0 /\ Re(jj:quat) = &0 /\ Im1(jj:quat) = &0 /\ Im2(jj:quat) = &1 /\ Im3(jj:quat) = &0 /\ Re(kk:quat) = &0 /\ Im1(kk:quat) = &0 /\ Im2(kk:quat) = &0 /\ Im3(kk:quat) = &1`, REWRITE_TAC[quat_ii; quat_jj; quat_kk; QUAT_COMPONENTS]);; let QUAT_EQ = prove (`!p q. p = q <=> Re p = Re q /\ Im1 p = Im1 q /\ Im2 p = Im2 q /\ Im3 p = Im3 q`, SIMP_TAC[CART_EQ; FORALL_4; DIMINDEX_4; QUAT_COMPONENTS_DEF]);; let QUAT = prove (`!q. quat(Re(q),Im1(q),Im2(q),Im3(q)) = q`, REWRITE_TAC[QUAT_EQ; QUAT_COMPONENTS]);; let QUAT_EQ_0 = prove (`q = Hx(&0) <=> Re q pow 2 + Im1 q pow 2 + Im2 q pow 2 + Im3 q pow 2 = &0`, REWRITE_TAC[QUAT_EQ; HX_DEF; QUAT_COMPONENTS] THEN EQ_TAC THEN SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `!x y z w:real. x + y + z + w = &0 ==> &0 <= x /\ &0 <= y /\ &0 <= z /\ &0 <= w ==> x = &0 /\ y = &0 /\ z = &0 /\ w = &0`)) THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE]);; let FORALL_QUAT = prove (`(!q. P q) <=> (!x y z w. P(quat(x,y,z,w)))`, MESON_TAC[QUAT]);; let EXISTS_QUAT = prove (`(?q. P q) <=> (?x y z w. P(quat(x,y,z,w)))`, MESON_TAC[QUAT]);; (* ------------------------------------------------------------------------- *) (* Pseudo-definitions of other general vector concepts over R^4. *) (* ------------------------------------------------------------------------- *) let quat_neg = prove (`--q = quat(--(Re q),--(Im1 q),--(Im2 q),--(Im3 q))`, REWRITE_TAC[QUAT_EQ; QUAT_COMPONENTS] THEN REWRITE_TAC[QUAT_COMPONENTS_DEF] THEN SIMP_TAC[VECTOR_NEG_COMPONENT; DIMINDEX_4; ARITH]);; let quat_add = prove (`p + q = quat(Re p + Re q,Im1 p + Im1 q,Im2 p + Im2 q,Im3 p + Im3 q)`, REWRITE_TAC[QUAT_EQ; QUAT_COMPONENTS] THEN REWRITE_TAC[QUAT_COMPONENTS_DEF] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; DIMINDEX_4; ARITH]);; let quat_sub = VECTOR_ARITH `(p:quat) - q = p + --q`;; let quat_norm = prove (`norm q = sqrt(Re q pow 2 + Im1 q pow 2 + Im2 q pow 2 + Im3 q pow 2)`, REWRITE_TAC[vector_norm; dot; QUAT_COMPONENTS_DEF; SUM_4; DIMINDEX_4] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let QUAT_SQNORM = prove (`norm q pow 2 = Re q pow 2 + Im1 q pow 2 + Im2 q pow 2 + Im3 q pow 2`, REWRITE_TAC[NORM_POW_2; dot; QUAT_COMPONENTS_DEF; SUM_4; DIMINDEX_4] THEN REAL_ARITH_TAC);; let NORM_HX = prove (`(!a. norm (Hx a) = abs a)`, REWRITE_TAC[quat_norm; HX_COMPONENTS] THEN CONV_TAC (ONCE_DEPTH_CONV (CHANGED_CONV REAL_POLY_CONV)) THEN REWRITE_TAC[POW_2_SQRT_ABS]);; let QUAT_NORM_UNITS = prove (`norm (ii:quat) = &1 /\ norm (jj:quat) = &1 /\ norm (kk:quat) = &1`, REWRITE_TAC[quat_norm; QUAT_UNITS_COMPONENTS] THEN CONV_TAC (ONCE_DEPTH_CONV (CHANGED_CONV REAL_POLY_CONV)) THEN REWRITE_TAC[SQRT_1]);; (* ------------------------------------------------------------------------- *) (* Crude tactic to automate very simple algebraic equivalences. *) (* ------------------------------------------------------------------------- *) let SIMPLE_QUAT_ARITH_TAC = REWRITE_TAC[QUAT_EQ; QUAT_COMPONENTS; HX_DEF; quat_add; quat_neg; quat_sub; quat_mul; quat_inv] THEN CONV_TAC REAL_FIELD;; let SIMPLE_QUAT_ARITH tm = prove(tm,SIMPLE_QUAT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Basic algebraic properties that can be proved automatically by this. *) (* ------------------------------------------------------------------------- *) let QUAT_ADD_SYM = prove (`!x y. x + y = y + x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_ASSOC = prove (`!x y z. x + y + z = (x + y) + z`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_LID = prove (`!x. Hx(&0) + x = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_LINV = prove (`!x. --x + x = Hx(&0)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_HX_SYM = prove (`!q a. q * Hx a = Hx a * q`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_ASSOC = prove (`!x y z. x * y * z = (x * y) * z`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_LID = prove (`!x. Hx(&1) * x = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_LDISTRIB = prove (`!x y z. x * (y + z) = x * y + x * z`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_AC = prove (`(p + q:quat = q + p) /\ ((p + q) + r = p + q + r) /\ (p + q + r = q + p + r)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_RID = prove (`!x. x + Hx(&0) = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_RID = prove (`!x. x * Hx(&1) = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_RINV = prove (`!x. x + --x = Hx(&0)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_RDISTRIB = prove (`!x y z. (x + y) * z = x * z + y * z`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_ADD_LCANCEL = prove (`!x y z. (x + y = x + z) <=> (y = z)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_ADD_RCANCEL = prove (`!x y z. (x + z = y + z) <=> (x = y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_RZERO = prove (`!x. x * Hx(&0) = Hx(&0)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_LZERO = prove (`!x. Hx(&0) * x = Hx(&0)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_NEG = prove (`!x. --(--x) = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_RNEG = prove (`!x y. x * --y = --(x * y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_LNEG = prove (`!x y. --x * y = --(x * y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_ADD = prove (`!x y. --(x + y) = --x + --y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_0 = prove (`--Hx(&0) = Hx(&0)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_ADD_LCANCEL_0 = prove (`!x y. (x + y = x) <=> (y = Hx(&0))`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_ADD_RCANCEL_0 = prove (`!x y. (x + y = y) <=> (x = Hx(&0))`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_LNEG_UNIQ = prove (`!x y. (x + y = Hx(&0)) <=> (x = --y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_RNEG_UNIQ = prove (`!x y. (x + y = Hx(&0)) <=> (y = --x)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_LMUL = prove (`!x y. --(x * y) = --x * y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_RMUL = prove (`!x y. --(x * y) = x * --y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_MUL2 = prove (`!x y. --x * --y = x * y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_ADD = prove (`!x y. x - y + y = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_ADD2 = prove (`!x y. y + x - y = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_REFL = prove (`!x. x - x = Hx(&0)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_0 = prove (`!x y. (x - y = Hx(&0)) <=> (x = y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_EQ_0 = prove (`!x. (--x = Hx(&0)) <=> (x = Hx(&0))`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_SUB = prove (`!x y. --(x - y) = y - x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_SUB = prove (`!x y. (x + y) - x = y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_EQ = prove (`!x y. (--x = y) <=> (x = --y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_NEG_MINUS1 = prove (`!x. --x = --Hx(&1) * x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_SUB = prove (`!x y. x - y - x = --y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD2_SUB2 = prove (`!a b c d. (a + b) - (c + d) = a - c + b - d`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_LZERO = prove (`!x. Hx(&0) - x = --x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_RZERO = prove (`!x. x - Hx(&0) = x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_LNEG = prove (`!x y. --x - y = --(x + y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_RNEG = prove (`!x y. x - --y = x + y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_NEG2 = prove (`!x y. --x - --y = y - x`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_TRIANGLE = prove (`!a b c. a - b + b - c = a - c`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_SUB_LADD = prove (`!x y z. (x = y - z) <=> (x + z = y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_SUB_RADD = prove (`!x y z. (x - y = z) <=> (x = z + y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_SUB2 = prove (`!x y. x - (x - y) = y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_ADD_SUB2 = prove (`!x y. x - (x + y) = --y`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_NEG2 = prove (`!x y. (--x = --y) <=> (x = y)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_LDISTRIB = prove (`!x y z. x * (y - z) = x * y - x * z`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_SUB_RDISTRIB = prove (`!x y z. (x - y) * z = x * z - y * z`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_2 = prove (`!x. Hx(&2) * x = x + x`, SIMPLE_QUAT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Sometimes here we need to tweak non-zeroness assertions. *) (* ------------------------------------------------------------------------- *) let QUAT_II_NZ = prove (`~(ii = Hx(&0))`, REWRITE_TAC[quat_ii] THEN SIMPLE_QUAT_ARITH_TAC);; let QUAT_JJ_NZ = prove (`~(jj = Hx(&0))`, REWRITE_TAC[quat_jj] THEN SIMPLE_QUAT_ARITH_TAC);; let QUAT_KK_NZ = prove (`~(kk = Hx(&0))`, REWRITE_TAC[quat_kk] THEN SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_LINV = prove (`!q. ~(q = Hx(&0)) ==> (inv(q) * q = Hx(&1))`, REWRITE_TAC[QUAT_EQ_0] THEN SIMPLE_QUAT_ARITH_TAC);; let QUAT_ENTIRE = prove (`!x y. (x * y = Hx(&0)) <=> (x = Hx(&0)) \/ (y = Hx(&0))`, REWRITE_TAC[QUAT_EQ_0] THEN SIMPLE_QUAT_ARITH_TAC);; let QUAT_MUL_RINV = prove (`!q. ~(q = Hx(&0)) ==> (q * inv(q) = Hx(&1))`, REWRITE_TAC[QUAT_EQ_0] THEN SIMPLE_QUAT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Homomorphic embedding properties for Hx mapping. *) (* ------------------------------------------------------------------------- *) let HX_INJ = prove (`!x y. (Hx(x) = Hx(y)) <=> (x = y)`, REWRITE_TAC[HX_DEF; QUAT_EQ; QUAT_COMPONENTS]);; let HX_NEG = prove (`!x. Hx(--x) = --(Hx(x))`, REWRITE_TAC[HX_DEF; quat_neg; QUAT_COMPONENTS; REAL_NEG_0]);; let HX_ADD = prove (`!x y. Hx(x + y) = Hx(x) + Hx(y)`, REWRITE_TAC[HX_DEF; quat_add; QUAT_COMPONENTS; REAL_ADD_LID]);; let HX_SUB = prove (`!x y. Hx(x - y) = Hx(x) - Hx(y)`, REWRITE_TAC[quat_sub; real_sub; HX_ADD; HX_NEG]);; let HX_INV = prove (`!x. Hx(inv x) = inv(Hx x)`, GEN_TAC THEN REWRITE_TAC[HX_DEF; quat_inv; QUAT_COMPONENTS; QUAT_EQ] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; let HX_MUL = prove (`!x y. Hx(x * y) = Hx(x) * Hx(y)`, REWRITE_TAC[HX_DEF; quat_mul; QUAT_COMPONENTS; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_SUB_RZERO; REAL_ADD_RID]);; let HX_POW = prove (`!x n. Hx(x pow n) = Hx(x) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[quat_pow; real_pow; HX_MUL]);; let HX_ABS = prove (`!x. Hx(abs x) = Hx(norm(Hx(x)))`, REWRITE_TAC[HX_DEF; quat_norm; QUAT_EQ; QUAT_COMPONENTS] THEN REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);; (* ------------------------------------------------------------------------- *) (* Some "linear" things hold for the Re and ImN's too. *) (* ------------------------------------------------------------------------- *) let QUAT_ADD_COMPONENTS = prove (`(!x y:quat. Re(x + y) = Re(x) + Re(y)) /\ (!x y:quat. Im1(x + y) = Im1(x) + Im1(y)) /\ (!x y:quat. Im2(x + y) = Im2(x) + Im2(y)) /\ (!x y:quat. Im3(x + y) = Im3(x) + Im3(y))`, REWRITE_TAC[quat_add; QUAT_COMPONENTS]);; let QUAT_NEG_COMPONENTS = prove (`(!x:quat. Re(--x) = --Re(x)) /\ (!x:quat. Im1(--x) = --Im1(x)) /\ (!x:quat. Im2(--x) = --Im2(x)) /\ (!x:quat. Im3(--x) = --Im3(x))`, REWRITE_TAC[quat_neg; QUAT_COMPONENTS]);; let QUAT_SUB_COMPONENTS = prove (`(!x y:quat. Re(x - y) = Re(x) - Re(y)) /\ (!x y:quat. Im1(x - y) = Im1(x) - Im1(y)) /\ (!x y:quat. Im2(x - y) = Im2(x) - Im2(y)) /\ (!x y:quat. Im3(x - y) = Im3(x) - Im3(y))`, REWRITE_TAC[quat_sub; real_sub; QUAT_ADD_COMPONENTS; QUAT_NEG_COMPONENTS]);; (* ------------------------------------------------------------------------- *) (* An "expansion" theorem into the traditional notation. *) (* ------------------------------------------------------------------------- *) let QUAT_EXPAND = time prove (`!q. q = Hx(Re q) + ii * Hx(Im1 q) + jj * Hx(Im2 q) + kk * Hx(Im3 q)`, REWRITE_TAC[quat_ii; quat_jj; quat_kk] THEN SIMPLE_QUAT_ARITH_TAC);; let QUAT_TRAD = time prove (`!x y z w. quat(x,y,z,w) = Hx(x) + ii * Hx(y) + jj * Hx(z) + kk * Hx(w)`, REWRITE_TAC[quat_ii; quat_jj; quat_kk] THEN SIMPLE_QUAT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Basic relations between projections and immaginary units. *) (* ------------------------------------------------------------------------- *) let QUAT_MUL_UNITS_COMPONENTS = prove (`(!q:quat. Re(q * ii) = --Im1 q /\ Re(ii * q) = --Im1 q) /\ (!q:quat. Im1(q * ii) = Re q /\ Im1(ii * q) = Re q) /\ (!q:quat. Im2(q * ii) = Im3 q /\ Im2(ii * q) = --Im3 q) /\ (!q:quat. Im3(q * ii) = --Im2 q /\ Im3(ii * q) = Im2 q) /\ (!q:quat. Re(q * jj) = --Im2 q /\ Re(jj * q) = --Im2 q) /\ (!q:quat. Im1(q * jj) = --Im3 q /\ Im1(jj * q) = Im3 q) /\ (!q:quat. Im2(q * jj) = Re q /\ Im2(jj * q) = Re q) /\ (!q:quat. Im3(q * jj) = Im1 q /\ Im3(jj * q) = --Im1 q) /\ (!q:quat. Re(q * kk) = --Im3 q /\ Re(kk * q) = --Im3 q) /\ (!q:quat. Im1(q * kk) = Im2 q /\ Im1(kk * q) = --Im2 q) /\ (!q:quat. Im2(q * kk) = --Im1 q /\ Im2(kk * q) = Im1 q) /\ (!q:quat. Im3(q * kk) = Re q /\ Im3(kk * q) = Re q)`, REWRITE_TAC[quat_mul; QUAT_COMPONENTS; QUAT_UNITS_COMPONENTS] THEN CONV_TAC REAL_ARITH);; (* ------------------------------------------------------------------------- *) (* Limited "multiplicative" theorems for Re, and ImN's. *) (* ------------------------------------------------------------------------- *) let QUAT_CMUL_COMPONENTS = prove (`(!a q:quat. Re(a % q) = a * Re q) /\ (!a q:quat. Im1(a % q) = a * Im1 q) /\ (!a q:quat. Im2(a % q) = a * Im2 q) /\ (!a q:quat. Im3(a % q) = a * Im3 q)`, REWRITE_TAC[QUAT_COMPONENTS_DEF; VECTOR_MUL_COMPONENT]);; let MUL_HX_COMPONENTS = prove (`(!x q. Re(Hx(x) * q) = x * Re q) /\ (!x q. Re(q * Hx(x)) = Re q * x) /\ (!x q. Im1(Hx(x) * q) = x * Im1 q) /\ (!x q. Im1(q * Hx(x)) = Im1 q * x) /\ (!x q. Im2(Hx(x) * q) = x * Im2 q) /\ (!x q. Im2(q * Hx(x)) = Im2 q * x) /\ (!x q. Im3(Hx(x) * q) = x * Im3 q) /\ (!x q. Im3(q * Hx(x)) = Im3 q * x)`, SIMPLE_QUAT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Syntax constructors etc. for quaternionic constants. *) (* ------------------------------------------------------------------------- *) let is_quat_const = let hx_tm = `Hx` in fun tm -> is_comb tm && let l,r = dest_comb tm in l = hx_tm && is_ratconst r;; let dest_quat_const = let hx_tm = `Hx` in fun tm -> let l,r = dest_comb tm in if l = hx_tm then rat_of_term r else failwith "dest_quat_const";; let mk_quat_const = let hx_tm = `Hx` in fun r -> mk_comb(hx_tm,term_of_rat r);; (* ------------------------------------------------------------------------- *) (* Conversions for arithmetic on quaternionic constants. *) (* ------------------------------------------------------------------------- *) let QUAT_RAT_EQ_CONV = GEN_REWRITE_CONV I [HX_INJ] THENC REAL_RAT_EQ_CONV;; let QUAT_RAT_MUL_CONV = GEN_REWRITE_CONV I [GSYM HX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;; let QUAT_RAT_ADD_CONV = GEN_REWRITE_CONV I [GSYM HX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;; let QUAT_RAT_POW_CONV = let x_tm = `x:real` and n_tm = `n:num` in let pth = SYM(SPECL [x_tm; n_tm] HX_POW) in fun tm -> let lop,r = dest_comb tm in let op,bod = dest_comb lop in let th1 = INST [rand bod,x_tm; r,n_tm] pth in let tm1,tm2 = dest_comb(concl th1) in if rand tm1 <> tm then failwith "QUAT_RAT_POW_CONV" else let tm3,tm4 = dest_comb tm2 in TRANS th1 (AP_TERM tm3 (REAL_RAT_REDUCE_CONV tm4));; let QUAT_POW_SUC_ALT = prove (`!x n. x pow (SUC n) = x pow n * x`, GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[quat_pow] THEN SIMPLE_QUAT_ARITH_TAC; ONCE_REWRITE_TAC[quat_pow] THEN ASM_REWRITE_TAC[] THEN SIMPLE_QUAT_ARITH_TAC]);; let QUAT_POW_LMUL_SYM = prove (`!p q n. p * q = q * p ==> p * q pow n = q pow n * p`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[quat_pow; QUAT_MUL_LID; QUAT_MUL_RID; QUAT_MUL_ASSOC] THEN ASM_REWRITE_TAC[GSYM QUAT_MUL_ASSOC]);; let QUAT_POW_RMUL_SYM = prove (`!p q m. p * q = q * p ==> p pow m * q = q * p pow m`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[quat_pow; QUAT_MUL_LID; QUAT_MUL_RID] THEN ASM_REWRITE_TAC[GSYM QUAT_MUL_ASSOC] THEN ASM_REWRITE_TAC[QUAT_MUL_ASSOC]);; let QUAT_POW_MUL_SYM = prove (`!p q m n. p * q = q * p ==> p pow m * q pow n = q pow n * p pow m`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[quat_pow; QUAT_MUL_LID; QUAT_MUL_RID; GSYM QUAT_MUL_ASSOC] THEN GEN_TAC THEN REWRITE_TAC[QUAT_MUL_ASSOC] THEN ASM_SIMP_TAC[QUAT_POW_LMUL_SYM]);; let QUAT_POLY_CLAUSES = prove (`(!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. Hx(&0) + x = x) /\ (!x. --x = Hx(-- &1) * x) /\ (!x y. x - y = x + Hx(-- &1) * y) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x. Hx(&1) * x = x) /\ (!x. x * Hx(&1) = x) /\ (!x. Hx(&0) * x = Hx(&0)) /\ (!x. x * Hx(&0) = Hx(&0)) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x y z. (y + z) * x = y * x + z * x) /\ (!x. x pow 0 = Hx(&1)) /\ (!x n. x pow (SUC n) = x * x pow n) /\ (!x n. x pow (SUC n) = x pow n * x)`, REWRITE_TAC[GSYM (CONJUNCT2 quat_pow); GSYM QUAT_POW_SUC_ALT] THEN REWRITE_TAC[quat_pow] THEN SIMPLE_QUAT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Most basic properties of inverses. *) (* ------------------------------------------------------------------------- *) let QUAT_INV_0 = prove (`inv(Hx(&0)) = Hx(&0)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_INV_1 = prove (`inv(Hx(&1)) = Hx(&1)`, SIMPLE_QUAT_ARITH_TAC);; let QUAT_EQ_MUL_LCANCEL = prove (`!x y z. (x * y = x * z) <=> (x = Hx(&0)) \/ (y = z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[QUAT_MUL_LZERO]] THEN STRIP_TAC THEN SUBGOAL_THEN `x * (y - z) = Hx(&0)` MP_TAC THENL [ASM_REWRITE_TAC[QUAT_SUB_LDISTRIB; QUAT_SUB_REFL]; REWRITE_TAC[QUAT_ENTIRE; QUAT_SUB_0]]);; let QUAT_EQ_MUL_RCANCEL = prove (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = Hx(&0))`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[QUAT_MUL_RZERO]] THEN STRIP_TAC THEN SUBGOAL_THEN `(x - y) * z = Hx(&0)` MP_TAC THENL [ASM_REWRITE_TAC[QUAT_SUB_RDISTRIB; QUAT_SUB_REFL]; REWRITE_TAC[QUAT_ENTIRE; QUAT_SUB_0]]);; let QUAT_MUL_LCANCEL = prove (`!x y z. ~(x = Hx(&0)) /\ x * y = x * z ==> y = z`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(inv x * x:quat) * y` THEN CONJ_TAC THENL [ASM_SIMP_TAC[QUAT_MUL_LINV; QUAT_MUL_LID]; ASM_REWRITE_TAC[GSYM QUAT_MUL_ASSOC] THEN ASM_SIMP_TAC[QUAT_MUL_ASSOC; QUAT_MUL_LINV; QUAT_MUL_LID]]);; let QUAT_MUL_RCANCEL = prove (`!x y z. ~(x = Hx(&0)) /\ y * x = z * x ==> y = z`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `y * (x * inv x:quat)` THEN CONJ_TAC THENL [ASM_SIMP_TAC[QUAT_MUL_RINV; QUAT_MUL_RID]; ASM_REWRITE_TAC[QUAT_MUL_ASSOC] THEN ASM_SIMP_TAC[GSYM QUAT_MUL_ASSOC; QUAT_MUL_RINV; QUAT_MUL_RID]]);; let QUAT_INV_MUL = prove (`!p q. inv(p * q) = inv(q) * inv(p)`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`p = Hx(&0)`; `q = Hx(&0)`] THEN ASM_REWRITE_TAC[QUAT_INV_0; QUAT_MUL_LZERO; QUAT_MUL_RZERO] THEN MATCH_MP_TAC QUAT_MUL_LCANCEL THEN EXISTS_TAC `q:quat` THEN ASM_SIMP_TAC[QUAT_MUL_ASSOC; QUAT_MUL_RINV; QUAT_MUL_LID] THEN MATCH_MP_TAC QUAT_MUL_LCANCEL THEN EXISTS_TAC `p:quat` THEN ASM_SIMP_TAC[QUAT_MUL_ASSOC; QUAT_MUL_RINV; QUAT_MUL_LID; QUAT_ENTIRE]);; let QUAT_POW_INV = prove (`!x n. (inv x) pow n = inv(x pow n)`, GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[quat_pow; QUAT_INV_1]; GEN_REWRITE_TAC LAND_CONV [quat_pow] THEN ASM_REWRITE_TAC[QUAT_POW_SUC_ALT; QUAT_INV_MUL]]);; let QUAT_INV_0_EQ = prove (`!q. inv q = Hx(&0) <=> q = Hx(&0)`, GEN_TAC THEN ASM_CASES_TAC `q = Hx(&0)` THEN ASM_REWRITE_TAC[QUAT_INV_0] THEN STRIP_TAC THEN SUBGOAL_THEN `inv q * q = Hx(&0)` MP_TAC THENL [ASM_REWRITE_TAC[QUAT_MUL_LZERO]; ALL_TAC] THEN ASM_SIMP_TAC[QUAT_MUL_LINV; HX_INJ; REAL_OF_NUM_EQ] THEN ARITH_TAC);; let QUAT_INV_INV = prove (`!q:quat. inv(inv q) = q`, GEN_TAC THEN ASM_CASES_TAC `q = Hx(&0)` THEN ASM_REWRITE_TAC[QUAT_INV_0] THEN MATCH_MP_TAC QUAT_MUL_LCANCEL THEN EXISTS_TAC `inv q` THEN ASM_SIMP_TAC[QUAT_INV_0_EQ; QUAT_MUL_LINV; QUAT_MUL_RINV]);; (* ------------------------------------------------------------------------- *) (* Powers. *) (* ------------------------------------------------------------------------- *) let QUAT_POW_ADD = prove (`!x m n. x pow (m + n) = x pow m * x pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; quat_pow; QUAT_MUL_LID; QUAT_MUL_ASSOC]);; let QUAT_POW_POW = prove (`!x m n. (x pow m) pow n = x pow (m * n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[quat_pow; MULT_CLAUSES; QUAT_POW_ADD]);; let QUAT_POW_1 = prove (`!x. x pow 1 = x`, REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[quat_pow; QUAT_MUL_RID]);; let QUAT_POW_2 = prove (`!x. x pow 2 = x * x`, REWRITE_TAC[num_CONV `2`] THEN REWRITE_TAC[quat_pow; QUAT_POW_1]);; let QUAT_POW_NEG = prove (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[quat_pow; EVEN] THEN ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[QUAT_MUL_RNEG; QUAT_MUL_LNEG; QUAT_NEG_NEG]);; let QUAT_POW_ONE = prove (`!n. Hx(&1) pow n = Hx(&1)`, INDUCT_TAC THEN ASM_REWRITE_TAC[quat_pow; QUAT_MUL_LID]);; let QUAT_MUL_POW_SYM = prove (`!n x y. x * y = y * x ==> x * y pow n = y pow n * x`, INDUCT_TAC THEN REWRITE_TAC[quat_pow; QUAT_MUL_LID; QUAT_MUL_RID] THEN ASM_SIMP_TAC[QUAT_MUL_ASSOC] THEN SIMP_TAC[GSYM QUAT_MUL_ASSOC]);; let QUAT_POW_MUL = prove (`!n x y. x * y = y * x ==> (x * y) pow n = (x pow n) * (y pow n)`, INDUCT_TAC THEN REWRITE_TAC[quat_pow; QUAT_MUL_LID] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM QUAT_MUL_ASSOC] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[QUAT_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[QUAT_MUL_POW_SYM]);; let QUAT_POW_UNITS_2 = prove (`ii pow 2 = --Hx(&1) /\ jj pow 2 = --Hx(&1) /\ kk pow 2 = --Hx(&1)`, REWRITE_TAC[quat_ii; quat_jj; quat_kk; QUAT_POW_2; quat_mul; HX_DEF; QUAT_COMPONENTS; quat_neg] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; let QUAT_POW_EQ_0 = prove (`!x n. (x pow n = Hx(&0)) <=> (x = Hx(&0)) /\ ~(n = 0)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC; quat_pow; QUAT_ENTIRE] THENL [SIMPLE_QUAT_ARITH_TAC; CONV_TAC TAUT]);; let QUAT_POW_ZERO = prove (`!n. Hx(&0) pow n = if n = 0 then Hx(&1) else Hx(&0)`, INDUCT_TAC THEN REWRITE_TAC[quat_pow; QUAT_MUL_LZERO; NOT_SUC]);; let QUAT_INV_UNITS = prove (`inv ii:quat = --ii /\ inv jj:quat = --jj /\ inv kk:quat = --kk`, REWRITE_TAC[quat_ii; quat_jj; quat_kk; quat_inv; QUAT_COMPONENTS; quat_neg] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; (* ------------------------------------------------------------------------- *) (* Norms (aka "moduli"). *) (* ------------------------------------------------------------------------- *) let QUAT_VEC_0 = prove (`vec 0 = Hx(&0)`, SIMP_TAC[CART_EQ; VEC_COMPONENT; HX_DEF; quat; DIMINDEX_4; FORALL_4; VECTOR_4]);; let QUAT_NORM_ZERO = prove (`!q. (norm q = &0) <=> (q = Hx(&0))`, REWRITE_TAC[NORM_EQ_0; QUAT_VEC_0]);; let QUAT_NORM_NUM = prove (`!n. norm(Hx(&n)) = &n`, REWRITE_TAC[NORM_HX; REAL_ABS_NUM]);; let QUAT_NORM_0 = prove (`norm(Hx(&0)) = &0`, MESON_TAC[QUAT_NORM_ZERO]);; let QUAT_NORM_NZ = prove (`!q. &0 < norm(q) <=> ~(q = Hx(&0))`, REWRITE_TAC[NORM_POS_LT; QUAT_VEC_0]);; let QUAT_NORM_MUL = prove (`!p q. norm(p * q) = norm(p) * norm(q)`, REPEAT GEN_TAC THEN REWRITE_TAC[quat_norm; quat_mul; QUAT_COMPONENTS; GSYM SQRT_MUL] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; let QUAT_NORM_POW = prove (`!q n. norm(q pow n) = norm(q) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[quat_pow; real_pow; QUAT_NORM_NUM; QUAT_NORM_MUL]);; let QUAT_NORM_INV = prove (`!q. norm(inv q) = inv(norm q)`, REWRITE_TAC[FORALL_QUAT] THEN REPEAT GEN_TAC THEN REWRITE_TAC[quat_norm; quat_inv; QUAT_COMPONENTS; GSYM SQRT_INV] THEN AP_TERM_TAC THEN REWRITE_TAC[real_div; REAL_POW_2] THEN ASM_CASES_TAC `x * x + y * y + z * z + w * w = &0` THENL [ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_RZERO; REAL_ADD_LID]; MATCH_MP_TAC(GSYM REAL_MUL_RINV_UNIQ) THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD]);; let QUAT_NORM_TRIANGLE_SUB = prove (`!p q. norm(p) <= norm(p + q) + norm(q)`, MESON_TAC[NORM_TRIANGLE; NORM_NEG; QUAT_ADD_ASSOC; QUAT_ADD_RINV; QUAT_ADD_RID]);; let QUAT_NORM_ABS_NORM = prove (`!p q. abs(norm p - norm q) <= norm(p - q)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a - b <= x /\ b - a <= x ==> abs(a - b) <= x:real`) THEN MESON_TAC[QUAT_NEG_SUB; NORM_NEG; REAL_LE_SUB_RADD; quat_sub; QUAT_NORM_TRIANGLE_SUB]);; let QUAT_POW_EQ_1 = prove (`!q n. q pow n = Hx(&1) ==> norm(q) = &1 \/ n = 0`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `norm:quat->real`) THEN SIMP_TAC[QUAT_NORM_POW; NORM_HX; REAL_POW_EQ_1; REAL_ABS_NUM] THEN SIMP_TAC[REAL_ABS_NORM] THEN CONV_TAC TAUT);; (* ------------------------------------------------------------------------- *) (* Conjugate of a quaternion. *) (* ------------------------------------------------------------------------- *) let quat_cnj = new_definition `cnj(q:quat) = quat(Re(q),--Im1(q),--Im2(q),--Im3(q))`;; (* ------------------------------------------------------------------------- *) (* Conjugation is an automorphism. *) (* ------------------------------------------------------------------------- *) let QUAT_CNJ_INJ = prove (`!p q:quat. cnj(p) = cnj(q) <=> (p = q)`, REWRITE_TAC[quat_cnj; QUAT_EQ; QUAT_COMPONENTS; REAL_EQ_NEG2]);; let QUAT_CNJ_CNJ = prove (`!q:quat. cnj(cnj q) = q`, REWRITE_TAC[quat_cnj; QUAT_EQ; QUAT_COMPONENTS; REAL_NEG_NEG]);; (* TODO: rimuovere? *) let CNJ_HX = prove (`!x. cnj(Hx x) = Hx x`, REWRITE_TAC[quat_cnj; QUAT_EQ; HX_DEF; REAL_NEG_0; QUAT_COMPONENTS]);; let QUAT_NORM_CNJ = prove (`!q:quat. norm(cnj q) = norm(q)`, REWRITE_TAC[quat_norm; quat_cnj; REAL_POW_2] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; QUAT_COMPONENTS; REAL_NEG_NEG]);; let QUAT_CNJ_NEG = prove (`!q:quat. cnj(--q) = --(cnj q)`, REWRITE_TAC[quat_cnj; quat_neg; QUAT_EQ; QUAT_COMPONENTS]);; let QUAT_CNJ_INV = prove (`!q:quat. cnj(inv q) = inv(cnj q)`, REWRITE_TAC[quat_cnj; quat_inv; QUAT_EQ; QUAT_COMPONENTS] THEN REWRITE_TAC[real_div; REAL_NEG_NEG; REAL_POW_2; REAL_MUL_LNEG; REAL_MUL_RNEG]);; let QUAT_CNJ_ADD = prove (`!p q:quat. cnj(p + q) = cnj(p) + cnj(q)`, REPEAT GEN_TAC THEN REWRITE_TAC[quat_cnj; quat_add; QUAT_EQ; QUAT_COMPONENTS] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let QUAT_CNJ_SUB = prove (`!p q:quat. cnj(p - q) = cnj(p) - cnj(q)`, REPEAT GEN_TAC THEN REWRITE_TAC[quat_sub; QUAT_CNJ_ADD; QUAT_CNJ_NEG]);; let QUAT_CNJ_MUL = prove (`!p q:quat. cnj(p * q) = cnj(q) * cnj(p)`, REPEAT GEN_TAC THEN REWRITE_TAC[quat_cnj; quat_mul; QUAT_EQ; QUAT_COMPONENTS] THEN REAL_ARITH_TAC);; let QUAT_CNJ_POW = prove (`!q:quat n. cnj(q pow n) = cnj(q) pow n`, GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[quat_pow; CNJ_HX]; GEN_REWRITE_TAC RAND_CONV [QUAT_POW_SUC_ALT] THEN ASM_REWRITE_TAC[quat_pow; QUAT_CNJ_MUL; CNJ_HX]]);; let QUAT_CNJ_COMPONENTS = prove (`(!q:quat. Re(cnj q) = Re q) /\ (!q:quat. Im1(cnj q) = --Im1 q) /\ (!q:quat. Im2(cnj q) = --Im2 q) /\ (!q:quat. Im3(cnj q) = --Im3 q)`, REWRITE_TAC[quat_cnj; QUAT_COMPONENTS]);; let QUAT_CNJ_UNITS = prove (`cnj ii:quat = --ii /\ cnj jj:quat = --jj /\ cnj kk:quat = --kk`, REWRITE_TAC[QUAT_EQ; QUAT_CNJ_COMPONENTS; QUAT_NEG_COMPONENTS; QUAT_UNITS_COMPONENTS; REAL_NEG_0]);; let CNJ_EQ_HX = prove (`!x q. cnj q = Hx x <=> q = Hx x`, REWRITE_TAC[QUAT_EQ; QUAT_CNJ_COMPONENTS; HX_COMPONENTS; REAL_NEG_EQ_0]);; let QUAT_CNJ_EQ_0 = prove (`!q. cnj q = Hx(&0) <=> q = Hx(&0)`, REWRITE_TAC[CNJ_EQ_HX]);; let QUAT_ADD_CNJ = prove (`(!q. q + cnj q = Hx(&2 * Re q)) /\ (!q. cnj q + q = Hx(&2 * Re q))`, REWRITE_TAC[QUAT_EQ; QUAT_ADD_COMPONENTS; QUAT_CNJ_COMPONENTS; HX_COMPONENTS] THEN REAL_ARITH_TAC);; let HX_QUAT_RE_CNJ = prove (`!q. Hx(Re q) = inv(Hx(&2)) * (q + cnj q)`, REWRITE_TAC[QUAT_EQ; HX_COMPONENTS; quat_mul; quat_inv; QUAT_COMPONENTS; QUAT_ADD_COMPONENTS; QUAT_CNJ_COMPONENTS] THEN REAL_ARITH_TAC);; let QUAT_MUL_CNJ_SYM = prove (`!q:quat. cnj q * q = q * cnj q`, REWRITE_TAC[QUAT_EQ; quat_mul; QUAT_COMPONENTS; QUAT_CNJ_COMPONENTS] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Slightly ad hoc theorems relating multiplication, inverse and conjugation *) (* ------------------------------------------------------------------------- *) let QUAT_NORM_POW_2 = prove (`!q. Hx(norm q) pow 2 = q * cnj q`, REWRITE_TAC [GSYM HX_POW; QUAT_SQNORM] THEN REWRITE_TAC [quat_cnj; quat_mul; HX_DEF; QUAT_COMPONENTS; QUAT_EQ] THEN REAL_ARITH_TAC);; let QUAT_NORM_POW_2_ALT = prove (`!q. Hx(norm q) pow 2 = cnj q * q`, REWRITE_TAC[QUAT_NORM_POW_2; QUAT_MUL_CNJ_SYM]);; let QUAT_MUL_CNJ = prove (`!q. cnj q * q = Hx(norm(q)) pow 2 /\ q * cnj q = Hx(norm(q)) pow 2`, GEN_TAC THEN CONJ_TAC THENL [REWRITE_TAC[QUAT_NORM_POW_2_ALT]; REWRITE_TAC[QUAT_NORM_POW_2]]);; let QUAT_INV_CNJ = prove (`!q. inv q = inv (Hx(norm q pow 2)) * cnj q`, REWRITE_TAC[GSYM HX_INV; QUAT_SQNORM; QUAT_EQ; MUL_HX_COMPONENTS] THEN REWRITE_TAC[quat_inv; QUAT_COMPONENTS; QUAT_CNJ_COMPONENTS] THEN REAL_ARITH_TAC);; let QUAT_INV_EQ_CNJ = prove (`!q. norm q = &1 ==> inv q = cnj q`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[QUAT_INV_CNJ] THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[QUAT_NORM_UNITS; REAL_POW_ONE; REAL_ABS_1; REAL_INV_1; QUAT_INV_1; QUAT_MUL_LID]);; (* ------------------------------------------------------------------------- *) (* A few more quaternionic-specific cases of vector notions. *) (* ------------------------------------------------------------------------- *) let QUAT_CMUL = prove (`!c x. c % x = Hx(c) * x`, SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; HX_DEF; quat; quat_mul; DIMINDEX_4; FORALL_4; QUAT_COMPONENTS_DEF; VECTOR_4] THEN REAL_ARITH_TAC);; let LINEAR_QUAT_LMUL = prove (`!c. linear (\x. c * x)`, REWRITE_TAC[linear; QUAT_CMUL; QUAT_ADD_LDISTRIB; QUAT_MUL_ASSOC; QUAT_MUL_HX_SYM]);; let LINEAR_QUAT_RMUL = prove (`!c. linear (\x. x * c)`, REWRITE_TAC[linear; QUAT_CMUL; QUAT_ADD_RDISTRIB; QUAT_MUL_ASSOC; QUAT_MUL_HX_SYM]);; let BILINEAR_QUAT_MUL = prove (`bilinear( * )`, REWRITE_TAC[bilinear; linear; QUAT_CMUL; QUAT_ADD_LDISTRIB; QUAT_ADD_RDISTRIB; QUAT_MUL_ASSOC; QUAT_MUL_HX_SYM]);; let QUAT_CMUL_RID = prove (`!x. x % Hx(&1) = Hx x`, REWRITE_TAC[QUAT_CMUL; QUAT_MUL_RID]);; let QUAT_CMUL_LID = prove (`!q:quat. &1 % q = q`, REWRITE_TAC[VECTOR_MUL_LID]);; let QUAT_DOT = prove (`!p q. p dot q = Re p * Re q + Im1 p * Im1 q + Im2 p * Im2 q + Im3 p * Im3 q`, REWRITE_TAC[FORALL_QUAT; QUAT_COMPONENTS] THEN REWRITE_TAC[quat; DOT_4; VECTOR_4]);; (* ------------------------------------------------------------------------- *) (* Quaternionic-specific theorems about sums. *) (* ------------------------------------------------------------------------- *) let QUAT_VSUM_COMPONENTS = prove (`(!f s:A->bool. FINITE s ==> Re(vsum s f) = sum s (\x. Re(f x))) /\ (!f s:A->bool. FINITE s ==> Im1(vsum s f) = sum s (\x. Im1(f x))) /\ (!f s:A->bool. FINITE s ==> Im2(vsum s f) = sum s (\x. Im2(f x))) /\ (!f s:A->bool. FINITE s ==> Im3(vsum s f) = sum s (\x. Im3(f x)))`, SIMP_TAC[QUAT_COMPONENTS_DEF; VSUM_COMPONENT; DIMINDEX_4; ARITH]);; let VSUM_QUAT_LMUL = prove (`!c f s. FINITE(s) ==> vsum s (\x:A. c * f x) = c * vsum s f`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; QUAT_VEC_0; QUAT_MUL_RZERO] THEN SIMPLE_QUAT_ARITH_TAC);; let VSUM_QUAT_RMUL = prove (`!c f s. FINITE(s) ==> vsum s (\x:A. f x * c) = vsum s f * c`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; QUAT_VEC_0; QUAT_MUL_LZERO] THEN SIMPLE_QUAT_ARITH_TAC);; let VSUM_HX = prove (`!f:A->real s. FINITE s ==> vsum s (\a. Hx(f a)) = Hx(sum s f)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; QUAT_VEC_0; HX_ADD]);; let QUAT_CNJ_VSUM = prove (`!f s. FINITE s ==> cnj(vsum s f) = vsum s (\x:A. cnj(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; QUAT_CNJ_ADD; CNJ_HX; QUAT_VEC_0]);; let VSUM_HX_NUMSEG = prove (`!f m n. vsum (m..n) (\a. Hx(f a)) = Hx(sum (m..n) f)`, SIMP_TAC[VSUM_HX; FINITE_NUMSEG]);; (* ------------------------------------------------------------------------- *) (* The quaternions that are real (zero imaginary part). *) (* ------------------------------------------------------------------------- *) let quat_real = new_definition `real(q:quat) <=> Im1 q = &0 /\ Im2 q = &0 /\ Im3 q = &0`;; let QUAT_REAL = prove (`!q. real q <=> Hx(Re q) = q`, REWRITE_TAC[QUAT_EQ; quat_real; HX_DEF; QUAT_COMPONENTS] THEN REAL_ARITH_TAC);; let QUAT_REAL_CNJ = prove (`!q:quat. real q <=> cnj q = q`, REWRITE_TAC[quat_real; quat_cnj; QUAT_EQ; QUAT_COMPONENTS] THEN REAL_ARITH_TAC);; let QUAT_REAL_EXISTS = prove (`!q:quat. real q <=> ?x. q = Hx x`, MESON_TAC[QUAT_REAL; quat_real; HX_COMPONENTS]);; let QUAT_FORALL_REAL = prove (`(!q:quat. real q ==> P q) <=> (!x. P(Hx x))`, MESON_TAC[QUAT_REAL_EXISTS]);; let QUAT_EXISTS_REAL = prove (`(?q:quat. real q /\ P q) <=> (?x. P(Hx x))`, MESON_TAC[QUAT_REAL_EXISTS]);; let REAL_HX = prove (`!x. real(Hx x)`, REWRITE_TAC[QUAT_REAL_CNJ; CNJ_HX]);; let REAL_MUL_HX = prove (`!x q. real(Hx x * q) <=> x = &0 \/ real q`, REWRITE_TAC[quat_real; MUL_HX_COMPONENTS; REAL_ENTIRE] THEN REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[]);; let QUAT_REAL_ADD = prove (`!p q. real p /\ real q ==> real(p + q)`, SIMP_TAC[QUAT_REAL_CNJ; QUAT_CNJ_ADD]);; let QUAT_REAL_NEG = prove (`!q:quat. real q ==> real(--q)`, SIMP_TAC[QUAT_REAL_CNJ; QUAT_CNJ_NEG]);; let QUAT_REAL_SUB = prove (`!p q. real p /\ real q ==> real(p - q)`, SIMP_TAC[QUAT_REAL_CNJ; QUAT_CNJ_SUB]);; let QUAT_REAL_MUL = prove (`!p q. real p /\ real q ==> real(p * q)`, REWRITE_TAC[quat_real] THEN SIMPLE_QUAT_ARITH_TAC);; let QUAT_REAL_POW = prove (`!q:quat n. real q ==> real(q pow n)`, SIMP_TAC[QUAT_REAL_CNJ; QUAT_CNJ_POW]);; let QUAT_REAL_INV = prove (`!q:quat. real q ==> real(inv q)`, SIMP_TAC[QUAT_REAL_CNJ; QUAT_CNJ_INV]);; let QUAT_REAL_INV_EQ = prove (`!q. real(inv q) = real q`, MESON_TAC[QUAT_REAL_INV; QUAT_INV_INV]);; let QUAT_REAL_VSUM = prove (`!f s. FINITE s /\ (!a:A. a IN s ==> real(f a)) ==> real(vsum s f)`, SIMP_TAC[QUAT_CNJ_VSUM; QUAT_REAL_CNJ]);; let QUAT_REAL_SEGMENT = prove (`!a b x:quat. x IN segment[a,b] /\ real a /\ real b ==> real x`, SIMP_TAC[segment; IN_ELIM_THM; quat_real; QUAT_EQ; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; QUAT_ADD_COMPONENTS; QUAT_CMUL_COMPONENTS] THEN REAL_ARITH_TAC);; let IN_SEGMENT_HX = prove (`!a b x. Hx(x) IN segment[Hx(a),Hx(b)] <=> a <= x /\ x <= b \/ b <= x /\ x <= a`, REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN REWRITE_TAC[QUAT_CMUL; GSYM HX_ADD; HX_INJ; GSYM HX_MUL] THEN ASM_CASES_TAC `a:real = b` THENL [ASM_REWRITE_TAC[REAL_ARITH `(&1 - u) * b + u * b = b`] THEN ASM_CASES_TAC `x:real = b` THEN ASM_REWRITE_TAC[REAL_LE_ANTISYM] THEN EXISTS_TAC `&0` THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `u:real` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST1_TAC)) THEN REWRITE_TAC[REAL_ARITH `a <= (&1 - u) * a + u * b <=> &0 <= u * (b - a)`; REAL_ARITH `b <= (&1 - u) * a + u * b <=> &0 <= (&1 - u) * (a - b)`; REAL_ARITH `(&1 - u) * a + u * b <= a <=> &0 <= u * (a - b)`; REAL_ARITH `(&1 - u) * a + u * b <= b <=> &0 <= (&1 - u) * (b - a)`] THEN DISJ_CASES_TAC(REAL_ARITH `a <= b \/ b <= a`) THENL [DISJ1_TAC; DISJ2_TAC] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THENL [SUBGOAL_THEN `&0 < b - a` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; EXISTS_TAC `(x - a:real) / (b - a)`]; SUBGOAL_THEN `&0 < a - b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; EXISTS_TAC `(a - x:real) / (a - b)`]] THEN (CONJ_TAC THENL [ALL_TAC; UNDISCH_TAC `~(a:real = b)` THEN CONV_TAC REAL_FIELD]) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC);; let IN_SEGMENT_HX_GEN = prove (`!a b x:quat. x IN segment[Hx a,Hx b] <=> real(x) /\ (a <= Re x /\ Re x <= b \/ b <= Re x /\ Re x <= a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `real (x:quat)` THENL [FIRST_X_ASSUM(SUBST1_TAC o SYM o REWRITE_RULE[QUAT_REAL]) THEN REWRITE_TAC[IN_SEGMENT_HX; REAL_HX; HX_COMPONENTS] THEN REAL_ARITH_TAC; ASM_MESON_TAC[QUAT_REAL_SEGMENT; REAL_HX]]);; let QUAT_RE_POS_SEGMENT = prove (`!a b x:quat. x IN segment[a,b] /\ &0 < Re a /\ &0 < Re b ==> &0 < Re x`, SIMP_TAC[segment; IN_ELIM_THM; quat_real; QUAT_EQ; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; QUAT_ADD_COMPONENTS; QUAT_CMUL_COMPONENTS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ENTIRE] THEN ASM_REAL_ARITH_TAC);; let QUAT_CONVEX_REAL = prove (`convex (real:quat->bool)`, REWRITE_TAC[convex; IN; QUAT_CMUL] THEN SIMP_TAC[QUAT_REAL_ADD; QUAT_REAL_MUL; REAL_HX]);; let IMAGE_HX = prove (`!s. IMAGE Hx s = {q | real q /\ Re(q) IN s}`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[HX_COMPONENTS; QUAT_REAL]);; (* ------------------------------------------------------------------------- *) (* Useful bound-type theorems for real quantities. *) (* ------------------------------------------------------------------------- *) let QUAT_REAL_NORM = prove (`!q. real q ==> norm(q) = abs(Re q)`, SIMP_TAC[quat_real; quat_norm] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[POW_2_SQRT_ABS; REAL_ADD_RID]);; let QUAT_REAL_NORM_POS = prove (`!q:quat. real q /\ &0 <= Re q ==> norm(q) = Re(q)`, SIMP_TAC[QUAT_REAL_NORM] THEN REAL_ARITH_TAC);; let QUAT_NORM_VSUM_SUM_RE = prove (`!f s. FINITE s /\ (!x:A. x IN s ==> real(f x) /\ &0 <= Re(f x)) ==> norm(vsum s f) = sum s (\x. Re(f x))`, SIMP_TAC[GSYM QUAT_VSUM_COMPONENTS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC QUAT_REAL_NORM_POS THEN ASM_SIMP_TAC[QUAT_REAL_VSUM; QUAT_VSUM_COMPONENTS; SUM_POS_LE]);; let QUAT_NORM_VSUM_BOUND = prove (`!s f:A->quat g:A->quat. FINITE s /\ (!x. x IN s ==> real(g x) /\ norm(f x) <= Re(g x)) ==> norm(vsum s f) <= norm(vsum s g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\x. norm((f:A->quat) x))` THEN ASM_SIMP_TAC[VSUM_NORM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\x. Re((g:A->quat) x))` THEN ASM_SIMP_TAC[SUM_LE] THEN MATCH_MP_TAC(REAL_ARITH `x:real = y ==> y <= x`) THEN MATCH_MP_TAC QUAT_NORM_VSUM_SUM_RE THEN ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]);; let QUAT_NORM_VSUM_BOUND_SUBSET = prove (`!f:A->quat g:A->quat s t. FINITE s /\ t SUBSET s /\ (!x. x IN s ==> real(g x) /\ norm(f x) <= Re(g x)) ==> norm(vsum t f) <= norm(vsum s g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(vsum t (g:A->quat))` THEN CONJ_TAC THENL [ASM_MESON_TAC[QUAT_NORM_VSUM_BOUND; SUBSET; FINITE_SUBSET];ALL_TAC] THEN SUBGOAL_THEN `norm(vsum t (g:A->quat)) = sum t (\x. Re(g x)) /\ norm(vsum s g) = sum s (\x. Re(g x))` (CONJUNCTS_THEN SUBST1_TAC) THENL [CONJ_TAC THEN MATCH_MP_TAC QUAT_NORM_VSUM_SUM_RE; MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[IN_DIFF]] THEN ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE; FINITE_SUBSET; SUBSET]);; (* ------------------------------------------------------------------------- *) (* Example. *) (* ------------------------------------------------------------------------- *) let _ = let LEMMA = prove (`!x y. Re x = Re y /\ norm x pow 2 = norm y pow 2 ==> y * (y - x) = (y - x) * cnj x`, REWRITE_TAC[QUAT_SQNORM; quat_cnj] THEN SIMPLE_QUAT_ARITH_TAC) in prove (`!x y. ~(x = y) /\ Re x = Re y /\ norm x pow 2 = norm y pow 2 ==> inv (y - x) * y * (y - x) = cnj x`, REPEAT GEN_TAC THEN INTRO_TAC "neq re_eq norm_eq" THEN SUBGOAL_THEN `~(y - x = Hx(&0))` ASSUME_TAC THENL [REMOVE_THEN "neq" MP_TAC THEN SIMPLE_QUAT_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC QUAT_MUL_LCANCEL THEN EXISTS_TAC `y - x` THEN ASM_SIMP_TAC[QUAT_MUL_ASSOC; QUAT_MUL_RINV; QUAT_MUL_LID] THEN MATCH_MP_TAC LEMMA THEN ASM_REWRITE_TAC[]);; hol-light/README000066400000000000000000000260101303454263000136240ustar00rootroot00000000000000 HOL LIGHT HOL Light is an interactive theorem prover / proof checker. It is written in Objective CAML (OCaml) and uses the toplevel from OCaml as its front end. This is the HOL Light homepage: http://www.cl.cam.ac.uk/~jrh13/hol-light/index.html and this is the root of the Github code repository: https://github.com/jrh13/hol-light Basic installation instructions are below. For more detailed information on usage, see the Tutorial: http://www.cl.cam.ac.uk/~jrh13/hol-light/tutorial.pdf Refer to the reference manual for more details of individual functions: http://www.cl.cam.ac.uk/~jrh13/hol-light/reference.html (HTML files) http://www.cl.cam.ac.uk/~jrh13/hol-light/reference.pdf (one PDF file) For information on using HOL Light with the native OCaml toplevel (which generally leads to something like a 4x improvement in runtime at the cost of much longer load times), see (or run) INSTALL_OCAMLNAT. * * * * * * * * INSTALLATION If you use Debian Linux or some other Debian-based Linux distribution (Knoppix, Mint, Ubuntu, etc.), there is actually a "hol-light" package, thanks to Hendrik Tews, so installation of HOL Light and all its prerequisites is as simple as sudo apt-get install hol-light For other OSs, more work is involved. The Objective CAML (OCaml) implementation is a prerequisite for running HOL Light. HOL Light should work with any recent version of OCaml; I've tried it on at least 3.04, 3.06, 3.07+2, 3.08.1, 3.09.3, 3.10.0, 3.11.2 and 4.00. However, for versions >= 3.10 (in 3.10 there was an incompatible change in the camlp4 preprocessor) you will also need to get camlp5 (version >= 4.07). Installing both items of software should not be too difficult, depending on the platform. 1. OCaml: there are packages for many Linux distributions. For example, on a debian derivative like Ubuntu, you may just need to do the following: sudo apt-get install ocaml Alternatively you can download binaries directly, or get sources and build them (which in my experience is usually trouble-free). See the OCaml Web page for downloads and other information. http://caml.inria.fr/ocaml/index.en.html 2. camlp5: this is needed to run HOL Light under any OCaml >= 3.10. Somtimes you need a recent version of camlp5 to be compatible with your OCaml. I recommend downloading the sources for a recent version from http://pauillac.inria.fr/~ddr/camlp5/ and building it in "strict" mode before installing it, thus: cd software/camlp5-6.06 [or wherever you unpacked sources to] ./configure --strict make world.opt sudo make install [assuming no earlier errors] There are also packages for camlp5, so you may be able to get away with just something like sudo apt-get install camlp5 However, you may get a version in "transitional" instead of "strict" mode (do "camlp5 -pmode" to check which you have). I encountered a couple of problems when building with OCaml 4.00: if you hit the same issues, you may like to try the same fix, or suggest better ones. 1. The "toploop.cmi" file has moved down into a subdirectory "compiler-libs". You can fix this by adding -I +compiler-libs to your "ocaml" invocation, though I found it easier simply to make a link like to the old location like this: cd /usr/local/lib/ocaml [or wherever your lib directory is] sudo ln -s compiler-libs/toploop.cmi . 2. For some reason, I did not get the "dllnums.so" file so I copied it manually after building: sudo cp <...>/ocaml-4.00.0/otherlibs/num/dllnums.so /usr/local/lib/ocaml Now for HOL Light itself. The instructions below assume a Unix-like environment such as Linux [or Cygwin (see www.cygwin.com) under Windows], but the steps automated by the Makefile are easy enough to invoke manually. There's more detail on doing that in the Tutorial. (0) You can download the HOL Light sources from the Github site. For example, the following will copy the code from the trunk of the Github repository into a new directory 'hol-light': git clone https://github.com/jrh13/hol-light.git The above is now the recommended way of getting HOL Light. There are also gzipped tar files on the HOL Light Web page, but they are only for quite old versions and will probably be difficult to use with recent versions of OCaml. You should next enter the 'hol-light' directory that has been created: cd ./hol-light There are now two alternatives: launch the OCaml toplevel and directly load the HOL Light source files into it, or create a standalone image with all the HOL Light sources pre-loaded. The latter is more convenient, but requires a separate checkpointing program, which may not be available for some platforms. First the basic approach: (1) Do 'make'. This ought to build the appropriate syntax extension file ('pa_j.cmo') for the version of OCaml that you're using. If you have the camlp4 or camlp5 libraries in a non-standard place rather than /usr/local/lib/ocaml/camlp4 or /usr/local/lib/ocaml/camlp5 then you may get an error like this Error while loading "pa_extend.cmo": file not found in path. in which case you should add the right directory to CAMLP4LIB or CAMLP5LIB, e.g. export CAMLP5LIB=$HOME/mylib/ocaml/camlp5 (2) Do 'ocaml'. (Actually for OCaml >= 4.02 I prefer 'ocaml -safe-string' to avoid mutable strings, while you may need something else like 'ocamlnum' on some platforms --- see [*] below.) You should see a prompt, something like: Objective Caml version 4.01.0 # (3) At the OCaml prompt '#', do '#use "hol.ml";;' (the '#' is part of the command, not the prompt) followed by a newline. This should rebuild all the core HOL Light theories, and terminate after a few minutes with the usual OCaml prompt, something like: val define : term -> thm = - : unit = () val help : string -> unit = - : unit = () Camlp5 Parsing version 3.10 # HOL Light is now ready for the user to start proving theorems. You can also use the load process (2) and (3) in other directories, but you should either set the environment variable HOLLIGHT_DIR to point to the directory containing the HOL source files, or change the first line of "hol.ml" to give that explicitly, from let hol_dir = ref (try Sys.getenv "HOLLIGHT_DIR" with Not_found -> Sys.getcwd());; to, for example let hol_dir = "/home/johnh/hol-light";; or let hol_dir = "/usr/share/hol";; Now for the alternative approach of building a standalone image. The level of convenience depends on the checkpointing program you have installed. The earlier checkpointing programs in this list are more convenient to use but seem less easy to get going on recent Linux kernel/libc combinations. (1) If you have the 'ckpt' program installed, then the Makefile will conveniently create a HOL Light binary. You can get 'ckpt' here: http://www.cs.wisc.edu/~zandy/ckpt/ Once 'ckpt' is installed, simply type make hol in the 'hol-light' directory, and a standalone HOL Light image called 'hol' should be created. If desired you can move or copy this to some other place such as '~/bin' or '/usr/local/bin'. You then simply type 'hol' (or './hol') to start the system up and start proving theorems. Note that although the HOL binary will work on its own, it does not pre-load all the source files. You will probably want to keep the sources available to be loaded later as needed (if you need additional mathematical theories or tools), so it's better to unpack the HOL distribution somewhere permanent before doing 'make hol'. If you later develop a large body of proofs or tools, you can save the augmented system using the command "self_destruct" (this is the same approach as in the Makefile) rather than re-load each time. For example, the following will create a HOL Light binary (always called 'hol.snapshot'): self_destruct "My version of HOL Light";; (2) Another checkpointing option is CryoPID, which you can get here: http://cryopid.berlios.de/ In this case, the Makefile doesn't have a convenient way of making HOL binaries, but you can make one yourself once HOL Light is loaded and you are sitting in its toplevel loop. (This also works if you have your own extensions loaded, and indeed this is when it's most useful.) Instead of the 'self_destruct' command, use 'checkpoint', which is similar except that the current process is not terminated once the binary (again called hol.snapshot) is created: checkpoint "My version of HOL Light";; (3) A third option which seems to work with recent Linuxes is DMTCP, which you can download from here: http://dmtcp.sourceforge.net/ You may try installing from the packages (e.g. 'sudo dpkg -i dmtcp.deb'), but I found it was better to compile from source. HOL Light does not have convenient commands or scripts to exploit DMTCP, but you can proceed as follows: 1. Start ocaml running under the DMTCP coordinator: dmtcp_checkpoint -n ocaml 2. Use ocaml to load HOL Light as usual, for example: #use "hol.ml";; 3. From another terminal, issue the checkpoint command: dmtcp_command --checkpoint 4. (Don't forget this!) Kill the original ocaml process, e.g. by just typing control-d to the Ocaml prompt. 5. Step 3 created a checkpoint of the OCaml process and a shell script to invoke it, both in the directory in which ocaml was started. Running that should restore the OCaml process with all your state and bindings: ./dmtcp_restart_script.sh (4) If none of these options work, you may find some others on the following Web page. Unfortunately I don't know of any such checkpointing program for either Windows or Mac OS X; I would be glad to hear of one. http://checkpointing.org The directories "Library" and "Examples" may give an idea of the kind of thing that might be done, or may be useful in further work. Thanks to Carl Witty for help with Camlp4 porting and advice on checkpointing programs. * * * * * * * * [*] HOL Light uses the OCaml 'num' library for multiple-precision rationals. On many platforms, including Linux and native Windows, this will be loaded automatically by the HOL root file 'hol.ml'. However, OCaml on some platforms (notably Cygwin) does not support dynamic loading, hence the need to use 'ocamlnum', a toplevel with the 'num' library already installed. This is normally created as part of the OCaml build, but if not, you can make your own with: ocamlmktop -o ocamlnum nums.cma hol-light/RichterHilbertAxiomGeometry/000077500000000000000000000000001303454263000203715ustar00rootroot00000000000000hol-light/RichterHilbertAxiomGeometry/HilbertAxiom_read.ml000066400000000000000000005243341303454263000243200ustar00rootroot00000000000000(* ========================================================================= *) (* HOL Light Hilbert geometry axiomatic proofs *) (* *) (* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* High school students can learn rigorous axiomatic geometry proofs, as in *) (* http://www.math.northwestern.edu/~richter/hilbert.pdf, using Hilbert's *) (* axioms, and code up readable formal proofs like these here. Thanks to the *) (* Mizar folks for their influential language, Freek Wiedijk for his dialect *) (* miz3 of HOL Light, John Harrison for explaining how to port Mizar code to *) (* miz3 and writing the first 100+ lines of code here, the hol-info list for *) (* explaining features of HOL, and Benjamin Kordesh for carefully reading *) (* much of the paper and the code. Formal proofs are given for the first 7 *) (* sections of the paper, the results cited there from Greenberg's book, and *) (* most of Euclid's book I propositions up to Proposition I.29, following *) (* Hartshorne, whose book seems the most exciting axiomatic geometry text. *) (* A proof assistant is an invaluable tool to help read it, as Hartshorne's *) (* proofs are often sketchy and even have gaps. *) (* *) (* M. Greenberg, Euclidean and non-Euclidean geometries, Freeman, 1974. *) (* R. Hartshorne, Geometry, Euclid and Beyond, UTM series, Springer, 2000. *) (* ========================================================================= *) needs "RichterHilbertAxiomGeometry/readable.ml";; new_type("point", 0);; NewConstant("Between", `:point->point->point->bool`);; NewConstant("Line", `:(point->bool)->bool`);; NewConstant("≡", `:(point->bool)->(point->bool)->bool`);; ParseAsInfix("≅", (12, "right"));; ParseAsInfix("same_side", (12, "right"));; ParseAsInfix("≡", (12, "right"));; ParseAsInfix("<__", (12, "right"));; ParseAsInfix("<_ang", (12, "right"));; ParseAsInfix("suppl", (12, "right"));; ParseAsInfix("∉", (11, "right"));; ParseAsInfix("∥", (12, "right"));; let NOTIN = NewDefinition `; ∀a l. a ∉ l ⇔ ¬(a ∈ l)`;; let INTER_TENSOR = theorem `; ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∩ t ⊂ s' ∩ t' by set`;; let Interval_DEF = NewDefinition `; ∀A B. Open (A, B) = {X | Between A X B}`;; let Collinear_DEF = NewDefinition `; Collinear A B C ⇔ ∃l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l`;; let SameSide_DEF = NewDefinition `; A,B same_side l ⇔ Line l ∧ ¬ ∃X. X ∈ l ∧ X ∈ Open (A, B)`;; let Ray_DEF = NewDefinition `; ∀A B. ray A B = {X | ¬(A = B) ∧ Collinear A B X ∧ A ∉ Open (X, B)}`;; let Ordered_DEF = NewDefinition `; ordered A B C D ⇔ B ∈ Open (A, C) ∧ B ∈ Open (A, D) ∧ C ∈ Open (A, D) ∧ C ∈ Open (B, D)`;; let InteriorAngle_DEF = NewDefinition `; ∀A O B. int_angle A O B = {P | ¬Collinear A O B ∧ ∃a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b}`;; let InteriorTriangle_DEF = NewDefinition `; ∀A B C. int_triangle A B C = {P | P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B}`;; let Tetralateral_DEF = NewDefinition `; Tetralateral A B C D ⇔ ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B`;; let Quadrilateral_DEF = NewDefinition `; Quadrilateral A B C D ⇔ Tetralateral A B C D ∧ Open (A, B) ∩ Open (C, D) = ∅ ∧ Open (B, C) ∩ Open (D, A) = ∅`;; let ConvexQuad_DEF = NewDefinition `; ConvexQuadrilateral A B C D ⇔ Quadrilateral A B C D ∧ A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C`;; let Segment_DEF = NewDefinition `; seg A B = {A, B} ∪ Open (A, B)`;; let SEGMENT = NewDefinition `; Segment s ⇔ ∃A B. s = seg A B ∧ ¬(A = B)`;; let SegmentOrdering_DEF = NewDefinition `; s <__ t ⇔ Segment s ∧ ∃C D X. t = seg C D ∧ X ∈ Open (C, D) ∧ s ≡ seg C X`;; let Angle_DEF = NewDefinition `; ∡ A O B = ray O A ∪ ray O B`;; let ANGLE = NewDefinition `; Angle α ⇔ ∃A O B. α = ∡ A O B ∧ ¬Collinear A O B`;; let AngleOrdering_DEF = NewDefinition `; α <_ang β ⇔ Angle α ∧ ∃A O B G. ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G`;; let RAY = NewDefinition `; Ray r ⇔ ∃O A. ¬(O = A) ∧ r = ray O A`;; let TriangleCong_DEF = NewDefinition `; ∀A B C A' B' C'. (A, B, C) ≅ (A', B', C') ⇔ ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B'`;; let SupplementaryAngles_DEF = NewDefinition `; ∀α β. α suppl β ⇔ ∃A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ β = ∡ B O A'`;; let RightAngle_DEF = NewDefinition `; ∀α. Right α ⇔ ∃β. α suppl β ∧ α ≡ β`;; let PlaneComplement_DEF = NewDefinition `; ∀α. complement α = {P | P ∉ α}`;; let CONVEX = NewDefinition `; Convex α ⇔ ∀A B. A ∈ α ∧ B ∈ α ⇒ Open (A, B) ⊂ α`;; let PARALLEL = NewDefinition `; ∀l k. l ∥ k ⇔ Line l ∧ Line k ∧ l ∩ k = ∅`;; let Parallelogram_DEF = NewDefinition `; ∀A B C D. Parallelogram A B C D ⇔ Quadrilateral A B C D ∧ ∃a b c d. Line a ∧ A ∈ a ∧ B ∈ a ∧ Line b ∧ B ∈ b ∧ C ∈ b ∧ Line c ∧ C ∈ c ∧ D ∈ d ∧ Line d ∧ D ∈ d ∧ A ∈ d ∧ a ∥ c ∧ b ∥ d`;; let InteriorCircle_DEF = NewDefinition `; ∀O R. int_circle O R = {P | ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R)} `;; (* ------------------------------------------------------------------------- *) (* Hilbert's geometry axioms, except the parallel axiom P, defined later. *) (* ------------------------------------------------------------------------- *) let I1 = NewAxiom `;∀A B. ¬(A = B) ⇒ ∃! l. Line l ∧ A ∈ l ∧ B ∈ l`;; let I2 = NewAxiom `;∀l. Line l ⇒ ∃A B. A ∈ l ∧ B ∈ l ∧ ¬(A = B)`;; let I3 = NewAxiom `;∃A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C`;; let B1 = NewAxiom `;∀A B C. Between A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Between C B A ∧ Collinear A B C`;; let B2 = NewAxiom `;∀A B. ¬(A = B) ⇒ ∃C. Between A B C`;; let B3 = NewAxiom `;∀A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (Between A B C ∨ Between B C A ∨ Between C A B) ∧ ¬(Between A B C ∧ Between B C A) ∧ ¬(Between A B C ∧ Between C A B) ∧ ¬(Between B C A ∧ Between C A B)`;; let B4 = NewAxiom `;∀l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃X. X ∈ l ∧ Between A X C) ⇒ (∃Y. Y ∈ l ∧ Between A Y B) ∨ (∃Y. Y ∈ l ∧ Between B Y C)`;; let C1 = NewAxiom `;∀s O Z. Segment s ∧ ¬(O = Z) ⇒ ∃! P. P ∈ ray O Z â” {O} ∧ seg O P ≡ s`;; let C2Reflexive = NewAxiom `;Segment s ⇒ s ≡ s`;; let C2Symmetric = NewAxiom `;Segment s ∧ Segment t ∧ s ≡ t ⇒ t ≡ s`;; let C2Transitive = NewAxiom `;Segment s ∧ Segment t ∧ Segment u ∧ s ≡ t ∧ t ≡ u ⇒ s ≡ u`;; let C3 = NewAxiom `;∀A B C A' B' C'. B ∈ Open (A, C) ∧ B' ∈ Open (A', C') ∧ seg A B ≡ seg A' B' ∧ seg B C ≡ seg B' C' ⇒ seg A C ≡ seg A' C'`;; let C4 = NewAxiom `;∀α O A l Y. Angle α ∧ ¬(O = A) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ ∃! r. Ray r ∧ ∃B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α`;; let C5Reflexive = NewAxiom `;Angle α ⇒ α ≡ α`;; let C5Symmetric = NewAxiom `;Angle α ∧ Angle β ∧ α ≡ β ⇒ β ≡ α`;; let C5Transitive = NewAxiom `;Angle α ∧ Angle β ∧ Angle γ ∧ α ≡ β ∧ β ≡ γ ⇒ α ≡ γ`;; let C6 = NewAxiom `;∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ⇒ ∡ B C A ≡ ∡ B' C' A'`;; (* ----------------------------------------------------------------- *) (* Theorems. *) (* ----------------------------------------------------------------- *) let IN_Interval = theorem `; ∀A B X. X ∈ Open (A, B) ⇔ Between A X B by rewrite Interval_DEF IN_ELIM_THM`;; let IN_Ray = theorem `; ∀A B X. X ∈ ray A B ⇔ ¬(A = B) ∧ Collinear A B X ∧ A ∉ Open (X, B) by rewrite Ray_DEF IN_ELIM_THM`;; let IN_InteriorAngle = theorem `; ∀A O B P. P ∈ int_angle A O B ⇔ ¬Collinear A O B ∧ ∃a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b by rewrite InteriorAngle_DEF IN_ELIM_THM`;; let IN_InteriorTriangle = theorem `; ∀A B C P. P ∈ int_triangle A B C ⇔ P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B by rewrite InteriorTriangle_DEF IN_ELIM_THM`;; let IN_PlaneComplement = theorem `; ∀α. ∀P. P ∈ complement α ⇔ P ∉ α by rewrite PlaneComplement_DEF IN_ELIM_THM`;; let IN_InteriorCircle = theorem `; ∀O R P. P ∈ int_circle O R ⇔ ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R) by rewrite InteriorCircle_DEF IN_ELIM_THM`;; let B1' = theorem `; ∀A B C. B ∈ Open (A, C) ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ Open (C, A) ∧ Collinear A B C by fol IN_Interval B1`;; let B2' = theorem `; ∀A B. ¬(A = B) ⇒ ∃C. B ∈ Open (A, C) by fol IN_Interval B2`;; let B3' = theorem `; ∀A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (B ∈ Open (A, C) ∨ C ∈ Open (B, A) ∨ A ∈ Open (C, B)) ∧ ¬(B ∈ Open (A, C) ∧ C ∈ Open (B, A)) ∧ ¬(B ∈ Open (A, C) ∧ A ∈ Open (C, B)) ∧ ¬(C ∈ Open (B, A) ∧ A ∈ Open (C, B)) by fol IN_Interval B3`;; let B4' = theorem `; ∀l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃X. X ∈ l ∧ X ∈ Open (A, C)) ⇒ (∃Y. Y ∈ l ∧ Y ∈ Open (A, B)) ∨ (∃Y. Y ∈ l ∧ Y ∈ Open (B, C)) by rewrite IN_Interval B4`;; let B4'' = theorem `; ∀l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l proof rewrite SameSide_DEF; fol B4'; qed; `;; let DisjointOneNotOther = theorem `; ∀l m. (∀x:A. x ∈ m ⇒ x ∉ l) ⇔ l ∩ m = ∅ by fol ∉ IN_INTER MEMBER_NOT_EMPTY`;; let EquivIntersectionHelp = theorem `; ∀e x:A. ∀l m:A->bool. (l ∩ m = {x} ∨ m ∩ l = {x}) ∧ e ∈ m â” {x} ⇒ e ∉ l by fol ∉ IN_INTER IN_SING IN_DIFF`;; let CollinearSymmetry = theorem `; ∀A B C. Collinear A B C ⇒ Collinear A C B ∧ Collinear B A C ∧ Collinear B C A ∧ Collinear C A B ∧ Collinear C B A proof intro_TAC ∀A B C, H1; consider l such that Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [l_line] by fol H1 Collinear_DEF; fol - Collinear_DEF; qed; `;; let ExistsNewPointOnLine = theorem `; ∀P. Line l ∧ P ∈ l ⇒ ∃Q. Q ∈ l ∧ ¬(P = Q) proof intro_TAC ∀P, H1; consider A B such that A ∈ l ∧ B ∈ l ∧ ¬(A = B) [l_line] by fol H1 I2; fol - l_line; qed; `;; let ExistsPointOffLine = theorem `; ∀l. Line l ⇒ ∃Q. Q ∉ l proof intro_TAC ∀l, H1; consider A B C such that ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C [Distinct] by fol I3; assume (A ∈ l) ∧ (B ∈ l) ∧ (C ∈ l) [all_on] by fol ∉; Collinear A B C [] by fol H1 - Collinear_DEF; fol - Distinct; qed; `;; let BetweenLinear = theorem `; ∀A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ (B ∈ Open (A, C) ∨ C ∈ Open (B, A) ∨ A ∈ Open (C, B)) ⇒ B ∈ m proof intro_TAC ∀A B C m, H1m H1A H1C H2; ¬(A = C) ∧ (Collinear A B C ∨ Collinear B C A ∨ Collinear C A B) [X1] by fol H2 B1'; consider l such that Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X2] by fol - Collinear_DEF; l = m [] by fol X1 - H2 H1m H1A H1C I1; fol - X2; qed; `;; let CollinearLinear = theorem `; ∀A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ (Collinear A B C ∨ Collinear B C A ∨ Collinear C A B) ∧ ¬(A = C) ⇒ B ∈ m proof intro_TAC ∀A B C m, H1m H1A H1C H2 H3; consider l such that Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X1] by fol H2 Collinear_DEF; l = m [] by fol H3 - H1m H1A H1C I1; fol - X1; qed; `;; let NonCollinearImpliesDistinct = theorem `; ∀A B C. ¬Collinear A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) proof intro_TAC ∀A B C, H1; assume A = B ∧ B = C [equal] by fol H1 I1 Collinear_DEF; consider Q such that ¬(Q = A) [notQA] by fol I3; fol - equal H1 I1 Collinear_DEF; qed; `;; let NonCollinearRaa = theorem `; ∀A B C l. ¬(A = C) ⇒ Line l ∧ A ∈ l ∧ C ∈ l ⇒ B ∉ l ⇒ ¬Collinear A B C proof intro_TAC ∀A B C l, Distinct, l_line, notBl; assume Collinear A B C [ANCcol] by fol; consider m such that Line m ∧ A ∈ m ∧ B ∈ m ∧ C ∈ m [m_line] by fol - Collinear_DEF; m = l [] by fol - l_line Distinct I1; B ∈ l [] by fol m_line -; fol - notBl ∉; qed; `;; let TwoSidesTriangle1Intersection = theorem `; ∀A B C Y. ¬Collinear A B C ∧ Collinear B C Y ∧ Collinear A C Y ⇒ Y = C proof intro_TAC ∀A B C Y, ABCcol BCYcol ACYcol; assume ¬(C = Y) [notCY] by fol; consider l such that Line l ∧ C ∈ l ∧ Y ∈ l [l_line] by fol - I1; B ∈ l ∧ A ∈ l [] by fol - BCYcol ACYcol Collinear_DEF notCY I1; fol - l_line Collinear_DEF ABCcol; qed; `;; let OriginInRay = theorem `; ∀O Q. ¬(Q = O) ⇒ O ∈ ray O Q proof intro_TAC ∀O Q, H1; O ∉ Open (O, Q) [OOQ] by fol B1' ∉; Collinear O Q O [] by fol H1 I1 Collinear_DEF; fol H1 - OOQ IN_Ray; qed; `;; let EndpointInRay = theorem `; ∀O Q. ¬(Q = O) ⇒ Q ∈ ray O Q proof intro_TAC ∀O Q, H1; O ∉ Open (Q, Q) [notOQQ] by fol B1' ∉; Collinear O Q Q [] by fol H1 I1 Collinear_DEF; fol H1 - notOQQ IN_Ray; qed; `;; let I1Uniqueness = theorem `; ∀X l m. Line l ∧ Line m ∧ ¬(l = m) ∧ X ∈ l ∧ X ∈ m ⇒ l ∩ m = {X} proof intro_TAC ∀X l m, H0l H0m H1 H2l H2m; assume ¬(l ∩ m = {X}) [H3] by fol; consider A such that A ∈ l ∩ m ∧ ¬(A = X) [X1] by fol H2l H2m IN_INTER H3 EXTENSION IN_SING; fol H0l H0m H2l H2m IN_INTER X1 I1 H1; qed; `;; let DisjointLinesImplySameSide = theorem `; ∀l m A B. Line l ∧ Line m ∧ A ∈ m ∧ B ∈ m ∧ l ∩ m = ∅ ⇒ A,B same_side l proof intro_TAC ∀l m A B, l_line m_line Am Bm lm0; l ∩ Open (A,B) = ∅ [] by fol Am Bm m_line BetweenLinear SUBSET lm0 SUBSET_REFL INTER_TENSOR SUBSET_EMPTY; fol l_line - SameSide_DEF SUBSET IN_INTER MEMBER_NOT_EMPTY; qed; `;; let EquivIntersection = theorem `; ∀A B X l m. Line l ∧ Line m ∧ l ∩ m = {X} ∧ A ∈ m â” {X} ∧ B ∈ m â” {X} ∧ X ∉ Open (A, B) ⇒ A,B same_side l proof intro_TAC ∀A B X l m, l_line m_line H1 H2l H2m H3; Open (A, B) ⊂ m [] by fol l_line m_line SUBSET_DIFF IN_DIFF IN_SING H2l H2m BetweenLinear SUBSET; l ∩ Open (A, B) ⊂ {X} [] by fol - H1 SUBSET_REFL INTER_TENSOR; l ∩ Open (A, B) ⊂ ∅ [] by fol - SUBSET IN_SING IN_INTER H3 ∉; fol l_line - SameSide_DEF SUBSET IN_INTER NOT_IN_EMPTY; qed; `;; let RayLine = theorem `; ∀O P l. Line l ∧ O ∈ l ∧ P ∈ l ⇒ ray O P ⊂ l by fol IN_Ray CollinearLinear SUBSET`;; let RaySameSide = theorem `; ∀l O A P. Line l ∧ O ∈ l ∧ A ∉ l ∧ P ∈ ray O A â” {O} ⇒ P ∉ l ∧ P,A same_side l proof intro_TAC ∀l O A P, l_line Ol notAl PrOA; ¬(O = A) [notOA] by fol l_line Ol notAl ∉; consider d such that Line d ∧ O ∈ d ∧ A ∈ d [d_line] by fol notOA I1; ¬(l = d) [] by fol - notAl ∉; l ∩ d = {O} [ldO] by fol l_line Ol d_line - I1Uniqueness; A ∈ d â” {O} [Ad_O] by fol d_line notOA IN_DIFF IN_SING; ray O A ⊂ d [] by fol d_line RayLine; P ∈ d â” {O} [Pd_O] by fol PrOA - SUBSET IN_DIFF IN_SING; P ∉ l [notPl] by fol ldO - EquivIntersectionHelp; O ∉ Open (P, A) [] by fol PrOA IN_DIFF IN_SING IN_Ray; P,A same_side l [] by fol l_line Ol d_line ldO Ad_O Pd_O - EquivIntersection; fol notPl -; qed; `;; let IntervalRayEZ = theorem `; ∀A B C. B ∈ Open (A, C) ⇒ B ∈ ray A C â” {A} ∧ C ∈ ray A B â” {A} proof intro_TAC ∀A B C, H1; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [ABC] by fol H1 B1'; A ∉ Open (B, C) ∧ A ∉ Open (C, B) [] by fol - H1 B3' B1' ∉; fol ABC - CollinearSymmetry IN_Ray ∉ IN_DIFF IN_SING; qed; `;; let NoncollinearityExtendsToLine = theorem `; ∀A O B X. ¬Collinear A O B ⇒ Collinear O B X ∧ ¬(X = O) ⇒ ¬Collinear A O X proof intro_TAC ∀A O B X, H1, H2; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by fol H1 NonCollinearImpliesDistinct; consider b such that Line b ∧ O ∈ b ∧ B ∈ b [b_line] by fol Distinct I1; A ∉ b [notAb] by fol b_line H1 Collinear_DEF ∉; X ∈ b [] by fol H2 b_line Distinct I1 Collinear_DEF; fol b_line - H2 notAb I1 Collinear_DEF ∉; qed; `;; let SameSideReflexive = theorem `; ∀l A. Line l ∧ A ∉ l ⇒ A,A same_side l by fol B1' SameSide_DEF`;; let SameSideSymmetric = theorem `; ∀l A B. Line l ∧ A ∉ l ∧ B ∉ l ⇒ A,B same_side l ⇒ B,A same_side l by fol SameSide_DEF B1'`;; let SameSideTransitive = theorem `; ∀l A B C. Line l ⇒ A ∉ l ∧ B ∉ l ∧ C ∉ l ⇒ A,B same_side l ⇒ B,C same_side l ⇒ A,C same_side l proof intro_TAC ∀l A B C, l_line, notABCl, Asim_lB, Bsim_lC; assume Collinear A B C ∧ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol l_line notABCl Asim_lB Bsim_lC B4'' SameSideReflexive; consider m such that Line m ∧ A ∈ m ∧ C ∈ m [m_line] by fol Distinct I1; B ∈ m [Bm] by fol - Distinct CollinearLinear; assume ¬(m ∩ l = ∅) [Intersect] by fol m_line l_line BetweenLinear SameSide_DEF IN_INTER NOT_IN_EMPTY; consider X such that X ∈ l ∧ X ∈ m [Xlm] by fol - MEMBER_NOT_EMPTY IN_INTER; Collinear A X B ∧ Collinear B A C ∧ Collinear A B C [ABXcol] by fol m_line Bm - Collinear_DEF; consider E such that E ∈ l ∧ ¬(E = X) [El_X] by fol l_line Xlm ExistsNewPointOnLine; ¬Collinear E A X [EAXncol] by fol l_line El_X Xlm notABCl I1 Collinear_DEF ∉; consider B' such that ¬(B = E) ∧ B ∈ Open (E, B') [EBB'] by fol notABCl El_X ∉ B2'; ¬(B' = E) ∧ ¬(B' = B) ∧ Collinear B E B' [EBB'col] by fol - B1' CollinearSymmetry; ¬Collinear A B B' ∧ ¬Collinear B' B A ∧ ¬Collinear B' A B [ABB'ncol] by fol EAXncol ABXcol Distinct - NoncollinearityExtendsToLine CollinearSymmetry; ¬Collinear B' B C ∧ ¬Collinear B' A C ∧ ¬Collinear A B' C [AB'Cncol] by fol ABB'ncol ABXcol Distinct NoncollinearityExtendsToLine CollinearSymmetry; B' ∈ ray E B â” {E} ∧ B ∈ ray E B' â” {E} [] by fol EBB' IntervalRayEZ; B' ∉ l ∧ B',B same_side l ∧ B,B' same_side l [notB'l] by fol l_line El_X notABCl - RaySameSide; A,B' same_side l ∧ B',C same_side l [] by fol l_line ABB'ncol notABCl notB'l Asim_lB - AB'Cncol Bsim_lC B4''; fol l_line AB'Cncol notABCl notB'l - B4''; qed; `;; let ConverseCrossbar = theorem `; ∀O A B G. ¬Collinear A O B ∧ G ∈ Open (A, B) ⇒ G ∈ int_angle A O B proof intro_TAC ∀O A B G, H1 H2; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by fol H1 NonCollinearImpliesDistinct; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol - I1; consider b such that Line b ∧ O ∈ b ∧ B ∈ b [b_line] by fol Distinct I1; consider l such that Line l ∧ A ∈ l ∧ B ∈ l [l_line] by fol Distinct I1; B ∉ a ∧ A ∉ b [] by fol H1 a_line b_line Collinear_DEF ∉; ¬(a = l) ∧ ¬(b = l) [] by fol - l_line ∉; a ∩ l = {A} ∧ b ∩ l = {B} [alA] by fol - a_line l_line b_line I1Uniqueness; ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [AGB] by fol H2 B1'; A ∉ Open (G, B) ∧ B ∉ Open (G, A) [notGAB] by fol H2 B3' B1' ∉; G ∈ l [Gl] by fol l_line H2 BetweenLinear; G ∉ a ∧ G ∉ b [notGa] by fol alA Gl AGB IN_DIFF IN_SING EquivIntersectionHelp; G ∈ l â” {A} ∧ B ∈ l â” {A} ∧ G ∈ l â” {B} ∧ A ∈ l â” {B} [] by fol Gl l_line AGB IN_DIFF IN_SING; G,B same_side a ∧ G,A same_side b [] by fol a_line l_line alA - notGAB b_line EquivIntersection; fol H1 a_line b_line notGa - IN_InteriorAngle; qed; `;; let InteriorUse = theorem `; ∀A O B P a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ⇒ P ∈ int_angle A O B ⇒ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b proof intro_TAC ∀A O B P a b, aOAbOB, P_AOB; consider α β such that ¬Collinear A O B ∧ Line α ∧ O ∈ α ∧ A ∈ α ∧ Line β ∧ O ∈ β ∧B ∈ β ∧ P ∉ α ∧ P ∉ β ∧ P,B same_side α ∧ P,A same_side β [exists] by fol P_AOB IN_InteriorAngle; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [] by fol - NonCollinearImpliesDistinct; α = a ∧ β = b [] by fol - aOAbOB exists I1; fol - exists; qed; `;; let InteriorEZHelp = theorem `; ∀A O B P. P ∈ int_angle A O B ⇒ ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) ∧ ¬Collinear A O P proof intro_TAC ∀A O B P, P_AOB; consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧B ∈ b ∧ P ∉ a ∧ P ∉ b [def_int] by fol P_AOB IN_InteriorAngle; ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) [PnotAOB] by fol - ∉; ¬(A = O) [] by fol def_int NonCollinearImpliesDistinct; ¬Collinear A O P [] by fol def_int - NonCollinearRaa CollinearSymmetry; fol PnotAOB -; qed; `;; let InteriorAngleSymmetry = theorem `; ∀A O B P: point. P ∈ int_angle A O B ⇒ P ∈ int_angle B O A proof rewrite IN_InteriorAngle; fol CollinearSymmetry; qed; `;; let InteriorWellDefined = theorem `; ∀A O B X P. P ∈ int_angle A O B ∧ X ∈ ray O B â” {O} ⇒ P ∈ int_angle A O X proof intro_TAC ∀A O B X P, H1 H2; consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ P ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b [def_int] by fol H1 IN_InteriorAngle; ¬(X = O) ∧ ¬(O = B) ∧ Collinear O B X [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; B ∉ a [notBa] by fol def_int Collinear_DEF ∉; ¬Collinear A O X [AOXnoncol] by fol def_int H2' NoncollinearityExtendsToLine; X ∈ b [Xb] by fol def_int H2' CollinearLinear; X ∉ a ∧ B,X same_side a [] by fol def_int notBa H2 RaySameSide SameSideSymmetric; P,X same_side a [] by fol def_int - notBa SameSideTransitive; fol AOXnoncol def_int Xb - IN_InteriorAngle; qed; `;; let WholeRayInterior = theorem `; ∀A O B X P. X ∈ int_angle A O B ∧ P ∈ ray O X â” {O} ⇒ P ∈ int_angle A O B proof intro_TAC ∀A O B X P, XintAOB PrOX; consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ X ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ X ∉ b ∧ X,B same_side a ∧ X,A same_side b [def_int] by fol XintAOB IN_InteriorAngle; P ∉ a ∧ P,X same_side a ∧ P ∉ b ∧ P,X same_side b [Psim_abX] by fol def_int PrOX RaySameSide; P,B same_side a ∧ P,A same_side b [] by fol - def_int Collinear_DEF SameSideTransitive ∉; fol def_int Psim_abX - IN_InteriorAngle; qed; `;; let AngleOrdering = theorem `; ∀O A P Q a. ¬(O = A) ⇒ Line a ∧ O ∈ a ∧ A ∈ a ⇒ P ∉ a ∧ Q ∉ a ⇒ P,Q same_side a ⇒ ¬Collinear P O Q ⇒ P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A proof intro_TAC ∀O A P Q a, H1, H2, H3, H4, H5; ¬(P = O) ∧ ¬(P = Q) ∧ ¬(O = Q) [Distinct] by fol H5 NonCollinearImpliesDistinct; consider q such that Line q ∧ O ∈ q ∧ Q ∈ q [q_line] by fol Distinct I1; P ∉ q [notPq] by fol - H5 Collinear_DEF ∉; assume ¬(P ∈ int_angle Q O A) [notPintQOA] by fol; ¬Collinear Q O A ∧ ¬Collinear P O A [POAncol] by fol H1 H2 H3 I1 Collinear_DEF ∉; ¬(P,A same_side q) [] by fol - H2 q_line H3 notPq H4 notPintQOA IN_InteriorAngle; consider G such that G ∈ q ∧ G ∈ Open (P, A) [existG] by fol q_line - SameSide_DEF; G ∈ int_angle P O A [G_POA] by fol POAncol existG ConverseCrossbar; G ∉ a ∧ G,P same_side a ∧ ¬(G = O) [Gsim_aP] by fol - H1 H2 IN_InteriorAngle I1 ∉; G,Q same_side a [] by fol H2 Gsim_aP H3 H4 SameSideTransitive; O ∉ Open (Q, G) [notQOG] by fol - H2 SameSide_DEF B1' ∉; Collinear O G Q [] by fol q_line existG Collinear_DEF; Q ∈ ray O G â” {O} [] by fol Gsim_aP - notQOG Distinct IN_Ray IN_DIFF IN_SING; fol G_POA - WholeRayInterior; qed; `;; let InteriorsDisjointSupplement = theorem `; ∀A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') ⇒ int_angle B O A' ∩ int_angle A O B = ∅ proof intro_TAC ∀A O B A', H1 H2; ∀D. D ∈ int_angle A O B ⇒ D ∉ int_angle B O A' [] proof intro_TAC ∀D, H3; ¬(A = O) ∧ ¬(O = B) [] by fol H1 NonCollinearImpliesDistinct; consider a b such that Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ A' ∈ a [ab_line] by fol - H2 I1 BetweenLinear; ¬Collinear B O A' [] by fol H1 H2 CollinearSymmetry B1' NoncollinearityExtendsToLine; A ∉ b ∧ A' ∉ b [notAb] by fol ab_line H1 - Collinear_DEF ∉; ¬(A',A same_side b) [A'nsim_bA] by fol ab_line H2 B1' SameSide_DEF; D ∉ b ∧ D,A same_side b [DintAOB] by fol ab_line H3 InteriorUse; ¬(D,A' same_side b) [] by fol ab_line notAb DintAOB A'nsim_bA SameSideSymmetric SameSideTransitive; fol ab_line - InteriorUse ∉; qed; fol - DisjointOneNotOther; qed; `;; let InteriorReflectionInterior = theorem `; ∀A O B D A'. O ∈ Open (A, A') ∧ D ∈ int_angle A O B ⇒ B ∈ int_angle D O A' proof intro_TAC ∀A O B D A', H1 H2; consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ D ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ D ∉ b ∧ D,B same_side a [DintAOB] by fol H2 IN_InteriorAngle; ¬(O = B) ∧ ¬(O = A') ∧ B ∉ a [Distinct] by fol - H1 NonCollinearImpliesDistinct B1' Collinear_DEF ∉; ¬Collinear D O B [DOB_ncol] by fol DintAOB - NonCollinearRaa CollinearSymmetry; A' ∈ a [A'a] by fol H1 DintAOB BetweenLinear; D ∉ int_angle B O A' [] by fol DintAOB H1 H2 InteriorsDisjointSupplement DisjointOneNotOther; fol Distinct DintAOB A'a DOB_ncol - AngleOrdering ∉; qed; `;; let Crossbar_THM = theorem `; ∀O A B D. D ∈ int_angle A O B ⇒ ∃G. G ∈ Open (A, B) ∧ G ∈ ray O D â” {O} proof intro_TAC ∀O A B D, H1; consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ D ∉ a ∧ D ∉ b ∧ D,B same_side a ∧ D,A same_side b [DintAOB] by fol H1 IN_InteriorAngle; B ∉ a [notBa] by fol DintAOB Collinear_DEF ∉; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(D = O) [Distinct] by fol DintAOB NonCollinearImpliesDistinct ∉; consider l such that Line l ∧ O ∈ l ∧ D ∈ l [l_line] by fol - I1; consider A' such that O ∈ Open (A, A') [AOA'] by fol Distinct B2'; A' ∈ a ∧ Collinear A O A' ∧ ¬(A' = O) [A'a] by fol DintAOB - BetweenLinear B1'; ¬(A,A' same_side l) [Ansim_lA'] by fol l_line AOA' SameSide_DEF; B ∈ int_angle D O A' [] by fol H1 AOA' InteriorReflectionInterior; B,A' same_side l [Bsim_lA'] by fol l_line DintAOB A'a - InteriorUse; ¬Collinear A O D ∧ ¬Collinear B O D [AODncol] by fol H1 InteriorEZHelp InteriorAngleSymmetry; ¬Collinear D O A' [] by fol - A'a CollinearSymmetry NoncollinearityExtendsToLine; A ∉ l ∧ B ∉ l ∧ A' ∉ l [] by fol l_line AODncol - Collinear_DEF ∉; ¬(A,B same_side l) [] by fol l_line - Bsim_lA' Ansim_lA' SameSideTransitive; consider G such that G ∈ Open (A, B) ∧ G ∈ l [AGB] by fol l_line - SameSide_DEF; Collinear O D G [ODGcol] by fol - l_line Collinear_DEF; G ∈ int_angle A O B [] by fol DintAOB AGB ConverseCrossbar; G ∉ a ∧ G,B same_side a ∧ ¬(G = O) [Gsim_aB] by fol DintAOB - InteriorUse ∉; B,D same_side a [] by fol DintAOB notBa SameSideSymmetric; G,D same_side a [Gsim_aD] by fol DintAOB Gsim_aB notBa - SameSideTransitive; O ∉ Open (G, D) [] by fol DintAOB - SameSide_DEF ∉; G ∈ ray O D â” {O} [] by fol Distinct ODGcol - Gsim_aB IN_Ray IN_DIFF IN_SING; fol AGB -; qed; `;; let AlternateConverseCrossbar = theorem `; ∀O A B G. Collinear A G B ∧ G ∈ int_angle A O B ⇒ G ∈ Open (A, B) proof intro_TAC ∀O A B G, H1; consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ G,B same_side a ∧ G,A same_side b [GintAOB] by fol H1 IN_InteriorAngle; ¬(A = B) ∧ ¬(G = A) ∧ ¬(G = B) ∧ A ∉ Open (G, B) ∧ B ∉ Open (G, A) [] by fol - H1 NonCollinearImpliesDistinct InteriorEZHelp SameSide_DEF ∉; fol - H1 B1' B3' ∉; qed; `;; let InteriorOpposite = theorem `; ∀A O B P p. P ∈ int_angle A O B ⇒ Line p ∧ O ∈ p ∧ P ∈ p ⇒ ¬(A,B same_side p) proof intro_TAC ∀A O B P p, PintAOB, p_line; consider G such that G ∈ Open (A, B) ∧ G ∈ ray O P [Gexists] by fol PintAOB Crossbar_THM IN_DIFF; fol p_line p_line - RayLine SUBSET Gexists SameSide_DEF; qed; `;; let IntervalTransitivity = theorem `; ∀O P Q R m. Line m ∧ O ∈ m ⇒ P ∈ m â” {O} ∧ Q ∈ m â” {O} ∧ R ∈ m â” {O} ⇒ O ∉ Open (P, Q) ∧ O ∉ Open (Q, R) ⇒ O ∉ Open (P, R) proof intro_TAC ∀O P Q R m, H0, H2, H3; consider E such that E ∉ m ∧ ¬(O = E) [notEm] by fol H0 ExistsPointOffLine ∉; consider l such that Line l ∧ O ∈ l ∧ E ∈ l [l_line] by fol - I1; ¬(m = l) [] by fol notEm - ∉; l ∩ m = {O} [lmO] by fol l_line H0 - l_line I1Uniqueness; P ∉ l ∧ Q ∉ l ∧ R ∉ l [notPQRl] by fol - H2 EquivIntersectionHelp; P,Q same_side l ∧ Q,R same_side l [] by fol l_line H0 lmO H2 H3 EquivIntersection; P,R same_side l [Psim_lR] by fol l_line notPQRl - SameSideTransitive; fol l_line - SameSide_DEF ∉; qed; `;; let RayWellDefinedHalfway = theorem `; ∀O P Q. ¬(Q = O) ∧ P ∈ ray O Q â” {O} ⇒ ray O P ⊂ ray O Q proof intro_TAC ∀O P Q, H1 H2; consider m such that Line m ∧ O ∈ m ∧ Q ∈ m [OQm] by fol H1 I1; P ∈ ray O Q ∧ ¬(P = O) ∧ O ∉ Open (P, Q) [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; P ∈ m ∧ P ∈ m â” {O} ∧ Q ∈ m â” {O} [PQm_O] by fol OQm H2' RayLine SUBSET H2' OQm H1 IN_DIFF IN_SING; O ∉ Open (P, Q) [notPOQ] by fol H2' IN_Ray; rewrite SUBSET; intro_TAC ∀[X], XrayOP; X ∈ m ∧ O ∉ Open (X, P) [XrOP] by fol - SUBSET OQm PQm_O H2' RayLine IN_Ray; Collinear O Q X [OQXcol] by fol OQm - Collinear_DEF; assume ¬(X = O) [notXO] by fol H1 OriginInRay; X ∈ m â” {O} [] by fol XrOP - IN_DIFF IN_SING; O ∉ Open (X, Q) [] by fol OQm - PQm_O XrOP H2' IntervalTransitivity; fol H1 OQXcol - IN_Ray; qed; `;; let RayWellDefined = theorem `; ∀O P Q. ¬(Q = O) ∧ P ∈ ray O Q â” {O} ⇒ ray O P = ray O Q proof intro_TAC ∀O P Q, H1 H2; ray O P ⊂ ray O Q [PsubsetQ] by fol H1 H2 RayWellDefinedHalfway; ¬(P = O) ∧ Collinear O Q P ∧ O ∉ Open (P, Q) [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; Q ∈ ray O P â” {O} [] by fol H2' B1' ∉ CollinearSymmetry IN_Ray H1 IN_DIFF IN_SING; ray O Q ⊂ ray O P [QsubsetP] by fol H2' - RayWellDefinedHalfway; fol PsubsetQ QsubsetP SUBSET_ANTISYM; qed; `;; let OppositeRaysIntersect1pointHelp = theorem `; ∀A O B X. O ∈ Open (A, B) ∧ X ∈ ray O B â” {O} ⇒ X ∉ ray O A ∧ O ∈ Open (X, A) proof intro_TAC ∀A O B X, H1 H2; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ Collinear A O B [AOB] by fol H1 B1'; ¬(X = O) ∧ Collinear O B X ∧ O ∉ Open (X, B) [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; consider m such that Line m ∧ A ∈ m ∧ B ∈ m [m_line] by fol AOB I1; O ∈ m ∧ X ∈ m [Om] by fol m_line H2' AOB CollinearLinear; A ∈ m â” {O} ∧ X ∈ m â” {O} ∧ B ∈ m â” {O} [] by fol m_line - H2' AOB IN_DIFF IN_SING; fol H1 m_line Om - H2' IntervalTransitivity ∉ B1' IN_Ray; qed; `;; let OppositeRaysIntersect1point = theorem `; ∀A O B. O ∈ Open (A, B) ⇒ ray O A ∩ ray O B = {O} proof intro_TAC ∀A O B, H1; ¬(A = O) ∧ ¬(O = B) [] by fol H1 B1'; rewrite GSYM SUBSET_ANTISYM_EQ SUBSET IN_INTER; conj_tac [Right] by fol - OriginInRay IN_SING; fol H1 OppositeRaysIntersect1pointHelp IN_DIFF IN_SING ∉; qed; `;; let IntervalRay = theorem `; ∀A B C. B ∈ Open (A, C) ⇒ ray A B = ray A C by fol B1' IntervalRayEZ RayWellDefined`;; let Reverse4Order = theorem `; ∀A B C D. ordered A B C D ⇒ ordered D C B A proof rewrite Ordered_DEF; fol B1'; qed; `;; let TransitivityBetweennessHelp = theorem `; ∀A B C D. B ∈ Open (A, C) ∧ C ∈ Open (B, D) ⇒ B ∈ Open (A, D) proof intro_TAC ∀A B C D, H1; D ∈ ray B C â” {B} [] by fol H1 IntervalRayEZ; fol H1 - OppositeRaysIntersect1pointHelp B1'; qed; `;; let TransitivityBetweenness = theorem `; ∀A B C D. B ∈ Open (A, C) ∧ C ∈ Open (B, D) ⇒ ordered A B C D proof intro_TAC ∀A B C D, H1; B ∈ Open (A, D) [ABD] by fol H1 TransitivityBetweennessHelp; C ∈ Open (D, B) ∧ B ∈ Open (C, A) [] by fol H1 B1'; C ∈ Open (D, A) [] by fol - TransitivityBetweennessHelp; fol H1 ABD - B1' Ordered_DEF; qed; `;; let IntervalsAreConvex = theorem `; ∀A B C. B ∈ Open (A, C) ⇒ Open (A, B) ⊂ Open (A, C) proof intro_TAC ∀A B C, H1; ∀X. X ∈ Open (A, B) ⇒ X ∈ Open (A, C) [] proof intro_TAC ∀X, AXB; X ∈ ray B A â” {B} [] by fol AXB B1' IntervalRayEZ; B ∈ Open (X, C) [] by fol H1 B1' - OppositeRaysIntersect1pointHelp; fol AXB - TransitivityBetweennessHelp; qed; fol - SUBSET; qed; `;; let TransitivityBetweennessVariant = theorem `; ∀A X B C. X ∈ Open (A, B) ∧ B ∈ Open (A, C) ⇒ ordered A X B C proof intro_TAC ∀A X B C, H1; X ∈ ray B A â” {B} [] by fol H1 B1' IntervalRayEZ; B ∈ Open (X, C) [] by fol H1 B1' - OppositeRaysIntersect1pointHelp; fol H1 - TransitivityBetweenness; qed; `;; let Interval2sides2aLineHelp = theorem `; ∀A B C X. B ∈ Open (A, C) ⇒ X ∉ Open (A, B) ∨ X ∉ Open (B, C) proof intro_TAC ∀A B C X, H1; assume ¬(X ∉ Open (A, B)) [AXB] by fol; ordered A X B C [] by fol - ∉ H1 TransitivityBetweennessVariant; fol MESON [-; Ordered_DEF] [B ∈ Open (X, C)] B1' B3' ∉; qed; `;; let Interval2sides2aLine = theorem `; ∀A B C X. Collinear A B C ⇒ X ∉ Open (A, B) ∨ X ∉ Open (A, C) ∨ X ∉ Open (B, C) proof intro_TAC ∀A B C X, H1; assume ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol B1' ∉; B ∈ Open (A, C) ∨ C ∈ Open (B, A) ∨ A ∈ Open (C, B) [] by fol - H1 B3'; fol - Interval2sides2aLineHelp B1' ∉; qed; `;; let TwosidesTriangle2aLine = theorem `; ∀A B C l. Line l ∧ ¬Collinear A B C ⇒ A ∉ l ∧ B ∉ l ∧ C ∉ l ⇒ ¬(A,B same_side l) ∧ ¬(B,C same_side l) ⇒ A,C same_side l proof intro_TAC ∀ A B C l, H1, off_l, H2; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [ABCdistinct] by fol H1 NonCollinearImpliesDistinct; consider m such that Line m ∧ A ∈ m ∧ C ∈ m [m_line] by fol - I1; assume ¬(l ∩ m = ∅) [lmIntersect] by fol H1 m_line DisjointLinesImplySameSide; consider Y such that Y ∈ l ∧ Y ∈ m [Ylm] by fol lmIntersect MEMBER_NOT_EMPTY IN_INTER; consider X Z such that X ∈ l ∧ X ∈ Open (A, B) ∧ Z ∈ l ∧ Z ∈ Open (C, B) [H2'] by fol H1 H2 SameSide_DEF B1'; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Y ∈ m â” {A} ∧ Y ∈ m â” {C} ∧ C ∈ m â” {A} ∧ A ∈ m â” {C} [Distinct] by fol H1 NonCollinearImpliesDistinct Ylm off_l ∉ m_line IN_DIFF IN_SING; consider p such that Line p ∧ B ∈ p ∧ A ∈ p [p_line] by fol Distinct I1; consider q such that Line q ∧ B ∈ q ∧ C ∈ q [q_line] by fol Distinct I1; X ∈ p ∧ Z ∈ q [Xp] by fol p_line H2' BetweenLinear q_line H2'; A ∉ q ∧ B ∉ m ∧ C ∉ p [vertex_off_line] by fol q_line m_line p_line H1 Collinear_DEF ∉; X ∉ q ∧ X,A same_side q ∧ Z ∉ p ∧ Z,C same_side p [Xsim_qA] by fol q_line p_line - H2' B1' IntervalRayEZ RaySameSide; ¬(m = p) ∧ ¬(m = q) [] by fol m_line vertex_off_line ∉; p ∩ m = {A} ∧ q ∩ m = {C} [pmA] by fol p_line m_line q_line H1 - Xp H2' I1Uniqueness; Y ∉ p ∧ Y ∉ q [notYpq] by fol - Distinct EquivIntersectionHelp; X ∈ ray A B â” {A} ∧ Z ∈ ray C B â” {C} [] by fol H2' IntervalRayEZ H2' B1'; X ∉ m ∧ Z ∉ m ∧ X,B same_side m ∧ B,Z same_side m [notXZm] by fol m_line vertex_off_line - RaySameSide SameSideSymmetric; X,Z same_side m [] by fol m_line - vertex_off_line SameSideTransitive; Collinear X Y Z ∧ Y ∉ Open (X, Z) ∧ ¬(Y = X) ∧ ¬(Y = Z) ∧ ¬(X = Z) [] by fol H1 H2' Ylm Collinear_DEF m_line - SameSide_DEF notXZm Xsim_qA Xp ∉; Z ∈ Open (X, Y) ∨ X ∈ Open (Z, Y) [] by fol - B3' ∉ B1'; case_split ZXY | XZY by fol -; suppose X ∈ Open (Z, Y); ¬(Z,Y same_side p) [] by fol p_line Xp - SameSide_DEF; ¬(C,Y same_side p) [] by fol p_line Xsim_qA vertex_off_line notYpq - SameSideTransitive; A ∈ Open (C, Y) [] by fol p_line m_line pmA Distinct - EquivIntersection ∉; fol H1 Ylm off_l - B1' IntervalRayEZ RaySameSide; end; suppose Z ∈ Open (X, Y); ¬(X,Y same_side q) [] by fol q_line Xp - SameSide_DEF; ¬(A,Y same_side q) [] by fol q_line Xsim_qA vertex_off_line notYpq - SameSideTransitive; C ∈ Open (Y, A) [] by fol q_line m_line pmA Distinct - EquivIntersection ∉ B1'; fol H1 Ylm off_l - IntervalRayEZ RaySameSide; end; qed; `;; let LineUnionOf2Rays = theorem `; ∀A O B l. Line l ∧ A ∈ l ∧ B ∈ l ⇒ O ∈ Open (A, B) ⇒ l = ray O A ∪ ray O B proof intro_TAC ∀A O B l, H1, H2; ¬(A = O) ∧ ¬(O = B) ∧ O ∈ l [Distinct] by fol H2 B1' H1 BetweenLinear; ray O A ∪ ray O B ⊂ l [AOBsub_l] by fol H1 - RayLine UNION_SUBSET; ∀X. X ∈ l ⇒ X ∈ ray O A ∨ X ∈ ray O B [] proof intro_TAC ∀X, Xl; assume ¬(X ∈ ray O B) [notXrOB] by fol; Collinear O B X ∧ Collinear X A B ∧ Collinear O A X [XABcol] by fol Distinct H1 Xl Collinear_DEF; O ∈ Open (X, B) [] by fol notXrOB Distinct - IN_Ray ∉; O ∉ Open (X, A) [] by fol ∉ B1' XABcol - H2 Interval2sides2aLine; fol Distinct XABcol - IN_Ray; qed; l ⊂ ray O A ∪ ray O B [] by fol - IN_UNION SUBSET; fol - AOBsub_l SUBSET_ANTISYM; qed; `;; let AtMost2Sides = theorem `; ∀A B C l. Line l ⇒ A ∉ l ∧ B ∉ l ∧ C ∉ l ⇒ A,B same_side l ∨ A,C same_side l ∨ B,C same_side l proof intro_TAC ∀A B C l, l_line, H2; assume ¬(A = C) [notAC] by fol l_line H2 SameSideReflexive; assume Collinear A B C [ABCcol] by fol l_line H2 TwosidesTriangle2aLine; consider m such that Line m ∧ A ∈ m ∧ B ∈ m ∧ C ∈ m [m_line] by fol notAC - I1 Collinear_DEF; assume ¬(m ∩ l = ∅) [m_lNot0] by fol m_line l_line BetweenLinear SameSide_DEF IN_INTER NOT_IN_EMPTY; consider X such that X ∈ l ∧ X ∈ m [Xlm] by fol - IN_INTER MEMBER_NOT_EMPTY; A ∈ m â” {X} ∧ B ∈ m â” {X} ∧ C ∈ m â” {X} [ABCm_X] by fol m_line - H2 ∉ IN_DIFF IN_SING; X ∉ Open (A, B) ∨ X ∉ Open (A, C) ∨ X ∉ Open (B, C) [] by fol ABCcol Interval2sides2aLine; fol l_line m_line m_line Xlm H2 ∉ I1Uniqueness ABCm_X - EquivIntersection; qed; `;; let FourPointsOrder = theorem `; ∀A B C X l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ X ∈ l ⇒ ¬(X = A) ∧ ¬(X = B) ∧ ¬(X = C) ⇒ B ∈ Open (A, C) ⇒ ordered X A B C ∨ ordered A X B C ∨ ordered A B X C ∨ ordered A B C X proof intro_TAC ∀A B C X l, H1, H2, H3; A ∈ Open (X, B) ∨ X ∈ Open (A, B) ∨ X ∈ Open (B, C) ∨ C ∈ Open (B, X) [] proof ¬(A = B) ∧ ¬(B = C) [ABCdistinct] by fol H3 B1'; Collinear A B X ∧ Collinear A C X ∧ Collinear C B X [ACXcol] by fol H1 Collinear_DEF; A ∈ Open (X, B) ∨ X ∈ Open (A, B) ∨ B ∈ Open (A, X) [3pos] by fol H2 ABCdistinct - B3' B1'; assume B ∈ Open (A, X) [ABX] by fol 3pos; B ∉ Open (C, X) [] by fol ACXcol H3 - Interval2sides2aLine ∉; fol H2 ABCdistinct ACXcol - B3' B1' ∉; qed; fol - H3 B1' TransitivityBetweenness TransitivityBetweennessVariant Reverse4Order; qed; `;; let HilbertAxiomRedundantByMoore = theorem `; ∀A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ D ∈ l ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ⇒ ordered D A B C ∨ ordered A D B C ∨ ordered A B D C ∨ ordered A B C D ∨ ordered D A C B ∨ ordered A D C B ∨ ordered A C D B ∨ ordered A C B D ∨ ordered D C A B ∨ ordered C D A B ∨ ordered C A D B ∨ ordered C A B D proof intro_TAC ∀A B C D l, H1, H2; Collinear A B C [] by fol H1 Collinear_DEF; B ∈ Open (A, C) ∨ C ∈ Open (A, B) ∨ A ∈ Open (C, B) [] by fol H2 - B3' B1'; fol - H1 H2 FourPointsOrder; qed; `;; let InteriorTransitivity = theorem `; ∀A O B M G. G ∈ int_angle A O B ∧ M ∈ int_angle A O G ⇒ M ∈ int_angle A O B proof intro_TAC ∀A O B M G, GintAOB MintAOG; ¬Collinear A O B [AOBncol] by fol GintAOB IN_InteriorAngle; consider G' such that G' ∈ Open (A, B) ∧ G' ∈ ray O G â” {O} [CrossG] by fol GintAOB Crossbar_THM; M ∈ int_angle A O G' [] by fol MintAOG - InteriorWellDefined; consider M' such that M' ∈ Open (A, G') ∧ M' ∈ ray O M â” {O} [CrossM] by fol - Crossbar_THM; ¬(M' = O) ∧ ¬(M = O) ∧ Collinear O M M' ∧ O ∉ Open (M', M) [] by fol - IN_Ray IN_DIFF IN_SING; M ∈ ray O M' â” {O} [MrOM'] by fol - CollinearSymmetry B1' ∉ IN_Ray IN_DIFF IN_SING; Open (A, G') ⊂ Open (A, B) ∧ M' ∈ Open (A, B) [] by fol CrossG IntervalsAreConvex CrossM SUBSET; M' ∈ int_angle A O B [] by fol AOBncol - ConverseCrossbar; fol - MrOM' WholeRayInterior; qed; `;; let HalfPlaneConvexNonempty = theorem `; ∀l H A. Line l ∧ A ∉ l ⇒ H = {X | X ∉ l ∧ X,A same_side l} ⇒ ¬(H = ∅) ∧ H ⊂ complement l ∧ Convex H proof intro_TAC ∀l H A, l_line, HalfPlane; ∀X. X ∈ H ⇔ X ∉ l ∧ X,A same_side l [Hdef] by simplify HalfPlane IN_ELIM_THM; H ⊂ complement l [Hsub] by fol - IN_PlaneComplement SUBSET; A,A same_side l ∧ A ∈ H [] by fol l_line SameSideReflexive Hdef; ¬(H = ∅) [Hnonempty] by fol - MEMBER_NOT_EMPTY; ∀P Q X. P ∈ H ∧ Q ∈ H ∧ X ∈ Open (P, Q) ⇒ X ∈ H [] proof intro_TAC ∀P Q X, PXQ; P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,A same_side l [PQinH] by fol - Hdef; P,Q same_side l [Psim_lQ] by fol l_line - SameSideSymmetric SameSideTransitive; X ∉ l [notXl] by fol - PXQ SameSide_DEF ∉; Open (X, P) ⊂ Open (P, Q) [] by fol PXQ IntervalsAreConvex B1' SUBSET; X,P same_side l [] by fol l_line - SUBSET Psim_lQ SameSide_DEF; X,A same_side l [] by fol l_line notXl PQinH - Psim_lQ PQinH SameSideTransitive; fol - notXl Hdef; qed; fol Hnonempty Hsub - SUBSET CONVEX; qed; `;; let PlaneSeparation = theorem `; ∀l. Line l ⇒ ∃H1 H2. H1 ∩ H2 = ∅ ∧ ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ Convex H1 ∧ Convex H2 ∧ complement l = H1 ∪ H2 ∧ ∀P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) proof intro_TAC ∀l, l_line; consider A such that A ∉ l [notAl] by fol l_line ExistsPointOffLine; consider E such that E ∈ l ∧ ¬(A = E) [El] by fol l_line I2 - ∉; consider B such that E ∈ Open (A, B) ∧ ¬(E = B) ∧ Collinear A E B [AEB] by fol - B2' B1'; B ∉ l [notBl] by fol - l_line El ∉ notAl NonCollinearRaa CollinearSymmetry; ¬(A,B same_side l) [Ansim_lB] by fol l_line El AEB SameSide_DEF; consider H1 H2 such that H1 = {X | X ∉ l ∧ X,A same_side l} ∧ H2 = {X | X ∉ l ∧ X,B same_side l} [H12sets] by fol; ∀X. (X ∈ H1 ⇔ X ∉ l ∧ X,A same_side l) ∧ (X ∈ H2 ⇔ X ∉ l ∧ X,B same_side l) [H12def] by simplify IN_ELIM_THM -; H1 ∩ H2 = ∅ [H12disjoint] proof assume ¬(H1 ∩ H2 = ∅) [nonempty] by fol; consider V such that V ∈ H1 ∧ V ∈ H2 [VinH12] by fol - MEMBER_NOT_EMPTY IN_INTER; V ∉ l ∧ V,A same_side l ∧ V ∉ l ∧ V,B same_side l [] by fol - H12def; A,B same_side l [] by fol l_line - notAl notBl SameSideSymmetric SameSideTransitive; fol - Ansim_lB; qed; ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ H1 ⊂ complement l ∧ H2 ⊂ complement l ∧ Convex H1 ∧ Convex H2 [H12convex_nonempty] by fol l_line notAl notBl H12sets HalfPlaneConvexNonempty; H1 ∪ H2 ⊂ complement l [H12sub] by fol H12convex_nonempty UNION_SUBSET; ∀C. C ∈ complement l ⇒ C ∈ H1 ∪ H2 [] proof intro_TAC ∀C, compl; C ∉ l [notCl] by fol - IN_PlaneComplement; C,A same_side l ∨ C,B same_side l [] by fol l_line notAl notBl - Ansim_lB AtMost2Sides; fol notCl - H12def IN_UNION; qed; complement l ⊂ H1 ∪ H2 [] by fol - SUBSET; complement l = H1 ∪ H2 [compl_H1unionH2] by fol H12sub - SUBSET_ANTISYM; ∀P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) [opp_sides] proof intro_TAC ∀P Q, both; P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,B same_side l [PH1_QH2] by fol - H12def IN; fol l_line - notAl SameSideSymmetric notBl Ansim_lB SameSideTransitive; qed; fol H12disjoint H12convex_nonempty compl_H1unionH2 opp_sides; qed; `;; let TetralateralSymmetry = theorem `; ∀A B C D. Tetralateral A B C D ⇒ Tetralateral B C D A ∧ Tetralateral A B D C proof intro_TAC ∀A B C D, H1; ¬Collinear A B D ∧ ¬Collinear B D C ∧ ¬Collinear D C A ∧ ¬Collinear C A B [TetraABCD] by fol H1 Tetralateral_DEF CollinearSymmetry; simplify H1 - Tetralateral_DEF; fol H1 Tetralateral_DEF; qed; `;; let EasyEmptyIntersectionsTetralateralHelp = theorem `; ∀A B C D. Tetralateral A B C D ⇒ Open (A, B) ∩ Open (B, C) = ∅ proof intro_TAC ∀A B C D, H1; ∀X. X ∈ Open (B, C) ⇒ X ∉ Open (A, B) [] proof intro_TAC ∀X, BXC; ¬Collinear A B C ∧ Collinear B X C ∧ ¬(X = B) [] by fol H1 Tetralateral_DEF - B1'; ¬Collinear A X B [] by fol - CollinearSymmetry B1' NoncollinearityExtendsToLine; fol - B1' ∉; qed; fol - DisjointOneNotOther; qed; `;; let EasyEmptyIntersectionsTetralateral = theorem `; ∀A B C D. Tetralateral A B C D ⇒ Open (A, B) ∩ Open (B, C) = ∅ ∧ Open (B, C) ∩ Open (C, D) = ∅ ∧ Open (C, D) ∩ Open (D, A) = ∅ ∧ Open (D, A) ∩ Open (A, B) = ∅ proof intro_TAC ∀A B C D, H1; Tetralateral B C D A ∧ Tetralateral C D A B ∧ Tetralateral D A B C [] by fol H1 TetralateralSymmetry; fol H1 - EasyEmptyIntersectionsTetralateralHelp; qed; `;; let SegmentSameSideOppositeLine = theorem `; ∀A B C D a c. Quadrilateral A B C D ⇒ Line a ∧ A ∈ a ∧ B ∈ a ⇒ Line c ∧ C ∈ c ∧ D ∈ c ⇒ A,B same_side c ∨ C,D same_side a proof intro_TAC ∀A B C D a c, H1, a_line, c_line; assume ¬(C,D same_side a) [CDnsim_a] by fol; consider G such that G ∈ a ∧ G ∈ Open (C, D) [CGD] by fol - a_line SameSide_DEF; G ∈ c ∧ Collinear G B A [Gc] by fol c_line - BetweenLinear a_line Collinear_DEF; ¬Collinear B C D ∧ ¬Collinear C D A ∧ Open (A, B) ∩ Open (C, D) = ∅ [quadABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; A ∉ c ∧ B ∉ c ∧ ¬(A = G) ∧ ¬(B = G) [Distinct] by fol - c_line Collinear_DEF ∉ Gc; G ∉ Open (A, B) [] by fol quadABCD CGD DisjointOneNotOther; A ∈ ray G B â” {G} [] by fol Distinct Gc - IN_Ray IN_DIFF IN_SING; fol c_line Gc Distinct - RaySameSide; qed; `;; let ConvexImpliesQuad = theorem `; ∀A B C D. Tetralateral A B C D ⇒ C ∈ int_angle D A B ∧ D ∈ int_angle A B C ⇒ Quadrilateral A B C D proof intro_TAC ∀A B C D, H1, H2; ¬(A = B) ∧ ¬(B = C) ∧ ¬(A = D) [TetraABCD] by fol H1 Tetralateral_DEF; consider a such that Line a ∧ A ∈ a ∧ B ∈ a [a_line] by fol TetraABCD I1; consider b such that Line b ∧ B ∈ b ∧ C ∈ b [b_line] by fol TetraABCD I1; consider d such that Line d ∧ D ∈ d ∧ A ∈ d [d_line] by fol TetraABCD I1; Open (B, C) ⊂ b ∧ Open (A, B) ⊂ a [BCbABa] by fol b_line a_line BetweenLinear SUBSET; D,A same_side b ∧ C,D same_side a [] by fol H2 a_line b_line d_line InteriorUse; b ∩ Open (D, A) = ∅ ∧ a ∩ Open (C, D) = ∅ [] by fol - b_line SameSide_DEF IN_INTER MEMBER_NOT_EMPTY; fol H1 BCbABa - INTER_TENSOR SUBSET_REFL SUBSET_EMPTY Quadrilateral_DEF; qed; `;; let DiagonalsIntersectImpliesConvexQuad = theorem `; ∀A B C D G. ¬Collinear B C D ⇒ G ∈ Open (A, C) ∧ G ∈ Open (B, D) ⇒ ConvexQuadrilateral A B C D proof intro_TAC ∀A B C D G, BCDncol, DiagInt; ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬(C = A) ∧ ¬(A = G) ∧ ¬(D = G) ∧ ¬(B = G) [Distinct] by fol BCDncol NonCollinearImpliesDistinct DiagInt B1'; Collinear A G C ∧ Collinear B G D [Gcols] by fol DiagInt B1'; ¬Collinear C D G ∧ ¬Collinear B C G [Gncols] by fol BCDncol CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; ¬Collinear C D A [CDAncol] by fol - CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; ¬Collinear A B C ∧ ¬Collinear D A G [ABCncol] by fol Gncols - CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; ¬Collinear D A B [DABncol] by fol - CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; ¬(A = B) ∧ ¬(A = D) [] by fol DABncol NonCollinearImpliesDistinct; Tetralateral A B C D [TetraABCD] by fol Distinct - BCDncol CDAncol DABncol ABCncol Tetralateral_DEF; A ∈ ray C G â” {C} ∧ B ∈ ray D G â” {D} ∧ C ∈ ray A G â” {A} ∧ D ∈ ray B G â” {B} [ArCG] by fol DiagInt B1' IntervalRayEZ; G ∈ int_angle B C D ∧ G ∈ int_angle C D A ∧ G ∈ int_angle D A B ∧ G ∈ int_angle A B C [] by fol BCDncol CDAncol DABncol ABCncol DiagInt B1' ConverseCrossbar; A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C [] by fol - ArCG WholeRayInterior; fol TetraABCD - ConvexImpliesQuad ConvexQuad_DEF; qed; `;; let DoubleNotSimImpliesDiagonalsIntersect = theorem `; ∀A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ⇒ Line m ∧ B ∈ m ∧ D ∈ m ⇒ Tetralateral A B C D ⇒ ¬(B,D same_side l) ⇒ ¬(A,C same_side m) ⇒ (∃G. G ∈ Open (A, C) ∩ Open (B, D)) ∧ ConvexQuadrilateral A B C D proof intro_TAC ∀A B C D l m, l_line, m_line, H1, H2, H3; ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Tetralateral_DEF; consider G such that G ∈ Open (A, C) ∧ G ∈ m [AGC] by fol H3 m_line SameSide_DEF; G ∈ l [Gl] by fol l_line - BetweenLinear; A ∉ m ∧ B ∉ l ∧ D ∉ l [] by fol TetraABCD m_line l_line Collinear_DEF ∉; ¬(l = m) ∧ B ∈ m â” {G} ∧ D ∈ m â” {G} [BDm_G] by fol - l_line ∉ m_line Gl IN_DIFF IN_SING; l ∩ m = {G} [] by fol l_line m_line - Gl AGC I1Uniqueness; G ∈ Open (B, D) [] by fol l_line m_line - BDm_G H2 EquivIntersection ∉; fol AGC - IN_INTER TetraABCD DiagonalsIntersectImpliesConvexQuad; qed; `;; let ConvexQuadImpliesDiagonalsIntersect = theorem `; ∀A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ⇒ Line m ∧ B ∈ m ∧ D ∈ m ⇒ ConvexQuadrilateral A B C D ⇒ ¬(B,D same_side l) ∧ ¬(A,C same_side m) ∧ (∃G. G ∈ Open (A, C) ∩ Open (B, D)) ∧ ¬Quadrilateral A B D C proof intro_TAC ∀A B C D l m, l_line, m_line, ConvQuadABCD; Tetralateral A B C D ∧ A ∈ int_angle B C D ∧ D ∈ int_angle A B C [convquadABCD] by fol ConvQuadABCD ConvexQuad_DEF Quadrilateral_DEF; ¬(B,D same_side l) ∧ ¬(A,C same_side m) [opp_sides] by fol convquadABCD l_line m_line InteriorOpposite; consider G such that G ∈ Open (A, C) ∩ Open (B, D) [Gexists] by fol l_line m_line convquadABCD opp_sides DoubleNotSimImpliesDiagonalsIntersect; ¬(Open (B, D) ∩ Open (C, A) = ∅) [] by fol - IN_INTER B1' MEMBER_NOT_EMPTY; ¬Quadrilateral A B D C [] by fol - Quadrilateral_DEF; fol opp_sides Gexists -; qed; `;; let FourChoicesTetralateralHelp = theorem `; ∀A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B ⇒ ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B proof intro_TAC ∀A B C D, H1 CintDAB; ¬(A = B) ∧ ¬(D = A) ∧ ¬(A = C) ∧ ¬(B = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Tetralateral_DEF; consider a d such that Line a ∧ A ∈ a ∧ B ∈ a ∧ Line d ∧ D ∈ d ∧ A ∈ d [ad_line] by fol TetraABCD I1; consider l m such that Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by fol TetraABCD I1; C ∉ a ∧ C ∉ d ∧ B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m ∧ ¬Collinear A B D ∧ ¬Collinear B D A [tetra'] by fol TetraABCD ad_line lm_line Collinear_DEF ∉ CollinearSymmetry; ¬(B,D same_side l) [Bsim_lD] by fol CintDAB lm_line InteriorOpposite - SameSideSymmetric; assume A,C same_side m [same] by fol lm_line H1 Bsim_lD DoubleNotSimImpliesDiagonalsIntersect; C,A same_side m [Csim_mA] by fol lm_line - tetra' SameSideSymmetric; C,B same_side d ∧ C,D same_side a [] by fol ad_line CintDAB InteriorUse; C ∈ int_angle A B D ∧ C ∈ int_angle B D A [] by fol tetra' ad_line lm_line Csim_mA - IN_InteriorAngle; fol CintDAB - IN_InteriorTriangle; qed; `;; let FourChoicesTetralateralHelp = theorem `; ∀A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B ⇒ ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B proof intro_TAC ∀A B C D, H1 CintDAB; ¬(A = B) ∧ ¬(D = A) ∧ ¬(A = C) ∧ ¬(B = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Tetralateral_DEF; consider a d such that Line a ∧ A ∈ a ∧ B ∈ a ∧ Line d ∧ D ∈ d ∧ A ∈ d [ad_line] by fol TetraABCD I1; consider l m such that Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by fol TetraABCD I1; C ∉ a ∧ C ∉ d ∧ B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m ∧ ¬Collinear A B D ∧ ¬Collinear B D A [tetra'] by fol TetraABCD ad_line lm_line Collinear_DEF ∉ CollinearSymmetry; ¬(B,D same_side l) [Bsim_lD] by fol CintDAB lm_line InteriorOpposite - SameSideSymmetric; assume A,C same_side m [same] by fol lm_line H1 Bsim_lD DoubleNotSimImpliesDiagonalsIntersect; C,A same_side m [Csim_mA] by fol lm_line - tetra' SameSideSymmetric; C,B same_side d ∧ C,D same_side a [] by fol ad_line CintDAB InteriorUse; C ∈ int_angle A B D ∧ C ∈ int_angle B D A [] by fol tetra' ad_line lm_line Csim_mA - IN_InteriorAngle; fol CintDAB - IN_InteriorTriangle; qed; `;; let InteriorTriangleSymmetry = theorem `; ∀A B C P. P ∈ int_triangle A B C ⇒ P ∈ int_triangle B C A by fol IN_InteriorTriangle`;; let FourChoicesTetralateral = theorem `; ∀A B C D a. Tetralateral A B C D ⇒ Line a ∧ A ∈ a ∧ B ∈ a ⇒ C,D same_side a ⇒ ConvexQuadrilateral A B C D ∨ ConvexQuadrilateral A B D C ∨ D ∈ int_triangle A B C ∨ C ∈ int_triangle D A B proof intro_TAC ∀A B C D a, H1, a_line, Csim_aD; ¬(A = B) ∧ ¬Collinear A B C ∧ ¬Collinear C D A ∧ ¬Collinear D A B ∧ Tetralateral A B D C [TetraABCD] by fol H1 Tetralateral_DEF TetralateralSymmetry; ¬Collinear C A D ∧ C ∉ a ∧ D ∉ a [notCDa] by fol TetraABCD CollinearSymmetry a_line Collinear_DEF ∉; C ∈ int_angle D A B ∨ D ∈ int_angle C A B [] by fol TetraABCD a_line - Csim_aD AngleOrdering; case_split CintDAB | DintCAB by fol -; suppose C ∈ int_angle D A B; ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B [] by fol H1 - FourChoicesTetralateralHelp; fol -; end; suppose D ∈ int_angle C A B; ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B [] by fol TetraABCD - FourChoicesTetralateralHelp; fol - InteriorTriangleSymmetry; end; qed; `;; let QuadrilateralSymmetry = theorem `; ∀A B C D. Quadrilateral A B C D ⇒ Quadrilateral B C D A ∧ Quadrilateral C D A B ∧ Quadrilateral D A B C by fol Quadrilateral_DEF INTER_COMM TetralateralSymmetry Quadrilateral_DEF`;; let FiveChoicesQuadrilateral = theorem `; ∀A B C D l m. Quadrilateral A B C D ⇒ Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m ⇒ (ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) ∧ (¬(B,D same_side l) ∨ ¬(A,C same_side m)) proof intro_TAC ∀A B C D l m, H1, lm_line; Tetralateral A B C D [H1Tetra] by fol H1 Quadrilateral_DEF; ¬(A = B) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(C = D) [Distinct] by fol H1Tetra Tetralateral_DEF; consider a c such that Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by fol Distinct I1; Quadrilateral C D A B ∧ Tetralateral C D A B [tetraCDAB] by fol H1 QuadrilateralSymmetry Quadrilateral_DEF; ¬ConvexQuadrilateral A B D C ∧ ¬ConvexQuadrilateral C D B A [notconvquad] by fol Distinct I1 H1 - ConvexQuadImpliesDiagonalsIntersect; ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C [5choices] proof A,B same_side c ∨ C,D same_side a [2pos] by fol H1 ac_line SegmentSameSideOppositeLine; assume A,B same_side c [Asym_cB] by fol 2pos H1Tetra ac_line notconvquad FourChoicesTetralateral; ConvexQuadrilateral C D A B ∨ B ∈ int_triangle C D A ∨ A ∈ int_triangle B C D [X1] by fol tetraCDAB ac_line - notconvquad FourChoicesTetralateral; fol - QuadrilateralSymmetry ConvexQuad_DEF; qed; ¬(B,D same_side l) ∨ ¬(A,C same_side m) [] by fol - lm_line ConvexQuadImpliesDiagonalsIntersect IN_InteriorTriangle InteriorAngleSymmetry InteriorOpposite; fol 5choices -; qed; `;; let IntervalSymmetry = theorem `; ∀A B. Open (A, B) = Open (B, A) by fol B1' EXTENSION`;; let SegmentSymmetry = theorem `; ∀A B. seg A B = seg B A by fol Segment_DEF INSERT_COMM IntervalSymmetry`;; let C1OppositeRay = theorem `; ∀O P s. Segment s ∧ ¬(O = P) ⇒ ∃Q. P ∈ Open (O, Q) ∧ seg P Q ≡ s proof intro_TAC ∀O P s, H1; consider Z such that P ∈ Open (O, Z) ∧ ¬(P = Z) [OPZ] by fol H1 B2' B1'; consider Q such that Q ∈ ray P Z â” {P} ∧ seg P Q ≡ s [PQeq] by fol H1 - C1; P ∈ Open (Q, O) [] by fol OPZ - OppositeRaysIntersect1pointHelp; fol - B1' PQeq; qed; `;; let OrderedCongruentSegments = theorem `; ∀A B C D G. ¬(A = C) ∧ ¬(D = G) ⇒ seg A C ≡ seg D G ⇒ B ∈ Open (A, C) ⇒ ∃E. E ∈ Open (D, G) ∧ seg A B ≡ seg D E proof intro_TAC ∀A B C D G, H1, H2, H3; Segment (seg A B) ∧ Segment (seg A C) ∧ Segment (seg B C) ∧ Segment (seg D G) [segs] by fol H3 B1' H1 SEGMENT; seg D G ≡ seg A C [DGeqAC] by fol - H2 C2Symmetric; consider E such that E ∈ ray D G â” {D} ∧ seg D E ≡ seg A B [DEeqAB] by fol segs H1 C1; ¬(E = D) ∧ Collinear D E G ∧ D ∉ Open (G, E) [ErDG] by fol - IN_DIFF IN_SING IN_Ray B1' CollinearSymmetry ∉; consider G' such that E ∈ Open (D, G') ∧ seg E G' ≡ seg B C [DEG'] by fol segs - C1OppositeRay; seg D G' ≡ seg A C [DG'eqAC] by fol DEG' H3 DEeqAB C3; Segment (seg D G') ∧ Segment (seg D E) [] by fol DEG' B1' SEGMENT; seg A C ≡ seg D G' ∧ seg A B ≡ seg D E [ABeqDE] by fol segs - DG'eqAC C2Symmetric DEeqAB; G' ∈ ray D E â” {D} ∧ G ∈ ray D E â” {D} [] by fol DEG' IntervalRayEZ ErDG IN_Ray H1 IN_DIFF IN_SING; G' = G [] by fol ErDG segs - DG'eqAC DGeqAC C1; fol - DEG' ABeqDE; qed; `;; let SegmentSubtraction = theorem `; ∀A B C A' B' C'. B ∈ Open (A, C) ∧ B' ∈ Open (A', C') ⇒ seg A B ≡ seg A' B' ⇒ seg A C ≡ seg A' C' ⇒ seg B C ≡ seg B' C' proof intro_TAC ∀A B C A' B' C', H1, H2, H3; ¬(A = B) ∧ ¬(A = C) ∧ Collinear A B C ∧ Segment (seg A' C') ∧ Segment (seg B' C') [Distinct] by fol H1 B1' SEGMENT; consider Q such that B ∈ Open (A, Q) ∧ seg B Q ≡ seg B' C' [defQ] by fol - C1OppositeRay; seg A Q ≡ seg A' C' [AQ_A'C'] by fol H1 H2 - C3; ¬(A = Q) ∧ Collinear A B Q ∧ A ∉ Open (C, B) ∧ A ∉ Open (Q, B) [] proof simplify defQ B1' ∉; fol defQ B1' H1 B3'; qed; C ∈ ray A B â” {A} ∧ Q ∈ ray A B â” {A} [] by fol Distinct - IN_Ray IN_DIFF IN_SING; fol defQ Distinct - AQ_A'C' H3 C1; qed; `;; let SegmentOrderingUse = theorem `; ∀A B s. Segment s ∧ ¬(A = B) ⇒ s <__ seg A B ⇒ ∃G. G ∈ Open (A, B) ∧ s ≡ seg A G proof intro_TAC ∀A B s, H1, H2; consider A' B' G' such that seg A B = seg A' B' ∧ G' ∈ Open (A', B') ∧ s ≡ seg A' G' [H2'] by fol H2 SegmentOrdering_DEF; ¬(A' = G') ∧ ¬(A' = B') ∧ seg A' B' ≡ seg A B [A'notB'G'] by fol - B1' H1 SEGMENT C2Reflexive; consider G such that G ∈ Open (A, B) ∧ seg A' G' ≡ seg A G [AGB] by fol A'notB'G' H1 H2' - OrderedCongruentSegments; s ≡ seg A G [] by fol H1 A'notB'G' - B1' SEGMENT H2' C2Transitive; fol AGB -; qed; `;; let SegmentTrichotomy1 = theorem `; ∀s t. s <__ t ⇒ ¬(s ≡ t) proof intro_TAC ∀s t, H1; consider A B G such that Segment s ∧ t = seg A B ∧ G ∈ Open (A, B) ∧ s ≡ seg A G [H1'] by fol H1 SegmentOrdering_DEF; ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [Distinct] by fol H1' B1'; seg A B ≡ seg A B [ABrefl] by fol - SEGMENT C2Reflexive; G ∈ ray A B â” {A} ∧ B ∈ ray A B â” {A} [] by fol H1' IntervalRay EndpointInRay Distinct IN_DIFF IN_SING; ¬(seg A G ≡ seg A B) ∧ seg A G ≡ s [] by fol Distinct SEGMENT - ABrefl C1 H1' C2Symmetric; fol Distinct H1' SEGMENT - C2Transitive; qed; `;; let SegmentTrichotomy2 = theorem `; ∀s t u. s <__ t ∧ Segment u ∧ t ≡ u ⇒ s <__ u proof intro_TAC ∀s t u, H1 H2; consider A B P such that Segment s ∧ t = seg A B ∧ P ∈ Open (A, B) ∧ s ≡ seg A P [H1'] by fol H1 SegmentOrdering_DEF; ¬(A = B) ∧ ¬(A = P) [Distinct] by fol - B1'; consider X Y such that u = seg X Y ∧ ¬(X = Y) [uXY] by fol H2 SEGMENT; consider Q such that Q ∈ Open (X, Y) ∧ seg A P ≡ seg X Q [XQY] by fol Distinct - H1' H2 OrderedCongruentSegments; ¬(X = Q) ∧ s ≡ seg X Q [] by fol - B1' H1' Distinct SEGMENT XQY C2Transitive; fol H1' uXY XQY - SegmentOrdering_DEF; qed; `;; let SegmentOrderTransitivity = theorem `; ∀s t u. s <__ t ∧ t <__ u ⇒ s <__ u proof intro_TAC ∀s t u, H1; consider A B G such that u = seg A B ∧ G ∈ Open (A, B) ∧ t ≡ seg A G [H1'] by fol H1 SegmentOrdering_DEF; ¬(A = B) ∧ ¬(A = G) ∧ Segment s [Distinct] by fol H1' B1' H1 SegmentOrdering_DEF; s <__ seg A G [] by fol H1 H1' Distinct SEGMENT SegmentTrichotomy2; consider F such that F ∈ Open (A, G) ∧ s ≡ seg A F [AFG] by fol Distinct - SegmentOrderingUse; F ∈ Open (A, B) [] by fol H1' IntervalsAreConvex - SUBSET; fol Distinct H1' - AFG SegmentOrdering_DEF; qed; `;; let SegmentTrichotomy = theorem `; ∀s t. Segment s ∧ Segment t ⇒ (s ≡ t ∨ s <__ t ∨ t <__ s) ∧ ¬(s ≡ t ∧ s <__ t) ∧ ¬(s ≡ t ∧ t <__ s) ∧ ¬(s <__ t ∧ t <__ s) proof intro_TAC ∀s t, H1; ¬(s ≡ t ∧ s <__ t) [Not12] by fol - SegmentTrichotomy1; ¬(s ≡ t ∧ t <__ s) [Not13] by fol H1 - SegmentTrichotomy1 C2Symmetric; ¬(s <__ t ∧ t <__ s) [Not23] by fol H1 - SegmentOrderTransitivity SegmentTrichotomy1 H1 C2Reflexive; consider O P such that s = seg O P ∧ ¬(O = P) [sOP] by fol H1 SEGMENT; consider Q such that Q ∈ ray O P â” {O} ∧ seg O Q ≡ t [QrOP] by fol H1 - C1; O ∉ Open (Q, P) ∧ Collinear O P Q ∧ ¬(O = Q) [notQOP] by fol - IN_DIFF IN_SING IN_Ray; s ≡ seg O P ∧ t ≡ seg O Q ∧ seg O Q ≡ t ∧ seg O P ≡ s [stOPQ] by fol H1 sOP - SEGMENT QrOP C2Reflexive C2Symmetric; assume ¬(Q = P) [notQP] by fol stOPQ sOP QrOP Not12 Not13 Not23; P ∈ Open (O, Q) ∨ Q ∈ Open (O, P) [] by fol sOP - notQOP B3' B1' ∉; s <__ seg O Q ∨ t <__ seg O P [] by fol H1 - stOPQ SegmentOrdering_DEF; s <__ t ∨ t <__ s [] by fol - H1 stOPQ SegmentTrichotomy2; fol - Not12 Not13 Not23; qed; `;; let C4Uniqueness = theorem `; ∀O A B P l. Line l ∧ O ∈ l ∧ A ∈ l ∧ ¬(O = A) ⇒ B ∉ l ∧ P ∉ l ∧ P,B same_side l ⇒ ∡ A O P ≡ ∡ A O B ⇒ ray O B = ray O P proof intro_TAC ∀O A B P l, H1, H2, H3; ¬(O = B) ∧ ¬(O = P) ∧ Ray (ray O B) ∧ Ray (ray O P) [Distinct] by fol H2 H1 ∉ RAY; ¬Collinear A O B ∧ B,B same_side l [Bsim_lB] by fol H1 H2 I1 Collinear_DEF ∉ SameSideReflexive; Angle (∡ A O B) ∧ ∡ A O B ≡ ∡ A O B [] by fol - ANGLE C5Reflexive; fol - H1 H2 Distinct Bsim_lB H3 C4; qed; `;; let AngleSymmetry = theorem `; ∀A O B. ∡ A O B = ∡ B O A by fol Angle_DEF UNION_COMM`;; let TriangleCongSymmetry = theorem `; ∀A B C A' B' C'. A,B,C ≅ A',B',C' ⇒ A,C,B ≅ A',C',B' ∧ B,A,C ≅ B',A',C' ∧ B,C,A ≅ B',C',A' ∧ C,A,B ≅ C',A',B' ∧ C,B,A ≅ C',B',A' proof intro_TAC ∀A B C A' B' C', H1; ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B' [H1'] by fol H1 TriangleCong_DEF; seg B A ≡ seg B' A' ∧ seg C A ≡ seg C' A' ∧ seg C B ≡ seg C' B' [segments] by fol H1' SegmentSymmetry; ∡ C B A ≡ ∡ C' B' A' ∧ ∡ A C B ≡ ∡ A' C' B' ∧ ∡ B A C ≡ ∡ B' A' C' [] by fol H1' AngleSymmetry; fol CollinearSymmetry H1' segments - TriangleCong_DEF; qed; `;; let SAS = theorem `; ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ⇒ ∡ A B C ≡ ∡ A' B' C' ⇒ A,B,C ≅ A',B',C' proof intro_TAC ∀A B C A' B' C', H1, H2, H3; ¬(A = B) ∧ ¬(A = C) ∧ ¬(A' = C') [Distinct] by fol H1 NonCollinearImpliesDistinct; consider c such that Line c ∧ A ∈ c ∧ B ∈ c [c_line] by fol Distinct I1; C ∉ c [notCc] by fol H1 c_line Collinear_DEF ∉; ∡ B C A ≡ ∡ B' C' A' [BCAeq] by fol H1 H2 H3 C6; ∡ B A C ≡ ∡ B' A' C' [BACeq] by fol H1 CollinearSymmetry H2 H3 AngleSymmetry C6; consider Y such that Y ∈ ray A C â” {A} ∧ seg A Y ≡ seg A' C' [YrAC] by fol Distinct SEGMENT C1; Y ∉ c ∧ Y,C same_side c [Ysim_cC] by fol c_line notCc - RaySameSide; ¬Collinear Y A B [YABncol] by fol Distinct c_line - NonCollinearRaa CollinearSymmetry; ray A Y = ray A C ∧ ∡ Y A B = ∡ C A B [] by fol Distinct YrAC RayWellDefined Angle_DEF; ∡ Y A B ≡ ∡ C' A' B' [] by fol BACeq - AngleSymmetry; ∡ A B Y ≡ ∡ A' B' C' [ABYeq] by fol YABncol H1 CollinearSymmetry H2 SegmentSymmetry YrAC - C6; Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A B Y) [] by fol H1 CollinearSymmetry YABncol ANGLE; ∡ A B Y ≡ ∡ A B C [ABYeqABC] by fol - ABYeq - H3 C5Symmetric C5Transitive; ray B C = ray B Y ∧ ¬(Y = B) ∧ Y ∈ ray B C [] by fol c_line Distinct notCc Ysim_cC ABYeqABC C4Uniqueness ∉ - EndpointInRay; Collinear B C Y ∧ Collinear A C Y [ABCYcol] by fol - YrAC IN_DIFF IN_SING IN_Ray; C = Y [] by fol H1 ABCYcol TwoSidesTriangle1Intersection; seg A C ≡ seg A' C' [] by fol - YrAC; fol H1 H2 SegmentSymmetry - H3 BCAeq BACeq AngleSymmetry TriangleCong_DEF; qed; `;; let ASA = theorem `; ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ seg A C ≡ seg A' C' ⇒ ∡ C A B ≡ ∡ C' A' B' ∧ ∡ B C A ≡ ∡ B' C' A' ⇒ A,B,C ≅ A',B',C' proof intro_TAC ∀A B C A' B' C', H1, H2, H3; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(A' = C') ∧ ¬(B' = C') ∧ Segment (seg C' B') [Distinct] by fol H1 NonCollinearImpliesDistinct SEGMENT; consider D such that D ∈ ray C B â” {C} ∧ seg C D ≡ seg C' B' ∧ ¬(D = C) [DrCB] by fol - C1 IN_DIFF IN_SING; Collinear C B D [CBDcol] by fol - IN_DIFF IN_SING IN_Ray; ¬Collinear D C A ∧ Angle (∡ C A D) ∧ Angle (∡ C' A' B') ∧ Angle (∡ C A B) [DCAncol] by fol H1 CollinearSymmetry - DrCB NoncollinearityExtendsToLine H1 ANGLE; consider b such that Line b ∧ A ∈ b ∧ C ∈ b [b_line] by fol Distinct I1; B ∉ b ∧ ¬(D = A) [notBb] by fol H1 - Collinear_DEF ∉ DCAncol NonCollinearImpliesDistinct; D ∉ b ∧ D,B same_side b [Dsim_bB] by fol b_line - DrCB RaySameSide; ray C D = ray C B [] by fol Distinct DrCB RayWellDefined; ∡ D C A ≡ ∡ B' C' A' [] by fol H3 - Angle_DEF; D,C,A ≅ B',C',A' [] by fol DCAncol H1 CollinearSymmetry DrCB H2 SegmentSymmetry - SAS; ∡ C A D ≡ ∡ C' A' B' [] by fol - TriangleCong_DEF; ∡ C A D ≡ ∡ C A B [] by fol DCAncol - H3 C5Symmetric C5Transitive; ray A B = ray A D ∧ D ∈ ray A B [] by fol b_line Distinct notBb Dsim_bB - C4Uniqueness notBb EndpointInRay; Collinear A B D [ABDcol] by fol - IN_Ray; D = B [] by fol H1 CBDcol ABDcol CollinearSymmetry TwoSidesTriangle1Intersection; seg C B ≡ seg C' B' [] by fol - DrCB; B,C,A ≅ B',C',A' [] by fol H1 CollinearSymmetry - H2 SegmentSymmetry H3 SAS; fol - TriangleCongSymmetry; qed; `;; let AngleSubtraction = theorem `; ∀A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ⇒ ∡ A O B ≡ ∡ A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' ⇒ ∡ G O B ≡ ∡ G' O' B' proof intro_TAC ∀A O B A' O' B' G G', H1, H2; ¬Collinear A O B ∧ ¬Collinear A' O' B' [A'O'B'ncol] by fol H1 IN_InteriorAngle; ¬(A = O) ∧ ¬(O = B) ∧ ¬(G = O) ∧ ¬(G' = O') ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by fol - NonCollinearImpliesDistinct H1 InteriorEZHelp SEGMENT; consider X Y such that X ∈ ray O A â” {O} ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B â” {O} ∧ seg O Y ≡ seg O' B' [XYexists] by fol - C1; G ∈ int_angle X O Y [GintXOY] by fol H1 XYexists InteriorWellDefined InteriorAngleSymmetry; consider H H' such that H ∈ Open (X, Y) ∧ H ∈ ray O G â” {O} ∧ H' ∈ Open (A', B') ∧ H' ∈ ray O' G' â” {O'} [Hexists] by fol - H1 Crossbar_THM; H ∈ int_angle X O Y ∧ H' ∈ int_angle A' O' B' [HintXOY] by fol GintXOY H1 - WholeRayInterior; ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G ∧ ray O' H' = ray O' G' [Orays] by fol Distinct XYexists Hexists RayWellDefined; ∡ X O Y ≡ ∡ A' O' B' ∧ ∡ X O H ≡ ∡ A' O' H' [H2'] by fol H2 - Angle_DEF; ¬Collinear X O Y [] by fol GintXOY IN_InteriorAngle; X,O,Y ≅ A',O',B' [] by fol - A'O'B'ncol H2' XYexists SAS; seg X Y ≡ seg A' B' ∧ ∡ O Y X ≡ ∡ O' B' A' ∧ ∡ Y X O ≡ ∡ B' A' O' [XOYcong] by fol - TriangleCong_DEF; ¬Collinear O H X ∧ ¬Collinear O' H' A' ∧ ¬Collinear O Y H ∧ ¬Collinear O' B' H' [OHXncol] by fol HintXOY InteriorEZHelp InteriorAngleSymmetry CollinearSymmetry; ray X H = ray X Y ∧ ray A' H' = ray A' B' ∧ ray Y H = ray Y X ∧ ray B' H' = ray B' A' [Hrays] by fol Hexists B1' IntervalRay; ∡ H X O ≡ ∡ H' A' O' [] by fol XOYcong - Angle_DEF; O,H,X ≅ O',H',A' [] by fol OHXncol XYexists - H2' ASA; seg X H ≡ seg A' H' [] by fol - TriangleCong_DEF SegmentSymmetry; seg H Y ≡ seg H' B' [] by fol Hexists XOYcong - SegmentSubtraction; seg Y O ≡ seg B' O' ∧ seg Y H ≡ seg B' H' [YHeq] by fol XYexists - SegmentSymmetry; ∡ O Y H ≡ ∡ O' B' H' [] by fol XOYcong Hrays Angle_DEF; O,Y,H ≅ O',B',H' [] by fol OHXncol YHeq - SAS; ∡ H O Y ≡ ∡ H' O' B' [] by fol - TriangleCong_DEF; fol - Orays Angle_DEF; qed; `;; let OrderedCongruentAngles = theorem `; ∀A O B A' O' B' G. ¬Collinear A' O' B' ∧ ∡ A O B ≡ ∡ A' O' B' ∧ G ∈ int_angle A O B ⇒ ∃G'. G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' proof intro_TAC ∀A O B A' O' B' G, H1 H2 H3; ¬Collinear A O B [AOBncol] by fol H3 IN_InteriorAngle; ¬(A = O) ∧ ¬(O = B) ∧ ¬(A' = B') ∧ ¬(O = G) ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by fol AOBncol H1 NonCollinearImpliesDistinct H3 InteriorEZHelp SEGMENT; consider X Y such that X ∈ ray O A â” {O} ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B â” {O} ∧ seg O Y ≡ seg O' B' [defXY] by fol - C1; G ∈ int_angle X O Y [GintXOY] by fol H3 - InteriorWellDefined InteriorAngleSymmetry; ¬Collinear X O Y ∧ ¬(X = Y) [XOYncol] by fol - IN_InteriorAngle NonCollinearImpliesDistinct; consider H such that H ∈ Open (X, Y) ∧ H ∈ ray O G â” {O} [defH] by fol GintXOY Crossbar_THM; ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G [Orays] by fol Distinct defXY - RayWellDefined; ∡ X O Y ≡ ∡ A' O' B' [] by fol H2 - Angle_DEF; X,O,Y ≅ A',O',B' [] by fol XOYncol H1 defXY - SAS; seg X Y ≡ seg A' B' ∧ ∡ O X Y ≡ ∡ O' A' B' [YXOcong] by fol - TriangleCong_DEF AngleSymmetry; consider G' such that G' ∈ Open (A', B') ∧ seg X H ≡ seg A' G' [A'G'B'] by fol XOYncol Distinct - defH OrderedCongruentSegments; G' ∈ int_angle A' O' B' [G'intA'O'B'] by fol H1 - ConverseCrossbar; ray X H = ray X Y ∧ ray A' G' = ray A' B' [] by fol defH A'G'B' IntervalRay; ∡ O X H ≡ ∡ O' A' G' [HXOeq] by fol - Angle_DEF YXOcong; H ∈ int_angle X O Y [] by fol GintXOY defH WholeRayInterior; ¬Collinear O X H ∧ ¬Collinear O' A' G' [] by fol - G'intA'O'B' InteriorEZHelp CollinearSymmetry; O,X,H ≅ O',A',G' [] by fol - A'G'B' defXY SegmentSymmetry HXOeq SAS; ∡ X O H ≡ ∡ A' O' G' [] by fol - TriangleCong_DEF AngleSymmetry; fol G'intA'O'B' - Orays Angle_DEF; qed; `;; let AngleAddition = theorem `; ∀A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ⇒ ∡ A O G ≡ ∡ A' O' G' ∧ ∡ G O B ≡ ∡ G' O' B' ⇒ ∡ A O B ≡ ∡ A' O' B' proof intro_TAC ∀A O B A' O' B' G G', H1, H2; ¬Collinear A O B ∧ ¬Collinear A' O' B' [AOBncol] by fol H1 IN_InteriorAngle; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(A' = O') ∧ ¬(A' = B') ∧ ¬(O' = B') ∧ ¬(G = O) [Distinct] by fol - NonCollinearImpliesDistinct H1 InteriorEZHelp; consider a b such that Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b [a_line] by fol Distinct I1; consider g such that Line g ∧ O ∈ g ∧ G ∈ g [g_line] by fol Distinct I1; G ∉ a ∧ G,B same_side a [H1'] by fol a_line H1 InteriorUse; ¬Collinear A O G ∧ ¬Collinear A' O' G' [AOGncol] by fol H1 InteriorEZHelp IN_InteriorAngle; Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A O G) ∧ Angle (∡ A' O' G') [angles] by fol AOBncol - ANGLE; ∃! r. Ray r ∧ ∃X. ¬(O = X) ∧ r = ray O X ∧ X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' [] by simplify C4 - angles Distinct a_line H1'; consider X such that X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' [Xexists] by fol -; ¬Collinear A O X [AOXncol] by fol Distinct a_line Xexists NonCollinearRaa CollinearSymmetry; ∡ A' O' B' ≡ ∡ A O X [] by fol - AOBncol ANGLE Xexists C5Symmetric; consider Y such that Y ∈ int_angle A O X ∧ ∡ A' O' G' ≡ ∡ A O Y [YintAOX] by fol AOXncol - H1 OrderedCongruentAngles; ¬Collinear A O Y [] by fol - InteriorEZHelp; ∡ A O Y ≡ ∡ A O G [AOGeq] by fol - angles - ANGLE YintAOX H2 C5Transitive C5Symmetric; consider x such that Line x ∧ O ∈ x ∧ X ∈ x [x_line] by fol Distinct I1; Y ∉ a ∧ Y,X same_side a [] by fol a_line - YintAOX InteriorUse; Y ∉ a ∧ Y,G same_side a [] by fol a_line - Xexists H1' SameSideTransitive; ray O G = ray O Y [] by fol a_line Distinct H1' - AOGeq C4Uniqueness; G ∈ ray O Y â” {O} [] by fol Distinct - EndpointInRay IN_DIFF IN_SING; G ∈ int_angle A O X [GintAOX] by fol YintAOX - WholeRayInterior; ∡ G O X ≡ ∡ G' O' B' [GOXeq] by fol - H1 Xexists H2 AngleSubtraction; ¬Collinear G O X ∧ ¬Collinear G O B ∧ ¬Collinear G' O' B' [GOXncol] by fol GintAOX H1 InteriorAngleSymmetry InteriorEZHelp CollinearSymmetry; Angle (∡ G O X) ∧ Angle (∡ G O B) ∧ Angle (∡ G' O' B') [] by fol - ANGLE; ∡ G O X ≡ ∡ G O B [G'O'Xeq] by fol angles - GOXeq C5Symmetric H2 C5Transitive; ¬(A,X same_side g) ∧ ¬(A,B same_side g) [Ansim_aXB] by fol g_line GintAOX H1 InteriorOpposite; A ∉ g ∧ B ∉ g ∧ X ∉ g [notABXg] by fol g_line AOGncol GOXncol Distinct I1 Collinear_DEF ∉; X,B same_side g [] by fol g_line - Ansim_aXB AtMost2Sides; ray O X = ray O B [] by fol g_line Distinct notABXg - G'O'Xeq C4Uniqueness; fol - Xexists Angle_DEF; qed; `;; let AngleOrderingUse = theorem `; ∀A O B α. Angle α ∧ ¬Collinear A O B ⇒ α <_ang ∡ A O B ⇒ ∃G. G ∈ int_angle A O B ∧ α ≡ ∡ A O G proof intro_TAC ∀A O B α, H1, H3; consider A' O' B' G' such that ¬Collinear A' O' B' ∧ ∡ A O B = ∡ A' O' B' ∧ G' ∈ int_angle A' O' B' ∧ α ≡ ∡ A' O' G' [H3'] by fol H3 AngleOrdering_DEF; Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A' O' G') [angles] by fol H1 - ANGLE InteriorEZHelp; ∡ A' O' B' ≡ ∡ A O B [] by fol - H3' C5Reflexive; consider G such that G ∈ int_angle A O B ∧ ∡ A' O' G' ≡ ∡ A O G [GintAOB] by fol H1 H3' - OrderedCongruentAngles; α ≡ ∡ A O G [] by fol H1 angles - InteriorEZHelp ANGLE H3' GintAOB C5Transitive; fol - GintAOB; qed; `;; let AngleTrichotomy1 = theorem `; ∀α β. α <_ang β ⇒ ¬(α ≡ β) proof intro_TAC ∀α β, H1; assume α ≡ β [Con] by fol; consider A O B G such that Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by fol H1 AngleOrdering_DEF; ¬(A = O) ∧ ¬(O = B) ∧ ¬Collinear A O G [Distinct] by fol H1' NonCollinearImpliesDistinct InteriorEZHelp; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol Distinct I1; consider b such that Line b ∧ O ∈ b ∧ B ∈ b [b_line] by fol Distinct I1; B ∉ a [notBa] by fol a_line H1' Collinear_DEF ∉; G ∉ a ∧ G ∉ b ∧ G,B same_side a [GintAOB] by fol a_line b_line H1' InteriorUse; ∡ A O G ≡ α [] by fol H1' Distinct ANGLE C5Symmetric; ∡ A O G ≡ ∡ A O B [] by fol H1' Distinct ANGLE - Con C5Transitive; ray O B = ray O G [] by fol a_line Distinct notBa GintAOB - C4Uniqueness; G ∈ b [] by fol Distinct - EndpointInRay b_line RayLine SUBSET; fol - GintAOB ∉; qed; `;; let AngleTrichotomy2 = theorem `; ∀α β γ. α <_ang β ∧ Angle γ ∧ β ≡ γ ⇒ α <_ang γ proof intro_TAC ∀α β γ, H1 H2 H3; consider A O B G such that Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by fol H1 AngleOrdering_DEF; consider A' O' B' such that γ = ∡ A' O' B' ∧ ¬Collinear A' O' B' [γA'O'B'] by fol H2 ANGLE; consider G' such that G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' [G'intA'O'B'] by fol γA'O'B' H1' H3 OrderedCongruentAngles; ¬Collinear A O G ∧ ¬Collinear A' O' G' [ncol] by fol H1' - InteriorEZHelp; α ≡ ∡ A' O' G' [] by fol H1' ANGLE - G'intA'O'B' C5Transitive; fol H1' - ncol γA'O'B' G'intA'O'B' - AngleOrdering_DEF; qed; `;; let AngleOrderTransitivity = theorem `; ∀α β γ. α <_ang β ∧ β <_ang γ ⇒ α <_ang γ proof intro_TAC ∀α β γ, H1 H2; consider A O B G such that Angle β ∧ ¬Collinear A O B ∧ γ = ∡ A O B ∧ G ∈ int_angle A O B ∧ β ≡ ∡ A O G [H2'] by fol H2 AngleOrdering_DEF; ¬Collinear A O G [AOGncol] by fol H2' InteriorEZHelp; Angle α ∧ Angle (∡ A O G) ∧ Angle γ [angles] by fol H1 AngleOrdering_DEF H2' - ANGLE; α <_ang ∡ A O G [] by fol H1 H2' - AngleTrichotomy2; consider F such that F ∈ int_angle A O G ∧ α ≡ ∡ A O F [FintAOG] by fol angles AOGncol - AngleOrderingUse; F ∈ int_angle A O B [] by fol H2' - InteriorTransitivity; fol angles H2' - FintAOG AngleOrdering_DEF; qed; `;; let AngleTrichotomy = theorem `; ∀α β. Angle α ∧ Angle β ⇒ (α ≡ β ∨ α <_ang β ∨ β <_ang α) ∧ ¬(α ≡ β ∧ α <_ang β) ∧ ¬(α ≡ β ∧ β <_ang α) ∧ ¬(α <_ang β ∧ β <_ang α) proof intro_TAC ∀α β, H1; ¬(α ≡ β ∧ α <_ang β) [Not12] by fol AngleTrichotomy1; ¬(α ≡ β ∧ β <_ang α) [Not13] by fol H1 C5Symmetric AngleTrichotomy1; ¬(α <_ang β ∧ β <_ang α) [Not23] by fol H1 AngleOrderTransitivity AngleTrichotomy1 C5Reflexive; consider P O A such that α = ∡ P O A ∧ ¬Collinear P O A [POA] by fol H1 ANGLE; ¬(P = O) ∧ ¬(O = A) [Distinct] by fol - NonCollinearImpliesDistinct; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol - I1; P ∉ a [notPa] by fol - Distinct I1 POA Collinear_DEF ∉; ∃! r. Ray r ∧ ∃Q. ¬(O = Q) ∧ r = ray O Q ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β [] by simplify H1 Distinct a_line C4 -; consider Q such that ¬(O = Q) ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β [Qexists] by fol -; O ∉ Open (Q, P) [notQOP] by fol a_line Qexists SameSide_DEF ∉; ¬Collinear A O P [AOPncol] by fol POA CollinearSymmetry; ¬Collinear A O Q [AOQncol] by fol a_line Distinct I1 Collinear_DEF Qexists ∉; Angle (∡ A O P) ∧ Angle (∡ A O Q) [] by fol AOPncol - ANGLE; α ≡ ∡ A O P ∧ β ≡ ∡ A O Q ∧ ∡ A O P ≡ α [flip] by fol H1 - POA AngleSymmetry C5Reflexive Qexists C5Symmetric; case_split QOPcol | QOPcolncol by fol -; suppose Collinear Q O P; Collinear O P Q [] by fol - CollinearSymmetry; Q ∈ ray O P â” {O} [] by fol Distinct - notQOP IN_Ray Qexists IN_DIFF IN_SING; ray O Q = ray O P [] by fol Distinct - RayWellDefined; ∡ P O A = ∡ A O Q [] by fol - Angle_DEF AngleSymmetry; fol - POA Qexists Not12 Not13 Not23; end; suppose ¬Collinear Q O P; P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A [] by fol Distinct a_line Qexists notPa - AngleOrdering; P ∈ int_angle A O Q ∨ Q ∈ int_angle A O P [] by fol - InteriorAngleSymmetry; α <_ang ∡ A O Q ∨ β <_ang ∡ A O P [] by fol H1 AOQncol AOPncol - flip AngleOrdering_DEF; α <_ang β ∨ β <_ang α [] by fol H1 - Qexists flip AngleTrichotomy2; fol - Not12 Not13 Not23; end; qed; `;; let SupplementExists = theorem `; ∀α. Angle α ⇒ ∃α'. α suppl α' proof intro_TAC ∀α, H1; consider A O B such that α = ∡ A O B ∧ ¬Collinear A O B ∧ ¬(A = O) [def_α] by fol H1 ANGLE NonCollinearImpliesDistinct; consider A' such that O ∈ Open (A, A') [AOA'] by fol - B2'; ∡ A O B suppl ∡ A' O B [AOBsup] by fol def_α - SupplementaryAngles_DEF AngleSymmetry; fol - def_α; qed; `;; let SupplementImpliesAngle = theorem `; ∀α β. α suppl β ⇒ Angle α ∧ Angle β proof intro_TAC ∀α β, H1; consider A O B A' such that ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by fol H1 SupplementaryAngles_DEF; ¬(O = A') ∧ Collinear A O A' [Distinct] by fol - NonCollinearImpliesDistinct B1'; ¬Collinear B O A' [] by fol H1' CollinearSymmetry - NoncollinearityExtendsToLine; fol H1' - ANGLE; qed; `;; let RightImpliesAngle = theorem `; ∀α. Right α ⇒ Angle α by fol RightAngle_DEF SupplementImpliesAngle`;; let SupplementSymmetry = theorem `; ∀α β. α suppl β ⇒ β suppl α proof intro_TAC ∀α β, H1; consider A O B A' such that ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by fol H1 SupplementaryAngles_DEF; ¬(O = A') ∧ Collinear A O A' [] by fol - NonCollinearImpliesDistinct B1'; ¬Collinear A' O B [A'OBncol] by fol H1' CollinearSymmetry - NoncollinearityExtendsToLine; O ∈ Open (A', A) ∧ β = ∡ A' O B ∧ α = ∡ B O A [] by fol H1' B1' AngleSymmetry; fol A'OBncol - SupplementaryAngles_DEF; qed; `;; let SupplementsCongAnglesCong = theorem `; ∀α β α' β'. α suppl α' ∧ β suppl β' ⇒ α ≡ β ⇒ α' ≡ β' proof intro_TAC ∀α β α' β', H1, H2; consider A O B A' such that ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by fol H1 SupplementaryAngles_DEF; ¬(A = O) ∧ ¬(O = B) ∧ ¬(A = A') ∧ ¬(O = A') ∧ Collinear A O A' [Distinctα] by fol - NonCollinearImpliesDistinct B1'; ¬Collinear B A A' ∧ ¬Collinear O A' B [BAA'ncol] by fol def_α CollinearSymmetry - NoncollinearityExtendsToLine; Segment (seg O A) ∧ Segment (seg O B) ∧ Segment (seg O A') [Osegments] by fol Distinctα SEGMENT; consider C P D C' such that ¬Collinear C P D ∧ P ∈ Open (C, C') ∧ β = ∡ C P D ∧ β' = ∡ D P C' [def_β] by fol H1 SupplementaryAngles_DEF; ¬(C = P) ∧ ¬(P = D) ∧ ¬(P = C') [Distinctβ] by fol def_β NonCollinearImpliesDistinct B1'; consider X such that X ∈ ray P C â” {P} ∧ seg P X ≡ seg O A [defX] by fol Osegments Distinctβ C1; consider Y such that Y ∈ ray P D â” {P} ∧ seg P Y ≡ seg O B ∧ ¬(Y = P) [defY] by fol Osegments Distinctβ C1 IN_DIFF IN_SING; consider X' such that X' ∈ ray P C' â” {P} ∧ seg P X' ≡ seg O A' [defX'] by fol Osegments Distinctβ C1; P ∈ Open (X', C) ∧ P ∈ Open (X, X') [XPX'] by fol def_β - OppositeRaysIntersect1pointHelp defX; ¬(X = P) ∧ ¬(X' = P) ∧ Collinear X P X' ∧ ¬(X = X') ∧ ray A' O = ray A' A ∧ ray X' P = ray X' X [XPX'line] by fol defX defX' IN_DIFF IN_SING - B1' def_α IntervalRay; Collinear P D Y ∧ Collinear P C X [] by fol defY defX IN_DIFF IN_SING IN_Ray; ¬Collinear C P Y ∧ ¬Collinear X P Y [XPYncol] by fol def_β - defY NoncollinearityExtendsToLine CollinearSymmetry XPX'line; ¬Collinear Y X X' ∧ ¬Collinear P X' Y [YXX'ncol] by fol - CollinearSymmetry XPX' XPX'line NoncollinearityExtendsToLine; ray P X = ray P C ∧ ray P Y = ray P D ∧ ray P X' = ray P C' [equalPrays] by fol Distinctβ defX defY defX' RayWellDefined; β = ∡ X P Y ∧ β' = ∡ Y P X' ∧ ∡ A O B ≡ ∡ X P Y [AOBeqXPY] by fol def_β - Angle_DEF H2 def_α; seg O A ≡ seg P X ∧ seg O B ≡ seg P Y ∧ seg A' O ≡ seg X' P [OAeq] by fol Osegments XPX'line SEGMENT defX defY defX' C2Symmetric SegmentSymmetry; seg A A' ≡ seg X X' [AA'eq] by fol def_α XPX'line XPX' - SegmentSymmetry C3; A,O,B ≅ X,P,Y [] by fol def_α XPYncol OAeq AOBeqXPY SAS; seg A B ≡ seg X Y ∧ ∡ B A O ≡ ∡ Y X P [AOB≅] by fol - TriangleCong_DEF AngleSymmetry; ray A O = ray A A' ∧ ray X P = ray X X' ∧ ∡ B A A' ≡ ∡ Y X X' [] by fol def_α XPX' IntervalRay - Angle_DEF; B,A,A' ≅ Y,X,X' [] by fol BAA'ncol YXX'ncol AOB≅ - AA'eq - SAS; seg A' B ≡ seg X' Y ∧ ∡ A A' B ≡ ∡ X X' Y [] by fol - TriangleCong_DEF SegmentSymmetry; O,A',B ≅ P,X',Y [] by fol BAA'ncol YXX'ncol OAeq - XPX'line Angle_DEF SAS; ∡ B O A' ≡ ∡ Y P X' [] by fol - TriangleCong_DEF; fol - equalPrays def_β Angle_DEF def_α; qed; `;; let SupplementUnique = theorem `; ∀α β β'. α suppl β ∧ α suppl β' ⇒ β ≡ β' by fol SupplementaryAngles_DEF ANGLE C5Reflexive SupplementsCongAnglesCong`;; let CongRightImpliesRight = theorem `; ∀α β. Angle α ∧ Right β ⇒ α ≡ β ⇒ Right α proof intro_TAC ∀α β, H1, H2; consider α' β' such that α suppl α' ∧ β suppl β' ∧ β ≡ β' [suppl] by fol H1 SupplementExists H1 RightAngle_DEF; α' ≡ β' [α'eqβ'] by fol suppl H2 SupplementsCongAnglesCong; Angle β ∧ Angle α' ∧ Angle β' [] by fol suppl SupplementImpliesAngle; α ≡ α' [] by fol H1 - H2 suppl α'eqβ' C5Symmetric C5Transitive; fol suppl - RightAngle_DEF; qed; `;; let RightAnglesCongruentHelp = theorem `; ∀A O B A' P a. ¬Collinear A O B ∧ O ∈ Open (A, A') ⇒ Right (∡ A O B) ∧ Right (∡ A O P) ⇒ P ∉ int_angle A O B proof intro_TAC ∀A O B A' P a, H1, H2; assume ¬(P ∉ int_angle A O B) [Con] by fol; P ∈ int_angle A O B [PintAOB] by fol - ∉; B ∈ int_angle P O A' ∧ B ∈ int_angle A' O P [BintA'OP] by fol H1 - InteriorReflectionInterior InteriorAngleSymmetry ; ¬Collinear A O P ∧ ¬Collinear P O A' [AOPncol] by fol PintAOB InteriorEZHelp - IN_InteriorAngle; ∡ A O B suppl ∡ B O A' ∧ ∡ A O P suppl ∡ P O A' [AOBsup] by fol H1 - SupplementaryAngles_DEF; consider α' β' such that ∡ A O B suppl α' ∧ ∡ A O B ≡ α' ∧ ∡ A O P suppl β' ∧ ∡ A O P ≡ β' [supplα'] by fol H2 RightAngle_DEF; α' ≡ ∡ B O A' ∧ β' ≡ ∡ P O A' [α'eqA'OB] by fol - AOBsup SupplementUnique; Angle (∡ A O B) ∧ Angle α' ∧ Angle (∡ B O A') ∧ Angle (∡ A O P) ∧ Angle β' ∧ Angle (∡ P O A') [angles] by fol AOBsup supplα' SupplementImpliesAngle AngleSymmetry; ∡ A O B ≡ ∡ B O A' ∧ ∡ A O P ≡ ∡ P O A' [H2'] by fol - supplα' α'eqA'OB C5Transitive; ∡ A O P ≡ ∡ A O P ∧ ∡ B O A' ≡ ∡ B O A' [refl] by fol angles C5Reflexive; ∡ A O P <_ang ∡ A O B ∧ ∡ B O A' <_ang ∡ P O A' [BOA'lessPOA'] by fol angles H1 PintAOB - AngleOrdering_DEF AOPncol CollinearSymmetry BintA'OP AngleSymmetry; ∡ A O P <_ang ∡ B O A' [] by fol - angles H2' AngleTrichotomy2; ∡ A O P <_ang ∡ P O A' [] by fol - BOA'lessPOA' AngleOrderTransitivity; fol - H2' AngleTrichotomy1; qed; `;; let RightAnglesCongruent = theorem `; ∀α β. Right α ∧ Right β ⇒ α ≡ β proof intro_TAC ∀α β, H1; consider α' such that α suppl α' ∧ α ≡ α' [αright] by fol H1 RightAngle_DEF; consider A O B A' such that ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by fol - SupplementaryAngles_DEF; ¬(A = O) ∧ ¬(O = B) [Distinct] by fol def_α NonCollinearImpliesDistinct B1'; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol Distinct I1; B ∉ a [notBa] by fol - def_α Collinear_DEF ∉; Angle β [] by fol H1 RightImpliesAngle; ∃! r. Ray r ∧ ∃P. ¬(O = P) ∧ r = ray O P ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β [] by simplify C4 - Distinct a_line notBa; consider P such that ¬(O = P) ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β [defP] by fol -; O ∉ Open (P, B) [notPOB] by fol a_line - SameSide_DEF ∉; ¬Collinear A O P [AOPncol] by fol a_line Distinct defP NonCollinearRaa CollinearSymmetry; Right (∡ A O P) [AOPright] by fol - ANGLE H1 defP CongRightImpliesRight; P ∉ int_angle A O B ∧ B ∉ int_angle A O P [] by fol def_α H1 - AOPncol AOPright RightAnglesCongruentHelp; Collinear P O B [] by fol Distinct a_line defP notBa - AngleOrdering InteriorAngleSymmetry ∉; P ∈ ray O B â” {O} [] by fol Distinct - CollinearSymmetry notPOB IN_Ray defP IN_DIFF IN_SING; ray O P = ray O B ∧ ∡ A O P = ∡ A O B [] by fol Distinct - RayWellDefined Angle_DEF; fol - defP def_α; qed; `;; let OppositeRightAnglesLinear = theorem `; ∀A B O H h. ¬Collinear A O H ∧ ¬Collinear H O B ⇒ Right (∡ A O H) ∧ Right (∡ H O B) ⇒ Line h ∧ O ∈ h ∧ H ∈ h ∧ ¬(A,B same_side h) ⇒ O ∈ Open (A, B) proof intro_TAC ∀A B O H h, H0, H1, H2; ¬(A = O) ∧ ¬(O = H) ∧ ¬(O = B) [Distinct] by fol H0 NonCollinearImpliesDistinct; A ∉ h ∧ B ∉ h [notABh] by fol H0 H2 Collinear_DEF ∉; consider E such that O ∈ Open (A, E) ∧ ¬(E = O) [AOE] by fol Distinct B2' B1'; ∡ A O H suppl ∡ H O E [AOHsupplHOE] by fol H0 - SupplementaryAngles_DEF; E ∉ h [notEh] by fol H2 ∉ AOE BetweenLinear notABh; ¬(A,E same_side h) [] by fol H2 AOE SameSide_DEF; B,E same_side h [Bsim_hE] by fol H2 notABh notEh - H2 AtMost2Sides; consider α' such that ∡ A O H suppl α' ∧ ∡ A O H ≡ α' [AOHsupplα'] by fol H1 RightAngle_DEF; Angle (∡ H O B) ∧ Angle (∡ A O H) ∧ Angle α' ∧ Angle (∡ H O E) [angα'] by fol H1 RightImpliesAngle - AOHsupplHOE SupplementImpliesAngle; ∡ H O B ≡ ∡ A O H ∧ α' ≡ ∡ H O E [] by fol H1 RightAnglesCongruent AOHsupplα' AOHsupplHOE SupplementUnique; ∡ H O B ≡ ∡ H O E [] by fol angα' - AOHsupplα' C5Transitive; ray O B = ray O E [] by fol H2 Distinct notABh notEh Bsim_hE - C4Uniqueness; B ∈ ray O E â” {O} [] by fol Distinct EndpointInRay - IN_DIFF IN_SING; fol AOE - OppositeRaysIntersect1pointHelp B1'; qed; `;; let RightImpliesSupplRight = theorem `; ∀A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ Right (∡ A O B) ⇒ Right (∡ B O A') proof intro_TAC ∀A O B A', H1 H2 H3; ∡ A O B suppl ∡ B O A' ∧ Angle (∡ A O B) ∧ Angle (∡ B O A') [AOBsuppl] by fol H1 H2 SupplementaryAngles_DEF SupplementImpliesAngle; consider β such that ∡ A O B suppl β ∧ ∡ A O B ≡ β [βsuppl] by fol H3 RightAngle_DEF; Angle β ∧ β ≡ ∡ A O B [angβ] by fol - SupplementImpliesAngle C5Symmetric; ∡ B O A' ≡ β [] by fol AOBsuppl βsuppl SupplementUnique; ∡ B O A' ≡ ∡ A O B [] by fol AOBsuppl angβ - βsuppl C5Transitive; fol AOBsuppl H3 - CongRightImpliesRight; qed; `;; let IsoscelesCongBaseAngles = theorem `; ∀A B C. ¬Collinear A B C ∧ seg B A ≡ seg B C ⇒ ∡ C A B ≡ ∡ A C B proof intro_TAC ∀A B C, H1 H2; ¬(A = B) ∧ ¬(B = C) ∧ ¬Collinear C B A [CBAncol] by fol H1 NonCollinearImpliesDistinct CollinearSymmetry; seg B C ≡ seg B A ∧ ∡ A B C ≡ ∡ C B A [] by fol - SEGMENT H2 C2Symmetric H1 ANGLE AngleSymmetry C5Reflexive; fol H1 CBAncol H2 - SAS TriangleCong_DEF; qed; `;; let C4withC1 = theorem `; ∀α l O A Y P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ⇒ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ ∃N. ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α proof intro_TAC ∀α l O A Y P Q, H1, l_line; ∃! r. Ray r ∧ ∃B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α [] by simplify C4 H1 l_line; consider B such that ¬(O = B) ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α [Bexists] by fol -; consider N such that N ∈ ray O B â” {O} ∧ seg O N ≡ seg P Q [Nexists] by fol H1 - SEGMENT C1; N ∉ l ∧ N,B same_side l [notNl] by fol l_line Bexists Nexists RaySameSide; N,Y same_side l [Nsim_lY] by fol l_line - Bexists SameSideTransitive; ray O N = ray O B [] by fol Bexists Nexists RayWellDefined; ∡ A O N ≡ α [] by fol - Bexists Angle_DEF; fol Nexists IN_DIFF IN_SING notNl Nsim_lY Nexists -; qed; `;; let C4OppositeSide = theorem `; ∀α l O A Z P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ⇒ Line l ∧ O ∈ l ∧ A ∈ l ∧ Z ∉ l ⇒ ∃N. ¬(O = N) ∧ N ∉ l ∧ ¬(Z,N same_side l) ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α proof intro_TAC ∀α l O A Z P Q, H1, l_line; ¬(Z = O) [] by fol l_line ∉; consider Y such that O ∈ Open (Z, Y) [ZOY] by fol - B2'; ¬(O = Y) ∧ Collinear O Z Y [notOY] by fol - B1' CollinearSymmetry; Y ∉ l [notYl] by fol notOY l_line NonCollinearRaa ∉; consider N such that ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α [Nexists] by simplify C4withC1 H1 l_line -; ¬(Z,Y same_side l) [] by fol l_line ZOY SameSide_DEF; ¬(Z,N same_side l) [] by fol l_line Nexists notYl - SameSideTransitive; fol - Nexists; qed; `;; let SSS = theorem `; ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ⇒ A,B,C ≅ A',B',C' proof intro_TAC ∀A B C A' B' C', H1, H2; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(B' = C') [Distinct] by fol H1 NonCollinearImpliesDistinct; consider h such that Line h ∧ A ∈ h ∧ C ∈ h [h_line] by fol Distinct I1; B ∉ h [notBh] by fol h_line H1 ∉ Collinear_DEF; Segment (seg A B) ∧ Segment (seg C B) ∧ Segment (seg A' B') ∧ Segment (seg C' B') [segments] by fol Distinct - SEGMENT; Angle (∡ C' A' B') [] by fol H1 CollinearSymmetry ANGLE; consider N such that ¬(A = N) ∧ N ∉ h ∧ ¬(B,N same_side h) ∧ seg A N ≡ seg A' B' ∧ ∡ C A N ≡ ∡ C' A' B' [Nexists] by simplify C4OppositeSide - Distinct h_line notBh; ¬(C = N) [] by fol h_line Nexists ∉; Segment (seg A N) ∧ Segment (seg C N) [segN] by fol Nexists - SEGMENT; ¬Collinear A N C [ANCncol] by fol Distinct h_line Nexists NonCollinearRaa; Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A N C) [angles] by fol H1 - ANGLE; seg A B ≡ seg A N [ABeqAN] by fol segments segN Nexists H2 C2Symmetric C2Transitive; C,A,N ≅ C',A',B' [] by fol ANCncol H1 CollinearSymmetry H2 Nexists SAS; ∡ A N C ≡ ∡ A' B' C' ∧ seg C N ≡ seg C' B' [ANCeq] by fol - TriangleCong_DEF; seg C B ≡ seg C N [CBeqCN] by fol segments segN - H2 SegmentSymmetry C2Symmetric C2Transitive; consider G such that G ∈ h ∧ G ∈ Open (B, N) [BGN] by fol Nexists h_line SameSide_DEF; ¬(B = N) [notBN] by fol - B1'; ray B G = ray B N ∧ ray N G = ray N B [Grays] by fol BGN B1' IntervalRay; consider v such that Line v ∧ B ∈ v ∧ N ∈ v [v_line] by fol notBN I1; G ∈ v ∧ ¬(h = v) [] by fol v_line BGN BetweenLinear notBh ∉; h ∩ v = {G} [hvG] by fol h_line v_line - BGN I1Uniqueness; ¬(G = A) ⇒ ∡ A B G ≡ ∡ A N G [ABGeqANG] proof intro_TAC notGA; A ∉ v [] by fol hvG h_line - EquivIntersectionHelp IN_DIFF IN_SING; ¬Collinear B A N [] by fol v_line notBN I1 Collinear_DEF - ∉; ∡ N B A ≡ ∡ B N A [] by fol - ABeqAN IsoscelesCongBaseAngles; ∡ G B A ≡ ∡ G N A [] by fol - Grays Angle_DEF notGA; fol - AngleSymmetry; qed; ¬(G = C) ⇒ ∡ G B C ≡ ∡ G N C [GBCeqGNC] proof intro_TAC notGC; C ∉ v [] by fol hvG h_line - EquivIntersectionHelp IN_DIFF IN_SING; ¬Collinear B C N [] by fol v_line notBN I1 Collinear_DEF - ∉; ∡ N B C ≡ ∡ B N C [] by fol - CBeqCN IsoscelesCongBaseAngles AngleSymmetry; fol - Grays Angle_DEF; qed; ∡ A B C ≡ ∡ A N C [] proof assume ¬(G = A) ∧ ¬(G = C) [AGCdistinct] by fol Distinct GBCeqGNC ABGeqANG; ∡ A B G ≡ ∡ A N G ∧ ∡ G B C ≡ ∡ G N C [Gequivs] by fol - ABGeqANG GBCeqGNC; ¬Collinear G B C ∧ ¬Collinear G N C ∧ ¬Collinear G B A ∧ ¬Collinear G N A [Gncols] by fol AGCdistinct h_line BGN notBh Nexists NonCollinearRaa; Collinear A G C [] by fol h_line BGN Collinear_DEF; G ∈ Open (A, C) ∨ C ∈ Open (G, A) ∨ A ∈ Open (C, G) [] by fol Distinct AGCdistinct - B3'; case_split AGC | GAC | CAG by fol -; suppose G ∈ Open (A, C); G ∈ int_angle A B C ∧ G ∈ int_angle A N C [] by fol H1 ANCncol - ConverseCrossbar; fol - Gequivs AngleAddition; end; suppose C ∈ Open (G, A); C ∈ int_angle G B A ∧ C ∈ int_angle G N A [] by fol Gncols - B1' ConverseCrossbar; fol - Gequivs AngleSubtraction AngleSymmetry; end; suppose A ∈ Open (C, G); A ∈ int_angle G B C ∧ A ∈ int_angle G N C [] by fol Gncols - B1' ConverseCrossbar; fol - Gequivs AngleSymmetry AngleSubtraction; end; qed; ∡ A B C ≡ ∡ A' B' C' [] by fol angles - ANCeq C5Transitive; fol H1 H2 SegmentSymmetry - SAS; qed; `;; let AngleBisector = theorem `; ∀A B C. ¬Collinear B A C ⇒ ∃M. M ∈ int_angle B A C ∧ ∡ B A M ≡ ∡ M A C proof intro_TAC ∀A B C, H1; ¬(A = B) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; consider D such that B ∈ Open (A, D) [ABD] by fol Distinct B2'; ¬(A = D) ∧ Collinear A B D ∧ Segment (seg A D) [ABD'] by fol - B1' SEGMENT; consider E such that E ∈ ray A C â” {A} ∧ seg A E ≡ seg A D ∧ ¬(A = E) [ErAC] by fol - Distinct C1 IN_Ray IN_DIFF IN_SING; Collinear A C E ∧ D ∈ ray A B â” {A} [notAE] by fol - IN_Ray ABD IntervalRayEZ IN_DIFF IN_SING; ray A D = ray A B ∧ ray A E = ray A C [equalrays] by fol Distinct notAE ErAC RayWellDefined; ¬Collinear D A E ∧ ¬Collinear E A D ∧ ¬Collinear A E D [EADncol] by fol H1 ABD' notAE ErAC CollinearSymmetry NoncollinearityExtendsToLine; ∡ D E A ≡ ∡ E D A [DEAeq] by fol EADncol ErAC IsoscelesCongBaseAngles; ¬Collinear E D A ∧ Angle (∡ E D A) ∧ ¬Collinear A D E ∧ ¬Collinear D E A [angEDA] by fol EADncol CollinearSymmetry ANGLE; ¬(D = E) [notDE] by fol EADncol NonCollinearImpliesDistinct; consider h such that Line h ∧ D ∈ h ∧ E ∈ h [h_line] by fol - I1; A ∉ h [notAh] by fol - Collinear_DEF EADncol ∉; consider M such that ¬(D = M) ∧ M ∉ h ∧ ¬(A,M same_side h) ∧ seg D M ≡ seg D A ∧ ∡ E D M ≡ ∡ E D A [Mexists] by simplify C4OppositeSide angEDA notDE ABD' h_line -; ¬(A = M) [notAM] by fol h_line - SameSideReflexive; ¬Collinear E D M ∧ ¬Collinear D E M ∧ ¬Collinear M E D [EDMncol] by fol notDE h_line Mexists NonCollinearRaa CollinearSymmetry; seg D E ≡ seg D E ∧ seg M A ≡ seg M A [MArefl] by fol notDE notAM SEGMENT C2Reflexive; E,D,M ≅ E,D,A [] by fol EDMncol angEDA - Mexists SAS; seg M E ≡ seg A E ∧ ∡ M E D ≡ ∡ A E D ∧ ∡ D E M ≡ ∡ D E A [MED≅] by fol - TriangleCong_DEF SegmentSymmetry AngleSymmetry; ∡ E D A ≡ ∡ D E A ∧ ∡ E D A ≡ ∡ E D M ∧ ∡ D E A ≡ ∡ D E M [EDAeqEDM] by fol EDMncol ANGLE angEDA Mexists MED≅ DEAeq C5Symmetric; consider G such that G ∈ h ∧ G ∈ Open (A, M) [AGM] by fol Mexists h_line SameSide_DEF; M ∈ ray A G â” {A} [MrAG] by fol - IntervalRayEZ; consider v such that Line v ∧ A ∈ v ∧ M ∈ v ∧ G ∈ v [v_line] by fol notAM I1 AGM BetweenLinear; ¬(v = h) ∧ v ∩ h = {G} [vhG] by fol - notAh ∉ h_line AGM I1Uniqueness; D ∉ v [notDv] proof assume ¬(D ∉ v) [Con] by fol; D ∈ v ∧ D = G [DG] by fol h_line - ∉ vhG IN_INTER IN_SING; D ∈ Open (A, M) [] by fol DG AGM; ∡ E D A suppl ∡ E D M [EDAsuppl] by fol angEDA - SupplementaryAngles_DEF AngleSymmetry; Right (∡ E D A) [] by fol EDAsuppl EDAeqEDM RightAngle_DEF; Right (∡ A E D) [RightAED] by fol angEDA ANGLE - DEAeq CongRightImpliesRight AngleSymmetry; Right (∡ D E M) [] by fol EDMncol ANGLE - MED≅ CongRightImpliesRight AngleSymmetry; E ∈ Open (A, M) [] by fol EADncol EDMncol RightAED - h_line Mexists OppositeRightAnglesLinear; E ∈ v ∧ E = G [] by fol v_line - BetweenLinear h_line vhG IN_INTER IN_SING; fol - DG notDE; qed; E ∉ v [notEv] proof assume ¬(E ∉ v) [Con] by fol; E ∈ v ∧ E = G [EG] by fol h_line - ∉ vhG IN_INTER IN_SING; E ∈ Open (A, M) [] by fol - AGM; ∡ D E A suppl ∡ D E M [DEAsuppl] by fol EADncol - SupplementaryAngles_DEF AngleSymmetry; Right (∡ D E A) [RightDEA] by fol DEAsuppl EDAeqEDM RightAngle_DEF; Right (∡ E D A) [RightEDA] by fol angEDA RightDEA EDAeqEDM CongRightImpliesRight; Right (∡ E D M) [] by fol EDMncol ANGLE RightEDA Mexists CongRightImpliesRight; D ∈ Open (A, M) [] by fol angEDA EDMncol RightEDA AngleSymmetry - h_line Mexists OppositeRightAnglesLinear; D ∈ v ∧ D = G [] by fol v_line - BetweenLinear h_line vhG IN_INTER IN_SING; fol - EG notDE; qed; ¬Collinear M A E ∧ ¬Collinear M A D ∧ ¬(M = E) [MAEncol] by fol notAM v_line notEv notDv NonCollinearRaa CollinearSymmetry NonCollinearImpliesDistinct; seg M E ≡ seg A D [MEeqAD] by fol - ErAC ABD' SEGMENT MED≅ ErAC C2Transitive; seg A D ≡ seg M D [] by fol SegmentSymmetry ABD' Mexists SEGMENT C2Symmetric; seg M E ≡ seg M D [] by fol MAEncol ABD' Mexists SEGMENT MEeqAD - C2Transitive; M,A,E ≅ M,A,D [] by fol MAEncol MArefl - ErAC SSS; ∡ M A E ≡ ∡ M A D [MAEeq] by fol - TriangleCong_DEF; ∡ D A M ≡ ∡ M A E [] by fol MAEncol ANGLE MAEeq C5Symmetric AngleSymmetry; ∡ B A M ≡ ∡ M A C [BAMeqMAC] by fol - equalrays Angle_DEF; ¬(E,D same_side v) [] proof assume E,D same_side v [Con] by fol; ray A D = ray A E [] by fol v_line notAM notDv notEv - MAEeq C4Uniqueness; fol ABD' EndpointInRay - IN_Ray EADncol; qed; consider H such that H ∈ v ∧ H ∈ Open (E, D) [EHD] by fol v_line - SameSide_DEF; H = G [] by fol - h_line BetweenLinear IN_INTER vhG IN_SING; G ∈ int_angle E A D [GintEAD] by fol EADncol - EHD ConverseCrossbar; M ∈ int_angle E A D [MintEAD] by fol GintEAD MrAG WholeRayInterior; B ∈ ray A D â” {A} ∧ C ∈ ray A E â” {A} [] by fol equalrays Distinct EndpointInRay IN_DIFF IN_SING; M ∈ int_angle B A C [] by fol MintEAD - InteriorWellDefined InteriorAngleSymmetry; fol - BAMeqMAC; qed; `;; let EuclidPropositionI_6 = theorem `; ∀A B C. ¬Collinear A B C ∧ ∡ B A C ≡ ∡ B C A ⇒ seg B A ≡ seg B C proof intro_TAC ∀A B C, H1 H2; ¬(A = C) [] by fol H1 NonCollinearImpliesDistinct; seg C A ≡ seg A C [CAeqAC] by fol SegmentSymmetry - SEGMENT C2Reflexive; ¬Collinear B C A ∧ ¬Collinear C B A ∧ ¬Collinear B A C [BCAncol] by fol H1 CollinearSymmetry; ∡ A C B ≡ ∡ C A B [] by fol - ANGLE H2 C5Symmetric AngleSymmetry; C,B,A ≅ A,B,C [] by fol H1 BCAncol CAeqAC H2 - ASA; fol - TriangleCong_DEF; qed; `;; let IsoscelesExists = theorem `; ∀A B. ¬(A = B) ⇒ ∃D. ¬Collinear A D B ∧ seg D A ≡ seg D B proof intro_TAC ∀A B, H1; consider l such that Line l ∧ A ∈ l ∧ B ∈ l [l_line] by fol H1 I1; consider C such that C ∉ l [notCl] by fol - ExistsPointOffLine; ¬Collinear C A B ∧ ¬Collinear C B A ∧ ¬Collinear A B C ∧ ¬Collinear A C B ∧ ¬Collinear B A C [CABncol] by fol l_line H1 I1 Collinear_DEF - ∉; ∡ C A B ≡ ∡ C B A ∨ ∡ C A B <_ang ∡ C B A ∨ ∡ C B A <_ang ∡ C A B [] by fol - ANGLE AngleTrichotomy; case_split cong | less | greater by fol -; suppose ∡ C A B ≡ ∡ C B A; fol - CABncol EuclidPropositionI_6; end; suppose ∡ C A B <_ang ∡ C B A; ∡ C A B <_ang ∡ A B C [] by fol - AngleSymmetry; consider E such that E ∈ int_angle A B C ∧ ∡ C A B ≡ ∡ A B E [Eexists] by fol CABncol ANGLE - AngleOrderingUse; ¬(B = E) [notBE] by fol - InteriorEZHelp; consider D such that D ∈ Open (A, C) ∧ D ∈ ray B E â” {B} [Dexists] by fol Eexists Crossbar_THM; D ∈ int_angle A B C [] by fol Eexists - WholeRayInterior; ¬Collinear A D B [ADBncol] by fol - InteriorEZHelp CollinearSymmetry; ray B D = ray B E ∧ ray A D = ray A C [] by fol notBE Dexists RayWellDefined IntervalRay; ∡ D A B ≡ ∡ A B D [] by fol Eexists - Angle_DEF; fol ADBncol - AngleSymmetry EuclidPropositionI_6; end; suppose ∡ C B A <_ang ∡ C A B; ∡ C B A <_ang ∡ B A C [] by fol - AngleSymmetry; consider E such that E ∈ int_angle B A C ∧ ∡ C B A ≡ ∡ B A E [Eexists] by fol CABncol ANGLE - AngleOrderingUse; ¬(A = E) [notAE] by fol - InteriorEZHelp; consider D such that D ∈ Open (B, C) ∧ D ∈ ray A E â” {A} [Dexists] by fol Eexists Crossbar_THM; D ∈ int_angle B A C [] by fol Eexists - WholeRayInterior; ¬Collinear A D B ∧ ¬Collinear D A B ∧ ¬Collinear D B A [ADBncol] by fol - InteriorEZHelp CollinearSymmetry; ray A D = ray A E ∧ ray B D = ray B C [] by fol notAE Dexists RayWellDefined IntervalRay; ∡ D B A ≡ ∡ B A D [] by fol Eexists - Angle_DEF; ∡ D A B ≡ ∡ D B A [] by fol AngleSymmetry ADBncol ANGLE - C5Symmetric; fol ADBncol - EuclidPropositionI_6; end; qed; `;; let MidpointExists = theorem `; ∀A B. ¬(A = B) ⇒ ∃M. M ∈ Open (A, B) ∧ seg A M ≡ seg M B proof intro_TAC ∀A B, H1; consider D such that ¬Collinear A D B ∧ seg D A ≡ seg D B [Dexists] by fol H1 IsoscelesExists; consider F such that F ∈ int_angle A D B ∧ ∡ A D F ≡ ∡ F D B [Fexists] by fol - AngleBisector; ¬(D = F) [notDF] by fol - InteriorEZHelp; consider M such that M ∈ Open (A, B) ∧ M ∈ ray D F â” {D} [Mexists] by fol Fexists Crossbar_THM; ray D M = ray D F [] by fol notDF - RayWellDefined; ∡ A D M ≡ ∡ M D B [ADMeqMDB] by fol Fexists - Angle_DEF; M ∈ int_angle A D B [] by fol Fexists Mexists WholeRayInterior; ¬(D = M) ∧ ¬Collinear A D M ∧ ¬Collinear B D M [ADMncol] by fol - InteriorEZHelp InteriorAngleSymmetry; seg D M ≡ seg D M [] by fol - SEGMENT C2Reflexive; A,D,M ≅ B,D,M [] by fol ADMncol Dexists - ADMeqMDB AngleSymmetry SAS; fol Mexists - TriangleCong_DEF SegmentSymmetry; qed; `;; let EuclidPropositionI_7short = theorem `; ∀A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ⇒ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ⇒ seg A C ≡ seg A D ⇒ ¬(seg B C ≡ seg B D) proof intro_TAC ∀A B C D a, a_line, Csim_aD, ACeqAD; ¬(A = C) ∧ ¬(A = D) [AnotCD] by fol a_line Csim_aD ∉; assume seg B C ≡ seg B D [Con] by fol; seg C B ≡ seg D B ∧ seg A B ≡ seg A B ∧ seg A D ≡ seg A D [segeqs] by fol - SegmentSymmetry a_line AnotCD SEGMENT C2Reflexive; ¬Collinear A C B ∧ ¬Collinear A D B [] by fol a_line I1 Csim_aD Collinear_DEF ∉; A,C,B ≅ A,D,B [] by fol - ACeqAD segeqs SSS; ∡ B A C ≡ ∡ B A D [] by fol - TriangleCong_DEF; ray A D = ray A C [] by fol a_line Csim_aD - C4Uniqueness; C ∈ ray A D â” {A} ∧ D ∈ ray A D â” {A} [] by fol AnotCD - EndpointInRay IN_DIFF IN_SING; C = D [] by fol AnotCD SEGMENT - ACeqAD segeqs C1; fol - Csim_aD; qed; `;; let EuclidPropositionI_7Help = theorem `; ∀A B C D a. ¬(A = B) ⇒ Line a ∧ A ∈ a ∧ B ∈ a ⇒ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ⇒ seg A C ≡ seg A D ⇒ C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B C D ⇒ ¬(seg B C ≡ seg B D) proof intro_TAC ∀A B C D a, notAB, a_line, Csim_aD, ACeqAD, Int_ConvQuad; ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) [Distinct] by fol a_line Csim_aD ∉ SameSide_DEF; case_split convex | CintDAB by fol Int_ConvQuad; suppose ConvexQuadrilateral A B C D; A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ Tetralateral A B C D [ABint] by fol - ConvexQuad_DEF Quadrilateral_DEF; ¬Collinear B C D ∧ ¬Collinear D C B ∧ ¬Collinear C B D ∧ ¬Collinear C D A ∧ ¬Collinear D A C ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) [angCDB] by fol - Tetralateral_DEF CollinearSymmetry ANGLE; ∡ C D A ≡ ∡ D C A [CDAeqDCA] by fol angCDB Distinct SEGMENT ACeqAD C2Symmetric IsoscelesCongBaseAngles; A ∈ int_angle D C B ∧ ∡ D C A ≡ ∡ D C A ∧ ∡ C D B ≡ ∡ C D B [] by fol ABint InteriorAngleSymmetry angCDB ANGLE C5Reflexive; ∡ D C A <_ang ∡ D C B ∧ ∡ C D B <_ang ∡ C D A [] by fol angCDB ABint - AngleOrdering_DEF; ∡ C D B <_ang ∡ D C B [] by fol - angCDB CDAeqDCA AngleTrichotomy2 AngleOrderTransitivity; ¬(∡ D C B ≡ ∡ C D B) [] by fol - AngleTrichotomy1 angCDB ANGLE C5Symmetric; fol angCDB - IsoscelesCongBaseAngles; end; suppose C ∈ int_triangle D A B; C ∈ int_angle A D B ∧ C ∈ int_angle D A B [CintADB] by fol - IN_InteriorTriangle InteriorAngleSymmetry; ¬Collinear A D C ∧ ¬Collinear B D C [ADCncol] by fol CintADB InteriorEZHelp InteriorAngleSymmetry; ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by fol - CollinearSymmetry; ¬Collinear B C D ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) ∧ ¬Collinear D C B [angCDB] by fol ADCncol - CollinearSymmetry ANGLE; ∡ C D A ≡ ∡ D C A [CDAeqDCA] by fol DACncol Distinct ADCncol SEGMENT ACeqAD C2Symmetric IsoscelesCongBaseAngles; consider E such that D ∈ Open (A, E) ∧ ¬(D = E) ∧ Collinear A D E [ADE] by fol Distinct B2' B1'; B ∈ int_angle C D E ∧ Collinear D A E [BintCDE] by fol CintADB - InteriorReflectionInterior CollinearSymmetry; ¬Collinear C D E [CDEncol] by fol DACncol - ADE NoncollinearityExtendsToLine; consider F such that F ∈ Open (B, D) ∧ F ∈ ray A C â” {A} [Fexists] by fol CintADB Crossbar_THM B1'; F ∈ int_angle B C D [FintBCD] by fol ADCncol CollinearSymmetry - ConverseCrossbar; ¬Collinear D C F [DCFncol] by fol Distinct ADCncol CollinearSymmetry Fexists B1' NoncollinearityExtendsToLine; Collinear A C F ∧ F ∈ ray D B â” {D} ∧ C ∈ int_angle A D F [] by fol Fexists IN_DIFF IN_SING IN_Ray B1' IntervalRayEZ CintADB InteriorWellDefined; C ∈ Open (A, F) [] by fol - AlternateConverseCrossbar; ∡ A D C suppl ∡ C D E ∧ ∡ A C D suppl ∡ D C F [] by fol ADE DACncol - SupplementaryAngles_DEF; ∡ C D E ≡ ∡ D C F [CDEeqDCF] by fol - CDAeqDCA AngleSymmetry SupplementsCongAnglesCong; ∡ C D B <_ang ∡ C D E [] by fol angCDB CDEncol BintCDE C5Reflexive AngleOrdering_DEF; ∡ C D B <_ang ∡ D C F [CDBlessDCF] by fol - DCFncol ANGLE CDEeqDCF AngleTrichotomy2; ∡ D C F <_ang ∡ D C B [] by fol DCFncol ANGLE angCDB FintBCD InteriorAngleSymmetry C5Reflexive AngleOrdering_DEF; ∡ C D B <_ang ∡ D C B [] by fol CDBlessDCF - AngleOrderTransitivity; ¬(∡ D C B ≡ ∡ C D B) [] by fol - AngleTrichotomy1 angCDB CollinearSymmetry ANGLE C5Symmetric; fol Distinct ADCncol CollinearSymmetry - IsoscelesCongBaseAngles; end; qed; `;; let EuclidPropositionI_7 = theorem `; ∀A B C D a. ¬(A = B) ⇒ Line a ∧ A ∈ a ∧ B ∈ a ⇒ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ⇒ seg A C ≡ seg A D ⇒ ¬(seg B C ≡ seg B D) proof intro_TAC ∀A B C D a, notAB, a_line, Csim_aD, ACeqAD; ¬Collinear A B C ∧ ¬Collinear D A B [ABCncol] by fol a_line notAB Csim_aD NonCollinearRaa CollinearSymmetry; ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ A ∉ Open (C, D) [Distinct] by fol a_line Csim_aD ∉ SameSide_DEF; ¬Collinear A D C [ADCncol] proof assume Collinear A D C [Con] by fol; C ∈ ray A D â” {A} ∧ D ∈ ray A D â” {A} ∧ seg A D ≡ seg A D [] by fol Distinct - IN_Ray EndpointInRay IN_DIFF IN_SING SEGMENT C2Reflexive; fol Distinct SEGMENT - ACeqAD C1 Csim_aD; qed; D,C same_side a [Dsim_aC] by fol a_line Csim_aD SameSideSymmetric; seg A D ≡ seg A C ∧ seg B D ≡ seg B D [ADeqAC] by fol Distinct SEGMENT ACeqAD C2Symmetric C2Reflexive; ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by fol ADCncol CollinearSymmetry; ¬(seg B D ≡ seg B C) ⇒ ¬(seg B C ≡ seg B D) [BswitchDC] by fol Distinct SEGMENT C2Symmetric; case_split BDCcol | BDCncol by fol -; suppose Collinear B D C; B ∉ Open (C, D) ∧ C ∈ ray B D â” {B} ∧ D ∈ ray B D â” {B} [] by fol a_line Csim_aD SameSide_DEF ∉ Distinct - IN_Ray Distinct IN_DIFF IN_SING EndpointInRay; fol Distinct SEGMENT - ACeqAD ADeqAC C1 Csim_aD; end; suppose ¬Collinear B D C; Tetralateral A B C D [] by fol notAB Distinct Csim_aD ABCncol - CollinearSymmetry DACncol Tetralateral_DEF; ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B [] by fol - a_line Csim_aD FourChoicesTetralateral InteriorTriangleSymmetry; fol notAB a_line Csim_aD Dsim_aC ACeqAD ADeqAC - EuclidPropositionI_7Help BswitchDC; end; qed; `;; let EuclidPropositionI_11 = theorem `; ∀A B. ¬(A = B) ⇒ ∃F. Right (∡ A B F) proof intro_TAC ∀A B, notAB; consider C such that B ∈ Open (A, C) ∧ seg B C ≡ seg B A [ABC] by fol notAB SEGMENT C1OppositeRay; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [Distinct] by fol ABC B1'; seg B A ≡ seg B C [BAeqBC] by fol - SEGMENT ABC C2Symmetric; consider F such that ¬Collinear A F C ∧ seg F A ≡ seg F C [Fexists] by fol Distinct IsoscelesExists; ¬Collinear B F A ∧ ¬Collinear B F C [BFAncol] by fol - CollinearSymmetry Distinct NoncollinearityExtendsToLine; ¬Collinear A B F ∧ Angle (∡ A B F) [angABF] by fol BFAncol CollinearSymmetry ANGLE; ∡ A B F suppl ∡ F B C [ABFsuppl] by fol - ABC SupplementaryAngles_DEF; ¬(B = F) ∧ seg B F ≡ seg B F [] by fol BFAncol NonCollinearImpliesDistinct SEGMENT C2Reflexive; B,F,A ≅ B,F,C [] by fol BFAncol - BAeqBC Fexists SSS; ∡ A B F ≡ ∡ F B C [] by fol - TriangleCong_DEF AngleSymmetry; fol angABF ABFsuppl - RightAngle_DEF; qed; `;; let DropPerpendicularToLine = theorem `; ∀P l. Line l ∧ P ∉ l ⇒ ∃E Q. E ∈ l ∧ Q ∈ l ∧ Right (∡ P Q E) proof intro_TAC ∀P l, l_line; consider A B such that A ∈ l ∧ B ∈ l ∧ ¬(A = B) [ABl] by fol l_line I2; ¬Collinear B A P ∧ ¬Collinear P A B ∧ ¬(A = P) [BAPncol] by fol ABl l_line NonCollinearRaa CollinearSymmetry ∉; Angle (∡ B A P) ∧ Angle (∡ P A B) [angBAP] by fol - ANGLE AngleSymmetry; consider P' such that ¬(A = P') ∧ P' ∉ l ∧ ¬(P,P' same_side l) ∧ seg A P' ≡ seg A P ∧ ∡ B A P' ≡ ∡ B A P [P'exists] by simplify C4OppositeSide - ABl BAPncol l_line; consider Q such that Q ∈ l ∧ Q ∈ Open (P, P') ∧ Collinear A B Q [Qexists] by fol l_line - SameSide_DEF ABl Collinear_DEF; ¬Collinear B A P' [BAP'ncol] by fol l_line ABl I1 Collinear_DEF P'exists ∉; ∡ B A P ≡ ∡ B A P' [BAPeqBAP'] by fol - ANGLE angBAP P'exists C5Symmetric; ∃E. E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' [] proof assume ¬(A = Q) [notAQ] by fol ABl BAPncol BAPeqBAP' AngleSymmetry; seg A Q ≡ seg A Q ∧ seg A P ≡ seg A P' [APeqAP'] by fol - SEGMENT C2Reflexive BAPncol P'exists C2Symmetric; ¬Collinear Q A P' ∧ ¬Collinear Q A P [QAP'ncol] by fol notAQ l_line ABl Qexists P'exists NonCollinearRaa CollinearSymmetry; ∡ Q A P ≡ ∡ Q A P' [] proof case_split QAB | notQAB by fol - ∉; suppose A ∈ Open (Q, B); ∡ B A P suppl ∡ P A Q ∧ ∡ B A P' suppl ∡ P' A Q [] by fol BAPncol BAP'ncol - B1' SupplementaryAngles_DEF; fol - BAPeqBAP' SupplementsCongAnglesCong AngleSymmetry; end; suppose A ∉ Open (Q, B); Q ∈ ray A B â” {A} [QrayAB_A] by fol ABl Qexists notQAB IN_Ray notAQ IN_DIFF IN_SING; ray A Q = ray A B [] by fol - ABl RayWellDefined; fol notAQ QrayAB_A - BAPeqBAP' Angle_DEF; end; qed; Q,A,P ≅ Q,A,P' [] by fol QAP'ncol APeqAP' - SAS; fol - TriangleCong_DEF AngleSymmetry ABl QAP'ncol CollinearSymmetry; qed; consider E such that E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' [Eexists] by fol -; ∡ P Q E suppl ∡ E Q P' ∧ Right (∡ P Q E) [] by fol - Qexists SupplementaryAngles_DEF RightAngle_DEF; fol Eexists Qexists -; qed; `;; let EuclidPropositionI_14 = theorem `; ∀A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ ¬(A = B) ⇒ C ∉ l ∧ D ∉ l ∧ ¬(C,D same_side l) ⇒ ∡ C B A suppl ∡ A B D ⇒ B ∈ Open (C, D) proof intro_TAC ∀A B C D l, l_line, Cnsim_lD, CBAsupplABD; ¬(B = C) ∧ ¬(B = D) ∧ ¬Collinear C B A [Distinct] by fol l_line Cnsim_lD ∉ I1 Collinear_DEF; consider E such that B ∈ Open (C, E) [CBE] by fol Distinct B2'; E ∉ l ∧ ¬(C,E same_side l) [Csim_lE] by fol l_line ∉ - BetweenLinear Cnsim_lD SameSide_DEF; D,E same_side l [Dsim_lE] by fol l_line Cnsim_lD - AtMost2Sides; ∡ C B A suppl ∡ A B E [] by fol Distinct CBE SupplementaryAngles_DEF; ∡ A B D ≡ ∡ A B E [] by fol CBAsupplABD - SupplementUnique; ray B E = ray B D [] by fol l_line Csim_lE Cnsim_lD Dsim_lE - C4Uniqueness; D ∈ ray B E â” {B} [] by fol Distinct - EndpointInRay IN_DIFF IN_SING; fol CBE - OppositeRaysIntersect1pointHelp B1'; qed; `;; (* Euclid's Proposition I.15 *) let VerticalAnglesCong = theorem `; ∀A B O A' B'. ¬Collinear A O B ⇒ O ∈ Open (A, A') ∧ O ∈ Open (B, B') ⇒ ∡ B O A' ≡ ∡ B' O A proof intro_TAC ∀A B O A' B', H1, H2; ∡ A O B suppl ∡ B O A' [AOBsupplBOA'] by fol H1 H2 SupplementaryAngles_DEF; ∡ B O A suppl ∡ A O B' [] by fol H1 CollinearSymmetry H2 SupplementaryAngles_DEF; fol AOBsupplBOA' - AngleSymmetry SupplementUnique; qed; `;; let EuclidPropositionI_16 = theorem `; ∀A B C D. ¬Collinear A B C ∧ C ∈ Open (B, D) ⇒ ∡ B A C <_ang ∡ D C A proof intro_TAC ∀A B C D, H1 H2; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; consider l such that Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol Distinct I1; consider m such that Line m ∧ B ∈ m ∧ C ∈ m [m_line] by fol Distinct I1; D ∈ m [Dm] by fol m_line H2 BetweenLinear; consider E such that E ∈ Open (A, C) ∧ seg A E ≡ seg E C [AEC] by fol Distinct MidpointExists; ¬(A = E) ∧ ¬(E = C) ∧ Collinear A E C ∧ ¬(B = E) [AECcol] by fol - B1' H1; E ∈ l [El] by fol l_line AEC BetweenLinear; consider F such that E ∈ Open (B, F) ∧ seg E F ≡ seg E B [BEF] by fol AECcol SEGMENT C1OppositeRay; ¬(B = E) ∧ ¬(B = F) ∧ ¬(E = F) ∧ Collinear B E F [BEF'] by fol BEF B1'; B ∉ l [notBl] by fol l_line Distinct I1 Collinear_DEF H1 ∉; ¬Collinear A E B ∧ ¬Collinear C E B [AEBncol] by fol AECcol l_line El notBl NonCollinearRaa CollinearSymmetry; Angle (∡ B A E) [angBAE] by fol - CollinearSymmetry ANGLE; ¬Collinear C E F [CEFncol] by fol AEBncol BEF' CollinearSymmetry NoncollinearityExtendsToLine; ∡ B E A ≡ ∡ F E C [BEAeqFEC] by fol AEBncol AEC B1' BEF VerticalAnglesCong; seg E A ≡ seg E C ∧ seg E B ≡ seg E F [] by fol AEC SegmentSymmetry AECcol BEF' SEGMENT BEF C2Symmetric; A,E,B ≅ C,E,F [] by fol AEBncol CEFncol - BEAeqFEC AngleSymmetry SAS; ∡ B A E ≡ ∡ F C E [BAEeqFCE] by fol - TriangleCong_DEF; ¬Collinear E C D [ECDncol] by fol AEBncol H2 B1' CollinearSymmetry NoncollinearityExtendsToLine; F ∉ l ∧ D ∉ l [notFl] by fol l_line El Collinear_DEF CEFncol - ∉; F ∈ ray B E â” {B} ∧ E ∉ m [] by fol BEF IntervalRayEZ m_line Collinear_DEF AEBncol ∉; F ∉ m ∧ F,E same_side m [Fsim_mE] by fol m_line - RaySameSide; ¬(B,F same_side l) ∧ ¬(B,D same_side l) [] by fol El l_line BEF H2 SameSide_DEF; F,D same_side l [] by fol l_line notBl notFl - AtMost2Sides; F ∈ int_angle E C D [] by fol ECDncol l_line El m_line Dm notFl Fsim_mE - IN_InteriorAngle; ∡ B A E <_ang ∡ E C D [BAElessECD] by fol angBAE ECDncol - BAEeqFCE AngleSymmetry AngleOrdering_DEF; ray A E = ray A C ∧ ray C E = ray C A [] by fol AEC B1' IntervalRay; ∡ B A C <_ang ∡ A C D [] by fol BAElessECD - Angle_DEF; fol - AngleSymmetry; qed; `;; let ExteriorAngle = theorem `; ∀A B C D. ¬Collinear A B C ∧ C ∈ Open (B, D) ⇒ ∡ A B C <_ang ∡ A C D proof intro_TAC ∀A B C D, H1 H2; ¬(C = D) ∧ C ∈ Open (D, B) ∧ Collinear B C D [H2'] by fol H2 BetweenLinear B1'; ¬Collinear B A C ∧ ¬(A = C) [BACncol] by fol H1 CollinearSymmetry NonCollinearImpliesDistinct; consider E such that C ∈ Open (A, E) [ACE] by fol - B2'; ¬(C = E) ∧ C ∈ Open (E, A) ∧ Collinear A C E [ACE'] by fol - B1'; ¬Collinear A C D ∧ ¬Collinear D C E [DCEncol] by fol H1 CollinearSymmetry H2' - NoncollinearityExtendsToLine; ∡ A B C <_ang ∡ E C B [ABClessECB] by fol BACncol ACE EuclidPropositionI_16; ∡ E C B ≡ ∡ A C D [] by fol DCEncol ACE' H2' VerticalAnglesCong; fol ABClessECB DCEncol ANGLE - AngleTrichotomy2; qed; `;; let EuclidPropositionI_17 = theorem `; ∀A B C α β γ. ¬Collinear A B C ∧ α = ∡ A B C ∧ β = ∡ B C A ⇒ β suppl γ ⇒ α <_ang γ proof intro_TAC ∀A B C α β γ, H1, H2; Angle γ [angγ] by fol H2 SupplementImpliesAngle; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; ¬Collinear B A C ∧ ¬Collinear A C B [BACncol] by fol H1 CollinearSymmetry; consider D such that C ∈ Open (A, D) [ACD] by fol Distinct B2'; ∡ A B C <_ang ∡ D C B [ABClessDCB] by fol BACncol ACD EuclidPropositionI_16; β suppl ∡ B C D [] by fol - H1 AngleSymmetry BACncol ACD SupplementaryAngles_DEF; ∡ B C D ≡ γ [] by fol H2 - SupplementUnique; fol ABClessDCB H1 AngleSymmetry angγ - AngleTrichotomy2; qed; `;; let EuclidPropositionI_18 = theorem `; ∀A B C. ¬Collinear A B C ∧ seg A C <__ seg A B ⇒ ∡ A B C <_ang ∡ B C A proof intro_TAC ∀A B C, H1 H2; ¬(A = B) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; consider D such that D ∈ Open (A, B) ∧ seg A C ≡ seg A D [ADB] by fol Distinct SEGMENT H2 SegmentOrderingUse; ¬(D = A) ∧ ¬(D = B) ∧ D ∈ Open (B, A) ∧ Collinear A D B ∧ ray B D = ray B A [ADB'] by fol - B1' IntervalRay; D ∈ int_angle A C B ∧ ¬Collinear A C B [DintACB] by fol H1 CollinearSymmetry ADB ConverseCrossbar; ¬Collinear D A C ∧ ¬Collinear C B D ∧ ¬Collinear C D A [DACncol] by fol H1 CollinearSymmetry ADB' NoncollinearityExtendsToLine; seg A D ≡ seg A C [] by fol ADB' Distinct SEGMENT ADB C2Symmetric; ∡ C D A ≡ ∡ A C D [] by fol DACncol - IsoscelesCongBaseAngles AngleSymmetry; ∡ C D A <_ang ∡ A C B [CDAlessACB] by fol DACncol ANGLE H1 DintACB - AngleOrdering_DEF; ∡ B D C suppl ∡ C D A [] by fol DACncol CollinearSymmetry ADB' SupplementaryAngles_DEF; ∡ C B D <_ang ∡ C D A [] by fol DACncol - EuclidPropositionI_17; ∡ C B D <_ang ∡ A C B [] by fol - CDAlessACB AngleOrderTransitivity; fol - ADB' Angle_DEF AngleSymmetry; qed; `;; let EuclidPropositionI_19 = theorem `; ∀A B C. ¬Collinear A B C ∧ ∡ A B C <_ang ∡ B C A ⇒ seg A C <__ seg A B proof intro_TAC ∀A B C, H1 H2; ¬Collinear B A C ∧ ¬Collinear B C A ∧ ¬Collinear A C B [BACncol] by fol H1 CollinearSymmetry; ¬(A = B) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; assume ¬(seg A C <__ seg A B) [Con] by fol; seg A B ≡ seg A C ∨ seg A B <__ seg A C [] by fol Distinct SEGMENT - SegmentTrichotomy; case_split cong | less by fol -; suppose seg A B ≡ seg A C; ∡ C B A ≡ ∡ B C A [] by fol BACncol - IsoscelesCongBaseAngles; fol - AngleSymmetry H2 AngleTrichotomy1; end; suppose seg A B <__ seg A C; ∡ A C B <_ang ∡ C B A [] by fol BACncol - EuclidPropositionI_18; fol H1 BACncol ANGLE - AngleSymmetry H2 AngleTrichotomy; end; qed; `;; let EuclidPropositionI_20 = theorem `; ∀A B C D. ¬Collinear A B C ⇒ A ∈ Open (B, D) ∧ seg A D ≡ seg A C ⇒ seg B C <__ seg B D proof intro_TAC ∀A B C D, H1, H2; ¬(B = D) ∧ ¬(A = D) ∧ A ∈ Open (D, B) ∧ Collinear B A D ∧ ray D A = ray D B [BAD'] by fol H2 B1' IntervalRay; ¬Collinear C A D [CADncol] by fol H1 CollinearSymmetry BAD' NoncollinearityExtendsToLine; ¬Collinear D C B ∧ ¬Collinear B D C [DCBncol] by fol H1 CollinearSymmetry BAD' NoncollinearityExtendsToLine; Angle (∡ C D A) [angCDA] by fol CADncol CollinearSymmetry ANGLE; ∡ C D A ≡ ∡ D C A [CDAeqDCA] by fol CADncol CollinearSymmetry H2 IsoscelesCongBaseAngles; A ∈ int_angle D C B [] by fol DCBncol BAD' ConverseCrossbar; ∡ C D A <_ang ∡ D C B [] by fol angCDA DCBncol - CDAeqDCA AngleOrdering_DEF; ∡ B D C <_ang ∡ D C B [] by fol - BAD' Angle_DEF AngleSymmetry; fol DCBncol - EuclidPropositionI_19; qed; `;; let EuclidPropositionI_21 = theorem `; ∀A B C D. ¬Collinear A B C ∧ D ∈ int_triangle A B C ⇒ ∡ A B C <_ang ∡ C D A proof intro_TAC ∀A B C D, H1 H2; ¬(B = A) ∧ ¬(B = C) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; D ∈ int_angle B A C ∧ D ∈ int_angle C B A [DintTri] by fol H2 IN_InteriorTriangle InteriorAngleSymmetry; consider E such that E ∈ Open (B, C) ∧ E ∈ ray A D â” {A} [BEC] by fol - Crossbar_THM; ¬(B = E) ∧ ¬(E = C) ∧ Collinear B E C ∧ Collinear A D E [BEC'] by fol - B1' IN_Ray IN_DIFF IN_SING; ray B E = ray B C ∧ E ∈ ray B C â” {B} [rBErBC] by fol BEC IntervalRay IntervalRayEZ; D ∈ int_angle A B E [DintABE] by fol DintTri - InteriorAngleSymmetry InteriorWellDefined; D ∈ Open (A, E) [ADE] by fol BEC' - AlternateConverseCrossbar; ray E D = ray E A [rEDrEA] by fol - B1' IntervalRay; ¬Collinear A B E ∧ ¬Collinear B E A ∧ ¬Collinear C B D ∧ ¬(A = D) [ABEncol] by fol DintABE IN_InteriorAngle CollinearSymmetry DintTri InteriorEZHelp; ¬Collinear E D C ∧ ¬Collinear C E D [EDCncol] by fol - CollinearSymmetry BEC' NoncollinearityExtendsToLine; ∡ A B E <_ang ∡ A E C ∧ ∡ C E D = ∡ D E C [] by fol ABEncol BEC ExteriorAngle AngleSymmetry; ∡ A B C <_ang ∡ C E D [ABClessAEC] by fol - rBErBC rEDrEA Angle_DEF; ∡ C E D <_ang ∡ C D A [] by fol EDCncol ADE B1' ExteriorAngle; fol ABClessAEC - AngleOrderTransitivity; qed; `;; let AngleTrichotomy3 = theorem `; ∀α β γ. α <_ang β ∧ Angle γ ∧ γ ≡ α ⇒ γ <_ang β proof intro_TAC ∀α β γ, H1; consider A O B G such that Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by fol H1 AngleOrdering_DEF; ¬Collinear A O G [] by fol - InteriorEZHelp; γ ≡ ∡ A O G [] by fol H1 H1' - ANGLE C5Transitive; fol H1 H1' - AngleOrdering_DEF; qed; `;; let InteriorCircleConvexHelp = theorem `; ∀O A B C. ¬Collinear A O C ⇒ B ∈ Open (A, C) ⇒ seg O A <__ seg O C ∨ seg O A ≡ seg O C ⇒ seg O B <__ seg O C proof intro_TAC ∀O A B C, H1, H2, H3; ¬Collinear O C A ∧ ¬Collinear C O A ∧ ¬(O = A) ∧ ¬(O = C) [H1'] by fol H1 CollinearSymmetry NonCollinearImpliesDistinct; ray A B = ray A C ∧ ray C B = ray C A [equal_rays] by fol H2 IntervalRay B1'; ∡ O C A <_ang ∡ C A O ∨ ∡ O C A ≡ ∡ C A O [] proof assume seg O A ≡ seg O C [seg_eq] by fol H3 H1' EuclidPropositionI_18; seg O C ≡ seg O A [] by fol H1' SEGMENT - C2Symmetric; fol H1' - IsoscelesCongBaseAngles AngleSymmetry; qed; ∡ O C B <_ang ∡ B A O ∨ ∡ O C B ≡ ∡ B A O [] by fol - equal_rays Angle_DEF; ∡ B C O <_ang ∡ O A B ∨ ∡ B C O ≡ ∡ O A B [BCOlessOAB] by fol - AngleSymmetry; ¬Collinear O A B ∧ ¬Collinear B C O ∧ ¬Collinear O C B [OABncol] by fol H1 CollinearSymmetry H2 B1' NoncollinearityExtendsToLine; ∡ O A B <_ang ∡ O B C [] by fol - H2 ExteriorAngle; ∡ B C O <_ang ∡ O B C [] by fol BCOlessOAB - AngleOrderTransitivity OABncol ANGLE - AngleTrichotomy3; fol OABncol - AngleSymmetry EuclidPropositionI_19; qed; `;; let InteriorCircleConvex = theorem `; ∀O R A B C. ¬(O = R) ⇒ B ∈ Open (A, C) ⇒ A ∈ int_circle O R ∧ C ∈ int_circle O R ⇒ B ∈ int_circle O R proof intro_TAC ∀O R A B C, H1, H2, H3; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ Open (C, A) [H2'] by fol H2 B1'; (A = O ∨ seg O A <__ seg O R) ∧ (C = O ∨ seg O C <__ seg O R) [ACintOR] by fol H3 H1 IN_InteriorCircle; case_split OAC | OnotAC by fol -; suppose O = A ∨ O = C; B ∈ Open (O, C) ∨ B ∈ Open (O, A) [] by fol - H2 B1'; seg O B <__ seg O A ∧ ¬(O = A) ∨ seg O B <__ seg O C ∧ ¬(O = C) [] by fol - B1' SEGMENT C2Reflexive SegmentOrdering_DEF; seg O B <__ seg O R [] by fol - ACintOR SegmentOrderTransitivity; fol - H1 IN_InteriorCircle; end; suppose ¬(O = A) ∧ ¬(O = C); case_split AOCncol | AOCcol by fol -; suppose ¬Collinear A O C; seg O A <__ seg O C ∨ seg O A ≡ seg O C ∨ seg O C <__ seg O A [] by fol OnotAC SEGMENT SegmentTrichotomy; seg O B <__ seg O C ∨ seg O B <__ seg O A [] by fol AOCncol H2 - InteriorCircleConvexHelp CollinearSymmetry B1'; fol OnotAC ACintOR - SegmentOrderTransitivity H1 IN_InteriorCircle; end; suppose Collinear A O C; consider l such that Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol H2' I1; Collinear B A O ∧ Collinear B C O [OABCcol] by fol - H2 BetweenLinear H2' AOCcol CollinearLinear Collinear_DEF; B ∉ Open (O, A) ∧ B ∉ Open (O, C) ⇒ B = O [] proof intro_TAC Assumption; O ∈ ray B A ∩ ray B C [] by fol H2' OABCcol - IN_Ray IN_INTER; fol - H2 OppositeRaysIntersect1point IN_SING; qed; B ∈ Open (O, A) ∨ B ∈ Open (O, C) ∨ B = O [] by fol - ∉; seg O B <__ seg O A ∨ seg O B <__ seg O C ∨ B = O [] by fol - B1' SEGMENT C2Reflexive SegmentOrdering_DEF; seg O B <__ seg O R ∨ B = O [] by fol - ACintOR OnotAC SegmentOrderTransitivity; fol - H1 IN_InteriorCircle; end; end; qed; `;; let SegmentTrichotomy3 = theorem `; ∀s t u. s <__ t ∧ Segment u ∧ u ≡ s ⇒ u <__ t proof intro_TAC ∀s t u, H1; consider C D X such that Segment s ∧ t = seg C D ∧ X ∈ Open (C, D) ∧ s ≡ seg C X ∧ ¬(C = X) [H1'] by fol H1 SegmentOrdering_DEF B1'; u ≡ seg C X [] by fol H1 - SEGMENT C2Transitive; fol H1 H1' - SegmentOrdering_DEF; qed; `;; let EuclidPropositionI_24Help = theorem `; ∀O A C O' D M. ¬Collinear A O C ∧ ¬Collinear D O' M ⇒ seg O' D ≡ seg O A ∧ seg O' M ≡ seg O C ⇒ ∡ D O' M <_ang ∡ A O C ⇒ seg O A <__ seg O C ∨ seg O A ≡ seg O C ⇒ seg D M <__ seg A C proof intro_TAC ∀O A C O' D M, H1, H2, H3, H4; consider K such that K ∈ int_angle A O C ∧ ∡ D O' M ≡ ∡ A O K [KintAOC] by fol H1 ANGLE H3 AngleOrderingUse; ¬(O = C) ∧ ¬(D = M) ∧ ¬(O' = M) ∧ ¬(O = K) [Distinct] by fol H1 NonCollinearImpliesDistinct - InteriorEZHelp; consider B such that B ∈ ray O K â” {O} ∧ seg O B ≡ seg O C [BrOK] by fol Distinct SEGMENT - C1; ray O B = ray O K [] by fol Distinct - RayWellDefined; ∡ D O' M ≡ ∡ A O B [DO'MeqAOB] by fol KintAOC - Angle_DEF; B ∈ int_angle A O C [BintAOC] by fol KintAOC BrOK WholeRayInterior; ¬(B = O) ∧ ¬Collinear A O B [AOBncol] by fol - InteriorEZHelp; seg O C ≡ seg O B [OCeqOB] by fol Distinct - SEGMENT BrOK C2Symmetric; seg O' M ≡ seg O B [] by fol Distinct SEGMENT AOBncol H2 - C2Transitive; D,O',M ≅ A,O,B [] by fol H1 AOBncol H2 - DO'MeqAOB SAS; seg D M ≡ seg A B [DMeqAB] by fol - TriangleCong_DEF; consider G such that G ∈ Open (A, C) ∧ G ∈ ray O B â” {O} ∧ ¬(G = O) [AGC] by fol BintAOC Crossbar_THM B1' IN_DIFF IN_SING; Segment (seg O G) ∧ ¬(O = B) [notOB] by fol - SEGMENT BrOK IN_DIFF IN_SING; seg O G <__ seg O C [] by fol H1 AGC H4 InteriorCircleConvexHelp; seg O G <__ seg O B [] by fol - OCeqOB BrOK SEGMENT SegmentTrichotomy2 IN_DIFF IN_SING; consider G' such that G' ∈ Open (O, B) ∧ seg O G ≡ seg O G' [OG'B] by fol notOB - SegmentOrderingUse; ¬(G' = O) ∧ seg O G' ≡ seg O G' ∧ Segment (seg O G') [notG'O] by fol - B1' SEGMENT C2Reflexive SEGMENT; G' ∈ ray O B â” {O} [] by fol OG'B IntervalRayEZ; G' = G ∧ G ∈ Open (B, O) [] by fol notG'O notOB - AGC OG'B C1 B1'; ConvexQuadrilateral B A O C [] by fol H1 - AGC DiagonalsIntersectImpliesConvexQuad; A ∈ int_angle O C B ∧ O ∈ int_angle C B A ∧ Quadrilateral B A O C [OintCBA] by fol - ConvexQuad_DEF; A ∈ int_angle B C O [AintBCO] by fol - InteriorAngleSymmetry; Tetralateral B A O C [] by fol OintCBA Quadrilateral_DEF; ¬Collinear C B A ∧ ¬Collinear B C O ∧ ¬Collinear C O B ∧ ¬Collinear C B O [BCOncol] by fol - Tetralateral_DEF CollinearSymmetry; ∡ B C O ≡ ∡ C B O [BCOeqCBO] by fol - OCeqOB IsoscelesCongBaseAngles; ¬Collinear B C A ∧ ¬Collinear A C B [ACBncol] by fol AintBCO InteriorEZHelp CollinearSymmetry; ∡ B C A ≡ ∡ B C A ∧ Angle (∡ B C A) ∧ ∡ C B O ≡ ∡ C B O [CBOref] by fol - ANGLE BCOncol C5Reflexive; ∡ B C A <_ang ∡ B C O [] by fol - BCOncol ANGLE AintBCO AngleOrdering_DEF; ∡ B C A <_ang ∡ C B O [BCAlessCBO] by fol - BCOncol ANGLE BCOeqCBO AngleTrichotomy2; ∡ C B O <_ang ∡ C B A [] by fol BCOncol ANGLE OintCBA CBOref AngleOrdering_DEF; ∡ A C B <_ang ∡ C B A [] by fol BCAlessCBO - AngleOrderTransitivity AngleSymmetry; seg A B <__ seg A C [] by fol ACBncol - EuclidPropositionI_19; fol - Distinct SEGMENT DMeqAB SegmentTrichotomy3; qed; `;; let EuclidPropositionI_24 = theorem `; ∀O A C O' D M. ¬Collinear A O C ∧ ¬Collinear D O' M ⇒ seg O' D ≡ seg O A ∧ seg O' M ≡ seg O C ⇒ ∡ D O' M <_ang ∡ A O C ⇒ seg D M <__ seg A C proof intro_TAC ∀O A C O' D M, H1, H2, H3; ¬(O = A) ∧ ¬(O = C) ∧ ¬Collinear C O A ∧ ¬Collinear M O' D [Distinct] by fol H1 NonCollinearImpliesDistinct CollinearSymmetry; seg O A ≡ seg O C ∨ seg O A <__ seg O C ∨ seg O C <__ seg O A [3pos] by fol - SEGMENT SegmentTrichotomy; assume seg O C <__ seg O A [H4] by fol 3pos H1 H2 H3 EuclidPropositionI_24Help; ∡ M O' D <_ang ∡ C O A [] by fol H3 AngleSymmetry; fol Distinct H3 AngleSymmetry H2 H4 EuclidPropositionI_24Help SegmentSymmetry; qed; `;; let EuclidPropositionI_25 = theorem `; ∀O A C O' D M. ¬Collinear A O C ∧ ¬Collinear D O' M ⇒ seg O' D ≡ seg O A ∧ seg O' M ≡ seg O C ⇒ seg D M <__ seg A C ⇒ ∡ D O' M <_ang ∡ A O C proof intro_TAC ∀O A C O' D M, H1, H2, H3; ¬(O = A) ∧ ¬(O = C) ∧ ¬(A = C) ∧ ¬(D = M) ∧ ¬(O' = D) ∧ ¬(O' = M) [Distinct] by fol H1 NonCollinearImpliesDistinct; assume ¬(∡ D O' M <_ang ∡ A O C) [Contradiction] by fol; ∡ D O' M ≡ ∡ A O C ∨ ∡ A O C <_ang ∡ D O' M [] by fol H1 ANGLE - AngleTrichotomy; case_split Cong | Con by fol -; suppose ∡ D O' M ≡ ∡ A O C; D,O',M ≅ A,O,C [] by fol H1 H2 - SAS; seg D M ≡ seg A C [] by fol - TriangleCong_DEF; fol Distinct SEGMENT - H3 SegmentTrichotomy; end; suppose ∡ A O C <_ang ∡ D O' M; seg O A ≡ seg O' D ∧ seg O C ≡ seg O' M [H2'] by fol Distinct SEGMENT H2 C2Symmetric; seg A C <__ seg D M [] by fol H1 - Con EuclidPropositionI_24; fol Distinct SEGMENT - H3 SegmentTrichotomy; end; qed; `;; let AAS = theorem `; ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ⇒ seg A B ≡ seg A' B' ⇒ A,B,C ≅ A',B',C' proof intro_TAC ∀A B C A' B' C', H1, H2, H3; ¬(A = B) ∧ ¬(B = C) ∧ ¬(B' = C') [Distinct] by fol H1 NonCollinearImpliesDistinct; consider G such that G ∈ ray B C â” {B} ∧ seg B G ≡ seg B' C' [Gexists] by fol Distinct SEGMENT C1; ¬(G = B) ∧ B ∉ Open (G, C) ∧ Collinear G B C [notGBC] by fol - IN_Ray CollinearSymmetry IN_DIFF IN_SING; ¬Collinear A B G ∧ ¬Collinear B G A [ABGncol] by fol H1 notGBC CollinearSymmetry NoncollinearityExtendsToLine; ray B G = ray B C [] by fol Distinct Gexists RayWellDefined; ∡ A B G = ∡ A B C [] by fol Distinct - Angle_DEF; A,B,G ≅ A',B',C' [ABG≅A'B'C'] by fol H1 ABGncol H3 SegmentSymmetry H2 - Gexists SAS; ∡ B G A ≡ ∡ B' C' A' [BGAeqB'C'A'] by fol - TriangleCong_DEF; ¬Collinear B C A ∧ ¬Collinear B' C' A' [BCAncol] by fol H1 CollinearSymmetry; ∡ B' C' A' ≡ ∡ B C A ∧ ∡ B C A ≡ ∡ B C A [BCArefl] by fol - ANGLE H2 C5Symmetric C5Reflexive; ∡ B G A ≡ ∡ B C A [BGAeqBCA] by fol ABGncol BCAncol ANGLE BGAeqB'C'A' - C5Transitive; assume ¬(G = C) [notGC] by fol BGAeqBCA ABG≅A'B'C'; ¬Collinear A C G ∧ ¬Collinear A G C [ACGncol] by fol H1 notGBC - CollinearSymmetry NoncollinearityExtendsToLine; C ∈ Open (B, G) ∨ G ∈ Open (C, B) [] by fol notGBC notGC Distinct B3' ∉; case_split BCG | CGB by fol -; suppose C ∈ Open (B, G) ; C ∈ Open (G, B) ∧ ray G C = ray G B [rGCrBG] by fol - B1' IntervalRay; ∡ A G C <_ang ∡ A C B [] by fol ACGncol - ExteriorAngle; ∡ B G A <_ang ∡ B C A [] by fol - rGCrBG Angle_DEF AngleSymmetry AngleSymmetry; fol ABGncol BCAncol ANGLE - AngleSymmetry BGAeqBCA AngleTrichotomy; end; suppose G ∈ Open (C, B); ray C G = ray C B ∧ ∡ A C G <_ang ∡ A G B [] by fol - IntervalRay ACGncol ExteriorAngle; ∡ A C B <_ang ∡ B G A [] by fol - Angle_DEF AngleSymmetry; ∡ B C A <_ang ∡ B C A [] by fol - BCAncol ANGLE BGAeqBCA AngleTrichotomy2 AngleSymmetry; fol - BCArefl AngleTrichotomy1; end; qed; `;; let ParallelSymmetry = theorem `; ∀l k. l ∥ k ⇒ k ∥ l by fol PARALLEL INTER_COMM`;; let AlternateInteriorAngles = theorem `; ∀A B C E l m t. Line l ∧ A ∈ l ∧ E ∈ l ⇒ Line m ∧ B ∈ m ∧ C ∈ m ⇒ Line t ∧ A ∈ t ∧ B ∈ t ⇒ ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ⇒ ¬(C,E same_side t) ⇒ ∡ E A B ≡ ∡ C B A ⇒ l ∥ m proof intro_TAC ∀A B C E l m t, l_line, m_line, t_line, Distinct, Cnsim_tE, AltIntAngCong; ¬Collinear E A B ∧ ¬Collinear C B A [EABncol] by fol t_line Distinct NonCollinearRaa CollinearSymmetry; B ∉ l ∧ A ∉ m [notAmBl] by fol l_line m_line Collinear_DEF - ∉; assume ¬(l ∥ m) [Con] by fol; ¬(l ∩ m = ∅) [] by fol - l_line m_line PARALLEL; consider G such that G ∈ l ∧ G ∈ m [Glm] by fol - MEMBER_NOT_EMPTY IN_INTER; ¬(G = A) ∧ ¬(G = B) ∧ Collinear B G C ∧ Collinear B C G ∧ Collinear A E G ∧ Collinear A G E [GnotAB] by fol - notAmBl ∉ m_line l_line Collinear_DEF; ¬Collinear A G B ∧ ¬Collinear B G A ∧ G ∉ t [AGBncol] by fol EABncol CollinearSymmetry - NoncollinearityExtendsToLine t_line Collinear_DEF ∉; ¬(E,C same_side t) [Ensim_tC] by fol t_line - Distinct Cnsim_tE SameSideSymmetric; E ∈ l â” {A} ∧ G ∈ l â” {A} [] by fol l_line Glm Distinct GnotAB IN_DIFF IN_SING; ¬(G,E same_side t) [] proof assume G,E same_side t [Gsim_tE] by fol; A ∉ Open (G, E) [notGAE] by fol t_line - SameSide_DEF ∉; G ∈ ray A E â” {A} [] by fol Distinct GnotAB notGAE IN_Ray GnotAB IN_DIFF IN_SING; ray A G = ray A E [rAGrAE] by fol Distinct - RayWellDefined; ¬(C,G same_side t) [Cnsim_tG] by fol t_line AGBncol Distinct Gsim_tE Cnsim_tE SameSideTransitive; C ∉ ray B G [notCrBG] by fol - IN_Ray Distinct t_line AGBncol RaySameSide Cnsim_tG IN_DIFF IN_SING ∉; B ∈ Open (C, G) [] by fol - GnotAB ∉ IN_Ray; ∡ G A B <_ang ∡ C B A [] by fol AGBncol notCrBG - B1' EuclidPropositionI_16; ∡ E A B <_ang ∡ C B A [] by fol - rAGrAE Angle_DEF; fol EABncol ANGLE AltIntAngCong - AngleTrichotomy1; qed; G,C same_side t [Gsim_tC] by fol t_line AGBncol Distinct - Cnsim_tE AtMost2Sides; B ∉ Open (G, C) [notGBC] by fol t_line - SameSide_DEF ∉; G ∈ ray B C â” {B} [] by fol Distinct GnotAB notGBC IN_Ray GnotAB IN_DIFF IN_SING; ray B G = ray B C [rBGrBC] by fol Distinct - RayWellDefined; ∡ C B A ≡ ∡ E A B [flipAltIntAngCong] by fol EABncol ANGLE AltIntAngCong C5Symmetric; ¬(E,G same_side t) [Ensim_tG] by fol t_line AGBncol Distinct Gsim_tC Ensim_tC SameSideTransitive; E ∉ ray A G [notErAG] by fol - IN_Ray Distinct t_line AGBncol RaySameSide Ensim_tG IN_DIFF IN_SING ∉; A ∈ Open (E, G) [] by fol - GnotAB ∉ IN_Ray; ∡ G B A <_ang ∡ E A B [] by fol AGBncol notErAG - B1' EuclidPropositionI_16; ∡ C B A <_ang ∡ E A B [] by fol - rBGrBC Angle_DEF; fol EABncol ANGLE flipAltIntAngCong - AngleTrichotomy1; qed; `;; let EuclidPropositionI_28 = theorem `; ∀A B C D E F G H l m t. Line l ∧ A ∈ l ∧ B ∈ l ∧ G ∈ l ⇒ Line m ∧ C ∈ m ∧ D ∈ m ∧ H ∈ m ⇒ Line t ∧ G ∈ t ∧ H ∈ t ⇒ G ∉ m ∧ H ∉ l ⇒ G ∈ Open (A, B) ∧ H ∈ Open (C, D) ⇒ G ∈ Open (E, H) ∧ H ∈ Open (F, G) ⇒ ¬(D,A same_side t) ⇒ ∡ E G B ≡ ∡ G H D ∨ ∡ B G H suppl ∡ G H D ⇒ l ∥ m proof intro_TAC ∀A B C D E F G H l m t, l_line, m_line, t_line, notGmHl, H1, H2, H3, H4; ¬(A = G) ∧ ¬(G = B) ∧ ¬(H = D) ∧ ¬(E = G) ∧ ¬(G = H) ∧ Collinear A G B ∧ Collinear E G H [Distinct] by fol H1 H2 B1'; ¬Collinear H G A ∧ ¬Collinear G H D ∧ A ∉ t ∧ D ∉ t [HGAncol] by fol Distinct l_line m_line notGmHl NonCollinearRaa CollinearSymmetry Collinear_DEF t_line ∉; ¬Collinear B G H ∧ ¬Collinear A G E ∧ ¬Collinear E G B [BGHncol] by fol - Distinct CollinearSymmetry NoncollinearityExtendsToLine; ∡ A G H ≡ ∡ D H G [] proof case_split EGBeqGHD | BGHeqGHD by fol H4; suppose ∡ E G B ≡ ∡ G H D; ∡ E G B ≡ ∡ H G A ∧ Angle (∡ E G B) ∧ Angle (∡ H G A) ∧ Angle (∡ G H D) [boo] by fol BGHncol H1 H2 VerticalAnglesCong HGAncol ANGLE; ∡ H G A ≡ ∡ E G B [] by fol - C5Symmetric; ∡ H G A ≡ ∡ G H D [] by fol boo - EGBeqGHD C5Transitive; fol - AngleSymmetry; end; suppose ∡ B G H suppl ∡ G H D; ∡ B G H suppl ∡ H G A [] by fol BGHncol H1 B1' SupplementaryAngles_DEF; fol - BGHeqGHD AngleSymmetry SupplementUnique AngleSymmetry; end; qed; fol l_line m_line t_line Distinct HGAncol H3 - AlternateInteriorAngles; qed; `;; let OppositeSidesCongImpliesParallelogram = theorem `; ∀A B C D. Quadrilateral A B C D ⇒ seg A B ≡ seg C D ∧ seg B C ≡ seg D A ⇒ Parallelogram A B C D proof intro_TAC ∀A B C D, H1, H2; ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; consider a c such that Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by fol TetraABCD I1; consider b d such that Line b ∧ B ∈ b ∧ C ∈ b ∧ Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by fol TetraABCD I1; consider l such that Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol TetraABCD I1; consider m such that Line m ∧ B ∈ m ∧ D ∈ m [m_line] by fol TetraABCD I1; B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m [notBDlACm] by fol l_line m_line TetraABCD Collinear_DEF ∉; seg A C ≡ seg C A ∧ seg B D ≡ seg D B [seg_refl] by fol TetraABCD SEGMENT C2Reflexive SegmentSymmetry; A,B,C ≅ C,D,A [] by fol TetraABCD H2 - SSS; ∡ B C A ≡ ∡ D A C ∧ ∡ C A B ≡ ∡ A C D [BCAeqDAC] by fol - TriangleCong_DEF; seg C D ≡ seg A B [CDeqAB] by fol TetraABCD SEGMENT H2 C2Symmetric; B,C,D ≅ D,A,B [] by fol TetraABCD H2 - seg_refl SSS; ∡ C D B ≡ ∡ A B D ∧ ∡ D B C ≡ ∡ B D A ∧ ∡ C B D ≡ ∡ A D B [CDBeqABD] by fol - TriangleCong_DEF AngleSymmetry; ¬(B,D same_side l) ∨ ¬(A,C same_side m) [] by fol H1 l_line m_line FiveChoicesQuadrilateral; case_split Case1 | Ansim_mC by fol -; suppose ¬(B,D same_side l); ¬(D,B same_side l) [] by fol l_line notBDlACm - SameSideSymmetric; a ∥ c ∧ b ∥ d [] by fol ac_line l_line TetraABCD notBDlACm - BCAeqDAC AngleSymmetry AlternateInteriorAngles bd_line BCAeqDAC; fol H1 ac_line bd_line - Parallelogram_DEF; end; suppose ¬(A,C same_side m); b ∥ d [b∥d] by fol bd_line m_line TetraABCD notBDlACm - CDBeqABD AlternateInteriorAngles; c ∥ a [] by fol ac_line m_line TetraABCD notBDlACm Ansim_mC CDBeqABD AlternateInteriorAngles; fol H1 ac_line bd_line b∥d - ParallelSymmetry Parallelogram_DEF; end; qed; `;; let OppositeAnglesCongImpliesParallelogramHelp = theorem `; ∀A B C D a c. Quadrilateral A B C D ⇒ ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ⇒ Line a ∧ A ∈ a ∧ B ∈ a ⇒ Line c ∧ C ∈ c ∧ D ∈ c ⇒ a ∥ c proof intro_TAC ∀A B C D a c, H1, H2, a_line, c_line; ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; ∡ C D A ≡ ∡ A B C ∧ ∡ B C D ≡ ∡ D A B [H2'] by fol TetraABCD ANGLE H2 C5Symmetric; consider l m such that Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by fol TetraABCD I1; consider b d such that Line b ∧ B ∈ b ∧ C ∈ b ∧ Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by fol TetraABCD I1; A ∉ c ∧ B ∉ c ∧ A ∉ b ∧ D ∉ b ∧ B ∉ d ∧ C ∉ d [point_off_line] by fol c_line bd_line Collinear_DEF TetraABCD ∉; ¬(A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) [] proof assume A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C [Con] by fol; ∡ B C D <_ang ∡ D A B ∨ ∡ C D A <_ang ∡ A B C ∨ ∡ D A B <_ang ∡ B C D ∨ ∡ A B C <_ang ∡ C D A [] by fol TetraABCD - EuclidPropositionI_21; fol - H2' H2 AngleTrichotomy1; qed; ConvexQuadrilateral A B C D [] by fol H1 lm_line - FiveChoicesQuadrilateral; A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C [AintBCD] by fol - ConvexQuad_DEF; B,A same_side c ∧ B,C same_side d [Bsim_cA] by fol c_line bd_line - InteriorUse; A,D same_side b [Asim_bD] by fol bd_line c_line AintBCD InteriorUse; assume ¬(a ∥ c) [Con] by fol; consider G such that G ∈ a ∧ G ∈ c [Gac] by fol - a_line c_line PARALLEL MEMBER_NOT_EMPTY IN_INTER; Collinear A B G ∧ Collinear D G C ∧ Collinear C G D [ABGcol] by fol a_line - Collinear_DEF c_line; ¬(G = A) ∧ ¬(G = B) ∧ ¬(G = C) ∧ ¬(G = D) [GnotABCD] by fol Gac ABGcol TetraABCD CollinearSymmetry Collinear_DEF; ¬Collinear B G C ∧ ¬Collinear A D G [BGCncol] by fol c_line Gac GnotABCD point_off_line NonCollinearRaa CollinearSymmetry; ¬Collinear B C G ∧ ¬Collinear G B C ∧ ¬Collinear G A D ∧ ¬Collinear A G D [BCGncol] by fol - CollinearSymmetry; G ∉ b ∧ G ∉ d [notGb] by fol bd_line Collinear_DEF BGCncol ∉; G ∉ Open (B, A) [notBGA] by fol Bsim_cA Gac SameSide_DEF ∉; B ∉ Open (A, G) [notABG] proof assume ¬(B ∉ Open (A, G)) [Con] by fol; B ∈ Open (A, G) [ABG] by fol - ∉; ray A B = ray A G [rABrAG] by fol - IntervalRay; ¬(A,G same_side b) [] by fol bd_line ABG SameSide_DEF; ¬(D,G same_side b) [] by fol bd_line point_off_line notGb Asim_bD - SameSideTransitive; D ∉ ray C G [] by fol bd_line notGb - RaySameSide TetraABCD IN_DIFF IN_SING ∉; C ∈ Open (D, G) [DCG] by fol GnotABCD ABGcol - IN_Ray ∉; consider M such that D ∈ Open (C, M) [CDM] by fol TetraABCD B2'; D ∈ Open (G, M) [GDM] by fol - B1' DCG TransitivityBetweennessHelp; ∡ C D A suppl ∡ A D M ∧ ∡ A B C suppl ∡ C B G [] by fol TetraABCD CDM ABG SupplementaryAngles_DEF; ∡ M D A ≡ ∡ G B C [MDAeqGBC] by fol - H2' SupplementsCongAnglesCong AngleSymmetry; ∡ G A D <_ang ∡ M D A ∧ ∡ G B C <_ang ∡ D C B [] by fol BCGncol BGCncol GDM DCG B1' EuclidPropositionI_16; ∡ G A D <_ang ∡ D C B [] by fol - BCGncol ANGLE MDAeqGBC AngleTrichotomy2 AngleOrderTransitivity; ∡ D A B <_ang ∡ B C D [] by fol - rABrAG Angle_DEF AngleSymmetry; fol - H2 AngleTrichotomy1; qed; A ∉ Open (G, B) [] proof assume ¬(A ∉ Open (G, B)) [Con] by fol; A ∈ Open (B, G) [BAG] by fol - B1' ∉; ray B A = ray B G [rBArBG] by fol - IntervalRay; ¬(B,G same_side d) [] by fol bd_line BAG SameSide_DEF; ¬(C,G same_side d) [] by fol bd_line point_off_line notGb Bsim_cA - SameSideTransitive; C ∉ ray D G [] by fol bd_line notGb - RaySameSide TetraABCD IN_DIFF IN_SING ∉; D ∈ Open (C, G) [CDG] by fol GnotABCD ABGcol - IN_Ray ∉; consider M such that C ∈ Open (D, M) [DCM] by fol B2' TetraABCD; C ∈ Open (G, M) [GCM] by fol - B1' CDG TransitivityBetweennessHelp; ∡ B C D suppl ∡ M C B ∧ ∡ D A B suppl ∡ G A D [] by fol TetraABCD CollinearSymmetry DCM BAG SupplementaryAngles_DEF AngleSymmetry; ∡ M C B ≡ ∡ G A D [GADeqMCB] by fol - H2' SupplementsCongAnglesCong; ∡ G B C <_ang ∡ M C B ∧ ∡ G A D <_ang ∡ C D A [] by fol BGCncol GCM BCGncol CDG B1' EuclidPropositionI_16; ∡ G B C <_ang ∡ C D A [] by fol - BCGncol ANGLE GADeqMCB AngleTrichotomy2 AngleOrderTransitivity; ∡ A B C <_ang ∡ C D A [] by fol - rBArBG Angle_DEF; fol - H2 AngleTrichotomy1; qed; fol TetraABCD GnotABCD ABGcol notABG notBGA - B3' ∉; qed; `;; let OppositeAnglesCongImpliesParallelogram = theorem `; ∀A B C D. Quadrilateral A B C D ⇒ ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ⇒ Parallelogram A B C D proof intro_TAC ∀A B C D, H1, H2; Quadrilateral B C D A [QuadBCDA] by fol H1 QuadrilateralSymmetry; ¬(A = B) ∧ ¬(B = C) ∧ ¬(C = D) ∧ ¬(D = A) ∧ ¬Collinear B C D ∧ ¬Collinear D A B [TetraABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; ∡ B C D ≡ ∡ D A B [H2'] by fol TetraABCD ANGLE H2 C5Symmetric; consider a such that Line a ∧ A ∈ a ∧ B ∈ a [a_line] by fol TetraABCD I1; consider b such that Line b ∧ B ∈ b ∧ C ∈ b [b_line] by fol TetraABCD I1; consider c such that Line c ∧ C ∈ c ∧ D ∈ c [c_line] by fol TetraABCD I1; consider d such that Line d ∧ D ∈ d ∧ A ∈ d [d_line] by fol TetraABCD I1; fol H1 QuadBCDA H2 H2' a_line b_line c_line d_line OppositeAnglesCongImpliesParallelogramHelp Parallelogram_DEF; qed; `;; let P = NewAxiom `;∀P l. Line l ∧ P ∉ l ⇒ ∃! m. Line m ∧ P ∈ m ∧ m ∥ l`;; NewConstant("μ",`:(point->bool)->real`);; let AMa = NewAxiom `;∀α. Angle α ⇒ &0 < μ α ∧ μ α < &180`;; let AMb = NewAxiom `;∀α. Right α ⇒ μ α = &90`;; let AMc = NewAxiom `;∀α β. Angle α ∧ Angle β ∧ α ≡ β ⇒ μ α = μ β`;; let AMd = NewAxiom `;∀A O B P. P ∈ int_angle A O B ⇒ μ (∡ A O B) = μ (∡ A O P) + μ (∡ P O B)`;; let ConverseAlternateInteriorAngles = theorem `; ∀A B C E l m. Line l ∧ A ∈ l ∧ E ∈ l ⇒ Line m ∧ B ∈ m ∧ C ∈ m ⇒ Line t ∧ A ∈ t ∧ B ∈ t ⇒ ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ⇒ ¬(C,E same_side t) ⇒ l ∥ m ⇒ ∡ E A B ≡ ∡ C B A proof intro_TAC ∀A B C E l m, l_line, m_line, t_line, Distinct, Cnsim_tE, para_lm; ¬Collinear C B A [] by fol Distinct t_line NonCollinearRaa CollinearSymmetry; A ∉ m ∧ Angle (∡ C B A) [notAm] by fol m_line - Collinear_DEF ∉ ANGLE; consider D such that ¬(A = D) ∧ D ∉ t ∧ ¬(C,D same_side t) ∧ seg A D ≡ seg A E ∧ ∡ B A D ≡ ∡ C B A [Dexists] by simplify C4OppositeSide - Distinct t_line; consider k such that Line k ∧ A ∈ k ∧ D ∈ k [k_line] by fol Distinct I1; k ∥ m [] by fol - m_line t_line Dexists Distinct AngleSymmetry AlternateInteriorAngles; k = l [] by fol m_line notAm l_line k_line - para_lm P; D,E same_side t ∧ A ∉ Open (D, E) ∧ Collinear A E D [] by fol t_line Distinct Dexists Cnsim_tE AtMost2Sides SameSide_DEF ∉ - k_line l_line Collinear_DEF; ray A D = ray A E [] by fol Distinct - IN_Ray Dexists RayWellDefined IN_DIFF IN_SING; fol - Dexists AngleSymmetry Angle_DEF; qed; `;; let HilbertTriangleSum = theorem `; ∀A B C. ¬Collinear A B C ⇒ ∃E F. B ∈ Open (E, F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A proof intro_TAC ∀A B C, ABCncol; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear C A B [Distinct] by fol ABCncol NonCollinearImpliesDistinct CollinearSymmetry; consider l such that Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol Distinct I1; consider x such that Line x ∧ A ∈ x ∧ B ∈ x [x_line] by fol Distinct I1; consider y such that Line y ∧ B ∈ y ∧ C ∈ y [y_line] by fol Distinct I1; C ∉ x [notCx] by fol x_line ABCncol Collinear_DEF ∉; Angle (∡ C A B) [] by fol ABCncol CollinearSymmetry ANGLE; consider E such that ¬(B = E) ∧ E ∉ x ∧ ¬(C,E same_side x) ∧ seg B E ≡ seg A B ∧ ∡ A B E ≡ ∡ C A B [Eexists] by simplify C4OppositeSide - Distinct x_line notCx; consider m such that Line m ∧ B ∈ m ∧ E ∈ m [m_line] by fol - I1; ∡ E B A ≡ ∡ C A B [EBAeqCAB] by fol Eexists AngleSymmetry; m ∥ l [para_lm] by fol m_line l_line x_line Eexists Distinct notCx - AlternateInteriorAngles; m ∩ l = ∅ [ml0] by fol - PARALLEL; C ∉ m ∧ A ∉ m [notACm] by fol - l_line INTER_COMM DisjointOneNotOther; consider F such that B ∈ Open (E, F) [EBF] by fol Eexists B2'; ¬(B = F) ∧ F ∈ m [EBF'] by fol - B1' m_line BetweenLinear; ¬Collinear A B F ∧ F ∉ x [ABFncol] by fol EBF' m_line notACm NonCollinearRaa CollinearSymmetry Collinear_DEF x_line ∉; ¬(E,F same_side x) ∧ ¬(E,F same_side y) [Ensim_yF] by fol EBF x_line y_line SameSide_DEF; C,F same_side x [Csim_xF] by fol x_line notCx Eexists ABFncol Eexists - AtMost2Sides; C,A same_side m [] by fol m_line l_line ml0 DisjointLinesImplySameSide; C ∈ int_angle A B F [CintABF] by fol ABFncol x_line m_line EBF' notCx notACm Csim_xF - IN_InteriorAngle; A ∈ int_angle C B E [] by fol EBF B1' - InteriorAngleSymmetry InteriorReflectionInterior; A ∉ y ∧ A,E same_side y [Asim_yE] by fol y_line m_line - InteriorUse; E ∉ y ∧ F ∉ y [notEFy] by fol y_line m_line EBF' Eexists EBF' I1 Collinear_DEF notACm ∉; E,A same_side y [] by fol y_line - Asim_yE SameSideSymmetric; ¬(A,F same_side y) [Ansim_yF] by fol y_line notEFy Asim_yE - Ensim_yF SameSideTransitive; ∡ F B C ≡ ∡ A C B [] by fol m_line EBF' l_line y_line EBF' Distinct notEFy Asim_yE Ansim_yF para_lm ConverseAlternateInteriorAngles; fol EBF CintABF EBAeqCAB - AngleSymmetry; qed; `;; let EuclidPropositionI_13 = theorem `; ∀A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') ⇒ μ (∡ A O B) + μ (∡ B O A') = &180 proof intro_TAC ∀A O B A', H1 H2; case_split RightAOB | notRightAOB by fol -; suppose Right (∡ A O B); Right (∡ B O A') ∧ μ (∡ A O B) = &90 ∧ μ (∡ B O A') = &90 [] by fol H1 H2 - RightImpliesSupplRight AMb; real_arithmetic -; end; suppose ¬Right (∡ A O B); ¬(A = O) ∧ ¬(O = B) [Distinct] by fol H1 NonCollinearImpliesDistinct; consider l such that Line l ∧ O ∈ l ∧ A ∈ l ∧ A' ∈ l [l_line] by fol - I1 H2 BetweenLinear; B ∉ l [notBl] by fol - Distinct I1 Collinear_DEF H1 ∉; consider F such that Right (∡ O A F) ∧ Angle (∡ O A F) [RightOAF] by fol Distinct EuclidPropositionI_11 RightImpliesAngle; ∃! r. Ray r ∧ ∃E. ¬(O = E) ∧ r = ray O E ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F [] by simplify C4 - Distinct l_line notBl; consider E such that ¬(O = E) ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F [Eexists] by fol -; ¬Collinear A O E [AOEncol] by fol Distinct l_line - NonCollinearRaa CollinearSymmetry; Right (∡ A O E) [RightAOE] by fol - ANGLE RightOAF Eexists CongRightImpliesRight; Right (∡ E O A') ∧ μ (∡ A O E) = &90 ∧ μ (∡ E O A') = &90 [RightEOA'] by fol AOEncol H2 - RightImpliesSupplRight AMb; ¬(∡ A O B ≡ ∡ A O E) [] by fol notRightAOB H1 ANGLE RightAOE CongRightImpliesRight; ¬(∡ A O B = ∡ A O E) [] by fol H1 AOEncol ANGLE - C5Reflexive; ¬(ray O B = ray O E) [] by fol - Angle_DEF; B ∉ ray O E ∧ O ∉ Open (B, E) [] by fol Distinct - Eexists RayWellDefined IN_DIFF IN_SING ∉ l_line B1' SameSide_DEF; ¬Collinear O E B [] by fol - Eexists IN_Ray ∉; E ∈ int_angle A O B ∨ B ∈ int_angle A O E [] by fol Distinct l_line Eexists notBl AngleOrdering - CollinearSymmetry InteriorAngleSymmetry; case_split EintAOB | BintAOE by fol -; suppose E ∈ int_angle A O B; B ∈ int_angle E O A' [] by fol H2 - InteriorReflectionInterior; μ (∡ A O B) = μ (∡ A O E) + μ (∡ E O B) ∧ μ (∡ E O A') = μ (∡ E O B) + μ (∡ B O A') [] by fol EintAOB - AMd; real_arithmetic - RightEOA'; end; suppose B ∈ int_angle A O E; E ∈ int_angle B O A' [] by fol H2 - InteriorReflectionInterior; μ (∡ A O E) = μ (∡ A O B) + μ (∡ B O E) ∧ μ (∡ B O A') = μ (∡ B O E) + μ (∡ E O A') [] by fol BintAOE - AMd; real_arithmetic - RightEOA'; end; end; qed; `;; let TriangleSum = theorem `; ∀A B C. ¬Collinear A B C ⇒ μ (∡ A B C) + μ (∡ B C A) + μ (∡ C A B) = &180 proof intro_TAC ∀A B C, ABCncol; ¬Collinear C A B ∧ ¬Collinear B C A [CABncol] by fol ABCncol CollinearSymmetry; consider E F such that B ∈ Open (E, F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A [EBF] by fol ABCncol HilbertTriangleSum; ¬Collinear C B F ∧ ¬Collinear A B F ∧ Collinear E B F ∧ ¬(B = E) [CBFncol] by fol - InteriorAngleSymmetry InteriorEZHelp IN_InteriorAngle B1' CollinearSymmetry; ¬Collinear E B A [EBAncol] by fol CollinearSymmetry - NoncollinearityExtendsToLine; μ (∡ A B F) = μ (∡ A B C) + μ (∡ C B F) [μCintABF] by fol EBF AMd; μ (∡ E B A) + μ (∡ A B F) = &180 [suppl180] by fol EBAncol EBF EuclidPropositionI_13; μ (∡ C A B) = μ (∡ E B A) ∧ μ (∡ B C A) = μ (∡ C B F) [] by fol CABncol EBAncol CBFncol ANGLE EBF AMc; real_arithmetic suppl180 μCintABF -; qed; `;; let CircleConvex2_THM = theorem `; ∀O A B C. ¬Collinear A O B ⇒ B ∈ Open (A, C) ⇒ seg O A <__ seg O B ∨ seg O A ≡ seg O B ⇒ seg O B <__ seg O C proof intro_TAC ∀O A B C, H1, H2, H3; ¬Collinear O B A ∧ ¬Collinear B O A ∧ ¬Collinear O A B ∧ ¬(O = A) ∧ ¬(O = B) [H1'] by fol H1 CollinearSymmetry NonCollinearImpliesDistinct; B ∈ Open (C, A) ∧ ¬(C = A) ∧ ¬(C = B) ∧ Collinear A B C ∧ Collinear B A C [H2'] by fol H2 B1' CollinearSymmetry; ¬Collinear O B C ∧ ¬Collinear O C B [OBCncol] by fol H1' - NoncollinearityExtendsToLine CollinearSymmetry; ¬Collinear O A C [OABncol] by fol H1' H2' NoncollinearityExtendsToLine; ∡ O C B <_ang ∡ O B A [OCBlessOBA] by fol OBCncol H2' ExteriorAngle; ∡ O A B <_ang ∡ O B C [OABlessOBC] by fol H1' H2 ExteriorAngle; ∡ O B A <_ang ∡ B A O ∨ ∡ O B A ≡ ∡ B A O [] proof assume seg O A ≡ seg O B [Cong] by fol H3 H1' EuclidPropositionI_18; seg O B ≡ seg O A [] by fol H1' SEGMENT - C2Symmetric; fol H1' - IsoscelesCongBaseAngles AngleSymmetry; qed; ∡ O B A <_ang ∡ O A B ∨ ∡ O B A ≡ ∡ O A B [OBAlessOAB] by fol - AngleSymmetry; ∡ O C B <_ang ∡ O B C [] by fol OCBlessOBA - OABlessOBC OBCncol H1' OABncol OBCncol ANGLE - AngleOrderTransitivity AngleTrichotomy2; fol OBCncol - AngleSymmetry EuclidPropositionI_19; qed; `;; hol-light/RichterHilbertAxiomGeometry/README000066400000000000000000000036361303454263000212610ustar00rootroot00000000000000 HOL Light readable proof style with several applications (c) Copyright, Bill Richter 2013 Distributed under the same license as HOL Light readable.ml is a miz3-type interface for HOL Light tactics proofs allowing full use of REWRITE_TAC and other thm list -> tactics. All the HOL Light code below is written using readable.ml, except for from_topology.ml, which is a subset of John Harrison's code. HilbertAxiom_read.ml is a formalization of the plane geometry part of the Hilbert axiomatic geometry paper http://www.math.northwestern.edu/~richter/hilbert.pdf inverse_bug_puzzle_read.ml is a formalization partly due to John Harrison of a theorem due to Tom Hales explained at the end of sec 10.1 "The bug puzzle" of the HOL Light tutorial. UniversalPropCartProd.ml defines FunctionSpace and FunctionComposition so that Cartesian product satisfies the usual universal property. Topology.ml is an in-progress port of the point-set topology in Multivariate/topology.ml, changing the definition of a topological space and the use of subtopology theorems. from_topology.ml is a subset of Multivariate/topology.ml which run after Topology.ml is loaded, in spite of the above "low-level" changes, upholding the principle of data abstraction. TarskiAxiomGeometry_read.ml is a partial formalization of Schwabhäuser's theorem that Tarski's plane geometry axioms imply Hilbert's, basically done up through Gupta's theorem. Julien Narboux has completely formalized Schwabhäuser's theorem in Coq. Adam Grabowski Jesse Alama improved my original Mizar Tarski code and published it in MML. thmTopology is a list of the theorems of Topology.ml. thmHilbertAxiom is a list of the theorems of HilbertAxiom_read.ml. error-checking.ml shows the error messages displayed by readable.ml. miz3 contains the original miz3 version of HilbertAxiom_read.ml, an emacs file for handling math characters and some miz3 documentation. hol-light/RichterHilbertAxiomGeometry/TarskiAxiomGeometry_read.ml000077500000000000000000000573741303454263000257100ustar00rootroot00000000000000(* ========================================================================= *) (* HOL Light Tarski plane geometry axiomatic proofs up to Gupta's theorem. *) (* ========================================================================= *) (* *) (* This is a port of MML Mizar code published with Adam Grabowski and Jesse *) (* Alama, which was a readable version of Julien Narboux's Coq pseudo-code *) (* http://dpt-info.u-strasbg.fr/~narboux/tarski.html. We partially prove a *) (* theorem in Schwabhäuser's Ishi Press book Metamathematische Methoden in *) (* der Geometrie, that Tarski's plane geometry axioms imply Hilbert's. We *) (* get about as far Gupta's amazing proof which implies Hilbert's axiom I1 *) (* that two points determine a line. *) (* *) (* Thanks to Freek Wiedijk, who wrote the HOL Light Mizar interface miz3, in *) (* which this code was originally written, and John Harrison, who came up *) (* with the axiomatic framework here, and recommended writing it in miz3. *) needs "RichterHilbertAxiomGeometry/readable.ml";; new_type("TarskiPlane",0);; NewConstant("≃",`:TarskiPlane#TarskiPlane->TarskiPlane#TarskiPlane->bool`);; NewConstant("ℬ", `:TarskiPlane->TarskiPlane->TarskiPlane->bool`);; ParseAsInfix("≃",(12, "right"));; ParseAsInfix("≊",(12, "right"));; ParseAsInfix("on_line",(12, "right"));; ParseAsInfix("equal_line",(12, "right"));; let cong_DEF = NewDefinition `;a,b,c ≊ x,y,z ⇔ a,b ≃ x,y ∧ a,c ≃ x,z ∧ b,c ≃ y,z`;; let is_ordered_DEF = NewDefinition `;is_ordered (a,b,c,d) ⇔ ℬ a b c ∧ ℬ a b d ∧ ℬ a c d ∧ ℬ b c d`;; let Line_DEF = NewDefinition `; x on_line a,b ⇔ ¬(a = b) ∧ (ℬ a b x ∨ ℬ a x b ∨ ℬ x a b)`;; let LineEq_DEF = NewDefinition `; a,b equal_line x,y ⇔ ¬(a = b) ∧ ¬(x = y) ∧ ∀ c . c on_line a,b ⇔ c on_line x,y`;; (* ------------------------------------------------------------------------- *) (* The axioms. *) (* ------------------------------------------------------------------------- *) let A1 = NewAxiom `; ∀a b. a,b ≃ b,a`;; let A2 = NewAxiom `; ∀a b p q r s. a,b ≃ p,q ∧ a,b ≃ r,s ⇒ p,q ≃ r,s`;; let A3 = NewAxiom `; ∀a b c. a,b ≃ c,c ⇒ a = b`;; let A4 = NewAxiom `; ∀a q b c. ∃x. ℬ q a x ∧ a,x ≃ b,c`;; let A5 = NewAxiom `; ∀a b c x a' b' c' x'. ¬(a = b) ∧ a,b,c ≊ a',b',c' ∧ ℬ a b x ∧ ℬ a' b' x' ∧ b,x ≃ b',x' ⇒ c,x ≃ c',x'`;; let A6 = NewAxiom `; ∀a b. ℬ a b a ⇒ a = b`;; let A7 = NewAxiom `; ∀a b p q z. ℬ a p z ∧ ℬ b q z ⇒ ∃x. ℬ p x b ∧ ℬ q x a`;; (* A4 is the Segment Construction axiom, A5 is the SAS axiom and A7 is the Inner Pasch axiom. There are 4 more axioms we're not using yet: there exist 3 non-collinear points; 3 points equidistant from 2 distinct points are collinear; Euclid's ∥ postulate; a first order version of Hilbert's Dedekind Cuts axiom. We shall say we apply SAS to a+cbx and a'+c'b'x'. Normally one applies SAS by showing cb = c'b' bx = b'x' (which we assume) and ∡ cbx ≊ ∡ c'b'x'. One might prove the ∡ congruence by showing that the triangles abc ∧ a'b'c' were congruent by SSS (which we also assume) and then apply the theorem that complements of congruent angles are congruent. Hence Tarski's axiom. *) let EquivReflexive = theorem `; ∀a b. a,b ≃ a,b by fol A1 A2`;; let EquivSymmetric = theorem `; ∀a b c d. a,b ≃ c,d ⇒ c,d ≃ a,b by fol EquivReflexive A2`;; let EquivTransitive = theorem `; ∀a b p q r s. a,b ≃ p,q ∧ p,q ≃ r,s ⇒ a,b ≃ r,s by fol EquivSymmetric A2`;; let Baaa_THM = theorem `; ∀a b. ℬ a a a ∧ a,a ≃ b,b by fol A4 A3`;; let Bqaa_THM = theorem `; ∀a q. ℬ q a a by fol A4 A3`;; let C1_THM = theorem `; ∀a b x y. ¬(a = b) ∧ ℬ a b x ∧ ℬ a b y ∧ b,x ≃ b,y ⇒ y = x proof intro_TAC ∀a b x y, H1 H2 H3 H4; a,b,y ≊ a,b,y [] by fol EquivReflexive cong_DEF; y,x ≃ y,y [] by fol - H1 H2 H3 H4 A5; fol - A3; qed; `;; let Bsymmetry_THM = theorem `; ∀a p z. ℬ a p z ⇒ ℬ z p a proof intro_TAC ∀a p z, H1; ℬ p z z [] by fol Bqaa_THM; consider x such that ℬ p x p ∧ ℬ z x a [xExists] by fol - H1 A7; fol - A6; qed; `;; let Baaq_THM = theorem `; ∀a q. ℬ a a q by fol Bqaa_THM Bsymmetry_THM`;; let BEquality_THM = theorem `; ∀a b c. ℬ a b c ∧ ℬ b a c ⇒ a = b proof intro_TAC ∀a b c, H1 H2; consider x such that ℬ b x b ∧ ℬ a x a [A7implies] by fol H2 H1 A7; fol - A6; qed; `;; let B124and234then123_THM = theorem `; ∀a b c d. ℬ a b d ∧ ℬ b c d ⇒ ℬ a b c proof intro_TAC ∀a b c d, H1 H2; consider x such that ℬ b x b ∧ ℬ c x a [A7implies] by fol H1 H2 A7; fol - A6 Bsymmetry_THM; qed; `;; let BTransitivity_THM = theorem `; ∀a b c d. ¬(b = c) ∧ ℬ a b c ∧ ℬ b c d ⇒ ℬ a c d proof intro_TAC ∀a b c d, H1 H2 H3; consider x such that ℬ a c x ∧ c,x ≃ c,d [X1] by fol A4; ℬ x c b [] by fol H2 Bsymmetry_THM - B124and234then123_THM; x = d [] by fol - Bsymmetry_THM H1 H3 X1 C1_THM; fol - X1; qed; `;; let BTransitivityOrdered_THM = theorem `; ∀a b c d. ¬(b = c) ∧ ℬ a b c ∧ ℬ b c d ⇒ is_ordered (a,b,c,d) proof intro_TAC ∀a b c d, H1 H2 H3; ℬ a c d [X1] by fol H1 H2 H3 BTransitivity_THM; ℬ d b a [] by fol H2 Bsymmetry_THM H1 H3 BTransitivity_THM; fol H2 - Bsymmetry_THM X1 H3 is_ordered_DEF; qed; `;; let B124and234Ordered_THM = theorem `; ∀a b c d. ℬ a b d ∧ ℬ b c d ⇒ is_ordered (a,b,c,d) proof intro_TAC ∀a b c d, H1 H2; ℬ a b c [Babc] by fol H1 H2 B124and234then123_THM; assume ¬(b = c) [] by fol - Bqaa_THM H1 H2 is_ordered_DEF; fol Babc - H2 BTransitivityOrdered_THM; qed; `;; let SegmentAddition_THM = theorem `; ∀a b c a' b' c'. ℬ a b c ∧ ℬ a' b' c' ∧ a,b ≃ a',b' ∧ b,c ≃ b',c' ⇒ a,c ≃ a',c' proof intro_TAC ∀a b c a' b' c', H1 H2 H3 H4; assume ¬(a = b) [aNOTb] by fol H3 EquivSymmetric A3 H4; a,b,a ≊ a',b',a' [] by fol Baaa_THM H3 A1 EquivTransitive cong_DEF; fol - aNOTb H1 H2 H4 A5; qed; `;; let CongruenceDoubleSymmetry_THM = theorem `; ∀a b c d. a,b ≃ c,d ⇒ b,a ≃ d,c by fol A1 EquivTransitive`;; let C1prime_THM = theorem `; ∀a b x y. ¬(a = b) ∧ ℬ a b x ∧ ℬ a b y ∧ a,x ≃ a,y ⇒ x = y proof intro_TAC ∀a b x y, H1 H2 H3 H4; consider m such that ℬ b a m ∧ a,m ≃ a,b [X1] by fol A4; ℬ m a b [X2] by fol X1 Bsymmetry_THM; ¬(m = a) [X3] by fol X1 EquivSymmetric A3 H1; is_ordered (m,a,b,x) [] by fol H1 X2 H2 BTransitivityOrdered_THM; ℬ m a x [X4] by fol - is_ordered_DEF; is_ordered (m,a,b,y) [] by fol H1 X2 H3 BTransitivityOrdered_THM; ℬ m a y [] by fol - is_ordered_DEF; fol - X3 X4 H4 C1_THM; qed; `;; let SegmentSubtraction_THM = theorem `; ∀a b c a' b' c'. ℬ a b c ∧ ℬ a' b' c' ∧ a,b ≃ a',b' ∧ a,c ≃ a',c' ⇒ b,c ≃ b',c' proof intro_TAC ∀a b c a' b' c', H1 H2 H3 H4; assume ¬(a = b) [Z1] by fol - H3 EquivSymmetric A3 H4; consider x such that ℬ a b x ∧ b,x ≃ b',c' [Z2] by fol A4; a,x ≃ a',c' [] by fol - H2 H3 SegmentAddition_THM; a,x ≃ a,c [] by fol H4 EquivSymmetric - EquivTransitive; x = c [] by fol - Z1 Z2 H1 C1prime_THM; fol - Z2; qed; `;; let EasyAngleTransport_THM = theorem `; ∀a O b. ¬(O = a) ⇒ ∃x y. ℬ b O x ∧ ℬ a O y ∧ x,y,O ≊ a,b,O proof intro_TAC ∀a O b, H1; consider x y such that ℬ b O x ∧ O,x ≃ O,a ∧ ℬ a O y ∧ O,y ≃ O,b [X2] by fol A4; x,O ≃ a,O [X3] by fol - CongruenceDoubleSymmetry_THM; a,O,x ≊ x,O,a [X5] by fol - EquivSymmetric A1 X2 cong_DEF; x,y ≃ a,b [] by fol H1 X5 X2 Bsymmetry_THM A5; x,y,O ≊ a,b,O [] by fol - X3 X2 CongruenceDoubleSymmetry_THM cong_DEF; fol X2 -; qed; `;; let B123and134Ordered_THM = theorem `; ∀a b c d. ℬ a b c ∧ ℬ a c d ⇒ is_ordered (a,b,c,d) proof intro_TAC ∀a b c d, H1 H2; is_ordered (d,c,b,a) [] by fol H2 H1 Bsymmetry_THM B124and234Ordered_THM; ℬ d b a ∧ ℬ d c b [] by fol - is_ordered_DEF; fol - Bsymmetry_THM H1 H2 is_ordered_DEF; qed; `;; let BextendToLine_THM = theorem `; ∀a b c d. ¬(a = b) ∧ ℬ a b c ∧ ℬ a b d ⇒ ∃x. is_ordered (a,b,c,x) ∧ is_ordered (a,b,d,x) proof intro_TAC ∀a b c d, H1 H2 H3; consider u such that ℬ a c u ∧ c,u ≃ b,d [X1] by fol A4; is_ordered (a,b,c,u) [X2] by fol H2 X1 B123and134Ordered_THM; ℬ u c b [X3] by fol X2 is_ordered_DEF Bsymmetry_THM; u,c ≃ b,d [X4] by fol A1 X1 EquivTransitive; ℬ a b u [X5] by fol X2 is_ordered_DEF; consider x such that ℬ a d x ∧ d,x ≃ b,c [Y1] by fol A4; is_ordered (a,b,d,x) [Y2] by fol H3 Y1 B123and134Ordered_THM; c,b ≃ d,x [Y5] by fol A1 Y1 EquivSymmetric EquivTransitive; ℬ a b x [Y6] by fol Y2 is_ordered_DEF; u,b ≃ b,x [] by fol X3 Y2 is_ordered_DEF X4 Y5 SegmentAddition_THM; u = x [] by fol A1 - EquivTransitive H1 X5 Y6 C1_THM; fol - X2 Y2; qed; `;; let GuptaEasy_THM = theorem `; ∀a b c d. ¬(a = b) ∧ ℬ a b c ∧ ℬ a b d ∧ ¬(b = c) ∧ ¬(b = d) ⇒ ¬ℬ c b d proof intro_TAC ∀a b c d, H1 H2 H3 H4 H5; assume ℬ c b d [H6] by fol; consider x such that is_ordered (a,b,c,x) ∧ is_ordered (a,b,d,x) [X1] by fol H1 H2 H3 BextendToLine_THM; ℬ b d x [] by fol X1 is_ordered_DEF; is_ordered (c,b,d,x) [] by fol - H5 H6 BTransitivityOrdered_THM; ℬ b c x ∧ ℬ c b x [] by fol - X1 is_ordered_DEF; fol - BEquality_THM H4; qed; `;; (* The next result is like SAS: there are 5 pairs of segments 4 equivalent. *) (* We apply Inner5Segments to abc-x and a'b'c'-x'. *) let Inner5Segments_THM = theorem `; ∀a b c x a' b' c' x'. a,b,c ≊ a',b',c' ∧ ℬ a x c ∧ ℬ a' x' c' ∧ c,x ≃ c',x' ⇒ b,x ≃ b',x' proof intro_TAC ∀a b c x a' b' c' x', H1 H2 H3 H4; a,b ≃ a',b' ∧ a,c ≃ a',c' ∧ b,c ≃ b',c' [X1] by fol H1 cong_DEF; assume ¬(x = c) [Case2] by fol H4 EquivSymmetric - A3 X1; ¬(a = c) [X2] by fol H2 A6 -; consider y such that ℬ a c y ∧ c,y ≃ a,c [X3] by fol A4; consider y' such that ℬ a' c' y' ∧ c',y' ≃ a,c [X4] by fol A4; c,y ≃ c',y' [X5] by fol - X3 EquivSymmetric EquivTransitive; c,b ≃ c',b' [X6] by fol X1 CongruenceDoubleSymmetry_THM; a,c,b ≊ a',c',b' [] by fol cong_DEF X1 -; b,y ≃ b',y' [X7] by fol - X2 X3 X4 X5 A5; ¬(y = c) [X8] by fol X3 EquivSymmetric A3 X2; ℬ y c x [X9] by fol X3 H2 Bsymmetry_THM B124and234then123_THM; ℬ y' c' a' ∧ ℬ c' x' a' [] by fol - X4 H3 Bsymmetry_THM; ℬ y' c' x' [X10] by fol - B124and234then123_THM; y,c,b ≊ y',c',b' [] by fol X5 X7 CongruenceDoubleSymmetry_THM cong_DEF X6; fol - X8 X9 X10 H4 A5; qed; `;; let RhombusDiagBisect_THM = theorem `; ∀b c d c' d'. ℬ b c d' ∧ ℬ b d c' ∧ c,d' ≃ c,d ∧ d,c' ≃ c,d ∧ d',c' ≃ c,d ⇒ ∃e. ℬ c e c' ∧ ℬ d e d' ∧ c,e ≃ c',e ∧ d,e ≃ d',e proof intro_TAC ∀b c d c' d', H1 H2 H3 H4 H5; ℬ d' c b ∧ ℬ c' d b [X1] by fol H1 H2 Bsymmetry_THM; consider e such that ℬ c e c' ∧ ℬ d e d' [X2] by fol X1 A7; c,d ≃ c,d' [X3] by fol H3 EquivSymmetric; c,c' ≃ c,c' [X4] by fol EquivReflexive; c,d,c' ≊ c,d',c' [] by fol H5 EquivSymmetric H4 EquivTransitive X3 X4 cong_DEF; d,e ≃ d',e [X5] by fol - X2 EquivReflexive Inner5Segments_THM; d,c ≃ d,c' [X7] by fol H4 EquivSymmetric A1 EquivTransitive; d,d' ≃ d,d' [X8] by fol EquivReflexive; c,d' ≃ c',d' [] by fol A1 H5 EquivSymmetric H3 EquivTransitive; d,c,d' ≊ d,c',d' [] by fol EquivReflexive X7 X8 - cong_DEF; c,e ≃ c',e [] by fol - X2 EquivReflexive Inner5Segments_THM; fol - X2 X5; qed; `;; let FlatNormal_THM = theorem `; ∀a b c d d' e. ℬ d e d' ∧ c,d' ≃ c,d ∧ d,e ≃ d',e ∧ ¬(c = d) ∧ ¬(e = d) ⇒ ∃p r q. ℬ p r q ∧ ℬ r c d' ∧ ℬ e c p ∧ r,c,p ≊ r,c,q ∧ r,c ≃ e,c ∧ p,r ≃ d,e proof intro_TAC ∀a b c d d' e, H1 H2 H3 H4 H5; ¬(c = d') [] by fol H4 H2 EquivSymmetric A3; consider p r such that ℬ e c p ∧ ℬ d' c r ∧ p,r,c ≊ d',e,c [X1] by fol - EasyAngleTransport_THM; p,r ≃ d',e ∧ p,c ≃ d',c ∧ r,c ≃ e,c [X2] by fol - X1 cong_DEF; p,r ≃ d,e [X3] by fol H3 EquivSymmetric X2 EquivTransitive; ¬(p = r) [X4] by fol - EquivSymmetric H5 A3; consider q such that ℬ p r q ∧ r,q ≃ e,d [X5] by fol A4; c,p ≃ c,d [X7] by fol - X2 CongruenceDoubleSymmetry_THM H2 EquivTransitive; :: Apply SAS to p+crq /\ d'+ced c,q ≃ c,d [] by fol X4 X1 X5 H1 Bsymmetry_THM A5; r,c,p ≊ r,c,q [] by fol - EquivSymmetric X7 EquivTransitive X5 X3 CongruenceDoubleSymmetry_THM EquivReflexive cong_DEF; fol X1 Bsymmetry_THM X5 - X2 X1 X3; qed; `;; let EqDist2PointsBetween_THM = theorem `; ∀a b c p q. ¬(a = b) ∧ ℬ a b c ∧ a,p ≃ a,q ∧ b,p ≃ b,q ⇒ c,p ≃ c,q proof :: a & b are equidistant from p & q. Apply SAS to a+pbc /\ a+qbc. intro_TAC ∀a b c p q, H1 H2 H3 H4; a,b,p ≊ a,b,q [] by fol EquivReflexive H3 H4 cong_DEF; p,c ≃ q,c [] by fol H1 - H2 EquivReflexive A5; fol - CongruenceDoubleSymmetry_THM; qed; `;; let EqDist2PointsInnerBetween_THM = theorem `; ∀a x c p q. ℬ a x c ∧ a,p ≃ a,q ∧ c,p ≃ c,q ⇒ x,p ≃ x,q proof :: a and c are equidistant from p and q. Apply Inner5Segments to :: apb-x /\ aqb-x. intro_TAC ∀a x c p q, H1 H2 H3; a,p,c ≊ a,q,c [] by fol H2 H3 CongruenceDoubleSymmetry_THM EquivReflexive cong_DEF; p,x ≃ q,x [] by fol - H1 EquivReflexive Inner5Segments_THM; fol - CongruenceDoubleSymmetry_THM; qed; `;; let Gupta_THM = theorem `; ∀a b c d. ¬(a = b) ∧ ℬ a b c ∧ ℬ a b d ⇒ ℬ b d c ∨ ℬ b c d proof intro_TAC ∀a b c d, H1 H2 H3; assume ¬(b = c) ∧ ¬(b = d) ∧ ¬(c = d) [H4] by fol - Baaq_THM Bqaa_THM; assume ¬ℬ b d c [H5] by fol; consider d' such that ℬ a c d' ∧ c,d' ≃ c,d [X1] by fol A4; consider c' such that ℬ a d c' ∧ d,c' ≃ c,d [X2] by fol A4; is_ordered (a,b,c,d') [] by fol H2 X1 B123and134Ordered_THM; ℬ a b d' ∧ ℬ b c d' [X3] by fol - is_ordered_DEF; is_ordered (a,b,d,c') [] by fol H3 X2 B123and134Ordered_THM; ℬ a b c' ∧ ℬ b d c' [X4] by fol - is_ordered_DEF; ¬(c = d') [X5] by fol X1 H4 A3 EquivSymmetric; ¬(d = c') [X6] by fol X2 H4 A3 EquivSymmetric; ¬(b = d') [X7] by fol X3 H4 A6; ¬(b = c') [X8] by fol X4 H4 A6; :: In the proof below, we prove a stronger result than :: BextendToLine_THM with much the same proof. We find u ∧ b' :: with essentially a,b,c,d',u and a b,d,c',b' ordered 5-tuples :: with d'u ≃ db ∧ cb' ≃ bc. consider u such that ℬ c d' u ∧ d',u ≃ b,d [Y1] by fol A4; is_ordered (b,c,d',u) [] by fol X5 X3 Y1 BTransitivityOrdered_THM; ℬ b c u ∧ ℬ b d' u [Y2] by fol - is_ordered_DEF; consider b' such that ℬ d c' b' ∧ c',b' ≃ b,c [Y3] by fol A4; is_ordered (b,d,c',b') [] by fol X6 X4 Y3 BTransitivityOrdered_THM; ℬ b d b' ∧ ℬ b c' b' [Y4] by fol - is_ordered_DEF; c,d' ≃ c',d [Y7] by fol X2 EquivSymmetric X1 A1 EquivTransitive; c,u ≃ c',b [Y8] by fol Y1 A1 EquivTransitive X4 Bsymmetry_THM Y7 SegmentAddition_THM; b,c ≃ b',c' [Y10] by fol Y3 EquivSymmetric A1 EquivTransitive; b,u ≃ b,b' [Y11] by fol Y4 Bsymmetry_THM Y2 Y10 Y8 SegmentAddition_THM A1 EquivTransitive; is_ordered (a,b,d',u) [Y12] by fol X7 X3 Y2 BTransitivityOrdered_THM; is_ordered (a,b,c',b') [] by fol X8 X4 Y4 BTransitivityOrdered_THM; ℬ a b u ∧ ℬ a b b' [] by fol - Y12 is_ordered_DEF; u = b' [Y13] by fol - H1 Y11 C1_THM; :: Show c'd' ≃ cd by applying SAS to b+c'cd ∧ b'+cc'd. b,c,c' ≊ b',c',c [Z2] by fol A1 Y10 Y13 Y8 EquivSymmetric CongruenceDoubleSymmetry_THM cong_DEF; d',c' ≃ c,d [] by fol Y3 Bsymmetry_THM H4 Z2 X3 Y7 A5 A1 EquivTransitive; :: c,d',c',d is a "flat" rhombus. The diagonals bisect each other. consider e such that ℬ c e c' ∧ ℬ d e d' ∧ c,e ≃ c',e ∧ d,e ≃ d',e [Z4] by fol - X3 X4 X1 X2 RhombusDiagBisect_THM; ¬(e = c) [U1] proof assume e = c [U2] by fol; c' = c [] by fol U2 Z4 EquivSymmetric A3; ℬ b d c [U3] by fol - X4; fol - U3 H5; qed; e = d [V1] proof assume ¬(e = d) [V2] by fol; consider p r q such that ℬ p r q ∧ ℬ r c d' ∧ ℬ e c p ∧ r,c,p ≊ r,c,q ∧ r,c ≃ e,c ∧ p,r ≃ d,e [W1] proof MP_TAC ISPECL [a; b; c; d; d'; e] FlatNormal_THM; fol Z4 X1 H4 V2; qed; r,p ≃ r,q ∧ c,p ≃ c,q [W2] by fol W1 cong_DEF; :: r and c are equidistant from p and q, r <> c, ℬ r,c,d', thus also d' ¬(c = r) [] by fol W1 U1 EquivSymmetric A3; d',p ≃ d',q [W3] by fol - W1 W2 EqDist2PointsBetween_THM; :: c and d' are equidistant from p and q, c <> d', :: ℬ c,d',b', thus also b'. b',p ≃ b',q [W4] by fol Y1 Y13 X5 W2 W3 EqDist2PointsBetween_THM; :: d' and c are equidistant from p and q, d' <> c, ℬ d',c,b, thus also b. b,p ≃ b,q [] by fol X3 Bsymmetry_THM X5 W3 W2 EqDist2PointsBetween_THM; :: b and b' are equidistant from p and q, ℬ b,c',b, thus also c'. c',p ≃ c',q [W7] by fol Y4 W4 - EqDist2PointsInnerBetween_THM; :: c' and c are equidistant from p and q, c' <> c, ℬ c',c,p, thus also p. is_ordered (c',e,c,p) [] by fol Z4 Bsymmetry_THM U1 W1 BTransitivityOrdered_THM; ℬ c' c p [W8] by fol - is_ordered_DEF; ¬(c' = c) [] by fol Z4 U1 A6; p,p ≃ p,q [] by fol - W8 W7 W2 EqDist2PointsBetween_THM; :: Now we deduce a contradiction from p = q. fol - W1 A6 EquivSymmetric A3 V2; qed; fol V1 Z4 EquivSymmetric A3 X3; qed; `;; (* Using Gupta's theorem, we prove Hilbert's axiom I3; a line is determined *) (* by fol two points. *) let I1part1_THM = theorem `; ∀a b x. ¬(a = b) ∧ ¬(a = x) ∧ x on_line a,b ⇒ ∀c. c on_line a,b ⇒ c on_line a,x proof intro_TAC ∀a b x, H1 H2 H3, ∀c, H4; ℬ a b x ∨ ℬ a x b ∨ ℬ x a b [X1] by fol H3 Line_DEF; ℬ a b c ∨ ℬ a c b ∨ ℬ c a b [X2] by fol H4 Line_DEF; assume ¬(x = b) ∧ ¬(b = c) [Case2] by fol - H4 X1 Bsymmetry_THM H2 Line_DEF; ℬ a x c ∨ ℬ a c x ∨ ℬ x a c [] proof case_split Y1 | Y2 | Y3 by fol X1; suppose ℬ a b x; case_split Y11 | Bacb | Bcab by fol X2; suppose ℬ a b c; ℬ b x c ∨ ℬ b c x [] by fol - Y1 H1 Gupta_THM; is_ordered (a,b,x,c) ∨ is_ordered (a,b,c,x) [] by fol Case2 Y1 Y11 - BTransitivityOrdered_THM; fol - is_ordered_DEF; end; suppose ℬ a c b; is_ordered (a,c,b,x) [] by fol - Y1 B123and134Ordered_THM; fol - is_ordered_DEF; end; suppose ℬ c a b; is_ordered (c,a,b,x) [] by fol H1 - Y1 BTransitivityOrdered_THM; fol - is_ordered_DEF Bsymmetry_THM; end; end; suppose ℬ a x b; case_split Babc | Y22 | Bcab by fol X2; suppose ℬ a b c; is_ordered (a,x,b,c) [] by fol - Y2 B123and134Ordered_THM; fol - is_ordered_DEF; end; suppose ℬ a c b; consider m such that ℬ b a m ∧ a,m ≃ a,b [X5] by fol - A4; ¬(a = m) [X6] by fol H1 X5 EquivSymmetric A3; ℬ m a b [] by fol X5 Bsymmetry_THM; :: m,a,c,b & m,a,x,b ℬ m a c ∧ ℬ m a x [] by fol - Y22 Y2 B124and234then123_THM; fol - X6 Gupta_THM; end; suppose ℬ c a b; ℬ c a x [] by fol - Y2 B124and234then123_THM; :: c,a,x,b fol - Bsymmetry_THM; end; end; suppose ℬ x a b; case_split Babc | Bacb | Bcab by fol X2; suppose ℬ a b c; is_ordered (x,a,b,c) [] by fol H1 - Y3 BTransitivityOrdered_THM; fol - is_ordered_DEF; end; suppose ℬ a c b; fol Y3 - B124and234then123_THM; end; :: x,a,c,b suppose ℬ c a b; ℬ b a x ∧ ℬ b a c [] by fol Y3 - Bsymmetry_THM; fol - H1 Gupta_THM; end; end; qed; fol - Bsymmetry_THM H2 Line_DEF; qed; `;; let I1part2_THM = theorem `; ∀a b x. ¬(a = b) ∧ ¬(a = x) ∧ x on_line a,b ⇒ a,b equal_line a,x proof intro_TAC ∀a b x, H1 H2 H3; ∀c. c on_line a,b ⇔ c on_line a,x [] proof intro_TAC ∀c; eq_tac [Left] by fol H1 H2 H3 I1part1_THM; b on_line a,x [] by fol H3 Line_DEF Bsymmetry_THM H2 Line_DEF; fol - H1 H2 I1part1_THM; qed; fol H1 H2 - LineEq_DEF; qed; `;; let LineEqRefl_THM = theorem `; ∀a b. ¬(a = b) ⇒ a,b equal_line a,b by fol LineEq_DEF`;; let LineEqA1_THM = theorem `; ∀a b. ¬(a = b) ⇒ a,b equal_line b,a proof intro_TAC ∀a b, H1; ∀c. c on_line a,b ⇔ c on_line b,a [] by fol Line_DEF Bsymmetry_THM H1; fol H1 - LineEq_DEF; qed; `;; let LineEqSymmetric_THM = theorem `; ∀a b c d. ¬(a = b) ∧ ¬(c = d) ⇒ a,b equal_line c,d ⇒ c,d equal_line a,b by fol LineEq_DEF`;; let LineEqTrans_THM = theorem `; ∀a b c d e f. ¬(a = b) ∧ ¬(c = d) ∧ ¬(e = f) ⇒ a,b equal_line c,d ⇒ c,d equal_line e,f ⇒ a,b equal_line e,f proof intro_TAC ∀a b c d e f, H1, H2, H3; ∀y. y on_line a,b ⇔ y on_line e,f [] by fol H2 H3 LineEq_DEF; fol - H1 LineEq_DEF; qed; `;; let onlineEq_THM = theorem `; ∀a b c d x. x on_line a,b ⇒ a,b equal_line c,d ⇒ x on_line c,d by fol LineEq_DEF`;; let I1part2Reverse_THM = theorem `; ∀a b y. ¬(a = b) ∧ ¬(b = y) ⇒ y on_line a,b ⇒ a,b equal_line y,b proof intro_TAC ∀a b y, H1, H3; a,b equal_line b,a ∧ b,y equal_line y,b [Y1] by fol H1 LineEqA1_THM; y on_line b,a [] by fol H3 Y1 onlineEq_THM; a,b equal_line b,y [] by fol - H1 Y1 I1part2_THM LineEqTrans_THM; fol - H1 Y1 LineEqTrans_THM; qed; `;; let I1_THM = theorem `; ∀a b x y. ¬(a = b) ∧ ¬(x = y) ∧ a on_line x,y ∧ b on_line x,y ⇒ x,y equal_line a,b proof intro_TAC ∀a b x y, H1 H2 H3 H4; case_split H5 | H6 by fol; suppose (x = b); b,a equal_line a,b ∧ x,y equal_line b,y [] by fol H1 LineEqA1_THM H2 H5 LineEqRefl_THM; fol H3 H5 H2 I1part2_THM H1 H2 - LineEqTrans_THM; end; suppose ¬(x = b); x,y equal_line x,b [P4] by fol - H2 H6 H4 I1part2_THM; a on_line x,b [] by fol - H2 H6 H3 onlineEq_THM; x,b equal_line a,b [] by fol - H6 H1 I1part2Reverse_THM; fol H1 H2 H6 P4 - LineEqTrans_THM; end; qed; `;; hol-light/RichterHilbertAxiomGeometry/Topology.ml000066400000000000000000004057131303454263000225510ustar00rootroot00000000000000(* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* An ongoing readable.ml port of Multivariate/topology.ml with 3 features: *) (* 1) A topological space will be an ordered pair α = (X, L), where L is the *) (* the set of open sets on X. topology.ml defines a topological space to be *) (* just L, and the topspace X is defined as UNIONS L. *) (* 2) Result about Connectiveness, limit points, interior and closure are *) (* first proved for general topological spaces and then specialized to *) (* Euclidean space. *) (* 3)All general topology theorems using subtopology α u have antecedent *) (* u ⊂ topspace α. *) (* The math character â” is used for DIFF. *) (* This file, together with from_topology.ml, shows that all of *) (* Multivariate/topology.ml is either ported/modified here, or else run on *) (* top of this file. *) (* Thanks to Vince Aravantinos for improving the proofs of OPEN_BALL, *) (* CONNECTED_OPEN_IN_EQ, CONNECTED_CLOSED_IN_EQ and INTERIOR_EQ. *) needs "RichterHilbertAxiomGeometry/readable.ml";; needs "Multivariate/determinants.ml";; ParseAsInfix("∉",(11, "right"));; let NOTIN = NewDefinition `; ∀a l. a ∉ l ⇔ ¬(a ∈ l)`;; let DIFF_UNION = theorem `; ∀u s t. u â” (s ∪ t) = (u â” s) ∩ (u â” t) by set`;; let DIFF_INTER = theorem `; ∀u s t. u â” (s ∩ t) = (u â” s) ∪ (u â” t) by set`;; let DIFF_REFL = theorem `; ∀u t. t ⊂ u ⇒ u â” (u â” t) = t by set`;; let DIFF_SUBSET = theorem `; ∀u s t. s ⊂ t ⇒ s â” u ⊂ t â” u by set`;; let DOUBLE_DIFF_UNION = theorem `; ∀A s t. A â” s â” t = A â” (s ∪ t) by set`;; let SUBSET_COMPLEMENT = theorem `; ∀s t A. s ⊂ A ⇒ (s ⊂ A â” t ⇔ s ∩ t = ∅) by set`;; let COMPLEMENT_DISJOINT = theorem `; ∀A s t. s ⊂ A ⇒ (s ⊂ t ⇔ s ∩ (A â” t) = ∅) by set`;; let COMPLEMENT_DUALITY = theorem `; ∀A s t. s ⊂ A ∧ t ⊂ A ⇒ (s = t ⇔ A â” s = A â” t) by set`;; let COMPLEMENT_DUALITY_UNION = theorem `; ∀A s t. s ⊂ A ∧ t ⊂ A ∧ u ⊂ A ⇒ (s = t ∪ u ⇔ A â” s = (A â” t) ∩ (A â” u)) by set`;; let SUBSET_DUALITY = theorem `; ∀s t u. t ⊂ u ⇒ s â” u ⊂ s â” t by set`;; let COMPLEMENT_INTER_DIFF = theorem `; ∀A s t. s ⊂ A ⇒ s â” t = s ∩ (A â” t) by set`;; let INTERS_SUBSET = theorem `; ∀f t. ¬(f = ∅) ∧ (∀s. s ∈ f ⇒ s ⊂ t) ⇒ INTERS f ⊂ t by set`;; let IN_SET_FUNCTION_PREDICATE = theorem `; ∀x f P. x ∈ {f y | P y} ⇔ ∃y. x = f y ∧ P y by set`;; let INTER_TENSOR = theorem `; ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∩ t ⊂ s' ∩ t' by set`;; let UNION_TENSOR = theorem `; ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∪ t ⊂ s' ∪ t' by set`;; let ExistsTensorInter = theorem `; ∀F G H. (∀x y. F x ∧ G y ⇒ H (x ∩ y)) ⇒ (∃x. F x) ∧ (∃y. G y) ⇒ (∃z. H z) by fol`;; let istopology = NewDefinition `; istopology (X, L) ⇔ (∀U. U ∈ L ⇒ U ⊂ X) ∧ ∅ ∈ L ∧ X ∈ L ∧ (∀s t. s ∈ L ∧ t ∈ L ⇒ s ∩ t ∈ L) ∧ ∀k. k ⊂ L ⇒ UNIONS k ∈ L`;; let UnderlyingSpace = NewDefinition `; UnderlyingSpace α = FST α`;; let OpenSets = NewDefinition `; OpenSets α = SND α`;; let ExistsTopology = theorem `; ∀X. ∃α. istopology α ∧ UnderlyingSpace α = X proof intro_TAC ∀X; consider L such that L = {U | U ⊂ X} [Lexists] by fol; exists_TAC (X, L); rewrite istopology IN_ELIM_THM Lexists UnderlyingSpace; set; qed; `;; let topology_tybij_th = theorem `; ∃t. istopology t by fol ExistsTopology`;; let topology_tybij = new_type_definition "topology" ("mk_topology","dest_topology") topology_tybij_th;; let ISTOPOLOGYdest_topology = theorem `; ∀α. istopology (dest_topology α) by fol topology_tybij`;; let OpenIn = NewDefinition `; ∀α. open_in α = OpenSets (dest_topology α)`;; let topspace = NewDefinition `; ∀α. topspace α = UnderlyingSpace (dest_topology α)`;; let TopologyPAIR = theorem `; ∀α. dest_topology α = (topspace α, open_in α) by rewrite PAIR_EQ OpenIn topspace UnderlyingSpace OpenSets`;; let Topology_Eq = theorem `; ∀α β. topspace α = topspace β ∧ (∀U. open_in α U ⇔ open_in β U) ⇔ α = β proof intro_TAC ∀α β; eq_tac [Right] by fol; intro_TAC H1 H2; dest_topology α = dest_topology β [] by simplify TopologyPAIR PAIR_EQ H1 H2 FUN_EQ_THM; fol - topology_tybij; qed; `;; let OpenInCLAUSES = theorem `; ∀α X. topspace α = X ⇒ (∀U. open_in α U ⇒ U ⊂ X) ∧ open_in α ∅ ∧ open_in α X ∧ (∀s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∩ t)) ∧ ∀k. (∀s. s ∈ k ⇒ open_in α s) ⇒ open_in α (UNIONS k) proof intro_TAC ∀α X, H1; consider L such that L = open_in α [Ldef] by fol; istopology (X, L) [] by fol H1 Ldef TopologyPAIR PAIR_EQ ISTOPOLOGYdest_topology; fol Ldef - istopology IN SUBSET; qed; `;; let OPEN_IN_SUBSET = theorem `; ∀α s. open_in α s ⇒ s ⊂ topspace α by fol OpenInCLAUSES`;; let OPEN_IN_EMPTY = theorem `; ∀α. open_in α ∅ by fol OpenInCLAUSES`;; let OPEN_IN_INTER = theorem `; ∀α s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∩ t) by fol OpenInCLAUSES`;; let OPEN_IN_UNIONS = theorem `; ∀α k. (∀s. s ∈ k ⇒ open_in α s) ⇒ open_in α (UNIONS k) by fol OpenInCLAUSES`;; let OpenInTopspace = theorem `; ∀α. open_in α (topspace α) by fol OpenInCLAUSES`;; let OPEN_IN_UNION = theorem `; ∀α s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∪ t) proof intro_TAC ∀α s t, H; ∀x. x ∈ {s, t} ⇔ x = s ∨ x = t [] by fol IN_INSERT NOT_IN_EMPTY; fol - UNIONS_2 H OPEN_IN_UNIONS; qed; `;; let OPEN_IN_TOPSPACE = theorem `; ∀α. open_in α (topspace α) by fol OpenInCLAUSES`;; let OPEN_IN_INTERS = theorem `; ∀α s. FINITE s ∧ ¬(s = ∅) ∧ (∀t. t ∈ s ⇒ open_in α t) ⇒ open_in α (INTERS s) proof intro_TAC ∀α; rewrite IMP_CONJ; MATCH_MP_TAC FINITE_INDUCT; rewrite INTERS_INSERT NOT_INSERT_EMPTY FORALL_IN_INSERT; intro_TAC ∀x s, H1, xWorks sWorks; assume ¬(s = ∅) [Nonempty] by simplify INTERS_0 INTER_UNIV xWorks; fol xWorks Nonempty H1 sWorks OPEN_IN_INTER; qed; `;; let OPEN_IN_SUBOPEN = theorem `; ∀α s. open_in α s ⇔ ∀x. x ∈ s ⇒ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s proof intro_TAC ∀α s; eq_tac [Left] by set; intro_TAC ALLtExist; consider f such that ∀x. x ∈ s ⇒ open_in α (f x) ∧ x ∈ f x ∧ f x ⊂ s [fExists] by fol ALLtExist SKOLEM_THM_GEN; s = UNIONS (IMAGE f s) [] by set -; fol - fExists FORALL_IN_IMAGE OPEN_IN_UNIONS; qed; `;; let closed_in = NewDefinition `; ∀α s. closed_in α s ⇔ s ⊂ topspace α ∧ open_in α (topspace α â” s)`;; let CLOSED_IN_SUBSET = theorem `; ∀α s. closed_in α s ⇒ s ⊂ topspace α by fol closed_in`;; let CLOSED_IN_EMPTY = theorem `; ∀α. closed_in α ∅ by fol closed_in EMPTY_SUBSET DIFF_EMPTY OPEN_IN_TOPSPACE`;; let CLOSED_IN_TOPSPACE = theorem `; ∀α. closed_in α (topspace α) by fol closed_in SUBSET_REFL DIFF_EQ_EMPTY OPEN_IN_EMPTY`;; let CLOSED_IN_UNION = theorem `; ∀α s t. closed_in α s ∧ closed_in α t ⇒ closed_in α (s ∪ t) proof intro_TAC ∀α s t, Hst; fol Hst closed_in DIFF_UNION UNION_SUBSET OPEN_IN_INTER; qed; `;; let CLOSED_IN_INTERS = theorem `; ∀α k. ¬(k = ∅) ∧ (∀s. s ∈ k ⇒ closed_in α s) ⇒ closed_in α (INTERS k) proof intro_TAC ∀α k, H1 H2; consider X such that X = topspace α [Xdef] by fol; simplify GSYM Xdef closed_in DIFF_INTERS SIMPLE_IMAGE; fol H1 H2 Xdef INTERS_SUBSET closed_in FORALL_IN_IMAGE OPEN_IN_UNIONS; qed; `;; let CLOSED_IN_FORALL_IN = theorem `; ∀α P Q. ¬(P = ∅) ∧ (∀a. P a ⇒ closed_in α {x | Q a x}) ⇒ closed_in α {x | ∀a. P a ⇒ Q a x} proof intro_TAC ∀α P Q, Pnonempty H1; consider f such that f = {{x | Q a x} | P a} [fDef] by fol; ¬(f = ∅) [fNonempty] by set fDef Pnonempty; (∀a. P a ⇒ closed_in α {x | Q a x}) ⇔ (∀s. s ∈ f ⇒ closed_in α s) [] by simplify fDef FORALL_IN_GSPEC; closed_in α (INTERS f) [] by fol fNonempty H1 - CLOSED_IN_INTERS; MP_TAC -; {x | ∀a. P a ⇒ x ∈ {x | Q a x}} = {x | ∀a. P a ⇒ Q a x} [] by set; simplify fDef INTERS_GSPEC -; qed; `;; let CLOSED_IN_INTER = theorem `; ∀α s t. closed_in α s ∧ closed_in α t ⇒ closed_in α (s ∩ t) proof intro_TAC ∀α s t, Hs Ht; rewrite GSYM INTERS_2; MATCH_MP_TAC CLOSED_IN_INTERS; set Hs Ht; qed; `;; let OPEN_IN_CLOSED_IN_EQ = theorem `; ∀α s. open_in α s ⇔ s ⊂ topspace α ∧ closed_in α (topspace α â” s) proof intro_TAC ∀α s; simplify closed_in SUBSET_DIFF OPEN_IN_SUBSET; fol SET_RULE [X â” (X â” s) = X ∩ s ∧ (s ⊂ X ⇒ X ∩ s = s)] OPEN_IN_SUBSET; qed; `;; let OPEN_IN_CLOSED_IN = theorem `; ∀s. s ⊂ topspace α ⇒ (open_in α s ⇔ closed_in α (topspace α â” s)) by fol OPEN_IN_CLOSED_IN_EQ`;; let OPEN_IN_DIFF = theorem `; ∀α s t. open_in α s ∧ closed_in α t ⇒ open_in α (s â” t) proof intro_TAC ∀α s t, H1 H2; consider X such that X = topspace α [Xdef] by fol; fol COMPLEMENT_INTER_DIFF OPEN_IN_SUBSET - H1 H2 closed_in OPEN_IN_INTER; qed; `;; let CLOSED_IN_DIFF = theorem `; ∀α s t. closed_in α s ∧ open_in α t ⇒ closed_in α (s â” t) proof intro_TAC ∀α s t, H1 H2; consider X such that X = topspace α [Xdef] by fol; fol COMPLEMENT_INTER_DIFF H1 - OPEN_IN_SUBSET SUBSET_DIFF DIFF_REFL H2 closed_in CLOSED_IN_INTER; qed; `;; let CLOSED_IN_UNIONS = theorem `; ∀α s. FINITE s ∧ (∀t. t ∈ s ⇒ closed_in α t) ⇒ closed_in α (UNIONS s) proof intro_TAC ∀α; rewrite IMP_CONJ; MATCH_MP_TAC FINITE_INDUCT; fol UNIONS_INSERT UNIONS_0 CLOSED_IN_EMPTY IN_INSERT CLOSED_IN_UNION; qed; `;; let subtopology = NewDefinition `; ∀α u. subtopology α u = mk_topology (u, {s ∩ u | open_in α s})`;; let IstopologySubtopology = theorem `; ∀α u:A->bool. u ⊂ topspace α ⇒ istopology (u, {s ∩ u | open_in α s}) proof intro_TAC ∀α u, H1; ∅ = ∅ ∩ u ∧ open_in α ∅ [emptysetOpen] by fol INTER_EMPTY OPEN_IN_EMPTY; u = topspace α ∩ u ∧ open_in α (topspace α) [uOpen] by fol OPEN_IN_TOPSPACE H1 INTER_COMM SUBSET_INTER_ABSORPTION; ∀s' s. open_in α s' ∧ open_in α s ⇒ open_in α (s' ∩ s) ∧ (s' ∩ u) ∩ (s ∩ u) = (s' ∩ s) ∩ u [interOpen] proof intro_TAC ∀s' s, H1 H2; set MESON [H1; H2; OPEN_IN_INTER] [open_in α (s' ∩ s)]; qed; ∀k. k ⊂ {s | open_in α s} ⇒ open_in α (UNIONS k) ∧ UNIONS (IMAGE (λs. s ∩ u) k) = (UNIONS k) ∩ u [unionsOpen] proof intro_TAC ∀k, kProp; open_in α (UNIONS k) [] by fol kProp SUBSET IN_ELIM_THM OPEN_IN_UNIONS; simplify - UNIONS_IMAGE UNIONS_GSPEC INTER_UNIONS; qed; {s ∩ u | open_in α s} = IMAGE (λs. s ∩ u) {s | open_in α s} [] by set; simplify istopology IN_SET_FUNCTION_PREDICATE LEFT_IMP_EXISTS_THM INTER_SUBSET - FORALL_SUBSET_IMAGE; fol emptysetOpen uOpen interOpen unionsOpen; qed; `;; let OpenInSubtopology = theorem `; ∀α u s. u ⊂ topspace α ⇒ (open_in (subtopology α u) s ⇔ ∃t. open_in α t ∧ s = t ∩ u) proof intro_TAC ∀α u s, H1; open_in (subtopology α u) = OpenSets (u,{s ∩ u | open_in α s}) [] by fol subtopology H1 IstopologySubtopology topology_tybij OpenIn; rewrite - OpenSets PAIR_EQ SND EXTENSION IN_ELIM_THM; qed; `;; let TopspaceSubtopology = theorem `; ∀α u. u ⊂ topspace α ⇒ topspace (subtopology α u) = u proof intro_TAC ∀α u , H1; topspace (subtopology α u) = UnderlyingSpace (u,{s ∩ u | open_in α s}) [] by fol subtopology H1 IstopologySubtopology topology_tybij topspace; rewrite - UnderlyingSpace PAIR_EQ FST; fol INTER_COMM H1 SUBSET_INTER_ABSORPTION; qed; `;; let OpenInRefl = theorem `; ∀α s. s ⊂ topspace α ⇒ open_in (subtopology α s) s by fol TopspaceSubtopology OPEN_IN_TOPSPACE`;; let ClosedInRefl = theorem `; ∀α s. s ⊂ topspace α ⇒ closed_in (subtopology α s) s by fol TopspaceSubtopology CLOSED_IN_TOPSPACE`;; let ClosedInSubtopology = theorem `; ∀α u C. u ⊂ topspace α ⇒ (closed_in (subtopology α u) C ⇔ ∃D. closed_in α D ∧ C = D ∩ u) proof intro_TAC ∀α u C, H1; consider X such that X = topspace α ∧ u ⊂ X [Xdef] by fol H1; closed_in (subtopology α u) C ⇔ ∃t. C ⊂ u ∧ t ⊂ X ∧ open_in α t ∧ u â” C = t ∩ u [] by fol closed_in H1 Xdef OpenInSubtopology OPEN_IN_SUBSET TopspaceSubtopology; closed_in (subtopology α u) C ⇔ ∃D. C ⊂ u ∧ D ⊂ X ∧ open_in α (X â” D) ∧ u â” C = (X â” D) ∩ u [] proof rewrite -; eq_tac [Left] proof STRIP_TAC; exists_TAC X â” t; ASM_SIMP_TAC H1 OPEN_IN_SUBSET DIFF_REFL SUBSET_DIFF; qed; STRIP_TAC; exists_TAC X â” D; ASM_SIMP_TAC SUBSET_DIFF; qed; simplify - GSYM Xdef H1 closed_in; ∀D C. C ⊂ u ∧ u â” C = (X â” D) ∩ u ⇔ C = D ∩ u [] by set Xdef DIFF_REFL INTER_SUBSET; fol -; qed; `;; let OPEN_IN_SUBTOPOLOGY_EMPTY = theorem `; ∀α s. open_in (subtopology α ∅) s ⇔ s = ∅ proof simplify EMPTY_SUBSET OpenInSubtopology INTER_EMPTY; fol OPEN_IN_EMPTY; qed; `;; let CLOSED_IN_SUBTOPOLOGY_EMPTY = theorem `; ∀α s. closed_in (subtopology α ∅) s ⇔ s = ∅ proof simplify EMPTY_SUBSET ClosedInSubtopology INTER_EMPTY; fol CLOSED_IN_EMPTY; qed; `;; let SUBTOPOLOGY_TOPSPACE = theorem `; ∀α. subtopology α (topspace α) = α proof intro_TAC ∀α; topspace (subtopology α (topspace α)) = topspace α [topXsub] by simplify SUBSET_REFL TopspaceSubtopology; simplify topXsub GSYM Topology_Eq; fol MESON [SUBSET_REFL] [topspace α ⊂ topspace α] OpenInSubtopology OPEN_IN_SUBSET SUBSET_INTER_ABSORPTION; qed; `;; let OpenInImpSubset = theorem `; ∀α s t. s ⊂ topspace α ⇒ open_in (subtopology α s) t ⇒ t ⊂ s by fol OpenInSubtopology INTER_SUBSET`;; let ClosedInImpSubset = theorem `; ∀α s t. s ⊂ topspace α ⇒ closed_in (subtopology α s) t ⇒ t ⊂ s by fol ClosedInSubtopology INTER_SUBSET`;; let OpenInSubtopologyUnion = theorem `; ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ open_in (subtopology α t) s ∧ open_in (subtopology α u) s ⇒ open_in (subtopology α (t ∪ u)) s proof intro_TAC ∀α s t u, Ht Hu; simplify Ht Hu Ht Hu UNION_SUBSET OpenInSubtopology; intro_TAC sOpenSub_t sOpenSub_u; consider a b such that open_in α a ∧ s = a ∩ t ∧ open_in α b ∧ s = b ∩ u [abExist] by fol sOpenSub_t sOpenSub_u; exists_TAC a ∩ b; set MESON [abExist; OPEN_IN_INTER] [open_in α (a ∩ b)] abExist; qed; `;; let ClosedInSubtopologyUnion = theorem `; ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ closed_in (subtopology α t) s ∧ closed_in (subtopology α u) s ⇒ closed_in (subtopology α (t ∪ u)) s proof intro_TAC ∀α s t u, Ht Hu; simplify Ht Hu Ht Hu UNION_SUBSET ClosedInSubtopology; intro_TAC sClosedSub_t sClosedSub_u; consider a b such that closed_in α a ∧ s = a ∩ t ∧ closed_in α b ∧ s = b ∩ u [abExist] by fol sClosedSub_t sClosedSub_u; exists_TAC a ∩ b; set MESON [abExist; CLOSED_IN_INTER] [closed_in α (a ∩ b)] abExist; qed; `;; let OpenInSubtopologyInterOpen = theorem `; ∀α s t u. u ⊂ topspace α ⇒ open_in (subtopology α u) s ∧ open_in α t ⇒ open_in (subtopology α u) (s ∩ t) proof intro_TAC ∀α s t u, H1, sOpenSub_t tOpen; consider a b such that open_in α a ∧ s = a ∩ u ∧ b = a ∩ t [aExists] by fol sOpenSub_t H1 OpenInSubtopology; fol - tOpen OPEN_IN_INTER INTER_ACI H1 OpenInSubtopology; qed; `;; let OpenInOpenInter = theorem `; ∀α u s. u ⊂ topspace α ⇒ open_in α s ⇒ open_in (subtopology α u) (u ∩ s) by fol INTER_COMM OpenInSubtopology`;; let OpenOpenInTrans = theorem `; ∀α s t. open_in α s ∧ open_in α t ∧ t ⊂ s ⇒ open_in (subtopology α s) t by fol OPEN_IN_SUBSET SUBSET_INTER_ABSORPTION OpenInSubtopology`;; let ClosedClosedInTrans = theorem `; ∀α s t. closed_in α s ∧ closed_in α t ∧ t ⊂ s ⇒ closed_in (subtopology α s) t by fol CLOSED_IN_SUBSET SUBSET_INTER_ABSORPTION ClosedInSubtopology`;; let OpenSubset = theorem `; ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ∧ open_in α s ⇒ open_in (subtopology α t) s by fol OpenInSubtopology SUBSET_INTER_ABSORPTION`;; let ClosedSubsetEq = theorem `; ∀α u s. u ⊂ topspace α ⇒ closed_in α s ⇒ (closed_in (subtopology α u) s ⇔ s ⊂ u) by fol ClosedInSubtopology INTER_SUBSET SUBSET_INTER_ABSORPTION`;; let ClosedInInterClosed = theorem `; ∀α s t u. u ⊂ topspace α ⇒ closed_in (subtopology α u) s ∧ closed_in α t ⇒ closed_in (subtopology α u) (s ∩ t) proof intro_TAC ∀α s t u, H1, sClosedSub_t tClosed; consider a b such that closed_in α a ∧ s = a ∩ u ∧ b = a ∩ t [aExists] by fol sClosedSub_t H1 ClosedInSubtopology; fol - tClosed CLOSED_IN_INTER INTER_ACI H1 ClosedInSubtopology; qed; `;; let ClosedInClosedInter = theorem `; ∀α u s. u ⊂ topspace α ⇒ closed_in α s ⇒ closed_in (subtopology α u) (u ∩ s) by fol INTER_COMM ClosedInSubtopology`;; let ClosedSubset = theorem `; ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ∧ closed_in α s ⇒ closed_in (subtopology α t) s by fol ClosedInSubtopology SUBSET_INTER_ABSORPTION`;; let OpenInSubsetTrans = theorem `; ∀α s t u. u ⊂ topspace α ∧ t ⊂ topspace α ⇒ open_in (subtopology α u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ open_in (subtopology α t) s proof intro_TAC ∀α s t u, uSubset tSubset; simplify uSubset tSubset OpenInSubtopology; intro_TAC sOpen_u s_t t_u; consider a such that open_in α a ∧ s = a ∩ u [aExists] by fol uSubset sOpen_u OpenInSubtopology; set aExists s_t t_u; qed; `;; let ClosedInSubsetTrans = theorem `; ∀α s t u. u ⊂ topspace α ∧ t ⊂ topspace α ⇒ closed_in (subtopology α u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ closed_in (subtopology α t) s proof intro_TAC ∀α s t u, uSubset tSubset; simplify uSubset tSubset ClosedInSubtopology; intro_TAC sClosed_u s_t t_u; consider a such that closed_in α a ∧ s = a ∩ u [aExists] by fol uSubset sClosed_u ClosedInSubtopology; set aExists s_t t_u; qed; `;; let OpenInTrans = theorem `; ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ open_in (subtopology α t) s ∧ open_in (subtopology α u) t ⇒ open_in (subtopology α u) s proof intro_TAC ∀α s t u, H1 H2; simplify H1 H2 OpenInSubtopology; fol H1 H2 OpenInSubtopology OPEN_IN_INTER INTER_ASSOC; qed; `;; let OpenInTransEq = theorem `; ∀α s t. t ⊂ topspace α ∧ s ⊂ topspace α ⇒ ((∀u. open_in (subtopology α t) u ⇒ open_in (subtopology α s) t) ⇔ open_in (subtopology α s) t) by fol OpenInTrans OpenInRefl`;; let OpenInOpenTrans = theorem `; ∀α u s. u ⊂ topspace α ⇒ open_in (subtopology α u) s ∧ open_in α u ⇒ open_in α s by fol OpenInSubtopology OPEN_IN_INTER`;; let OpenInSubtopologyTrans = theorem `; ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ open_in (subtopology α t) s ∧ open_in (subtopology α u) t ⇒ open_in (subtopology α u) s proof simplify OpenInSubtopology; fol OPEN_IN_INTER INTER_ASSOC; qed; `;; let SubtopologyOpenInSubopen = theorem `; ∀α u s. u ⊂ topspace α ⇒ (open_in (subtopology α u) s ⇔ s ⊂ u ∧ ∀x. x ∈ s ⇒ ∃t. open_in α t ∧ x ∈ t ∧ t ∩ u ⊂ s) proof intro_TAC ∀α u s, H1; rewriteL OPEN_IN_SUBOPEN; simplify H1 OpenInSubtopology; eq_tac [Right] by fol SUBSET IN_INTER; intro_TAC H2; conj_tac [Left] proof simplify SUBSET; fol H2 IN_INTER; qed; intro_TAC ∀x, xs; consider t such that open_in α t ∧ x ∈ t ∩ u ∧ t ∩ u ⊂ s [tExists] by fol H2 xs; fol - IN_INTER; qed; `;; let ClosedInSubtopologyTrans = theorem `; ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ closed_in (subtopology α t) s ∧ closed_in (subtopology α u) t ⇒ closed_in (subtopology α u) s proof simplify ClosedInSubtopology; fol CLOSED_IN_INTER INTER_ASSOC; qed; `;; let ClosedInSubtopologyTransEq = theorem `; ∀α s t. t ⊂ topspace α ∧ s ⊂ topspace α ⇒ ((∀u. closed_in (subtopology α t) u ⇒ closed_in (subtopology α s) t) ⇔ closed_in (subtopology α s) t) proof intro_TAC ∀α s t, H1 H2; fol H1 H2 ClosedInSubtopologyTrans CLOSED_IN_TOPSPACE; qed; `;; let ClosedInClosedTrans = theorem `; ∀α s t. u ⊂ topspace α ⇒ closed_in (subtopology α u) s ∧ closed_in α u ⇒ closed_in α s by fol ClosedInSubtopology CLOSED_IN_INTER`;; let OpenInSubtopologyInterSubset = theorem `; ∀α s u v. u ⊂ topspace α ∧ v ⊂ topspace α ⇒ open_in (subtopology α u) (u ∩ s) ∧ v ⊂ u ⇒ open_in (subtopology α v) (v ∩ s) proof simplify OpenInSubtopology; set; qed; `;; let OpenInOpenEq = theorem `; ∀α s t. s ⊂ topspace α ⇒ open_in α s ⇒ (open_in (subtopology α s) t ⇔ open_in α t ∧ t ⊂ s) by fol OpenOpenInTrans OPEN_IN_SUBSET TopspaceSubtopology OpenInOpenTrans`;; let ClosedInClosedEq = theorem `; ∀α s t. s ⊂ topspace α ⇒ closed_in α s ⇒ (closed_in (subtopology α s) t ⇔ closed_in α t ∧ t ⊂ s) by fol ClosedClosedInTrans CLOSED_IN_SUBSET TopspaceSubtopology ClosedInClosedTrans`;; let OpenImpliesSubtopologyInterOpen = theorem `; ∀α u s. u ⊂ topspace α ⇒ open_in α s ⇒ open_in (subtopology α u) (u ∩ s) by fol OpenInSubtopology INTER_COMM`;; let OPEN_IN_EXISTS_IN = theorem `; ∀α P Q. (∀a. P a ⇒ open_in α {x | Q a x}) ⇒ open_in α {x | ∃a. P a ∧ Q a x} proof intro_TAC ∀α P Q, H1; consider f such that f = {{x | Q a x} | P a} [fDef] by fol; (∀a. P a ⇒ open_in α {x | Q a x}) ⇔ (∀s. s ∈ f ⇒ open_in α s) [] by simplify fDef FORALL_IN_GSPEC; MP_TAC MESON [H1; -; OPEN_IN_UNIONS] [open_in α (UNIONS f)]; simplify fDef UNIONS_GSPEC; set; qed; `;; let Connected_DEF = NewDefinition `; ∀α. Connected α ⇔ ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))`;; let ConnectedClosedHelp = theorem `; ∀α e1 e2. topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ⇒ (closed_in α e1 ∧ closed_in α e2 ⇔ open_in α e1 ∧ open_in α e2) proof intro_TAC ∀α e1 e2, H1 H2; e1 = topspace α â” e2 ∧ e2 = topspace α â” e1 [e12Complements] by set H1 H2; fol H1 SUBSET_UNION e12Complements OPEN_IN_CLOSED_IN_EQ; qed; `;; let ConnectedClosed = theorem `; ∀α. Connected α ⇔ ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) proof rewrite Connected_DEF; fol ConnectedClosedHelp; qed; `;; let ConnectedOpenIn = theorem `; ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. open_in (subtopology α s) e1 ∧ open_in (subtopology α s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))) proof simplify Connected_DEF TopspaceSubtopology; fol SUBSET_REFL OpenInImpSubset UNION_SUBSET SUBSET_ANTISYM; qed; `;; let ConnectedClosedIn = theorem `; ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. closed_in (subtopology α s) e1 ∧ closed_in (subtopology α s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))) proof simplify ConnectedClosed TopspaceSubtopology; fol SUBSET_REFL ClosedInImpSubset UNION_SUBSET SUBSET_ANTISYM; qed; `;; let ConnectedSubtopology = theorem `; ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅))) proof intro_TAC ∀α s, H1; simplify H1 Connected_DEF OpenInSubtopology TopspaceSubtopology; AP_TERM_TAC; eq_tac [Left] proof intro_TAC H2; consider t1 t2 such that open_in α t1 ∧ open_in α t2 ∧ s = (t1 ∩ s) ∪ (t2 ∩ s) ∧ (t1 ∩ s) ∩ (t2 ∩ s) = ∅ ∧ ¬(t1 ∩ s = ∅) ∧ ¬(t2 ∩ s = ∅) [t12Exist] by fol H2; s ⊂ t1 ∪ t2 ∧ t1 ∩ t2 ∩ s = ∅ [] by set t12Exist; fol t12Exist -; qed; rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, e12Exist; exists_TAC e1 ∩ s; exists_TAC e2 ∩ s; set e12Exist; qed; `;; let ConnectedSubtopology_ALT = theorem `; ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ∀e1 e2. open_in α e1 ∧ open_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ⇒ e1 ∩ s = ∅ ∨ e2 ∩ s = ∅) proof simplify ConnectedSubtopology; fol; qed; `;; let ConnectedClosedSubtopology = theorem `; ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅))) proof intro_TAC ∀α s, H1; simplify H1 ConnectedSubtopology; AP_TERM_TAC; eq_tac [Left] proof rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, e12Exist; exists_TAC topspace α â” e2; exists_TAC topspace α â” e1; simplify OPEN_IN_SUBSET H1 SUBSET_DIFF DIFF_REFL closed_in e12Exist; set H1 e12Exist; qed; rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, e12Exist; exists_TAC topspace α â” e2; exists_TAC topspace α â” e1; e1 ⊂ topspace α ∧ e2 ⊂ topspace α [e12Top] by fol closed_in e12Exist; simplify DIFF_REFL SUBSET_DIFF e12Top OPEN_IN_CLOSED_IN; set H1 e12Exist; qed; `;; let ConnectedClosedSubtopology_ALT = theorem `; ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ∀e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ⇒ e1 ∩ s = ∅ ∨ e2 ∩ s = ∅) proof simplify ConnectedClosedSubtopology; fol; qed; `;; let ConnectedClopen = theorem `; ∀α. Connected α ⇔ ∀t. open_in α t ∧ closed_in α t ⇒ t = ∅ ∨ t = topspace α proof intro_TAC ∀α; simplify Connected_DEF closed_in TAUT [(¬a ⇔ b) ⇔ (a ⇔ ¬b)] NOT_FORALL_THM NOT_IMP DE_MORGAN_THM; eq_tac [Left] proof rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H1 H2 H3 H4 H5 H6; exists_TAC e1; e1 ⊂ topspace α ∧ e2 = topspace α â” e1 ∧ ¬(e1 = topspace alpha) [] by set H3 H4 H6; fol H1 - H2 H5; qed; rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀t, H1; exists_TAC t; exists_TAC topspace α â” t; set H1; qed; `;; let ConnectedClosedSet = theorem `; ∀α s. s ⊂ topspace α ⇒ closed_in α s ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) proof intro_TAC ∀α s, H1, H2; simplify H1 ConnectedClosedSubtopology; AP_TERM_TAC; eq_tac [Left] proof rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; exists_TAC e1 ∩ s; exists_TAC e2 ∩ s; simplify H2 H3 H4 H7 H8 CLOSED_IN_INTER; set H5 H6; qed; rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; exists_TAC e1; exists_TAC e2; set H3 H4 H7 H8 H5 H6; qed; `;; let ConnectedOpenSet = theorem `; ∀α s. open_in α s ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) proof intro_TAC ∀α s, H1; simplify H1 OPEN_IN_SUBSET ConnectedSubtopology; AP_TERM_TAC; eq_tac [Left] proof rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; exists_TAC e1 ∩ s; exists_TAC e2 ∩ s; e1 ⊂ topspace α ∧ e2 ⊂ topspace α [e12Subsets] by fol H3 H4 OPEN_IN_SUBSET; simplify H1 H3 H4 OPEN_IN_INTER H7 H8; set e12Subsets H5 H6; qed; rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; exists_TAC e1; exists_TAC e2; set H3 H4 H7 H8 H5 H6; qed; `;; let ConnectedEmpty = theorem `; ∀α. Connected (subtopology α ∅) proof simplify Connected_DEF INTER_EMPTY EMPTY_SUBSET TopspaceSubtopology; fol UNION_SUBSET SUBSET_EMPTY; qed; `;; let ConnectedSing = theorem `; ∀α a. a ∈ topspace α ⇒ Connected (subtopology α {a}) proof simplify Connected_DEF SING_SUBSET TopspaceSubtopology; set; qed; `;; let ConnectedUnions = theorem `; ∀α P. (∀s. s ∈ P ⇒ s ⊂ topspace α) ⇒ (∀s. s ∈ P ⇒ Connected (subtopology α s)) ∧ ¬(INTERS P = ∅) ⇒ Connected (subtopology α (UNIONS P)) proof intro_TAC ∀α P, H1; simplify H1 ConnectedSubtopology UNIONS_SUBSET NOT_EXISTS_THM; intro_TAC allConnected PnotDisjoint, ∀[d/e1] [e/e2]; consider a such that ∀t. t ∈ P ⇒ a ∈ t [aInterP] by fol PnotDisjoint MEMBER_NOT_EMPTY IN_INTERS; ONCE_REWRITE_TAC TAUT [∀p. ¬p ⇔ p ⇒ F]; intro_TAC dOpen eOpen Pde deDisjoint dNonempty eNonempty; a ∈ d ∨ a ∈ e [adORae] by set aInterP Pde dNonempty; consider s x t y such that s ∈ P ∧ x ∈ d ∩ s ∧ t ∈ P ∧ y ∈ e ∩ t [xdsANDyet] by set dNonempty eNonempty; d ∩ e ∩ s = ∅ ∧ d ∩ e ∩ t = ∅ [] by set - deDisjoint; (d ∩ s = ∅ ∨ e ∩ s = ∅) ∧ (d ∩ t = ∅ ∨ e ∩ t = ∅) [] by fol xdsANDyet allConnected dOpen eOpen Pde -; set adORae xdsANDyet aInterP -; qed; `;; let ConnectedUnion = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ∧ ¬(s ∩ t = ∅) ∧ Connected (subtopology α s) ∧ Connected (subtopology α t) ⇒ Connected (subtopology α (s ∪ t)) proof rewrite GSYM UNIONS_2 GSYM INTERS_2; intro_TAC ∀α s t, H1 H2 H3 H4 H5; ∀u. u ∈ {s, t} ⇒ u ⊂ topspace α [stEuclidean] by set H1 H2; ∀u. u ∈ {s, t} ⇒ Connected (subtopology α u) [] by set H4 H5; fol stEuclidean - H3 ConnectedUnions; qed; `;; let ConnectedDiffOpenFromClosed = theorem `; ∀α s t u. u ⊂ topspace α ⇒ s ⊂ t ∧ t ⊂ u ∧ open_in α s ∧ closed_in α t ∧ Connected (subtopology α u) ∧ Connected (subtopology α (t â” s)) ⇒ Connected (subtopology α (u â” s)) proof ONCE_REWRITE_TAC TAUT [∀a b c d e f g. (a ∧ b ∧ c ∧ d ∧ e ∧ f ⇒ g) ⇔ (a ∧ b ∧ c ∧ d ⇒ ¬g ⇒ f ⇒ ¬e)]; intro_TAC ∀α s t u, uSubset, st tu sOpen tClosed; t â” s ⊂ topspace α ∧ u â” s ⊂ topspace α [] by fol uSubset sOpen OPEN_IN_SUBSET tClosed closed_in SUBSET_DIFF SUBSET_TRANS; simplify uSubset - ConnectedSubtopology; rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀[v/e1] [w/e2]; intro_TAC vOpen wOpen u_sDisconnected vwDisjoint vNonempty wNonempty; rewrite NOT_EXISTS_THM; intro_TAC t_sConnected; t â” s ⊂ v ∪ w ∧ v ∩ w ∩ (t â” s) = ∅ [] by set tu u_sDisconnected vwDisjoint; v ∩ (t â” s) = ∅ ∨ w ∩ (t â” s) = ∅ [] by fol t_sConnected vOpen wOpen -; case_split vEmpty | wEmpty by fol -; suppose v ∩ (t â” s) = ∅; exists_TAC w ∪ s; exists_TAC v â” t; simplify vOpen wOpen sOpen tClosed OPEN_IN_UNION OPEN_IN_DIFF; set st tu u_sDisconnected vEmpty vwDisjoint wNonempty vNonempty; end; suppose w ∩ (t â” s) = ∅; exists_TAC v ∪ s; exists_TAC w â” t; simplify vOpen wOpen sOpen tClosed OPEN_IN_UNION OPEN_IN_DIFF; set st tu u_sDisconnected wEmpty vwDisjoint wNonempty vNonempty; end; qed; `;; let ConnectedDisjointUnionsOpenUniquePart1 = theorem `; ∀α f f' s t a. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ (∀s. s ∈ f ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ (∀s. s ∈ f' ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ UNIONS f = UNIONS f' ∧ s ∈ f ∧ t ∈ f' ∧ a ∈ s ∧ a ∈ t ⇒ s ⊂ t proof intro_TAC ∀α f f' s t a, pDISJf pDISJf' fConn f'Conn Uf_Uf' sf tf' a_s a_t; ∀s. s ∈ f ⇒ s ⊂ topspace α [fTop] by fol fConn OPEN_IN_SUBSET; ∀s. s ∈ f' ⇒ s ⊂ topspace α [f'Top] by fol f'Conn OPEN_IN_SUBSET; rewrite SUBSET; intro_TAC ∀[b], bs; assume ¬(b ∈ t) [Contradiction] by fol; ∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ s ⊂ e1 ∪ e2 ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅) [] proof exists_TAC t; exists_TAC UNIONS (f' DELETE t); simplify tf' f'Conn IN_DELETE OPEN_IN_UNIONS; conj_tac [Right] by set sf Uf_Uf' a_s a_t sf bs Contradiction; MATCH_MP_TAC SET_RULE [∀s t u. t ∩ u = ∅ ⇒ t ∩ u ∩ s = ∅]; rewrite INTER_UNIONS EMPTY_UNIONS FORALL_IN_GSPEC; rewrite IN_DELETE GSYM DISJOINT; fol pDISJf' tf' pairwise; qed; fol - sf fTop fConn ConnectedSubtopology; qed; `;; let ConnectedDisjointUnionsOpenUnique = theorem `; ∀α f f'. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ (∀s. s ∈ f ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ (∀s. s ∈ f' ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ UNIONS f = UNIONS f' ⇒ f = f' proof MATCH_MP_TAC MESON [SUBSET_ANTISYM] [(∀α s t. P α s t ⇒ P α t s) ∧ (∀α s t. P α s t ⇒ s ⊂ t) ⇒ (∀α s t. P α s t ⇒ s = t)]; conj_tac [Left] by fol; intro_TAC ∀α f f', pDISJf pDISJf' fConn f'Conn Uf_Uf'; rewrite SUBSET; intro_TAC ∀[s], sf; consider t a such that t ∈ f' ∧ a ∈ s ∧ a ∈ t [taExist] by set sf fConn Uf_Uf'; MP_TAC ISPECL [α; f; f'; s; t] ConnectedDisjointUnionsOpenUniquePart1; MP_TAC ISPECL [α; f'; f; t; s] ConnectedDisjointUnionsOpenUniquePart1; fol pDISJf pDISJf' fConn f'Conn Uf_Uf' sf taExist SUBSET_ANTISYM taExist; qed; `;; let ConnectedFromClosedUnionAndInter = theorem `; ∀α s t. s ∪ t ⊂ topspace α ∧ closed_in α s ∧ closed_in α t ∧ Connected (subtopology α (s ∪ t)) ∧ Connected (subtopology α (s ∩ t)) ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) proof MATCH_MP_TAC MESON [] [(∀α s t. P α s t ⇒ P α t s) ∧ (∀α s t. P α s t ⇒ Q α s) ⇒ ∀α s t. P α s t ⇒ Q α s ∧ Q α t]; conj_tac [Left] by fol UNION_COMM INTER_COMM; ONCE_REWRITE_TAC TAUT [∀a b c d e f. a ∧ b ∧ c ∧ d ∧ e ⇒ f ⇔ a ∧ b ∧ c ∧ e ∧ ¬f ⇒ ¬d]; intro_TAC ∀α s t, stUnionTop sClosed tClosed stInterConn NOTsConn; s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol stUnionTop UNION_SUBSET INTER_SUBSET SUBSET_TRANS; simplify stUnionTop ConnectedClosedSubtopology; consider u v such that closed_in α u ∧ closed_in α v ∧ ¬(u = ∅) ∧ ¬(v = ∅) ∧ u ∪ v = s ∧ u ∩ v = ∅ [sDisConn] proof MP_TAC ISPECL [α; s] ConnectedClosedSet; simplify stTop sClosed NOTsConn; qed; s ∩ t ⊂ u ∪ v ∧ u ∩ v ∩ (s ∩ t) = ∅ [stuvProps] by set sDisConn; u ∩ (s ∩ t) = ∅ ∨ v ∩ (s ∩ t) = ∅ [] by fol stTop stInterConn sDisConn - ConnectedClosedSubtopology_ALT; case_split vstEmpty | ustEmpty by fol -; suppose v ∩ (s ∩ t) = ∅; exists_TAC t ∪ u; exists_TAC v; simplify tClosed sDisConn CLOSED_IN_UNION; set stuvProps sDisConn vstEmpty; end; suppose u ∩ (s ∩ t) = ∅; exists_TAC t ∪ v; exists_TAC u; simplify tClosed sDisConn CLOSED_IN_UNION; set stuvProps sDisConn ustEmpty; end; qed; `;; let ConnectedFromOpenUnionAndInter = theorem `; ∀α s t. s ∪ t ⊂ topspace α ∧ open_in α s ∧ open_in α t ∧ Connected (subtopology α (s ∪ t)) ∧ Connected (subtopology α (s ∩ t)) ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) proof MATCH_MP_TAC MESON [] [(∀α s t. P α s t ⇒ P α t s) ∧ (∀α s t. P α s t ⇒ Q α s) ⇒ ∀α s t. P α s t ⇒ Q α s ∧ Q α t]; conj_tac [Left] by fol UNION_COMM INTER_COMM; ONCE_REWRITE_TAC TAUT [∀a b c d e f. a ∧ b ∧ c ∧ d ∧ e ⇒ f ⇔ a ∧ b ∧ c ∧ e ∧ ¬f ⇒ ¬d]; intro_TAC ∀α s t, stUnionTop sOpen tOpen stInterConn NOTsConn; s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol stUnionTop UNION_SUBSET INTER_SUBSET SUBSET_TRANS; simplify stUnionTop ConnectedSubtopology; consider u v such that open_in α u ∧ open_in α v ∧ ¬(u = ∅) ∧ ¬(v = ∅) ∧ u ∪ v = s ∧ u ∩ v = ∅ [sDisConn] proof MP_TAC ISPECL [α; s] ConnectedOpenSet; simplify stTop sOpen NOTsConn; qed; s ∩ t ⊂ u ∪ v ∧ u ∩ v ∩ (s ∩ t) = ∅ [stuvProps] by set sDisConn; u ∩ (s ∩ t) = ∅ ∨ v ∩ (s ∩ t) = ∅ [] by fol stTop stInterConn sDisConn - ConnectedSubtopology_ALT; case_split vstEmpty | ustEmpty by fol -; suppose v ∩ (s ∩ t) = ∅; exists_TAC t ∪ u; exists_TAC v; simplify tOpen sDisConn OPEN_IN_UNION; set stuvProps sDisConn vstEmpty; end; suppose u ∩ (s ∩ t) = ∅; exists_TAC t ∪ v; exists_TAC u; simplify tOpen sDisConn OPEN_IN_UNION; set stuvProps sDisConn ustEmpty; end; qed; `;; let ConnectedInduction = theorem `; ∀α P Q s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀t a. open_in (subtopology α s) t ∧ a ∈ t ⇒ ∃z. z ∈ t ∧ P z) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y) ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ∧ Q a ⇒ Q b proof intro_TAC ∀α P Q s, sTop, sConn atOpenImplies_ztPz asImplies_atOpen_xytPxPyQxasImpliesQy, ∀a b, aINs bINs Pa Pb Qa; assume ¬Q b [NotQb] by fol; ¬Connected (subtopology α s) [] proof simplify sTop ConnectedOpenIn; exists_TAC {b | ∃t. open_in (subtopology α s) t ∧ b ∈ t ∧ ∀x. x ∈ t ∧ P x ⇒ Q x}; exists_TAC {b | ∃t. open_in (subtopology α s) t ∧ b ∈ t ∧ ∀x. x ∈ t ∧ P x ⇒ ¬(Q x)}; conj_tac [Left] proof ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; intro_TAC ∀[c]; rewrite IN_ELIM_THM; MATCH_MP_TAC MONO_EXISTS; set atOpenImplies_ztPz; qed; conj_tac [Left] proof ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; intro_TAC ∀[c]; rewrite IN_ELIM_THM; MATCH_MP_TAC MONO_EXISTS; set atOpenImplies_ztPz; qed; conj_tac [Left] proof rewrite SUBSET IN_ELIM_THM IN_UNION; intro_TAC ∀[c], cs; MP_TAC SPECL [c] asImplies_atOpen_xytPxPyQxasImpliesQy; set cs; qed; conj_tac [Right] by set aINs bINs Qa NotQb asImplies_atOpen_xytPxPyQxasImpliesQy Pa Pb; rewrite EXTENSION IN_INTER NOT_IN_EMPTY IN_ELIM_THM; intro_TAC ∀[c]; ONCE_REWRITE_TAC TAUT [∀p. ¬p ⇔ p ⇒ F]; intro_TAC Qx NotQx; consider t such that open_in (subtopology α s) t ∧ c ∈ t ∧ (∀x. x ∈ t ∧ P x ⇒ Q x) [tExists] by fol Qx; consider u such that open_in (subtopology α s) u ∧ c ∈ u ∧ (∀x. x ∈ u ∧ P x ⇒ ¬Q x) [uExists] by fol NotQx; MP_TAC SPECL [t ∩ u; c] atOpenImplies_ztPz; simplify tExists uExists OPEN_IN_INTER; set tExists uExists; qed; fol sConn -; qed; `;; let ConnectedEquivalenceRelationGen = theorem `; ∀α P R s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀t a. open_in (subtopology α s) t ∧ a ∈ t ⇒ ∃z. z ∈ t ∧ P z) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y) ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b proof intro_TAC ∀α P R s, sTop, sConn Rtrans atOpenImplies_ztPz asImplies_atOpen_xytPxPyImpliesRxy, ∀a b, aINs bINs Pa Pb; ∀a. a ∈ s ∧ P a ⇒ ∀b c. b ∈ s ∧ c ∈ s ∧ P b ∧ P c ∧ R a b ⇒ R a c [] proof intro_TAC ∀[p/a], pINs Pp; MP_TAC ISPECL [α; P; λx. R p x; s] ConnectedInduction; rewrite sTop sConn atOpenImplies_ztPz; fol asImplies_atOpen_xytPxPyImpliesRxy Rtrans; qed; fol aINs Pa bINs Pb asImplies_atOpen_xytPxPyImpliesRxy -; qed; `;; let ConnectedInductionSimple = theorem `; ∀α P s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ ∀x y. x ∈ t ∧ y ∈ t ∧ P x ⇒ P y) ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ⇒ P b proof intro_TAC ∀α P s, sTop; MP_TAC ISPECL [α; (λx. T ∨ x ∈ s); P; s] ConnectedInduction; fol sTop; qed; `;; let ConnectedEquivalenceRelation = theorem `; ∀α R s. s ⊂ topspace α ⇒ Connected (subtopology α s)∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ ∀x. x ∈ t ⇒ R a x) ⇒ ∀a b. a ∈ s ∧ b ∈ s ⇒ R a b proof intro_TAC ∀α R s, sTop, sConn Rcomm Rtrans asImplies_atOpen_xtImpliesRax; ∀a. a ∈ s ⇒ ∀b c. b ∈ s ∧ c ∈ s ∧ R a b ⇒ R a c [] proof intro_TAC ∀[p/a], pINs; MP_TAC ISPECL [α; λx. R p x; s] ConnectedInductionSimple; rewrite sTop sConn; fol asImplies_atOpen_xtImpliesRax Rcomm Rtrans; qed; fol asImplies_atOpen_xtImpliesRax -; qed; `;; let LimitPointOf = NewDefinition `; ∀α s. LimitPointOf α s = {x | s ⊂ topspace α ∧ x ∈ topspace α ∧ ∀t. x ∈ t ∧ open_in α t ⇒ ∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t}`;; let IN_LimitPointOf = theorem `; ∀α s x. s ⊂ topspace α ⇒ (x ∈ LimitPointOf α s ⇔ x ∈ topspace α ∧ ∀t. x ∈ t ∧ open_in α t ⇒ ∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t) by simplify IN_ELIM_THM LimitPointOf`;; let NotLimitPointOf = theorem `; ∀α s x. s ⊂ topspace α ∧ x ∈ topspace α ⇒ (x ∉ LimitPointOf α s ⇔ ∃t. x ∈ t ∧ open_in α t ∧ s ∩ (t â” {x}) = ∅) proof ONCE_REWRITE_TAC TAUT [∀a b. (a ⇔ b) ⇔ (¬a ⇔ ¬b)]; simplify ∉ NOT_EXISTS_THM IN_LimitPointOf TAUT [∀a b. ¬(a ∧ b ∧ c) ⇔ a ∧ b ⇒ ¬c] GSYM MEMBER_NOT_EMPTY IN_INTER IN_DIFF IN_SING; fol; qed; `;; let LimptSubset = theorem `; ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ LimitPointOf α s ⊂ LimitPointOf α t proof intro_TAC ∀α s t, tTop, st; s ⊂ topspace α [sTop] by fol tTop st SUBSET_TRANS; simplify tTop sTop IN_LimitPointOf SUBSET; fol st SUBSET; qed; `;; let ClosedLimpt = theorem `; ∀α s. s ⊂ topspace α ⇒ (closed_in α s ⇔ LimitPointOf α s ⊂ s) proof intro_TAC ∀α s, H1; simplify H1 closed_in; ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; simplify H1 IN_LimitPointOf SUBSET IN_DIFF; AP_TERM_TAC; ABS_TAC; fol OPEN_IN_SUBSET SUBSET; qed; `;; let LimptEmpty = theorem `; ∀α x. x ∈ topspace α ⇒ x ∉ LimitPointOf α ∅ by fol EMPTY_SUBSET IN_LimitPointOf OPEN_IN_TOPSPACE NOT_IN_EMPTY ∉`;; let NoLimitPointImpClosed = theorem `; ∀α s. s ⊂ topspace α ⇒ (∀x. x ∉ LimitPointOf α s) ⇒ closed_in α s by fol ClosedLimpt SUBSET ∉`;; let LimitPointUnion = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ LimitPointOf α (s ∪ t) = LimitPointOf α s ∪ LimitPointOf α t proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 UNION_SUBSET; rewrite EXTENSION IN_UNION; intro_TAC ∀x; assume x ∈ topspace α [xTop] by fol H1 stTop IN_LimitPointOf; ONCE_REWRITE_TAC TAUT [∀a b. (a ⇔ b) ⇔ (¬a ⇔ ¬b)]; simplify GSYM NOTIN DE_MORGAN_THM H1 stTop NotLimitPointOf xTop; eq_tac [Left] by set; MATCH_MP_TAC ExistsTensorInter; simplify IN_INTER OPEN_IN_INTER; set; qed; `;; let Interior_DEF = NewDefinition `; ∀α s. Interior α s = {x | s ⊂ topspace α ∧ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s}`;; let Interior_THM = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α s = {x | s ⊂ topspace α ∧ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s} by fol Interior_DEF`;; let IN_Interior = theorem `; ∀α s x. s ⊂ topspace α ⇒ (x ∈ Interior α s ⇔ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s) by simplify Interior_THM IN_ELIM_THM`;; let InteriorEq = theorem `; ∀α s. s ⊂ topspace α ⇒ (open_in α s ⇔ s = Interior α s) proof intro_TAC ∀α s, H1; rewriteL OPEN_IN_SUBOPEN; simplify EXTENSION H1 IN_Interior; set; qed; `;; let InteriorOpen = theorem `; ∀α s. open_in α s ⇒ Interior α s = s by fol OPEN_IN_SUBSET InteriorEq`;; let InteriorEmpty = theorem `; ∀α. Interior α ∅ = ∅ by fol OPEN_IN_EMPTY EMPTY_SUBSET InteriorOpen`;; let InteriorUniv = theorem `; ∀α. Interior α (topspace α) = topspace α by simplify OpenInTopspace InteriorOpen`;; let OpenInterior = theorem `; ∀α s. s ⊂ topspace α ⇒ open_in α (Interior α s) proof ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; fol IN_Interior SUBSET; qed; `;; let InteriorInterior = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α (Interior α s) = Interior α s by fol OpenInterior InteriorOpen`;; let InteriorSubset = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α s ⊂ s proof intro_TAC ∀α s, H1; simplify SUBSET Interior_DEF IN_ELIM_THM; fol H1 SUBSET; qed; `;; let InteriorTopspace = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α s ⊂ topspace α by fol SUBSET_TRANS InteriorSubset`;; let SubsetInterior = theorem `; ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ Interior α s ⊂ Interior α t by fol SUBSET_TRANS SUBSET IN_Interior SUBSET`;; let InteriorMaximal = theorem `; ∀α s t. s ⊂ topspace α ⇒ t ⊂ s ∧ open_in α t ⇒ t ⊂ Interior α s by fol SUBSET IN_Interior SUBSET`;; let InteriorMaximalEq = theorem `; ∀s t. t ⊂ topspace α ⇒ open_in α s ⇒ (s ⊂ Interior α t ⇔ s ⊂ t) by fol InteriorMaximal SUBSET_TRANS InteriorSubset`;; let InteriorUnique = theorem `; ∀α s t. s ⊂ topspace α ⇒ t ⊂ s ∧ open_in α t ∧ (∀t'. t' ⊂ s ∧ open_in α t' ⇒ t' ⊂ t) ⇒ Interior α s = t by fol SUBSET_ANTISYM InteriorSubset OpenInterior InteriorMaximal`;; let OpenSubsetInterior = theorem `; ∀α s t. t ⊂ topspace α ⇒ open_in α s ⇒ (s ⊂ Interior α t ⇔ s ⊂ t) by fol InteriorMaximal InteriorSubset SUBSET_TRANS`;; let InteriorInter = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α (s ∩ t) = Interior α s ∩ Interior α t proof intro_TAC ∀α s t, sTop tTop; rewrite GSYM SUBSET_ANTISYM_EQ SUBSET_INTER; conj_tac [Left] by fol sTop tTop SubsetInterior INTER_SUBSET; s ∩ t ⊂ topspace α [] by fol sTop INTER_SUBSET SUBSET_TRANS; fol - sTop tTop OpenInterior OPEN_IN_INTER InteriorSubset InteriorMaximal INTER_TENSOR; qed; `;; let InteriorFiniteInters = theorem `; ∀α s. FINITE s ⇒ ¬(s = ∅) ⇒ (∀t. t ∈ s ⇒ t ⊂ topspace α) ⇒ Interior α (INTERS s) = INTERS (IMAGE (Interior α) s) proof intro_TAC ∀α; MATCH_MP_TAC FINITE_INDUCT; rewrite INTERS_INSERT IMAGE_CLAUSES IN_INSERT; intro_TAC ∀x s, sCase, xsNonempty, sSetOfSubsets; assume ¬(s = ∅) [sNonempty] by simplify INTERS_0 INTER_UNIV IMAGE_CLAUSES; simplify INTERS_SUBSET sSetOfSubsets InteriorInter sNonempty sSetOfSubsets sCase; qed; `;; let InteriorIntersSubset = theorem `; ∀α f. ¬(f = ∅) ∧ (∀t. t ∈ f ⇒ t ⊂ topspace α) ⇒ Interior α (INTERS f) ⊂ INTERS (IMAGE (Interior α) f) proof intro_TAC ∀α f, H1 H2; INTERS f ⊂ topspace α [] by set H1 H2; simplify SUBSET IN_INTERS FORALL_IN_IMAGE - H2 IN_Interior; fol; qed; `;; let UnionInteriorSubset = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α s ∪ Interior α t ⊂ Interior α (s ∪ t) proof intro_TAC ∀α s t, sTop tTop; s ∪ t ⊂ topspace α [] by fol sTop tTop UNION_SUBSET; fol sTop tTop - OpenInterior OPEN_IN_UNION InteriorMaximal UNION_TENSOR InteriorSubset; qed; `;; let InteriorEqEmpty = theorem `; ∀α s. s ⊂ topspace α ⇒ (Interior α s = ∅ ⇔ ∀t. open_in α t ∧ t ⊂ s ⇒ t = ∅) by fol InteriorMaximal SUBSET_EMPTY OpenInterior SUBSET_REFL InteriorSubset`;; let InteriorEqEmptyAlt = theorem `; ∀α s. s ⊂ topspace α ⇒ (Interior α s = ∅ ⇔ ∀t. open_in α t ∧ ¬(t = ∅) ⇒ ¬(t â” s = ∅)) proof simplify InteriorEqEmpty; set; qed; `;; let InteriorUnionsOpenSubsets = theorem `; ∀α s. s ⊂ topspace α ⇒ UNIONS {t | open_in α t ∧ t ⊂ s} = Interior α s proof intro_TAC ∀α s, H1; consider t such that t = UNIONS {f | open_in α f ∧ f ⊂ s} [tDef] by fol; t ⊂ s ∧ ∀f. f ⊂ s ∧ open_in α f ⇒ f ⊂ t [] by set tDef; simplify H1 tDef - OPEN_IN_UNIONS IN_ELIM_THM InteriorUnique; qed; `;; let InteriorClosedUnionEmptyInterior = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ closed_in α s ∧ Interior α t = ∅ ⇒ Interior α (s ∪ t) = Interior α s proof intro_TAC ∀α s t, H1 H2, H3 H4; s ∪ t ⊂ topspace α [stTop] by fol H1 H2 UNION_SUBSET; Interior α (s ∪ t) ⊂ s [] proof simplify SUBSET stTop IN_Interior LEFT_IMP_EXISTS_THM; intro_TAC ∀[y] [O], openO yO Os_t; consider O' such that O' = (topspace α â” s) ∩ O [O'def] by fol -; O' ⊂ t [O't] by set O'def Os_t; assume y ∉ s [yNOTs] by fol ∉; y ∈ topspace α â” s [] by fol openO OPEN_IN_SUBSET yO SUBSET yNOTs IN_DIFF ∉; y ∈ O' ∧ open_in α O' [] by fol O'def - yO IN_INTER H3 closed_in openO OPEN_IN_INTER; fol O'def - O't H2 IN_Interior SUBSET MEMBER_NOT_EMPTY H4; qed; fol SUBSET_ANTISYM H1 stTop OpenInterior - InteriorMaximal SUBSET_UNION SubsetInterior; qed; `;; let InteriorUnionEqEmpty = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ closed_in α s ∨ closed_in α t ⇒ (Interior α (s ∪ t) = ∅ ⇔ Interior α s = ∅ ∧ Interior α t = ∅) proof intro_TAC ∀α s t, H1, H2; s ⊂ topspace α ∧ t ⊂ topspace α [] by fol H1 UNION_SUBSET; eq_tac [Left] by fol - H1 SUBSET_UNION SubsetInterior SUBSET_EMPTY; fol UNION_COMM - H2 InteriorClosedUnionEmptyInterior; qed; `;; let Closure_DEF = NewDefinition `; ∀α s. Closure α s = s ∪ LimitPointOf α s`;; let Closure_THM = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α s = s ∪ LimitPointOf α s by fol Closure_DEF`;; let IN_Closure = theorem `; ∀α s x. s ⊂ topspace α ⇒ (x ∈ Closure α s ⇔ x ∈ topspace α ∧ ∀t. x ∈ t ∧ open_in α t ⇒ ∃y. y ∈ s ∧ y ∈ t) proof intro_TAC ∀α s x, H1; simplify H1 Closure_THM IN_UNION IN_LimitPointOf; fol H1 SUBSET; qed; `;; let ClosureSubset = theorem `; ∀α s. s ⊂ topspace α ⇒ s ⊂ Closure α s by fol SUBSET IN_Closure`;; let ClosureTopspace = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α s ⊂ topspace α by fol SUBSET IN_Closure`;; let ClosureInterior = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α s = topspace α â” (Interior α (topspace α â” s)) proof intro_TAC ∀α s, H1; simplify H1 EXTENSION IN_Closure IN_DIFF IN_Interior SUBSET; fol OPEN_IN_SUBSET SUBSET; qed; `;; let InteriorClosure = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α s = topspace α â” (Closure α (topspace α â” s)) by fol SUBSET_DIFF InteriorTopspace DIFF_REFL ClosureInterior`;; let ClosedClosure = theorem `; ∀α s. s ⊂ topspace α ⇒ closed_in α (Closure α s) by fol closed_in ClosureInterior DIFF_REFL SUBSET_DIFF InteriorTopspace OpenInterior`;; let SubsetClosure = theorem `; ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ Closure α s ⊂ Closure α t proof intro_TAC ∀α s t, tSubset, st; s ⊂ topspace α [] by fol tSubset st SUBSET_TRANS; simplify tSubset - Closure_THM st LimptSubset UNION_TENSOR; qed; `;; let ClosureHull = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α s = (closed_in α) hull s proof intro_TAC ∀α s, H1; MATCH_MP_TAC GSYM HULL_UNIQUE; simplify H1 ClosureSubset ClosedClosure Closure_THM UNION_SUBSET; fol LimptSubset CLOSED_IN_SUBSET ClosedLimpt SUBSET_TRANS; qed; `;; let ClosureEq = theorem `; ∀α s. s ⊂ topspace α ⇒ (Closure α s = s ⇔ closed_in α s) by fol ClosedClosure ClosedLimpt Closure_THM SUBSET_UNION_ABSORPTION UNION_COMM`;; let ClosureClosed = theorem `; ∀α s. closed_in α s ⇒ Closure α s = s by fol closed_in ClosureEq`;; let ClosureClosure = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α (Closure α s) = Closure α s by fol ClosureTopspace ClosureHull HULL_HULL`;; let ClosureUnion = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α (s ∪ t) = Closure α s ∪ Closure α t proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 UNION_SUBSET; simplify H1 stTop Closure_THM LimitPointUnion; set; qed; `;; let ClosureInterSubset = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Closure α (s ∩ t) ⊂ Closure α s ∩ Closure α t by fol SUBSET_INTER INTER_SUBSET SubsetClosure`;; let ClosureIntersSubset = theorem `; ∀α f. (∀s. s ∈ f ⇒ s ⊂ topspace α) ⇒ Closure α (INTERS f) ⊂ INTERS (IMAGE (Closure α) f) proof intro_TAC ∀α f, H1; rewrite SET_RULE [s ⊂ INTERS f ⇔ ∀t. t ∈ f ⇒ s ⊂ t] FORALL_IN_IMAGE; intro_TAC ∀[s], sf; s ⊂ topspace α ∧ INTERS f ⊂ s ∧ INTERS f ⊂ topspace α [] by set H1 sf; fol SubsetClosure -; qed; `;; let ClosureMinimal = theorem `; ∀α s t. s ⊂ t ∧ closed_in α t ⇒ Closure α s ⊂ t by fol closed_in SubsetClosure ClosureClosed`;; let ClosureMinimalEq = theorem `; ∀α s t. s ⊂ topspace α ⇒ closed_in α t ⇒ (Closure α s ⊂ t ⇔ s ⊂ t) by fol closed_in SUBSET_TRANS ClosureSubset ClosureMinimal`;; let ClosureUnique = theorem `; ∀α s t. s ⊂ t ∧ closed_in α t ∧ (∀u. s ⊂ u ∧ closed_in α u ⇒ t ⊂ u) ⇒ Closure α s = t by fol closed_in SUBSET_ANTISYM_EQ ClosureMinimal SUBSET_TRANS ClosureSubset ClosedClosure`;; let ClosureUniv = theorem `; ∀α. Closure α (topspace α) = topspace α by simplify SUBSET_REFL CLOSED_IN_TOPSPACE ClosureEq`;; let ClosureEmpty = theorem `; Closure α ∅ = ∅ by fol EMPTY_SUBSET CLOSED_IN_EMPTY ClosureClosed`;; let ClosureUnions = theorem `; ∀α f. FINITE f ⇒ (∀ t. t ∈ f ⇒ t ⊂ topspace α) ⇒ Closure α (UNIONS f) = UNIONS {Closure α t | t ∈ f} proof intro_TAC ∀α; MATCH_MP_TAC FINITE_INDUCT; rewrite UNIONS_0 SET_RULE [{f x | x ∈ ∅} = ∅] ClosureEmpty UNIONS_INSERT SET_RULE [{f x | x ∈ a INSERT t} = (f a) INSERT {f x | x ∈ t}] IN_INSERT; fol UNION_SUBSET UNIONS_SUBSET IN_UNIONS ClosureUnion; qed; `;; let ClosureEqEmpty = theorem `; ∀α s. s ⊂ topspace α ⇒ (Closure α s = ∅ ⇔ s = ∅) by fol ClosureEmpty ClosureSubset SUBSET_EMPTY`;; let ClosureSubsetEq = theorem `; ∀α s. s ⊂ topspace α ⇒ (Closure α s ⊂ s ⇔ closed_in α s) by fol ClosureEq ClosureSubset SUBSET_ANTISYM`;; let OpenInterClosureEqEmpty = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ open_in α s ⇒ (s ∩ Closure α t = ∅ ⇔ s ∩ t = ∅) proof intro_TAC ∀α s t, H1 H2, H3; eq_tac [Left] by fol H2 ClosureSubset INTER_TENSOR SUBSET_REFL SUBSET_EMPTY; intro_TAC stDisjoint; s ⊂ Interior α (topspace α â” t) [] by fol H2 SUBSET_DIFF H3 H1 H2 stDisjoint SUBSET_COMPLEMENT OpenSubsetInterior; fol H1 H2 InteriorTopspace - COMPLEMENT_DISJOINT H2 ClosureInterior; qed; `;; let OpenInterClosureSubset = theorem `; ∀α s t. t ⊂ topspace α ⇒ open_in α s ⇒ s ∩ Closure α t ⊂ Closure α (s ∩ t) proof intro_TAC ∀α s t, tTop, sOpen; s ⊂ topspace α [sTop] by fol OPEN_IN_SUBSET sOpen; s ∩ t ⊂ topspace α [stTop] by fol sTop sTop INTER_SUBSET SUBSET_TRANS; simplify tTop - Closure_THM UNION_OVER_INTER SUBSET_UNION SUBSET_UNION; s ∩ LimitPointOf α t ⊂ LimitPointOf α (s ∩ t) [] proof simplify SUBSET IN_INTER tTop stTop IN_LimitPointOf; intro_TAC ∀[x], xs xTop xLIMt, ∀[O], xO Oopen; x ∈ O ∩ s ∧ open_in α (O ∩ s) [xOsOpen] by fol xs xO IN_INTER Oopen sOpen OPEN_IN_INTER; fol xOsOpen xLIMt IN_INTER; qed; simplify - UNION_TENSOR SUBSET_REFL; qed; `;; let ClosureOpenInterSuperset = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ open_in α s ∧ s ⊂ Closure α t ⇒ Closure α (s ∩ t) = Closure α s proof intro_TAC ∀α s t, sTop tTop, sOpen sSUBtC; s ∩ t ⊂ topspace α [stTop] by fol INTER_SUBSET sTop SUBSET_TRANS; MATCH_MP_TAC SUBSET_ANTISYM; conj_tac [Left] by fol sTop INTER_SUBSET SubsetClosure; s ⊂ Closure α (s ∩ t) [] by fol tTop sOpen OpenInterClosureSubset SUBSET_REFL sSUBtC SUBSET_INTER SUBSET_TRANS; fol stTop - ClosedClosure ClosureMinimal; qed; `;; let ClosureComplement = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α (topspace α â” s) = topspace α â” Interior α s by fol InteriorClosure SUBSET_DIFF ClosureTopspace DIFF_REFL`;; let InteriorComplement = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α (topspace α â” s) = topspace α â” Closure α s by fol SUBSET_DIFF InteriorTopspace DIFF_REFL ClosureInterior DIFF_REFL`;; let ClosureInteriorComplement = theorem `; ∀α s. s ⊂ topspace α ⇒ topspace α â” Closure α (Interior α s) = Interior α (Closure α (topspace α â” s)) by fol InteriorTopspace InteriorComplement ClosureComplement`;; let InteriorClosureComplement = theorem `; ∀α s. s ⊂ topspace α ⇒ topspace α â” Interior α (Closure α s) = Closure α (Interior α (topspace α â” s)) by fol ClosureTopspace SUBSET_TRANS InteriorComplement ClosureComplement`;; let ConnectedIntermediateClosure = theorem `; ∀α s t. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ s ⊂ t ∧ t ⊂ Closure α s ⇒ Connected (subtopology α t) proof intro_TAC ∀α s t, sTop, sCon st tCs; t ⊂ topspace α [tTop] by fol tCs sTop ClosureTopspace SUBSET_TRANS; simplify tTop ConnectedSubtopology_ALT; intro_TAC ∀[u] [v], uOpen vOpen t_uv uvtEmpty; u ⊂ topspace α ∧ v ⊂ topspace α [uvTop] by fol uOpen vOpen OPEN_IN_SUBSET; u ∩ s = ∅ ∨ v ∩ s = ∅ [] by fol sTop uvTop uOpen vOpen st t_uv uvtEmpty SUBSET_TRANS SUBSET_REFL INTER_TENSOR SUBSET_EMPTY sCon ConnectedSubtopology_ALT; s ⊂ topspace α â” u ∨ s ⊂ topspace α â” v [] by fol - sTop uvTop INTER_COMM SUBSET_COMPLEMENT; t ⊂ topspace α â” u ∨ t ⊂ topspace α â” v [] by fol SUBSET_DIFF - uvTop uOpen vOpen OPEN_IN_CLOSED_IN ClosureMinimal tCs SUBSET_TRANS; fol tTop uvTop - SUBSET_COMPLEMENT INTER_COMM; qed; `;; let ConnectedClosure = theorem `; ∀α s. s ⊂ topspace α ⇒ Connected (subtopology α s) ⇒ Connected (subtopology α (Closure α s)) by fol ClosureTopspace ClosureSubset SUBSET_REFL ConnectedIntermediateClosure`;; let ConnectedUnionStrong = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) ∧ ¬(Closure α s ∩ t = ∅) ⇒ Connected (subtopology α (s ∪ t)) proof intro_TAC ∀α s t, sTop tTop, H2 H3 H4; consider p s' such that p ∈ Closure α s ∧ p ∈ t ∧ s' = p ╪ s [pCst] by fol H4 MEMBER_NOT_EMPTY IN_INTER; s ⊂ s' ∧ s' ⊂ Closure α s [s_ps_Cs] by fol IN_INSERT SUBSET pCst sTop ClosureSubset INSERT_SUBSET; Connected (subtopology α (s')) [s'Con] by fol sTop H2 s_ps_Cs ConnectedIntermediateClosure; s ∪ t = s' ∪ t ∧ ¬(s' ∩ t = ∅) [] by fol pCst INSERT_UNION IN_INSERT IN_INTER MEMBER_NOT_EMPTY; fol s_ps_Cs sTop ClosureTopspace SUBSET_TRANS tTop - s'Con H3 ConnectedUnion; qed; `;; let InteriorDiff = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α (s â” t) = Interior α s â” Closure α t by fol ClosureTopspace InteriorTopspace COMPLEMENT_INTER_DIFF InteriorComplement SUBSET_DIFF InteriorInter`;; let ClosedInLimpt = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ (closed_in (subtopology α t) s ⇔ s ⊂ t ∧ LimitPointOf α s ∩ t ⊂ s) proof intro_TAC ∀α s t, H1 H2; simplify H2 ClosedInSubtopology; eq_tac [Right] proof intro_TAC sSUBt LIMstSUBs; exists_TAC Closure α s; simplify H1 ClosedClosure Closure_THM INTER_COMM UNION_OVER_INTER; set sSUBt LIMstSUBs; qed; rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀[D], Dexists; LimitPointOf α (D ∩ t) ⊂ D [] by fol Dexists CLOSED_IN_SUBSET INTER_SUBSET LimptSubset ClosedLimpt SUBSET_TRANS; fol Dexists INTER_SUBSET - SUBSET_REFL INTER_TENSOR; qed; `;; let ClosedInLimpt_ALT = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ (closed_in (subtopology α t) s ⇔ s ⊂ t ∧ ∀x. x ∈ LimitPointOf α s ∧ x ∈ t ⇒ x ∈ s) by simplify SUBSET IN_INTER ClosedInLimpt`;; let ClosedInInterClosure = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ (closed_in (subtopology α s) t ⇔ s ∩ Closure α t = t) proof simplify Closure_THM ClosedInLimpt; set; qed; `;; let InteriorClosureIdemp = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α (Closure α (Interior α (Closure α s))) = Interior α (Closure α s) proof intro_TAC ∀α s, H1; consider IC CIC such that IC = Interior α (Closure α s) ∧ CIC = Closure α IC [CICdef] by fol; Closure α s ⊂ topspace α [Ctop] by fol H1 ClosureTopspace; IC ⊂ topspace α [ICtop] by fol CICdef - H1 InteriorTopspace; CIC ⊂ topspace α [CICtop] by fol CICdef - ClosureTopspace; IC ⊂ CIC [ICsubCIC] by fol CICdef ICtop ClosureSubset; ∀u. u ⊂ CIC ∧ open_in α u ⇒ u ⊂ IC [] by fol CICdef Ctop InteriorSubset SubsetClosure H1 ClosureClosure SUBSET_TRANS OpenSubsetInterior; fol CICdef CICtop ICsubCIC Ctop OpenInterior - InteriorUnique; qed; `;; let InteriorClosureIdemp = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α (Closure α (Interior α (Closure α s))) = Interior α (Closure α s) proof intro_TAC ∀α s, H1; Closure α s ⊂ topspace α [Ctop] by fol H1 ClosureTopspace; consider IC CIC such that IC = Interior α (Closure α s) ∧ CIC = Closure α IC [ICdefs] by fol; IC ⊂ topspace α [] by fol - Ctop H1 InteriorTopspace; CIC ⊂ topspace α ∧ IC ⊂ CIC ∧ ∀u. u ⊂ CIC ∧ open_in α u ⇒ u ⊂ IC [] by fol ICdefs Ctop - ClosureTopspace ClosureSubset InteriorSubset SubsetClosure H1 ClosureClosure SUBSET_TRANS OpenSubsetInterior; fol ICdefs - Ctop OpenInterior InteriorUnique; qed; `;; let ClosureInteriorIdemp = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α (Interior α (Closure α (Interior α s))) = Closure α (Interior α s) proof intro_TAC ∀α s, H1; consider t such that t = topspace α â” s [tDef] by fol; t ⊂ topspace α ∧ s = topspace α â” t [tProps] by fol - H1 SUBSET_DIFF DIFF_REFL; Interior α (Closure α t) ⊂ topspace α [] by fol - ClosureTopspace InteriorTopspace; simplify tProps - GSYM InteriorClosureComplement InteriorClosureIdemp; qed; `;; let InteriorClosureDiffSpaceEmpty = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α (Closure α s â” s) = ∅ proof intro_TAC ∀α s, H1; Closure α s â” s ⊂ topspace α [Cs_sTop] by fol H1 ClosureTopspace SUBSET_DIFF SUBSET_TRANS; assume ¬(Interior α (Closure α s â” s) = ∅) [Contradiction] by fol; consider x such that x ∈ (Interior α (Closure α s â” s)) [xExists] by fol - MEMBER_NOT_EMPTY; consider t such that open_in α t ∧ x ∈ t ∧ t ⊂ (s ∪ LimitPointOf α s) â” s [tProps] by fol - Cs_sTop IN_Interior Closure_DEF; t ⊂ LimitPointOf α s ∧ s ∩ (t â” {x}) = ∅ [tSubLIMs] by set -; x ∈ LimitPointOf α s ∧ x ∉ s [xLims] by fol tProps - SUBSET IN_DIFF ∉; fol H1 xLims IN_LimitPointOf tProps tSubLIMs NotLimitPointOf ∉; qed; `;; let NowhereDenseUnion = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ (Interior α (Closure α (s ∪ t)) = ∅ ⇔ Interior α (Closure α s) = ∅ ∧ Interior α (Closure α t) = ∅) proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α [] by fol H1 UNION_SUBSET; simplify H1 - ClosureUnion ClosureTopspace UNION_SUBSET ClosedClosure InteriorUnionEqEmpty; qed; `;; let NowhereDense = theorem `; ∀α s. s ⊂ topspace α ⇒ (Interior α (Closure α s) = ∅ ⇔ ∀t. open_in α t ∧ ¬(t = ∅) ⇒ ∃u. open_in α u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅) proof intro_TAC ∀α s, H1; simplify H1 ClosureTopspace InteriorEqEmptyAlt; eq_tac [Left] proof intro_TAC H2, ∀[t], tOpen tNonempty; exists_TAC t â” Closure α s; fol tOpen H1 ClosedClosure OPEN_IN_DIFF tOpen tNonempty H2 SUBSET_DIFF H1 ClosureSubset SET_RULE [∀s t A. s ⊂ t ⇒ (A â” t) ∩ s = ∅]; qed; intro_TAC H2, ∀[t], tOpen tNonempty; consider u such that open_in α u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅ [uExists] by simplify tOpen tNonempty H2; MP_TAC ISPECL [α; u; s] OpenInterClosureEqEmpty; simplify uExists OPEN_IN_SUBSET H1; set uExists; qed; `;; let InteriorClosureInterOpen = theorem `; ∀α s t. open_in α s ∧ open_in α t ⇒ Interior α (Closure α (s ∩ t)) = Interior α (Closure α s) ∩ Interior α (Closure α t) proof intro_TAC ∀α s t, sOpen tOpen; s ⊂ topspace α [sTop] by fol sOpen OPEN_IN_SUBSET; t ⊂ topspace α [tTop] by fol tOpen OPEN_IN_SUBSET; rewrite SET_RULE [∀s t u. u = s ∩ t ⇔ s ∩ t ⊂ u ∧ u ⊂ s ∧ u ⊂ t]; simplify sTop tTop INTER_SUBSET SubsetClosure ClosureTopspace SubsetInterior; s ∩ t ⊂ topspace α [stTop] by fol INTER_SUBSET sTop SUBSET_TRANS; Closure α s ⊂ topspace α ∧ Closure α t ⊂ topspace α [CsCtTop] by fol sTop tTop ClosureTopspace; Closure α s ∩ Closure α t ⊂ topspace α [CsIntCtTop] by fol - INTER_SUBSET SUBSET_TRANS; Closure α s â” s ∪ Closure α t â” t ⊂ topspace α [Cs_sUNIONCt_tTop] by fol CsCtTop SUBSET_DIFF UNION_SUBSET SUBSET_TRANS; simplify CsCtTop GSYM InteriorInter; Interior α (Closure α s ∩ Closure α t) ⊂ Closure α (s ∩ t) [] proof simplify CsIntCtTop InteriorTopspace ISPECL [topspace α] COMPLEMENT_DISJOINT stTop ClosureTopspace GSYM ClosureComplement GSYM InteriorComplement CsIntCtTop SUBSET_DIFF GSYM InteriorInter; closed_in α (Closure α s â” s) ∧ closed_in α (Closure α t â” t) [] by fol sTop tTop ClosedClosure sOpen tOpen CLOSED_IN_DIFF; Interior α (Closure α s â” s ∪ Closure α t â” t) = ∅ [IntEmpty] by fol Cs_sUNIONCt_tTop - sTop tTop InteriorClosureDiffSpaceEmpty InteriorUnionEqEmpty; Closure α s ∩ Closure α t ∩ (topspace α â” (s ∩ t)) ⊂ Closure α s â” s ∪ Closure α t â” t [] by set; fol Cs_sUNIONCt_tTop - SubsetInterior IntEmpty INTER_ACI SUBSET_EMPTY; qed; fol stTop ClosureTopspace - CsIntCtTop OpenInterior InteriorMaximal; qed; `;; let ClosureInteriorUnionClosed = theorem `; ∀α s t. closed_in α s ∧ closed_in α t ⇒ Closure α (Interior α (s ∪ t)) = Closure α (Interior α s) ∪ Closure α (Interior α t) proof rewrite closed_in; intro_TAC ∀α s t, sClosed tClosed; simplify sClosed tClosed ClosureTopspace UNION_SUBSET InteriorTopspace ISPECL [topspace α] COMPLEMENT_DUALITY_UNION; simplify sClosed tClosed UNION_SUBSET ClosureTopspace InteriorTopspace ClosureInteriorComplement DIFF_UNION SUBSET_DIFF InteriorClosureInterOpen; qed; `;; let RegularOpenInter = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α (Closure α s) = s ∧ Interior α (Closure α t) = t ⇒ Interior α (Closure α (s ∩ t)) = s ∩ t by fol ClosureTopspace OpenInterior InteriorClosureInterOpen`;; let RegularClosedUnion = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Closure α (Interior α s) = s ∧ Closure α (Interior α t) = t ⇒ Closure α (Interior α (s ∪ t)) = s ∪ t by fol InteriorTopspace ClosureInteriorUnionClosed ClosedClosure`;; let DiffClosureSubset = theorem `; ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Closure α s â” Closure α t ⊂ Closure α (s â” t) proof intro_TAC ∀α s t, sTop tTop; Closure α s â” Closure α t ⊂ Closure α (s â” Closure α t) [] by fol sTop ClosureTopspace tTop ClosedClosure tTop closed_in OpenInterClosureSubset INTER_COMM COMPLEMENT_INTER_DIFF; fol - tTop ClosureSubset SUBSET_DUALITY sTop SUBSET_DIFF SUBSET_TRANS SubsetClosure; qed; `;; let Frontier_DEF = NewDefinition `; ∀α s. Frontier α s = Closure α s â” Interior α s`;; let Frontier_THM = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α s = Closure α s â” Interior α s by fol Frontier_DEF`;; let FrontierTopspace = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α s ⊂ topspace α by fol Frontier_THM SUBSET_DIFF ClosureTopspace SUBSET_TRANS`;; let FrontierClosed = theorem `; ∀α s. s ⊂ topspace α ⇒ closed_in α (Frontier α s) by simplify Frontier_THM ClosedClosure OpenInterior CLOSED_IN_DIFF`;; let FrontierClosures = theorem `; ∀s. s ⊂ topspace α ⇒ Frontier α s = (Closure α s) ∩ (Closure α (topspace α â” s)) by simplify SET_RULE [∀A s t. s ⊂ A ∧ t ⊂ A ⇒ s â” (A â” t) = s ∩ t] Frontier_THM InteriorClosure ClosureTopspace SUBSET_DIFF`;; let FrontierStraddle = theorem `; ∀α a s. s ⊂ topspace α ⇒ (a ∈ Frontier α s ⇔ a ∈ topspace α ∧ ∀t. open_in α t ∧ a ∈ t ⇒ (∃x. x ∈ s ∧ x ∈ t) ∧ (∃x. ¬(x ∈ s) ∧ x ∈ t)) proof simplify SUBSET_DIFF FrontierClosures IN_INTER SUBSET_DIFF IN_Closure IN_DIFF; fol OPEN_IN_SUBSET SUBSET; qed; `;; let FrontierSubsetClosed = theorem `; ∀α s. closed_in α s ⇒ (Frontier α s) ⊂ s by fol closed_in Frontier_THM ClosureClosed SUBSET_DIFF`;; let FrontierEmpty = theorem `; ∀α. Frontier α ∅ = ∅ by fol Frontier_THM EMPTY_SUBSET ClosureEmpty EMPTY_DIFF`;; let FrontierUniv = theorem `; ∀α. Frontier α (topspace α) = ∅ by fol Frontier_DEF ClosureUniv InteriorUniv DIFF_EQ_EMPTY`;; let FrontierSubsetEq = theorem `; ∀α s. s ⊂ topspace α ⇒ ((Frontier α s) ⊂ s ⇔ closed_in α s) proof intro_TAC ∀α s, sTop; eq_tac [Right] by fol FrontierSubsetClosed; simplify sTop Frontier_THM ; fol sTop InteriorSubset SET_RULE [∀s t u. s â” t ⊂ u ∧ t ⊂ u ⇒ s ⊂ u] ClosureSubsetEq; qed; `;; let FrontierComplement = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α (topspace α â” s) = Frontier α s proof intro_TAC ∀α s, sTop; simplify sTop SUBSET_DIFF Frontier_THM ClosureComplement InteriorComplement; fol sTop InteriorTopspace ClosureTopspace SET_RULE [∀ Top Int Clo. Int ⊂ Top ∧ Clo ⊂ Top ⇒ Top â” Int â” (Top â” Clo) = Clo â” Int]; qed; `;; let FrontierComplement = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α (topspace α â” s) = Frontier α s proof intro_TAC ∀α s, sTop; simplify sTop SUBSET_DIFF Frontier_THM ClosureComplement InteriorComplement; fol sTop InteriorTopspace ClosureTopspace SET_RULE [∀ Top Int Clo. Int ⊂ Top ∧ Clo ⊂ Top ⇒ Top â” Int â” (Top â” Clo) = Clo â” Int]; qed; `;; let FrontierDisjointEq = theorem `; ∀α s. s ⊂ topspace α ⇒ ((Frontier α s) ∩ s = ∅ ⇔ open_in α s) proof intro_TAC ∀α s, sTop; topspace α â” s ⊂ topspace α [COMPsTop] by fol sTop SUBSET_DIFF; simplify sTop GSYM FrontierComplement OPEN_IN_CLOSED_IN; fol COMPsTop GSYM FrontierSubsetEq FrontierTopspace SUBSET_COMPLEMENT; qed; `;; let FrontierInterSubset = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∩ t) ⊂ Frontier α s ∪ Frontier α t proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; simplify - Frontier_THM InteriorInter DIFF_INTER INTER_SUBSET SubsetClosure DIFF_SUBSET UNION_TENSOR; qed; `;; let FrontierUnionSubset = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∪ t) ⊂ Frontier α s ∪ Frontier α t proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION SUBSET_TRANS; simplify H1 - GSYM FrontierComplement DIFF_UNION; topspace α â” s ∪ topspace α â” t ⊂ topspace α [] by fol SUBSET_DIFF UNION_SUBSET SUBSET_TRANS; fol - FrontierInterSubset; qed; `;; let FrontierInteriors = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α s = topspace α â” Interior α s â” Interior α (topspace α â” s) by simplify Frontier_THM ClosureInterior DOUBLE_DIFF_UNION UNION_COMM`;; let FrontierFrontierSubset = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α (Frontier α s) ⊂ Frontier α s by fol FrontierTopspace Frontier_THM FrontierClosed ClosureClosed SUBSET_DIFF`;; let InteriorFrontier = theorem `; ∀α s. s ⊂ topspace α ⇒ Interior α (Frontier α s) = Interior α (Closure α s) â” Closure α (Interior α s) proof intro_TAC ∀α s, sTop; Frontier α s = Closure α s ∩ (topspace α â” Interior α s) [] by fol sTop Frontier_THM ClosureTopspace COMPLEMENT_INTER_DIFF; Interior α (Frontier α s) = Interior α (Closure α s) ∩ (topspace α â” Closure α (Interior α s)) [] by fol - sTop ClosureTopspace InteriorTopspace SUBSET_DIFF InteriorInter InteriorComplement; fol - sTop ClosureTopspace InteriorTopspace COMPLEMENT_INTER_DIFF; qed; `;; let InteriorFrontierEmpty = theorem `; ∀α s. open_in α s ∨ closed_in α s ⇒ Interior α (Frontier α s) = ∅ by fol InteriorFrontier SET_RULE [∀s t. s â” t = ∅ ⇔ s ⊂ t] OPEN_IN_SUBSET closed_in InteriorOpen ClosureTopspace InteriorSubset ClosureClosed InteriorTopspace ClosureSubset`;; let FrontierFrontier = theorem `; ∀α s. open_in α s ∨ closed_in α s ⇒ Frontier α (Frontier α s) = Frontier α s proof intro_TAC ∀α s, openORclosed; s ⊂ topspace α [sTop] by fol openORclosed OPEN_IN_SUBSET closed_in; Frontier α (Frontier α s) = Closure α (Frontier α s) [] by fol sTop FrontierTopspace Frontier_THM openORclosed InteriorFrontierEmpty DIFF_EMPTY; fol - sTop FrontierClosed ClosureClosed; qed; `;; let UnionFrontierPart1 = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α s ∩ Interior α t ⊂ Frontier α (s ∩ t) proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; rewrite SUBSET IN_INTER; intro_TAC ∀[a], aFs aIt; consider O such that open_in α O ∧ a ∈ O ∧ O ⊂ t [aOs] by fol aIt stTop IN_Interior; a ∈ topspace α [] by fol stTop aFs FrontierTopspace SUBSET; simplify stTop FrontierStraddle -; intro_TAC ∀[P], Popen aP; a ∈ O ∩ P ∧ open_in α (O ∩ P) [aOPopen] by fol aOs aP IN_INTER Popen OPEN_IN_INTER; consider x y such that x ∈ s ∧ x ∈ O ∩ P ∧ ¬(y ∈ s) ∧ y ∈ O ∩ P [xExists] by fol aOs Popen OPEN_IN_INTER aOPopen stTop aFs FrontierStraddle; fol xExists aOs IN_INTER SUBSET; qed; `;; let UnionFrontierPart2 = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α s â” Frontier α t ⊂ Frontier α (s ∩ t) ∪ Frontier α (s ∪ t) proof intro_TAC ∀α s t, stTop; s ⊂ topspace α ∧ t ⊂ topspace α [] by fol stTop SUBSET_UNION INTER_SUBSET SUBSET_TRANS; Frontier α s â” Frontier α t = Frontier α s ∩ Interior α t ∪ Frontier α (topspace α â” s) ∩ Interior α (topspace α â” t) [] by fol - FrontierTopspace FrontierInteriors FrontierComplement SET_RULE [∀A s t u. s ⊂ A ⇒ s â” (A â” t â” u) = s ∩ t ∪ s ∩ u]; Frontier α s â” Frontier α t ⊂ Frontier α (s ∩ t) ∪ Frontier α (topspace α â” (s ∪ t)) [] by simplify - stTop UnionFrontierPart1 UNION_TENSOR SUBSET_DIFF UNION_SUBSET DIFF_UNION; fol - stTop FrontierComplement; qed; `;; let UnionFrontierPart3 = theorem `; ∀α s t a. s ∪ t ⊂ topspace α ⇒ a ∈ Frontier α s ∧ a ∉ Frontier α t ⇒ a ∈ Frontier α (s ∩ t) ∨ a ∈ Frontier α (s ∪ t) proof intro_TAC ∀α s t a, H1; rewrite ∉ GSYM IN_INTER GSYM IN_DIFF GSYM IN_UNION; fol H1 UnionFrontierPart2 SUBSET; qed; `;; let UnionFrontier = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α s ∪ Frontier α t = Frontier α (s ∪ t) ∪ Frontier α (s ∩ t) ∪ Frontier α s ∩ Frontier α t proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; rewrite GSYM SUBSET_ANTISYM_EQ; conj_tac [Right] by fol SET_RULE [∀s t. s ∩ t ⊂ s ∪ t] stTop FrontierUnionSubset UNION_SUBSET FrontierInterSubset; rewrite SUBSET IN_INTER IN_UNION; fol H1 UnionFrontierPart3 INTER_COMM UNION_COMM ∉; qed; `;; let ConnectedInterFrontier = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Connected (subtopology α s) ∧ ¬(s ∩ t = ∅) ∧ ¬(s â” t = ∅) ⇒ ¬(s ∩ Frontier α t = ∅) proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION SUBSET_TRANS; ONCE_REWRITE_TAC TAUT [∀a b c d. a ∧ b ∧ c ⇒ ¬d ⇔ b ∧ c ∧ d ⇒ ¬a]; intro_TAC sINTERtNonempty sDIFFtNonempty sInterFtEmpty; simplify stTop ConnectedOpenIn; exists_TAC s ∩ Interior α t; exists_TAC s ∩ Interior α (topspace α â” t); simplify stTop SUBSET_DIFF OpenInterior OpenInOpenInter; Interior α t ⊂ t ∧ Interior α (topspace α â” t) ⊂ topspace α â” t [IntSubs] by fol stTop SUBSET_DIFF InteriorSubset; s ⊂ Interior α t ∪ Interior α (topspace α â” t) [] by fol stTop sInterFtEmpty FrontierInteriors DOUBLE_DIFF_UNION COMPLEMENT_DISJOINT; set sDIFFtNonempty sINTERtNonempty IntSubs -; qed; `;; let InteriorClosedEqEmptyAsFrontier = theorem `; ∀α s. s ⊂ topspace α ⇒ (closed_in α s ∧ Interior α s = ∅ ⇔ ∃t. open_in α t ∧ s = Frontier α t) proof intro_TAC ∀α s, sTop; eq_tac [Right] by fol OPEN_IN_SUBSET FrontierClosed InteriorFrontierEmpty; intro_TAC sClosed sEmptyInt; exists_TAC topspace α â” s; fol sClosed closed_in sTop FrontierComplement Frontier_THM sEmptyInt DIFF_EMPTY ClosureClosed; qed; `;; let ClosureUnionFrontier = theorem `; ∀α s. s ⊂ topspace α ⇒ Closure α s = s ∪ Frontier α s proof intro_TAC ∀α s, sTop; simplify sTop Frontier_THM; s ⊂ Closure α s ∧ Interior α s ⊂ s [] by fol sTop ClosureSubset InteriorSubset; set -; qed; `;; let FrontierInteriorSubset = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α (Interior α s) ⊂ Frontier α s by simplify InteriorTopspace Frontier_THM InteriorInterior InteriorSubset SubsetClosure DIFF_SUBSET`;; let FrontierClosureSubset = theorem `; ∀α s. s ⊂ topspace α ⇒ Frontier α (Closure α s) ⊂ Frontier α s by simplify ClosureTopspace Frontier_THM ClosureClosure ClosureTopspace ClosureSubset SubsetInterior SUBSET_DUALITY`;; let SetDiffFrontier = theorem `; ∀α s. s ⊂ topspace α ⇒ s â” Frontier α s = Interior α s proof intro_TAC ∀α s, sTop; simplify sTop Frontier_THM; s ⊂ Closure α s ∧ Interior α s ⊂ s [] by fol sTop ClosureSubset InteriorSubset; set -; qed; `;; let FrontierInterSubsetInter = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∩ t) ⊂ Closure α s ∩ Frontier α t ∪ Frontier α s ∩ Closure α t proof intro_TAC ∀α s t, H1; s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; simplify H1 stTop Frontier_THM InteriorInter; Closure α (s ∩ t) ⊂ Closure α s ∩ Closure α t [] by fol stTop ClosureInterSubset; set -; qed; `;; let FrontierUnionPart1 = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ ⇒ Frontier α s ∩ Interior α (s ∪ t) = ∅ proof intro_TAC ∀α s t, H1, CsCtDisjoint; s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; Frontier α s ∩ Interior α (s ∪ t) ⊂ topspace α [FIstTop] by fol stTop FrontierTopspace INTER_SUBSET SUBSET_TRANS; Frontier α s ∩ Interior α (s ∪ t) ∩ (topspace α â” Closure α t) = ∅ [] proof simplify stTop GSYM InteriorComplement H1 SUBSET_DIFF InteriorInter Frontier_THM; Interior α (s ∪ t) ∩ Interior α (topspace α â” t) ⊂ Interior α s [] by fol SET_RULE [∀A s t. s ⊂ A ⇒ (s ∪ t) ∩ (A â” t) = s â” t] H1 SUBSET_DIFF InteriorInter stTop SubsetInterior; set -; qed; Frontier α s ∩ Interior α (s ∪ t) ⊂ Closure α t [] by fol H1 CsCtDisjoint - FIstTop COMPLEMENT_DISJOINT INTER_ACI; fol SET_RULE [∀ s t F I. s ∩ t = ∅ ∧ F ⊂ s ∧ F ∩ I ⊂ t ⇒ F ∩ I = ∅] CsCtDisjoint stTop Frontier_THM SUBSET_DIFF -; qed; `;; let FrontierUnion = theorem `; ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ ⇒ Frontier α (s ∪ t) = Frontier α s ∪ Frontier α t proof intro_TAC ∀α s t, H1, CsCtDisjoint; s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; MATCH_MP_TAC SUBSET_ANTISYM; simplify H1 FrontierUnionSubset Frontier_THM; Frontier α s ∩ Interior α (s ∪ t) = ∅ ∧ Frontier α t ∩ Interior α (s ∪ t) = ∅ [usePart1] by fol H1 CsCtDisjoint FrontierUnionPart1 INTER_COMM UNION_COMM; Frontier α s ⊂ Closure α (s ∪ t) ∧ Frontier α t ⊂ Closure α (s ∪ t) [] by fol stTop Frontier_THM SUBSET_DIFF H1 SUBSET_UNION SubsetClosure SUBSET_TRANS; set usePart1 -; qed; `;; (* ------------------------------------------------------------------------- *) (* The universal Euclidean versions are what we use most of the time. *) (* ------------------------------------------------------------------------- *) let open_def = NewDefinition `; open s ⇔ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ ∀x'. dist(x',x) < e ⇒ x' ∈ s`;; let closed = NewDefinition `; closed s ⇔ open (UNIV â” s)`;; let euclidean = new_definition `euclidean = mk_topology (UNIV, open)`;; let OPEN_EMPTY = theorem `; open ∅ by rewrite open_def NOT_IN_EMPTY`;; let OPEN_UNIV = theorem `; open UNIV by fol open_def IN_UNIV REAL_LT_01`;; let OPEN_INTER = theorem `; ∀s t. open s ∧ open t ⇒ open (s ∩ t) proof intro_TAC ∀s t, sOpen tOpen; rewrite open_def IN_INTER; intro_TAC ∀x, xs xt; consider d1 such that &0 < d1 ∧ ∀x'. dist (x',x) < d1 ⇒ x' ∈ s [d1Exists] by fol sOpen xs open_def; consider d2 such that &0 < d2 ∧ ∀x'. dist (x',x) < d2 ⇒ x' ∈ t [d2Exists] by fol tOpen xt open_def; consider e such that &0 < e /\ e < d1 /\ e < d2 [eExists] by fol d1Exists d2Exists REAL_DOWN2; fol - d1Exists d2Exists REAL_LT_TRANS; qed; `;; let OPEN_UNIONS = theorem `; (∀s. s ∈ f ⇒ open s) ⇒ open (UNIONS f) by fol open_def IN_UNIONS`;; let IstopologyEuclidean = theorem `; istopology (UNIV, open) by simplify istopology IN IN_UNIV SUBSET OPEN_EMPTY OPEN_UNIV OPEN_INTER OPEN_UNIONS`;; let OPEN_IN = theorem `; open = open_in euclidean by fol euclidean topology_tybij IstopologyEuclidean TopologyPAIR PAIR_EQ`;; let TOPSPACE_EUCLIDEAN = theorem `; topspace euclidean = UNIV by fol euclidean IstopologyEuclidean topology_tybij TopologyPAIR PAIR_EQ`;; let OPEN_EXISTS_IN = theorem `; ∀P Q. (∀a. P a ⇒ open {x | Q a x}) ⇒ open {x | ∃a. P a ∧ Q a x} by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OPEN_IN_EXISTS_IN`;; let OPEN_EXISTS = theorem `; ∀Q. (∀a. open {x | Q a x}) ⇒ open {x | ∃a. Q a x} proof intro_TAC ∀Q; (∀a. T ⇒ open {x | Q a x}) ⇒ open {x | ∃a. T ∧ Q a x} [] by simplify OPEN_EXISTS_IN; MP_TAC -; fol; qed; `;; let TOPSPACE_EUCLIDEAN_SUBTOPOLOGY = theorem `; ∀s. topspace (subtopology euclidean s) = s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN TopspaceSubtopology`;; let OPEN_IN_REFL = theorem `; ∀s. open_in (subtopology euclidean s) s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInRefl`;; let CLOSED_IN_REFL = theorem `; ∀s. closed_in (subtopology euclidean s) s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInRefl`;; let CLOSED_IN = theorem `; ∀s. closed = closed_in euclidean by fol closed closed_in TOPSPACE_EUCLIDEAN OPEN_IN SUBSET_UNIV EXTENSION IN`;; let OPEN_UNION = theorem `; ∀s t. open s ∧ open t ⇒ open(s ∪ t) by fol OPEN_IN OPEN_IN_UNION`;; let OPEN_SUBOPEN = theorem `; ∀s. open s ⇔ ∀x. x ∈ s ⇒ ∃t. open t ∧ x ∈ t ∧ t ⊂ s by fol OPEN_IN OPEN_IN_SUBOPEN`;; let CLOSED_EMPTY = theorem `; closed ∅ by fol CLOSED_IN CLOSED_IN_EMPTY`;; let CLOSED_UNIV = theorem `; closed UNIV by fol CLOSED_IN TOPSPACE_EUCLIDEAN CLOSED_IN_TOPSPACE`;; let CLOSED_UNION = theorem `; ∀s t. closed s ∧ closed t ⇒ closed(s ∪ t) by fol CLOSED_IN CLOSED_IN_UNION`;; let CLOSED_INTER = theorem `; ∀s t. closed s ∧ closed t ⇒ closed(s ∩ t) by fol CLOSED_IN CLOSED_IN_INTER`;; let CLOSED_INTERS = theorem `; ∀f. (∀s. s ∈ f ⇒ closed s) ⇒ closed (INTERS f) by fol CLOSED_IN CLOSED_IN_INTERS INTERS_0 CLOSED_UNIV`;; let CLOSED_FORALL_IN = theorem `; ∀P Q. (∀a. P a ⇒ closed {x | Q a x}) ⇒ closed {x | ∀a. P a ⇒ Q a x} proof intro_TAC ∀P Q; case_split Pnonempty | Pempty by fol; suppose ¬(P = ∅); simplify CLOSED_IN Pnonempty CLOSED_IN_FORALL_IN; end; suppose P = ∅; {x | ∀a. P a ⇒ Q a x} = UNIV [] by set Pempty; simplify - CLOSED_UNIV; end; qed; `;; let CLOSED_FORALL = theorem `; ∀Q. (∀a. closed {x | Q a x}) ⇒ closed {x | ∀a. Q a x} proof intro_TAC ∀Q; (∀a. T ⇒ closed {x | Q a x}) ⇒ closed {x | ∀a. T ⇒ Q a x} [] by simplify CLOSED_FORALL_IN; MP_TAC -; fol; qed; `;; let OPEN_CLOSED = theorem `; ∀s. open s ⇔ closed(UNIV â” s) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN CLOSED_IN OPEN_IN_CLOSED_IN`;; let OPEN_DIFF = theorem `; ∀s t. open s ∧ closed t ⇒ open(s â” t) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN CLOSED_IN OPEN_IN_DIFF`;; let CLOSED_DIFF = theorem `; ∀s t. closed s ∧ open t ⇒ closed (s â” t) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN CLOSED_IN CLOSED_IN_DIFF`;; let OPEN_INTERS = theorem `; ∀s. FINITE s ∧ (∀t. t ∈ s ⇒ open t) ⇒ open (INTERS s) by fol OPEN_IN OPEN_IN_INTERS INTERS_0 OPEN_UNIV`;; let CLOSED_UNIONS = theorem `; ∀s. FINITE s ∧ (∀t. t ∈ s ⇒ closed t) ⇒ closed (UNIONS s) by fol CLOSED_IN CLOSED_IN_UNIONS`;; (* ------------------------------------------------------------------------- *) (* Open and closed balls and spheres. *) (* ------------------------------------------------------------------------- *) let ball = new_definition `ball(x,e) = {y | dist(x,y) < e}`;; let cball = new_definition `cball(x,e) = {y | dist(x,y) <= e}`;; let IN_BALL = theorem `; ∀x y e. y ∈ ball(x,e) ⇔ dist(x,y) < e by rewrite ball IN_ELIM_THM`;; let IN_CBALL = theorem `; ∀x y e. y ∈ cball(x, e) ⇔ dist(x, y) <= e by rewrite cball IN_ELIM_THM`;; let BALL_SUBSET_CBALL = theorem `; ∀x e. ball (x,e) ⊂ cball (x, e) proof rewrite IN_BALL IN_CBALL SUBSET; real_arithmetic; qed; `;; let OPEN_BALL = theorem `; ∀x e. open (ball (x,e)) proof rewrite open_def ball IN_ELIM_THM; fol DIST_SYM REAL_SUB_LT REAL_LT_SUB_LADD REAL_ADD_SYM REAL_LET_TRANS DIST_TRIANGLE; qed; `;; let CENTRE_IN_BALL = theorem `; ∀x e. x ∈ ball(x,e) ⇔ &0 < e by fol IN_BALL DIST_REFL`;; let OPEN_CONTAINS_BALL = theorem `; ∀s. open s ⇔ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ ball(x,e) ⊂ s by rewrite open_def SUBSET IN_BALL DIST_SYM`;; let HALF_CBALL_IN_BALL = theorem `; ∀e. &0 < e ⇒ &0 < e/ &2 ∧ e / &2 < e ∧ cball (x, e/ &2) ⊂ ball (x, e) proof intro_TAC ∀e, H1; &0 < e/ &2 ∧ e / &2 < e [] by real_arithmetic H1; fol - SUBSET IN_CBALL IN_BALL REAL_LET_TRANS; qed; `;; let OPEN_IN_CONTAINS_CBALL_LEMMA = theorem `; ∀t s x. x ∈ s ⇒ ((∃e. &0 < e ∧ ball (x, e) ∩ t ⊂ s) ⇔ (∃e. &0 < e ∧ cball (x, e) ∩ t ⊂ s)) by fol BALL_SUBSET_CBALL HALF_CBALL_IN_BALL INTER_TENSOR SUBSET_REFL SUBSET_TRANS`;; (* ------------------------------------------------------------------------- *) (* Basic "localization" results are handy for connectedness. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_OPEN = theorem `; ∀s u. open_in (subtopology euclidean u) s ⇔ ∃t. open t ∧ (s = u ∩ t) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenInSubtopology INTER_COMM`;; let OPEN_IN_INTER_OPEN = theorem `; ∀s t u. open_in (subtopology euclidean u) s ∧ open t ⇒ open_in (subtopology euclidean u) (s ∩ t) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenInSubtopologyInterOpen`;; let OPEN_IN_OPEN_INTER = theorem `; ∀u s. open s ⇒ open_in (subtopology euclidean u) (u ∩ s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenInOpenInter`;; let OPEN_OPEN_IN_TRANS = theorem `; ∀s t. open s ∧ open t ∧ t ⊂ s ⇒ open_in (subtopology euclidean s) t by fol OPEN_IN OpenOpenInTrans`;; let OPEN_SUBSET = theorem `; ∀s t. s ⊂ t ∧ open s ⇒ open_in (subtopology euclidean t) s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenSubset`;; let CLOSED_IN_CLOSED = theorem `; ∀s u. closed_in (subtopology euclidean u) s ⇔ ∃t. closed t ∧ (s = u ∩ t) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInSubtopology INTER_COMM`;; let CLOSED_SUBSET_EQ = theorem `; ∀u s. closed s ⇒ (closed_in (subtopology euclidean u) s ⇔ s ⊂ u) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedSubsetEq`;; let CLOSED_IN_INTER_CLOSED = theorem `; ∀s t u. closed_in (subtopology euclidean u) s ∧ closed t ⇒ closed_in (subtopology euclidean u) (s ∩ t) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInInterClosed`;; let CLOSED_IN_CLOSED_INTER = theorem `; ∀u s. closed s ⇒ closed_in (subtopology euclidean u) (u ∩ s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInClosedInter`;; let CLOSED_SUBSET = theorem `; ∀s t. s ⊂ t ∧ closed s ⇒ closed_in (subtopology euclidean t) s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedSubset`;; let OPEN_IN_SUBSET_TRANS = theorem `; ∀s t u. open_in (subtopology euclidean u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ open_in (subtopology euclidean t) s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN OpenInSubsetTrans`;; let CLOSED_IN_SUBSET_TRANS = theorem `; ∀s t u. closed_in (subtopology euclidean u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ closed_in (subtopology euclidean t) s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInSubsetTrans`;; let OPEN_IN_CONTAINS_BALL_LEMMA = theorem `; ∀t s x. x ∈ s ⇒ ((∃E. open E ∧ x ∈ E ∧ E ∩ t ⊂ s) ⇔ (∃e. &0 < e ∧ ball (x,e) ∩ t ⊂ s)) proof intro_TAC ∀ t s x, xs; eq_tac [Right] by fol CENTRE_IN_BALL OPEN_BALL; intro_TAC H2; consider a such that open a ∧ x ∈ a ∧ a ∩ t ⊂ s [aExists] by fol H2; consider e such that &0 < e ∧ ball(x,e) ⊂ a [eExists] by fol - OPEN_CONTAINS_BALL; fol aExists - INTER_SUBSET GSYM SUBSET_INTER SUBSET_TRANS; qed; `;; let OPEN_IN_CONTAINS_BALL = theorem `; ∀s t. open_in (subtopology euclidean t) s ⇔ s ⊂ t ∧ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ ball(x,e) ∩ t ⊂ s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN SubtopologyOpenInSubopen GSYM OPEN_IN GSYM OPEN_IN_CONTAINS_BALL_LEMMA`;; let OPEN_IN_CONTAINS_CBALL = theorem `; ∀s t. open_in (subtopology euclidean t) s ⇔ s ⊂ t ∧ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ cball(x,e) ∩ t ⊂ s by fol OPEN_IN_CONTAINS_BALL OPEN_IN_CONTAINS_CBALL_LEMMA`;; let open_in = theorem `; ∀u s. open_in (subtopology euclidean u) s ⇔ s ⊂ u ∧ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ ∀x'. x' ∈ u ∧ dist(x',x) < e ⇒ x' ∈ s by rewrite OPEN_IN_CONTAINS_BALL IN_INTER SUBSET IN_BALL CONJ_SYM DIST_SYM`;; (* ------------------------------------------------------------------------- *) (* These "transitivity" results are handy too. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_TRANS = theorem `; ∀s t u. open_in (subtopology euclidean t) s ∧ open_in (subtopology euclidean u) t ⇒ open_in (subtopology euclidean u) s proof intro_TAC ∀s t u; t ⊂ topspace euclidean ∧ u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - OPEN_IN OpenInTrans; qed; `;; let OPEN_IN_TRANS_EQ = theorem `; ∀s t. (∀u. open_in (subtopology euclidean t) u ⇒ open_in (subtopology euclidean s) t) ⇔ open_in (subtopology euclidean s) t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInTransEq`;; let OPEN_IN_OPEN_TRANS = theorem `; ∀u s. open_in (subtopology euclidean u) s ∧ open u ⇒ open s proof intro_TAC ∀u s, H1; u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - H1 OPEN_IN OpenInOpenTrans; qed; `;; let CLOSED_IN_TRANS = theorem `; ∀s t u. closed_in (subtopology euclidean t) s ∧ closed_in (subtopology euclidean u) t ⇒ closed_in (subtopology euclidean u) s proof intro_TAC ∀s t u; t ⊂ topspace euclidean ∧ u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - ClosedInSubtopologyTrans; qed; `;; let CLOSED_IN_TRANS_EQ = theorem `; ∀s t. (∀u. closed_in (subtopology euclidean t) u ⇒ closed_in (subtopology euclidean s) t) ⇔ closed_in (subtopology euclidean s) t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInSubtopologyTransEq`;; let CLOSED_IN_CLOSED_TRANS = theorem `; ∀s u. closed_in (subtopology euclidean u) s ∧ closed u ⇒ closed s proof intro_TAC ∀u s; u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - CLOSED_IN ClosedInClosedTrans; qed; `;; let OPEN_IN_SUBTOPOLOGY_INTER_SUBSET = theorem `; ∀s u v. open_in (subtopology euclidean u) (u ∩ s) ∧ v ⊂ u ⇒ open_in (subtopology euclidean v) (v ∩ s) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInSubtopologyInterSubset`;; let OPEN_IN_OPEN_EQ = theorem `; ∀s t. open s ⇒ (open_in (subtopology euclidean s) t ⇔ open t ∧ t ⊂ s) by fol OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInOpenEq`;; let CLOSED_IN_CLOSED_EQ = theorem `; ∀s t. closed s ⇒ (closed_in (subtopology euclidean s) t ⇔ closed t ∧ t ⊂ s) by fol CLOSED_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInClosedEq`;; (* ------------------------------------------------------------------------- *) (* Also some invariance theorems for relative topology. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_INJECTIVE_LINEAR_IMAGE = theorem `; ∀f s t. linear f ∧ (∀x y. f x = f y ⇒ x = y) ⇒ (open_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) ⇔ open_in (subtopology euclidean t) s) proof rewrite open_in FORALL_IN_IMAGE IMP_CONJ SUBSET; intro_TAC ∀f s t, H1, H2; ∀x s. f x ∈ IMAGE f s ⇔ x ∈ s [fInjMap] by set H2; rewrite -; ∀x y. f x - f y = f (x - y) [fSubLinear] by fol H1 LINEAR_SUB; consider B1 such that &0 < B1 ∧ ∀x. norm (f x) <= B1 * norm x [B1exists] by fol H1 LINEAR_BOUNDED_POS; consider B2 such that &0 < B2 ∧ ∀x. norm x * B2 <= norm (f x) [B2exists] by fol H1 H2 LINEAR_INJECTIVE_BOUNDED_BELOW_POS; AP_TERM_TAC; eq_tac [Left] proof intro_TAC H3, ∀x, xs; consider e such that &0 < e ∧ ∀x'. x' ∈ t ⇒ dist (f x',f x) < e ⇒ x' ∈ s [eExists] by fol H3 xs; exists_TAC e / B1; simplify REAL_LT_DIV eExists B1exists; intro_TAC ∀x', x't; ∀x. norm(f x) <= B1 * norm(x) ∧ norm(x) * B1 < e ⇒ norm(f x) < e [normB1] by real_arithmetic; simplify fSubLinear B1exists H3 eExists x't normB1 dist REAL_LT_RDIV_EQ; qed; intro_TAC H3, ∀x, xs; consider e such that &0 < e ∧ ∀x'. x' ∈ t ⇒ dist (x',x) < e ⇒ x' ∈ s [eExists] by fol H3 xs; exists_TAC e * B2; simplify REAL_LT_MUL eExists B2exists; intro_TAC ∀x', x't; ∀x. norm x <= norm (f x) / B2 ∧ norm(f x) / B2 < e ⇒ norm x < e [normB2] by real_arithmetic; simplify fSubLinear B2exists H3 eExists x't normB2 dist REAL_LE_RDIV_EQ REAL_LT_LDIV_EQ; qed; `;; add_linear_invariants [OPEN_IN_INJECTIVE_LINEAR_IMAGE];; let CLOSED_IN_INJECTIVE_LINEAR_IMAGE = theorem `; ∀f s t. linear f ∧ (∀x y. f x = f y ⇒ x = y) ⇒ (closed_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) ⇔ closed_in (subtopology euclidean t) s) proof rewrite closed_in TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; GEOM_TRANSFORM_TAC[]; qed; `;; add_linear_invariants [CLOSED_IN_INJECTIVE_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Subspace topology results only proved for Euclidean space. *) (* ------------------------------------------------------------------------- *) (* ISTOPLOGY_SUBTOPOLOGY can not be proved, as the definition of topology *) (* there is different from the one here. *) let OPEN_IN_SUBTOPOLOGY = theorem `; ∀u s. open_in (subtopology euclidean u) s ⇔ ∃t. open_in euclidean t ∧ s = t ∩ u by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInSubtopology`;; let TOPSPACE_SUBTOPOLOGY = theorem `; ∀u. topspace(subtopology euclidean u) = topspace euclidean ∩ u proof intro_TAC ∀u; u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - TopspaceSubtopology INTER_COMM SUBSET_INTER_ABSORPTION; qed; `;; let CLOSED_IN_SUBTOPOLOGY = theorem `; ∀u s. closed_in (subtopology euclidean u) s ⇔ ∃t. closed_in euclidean t ∧ s = t ∩ u by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closed_in ClosedInSubtopology`;; let OPEN_IN_SUBTOPOLOGY_REFL = theorem `; ∀u. open_in (subtopology euclidean u) u ⇔ u ⊂ topspace euclidean by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN_REFL`;; let CLOSED_IN_SUBTOPOLOGY_REFL = theorem `; ∀u. closed_in (subtopology euclidean u) u ⇔ u ⊂ topspace euclidean by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN_REFL`;; let SUBTOPOLOGY_UNIV = theorem `; subtopology euclidean UNIV = euclidean proof rewrite GSYM Topology_Eq; conj_tac [Left] by fol TOPSPACE_EUCLIDEAN TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; rewrite GSYM OPEN_IN OPEN_IN_OPEN INTER_UNIV; fol; qed; `;; let SUBTOPOLOGY_SUPERSET = theorem `; ∀s. topspace euclidean ⊂ s ⇒ subtopology euclidean s = euclidean by simplify TOPSPACE_EUCLIDEAN UNIV_SUBSET SUBTOPOLOGY_UNIV`;; let OPEN_IN_IMP_SUBSET = theorem `; ∀s t. open_in (subtopology euclidean s) t ⇒ t ⊂ s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInImpSubset`;; let CLOSED_IN_IMP_SUBSET = theorem `; ∀s t. closed_in (subtopology euclidean s) t ⇒ t ⊂ s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInImpSubset`;; let OPEN_IN_SUBTOPOLOGY_UNION = theorem `; ∀s t u. open_in (subtopology euclidean t) s ∧ open_in (subtopology euclidean u) s ⇒ open_in (subtopology euclidean (t ∪ u)) s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInSubtopologyUnion`;; let CLOSED_IN_SUBTOPOLOGY_UNION = theorem `; ∀s t u. closed_in (subtopology euclidean t) s ∧ closed_in (subtopology euclidean u) s ⇒ closed_in (subtopology euclidean (t ∪ u)) s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInSubtopologyUnion`;; (* ------------------------------------------------------------------------- *) (* Connectedness. *) (* ------------------------------------------------------------------------- *) let connected_DEF = NewDefinition `; connected s ⇔ Connected (subtopology euclidean s)`;; let connected = theorem `; ∀s. connected s ⇔ ¬(∃e1 e2. open e1 ∧ open e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅)) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF OPEN_IN ConnectedSubtopology`;; let CONNECTED_CLOSED = theorem `; ∀s. connected s ⇔ ¬(∃e1 e2. closed e1 ∧ closed e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅)) by simplify connected_DEF CLOSED_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF CLOSED_IN ConnectedClosedSubtopology`;; let CONNECTED_OPEN_IN = theorem `; ∀s. connected s ⇔ ¬(∃e1 e2. open_in (subtopology euclidean s) e1 ∧ open_in (subtopology euclidean s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF OPEN_IN ConnectedOpenIn`;; let CONNECTED_OPEN_IN_EQ = theorem `; ∀s. connected s ⇔ ¬(∃e1 e2. open_in (subtopology euclidean s) e1 ∧ open_in (subtopology euclidean s) e2 ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) by simplify connected_DEF Connected_DEF SUBSET_UNIV TOPSPACE_EUCLIDEAN TopspaceSubtopology EQ_SYM_EQ`;; let CONNECTED_CLOSED_IN = theorem `; ∀s. connected s ⇔ ¬(∃e1 e2. closed_in (subtopology euclidean s) e1 ∧ closed_in (subtopology euclidean s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF CLOSED_IN ConnectedClosedIn`;; let CONNECTED_CLOSED_IN_EQ = theorem `; ∀s. connected s ⇔ ¬(∃e1 e2. closed_in (subtopology euclidean s) e1 ∧ closed_in (subtopology euclidean s) e2 ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) by simplify connected_DEF ConnectedClosed SUBSET_UNIV TOPSPACE_EUCLIDEAN TopspaceSubtopology EQ_SYM_EQ`;; let CONNECTED_CLOPEN = theorem `; ∀s. connected s ⇔ ∀t. open_in (subtopology euclidean s) t ∧ closed_in (subtopology euclidean s) t ⇒ t = ∅ ∨ t = s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF ConnectedClopen TopspaceSubtopology`;; let CONNECTED_CLOSED_SET = theorem `; ∀s. closed s ⇒ (connected s ⇔ ¬(∃e1 e2. closed e1 ∧ closed e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) by simplify connected_DEF CLOSED_IN closed_in ConnectedClosedSet`;; let CONNECTED_OPEN_SET = theorem `; ∀s. open s ⇒ (connected s ⇔ ¬(∃e1 e2. open e1 ∧ open e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) by simplify connected_DEF OPEN_IN ConnectedOpenSet`;; let CONNECTED_EMPTY = theorem `; connected ∅ by rewrite connected_DEF ConnectedEmpty`;; let CONNECTED_SING = theorem `; ∀a. connected {a} proof intro_TAC ∀a; a ∈ topspace euclidean [] by fol IN_UNIV TOPSPACE_EUCLIDEAN; fol - ConnectedSing connected_DEF; qed; `;; let CONNECTED_UNIONS = theorem `; ∀P. (∀s. s ∈ P ⇒ connected s) ∧ ¬(INTERS P = ∅) ⇒ connected(UNIONS P) proof intro_TAC ∀P; ∀s. s ∈ P ⇒ s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - connected_DEF ConnectedUnions; qed; `;; let CONNECTED_UNION = theorem `; ∀s t. connected s ∧ connected t ∧ ¬(s ∩ t = ∅) ⇒ connected (s ∪ t) proof intro_TAC ∀s t; s ⊂ topspace euclidean ∧ t ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - connected_DEF ConnectedUnion; qed; `;; let CONNECTED_DIFF_OPEN_FROM_CLOSED = theorem `; ∀s t u. s ⊂ t ∧ t ⊂ u ∧ open s ∧ closed t ∧ connected u ∧ connected(t â” s) ⇒ connected(u â” s) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF OPEN_IN CLOSED_IN ConnectedDiffOpenFromClosed`;; let CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE = theorem `; ∀f f'. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ (∀s. s ∈ f ⇒ open s ∧ connected s ∧ ¬(s = ∅)) ∧ (∀s. s ∈ f' ⇒ open s ∧ connected s ∧ ¬(s = ∅)) ∧ UNIONS f = UNIONS f' ⇒ f = f' by rewrite connected_DEF OPEN_IN ConnectedDisjointUnionsOpenUnique`;; let CONNECTED_FROM_CLOSED_UNION_AND_INTER = theorem `; ∀s t. closed s ∧ closed t ∧ connected (s ∪ t) ∧ connected (s ∩ t) ⇒ connected s ∧ connected t proof intro_TAC ∀s t; s ∪ t ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - connected_DEF CLOSED_IN ConnectedFromClosedUnionAndInter; qed; `;; let CONNECTED_FROM_OPEN_UNION_AND_INTER = theorem `; ∀s t. open s ∧ open t ∧ connected (s ∪ t) ∧ connected (s ∩ t) ⇒ connected s ∧ connected t proof intro_TAC ∀s t; s ∪ t ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; fol - connected_DEF OPEN_IN ConnectedFromOpenUnionAndInter; qed; `;; (* ------------------------------------------------------------------------- *) (* Sort of induction principle for connected sets. *) (* ------------------------------------------------------------------------- *) let CONNECTED_INDUCTION = theorem `; ∀P Q s. connected s ∧ (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ ∃z. z ∈ t ∧ P z) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y) ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ∧ Q a ⇒ Q b proof intro_TAC ∀P Q s; s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; MP_TAC -; rewrite connected_DEF ConnectedInduction; qed; `;; let CONNECTED_EQUIVALENCE_RELATION_GEN_LEMMA = theorem `; ∀P R s. connected s ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ ∃z. z ∈ t ∧ P z) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y) ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b proof intro_TAC ∀P R s; s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; MP_TAC -; rewrite connected_DEF ConnectedEquivalenceRelationGen; qed; `;; let CONNECTED_EQUIVALENCE_RELATION_GEN = theorem `; ∀P R s. connected s ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ ∃z. z ∈ t ∧ P z) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y) ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b proof intro_TAC ∀P R s; MP_TAC ISPECL [P; R; s] CONNECTED_EQUIVALENCE_RELATION_GEN_LEMMA; fol; qed; `;; let CONNECTED_INDUCTION_SIMPLE = theorem `; ∀P s. connected s ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ ∀x y. x ∈ t ∧ y ∈ t ∧ P x ⇒ P y) ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ⇒ P b proof intro_TAC ∀P s; s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; MP_TAC -; rewrite connected_DEF ConnectedInductionSimple; qed; `;; let CONNECTED_EQUIVALENCE_RELATION = theorem `; ∀R s. connected s ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀a. a ∈ s ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ ∀x. x ∈ t ⇒ R a x) ⇒ ∀a b. a ∈ s ∧ b ∈ s ⇒ R a b proof intro_TAC ∀R s; s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; MP_TAC -; rewrite connected_DEF ConnectedEquivalenceRelation; qed; `;; (* ------------------------------------------------------------------------- *) (* Limit points. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("limit_point_of",(12,"right"));; let limit_point_of_DEF = NewDefinition `; x limit_point_of s ⇔ x ∈ LimitPointOf euclidean s`;; let limit_point_of = theorem `; x limit_point_of s ⇔ ∀t. x ∈ t ∧ open t ⇒ ∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV IN_LimitPointOf limit_point_of_DEF OPEN_IN`;; let LIMPT_SUBSET = theorem `; ∀x s t. x limit_point_of s ∧ s ⊂ t ⇒ x limit_point_of t by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN limit_point_of_DEF LimptSubset SUBSET`;; let CLOSED_LIMPT = theorem `; ∀s. closed s ⇔ ∀x. x limit_point_of s ⇒ x ∈ s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF CLOSED_IN ClosedLimpt SUBSET`;; let LIMPT_EMPTY = theorem `; ∀x. ¬(x limit_point_of ∅) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF GSYM ∉ LimptEmpty`;; let NO_LIMIT_POINT_IMP_CLOSED = theorem `; ∀s. ¬(∃x. x limit_point_of s) ⇒ closed s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF CLOSED_IN NoLimitPointImpClosed NOT_EXISTS_THM ∉`;; let LIMIT_POINT_UNION = theorem `; ∀s t x. x limit_point_of (s ∪ t) ⇔ x limit_point_of s ∨ x limit_point_of t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF LimitPointUnion EXTENSION IN_UNION`;; let LimitPointOf_euclidean = theorem `; ∀s. LimitPointOf euclidean s = {x | x limit_point_of s} by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF LimitPointOf IN_ELIM_THM EXTENSION`;; (* ------------------------------------------------------------------------- *) (* Interior of a set. *) (* ------------------------------------------------------------------------- *) let interior_DEF = NewDefinition `; interior = Interior euclidean`;; let interior = theorem `; ∀s. interior s = {x | ∃t. open t ∧ x ∈ t ∧ t ⊂ s} by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF Interior_DEF OPEN_IN`;; let INTERIOR_EQ = theorem `; ∀s. interior s = s ⇔ open s by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorEq EQ_SYM_EQ`;; let INTERIOR_OPEN = theorem `; ∀s. open s ⇒ interior s = s by fol interior_DEF OPEN_IN InteriorOpen`;; let INTERIOR_EMPTY = theorem `; interior ∅ = ∅ by fol interior_DEF OPEN_IN InteriorEmpty`;; let INTERIOR_UNIV = theorem `; interior UNIV = UNIV by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF InteriorUniv`;; let OPEN_INTERIOR = theorem `; ∀s. open (interior s) by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInterior`;; let INTERIOR_INTERIOR = theorem `; ∀s. interior (interior s) = interior s by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorInterior`;; let INTERIOR_SUBSET = theorem `; ∀s. interior s ⊂ s by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorSubset`;; let SUBSET_INTERIOR = theorem `; ∀s t. s ⊂ t ⇒ interior s ⊂ interior t by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN SubsetInterior`;; let INTERIOR_MAXIMAL = theorem `; ∀s t. t ⊂ s ∧ open t ⇒ t ⊂ interior s by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorMaximal`;; let INTERIOR_MAXIMAL_EQ = theorem `; ∀s t. open s ⇒ (s ⊂ interior t ⇔ s ⊂ t) by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorMaximalEq`;; let INTERIOR_UNIQUE = theorem `; ∀s t. t ⊂ s ∧ open t ∧ (∀t'. t' ⊂ s ∧ open t' ⇒ t' ⊂ t) ⇒ interior s = t by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorUnique`;; let IN_INTERIOR = theorem `; ∀x s. x ∈ interior s ⇔ ∃e. &0 < e ∧ ball(x,e) ⊂ s proof simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF IN_Interior GSYM OPEN_IN; fol OPEN_CONTAINS_BALL SUBSET_TRANS CENTRE_IN_BALL OPEN_BALL; qed; `;; let OPEN_SUBSET_INTERIOR = theorem `; ∀s t. open s ⇒ (s ⊂ interior t ⇔ s ⊂ t) by fol interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenSubsetInterior`;; let INTERIOR_INTER = theorem `; ∀s t. interior (s ∩ t) = interior s ∩ interior t by simplify interior_DEF SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorInter`;; let INTERIOR_FINITE_INTERS = theorem `; ∀s. FINITE s ⇒ interior (INTERS s) = INTERS (IMAGE interior s) proof intro_TAC ∀s, H1; assume ¬(s = ∅) [sNonempty] by simplify INTERS_0 IMAGE_CLAUSES INTERIOR_UNIV; simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN H1 sNonempty interior_DEF InteriorFiniteInters; qed; `;; let INTERIOR_FINITE_INTERS = theorem `; ∀s. FINITE s ⇒ interior (INTERS s) = INTERS (IMAGE interior s) proof intro_TAC ∀s, H1; assume s = ∅ [sEmpty] by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN H1 interior_DEF InteriorFiniteInters; rewrite INTERS_0 IMAGE_CLAUSES sEmpty INTERIOR_UNIV; qed; `;; let INTERIOR_INTERS_SUBSET = theorem `; ∀f. interior (INTERS f) ⊂ INTERS (IMAGE interior f) proof intro_TAC ∀f; assume f = ∅ [fEmpty] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF InteriorIntersSubset; rewrite INTERS_0 IMAGE_CLAUSES - INTERIOR_UNIV SUBSET_REFL; qed; `;; let UNION_INTERIOR_SUBSET = theorem `; ∀s t. interior s ∪ interior t ⊂ interior(s ∪ t) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF UnionInteriorSubset`;; let INTERIOR_EQ_EMPTY = theorem `; ∀s. interior s = ∅ ⇔ ∀t. open t ∧ t ⊂ s ⇒ t = ∅ by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF OPEN_IN InteriorEqEmpty`;; let INTERIOR_EQ_EMPTY_ALT = theorem `; ∀s. interior s = ∅ ⇔ ∀t. open t ∧ ¬(t = ∅) ⇒ ¬(t â” s = ∅) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF OPEN_IN InteriorEqEmptyAlt`;; let INTERIOR_UNIONS_OPEN_SUBSETS = theorem `; ∀s. UNIONS {t | open t ∧ t ⊂ s} = interior s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF OPEN_IN InteriorUnionsOpenSubsets`;; (* ------------------------------------------------------------------------- *) (* Closure of a set. *) (* ------------------------------------------------------------------------- *) let closure_DEF = NewDefinition `; closure = Closure euclidean`;; let closure = theorem `; ∀s. closure s = s UNION {x | x limit_point_of s} by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF LimitPointOf_euclidean Closure_THM`;; let CLOSURE_INTERIOR = theorem `; ∀s. closure s = UNIV â” interior (UNIV â” s) proof rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosureInterior; qed; `;; let INTERIOR_CLOSURE = theorem `; ∀s. interior s = UNIV â” (closure (UNIV â” s)) proof rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorClosure; qed; `;; let CLOSED_CLOSURE = theorem `; ∀s. closed (closure s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosedClosure`;; let CLOSURE_SUBSET = theorem `; ∀s. s ⊂ closure s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureSubset`;; let SUBSET_CLOSURE = theorem `; ∀s t. s ⊂ t ⇒ closure s ⊂ closure t by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF SubsetClosure`;; let CLOSURE_HULL = theorem `; ∀s. closure s = closed hull s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureHull`;; let CLOSURE_EQ = theorem `; ∀s. closure s = s ⇔ closed s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureEq`;; let CLOSURE_CLOSED = theorem `; ∀s. closed s ⇒ closure s = s by fol CLOSED_IN closure_DEF ClosureClosed`;; let CLOSURE_CLOSURE = theorem `; ∀s. closure (closure s) = closure s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureClosure`;; let CLOSURE_UNION = theorem `; ∀s t. closure (s ∪ t) = closure s ∪ closure t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureUnion`;; let CLOSURE_INTER_SUBSET = theorem `; ∀s t. closure (s ∩ t) ⊂ closure s ∩ closure t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureInterSubset`;; let CLOSURE_INTERS_SUBSET = theorem `; ∀f. closure (INTERS f) ⊂ INTERS (IMAGE closure f) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureIntersSubset`;; let CLOSURE_MINIMAL = theorem `; ∀s t. s ⊂ t ∧ closed t ⇒ closure s ⊂ t by fol CLOSED_IN closure_DEF ClosureMinimal`;; let CLOSURE_MINIMAL_EQ = theorem `; ∀s t. closed t ⇒ (closure s ⊂ t ⇔ s ⊂ t) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureMinimalEq`;; let CLOSURE_UNIQUE = theorem `; ∀s t. s ⊂ t ∧ closed t ∧ (∀t'. s ⊂ t' ∧ closed t' ⇒ t ⊂ t') ⇒ closure s = t by fol CLOSED_IN closure_DEF ClosureUnique`;; let CLOSURE_EMPTY = theorem `; closure ∅ = ∅ by fol closure_DEF ClosureEmpty`;; let CLOSURE_UNIV = theorem `; closure UNIV = UNIV by fol TOPSPACE_EUCLIDEAN closure_DEF ClosureUniv`;; let CLOSURE_UNIONS = theorem `; ∀f. FINITE f ⇒ closure (UNIONS f) = UNIONS {closure s | s ∈ f} by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF ClosureUnions`;; let CLOSURE_EQ_EMPTY = theorem `; ∀s. closure s = ∅ ⇔ s = ∅ by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF ClosureEqEmpty`;; let CLOSURE_SUBSET_EQ = theorem `; ∀s. closure s ⊂ s ⇔ closed s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF CLOSED_IN ClosureSubsetEq`;; let OPEN_INTER_CLOSURE_EQ_EMPTY = theorem `; ∀s t. open s ⇒ (s ∩ closure t = ∅ ⇔ s ∩ t = ∅) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF OPEN_IN OpenInterClosureEqEmpty`;; let OPEN_INTER_CLOSURE_SUBSET = theorem `; ∀s t. open s ⇒ s ∩ closure t ⊂ closure (s ∩ t) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF OPEN_IN OpenInterClosureSubset`;; let CLOSURE_OPEN_INTER_SUPERSET = theorem `; ∀s t. open s ∧ s ⊂ closure t ⇒ closure (s ∩ t) = closure s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF OPEN_IN ClosureOpenInterSuperset`;; let CLOSURE_COMPLEMENT = theorem `; ∀s. closure (UNIV â” s) = UNIV â” interior s proof rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosureComplement; qed; `;; let INTERIOR_COMPLEMENT = theorem `; ∀s. interior (UNIV â” s) = UNIV â” closure s proof rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorComplement; qed; `;; let CONNECTED_INTERMEDIATE_CLOSURE = theorem `; ∀s t. connected s ∧ s ⊂ t ∧ t ⊂ closure s ⇒ connected t by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF connected_DEF ConnectedIntermediateClosure`;; let CONNECTED_CLOSURE = theorem `; ∀s. connected s ⇒ connected (closure s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF connected_DEF ConnectedClosure`;; let CONNECTED_UNION_STRONG = theorem `; ∀s t. connected s ∧ connected t ∧ ¬(closure s ∩ t = ∅) ⇒ connected (s ∪ t) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF connected_DEF ConnectedUnionStrong`;; let INTERIOR_DIFF = theorem `; ∀s t. interior (s â” t) = interior s â” closure t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF InteriorDiff`;; let CLOSED_IN_LIMPT = theorem `; ∀s t. closed_in (subtopology euclidean t) s ⇔ s ⊂ t ∧ ∀x. x limit_point_of s ∧ x ∈ t ⇒ x ∈ s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF limit_point_of_DEF ClosedInLimpt_ALT`;; let CLOSED_IN_INTER_CLOSURE = theorem `; ∀s t. closed_in (subtopology euclidean s) t ⇔ s ∩ closure t = t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF limit_point_of_DEF ClosedInInterClosure`;; let INTERIOR_CLOSURE_IDEMP = theorem `; ∀s. interior (closure (interior (closure s))) = interior (closure s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF InteriorClosureIdemp`;; let CLOSURE_INTERIOR_IDEMP = theorem `; ∀s. closure (interior (closure (interior s))) = closure (interior s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF ClosureInteriorIdemp`;; let INTERIOR_CLOSED_UNION_EMPTY_INTERIOR = theorem `; ∀s t. closed s ∧ interior t = ∅ ⇒ interior (s ∪ t) = interior s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN interior_DEF InteriorClosedUnionEmptyInterior`;; let INTERIOR_UNION_EQ_EMPTY = theorem `; ∀s t. closed s ∨ closed t ⇒ (interior (s ∪ t) = ∅ ⇔ interior s = ∅ ∧ interior t = ∅) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN interior_DEF InteriorUnionEqEmpty`;; let NOWHERE_DENSE_UNION = theorem `; ∀s t. interior (closure (s ∪ t)) = ∅ ⇔ interior (closure s) = ∅ ∧ interior (closure t) = ∅ by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF NowhereDenseUnion`;; let NOWHERE_DENSE = theorem `; ∀s. interior (closure s) = ∅ ⇔ ∀t. open t ∧ ¬(t = ∅) ⇒ ∃u. open u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅ by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF closure_DEF OPEN_IN NowhereDense`;; let INTERIOR_CLOSURE_INTER_OPEN = theorem `; ∀s t. open s ∧ open t ⇒ interior (closure (s ∩ t)) = interior(closure s) ∩ interior (closure t) by simplify interior_DEF closure_DEF OPEN_IN InteriorClosureInterOpen`;; let CLOSURE_INTERIOR_UNION_CLOSED = theorem `; ∀s t. closed s ∧ closed t ⇒ closure (interior (s ∪ t)) = closure (interior s) ∪ closure (interior t) by simplify interior_DEF closure_DEF CLOSED_IN ClosureInteriorUnionClosed`;; let REGULAR_OPEN_INTER = theorem `; ∀s t. interior (closure s) = s ∧ interior (closure t) = t ⇒ interior (closure (s ∩ t)) = s ∩ t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF closure_DEF RegularOpenInter`;; let REGULAR_CLOSED_UNION = theorem `; ∀s t. closure (interior s) = s ∧ closure (interior t) = t ⇒ closure (interior (s ∪ t)) = s ∪ t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF closure_DEF RegularClosedUnion`;; let DIFF_CLOSURE_SUBSET = theorem `; ∀s t. closure s â” closure t ⊂ closure (s â” t) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF DiffClosureSubset`;; (* ------------------------------------------------------------------------- *) (* Frontier (aka boundary). *) (* ------------------------------------------------------------------------- *) let frontier_DEF = NewDefinition `; frontier = Frontier euclidean`;; let frontier = theorem `; ∀s. frontier s = (closure s) DIFF (interior s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF interior_DEF Frontier_THM`;; let FRONTIER_CLOSED = theorem `; ∀s. closed (frontier s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF CLOSED_IN FrontierClosed`;; let FRONTIER_CLOSURES = theorem `; ∀s. frontier s = (closure s) ∩ (closure (UNIV â” s)) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierClosures`;; let FRONTIER_STRADDLE = theorem `; ∀a s. a ∈ frontier s ⇔ ∀e. &0 < e ⇒ (∃x. x ∈ s ∧ dist(a,x) < e) ∧ (∃x. ¬(x ∈ s) ∧ dist(a,x) < e) proof simplify SUBSET_UNIV IN_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierStraddle GSYM OPEN_IN; fol IN_BALL SUBSET OPEN_CONTAINS_BALL CENTRE_IN_BALL OPEN_BALL; qed; `;; let FRONTIER_SUBSET_CLOSED = theorem `; ∀s. closed s ⇒ (frontier s) ⊂ s by fol frontier_DEF CLOSED_IN FrontierSubsetClosed`;; let FRONTIER_EMPTY = theorem `; frontier ∅ = ∅ by fol frontier_DEF FrontierEmpty`;; let FRONTIER_UNIV = theorem `; frontier UNIV = ∅ by fol frontier_DEF TOPSPACE_EUCLIDEAN FrontierUniv`;; let FRONTIER_SUBSET_EQ = theorem `; ∀s. (frontier s) ⊂ s ⇔ closed s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF CLOSED_IN FrontierSubsetEq`;; let FRONTIER_COMPLEMENT = theorem `; ∀s. frontier (UNIV â” s) = frontier s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierComplement`;; let FRONTIER_DISJOINT_EQ = theorem `; ∀s. (frontier s) ∩ s = ∅ ⇔ open s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF OPEN_IN FrontierDisjointEq`;; let FRONTIER_INTER_SUBSET = theorem `; ∀s t. frontier (s ∩ t) ⊂ frontier s ∪ frontier t by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierInterSubset`;; let FRONTIER_UNION_SUBSET = theorem `; ∀s t. frontier (s ∪ t) ⊂ frontier s ∪ frontier t by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierUnionSubset`;; let FRONTIER_INTERIORS = theorem `; frontier s = UNIV â” interior(s) â” interior(UNIV â” s) by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF interior_DEF FrontierInteriors`;; let FRONTIER_FRONTIER_SUBSET = theorem `; ∀s. frontier (frontier s) ⊂ frontier s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierFrontierSubset`;; let INTERIOR_FRONTIER = theorem `; ∀s. interior (frontier s) = interior (closure s) â” closure (interior s) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF frontier_DEF closure_DEF InteriorFrontier`;; let INTERIOR_FRONTIER_EMPTY = theorem `; ∀s. open s ∨ closed s ⇒ interior (frontier s) = ∅ by fol OPEN_IN CLOSED_IN interior_DEF frontier_DEF InteriorFrontierEmpty`;; let UNION_FRONTIER = theorem `; ∀s t. frontier s ∪ frontier t = frontier (s ∪ t) ∪ frontier (s ∩ t) ∪ frontier s ∩ frontier t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF UnionFrontier`;; let CONNECTED_INTER_FRONTIER = theorem `; ∀s t. connected s ∧ ¬(s ∩ t = ∅) ∧ ¬(s â” t = ∅) ⇒ ¬(s ∩ frontier t = ∅) by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF frontier_DEF ConnectedInterFrontier`;; let INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER = theorem `; ∀s. closed s ∧ interior s = ∅ ⇔ ∃t. open t ∧ s = frontier t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN interior_DEF OPEN_IN frontier_DEF InteriorClosedEqEmptyAsFrontier`;; let FRONTIER_UNION = theorem `; ∀s t. closure s ∩ closure t = ∅ ⇒ frontier (s ∪ t) = frontier s ∪ frontier t by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierUnion`;; let CLOSURE_UNION_FRONTIER = theorem `; ∀s. closure s = s ∪ frontier s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF frontier_DEF ClosureUnionFrontier`;; let FRONTIER_INTERIOR_SUBSET = theorem `; ∀s. frontier (interior s) ⊂ frontier s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF interior_DEF FrontierInteriorSubset`;; let FRONTIER_CLOSURE_SUBSET = theorem `; ∀s. frontier (closure s) ⊂ frontier s by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierClosureSubset`;; let SET_DIFF_FRONTIER = theorem `; ∀s. s â” frontier s = interior s by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF interior_DEF SetDiffFrontier`;; let FRONTIER_INTER_SUBSET_INTER = theorem `; ∀s t. frontier (s ∩ t) ⊂ closure s ∩ frontier t ∪ frontier s ∩ closure t by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierInterSubsetInter`;; hol-light/RichterHilbertAxiomGeometry/UniversalPropCartProd.ml000066400000000000000000000233321303454263000251760ustar00rootroot00000000000000(* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* Definitions of FunctionSpace and FunctionComposition. A proof that the *) (* Cartesian product satisfies the universal property that given functions *) (* α ∈ M → A and β ∈ M → B, there is a unique γ ∈ M → A ∠B whose *) (* projections to A and B are f and g. *) needs "RichterHilbertAxiomGeometry/readable.ml";; ParseAsInfix("∉",(11, "right"));; ParseAsInfix("âˆ",(20, "right"));; ParseAsInfix("∘",(20, "right"));; ParseAsInfix("→",(13,"right"));; (* ∉ |- ∀a l. a ∉ l ⇔ ¬(a ∈ l) CartesianProduct |- ∀X Y. X ∠Y = {x,y | x ∈ X ∧ y ∈ Y} FUNCTION |- ∀α. FUNCTION α ⇔ (∃f s t. α = t,f,s ∧ (∀x. x ∈ s ⇒ f x ∈ t) ∧ (∀x. x ∉ s ⇒ f x = (@y. T))) SOURCE |- ∀α. SOURCE α = SND (SND α) FUN |- ∀α. FUN α = FST (SND α) TARGET |- ∀α. TARGET α = FST α FunctionSpace |- ∀s t. s → t = {α | FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α} makeFunction |- ∀t f s. makeFunction t f s = t,(λx. if x ∈ s then f x else @y. T),s Projection1Function |- ∀X Y. Pi1 X Y = makeFunction X FST (X ∠Y) Projection2Function |- ∀X Y. Pi2 X Y = makeFunction Y SND (X ∠Y) FunctionComposition |- ∀α β. α ∘ β = makeFunction (TARGET α) (FUN α o FUN β) (SOURCE β) IN_CartesianProduct |- ∀X Y x y. x,y ∈ X ∠Y ⇔ x ∈ X ∧ y ∈ Y CartesianFstSnd |- ∀pair. pair ∈ X ∠Y ⇒ FST pair ∈ X ∧ SND pair ∈ Y FUNCTION_EQ |- ∀α β. FUNCTION α ∧ FUNCTION β ∧ SOURCE α = SOURCE β ∧ FUN α = FUN β ∧ TARGET α = TARGET β ⇒ α = β IN_FunctionSpace |- ∀s t α. α ∈ s → t ⇔ FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α makeFunction_EQ |- ∀f g s t. (∀x. x ∈ s ⇒ f x = g x) ⇒ makeFunction t f s = makeFunction t g s makeFunctionyieldsFUN |- ∀α g t f s. α = makeFunction t f s ∧ g = FUN α ⇒ ∀x. x ∈ s ⇒ f x = g x makeFunctionEq |- ∀α β f g s t. α = makeFunction t f s ∧ β = makeFunction t g s ∧ (∀x. x ∈ s ⇒ f x = g x) ⇒ α = β FunctionSpaceOnSource |- ∀α f s t. α ∈ s → t ∧ f = FUN α ⇒ (∀x. x ∈ s ⇒ f x ∈ t) FunctionSpaceOnOffSource |- ∀α f s t. α ∈ s → t ∧ f = FUN α ⇒ (∀x. x ∈ s ⇒ f x ∈ t) ∧ (∀x. x ∉ s ⇒ f x = (@y. T)) ImpliesTruncatedFunctionSpace |- ∀α s t f. α = makeFunction t f s ∧ (∀x. x ∈ s ⇒ f x ∈ t) ⇒ α ∈ s → t FunFunctionSpaceImplyFunction |- ∀α s t f. α ∈ s → t ∧ f = FUN α ⇒ α = makeFunction t f s UseFunctionComposition |- ∀α β u f t g s. α = makeFunction u f t ∧ β = makeFunction t g s ∧ β ∈ s → t ⇒ α ∘ β = makeFunction u (f o g) s PairProjectionFunctions |- ∀X Y. Pi1 X Y ∈ X ∠Y → X ∧ Pi2 X Y ∈ X ∠Y → Y UniversalPropertyProduct |- ∀M A B α β. α ∈ M → A ∧ β ∈ M → B ⇒ (∃!γ. γ ∈ M → A ∠B ∧ Pi1 A B ∘ γ = α ∧ Pi2 A B ∘ γ = β) *) let NOTIN = NewDefinition `; ∀a l. a ∉ l ⇔ ¬(a ∈ l)`;; let CartesianProduct = NewDefinition `; ∀X Y. X ∠Y = {x,y | x ∈ X ∧ y ∈ Y}`;; let FUNCTION = NewDefinition `; FUNCTION α ⇔ ∃f s t. α = (t, f, s) ∧ (∀x. x IN s ⇒ f x IN t) ∧ ∀x. x ∉ s ⇒ f x = @y. T`;; let SOURCE = NewDefinition `; SOURCE α = SND (SND α)`;; let FUN = NewDefinition `; FUN α = FST (SND α)`;; let TARGET = NewDefinition `; TARGET α = FST α`;; let FunctionSpace = NewDefinition `; ∀s t. s → t = {α | FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α}`;; let makeFunction = NewDefinition `; ∀t f s. makeFunction t f s = (t, (λx. if x ∈ s then f x else @y. T), s)`;; let Projection1Function = NewDefinition `; Pi1 X Y = makeFunction X FST (X ∠Y)`;; let Projection2Function = NewDefinition `; Pi2 X Y = makeFunction Y SND (X ∠Y)`;; let FunctionComposition = NewDefinition `; ∀α β. α ∘ β = makeFunction (TARGET α) (FUN α o FUN β) (SOURCE β)`;; let IN_CartesianProduct = theorem `; ∀X Y x y. x,y ∈ X ∠Y ⇔ x ∈ X ∧ y ∈ Y proof rewrite IN_ELIM_THM CartesianProduct; fol PAIR_EQ; qed; `;; let IN_CartesianProduct = theorem `; ∀X Y x y. x,y ∈ X ∠Y ⇔ x ∈ X ∧ y ∈ Y proof rewrite IN_ELIM_THM CartesianProduct; fol PAIR_EQ; qed; `;; let CartesianFstSnd = theorem `; ∀pair. pair ∈ X ∠Y ⇒ FST pair ∈ X ∧ SND pair ∈ Y by rewrite FORALL_PAIR_THM PAIR_EQ IN_CartesianProduct`;; let FUNCTION_EQ = theorem `; ∀α β. FUNCTION α ∧ FUNCTION β ∧ SOURCE α = SOURCE β ∧ FUN α = FUN β ∧ TARGET α = TARGET β ⇒ α = β by simplify FORALL_PAIR_THM FUNCTION SOURCE TARGET FUN PAIR_EQ`;; let IN_FunctionSpace = theorem `; ∀s t α. α ∈ s → t ⇔ FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α by rewrite IN_ELIM_THM FunctionSpace`;; let makeFunction_EQ = theorem `; ∀f g s t. (∀x. x ∈ s ⇒ f x = g x) ⇒ makeFunction t f s = makeFunction t g s by simplify makeFunction ∉ FUN_EQ_THM`;; let makeFunctionyieldsFUN = theorem `; ∀α g t f s. α = makeFunction t f s ∧ g = FUN α ⇒ ∀x. x ∈ s ⇒ f x = g x by simplify makeFunction FORALL_PAIR_THM FUN PAIR_EQ`;; let makeFunctionEq = theorem `; ∀α β f g s t. α = makeFunction t f s ∧ β = makeFunction t g s ∧ (∀x. x ∈ s ⇒ f x = g x) ⇒ α = β by simplify FORALL_PAIR_THM makeFunction PAIR_EQ`;; let FunctionSpaceOnSource = theorem `; ∀α f s t. α ∈ s → t ∧ f = FUN α ⇒ ∀x. x ∈ s ⇒ f x ∈ t proof rewrite FORALL_PAIR_THM IN_FunctionSpace FUNCTION SOURCE TARGET PAIR_EQ FUN; fol; qed; `;; let FunctionSpaceOnOffSource = theorem `; ∀α f s t. α ∈ s → t ∧ f = FUN α ⇒ (∀x. x ∈ s ⇒ f x ∈ t) ∧ ∀x. x ∉ s ⇒ f x = @y. T proof rewrite FORALL_PAIR_THM IN_FunctionSpace FUNCTION SOURCE TARGET PAIR_EQ FUN; fol; qed; `;; let ImpliesTruncatedFunctionSpace = theorem `; ∀α s t f. α = makeFunction t f s ∧ (∀x. x ∈ s ⇒ f x ∈ t) ⇒ α ∈ s → t proof rewrite FORALL_PAIR_THM IN_FunctionSpace makeFunction FUNCTION SOURCE TARGET NOTIN PAIR_EQ; fol; qed; `;; let FunFunctionSpaceImplyFunction = theorem `; ∀α s t f. α ∈ s → t ∧ f = FUN α ⇒ α = makeFunction t f s proof rewrite FORALL_PAIR_THM IN_FunctionSpace makeFunction FUNCTION SOURCE TARGET FUN NOTIN PAIR_EQ; fol FUN_EQ_THM; qed; `;; let UseFunctionComposition = theorem `; ∀α β u f t g s. α = makeFunction u f t ∧ β = makeFunction t g s ∧ β ∈ s → t ⇒ α _o_ β = makeFunction u (f o g) s proof rewrite FORALL_PAIR_THM makeFunction FunctionComposition SOURCE TARGET FUN BETA_THM o_THM IN_FunctionSpace FUNCTION SOURCE TARGET NOTIN PAIR_EQ; intro_TAC ∀[u'] [f'] [t'] [t1] [g1] [s1] [u] [f] [t] [g] [s], Hα Hβ Hβ_st Hs Ht; (∀x. x ∈ s ⇒ g x ∈ t) [g_st] by fol Hβ_st Hβ; simplify Hα GSYM Hs Hβ g_st; qed; `;; let PairProjectionFunctions = theorem `; ∀X Y. Pi1 X Y ∈ X ∠Y → X ∧ Pi2 X Y ∈ X ∠Y → Y proof intro_TAC ∀X Y; ∀pair. pair ∈ X ∠Y ⇒ FST pair ∈ X ∧ SND pair ∈ Y [] by fol CartesianFstSnd; fol Projection1Function Projection2Function - ImpliesTruncatedFunctionSpace; qed; `;; let UniversalPropertyProduct = theorem `; ∀M A B α β. α ∈ M → A ∧ β ∈ M → B ⇒ ∃!γ. γ ∈ M → A ∠B ∧ Pi1 A B ∘ γ = α ∧ Pi2 A B ∘ γ = β proof intro_TAC ∀M A B α β, H1; consider f g such that f = FUN α ∧ g = FUN β [fgExist] by fol; consider h such that h = λx. (f x,g x) [hExists] by fol; ∀x. x ∈ M ⇒ h x ∈ A ∠B [hProd] by fol hExists IN_CartesianProduct H1 fgExist FunctionSpaceOnSource; consider γ such that γ = makeFunction (A ∠B) h M [γExists] by fol; γ ∈ M → A ∠B [γFunSpace] by fol - hProd ImpliesTruncatedFunctionSpace; ∀x. x ∈ M ⇒ (FST o h) x = f x ∧ (SND o h) x = g x [h_fg] by simplify hExists PAIR o_THM; Pi1 A B ∘ γ = makeFunction A (FST o h) M ∧ Pi2 A B ∘ γ = makeFunction B (SND o h) M [] by fol Projection1Function Projection2Function γExists γFunSpace UseFunctionComposition; Pi1 A B ∘ γ = α ∧ Pi2 A B ∘ γ = β [γWorks] by fol - h_fg makeFunction_EQ H1 fgExist FunFunctionSpaceImplyFunction; ∀θ. θ ∈ M → A ∠B ∧ Pi1 A B ∘ θ = α ∧ Pi2 A B ∘ θ = β ⇒ θ = γ [] proof intro_TAC ∀θ, θWorks; consider k such that k = FUN θ [kExists] by fol; θ = makeFunction (A ∠B) k M [θFUNk] by fol θWorks - FunFunctionSpaceImplyFunction; α = makeFunction A (FST o k) M ∧ β = makeFunction B (SND o k) M [] by fol Projection1Function Projection2Function θFUNk θWorks UseFunctionComposition; ∀x. x ∈ M ⇒ f x = (FST o k) x ∧ g x = (SND o k) x [fg_k] by fol ISPECL [α; f; A; (FST o k); M] makeFunctionyieldsFUN ISPECL [β; g; B; (SND o k); M] makeFunctionyieldsFUN - fgExist; ∀x. x ∈ M ⇒ k x = ((FST o k) x, (SND o k) x) [] by fol PAIR o_THM; ∀x. x ∈ M ⇒ k x = (f x, g x) [] by fol - fg_k PAIR_EQ; fol hExists θFUNk γExists - makeFunctionEq; qed; fol γFunSpace γWorks - EXISTS_UNIQUE_THM; qed; `;; hol-light/RichterHilbertAxiomGeometry/error-checking.ml000066400000000000000000000254471303454263000236410ustar00rootroot00000000000000(* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* Examples showing error messages displayed by readable.ml when raising the *) (* exception Readable_fail, with some working examples interspersed. *) needs "RichterHilbertAxiomGeometry/readable.ml";; let s = "abc]edf" in Str.string_before s (FindMatch "\[" "\]" s);; let s = "123456[abc]lmn[op[abc]pq]rs!!!!!!!!!!]xyz" in Str.string_before s (FindMatch "\[" "\]" s);; (* val it : string = "abc]" val it : string = "123456[abc]lmn[op[abc]pq]rs!!!!!!!!!!]" *) let s = "123456[abc]lmn[op[abc]pq]rs!!!!!!!!!![]xyz" in Str.string_before s (FindMatch "\[" "\]" s);; (* Exception: No matching right bracket operator \] to left bracket operator \[ in xyz. *) let s = "123456[abc]lmn[op[a; b; c]pq]rs[];xyz" in Str.string_before s (FindSemicolon s);; let s = "123456[abc]lmn[op[a; b; c]pq]rs![]xyz" in Str.string_before s (FindSemicolon s);; (* val it : string = "123456[abc]lmn[op[a; b; c]pq]rs[]" Exception: No final semicolon in 123456[abc]lmn[op[a; b; c]pq]rs![]xyz. *) let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) proof intro_TAC !m n, H1; MP_TAC ISPECL [m; n; 1] MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; `;; (* 0..0..3..6..solved at 21 0..0..3..6..31..114..731..5973..solved at 6087 val MOD_MOD_REFL : thm = |- !m n. ~(n = 0) ==> m MOD n MOD n = m MOD n *) let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) proof INTRO_TAC !m n, H1; MP_TAC ISPECL [m; n; 1] MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; `;; (* Exception: Can't parse as a Proof: INTRO_TAC !m n, H1. *) let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) proof intro_TAC !m n, H1; MP_TAC ISPECL [m; n; 1] mod_mod; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; `;; (* Exception: Not a theorem: mod_mod. *) let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) proof intro_TAC !m n, H1; MP_TAC ISPECL MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; `;; (* Exception: termlist->thm->thm ISPECL not followed by term list in MOD_MOD. *) let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) proof intro_TAC !m n, H1; MP_TAC ISPECL m n 1] MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; `;; (* Exception: termlist->thm->thm ISPECL not followed by term list in m n 1] MOD_MOD. *) interactive_goal `;∀p q. p * p = 2 * q * q ⇒ q = 0 `;; interactive_proof `; MATCH_MP_TAC ; intro_TAC ∀p, A, ∀q, B; EVEN(p * p) ⇔ EVEN(2 * q * q) [] proof qed; `;; (* Exception: Empty theorem: . *) interactive_goal `;∀p q. p * p = 2 * q * q ⇒ q = 0 `;; interactive_proof `; MATCH_MP_TAC num_WF num_WF ; intro_TAC ∀p, A, ∀q, B; EVEN(p * p) ⇔ EVEN(2 * q * q) [] proof qed; `;; (* Exception: thm_tactic MATCH_MP_TAC not followed by a theorem, but instead num_WF num_WF . *) let EXP_2 = theorem `; ∀n:num. n EXP 2 = n * n by REWRITE BIT0_THM BIT1_THM EXP EXP_ADD MULT_CLAUSES ADD_CLAUSES`;; (* Exception: Not a proof: REWRITE BIT0_THM BIT1_THM EXP EXP_ADD MULT_CLAUSES ADD_CLAUSES. The problem is that REWRITE should be rewrite.*) let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) prooof intro_TAC !m n, H1; MP_TAC ISPECL [m; n; 1] MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; `;; (* Exception: Missing initial "proof", "by", or final "qed;" in !m n. ~(n = 0) ==> ((m MOD n) MOD n = m MOD n) prooof intro_TAC !m n, H1; MP_TAC ISPECL [m; n; 1] MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; . *) let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) proof intro_TAC !m n, H1; MP_TAC ISPECL [m; n; 1] MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; What me worry? `;; (* Exception: Trailing garbage after the proof...qed: What me worry? . Two examples from the ocaml reference manual sec 1.4 to show the handling of exceptions other than Readable_fail. *) exception Empty_list;; let head l = match l with [] -> raise Empty_list | hd :: tl -> hd;; head [1;2];; head [];; exception Unbound_variable of string;; type expression = Const of float | Var of string | Sum of expression * expression | Diff of expression * expression | Prod of expression * expression | Quot of expression * expression;; let rec eval env exp = match exp with Const c -> c | Var v -> (try List.assoc v env with Not_found -> raise(Unbound_variable v)) | Sum(f, g) -> eval env f +. eval env g | Diff(f, g) -> eval env f -. eval env g | Prod(f, g) -> eval env f *. eval env g | Quot(f, g) -> eval env f /. eval env g;; eval [("x", 1.0); ("y", 3.14)] (Prod(Sum(Var "x", Const 2.0), Var "y"));; eval [("x", 1.0); ("y", 3.14)] (Prod(Sum(Var "z", Const 2.0), Var "y"));; (* The only difference caused by printReadExn is that Exception: Unbound_variable "z". is now Exception: Unbound_variable("z"). *) let binom = define `(!n. binom(n,0) = 1) /\ (!k. binom(0,SUC(k)) = 0) /\ (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; let BINOM_LT = theorem `; ∀n k. n < k ⇒ binom(n,k) = 0 proof INDUCT_TAC; INDUCT_TAC; rewrite binom ARITH LT_SUC LT; ASM_SIMP_TAC ARITH_RULE [n < k ==> n < SUC(k)] ARITH; qed; `;; let BINOM_REFL = theorem `; ∀n. binom(n,n) = 1 proof INDUCT_TAC; ASM_SIMP_TAC binom BINOM_LT LT ARITH; qed; `;; let BINOMIAL_THEOREM = theorem `; ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) proof ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; MATCH_MP_TAC num_INDUCTION; simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; intro_TAC ∀n, nThm; rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; rewriteR ADD_SYM; rewriteRLDepth SUB_SUC EXP; rewrite MULT_AC EQ_ADD_LCANCEL MESON [binom] [1 = binom(n, 0)] GSYM Nsum0SUC; simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; qed; `;; (* val binom : thm = |- (!n. binom (n,0) = 1) /\ (!k. binom (0,SUC k) = 0) /\ (!n k. binom (SUC n,SUC k) = binom (n,SUC k) + binom (n,k)) val BINOM_LT : thm = |- !n k. n < k ==> binom (n,k) = 0 val BINOM_REFL : thm = |- !n. binom (n,n) = 1 0..0..1..2..solved at 6 val BINOMIAL_THEOREM : thm = |- !n. (x + y) EXP n = nsum (0..n) (\k. binom (n,k) * x EXP k * y EXP (n - k)) *) let BINOM_LT = theorem `; ∀n k. n < k ⇒ binom(n,k) = 0 proof INDUCT_TAC; INDUCT_TAC; rewrite binom ARITH LT_SUC LT; ASM_SIMP_TAC ARITH_RULE n < k ==> n < SUC(k)] ARITH; qed; `;; (* Exception: term->thm ARITH_RULE not followed by term list, but instead n < k ==> n < SUC(k)] ARITH. *) let BINOM_LT = theorem `; ∀n k. n < k ⇒ binom(n,k) = 0 proof INDUCT_TAC; INDUCT_TAC; rewrite binom ARITH LT_SUC LT; ASM_SIMP_TAC ARITH_RULE [n < k; n < SUC(k)] ARITH; qed; `;; (* Exception: term->thm ARITH_RULE not followed by length 1 term list, but instead the list [n < k; n < SUC(k)]. *) let BINOM_LT = theorem `; ∀n k. n < k ⇒ binom(n,k) = 0 proof INDUCT_TAC; INDUCT_TAC; rewrite binom ARITH LT_SUC LT; ASM_SIMP_TAC ARITH_RULE [ ] ARITH; qed; `;; (* Exception: term->thm ARITH_RULE not followed by length 1 term list, but instead the list []. *) let BINOMIAL_THEOREM = theorem `; ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) proof ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; MATCH_MP_TAC num_INDUCTION; simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; intro_TAC ∀n, nThm; rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; rewriteR ADD_SYM; rewriteRLDepth SUB_SUC EXP; rewrite MULT_AC EQ_ADD_LCANCEL MESON binom] [1 = binom(n, 0)] GSYM Nsum0SUC; simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; qed; `;; (* Exception: thmlist->term->thm MESON not followed by thm list in binom] [1 = binom(n, 0)] GSYM Nsum0SUC. *) let BINOMIAL_THEOREM = theorem `; ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) proof ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; MATCH_MP_TAC num_INDUCTION; simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; intro_TAC ∀n, nThm; rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; rewriteR ADD_SYM; rewriteRLDepth SUB_SUC EXP; rewrite MULT_AC EQ_ADD_LCANCEL MESON [binom] 1 = binom(n, 0)] GSYM Nsum0SUC; simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; qed; `;; (* Exception: thmlist->term->thm MESON followed by list of theorems [binom] not followed by term in 1 = binom(n, 0)] GSYM Nsum0SUC. *) hol-light/RichterHilbertAxiomGeometry/from_topology.ml000066400000000000000000032306041303454263000236320ustar00rootroot00000000000000(* (c) Copyright, John Harrison 1998-2014 *) (* (c) Copyright, Valentina Bruno 2010 *) (* Distributed under the same license as HOL Light *) (* *) (* Theorems taken directly from Multivariate/topology.ml which run after *) (* loading Topology.ml. *) needs "Library/card.ml";; needs "Multivariate/determinants.ml";; needs "RichterHilbertAxiomGeometry/Topology.ml";; (* ------------------------------------------------------------------------- *) (* Open and closed balls and spheres. *) (* ------------------------------------------------------------------------- *) let sphere = new_definition `sphere(x,e) = { y | dist(x,y) = e}`;; let IN_SPHERE = prove (`!x y e. y IN sphere(x,e) <=> dist(x,y) = e`, REWRITE_TAC[sphere; IN_ELIM_THM]);; let IN_BALL_0 = prove (`!x e. x IN ball(vec 0,e) <=> norm(x) < e`, REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; let IN_CBALL_0 = prove (`!x e. x IN cball(vec 0,e) <=> norm(x) <= e`, REWRITE_TAC[IN_CBALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; let IN_SPHERE_0 = prove (`!x e. x IN sphere(vec 0,e) <=> norm(x) = e`, REWRITE_TAC[IN_SPHERE; dist; VECTOR_SUB_LZERO; NORM_NEG]);; let BALL_TRIVIAL = prove (`!x. ball(x,&0) = {}`, REWRITE_TAC[EXTENSION; IN_BALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; let CBALL_TRIVIAL = prove (`!x. cball(x,&0) = {x}`, REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; let CENTRE_IN_CBALL = prove (`!x e. x IN cball(x,e) <=> &0 <= e`, MESON_TAC[IN_CBALL; DIST_REFL]);; let SPHERE_SUBSET_CBALL = prove (`!x e. sphere(x,e) SUBSET cball(x,e)`, REWRITE_TAC[IN_SPHERE; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);; let SUBSET_BALL = prove (`!x d e. d <= e ==> ball(x,d) SUBSET ball(x,e)`, REWRITE_TAC[SUBSET; IN_BALL] THEN MESON_TAC[REAL_LTE_TRANS]);; let SUBSET_CBALL = prove (`!x d e. d <= e ==> cball(x,d) SUBSET cball(x,e)`, REWRITE_TAC[SUBSET; IN_CBALL] THEN MESON_TAC[REAL_LE_TRANS]);; let BALL_MAX_UNION = prove (`!a r s. ball(a,max r s) = ball(a,r) UNION ball(a,s)`, REWRITE_TAC[IN_BALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; let BALL_MIN_INTER = prove (`!a r s. ball(a,min r s) = ball(a,r) INTER ball(a,s)`, REWRITE_TAC[IN_BALL; IN_INTER; EXTENSION] THEN REAL_ARITH_TAC);; let CBALL_MAX_UNION = prove (`!a r s. cball(a,max r s) = cball(a,r) UNION cball(a,s)`, REWRITE_TAC[IN_CBALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; let CBALL_MIN_INTER = prove (`!x d e. cball(x,min d e) = cball(x,d) INTER cball(x,e)`, REWRITE_TAC[EXTENSION; IN_INTER; IN_CBALL] THEN REAL_ARITH_TAC);; let BALL_TRANSLATION = prove (`!a x r. ball(a + x,r) = IMAGE (\y. a + y) (ball(x,r))`, REWRITE_TAC[ball] THEN GEOM_TRANSLATE_TAC[]);; let CBALL_TRANSLATION = prove (`!a x r. cball(a + x,r) = IMAGE (\y. a + y) (cball(x,r))`, REWRITE_TAC[cball] THEN GEOM_TRANSLATE_TAC[]);; let SPHERE_TRANSLATION = prove (`!a x r. sphere(a + x,r) = IMAGE (\y. a + y) (sphere(x,r))`, REWRITE_TAC[sphere] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [BALL_TRANSLATION; CBALL_TRANSLATION; SPHERE_TRANSLATION];; let BALL_LINEAR_IMAGE = prove (`!f:real^M->real^N x r. linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) ==> ball(f x,r) = IMAGE f (ball(x,r))`, REWRITE_TAC[ball] THEN GEOM_TRANSFORM_TAC[]);; let CBALL_LINEAR_IMAGE = prove (`!f:real^M->real^N x r. linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) ==> cball(f x,r) = IMAGE f (cball(x,r))`, REWRITE_TAC[cball] THEN GEOM_TRANSFORM_TAC[]);; let SPHERE_LINEAR_IMAGE = prove (`!f:real^M->real^N x r. linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) ==> sphere(f x,r) = IMAGE f (sphere(x,r))`, REWRITE_TAC[sphere] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [BALL_LINEAR_IMAGE; CBALL_LINEAR_IMAGE; SPHERE_LINEAR_IMAGE];; let BALL_SCALING = prove (`!c. &0 < c ==> !x r. ball(c % x,c * r) = IMAGE (\x. c % x) (ball(x,r))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[IN_BALL; DIST_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LT_LMUL_EQ]);; let CBALL_SCALING = prove (`!c. &0 < c ==> !x r. cball(c % x,c * r) = IMAGE (\x. c % x) (cball(x,r))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN REWRITE_TAC[IN_CBALL; DIST_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LE_LMUL_EQ]);; add_scaling_theorems [BALL_SCALING; CBALL_SCALING];; let CBALL_DIFF_BALL = prove (`!a r. cball(a,r) DIFF ball(a,r) = sphere(a,r)`, REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let BALL_UNION_SPHERE = prove (`!a r. ball(a,r) UNION sphere(a,r) = cball(a,r)`, REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let SPHERE_UNION_BALL = prove (`!a r. sphere(a,r) UNION ball(a,r) = cball(a,r)`, REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CBALL_DIFF_SPHERE = prove (`!a r. cball(a,r) DIFF sphere(a,r) = ball(a,r)`, REWRITE_TAC[EXTENSION; IN_DIFF; IN_SPHERE; IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let OPEN_CONTAINS_BALL_EQ = prove (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ ball(x,e) SUBSET s)`, MESON_TAC[OPEN_CONTAINS_BALL; SUBSET; CENTRE_IN_BALL]);; let BALL_EQ_EMPTY = prove (`!x e. (ball(x,e) = {}) <=> e <= &0`, REWRITE_TAC[EXTENSION; IN_BALL; NOT_IN_EMPTY; REAL_NOT_LT] THEN MESON_TAC[DIST_POS_LE; REAL_LE_TRANS; DIST_REFL]);; let BALL_EMPTY = prove (`!x e. e <= &0 ==> ball(x,e) = {}`, REWRITE_TAC[BALL_EQ_EMPTY]);; let OPEN_CONTAINS_CBALL = prove (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ cball(x,e) SUBSET s`, GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN SUBGOAL_THEN `e / &2 < e` (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS]) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; let OPEN_CONTAINS_CBALL_EQ = prove (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ cball(x,e) SUBSET s)`, MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET; REAL_LT_IMP_LE; CENTRE_IN_CBALL]);; let SPHERE_EQ_EMPTY = prove (`!a:real^N r. sphere(a,r) = {} <=> r < &0`, REWRITE_TAC[sphere; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN MESON_TAC[VECTOR_CHOOSE_DIST; REAL_NOT_LE]);; let SPHERE_EMPTY = prove (`!a:real^N r. r < &0 ==> sphere(a,r) = {}`, REWRITE_TAC[SPHERE_EQ_EMPTY]);; let NEGATIONS_BALL = prove (`!r. IMAGE (--) (ball(vec 0:real^N,r)) = ball(vec 0,r)`, GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_BALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; let NEGATIONS_CBALL = prove (`!r. IMAGE (--) (cball(vec 0:real^N,r)) = cball(vec 0,r)`, GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_CBALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; let NEGATIONS_SPHERE = prove (`!r. IMAGE (--) (sphere(vec 0:real^N,r)) = sphere(vec 0,r)`, GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_SPHERE_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; let ORTHOGONAL_TRANSFORMATION_BALL = prove (`!f:real^N->real^N r. orthogonal_transformation f ==> IMAGE f (ball(vec 0,r)) = ball(vec 0,r)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL_0] THEN MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; let ORTHOGONAL_TRANSFORMATION_CBALL = prove (`!f:real^N->real^N r. orthogonal_transformation f ==> IMAGE f (cball(vec 0,r)) = cball(vec 0,r)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL_0] THEN MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; let ORTHOGONAL_TRANSFORMATION_SPHERE = prove (`!f:real^N->real^N r. orthogonal_transformation f ==> IMAGE f (sphere(vec 0,r)) = sphere(vec 0,r)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPHERE_0] THEN MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; (* ------------------------------------------------------------------------- *) (* Also some invariance theorems for relative topology. *) (* ------------------------------------------------------------------------- *) let OPEN_IN_TRANSLATION_EQ = prove (`!a s t. open_in (subtopology euclidean (IMAGE (\x. a + x) t)) (IMAGE (\x. a + x) s) <=> open_in (subtopology euclidean t) s`, REWRITE_TAC[open_in] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [OPEN_IN_TRANSLATION_EQ];; let CLOSED_IN_TRANSLATION_EQ = prove (`!a s t. closed_in (subtopology euclidean (IMAGE (\x. a + x) t)) (IMAGE (\x. a + x) s) <=> closed_in (subtopology euclidean t) s`, REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [CLOSED_IN_TRANSLATION_EQ];; (* ------------------------------------------------------------------------- *) (* Limit points. *) (* ------------------------------------------------------------------------- *) let LIMPT_APPROACHABLE = prove (`!x s. x limit_point_of s <=> !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[limit_point_of] THEN MESON_TAC[open_def; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; IN_BALL]);; let LIMPT_APPROACHABLE_LE = prove (`!x s. x limit_point_of s <=> !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) <= e`, REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN MATCH_MP_TAC(TAUT `(~a <=> ~b) ==> (a <=> b)`) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> c ==> ~(a /\ b)`; APPROACHABLE_LT_LE]);; let LIMPT_UNIV = prove (`!x:real^N. x limit_point_of UNIV`, GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `?c:real^N. norm(c) = e / &2` CHOOSE_TAC THENL [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE; REAL_HALF; REAL_LT_IMP_LE]; ALL_TAC] THEN EXISTS_TAC `x + c:real^N` THEN REWRITE_TAC[dist; VECTOR_EQ_ADDR] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB] THEN SUBGOAL_THEN `&0 < e / &2 /\ e / &2 < e` (fun th -> ASM_MESON_TAC[th; NORM_0; REAL_LT_REFL]) THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; let CLOSED_POSITIVE_ORTHANT = prove (`closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `--(x:real^N $ i)`) THEN ASM_REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; NOT_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC(TAUT `(a ==> ~c) ==> ~(a /\ b /\ c)`) THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `!b. abs x <= b /\ b <= a ==> ~(a + x < &0)`) THEN EXISTS_TAC `abs((y - x :real^N)$i)` THEN ASM_SIMP_TAC[dist; COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH `x < &0 /\ &0 <= y ==> abs(x) <= abs(y - x)`]);; let FINITE_SET_AVOID = prove (`!a:real^N s. FINITE s ==> ?d. &0 < d /\ !x. x IN s /\ ~(x = a) ==> d <= dist(a,x)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY] THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `x:real^N = a` THEN REWRITE_TAC[IN_INSERT] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN EXISTS_TAC `min d (dist(a:real^N,x))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ; REAL_MIN_LE] THEN ASM_MESON_TAC[REAL_LE_REFL]);; let LIMIT_POINT_FINITE = prove (`!s a. FINITE s ==> ~(a limit_point_of s)`, REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LE] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM; REAL_NOT_LE; REAL_NOT_LT; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN MESON_TAC[FINITE_SET_AVOID; DIST_SYM]);; let LIMPT_SING = prove (`!x y:real^N. ~(x limit_point_of {y})`, SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING]);; let LIMPT_INSERT = prove (`!s x y:real^N. x limit_point_of (y INSERT s) <=> x limit_point_of s`, ONCE_REWRITE_TAC[SET_RULE `y INSERT s = {y} UNION s`] THEN REWRITE_TAC[LIMIT_POINT_UNION] THEN SIMP_TAC[FINITE_SING; LIMIT_POINT_FINITE]);; let LIMPT_OF_LIMPTS = prove (`!x:real^N s. x limit_point_of {y | y limit_point_of s} ==> x limit_point_of s`, REWRITE_TAC[LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `dist(y:real^N,x)`) THEN ASM_SIMP_TAC[DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let CLOSED_LIMPTS = prove (`!s. closed {x:real^N | x limit_point_of s}`, REWRITE_TAC[CLOSED_LIMPT; IN_ELIM_THM; LIMPT_OF_LIMPTS]);; let DISCRETE_IMP_CLOSED = prove (`!s:real^N->bool e. &0 < e /\ (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) ==> closed s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x:real^N. ~(x limit_point_of s)` (fun th -> MESON_TAC[th; CLOSED_LIMPT]) THEN GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `e / &2`) THEN REWRITE_TAC[REAL_HALF; ASSUME `&0 < e`] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (e / &2) (dist(x:real^N,y))`) THEN ASM_SIMP_TAC[REAL_LT_MIN; DIST_POS_LT; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ASM_REWRITE_TAC[] THEN ASM_NORM_ARITH_TAC);; let LIMPT_OF_UNIV = prove (`!x. x limit_point_of (:real^N)`, GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`x:real^N`; `e / &2`] VECTOR_CHOOSE_DIST) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH);; let LIMPT_OF_OPEN_IN = prove (`!s t x:real^N. open_in (subtopology euclidean s) t /\ x limit_point_of s /\ x IN t ==> x limit_point_of t`, REWRITE_TAC[open_in; SUBSET; LIMPT_APPROACHABLE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; let LIMPT_OF_OPEN = prove (`!s x:real^N. open s /\ x IN s ==> x limit_point_of s`, REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN MESON_TAC[LIMPT_OF_OPEN_IN; LIMPT_OF_UNIV]);; let OPEN_IN_SING = prove (`!s a. open_in (subtopology euclidean s) {a} <=> a IN s /\ ~(a limit_point_of s)`, REWRITE_TAC[open_in; LIMPT_APPROACHABLE; SING_SUBSET; IN_SING] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Interior of a set. *) (* ------------------------------------------------------------------------- *) let INTERIOR_LIMIT_POINT = prove (`!s x:real^N. x IN interior s ==> x limit_point_of s`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_INTERIOR; IN_ELIM_THM; SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`x:real^N`; `min d e / &2`] VECTOR_CHOOSE_DIST) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM DIST_EQ_0]; ONCE_REWRITE_TAC[DIST_SYM]] THEN ASM_REAL_ARITH_TAC);; let INTERIOR_SING = prove (`!a:real^N. interior {a} = {}`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[INTERIOR_LIMIT_POINT; LIMPT_SING]);; (* ------------------------------------------------------------------------- *) (* Closure of a set. *) (* ------------------------------------------------------------------------- *) let LIMPT_OF_CLOSURE = prove (`!x:real^N s. x limit_point_of closure s <=> x limit_point_of s`, REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; LIMIT_POINT_UNION] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> (p \/ q <=> p)`) THEN REWRITE_TAC[LIMPT_OF_LIMPTS]);; (* ------------------------------------------------------------------------- *) (* A variant of nets (slightly non-standard but good for our purposes). *) (* ------------------------------------------------------------------------- *) let net_tybij = new_type_definition "net" ("mk_net","netord") (prove (`?g:A->A->bool. !x y. (!z. g z x ==> g z y) \/ (!z. g z y ==> g z x)`, EXISTS_TAC `\x:A y:A. F` THEN REWRITE_TAC[]));; let NET = prove (`!n x y. (!z. netord n z x ==> netord n z y) \/ (!z. netord n z y ==> netord n z x)`, REWRITE_TAC[net_tybij; ETA_AX]);; let OLDNET = prove (`!n x y. netord n x x /\ netord n y y ==> ?z. netord n z z /\ !w. netord n w z ==> netord n w x /\ netord n w y`, MESON_TAC[NET]);; let NET_DILEMMA = prove (`!net. (?a. (?x. netord net x a) /\ (!x. netord net x a ==> P x)) /\ (?b. (?x. netord net x b) /\ (!x. netord net x b ==> Q x)) ==> ?c. (?x. netord net x c) /\ (!x. netord net x c ==> P x /\ Q x)`, MESON_TAC[NET]);; (* ------------------------------------------------------------------------- *) (* Common nets and the "within" modifier for nets. *) (* ------------------------------------------------------------------------- *) parse_as_infix("within",(14,"right"));; parse_as_infix("in_direction",(14,"right"));; let at = new_definition `at a = mk_net(\x y. &0 < dist(x,a) /\ dist(x,a) <= dist(y,a))`;; let at_infinity = new_definition `at_infinity = mk_net(\x y. norm(x) >= norm(y))`;; let sequentially = new_definition `sequentially = mk_net(\m:num n. m >= n)`;; let within = new_definition `net within s = mk_net(\x y. netord net x y /\ x IN s)`;; let in_direction = new_definition `a in_direction v = (at a) within {b | ?c. &0 <= c /\ (b - a = c % v)}`;; (* ------------------------------------------------------------------------- *) (* Prove that they are all nets. *) (* ------------------------------------------------------------------------- *) let NET_PROVE_TAC[def] = REWRITE_TAC[GSYM FUN_EQ_THM; def] THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[GSYM(CONJUNCT2 net_tybij)];; let AT = prove (`!a:real^N x y. netord(at a) x y <=> &0 < dist(x,a) /\ dist(x,a) <= dist(y,a)`, GEN_TAC THEN NET_PROVE_TAC[at] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);; let AT_INFINITY = prove (`!x y. netord at_infinity x y <=> norm(x) >= norm(y)`, NET_PROVE_TAC[at_infinity] THEN REWRITE_TAC[real_ge; REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; let SEQUENTIALLY = prove (`!m n. netord sequentially m n <=> m >= n`, NET_PROVE_TAC[sequentially] THEN REWRITE_TAC[GE; LE_REFL] THEN MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; let WITHIN = prove (`!n s x y. netord(n within s) x y <=> netord n x y /\ x IN s`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[within; GSYM FUN_EQ_THM] THEN REWRITE_TAC[GSYM(CONJUNCT2 net_tybij); ETA_AX] THEN MESON_TAC[NET]);; let IN_DIRECTION = prove (`!a v x y. netord(a in_direction v) x y <=> &0 < dist(x,a) /\ dist(x,a) <= dist(y,a) /\ ?c. &0 <= c /\ (x - a = c % v)`, REWRITE_TAC[WITHIN; AT; in_direction; IN_ELIM_THM; CONJ_ACI]);; let WITHIN_UNIV = prove (`!x:real^N. at x within UNIV = at x`, REWRITE_TAC[within; at; IN_UNIV] THEN REWRITE_TAC[ETA_AX; net_tybij]);; let WITHIN_WITHIN = prove (`!net s t. (net within s) within t = net within (s INTER t)`, ONCE_REWRITE_TAC[within] THEN REWRITE_TAC[WITHIN; IN_INTER; GSYM CONJ_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Identify trivial limits, where we can't approach arbitrarily closely. *) (* ------------------------------------------------------------------------- *) let trivial_limit = new_definition `trivial_limit net <=> (!a:A b. a = b) \/ ?a:A b. ~(a = b) /\ !x. ~(netord(net) x a) /\ ~(netord(net) x b)`;; let TRIVIAL_LIMIT_WITHIN = prove (`!a:real^N. trivial_limit (at a within s) <=> ~(a limit_point_of s)`, REWRITE_TAC[trivial_limit; LIMPT_APPROACHABLE_LE; WITHIN; AT; DIST_NZ] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MESON_TAC[REAL_LT_01; REAL_LT_REFL; VECTOR_CHOOSE_DIST; DIST_REFL; REAL_LT_IMP_LE]; DISCH_THEN(X_CHOOSE_THEN `b:real^N` (X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `&0 < dist(a,b:real^N) \/ &0 < dist(a,c:real^N)` MP_TAC THEN ASM_MESON_TAC[DIST_TRIANGLE; DIST_SYM; GSYM DIST_NZ; GSYM DIST_EQ_0; REAL_ARITH `x <= &0 + &0 ==> ~(&0 < x)`]]; REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN DISJ2_TAC THEN EXISTS_TAC `a:real^N` THEN SUBGOAL_THEN `?b:real^N. dist(a,b) = e` MP_TAC THENL [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]]);; let TRIVIAL_LIMIT_AT = prove (`!a. ~(trivial_limit (at a))`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_UNIV]);; let TRIVIAL_LIMIT_AT_INFINITY = prove (`~(trivial_limit at_infinity)`, REWRITE_TAC[trivial_limit; AT_INFINITY; real_ge] THEN MESON_TAC[REAL_LE_REFL; VECTOR_CHOOSE_SIZE; REAL_LT_01; REAL_LT_LE]);; let TRIVIAL_LIMIT_SEQUENTIALLY = prove (`~(trivial_limit sequentially)`, REWRITE_TAC[trivial_limit; SEQUENTIALLY] THEN MESON_TAC[GE_REFL; NOT_SUC]);; let LIM_WITHIN_CLOSED_TRIVIAL = prove (`!a s. closed s /\ ~(a IN s) ==> trivial_limit (at a within s)`, REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN MESON_TAC[CLOSED_LIMPT]);; let NONTRIVIAL_LIMIT_WITHIN = prove (`!net s. trivial_limit net ==> trivial_limit(net within s)`, REWRITE_TAC[trivial_limit; WITHIN] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some property holds "sufficiently close" to the limit point. *) (* ------------------------------------------------------------------------- *) let eventually = new_definition `eventually p net <=> trivial_limit net \/ ?y. (?x. netord net x y) /\ (!x. netord net x y ==> p x)`;; let EVENTUALLY_HAPPENS = prove (`!net p. eventually p net ==> trivial_limit net \/ ?x. p x`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_WITHIN_LE = prove (`!s a:real^M p. eventually p (at a within s) <=> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> p(x)`, REWRITE_TAC[eventually; AT; WITHIN; TRIVIAL_LIMIT_WITHIN] THEN REWRITE_TAC[LIMPT_APPROACHABLE_LE; DIST_NZ] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LTE_TRANS]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> ~a \/ b`) THEN DISCH_TAC THEN SUBGOAL_THEN `?b:real^M. dist(a,b) = d` MP_TAC THENL [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^M` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]);; let EVENTUALLY_WITHIN = prove (`!s a:real^M p. eventually p (at a within s) <=> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, REWRITE_TAC[EVENTUALLY_WITHIN_LE] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN REWRITE_TAC[APPROACHABLE_LT_LE]);; let EVENTUALLY_AT = prove (`!a p. eventually p (at a) <=> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[EVENTUALLY_WITHIN; IN_UNIV]);; let EVENTUALLY_SEQUENTIALLY = prove (`!p. eventually p sequentially <=> ?N. !n. N <= n ==> p n`, REWRITE_TAC[eventually; SEQUENTIALLY; GE; LE_REFL; TRIVIAL_LIMIT_SEQUENTIALLY] THEN MESON_TAC[LE_REFL]);; let EVENTUALLY_AT_INFINITY = prove (`!p. eventually p at_infinity <=> ?b. !x. norm(x) >= b ==> p x`, REWRITE_TAC[eventually; AT_INFINITY; TRIVIAL_LIMIT_AT_INFINITY] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN MESON_TAC[real_ge; REAL_LE_REFL; VECTOR_CHOOSE_SIZE; REAL_ARITH `&0 <= b \/ (!x. x >= &0 ==> x >= b)`]);; let EVENTUALLY_AT_INFINITY_POS = prove (`!p:real^N->bool. eventually p at_infinity <=> ?b. &0 < b /\ !x. norm x >= b ==> p x`, GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (abs b + &1 <= x ==> b <= x)`]);; let ALWAYS_EVENTUALLY = prove (`(!x. p x) ==> eventually p net`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[eventually; trivial_limit] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Combining theorems for "eventually". *) (* ------------------------------------------------------------------------- *) let EVENTUALLY_AND = prove (`!net:(A net) p q. eventually (\x. p x /\ q x) net <=> eventually p net /\ eventually q net`, REPEAT GEN_TAC THEN REWRITE_TAC[eventually] THEN ASM_CASES_TAC `trivial_limit(net:(A net))` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN SIMP_TAC[NET_DILEMMA] THEN MESON_TAC[]);; let EVENTUALLY_MONO = prove (`!net:(A net) p q. (!x. p x ==> q x) /\ eventually p net ==> eventually q net`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_MP = prove (`!net:(A net) p q. eventually (\x. p x ==> q x) net /\ eventually p net ==> eventually q net`, REWRITE_TAC[GSYM EVENTUALLY_AND] THEN REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_FALSE = prove (`!net. eventually (\x. F) net <=> trivial_limit net`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_TRUE = prove (`!net. eventually (\x. T) net <=> T`, REWRITE_TAC[eventually; trivial_limit] THEN MESON_TAC[]);; let NOT_EVENTUALLY = prove (`!net p. (!x. ~(p x)) /\ ~(trivial_limit net) ==> ~(eventually p net)`, REWRITE_TAC[eventually] THEN MESON_TAC[]);; let EVENTUALLY_FORALL = prove (`!net:(A net) p s:B->bool. FINITE s /\ ~(s = {}) ==> (eventually (\x. !a. a IN s ==> p a x) net <=> !a. a IN s ==> eventually (p a) net)`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT; EVENTUALLY_AND; ETA_AX] THEN MAP_EVERY X_GEN_TAC [`b:B`; `t:B->bool`] THEN ASM_CASES_TAC `t:B->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; EVENTUALLY_TRUE]);; let FORALL_EVENTUALLY = prove (`!net:(A net) p s:B->bool. FINITE s /\ ~(s = {}) ==> ((!a. a IN s ==> eventually (p a) net) <=> eventually (\x. !a. a IN s ==> p a x) net)`, SIMP_TAC[EVENTUALLY_FORALL]);; (* ------------------------------------------------------------------------- *) (* Limits, defined as vacuously true when the limit is trivial. *) (* ------------------------------------------------------------------------- *) parse_as_infix("-->",(12,"right"));; let tendsto = new_definition `(f --> l) net <=> !e. &0 < e ==> eventually (\x. dist(f(x),l) < e) net`;; let lim = new_definition `lim net f = @l. (f --> l) net`;; let LIM = prove (`(f --> l) net <=> trivial_limit net \/ !e. &0 < e ==> ?y. (?x. netord(net) x y) /\ !x. netord(net) x y ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; eventually] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Show that they yield usual definitions in the various cases. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_LE = prove (`!f:real^M->real^N l a s. (f --> l)(at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LE]);; let LIM_WITHIN = prove (`!f:real^M->real^N l a s. (f --> l) (at a within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_WITHIN] THEN MESON_TAC[]);; let LIM_AT_LE = prove (`!f l a. (f --> l) (at a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) <= d ==> dist (f x,l) < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_LE; IN_UNIV]);; let LIM_AT = prove (`!f l:real^N a:real^M. (f --> l) (at a) <=> !e. &0 < e ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_AT] THEN MESON_TAC[]);; let LIM_AT_INFINITY = prove (`!f l. (f --> l) at_infinity <=> !e. &0 < e ==> ?b. !x. norm(x) >= b ==> dist(f(x),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);; let LIM_AT_INFINITY_POS = prove (`!f l. (f --> l) at_infinity <=> !e. &0 < e ==> ?b. &0 < b /\ !x. norm x >= b ==> dist(f x,l) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY] THEN MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);; let LIM_SEQUENTIALLY = prove (`!s l. (s --> l) sequentially <=> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s(n),l) < e`, REWRITE_TAC[tendsto; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);; let LIM_EVENTUALLY = prove (`!net f l. eventually (\x. f x = l) net ==> (f --> l) net`, REWRITE_TAC[eventually; LIM] THEN MESON_TAC[DIST_REFL]);; (* ------------------------------------------------------------------------- *) (* The expected monotonicity property. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_EMPTY = prove (`!f l x. (f --> l) (at x within {})`, REWRITE_TAC[LIM_WITHIN; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);; let LIM_WITHIN_SUBSET = prove (`!f l a s. (f --> l) (at a within s) /\ t SUBSET s ==> (f --> l) (at a within t)`, REWRITE_TAC[LIM_WITHIN; SUBSET] THEN MESON_TAC[]);; let LIM_UNION = prove (`!f x l s t. (f --> l) (at x within s) /\ (f --> l) (at x within t) ==> (f --> l) (at x within (s UNION t))`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; IN_UNION] THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_SIMP_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN EXISTS_TAC `min d1 d2` THEN ASM_MESON_TAC[REAL_LT_MIN]);; let LIM_UNION_UNIV = prove (`!f x l s t. (f --> l) (at x within s) /\ (f --> l) (at x within t) /\ s UNION t = (:real^N) ==> (f --> l) (at x)`, MESON_TAC[LIM_UNION; WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Composition of limits. *) (* ------------------------------------------------------------------------- *) let LIM_COMPOSE_WITHIN = prove (`!net f:real^M->real^N g:real^N->real^P s y z. (f --> y) net /\ eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\ (g --> z) (at y within s) ==> ((g o f) --> z) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; CONJ_ASSOC] THEN ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; o_DEF] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN ASM_MESON_TAC[DIST_REFL]);; let LIM_COMPOSE_AT = prove (`!net f:real^M->real^N g:real^N->real^P y z. (f --> y) net /\ eventually (\w. f w = y ==> g y = z) net /\ (g --> z) (at y) ==> ((g o f) --> z) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(real^M)net`; `f:real^M->real^N`; `g:real^N->real^P`; `(:real^N)`; `y:real^N`; `z:real^P`] LIM_COMPOSE_WITHIN) THEN ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Interrelations between restricted and unrestricted limits. *) (* ------------------------------------------------------------------------- *) let LIM_AT_WITHIN = prove (`!f l a s. (f --> l)(at a) ==> (f --> l)(at a within s)`, REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN MESON_TAC[]);; let LIM_WITHIN_OPEN = prove (`!f l a:real^M s. a IN s /\ open s ==> ((f --> l)(at a within s) <=> (f --> l)(at a))`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_AT_WITHIN] THEN REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M` o GEN_REWRITE_RULE I [open_def]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_TRANS]);; (* ------------------------------------------------------------------------- *) (* More limit point characterizations. *) (* ------------------------------------------------------------------------- *) let LIMPT_SEQUENTIAL_INJ = prove (`!x:real^N s. x limit_point_of s <=> ?f. (!n. f(n) IN (s DELETE x)) /\ (!m n. f m = f n <=> m = n) /\ (f --> x) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[GE; LE_REFL]] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real->real^N` THEN DISCH_TAC THEN (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) `(z 0 = y (&1)) /\ (!n. z (SUC n):real^N = y(min (inv(&2 pow (SUC n))) (dist(z n,x))))` THEN EXISTS_TAC `z:num->real^N` THEN SUBGOAL_THEN `!n. z(n) IN s /\ ~(z n:real^N = x) /\ dist(z n,x) < inv(&2 pow n)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_01] THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT]; ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[EQ_SYM_EQ] THEN SUBGOAL_THEN `!m n:num. m < n ==> dist(z n:real^N,x) < dist(z m,x)` (fun th -> MESON_TAC[th; REAL_LT_REFL; LT_REFL]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN CONJ_TAC THENL [REAL_ARITH_TAC; GEN_TAC THEN ASM_REWRITE_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT]; X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS)) THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]]);; let LIMPT_SEQUENTIAL = prove (`!x:real^N s. x limit_point_of s <=> ?f. (!n. f(n) IN (s DELETE x)) /\ (f --> x) sequentially`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN MESON_TAC[]; REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN MESON_TAC[GE; LE_REFL]]);; let [LIMPT_INFINITE_OPEN; LIMPT_INFINITE_BALL; LIMPT_INFINITE_CBALL] = (CONJUNCTS o prove) (`(!s x:real^N. x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t)) /\ (!s x:real^N. x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e))) /\ (!s x:real^N. x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) /\ (r ==> s) /\ (s ==> q) /\ (p ==> r) ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[limit_point_of; INFINITE; SET_RULE `(?y. ~(y = x) /\ y IN s /\ y IN t) <=> ~(s INTER t SUBSET {x})`] THEN MESON_TAC[FINITE_SUBSET; FINITE_SING]; MESON_TAC[INFINITE_SUPERSET; BALL_SUBSET_CBALL; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; MESON_TAC[INFINITE_SUPERSET; OPEN_CONTAINS_CBALL; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC `IMAGE (f:num->real^N) (from N)` THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_FROM; IN_INTER] THEN ASM_MESON_TAC[INFINITE_IMAGE_INJ; INFINITE_FROM]]);; let INFINITE_OPEN_IN = prove (`!u s:real^N->bool. open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u) ==> INFINITE s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Condensation points. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("condensation_point_of",(12,"right"));; let condensation_point_of = new_definition `x condensation_point_of s <=> !t. x IN t /\ open t ==> ~COUNTABLE(s INTER t)`;; let CONDENSATION_POINT_OF_SUBSET = prove (`!x:real^N s t. x condensation_point_of s /\ s SUBSET t ==> x condensation_point_of t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[condensation_point_of] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN ASM SET_TAC[]);; let CONDENSATION_POINT_IMP_LIMPT = prove (`!x s. x condensation_point_of s ==> x limit_point_of s`, REWRITE_TAC[condensation_point_of; LIMPT_INFINITE_OPEN; INFINITE] THEN MESON_TAC[FINITE_IMP_COUNTABLE]);; let CONDENSATION_POINT_INFINITE_BALL,CONDENSATION_POINT_INFINITE_CBALL = (CONJ_PAIR o prove) (`(!s x:real^N. x condensation_point_of s <=> !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e))) /\ (!s x:real^N. x condensation_point_of s <=> !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN REWRITE_TAC[condensation_point_of] THEN REPEAT CONJ_TAC THENL [MESON_TAC[OPEN_BALL; CENTRE_IN_BALL]; MESON_TAC[BALL_SUBSET_CBALL; COUNTABLE_SUBSET; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; MESON_TAC[COUNTABLE_SUBSET; OPEN_CONTAINS_CBALL; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]]);; (* ------------------------------------------------------------------------- *) (* Basic arithmetical combining theorems for limits. *) (* ------------------------------------------------------------------------- *) let LIM_LINEAR = prove (`!net:(A)net h f l. (f --> l) net /\ linear h ==> ((\x. h(f x)) --> h l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN ASM_SIMP_TAC[REAL_LT_DIV; dist; GSYM LINEAR_SUB; REAL_LT_RDIV_EQ] THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_MUL_SYM]);; let LIM_CONST = prove (`!net a:real^N. ((\x. a) --> a) net`, SIMP_TAC[LIM; DIST_REFL; trivial_limit] THEN MESON_TAC[]);; let LIM_CMUL = prove (`!f l c. (f --> l) net ==> ((\x. c % f x) --> c % l) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_LINEAR THEN ASM_REWRITE_TAC[REWRITE_RULE[ETA_AX] (MATCH_MP LINEAR_COMPOSE_CMUL LINEAR_ID)]);; let LIM_CMUL_EQ = prove (`!net f l c. ~(c = &0) ==> (((\x. c % f x) --> c % l) net <=> (f --> l) net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_CMUL] THEN DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP LIM_CMUL) THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; let LIM_NEG = prove (`!net f l:real^N. (f --> l) net ==> ((\x. --(f x)) --> --l) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM; dist] THEN REWRITE_TAC[VECTOR_ARITH `--x - --y = --(x - y:real^N)`; NORM_NEG]);; let LIM_NEG_EQ = prove (`!net f l:real^N. ((\x. --(f x)) --> --l) net <=> (f --> l) net`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; let LIM_ADD = prove (`!net:(A)net f g l m. (f --> l) net /\ (g --> m) net ==> ((\x. f(x) + g(x)) --> l + m) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_HALF; DIST_TRIANGLE_ADD; REAL_LT_ADD2; REAL_LET_TRANS]);; let LIM_ABS = prove (`!net:(A)net f:A->real^N l. (f --> l) net ==> ((\x. lambda i. (abs(f(x)$i))) --> (lambda i. abs(l$i)):real^N) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm(x - y) <= norm(a - b) ==> dist(a,b) < e ==> dist(x,y) < e`) THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC);; let LIM_SUB = prove (`!net:(A)net f g l m. (f --> l) net /\ (g --> m) net ==> ((\x. f(x) - g(x)) --> l - m) net`, REWRITE_TAC[real_sub; VECTOR_SUB] THEN ASM_SIMP_TAC[LIM_ADD; LIM_NEG]);; let LIM_MAX = prove (`!net:(A)net f g l:real^N m:real^N. (f --> l) net /\ (g --> m) net ==> ((\x. lambda i. max (f(x)$i) (g(x)$i)) --> (lambda i. max (l$i) (m$i)):real^N) net`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LIM_ADD) THEN FIRST_ASSUM(MP_TAC o MATCH_MP LIM_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ABS) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP LIM_CMUL) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);; let LIM_MIN = prove (`!net:(A)net f g l:real^N m:real^N. (f --> l) net /\ (g --> m) net ==> ((\x. lambda i. min (f(x)$i) (g(x)$i)) --> (lambda i. min (l$i) (m$i)):real^N) net`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LIM_NEG)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG o MATCH_MP LIM_MAX) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC);; let LIM_NORM = prove (`!net f:A->real^N l. (f --> l) net ==> ((\x. lift(norm(f x))) --> lift(norm l)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; DIST_LIFT] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[] THEN NORM_ARITH_TAC);; let LIM_NULL = prove (`!net f l. (f --> l) net <=> ((\x. f(x) - l) --> vec 0) net`, REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO]);; let LIM_NULL_NORM = prove (`!net f. (f --> vec 0) net <=> ((\x. lift(norm(f x))) --> vec 0) net`, REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO; REAL_ABS_NORM; NORM_LIFT]);; let LIM_NULL_CMUL_EQ = prove (`!net f c. ~(c = &0) ==> (((\x. c % f x) --> vec 0) net <=> (f --> vec 0) net)`, MESON_TAC[LIM_CMUL_EQ; VECTOR_MUL_RZERO]);; let LIM_NULL_CMUL = prove (`!net f c. (f --> vec 0) net ==> ((\x. c % f x) --> vec 0) net`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_SIMP_TAC[LIM_NULL_CMUL_EQ; VECTOR_MUL_LZERO; LIM_CONST]);; let LIM_NULL_COMPARISON = prove (`!net f g. eventually (\x. norm(f x) <= g x) net /\ ((\x. lift(g x)) --> vec 0) net ==> (f --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN REAL_ARITH_TAC);; let LIM_COMPONENT = prove (`!net f i l:real^N. (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) ==> ((\a. lift(f(a)$i)) --> lift(l$i)) net`, REWRITE_TAC[LIM; dist; GSYM LIFT_SUB; NORM_LIFT] THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);; let LIM_TRANSFORM_BOUND = prove (`!f g. eventually (\n. norm(f n) <= norm(g n)) net /\ (g --> vec 0) net ==> (f --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN REAL_ARITH_TAC);; let LIM_NULL_CMUL_BOUNDED = prove (`!f g:A->real^N B. eventually (\a. g a = vec 0 \/ abs(f a) <= B) net /\ (g --> vec 0) net ==> ((\n. f n % g n) --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN UNDISCH_TAC `eventually (\a. g a:real^N = vec 0 \/ abs(f a) <= B) (net:(A net))` THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `(g:A->real^N) x = vec 0` THEN ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * e / (abs B + &1)` THEN ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `c * (a / b) = (c * a) / b`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN MATCH_MP_TAC(REAL_ARITH `e * B <= e * abs B /\ &0 < e ==> B * e < e * (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; let LIM_NULL_VMUL_BOUNDED = prove (`!f g:A->real^N B. ((lift o f) --> vec 0) net /\ eventually (\a. f a = &0 \/ norm(g a) <= B) net ==> ((\n. f n % g n) --> vec 0) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN UNDISCH_TAC `eventually(\a. f a = &0 \/ norm((g:A->real^N) a) <= B) net` THEN REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN ASM_CASES_TAC `(f:A->real) x = &0` THEN ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / (abs B + &1) * B` THEN ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[REAL_ARITH `(a / b) * c = (a * c) / b`] THEN SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN MATCH_MP_TAC(REAL_ARITH `e * B <= e * abs B /\ &0 < e ==> e * B < e * (abs B + &1)`) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; let LIM_VSUM = prove (`!f:A->B->real^N s. FINITE s /\ (!i. i IN s ==> ((f i) --> (l i)) net) ==> ((\x. vsum s (\i. f i x)) --> vsum s l) net`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES; LIM_CONST; LIM_ADD; IN_INSERT; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Deducing things about the limit from the elements. *) (* ------------------------------------------------------------------------- *) let LIM_IN_CLOSED_SET = prove (`!net f:A->real^N s l. closed s /\ eventually (\x. f(x) IN s) net /\ ~(trivial_limit net) /\ (f --> l) net ==> l IN s`, REWRITE_TAC[closed] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `~(x IN (UNIV DIFF s)) ==> x IN s`) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `l:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_UNION] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [tendsto]) THEN UNDISCH_TAC `eventually (\x. (f:A->real^N) x IN s) net` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; TAUT `a ==> ~b <=> ~(a /\ b)`] THEN MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_MESON_TAC[DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Need to prove closed(cball(x,e)) before deducing this as a corollary. *) (* ------------------------------------------------------------------------- *) let LIM_NORM_UBOUND = prove (`!net:(A)net f (l:real^N) b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. norm(f x) <= b) net ==> norm(l) <= b`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[eventually] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `?x:A. dist(f(x):real^N,l) < norm(l:real^N) - b /\ norm(f x) <= b` (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN NORM_ARITH_TAC);; let LIM_NORM_LBOUND = prove (`!net:(A)net f (l:real^N) b. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= norm(f x)) net ==> b <= norm(l)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[eventually] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN SUBGOAL_THEN `?x:A. dist(f(x):real^N,l) < b - norm(l:real^N) /\ b <= norm(f x)` (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Uniqueness of the limit, when nontrivial. *) (* ------------------------------------------------------------------------- *) let LIM_UNIQUE = prove (`!net:(A)net f l:real^N l'. ~(trivial_limit net) /\ (f --> l) net /\ (f --> l') net ==> (l = l')`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(ASSUME_TAC o REWRITE_RULE[VECTOR_SUB_REFL] o MATCH_MP LIM_SUB) THEN SUBGOAL_THEN `!e. &0 < e ==> norm(l:real^N - l') <= e` MP_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_NORM_UBOUND THEN MAP_EVERY EXISTS_TAC [`net:(A)net`; `\x:A. vec 0 : real^N`] THEN ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE; eventually] THEN ASM_MESON_TAC[trivial_limit]; ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DIST_NZ; dist] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `norm(l - l':real^N) / &2`) THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN UNDISCH_TAC `&0 < norm(l - l':real^N)` THEN REAL_ARITH_TAC]);; let TENDSTO_LIM = prove (`!net f l. ~(trivial_limit net) /\ (f --> l) net ==> lim net f = l`, REWRITE_TAC[lim] THEN MESON_TAC[LIM_UNIQUE]);; let LIM_CONST_EQ = prove (`!net:(A net) c d:real^N. ((\x. c) --> d) net <=> trivial_limit net \/ c = d`, REPEAT GEN_TAC THEN ASM_CASES_TAC `trivial_limit (net:A net)` THEN ASM_REWRITE_TAC[] THENL [ASM_REWRITE_TAC[LIM]; ALL_TAC] THEN EQ_TAC THEN SIMP_TAC[LIM_CONST] THEN DISCH_TAC THEN MATCH_MP_TAC(SPEC `net:A net` LIM_UNIQUE) THEN EXISTS_TAC `(\x. c):A->real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);; (* ------------------------------------------------------------------------- *) (* Some unwieldy but occasionally useful theorems about uniform limits. *) (* ------------------------------------------------------------------------- *) let UNIFORM_LIM_ADD = prove (`!net:(A)net P f g l m. (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm((f n x + g n x) - (l n + m n)) < e) net`, REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; let UNIFORM_LIM_SUB = prove (`!net:(A)net P f g l m. (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm((f n x - g n x) - (l n - m n)) < e) net`, REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; (* ------------------------------------------------------------------------- *) (* Limit under bilinear function, uniform version first. *) (* ------------------------------------------------------------------------- *) let UNIFORM_LIM_BILINEAR = prove (`!net:(A)net P (h:real^M->real^N->real^P) f g l m b1 b2. bilinear h /\ eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ eventually (\x. !n. P n ==> norm(m n) <= b2) net /\ (!e. &0 < e ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ (!e. &0 < e ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) ==> !e. &0 < e ==> eventually (\x. !n. P n ==> norm(h (f n x) (g n x) - h (l n) (m n)) < e) net`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN REWRITE_TAC[AND_FORALL_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (abs b2 + &1) (e / &2 / (B * (abs b1 + abs b2 + &2)))`) THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_LT_MIN; REAL_ARITH `&0 < abs x + &1`; REAL_ARITH `&0 < abs x + abs y + &2`] THEN REWRITE_TAC[GSYM EVENTUALLY_AND] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `h a b - h c d :real^N = (h a b - h a d) + (h a d - h c d)`] THEN ASM_SIMP_TAC[GSYM BILINEAR_LSUB; GSYM BILINEAR_RSUB] THEN MATCH_MP_TAC NORM_TRIANGLE_LT THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[REAL_LE_ADD2; REAL_LET_TRANS] `(!x y. norm(h x y:real^P) <= B * norm x * norm y) ==> B * norm a * norm b + B * norm c * norm d < e ==> norm(h a b) + norm(h c d) < e`)) THEN MATCH_MP_TAC(REAL_ARITH `x * B < e / &2 /\ y * B < e / &2 ==> B * x + B * y < e`) THEN CONJ_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2 / (B * (abs b1 + abs b2 + &2)) * (abs b1 + abs b2 + &1)` THEN (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_ARITH `a <= b2 ==> a <= abs b1 + abs b2 + &1`] THEN ASM_MESON_TAC[NORM_ARITH `norm(f - l:real^P) < abs b2 + &1 /\ norm(l) <= b1 ==> norm(f) <= abs b1 + abs b2 + &1`]; ONCE_REWRITE_TAC[real_div] THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_HALF; GSYM REAL_MUL_ASSOC; REAL_INV_MUL] THEN REWRITE_TAC[REAL_ARITH `B * inv x * y < B <=> B * y / x < B * &1`] THEN ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + abs y + &2`] THEN REAL_ARITH_TAC]));; let LIM_BILINEAR = prove (`!net:(A)net (h:real^M->real^N->real^P) f g l m. (f --> l) net /\ (g --> m) net /\ bilinear h ==> ((\x. h (f x) (g x)) --> (h l m)) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `\x:one. T`; `h:real^M->real^N->real^P`; `\n:one. (f:A->real^M)`; `\n:one. (g:A->real^N)`; `\n:one. (l:real^M)`; `\n:one. (m:real^N)`; `norm(l:real^M)`; `norm(m:real^N)`] UNIFORM_LIM_BILINEAR) THEN ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN ASM_REWRITE_TAC[GSYM dist; GSYM tendsto]);; (* ------------------------------------------------------------------------- *) (* These are special for limits out of the same vector space. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_ID = prove (`!a s. ((\x. x) --> a) (at a within s)`, REWRITE_TAC[LIM_WITHIN] THEN MESON_TAC[]);; let LIM_AT_ID = prove (`!a. ((\x. x) --> a) (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_ID]);; let LIM_AT_ZERO = prove (`!f:real^M->real^N l a. (f --> l) (at a) <=> ((\x. f(a + x)) --> l) (at(vec 0))`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_SUB_RZERO]; FIRST_X_ASSUM(MP_TAC o SPEC `x - a:real^M`) THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_ADD2]]);; (* ------------------------------------------------------------------------- *) (* It's also sometimes useful to extract the limit point from the net. *) (* ------------------------------------------------------------------------- *) let netlimit = new_definition `netlimit net = @a. !x. ~(netord net x a)`;; let NETLIMIT_WITHIN = prove (`!a:real^N s. ~(trivial_limit (at a within s)) ==> (netlimit (at a within s) = a)`, REWRITE_TAC[trivial_limit; netlimit; AT; WITHIN; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!x:real^N. ~(&0 < dist(x,a) /\ dist(x,a) <= dist(a,a) /\ x IN s)` ASSUME_TAC THENL [ASM_MESON_TAC[DIST_REFL; REAL_NOT_LT]; ASM_MESON_TAC[]]);; let NETLIMIT_AT = prove (`!a. netlimit(at a) = a`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN SIMP_TAC[TRIVIAL_LIMIT_AT; WITHIN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Transformation of limit. *) (* ------------------------------------------------------------------------- *) let LIM_TRANSFORM = prove (`!net f g l. ((\x. f x - g x) --> vec 0) net /\ (f --> l) net ==> (g --> l) net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; let LIM_TRANSFORM_EVENTUALLY = prove (`!net f g l. eventually (\x. f x = g x) net /\ (f --> l) net ==> (g --> l) net`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP LIM_EVENTUALLY) MP_TAC) THEN MESON_TAC[LIM_TRANSFORM]);; let LIM_TRANSFORM_WITHIN = prove (`!f g x s d. &0 < d /\ (!x'. x' IN s /\ &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ (f --> l) (at x within s) ==> (g --> l) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN REWRITE_TAC[LIM_WITHIN] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `d:real` THEN ASM_SIMP_TAC[VECTOR_SUB_REFL; DIST_REFL]);; let LIM_TRANSFORM_AT = prove (`!f g x d. &0 < d /\ (!x'. &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ (f --> l) (at x) ==> (g --> l) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_WITHIN]);; let LIM_TRANSFORM_EQ = prove (`!net f:A->real^N g l. ((\x. f x - g x) --> vec 0) net ==> ((f --> l) net <=> (g --> l) net)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THENL [EXISTS_TAC `f:A->real^N` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `g:A->real^N` THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]]);; let LIM_TRANSFORM_WITHIN_SET = prove (`!f a s t. eventually (\x. x IN s <=> x IN t) (at a) ==> ((f --> l) (at a within s) <=> (f --> l) (at a within t))`, REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; LIM_WITHIN] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Common case assuming being away from some crucial point like 0. *) (* ------------------------------------------------------------------------- *) let LIM_TRANSFORM_AWAY_WITHIN = prove (`!f:real^M->real^N g a b s. ~(a = b) /\ (!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ (f --> l) (at a within s) ==> (g --> l) (at a within s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `dist(a:real^M,b)`] THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `y:real^M` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]);; let LIM_TRANSFORM_AWAY_AT = prove (`!f:real^M->real^N g a b. ~(a = b) /\ (!x. ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ (f --> l) (at a) ==> (g --> l) (at a)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_AWAY_WITHIN]);; (* ------------------------------------------------------------------------- *) (* Alternatively, within an open set. *) (* ------------------------------------------------------------------------- *) let LIM_TRANSFORM_WITHIN_OPEN = prove (`!f g:real^M->real^N s a l. open s /\ a IN s /\ (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ (f --> l) (at a) ==> (g --> l) (at a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; let LIM_TRANSFORM_WITHIN_OPEN_IN = prove (`!f g:real^M->real^N s t a l. open_in (subtopology euclidean t) s /\ a IN s /\ (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ (f --> l) (at a within t) ==> (g --> l) (at a within t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Another quite common idiom of an explicit conditional in a sequence. *) (* ------------------------------------------------------------------------- *) let LIM_CASES_FINITE_SEQUENTIALLY = prove (`!f g l. FINITE {n | P n} ==> (((\n. if P n then f n else g n) --> l) sequentially <=> (g --> l) sequentially)`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N + 1` THEN ASM_MESON_TAC[ARITH_RULE `~(x <= n /\ n + 1 <= x)`]);; let LIM_CASES_COFINITE_SEQUENTIALLY = prove (`!f g l. FINITE {n | ~P n} ==> (((\n. if P n then f n else g n) --> l) sequentially <=> (f --> l) sequentially)`, ONCE_REWRITE_TAC[TAUT `(if p then x else y) = (if ~p then y else x)`] THEN REWRITE_TAC[LIM_CASES_FINITE_SEQUENTIALLY]);; let LIM_CASES_SEQUENTIALLY = prove (`!f g l m. (((\n. if m <= n then f n else g n) --> l) sequentially <=> (f --> l) sequentially) /\ (((\n. if m < n then f n else g n) --> l) sequentially <=> (f --> l) sequentially) /\ (((\n. if n <= m then f n else g n) --> l) sequentially <=> (g --> l) sequentially) /\ (((\n. if n < m then f n else g n) --> l) sequentially <=> (g --> l) sequentially)`, SIMP_TAC[LIM_CASES_FINITE_SEQUENTIALLY; LIM_CASES_COFINITE_SEQUENTIALLY; NOT_LE; NOT_LT; FINITE_NUMSEG_LT; FINITE_NUMSEG_LE]);; (* ------------------------------------------------------------------------- *) (* A congruence rule allowing us to transform limits assuming not at point. *) (* ------------------------------------------------------------------------- *) let LIM_CONG_WITHIN = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (at a within s) <=> ((g --> l) (at a within s)))`, REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);; let LIM_CONG_AT = prove (`(!x. ~(x = a) ==> f x = g x) ==> (((\x. f x) --> l) (at a) <=> ((g --> l) (at a)))`, REWRITE_TAC[LIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);; extend_basic_congs [LIM_CONG_WITHIN; LIM_CONG_AT];; (* ------------------------------------------------------------------------- *) (* Useful lemmas on closure and set of possible sequential limits. *) (* ------------------------------------------------------------------------- *) let CLOSURE_SEQUENTIAL = prove (`!s l:real^N. l IN closure(s) <=> ?x. (!n. x(n) IN s) /\ (x --> l) sequentially`, REWRITE_TAC[closure; IN_UNION; LIMPT_SEQUENTIAL; IN_ELIM_THM; IN_DELETE] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `((b ==> c) /\ (~a /\ c ==> b)) /\ (a ==> c) ==> (a \/ b <=> c)`) THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN EXISTS_TAC `\n:num. l:real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);; let CLOSED_CONTAINS_SEQUENTIAL_LIMIT = prove (`!s x l:real^N. closed s /\ (!n. x n IN s) /\ (x --> l) sequentially ==> l IN s`, MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED]);; let CLOSED_SEQUENTIAL_LIMITS = prove (`!s. closed s <=> !x l. (!n. x(n) IN s) /\ (x --> l) sequentially ==> l IN s`, MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED; CLOSED_LIMPT; LIMPT_SEQUENTIAL; IN_DELETE]);; let CLOSURE_APPROACHABLE = prove (`!x s. x IN closure(s) <=> !e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e`, REWRITE_TAC[closure; LIMPT_APPROACHABLE; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[DIST_REFL]);; let CLOSED_APPROACHABLE = prove (`!x s. closed s ==> ((!e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e) <=> x IN s)`, MESON_TAC[CLOSURE_CLOSED; CLOSURE_APPROACHABLE]);; let IN_CLOSURE_DELETE = prove (`!s x:real^N. x IN closure(s DELETE x) <=> x limit_point_of s`, SIMP_TAC[CLOSURE_APPROACHABLE; LIMPT_APPROACHABLE; IN_DELETE; CONJ_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Some other lemmas about sequences. *) (* ------------------------------------------------------------------------- *) let SEQ_OFFSET = prove (`!f l k. (f --> l) sequentially ==> ((\i. f(i + k)) --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN MESON_TAC[ARITH_RULE `N <= n ==> N <= n + k:num`]);; let SEQ_OFFSET_NEG = prove (`!f l k. (f --> l) sequentially ==> ((\i. f(i - k)) --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k:num`]);; let SEQ_OFFSET_REV = prove (`!f l k. ((\i. f(i + k)) --> l) sequentially ==> (f --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k /\ (n - k) + k = n:num`]);; let SEQ_HARMONIC = prove (`((\n. lift(inv(&n))) --> vec 0) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN ASM_REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_NZ]);; (* ------------------------------------------------------------------------- *) (* More properties of closed balls. *) (* ------------------------------------------------------------------------- *) let CLOSED_CBALL = prove (`!x:real^N e. closed(cball(x,e))`, REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_CBALL; dist] THEN GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:num->real^N` THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. x - (s:num->real^N) n` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN ASM_SIMP_TAC[LIM_SUB; LIM_CONST; SEQUENTIALLY] THEN MESON_TAC[GE_REFL]);; let IN_INTERIOR_CBALL = prove (`!x s. x IN interior s <=> ?e. &0 < e /\ cball(x,e) SUBSET s`, REWRITE_TAC[interior; IN_ELIM_THM] THEN MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET_TRANS; BALL_SUBSET_CBALL; CENTRE_IN_BALL; OPEN_BALL]);; let LIMPT_BALL = prove (`!x:real^N y e. y limit_point_of ball(x,e) <=> &0 < e /\ y IN cball(x,e)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < e` THENL [ALL_TAC; ASM_MESON_TAC[LIMPT_EMPTY; REAL_NOT_LT; BALL_EQ_EMPTY]] THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [MESON_TAC[CLOSED_CBALL; CLOSED_LIMPT; LIMPT_SUBSET; BALL_SUBSET_CBALL]; REWRITE_TAC[IN_CBALL; LIMPT_APPROACHABLE; IN_BALL]] THEN DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[DIST_NZ] THENL [MP_TAC(SPECL [`d:real`; `e:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN GEN_MESON_TAC 0 40 1 [VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; ALL_TAC] THEN MP_TAC(SPECL [`norm(y:real^N - x)`; `d:real`] REAL_DOWN2) THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ; dist]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(y:real^N) - (k / dist(y,x)) % (y - x)` THEN REWRITE_TAC[dist; VECTOR_ARITH `(y - c % z) - y = --c % z`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NEG] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN REWRITE_TAC[VECTOR_ARITH `x - (y - k % (y - x)) = (&1 - k) % (x - y)`] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> &0 < abs k`; NORM_MUL] THEN ASM_SIMP_TAC[REAL_ARITH `&0 < k /\ k < d ==> abs k < d`] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(x:real^N - y)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[NORM_SUB]] THEN MATCH_MP_TAC(REAL_ARITH `&0 < k /\ k < &1 ==> abs(&1 - k) < &1`) THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_MUL_LZERO; REAL_MUL_LID]);; let CLOSURE_BALL = prove (`!x:real^N e. &0 < e ==> (closure(ball(x,e)) = cball(x,e))`, SIMP_TAC[EXTENSION; closure; IN_ELIM_THM; IN_UNION; LIMPT_BALL] THEN REWRITE_TAC[IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let INTERIOR_BALL = prove (`!a r. interior(ball(a,r)) = ball(a,r)`, SIMP_TAC[INTERIOR_OPEN; OPEN_BALL]);; let INTERIOR_CBALL = prove (`!x:real^N e. interior(cball(x,e)) = ball(x,e)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL [ALL_TAC; SUBGOAL_THEN `cball(x:real^N,e) = {} /\ ball(x:real^N,e) = {}` (fun th -> REWRITE_TAC[th; INTERIOR_EMPTY]) THEN REWRITE_TAC[IN_BALL; IN_CBALL; EXTENSION; NOT_IN_EMPTY] THEN CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN MP_TAC(ISPECL [`x:real^N`; `y:real^N`] DIST_POS_LE) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN REWRITE_TAC[BALL_SUBSET_CBALL; OPEN_BALL] THEN X_GEN_TAC `t:real^N->bool` THEN SIMP_TAC[SUBSET; IN_CBALL; IN_BALL; REAL_LT_LE] THEN STRIP_TAC THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o GEN_REWRITE_RULE I [open_def]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_CASES_TAC `z:real^N = x` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `k:real` o MATCH_MP REAL_DOWN) THEN SUBGOAL_THEN `?w:real^N. dist(w,x) = k` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_SYM]]; RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ]) THEN DISCH_THEN(MP_TAC o SPEC `z + ((d / &2) / dist(z,x)) % (z - x:real^N)`) THEN REWRITE_TAC[dist; VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; GSYM dist; REAL_LT_IMP_NZ] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN ASM_REWRITE_TAC[REAL_ARITH `abs d < d * &2 <=> &0 < d`] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[dist] THEN REWRITE_TAC[VECTOR_ARITH `x - (z + k % (z - x)) = (&1 + k) % (x - z)`] THEN REWRITE_TAC[REAL_NOT_LE; NORM_MUL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; GSYM dist] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]);; let FRONTIER_BALL = prove (`!a e. &0 < e ==> frontier(ball(a,e)) = sphere(a,e)`, SIMP_TAC[frontier; sphere; CLOSURE_BALL; INTERIOR_OPEN; OPEN_BALL; REAL_LT_IMP_LE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let FRONTIER_CBALL = prove (`!a e. frontier(cball(a,e)) = sphere(a,e)`, SIMP_TAC[frontier; sphere; INTERIOR_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; REAL_LT_IMP_LE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; let CBALL_EQ_EMPTY = prove (`!x e. (cball(x,e) = {}) <=> e < &0`, REWRITE_TAC[EXTENSION; IN_CBALL; NOT_IN_EMPTY; REAL_NOT_LE] THEN MESON_TAC[DIST_POS_LE; DIST_REFL; REAL_LTE_TRANS]);; let CBALL_EMPTY = prove (`!x e. e < &0 ==> cball(x,e) = {}`, REWRITE_TAC[CBALL_EQ_EMPTY]);; let CBALL_EQ_SING = prove (`!x:real^N e. (cball(x,e) = {x}) <=> e = &0`, REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DIST_LE_0]] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `x + (e / &2) % basis 1:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN REWRITE_TAC[dist; VECTOR_ARITH `x - (x + e):real^N = --e`; VECTOR_ARITH `x + e = x <=> e:real^N = vec 0`] THEN REWRITE_TAC[NORM_NEG; NORM_MUL; VECTOR_MUL_EQ_0; NORM_0; VECTOR_SUB_REFL] THEN SIMP_TAC[NORM_BASIS; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);; let CBALL_SING = prove (`!x e. e = &0 ==> cball(x,e) = {x}`, REWRITE_TAC[CBALL_EQ_SING]);; let SPHERE_SING = prove (`!x e. e = &0 ==> sphere(x,e) = {x}`, SIMP_TAC[sphere; DIST_EQ_0; SING_GSPEC]);; let SPHERE_EQ_SING = prove (`!a:real^N r x. sphere(a,r) = {x} <=> x = a /\ r = &0`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPHERE_SING] THEN ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_INSERT_EMPTY] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING] THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!y. (x IN s ==> y IN s /\ ~(y = x)) ==> ~(s = {x})`) THEN EXISTS_TAC `a - (x - a):real^N` THEN REWRITE_TAC[IN_SPHERE] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH);; (* ------------------------------------------------------------------------- *) (* For points in the interior, localization of limits makes no difference. *) (* ------------------------------------------------------------------------- *) let EVENTUALLY_WITHIN_INTERIOR = prove (`!p s x. x IN interior s ==> (eventually p (at x within s) <=> eventually p (at x))`, REWRITE_TAC[EVENTUALLY_WITHIN; EVENTUALLY_AT; IN_INTERIOR] THEN REPEAT GEN_TAC THEN SIMP_TAC[SUBSET; IN_BALL; LEFT_IMP_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[DIST_SYM]);; let LIM_WITHIN_INTERIOR = prove (`!f l s x. x IN interior s ==> ((f --> l) (at x within s) <=> (f --> l) (at x))`, SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR]);; let NETLIMIT_WITHIN_INTERIOR = prove (`!s x:real^N. x IN interior s ==> netlimit(at x within s) = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[OPEN_CONTAINS_BALL] (SPEC_ALL OPEN_INTERIOR))) THEN ASM_MESON_TAC[LIMPT_SUBSET; LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_IMP_LE; SUBSET_TRANS; INTERIOR_SUBSET]);; (* ------------------------------------------------------------------------- *) (* A non-singleton connected set is perfect (i.e. has no isolated points). *) (* ------------------------------------------------------------------------- *) let CONNECTED_IMP_PERFECT = prove (`!s x:real^N. connected s /\ ~(?a. s = {a}) /\ x IN s ==> x limit_point_of s`, REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N}` o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]; REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `cball(x:real^N,e)` THEN REWRITE_TAC[CLOSED_CBALL] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_SING] THEN ASM_MESON_TAC[CENTRE_IN_CBALL; SUBSET; REAL_LT_IMP_LE]; ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Boundedness. *) (* ------------------------------------------------------------------------- *) let bounded = new_definition `bounded s <=> ?a. !x:real^N. x IN s ==> norm(x) <= a`;; let BOUNDED_EMPTY = prove (`bounded {}`, REWRITE_TAC[bounded; NOT_IN_EMPTY]);; let BOUNDED_SUBSET = prove (`!s t. bounded t /\ s SUBSET t ==> bounded s`, MESON_TAC[bounded; SUBSET]);; let BOUNDED_INTERIOR = prove (`!s:real^N->bool. bounded s ==> bounded(interior s)`, MESON_TAC[BOUNDED_SUBSET; INTERIOR_SUBSET]);; let BOUNDED_CLOSURE = prove (`!s:real^N->bool. bounded s ==> bounded(closure s)`, REWRITE_TAC[bounded; CLOSURE_SEQUENTIAL] THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MESON_TAC[REWRITE_RULE[eventually] LIM_NORM_UBOUND; TRIVIAL_LIMIT_SEQUENTIALLY; trivial_limit]);; let BOUNDED_CLOSURE_EQ = prove (`!s:real^N->bool. bounded(closure s) <=> bounded s`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSURE] THEN MESON_TAC[BOUNDED_SUBSET; CLOSURE_SUBSET]);; let BOUNDED_CBALL = prove (`!x:real^N e. bounded(cball(x,e))`, REPEAT GEN_TAC THEN REWRITE_TAC[bounded] THEN EXISTS_TAC `norm(x:real^N) + e` THEN REWRITE_TAC[IN_CBALL; dist] THEN NORM_ARITH_TAC);; let BOUNDED_BALL = prove (`!x e. bounded(ball(x,e))`, MESON_TAC[BALL_SUBSET_CBALL; BOUNDED_CBALL; BOUNDED_SUBSET]);; let FINITE_IMP_BOUNDED = prove (`!s:real^N->bool. FINITE s ==> bounded s`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[BOUNDED_EMPTY] THEN REWRITE_TAC[bounded; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) STRIP_ASSUME_TAC) THEN EXISTS_TAC `norm(x:real^N) + abs B` THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH `(y <= b /\ &0 <= x ==> y <= x + abs b) /\ x <= x + abs b`]);; let BOUNDED_UNION = prove (`!s t. bounded (s UNION t) <=> bounded s /\ bounded t`, REWRITE_TAC[bounded; IN_UNION] THEN MESON_TAC[REAL_LE_MAX]);; let BOUNDED_UNIONS = prove (`!f. FINITE f /\ (!s. s IN f ==> bounded s) ==> bounded(UNIONS f)`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; BOUNDED_EMPTY; IN_INSERT; UNIONS_INSERT] THEN MESON_TAC[BOUNDED_UNION]);; let BOUNDED_POS = prove (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) <= b`, REWRITE_TAC[bounded] THEN MESON_TAC[REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x <= &1 + abs(y))`]);; let BOUNDED_POS_LT = prove (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) < b`, REWRITE_TAC[bounded] THEN MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);; let BOUNDED_INTER = prove (`!s t. bounded s \/ bounded t ==> bounded (s INTER t)`, MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; let BOUNDED_DIFF = prove (`!s t. bounded s ==> bounded (s DIFF t)`, MESON_TAC[BOUNDED_SUBSET; SUBSET_DIFF]);; let BOUNDED_INSERT = prove (`!x s. bounded(x INSERT s) <=> bounded s`, ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN SIMP_TAC[BOUNDED_UNION; FINITE_IMP_BOUNDED; FINITE_RULES]);; let BOUNDED_SING = prove (`!a. bounded {a}`, REWRITE_TAC[BOUNDED_INSERT; BOUNDED_EMPTY]);; let BOUNDED_INTERS = prove (`!f:(real^N->bool)->bool. (?s:real^N->bool. s IN f /\ bounded s) ==> bounded(INTERS f)`, REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN ASM SET_TAC[]);; let NOT_BOUNDED_UNIV = prove (`~(bounded (:real^N))`, REWRITE_TAC[BOUNDED_POS; NOT_FORALL_THM; NOT_EXISTS_THM; IN_UNIV; DE_MORGAN_THM; REAL_NOT_LE] THEN X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `B + &1` VECTOR_CHOOSE_SIZE) THEN ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> &0 <= B + &1`] THEN MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC);; let COBOUNDED_IMP_UNBOUNDED = prove (`!s. bounded((:real^N) DIFF s) ==> ~bounded s`, GEN_TAC THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN REWRITE_TAC[GSYM BOUNDED_UNION; SET_RULE `UNIV DIFF s UNION s = UNIV`] THEN REWRITE_TAC[NOT_BOUNDED_UNIV]);; let BOUNDED_LINEAR_IMAGE = prove (`!f:real^M->real^N s. bounded s /\ linear f ==> bounded(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:real`) MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `B2:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN EXISTS_TAC `B2 * B1` THEN ASM_SIMP_TAC[REAL_LT_MUL; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * norm(x:real^M)` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ]);; let BOUNDED_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (bounded (IMAGE f s) <=> bounded s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE BOUNDED_LINEAR_IMAGE));; add_linear_invariants [BOUNDED_LINEAR_IMAGE_EQ];; let BOUNDED_SCALING = prove (`!c s. bounded s ==> bounded (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID]);; let BOUNDED_NEGATIONS = prove (`!s. bounded s ==> bounded (IMAGE (--) s)`, GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `-- &1` o MATCH_MP BOUNDED_SCALING) THEN REWRITE_TAC[bounded; IN_IMAGE; VECTOR_MUL_LNEG; VECTOR_MUL_LID]);; let BOUNDED_TRANSLATION = prove (`!a:real^N s. bounded s ==> bounded (IMAGE (\x. a + x) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `B + norm(a:real^N)` THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN NORM_ARITH_TAC);; let BOUNDED_TRANSLATION_EQ = prove (`!a s. bounded (IMAGE (\x:real^N. a + x) s) <=> bounded s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_TRANSLATION] THEN DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP BOUNDED_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; add_translation_invariants [BOUNDED_TRANSLATION_EQ];; let BOUNDED_DIFFS = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> bounded {x - y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm x <= a /\ norm y <= b ==> norm(x - y) <= a + b`) THEN ASM_SIMP_TAC[]);; let BOUNDED_SUMS = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> bounded {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH `norm x <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN ASM_SIMP_TAC[]);; let BOUNDED_SUMS_IMAGE = prove (`!f g t. bounded {f x | x IN t} /\ bounded {g x | x IN t} ==> bounded {f x + g x | x IN t}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN SET_TAC[]);; let BOUNDED_SUMS_IMAGES = prove (`!f:A->B->real^N t s. FINITE s /\ (!a. a IN s ==> bounded {f x a | x IN t}) ==> bounded { vsum s (f x) | x IN t}`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES] THEN CONJ_TAC THENL [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `{vec 0:real^N}` THEN SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_RULES] THEN SET_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUMS_IMAGE THEN ASM_SIMP_TAC[IN_INSERT]);; let BOUNDED_SUBSET_BALL = prove (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET ball(x,r)`, REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `&2 * B + norm(x:real^N)` THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 < B /\ &0 <= x ==> &0 < &2 * B + x`] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[IN_BALL] THEN UNDISCH_TAC `&0 < B` THEN NORM_ARITH_TAC);; let BOUNDED_SUBSET_CBALL = prove (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET cball(x,r)`, MESON_TAC[BOUNDED_SUBSET_BALL; SUBSET_TRANS; BALL_SUBSET_CBALL]);; let UNBOUNDED_INTER_COBOUNDED = prove (`!s t. ~bounded s /\ bounded((:real^N) DIFF t) ==> ~(s INTER t = {})`, REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (:real^N) DIFF t`] THEN MESON_TAC[BOUNDED_SUBSET]);; let COBOUNDED_INTER_UNBOUNDED = prove (`!s t. bounded((:real^N) DIFF s) /\ ~bounded t ==> ~(s INTER t = {})`, REWRITE_TAC[SET_RULE `s INTER t = {} <=> t SUBSET (:real^N) DIFF s`] THEN MESON_TAC[BOUNDED_SUBSET]);; let SUBSPACE_BOUNDED_EQ_TRIVIAL = prove (`!s:real^N->bool. subspace s ==> (bounded s <=> s = {vec 0})`, REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_SING] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN ASM_SIMP_TAC[SUBSPACE_0] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN REWRITE_TAC[bounded; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm v % v:real^N`) THEN ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC);; let BOUNDED_COMPONENTWISE = prove (`!s:real^N->bool. bounded s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> bounded (IMAGE (\x. lift(x$i)) s)`, GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; NORM_LIFT] THEN EQ_TAC THENL [ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->real` THEN DISCH_TAC THEN EXISTS_TAC `sum(1..dimindex(:N)) b` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. &0)` THEN SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POS] THEN MATCH_MP_TAC SUM_LT_ALL THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY] THEN REWRITE_TAC[NOT_LT; DIMINDEX_GE_1]; REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG]]);; (* ------------------------------------------------------------------------- *) (* Some theorems on sups and infs using the notion "bounded". *) (* ------------------------------------------------------------------------- *) let BOUNDED_LIFT = prove (`!s. bounded(IMAGE lift s) <=> ?a. !x. x IN s ==> abs(x) <= a`, REWRITE_TAC[bounded; FORALL_LIFT; NORM_LIFT; LIFT_IN_IMAGE_LIFT]);; let BOUNDED_HAS_SUP = prove (`!s. bounded(IMAGE lift s) /\ ~(s = {}) ==> (!x. x IN s ==> x <= sup s) /\ (!b. (!x. x IN s ==> x <= b) ==> sup s <= b)`, REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN MESON_TAC[SUP; REAL_ARITH `abs(x) <= a ==> x <= a`]);; let SUP_INSERT = prove (`!x s. bounded (IMAGE lift s) ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_LE_MAX; REAL_LT_MAX; IN_INSERT] THEN MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; let BOUNDED_HAS_INF = prove (`!s. bounded(IMAGE lift s) /\ ~(s = {}) ==> (!x. x IN s ==> inf s <= x) /\ (!b. (!x. x IN s ==> b <= x) ==> b <= inf s)`, REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN MESON_TAC[INF; REAL_ARITH `abs(x) <= a ==> --a <= x`]);; let INF_INSERT = prove (`!x s. bounded (IMAGE lift s) ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN REWRITE_TAC[REAL_MIN_LE; REAL_MIN_LT; IN_INSERT] THEN MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; (* ------------------------------------------------------------------------- *) (* Subset and overlapping relations on balls. *) (* ------------------------------------------------------------------------- *) let SUBSET_BALLS = prove (`(!a a':real^N r r'. ball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ (!a a':real^N r r'. ball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ (!a a':real^N r r'. cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0) /\ (!a a':real^N r r'. cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0)`, let lemma = prove (`(!a':real^N r r'. cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0) /\ (!a':real^N r r'. cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0)`, CONJ_TAC THEN (GEOM_ORIGIN_TAC `a':real^N` THEN REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN EQ_TAC THENL [REWRITE_TAC[DIST_0]; NORM_ARITH_TAC] THEN DISJ_CASES_TAC(REAL_ARITH `r < &0 \/ &0 <= r`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISJ1_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `r % basis 1:real^N`) THEN ASM_SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; FIRST_X_ASSUM(MP_TAC o SPEC `(&1 + r / norm(a)) % a:real^N`) THEN SIMP_TAC[dist; VECTOR_ARITH `a - (&1 + x) % a:real^N = --(x % a)`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_NEG; REAL_POS; REAL_LE_DIV; NORM_POS_LE; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`]] THEN UNDISCH_TAC `&0 <= r` THEN NORM_ARITH_TAC)) and tac = DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN ASM_SIMP_TAC[CLOSED_CBALL; CLOSURE_CLOSED; CLOSURE_BALL] in REWRITE_TAC[AND_FORALL_THM] THEN GEOM_ORIGIN_TAC `a':real^N` THEN REPEAT STRIP_TAC THEN (EQ_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) THEN MATCH_MP_TAC(SET_RULE `(s = {} <=> q) /\ (s SUBSET t /\ ~(s = {}) /\ ~(t = {}) ==> p) ==> s SUBSET t ==> p \/ q`) THEN REWRITE_TAC[BALL_EQ_EMPTY; CBALL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL [tac; tac; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[lemma] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let INTER_BALLS_EQ_EMPTY = prove (`(!a b:real^N r s. ball(a,r) INTER ball(b,s) = {} <=> r <= &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ (!a b:real^N r s. ball(a,r) INTER cball(b,s) = {} <=> r <= &0 \/ s < &0 \/ r + s <= dist(a,b)) /\ (!a b:real^N r s. cball(a,r) INTER ball(b,s) = {} <=> r < &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ (!a b:real^N r s. cball(a,r) INTER cball(b,s) = {} <=> r < &0 \/ s < &0 \/ r + s < dist(a,b))`, REPEAT STRIP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_CBALL; IN_BALL] THEN (EQ_TAC THENL [ALL_TAC; SPEC_TAC(`b % basis 1:real^N`,`v:real^N`) THEN CONV_TAC NORM_ARITH]) THEN DISCH_THEN(MP_TAC o GEN `c:real` o SPEC `c % basis 1:real^N`) THEN SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1; dist; NORM_NEG; VECTOR_SUB_LZERO; GSYM VECTOR_SUB_RDISTRIB; REAL_MUL_RID] THEN ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `min b r:real` th) THEN MP_TAC(SPEC `max (&0) (b - s:real)` th) THEN MP_TAC(SPEC `(r + (b - s)) / &2` th)) THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Every closed set is a G_Delta. *) (* ------------------------------------------------------------------------- *) let CLOSED_AS_GDELTA = prove (`!s:real^N->bool. closed s ==> ?g. COUNTABLE g /\ (!u. u IN g ==> open u) /\ INTERS g = s`, REPEAT STRIP_TAC THEN EXISTS_TAC `{ UNIONS { ball(x:real^N,inv(&n + &1)) | x IN s} | n IN (:num)}` THEN SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN SIMP_TAC[FORALL_IN_IMAGE; OPEN_UNIONS; OPEN_BALL] THEN MATCH_MP_TAC(SET_RULE `closure s = s /\ s SUBSET t /\ t SUBSET closure s ==> t = s`) THEN ASM_REWRITE_TAC[CLOSURE_EQ] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; INTERS_IMAGE; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; UNIONS_IMAGE] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS)) THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Compactness (the definition is the one based on convegent subsequences). *) (* ------------------------------------------------------------------------- *) let compact = new_definition `compact s <=> !f:num->real^N. (!n. f(n) IN s) ==> ?l r. l IN s /\ (!m n:num. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`;; let MONOTONE_BIGGER = prove (`!r. (!m n. m < n ==> r(m) < r(n)) ==> !n:num. n <= r(n)`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LE_0; ARITH_RULE `n <= m /\ m < p ==> SUC n <= p`; LT]);; let LIM_SUBSEQUENCE = prove (`!s r l. (!m n. m < n ==> r(m) < r(n)) /\ (s --> l) sequentially ==> (s o r --> l) sequentially`, REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[MONOTONE_BIGGER; LE_TRANS]);; let MONOTONE_SUBSEQUENCE = prove (`!s:num->real. ?r:num->num. (!m n. m < n ==> r(m) < r(n)) /\ ((!m n. m <= n ==> s(r(m)) <= s(r(n))) \/ (!m n. m <= n ==> s(r(n)) <= s(r(m))))`, GEN_TAC THEN ASM_CASES_TAC `!n:num. ?p. n < p /\ !m. p <= m ==> s(m) <= s(p)` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; NOT_IMP; DE_MORGAN_THM] THEN REWRITE_TAC[RIGHT_OR_EXISTS_THM; SKOLEM_THM; REAL_NOT_LE; REAL_NOT_LT] THENL [ABBREV_TAC `N = 0`; DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC)] THEN DISCH_THEN(X_CHOOSE_THEN `next:num->num` STRIP_ASSUME_TAC) THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `(r 0 = next(SUC N)) /\ (!n. r(SUC n) = next(r n))` THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THENL [SUBGOAL_THEN `!m:num n:num. r n <= m ==> s(m) <= s(r n):real` ASSUME_TAC THEN TRY CONJ_TAC THEN TRY DISJ2_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL; LT_IMP_LE; LT_TRANS]; SUBGOAL_THEN `!n. N < (r:num->num) n` ASSUME_TAC THEN TRY(CONJ_TAC THENL [GEN_TAC; DISJ1_TAC THEN GEN_TAC]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN TRY STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_REFL; LT_LE; LTE_TRANS; REAL_LE_REFL; REAL_LT_LE; REAL_LE_TRANS; LT]]);; let CONVERGENT_BOUNDED_INCREASING = prove (`!s:num->real b. (!m n. m <= n ==> s m <= s n) /\ (!n. abs(s n) <= b) ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. ?n. (s:num->real) n = x` REAL_COMPLETE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_ARITH `abs(x) <= b ==> x <= b`]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `l - e`) THEN ASM_MESON_TAC[REAL_ARITH `&0 < e ==> ~(l <= l - e)`; REAL_ARITH `x <= y /\ y <= l /\ ~(x <= l - e) ==> abs(y - l) < e`]);; let CONVERGENT_BOUNDED_MONOTONE = prove (`!s:num->real b. (!n. abs(s n) <= b) /\ ((!m n. m <= n ==> s m <= s n) \/ (!m n. m <= n ==> s n <= s m)) ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CONVERGENT_BOUNDED_INCREASING]; ALL_TAC] THEN MP_TAC(SPEC `\n. --((s:num->real) n)` CONVERGENT_BOUNDED_INCREASING) THEN ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_ABS_NEG] THEN ASM_MESON_TAC[REAL_ARITH `abs(x - --l) = abs(--x - l)`]);; let COMPACT_REAL_LEMMA = prove (`!s b. (!n:num. abs(s n) <= b) ==> ?l r. (!m n:num. m < n ==> r(m) < r(n)) /\ !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(r n) - l) < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MP_TAC(SPEC `s:num->real` MONOTONE_SUBSEQUENCE) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN ASM_MESON_TAC[]);; let COMPACT_LEMMA = prove (`!s. bounded s /\ (!n. (x:num->real^N) n IN s) ==> !d. d <= dimindex(:N) ==> ?l:real^N r. (!m n. m < n ==> r m < (r:num->num) n) /\ !e. &0 < e ==> ?N. !n i. 1 <= i /\ i <= d ==> N <= n ==> abs(x(r n)$i - l$i) < e`, GEN_TAC THEN REWRITE_TAC[bounded] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:real`) ASSUME_TAC) THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 <=> F`; CONJ_ASSOC] THEN DISCH_TAC THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN STRIP_TAC THEN MP_TAC(SPECL [`\n:num. (x:num->real^N) (r n) $ (SUC d)`; `b:real`] COMPACT_REAL_LEMMA) THEN REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; ARITH_RULE `1 <= SUC n`]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `y:real` (X_CHOOSE_THEN `s:num->num` STRIP_ASSUME_TAC)) THEN MAP_EVERY EXISTS_TAC [`(lambda k. if k = SUC d then y else (l:real^N)$k):real^N`; `(r:num->num) o (s:num->num)`] THEN ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN REPEAT(FIRST_ASSUM(C UNDISCH_THEN (MP_TAC o SPEC `e:real`) o concl)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN FIRST_ASSUM(fun th -> SIMP_TAC[LAMBDA_BETA; MATCH_MP(ARITH_RULE `SUC d <= n ==> !i. 1 <= i /\ i <= SUC d ==> 1 <= i /\ i <= n`) th]) THEN REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRY COND_CASES_TAC THEN ASM_MESON_TAC[MONOTONE_BIGGER; LE_TRANS; ARITH_RULE `N1 + N2 <= n ==> N2 <= n:num /\ N1 <= n`; ARITH_RULE `1 <= i /\ i <= d /\ SUC d <= n ==> ~(i = SUC d) /\ 1 <= SUC d /\ d <= n /\ i <= n`]);; let BOUNDED_CLOSED_IMP_COMPACT = prove (`!s:real^N->bool. bounded s /\ closed s ==> compact s`, REPEAT STRIP_TAC THEN REWRITE_TAC[compact] THEN X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` COMPACT_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CLOSED_SEQUENTIAL_LIMITS]) THEN EXISTS_TAC `(x:num->real^N) o (r:num->num)` THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / &(dimindex(:N))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_NONZERO; REAL_HALF; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[dist] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MATCH_MP (REAL_ARITH `a <= b ==> b < e ==> a < e`) (SPEC_ALL NORM_LE_L1)) THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (1..dimindex(:N)) (\k. e / &2 / &(dimindex(:N)))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[o_THM; LAMBDA_BETA; vector_sub] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; LE_TRANS]; ASM_SIMP_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_DIV_LMUL; REAL_OF_NUM_EQ; DIMINDEX_NONZERO; REAL_LE_REFL; REAL_LT_LDIV_EQ; ARITH; REAL_OF_NUM_LT; REAL_ARITH `x < x * &2 <=> &0 < x`]]);; (* ------------------------------------------------------------------------- *) (* Completeness. *) (* ------------------------------------------------------------------------- *) let cauchy = new_definition `cauchy (s:num->real^N) <=> !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> dist(s m,s n) < e`;; let complete = new_definition `complete s <=> !f:num->real^N. (!n. f n IN s) /\ cauchy f ==> ?l. l IN s /\ (f --> l) sequentially`;; let CAUCHY = prove (`!s:num->real^N. cauchy s <=> !e. &0 < e ==> ?N. !n. n >= N ==> dist(s n,s N) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL [MESON_TAC[LE_REFL]; DISCH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]);; let CONVERGENT_IMP_CAUCHY = prove (`!s l. (s --> l) sequentially ==> cauchy s`, REWRITE_TAC[LIM_SEQUENTIALLY; cauchy] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN ASM_MESON_TAC[GE; LE_REFL; DIST_TRIANGLE_HALF_L]);; let CAUCHY_IMP_BOUNDED = prove (`!s:num->real^N. cauchy s ==> bounded {y | ?n. y = s n}`, REWRITE_TAC[cauchy; bounded; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN REWRITE_TAC[GE_REFL] THEN DISCH_TAC THEN SUBGOAL_THEN `!n:num. N <= n ==> norm(s n :real^N) <= norm(s N) + &1` ASSUME_TAC THENL [ASM_MESON_TAC[GE; dist; DIST_SYM; NORM_TRIANGLE_SUB; REAL_ARITH `a <= b + c /\ c < &1 ==> a <= b + &1`]; MP_TAC(ISPECL [`\n:num. norm(s n :real^N)`; `0..N`] UPPER_BOUND_FINITE_SET_REAL) THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; LEFT_IMP_EXISTS_THM] THEN ASM_MESON_TAC[LE_CASES; REAL_ARITH `x <= a \/ x <= b ==> x <= abs a + abs b`]]);; let COMPACT_IMP_COMPLETE = prove (`!s:real^N->bool. compact s ==> complete s`, GEN_TAC THEN REWRITE_TAC[complete; compact] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:num->real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_ADD)) THEN DISCH_THEN(MP_TAC o SPEC `\n. (f:num->real^N)(n) - f(r n)`) THEN DISCH_THEN(MP_TAC o SPEC `vec 0: real^N`) THEN ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_ADD2; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cauchy]) THEN REWRITE_TAC[GE; LIM; SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN SUBGOAL_THEN `!n:num. n <= r(n)` MP_TAC THENL [INDUCT_TAC; ALL_TAC] THEN ASM_MESON_TAC[ LE_TRANS; LE_REFL; LT; LET_TRANS; LE_0; LE_SUC_LT]);; let COMPLETE_UNIV = prove (`complete(:real^N)`, REWRITE_TAC[complete; IN_UNIV] THEN X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP BOUNDED_CLOSURE) THEN MP_TAC(ISPEC `closure {y:real^N | ?n:num. y = x n}` COMPACT_IMP_COMPLETE) THEN ASM_SIMP_TAC[BOUNDED_CLOSED_IMP_COMPACT; CLOSED_CLOSURE; complete] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN ASM_REWRITE_TAC[closure; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]);; let COMPLETE_EQ_CLOSED = prove (`!s:real^N->bool. complete s <=> closed s`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[complete; CLOSED_LIMPT; LIMPT_SEQUENTIAL] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[CONVERGENT_IMP_CAUCHY; IN_DELETE; LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY]; REWRITE_TAC[complete; CLOSED_SEQUENTIAL_LIMITS] THEN DISCH_TAC THEN X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN MP_TAC(REWRITE_RULE[complete] COMPLETE_UNIV) THEN DISCH_THEN(MP_TAC o SPEC `f:num->real^N`) THEN ASM_REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[]]);; let CONVERGENT_EQ_CAUCHY = prove (`!s. (?l. (s --> l) sequentially) <=> cauchy s`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONVERGENT_IMP_CAUCHY]; REWRITE_TAC[REWRITE_RULE[complete; IN_UNIV] COMPLETE_UNIV]]);; let CONVERGENT_IMP_BOUNDED = prove (`!s l. (s --> l) sequentially ==> bounded (IMAGE s (:num))`, REWRITE_TAC[LEFT_FORALL_IMP_THM; CONVERGENT_EQ_CAUCHY] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN REWRITE_TAC[IMAGE; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Total boundedness. *) (* ------------------------------------------------------------------------- *) let COMPACT_IMP_TOTALLY_BOUNDED = prove (`!s:real^N->bool. compact s ==> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\ s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`; SUBSET] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?x:num->real^N. !n. x(n) IN s /\ !m. m < n ==> ~(dist(x(m),x(n)) < e)` MP_TAC THENL [SUBGOAL_THEN `?x:num->real^N. !n. x(n) = @y. y IN s /\ !m. m < n ==> ~(dist(x(m),y) < e)` MP_TAC THENL [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(SUBST1_TAC o SPEC `n:num`) THEN STRIP_TAC THEN CONV_TAC SELECT_CONV THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (x:num->real^N) {m | m < n}`) THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[IN_BALL]; ALL_TAC] THEN REWRITE_TAC[compact; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_THM; NOT_EXISTS_THM; NOT_IMP; NOT_FORALL_THM; NOT_IMP] THEN X_GEN_TAC `N:num` THEN MAP_EVERY EXISTS_TAC [`N:num`; `SUC N`] THEN CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[LT]]);; (* ------------------------------------------------------------------------- *) (* Heine-Borel theorem (following Burkill & Burkill vol. 2) *) (* ------------------------------------------------------------------------- *) let HEINE_BOREL_LEMMA = prove (`!s:real^N->bool. compact s ==> !t. s SUBSET (UNIONS t) /\ (!b. b IN t ==> open b) ==> ?e. &0 < e /\ !x. x IN s ==> ?b. b IN t /\ ball(x,e) SUBSET b`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_ARITH `x <= y ==> x < y + &1`; FORALL_AND_THM; REAL_POS; NOT_FORALL_THM; NOT_IMP; SKOLEM_THM; compact] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN SUBGOAL_THEN `?b:real^N->bool. l IN b /\ b IN t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; IN_UNIONS]; ALL_TAC] THEN SUBGOAL_THEN `?e. &0 < e /\ !z:real^N. dist(z,l) < e ==> z IN b` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_def]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN SUBGOAL_THEN `&0 < e / &2` (fun th -> REWRITE_TAC[th; o_THM] THEN MP_TAC(GEN_REWRITE_RULE I [REAL_ARCH_INV] th)) THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(r:num->num)(N1 + N2)`; `b:real^N->bool`]) THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_R THEN EXISTS_TAC `(f:num->real^N)(r(N1 + N2:num))` THEN CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N1)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_MESON_TAC[ARITH_RULE `(~(n = 0) ==> 0 < n)`; LE_ADD; MONOTONE_BIGGER; LT_IMP_LE; LE_TRANS]);; let COMPACT_IMP_HEINE_BOREL = prove (`!s. compact (s:real^N->bool) ==> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `f:(real^N->bool)->bool` o MATCH_MP HEINE_BOREL_LEMMA) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_TAC `B:real^N->real^N->bool`) THEN FIRST_ASSUM(MP_TAC o SPEC `e:real` o MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN ASM_REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[IN_UNIONS; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (B:real^N->real^N->bool) k` THEN ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN ASM_MESON_TAC[IN_BALL]);; (* ------------------------------------------------------------------------- *) (* Bolzano-Weierstrass property. *) (* ------------------------------------------------------------------------- *) let HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. (!f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')) ==> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, REWRITE_TAC[RIGHT_IMP_FORALL_THM; limit_point_of] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> c ==> ~d ==> a ==> ~b`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `f:real^N->real^N->bool`) THEN DISCH_THEN(MP_TAC o SPEC `{t:real^N->bool | ?x:real^N. x IN s /\ (t = f x)}`) THEN REWRITE_TAC[INFINITE; SUBSET; IN_ELIM_THM; IN_UNIONS; NOT_IMP] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:real^N | x IN t /\ (f(x):real^N->bool) IN g}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE_INJ_GENERAL THEN ASM_MESON_TAC[SUBSET]; SIMP_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `(u:real^N) IN s` ASSUME_TAC THEN ASM_MESON_TAC[SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Complete the chain of compactness variants. *) (* ------------------------------------------------------------------------- *) let BOLZANO_WEIERSTRASS_IMP_BOUNDED = prove (`!s:real^N->bool. (!t. INFINITE t /\ t SUBSET s ==> ?x. x limit_point_of t) ==> bounded s`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[compact; bounded] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; SKOLEM_THM; NOT_IMP] THEN REWRITE_TAC[REAL_NOT_LE] THEN DISCH_THEN(X_CHOOSE_TAC `beyond:real->real^N`) THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `(f(0) = beyond(&0)) /\ (!n. f(SUC n) = beyond(norm(f n) + &1):real^N)` THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (x:num->real^N) UNIV` THEN SUBGOAL_THEN `!m n. m < n ==> norm((x:num->real^N) m) + &1 < norm(x n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH `b < b + &1`]; ALL_TAC] THEN SUBGOAL_THEN `!m n. ~(m = n) ==> &1 < dist((x:num->real^N) m,x n)` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPECL [`m:num`; `n:num`] LT_CASES) THEN ASM_MESON_TAC[dist; LT_CASES; NORM_TRIANGLE_SUB; NORM_SUB; REAL_ARITH `x + &1 < y /\ y <= x + d ==> &1 < d`]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[INFINITE_IMAGE_INJ; num_INFINITE; DIST_REFL; REAL_ARITH `~(&1 < &0)`]; REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N` THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN REWRITE_TAC[IN_IMAGE; IN_UNIV; LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `dist((x:num->real^N) k,l)`) THEN ASM_SIMP_TAC[DIST_POS_LT] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `m:num = k` THEN ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; REAL_LT_TRANS; REAL_LT_REFL]);; let SEQUENCE_INFINITE_LEMMA = prove (`!f l. (!n. ~(f(n) = l)) /\ (f --> l) sequentially ==> INFINITE {y:real^N | ?n. y = f n}`, REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC `IMAGE (\y:real^N. dist(y,l)) {y | ?n:num. y = f n}` INF_FINITE) THEN ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE; FINITE_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[LIM_SEQUENTIALLY; LE_REFL; REAL_NOT_LE; DIST_POS_LT]);; let LIMPT_OF_SEQUENCE_SUBSEQUENCE = prove (`!f:num->real^N l. l limit_point_of (IMAGE f (:num)) ==> ?r. (!m n. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inf((inv(&n + &1)) INSERT IMAGE (\k. dist((f:num->real^N) k,l)) {k | k IN 0..n /\ ~(f k = l)})`) THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_INSERT; NOT_INSERT_EMPTY; FINITE_RESTRICT; FINITE_NUMSEG; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN SIMP_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; GSYM DIST_NZ; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `nn:num->num` STRIP_ASSUME_TAC) THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `r 0 = nn 0 /\ (!n. r (SUC n) = nn(r n))` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN REWRITE_TAC[LT_TRANS] THEN X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`(r:num->num) n`; `(nn:num->num)(r(n:num))`]) THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_0; REAL_LT_REFL] THEN ARITH_TAC; DISCH_THEN(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER)] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[CONJUNCT1 LE] THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&((r:num->num) n) + &1)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(ARITH_RULE `N <= SUC n /\ n <= r n ==> N <= r n + 1`) THEN ASM_REWRITE_TAC[]);; let SEQUENCE_UNIQUE_LIMPT = prove (`!f l l':real^N. (f --> l) sequentially /\ l' limit_point_of {y | ?n. y = f n} ==> l' = l`, REWRITE_TAC[SET_RULE `{y | ?n. y = f n} = IMAGE f (:num)`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `(f:num->real^N) o (r:num->num)` THEN ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUBSEQUENCE]);; let BOLZANO_WEIERSTRASS_IMP_CLOSED = prove (`!s:real^N->bool. (!t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t) ==> closed s`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN MAP_EVERY X_GEN_TAC [`f:num->real^N`; `l:real^N`] THEN DISCH_TAC THEN MAP_EVERY (MP_TAC o ISPECL [`f:num->real^N`; `l:real^N`]) [SEQUENCE_UNIQUE_LIMPT; SEQUENCE_INFINITE_LEMMA] THEN MATCH_MP_TAC(TAUT `(~d ==> a /\ ~(b /\ c)) ==> (a ==> b) ==> c ==> d`) THEN DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | ?n:num. y = f n}`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM]; ABBREV_TAC `t = {y:real^N | ?n:num. y = f n}`] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence express everything as an equivalence. *) (* ------------------------------------------------------------------------- *) let COMPACT_EQ_HEINE_BOREL = prove (`!s:real^N->bool. compact s <=> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[COMPACT_IMP_HEINE_BOREL] THEN DISCH_THEN(MP_TAC o MATCH_MP HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS) THEN DISCH_TAC THEN MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN ASM_MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED]);; let COMPACT_EQ_BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. compact s <=> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[COMPACT_EQ_HEINE_BOREL; HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS]; MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED; BOUNDED_CLOSED_IMP_COMPACT]]);; let COMPACT_EQ_BOUNDED_CLOSED = prove (`!s:real^N->bool. compact s <=> bounded s /\ closed s`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSED_IMP_COMPACT] THEN MESON_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED]);; let COMPACT_IMP_BOUNDED = prove (`!s. compact s ==> bounded s`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; let COMPACT_IMP_CLOSED = prove (`!s. compact s ==> closed s`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; let COMPACT_SEQUENCE_WITH_LIMIT = prove (`!f l:real^N. (f --> l) sequentially ==> compact (l INSERT IMAGE f (:num))`, REPEAT STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REWRITE_TAC[BOUNDED_INSERT] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_BOUNDED]; SIMP_TAC[CLOSED_LIMPT; LIMPT_INSERT; IN_INSERT] THEN REWRITE_TAC[IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC SEQUENCE_UNIQUE_LIMPT THEN ASM_MESON_TAC[]]);; let CLOSED_IN_COMPACT = prove (`!s t:real^N->bool. compact s /\ closed_in (subtopology euclidean s) t ==> compact t`, SIMP_TAC[IMP_CONJ; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_EQ] THEN MESON_TAC[BOUNDED_SUBSET]);; let CLOSED_IN_COMPACT_EQ = prove (`!s t. compact s ==> (closed_in (subtopology euclidean s) t <=> compact t /\ t SUBSET s)`, MESON_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);; (* ------------------------------------------------------------------------- *) (* A version of Heine-Borel for subtopology. *) (* ------------------------------------------------------------------------- *) let COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY = prove (`!s:real^N->bool. compact s <=> (!f. (!t. t IN f ==> open_in(subtopology euclidean s) t) /\ s SUBSET UNIONS f ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET UNIONS f')`, GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `f:(real^N->bool)->bool` THENL [REWRITE_TAC[OPEN_IN_OPEN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `m:(real^N->bool)->(real^N->bool)`) ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (m:(real^N->bool)->(real^N->bool)) f`) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `IMAGE (\t:real^N->bool. s INTER t) f'` THEN ASM_SIMP_TAC[FINITE_IMAGE; UNIONS_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_IMAGE]) THEN STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{s INTER t:real^N->bool | t IN f}`) THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_IN_OPEN; UNIONS_IMAGE] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* More easy lemmas. *) (* ------------------------------------------------------------------------- *) let COMPACT_CLOSURE = prove (`!s. compact(closure s) <=> bounded s`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; BOUNDED_CLOSURE_EQ]);; let BOLZANO_WEIERSTRASS_CONTRAPOS = prove (`!s t:real^N->bool. compact s /\ t SUBSET s /\ (!x. x IN s ==> ~(x limit_point_of t)) ==> FINITE t`, REWRITE_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; INFINITE] THEN MESON_TAC[]);; let DISCRETE_BOUNDED_IMP_FINITE = prove (`!s:real^N->bool e. &0 < e /\ (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) /\ bounded s ==> FINITE s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `compact(s:real^N->bool)` MP_TAC THENL [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN ASM_MESON_TAC[DISCRETE_IMP_CLOSED]; DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL)] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. ball(x,e)) s`) THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; UNIONS_IMAGE; IN_ELIM_THM] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL]; ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`]] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_BALL; dist] THEN ASM_MESON_TAC[SUBSET]);; let BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. bounded s /\ INFINITE s ==> ?x. x limit_point_of s`, GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP NO_LIMIT_POINT_IMP_CLOSED) THEN STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` COMPACT_EQ_BOLZANO_WEIERSTRASS) THEN ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[]);; let BOUNDED_EQ_BOLZANO_WEIERSTRASS = prove (`!s:real^N->bool. bounded s <=> !t. t SUBSET s /\ INFINITE t ==> ?x. x limit_point_of t`, MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS; BOUNDED_SUBSET]);; (* ------------------------------------------------------------------------- *) (* In particular, some common special cases. *) (* ------------------------------------------------------------------------- *) let COMPACT_EMPTY = prove (`compact {}`, REWRITE_TAC[compact; NOT_IN_EMPTY]);; let COMPACT_UNION = prove (`!s t. compact s /\ compact t ==> compact (s UNION t)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_UNION; CLOSED_UNION]);; let COMPACT_INTER = prove (`!s t. compact s /\ compact t ==> compact (s INTER t)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; CLOSED_INTER]);; let COMPACT_INTER_CLOSED = prove (`!s t. compact s /\ closed t ==> compact (s INTER t)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER] THEN MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; let CLOSED_INTER_COMPACT = prove (`!s t. closed s /\ compact t ==> compact (s INTER t)`, MESON_TAC[COMPACT_INTER_CLOSED; INTER_COMM]);; let COMPACT_INTERS = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> compact s) /\ ~(f = {}) ==> compact(INTERS f)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTERS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_INTERS THEN ASM SET_TAC[]);; let FINITE_IMP_CLOSED = prove (`!s. FINITE s ==> closed s`, MESON_TAC[BOLZANO_WEIERSTRASS_IMP_CLOSED; INFINITE; FINITE_SUBSET]);; let FINITE_IMP_CLOSED_IN = prove (`!s t. FINITE s /\ s SUBSET t ==> closed_in (subtopology euclidean t) s`, SIMP_TAC[CLOSED_SUBSET_EQ; FINITE_IMP_CLOSED]);; let FINITE_IMP_COMPACT = prove (`!s. FINITE s ==> compact s`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; FINITE_IMP_CLOSED; FINITE_IMP_BOUNDED]);; let COMPACT_SING = prove (`!a. compact {a}`, SIMP_TAC[FINITE_IMP_COMPACT; FINITE_RULES]);; let COMPACT_INSERT = prove (`!a s. compact s ==> compact(a INSERT s)`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN SIMP_TAC[COMPACT_UNION; COMPACT_SING]);; let CLOSED_SING = prove (`!a. closed {a}`, MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_SING]);; let CLOSED_IN_SING = prove (`!u x:real^N. closed_in (subtopology euclidean u) {x} <=> x IN u`, SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_SING] THEN SET_TAC[]);; let CLOSURE_SING = prove (`!x:real^N. closure {x} = {x}`, SIMP_TAC[CLOSURE_CLOSED; CLOSED_SING]);; let CLOSED_INSERT = prove (`!a s. closed s ==> closed(a INSERT s)`, ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN SIMP_TAC[CLOSED_UNION; CLOSED_SING]);; let COMPACT_CBALL = prove (`!x e. compact(cball(x,e))`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_CBALL; CLOSED_CBALL]);; let COMPACT_FRONTIER_BOUNDED = prove (`!s. bounded s ==> compact(frontier s)`, SIMP_TAC[frontier; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_DIFF; OPEN_INTERIOR; CLOSED_CLOSURE] THEN MESON_TAC[SUBSET_DIFF; BOUNDED_SUBSET; BOUNDED_CLOSURE]);; let COMPACT_FRONTIER = prove (`!s. compact s ==> compact (frontier s)`, MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_FRONTIER_BOUNDED]);; let BOUNDED_FRONTIER = prove (`!s:real^N->bool. bounded s ==> bounded(frontier s)`, MESON_TAC[COMPACT_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);; let FRONTIER_SUBSET_COMPACT = prove (`!s. compact s ==> frontier s SUBSET s`, MESON_TAC[FRONTIER_SUBSET_CLOSED; COMPACT_EQ_BOUNDED_CLOSED]);; let OPEN_DELETE = prove (`!s x. open s ==> open(s DELETE x)`, let lemma = prove(`s DELETE x = s DIFF {x}`,SET_TAC[]) in SIMP_TAC[lemma; OPEN_DIFF; CLOSED_SING]);; let OPEN_IN_DELETE = prove (`!u s a:real^N. open_in (subtopology euclidean u) s ==> open_in (subtopology euclidean u) (s DELETE a)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL [ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`]]);; let CLOSED_INTERS_COMPACT = prove (`!s:real^N->bool. closed s <=> !e. compact(cball(vec 0,e) INTER s)`, GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; CLOSED_CBALL; BOUNDED_INTER; BOUNDED_CBALL]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `norm(x:real^N) + &1`) THEN DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &2)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `y:real^N` THEN SIMP_TAC[IN_INTER; IN_CBALL] THEN NORM_ARITH_TAC);; let COMPACT_UNIONS = prove (`!s. FINITE s /\ (!t. t IN s ==> compact t) ==> compact(UNIONS s)`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_UNIONS; BOUNDED_UNIONS]);; let COMPACT_DIFF = prove (`!s t. compact s /\ open t ==> compact(s DIFF t)`, ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN SIMP_TAC[COMPACT_INTER_CLOSED; GSYM OPEN_CLOSED]);; let COMPACT_SPHERE = prove (`!a:real^N r. compact(sphere(a,r))`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC COMPACT_FRONTIER THEN REWRITE_TAC[COMPACT_CBALL]);; let BOUNDED_SPHERE = prove (`!a:real^N r. bounded(sphere(a,r))`, SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_BOUNDED]);; let CLOSED_SPHERE = prove (`!a r. closed(sphere(a,r))`, SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED]);; let FRONTIER_SING = prove (`!a:real^N. frontier {a} = {a}`, REWRITE_TAC[frontier; CLOSURE_SING; INTERIOR_SING; DIFF_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Finite intersection property. I could make it an equivalence in fact. *) (* ------------------------------------------------------------------------- *) let COMPACT_IMP_FIP = prove (`!s:real^N->bool f. compact s /\ (!t. t IN f ==> closed t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) ==> ~(s INTER (INTERS f) = {})`, let lemma = prove(`(s = UNIV DIFF t) <=> (UNIV DIFF s = t)`,SET_TAC[]) in REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) f`) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[OPEN_DIFF; CLOSED_DIFF; OPEN_UNIV; CLOSED_UNIV; NOT_IMP] THEN CONJ_TAC THENL [UNDISCH_TAC `(s:real^N->bool) INTER INTERS f = {}` THEN ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) g`) THEN ASM_CASES_TAC `FINITE(g:(real^N->bool)->bool)` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTER; IN_INTERS; IN_IMAGE; IN_DIFF; IN_UNIV; NOT_IN_EMPTY; lemma; UNWIND_THM1; IN_UNIONS] THEN SET_TAC[]]);; let CLOSED_IMP_FIP = prove (`!s:real^N->bool f. closed s /\ (!t. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) ==> ~(s INTER (INTERS f) = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `~((s INTER t) INTER u = {}) ==> ~(s INTER u = {})`) THEN MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INTER_COMPACT; COMPACT_EQ_BOUNDED_CLOSED]; REWRITE_TAC[INTER_ASSOC] THEN ONCE_REWRITE_TAC[GSYM INTERS_INSERT]] THEN GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[FINITE_INSERT; INSERT_SUBSET]);; let CLOSED_IMP_FIP_COMPACT = prove (`!s:real^N->bool f. closed s /\ (!t. t IN f ==> compact t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) ==> ~(s INTER (INTERS f) = {})`, REPEAT GEN_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN ASM_SIMP_TAC[SUBSET_EMPTY; INTERS_0; INTER_UNIV] THENL [MESON_TAC[FINITE_EMPTY]; ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; MEMBER_NOT_EMPTY]);; let CLOSED_FIP = prove (`!f. (!t:real^N->bool. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; let COMPACT_FIP = prove (`!f. (!t:real^N->bool. t IN f ==> compact t) /\ (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) ==> ~(INTERS f = {})`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN MATCH_MP_TAC CLOSED_IMP_FIP_COMPACT THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; (* ------------------------------------------------------------------------- *) (* Bounded closed nest property (proof does not use Heine-Borel). *) (* ------------------------------------------------------------------------- *) let BOUNDED_CLOSED_NEST = prove (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ (!m n. m <= n ==> s(n) SUBSET s(m)) /\ bounded(s 0) ==> ?a:real^N. !n:num. a IN s(n)`, GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `compact(s 0:real^N->bool)` MP_TAC THENL [ASM_MESON_TAC[BOUNDED_CLOSED_IMP_COMPACT]; ALL_TAC] THEN REWRITE_TAC[compact] THEN DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_0]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC I [TAUT `p <=> ~(~p)`] THEN GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN MP_TAC(ISPECL [`l:real^N`; `(s:num->real^N->bool) N`] CLOSED_APPROACHABLE) THEN ASM_MESON_TAC[SUBSET; LE_REFL; LE_TRANS; LE_CASES; MONOTONE_BIGGER]);; (* ------------------------------------------------------------------------- *) (* Decreasing case does not even need compactness, just completeness. *) (* ------------------------------------------------------------------------- *) let DECREASING_CLOSED_NEST = prove (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ (!m n. m <= n ==> s(n) SUBSET s(m)) /\ (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) ==> ?a:real^N. !n:num. a IN s(n)`, GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?l:real^N. (a --> l) sequentially` MP_TAC THENL [ASM_MESON_TAC[cauchy; GE; SUBSET; LE_TRANS; LE_REFL; complete; COMPLETE_UNIV; IN_UNIV]; ASM_MESON_TAC[LIM_SEQUENTIALLY; CLOSED_APPROACHABLE; SUBSET; LE_REFL; LE_TRANS; LE_CASES]]);; (* ------------------------------------------------------------------------- *) (* Strengthen it to the intersection actually being a singleton. *) (* ------------------------------------------------------------------------- *) let DECREASING_CLOSED_NEST_SING = prove (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ (!m n. m <= n ==> s(n) SUBSET s(m)) /\ (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) ==> ?a:real^N. INTERS {t | ?n:num. t = s n} = {a}`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DECREASING_CLOSED_NEST) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERS; IN_SING; IN_ELIM_THM] THEN ASM_MESON_TAC[DIST_POS_LT; REAL_LT_REFL; SUBSET; LE_CASES]);; (* ------------------------------------------------------------------------- *) (* A version for a more general chain, not indexed by N. *) (* ------------------------------------------------------------------------- *) let BOUNDED_CLOSED_CHAIN = prove (`!f b:real^N->bool. (!s. s IN f ==> closed s /\ ~(s = {})) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) /\ b IN f /\ bounded b ==> ~(INTERS f = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(b INTER (INTERS f):real^N->bool = {})` MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?s:real^N->bool. s IN f /\ !t. t IN u ==> s SUBSET t` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN UNDISCH_TAC `(u:(real^N->bool)->bool) SUBSET f` THEN UNDISCH_TAC `FINITE(u:(real^N->bool)->bool)` THEN SPEC_TAC(`u:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:(real^N->bool)->bool`] THEN REWRITE_TAC[INSERT_SUBSET] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Analogous things directly for compactness. *) (* ------------------------------------------------------------------------- *) let COMPACT_CHAIN = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> compact s /\ ~(s = {})) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> ~(INTERS f = {})`, GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL [ASM_REWRITE_TAC[INTERS_0] THEN SET_TAC[]; MATCH_MP_TAC BOUNDED_CLOSED_CHAIN THEN ASM SET_TAC[]]);; let COMPACT_NEST = prove (`!s. (!n. compact(s n) /\ ~(s n = {})) /\ (!m n. m <= n ==> s n SUBSET s m) ==> ~(INTERS {s n | n IN (:num)} = {})`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPACT_CHAIN THEN ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cauchy-type criteria for *uniform* convergence. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONVERGENT_EQ_CAUCHY = prove (`!P s:num->A->real^N. (?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=> (!e. &0 < e ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_TAC `l:A->real^N`) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]; ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `!x:A. P x ==> cauchy (\n. s n x :real^N)` MP_TAC THENL [REWRITE_TAC[cauchy; GE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:A->real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `N + M:num`; `x:A`]) THEN ASM_REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; let UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT = prove (`!P (s:num->A->real^N) l. (!e. &0 < e ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e) /\ (!x. P x ==> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s n x,l x) < e) ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `l':A->real^N`) ASSUME_TAC) THEN SUBGOAL_THEN `!x. P x ==> (l:A->real^N) x = l' x` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n. (s:num->A->real^N) n x` THEN REWRITE_TAC[LIM_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Define continuity over a net to take in restrictions of the set. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("continuous",(12,"right"));; let continuous = new_definition `f continuous net <=> (f --> f(netlimit net)) net`;; let CONTINUOUS_TRIVIAL_LIMIT = prove (`!f net. trivial_limit net ==> f continuous net`, SIMP_TAC[continuous; LIM]);; let CONTINUOUS_WITHIN = prove (`!f x:real^M. f continuous (at x within s) <=> (f --> f(x)) (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; let CONTINUOUS_AT = prove (`!f (x:real^N). f continuous (at x) <=> (f --> f(x)) (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHIN; IN_UNIV]);; let CONTINUOUS_AT_WITHIN = prove (`!f:real^M->real^N x s. f continuous (at x) ==> f continuous (at x within s)`, SIMP_TAC[LIM_AT_WITHIN; CONTINUOUS_AT; CONTINUOUS_WITHIN]);; let CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL = prove (`!a s. closed s /\ ~(a IN s) ==> f continuous (at a within s)`, ASM_SIMP_TAC[continuous; LIM; LIM_WITHIN_CLOSED_TRIVIAL]);; let CONTINUOUS_TRANSFORM_WITHIN = prove (`!f g:real^M->real^N s x d. &0 < d /\ x IN s /\ (!x'. x' IN s /\ dist(x',x) < d ==> f(x') = g(x')) /\ f continuous (at x within s) ==> g continuous (at x within s)`, REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_TRANSFORM_WITHIN; DIST_REFL]);; let CONTINUOUS_TRANSFORM_AT = prove (`!f g:real^M->real^N x d. &0 < d /\ (!x'. dist(x',x) < d ==> f(x') = g(x')) /\ f continuous (at x) ==> g continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT] THEN MESON_TAC[LIM_TRANSFORM_AT; DIST_REFL]);; let CONTINUOUS_TRANSFORM_WITHIN_OPEN = prove (`!f g:real^M->real^N s a. open s /\ a IN s /\ (!x. x IN s ==> f x = g x) /\ f continuous at a ==> g continuous at a`, MESON_TAC[CONTINUOUS_AT; LIM_TRANSFORM_WITHIN_OPEN]);; let CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN = prove (`!f g:real^M->real^N s t a. open_in (subtopology euclidean t) s /\ a IN s /\ (!x. x IN s ==> f x = g x) /\ f continuous (at a within t) ==> g continuous (at a within t)`, MESON_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_OPEN_IN]);; (* ------------------------------------------------------------------------- *) (* Derive the epsilon-delta forms, which we often use as "definitions" *) (* ------------------------------------------------------------------------- *) let continuous_within = prove (`f continuous (at x within s) <=> !e. &0 < e ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`, REWRITE_TAC[CONTINUOUS_WITHIN; LIM_WITHIN] THEN REWRITE_TAC[GSYM DIST_NZ] THEN MESON_TAC[DIST_REFL]);; let continuous_at = prove (`f continuous (at x) <=> !e. &0 < e ==> ?d. &0 < d /\ !x'. dist(x',x) < d ==> dist(f(x'),f(x)) < e`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[continuous_within; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Versions in terms of open balls. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_BALL = prove (`!f s x. f continuous (at x within s) <=> !e. &0 < e ==> ?d. &0 < d /\ IMAGE f (ball(x,d) INTER s) SUBSET ball(f x,e)`, SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_within; IN_INTER] THEN MESON_TAC[DIST_SYM]);; let CONTINUOUS_AT_BALL = prove (`!f x. f continuous (at x) <=> !e. &0 < e ==> ?d. &0 < d /\ IMAGE f (ball(x,d)) SUBSET ball(f x,e)`, SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_at] THEN MESON_TAC[DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* For setwise continuity, just start from the epsilon-delta definitions. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("continuous_on",(12,"right"));; parse_as_infix ("uniformly_continuous_on",(12,"right"));; let continuous_on = new_definition `f continuous_on s <=> !x. x IN s ==> !e. &0 < e ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`;; let uniformly_continuous_on = new_definition `f uniformly_continuous_on s <=> !e. &0 < e ==> ?d. &0 < d /\ !x x'. x IN s /\ x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`;; (* ------------------------------------------------------------------------- *) (* Some simple consequential lemmas. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS = prove (`!f s. f uniformly_continuous_on s ==> f continuous_on s`, REWRITE_TAC[uniformly_continuous_on; continuous_on] THEN MESON_TAC[]);; let CONTINUOUS_AT_IMP_CONTINUOUS_ON = prove (`!f s. (!x. x IN s ==> f continuous (at x)) ==> f continuous_on s`, REWRITE_TAC[continuous_at; continuous_on] THEN MESON_TAC[]);; let CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove (`!f s. f continuous_on s <=> !x. x IN s ==> f continuous (at x within s)`, REWRITE_TAC[continuous_on; continuous_within]);; let CONTINUOUS_ON = prove (`!f (s:real^N->bool). f continuous_on s <=> !x. x IN s ==> (f --> f(x)) (at x within s)`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN]);; let CONTINUOUS_ON_EQ_CONTINUOUS_AT = prove (`!f:real^M->real^N s. open s ==> (f continuous_on s <=> (!x. x IN s ==> f continuous (at x)))`, SIMP_TAC[CONTINUOUS_ON; CONTINUOUS_AT; LIM_WITHIN_OPEN]);; let CONTINUOUS_WITHIN_SUBSET = prove (`!f s t x. f continuous (at x within s) /\ t SUBSET s ==> f continuous (at x within t)`, REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_SUBSET]);; let CONTINUOUS_ON_SUBSET = prove (`!f s t. f continuous_on s /\ t SUBSET s ==> f continuous_on t`, REWRITE_TAC[CONTINUOUS_ON] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; let UNIFORMLY_CONTINUOUS_ON_SUBSET = prove (`!f s t. f uniformly_continuous_on s /\ t SUBSET s ==> f uniformly_continuous_on t`, REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; let CONTINUOUS_ON_INTERIOR = prove (`!f:real^M->real^N s x. f continuous_on s /\ x IN interior(s) ==> f continuous at x`, REWRITE_TAC[interior; IN_ELIM_THM] THEN MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; CONTINUOUS_ON_SUBSET]);; let CONTINUOUS_ON_EQ = prove (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f continuous_on s ==> g continuous_on s`, SIMP_TAC[continuous_on; IMP_CONJ]);; let UNIFORMLY_CONTINUOUS_ON_EQ = prove (`!f g s. (!x. x IN s ==> f x = g x) /\ f uniformly_continuous_on s ==> g uniformly_continuous_on s`, SIMP_TAC[uniformly_continuous_on; IMP_CONJ]);; let CONTINUOUS_ON_SING = prove (`!f:real^M->real^N a. f continuous_on {a}`, SIMP_TAC[continuous_on; IN_SING; FORALL_UNWIND_THM2; DIST_REFL] THEN MESON_TAC[]);; let CONTINUOUS_ON_EMPTY = prove (`!f:real^M->real^N. f continuous_on {}`, MESON_TAC[CONTINUOUS_ON_SING; EMPTY_SUBSET; CONTINUOUS_ON_SUBSET]);; let CONTINUOUS_ON_NO_LIMPT = prove (`!f:real^M->real^N s. ~(?x. x limit_point_of s) ==> f continuous_on s`, REWRITE_TAC[continuous_on; LIMPT_APPROACHABLE] THEN MESON_TAC[DIST_REFL]);; let CONTINUOUS_ON_FINITE = prove (`!f:real^M->real^N s. FINITE s ==> f continuous_on s`, MESON_TAC[CONTINUOUS_ON_NO_LIMPT; LIMIT_POINT_FINITE]);; let CONTRACTION_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N. (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(x,y)) ==> f continuous_on s`, SIMP_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);; let ISOMETRY_ON_IMP_CONTINUOUS_ON = prove (`!f:real^M->real^N. (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) ==> f continuous_on s`, SIMP_TAC[CONTRACTION_IMP_CONTINUOUS_ON; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Characterization of various kinds of continuity in terms of sequences. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_SEQUENTIALLY = prove (`!f a:real^N. f continuous (at a within s) <=> !x. (!n. x(n) IN s) /\ (x --> a) sequentially ==> ((f o x) --> f(a)) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH; REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`; REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]);; let CONTINUOUS_AT_SEQUENTIALLY = prove (`!f a:real^N. f continuous (at a) <=> !x. (x --> a) sequentially ==> ((f o x) --> f(a)) sequentially`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_UNIV]);; let CONTINUOUS_ON_SEQUENTIALLY = prove (`!f s:real^N->bool. f continuous_on s <=> !x a. a IN s /\ (!n. x(n) IN s) /\ (x --> a) sequentially ==> ((f o x) --> f(a)) sequentially`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; let UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY = prove (`!f s:real^N->bool. f uniformly_continuous_on s <=> !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\ ((\n. x(n) - y(n)) --> vec 0) sequentially ==> ((\n. f(x(n)) - f(y(n))) --> vec 0) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN REWRITE_TAC[LIM_SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH; REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN CONJ_TAC THENL [MATCH_MP_TAC FORALL_POS_MONO_1 THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`; REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]; EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `\x:num. x` THEN ASM_REWRITE_TAC[LE_REFL]]);; let LIM_CONTINUOUS_FUNCTION = prove (`!f net g l. f continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) --> f l) net`, REWRITE_TAC[tendsto; continuous_at; eventually] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Combination results for pointwise continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_CONST = prove (`!net c. (\x. c) continuous net`, REWRITE_TAC[continuous; LIM_CONST]);; let CONTINUOUS_CMUL = prove (`!f c net. f continuous net ==> (\x. c % f(x)) continuous net`, REWRITE_TAC[continuous; LIM_CMUL]);; let CONTINUOUS_NEG = prove (`!f net. f continuous net ==> (\x. --(f x)) continuous net`, REWRITE_TAC[continuous; LIM_NEG]);; let CONTINUOUS_ADD = prove (`!f g net. f continuous net /\ g continuous net ==> (\x. f(x) + g(x)) continuous net`, REWRITE_TAC[continuous; LIM_ADD]);; let CONTINUOUS_SUB = prove (`!f g net. f continuous net /\ g continuous net ==> (\x. f(x) - g(x)) continuous net`, REWRITE_TAC[continuous; LIM_SUB]);; let CONTINUOUS_ABS = prove (`!(f:A->real^N) net. f continuous net ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous net`, REWRITE_TAC[continuous; LIM_ABS]);; let CONTINUOUS_MAX = prove (`!(f:A->real^N) (g:A->real^N) net. f continuous net /\ g continuous net ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous net`, REWRITE_TAC[continuous; LIM_MAX]);; let CONTINUOUS_MIN = prove (`!(f:A->real^N) (g:A->real^N) net. f continuous net /\ g continuous net ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous net`, REWRITE_TAC[continuous; LIM_MIN]);; let CONTINUOUS_VSUM = prove (`!net f s. FINITE s /\ (!a. a IN s ==> (f a) continuous net) ==> (\x. vsum s (\a. f a x)) continuous net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; CONTINUOUS_CONST; CONTINUOUS_ADD; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Same thing for setwise continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_CONST = prove (`!s c. (\x. c) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CONST]);; let CONTINUOUS_ON_CMUL = prove (`!f c s. f continuous_on s ==> (\x. c % f(x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CMUL]);; let CONTINUOUS_ON_NEG = prove (`!f s. f continuous_on s ==> (\x. --(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_NEG]);; let CONTINUOUS_ON_ADD = prove (`!f g s. f continuous_on s /\ g continuous_on s ==> (\x. f(x) + g(x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ADD]);; let CONTINUOUS_ON_SUB = prove (`!f g s. f continuous_on s /\ g continuous_on s ==> (\x. f(x) - g(x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SUB]);; let CONTINUOUS_ON_ABS = prove (`!f:real^M->real^N s. f continuous_on s ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ABS]);; let CONTINUOUS_ON_MAX = prove (`!f:real^M->real^N g:real^M->real^N s. f continuous_on s /\ g continuous_on s ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MAX]);; let CONTINUOUS_ON_MIN = prove (`!f:real^M->real^N g:real^M->real^N s. f continuous_on s /\ g continuous_on s ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MIN]);; let CONTINUOUS_ON_VSUM = prove (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) continuous_on t) ==> (\x. vsum s (\a. f a x)) continuous_on t`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_VSUM]);; (* ------------------------------------------------------------------------- *) (* Same thing for uniform continuity, using sequential formulations. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_ON_CONST = prove (`!s c. (\x. c) uniformly_continuous_on s`, REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF; VECTOR_SUB_REFL; LIM_CONST]);; let LINEAR_UNIFORMLY_CONTINUOUS_ON = prove (`!f:real^M->real^N s. linear f ==> f uniformly_continuous_on s`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[uniformly_continuous_on; dist; GSYM LINEAR_SUB] THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(y - x:real^M)` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_RDIV_EQ; REAL_MUL_SYM]);; let UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on (IMAGE f s) ==> (g o f) uniformly_continuous_on s`, let lemma = prove (`(!y. ((?x. (y = f x) /\ P x) /\ Q y ==> R y)) <=> (!x. P x /\ Q (f x) ==> R (f x))`, MESON_TAC[]) in REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; o_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove (`!f:real^M->real^N g (h:real^N->real^P->real^Q) s. f uniformly_continuous_on s /\ g uniformly_continuous_on s /\ bilinear h /\ bounded(IMAGE f s) /\ bounded(IMAGE g s) ==> (\x. h (f x) (g x)) uniformly_continuous_on s`, REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; dist] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN `!a b c d. (h:real^N->real^P->real^Q) a b - h c d = h (a - c) b + h c (b - d)` (fun th -> ONCE_REWRITE_TAC[th]) THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_LSUB th]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_RSUB th]) THEN VECTOR_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN UNDISCH_TAC `bounded(IMAGE (g:real^M->real^P) s)` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `(g:real^M->real^P) uniformly_continuous_on s` THEN UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on s` THEN REWRITE_TAC[uniformly_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B2`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B1`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`])) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * e / &2 / &2 / B / B2 * B2 + B * B1 * e / &2 / &2 / B / B1` THEN CONJ_TAC THENL [MATCH_MP_TAC(NORM_ARITH `norm(x) <= a /\ norm(y) <= b ==> norm(x + y:real^N) <= a + b`) THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN ASM_REAL_ARITH_TAC]);; let UNIFORMLY_CONTINUOUS_ON_MUL = prove (`!f g:real^M->real^N s. (lift o f) uniformly_continuous_on s /\ g uniformly_continuous_on s /\ bounded(IMAGE (lift o f) s) /\ bounded(IMAGE g s) ==> (\x. f x % g x) uniformly_continuous_on s`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`lift o (f:real^M->real)`; `g:real^M->real^N`; `\c (v:real^N). drop c % v`; `s:real^M->bool`] BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; let UNIFORMLY_CONTINUOUS_ON_CMUL = prove (`!f c s. f uniformly_continuous_on s ==> (\x. c % f(x)) uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL) THEN ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_RZERO]);; let UNIFORMLY_CONTINUOUS_ON_VMUL = prove (`!s:real^M->bool c v:real^N. (lift o c) uniformly_continuous_on s ==> (\x. c x % v) uniformly_continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o ISPEC `\x. (drop x % v:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LINEAR_UNIFORMLY_CONTINUOUS_ON THEN MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]);; let UNIFORMLY_CONTINUOUS_ON_NEG = prove (`!f s. f uniformly_continuous_on s ==> (\x. --(f x)) uniformly_continuous_on s`, ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_CMUL]);; let UNIFORMLY_CONTINUOUS_ON_ADD = prove (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s ==> (\x. f(x) + g(x)) uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN REWRITE_TAC[AND_FORALL_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[VECTOR_ADD_LID] THEN AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; let UNIFORMLY_CONTINUOUS_ON_SUB = prove (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s ==> (\x. f(x) - g(x)) uniformly_continuous_on s`, REWRITE_TAC[VECTOR_SUB] THEN SIMP_TAC[UNIFORMLY_CONTINUOUS_ON_NEG; UNIFORMLY_CONTINUOUS_ON_ADD]);; let UNIFORMLY_CONTINUOUS_ON_VSUM = prove (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) uniformly_continuous_on t) ==> (\x. vsum s (\a. f a x)) uniformly_continuous_on t`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; UNIFORMLY_CONTINUOUS_ON_CONST; UNIFORMLY_CONTINUOUS_ON_ADD; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Identity function is continuous in every sense. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_ID = prove (`!a s. (\x. x) continuous (at a within s)`, REWRITE_TAC[continuous_within] THEN MESON_TAC[]);; let CONTINUOUS_AT_ID = prove (`!a. (\x. x) continuous (at a)`, REWRITE_TAC[continuous_at] THEN MESON_TAC[]);; let CONTINUOUS_ON_ID = prove (`!s. (\x. x) continuous_on s`, REWRITE_TAC[continuous_on] THEN MESON_TAC[]);; let UNIFORMLY_CONTINUOUS_ON_ID = prove (`!s. (\x. x) uniformly_continuous_on s`, REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Continuity of all kinds is preserved under composition. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_COMPOSE = prove (`!f g x s. f continuous (at x within s) /\ g continuous (at (f x) within IMAGE f s) ==> (g o f) continuous (at x within s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; o_THM; IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_MESON_TAC[]);; let CONTINUOUS_AT_COMPOSE = prove (`!f g x. f continuous (at x) /\ g continuous (at (f x)) ==> (g o f) continuous (at x)`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[CONTINUOUS_WITHIN_COMPOSE; IN_IMAGE; CONTINUOUS_WITHIN_SUBSET; SUBSET_UNIV; IN_UNIV]);; let CONTINUOUS_ON_COMPOSE = prove (`!f g s. f continuous_on s /\ g continuous_on (IMAGE f s) ==> (g o f) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN MESON_TAC[IN_IMAGE; CONTINUOUS_WITHIN_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Continuity in terms of open preimages. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_OPEN = prove (`!f:real^M->real^N x u. f continuous (at x within u) <=> !t. open t /\ f(x) IN t ==> ?s. open s /\ x IN s /\ !x'. x' IN s /\ x' IN u ==> f(x') IN t`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [open_def] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; DIST_SYM]; DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; let CONTINUOUS_AT_OPEN = prove (`!f:real^M->real^N x. f continuous (at x) <=> !t. open t /\ f(x) IN t ==> ?s. open s /\ x IN s /\ !x'. x' IN s ==> f(x') IN t`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_at] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC LAND_CONV [open_def] THEN DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL]; DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; let CONTINUOUS_ON_OPEN_GEN = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> (f continuous_on s <=> !u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL [REWRITE_TAC[open_in; SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM SET_TAC[]; DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e) INTER t`) THEN ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_OPEN; INTER_COMM; OPEN_BALL]; ALL_TAC] THEN REWRITE_TAC[open_in; SUBSET; IN_INTER; IN_ELIM_THM; IN_BALL; IN_IMAGE] THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_MESON_TAC[DIST_REFL; DIST_SYM]]);; let CONTINUOUS_ON_OPEN = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. open_in (subtopology euclidean (IMAGE f s)) t ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_OPEN_GEN THEN REWRITE_TAC[SUBSET_REFL]);; let CONTINUOUS_OPEN_IN_PREIMAGE_GEN = prove (`!f:real^M->real^N s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, MESON_TAC[CONTINUOUS_ON_OPEN_GEN]);; let CONTINUOUS_ON_IMP_OPEN_IN = prove (`!f:real^M->real^N s t. f continuous_on s /\ open_in (subtopology euclidean (IMAGE f s)) t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, MESON_TAC[CONTINUOUS_ON_OPEN]);; (* ------------------------------------------------------------------------- *) (* Similarly in terms of closed sets. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_CLOSED_GEN = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> (f continuous_on s <=> !u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THENL [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let CONTINUOUS_ON_CLOSED = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. closed_in (subtopology euclidean (IMAGE f s)) t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSED_GEN THEN REWRITE_TAC[SUBSET_REFL]);; let CONTINUOUS_CLOSED_IN_PREIMAGE_GEN = prove (`!f:real^M->real^N s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, MESON_TAC[CONTINUOUS_ON_CLOSED_GEN]);; let CONTINUOUS_ON_IMP_CLOSED_IN = prove (`!f:real^M->real^N s t. f continuous_on s /\ closed_in (subtopology euclidean (IMAGE f s)) t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, MESON_TAC[CONTINUOUS_ON_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Half-global and completely global cases. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_OPEN_IN_PREIMAGE = prove (`!f s t. f continuous_on s /\ open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_OPEN]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_CLOSED_IN_PREIMAGE = prove (`!f s t. f continuous_on s /\ closed t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_CLOSED]) THEN ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_OPEN_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ open s /\ open t ==> open {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN REWRITE_TAC [OPEN_IN_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN ANTS_TAC THENL [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = s INTER t'` SUBST1_TAC THENL [ASM SET_TAC []; ASM_MESON_TAC [OPEN_INTER]]]);; let CONTINUOUS_CLOSED_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ closed s /\ closed t ==> closed {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_CLOSED]) THEN REWRITE_TAC [CLOSED_IN_CLOSED] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN ANTS_TAC THENL [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = s INTER t'` SUBST1_TAC THENL [ASM SET_TAC []; ASM_MESON_TAC [CLOSED_INTER]]]);; let CONTINUOUS_OPEN_PREIMAGE_UNIV = prove (`!f:real^M->real^N s. (!x. f continuous (at x)) /\ open s ==> open {x | f(x) IN s}`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] CONTINUOUS_OPEN_PREIMAGE) THEN ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; let CONTINUOUS_CLOSED_PREIMAGE_UNIV = prove (`!f:real^M->real^N s. (!x. f continuous (at x)) /\ closed s ==> closed {x | f(x) IN s}`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] CONTINUOUS_CLOSED_PREIMAGE) THEN ASM_SIMP_TAC[CLOSED_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; let CONTINUOUS_OPEN_IN_PREIMAGE_EQ = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_OPEN_IN_PREIMAGE] THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; let CONTINUOUS_CLOSED_IN_PREIMAGE_EQ = prove (`!f:real^M->real^N s. f continuous_on s <=> !t. closed t ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE] THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [CLOSED_IN_CLOSED] THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Linear functions are (uniformly) continuous on any set. *) (* ------------------------------------------------------------------------- *) let LINEAR_LIM_0 = prove (`!f. linear f ==> (f --> vec 0) (at (vec 0))`, REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN ASM_MESON_TAC[REAL_MUL_SYM; REAL_LET_TRANS; REAL_LT_RDIV_EQ]);; let LINEAR_CONTINUOUS_AT = prove (`!f:real^M->real^N a. linear f ==> f continuous (at a)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `\x. (f:real^M->real^N) (a + x) - f(a)` LINEAR_LIM_0) THEN ANTS_TAC THENL [POP_ASSUM MP_TAC THEN SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[GSYM LIM_NULL; CONTINUOUS_AT] THEN GEN_REWRITE_TAC RAND_CONV [LIM_AT_ZERO] THEN SIMP_TAC[]);; let LINEAR_CONTINUOUS_WITHIN = prove (`!f:real^M->real^N s x. linear f ==> f continuous (at x within s)`, SIMP_TAC[CONTINUOUS_AT_WITHIN; LINEAR_CONTINUOUS_AT]);; let LINEAR_CONTINUOUS_ON = prove (`!f:real^M->real^N s. linear f ==> f continuous_on s`, MESON_TAC[LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; let LINEAR_CONTINUOUS_COMPOSE = prove (`!net f:A->real^N g:real^N->real^P. f continuous net /\ linear g ==> (\x. g(f x)) continuous net`, REWRITE_TAC[continuous; LIM_LINEAR]);; let LINEAR_CONTINUOUS_ON_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s. f continuous_on s /\ linear g ==> (\x. g(f x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; LINEAR_CONTINUOUS_COMPOSE]);; let CONTINUOUS_LIFT_COMPONENT_COMPOSE = prove (`!net f:A->real^N i. f continuous net ==> (\x. lift(f x$i)) continuous net`, REPEAT GEN_TAC THEN SUBGOAL_THEN `linear(\x:real^N. lift (x$i))` MP_TAC THENL [REWRITE_TAC[LINEAR_LIFT_COMPONENT]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN REWRITE_TAC[LINEAR_CONTINUOUS_COMPOSE]);; let CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE = prove (`!f:real^M->real^N s. f continuous_on s ==> (\x. lift (f x$i)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_COMPONENT_COMPOSE]);; (* ------------------------------------------------------------------------- *) (* Also bilinear functions, in composition form. *) (* ------------------------------------------------------------------------- *) let BILINEAR_CONTINUOUS_COMPOSE = prove (`!net f:A->real^M g:A->real^N h:real^M->real^N->real^P. f continuous net /\ g continuous net /\ bilinear h ==> (\x. h (f x) (g x)) continuous net`, REWRITE_TAC[continuous; LIM_BILINEAR]);; let BILINEAR_CONTINUOUS_ON_COMPOSE = prove (`!f g h s. f continuous_on s /\ g continuous_on s /\ bilinear h ==> (\x. h (f x) (g x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; BILINEAR_CONTINUOUS_COMPOSE]);; let BILINEAR_DOT = prove (`bilinear (\x y:real^N. lift(x dot y))`, REWRITE_TAC[bilinear; linear; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);; let CONTINUOUS_LIFT_DOT2 = prove (`!net f g:A->real^N. f continuous net /\ g continuous net ==> (\x. lift(f x dot g x)) continuous net`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; let CONTINUOUS_ON_LIFT_DOT2 = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on s ==> (\x. lift(f x dot g x)) continuous_on s`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Preservation of compactness and connectedness under continuous function. *) (* ------------------------------------------------------------------------- *) let COMPACT_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ compact s ==> compact(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; compact] THEN STRIP_TAC THEN X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN DISCH_THEN(X_CHOOSE_THEN `l:real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) l` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o SPEC `l:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; let COMPACT_TRANSLATION = prove (`!s a:real^N. compact s ==> compact (IMAGE (\x. a + x) s)`, SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; let COMPACT_TRANSLATION_EQ = prove (`!a s. compact (IMAGE (\x:real^N. a + x) s) <=> compact s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COMPACT_TRANSLATION] THEN DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP COMPACT_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; add_translation_invariants [COMPACT_TRANSLATION_EQ];; let COMPACT_LINEAR_IMAGE = prove (`!f:real^M->real^N s. compact s /\ linear f ==> compact(IMAGE f s)`, SIMP_TAC[LINEAR_CONTINUOUS_ON; COMPACT_CONTINUOUS_IMAGE]);; let COMPACT_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (compact (IMAGE f s) <=> compact s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COMPACT_LINEAR_IMAGE));; add_linear_invariants [COMPACT_LINEAR_IMAGE_EQ];; let CONNECTED_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f continuous_on s /\ connected s ==> connected(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[CONNECTED_CLOPEN; NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `t:real^N->bool` th) THEN MP_TAC(SPEC `IMAGE (f:real^M->real^N) s DIFF t` th)) THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN IMAGE f s DIFF t} = s DIFF {x | x IN s /\ f x IN t}` SUBST1_TAC THENL [UNDISCH_TAC `t SUBSET IMAGE (f:real^M->real^N) s` THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_ELIM_THM; SUBSET] THEN MESON_TAC[]; REPEAT STRIP_TAC THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN t}` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REWRITE_TAC[IN_IMAGE; SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; EXTENSION] THEN MESON_TAC[]]);; let CONNECTED_TRANSLATION = prove (`!a s. connected s ==> connected (IMAGE (\x:real^N. a + x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; let CONNECTED_TRANSLATION_EQ = prove (`!a s. connected (IMAGE (\x:real^N. a + x) s) <=> connected s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_TRANSLATION] THEN DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP CONNECTED_TRANSLATION) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`]);; add_translation_invariants [CONNECTED_TRANSLATION_EQ];; let CONNECTED_LINEAR_IMAGE = prove (`!f:real^M->real^N s. connected s /\ linear f ==> connected(IMAGE f s)`, SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CONTINUOUS_IMAGE]);; let CONNECTED_LINEAR_IMAGE_EQ = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) ==> (connected (IMAGE f s) <=> connected s)`, MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONNECTED_LINEAR_IMAGE));; add_linear_invariants [CONNECTED_LINEAR_IMAGE_EQ];; (* ------------------------------------------------------------------------- *) (* Preservation properties for pasted sets (Cartesian products). *) (* ------------------------------------------------------------------------- *) let BOUNDED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. bounded (s PCROSS t) <=> s = {} \/ t = {} \/ bounded s /\ bounded t`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; BOUNDED_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[bounded; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS; NORM_PASTECART_LE; REAL_LE_ADD2]);; let BOUNDED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. bounded s /\ bounded t ==> bounded (s PCROSS t)`, SIMP_TAC[BOUNDED_PCROSS_EQ]);; let CLOSED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. closed (s PCROSS t) <=> s = {} \/ t = {} \/ closed s /\ closed t`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN MAP_EVERY ASM_CASES_TAC [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; CLOSED_EMPTY; SET_RULE `{f x y |x,y| F} = {}`] THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; LIM_SEQUENTIALLY] THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN REWRITE_TAC[IN_ELIM_THM; SKOLEM_THM; FORALL_AND_THM] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN SIMP_TAC[TAUT `((p /\ q) /\ r) /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN ONCE_REWRITE_TAC[MESON[] `(!a b c d e. P a b c d e) <=> (!d e b c a. P a b c d e)`] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL [GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; FORALL_AND_THM] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM]] THEN MATCH_MP_TAC MONO_FORALL THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(MESON[] `(?x. P x (\n. x)) ==> (?s x. P x s)`) THEN ASM_MESON_TAC[DIST_PASTECART_CANCEL]; ONCE_REWRITE_TAC[MESON[] `(!x l. P x l) /\ (!y m. Q y m) <=> (!x y l m. P x l /\ Q y m)`] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[dist; PASTECART_SUB] THEN ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]]);; let CLOSED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. closed s /\ closed t ==> closed (s PCROSS t)`, SIMP_TAC[CLOSED_PCROSS_EQ]);; let COMPACT_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. compact (s PCROSS t) <=> s = {} \/ t = {} \/ compact s /\ compact t`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_PCROSS_EQ; BOUNDED_PCROSS_EQ] THEN MESON_TAC[]);; let COMPACT_PCROSS = prove (`!s:real^M->bool t:real^N->bool. compact s /\ compact t ==> compact (s PCROSS t)`, SIMP_TAC[COMPACT_PCROSS_EQ]);; let OPEN_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. open (s PCROSS t) <=> s = {} \/ t = {} \/ open s /\ open t`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; OPEN_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL [REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[DIST_PASTECART_CANCEL]; REWRITE_TAC[OPEN_CLOSED] THEN STRIP_TAC THEN SUBGOAL_THEN `UNIV DIFF {pastecart x y | x IN s /\ y IN t} = {pastecart x y | x IN ((:real^M) DIFF s) /\ y IN (:real^N)} UNION {pastecart x y | x IN (:real^M) /\ y IN ((:real^N) DIFF t)}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; FORALL_PASTECART; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]; SIMP_TAC[GSYM PCROSS] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN MATCH_MP_TAC CLOSED_PCROSS THEN ASM_REWRITE_TAC[CLOSED_UNIV]]]);; let OPEN_PCROSS = prove (`!s:real^M->bool t:real^N->bool. open s /\ open t ==> open (s PCROSS t)`, SIMP_TAC[OPEN_PCROSS_EQ]);; let OPEN_IN_PCROSS = prove (`!s s':real^M->bool t t':real^N->bool. open_in (subtopology euclidean s) s' /\ open_in (subtopology euclidean t) t' ==> open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN ASM_SIMP_TAC[OPEN_PCROSS; EXTENSION; FORALL_PASTECART] THEN REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; let PASTECART_IN_INTERIOR_SUBTOPOLOGY = prove (`!s t u x:real^M y:real^N. pastecart x y IN u /\ open_in (subtopology euclidean (s PCROSS t)) u ==> ?v w. open_in (subtopology euclidean s) v /\ x IN v /\ open_in (subtopology euclidean t) w /\ y IN w /\ (v PCROSS w) SUBSET u`, REWRITE_TAC[open_in; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^N`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^M,e / &2) INTER s` THEN EXISTS_TAC `ball(y:real^N,e / &2) INTER t` THEN SUBGOAL_THEN `(x:real^M) IN s /\ (y:real^N) IN t` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET; PASTECART_IN_PCROSS]; ALL_TAC] THEN ASM_SIMP_TAC[INTER_SUBSET; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN REWRITE_TAC[IN_BALL] THEN REPEAT(CONJ_TAC THENL [MESON_TAC[REAL_SUB_LT; NORM_ARITH `dist(x,y) < e /\ dist(z,y) < e - dist(x,y) ==> dist(x:real^N,z) < e`]; ALL_TAC]) THEN REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_BALL; IN_INTER] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist)] THEN ASM_REAL_ARITH_TAC);; let OPEN_IN_PCROSS_EQ = prove (`!s s':real^M->bool t t':real^N->bool. open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> s' = {} \/ t' = {} \/ open_in (subtopology euclidean s) s' /\ open_in (subtopology euclidean t) t'`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s':real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN ASM_CASES_TAC `t':real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[OPEN_IN_PCROSS] THEN REPEAT STRIP_TAC THENL [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN UNDISCH_TAC `~(t':real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`); ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN UNDISCH_TAC `~(s':real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `x:real^M`)] THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`; `(s':real^M->bool) PCROSS (t':real^N->bool)`; `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN ASM_REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MESON_TAC[]);; let INTERIOR_PCROSS = prove (`!s:real^M->bool t:real^N->bool. interior (s PCROSS t) = (interior s) PCROSS (interior t)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`; `interior((s:real^M->bool) PCROSS (t:real^N->bool))`; `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN REWRITE_TAC[UNIV_PCROSS_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN ASM_REWRITE_TAC[OPEN_INTERIOR] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[INTERIOR_SUBSET; SUBSET_TRANS] `s SUBSET interior t ==> s SUBSET t`)) THEN REWRITE_TAC[SUBSET_PCROSS] THEN ASM_MESON_TAC[NOT_IN_EMPTY; INTERIOR_MAXIMAL; SUBSET]; MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[OPEN_PCROSS; OPEN_INTERIOR; PCROSS_MONO; INTERIOR_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Quotient maps are occasionally useful. *) (* ------------------------------------------------------------------------- *) let QUASICOMPACT_OPEN_CLOSED = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} ==> open_in (subtopology euclidean t) u)) <=> (!u. u SUBSET t ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} ==> closed_in (subtopology euclidean t) u)))`, SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN (ANTS_TAC THENL [SET_TAC[]; REPEAT STRIP_TAC]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_RESTRICT] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `open_in top x ==> x = y ==> open_in top y`)) THEN ASM SET_TAC[]);; let QUOTIENT_MAP_IMP_CONTINUOUS_OPEN = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) ==> f continuous_on s`, MESON_TAC[OPEN_IN_IMP_SUBSET; CONTINUOUS_ON_OPEN_GEN]);; let QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> closed_in (subtopology euclidean t) u)) ==> f continuous_on s`, MESON_TAC[CLOSED_IN_IMP_SUBSET; CONTINUOUS_ON_CLOSED_GEN]);; let OPEN_MAP_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N s. f continuous_on s /\ (!t. open_in (subtopology euclidean s) t ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) ==> !t. t SUBSET IMAGE f s ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> open_in (subtopology euclidean (IMAGE f s)) t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `t = IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN t}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN ASM_SIMP_TAC[]]);; let CLOSED_MAP_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N s. f continuous_on s /\ (!t. closed_in (subtopology euclidean s) t ==> closed_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) ==> !t. t SUBSET IMAGE f s ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> open_in (subtopology euclidean (IMAGE f s)) t)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF {x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN ANTS_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF THEN ASM_SIMP_TAC[CLOSED_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]; REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN ASM_SIMP_TAC[]]);; let CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ (!y. y IN t ==> f(g y) = y) ==> (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u))`, REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(IMAGE (g:real^N->real^M) t) INTER {x | x IN s /\ (f:real^M->real^N) x IN u}`) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]; DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = t` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM SET_TAC[]]);; let CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N g s. f continuous_on s /\ g continuous_on (IMAGE f s) /\ (!x. x IN s ==> g(f x) = x) ==> (!u. u SUBSET (IMAGE f s) ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean (IMAGE f s)) u))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let QUOTIENT_MAP_OPEN_CLOSED = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) <=> (!u. u SUBSET t ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> closed_in (subtopology euclidean t) u)))`, SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN (ANTS_TAC THENL [SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN REWRITE_TAC[SUBSET_RESTRICT] THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let CONTINUOUS_ON_COMPOSE_QUOTIENT = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ (!v. v SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean t) v)) /\ (g o f) continuous_on s ==> g continuous_on t`, REPEAT GEN_TAC THEN REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN SUBGOAL_THEN `IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) s SUBSET u` (fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_TAC] THEN X_GEN_TAC `v:real^P->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN v}`) THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `open_in top s ==> s = t ==> open_in top t`)) THEN ASM SET_TAC[]);; let LIFT_TO_QUOTIENT_SPACE = prove (`!f:real^M->real^N h:real^M->real^P s t u. IMAGE f s = t /\ (!v. v SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean t) v)) /\ h continuous_on s /\ IMAGE h s = u /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> h x = h y) ==> ?g. g continuous_on t /\ IMAGE g t = u /\ !x. x IN s ==> h(x) = g(f x)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[FUNCTION_FACTORS_LEFT_GEN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^P` THEN DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE_QUOTIENT THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`; `u:real^P->bool`] THEN ASM_SIMP_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_EQ)) THEN ASM_REWRITE_TAC[o_THM]);; let QUOTIENT_MAP_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ (!v. v SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean t) v)) /\ (!v. v SUBSET u ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=> open_in (subtopology euclidean u) v)) ==> !v. v SUBSET u ==> (open_in (subtopology euclidean s) {x | x IN s /\ (g o f) x IN v} <=> open_in (subtopology euclidean u) v)`, REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN SUBGOAL_THEN `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_RESTRICT]]);; let QUOTIENT_MAP_FROM_COMPOSITION = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!v. v SUBSET u ==> (open_in (subtopology euclidean s) {x | x IN s /\ (g o f) x IN v} <=> open_in (subtopology euclidean u) v)) ==> !v. v SUBSET u ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=> open_in (subtopology euclidean u) v)`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN SUBGOAL_THEN `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[]]);; let QUOTIENT_MAP_FROM_SUBSET = prove (`!f:real^M->real^N s t u. f continuous_on t /\ IMAGE f t SUBSET u /\ s SUBSET t /\ IMAGE f s = u /\ (!v. v SUBSET u ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> open_in (subtopology euclidean u) v)) ==> !v. v SUBSET u ==> (open_in (subtopology euclidean t) {x | x IN t /\ f x IN v} <=> open_in (subtopology euclidean u) v)`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC QUOTIENT_MAP_FROM_COMPOSITION THEN MAP_EVERY EXISTS_TAC [`\x:real^M. x`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; o_THM]);; let QUOTIENT_MAP_RESTRICT = prove (`!f:real^M->real^N s t c. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) /\ (open_in (subtopology euclidean t) c \/ closed_in (subtopology euclidean t) c) ==> !u. u SUBSET c ==> (open_in (subtopology euclidean {x | x IN s /\ f x IN c}) {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u} <=> open_in (subtopology euclidean c) u)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC (MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN) th)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) {x | x IN s /\ f x IN c} SUBSET c` ASSUME_TAC THENL [SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL [FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET); ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN (MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_MP_TAC(MESON[] `t = s /\ (P s <=> Q s) ==> (P s <=> Q t)`) THEN CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM]]; ALL_TAC]) THEN (EQ_TAC THENL [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) ORELSE MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_SUBSET_TRANS); MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) ORELSE MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_TRANS)]) THEN (MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN ORELSE MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN ORELSE ASM_SIMP_TAC[]) THEN ASM SET_TAC[]);; let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ connected t ==> connected s`, REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN UNDISCH_TAC `connected(t:real^N->bool)` THEN SIMP_TAC[CONNECTED_OPEN_IN] THEN MAP_EVERY EXISTS_TAC [`IMAGE (f:real^M->real^N) (s INTER u)`; `IMAGE (f:real^M->real^N) (s INTER v)`] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) (s INTER u) INTER IMAGE f (s INTER v) = {}` ASSUME_TAC THENL [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected]] THEN MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN ASM SET_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH (rand o rand) th o snd)) THEN (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN MATCH_MP_TAC(MESON[] `{x | x IN s /\ f x IN IMAGE f u} = u /\ open_in top u ==> open_in top {x | x IN s /\ f x IN IMAGE f u}`) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN ASM SET_TAC[]);; let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN = prove (`!f:real^M->real^N s t c. IMAGE f s = t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ (open_in (subtopology euclidean t) c \/ closed_in (subtopology euclidean t) c) /\ connected c ==> connected {x | x IN s /\ f x IN c}`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] CONNECTED_MONOTONE_QUOTIENT_PREIMAGE)) THEN SUBGOAL_THEN `(c:real^N->bool) SUBSET t` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN EXISTS_TAC `f:real^M->real^N` THEN REPEAT CONJ_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN)) THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN REWRITE_TAC[SUBSET_RESTRICT]; ASM SET_TAC[]; MATCH_MP_TAC QUOTIENT_MAP_RESTRICT THEN ASM_MESON_TAC[SUBSET_REFL]; X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* More properties of open and closed maps. *) (* ------------------------------------------------------------------------- *) let OPEN_MAP_RESTRICT = prove (`!f:real^M->real^N s t t'. (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ t' SUBSET t ==> !u. open_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u ==> open_in (subtopology euclidean t') (IMAGE f u)`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let CLOSED_MAP_RESTRICT = prove (`!f:real^M->real^N s t t'. (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ t' SUBSET t ==> !u. closed_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u ==> closed_in (subtopology euclidean t') (IMAGE f u)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; let QUOTIENT_MAP_OPEN_MAP_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) ==> ((!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f k}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let QUOTIENT_MAP_CLOSED_MAP_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t /\ (!u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)) ==> ((!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f k}))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let CLOSED_MAP_IMP_OPEN_MAP = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f u}) ==> (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[CLOSED_IN_REFL]]);; let OPEN_MAP_IMP_CLOSED_MAP = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN IMAGE f u}) ==> (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);; let OPEN_MAP_FROM_COMPOSITION_SURJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. open_in (subtopology euclidean t) k ==> open_in (subtopology euclidean u) (IMAGE g k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) {x | x IN s /\ f(x) IN k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; let CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. closed_in (subtopology euclidean t) k ==> closed_in (subtopology euclidean u) (IMAGE g k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) {x | x IN s /\ f(x) IN k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; let OPEN_MAP_FROM_COMPOSITION_INJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE f k = {x | x IN t /\ g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; let CLOSED_MAP_FROM_COMPOSITION_INJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) ==> (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE f k = {x | x IN t /\ g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE = prove (`!f:real^M->real^N s t u w. (!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k)) /\ closed_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. closed_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u`, REPEAT STRIP_TAC THEN EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]);; let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. open_in (subtopology euclidean s) k ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> (!u w. closed_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. closed_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[OPEN_MAP_CLOSED_SUPERSET_PREIMAGE] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]]);; let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE = prove (`!f:real^M->real^N s t u w. (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ open_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. open_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u`, REPEAT STRIP_TAC THEN EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]);; let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> (!u w. open_in (subtopology euclidean s) u /\ w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u ==> ?v. open_in (subtopology euclidean t) v /\ w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]]);; let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> (!u y. open_in (subtopology euclidean s) u /\ y IN t /\ {x | x IN s /\ f(x) = y} SUBSET u ==> ?v. open_in (subtopology euclidean t) v /\ y IN v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ] THEN EQ_TAC THEN DISCH_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `{y:real^N}`]) THEN ASM_REWRITE_TAC[SING_SUBSET; IN_SING]; MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS {(vv:real^N->real^N->bool) y | y IN w}` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_GSPEC] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM SET_TAC[]]]);; let CONNECTED_OPEN_MONOTONE_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!c. open_in (subtopology euclidean s) c ==> open_in (subtopology euclidean t) (IMAGE f c)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) ==> !c. connected c /\ c SUBSET t ==> connected {x | x IN s /\ f x IN c}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_MAP_RESTRICT)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] OPEN_MAP_IMP_QUOTIENT_MAP) THEN SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; SIMP_TAC[SET_RULE `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = {x | x IN s /\ f x = y}`] THEN ASM SET_TAC[]]);; let CONNECTED_CLOSED_MONOTONE_PREIMAGE = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!c. closed_in (subtopology euclidean s) c ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ (!y. y IN t ==> connected {x | x IN s /\ f x = y}) ==> !c. connected c /\ c SUBSET t ==> connected {x | x IN s /\ f x IN c}`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_MAP_RESTRICT)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] CLOSED_MAP_IMP_QUOTIENT_MAP) THEN SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; DISCH_TAC] THEN MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; SIMP_TAC[SET_RULE `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = {x | x IN s /\ f x = y}`] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Proper maps, including projections out of compact sets. *) (* ------------------------------------------------------------------------- *) let PROPER_MAP = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=> (!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ (!a. a IN t ==> compact {x | x IN s /\ f x = a}))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[SET_RULE `x = a <=> x IN {a}`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[SING_SUBSET; COMPACT_SING]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[CLOSED_IN_LIMPT] THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `y:real^N`] THEN REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE] THEN REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; SKOLEM_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_AND_THM] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[UNWIND_THM2; FUN_EQ_THM] THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `~(INTERS {{a | a IN k /\ (f:real^M->real^N) a IN (y INSERT IMAGE (\i. f(x(n + i))) (:num))} | n IN (:num)} = {})` MP_TAC THENL [MATCH_MP_TAC COMPACT_FIP THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[SET_RULE `{x | x IN s INTER k /\ P x} = k INTER {x | x IN s /\ P x}`] THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP SEQ_OFFSET) THEN REWRITE_TAC[ADD_SYM]; REWRITE_TAC[SIMPLE_IMAGE; FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `i:num->bool` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `(x:num->real^M) m` THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN DISJ2_TAC THEN EXISTS_TAC `m - p:num` THEN ASM_MESON_TAC[ARITH_RULE `p <= m ==> p + m - p:num = m`]]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(fun th -> LABEL_TAC "*" th THEN MP_TAC(SPEC `0` th)) THEN REWRITE_TAC[ADD_CLAUSES; IN_INSERT; IN_IMAGE; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (DISJ_CASES_THEN MP_TAC)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN REMOVE_THEN "*" (MP_TAC o SPEC `i + 1`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN ARITH_TAC]; STRIP_TAC THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN X_GEN_TAC `c:(real^M->bool)->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `!a. a IN k ==> ?g. g SUBSET c /\ FINITE g /\ {x | x IN s /\ (f:real^M->real^N) x = a} SUBSET UNIONS g` MP_TAC THENL [X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN UNDISCH_THEN `!a. a IN t ==> compact {x | x IN s /\ (f:real^M->real^N) x = a}` (MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[COMPACT_EQ_HEINE_BOREL]] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uu:real^N->(real^M->bool)->bool` THEN DISCH_THEN(LABEL_TAC "*")] THEN SUBGOAL_THEN `!a. a IN k ==> ?v. open v /\ a IN v /\ {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET UNIONS(uu a)` MP_TAC THENL [REPEAT STRIP_TAC THEN UNDISCH_THEN `!k. closed_in (subtopology euclidean s) k ==> closed_in (subtopology euclidean t) (IMAGE (f:real^M->real^N) k)` (MP_TAC o SPEC `(s:real^M->bool) DIFF UNIONS(uu(a:real^N))`) THEN SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ANTS_TAC THENL [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN MATCH_MP_TAC OPEN_UNIONS THEN ASM SET_TAC[]; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`)) THEN ASM_REWRITE_TAC[] THEN REPEAT ((ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) ORELSE STRIP_TAC) THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM SET_TAC[]]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `vv:real^N->(real^N->bool)` THEN DISCH_THEN(LABEL_TAC "+")] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (vv:real^N->(real^N->bool)) k`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN X_GEN_TAC `j:real^N->bool` THEN REPEAT STRIP_TAC THEN EXISTS_TAC `UNIONS(IMAGE (uu:real^N->(real^M->bool)->bool) j)` THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FINITE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE] THEN ASM SET_TAC[]; REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_UNIONS; IN_ELIM_THM] THEN ASM SET_TAC[]]]);; let COMPACT_CONTINUOUS_IMAGE_EQ = prove (`!f:real^M->real^N s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> (f continuous_on s <=> !t. compact t /\ t SUBSET s ==> compact(IMAGE f t))`, REPEAT STRIP_TAC THEN EQ_TAC THENL [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; DISCH_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `g:real^N->real^M` o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`; `s:real^M->bool`] PROPER_MAP) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(q ==> s) /\ p ==> (p <=> q /\ r) ==> s`) THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN u} = IMAGE g u` (fun th -> ASM_MESON_TAC[th]); SUBGOAL_THEN `{x | x IN IMAGE f s /\ (g:real^N->real^M) x IN k} = IMAGE f k` (fun th -> ASM_SIMP_TAC[th])] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]);; let PROPER_MAP_FROM_COMPACT = prove (`!f:real^M->real^N s k. f continuous_on s /\ IMAGE f s SUBSET t /\ compact s /\ closed_in (subtopology euclidean t) k ==> compact {x | x IN s /\ f x IN k}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_GEN]);; let PROPER_MAP_COMPOSE = prove (`!f:real^M->real^N g:real^N->real^P s t u. IMAGE f s SUBSET t /\ (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ (!k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}) ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN s /\ (g o f) x IN k}`, REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN k}`) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let PROPER_MAP_FROM_COMPOSITION_LEFT = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!k. k SUBSET u /\ compact k ==> compact {x | x IN s /\ (g o f) x IN k}) ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}`, REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] COMPACT_CONTINUOUS_IMAGE)) THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let PROPER_MAP_FROM_COMPOSITION_RIGHT = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!k. k SUBSET u /\ compact k ==> compact {x | x IN s /\ (g o f) x IN k}) ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`, let lemma = prove (`!s t. closed_in (subtopology euclidean s) t ==> compact s ==> compact t`, MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; CLOSED_IN_CLOSED_EQ]) in REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (g:real^N->real^P) k`) THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; MATCH_MP_TAC lemma THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);; let PROPER_MAP_FSTCART = prove (`!s:real^M->bool t:real^N->bool k. compact t /\ k SUBSET s /\ compact k ==> compact {z | z IN s PCROSS t /\ fstcart z IN k}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{z | z IN s PCROSS t /\ fstcart z IN k} = (k:real^M->bool) PCROSS (t:real^N->bool)` (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS; FSTCART_PASTECART] THEN ASM SET_TAC[]);; let CLOSED_MAP_FSTCART = prove (`!s:real^M->bool t:real^N->bool c. compact t /\ closed_in (subtopology euclidean (s PCROSS t)) c ==> closed_in (subtopology euclidean s) (IMAGE fstcart c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`] PROPER_MAP) THEN ASM_SIMP_TAC[PROPER_MAP_FSTCART; IMAGE_FSTCART_PCROSS] THEN ASM SET_TAC[]);; let PROPER_MAP_SNDCART = prove (`!s:real^M->bool t:real^N->bool k. compact s /\ k SUBSET t /\ compact k ==> compact {z | z IN s PCROSS t /\ sndcart z IN k}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{z | z IN s PCROSS t /\ sndcart z IN k} = (s:real^M->bool) PCROSS (k:real^N->bool)` (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let CLOSED_MAP_SNDCART = prove (`!s:real^M->bool t:real^N->bool c. compact s /\ closed_in (subtopology euclidean (s PCROSS t)) c ==> closed_in (subtopology euclidean t) (IMAGE sndcart c)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`] PROPER_MAP) THEN ASM_SIMP_TAC[PROPER_MAP_SNDCART; IMAGE_SNDCART_PCROSS] THEN ASM SET_TAC[]);; let CLOSED_IN_COMPACT_PROJECTION = prove (`!s:real^M->bool t:real^N->bool u. compact s /\ closed_in (subtopology euclidean (s PCROSS t)) u ==> closed_in (subtopology euclidean t) {y | ?x. x IN s /\ pastecart x y IN u}`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_MAP_SNDCART) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET o CONJUNCT2) THEN REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART; EXISTS_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN SET_TAC[]);; let CLOSED_COMPACT_PROJECTION = prove (`!s:real^M->bool t:real^(M,N)finite_sum->bool. compact s /\ closed t ==> closed {y | ?x. x IN s /\ pastecart x y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{y | ?x:real^M. x IN s /\ pastecart x y IN t} = {y | ?x. x IN s /\ pastecart x y IN ((s PCROSS (:real^N)) INTER t)}` SUBST1_TAC THENL [REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_INTER] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[CLOSED_UNIV] THEN MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[CLOSED_INTER; CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED; INTER_SUBSET]]);; let TUBE_LEMMA = prove (`!s:real^M->bool t:real^N->bool u a. compact s /\ ~(s = {}) /\ {pastecart x a | x IN s} SUBSET u /\ open_in(subtopology euclidean (s PCROSS t)) u ==> ?v. open_in (subtopology euclidean t) v /\ a IN v /\ (s PCROSS v) SUBSET u`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; PCROSS] CLOSED_IN_COMPACT_PROJECTION)) THEN ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] `(closed_in top t ==> s DIFF (s DIFF t) = t) /\ s DIFF t SUBSET s /\ P(s DIFF t) ==> closed_in top t ==> ?v. v SUBSET s /\ closed_in top (s DIFF v) /\ P v`) THEN REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = t <=> t SUBSET s`] THEN REWRITE_TAC[SUBSET_DIFF] THEN SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; let TUBE_LEMMA_GEN = prove (`!s t t' u:real^(M,N)finite_sum->bool. compact s /\ ~(s = {}) /\ t SUBSET t' /\ s PCROSS t SUBSET u /\ open_in (subtopology euclidean (s PCROSS t')) u ==> ?v. open_in (subtopology euclidean t') v /\ t SUBSET v /\ s PCROSS v SUBSET u`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a. a IN t ==> ?v. open_in (subtopology euclidean t') v /\ a IN v /\ (s:real^M->bool) PCROSS (v:real^N->bool) SUBSET u` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC TUBE_LEMMA THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (vv:real^N->real^N->bool) t)` THEN ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_IMAGE] THEN REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; FORALL_IN_PCROSS] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real^N`)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Pasting functions together on open sets. *) (* ------------------------------------------------------------------------- *) let PASTING_LEMMA = prove (`!f:A->real^M->real^N g t s k. (!i. i IN k ==> open_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i)) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) /\ (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) ==> g continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ g x IN u} = UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | i IN k}` SUBST1_TAC THENL [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[OPEN_IN_TRANS]]);; let PASTING_LEMMA_EXISTS = prove (`!f:A->real^M->real^N t s k. s SUBSET UNIONS {t i | i IN k} /\ (!i. i IN k ==> open_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i)) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) ==> ?g. g continuous_on s /\ (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA THEN MAP_EVERY EXISTS_TAC [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN ASM SET_TAC[]);; let CONTINUOUS_ON_UNION_LOCAL_OPEN = prove (`!f:real^M->real^N s. open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\i:(real^M->bool). (f:real^M->real^N)`; `f:real^M->real^N`; `\i:(real^M->bool). i`; `s UNION t:real^M->bool`; `{s:real^M->bool,t}`] PASTING_LEMMA) THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_UNION]);; let CONTINUOUS_ON_UNION_OPEN = prove (`!f s t. open s /\ open t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; let CONTINUOUS_ON_CASES_LOCAL_OPEN = prove (`!P f g:real^M->real^N s t. open_in (subtopology euclidean (s UNION t)) s /\ open_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_CASES_OPEN = prove (`!P f g s t. open s /\ open t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on s UNION t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Likewise on closed sets, with a finiteness assumption. *) (* ------------------------------------------------------------------------- *) let PASTING_LEMMA_CLOSED = prove (`!f:A->real^M->real^N g t s k. FINITE k /\ (!i. i IN k ==> closed_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i)) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) /\ (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) ==> g continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ g x IN u} = UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | i IN k}` SUBST1_TAC THENL [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[CLOSED_IN_TRANS]]);; let PASTING_LEMMA_EXISTS_CLOSED = prove (`!f:A->real^M->real^N t s k. FINITE k /\ s SUBSET UNIONS {t i | i IN k} /\ (!i. i IN k ==> closed_in (subtopology euclidean s) (t i) /\ (f i) continuous_on (t i)) /\ (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j ==> f i x = f j x) ==> ?g. g continuous_on s /\ (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA_CLOSED THEN MAP_EVERY EXISTS_TAC [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Closure of halflines, halfspaces and hyperplanes. *) (* ------------------------------------------------------------------------- *) let LIM_LIFT_DOT = prove (`!f:real^M->real^N a. (f --> l) net ==> ((lift o (\y. a dot f(y))) --> lift(a dot l)) net`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a = vec 0:real^N` THENL [ASM_REWRITE_TAC[DOT_LZERO; LIFT_NUM; o_DEF; LIM_CONST]; ALL_TAC] THEN REWRITE_TAC[LIM] THEN MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / norm(a:real^N)`) THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_RDIV_EQ] THEN REWRITE_TAC[dist; o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; NORM_LIFT] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN MESON_TAC[NORM_CAUCHY_SCHWARZ_ABS; REAL_MUL_SYM; REAL_LET_TRANS]);; let CONTINUOUS_AT_LIFT_DOT = prove (`!a:real^N x. (lift o (\y. a dot y)) continuous at x`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_AT; o_THM] THEN MATCH_MP_TAC LIM_LIFT_DOT THEN REWRITE_TAC[LIM_AT] THEN MESON_TAC[]);; let CONTINUOUS_ON_LIFT_DOT = prove (`!s. (lift o (\y. a dot y)) continuous_on s`, SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_DOT]);; let CLOSED_INTERVAL_LEFT = prove (`!b:real^N. closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i <= b$i}`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[dist; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; let CLOSED_INTERVAL_RIGHT = prove (`!a:real^N. closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i}`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[dist; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`]);; let CLOSED_HALFSPACE_LE = prove (`!a:real^N b. closed {x | a dot x <= b}`, REPEAT GEN_TAC THEN MP_TAC(ISPEC `(:real^N)` CONTINUOUS_ON_LIFT_DOT) THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN DISCH_THEN(MP_TAC o SPEC `IMAGE lift {r | ?x:real^N. (a dot x = r) /\ r <= b}`) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[o_DEF] THEN MESON_TAC[LIFT_DROP]] THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `{x | !i. 1 <= i /\ i <= dimindex(:1) ==> (x:real^1)$i <= (lift b)$i}` THEN REWRITE_TAC[CLOSED_INTERVAL_LEFT] THEN SIMP_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_ELIM_THM; IN_INTER; VEC_COMPONENT; DIMINDEX_1; LAMBDA_BETA; o_THM] THEN SIMP_TAC[ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN MESON_TAC[LIFT_DROP]);; let CLOSED_HALFSPACE_GE = prove (`!a:real^N b. closed {x | a dot x >= b}`, REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; CLOSED_HALFSPACE_LE]);; let CLOSED_HYPERPLANE = prove (`!a b. closed {x | a dot x = b}`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REWRITE_TAC[REAL_ARITH `b <= a dot x <=> a dot x >= b`] THEN REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_LE; CLOSED_HALFSPACE_GE]);; let CLOSED_STANDARD_HYPERPLANE = prove (`!k a. closed {x:real^N | x$k = a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CLOSED_HALFSPACE_COMPONENT_LE = prove (`!a k. closed {x:real^N | x$k <= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_LE) THEN ASM_SIMP_TAC[DOT_BASIS]);; let CLOSED_HALFSPACE_COMPONENT_GE = prove (`!a k. closed {x:real^N | x$k >= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_GE) THEN ASM_SIMP_TAC[DOT_BASIS]);; (* ------------------------------------------------------------------------- *) (* Openness of halfspaces. *) (* ------------------------------------------------------------------------- *) let OPEN_HALFSPACE_LT = prove (`!a b. open {x | a dot x < b}`, REWRITE_TAC[GSYM REAL_NOT_LE] THEN REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN REWRITE_TAC[GSYM closed; GSYM real_ge; CLOSED_HALFSPACE_GE]);; let OPEN_HALFSPACE_COMPONENT_LT = prove (`!a k. open {x:real^N | x$k < a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_LT) THEN ASM_SIMP_TAC[DOT_BASIS]);; let OPEN_HALFSPACE_GT = prove (`!a b. open {x | a dot x > b}`, REWRITE_TAC[REAL_ARITH `x > y <=> ~(x <= y)`] THEN REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN REWRITE_TAC[GSYM closed; CLOSED_HALFSPACE_LE]);; let OPEN_HALFSPACE_COMPONENT_GT = prove (`!a k. open {x:real^N | x$k > a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_GT) THEN ASM_SIMP_TAC[DOT_BASIS]);; let OPEN_POSITIVE_MULTIPLES = prove (`!s:real^N->bool. open s ==> open {c % x | &0 < c /\ x IN s}`, REWRITE_TAC[open_def; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(c) % y:real^N`) THEN ANTS_TAC THENL [SUBGOAL_THEN `x:real^N = inv c % c % x` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; REAL_LT_IMP_NZ]; ASM_SIMP_TAC[DIST_MUL; real_abs; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH `inv c * x:real = x / c`] THEN ASM_MESON_TAC[REAL_LT_LDIV_EQ; REAL_MUL_SYM]]; DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `c:real` THEN EXISTS_TAC `inv(c) % y:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Closures and interiors of halfspaces. *) (* ------------------------------------------------------------------------- *) let INTERIOR_HALFSPACE_LE = prove (`!a:real^N b. ~(a = vec 0) ==> interior {x | a dot x <= b} = {x | a dot x < b}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN SIMP_TAC[OPEN_HALFSPACE_LT; SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE] THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[SUBSET; IN_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; REAL_ARITH `&0 < x ==> abs x <= x`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e ==> ~(b + e <= b)`) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]);; let INTERIOR_HALFSPACE_GE = prove (`!a:real^N b. ~(a = vec 0) ==> interior {x | a dot x >= b} = {x | a dot x > b}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; REAL_ARITH `a > b <=> --a < --b`] THEN ASM_SIMP_TAC[GSYM DOT_LNEG; INTERIOR_HALFSPACE_LE; VECTOR_NEG_EQ_0]);; let INTERIOR_HALFSPACE_COMPONENT_LE = prove (`!a k. interior {x:real^N | x$k <= a} = {x | x$k < a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_LE) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let INTERIOR_HALFSPACE_COMPONENT_GE = prove (`!a k. interior {x:real^N | x$k >= a} = {x | x$k > a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_GE) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let CLOSURE_HALFSPACE_LT = prove (`!a:real^N b. ~(a = vec 0) ==> closure {x | a dot x < b} = {x | a dot x <= b}`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN REWRITE_TAC[SET_RULE `UNIV DIFF {x | P x} = {x | ~P x}`] THEN ASM_SIMP_TAC[REAL_ARITH `~(x < b) <=> x >= b`; INTERIOR_HALFSPACE_GE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN REAL_ARITH_TAC);; let CLOSURE_HALFSPACE_GT = prove (`!a:real^N b. ~(a = vec 0) ==> closure {x | a dot x > b} = {x | a dot x >= b}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; REAL_ARITH `a > b <=> --a < --b`] THEN ASM_SIMP_TAC[GSYM DOT_LNEG; CLOSURE_HALFSPACE_LT; VECTOR_NEG_EQ_0]);; let CLOSURE_HALFSPACE_COMPONENT_LT = prove (`!a k. closure {x:real^N | x$k < a} = {x | x$k <= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_LT) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let CLOSURE_HALFSPACE_COMPONENT_GT = prove (`!a k. closure {x:real^N | x$k > a} = {x | x$k >= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_GT) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let INTERIOR_HYPERPLANE = prove (`!a b. ~(a = vec 0) ==> interior {x | a dot x = b} = {}`, REWRITE_TAC[REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN REWRITE_TAC[INTERIOR_INTER] THEN ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; INTERIOR_HALFSPACE_GE] THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN REAL_ARITH_TAC);; let FRONTIER_HALFSPACE_LE = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x <= b} = {x | a dot x = b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO] THENL [ASM_CASES_TAC `&0 <= b` THEN ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; ASM_SIMP_TAC[frontier; INTERIOR_HALFSPACE_LE; CLOSURE_CLOSED; CLOSED_HALFSPACE_LE] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let FRONTIER_HALFSPACE_GE = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x >= b} = {x | a dot x = b}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LE) THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);; let FRONTIER_HALFSPACE_LT = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x < b} = {x | a dot x = b}`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO] THENL [ASM_CASES_TAC `&0 < b` THEN ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; ASM_SIMP_TAC[frontier; CLOSURE_HALFSPACE_LT; INTERIOR_OPEN; OPEN_HALFSPACE_LT] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let FRONTIER_HALFSPACE_GT = prove (`!a:real^N b. ~(a = vec 0 /\ b = &0) ==> frontier {x | a dot x > b} = {x | a dot x = b}`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LT) THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN REWRITE_TAC[REAL_LT_NEG2; REAL_EQ_NEG2; real_gt]);; let INTERIOR_STANDARD_HYPERPLANE = prove (`!k a. interior {x:real^N | x$k = a} = {}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` CHOOSE_TAC THENL [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; let EMPTY_INTERIOR_LOWDIM = prove (`!s:real^N->bool. dim(s) < dimindex(:N) ==> interior s = {}`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `!t u. s SUBSET t /\ t SUBSET u /\ u = {} ==> s = {}`) THEN MAP_EVERY EXISTS_TAC [`interior(span(s):real^N->bool)`; `interior({x:real^N | a dot x = &0})`] THEN ASM_SIMP_TAC[SUBSET_INTERIOR; SPAN_INC; INTERIOR_HYPERPLANE]);; (* ------------------------------------------------------------------------- *) (* Unboundedness of halfspaces. *) (* ------------------------------------------------------------------------- *) let UNBOUNDED_HALFSPACE_COMPONENT_LE = prove (`!a k. ~bounded {x:real^N | x$k <= a}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !z:real^N. z$k = z$i` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN EXISTS_TAC `--(&1 + max (abs B) (abs a)) % basis i:real^N` THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; BASIS_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);; let UNBOUNDED_HALFSPACE_COMPONENT_GE = prove (`!a k. ~bounded {x:real^N | x$k >= a}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_NEGATIONS) THEN MP_TAC(SPECL [`--a:real`; `k:num`] UNBOUNDED_HALFSPACE_COMPONENT_LE) THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[VECTOR_NEG_NEG]; REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC]);; let UNBOUNDED_HALFSPACE_COMPONENT_LT = prove (`!a k. ~bounded {x:real^N | x$k < a}`, ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_LT; UNBOUNDED_HALFSPACE_COMPONENT_LE]);; let UNBOUNDED_HALFSPACE_COMPONENT_GT = prove (`!a k. ~bounded {x:real^N | x$k > a}`, ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_GT; UNBOUNDED_HALFSPACE_COMPONENT_GE]);; let BOUNDED_HALFSPACE_LE = prove (`!a:real^N b. bounded {x | a dot x <= b} <=> a = vec 0 /\ b < &0`, GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN SIMP_TAC[DOT_LMUL; DOT_BASIS; VECTOR_MUL_EQ_0; DIMINDEX_GE_1; LE_REFL; BASIS_NONZERO] THEN X_GEN_TAC `a:real` THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `b:real` THENL [REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `&0 <= b` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE; UNBOUNDED_HALFSPACE_COMPONENT_LE]]);; let BOUNDED_HALFSPACE_GE = prove (`!a:real^N b. bounded {x | a dot x >= b} <=> a = vec 0 /\ &0 < b`, REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LE] THEN REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b < &0 <=> &0 < b`]);; let BOUNDED_HALFSPACE_LT = prove (`!a:real^N b. bounded {x | a dot x < b} <=> a = vec 0 /\ b <= &0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `b <= &0` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; BOUNDED_HALFSPACE_LE]]);; let BOUNDED_HALFSPACE_GT = prove (`!a:real^N b. bounded {x | a dot x > b} <=> a = vec 0 /\ &0 <= b`, REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`] THEN REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LT] THEN REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b <= &0 <=> &0 <= b`]);; (* ------------------------------------------------------------------------- *) (* Equality of continuous functions on closure and related results. *) (* ------------------------------------------------------------------------- *) let FORALL_IN_CLOSURE = prove (`!f:real^M->real^N s t. closed t /\ f continuous_on (closure s) /\ (!x. x IN s ==> f x IN t) ==> (!x. x IN closure s ==> f x IN t)`, REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> s SUBSET {x | x IN s /\ f x IN t}`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_CLOSURE]]);; let FORALL_IN_CLOSURE_EQ = prove (`!f s t. closed t /\ f continuous_on closure s ==> ((!x. x IN closure s ==> f x IN t) <=> (!x. x IN s ==> f x IN t))`, MESON_TAC[FORALL_IN_CLOSURE; CLOSURE_SUBSET; SUBSET]);; let SUP_CLOSURE = prove (`!s. sup(IMAGE drop (closure s)) = sup(IMAGE drop s)`, GEN_TAC THEN MATCH_MP_TAC SUP_EQ THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_LE]);; let INF_CLOSURE = prove (`!s. inf(IMAGE drop (closure s)) = inf(IMAGE drop s)`, GEN_TAC THEN MATCH_MP_TAC INF_EQ THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `b <= drop x <=> x IN {x | b <= drop x}`] THEN MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_GE; GSYM real_ge]);; let CONTINUOUS_LE_ON_CLOSURE = prove (`!f:real^M->real s a. (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> f(x) <= a) ==> !x. x IN closure(s) ==> f(x) <= a`, let lemma = prove (`x IN s ==> f x <= a <=> x IN s ==> (lift o f) x IN {y | y$1 <= a}`, REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; LIFT_DROP]) in REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_LE]);; let CONTINUOUS_GE_ON_CLOSURE = prove (`!f:real^M->real s a. (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> a <= f(x)) ==> !x. x IN closure(s) ==> a <= f(x)`, let lemma = prove (`x IN s ==> a <= f x <=> x IN s ==> (lift o f) x IN {y | y$1 >= a}`, REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; real_ge; LIFT_DROP]) in REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_GE]);; let CONTINUOUS_CONSTANT_ON_CLOSURE = prove (`!f:real^M->real^N s a. f continuous_on closure(s) /\ (!x. x IN s ==> f(x) = a) ==> !x. x IN closure(s) ==> f(x) = a`, REWRITE_TAC[SET_RULE `x IN s ==> f x = a <=> x IN s ==> f x IN {a}`] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN ASM_REWRITE_TAC[CLOSED_SING]);; let CONTINUOUS_AGREE_ON_CLOSURE = prove (`!g h:real^M->real^N. g continuous_on closure s /\ h continuous_on closure s /\ (!x. x IN s ==> g x = h x) ==> !x. x IN closure s ==> g x = h x`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_CONSTANT_ON_CLOSURE THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB]);; let CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT = prove (`!f:real^M->real^N s a. f continuous_on s ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x = a}`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_SING]);; let CONTINUOUS_CLOSED_PREIMAGE_CONSTANT = prove (`!f:real^M->real^N s. f continuous_on s /\ closed s ==> closed {x | x IN s /\ f(x) = a}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `{x | x IN s /\ (f:real^M->real^N)(x) = a} = {}` THEN ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_SING] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Theorems relating continuity and uniform continuity to closures. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_CLOSURE = prove (`!f:real^M->real^N s. f continuous_on closure s <=> !x e. x IN closure s /\ &0 < e ==> ?d. &0 < d /\ !y. y IN s /\ dist(y,x) < d ==> dist(f y,f x) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL [MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET]; ALL_TAC] THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`]) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `e / &2`]) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min k (d / &2)`) THEN ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN ASM_MESON_TAC[DIST_SYM; NORM_ARITH `dist(a,b) < e / &2 /\ dist(b,c) < e / &2 ==> dist(a,c) < e`]);; let CONTINUOUS_ON_CLOSURE_SEQUENTIALLY = prove (`!f:real^M->real^N s. f continuous_on closure s <=> !x a. a IN closure s /\ (!n. x n IN s) /\ (x --> a) sequentially ==> ((f o x) --> f a) sequentially`, REWRITE_TAC[CONTINUOUS_ON_CLOSURE] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP; GSYM continuous_within] THEN REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; let UNIFORMLY_CONTINUOUS_ON_CLOSURE = prove (`!f:real^M->real^N s. f uniformly_continuous_on s /\ f continuous_on closure s ==> f uniformly_continuous_on closure s`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `d / &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPECL [`x:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d1 (d / &3)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN DISCH_THEN(X_CHOOSE_THEN `x':real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `x':real^M`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d2 (d / &3)`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN DISCH_THEN(X_CHOOSE_THEN `y':real^M` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `y':real^M`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x':real^M`; `y':real^M`]) THEN ASM_MESON_TAC[DIST_SYM; NORM_ARITH `dist(y,x) < d / &3 /\ dist(x',x) < d / &3 /\ dist(y',y) < d / &3 ==> dist(y',x') < d`]);; (* ------------------------------------------------------------------------- *) (* Continuity properties for square roots. We get other forms of this *) (* later (transcendentals.ml and realanalysis.ml) but it's nice to have *) (* them around earlier. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_AT_SQRT = prove (`!a s. &0 < drop a ==> (lift o sqrt o drop) continuous (at a)`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `min (drop a) (e * sqrt(drop a))` THEN ASM_SIMP_TAC[REAL_LT_MIN; SQRT_POS_LT; REAL_LT_MUL; DIST_REAL] THEN X_GEN_TAC `b:real^1` THEN REWRITE_TAC[GSYM drop] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `abs(b - a) < a ==> &0 < b`)) THEN SUBGOAL_THEN `sqrt(drop b) - sqrt(drop a) = (drop b - drop a) / (sqrt(drop a) + sqrt(drop b))` SUBST1_TAC THENL [MATCH_MP_TAC(REAL_FIELD `sa pow 2 = a /\ sb pow 2 = b /\ &0 < sa /\ &0 < sb ==> sb - sa = (b - a) / (sa + sb)`) THEN ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE]; ASM_SIMP_TAC[REAL_ABS_DIV; SQRT_POS_LT; REAL_LT_ADD; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < x ==> abs x = x`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_ADDR; SQRT_POS_LE; REAL_LT_IMP_LE]]);; let CONTINUOUS_WITHIN_LIFT_SQRT = prove (`!a s. (!x. x IN s ==> &0 <= drop x) ==> (lift o sqrt o drop) continuous (at a within s)`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `drop a < &0 \/ drop a = &0 \/ &0 < drop a`) THENL [MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `{x | &0 <= drop x}` THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_NOT_LE] THEN REWRITE_TAC[drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]) THEN ASM_REWRITE_TAC[continuous_within; o_THM; DROP_VEC; SQRT_0; LIFT_NUM] THEN REWRITE_TAC[DIST_0; NORM_LIFT; NORM_REAL; GSYM drop] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(e:real) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN ASM_SIMP_TAC[real_abs; SQRT_POS_LE] THEN SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL [ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; MATCH_MP_TAC SQRT_MONO_LT THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]; MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[]]);; let CONTINUOUS_WITHIN_SQRT_COMPOSE = prove (`!f s a:real^N. (\x. lift(f x)) continuous (at a within s) /\ (&0 < f a \/ !x. x IN s ==> &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous (at a within s)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN REPEAT STRIP_TAC THEN (MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF]; ALL_TAC]) THENL [MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP]; MATCH_MP_TAC CONTINUOUS_WITHIN_LIFT_SQRT THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]]);; let CONTINUOUS_AT_SQRT_COMPOSE = prove (`!f a:real^N. (\x. lift(f x)) continuous (at a) /\ (&0 < f a \/ !x. &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous (at a)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `(:real^N)`; `a:real^N`] CONTINUOUS_WITHIN_SQRT_COMPOSE) THEN REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; let CONTINUOUS_ON_LIFT_SQRT = prove (`!s. (!x. x IN s ==> &0 <= drop x) ==> (lift o sqrt o drop) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_LIFT_SQRT]);; let CONTINUOUS_ON_LIFT_SQRT_COMPOSE = prove (`!f:real^N->real s. (lift o f) continuous_on s /\ (!x. x IN s ==> &0 <= f x) ==> (\x. lift(sqrt(f x))) continuous_on s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_SQRT THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]]);; (* ------------------------------------------------------------------------- *) (* Cauchy continuity, and the extension of functions to closures. *) (* ------------------------------------------------------------------------- *) let UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS = prove (`!f:real^M->real^N s. f uniformly_continuous_on s ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; cauchy; o_DEF] THEN MESON_TAC[]);; let CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS = prove (`!f:real^M->real^N s. f continuous_on s /\ closed s ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; CONTINUOUS_ON_SEQUENTIALLY] THEN REWRITE_TAC[complete] THEN MESON_TAC[CONVERGENT_IMP_CAUCHY]);; let CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) ==> !a x. (!n. (x n) IN s) /\ (x --> a) sequentially ==> ?l. ((f o x) --> l) sequentially /\ !y. (!n. (y n) IN s) /\ (y --> a) sequentially ==> ((f o y) --> l) sequentially`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:num->real^M` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:num->real^M`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `l:real^N = m` (fun th -> ASM_REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (f:real^M->real^N)(x n) - f(y n)` THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN FIRST_X_ASSUM(MP_TAC o SPEC `\n. if EVEN n then x(n DIV 2):real^M else y(n DIV 2)`) THEN REWRITE_TAC[cauchy; o_THM; LIM_SEQUENTIALLY] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC [`((y:num->real^M) --> a) sequentially`; `((x:num->real^M) --> a) sequentially`] THEN REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl))) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `2 * (N1 + N2)` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `m DIV 2` th) THEN MP_TAC(SPEC `n DIV 2` th))) THEN REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`2 * n`; `2 * n + 1`]) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN REWRITE_TAC[ARITH_RULE `(2 * n) DIV 2 = n /\ (2 * n + 1) DIV 2 = n`] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO]]);; let CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) ==> ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!a:real^M. ?x. a IN closure s ==> (!n. x n IN s) /\ (x --> a) sequentially` MP_TAC THENL [MESON_TAC[CLOSURE_SEQUENTIAL]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `X:real^M->num->real^M` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA) THEN DISCH_THEN(MP_TAC o GEN `a:real^M` o SPECL [`a:real^M`; `(X:real^M->num->real^M) a`]) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `(!a. P a ==> Q a) ==> ((!a. P a ==> R a) ==> p) ==> ((!a. Q a ==> R a) ==> p)`)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL [X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `(\n. a):num->real^M` o CONJUNCT2) THEN ASM_SIMP_TAC[LIM_CONST_EQ; o_DEF; TRIVIAL_LIMIT_SEQUENTIALLY]; STRIP_TAC] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY] THEN MAP_EVERY X_GEN_TAC [`x:num->real^M`; `a:real^M`] THEN STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `(f:real^M->real^N) o (x:num->real^M)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[o_THM]);; let UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove (`!f:real^M->real^N s. f uniformly_continuous_on s ==> ?g. g uniformly_continuous_on closure s /\ (!x. x IN s ==> g x = f x) /\ !h. h continuous_on closure s /\ (!x. x IN s ==> h x = f x) ==> !x. x IN closure s ==> h x = g x`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_ON_CLOSURE; UNIFORMLY_CONTINUOUS_ON_EQ]; ASM_MESON_TAC[CONTINUOUS_AGREE_ON_CLOSURE]]);; let CAUCHY_CONTINUOUS_IMP_CONTINUOUS = prove (`!f:real^M->real^N s. (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) ==> f continuous_on s`, REPEAT STRIP_TAC THEN FIRST_ASSUM(CHOOSE_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CLOSURE_SUBSET; CONTINUOUS_ON_EQ]);; let BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. f uniformly_continuous_on s /\ bounded s ==> bounded(IMAGE f s)`, REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `IMAGE (g:real^M->real^N) (closure s)` THEN CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_CLOSURE; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE]; MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Occasionally useful invariance properties. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_AT_COMPOSE_EQ = prove (`!f:real^M->real^N g:real^M->real^M h:real^M->real^M. g continuous at x /\ h continuous at (g x) /\ (!y. g(h y) = y) /\ h(g x) = x ==> (f continuous at (g x) <=> (\x. f(g x)) continuous at x)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE] THEN DISCH_TAC THEN SUBGOAL_THEN `((f:real^M->real^N) o (g:real^M->real^M) o (h:real^M->real^M)) continuous at (g(x:real^M))` MP_TAC THENL [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN ASM_REWRITE_TAC[o_DEF]; ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; let CONTINUOUS_AT_TRANSLATION = prove (`!a z f:real^M->real^N. f continuous at (a + z) <=> (\x. f(a + x)) continuous at z`, REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN EXISTS_TAC `\x:real^M. x - a` THEN SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN VECTOR_ARITH_TAC);; add_translation_invariants [CONTINUOUS_AT_TRANSLATION];; let CONTINUOUS_AT_LINEAR_IMAGE = prove (`!h:real^M->real^M z f:real^M->real^N. linear h /\ (!x. norm(h x) = norm x) ==> (f continuous at (h z) <=> (\x. f(h x)) continuous at z)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM ORTHOGONAL_TRANSFORMATION]) THEN FIRST_ASSUM(X_CHOOSE_TAC `g:real^M->real^M` o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE) THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN EXISTS_TAC `g:real^M->real^M` THEN RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_TRANSFORMATION]) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; add_linear_invariants [CONTINUOUS_AT_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Interior of an injective image. *) (* ------------------------------------------------------------------------- *) let INTERIOR_IMAGE_SUBSET = prove (`!f:real^M->real^N s. (!x. f continuous at x) /\ (!x y. f x = f y ==> x = y) ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN REWRITE_TAC[interior; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN SUBGOAL_THEN `y IN IMAGE (f:real^M->real^N) s` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `{x | (f:real^M->real^N)(x) IN t}` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_MESON_TAC[]; ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Making a continuous function avoid some value in a neighbourhood. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_WITHIN_AVOID = prove (`!f:real^M->real^N x s a. f continuous (at x within s) /\ x IN s /\ ~(f x = a) ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x - a)`) THEN ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN NORM_ARITH_TAC);; let CONTINUOUS_AT_AVOID = prove (`!f:real^M->real^N x a. f continuous (at x) /\ ~(f x = a) ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, MP_TAC CONTINUOUS_WITHIN_AVOID THEN REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(MP_TAC o SPEC `(:real^M)`) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; let CONTINUOUS_ON_AVOID = prove (`!f:real^M->real^N x s a. f continuous_on s /\ x IN s /\ ~(f x = a) ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_AVOID THEN ASM_SIMP_TAC[]);; let CONTINUOUS_ON_OPEN_AVOID = prove (`!f:real^M->real^N x s a. f continuous_on s /\ open s /\ x IN s /\ ~(f x = a) ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `open(s:real^M->bool)` THEN ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_AVOID THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Proving a function is constant by proving open-ness of level set. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_LEVELSET_OPEN_IN_CASES = prove (`!f:real^M->real^N s a. connected s /\ f continuous_on s /\ open_in (subtopology euclidean s) {x | x IN s /\ f x = a} ==> (!x. x IN s ==> ~(f x = a)) \/ (!x. x IN s ==> f x = a)`, REWRITE_TAC[SET_RULE `(!x. x IN s ==> ~(f x = a)) <=> {x | x IN s /\ f x = a} = {}`; SET_RULE `(!x. x IN s ==> f x = a) <=> {x | x IN s /\ f x = a} = s`] THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT]);; let CONTINUOUS_LEVELSET_OPEN_IN = prove (`!f:real^M->real^N s a. connected s /\ f continuous_on s /\ open_in (subtopology euclidean s) {x | x IN s /\ f x = a} /\ (?x. x IN s /\ f x = a) ==> (!x. x IN s ==> f x = a)`, MESON_TAC[CONTINUOUS_LEVELSET_OPEN_IN_CASES]);; let CONTINUOUS_LEVELSET_OPEN = prove (`!f:real^M->real^N s a. connected s /\ f continuous_on s /\ open {x | x IN s /\ f x = a} /\ (?x. x IN s /\ f x = a) ==> (!x. x IN s ==> f x = a)`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC CONTINUOUS_LEVELSET_OPEN_IN THEN ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x = a}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some arithmetical combinations (more to prove). *) (* ------------------------------------------------------------------------- *) let OPEN_SCALING = prove (`!s:real^N->bool c. ~(c = &0) /\ open s ==> open(IMAGE (\x. c % x) s)`, REPEAT GEN_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e * abs(c)` THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `inv(c) % y:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `x = inv(c) % c % x:real^N` SUBST1_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN ASM_REWRITE_TAC[GSYM dist]]);; let OPEN_NEGATIONS = prove (`!s:real^N->bool. open s ==> open (IMAGE (--) s)`, SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x` (fun th -> SIMP_TAC[th; OPEN_SCALING; REAL_ARITH `~(--(&1) = &0)`]) THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; let OPEN_TRANSLATION = prove (`!s a:real^N. open s ==> open(IMAGE (\x. a + x) s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. x - a`; `s:real^N->bool`] CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[VECTOR_ARITH `(a + x) - a = x:real^N`; VECTOR_ARITH `a + (x - a) = x:real^N`]);; let OPEN_TRANSLATION_EQ = prove (`!a s. open (IMAGE (\x:real^N. a + x) s) <=> open s`, REWRITE_TAC[open_def] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [OPEN_TRANSLATION_EQ];; let OPEN_AFFINITY = prove (`!s a:real^N c. open s /\ ~(c = &0) ==> open (IMAGE (\x. a + c % x) s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN ASM_SIMP_TAC[IMAGE_o; OPEN_TRANSLATION; OPEN_SCALING]);; let INTERIOR_TRANSLATION = prove (`!a:real^N s. interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (interior s)`, REWRITE_TAC[interior] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [INTERIOR_TRANSLATION];; let OPEN_SUMS = prove (`!s t:real^N->bool. open s \/ open t ==> open {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[open_def] THEN STRIP_TAC THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`); FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[VECTOR_ADD_SYM; VECTOR_ARITH `(z - y) + y:real^N = z`; NORM_ARITH `dist(z:real^N,x + y) < e ==> dist(z - y,x) < e`]);; (* ------------------------------------------------------------------------- *) (* Upper and lower hemicontinuous functions, relation in the case of *) (* preimage map to open and closed maps, and fact that upper and lower *) (* hemicontinuity together imply continuity in the sense of the Hausdorff *) (* metric (at points where the function gives a bounded and nonempty set). *) (* ------------------------------------------------------------------------- *) let UPPER_HEMICONTINUOUS = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) ==> ((!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) <=> (!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ ~(f(x) INTER u = {})}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]; REWRITE_TAC[closed_in]] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let LOWER_HEMICONTINUOUS = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) ==> ((!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) <=> (!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ ~(f(x) INTER u = {})}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) {y | y IN t /\ {x | x IN s /\ f x = y} SUBSET u}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE = prove (`!f:real^M->real^N s t. IMAGE f s SUBSET t ==> ((!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) <=> (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) {y | y IN t /\ {x | x IN s /\ f x = y} SUBSET u}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; let UPPER_LOWER_HEMICONTINUOUS_EXPLICIT = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) /\ (!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) /\ (!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) ==> !x e. x IN s /\ &0 < e /\ bounded(f x) /\ ~(f x = {}) ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x,x') < d ==> (!y. y IN f x ==> ?y'. y' IN f x' /\ dist(y,y') < e) /\ (!y'. y' IN f x' ==> ?y. y IN f x /\ dist(y',y) < e)`, REPEAT STRIP_TAC THEN UNDISCH_TAC `!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN DISCH_THEN(MP_TAC o SPEC `t INTER {a + b | a IN (f:real^M->real^N->bool) x /\ b IN ball(vec 0,e)}`) THEN SIMP_TAC[OPEN_SUMS; OPEN_BALL; OPEN_IN_OPEN_INTER] THEN REWRITE_TAC[open_in; SUBSET_RESTRICT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_SIMP_TAC[IN_ELIM_THM; SUBSET_INTER] THEN ANTS_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1")))] THEN UNDISCH_TAC `!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN ASM_SIMP_TAC[LOWER_HEMICONTINUOUS] THEN DISCH_THEN(MP_TAC o GEN `a:real^N` o SPEC `t INTER ball(a:real^N,e / &2)`) THEN SIMP_TAC[OPEN_BALL; OPEN_IN_OPEN_INTER] THEN MP_TAC(SPEC `closure((f:real^M->real^N->bool) x)` COMPACT_EQ_HEINE_BOREL) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `{ball(a:real^N,e / &2) | a IN (f:real^M->real^N->bool) x}`) THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_BALL] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL [REWRITE_TAC[CLOSURE_APPROACHABLE; SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[IN_BALL] THEN ASM_SIMP_TAC[REAL_HALF]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (MESON[CLOSURE_SUBSET; SUBSET_TRANS] `closure s SUBSET t ==> s SUBSET t`)) THEN SUBGOAL_THEN `open_in (subtopology euclidean s) (INTERS {{x | x IN s /\ ~((f:real^M->real^N->bool) x INTER t INTER ball(a,e / &2) = {})} | a IN c})` MP_TAC THENL [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ANTS_TAC THENL [REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN ASM SET_TAC[]; DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))] THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; REMOVE_THEN "1" (MP_TAC o SPEC `x':real^M`) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_BALL] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = a + b <=> x - a = b`; DIST_0; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[dist]] THEN REMOVE_THEN "2" (MP_TAC o SPEC `x':real^M`) THEN ASM_REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN DISCH_THEN(LABEL_TAC "3") THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN UNDISCH_TAC `(f:real^M->real^N->bool) x SUBSET UNIONS (IMAGE (\a. ball (a,e / &2)) c)` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN REMOVE_THEN "3" (MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; (* ------------------------------------------------------------------------- *) (* Connected components, considered as a "connectedness" relation or a set. *) (* ------------------------------------------------------------------------- *) let connected_component = new_definition `connected_component s x y <=> ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t`;; let CONNECTED_COMPONENT_IN = prove (`!s x y. connected_component s x y ==> x IN s /\ y IN s`, REWRITE_TAC[connected_component] THEN SET_TAC[]);; let CONNECTED_COMPONENT_REFL = prove (`!s x:real^N. x IN s ==> connected_component s x x`, REWRITE_TAC[connected_component] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[CONNECTED_SING] THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_REFL_EQ = prove (`!s x:real^N. connected_component s x x <=> x IN s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL] THEN REWRITE_TAC[connected_component] THEN SET_TAC[]);; let CONNECTED_COMPONENT_SYM = prove (`!s x y:real^N. connected_component s x y ==> connected_component s y x`, REWRITE_TAC[connected_component] THEN MESON_TAC[]);; let CONNECTED_COMPONENT_TRANS = prove (`!s x y:real^N. connected_component s x y /\ connected_component s y z ==> connected_component s x z`, REPEAT GEN_TAC THEN REWRITE_TAC[connected_component] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `t:real^N->bool`) (X_CHOOSE_TAC `u:real^N->bool`)) THEN EXISTS_TAC `t UNION u:real^N->bool` THEN ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_OF_SUBSET = prove (`!s t x. s SUBSET t /\ connected_component s x y ==> connected_component t x y`, REWRITE_TAC[connected_component] THEN SET_TAC[]);; let CONNECTED_COMPONENT_SET = prove (`!s x. connected_component s x = { y | ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t}`, REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN REWRITE_TAC[IN; connected_component] THEN MESON_TAC[]);; let CONNECTED_COMPONENT_UNIONS = prove (`!s x. connected_component s x = UNIONS {t | connected t /\ x IN t /\ t SUBSET s}`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_COMPONENT_SUBSET = prove (`!s x. (connected_component s x) SUBSET s`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_CONNECTED_COMPONENT_SET = prove (`!s. connected s <=> !x:real^N. x IN s ==> connected_component s x = s`, GEN_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_UNIONS THEN ASM SET_TAC[]);; let CONNECTED_COMPONENT_EQ_SELF = prove (`!s x. connected s /\ x IN s ==> connected_component s x = s`, MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET]);; let CONNECTED_IFF_CONNECTED_COMPONENT = prove (`!s. connected s <=> !x y. x IN s /\ y IN s ==> connected_component s x y`, REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT_SET] THEN REWRITE_TAC[EXTENSION] THEN MESON_TAC[IN; CONNECTED_COMPONENT_IN]);; let CONNECTED_COMPONENT_MAXIMAL = prove (`!s t x:real^N. x IN t /\ connected t /\ t SUBSET s ==> t SUBSET (connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_COMPONENT_MONO = prove (`!s t x. s SUBSET t ==> (connected_component s x) SUBSET (connected_component t x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; let CONNECTED_CONNECTED_COMPONENT = prove (`!s x. connected(connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN SET_TAC[]);; let CONNECTED_COMPONENT_EQ_EMPTY = prove (`!s x:real^N. connected_component s x = {} <=> ~(x IN s)`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]]);; let CONNECTED_COMPONENT_EMPTY = prove (`!x. connected_component {} x = {}`, REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);; let CONNECTED_COMPONENT_EQ = prove (`!s x y. y IN connected_component s x ==> (connected_component s y = connected_component s x)`, REWRITE_TAC[EXTENSION; IN] THEN MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; let CLOSED_CONNECTED_COMPONENT = prove (`!s x:real^N. closed s ==> closed(connected_component s x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL [ALL_TAC; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CLOSED_EMPTY]] THEN REWRITE_TAC[GSYM CLOSURE_EQ] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN SIMP_TAC[CONNECTED_CLOSURE; CONNECTED_CONNECTED_COMPONENT] THEN CONJ_TAC THENL [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; let CONNECTED_COMPONENT_DISJOINT = prove (`!s a b. DISJOINT (connected_component s a) (connected_component s b) <=> ~(a IN connected_component s b)`, REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN REWRITE_TAC[IN] THEN MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; let CONNECTED_COMPONENT_NONOVERLAP = prove (`!s a b:real^N. (connected_component s a) INTER (connected_component s b) = {} <=> ~(a IN s) \/ ~(b IN s) \/ ~(connected_component s a = connected_component s b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC `connected_component s (a:real^N) = connected_component s b` THEN ASM_REWRITE_TAC[INTER_IDEMPOT; CONNECTED_COMPONENT_EQ_EMPTY] THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DISJOINT]) THEN REWRITE_TAC[CONNECTED_COMPONENT_DISJOINT]);; let CONNECTED_COMPONENT_OVERLAP = prove (`!s a b:real^N. ~((connected_component s a) INTER (connected_component s b) = {}) <=> a IN s /\ b IN s /\ connected_component s a = connected_component s b`, REWRITE_TAC[CONNECTED_COMPONENT_NONOVERLAP; DE_MORGAN_THM]);; let CONNECTED_COMPONENT_SYM_EQ = prove (`!s x y. connected_component s x y <=> connected_component s y x`, MESON_TAC[CONNECTED_COMPONENT_SYM]);; let CONNECTED_COMPONENT_EQ_EQ = prove (`!s x y:real^N. connected_component s x = connected_component s y <=> ~(x IN s) /\ ~(y IN s) \/ x IN s /\ y IN s /\ connected_component s x y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_REFL; CONNECTED_COMPONENT_SYM]; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]; RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]);; let CONNECTED_EQ_CONNECTED_COMPONENT_EQ = prove (`!s. connected s <=> !x y. x IN s /\ y IN s ==> connected_component s x = connected_component s y`, SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);; let CONNECTED_COMPONENT_IDEMP = prove (`!s x:real^N. connected_component (connected_component s x) x = connected_component s x`, REWRITE_TAC[FUN_EQ_THM; connected_component] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL; SUBSET_TRANS; CONNECTED_COMPONENT_SUBSET]);; let CONNECTED_COMPONENT_UNIQUE = prove (`!s c x:real^N. x IN c /\ c SUBSET s /\ connected c /\ (!c'. x IN c' /\ c' SUBSET s /\ connected c' ==> c' SUBSET c) ==> connected_component s x = c`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);; let JOINABLE_CONNECTED_COMPONENT_EQ = prove (`!s t x y:real^N. connected t /\ t SUBSET s /\ ~(connected_component s x INTER t = {}) /\ ~(connected_component s y INTER t = {}) ==> connected_component s x = connected_component s y`, REPEAT GEN_TAC THEN REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC)) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `z:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^N` THEN CONJ_TAC THENL [REWRITE_TAC[connected_component] THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_SYM]]);; let CONNECTED_COMPONENT_TRANSLATION = prove (`!a s x. connected_component (IMAGE (\x. a + x) s) (a + x) = IMAGE (\x. a + x) (connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [CONNECTED_COMPONENT_TRANSLATION];; let CONNECTED_COMPONENT_LINEAR_IMAGE = prove (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> connected_component (IMAGE f s) (f x) = IMAGE f (connected_component s x)`, REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [CONNECTED_COMPONENT_LINEAR_IMAGE];; let UNIONS_CONNECTED_COMPONENT = prove (`!s:real^N->bool. UNIONS {connected_component s x |x| x IN s} = s`, GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; CONNECTED_COMPONENT_SUBSET] THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]);; let COMPLEMENT_CONNECTED_COMPONENT_UNIONS = prove (`!s x:real^N. s DIFF connected_component s x = UNIONS({connected_component s y | y | y IN s} DELETE (connected_component s x))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s DELETE a ==> DISJOINT a x) ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN SIMP_TAC[CONNECTED_COMPONENT_DISJOINT; CONNECTED_COMPONENT_EQ_EQ] THEN MESON_TAC[IN; SUBSET; CONNECTED_COMPONENT_SUBSET]);; let CLOSED_IN_CONNECTED_COMPONENT = prove (`!s x:real^N. closed_in (subtopology euclidean s) (connected_component s x)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN ASM_REWRITE_TAC[CLOSED_IN_EMPTY] THEN RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `closure(connected_component s x):real^N->bool` THEN REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_INTER] THEN MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN EXISTS_TAC `connected_component s (x:real^N)` THEN REWRITE_TAC[INTER_SUBSET; CONNECTED_CONNECTED_COMPONENT; SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET]]);; let OPEN_IN_CONNECTED_COMPONENT = prove (`!s x:real^N. FINITE {connected_component s x |x| x IN s} ==> open_in (subtopology euclidean s) (connected_component s x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `connected_component s (x:real^N) = s DIFF (UNIONS {connected_component s y |y| y IN s} DIFF connected_component s x)` SUBST1_TAC THENL [REWRITE_TAC[UNIONS_CONNECTED_COMPONENT] THEN MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s DIFF (s DIFF t)`) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN REWRITE_TAC[UNIONS_DIFF] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `connected_component s y DIFF connected_component s x = connected_component s y \/ connected_component s (y:real^N) DIFF connected_component s x = {}` (DISJ_CASES_THEN SUBST1_TAC) THENL [MATCH_MP_TAC(SET_RULE `(~(s INTER t = {}) ==> s = t) ==> s DIFF t = s \/ s DIFF t = {}`) THEN SIMP_TAC[CONNECTED_COMPONENT_OVERLAP]; REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT]; REWRITE_TAC[CLOSED_IN_EMPTY]]]);; let CONNECTED_COMPONENT_EQUIVALENCE_RELATION = prove (`!R s:real^N->bool. (!x y. R x y ==> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!a. a IN s ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ !x. x IN t ==> R a x) ==> !a b. connected_component s a b ==> R a b`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`R:real^N->real^N->bool`; `connected_component s (a:real^N)`] CONNECTED_EQUIVALENCE_RELATION) THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL [X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ANTS_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `t INTER connected_component s (a:real^N)` THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] CONNECTED_COMPONENT_SUBSET) THEN SET_TAC[]; DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_IN]]);; let CONNECTED_COMPONENT_INTERMEDIATE_SUBSET = prove (`!t u a:real^N. connected_component u a SUBSET t /\ t SUBSET u ==> connected_component t a = connected_component u a`, REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; SUBSET]]);; (* ------------------------------------------------------------------------- *) (* The set of connected components of a set. *) (* ------------------------------------------------------------------------- *) let components = new_definition `components s = {connected_component s x | x | x:real^N IN s}`;; let COMPONENTS_TRANSLATION = prove (`!a s. components(IMAGE (\x. a + x) s) = IMAGE (IMAGE (\x. a + x)) (components s)`, REWRITE_TAC[components] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);; add_translation_invariants [COMPONENTS_TRANSLATION];; let COMPONENTS_LINEAR_IMAGE = prove (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> components(IMAGE f s) = IMAGE (IMAGE f) (components s)`, REWRITE_TAC[components] THEN GEOM_TRANSFORM_TAC[] THEN SET_TAC[]);; add_linear_invariants [COMPONENTS_LINEAR_IMAGE];; let IN_COMPONENTS = prove (`!u:real^N->bool s. s IN components u <=> ?x. x IN u /\ s = connected_component u x`, REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN EQ_TAC THENL [SET_TAC[];STRIP_TAC THEN ASM_SIMP_TAC[] THEN UNDISCH_TAC `x:real^N IN u` THEN SET_TAC[]]);; let UNIONS_COMPONENTS = prove (`!u:real^N->bool. u = UNIONS (components u)`, REWRITE_TAC[EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC THENL[DISCH_TAC THEN REWRITE_TAC[IN_UNIONS] THEN EXISTS_TAC `connected_component (u:real^N->bool) x` THEN CONJ_TAC THENL [REWRITE_TAC[components] THEN SET_TAC[ASSUME `x:real^N IN u`]; REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SUBGOAL_THEN `?s:real^N->bool. connected s /\ s SUBSET u /\ x IN s` MP_TAC THENL[EXISTS_TAC `{x:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING] THEN POP_ASSUM MP_TAC THEN SET_TAC[]; SET_TAC[]]]; REWRITE_TAC[IN_UNIONS] THEN STRIP_TAC THEN MATCH_MP_TAC (SET_RULE `!x:real^N s u. x IN s /\ s SUBSET u ==> x IN u`) THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS;ASSUME `t:real^N->bool IN components u`] `?y. t:real^N->bool = connected_component u y`) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; let PAIRWISE_DISJOINT_COMPONENTS = prove (`!u:real^N->bool. pairwise DISJOINT (components u)`, GEN_TAC THEN REWRITE_TAC[pairwise;DISJOINT] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN ASSERT_TAC `(?a. s:real^N->bool = connected_component u a) /\ ?b. t:real^N->bool = connected_component u b` THENL [ASM_MESON_TAC[IN_COMPONENTS]; ASM_MESON_TAC[CONNECTED_COMPONENT_NONOVERLAP]]);; let IN_COMPONENTS_NONEMPTY = prove (`!s c. c IN components s ==> ~(c = {})`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; let IN_COMPONENTS_SUBSET = prove (`!s c. c IN components s ==> c SUBSET s`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; let IN_COMPONENTS_CONNECTED = prove (`!s c. c IN components s ==> connected c`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);; let IN_COMPONENTS_MAXIMAL = prove (`!s c:real^N->bool. c IN components s <=> ~(c = {}) /\ c SUBSET s /\ connected c /\ !c'. ~(c' = {}) /\ c SUBSET c' /\ c' SUBSET s /\ connected c' ==> c' = c`, REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN; SUBSET]; STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(GSYM CONNECTED_COMPONENT_UNIQUE) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]]);; let JOINABLE_COMPONENTS_EQ = prove (`!s t c1 c2. connected t /\ t SUBSET s /\ c1 IN components s /\ c2 IN components s /\ ~(c1 INTER t = {}) /\ ~(c2 INTER t = {}) ==> c1 = c2`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN MESON_TAC[JOINABLE_CONNECTED_COMPONENT_EQ]);; let CLOSED_IN_COMPONENT = prove (`!s c:real^N->bool. c IN components s ==> closed_in (subtopology euclidean s) c`, REWRITE_TAC[components; FORALL_IN_GSPEC; CLOSED_IN_CONNECTED_COMPONENT]);; let CLOSED_COMPONENTS = prove (`!s c. closed s /\ c IN components s ==> closed c`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN SIMP_TAC[CLOSED_CONNECTED_COMPONENT]);; let COMPACT_COMPONENTS = prove (`!s c:real^N->bool. compact s /\ c IN components s ==> compact c`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN MESON_TAC[CLOSED_COMPONENTS; IN_COMPONENTS_SUBSET; BOUNDED_SUBSET]);; let CONTINUOUS_ON_COMPONENTS_GEN = prove (`!f:real^M->real^N s. (!c. c IN components s ==> open_in (subtopology euclidean s) c /\ f continuous_on c) ==> f continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` SUBST1_TAC THENL [CONV_TAC(LAND_CONV(SUBS_CONV [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[OPEN_IN_TRANS]]);; let CONTINUOUS_ON_COMPONENTS_FINITE = prove (`!f:real^M->real^N s. FINITE(components s) /\ (!c. c IN components s ==> f continuous_on c) ==> f continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` SUBST1_TAC THENL [CONV_TAC(LAND_CONV(SUBS_CONV [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_COMPONENT]]);; let COMPONENTS_NONOVERLAP = prove (`!s c c'. c IN components s /\ c' IN components s ==> (c INTER c' = {} <=> ~(c = c'))`, REWRITE_TAC[components; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_NONOVERLAP]);; let COMPONENTS_EQ = prove (`!s c c'. c IN components s /\ c' IN components s ==> (c = c' <=> ~(c INTER c' = {}))`, MESON_TAC[COMPONENTS_NONOVERLAP]);; let COMPONENTS_EQ_EMPTY = prove (`!s. components s = {} <=> s = {}`, GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[components; connected_component; IN_ELIM_THM] THEN SET_TAC[]);; let COMPONENTS_EMPTY = prove (`components {} = {}`, REWRITE_TAC[COMPONENTS_EQ_EMPTY]);; let CONNECTED_EQ_CONNECTED_COMPONENTS_EQ = prove (`!s. connected s <=> !c c'. c IN components s /\ c' IN components s ==> c = c'`, REWRITE_TAC[components; IN_ELIM_THM] THEN MESON_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ]);; let COMPONENTS_EQ_SING,COMPONENTS_EQ_SING_EXISTS = (CONJ_PAIR o prove) (`(!s:real^N->bool. components s = {s} <=> connected s /\ ~(s = {})) /\ (!s:real^N->bool. (?a. components s = {a}) <=> connected s /\ ~(s = {}))`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> r) /\ (q <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN ASM_MESON_TAC[IN_SING; COMPONENTS_EQ_EMPTY; NOT_INSERT_EMPTY]; STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_SING] THEN REWRITE_TAC[components; IN_ELIM_THM] THEN ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; MEMBER_NOT_EMPTY]]);; let CONNECTED_EQ_COMPONENTS_SUBSET_SING = prove (`!s:real^N->bool. connected s <=> components s SUBSET {s}`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING]);; let CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS = prove (`!s:real^N->bool. connected s <=> ?a. components s SUBSET {a}`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING_EXISTS]);; let IN_COMPONENTS_SELF = prove (`!s:real^N->bool. s IN components s <=> connected s /\ ~(s = {})`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED]; SIMP_TAC[GSYM COMPONENTS_EQ_SING; IN_SING]]);; let COMPONENTS_MAXIMAL = prove (`!s t c:real^N->bool. c IN components s /\ connected t /\ t SUBSET s /\ ~(c INTER t = {}) ==> t SUBSET c`, REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]);; let COMPONENTS_UNIQUE = prove (`!s:real^N->bool k. UNIONS k = s /\ (!c. c IN k ==> connected c /\ ~(c = {}) /\ !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c) ==> components s = k`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `c:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS] THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `x:real^N` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [EXTENSION]) THEN REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `connected_component s (x:real^N) = c` (fun th -> ASM_REWRITE_TAC[th]) THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION; ASM SET_TAC[]] THEN ASM SET_TAC[]; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_SUBSET] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; let COMPONENTS_UNIQUE_EQ = prove (`!s:real^N->bool k. components s = k <=> UNIONS k = s /\ (!c. c IN k ==> connected c /\ ~(c = {}) /\ !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(SUBST1_TAC o SYM); REWRITE_TAC[COMPONENTS_UNIQUE]] THEN REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; RULE_ASSUM_TAC(REWRITE_RULE[IN_COMPONENTS_MAXIMAL]) THEN ASM_MESON_TAC[SUBSET_EMPTY]]);; let EXISTS_COMPONENT_SUPERSET = prove (`!s t:real^N->bool. t SUBSET s /\ ~(s = {}) /\ connected t ==> ?c. c IN components s /\ t SUBSET c`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM_REWRITE_TAC[EMPTY_SUBSET] THEN ASM_MESON_TAC[COMPONENTS_EQ_EMPTY; MEMBER_NOT_EMPTY]; FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^N` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN EXISTS_TAC `connected_component s (a:real^N)` THEN REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]]]);; let COMPONENTS_INTERMEDIATE_SUBSET = prove (`!s t u:real^N->bool. s IN components u /\ s SUBSET t /\ t SUBSET u ==> s IN components t`, REPEAT GEN_TAC THEN REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN MESON_TAC[CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; SUBSET; CONNECTED_COMPONENT_REFL; IN; CONNECTED_COMPONENT_SUBSET]);; let IN_COMPONENTS_UNIONS_COMPLEMENT = prove (`!s c:real^N->bool. c IN components s ==> s DIFF c = UNIONS(components s DELETE c)`, REWRITE_TAC[components; FORALL_IN_GSPEC; COMPLEMENT_CONNECTED_COMPONENT_UNIONS]);; let CONNECTED_SUBSET_CLOPEN = prove (`!u s c:real^N->bool. closed_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) s /\ connected c /\ c SUBSET u /\ ~(c INTER s = {}) ==> c SUBSET s`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`c INTER s:real^N->bool`; `c DIFF s:real^N->bool`]) THEN ASM_REWRITE_TAC[CONJ_ASSOC; SET_RULE `c DIFF s = {} <=> c SUBSET s`] THEN MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN REPLICATE_TAC 2 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN])] THEN DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN REWRITE_TAC[OPEN_IN_OPEN; CLOSED_IN_CLOSED] THENL [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `(:real^N) DIFF t`] THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; let CLOPEN_UNIONS_COMPONENTS = prove (`!u s:real^N->bool. closed_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) s ==> ?k. k SUBSET components u /\ s = UNIONS k`, REPEAT STRIP_TAC THEN EXISTS_TAC `{c:real^N->bool | c IN components u /\ ~(c INTER s = {})}` THEN REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_SUBSET_CLOPEN THEN EXISTS_TAC `u:real^N->bool` THEN ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]]);; let CLOPEN_IN_COMPONENTS = prove (`!u s:real^N->bool. closed_in (subtopology euclidean u) s /\ open_in (subtopology euclidean u) s /\ connected s /\ ~(s = {}) ==> s IN components u`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOPEN_UNIONS_COMPONENTS) THEN DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `k:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N->bool`) THEN ASM_CASES_TAC `k = {c:real^N->bool}` THENL [ASM_MESON_TAC[UNIONS_1; GSYM SING_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `~p ==> p /\ q ==> r`) THEN SUBGOAL_THEN `?c':real^N->bool. c' IN k /\ ~(c = c')` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[SET_RULE `a IN s /\ ~(s = {a}) ==> ?b. b IN s /\ ~(b = a)`]; REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `c':real^N->bool`]) THEN ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THEN MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Continuity implies uniform continuity on a compact domain. *) (* ------------------------------------------------------------------------- *) let COMPACT_UNIFORMLY_EQUICONTINUOUS = prove (`!(fs:(real^M->real^N)->bool) s. (!x e. x IN s /\ &0 < e ==> ?d. &0 < d /\ (!f x'. f IN fs /\ x' IN s /\ dist (x',x) < d ==> dist (f x',f x) < e)) /\ compact s ==> !e. &0 < e ==> ?d. &0 < d /\ !f x x'. f IN fs /\ x IN s /\ x' IN s /\ dist (x',x) < d ==> dist(f x',f x) < e`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real^M->real->real` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN DISCH_THEN(MP_TAC o SPEC `{ ball(x:real^M,d x (e / &2)) | x IN s}`) THEN SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; UNIONS_GSPEC; SUBSET; IN_ELIM_THM] THEN ANTS_TAC THENL [ASM_MESON_TAC[CENTRE_IN_BALL; REAL_HALF]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `u:real^M`; `v:real^M`] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `v:real^M` th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN ASM_REWRITE_TAC[DIST_REFL] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `w:real^M` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `e / &2`]) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o CONJUNCT2) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; let COMPACT_UNIFORMLY_CONTINUOUS = prove (`!f:real^M->real^N s. f continuous_on s /\ compact s ==> f uniformly_continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; uniformly_continuous_on] THEN STRIP_TAC THEN MP_TAC(ISPECL [`{f:real^M->real^N}`; `s:real^M->bool`] COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; IN_SING; FORALL_UNWIND_THM2] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* A uniformly convergent limit of continuous functions is continuous. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_UNIFORM_LIMIT = prove (`!net f:A->real^M->real^N g s. ~(trivial_limit net) /\ eventually (\n. (f n) continuous_on s) net /\ (!e. &0 < e ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) net) ==> g continuous_on s`, REWRITE_TAC[continuous_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:A` THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `x:real^M`) ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `w <= x + y + z ==> x < e / &3 ==> y < e / &3 ==> z < e / &3 ==> w < e`) THEN REWRITE_TAC[dist] THEN SUBST1_TAC(VECTOR_ARITH `(g:real^M->real^N) y - g x = --(f (a:A) y - g y) + (f a x - g x) + (f a y - f a x)`) THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_LADD] THEN MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Topological stuff lifted from and dropped to R *) (* ------------------------------------------------------------------------- *) let OPEN_LIFT = prove (`!s. open(IMAGE lift s) <=> !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`, REWRITE_TAC[open_def; FORALL_LIFT; LIFT_IN_IMAGE_LIFT; DIST_LIFT]);; let LIMPT_APPROACHABLE_LIFT = prove (`!x s. (lift x) limit_point_of (IMAGE lift s) <=> !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e`, REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT; LIFT_EQ; DIST_LIFT]);; let CLOSED_LIFT = prove (`!s. closed (IMAGE lift s) <=> !x. (!e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e) ==> x IN s`, GEN_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN ONCE_REWRITE_TAC[FORALL_LIFT] THEN REWRITE_TAC[LIMPT_APPROACHABLE_LIFT; LIFT_EQ; DIST_LIFT; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT]);; let CONTINUOUS_AT_LIFT_RANGE = prove (`!f x. (lift o f) continuous (at x) <=> !e. &0 < e ==> ?d. &0 < d /\ (!x'. norm(x' - x) < d ==> abs(f x' - f x) < e)`, REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; let CONTINUOUS_ON_LIFT_RANGE = prove (`!f s. (lift o f) continuous_on s <=> !x. x IN s ==> !e. &0 < e ==> ?d. &0 < d /\ (!x'. x' IN s /\ norm(x' - x) < d ==> abs(f x' - f x) < e)`, REWRITE_TAC[continuous_on; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; let CONTINUOUS_LIFT_NORM_COMPOSE = prove (`!net f:A->real^N. f continuous net ==> (\x. lift(norm(f x))) continuous net`, REPEAT GEN_TAC THEN REWRITE_TAC[continuous; tendsto] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN NORM_ARITH_TAC);; let CONTINUOUS_ON_LIFT_NORM_COMPOSE = prove (`!f:real^M->real^N s. f continuous_on s ==> (\x. lift(norm(f x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_NORM_COMPOSE]);; let CONTINUOUS_AT_LIFT_NORM = prove (`!x. (lift o norm) continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE; NORM_LIFT] THEN MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; let CONTINUOUS_ON_LIFT_NORM = prove (`!s. (lift o norm) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE; NORM_LIFT] THEN MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; let CONTINUOUS_AT_LIFT_COMPONENT = prove (`!i a. 1 <= i /\ i <= dimindex(:N) ==> (\x:real^N. lift(x$i)) continuous (at a)`, SIMP_TAC[continuous_at; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; let CONTINUOUS_ON_LIFT_COMPONENT = prove (`!i s. 1 <= i /\ i <= dimindex(:N) ==> (\x:real^N. lift(x$i)) continuous_on s`, SIMP_TAC[continuous_on; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; let CONTINUOUS_AT_LIFT_INFNORM = prove (`!x:real^N. (lift o infnorm) continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT; LIM_AT; o_THM; DIST_LIFT] THEN MESON_TAC[REAL_LET_TRANS; dist; REAL_ABS_SUB_INFNORM; INFNORM_LE_NORM]);; let CONTINUOUS_AT_LIFT_DIST = prove (`!a:real^N x. (lift o (\x. dist(a,x))) continuous (at x)`, REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE] THEN MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; REAL_LET_TRANS]);; let CONTINUOUS_ON_LIFT_DIST = prove (`!a s. (lift o (\x. dist(a,x))) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; REAL_LET_TRANS]);; (* ------------------------------------------------------------------------- *) (* Hence some handy theorems on distance, diameter etc. of/from a set. *) (* ------------------------------------------------------------------------- *) let COMPACT_ATTAINS_SUP = prove (`!s. compact (IMAGE lift s) /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> y <= x`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `sup s` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s <= s - e <=> ~(&0 < e)`; REAL_ARITH `x <= s /\ ~(x <= s - e) ==> abs(x - s) < e`]);; let COMPACT_ATTAINS_INF = prove (`!s. compact (IMAGE lift s) /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> x <= y`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `inf s` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s + e <= s <=> ~(&0 < e)`; REAL_ARITH `s <= x /\ ~(s + e <= x) ==> abs(x - s) < e`]);; let CONTINUOUS_ATTAINS_SUP = prove (`!f:real^N->real s. compact s /\ ~(s = {}) /\ (lift o f) continuous_on s ==> ?x. x IN s /\ !y. y IN s ==> f(y) <= f(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_SUP) THEN ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN MESON_TAC[IN_IMAGE]);; let CONTINUOUS_ATTAINS_INF = prove (`!f:real^N->real s. compact s /\ ~(s = {}) /\ (lift o f) continuous_on s ==> ?x. x IN s /\ !y. y IN s ==> f(x) <= f(y)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_INF) THEN ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN MESON_TAC[IN_IMAGE]);; let DISTANCE_ATTAINS_SUP = prove (`!s a. compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> dist(a,y) <= dist(a,x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN REWRITE_TAC[dist] THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]);; (* ------------------------------------------------------------------------- *) (* For *minimal* distance, we only need closure, not compactness. *) (* ------------------------------------------------------------------------- *) let DISTANCE_ATTAINS_INF = prove (`!s a:real^N. closed s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN MP_TAC(ISPECL [`\x:real^N. dist(a,x)`; `cball(a:real^N,dist(b,a)) INTER s`] CONTINUOUS_ATTAINS_INF) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; BOUNDED_INTER; BOUNDED_CBALL; CLOSED_CBALL; GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[dist; CONTINUOUS_ON_LIFT_RANGE; IN_INTER; IN_CBALL] THEN ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; REAL_LE_REFL; NORM_SUB; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]; MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_INTER; IN_CBALL] THEN ASM_MESON_TAC[DIST_SYM; REAL_LE_TOTAL; REAL_LE_TRANS]]);; (* ------------------------------------------------------------------------- *) (* We can now extend limit compositions to consider the scalar multiplier. *) (* ------------------------------------------------------------------------- *) let LIM_MUL = prove (`!net:(A)net f l:real^N c d. ((lift o c) --> lift d) net /\ (f --> l) net ==> ((\x. c(x) % f(x)) --> (d % l)) net`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `\x (y:real^N). drop x % y`; `lift o (c:A->real)`; `f:A->real^N`; `lift d`; `l:real^N`] LIM_BILINEAR) THEN ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let LIM_VMUL = prove (`!net:(A)net c d v:real^N. ((lift o c) --> lift d) net ==> ((\x. c(x) % v) --> d % v) net`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[LIM_CONST]);; let CONTINUOUS_VMUL = prove (`!net c v. (lift o c) continuous net ==> (\x. c(x) % v) continuous net`, REWRITE_TAC[continuous; LIM_VMUL; o_THM]);; let CONTINUOUS_MUL = prove (`!net f c. (lift o c) continuous net /\ f continuous net ==> (\x. c(x) % f(x)) continuous net`, REWRITE_TAC[continuous; LIM_MUL; o_THM]);; let CONTINUOUS_ON_VMUL = prove (`!s c v. (lift o c) continuous_on s ==> (\x. c(x) % v) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_VMUL]);; let CONTINUOUS_ON_MUL = prove (`!s c f. (lift o c) continuous_on s /\ f continuous_on s ==> (\x. c(x) % f(x)) continuous_on s`, REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN SIMP_TAC[CONTINUOUS_MUL]);; let CONTINUOUS_LIFT_POW = prove (`!net f:A->real n. (\x. lift(f x)) continuous net ==> (\x. lift(f x pow n)) continuous net`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_CONST] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[o_DEF]);; let CONTINUOUS_ON_LIFT_POW = prove (`!f:real^N->real s n. (\x. lift(f x)) continuous_on s ==> (\x. lift(f x pow n)) continuous_on s`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF]);; let CONTINUOUS_LIFT_PRODUCT = prove (`!net:(A)net f (t:B->bool). FINITE t /\ (!i. i IN t ==> (\x. lift(f x i)) continuous net) ==> (\x. lift(product t (f x))) continuous net`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN REWRITE_TAC[CONTINUOUS_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_SIMP_TAC[o_DEF]);; let CONTINUOUS_ON_LIFT_PRODUCT = prove (`!f:real^N->A->real s t. FINITE t /\ (!i. i IN t ==> (\x. lift(f x i)) continuous_on s) ==> (\x. lift(product t (f x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_PRODUCT]);; (* ------------------------------------------------------------------------- *) (* And so we have continuity of inverse. *) (* ------------------------------------------------------------------------- *) let LIM_INV = prove (`!net:(A)net f l. ((lift o f) --> lift l) net /\ ~(l = &0) ==> ((lift o inv o f) --> lift(inv l)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[o_THM; DIST_LIFT] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `min (abs(l) / &2) ((l pow 2 * e) / &2)`) THEN REWRITE_TAC[REAL_LT_MIN] THEN ANTS_TAC THENL [ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:A` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `b:A` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `abs(x - l) * &2 < abs l ==> ~(x = &0)`)) THEN ASM_SIMP_TAC[REAL_SUB_INV; REAL_ABS_DIV; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ; REAL_ENTIRE] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `abs(x - y) * &2 < b * c ==> c * b <= d * &2 ==> abs(y - x) < d`)) THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_POW_2; REAL_MUL_ASSOC; GSYM REAL_ABS_NZ; REAL_LE_RMUL_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `abs(x - y) * &2 < abs y ==> abs y <= &2 * abs x`]);; let CONTINUOUS_INV = prove (`!net f. (lift o f) continuous net /\ ~(f(netlimit net) = &0) ==> (lift o inv o f) continuous net`, REWRITE_TAC[continuous; LIM_INV; o_THM]);; let CONTINUOUS_AT_WITHIN_INV = prove (`!f s a:real^N. (lift o f) continuous (at a within s) /\ ~(f a = &0) ==> (lift o inv o f) continuous (at a within s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `trivial_limit (at (a:real^N) within s)` THENL [ASM_REWRITE_TAC[continuous; LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN; CONTINUOUS_INV]]);; let CONTINUOUS_AT_INV = prove (`!f a. (lift o f) continuous at a /\ ~(f a = &0) ==> (lift o inv o f) continuous at a`, ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[CONTINUOUS_AT_WITHIN_INV]);; let CONTINUOUS_ON_INV = prove (`!f s. (lift o f) continuous_on s /\ (!x. x IN s ==> ~(f x = &0)) ==> (lift o inv o f) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN_INV]);; (* ------------------------------------------------------------------------- *) (* More preservation properties for pasted sets (Cartesian products). *) (* ------------------------------------------------------------------------- *) let LIM_PASTECART = prove (`!net f:A->real^M g:A->real^N. (f --> a) net /\ (g --> b) net ==> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`, REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REWRITE_TAC[dist; PASTECART_SUB] THEN MATCH_MP_TAC(REAL_ARITH `z <= x + y ==> x < e / &2 /\ y < e / &2 ==> z < e`) THEN REWRITE_TAC[NORM_PASTECART_LE]);; let LIM_PASTECART_EQ = prove (`!net f:A->real^M g:A->real^N. ((\x. pastecart (f x) (g x)) --> pastecart a b) net <=> (f --> a) net /\ (g --> b) net`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LIM_PASTECART] THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN REWRITE_TAC[LINEAR_FSTCART; FSTCART_PASTECART; ETA_AX]; FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN REWRITE_TAC[LINEAR_SNDCART; SNDCART_PASTECART; ETA_AX]]);; let CONTINUOUS_PASTECART = prove (`!net f:A->real^M g:A->real^N. f continuous net /\ g continuous net ==> (\x. pastecart (f x) (g x)) continuous net`, REWRITE_TAC[continuous; LIM_PASTECART]);; let CONTINUOUS_ON_PASTECART = prove (`!f:real^M->real^N g:real^M->real^P s. f continuous_on s /\ g continuous_on s ==> (\x. pastecart (f x) (g x)) continuous_on s`, SIMP_TAC[CONTINUOUS_ON; LIM_PASTECART]);; let CONNECTED_PCROSS = prove (`!s:real^M->bool t:real^N->bool. connected s /\ connected t ==> connected (s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; CONNECTED_IFF_CONNECTED_COMPONENT] THEN DISCH_TAC THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`]) (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; connected_component] THEN X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN X_GEN_TAC `c1:real^M->bool` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (\x:real^M. pastecart x y1) c1 UNION IMAGE (\y:real^N. pastecart x2 y) c2` THEN REWRITE_TAC[IN_UNION] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; EXISTS_IN_IMAGE] THEN EXISTS_TAC `x2:real^M` THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_UNION; FORALL_AND_THM; FORALL_IN_IMAGE; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]);; let CONNECTED_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. connected (s PCROSS t) <=> s = {} \/ t = {} \/ connected s /\ connected t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN REWRITE_TAC[PCROSS_EMPTY; CONNECTED_EMPTY] THEN EQ_TAC THEN SIMP_TAC[CONNECTED_PCROSS] THEN REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `connected (IMAGE fstcart {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]; SUBGOAL_THEN `connected (IMAGE sndcart {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]] THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let CLOSURE_PCROSS = prove (`!s:real^M->bool t:real^N->bool. closure (s PCROSS t) = (closure s) PCROSS (closure t)`, REWRITE_TAC[EXTENSION; PCROSS; FORALL_PASTECART] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CLOSURE_APPROACHABLE; EXISTS_PASTECART; FORALL_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ] THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN REWRITE_TAC[dist; PASTECART_SUB] THEN EQ_TAC THENL [MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; DISCH_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; let LIMPT_PCROSS = prove (`!s:real^M->bool t:real^N->bool x y. x limit_point_of s /\ y limit_point_of t ==> (pastecart x y) limit_point_of (s PCROSS t)`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; LIMPT_APPROACHABLE; EXISTS_PASTECART] THEN REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ; dist; PASTECART_SUB] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; let CLOSED_IN_PCROSS = prove (`!s:real^M->bool s' t:real^N->bool t'. closed_in (subtopology euclidean s) s' /\ closed_in (subtopology euclidean t) t' ==> closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN ASM_SIMP_TAC[CLOSED_PCROSS; EXTENSION; FORALL_PASTECART] THEN REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; let CLOSED_IN_PCROSS_EQ = prove (`!s s':real^M->bool t t':real^N->bool. closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> s' = {} \/ t' = {} \/ closed_in (subtopology euclidean s) s' /\ closed_in (subtopology euclidean t) t'`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s':real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN ASM_CASES_TAC `t':real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[CLOSED_IN_PCROSS] THEN ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; CLOSURE_PCROSS; INTER_PCROSS; PCROSS_EQ; PCROSS_EQ_EMPTY]);; let FRONTIER_PCROSS = prove (`!s:real^M->bool t:real^N->bool. frontier(s PCROSS t) = frontier s PCROSS closure t UNION closure s PCROSS frontier t`, REPEAT GEN_TAC THEN REWRITE_TAC[frontier; CLOSURE_PCROSS; INTERIOR_PCROSS; PCROSS_DIFF] THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; IN_UNION; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence some useful properties follow quite easily. *) (* ------------------------------------------------------------------------- *) let CONNECTED_SCALING = prove (`!s:real^N->bool c. connected s ==> connected (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let CONNECTED_NEGATIONS = prove (`!s:real^N->bool. connected s ==> connected (IMAGE (--) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let CONNECTED_SUMS = prove (`!s t:real^N->bool. connected s /\ connected t ==> connected {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_PCROSS) THEN DISCH_THEN(MP_TAC o ISPEC `\z. (fstcart z + sndcart z:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; PCROSS] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]);; let COMPACT_SCALING = prove (`!s:real^N->bool c. compact s ==> compact (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let COMPACT_NEGATIONS = prove (`!s:real^N->bool. compact s ==> compact (IMAGE (--) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let COMPACT_SUMS = prove (`!s:real^N->bool t. compact s /\ compact t ==> compact {x + y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x + y | x IN s /\ y IN t} = IMAGE (\z. fstcart z + sndcart z :real^N) (s PCROSS t)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; PCROSS] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_FST_SND]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_PCROSS] THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; SNDCART_CMUL] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; let COMPACT_DIFFERENCES = prove (`!s:real^N->bool t. compact s /\ compact t ==> compact {x - y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = {x + y | x IN s /\ y IN (IMAGE (--) t)}` (fun th -> ASM_SIMP_TAC[th; COMPACT_SUMS; COMPACT_NEGATIONS]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN MESON_TAC[VECTOR_NEG_NEG]);; let COMPACT_AFFINITY = prove (`!s a:real^N c. compact s ==> compact (IMAGE (\x. a + c % x) s)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN ASM_SIMP_TAC[IMAGE_o; COMPACT_TRANSLATION; COMPACT_SCALING]);; (* ------------------------------------------------------------------------- *) (* Hence we get the following. *) (* ------------------------------------------------------------------------- *) let COMPACT_SUP_MAXDISTANCE = prove (`!s:real^N->bool. compact s /\ ~(s = {}) ==> ?x y. x IN s /\ y IN s /\ !u v. u IN s /\ v IN s ==> norm(u - v) <= norm(x - y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN s}`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN ANTS_TAC THENL [ASM_SIMP_TAC[COMPACT_DIFFERENCES] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]; REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; NORM_NEG] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* We can state this in terms of diameter of a set. *) (* ------------------------------------------------------------------------- *) let diameter = new_definition `diameter s = if s = {} then &0 else sup {norm(x - y) | x IN s /\ y IN s}`;; let DIAMETER_BOUNDED = prove (`!s. bounded s ==> (!x:real^N y. x IN s /\ y IN s ==> norm(x - y) <= diameter s) /\ (!d. &0 <= d /\ d < diameter s ==> ?x y. x IN s /\ y IN s /\ norm(x - y) > d)`, GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[diameter; NOT_IN_EMPTY; REAL_LET_ANTISYM] THEN MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN ABBREV_TAC `b = sup {norm(x - y:real^N) | x IN s /\ y IN s}` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[NOT_IN_EMPTY; real_gt] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC]; MESON_TAC[REAL_NOT_LE]] THEN SIMP_TAC[VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN MESON_TAC[REAL_ARITH `x <= y + z /\ y <= b /\ z<= b ==> x <= b + b`; NORM_TRIANGLE; NORM_NEG]);; let DIAMETER_BOUNDED_BOUND = prove (`!s x y. bounded s /\ x IN s /\ y IN s ==> norm(x - y) <= diameter s`, MESON_TAC[DIAMETER_BOUNDED]);; let DIAMETER_COMPACT_ATTAINED = prove (`!s:real^N->bool. compact s /\ ~(s = {}) ==> ?x y. x IN s /\ y IN s /\ (norm(x - y) = diameter s)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_SUP_MAXDISTANCE) THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(SPEC `s:real^N->bool` DIAMETER_BOUNDED) THEN RULE_ASSUM_TAC(REWRITE_RULE[COMPACT_EQ_BOUNDED_CLOSED]) THEN ASM_REWRITE_TAC[real_gt] THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_MESON_TAC[NORM_POS_LE; REAL_NOT_LT]);; let DIAMETER_TRANSLATION = prove (`!a s. diameter (IMAGE (\x. a + x) s) = diameter s`, REWRITE_TAC[diameter] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [DIAMETER_TRANSLATION];; let DIAMETER_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x. norm(f x) = norm x) ==> diameter(IMAGE f s) = diameter s`, REWRITE_TAC[diameter] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[diameter; IMAGE_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN ASM_MESON_TAC[LINEAR_SUB]);; add_linear_invariants [DIAMETER_LINEAR_IMAGE];; let DIAMETER_EMPTY = prove (`diameter {} = &0`, REWRITE_TAC[diameter]);; let DIAMETER_SING = prove (`!a. diameter {a} = &0`, REWRITE_TAC[diameter; NOT_INSERT_EMPTY; IN_SING] THEN REWRITE_TAC[SET_RULE `{f x y | x = a /\ y = a} = {f a a }`] THEN REWRITE_TAC[SUP_SING; VECTOR_SUB_REFL; NORM_0]);; let DIAMETER_POS_LE = prove (`!s:real^N->bool. bounded s ==> &0 <= diameter s`, REPEAT STRIP_TAC THEN REWRITE_TAC[diameter] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN EXISTS_TAC `&2 * B` THEN ASM_SIMP_TAC[NORM_ARITH `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a:real^N`] o CONJUNCT1) THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0]]);; let DIAMETER_SUBSET = prove (`!s t:real^N->bool. s SUBSET t /\ bounded t ==> diameter s <= diameter t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[DIAMETER_EMPTY; DIAMETER_POS_LE] THEN ASM_REWRITE_TAC[diameter] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN EXISTS_TAC `&2 * B` THEN ASM_SIMP_TAC[NORM_ARITH `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]);; let DIAMETER_CLOSURE = prove (`!s:real^N->bool. bounded s ==> diameter(closure s) = diameter s`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_CLOSURE; CLOSURE_SUBSET] THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_BOUNDED) THEN ABBREV_TAC `d = diameter(closure s) - diameter(s:real^N->bool)` THEN ASM_SIMP_TAC[BOUNDED_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `diameter(closure(s:real^N->bool)) - d / &2` o CONJUNCT2) THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; NOT_EXISTS_THM] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIAMETER_POS_LE) THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[CLOSURE_APPROACHABLE; CONJ_ASSOC; AND_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `d / &4`) ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < d / &4 <=> &0 < d`] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) (X_CHOOSE_THEN `v:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIAMETER_BOUNDED) THEN DISCH_THEN(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let DIAMETER_SUBSET_CBALL_NONEMPTY = prove (`!s:real^N->bool. bounded s /\ ~(s = {}) ==> ?z. z IN s /\ s SUBSET cball(z,diameter s)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN ASM_MESON_TAC[DIAMETER_BOUNDED]);; let DIAMETER_SUBSET_CBALL = prove (`!s:real^N->bool. bounded s ==> ?z. s SUBSET cball(z,diameter s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_MESON_TAC[DIAMETER_SUBSET_CBALL_NONEMPTY; EMPTY_SUBSET]);; let DIAMETER_EQ_0 = prove (`!s:real^N->bool. bounded s ==> (diameter s = &0 <=> s = {} \/ ?a. s = {a})`, REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY; DIAMETER_SING] THEN REWRITE_TAC[SET_RULE `s = {} \/ (?a. s = {a}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`] DIAMETER_BOUNDED_BOUND) THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let DIAMETER_LE = prove (`!s:real^N->bool. (~(s = {}) \/ &0 <= d) /\ (!x y. x IN s /\ y IN s ==> norm(x - y) <= d) ==> diameter s <= d`, GEN_TAC THEN REWRITE_TAC[diameter] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FORALL_IN_GSPEC]]);; let DIAMETER_CBALL = prove (`!a:real^N r. diameter(cball(a,r)) = if r < &0 then &0 else &2 * r`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ASM_MESON_TAC[CBALL_EQ_EMPTY; DIAMETER_EMPTY]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LE_MUL; REAL_POS; REAL_NOT_LT] THEN REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm((a + r % basis 1) - (a - r % basis 1):real^N)` THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `(a + r % b) - (a - r % b:real^N) = (&2 * r) % b`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN REWRITE_TAC[BOUNDED_CBALL; IN_CBALL] THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b /\ dist(a,a - b) = norm b`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC]]);; let DIAMETER_BALL = prove (`!a:real^N r. diameter(ball(a,r)) = if r < &0 then &0 else &2 * r`, REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; DIAMETER_EMPTY]; ALL_TAC] THEN ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; DIAMETER_EMPTY; REAL_MUL_RZERO] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `diameter(cball(a:real^N,r))` THEN CONJ_TAC THENL [SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[GSYM CLOSURE_BALL; DIAMETER_CLOSURE; BOUNDED_BALL]; ASM_SIMP_TAC[DIAMETER_CBALL]]);; let DIAMETER_SUMS = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> diameter {x + y | x IN s /\ y IN t} <= diameter s + diameter t`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; DIAMETER_EMPTY; REAL_ADD_LID; DIAMETER_POS_LE] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; DIAMETER_EMPTY; REAL_ADD_RID; DIAMETER_POS_LE] THEN MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(x - x') <= s /\ norm(y - y') <= t ==> norm((x + y) - (x' + y'):real^N) <= s + t`) THEN ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND]);; let LEBESGUE_COVERING_LEMMA = prove (`!s:real^N->bool c. compact s /\ ~(c = {}) /\ s SUBSET UNIONS c /\ (!b. b IN c ==> open b) ==> ?d. &0 < d /\ !t. t SUBSET s /\ diameter t <= d ==> ?b. b IN c /\ t SUBSET b`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN DISCH_THEN(MP_TAC o SPEC `c:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `t:real^N->bool` DIAMETER_SUBSET_CBALL_NONEMPTY) THEN ANTS_TAC THENL [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(x:real^N,diameter(t:real^N->bool))` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN MAP_EVERY UNDISCH_TAC [`&0 < e`; `diameter(t:real^N->bool) <= e / &2`] THEN NORM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Related results with closure as the conclusion. *) (* ------------------------------------------------------------------------- *) let CLOSED_SCALING = prove (`!s:real^N->bool c. closed s ==> closed (IMAGE (\x. c % x) s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s :real^N->bool = {}` THEN ASM_REWRITE_TAC[CLOSED_EMPTY; IMAGE_CLAUSES] THEN ASM_CASES_TAC `c = &0` THENL [SUBGOAL_THEN `IMAGE (\x:real^N. c % x) s = {(vec 0)}` (fun th -> REWRITE_TAC[th; CLOSED_SING]) THEN ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING; VECTOR_MUL_LZERO] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_IMAGE; SKOLEM_THM] THEN STRIP_TAC THEN X_GEN_TAC `x:num->real^N` THEN X_GEN_TAC `l:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` MP_TAC) THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN EXISTS_TAC `inv(c) % l :real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n:num. inv(c) % x n:real^N` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; MATCH_MP_TAC LIM_CMUL THEN FIRST_ASSUM(fun th -> REWRITE_TAC[SYM(SPEC_ALL th)]) THEN ASM_REWRITE_TAC[ETA_AX]]);; let CLOSED_NEGATIONS = prove (`!s:real^N->bool. closed s ==> closed (IMAGE (--) s)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x:real^N. --(&1) % x) s` SUBST1_TAC THEN SIMP_TAC[CLOSED_SCALING] THEN REWRITE_TAC[VECTOR_ARITH `--(&1) % x = --x`] THEN REWRITE_TAC[ETA_AX]);; let COMPACT_CLOSED_SUMS = prove (`!s:real^N->bool t. compact s /\ closed t ==> closed {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[compact; IN_ELIM_THM; CLOSED_SEQUENTIAL_LIMITS] THEN STRIP_TAC THEN X_GEN_TAC `f:num->real^N` THEN X_GEN_TAC `l:real^N` THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl) o SPEC `a:num->real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `la:real^N` (X_CHOOSE_THEN `sub:num->num` STRIP_ASSUME_TAC)) THEN MAP_EVERY EXISTS_TAC [`la:real^N`; `l - la:real^N`] THEN ASM_REWRITE_TAC[VECTOR_ARITH `a + (b - a) = b:real^N`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n. (f o (sub:num->num)) n - (a o sub) n:real^N` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[VECTOR_ADD_SUB; o_THM]; ALL_TAC] THEN MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; ETA_AX]);; let CLOSED_COMPACT_SUMS = prove (`!s:real^N->bool t. closed s /\ compact t ==> closed {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN SUBGOAL_THEN `{x + y:real^N | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}` SUBST1_TAC THEN SIMP_TAC[COMPACT_CLOSED_SUMS] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);; let CLOSURE_SUMS = prove (`!s t:real^N->bool. bounded s \/ bounded t ==> closure {x + y | x IN s /\ y IN t} = {x + y | x IN closure s /\ y IN closure t}`, REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN REWRITE_TAC[FORALL_AND_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; CLOSURE_SEQUENTIAL] THEN X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL [REWRITE_TAC[IN_ELIM_THM; IN_DELETE; SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[FORALL_AND_THM] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN ONCE_REWRITE_TAC[MESON[] `(?f x y. P f x y) <=> (?x y f. P f x y)`] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[ETA_AX; UNWIND_THM2] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` compact) THEN ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^N`; `r:num->num`] THEN STRIP_TAC THEN EXISTS_TAC `z - u:real^N` THEN EXISTS_TAC `(a:num->real^N) o (r:num->num)` THEN EXISTS_TAC `u:real^N` THEN ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN EXISTS_TAC `(\n. ((\n. a n + b n) o (r:num->num)) n - (a o r) n) :num->real^N` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(a + b) - a:real^N = b`]; MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]]; REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `a:num->real^N`; `b:num->real^N`] THEN STRIP_TAC THEN EXISTS_TAC `(\n. a n + b n):num->real^N` THEN ASM_SIMP_TAC[LIM_ADD] THEN ASM_MESON_TAC[]]);; let COMPACT_CLOSED_DIFFERENCES = prove (`!s:real^N->bool t. compact s /\ closed t ==> closed {x - y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = {x + y | x IN s /\ y IN (IMAGE (--) t)}` (fun th -> ASM_SIMP_TAC[th; COMPACT_CLOSED_SUMS; CLOSED_NEGATIONS]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN MESON_TAC[VECTOR_NEG_NEG]);; let CLOSED_COMPACT_DIFFERENCES = prove (`!s:real^N->bool t. closed s /\ compact t ==> closed {x - y | x IN s /\ y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = {x + y | x IN s /\ y IN (IMAGE (--) t)}` (fun th -> ASM_SIMP_TAC[th; CLOSED_COMPACT_SUMS; COMPACT_NEGATIONS]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN MESON_TAC[VECTOR_NEG_NEG]);; let CLOSED_TRANSLATION_EQ = prove (`!a s. closed (IMAGE (\x:real^N. a + x) s) <=> closed s`, REWRITE_TAC[closed] THEN GEOM_TRANSLATE_TAC[]);; let CLOSED_TRANSLATION = prove (`!s a:real^N. closed s ==> closed (IMAGE (\x. a + x) s)`, REWRITE_TAC[CLOSED_TRANSLATION_EQ]);; add_translation_invariants [CLOSED_TRANSLATION_EQ];; let COMPLETE_TRANSLATION_EQ = prove (`!a s. complete(IMAGE (\x:real^N. a + x) s) <=> complete s`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_TRANSLATION_EQ]);; add_translation_invariants [COMPLETE_TRANSLATION_EQ];; let TRANSLATION_UNIV = prove (`!a. IMAGE (\x. a + x) (:real^N) = (:real^N)`, CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEOM_TRANSLATE_TAC[]);; let TRANSLATION_DIFF = prove (`!s t:real^N->bool. IMAGE (\x. a + x) (s DIFF t) = (IMAGE (\x. a + x) s) DIFF (IMAGE (\x. a + x) t)`, REWRITE_TAC[EXTENSION; IN_DIFF; IN_IMAGE] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = a + y <=> y = x - a`] THEN REWRITE_TAC[UNWIND_THM2]);; let CLOSURE_TRANSLATION = prove (`!a s. closure(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (closure s)`, REWRITE_TAC[CLOSURE_INTERIOR] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [CLOSURE_TRANSLATION];; let FRONTIER_TRANSLATION = prove (`!a s. frontier(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (frontier s)`, REWRITE_TAC[frontier] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [FRONTIER_TRANSLATION];; (* ------------------------------------------------------------------------- *) (* Separation between points and sets. *) (* ------------------------------------------------------------------------- *) let SEPARATE_POINT_CLOSED = prove (`!s a:real^N. closed s /\ ~(a IN s) ==> ?d. &0 < d /\ !x. x IN s ==> d <= dist(a,x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN EXISTS_TAC `dist(a:real^N,b)` THEN ASM_MESON_TAC[DIST_POS_LT]);; let SEPARATE_COMPACT_CLOSED = prove (`!s t:real^N->bool. compact s /\ closed t /\ s INTER t = {} ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] SEPARATE_POINT_CLOSED) THEN ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `vec 0 = x - y <=> x = y`] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN MESON_TAC[NORM_ARITH `dist(vec 0,x - y) = dist(x,y)`]);; let SEPARATE_CLOSED_COMPACT = prove (`!s t:real^N->bool. closed s /\ compact t /\ s INTER t = {} ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, ONCE_REWRITE_TAC[DIST_SYM; INTER_COMM] THEN MESON_TAC[SEPARATE_COMPACT_CLOSED]);; (* ------------------------------------------------------------------------- *) (* Representing sets as the union of a chain of compact sets. *) (* ------------------------------------------------------------------------- *) let CLOSED_UNION_COMPACT_SUBSETS = prove (`!s. closed s ==> ?f:num->real^N->bool. (!n. compact(f n)) /\ (!n. (f n) SUBSET s) /\ (!n. (f n) SUBSET f(n + 1)) /\ UNIONS {f n | n IN (:num)} = s /\ (!k. compact k /\ k SUBSET s ==> ?N. !n. n >= N ==> k SUBSET (f n))`, REPEAT STRIP_TAC THEN EXISTS_TAC `\n. s INTER cball(vec 0:real^N,&n)` THEN ASM_SIMP_TAC[INTER_SUBSET; COMPACT_CBALL; CLOSED_INTER_COMPACT] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_CBALL_0] THEN MESON_TAC[REAL_ARCH_SIMPLE]; X_GEN_TAC `k:real^N->bool` THEN SIMP_TAC[SUBSET_INTER] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]);; let OPEN_UNION_COMPACT_SUBSETS = prove (`!s. open s ==> ?f:num->real^N->bool. (!n. compact(f n)) /\ (!n. (f n) SUBSET s) /\ (!n. (f n) SUBSET interior(f(n + 1))) /\ UNIONS {f n | n IN (:num)} = s /\ (!k. compact k /\ k SUBSET s ==> ?N. !n. n >= N ==> k SUBSET (f n))`, GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [DISCH_TAC THEN EXISTS_TAC `(\n. {}):num->real^N->bool` THEN ASM_SIMP_TAC[EMPTY_SUBSET; SUBSET_EMPTY; COMPACT_EMPTY] THEN REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; NOT_IN_EMPTY]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN STRIP_TAC] THEN MATCH_MP_TAC(MESON[] `(!f. p1 f /\ p3 f /\ p4 f ==> p5 f) /\ (?f. p1 f /\ p2 f /\ p3 f /\ (p2 f ==> p4 f)) ==> ?f. p1 f /\ p2 f /\ p3 f /\ p4 f /\ p5 f`) THEN CONJ_TAC THENL [X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `{interior(f n):real^N->bool | n IN (:num)}`) THEN REWRITE_TAC[FORALL_IN_GSPEC; OPEN_INTERIOR] THEN ANTS_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM SET_TAC[]; ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN REWRITE_TAC[SUBSET_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `i:num->bool` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `(f:num->real^N->bool) m` THEN REWRITE_TAC[INTERIOR_SUBSET] THEN SUBGOAL_THEN `!m n. m <= n ==> (f:num->real^N->bool) m SUBSET f n` (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_MESON_TAC[SUBSET; ADD1; INTERIOR_SUBSET]]; EXISTS_TAC `\n. cball(a,&n) DIFF {x + e | x IN (:real^N) DIFF s /\ e IN ball(vec 0,inv(&n + &1))}` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN MATCH_MP_TAC COMPACT_DIFF THEN SIMP_TAC[COMPACT_CBALL; OPEN_SUMS; OPEN_BALL]; GEN_TAC THEN MATCH_MP_TAC(SET_RULE `(UNIV DIFF s) SUBSET t ==> c DIFF t SUBSET s`) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN ASM_REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; GEN_TAC THEN REWRITE_TAC[INTERIOR_DIFF] THEN MATCH_MP_TAC(SET_RULE `s SUBSET s' /\ t' SUBSET t ==> (s DIFF t) SUBSET (s' DIFF t')`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERIOR_CBALL; SUBSET; IN_BALL; IN_CBALL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `{x + e | x IN (:real^N) DIFF s /\ e IN cball(vec 0,inv(&n + &2))}` THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL; GSYM OPEN_CLOSED] THEN MATCH_MP_TAC(SET_RULE `t SUBSET t' ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s /\ y IN t'}`) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; MATCH_MP_TAC(SET_RULE `t SUBSET t' ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s /\ y IN t'}`) THEN REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `a < b ==> x <= a ==> x < b`) THEN MATCH_MP_TAC REAL_LT_INV2 THEN REAL_ARITH_TAC]]; DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_BALL_0] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = y + e <=> e = x - y`] THEN REWRITE_TAC[TAUT `(p /\ q) /\ r <=> r /\ p /\ q`; UNWIND_THM2] THEN REWRITE_TAC[MESON[] `~(?x. ~P x /\ Q x) <=> !x. Q x ==> P x`] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN MP_TAC(ISPEC `norm(x - a:real^N)` REAL_ARCH_SIMPLE) THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN CONJ_TAC THENL [REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN UNDISCH_TAC `norm(x - a:real^N) <= &N2` THEN REWRITE_TAC[dist; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `inv(&(N1 + N2) + &1) <= inv(&N1)` MP_TAC THENL [MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]]]);; (* ------------------------------------------------------------------------- *) (* Closed-graph characterization of continuity. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_CLOSED_GRAPH_GEN = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s SUBSET t ==> closed_in (subtopology euclidean (s PCROSS t)) {pastecart x (f x) | x IN s}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{pastecart (x:real^M) (f x:real^N) | x IN s} = {z | z IN s PCROSS t /\ f(fstcart z) - sndcart z IN {vec 0}}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; IN_SING; PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ; VECTOR_SUB_EQ] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN SIMP_TAC[GSYM o_DEF; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]]);; let CONTINUOUS_CLOSED_GRAPH_EQ = prove (`!f:real^M->real^N s t. compact t /\ IMAGE f s SUBSET t ==> (f continuous_on s <=> closed_in (subtopology euclidean (s PCROSS t)) {pastecart x (f x) | x IN s})`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_GRAPH_GEN] THEN DISCH_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_CLOSED_GEN th]) THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN c} = IMAGE fstcart ({pastecart x (f x) | x IN s} INTER (s PCROSS c))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART; FSTCART_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM; PASTECART_IN_PCROSS; PASTECART_INJ] THEN ASM SET_TAC[]; MATCH_MP_TAC CLOSED_MAP_FSTCART THEN EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN ASM_REWRITE_TAC[CLOSED_IN_REFL]]);; let CONTINUOUS_CLOSED_GRAPH = prove (`!f:real^M->real^N s. closed s /\ f continuous_on s ==> closed {pastecart x (f x) | x IN s}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `(s:real^M->bool) PCROSS (:real^N)` THEN ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_UNIV] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_GRAPH_GEN THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; let CONTINUOUS_FROM_CLOSED_GRAPH = prove (`!f:real^M->real^N s t. compact t /\ IMAGE f s SUBSET t /\ closed {pastecart x (f x) | x IN s} ==> f continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONTINUOUS_CLOSED_GRAPH_EQ) THEN MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* A cute way of denoting open and closed intervals using overloading. *) (* ------------------------------------------------------------------------- *) let open_interval = new_definition `open_interval(a:real^N,b:real^N) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i /\ x$i < b$i}`;; let closed_interval = new_definition `closed_interval(l:(real^N#real^N)list) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> FST(HD l)$i <= x$i /\ x$i <= SND(HD l)$i}`;; make_overloadable "interval" `:A`;; overload_interface("interval",`open_interval`);; overload_interface("interval",`closed_interval`);; let interval = prove (`(interval (a,b) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i /\ x$i < b$i}) /\ (interval [a,b] = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i /\ x$i <= b$i})`, REWRITE_TAC[open_interval; closed_interval; HD; FST; SND]);; let IN_INTERVAL = prove (`(!x:real^N. x IN interval (a,b) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i /\ x$i < b$i) /\ (!x:real^N. x IN interval [a,b] <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i /\ x$i <= b$i)`, REWRITE_TAC[interval; IN_ELIM_THM]);; let IN_INTERVAL_REFLECT = prove (`(!a b x. (--x) IN interval[--b,--a] <=> x IN interval[a,b]) /\ (!a b x. (--x) IN interval(--b,--a) <=> x IN interval(a,b))`, SIMP_TAC[IN_INTERVAL; REAL_LT_NEG2; REAL_LE_NEG2; VECTOR_NEG_COMPONENT] THEN MESON_TAC[]);; let REFLECT_INTERVAL = prove (`(!a b:real^N. IMAGE (--) (interval[a,b]) = interval[--b,--a]) /\ (!a b:real^N. IMAGE (--) (interval(a,b)) = interval(--b,--a))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_INTERVAL_REFLECT] THEN MESON_TAC[VECTOR_NEG_NEG]);; let INTERVAL_EQ_EMPTY = prove (`((interval [a:real^N,b] = {}) <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i < a$i) /\ ((interval (a:real^N,b) = {}) <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i <= a$i)`, REWRITE_TAC[EXTENSION; IN_INTERVAL; NOT_IN_EMPTY] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LE_REFL; REAL_NOT_LE]; MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE]; ALL_TAC; MESON_TAC[REAL_LT_TRANS; REAL_NOT_LT]] THEN SUBGOAL_THEN `!a b. ?c. a < b ==> a < c /\ c < b` (MP_TAC o REWRITE_RULE[SKOLEM_THM]) THENL [MESON_TAC[REAL_LT_BETWEEN]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `mid:real->real->real`) THEN DISCH_THEN(MP_TAC o SPEC `(lambda i. mid ((a:real^N)$i) ((b:real^N)$i)):real^N`) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_NOT_LT]);; let INTERVAL_NE_EMPTY = prove (`(~(interval [a:real^N,b] = {}) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) /\ (~(interval (a:real^N,b) = {}) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i)`, REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN MESON_TAC[REAL_NOT_LE]);; let SUBSET_INTERVAL_IMP = prove (`((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) ==> interval[c,d] SUBSET interval[a:real^N,b]) /\ ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i) ==> interval[c,d] SUBSET interval(a:real^N,b)) /\ ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) ==> interval(c,d) SUBSET interval[a:real^N,b]) /\ ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) ==> interval(c,d) SUBSET interval(a:real^N,b))`, REWRITE_TAC[SUBSET; IN_INTERVAL] THEN REPEAT CONJ_TAC THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let INTERVAL_SING = prove (`interval[a,a] = {a} /\ interval(a,a) = {}`, REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_INTERVAL] THEN REWRITE_TAC[REAL_LE_ANTISYM; REAL_LT_ANTISYM; CART_EQ; EQ_SYM_EQ] THEN MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; let SUBSET_INTERVAL = prove (`(interval[c,d] SUBSET interval[a:real^N,b] <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ (interval[c,d] SUBSET interval(a:real^N,b) <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i)) /\ (interval(c,d) SUBSET interval[a:real^N,b] <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ (interval(c,d) SUBSET interval(a:real^N,b) <=> (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i))`, let lemma = prove (`(!x:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> Q i (x$i)) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> R i (x$i))) ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> ?y. Q i y) ==> !i y. 1 <= i /\ i <= dimindex(:N) /\ Q i y ==> R i y`, DISCH_TAC THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real` STRIP_ASSUME_TAC) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(lambda j. if j = i then y else f j):real^N`) THEN SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[]) in REPEAT STRIP_TAC THEN (MATCH_MP_TAC(TAUT `(~q ==> p) /\ (q ==> (p <=> r)) ==> (p <=> q ==> r)`) THEN CONJ_TAC THENL [DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `s = {} ==> s SUBSET t`) THEN REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_NOT_LT]; ALL_TAC] THEN DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_IMP] THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_BETWEEN; REAL_LE_BETWEEN]; ALL_TAC] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC) THENL [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; ALL_TAC; ALL_TAC] THEN (REPEAT STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `((c:real^N)$i + min ((a:real^N)$i) ((d:real^N)$i)) / &2`) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `(max ((b:real^N)$i) ((c:real^N)$i) + (d:real^N)$i) / &2`) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]));; let DISJOINT_INTERVAL = prove (`!a b c d:real^N. (interval[a,b] INTER interval[c,d] = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i < a$i \/ d$i < c$i \/ b$i < c$i \/ d$i < a$i)) /\ (interval[a,b] INTER interval(c,d) = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i < a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ (interval(a,b) INTER interval[c,d] = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i <= a$i \/ d$i < c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ (interval(a,b) INTER interval(c,d) = {} <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ (b$i <= a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i))`, REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; NOT_IN_EMPTY] THEN REWRITE_TAC[AND_FORALL_THM; NOT_FORALL_THM] THEN REWRITE_TAC[TAUT `~((p ==> q) /\ (p ==> r)) <=> p /\ (~q \/ ~r)`] THEN REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN (EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `(lambda i. (max ((a:real^N)$i) ((c:real^N)$i) + min ((b:real^N)$i) ((d:real^N)$i)) / &2):real^N`) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; DISCH_THEN(fun th -> GEN_TAC THEN MP_TAC th) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN REAL_ARITH_TAC]));; let ENDS_IN_INTERVAL = prove (`(!a b. a IN interval[a,b] <=> ~(interval[a,b] = {})) /\ (!a b. b IN interval[a,b] <=> ~(interval[a,b] = {})) /\ (!a b. ~(a IN interval(a,b))) /\ (!a b. ~(b IN interval(a,b)))`, REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY] THEN REWRITE_TAC[REAL_LE_REFL; REAL_LT_REFL] THEN MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; let ENDS_IN_UNIT_INTERVAL = prove (`vec 0 IN interval[vec 0,vec 1] /\ vec 1 IN interval[vec 0,vec 1] /\ ~(vec 0 IN interval(vec 0,vec 1)) /\ ~(vec 1 IN interval(vec 0,vec 1))`, REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY; VEC_COMPONENT] THEN REWRITE_TAC[REAL_POS]);; let INTER_INTERVAL = prove (`interval[a,b] INTER interval[c,d] = interval[(lambda i. max (a$i) (c$i)),(lambda i. min (b$i) (d$i))]`, REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL] THEN SIMP_TAC[LAMBDA_BETA; REAL_MAX_LE; REAL_LE_MIN] THEN MESON_TAC[]);; let INTERVAL_OPEN_SUBSET_CLOSED = prove (`!a b. interval(a,b) SUBSET interval[a,b]`, REWRITE_TAC[SUBSET; IN_INTERVAL] THEN MESON_TAC[REAL_LT_IMP_LE]);; let OPEN_INTERVAL_LEMMA = prove (`!a b x. a < x /\ x < b ==> ?d. &0 < d /\ !x'. abs(x' - x) < d ==> a < x' /\ x' < b`, REPEAT STRIP_TAC THEN EXISTS_TAC `min (x - a) (b - x)` THEN REWRITE_TAC[REAL_LT_MIN] THEN ASM_REAL_ARITH_TAC);; let OPEN_INTERVAL = prove (`!a:real^N b. open(interval (a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[open_def; interval; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?d. &0 < d /\ !x'. abs(x' - (x:real^N)$i) < d ==> (a:real^N)$i < x' /\ x' < (b:real^N)$i` MP_TAC THENL [ASM_SIMP_TAC[OPEN_INTERVAL_LEMMA]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inf (IMAGE d (1..dimindex(:N)))` THEN SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NOT_INSERT_EMPTY; NUMSEG_EMPTY; ARITH_RULE `n < 1 <=> (n = 0)`; DIMINDEX_NONZERO] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; dist] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; VECTOR_SUB_COMPONENT]);; let CLOSED_INTERVAL = prove (`!a:real^N b. closed(interval [a,b])`, REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_INTERVAL] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`); FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`)] THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[dist; REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`; REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; let INTERIOR_CLOSED_INTERVAL = prove (`!a:real^N b. interior(interval [a,b]) = interval (a,b)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC INTERIOR_MAXIMAL THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL]] THEN REWRITE_TAC[interior; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL [(let t = `x - (e / &2) % basis i :real^N` in DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t)); (let t = `x + (e / &2) % basis i :real^N` in DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t))] THEN REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_ARITH `x - y - x = --y:real^N`] THEN ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; NORM_NEG; REAL_MUL_RID; REAL_ARITH `&0 < e ==> abs(e / &2) < e`] THEN MATCH_MP_TAC(TAUT `~b ==> (a ==> b) ==> ~a`) THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[DE_MORGAN_THM; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THENL [DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `a <= a - b <=> ~(&0 < b)`]; DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH `a + b <= a <=> ~(&0 < b)`]] THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; basis; LAMBDA_BETA; REAL_MUL_RID] THEN ASM_REWRITE_TAC[REAL_HALF]);; let INTERIOR_INTERVAL = prove (`(!a b. interior(interval[a,b]) = interval(a,b)) /\ (!a b. interior(interval(a,b)) = interval(a,b))`, SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);; let BOUNDED_CLOSED_INTERVAL = prove (`!a b:real^N. bounded (interval [a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[bounded; interval] THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((a:real^N)$i) + abs((b:real^N)$i))` THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x:real^N)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ARITH `a <= x /\ x <= b ==> abs(x) <= abs(a) + abs(b)`]);; let BOUNDED_INTERVAL = prove (`(!a b. bounded (interval [a,b])) /\ (!a b. bounded (interval (a,b)))`, MESON_TAC[BOUNDED_CLOSED_INTERVAL; BOUNDED_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]);; let NOT_INTERVAL_UNIV = prove (`(!a b. ~(interval[a,b] = UNIV)) /\ (!a b. ~(interval(a,b) = UNIV))`, MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; let COMPACT_INTERVAL = prove (`!a b. compact (interval [a,b])`, SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL; CLOSED_INTERVAL]);; let OPEN_INTERVAL_MIDPOINT = prove (`!a b:real^N. ~(interval(a,b) = {}) ==> (inv(&2) % (a + b)) IN interval(a,b)`, REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL] THEN SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);; let OPEN_CLOSED_INTERVAL_CONVEX = prove (`!a b x y:real^N e. x IN interval(a,b) /\ y IN interval[a,b] /\ &0 < e /\ e <= &1 ==> (e % x + (&1 - e) % y) IN interval(a,b)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(c /\ d ==> a /\ b ==> e) ==> a /\ b /\ c /\ d ==> e`) THEN STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBST1_TAC(REAL_ARITH `(a:real^N)$i = e * a$i + (&1 - e) * a$i`) THEN SUBST1_TAC(REAL_ARITH `(b:real^N)$i = e * b$i + (&1 - e) * b$i`) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL; REAL_SUB_LE]);; let CLOSURE_OPEN_INTERVAL = prove (`!a b:real^N. ~(interval(a,b) = {}) ==> closure(interval(a,b)) = interval[a,b]`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CLOSED_INTERVAL]; ALL_TAC] THEN REWRITE_TAC[SUBSET; closure; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~b ==> c) ==> b \/ c`) THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; LIMPT_SEQUENTIAL] THEN ABBREV_TAC `(c:real^N) = inv(&2) % (a + b)` THEN EXISTS_TAC `\n. (x:real^N) + inv(&n + &1) % (c - x)` THEN CONJ_TAC THENL [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_DELETE] THEN REWRITE_TAC[VECTOR_ARITH `x + a = x <=> a = vec 0`] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0] THEN REWRITE_TAC[VECTOR_SUB_EQ; REAL_ARITH `~(&n + &1 = &0)`] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]] THEN REWRITE_TAC[VECTOR_ARITH `x + a % (y - x) = a % y + (&1 - a) % x`] THEN MATCH_MP_TAC OPEN_CLOSED_INTERVAL_CONVEX THEN CONJ_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [VECTOR_ARITH `x:real^N = x + &0 % (c - x)`] THEN MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; DIST_LIFT; REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `N:num <= n` THEN UNDISCH_TAC `~(N = 0)` THEN REWRITE_TAC[GSYM LT_NZ; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT] THEN REAL_ARITH_TAC);; let CLOSURE_INTERVAL = prove (`(!a b. closure(interval[a,b]) = interval[a,b]) /\ (!a b. closure(interval(a,b)) = if interval(a,b) = {} then {} else interval[a,b])`, SIMP_TAC[CLOSURE_CLOSED; CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; CLOSURE_EMPTY]);; let BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC = prove (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval(--a,a)`, REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `B:real`] THEN STRIP_TAC THEN EXISTS_TAC `(lambda i. B + &1):real^N` THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_BOUNDS_LT; VECTOR_NEG_COMPONENT] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_ARITH `x <= y ==> a <= x ==> a < y + &1`]);; let BOUNDED_SUBSET_OPEN_INTERVAL = prove (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval(a,b)`, MESON_TAC[BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC]);; let BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC = prove (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval[--a,a]`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC) THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_BALL; IN_INTERVAL; SUBSET; REAL_LT_IMP_LE]);; let BOUNDED_SUBSET_CLOSED_INTERVAL = prove (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval[a,b]`, MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC]);; let FRONTIER_CLOSED_INTERVAL = prove (`!a b. frontier(interval[a,b]) = interval[a,b] DIFF interval(a,b)`, SIMP_TAC[frontier; INTERIOR_CLOSED_INTERVAL; CLOSURE_CLOSED; CLOSED_INTERVAL]);; let FRONTIER_OPEN_INTERVAL = prove (`!a b. frontier(interval(a,b)) = if interval(a,b) = {} then {} else interval[a,b] DIFF interval(a,b)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FRONTIER_EMPTY] THEN ASM_SIMP_TAC[frontier; CLOSURE_OPEN_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);; let INTER_INTERVAL_MIXED_EQ_EMPTY = prove (`!a b c d:real^N. ~(interval(c,d) = {}) ==> (interval(a,b) INTER interval[c,d] = {} <=> interval(a,b) INTER interval(c,d) = {})`, SIMP_TAC[GSYM CLOSURE_OPEN_INTERVAL; OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_INTERVAL]);; let INTERVAL_TRANSLATION = prove (`(!c a b. interval[c + a,c + b] = IMAGE (\x. c + x) (interval[a,b])) /\ (!c a b. interval(c + a,c + b) = IMAGE (\x. c + x) (interval(a,b)))`, REWRITE_TAC[interval] THEN CONJ_TAC THEN GEOM_TRANSLATE_TAC[] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; add_translation_invariants [CONJUNCT1 INTERVAL_TRANSLATION; CONJUNCT2 INTERVAL_TRANSLATION];; let EMPTY_AS_INTERVAL = prove (`{} = interval[vec 1,vec 0]`, SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTERVAL; VEC_COMPONENT] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);; let UNIT_INTERVAL_NONEMPTY = prove (`~(interval[vec 0:real^N,vec 1] = {}) /\ ~(interval(vec 0:real^N,vec 1) = {})`, SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01; REAL_POS]);; let IMAGE_STRETCH_INTERVAL = prove (`!a b:real^N m. IMAGE (\x. lambda k. m(k) * x$k) (interval[a,b]) = if interval[a,b] = {} then {} else interval[(lambda k. min (m(k) * a$k) (m(k) * b$k)):real^N, (lambda k. max (m(k) * a$k) (m(k) * b$k))]`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES] THEN ASM_SIMP_TAC[EXTENSION; IN_IMAGE; CART_EQ; IN_INTERVAL; AND_FORALL_THM; TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`; LAMBDA_BETA; GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC(MESON[] `(!x. p x ==> (q x <=> r x)) ==> ((!x. p x ==> q x) <=> (!x. p x ==> r x))`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(m:num->real) k = &0` THENL [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MAX_ACI; REAL_MIN_ACI] THEN ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_REFL]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_FIELD `~(m = &0) ==> (x = m * y <=> y = x / m)`] THEN REWRITE_TAC[UNWIND_THM2] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(z = &0) ==> &0 < z \/ &0 < --z`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ARITH `--(max a b) = min (--a) (--b)`; REAL_ARITH `--(min a b) = max (--a) (--b)`; real_div; GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN REWRITE_TAC[GSYM real_div]] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN ASM_SIMP_TAC[real_min; real_max; REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC);; let INTERVAL_IMAGE_STRETCH_INTERVAL = prove (`!a b:real^N m. ?u v:real^N. IMAGE (\x. lambda k. m k * x$k) (interval[a,b]) = interval[u,v]`, REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]);; let CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL = prove (`!a b:real^N. ~(interval[a,b] = {}) ==> interval[a,b] = IMAGE (\x:real^N. a + x) (IMAGE (\x. (lambda i. (b$i - a$i) * x$i)) (interval[vec 0:real^N,vec 1]))`, REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_STRETCH_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN REWRITE_TAC[EXTENSION; IN_INTERVAL] THEN SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN GEN_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID] THEN MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((!x. P x) <=> (!x. Q x))`) THEN POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let SUMS_INTERVALS = prove (`(!a b c d:real^N. ~(interval[a,b] = {}) /\ ~(interval[c,d] = {}) ==> {x + y | x IN interval[a,b] /\ y IN interval[c,d]} = interval[a+c,b+d]) /\ (!a b c d:real^N. ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) ==> {x + y | x IN interval(a,b) /\ y IN interval(c,d)} = interval(a+c,b+d))`, CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN REWRITE_TAC[UNWIND_THM2; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN (X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC); DISCH_TAC THEN REWRITE_TAC[AND_FORALL_THM; GSYM LAMBDA_SKOLEM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[REAL_ARITH `((a <= y /\ y <= b) /\ c <= x - y /\ x - y <= d <=> max a (x - d) <= y /\ y <= min b (x - c)) /\ ((a < y /\ y < b) /\ c < x - y /\ x - y < d <=> max a (x - d) < y /\ y < min b (x - c))`] THEN REWRITE_TAC[GSYM REAL_LE_BETWEEN; GSYM REAL_LT_BETWEEN]] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));; let PCROSS_INTERVAL = prove (`!a b:real^M c d:real^N. interval[a,b] PCROSS interval[c,d] = interval[pastecart a c,pastecart b d]`, REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN SIMP_TAC[IN_INTERVAL; pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THEN STRIP_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB] THENL [ASM_ARITH_TAC; DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]]]);; let OPEN_CONTAINS_INTERVAL,OPEN_CONTAINS_OPEN_INTERVAL = (CONJ_PAIR o prove) (`(!s:real^N->bool. open s <=> !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s) /\ (!s:real^N->bool. open s <=> !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)`, REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN REPEAT CONJ_TAC THENL [MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; DISCH_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN MP_TAC(ISPEC `interval(a:real^N,b)` OPEN_CONTAINS_BALL) THEN REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `x - e / &(dimindex(:N)) % vec 1:real^N` THEN EXISTS_TAC `x + e / &(dimindex(:N)) % vec 1:real^N` THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b SUBSET s ==> x IN i /\ j SUBSET b ==> x IN i /\ j SUBSET s`)) THEN SIMP_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; IN_CBALL; VEC_COMPONENT; VECTOR_ADD_COMPONENT; SUBSET; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `x - e < x /\ x < x + e <=> &0 < e`; REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(x - y) <= e`] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN ASM_SIMP_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]);; let DIAMETER_INTERVAL = prove (`(!a b:real^N. diameter(interval[a,b]) = if interval[a,b] = {} then &0 else norm(b - a)) /\ (!a b:real^N. diameter(interval(a,b)) = if interval(a,b) = {} then &0 else norm(b - a))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_EMPTY; DIAMETER_EMPTY]; ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND; ENDS_IN_INTERVAL; BOUNDED_INTERVAL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `diameter(cball(inv(&2) % (a + b):real^N,norm(b - a) / &2))` THEN CONJ_TAC THENL [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_CBALL] THEN REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN REWRITE_TAC[GSYM NORM_MUL; REAL_ARITH `x / &2 = abs(inv(&2)) * x`] THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC; REWRITE_TAC[DIAMETER_CBALL] THEN NORM_ARITH_TAC]; DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY] THEN SUBGOAL_THEN `interval[a:real^N,b] = closure(interval(a,b))` SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN ASM_MESON_TAC[DIAMETER_CLOSURE; BOUNDED_INTERVAL]]);; (* ------------------------------------------------------------------------- *) (* Some special cases for intervals in R^1. *) (* ------------------------------------------------------------------------- *) let INTERVAL_CASES_1 = prove (`!x:real^1. x IN interval[a,b] ==> x IN interval(a,b) \/ (x = a) \/ (x = b)`, REWRITE_TAC[CART_EQ; IN_INTERVAL; FORALL_DIMINDEX_1] THEN REAL_ARITH_TAC);; let IN_INTERVAL_1 = prove (`!a b x:real^1. (x IN interval[a,b] <=> drop a <= drop x /\ drop x <= drop b) /\ (x IN interval(a,b) <=> drop a < drop x /\ drop x < drop b)`, REWRITE_TAC[IN_INTERVAL; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN MESON_TAC[]);; let INTERVAL_EQ_EMPTY_1 = prove (`!a b:real^1. (interval[a,b] = {} <=> drop b < drop a) /\ (interval(a,b) = {} <=> drop b <= drop a)`, REWRITE_TAC[INTERVAL_EQ_EMPTY; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN MESON_TAC[]);; let INTERVAL_NE_EMPTY_1 = prove (`(!a b:real^1. ~(interval[a,b] = {}) <=> drop a <= drop b) /\ (!a b:real^1. ~(interval(a,b) = {}) <=> drop a < drop b)`, REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN REAL_ARITH_TAC);; let SUBSET_INTERVAL_1 = prove (`!a b c d. (interval[a,b] SUBSET interval[c,d] <=> drop b < drop a \/ drop c <= drop a /\ drop a <= drop b /\ drop b <= drop d) /\ (interval[a,b] SUBSET interval(c,d) <=> drop b < drop a \/ drop c < drop a /\ drop a <= drop b /\ drop b < drop d) /\ (interval(a,b) SUBSET interval[c,d] <=> drop b <= drop a \/ drop c <= drop a /\ drop a < drop b /\ drop b <= drop d) /\ (interval(a,b) SUBSET interval(c,d) <=> drop b <= drop a \/ drop c <= drop a /\ drop a < drop b /\ drop b <= drop d)`, REWRITE_TAC[SUBSET_INTERVAL; FORALL_1; DIMINDEX_1; drop] THEN REAL_ARITH_TAC);; let EQ_INTERVAL_1 = prove (`!a b c d:real^1. (interval[a,b] = interval[c,d] <=> drop b < drop a /\ drop d < drop c \/ drop a = drop c /\ drop b = drop d)`, REWRITE_TAC[SET_RULE `s = t <=> s SUBSET t /\ t SUBSET s`] THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC);; let DISJOINT_INTERVAL_1 = prove (`!a b c d:real^1. (interval[a,b] INTER interval[c,d] = {} <=> drop b < drop a \/ drop d < drop c \/ drop b < drop c \/ drop d < drop a) /\ (interval[a,b] INTER interval(c,d) = {} <=> drop b < drop a \/ drop d <= drop c \/ drop b <= drop c \/ drop d <= drop a) /\ (interval(a,b) INTER interval[c,d] = {} <=> drop b <= drop a \/ drop d < drop c \/ drop b <= drop c \/ drop d <= drop a) /\ (interval(a,b) INTER interval(c,d) = {} <=> drop b <= drop a \/ drop d <= drop c \/ drop b <= drop c \/ drop d <= drop a)`, REWRITE_TAC[DISJOINT_INTERVAL; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM; UNWIND_THM1; drop]);; let OPEN_CLOSED_INTERVAL_1 = prove (`!a b:real^1. interval(a,b) = interval[a,b] DIFF {a,b}`, REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; let CLOSED_OPEN_INTERVAL_1 = prove (`!a b:real^1. drop a <= drop b ==> interval[a,b] = interval(a,b) UNION {a,b}`, REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; let BALL_1 = prove (`!x:real^1 r. cball(x,r) = interval[x - lift r,x + lift r] /\ ball(x,r) = interval(x - lift r,x + lift r)`, REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL; IN_INTERVAL_1] THEN REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_ADD] THEN REAL_ARITH_TAC);; let SPHERE_1 = prove (`!a:real^1 r. sphere(a,r) = if r < &0 then {} else {a - lift r,a + lift r}`, REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN COND_CASES_TAC THEN REWRITE_TAC[DIST_REAL; GSYM drop; FORALL_DROP] THEN REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC);; let FINITE_SPHERE_1 = prove (`!a:real^1 r. FINITE(sphere(a,r))`, REPEAT GEN_TAC THEN REWRITE_TAC[SPHERE_1] THEN MESON_TAC[FINITE_INSERT; FINITE_EMPTY]);; let FINITE_INTERVAL_1 = prove (`(!a b. FINITE(interval[a,b]) <=> drop b <= drop a) /\ (!a b. FINITE(interval(a,b)) <=> drop b <= drop a)`, REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `interval[a,b] = IMAGE lift {x | drop a <= x /\ x <= drop b}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; LIFT_DROP]; SIMP_TAC[FINITE_IMAGE_INJ_EQ; LIFT_EQ; FINITE_REAL_INTERVAL]]);; let BALL_INTERVAL = prove (`!x:real^1 e. ball(x,e) = interval(x - lift e,x + lift e)`, REWRITE_TAC[EXTENSION; IN_BALL; IN_INTERVAL_1; DIST_REAL] THEN REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; let CBALL_INTERVAL = prove (`!x:real^1 e. cball(x,e) = interval[x - lift e,x + lift e]`, REWRITE_TAC[EXTENSION; IN_CBALL; IN_INTERVAL_1; DIST_REAL] THEN REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; let BALL_INTERVAL_0 = prove (`!e. ball(vec 0:real^1,e) = interval(--lift e,lift e)`, GEN_TAC THEN REWRITE_TAC[BALL_INTERVAL] THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; let CBALL_INTERVAL_0 = prove (`!e. cball(vec 0:real^1,e) = interval[--lift e,lift e]`, GEN_TAC THEN REWRITE_TAC[CBALL_INTERVAL] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; let INTER_INTERVAL_1 = prove (`!a b c d:real^1. interval[a,b] INTER interval[c,d] = interval[lift(max (drop a) (drop c)),lift(min (drop b) (drop d))]`, REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; real_max; real_min] THEN REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN ASM_REAL_ARITH_TAC);; let CLOSED_DIFF_OPEN_INTERVAL_1 = prove (`!a b:real^1. interval[a,b] DIFF interval(a,b) = if interval[a,b] = {} then {} else {a,b}`, REWRITE_TAC[EXTENSION; IN_DIFF; INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Intervals in general, including infinite and mixtures of open and closed. *) (* ------------------------------------------------------------------------- *) let is_interval = new_definition `is_interval(s:real^N->bool) <=> !a b x. a IN s /\ b IN s /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> (a$i <= x$i /\ x$i <= b$i) \/ (b$i <= x$i /\ x$i <= a$i)) ==> x IN s`;; let IS_INTERVAL_INTERVAL = prove (`!a:real^N b. is_interval(interval (a,b)) /\ is_interval(interval [a,b])`, REWRITE_TAC[is_interval; IN_INTERVAL] THEN MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS]);; let IS_INTERVAL_EMPTY = prove (`is_interval {}`, REWRITE_TAC[is_interval; NOT_IN_EMPTY]);; let IS_INTERVAL_UNIV = prove (`is_interval(UNIV:real^N->bool)`, REWRITE_TAC[is_interval; IN_UNIV]);; let IS_INTERVAL_TRANSLATION_EQ = prove (`!a:real^N s. is_interval(IMAGE (\x. a + x) s) <=> is_interval s`, REWRITE_TAC[is_interval] THEN GEOM_TRANSLATE_TAC[] THEN REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; add_translation_invariants [IS_INTERVAL_TRANSLATION_EQ];; let IS_INTERVAL_TRANSLATION = prove (`!s a:real^N. is_interval s ==> is_interval(IMAGE (\x. a + x) s)`, REWRITE_TAC[IS_INTERVAL_TRANSLATION_EQ]);; let IS_INTERVAL_POINTWISE = prove (`!s:real^N->bool x. is_interval s /\ (!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. a IN s /\ a$i = x$i) ==> x IN s`, REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n. ?y:real^N. (!i. 1 <= i /\ i <= n ==> y$i = (x:real^N)$i) /\ y IN s` MP_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THENL [ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN ASM_CASES_TAC `SUC n <= dimindex(:N)` THENL [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(lambda i. if i <= n then (y:real^N)$i else (z:real^N)$i):real^N` THEN CONJ_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `i = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN ASM_ARITH_TAC; FIRST_X_ASSUM(ASSUME_TAC o CONJUNCT2) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`y:real^N`; `z:real^N`] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]; EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `y:real^N = x` (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[CART_EQ] THEN ASM_MESON_TAC[ARITH_RULE `i <= N /\ ~(SUC n <= N) ==> i <= n`]]; DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[GSYM CART_EQ] THEN MESON_TAC[]]);; let IS_INTERVAL_COMPACT = prove (`!s:real^N->bool. is_interval s /\ compact s <=> ?a b. s = interval[a,b]`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[IS_INTERVAL_INTERVAL; COMPACT_INTERVAL] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN EXISTS_TAC `(lambda i. inf { (x:real^N)$i | x IN s}):real^N` THEN EXISTS_TAC `(lambda i. sup { (x:real^N)$i | x IN s}):real^N` THEN SIMP_TAC[EXTENSION; IN_INTERVAL; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` INF) THEN MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` SUP) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN REWRITE_TAC[bounded] THEN ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; REAL_ARITH `abs(x) <= B ==> --B <= x /\ x <= B`]; DISCH_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `?a b:real^N. a IN s /\ b IN s /\ a$i <= (x:real^N)$i /\ x$i <= b$i` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] CONTINUOUS_ATTAINS_INF) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] CONTINUOUS_ATTAINS_SUP) THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL [EXISTS_TAC `inf {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_INF THEN ASM SET_TAC[]; EXISTS_TAC `sup {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_SUP_LE THEN ASM SET_TAC[]]; EXISTS_TAC `(lambda j. if j = i then (x:real^N)$i else (a:real^N)$j):real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `(lambda j. if j = i then (b:real^N)$i else (a:real^N)$j):real^N`] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_SIMP_TAC[LAMBDA_BETA]; ALL_TAC] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; let IS_INTERVAL_1 = prove (`!s:real^1->bool. is_interval s <=> !a b x. a IN s /\ b IN s /\ drop a <= drop x /\ drop x <= drop b ==> x IN s`, REWRITE_TAC[is_interval; DIMINDEX_1; FORALL_1; GSYM drop] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MESON_TAC[]);; let IS_INTERVAL_1_CASES = prove (`!s:real^1->bool. is_interval s <=> s = {} \/ s = (:real^1) \/ (?a. s = {x | a < drop x}) \/ (?a. s = {x | a <= drop x}) \/ (?b. s = {x | drop x <= b}) \/ (?b. s = {x | drop x < b}) \/ (?a b. s = {x | a < drop x /\ drop x < b}) \/ (?a b. s = {x | a < drop x /\ drop x <= b}) \/ (?a b. s = {x | a <= drop x /\ drop x < b}) \/ (?a b. s = {x | a <= drop x /\ drop x <= b})`, GEN_TAC THEN REWRITE_TAC[IS_INTERVAL_1] THEN EQ_TAC THENL [DISCH_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN REAL_ARITH_TAC] THEN ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPEC `IMAGE drop s` SUP) THEN MP_TAC(ISPEC `IMAGE drop s` INF) THEN ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN ASM_CASES_TAC `?a. !x. x IN s ==> a <= drop x` THEN ASM_CASES_TAC `?b. !x. x IN s ==> drop x <= b` THEN ASM_REWRITE_TAC[] THENL [STRIP_TAC THEN STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`inf(IMAGE drop s) IN IMAGE drop s`; `sup(IMAGE drop s) IN IMAGE drop s`] THENL [REPLICATE_TAC 8 DISJ2_TAC; REPLICATE_TAC 7 DISJ2_TAC THEN DISJ1_TAC; REPLICATE_TAC 6 DISJ2_TAC THEN DISJ1_TAC; REPLICATE_TAC 5 DISJ2_TAC THEN DISJ1_TAC] THEN MAP_EVERY EXISTS_TAC [`inf(IMAGE drop s)`; `sup(IMAGE drop s)`]; STRIP_TAC THEN ASM_CASES_TAC `inf(IMAGE drop s) IN IMAGE drop s` THENL [REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC; DISJ2_TAC THEN DISJ1_TAC] THEN EXISTS_TAC `inf(IMAGE drop s)`; STRIP_TAC THEN ASM_CASES_TAC `sup(IMAGE drop s) IN IMAGE drop s` THENL [REPLICATE_TAC 3 DISJ2_TAC THEN DISJ1_TAC; REPLICATE_TAC 4 DISJ2_TAC THEN DISJ1_TAC] THEN EXISTS_TAC `sup(IMAGE drop s)`; DISJ1_TAC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM]);; let IS_INTERVAL_PCROSS = prove (`!s:real^M->bool t:real^N->bool. is_interval s /\ is_interval t ==> is_interval(s PCROSS t)`, REWRITE_TAC[is_interval; DIMINDEX_FINITE_SUM] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[] `(!a b a' b' x x'. P a b x /\ Q a' b' x' ==> R a b x a' b' x') ==> (!a b x. P a b x) /\ (!a' b' x'. Q a' b' x') ==> (!a a' b b' x x'. R a b x a' b' x')`) THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ARITH_RULE `x:num <= m ==> x <= m + n`]; FIRST_X_ASSUM(MP_TAC o SPEC `dimindex(:M) + i`) THEN ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ARITH_RULE `x:num <= n ==> m + x <= m + n`; ARITH_RULE `1 <= x ==> 1 <= m + x`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN ASM_ARITH_TAC]);; let IS_INTERVAL_PCROSS_EQ = prove (`!s:real^M->bool t:real^N->bool. is_interval(s PCROSS t) <=> s = {} \/ t = {} \/ is_interval s /\ is_interval t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_PCROSS] THEN REWRITE_TAC[is_interval] THEN REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN STRIP_TAC THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `y:real^N`; `b:real^M`; `y:real^N`; `x:real^M`; `y:real^N`]); MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `w:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `a:real^N`; `w:real^M`; `b:real^N`; `w:real^M`; `x:real^N`])] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[pastecart; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `1 <= i /\ i <= m + n /\ ~(i <= m) ==> 1 <= i - m /\ i - m <= n`]);; let IS_INTERVAL_INTER = prove (`!s t:real^N->bool. is_interval s /\ is_interval t ==> is_interval(s INTER t)`, REWRITE_TAC[is_interval; IN_INTER] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[]);; let INTERVAL_SUBSET_IS_INTERVAL = prove (`!s a b:real^N. is_interval s ==> (interval[a,b] SUBSET s <=> interval[a,b] = {} \/ a IN s /\ b IN s)`, REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN ASM_REWRITE_TAC[EMPTY_SUBSET] THEN EQ_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[]);; let INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD = prove (`!s x:real^N. is_interval s /\ x IN s ==> ?a b d. &0 < d /\ x IN interval[a,b] /\ interval[a,b] SUBSET s /\ ball(x,d) INTER s SUBSET interval[a,b]`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. (?y. y IN s /\ y$i = a) /\ (a < x$i \/ a = (x:real^N)$i /\ !y:real^N. y IN s ==> a <= y$i)` MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?b. (?y. y IN s /\ y$i = b) /\ (x$i < b \/ b = (x:real^N)$i /\ !y:real^N. y IN s ==> y$i <= b)` MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN EXISTS_TAC `min (inf (IMAGE (\i. if a$i < x$i then (x:real^N)$i - (a:real^N)$i else &1) (1..dimindex(:N)))) (inf (IMAGE (\i. if x$i < b$i then (b:real^N)$i - x$i else &1) (1..dimindex(:N))))` THEN REWRITE_TAC[REAL_LT_MIN; SUBSET; IN_BALL; IN_INTER] THEN SIMP_TAC[REAL_LT_INF_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE; FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL] THEN REPEAT CONJ_TAC THENL [MESON_TAC[REAL_SUB_LT; REAL_LT_01]; MESON_TAC[REAL_SUB_LT; REAL_LT_01]; ASM_MESON_TAC[REAL_LE_LT]; DISJ2_TAC THEN CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN ASM_MESON_TAC[]; X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN (COND_CASES_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]]) THEN DISCH_TAC THEN MP_TAC(ISPECL [`x - y:real^N`; `i:num`] COMPONENT_LE_NORM) THEN ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);; let IS_INTERVAL_SUMS = prove (`!s t:real^N->bool. is_interval s /\ is_interval t ==> is_interval {x + y | x IN s /\ y IN t}`, REPEAT GEN_TAC THEN REWRITE_TAC[is_interval] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `a':real^N`; `b:real^N`; `b':real^N`; `y:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPECL [`a:real^N`; `b:real^N`]) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPECL [`a':real^N`; `b':real^N`]) STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[IMP_IMP; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN ONCE_REWRITE_TAC[VECTOR_ARITH `z:real^N = x + y <=> y = z - x`] THEN REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(MESON[] `(?x. P x /\ Q(f x)) ==> (!x. P x ==> x IN s) /\ (!x. Q x ==> x IN t) ==> ?x. x IN s /\ f x IN t`) THEN REWRITE_TAC[VECTOR_SUB_COMPONENT; AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN REWRITE_TAC[REAL_ARITH `c <= y - x /\ y - x <= d <=> y - d <= x /\ x <= y - c`] THEN REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=> min a b <= x /\ x <= max a b`] THEN ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> (p /\ r) /\ (q /\ s)`] THEN REWRITE_TAC[GSYM REAL_LE_MIN; GSYM REAL_MAX_LE] THEN REWRITE_TAC[GSYM REAL_LE_BETWEEN] THEN REAL_ARITH_TAC);; let IS_INTERVAL_SING = prove (`!a:real^N. is_interval {a}`, SIMP_TAC[is_interval; IN_SING; IMP_CONJ; CART_EQ; REAL_LE_ANTISYM]);; let IS_INTERVAL_SCALING = prove (`!s:real^N->bool c. is_interval s ==> is_interval(IMAGE (\x. c % x) s)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` STRIP_ASSUME_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; ASM_REWRITE_TAC[IS_INTERVAL_SING]]; REWRITE_TAC[is_interval; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_REWRITE_TAC (BINOP_CONV o REDEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; VECTOR_MUL_COMPONENT] THEN MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) [`a:real^N`; `b:real^N`] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MP_TAC(SPEC `inv(c) % x:real^N` th)) THEN ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; IN_IMAGE] THEN ANTS_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(c = &0) ==> &0 < c \/ &0 < --c`)) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LE_NEG2] THEN ASM_SIMP_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ] THEN REWRITE_TAC[real_div; REAL_INV_NEG] THEN REAL_ARITH_TAC; DISCH_TAC THEN EXISTS_TAC `inv c % x:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]);; let IS_INTERVAL_SCALING_EQ = prove (`!s:real^N->bool c. is_interval(IMAGE (\x. c % x) s) <=> c = &0 \/ is_interval s`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` STRIP_ASSUME_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; ASM_REWRITE_TAC[IS_INTERVAL_SING]]; ASM_REWRITE_TAC[] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_SCALING] THEN DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP IS_INTERVAL_SCALING) THEN ASM_SIMP_TAC[GSYM IMAGE_o; VECTOR_MUL_ASSOC; o_DEF; REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);; let lemma = prove (`!c. &0 < c ==> !s:real^N->bool. is_interval(IMAGE (\x. c % x) s) <=> is_interval s`, SIMP_TAC[IS_INTERVAL_SCALING_EQ; REAL_LT_IMP_NZ]) in add_scaling_theorems [lemma];; (* ------------------------------------------------------------------------- *) (* Line segments, with same open/closed overloading as for intervals. *) (* ------------------------------------------------------------------------- *) let closed_segment = define `closed_segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1}`;; let open_segment = new_definition `open_segment(a,b) = closed_segment[a,b] DIFF {a,b}`;; let OPEN_SEGMENT_ALT = prove (`!a b:real^N. ~(a = b) ==> open_segment(a,b) = {(&1 - u) % a + u % b | &0 < u /\ u < &1}`, REPEAT STRIP_TAC THEN REWRITE_TAC[open_segment; closed_segment] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN ASM_CASES_TAC `x:real^N = (&1 - u) % a + u % b` THEN ASM_REWRITE_TAC[REAL_LE_LT; VECTOR_ARITH `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`; VECTOR_ARITH `(&1 - u) % a + u % b = b <=> (&1 - u) % (b - a) = vec 0`; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC);; make_overloadable "segment" `:A`;; overload_interface("segment",`open_segment`);; overload_interface("segment",`closed_segment`);; let segment = prove (`segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1} /\ segment(a,b) = segment[a,b] DIFF {a,b}`, REWRITE_TAC[open_segment; closed_segment]);; let SEGMENT_REFL = prove (`(!a. segment[a,a] = {a}) /\ (!a. segment(a,a) = {})`, REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % a = a`] THEN SET_TAC[REAL_POS]);; let IN_SEGMENT = prove (`!a b x:real^N. (x IN segment[a,b] <=> ?u. &0 <= u /\ u <= &1 /\ x = (&1 - u) % a + u % b) /\ (x IN segment(a,b) <=> ~(a = b) /\ ?u. &0 < u /\ u < &1 /\ x = (&1 - u) % a + u % b)`, REPEAT STRIP_TAC THENL [REWRITE_TAC[segment; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM; CONJ_ASSOC]);; let SEGMENT_SYM = prove (`(!a b:real^N. segment[a,b] = segment[b,a]) /\ (!a b:real^N. segment(a,b) = segment(b,a))`, MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN SIMP_TAC[open_segment] THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[INSERT_AC]] THEN REWRITE_TAC[EXTENSION; IN_SEGMENT] THEN REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN TRY ASM_ARITH_TAC THEN VECTOR_ARITH_TAC);; let ENDS_IN_SEGMENT = prove (`!a b. a IN segment[a,b] /\ b IN segment[a,b]`, REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THENL [EXISTS_TAC `&0`; EXISTS_TAC `&1`] THEN (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]));; let ENDS_NOT_IN_SEGMENT = prove (`!a b. ~(a IN segment(a,b)) /\ ~(b IN segment(a,b))`, REWRITE_TAC[open_segment] THEN SET_TAC[]);; let SEGMENT_CLOSED_OPEN = prove (`!a b. segment[a,b] = segment(a,b) UNION {a,b}`, REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE `a IN s /\ b IN s ==> s = (s DIFF {a,b}) UNION {a,b}`) THEN REWRITE_TAC[ENDS_IN_SEGMENT]);; let MIDPOINT_IN_SEGMENT = prove (`(!a b:real^N. midpoint(a,b) IN segment[a,b]) /\ (!a b:real^N. midpoint(a,b) IN segment(a,b) <=> ~(a = b))`, REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL [ALL_TAC; ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[]] THEN EXISTS_TAC `&1 / &2` THEN REWRITE_TAC[midpoint] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC);; let BETWEEN_IN_SEGMENT = prove (`!x a b:real^N. between x (a,b) <=> x IN segment[a,b]`, REPEAT GEN_TAC THEN REWRITE_TAC[between] THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING] THENL [NORM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN EQ_TAC THENL [DISCH_THEN(ASSUME_TAC o SYM) THEN EXISTS_TAC `dist(a:real^N,x) / dist(a,b)` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; DIST_POS_LT] THEN CONJ_TAC THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN NORM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `dist(a:real^N,b)` THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_SUB_LDISTRIB; REAL_DIV_LMUL; DIST_EQ_0] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIST_TRIANGLE_EQ] o SYM) THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[dist; REAL_ARITH `(a + b) * &1 - a = b`] THEN VECTOR_ARITH_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN REWRITE_TAC[VECTOR_ARITH `a - ((&1 - u) % a + u % b) = u % (a - b)`; VECTOR_ARITH `((&1 - u) % a + u % b) - b = (&1 - u) % (a - b)`; NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; let IN_SEGMENT_COMPONENT = prove (`!a b x:real^N i. x IN segment[a,b] /\ 1 <= i /\ i <= dimindex(:N) ==> min (a$i) (b$i) <= x$i /\ x$i <= max (a$i) (b$i)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN SIMP_TAC[REAL_ARITH `c <= u * a + t * b <=> u * --a + t * --b <= --c`] THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REAL_ARITH_TAC);; let SEGMENT_1 = prove (`(!a b. segment[a,b] = if drop a <= drop b then interval[a,b] else interval[b,a]) /\ (!a b. segment(a,b) = if drop a <= drop b then interval(a,b) else interval(b,a))`, CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN COND_CASES_TAC THEN REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; EXTENSION; GSYM BETWEEN_IN_SEGMENT; between; IN_INTERVAL_1] THEN REWRITE_TAC[GSYM DROP_EQ; DIST_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC);; let OPEN_SEGMENT_1 = prove (`!a b:real^1. open(segment(a,b))`, REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN REWRITE_TAC[OPEN_INTERVAL]);; let SEGMENT_TRANSLATION = prove (`(!c a b. segment[c + a,c + b] = IMAGE (\x. c + x) (segment[a,b])) /\ (!c a b. segment(c + a,c + b) = IMAGE (\x. c + x) (segment(a,b)))`, REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_IMAGE] THEN REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (c + a) + u % (c + b) = c + (&1 - u) % a + u % b`] THEN REWRITE_TAC[VECTOR_ARITH `c + a:real^N = c + b <=> a = b`] THEN MESON_TAC[]);; add_translation_invariants [CONJUNCT1 SEGMENT_TRANSLATION; CONJUNCT2 SEGMENT_TRANSLATION];; let CLOSED_SEGMENT_LINEAR_IMAGE = prove (`!f a b. linear f ==> segment[f a,f b] = IMAGE f (segment[a,b])`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SEGMENT] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN MESON_TAC[]);; add_linear_invariants [CLOSED_SEGMENT_LINEAR_IMAGE];; let OPEN_SEGMENT_LINEAR_IMAGE = prove (`!f:real^M->real^N a b. linear f /\ (!x y. f x = f y ==> x = y) ==> segment(f a,f b) = IMAGE f (segment(a,b))`, REWRITE_TAC[open_segment] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [OPEN_SEGMENT_LINEAR_IMAGE];; let IN_OPEN_SEGMENT = prove (`!a b x:real^N. x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b)`, REPEAT GEN_TAC THEN REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]);; let IN_OPEN_SEGMENT_ALT = prove (`!a b x:real^N. x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b) /\ ~(a = b)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING; NOT_IN_EMPTY] THEN ASM_MESON_TAC[IN_OPEN_SEGMENT]);; let COLLINEAR_DIST_IN_CLOSED_SEGMENT = prove (`!a b x. collinear {x,a,b} /\ dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b) ==> x IN segment[a,b]`, REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; COLLINEAR_DIST_BETWEEN]);; let COLLINEAR_DIST_IN_OPEN_SEGMENT = prove (`!a b x. collinear {x,a,b} /\ dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b) ==> x IN segment(a,b)`, REWRITE_TAC[IN_OPEN_SEGMENT] THEN MESON_TAC[COLLINEAR_DIST_IN_CLOSED_SEGMENT; REAL_LT_LE; DIST_SYM]);; let SEGMENT_SCALAR_MULTIPLE = prove (`(!a b v. segment[a % v,b % v] = {x % v:real^N | a <= x /\ x <= b \/ b <= x /\ x <= a}) /\ (!a b v. ~(v = vec 0) ==> segment(a % v,b % v) = {x % v:real^N | a < x /\ x < b \/ b < x /\ x < a})`, MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL [REPEAT GEN_TAC THEN MP_TAC(SPECL [`a % basis 1:real^1`; `b % basis 1:real^1`] (CONJUNCT1 SEGMENT_1)) THEN REWRITE_TAC[segment; VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN REWRITE_TAC[SET_RULE `{f x % b | p x} = IMAGE (\a. a % b) {f x | p x}`] THEN DISCH_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `IMAGE drop`) THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_CMUL] THEN SIMP_TAC[drop; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN REWRITE_TAC[REAL_MUL_RID; IMAGE_ID] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN SIMP_TAC[drop; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[open_segment] THEN ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; SET_RULE `(!x y. x % v = y % v <=> x = y) ==> {x % v | P x} DIFF {a % v,b % v} = {x % v | P x /\ ~(x = a) /\ ~(x = b)}`] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; let FINITE_INTER_COLLINEAR_OPEN_SEGMENTS = prove (`!a b c d:real^N. collinear{a,b,c} ==> (FINITE(segment(a,b) INTER segment(c,d)) <=> segment(a,b) INTER segment(c,d) = {})`, REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = b - a` THEN POP_ASSUM MP_TAC THEN GEOM_NORMALIZE_TAC `m:real^N` THEN SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; INTER_EMPTY; FINITE_EMPTY] THEN X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM(K ALL_TAC) THEN ASM_CASES_TAC `collinear{vec 0:real^N,&1 % basis 1,y}` THENL [POP_ASSUM MP_TAC THEN SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN MATCH_MP_TAC(TAUT `~a /\ (b ==> c ==> d) ==> a \/ b ==> a \/ c ==> d`) THEN CONJ_TAC THENL [SIMP_TAC[VECTOR_MUL_LID; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `b:real` THEN DISCH_THEN SUBST_ALL_TAC THEN X_GEN_TAC `a:real` THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_RCANCEL; IMAGE_EQ_EMPTY; FINITE_IMAGE_INJ_EQ; SET_RULE `(!x y. x % v = y % v <=> x = y) ==> {x % v | P x} INTER {x % v | Q x} = IMAGE (\x. x % v) {x | P x /\ Q x}`] THEN REWRITE_TAC[REAL_ARITH `(&0 < x /\ x < &1 \/ &1 < x /\ x < &0) /\ (b < x /\ x < a \/ a < x /\ x < b) <=> max (&0) (min a b) < x /\ x < min (&1) (max a b)`] THEN SIMP_TAC[FINITE_REAL_INTERVAL; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN SIMP_TAC[GSYM REAL_LT_BETWEEN; GSYM NOT_EXISTS_THM] THEN REAL_ARITH_TAC; DISCH_TAC THEN ASM_CASES_TAC `segment(vec 0:real^N,&1 % basis 1) INTER segment (x,y) = {}` THEN ASM_REWRITE_TAC[FINITE_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[open_segment; IN_DIFF; NOT_IN_EMPTY; DE_MORGAN_THM; IN_INTER; IN_INSERT] THEN DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN UNDISCH_TAC `~collinear{vec 0:real^N,&1 % basis 1, y}` THEN RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_LID]) THEN REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{p,x:real^N, y, vec 0, basis 1}` THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN MP_TAC(ISPECL [`{y:real^N,vec 0,basis 1}`; `p:real^N`; `x:real^N`] COLLINEAR_TRIPLES) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `{p,x,y} = {x,p,y}`] THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]; ALL_TAC] THEN ASM_SIMP_TAC[GSYM COLLINEAR_4_3] THEN ONCE_REWRITE_TAC[SET_RULE `{p,x,z,w} = {w,z,p,x}`] THEN SIMP_TAC[COLLINEAR_4_3; BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR o GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT])) THEN REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);; let DIST_IN_CLOSED_SEGMENT,DIST_IN_OPEN_SEGMENT = (CONJ_PAIR o prove) (`(!a b x:real^N. x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)) /\ (!a b x:real^N. x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))`, SIMP_TAC[IN_SEGMENT; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; dist; VECTOR_ARITH `((&1 - u) % a + u % b) - a:real^N = u % (b - a) /\ ((&1 - u) % a + u % b) - b = --(&1 - u) % (b - a)`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; NORM_SUB] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THENL [REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `x * y < y <=> x * y < &1 * y`] THEN ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let DIST_DECREASES_OPEN_SEGMENT = prove (`!a b c x:real^N. x IN segment(a,b) ==> dist(c,x) < dist(c,a) \/ dist(c,x) < dist(c,b)`, GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN X_GEN_TAC `b:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN SIMP_TAC[NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID; VECTOR_MUL_LID] THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_SEGMENT; dist] THEN STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN SUBGOAL_THEN `norm((c$1 - u) % basis 1:real^N) < norm((c:real^N)$1 % basis 1:real^N) \/ norm((c$1 - u) % basis 1:real^N) < norm((c$1 - &1) % basis 1:real^N)` MP_TAC THENL [SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[NORM_LT; DOT_LMUL; DOT_RMUL; DOT_BASIS; DIMINDEX_GE_1; DOT_LSUB; DOT_RSUB; LE_REFL; VECTOR_MUL_COMPONENT; VEC_COMPONENT; BASIS_COMPONENT; DOT_LZERO; DOT_RZERO; VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);; let DIST_DECREASES_CLOSED_SEGMENT = prove (`!a b c x:real^N. x IN segment[a,b] ==> dist(c,x) <= dist(c,a) \/ dist(c,x) <= dist(c,b)`, REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN ASM_MESON_TAC[DIST_DECREASES_OPEN_SEGMENT; REAL_LE_REFL; REAL_LT_IMP_LE]);; (* ------------------------------------------------------------------------- *) (* Limit component bounds. *) (* ------------------------------------------------------------------------- *) let LIM_COMPONENT_UBOUND = prove (`!net:(A)net f (l:real^N) b k. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. (f x)$k <= b) net /\ 1 <= k /\ k <= dimindex(:N) ==> l$k <= b`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->real^N`; `{y:real^N | basis k dot y <= b}`; `l:real^N`] LIM_IN_CLOSED_SET) THEN ASM_SIMP_TAC[CLOSED_HALFSPACE_LE; IN_ELIM_THM; DOT_BASIS]);; let LIM_COMPONENT_LBOUND = prove (`!net:(A)net f (l:real^N) b k. ~(trivial_limit net) /\ (f --> l) net /\ eventually (\x. b <= (f x)$k) net /\ 1 <= k /\ k <= dimindex(:N) ==> b <= l$k`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`net:(A)net`; `f:A->real^N`; `{y:real^N | b <= basis k dot y}`; `l:real^N`] LIM_IN_CLOSED_SET) THEN ASM_SIMP_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_GE; IN_ELIM_THM; DOT_BASIS]);; let LIM_COMPONENT_EQ = prove (`!net f:A->real^N i l b. (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) /\ ~(trivial_limit net) /\ eventually (\x. f(x)$i = b) net ==> l$i = b`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; EVENTUALLY_AND] THEN MESON_TAC[LIM_COMPONENT_UBOUND; LIM_COMPONENT_LBOUND]);; let LIM_COMPONENT_LE = prove (`!net:(A)net f:A->real^N g:A->real^N k l m. ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ eventually (\x. (f x)$k <= (g x)$k) net /\ 1 <= k /\ k <= dimindex(:N) ==> l$k <= m$k`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; LIM_COMPONENT_LBOUND] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b /\ a ==> c ==> d`] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; LIM_COMPONENT_LBOUND]);; let LIM_DROP_LE = prove (`!net:(A)net f g l m. ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ eventually (\x. drop(f x) <= drop(g x)) net ==> drop l <= drop m`, REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `net:(A)net` LIM_COMPONENT_LE) THEN MAP_EVERY EXISTS_TAC [`f:A->real^1`; `g:A->real^1`] THEN ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; let LIM_DROP_UBOUND = prove (`!net f:A->real^1 l b. (f --> l) net /\ ~(trivial_limit net) /\ eventually (\x. drop(f x) <= b) net ==> drop l <= b`, SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_COMPONENT_UBOUND THEN REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; let LIM_DROP_LBOUND = prove (`!net f:A->real^1 l b. (f --> l) net /\ ~(trivial_limit net) /\ eventually (\x. b <= drop(f x)) net ==> b <= drop l`, SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Also extending closed bounds to closures. *) (* ------------------------------------------------------------------------- *) let IMAGE_CLOSURE_SUBSET = prove (`!f (s:real^N->bool) (t:real^M->bool). f continuous_on closure s /\ closed t /\ IMAGE f s SUBSET t ==> IMAGE f (closure s) SUBSET t`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `closure s SUBSET {x | (f:real^N->real^M) x IN t}` MP_TAC THENL [MATCH_MP_TAC SUBSET_TRANS; SET_TAC []] THEN EXISTS_TAC `{x | x IN closure s /\ (f:real^N->real^M) x IN t}` THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSURE_MINIMAL; SET_TAC[]] THEN ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CLOSURE] THEN MP_TAC (ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);; let CLOSURE_IMAGE_CLOSURE = prove (`!f:real^M->real^N s. f continuous_on closure s ==> closure(IMAGE f (closure s)) = closure(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN SIMP_TAC[SUBSET_CLOSURE; IMAGE_SUBSET; CLOSURE_SUBSET] THEN SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_CLOSURE] THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET]);; let CLOSURE_IMAGE_BOUNDED = prove (`!f:real^M->real^N s. f continuous_on closure s /\ bounded s ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `closure(IMAGE (f:real^M->real^N) (closure s))` THEN CONJ_TAC THENL [ASM_MESON_TAC[CLOSURE_IMAGE_CLOSURE]; ALL_TAC] THEN MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]);; let CONTINUOUS_ON_CLOSURE_NORM_LE = prove (`!f:real^N->real^M s x b. f continuous_on (closure s) /\ (!y. y IN s ==> norm(f y) <= b) /\ x IN (closure s) ==> norm(f x) <= b`, REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET cball(vec 0,b)` MP_TAC THENL [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN ASM_REWRITE_TAC [CLOSED_CBALL] THEN ASM SET_TAC []);; let CONTINUOUS_ON_CLOSURE_COMPONENT_LE = prove (`!f:real^N->real^M s x b k. f continuous_on (closure s) /\ (!y. y IN s ==> (f y)$k <= b) /\ x IN (closure s) ==> (f x)$k <= b`, REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k <= b}` MP_TAC THENL [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM SET_TAC[]);; let CONTINUOUS_ON_CLOSURE_COMPONENT_GE = prove (`!f:real^N->real^M s x b k. f continuous_on (closure s) /\ (!y. y IN s ==> b <= (f y)$k) /\ x IN (closure s) ==> b <= (f x)$k`, REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k >= b}` MP_TAC THENL [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC [real_ge]] THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM SET_TAC[real_ge]);; (* ------------------------------------------------------------------------- *) (* Limits relative to a union. *) (* ------------------------------------------------------------------------- *) let LIM_WITHIN_UNION = prove (`(f --> l) (at x within (s UNION t)) <=> (f --> l) (at x within s) /\ (f --> l) (at x within t)`, REWRITE_TAC[LIM_WITHIN; IN_UNION; AND_FORALL_THM] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `k:real`)) THEN EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_UNION = prove (`!f s t. closed s /\ closed t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REWRITE_TAC[CONTINUOUS_ON; CLOSED_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; let CONTINUOUS_ON_CASES = prove (`!P f g:real^M->real^N s t. closed s /\ closed t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_UNION_LOCAL = prove (`!f:real^M->real^N s. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ f continuous_on t ==> f continuous_on (s UNION t)`, REWRITE_TAC[CONTINUOUS_ON; CLOSED_IN_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; let CONTINUOUS_ON_CASES_LOCAL = prove (`!P f g:real^M->real^N s t. closed_in (subtopology euclidean (s UNION t)) s /\ closed_in (subtopology euclidean (s UNION t)) t /\ f continuous_on s /\ g continuous_on t /\ (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let CONTINUOUS_ON_CASES_LE = prove (`!f g:real^M->real^N h s a. f continuous_on {t | t IN s /\ h t <= a} /\ g continuous_on {t | t IN s /\ a <= h t} /\ (lift o h) continuous_on s /\ (!t. t IN s /\ h t = a ==> f t = g t) ==> (\t. if h t <= a then f(t) else g(t)) continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `{t | t IN s /\ (h:real^M->real) t <= a} UNION {t | t IN s /\ a <= h t}` THEN CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUBSET; IN_UNION; IN_ELIM_THM; REAL_LE_TOTAL]] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; REAL_LE_ANTISYM] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN CONJ_TAC THENL [SUBGOAL_THEN `{t | t IN s /\ (h:real^M->real) t <= a} = {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ (lift o h) t IN {x | x$1 <= a}}` (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THENL [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; IN_UNION] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]]; SUBGOAL_THEN `{t | t IN s /\ a <= (h:real^M->real) t} = {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ (lift o h) t IN {x | x$1 >= a}}` (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THENL [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; IN_UNION] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE; ETA_AX] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]]]);; let CONTINUOUS_ON_CASES_1 = prove (`!f g:real^1->real^N s a. f continuous_on {t | t IN s /\ drop t <= a} /\ g continuous_on {t | t IN s /\ a <= drop t} /\ (lift a IN s ==> f(lift a) = g(lift a)) ==> (\t. if drop t <= a then f(t) else g(t)) continuous_on s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN ASM_MESON_TAC[]);; let EXTENSION_FROM_CLOPEN = prove (`!f:real^M->real^N s t u. open_in (subtopology euclidean s) t /\ closed_in (subtopology euclidean s) t /\ f continuous_on t /\ IMAGE f t SUBSET u /\ (u = {} ==> s = {}) ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ !x. x IN t ==> g x = f x`, REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; SUBSET_EMPTY; IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else a` THEN SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SUBGOAL_THEN `s:real^M->bool = t UNION (s DIFF t)` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`] THEN REWRITE_TAC[CONTINUOUS_ON_CONST; IN_DIFF] THEN CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF; MESON_TAC[]] THEN ASM_REWRITE_TAC[CLOSED_IN_REFL]);; (* ------------------------------------------------------------------------- *) (* Componentwise limits and continuity. *) (* ------------------------------------------------------------------------- *) let LIM_COMPONENTWISE_LIFT = prove (`!net f:A->real^N. (f --> l) net <=> !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. lift((f x)$i)) --> lift(l$i)) net`, REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN GEN_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH `y <= x ==> x < e ==> y < e`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM LIFT_SUB; NORM_LIFT; GSYM VECTOR_SUB_COMPONENT]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[GSYM IN_NUMSEG; RIGHT_FORALL_IMP_THM] THEN SIMP_TAC[FORALL_EVENTUALLY; FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN REWRITE_TAC[DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN X_GEN_TAC `x:A` THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist] THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1; CARD_NUMSEG_1; GSYM IN_NUMSEG]]);; let CONTINUOUS_COMPONENTWISE_LIFT = prove (`!net f:A->real^N. f continuous net <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift((f x)$i)) continuous net`, REWRITE_TAC[continuous; GSYM LIM_COMPONENTWISE_LIFT]);; let CONTINUOUS_ON_COMPONENTWISE_LIFT = prove (`!f:real^M->real^N s. f continuous_on s <=> !i. 1 <= i /\ i <= dimindex(:N) ==> (\x. lift((f x)$i)) continuous_on s`, REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONTINUOUS_COMPONENTWISE_LIFT] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some more convenient intermediate-value theorem formulations. *) (* ------------------------------------------------------------------------- *) let CONNECTED_IVT_HYPERPLANE = prove (`!s x y:real^N a b. connected s /\ x IN s /\ y IN s /\ a dot x <= b /\ b <= a dot y ==> ?z. z IN s /\ a dot z = b`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`{x:real^N | a dot x < b}`; `{x:real^N | a dot x > b}`]) THEN REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; SUBSET; IN_UNION; REAL_LT_LE; real_gt] THEN ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM]);; let CONNECTED_IVT_COMPONENT = prove (`!s x y:real^N a k. connected s /\ x IN s /\ y IN s /\ 1 <= k /\ k <= dimindex(:N) /\ x$k <= a /\ a <= y$k ==> ?z. z IN s /\ z$k = a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `y:real^N`; `(basis k):real^N`; `a:real`] CONNECTED_IVT_HYPERPLANE) THEN ASM_SIMP_TAC[DOT_BASIS]);; (* ------------------------------------------------------------------------- *) (* Rather trivial observation that we can map any connected set on segment. *) (* ------------------------------------------------------------------------- *) let MAPPING_CONNECTED_ONTO_SEGMENT = prove (`!s:real^M->bool a b:real^N. connected s /\ ~(?a. s SUBSET {a}) ==> ?f. f continuous_on s /\ IMAGE f s = segment[a,b]`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(?a. s SUBSET {a}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`)) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^M. a + dist(u,x) / (dist(u,x) + dist(v,x)) % (b - a:real^N)` THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST]; REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN MATCH_MP_TAC(SET_RULE `IMAGE f s = {x | P x} ==> IMAGE (\x. a + f x % b) s = {a + u % b:real^N | P u}`) THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_ARITH `~(u:real^N = v) ==> &0 < dist(u,x) + dist(v,x)`] THEN CONJ_TAC THENL [CONV_TAC NORM_ARITH; REWRITE_TAC[IN_IMAGE]] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (\x:real^M. lift(dist(u,x) / (dist(u,x) + dist(v,x)))) s`; `vec 0:real^1`; `vec 1:real^1`; `t:real`; `1`] CONNECTED_IVT_COMPONENT) THEN ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH_LE] THEN REWRITE_TAC[EXISTS_IN_IMAGE; GSYM drop; LIFT_DROP] THEN ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE]; MESON_TAC[]] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[]; EXISTS_TAC `u:real^M` THEN ASM_REWRITE_TAC[DIST_REFL; real_div] THEN REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN REAL_ARITH_TAC; EXISTS_TAC `v:real^M` THEN ASM_REWRITE_TAC[DIST_REFL] THEN ASM_SIMP_TAC[REAL_DIV_REFL; DIST_EQ_0; REAL_ADD_RID] THEN REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]]] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_DIST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[LIFT_ADD; NORM_ARITH `~(u:real^N = v) ==> ~(dist(u,x) + dist(v,x) = &0)`] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]);; (* ------------------------------------------------------------------------- *) (* Also more convenient formulations of monotone convergence. *) (* ------------------------------------------------------------------------- *) let BOUNDED_INCREASING_CONVERGENT = prove (`!s:num->real^1. bounded {s n | n IN (:num)} /\ (!n. drop(s n) <= drop(s(SUC n))) ==> ?l. (s --> l) sequentially`, GEN_TAC THEN REWRITE_TAC[bounded; IN_ELIM_THM; ABS_DROP; LIM_SEQUENTIALLY; dist; DROP_SUB; IN_UNIV; GSYM EXISTS_DROP] THEN DISCH_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISJ1_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; let BOUNDED_DECREASING_CONVERGENT = prove (`!s:num->real^1. bounded {s n | n IN (:num)} /\ (!n. drop(s(SUC n)) <= drop(s(n))) ==> ?l. (s --> l) sequentially`, GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC(ISPEC `\n. --((s:num->real^1) n)` BOUNDED_INCREASING_CONVERGENT) THEN ASM_SIMP_TAC[bounded; FORALL_IN_GSPEC; NORM_NEG; DROP_NEG; REAL_LE_NEG2] THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM LIM_NEG_EQ] THEN REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Since we'll use some cardinality reasoning, add invariance theorems. *) (* ------------------------------------------------------------------------- *) let card_translation_invariants = (CONJUNCTS o prove) (`(!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s =_c t <=> s =_c t) /\ (!a (s:A->bool) (t:real^N->bool). s =_c IMAGE (\x. a + x) t <=> s =_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s <_c t <=> s <_c t) /\ (!a (s:A->bool) (t:real^N->bool). s <_c IMAGE (\x. a + x) t <=> s <_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s <=_c t <=> s <=_c t) /\ (!a (s:A->bool) (t:real^N->bool). s <=_c IMAGE (\x. a + x) t <=> s <=_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s >_c t <=> s >_c t) /\ (!a (s:A->bool) (t:real^N->bool). s >_c IMAGE (\x. a + x) t <=> s >_c t) /\ (!a (s:real^N->bool) (t:A->bool). IMAGE (\x. a + x) s >=_c t <=> s >=_c t) /\ (!a (s:A->bool) (t:real^N->bool). s >=_c IMAGE (\x. a + x) t <=> s >=_c t)`, REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG] THEN REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]) in add_translation_invariants card_translation_invariants;; let card_linear_invariants = (CONJUNCTS o prove) (`(!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s =_c t <=> s =_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s =_c IMAGE f t <=> s =_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s <_c t <=> s <_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s <_c IMAGE f t <=> s <_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s <=_c t <=> s <=_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s <=_c IMAGE f t <=> s <=_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s >_c t <=> s >_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s >_c IMAGE f t <=> s >_c t)) /\ (!(f:real^M->real^N) s (t:A->bool). linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s >=_c t <=> s >=_c t)) /\ (!(f:real^M->real^N) (s:A->bool) t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s >=_c IMAGE f t <=> s >=_c t))`, REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_EQ_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LT_CONG; MATCH_MP_TAC CARD_LE_CONG; MATCH_MP_TAC CARD_LE_CONG] THEN REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN ASM_MESON_TAC[]) in add_linear_invariants card_linear_invariants;; (* ------------------------------------------------------------------------- *) (* Basic homeomorphism definitions. *) (* ------------------------------------------------------------------------- *) let homeomorphism = new_definition `homeomorphism (s,t) (f,g) <=> (!x. x IN s ==> (g(f(x)) = x)) /\ (IMAGE f s = t) /\ f continuous_on s /\ (!y. y IN t ==> (f(g(y)) = y)) /\ (IMAGE g t = s) /\ g continuous_on t`;; parse_as_infix("homeomorphic",(12,"right"));; let homeomorphic = new_definition `s homeomorphic t <=> ?f g. homeomorphism (s,t) (f,g)`;; let HOMEOMORPHISM = prove (`!s:real^M->bool t:real^N->bool f g. homeomorphism (s,t) (f,g) <=> f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET s /\ (!x. x IN s ==> g (f x) = x) /\ (!y. y IN t ==> f (g y) = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN EQ_TAC THEN SIMP_TAC[] THEN SET_TAC[]);; let HOMEOMORPHISM_OF_SUBSETS = prove (`!f g s t s' t'. homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ IMAGE f s' = t' ==> homeomorphism (s',t') (f,g)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_SUBSET) THEN ASM SET_TAC[]);; let HOMEOMORPHISM_ID = prove (`!s:real^N->bool. homeomorphism (s,s) ((\x. x),(\x. x))`, REWRITE_TAC[homeomorphism; IMAGE_ID; CONTINUOUS_ON_ID]);; let HOMEOMORPHISM_I = prove (`!s:real^N->bool. homeomorphism (s,s) (I,I)`, REWRITE_TAC[I_DEF; HOMEOMORPHISM_ID]);; let HOMEOMORPHIC_REFL = prove (`!s:real^N->bool. s homeomorphic s`, REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_I]);; let HOMEOMORPHISM_SYM = prove (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) <=> homeomorphism (t,s) (g,f)`, REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);; let HOMEOMORPHIC_SYM = prove (`!s t. s homeomorphic t <=> t homeomorphic s`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);; let HOMEOMORPHISM_COMPOSE = prove (`!f:real^M->real^N g h:real^N->real^P k s t u. homeomorphism (s,t) (f,g) /\ homeomorphism (t,u) (h,k) ==> homeomorphism (s,u) (h o f,g o k)`, SIMP_TAC[homeomorphism; CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM] THEN SET_TAC[]);; let HOMEOMORPHIC_TRANS = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. s homeomorphic t /\ t homeomorphic u ==> s homeomorphic u`, REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPOSE]);; let HOMEOMORPHIC_IMP_CARD_EQ = prove (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> s =_c t`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism; eq_c] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; let HOMEOMORPHIC_EMPTY = prove (`(!s. (s:real^N->bool) homeomorphic ({}:real^M->bool) <=> s = {}) /\ (!s. ({}:real^M->bool) homeomorphic (s:real^N->bool) <=> s = {})`, REWRITE_TAC[homeomorphic; homeomorphism; IMAGE_CLAUSES; IMAGE_EQ_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[continuous_on; NOT_IN_EMPTY]);; let HOMEOMORPHIC_MINIMAL = prove (`!s t. s homeomorphic t <=> ?f g. (!x. x IN s ==> f(x) IN t /\ (g(f(x)) = x)) /\ (!y. y IN t ==> g(y) IN s /\ (f(g(y)) = y)) /\ f continuous_on s /\ g continuous_on t`, REWRITE_TAC[homeomorphic; homeomorphism; EXTENSION; IN_IMAGE] THEN REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[]);; let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (IMAGE f s) homeomorphic s`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; FORALL_IN_IMAGE; FUN_IN_IMAGE] THEN ASM_SIMP_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e * B:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[dist; GSYM LINEAR_SUB] THEN DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> ((IMAGE f s) homeomorphic t <=> s homeomorphic t)`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o MATCH_MP HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF) THEN EQ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]); POP_ASSUM MP_TAC] THEN REWRITE_TAC[IMP_IMP; HOMEOMORPHIC_TRANS]);; let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove (`!f:real^M->real^N s t. linear f /\ (!x y. f x = f y ==> x = y) ==> (s homeomorphic (IMAGE f t) <=> s homeomorphic t)`, ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);; add_linear_invariants [HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];; let HOMEOMORPHIC_TRANSLATION_SELF = prove (`!a:real^N s. (IMAGE (\x. a + x) s) homeomorphic s`, REPEAT GEN_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `\x:real^N. x - a` THEN EXISTS_TAC `\x:real^N. a + x` THEN SIMP_TAC[FORALL_IN_IMAGE; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ADD; VECTOR_ADD_SUB] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; let HOMEOMORPHIC_TRANSLATION_LEFT_EQ = prove (`!a:real^N s t. (IMAGE (\x. a + x) s) homeomorphic t <=> s homeomorphic t`, MESON_TAC[HOMEOMORPHIC_TRANSLATION_SELF; HOMEOMORPHIC_SYM; HOMEOMORPHIC_TRANS]);; let HOMEOMORPHIC_TRANSLATION_RIGHT_EQ = prove (`!a:real^N s t. s homeomorphic (IMAGE (\x. a + x) t) <=> s homeomorphic t`, ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ]);; add_translation_invariants [HOMEOMORPHIC_TRANSLATION_LEFT_EQ; HOMEOMORPHIC_TRANSLATION_RIGHT_EQ];; let HOMEOMORPHISM_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) ==> !u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[SUBSET_REFL]);; let HOMEOMORPHIC_PCROSS = prove (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool. s homeomorphic s' /\ t homeomorphic t' ==> (s PCROSS t) homeomorphic (s' PCROSS t')`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:real^M->real^P` (X_CHOOSE_THEN `f':real^P->real^M` STRIP_ASSUME_TAC)) (X_CHOOSE_THEN `g:real^N->real^Q` (X_CHOOSE_THEN `g':real^Q->real^N` STRIP_ASSUME_TAC))) THEN MAP_EVERY EXISTS_TAC [`(\z. pastecart (f(fstcart z)) (g(sndcart z))) :real^(M,N)finite_sum->real^(P,Q)finite_sum`; `(\z. pastecart (f'(fstcart z)) (g'(sndcart z))) :real^(P,Q)finite_sum->real^(M,N)finite_sum`] THEN ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);; let HOMEOMORPHIC_PCROSS_SYM = prove (`!s:real^M->bool t:real^N->bool. (s PCROSS t) homeomorphic (t PCROSS s)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) :real^(M,N)finite_sum->real^(N,M)finite_sum` THEN EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) :real^(N,M)finite_sum->real^(M,N)finite_sum` THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; PASTECART_IN_PCROSS] THEN MESON_TAC[]);; let HOMEOMORPHIC_PCROSS_ASSOC = prove (`!s:real^M->bool t:real^N->bool u:real^P->bool. (s PCROSS (t PCROSS u)) homeomorphic ((s PCROSS t) PCROSS u)`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC [`\z:real^(M,(N,P)finite_sum)finite_sum. pastecart (pastecart (fstcart z) (fstcart(sndcart z))) (sndcart(sndcart z))`; `\z:real^((M,N)finite_sum,P)finite_sum. pastecart (fstcart(fstcart z)) (pastecart (sndcart(fstcart z)) (sndcart z))`] THEN REWRITE_TAC[FORALL_IN_PCROSS; SUBSET; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN TRY(GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN MATCH_MP_TAC LINEAR_COMPOSE) THEN REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; let HOMEOMORPHIC_SCALING_LEFT = prove (`!c. &0 < c ==> !s t. (IMAGE (\x. c % x) s) homeomorphic t <=> s homeomorphic t`, REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; let HOMEOMORPHIC_SCALING_RIGHT = prove (`!c. &0 < c ==> !s t. s homeomorphic (IMAGE (\x. c % x) t) <=> s homeomorphic t`, REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ THEN ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; let HOMEOMORPHIC_SUBSPACES = prove (`!s:real^M->bool t:real^N->bool. subspace s /\ subspace t /\ dim s = dim t ==> s homeomorphic t`, REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; let HOMEOMORPHIC_FINITE = prove (`!s:real^M->bool t:real^N->bool. FINITE s /\ FINITE t ==> (s homeomorphic t <=> CARD s = CARD t)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN ASM_SIMP_TAC[CARD_EQ_CARD]; STRIP_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`] CARD_EQ_BIJECTIONS) THEN ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_FINITE] THEN ASM SET_TAC[]]);; let HOMEOMORPHIC_FINITE_STRONG = prove (`!s:real^M->bool t:real^N->bool. FINITE s \/ FINITE t ==> (s homeomorphic t <=> FINITE s /\ FINITE t /\ CARD s = CARD t)`, REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN SIMP_TAC[HOMEOMORPHIC_FINITE] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);; let HOMEOMORPHIC_SING = prove (`!a:real^M b:real^N. {a} homeomorphic {b}`, SIMP_TAC[HOMEOMORPHIC_FINITE; FINITE_SING; CARD_SING]);; let HOMEOMORPHIC_PCROSS_SING = prove (`(!s:real^M->bool a:real^N. s homeomorphic (s PCROSS {a})) /\ (!s:real^M->bool a:real^N. s homeomorphic ({a} PCROSS s))`, MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL [MESON_TAC[HOMEOMORPHIC_PCROSS_SYM; HOMEOMORPHIC_TRANS]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN EXISTS_TAC `\x. (pastecart x a:real^(M,N)finite_sum)` THEN EXISTS_TAC `fstcart:real^(M,N)finite_sum->real^M` THEN SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN SIMP_TAC[FSTCART_PASTECART]);; (* ------------------------------------------------------------------------- *) (* Inverse function property for open/closed maps. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_ON_INVERSE_OPEN_MAP = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) ==> g continuous_on t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] CONTINUOUS_ON_OPEN_GEN) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN ASM SET_TAC[]);; let CONTINUOUS_ON_INVERSE_CLOSED_MAP = prove (`!f:real^M->real^N g s t. f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) ==> g continuous_on t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] CONTINUOUS_ON_CLOSED_GEN) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]);; let HOMEOMORPHISM_INJECTIVE_OPEN_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN ASM_MESON_TAC[]);; let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);; let HOMEOMORPHISM_IMP_OPEN_MAP = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = {y | y IN t /\ g(y) IN u}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]);; let HOMEOMORPHISM_IMP_CLOSED_MAP = prove (`!f:real^M->real^N g s t u. homeomorphism (s,t) (f,g) /\ closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)`, REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = {y | y IN t /\ g(y) IN u}` SUBST1_TAC THENL [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_IMP_CLOSED_IN THEN ASM_REWRITE_TAC[]]);; let HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((?g. homeomorphism (s,t) (f,g)) <=> !u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN ASM_REWRITE_TAC[]]);; let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((?g. homeomorphism (s,t) (f,g)) <=> !u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN ASM_MESON_TAC[]; MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN ASM_REWRITE_TAC[]]);; let INJECTIVE_MAP_OPEN_IFF_CLOSED = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((!u. open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> (!u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `?g:real^N->real^M. homeomorphism (s,t) (f,g)` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Relatively weak hypotheses if the domain of the function is compact. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_IMP_CLOSED_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ compact s ==> !u. closed_in (subtopology euclidean s) u ==> closed_in (subtopology euclidean t) (IMAGE f u)`, SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN EXPAND_TAC "t" THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]);; let CONTINUOUS_IMP_QUOTIENT_MAP = prove (`!f:real^M->real^N s t. f continuous_on s /\ IMAGE f s = t /\ compact s ==> !u. u SUBSET t ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> open_in (subtopology euclidean t) u)`, REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_IMP_CLOSED_MAP THEN ASM_REWRITE_TAC[]);; let CONTINUOUS_ON_INVERSE = prove (`!f:real^M->real^N g s. f continuous_on s /\ compact s /\ (!x. x IN s ==> (g(f(x)) = x)) ==> g continuous_on (IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN SUBGOAL_THEN `IMAGE g (IMAGE (f:real^M->real^N) s) = s` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]; REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET]]);; let HOMEOMORPHISM_COMPACT = prove (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> ?g. homeomorphism(s,t) (f,g)`, REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[EXTENSION; homeomorphism] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[CONTINUOUS_ON_INVERSE; IN_IMAGE]);; let HOMEOMORPHIC_COMPACT = prove (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> s homeomorphic t`, REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPACT]);; (* ------------------------------------------------------------------------- *) (* Lemmas about composition of homeomorphisms. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s = t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (?h. homeomorphism (s,u) (g o f,h)) ==> (?f'. homeomorphism (s,t) (f,f')) /\ (?g'. homeomorphism (t,u) (g,g'))`, REPEAT GEN_TAC THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_SURJECTIVE THEN MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[homeomorphism; o_THM]; REWRITE_TAC[homeomorphism; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `g':real^P->real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(h:real^P->real^M) o (g:real^N->real^P)` THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; let HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE = prove (`!f:real^M->real^N g:real^N->real^P s t u. f continuous_on s /\ IMAGE f s SUBSET t /\ g continuous_on t /\ IMAGE g t SUBSET u /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ (?h. homeomorphism (s,u) (g o f,h)) ==> (?f'. homeomorphism (s,t) (f,f')) /\ (?g'. homeomorphism (t,u) (g,g'))`, REPEAT GEN_TAC THEN STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_INJECTIVE THEN MAP_EVERY EXISTS_TAC [`g:real^N->real^P`; `u:real^P->bool`] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN ASM_REWRITE_TAC[homeomorphism; o_THM]; REWRITE_TAC[homeomorphism; o_THM] THEN DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^M` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:real^M->real^N) o (h:real^P->real^M)` THEN ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* Preservation of topological properties. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_COMPACTNESS = prove (`!s t. s homeomorphic t ==> (compact s <=> compact t)`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);; let HOMEOMORPHIC_CONNECTEDNESS = prove (`!s t. s homeomorphic t ==> (connected s <=> connected t)`, REWRITE_TAC[homeomorphic; homeomorphism] THEN MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Results on translation, scaling etc. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_SCALING = prove (`!s:real^N->bool c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MAP_EVERY EXISTS_TAC [`\x:real^N. c % x`; `\x:real^N. inv(c) % x`] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN SIMP_TAC[VECTOR_MUL_LID; IN_IMAGE; REAL_MUL_LID] THEN MESON_TAC[]);; let HOMEOMORPHIC_TRANSLATION = prove (`!s a:real^N. s homeomorphic (IMAGE (\x. a + x) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN MAP_EVERY EXISTS_TAC [`\x:real^N. a + x`; `\x:real^N. --a + x`] THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN SIMP_TAC[VECTOR_ADD_ASSOC; VECTOR_ADD_LINV; VECTOR_ADD_RINV; FORALL_IN_IMAGE; VECTOR_ADD_LID] THEN REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; let HOMEOMORPHIC_AFFINITY = prove (`!s a:real^N c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. a + c % x) s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_TRANS THEN EXISTS_TAC `IMAGE (\x:real^N. c % x) s` THEN ASM_SIMP_TAC[HOMEOMORPHIC_SCALING] THEN SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN REWRITE_TAC[IMAGE_o; HOMEOMORPHIC_TRANSLATION]);; let [HOMEOMORPHIC_BALLS; HOMEOMORPHIC_CBALLS; HOMEOMORPHIC_SPHERES] = (CONJUNCTS o prove) (`(!a:real^N b:real^N d e. &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e)) /\ (!a:real^N b:real^N d e. &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e)) /\ (!a:real^N b:real^N d e. &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))`, REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `\x:real^N. b + (e / d) % (x - a)` THEN EXISTS_TAC `\x:real^N. a + (d / e) % (x - b)` THEN ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; IN_BALL; IN_CBALL; IN_SPHERE] THEN REWRITE_TAC[dist; VECTOR_ARITH `a - (a + b) = --b:real^N`; NORM_NEG] THEN REWRITE_TAC[real_div; VECTOR_ARITH `a + d % ((b + e % (x - a)) - b) = (&1 - d * e) % a + (d * e) % x`] THEN ONCE_REWRITE_TAC[REAL_ARITH `(e * d') * (d * e') = (d * d') * (e * e')`] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID; REAL_SUB_REFL] THEN REWRITE_TAC[NORM_MUL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ARITH `&0 < x ==> (abs x = x)`] THEN GEN_REWRITE_TAC(BINOP_CONV o BINDER_CONV o funpow 2 RAND_CONV) [GSYM REAL_MUL_RID] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID; GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; NORM_SUB] THEN ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_RID]);; (* ------------------------------------------------------------------------- *) (* Homeomorphism of one-point compactifications. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS = prove (`!s:real^M->bool t:real^N->bool a b. compact s /\ compact t /\ a IN s /\ b IN t /\ (s DELETE a) homeomorphic (t DELETE b) ==> s homeomorphic t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN STRIP_TAC THEN EXISTS_TAC `\x. if x = a then b else (f:real^M->real^N) x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^M = a` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL [`b:real^N`; `e:real`] CENTRE_IN_BALL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `closed_in (subtopology euclidean s) { x | x IN (s DELETE a) /\ (f:real^M->real^N)(x) IN t DIFF ball(b,e)}` MP_TAC THENL [MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBGOAL_THEN `{x | x IN s DELETE a /\ f x IN t DIFF ball(b,e)} = IMAGE (g:real^N->real^M) (t DIFF ball (b,e))` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[COMPACT_DIFF; OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; REWRITE_TAC[closed_in; open_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_THEN(MP_TAC o SPEC `a:real^M` o last o CONJUNCTS) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF; IN_DELETE] THEN SIMP_TAC[IMP_CONJ; DE_MORGAN_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM SET_TAC[]]; UNDISCH_TAC `(f:real^M->real^N) continuous_on (s DELETE a)` THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN REWRITE_TAC[continuous_within] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d (dist(a:real^M,x))` THEN ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ] THEN ASM_MESON_TAC[REAL_LT_REFL]]);; (* ------------------------------------------------------------------------- *) (* Homeomorphisms between open intervals in real^1 and then in real^N. *) (* Could prove similar things for closed intervals, but they drop out of *) (* later stuff in "convex.ml" even more easily. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_OPEN_INTERVALS_1 = prove (`!a b c d. drop a < drop b /\ drop c < drop d ==> interval(a,b) homeomorphic interval(c,d)`, SUBGOAL_THEN `!a b. drop a < drop b ==> interval(vec 0:real^1,vec 1) homeomorphic interval(a,b)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `(\x. a + drop x % (b - a)):real^1->real^1` THEN EXISTS_TAC `(\x. inv(drop b - drop a) % (x - a)):real^1->real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; DROP_SUB] THEN REWRITE_TAC[REAL_ARITH `inv b * a:real = a / b`] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT; REAL_LT_ADDR; REAL_EQ_LDIV_EQ; REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_MUL; REAL_MUL_LZERO; REAL_ADD_SUB; REAL_LT_RMUL_EQ; REAL_ARITH `a + x < b <=> x < &1 * (b - a)`] THEN REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]; MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]]; REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `d:real^1`]) THEN ASM_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_TRANS]]);; let HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1 = prove (`!a b. drop a < drop b ==> interval(a,b) homeomorphic (:real^1)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:real^1`; `b:real^1`; `--vec 1:real^1`; `vec 1:real^1`] HOMEOMORPHIC_OPEN_INTERVALS_1) THEN ASM_REWRITE_TAC[DROP_VEC; DROP_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_UNIV] THEN EXISTS_TAC `\x:real^1. inv(&1 - norm x) % x` THEN EXISTS_TAC `\y. if &0 <= drop y then inv(&1 + drop y) % y else inv(&1 - drop y) % y` THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN REWRITE_TAC[DROP_NEG; DROP_VEC; DROP_CMUL; NORM_REAL; GSYM drop] THEN SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LE_MUL_EQ; REAL_ARITH `--a < x /\ x < a ==> &0 < a - abs x`] THEN SIMP_TAC[real_abs; VECTOR_MUL_ASSOC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; X_GEN_TAC `y:real^1` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; REAL_BOUNDS_LT] THEN REWRITE_TAC[DROP_CMUL; REAL_ABS_MUL; REAL_ABS_INV] THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < abs(&1 + x)`; REAL_ARITH `~(&0 <= x) ==> &0 < abs(&1 - x)`] THEN (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN REWRITE_TAC[NORM_REAL; VECTOR_MUL_ASSOC] THEN REWRITE_TAC[GSYM drop; DROP_CMUL; REAL_ABS_MUL] THEN ASM_REWRITE_TAC[real_abs; REAL_LE_INV_EQ] THEN ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 <= &1 + x`; REAL_ARITH `~(&0 <= x) ==> &0 <= &1 - x`] THEN GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC] THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_SUB; LIFT_DROP] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_SUB THEN SIMP_TAC[CONTINUOUS_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]; REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC]; SUBGOAL_THEN `(:real^1) = {x | x$1 >= &0} UNION {x | x$1 <= &0}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_ON_CASES THEN REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE; IN_ELIM_THM] THEN REWRITE_TAC[GSYM drop; REAL_NOT_LE; real_ge; REAL_LET_ANTISYM] THEN SIMP_TAC[REAL_LE_ANTISYM; REAL_SUB_RZERO; REAL_ADD_RID] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_ADD; LIFT_SUB; LIFT_DROP] THEN ASM_SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_SUB; CONTINUOUS_CONST] THEN ASM_REAL_ARITH_TAC]]);; let HOMEOMORPHIC_OPEN_INTERVALS = prove (`!a b:real^N c d:real^N. (interval(a,b) = {} <=> interval(c,d) = {}) ==> interval(a,b) homeomorphic interval(c,d)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(c:real^N,d) = {}` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic interval(lift((c:real^N)$i),lift((d:real^N)$i))` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVALS_1; LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN EXISTS_TAC `(\x. lambda i. drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; EXISTS_TAC `interval(lift((c:real^N)$i),lift((d:real^N)$i))`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; let HOMEOMORPHIC_OPEN_INTERVAL_UNIV = prove (`!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) homeomorphic (:real^N)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic (:real^1)` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; LIFT_DROP]; ALL_TAC] THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN DISCH_TAC THEN EXISTS_TAC `(\x. lambda i. drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN EXISTS_TAC `(\x. lambda i. drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP; IN_UNIV] THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; EXISTS_TAC `(:real^1)`] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; IN_UNIV] THEN ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; let HOMEOMORPHIC_BALL_UNIV = prove (`!a:real^N r. &0 < r ==> ball(a,r) homeomorphic (:real^N)`, REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `?y:real^N. r = norm(y)` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_LT_IMP_LE]; POP_ASSUM MP_TAC] THEN REWRITE_TAC[NORM_POS_LT] THEN GEOM_NORMALIZE_TAC `y:real^N` THEN SIMP_TAC[] THEN GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN EXISTS_TAC `\z:real^N. inv(&1 - norm(z)) % z` THEN EXISTS_TAC `\z:real^N. inv(&1 + norm(z)) % z` THEN REWRITE_TAC[IN_BALL; IN_UNIV; DIST_0; VECTOR_MUL_ASSOC; VECTOR_MUL_EQ_0; VECTOR_ARITH `a % x:real^N = x <=> (a - &1) % x = vec 0`] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISJ1_TAC THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> abs(&1 - x) = &1 - x`] THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; X_GEN_TAC `y:real^N` THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= y ==> inv(abs(&1 + y)) * z = z / (&1 + y)`] THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= y ==> &0 < &1 + y`] THEN CONJ_TAC THENL [REAL_ARITH_TAC; DISJ1_TAC] THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN MP_TAC(ISPEC `y:real^N` NORM_POS_LE) THEN CONV_TAC REAL_FIELD; MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_INV THEN SIMP_TAC[IN_BALL_0; REAL_SUB_0; REAL_ARITH `x < &1 ==> ~(&1 = x)`] THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_ID]; MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_INV THEN SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`] THEN REWRITE_TAC[o_DEF; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_ID]]);; (* ------------------------------------------------------------------------- *) (* Cardinalities of various useful sets. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_EUCLIDEAN = prove (`(:real^N) =_c (:real)`, MATCH_MP_TAC CARD_EQ_CART THEN REWRITE_TAC[real_INFINITE]);; let UNCOUNTABLE_EUCLIDEAN = prove (`~COUNTABLE(:real^N)`, MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]);; let CARD_EQ_INTERVAL = prove (`(!a b:real^N. ~(interval(a,b) = {}) ==> interval[a,b] =_c (:real)) /\ (!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) =_c (:real))`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; TRANS_TAC CARD_LE_TRANS `interval(a:real^N,b)` THEN SIMP_TAC[CARD_LE_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]; TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; ALL_TAC] THEN TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);; let UNCOUNTABLE_INTERVAL = prove (`(!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval[a,b])) /\ (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval(a,b)))`, SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_INTERVAL]);; let COUNTABLE_OPEN_INTERVAL = prove (`!a b. COUNTABLE(interval(a,b)) <=> interval(a,b) = {}`, MESON_TAC[COUNTABLE_EMPTY; UNCOUNTABLE_INTERVAL]);; let CARD_EQ_OPEN = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> s =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `interval[a:real^N,b]` THEN ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_INTERVAL]]);; let UNCOUNTABLE_OPEN = prove (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(COUNTABLE s)`, SIMP_TAC[CARD_EQ_OPEN; CARD_EQ_REAL_IMP_UNCOUNTABLE]);; let CARD_EQ_BALL = prove (`!a:real^N r. &0 < r ==> ball(a,r) =_c (:real)`, SIMP_TAC[CARD_EQ_OPEN; OPEN_BALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT]);; let CARD_EQ_CBALL = prove (`!a:real^N r. &0 < r ==> cball(a,r) =_c (:real)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_EQ_EUCLIDEAN]; TRANS_TAC CARD_LE_TRANS `ball(a:real^N,r)` THEN SIMP_TAC[CARD_LE_SUBSET; BALL_SUBSET_CBALL] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_BALL]]);; let FINITE_IMP_NOT_OPEN = prove (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> ~(open s)`, MESON_TAC[UNCOUNTABLE_OPEN; FINITE_IMP_COUNTABLE]);; let OPEN_IMP_INFINITE = prove (`!s. open s ==> s = {} \/ INFINITE s`, MESON_TAC[FINITE_IMP_NOT_OPEN; INFINITE]);; let EMPTY_INTERIOR_FINITE = prove (`!s:real^N->bool. FINITE s ==> interior s = {}`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_INTERIOR) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] FINITE_IMP_NOT_OPEN) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[INTERIOR_SUBSET]);; let CARD_EQ_CONNECTED = prove (`!s a b:real^N. connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, GEOM_ORIGIN_TAC `b:real^N` THEN GEOM_NORMALIZE_TAC `a:real^N` THEN REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE]; TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL [MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN SIMP_TAC[UNIT_INTERVAL_NONEMPTY; CARD_EQ_INTERVAL]; REWRITE_TAC[LE_C] THEN EXISTS_TAC `\x:real^N. lift(a dot x)` THEN SIMP_TAC[FORALL_LIFT; LIFT_EQ; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `a:real^N`] THEN ASM_REWRITE_TAC[DOT_RZERO]]]);; let UNCOUNTABLE_CONNECTED = prove (`!s a b:real^N. connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM_MESON_TAC[]);; let CARD_LT_IMP_DISCONNECTED = prove (`!s x:real^N. s <_c (:real) /\ x IN s ==> connected_component s x = {x}`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !a b. a IN s /\ b IN s /\ ~(a = b) ==> F`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN MP_TAC(ISPECL [`connected_component s (x:real^N)`; `a:real^N`; `b:real^N`] CARD_EQ_CONNECTED) THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN DISCH_TAC THEN UNDISCH_TAC `(s:real^N->bool) <_c (:real)` THEN REWRITE_TAC[CARD_NOT_LT] THEN TRANS_TAC CARD_LE_TRANS `connected_component s (x:real^N)` THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; let COUNTABLE_IMP_DISCONNECTED = prove (`!s x:real^N. COUNTABLE s /\ x IN s ==> connected_component s x = {x}`, SIMP_TAC[CARD_LT_IMP_DISCONNECTED; COUNTABLE_IMP_CARD_LT_REAL]);; let CONNECTED_CARD_EQ_IFF_NONTRIVIAL = prove (`!s:real^N->bool. connected s ==> (s =_c (:real) <=> ~(?a. s SUBSET {a}))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ALL_TAC; MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]] THEN FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_SING] THEN ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_IMP_COUNTABLE]);; (* ------------------------------------------------------------------------- *) (* "Iff" forms of constancy of function from connected set into a set that *) (* is smaller than R, or countable, or finite, or disconnected, or discrete. *) (* ------------------------------------------------------------------------- *) let [CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; CONTINUOUS_FINITE_RANGE_CONSTANT_EQ] = (CONJUNCTS o prove) (`(!s. connected s <=> !f:real^M->real^N t. f continuous_on s /\ IMAGE f s SUBSET t /\ (!y. y IN t ==> connected_component t y = {y}) ==> ?a. !x. x IN s ==> f x = a) /\ (!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ (!x. x IN s ==> ?e. &0 < e /\ !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) ==> ?a. !x. x IN s ==> f x = a) /\ (!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ FINITE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a)`, REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC(TAUT `(s ==> t) /\ (t ==> u) /\ (u ==> v) /\ (v ==> s) ==> (s <=> t) /\ (s <=> u) /\ (s <=> v)`) THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^M` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN EXISTS_TAC `(f:real^M->real^N) x` THEN MATCH_MP_TAC(SET_RULE `IMAGE f s SUBSET {a} ==> !y. y IN s ==> f y = a`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN ASM SET_TAC[]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_REFL] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(SET_RULE `(!y. y IN s /\ f y IN connected_component (IMAGE f s) a ==> f y = a) /\ connected_component (IMAGE f s) a SUBSET (IMAGE f s) /\ connected_component (IMAGE f s) a a ==> connected_component (IMAGE f s) a = {a}`) THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN ASM_SIMP_TAC[FUN_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN MP_TAC(ISPEC `connected_component (IMAGE (f:real^M->real^N) s) (f x)` CONNECTED_CLOSED) THEN REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`cball((f:real^M->real^N) x,e / &2)`; `(:real^N) DIFF ball((f:real^M->real^N) x,e)`] THEN REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; CLOSED_CBALL] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; IN_CBALL; IN_UNION; IN_DIFF; IN_BALL; IN_UNIV] THEN MATCH_MP_TAC(MESON[SUBSET; CONNECTED_COMPONENT_SUBSET] `(!x. x IN s ==> P x) ==> (!x. x IN connected_component s y ==> P x)`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t INTER u = {}`) THEN REWRITE_TAC[IN_BALL; IN_CBALL; IN_DIFF; IN_UNIV] THEN UNDISCH_TAC `&0 < e` THEN CONV_TAC NORM_ARITH; EXISTS_TAC `(f:real^M->real^N) x` THEN ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_HALF; REAL_LT_IMP_LE; IN_INTER] THEN REWRITE_TAC[IN] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL_EQ; FUN_IN_IMAGE]; EXISTS_TAC `(f:real^M->real^N) y` THEN ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist]]; MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MATCH_MP_TAC th) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `IMAGE (f:real^M->real^N) s DELETE (f x) = {}` THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `inf{norm(z - f x) |z| z IN IMAGE (f:real^M->real^N) s DELETE (f x)}` THEN REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; FINITE_DELETE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_DELETE; NORM_POS_LT; VECTOR_SUB_EQ; IN_IMAGE] THEN MESON_TAC[REAL_LE_REFL]; REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `(\x. if x IN t then vec 0 else basis 1):real^M->real^N`) THEN REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^N,basis 1}` THEN REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[]; SUBGOAL_THEN `?a b:real^M. a IN s /\ a IN t /\ b IN s /\ ~(b IN t)` STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; DISCH_THEN(CHOOSE_THEN MP_TAC)] THEN DISCH_THEN(fun th -> MP_TAC(SPEC `a:real^M` th) THEN MP_TAC(SPEC `b:real^M` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC(RAND_CONV SYM_CONV) THEN SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; REAL_LE_REFL]]]);; let CONTINUOUS_DISCONNECTED_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ IMAGE f s SUBSET t /\ (!y. y IN t ==> connected_component t y = {y}) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]);; let CONTINUOUS_DISCRETE_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ (!x. x IN s ==> ?e. &0 < e /\ !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) ==> ?a. !x. x IN s ==> f x = a`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REWRITE_TAC[IMP_IMP; GSYM CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ]);; let CONTINUOUS_FINITE_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ FINITE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]);; let CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ = prove (`!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ COUNTABLE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; REWRITE_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[FINITE_IMP_COUNTABLE] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_SIMP_TAC[COUNTABLE_IMP_DISCONNECTED; SUBSET_REFL]);; let CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ = prove (`!s. connected s <=> !f:real^M->real^N. f continuous_on s /\ (IMAGE f s) <_c (:real) ==> ?a. !x. x IN s ==> f x = a`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; REWRITE_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL] THEN EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN ASM_SIMP_TAC[CARD_LT_IMP_DISCONNECTED; SUBSET_REFL]);; let CONTINUOUS_COUNTABLE_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ COUNTABLE(IMAGE f s) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]);; let CONTINUOUS_CARD_LT_RANGE_CONSTANT = prove (`!f:real^M->real^N s. connected s /\ f continuous_on s /\ (IMAGE f s) <_c (:real) ==> ?a. !x. x IN s ==> f x = a`, MESON_TAC[CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ]);; (* ------------------------------------------------------------------------- *) (* Homeomorphism of hyperplanes. *) (* ------------------------------------------------------------------------- *) let HOMEOMORPHIC_HYPERPLANES = prove (`!a:real^N b c:real^N d. ~(a = vec 0) /\ ~(c = vec 0) ==> {x | a dot x = b} homeomorphic {x | c dot x = d}`, let lemma = prove (`~(a = vec 0) ==> {x:real^N | a dot x = b} homeomorphic {x:real^N | x$1 = &0}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^N. a dot c = b` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `b / (a:real^N)$k % basis k:real^N` THEN ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; REAL_DIV_RMUL]; FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ABBREV_TAC `p = {x:real^N | x$1 = &0}` THEN GEOM_ORIGIN_TAC `c:real^N` THEN REWRITE_TAC[VECTOR_ADD_RID; DOT_RADD; DOT_RZERO; REAL_EQ_ADD_LCANCEL_0; REAL_ADD_RID] THEN REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a:real^N = vec 0)` THEN GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; REAL_ENTIRE] THEN SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1] THEN EXPAND_TAC "p" THEN REWRITE_TAC[HOMEOMORPHIC_REFL]]) in REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0}` THEN ASM_SIMP_TAC[lemma] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN ASM_SIMP_TAC[lemma]);; let HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE = prove (`!a:real^N b k c. ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) ==> {x | a dot x = b} homeomorphic {x:real^N | x$k = c}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x:real^N | x$k = c} = {x | basis k dot x = c}` SUBST1_TAC THENL [ASM_SIMP_TAC[DOT_BASIS]; MATCH_MP_TAC HOMEOMORPHIC_HYPERPLANES] THEN ASM_SIMP_TAC[BASIS_NONZERO]);; let HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE = prove (`!a:real^N b k c. ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) ==> {x:real^N | x$k = c} homeomorphic {x | a dot x = b}`, ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE]);; let HOMEOMORPHIC_HYPERPLANE_UNIV = prove (`!a b. ~(a = vec 0) /\ dimindex(:N) = dimindex(:M) + 1 ==> {x:real^N | a dot x = b} homeomorphic (:real^M)`, REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis(dimindex(:N)) dot x = &0}` THEN ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANES; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN EXISTS_TAC `(\x. lambda i. if i <= dimindex(:M) then x$i else &0) :real^M->real^N` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; REWRITE_TAC[SUBSET_UNIV]; MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN ASM_SIMP_TAC[DOT_BASIS; LAMBDA_BETA; LE_REFL; ARITH_RULE `1 <= n + 1`; ARITH_RULE `~(m + 1 <= m)`]; ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; LE_REFL; CART_EQ; ARITH_RULE `1 <= n + 1`] THEN GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i = dimindex(:M) + 1` THEN ASM_REWRITE_TAC[COND_ID] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; IN_UNIV; LE_REFL; ARITH_RULE `i <= n ==> i <= n + 1`]]);; (* ------------------------------------------------------------------------- *) (* "Isometry" (up to constant bounds) of injective linear map etc. *) (* ------------------------------------------------------------------------- *) let CAUCHY_ISOMETRIC = prove (`!f s e x. &0 < e /\ subspace s /\ linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ (!n. x(n) IN s) /\ cauchy(f o x) ==> cauchy x`, REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[CAUCHY; dist; o_THM] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN DISCH_THEN(fun th -> X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC th) THEN DISCH_THEN(MP_TAC o SPEC `d * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_MUL_SYM; REAL_LET_TRANS; SUBSPACE_SUB; REAL_LT_LDIV_EQ]);; let COMPLETE_ISOMETRIC_IMAGE = prove (`!f:real^M->real^N s e. &0 < e /\ subspace s /\ linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ complete s ==> complete(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[complete; EXISTS_IN_IMAGE] THEN STRIP_TAC THEN X_GEN_TAC `g:num->real^N` THEN REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM FUN_EQ_THM] THEN REWRITE_TAC[GSYM o_DEF] THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ASM_MESON_TAC[CAUCHY_ISOMETRIC; LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_SEQUENTIALLY]);; let INJECTIVE_IMP_ISOMETRIC = prove (`!f:real^M->real^N s. closed s /\ subspace s /\ linear f /\ (!x. x IN s /\ (f x = vec 0) ==> (x = vec 0)) ==> ?e. &0 < e /\ !x. x IN s ==> norm(f x) >= e * norm(x)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s SUBSET {vec 0 :real^M}` THENL [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_LID; real_ge] THEN ASM_MESON_TAC[SUBSET; IN_SING; NORM_0; LINEAR_0; REAL_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_SING] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`{(f:real^M->real^N) x | x IN s /\ norm(x) = norm(a:real^M)}`; `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN ANTS_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBST1_TAC(SET_RULE `{f x | x IN s /\ norm(x) = norm(a:real^M)} = IMAGE (f:real^M->real^N) (s INTER {x | norm x = norm a})`) THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `{x:real^M | norm x = norm(a:real^M)} = frontier(cball(vec 0,norm a))` SUBST1_TAC THENL [ASM_SIMP_TAC[FRONTIER_CBALL; NORM_POS_LT; dist; VECTOR_SUB_LZERO; NORM_NEG; sphere]; ASM_SIMP_TAC[COMPACT_FRONTIER; COMPACT_CBALL]]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^M` MP_TAC) THEN REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_LZERO; NORM_NEG] THEN STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN EXISTS_TAC `norm((f:real^M->real^N) b) / norm(b)` THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_DIV; NORM_POS_LT; NORM_EQ_0]; ALL_TAC] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^M = vec 0` THENL [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN REWRITE_TAC[NORM_0; REAL_MUL_RZERO; real_ge; REAL_LE_REFL]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `(norm(a:real^M) / norm(x)) % x:real^M`) THEN ANTS_TAC THENL [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_MESON_TAC[subspace]; ALL_TAC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; real_ge] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT] THEN REWRITE_TAC[real_div; REAL_MUL_AC]);; let CLOSED_INJECTIVE_IMAGE_SUBSPACE = prove (`!f s. subspace s /\ linear f /\ (!x. x IN s /\ f(x) = vec 0 ==> x = vec 0) /\ closed s ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED] THEN MATCH_MP_TAC COMPLETE_ISOMETRIC_IMAGE THEN ASM_REWRITE_TAC[COMPLETE_EQ_CLOSED] THEN MATCH_MP_TAC INJECTIVE_IMP_ISOMETRIC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Relating linear images to open/closed/interior/closure. *) (* ------------------------------------------------------------------------- *) let OPEN_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!y. ?x. f x = y) ==> !s. open s ==> open(IMAGE f s)`, GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN FIRST_ASSUM(MP_TAC o GEN `k:num` o SPEC `basis k:real^N`) THEN REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `b:num->real^M` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `bounded(IMAGE (b:num->real^M) (1..dimindex(:N)))` MP_TAC THENL [SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / B / &(dimindex(:N))` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN ABBREV_TAC `u = y - (f:real^M->real^N) x` THEN EXISTS_TAC `x + vsum(1..dimindex(:N)) (\i. (u:real^N)$i % b i):real^M` THEN ASM_SIMP_TAC[LINEAR_ADD; LINEAR_VSUM; FINITE_NUMSEG; o_DEF; LINEAR_CMUL; BASIS_EXPANSION] THEN CONJ_TAC THENL [EXPAND_TAC "u" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[NORM_ARITH `dist(x + y,x) = norm y`] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(dist(y,(f:real^M->real^N) x) * &(dimindex(:N))) * B` THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN GEN_REWRITE_TAC(RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; dist] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN ASM_SIMP_TAC[COMPONENT_LE_NORM]);; let OPEN_BIJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> (open(IMAGE f s) <=> open s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE]] THEN SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; add_linear_invariants [OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];; let CLOSED_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> !s. closed s ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN EXISTS_TAC `IMAGE (f:real^M->real^N) (:real^M)` THEN CONJ_TAC THENL [MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) (:real^M)`; `IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s)`] CONTINUOUS_CLOSED_IN_PREIMAGE) THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_I]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN REWRITE_TAC[EXTENSION; o_THM; I_THM] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSPACE THEN ASM_REWRITE_TAC[IN_UNIV; SUBSPACE_UNIV; CLOSED_UNIV] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o AP_TERM `g:real^N->real^M`) THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM]) THEN ASM_MESON_TAC[LINEAR_0]]);; let CLOSED_INJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (closed(IMAGE f s) <=> closed s)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]] THEN SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; add_linear_invariants [CLOSED_INJECTIVE_LINEAR_IMAGE_EQ];; let CLOSURE_LINEAR_IMAGE_SUBSET = prove (`!f:real^M->real^N s. linear f ==> IMAGE f (closure s) SUBSET closure(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; LINEAR_CONTINUOUS_ON]);; let CLOSURE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE; CLOSED_CLOSURE]);; add_linear_invariants [CLOSURE_INJECTIVE_LINEAR_IMAGE];; let CLOSURE_BOUNDED_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ bounded s ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN ASM_REWRITE_TAC[COMPACT_CLOSURE]);; let LINEAR_INTERIOR_IMAGE_SUBSET = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, MESON_TAC[INTERIOR_IMAGE_SUBSET; LINEAR_CONTINUOUS_AT]);; let LINEAR_IMAGE_SUBSET_INTERIOR = prove (`!f:real^M->real^N s. linear f /\ (!y. ?x. f x = y) ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN ASM_SIMP_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE; OPEN_INTERIOR; IMAGE_SUBSET; INTERIOR_SUBSET]);; let INTERIOR_BIJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> interior(IMAGE f s) = IMAGE f (interior s)`, REWRITE_TAC[interior] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [INTERIOR_BIJECTIVE_LINEAR_IMAGE];; let FRONTIER_BIJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, REWRITE_TAC[frontier] THEN GEOM_TRANSFORM_TAC[]);; add_linear_invariants [FRONTIER_BIJECTIVE_LINEAR_IMAGE];; (* ------------------------------------------------------------------------- *) (* Corollaries, reformulations and special cases for M = N. *) (* ------------------------------------------------------------------------- *) let IN_INTERIOR_LINEAR_IMAGE = prove (`!f:real^M->real^N g s x. linear f /\ linear g /\ (f o g = I) /\ x IN interior s ==> (f x) IN interior (IMAGE f s)`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] LINEAR_IMAGE_SUBSET_INTERIOR) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]);; let LINEAR_OPEN_MAPPING = prove (`!f:real^M->real^N g. linear f /\ linear g /\ (f o g = I) ==> !s. open s ==> open(IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[]);; let INTERIOR_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> interior(IMAGE f s) = IMAGE f (interior s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; let INTERIOR_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!y. ?x. f x = y) ==> interior(IMAGE f s) = IMAGE f (interior s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; let CLOSURE_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!y. ?x. f x = y) ==> closure(IMAGE f s) = IMAGE f (closure s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; let FRONTIER_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; let FRONTIER_SURJECTIVE_LINEAR_IMAGE = prove (`!f:real^N->real^N. linear f /\ (!y. ?x. f x = y) ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; let COMPLETE_INJECTIVE_LINEAR_IMAGE = prove (`!f:real^M->real^N. linear f /\ (!x y. f x = f y ==> x = y) ==> !s. complete s ==> complete(IMAGE f s)`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE]);; let COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> (complete(IMAGE f s) <=> complete s)`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]);; add_linear_invariants [COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ];; let LIMPT_INJECTIVE_LINEAR_IMAGE_EQ = prove (`!f:real^M->real^N s. linear f /\ (!x y. f x = f y ==> x = y) ==> ((f x) limit_point_of (IMAGE f s) <=> x limit_point_of s)`, REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS); MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THENL [FIRST_X_ASSUM(MP_TAC o SPEC `e * B:real`); FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`)] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; dist; GSYM LINEAR_SUB] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; add_linear_invariants [LIMPT_INJECTIVE_LINEAR_IMAGE_EQ];; let LIMPT_TRANSLATION_EQ = prove (`!a s x. (a + x) limit_point_of (IMAGE (\y. a + y) s) <=> x limit_point_of s`, REWRITE_TAC[limit_point_of] THEN GEOM_TRANSLATE_TAC[]);; add_translation_invariants [LIMPT_TRANSLATION_EQ];; let OPEN_OPEN_LEFT_PROJECTION = prove (`!s t:real^(M,N)finite_sum->bool. open s /\ open t ==> open {x | x IN s /\ ?y. pastecart x y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ ?y. (pastecart x y:real^(M,N)finite_sum) IN t} = s INTER IMAGE fstcart t` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN MESON_TAC[FSTCART_PASTECART; PASTECART_FST_SND]; MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] OPEN_SURJECTIVE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN MESON_TAC[FSTCART_PASTECART]]);; let OPEN_OPEN_RIGHT_PROJECTION = prove (`!s t:real^(M,N)finite_sum->bool. open s /\ open t ==> open {y | y IN s /\ ?x. pastecart x y IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{y | y IN s /\ ?x. (pastecart x y:real^(M,N)finite_sum) IN t} = s INTER IMAGE sndcart t` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN MESON_TAC[SNDCART_PASTECART; PASTECART_FST_SND]; MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] OPEN_SURJECTIVE_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN MESON_TAC[SNDCART_PASTECART]]);; (* ------------------------------------------------------------------------- *) (* Even more special cases. *) (* ------------------------------------------------------------------------- *) let INTERIOR_NEGATIONS = prove (`!s. interior(IMAGE (--) s) = IMAGE (--) (interior s)`, GEN_TAC THEN MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; let SYMMETRIC_INTERIOR = prove (`!s:real^N->bool. (!x. x IN s ==> --x IN s) ==> !x. x IN interior s ==> (--x) IN interior s`, REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN REWRITE_TAC[GSYM INTERIOR_NEGATIONS] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; let CLOSURE_NEGATIONS = prove (`!s. closure(IMAGE (--) s) = IMAGE (--) (closure s)`, GEN_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; let SYMMETRIC_CLOSURE = prove (`!s:real^N->bool. (!x. x IN s ==> --x IN s) ==> !x. x IN closure s ==> (--x) IN closure s`, REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN REWRITE_TAC[GSYM CLOSURE_NEGATIONS] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; (* ------------------------------------------------------------------------- *) (* Some properties of a canonical subspace. *) (* ------------------------------------------------------------------------- *) let SUBSPACE_SUBSTANDARD = prove (`!d. subspace {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, GEN_TAC THEN ASM_CASES_TAC `d <= dimindex(:N)` THENL [MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN SIMP_TAC[subspace; IN_ELIM_THM; REAL_MUL_RZERO; REAL_ADD_LID; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT]; ASM_SIMP_TAC[ARITH_RULE `~(d:num <= e) ==> (d < i /\ i <= e <=> F)`] THEN REWRITE_TAC[SET_RULE `{x | T} = UNIV`; SUBSPACE_UNIV]]);; let CLOSED_SUBSTANDARD = prove (`!d. closed {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, GEN_TAC THEN SUBGOAL_THEN `{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} = INTERS {{x | basis i dot x = &0} | d < i /\ i <= dimindex(:N)}` SUBST1_TAC THENL [ALL_TAC; SIMP_TAC[CLOSED_INTERS; CLOSED_HYPERPLANE; IN_ELIM_THM; LEFT_IMP_EXISTS_THM]] THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN SIMP_TAC[DOT_BASIS] THEN MESON_TAC[]);; let DIM_SUBSTANDARD = prove (`!d. d <= dimindex(:N) ==> (dim {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} = d)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `IMAGE (basis:num->real^N) (1..d)` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN MESON_TAC[BASIS_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`; NOT_LT]; ALL_TAC; MATCH_MP_TAC INDEPENDENT_MONO THEN EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN REWRITE_TAC[INDEPENDENT_STDBASIS]THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS; BASIS_INJ]] THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`; SPAN_STDBASIS] THEN SUBGOAL_THEN `IMAGE basis (1 .. 0) :real^N->bool = {}` SUBST1_TAC THENL [REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; ARITH]; ALL_TAC] THEN DISCH_TAC THEN REWRITE_TAC[SPAN_EMPTY; SUBSET; IN_ELIM_THM; IN_SING] THEN SIMP_TAC[CART_EQ; VEC_COMPONENT]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x - (x$(SUC d)) % basis(SUC d) :real^N`) THEN ANTS_TAC THENL [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `d < i ==> 1 <= i`)) THEN ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_SUB_REFL] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN ASM_MESON_TAC[ARITH_RULE `d < i /\ ~(i = SUC d) ==> SUC d < i`]; ALL_TAC] THEN DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH `x = (x - (x$(SUC d)) % basis(SUC d)) + x$(SUC d) % basis(SUC d) :real^N`) THEN MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_MONO; SUBSET_IMAGE; SUBSET; SUBSET_NUMSEG; LE_REFL; LE]; MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN MESON_TAC[LE_REFL; ARITH_RULE `1 <= SUC d`]]);; (* ------------------------------------------------------------------------- *) (* Hence closure and completeness of all subspaces. *) (* ------------------------------------------------------------------------- *) let CLOSED_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> closed s`, REPEAT STRIP_TAC THEN ABBREV_TAC `d = dim(s:real^N->bool)` THEN MP_TAC(MATCH_MP DIM_SUBSTANDARD (ISPEC `s:real^N->bool` DIM_SUBSET_UNIV)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`; `s:real^N->bool`] SUBSPACE_ISOMORPHISM) THEN ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD] THEN DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN MATCH_MP_TAC(ISPEC `f:real^N->real^N` CLOSED_INJECTIVE_IMAGE_SUBSPACE) THEN ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD; CLOSED_SUBSTANDARD] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINEAR_0]] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[VEC_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`]);; let COMPLETE_SUBSPACE = prove (`!s:real^N->bool. subspace s ==> complete s`, REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_SUBSPACE]);; let CLOSED_SPAN = prove (`!s. closed(span s)`, SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]);; let DIM_CLOSURE = prove (`!s:real^N->bool. dim(closure s) = dim s`, GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN]; ALL_TAC] THEN MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN; SPAN_INC]);; let CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE = prove (`!f:real^M->real^N s. closed s /\ f continuous_on s /\ (!e. bounded {x | x IN s /\ norm(f x) <= e}) ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_INTERS_COMPACT] THEN REWRITE_TAC[SET_RULE `cball(vec 0,e) INTER IMAGE (f:real^M->real^N) s = IMAGE f (s INTER {x | x IN s /\ f x IN cball(vec 0,e)})`] THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[IN_CBALL_0]; ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CBALL]]]);; let CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE = prove (`!f:real^M->real^N s t. closed s /\ s SUBSET t /\ subspace t /\ linear f /\ (!x. x IN t /\ f(x) = vec 0 ==> x = vec 0) ==> closed(IMAGE f s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`] INJECTIVE_IMP_ISOMETRIC) THEN ASM_SIMP_TAC[CLOSED_SUBSPACE; real_ge] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(vec 0:real^M,e / B)` THEN REWRITE_TAC[BOUNDED_CBALL] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0; REAL_LE_RDIV_EQ] THEN ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);; let BASIS_COORDINATES_LIPSCHITZ = prove (`!b:real^N->bool. independent b ==> ?B. &0 < B /\ !c v. v IN b ==> abs(c v) <= B * norm(vsum b (\v. c(v) % v))`, X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP INDEPENDENT_BOUND) THEN FIRST_ASSUM(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ABBREV_TAC `n = CARD(k:real^N->bool)` THEN MP_TAC(ISPECL [`(\x. vsum(1..n) (\i. x$i % b i)):real^N->real^N`; `span(IMAGE basis (1..n)):real^N->bool`] INJECTIVE_IMP_ISOMETRIC) THEN REWRITE_TAC[SUBSPACE_SPAN] THEN ANTS_TAC THENL [CONJ_TAC THENL [SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]; ALL_TAC] THEN CONJ_TAC THENL [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_VMUL_COMPONENT THEN SIMP_TAC[LINEAR_ID] THEN ASM_ARITH_TAC; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPAN_IMAGE_BASIS]) THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `c:real^N->num`) THEN SUBGOAL_THEN `vsum(1..n) (\i. (x:real^N)$i % b i:real^N) = vsum k (\v. x$(c v) % v)` SUBST1_TAC THENL [MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN MAP_EVERY EXISTS_TAC [`b:num->real^N`; `c:real^N->num`] THEN ASM SET_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN DISCH_THEN(MP_TAC o SPEC `\v:real^N. (x:real^N)$(c v)` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[CART_EQ; FORALL_IN_IMAGE; VEC_COMPONENT] THEN ASM_MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(B:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN MAP_EVERY X_GEN_TAC [`c:real^N->real`; `j:num`] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rand o rand o snd) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`) THEN SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA] THEN ANTS_TAC THENL [MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `x = v /\ u <= y ==> x >= y ==> u <= v`) THEN CONJ_TAC THENL [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN DISCH_THEN(K ALL_TAC)] THEN REWRITE_TAC[o_THM]; GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN MP_TAC(ISPECL [`(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`; `j:num`] COMPONENT_LE_NORM) THEN SUBGOAL_THEN `1 <= j /\ j <= dimindex(:N)` MP_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[]]]);; let BASIS_COORDINATES_CONTINUOUS = prove (`!b:real^N->bool e. independent b /\ &0 < e ==> ?d. &0 < d /\ !c. norm(vsum b (\v. c(v) % v)) < d ==> !v. v IN b ==> abs(c v) < e`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN X_GEN_TAC `c:real^N->real` THEN DISCH_TAC THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(vsum b (\v:real^N. c v % v))` THEN ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);; (* ------------------------------------------------------------------------- *) (* Affine transformations of intervals. *) (* ------------------------------------------------------------------------- *) let AFFINITY_INVERSES = prove (`!m c. ~(m = &0) ==> (\x. m % x + c) o (\x. inv(m) % x + (--(inv(m) % c))) = I /\ (\x. inv(m) % x + (--(inv(m) % c))) o (\x. m % x + c) = I`, REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_RNEG] THEN SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; let REAL_AFFINITY_LE = prove (`!m c x y. &0 < m ==> (m * x + c <= y <=> x <= inv(m) * y + --(c / m))`, REWRITE_TAC[REAL_ARITH `m * x + c <= y <=> x * m <= y - c`] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC);; let REAL_LE_AFFINITY = prove (`!m c x y. &0 < m ==> (y <= m * x + c <=> inv(m) * y + --(c / m) <= x)`, REWRITE_TAC[REAL_ARITH `y <= m * x + c <=> y - c <= x * m`] THEN SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC);; let REAL_AFFINITY_LT = prove (`!m c x y. &0 < m ==> (m * x + c < y <=> x < inv(m) * y + --(c / m))`, SIMP_TAC[REAL_LE_AFFINITY; GSYM REAL_NOT_LE]);; let REAL_LT_AFFINITY = prove (`!m c x y. &0 < m ==> (y < m * x + c <=> inv(m) * y + --(c / m) < x)`, SIMP_TAC[REAL_AFFINITY_LE; GSYM REAL_NOT_LE]);; let REAL_AFFINITY_EQ = prove (`!m c x y. ~(m = &0) ==> (m * x + c = y <=> x = inv(m) * y + --(c / m))`, CONV_TAC REAL_FIELD);; let REAL_EQ_AFFINITY = prove (`!m c x y. ~(m = &0) ==> (y = m * x + c <=> inv(m) * y + --(c / m) = x)`, CONV_TAC REAL_FIELD);; let VECTOR_AFFINITY_EQ = prove (`!m c x y. ~(m = &0) ==> (m % x + c = y <=> x = inv(m) % y + --(inv(m) % c))`, SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; real_div; VECTOR_NEG_COMPONENT; REAL_AFFINITY_EQ] THEN REWRITE_TAC[REAL_MUL_AC]);; let VECTOR_EQ_AFFINITY = prove (`!m c x y. ~(m = &0) ==> (y = m % x + c <=> inv(m) % y + --(inv(m) % c) = x)`, SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; real_div; VECTOR_NEG_COMPONENT; REAL_EQ_AFFINITY] THEN REWRITE_TAC[REAL_MUL_AC]);; let IMAGE_AFFINITY_INTERVAL = prove (`!a b:real^N m c. IMAGE (\x. m % x + c) (interval[a,b]) = if interval[a,b] = {} then {} else if &0 <= m then interval[m % a + c,m % b + c] else interval[m % b + c,m % a + c]`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[REAL_LE_LT] THENL [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; COND_ID] THEN REWRITE_TAC[INTERVAL_SING] THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN ASM_SIMP_TAC[EXTENSION; IN_IMAGE; REAL_ARITH `&0 < --x ==> ~(&0 < x)`] THENL [ALL_TAC; ONCE_REWRITE_TAC[VECTOR_ARITH `x = m % y + c <=> c = (--m) % y + x`]] THEN ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; REAL_LT_IMP_NZ; UNWIND_THM1] THEN SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_INV_EQ]) THEN SIMP_TAC[REAL_AFFINITY_LE; REAL_LE_AFFINITY; real_div] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_INV_INV] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_NEGNEG] THEN ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> (inv m * x) * m = x`] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Existence of eigenvectors. The proof is only in this file because it uses *) (* a few simple results about continuous functions (at least *) (* CONTINUOUS_ON_LIFT_DOT2, CONTINUOUS_ATTAINS_SUP and CLOSED_SUBSPACE). *) (* ------------------------------------------------------------------------- *) let SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE = prove (`!f:real^N->real^N s. linear f /\ adjoint f = f /\ subspace s /\ ~(s = {vec 0}) /\ (!x. x IN s ==> f x IN s) ==> ?v c. v IN s /\ norm(v) = &1 /\ f(v) = c % v`, let lemma = prove (`!a b. (!x. a * x <= b * x pow 2) ==> &0 <= b ==> a = &0`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(fun t -> MP_TAC(SPEC `&1` t) THEN MP_TAC(SPEC `-- &1` t)) THEN ASM_REAL_ARITH_TAC; DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a / &2 / b`) THEN ASM_SIMP_TAC[REAL_FIELD `&0 < b ==> (b * (a / b) pow 2) = a pow 2 / b`] THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN REWRITE_TAC[REAL_LT_SQUARE; REAL_ARITH `(a * a) / &2 <= (a / &2) pow 2 <=> ~(&0 < a * a)`]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:real^N. (f x) dot x`; `s INTER sphere(vec 0:real^N,&1)`] CONTINUOUS_ATTAINS_SUP) THEN REWRITE_TAC[EXISTS_IN_GSPEC; FORALL_IN_GSPEC; o_DEF] THEN ANTS_TAC THENL [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT2; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_ID] THEN ASM_SIMP_TAC[COMPACT_SPHERE; CLOSED_INTER_COMPACT; CLOSED_SUBSPACE] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN ASM_SIMP_TAC[SUBSPACE_0; IN_SPHERE_0; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `inv(norm x) % x:real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_SUB_RZERO; NORM_MUL] THEN ASM_SIMP_TAC[SUBSPACE_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N` THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN ABBREV_TAC `c = (f:real^N->real^N) v dot v` THEN EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]] THEN ABBREV_TAC `p = \x y:real^N. c * (x dot y) - (f x) dot y` THEN SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= p x x` (LABEL_TAC "POSDEF") THENL [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "p" THEN REWRITE_TAC[] THEN ASM_CASES_TAC `x:real^N = vec 0` THEN DISCH_TAC THEN ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO; REAL_SUB_LE; REAL_LE_REFL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(norm x) % x:real^N`) THEN ASM_SIMP_TAC[SUBSPACE_MUL] THEN ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL; REAL_ABS_INV; DOT_RMUL] THEN ASM_SIMP_TAC[REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; DOT_LMUL] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; DOT_POS_LT] THEN REWRITE_TAC[GSYM NORM_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!y:real^N. y IN s ==> !a. p v y * a <= p y y * a pow 2` MP_TAC THENL [REPEAT STRIP_TAC THEN REMOVE_THEN "POSDEF" (MP_TAC o SPEC `v - (&2 * a) % y:real^N`) THEN EXPAND_TAC "p" THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN ASM_SIMP_TAC[LINEAR_SUB; LINEAR_CMUL] THEN REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN SUBGOAL_THEN `f y dot (v:real^N) = f v dot y` SUBST1_TAC THENL [ASM_MESON_TAC[ADJOINT_CLAUSES; DOT_SYM]; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REWRITE_TAC[NORM_POW_2] THEN MATCH_MP_TAC(REAL_ARITH `&4 * (z - y) = x ==> &0 <= x ==> y <= z`) THEN REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING; DISCH_THEN(MP_TAC o GEN `y:real^N` o DISCH `(y:real^N) IN s` o MATCH_MP lemma o C MP (ASSUME `(y:real^N) IN s`) o SPEC `y:real^N`) THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "p" THEN REWRITE_TAC[GSYM DOT_LMUL; GSYM DOT_LSUB] THEN DISCH_THEN(MP_TAC o SPEC `c % v - f v:real^N`) THEN ASM_SIMP_TAC[SUBSPACE_MUL; SUBSPACE_SUB; DOT_EQ_0; VECTOR_SUB_EQ]]);; let SELF_ADJOINT_HAS_EIGENVECTOR = prove (`!f:real^N->real^N. linear f /\ adjoint f = f ==> ?v c. norm(v) = &1 /\ f(v) = c % v`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC(SET_RULE `!a. ~(a IN s) ==> ~(UNIV = s)`) THEN EXISTS_TAC `vec 1:real^N` THEN REWRITE_TAC[IN_SING; VEC_EQ; ARITH_EQ]);; let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE = prove (`!f:real^N->real^N s. linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s) ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ independent b /\ span b = s /\ b HAS_SIZE dim s`, let lemma = prove (`!f:real^N->real^N s. linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s) ==> ?b. b SUBSET s /\ b HAS_SIZE dim s /\ pairwise orthogonal b /\ (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL [EXISTS_TAC `{}:real^N->bool` THEN ASM_SIMP_TAC[HAS_SIZE_CLAUSES; NOT_IN_EMPTY; PAIRWISE_EMPTY; EMPTY_SUBSET]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DIM_EQ_0]) THEN DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE `~(s SUBSET {a}) ==> ~(s = {a})`)) THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N` MP_TAC) THEN ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | y IN s /\ orthogonal v y}`) THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM] THEN MP_TAC(ISPECL [`span {v:real^N}`; `s:real^N->bool`] DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN ASM_REWRITE_TAC[SUBSPACE_SPAN; IN_SING; FORALL_UNWIND_THM2] THEN ANTS_TAC THENL [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN ASM_REWRITE_TAC[DIM_SPAN; DIM_SING; ARITH_RULE `n < n + 1`] THEN ANTS_TAC THENL [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN REWRITE_TAC[orthogonal] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(f:real^N->real^N) v dot x` THEN CONJ_TAC THENL [ASM_MESON_TAC[ADJOINT_CLAUSES]; ASM_MESON_TAC[DOT_LMUL; REAL_MUL_RZERO]]; DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(v:real^N) INSERT b` THEN ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[PAIRWISE_INSERT] THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE; SUBSET; IN_ELIM_THM]) THEN CONJ_TAC THENL [ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD1] THEN ASM_MESON_TAC[ORTHOGONAL_REFL]; RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN ASM_MESON_TAC[ORTHOGONAL_SYM]]]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] lemma) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ASM_MESON_TAC[SPAN_SUBSET_SUBSPACE]; MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_REWRITE_TAC[LE_REFL]]]);; let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS = prove (`!f:real^N->real^N. linear f /\ adjoint f = f ==> ?b. pairwise orthogonal b /\ (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ independent b /\ span b = (:real^N) /\ b HAS_SIZE (dimindex(:N))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE) THEN ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV; SUBSET_UNIV]);; (* ------------------------------------------------------------------------- *) (* Diagonalization of symmetric matrix. *) (* ------------------------------------------------------------------------- *) let SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT = prove (`!A:real^N^N. transp A = A ==> ?P d. orthogonal_matrix P /\ transp P ** A ** P = (lambda i j. if i = j then d i else &0)`, let lemma1 = prove (`!A:real^N^N P:real^N^N d. A ** P = P ** (lambda i j. if i = j then d i else &0) <=> !i. 1 <= i /\ i <= dimindex(:N) ==> A ** column i P = d i % column i P`, SIMP_TAC[CART_EQ; matrix_mul; matrix_vector_mul; LAMBDA_BETA; column; VECTOR_MUL_COMPONENT] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[REAL_MUL_SYM]) in let lemma2 = prove (`!A:real^N^N P:real^N^N d. orthogonal_matrix P /\ transp P ** A ** P = (lambda i j. if i = j then d i else &0) <=> orthogonal_matrix P /\ !i. 1 <= i /\ i <= dimindex(:N) ==> A ** column i P = d i % column i P`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM lemma1; orthogonal_matrix] THEN ABBREV_TAC `D:real^N^N = lambda i j. if i = j then d i else &0` THEN MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]) in REPEAT STRIP_TAC THEN REWRITE_TAC[lemma2] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN ASM_SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR; MATRIX_OF_MATRIX_VECTOR_MUL] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN ASM_REWRITE_TAC[IN_NUMSEG; TAUT `p /\ q /\ x = y ==> a = b <=> p /\ q /\ ~(a = b) ==> ~(x = y)`] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[PAIRWISE_IMAGE; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[pairwise; IN_NUMSEG] THEN STRIP_TAC THEN EXISTS_TAC `transp(lambda i. f i):real^N^N` THEN SIMP_TAC[COLUMN_TRANSP; ORTHOGONAL_MATRIX_TRANSP] THEN SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; row] THEN SIMP_TAC[LAMBDA_ETA; LAMBDA_BETA; pairwise; IN_NUMSEG] THEN ASM_MESON_TAC[]);; let SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE = prove (`!A:real^N^N. transp A = A ==> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[diagonal_matrix; LAMBDA_BETA]);; let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE = prove (`!A:real^N^N. transp A = A <=> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE] THEN REWRITE_TAC[orthogonal_matrix] THEN DISCH_THEN(X_CHOOSE_THEN `P:real^N^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `D:real^N^N = transp P ** (A:real^N^N) ** P` THEN SUBGOAL_THEN `A:real^N^N = P ** (D:real^N^N) ** transp P` SUBST1_TAC THENL [EXPAND_TAC "D" THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]; REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC] THEN ASM_MESON_TAC[TRANSP_DIAGONAL_MATRIX]]);; (* ------------------------------------------------------------------------- *) (* Some matrix identities are easier to deduce for invertible matrices. We *) (* can then extend by continuity, which is why this material needs to be *) (* here after basic topological notions have been defined. *) (* ------------------------------------------------------------------------- *) let CONTINUOUS_LIFT_DET = prove (`!(A:A->real^N^N) net. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (\x. lift(A x$i$j)) continuous net) ==> (\x. lift(det(A x))) continuous net`, REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN SIMP_TAC[LIFT_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; LIFT_CMUL; IN_ELIM_THM] THEN X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN MATCH_MP_TAC CONTINUOUS_LIFT_PRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG]);; let CONTINUOUS_ON_LIFT_DET = prove (`!A:real^M->real^N^N s. (!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) ==> (\x. lift(A x$i$j)) continuous_on s) ==> (\x. lift(det(A x))) continuous_on s`, SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_DET]);; let NEARBY_INVERTIBLE_MATRIX = prove (`!A:real^N^N. ?e. &0 < e /\ !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% mat 1)`, GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` CHARACTERISTIC_POLYNOMIAL) THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`dimindex(:N)`; `a:num->real`] REAL_POLYFUN_FINITE_ROOTS) THEN MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP FINITE_IMAGE) THEN DISCH_THEN(MP_TAC o MATCH_MP LIMIT_POINT_FINITE) THEN DISCH_THEN(MP_TAC o SPEC `lift(&0)`) THEN REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN REWRITE_TAC[DIST_LIFT; LIFT_EQ; REAL_SUB_RZERO; NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN MP_TAC(SPEC `--x:real` th)) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `--x:real`) THEN ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_ABS_NEG] THEN ONCE_REWRITE_TAC[GSYM INVERTIBLE_NEG] THEN REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN REWRITE_TAC[GSYM MATRIX_CMUL_ADD_LDISTRIB; GSYM MATRIX_CMUL_ASSOC] THEN REWRITE_TAC[MATRIX_CMUL_LID; MATRIX_ADD_SYM]);; let MATRIX_WLOG_INVERTIBLE = prove (`!P. (!A:real^N^N. invertible A ==> P A) /\ (!A:real^N^N. ?d. &0 < d /\ closed {x | x IN cball(vec 0,d) /\ P(A + drop x %% mat 1)}) ==> !A:real^N^N. P A`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^1` o GEN_REWRITE_RULE I [CLOSED_LIMPT]) THEN ASM_SIMP_TAC[IN_ELIM_THM; DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN ANTS_TAC THENL [ALL_TAC; CONV_TAC TAUT] THEN MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_LIFT; IN_ELIM_THM] THEN REWRITE_TAC[GSYM LIFT_NUM; IN_CBALL_0; NORM_LIFT; DIST_LIFT] THEN REWRITE_TAC[REAL_SUB_RZERO; LIFT_EQ; LIFT_DROP] THEN EXISTS_TAC `min d ((min e k) / &2)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; let SYLVESTER_DETERMINANT_IDENTITY = prove (`!A:real^N^M B:real^M^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, let lemma1 = prove (`!A:real^N^N B:real^N^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN SUBGOAL_THEN `det((mat 1 + A ** B) ** A:real^N^N) = det(A ** (mat 1 + B ** A))` MP_TAC THENL [REWRITE_TAC[MATRIX_ADD_RDISTRIB; MATRIX_ADD_LDISTRIB] THEN REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID; MATRIX_MUL_ASSOC]; REWRITE_TAC[DET_MUL] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INVERTIBLE_DET_NZ]) THEN CONV_TAC REAL_RING]; X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; CONTINUOUS_CONST] THEN SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN REWRITE_TAC[LIFT_DROP; CONTINUOUS_AT_ID]]) in let lemma2 = prove (`!A:real^N^M B:real^M^N. dimindex(:M) <= dimindex(:N) ==> det(mat 1 + A ** B) = det(mat 1 + B ** A)`, REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC [`A':real^N^N = lambda i j. if i <= dimindex(:M) then (A:real^N^M)$i$j else &0`; `B':real^N^N = lambda i j. if j <= dimindex(:M) then (B:real^M^N)$i$j else &0`] THEN MP_TAC(ISPECL [`A':real^N^N`; `B':real^N^N`] lemma1) THEN SUBGOAL_THEN `(B':real^N^N) ** (A':real^N^N) = (B:real^M^N) ** (A:real^N^M)` SUBST1_TAC THENL [MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; FINITE_NUMSEG; SUBSET_NUMSEG; LE_REFL; TAUT `(p /\ q) /\ ~(p /\ r) <=> p /\ q /\ ~r`]; DISCH_THEN(SUBST1_TAC o SYM)] THEN REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {p | p permutes 1..dimindex(:N) /\ !i. dimindex(:M) < i ==> p i = i} (\p. sign p * product (1..dimindex(:N)) (\i. (mat 1 + (A':real^N^N) ** (B':real^N^N))$i$p i))` THEN CONJ_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; SIMP_TAC[IN_ELIM_THM; IMP_CONJ]] THEN X_GEN_TAC `p:num->num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE; PRODUCT_EQ_0_NUMSEG] THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `k:num` o CONJUNCT1 o GEN_REWRITE_RULE I [permutes]) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; REAL_ADD_LID] THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; GSYM NOT_LT]] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN EXISTS_TAC `\f:num->num. f` THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THENL [REWRITE_TAC[MESON[] `(?!x. P x /\ x = y) <=> P y`] THEN CONJ_TAC THENL [MATCH_MP_TAC PERMUTES_SUBSET THEN EXISTS_TAC `1..dimindex(:M)` THEN ASM_REWRITE_TAC[SUBSET_NUMSEG; LE_REFL]; X_GEN_TAC `k:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [permutes]) THEN ASM_REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; NOT_LE]]; MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [MATCH_MP_TAC PERMUTES_SUPERSET THEN EXISTS_TAC `1..dimindex(:N)` THEN ASM_REWRITE_TAC[IN_DIFF; IN_NUMSEG] THEN ASM_MESON_TAC[NOT_LE]; DISCH_TAC] THEN AP_TERM_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE `m:num <= n ==> n = m + (n - m)`)) THEN SIMP_TAC[PRODUCT_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN MATCH_MP_TAC(REAL_RING `x = y /\ z = &1 ==> x = y * z`) THEN CONJ_TAC THENL [MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MP_TAC(ISPECL [`p:num->num`; `1..dimindex(:M)`] PERMUTES_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `(p:num->num) i <= dimindex(:N)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN ASM_SIMP_TAC[LAMBDA_BETA]; MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG THEN ASM_SIMP_TAC[ARITH_RULE `n + 1 <= i ==> n < i`] THEN ASM_SIMP_TAC[ARITH_RULE `m:num <= n ==> m + (n - m) = n`] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN ASM_SIMP_TAC[REAL_EQ_ADD_LCANCEL_0; matrix_mul; LAMBDA_BETA] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `m + 1 <= i ==> ~(i <= m)`]]]) in REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE `dimindex(:M) <= dimindex(:N) \/ dimindex(:N) <= dimindex(:M)`) THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[]);; let COFACTOR_MATRIX_MUL = prove (`!A B:real^N^N. cofactor(A ** B) = cofactor(A) ** cofactor(B)`, MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL [ASM_SIMP_TAC[COFACTOR_MATRIX_INV; GSYM INVERTIBLE_DET_NZ; INVERTIBLE_MATRIX_MUL] THEN REWRITE_TAC[DET_MUL; MATRIX_MUL_LMUL] THEN REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_CMUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN ASM_SIMP_TAC[MATRIX_INV_MUL]; GEN_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]]; X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN MATCH_MP_TAC CLOSED_FORALL THEN GEN_TAC] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN REWRITE_TAC[CART_EQ] THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; cofactor; LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN (MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC]) THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; CONTINUOUS_CONST] THEN REPEAT(W(fun (asl,w) -> let t = find_term is_cond w in ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN TRY(MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN STRIP_TAC) THEN REWRITE_TAC[LIFT_CMUL] THEN TRY(MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; CONTINUOUS_CONST]) THEN REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_CONST; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; let DET_COFACTOR = prove (`!A:real^N^N. det(cofactor A) = det(A) pow (dimindex(:N) - 1)`, MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN X_GEN_TAC `A:real^N^N` THENL [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_FIELD `~(a = &0) ==> a * x = a * y ==> x = y`)) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN REWRITE_TAC[GSYM DET_MUL; MATRIX_MUL_RIGHT_COFACTOR] THEN REWRITE_TAC[DET_CMUL; GSYM(CONJUNCT2 real_pow); DET_I; REAL_MUL_RID] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`]; ALL_TAC] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_LIFT_POW] THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID] THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REPEAT(W(fun (asl,w) -> let t = find_term is_cond w in ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; let INVERTIBLE_COFACTOR = prove (`!A:real^N^N. invertible(cofactor A) <=> dimindex(:N) = 1 \/ invertible A`, SIMP_TAC[DET_COFACTOR; INVERTIBLE_DET_NZ; REAL_POW_EQ_0; DE_MORGAN_THM; DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`; DISJ_ACI]);; let COFACTOR_COFACTOR = prove (`!A:real^N^N. 2 <= dimindex(:N) ==> cofactor(cofactor A) = (det(A) pow (dimindex(:N) - 2)) %% A`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN X_GEN_TAC `A:real^N^N` THENL [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_TAC THEN MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] COFACTOR_MATRIX_MUL) THEN REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; COFACTOR_CMUL; COFACTOR_I] THEN REWRITE_TAC[COFACTOR_TRANSP] THEN DISCH_THEN(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; TRANSP_MATRIX_CMUL] THEN REWRITE_TAC[TRANSP_MAT] THEN DISCH_THEN(MP_TAC o AP_TERM `(\x. x ** A):real^N^N->real^N^N`) THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LEFT_COFACTOR] THEN REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N^N. inv(det(A:real^N^N)) %% x`) THEN ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_LINV; MATRIX_CMUL_LID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[REAL_POW_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; POP_ASSUM(K ALL_TAC)] THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN REWRITE_TAC[CART_EQ] THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL [REPLICATE_TAC 2 (ONCE_REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REPEAT(W(fun (asl,w) -> let t = find_term is_cond w in ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST]))); REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_LIFT_POW THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC; ALL_TAC]] THEN REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_CMUL; CONTINUOUS_AT_ID]);; let RANK_COFACTOR_EQ_FULL = prove (`!A:real^N^N. rank(cofactor A) = dimindex(:N) <=> dimindex(:N) = 1 \/ rank A = dimindex(:N)`, REWRITE_TAC[RANK_EQ_FULL_DET; DET_COFACTOR; REAL_POW_EQ_0] THEN SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN CONV_TAC TAUT);; let COFACTOR_EQ_0 = prove (`!A:real^N^N. cofactor A = mat 0 <=> rank(A) < dimindex(:N) - 1`, let lemma1 = prove (`!A:real^N^N. rank(A) < dimindex(:N) - 1 ==> cofactor A = mat 0`, GEN_TAC THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN SIMP_TAC[CART_EQ; cofactor; MAT_COMPONENT; LAMBDA_BETA; COND_ID] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[DET_EQ_0_RANK] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE `r < n - 1 ==> s <= r + 1 ==> s < n`)) THEN REWRITE_TAC[RANK_ROW; rows] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim (basis n INSERT {row i ((lambda k l. if l = n then &0 else (A:real^N^N)$k$l) :real^N^N) | i IN (1..dimindex(:N)) DELETE m})` THEN CONJ_TAC THENL [MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `m IN s /\ (!i. i IN s DELETE m ==> f i = g i) /\ f m = a ==> {f i | i IN s} SUBSET a INSERT {g i | i IN s DELETE m}`) THEN ASM_SIMP_TAC[IN_NUMSEG; IN_DELETE; row; LAMBDA_BETA; basis; LAMBDA_ETA]; REWRITE_TAC[DIM_INSERT] THEN MATCH_MP_TAC(ARITH_RULE `n <= k ==> (if p then n else n + 1) <= k + 1`) THEN MATCH_MP_TAC(MESON[DIM_LINEAR_IMAGE_LE; DIM_SUBSET; LE_TRANS] `(?f. linear f /\ t SUBSET IMAGE f s) ==> dim t <= dim s`) THEN EXISTS_TAC `(\x. lambda i. if i = n then &0 else x$i) :real^N->real^N` THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG; IN_DELETE] THEN STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA]]]) and lemma2 = prove (`!A:real^N^N. rank A < dimindex(:N) ==> ?n x. 1 <= n /\ n <= dimindex(:N) /\ rank A < rank((lambda i. if i = n then x else row i A):real^N^N)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?n. 1 <= n /\ n <= dimindex(:N) /\ row n (A:real^N^N) IN span {row j A | j IN (1..dimindex(:N)) DELETE n}` MP_TAC THENL [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN ASM_REWRITE_TAC[DET_EQ_0_RANK; RANK_TRANSP] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN SIMP_TAC[matrix_vector_mul; transp; VEC_COMPONENT; LAMBDA_BETA] THEN DISCH_TAC THEN SUBGOAL_THEN `row n A = vsum ((1..dimindex(:N)) DELETE n) (\i. --((c:real^N)$i / c$n) % row i (A:real^N^N))` SUBST1_TAC THENL [ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; REAL_DIV_REFL] THEN REWRITE_TAC[VECTOR_ARITH `n = x - -- &1 % n <=> x:real^N = vec 0`] THEN SIMP_TAC[VSUM_COMPONENT; row; VECTOR_MUL_COMPONENT; LAMBDA_BETA; CART_EQ; REAL_ARITH `--(x / y) * z:real = --(inv y) * z * x`] THEN ASM_SIMP_TAC[SUM_LMUL; VEC_COMPONENT; REAL_MUL_RZERO]; MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `span {row j (A:real^N^N) | j IN (1..dimindex(:N)) DELETE n} PSUBSET (:real^N)` MP_TAC THENL [REWRITE_TAC[PSUBSET; SUBSET_UNIV] THEN DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN REWRITE_TAC[DIM_UNIV] THEN MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n - 1 ==> ~(x = n)`) THEN REWRITE_TAC[DIMINDEX_GE_1; DIM_SPAN] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIM_LE_CARD o lhand o snd) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN SIMP_TAC[FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN ASM_SIMP_TAC[CARD_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN REWRITE_TAC[CARD_NUMSEG_1; LE_REFL]; DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s PSUBSET UNIV ==> ?x. ~(x IN s)`)) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN SUBGOAL_THEN `!A:real^N^N. rows A = row n A INSERT {row j A | j IN (1..dimindex (:N)) DELETE n}` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[rows; IN_DELETE; IN_NUMSEG] THEN ASM SET_TAC[]; ASM_SIMP_TAC[DIM_INSERT]] THEN COND_CASES_TAC THENL [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `x IN span s ==> x = y /\ s = t ==> ~(y IN span t) ==> q`)) THEN ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA]; MATCH_MP_TAC(ARITH_RULE `s = t ==> s < t + 1`) THEN AP_TERM_TAC THEN REWRITE_TAC[row]] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA; CART_EQ]]]) in GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[lemma1] THEN DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `r <= n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN REPEAT CONJ_TAC THENL [MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN ARITH_TAC; REWRITE_TAC[RANK_EQ_FULL_DET] THEN MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN REWRITE_TAC[MAT_EQ; ARITH_EQ]; DISCH_TAC] THEN MP_TAC(ISPEC `A:real^N^N` lemma2) THEN ASM_REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `n - 1 < n <=> 1 <= n`] THEN DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `n - 1 < k ==> k <= MIN n n ==> k = n`)) THEN REWRITE_TAC[RANK_BOUND; RANK_EQ_FULL_DET] THEN MP_TAC(GEN `A:real^N^N` (ISPECL [`A:real^N^N`; `n:num`] DET_COFACTOR_EXPANSION)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN SIMP_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `m:num`) THEN ASM_SIMP_TAC[MAT_COMPONENT; COND_ID] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row] THEN REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA]) THEN ASM_MESON_TAC[]);; let RANK_COFACTOR_EQ_1 = prove (`!A:real^N^N. rank(cofactor A) = 1 <=> dimindex(:N) = 1 \/ rank A = dimindex(:N) - 1`, GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL [ASM_MESON_TAC[RANK_COFACTOR_EQ_FULL]; ASM_REWRITE_TAC[]] THEN EQ_TAC THENL [ASM_CASES_TAC `cofactor A:real^N^N = mat 0` THEN ASM_REWRITE_TAC[RANK_0; ARITH_EQ] THEN DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `~(r < n - 1) /\ ~(r = n) /\ r <= MIN n n ==> r = n - 1`) THEN ASM_REWRITE_TAC[RANK_BOUND; GSYM COFACTOR_EQ_0] THEN MP_TAC(ISPEC `A:real^N^N` RANK_COFACTOR_EQ_FULL) THEN ASM_REWRITE_TAC[]; DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `~(n = 0) /\ n <= 1 ==> n = 1`) THEN ASM_REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0; LT_REFL] THEN MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] RANK_SYLVESTER) THEN ASM_REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; RANK_TRANSP] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a = n - 1 ==> 1 <= n ==> a < n`)) THEN ASM_SIMP_TAC[GSYM DET_EQ_0_RANK; DIMINDEX_GE_1] THEN DISCH_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; RANK_0] THEN ARITH_TAC]);; let RANK_COFACTOR = prove (`!A:real^N^N. rank(cofactor A) = if rank(A) = dimindex(:N) then dimindex(:N) else if rank(A) = dimindex(:N) - 1 then 1 else 0`, GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_FULL] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_1] THEN REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0] THEN MATCH_MP_TAC(ARITH_RULE `r <= MIN n n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN ASM_REWRITE_TAC[RANK_BOUND]);; (* ------------------------------------------------------------------------- *) (* Not in so many words, but combining this with intermediate value theorem *) (* implies the determinant is an open map. *) (* ------------------------------------------------------------------------- *) let DET_OPEN_MAP = prove (`!A:real^N^N e. &0 < e ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < det A) /\ (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > det A)`, let lemma1 = prove (`!A:real^N^N i e. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 /\ &0 < e ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < &0) /\ (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > &0)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `det(A:real^N^N) = &0` ASSUME_TAC THENL [ASM_MESON_TAC[DET_ZERO_ROW]; ALL_TAC] THEN MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[INVERTIBLE_DET_NZ]] THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> x < &0 \/ &0 < x`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN (CONJ_TAC THENL [EXISTS_TAC `A + min d e / &2 %% mat 1:real^N^N`; EXISTS_TAC `(lambda j. if j = i then --(&1) % row i (A + min d e / &2 %% mat 1:real^N^N) else row j (A + min d e / &2 %% mat 1:real^N^N)) :real^N^N`]) THEN ASM_SIMP_TAC[DET_ROW_MUL; MESON[] `(if j = i then f i else f j) = f j`] THEN REWRITE_TAC[row; LAMBDA_ETA] THEN ASM_REWRITE_TAC[real_gt; GSYM row] THEN TRY(CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT; VECTOR_MUL_COMPONENT] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_SIMP_TAC[row; LAMBDA_BETA; VEC_COMPONENT] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC) and lemma2 = prove (`!A:real^N^N x:real^N i. 1 <= i /\ i <= dimindex(:N) /\ x$i = &1 ==> det(lambda k. if k = i then transp A ** x else row k A) = det A`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `det(lambda k. if k = i then row i (A:real^N^N) + (transp A ** x - row i A) else row k A)` THEN CONJ_TAC THENL [REWRITE_TAC[VECTOR_ARITH `r + (x - r):real^N = x`]; ALL_TAC] THEN MATCH_MP_TAC DET_ROW_SPAN THEN SUBGOAL_THEN `transp(A:real^N^N) ** x - row i A = vsum ((1..dimindex(:N)) DELETE i) (\k. x$k % row k A)` SUBST1_TAC THENL [SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_SUB_COMPONENT; row; transp; LAMBDA_BETA; matrix_vector_mul; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_AC]; ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_DELETE; IN_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) in REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `cofactor(A:real^N^N) = mat 0` THENL [MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN REWRITE_TAC[MAT_EQ; ARITH_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `?c i. 1 <= i /\ i <= dimindex(:N) /\ c$i = &1 /\ transp(A:real^N^N) ** c = vec 0` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN ASM_REWRITE_TAC[DET_TRANSP] THEN DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN REWRITE_TAC[VEC_COMPONENT; NOT_IMP; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `inv(c$i) % c:real^N` THEN ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV] THEN ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; VECTOR_MUL_RZERO]; ALL_TAC] THEN MP_TAC(ISPECL [`(lambda k. if k = i then transp A ** c else row k (A:real^N^N)):real^N^N`; `i:num`; `min e (e / &(dimindex(:N)) / (&1 + norm(&2 % basis i - c:real^N)))`] lemma1) THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN ANTS_TAC THENL [ASM_SIMP_TAC[row; CART_EQ; VEC_COMPONENT; LAMBDA_BETA]; ALL_TAC] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN ABBREV_TAC `A':real^N^N = lambda k. if k = i then vec 0 else row k (A:real^N^N)` THEN DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(lambda k. if k = i then transp(B:real^N^N) ** (&2 % basis i - c) else row k B):real^N^N` THEN ASM_SIMP_TAC[lemma2; BASIS_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; REAL_ARITH `&2 * x - x = x`] THEN (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN (COND_CASES_TAC THENL [ALL_TAC; FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; row]] THEN SUBGOAL_THEN `(A:real^N^N)$k$l = (transp(A':real^N^N) ** (&2 % basis i - c:real^N))$l` SUBST1_TAC THENL [ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[COND_RAND; COND_RATOR] THEN SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LZERO] THEN ASM_SIMP_TAC[SUM_CASES; FINITE_NUMSEG; SUM_0; REAL_ADD_LID] THEN ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN UNDISCH_TAC `transp(A:real^N^N) ** (c:real^N) = vec 0` THEN ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT; matrix_vector_mul; LAMBDA_BETA; row; transp] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[REAL_MUL_RNEG; SUM_NEG] THEN REAL_ARITH_TAC; REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM TRANSP_MATRIX_SUB; GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB]] THEN ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN X_GEN_TAC `r:num` THEN REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN TRANS_TAC REAL_LET_TRANS `abs((B - A':real^N^N)$r$l) * (&1 + norm(&2 % basis i - c:real^N))` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= &1 + b`) THEN ASM_SIMP_TAC[COMPONENT_LE_NORM]; ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; GSYM REAL_LT_RDIV_EQ; NORM_ARITH `&0 < &1 + norm(x:real^N)`]]); FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN SIMP_TAC[CART_EQ; MAT_COMPONENT; COND_ID] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_gt] THEN DISCH_THEN(X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC (X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC))) THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH `~(x = &0) ==> &0 < x \/ x < &0`)) THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN (CONJ_TAC THENL [EXISTS_TAC `(lambda m n. if m = i /\ n = j then (A:real^N^N)$i$j - e / (&1 + abs(cofactor A$i$j)) else A$m$n):real^N^N`; EXISTS_TAC `(lambda m n. if m = i /\ n = j then (A:real^N^N)$i$j + e / (&1 + abs(cofactor A$i$j)) else A$m$n):real^N^N`]) THEN (CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ARITH `abs(a - e - a) = abs e`; REAL_ARITH `abs((a + e) - a) = abs e`] THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_ABS] THEN ASM_SIMP_TAC[REAL_ARITH `abs(&1 + abs x) = &1 + abs x`; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ &0 < e * x ==> abs e < e * (&1 + x)`) THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN MP_TAC(GEN `A:real^N^N` (SPECL [`A:real^N^N`; `i:num`] DET_COFACTOR_EXPANSION)) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN ASM_SIMP_TAC[GSYM SUM_SUB_NUMSEG; LAMBDA_BETA] THEN REWRITE_TAC[REAL_ARITH `p - A$i$j * cofactor A$i$j = --(A$i$j * cofactor A$i$j - p)`] THEN REWRITE_TAC[SUM_NEG; REAL_ARITH `a * b - c * d:real = b * (a - c) + c * (b - d)`] THEN REWRITE_TAC[SUM_ADD_NUMSEG; REAL_NEG_ADD] THEN MATCH_MP_TAC(REAL_ARITH `b = &0 /\ &0 < a ==> &0 < a + b`) THEN (CONJ_TAC THENL [REWRITE_TAC[REAL_NEG_EQ_0] THEN MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN REWRITE_TAC[GSYM SUM_NEG; GSYM REAL_MUL_RNEG] THEN MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC(MESON[REAL_LT_IMP_LE; REAL_LE_REFL] `(?i. P i /\ &0 < f i /\ (!j. P j /\ ~(j = i) ==> f j = &0)) ==> (!j. P j ==> &0 <= f j) /\ (?j. P j /\ &0 < f j)`) THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; IN_NUMSEG; REAL_NEG_0] THEN REWRITE_TAC[REAL_ARITH `a - (a + e):real = --e`; REAL_ARITH `a - (a - e):real = e`; REAL_NEG_NEG] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REWRITE_TAC[REAL_ARITH `&0 < a * --b <=> &0 < --a * b`] THEN ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_NEG_GT0] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Infinite sums of vectors. Allow general starting point (and more). *) (* ------------------------------------------------------------------------- *) parse_as_infix("sums",(12,"right"));; let sums = new_definition `(f sums l) s = ((\n. vsum(s INTER (0..n)) f) --> l) sequentially`;; let infsum = new_definition `infsum s f = @l. (f sums l) s`;; let summable = new_definition `summable s f = ?l. (f sums l) s`;; let SUMS_SUMMABLE = prove (`!f l s. (f sums l) s ==> summable s f`, REWRITE_TAC[summable] THEN MESON_TAC[]);; let SUMS_INFSUM = prove (`!f s. (f sums (infsum s f)) s <=> summable s f`, REWRITE_TAC[infsum; summable] THEN MESON_TAC[]);; let SUMS_LIM = prove (`!f:num->real^N s. (f sums lim sequentially (\n. vsum (s INTER (0..n)) f)) s <=> summable s f`, GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL [MESON_TAC[summable]; REWRITE_TAC[summable; sums] THEN STRIP_TAC THEN REWRITE_TAC[lim] THEN ASM_MESON_TAC[]]);; let FINITE_INTER_NUMSEG = prove (`!s m n. FINITE(s INTER (m..n))`, MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG; INTER_SUBSET]);; let SERIES_FROM = prove (`!f l k. (f sums l) (from k) = ((\n. vsum(k..n) f) --> l) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);; let SERIES_UNIQUE = prove (`!f:num->real^N l l' s. (f sums l) s /\ (f sums l') s ==> (l = l')`, REWRITE_TAC[sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_UNIQUE]);; let INFSUM_UNIQUE = prove (`!f:num->real^N l s. (f sums l) s ==> infsum s f = l`, MESON_TAC[SERIES_UNIQUE; SUMS_INFSUM; summable]);; let SERIES_TERMS_TOZERO = prove (`!f l n. (f sums l) (from n) ==> (f --> vec 0) sequentially`, REPEAT GEN_TAC THEN SIMP_TAC[sums; LIM_SEQUENTIALLY; FROM_INTER_NUMSEG] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `m - 1` th) THEN MP_TAC(SPEC `m:num` th)) THEN SUBGOAL_THEN `0 < m /\ n <= m` (fun th -> SIMP_TAC[VSUM_CLAUSES_RIGHT; th]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; let SERIES_FINITE = prove (`!f s. FINITE s ==> (f sums (vsum s f)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN SUBGOAL_THEN `s INTER (0..m) = s` (fun th -> ASM_REWRITE_TAC[th; DIST_REFL]) THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[LE_TRANS]);; let SERIES_LINEAR = prove (`!f h l s. (f sums l) s /\ linear h ==> ((\n. h(f n)) sums h l) s`, SIMP_TAC[sums; LIM_LINEAR; FINITE_INTER; FINITE_NUMSEG; GSYM(REWRITE_RULE[o_DEF] LINEAR_VSUM)]);; let SERIES_0 = prove (`!s. ((\n. vec 0) sums (vec 0)) s`, REWRITE_TAC[sums; VSUM_0; LIM_CONST]);; let SERIES_ADD = prove (`!x x0 y y0 s. (x sums x0) s /\ (y sums y0) s ==> ((\n. x n + y n) sums (x0 + y0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_ADD; LIM_ADD]);; let SERIES_SUB = prove (`!x x0 y y0 s. (x sums x0) s /\ (y sums y0) s ==> ((\n. x n - y n) sums (x0 - y0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_SUB; LIM_SUB]);; let SERIES_CMUL = prove (`!x x0 c s. (x sums x0) s ==> ((\n. c % x n) sums (c % x0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_LMUL; LIM_CMUL]);; let SERIES_NEG = prove (`!x x0 s. (x sums x0) s ==> ((\n. --(x n)) sums (--x0)) s`, SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_NEG; LIM_NEG]);; let SUMS_IFF = prove (`!f g k. (!x. x IN k ==> f x = g x) ==> ((f sums l) k <=> (g sums l) k)`, REPEAT STRIP_TAC THEN REWRITE_TAC[sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);; let SUMS_EQ = prove (`!f g k. (!x. x IN k ==> f x = g x) /\ (f sums l) k ==> (g sums l) k`, MESON_TAC[SUMS_IFF]);; let SUMS_0 = prove (`!f:num->real^N s. (!n. n IN s ==> f n = vec 0) ==> (f sums vec 0) s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n:num. vec 0:real^N` THEN ASM_SIMP_TAC[SERIES_0]);; let SERIES_FINITE_SUPPORT = prove (`!f:num->real^N s k. FINITE (s INTER k) /\ (!x. ~(x IN s INTER k) ==> f x = vec 0) ==> (f sums vsum (s INTER k) f) k`, REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN SUBGOAL_THEN `vsum (k INTER (0..n)) (f:num->real^N) = vsum(s INTER k) f` (fun th -> ASM_REWRITE_TAC[DIST_REFL; th]) THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[IN_INTER; LE_TRANS]);; let SERIES_COMPONENT = prove (`!f s l:real^N k. (f sums l) s /\ 1 <= k /\ k <= dimindex(:N) ==> ((\i. lift(f(i)$k)) sums lift(l$k)) s`, REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[GSYM LIFT_SUM; GSYM VSUM_COMPONENT; FINITE_INTER; FINITE_NUMSEG] THEN ASM_SIMP_TAC[o_DEF; LIM_COMPONENT]);; let SERIES_DIFFS = prove (`!f:num->real^N k. (f --> vec 0) sequentially ==> ((\n. f(n) - f(n + 1)) sums f(k)) (from k)`, REWRITE_TAC[sums; FROM_INTER_NUMSEG; VSUM_DIFFS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC `\n. (f:num->real^N) k - f(n + 1)` THEN CONJ_TAC THENL [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN SIMP_TAC[]; GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN MATCH_MP_TAC SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);; let SERIES_TRIVIAL = prove (`!f. (f sums vec 0) {}`, REWRITE_TAC[sums; INTER_EMPTY; VSUM_CLAUSES; LIM_CONST]);; let SERIES_RESTRICT = prove (`!f k l:real^N. ((\n. if n IN k then f(n) else vec 0) sums l) (:num) <=> (f sums l) k`, REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] `vsum s f = vsum t f /\ vsum t f = vsum t g ==> vsum s f = vsum t g`) THEN CONJ_TAC THENL [MATCH_MP_TAC VSUM_SUPERSET THEN SET_TAC[]; MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_INTER]]);; let SERIES_VSUM = prove (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = vec 0) /\ vsum s f = l ==> (f sums l) k`, REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL [ASM SET_TAC []; ASM_MESON_TAC [SERIES_FINITE_SUPPORT]]);; let SUMS_REINDEX = prove (`!k a l n. ((\x. a(x + k)) sums l) (from n) <=> (a sums l) (from(n + k))`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM VSUM_OFFSET] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`; ARITH_RULE `N + k:num <= n ==> N <= n + k`]);; (* ------------------------------------------------------------------------- *) (* Similar combining theorems just for summability. *) (* ------------------------------------------------------------------------- *) let SUMMABLE_LINEAR = prove (`!f h s. summable s f /\ linear h ==> summable s (\n. h(f n))`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_LINEAR]);; let SUMMABLE_0 = prove (`!s. summable s (\n. vec 0)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_0]);; let SUMMABLE_ADD = prove (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n + y n)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_ADD]);; let SUMMABLE_SUB = prove (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n - y n)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUB]);; let SUMMABLE_CMUL = prove (`!s x c. summable s x ==> summable s (\n. c % x n)`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_CMUL]);; let SUMMABLE_NEG = prove (`!x s. summable s x ==> summable s (\n. --(x n))`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_NEG]);; let SUMMABLE_IFF = prove (`!f g k. (!x. x IN k ==> f x = g x) ==> (summable k f <=> summable k g)`, REWRITE_TAC[summable] THEN MESON_TAC[SUMS_IFF]);; let SUMMABLE_EQ = prove (`!f g k. (!x. x IN k ==> f x = g x) /\ summable k f ==> summable k g`, REWRITE_TAC[summable] THEN MESON_TAC[SUMS_EQ]);; let SUMMABLE_COMPONENT = prove (`!f:num->real^N s k. summable s f /\ 1 <= k /\ k <= dimindex(:N) ==> summable s (\i. lift(f(i)$k))`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^N` o REWRITE_RULE[summable]) THEN REWRITE_TAC[summable] THEN EXISTS_TAC `lift((l:real^N)$k)` THEN ASM_SIMP_TAC[SERIES_COMPONENT]);; let SERIES_SUBSET = prove (`!x s t l. s SUBSET t /\ ((\i. if i IN s then x i else vec 0) sums l) t ==> (x sums l) s`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[sums] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let SUMMABLE_SUBSET = prove (`!x s t. s SUBSET t /\ summable t (\i. if i IN s then x i else vec 0) ==> summable s x`, REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUBSET]);; let SUMMABLE_TRIVIAL = prove (`!f:num->real^N. summable {} f`, GEN_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `vec 0:real^N` THEN REWRITE_TAC[SERIES_TRIVIAL]);; let SUMMABLE_RESTRICT = prove (`!f:num->real^N k. summable (:num) (\n. if n IN k then f(n) else vec 0) <=> summable k f`, REWRITE_TAC[summable; SERIES_RESTRICT]);; let SUMS_FINITE_DIFF = prove (`!f:num->real^N t s l. t SUBSET s /\ FINITE t /\ (f sums l) s ==> (f sums (l - vsum t f)) (s DIFF t)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let SUMS_FINITE_UNION = prove (`!f:num->real^N s t l. FINITE t /\ (f sums l) s ==> (f sums (l + vsum (t DIFF s) f)) (s UNION t)`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN DISCH_THEN(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF; IN_UNION] THEN MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; let SUMS_OFFSET = prove (`!f:num->real^N l m n. (f sums l) (from m) /\ m < n ==> (f sums (l - vsum(m..(n-1)) f)) (from n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC; MATCH_MP_TAC SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);; let SUMS_OFFSET_REV = prove (`!f:num->real^N l m n. (f sums l) (from m) /\ n < m ==> (f sums (l + vsum(n..m-1) f)) (from n)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `from m`; `n..m-1`; `l:real^N`] SUMS_FINITE_UNION) THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN ASM_ARITH_TAC);; let SUMMABLE_REINDEX = prove (`!k a n. summable (from n) (\x. a (x + k)) <=> summable (from(n + k)) a`, REWRITE_TAC[summable; GSYM SUMS_REINDEX]);; let SERIES_DROP_LE = prove (`!f g s a b. (f sums a) s /\ (g sums b) s /\ (!x. x IN s ==> drop(f x) <= drop(g x)) ==> drop a <= drop b`, REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^1)` THEN EXISTS_TAC `\n. vsum (s INTER (0..n)) (g:num->real^1)` THEN ASM_REWRITE_TAC[DROP_VSUM] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; o_THM; IN_INTER; IN_NUMSEG]);; let SERIES_DROP_POS = prove (`!f s a. (f sums a) s /\ (!x. x IN s ==> &0 <= drop(f x)) ==> &0 <= drop a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(\n. vec 0):num->real^1`; `f:num->real^1`; `s:num->bool`; `vec 0:real^1`; `a:real^1`] SERIES_DROP_LE) THEN ASM_SIMP_TAC[SUMS_0; DROP_VEC]);; let SERIES_BOUND = prove (`!f:num->real^N g s a b. (f sums a) s /\ ((lift o g) sums (lift b)) s /\ (!i. i IN s ==> norm(f i) <= g i) ==> norm(a) <= b`, REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^N)` THEN ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..m)) g` THEN CONJ_TAC THEN ASM_SIMP_TAC[VSUM_NORM_LE; IN_INTER; FINITE_NUMSEG; FINITE_INTER] THEN RULE_ASSUM_TAC(REWRITE_RULE[GSYM sums]) THEN UNDISCH_TAC `((lift o g) sums lift b) s` THEN GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN REWRITE_TAC[GSYM FROM_0] THEN DISCH_THEN(MP_TAC o SPEC `m + 1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN REWRITE_TAC[ARITH_RULE `0 < m + 1`; o_DEF; ADD_SUB] THEN REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN REWRITE_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SERIES_DROP_POS)) THEN REWRITE_TAC[DROP_SUB; LIFT_DROP; ONCE_REWRITE_RULE[INTER_COMM] (GSYM INTER); REAL_SUB_LE] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_REFL] THEN ASM_MESON_TAC[NORM_ARITH `norm(x:real^N) <= y ==> &0 <= y`]);; (* ------------------------------------------------------------------------- *) (* Similar combining theorems for infsum. *) (* ------------------------------------------------------------------------- *) let INFSUM_LINEAR = prove (`!f h s. summable s f /\ linear h ==> infsum s (\n. h(f n)) = h(infsum s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_0 = prove (`infsum s (\i. vec 0) = vec 0`, MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[SERIES_0]);; let INFSUM_ADD = prove (`!x y s. summable s x /\ summable s y ==> infsum s (\i. x i + y i) = infsum s x + infsum s y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_ADD THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_SUB = prove (`!x y s. summable s x /\ summable s y ==> infsum s (\i. x i - y i) = infsum s x - infsum s y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_SUB THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_CMUL = prove (`!s x c. summable s x ==> infsum s (\n. c % x n) = c % infsum s x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_NEG = prove (`!s x. summable s x ==> infsum s (\n. --(x n)) = --(infsum s x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN MATCH_MP_TAC SERIES_NEG THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; let INFSUM_EQ = prove (`!f g k. summable k f /\ summable k g /\ (!x. x IN k ==> f x = g x) ==> infsum k f = infsum k g`, REPEAT STRIP_TAC THEN REWRITE_TAC[infsum] THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[SUMS_EQ; SUMS_INFSUM]);; let INFSUM_RESTRICT = prove (`!k a:num->real^N. infsum (:num) (\n. if n IN k then a n else vec 0) = infsum k a`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`a:num->real^N`; `k:num->bool`] SUMMABLE_RESTRICT) THEN ASM_CASES_TAC `summable k (a:num->real^N)` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL [MATCH_MP_TAC INFSUM_UNIQUE THEN ASM_REWRITE_TAC[SERIES_RESTRICT; SUMS_INFSUM]; RULE_ASSUM_TAC(REWRITE_RULE[summable; NOT_EXISTS_THM]) THEN ASM_REWRITE_TAC[infsum]]);; let PARTIAL_SUMS_COMPONENT_LE_INFSUM = prove (`!f:num->real^N s k n. 1 <= k /\ k <= dimindex(:N) /\ (!i. i IN s ==> &0 <= (f i)$k) /\ summable s f ==> (vsum (s INTER (0..n)) f)$k <= (infsum s f)$k`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `vsum (s INTER (0..n)) (f:num->real^N)$k - (infsum s f)$k`) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N + n:num`)) THEN REWRITE_TAC[LE_ADD; REAL_NOT_LT; dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((vsum (s INTER (0..N + n)) f - infsum s f:real^N)$k)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH `s < a /\ a <= b ==> a - s <= abs(b - s)`) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN SIMP_TAC[NUMSEG_ADD_SPLIT; LE_0; UNION_OVER_INTER] THEN W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhand o rand o snd) THEN ANTS_TAC THENL [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; DISJOINT; EXTENSION] THEN REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LE_ADDR; VECTOR_ADD_COMPONENT] THEN ASM_SIMP_TAC[VSUM_COMPONENT] THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);; let PARTIAL_SUMS_DROP_LE_INFSUM = prove (`!f s n. (!i. i IN s ==> &0 <= drop(f i)) /\ summable s f ==> drop(vsum (s INTER (0..n)) f) <= drop(infsum s f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[drop] THEN MATCH_MP_TAC PARTIAL_SUMS_COMPONENT_LE_INFSUM THEN ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL; GSYM drop]);; (* ------------------------------------------------------------------------- *) (* Cauchy criterion for series. *) (* ------------------------------------------------------------------------- *) let SEQUENCE_CAUCHY_WLOG = prove (`!P s. (!m n:num. P m /\ P n ==> dist(s m,s n) < e) <=> (!m n. P m /\ P n /\ m <= n ==> dist(s m,s n) < e)`, MESON_TAC[DIST_SYM; LE_CASES]);; let VSUM_DIFF_LEMMA = prove (`!f:num->real^N k m n. m <= n ==> vsum(k INTER (0..n)) f - vsum(k INTER (0..m)) f = vsum(k INTER (m+1..n)) f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `k INTER (0..n)`; `k INTER (0..m)`] VSUM_DIFF) THEN ANTS_TAC THENL [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC (SET_RULE `s SUBSET t ==> (u INTER s SUBSET u INTER t)`) THEN REWRITE_TAC[SUBSET; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `(k INTER s) DIFF (k INTER t) = k INTER (s DIFF t)`] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC]);; let NORM_VSUM_TRIVIAL_LEMMA = prove (`!e. &0 < e ==> (P ==> norm(vsum(s INTER (m..n)) f) < e <=> P ==> n < m \/ norm(vsum(s INTER (m..n)) f) < e)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n:num < m` THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [GSYM NUMSEG_EMPTY]) THEN ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0; INTER_EMPTY]);; let SERIES_CAUCHY = prove (`!f s. (?l. (f sums l) s) = !e. &0 < e ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; CONVERGENT_EQ_CAUCHY; cauchy] THEN REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN REWRITE_TAC[NOT_LT; ARITH_RULE `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> N + 1 <= m + 1 /\ m + 1 <= n`] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN ASM_ARITH_TAC);; let SUMMABLE_CAUCHY = prove (`!f s. summable s f <=> !e. &0 < e ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`, REWRITE_TAC[summable; GSYM SERIES_CAUCHY]);; let SUMMABLE_IFF_EVENTUALLY = prove (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) ==> (summable k f <=> summable k g)`, REWRITE_TAC[summable; SERIES_CAUCHY] THEN REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `N1:num` (fun th -> EXISTS_TAC `N0 + N1:num` THEN MP_TAC th)) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER; IN_NUMSEG] THEN REPEAT STRIP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; let SUMMABLE_EQ_EVENTUALLY = prove (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ summable k f ==> summable k g`, MESON_TAC[SUMMABLE_IFF_EVENTUALLY]);; let SUMMABLE_IFF_COFINITE = prove (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) ==> (summable s f <=> summable t f)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUMMABLE_RESTRICT] THEN MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN FIRST_ASSUM(MP_TAC o ISPEC `\x:num.x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN REWRITE_TAC[ARITH_RULE `N + 1 <= n <=> ~(n <= N)`] THEN ASM SET_TAC[]);; let SUMMABLE_EQ_COFINITE = prove (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ summable s f ==> summable t f`, MESON_TAC[SUMMABLE_IFF_COFINITE]);; let SUMMABLE_FROM_ELSEWHERE = prove (`!f m n. summable (from m) f ==> summable (from n) f`, REPEAT GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ_COFINITE) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Uniform vesion of Cauchy criterion. *) (* ------------------------------------------------------------------------- *) let SERIES_CAUCHY_UNIFORM = prove (`!P f:A->num->real^N k. (?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(vsum(k INTER (0..n)) (f x), l x) < e) <=> (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x ==> norm(vsum(k INTER (m..n)) (f x)) < e)`, REPEAT GEN_TAC THEN REWRITE_TAC[sums; UNIFORMLY_CONVERGENT_EQ_CAUCHY; cauchy] THEN ONCE_REWRITE_TAC[MESON[] `(!m n:num y. N <= m /\ N <= n /\ P y ==> Q m n y) <=> (!y. P y ==> !m n. N <= m /\ N <= n ==> Q m n y)`] THEN REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN REWRITE_TAC[NOT_LT; ARITH_RULE `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> N + 1 <= m + 1 /\ m + 1 <= n`] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* So trivially, terms of a convergent series go to zero. *) (* ------------------------------------------------------------------------- *) let SERIES_GOESTOZERO = prove (`!s x. summable s x ==> !e. &0 < e ==> eventually (\n. n IN s ==> norm(x n) < e) sequentially`, REPEAT GEN_TAC THEN REWRITE_TAC[summable; SERIES_CAUCHY] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`]) THEN ASM_SIMP_TAC[NUMSEG_SING; GE; SET_RULE `n IN s ==> s INTER {n} = {n}`] THEN REWRITE_TAC[VSUM_SING]);; let SUMMABLE_IMP_TOZERO = prove (`!f:num->real^N k. summable k f ==> ((\n. if n IN k then f(n) else vec 0) --> vec 0) sequentially`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUMMABLE_RESTRICT] THEN REWRITE_TAC[summable; LIM_SEQUENTIALLY; INTER_UNIV; sums] THEN DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `n - 1` th) THEN MP_TAC(SPEC `n:num` th)) THEN ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> N <= n /\ N <= n - 1`] THEN ABBREV_TAC `m = n - 1` THEN SUBGOAL_THEN `n = SUC m` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC NORM_ARITH);; let SUMMABLE_IMP_BOUNDED = prove (`!f:num->real^N k. summable k f ==> bounded (IMAGE f k)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_IMP_LE; NORM_0]);; let SUMMABLE_IMP_SUMS_BOUNDED = prove (`!f:num->real^N k. summable (from k) f ==> bounded { vsum(k..n) f | n IN (:num) }`, REWRITE_TAC[summable; sums; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Comparison test. *) (* ------------------------------------------------------------------------- *) let SERIES_COMPARISON = prove (`!f g s. (?l. ((lift o g) sums l) s) /\ (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) ==> ?l:real^N. (f sums l) s`, REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_CAUCHY] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num /\ m <= x ==> x >= N1`]; ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num ==> m >= N2`]]);; let SUMMABLE_COMPARISON = prove (`!f g s. summable s (lift o g) /\ (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) ==> summable s f`, REWRITE_TAC[summable; SERIES_COMPARISON]);; let SERIES_LIFT_ABSCONV_IMP_CONV = prove (`!x:num->real^N k. summable k (\n. lift(norm(x n))) ==> summable k x`, REWRITE_TAC[summable] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `\n:num. norm(x n:real^N)` THEN ASM_REWRITE_TAC[o_DEF; REAL_LE_REFL] THEN ASM_MESON_TAC[]);; let SUMMABLE_SUBSET_ABSCONV = prove (`!x:num->real^N s t. summable s (\n. lift(norm(x n))) /\ t SUBSET s ==> summable t (\n. lift(norm(x n)))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN EXISTS_TAC `\n:num. norm(x n:real^N)` THEN ASM_REWRITE_TAC[o_DEF; GSYM summable] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; NORM_LIFT; REAL_ABS_NORM; NORM_0; NORM_POS_LE]);; let SERIES_COMPARISON_BOUND = prove (`!f:num->real^N g s a. (g sums a) s /\ (!i. i IN s ==> norm(f i) <= drop(g i)) ==> ?l. (f sums l) s /\ norm(l) <= drop a`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] SUMMABLE_COMPARISON) THEN REWRITE_TAC[o_DEF; LIFT_DROP; GE; ETA_AX; summable] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[FROM_0; INTER_UNIV; sums]) THEN MATCH_MP_TAC SERIES_BOUND THEN MAP_EVERY EXISTS_TAC [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] THEN ASM_REWRITE_TAC[sums; o_DEF; LIFT_DROP; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Uniform version of comparison test. *) (* ------------------------------------------------------------------------- *) let SERIES_COMPARISON_UNIFORM = prove (`!f g P s. (?l. ((lift o g) sums l) s) /\ (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= g n) ==> ?l:A->real^N. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(vsum(s INTER (0..n)) (f x), l x) < e`, REPEAT GEN_TAC THEN SIMP_TAC[GE; SERIES_CAUCHY; SERIES_CAUCHY_UNIFORM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`]; ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);; (* ------------------------------------------------------------------------- *) (* Ratio test. *) (* ------------------------------------------------------------------------- *) let SERIES_RATIO = prove (`!c a s N. c < &1 /\ (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n))) ==> ?l:real^N. (a sums l) s`, REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON THEN DISJ_CASES_TAC(REAL_ARITH `c <= &0 \/ &0 < c`) THENL [EXISTS_TAC `\n:num. &0` THEN REWRITE_TAC[o_DEF; LIFT_NUM] THEN CONJ_TAC THENL [MESON_TAC[SERIES_0]; ALL_TAC] THEN EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm(a(n - 1):real^N)` THEN CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N + 1 <= n ==> SUC(n - 1) = n /\ N <= n - 1`]; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= --c * x ==> c * x <= &0`) THEN MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN UNDISCH_TAC `c <= &0` THEN REAL_ARITH_TAC; ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`))] THEN EXISTS_TAC `\n. norm(a(N):real^N) * c pow (n - N)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; EXISTS_TAC `N:num` THEN SIMP_TAC[GE; LE_EXISTS; IMP_CONJ; ADD_SUB2; LEFT_IMP_EXISTS_THM] THEN SUBGOAL_THEN `!d:num. norm(a(N + d):real^N) <= norm(a N) * c pow d` (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_RID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm((a:num->real^N) (N + d))` THEN ASM_SIMP_TAC[LE_ADD] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]] THEN GEN_REWRITE_TAC I [SERIES_CAUCHY] THEN X_GEN_TAC `e:real` THEN SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER; NORM_LIFT; FINITE_NUMSEG] THEN DISCH_TAC THEN SIMP_TAC[SUM_LMUL; FINITE_INTER; FINITE_NUMSEG] THEN ASM_CASES_TAC `(a:num->real^N) N = vec 0` THENL [ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_ABS_NUM]; ALL_TAC] THEN MP_TAC(SPECL [`c:real`; `((&1 - c) * e) / norm((a:num->real^N) N)`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_SUB_LT; NORM_POS_LT; GE] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `N + M:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(norm((a:num->real^N) N) * sum(m..n) (\i. c pow (i - N)))` THEN CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN ASM_SIMP_TAC[SUM_POS_LE; FINITE_INTER_NUMSEG; REAL_POW_LE] THEN MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[REAL_POW_LE] THEN REWRITE_TAC[FINITE_INTER_NUMSEG; FINITE_NUMSEG] THEN REWRITE_TAC[IN_INTER; IN_DIFF] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN DISJ_CASES_TAC(ARITH_RULE `n:num < m \/ m <= n`) THENL [ASM_SIMP_TAC[SUM_TRIV_NUMSEG; REAL_ABS_NUM; REAL_MUL_RZERO]; ALL_TAC] THEN SUBGOAL_THEN `m = 0 + m /\ n = (n - m) + m` (CONJUNCTS_THEN SUBST1_TAC) THENL [UNDISCH_TAC `m:num <= n` THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[SUM_OFFSET] THEN UNDISCH_TAC `N + M:num <= m` THEN SIMP_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[ARITH_RULE `(i + (N + M) + d) - N:num = (M + d) + i`] THEN ONCE_REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[SUM_LMUL; SUM_GP] THEN ASM_SIMP_TAC[LT; REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_POW] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ABS_DIV; REAL_POW_LT; REAL_ARITH `&0 < c /\ c < &1 ==> &0 < abs c /\ &0 < abs(&1 - c)`; REAL_LT_LDIV_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < x /\ x <= &1 /\ &1 <= e ==> abs(c pow 0 - x) < e`) THEN ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_1_LE; REAL_LT_IMP_LE] THEN ASM_SIMP_TAC[REAL_ARITH `c < &1 ==> x * abs(&1 - c) = (&1 - c) * x`] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD; REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH `(((a * b) * c) * d) * e = (e * ((a * b) * c)) * d`] THEN ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_MUL_LID; REAL_ARITH `&0 < c ==> abs c = c`] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `xm < e ==> &0 <= (d - &1) * e ==> xm <= d * e`)) THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [REWRITE_TAC[REAL_SUB_LE; GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE_1 THEN MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT]]);; (* ------------------------------------------------------------------------- *) (* Ostensibly weaker versions of the boundedness of partial sums. *) (* ------------------------------------------------------------------------- *) let BOUNDED_PARTIAL_SUMS = prove (`!f:num->real^N k. bounded { vsum(k..n) f | n IN (:num) } ==> bounded { vsum(m..n) f | m IN (:num) /\ n IN (:num) }`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `bounded { vsum(0..n) f:real^N | n IN (:num) }` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN REWRITE_TAC[bounded] THEN REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `sum { i:num | i < k} (\i. norm(f i:real^N)) + B` THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num < k` THENL [MATCH_MP_TAC(REAL_ARITH `!y. x <= y /\ y <= a /\ &0 < b ==> x <= a + b`) THEN EXISTS_TAC `sum (0..i) (\i. norm(f i:real^N))` THEN ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG; FINITE_NUMSEG_LT; NORM_POS_LE] THEN REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `k = 0` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(REAL_ARITH `x <= B /\ &0 <= b ==> x <= b + B`) THEN ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG_LT; NORM_POS_LE]; ALL_TAC] THEN MP_TAC(ISPECL [`f:num->real^N`; `0`; `k:num`; `i:num`] VSUM_COMBINE_L) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[NUMSEG_LT] THEN MATCH_MP_TAC(NORM_ARITH `norm(x) <= a /\ norm(y) <= b ==> norm(x + y) <= a + b`) THEN ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP BOUNDED_DIFFS (W CONJ th)) THEN MP_TAC th) THEN REWRITE_TAC[IMP_IMP; GSYM BOUNDED_UNION] THEN MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] BOUNDED_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `m:num`; `n:num`] THEN DISCH_THEN SUBST1_TAC THEN ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `n:num < m` THENL [DISJ2_TAC THEN REPEAT(EXISTS_TAC `vsum(0..0) (f:num->real^N)`) THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; VECTOR_SUB_REFL] THEN MESON_TAC[]; ALL_TAC] THEN DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`vsum(0..n) (f:num->real^N)`; `vsum(0..(m-1)) (f:num->real^N)`] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`f:num->real^N`; `0`; `m:num`; `n:num`] VSUM_COMBINE_L) THEN ANTS_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* General Dirichlet convergence test (could make this uniform on a set). *) (* ------------------------------------------------------------------------- *) let SUMMABLE_BILINEAR_PARTIAL_PRE = prove (`!f g h:real^M->real^N->real^P l k. bilinear h /\ ((\n. h (f(n + 1)) (g(n))) --> l) sequentially /\ summable (from k) (\n. h (f(n + 1) - f(n)) (g(n))) ==> summable (from k) (\n. h (f n) (g(n) - g(n - 1)))`, REPEAT GEN_TAC THEN REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG] THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE th]) THEN DISCH_THEN(X_CHOOSE_TAC `l':real^P`) THEN EXISTS_TAC `l - (h:real^M->real^N->real^P) (f k) (g(k - 1)) - l'` THEN REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN REPEAT(MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]));; let SERIES_DIRICHLET_BILINEAR = prove (`!f g h:real^M->real^N->real^P k m p l. bilinear h /\ bounded { vsum (m..n) f | n IN (:num)} /\ summable (from p) (\n. lift(norm(g(n + 1) - g(n)))) /\ ((\n. h (g(n + 1)) (vsum(1..n) f)) --> l) sequentially ==> summable (from k) (\n. h (g n) (f n))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `1` THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\n. (h:real^M->real^N->real^P) (g n) (vsum (1..n) f - vsum (1..n-1) f)` THEN SIMP_TAC[IN_FROM; GSYM NUMSEG_RREC] THEN SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; ARITH_RULE `1 <= n ==> ~(n <= n - 1)`] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RSUB] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `p:num` THEN MP_TAC(ISPECL [`g:num->real^M`; `\n. vsum(1..n) f:real^N`; `h:real^M->real^N->real^P`; `l:real^P`; `p:num`] SUMMABLE_BILINEAR_PARTIAL_PRE) THEN REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `summable (from p) (lift o (\n. C * B * norm(g(n + 1) - g(n):real^M)))` MP_TAC THENL [ASM_SIMP_TAC[o_DEF; LIFT_CMUL; SUMMABLE_CMUL]; ALL_TAC] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUMMABLE_COMPARISON) THEN EXISTS_TAC `0` THEN REWRITE_TAC[IN_FROM; GE; LE_0] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `C * norm(g(n + 1) - g(n):real^M) * norm(vsum (1..n) f:real^N)` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);; let SERIES_DIRICHLET = prove (`!f:num->real^N g N k m. bounded { vsum (m..n) f | n IN (:num)} /\ (!n. N <= n ==> g(n + 1) <= g(n)) /\ ((lift o g) --> vec 0) sequentially ==> summable (from k) (\n. g(n) % f(n))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:num->real^N`; `lift o (g:num->real)`; `\x y:real^N. drop x % y`] SERIES_DIRICHLET_BILINEAR) THEN REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC [`m:num`; `N:num`; `vec 0:real^N`] THEN CONJ_TAC THENL [REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN FIRST_ASSUM(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN REWRITE_TAC[o_THM] THEN DISCH_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC SUMMABLE_EQ_EVENTUALLY THEN EXISTS_TAC `\n. lift(g(n) - g(n + 1))` THEN REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[REAL_ARITH `b <= a ==> abs(b - a) = a - b`]; REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG; VSUM_DIFFS; LIFT_SUB] THEN REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN EXISTS_TAC `lift(g(N:num)) - vec 0` THEN MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]]; MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN ASM_REWRITE_TAC[o_DEF] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN SIMP_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Rearranging absolutely convergent series. *) (* ------------------------------------------------------------------------- *) let SERIES_INJECTIVE_IMAGE_STRONG = prove (`!x:num->real^N s f. summable (IMAGE f s) (\n. lift(norm(x n))) /\ (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) ==> ((\n. vsum (IMAGE f s INTER (0..n)) x - vsum (s INTER (0..n)) (x o f)) --> vec 0) sequentially`, let lemma = prove (`!f:A->real^N s t. FINITE s /\ FINITE t ==> vsum s f - vsum t f = vsum (s DIFF t) f - vsum (t DIFF s) f`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN ASM_SIMP_TAC[VSUM_DIFF; INTER_SUBSET] THEN REWRITE_TAC[INTER_COMM] THEN VECTOR_ARITH_TAC) in REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUMMABLE_CAUCHY]) THEN SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN SIMP_TAC[real_abs; SUM_POS_LE; NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[dist; GE; VECTOR_SUB_RZERO; REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `g:num->num`) THEN MP_TAC(ISPECL [`g:num->num`; `0..N`] UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN DISCH_THEN(X_CHOOSE_TAC `P:num`) THEN EXISTS_TAC `MAX N P` THEN X_GEN_TAC `n:num` THEN SIMP_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN DISCH_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) VSUM_IMAGE o rand o rand o lhand o snd) THEN ANTS_TAC THENL [ASM_MESON_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER]; DISCH_THEN(SUBST1_TAC o SYM)] THEN W(MP_TAC o PART_MATCH (lhand o rand) lemma o rand o lhand o snd) THEN SIMP_TAC[FINITE_INTER; FINITE_IMAGE; FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm a < e / &2 /\ norm b < e / &2 ==> norm(a - b:real^N) < e`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN SIMP_TAC[FINITE_DIFF; FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN MATCH_MP_TAC REAL_LET_TRANS THENL [EXISTS_TAC `sum(IMAGE (f:num->num) s INTER (N..n)) (\i. norm(x i :real^N))` THEN ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ f(x) IN n /\ ~(x IN m) ==> f x IN t) ==> (IMAGE f s INTER n) DIFF (IMAGE f (s INTER m)) SUBSET IMAGE f s INTER t`) THEN ASM_SIMP_TAC[IN_NUMSEG; LE_0; NOT_LE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[GSYM NOT_LE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV [GSYM CONTRAPOS_THM]) THEN ASM_SIMP_TAC[] THEN ASM_ARITH_TAC; MP_TAC(ISPECL [`f:num->num`; `0..n`] UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN EXISTS_TAC `sum(IMAGE (f:num->num) s INTER (N..p)) (\i. norm(x i :real^N))` THEN ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN n /\ ~(f x IN m) ==> f x IN t) ==> (IMAGE f (s INTER n) DIFF (IMAGE f s) INTER m) SUBSET (IMAGE f s INTER t)`) THEN ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN ASM_ARITH_TAC]);; let SERIES_INJECTIVE_IMAGE = prove (`!x:num->real^N s f l. summable (IMAGE f s) (\n. lift(norm(x n))) /\ (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) ==> (((x o f) sums l) s <=> (x sums l) (IMAGE f s))`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[sums] THEN MATCH_MP_TAC LIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN MATCH_MP_TAC SERIES_INJECTIVE_IMAGE_STRONG THEN ASM_REWRITE_TAC[]);; let SERIES_REARRANGE_EQ = prove (`!x:num->real^N s p l. summable s (\n. lift(norm(x n))) /\ p permutes s ==> (((x o p) sums l) s <=> (x sums l) s)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`x:num->real^N`; `s:num->bool`; `p:num->num`; `l:real^N`] SERIES_INJECTIVE_IMAGE) THEN ASM_SIMP_TAC[PERMUTES_IMAGE] THEN ASM_MESON_TAC[PERMUTES_INJECTIVE]);; let SERIES_REARRANGE = prove (`!x:num->real^N s p l. summable s (\n. lift(norm(x n))) /\ p permutes s /\ (x sums l) s ==> ((x o p) sums l) s`, MESON_TAC[SERIES_REARRANGE_EQ]);; let SUMMABLE_REARRANGE = prove (`!x s p. summable s (\n. lift(norm(x n))) /\ p permutes s ==> summable s (x o p)`, MESON_TAC[SERIES_LIFT_ABSCONV_IMP_CONV; summable; SERIES_REARRANGE]);; (* ------------------------------------------------------------------------- *) (* Banach fixed point theorem (not really topological...) *) (* ------------------------------------------------------------------------- *) let BANACH_FIX = prove (`!f s c. complete s /\ ~(s = {}) /\ &0 <= c /\ c < &1 /\ (IMAGE f s) SUBSET s /\ (!x y. x IN s /\ y IN s ==> dist(f(x),f(y)) <= c * dist(x,y)) ==> ?!x:real^N. x IN s /\ (f x = x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL [ALL_TAC; MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN SUBGOAL_THEN `dist((f:real^N->real^N) x,f y) <= c * dist(x,y)` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[REAL_ARITH `a <= c * a <=> &0 <= --a * (&1 - c)`] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_SUB_LT; real_div] THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ARITH `&0 <= --x <=> ~(&0 < x)`] THEN MESON_TAC[DIST_POS_LT]] THEN STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION `(z 0 = @x:real^N. x IN s) /\ (!n. z(SUC n) = f(z n))`) THEN SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_IMAGE]; ALL_TAC] THEN UNDISCH_THEN `z 0 = @x:real^N. x IN s` (K ALL_TAC) THEN SUBGOAL_THEN `?x:real^N. x IN s /\ (z --> x) sequentially` MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `e = dist(f(a:real^N),a)` THEN SUBGOAL_THEN `~(&0 < e)` (fun th -> ASM_MESON_TAC[th; DIST_POS_LT]) THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN SUBGOAL_THEN `dist(f(z N),a:real^N) < e / &2 /\ dist(f(z(N:num)),f(a)) < e / &2` (fun th -> ASM_MESON_TAC[th; DIST_TRIANGLE_HALF_R; REAL_LT_REFL]) THEN CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N <= SUC N`]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `c * dist((z:num->real^N) N,a)` THEN ASM_SIMP_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x < y /\ c * x <= &1 * x ==> c * x < y`) THEN ASM_SIMP_TAC[LE_REFL; REAL_LE_RMUL; DIST_POS_LE; REAL_LT_IMP_LE]] THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [complete]) THEN ASM_REWRITE_TAC[CAUCHY] THEN SUBGOAL_THEN `!n. dist(z(n):real^N,z(SUC n)) <= c pow n * dist(z(0),z(1))` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[real_pow; ARITH; REAL_MUL_LID; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * dist(z(n):real^N,z(SUC n))` THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL]; ALL_TAC] THEN SUBGOAL_THEN `!m n:num. (&1 - c) * dist(z(m):real^N,z(m+n)) <= c pow m * dist(z(0),z(1)) * (&1 - c pow n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_RZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_SUB_LE; REAL_POW_1_LE; REAL_LT_IMP_LE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - c) * (dist(z m:real^N,z(m + n)) + dist(z(m + n),z(m + SUC n)))` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; REAL_LT_IMP_LE; DIST_TRIANGLE] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `c * x <= y ==> c * x' + y <= y' ==> c * (x + x') <= y'`)) THEN REWRITE_TAC[REAL_ARITH `q + a * b * (&1 - x) <= a * b * (&1 - y) <=> q <= a * b * (x - y)`] THEN REWRITE_TAC[ADD_CLAUSES; real_pow] THEN REWRITE_TAC[REAL_ARITH `a * b * (d - c * d) = (&1 - c) * a * d * b`] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE] THEN REWRITE_TAC[GSYM REAL_POW_ADD; REAL_MUL_ASSOC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ASM_CASES_TAC `(z:num->real^N) 0 = z 1` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0] THEN X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `n:num`]) THEN REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_CASES_TAC `(z:num->real^N) 0 = z n` THEN ASM_REWRITE_TAC[DIST_REFL; REAL_NOT_LE] THEN ASM_SIMP_TAC[REAL_LT_MUL; DIST_POS_LT; REAL_SUB_LT]; ALL_TAC] THEN MP_TAC(SPECL [`c:real`; `e * (&1 - c) / dist((z:num->real^N) 0,z 1)`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_SUB_LT; DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[real_div; GE; REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM real_div; DIST_POS_LT] THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN DISCH_TAC THEN REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST_ALL_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH `d < e ==> x <= d ==> x < e`)) THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `d:num`]) THEN MATCH_MP_TAC(REAL_ARITH `(c * d) * e <= (c * d) * &1 ==> x * y <= c * d * e ==> y * x <= c * d`) THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_ARITH `&0 <= x ==> &1 - x <= &1`]);; (* ------------------------------------------------------------------------- *) (* Edelstein fixed point theorem. *) (* ------------------------------------------------------------------------- *) let EDELSTEIN_FIX = prove (`!f s. compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(f(x),f(y)) < dist(x,y)) ==> ?!x:real^N. x IN s /\ f x = x`, MAP_EVERY X_GEN_TAC [`g:real^N->real^N`; `s:real^N->bool`] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]] THEN SUBGOAL_THEN `!x y. x IN s /\ y IN s ==> dist((g:real^N->real^N)(x),g(y)) <= dist(x,y)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DIST_REFL; REAL_LE_LT]; ALL_TAC] THEN ASM_CASES_TAC `?x:real^N. x IN s /\ ~(g x = x)` THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN ABBREV_TAC `y = (g:real^N->real^N) x` THEN SUBGOAL_THEN `(y:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_PCROSS o W CONJ) THEN REWRITE_TAC[compact; PCROSS] THEN (STRIP_ASSUME_TAC o prove_general_recursive_function_exists) `?f:num->real^N->real^N. (!z. f 0 z = z) /\ (!z n. f (SUC n) z = g(f n z))` THEN SUBGOAL_THEN `!n z. z IN s ==> (f:num->real^N->real^N) n z IN s` STRIP_ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m n w z. m <= n /\ w IN s /\ z IN s ==> dist((f:num->real^N->real^N) n w,f n z) <= dist(f m w,f m z)` ASSUME_TAC THENL [REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `\n:num. pastecart (f n (x:real^N)) (f n y:real^N)`) THEN ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`l:real^(N,N)finite_sum`; `s:num->num`] THEN REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST_ALL_TAC) THEN SUBGOAL_THEN `(\x:real^(N,N)finite_sum. fstcart x) continuous_on UNIV /\ (\x:real^(N,N)finite_sum. sndcart x) continuous_on UNIV` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[ETA_AX; LINEAR_FSTCART; LINEAR_SNDCART]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th))) THEN REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN(fun th -> CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B") th THEN MP_TAC(MATCH_MP LIM_SUB th)) THEN REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "AB") THEN SUBGOAL_THEN `!n. dist(a:real^N,b) <= dist((f:num->real^N->real^N) n x,f n y)` STRIP_ASSUME_TAC THENL [X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN USE_THEN "AB" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o MATCH_MP th)) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN MATCH_MP_TAC(NORM_ARITH `dist(fx,fy) <= dist(x,y) ==> ~(dist(fx - fy,a - b) < dist(a,b) - dist(x,y))`) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num` o MATCH_MP MONOTONE_BIGGER) THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `b:real^N = a` SUBST_ALL_TAC THENL [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN ABBREV_TAC `e = dist(a,b) - dist((g:real^N->real^N) a,g b)` THEN SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL [ASM_MESON_TAC[REAL_SUB_LT]; ALL_TAC] THEN SUBGOAL_THEN `?n. dist((f:num->real^N->real^N) n x,a) < e / &2 /\ dist(f n y,b) < e / &2` STRIP_ASSUME_TAC THENL [MAP_EVERY (fun s -> USE_THEN s (MP_TAC o SPEC `e / &2` o REWRITE_RULE[LIM_SEQUENTIALLY])) ["A"; "B"] THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `(s:num->num) (M + N)` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `dist(f (SUC n) x,(g:real^N->real^N) a) + dist((f:num->real^N->real^N) (SUC n) y,g b) < e` MP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH `dist(x,y) < e ==> dist(g x,g y) <= dist(x,y) ==> dist(g x,g y) < e`)) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `SUC n` (ASSUME `!n. dist (a:real^N,b) <= dist ((f:num->real^N->real^N) n x,f n y)`)) THEN EXPAND_TAC "e" THEN NORM_ARITH_TAC; ALL_TAC] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC `\n:num. (f:num->real^N->real^N) (SUC(s n)) x` THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(g:real^N->real^N) continuous_on s` MP_TAC THENL [REWRITE_TAC[continuous_on] THEN ASM_MESON_TAC[REAL_LET_TRANS]; ALL_TAC] THEN REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[]; SUBGOAL_THEN `!n. (f:num->real^N->real^N) (SUC n) x = f n y` (fun th -> ASM_SIMP_TAC[th]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Dini's theorem. *) (* ------------------------------------------------------------------------- *) let DINI = prove (`!f:num->real^N->real^1 g s. compact s /\ (!n. (f n) continuous_on s) /\ g continuous_on s /\ (!x. x IN s ==> ((\n. (f n x)) --> g x) sequentially) /\ (!n x. x IN s ==> drop(f n x) <= drop(f (n + 1) x)) ==> !e. &0 < e ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) sequentially`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x:real^N m n:num. x IN s /\ m <= n ==> drop(f m x) <= drop(f n x)` ASSUME_TAC THENL [GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[ADD1] THEN REAL_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!n:num x:real^N. x IN s ==> drop(f n x) <= drop(g x)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN EXISTS_TAC `\m:num. (f:num->real^N->real^1) n x` THEN EXISTS_TAC `\m:num. (f:num->real^N->real^1) m x` THEN ASM_SIMP_TAC[LIM_CONST; TRIVIAL_LIMIT_SEQUENTIALLY] THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[LIM_SEQUENTIALLY; dist]) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\n. { x | x IN s /\ norm((f:num->real^N->real^1) n x - g x) < e}) (:num)`) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; SUBSET_UNION; UNIONS_IMAGE] THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY] THEN SIMP_TAC[SUBSET; IN_UNIV; IN_ELIM_THM] THEN ANTS_TAC THENL [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM IN_BALL_0] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN ASM_SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_SUB; ETA_AX]; DISCH_THEN(X_CHOOSE_THEN `k:num->bool` (CONJUNCTS_THEN2 (MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) (LABEL_TAC "*"))) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH `m <= n /\ n <= g ==> abs(m - g) < e ==> abs(n - g) < e`) THEN ASM_MESON_TAC[LE_TRANS]]);; (* ------------------------------------------------------------------------- *) (* Closest point of a (closed) set to a point. *) (* ------------------------------------------------------------------------- *) let closest_point = new_definition `closest_point s a = @x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`;; let CLOSEST_POINT_EXISTS = prove (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s /\ !y. y IN s ==> dist(a,closest_point s a) <= dist(a,y)`, REWRITE_TAC[closest_point] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN REWRITE_TAC[DISTANCE_ATTAINS_INF]);; let CLOSEST_POINT_IN_SET = prove (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s`, MESON_TAC[CLOSEST_POINT_EXISTS]);; let CLOSEST_POINT_LE = prove (`!s a x. closed s /\ x IN s ==> dist(a,closest_point s a) <= dist(a,x)`, MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; let CLOSEST_POINT_SELF = prove (`!s x:real^N. x IN s ==> closest_point s x = x`, REPEAT STRIP_TAC THEN REWRITE_TAC[closest_point] THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[DIST_LE_0; DIST_REFL]; STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL; DIST_POS_LE]]);; let CLOSEST_POINT_REFL = prove (`!s x:real^N. closed s /\ ~(s = {}) ==> (closest_point s x = x <=> x IN s)`, MESON_TAC[CLOSEST_POINT_IN_SET; CLOSEST_POINT_SELF]);; let DIST_CLOSEST_POINT_LIPSCHITZ = prove (`!s x y:real^N. closed s /\ ~(s = {}) ==> abs(dist(x,closest_point s x) - dist(y,closest_point s y)) <= dist(x,y)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSEST_POINT_EXISTS) THEN DISCH_THEN(fun th -> CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `closest_point s (y:real^N)`) (SPEC `x:real^N` th) THEN CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `closest_point s (x:real^N)`) (SPEC `y:real^N` th)) THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; let CONTINUOUS_AT_DIST_CLOSEST_POINT = prove (`!s x:real^N. closed s /\ ~(s = {}) ==> (\x. lift(dist(x,closest_point s x))) continuous (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; let CONTINUOUS_ON_DIST_CLOSEST_POINT = prove (`!s t. closed s /\ ~(s = {}) ==> (\x. lift(dist(x,closest_point s x))) continuous_on t`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_DIST_CLOSEST_POINT]);; let UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT = prove (`!s t:real^N->bool. closed s /\ ~(s = {}) ==> (\x. lift(dist(x,closest_point s x))) uniformly_continuous_on t`, REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; let SEGMENT_TO_CLOSEST_POINT = prove (`!s a:real^N. closed s /\ ~(s = {}) ==> segment(a,closest_point s a) INTER s = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN MATCH_MP_TAC(TAUT `(r ==> ~p) ==> p /\ q ==> ~r`) THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS; REAL_NOT_LT; DIST_SYM]);; let SEGMENT_TO_POINT_EXISTS = prove (`!s a:real^N. closed s /\ ~(s = {}) ==> ?b. b IN s /\ segment(a,b) INTER s = {}`, MESON_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]);; let CLOSEST_POINT_IN_INTERIOR = prove (`!s x:real^N. closed s /\ ~(s = {}) ==> ((closest_point s x) IN interior s <=> x IN interior s)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `closest_point s (x:real^N) IN s` ASSUME_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `closest_point s x - (min (&1) (e / norm(closest_point s x - x))) % (closest_point s x - x):real^N`] CLOSEST_POINT_LE) THEN ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE]; REWRITE_TAC[NORM_MUL; REAL_ARITH `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);; let CLOSEST_POINT_IN_FRONTIER = prove (`!s x:real^N. closed s /\ ~(s = {}) /\ ~(x IN interior s) ==> (closest_point s x) IN frontier s`, SIMP_TAC[frontier; IN_DIFF; CLOSEST_POINT_IN_INTERIOR] THEN SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSURE_CLOSED]);; (* ------------------------------------------------------------------------- *) (* More general infimum of distance between two sets. *) (* ------------------------------------------------------------------------- *) let setdist = new_definition `setdist(s,t) = if s = {} \/ t = {} then &0 else inf {dist(x,y) | x IN s /\ y IN t}`;; let SETDIST_EMPTY = prove (`(!t. setdist({},t) = &0) /\ (!s. setdist(s,{}) = &0)`, REWRITE_TAC[setdist]);; let SETDIST_POS_LE = prove (`!s t. &0 <= setdist(s,t)`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_INF THEN REWRITE_TAC[FORALL_IN_GSPEC; DIST_POS_LE] THEN ASM SET_TAC[]);; let REAL_LE_SETDIST = prove (`!s t:real^N->bool d. ~(s = {}) /\ ~(t = {}) /\ (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) ==> d <= setdist(s,t)`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[setdist] THEN MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN ASM_MESON_TAC[]);; let SETDIST_LE_DIST = prove (`!s t x y:real^N. x IN s /\ y IN t ==> setdist(s,t) <= dist(x,y)`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN ASM_MESON_TAC[]);; let REAL_LE_SETDIST_EQ = prove (`!d s t:real^N->bool. d <= setdist(s,t) <=> (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) /\ (s = {} \/ t = {} ==> d <= &0)`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY; NOT_IN_EMPTY] THEN ASM_MESON_TAC[REAL_LE_SETDIST; SETDIST_LE_DIST; REAL_LE_TRANS]);; let REAL_SETDIST_LT_EXISTS = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ setdist(s,t) < b ==> ?x y. x IN s /\ y IN t /\ dist(x,y) < b`, REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SETDIST_EQ] THEN MESON_TAC[]);; let SETDIST_REFL = prove (`!s:real^N->bool. setdist(s,s) = &0`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM_REWRITE_TAC[setdist; REAL_LE_REFL]; ALL_TAC] THEN ASM_MESON_TAC[SETDIST_LE_DIST; MEMBER_NOT_EMPTY; DIST_REFL]);; let SETDIST_SYM = prove (`!s t. setdist(s,t) = setdist(t,s)`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist; DISJ_SYM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[DIST_SYM]);; let SETDIST_TRIANGLE = prove (`!s a t:real^N->bool. setdist(s,t) <= setdist(s,{a}) + setdist({a},t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_LID; SETDIST_POS_LE] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_RID; SETDIST_POS_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN REWRITE_TAC[REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `dist(x:real^N,y)` THEN ASM_SIMP_TAC[SETDIST_LE_DIST] THEN CONV_TAC NORM_ARITH);; let SETDIST_SINGS = prove (`!x y. setdist({x},{y}) = dist(x,y)`, REWRITE_TAC[setdist; NOT_INSERT_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x y | x IN {a} /\ y IN {b}} = {f a b}`] THEN SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);; let SETDIST_LIPSCHITZ = prove (`!s t x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SETDIST_SINGS] THEN REWRITE_TAC[REAL_ARITH `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN MESON_TAC[SETDIST_TRIANGLE; SETDIST_SYM]);; let CONTINUOUS_AT_LIFT_SETDIST = prove (`!s x:real^N. (\y. lift(setdist({y},s))) continuous (at x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; let CONTINUOUS_ON_LIFT_SETDIST = prove (`!s t:real^N->bool. (\y. lift(setdist({y},s))) continuous_on t`, MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_SETDIST]);; let UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST = prove (`!s t:real^N->bool. (\y. lift(setdist({y},s))) uniformly_continuous_on t`, REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; let SETDIST_DIFFERENCES = prove (`!s t. setdist(s,t) = setdist({vec 0},{x - y:real^N | x IN s /\ y IN t})`, REPEAT GEN_TAC THEN REWRITE_TAC[setdist; NOT_INSERT_EMPTY; SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2; DIST_0] THEN REWRITE_TAC[dist] THEN MESON_TAC[]);; let SETDIST_SUBSET_RIGHT = prove (`!s t u:real^N->bool. ~(t = {}) /\ t SUBSET u ==> setdist(s,u) <= setdist(s,t)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY; SETDIST_POS_LE; REAL_LE_REFL] THEN ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET] THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN MESON_TAC[DIST_POS_LE]);; let SETDIST_SUBSET_LEFT = prove (`!s t u:real^N->bool. ~(s = {}) /\ s SUBSET t ==> setdist(t,u) <= setdist(s,u)`, MESON_TAC[SETDIST_SUBSET_RIGHT; SETDIST_SYM]);; let SETDIST_CLOSURE = prove (`(!s t:real^N->bool. setdist(closure s,t) = setdist(s,t)) /\ (!s t:real^N->bool. setdist(s,closure t) = setdist(s,t))`, GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN REWRITE_TAC[] THEN REWRITE_TAC[MESON[REAL_LE_ANTISYM] `x:real = y <=> !d. d <= x <=> d <= y`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; CLOSURE_EMPTY; NOT_IN_EMPTY] THEN MATCH_MP_TAC(SET_RULE `s SUBSET c /\ (!y. Q y /\ (!x. x IN s ==> P x y) ==> (!x. x IN c ==> P x y)) ==> ((!x y. x IN c /\ Q y ==> P x y) <=> (!x y. x IN s /\ Q y ==> P x y))`) THEN REWRITE_TAC[CLOSURE_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE THEN ASM_REWRITE_TAC[o_DEF; dist] THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; let SETDIST_COMPACT_CLOSED = prove (`!s t:real^N->bool. compact s /\ closed t /\ ~(s = {}) /\ ~(t = {}) ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(MESON[] `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN SIMP_TAC[SETDIST_LE_DIST] THEN ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; DIST_0; GSYM CONJ_ASSOC] THEN REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let SETDIST_CLOSED_COMPACT = prove (`!s t:real^N->bool. closed s /\ compact t /\ ~(s = {}) /\ ~(t = {}) ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(MESON[] `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN SIMP_TAC[SETDIST_LE_DIST] THEN ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; DIST_0; GSYM CONJ_ASSOC] THEN REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let SETDIST_EQ_0_COMPACT_CLOSED = prove (`!s t:real^N->bool. compact s /\ closed t ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN EQ_TAC THENL [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[DIST_EQ_0]; REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[SETDIST_LE_DIST; DIST_EQ_0]]);; let SETDIST_EQ_0_CLOSED_COMPACT = prove (`!s t:real^N->bool. closed s /\ compact t ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, ONCE_REWRITE_TAC[SETDIST_SYM] THEN SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED] THEN SET_TAC[]);; let SETDIST_EQ_0_BOUNDED = prove (`!s t:real^N->bool. (bounded s \/ bounded t) ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(closure(s) INTER closure(t) = {}))`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] `setdist(s,t) = setdist(closure s,closure t)`] THEN ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; SETDIST_EQ_0_CLOSED_COMPACT; COMPACT_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY]);; let SETDIST_TRANSLATION = prove (`!a:real^N s t. setdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = setdist(s,t)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SETDIST_DIFFERENCES] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = {f (g x) (g y) | x IN s /\ y IN t}`] THEN REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; add_translation_invariants [SETDIST_TRANSLATION];; let SETDIST_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x. norm(f x) = norm x) ==> setdist(IMAGE f s,IMAGE f t) = setdist(s,t)`, REPEAT STRIP_TAC THEN REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN AP_TERM_TAC THEN REWRITE_TAC[SET_RULE `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = {f (g x) (g y) | x IN s /\ y IN t}`] THEN FIRST_X_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN ASM_REWRITE_TAC[]);; add_linear_invariants [SETDIST_LINEAR_IMAGE];; let SETDIST_UNIQUE = prove (`!s t a b:real^N d. a IN s /\ b IN t /\ dist(a,b) = d /\ (!x y. x IN s /\ y IN t ==> dist(a,b) <= dist(x,y)) ==> setdist(s,t) = d`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [ASM_MESON_TAC[SETDIST_LE_DIST]; MATCH_MP_TAC REAL_LE_SETDIST THEN ASM SET_TAC[]]);; let SETDIST_CLOSEST_POINT = prove (`!a:real^N s. closed s /\ ~(s = {}) ==> setdist({a},s) = dist(a,closest_point s a)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; IN_SING; UNWIND_THM2] THEN EXISTS_TAC `closest_point s (a:real^N)` THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS; DIST_SYM]);; let SETDIST_EQ_0_SING = prove (`(!s x:real^N. setdist({x},s) = &0 <=> s = {} \/ x IN closure s) /\ (!s x:real^N. setdist(s,{x}) = &0 <=> s = {} \/ x IN closure s)`, SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_SING; CLOSURE_SING] THEN SET_TAC[]);; let SETDIST_EQ_0_CLOSED = prove (`!s x. closed s ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_SING] THEN SET_TAC[]);; let SETDIST_EQ_0_CLOSED_IN = prove (`!u s x. closed_in (subtopology euclidean u) s /\ x IN u ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, REWRITE_TAC[SETDIST_EQ_0_SING; CLOSED_IN_INTER_CLOSURE] THEN SET_TAC[]);; let SETDIST_SING_IN_SET = prove (`!x s. x IN s ==> setdist({x},s) = &0`, SIMP_TAC[SETDIST_EQ_0_SING; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);; let SETDIST_SING_TRIANGLE = prove (`!s x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_SUB_REFL; REAL_ABS_NUM; DIST_POS_LE] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_NEG_SUB] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a - b <= c <=> a - c <= b`; REAL_ARITH `--a <= b - c <=> c - a <= b`] THEN MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN SIMP_TAC[IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THENL [MATCH_MP_TAC(NORM_ARITH `a <= dist(y:real^N,z) ==> a - dist(x,y) <= dist(x,z)`); MATCH_MP_TAC(NORM_ARITH `a <= dist(x:real^N,z) ==> a - dist(x,y) <= dist(y,z)`)] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; let SETDIST_LE_SING = prove (`!s t x:real^N. x IN s ==> setdist(s,t) <= setdist({x},t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_SUBSET_LEFT THEN ASM SET_TAC[]);; let SETDIST_BALLS = prove (`(!a b:real^N r s. setdist(ball(a,r),ball(b,s)) = if r <= &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ (!a b:real^N r s. setdist(ball(a,r),cball(b,s)) = if r <= &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ (!a b:real^N r s. setdist(cball(a,r),ball(b,s)) = if r < &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ (!a b:real^N r s. setdist(cball(a,r),cball(b,s)) = if r < &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s)))`, REWRITE_TAC[MESON[] `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; SETDIST_EMPTY; DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] `setdist(s,t) = setdist(closure s,closure t)`] THEN SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN REWRITE_TAC[SETDIST_CLOSURE] THEN MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT GEN_TAC] THEN REWRITE_TAC[real_max; REAL_SUB_LE] THEN COND_CASES_TAC THEN SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; CBALL_EQ_EMPTY; INTER_BALLS_EQ_EMPTY] THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_CASES_TAC `b:real^N = a` THENL [FIRST_X_ASSUM SUBST_ALL_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_REFL]) THEN ASM_CASES_TAC `r = &0 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN ASM_SIMP_TAC[CBALL_SING; SETDIST_SINGS] THEN REAL_ARITH_TAC; STRIP_TAC] THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; IN_CBALL] THEN CONV_TAC NORM_ARITH] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `dist(a + r / dist(a,b) % (b - a):real^N, b - s / dist(a,b) % (b - a))` THEN CONJ_TAC THENL [MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a + x) = norm x`; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[dist; VECTOR_ARITH `(a + d % (b - a)) - (b - e % (b - a)):real^N = (&1 - d - e) % (a - b)`] THEN REWRITE_TAC[NORM_MUL; REAL_ARITH `&1 - r / y - s / y = &1 - (r + s) / y`] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN ASM_SIMP_TAC[VECTOR_SUB_EQ; NORM_EQ_0; REAL_FIELD `~(n = &0) ==> (&1 - x / n) * n = n - x`] THEN REWRITE_TAC[GSYM dist] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Use set distance for an easy proof of separation properties etc. *) (* ------------------------------------------------------------------------- *) let SEPARATION_CLOSURES = prove (`!s t:real^N->bool. s INTER closure(t) = {} /\ t INTER closure(s) = {} ==> ?u v. DISJOINT u v /\ open u /\ open v /\ s SUBSET u /\ t SUBSET v`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `(:real^N)`] THEN ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; ALL_TAC] THEN EXISTS_TAC `{x | x IN (:real^N) /\ lift(setdist({x},t) - setdist({x},s)) IN {x | &0 < x$1}}` THEN EXISTS_TAC `{x | x IN (:real^N) /\ lift(setdist({x},t) - setdist({x},s)) IN {x | x$1 < &0}}` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC; MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN SIMP_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN SIMP_TAC[OPEN_HALFSPACE_COMPONENT_LT; OPEN_UNIV] THEN SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ y = &0 /\ ~(x = &0) ==> &0 < x - y`); REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = &0 /\ ~(y = &0) ==> x - y < &0`)] THEN ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_BOUNDED; BOUNDED_SING] THEN ASM_SIMP_TAC[CLOSED_SING; CLOSURE_CLOSED; NOT_INSERT_EMPTY; REWRITE_RULE[SUBSET] CLOSURE_SUBSET; SET_RULE `{a} INTER s = {} <=> ~(a IN s)`] THEN ASM SET_TAC[]);; let SEPARATION_NORMAL = prove (`!s t:real^N->bool. closed s /\ closed t /\ s INTER t = {} ==> ?u v. open u /\ open v /\ s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN MATCH_MP_TAC SEPARATION_CLOSURES THEN ASM_SIMP_TAC[CLOSURE_CLOSED] THEN ASM SET_TAC[]);; let SEPARATION_NORMAL_LOCAL = prove (`!s t u:real^N->bool. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} ==> ?s' t'. open_in (subtopology euclidean u) s' /\ open_in (subtopology euclidean u) t' /\ s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {}`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `u:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL [MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `{}:real^N->bool`] THEN ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},s) < setdist({x},t)}` THEN EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},t) < setdist({x},s)}` THEN SIMP_TAC[EXTENSION; SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; IN_INTER; NOT_IN_EMPTY; SETDIST_POS_LE; CONJ_ASSOC; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_ANTISYM]] THEN ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SETDIST_EQ_0_CLOSED_IN; CLOSED_IN_IMP_SUBSET; SUBSET; MEMBER_NOT_EMPTY; IN_INTER]] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 < x <=> &0 < drop(lift x)`] THEN REWRITE_TAC[SET_RULE `{x | x IN u /\ &0 < drop(f x)} = {x | x IN u /\ f x IN {x | &0 < drop x}}`] THEN REWRITE_TAC[drop] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; LIFT_SUB; REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]);; let SEPARATION_NORMAL_COMPACT = prove (`!s t:real^N->bool. compact s /\ closed t /\ s INTER t = {} ==> ?u v. open u /\ compact(closure u) /\ open v /\ s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`s:real^N->bool`; `t UNION ((:real^N) DIFF ball(vec 0,r))`] SEPARATION_NORMAL) THEN ASM_SIMP_TAC[CLOSED_UNION; GSYM OPEN_CLOSED; OPEN_BALL] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSURE; ASM SET_TAC[]] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,r)` THEN REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]);; let SEPARATION_HAUSDORFF = prove (`!x:real^N y. ~(x = y) ==> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`{x:real^N}`; `{y:real^N}`] SEPARATION_NORMAL) THEN REWRITE_TAC[SING_SUBSET; CLOSED_SING] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; let SEPARATION_T2 = prove (`!x:real^N y. ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[SEPARATION_HAUSDORFF] THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[]);; let SEPARATION_T1 = prove (`!x:real^N y. ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ ~(y IN u) /\ ~(x IN v) /\ y IN v`, REPEAT STRIP_TAC THEN EQ_TAC THENL [ASM_SIMP_TAC[SEPARATION_T2; EXTENSION; NOT_IN_EMPTY; IN_INTER]; ALL_TAC] THEN MESON_TAC[]);; let SEPARATION_T0 = prove (`!x:real^N y. ~(x = y) <=> ?u. open u /\ ~(x IN u <=> y IN u)`, MESON_TAC[SEPARATION_T1]);; (* ------------------------------------------------------------------------- *) (* Hausdorff distance between sets. *) (* ------------------------------------------------------------------------- *) let hausdist = new_definition `hausdist(s:real^N->bool,t:real^N->bool) = let ds = {setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} in if ~(ds = {}) /\ (?b. !d. d IN ds ==> d <= b) then sup ds else &0`;; let HAUSDIST_POS_LE = prove (`!s t:real^N->bool. &0 <= hausdist(s,t)`, REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_SUP THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (!x. x IN s ==> P x) ==> ?y. y IN s /\ P y`) THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE]);; let HAUSDIST_REFL = prove (`!s:real^N->bool. hausdist(s,s) = &0`, GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE] THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_SUP_LE THEN REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; REAL_LE_REFL]);; let HAUSDIST_SYM = prove (`!s t:real^N->bool. hausdist(s,t) = hausdist(t,s)`, REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM] THEN REWRITE_TAC[]);; let HAUSDIST_EMPTY = prove (`(!t:real^N->bool. hausdist ({},t) = &0) /\ (!s:real^N->bool. hausdist (s,{}) = &0)`, REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_EMPTY] THEN REWRITE_TAC[SET_RULE `{f x | x IN {}} = {}`; UNION_EMPTY] THEN REWRITE_TAC[SET_RULE `{c |x| x IN s} = {} <=> s = {}`] THEN X_GEN_TAC `s:real^N->bool` THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> {c |x| x IN s} = {c}`] THEN REWRITE_TAC[SUP_SING; COND_ID]);; let HAUSDIST_SINGS = prove (`!x y:real^N. hausdist({x},{y}) = dist(x,y)`, REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`] THEN REWRITE_TAC[DIST_SYM; UNION_IDEMPOT; SUP_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN MESON_TAC[REAL_LE_REFL]);; let HAUSDIST_EQ = prove (`!s t:real^M->bool s' t':real^N->bool. (!b. (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= b) <=> (!x. x IN s' ==> setdist({x},t') <= b) /\ (!y. y IN t' ==> setdist({y},s') <= b)) ==> hausdist(s,t) = hausdist(s',t')`, REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN MATCH_MP_TAC(MESON[] `(p <=> p') /\ s = s' ==> (if p then s else &0) = (if p' then s' else &0)`) THEN CONJ_TAC THENL [BINOP_TAC THENL [PURE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`]; AP_TERM_TAC THEN ABS_TAC]; MATCH_MP_TAC SUP_EQ] THEN PURE_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN REWRITE_TAC[GSYM DE_MORGAN_THM] THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `--(&1):real`) THEN SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> ~(x <= --(&1))`] THEN SET_TAC[]);; let HAUSDIST_TRANSLATION = prove (`!a s t:real^N->bool. hausdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = hausdist(s,t)`, REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN REWRITE_TAC[SET_RULE `{a + x:real^N} = IMAGE (\x. a + x) {x}`] THEN REWRITE_TAC[SETDIST_TRANSLATION]);; add_translation_invariants [HAUSDIST_TRANSLATION];; let HAUSDIST_LINEAR_IMAGE = prove (`!f:real^M->real^N s t. linear f /\ (!x. norm(f x) = norm x) ==> hausdist(IMAGE f s,IMAGE f t) = hausdist(s,t)`, REPEAT STRIP_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN ONCE_REWRITE_TAC[SET_RULE `{(f:real^M->real^N) x} = IMAGE f {x}`] THEN ASM_SIMP_TAC[SETDIST_LINEAR_IMAGE]);; add_linear_invariants [HAUSDIST_LINEAR_IMAGE];; let HAUSDIST_CLOSURE = prove (`(!s t:real^N->bool. hausdist(closure s,t) = hausdist(s,t)) /\ (!s t:real^N->bool. hausdist(s,closure t) = hausdist(s,t))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_EQ THEN GEN_TAC THEN BINOP_TAC THEN REWRITE_TAC[SETDIST_CLOSURE] THEN PURE_ONCE_REWRITE_TAC[SET_RULE `(!x. P x ==> Q x) <=> (!x. P x ==> x IN {x | Q x})`] THEN MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN REWRITE_TAC[EMPTY_GSPEC; CONTINUOUS_ON_ID; CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x <= b <=> drop(lift x) <= b`] THEN REWRITE_TAC[SET_RULE `{x | drop(lift(f x)) <= b} = {x | x IN UNIV /\ lift(f x) IN {x | drop x <= b}}`] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_LIFT_SETDIST] THEN REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]);; let REAL_HAUSDIST_LE = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= b) ==> hausdist(s,t) <= b`, REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN MATCH_MP_TAC REAL_SUP_LE THEN ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN ASM_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]);; let REAL_HAUSDIST_LE_SUMS = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ s SUBSET {y + z | y IN t /\ z IN cball(vec 0,b)} /\ t SUBSET {y + z | y IN s /\ z IN cball(vec 0,b)} ==> hausdist(s,t) <= b`, REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_MESON_TAC[SETDIST_LE_DIST; REAL_LE_TRANS; IN_SING]);; let REAL_LE_HAUSDIST = prove (`!s t:real^N->bool a b c z. ~(s = {}) /\ ~(t = {}) /\ (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= c) /\ (z IN s /\ a <= setdist({z},t) \/ z IN t /\ a <= setdist({z},s)) ==> a <= hausdist(s,t)`, REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL [MATCH_MP_TAC REAL_LE_SUP THEN ASM_SIMP_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM]] THEN EXISTS_TAC `max b c:real` THEN ASM_SIMP_TAC[REAL_LE_MAX] THEN ASM SET_TAC[]);; let SETDIST_LE_HAUSDIST = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> setdist(s,t) <= hausdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN REWRITE_TAC[CONJ_ASSOC] THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SETDIST_LE_SING; MEMBER_NOT_EMPTY]] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN CONJ_TAC THEN EXISTS_TAC `b:real` THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS; SETDIST_LE_DIST; MEMBER_NOT_EMPTY; IN_SING; DIST_SYM]);; let SETDIST_SING_LE_HAUSDIST = prove (`!s t x:real^N. bounded s /\ bounded t /\ x IN s ==> setdist({x},t) <= hausdist(s,t)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_OR_THM; CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN CONJ_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM dist] THEN GEN_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THENL [UNDISCH_TAC `~(t:real^N->bool = {})`; UNDISCH_TAC `~(s:real^N->bool = {})`] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THENL [ALL_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; let UPPER_LOWER_HEMICONTINUOUS = prove (`!f:real^M->real^N->bool t s. (!x. x IN s ==> f(x) SUBSET t) /\ (!u. open_in (subtopology euclidean t) u ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) /\ (!u. closed_in (subtopology euclidean t) u ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) SUBSET u}) ==> !x e. x IN s /\ &0 < e /\ bounded(f x) ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x,x') < d ==> hausdist(f x,f x') < e`, REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `(f:real^M->real^N->bool) x = {}` THENL [ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`] o MATCH_MP UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o SPEC `t INTER ball(vec 0:real^N,r)` o CONJUNCT1 o CONJUNCT2) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ASM_SIMP_TAC[SUBSET_INTER; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x':real^M`)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `(f:real^M->real^N->bool) x' = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; IN_SING; REAL_LT_IMP_LE]);; let HAUSDIST_NONTRIVIAL = prove (`!s t:real^N->bool. bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = sup({setdist ({x},t) | x IN s} UNION {setdist ({y},s) | y IN t})`, REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN ASM_SIMP_TAC[EMPTY_UNION; SIMPLE_IMAGE; IMAGE_EQ_EMPTY] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let HAUSDIST_NONTRIVIAL_ALT = prove (`!s t:real^N->bool. bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = max (sup {setdist ({x},t) | x IN s}) (sup {setdist ({y},s) | y IN t})`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL] THEN MATCH_MP_TAC SUP_UNION THEN ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN CONJ_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let REAL_HAUSDIST_LE_EQ = prove (`!s t:real^N->bool b. ~(s = {}) /\ ~(t = {}) /\ bounded s /\ bounded t ==> (hausdist(s,t) <= b <=> (!x. x IN s ==> setdist({x},t) <= b) /\ (!y. y IN t ==> setdist({y},s) <= b))`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL_ALT; REAL_MAX_LE] THEN BINOP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x <= b) <=> (!y. y IN {f x | x IN s} ==> y <= b)`] THEN MATCH_MP_TAC REAL_SUP_LE_EQ THEN ASM_REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let HAUSDIST_COMPACT_EXISTS = prove (`!s t:real^N->bool. bounded s /\ compact t /\ ~(t = {}) ==> !x. x IN s ==> ?y. y IN t /\ dist(x,y) <= hausdist(s,t)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN ASM_SIMP_TAC[COMPACT_SING; COMPACT_IMP_CLOSED; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; UNWIND_THM2; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; IN_SING]);; let HAUSDIST_COMPACT_SUMS = prove (`!s t:real^N->bool. bounded s /\ compact t /\ ~(t = {}) ==> s SUBSET {y + z | y IN t /\ z IN cball(vec 0,hausdist(s,t))}`, REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[GSYM dist; HAUSDIST_COMPACT_EXISTS]);; let HAUSDIST_TRANS = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u /\ ~(t = {}) ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)`, let lemma = prove (`!s t u:real^N->bool. bounded s /\ bounded t /\ bounded u /\ ~(s = {}) /\ ~(t = {}) /\ ~(u = {}) ==> !x. x IN s ==> setdist({x},u) <= hausdist(s,t) + hausdist(t,u)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`closure s:real^N->bool`; `closure t:real^N->bool`] HAUSDIST_COMPACT_EXISTS) THEN ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL [`closure t:real^N->bool`; `closure u:real^N->bool`] HAUSDIST_COMPACT_EXISTS) THEN ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z)` THEN CONJ_TAC THENL [ASM_MESON_TAC[SETDIST_CLOSURE; SETDIST_LE_DIST; IN_SING]; ALL_TAC] THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y) + dist(y,z)` THEN REWRITE_TAC[DIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC) in REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_LID; HAUSDIST_POS_LE] THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_RID; HAUSDIST_POS_LE] THEN ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ] THEN ASM_MESON_TAC[lemma; HAUSDIST_SYM; SETDIST_SYM; REAL_ADD_SYM]);; let HAUSDIST_EQ_0 = prove (`!s t:real^N->bool. bounded s /\ bounded t ==> (hausdist(s,t) = &0 <=> s = {} \/ t = {} \/ closure s = closure t)`, REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE; REAL_HAUSDIST_LE_EQ] THEN SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN ASM_REWRITE_TAC[SETDIST_EQ_0_SING; GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN SIMP_TAC[FORALL_IN_CLOSURE_EQ; CLOSED_CLOSURE; CONTINUOUS_ON_ID]);; let HAUSDIST_COMPACT_NONTRIVIAL = prove (`!s t:real^N->bool. compact s /\ compact t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = inf {e | &0 <= e /\ s SUBSET {x + y | x IN t /\ norm y <= e} /\ t SUBSET {x + y | x IN s /\ norm y <= e}}`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN REWRITE_TAC[GSYM dist] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; IN_SING; REAL_LT_IMP_LE]; REPEAT STRIP_TAC THEN EXISTS_TAC `hausdist(s:real^N->bool,t)` THEN ASM_REWRITE_TAC[HAUSDIST_POS_LE] THEN ASM_MESON_TAC[DIST_SYM; HAUSDIST_SYM; HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]]);; let HAUSDIST_BALLS = prove (`(!a b:real^N r s. hausdist(ball(a,r),ball(b,s)) = if r <= &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ (!a b:real^N r s. hausdist(ball(a,r),cball(b,s)) = if r <= &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s)) /\ (!a b:real^N r s. hausdist(cball(a,r),ball(b,s)) = if r < &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ (!a b:real^N r s. hausdist(cball(a,r),cball(b,s)) = if r < &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s))`, REWRITE_TAC[MESON[] `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; HAUSDIST_EMPTY; DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] `hausdist(s,t) = hausdist(closure s,closure t)`] THEN SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN REWRITE_TAC[HAUSDIST_CLOSURE] THEN MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT STRIP_TAC] THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; BOUNDED_CBALL; CBALL_EQ_EMPTY; REAL_NOT_LT] THEN MATCH_MP_TAC SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN REWRITE_TAC[MESON[CBALL_SING] `{a} = cball(a:real^N,&0)`] THEN ASM_REWRITE_TAC[SETDIST_BALLS; REAL_LT_REFL] THEN X_GEN_TAC `c:real` THEN REWRITE_TAC[IN_CBALL] THEN EQ_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN ASM_CASES_TAC `b:real^N = a` THENL [ASM_REWRITE_TAC[DIST_SYM; DIST_REFL; REAL_MAX_LE] THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `a + r % basis 1:real^N`) (MP_TAC o SPEC `a + s % basis 1:real^N`)) THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN ASM_REAL_ARITH_TAC; DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `a - r / dist(a,b) % (b - a):real^N`) (MP_TAC o SPEC `b - s / dist(a,b) % (a - b):real^N`)) THEN REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH `b - e % (a - b) - a:real^N = (&1 + e) % (b - a)`] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN REWRITE_TAC[NORM_SUB; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; let HAUSDIST_ALT = prove (`!s t:real^N->bool. bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) ==> hausdist(s,t) = sup {abs(setdist({x},s) - setdist({x},t)) | x IN (:real^N)}`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM(CONJUNCT2 SETDIST_CLOSURE); GSYM CLOSURE_EQ_EMPTY; MESON[HAUSDIST_CLOSURE] `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; COMPACT_IMP_BOUNDED] THEN MATCH_MP_TAC SUP_EQ THEN REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC; IN_UNIV] THEN REWRITE_TAC[REAL_ARITH `abs(y - x) <= b <=> x <= y + b /\ y <= x + b`] THEN GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN BINOP_TAC THEN (EQ_TAC THENL [ALL_TAC; MESON_TAC[SETDIST_SING_IN_SET; REAL_ADD_LID]]) THEN DISCH_TAC THEN X_GEN_TAC `z:real^N` THENL [MP_TAC(ISPECL[`{z:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT); MP_TAC(ISPECL[`{z:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL [MP_TAC(ISPECL[`{y:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT); MP_TAC(ISPECL[`{y:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN TRANS_TAC REAL_LE_TRANS `dist(z:real^N,x)` THEN ASM_SIMP_TAC[SETDIST_LE_DIST; IN_SING] THEN UNDISCH_TAC `dist(y:real^N,x) <= b` THEN CONV_TAC NORM_ARITH);; let CONTINUOUS_DIAMETER = prove (`!s:real^N->bool e. bounded s /\ ~(s = {}) /\ &0 < e ==> ?d. &0 < d /\ !t. bounded t /\ ~(t = {}) /\ hausdist(s,t) < d ==> abs(diameter s - diameter t) < e`, REPEAT STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `diameter(s:real^N->bool) - diameter(t:real^N->bool) = diameter(closure s) - diameter(closure t)` SUBST1_TAC THENL [ASM_MESON_TAC[DIAMETER_CLOSURE]; ALL_TAC] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 * hausdist(s:real^N->bool,t)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN MP_TAC(ISPECL [`vec 0:real^N`; `hausdist(s:real^N->bool,t)`] DIAMETER_CBALL) THEN ASM_SIMP_TAC[HAUSDIST_POS_LE; GSYM REAL_NOT_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH `x <= y + e /\ y <= x + e ==> abs(x - y) <= e`) THEN CONJ_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) DIAMETER_SUMS o rand o snd) THEN ASM_SIMP_TAC[BOUNDED_CBALL; BOUNDED_CLOSURE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN MATCH_MP_TAC DIAMETER_SUBSET THEN ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL; BOUNDED_CLOSURE] THEN ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY]);; (* ------------------------------------------------------------------------- *) (* Isometries are embeddings, and even surjective in the compact case. *) (* ------------------------------------------------------------------------- *) let ISOMETRY_IMP_OPEN_MAP = prove (`!f:real^M->real^N s t u. IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) /\ open_in (subtopology euclidean s) u ==> open_in (subtopology euclidean t) (IMAGE f u)`, REWRITE_TAC[open_in; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IMP_CONJ] THEN EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]);; let ISOMETRY_IMP_EMBEDDING = prove (`!f:real^M->real^N s t. IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) ==> ?g. homeomorphism (s,t) (f,g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN ASM_SIMP_TAC[ISOMETRY_ON_IMP_CONTINUOUS_ON] THEN CONJ_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; REPEAT STRIP_TAC] THEN MATCH_MP_TAC ISOMETRY_IMP_OPEN_MAP THEN ASM_MESON_TAC[]);; let ISOMETRY_IMP_HOMEOMORPHISM_COMPACT = prove (`!f s:real^N->bool. compact s /\ IMAGE f s SUBSET s /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) ==> ?g. homeomorphism (s,s) (f,g)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (f:real^N->real^N) s = s` (fun th -> ASM_MESON_TAC[th; ISOMETRY_IMP_EMBEDDING]) THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOMETRY_ON_IMP_CONTINUOUS_ON) THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `setdist({x},IMAGE (f:real^N->real^N) s) = &0` MP_TAC THENL [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN REWRITE_TAC[SETDIST_POS_LE] THEN DISCH_TAC THEN (X_CHOOSE_THEN `z:num->real^N` STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) `z 0 = (x:real^N) /\ !n. z(SUC n) = f(z n)` THEN SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN DISCH_THEN(MP_TAC o SPEC `z:num->real^N`) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `setdist({x},IMAGE (f:real^N->real^N) s)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPECL [`N:num`; `N + 1`])) THEN ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[REAL_NOT_LT; o_THM]] THEN SUBGOAL_THEN `(r:num->num) N < r (N + 1)` MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM]] THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z(SUC d))` THEN CONJ_TAC THENL [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN SPEC_TAC(`(r:num->num) N`,`m:num`) THEN INDUCT_TAC THEN ASM_MESON_TAC[ADD_CLAUSES]; REWRITE_TAC[SETDIST_EQ_0_SING; IMAGE_EQ_EMPTY] THEN ASM_MESON_TAC[COMPACT_IMP_CLOSED; NOT_IN_EMPTY; COMPACT_CONTINUOUS_IMAGE; CLOSURE_CLOSED]]);; (* ------------------------------------------------------------------------- *) (* Urysohn's lemma (for real^N, where the proof is easy using distances). *) (* ------------------------------------------------------------------------- *) let URYSOHN_LOCAL_STRONG = prove (`!s t u a b. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} /\ ~(a = b) ==> ?f:real^N->real^M. f continuous_on u /\ (!x. x IN u ==> f(x) IN segment[a,b]) /\ (!x. x IN u ==> (f x = a <=> x IN s)) /\ (!x. x IN u ==> (f x = b <=> x IN t))`, let lemma = prove (`!s t u a b. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} /\ ~(s = {}) /\ ~(t = {}) /\ ~(a = b) ==> ?f:real^N->real^M. f continuous_on u /\ (!x. x IN u ==> f(x) IN segment[a,b]) /\ (!x. x IN u ==> (f x = a <=> x IN s)) /\ (!x. x IN u ==> (f x = b <=> x IN t))`, REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real^N. a + setdist({x},s) / (setdist({x},s) + setdist({x},t)) % (b - a:real^M)` THEN REWRITE_TAC[] THEN SUBGOAL_THEN `(!x:real^N. x IN u ==> (setdist({x},s) = &0 <=> x IN s)) /\ (!x:real^N. x IN u ==> (setdist({x},t) = &0 <=> x IN t))` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[SETDIST_EQ_0_SING] THEN CONJ_TAC THENL [MP_TAC(ISPEC `s:real^N->bool` CLOSED_IN_CLOSED); MP_TAC(ISPEC `t:real^N->bool` CLOSED_IN_CLOSED)] THEN DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN ASM_MESON_TAC[CLOSURE_CLOSED; INTER_SUBSET; SUBSET_CLOSURE; SUBSET; IN_INTER; CLOSURE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN u ==> &0 < setdist({x},s) + setdist({x},t)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN REWRITE_TAC[SETDIST_POS_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC) THEN REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF] THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN REWRITE_TAC[VECTOR_MUL_EQ_0; LEFT_OR_DISTRIB; VECTOR_ARITH `a + x % (b - a):real^N = (&1 - u) % a + u % b <=> (x - u) % (b - a) = vec 0`; EXISTS_OR_THM] THEN DISJ1_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[REAL_SUB_0; UNWIND_THM1] THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; SETDIST_POS_LE; REAL_LE_LDIV_EQ; REAL_ARITH `a <= &1 * (a + b) <=> &0 <= b`]; REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`]; REWRITE_TAC[VECTOR_ARITH `a + x % (b - a):real^N = b <=> (x - &1) % (b - a) = vec 0`]] THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN ASM_SIMP_TAC[REAL_SUB_0; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ARITH `x:real = x + y <=> y = &0`] THEN ASM_REWRITE_TAC[]) in MATCH_MP_TAC(MESON[] `(!s t. P s t <=> P t s) /\ (!s t. ~(s = {}) /\ ~(t = {}) ==> P s t) /\ P {} {} /\ (!t. ~(t = {}) ==> P {} t) ==> !s t. P s t`) THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN REWRITE_TAC[SEGMENT_SYM; INTER_COMM; CONJ_ACI; EQ_SYM_EQ]; SIMP_TAC[lemma]; REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. midpoint(a,b)):real^N->real^M` THEN ASM_SIMP_TAC[NOT_IN_EMPTY; CONTINUOUS_ON_CONST; MIDPOINT_IN_SEGMENT] THEN REWRITE_TAC[midpoint] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN UNDISCH_TAC `~(a:real^M = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN VECTOR_ARITH_TAC; REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = u` THENL [EXISTS_TAC `(\x. b):real^N->real^M` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; ENDS_IN_SEGMENT; IN_UNIV; CONTINUOUS_ON_CONST]; SUBGOAL_THEN `?c:real^N. c IN u /\ ~(c IN t)` STRIP_ASSUME_TAC THENL [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`{c:real^N}`; `t:real^N->bool`; `u:real^N->bool`; `midpoint(a,b):real^M`; `b:real^M`] lemma) THEN ASM_REWRITE_TAC[CLOSED_IN_SING; MIDPOINT_EQ_ENDPOINT] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NOT_IN_EMPTY] THEN X_GEN_TAC `f:real^N->real^M` THEN STRIP_TAC THEN CONJ_TAC THENL [SUBGOAL_THEN `segment[midpoint(a,b):real^M,b] SUBSET segment[a,b]` MP_TAC THENL [REWRITE_TAC[SUBSET; IN_SEGMENT; midpoint] THEN GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(&1 + u) / &2` THEN ASM_REWRITE_TAC[] THEN REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN VECTOR_ARITH_TAC; ASM SET_TAC[]]; SUBGOAL_THEN `~(a IN segment[midpoint(a,b):real^M,b])` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP DIST_IN_CLOSED_SEGMENT) THEN REWRITE_TAC[DIST_MIDPOINT] THEN UNDISCH_TAC `~(a:real^M = b)` THEN NORM_ARITH_TAC]]]);; let URYSOHN_LOCAL = prove (`!s t u a b. closed_in (subtopology euclidean u) s /\ closed_in (subtopology euclidean u) t /\ s INTER t = {} ==> ?f:real^N->real^M. f continuous_on u /\ (!x. x IN u ==> f(x) IN segment[a,b]) /\ (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^M = b` THENL [EXISTS_TAC `(\x. b):real^N->real^M` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; CONTINUOUS_ON_CONST]; MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`; `a:real^M`; `b:real^M`] URYSOHN_LOCAL_STRONG) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SET_TAC[]]);; let URYSOHN_STRONG = prove (`!s t a b. closed s /\ closed t /\ s INTER t = {} /\ ~(a = b) ==> ?f:real^N->real^M. f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ (!x. f x = a <=> x IN s) /\ (!x. f x = b <=> x IN t)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN(MP_TAC o MATCH_MP URYSOHN_LOCAL_STRONG) THEN REWRITE_TAC[IN_UNIV]);; let URYSOHN = prove (`!s t a b. closed s /\ closed t /\ s INTER t = {} ==> ?f:real^N->real^M. f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`, REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN (MP_TAC o ISPECL [`a:real^M`; `b:real^M`] o MATCH_MP URYSOHN_LOCAL) THEN REWRITE_TAC[IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Countability of some relevant sets. *) (* ------------------------------------------------------------------------- *) let COUNTABLE_INTEGER = prove (`COUNTABLE integer`, MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\n. (&n:real)) (:num) UNION IMAGE (\n. --(&n)) (:num)` THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_UNION; NUM_COUNTABLE] THEN REWRITE_TAC[SUBSET; IN_UNION; IN_IMAGE; IN_UNIV] THEN REWRITE_TAC[IN; INTEGER_CASES]);; let CARD_EQ_INTEGER = prove (`integer =_c (:num)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_INTEGER] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN REWRITE_TAC[IN; INTEGER_CLOSED]);; let COUNTABLE_RATIONAL = prove (`COUNTABLE rational`, MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (\(x,y). x / y) (integer CROSS integer)` THEN SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; COUNTABLE_INTEGER] THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS] THEN REWRITE_TAC[rational; IN] THEN MESON_TAC[]);; let CARD_EQ_RATIONAL = prove (`rational =_c (:num)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_RATIONAL] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN REWRITE_TAC[IN; RATIONAL_CLOSED]);; let COUNTABLE_INTEGER_COORDINATES = prove (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }`, MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_INTEGER]);; let COUNTABLE_RATIONAL_COORDINATES = prove (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`, MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_RATIONAL]);; (* ------------------------------------------------------------------------- *) (* Density of points with rational, or just dyadic rational, coordinates. *) (* ------------------------------------------------------------------------- *) let CLOSURE_DYADIC_RATIONALS = prove (`closure { inv(&2 pow n) % x |n,x| !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) } = (:real^N)`, REWRITE_TAC[EXTENSION; CLOSURE_APPROACHABLE; IN_UNIV; EXISTS_IN_GSPEC] THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; REAL_POW_INV; REAL_LT_RDIV_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN ASM_SIMP_TAC[LAMBDA_BETA; FLOOR; dist; NORM_MUL] THEN MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) (SPEC_ALL NORM_LE_L1)) THEN SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&(dimindex(:N)) * inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN SIMP_TAC[REAL_ABS_MUL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH; REAL_FIELD `~(a = &0) ==> inv a * b - x = inv a * (b - a * x)`] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[REAL_LE_REFL; REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NUM] THEN MP_TAC(SPEC `&2 pow n * (x:real^N)$k` FLOOR) THEN REAL_ARITH_TAC);; let CLOSURE_RATIONAL_COORDINATES = prove (`closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } = (:real^N)`, MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN EXISTS_TAC `closure { inv(&2 pow n) % x:real^N |n,x| !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }` THEN CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CLOSURE_DYADIC_RATIONALS]] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN ASM_SIMP_TAC[RATIONAL_CLOSED]);; let CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET = prove (`!s:real^N->bool. open s ==> closure(s INTER { inv(&2 pow n) % x | n,x | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; let CLOSURE_RATIONALS_IN_OPEN_SET = prove (`!s:real^N->bool. open s ==> closure(s INTER { inv(&2 pow n) % x | n,x | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = closure s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; (* ------------------------------------------------------------------------- *) (* Various separability-type properties. *) (* ------------------------------------------------------------------------- *) let UNIV_SECOND_COUNTABLE = prove (`?b. COUNTABLE b /\ (!c. c IN b ==> open c) /\ !s:real^N->bool. open s ==> ?u. u SUBSET b /\ s = UNIONS u`, EXISTS_TAC `IMAGE (\(v:real^N,q). ball(v,q)) ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS rational)` THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_CROSS THEN REWRITE_TAC[COUNTABLE_RATIONAL] THEN MATCH_MP_TAC COUNTABLE_CART THEN REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | P x} = P`]; REWRITE_TAC[FORALL_IN_IMAGE; CROSS; FORALL_IN_GSPEC; OPEN_BALL]; REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[UNIONS_0; EMPTY_SUBSET]; ALL_TAC] THEN EXISTS_TAC `{c | c IN IMAGE (\(v:real^N,q). ball(v,q)) ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS rational) /\ c SUBSET s}` THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_IN_IMAGE] THEN REWRITE_TAC[CROSS; EXISTS_PAIR_THM; EXISTS_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC(REWRITE_RULE[EXTENSION; IN_UNIV] CLOSURE_RATIONAL_COORDINATES) THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `e / &4`]) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN SUBGOAL_THEN `?x. rational x /\ e / &3 < x /\ x < e / &2` (X_CHOOSE_THEN `q:real` STRIP_ASSUME_TAC) THENL [MP_TAC(ISPECL [`&5 / &12 * e`; `e / &12`] RATIONAL_APPROXIMATION) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN SIMP_TAC[] THEN REAL_ARITH_TAC; EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL [ASM_REWRITE_TAC[IN]; REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; ASM_REAL_ARITH_TAC]]]);; let UNIV_SECOND_COUNTABLE_SEQUENCE = prove (`?b:num->real^N->bool. (!m n. b m = b n <=> m = n) /\ (!n. open(b n)) /\ (!s. open s ==> ?k. s = UNIONS {b n | n IN k})`, X_CHOOSE_THEN `bb:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN MP_TAC(ISPEC `bb:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN SUBGOAL_THEN `INFINITE {ball(vec 0:real^N,inv(&n + &1)) | n IN (:num)}` MP_TAC THENL [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(REWRITE_RULE [RIGHT_IMP_FORALL_THM; IMP_IMP] INFINITE_IMAGE_INJ) THEN REWRITE_TAC[num_INFINITE] THEN MATCH_MP_TAC WLOG_LT THEN SIMP_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `inv(&n + &1) % basis 1:real^N`) THEN REWRITE_TAC[IN_BALL; DIST_0; NORM_MUL; REAL_ABS_INV] THEN SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_REFL] THEN MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; REWRITE_TAC[INFINITE; SIMPLE_IMAGE] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE UNIONS {u | u SUBSET bb} :(real^N->bool)->bool` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET] THEN GEN_REWRITE_TAC I [SUBSET] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[OPEN_BALL]]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[SUBSET_IMAGE; LEFT_AND_EXISTS_THM; SUBSET_UNIV] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLE_IMAGE]]);; let SUBSET_SECOND_COUNTABLE = prove (`!s:real^N->bool. ?b. COUNTABLE b /\ (!c. c IN b ==> ~(c = {}) /\ open_in(subtopology euclidean s) c) /\ !t. open_in(subtopology euclidean s) t ==> ?u. u SUBSET b /\ t = UNIONS u`, GEN_TAC THEN SUBGOAL_THEN `?b. COUNTABLE b /\ (!c:real^N->bool. c IN b ==> open_in(subtopology euclidean s) c) /\ !t. open_in(subtopology euclidean s) t ==> ?u. u SUBSET b /\ t = UNIONS u` STRIP_ASSUME_TAC THENL [X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN EXISTS_TAC `{s INTER c :real^N->bool | c IN B}` THEN ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE] THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; OPEN_IN_OPEN_INTER] THEN REWRITE_TAC[OPEN_IN_OPEN] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `?b. b SUBSET B /\ u:real^N->bool = UNIONS b` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `b:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[INTER_UNIONS] THEN AP_TERM_TAC THEN SET_TAC[]; EXISTS_TAC `b DELETE ({}:real^N->bool)` THEN ASM_SIMP_TAC[COUNTABLE_DELETE; IN_DELETE; SUBSET_DELETE] THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u DELETE ({}:real^N->bool)` THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[EXTENSION; IN_UNIONS] THEN GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[IN_DELETE] THEN SET_TAC[]]);; let SEPARABLE = prove (`!s:real^N->bool. ?t. COUNTABLE t /\ t SUBSET s /\ s SUBSET closure t`, MP_TAC SUBSET_SECOND_COUNTABLE THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `B:(real^N->bool)->bool` (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:(real^N->bool)->real^N` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (f:(real^N->bool)->real^N) B` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[]; REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_THEN `!t:real^N->bool. open_in (subtopology euclidean s) t ==> (?u. u SUBSET B /\ t = UNIONS u)` (MP_TAC o SPEC `s INTER ball(x:real^N,e)`) THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:(real^N->bool)->bool` THEN ASM_CASES_TAC `b:(real^N->bool)->bool = {}` THENL [MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN ASM_REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; UNIONS_0] THEN ASM_MESON_TAC[CENTRE_IN_BALL]; STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `(f:(real^N->bool)->real^N) c`) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN MATCH_MP_TAC(TAUT `a /\ c ==> (a /\ b <=> c) ==> b`) THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[]]]);; let OPEN_SET_RATIONAL_COORDINATES = prove (`!s. open s /\ ~(s = {}) ==> ?x:real^N. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } INTER (s:real^N->bool) = {})` MP_TAC THENL [ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; INTER_UNIV]; ALL_TAC] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; CLOSURE_APPROACHABLE; IN_INTER; IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o REWRITE_RULE[open_def]) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let OPEN_COUNTABLE_UNION_OPEN_INTERVALS, OPEN_COUNTABLE_UNION_CLOSED_INTERVALS = (CONJ_PAIR o prove) (`(!s:real^N->bool. open s ==> ?D. COUNTABLE D /\ (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval(a,b)) /\ UNIONS D = s) /\ (!s:real^N->bool. open s ==> ?D. COUNTABLE D /\ (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval[a,b]) /\ UNIONS D = s)`, REPEAT STRIP_TAC THENL [EXISTS_TAC `{i | i IN IMAGE (\(a:real^N,b). interval(a,b)) ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ i SUBSET s}`; EXISTS_TAC `{i | i IN IMAGE (\(a:real^N,b). interval[a,b]) ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ i SUBSET s}`] THEN (SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_CROSS; COUNTABLE_RATIONAL_COORDINATES] THEN REWRITE_TAC[IN_ELIM_THM; UNIONS_GSPEC; IMP_CONJ; GSYM CONJ_ASSOC] THEN REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_CROSS; IN_ELIM_THM] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SET_TAC[]; DISCH_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[open_def]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) ==> ?a b. rational a /\ rational b /\ a < (x:real^N)$i /\ (x:real^N)$i < b /\ abs(b - a) < e / &(dimindex(:N))` MP_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[SUBSET; IN_INTERVAL; REAL_LT_IMP_LE] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[dist] THEN MP_TAC(ISPEC `y - x:real^N` NORM_LE_L1) THEN MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; CARD_NUMSEG_1] THEN REWRITE_TAC[DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));; let LINDELOF = prove (`!f:(real^N->bool)->bool. (!s. s IN f ==> open s) ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?b. COUNTABLE b /\ (!c:real^N->bool. c IN b ==> open c) /\ (!s. open s ==> ?u. u SUBSET b /\ s = UNIONS u)` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[UNIV_SECOND_COUNTABLE]; ALL_TAC] THEN ABBREV_TAC `d = {s:real^N->bool | s IN b /\ ?u. u IN f /\ s SUBSET u}` THEN SUBGOAL_THEN `COUNTABLE d /\ UNIONS f :real^N->bool = UNIONS d` STRIP_ASSUME_TAC THENL [EXPAND_TAC "d" THEN ASM_SIMP_TAC[COUNTABLE_RESTRICT] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!s:real^N->bool. ?u. s IN d ==> u IN f /\ s SUBSET u` MP_TAC THENL [EXPAND_TAC "d" THEN SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:(real^N->bool)->(real^N->bool)` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (g:(real^N->bool)->(real^N->bool)) d` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; UNIONS_IMAGE] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; let LINDELOF_OPEN_IN = prove (`!f u:real^N->bool. (!s. s IN f ==> open_in (subtopology euclidean u) s) ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:(real^N->bool)->real^N->bool` THEN DISCH_TAC THEN MP_TAC(ISPEC `IMAGE (v:(real^N->bool)->real^N->bool) f` LINDELOF) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!f'. f' SUBSET f ==> UNIONS f' = (u:real^N->bool) INTER UNIONS (IMAGE v f')` MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_REFL]]);; let COUNTABLE_DISJOINT_OPEN_SUBSETS = prove (`!f. (!s:real^N->bool. s IN f ==> open s) /\ pairwise DISJOINT f ==> COUNTABLE f`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINDELOF) THEN DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `({}:real^N->bool) INSERT g` THEN ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN REWRITE_TAC[SUBSET; IN_INSERT] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[EXTENSION; SUBSET] THEN REWRITE_TAC[IN_UNIONS; pairwise] THEN REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[]);; let CARD_EQ_OPEN_SETS = prove (`{s:real^N->bool | open s} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN TRANS_TAC CARD_LE_TRANS `{s:(real^N->bool)->bool | s SUBSET b}` THEN CONJ_TAC THENL [REWRITE_TAC[LE_C] THEN EXISTS_TAC `UNIONS:((real^N->bool)->bool)->real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; TRANS_TAC CARD_LE_TRANS `{s | s SUBSET (:num)}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_LE_POWERSET THEN ASM_REWRITE_TAC[GSYM COUNTABLE_ALT]; REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC] THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM; CARD_EQ_REAL]]]; REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN EXISTS_TAC `\x. ball(x % basis 1:real^N,&1)` THEN REWRITE_TAC[OPEN_BALL; GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[NORM_ARITH `dist(p:real^N,q) + &1 <= &1 <=> p = q`] THEN REWRITE_TAC[VECTOR_MUL_RCANCEL; EQ_SYM_EQ] THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; let CARD_EQ_CLOSED_SETS = prove (`{s:real^N->bool | closed s} =_c (:real)`, SUBGOAL_THEN `{s:real^N->bool | closed s} = IMAGE (\s. (:real^N) DIFF s) {s | open s}` SUBST1_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_ELIM_THM; GSYM OPEN_CLOSED] THEN MESON_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]; TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | open s}` THEN REWRITE_TAC[CARD_EQ_OPEN_SETS] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN SET_TAC[]]);; let CARD_EQ_COMPACT_SETS = prove (`{s:real^N->bool | compact s} =_c (:real)`, REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_CLOSED_SETS] THEN MATCH_MP_TAC CARD_LE_SUBSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_CLOSED]; REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN EXISTS_TAC `\x. {x % basis 1:real^N}` THEN REWRITE_TAC[COMPACT_SING; SET_RULE `{x} = {y} <=> x = y`] THEN SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; let COUNTABLE_NON_CONDENSATION_POINTS = prove (`!s:real^N->bool. COUNTABLE(s DIFF {x | x condensation_point_of s})`, REPEAT STRIP_TAC THEN REWRITE_TAC[condensation_point_of] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC UNIV_SECOND_COUNTABLE THEN EXISTS_TAC `s INTER UNIONS { u:real^N->bool | u IN b /\ COUNTABLE(s INTER u)}` THEN REWRITE_TAC[INTER_UNIONS; IN_ELIM_THM] THEN CONJ_TAC THENL [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RESTRICT]; SIMP_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN SUBGOAL_THEN `?u:real^N->bool. x IN u /\ u IN b /\ u SUBSET t` MP_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `s INTER t:real^N->bool` THEN ASM SET_TAC[]]);; let CARD_EQ_CONDENSATION_POINTS_IN_SET = prove (`!s:real^N->bool. ~(COUNTABLE s) ==> {x | x IN s /\ x condensation_point_of s} =_c s`, REPEAT STRIP_TAC THEN TRANS_TAC CARD_EQ_TRANS `(s DIFF {x | x condensation_point_of s}) +_c {x:real^N | x IN s /\ x condensation_point_of s}` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_ADD_ABSORB_LEFT THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [POP_ASSUM MP_TAC THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o CONJ (SPEC `s:real^N->bool` COUNTABLE_NON_CONDENSATION_POINTS) o MATCH_MP FINITE_IMP_COUNTABLE) THEN REWRITE_TAC[GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]; REWRITE_TAC[INFINITE_CARD_LE] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS) THEN REWRITE_TAC[GSYM COUNTABLE_ALT; COUNTABLE_NON_CONDENSATION_POINTS]]; ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN W(MP_TAC o PART_MATCH (rand o rand) CARD_DISJOINT_UNION o rand o snd) THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]]);; let LIMPT_OF_CONDENSATION_POINTS,CONDENSATION_POINT_OF_CONDENSATION_POINTS = (CONJ_PAIR o prove) (`(!x:real^N s. x limit_point_of {y | y condensation_point_of s} <=> x condensation_point_of s) /\ (!x:real^N s. x condensation_point_of {y | y condensation_point_of s} <=> x condensation_point_of s)`, REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(r ==> q) /\ (q ==> p) /\ (p ==> r) ==> (q <=> p) /\ (r <=> p)`) THEN REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT] THEN CONJ_TAC THENL [REWRITE_TAC[LIMPT_APPROACHABLE; CONDENSATION_POINT_INFINITE_BALL] THEN REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SIMP_TAC[SUBSET; IN_INTER; IN_BALL] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; ONCE_REWRITE_TAC[CONDENSATION_POINT_INFINITE_BALL] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[CARD_EQ_CONDENSATION_POINTS_IN_SET; CARD_COUNTABLE_CONG] `~COUNTABLE s ==> ~COUNTABLE {x | x IN s /\ x condensation_point_of s}`)) THEN REWRITE_TAC[UNCOUNTABLE_REAL; CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THENL [ASM_MESON_TAC[CONDENSATION_POINT_OF_SUBSET; INTER_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN EXISTS_TAC `closure(s INTER ball(x:real^N,e / &2))` THEN CONJ_TAC THENL [REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN ASM_SIMP_TAC[CONDENSATION_POINT_IMP_LIMPT]; TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]]);; let CLOSED_CONDENSATION_POINTS = prove (`!s:real^N->bool. closed {x | x condensation_point_of s}`, SIMP_TAC[CLOSED_LIMPT; LIMPT_OF_CONDENSATION_POINTS; IN_ELIM_THM]);; let CANTOR_BENDIXSON = prove (`!s:real^N->bool. closed s ==> ?t u. closed t /\ (!x. x IN t ==> x limit_point_of t) /\ COUNTABLE u /\ s = t UNION u`, REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`{x:real^N | x condensation_point_of s}`; `s DIFF {x:real^N | x condensation_point_of s}`] THEN REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS; CLOSED_CONDENSATION_POINTS; IN_ELIM_THM; LIMPT_OF_CONDENSATION_POINTS] THEN REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN RULE_ASSUM_TAC(REWRITE_RULE[CLOSED_LIMPT]) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CONDENSATION_POINT_IMP_LIMPT]);; (* ------------------------------------------------------------------------- *) (* A discrete set is countable, and an uncountable set has a limit point. *) (* ------------------------------------------------------------------------- *) let DISCRETE_IMP_COUNTABLE = prove (`!s:real^N->bool. (!x. x IN s ==> ?e. &0 < e /\ !y. y IN s /\ ~(y = x) ==> e <= norm(y - x)) ==> COUNTABLE s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!x. x IN s ==> ?q. (!i. 1 <= i /\ i <= dimindex(:N) ==> rational(q$i)) /\ !y:real^N. y IN s /\ ~(y = x) ==> norm(x - q) < norm(y - q)` MP_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN MP_TAC(SET_RULE `x IN (:real^N)`) THEN REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `q:real^N->real^N` THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `{ x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`; `(:num)`] CARD_LE_TRANS) THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REWRITE_RULE[COUNTABLE; ge_c] COUNTABLE_RATIONAL_COORDINATES] THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `q:real^N->real^N` THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_ANTISYM]]);; let UNCOUNTABLE_CONTAINS_LIMIT_POINT = prove (`!s. ~(COUNTABLE s) ==> ?x. x IN s /\ x limit_point_of s`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] DISCRETE_IMP_COUNTABLE)) THEN REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LT; dist] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* The Brouwer reduction theorem. *) (* ------------------------------------------------------------------------- *) let BROUWER_REDUCTION_THEOREM_GEN = prove (`!P s:real^N->bool. (!f. (!n. closed(f n) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n)) ==> P(INTERS {f n | n IN (:num)})) /\ closed s /\ P s ==> ?t. t SUBSET s /\ closed t /\ P t /\ (!u. u SUBSET s /\ closed u /\ P u ==> ~(u PSUBSET t))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?b:num->real^N->bool. (!m n. b m = b n <=> m = n) /\ (!n. open (b n)) /\ (!s. open s ==> (?k. s = UNIONS {b n | n IN k}))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[UNIV_SECOND_COUNTABLE_SEQUENCE]; ALL_TAC] THEN X_CHOOSE_THEN `a:num->real^N->bool` MP_TAC (prove_recursive_functions_exist num_RECURSION `a 0 = (s:real^N->bool) /\ (!n. a(SUC n) = if ?u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} then @u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} else a(n))`) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "base") (LABEL_TAC "step")) THEN EXISTS_TAC `INTERS {a n :real^N->bool | n IN (:num)}` THEN SUBGOAL_THEN `!n. (a:num->real^N->bool)(SUC n) SUBSET a(n)` ASSUME_TAC THENL [GEN_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!n. (a:num->real^N->bool) n SUBSET s` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; ALL_TAC] THEN SUBGOAL_THEN `!n. closed((a:num->real^N->bool) n) /\ P(a n)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CLOSED_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN REWRITE_TAC[PSUBSET_ALT] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[INTERS_GSPEC; EXISTS_IN_GSPEC; IN_UNIV] THEN DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?n. x IN (b:num->real^N->bool)(n) /\ t INTER b n = {}` STRIP_ASSUME_TAC THENL [MP_TAC(ISPEC `(:real^N) DIFF t` OPEN_CONTAINS_BALL) THEN ASM_REWRITE_TAC[GSYM closed] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> t INTER s = {}`] THEN X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN FIRST_X_ASSUM(MP_TAC o SPEC `ball(x:real^N,e)`) THEN ASM_REWRITE_TAC[OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `k:num->bool` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_UNIONS; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN SET_TAC[]; REMOVE_THEN "step" (MP_TAC o SPEC `n:num`) THEN COND_CASES_TAC THENL [DISCH_THEN(ASSUME_TAC o SYM) THEN FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN DISCH_THEN(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]]]);; let BROUWER_REDUCTION_THEOREM = prove (`!P s:real^N->bool. (!f. (!n. compact(f n) /\ ~(f n = {}) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n)) ==> P(INTERS {f n | n IN (:num)})) /\ compact s /\ ~(s = {}) /\ P s ==> ?t. t SUBSET s /\ compact t /\ ~(t = {}) /\ P t /\ (!u. u SUBSET s /\ closed u /\ ~(u = {}) /\ P u ==> ~(u PSUBSET t))`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\t:real^N->bool. ~(t = {}) /\ t SUBSET s /\ P t`; `s:real^N->bool`] BROUWER_REDUCTION_THEOREM_GEN) THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_REFL] THEN ANTS_TAC THENL [GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!n. compact((f:num->real^N->bool) n)` ASSUME_TAC THENL [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[] THEN SET_TAC[]; ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]]);; (* ------------------------------------------------------------------------- *) (* The Arzela-Ascoli theorem. *) (* ------------------------------------------------------------------------- *) let SUBSEQUENCE_DIAGONALIZATION_LEMMA = prove (`!P:num->(num->A)->bool. (!i r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ P i (r o k)) /\ (!i r:num->A k1 k2 N. P i (r o k1) /\ (!j. N <= j ==> ?j'. j <= j' /\ k2 j = k1 j') ==> P i (r o k2)) ==> !r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ (!i. P i (r o k))`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [SKOLEM_THM] THEN REWRITE_TAC[FORALL_AND_THM; TAUT `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN DISCH_THEN(X_CHOOSE_THEN `kk:num->(num->A)->num->num` STRIP_ASSUME_TAC) THEN X_GEN_TAC `r:num->A` THEN (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) `(rr 0 = (kk:num->(num->A)->num->num) 0 r) /\ (!n. rr(SUC n) = rr n o kk (SUC n) (r o rr n))` THEN EXISTS_TAC `\n. (rr:num->num->num) n n` THEN REWRITE_TAC[ETA_AX] THEN SUBGOAL_THEN `(!i. (!m n. m < n ==> (rr:num->num->num) i m < rr i n)) /\ (!i. (P:num->(num->A)->bool) i (r o rr i))` STRIP_ASSUME_TAC THENL [REWRITE_TAC[AND_FORALL_THM] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[o_ASSOC] THEN REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!i j n. i <= j ==> (rr:num->num->num) i n <= rr j n` ASSUME_TAC THENL [REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`j:num`,`j:num`) THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[FORALL_UNWIND_THM2] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LE_TRANS)) THEN REWRITE_TAC[o_THM] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[LE_LT] `!f:num->num. (!m n. m < n ==> f m < f n) ==> (!m n. m <= n ==> f m <= f n)`) o SPEC `i + d:num`) THEN SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN ASM_SIMP_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `(rr:num->num->num) n m` THEN ASM_MESON_TAC[LT_IMP_LE]; ALL_TAC] THEN SUBGOAL_THEN `!m n i. n <= m ==> ?j. i <= j /\ (rr:num->num->num) m i = rr n j` ASSUME_TAC THENL [ALL_TAC; X_GEN_TAC `i:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(rr:num->num->num) i` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `i:num` THEN ASM_MESON_TAC[]] THEN SUBGOAL_THEN `!p d i. ?j. i <= j /\ (rr:num->num->num) (p + d) i = rr p j` (fun th -> MESON_TAC[LE_EXISTS; th]) THEN X_GEN_TAC `p:num` THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "+") THEN X_GEN_TAC `i:num` THEN ASM_REWRITE_TAC[o_THM] THEN REMOVE_THEN "+" (MP_TAC o SPEC `(kk:num->(num->A)->num->num) (SUC(p + d)) ((r:num->A) o (rr:num->num->num) (p + d)) i`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN SPEC_TAC(`i:num`,`i:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; let FUNCTION_CONVERGENT_SUBSEQUENCE = prove (`!f:num->real^M->real^N s M. COUNTABLE s /\ (!n x. x IN s ==> norm(f n x) <= M) ==> ?k. (!m n:num. m < n ==> k m < k n) /\ !x. x IN s ==> ?l. ((\n. f (k n) x) --> l) sequentially`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL [EXISTS_TAC `\n:num. n` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY]; ALL_TAC] THEN MP_TAC(ISPEC `s:real^M->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `X:num->real^M` THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(ISPEC `\i r. ?l. ((\n. ((f:num->real^M->real^N) o (r:num->num)) n ((X:num->real^M) i)) --> l) sequentially` SUBSEQUENCE_DIAGONALIZATION_LEMMA) THEN REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_UNIV] THEN ANTS_TAC THENL [ALL_TAC; DISCH_THEN MATCH_ACCEPT_TAC] THEN CONJ_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN MAP_EVERY X_GEN_TAC [`i:num`; `r:num->num`] THEN MP_TAC(ISPEC `cball(vec 0:real^N,M)` compact) THEN REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `\n. (f:num->real^M->real^N) ((r:num->num) n) (X(i:num))`) THEN ASM_REWRITE_TAC[IN_CBALL_0; o_DEF] THEN MESON_TAC[]; REPEAT GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY; GE] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN ASM_MESON_TAC[LE_TRANS; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`]]);; let ARZELA_ASCOLI = prove (`!f:num->real^M->real^N s M. compact s /\ (!n x. x IN s ==> norm(f n x) <= M) /\ (!x e. x IN s /\ &0 < e ==> ?d. &0 < d /\ !n y. y IN s /\ norm(x - y) < d ==> norm(f n x - f n y) < e) ==> ?g. g continuous_on s /\ ?r. (!m n:num. m < n ==> r m < r n) /\ !e. &0 < e ==> ?N. !n x. n >= N /\ x IN s ==> norm(f(r n) x - g x) < e`, REPEAT STRIP_TAC THEN REWRITE_TAC[GE] THEN MATCH_MP_TAC(MESON[] `(!k g. V k g ==> N g) /\ (?k. M k /\ ?g. V k g) ==> ?g. N g /\ ?k. M k /\ V k g`) THEN CONJ_TAC THENL [MAP_EVERY X_GEN_TAC [`k:num->num`; `g:real^M->real^N`] THEN STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN EXISTS_TAC `(f:num->real^M->real^N) o (k:num->num)` THEN ASM_SIMP_TAC[EVENTUALLY_SEQUENTIALLY; o_THM; TRIVIAL_LIMIT_SEQUENTIALLY; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN EXISTS_TAC `0` THEN REWRITE_TAC[continuous_on; dist] THEN ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN MP_TAC(ISPECL [`IMAGE (f:num->real^M->real^N) (:num)`; `s:real^M->bool`] COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN ANTS_TAC THENL [REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`)] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; dist] THEN DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[NORM_SUB]) THEN REWRITE_TAC[GSYM dist; UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN X_CHOOSE_THEN `r:real^M->bool` STRIP_ASSUME_TAC (ISPEC `s:real^M->bool` SEPARABLE) THEN MP_TAC(ISPECL [`f:num->real^M->real^N`; `r:real^M->bool`; `M:real`] FUNCTION_CONVERGENT_SUBSEQUENCE) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num->num` THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^M. ball(x,d)) r`) THEN REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL] THEN ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure r:real^M->bool` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL]; DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC)] THEN REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `M:real^M->num` THEN DISCH_THEN(LABEL_TAC "*") THEN MP_TAC(ISPECL [`M:real^M->num`; `t:real^M->bool`] UPPER_BOUND_FINITE_SET) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:real^M`] THEN STRIP_TAC THEN UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^M. ball (x,d)) t)` THEN REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_BALL; LEFT_IMP_EXISTS_THM; dist] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(f (k(m:num)) y - f (k m) x) < e / &3 /\ norm(f (k n) y - f (k n) x) < e / &3 /\ norm(f (k m) y - f (k n) y) < e / &3 ==> norm(f (k m) x - f (k n) x :real^M) < e`) THEN ASM_SIMP_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_REWRITE_TAC[dist; GE] THEN ASM_MESON_TAC[SUBSET; LE_TRANS]);; (* ------------------------------------------------------------------------- *) (* Two forms of the Baire propery of dense sets. *) (* ------------------------------------------------------------------------- *) let BAIRE = prove (`!g s:real^N->bool. closed s /\ COUNTABLE g /\ (!t. t IN g ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t) ==> s SUBSET closure(INTERS g)`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; CLOSURE_UNIV; SUBSET_UNIV] THEN MP_TAC(ISPEC `g:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`COUNTABLE(g:(real^N->bool)->bool)`; `~(g:(real^N->bool)->bool = {})`] THEN DISCH_THEN(X_CHOOSE_THEN `g:num->real^N->bool` SUBST_ALL_TAC) THEN RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL; GSYM IN_INTER; MEMBER_NOT_EMPTY] THEN SUBGOAL_THEN `?t:num->real^N->bool. (!n. open_in (subtopology euclidean s) (t n) /\ ~(t n = {}) /\ s INTER closure(t n) SUBSET g n /\ closure(t n) SUBSET ball(x,e)) /\ (!n. t(SUC n) SUBSET t n)` STRIP_ASSUME_TAC THENL [SUBGOAL_THEN `!u n. open_in (subtopology euclidean s) u /\ ~(u = {}) /\ closure u SUBSET ball(x,e) ==> ?y. open_in (subtopology euclidean s) y /\ ~(y = {}) /\ s INTER closure y SUBSET (g:num->real^N->bool) n /\ closure y SUBSET ball(x,e) /\ y SUBSET u` ASSUME_TAC THENL [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `n:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `?y:real^N. y IN u /\ y IN g(n:num)` STRIP_ASSUME_TAC THENL [FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `open_in (subtopology euclidean s) (u INTER g(n:num):real^N->bool)` MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_INTER]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN ASM_REWRITE_TAC[IN_INTER] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s INTER ball(y:real^N,d / &2)` THEN SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b SUBSET u INTER g ==> !s. s SUBSET b ==> s SUBSET g`)) THEN MATCH_MP_TAC(SET_RULE `closure(s INTER b) SUBSET closure b /\ closure b SUBSET c ==> s INTER closure(s INTER b) SUBSET c INTER s`) THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN ASM_REAL_ARITH_TAC; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN MATCH_MP_TAC SUBSET_CLOSURE; ALL_TAC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE `b INTER s SUBSET u INTER g ==> c SUBSET b ==> s INTER c SUBSET u`)) THEN REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; MATCH_MP_TAC DEPENDENT_CHOICE THEN ASM_SIMP_TAC[GSYM CONJ_ASSOC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s INTER ball(x:real^N,e / &2)`; `0`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; GSYM MEMBER_NOT_EMPTY] THEN ANTS_TAC THENL [REWRITE_TAC[LEFT_AND_EXISTS_THM]; MESON_TAC[]] THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN ASM_REAL_ARITH_TAC]; MP_TAC(ISPEC `(\n. s INTER closure(t n)):num->real^N->bool` COMPACT_NEST) THEN ANTS_TAC THENL [REWRITE_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL [GEN_TAC THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE]; GEN_TAC THEN MATCH_MP_TAC(SET_RULE `~(t = {}) /\ t SUBSET s /\ t SUBSET closure t ==> ~(s INTER closure t = {})`) THEN ASM_MESON_TAC[CLOSURE_SUBSET; OPEN_IN_IMP_SUBSET]; MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[SUBSET_CLOSURE; SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN SET_TAC[]]; MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`) THEN REWRITE_TAC[SUBSET_INTER] THEN REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN ASM SET_TAC[]]]);; let BAIRE_ALT = prove (`!g s:real^N->bool. closed s /\ ~(s = {}) /\ COUNTABLE g /\ UNIONS g = s ==> ?t u. t IN g /\ open_in (subtopology euclidean s) u /\ u SUBSET (closure t)`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`IMAGE (\t:real^N->bool. s DIFF closure t) g`; `s:real^N->bool`] BAIRE) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN MATCH_MP_TAC(TAUT `~q /\ (~r ==> p) ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL [MATCH_MP_TAC(SET_RULE `~(s = {}) /\ (t = {} ==> closure t = {}) /\ t = {} ==> ~(s SUBSET closure t)`) THEN ASM_SIMP_TAC[CLOSURE_EMPTY] THEN MATCH_MP_TAC(SET_RULE `i SUBSET s /\ s DIFF i = s ==> i = {}`) THEN CONJ_TAC THENL [REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[DIFF_INTERS] THEN REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN REWRITE_TAC[SET_RULE `{s INTER closure t | t IN g} = {s INTER t | t IN IMAGE closure g}`] THEN SIMP_TAC[GSYM INTER_UNIONS; SET_RULE `s INTER t = s <=> s SUBSET t`] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[CLOSURE_SUBSET]; REWRITE_TAC[NOT_EXISTS_THM] THEN STRIP_TAC THEN X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE; OPEN_IN_REFL]; REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^N->bool`; `s INTER ball(x:real^N,e)`]) THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; SUBSET; IN_INTER; IN_BALL; IN_DIFF] THEN MESON_TAC[DIST_SYM]]]);; (* ------------------------------------------------------------------------- *) (* Several variants of paracompactness. *) (* ------------------------------------------------------------------------- *) let PARACOMPACT = prove (`!s c. (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c ==> ?c'. s SUBSET UNIONS c' /\ (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ (!x. x IN s ==> ?v. open v /\ x IN v /\ FINITE {u | u IN c' /\ ~(u INTER v = {})})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL [EXISTS_TAC `{}:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN s ==> ?t u. x IN u /\ open u /\ closure u SUBSET t /\ t IN c` MP_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN ASM_REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_CONTAINS_CBALL] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `ball(x:real^N,e)` THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; CLOSURE_BALL]; GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN MAP_EVERY X_GEN_TAC [`f:real^N->real^N->bool`; `e:real^N->real^N->bool`] THEN STRIP_TAC] THEN MP_TAC(ISPEC `IMAGE (e:real^N->real^N->bool) s` LINDELOF) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_CASES_TAC `k:real^N->bool = {}` THENL [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `k:real^N->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` SUBST_ALL_TAC) THEN STRIP_TAC THEN EXISTS_TAC `{ f(a n:real^N) DIFF UNIONS {closure(e(a m)):real^N->bool | m < n} | n IN (:num)}` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN REPEAT CONJ_TAC THENL [X_GEN_TAC `n:num` THEN CONJ_TAC THENL [MATCH_MP_TAC OPEN_DIFF THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC CLOSED_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; EXISTS_TAC `f((a:num->real^N) n):real^N->bool` THEN ASM SET_TAC[]]; REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN SUBGOAL_THEN `?n. x IN (f((a:num->real^N) n):real^N->bool)` MP_TAC THENL [RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `(a:num->real^N) n`) THEN ANTS_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]; GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `e((a:num->real^N) n):real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `{u | (?n. u = f n) /\ P u} = IMAGE f {n |n| P(f n) /\ n IN (:num)}`] THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `u SUBSET t ==> (s DIFF t) INTER u = {}`) THEN REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC] THEN ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]);; let PARACOMPACT_CLOSED_IN = prove (`!u:real^N->bool s c. closed_in (subtopology euclidean u) s /\ (!t:real^N->bool. t IN c ==> open_in (subtopology euclidean u) t) /\ s SUBSET UNIONS c ==> ?c'. s SUBSET UNIONS c' /\ (!v. v IN c' ==> open_in (subtopology euclidean u) v /\ ?t. t IN c /\ v SUBSET t) /\ (!x. x IN u ==> ?v. open_in (subtopology euclidean u) v /\ x IN v /\ FINITE {n | n IN c' /\ ~(n INTER v = {})})`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[OPEN_IN_OPEN] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `uu:(real^N->bool)->(real^N->bool)` THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN MP_TAC(ISPECL [`u:real^N->bool`; `((:real^N) DIFF k) INSERT IMAGE (uu:(real^N->bool)->(real^N->bool)) c`] PARACOMPACT) THEN ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE; UNIONS_INSERT; FORALL_IN_INSERT; EXISTS_IN_IMAGE; EXISTS_IN_INSERT; GSYM closed] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `{u INTER v:real^N->bool | v IN d /\ ~(v INTER k = {})}` THEN REPEAT CONJ_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `u INTER v:real^N->bool` THEN ASM_REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[SET_RULE `{y | y IN {f x | P x} /\ Q y} = IMAGE f {x | P x /\ Q(f x)}`] THEN MATCH_MP_TAC FINITE_IMAGE THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);; let PARACOMPACT_CLOSED = prove (`!s:real^N->bool c. closed s /\ (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c ==> ?c'. s SUBSET UNIONS c' /\ (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ (!x. ?v. open v /\ x IN v /\ FINITE {u | u IN c' /\ ~(u INTER v = {})})`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`; `c:(real^N->bool)->bool`] PARACOMPACT_CLOSED_IN) THEN ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Partitions of unity subordinate to locally finite open coverings. *) (* ------------------------------------------------------------------------- *) let SUBORDINATE_PARTITION_OF_UNITY = prove (`!c s. s SUBSET UNIONS c /\ (!u. u IN c ==> open u) /\ (!x. x IN s ==> ?v. open v /\ x IN v /\ FINITE {u | u IN c /\ ~(u INTER v = {})}) ==> ?f:(real^N->bool)->real^N->real. (!u. u IN c ==> (lift o f u) continuous_on s /\ !x. x IN s ==> &0 <= f u x) /\ (!x u. u IN c /\ x IN s /\ ~(x IN u) ==> f u x = &0) /\ (!x. x IN s ==> sum c (\u. f u x) = &1) /\ (!x. x IN s ==> ?n. open n /\ x IN n /\ FINITE {u | u IN c /\ ~(!x. x IN n ==> f u x = &0)})`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `?u:real^N->bool. u IN c /\ s SUBSET u` THENL [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN EXISTS_TAC `\v:real^N->bool x:real^N. if v = u then &1 else &0` THEN REWRITE_TAC[COND_RAND; COND_RATOR; o_DEF; REAL_POS; REAL_OF_NUM_EQ; ARITH_EQ; MESON[] `(if p then q else T) <=> p ==> q`] THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST; COND_ID; SUM_DELTA] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `ball(x:real^N,&1)` THEN REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{u:real^N->bool}` THEN REWRITE_TAC[FINITE_SING; SUBSET; IN_ELIM_THM; IN_SING] THEN X_GEN_TAC `v:real^N->bool` THEN ASM_CASES_TAC `v:real^N->bool = u` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN EXISTS_TAC `\u:real^N->bool x:real^N. if x IN s then setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)) else &0` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN SIMP_TAC[SUM_POS_LE; SETDIST_POS_LE; REAL_LE_DIV] THEN SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; real_div; REAL_MUL_LZERO] THEN REWRITE_TAC[SUM_RMUL] THEN REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN ASM_CASES_TAC `(u:real^N->bool) IN c` THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[real_div; REAL_ENTIRE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(y:real^N) IN u` THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; REAL_MUL_LZERO] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!v x:real^N. v IN c /\ x IN s /\ x IN v ==> &0 < setdist({x},s DIFF v)` ASSUME_TAC THENL [REPEAT STRIP_TAC THEN SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF v:real^N->bool`; `x:real^N`] SETDIST_EQ_0_CLOSED_IN) THEN ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; GSYM OPEN_CLOSED] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNION] THEN ASM SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:real^N. x IN s ==> &0 < sum c (\v. setdist ({x},s DIFF v))` ASSUME_TAC THENL [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[SETDIST_POS_LE] THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN ASM_CASES_TAC `(x:real^N) IN u` THEN ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF] THEN ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[REAL_LT_IMP_NZ]]; ALL_TAC] THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_REFL; o_DEF] THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\x:real^N. lift(setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)))` THEN SIMP_TAC[] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[CONTINUOUS_ON_LIFT_SETDIST; o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)) THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN MAP_EVERY EXISTS_TAC [`\x:real^N. lift(sum {v | v IN c /\ ~(v INTER n = {})} (\v. setdist({x},s DIFF v)))`; `s INTER n:real^N->bool`] THEN ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN MATCH_MP_TAC SETDIST_SING_IN_SET THEN ASM SET_TAC[]; ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN ASM_SIMP_TAC[CONTINUOUS_AT_LIFT_SETDIST; CONTINUOUS_AT_WITHIN]]);; hol-light/RichterHilbertAxiomGeometry/inverse_bug_puzzle_read.ml000066400000000000000000000476171303454263000256560ustar00rootroot00000000000000(* ========================================================================= *) (* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* Proof of the Bug Puzzle conjecture of the HOL Light tutorial: Any two *) (* triples of points in the plane with the same oriented area can be *) (* connected in 5 moves or less (FivemovesOrLess). Much of the code is *) (* due to John Harrison: a proof (NOTENOUGH_4) showing this is the best *) (* possible result; an early version of Noncollinear_2Span; the *) (* definition of move, which defines a closed subset *) (* {(A,B,C,A',B',C') | move (A,B,C) (A',B',C')} of R^6 x R^6, *) (* i.e. the zero set of a continuous function; FivemovesOrLess_STRONG, *) (* which handles the degenerate case (collinear or non-distinct triples), *) (* giving a satisfying answer using this "closed" definition of move. *) (* *) (* The mathematical proofs are essentially due to Tom Hales. *) (* ========================================================================= *) needs "Multivariate/determinants.ml";; needs "RichterHilbertAxiomGeometry/readable.ml";; new_type_abbrev("triple",`:real^2#real^2#real^2`);; let VEC2_TAC = SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; vector_add; vec; dot; orthogonal; basis; vector_neg; vector_sub; vector_mul; ARITH] THEN CONV_TAC REAL_RING;; let oriented_area = new_definition `oriented_area (a:real^2,b:real^2,c:real^2) = ((b$1 - a$1) * (c$2 - a$2) - (c$1 - a$1) * (b$2 - a$2)) / &2`;; let move = NewDefinition `; ∀A B C A' B' C':real^2. move (A,B,C) (A',B',C') ⇔ (B = B' ∧ C = C' ∧ collinear {vec 0,C - B,A' - A} ∨ A = A' ∧ C = C' ∧ collinear {vec 0,C - A,B' - B} ∨ A = A' ∧ B = B' ∧ collinear {vec 0,B - A,C' - C})`;; let reachable = NewDefinition `; ∀p p'. reachable p p' ⇔ ∃n. ∃s. s 0 = p ∧ s n = p' ∧ (∀m. 0 <= m ∧ m < n ⇒ move (s m) (s (SUC m)))`;; let reachableN = NewDefinition `; ∀p p'. ∀n. reachableN p p' n ⇔ ∃s. s 0 = p ∧ s n = p' ∧ (∀m. 0 <= m ∧ m < n ⇒ move (s m) (s (SUC m)))`;; let move2Cond = NewDefinition `; ∀ A B A' B':real^2. move2Cond A B A' B' ⇔ ¬collinear {B,A,A'} ∧ ¬collinear {A',B,B'} ∨ ¬collinear {A,B,B'} ∧ ¬collinear {B',A,A'}`;; let oriented_areaSymmetry = theorem `; oriented_area (A,B,C) = oriented_area(A',B',C') ⇒ oriented_area (B,C,A) = oriented_area (B',C',A') ∧ oriented_area (C,A,B) = oriented_area (C',A',B') ∧ oriented_area (A,C,B) = oriented_area (A',C',B') ∧ oriented_area (B,A,C) = oriented_area (B',A',C') ∧ oriented_area (C,B,A) = oriented_area (C',B',A') proof rewrite oriented_area; VEC2_TAC; qed; `;; let COLLINEAR_3_2Dzero = theorem `; ∀y z:real^2. collinear{vec 0,y,z} ⇔ z$1 * y$2 = y$1 * z$2 proof rewrite COLLINEAR_3_2D; VEC2_TAC; qed; `;; let Noncollinear_3ImpliesDistinct = theorem `; ¬collinear {a,b,c} ⇒ ¬(a = b) ∧ ¬(a = c) ∧ ¬(b = c) by fol COLLINEAR_BETWEEN_CASES BETWEEN_REFL`;; let collinearSymmetry = theorem `; collinear {A,B,C} ⇒ collinear {A,C,B} ∧ collinear {B,A,C} ∧ collinear {B,C,A} ∧ collinear {C,A,B} ∧ collinear {C,B,A} proof {A,C,B} ⊂ {A,B,C} ∧ {B,A,C} ⊂ {A,B,C} ∧ {B,C,A} ⊂ {A,B,C} ∧ {C,A,B} ⊂ {A,B,C} ∧ {C,B,A} ⊂ {A,B,C} [] by set; fol - COLLINEAR_SUBSET; qed; `;; let Noncollinear_2Span = theorem `; ∀u v w:real^2. ¬collinear {vec 0,v,w} ⇒ ∃ s t. s % v + t % w = u proof intro_TAC ∀u v w, H1; ¬(v$1 * w$2 - w$1 * v$2 = &0) [H1'] by fol H1 COLLINEAR_3_2Dzero REAL_SUB_0; consider M such that M = transp(vector[v;w]):real^2^2 [Mexists] by fol -; ¬(det M = &0) ∧ (∀ x. (M ** x)$1 = v$1 * x$1 + w$1 * x$2 ∧ (M ** x)$2 = v$2 * x$1 + w$2 * x$2) [MatMult] by simplify H1' Mexists matrix_vector_mul DIMINDEX_2 SUM_2 TRANSP_COMPONENT VECTOR_2 LAMBDA_BETA ARITH CART_EQ FORALL_2 DET_2; ∀ r n. ¬(r < n) ∧ r <= MIN n n ⇒ r = n [] by arithmetic; consider x such that M ** x = u [xDef] by fol MatMult - DET_EQ_0_RANK RANK_BOUND MATRIX_FULL_LINEAR_EQUATIONS; exists_TAC x$1; exists_TAC x$2; x$1 * v$1 + x$2 * w$1 = u$1 ∧ x$1 * v$2 + x$2 * w$2 = u$2 [xDef] by fol MatMult xDef REAL_MUL_SYM; simplify - CART_EQ LAMBDA_BETA FORALL_2 SUM_2 DIMINDEX_2 VECTOR_2 vector_add vector_mul ARITH; qed; `;; let moveInvariant = theorem `; ∀p p'. move p p' ⇒ oriented_area p = oriented_area p' proof rewrite FORALL_PAIR_THM move oriented_area COLLINEAR_LEMMA vector_mul; VEC2_TAC; qed; `;; let ReachLemma = theorem `; ∀p p'. reachable p p' ⇔ ∃n. reachableN p p' n proof rewrite reachable reachableN; qed; `;; let reachableN_CLAUSES = theorem `; ∀ p p'. (reachableN p p' 0 ⇔ p = p') ∧ ∀ n. reachableN p p' (SUC n) ⇔ ∃ q. reachableN p q n ∧ move q p' proof intro_TAC ∀p p'; consider s0 such that s0 = λm:num. p:triple [s0exists] by fol; reachableN p p' 0 ⇔ p = p' [0CLAUSE] by fol s0exists LE_0 reachableN LT; ∀ n. reachableN p p' (SUC n) ⇒ ∃ q. reachableN p q n ∧ move q p' [Imp1] proof intro_TAC ∀n, H1; consider s such that s 0 = p ∧ s (SUC n) = p' ∧ ∀m. m < SUC n ⇒ move (s m) (s (SUC m)) [sDef] by fol H1 LE_0 reachableN; consider q such that q = s n [qDef] by fol; fol sDef qDef LE_0 reachableN LT; qed; ∀n. (∃ q. reachableN p q n ∧ move q p') ⇒ reachableN p p' (SUC n) [Imp2] proof intro_TAC ∀n; rewrite IMP_CONJ LEFT_IMP_EXISTS_THM; intro_TAC ∀q, nReach, move_qp'; consider s such that s 0 = p ∧ s n = q ∧ ∀m. m < n ⇒ move (s m) (s (SUC m)) [sDef] by fol nReach reachableN LT LE_0; rewrite reachableN LT LE_0; exists_TAC λm. if m < SUC n then s m else p'; fol sDef move_qp' LT_0 LT_REFL LT LT_SUC; qed; fol 0CLAUSE Imp1 Imp2; qed; `;; let reachableInvariant = theorem `; ∀p p'. reachable p p' ⇒ oriented_area p = oriented_area p' proof simplify ReachLemma LEFT_IMP_EXISTS_THM SWAP_FORALL_THM; MATCH_MP_TAC num_INDUCTION; simplify reachableN_CLAUSES; intro_TAC ∀n, nStep; fol nStep moveInvariant; qed; `;; let reachableN_One = theorem `; reachableN P0 P1 1 ⇔ move P0 P1 by fol ONE reachableN reachableN_CLAUSES`;; let reachableN_Two = theorem `; reachableN P0 P2 2 ⇔ ∃P1. move P0 P1 ∧ move P1 P2 by fol TWO reachableN_One reachableN_CLAUSES`;; let reachableN_Three = theorem `; reachableN P0 P3 3 ⇔ ∃P1 P2. move P0 P1 ∧ move P1 P2 ∧ move P2 P3 by fol ARITH_RULE [3 = SUC 2] reachableN_Two reachableN_CLAUSES`;; let reachableN_Four = theorem `; reachableN P0 P4 4 ⇔ ∃P1 P2 P3. move P0 P1 ∧ move P1 P2 ∧ move P2 P3 ∧ move P3 P4 by fol ARITH_RULE [4 = SUC 3] reachableN_Three reachableN_CLAUSES`;; let reachableN_Five = theorem `; reachableN P0 P5 5 ⇔ ∃P1 P2 P3 P4. move P0 P1 ∧ move P1 P2 ∧ move P2 P3 ∧ move P3 P4 ∧ move P4 P5 proof rewrite ARITH_RULE [5 = SUC 4] reachableN_CLAUSES; fol reachableN_Four; qed; `;; let moveSymmetry = theorem `; move (A,B,C) (A',B',C') ⇒ move (B,C,A) (B',C',A') ∧ move (C,A,B) (C',A',B') ∧ move (A,C,B) (A',C',B') ∧ move (B,A,C) (B',A',C') ∧ move (C,B,A) (C',B',A') proof ∀X Y Z X':real^2. collinear {vec 0, Z - Y, X' - X} ⇒ collinear {vec 0, Y - Z, X' - X} [] proof rewrite COLLINEAR_3_2Dzero; VEC2_TAC; qed; MP_TAC -; rewrite move; ∀X Y Z X':real^2. collinear {vec 0, Z - Y, X' - X} ⇒ collinear {vec 0, Y - Z, X' - X} [] proof rewrite COLLINEAR_3_2Dzero; VEC2_TAC; qed; MP_TAC -; rewrite move; fol; qed; `;; let reachableNSymmetry = theorem `; ∀ n. ∀ A B C A' B' C'. reachableN (A,B,C) (A',B',C') n ⇒ reachableN (B,C,A) (B',C',A') n ∧ reachableN (C,A,B) (C',A',B') n ∧ reachableN (A,C,B) (A',C',B') n ∧ reachableN (B,A,C) (B',A',C') n ∧ reachableN (C,B,A) (C',B',A') n proof MATCH_MP_TAC num_INDUCTION; rewrite reachableN_CLAUSES; simplify PAIR_EQ; intro_TAC ∀n, nStep, ∀A B C A' B' C'; rewrite LEFT_IMP_EXISTS_THM FORALL_PAIR_THM; intro_TAC ∀[X] [Y] [Z], XYZexists; rewrite RIGHT_AND_EXISTS_THM LEFT_AND_EXISTS_THM; exists_TAC (Y,Z,X); exists_TAC (Z,X,Y); exists_TAC (X,Z,Y); exists_TAC (Y,X,Z); exists_TAC (Z,Y,X); simplify nStep XYZexists moveSymmetry; qed; `;; let ORIENTED_AREA_COLLINEAR_CONG = theorem `; ∀ A B C A' B' C. oriented_area (A,B,C) = oriented_area (A',B',C') ⇒ (collinear {A,B,C} ⇔ collinear {A',B',C'}) proof rewrite COLLINEAR_3_2D oriented_area; real_ring; qed; `;; let Basic2move_THM = theorem `; ∀ A B C A'. ¬collinear {A,B,C} ∧ ¬collinear {B,A,A'} ⇒ ∃X. move (A,B,C) (A,B,X) ∧ move (A,B,X) (A',B,X) proof intro_TAC ∀A B C A', H1 H2; ∀r. r % (A - B) = (--r) % (B - A) ∧ r % (A - B) = r % (A - B) + &0 % (C - B) [add0vector_mul] by VEC2_TAC; ¬ ∃ r. A' - A = r % (A - B) [H2'] by fol - H2 COLLINEAR_3 COLLINEAR_LEMMA; consider r t such that A' - A = r % (A - B) + t % (C - B) [rExists] by fol - H1 COLLINEAR_3 Noncollinear_2Span; ¬(t = &0) [tNonzero] by fol - add0vector_mul H2'; consider s X such that s = r / t ∧ X = C + s % (A - B) [Xexists] by fol rExists; A' - A = (t * s) % (A - B) + t % (C - B) [] by fol - rExists tNonzero REAL_DIV_LMUL; A' - A = t % (X - B) ∧ X - C = (-- s) % (B - A) [] proof rewrite - Xexists; VEC2_TAC; qed; collinear {vec 0,B - A,X - C} ∧ collinear {vec 0,X - B,A' - A} [] by fol - COLLINEAR_LEMMA; fol - move; qed; `;; let FourStepMoveAB = theorem `; ∀A B C A' B'. ¬collinear {A,B,C} ⇒ ¬collinear {B,A,A'} ∧ ¬collinear {A',B,B'} ⇒ ∃ X Y. move (A,B,C) (A,B,X) ∧ move (A,B,X) (A',B,X) ∧ move (A',B,X) (A',B,Y) ∧ move (A',B,Y) (A',B',Y) proof intro_TAC ∀A B C A' B', H1, H2; consider X such that move (A,B,C) (A,B,X) ∧ move (A,B,X) (A',B,X) [ABX] by fol H1 H2 Basic2move_THM; ¬collinear {A,B,X} ∧ ¬collinear {A',B,X} [] by fol - H1 moveInvariant ORIENTED_AREA_COLLINEAR_CONG; ¬collinear {B,A',X} [] by fol - collinearSymmetry; consider Y such that move (B,A',X) (B,A',Y) ∧ move (B,A',Y) (B',A',Y) [BA'Y] by fol - H2 Basic2move_THM; move (A',B,X) (A',B,Y) ∧ move (A',B,Y) (A',B',Y) [] by fol - BA'Y moveSymmetry; fol - ABX; qed; `;; let FourStepMoveABBAreach = theorem `; ∀A B C A' B'. ¬collinear {A,B,C} ∧ move2Cond A B A' B' ⇒ ∃ Y. reachableN (A,B,C) (A',B',Y) 4 proof intro_TAC ∀A B C A' B', H1 H2; case_split Case1 | Case2 by fol - H2 move2Cond; suppose ¬collinear {B,A,A'} ∧ ¬collinear {A',B,B'}; fol - H1 FourStepMoveAB reachableN_Four; end; suppose ¬collinear {A,B,B'} ∧ ¬collinear {B',A,A'}; ¬collinear {B,A,C} [] by fol H1 collinearSymmetry; consider X Y such that move (B,A,C) (B,A,X) ∧ move (B,A,X) (B',A,X) ∧ move (B',A,X) (B',A,Y) ∧ move (B',A,Y) (B',A',Y) [BAX] by fol Case2 - FourStepMoveAB; fol - moveSymmetry reachableN_Four; end; qed; `;; let NotMove2ImpliesCollinear = theorem `; ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ∧ ¬(A = A') ∧ ¬(B = B') ∧ ¬move2Cond A B A' B' ⇒ collinear {A,B,A',B'} proof intro_TAC ∀A B C A' B' C', H1 H1' H2 H2' H3; ¬(A = B) ∧ ¬(A' = B') [Distinct] by fol H1 H1' Noncollinear_3ImpliesDistinct; {A,B,A',B'} ⊂ {A,A',B,B'} ∧ {A,B,A',B'} ⊂ {B,B',A',A} ∧ {A,B,A',B'} ⊂ {A',B',B,A} [set4symmetry] by SET_TAC; case_split Case1 | Case2 | Case3 | Case4 by fol H3 move2Cond; suppose collinear {B,A,A'} ∧ collinear {A,B,B'}; fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; end; suppose collinear {B,A,A'} ∧ collinear {B',A,A'}; fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; end; suppose collinear {A',B,B'} ∧ collinear {A,B,B'}; fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; end; suppose collinear {A',B,B'} ∧ collinear {B',A,A'}; fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; end; qed; `;; let NotMove2ImpliesCollinear = theorem `; ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ∧ ¬(A = A') ∧ ¬(B = B') ∧ ¬move2Cond A B A' B' ⇒ collinear {A,B,A',B'} proof intro_TAC ∀A B C A' B' C', H1 H1' H2 H2' H3; ¬(A = B) ∧ ¬(A' = B') [Distinct] by fol H1 H1' Noncollinear_3ImpliesDistinct; {A,B,A',B'} ⊂ {A,A',B,B'} ∧ {A,B,A',B'} ⊂ {B,B',A',A} ∧ {A,B,A',B'} ⊂ {A',B',B,A} [set4symmetry] by SET_TAC; collinear {B,A,A'} ∧ collinear {A,B,B'} ∨ collinear {B,A,A'} ∧ collinear {B',A,A'} ∨ collinear {A',B,B'} ∧ collinear {A,B,B'} ∨ collinear {A',B,B'} ∧ collinear {B',A,A'} [] by fol H3 move2Cond; fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; qed; `;; let DistinctImplies2moveable = theorem `; ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ∧ ¬(A = A') ∧ ¬(B = B') ∧ ¬(C = C') ⇒ move2Cond A B A' B' ∨ move2Cond B C B' C' proof intro_TAC ∀A B C A' B' C', H1 H1' H2a H2b H2c; {A,B,B'} ⊂ {A,B,A',B'} ∧ {B,B',C} ⊂ {B,C,B',C'} [3subset4] by SET_TAC; assume ¬move2Cond A B A' B' ∧ ¬move2Cond B C B' C' [Con] by fol; collinear {A,B,A',B'} ∧ collinear {B,C,B',C'} [] by fol - H1 H1' H2a H2b H2c collinearSymmetry NotMove2ImpliesCollinear; collinear {A,B,C} [] by fol - 3subset4 H2a H2b H2c COLLINEAR_SUBSET COLLINEAR_3_TRANS; fol - H1 H1'; qed; `;; let SameCdiffAB = theorem `; ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ⇒ C = C' ∧ ¬(A = A') ∧ ¬(B = B') ⇒ ∃ Y. reachableN (A,B,C) (Y,B',C') 2 ∨ reachableN (A,B,C) (A',B',Y) 4 proof intro_TAC ∀A B C A' B' C', H1, H2; {B,B',A} ⊂ {A,B,A',B'} ∧ {A,B,C} ⊂ {B,B',A,C} [easy_set] by SET_TAC; case_split Ncol | move | col_Nmove by fol; suppose ¬collinear {C,B,B'}; consider X such that move (B,C,A) (B,C,X) ∧ move (B,C,X) (B',C',X) [BCX] by fol - easy_set H1 H2 collinearSymmetry Basic2move_THM; fol BCX reachableN_Two reachableNSymmetry; end; suppose move2Cond A B A' B'; fol - H1 FourStepMoveABBAreach; end; suppose collinear {C,B,B'} ∧ ¬move2Cond A B A' B'; collinear {B,B',A} ∧ collinear {B,B',C} [] by fol - H1 H2 easy_set NotMove2ImpliesCollinear COLLINEAR_SUBSET collinearSymmetry; fol - H2 easy_set H1 COLLINEAR_4_3 COLLINEAR_SUBSET; end; qed; `;; let FourMovesToCorrectTwo = theorem `; ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ⇒ ∃ n. n < 5 ∧ ∃ Y. reachableN (A,B,C) (A',B',Y) n ∨ reachableN (A,B,C) (A',Y,C') n ∨ reachableN (A,B,C) (Y,B',C') n proof intro_TAC ∀A B C A' B' C', H1; ¬collinear {B,C,A} ∧ ¬collinear{B',C',A'} ∧ ¬collinear {C,A,B} ∧ ¬collinear {C',A',B'} [H1'] by fol H1 collinearSymmetry; 0 < 5 ∧ 2 < 5 ∧ 3 < 5 ∧ 4 < 5 [easy_arith] by ARITH_TAC; case_split case01 | case2 | case3 by fol; suppose A = A' ∧ B = B' ∧ C = C' ∨ A = A' ∧ B = B' ∧ ¬(C = C') ∨ A = A' ∧ ¬(B = B') ∧ C = C' ∨ ¬(A = A') ∧ B = B' ∧ C = C'; fol - easy_arith reachableN_CLAUSES; end; suppose A = A' ∧ ¬(B = B') ∧ ¬(C = C') ∨ ¬(A = A') ∧ B = B' ∧ ¬(C = C') ∨ ¬(A = A') ∧ ¬(B = B') ∧ C = C'; fol - H1 H1' easy_arith SameCdiffAB reachableNSymmetry; end; suppose ¬(A = A') ∧ ¬(B = B') ∧ ¬(C = C'); exists_TAC 4; simplify easy_arith reachableN_CLAUSES; fol - H1 H1' DistinctImplies2moveable FourStepMoveABBAreach reachableNSymmetry reachableN_Four; end; qed; `;; let CorrectFinalPoint = theorem `; oriented_area (A,B,C) = oriented_area (A,B,C') ⇒ move (A,B,C) (A,B,C') proof rewrite move oriented_area COLLINEAR_3_2Dzero; VEC2_TAC; qed; `;; let FiveMovesOrLess = theorem `; ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ oriented_area (A,B,C) = oriented_area (A',B',C') ⇒ ∃ n. n <= 5 ∧ reachableN (A,B,C) (A',B',C') n proof intro_TAC ∀A B C A' B' C', H1 H2; ¬collinear {A',B',C'} [H1'] by fol H1 H2 ORIENTED_AREA_COLLINEAR_CONG; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(A' = C') ∧ ¬(B' = C') [Distinct] by fol - H1 Noncollinear_3ImpliesDistinct; consider n Y such that n < 5 ∧ (reachableN (A,B,C) (A',B',Y) n ∨ reachableN (A,B,C) (A',Y,C') n ∨ reachableN (A,B,C) (Y,B',C') n) [2Correct] by fol H1 H1' FourMovesToCorrectTwo; case_split A'B'Y | A'YC' | YB'C' by fol 2Correct; suppose reachableN (A,B,C) (A',B',Y) n; oriented_area (A',B',Y) = oriented_area (A',B',C') [] by fol - H2 ReachLemma reachableInvariant; move (A',B',Y) (A',B',C') [] by fol - Distinct CorrectFinalPoint; fol A'B'Y - 2Correct reachableN_CLAUSES LE_SUC_LT; end; suppose reachableN (A,B,C) (A',Y,C') n; oriented_area (A',C',Y) = oriented_area (A',C',B') [] by fol H2 - ReachLemma reachableInvariant oriented_areaSymmetry; move (A',Y,C') (A',B',C') [] by fol - Distinct CorrectFinalPoint moveSymmetry; fol A'YC' - 2Correct reachableN_CLAUSES LE_SUC_LT; end; suppose reachableN (A,B,C) (Y,B',C') n; oriented_area (B',C',Y) = oriented_area (B',C',A') [] by fol H2 - ReachLemma reachableInvariant oriented_areaSymmetry; move (Y,B',C') (A',B',C') [] by fol - Distinct CorrectFinalPoint moveSymmetry; fol YB'C' - 2Correct reachableN_CLAUSES LE_SUC_LT; end; qed; `;; let NOTENOUGH_4 = theorem `; ∃p0 p4. oriented_area p0 = oriented_area p4 ∧ ¬reachableN p0 p4 4 proof consider p0 p4 such that p0:triple = vector [&0;&0],vector [&0;&1],vector [&1;&0] ∧ p4:triple = vector [&1;&1],vector [&1;&2],vector [&2;&1] [p04Def] by fol; oriented_area p0 = oriented_area p4 [equal_areas] proof rewrite - oriented_area; VEC2_TAC; qed; ¬reachableN p0 p4 4 [] proof rewrite p04Def reachableN_Four NOT_EXISTS_THM FORALL_PAIR_THM move COLLINEAR_3_2Dzero FORALL_VECTOR_2; VEC2_TAC; qed; fol - equal_areas; qed; `;; let FiveMovesOrLess_STRONG = theorem `; ∀A B C A' B' C'. oriented_area (A,B,C) = oriented_area (A',B',C') ⇒ ∃n. n <= 5 ∧ reachableN (A,B,C) (A',B',C') n proof intro_TAC ∀A B C A' B' C', H1; (∀X Y:real^2. collinear {X,Y,Y}) ∧ (∀A B A'. move (A,B,B) (A',B,B)) ∧ ∀A B C B'. (collinear {A,B,C} ∧ collinear {A,B',C} ⇒ move (A,B,C) (A,B',C)) [EZcollinear] proof rewrite move COLLINEAR_3_2D; VEC2_TAC; qed; case_split ABCncol | ABCcol by fol ; suppose ¬collinear {A,B,C}; fol - H1 FiveMovesOrLess; end; suppose collinear {A,B,C}; collinear {A',B',C'} [A'B'C'col] by fol - H1 ORIENTED_AREA_COLLINEAR_CONG; consider P1 P2 P3 P4 such that P1 = A,C,C ∧ P2 = B',C,C ∧ P3 = B',B',C ∧ P4 = B',B',C' [P1234exist] by fol; move (A,B,C) P1 ∧ move P1 P2 ∧ move P2 P3 ∧ move P3 P4 ∧ move P4 (A',B',C') [] by fol ABCcol A'B'C'col EZcollinear P1234exist collinearSymmetry moveSymmetry; fol - reachableN_Five LE_REFL; end; qed; `;; hol-light/RichterHilbertAxiomGeometry/miz3/000077500000000000000000000000001303454263000212535ustar00rootroot00000000000000hol-light/RichterHilbertAxiomGeometry/miz3/FontHilbertAxiom.ml000066400000000000000000005214001303454263000250250ustar00rootroot00000000000000(* ----------------------------------------------------------------- *) (* HOL Light Hilbert geometry axiomatic proofs using miz3. *) (* ----------------------------------------------------------------- *) (* High school students can learn rigorous axiomatic Geometry proofs, as in http://www.math.northwestern.edu/~richter/hilbert.pdf, using Hilbert's axioms, and code up their proofs in miz3 and HOL Light. Thanks to Bjørn Jahren, Miguel Lerma,Takuo Matsuoka, Stephen Wilson for advice on Hilbert's axioms, and especially Benjamin Kordesh, who carefully read much of the paper and the code. Formal proofs are given for the first 7 sections of the paper, the results cited there from Greenberg's book, and most of Euclid's book I propositions up to Proposition I.29, following Hartshorne, whose book seems the most exciting axiomatic geometry text. A proof assistant is an valuable tool to help read it, as Hartshorne's proofs are often sketchy and even have gaps. M. Greenberg, Euclidean and non-Euclidean geometries, W. H. Freeman and Co., 1974. R. Hartshorne, Geometry, Euclid and Beyond, Undergraduate Texts in Math., Springer, 2000. Thanks to Mizar folks for their influential language, Freek Wiedijk, who wrote the miz3 port of Mizar to HOL Light, and especially John Harrison, who was extremely helpful and developed the framework for porting my axiomatic proofs to HOL Light. *) verbose := false;; report_timing := false;; horizon := 0;; timeout := 50;; new_type("point",0);; new_type_abbrev("point_set",`:point->bool`);; new_constant("Between",`:point->point->point->bool`);; new_constant("Line",`:point_set->bool`);; new_constant("≡",`:(point->bool)->(point->bool)->bool`);; parse_as_infix("≅",(12, "right"));; parse_as_infix("same_side",(12, "right"));; parse_as_infix("≡",(12, "right"));; parse_as_infix("<__",(12, "right"));; parse_as_infix("<_ang",(12, "right"));; parse_as_infix("suppl",(12, "right"));; parse_as_infix("∉",(11, "right"));; parse_as_infix("∥",(12, "right"));; let ∉ = new_definition `∀a:A l:A->bool. a ∉ l ⇔ ¬(a ∈ l)`;; let Interval_DEF = new_definition `∀ A B. open (A,B) = {X | Between A X B}`;; let Collinear_DEF = new_definition `Collinear A B C ⇔ ∃ l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l`;; let SameSide_DEF = new_definition `A,B same_side l ⇔ Line l ∧ ¬ ∃ X. (X ∈ l) ∧ X ∈ open (A,B)`;; let Ray_DEF = new_definition `∀ A B. ray A B = {X | ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B)}`;; let Ordered_DEF = new_definition `ordered A B C D ⇔ B ∈ open (A,C) ∧ B ∈ open (A,D) ∧ C ∈ open (A,D) ∧ C ∈ open (B,D)`;; let InteriorAngle_DEF = new_definition `∀ A O B. int_angle A O B = {P:point | ¬Collinear A O B ∧ ∃ a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b}`;; let InteriorTriangle_DEF = new_definition `∀ A B C. int_triangle A B C = {P | P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B}`;; let Tetralateral_DEF = new_definition `Tetralateral A B C D ⇔ ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B`;; let Quadrilateral_DEF = new_definition `Quadrilateral A B C D ⇔ Tetralateral A B C D ∧ open (A,B) ∩ open (C,D) = ∅ ∧ open (B,C) ∩ open (D,A) = ∅ `;; let ConvexQuad_DEF = new_definition `ConvexQuadrilateral A B C D ⇔ Quadrilateral A B C D ∧ A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C `;; let Segment_DEF = new_definition `seg A B = {A, B} UNION open (A,B)`;; let SEGMENT = new_definition `Segment s ⇔ ∃ A B. s = seg A B ∧ ¬(A = B)`;; let SegmentOrdering_DEF = new_definition `s <__ t ⇔ Segment s ∧ ∃ C D X. t = seg C D ∧ X ∈ open (C,D) ∧ s ≡ seg C X`;; let Angle_DEF = new_definition ` ∡ A O B = ray O A UNION ray O B `;; let ANGLE = new_definition `Angle α ⇔ ∃ A O B. α = ∡ A O B ∧ ¬Collinear A O B`;; let AngleOrdering_DEF = new_definition `α <_ang β ⇔ Angle α ∧ ∃ A O B G. ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G`;; let RAY = new_definition `Ray r ⇔ ∃ O A. ¬(O = A) ∧ r = ray O A`;; let TriangleCong_DEF = new_definition `∀ A B C A' B' C' :point. (A, B, C) ≅ (A', B', C') ⇔ ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B'`;; let SupplementaryAngles_DEF = new_definition `∀ α β. α suppl β ⇔ ∃ A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A'`;; let RightAngle_DEF = new_definition `∀ α. Right α ⇔ ∃ β. α suppl β ∧ α ≡ β`;; let PlaneComplement_DEF = new_definition `∀ α:point_set. complement α = {P | P ∉ α}`;; let CONVEX = new_definition `Convex α ⇔ ∀ A B. A ∈ α ∧ B ∈ α ⇒ open (A,B) ⊂ α`;; let PARALLEL = new_definition `∀ l k. l ∥ k ⇔ Line l ∧ Line k ∧ l ∩ k = ∅`;; let Parallelogram_DEF = new_definition `∀ A B C D. Parallelogram A B C D ⇔ Quadrilateral A B C D ∧ ∃ a b c d. Line a ∧ A ∈ a ∧ B ∈ a ∧ Line b ∧ B ∈ b ∧ C ∈ b ∧ Line c ∧ C ∈ c ∧ D ∈ d ∧ Line d ∧ D ∈ d ∧ A ∈ d ∧ a ∥ c ∧ b ∥ d`;; let InteriorCircle_DEF = new_definition `∀ O R. int_circle O R = {P | ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R)} `;; (* ---------------------------------------------------------------------------- *) (* Hilbert's geometry axioms, except the parallel axiom P, defined near the end. *) (* ---------------------------------------------------------------------------- *) let I1 = new_axiom `∀ A B. ¬(A = B) ⇒ ∃! l. Line l ∧ A ∈ l ∧ B ∈ l`;; let I2 = new_axiom `∀ l. Line l ⇒ ∃ A B. A ∈ l ∧ B ∈ l ∧ ¬(A = B)`;; let I3 = new_axiom `∃ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C`;; let B1 = new_axiom `∀ A B C. Between A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Between C B A ∧ Collinear A B C`;; let B2 = new_axiom `∀ A B. ¬(A = B) ⇒ ∃ C. Between A B C`;; let B3 = new_axiom `∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (Between A B C ∨ Between B C A ∨ Between C A B) ∧ ¬(Between A B C ∧ Between B C A) ∧ ¬(Between A B C ∧ Between C A B) ∧ ¬(Between B C A ∧ Between C A B)`;; let B4 = new_axiom `∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ Between A X C) ⇒ (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C)`;; let C1 = new_axiom `∀ s O Z. Segment s ∧ ¬(O = Z) ⇒ ∃! P. P ∈ ray O Z â” O ∧ seg O P ≡ s`;; let C2Reflexive = new_axiom `Segment s ⇒ s ≡ s`;; let C2Symmetric = new_axiom `Segment s ∧ Segment t ∧ s ≡ t ⇒ t ≡ s`;; let C2Transitive = new_axiom `Segment s ∧ Segment t ∧ Segment u ∧ s ≡ t ∧ t ≡ u ⇒ s ≡ u`;; let C3 = new_axiom `∀ A B C A' B' C'. B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ seg A B ≡ seg A' B' ∧ seg B C ≡ seg B' C' ⇒ seg A C ≡ seg A' C'`;; let C4 = new_axiom `∀ α O A l Y. Angle α ∧ ¬(O = A) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ ∃! r. Ray r ∧ ∃ B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α`;; let C5Reflexive = new_axiom `Angle α ⇒ α ≡ α`;; let C5Symmetric = new_axiom `Angle α ∧ Angle β ∧ α ≡ β ⇒ β ≡ α`;; let C5Transitive = new_axiom `Angle α ∧ Angle β ∧ Angle γ ∧ α ≡ β ∧ β ≡ γ ⇒ α ≡ γ`;; let C6 = new_axiom `∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ⇒ ∡ B C A ≡ ∡ B' C' A'`;; (* ----------------------------------------------------------------- *) (* Theorems. *) (* ----------------------------------------------------------------- *) let IN_Interval = thm `; ∀ A B X. X ∈ open (A,B) ⇔ Between A X B by Interval_DEF, SET_RULE; `;; let IN_Ray = thm `; ∀ A B X. X ∈ ray A B ⇔ ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B) by Ray_DEF, SET_RULE; `;; let IN_InteriorAngle = thm `; ∀ A O B P. P ∈ int_angle A O B ⇔ ¬Collinear A O B ∧ ∃ a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b by InteriorAngle_DEF, SET_RULE; `;; let IN_InteriorTriangle = thm `; ∀ A B C P. P ∈ int_triangle A B C ⇔ P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B by InteriorTriangle_DEF, SET_RULE; `;; let IN_PlaneComplement = thm `; ∀ α:point_set. ∀ P. P ∈ complement α ⇔ P ∉ α by PlaneComplement_DEF, SET_RULE; `;; let IN_InteriorCircle = thm `; ∀ O R P. P ∈ int_circle O R ⇔ ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R) by InteriorCircle_DEF, SET_RULE; `;; let B1' = thm `; ∀ A B C. B ∈ open (A,C) ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ open (C,A) ∧ Collinear A B C by IN_Interval, B1; `;; let B2' = thm `; ∀ A B. ¬(A = B) ⇒ ∃ C. B ∈ open (A,C) by IN_Interval, B2; `;; let B3' = thm `; ∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B)) ∧ ¬(B ∈ open (A,C) ∧ C ∈ open (B,A)) ∧ ¬(B ∈ open (A,C) ∧ A ∈ open (C,B)) ∧ ¬(C ∈ open (B,A) ∧ A ∈ open (C,B)) by IN_Interval, B3; `;; let B4' = thm `; ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ X ∈ open (A,C)) ⇒ (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) by IN_Interval, B4; `;; let B4'' = thm `; ∀ l:point_set. ∀ A B C:point. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l by B4', SameSide_DEF; `;; let DisjointOneNotOther = thm `; ∀ l m:A->bool. (∀ x:A. x ∈ m ⇒ x ∉ l) ⇔ l ∩ m = ∅ by SET_RULE, ∉; `;; let EquivIntersectionHelp = thm `; ∀ e x:A. ∀ l m:A->bool. (l ∩ m = {x} ∨ m ∩ l = {x}) ∧ e ∈ m â” x ⇒ e ∉ l by SET_RULE, ∉; `;; let CollinearSymmetry = thm `; let A B C be point; assume Collinear A B C [H1]; thus Collinear A C B ∧ Collinear B A C ∧ Collinear B C A ∧ Collinear C A B ∧ Collinear C B A proof consider l such that Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l by H1, Collinear_DEF; qed by -, Collinear_DEF; `;; let ExistsNewPointOnLine = thm `; let P be point; let l be point_set; assume Line l ∧ P ∈ l [H1]; thus ∃ Q. Q ∈ l ∧ ¬(P = Q) proof consider A B such that A ∈ l ∧ B ∈ l ∧ ¬(A = B) [l_line] by H1, I2; cases; suppose P = A; qed by -, l_line; suppose ¬(P = A); qed by -, l_line; end; `;; let ExistsPointOffLine = thm `; let l be point_set; assume Line l [H1]; thus ∃ Q:point. Q ∉ l proof consider A B C such that ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C [Distinct] by I3; (A ∉ l ∨ B ∉ l ∨ C ∉ l) ∨ (A ∈ l ∧ B ∈ l ∧ C ∈ l) by ∉; cases by -; suppose A ∉ l ∨ B ∉ l ∨ C ∉ l; qed by -; suppose (A ∈ l) ∧ (B ∈ l) ∧ (C ∈ l); Collinear A B C by H1, -, Collinear_DEF; qed by -, Distinct; end; `;; let BetweenLinear = thm `; let A B C be point; let m be point_set; assume Line m ∧ A ∈ m ∧ C ∈ m [H1]; assume B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B) [H2]; thus B ∈ m proof ¬(A = C) ∧ (Collinear A B C ∨ Collinear B C A ∨ Collinear C A B) [X1] by H2, B1'; consider l such that Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X2] by -, Collinear_DEF; l = m by X1, -, H2, H1, I1; qed by -, X2; `;; let CollinearLinear = thm `; let A B C be point; let m be point_set; assume Line m ∧ A ∈ m ∧ C ∈ m [H1]; assume Collinear A B C ∨ Collinear B C A ∨ Collinear C A B [H2]; assume ¬(A = C) [H3]; thus B ∈ m proof consider l such that Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X1] by H2, Collinear_DEF; l = m by H3, -, H1, I1; qed by -, X1; `;; let NonCollinearImpliesDistinct = thm `; let A B C be point; assume ¬Collinear A B C [H1]; thus ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) proof cases; suppose A = B ∧ B = C [Case1]; consider Q such that ¬(Q = A) by I3; qed by -, I1, Case1, Collinear_DEF, H1; suppose (A = B ∧ ¬(A = C)) ∨ (A = C ∧ ¬(A = B)) ∨ (B = C ∧ ¬(A = B)); qed by -, I1, Collinear_DEF, H1; suppose ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C); qed by -; end; `;; let Reverse4Order = thm `; ∀ A B C D:point. ordered A B C D ⇒ ordered D C B A by Ordered_DEF, B1'; `;; let OriginInRay = thm `; let O Q be point; assume ¬(Q = O) [H1]; thus O ∈ ray O Q proof O ∉ open (O,Q) [OOQ] by B1', ∉; Collinear O Q O by H1, I1, Collinear_DEF; qed by H1, -, OOQ, IN_Ray; `;; let EndpointInRay = thm `; let O Q be point; assume ¬(Q = O) [H1]; thus Q ∈ ray O Q proof O ∉ open (Q,Q) [notOQQ] by B1', ∉; Collinear O Q Q by H1, I1, Collinear_DEF; qed by H1, -, notOQQ, IN_Ray; `;; let I1Uniqueness = thm `; let X be point; let l m be point_set; assume Line l ∧ Line m [H0]; assume ¬(l = m) [H1]; assume X ∈ l ∧ X ∈ m [H2]; thus l ∩ m = {X} proof assume ¬(l ∩ m = {X}) [H3]; X ∈ l ∩ m by H2, IN_INTER; consider A such that A ∈ l ∩ m ∧ ¬(A = X) [X1] by -, H3, SET_RULE; A ∈ l ∧ X ∈ l ∧ A ∈ m ∧ X ∈ m by H0, -, H2, IN_INTER; l = m by H0, -, X1, I1; qed by -, H1; `;; let EquivIntersection = thm `; let A B X be point; let l m be point_set; assume Line l ∧ Line m [H0]; assume l ∩ m = {X} [H1]; assume A ∈ m â” X ∧ B ∈ m â” X [H2]; assume X ∉ open (A,B) [H3]; thus A,B same_side l proof assume ¬(A,B same_side l) [Con]; A ∈ m ∧ B ∈ m ∧ ¬(A = X) ∧ ¬(B = X) [H2'] by H2, IN_DELETE; ¬(open (A,B) ∩ l = ∅) [nonempty] by H0, Con, SameSide_DEF, SET_RULE; open (A,B) ⊂ m [ABm] by H0, H2', BetweenLinear, SUBSET; open (A,B) ∩ l ⊂ {X} by -, SET_RULE, H1; X ∈ open (A,B) ∩ l by nonempty, -, SET_RULE; qed by -, IN_INTER, H3, ∉; `;; let RayLine = thm `; ∀ O P:point. ∀ l: point_set. Line l ∧ O ∈ l ∧ P ∈ l ⇒ ray O P ⊂ l by IN_Ray, CollinearLinear, SUBSET; `;; let RaySameSide = thm `; let l be point_set; let O A P be point; assume Line l ∧ O ∈ l [l_line]; assume A ∉ l [notAl]; assume P ∈ ray O A â” O [PrOA]; thus P ∉ l ∧ P,A same_side l proof ¬(O = A) [notOA] by l_line, notAl, ∉; consider d such that Line d ∧ O ∈ d ∧ A ∈ d [d_line] by notOA, I1; ¬(l = d) by -, notAl, ∉; l ∩ d = {O} [ldO] by l_line, d_line, -, I1Uniqueness; A ∈ d â” O [Ad_O] by d_line, notOA, IN_DELETE; ray O A ⊂ d by d_line, RayLine; P ∈ d â” O [Pd_O] by PrOA, -, SUBSET, IN_DELETE; P ∉ l [notPl] by ldO, -, EquivIntersectionHelp; O ∉ open (P,A) by PrOA, IN_DELETE, IN_Ray; P,A same_side l by l_line, d_line, ldO, Ad_O, Pd_O, -, EquivIntersection; qed by notPl, -; `;; let IntervalRayEZ = thm `; let A B C be point; assume B ∈ open (A,C) [H1]; thus B ∈ ray A C â” A ∧ C ∈ ray A B â” A proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [ABC] by H1, B1'; A ∉ open (B,C) ∧ A ∉ open (C,B) by -, H1, B3', B1', ∉; qed by ABC, CollinearSymmetry, -, IN_Ray, IN_DELETE, ∉; `;; let NoncollinearityExtendsToLine = thm `; let A O B X be point; assume ¬Collinear A O B [H1]; assume Collinear O B X ∧ ¬(X = O) [H2]; thus ¬Collinear A O X proof ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; consider b such that Line b ∧ O ∈ b ∧ B ∈ b [b_line] by Distinct, I1; A ∉ b [notAb] by b_line, Collinear_DEF, H1, ∉; X ∈ b by H2, b_line, Distinct, I1, Collinear_DEF; qed by b_line, -, H2, I1, Collinear_DEF, notAb, ∉; `;; let SameSideReflexive = thm `; ∀ l A. Line l ∧ A ∉ l ⇒ A,A same_side l by B1', SameSide_DEF; `;; let SameSideSymmetric = thm `; ∀ l A B. Line l ∧ A ∉ l ∧ B ∉ l ⇒ A,B same_side l ⇒ B,A same_side l by SameSide_DEF, B1'; `;; let SameSideTransitive = thm `; let l be point_set; let A B C be point; assume Line l [l_line]; assume A ∉ l ∧ B ∉ l ∧ C ∉ l [notABCl]; assume A,B same_side l [Asim_lB]; assume B,C same_side l [Bsim_lC]; thus A,C same_side l proof cases; suppose ¬Collinear A B C ∨ A = B ∨ A = C ∨ B = C; qed by l_line, -, notABCl, Asim_lB, Bsim_lC, B4'', SameSideReflexive; suppose Collinear A B C ∧ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct]; consider m such that Line m ∧ A ∈ m ∧ C ∈ m [m_line] by Distinct, I1; B ∈ m [Bm] by -, Distinct, CollinearLinear; cases; suppose m ∩ l = ∅; qed by m_line, l_line, -, BetweenLinear, SET_RULE, SameSide_DEF; suppose ¬(m ∩ l = ∅); consider X such that X ∈ l ∧ X ∈ m [Xlm] by -, MEMBER_NOT_EMPTY, IN_INTER; Collinear A X B ∧ Collinear B A C ∧ Collinear A B C [ABXcol] by m_line, Bm, -, Collinear_DEF; consider E such that E ∈ l ∧ ¬(E = X) [El_X] by l_line, Xlm, ExistsNewPointOnLine; ¬Collinear E A X [EAXncol] by l_line, El_X, Xlm, I1, Collinear_DEF, notABCl, ∉; consider B' such that ¬(B = E) ∧ B ∈ open (E,B') [EBB'] by notABCl, El_X, ∉, B2'; ¬(B' = E) ∧ ¬(B' = B) ∧ Collinear B E B' [EBB'col] by -, B1', CollinearSymmetry; ¬Collinear A B B' ∧ ¬Collinear B' B A ∧ ¬Collinear B' A B [ABB'ncol] by EAXncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry, -; ¬Collinear B' B C ∧ ¬Collinear B' A C ∧ ¬Collinear A B' C [AB'Cncol] by ABB'ncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry; B' ∈ ray E B â” E ∧ B ∈ ray E B' â” E by EBB', IntervalRayEZ; B' ∉ l ∧ B',B same_side l ∧ B,B' same_side l [notB'l] by l_line, El_X, notABCl, -, RaySameSide; A,B' same_side l ∧ B',C same_side l by l_line, ABB'ncol, notABCl, notB'l, Asim_lB, -, B4'', AB'Cncol, Bsim_lC; qed by l_line, AB'Cncol, notABCl, notB'l, -, B4''; end; end; `;; let ConverseCrossbar = thm `; let O A B G be point; assume ¬Collinear A O B [H1]; assume G ∈ open (A,B) [H2]; thus G ∈ int_angle A O B proof ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by -, I1; consider b such that Line b ∧ O ∈ b ∧ B ∈ b [b_line] by Distinct, I1; consider l such that Line l ∧ A ∈ l ∧ B ∈ l [l_line] by Distinct, I1; B ∉ a ∧ A ∉ b by H1, a_line, Collinear_DEF, ∉, b_line; ¬(a = l) ∧ ¬(b = l) by -, l_line, ∉; a ∩ l = {A} ∧ b ∩ l = {B} [alA] by -, a_line, l_line, I1Uniqueness, b_line; ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [AGB] by H2, B1'; A ∉ open (G,B) ∧ B ∉ open (G,A) [notGAB] by H2, B3', B1', ∉; G ∈ l [Gl] by l_line, H2, BetweenLinear; G ∉ a ∧ G ∉ b [notGa] by alA, Gl, AGB, IN_DELETE, EquivIntersectionHelp; G ∈ l â” A ∧ B ∈ l â” A ∧ G ∈ l â” B ∧ A ∈ l â” B by Gl, l_line, AGB, IN_DELETE; G,B same_side a ∧ G,A same_side b by a_line, l_line, alA, -, notGAB, EquivIntersection, b_line; qed by H1, a_line, b_line, notGa, -, IN_InteriorAngle; `;; let InteriorUse = thm `; let A O B P be point; let a b be point_set; assume Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b [aOAbOB]; assume P ∈ int_angle A O B [P_AOB]; thus P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b proof consider α β such that ¬Collinear A O B ∧ Line α ∧ O ∈ α ∧ A ∈ α ∧ Line β ∧ O ∈ β ∧B ∈ β ∧ P ∉ α ∧ P ∉ β ∧ P,B same_side α ∧ P,A same_side β [exists] by P_AOB, IN_InteriorAngle; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by -, NonCollinearImpliesDistinct; α = a ∧ β = b by -, aOAbOB, exists, I1; qed by -, exists; `;; let InteriorEZHelp = thm `; let A O B P be point; assume P ∈ int_angle A O B [P_AOB]; thus ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) ∧ ¬Collinear A O P proof consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧B ∈ b ∧ P ∉ a ∧ P ∉ b [def_int] by P_AOB, IN_InteriorAngle; ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) [PnotAOB] by -, ∉; ¬(A = O) [notAO] by def_int, NonCollinearImpliesDistinct; ¬Collinear A O P by def_int, notAO, -, I1, Collinear_DEF, ∉; qed by PnotAOB, -; `;; let InteriorAngleSymmetry = thm `; ∀ A O B P: point. P ∈ int_angle A O B ⇒ P ∈ int_angle B O A by IN_InteriorAngle, CollinearSymmetry; `;; let InteriorWellDefined = thm `; let A O B X P be point; assume P ∈ int_angle A O B [H1]; assume X ∈ ray O B â” O [H2]; thus P ∈ int_angle A O X proof consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ P ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b [def_int] by H1, IN_InteriorAngle; ¬(X = O) ∧ ¬(O = B) ∧ Collinear O B X [H2'] by H2, IN_DELETE, IN_Ray; B ∉ a [notBa] by def_int, Collinear_DEF, ∉; ¬Collinear A O X [AOXnoncol] by def_int, H2', NoncollinearityExtendsToLine; X ∈ b [Xb] by def_int, H2', CollinearLinear; X ∉ a ∧ B,X same_side a by def_int, notBa, H2, RaySameSide, SameSideSymmetric; P,X same_side a by def_int, -, notBa, SameSideTransitive; qed by AOXnoncol, def_int, Xb, -, IN_InteriorAngle; `;; let WholeRayInterior = thm `; let A O B X P be point; assume X ∈ int_angle A O B [XintAOB]; assume P ∈ ray O X â” O [PrOX]; thus P ∈ int_angle A O B proof consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ X ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ X ∉ b ∧ X,B same_side a ∧ X,A same_side b [def_int] by XintAOB, IN_InteriorAngle; P ∉ a ∧ P,X same_side a ∧ P ∉ b ∧ P,X same_side b [Psim_abX] by def_int, PrOX, RaySameSide; P,B same_side a ∧ P,A same_side b by -, def_int, Collinear_DEF, SameSideTransitive, ∉; qed by def_int, Psim_abX, -, IN_InteriorAngle; `;; let AngleOrdering = thm `; let O A P Q be point; let a be point_set; assume ¬(O = A) [H1]; assume Line a ∧ O ∈ a ∧ A ∈ a [H2]; assume P ∉ a ∧ Q ∉ a [H3]; assume P, Q same_side a [H4]; assume ¬Collinear P O Q [H5]; thus P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A proof ¬(P = O) ∧ ¬(P = Q) ∧ ¬(O = Q) [Distinct] by H5, NonCollinearImpliesDistinct; consider q such that Line q ∧ O ∈ q ∧ Q ∈ q [q_line] by Distinct, I1; P ∉ q [notPq] by -, Collinear_DEF, H5, ∉; assume ¬(P ∈ int_angle Q O A) [notPintQOA]; ¬Collinear Q O A ∧ ¬Collinear P O A [POAncol] by H1, H2, I1, Collinear_DEF, H3, ∉; ¬(P,A same_side q) by -, H2, q_line, H3, notPq, H4, notPintQOA, IN_InteriorAngle; consider G such that G ∈ q ∧ G ∈ open (P,A) [existG] by q_line, -, SameSide_DEF; G ∈ int_angle P O A [G_POA] by POAncol, existG, ConverseCrossbar; G ∉ a ∧ G,P same_side a ∧ ¬(G = O) [Gsim_aP] by -, IN_InteriorAngle, H1, H2, I1, ∉; G,Q same_side a by H2, Gsim_aP, H3, H4, SameSideTransitive; O ∉ open (Q,G) [notQOG] by -, SameSide_DEF, H2, B1', ∉; Collinear O G Q by q_line, existG, Collinear_DEF; Q ∈ ray O G â” O by Gsim_aP, -, notQOG, IN_Ray, Distinct, IN_DELETE; qed by G_POA, -, WholeRayInterior; `;; let InteriorsDisjointSupplement = thm `; let A O B A' be point; assume ¬Collinear A O B [H1]; assume O ∈ open (A,A') [H2]; thus int_angle B O A' ∩ int_angle A O B = ∅ proof ∀ D. D ∈ int_angle A O B ⇒ D ∉ int_angle B O A' proof let D be point; assume D ∈ int_angle A O B [H3]; ¬(A = O) ∧ ¬(O = B) by H1, NonCollinearImpliesDistinct; consider a b such that Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ A' ∈ a [ab_line] by -, I1, H2, BetweenLinear; ¬Collinear B O A' by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; A ∉ b ∧ A' ∉ b [notAb] by ab_line, Collinear_DEF, H1, -, ∉; ¬(A',A same_side b) [A'nsim_bA] by ab_line, H2, B1', SameSide_DEF ; D ∉ b ∧ D,A same_side b [DintAOB] by ab_line, H3, InteriorUse; ¬(D,A' same_side b) by ab_line, notAb, DintAOB, A'nsim_bA, SameSideSymmetric, SameSideTransitive; qed by ab_line, -, InteriorUse, ∉; qed by -, DisjointOneNotOther; `;; let InteriorReflectionInterior = thm `; let A O B D A' be point; assume O ∈ open (A,A') [H1]; assume D ∈ int_angle A O B [H2]; thus B ∈ int_angle D O A' proof consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ D ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ D ∉ b ∧ D,B same_side a [DintAOB] by H2, IN_InteriorAngle; ¬(O = B) ∧ ¬(O = A') ∧ B ∉ a [Distinct] by -, NonCollinearImpliesDistinct, H1, B1', Collinear_DEF, ∉; ¬Collinear D O B [DOB_ncol] by DintAOB, -, I1, Collinear_DEF, ∉; A' ∈ a [A'a] by H1, DintAOB, BetweenLinear; D ∉ int_angle B O A' by DintAOB, H1, InteriorsDisjointSupplement, H2, DisjointOneNotOther; qed by Distinct, DintAOB, A'a, DOB_ncol, -, AngleOrdering, ∉; `;; let Crossbar_THM = thm `; let O A B D be point; assume D ∈ int_angle A O B [H1]; thus ∃ G. G ∈ open (A,B) ∧ G ∈ ray O D â” O proof consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ D ∉ a ∧ D ∉ b ∧ D,B same_side a ∧ D,A same_side b [DintAOB] by H1, IN_InteriorAngle; B ∉ a [notBa] by DintAOB, Collinear_DEF, ∉; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(D = O) [Distinct] by DintAOB, NonCollinearImpliesDistinct, ∉; consider l such that Line l ∧ O ∈ l ∧ D ∈ l [l_line] by -, I1; consider A' such that O ∈ open (A,A') [AOA'] by Distinct, B2'; A' ∈ a ∧ Collinear A O A' ∧ ¬(A' = O) [A'a] by DintAOB, -, BetweenLinear, B1'; ¬(A,A' same_side l) [Ansim_lA'] by l_line, AOA', SameSide_DEF; B ∈ int_angle D O A' by H1, AOA', InteriorReflectionInterior; B,A' same_side l [Bsim_lA'] by l_line, DintAOB, A'a, -, InteriorUse; ¬Collinear A O D ∧ ¬Collinear B O D [AODncol] by H1, InteriorEZHelp, InteriorAngleSymmetry; ¬Collinear D O A' by -, CollinearSymmetry, A'a, NoncollinearityExtendsToLine; A ∉ l ∧ B ∉ l ∧ A' ∉ l by l_line, Collinear_DEF, AODncol, -, ∉; ¬(A,B same_side l) by l_line, -, Bsim_lA', Ansim_lA', SameSideTransitive; consider G such that G ∈ open (A,B) ∧ G ∈ l [AGB] by l_line, -, SameSide_DEF; Collinear O D G [ODGcol] by -, l_line, Collinear_DEF; G ∈ int_angle A O B by DintAOB, AGB, ConverseCrossbar; G ∉ a ∧ G,B same_side a ∧ ¬(G = O) [Gsim_aB] by DintAOB, -, InteriorUse, ∉; B,D same_side a by DintAOB, notBa, SameSideSymmetric; G,D same_side a [Gsim_aD] by DintAOB, Gsim_aB, notBa, -, SameSideTransitive; O ∉ open (G,D) by DintAOB, -, SameSide_DEF, ∉; G ∈ ray O D â” O by Distinct, ODGcol, -, IN_Ray, Gsim_aB, IN_DELETE; qed by AGB, -; `;; let AlternateConverseCrossbar = thm `; let O A B G be point; assume Collinear A G B ∧ G ∈ int_angle A O B [H1]; thus G ∈ open (A,B) proof consider a b such that ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ G,B same_side a ∧ G,A same_side b [GintAOB] by H1, IN_InteriorAngle; ¬(A = B) ∧ ¬(G = A) ∧ ¬(G = B) ∧ A ∉ open (G,B) ∧ B ∉ open (G,A) by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SameSide_DEF, ∉; qed by -, H1, B1', B3', ∉; `;; let InteriorOpposite = thm `; let A O B P be point; let p be point_set; assume P ∈ int_angle A O B [PintAOB]; assume Line p ∧ O ∈ p ∧ P ∈ p [p_line]; thus ¬(A,B same_side p) proof consider G such that G ∈ open (A,B) ∧ G ∈ ray O P [Gexists] by PintAOB, Crossbar_THM, IN_DELETE; G ∈ p by p_line, RayLine, -, SUBSET; qed by p_line, -, Gexists, SameSide_DEF; `;; let IntervalTransitivity = thm `; let O P Q R be point; let m be point_set; assume Line m ∧ O ∈ m [H0]; assume P ∈ m â” O ∧ Q ∈ m â” O ∧ R ∈ m â” O [H2]; assume O ∉ open (P,Q) ∧ O ∉ open (Q,R) [H3]; thus O ∉ open (P,R) proof consider E such that E ∉ m ∧ ¬(O = E) [notEm] by H0, ExistsPointOffLine, ∉; consider l such that Line l ∧ O ∈ l ∧ E ∈ l [l_line] by -, I1; ¬(m = l) by notEm, -, ∉; l ∩ m = {O} [lmO] by l_line, H0, -, l_line, I1Uniqueness; P ∉ l ∧ Q ∉ l ∧ R ∉ l [notPQRl] by -, H2, EquivIntersectionHelp; P,Q same_side l ∧ Q,R same_side l by l_line, H0, lmO, H2, H3, EquivIntersection; P,R same_side l [Psim_lR] by l_line, notPQRl, -, SameSideTransitive; qed by l_line, -, SameSide_DEF, ∉; `;; let RayWellDefinedHalfway = thm `; let O P Q be point; assume ¬(Q = O) [H1]; assume P ∈ ray O Q â” O [H2]; thus ray O P ⊂ ray O Q proof consider m such that Line m ∧ O ∈ m ∧ Q ∈ m [OQm] by H1, I1; P ∈ ray O Q ∧ ¬(P = O) ∧ O ∉ open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; P ∈ m ∧ P ∈ m â” O ∧ Q ∈ m â” O [PQm_O] by OQm, H2', RayLine, SUBSET, H2', OQm, H1, IN_DELETE; O ∉ open (P,Q) [notPOQ] by H2', IN_Ray; ∀ X. X ∈ ray O P ⇒ X ∈ ray O Q proof let X be point; assume X ∈ ray O P; X ∈ m ∧ O ∉ open (X,P) [XrOP] by OQm, PQm_O, H2', -, RayLine, SUBSET, IN_Ray; Collinear O Q X [OQXcol] by OQm, -, Collinear_DEF; cases; suppose X = O; qed by H1, -, OriginInRay; suppose ¬(X = O); X ∈ m â” O by XrOP, -, IN_DELETE; O ∉ open (X,Q) by OQm, -, PQm_O, XrOP, H2', IntervalTransitivity; qed by H1, OQXcol, -, IN_Ray; end; qed by -, SUBSET; `;; let RayWellDefined = thm `; let O P Q be point; assume ¬(Q = O) [H1]; assume P ∈ ray O Q â” O [H2]; thus ray O P = ray O Q proof ray O P ⊂ ray O Q [PsubsetQ] by H1, H2, RayWellDefinedHalfway; ¬(P = O) ∧ Collinear O Q P ∧ O ∉ open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; Q ∈ ray O P â” O by H2', B1', ∉, CollinearSymmetry, IN_Ray, H1, IN_DELETE; ray O Q ⊂ ray O P [QsubsetP] by H2', -, RayWellDefinedHalfway; qed by PsubsetQ, QsubsetP, SUBSET_ANTISYM; `;; let OppositeRaysIntersect1pointHelp = thm `; let A O B X be point; assume O ∈ open (A,B) [H1]; assume X ∈ ray O B â” O [H2]; thus X ∉ ray O A ∧ O ∈ open (X,A) proof ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ Collinear A O B [AOB] by H1, B1'; ¬(X = O) ∧ Collinear O B X ∧ O ∉ open (X,B) [H2'] by H2, IN_DELETE, IN_Ray; consider m such that Line m ∧ A ∈ m ∧ B ∈ m [m_line] by AOB, I1; O ∈ m ∧ X ∈ m [Om] by m_line, H2', AOB, CollinearLinear; A ∈ m â” O ∧ X ∈ m â” O ∧ B ∈ m â” O by m_line, -, H2', AOB, IN_DELETE; O ∈ open (X,A) by H1, m_line, Om, -, H2', IntervalTransitivity, ∉, B1'; qed by -, IN_Ray, ∉; `;; let OppositeRaysIntersect1point = thm `; let A O B be point; assume O ∈ open (A,B) [H1]; thus ray O A ∩ ray O B = {O} proof ¬(A = O) ∧ ¬(O = B) by H1, B1'; {O} ⊂ ray O A ∩ ray O B [Osubset_rOA] by -, OriginInRay, IN_INTER, SING_SUBSET; ∀ X. ¬(X = O) ∧ X ∈ ray O B ⇒ X ∉ ray O A by IN_DELETE, H1, OppositeRaysIntersect1pointHelp; ray O A ∩ ray O B ⊂ {O} by -, IN_INTER, IN_SING, SUBSET, ∉; qed by -, Osubset_rOA, SUBSET_ANTISYM; `;; let IntervalRay = thm `; ∀ A B C:point. B ∈ open (A,C) ⇒ ray A B = ray A C by B1', IntervalRayEZ, RayWellDefined; `;; let TransitivityBetweennessHelp = thm `; let A B C D be point; assume B ∈ open (A,C) ∧ C ∈ open (B,D) [H1]; thus B ∈ open (A,D) proof D ∈ ray B C â” B by H1, IntervalRayEZ; qed by H1, -, OppositeRaysIntersect1pointHelp, B1'; `;; let TransitivityBetweenness = thm `; let A B C D be point; assume B ∈ open (A,C) ∧ C ∈ open (B,D) [H1]; thus ordered A B C D proof B ∈ open (A,D) [ABD] by H1, TransitivityBetweennessHelp; C ∈ open (D,B) ∧ B ∈ open (C,A) by H1, B1'; C ∈ open (D,A) by -, TransitivityBetweennessHelp; qed by H1, ABD, -, B1', Ordered_DEF; `;; let IntervalsAreConvex = thm `; let A B C be point; assume B ∈ open (A,C) [H1]; thus open (A,B) ⊂ open (A,C) proof ∀ X. X ∈ open (A,B) ⇒ X ∈ open (A,C) proof let X be point; assume X ∈ open (A,B) [AXB]; X ∈ ray B A â” B by AXB, B1', IntervalRayEZ; B ∈ open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; qed by AXB, -, TransitivityBetweennessHelp; qed by -, SUBSET; `;; let TransitivityBetweennessVariant = thm `; let A X B C be point; assume X ∈ open (A,B) ∧ B ∈ open (A,C) [H1]; thus ordered A X B C proof X ∈ ray B A â” B by H1, B1', IntervalRayEZ; B ∈ open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; qed by H1, -, TransitivityBetweenness; `;; let Interval2sides2aLineHelp = thm `; let A B C X be point; assume B ∈ open (A,C) [H1]; thus X ∉ open (A,B) ∨ X ∉ open (B,C) proof assume ¬(X ∉ open (A,B)); ordered A X B C by -, ∉, H1, TransitivityBetweennessVariant; B ∈ open (X,C) by -, Ordered_DEF; X ∉ open (C,B) by -, B1', B3', ∉; qed by -, B1', ∉; `;; let Interval2sides2aLine = thm `; let A B C X be point; assume Collinear A B C [H1]; thus X ∉ open (A,B) ∨ X ∉ open (A,C) ∨ X ∉ open (B,C) proof cases; suppose A = B ∨ A = C ∨ B = C; qed by -, B1', ∉; suppose ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C); B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B) by -, H1, B3'; qed by -, Interval2sides2aLineHelp, B1', ∉; end; `;; let TwosidesTriangle2aLine = thm `; let A B C Y be point; let l m be point_set; assume Line l ∧ ¬Collinear A B C [H1]; assume A ∉ l ∧ B ∉ l ∧ C ∉ l [off_l]; assume Line m ∧ A ∈ m ∧ C ∈ m [m_line]; assume Y ∈ l ∧ Y ∈ m [Ylm]; assume ¬(A,B same_side l) ∧ ¬(B,C same_side l) [H2]; thus A,C same_side l proof consider X Z such that X ∈ l ∧ X ∈ open (A,B) ∧ Z ∈ l ∧ Z ∈ open (C,B) [H2'] by H1, H2, SameSide_DEF, B1'; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Y ∈ m â” A ∧ Y ∈ m â” C ∧ C ∈ m â” A ∧ A ∈ m â” C [Distinct] by H1, NonCollinearImpliesDistinct, Ylm, off_l, ∉, m_line, IN_DELETE; consider p such that Line p ∧ B ∈ p ∧ A ∈ p [p_line] by Distinct, I1; consider q such that Line q ∧ B ∈ q ∧ C ∈ q [q_line] by Distinct, I1; X ∈ p ∧ Z ∈ q [Xp] by p_line, H2', BetweenLinear, q_line, H2'; A ∉ q ∧ B ∉ m ∧ C ∉ p [vertex_off_line] by q_line, m_line, p_line, H1, Collinear_DEF, ∉; X ∉ q ∧ X,A same_side q ∧ Z ∉ p ∧ Z,C same_side p [Xsim_qA] by q_line, p_line, -, H2', B1', IntervalRayEZ, RaySameSide; ¬(m = p) ∧ ¬(m = q) by m_line, vertex_off_line, ∉; p ∩ m = {A} ∧ q ∩ m = {C} [pmA] by p_line, m_line, q_line, H1, -, Xp, H2', I1Uniqueness; Y ∉ p ∧ Y ∉ q [notYpq] by -, Distinct, EquivIntersectionHelp; X ∈ ray A B â” A ∧ Z ∈ ray C B â” C by H2', IntervalRayEZ, H2', B1'; X ∉ m ∧ Z ∉ m ∧ X,B same_side m ∧ B,Z same_side m [notXZm] by m_line, vertex_off_line, -, RaySameSide, SameSideSymmetric; X,Z same_side m by m_line, -, vertex_off_line, SameSideTransitive; Collinear X Y Z ∧ Y ∉ open (X,Z) ∧ ¬(Y = X) ∧ ¬(Y = Z) ∧ ¬(X = Z) by H1, H2', Ylm, Collinear_DEF, m_line, -, SameSide_DEF, notXZm, Xsim_qA, Xp, ∉; Z ∈ open (X,Y) ∨ X ∈ open (Z,Y) by -, B3', ∉, B1'; cases by -; suppose X ∈ open (Z,Y); ¬(Z,Y same_side p) by p_line, Xp, -, SameSide_DEF; ¬(C,Y same_side p) by p_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; A ∈ open (C,Y) by p_line, m_line, pmA, Distinct, -, EquivIntersection, ∉; qed by H1, Ylm, off_l, -, B1', IntervalRayEZ, RaySameSide; suppose Z ∈ open (X,Y); ¬(X,Y same_side q) by q_line, Xp, -, SameSide_DEF; ¬(A,Y same_side q) by q_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; C ∈ open (Y,A) by q_line, m_line, pmA, Distinct, -, EquivIntersection, ∉, B1'; qed by H1, Ylm, off_l, -, IntervalRayEZ, RaySameSide; end; `;; let LineUnionOf2Rays = thm `; let A O B be point; let l be point_set; assume Line l ∧ A ∈ l ∧ B ∈ l [H1]; assume O ∈ open (A,B) [H2]; thus l = ray O A ∪ ray O B proof ¬(A = O) ∧ ¬(O = B) ∧ O ∈ l [Distinct] by H2, B1', H1, BetweenLinear; ray O A ∪ ray O B ⊂ l [AOBsub_l] by H1, -, RayLine, UNION_SUBSET; ∀ X. X ∈ l ⇒ X ∈ ray O A ∨ X ∈ ray O B proof let X be point; assume X ∈ l [Xl]; assume ¬(X ∈ ray O B) [notXrOB]; Collinear O B X ∧ Collinear X A B ∧ Collinear O A X [XABcol] by Distinct, H1, Xl, Collinear_DEF; O ∈ open (X,B) by notXrOB, Distinct, -, IN_Ray, ∉; O ∉ open (X,A) by ∉, B1', XABcol, -, H2, Interval2sides2aLine; qed by Distinct, XABcol, -, IN_Ray; l ⊂ ray O A ∪ ray O B by -, IN_UNION, SUBSET; qed by -, AOBsub_l, SUBSET_ANTISYM; `;; let AtMost2Sides = thm `; let A B C be point; let l be point_set; assume Line l [H1]; assume A ∉ l ∧ B ∉ l ∧ C ∉ l [H2]; thus A,B same_side l ∨ A,C same_side l ∨ B,C same_side l proof cases; suppose A = C; qed by -, H1, H2, SameSideReflexive; suppose ¬(A = C) [notAC]; consider m such that Line m ∧ A ∈ m ∧ C ∈ m [m_line] by notAC, I1; cases; suppose m ∩ l = ∅; A,C same_side l by m_line, H1, -, BetweenLinear, SET_RULE, SameSide_DEF; qed by -; suppose ¬(m ∩ l = ∅); consider Y such that Y ∈ l ∧ Y ∈ m [Ylm] by -, IN_INTER, MEMBER_NOT_EMPTY; cases; suppose ¬Collinear A B C; qed by H1, -, H2, m_line, Ylm, TwosidesTriangle2aLine; suppose Collinear A B C [ABCcol]; B ∈ m [Bm] by -, m_line, notAC, I1, Collinear_DEF; ¬(Y = A) ∧ ¬(Y = B) ∧ ¬(Y = C) [YnotABC] by Ylm, H2, ∉; Y ∉ open (A,B) ∨ Y ∉ open (A,C) ∨ Y ∉ open (B,C) by ABCcol, Interval2sides2aLine; A ∈ ray Y B â” Y ∨ A ∈ ray Y C â” Y ∨ B ∈ ray Y C â” Y by YnotABC, m_line, Bm, Ylm, Collinear_DEF, -, IN_Ray, IN_DELETE; qed by H1, Ylm, H2, -, RaySameSide; end; end; end; `;; let FourPointsOrder = thm `; let A B C X be point; let l be point_set; assume Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ X ∈ l [H1]; assume ¬(X = A) ∧ ¬(X = B) ∧ ¬(X = C) [H2]; assume B ∈ open (A,C) [H3]; thus ordered X A B C ∨ ordered A X B C ∨ ordered A B X C ∨ ordered A B C X proof A ∈ open (X,B) ∨ X ∈ open (A,B) ∨ X ∈ open (B,C) ∨ C ∈ open (B,X) proof ¬(A = B) ∧ ¬(B = C) [ABCdistinct] by H3, B1'; Collinear A B X ∧ Collinear A C X ∧ Collinear C B X [ACXcol] by H1, Collinear_DEF; A ∈ open (X,B) ∨ X ∈ open (A,B) ∨ B ∈ open (A,X) by H2, ABCdistinct, -, B3', B1'; cases by -; suppose A ∈ open (X,B) ∨ X ∈ open (A,B); qed by -; suppose B ∈ open (A,X); B ∉ open (C,X) by ACXcol, H3, -, Interval2sides2aLine, ∉; qed by H2, ABCdistinct, ACXcol, -, B3', B1', ∉; end; qed by -, H3, B1', TransitivityBetweenness, TransitivityBetweennessVariant, Reverse4Order; `;; let HilbertAxiomRedundantByMoore = thm `; let A B C D be point; let l be point_set; assume Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ D ∈ l [H1]; assume ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) [H2]; thus ordered D A B C ∨ ordered A D B C ∨ ordered A B D C ∨ ordered A B C D ∨ ordered D A C B ∨ ordered A D C B ∨ ordered A C D B ∨ ordered A C B D ∨ ordered D C A B ∨ ordered C D A B ∨ ordered C A D B ∨ ordered C A B D proof Collinear A B C by H1, Collinear_DEF; B ∈ open (A,C) ∨ C ∈ open (A,B) ∨ A ∈ open (C,B) by H2, -, B3', B1'; qed by -, H1, H2, FourPointsOrder; `;; let InteriorTransitivity = thm `; let A O B F G be point; assume G ∈ int_angle A O B [GintAOB]; assume F ∈ int_angle A O G [FintAOG]; thus F ∈ int_angle A O B proof ¬Collinear A O B [AOBncol] by GintAOB, IN_InteriorAngle; consider G' such that G' ∈ open (A,B) ∧ G' ∈ ray O G â” O [CrossG] by GintAOB, Crossbar_THM; F ∈ int_angle A O G' by FintAOG, -, InteriorWellDefined; consider F' such that F' ∈ open (A,G') ∧ F' ∈ ray O F â” O [CrossF] by -, Crossbar_THM; ¬(F' = O) ∧ ¬(F = O) ∧ Collinear O F F' ∧ O ∉ open (F',F) by -, IN_DELETE, IN_Ray; F ∈ ray O F' â” O [FrOF'] by -, CollinearSymmetry, B1', ∉, IN_Ray, IN_DELETE; open (A,G') ⊂ open (A,B) ∧ F' ∈ open (A,B) by CrossG, IntervalsAreConvex, CrossF, SUBSET; F' ∈ int_angle A O B by AOBncol, -, ConverseCrossbar; qed by -, FrOF', WholeRayInterior; `;; let HalfPlaneConvexNonempty = thm `; let l H be point_set; let A be point; assume Line l ∧ A ∉ l [l_line]; assume H = {X | X ∉ l ∧ X,A same_side l} [HalfPlane]; thus ¬(H = ∅) ∧ H ⊂ complement l ∧ Convex H proof ∀ X. X ∈ H ⇔ X ∉ l ∧ X,A same_side l [Hdef] by HalfPlane, SET_RULE; H ⊂ complement l [Hsub] by -, IN_PlaneComplement, SUBSET; A,A same_side l ∧ A ∈ H by l_line, SameSideReflexive, Hdef; ¬(H = ∅) [Hnonempty] by -, MEMBER_NOT_EMPTY; ∀ P Q X. P ∈ H ∧ Q ∈ H ∧ X ∈ open (P,Q) ⇒ X ∈ H proof let P Q X be point; assume P ∈ H ∧ Q ∈ H ∧ X ∈ open (P,Q) [PXQ]; P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,A same_side l [PQinH] by -, Hdef; P,Q same_side l [Psim_lQ] by l_line, -, SameSideSymmetric, SameSideTransitive; X ∉ l [notXl] by -, PXQ, SameSide_DEF, ∉; open (X,P) ⊂ open (P,Q) by PXQ, IntervalsAreConvex, B1', SUBSET; X,P same_side l by l_line, -, SUBSET, Psim_lQ, SameSide_DEF; X,A same_side l by l_line, notXl, PQinH, -, Psim_lQ, PQinH, SameSideTransitive; qed by -, notXl, Hdef; Convex H by -, SUBSET, CONVEX; qed by Hnonempty, Hsub, -; `;; let PlaneSeparation = thm `; let l be point_set; assume Line l [l_line]; thus ∃ H1 H2:point_set. H1 ∩ H2 = ∅ ∧ ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ Convex H1 ∧ Convex H2 ∧ complement l = H1 ∪ H2 ∧ ∀ P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) proof consider A such that A ∉ l [notAl] by l_line, ExistsPointOffLine; consider E such that E ∈ l ∧ ¬(A = E) [El] by l_line, I2, -, ∉; consider B such that E ∈ open (A,B) ∧ ¬(E = B) ∧ Collinear A E B [AEB] by -, B2', B1'; B ∉ l [notBl] by l_line, El, -, I1, Collinear_DEF, notAl, ∉; ¬(A,B same_side l) [Ansim_lB] by l_line, El, AEB, SameSide_DEF; consider H1 H2 such that H1 = {X | X ∉ l ∧ X,A same_side l} ∧ H2 = {X | X ∉ l ∧ X,B same_side l} [H12sets]; ∀ X. (X ∈ H1 ⇔ X ∉ l ∧ X,A same_side l) ∧ (X ∈ H2 ⇔ X ∉ l ∧ X,B same_side l) [H12def] by -, SET_RULE; ∀ X. X ∈ H1 ⇔ X ∉ l ∧ X,A same_side l [H1def] by H12sets, SET_RULE; ∀ X. X ∈ H2 ⇔ X ∉ l ∧ X,B same_side l [H2def] by H12sets, SET_RULE; H1 ∩ H2 = ∅ [H12disjoint] proof assume ¬(H1 ∩ H2 = ∅); consider V such that V ∈ H1 ∧ V ∈ H2 by -, MEMBER_NOT_EMPTY, IN_INTER; V ∉ l ∧ V,A same_side l ∧ V ∉ l ∧ V,B same_side l by -, H12def; A,B same_side l by l_line, -, notAl, notBl, SameSideSymmetric, SameSideTransitive; qed by -, Ansim_lB; ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ H1 ⊂ complement l ∧ H2 ⊂ complement l ∧ Convex H1 ∧ Convex H2 [H12convex_nonempty] by l_line, notAl, notBl, H12sets, HalfPlaneConvexNonempty; H1 ∪ H2 ⊂ complement l [H12sub] by H12convex_nonempty, UNION_SUBSET; ∀ C. C ∈ complement l ⇒ C ∈ H1 ∪ H2 proof let C be point; assume C ∈ complement l; C ∉ l [notCl] by -, IN_PlaneComplement; C,A same_side l ∨ C,B same_side l by l_line, notAl, notBl, -, Ansim_lB, AtMost2Sides; C ∈ H1 ∨ C ∈ H2 by notCl, -, H12def; qed by -, IN_UNION; complement l ⊂ H1 ∪ H2 by -, SUBSET; complement l = H1 ∪ H2 [compl_H1unionH2] by H12sub, -, SUBSET_ANTISYM; ∀ P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) [opp_sides] proof let P Q be point; assume P ∈ H1 ∧ Q ∈ H2; P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,B same_side l [PH1_QH2] by -, H12def, IN; qed by l_line, -, notAl, SameSideSymmetric, notBl, Ansim_lB, SameSideTransitive; qed by H12disjoint, H12convex_nonempty, compl_H1unionH2, opp_sides; `;; let TetralateralSymmetry = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; thus Tetralateral B C D A ∧ Tetralateral A B D C proof ¬Collinear A B D ∧ ¬Collinear B D C ∧ ¬Collinear D C A ∧ ¬Collinear C A B [TetraABCD] by H1, Tetralateral_DEF, CollinearSymmetry; qed by H1, -, Tetralateral_DEF; `;; let EasyEmptyIntersectionsTetralateralHelp = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; thus open (A,B) ∩ open (B,C) = ∅ proof ∀ X. X ∈ open (B,C) ⇒ X ∉ open (A,B) proof let X be point; assume X ∈ open (B,C); ¬Collinear A B C ∧ Collinear B X C ∧ ¬(X = B) by H1, Tetralateral_DEF, -, B1'; ¬Collinear A X B by -, CollinearSymmetry, B1', NoncollinearityExtendsToLine; qed by -, B1', ∉; qed by -, DisjointOneNotOther; `;; let EasyEmptyIntersectionsTetralateral = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; thus open (A,B) ∩ open (B,C) = ∅ ∧ open (B,C) ∩ open (C,D) = ∅ ∧ open (C,D) ∩ open (D,A) = ∅ ∧ open (D,A) ∩ open (A,B) = ∅ proof Tetralateral B C D A ∧ Tetralateral C D A B ∧ Tetralateral D A B C by H1, TetralateralSymmetry; qed by H1, -, EasyEmptyIntersectionsTetralateralHelp; `;; let SegmentSameSideOppositeLine = thm `; let A B C D be point; let a c be point_set; assume Quadrilateral A B C D [H1]; assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; assume Line c ∧ C ∈ c ∧ D ∈ c [c_line]; thus A,B same_side c ∨ C,D same_side a proof assume ¬(C,D same_side a); :: prove A,B same_side c consider G such that G ∈ a ∧ G ∈ open (C,D) [CGD] by -, a_line, SameSide_DEF; G ∈ c ∧ Collinear G B A [Gc] by c_line, -, BetweenLinear, a_line, Collinear_DEF; ¬Collinear B C D ∧ ¬Collinear C D A ∧ open (A,B) ∩ open (C,D) = ∅ [quadABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; A ∉ c ∧ B ∉ c ∧ ¬(A = G) ∧ ¬(B = G) [Distinct] by -, c_line, Collinear_DEF, ∉, Gc; G ∉ open (A,B) by quadABCD, CGD, DisjointOneNotOther; A ∈ ray G B â” G by Distinct, Gc, -, IN_Ray, IN_DELETE; qed by c_line, Gc, Distinct, -, RaySameSide; `;; let ConvexImpliesQuad = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; assume C ∈ int_angle D A B ∧ D ∈ int_angle A B C [H2]; thus Quadrilateral A B C D proof ¬(A = B) ∧ ¬(B = C) ∧ ¬(A = D) [TetraABCD] by H1, Tetralateral_DEF; consider a such that Line a ∧ A ∈ a ∧ B ∈ a [a_line] by TetraABCD, I1; consider b such that Line b ∧ B ∈ b ∧ C ∈ b [b_line] by TetraABCD, I1; consider d such that Line d ∧ D ∈ d ∧ A ∈ d [d_line] by TetraABCD, I1; open (B,C) ⊂ b ∧ open (A,B) ⊂ a [BCbABa] by b_line, a_line, BetweenLinear, SUBSET; D,A same_side b ∧ C,D same_side a by H2, a_line, b_line, d_line, InteriorUse; b ∩ open (D,A) = ∅ ∧ a ∩ open (C,D) = ∅ by -, b_line, SameSide_DEF, SET_RULE; open (B,C) ∩ open (D,A) = ∅ ∧ open (A,B) ∩ open (C,D) = ∅ by BCbABa, -, SET_RULE; qed by H1, -, Quadrilateral_DEF; `;; let DiagonalsIntersectImpliesConvexQuad = thm `; let A B C D G be point; assume ¬Collinear B C D [BCDncol]; assume G ∈ open (A,C) ∧ G ∈ open (B,D) [DiagInt]; thus ConvexQuadrilateral A B C D proof ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬(C = A) ∧ ¬(A = G) ∧ ¬(D = G) ∧ ¬(B = G) [Distinct] by BCDncol, NonCollinearImpliesDistinct, DiagInt, B1'; Collinear A G C ∧ Collinear B G D [AGCcol] by DiagInt, B1'; ¬Collinear C D A [CDAncol] by BCDncol, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; ¬Collinear D A B [DABncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; ¬Collinear A B C [ABCncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; ¬(A = B) ∧ ¬(A = D) by DABncol, NonCollinearImpliesDistinct; Tetralateral A B C D [TetraABCD] by Distinct, -, BCDncol, CDAncol, DABncol, ABCncol, Tetralateral_DEF; A ∈ ray C G â” C ∧ B ∈ ray D G â” D ∧ C ∈ ray A G â” A ∧ D ∈ ray B G â” B [ArCG] by DiagInt, B1', IntervalRayEZ; G ∈ int_angle B C D ∧ G ∈ int_angle C D A ∧ G ∈ int_angle D A B ∧ G ∈ int_angle A B C by BCDncol, CDAncol, DABncol, ABCncol, DiagInt, B1', ConverseCrossbar; A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C by -, ArCG, WholeRayInterior; qed by TetraABCD, -, ConvexImpliesQuad, ConvexQuad_DEF; `;; let DoubleNotSimImpliesDiagonalsIntersect = thm `; let A B C D be point; let l m be point_set; assume Line l ∧ A ∈ l ∧ C ∈ l [l_line]; assume Line m ∧ B ∈ m ∧ D ∈ m [m_line]; assume Tetralateral A B C D [H1]; assume ¬(B,D same_side l) [H2]; assume ¬(A,C same_side m) [H3]; thus (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ConvexQuadrilateral A B C D proof ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; consider G such that G ∈ open (A,C) ∧ G ∈ m [AGC] by H3, m_line, SameSide_DEF; G ∈ l [Gl] by l_line, -, BetweenLinear; A ∉ m ∧ B ∉ l ∧ D ∉ l by TetraABCD, m_line, l_line, Collinear_DEF, ∉; ¬(l = m) ∧ B ∈ m â” G ∧ D ∈ m â” G [BDm_G] by -, l_line, ∉, m_line, Gl, IN_DELETE; l ∩ m = {G} by l_line, m_line, -, Gl, AGC, I1Uniqueness; G ∈ open (B,D) by l_line, m_line, -, BDm_G, H2, EquivIntersection, ∉; qed by AGC, -, IN_INTER, TetraABCD, DiagonalsIntersectImpliesConvexQuad; `;; let ConvexQuadImpliesDiagonalsIntersect = thm `; let A B C D be point; let l m be point_set; assume Line l ∧ A ∈ l ∧ C ∈ l [l_line]; assume Line m ∧ B ∈ m ∧ D ∈ m [m_line]; assume ConvexQuadrilateral A B C D [ConvQuadABCD]; thus ¬(B,D same_side l) ∧ ¬(A,C same_side m) ∧ (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ¬Quadrilateral A B D C proof Tetralateral A B C D ∧ A ∈ int_angle B C D ∧ D ∈ int_angle A B C [convquadABCD] by ConvQuadABCD, ConvexQuad_DEF, Quadrilateral_DEF; ¬(B,D same_side l) ∧ ¬(A,C same_side m) [opp_sides] by convquadABCD, l_line, m_line, InteriorOpposite; consider G such that G ∈ open (A,C) ∩ open (B,D) [Gexists] by l_line, m_line, convquadABCD, opp_sides, DoubleNotSimImpliesDiagonalsIntersect; ¬(open (B,D) ∩ open (C,A) = ∅) by -, IN_INTER, B1', MEMBER_NOT_EMPTY; ¬Quadrilateral A B D C by -, Quadrilateral_DEF; qed by opp_sides, Gexists, -; `;; let FourChoicesTetralateralHelp = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; assume C ∈ int_angle D A B [CintDAB]; thus ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B proof ¬(A = B) ∧ ¬(D = A) ∧ ¬(A = C) ∧ ¬(B = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; consider a d such that Line a ∧ A ∈ a ∧ B ∈ a ∧ Line d ∧ D ∈ d ∧ A ∈ d [ad_line] by TetraABCD, I1; consider l m such that Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by TetraABCD, I1; C ∉ a ∧ C ∉ d ∧ B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m ∧ ¬Collinear A B D ∧ ¬Collinear B D A [tetra'] by TetraABCD, ad_line, lm_line, Collinear_DEF, ∉, CollinearSymmetry; ¬(B,D same_side l) [Bsim_lD] by CintDAB, lm_line, InteriorOpposite, -, SameSideSymmetric; cases; suppose ¬(A,C same_side m); qed by lm_line, H1, Bsim_lD, -, DoubleNotSimImpliesDiagonalsIntersect; suppose A,C same_side m; C,A same_side m [Csim_mA] by lm_line, -, tetra', SameSideSymmetric; C,B same_side d ∧ C,D same_side a by ad_line, CintDAB, InteriorUse; C ∈ int_angle A B D ∧ C ∈ int_angle B D A by tetra', ad_line, lm_line, Csim_mA, -, IN_InteriorAngle; C ∈ int_triangle D A B by CintDAB, -, IN_InteriorTriangle; qed by -; end; `;; let InteriorTriangleSymmetry = thm `; ∀ A B C P. P ∈ int_triangle A B C ⇒ P ∈ int_triangle B C A by IN_InteriorTriangle; `;; let FourChoicesTetralateral = thm `; let A B C D be point; let a be point_set; assume Tetralateral A B C D [H1]; assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; assume C,D same_side a [Csim_aD]; thus ConvexQuadrilateral A B C D ∨ ConvexQuadrilateral A B D C ∨ D ∈ int_triangle A B C ∨ C ∈ int_triangle D A B proof ¬(A = B) ∧ ¬Collinear A B C ∧ ¬Collinear C D A ∧ ¬Collinear D A B ∧ Tetralateral A B D C [TetraABCD] by H1, Tetralateral_DEF, TetralateralSymmetry; ¬Collinear C A D ∧ C ∉ a ∧ D ∉ a [notCDa] by TetraABCD, CollinearSymmetry, a_line, Collinear_DEF, ∉; C ∈ int_angle D A B ∨ D ∈ int_angle C A B by TetraABCD, a_line, -, Csim_aD, AngleOrdering; cases by -; suppose C ∈ int_angle D A B; ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B by H1, -, FourChoicesTetralateralHelp; qed by -; suppose D ∈ int_angle C A B; ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B by TetraABCD, -, FourChoicesTetralateralHelp; qed by -, InteriorTriangleSymmetry; end; `;; let QuadrilateralSymmetry = thm `; ∀ A B C D:point. Quadrilateral A B C D ⇒ Quadrilateral B C D A ∧ Quadrilateral C D A B ∧ Quadrilateral D A B C by Quadrilateral_DEF, INTER_COMM, TetralateralSymmetry, Quadrilateral_DEF; `;; let FiveChoicesQuadrilateral = thm `; let A B C D be point; let l m be point_set; assume Quadrilateral A B C D [H1]; assume Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m [lm_line]; thus (ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) ∧ (¬(B,D same_side l) ∨ ¬(A,C same_side m)) proof Tetralateral A B C D [H1Tetra] by H1, Quadrilateral_DEF; ¬(A = B) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(C = D) [Distinct] by H1Tetra, Tetralateral_DEF; consider a c such that Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by Distinct, I1; Quadrilateral C D A B ∧ Tetralateral C D A B [tetraCDAB] by H1, QuadrilateralSymmetry, Quadrilateral_DEF; ¬ConvexQuadrilateral A B D C ∧ ¬ConvexQuadrilateral C D B A [notconvquad] by Distinct, I1, H1, -, ConvexQuadImpliesDiagonalsIntersect; ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C [5choices] proof A,B same_side c ∨ C,D same_side a by H1, ac_line, SegmentSameSideOppositeLine; cases by -; suppose C,D same_side a; qed by H1Tetra, ac_line, -, notconvquad, FourChoicesTetralateral; suppose A,B same_side c; ConvexQuadrilateral C D A B ∨ B ∈ int_triangle C D A ∨ A ∈ int_triangle B C D [X1] by tetraCDAB, ac_line, -, notconvquad, FourChoicesTetralateral; qed by -, QuadrilateralSymmetry, ConvexQuad_DEF; end; ¬(B,D same_side l) ∨ ¬(A,C same_side m) by -, lm_line, ConvexQuadImpliesDiagonalsIntersect, IN_InteriorTriangle, InteriorAngleSymmetry, InteriorOpposite; qed by 5choices, -; `;; let IntervalSymmetry = thm `; ∀ A B: point. open (A,B) = open (B,A) by B1', EXTENSION; `;; let SegmentSymmetry = thm `; ∀ A B: point. seg A B = seg B A by Segment_DEF, IntervalSymmetry, SET_RULE; `;; let C1OppositeRay = thm `; let O P be point; let s be point_set; assume Segment s ∧ ¬(O = P) [H1]; thus ∃ Q. P ∈ open (O,Q) ∧ seg P Q ≡ s proof consider Z such that P ∈ open (O,Z) ∧ ¬(P = Z) [OPZ] by H1, B2', B1'; consider Q such that Q ∈ ray P Z â” P ∧ seg P Q ≡ s [PQeq] by H1, -, C1; P ∈ open (Q,O) by OPZ, -, OppositeRaysIntersect1pointHelp; qed by -, B1', PQeq; `;; let OrderedCongruentSegments = thm `; let A B C D F be point; assume ¬(A = C) ∧ ¬(D = F) [H1]; assume seg A C ≡ seg D F [H2]; assume B ∈ open (A,C) [H3]; thus ∃ E. E ∈ open (D,F) ∧ seg A B ≡ seg D E proof Segment (seg A B) ∧ Segment (seg A C) ∧ Segment (seg B C) ∧ Segment (seg D F) [segs] by H3, B1', H1, SEGMENT; seg D F ≡ seg A C [DFeqAC] by -, H2, C2Symmetric; consider E such that E ∈ ray D F â” D ∧ seg D E ≡ seg A B [DEeqAB] by segs, H1, C1; ¬(E = D) ∧ Collinear D E F ∧ D ∉ open (F,E) [ErDF] by -, IN_DELETE, IN_Ray, B1', CollinearSymmetry, ∉; consider F' such that E ∈ open (D,F') ∧ seg E F' ≡ seg B C [DEF'] by segs, -, C1OppositeRay; seg D F' ≡ seg A C [DF'eqAC] by DEF', H3, DEeqAB, C3; Segment (seg D F') ∧ Segment (seg D E) by DEF', B1', SEGMENT; seg A C ≡ seg D F' ∧ seg A B ≡ seg D E [ABeqDE] by segs, -, DF'eqAC, C2Symmetric, DEeqAB; F' ∈ ray D E â” D ∧ F ∈ ray D E â” D by DEF', IntervalRayEZ, ErDF, IN_Ray, H1, IN_DELETE; F' = F by ErDF, segs, -, DF'eqAC, DFeqAC, C1; qed by -, DEF', ABeqDE; `;; let SegmentSubtraction = thm `; let A B C A' B' C' be point; assume B ∈ open (A,C) ∧ B' ∈ open (A',C') [H1]; assume seg A B ≡ seg A' B' [H2]; assume seg A C ≡ seg A' C' [H3]; thus seg B C ≡ seg B' C' proof ¬(A = B) ∧ ¬(A = C) ∧ Collinear A B C ∧ Segment (seg A' C') ∧ Segment (seg B' C') [Distinct] by H1, B1', SEGMENT; consider Q such that B ∈ open (A,Q) ∧ seg B Q ≡ seg B' C' [defQ] by -, C1OppositeRay; seg A Q ≡ seg A' C' [AQ_A'C'] by H1, H2, -, C3; ¬(A = Q) ∧ Collinear A B Q ∧ A ∉ open (C,B) ∧ A ∉ open (Q,B) by defQ, B1', H1, B3', ∉; C ∈ ray A B â” A ∧ Q ∈ ray A B â” A by Distinct, -, IN_Ray, IN_DELETE; C = Q by Distinct, -, AQ_A'C', H3, C1; qed by defQ, -; `;; let SegmentOrderingUse = thm `; let A B be point; let s be point_set; assume Segment s ∧ ¬(A = B) [H1]; assume s <__ seg A B [H2]; thus ∃ G. G ∈ open (A,B) ∧ s ≡ seg A G proof consider A' B' G' such that seg A B = seg A' B' ∧ G' ∈ open (A',B') ∧ s ≡ seg A' G' [H2'] by H2, SegmentOrdering_DEF; ¬(A' = G') ∧ ¬(A' = B') ∧ seg A' B' ≡ seg A B [A'notB'G'] by -, B1', H1, SEGMENT, C2Reflexive; consider G such that G ∈ open (A,B) ∧ seg A' G' ≡ seg A G [AGB] by A'notB'G', H1, H2', -, OrderedCongruentSegments; s ≡ seg A G by H1, A'notB'G', -, B1', SEGMENT, H2', C2Transitive; qed by AGB, -; `;; let SegmentTrichotomy1 = thm `; let s t be point_set; assume s <__ t [H1]; thus ¬(s ≡ t) proof consider A B G such that Segment s ∧ t = seg A B ∧ G ∈ open (A,B) ∧ s ≡ seg A G [H1'] by H1, SegmentOrdering_DEF; ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [Distinct] by H1', B1'; seg A B ≡ seg A B [ABrefl] by -, SEGMENT, C2Reflexive; G ∈ ray A B â” A ∧ B ∈ ray A B â” A by H1', IntervalRay, EndpointInRay, Distinct, IN_DELETE; ¬(seg A G ≡ seg A B) ∧ seg A G ≡ s by Distinct, SEGMENT, -, ABrefl, C1, H1', C2Symmetric; qed by Distinct, H1', SEGMENT, -, C2Transitive; `;; let SegmentTrichotomy2 = thm `; let s t u be point_set; assume s <__ t [H1]; assume Segment u ∧ t ≡ u [H2]; thus s <__ u proof consider A B P such that Segment s ∧ t = seg A B ∧ P ∈ open (A,B) ∧ s ≡ seg A P [H1'] by H1, SegmentOrdering_DEF; ¬(A = B) ∧ ¬(A = P) [Distinct] by -, B1'; consider X Y such that u = seg X Y ∧ ¬(X = Y) [uXY] by H2, SEGMENT; consider Q such that Q ∈ open (X,Y) ∧ seg A P ≡ seg X Q [XQY] by Distinct, -, H1', H2, OrderedCongruentSegments; ¬(X = Q) ∧ s ≡ seg X Q by -, B1', H1', Distinct, SEGMENT, XQY, C2Transitive; qed by H1', uXY, XQY, -, SegmentOrdering_DEF; `;; let SegmentOrderTransitivity = thm `; let s t u be point_set; assume s <__ t ∧ t <__ u [H1]; thus s <__ u proof consider A B G such that u = seg A B ∧ G ∈ open (A,B) ∧ t ≡ seg A G [H1'] by H1, SegmentOrdering_DEF; ¬(A = B) ∧ ¬(A = G) ∧ Segment s [Distinct] by H1', B1', H1, SegmentOrdering_DEF; s <__ seg A G by H1, H1', Distinct, SEGMENT, SegmentTrichotomy2; consider F such that F ∈ open (A,G) ∧ s ≡ seg A F [AFG] by Distinct, -, SegmentOrderingUse; F ∈ open (A,B) by H1', IntervalsAreConvex, -, SUBSET; qed by Distinct, H1', -, AFG, SegmentOrdering_DEF; `;; let SegmentTrichotomy = thm `; let s t be point_set; assume Segment s ∧ Segment t [H1]; thus (s ≡ t ∨ s <__ t ∨ t <__ s) ∧ ¬(s ≡ t ∧ s <__ t) ∧ ¬(s ≡ t ∧ t <__ s) ∧ ¬(s <__ t ∧ t <__ s) proof ¬(s ≡ t ∧ s <__ t) [Not12] proof assume s <__ t; qed by -, SegmentTrichotomy1; ¬(s ≡ t ∧ t <__ s) [Not13] proof assume t <__ s; ¬(t ≡ s) by -, SegmentTrichotomy1; qed by H1, -, C2Symmetric; ¬(s <__ t ∧ t <__ s) [Not23] proof assume s <__ t ∧ t <__ s; s <__ s by H1, -, SegmentOrderTransitivity; qed by -, SegmentTrichotomy1, H1, C2Reflexive; consider O P such that s = seg O P ∧ ¬(O = P) [sOP] by H1, SEGMENT; consider Q such that Q ∈ ray O P â” O ∧ seg O Q ≡ t [QrOP] by H1, -, C1; O ∉ open (Q,P) ∧ Collinear O P Q ∧ ¬(O = Q) [notQOP] by -, IN_DELETE, IN_Ray; s ≡ seg O P ∧ t ≡ seg O Q ∧ seg O Q ≡ t ∧ seg O P ≡ s [stOPQ] by H1, sOP, -, SEGMENT, QrOP, C2Reflexive, C2Symmetric; cases; suppose Q = P; s ≡ t by -, sOP, QrOP; qed by -, Not12, Not13, Not23; suppose ¬(Q = P); P ∈ open (O,Q) ∨ Q ∈ open (O,P) by sOP, -, notQOP, B3', B1', ∉; s <__ seg O Q ∨ t <__ seg O P by H1, -, stOPQ, SegmentOrdering_DEF; s <__ t ∨ t <__ s by -, H1, stOPQ, SegmentTrichotomy2; qed by -, Not12, Not13, Not23; end; `;; let C4Uniqueness = thm `; let O A B P be point; let l be point_set; assume Line l ∧ O ∈ l ∧ A ∈ l ∧ ¬(O = A) [H1]; assume B ∉ l ∧ P ∉ l ∧ P,B same_side l [H2]; assume ∡ A O P ≡ ∡ A O B [H3]; thus ray O B = ray O P proof ¬(O = B) ∧ ¬(O = P) ∧ Ray (ray O B) ∧ Ray (ray O P) [Distinct] by H2, H1, ∉, RAY; ¬Collinear A O B ∧ B,B same_side l [Bsim_lB] by H1, H2, I1, Collinear_DEF, ∉, SameSideReflexive; Angle (∡ A O B) ∧ ∡ A O B ≡ ∡ A O B by -, ANGLE, C5Reflexive; qed by -, H1, H2, Distinct, Bsim_lB, H3, C4; `;; let AngleSymmetry = thm `; ∀ A O B. ∡ A O B = ∡ B O A by Angle_DEF, UNION_COMM; `;; let TriangleCongSymmetry = thm `; let A B C A' B' C' be point; assume A,B,C ≅ A',B',C' [H1]; thus A,C,B ≅ A',C',B' ∧ B,A,C ≅ B',A',C' ∧ B,C,A ≅ B',C',A' ∧ C,A,B ≅ C',A',B' ∧ C,B,A ≅ C',B',A' proof ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B' [H1'] by H1, TriangleCong_DEF; seg B A ≡ seg B' A' ∧ seg C A ≡ seg C' A' ∧ seg C B ≡ seg C' B' [segments] by H1', SegmentSymmetry; ∡ C B A ≡ ∡ C' B' A' ∧ ∡ A C B ≡ ∡ A' C' B' ∧ ∡ B A C ≡ ∡ B' A' C' by H1', AngleSymmetry; qed by CollinearSymmetry, H1', segments, -, TriangleCong_DEF; `;; let SAS = thm `; let A B C A' B' C' be point; assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; assume seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' [H2]; assume ∡ A B C ≡ ∡ A' B' C' [H3]; thus A,B,C ≅ A',B',C' proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(A' = C') [Distinct] by H1, NonCollinearImpliesDistinct; :: 134 consider c such that Line c ∧ A ∈ c ∧ B ∈ c [c_line] by Distinct, I1; C ∉ c [notCc] by H1, c_line, Collinear_DEF, ∉; ∡ B C A ≡ ∡ B' C' A' [BCAeq] by H1, H2, H3, C6; ∡ B A C ≡ ∡ B' A' C' [BACeq] by H1, CollinearSymmetry, H2, H3, AngleSymmetry, C6; consider Y such that Y ∈ ray A C â” A ∧ seg A Y ≡ seg A' C' [YrAC] by Distinct, SEGMENT, C1; Y ∉ c ∧ Y,C same_side c [Ysim_cC] by c_line, notCc, -, RaySameSide; ¬Collinear Y A B [YABncol] by c_line, -, Distinct, I1, Collinear_DEF, ∉; ray A Y = ray A C ∧ ∡ Y A B = ∡ C A B by Distinct, YrAC, RayWellDefined, Angle_DEF; ∡ Y A B ≡ ∡ C' A' B' by BACeq, -, AngleSymmetry; ∡ A B Y ≡ ∡ A' B' C' [ABYeq] by YABncol, H1, CollinearSymmetry, H2, SegmentSymmetry, YrAC, -, C6; Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A B Y) by H1, CollinearSymmetry, YABncol, ANGLE; ∡ A B Y ≡ ∡ A B C [ABYeqABC] by -, ABYeq, -, H3, C5Symmetric, C5Transitive; ray B C = ray B Y ∧ ¬(Y = B) ∧ Y ∈ ray B C by c_line, Distinct, notCc, Ysim_cC, ABYeqABC, C4Uniqueness, ∉, -, EndpointInRay; Collinear B C Y ∧ Collinear A C Y by -, YrAC, IN_DELETE, IN_Ray; C = Y by -, I1, Collinear_DEF, H1; seg A C ≡ seg A' C' by -, YrAC; qed by H1, H2, SegmentSymmetry, -, H3, BCAeq, BACeq, AngleSymmetry, TriangleCong_DEF; `;; let ASA = thm `; let A B C A' B' C' be point; assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; assume seg A C ≡ seg A' C' [H2]; assume ∡ C A B ≡ ∡ C' A' B' ∧ ∡ B C A ≡ ∡ B' C' A' [H3]; thus A,B,C ≅ A',B',C' proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(A' = C') ∧ ¬(B' = C') ∧ Segment (seg C' B') [Distinct] by H1, NonCollinearImpliesDistinct, SEGMENT; consider D such that D ∈ ray C B â” C ∧ seg C D ≡ seg C' B' ∧ ¬(D = C) [DrCB] by -, C1, IN_DELETE; Collinear C B D [CBDcol] by -, IN_DELETE, IN_Ray; ¬Collinear D C A ∧ Angle (∡ C A D) ∧ Angle (∡ C' A' B') ∧ Angle (∡ C A B) [DCAncol] by H1, CollinearSymmetry, -, DrCB, NoncollinearityExtendsToLine, H1, ANGLE; consider b such that Line b ∧ A ∈ b ∧ C ∈ b [b_line] by Distinct, I1; B ∉ b ∧ ¬(D = A) [notBb] by H1, -, Collinear_DEF, ∉, DCAncol, NonCollinearImpliesDistinct; D ∉ b ∧ D,B same_side b [Dsim_bB] by b_line, -, DrCB, RaySameSide; ray C D = ray C B by Distinct, DrCB, RayWellDefined; ∡ D C A ≡ ∡ B' C' A' by H3, -, Angle_DEF; D,C,A ≅ B',C',A' by DCAncol, H1, CollinearSymmetry, DrCB, H2, SegmentSymmetry, -, SAS; ∡ C A D ≡ ∡ C' A' B' by -, TriangleCong_DEF; ∡ C A D ≡ ∡ C A B by DCAncol, -, H3, C5Symmetric, C5Transitive; ray A B = ray A D ∧ D ∈ ray A B by b_line, Distinct, notBb, Dsim_bB, -, C4Uniqueness, notBb, EndpointInRay; Collinear A B D by -, IN_Ray; D = B by I1, -, Collinear_DEF, CBDcol, H1; seg C B ≡ seg C' B' by -, DrCB; B,C,A ≅ B',C',A' by H1, CollinearSymmetry, -, H2, SegmentSymmetry, H3, SAS; qed by -, TriangleCongSymmetry; `;; let AngleSubtraction = thm `; let A O B A' O' B' G G' be point; assume G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' [H1]; assume ∡ A O B ≡ ∡ A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' [H2]; thus ∡ G O B ≡ ∡ G' O' B' proof ¬Collinear A O B ∧ ¬Collinear A' O' B' [A'O'B'ncol] by H1, IN_InteriorAngle; ¬(A = O) ∧ ¬(O = B) ∧ ¬(G = O) ∧ ¬(G' = O') ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SEGMENT; consider X Y such that X ∈ ray O A â” O ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B â” O ∧ seg O Y ≡ seg O' B' [XYexists] by -, C1; G ∈ int_angle X O Y [GintXOY] by H1, XYexists, InteriorWellDefined, InteriorAngleSymmetry; consider H H' such that H ∈ open (X,Y) ∧ H ∈ ray O G â” O ∧ H' ∈ open (A',B') ∧ H' ∈ ray O' G' â” O' [Hexists] by -, H1, Crossbar_THM; H ∈ int_angle X O Y ∧ H' ∈ int_angle A' O' B' [HintXOY] by GintXOY, H1, -, WholeRayInterior; ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G ∧ ray O' H' = ray O' G' [Orays] by Distinct, XYexists, Hexists, RayWellDefined; ∡ X O Y ≡ ∡ A' O' B' ∧ ∡ X O H ≡ ∡ A' O' H' [H2'] by H2, -, Angle_DEF; ¬Collinear X O Y by GintXOY, IN_InteriorAngle; X,O,Y ≅ A',O',B' by -, A'O'B'ncol, H2', XYexists, SAS; seg X Y ≡ seg A' B' ∧ ∡ O Y X ≡ ∡ O' B' A' ∧ ∡ Y X O ≡ ∡ B' A' O' [XOYcong] by -, TriangleCong_DEF; ¬Collinear O H X ∧ ¬Collinear O' H' A' ∧ ¬Collinear O Y H ∧ ¬Collinear O' B' H' [OHXncol] by HintXOY, InteriorEZHelp, InteriorAngleSymmetry, CollinearSymmetry; ray X H = ray X Y ∧ ray A' H' = ray A' B' ∧ ray Y H = ray Y X ∧ ray B' H' = ray B' A' [Hrays] by Hexists, B1', IntervalRay; ∡ H X O ≡ ∡ H' A' O' by XOYcong, -, Angle_DEF; O,H,X ≅ O',H',A' by OHXncol, XYexists, -, H2', ASA; seg X H ≡ seg A' H' by -, TriangleCong_DEF, SegmentSymmetry; seg H Y ≡ seg H' B' by Hexists, XOYcong, -, SegmentSubtraction; seg Y O ≡ seg B' O' ∧ seg Y H ≡ seg B' H' [YHeq] by XYexists, -, SegmentSymmetry; ∡ O Y H ≡ ∡ O' B' H' by XOYcong, Hrays, Angle_DEF; O,Y,H ≅ O',B',H' by OHXncol, YHeq, -, SAS; ∡ H O Y ≡ ∡ H' O' B' by -, TriangleCong_DEF; qed by -, Orays, Angle_DEF; `;; let OrderedCongruentAngles = thm `; let A O B A' O' B' G be point; assume ¬Collinear A' O' B' [H1]; assume ∡ A O B ≡ ∡ A' O' B' [H2]; assume G ∈ int_angle A O B [H3]; thus ∃ G'. G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' proof ¬Collinear A O B [AOBncol] by H3, IN_InteriorAngle; ¬(A = O) ∧ ¬(O = B) ∧ ¬(A' = B') ∧ ¬(O = G) ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by AOBncol, H1, NonCollinearImpliesDistinct, H3, InteriorEZHelp, SEGMENT; consider X Y such that X ∈ ray O A â” O ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B â” O ∧ seg O Y ≡ seg O' B' [defXY] by -, C1; G ∈ int_angle X O Y [GintXOY] by H3, -, InteriorWellDefined, InteriorAngleSymmetry; ¬Collinear X O Y ∧ ¬(X = Y) [XOYncol] by -, IN_InteriorAngle, NonCollinearImpliesDistinct; consider H such that H ∈ open (X,Y) ∧ H ∈ ray O G â” O [defH] by GintXOY, Crossbar_THM; ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G [Orays] by Distinct, defXY, -, RayWellDefined; ∡ X O Y ≡ ∡ A' O' B' by H2, -, Angle_DEF; X,O,Y ≅ A',O',B' by XOYncol, H1, defXY, -, SAS; seg X Y ≡ seg A' B' ∧ ∡ O X Y ≡ ∡ O' A' B' [YXOcong] by -, TriangleCong_DEF, AngleSymmetry; consider G' such that G' ∈ open (A',B') ∧ seg X H ≡ seg A' G' [A'G'B'] by XOYncol, Distinct, -, defH, OrderedCongruentSegments; G' ∈ int_angle A' O' B' [G'intA'O'B'] by H1, -, ConverseCrossbar; ray X H = ray X Y ∧ ray A' G' = ray A' B' by defH, A'G'B', IntervalRay; ∡ O X H ≡ ∡ O' A' G' [HXOeq] by -, Angle_DEF, YXOcong; H ∈ int_angle X O Y by GintXOY, defH, WholeRayInterior; ¬Collinear O X H ∧ ¬Collinear O' A' G' by -, G'intA'O'B', InteriorEZHelp, CollinearSymmetry; O,X,H ≅ O',A',G' by -, A'G'B', defXY, SegmentSymmetry, HXOeq, SAS; ∡ X O H ≡ ∡ A' O' G' by -, TriangleCong_DEF, AngleSymmetry; ∡ A O G ≡ ∡ A' O' G' by -, Orays, Angle_DEF; qed by G'intA'O'B', -; `;; let AngleAddition = thm `; let A O B A' O' B' G G' be point; assume G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' [H1]; assume ∡ A O G ≡ ∡ A' O' G' ∧ ∡ G O B ≡ ∡ G' O' B' [H2]; thus ∡ A O B ≡ ∡ A' O' B' proof ¬Collinear A O B ∧ ¬Collinear A' O' B' [AOBncol] by H1, IN_InteriorAngle; ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(A' = O') ∧ ¬(A' = B') ∧ ¬(O' = B') ∧ ¬(G = O) [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp; consider a b such that Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b [a_line] by Distinct, I1; consider g such that Line g ∧ O ∈ g ∧ G ∈ g [g_line] by Distinct, I1; G ∉ a ∧ G,B same_side a [H1'] by a_line, H1, InteriorUse; ¬Collinear A O G ∧ ¬Collinear A' O' G' [AOGncol] by H1, InteriorEZHelp, IN_InteriorAngle; Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A O G) ∧ Angle (∡ A' O' G') [angles] by AOBncol, -, ANGLE; ∃! r. Ray r ∧ ∃ X. ¬(O = X) ∧ r = ray O X ∧ X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' by -, Distinct, a_line, H1', C4; consider X such that X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' [Xexists] by -; ¬Collinear A O X [AOXncol] by -, a_line, Distinct, I1, Collinear_DEF, ∉; ∡ A' O' B' ≡ ∡ A O X by -, AOBncol, ANGLE, Xexists, C5Symmetric; consider Y such that Y ∈ int_angle A O X ∧ ∡ A' O' G' ≡ ∡ A O Y [YintAOX] by AOXncol, -, H1, OrderedCongruentAngles; ¬Collinear A O Y by -, InteriorEZHelp; ∡ A O Y ≡ ∡ A O G [AOGeq] by -, angles, -, ANGLE, YintAOX, H2, C5Transitive, C5Symmetric; consider x such that Line x ∧ O ∈ x ∧ X ∈ x by Distinct, I1; Y ∉ a ∧ Y,X same_side a by a_line, -, YintAOX, InteriorUse; Y ∉ a ∧ Y,G same_side a by a_line, -, Xexists, H1', SameSideTransitive; ray O G = ray O Y by a_line, Distinct, H1', -, AOGeq, C4Uniqueness; G ∈ ray O Y â” O by Distinct, -, EndpointInRay, IN_DELETE; G ∈ int_angle A O X [GintAOX] by YintAOX, -, WholeRayInterior; ∡ G O X ≡ ∡ G' O' B' [GOXeq] by -, H1, Xexists, H2, AngleSubtraction; ¬Collinear G O X ∧ ¬Collinear G O B ∧ ¬Collinear G' O' B' [GOXncol] by GintAOX, H1, InteriorAngleSymmetry, InteriorEZHelp, CollinearSymmetry; Angle (∡ G O X) ∧ Angle (∡ G O B) ∧ Angle (∡ G' O' B') by -, ANGLE; ∡ G O X ≡ ∡ G O B [G'O'Xeq] by angles, -, GOXeq, C5Symmetric, H2, C5Transitive; ¬(A,X same_side g) ∧ ¬(A,B same_side g) [Ansim_aXB] by g_line, GintAOX, H1, InteriorOpposite; A ∉ g ∧ B ∉ g ∧ X ∉ g [notABXg] by g_line, AOGncol, GOXncol, Distinct, I1, Collinear_DEF, ∉; X,B same_side g by g_line, -, Ansim_aXB, AtMost2Sides; ray O X = ray O B by g_line, Distinct, notABXg, -, G'O'Xeq, C4Uniqueness; qed by -, Xexists, Angle_DEF; `;; let AngleOrderingUse = thm `; let A O B be point; let α be point_set; assume Angle α ∧ ¬Collinear A O B [H1]; assume α <_ang ∡ A O B [H3]; thus ∃ G. G ∈ int_angle A O B ∧ α ≡ ∡ A O G proof consider A' O' B' G' such that ¬Collinear A' O' B' ∧ ∡ A O B = ∡ A' O' B' ∧ G' ∈ int_angle A' O' B' ∧ α ≡ ∡ A' O' G' [H3'] by H3, AngleOrdering_DEF; Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A' O' G') [angles] by H1, -, ANGLE, InteriorEZHelp; ∡ A' O' B' ≡ ∡ A O B by -, H3', C5Reflexive; consider G such that G ∈ int_angle A O B ∧ ∡ A' O' G' ≡ ∡ A O G [GintAOB] by H1, H3', -, OrderedCongruentAngles; α ≡ ∡ A O G by H1, angles, -, InteriorEZHelp, ANGLE, H3', GintAOB, C5Transitive; qed by -, GintAOB; `;; let AngleTrichotomy1 = thm `; let α β be point_set; assume α <_ang β [H1]; thus ¬(α ≡ β) proof assume α ≡ β [Con]; consider A O B G such that Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by H1, AngleOrdering_DEF; ¬(A = O) ∧ ¬(O = B) ∧ ¬Collinear A O G [Distinct] by H1', NonCollinearImpliesDistinct, InteriorEZHelp; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by Distinct, I1; consider b such that Line b ∧ O ∈ b ∧ B ∈ b [b_line] by Distinct, I1; B ∉ a [notBa] by a_line, H1', Collinear_DEF, ∉; G ∉ a ∧ G ∉ b ∧ G,B same_side a [GintAOB] by a_line, b_line, H1', InteriorUse; ∡ A O G ≡ α by H1', Distinct, ANGLE, C5Symmetric; ∡ A O G ≡ ∡ A O B by H1', Distinct, ANGLE, -, Con, C5Transitive; ray O B = ray O G by a_line, Distinct, notBa, GintAOB, -, C4Uniqueness; G ∈ b by Distinct, -, EndpointInRay, b_line, RayLine, SUBSET; qed by -, GintAOB, ∉; `;; let AngleTrichotomy2 = thm `; let α β γ be point_set; assume α <_ang β [H1]; assume Angle γ [H2]; assume β ≡ γ [H3]; thus α <_ang γ proof consider A O B G such that Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by H1, AngleOrdering_DEF; consider A' O' B' such that γ = ∡ A' O' B' ∧ ¬Collinear A' O' B' [γA'O'B'] by H2, ANGLE; consider G' such that G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' [G'intA'O'B'] by γA'O'B', H1', H3, OrderedCongruentAngles; ¬Collinear A O G ∧ ¬Collinear A' O' G' [ncol] by H1', -, InteriorEZHelp; α ≡ ∡ A' O' G' by H1', ANGLE, -, G'intA'O'B', C5Transitive; qed by H1', -, ncol, γA'O'B', G'intA'O'B', -, AngleOrdering_DEF; `;; let AngleOrderTransitivity = thm `; let α β γ be point_set; assume α <_ang β [H0]; assume β <_ang γ [H2]; thus α <_ang γ proof consider A O B G such that Angle β ∧ ¬Collinear A O B ∧ γ = ∡ A O B ∧ G ∈ int_angle A O B ∧ β ≡ ∡ A O G [H2'] by H2, AngleOrdering_DEF; ¬Collinear A O G [AOGncol] by H2', InteriorEZHelp; Angle α ∧ Angle (∡ A O G) ∧ Angle γ [angles] by H0, AngleOrdering_DEF, H2', -, ANGLE; α <_ang ∡ A O G by H0, H2', -, AngleTrichotomy2; consider F such that F ∈ int_angle A O G ∧ α ≡ ∡ A O F [FintAOG] by angles, AOGncol, -, AngleOrderingUse; F ∈ int_angle A O B by H2', -, InteriorTransitivity; qed by angles, H2', -, FintAOG, AngleOrdering_DEF; `;; let AngleTrichotomy = thm `; let α β be point_set; assume Angle α ∧ Angle β [H1]; thus (α ≡ β ∨ α <_ang β ∨ β <_ang α) ∧ ¬(α ≡ β ∧ α <_ang β) ∧ ¬(α ≡ β ∧ β <_ang α) ∧ ¬(α <_ang β ∧ β <_ang α) proof ¬(α ≡ β ∧ α <_ang β) [Not12] by AngleTrichotomy1; ¬(α ≡ β ∧ β <_ang α) [Not13] by H1, C5Symmetric, AngleTrichotomy1; ¬(α <_ang β ∧ β <_ang α) [Not23] by H1, AngleOrderTransitivity, AngleTrichotomy1, C5Reflexive; consider P O A such that α = ∡ P O A ∧ ¬Collinear P O A [POA] by H1, ANGLE; ¬(P = O) ∧ ¬(O = A) [Distinct] by -, NonCollinearImpliesDistinct; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by -, I1; P ∉ a [notPa] by -, Distinct, I1, POA, Collinear_DEF, ∉; ∃! r. Ray r ∧ ∃ Q. ¬(O = Q) ∧ r = ray O Q ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β by H1, Distinct, a_line, -, C4; consider Q such that ¬(O = Q) ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β [Qexists] by -; O ∉ open (Q,P) [notQOP] by a_line, Qexists, SameSide_DEF, ∉; ¬Collinear A O P [AOPncol] by POA, CollinearSymmetry; ¬Collinear A O Q [AOQncol] by a_line, Distinct, I1, Collinear_DEF, Qexists, ∉; Angle (∡ A O P) ∧ Angle (∡ A O Q) by AOPncol, -, ANGLE; α ≡ ∡ A O P ∧ β ≡ ∡ A O Q ∧ ∡ A O P ≡ α [flip] by H1, -, POA, AngleSymmetry, C5Reflexive, Qexists, C5Symmetric; cases; suppose Collinear Q O P; Collinear O P Q by -, CollinearSymmetry; Q ∈ ray O P â” O by Distinct, -, notQOP, IN_Ray, Qexists, IN_DELETE; ray O Q = ray O P by Distinct, -, RayWellDefined; ∡ P O A = ∡ A O Q by -, Angle_DEF, AngleSymmetry; α ≡ β by -, POA, Qexists; qed by -, Not12, Not13, Not23; suppose ¬Collinear Q O P; P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A by Distinct, a_line, Qexists, notPa, -, AngleOrdering; P ∈ int_angle A O Q ∨ Q ∈ int_angle A O P by -, InteriorAngleSymmetry; α <_ang ∡ A O Q ∨ β <_ang ∡ A O P by H1, AOQncol, AOPncol, -, flip, AngleOrdering_DEF; α <_ang β ∨ β <_ang α by H1, -, Qexists, flip, AngleTrichotomy2; qed by -, Not12, Not13, Not23; end; `;; let SupplementExists = thm `; let α be point_set; assume Angle α [H1]; thus ∃ α'. α suppl α' proof consider A O B such that α = ∡ A O B ∧ ¬Collinear A O B ∧ ¬(A = O) [def_α] by H1, ANGLE, NonCollinearImpliesDistinct; consider A' such that O ∈ open (A,A') by -, B2'; ∡ A O B suppl ∡ A' O B [AOBsup] by def_α, -, SupplementaryAngles_DEF, AngleSymmetry; qed by -, def_α; `;; let SupplementImpliesAngle = thm `; let α β be point_set; assume α suppl β [H1]; thus Angle α ∧ Angle β proof consider A O B A' such that ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by H1, SupplementaryAngles_DEF; ¬(O = A') ∧ Collinear A O A' [Distinct] by -, NonCollinearImpliesDistinct, B1'; ¬Collinear B O A' by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; qed by H1', -, ANGLE; `;; let RightImpliesAngle = thm `; ∀ α: point_set. Right α ⇒ Angle α by RightAngle_DEF, SupplementImpliesAngle; `;; let SupplementSymmetry = thm `; let α β be point_set; assume α suppl β [H1]; thus β suppl α proof consider A O B A' such that ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by H1, SupplementaryAngles_DEF; ¬(O = A') ∧ Collinear A O A' by -, NonCollinearImpliesDistinct, B1'; ¬Collinear A' O B [A'OBncol] by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; O ∈ open (A',A) ∧ β = ∡ A' O B ∧ α = ∡ B O A by H1', B1', AngleSymmetry; qed by A'OBncol, -, SupplementaryAngles_DEF; `;; let SupplementsCongAnglesCong = thm `; let α β α' β' be point_set; assume α suppl α' ∧ β suppl β' [H1]; assume α ≡ β [H2]; thus α' ≡ β' proof consider A O B A' such that ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by H1, SupplementaryAngles_DEF; ¬(A = O) ∧ ¬(O = B) ∧ ¬(A = A') ∧ ¬(O = A') ∧ Collinear A O A' [Distinctα] by -, NonCollinearImpliesDistinct, B1'; ¬Collinear B A A' ∧ ¬Collinear O A' B [BAA'ncol] by def_α, CollinearSymmetry, -, NoncollinearityExtendsToLine; Segment (seg O A) ∧ Segment (seg O B) ∧ Segment (seg O A') [Osegments] by Distinctα, SEGMENT; consider C P D C' such that ¬Collinear C P D ∧ P ∈ open (C,C') ∧ β = ∡ C P D ∧ β' = ∡ D P C' [def_β] by H1, SupplementaryAngles_DEF; ¬(C = P) ∧ ¬(P = D) ∧ ¬(P = C') [Distinctβ] by def_β, NonCollinearImpliesDistinct, B1'; consider X such that X ∈ ray P C â” P ∧ seg P X ≡ seg O A [defX] by Osegments, Distinctβ, C1; consider Y such that Y ∈ ray P D â” P ∧ seg P Y ≡ seg O B ∧ ¬(Y = P) [defY] by Osegments, Distinctβ, C1, IN_DELETE; consider X' such that X' ∈ ray P C' â” P ∧ seg P X' ≡ seg O A' [defX'] by Osegments, Distinctβ, C1; P ∈ open (X',C) ∧ P ∈ open (X,X') [XPX'] by def_β, -, OppositeRaysIntersect1pointHelp, defX; ¬(X = P) ∧ ¬(X' = P) ∧ Collinear X P X' ∧ ¬(X = X') ∧ ray A' O = ray A' A ∧ ray X' P = ray X' X [XPX'line] by defX, defX', IN_DELETE, -, B1', def_α, IntervalRay; Collinear P D Y ∧ Collinear P C X by defY, defX, IN_DELETE, IN_Ray; ¬Collinear C P Y ∧ ¬Collinear X P Y [XPYncol] by def_β, -, defY, NoncollinearityExtendsToLine, CollinearSymmetry, XPX'line; ¬Collinear Y X X' ∧ ¬Collinear P X' Y [YXX'ncol] by -, CollinearSymmetry, XPX', XPX'line, NoncollinearityExtendsToLine; ray P X = ray P C ∧ ray P Y = ray P D ∧ ray P X' = ray P C' [equalPrays] by Distinctβ, defX, defY, defX', RayWellDefined; β = ∡ X P Y ∧ β' = ∡ Y P X' ∧ ∡ A O B ≡ ∡ X P Y [AOBeqXPY] by def_β, -, Angle_DEF, H2, def_α; seg O A ≡ seg P X ∧ seg O B ≡ seg P Y ∧ seg A' O ≡ seg X' P [OAeq] by Osegments, XPX'line, SEGMENT, defX, defY, defX', C2Symmetric, SegmentSymmetry; seg A A' ≡ seg X X' [AA'eq] by def_α, XPX'line, XPX', -, SegmentSymmetry, C3; A,O,B ≅ X,P,Y by def_α, XPYncol, OAeq, AOBeqXPY, SAS; seg A B ≡ seg X Y ∧ ∡ B A O ≡ ∡ Y X P [AOB≅] by -, TriangleCong_DEF, AngleSymmetry; ray A O = ray A A' ∧ ray X P = ray X X' ∧ ∡ B A A' ≡ ∡ Y X X' by def_α, XPX', IntervalRay, -, Angle_DEF; B,A,A' ≅ Y,X,X' by BAA'ncol, YXX'ncol, AOB≅, -, AA'eq, -, SAS; seg A' B ≡ seg X' Y ∧ ∡ A A' B ≡ ∡ X X' Y by -, TriangleCong_DEF, SegmentSymmetry; O,A',B ≅ P,X',Y by BAA'ncol, YXX'ncol, OAeq, -, XPX'line, Angle_DEF, SAS; ∡ B O A' ≡ ∡ Y P X' by -, TriangleCong_DEF; qed by -, equalPrays, def_β, Angle_DEF, def_α; `;; let SupplementUnique = thm `; ∀ α β β': point_set. α suppl β ∧ α suppl β' ⇒ β ≡ β' by SupplementaryAngles_DEF, ANGLE, C5Reflexive, SupplementsCongAnglesCong; `;; let CongRightImpliesRight = thm `; let α β be point_set; assume Angle α ∧ Right β [H1]; assume α ≡ β [H2]; thus Right α proof consider α' β' such that α suppl α' ∧ β suppl β' ∧ β ≡ β' [suppl] by H1, SupplementExists, H1, RightAngle_DEF; α' ≡ β' [α'eqβ'] by suppl, H2, SupplementsCongAnglesCong; Angle β ∧ Angle α' ∧ Angle β' by suppl, SupplementImpliesAngle; α ≡ α' by H1, -, H2, suppl, α'eqβ', C5Symmetric, C5Transitive; qed by suppl, -, RightAngle_DEF; `;; let RightAnglesCongruentHelp = thm `; let A O B A' P be point; let a be point_set; assume ¬Collinear A O B ∧ O ∈ open (A,A') [H1]; assume Right (∡ A O B) ∧ Right (∡ A O P) [H2]; thus P ∉ int_angle A O B proof assume ¬(P ∉ int_angle A O B); P ∈ int_angle A O B [PintAOB] by -, ∉; B ∈ int_angle P O A' ∧ B ∈ int_angle A' O P [BintA'OP] by H1, -, InteriorReflectionInterior, InteriorAngleSymmetry ; ¬Collinear A O P ∧ ¬Collinear P O A' [AOPncol] by PintAOB, InteriorEZHelp, -, IN_InteriorAngle; ∡ A O B suppl ∡ B O A' ∧ ∡ A O P suppl ∡ P O A' [AOBsup] by H1, -, SupplementaryAngles_DEF; consider α' β' such that ∡ A O B suppl α' ∧ ∡ A O B ≡ α' ∧ ∡ A O P suppl β' ∧ ∡ A O P ≡ β' [supplα'] by H2, RightAngle_DEF; α' ≡ ∡ B O A' ∧ β' ≡ ∡ P O A' [α'eqA'OB] by -, AOBsup, SupplementUnique; Angle (∡ A O B) ∧ Angle α' ∧ Angle (∡ B O A') ∧ Angle (∡ A O P) ∧ Angle β' ∧ Angle (∡ P O A') [angles] by AOBsup, supplα', SupplementImpliesAngle, AngleSymmetry; ∡ A O B ≡ ∡ B O A' ∧ ∡ A O P ≡ ∡ P O A' [H2'] by -, supplα', α'eqA'OB, C5Transitive; ∡ A O P ≡ ∡ A O P ∧ ∡ B O A' ≡ ∡ B O A' [refl] by angles, C5Reflexive; ∡ A O P <_ang ∡ A O B ∧ ∡ B O A' <_ang ∡ P O A' [BOA'lessPOA'] by angles, H1, PintAOB, -, AngleOrdering_DEF, AOPncol, CollinearSymmetry, BintA'OP, AngleSymmetry; ∡ A O P <_ang ∡ B O A' by -, angles, H2', AngleTrichotomy2; ∡ A O P <_ang ∡ P O A' by -, BOA'lessPOA', AngleOrderTransitivity; qed by -, H2', AngleTrichotomy1; `;; let RightAnglesCongruent = thm `; let α β be point_set; assume Right α ∧ Right β [H1]; thus α ≡ β proof consider α' such that α suppl α' ∧ α ≡ α' by H1, RightAngle_DEF; consider A O B A' such that ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by -, SupplementaryAngles_DEF; ¬(A = O) ∧ ¬(O = B) [Distinct] by def_α, NonCollinearImpliesDistinct, B1'; consider a such that Line a ∧ O ∈ a ∧ A ∈ a [a_line] by Distinct, I1; B ∉ a [notBa] by -, def_α, Collinear_DEF, ∉; Angle β by H1, RightImpliesAngle; ∃! r. Ray r ∧ ∃ P. ¬(O = P) ∧ r = ray O P ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β by -, Distinct, a_line, notBa, C4; consider P such that ¬(O = P) ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β [defP] by -; O ∉ open (P,B) [notPOB] by a_line, -, SameSide_DEF, ∉; ¬Collinear A O P [AOPncol] by a_line, Distinct, I1, defP, Collinear_DEF, ∉; Right (∡ A O P) [AOPright] by -, ANGLE, H1, defP, CongRightImpliesRight; P ∉ int_angle A O B ∧ B ∉ int_angle A O P by def_α, H1, -, AOPncol, AOPright, RightAnglesCongruentHelp; Collinear P O B by Distinct, a_line, defP, notBa, -, AngleOrdering, InteriorAngleSymmetry, ∉; P ∈ ray O B â” O by Distinct, -, CollinearSymmetry, notPOB, IN_Ray, defP, IN_DELETE; ray O P = ray O B ∧ ∡ A O P = ∡ A O B by Distinct, -, RayWellDefined, Angle_DEF; qed by -, defP, def_α; `;; let OppositeRightAnglesLinear = thm `; let A B O H be point; let h be point_set; assume ¬Collinear A O H ∧ ¬Collinear H O B [H0]; assume Right (∡ A O H) ∧ Right (∡ H O B) [H1]; assume Line h ∧ O ∈ h ∧ H ∈ h ∧ ¬(A,B same_side h) [H2]; thus O ∈ open (A,B) proof ¬(A = O) ∧ ¬(O = H) ∧ ¬(O = B) [Distinct] by H0, NonCollinearImpliesDistinct; A ∉ h ∧ B ∉ h [notABh] by H0, H2, Collinear_DEF, ∉; consider E such that O ∈ open (A,E) ∧ ¬(E = O) [AOE] by Distinct, B2', B1'; ∡ A O H suppl ∡ H O E [AOHsupplHOE] by H0, -, SupplementaryAngles_DEF; E ∉ h [notEh] by H2, ∉, AOE, BetweenLinear, notABh; ¬(A,E same_side h) by H2, AOE, SameSide_DEF; B,E same_side h [Bsim_hE] by H2, notABh, notEh, -, H2, AtMost2Sides; consider α' such that ∡ A O H suppl α' ∧ ∡ A O H ≡ α' [AOHsupplα'] by H1, RightAngle_DEF; Angle (∡ H O B) ∧ Angle (∡ A O H) ∧ Angle α' ∧ Angle (∡ H O E) [angα'] by H1, RightImpliesAngle, -, AOHsupplHOE, SupplementImpliesAngle; ∡ H O B ≡ ∡ A O H ∧ α' ≡ ∡ H O E by H1, RightAnglesCongruent, AOHsupplα', AOHsupplHOE, SupplementUnique; ∡ H O B ≡ ∡ H O E by angα', -, AOHsupplα', C5Transitive; ray O B = ray O E by H2, Distinct, notABh, notEh, Bsim_hE, -, C4Uniqueness; B ∈ ray O E â” O by Distinct, EndpointInRay, -, IN_DELETE; qed by AOE, -, OppositeRaysIntersect1pointHelp, B1'; `;; let RightImpliesSupplRight = thm `; let A O B A' be point; assume ¬Collinear A O B [H1]; assume O ∈ open (A,A') [H2]; assume Right (∡ A O B) [H3]; thus Right (∡ B O A') proof ∡ A O B suppl ∡ B O A' ∧ Angle (∡ A O B) ∧ Angle (∡ B O A') [AOBsuppl] by H1, H2, SupplementaryAngles_DEF, SupplementImpliesAngle; consider β such that ∡ A O B suppl β ∧ ∡ A O B ≡ β [βsuppl] by H3, RightAngle_DEF; Angle β ∧ β ≡ ∡ A O B [angβ] by -, SupplementImpliesAngle, C5Symmetric; ∡ B O A' ≡ β by AOBsuppl, βsuppl, SupplementUnique; ∡ B O A' ≡ ∡ A O B by AOBsuppl, angβ, -, βsuppl, C5Transitive; qed by AOBsuppl, H3, -, CongRightImpliesRight; `;; let IsoscelesCongBaseAngles = thm `; let A B C be point; assume ¬Collinear A B C [H1]; assume seg B A ≡ seg B C [H2]; thus ∡ C A B ≡ ∡ A C B proof ¬(A = B) ∧ ¬(B = C) ∧ ¬Collinear C B A [CBAncol] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; seg B C ≡ seg B A ∧ ∡ A B C ≡ ∡ C B A by -, SEGMENT, H2, C2Symmetric, H1, ANGLE, AngleSymmetry, C5Reflexive; A,B,C ≅ C,B,A by H1, CBAncol, H2, -, SAS; qed by -, TriangleCong_DEF; `;; let C4withC1 = thm `; let α l be point_set; let O A Y P Q be point; assume Angle α ∧ ¬(O = A) ∧ ¬(P = Q) [H1]; assume Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l [l_line]; thus ∃ N. ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α proof ∃! r. Ray r ∧ ∃ B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α by H1, l_line, C4; consider B such that ¬(O = B) ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α [Bexists] by -; consider N such that N ∈ ray O B â” O ∧ seg O N ≡ seg P Q [Nexists] by H1, -, SEGMENT, C1; ¬(O = N) [notON] by -, IN_DELETE; N ∉ l ∧ N,B same_side l [notNl] by l_line, Bexists, Nexists, RaySameSide; N,Y same_side l [Nsim_lY] by l_line, -, Bexists, SameSideTransitive; ray O N = ray O B ∧ ∡ A O N ≡ α by Bexists, Nexists, RayWellDefined, Angle_DEF; qed by notON, notNl, Nsim_lY, Nexists, -; `;; let C4OppositeSide = thm `; let α l be point_set; let O A Z P Q be point; assume Angle α ∧ ¬(O = A) ∧ ¬(P = Q) [H1]; assume Line l ∧ O ∈ l ∧ A ∈ l ∧ Z ∉ l [l_line]; thus ∃ N. ¬(O = N) ∧ N ∉ l ∧ ¬(Z,N same_side l) ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α proof ¬(Z = O) by l_line, ∉; consider Y such that O ∈ open (Z,Y) [ZOY] by -, B2'; ¬(O = Y) ∧ Collinear Z O Y by -, B1'; Y ∉ l [notYl] by l_line, I1, -, Collinear_DEF, ∉; consider N such that ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α [Nexists] by H1, l_line, notYl, C4withC1; ¬(Z,Y same_side l) by l_line, ZOY, SameSide_DEF; ¬(Z,N same_side l) by l_line, Nexists, notYl, -, SameSideTransitive; qed by -, Nexists; `;; let SSS = thm `; let A B C A' B' C' be point; assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; assume seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' [H2]; thus A,B,C ≅ A',B',C' proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; consider h such that Line h ∧ A ∈ h ∧ C ∈ h [h_line] by Distinct, I1; B ∉ h [notBh] by h_line, H1, ∉, Collinear_DEF; Segment (seg A B) ∧ Segment (seg C B) ∧ Segment (seg A' B') ∧ Segment (seg C' B') [segments] by Distinct, -, SEGMENT; Angle (∡ C' A' B') by H1, CollinearSymmetry, ANGLE; consider N such that ¬(A = N) ∧ N ∉ h ∧ ¬(B,N same_side h) ∧ seg A N ≡ seg A' B' ∧ ∡ C A N ≡ ∡ C' A' B' [Nexists] by -, Distinct, h_line, notBh, C4OppositeSide; ¬(C = N) by h_line, Nexists, ∉; Segment (seg A N) ∧ Segment (seg C N) [segN] by Nexists, -, SEGMENT; ¬Collinear A N C [ANCncol] by h_line, Distinct, I1, Collinear_DEF, Nexists, ∉; Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A N C) [angles] by H1, -, ANGLE; seg A B ≡ seg A N [ABeqAN] by segments, segN, Nexists, H2, C2Symmetric, C2Transitive; C,A,N ≅ C',A',B' by ANCncol, H1, CollinearSymmetry, H2, Nexists, SAS; ∡ A N C ≡ ∡ A' B' C' ∧ seg C N ≡ seg C' B' [ANCeq] by -, TriangleCong_DEF; seg C B ≡ seg C N [CBeqCN] by segments, segN, -, H2, SegmentSymmetry, C2Symmetric, C2Transitive; consider G such that G ∈ h ∧ G ∈ open (B,N) [BGN] by Nexists, h_line, SameSide_DEF; ¬(B = N) [notBN] by -, B1'; ray B G = ray B N ∧ ray N G = ray N B [Grays] by BGN, B1', IntervalRay; consider v such that Line v ∧ B ∈ v ∧ N ∈ v [v_line] by notBN, I1; G ∈ v ∧ ¬(h = v) by v_line, BGN, BetweenLinear, notBh, ∉; h ∩ v = {G} [hvG] by h_line, v_line, -, BGN, I1Uniqueness; ¬(G = A) ⇒ ∡ A B G ≡ ∡ A N G [ABGeqANG] proof assume ¬(G = A) [notGA]; A ∉ v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; ¬Collinear B A N by v_line, notBN, I1, Collinear_DEF, -, ∉; ∡ N B A ≡ ∡ B N A by -, ABeqAN, IsoscelesCongBaseAngles; ∡ G B A ≡ ∡ G N A by -, Grays, Angle_DEF, notGA; qed by -, AngleSymmetry; ¬(G = C) ⇒ ∡ G B C ≡ ∡ G N C [GBCeqGNC] proof assume ¬(G = C) [notGC]; C ∉ v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; ¬Collinear B C N by v_line, notBN, I1, Collinear_DEF, -, ∉; ∡ N B C ≡ ∡ B N C by -, CBeqCN, IsoscelesCongBaseAngles, AngleSymmetry; qed by -, Grays, Angle_DEF; ∡ A B C ≡ ∡ A N C proof cases; suppose G = A [GA]; ¬(G = C) by -, Distinct; qed by -, GBCeqGNC, GA; suppose G = C [GC]; ¬(G = A) by -, Distinct; qed by -, ABGeqANG, GC; suppose ¬(G = A) ∧ ¬(G = C) [AGCdistinct]; ∡ A B G ≡ ∡ A N G ∧ ∡ G B C ≡ ∡ G N C [Gequivs] by -, ABGeqANG, GBCeqGNC; ¬Collinear G B C ∧ ¬Collinear G N C ∧ ¬Collinear G B A ∧ ¬Collinear G N A [Gncols] by h_line, BGN, AGCdistinct, I1, Collinear_DEF, notBh, Nexists, ∉; Collinear A G C by h_line, BGN, Collinear_DEF; G ∈ open (A,C) ∨ C ∈ open (G,A) ∨ A ∈ open (C,G) by Distinct, AGCdistinct, -, B3'; cases by -; suppose G ∈ open (A,C); G ∈ int_angle A B C ∧ G ∈ int_angle A N C by H1, ANCncol, -, ConverseCrossbar; qed by -, Gequivs, AngleAddition; suppose C ∈ open (G,A); C ∈ int_angle G B A ∧ C ∈ int_angle G N A by Gncols, -, B1', ConverseCrossbar; qed by -, Gequivs, AngleSubtraction, AngleSymmetry; suppose A ∈ open (C,G); A ∈ int_angle G B C ∧ A ∈ int_angle G N C by Gncols, -, B1', ConverseCrossbar; qed by -, Gequivs, AngleSymmetry, AngleSubtraction; end; end; ∡ A B C ≡ ∡ A' B' C' by angles, -, ANCeq, C5Transitive; qed by H1, H2, SegmentSymmetry, -, SAS; `;; let AngleBisector = thm `; let A B C be point; assume ¬Collinear B A C [H1]; thus ∃ F. F ∈ int_angle B A C ∧ ∡ B A F ≡ ∡ F A C proof ¬(A = B) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; consider D such that B ∈ open (A,D) [ABD] by Distinct, B2'; ¬(A = D) ∧ Collinear A B D ∧ Segment (seg A D) [ABD'] by -, B1', SEGMENT; consider E such that E ∈ ray A C â” A ∧ seg A E ≡ seg A D ∧ ¬(A = E) [ErAC] by -, Distinct, C1, IN_DELETE, IN_Ray; Collinear A C E ∧ D ∈ ray A B â” A [notAE] by ErAC, IN_DELETE, IN_Ray, ABD, IntervalRayEZ; ray A D = ray A B ∧ ray A E = ray A C [equalrays] by Distinct, notAE, ErAC, RayWellDefined; ¬Collinear D A E ∧ ¬Collinear E A D ∧ ¬Collinear A E D [EADncol] by H1, ABD', notAE, ErAC, CollinearSymmetry, NoncollinearityExtendsToLine; ∡ D E A ≡ ∡ E D A [DEAeq] by EADncol, ErAC, IsoscelesCongBaseAngles; ¬Collinear E D A ∧ Angle (∡ E D A) ∧ ¬Collinear A D E ∧ ¬Collinear D E A [angEDA] by EADncol, CollinearSymmetry, ANGLE; ¬(D = E) [notDE] by EADncol, NonCollinearImpliesDistinct; consider h such that Line h ∧ D ∈ h ∧ E ∈ h [h_line] by -, I1; A ∉ h [notAh] by -, Collinear_DEF, EADncol, ∉; consider F such that ¬(D = F) ∧ F ∉ h ∧ ¬(A,F same_side h) ∧ seg D F ≡ seg D A ∧ ∡ E D F ≡ ∡ E D A [Fexists] by angEDA, notDE, ABD', h_line, -, C4OppositeSide; ¬(A = F) [notAF] by h_line, -, SameSideReflexive; ¬Collinear E D F ∧ ¬Collinear D E F ∧ ¬Collinear F E D [EDFncol] by h_line, notDE, I1, Collinear_DEF, Fexists, ∉; seg D E ≡ seg D E ∧ seg F A ≡ seg F A [FArefl] by notDE, notAF, SEGMENT, C2Reflexive; E,D,F ≅ E,D,A by EDFncol, angEDA, -, Fexists, SAS; seg F E ≡ seg A E ∧ ∡ F E D ≡ ∡ A E D [FED≅] by -, TriangleCong_DEF, SegmentSymmetry; ∡ E D A ≡ ∡ D E A ∧ ∡ E D A ≡ ∡ E D F ∧ ∡ D E A ≡ ∡ D E F [EDAeqEDF] by EDFncol, ANGLE, angEDA, Fexists, FED≅, DEAeq, C5Symmetric, AngleSymmetry; consider G such that G ∈ h ∧ G ∈ open (A,F) [AGF] by Fexists, h_line, SameSide_DEF; F ∈ ray A G â” A [FrAG] by -, IntervalRayEZ; consider v such that Line v ∧ A ∈ v ∧ F ∈ v ∧ G ∈ v [v_line] by notAF, I1, AGF, BetweenLinear; ¬(v = h) ∧ v ∩ h = {G} [vhG] by -, notAh, ∉, h_line, AGF, I1Uniqueness; D ∉ v [notDv] proof assume ¬(D ∉ v); D ∈ v ∧ D = G [DG] by h_line, -, ∉, vhG, IN_INTER, IN_SING; D ∈ open (A,F) by DG, AGF; ∡ E D A suppl ∡ E D F [EDAsuppl] by angEDA, -, SupplementaryAngles_DEF, AngleSymmetry; Right (∡ E D A) by EDAsuppl, EDAeqEDF, RightAngle_DEF; Right (∡ A E D) [RightAED] by angEDA, ANGLE, -, DEAeq, CongRightImpliesRight, AngleSymmetry; Right (∡ D E F) by EDFncol, ANGLE, -, FED≅, CongRightImpliesRight, AngleSymmetry; E ∈ open (A,F) by EADncol, EDFncol, RightAED, -, h_line, Fexists, OppositeRightAnglesLinear; E ∈ v ∧ E = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; qed by -, DG, notDE; E ∉ v [notEv] proof assume ¬(E ∉ v); E ∈ v ∧ E = G [EG] by h_line, -, ∉, vhG, IN_INTER, IN_SING; E ∈ open (A,F) by -, AGF; ∡ D E A suppl ∡ D E F [DEAsuppl] by EADncol, -, SupplementaryAngles_DEF, AngleSymmetry; Right (∡ D E A) [RightDEA] by DEAsuppl, EDAeqEDF, RightAngle_DEF; Right (∡ E D A) [RightEDA] by angEDA, RightDEA, EDAeqEDF, CongRightImpliesRight; Right (∡ E D F) by EDFncol, ANGLE, RightEDA, Fexists, CongRightImpliesRight; D ∈ open (A,F) by angEDA, EDFncol, RightEDA, AngleSymmetry, -, h_line, Fexists, OppositeRightAnglesLinear; D ∈ v ∧ D = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; qed by -, EG, notDE; ¬Collinear F A E ∧ ¬Collinear F A D ∧ ¬(F = E) [FAEncol] by v_line, notAF, I1, Collinear_DEF, notEv, notDv, ∉, NonCollinearImpliesDistinct; seg F E ≡ seg A D [FEeqAD] by -, ErAC, ABD', SEGMENT, FED≅, ErAC, C2Transitive; seg A D ≡ seg F D by SegmentSymmetry, ABD', Fexists, SEGMENT, C2Symmetric; seg F E ≡ seg F D by FAEncol, ABD', Fexists, SEGMENT, FEeqAD, -, C2Transitive; F,A,E ≅ F,A,D by FAEncol, FArefl, -, ErAC, SSS; ∡ F A E ≡ ∡ F A D [FAEeq] by -, TriangleCong_DEF; ∡ D A F ≡ ∡ F A E by FAEncol, ANGLE, FAEeq, C5Symmetric, AngleSymmetry; ∡ B A F ≡ ∡ F A C [BAFeqFAC] by -, equalrays, Angle_DEF; ¬(E,D same_side v) proof assume E,D same_side v; ray A D = ray A E by v_line, notAF, notDv, notEv, -, FAEeq, C4Uniqueness; qed by ABD', EndpointInRay, -, IN_Ray, EADncol; consider H such that H ∈ v ∧ H ∈ open (E,D) [EHD] by v_line, -, SameSide_DEF; H = G by -, h_line, BetweenLinear, IN_INTER, vhG, IN_SING; G ∈ int_angle E A D [GintEAD] by EADncol, -, EHD, ConverseCrossbar; F ∈ int_angle E A D [FintEAD] by GintEAD, FrAG, WholeRayInterior; B ∈ ray A D â” A ∧ C ∈ ray A E â” A by equalrays, Distinct, EndpointInRay, IN_DELETE; F ∈ int_angle B A C by FintEAD, -, InteriorWellDefined, InteriorAngleSymmetry; qed by -, BAFeqFAC; `;; let EuclidPropositionI_6 = thm `; let A B C be point; assume ¬Collinear A B C [H1]; assume ∡ B A C ≡ ∡ B C A [H2]; thus seg B A ≡ seg B C proof ¬(A = C) by H1, NonCollinearImpliesDistinct; seg C A ≡ seg A C [CAeqAC] by SegmentSymmetry, -, SEGMENT, C2Reflexive; ¬Collinear B C A ∧ ¬Collinear C B A ∧ ¬Collinear B A C [BCAncol] by H1, CollinearSymmetry; ∡ A C B ≡ ∡ C A B by -, ANGLE, H2, C5Symmetric, AngleSymmetry; C,B,A ≅ A,B,C by H1, BCAncol, CAeqAC, H2, -, ASA; qed by -, TriangleCong_DEF; `;; let IsoscelesExists = thm `; let A B be point; assume ¬(A = B) [H1]; thus ∃ D. ¬Collinear A D B ∧ seg D A ≡ seg D B proof consider l such that Line l ∧ A ∈ l ∧ B ∈ l [l_line] by H1, I1; consider C such that C ∉ l [notCl] by -, ExistsPointOffLine; ¬Collinear C A B ∧ ¬Collinear C B A ∧ ¬Collinear A B C ∧ ¬Collinear A C B ∧ ¬Collinear B A C [CABncol] by l_line, H1, I1, Collinear_DEF, -, ∉; ∡ C A B ≡ ∡ C B A ∨ ∡ C A B <_ang ∡ C B A ∨ ∡ C B A <_ang ∡ C A B by -, ANGLE, AngleTrichotomy; cases by -; suppose ∡ C A B ≡ ∡ C B A; qed by -, CABncol, EuclidPropositionI_6; suppose ∡ C A B <_ang ∡ C B A; ∡ C A B <_ang ∡ A B C by -, AngleSymmetry; consider E such that E ∈ int_angle A B C ∧ ∡ C A B ≡ ∡ A B E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; ¬(B = E) [notBE] by -, InteriorEZHelp; consider D such that D ∈ open (A,C) ∧ D ∈ ray B E â” B [Dexists] by Eexists, Crossbar_THM; D ∈ int_angle A B C by Eexists, -, WholeRayInterior; ¬Collinear A D B [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; ray B D = ray B E ∧ ray A D = ray A C by notBE, Dexists, RayWellDefined, IntervalRay; ∡ D A B ≡ ∡ A B D by Eexists, -, Angle_DEF; qed by ADBncol, -, AngleSymmetry, EuclidPropositionI_6; :: similar case suppose ∡ C B A <_ang ∡ C A B; ∡ C B A <_ang ∡ B A C by -, AngleSymmetry; consider E such that E ∈ int_angle B A C ∧ ∡ C B A ≡ ∡ B A E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; ¬(A = E) [notAE] by -, InteriorEZHelp; consider D such that D ∈ open (B,C) ∧ D ∈ ray A E â” A [Dexists] by Eexists, Crossbar_THM; D ∈ int_angle B A C by Eexists, -, WholeRayInterior; ¬Collinear A D B ∧ ¬Collinear D A B ∧ ¬Collinear D B A [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; ray A D = ray A E ∧ ray B D = ray B C by notAE, Dexists, RayWellDefined, IntervalRay; ∡ D B A ≡ ∡ B A D by Eexists, -, Angle_DEF; ∡ D A B ≡ ∡ D B A by AngleSymmetry, ADBncol, ANGLE, -, C5Symmetric; qed by ADBncol, -, EuclidPropositionI_6; end; `;; let MidpointExists = thm `; let A B be point; assume ¬(A = B) [H1]; thus ∃ M. M ∈ open (A,B) ∧ seg A M ≡ seg M B proof consider D such that ¬Collinear A D B ∧ seg D A ≡ seg D B [Dexists] by H1, IsoscelesExists; consider F such that F ∈ int_angle A D B ∧ ∡ A D F ≡ ∡ F D B [Fexists] by -, AngleBisector; ¬(D = F) [notDF] by -, InteriorEZHelp; consider M such that M ∈ open (A,B) ∧ M ∈ ray D F â” D [Mexists] by Fexists, Crossbar_THM; ray D M = ray D F by notDF, -, RayWellDefined; ∡ A D M ≡ ∡ M D B [ADMeqMDB] by Fexists, -, Angle_DEF; M ∈ int_angle A D B by Fexists, Mexists, WholeRayInterior; ¬(D = M) ∧ ¬Collinear A D M ∧ ¬Collinear B D M [ADMncol] by -, InteriorEZHelp, InteriorAngleSymmetry; seg D M ≡ seg D M by -, SEGMENT, C2Reflexive; A,D,M ≅ B,D,M by ADMncol, Dexists, -, ADMeqMDB, AngleSymmetry, SAS; qed by Mexists, -, TriangleCong_DEF, SegmentSymmetry; `;; let EuclidPropositionI_7short = thm `; let A B C D be point; let a be point_set; assume ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a [a_line]; assume ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a [Csim_aD]; assume seg A C ≡ seg A D [ACeqAD]; thus ¬(seg B C ≡ seg B D) proof ¬(A = C) ∧ ¬(A = D) [AnotCD] by a_line, Csim_aD, ∉; assume seg B C ≡ seg B D; seg C B ≡ seg D B ∧ seg A B ≡ seg A B ∧ seg A D ≡ seg A D [segeqs] by -, SegmentSymmetry, a_line, AnotCD, SEGMENT, C2Reflexive; ¬Collinear A C B ∧ ¬Collinear A D B by a_line, I1, Csim_aD, Collinear_DEF, ∉; A,C,B ≅ A,D,B by -, ACeqAD, segeqs, SSS; ∡ B A C ≡ ∡ B A D by -, TriangleCong_DEF; ray A D = ray A C by a_line, Csim_aD, -, C4Uniqueness; C ∈ ray A D â” A ∧ D ∈ ray A D â” A by AnotCD, -, EndpointInRay, IN_DELETE; C = D by AnotCD, SEGMENT, -, ACeqAD, segeqs, C1; qed by -, Csim_aD; `;; let EuclidPropositionI_7Help = thm `; let A B C D be point; let a be point_set; assume ¬(A = B) [notAB]; assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; assume ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a [Csim_aD]; assume seg A C ≡ seg A D [ACeqAD]; assume C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B C D [Int_ConvQuad]; thus ¬(seg B C ≡ seg B D) proof ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) [Distinct] by a_line, Csim_aD, ∉, SameSide_DEF; cases by Int_ConvQuad; suppose ConvexQuadrilateral A B C D; A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ Tetralateral A B C D [ABint] by -, ConvexQuad_DEF, Quadrilateral_DEF; ¬Collinear B C D ∧ ¬Collinear D C B ∧ ¬Collinear C B D ∧ ¬Collinear C D A ∧ ¬Collinear D A C ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) [angCDB] by -, Tetralateral_DEF, CollinearSymmetry, ANGLE; ∡ C D A ≡ ∡ D C A [CDAeqDCA] by angCDB, Distinct, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; A ∈ int_angle D C B ∧ ∡ D C A ≡ ∡ D C A ∧ ∡ C D B ≡ ∡ C D B by ABint, InteriorAngleSymmetry, angCDB, ANGLE, C5Reflexive; ∡ D C A <_ang ∡ D C B ∧ ∡ C D B <_ang ∡ C D A by angCDB, ABint, -, AngleOrdering_DEF; ∡ C D B <_ang ∡ D C B by -, angCDB, CDAeqDCA, AngleTrichotomy2, AngleOrderTransitivity; ¬(∡ D C B ≡ ∡ C D B) by -, AngleTrichotomy1, angCDB, ANGLE, C5Symmetric; qed by angCDB, -, IsoscelesCongBaseAngles; suppose C ∈ int_triangle D A B; C ∈ int_angle A D B ∧ C ∈ int_angle D A B [CintADB] by -, IN_InteriorTriangle, InteriorAngleSymmetry; ¬Collinear A D C ∧ ¬Collinear B D C [ADCncol] by CintADB, InteriorEZHelp, InteriorAngleSymmetry; ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by -, CollinearSymmetry; ¬Collinear B C D ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) ∧ ¬Collinear D C B [angCDB] by ADCncol, -, CollinearSymmetry, ANGLE; ∡ C D A ≡ ∡ D C A [CDAeqDCA] by DACncol, Distinct, ADCncol, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; consider E such that D ∈ open (A,E) ∧ ¬(D = E) ∧ Collinear A D E [ADE] by Distinct, B2', B1'; B ∈ int_angle C D E ∧ Collinear D A E [BintCDE] by CintADB, -, InteriorReflectionInterior, CollinearSymmetry; ¬Collinear C D E [CDEncol] by DACncol, -, ADE, NoncollinearityExtendsToLine; consider F such that F ∈ open (B,D) ∧ F ∈ ray A C â” A [Fexists] by CintADB, Crossbar_THM, B1'; F ∈ int_angle B C D [FintBCD] by ADCncol, CollinearSymmetry, -, ConverseCrossbar; ¬Collinear D C F [DCFncol] by Distinct, ADCncol, CollinearSymmetry, Fexists, B1', NoncollinearityExtendsToLine; Collinear A C F ∧ F ∈ ray D B â” D ∧ C ∈ int_angle A D F by Fexists, IN_DELETE, IN_Ray, B1', IntervalRayEZ, CintADB, InteriorWellDefined; C ∈ open (A,F) by -, AlternateConverseCrossbar; ∡ A D C suppl ∡ C D E ∧ ∡ A C D suppl ∡ D C F by ADE, DACncol, -, SupplementaryAngles_DEF; ∡ C D E ≡ ∡ D C F [CDEeqDCF] by -, CDAeqDCA, AngleSymmetry, SupplementsCongAnglesCong; ∡ C D B <_ang ∡ C D E by angCDB, CDEncol, BintCDE, C5Reflexive, AngleOrdering_DEF; ∡ C D B <_ang ∡ D C F [CDBlessDCF] by -, DCFncol, ANGLE, CDEeqDCF, AngleTrichotomy2; ∡ D C F <_ang ∡ D C B by DCFncol, ANGLE, angCDB, FintBCD, InteriorAngleSymmetry, C5Reflexive, AngleOrdering_DEF; ∡ C D B <_ang ∡ D C B by CDBlessDCF, -, AngleOrderTransitivity; ¬(∡ D C B ≡ ∡ C D B) by -, AngleTrichotomy1, angCDB, CollinearSymmetry, ANGLE, C5Symmetric; qed by Distinct, ADCncol, CollinearSymmetry, -, IsoscelesCongBaseAngles; end; `;; let EuclidPropositionI_7 = thm `; let A B C D be point; let a be point_set; assume ¬(A = B) [notAB]; assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; assume ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a [Csim_aD]; assume seg A C ≡ seg A D [ACeqAD]; thus ¬(seg B C ≡ seg B D) proof ¬Collinear A B C ∧ ¬Collinear D A B [ABCncol] by a_line, notAB, I1, Collinear_DEF, Csim_aD, ∉; ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ A ∉ open (C,D) [Distinct] by a_line, Csim_aD, ∉, SameSide_DEF; ¬Collinear A D C [ADCncol] proof assume Collinear A D C; C ∈ ray A D â” A ∧ D ∈ ray A D â” A by Distinct, -, IN_Ray, EndpointInRay, IN_DELETE; qed by Distinct, SEGMENT, -, ACeqAD, C2Reflexive, C1, Csim_aD; D,C same_side a [Dsim_aC] by a_line, Csim_aD, SameSideSymmetric; seg A D ≡ seg A C ∧ seg B D ≡ seg B D [ADeqAC] by Distinct, SEGMENT, ACeqAD, C2Symmetric, C2Reflexive; ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by ADCncol, CollinearSymmetry; ¬(seg B D ≡ seg B C) ⇒ ¬(seg B C ≡ seg B D) [BswitchDC] by Distinct, SEGMENT, C2Symmetric; cases; suppose Collinear B D C; B ∉ open (C,D) ∧ C ∈ ray B D â” B ∧ D ∈ ray B D â” B by a_line, Csim_aD, SameSide_DEF, ∉, Distinct, -, IN_Ray, Distinct, IN_DELETE, EndpointInRay; qed by Distinct, SEGMENT, -, ACeqAD, ADeqAC, C1, Csim_aD; suppose ¬Collinear B D C [BDCncol]; Tetralateral A B C D by notAB, Distinct, Csim_aD, ABCncol, -, CollinearSymmetry, DACncol, Tetralateral_DEF; ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B by -, a_line, Csim_aD, FourChoicesTetralateral, InteriorTriangleSymmetry; qed by notAB, a_line, Csim_aD, Dsim_aC, ACeqAD, ADeqAC, -, EuclidPropositionI_7Help, BswitchDC; end; `;; let EuclidPropositionI_11 = thm `; let A B be point; assume ¬(A = B) [notAB]; thus ∃ F. Right (∡ A B F) proof consider C such that B ∈ open (A,C) ∧ seg B C ≡ seg B A [ABC] by notAB, SEGMENT, C1OppositeRay; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [Distinct] by ABC, B1'; seg B A ≡ seg B C [BAeqBC] by -, SEGMENT, ABC, C2Symmetric; consider F such that ¬Collinear A F C ∧ seg F A ≡ seg F C [Fexists] by Distinct, IsoscelesExists; ¬Collinear B F A ∧ ¬Collinear B F C [BFAncol] by -, CollinearSymmetry, Distinct, NoncollinearityExtendsToLine; ¬Collinear A B F ∧ Angle (∡ A B F) [angABF] by BFAncol, CollinearSymmetry, ANGLE; ∡ A B F suppl ∡ F B C [ABFsuppl] by -, ABC, SupplementaryAngles_DEF; ¬(B = F) ∧ seg B F ≡ seg B F by BFAncol, NonCollinearImpliesDistinct, SEGMENT, C2Reflexive; B,F,A ≅ B,F,C by BFAncol, -, BAeqBC, Fexists, SSS; ∡ A B F ≡ ∡ F B C by -, TriangleCong_DEF, AngleSymmetry; qed by angABF, ABFsuppl, -, RightAngle_DEF; `;; let DropPerpendicularToLine = thm `; let P be point; let l be point_set; assume Line l ∧ P ∉ l [l_line]; thus ∃ E Q. E ∈ l ∧ Q ∈ l ∧ Right (∡ P Q E) proof consider A B such that A ∈ l ∧ B ∈ l ∧ ¬(A = B) [ABl] by l_line, I2; ¬Collinear B A P ∧ ¬Collinear P A B ∧ ¬(A = P) [BAPncol] by l_line, ABl, I1, Collinear_DEF, ∉, CollinearSymmetry, ABl, ∉; Angle (∡ B A P) ∧ Angle (∡ P A B) [angBAP] by -, ANGLE, AngleSymmetry; consider P' such that ¬(A = P') ∧ P' ∉ l ∧ ¬(P,P' same_side l) ∧ seg A P' ≡ seg A P ∧ ∡ B A P' ≡ ∡ B A P [P'exists] by angBAP, ABl, BAPncol, l_line, C4OppositeSide; consider Q such that Q ∈ l ∧ Q ∈ open (P,P') ∧ Collinear A B Q [Qexists] by l_line, -, SameSide_DEF, ABl, Collinear_DEF; ¬Collinear B A P' [BAP'ncol] by l_line, ABl, I1, Collinear_DEF, P'exists, ∉; ∡ B A P ≡ ∡ B A P' [BAPeqBAP'] by -, ANGLE, angBAP, P'exists, C5Symmetric; ∃ E. E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' proof cases; suppose A = Q [AQ]; qed by ABl, AQ, BAPncol, BAPeqBAP', AngleSymmetry; suppose ¬(A = Q) [notAQ]; seg A Q ≡ seg A Q ∧ seg A P ≡ seg A P' [APeqAP'] by -, SEGMENT, C2Reflexive, BAPncol, P'exists, C2Symmetric; ¬Collinear Q A P' ∧ ¬Collinear Q A P [QAP'ncol] by l_line, ABl, Qexists, notAQ, I1, Collinear_DEF, P'exists, ∉; ∡ Q A P ≡ ∡ Q A P' proof cases; suppose A ∈ open (Q,B); ∡ B A P suppl ∡ P A Q ∧ ∡ B A P' suppl ∡ P' A Q by BAPncol, BAP'ncol, -, B1', SupplementaryAngles_DEF; qed by -, BAPeqBAP', SupplementsCongAnglesCong, AngleSymmetry; suppose ¬(A ∈ open (Q,B)); A ∉ open (Q,B) ∧ Q ∈ ray A B â” A ∧ ray A Q = ray A B by -, ∉, ABl, Qexists, IN_Ray, notAQ, IN_DELETE, ABl, RayWellDefined; qed by -, BAPeqBAP', Angle_DEF; end; Q,A,P ≅ Q,A,P' by QAP'ncol, APeqAP', -, SAS; qed by -, TriangleCong_DEF, AngleSymmetry, ABl, QAP'ncol, CollinearSymmetry; end; consider E such that E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' [Eexists] by -; ∡ P Q E suppl ∡ E Q P' ∧ Right (∡ P Q E) by -, Qexists, SupplementaryAngles_DEF, RightAngle_DEF; qed by Eexists, Qexists, -; `;; let EuclidPropositionI_14 = thm `; let A B C D be point; let l be point_set; assume Line l ∧ A ∈ l ∧ B ∈ l ∧ ¬(A = B) [l_line]; assume C ∉ l ∧ D ∉ l ∧ ¬(C,D same_side l) [Cnsim_lD]; assume ∡ C B A suppl ∡ A B D [CBAsupplABD]; thus B ∈ open (C,D) proof ¬(B = C) ∧ ¬(B = D) ∧ ¬Collinear C B A [Distinct] by l_line, Cnsim_lD, ∉, I1, Collinear_DEF; consider E such that B ∈ open (C,E) [CBE] by Distinct, B2'; E ∉ l ∧ ¬(C,E same_side l) [Csim_lE] by l_line, ∉, -, BetweenLinear, Cnsim_lD, SameSide_DEF; D,E same_side l [Dsim_lE] by l_line, Cnsim_lD, -, AtMost2Sides; ∡ C B A suppl ∡ A B E by Distinct, CBE, SupplementaryAngles_DEF; ∡ A B D ≡ ∡ A B E by CBAsupplABD, -, SupplementUnique; ray B E = ray B D by l_line, Csim_lE, Cnsim_lD, Dsim_lE, -, C4Uniqueness; D ∈ ray B E â” B by Distinct, -, EndpointInRay, IN_DELETE; qed by CBE, -, OppositeRaysIntersect1pointHelp, B1'; `;; let VerticalAnglesCong = thm `; :: Euclid's Proposition I.15 let A B O A' B' be point; assume ¬Collinear A O B [H1]; assume O ∈ open (A,A') ∧ O ∈ open (B,B') [H2]; thus ∡ B O A' ≡ ∡ B' O A proof ∡ A O B suppl ∡ B O A' [AOBsupplBOA'] by H1, H2, SupplementaryAngles_DEF; ∡ B O A suppl ∡ A O B' by H1, CollinearSymmetry, H2, SupplementaryAngles_DEF; qed by AOBsupplBOA', -, AngleSymmetry, SupplementUnique; `;; let EuclidPropositionI_16 = thm `; let A B C D be point; assume ¬Collinear A B C [H1]; assume C ∈ open (B,D) [H2]; thus ∡ B A C <_ang ∡ D C A proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; consider l such that Line l ∧ A ∈ l ∧ C ∈ l [l_line] by Distinct, I1; consider m such that Line m ∧ B ∈ m ∧ C ∈ m [m_line] by Distinct, I1; D ∈ m [Dm] by m_line, H2, BetweenLinear; consider E such that E ∈ open (A,C) ∧ seg A E ≡ seg E C [AEC] by Distinct, MidpointExists; ¬(A = E) ∧ ¬(E = C) ∧ Collinear A E C ∧ ¬(B = E) [AECcol] by -, B1', H1; E ∈ l [El] by l_line, AEC, BetweenLinear; consider F such that E ∈ open (B,F) ∧ seg E F ≡ seg E B [BEF] by AECcol, SEGMENT, C1OppositeRay; ¬(B = E) ∧ ¬(B = F) ∧ ¬(E = F) ∧ Collinear B E F [BEF'] by BEF, B1'; B ∉ l [notBl] by l_line, Distinct, I1, Collinear_DEF, H1, ∉; ¬Collinear A E B ∧ ¬Collinear C E B [AEBncol] by l_line, El, AECcol, I1, Collinear_DEF, notBl, ∉; Angle (∡ B A E) [angBAE] by -, CollinearSymmetry, ANGLE; ¬Collinear C E F [CEFncol] by AEBncol, BEF', CollinearSymmetry, NoncollinearityExtendsToLine; ∡ B E A ≡ ∡ F E C [BEAeqFEC] by AEBncol, AEC, B1', BEF, VerticalAnglesCong; seg E A ≡ seg E C ∧ seg E B ≡ seg E F by AEC, SegmentSymmetry, AECcol, BEF', SEGMENT, BEF, C2Symmetric; A,E,B ≅ C,E,F by AEBncol, CEFncol, -, BEAeqFEC, AngleSymmetry, SAS; ∡ B A E ≡ ∡ F C E [BAEeqFCE] by -, TriangleCong_DEF; ¬Collinear E C D [ECDncol] by AEBncol, H2, B1', CollinearSymmetry, NoncollinearityExtendsToLine; F ∉ l ∧ D ∉ l [notFl] by l_line, El, Collinear_DEF, CEFncol, -, ∉; F ∈ ray B E â” B ∧ E ∉ m by BEF, IntervalRayEZ, m_line, Collinear_DEF, AEBncol, ∉; F ∉ m ∧ F,E same_side m [Fsim_mE] by m_line, -, RaySameSide; ¬(B,F same_side l) ∧ ¬(B,D same_side l) by El, l_line, BEF, H2, SameSide_DEF; F,D same_side l by l_line, notBl, notFl, -, AtMost2Sides; F ∈ int_angle E C D by ECDncol, l_line, El, m_line, Dm, notFl, Fsim_mE, -, IN_InteriorAngle; ∡ B A E <_ang ∡ E C D [BAElessECD] by angBAE, ECDncol, -, BAEeqFCE, AngleSymmetry, AngleOrdering_DEF; ray A E = ray A C ∧ ray C E = ray C A by AEC, B1', IntervalRay; ∡ B A C <_ang ∡ A C D by BAElessECD, -, Angle_DEF; qed by -, AngleSymmetry; `;; let ExteriorAngle = thm `; let A B C D be point; assume ¬Collinear A B C [H1]; assume C ∈ open (B,D) [H2]; thus ∡ A B C <_ang ∡ A C D proof ¬(C = D) ∧ C ∈ open (D,B) ∧ Collinear B C D [H2'] by H2, BetweenLinear, B1'; ¬Collinear B A C ∧ ¬(A = C) [BACncol] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; consider E such that C ∈ open (A,E) [ACE] by -, B2'; ¬(C = E) ∧ C ∈ open (E,A) ∧ Collinear A C E [ACE'] by -, B1'; ¬Collinear A C D ∧ ¬Collinear D C E [DCEncol] by H1, CollinearSymmetry, H2', -, NoncollinearityExtendsToLine; ∡ A B C <_ang ∡ E C B [ABClessECB] by BACncol, ACE, EuclidPropositionI_16; ∡ E C B ≡ ∡ A C D by DCEncol, ACE', H2', VerticalAnglesCong; qed by ABClessECB, DCEncol, ANGLE, -, AngleTrichotomy2; `;; let EuclidPropositionI_17 = thm `; let A B C be point; let α β γ be point_set; assume ¬Collinear A B C ∧ α = ∡ A B C ∧ β = ∡ B C A [H1]; assume β suppl γ [H2]; thus α <_ang γ proof Angle γ [angγ] by H2, SupplementImpliesAngle; ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; ¬Collinear B A C ∧ ¬Collinear A C B [BACncol] by H1, CollinearSymmetry; consider D such that C ∈ open (A,D) [ACD] by Distinct, B2'; ∡ A B C <_ang ∡ D C B [ABClessDCB] by BACncol, ACD, EuclidPropositionI_16; β suppl ∡ B C D by -, H1, AngleSymmetry, BACncol, ACD, SupplementaryAngles_DEF; ∡ B C D ≡ γ by H2, -, SupplementUnique; qed by ABClessDCB, H1, AngleSymmetry, angγ, -, AngleTrichotomy2; `;; let EuclidPropositionI_18 = thm `; let A B C be point; assume ¬Collinear A B C [H1]; assume seg A C <__ seg A B [H2]; thus ∡ A B C <_ang ∡ B C A proof ¬(A = B) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; consider D such that D ∈ open (A,B) ∧ seg A C ≡ seg A D [ADB] by Distinct, SEGMENT, H2, SegmentOrderingUse; ¬(D = A) ∧ ¬(D = B) ∧ D ∈ open (B,A) ∧ Collinear A D B ∧ ray B D = ray B A [ADB'] by -, B1', IntervalRay; D ∈ int_angle A C B [DintACB] by H1, CollinearSymmetry, ADB, ConverseCrossbar; ¬Collinear D A C ∧ ¬Collinear C B D [DACncol] by H1, CollinearSymmetry, ADB', NoncollinearityExtendsToLine; seg A D ≡ seg A C by ADB', Distinct, SEGMENT, ADB, C2Symmetric; ∡ C D A ≡ ∡ A C D by DACncol, -, IsoscelesCongBaseAngles, AngleSymmetry; ∡ C D A <_ang ∡ A C B [CDAlessACB] by DACncol, CollinearSymmetry, ANGLE, H1, CollinearSymmetry, DintACB, -, AngleOrdering_DEF; ∡ B D C suppl ∡ C D A by DACncol, CollinearSymmetry, ADB', SupplementaryAngles_DEF; ∡ C B D <_ang ∡ C D A by DACncol, -, EuclidPropositionI_17; ∡ C B D <_ang ∡ A C B by -, CDAlessACB, AngleOrderTransitivity; qed by -, ADB', Angle_DEF, AngleSymmetry; `;; let EuclidPropositionI_19 = thm `; let A B C be point; assume ¬Collinear A B C [H1]; assume ∡ A B C <_ang ∡ B C A [H2]; thus seg A C <__ seg A B proof ¬Collinear B A C ∧ ¬Collinear B C A ∧ ¬Collinear A C B [BACncol] by H1, CollinearSymmetry; ¬(A = B) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; assume ¬(seg A C <__ seg A B); seg A B ≡ seg A C ∨ seg A B <__ seg A C by Distinct, SEGMENT, -, SegmentTrichotomy; cases by -; suppose seg A B ≡ seg A C; ∡ C B A ≡ ∡ B C A by BACncol, -, IsoscelesCongBaseAngles; qed by -, AngleSymmetry, H2, AngleTrichotomy1; suppose seg A B <__ seg A C; ∡ A C B <_ang ∡ C B A by BACncol, -, EuclidPropositionI_18; qed by H1, BACncol, ANGLE, -, AngleSymmetry, H2, AngleTrichotomy; end; `;; let EuclidPropositionI_20 = thm `; let A B C D be point; assume ¬Collinear A B C [H1]; assume A ∈ open (B,D) ∧ seg A D ≡ seg A C [H2]; thus seg B C <__ seg B D proof ¬(B = D) ∧ ¬(A = D) ∧ A ∈ open (D,B) ∧ Collinear B A D ∧ ray D A = ray D B [BAD'] by H2, B1', IntervalRay; ¬Collinear C A D [CADncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; ¬Collinear D C B ∧ ¬Collinear B D C [DCBncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; :: 13 Angle (∡ C D A) [angCDA] by CADncol, CollinearSymmetry, ANGLE; ∡ C D A ≡ ∡ D C A [CDAeqDCA] by CADncol, CollinearSymmetry, H2, IsoscelesCongBaseAngles; A ∈ int_angle D C B by DCBncol, BAD', ConverseCrossbar; ∡ C D A <_ang ∡ D C B by angCDA, DCBncol, -, CDAeqDCA, AngleOrdering_DEF; ∡ B D C <_ang ∡ D C B by -, BAD', Angle_DEF, AngleSymmetry; qed by DCBncol, -, EuclidPropositionI_19; `;; let EuclidPropositionI_21 = thm `; let A B C D be point; assume ¬Collinear A B C [H1]; assume D ∈ int_triangle A B C [H2]; thus ∡ A B C <_ang ∡ C D A proof ¬(B = A) ∧ ¬(B = C) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; D ∈ int_angle B A C ∧ D ∈ int_angle C B A [DintTri] by H2, IN_InteriorTriangle, InteriorAngleSymmetry; consider E such that E ∈ open (B,C) ∧ E ∈ ray A D â” A [BEC] by -, Crossbar_THM; ¬(B = E) ∧ ¬(E = C) ∧ Collinear B E C ∧ Collinear A D E [BEC'] by -, B1', IN_DELETE, IN_Ray; ray B E = ray B C ∧ E ∈ ray B C â” B [rBErBC] by BEC, IntervalRay, IntervalRayEZ; D ∈ int_angle A B E [DintABE] by DintTri, -, InteriorAngleSymmetry, InteriorWellDefined; D ∈ open (A,E) [ADE] by BEC', -, AlternateConverseCrossbar; ray E D = ray E A [rEDrEA] by -, B1', IntervalRay; ¬Collinear A B E ∧ ¬Collinear B E A ∧ ¬Collinear C B D ∧ ¬(A = D) [ABEncol] by DintABE, IN_InteriorAngle, CollinearSymmetry, DintTri, InteriorEZHelp; ¬Collinear E D C ∧ ¬Collinear C E D [EDCncol] by -, CollinearSymmetry, BEC', NoncollinearityExtendsToLine; ∡ A B E <_ang ∡ A E C by ABEncol, BEC, ExteriorAngle; ∡ A B C <_ang ∡ C E D [ABClessAEC] by -, rBErBC, rEDrEA, Angle_DEF, AngleSymmetry; ∡ C E D <_ang ∡ C D A by EDCncol, ADE, B1', ExteriorAngle; qed by ABClessAEC, -, AngleOrderTransitivity; `;; let AngleTrichotomy3 = thm `; let α β γ be point_set; assume α <_ang β ∧ Angle γ ∧ γ ≡ α [H1]; thus γ <_ang β proof consider A O B G such that Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by H1, AngleOrdering_DEF; ¬Collinear A O G by -, InteriorEZHelp; γ ≡ ∡ A O G by H1, H1', -, ANGLE, C5Transitive; qed by H1, H1', -, AngleOrdering_DEF; `;; let InteriorCircleConvexHelp = thm `; let O A B C be point; assume ¬Collinear A O C [H1]; assume B ∈ open (A,C) [H2]; assume seg O A <__ seg O C ∨ seg O A ≡ seg O C [H3]; thus seg O B <__ seg O C proof ¬Collinear O C A ∧ ¬Collinear C O A ∧ ¬(O = A) ∧ ¬(O = C) [H1'] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; ray A B = ray A C ∧ ray C B = ray C A [equal_rays] by H2, IntervalRay, B1'; ∡ O C A <_ang ∡ C A O ∨ ∡ O C A ≡ ∡ C A O proof cases by H3; suppose seg O A <__ seg O C; qed by H1', -, EuclidPropositionI_18; suppose seg O A ≡ seg O C [seg_eq]; seg O C ≡ seg O A by H1', SEGMENT, -, C2Symmetric; qed by H1', -, IsoscelesCongBaseAngles, AngleSymmetry; end; ∡ O C B <_ang ∡ B A O ∨ ∡ O C B ≡ ∡ B A O by -, equal_rays, Angle_DEF; ∡ B C O <_ang ∡ O A B ∨ ∡ B C O ≡ ∡ O A B [BCOlessOAB] by -, AngleSymmetry; ¬Collinear O A B ∧ ¬Collinear B C O ∧ ¬Collinear O C B [OABncol] by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; ∡ O A B <_ang ∡ O B C by -, H2, ExteriorAngle; ∡ B C O <_ang ∡ O B C by BCOlessOAB, -, AngleOrderTransitivity, OABncol, ANGLE, -, AngleTrichotomy3; qed by OABncol, -, AngleSymmetry, EuclidPropositionI_19; `;; let InteriorCircleConvex = thm `; let O R A B C be point; assume ¬(O = R) [H1]; assume B ∈ open (A,C) [H2]; assume A ∈ int_circle O R ∧ C ∈ int_circle O R [H3]; thus B ∈ int_circle O R proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ open (C,A) [H2'] by H2, B1'; (A = O ∨ seg O A <__ seg O R) ∧ (C = O ∨ seg O C <__ seg O R) [ACintOR] by H3, H1, IN_InteriorCircle; cases; suppose O = A ∨ O = C; B ∈ open (O,C) ∨ B ∈ open (O,A) by -, H2, B1'; seg O B <__ seg O A ∧ ¬(O = A) ∨ seg O B <__ seg O C ∧ ¬(O = C) by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; seg O B <__ seg O R by -, ACintOR, SegmentOrderTransitivity; qed by -, H1, IN_InteriorCircle; suppose ¬(O = A) ∧ ¬(O = C) [OnotAC]; cases; suppose ¬Collinear A O C [AOCncol]; seg O A <__ seg O C ∨ seg O A ≡ seg O C ∨ seg O C <__ seg O A by OnotAC, SEGMENT, SegmentTrichotomy; seg O B <__ seg O C ∨ seg O B <__ seg O A by AOCncol, H2, -, InteriorCircleConvexHelp, CollinearSymmetry, B1'; qed by OnotAC, ACintOR, -, SegmentOrderTransitivity, H1, IN_InteriorCircle; suppose Collinear A O C [AOCcol]; consider l such that Line l ∧ A ∈ l ∧ C ∈ l by H2', I1; Collinear B A O ∧ Collinear B C O [OABCcol] by -, H2, BetweenLinear, H2', AOCcol, CollinearLinear, Collinear_DEF; B ∉ open (O,A) ∧ B ∉ open (O,C) ⇒ B = O proof assume B ∉ open (O,A) ∧ B ∉ open (O,C); O ∈ ray B A ∩ ray B C by H2', OABCcol, -, IN_Ray, IN_INTER; qed by -, H2, OppositeRaysIntersect1point, IN_SING; B ∈ open (O,A) ∨ B ∈ open (O,C) ∨ B = O by -, ∉; seg O B <__ seg O A ∨ seg O B <__ seg O C ∨ B = O by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; seg O B <__ seg O R ∨ B = O by -, ACintOR, OnotAC, SegmentOrderTransitivity; qed by -, H1, IN_InteriorCircle; end; end; `;; let SegmentTrichotomy3 = thm `; let s t u be point_set; assume s <__ t ∧ Segment u ∧ u ≡ s [H1]; thus u <__ t proof consider C D X such that Segment s ∧ t = seg C D ∧ X ∈ open (C,D) ∧ s ≡ seg C X ∧ ¬(C = X) [H1'] by H1, SegmentOrdering_DEF, B1'; u ≡ seg C X by H1, -, SEGMENT, C2Transitive; qed by H1, H1', -, SegmentOrdering_DEF; `;; let EuclidPropositionI_24Help = thm `; let O A C O' D F be point; assume ¬Collinear A O C ∧ ¬Collinear D O' F [H1]; assume seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C [H2]; assume ∡ D O' F <_ang ∡ A O C [H3]; assume seg O A <__ seg O C ∨ seg O A ≡ seg O C [H4]; thus seg D F <__ seg A C proof consider K such that K ∈ int_angle A O C ∧ ∡ D O' F ≡ ∡ A O K [KintAOC] by H1, ANGLE, H3, AngleOrderingUse; ¬(O = C) ∧ ¬(D = F) ∧ ¬(O' = F) ∧ ¬(O = K) [Distinct] by H1, NonCollinearImpliesDistinct, -, InteriorEZHelp; consider B such that B ∈ ray O K â” O ∧ seg O B ≡ seg O C [BrOK] by Distinct, SEGMENT, -, C1; ray O B = ray O K by Distinct, -, RayWellDefined; ∡ D O' F ≡ ∡ A O B [DO'FeqAOB] by KintAOC, -, Angle_DEF; B ∈ int_angle A O C [BintAOC] by KintAOC, BrOK, WholeRayInterior; ¬(B = O) ∧ ¬Collinear A O B [AOBncol] by -, InteriorEZHelp; seg O C ≡ seg O B [OCeqOB] by Distinct, -, SEGMENT, BrOK, C2Symmetric; seg O' F ≡ seg O B by Distinct, SEGMENT, AOBncol, H2, -, C2Transitive; D,O',F ≅ A,O,B by H1, AOBncol, H2, -, DO'FeqAOB, SAS; seg D F ≡ seg A B [DFeqAB] by -, TriangleCong_DEF; consider G such that G ∈ open (A,C) ∧ G ∈ ray O B â” O ∧ ¬(G = O) [AGC] by BintAOC, Crossbar_THM, B1', IN_DELETE; Segment (seg O G) ∧ ¬(O = B) [notOB] by AGC, SEGMENT, BrOK, IN_DELETE; seg O G <__ seg O C by H1, AGC, H4, InteriorCircleConvexHelp; seg O G <__ seg O B by -, OCeqOB, BrOK, IN_DELETE, SEGMENT, SegmentTrichotomy2; consider G' such that G' ∈ open (O,B) ∧ seg O G ≡ seg O G' [OG'B] by notOB, -, SegmentOrderingUse; ¬(G' = O) ∧ seg O G' ≡ seg O G' ∧ Segment (seg O G') [notG'O] by -, B1', SEGMENT, C2Reflexive, SEGMENT; G' ∈ ray O B â” O by OG'B, IntervalRayEZ; G' = G ∧ G ∈ open (B,O) by notG'O, notOB, -, AGC, OG'B, C1, B1'; ConvexQuadrilateral B A O C by H1, -, AGC, DiagonalsIntersectImpliesConvexQuad; A ∈ int_angle O C B ∧ O ∈ int_angle C B A ∧ Quadrilateral B A O C [OintCBA] by -, ConvexQuad_DEF; A ∈ int_angle B C O [AintBCO] by -, InteriorAngleSymmetry; Tetralateral B A O C by OintCBA, Quadrilateral_DEF; ¬Collinear C B A ∧ ¬Collinear B C O ∧ ¬Collinear C O B ∧ ¬Collinear C B O [BCOncol] by -, Tetralateral_DEF, CollinearSymmetry; ∡ B C O ≡ ∡ C B O [BCOeqCBO] by -, OCeqOB, IsoscelesCongBaseAngles; ¬Collinear B C A ∧ ¬Collinear A C B [ACBncol] by AintBCO, InteriorEZHelp, CollinearSymmetry; ∡ B C A ≡ ∡ B C A ∧ Angle (∡ B C A) ∧ ∡ C B O ≡ ∡ C B O [CBOref] by -, ANGLE, BCOncol, C5Reflexive; ∡ B C A <_ang ∡ B C O by -, BCOncol, ANGLE, AintBCO, AngleOrdering_DEF; ∡ B C A <_ang ∡ C B O [BCAlessCBO] by -, BCOncol, ANGLE, BCOeqCBO, AngleTrichotomy2; ∡ C B O <_ang ∡ C B A by BCOncol, ANGLE, OintCBA, CBOref, AngleOrdering_DEF; ∡ A C B <_ang ∡ C B A by BCAlessCBO, -, AngleOrderTransitivity, AngleSymmetry; seg A B <__ seg A C by ACBncol, -, EuclidPropositionI_19; qed by -, Distinct, SEGMENT, DFeqAB, SegmentTrichotomy3; `;; let EuclidPropositionI_24 = thm `; let O A C O' D F be point; assume ¬Collinear A O C ∧ ¬Collinear D O' F [H1]; assume seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C [H2]; assume ∡ D O' F <_ang ∡ A O C [H3]; thus seg D F <__ seg A C proof ¬(O = A) ∧ ¬(O = C) ∧ ¬Collinear C O A ∧ ¬Collinear F O' D [Distinct] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; seg O A ≡ seg O C ∨ seg O A <__ seg O C ∨ seg O C <__ seg O A by -, SEGMENT, SegmentTrichotomy; cases by -; suppose seg O A <__ seg O C ∨ seg O A ≡ seg O C; qed by H1, H2, H3, -, EuclidPropositionI_24Help; suppose seg O C <__ seg O A [H4]; ∡ F O' D <_ang ∡ C O A by H3, AngleSymmetry; qed by Distinct, H3, AngleSymmetry, H2, H4, EuclidPropositionI_24Help, SegmentSymmetry; end; `;; let EuclidPropositionI_25 = thm `; let O A C O' D F be point; assume ¬Collinear A O C ∧ ¬Collinear D O' F [H1]; assume seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C [H2]; assume seg D F <__ seg A C [H3]; thus ∡ D O' F <_ang ∡ A O C proof ¬(O = A) ∧ ¬(O = C) ∧ ¬(A = C) ∧ ¬(D = F) ∧ ¬(O' = D) ∧ ¬(O' = F) [Distinct] by H1, NonCollinearImpliesDistinct; assume ¬(∡ D O' F <_ang ∡ A O C); ∡ D O' F ≡ ∡ A O C ∨ ∡ A O C <_ang ∡ D O' F by H1, ANGLE, -, AngleTrichotomy; cases by -; suppose ∡ D O' F ≡ ∡ A O C; D,O',F ≅ A,O,C by H1, H2, -, SAS; seg D F ≡ seg A C by -, TriangleCong_DEF; qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; suppose ∡ A O C <_ang ∡ D O' F [Con]; seg O A ≡ seg O' D ∧ seg O C ≡ seg O' F [H2'] by Distinct, SEGMENT, H2, C2Symmetric; seg A C <__ seg D F by H1, -, Con, EuclidPropositionI_24; qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; end; `;; let AAS = thm `; let A B C A' B' C' be point; assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; assume ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' [H2]; assume seg A B ≡ seg A' B' [H3]; thus A,B,C ≅ A',B',C' proof ¬(A = B) ∧ ¬(B = C) ∧ ¬(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; consider G such that G ∈ ray B C â” B ∧ seg B G ≡ seg B' C' [Gexists] by Distinct, SEGMENT, C1; ¬(G = B) ∧ B ∉ open (G,C) ∧ Collinear G B C [notGBC] by -, IN_DELETE, IN_Ray, CollinearSymmetry; ¬Collinear A B G ∧ ¬Collinear B G A [ABGncol] by H1, notGBC, CollinearSymmetry, NoncollinearityExtendsToLine; ray B G = ray B C by Distinct, Gexists, RayWellDefined; ∡ A B G = ∡ A B C by Distinct, -, Angle_DEF; A,B,G ≅ A',B',C' [ABG≅A'B'C'] by H1, ABGncol, H3, SegmentSymmetry, H2, -, Gexists, SAS; ∡ B G A ≡ ∡ B' C' A' [BGAeqB'C'A'] by -, TriangleCong_DEF; ¬Collinear B C A ∧ ¬Collinear B' C' A' [BCAncol] by H1, CollinearSymmetry; ∡ B' C' A' ≡ ∡ B C A ∧ ∡ B C A ≡ ∡ B C A [BCArefl] by -, ANGLE, H2, C5Symmetric, C5Reflexive; ∡ B G A ≡ ∡ B C A [BGAeqBCA] by ABGncol, BCAncol, ANGLE, BGAeqB'C'A', -, C5Transitive; cases; suppose G = C; qed by -, ABG≅A'B'C'; suppose ¬(G = C) [notGC]; ¬Collinear A C G ∧ ¬Collinear A G C [ACGncol] by H1, notGBC, -, CollinearSymmetry, NoncollinearityExtendsToLine; C ∈ open (B,G) ∨ G ∈ open (C,B) by notGBC, notGC, Distinct, B3', ∉; cases by -; suppose C ∈ open (B,G) ; C ∈ open (G,B) ∧ ray G C = ray G B [rGCrBG] by -, B1', IntervalRay; ∡ A G C <_ang ∡ A C B by ACGncol, -, ExteriorAngle; ∡ B G A <_ang ∡ B C A by -, rGCrBG, Angle_DEF, AngleSymmetry, AngleSymmetry; qed by ABGncol, BCAncol, ANGLE, -, AngleSymmetry, BGAeqBCA, AngleTrichotomy; suppose G ∈ open (C,B) [CGB]; ray C G = ray C B ∧ ∡ A C G <_ang ∡ A G B by -, IntervalRay, ACGncol, ExteriorAngle; ∡ A C B <_ang ∡ B G A by -, Angle_DEF, AngleSymmetry; ∡ B C A <_ang ∡ B C A by -, BCAncol, ANGLE, BGAeqBCA, AngleTrichotomy2, AngleSymmetry; qed by -, BCArefl, AngleTrichotomy1; end; end; `;; let ParallelSymmetry = thm `; ∀ l k: point_set. l ∥ k ⇒ k ∥ l by PARALLEL, INTER_COMM; `;; let AlternateInteriorAngles = thm `; let A B C E be point; let l m t be point_set; assume Line l ∧ A ∈ l ∧ E ∈ l [l_line]; assume Line m ∧ B ∈ m ∧ C ∈ m [m_line]; assume Line t ∧ A ∈ t ∧ B ∈ t [t_line]; assume ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t [Distinct]; assume ¬(C,E same_side t) [Cnsim_tE]; assume ∡ E A B ≡ ∡ C B A [AltIntAngCong]; thus l ∥ m proof ¬Collinear E A B ∧ ¬Collinear C B A [EABncol] by t_line, Distinct, I1, Collinear_DEF, ∉; B ∉ l ∧ A ∉ m [notAmBl] by l_line, m_line, Collinear_DEF, -, ∉; assume ¬(l ∥ m); ¬(l ∩ m = ∅) by -, l_line, m_line, PARALLEL; consider G such that G ∈ l ∧ G ∈ m [Glm] by -, MEMBER_NOT_EMPTY, IN_INTER; ¬(G = A) ∧ ¬(G = B) ∧ Collinear B G C ∧ Collinear B C G ∧ Collinear A E G ∧ Collinear A G E [GnotAB] by -, notAmBl, ∉, m_line, l_line, Collinear_DEF; ¬Collinear A G B ∧ ¬Collinear B G A ∧ G ∉ t [AGBncol] by EABncol, CollinearSymmetry, -, NoncollinearityExtendsToLine, t_line, Collinear_DEF, ∉; ¬(E,C same_side t) [Ensim_tC] by t_line, -, Distinct, Cnsim_tE, SameSideSymmetric; C ∈ m â” B ∧ G ∈ m â” B [CGm_B] by m_line, Glm, Distinct, GnotAB, IN_DELETE; E ∈ l â” A ∧ G ∈ l â” A [EGm_A] by l_line, Glm, Distinct, GnotAB, IN_DELETE; ¬(G,E same_side t) proof assume G,E same_side t [Gsim_tE]; A ∉ open (G,E) [notGAE] by t_line, -, SameSide_DEF, ∉; G ∈ ray A E â” A by Distinct, GnotAB, notGAE, IN_Ray, GnotAB, IN_DELETE; ray A G = ray A E [rAGrAE] by Distinct, -, RayWellDefined; ¬(C,G same_side t) by t_line, AGBncol, Distinct, Gsim_tE, Cnsim_tE, SameSideTransitive; C ∉ ray B G ∧ B ∈ open (C,G) by t_line, AGBncol, Distinct, -, RaySameSide, ∉, GnotAB, IN_DELETE, IN_Ray; ∡ G A B <_ang ∡ C B A by AGBncol, -, B1', EuclidPropositionI_16; ∡ E A B <_ang ∡ C B A by -, rAGrAE, Angle_DEF; qed by EABncol, ANGLE, AltIntAngCong, -, AngleTrichotomy1; G,C same_side t [Gsim_tC] by t_line, AGBncol, Distinct, -, Cnsim_tE, AtMost2Sides; :: now we make a symmetric argument B ∉ open (G,C) [notGBC] by t_line, -, SameSide_DEF, ∉; G ∈ ray B C â” B by Distinct, GnotAB, notGBC, IN_Ray, GnotAB, IN_DELETE; ray B G = ray B C [rBGrBC] by Distinct, -, RayWellDefined; ∡ C B A ≡ ∡ E A B [flipAltIntAngCong] by EABncol, ANGLE, AltIntAngCong, C5Symmetric; ¬(E,G same_side t) by t_line, AGBncol, Distinct, Gsim_tC, Ensim_tC, SameSideTransitive; E ∉ ray A G ∧ A ∈ open (E,G) by t_line, AGBncol, Distinct, -, RaySameSide, ∉, GnotAB, IN_Ray, IN_DELETE; ∡ G B A <_ang ∡ E A B by AGBncol, -, B1', EuclidPropositionI_16; ∡ C B A <_ang ∡ E A B by -, rBGrBC, Angle_DEF; qed by EABncol, ANGLE, flipAltIntAngCong, -, AngleTrichotomy1; `;; let EuclidPropositionI_28 = thm `; let A B C D E F G H be point; let l m t be point_set; assume Line l ∧ A ∈ l ∧ B ∈ l ∧ G ∈ l [l_line]; assume Line m ∧ C ∈ m ∧ D ∈ m ∧ H ∈ m [m_line]; assume Line t ∧ G ∈ t ∧ H ∈ t [t_line]; assume G ∉ m ∧ H ∉ l [notGmHl]; assume G ∈ open (A,B) ∧ H ∈ open (C,D) [H1]; assume G ∈ open (E,H) ∧ H ∈ open (F,G) [H2]; assume ¬(D,A same_side t) [H3]; assume ∡ E G B ≡ ∡ G H D ∨ ∡ B G H suppl ∡ G H D [H4]; thus l ∥ m proof ¬(A = G) ∧ ¬(G = B) ∧ ¬(H = D) ∧ ¬(E = G) ∧ ¬(G = H) ∧ Collinear A G B ∧ Collinear E G H [Distinct] by H1, H2, B1'; ¬Collinear H G A ∧ ¬Collinear G H D ∧ A ∉ t ∧ D ∉ t [HGAncol] by l_line, m_line, Distinct, I1, Collinear_DEF, notGmHl, ∉, t_line, Collinear_DEF; ¬Collinear B G H ∧ ¬Collinear A G E ∧ ¬Collinear E G B [BGHncol] by -, Distinct, CollinearSymmetry, NoncollinearityExtendsToLine; ∡ A G H ≡ ∡ D H G proof cases by H4; suppose ∡ E G B ≡ ∡ G H D [EGBeqGHD]; ∡ E G B ≡ ∡ H G A by BGHncol, H1, H2, VerticalAnglesCong; ∡ H G A ≡ ∡ E G B by BGHncol, HGAncol, ANGLE, -, C5Symmetric; ∡ H G A ≡ ∡ G H D by BGHncol, HGAncol, ANGLE, -, EGBeqGHD, C5Transitive; qed by -, AngleSymmetry; suppose ∡ B G H suppl ∡ G H D [BGHeqGHD]; ∡ B G H suppl ∡ H G A by BGHncol, H1, B1', SupplementaryAngles_DEF; qed by -, BGHeqGHD, AngleSymmetry, SupplementUnique, AngleSymmetry; end; qed by l_line, m_line, t_line, Distinct, HGAncol, H3, -, AlternateInteriorAngles; `;; let OppositeSidesCongImpliesParallelogram = thm `; let A B C D be point; assume Quadrilateral A B C D [H1]; assume seg A B ≡ seg C D ∧ seg B C ≡ seg D A [H2]; thus Parallelogram A B C D proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; consider a c such that Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by TetraABCD, I1; consider b d such that Line b ∧ B ∈ b ∧ C ∈ b ∧ Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by TetraABCD, I1; consider l such that Line l ∧ A ∈ l ∧ C ∈ l [l_line] by TetraABCD, I1; consider m such that Line m ∧ B ∈ m ∧ D ∈ m [m_line] by TetraABCD, I1; B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m [notBDlACm] by l_line, m_line, TetraABCD, Collinear_DEF, ∉; seg A C ≡ seg C A ∧ seg B D ≡ seg D B [seg_refl] by TetraABCD, SEGMENT, C2Reflexive, SegmentSymmetry; A,B,C ≅ C,D,A by TetraABCD, H2, -, SSS; ∡ B C A ≡ ∡ D A C ∧ ∡ C A B ≡ ∡ A C D [BCAeqDAC] by -, TriangleCong_DEF; seg C D ≡ seg A B [CDeqAB] by TetraABCD, SEGMENT, H2, C2Symmetric; B,C,D ≅ D,A,B by TetraABCD, H2, -, seg_refl, SSS; ∡ C D B ≡ ∡ A B D ∧ ∡ D B C ≡ ∡ B D A [CDBeqABD] by -, TriangleCong_DEF; ¬(B,D same_side l) ∨ ¬(A,C same_side m) by H1, l_line, m_line, FiveChoicesQuadrilateral; cases by -; suppose ¬(B,D same_side l); ¬(D,B same_side l) by l_line, notBDlACm, -, SameSideSymmetric; a ∥ c ∧ b ∥ d by ac_line, l_line, TetraABCD, notBDlACm, -, BCAeqDAC, AngleSymmetry, AlternateInteriorAngles, bd_line, BCAeqDAC; qed by H1, ac_line, bd_line, -, Parallelogram_DEF; suppose ¬(A,C same_side m); b ∥ d ∧ c ∥ a by bd_line, m_line, TetraABCD, notBDlACm, -, CDBeqABD, AngleSymmetry, AlternateInteriorAngles, ac_line, CDBeqABD; qed by H1, ac_line, bd_line, -, ParallelSymmetry, Parallelogram_DEF; end; `;; let OppositeAnglesCongImpliesParallelogramHelp = thm `; let A B C D be point; let a c be point_set; assume Quadrilateral A B C D [H1]; assume ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D [H2]; assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; assume Line c ∧ C ∈ c ∧ D ∈ c [c_line]; thus a ∥ c proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; ∡ C D A ≡ ∡ A B C ∧ ∡ B C D ≡ ∡ D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; consider l m such that Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by TetraABCD, I1; consider b d such that Line b ∧ B ∈ b ∧ C ∈ b ∧ Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by TetraABCD, I1; A ∉ c ∧ B ∉ c ∧ A ∉ b ∧ D ∉ b ∧ B ∉ d ∧ C ∉ d [point_off_line] by c_line, bd_line, Collinear_DEF, TetraABCD, ∉; ¬(A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) proof assume A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C; ∡ B C D <_ang ∡ D A B ∨ ∡ C D A <_ang ∡ A B C ∨ ∡ D A B <_ang ∡ B C D ∨ ∡ A B C <_ang ∡ C D A by TetraABCD, -, EuclidPropositionI_21; qed by -, H2', H2, AngleTrichotomy1; ConvexQuadrilateral A B C D by H1, lm_line, -, FiveChoicesQuadrilateral; A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C [AintBCD] by -, ConvexQuad_DEF; B,A same_side c ∧ B,C same_side d [Bsim_cA] by c_line, bd_line, -, InteriorUse; A,D same_side b [Asim_bD] by bd_line, c_line, AintBCD, InteriorUse; assume ¬(a ∥ c); consider G such that G ∈ a ∧ G ∈ c [Gac] by -, a_line, c_line, PARALLEL, MEMBER_NOT_EMPTY, IN_INTER; Collinear A B G ∧ Collinear D G C ∧ Collinear C G D [ABGcol] by a_line, -, Collinear_DEF, c_line; ¬(G = A) ∧ ¬(G = B) ∧ ¬(G = C) ∧ ¬(G = D) [GnotABCD] by Gac, ABGcol, TetraABCD, CollinearSymmetry, Collinear_DEF; ¬Collinear B G C ∧ ¬Collinear A D G [BGCncol] by c_line, Gac, GnotABCD, I1, Collinear_DEF, point_off_line, ∉; ¬Collinear B C G ∧ ¬Collinear G B C ∧ ¬Collinear G A D ∧ ¬Collinear A G D [BCGncol] by -, CollinearSymmetry; G ∉ b ∧ G ∉ d [notGb] by bd_line, Collinear_DEF, BGCncol, ∉; G ∉ open (B,A) [notBGA] by Bsim_cA, Gac, SameSide_DEF, ∉; B ∉ open (A,G) [notABG] proof assume ¬(B ∉ open (A,G)); B ∈ open (A,G) [ABG] by -, ∉; ray A B = ray A G [rABrAG] by -, IntervalRay; ¬(A,G same_side b) by bd_line, ABG, SameSide_DEF; ¬(D,G same_side b) by bd_line, point_off_line, notGb, Asim_bD, -, SameSideTransitive; D ∉ ray C G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, ∉; C ∈ open (D,G) [DCG] by GnotABCD, ABGcol, -, IN_Ray, ∉; consider M such that D ∈ open (C,M) [CDM] by TetraABCD, B2'; D ∈ open (G,M) [GDM] by -, B1', DCG, TransitivityBetweennessHelp; ∡ C D A suppl ∡ A D M ∧ ∡ A B C suppl ∡ C B G by TetraABCD, CDM, ABG, SupplementaryAngles_DEF; ∡ M D A ≡ ∡ G B C [MDAeqGBC] by -, H2', SupplementsCongAnglesCong, AngleSymmetry; ∡ G A D <_ang ∡ M D A ∧ ∡ G B C <_ang ∡ D C B by BCGncol, BGCncol, GDM, DCG, B1', EuclidPropositionI_16; ∡ G A D <_ang ∡ D C B by -, BCGncol, ANGLE, MDAeqGBC, AngleTrichotomy2, AngleOrderTransitivity; ∡ D A B <_ang ∡ B C D by -, rABrAG, Angle_DEF, AngleSymmetry; qed by -, H2, AngleTrichotomy1; A ∉ open (G,B) proof assume ¬(A ∉ open (G,B)); A ∈ open (B,G) [BAG] by -, B1', ∉; ray B A = ray B G [rBArBG] by -, IntervalRay; ¬(B,G same_side d) by bd_line, BAG, SameSide_DEF; ¬(C,G same_side d) by bd_line, point_off_line, notGb, Bsim_cA, -, SameSideTransitive; C ∉ ray D G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, ∉; D ∈ open (C,G) [CDG] by GnotABCD, ABGcol, -, IN_Ray, ∉; consider M such that C ∈ open (D,M) [DCM] by B2', TetraABCD; C ∈ open (G,M) [GCM] by -, B1', CDG, TransitivityBetweennessHelp; ∡ B C D suppl ∡ M C B ∧ ∡ D A B suppl ∡ G A D by TetraABCD, CollinearSymmetry, DCM, BAG, SupplementaryAngles_DEF, AngleSymmetry; ∡ M C B ≡ ∡ G A D [GADeqMCB] by -, H2', SupplementsCongAnglesCong; ∡ G B C <_ang ∡ M C B ∧ ∡ G A D <_ang ∡ C D A by BGCncol, GCM, BCGncol, CDG, B1', EuclidPropositionI_16; ∡ G B C <_ang ∡ C D A by -, BCGncol, ANGLE, GADeqMCB, AngleTrichotomy2, AngleOrderTransitivity; ∡ A B C <_ang ∡ C D A by -, rBArBG, Angle_DEF; qed by -, H2, AngleTrichotomy1; qed by TetraABCD, GnotABCD, ABGcol, notABG, notBGA, -, B3', ∉; `;; let OppositeAnglesCongImpliesParallelogram = thm `; let A B C D be point; assume Quadrilateral A B C D [H1]; assume ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D [H2]; thus Parallelogram A B C D proof Quadrilateral B C D A [QuadBCDA] by H1, QuadrilateralSymmetry; ¬(A = B) ∧ ¬(B = C) ∧ ¬(C = D) ∧ ¬(D = A) ∧ ¬Collinear B C D ∧ ¬Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; ∡ B C D ≡ ∡ D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; consider a such that Line a ∧ A ∈ a ∧ B ∈ a [a_line] by TetraABCD, I1; consider b such that Line b ∧ B ∈ b ∧ C ∈ b [b_line] by TetraABCD, I1; consider c such that Line c ∧ C ∈ c ∧ D ∈ c [c_line] by TetraABCD, I1; consider d such that Line d ∧ D ∈ d ∧ A ∈ d [d_line] by TetraABCD, I1; qed by H1, QuadBCDA, H2, H2', a_line, b_line, c_line, d_line, OppositeAnglesCongImpliesParallelogramHelp, Parallelogram_DEF; `;; let P = new_axiom `∀ P l. Line l ∧ P ∉ l ⇒ ∃! m. Line m ∧ P ∈ m ∧ m ∥ l`;; new_constant("μ",`:point_set->real`);; let AMa = new_axiom `∀ α. Angle α ⇒ &0 < μ α ∧ μ α < &180`;; let AMb = new_axiom `∀ α. Right α ⇒ μ α = &90`;; let AMc = new_axiom `∀ α β. Angle α ∧ Angle β ∧ α ≡ β ⇒ μ α = μ β`;; let AMd = new_axiom `∀ A O B P. P ∈ int_angle A O B ⇒ μ (∡ A O B) = μ (∡ A O P) + μ (∡ P O B)`;; let ConverseAlternateInteriorAngles = thm `; let A B C E be point; let l m t be point_set; assume Line l ∧ A ∈ l ∧ E ∈ l [l_line]; assume Line m ∧ B ∈ m ∧ C ∈ m [m_line]; assume Line t ∧ A ∈ t ∧ B ∈ t [t_line]; assume ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t [Distinct]; assume ¬(C,E same_side t) [Cnsim_tE]; assume l ∥ m [para_lm]; thus ∡ E A B ≡ ∡ C B A proof ¬Collinear C B A by t_line, Distinct, I1, Collinear_DEF, ∉, ANGLE; A ∉ m ∧ Angle (∡ C B A) [notAm] by m_line, -, Collinear_DEF, ∉, ANGLE; consider D such that ¬(A = D) ∧ D ∉ t ∧ ¬(C,D same_side t) ∧ seg A D ≡ seg A E ∧ ∡ B A D ≡ ∡ C B A [Dexists] by -, Distinct, t_line, C4OppositeSide; consider k such that Line k ∧ A ∈ k ∧ D ∈ k [k_line] by Distinct, I1; k ∥ m by -, m_line, t_line, Dexists, Distinct, AngleSymmetry, AlternateInteriorAngles; k = l by m_line, notAm, l_line, k_line, -, para_lm, P; D,E same_side t ∧ A ∉ open (D,E) ∧ Collinear A E D by t_line, Distinct, Dexists, Cnsim_tE, AtMost2Sides, SameSide_DEF, ∉, -, k_line, l_line, Collinear_DEF; ray A D = ray A E by Distinct, -, IN_Ray, Dexists, IN_DELETE, RayWellDefined; qed by -, Dexists, AngleSymmetry, Angle_DEF; `;; let HilbertTriangleSum = thm `; let A B C be point; assume ¬Collinear A B C [ABCncol]; thus ∃ E F. B ∈ open (E,F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A proof ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear C A B [Distinct] by ABCncol, NonCollinearImpliesDistinct, CollinearSymmetry; consider l such that Line l ∧ A ∈ l ∧ C ∈ l [l_line] by Distinct, I1; consider x such that Line x ∧ A ∈ x ∧ B ∈ x [x_line] by Distinct, I1; consider y such that Line y ∧ B ∈ y ∧ C ∈ y [y_line] by Distinct, I1; C ∉ x [notCx] by x_line, ABCncol, Collinear_DEF, ∉; Angle (∡ C A B) by ABCncol, CollinearSymmetry, ANGLE; consider E such that ¬(B = E) ∧ E ∉ x ∧ ¬(C,E same_side x) ∧ seg B E ≡ seg A B ∧ ∡ A B E ≡ ∡ C A B [Eexists] by -, Distinct, x_line, notCx, C4OppositeSide; consider m such that Line m ∧ B ∈ m ∧ E ∈ m [m_line] by -, I1, IN_DELETE; ∡ E B A ≡ ∡ C A B [EBAeqCAB] by Eexists, AngleSymmetry; m ∥ l [para_lm] by m_line, l_line, x_line, Eexists, Distinct, notCx, -, AlternateInteriorAngles; m ∩ l = ∅ [lm0] by -, PARALLEL; C ∉ m ∧ A ∉ m [notACm] by -, l_line, INTER_COMM, DisjointOneNotOther; consider F such that B ∈ open (E,F) [EBF] by Eexists, B2'; ¬(B = F) ∧ F ∈ m [EBF'] by -, B1', m_line, BetweenLinear; ¬Collinear A B F ∧ F ∉ x [ABFncol] by m_line, -, I1, Collinear_DEF, notACm, ∉, x_line; ¬(E,F same_side x) ∧ ¬(E,F same_side y) [Ensim_yF] by EBF, x_line, y_line, SameSide_DEF; C,F same_side x [Csim_xF] by x_line, notCx, Eexists, ABFncol, Eexists, -, AtMost2Sides; m ∩ open(C,A) = ∅ by l_line, BetweenLinear, SUBSET, SET_RULE, lm0, SUBSET_EMPTY; C,A same_side m by m_line, -, SameSide_DEF, SET_RULE; C ∈ int_angle A B F [CintABF] by ABFncol, x_line, m_line, EBF', notCx, notACm, Csim_xF, -, IN_InteriorAngle; A ∈ int_angle C B E by EBF, B1', -, InteriorAngleSymmetry, InteriorReflectionInterior; A ∉ y ∧ A,E same_side y [Asim_yE] by y_line, m_line, -, InteriorUse; E ∉ y ∧ F ∉ y [notEFy] by y_line, m_line, EBF', Eexists, EBF', I1, Collinear_DEF, notACm, ∉; E,A same_side y by y_line, -, Asim_yE, SameSideSymmetric; ¬(A,F same_side y) [Ansim_yF] by y_line, notEFy, Asim_yE, -, Ensim_yF, SameSideTransitive; ∡ F B C ≡ ∡ A C B by m_line, EBF', l_line, y_line, EBF', Distinct, notEFy, Asim_yE, Ansim_yF, para_lm, ConverseAlternateInteriorAngles; qed by EBF, CintABF, EBAeqCAB, -, AngleSymmetry; `;; let EuclidPropositionI_13 = thm `; let A O B A' be point; assume ¬Collinear A O B [H1]; assume O ∈ open (A,A') [H2]; thus μ (∡ A O B) + μ (∡ B O A') = &180 proof cases; suppose Right (∡ A O B); Right (∡ B O A') ∧ μ (∡ A O B) = &90 ∧ μ (∡ B O A') = &90 by H1, H2, -, RightImpliesSupplRight, AMb; qed by -, REAL_ARITH; suppose ¬Right (∡ A O B) [notRightAOB]; ¬(A = O) ∧ ¬(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; consider l such that Line l ∧ O ∈ l ∧ A ∈ l ∧ A' ∈ l [l_line] by -, I1, H2, BetweenLinear; B ∉ l [notBl] by -, Distinct, I1, Collinear_DEF, H1, ∉; consider F such that Right (∡ O A F) ∧ Angle (∡ O A F) [RightOAF] by Distinct, EuclidPropositionI_11, RightImpliesAngle; ∃! r. Ray r ∧ ∃ E. ¬(O = E) ∧ r = ray O E ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F by -, Distinct, l_line, notBl, C4; consider E such that ¬(O = E) ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F [Eexists] by -; ¬Collinear A O E [AOEncol] by l_line, Distinct, I1, Collinear_DEF, -, ∉; Right (∡ A O E) [RightAOE] by -, ANGLE, RightOAF, Eexists, CongRightImpliesRight; Right (∡ E O A') ∧ μ (∡ A O E) = &90 ∧ μ (∡ E O A') = &90 [RightEOA'] by AOEncol, H2, -, RightImpliesSupplRight, AMb; ¬(∡ A O B ≡ ∡ A O E) by notRightAOB, H1, ANGLE, RightAOE, CongRightImpliesRight; ¬(∡ A O B = ∡ A O E) by H1, AOEncol, ANGLE, -, C5Reflexive; ¬(ray O B = ray O E) by -, Angle_DEF; B ∉ ray O E ∧ O ∉ open (B,E) by Distinct, -, Eexists, RayWellDefined, IN_DELETE, ∉, l_line, B1', SameSide_DEF; ¬Collinear O E B by -, Eexists, IN_Ray, ∉; E ∈ int_angle A O B ∨ B ∈ int_angle A O E by Distinct, l_line, Eexists, notBl, AngleOrdering, -, CollinearSymmetry, InteriorAngleSymmetry; cases by -; suppose E ∈ int_angle A O B [EintAOB]; B ∈ int_angle E O A' by H2, -, InteriorReflectionInterior; μ (∡ A O B) = μ (∡ A O E) + μ (∡ E O B) ∧ μ (∡ E O A') = μ (∡ E O B) + μ (∡ B O A') by EintAOB, -, AMd; qed by -, RightEOA', REAL_ARITH; suppose B ∈ int_angle A O E [BintAOE]; E ∈ int_angle B O A' by H2, -, InteriorReflectionInterior; μ (∡ A O E) = μ (∡ A O B) + μ (∡ B O E) ∧ μ (∡ B O A') = μ (∡ B O E) + μ (∡ E O A') by BintAOE, -, AMd; qed by -, RightEOA', REAL_ARITH; end; end; `;; let TriangleSum = thm `; let A B C be point; assume ¬Collinear A B C [ABCncol]; thus μ (∡ A B C) + μ (∡ B C A) + μ (∡ C A B) = &180 proof ¬Collinear C A B ∧ ¬Collinear B C A [CABncol] by ABCncol, CollinearSymmetry; consider E F such that B ∈ open (E,F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A [EBF] by ABCncol, HilbertTriangleSum; ¬Collinear C B F ∧ ¬Collinear A B F ∧ Collinear E B F ∧ ¬(B = E) [CBFncol] by -, InteriorAngleSymmetry, InteriorEZHelp, IN_InteriorAngle, B1', CollinearSymmetry; ¬Collinear E B A [EBAncol] by CollinearSymmetry, -, NoncollinearityExtendsToLine; μ (∡ A B F) = μ (∡ A B C) + μ (∡ C B F) [μCintABF] by EBF, AMd; μ (∡ E B A) + μ (∡ A B F) = &180 [suppl180] by EBAncol, EBF, EuclidPropositionI_13; μ (∡ C A B) = μ (∡ E B A) ∧ μ (∡ B C A) = μ (∡ C B F) by CABncol, EBAncol, CBFncol, ANGLE, EBF, AMc; qed by suppl180, μCintABF, -, REAL_ARITH; `;; hol-light/RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml000066400000000000000000005215521303454263000242060ustar00rootroot00000000000000(* ----------------------------------------------------------------- *) (* HOL Light Hilbert geometry axiomatic proofs using miz3. *) (* ----------------------------------------------------------------- *) (* High school students can learn rigorous axiomatic Geometry proofs, as in http://www.math.northwestern.edu/~richter/hilbert.pdf, using Hilbert's axioms, and code up their proofs in miz3 and HOL Light. Thanks to Bjørn Jahren, Miguel Lerma,Takuo Matsuoka, Stephen Wilson for advice on Hilbert's axioms, and especially Benjamin Kordesh, who carefully read much of the paper and the code. Formal proofs are given for the first 7 sections of the paper, the results cited there from Greenberg's book, and most of Euclid's book I propositions up to Proposition I.29, following Hartshorne, whose book seems the most exciting axiomatic geometry text. A proof assistant is an valuable tool to help read it, as Hartshorne's proofs are often sketchy and even have gaps. M. Greenberg, Euclidean and non-Euclidean geometries, W. H. Freeman and Co., 1974. R. Hartshorne, Geometry, Euclid and Beyond, Undergraduate Texts in Math., Springer, 2000. Thanks to Mizar folks for their influential language, Freek Wiedijk, who wrote the miz3 port of Mizar to HOL Light, and especially John Harrison, who was extremely helpful and developed the framework for porting my axiomatic proofs to HOL Light. *) verbose := false;; report_timing := false;; horizon := 0;; timeout := 150;; new_type("point",0);; new_type_abbrev("point_set",`:point->bool`);; new_constant("Between",`:point->point->point->bool`);; new_constant("Line",`:point_set->bool`);; new_constant("===",`:(point->bool)->(point->bool)->bool`);; parse_as_infix("cong",(12, "right"));; parse_as_infix("same_side",(12, "right"));; parse_as_infix("===",(12, "right"));; parse_as_infix("<__",(12, "right"));; parse_as_infix("<_ang",(12, "right"));; parse_as_infix("suppl",(12, "right"));; parse_as_infix("NOTIN",(11, "right"));; parse_as_infix("parallel",(12, "right"));; let NOTIN = new_definition `!a:A l:A->bool. a NOTIN l <=> ~(a IN l)`;; let Interval_DEF = new_definition `! A B. open (A,B) = {X | Between A X B}`;; let Collinear_DEF = new_definition `Collinear A B C <=> ? l. Line l /\ A IN l /\ B IN l /\ C IN l`;; let SameSide_DEF = new_definition `A,B same_side l <=> Line l /\ ~ ? X. (X IN l) /\ X IN open (A,B)`;; let Ray_DEF = new_definition `! A B. ray A B = {X | ~(A = B) /\ Collinear A B X /\ A NOTIN open (X,B)}`;; let Ordered_DEF = new_definition `ordered A B C D <=> B IN open (A,C) /\ B IN open (A,D) /\ C IN open (A,D) /\ C IN open (B,D)`;; let InteriorAngle_DEF = new_definition `! A O B. int_angle A O B = {P:point | ~Collinear A O B /\ ? a b. Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ P NOTIN a /\ P NOTIN b /\ P,B same_side a /\ P,A same_side b}`;; let InteriorTriangle_DEF = new_definition `! A B C. int_triangle A B C = {P | P IN int_angle A B C /\ P IN int_angle B C A /\ P IN int_angle C A B}`;; let Tetralateral_DEF = new_definition `Tetralateral A B C D <=> ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B`;; let Quadrilateral_DEF = new_definition `Quadrilateral A B C D <=> Tetralateral A B C D /\ open (A,B) INTER open (C,D) = {} /\ open (B,C) INTER open (D,A) = {} `;; let ConvexQuad_DEF = new_definition `ConvexQuadrilateral A B C D <=> Quadrilateral A B C D /\ A IN int_angle B C D /\ B IN int_angle C D A /\ C IN int_angle D A B /\ D IN int_angle A B C `;; let Segment_DEF = new_definition `seg A B = {A, B} UNION open (A,B)`;; let SEGMENT = new_definition `Segment s <=> ? A B. s = seg A B /\ ~(A = B)`;; let SegmentOrdering_DEF = new_definition `s <__ t <=> Segment s /\ ? C D X. t = seg C D /\ X IN open (C,D) /\ s === seg C X`;; let Angle_DEF = new_definition ` angle A O B = ray O A UNION ray O B `;; let ANGLE = new_definition `Angle alpha <=> ? A O B. alpha = angle A O B /\ ~Collinear A O B`;; let AngleOrdering_DEF = new_definition `alpha <_ang beta <=> Angle alpha /\ ? A O B G. ~Collinear A O B /\ beta = angle A O B /\ G IN int_angle A O B /\ alpha === angle A O G`;; let RAY = new_definition `Ray r <=> ? O A. ~(O = A) /\ r = ray O A`;; let TriangleCong_DEF = new_definition `! A B C A' B' C' :point. (A, B, C) cong (A', B', C') <=> ~Collinear A B C /\ ~Collinear A' B' C' /\ seg A B === seg A' B' /\ seg A C === seg A' C' /\ seg B C === seg B' C' /\ angle A B C === angle A' B' C' /\ angle B C A === angle B' C' A' /\ angle C A B === angle C' A' B'`;; let SupplementaryAngles_DEF = new_definition `! alpha beta. alpha suppl beta <=> ? A O B A'. ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ beta = angle B O A'`;; let RightAngle_DEF = new_definition `! alpha. Right alpha <=> ? beta. alpha suppl beta /\ alpha === beta`;; let PlaneComplement_DEF = new_definition `! alpha:point_set. complement alpha = {P | P NOTIN alpha}`;; let CONVEX = new_definition `Convex alpha <=> ! A B. A IN alpha /\ B IN alpha ==> open (A,B) SUBSET alpha`;; let PARALLEL = new_definition `! l k. l parallel k <=> Line l /\ Line k /\ l INTER k = {}`;; let Parallelogram_DEF = new_definition `! A B C D. Parallelogram A B C D <=> Quadrilateral A B C D /\ ? a b c d. Line a /\ A IN a /\ B IN a /\ Line b /\ B IN b /\ C IN b /\ Line c /\ C IN c /\ D IN d /\ Line d /\ D IN d /\ A IN d /\ a parallel c /\ b parallel d`;; let InteriorCircle_DEF = new_definition `! O R. int_circle O R = {P | ~(O = R) /\ (P = O \/ seg O P <__ seg O R)} `;; (* ---------------------------------------------------------------------------- *) (* Hilbert's geometry axioms, except the parallel axiom P, defined near the end. *) (* ---------------------------------------------------------------------------- *) let I1 = new_axiom `! A B. ~(A = B) ==> ?! l. Line l /\ A IN l /\ B IN l`;; let I2 = new_axiom `! l. Line l ==> ? A B. A IN l /\ B IN l /\ ~(A = B)`;; let I3 = new_axiom `? A B C. ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~Collinear A B C`;; let B1 = new_axiom `! A B C. Between A B C ==> ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Between C B A /\ Collinear A B C`;; let B2 = new_axiom `! A B. ~(A = B) ==> ? C. Between A B C`;; let B3 = new_axiom `! A B C. ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C ==> (Between A B C \/ Between B C A \/ Between C A B) /\ ~(Between A B C /\ Between B C A) /\ ~(Between A B C /\ Between C A B) /\ ~(Between B C A /\ Between C A B)`;; let B4 = new_axiom `! l A B C. Line l /\ ~Collinear A B C /\ A NOTIN l /\ B NOTIN l /\ C NOTIN l /\ (? X. X IN l /\ Between A X C) ==> (? Y. Y IN l /\ Between A Y B) \/ (? Y. Y IN l /\ Between B Y C)`;; let C1 = new_axiom `! s O Z. Segment s /\ ~(O = Z) ==> ?! P. P IN ray O Z DELETE O /\ seg O P === s`;; let C2Reflexive = new_axiom `Segment s ==> s === s`;; let C2Symmetric = new_axiom `Segment s /\ Segment t /\ s === t ==> t === s`;; let C2Transitive = new_axiom `Segment s /\ Segment t /\ Segment u /\ s === t /\ t === u ==> s === u`;; let C3 = new_axiom `! A B C A' B' C'. B IN open (A,C) /\ B' IN open (A',C') /\ seg A B === seg A' B' /\ seg B C === seg B' C' ==> seg A C === seg A' C'`;; let C4 = new_axiom `! alpha O A l Y. Angle alpha /\ ~(O = A) /\ Line l /\ O IN l /\ A IN l /\ Y NOTIN l ==> ?! r. Ray r /\ ? B. ~(O = B) /\ r = ray O B /\ B NOTIN l /\ B,Y same_side l /\ angle A O B === alpha`;; let C5Reflexive = new_axiom `Angle alpha ==> alpha === alpha`;; let C5Symmetric = new_axiom `Angle alpha /\ Angle beta /\ alpha === beta ==> beta === alpha`;; let C5Transitive = new_axiom `Angle alpha /\ Angle beta /\ Angle gamma /\ alpha === beta /\ beta === gamma ==> alpha === gamma`;; let C6 = new_axiom `! A B C A' B' C'. ~Collinear A B C /\ ~Collinear A' B' C' /\ seg B A === seg B' A' /\ seg B C === seg B' C' /\ angle A B C === angle A' B' C' ==> angle B C A === angle B' C' A'`;; (* ----------------------------------------------------------------- *) (* Theorems. *) (* ----------------------------------------------------------------- *) let IN_Interval = thm `; ! A B X. X IN open (A,B) <=> Between A X B by Interval_DEF, SET_RULE; `;; let IN_Ray = thm `; ! A B X. X IN ray A B <=> ~(A = B) /\ Collinear A B X /\ A NOTIN open (X,B) by Ray_DEF, SET_RULE; `;; let IN_InteriorAngle = thm `; ! A O B P. P IN int_angle A O B <=> ~Collinear A O B /\ ? a b. Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ P NOTIN a /\ P NOTIN b /\ P,B same_side a /\ P,A same_side b by InteriorAngle_DEF, SET_RULE; `;; let IN_InteriorTriangle = thm `; ! A B C P. P IN int_triangle A B C <=> P IN int_angle A B C /\ P IN int_angle B C A /\ P IN int_angle C A B by InteriorTriangle_DEF, SET_RULE; `;; let IN_PlaneComplement = thm `; ! alpha:point_set. ! P. P IN complement alpha <=> P NOTIN alpha by PlaneComplement_DEF, SET_RULE; `;; let IN_InteriorCircle = thm `; ! O R P. P IN int_circle O R <=> ~(O = R) /\ (P = O \/ seg O P <__ seg O R) by InteriorCircle_DEF, SET_RULE; `;; let B1' = thm `; ! A B C. B IN open (A,C) ==> ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ B IN open (C,A) /\ Collinear A B C by IN_Interval, B1; `;; let B2' = thm `; ! A B. ~(A = B) ==> ? C. B IN open (A,C) by IN_Interval, B2; `;; let B3' = thm `; ! A B C. ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C ==> (B IN open (A,C) \/ C IN open (B,A) \/ A IN open (C,B)) /\ ~(B IN open (A,C) /\ C IN open (B,A)) /\ ~(B IN open (A,C) /\ A IN open (C,B)) /\ ~(C IN open (B,A) /\ A IN open (C,B)) by IN_Interval, B3; `;; let B4' = thm `; ! l A B C. Line l /\ ~Collinear A B C /\ A NOTIN l /\ B NOTIN l /\ C NOTIN l /\ (? X. X IN l /\ X IN open (A,C)) ==> (? Y. Y IN l /\ Y IN open (A,B)) \/ (? Y. Y IN l /\ Y IN open (B,C)) by IN_Interval, B4; `;; let B4'' = thm `; ! l:point_set. ! A B C:point. Line l /\ ~Collinear A B C /\ A NOTIN l /\ B NOTIN l /\ C NOTIN l /\ A,B same_side l /\ B,C same_side l ==> A,C same_side l by B4', SameSide_DEF; `;; let DisjointOneNotOther = thm `; ! l m:A->bool. (! x:A. x IN m ==> x NOTIN l) <=> l INTER m = {} by SET_RULE, NOTIN; `;; let EquivIntersectionHelp = thm `; ! e x:A. ! l m:A->bool. (l INTER m = {x} \/ m INTER l = {x}) /\ e IN m DELETE x ==> e NOTIN l by SET_RULE, NOTIN; `;; let CollinearSymmetry = thm `; let A B C be point; assume Collinear A B C [H1]; thus Collinear A C B /\ Collinear B A C /\ Collinear B C A /\ Collinear C A B /\ Collinear C B A proof consider l such that Line l /\ A IN l /\ B IN l /\ C IN l by H1, Collinear_DEF; qed by -, Collinear_DEF; `;; let ExistsNewPointOnLine = thm `; let P be point; let l be point_set; assume Line l /\ P IN l [H1]; thus ? Q. Q IN l /\ ~(P = Q) proof consider A B such that A IN l /\ B IN l /\ ~(A = B) [l_line] by H1, I2; cases; suppose P = A; qed by -, l_line; suppose ~(P = A); qed by -, l_line; end; `;; let ExistsPointOffLine = thm `; let l be point_set; assume Line l [H1]; thus ? Q:point. Q NOTIN l proof consider A B C such that ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~Collinear A B C [Distinct] by I3; (A NOTIN l \/ B NOTIN l \/ C NOTIN l) \/ (A IN l /\ B IN l /\ C IN l) by NOTIN; cases by -; suppose A NOTIN l \/ B NOTIN l \/ C NOTIN l; qed by -; suppose (A IN l) /\ (B IN l) /\ (C IN l); Collinear A B C by H1, -, Collinear_DEF; qed by -, Distinct; end; `;; let BetweenLinear = thm `; let A B C be point; let m be point_set; assume Line m /\ A IN m /\ C IN m [H1]; assume B IN open (A,C) \/ C IN open (B,A) \/ A IN open (C,B) [H2]; thus B IN m proof ~(A = C) /\ (Collinear A B C \/ Collinear B C A \/ Collinear C A B) [X1] by H2, B1'; consider l such that Line l /\ A IN l /\ B IN l /\ C IN l [X2] by -, Collinear_DEF; l = m by X1, -, H2, H1, I1; qed by -, X2; `;; let CollinearLinear = thm `; let A B C be point; let m be point_set; assume Line m /\ A IN m /\ C IN m [H1]; assume Collinear A B C \/ Collinear B C A \/ Collinear C A B [H2]; assume ~(A = C) [H3]; thus B IN m proof consider l such that Line l /\ A IN l /\ B IN l /\ C IN l [X1] by H2, Collinear_DEF; l = m by H3, -, H1, I1; qed by -, X1; `;; let NonCollinearImpliesDistinct = thm `; let A B C be point; assume ~Collinear A B C [H1]; thus ~(A = B) /\ ~(A = C) /\ ~(B = C) proof cases; suppose A = B /\ B = C [Case1]; consider Q such that ~(Q = A) by I3; qed by -, I1, Case1, Collinear_DEF, H1; suppose (A = B /\ ~(A = C)) \/ (A = C /\ ~(A = B)) \/ (B = C /\ ~(A = B)); qed by -, I1, Collinear_DEF, H1; suppose ~(A = B) /\ ~(A = C) /\ ~(B = C); qed by -; end; `;; let Reverse4Order = thm `; ! A B C D:point. ordered A B C D ==> ordered D C B A by Ordered_DEF, B1'; `;; let OriginInRay = thm `; let O Q be point; assume ~(Q = O) [H1]; thus O IN ray O Q proof O NOTIN open (O,Q) [OOQ] by B1', NOTIN; Collinear O Q O by H1, I1, Collinear_DEF; qed by H1, -, OOQ, IN_Ray; `;; let EndpointInRay = thm `; let O Q be point; assume ~(Q = O) [H1]; thus Q IN ray O Q proof O NOTIN open (Q,Q) [notOQQ] by B1', NOTIN; Collinear O Q Q by H1, I1, Collinear_DEF; qed by H1, -, notOQQ, IN_Ray; `;; let I1Uniqueness = thm `; let X be point; let l m be point_set; assume Line l /\ Line m [H0]; assume ~(l = m) [H1]; assume X IN l /\ X IN m [H2]; thus l INTER m = {X} proof assume ~(l INTER m = {X}) [H3]; X IN l INTER m by H2, IN_INTER; consider A such that A IN l INTER m /\ ~(A = X) [X1] by -, H3, SET_RULE; A IN l /\ X IN l /\ A IN m /\ X IN m by H0, -, H2, IN_INTER; l = m by H0, -, X1, I1; qed by -, H1; `;; let EquivIntersection = thm `; let A B X be point; let l m be point_set; assume Line l /\ Line m [H0]; assume l INTER m = {X} [H1]; assume A IN m DELETE X /\ B IN m DELETE X [H2]; assume X NOTIN open (A,B) [H3]; thus A,B same_side l proof assume ~(A,B same_side l) [Con]; A IN m /\ B IN m /\ ~(A = X) /\ ~(B = X) [H2'] by H2, IN_DELETE; ~(open (A,B) INTER l = {}) [nonempty] by H0, Con, SameSide_DEF, SET_RULE; open (A,B) SUBSET m [ABm] by H0, H2', BetweenLinear, SUBSET; open (A,B) INTER l SUBSET {X} by -, SET_RULE, H1; X IN open (A,B) INTER l by nonempty, -, SET_RULE; qed by -, IN_INTER, H3, NOTIN; `;; let RayLine = thm `; ! O P:point. ! l: point_set. Line l /\ O IN l /\ P IN l ==> ray O P SUBSET l by IN_Ray, CollinearLinear, SUBSET; `;; let RaySameSide = thm `; let l be point_set; let O A P be point; assume Line l /\ O IN l [l_line]; assume A NOTIN l [notAl]; assume P IN ray O A DELETE O [PrOA]; thus P NOTIN l /\ P,A same_side l proof ~(O = A) [notOA] by l_line, notAl, NOTIN; consider d such that Line d /\ O IN d /\ A IN d [d_line] by notOA, I1; ~(l = d) by -, notAl, NOTIN; l INTER d = {O} [ldO] by l_line, d_line, -, I1Uniqueness; A IN d DELETE O [Ad_O] by d_line, notOA, IN_DELETE; ray O A SUBSET d by d_line, RayLine; P IN d DELETE O [Pd_O] by PrOA, -, SUBSET, IN_DELETE; P NOTIN l [notPl] by ldO, -, EquivIntersectionHelp; O NOTIN open (P,A) by PrOA, IN_DELETE, IN_Ray; P,A same_side l by l_line, d_line, ldO, Ad_O, Pd_O, -, EquivIntersection; qed by notPl, -; `;; let IntervalRayEZ = thm `; let A B C be point; assume B IN open (A,C) [H1]; thus B IN ray A C DELETE A /\ C IN ray A B DELETE A proof ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C [ABC] by H1, B1'; A NOTIN open (B,C) /\ A NOTIN open (C,B) by -, H1, B3', B1', NOTIN; qed by ABC, CollinearSymmetry, -, IN_Ray, IN_DELETE, NOTIN; `;; let NoncollinearityExtendsToLine = thm `; let A O B X be point; assume ~Collinear A O B [H1]; assume Collinear O B X /\ ~(X = O) [H2]; thus ~Collinear A O X proof ~(A = O) /\ ~(A = B) /\ ~(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; consider b such that Line b /\ O IN b /\ B IN b [b_line] by Distinct, I1; A NOTIN b [notAb] by b_line, Collinear_DEF, H1, NOTIN; X IN b by H2, b_line, Distinct, I1, Collinear_DEF; qed by b_line, -, H2, I1, Collinear_DEF, notAb, NOTIN; `;; let SameSideReflexive = thm `; ! l A. Line l /\ A NOTIN l ==> A,A same_side l by B1', SameSide_DEF; `;; let SameSideSymmetric = thm `; ! l A B. Line l /\ A NOTIN l /\ B NOTIN l ==> A,B same_side l ==> B,A same_side l by SameSide_DEF, B1'; `;; let SameSideTransitive = thm `; let l be point_set; let A B C be point; assume Line l [l_line]; assume A NOTIN l /\ B NOTIN l /\ C NOTIN l [notABCl]; assume A,B same_side l [Asim_lB]; assume B,C same_side l [Bsim_lC]; thus A,C same_side l proof cases; suppose ~Collinear A B C \/ A = B \/ A = C \/ B = C; qed by l_line, -, notABCl, Asim_lB, Bsim_lC, B4'', SameSideReflexive; suppose Collinear A B C /\ ~(A = B) /\ ~(A = C) /\ ~(B = C) [Distinct]; consider m such that Line m /\ A IN m /\ C IN m [m_line] by Distinct, I1; B IN m [Bm] by -, Distinct, CollinearLinear; cases; suppose m INTER l = {}; qed by m_line, l_line, -, BetweenLinear, SET_RULE, SameSide_DEF; suppose ~(m INTER l = {}); consider X such that X IN l /\ X IN m [Xlm] by -, MEMBER_NOT_EMPTY, IN_INTER; Collinear A X B /\ Collinear B A C /\ Collinear A B C [ABXcol] by m_line, Bm, -, Collinear_DEF; consider E such that E IN l /\ ~(E = X) [El_X] by l_line, Xlm, ExistsNewPointOnLine; ~Collinear E A X [EAXncol] by l_line, El_X, Xlm, I1, Collinear_DEF, notABCl, NOTIN; consider B' such that ~(B = E) /\ B IN open (E,B') [EBB'] by notABCl, El_X, NOTIN, B2'; ~(B' = E) /\ ~(B' = B) /\ Collinear B E B' [EBB'col] by -, B1', CollinearSymmetry; ~Collinear A B B' /\ ~Collinear B' B A /\ ~Collinear B' A B [ABB'ncol] by EAXncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry, -; ~Collinear B' B C /\ ~Collinear B' A C /\ ~Collinear A B' C [AB'Cncol] by ABB'ncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry; B' IN ray E B DELETE E /\ B IN ray E B' DELETE E by EBB', IntervalRayEZ; B' NOTIN l /\ B',B same_side l /\ B,B' same_side l [notB'l] by l_line, El_X, notABCl, -, RaySameSide; A,B' same_side l /\ B',C same_side l by l_line, ABB'ncol, notABCl, notB'l, Asim_lB, -, B4'', AB'Cncol, Bsim_lC; qed by l_line, AB'Cncol, notABCl, notB'l, -, B4''; end; end; `;; let ConverseCrossbar = thm `; let O A B G be point; assume ~Collinear A O B [H1]; assume G IN open (A,B) [H2]; thus G IN int_angle A O B proof ~(A = O) /\ ~(A = B) /\ ~(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; consider a such that Line a /\ O IN a /\ A IN a [a_line] by -, I1; consider b such that Line b /\ O IN b /\ B IN b [b_line] by Distinct, I1; consider l such that Line l /\ A IN l /\ B IN l [l_line] by Distinct, I1; B NOTIN a /\ A NOTIN b by H1, a_line, Collinear_DEF, NOTIN, b_line; ~(a = l) /\ ~(b = l) by -, l_line, NOTIN; a INTER l = {A} /\ b INTER l = {B} [alA] by -, a_line, l_line, I1Uniqueness, b_line; ~(A = G) /\ ~(A = B) /\ ~(G = B) [AGB] by H2, B1'; A NOTIN open (G,B) /\ B NOTIN open (G,A) [notGAB] by H2, B3', B1', NOTIN; G IN l [Gl] by l_line, H2, BetweenLinear; G NOTIN a /\ G NOTIN b [notGa] by alA, Gl, AGB, IN_DELETE, EquivIntersectionHelp; G IN l DELETE A /\ B IN l DELETE A /\ G IN l DELETE B /\ A IN l DELETE B by Gl, l_line, AGB, IN_DELETE; G,B same_side a /\ G,A same_side b by a_line, l_line, alA, -, notGAB, EquivIntersection, b_line; qed by H1, a_line, b_line, notGa, -, IN_InteriorAngle; `;; let InteriorUse = thm `; let A O B P be point; let a b be point_set; assume Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b [aOAbOB]; assume P IN int_angle A O B [P_AOB]; thus P NOTIN a /\ P NOTIN b /\ P,B same_side a /\ P,A same_side b proof consider alpha beta such that ~Collinear A O B /\ Line alpha /\ O IN alpha /\ A IN alpha /\ Line beta /\ O IN beta /\B IN beta /\ P NOTIN alpha /\ P NOTIN beta /\ P,B same_side alpha /\ P,A same_side beta [exists] by P_AOB, IN_InteriorAngle; ~(A = O) /\ ~(A = B) /\ ~(O = B) [Distinct] by -, NonCollinearImpliesDistinct; alpha = a /\ beta = b by -, aOAbOB, exists, I1; qed by -, exists; `;; let InteriorEZHelp = thm `; let A O B P be point; assume P IN int_angle A O B [P_AOB]; thus ~(P = A) /\ ~(P = O) /\ ~(P = B) /\ ~Collinear A O P proof consider a b such that ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\B IN b /\ P NOTIN a /\ P NOTIN b [def_int] by P_AOB, IN_InteriorAngle; ~(P = A) /\ ~(P = O) /\ ~(P = B) [PnotAOB] by -, NOTIN; ~(A = O) [notAO] by def_int, NonCollinearImpliesDistinct; ~Collinear A O P by def_int, notAO, -, I1, Collinear_DEF, NOTIN; qed by PnotAOB, -; `;; let InteriorAngleSymmetry = thm `; ! A O B P: point. P IN int_angle A O B ==> P IN int_angle B O A by IN_InteriorAngle, CollinearSymmetry; `;; let InteriorWellDefined = thm `; let A O B X P be point; assume P IN int_angle A O B [H1]; assume X IN ray O B DELETE O [H2]; thus P IN int_angle A O X proof consider a b such that ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ P NOTIN a /\ Line b /\ O IN b /\ B IN b /\ P NOTIN b /\ P,B same_side a /\ P,A same_side b [def_int] by H1, IN_InteriorAngle; ~(X = O) /\ ~(O = B) /\ Collinear O B X [H2'] by H2, IN_DELETE, IN_Ray; B NOTIN a [notBa] by def_int, Collinear_DEF, NOTIN; ~Collinear A O X [AOXnoncol] by def_int, H2', NoncollinearityExtendsToLine; X IN b [Xb] by def_int, H2', CollinearLinear; X NOTIN a /\ B,X same_side a by def_int, notBa, H2, RaySameSide, SameSideSymmetric; P,X same_side a by def_int, -, notBa, SameSideTransitive; qed by AOXnoncol, def_int, Xb, -, IN_InteriorAngle; `;; let WholeRayInterior = thm `; let A O B X P be point; assume X IN int_angle A O B [XintAOB]; assume P IN ray O X DELETE O [PrOX]; thus P IN int_angle A O B proof consider a b such that ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ X NOTIN a /\ Line b /\ O IN b /\ B IN b /\ X NOTIN b /\ X,B same_side a /\ X,A same_side b [def_int] by XintAOB, IN_InteriorAngle; P NOTIN a /\ P,X same_side a /\ P NOTIN b /\ P,X same_side b [Psim_abX] by def_int, PrOX, RaySameSide; P,B same_side a /\ P,A same_side b by -, def_int, Collinear_DEF, SameSideTransitive, NOTIN; qed by def_int, Psim_abX, -, IN_InteriorAngle; `;; let AngleOrdering = thm `; let O A P Q be point; let a be point_set; assume ~(O = A) [H1]; assume Line a /\ O IN a /\ A IN a [H2]; assume P NOTIN a /\ Q NOTIN a [H3]; assume P, Q same_side a [H4]; assume ~Collinear P O Q [H5]; thus P IN int_angle Q O A \/ Q IN int_angle P O A proof ~(P = O) /\ ~(P = Q) /\ ~(O = Q) [Distinct] by H5, NonCollinearImpliesDistinct; consider q such that Line q /\ O IN q /\ Q IN q [q_line] by Distinct, I1; P NOTIN q [notPq] by -, Collinear_DEF, H5, NOTIN; assume ~(P IN int_angle Q O A) [notPintQOA]; ~Collinear Q O A /\ ~Collinear P O A [POAncol] by H1, H2, I1, Collinear_DEF, H3, NOTIN; ~(P,A same_side q) by -, H2, q_line, H3, notPq, H4, notPintQOA, IN_InteriorAngle; consider G such that G IN q /\ G IN open (P,A) [existG] by q_line, -, SameSide_DEF; G IN int_angle P O A [G_POA] by POAncol, existG, ConverseCrossbar; G NOTIN a /\ G,P same_side a /\ ~(G = O) [Gsim_aP] by -, IN_InteriorAngle, H1, H2, I1, NOTIN; G,Q same_side a by H2, Gsim_aP, H3, H4, SameSideTransitive; O NOTIN open (Q,G) [notQOG] by -, SameSide_DEF, H2, B1', NOTIN; Collinear O G Q by q_line, existG, Collinear_DEF; Q IN ray O G DELETE O by Gsim_aP, -, notQOG, IN_Ray, Distinct, IN_DELETE; qed by G_POA, -, WholeRayInterior; `;; let InteriorsDisjointSupplement = thm `; let A O B A' be point; assume ~Collinear A O B [H1]; assume O IN open (A,A') [H2]; thus int_angle B O A' INTER int_angle A O B = {} proof ! D. D IN int_angle A O B ==> D NOTIN int_angle B O A' proof let D be point; assume D IN int_angle A O B [H3]; ~(A = O) /\ ~(O = B) by H1, NonCollinearImpliesDistinct; consider a b such that Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ A' IN a [ab_line] by -, I1, H2, BetweenLinear; ~Collinear B O A' by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; A NOTIN b /\ A' NOTIN b [notAb] by ab_line, Collinear_DEF, H1, -, NOTIN; ~(A',A same_side b) [A'nsim_bA] by ab_line, H2, B1', SameSide_DEF ; D NOTIN b /\ D,A same_side b [DintAOB] by ab_line, H3, InteriorUse; ~(D,A' same_side b) by ab_line, notAb, DintAOB, A'nsim_bA, SameSideSymmetric, SameSideTransitive; qed by ab_line, -, InteriorUse, NOTIN; qed by -, DisjointOneNotOther; `;; let InteriorReflectionInterior = thm `; let A O B D A' be point; assume O IN open (A,A') [H1]; assume D IN int_angle A O B [H2]; thus B IN int_angle D O A' proof consider a b such that ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ D NOTIN a /\ Line b /\ O IN b /\ B IN b /\ D NOTIN b /\ D,B same_side a [DintAOB] by H2, IN_InteriorAngle; ~(O = B) /\ ~(O = A') /\ B NOTIN a [Distinct] by -, NonCollinearImpliesDistinct, H1, B1', Collinear_DEF, NOTIN; ~Collinear D O B [DOB_ncol] by DintAOB, -, I1, Collinear_DEF, NOTIN; A' IN a [A'a] by H1, DintAOB, BetweenLinear; D NOTIN int_angle B O A' by DintAOB, H1, InteriorsDisjointSupplement, H2, DisjointOneNotOther; qed by Distinct, DintAOB, A'a, DOB_ncol, -, AngleOrdering, NOTIN; `;; let Crossbar_THM = thm `; let O A B D be point; assume D IN int_angle A O B [H1]; thus ? G. G IN open (A,B) /\ G IN ray O D DELETE O proof consider a b such that ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ D NOTIN a /\ D NOTIN b /\ D,B same_side a /\ D,A same_side b [DintAOB] by H1, IN_InteriorAngle; B NOTIN a [notBa] by DintAOB, Collinear_DEF, NOTIN; ~(A = O) /\ ~(A = B) /\ ~(O = B) /\ ~(D = O) [Distinct] by DintAOB, NonCollinearImpliesDistinct, NOTIN; consider l such that Line l /\ O IN l /\ D IN l [l_line] by -, I1; consider A' such that O IN open (A,A') [AOA'] by Distinct, B2'; A' IN a /\ Collinear A O A' /\ ~(A' = O) [A'a] by DintAOB, -, BetweenLinear, B1'; ~(A,A' same_side l) [Ansim_lA'] by l_line, AOA', SameSide_DEF; B IN int_angle D O A' by H1, AOA', InteriorReflectionInterior; B,A' same_side l [Bsim_lA'] by l_line, DintAOB, A'a, -, InteriorUse; ~Collinear A O D /\ ~Collinear B O D [AODncol] by H1, InteriorEZHelp, InteriorAngleSymmetry; ~Collinear D O A' by -, CollinearSymmetry, A'a, NoncollinearityExtendsToLine; A NOTIN l /\ B NOTIN l /\ A' NOTIN l by l_line, Collinear_DEF, AODncol, -, NOTIN; ~(A,B same_side l) by l_line, -, Bsim_lA', Ansim_lA', SameSideTransitive; consider G such that G IN open (A,B) /\ G IN l [AGB] by l_line, -, SameSide_DEF; Collinear O D G [ODGcol] by -, l_line, Collinear_DEF; G IN int_angle A O B by DintAOB, AGB, ConverseCrossbar; G NOTIN a /\ G,B same_side a /\ ~(G = O) [Gsim_aB] by DintAOB, -, InteriorUse, NOTIN; B,D same_side a by DintAOB, notBa, SameSideSymmetric; G,D same_side a [Gsim_aD] by DintAOB, Gsim_aB, notBa, -, SameSideTransitive; O NOTIN open (G,D) by DintAOB, -, SameSide_DEF, NOTIN; G IN ray O D DELETE O by Distinct, ODGcol, -, IN_Ray, Gsim_aB, IN_DELETE; qed by AGB, -; `;; let AlternateConverseCrossbar = thm `; let O A B G be point; assume Collinear A G B /\ G IN int_angle A O B [H1]; thus G IN open (A,B) proof consider a b such that ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ G,B same_side a /\ G,A same_side b [GintAOB] by H1, IN_InteriorAngle; ~(A = B) /\ ~(G = A) /\ ~(G = B) /\ A NOTIN open (G,B) /\ B NOTIN open (G,A) by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SameSide_DEF, NOTIN; qed by -, H1, B1', B3', NOTIN; `;; let InteriorOpposite = thm `; let A O B P be point; let p be point_set; assume P IN int_angle A O B [PintAOB]; assume Line p /\ O IN p /\ P IN p [p_line]; thus ~(A,B same_side p) proof consider G such that G IN open (A,B) /\ G IN ray O P [Gexists] by PintAOB, Crossbar_THM, IN_DELETE; G IN p by p_line, RayLine, -, SUBSET; qed by p_line, -, Gexists, SameSide_DEF; `;; let IntervalTransitivity = thm `; let O P Q R be point; let m be point_set; assume Line m /\ O IN m [H0]; assume P IN m DELETE O /\ Q IN m DELETE O /\ R IN m DELETE O [H2]; assume O NOTIN open (P,Q) /\ O NOTIN open (Q,R) [H3]; thus O NOTIN open (P,R) proof consider E such that E NOTIN m /\ ~(O = E) [notEm] by H0, ExistsPointOffLine, NOTIN; consider l such that Line l /\ O IN l /\ E IN l [l_line] by -, I1; ~(m = l) by notEm, -, NOTIN; l INTER m = {O} [lmO] by l_line, H0, -, l_line, I1Uniqueness; P NOTIN l /\ Q NOTIN l /\ R NOTIN l [notPQRl] by -, H2, EquivIntersectionHelp; P,Q same_side l /\ Q,R same_side l by l_line, H0, lmO, H2, H3, EquivIntersection; P,R same_side l [Psim_lR] by l_line, notPQRl, -, SameSideTransitive; qed by l_line, -, SameSide_DEF, NOTIN; `;; let RayWellDefinedHalfway = thm `; let O P Q be point; assume ~(Q = O) [H1]; assume P IN ray O Q DELETE O [H2]; thus ray O P SUBSET ray O Q proof consider m such that Line m /\ O IN m /\ Q IN m [OQm] by H1, I1; P IN ray O Q /\ ~(P = O) /\ O NOTIN open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; P IN m /\ P IN m DELETE O /\ Q IN m DELETE O [PQm_O] by OQm, H2', RayLine, SUBSET, H2', OQm, H1, IN_DELETE; O NOTIN open (P,Q) [notPOQ] by H2', IN_Ray; ! X. X IN ray O P ==> X IN ray O Q proof let X be point; assume X IN ray O P; X IN m /\ O NOTIN open (X,P) [XrOP] by OQm, PQm_O, H2', -, RayLine, SUBSET, IN_Ray; Collinear O Q X [OQXcol] by OQm, -, Collinear_DEF; cases; suppose X = O; qed by H1, -, OriginInRay; suppose ~(X = O); X IN m DELETE O by XrOP, -, IN_DELETE; O NOTIN open (X,Q) by OQm, -, PQm_O, XrOP, H2', IntervalTransitivity; qed by H1, OQXcol, -, IN_Ray; end; qed by -, SUBSET; `;; let RayWellDefined = thm `; let O P Q be point; assume ~(Q = O) [H1]; assume P IN ray O Q DELETE O [H2]; thus ray O P = ray O Q proof ray O P SUBSET ray O Q [PsubsetQ] by H1, H2, RayWellDefinedHalfway; ~(P = O) /\ Collinear O Q P /\ O NOTIN open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; Q IN ray O P DELETE O by H2', B1', NOTIN, CollinearSymmetry, IN_Ray, H1, IN_DELETE; ray O Q SUBSET ray O P [QsubsetP] by H2', -, RayWellDefinedHalfway; qed by PsubsetQ, QsubsetP, SUBSET_ANTISYM; `;; let OppositeRaysIntersect1pointHelp = thm `; let A O B X be point; assume O IN open (A,B) [H1]; assume X IN ray O B DELETE O [H2]; thus X NOTIN ray O A /\ O IN open (X,A) proof ~(A = O) /\ ~(A = B) /\ ~(O = B) /\ Collinear A O B [AOB] by H1, B1'; ~(X = O) /\ Collinear O B X /\ O NOTIN open (X,B) [H2'] by H2, IN_DELETE, IN_Ray; consider m such that Line m /\ A IN m /\ B IN m [m_line] by AOB, I1; O IN m /\ X IN m [Om] by m_line, H2', AOB, CollinearLinear; A IN m DELETE O /\ X IN m DELETE O /\ B IN m DELETE O by m_line, -, H2', AOB, IN_DELETE; O IN open (X,A) by H1, m_line, Om, -, H2', IntervalTransitivity, NOTIN, B1'; qed by -, IN_Ray, NOTIN; `;; let OppositeRaysIntersect1point = thm `; let A O B be point; assume O IN open (A,B) [H1]; thus ray O A INTER ray O B = {O} proof ~(A = O) /\ ~(O = B) by H1, B1'; {O} SUBSET ray O A INTER ray O B [Osubset_rOA] by -, OriginInRay, IN_INTER, SING_SUBSET; ! X. ~(X = O) /\ X IN ray O B ==> X NOTIN ray O A by IN_DELETE, H1, OppositeRaysIntersect1pointHelp; ray O A INTER ray O B SUBSET {O} by -, IN_INTER, IN_SING, SUBSET, NOTIN; qed by -, Osubset_rOA, SUBSET_ANTISYM; `;; let IntervalRay = thm `; ! A B C:point. B IN open (A,C) ==> ray A B = ray A C by B1', IntervalRayEZ, RayWellDefined; `;; let TransitivityBetweennessHelp = thm `; let A B C D be point; assume B IN open (A,C) /\ C IN open (B,D) [H1]; thus B IN open (A,D) proof D IN ray B C DELETE B by H1, IntervalRayEZ; qed by H1, -, OppositeRaysIntersect1pointHelp, B1'; `;; let TransitivityBetweenness = thm `; let A B C D be point; assume B IN open (A,C) /\ C IN open (B,D) [H1]; thus ordered A B C D proof B IN open (A,D) [ABD] by H1, TransitivityBetweennessHelp; C IN open (D,B) /\ B IN open (C,A) by H1, B1'; C IN open (D,A) by -, TransitivityBetweennessHelp; qed by H1, ABD, -, B1', Ordered_DEF; `;; let IntervalsAreConvex = thm `; let A B C be point; assume B IN open (A,C) [H1]; thus open (A,B) SUBSET open (A,C) proof ! X. X IN open (A,B) ==> X IN open (A,C) proof let X be point; assume X IN open (A,B) [AXB]; X IN ray B A DELETE B by AXB, B1', IntervalRayEZ; B IN open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; qed by AXB, -, TransitivityBetweennessHelp; qed by -, SUBSET; `;; let TransitivityBetweennessVariant = thm `; let A X B C be point; assume X IN open (A,B) /\ B IN open (A,C) [H1]; thus ordered A X B C proof X IN ray B A DELETE B by H1, B1', IntervalRayEZ; B IN open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; qed by H1, -, TransitivityBetweenness; `;; let Interval2sides2aLineHelp = thm `; let A B C X be point; assume B IN open (A,C) [H1]; thus X NOTIN open (A,B) \/ X NOTIN open (B,C) proof assume ~(X NOTIN open (A,B)); ordered A X B C by -, NOTIN, H1, TransitivityBetweennessVariant; B IN open (X,C) by -, Ordered_DEF; X NOTIN open (C,B) by -, B1', B3', NOTIN; qed by -, B1', NOTIN; `;; let Interval2sides2aLine = thm `; let A B C X be point; assume Collinear A B C [H1]; thus X NOTIN open (A,B) \/ X NOTIN open (A,C) \/ X NOTIN open (B,C) proof cases; suppose A = B \/ A = C \/ B = C; qed by -, B1', NOTIN; suppose ~(A = B) /\ ~(A = C) /\ ~(B = C); B IN open (A,C) \/ C IN open (B,A) \/ A IN open (C,B) by -, H1, B3'; qed by -, Interval2sides2aLineHelp, B1', NOTIN; end; `;; let TwosidesTriangle2aLine = thm `; let A B C Y be point; let l m be point_set; assume Line l /\ ~Collinear A B C [H1]; assume A NOTIN l /\ B NOTIN l /\ C NOTIN l [off_l]; assume Line m /\ A IN m /\ C IN m [m_line]; assume Y IN l /\ Y IN m [Ylm]; assume ~(A,B same_side l) /\ ~(B,C same_side l) [H2]; thus A,C same_side l proof consider X Z such that X IN l /\ X IN open (A,B) /\ Z IN l /\ Z IN open (C,B) [H2'] by H1, H2, SameSide_DEF, B1'; ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Y IN m DELETE A /\ Y IN m DELETE C /\ C IN m DELETE A /\ A IN m DELETE C [Distinct] by H1, NonCollinearImpliesDistinct, Ylm, off_l, NOTIN, m_line, IN_DELETE; consider p such that Line p /\ B IN p /\ A IN p [p_line] by Distinct, I1; consider q such that Line q /\ B IN q /\ C IN q [q_line] by Distinct, I1; X IN p /\ Z IN q [Xp] by p_line, H2', BetweenLinear, q_line, H2'; A NOTIN q /\ B NOTIN m /\ C NOTIN p [vertex_off_line] by q_line, m_line, p_line, H1, Collinear_DEF, NOTIN; X NOTIN q /\ X,A same_side q /\ Z NOTIN p /\ Z,C same_side p [Xsim_qA] by q_line, p_line, -, H2', B1', IntervalRayEZ, RaySameSide; ~(m = p) /\ ~(m = q) by m_line, vertex_off_line, NOTIN; p INTER m = {A} /\ q INTER m = {C} [pmA] by p_line, m_line, q_line, H1, -, Xp, H2', I1Uniqueness; Y NOTIN p /\ Y NOTIN q [notYpq] by -, Distinct, EquivIntersectionHelp; X IN ray A B DELETE A /\ Z IN ray C B DELETE C by H2', IntervalRayEZ, H2', B1'; X NOTIN m /\ Z NOTIN m /\ X,B same_side m /\ B,Z same_side m [notXZm] by m_line, vertex_off_line, -, RaySameSide, SameSideSymmetric; X,Z same_side m by m_line, -, vertex_off_line, SameSideTransitive; Collinear X Y Z /\ Y NOTIN open (X,Z) /\ ~(Y = X) /\ ~(Y = Z) /\ ~(X = Z) by H1, H2', Ylm, Collinear_DEF, m_line, -, SameSide_DEF, notXZm, Xsim_qA, Xp, NOTIN; Z IN open (X,Y) \/ X IN open (Z,Y) by -, B3', NOTIN, B1'; cases by -; suppose X IN open (Z,Y); ~(Z,Y same_side p) by p_line, Xp, -, SameSide_DEF; ~(C,Y same_side p) by p_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; A IN open (C,Y) by p_line, m_line, pmA, Distinct, -, EquivIntersection, NOTIN; qed by H1, Ylm, off_l, -, B1', IntervalRayEZ, RaySameSide; suppose Z IN open (X,Y); ~(X,Y same_side q) by q_line, Xp, -, SameSide_DEF; ~(A,Y same_side q) by q_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; C IN open (Y,A) by q_line, m_line, pmA, Distinct, -, EquivIntersection, NOTIN, B1'; qed by H1, Ylm, off_l, -, IntervalRayEZ, RaySameSide; end; `;; let LineUnionOf2Rays = thm `; let A O B be point; let l be point_set; assume Line l /\ A IN l /\ B IN l [H1]; assume O IN open (A,B) [H2]; thus l = ray O A UNION ray O B proof ~(A = O) /\ ~(O = B) /\ O IN l [Distinct] by H2, B1', H1, BetweenLinear; ray O A UNION ray O B SUBSET l [AOBsub_l] by H1, -, RayLine, UNION_SUBSET; ! X. X IN l ==> X IN ray O A \/ X IN ray O B proof let X be point; assume X IN l [Xl]; assume ~(X IN ray O B) [notXrOB]; Collinear O B X /\ Collinear X A B /\ Collinear O A X [XABcol] by Distinct, H1, Xl, Collinear_DEF; O IN open (X,B) by notXrOB, Distinct, -, IN_Ray, NOTIN; O NOTIN open (X,A) by NOTIN, B1', XABcol, -, H2, Interval2sides2aLine; qed by Distinct, XABcol, -, IN_Ray; l SUBSET ray O A UNION ray O B by -, IN_UNION, SUBSET; qed by -, AOBsub_l, SUBSET_ANTISYM; `;; let AtMost2Sides = thm `; let A B C be point; let l be point_set; assume Line l [H1]; assume A NOTIN l /\ B NOTIN l /\ C NOTIN l [H2]; thus A,B same_side l \/ A,C same_side l \/ B,C same_side l proof cases; suppose A = C; qed by -, H1, H2, SameSideReflexive; suppose ~(A = C) [notAC]; consider m such that Line m /\ A IN m /\ C IN m [m_line] by notAC, I1; cases; suppose m INTER l = {}; A,C same_side l by m_line, H1, -, BetweenLinear, SET_RULE, SameSide_DEF; qed by -; suppose ~(m INTER l = {}); consider Y such that Y IN l /\ Y IN m [Ylm] by -, IN_INTER, MEMBER_NOT_EMPTY; cases; suppose ~Collinear A B C; qed by H1, -, H2, m_line, Ylm, TwosidesTriangle2aLine; suppose Collinear A B C [ABCcol]; B IN m [Bm] by -, m_line, notAC, I1, Collinear_DEF; ~(Y = A) /\ ~(Y = B) /\ ~(Y = C) [YnotABC] by Ylm, H2, NOTIN; Y NOTIN open (A,B) \/ Y NOTIN open (A,C) \/ Y NOTIN open (B,C) by ABCcol, Interval2sides2aLine; A IN ray Y B DELETE Y \/ A IN ray Y C DELETE Y \/ B IN ray Y C DELETE Y by YnotABC, m_line, Bm, Ylm, Collinear_DEF, -, IN_Ray, IN_DELETE; qed by H1, Ylm, H2, -, RaySameSide; end; end; end; `;; let FourPointsOrder = thm `; let A B C X be point; let l be point_set; assume Line l /\ A IN l /\ B IN l /\ C IN l /\ X IN l [H1]; assume ~(X = A) /\ ~(X = B) /\ ~(X = C) [H2]; assume B IN open (A,C) [H3]; thus ordered X A B C \/ ordered A X B C \/ ordered A B X C \/ ordered A B C X proof A IN open (X,B) \/ X IN open (A,B) \/ X IN open (B,C) \/ C IN open (B,X) proof ~(A = B) /\ ~(B = C) [ABCdistinct] by H3, B1'; Collinear A B X /\ Collinear A C X /\ Collinear C B X [ACXcol] by H1, Collinear_DEF; A IN open (X,B) \/ X IN open (A,B) \/ B IN open (A,X) by H2, ABCdistinct, -, B3', B1'; cases by -; suppose A IN open (X,B) \/ X IN open (A,B); qed by -; suppose B IN open (A,X); B NOTIN open (C,X) by ACXcol, H3, -, Interval2sides2aLine, NOTIN; qed by H2, ABCdistinct, ACXcol, -, B3', B1', NOTIN; end; qed by -, H3, B1', TransitivityBetweenness, TransitivityBetweennessVariant, Reverse4Order; `;; let HilbertAxiomRedundantByMoore = thm `; let A B C D be point; let l be point_set; assume Line l /\ A IN l /\ B IN l /\ C IN l /\ D IN l [H1]; assume ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) [H2]; thus ordered D A B C \/ ordered A D B C \/ ordered A B D C \/ ordered A B C D \/ ordered D A C B \/ ordered A D C B \/ ordered A C D B \/ ordered A C B D \/ ordered D C A B \/ ordered C D A B \/ ordered C A D B \/ ordered C A B D proof Collinear A B C by H1, Collinear_DEF; B IN open (A,C) \/ C IN open (A,B) \/ A IN open (C,B) by H2, -, B3', B1'; qed by -, H1, H2, FourPointsOrder; `;; let InteriorTransitivity = thm `; let A O B F G be point; assume G IN int_angle A O B [GintAOB]; assume F IN int_angle A O G [FintAOG]; thus F IN int_angle A O B proof ~Collinear A O B [AOBncol] by GintAOB, IN_InteriorAngle; consider G' such that G' IN open (A,B) /\ G' IN ray O G DELETE O [CrossG] by GintAOB, Crossbar_THM; F IN int_angle A O G' by FintAOG, -, InteriorWellDefined; consider F' such that F' IN open (A,G') /\ F' IN ray O F DELETE O [CrossF] by -, Crossbar_THM; ~(F' = O) /\ ~(F = O) /\ Collinear O F F' /\ O NOTIN open (F',F) by -, IN_DELETE, IN_Ray; F IN ray O F' DELETE O [FrOF'] by -, CollinearSymmetry, B1', NOTIN, IN_Ray, IN_DELETE; open (A,G') SUBSET open (A,B) /\ F' IN open (A,B) by CrossG, IntervalsAreConvex, CrossF, SUBSET; F' IN int_angle A O B by AOBncol, -, ConverseCrossbar; qed by -, FrOF', WholeRayInterior; `;; let HalfPlaneConvexNonempty = thm `; let l H be point_set; let A be point; assume Line l /\ A NOTIN l [l_line]; assume H = {X | X NOTIN l /\ X,A same_side l} [HalfPlane]; thus ~(H = {}) /\ H SUBSET complement l /\ Convex H proof ! X. X IN H <=> X NOTIN l /\ X,A same_side l [Hdef] by HalfPlane, SET_RULE; H SUBSET complement l [Hsub] by -, IN_PlaneComplement, SUBSET; A,A same_side l /\ A IN H by l_line, SameSideReflexive, Hdef; ~(H = {}) [Hnonempty] by -, MEMBER_NOT_EMPTY; ! P Q X. P IN H /\ Q IN H /\ X IN open (P,Q) ==> X IN H proof let P Q X be point; assume P IN H /\ Q IN H /\ X IN open (P,Q) [PXQ]; P NOTIN l /\ P,A same_side l /\ Q NOTIN l /\ Q,A same_side l [PQinH] by -, Hdef; P,Q same_side l [Psim_lQ] by l_line, -, SameSideSymmetric, SameSideTransitive; X NOTIN l [notXl] by -, PXQ, SameSide_DEF, NOTIN; open (X,P) SUBSET open (P,Q) by PXQ, IntervalsAreConvex, B1', SUBSET; X,P same_side l by l_line, -, SUBSET, Psim_lQ, SameSide_DEF; X,A same_side l by l_line, notXl, PQinH, -, Psim_lQ, PQinH, SameSideTransitive; qed by -, notXl, Hdef; Convex H by -, SUBSET, CONVEX; qed by Hnonempty, Hsub, -; `;; let PlaneSeparation = thm `; let l be point_set; assume Line l [l_line]; thus ? H1 H2:point_set. H1 INTER H2 = {} /\ ~(H1 = {}) /\ ~(H2 = {}) /\ Convex H1 /\ Convex H2 /\ complement l = H1 UNION H2 /\ ! P Q. P IN H1 /\ Q IN H2 ==> ~(P,Q same_side l) proof consider A such that A NOTIN l [notAl] by l_line, ExistsPointOffLine; consider E such that E IN l /\ ~(A = E) [El] by l_line, I2, -, NOTIN; consider B such that E IN open (A,B) /\ ~(E = B) /\ Collinear A E B [AEB] by -, B2', B1'; B NOTIN l [notBl] by l_line, El, -, I1, Collinear_DEF, notAl, NOTIN; ~(A,B same_side l) [Ansim_lB] by l_line, El, AEB, SameSide_DEF; consider H1 H2 such that H1 = {X | X NOTIN l /\ X,A same_side l} /\ H2 = {X | X NOTIN l /\ X,B same_side l} [H12sets]; ! X. (X IN H1 <=> X NOTIN l /\ X,A same_side l) /\ (X IN H2 <=> X NOTIN l /\ X,B same_side l) [H12def] by -, SET_RULE; ! X. X IN H1 <=> X NOTIN l /\ X,A same_side l [H1def] by H12sets, SET_RULE; ! X. X IN H2 <=> X NOTIN l /\ X,B same_side l [H2def] by H12sets, SET_RULE; H1 INTER H2 = {} [H12disjoint] proof assume ~(H1 INTER H2 = {}); consider V such that V IN H1 /\ V IN H2 by -, MEMBER_NOT_EMPTY, IN_INTER; V NOTIN l /\ V,A same_side l /\ V NOTIN l /\ V,B same_side l by -, H12def; A,B same_side l by l_line, -, notAl, notBl, SameSideSymmetric, SameSideTransitive; qed by -, Ansim_lB; ~(H1 = {}) /\ ~(H2 = {}) /\ H1 SUBSET complement l /\ H2 SUBSET complement l /\ Convex H1 /\ Convex H2 [H12convex_nonempty] by l_line, notAl, notBl, H12sets, HalfPlaneConvexNonempty; H1 UNION H2 SUBSET complement l [H12sub] by H12convex_nonempty, UNION_SUBSET; ! C. C IN complement l ==> C IN H1 UNION H2 proof let C be point; assume C IN complement l; C NOTIN l [notCl] by -, IN_PlaneComplement; C,A same_side l \/ C,B same_side l by l_line, notAl, notBl, -, Ansim_lB, AtMost2Sides; C IN H1 \/ C IN H2 by notCl, -, H12def; qed by -, IN_UNION; complement l SUBSET H1 UNION H2 by -, SUBSET; complement l = H1 UNION H2 [compl_H1unionH2] by H12sub, -, SUBSET_ANTISYM; ! P Q. P IN H1 /\ Q IN H2 ==> ~(P,Q same_side l) [opp_sides] proof let P Q be point; assume P IN H1 /\ Q IN H2; P NOTIN l /\ P,A same_side l /\ Q NOTIN l /\ Q,B same_side l [PH1_QH2] by -, H12def, IN; qed by l_line, -, notAl, SameSideSymmetric, notBl, Ansim_lB, SameSideTransitive; qed by H12disjoint, H12convex_nonempty, compl_H1unionH2, opp_sides; `;; let TetralateralSymmetry = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; thus Tetralateral B C D A /\ Tetralateral A B D C proof ~Collinear A B D /\ ~Collinear B D C /\ ~Collinear D C A /\ ~Collinear C A B [TetraABCD] by H1, Tetralateral_DEF, CollinearSymmetry; qed by H1, -, Tetralateral_DEF; `;; let EasyEmptyIntersectionsTetralateralHelp = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; thus open (A,B) INTER open (B,C) = {} proof ! X. X IN open (B,C) ==> X NOTIN open (A,B) proof let X be point; assume X IN open (B,C); ~Collinear A B C /\ Collinear B X C /\ ~(X = B) by H1, Tetralateral_DEF, -, B1'; ~Collinear A X B by -, CollinearSymmetry, B1', NoncollinearityExtendsToLine; qed by -, B1', NOTIN; qed by -, DisjointOneNotOther; `;; let EasyEmptyIntersectionsTetralateral = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; thus open (A,B) INTER open (B,C) = {} /\ open (B,C) INTER open (C,D) = {} /\ open (C,D) INTER open (D,A) = {} /\ open (D,A) INTER open (A,B) = {} proof Tetralateral B C D A /\ Tetralateral C D A B /\ Tetralateral D A B C by H1, TetralateralSymmetry; qed by H1, -, EasyEmptyIntersectionsTetralateralHelp; `;; let SegmentSameSideOppositeLine = thm `; let A B C D be point; let a c be point_set; assume Quadrilateral A B C D [H1]; assume Line a /\ A IN a /\ B IN a [a_line]; assume Line c /\ C IN c /\ D IN c [c_line]; thus A,B same_side c \/ C,D same_side a proof assume ~(C,D same_side a); :: prove A,B same_side c consider G such that G IN a /\ G IN open (C,D) [CGD] by -, a_line, SameSide_DEF; G IN c /\ Collinear G B A [Gc] by c_line, -, BetweenLinear, a_line, Collinear_DEF; ~Collinear B C D /\ ~Collinear C D A /\ open (A,B) INTER open (C,D) = {} [quadABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; A NOTIN c /\ B NOTIN c /\ ~(A = G) /\ ~(B = G) [Distinct] by -, c_line, Collinear_DEF, NOTIN, Gc; G NOTIN open (A,B) by quadABCD, CGD, DisjointOneNotOther; A IN ray G B DELETE G by Distinct, Gc, -, IN_Ray, IN_DELETE; qed by c_line, Gc, Distinct, -, RaySameSide; `;; let ConvexImpliesQuad = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; assume C IN int_angle D A B /\ D IN int_angle A B C [H2]; thus Quadrilateral A B C D proof ~(A = B) /\ ~(B = C) /\ ~(A = D) [TetraABCD] by H1, Tetralateral_DEF; consider a such that Line a /\ A IN a /\ B IN a [a_line] by TetraABCD, I1; consider b such that Line b /\ B IN b /\ C IN b [b_line] by TetraABCD, I1; consider d such that Line d /\ D IN d /\ A IN d [d_line] by TetraABCD, I1; open (B,C) SUBSET b /\ open (A,B) SUBSET a [BCbABa] by b_line, a_line, BetweenLinear, SUBSET; D,A same_side b /\ C,D same_side a by H2, a_line, b_line, d_line, InteriorUse; b INTER open (D,A) = {} /\ a INTER open (C,D) = {} by -, b_line, SameSide_DEF, SET_RULE; open (B,C) INTER open (D,A) = {} /\ open (A,B) INTER open (C,D) = {} by BCbABa, -, SET_RULE; qed by H1, -, Quadrilateral_DEF; `;; let DiagonalsIntersectImpliesConvexQuad = thm `; let A B C D G be point; assume ~Collinear B C D [BCDncol]; assume G IN open (A,C) /\ G IN open (B,D) [DiagInt]; thus ConvexQuadrilateral A B C D proof ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ ~(C = A) /\ ~(A = G) /\ ~(D = G) /\ ~(B = G) [Distinct] by BCDncol, NonCollinearImpliesDistinct, DiagInt, B1'; Collinear A G C /\ Collinear B G D [AGCcol] by DiagInt, B1'; ~Collinear C D A [CDAncol] by BCDncol, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; ~Collinear D A B [DABncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; ~Collinear A B C [ABCncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; ~(A = B) /\ ~(A = D) by DABncol, NonCollinearImpliesDistinct; Tetralateral A B C D [TetraABCD] by Distinct, -, BCDncol, CDAncol, DABncol, ABCncol, Tetralateral_DEF; A IN ray C G DELETE C /\ B IN ray D G DELETE D /\ C IN ray A G DELETE A /\ D IN ray B G DELETE B [ArCG] by DiagInt, B1', IntervalRayEZ; G IN int_angle B C D /\ G IN int_angle C D A /\ G IN int_angle D A B /\ G IN int_angle A B C by BCDncol, CDAncol, DABncol, ABCncol, DiagInt, B1', ConverseCrossbar; A IN int_angle B C D /\ B IN int_angle C D A /\ C IN int_angle D A B /\ D IN int_angle A B C by -, ArCG, WholeRayInterior; qed by TetraABCD, -, ConvexImpliesQuad, ConvexQuad_DEF; `;; let DoubleNotSimImpliesDiagonalsIntersect = thm `; let A B C D be point; let l m be point_set; assume Line l /\ A IN l /\ C IN l [l_line]; assume Line m /\ B IN m /\ D IN m [m_line]; assume Tetralateral A B C D [H1]; assume ~(B,D same_side l) [H2]; assume ~(A,C same_side m) [H3]; thus (? G. G IN open (A,C) INTER open (B,D)) /\ ConvexQuadrilateral A B C D proof ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; consider G such that G IN open (A,C) /\ G IN m [AGC] by H3, m_line, SameSide_DEF; G IN l [Gl] by l_line, -, BetweenLinear; A NOTIN m /\ B NOTIN l /\ D NOTIN l by TetraABCD, m_line, l_line, Collinear_DEF, NOTIN; ~(l = m) /\ B IN m DELETE G /\ D IN m DELETE G [BDm_G] by -, l_line, NOTIN, m_line, Gl, IN_DELETE; l INTER m = {G} by l_line, m_line, -, Gl, AGC, I1Uniqueness; G IN open (B,D) by l_line, m_line, -, BDm_G, H2, EquivIntersection, NOTIN; qed by AGC, -, IN_INTER, TetraABCD, DiagonalsIntersectImpliesConvexQuad; `;; let ConvexQuadImpliesDiagonalsIntersect = thm `; let A B C D be point; let l m be point_set; assume Line l /\ A IN l /\ C IN l [l_line]; assume Line m /\ B IN m /\ D IN m [m_line]; assume ConvexQuadrilateral A B C D [ConvQuadABCD]; thus ~(B,D same_side l) /\ ~(A,C same_side m) /\ (? G. G IN open (A,C) INTER open (B,D)) /\ ~Quadrilateral A B D C proof Tetralateral A B C D /\ A IN int_angle B C D /\ D IN int_angle A B C [convquadABCD] by ConvQuadABCD, ConvexQuad_DEF, Quadrilateral_DEF; ~(B,D same_side l) /\ ~(A,C same_side m) [opp_sides] by convquadABCD, l_line, m_line, InteriorOpposite; consider G such that G IN open (A,C) INTER open (B,D) [Gexists] by l_line, m_line, convquadABCD, opp_sides, DoubleNotSimImpliesDiagonalsIntersect; ~(open (B,D) INTER open (C,A) = {}) by -, IN_INTER, B1', MEMBER_NOT_EMPTY; ~Quadrilateral A B D C by -, Quadrilateral_DEF; qed by opp_sides, Gexists, -; `;; let FourChoicesTetralateralHelp = thm `; let A B C D be point; assume Tetralateral A B C D [H1]; assume C IN int_angle D A B [CintDAB]; thus ConvexQuadrilateral A B C D \/ C IN int_triangle D A B proof ~(A = B) /\ ~(D = A) /\ ~(A = C) /\ ~(B = D) /\ ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; consider a d such that Line a /\ A IN a /\ B IN a /\ Line d /\ D IN d /\ A IN d [ad_line] by TetraABCD, I1; consider l m such that Line l /\ A IN l /\ C IN l /\ Line m /\ B IN m /\ D IN m [lm_line] by TetraABCD, I1; C NOTIN a /\ C NOTIN d /\ B NOTIN l /\ D NOTIN l /\ A NOTIN m /\ C NOTIN m /\ ~Collinear A B D /\ ~Collinear B D A [tetra'] by TetraABCD, ad_line, lm_line, Collinear_DEF, NOTIN, CollinearSymmetry; ~(B,D same_side l) [Bsim_lD] by CintDAB, lm_line, InteriorOpposite, -, SameSideSymmetric; cases; suppose ~(A,C same_side m); qed by lm_line, H1, Bsim_lD, -, DoubleNotSimImpliesDiagonalsIntersect; suppose A,C same_side m; C,A same_side m [Csim_mA] by lm_line, -, tetra', SameSideSymmetric; C,B same_side d /\ C,D same_side a by ad_line, CintDAB, InteriorUse; C IN int_angle A B D /\ C IN int_angle B D A by tetra', ad_line, lm_line, Csim_mA, -, IN_InteriorAngle; C IN int_triangle D A B by CintDAB, -, IN_InteriorTriangle; qed by -; end; `;; let InteriorTriangleSymmetry = thm `; ! A B C P. P IN int_triangle A B C ==> P IN int_triangle B C A by IN_InteriorTriangle; `;; let FourChoicesTetralateral = thm `; let A B C D be point; let a be point_set; assume Tetralateral A B C D [H1]; assume Line a /\ A IN a /\ B IN a [a_line]; assume C,D same_side a [Csim_aD]; thus ConvexQuadrilateral A B C D \/ ConvexQuadrilateral A B D C \/ D IN int_triangle A B C \/ C IN int_triangle D A B proof ~(A = B) /\ ~Collinear A B C /\ ~Collinear C D A /\ ~Collinear D A B /\ Tetralateral A B D C [TetraABCD] by H1, Tetralateral_DEF, TetralateralSymmetry; ~Collinear C A D /\ C NOTIN a /\ D NOTIN a [notCDa] by TetraABCD, CollinearSymmetry, a_line, Collinear_DEF, NOTIN; C IN int_angle D A B \/ D IN int_angle C A B by TetraABCD, a_line, -, Csim_aD, AngleOrdering; cases by -; suppose C IN int_angle D A B; ConvexQuadrilateral A B C D \/ C IN int_triangle D A B by H1, -, FourChoicesTetralateralHelp; qed by -; suppose D IN int_angle C A B; ConvexQuadrilateral A B D C \/ D IN int_triangle C A B by TetraABCD, -, FourChoicesTetralateralHelp; qed by -, InteriorTriangleSymmetry; end; `;; let QuadrilateralSymmetry = thm `; ! A B C D:point. Quadrilateral A B C D ==> Quadrilateral B C D A /\ Quadrilateral C D A B /\ Quadrilateral D A B C by Quadrilateral_DEF, INTER_COMM, TetralateralSymmetry, Quadrilateral_DEF; `;; let FiveChoicesQuadrilateral = thm `; let A B C D be point; let l m be point_set; assume Quadrilateral A B C D [H1]; assume Line l /\ A IN l /\ C IN l /\ Line m /\ B IN m /\ D IN m [lm_line]; thus (ConvexQuadrilateral A B C D \/ A IN int_triangle B C D \/ B IN int_triangle C D A \/ C IN int_triangle D A B \/ D IN int_triangle A B C) /\ (~(B,D same_side l) \/ ~(A,C same_side m)) proof Tetralateral A B C D [H1Tetra] by H1, Quadrilateral_DEF; ~(A = B) /\ ~(A = D) /\ ~(B = C) /\ ~(C = D) [Distinct] by H1Tetra, Tetralateral_DEF; consider a c such that Line a /\ A IN a /\ B IN a /\ Line c /\ C IN c /\ D IN c [ac_line] by Distinct, I1; Quadrilateral C D A B /\ Tetralateral C D A B [tetraCDAB] by H1, QuadrilateralSymmetry, Quadrilateral_DEF; ~ConvexQuadrilateral A B D C /\ ~ConvexQuadrilateral C D B A [notconvquad] by Distinct, I1, H1, -, ConvexQuadImpliesDiagonalsIntersect; ConvexQuadrilateral A B C D \/ A IN int_triangle B C D \/ B IN int_triangle C D A \/ C IN int_triangle D A B \/ D IN int_triangle A B C [5choices] proof A,B same_side c \/ C,D same_side a by H1, ac_line, SegmentSameSideOppositeLine; cases by -; suppose C,D same_side a; qed by H1Tetra, ac_line, -, notconvquad, FourChoicesTetralateral; suppose A,B same_side c; ConvexQuadrilateral C D A B \/ B IN int_triangle C D A \/ A IN int_triangle B C D [X1] by tetraCDAB, ac_line, -, notconvquad, FourChoicesTetralateral; qed by -, QuadrilateralSymmetry, ConvexQuad_DEF; end; ~(B,D same_side l) \/ ~(A,C same_side m) by -, lm_line, ConvexQuadImpliesDiagonalsIntersect, IN_InteriorTriangle, InteriorAngleSymmetry, InteriorOpposite; qed by 5choices, -; `;; let IntervalSymmetry = thm `; ! A B: point. open (A,B) = open (B,A) by B1', EXTENSION; `;; let SegmentSymmetry = thm `; ! A B: point. seg A B = seg B A by Segment_DEF, IntervalSymmetry, SET_RULE; `;; let C1OppositeRay = thm `; let O P be point; let s be point_set; assume Segment s /\ ~(O = P) [H1]; thus ? Q. P IN open (O,Q) /\ seg P Q === s proof consider Z such that P IN open (O,Z) /\ ~(P = Z) [OPZ] by H1, B2', B1'; consider Q such that Q IN ray P Z DELETE P /\ seg P Q === s [PQeq] by H1, -, C1; P IN open (Q,O) by OPZ, -, OppositeRaysIntersect1pointHelp; qed by -, B1', PQeq; `;; let OrderedCongruentSegments = thm `; let A B C D F be point; assume ~(A = C) /\ ~(D = F) [H1]; assume seg A C === seg D F [H2]; assume B IN open (A,C) [H3]; thus ? E. E IN open (D,F) /\ seg A B === seg D E proof Segment (seg A B) /\ Segment (seg A C) /\ Segment (seg B C) /\ Segment (seg D F) [segs] by H3, B1', H1, SEGMENT; seg D F === seg A C [DFeqAC] by -, H2, C2Symmetric; consider E such that E IN ray D F DELETE D /\ seg D E === seg A B [DEeqAB] by segs, H1, C1; ~(E = D) /\ Collinear D E F /\ D NOTIN open (F,E) [ErDF] by -, IN_DELETE, IN_Ray, B1', CollinearSymmetry, NOTIN; consider F' such that E IN open (D,F') /\ seg E F' === seg B C [DEF'] by segs, -, C1OppositeRay; seg D F' === seg A C [DF'eqAC] by DEF', H3, DEeqAB, C3; Segment (seg D F') /\ Segment (seg D E) by DEF', B1', SEGMENT; seg A C === seg D F' /\ seg A B === seg D E [ABeqDE] by segs, -, DF'eqAC, C2Symmetric, DEeqAB; F' IN ray D E DELETE D /\ F IN ray D E DELETE D by DEF', IntervalRayEZ, ErDF, IN_Ray, H1, IN_DELETE; F' = F by ErDF, segs, -, DF'eqAC, DFeqAC, C1; qed by -, DEF', ABeqDE; `;; let SegmentSubtraction = thm `; let A B C A' B' C' be point; assume B IN open (A,C) /\ B' IN open (A',C') [H1]; assume seg A B === seg A' B' [H2]; assume seg A C === seg A' C' [H3]; thus seg B C === seg B' C' proof ~(A = B) /\ ~(A = C) /\ Collinear A B C /\ Segment (seg A' C') /\ Segment (seg B' C') [Distinct] by H1, B1', SEGMENT; consider Q such that B IN open (A,Q) /\ seg B Q === seg B' C' [defQ] by -, C1OppositeRay; seg A Q === seg A' C' [AQ_A'C'] by H1, H2, -, C3; ~(A = Q) /\ Collinear A B Q /\ A NOTIN open (C,B) /\ A NOTIN open (Q,B) by defQ, B1', H1, B3', NOTIN; C IN ray A B DELETE A /\ Q IN ray A B DELETE A by Distinct, -, IN_Ray, IN_DELETE; C = Q by Distinct, -, AQ_A'C', H3, C1; qed by defQ, -; `;; let SegmentOrderingUse = thm `; let A B be point; let s be point_set; assume Segment s /\ ~(A = B) [H1]; assume s <__ seg A B [H2]; thus ? G. G IN open (A,B) /\ s === seg A G proof consider A' B' G' such that seg A B = seg A' B' /\ G' IN open (A',B') /\ s === seg A' G' [H2'] by H2, SegmentOrdering_DEF; ~(A' = G') /\ ~(A' = B') /\ seg A' B' === seg A B [A'notB'G'] by -, B1', H1, SEGMENT, C2Reflexive; consider G such that G IN open (A,B) /\ seg A' G' === seg A G [AGB] by A'notB'G', H1, H2', -, OrderedCongruentSegments; s === seg A G by H1, A'notB'G', -, B1', SEGMENT, H2', C2Transitive; qed by AGB, -; `;; let SegmentTrichotomy1 = thm `; let s t be point_set; assume s <__ t [H1]; thus ~(s === t) proof consider A B G such that Segment s /\ t = seg A B /\ G IN open (A,B) /\ s === seg A G [H1'] by H1, SegmentOrdering_DEF; ~(A = G) /\ ~(A = B) /\ ~(G = B) [Distinct] by H1', B1'; seg A B === seg A B [ABrefl] by -, SEGMENT, C2Reflexive; G IN ray A B DELETE A /\ B IN ray A B DELETE A by H1', IntervalRay, EndpointInRay, Distinct, IN_DELETE; ~(seg A G === seg A B) /\ seg A G === s by Distinct, SEGMENT, -, ABrefl, C1, H1', C2Symmetric; qed by Distinct, H1', SEGMENT, -, C2Transitive; `;; let SegmentTrichotomy2 = thm `; let s t u be point_set; assume s <__ t [H1]; assume Segment u /\ t === u [H2]; thus s <__ u proof consider A B P such that Segment s /\ t = seg A B /\ P IN open (A,B) /\ s === seg A P [H1'] by H1, SegmentOrdering_DEF; ~(A = B) /\ ~(A = P) [Distinct] by -, B1'; consider X Y such that u = seg X Y /\ ~(X = Y) [uXY] by H2, SEGMENT; consider Q such that Q IN open (X,Y) /\ seg A P === seg X Q [XQY] by Distinct, -, H1', H2, OrderedCongruentSegments; ~(X = Q) /\ s === seg X Q by -, B1', H1', Distinct, SEGMENT, XQY, C2Transitive; qed by H1', uXY, XQY, -, SegmentOrdering_DEF; `;; let SegmentOrderTransitivity = thm `; let s t u be point_set; assume s <__ t /\ t <__ u [H1]; thus s <__ u proof consider A B G such that u = seg A B /\ G IN open (A,B) /\ t === seg A G [H1'] by H1, SegmentOrdering_DEF; ~(A = B) /\ ~(A = G) /\ Segment s [Distinct] by H1', B1', H1, SegmentOrdering_DEF; s <__ seg A G by H1, H1', Distinct, SEGMENT, SegmentTrichotomy2; consider F such that F IN open (A,G) /\ s === seg A F [AFG] by Distinct, -, SegmentOrderingUse; F IN open (A,B) by H1', IntervalsAreConvex, -, SUBSET; qed by Distinct, H1', -, AFG, SegmentOrdering_DEF; `;; let SegmentTrichotomy = thm `; let s t be point_set; assume Segment s /\ Segment t [H1]; thus (s === t \/ s <__ t \/ t <__ s) /\ ~(s === t /\ s <__ t) /\ ~(s === t /\ t <__ s) /\ ~(s <__ t /\ t <__ s) proof ~(s === t /\ s <__ t) [Not12] proof assume s <__ t; qed by -, SegmentTrichotomy1; ~(s === t /\ t <__ s) [Not13] proof assume t <__ s; ~(t === s) by -, SegmentTrichotomy1; qed by H1, -, C2Symmetric; ~(s <__ t /\ t <__ s) [Not23] proof assume s <__ t /\ t <__ s; s <__ s by H1, -, SegmentOrderTransitivity; qed by -, SegmentTrichotomy1, H1, C2Reflexive; consider O P such that s = seg O P /\ ~(O = P) [sOP] by H1, SEGMENT; consider Q such that Q IN ray O P DELETE O /\ seg O Q === t [QrOP] by H1, -, C1; O NOTIN open (Q,P) /\ Collinear O P Q /\ ~(O = Q) [notQOP] by -, IN_DELETE, IN_Ray; s === seg O P /\ t === seg O Q /\ seg O Q === t /\ seg O P === s [stOPQ] by H1, sOP, -, SEGMENT, QrOP, C2Reflexive, C2Symmetric; cases; suppose Q = P; s === t by -, sOP, QrOP; qed by -, Not12, Not13, Not23; suppose ~(Q = P); P IN open (O,Q) \/ Q IN open (O,P) by sOP, -, notQOP, B3', B1', NOTIN; s <__ seg O Q \/ t <__ seg O P by H1, -, stOPQ, SegmentOrdering_DEF; s <__ t \/ t <__ s by -, H1, stOPQ, SegmentTrichotomy2; qed by -, Not12, Not13, Not23; end; `;; let C4Uniqueness = thm `; let O A B P be point; let l be point_set; assume Line l /\ O IN l /\ A IN l /\ ~(O = A) [H1]; assume B NOTIN l /\ P NOTIN l /\ P,B same_side l [H2]; assume angle A O P === angle A O B [H3]; thus ray O B = ray O P proof ~(O = B) /\ ~(O = P) /\ Ray (ray O B) /\ Ray (ray O P) [Distinct] by H2, H1, NOTIN, RAY; ~Collinear A O B /\ B,B same_side l [Bsim_lB] by H1, H2, I1, Collinear_DEF, NOTIN, SameSideReflexive; Angle (angle A O B) /\ angle A O B === angle A O B by -, ANGLE, C5Reflexive; qed by -, H1, H2, Distinct, Bsim_lB, H3, C4; `;; let AngleSymmetry = thm `; ! A O B. angle A O B = angle B O A by Angle_DEF, UNION_COMM; `;; let TriangleCongSymmetry = thm `; let A B C A' B' C' be point; assume A,B,C cong A',B',C' [H1]; thus A,C,B cong A',C',B' /\ B,A,C cong B',A',C' /\ B,C,A cong B',C',A' /\ C,A,B cong C',A',B' /\ C,B,A cong C',B',A' proof ~Collinear A B C /\ ~Collinear A' B' C' /\ seg A B === seg A' B' /\ seg A C === seg A' C' /\ seg B C === seg B' C' /\ angle A B C === angle A' B' C' /\ angle B C A === angle B' C' A' /\ angle C A B === angle C' A' B' [H1'] by H1, TriangleCong_DEF; seg B A === seg B' A' /\ seg C A === seg C' A' /\ seg C B === seg C' B' [segments] by H1', SegmentSymmetry; angle C B A === angle C' B' A' /\ angle A C B === angle A' C' B' /\ angle B A C === angle B' A' C' by H1', AngleSymmetry; qed by CollinearSymmetry, H1', segments, -, TriangleCong_DEF; `;; let SAS = thm `; let A B C A' B' C' be point; assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; assume seg B A === seg B' A' /\ seg B C === seg B' C' [H2]; assume angle A B C === angle A' B' C' [H3]; thus A,B,C cong A',B',C' proof ~(A = B) /\ ~(A = C) /\ ~(A' = C') [Distinct] by H1, NonCollinearImpliesDistinct; :: 134 consider c such that Line c /\ A IN c /\ B IN c [c_line] by Distinct, I1; C NOTIN c [notCc] by H1, c_line, Collinear_DEF, NOTIN; angle B C A === angle B' C' A' [BCAeq] by H1, H2, H3, C6; angle B A C === angle B' A' C' [BACeq] by H1, CollinearSymmetry, H2, H3, AngleSymmetry, C6; consider Y such that Y IN ray A C DELETE A /\ seg A Y === seg A' C' [YrAC] by Distinct, SEGMENT, C1; Y NOTIN c /\ Y,C same_side c [Ysim_cC] by c_line, notCc, -, RaySameSide; ~Collinear Y A B [YABncol] by c_line, -, Distinct, I1, Collinear_DEF, NOTIN; ray A Y = ray A C /\ angle Y A B = angle C A B by Distinct, YrAC, RayWellDefined, Angle_DEF; angle Y A B === angle C' A' B' by BACeq, -, AngleSymmetry; angle A B Y === angle A' B' C' [ABYeq] by YABncol, H1, CollinearSymmetry, H2, SegmentSymmetry, YrAC, -, C6; Angle (angle A B C) /\ Angle (angle A' B' C') /\ Angle (angle A B Y) by H1, CollinearSymmetry, YABncol, ANGLE; angle A B Y === angle A B C [ABYeqABC] by -, ABYeq, -, H3, C5Symmetric, C5Transitive; ray B C = ray B Y /\ ~(Y = B) /\ Y IN ray B C by c_line, Distinct, notCc, Ysim_cC, ABYeqABC, C4Uniqueness, NOTIN, -, EndpointInRay; Collinear B C Y /\ Collinear A C Y by -, YrAC, IN_DELETE, IN_Ray; C = Y by -, I1, Collinear_DEF, H1; seg A C === seg A' C' by -, YrAC; qed by H1, H2, SegmentSymmetry, -, H3, BCAeq, BACeq, AngleSymmetry, TriangleCong_DEF; `;; let ASA = thm `; let A B C A' B' C' be point; assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; assume seg A C === seg A' C' [H2]; assume angle C A B === angle C' A' B' /\ angle B C A === angle B' C' A' [H3]; thus A,B,C cong A',B',C' proof ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~(A' = B') /\ ~(A' = C') /\ ~(B' = C') /\ Segment (seg C' B') [Distinct] by H1, NonCollinearImpliesDistinct, SEGMENT; consider D such that D IN ray C B DELETE C /\ seg C D === seg C' B' /\ ~(D = C) [DrCB] by -, C1, IN_DELETE; Collinear C B D [CBDcol] by -, IN_DELETE, IN_Ray; ~Collinear D C A /\ Angle (angle C A D) /\ Angle (angle C' A' B') /\ Angle (angle C A B) [DCAncol] by H1, CollinearSymmetry, -, DrCB, NoncollinearityExtendsToLine, H1, ANGLE; consider b such that Line b /\ A IN b /\ C IN b [b_line] by Distinct, I1; B NOTIN b /\ ~(D = A) [notBb] by H1, -, Collinear_DEF, NOTIN, DCAncol, NonCollinearImpliesDistinct; D NOTIN b /\ D,B same_side b [Dsim_bB] by b_line, -, DrCB, RaySameSide; ray C D = ray C B by Distinct, DrCB, RayWellDefined; angle D C A === angle B' C' A' by H3, -, Angle_DEF; D,C,A cong B',C',A' by DCAncol, H1, CollinearSymmetry, DrCB, H2, SegmentSymmetry, -, SAS; angle C A D === angle C' A' B' by -, TriangleCong_DEF; angle C A D === angle C A B by DCAncol, -, H3, C5Symmetric, C5Transitive; ray A B = ray A D /\ D IN ray A B by b_line, Distinct, notBb, Dsim_bB, -, C4Uniqueness, notBb, EndpointInRay; Collinear A B D by -, IN_Ray; D = B by I1, -, Collinear_DEF, CBDcol, H1; seg C B === seg C' B' by -, DrCB; B,C,A cong B',C',A' by H1, CollinearSymmetry, -, H2, SegmentSymmetry, H3, SAS; qed by -, TriangleCongSymmetry; `;; let AngleSubtraction = thm `; let A O B A' O' B' G G' be point; assume G IN int_angle A O B /\ G' IN int_angle A' O' B' [H1]; assume angle A O B === angle A' O' B' /\ angle A O G === angle A' O' G' [H2]; thus angle G O B === angle G' O' B' proof ~Collinear A O B /\ ~Collinear A' O' B' [A'O'B'ncol] by H1, IN_InteriorAngle; ~(A = O) /\ ~(O = B) /\ ~(G = O) /\ ~(G' = O') /\ Segment (seg O' A') /\ Segment (seg O' B') [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SEGMENT; consider X Y such that X IN ray O A DELETE O /\ seg O X === seg O' A' /\ Y IN ray O B DELETE O /\ seg O Y === seg O' B' [XYexists] by -, C1; G IN int_angle X O Y [GintXOY] by H1, XYexists, InteriorWellDefined, InteriorAngleSymmetry; consider H H' such that H IN open (X,Y) /\ H IN ray O G DELETE O /\ H' IN open (A',B') /\ H' IN ray O' G' DELETE O' [Hexists] by -, H1, Crossbar_THM; H IN int_angle X O Y /\ H' IN int_angle A' O' B' [HintXOY] by GintXOY, H1, -, WholeRayInterior; ray O X = ray O A /\ ray O Y = ray O B /\ ray O H = ray O G /\ ray O' H' = ray O' G' [Orays] by Distinct, XYexists, Hexists, RayWellDefined; angle X O Y === angle A' O' B' /\ angle X O H === angle A' O' H' [H2'] by H2, -, Angle_DEF; ~Collinear X O Y by GintXOY, IN_InteriorAngle; X,O,Y cong A',O',B' by -, A'O'B'ncol, H2', XYexists, SAS; seg X Y === seg A' B' /\ angle O Y X === angle O' B' A' /\ angle Y X O === angle B' A' O' [XOYcong] by -, TriangleCong_DEF; ~Collinear O H X /\ ~Collinear O' H' A' /\ ~Collinear O Y H /\ ~Collinear O' B' H' [OHXncol] by HintXOY, InteriorEZHelp, InteriorAngleSymmetry, CollinearSymmetry; ray X H = ray X Y /\ ray A' H' = ray A' B' /\ ray Y H = ray Y X /\ ray B' H' = ray B' A' [Hrays] by Hexists, B1', IntervalRay; angle H X O === angle H' A' O' by XOYcong, -, Angle_DEF; O,H,X cong O',H',A' by OHXncol, XYexists, -, H2', ASA; seg X H === seg A' H' by -, TriangleCong_DEF, SegmentSymmetry; seg H Y === seg H' B' by Hexists, XOYcong, -, SegmentSubtraction; seg Y O === seg B' O' /\ seg Y H === seg B' H' [YHeq] by XYexists, -, SegmentSymmetry; angle O Y H === angle O' B' H' by XOYcong, Hrays, Angle_DEF; O,Y,H cong O',B',H' by OHXncol, YHeq, -, SAS; angle H O Y === angle H' O' B' by -, TriangleCong_DEF; qed by -, Orays, Angle_DEF; `;; let OrderedCongruentAngles = thm `; let A O B A' O' B' G be point; assume ~Collinear A' O' B' [H1]; assume angle A O B === angle A' O' B' [H2]; assume G IN int_angle A O B [H3]; thus ? G'. G' IN int_angle A' O' B' /\ angle A O G === angle A' O' G' proof ~Collinear A O B [AOBncol] by H3, IN_InteriorAngle; ~(A = O) /\ ~(O = B) /\ ~(A' = B') /\ ~(O = G) /\ Segment (seg O' A') /\ Segment (seg O' B') [Distinct] by AOBncol, H1, NonCollinearImpliesDistinct, H3, InteriorEZHelp, SEGMENT; consider X Y such that X IN ray O A DELETE O /\ seg O X === seg O' A' /\ Y IN ray O B DELETE O /\ seg O Y === seg O' B' [defXY] by -, C1; G IN int_angle X O Y [GintXOY] by H3, -, InteriorWellDefined, InteriorAngleSymmetry; ~Collinear X O Y /\ ~(X = Y) [XOYncol] by -, IN_InteriorAngle, NonCollinearImpliesDistinct; consider H such that H IN open (X,Y) /\ H IN ray O G DELETE O [defH] by GintXOY, Crossbar_THM; ray O X = ray O A /\ ray O Y = ray O B /\ ray O H = ray O G [Orays] by Distinct, defXY, -, RayWellDefined; angle X O Y === angle A' O' B' by H2, -, Angle_DEF; X,O,Y cong A',O',B' by XOYncol, H1, defXY, -, SAS; seg X Y === seg A' B' /\ angle O X Y === angle O' A' B' [YXOcong] by -, TriangleCong_DEF, AngleSymmetry; consider G' such that G' IN open (A',B') /\ seg X H === seg A' G' [A'G'B'] by XOYncol, Distinct, -, defH, OrderedCongruentSegments; G' IN int_angle A' O' B' [G'intA'O'B'] by H1, -, ConverseCrossbar; ray X H = ray X Y /\ ray A' G' = ray A' B' by defH, A'G'B', IntervalRay; angle O X H === angle O' A' G' [HXOeq] by -, Angle_DEF, YXOcong; H IN int_angle X O Y by GintXOY, defH, WholeRayInterior; ~Collinear O X H /\ ~Collinear O' A' G' by -, G'intA'O'B', InteriorEZHelp, CollinearSymmetry; O,X,H cong O',A',G' by -, A'G'B', defXY, SegmentSymmetry, HXOeq, SAS; angle X O H === angle A' O' G' by -, TriangleCong_DEF, AngleSymmetry; angle A O G === angle A' O' G' by -, Orays, Angle_DEF; qed by G'intA'O'B', -; `;; let AngleAddition = thm `; let A O B A' O' B' G G' be point; assume G IN int_angle A O B /\ G' IN int_angle A' O' B' [H1]; assume angle A O G === angle A' O' G' /\ angle G O B === angle G' O' B' [H2]; thus angle A O B === angle A' O' B' proof ~Collinear A O B /\ ~Collinear A' O' B' [AOBncol] by H1, IN_InteriorAngle; ~(A = O) /\ ~(A = B) /\ ~(O = B) /\ ~(A' = O') /\ ~(A' = B') /\ ~(O' = B') /\ ~(G = O) [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp; consider a b such that Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b [a_line] by Distinct, I1; consider g such that Line g /\ O IN g /\ G IN g [g_line] by Distinct, I1; G NOTIN a /\ G,B same_side a [H1'] by a_line, H1, InteriorUse; ~Collinear A O G /\ ~Collinear A' O' G' [AOGncol] by H1, InteriorEZHelp, IN_InteriorAngle; Angle (angle A O B) /\ Angle (angle A' O' B') /\ Angle (angle A O G) /\ Angle (angle A' O' G') [angles] by AOBncol, -, ANGLE; ?! r. Ray r /\ ? X. ~(O = X) /\ r = ray O X /\ X NOTIN a /\ X,G same_side a /\ angle A O X === angle A' O' B' by -, Distinct, a_line, H1', C4; consider X such that X NOTIN a /\ X,G same_side a /\ angle A O X === angle A' O' B' [Xexists] by -; ~Collinear A O X [AOXncol] by -, a_line, Distinct, I1, Collinear_DEF, NOTIN; angle A' O' B' === angle A O X by -, AOBncol, ANGLE, Xexists, C5Symmetric; consider Y such that Y IN int_angle A O X /\ angle A' O' G' === angle A O Y [YintAOX] by AOXncol, -, H1, OrderedCongruentAngles; ~Collinear A O Y by -, InteriorEZHelp; angle A O Y === angle A O G [AOGeq] by -, angles, -, ANGLE, YintAOX, H2, C5Transitive, C5Symmetric; consider x such that Line x /\ O IN x /\ X IN x by Distinct, I1; Y NOTIN a /\ Y,X same_side a by a_line, -, YintAOX, InteriorUse; Y NOTIN a /\ Y,G same_side a by a_line, -, Xexists, H1', SameSideTransitive; ray O G = ray O Y by a_line, Distinct, H1', -, AOGeq, C4Uniqueness; G IN ray O Y DELETE O by Distinct, -, EndpointInRay, IN_DELETE; G IN int_angle A O X [GintAOX] by YintAOX, -, WholeRayInterior; angle G O X === angle G' O' B' [GOXeq] by -, H1, Xexists, H2, AngleSubtraction; ~Collinear G O X /\ ~Collinear G O B /\ ~Collinear G' O' B' [GOXncol] by GintAOX, H1, InteriorAngleSymmetry, InteriorEZHelp, CollinearSymmetry; Angle (angle G O X) /\ Angle (angle G O B) /\ Angle (angle G' O' B') by -, ANGLE; angle G O X === angle G O B [G'O'Xeq] by angles, -, GOXeq, C5Symmetric, H2, C5Transitive; ~(A,X same_side g) /\ ~(A,B same_side g) [Ansim_aXB] by g_line, GintAOX, H1, InteriorOpposite; A NOTIN g /\ B NOTIN g /\ X NOTIN g [notABXg] by g_line, AOGncol, GOXncol, Distinct, I1, Collinear_DEF, NOTIN; X,B same_side g by g_line, -, Ansim_aXB, AtMost2Sides; ray O X = ray O B by g_line, Distinct, notABXg, -, G'O'Xeq, C4Uniqueness; qed by -, Xexists, Angle_DEF; `;; let AngleOrderingUse = thm `; let A O B be point; let alpha be point_set; assume Angle alpha /\ ~Collinear A O B [H1]; assume alpha <_ang angle A O B [H3]; thus ? G. G IN int_angle A O B /\ alpha === angle A O G proof consider A' O' B' G' such that ~Collinear A' O' B' /\ angle A O B = angle A' O' B' /\ G' IN int_angle A' O' B' /\ alpha === angle A' O' G' [H3'] by H3, AngleOrdering_DEF; Angle (angle A O B) /\ Angle (angle A' O' B') /\ Angle (angle A' O' G') [angles] by H1, -, ANGLE, InteriorEZHelp; angle A' O' B' === angle A O B by -, H3', C5Reflexive; consider G such that G IN int_angle A O B /\ angle A' O' G' === angle A O G [GintAOB] by H1, H3', -, OrderedCongruentAngles; alpha === angle A O G by H1, angles, -, InteriorEZHelp, ANGLE, H3', GintAOB, C5Transitive; qed by -, GintAOB; `;; let AngleTrichotomy1 = thm `; let alpha beta be point_set; assume alpha <_ang beta [H1]; thus ~(alpha === beta) proof assume alpha === beta [Con]; consider A O B G such that Angle alpha /\ ~Collinear A O B /\ beta = angle A O B /\ G IN int_angle A O B /\ alpha === angle A O G [H1'] by H1, AngleOrdering_DEF; ~(A = O) /\ ~(O = B) /\ ~Collinear A O G [Distinct] by H1', NonCollinearImpliesDistinct, InteriorEZHelp; consider a such that Line a /\ O IN a /\ A IN a [a_line] by Distinct, I1; consider b such that Line b /\ O IN b /\ B IN b [b_line] by Distinct, I1; B NOTIN a [notBa] by a_line, H1', Collinear_DEF, NOTIN; G NOTIN a /\ G NOTIN b /\ G,B same_side a [GintAOB] by a_line, b_line, H1', InteriorUse; angle A O G === alpha by H1', Distinct, ANGLE, C5Symmetric; angle A O G === angle A O B by H1', Distinct, ANGLE, -, Con, C5Transitive; ray O B = ray O G by a_line, Distinct, notBa, GintAOB, -, C4Uniqueness; G IN b by Distinct, -, EndpointInRay, b_line, RayLine, SUBSET; qed by -, GintAOB, NOTIN; `;; let AngleTrichotomy2 = thm `; let alpha beta gamma be point_set; assume alpha <_ang beta [H1]; assume Angle gamma [H2]; assume beta === gamma [H3]; thus alpha <_ang gamma proof consider A O B G such that Angle alpha /\ ~Collinear A O B /\ beta = angle A O B /\ G IN int_angle A O B /\ alpha === angle A O G [H1'] by H1, AngleOrdering_DEF; consider A' O' B' such that gamma = angle A' O' B' /\ ~Collinear A' O' B' [gammaA'O'B'] by H2, ANGLE; consider G' such that G' IN int_angle A' O' B' /\ angle A O G === angle A' O' G' [G'intA'O'B'] by gammaA'O'B', H1', H3, OrderedCongruentAngles; ~Collinear A O G /\ ~Collinear A' O' G' [ncol] by H1', -, InteriorEZHelp; alpha === angle A' O' G' by H1', ANGLE, -, G'intA'O'B', C5Transitive; qed by H1', -, ncol, gammaA'O'B', G'intA'O'B', -, AngleOrdering_DEF; `;; let AngleOrderTransitivity = thm `; let alpha beta gamma be point_set; assume alpha <_ang beta [H0]; assume beta <_ang gamma [H2]; thus alpha <_ang gamma proof consider A O B G such that Angle beta /\ ~Collinear A O B /\ gamma = angle A O B /\ G IN int_angle A O B /\ beta === angle A O G [H2'] by H2, AngleOrdering_DEF; ~Collinear A O G [AOGncol] by H2', InteriorEZHelp; Angle alpha /\ Angle (angle A O G) /\ Angle gamma [angles] by H0, AngleOrdering_DEF, H2', -, ANGLE; alpha <_ang angle A O G by H0, H2', -, AngleTrichotomy2; consider F such that F IN int_angle A O G /\ alpha === angle A O F [FintAOG] by angles, AOGncol, -, AngleOrderingUse; F IN int_angle A O B by H2', -, InteriorTransitivity; qed by angles, H2', -, FintAOG, AngleOrdering_DEF; `;; let AngleTrichotomy = thm `; let alpha beta be point_set; assume Angle alpha /\ Angle beta [H1]; thus (alpha === beta \/ alpha <_ang beta \/ beta <_ang alpha) /\ ~(alpha === beta /\ alpha <_ang beta) /\ ~(alpha === beta /\ beta <_ang alpha) /\ ~(alpha <_ang beta /\ beta <_ang alpha) proof ~(alpha === beta /\ alpha <_ang beta) [Not12] by AngleTrichotomy1; ~(alpha === beta /\ beta <_ang alpha) [Not13] by H1, C5Symmetric, AngleTrichotomy1; ~(alpha <_ang beta /\ beta <_ang alpha) [Not23] by H1, AngleOrderTransitivity, AngleTrichotomy1, C5Reflexive; consider P O A such that alpha = angle P O A /\ ~Collinear P O A [POA] by H1, ANGLE; ~(P = O) /\ ~(O = A) [Distinct] by -, NonCollinearImpliesDistinct; consider a such that Line a /\ O IN a /\ A IN a [a_line] by -, I1; P NOTIN a [notPa] by -, Distinct, I1, POA, Collinear_DEF, NOTIN; ?! r. Ray r /\ ? Q. ~(O = Q) /\ r = ray O Q /\ Q NOTIN a /\ Q,P same_side a /\ angle A O Q === beta by H1, Distinct, a_line, -, C4; consider Q such that ~(O = Q) /\ Q NOTIN a /\ Q,P same_side a /\ angle A O Q === beta [Qexists] by -; O NOTIN open (Q,P) [notQOP] by a_line, Qexists, SameSide_DEF, NOTIN; ~Collinear A O P [AOPncol] by POA, CollinearSymmetry; ~Collinear A O Q [AOQncol] by a_line, Distinct, I1, Collinear_DEF, Qexists, NOTIN; Angle (angle A O P) /\ Angle (angle A O Q) by AOPncol, -, ANGLE; alpha === angle A O P /\ beta === angle A O Q /\ angle A O P === alpha [flip] by H1, -, POA, AngleSymmetry, C5Reflexive, Qexists, C5Symmetric; cases; suppose Collinear Q O P; Collinear O P Q by -, CollinearSymmetry; Q IN ray O P DELETE O by Distinct, -, notQOP, IN_Ray, Qexists, IN_DELETE; ray O Q = ray O P by Distinct, -, RayWellDefined; angle P O A = angle A O Q by -, Angle_DEF, AngleSymmetry; alpha === beta by -, POA, Qexists; qed by -, Not12, Not13, Not23; suppose ~Collinear Q O P; P IN int_angle Q O A \/ Q IN int_angle P O A by Distinct, a_line, Qexists, notPa, -, AngleOrdering; P IN int_angle A O Q \/ Q IN int_angle A O P by -, InteriorAngleSymmetry; alpha <_ang angle A O Q \/ beta <_ang angle A O P by H1, AOQncol, AOPncol, -, flip, AngleOrdering_DEF; alpha <_ang beta \/ beta <_ang alpha by H1, -, Qexists, flip, AngleTrichotomy2; qed by -, Not12, Not13, Not23; end; `;; let SupplementExists = thm `; let alpha be point_set; assume Angle alpha [H1]; thus ? alpha'. alpha suppl alpha' proof consider A O B such that alpha = angle A O B /\ ~Collinear A O B /\ ~(A = O) [def_alpha] by H1, ANGLE, NonCollinearImpliesDistinct; consider A' such that O IN open (A,A') by -, B2'; angle A O B suppl angle A' O B [AOBsup] by def_alpha, -, SupplementaryAngles_DEF, AngleSymmetry; qed by -, def_alpha; `;; let SupplementImpliesAngle = thm `; let alpha beta be point_set; assume alpha suppl beta [H1]; thus Angle alpha /\ Angle beta proof consider A O B A' such that ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ beta = angle B O A' [H1'] by H1, SupplementaryAngles_DEF; ~(O = A') /\ Collinear A O A' [Distinct] by -, NonCollinearImpliesDistinct, B1'; ~Collinear B O A' by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; qed by H1', -, ANGLE; `;; let RightImpliesAngle = thm `; ! alpha: point_set. Right alpha ==> Angle alpha by RightAngle_DEF, SupplementImpliesAngle; `;; let SupplementSymmetry = thm `; let alpha beta be point_set; assume alpha suppl beta [H1]; thus beta suppl alpha proof consider A O B A' such that ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ beta = angle B O A' [H1'] by H1, SupplementaryAngles_DEF; ~(O = A') /\ Collinear A O A' by -, NonCollinearImpliesDistinct, B1'; ~Collinear A' O B [A'OBncol] by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; O IN open (A',A) /\ beta = angle A' O B /\ alpha = angle B O A by H1', B1', AngleSymmetry; qed by A'OBncol, -, SupplementaryAngles_DEF; `;; let SupplementsCongAnglesCong = thm `; let alpha beta alpha' beta' be point_set; assume alpha suppl alpha' /\ beta suppl beta' [H1]; assume alpha === beta [H2]; thus alpha' === beta' proof consider A O B A' such that ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ alpha' = angle B O A' [def_alpha] by H1, SupplementaryAngles_DEF; ~(A = O) /\ ~(O = B) /\ ~(A = A') /\ ~(O = A') /\ Collinear A O A' [Distinctalpha] by -, NonCollinearImpliesDistinct, B1'; ~Collinear B A A' /\ ~Collinear O A' B [BAA'ncol] by def_alpha, CollinearSymmetry, -, NoncollinearityExtendsToLine; Segment (seg O A) /\ Segment (seg O B) /\ Segment (seg O A') [Osegments] by Distinctalpha, SEGMENT; consider C P D C' such that ~Collinear C P D /\ P IN open (C,C') /\ beta = angle C P D /\ beta' = angle D P C' [def_beta] by H1, SupplementaryAngles_DEF; ~(C = P) /\ ~(P = D) /\ ~(P = C') [Distinctbeta] by def_beta, NonCollinearImpliesDistinct, B1'; consider X such that X IN ray P C DELETE P /\ seg P X === seg O A [defX] by Osegments, Distinctbeta, C1; consider Y such that Y IN ray P D DELETE P /\ seg P Y === seg O B /\ ~(Y = P) [defY] by Osegments, Distinctbeta, C1, IN_DELETE; consider X' such that X' IN ray P C' DELETE P /\ seg P X' === seg O A' [defX'] by Osegments, Distinctbeta, C1; P IN open (X',C) /\ P IN open (X,X') [XPX'] by def_beta, -, OppositeRaysIntersect1pointHelp, defX; ~(X = P) /\ ~(X' = P) /\ Collinear X P X' /\ ~(X = X') /\ ray A' O = ray A' A /\ ray X' P = ray X' X [XPX'line] by defX, defX', IN_DELETE, -, B1', def_alpha, IntervalRay; Collinear P D Y /\ Collinear P C X by defY, defX, IN_DELETE, IN_Ray; ~Collinear C P Y /\ ~Collinear X P Y [XPYncol] by def_beta, -, defY, NoncollinearityExtendsToLine, CollinearSymmetry, XPX'line; ~Collinear Y X X' /\ ~Collinear P X' Y [YXX'ncol] by -, CollinearSymmetry, XPX', XPX'line, NoncollinearityExtendsToLine; ray P X = ray P C /\ ray P Y = ray P D /\ ray P X' = ray P C' [equalPrays] by Distinctbeta, defX, defY, defX', RayWellDefined; beta = angle X P Y /\ beta' = angle Y P X' /\ angle A O B === angle X P Y [AOBeqXPY] by def_beta, -, Angle_DEF, H2, def_alpha; seg O A === seg P X /\ seg O B === seg P Y /\ seg A' O === seg X' P [OAeq] by Osegments, XPX'line, SEGMENT, defX, defY, defX', C2Symmetric, SegmentSymmetry; seg A A' === seg X X' [AA'eq] by def_alpha, XPX'line, XPX', -, SegmentSymmetry, C3; A,O,B cong X,P,Y by def_alpha, XPYncol, OAeq, AOBeqXPY, SAS; seg A B === seg X Y /\ angle B A O === angle Y X P [AOBcong] by -, TriangleCong_DEF, AngleSymmetry; ray A O = ray A A' /\ ray X P = ray X X' /\ angle B A A' === angle Y X X' by def_alpha, XPX', IntervalRay, -, Angle_DEF; B,A,A' cong Y,X,X' by BAA'ncol, YXX'ncol, AOBcong, -, AA'eq, -, SAS; seg A' B === seg X' Y /\ angle A A' B === angle X X' Y by -, TriangleCong_DEF, SegmentSymmetry; O,A',B cong P,X',Y by BAA'ncol, YXX'ncol, OAeq, -, XPX'line, Angle_DEF, SAS; angle B O A' === angle Y P X' by -, TriangleCong_DEF; qed by -, equalPrays, def_beta, Angle_DEF, def_alpha; `;; let SupplementUnique = thm `; ! alpha beta beta': point_set. alpha suppl beta /\ alpha suppl beta' ==> beta === beta' by SupplementaryAngles_DEF, ANGLE, C5Reflexive, SupplementsCongAnglesCong; `;; let CongRightImpliesRight = thm `; let alpha beta be point_set; assume Angle alpha /\ Right beta [H1]; assume alpha === beta [H2]; thus Right alpha proof consider alpha' beta' such that alpha suppl alpha' /\ beta suppl beta' /\ beta === beta' [suppl] by H1, SupplementExists, H1, RightAngle_DEF; alpha' === beta' [alpha'eqbeta'] by suppl, H2, SupplementsCongAnglesCong; Angle beta /\ Angle alpha' /\ Angle beta' by suppl, SupplementImpliesAngle; alpha === alpha' by H1, -, H2, suppl, alpha'eqbeta', C5Symmetric, C5Transitive; qed by suppl, -, RightAngle_DEF; `;; let RightAnglesCongruentHelp = thm `; let A O B A' P be point; let a be point_set; assume ~Collinear A O B /\ O IN open (A,A') [H1]; assume Right (angle A O B) /\ Right (angle A O P) [H2]; thus P NOTIN int_angle A O B proof assume ~(P NOTIN int_angle A O B); P IN int_angle A O B [PintAOB] by -, NOTIN; B IN int_angle P O A' /\ B IN int_angle A' O P [BintA'OP] by H1, -, InteriorReflectionInterior, InteriorAngleSymmetry ; ~Collinear A O P /\ ~Collinear P O A' [AOPncol] by PintAOB, InteriorEZHelp, -, IN_InteriorAngle; angle A O B suppl angle B O A' /\ angle A O P suppl angle P O A' [AOBsup] by H1, -, SupplementaryAngles_DEF; consider alpha' beta' such that angle A O B suppl alpha' /\ angle A O B === alpha' /\ angle A O P suppl beta' /\ angle A O P === beta' [supplalpha'] by H2, RightAngle_DEF; alpha' === angle B O A' /\ beta' === angle P O A' [alpha'eqA'OB] by -, AOBsup, SupplementUnique; Angle (angle A O B) /\ Angle alpha' /\ Angle (angle B O A') /\ Angle (angle A O P) /\ Angle beta' /\ Angle (angle P O A') [angles] by AOBsup, supplalpha', SupplementImpliesAngle, AngleSymmetry; angle A O B === angle B O A' /\ angle A O P === angle P O A' [H2'] by -, supplalpha', alpha'eqA'OB, C5Transitive; angle A O P === angle A O P /\ angle B O A' === angle B O A' [refl] by angles, C5Reflexive; angle A O P <_ang angle A O B /\ angle B O A' <_ang angle P O A' [BOA'lessPOA'] by angles, H1, PintAOB, -, AngleOrdering_DEF, AOPncol, CollinearSymmetry, BintA'OP, AngleSymmetry; angle A O P <_ang angle B O A' by -, angles, H2', AngleTrichotomy2; angle A O P <_ang angle P O A' by -, BOA'lessPOA', AngleOrderTransitivity; qed by -, H2', AngleTrichotomy1; `;; let RightAnglesCongruent = thm `; let alpha beta be point_set; assume Right alpha /\ Right beta [H1]; thus alpha === beta proof consider alpha' such that alpha suppl alpha' /\ alpha === alpha' by H1, RightAngle_DEF; consider A O B A' such that ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ alpha' = angle B O A' [def_alpha] by -, SupplementaryAngles_DEF; ~(A = O) /\ ~(O = B) [Distinct] by def_alpha, NonCollinearImpliesDistinct, B1'; consider a such that Line a /\ O IN a /\ A IN a [a_line] by Distinct, I1; B NOTIN a [notBa] by -, def_alpha, Collinear_DEF, NOTIN; Angle beta by H1, RightImpliesAngle; ?! r. Ray r /\ ? P. ~(O = P) /\ r = ray O P /\ P NOTIN a /\ P,B same_side a /\ angle A O P === beta by -, Distinct, a_line, notBa, C4; consider P such that ~(O = P) /\ P NOTIN a /\ P,B same_side a /\ angle A O P === beta [defP] by -; O NOTIN open (P,B) [notPOB] by a_line, -, SameSide_DEF, NOTIN; ~Collinear A O P [AOPncol] by a_line, Distinct, I1, defP, Collinear_DEF, NOTIN; Right (angle A O P) [AOPright] by -, ANGLE, H1, defP, CongRightImpliesRight; P NOTIN int_angle A O B /\ B NOTIN int_angle A O P by def_alpha, H1, -, AOPncol, AOPright, RightAnglesCongruentHelp; Collinear P O B by Distinct, a_line, defP, notBa, -, AngleOrdering, InteriorAngleSymmetry, NOTIN; P IN ray O B DELETE O by Distinct, -, CollinearSymmetry, notPOB, IN_Ray, defP, IN_DELETE; ray O P = ray O B /\ angle A O P = angle A O B by Distinct, -, RayWellDefined, Angle_DEF; qed by -, defP, def_alpha; `;; let OppositeRightAnglesLinear = thm `; let A B O H be point; let h be point_set; assume ~Collinear A O H /\ ~Collinear H O B [H0]; assume Right (angle A O H) /\ Right (angle H O B) [H1]; assume Line h /\ O IN h /\ H IN h /\ ~(A,B same_side h) [H2]; thus O IN open (A,B) proof ~(A = O) /\ ~(O = H) /\ ~(O = B) [Distinct] by H0, NonCollinearImpliesDistinct; A NOTIN h /\ B NOTIN h [notABh] by H0, H2, Collinear_DEF, NOTIN; consider E such that O IN open (A,E) /\ ~(E = O) [AOE] by Distinct, B2', B1'; angle A O H suppl angle H O E [AOHsupplHOE] by H0, -, SupplementaryAngles_DEF; E NOTIN h [notEh] by H2, NOTIN, AOE, BetweenLinear, notABh; ~(A,E same_side h) by H2, AOE, SameSide_DEF; B,E same_side h [Bsim_hE] by H2, notABh, notEh, -, H2, AtMost2Sides; consider alpha' such that angle A O H suppl alpha' /\ angle A O H === alpha' [AOHsupplalpha'] by H1, RightAngle_DEF; Angle (angle H O B) /\ Angle (angle A O H) /\ Angle alpha' /\ Angle (angle H O E) [angalpha'] by H1, RightImpliesAngle, -, AOHsupplHOE, SupplementImpliesAngle; angle H O B === angle A O H /\ alpha' === angle H O E by H1, RightAnglesCongruent, AOHsupplalpha', AOHsupplHOE, SupplementUnique; angle H O B === angle H O E by angalpha', -, AOHsupplalpha', C5Transitive; ray O B = ray O E by H2, Distinct, notABh, notEh, Bsim_hE, -, C4Uniqueness; B IN ray O E DELETE O by Distinct, EndpointInRay, -, IN_DELETE; qed by AOE, -, OppositeRaysIntersect1pointHelp, B1'; `;; let RightImpliesSupplRight = thm `; let A O B A' be point; assume ~Collinear A O B [H1]; assume O IN open (A,A') [H2]; assume Right (angle A O B) [H3]; thus Right (angle B O A') proof angle A O B suppl angle B O A' /\ Angle (angle A O B) /\ Angle (angle B O A') [AOBsuppl] by H1, H2, SupplementaryAngles_DEF, SupplementImpliesAngle; consider beta such that angle A O B suppl beta /\ angle A O B === beta [betasuppl] by H3, RightAngle_DEF; Angle beta /\ beta === angle A O B [angbeta] by -, SupplementImpliesAngle, C5Symmetric; angle B O A' === beta by AOBsuppl, betasuppl, SupplementUnique; angle B O A' === angle A O B by AOBsuppl, angbeta, -, betasuppl, C5Transitive; qed by AOBsuppl, H3, -, CongRightImpliesRight; `;; let IsoscelesCongBaseAngles = thm `; let A B C be point; assume ~Collinear A B C [H1]; assume seg B A === seg B C [H2]; thus angle C A B === angle A C B proof ~(A = B) /\ ~(B = C) /\ ~Collinear C B A [CBAncol] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; seg B C === seg B A /\ angle A B C === angle C B A by -, SEGMENT, H2, C2Symmetric, H1, ANGLE, AngleSymmetry, C5Reflexive; A,B,C cong C,B,A by H1, CBAncol, H2, -, SAS; qed by -, TriangleCong_DEF; `;; let C4withC1 = thm `; let alpha l be point_set; let O A Y P Q be point; assume Angle alpha /\ ~(O = A) /\ ~(P = Q) [H1]; assume Line l /\ O IN l /\ A IN l /\ Y NOTIN l [l_line]; thus ? N. ~(O = N) /\ N NOTIN l /\ N,Y same_side l /\ seg O N === seg P Q /\ angle A O N === alpha proof ?! r. Ray r /\ ? B. ~(O = B) /\ r = ray O B /\ B NOTIN l /\ B,Y same_side l /\ angle A O B === alpha by H1, l_line, C4; consider B such that ~(O = B) /\ B NOTIN l /\ B,Y same_side l /\ angle A O B === alpha [Bexists] by -; consider N such that N IN ray O B DELETE O /\ seg O N === seg P Q [Nexists] by H1, -, SEGMENT, C1; ~(O = N) [notON] by -, IN_DELETE; N NOTIN l /\ N,B same_side l [notNl] by l_line, Bexists, Nexists, RaySameSide; N,Y same_side l [Nsim_lY] by l_line, -, Bexists, SameSideTransitive; ray O N = ray O B /\ angle A O N === alpha by Bexists, Nexists, RayWellDefined, Angle_DEF; qed by notON, notNl, Nsim_lY, Nexists, -; `;; let C4OppositeSide = thm `; let alpha l be point_set; let O A Z P Q be point; assume Angle alpha /\ ~(O = A) /\ ~(P = Q) [H1]; assume Line l /\ O IN l /\ A IN l /\ Z NOTIN l [l_line]; thus ? N. ~(O = N) /\ N NOTIN l /\ ~(Z,N same_side l) /\ seg O N === seg P Q /\ angle A O N === alpha proof ~(Z = O) by l_line, NOTIN; consider Y such that O IN open (Z,Y) [ZOY] by -, B2'; ~(O = Y) /\ Collinear Z O Y by -, B1'; Y NOTIN l [notYl] by l_line, I1, -, Collinear_DEF, NOTIN; consider N such that ~(O = N) /\ N NOTIN l /\ N,Y same_side l /\ seg O N === seg P Q /\ angle A O N === alpha [Nexists] by H1, l_line, notYl, C4withC1; ~(Z,Y same_side l) by l_line, ZOY, SameSide_DEF; ~(Z,N same_side l) by l_line, Nexists, notYl, -, SameSideTransitive; qed by -, Nexists; `;; let SSS = thm `; let A B C A' B' C' be point; assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; assume seg A B === seg A' B' /\ seg A C === seg A' C' /\ seg B C === seg B' C' [H2]; thus A,B,C cong A',B',C' proof ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~(A' = B') /\ ~(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; consider h such that Line h /\ A IN h /\ C IN h [h_line] by Distinct, I1; B NOTIN h [notBh] by h_line, H1, NOTIN, Collinear_DEF; Segment (seg A B) /\ Segment (seg C B) /\ Segment (seg A' B') /\ Segment (seg C' B') [segments] by Distinct, -, SEGMENT; Angle (angle C' A' B') by H1, CollinearSymmetry, ANGLE; consider N such that ~(A = N) /\ N NOTIN h /\ ~(B,N same_side h) /\ seg A N === seg A' B' /\ angle C A N === angle C' A' B' [Nexists] by -, Distinct, h_line, notBh, C4OppositeSide; ~(C = N) by h_line, Nexists, NOTIN; Segment (seg A N) /\ Segment (seg C N) [segN] by Nexists, -, SEGMENT; ~Collinear A N C [ANCncol] by h_line, Distinct, I1, Collinear_DEF, Nexists, NOTIN; Angle (angle A B C) /\ Angle (angle A' B' C') /\ Angle (angle A N C) [angles] by H1, -, ANGLE; seg A B === seg A N [ABeqAN] by segments, segN, Nexists, H2, C2Symmetric, C2Transitive; C,A,N cong C',A',B' by ANCncol, H1, CollinearSymmetry, H2, Nexists, SAS; angle A N C === angle A' B' C' /\ seg C N === seg C' B' [ANCeq] by -, TriangleCong_DEF; seg C B === seg C N [CBeqCN] by segments, segN, -, H2, SegmentSymmetry, C2Symmetric, C2Transitive; consider G such that G IN h /\ G IN open (B,N) [BGN] by Nexists, h_line, SameSide_DEF; ~(B = N) [notBN] by -, B1'; ray B G = ray B N /\ ray N G = ray N B [Grays] by BGN, B1', IntervalRay; consider v such that Line v /\ B IN v /\ N IN v [v_line] by notBN, I1; G IN v /\ ~(h = v) by v_line, BGN, BetweenLinear, notBh, NOTIN; h INTER v = {G} [hvG] by h_line, v_line, -, BGN, I1Uniqueness; ~(G = A) ==> angle A B G === angle A N G [ABGeqANG] proof assume ~(G = A) [notGA]; A NOTIN v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; ~Collinear B A N by v_line, notBN, I1, Collinear_DEF, -, NOTIN; angle N B A === angle B N A by -, ABeqAN, IsoscelesCongBaseAngles; angle G B A === angle G N A by -, Grays, Angle_DEF, notGA; qed by -, AngleSymmetry; ~(G = C) ==> angle G B C === angle G N C [GBCeqGNC] proof assume ~(G = C) [notGC]; C NOTIN v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; ~Collinear B C N by v_line, notBN, I1, Collinear_DEF, -, NOTIN; angle N B C === angle B N C by -, CBeqCN, IsoscelesCongBaseAngles, AngleSymmetry; qed by -, Grays, Angle_DEF; angle A B C === angle A N C proof cases; suppose G = A [GA]; ~(G = C) by -, Distinct; qed by -, GBCeqGNC, GA; suppose G = C [GC]; ~(G = A) by -, Distinct; qed by -, ABGeqANG, GC; suppose ~(G = A) /\ ~(G = C) [AGCdistinct]; angle A B G === angle A N G /\ angle G B C === angle G N C [Gequivs] by -, ABGeqANG, GBCeqGNC; ~Collinear G B C /\ ~Collinear G N C /\ ~Collinear G B A /\ ~Collinear G N A [Gncols] by h_line, BGN, AGCdistinct, I1, Collinear_DEF, notBh, Nexists, NOTIN; Collinear A G C by h_line, BGN, Collinear_DEF; G IN open (A,C) \/ C IN open (G,A) \/ A IN open (C,G) by Distinct, AGCdistinct, -, B3'; cases by -; suppose G IN open (A,C); G IN int_angle A B C /\ G IN int_angle A N C by H1, ANCncol, -, ConverseCrossbar; qed by -, Gequivs, AngleAddition; suppose C IN open (G,A); C IN int_angle G B A /\ C IN int_angle G N A by Gncols, -, B1', ConverseCrossbar; qed by -, Gequivs, AngleSubtraction, AngleSymmetry; suppose A IN open (C,G); A IN int_angle G B C /\ A IN int_angle G N C by Gncols, -, B1', ConverseCrossbar; qed by -, Gequivs, AngleSymmetry, AngleSubtraction; end; end; angle A B C === angle A' B' C' by angles, -, ANCeq, C5Transitive; qed by H1, H2, SegmentSymmetry, -, SAS; `;; let AngleBisector = thm `; let A B C be point; assume ~Collinear B A C [H1]; thus ? F. F IN int_angle B A C /\ angle B A F === angle F A C proof ~(A = B) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; consider D such that B IN open (A,D) [ABD] by Distinct, B2'; ~(A = D) /\ Collinear A B D /\ Segment (seg A D) [ABD'] by -, B1', SEGMENT; consider E such that E IN ray A C DELETE A /\ seg A E === seg A D /\ ~(A = E) [ErAC] by -, Distinct, C1, IN_DELETE, IN_Ray; Collinear A C E /\ D IN ray A B DELETE A [notAE] by ErAC, IN_DELETE, IN_Ray, ABD, IntervalRayEZ; ray A D = ray A B /\ ray A E = ray A C [equalrays] by Distinct, notAE, ErAC, RayWellDefined; ~Collinear D A E /\ ~Collinear E A D /\ ~Collinear A E D [EADncol] by H1, ABD', notAE, ErAC, CollinearSymmetry, NoncollinearityExtendsToLine; angle D E A === angle E D A [DEAeq] by EADncol, ErAC, IsoscelesCongBaseAngles; ~Collinear E D A /\ Angle (angle E D A) /\ ~Collinear A D E /\ ~Collinear D E A [angEDA] by EADncol, CollinearSymmetry, ANGLE; ~(D = E) [notDE] by EADncol, NonCollinearImpliesDistinct; consider h such that Line h /\ D IN h /\ E IN h [h_line] by -, I1; A NOTIN h [notAh] by -, Collinear_DEF, EADncol, NOTIN; consider F such that ~(D = F) /\ F NOTIN h /\ ~(A,F same_side h) /\ seg D F === seg D A /\ angle E D F === angle E D A [Fexists] by angEDA, notDE, ABD', h_line, -, C4OppositeSide; ~(A = F) [notAF] by h_line, -, SameSideReflexive; ~Collinear E D F /\ ~Collinear D E F /\ ~Collinear F E D [EDFncol] by h_line, notDE, I1, Collinear_DEF, Fexists, NOTIN; seg D E === seg D E /\ seg F A === seg F A [FArefl] by notDE, notAF, SEGMENT, C2Reflexive; E,D,F cong E,D,A by EDFncol, angEDA, -, Fexists, SAS; seg F E === seg A E /\ angle F E D === angle A E D [FEDcong] by -, TriangleCong_DEF, SegmentSymmetry; angle E D A === angle D E A /\ angle E D A === angle E D F /\ angle D E A === angle D E F [EDAeqEDF] by EDFncol, ANGLE, angEDA, Fexists, FEDcong, DEAeq, C5Symmetric, AngleSymmetry; consider G such that G IN h /\ G IN open (A,F) [AGF] by Fexists, h_line, SameSide_DEF; F IN ray A G DELETE A [FrAG] by -, IntervalRayEZ; consider v such that Line v /\ A IN v /\ F IN v /\ G IN v [v_line] by notAF, I1, AGF, BetweenLinear; ~(v = h) /\ v INTER h = {G} [vhG] by -, notAh, NOTIN, h_line, AGF, I1Uniqueness; D NOTIN v [notDv] proof assume ~(D NOTIN v); D IN v /\ D = G [DG] by h_line, -, NOTIN, vhG, IN_INTER, IN_SING; D IN open (A,F) by DG, AGF; angle E D A suppl angle E D F [EDAsuppl] by angEDA, -, SupplementaryAngles_DEF, AngleSymmetry; Right (angle E D A) by EDAsuppl, EDAeqEDF, RightAngle_DEF; Right (angle A E D) [RightAED] by angEDA, ANGLE, -, DEAeq, CongRightImpliesRight, AngleSymmetry; Right (angle D E F) by EDFncol, ANGLE, -, FEDcong, CongRightImpliesRight, AngleSymmetry; E IN open (A,F) by EADncol, EDFncol, RightAED, -, h_line, Fexists, OppositeRightAnglesLinear; E IN v /\ E = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; qed by -, DG, notDE; E NOTIN v [notEv] proof assume ~(E NOTIN v); E IN v /\ E = G [EG] by h_line, -, NOTIN, vhG, IN_INTER, IN_SING; E IN open (A,F) by -, AGF; angle D E A suppl angle D E F [DEAsuppl] by EADncol, -, SupplementaryAngles_DEF, AngleSymmetry; Right (angle D E A) [RightDEA] by DEAsuppl, EDAeqEDF, RightAngle_DEF; Right (angle E D A) [RightEDA] by angEDA, RightDEA, EDAeqEDF, CongRightImpliesRight; Right (angle E D F) by EDFncol, ANGLE, RightEDA, Fexists, CongRightImpliesRight; D IN open (A,F) by angEDA, EDFncol, RightEDA, AngleSymmetry, -, h_line, Fexists, OppositeRightAnglesLinear; D IN v /\ D = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; qed by -, EG, notDE; ~Collinear F A E /\ ~Collinear F A D /\ ~(F = E) [FAEncol] by v_line, notAF, I1, Collinear_DEF, notEv, notDv, NOTIN, NonCollinearImpliesDistinct; seg F E === seg A D [FEeqAD] by -, ErAC, ABD', SEGMENT, FEDcong, ErAC, C2Transitive; seg A D === seg F D by SegmentSymmetry, ABD', Fexists, SEGMENT, C2Symmetric; seg F E === seg F D by FAEncol, ABD', Fexists, SEGMENT, FEeqAD, -, C2Transitive; F,A,E cong F,A,D by FAEncol, FArefl, -, ErAC, SSS; angle F A E === angle F A D [FAEeq] by -, TriangleCong_DEF; angle D A F === angle F A E by FAEncol, ANGLE, FAEeq, C5Symmetric, AngleSymmetry; angle B A F === angle F A C [BAFeqFAC] by -, equalrays, Angle_DEF; ~(E,D same_side v) proof assume E,D same_side v; ray A D = ray A E by v_line, notAF, notDv, notEv, -, FAEeq, C4Uniqueness; qed by ABD', EndpointInRay, -, IN_Ray, EADncol; consider H such that H IN v /\ H IN open (E,D) [EHD] by v_line, -, SameSide_DEF; H = G by -, h_line, BetweenLinear, IN_INTER, vhG, IN_SING; G IN int_angle E A D [GintEAD] by EADncol, -, EHD, ConverseCrossbar; F IN int_angle E A D [FintEAD] by GintEAD, FrAG, WholeRayInterior; B IN ray A D DELETE A /\ C IN ray A E DELETE A by equalrays, Distinct, EndpointInRay, IN_DELETE; F IN int_angle B A C by FintEAD, -, InteriorWellDefined, InteriorAngleSymmetry; qed by -, BAFeqFAC; `;; let EuclidPropositionI_6 = thm `; let A B C be point; assume ~Collinear A B C [H1]; assume angle B A C === angle B C A [H2]; thus seg B A === seg B C proof ~(A = C) by H1, NonCollinearImpliesDistinct; seg C A === seg A C [CAeqAC] by SegmentSymmetry, -, SEGMENT, C2Reflexive; ~Collinear B C A /\ ~Collinear C B A /\ ~Collinear B A C [BCAncol] by H1, CollinearSymmetry; angle A C B === angle C A B by -, ANGLE, H2, C5Symmetric, AngleSymmetry; C,B,A cong A,B,C by H1, BCAncol, CAeqAC, H2, -, ASA; qed by -, TriangleCong_DEF; `;; let IsoscelesExists = thm `; let A B be point; assume ~(A = B) [H1]; thus ? D. ~Collinear A D B /\ seg D A === seg D B proof consider l such that Line l /\ A IN l /\ B IN l [l_line] by H1, I1; consider C such that C NOTIN l [notCl] by -, ExistsPointOffLine; ~Collinear C A B /\ ~Collinear C B A /\ ~Collinear A B C /\ ~Collinear A C B /\ ~Collinear B A C [CABncol] by l_line, H1, I1, Collinear_DEF, -, NOTIN; angle C A B === angle C B A \/ angle C A B <_ang angle C B A \/ angle C B A <_ang angle C A B by -, ANGLE, AngleTrichotomy; cases by -; suppose angle C A B === angle C B A; qed by -, CABncol, EuclidPropositionI_6; suppose angle C A B <_ang angle C B A; angle C A B <_ang angle A B C by -, AngleSymmetry; consider E such that E IN int_angle A B C /\ angle C A B === angle A B E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; ~(B = E) [notBE] by -, InteriorEZHelp; consider D such that D IN open (A,C) /\ D IN ray B E DELETE B [Dexists] by Eexists, Crossbar_THM; D IN int_angle A B C by Eexists, -, WholeRayInterior; ~Collinear A D B [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; ray B D = ray B E /\ ray A D = ray A C by notBE, Dexists, RayWellDefined, IntervalRay; angle D A B === angle A B D by Eexists, -, Angle_DEF; qed by ADBncol, -, AngleSymmetry, EuclidPropositionI_6; :: similar case suppose angle C B A <_ang angle C A B; angle C B A <_ang angle B A C by -, AngleSymmetry; consider E such that E IN int_angle B A C /\ angle C B A === angle B A E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; ~(A = E) [notAE] by -, InteriorEZHelp; consider D such that D IN open (B,C) /\ D IN ray A E DELETE A [Dexists] by Eexists, Crossbar_THM; D IN int_angle B A C by Eexists, -, WholeRayInterior; ~Collinear A D B /\ ~Collinear D A B /\ ~Collinear D B A [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; ray A D = ray A E /\ ray B D = ray B C by notAE, Dexists, RayWellDefined, IntervalRay; angle D B A === angle B A D by Eexists, -, Angle_DEF; angle D A B === angle D B A by AngleSymmetry, ADBncol, ANGLE, -, C5Symmetric; qed by ADBncol, -, EuclidPropositionI_6; end; `;; let MidpointExists = thm `; let A B be point; assume ~(A = B) [H1]; thus ? M. M IN open (A,B) /\ seg A M === seg M B proof consider D such that ~Collinear A D B /\ seg D A === seg D B [Dexists] by H1, IsoscelesExists; consider F such that F IN int_angle A D B /\ angle A D F === angle F D B [Fexists] by -, AngleBisector; ~(D = F) [notDF] by -, InteriorEZHelp; consider M such that M IN open (A,B) /\ M IN ray D F DELETE D [Mexists] by Fexists, Crossbar_THM; ray D M = ray D F by notDF, -, RayWellDefined; angle A D M === angle M D B [ADMeqMDB] by Fexists, -, Angle_DEF; M IN int_angle A D B by Fexists, Mexists, WholeRayInterior; ~(D = M) /\ ~Collinear A D M /\ ~Collinear B D M [ADMncol] by -, InteriorEZHelp, InteriorAngleSymmetry; seg D M === seg D M by -, SEGMENT, C2Reflexive; A,D,M cong B,D,M by ADMncol, Dexists, -, ADMeqMDB, AngleSymmetry, SAS; qed by Mexists, -, TriangleCong_DEF, SegmentSymmetry; `;; let EuclidPropositionI_7short = thm `; let A B C D be point; let a be point_set; assume ~(A = B) /\ Line a /\ A IN a /\ B IN a [a_line]; assume ~(C = D) /\ C NOTIN a /\ D NOTIN a /\ C,D same_side a [Csim_aD]; assume seg A C === seg A D [ACeqAD]; thus ~(seg B C === seg B D) proof ~(A = C) /\ ~(A = D) [AnotCD] by a_line, Csim_aD, NOTIN; assume seg B C === seg B D; seg C B === seg D B /\ seg A B === seg A B /\ seg A D === seg A D [segeqs] by -, SegmentSymmetry, a_line, AnotCD, SEGMENT, C2Reflexive; ~Collinear A C B /\ ~Collinear A D B by a_line, I1, Csim_aD, Collinear_DEF, NOTIN; A,C,B cong A,D,B by -, ACeqAD, segeqs, SSS; angle B A C === angle B A D by -, TriangleCong_DEF; ray A D = ray A C by a_line, Csim_aD, -, C4Uniqueness; C IN ray A D DELETE A /\ D IN ray A D DELETE A by AnotCD, -, EndpointInRay, IN_DELETE; C = D by AnotCD, SEGMENT, -, ACeqAD, segeqs, C1; qed by -, Csim_aD; `;; let EuclidPropositionI_7Help = thm `; let A B C D be point; let a be point_set; assume ~(A = B) [notAB]; assume Line a /\ A IN a /\ B IN a [a_line]; assume ~(C = D) /\ C NOTIN a /\ D NOTIN a /\ C,D same_side a [Csim_aD]; assume seg A C === seg A D [ACeqAD]; assume C IN int_triangle D A B \/ ConvexQuadrilateral A B C D [Int_ConvQuad]; thus ~(seg B C === seg B D) proof ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) [Distinct] by a_line, Csim_aD, NOTIN, SameSide_DEF; cases by Int_ConvQuad; suppose ConvexQuadrilateral A B C D; A IN int_angle B C D /\ B IN int_angle C D A /\ Tetralateral A B C D [ABint] by -, ConvexQuad_DEF, Quadrilateral_DEF; ~Collinear B C D /\ ~Collinear D C B /\ ~Collinear C B D /\ ~Collinear C D A /\ ~Collinear D A C /\ Angle (angle D C A) /\ Angle (angle C D B) [angCDB] by -, Tetralateral_DEF, CollinearSymmetry, ANGLE; angle C D A === angle D C A [CDAeqDCA] by angCDB, Distinct, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; A IN int_angle D C B /\ angle D C A === angle D C A /\ angle C D B === angle C D B by ABint, InteriorAngleSymmetry, angCDB, ANGLE, C5Reflexive; angle D C A <_ang angle D C B /\ angle C D B <_ang angle C D A by angCDB, ABint, -, AngleOrdering_DEF; angle C D B <_ang angle D C B by -, angCDB, CDAeqDCA, AngleTrichotomy2, AngleOrderTransitivity; ~(angle D C B === angle C D B) by -, AngleTrichotomy1, angCDB, ANGLE, C5Symmetric; qed by angCDB, -, IsoscelesCongBaseAngles; suppose C IN int_triangle D A B; C IN int_angle A D B /\ C IN int_angle D A B [CintADB] by -, IN_InteriorTriangle, InteriorAngleSymmetry; ~Collinear A D C /\ ~Collinear B D C [ADCncol] by CintADB, InteriorEZHelp, InteriorAngleSymmetry; ~Collinear D A C /\ ~Collinear C D A /\ ~Collinear A C D /\ ~Collinear A D C [DACncol] by -, CollinearSymmetry; ~Collinear B C D /\ Angle (angle D C A) /\ Angle (angle C D B) /\ ~Collinear D C B [angCDB] by ADCncol, -, CollinearSymmetry, ANGLE; angle C D A === angle D C A [CDAeqDCA] by DACncol, Distinct, ADCncol, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; consider E such that D IN open (A,E) /\ ~(D = E) /\ Collinear A D E [ADE] by Distinct, B2', B1'; B IN int_angle C D E /\ Collinear D A E [BintCDE] by CintADB, -, InteriorReflectionInterior, CollinearSymmetry; ~Collinear C D E [CDEncol] by DACncol, -, ADE, NoncollinearityExtendsToLine; consider F such that F IN open (B,D) /\ F IN ray A C DELETE A [Fexists] by CintADB, Crossbar_THM, B1'; F IN int_angle B C D [FintBCD] by ADCncol, CollinearSymmetry, -, ConverseCrossbar; ~Collinear D C F [DCFncol] by Distinct, ADCncol, CollinearSymmetry, Fexists, B1', NoncollinearityExtendsToLine; Collinear A C F /\ F IN ray D B DELETE D /\ C IN int_angle A D F by Fexists, IN_DELETE, IN_Ray, B1', IntervalRayEZ, CintADB, InteriorWellDefined; C IN open (A,F) by -, AlternateConverseCrossbar; angle A D C suppl angle C D E /\ angle A C D suppl angle D C F by ADE, DACncol, -, SupplementaryAngles_DEF; angle C D E === angle D C F [CDEeqDCF] by -, CDAeqDCA, AngleSymmetry, SupplementsCongAnglesCong; angle C D B <_ang angle C D E by angCDB, CDEncol, BintCDE, C5Reflexive, AngleOrdering_DEF; angle C D B <_ang angle D C F [CDBlessDCF] by -, DCFncol, ANGLE, CDEeqDCF, AngleTrichotomy2; angle D C F <_ang angle D C B by DCFncol, ANGLE, angCDB, FintBCD, InteriorAngleSymmetry, C5Reflexive, AngleOrdering_DEF; angle C D B <_ang angle D C B by CDBlessDCF, -, AngleOrderTransitivity; ~(angle D C B === angle C D B) by -, AngleTrichotomy1, angCDB, CollinearSymmetry, ANGLE, C5Symmetric; qed by Distinct, ADCncol, CollinearSymmetry, -, IsoscelesCongBaseAngles; end; `;; let EuclidPropositionI_7 = thm `; let A B C D be point; let a be point_set; assume ~(A = B) [notAB]; assume Line a /\ A IN a /\ B IN a [a_line]; assume ~(C = D) /\ C NOTIN a /\ D NOTIN a /\ C,D same_side a [Csim_aD]; assume seg A C === seg A D [ACeqAD]; thus ~(seg B C === seg B D) proof ~Collinear A B C /\ ~Collinear D A B [ABCncol] by a_line, notAB, I1, Collinear_DEF, Csim_aD, NOTIN; ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ A NOTIN open (C,D) [Distinct] by a_line, Csim_aD, NOTIN, SameSide_DEF; ~Collinear A D C [ADCncol] proof assume Collinear A D C; C IN ray A D DELETE A /\ D IN ray A D DELETE A by Distinct, -, IN_Ray, EndpointInRay, IN_DELETE; qed by Distinct, SEGMENT, -, ACeqAD, C2Reflexive, C1, Csim_aD; D,C same_side a [Dsim_aC] by a_line, Csim_aD, SameSideSymmetric; seg A D === seg A C /\ seg B D === seg B D [ADeqAC] by Distinct, SEGMENT, ACeqAD, C2Symmetric, C2Reflexive; ~Collinear D A C /\ ~Collinear C D A /\ ~Collinear A C D /\ ~Collinear A D C [DACncol] by ADCncol, CollinearSymmetry; ~(seg B D === seg B C) ==> ~(seg B C === seg B D) [BswitchDC] by Distinct, SEGMENT, C2Symmetric; cases; suppose Collinear B D C; B NOTIN open (C,D) /\ C IN ray B D DELETE B /\ D IN ray B D DELETE B by a_line, Csim_aD, SameSide_DEF, NOTIN, Distinct, -, IN_Ray, Distinct, IN_DELETE, EndpointInRay; qed by Distinct, SEGMENT, -, ACeqAD, ADeqAC, C1, Csim_aD; suppose ~Collinear B D C [BDCncol]; Tetralateral A B C D by notAB, Distinct, Csim_aD, ABCncol, -, CollinearSymmetry, DACncol, Tetralateral_DEF; ConvexQuadrilateral A B C D \/ C IN int_triangle D A B \/ ConvexQuadrilateral A B D C \/ D IN int_triangle C A B by -, a_line, Csim_aD, FourChoicesTetralateral, InteriorTriangleSymmetry; qed by notAB, a_line, Csim_aD, Dsim_aC, ACeqAD, ADeqAC, -, EuclidPropositionI_7Help, BswitchDC; end; `;; let EuclidPropositionI_11 = thm `; let A B be point; assume ~(A = B) [notAB]; thus ? F. Right (angle A B F) proof consider C such that B IN open (A,C) /\ seg B C === seg B A [ABC] by notAB, SEGMENT, C1OppositeRay; ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C [Distinct] by ABC, B1'; seg B A === seg B C [BAeqBC] by -, SEGMENT, ABC, C2Symmetric; consider F such that ~Collinear A F C /\ seg F A === seg F C [Fexists] by Distinct, IsoscelesExists; ~Collinear B F A /\ ~Collinear B F C [BFAncol] by -, CollinearSymmetry, Distinct, NoncollinearityExtendsToLine; ~Collinear A B F /\ Angle (angle A B F) [angABF] by BFAncol, CollinearSymmetry, ANGLE; angle A B F suppl angle F B C [ABFsuppl] by -, ABC, SupplementaryAngles_DEF; ~(B = F) /\ seg B F === seg B F by BFAncol, NonCollinearImpliesDistinct, SEGMENT, C2Reflexive; B,F,A cong B,F,C by BFAncol, -, BAeqBC, Fexists, SSS; angle A B F === angle F B C by -, TriangleCong_DEF, AngleSymmetry; qed by angABF, ABFsuppl, -, RightAngle_DEF; `;; let DropPerpendicularToLine = thm `; let P be point; let l be point_set; assume Line l /\ P NOTIN l [l_line]; thus ? E Q. E IN l /\ Q IN l /\ Right (angle P Q E) proof consider A B such that A IN l /\ B IN l /\ ~(A = B) [ABl] by l_line, I2; ~Collinear B A P /\ ~Collinear P A B /\ ~(A = P) [BAPncol] by l_line, ABl, I1, Collinear_DEF, NOTIN, CollinearSymmetry, ABl, NOTIN; Angle (angle B A P) /\ Angle (angle P A B) [angBAP] by -, ANGLE, AngleSymmetry; consider P' such that ~(A = P') /\ P' NOTIN l /\ ~(P,P' same_side l) /\ seg A P' === seg A P /\ angle B A P' === angle B A P [P'exists] by angBAP, ABl, BAPncol, l_line, C4OppositeSide; consider Q such that Q IN l /\ Q IN open (P,P') /\ Collinear A B Q [Qexists] by l_line, -, SameSide_DEF, ABl, Collinear_DEF; ~Collinear B A P' [BAP'ncol] by l_line, ABl, I1, Collinear_DEF, P'exists, NOTIN; angle B A P === angle B A P' [BAPeqBAP'] by -, ANGLE, angBAP, P'exists, C5Symmetric; ? E. E IN l /\ ~Collinear P Q E /\ angle P Q E === angle E Q P' proof cases; suppose A = Q [AQ]; qed by ABl, AQ, BAPncol, BAPeqBAP', AngleSymmetry; suppose ~(A = Q) [notAQ]; seg A Q === seg A Q /\ seg A P === seg A P' [APeqAP'] by -, SEGMENT, C2Reflexive, BAPncol, P'exists, C2Symmetric; ~Collinear Q A P' /\ ~Collinear Q A P [QAP'ncol] by l_line, ABl, Qexists, notAQ, I1, Collinear_DEF, P'exists, NOTIN; angle Q A P === angle Q A P' proof cases; suppose A IN open (Q,B); angle B A P suppl angle P A Q /\ angle B A P' suppl angle P' A Q by BAPncol, BAP'ncol, -, B1', SupplementaryAngles_DEF; qed by -, BAPeqBAP', SupplementsCongAnglesCong, AngleSymmetry; suppose ~(A IN open (Q,B)); A NOTIN open (Q,B) /\ Q IN ray A B DELETE A /\ ray A Q = ray A B by -, NOTIN, ABl, Qexists, IN_Ray, notAQ, IN_DELETE, ABl, RayWellDefined; qed by -, BAPeqBAP', Angle_DEF; end; Q,A,P cong Q,A,P' by QAP'ncol, APeqAP', -, SAS; qed by -, TriangleCong_DEF, AngleSymmetry, ABl, QAP'ncol, CollinearSymmetry; end; consider E such that E IN l /\ ~Collinear P Q E /\ angle P Q E === angle E Q P' [Eexists] by -; angle P Q E suppl angle E Q P' /\ Right (angle P Q E) by -, Qexists, SupplementaryAngles_DEF, RightAngle_DEF; qed by Eexists, Qexists, -; `;; let EuclidPropositionI_14 = thm `; let A B C D be point; let l be point_set; assume Line l /\ A IN l /\ B IN l /\ ~(A = B) [l_line]; assume C NOTIN l /\ D NOTIN l /\ ~(C,D same_side l) [Cnsim_lD]; assume angle C B A suppl angle A B D [CBAsupplABD]; thus B IN open (C,D) proof ~(B = C) /\ ~(B = D) /\ ~Collinear C B A [Distinct] by l_line, Cnsim_lD, NOTIN, I1, Collinear_DEF; consider E such that B IN open (C,E) [CBE] by Distinct, B2'; E NOTIN l /\ ~(C,E same_side l) [Csim_lE] by l_line, NOTIN, -, BetweenLinear, Cnsim_lD, SameSide_DEF; D,E same_side l [Dsim_lE] by l_line, Cnsim_lD, -, AtMost2Sides; angle C B A suppl angle A B E by Distinct, CBE, SupplementaryAngles_DEF; angle A B D === angle A B E by CBAsupplABD, -, SupplementUnique; ray B E = ray B D by l_line, Csim_lE, Cnsim_lD, Dsim_lE, -, C4Uniqueness; D IN ray B E DELETE B by Distinct, -, EndpointInRay, IN_DELETE; qed by CBE, -, OppositeRaysIntersect1pointHelp, B1'; `;; let VerticalAnglesCong = thm `; :: Euclid's Proposition I.15 let A B O A' B' be point; assume ~Collinear A O B [H1]; assume O IN open (A,A') /\ O IN open (B,B') [H2]; thus angle B O A' === angle B' O A proof angle A O B suppl angle B O A' [AOBsupplBOA'] by H1, H2, SupplementaryAngles_DEF; angle B O A suppl angle A O B' by H1, CollinearSymmetry, H2, SupplementaryAngles_DEF; qed by AOBsupplBOA', -, AngleSymmetry, SupplementUnique; `;; let EuclidPropositionI_16 = thm `; let A B C D be point; assume ~Collinear A B C [H1]; assume C IN open (B,D) [H2]; thus angle B A C <_ang angle D C A proof ~(A = B) /\ ~(A = C) /\ ~(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; consider l such that Line l /\ A IN l /\ C IN l [l_line] by Distinct, I1; consider m such that Line m /\ B IN m /\ C IN m [m_line] by Distinct, I1; D IN m [Dm] by m_line, H2, BetweenLinear; consider E such that E IN open (A,C) /\ seg A E === seg E C [AEC] by Distinct, MidpointExists; ~(A = E) /\ ~(E = C) /\ Collinear A E C /\ ~(B = E) [AECcol] by -, B1', H1; E IN l [El] by l_line, AEC, BetweenLinear; consider F such that E IN open (B,F) /\ seg E F === seg E B [BEF] by AECcol, SEGMENT, C1OppositeRay; ~(B = E) /\ ~(B = F) /\ ~(E = F) /\ Collinear B E F [BEF'] by BEF, B1'; B NOTIN l [notBl] by l_line, Distinct, I1, Collinear_DEF, H1, NOTIN; ~Collinear A E B /\ ~Collinear C E B [AEBncol] by l_line, El, AECcol, I1, Collinear_DEF, notBl, NOTIN; Angle (angle B A E) [angBAE] by -, CollinearSymmetry, ANGLE; ~Collinear C E F [CEFncol] by AEBncol, BEF', CollinearSymmetry, NoncollinearityExtendsToLine; angle B E A === angle F E C [BEAeqFEC] by AEBncol, AEC, B1', BEF, VerticalAnglesCong; seg E A === seg E C /\ seg E B === seg E F by AEC, SegmentSymmetry, AECcol, BEF', SEGMENT, BEF, C2Symmetric; A,E,B cong C,E,F by AEBncol, CEFncol, -, BEAeqFEC, AngleSymmetry, SAS; angle B A E === angle F C E [BAEeqFCE] by -, TriangleCong_DEF; ~Collinear E C D [ECDncol] by AEBncol, H2, B1', CollinearSymmetry, NoncollinearityExtendsToLine; F NOTIN l /\ D NOTIN l [notFl] by l_line, El, Collinear_DEF, CEFncol, -, NOTIN; F IN ray B E DELETE B /\ E NOTIN m by BEF, IntervalRayEZ, m_line, Collinear_DEF, AEBncol, NOTIN; F NOTIN m /\ F,E same_side m [Fsim_mE] by m_line, -, RaySameSide; ~(B,F same_side l) /\ ~(B,D same_side l) by El, l_line, BEF, H2, SameSide_DEF; F,D same_side l by l_line, notBl, notFl, -, AtMost2Sides; F IN int_angle E C D by ECDncol, l_line, El, m_line, Dm, notFl, Fsim_mE, -, IN_InteriorAngle; angle B A E <_ang angle E C D [BAElessECD] by angBAE, ECDncol, -, BAEeqFCE, AngleSymmetry, AngleOrdering_DEF; ray A E = ray A C /\ ray C E = ray C A by AEC, B1', IntervalRay; angle B A C <_ang angle A C D by BAElessECD, -, Angle_DEF; qed by -, AngleSymmetry; `;; let ExteriorAngle = thm `; let A B C D be point; assume ~Collinear A B C [H1]; assume C IN open (B,D) [H2]; thus angle A B C <_ang angle A C D proof ~(C = D) /\ C IN open (D,B) /\ Collinear B C D [H2'] by H2, BetweenLinear, B1'; ~Collinear B A C /\ ~(A = C) [BACncol] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; consider E such that C IN open (A,E) [ACE] by -, B2'; ~(C = E) /\ C IN open (E,A) /\ Collinear A C E [ACE'] by -, B1'; ~Collinear A C D /\ ~Collinear D C E [DCEncol] by H1, CollinearSymmetry, H2', -, NoncollinearityExtendsToLine; angle A B C <_ang angle E C B [ABClessECB] by BACncol, ACE, EuclidPropositionI_16; angle E C B === angle A C D by DCEncol, ACE', H2', VerticalAnglesCong; qed by ABClessECB, DCEncol, ANGLE, -, AngleTrichotomy2; `;; let EuclidPropositionI_17 = thm `; let A B C be point; let alpha beta gamma be point_set; assume ~Collinear A B C /\ alpha = angle A B C /\ beta = angle B C A [H1]; assume beta suppl gamma [H2]; thus alpha <_ang gamma proof Angle gamma [anggamma] by H2, SupplementImpliesAngle; ~(A = B) /\ ~(A = C) /\ ~(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; ~Collinear B A C /\ ~Collinear A C B [BACncol] by H1, CollinearSymmetry; consider D such that C IN open (A,D) [ACD] by Distinct, B2'; angle A B C <_ang angle D C B [ABClessDCB] by BACncol, ACD, EuclidPropositionI_16; beta suppl angle B C D by -, H1, AngleSymmetry, BACncol, ACD, SupplementaryAngles_DEF; angle B C D === gamma by H2, -, SupplementUnique; qed by ABClessDCB, H1, AngleSymmetry, anggamma, -, AngleTrichotomy2; `;; let EuclidPropositionI_18 = thm `; let A B C be point; assume ~Collinear A B C [H1]; assume seg A C <__ seg A B [H2]; thus angle A B C <_ang angle B C A proof ~(A = B) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; consider D such that D IN open (A,B) /\ seg A C === seg A D [ADB] by Distinct, SEGMENT, H2, SegmentOrderingUse; ~(D = A) /\ ~(D = B) /\ D IN open (B,A) /\ Collinear A D B /\ ray B D = ray B A [ADB'] by -, B1', IntervalRay; D IN int_angle A C B [DintACB] by H1, CollinearSymmetry, ADB, ConverseCrossbar; ~Collinear D A C /\ ~Collinear C B D [DACncol] by H1, CollinearSymmetry, ADB', NoncollinearityExtendsToLine; seg A D === seg A C by ADB', Distinct, SEGMENT, ADB, C2Symmetric; angle C D A === angle A C D by DACncol, -, IsoscelesCongBaseAngles, AngleSymmetry; angle C D A <_ang angle A C B [CDAlessACB] by DACncol, CollinearSymmetry, ANGLE, H1, CollinearSymmetry, DintACB, -, AngleOrdering_DEF; angle B D C suppl angle C D A by DACncol, CollinearSymmetry, ADB', SupplementaryAngles_DEF; angle C B D <_ang angle C D A by DACncol, -, EuclidPropositionI_17; angle C B D <_ang angle A C B by -, CDAlessACB, AngleOrderTransitivity; qed by -, ADB', Angle_DEF, AngleSymmetry; `;; let EuclidPropositionI_19 = thm `; let A B C be point; assume ~Collinear A B C [H1]; assume angle A B C <_ang angle B C A [H2]; thus seg A C <__ seg A B proof ~Collinear B A C /\ ~Collinear B C A /\ ~Collinear A C B [BACncol] by H1, CollinearSymmetry; ~(A = B) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; assume ~(seg A C <__ seg A B); seg A B === seg A C \/ seg A B <__ seg A C by Distinct, SEGMENT, -, SegmentTrichotomy; cases by -; suppose seg A B === seg A C; angle C B A === angle B C A by BACncol, -, IsoscelesCongBaseAngles; qed by -, AngleSymmetry, H2, AngleTrichotomy1; suppose seg A B <__ seg A C; angle A C B <_ang angle C B A by BACncol, -, EuclidPropositionI_18; qed by H1, BACncol, ANGLE, -, AngleSymmetry, H2, AngleTrichotomy; end; `;; let EuclidPropositionI_20 = thm `; let A B C D be point; assume ~Collinear A B C [H1]; assume A IN open (B,D) /\ seg A D === seg A C [H2]; thus seg B C <__ seg B D proof ~(B = D) /\ ~(A = D) /\ A IN open (D,B) /\ Collinear B A D /\ ray D A = ray D B [BAD'] by H2, B1', IntervalRay; ~Collinear C A D [CADncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; ~Collinear D C B /\ ~Collinear B D C [DCBncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; :: 13 Angle (angle C D A) [angCDA] by CADncol, CollinearSymmetry, ANGLE; angle C D A === angle D C A [CDAeqDCA] by CADncol, CollinearSymmetry, H2, IsoscelesCongBaseAngles; A IN int_angle D C B by DCBncol, BAD', ConverseCrossbar; angle C D A <_ang angle D C B by angCDA, DCBncol, -, CDAeqDCA, AngleOrdering_DEF; angle B D C <_ang angle D C B by -, BAD', Angle_DEF, AngleSymmetry; qed by DCBncol, -, EuclidPropositionI_19; `;; let EuclidPropositionI_21 = thm `; let A B C D be point; assume ~Collinear A B C [H1]; assume D IN int_triangle A B C [H2]; thus angle A B C <_ang angle C D A proof ~(B = A) /\ ~(B = C) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; D IN int_angle B A C /\ D IN int_angle C B A [DintTri] by H2, IN_InteriorTriangle, InteriorAngleSymmetry; consider E such that E IN open (B,C) /\ E IN ray A D DELETE A [BEC] by -, Crossbar_THM; ~(B = E) /\ ~(E = C) /\ Collinear B E C /\ Collinear A D E [BEC'] by -, B1', IN_DELETE, IN_Ray; ray B E = ray B C /\ E IN ray B C DELETE B [rBErBC] by BEC, IntervalRay, IntervalRayEZ; D IN int_angle A B E [DintABE] by DintTri, -, InteriorAngleSymmetry, InteriorWellDefined; D IN open (A,E) [ADE] by BEC', -, AlternateConverseCrossbar; ray E D = ray E A [rEDrEA] by -, B1', IntervalRay; ~Collinear A B E /\ ~Collinear B E A /\ ~Collinear C B D /\ ~(A = D) [ABEncol] by DintABE, IN_InteriorAngle, CollinearSymmetry, DintTri, InteriorEZHelp; ~Collinear E D C /\ ~Collinear C E D [EDCncol] by -, CollinearSymmetry, BEC', NoncollinearityExtendsToLine; angle A B E <_ang angle A E C by ABEncol, BEC, ExteriorAngle; angle A B C <_ang angle C E D [ABClessAEC] by -, rBErBC, rEDrEA, Angle_DEF, AngleSymmetry; angle C E D <_ang angle C D A by EDCncol, ADE, B1', ExteriorAngle; qed by ABClessAEC, -, AngleOrderTransitivity; `;; let AngleTrichotomy3 = thm `; let alpha beta gamma be point_set; assume alpha <_ang beta /\ Angle gamma /\ gamma === alpha [H1]; thus gamma <_ang beta proof consider A O B G such that Angle alpha /\ ~Collinear A O B /\ beta = angle A O B /\ G IN int_angle A O B /\ alpha === angle A O G [H1'] by H1, AngleOrdering_DEF; ~Collinear A O G by -, InteriorEZHelp; gamma === angle A O G by H1, H1', -, ANGLE, C5Transitive; qed by H1, H1', -, AngleOrdering_DEF; `;; let InteriorCircleConvexHelp = thm `; let O A B C be point; assume ~Collinear A O C [H1]; assume B IN open (A,C) [H2]; assume seg O A <__ seg O C \/ seg O A === seg O C [H3]; thus seg O B <__ seg O C proof ~Collinear O C A /\ ~Collinear C O A /\ ~(O = A) /\ ~(O = C) [H1'] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; ray A B = ray A C /\ ray C B = ray C A [equal_rays] by H2, IntervalRay, B1'; angle O C A <_ang angle C A O \/ angle O C A === angle C A O proof cases by H3; suppose seg O A <__ seg O C; qed by H1', -, EuclidPropositionI_18; suppose seg O A === seg O C [seg_eq]; seg O C === seg O A by H1', SEGMENT, -, C2Symmetric; qed by H1', -, IsoscelesCongBaseAngles, AngleSymmetry; end; angle O C B <_ang angle B A O \/ angle O C B === angle B A O by -, equal_rays, Angle_DEF; angle B C O <_ang angle O A B \/ angle B C O === angle O A B [BCOlessOAB] by -, AngleSymmetry; ~Collinear O A B /\ ~Collinear B C O /\ ~Collinear O C B [OABncol] by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; angle O A B <_ang angle O B C by -, H2, ExteriorAngle; angle B C O <_ang angle O B C by BCOlessOAB, -, AngleOrderTransitivity, OABncol, ANGLE, -, AngleTrichotomy3; qed by OABncol, -, AngleSymmetry, EuclidPropositionI_19; `;; let InteriorCircleConvex = thm `; let O R A B C be point; assume ~(O = R) [H1]; assume B IN open (A,C) [H2]; assume A IN int_circle O R /\ C IN int_circle O R [H3]; thus B IN int_circle O R proof ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ B IN open (C,A) [H2'] by H2, B1'; (A = O \/ seg O A <__ seg O R) /\ (C = O \/ seg O C <__ seg O R) [ACintOR] by H3, H1, IN_InteriorCircle; cases; suppose O = A \/ O = C; B IN open (O,C) \/ B IN open (O,A) by -, H2, B1'; seg O B <__ seg O A /\ ~(O = A) \/ seg O B <__ seg O C /\ ~(O = C) by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; seg O B <__ seg O R by -, ACintOR, SegmentOrderTransitivity; qed by -, H1, IN_InteriorCircle; suppose ~(O = A) /\ ~(O = C) [OnotAC]; cases; suppose ~Collinear A O C [AOCncol]; seg O A <__ seg O C \/ seg O A === seg O C \/ seg O C <__ seg O A by OnotAC, SEGMENT, SegmentTrichotomy; seg O B <__ seg O C \/ seg O B <__ seg O A by AOCncol, H2, -, InteriorCircleConvexHelp, CollinearSymmetry, B1'; qed by OnotAC, ACintOR, -, SegmentOrderTransitivity, H1, IN_InteriorCircle; suppose Collinear A O C [AOCcol]; consider l such that Line l /\ A IN l /\ C IN l by H2', I1; Collinear B A O /\ Collinear B C O [OABCcol] by -, H2, BetweenLinear, H2', AOCcol, CollinearLinear, Collinear_DEF; B NOTIN open (O,A) /\ B NOTIN open (O,C) ==> B = O proof assume B NOTIN open (O,A) /\ B NOTIN open (O,C); O IN ray B A INTER ray B C by H2', OABCcol, -, IN_Ray, IN_INTER; qed by -, H2, OppositeRaysIntersect1point, IN_SING; B IN open (O,A) \/ B IN open (O,C) \/ B = O by -, NOTIN; seg O B <__ seg O A \/ seg O B <__ seg O C \/ B = O by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; seg O B <__ seg O R \/ B = O by -, ACintOR, OnotAC, SegmentOrderTransitivity; qed by -, H1, IN_InteriorCircle; end; end; `;; let SegmentTrichotomy3 = thm `; let s t u be point_set; assume s <__ t /\ Segment u /\ u === s [H1]; thus u <__ t proof consider C D X such that Segment s /\ t = seg C D /\ X IN open (C,D) /\ s === seg C X /\ ~(C = X) [H1'] by H1, SegmentOrdering_DEF, B1'; u === seg C X by H1, -, SEGMENT, C2Transitive; qed by H1, H1', -, SegmentOrdering_DEF; `;; let EuclidPropositionI_24Help = thm `; let O A C O' D F be point; assume ~Collinear A O C /\ ~Collinear D O' F [H1]; assume seg O' D === seg O A /\ seg O' F === seg O C [H2]; assume angle D O' F <_ang angle A O C [H3]; assume seg O A <__ seg O C \/ seg O A === seg O C [H4]; thus seg D F <__ seg A C proof consider K such that K IN int_angle A O C /\ angle D O' F === angle A O K [KintAOC] by H1, ANGLE, H3, AngleOrderingUse; ~(O = C) /\ ~(D = F) /\ ~(O' = F) /\ ~(O = K) [Distinct] by H1, NonCollinearImpliesDistinct, -, InteriorEZHelp; consider B such that B IN ray O K DELETE O /\ seg O B === seg O C [BrOK] by Distinct, SEGMENT, -, C1; ray O B = ray O K by Distinct, -, RayWellDefined; angle D O' F === angle A O B [DO'FeqAOB] by KintAOC, -, Angle_DEF; B IN int_angle A O C [BintAOC] by KintAOC, BrOK, WholeRayInterior; ~(B = O) /\ ~Collinear A O B [AOBncol] by -, InteriorEZHelp; seg O C === seg O B [OCeqOB] by Distinct, -, SEGMENT, BrOK, C2Symmetric; seg O' F === seg O B by Distinct, SEGMENT, AOBncol, H2, -, C2Transitive; D,O',F cong A,O,B by H1, AOBncol, H2, -, DO'FeqAOB, SAS; seg D F === seg A B [DFeqAB] by -, TriangleCong_DEF; consider G such that G IN open (A,C) /\ G IN ray O B DELETE O /\ ~(G = O) [AGC] by BintAOC, Crossbar_THM, B1', IN_DELETE; Segment (seg O G) /\ ~(O = B) [notOB] by AGC, SEGMENT, BrOK, IN_DELETE; seg O G <__ seg O C by H1, AGC, H4, InteriorCircleConvexHelp; seg O G <__ seg O B by -, OCeqOB, BrOK, IN_DELETE, SEGMENT, SegmentTrichotomy2; consider G' such that G' IN open (O,B) /\ seg O G === seg O G' [OG'B] by notOB, -, SegmentOrderingUse; ~(G' = O) /\ seg O G' === seg O G' /\ Segment (seg O G') [notG'O] by -, B1', SEGMENT, C2Reflexive, SEGMENT; G' IN ray O B DELETE O by OG'B, IntervalRayEZ; G' = G /\ G IN open (B,O) by notG'O, notOB, -, AGC, OG'B, C1, B1'; ConvexQuadrilateral B A O C by H1, -, AGC, DiagonalsIntersectImpliesConvexQuad; A IN int_angle O C B /\ O IN int_angle C B A /\ Quadrilateral B A O C [OintCBA] by -, ConvexQuad_DEF; A IN int_angle B C O [AintBCO] by -, InteriorAngleSymmetry; Tetralateral B A O C by OintCBA, Quadrilateral_DEF; ~Collinear C B A /\ ~Collinear B C O /\ ~Collinear C O B /\ ~Collinear C B O [BCOncol] by -, Tetralateral_DEF, CollinearSymmetry; angle B C O === angle C B O [BCOeqCBO] by -, OCeqOB, IsoscelesCongBaseAngles; ~Collinear B C A /\ ~Collinear A C B [ACBncol] by AintBCO, InteriorEZHelp, CollinearSymmetry; angle B C A === angle B C A /\ Angle (angle B C A) /\ angle C B O === angle C B O [CBOref] by -, ANGLE, BCOncol, C5Reflexive; angle B C A <_ang angle B C O by -, BCOncol, ANGLE, AintBCO, AngleOrdering_DEF; angle B C A <_ang angle C B O [BCAlessCBO] by -, BCOncol, ANGLE, BCOeqCBO, AngleTrichotomy2; angle C B O <_ang angle C B A by BCOncol, ANGLE, OintCBA, CBOref, AngleOrdering_DEF; angle A C B <_ang angle C B A by BCAlessCBO, -, AngleOrderTransitivity, AngleSymmetry; seg A B <__ seg A C by ACBncol, -, EuclidPropositionI_19; qed by -, Distinct, SEGMENT, DFeqAB, SegmentTrichotomy3; `;; let EuclidPropositionI_24 = thm `; let O A C O' D F be point; assume ~Collinear A O C /\ ~Collinear D O' F [H1]; assume seg O' D === seg O A /\ seg O' F === seg O C [H2]; assume angle D O' F <_ang angle A O C [H3]; thus seg D F <__ seg A C proof ~(O = A) /\ ~(O = C) /\ ~Collinear C O A /\ ~Collinear F O' D [Distinct] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; seg O A === seg O C \/ seg O A <__ seg O C \/ seg O C <__ seg O A by -, SEGMENT, SegmentTrichotomy; cases by -; suppose seg O A <__ seg O C \/ seg O A === seg O C; qed by H1, H2, H3, -, EuclidPropositionI_24Help; suppose seg O C <__ seg O A [H4]; angle F O' D <_ang angle C O A by H3, AngleSymmetry; qed by Distinct, H3, AngleSymmetry, H2, H4, EuclidPropositionI_24Help, SegmentSymmetry; end; `;; let EuclidPropositionI_25 = thm `; let O A C O' D F be point; assume ~Collinear A O C /\ ~Collinear D O' F [H1]; assume seg O' D === seg O A /\ seg O' F === seg O C [H2]; assume seg D F <__ seg A C [H3]; thus angle D O' F <_ang angle A O C proof ~(O = A) /\ ~(O = C) /\ ~(A = C) /\ ~(D = F) /\ ~(O' = D) /\ ~(O' = F) [Distinct] by H1, NonCollinearImpliesDistinct; assume ~(angle D O' F <_ang angle A O C); angle D O' F === angle A O C \/ angle A O C <_ang angle D O' F by H1, ANGLE, -, AngleTrichotomy; cases by -; suppose angle D O' F === angle A O C; D,O',F cong A,O,C by H1, H2, -, SAS; seg D F === seg A C by -, TriangleCong_DEF; qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; suppose angle A O C <_ang angle D O' F [Con]; seg O A === seg O' D /\ seg O C === seg O' F [H2'] by Distinct, SEGMENT, H2, C2Symmetric; seg A C <__ seg D F by H1, -, Con, EuclidPropositionI_24; qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; end; `;; let AAS = thm `; let A B C A' B' C' be point; assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; assume angle A B C === angle A' B' C' /\ angle B C A === angle B' C' A' [H2]; assume seg A B === seg A' B' [H3]; thus A,B,C cong A',B',C' proof ~(A = B) /\ ~(B = C) /\ ~(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; consider G such that G IN ray B C DELETE B /\ seg B G === seg B' C' [Gexists] by Distinct, SEGMENT, C1; ~(G = B) /\ B NOTIN open (G,C) /\ Collinear G B C [notGBC] by -, IN_DELETE, IN_Ray, CollinearSymmetry; ~Collinear A B G /\ ~Collinear B G A [ABGncol] by H1, notGBC, CollinearSymmetry, NoncollinearityExtendsToLine; ray B G = ray B C by Distinct, Gexists, RayWellDefined; angle A B G = angle A B C by Distinct, -, Angle_DEF; A,B,G cong A',B',C' [ABGcongA'B'C'] by H1, ABGncol, H3, SegmentSymmetry, H2, -, Gexists, SAS; angle B G A === angle B' C' A' [BGAeqB'C'A'] by -, TriangleCong_DEF; ~Collinear B C A /\ ~Collinear B' C' A' [BCAncol] by H1, CollinearSymmetry; angle B' C' A' === angle B C A /\ angle B C A === angle B C A [BCArefl] by -, ANGLE, H2, C5Symmetric, C5Reflexive; angle B G A === angle B C A [BGAeqBCA] by ABGncol, BCAncol, ANGLE, BGAeqB'C'A', -, C5Transitive; cases; suppose G = C; qed by -, ABGcongA'B'C'; suppose ~(G = C) [notGC]; ~Collinear A C G /\ ~Collinear A G C [ACGncol] by H1, notGBC, -, CollinearSymmetry, NoncollinearityExtendsToLine; C IN open (B,G) \/ G IN open (C,B) by notGBC, notGC, Distinct, B3', NOTIN; cases by -; suppose C IN open (B,G) ; C IN open (G,B) /\ ray G C = ray G B [rGCrBG] by -, B1', IntervalRay; angle A G C <_ang angle A C B by ACGncol, -, ExteriorAngle; angle B G A <_ang angle B C A by -, rGCrBG, Angle_DEF, AngleSymmetry, AngleSymmetry; qed by ABGncol, BCAncol, ANGLE, -, AngleSymmetry, BGAeqBCA, AngleTrichotomy; suppose G IN open (C,B) [CGB]; ray C G = ray C B /\ angle A C G <_ang angle A G B by -, IntervalRay, ACGncol, ExteriorAngle; angle A C B <_ang angle B G A by -, Angle_DEF, AngleSymmetry; angle B C A <_ang angle B C A by -, BCAncol, ANGLE, BGAeqBCA, AngleTrichotomy2, AngleSymmetry; qed by -, BCArefl, AngleTrichotomy1; end; end; `;; let ParallelSymmetry = thm `; ! l k: point_set. l parallel k ==> k parallel l by PARALLEL, INTER_COMM; `;; let AlternateInteriorAngles = thm `; let A B C E be point; let l m t be point_set; assume Line l /\ A IN l /\ E IN l [l_line]; assume Line m /\ B IN m /\ C IN m [m_line]; assume Line t /\ A IN t /\ B IN t [t_line]; assume ~(A = E) /\ ~(B = C) /\ ~(A = B) /\ E NOTIN t /\ C NOTIN t [Distinct]; assume ~(C,E same_side t) [Cnsim_tE]; assume angle E A B === angle C B A [AltIntAngCong]; thus l parallel m proof ~Collinear E A B /\ ~Collinear C B A [EABncol] by t_line, Distinct, I1, Collinear_DEF, NOTIN; B NOTIN l /\ A NOTIN m [notAmBl] by l_line, m_line, Collinear_DEF, -, NOTIN; assume ~(l parallel m); ~(l INTER m = {}) by -, l_line, m_line, PARALLEL; consider G such that G IN l /\ G IN m [Glm] by -, MEMBER_NOT_EMPTY, IN_INTER; ~(G = A) /\ ~(G = B) /\ Collinear B G C /\ Collinear B C G /\ Collinear A E G /\ Collinear A G E [GnotAB] by -, notAmBl, NOTIN, m_line, l_line, Collinear_DEF; ~Collinear A G B /\ ~Collinear B G A /\ G NOTIN t [AGBncol] by EABncol, CollinearSymmetry, -, NoncollinearityExtendsToLine, t_line, Collinear_DEF, NOTIN; ~(E,C same_side t) [Ensim_tC] by t_line, -, Distinct, Cnsim_tE, SameSideSymmetric; C IN m DELETE B /\ G IN m DELETE B [CGm_B] by m_line, Glm, Distinct, GnotAB, IN_DELETE; E IN l DELETE A /\ G IN l DELETE A [EGm_A] by l_line, Glm, Distinct, GnotAB, IN_DELETE; ~(G,E same_side t) proof assume G,E same_side t [Gsim_tE]; A NOTIN open (G,E) [notGAE] by t_line, -, SameSide_DEF, NOTIN; G IN ray A E DELETE A by Distinct, GnotAB, notGAE, IN_Ray, GnotAB, IN_DELETE; ray A G = ray A E [rAGrAE] by Distinct, -, RayWellDefined; ~(C,G same_side t) by t_line, AGBncol, Distinct, Gsim_tE, Cnsim_tE, SameSideTransitive; C NOTIN ray B G /\ B IN open (C,G) by t_line, AGBncol, Distinct, -, RaySameSide, NOTIN, GnotAB, IN_DELETE, IN_Ray; angle G A B <_ang angle C B A by AGBncol, -, B1', EuclidPropositionI_16; angle E A B <_ang angle C B A by -, rAGrAE, Angle_DEF; qed by EABncol, ANGLE, AltIntAngCong, -, AngleTrichotomy1; G,C same_side t [Gsim_tC] by t_line, AGBncol, Distinct, -, Cnsim_tE, AtMost2Sides; :: now we make a symmetric argument B NOTIN open (G,C) [notGBC] by t_line, -, SameSide_DEF, NOTIN; G IN ray B C DELETE B by Distinct, GnotAB, notGBC, IN_Ray, GnotAB, IN_DELETE; ray B G = ray B C [rBGrBC] by Distinct, -, RayWellDefined; angle C B A === angle E A B [flipAltIntAngCong] by EABncol, ANGLE, AltIntAngCong, C5Symmetric; ~(E,G same_side t) by t_line, AGBncol, Distinct, Gsim_tC, Ensim_tC, SameSideTransitive; E NOTIN ray A G /\ A IN open (E,G) by t_line, AGBncol, Distinct, -, RaySameSide, NOTIN, GnotAB, IN_Ray, IN_DELETE; angle G B A <_ang angle E A B by AGBncol, -, B1', EuclidPropositionI_16; angle C B A <_ang angle E A B by -, rBGrBC, Angle_DEF; qed by EABncol, ANGLE, flipAltIntAngCong, -, AngleTrichotomy1; `;; let EuclidPropositionI_28 = thm `; let A B C D E F G H be point; let l m t be point_set; assume Line l /\ A IN l /\ B IN l /\ G IN l [l_line]; assume Line m /\ C IN m /\ D IN m /\ H IN m [m_line]; assume Line t /\ G IN t /\ H IN t [t_line]; assume G NOTIN m /\ H NOTIN l [notGmHl]; assume G IN open (A,B) /\ H IN open (C,D) [H1]; assume G IN open (E,H) /\ H IN open (F,G) [H2]; assume ~(D,A same_side t) [H3]; assume angle E G B === angle G H D \/ angle B G H suppl angle G H D [H4]; thus l parallel m proof ~(A = G) /\ ~(G = B) /\ ~(H = D) /\ ~(E = G) /\ ~(G = H) /\ Collinear A G B /\ Collinear E G H [Distinct] by H1, H2, B1'; ~Collinear H G A /\ ~Collinear G H D /\ A NOTIN t /\ D NOTIN t [HGAncol] by l_line, m_line, Distinct, I1, Collinear_DEF, notGmHl, NOTIN, t_line, Collinear_DEF; ~Collinear B G H /\ ~Collinear A G E /\ ~Collinear E G B [BGHncol] by -, Distinct, CollinearSymmetry, NoncollinearityExtendsToLine; angle A G H === angle D H G proof cases by H4; suppose angle E G B === angle G H D [EGBeqGHD]; angle E G B === angle H G A by BGHncol, H1, H2, VerticalAnglesCong; angle H G A === angle E G B by BGHncol, HGAncol, ANGLE, -, C5Symmetric; angle H G A === angle G H D by BGHncol, HGAncol, ANGLE, -, EGBeqGHD, C5Transitive; qed by -, AngleSymmetry; suppose angle B G H suppl angle G H D [BGHeqGHD]; angle B G H suppl angle H G A by BGHncol, H1, B1', SupplementaryAngles_DEF; qed by -, BGHeqGHD, AngleSymmetry, SupplementUnique, AngleSymmetry; end; qed by l_line, m_line, t_line, Distinct, HGAncol, H3, -, AlternateInteriorAngles; `;; let OppositeSidesCongImpliesParallelogram = thm `; let A B C D be point; assume Quadrilateral A B C D [H1]; assume seg A B === seg C D /\ seg B C === seg D A [H2]; thus Parallelogram A B C D proof ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; consider a c such that Line a /\ A IN a /\ B IN a /\ Line c /\ C IN c /\ D IN c [ac_line] by TetraABCD, I1; consider b d such that Line b /\ B IN b /\ C IN b /\ Line d /\ D IN d /\ A IN d [bd_line] by TetraABCD, I1; consider l such that Line l /\ A IN l /\ C IN l [l_line] by TetraABCD, I1; consider m such that Line m /\ B IN m /\ D IN m [m_line] by TetraABCD, I1; B NOTIN l /\ D NOTIN l /\ A NOTIN m /\ C NOTIN m [notBDlACm] by l_line, m_line, TetraABCD, Collinear_DEF, NOTIN; seg A C === seg C A /\ seg B D === seg D B [seg_refl] by TetraABCD, SEGMENT, C2Reflexive, SegmentSymmetry; A,B,C cong C,D,A by TetraABCD, H2, -, SSS; angle B C A === angle D A C /\ angle C A B === angle A C D [BCAeqDAC] by -, TriangleCong_DEF; seg C D === seg A B [CDeqAB] by TetraABCD, SEGMENT, H2, C2Symmetric; B,C,D cong D,A,B by TetraABCD, H2, -, seg_refl, SSS; angle C D B === angle A B D /\ angle D B C === angle B D A [CDBeqABD] by -, TriangleCong_DEF; ~(B,D same_side l) \/ ~(A,C same_side m) by H1, l_line, m_line, FiveChoicesQuadrilateral; cases by -; suppose ~(B,D same_side l); ~(D,B same_side l) by l_line, notBDlACm, -, SameSideSymmetric; a parallel c /\ b parallel d by ac_line, l_line, TetraABCD, notBDlACm, -, BCAeqDAC, AngleSymmetry, AlternateInteriorAngles, bd_line, BCAeqDAC; qed by H1, ac_line, bd_line, -, Parallelogram_DEF; suppose ~(A,C same_side m); b parallel d /\ c parallel a by bd_line, m_line, TetraABCD, notBDlACm, -, CDBeqABD, AngleSymmetry, AlternateInteriorAngles, ac_line, CDBeqABD; qed by H1, ac_line, bd_line, -, ParallelSymmetry, Parallelogram_DEF; end; `;; let OppositeAnglesCongImpliesParallelogramHelp = thm `; let A B C D be point; let a c be point_set; assume Quadrilateral A B C D [H1]; assume angle A B C === angle C D A /\ angle D A B === angle B C D [H2]; assume Line a /\ A IN a /\ B IN a [a_line]; assume Line c /\ C IN c /\ D IN c [c_line]; thus a parallel c proof ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; angle C D A === angle A B C /\ angle B C D === angle D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; consider l m such that Line l /\ A IN l /\ C IN l /\ Line m /\ B IN m /\ D IN m [lm_line] by TetraABCD, I1; consider b d such that Line b /\ B IN b /\ C IN b /\ Line d /\ D IN d /\ A IN d [bd_line] by TetraABCD, I1; A NOTIN c /\ B NOTIN c /\ A NOTIN b /\ D NOTIN b /\ B NOTIN d /\ C NOTIN d [point_off_line] by c_line, bd_line, Collinear_DEF, TetraABCD, NOTIN; ~(A IN int_triangle B C D \/ B IN int_triangle C D A \/ C IN int_triangle D A B \/ D IN int_triangle A B C) proof assume A IN int_triangle B C D \/ B IN int_triangle C D A \/ C IN int_triangle D A B \/ D IN int_triangle A B C; angle B C D <_ang angle D A B \/ angle C D A <_ang angle A B C \/ angle D A B <_ang angle B C D \/ angle A B C <_ang angle C D A by TetraABCD, -, EuclidPropositionI_21; qed by -, H2', H2, AngleTrichotomy1; ConvexQuadrilateral A B C D by H1, lm_line, -, FiveChoicesQuadrilateral; A IN int_angle B C D /\ B IN int_angle C D A /\ C IN int_angle D A B /\ D IN int_angle A B C [AintBCD] by -, ConvexQuad_DEF; B,A same_side c /\ B,C same_side d [Bsim_cA] by c_line, bd_line, -, InteriorUse; A,D same_side b [Asim_bD] by bd_line, c_line, AintBCD, InteriorUse; assume ~(a parallel c); consider G such that G IN a /\ G IN c [Gac] by -, a_line, c_line, PARALLEL, MEMBER_NOT_EMPTY, IN_INTER; Collinear A B G /\ Collinear D G C /\ Collinear C G D [ABGcol] by a_line, -, Collinear_DEF, c_line; ~(G = A) /\ ~(G = B) /\ ~(G = C) /\ ~(G = D) [GnotABCD] by Gac, ABGcol, TetraABCD, CollinearSymmetry, Collinear_DEF; ~Collinear B G C /\ ~Collinear A D G [BGCncol] by c_line, Gac, GnotABCD, I1, Collinear_DEF, point_off_line, NOTIN; ~Collinear B C G /\ ~Collinear G B C /\ ~Collinear G A D /\ ~Collinear A G D [BCGncol] by -, CollinearSymmetry; G NOTIN b /\ G NOTIN d [notGb] by bd_line, Collinear_DEF, BGCncol, NOTIN; G NOTIN open (B,A) [notBGA] by Bsim_cA, Gac, SameSide_DEF, NOTIN; B NOTIN open (A,G) [notABG] proof assume ~(B NOTIN open (A,G)); B IN open (A,G) [ABG] by -, NOTIN; ray A B = ray A G [rABrAG] by -, IntervalRay; ~(A,G same_side b) by bd_line, ABG, SameSide_DEF; ~(D,G same_side b) by bd_line, point_off_line, notGb, Asim_bD, -, SameSideTransitive; D NOTIN ray C G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, NOTIN; C IN open (D,G) [DCG] by GnotABCD, ABGcol, -, IN_Ray, NOTIN; consider M such that D IN open (C,M) [CDM] by TetraABCD, B2'; D IN open (G,M) [GDM] by -, B1', DCG, TransitivityBetweennessHelp; angle C D A suppl angle A D M /\ angle A B C suppl angle C B G by TetraABCD, CDM, ABG, SupplementaryAngles_DEF; angle M D A === angle G B C [MDAeqGBC] by -, H2', SupplementsCongAnglesCong, AngleSymmetry; angle G A D <_ang angle M D A /\ angle G B C <_ang angle D C B by BCGncol, BGCncol, GDM, DCG, B1', EuclidPropositionI_16; angle G A D <_ang angle D C B by -, BCGncol, ANGLE, MDAeqGBC, AngleTrichotomy2, AngleOrderTransitivity; angle D A B <_ang angle B C D by -, rABrAG, Angle_DEF, AngleSymmetry; qed by -, H2, AngleTrichotomy1; A NOTIN open (G,B) proof assume ~(A NOTIN open (G,B)); A IN open (B,G) [BAG] by -, B1', NOTIN; ray B A = ray B G [rBArBG] by -, IntervalRay; ~(B,G same_side d) by bd_line, BAG, SameSide_DEF; ~(C,G same_side d) by bd_line, point_off_line, notGb, Bsim_cA, -, SameSideTransitive; C NOTIN ray D G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, NOTIN; D IN open (C,G) [CDG] by GnotABCD, ABGcol, -, IN_Ray, NOTIN; consider M such that C IN open (D,M) [DCM] by B2', TetraABCD; C IN open (G,M) [GCM] by -, B1', CDG, TransitivityBetweennessHelp; angle B C D suppl angle M C B /\ angle D A B suppl angle G A D by TetraABCD, CollinearSymmetry, DCM, BAG, SupplementaryAngles_DEF, AngleSymmetry; angle M C B === angle G A D [GADeqMCB] by -, H2', SupplementsCongAnglesCong; angle G B C <_ang angle M C B /\ angle G A D <_ang angle C D A by BGCncol, GCM, BCGncol, CDG, B1', EuclidPropositionI_16; angle G B C <_ang angle C D A by -, BCGncol, ANGLE, GADeqMCB, AngleTrichotomy2, AngleOrderTransitivity; angle A B C <_ang angle C D A by -, rBArBG, Angle_DEF; qed by -, H2, AngleTrichotomy1; qed by TetraABCD, GnotABCD, ABGcol, notABG, notBGA, -, B3', NOTIN; `;; let OppositeAnglesCongImpliesParallelogram = thm `; let A B C D be point; assume Quadrilateral A B C D [H1]; assume angle A B C === angle C D A /\ angle D A B === angle B C D [H2]; thus Parallelogram A B C D proof Quadrilateral B C D A [QuadBCDA] by H1, QuadrilateralSymmetry; ~(A = B) /\ ~(B = C) /\ ~(C = D) /\ ~(D = A) /\ ~Collinear B C D /\ ~Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; angle B C D === angle D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; consider a such that Line a /\ A IN a /\ B IN a [a_line] by TetraABCD, I1; consider b such that Line b /\ B IN b /\ C IN b [b_line] by TetraABCD, I1; consider c such that Line c /\ C IN c /\ D IN c [c_line] by TetraABCD, I1; consider d such that Line d /\ D IN d /\ A IN d [d_line] by TetraABCD, I1; qed by H1, QuadBCDA, H2, H2', a_line, b_line, c_line, d_line, OppositeAnglesCongImpliesParallelogramHelp, Parallelogram_DEF; `;; let P = new_axiom `! P l. Line l /\ P NOTIN l ==> ?! m. Line m /\ P IN m /\ m parallel l`;; new_constant("mu",`:point_set->real`);; let AMa = new_axiom `! alpha. Angle alpha ==> &0 < mu alpha /\ mu alpha < &180`;; let AMb = new_axiom `! alpha. Right alpha ==> mu alpha = &90`;; let AMc = new_axiom `! alpha beta. Angle alpha /\ Angle beta /\ alpha === beta ==> mu alpha = mu beta`;; let AMd = new_axiom `! A O B P. P IN int_angle A O B ==> mu (angle A O B) = mu (angle A O P) + mu (angle P O B)`;; let ConverseAlternateInteriorAngles = thm `; let A B C E be point; let l m t be point_set; assume Line l /\ A IN l /\ E IN l [l_line]; assume Line m /\ B IN m /\ C IN m [m_line]; assume Line t /\ A IN t /\ B IN t [t_line]; assume ~(A = E) /\ ~(B = C) /\ ~(A = B) /\ E NOTIN t /\ C NOTIN t [Distinct]; assume ~(C,E same_side t) [Cnsim_tE]; assume l parallel m [para_lm]; thus angle E A B === angle C B A proof ~Collinear C B A by t_line, Distinct, I1, Collinear_DEF, NOTIN, ANGLE; A NOTIN m /\ Angle (angle C B A) [notAm] by m_line, -, Collinear_DEF, NOTIN, ANGLE; consider D such that ~(A = D) /\ D NOTIN t /\ ~(C,D same_side t) /\ seg A D === seg A E /\ angle B A D === angle C B A [Dexists] by -, Distinct, t_line, C4OppositeSide; consider k such that Line k /\ A IN k /\ D IN k [k_line] by Distinct, I1; k parallel m by -, m_line, t_line, Dexists, Distinct, AngleSymmetry, AlternateInteriorAngles; k = l by m_line, notAm, l_line, k_line, -, para_lm, P; D,E same_side t /\ A NOTIN open (D,E) /\ Collinear A E D by t_line, Distinct, Dexists, Cnsim_tE, AtMost2Sides, SameSide_DEF, NOTIN, -, k_line, l_line, Collinear_DEF; ray A D = ray A E by Distinct, -, IN_Ray, Dexists, IN_DELETE, RayWellDefined; qed by -, Dexists, AngleSymmetry, Angle_DEF; `;; let HilbertTriangleSum = thm `; let A B C be point; assume ~Collinear A B C [ABCncol]; thus ? E F. B IN open (E,F) /\ C IN int_angle A B F /\ angle E B A === angle C A B /\ angle C B F === angle B C A proof ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~Collinear C A B [Distinct] by ABCncol, NonCollinearImpliesDistinct, CollinearSymmetry; consider l such that Line l /\ A IN l /\ C IN l [l_line] by Distinct, I1; consider x such that Line x /\ A IN x /\ B IN x [x_line] by Distinct, I1; consider y such that Line y /\ B IN y /\ C IN y [y_line] by Distinct, I1; C NOTIN x [notCx] by x_line, ABCncol, Collinear_DEF, NOTIN; Angle (angle C A B) by ABCncol, CollinearSymmetry, ANGLE; consider E such that ~(B = E) /\ E NOTIN x /\ ~(C,E same_side x) /\ seg B E === seg A B /\ angle A B E === angle C A B [Eexists] by -, Distinct, x_line, notCx, C4OppositeSide; consider m such that Line m /\ B IN m /\ E IN m [m_line] by -, I1, IN_DELETE; angle E B A === angle C A B [EBAeqCAB] by Eexists, AngleSymmetry; m parallel l [para_lm] by m_line, l_line, x_line, Eexists, Distinct, notCx, -, AlternateInteriorAngles; m INTER l = {} [lm0] by -, PARALLEL; C NOTIN m /\ A NOTIN m [notACm] by -, l_line, INTER_COMM, DisjointOneNotOther; consider F such that B IN open (E,F) [EBF] by Eexists, B2'; ~(B = F) /\ F IN m [EBF'] by -, B1', m_line, BetweenLinear; ~Collinear A B F /\ F NOTIN x [ABFncol] by m_line, -, I1, Collinear_DEF, notACm, NOTIN, x_line; ~(E,F same_side x) /\ ~(E,F same_side y) [Ensim_yF] by EBF, x_line, y_line, SameSide_DEF; C,F same_side x [Csim_xF] by x_line, notCx, Eexists, ABFncol, Eexists, -, AtMost2Sides; m INTER open(C,A) = {} by l_line, BetweenLinear, SUBSET, SET_RULE, lm0, SUBSET_EMPTY; C,A same_side m by m_line, -, SameSide_DEF, SET_RULE; C IN int_angle A B F [CintABF] by ABFncol, x_line, m_line, EBF', notCx, notACm, Csim_xF, -, IN_InteriorAngle; A IN int_angle C B E by EBF, B1', -, InteriorAngleSymmetry, InteriorReflectionInterior; A NOTIN y /\ A,E same_side y [Asim_yE] by y_line, m_line, -, InteriorUse; E NOTIN y /\ F NOTIN y [notEFy] by y_line, m_line, EBF', Eexists, EBF', I1, Collinear_DEF, notACm, NOTIN; E,A same_side y by y_line, -, Asim_yE, SameSideSymmetric; ~(A,F same_side y) [Ansim_yF] by y_line, notEFy, Asim_yE, -, Ensim_yF, SameSideTransitive; angle F B C === angle A C B by m_line, EBF', l_line, y_line, EBF', Distinct, notEFy, Asim_yE, Ansim_yF, para_lm, ConverseAlternateInteriorAngles; qed by EBF, CintABF, EBAeqCAB, -, AngleSymmetry; `;; let EuclidPropositionI_13 = thm `; let A O B A' be point; assume ~Collinear A O B [H1]; assume O IN open (A,A') [H2]; thus mu (angle A O B) + mu (angle B O A') = &180 proof cases; suppose Right (angle A O B); Right (angle B O A') /\ mu (angle A O B) = &90 /\ mu (angle B O A') = &90 by H1, H2, -, RightImpliesSupplRight, AMb; qed by -, REAL_ARITH; suppose ~Right (angle A O B) [notRightAOB]; ~(A = O) /\ ~(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; consider l such that Line l /\ O IN l /\ A IN l /\ A' IN l [l_line] by -, I1, H2, BetweenLinear; B NOTIN l [notBl] by -, Distinct, I1, Collinear_DEF, H1, NOTIN; consider F such that Right (angle O A F) /\ Angle (angle O A F) [RightOAF] by Distinct, EuclidPropositionI_11, RightImpliesAngle; ?! r. Ray r /\ ? E. ~(O = E) /\ r = ray O E /\ E NOTIN l /\ E,B same_side l /\ angle A O E === angle O A F by -, Distinct, l_line, notBl, C4; consider E such that ~(O = E) /\ E NOTIN l /\ E,B same_side l /\ angle A O E === angle O A F [Eexists] by -; ~Collinear A O E [AOEncol] by l_line, Distinct, I1, Collinear_DEF, -, NOTIN; Right (angle A O E) [RightAOE] by -, ANGLE, RightOAF, Eexists, CongRightImpliesRight; Right (angle E O A') /\ mu (angle A O E) = &90 /\ mu (angle E O A') = &90 [RightEOA'] by AOEncol, H2, -, RightImpliesSupplRight, AMb; ~(angle A O B === angle A O E) by notRightAOB, H1, ANGLE, RightAOE, CongRightImpliesRight; ~(angle A O B = angle A O E) by H1, AOEncol, ANGLE, -, C5Reflexive; ~(ray O B = ray O E) by -, Angle_DEF; B NOTIN ray O E /\ O NOTIN open (B,E) by Distinct, -, Eexists, RayWellDefined, IN_DELETE, NOTIN, l_line, B1', SameSide_DEF; ~Collinear O E B by -, Eexists, IN_Ray, NOTIN; E IN int_angle A O B \/ B IN int_angle A O E by Distinct, l_line, Eexists, notBl, AngleOrdering, -, CollinearSymmetry, InteriorAngleSymmetry; cases by -; suppose E IN int_angle A O B [EintAOB]; B IN int_angle E O A' by H2, -, InteriorReflectionInterior; mu (angle A O B) = mu (angle A O E) + mu (angle E O B) /\ mu (angle E O A') = mu (angle E O B) + mu (angle B O A') by EintAOB, -, AMd; qed by -, RightEOA', REAL_ARITH; suppose B IN int_angle A O E [BintAOE]; E IN int_angle B O A' by H2, -, InteriorReflectionInterior; mu (angle A O E) = mu (angle A O B) + mu (angle B O E) /\ mu (angle B O A') = mu (angle B O E) + mu (angle E O A') by BintAOE, -, AMd; qed by -, RightEOA', REAL_ARITH; end; end; `;; let TriangleSum = thm `; let A B C be point; assume ~Collinear A B C [ABCncol]; thus mu (angle A B C) + mu (angle B C A) + mu (angle C A B) = &180 proof ~Collinear C A B /\ ~Collinear B C A [CABncol] by ABCncol, CollinearSymmetry; consider E F such that B IN open (E,F) /\ C IN int_angle A B F /\ angle E B A === angle C A B /\ angle C B F === angle B C A [EBF] by ABCncol, HilbertTriangleSum; ~Collinear C B F /\ ~Collinear A B F /\ Collinear E B F /\ ~(B = E) [CBFncol] by -, InteriorAngleSymmetry, InteriorEZHelp, IN_InteriorAngle, B1', CollinearSymmetry; ~Collinear E B A [EBAncol] by CollinearSymmetry, -, NoncollinearityExtendsToLine; mu (angle A B F) = mu (angle A B C) + mu (angle C B F) [muCintABF] by EBF, AMd; mu (angle E B A) + mu (angle A B F) = &180 [suppl180] by EBAncol, EBF, EuclidPropositionI_13; mu (angle C A B) = mu (angle E B A) /\ mu (angle B C A) = mu (angle C B F) by CABncol, EBAncol, CBFncol, ANGLE, EBF, AMc; qed by suppl180, muCintABF, -, REAL_ARITH; `;; hol-light/RichterHilbertAxiomGeometry/miz3/Miz3Tips000066400000000000000000000372361303454263000226730ustar00rootroot00000000000000The simplest way to run HilbertAxiom.ml is this. In a terminal window (or Emacs shell), move to your hol_light directory and paste in these 3 commands, followed by a RETURN: ocaml #use "hol.ml";; #use "RichterHilbertAxiomGeometry/make.ml";; This will not work if you have already evaluated HilbertAxiom_read.ml, because you will get an error Exception: Failure "new_type: type point has already been declared". You will see 190 or so definitions and proved theorems, in perhaps 15 minutes. How to check the Hilbert axiomatic geometry proofs HilbertAxiom.ml, which are a formalization in the proof assistant HOL Light of http://www.math.northwestern.edu/~richter/hilbert.pdf using Freek Wiedijk's Mizar mode miz3. This has only been checked on Linux. I'll also assume familiarity with the Emacs editor (version 23 or 24). First a discussion of miz3. There are a number of good proof assistants to formalize mathematical proofs in, e.g. Coq, with which the 4-color theorem proof was formalized. There are a number of good HOL proof assistants, e.g. HOL4 & Isabelle. Two outstanding advantages of HOL Light are Freek's miz3 and that HOL Light is the preferred proof assistant of Tom Hales, who is ambituously trying to formalize his proof of the Kepler sphere-packing theorem. I suspect that John Harrison's leadership is involved in both advantages. Mizar was the first proof assistant allowing readable formal proofs. Miz3 now allows readable formal proofs in HOL Light. Miz3 mostly resembles Mizar in its syntax (let, assume, thus, proof, by, end, consider, suppose, cases, ...) and proof structure. The Mizar type system and vocabulary (both quite confusing to beginners) is gone from miz3. As in Mizar, each line in a miz3 proof is of the form statement by list; so the statement is supposed to be justified by the list of results. But the "by justification" in Mizar is quite different from that in miz3. The miz3 by justification is mostly performed by the HOL Light FOL prover MESON, which is quite powerful, so in miz3, one can skip steps that could not be skipped in Mizar, which seems to have intentionally weakened the by justification in order to encourage readable proofs. Miz3 has no such intentional weakness (although timeout must be set to a high value to skip steps), but MESON is not particularly good at equational reasoning, as one sees in this example from the Hilbert code (using fancy fonts for readability): let B4 = new_axiom `∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ Between A X C) ⇒ (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C)`;; let B4' = thm `; ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ X ∈ open (A,C)) ⇒ (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) by IN_Interval, B4; `;; B4' does nothing but substitute into B4 the definition IN_Interval |- ∀ A B X. X ∈ open (A,B) ⇔ Between A X B This is equational reasoning, and B4' times out with the default timeout value of 1 (5 suffices), and then, a longer proof is needed: let B4prime = thm `; let l be point_set; let A B C be point; assume Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ X ∈ open (A,C)) [H1]; thus (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) proof Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ Between A X C) by H1, IN_Interval; (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C) by -, B4; qed by -, IN_Interval; `;; The biggest difference between miz3 and Mizar is that miz3 allows one to mix the procedural and declarative styles of formal proofs (Mizar proofs are entirely declarative). That is, one can use HOL Light tactics in the by list, although this is essentially not done here. A HOL Light tactic that might be helpful here is REWRITE_TAC, which is used in equational reasoning, an interesting area of HOL. It pay to write a `skeleton' of your proof before filling in the details, and I always start with this: proof qed by -; My miz3 proof typically end with "qed by ... ;", Freek's macro for "thus thesis by ... ; end;", as in the proof of B4prime above, and rarely with neither qed nor end, as in the short proof of B4', but a proof with cases must end with "end". Suppose in the course of a proof you realize you need cases. Write in the various cases (with suppose) first before giving the proofs, or miz3 will give you a skeleton error. So your proof will then look something like this: proof [...] A ∨ B ∨ C; cases by -; suppose A; qed by -; suppose B; qed by -; suppose C; qed by -; end; The point is that the final "qed by -;" matching "proof" has been changed to "end;" Here's a partial explanation. In miz3, there is always a thesis, which changes from line to line. "Thus thesis" means the thesis is proven, and then one writes "end" to end the proof. In the cases construction above, each of the 3 forks have their own thesis, A, B and C resp., and each proofs end with qed. So in the final line, there is no thesis! So we merely write "end". In the proof B4prime above, "thus" seems to have two separate meanings. The first thus seems to be stating the theorem, and the second thus (contained in the qed) is is ending the proof. In a sense thus has the same meaning. Let's simplify B4prime as let B4prime = thm `; [...] thus α ∨ β proof [...] thus thesis by -, IN_Interval; end; `;; The entire "proof [...] IN_Interval;" is as a justification of the statement α ∨ β, even though there is no "by". So we could in a sense rewrite B4prime as let B4prime = thm `; [...] thus α ∨ β by [...]; end; `;; As the thesis is α ∨ β on the "thus" line, this is analogous to thus thesis by -, IN_Interval; which ends the proof. My code uses a fair amount of set theory, which is explained in John's tutorial briefly in sec 14, and in more detail in his reference manual. I found browsing the file sets.ml to be quite helpful. SET_RULE, explained on p 92 of the tutorial simplified my coding. At the top I explained how to run HilbertAxiom.ml. For a longer journey, comment the top t two lines of HilbertAxiom.ml and FontHilbertAxiom.ml verbose := false;; report_timing := false;; Change into the directory containing your HOL source files (named hol_light), as explained in the HOL Light documentation. I'll assume that you can copy and paste with the mouse. Open a terminal window. Paste in these 4 commands and type RET: ocaml #use "hol.ml";; #load "unix.cma";; loadt "miz3/miz3.ml";; After a short while you will see val it : unit = () # Now select the entire file HilbertAxiom.ml and paste it in. This will take perhaps 15 minutes and you'll see various numbers and so forth to indicate how hard miz3 is working. Paste the file in again, and in perhaps 15 seconds you will see the miz3 output, with no numbers. The faster speed is due to the fact that miz3 caches information. The miz3 cache causes trouble if you change the statement of a theorem. To clear all the theorems from the miz3 cache paste in reset_miz3 0;; Theorems are created by thm, and definitions are created by new_definition. This command will not clear definitions or axioms, so to change a definition or axioms, end the session and start a new session. Sometimes even when only changing theorems it's good to start a new session. To end your ocam/HOL-Light/miz3 session, type C-d If you paste in bad input, sometimes you can fix the problem by typing C-c (or the signal BREAK in an Emacs shell C-c C-c). To learn the thesis in a statement in a miz3 proof, insert exec GOAL_TAC; after the statement, and the type p();; at the end of the proof. There are two problems with pasting into a terminal window, both solved by using intead an Emacs shell, created with M-x shell. After pasting into the shell, type RET. In a terminal window, miz3 output is mixed with miz3 code pasted in. More seriously, a terminal window can only be scrolled back so far, so with a long program, errors at the top of the file won't be visible. When pasting into an Emacs shell, the output is all at the end, and there is no line limit. Freek has a different system of using miz3 involving code being piped directly from the editor vi, but I have not tried it yet. You should use a separate Emacs process for each shell you use, because in the 30 seconds or so when the shell is interpreting the program, no editing can take place in that Emacs process. Loading the file hol-light-fonts.el (or for a bit more speed, hol-light-fonts.elc) will put any file with extension `ml' in text-mode with auto-fill-mode turned off (provided it isn't set to be on by default in your .emacs file) and visual-line-mode turned on, which turns on `word-wrap', which aids readability with my long lines. The miz3 error messages are rather cryptic, but this seems to be a problem with HOL Light. Some tips on the error messages: #1 inference error means that miz3 asserts that your `by' justification is impossible. A simple way to earn a #1 error is to mix up `qed' and `end' in a cases construction. #2 inference time-out means that miz3 was unable to calculate your `by' justification before timing out. There are two possibilities: 1) your `by' justification doesn't work, so you should fix it; 2) you need more time, in which case you can increase the value of timeout, to e.g. 50 as is done here, with timeout := 50;; You never get a #2 time-out error if you set timeout to infinity, by timeout := -1;; As Freek explains, this is useful in checking ones proofs on a slower machine than the one on which the miz3 proofs were debugged on. #3 skeleton error require a good understanding of miz3's version of Mizar's (barely documented) notion of the skeleton, which is the outline of the proof. Freek's paper contains a reasonably good explanation of miz3 skeletons. The first line with an error message may not be the first line with a mistake on it. Consider this fragment of a miz3 error messages: Exception: Mizar_error (`; let A B C be point; assume ~Collinear A B C [H1]; assume seg B A === seg C B [H2]; :: #3 :: 3: skeleton error thus angle BCA === angle CAB :: #8 :: 8: syntax or type error hol proof [...] There is nothing wrong with the line with the #3 error message. The problem is in the next line with the #8 error, where `BCA' & `CAB' should read `B C A' and `C A B'. One this problem is fixed, the earlier #3 error disappears: Mizar_error (`; let A B C be point; assume ~Collinear A B C [H1]; assume seg B A === seg B C [H2]; thus angle B C A === angle C A B proof [...] Here's another example where the first line with a reported error is fine, and the real error occurs later: cases; suppose G = A; qed by -; :: #1 :: 1: inference error suppose G = C; qed by -; :: #1 suppose ~(G = A) /\ ~(G = C) [AGCdistinct]; Collinear A G C [AGCcol] by h_line, BGN, Collinear_DEF; G IN open (A,C) \/ C IN open (G,A) \/ A IN open (C,G) by Distinct, AGCdistinct, -, B3'; cases by -; suppose G IN open (A,C) [AGC]; qed by -; :: #1 suppose C IN open (G,A) [GCA]; qed by -; :: #1 suppose A IN open (C,G) [CAG]; qed by -; :: #1#9 :: 9: syntax error mizar qed by -; end The #1 inference error are all correct, as the proofs is the various cases have not yet been coded up. But the #9 error occurs on a line with no error. The problem is in the line below it, which should be `end' and not `qed'. When we fix this, the #9 error goes away: cases; suppose G = A; qed by -; :: #1 :: 1: inference error suppose G = C; qed by -; :: #1 suppose ~(G = A) /\ ~(G = C) [AGCdistinct]; Collinear A G C [AGCcol] by h_line, BGN, Collinear_DEF; G IN open (A,C) \/ C IN open (G,A) \/ A IN open (C,G) by Distinct, AGCdistinct, -, B3'; cases by -; suppose G IN open (A,C) [AGC]; qed by -; :: #1 suppose C IN open (G,A) [GCA]; qed by -; :: #1 suppose A IN open (C,G) [CAG]; qed by -; :: #1 end; end Here's an example of the error being reported on a line later than the error: D,O',F cong A,O,C by H1, H2, -, SAS_THM: seg D F === seg A C by -, TriangleCong_DEF; :: #9 :: 9: syntax error mizar The problem is the : on the first line, which should be a ;. There is no other error here. #4 unknown label often means that you mis-typed one of the results in the by list. You can also earn a #4 error message by misplacing the "by": A,D,M cong B,D,M by [ADMcong] ADMncol, Dexists, -, ADM, AngleSymmetry_THM, SAS_THM; :: #4 :: 4: unknown label Placing the "by" after the label gets rid of #4 error message: A,D,M ≅ B,D,M [ADMcong] by ADMncol, Dexists, -, ADM, AngleSymmetry_THM, SAS_THM; #8 syntax or type error hol often means that e.g. a function has the wong number of arguments, or the `by' is missing, but sometimes HOL Light expertise is needed. You can not e.g. define (by `let') the letter `o' as a variable, because it already means the composition operator. Evaluating type_of `o`;; tells you the hol_type of `o' is `:(?143901->?143903)->(?143902->?143901)->?143902->?143903` meaning that `o' is a function taking two selfmaps and returning the composition. You can see that `o' is infix operator by evaluting infixes();; which gives all the infix operators plus precedence info, including ("o", (26, "right")) #9 syntax error mizar might mean that there's a colon (:) instead of a semicolon (;) at the end of the line, or a ;;, or there is no ; at the end of the line, there is a blank between two commas in the `by' list. i.e. statement [label] by X1, X2, , X3, X4; or that there are two occurrences of `by' on the line, as in ray D C = ray D G [rDCrDG] by by DCG, IntervalRay_THM; Exception: Failure "lex1". may means you have a bad character, perhaps obtained by pasting from a pdf file, where you can the fancy quote (’) which HOL Light will not parse, and you must replace it by the quote ('). Use `thm' in miz3 for a theorem/proof. The style used here is let CarefullyChosenName_THM = thm `; let *; assume *; thus * proof qed by *; `;; Begin with `let' variable bindings, `assume' assumptions, then state the theorem with `thus', then give the proof beginning with `proof', and end the proof with `qed' or `end'. Notice that the `thus' and `proof' statement do not end in a semicolon (;). The miz3 comment symbol in a `thm' body is a double colon (::). Outside a `thm' body, use the Hol Light (* ... *) comment convention. There are exactly two occurrences of backquote (`) in the `thm' body. You can not have a other backquotes, even a ` commented out with ::. If you ever accidentally paste miz3 code with e.g. a misplaced backquote (`), into the miz3 window (or Emacs shell), type C-c to get miz3 to forget about it (C-c C-c in an Emacs shell). You can see there's a bad backquote when miz3 gives you the error message containing "Parse error". Exception: Failure "term_of_now". This error occurs when ??? hol-light/RichterHilbertAxiomGeometry/miz3/README000066400000000000000000000015721303454263000221400ustar00rootroot00000000000000 HOL Light formalization of Hilbert's axiomatic geometry (c) Copyright, Bill Richter 2012 Distributed under the same license as HOL Light HilbertAxiom.ml is a formalization using miz3 of the plane geometry part of the Hilbert axiomatic geometry paper http://www.math.northwestern.edu/~richter/hilbert.pdf Miz3Tips gives details on running HilbertAxiom.ml, and some information on how to use miz3. FontHilbertAxiom.ml is a version of HilbertAxiom.ml written with mathematical characters ⇒, ⇔, ¬, ∨, ∧, ∀, ∃, ⊂, ∈, ∪, ∩ and ∅ which HOL4, Isabelle and readable.ml allow. It requires hol-light-fonts.el is needed to run the miz3 code FontHilbertAxiom.ml. hol-light-fonts.elc is the byte-compiled version of the Emacs code. make.ml is an easy way to run the miz3 code HilbertAxiom.ml: #use "RichterHilbertAxiomGeometry/miz3/make.ml";; hol-light/RichterHilbertAxiomGeometry/miz3/hol-light-fonts.el000066400000000000000000000323731303454263000246230ustar00rootroot00000000000000;; The function Math-fonts-for-HOL-Light replace the expressions ;; ==>, <=>, ~, \/, /\, !, ?, SUBSET, IN, UNION, INTER and {} ;; in a file with the mathematical characters (used by Isabelle) ;; ⇒, ⇔, ¬, ∨, ∧, ∀, ∃, ⊂, ∈, ∪, ∩ and ∅. ;; The function Remove-math-fonts-for-HOL-Light turns the mathematical characters ;; ⇒, ⇔, ¬ etc back to HOL Light expressions ==>, <=>, ~ etc. ;; Given a file with mathematical characters, the function ;; File-remove-math-fonts-for-HOL-Light makes the X-selection a ;; version of the file with ∀, ∃, ∩,... replaced by !, ?, INTER,... so ;; it can be pasted into a ocaml/HOL-Light process. ;; the function Region-math-fonts-removed-for-HOL-Light similarly ;; processes the region. (defun Math-fonts-for-HOL-Light () "replace HOL Light expressions (!, ?, INTER,...) with mathematical characters (∀, ∃, ∩,...) in the entire buffer." (interactive) (let ((start (point))) (setq case-fold-search nil) (goto-char (point-min)) (while (search-forward "\\/" nil t) (replace-match "∨" nil t)) (goto-char (point-min)) (while (search-forward "/\\" nil t) (replace-match "∧" nil t)) (goto-char (point-min)) (while (search-forward "===" nil t) (replace-match "≡" nil t)) (goto-char (point-min)) (while (search-forward "==>" nil t) (replace-match "⇒" nil t)) (goto-char (point-min)) (while (search-forward "~" nil t) (replace-match "¬" nil t)) (goto-char (point-min)) (while (search-forward "<=>" nil t) (replace-match "⇔" nil t)) (goto-char (point-min)) (while (search-forward "!" nil t) (replace-match "∀" nil t)) (goto-char (point-min)) (while (search-forward "?" nil t) (replace-match "∃" nil t)) (goto-char (point-min)) (while (search-forward "∃∀" nil t) (replace-match "∃!" nil t)) (goto-char (point-min)) (while (search-forward " SUBSET " nil t) (replace-match " ⊂ " nil t)) (goto-char (point-min)) (while (search-forward " SUBSET " nil t) (replace-match " ⊂ " nil t)) (goto-char (point-min)) (while (search-forward " INTER " nil t) (replace-match " ∩ " nil t)) (goto-char (point-min)) (while (search-forward " INTER " nil t) (replace-match " ∩ " nil t)) (goto-char (point-min)) (while (search-forward " UNION " nil t) (replace-match " ∪ " nil t)) (goto-char (point-min)) (while (search-forward " UNION " nil t) (replace-match " ∪ " nil t)) (goto-char (point-min)) (while (search-forward "{}" nil t) (replace-match "∅" nil t)) (goto-char (point-min)) (while (search-forward "cong" nil t) (replace-match "≅" nil t)) (goto-char (point-min)) (while (search-forward " IN " nil t) (replace-match " ∈ " nil t)) (goto-char (point-min)) (while (search-forward " DIFF " nil t) (replace-match " â” " nil t)) (goto-char (point-min)) (while (search-forward " DIFF " nil t) (replace-match " â” " nil t)) (goto-char (point-min)) (while (search-forward " INSERT " nil t) (replace-match " ╪ " nil t)) (goto-char (point-min)) (while (search-forward "alpha" nil t) (replace-match "α" nil t)) (goto-char (point-min)) (while (search-forward "beta" nil t) (replace-match "β" nil t)) (goto-char (point-min)) (while (search-forward "gamma" nil t) (replace-match "γ" nil t)) (goto-char (point-min)) (while (search-forward " angle " nil t) (replace-match " ∡ " nil t)) (goto-char (point-min)) (while (search-forward "(angle " nil t) (replace-match "(∡ " nil t)) (goto-char (point-min)) (while (search-forward "not===" nil t) (replace-match " ≢ " nil t)) (goto-char (point-min)) (while (search-forward "NOTIN" nil t) (replace-match "∉" nil t)) (goto-char (point-min)) (while (search-forward "neq" nil t) (replace-match " ≠ " nil t)) (goto-char (point-min)) (while (search-forward "\\" nil t) (replace-match "λ" nil t)) (goto-char (point-min)) (while (search-forward "parallel" nil t) (replace-match "∥" nil t)) (goto-char (point-min)) (while (search-forward "theta" nil t) (replace-match "θ" nil t)) (goto-char (point-min)) (while (search-forward "mu" nil t) (replace-match "μ" nil t)) (goto-char (point-min)) (while (search-forward "--->" nil t) (replace-match "→" nil t)) (goto-char (point-min)) (while (search-forward " prod " nil t) (replace-match " ∠" nil t)) (goto-char (point-min)) (while (search-forward " _o_ " nil t) (replace-match " ∘ " nil t)) (goto-char start))) (defun Remove-math-fonts-for-HOL-Light () "replace mathematical characters (∀, ∃, ∩,...) with HOL Light expressions (!, ?, INTER,...)." (interactive) (setq case-fold-search nil) (untabify (point-min) (point-max)) (goto-char (point-min)) (while (search-forward "∨" nil t) (replace-match "\\/" nil t)) (goto-char (point-min)) (while (search-forward "∧" nil t) (replace-match "/\\" nil t)) (goto-char (point-min)) (while (search-forward "≡" nil t) (replace-match "===" nil t)) (goto-char (point-min)) (while (search-forward "⇒" nil t) (replace-match "==>" nil t)) (goto-char (point-min)) (while (search-forward "¬" nil t) (replace-match "~" nil t)) (goto-char (point-min)) (while (search-forward "⇔" nil t) (replace-match "<=>" nil t)) (goto-char (point-min)) (while (search-forward "∀" nil t) (replace-match "!" nil t)) (goto-char (point-min)) (while (search-forward "∃" nil t) (replace-match "?" nil t)) (goto-char (point-min)) (while (search-forward " ⊂ " nil t) (replace-match " SUBSET " nil t)) (goto-char (point-min)) (while (search-forward " ∩ " nil t) (replace-match " INTER " nil t)) (goto-char (point-min)) (while (search-forward " ∪ " nil t) (replace-match " UNION " nil t)) (goto-char (point-min)) (while (search-forward "∅" nil t) (replace-match "{}" nil t)) (goto-char (point-min)) (while (search-forward "≅" nil t) (replace-match "cong" nil t)) (goto-char (point-min)) (while (search-forward " ∈ " nil t) (replace-match " IN " nil t)) (goto-char (point-min)) (while (search-forward " â” " nil t) (replace-match " DIFF " nil t)) (goto-char (point-min)) (while (search-forward " ╪ " nil t) (replace-match " INSERT " nil t)) (goto-char (point-min)) (while (search-forward "α" nil t) (replace-match "alpha" nil t)) (goto-char (point-min)) (while (search-forward "β" nil t) (replace-match "beta" nil t)) (goto-char (point-min)) (while (search-forward "γ" nil t) (replace-match "gamma" nil t)) (goto-char (point-min)) (while (search-forward " ∡ " nil t) (replace-match " angle " nil t)) (goto-char (point-min)) (while (search-forward "(∡ " nil t) (replace-match "(angle " nil t)) (goto-char (point-min)) (while (search-forward " ≢ " nil t) (replace-match " not=== " nil t)) (goto-char (point-min)) (while (search-forward "∉" nil t) (replace-match "NOTIN" nil t)) (goto-char (point-min)) (while (search-forward " ≠ " nil t) (replace-match " neq " nil t)) (goto-char (point-min)) (while (search-forward "λ" nil t) (replace-match "\\" nil t)) (goto-char (point-min)) (while (search-forward "∥" nil t) (replace-match "parallel" nil t)) (goto-char (point-min)) (while (search-forward "θ" nil t) (replace-match "theta" nil t)) (goto-char (point-min)) (while (search-forward "μ" nil t) (replace-match "mu" nil t)) (goto-char (point-min)) (while (search-forward "→" nil t) (replace-match "--->" nil t)) (goto-char (point-min)) (while (search-forward " ∠" nil t) (replace-match " prod " nil t)) (goto-char (point-min)) (while (search-forward " ∘ " nil t) (replace-match " _o_ " nil t)) (goto-char (point-min))) (defun Region-math-fonts-removed-for-HOL-Light (bottom top) "writes the file joe.ml in which the mathematical characters (∀, ∃, ∩,...) of the region of this file are replaced by HOL Light expressions (!, ?, INTER,...), and makes joe.ml the X-selection." (interactive "r") (let ((rebuff (current-buffer))) ;; (save-current-buffer (save-window-excursion (find-file "joe.ml") (goto-char (point-min)) (delete-region (point-min) (point-max)) (insert-buffer-substring rebuff bottom top) (Remove-math-fonts-for-HOL-Light) (goto-char (point-max)) (untabify (point-min) (point-max)) (copy-region-as-kill (point-min) (point-max)) (save-buffer) (kill-buffer "joe.ml")))) (defun File-math-fonts-removed-for-HOL-Light () "writes the file joe.ml in which the mathematical characters (∀, ∃, ∩,...) of this file are replaced by HOL Light expressions (!, ?, INTER,...), and makes joe.ml the X-selection." (interactive) (Region-math-fonts-removed-for-HOL-Light (point-min) (point-max))) ;; Assuming the function key F2 is an unbound prefix key in Emacs, and ;; this code binds the keys ;; F2 i, F2 b (for biconditional) etc ;; to inserting the symbols (sometimes padded with spaces), as indicated: (global-set-key '[f2 73] '(lambda () (interactive) (insert " ⇒ "))) ;; F2 I (global-set-key '[f2 98] '(lambda () (interactive) (insert " ⇔ "))) ;; F2 b (global-set-key '[f2 110] '(lambda () (interactive) (insert "¬"))) ;; F2 n (global-set-key '[f2 111] '(lambda () (interactive) (insert " ∨ "))) ;; F2 o (global-set-key '[f2 97] '(lambda () (interactive) (insert " ∧ "))) ;; F2 a (global-set-key '[f2 102] '(lambda () (interactive) (insert "∀"))) ;; F2 f (global-set-key '[f2 69] '(lambda () (interactive) (insert "∃"))) ;; F2 E (global-set-key '[f2 115] '(lambda () (interactive) (insert " ⊂ "))) ;; F2 s (global-set-key '[f2 105] '(lambda () (interactive) (insert " ∈ "))) ;; F2 i (global-set-key '[f2 86] '(lambda () (interactive) (insert " ∪ "))) ;; F2 V (global-set-key '[f2 65] '(lambda () (interactive) (insert " ∩ "))) ;; F2 A (global-set-key '[f2 99] '(lambda () (interactive) (insert " ≅ "))) ;; F2 c (global-set-key '[f2 101] '(lambda () (interactive) (insert " ≡ "))) ;; F2 e (global-set-key '[f2 78] '(lambda () (interactive) (insert "∅"))) ;; F2 N (global-set-key '[f2 100] '(lambda () (interactive) (insert " â” "))) ;; F2 d (global-set-key '[f2 112] '(lambda () (interactive) (insert " ╪ "))) ;; F2 p (global-set-key '[f2 108] '(lambda () (interactive) (insert "λ"))) ;; F2 l (global-set-key '[f2 109] '(lambda () (interactive) (insert "μ"))) ;; F2 m (global-set-key '[f2 49] '(lambda () (interactive) (insert "α"))) ;; F2 1 (global-set-key '[f2 50] '(lambda () (interactive) (insert "β"))) ;; F2 2 (global-set-key '[f2 51] '(lambda () (interactive) (insert "γ"))) ;; F2 3 (global-set-key '[f2 52] '(lambda () (interactive) (insert "θ"))) ;; F2 4 (global-set-key '[f2 53] '(lambda () (interactive) (insert "φ"))) ;; F2 5 (global-set-key '[f2 125] '(lambda () (interactive) (insert " ≠ " ))) ;; F2 } (global-set-key '[f2 123] '(lambda () (interactive) (insert " ∉ "))) ;; F2 { (global-set-key '[f2 48] '(lambda () (interactive) (insert " ≢ "))) ;; F2 0 (global-set-key '[f2 57] '(lambda () (interactive) (insert "∡ "))) ;; F2 9 (global-set-key '[f2 56] '(lambda () (interactive) (insert " ≇ "))) ;; F2 8 (global-set-key '[f2 55] '(lambda () (interactive) (insert " ∥ "))) ;; F2 7 (global-set-key '[f2 54] '(lambda () (interactive) (insert " ∦ "))) ;; F2 6 (global-set-key '[f2 70] '(lambda () (interactive) (insert " → "))) ;; F2 F (global-set-key '[f2 80] '(lambda () (interactive) (insert " ∠"))) ;; F2 P (global-set-key '[f2 79] '(lambda () (interactive) (insert " ∘ "))) ;; F2 O (global-set-key '[f2 79] '(lambda () (interactive) (insert " ∘ "))) ;; F2 O (global-set-key '[f2 68] '(lambda () (interactive) (insert " â—¼ "))) ;; F2 D ;; Two Emacs functions are useful in this context: ;; (string-to-char "⇒") => 8658 ;; (char-to-string 8660) => "⇔" ;; Here's my low-level system using math symbols in HOL-Light/Miz3 . ;; In the Emacs buffer containing math symbols, type ;; M-x remove-math-fonts-for-HOL-Light ;; and then mouse-paste into a terminal window (or Emacs shell) ;; running ocaml/HOL Light/miz3. The X selection pasted by the mouse ;; is copied to a file joe.ml, which is the original file with the math symbols ;; ∅ etc replaced by into their HOL Light versions {} etc. ;; The command M-x remove-math-fonts-for-HOL-Light will be in the ;; command history, and you can recall it with repeat-complex-command, ;; which I bind to the function key F8 by ;; (global-set-key [f8] 'repeat-complex-command) (setq auto-mode-alist (append `(("ml\\'" . text-mode)) auto-mode-alist)) (add-hook 'text-mode-hook 'turn-off-auto-fill) (add-hook 'text-mode-hook 'turn-on-visual-line-mode) (add-hook 'text-mode-hook (lambda () (setq comment-start "::"))) (setq select-active-regions nil) (setq mouse-drag-copy-region t) (setq x-select-enable-primary t) (setq x-select-enable-clipboard nil) hol-light/RichterHilbertAxiomGeometry/miz3/hol-light-fonts.elc000066400000000000000000000232011303454263000247540ustar00rootroot00000000000000;ELC ;;; Compiled by richter@localhost.localdomain on Wed Feb 19 09:15:30 2014 ;;; from file /home/richter/hol_light/RichterHilbertAxiomGeometry/miz3/hol-light-fonts.el ;;; in Emacs version 24.2.1 ;;; with all optimizations. ;;; This file contains utf-8 non-ASCII characters, ;;; and so cannot be loaded into Emacs 22 or earlier. (and (boundp 'emacs-version) (< (aref emacs-version (1- (length emacs-version))) ?A) (string-lessp emacs-version "23") (error "`%s' was compiled for Emacs 23 or later" load-file-name)) ;;;;;;;;;;;;;;;;; #@120 replace HOL Light expressions (!, ?, INTER,...) with mathematical characters (∀, ∃, ∩,...) in the entire buffer. (defalias 'Math-fonts-for-HOL-Light #[nil "`\302eb\210\303\304\302\305#\203\306\307\302\305#\210\202eb\210\303\310\302\305#\203,\306\311\302\305#\210\202eb\210\303\312\302\305#\203@\306\313\302\305#\210\202/eb\210\303\314\302\305#\203T\306\315\302\305#\210\202Ceb\210\303\316\302\305#\203h\306\317\302\305#\210\202Web\210\303\320\302\305#\203|\306\321\302\305#\210\202keb\210\303\322\302\305#\203\220\306\323\302\305#\210\202eb\210\303\324\302\305#\203\244\306\325\302\305#\210\202\223eb\210\303\326\302\305#\203\270\306\327\302\305#\210\202\247eb\210\303\330\302\305#\203\314\306\331\302\305#\210\202\273eb\210\303\332\302\305#\203\340\306\333\302\305#\210\202\317eb\210\303\334\302\305#\203\364\306\335\302\305#\210\202\343eb\210\303\336\302\305#\203\306\337\302\305#\210\202\367eb\210\303\340\302\305#\203\306\341\302\305#\210\202 eb\210\303\342\302\305#\2030\306\343\302\305#\210\202eb\210\303\344\302\305#\203D\306\345\302\305#\210\2023eb\210\303\346\302\305#\203X\306\347\302\305#\210\202Geb\210\303\350\302\305#\203l\306\351\302\305#\210\202[eb\210\303\352\302\305#\203\200\306\353\302\305#\210\202oeb\210\303\354\302\305#\203\224\306\355\302\305#\210\202\203eb\210\303\356\302\305#\203\250\306\357\302\305#\210\202\227eb\210\303\360\302\305#\203\274\306\361\302\305#\210\202\253eb\210\303\362\302\305#\203\320\306\363\302\305#\210\202\277eb\210\303\364\302\305#\203\344\306\365\302\305#\210\202\323eb\210\303\366\302\305#\203\370\306\367\302\305#\210\202\347eb\210\303\370\302\305#\203\f\306\371\302\305#\210\202\373eb\210\303\372\302\305#\203 \306\373\302\305#\210\202eb\210\303\374\302\305#\2034\306\375\302\305#\210\202#eb\210\303\376\302\305#\203H\306\377\302\305#\210\2027eb\210\303\201@\302\305#\203`\306\201A\302\305#\210\202Keb\210\303\201B\302\305#\203x\306\201C\302\305#\210\202ceb\210\303\201D\302\305#\203\220\306\201E\302\305#\210\202{eb\210\303\201F\302\305#\203\250\306\201G\302\305#\210\202\223eb\210\303\201H\302\305#\203\300\306\201I\302\305#\210\202\253eb\210\303\201J\302\305#\203\330\306\201K\302\305#\210\202\303eb\210\303\201L\302\305#\203\360\306\201M\302\305#\210\202\333b)\207" [start case-fold-search nil search-forward "\\/" t replace-match "∨" "/\\" "∧" "===" "≡" "==>" "⇒" "~" "¬" "<=>" "⇔" "!" "∀" "?" "∃" "∃∀" "∃!" " SUBSET " " ⊂ " " SUBSET\n" " ⊂\n" " INTER " " ∩ " " INTER\n" " ∩\n" " UNION " " ∪ " " UNION\n" " ∪\n" "{}" "∅" "cong" "≅" " IN " " ∈ " " DIFF " " â” " " DIFF\n" " â”\n" " INSERT " " ╪ " "alpha" "α" "beta" "β" "gamma" "γ" " angle " " ∡ " "(angle " "(∡ " "not===" " ≢ " "NOTIN" "∉" "neq" " ≠ " "\\" "λ" "parallel" "∥" "theta" "θ" "mu" "μ" "--->" "→" " prod " " ∠" " _o_ " " ∘ "] 4 (#$ . 562) nil]) #@99 replace mathematical characters (∀, ∃, ∩,...) with HOL Light expressions (!, ?, INTER,...). (defalias 'Remove-math-fonts-for-HOL-Light #[nil "\301\302ed\"\210eb\210\303\304\301\305#\203\306\307\301\305#\210\202\neb\210\303\310\301\305#\203/\306\311\301\305#\210\202eb\210\303\312\301\305#\203C\306\313\301\305#\210\2022eb\210\303\314\301\305#\203W\306\315\301\305#\210\202Feb\210\303\316\301\305#\203k\306\317\301\305#\210\202Zeb\210\303\320\301\305#\203\306\321\301\305#\210\202neb\210\303\322\301\305#\203\223\306\323\301\305#\210\202\202eb\210\303\324\301\305#\203\247\306\325\301\305#\210\202\226eb\210\303\326\301\305#\203\273\306\327\301\305#\210\202\252eb\210\303\330\301\305#\203\317\306\331\301\305#\210\202\276eb\210\303\332\301\305#\203\343\306\333\301\305#\210\202\322eb\210\303\334\301\305#\203\367\306\335\301\305#\210\202\346eb\210\303\336\301\305#\203 \306\337\301\305#\210\202\372eb\210\303\340\301\305#\203\306\341\301\305#\210\202eb\210\303\342\301\305#\2033\306\343\301\305#\210\202\"eb\210\303\344\301\305#\203G\306\345\301\305#\210\2026eb\210\303\346\301\305#\203[\306\347\301\305#\210\202Jeb\210\303\350\301\305#\203o\306\351\301\305#\210\202^eb\210\303\352\301\305#\203\203\306\353\301\305#\210\202reb\210\303\354\301\305#\203\227\306\355\301\305#\210\202\206eb\210\303\356\301\305#\203\253\306\357\301\305#\210\202\232eb\210\303\360\301\305#\203\277\306\361\301\305#\210\202\256eb\210\303\362\301\305#\203\323\306\363\301\305#\210\202\302eb\210\303\364\301\305#\203\347\306\365\301\305#\210\202\326eb\210\303\366\301\305#\203\373\306\367\301\305#\210\202\352eb\210\303\370\301\305#\203\306\371\301\305#\210\202\376eb\210\303\372\301\305#\203#\306\373\301\305#\210\202eb\210\303\374\301\305#\2037\306\375\301\305#\210\202&eb\210\303\376\301\305#\203K\306\377\301\305#\210\202:eb\210\303\201@\301\305#\203c\306\201A\301\305#\210\202Neb\210\303\201B\301\305#\203{\306\201C\301\305#\210\202feb\207" [case-fold-search nil untabify search-forward "∨" t replace-match "\\/" "∧" "/\\" "≡" "===" "⇒" "==>" "¬" "~" "⇔" "<=>" "∀" "!" "∃" "?" " ⊂ " " SUBSET " " ∩ " " INTER " " ∪ " " UNION " "∅" "{}" "≅" "cong" " ∈ " " IN " " â” " " DIFF " " ╪ " " INSERT " "α" "alpha" "β" "beta" "γ" "gamma" " ∡ " " angle " "(∡ " "(angle " " ≢ " " not=== " "∉" "NOTIN" " ≠ " " neq " "λ" "\\" "∥" "parallel" "θ" "theta" "μ" "mu" "→" "--->" " ∠" " prod " " ∘ " " _o_ "] 4 (#$ . 3505) nil]) #@199 writes the file joe.ml in which the mathematical characters (∀, ∃, ∩,...) of the region of this file are replaced by HOL Light expressions (!, ?, INTER,...), and makes joe.ml the X-selection. (defalias 'Region-math-fonts-removed-for-HOL-Light #[(bottom top) "p\304 \305\216\306\307!\210eb\210ed|\210\310\n #\210\311 \210db\210\312ed\"\210\313ed\"\210\314 \210\315\307!+\207" [rebuff #1=#:wconfig bottom top current-window-configuration ((set-window-configuration #1#)) find-file "joe.ml" insert-buffer-substring Remove-math-fonts-for-HOL-Light untabify copy-region-as-kill save-buffer kill-buffer] 4 (#$ . 6033) "r"]) #@185 writes the file joe.ml in which the mathematical characters (∀, ∃, ∩,...) of this file are replaced by HOL Light expressions (!, ?, INTER,...), and makes joe.ml the X-selection. (defalias 'File-math-fonts-removed-for-HOL-Light #[nil "\300ed\"\207" [Region-math-fonts-removed-for-HOL-Light] 3 (#$ . 6667) nil]) (byte-code "\305\306\307\"\210\305\310\311\"\210\305\312\313\"\210\305\314\315\"\210\305\316\317\"\210\305\320\321\"\210\305\322\323\"\210\305\324\325\"\210\305\326\327\"\210\305\330\331\"\210\305\332\333\"\210\305\334\335\"\210\305\336\337\"\210\305\340\341\"\210\305\342\343\"\210\305\344\345\"\210\305\346\347\"\210\305\350\351\"\210\305\352\353\"\210\305\354\355\"\210\305\356\357\"\210\305\360\361\"\210\305\362\363\"\210\305\364\365\"\210\305\366\367\"\210\305\370\371\"\210\305\372\373\"\210\305\374\375\"\210\305\376\377\"\210\305\201@\201A\"\210\305\201B\201C\"\210\305\201D\201E\"\210\305\201F\201G\"\210\305\201H\201I\"\210\305\201J\201K\"\210\201L\201M\"\201N\201O\201P\"\210\201N\201O\201Q\"\210\201N\201O\201R\"\210\201S\201T\211\201S\211\207" [auto-mode-alist select-active-regions mouse-drag-copy-region x-select-enable-primary x-select-enable-clipboard global-set-key [f2 73] (lambda nil (interactive) (insert " ⇒ ")) [f2 98] (lambda nil (interactive) (insert " ⇔ ")) [f2 110] (lambda nil (interactive) (insert "¬")) [f2 111] (lambda nil (interactive) (insert " ∨ ")) [f2 97] (lambda nil (interactive) (insert " ∧ ")) [f2 102] (lambda nil (interactive) (insert "∀")) [f2 69] (lambda nil (interactive) (insert "∃")) [f2 115] (lambda nil (interactive) (insert " ⊂ ")) [f2 105] (lambda nil (interactive) (insert " ∈ ")) [f2 86] (lambda nil (interactive) (insert " ∪ ")) [f2 65] (lambda nil (interactive) (insert " ∩ ")) [f2 99] (lambda nil (interactive) (insert " ≅ ")) [f2 101] (lambda nil (interactive) (insert " ≡ ")) [f2 78] (lambda nil (interactive) (insert "∅")) [f2 100] (lambda nil (interactive) (insert " â” ")) [f2 112] (lambda nil (interactive) (insert " ╪ ")) [f2 108] (lambda nil (interactive) (insert "λ")) [f2 109] (lambda nil (interactive) (insert "μ")) [f2 49] (lambda nil (interactive) (insert "α")) [f2 50] (lambda nil (interactive) (insert "β")) [f2 51] (lambda nil (interactive) (insert "γ")) [f2 52] (lambda nil (interactive) (insert "θ")) [f2 53] (lambda nil (interactive) (insert "φ")) [f2 125] (lambda nil (interactive) (insert " ≠ ")) [f2 123] (lambda nil (interactive) (insert " ∉ ")) [f2 48] (lambda nil (interactive) (insert " ≢ ")) [f2 57] (lambda nil (interactive) (insert "∡ ")) [f2 56] (lambda nil (interactive) (insert " ≇ ")) [f2 55] (lambda nil (interactive) (insert " ∥ ")) [f2 54] (lambda nil (interactive) (insert " ∦ ")) [f2 70] (lambda nil (interactive) (insert " → ")) [f2 80] (lambda nil (interactive) (insert " ∠")) [f2 79] (lambda nil (interactive) (insert " ∘ ")) [f2 79] (lambda nil (interactive) (insert " ∘ ")) [f2 68] (lambda nil (interactive) (insert " â—¼ ")) append (("ml\\'" . text-mode)) add-hook text-mode-hook turn-off-auto-fill turn-on-visual-line-mode #[nil "\301\211\207" [comment-start "::"] 2] nil t] 4) hol-light/RichterHilbertAxiomGeometry/miz3/make.ml000066400000000000000000000002001303454263000225120ustar00rootroot00000000000000#load "unix.cma";; loadt "miz3/miz3.ml";; loadt "RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml";; hol-light/RichterHilbertAxiomGeometry/readable.ml000066400000000000000000001040031303454263000224600ustar00rootroot00000000000000(* ========================================================================= *) (* Miz3 interface for readable HOL Light tactics formal proofs *) (* *) (* (c) Copyright, Bill Richter 2013 *) (* Distributed under the same license as HOL Light *) (* *) (* The primary meaning of readability is explained in the HOL Light tutorial *) (* on page 81 after the proof of NSQRT_2 (ported below), *) (* "We would like to claim that this proof can be read in isolation, without *) (* running it in HOL. For each step, every fact we used is clearly labelled *) (* somewhere else in the proof, and every assumption is given explicitly." *) (* However readability is often improved by using tactics constructs like *) (* SIMP_TAC and MATCH_MP_TAC, which allow facts and assumptions to not be *) (* given explicitly, so as to not lose sight of the proof. Readability is *) (* improved by a miz3 interface with few type annotations, back-quotes or *) (* double-quotes, and allowing HOL4/Isabelle math characters, e.g. *) (* ⇒ ⇔ ∧ ∨ ¬ ∀ ∃ ∈ ∉ α β γ λ θ μ ⊂ ∩ ∪ ∅ ┠≡ ≅ ∡ ∥ ∠∘ → ╪ . *) (* We use ideas for readable formal proofs due to John Harrison ("Towards *) (* more readable proofs" of the tutorial and Examples/mizar.ml), Freek *) (* Wiedijk (Mizarlight/miz2a.ml, miz3/miz3.ml and arxiv.org/pdf/1201.3601 *) (* "A Synthesis of Procedural and Declarative Styles of Interactive *) (* Theorem Proving"), Marco Maggesi (author of tactic constructs *) (* INTRO_TAC, DESTRUCT_TAC & HYP), Petros Papapanagiotou (coauthor of *) (* Isabelle Light), Vincent Aravantinos (author of the Q-module *) (* https://github.com/aravantv/HOL-Light-Q) and Mark Adams (author of HOL *) (* Zero and Tactician). These readability ideas yield the miz3-type *) (* declarative constructs assume, consider and case_split. The semantics of *) (* readable.ml is clear from an obvious translation to HOL Light proofs. An *) (* interactive mode is useful in writing, debugging and displaying proofs. *) (* *) (* The construct "case_split" reducing the goal to various cases given by *) (* "suppose" clauses. The construct "proof" [...] "qed" allows arbitrarily *) (* long proofs, which can be arbitrarily nested with other case_split and *) (* proof/qed constructs. THENL is only implemented implicitly in case_split *) (* (also eq_tac and conj_tac), and this requires adjustments, such as using *) (* MATCH_MP_TAC num_INDUCTION instead of INDUCT_TAC. *) (* ========================================================================= *) (* The Str library defines regexp functions needed to process strings. *) #load "str.cma";; (* parse_qproof uses system.ml quotexpander feature designed for miz3.ml to *) (* turn backquoted expression `;[...]` into a string with no newline or *) (* backslash problems. Note that miz3.ml defines parse_qproof differently. *) let parse_qproof s = (String.sub s 1 (String.length s - 1));; (* Allows HOL4 and Isabelle style math characters. *) let CleanMathFontsForHOL_Light s = let rec clean s loStringPairs = match loStringPairs with | [] -> s | hd :: tl -> let s = Str.global_replace (Str.regexp (fst hd)) (snd hd) s in clean s tl in clean s ["⇒","==>"; "⇔","<=>"; "∧","/\\ "; "∨","\\/"; "¬","~"; "∀","!"; "∃","?"; "∈","IN"; "∉","NOTIN"; "α","alpha"; "β","beta"; "γ","gamma"; "λ","\\ "; "θ","theta"; "μ","mu"; "⊂","SUBSET"; "∩","INTER"; "∪","UNION"; "∅","{}"; "â”","DIFF"; "≡","==="; "≅","cong"; "∡","angle"; "∥","parallel"; "âˆ","prod"; "∘","_o_"; "→","--->"; "╪","INSERT"; "≃", "TarskiCong"; "≊", "TarskiTriangleCong"; "ℬ", "TarskiBetween"];; (* printReadExn prints uncluttered error messages via Readable_fail. This *) (* is due to Mark Adams, who also explained Roland Zumkeller's exec below. *) exception Readable_fail of string;; let printReadExn e = match e with | Readable_fail s -> print_string s | _ -> print_string (Printexc.to_string e);; #install_printer printReadExn;; (* From update_database.ml: Execute any OCaml expression given as a string. *) let exec = ignore o Toploop.execute_phrase false Format.std_formatter o !Toploop.parse_toplevel_phrase o Lexing.from_string;; (* Following miz3.ml, exec_thm returns the theorem representing a string, so *) (* exec_thm "FORALL_PAIR_THM";; returns *) (* val it : thm = |- !P. (!p. P p) <=> (!p1 p2. P (p1,p2)) *) (* Extra error-checking is done to rule out the possibility of the theorem *) (* string ending with a semicolon. *) let thm_ref = ref TRUTH;; let tactic_ref = ref ALL_TAC;; let thmtactic_ref = ref MATCH_MP_TAC;; let thmlist_tactic_ref = ref REWRITE_TAC;; let termlist_thm_thm_ref = ref SPECL;; let thm_thm_ref = ref GSYM;; let term_thm_ref = ref ARITH_RULE;; let thmlist_term_thm_ref = ref MESON;; let exec_thm s = if Str.string_match (Str.regexp "[^;]*;") s 0 then raise Noparse else try exec ("thm_ref := (("^ s ^"): thm);;"); !thm_ref with _ -> raise Noparse;; let exec_tactic s = try exec ("tactic_ref := (("^ s ^"): tactic);;"); !tactic_ref with _ -> raise Noparse;; let exec_thmlist_tactic s = try exec ("thmlist_tactic_ref := (("^ s ^"): thm list -> tactic);;"); !thmlist_tactic_ref with _ -> raise Noparse;; let exec_thmtactic s = try exec ("thmtactic_ref := (("^ s ^"): thm -> tactic);;"); !thmtactic_ref with _ -> raise Noparse;; let exec_termlist_thm_thm s = try exec ("termlist_thm_thm_ref := (("^ s ^"): (term list -> thm -> thm));;"); !termlist_thm_thm_ref with _ -> raise Noparse;; let exec_thm_thm s = try exec ("thm_thm_ref := (("^ s ^"): (thm -> thm));;"); !thm_thm_ref with _ -> raise Noparse;; let exec_term_thm s = try exec ("term_thm_ref := (("^ s ^"): (term -> thm));;"); !term_thm_ref with _ -> raise Noparse;; let exec_thmlist_term_thm s = try exec ("thmlist_term_thm_ref := (("^ s ^"): (thm list ->term -> thm));;"); !thmlist_term_thm_ref with _ -> raise Noparse;; (* make_env and parse_env_string (following parse_term from parser.ml, *) (* Mizarlight/miz2a.ml and https://github.com/aravantv/HOL-Light-Q) turn a *) (* string into a term with types inferred by the goal and assumption list. *) let (make_env: goal -> (string * pretype) list) = fun (asl, w) -> map ((fun (s, ty) -> (s, pretype_of_type ty)) o dest_var) (freesl (w::(map (concl o snd) asl)));; let parse_env_string env s = let (ptm, l) = (parse_preterm o lex o explode) s in if l = [] then (term_of_preterm o retypecheck env) ptm else raise (Readable_fail ("Unparsed input at the end of the term\n" ^ s));; (* versions of new_constant, parse_as_infix, new_definition and new_axiom *) let NewConstant (x, y) = new_constant(CleanMathFontsForHOL_Light x, y);; let ParseAsInfix (x, y) = parse_as_infix (CleanMathFontsForHOL_Light x, y);; let NewDefinition s = new_definition (parse_env_string [] (CleanMathFontsForHOL_Light s));; let NewAxiom s = new_axiom (parse_env_string [] (CleanMathFontsForHOL_Light s));; (* String versions without type annotations of SUBGOAL_THEN, SUBGOAL_TAC, *) (* intro_TAC, EXISTS_TAC, X_GEN_TAC, and EXISTS_TAC, and also new miz3-type *) (* tactic constructs assume, consider and case_split. *) (* subgoal_THEN stm ttac gl = (SUBGOAL_THEN t ttac) gl, *) (* where stm is a string that turned into a statement t by make_env and *) (* parse_env_string, using the goal gl. We call stm a string statement. *) (* ttac is often the thm_tactic (LABEL_TAC string) or (DESTRUCT_TAC string). *) let subgoal_THEN stm ttac gl = SUBGOAL_THEN (parse_env_string (make_env gl) stm) ttac gl;; (* subgoal_TAC stm lab tac gl = (SUBGOAL_TAC lab t [tac]) gl, *) (* exists_TAC stm gl = (EXISTS_TAC t) gl, and *) (* X_gen_TAC svar gl = (X_GEN_TAC v) gl, where *) (* stm is a string statement which is turned into a statement t by make_env, *) (* parse_env_string and the goal gl. Similarly string svar is turned into a *) (* variable v. *) (* X_genl_TAC combines X_gen_TAC and GENL. Since below in StepToTactic the *) (* string-term list uses whitespace as the delimiter and no braces, there is *) (* no reason in readable.ml proofs to use X_gen_TAC instead X_genl_TAC. *) (* intro_TAC is INTRO_TAC with the delimiter ";" replaced with",". *) (* eq_tac string tac *) (* requires the goal to be an iff statement of the form x ⇔ y and then *) (* performs an EQ_TAC. If string = "Right", then the tactic tac proves the *) (* implication y ⇒ x, and the goal becomes the other implication x ⇒ y. *) (* If string = "Left", then tac proves x ⇒ y and the goal becomes y ⇒ x. *) (* conj_tac string tac *) (* requires the goal to be a conjunction statement x ∧ y and then performs a *) (* CONJ_TAC. If string = "Left" then the tactic tac proves x, and the goal *) (* becomes y. If string = "Right", tac proves y and the new goal is x. *) (* consider svars stm lab tac *) (* defines new variables given by the string svars = "v1 v2 ... vn" and the *) (* string statement stm, which subgoal_THEN turns into statement t, labeled *) (* by lab. The tactic tac proves the existential statement ?v1 ... vn. t. *) (* case_split sDestruct tac listofDisj listofTac *) (* reduces the goal to n cases which are solved separately. listofDisj is a *) (* list of strings [st_1;...; st_n] whose disjunction st_1 \/...\/ st_n is a *) (* string statement proved by tactic tac. listofTac is a list of tactics *) (* [tac_1;...; tac_n] which prove the statements st_1,..., st_n. The string *) (* sDestruct must have the form "lab_1 |...| lab_n", and lab_i is a label *) (* used by tac_i to prove st_i. Each lab_i must be a nonempty string. *) (* assume *) (* is a version of ASM_CASES_TAC, and performs proofs by contradiction and *) (* binary case_splits where one of the forks has a short proof. In general, *) (* assume statement lab tac *) (* turns the string statement into a term t, with the tactic tac a proof of *) (* ¬t ⇒ w, where w is the goal. There is a new assumption t labeled lab, and *) (* the new goal is the result of applying the tactic SIMP_TAC [t] to w. *) (* It's recommended to only use assume with a short proof tac. Three uses *) (* of assume arise when t = ¬w or t = ¬α, with w = α ∨ β or w = β ∨ α. *) (* In all three cases write *) (* assume statement [lab] by fol; *) (* and the new goal will be F (false) or β respectively, as a result of the *) (* SIMP_TAC [t]. So do not use assume if SIMP_TAC [t] is disadvantageous. *) let subgoal_TAC stm lab tac gl = SUBGOAL_TAC lab (parse_env_string (make_env gl) stm) [tac] gl;; let exists_TAC stm gl = EXISTS_TAC (parse_env_string (make_env gl) stm) gl;; let X_gen_TAC svar (asl, w as gl) = let vartype = (snd o dest_var o fst o dest_forall) w in X_GEN_TAC (mk_var (svar, vartype)) gl;; let X_genl_TAC svarlist = MAP_EVERY X_gen_TAC svarlist;; let intro_TAC s = INTRO_TAC (Str.global_replace (Str.regexp ",") ";" s);; let assume statement lab tac (asl, w as gl) = let t = parse_env_string (make_env gl) statement in (DISJ_CASES_THEN (LABEL_TAC lab) (SPEC t EXCLUDED_MIDDLE) THENL [ALL_TAC; FIRST_ASSUM MP_TAC THEN tac] THEN HYP SIMP_TAC lab []) gl;; let eq_tac string tac = if string = "Right" then CONV_TAC SYM_CONV THEN EQ_TAC THENL [tac; ALL_TAC] else if string = "Left" then EQ_TAC THENL [tac; ALL_TAC] else raise (Readable_fail ("eq_tac requires " ^ string ^" to be either Left or Right"));; let conj_tac string tac = if string = "Right" then ONCE_REWRITE_TAC [CONJ_SYM] THEN CONJ_TAC THENL [tac; ALL_TAC] else if string = "Left" then CONJ_TAC THENL [tac; ALL_TAC] else raise (Readable_fail ("conj_tac requires " ^ string ^" to be either Left or Right"));; let consider svars stm lab tac = subgoal_THEN ("?"^ svars ^ ". "^ stm) (DESTRUCT_TAC ("@"^ svars ^ "."^ lab)) THENL [tac; ALL_TAC];; let case_split sDestruct tac listofDisj listofTac = let disjunction = itlist (fun s t -> if t = "" then "("^ s ^")" else "("^ s ^") \\/ "^ t) listofDisj "" in subgoal_TAC disjunction "" tac THEN FIRST_X_ASSUM (DESTRUCT_TAC sDestruct) THENL listofTac;; (* Following the HOL Light tutorial section "Towards more readable proofs." *) let fol = MESON_TAC;; let rewrite = REWRITE_TAC;; let simplify = SIMP_TAC;; let set = SET_TAC;; let rewriteR = GEN_REWRITE_TAC (RAND_CONV);; let rewriteL = GEN_REWRITE_TAC (LAND_CONV);; let rewriteI = GEN_REWRITE_TAC I;; let rewriteRLDepth = GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o DEPTH_CONV);; let TACtoThmTactic tac = fun ths -> MAP_EVERY MP_TAC ths THEN tac;; let arithmetic = TACtoThmTactic ARITH_TAC;; let real_arithmetic = TACtoThmTactic REAL_ARITH_TAC;; let num_ring = TACtoThmTactic (CONV_TAC NUM_RING);; let real_ring = TACtoThmTactic (CONV_TAC REAL_RING);; let ws = "[ \t\n]+";; let ws0 = "[ \t\n]*";; let StringRegexpEqual r s = Str.string_match r s 0 && s = Str.matched_string s;; (* FindMatch sleft sright s *) (* turns strings sleft and sright into regexps, recursively searches string *) (* s for matched pairs of substrings matching sleft and sright, and returns *) (* the position after the first substring matched by sright which is not *) (* paired with an sleft-matching substring. Often here sleft ends with *) (* whitespace (ws) while sright begins with ws. The "degenerate" case of *) (* X^ws^Y where X^ws matches sleft and ws^Y matches sright is handled by *) (* backing up a character after an sleft match if the last character is ws. *) let FindMatch sleft sright s = let test = Str.regexp ("\("^ sleft ^"\|"^ sright ^"\)") and left = Str.regexp sleft in let rec FindMatchPosition s count = if count = 1 then 0 else try ignore(Str.search_forward test s 0); let TestMatch = Str.matched_group 1 s and AfterTest = Str.match_end() in let LastChar = Str.last_chars (Str.string_before s AfterTest) 1 in let endpos = if Str.string_match (Str.regexp ws) LastChar 0 then AfterTest - 1 else AfterTest in let rest = Str.string_after s endpos and increment = if StringRegexpEqual left TestMatch then -1 else 1 in endpos + (FindMatchPosition rest (count + increment)) with Not_found -> raise (Readable_fail ("No matching right bracket operator "^ sright ^ " to left bracket operator "^ sleft ^" in "^ s)) in FindMatchPosition s 0;; (* FindSemicolon uses FindMatch to find the position before the next *) (* semicolon which is not a delimiter of a list. *) let rec FindSemicolon s = try let rec FindMatchPosition s pos = let start = Str.search_forward (Str.regexp ";\|\[") s pos in if Str.matched_string s = ";" then start else let rest = Str.string_after s (start + 1) in let MatchingSquareBrace = FindMatch "\[" "\]" rest in let newpos = start + 1 + MatchingSquareBrace in FindMatchPosition s newpos in FindMatchPosition s 0 with Not_found -> raise (Readable_fail ("No final semicolon in "^ s));; (* FindCases uses FindMatch to take a string *) (* "suppose" proof_1 "end;" ... "suppose" proof_n "end;" *) (* and return the list [proof_1; proof_2; ... ; proof_n]. *) let rec FindCases s = let sleftCase, srightCase = ws^ "suppose"^ws, ws^ "end" ^ws0^ ";" in if Str.string_match (Str.regexp sleftCase) s 0 then let CaseEndRest = Str.string_after s (Str.match_end()) in let PosAfterEnd = FindMatch sleftCase srightCase CaseEndRest in let pos = Str.search_backward (Str.regexp srightCase) CaseEndRest PosAfterEnd in let case = Str.string_before CaseEndRest pos and rest = Str.string_after CaseEndRest PosAfterEnd in case :: (FindCases rest) else [];; (* StringToList uses FindSemicolon to turns a string into the list of *) (* substrings delimited by the semicolons which are not captured in lists. *) let rec StringToList s = if StringRegexpEqual (Str.regexp ws0) s then [] else if Str.string_match (Str.regexp "[^;]*;") s 0 then let pos = FindSemicolon s in let head = Str.string_before s pos in head :: (StringToList (Str.string_after s (pos + 1))) else [s];; (* ExtractWsStringList string = (["l1"; "l2"; ...; "ln"], rest), *) (* if string = ws ^ "[l1; l2; ...; ln]" ^ rest. Raises Not_found otherwise. *) let ExtractWsStringList string = if Str.string_match (Str.regexp (ws^ "\[")) string 0 then let listRest = Str.string_after string (Str.match_end()) in let RightBrace = FindMatch "\[" "\]" listRest in let rest = Str.string_after listRest RightBrace and list = Str.string_before listRest (RightBrace - 1) in (StringToList list, rest) else raise Not_found;; (* theoremify string goal returns a pair (thm, rest), *) (* where thm is the first theorem found on string, using goal if needed, and *) (* rest is the remainder of string. Theoremify uses 3 helping functions: *) (* 1) CombTermThm_Term, which produces a combination of a term->thm *) (* (e.g. ARITH_RULE) with a term, *) (* 2) CombThmlistTermThm_Thmlist_Term, which combines a thmlist->term->thm *) (* (e.g. MESON) with a thmlist and a term, and *) (* 3) CombTermlistThmThm_Termlist, which combines a termlist->thm->thm *) (* (e.g. SPECL) with a termlist and a thm produced by theoremify. *) (* Similar functions CombThmtactic_Thm and CombThmlisttactic_Thmlist are *) (* used below, along with theoremify, by StringToTactic. *) let CombTermThm_Term word rest gl = let TermThm = exec_term_thm word in try let (stermlist, wsRest) = ExtractWsStringList rest in if length stermlist = 1 then let term = (parse_env_string (make_env gl)) (hd stermlist) in (TermThm term, wsRest) else raise (Readable_fail ("term->thm "^ word ^" not followed by length 1 term list, but instead the list \n["^ String.concat ";" stermlist ^"]")) with Not_found -> raise (Readable_fail ("term->thm "^ word ^" not followed by term list, but instead \n"^ rest));; let rec theoremify string gl = if Str.string_match (Str.regexp (ws^ "\([^][ \t\n]+\)")) string 0 then let word = Str.matched_group 1 string and rest = Str.string_after string (Str.match_end()) in if word = "-" then (snd (hd (fst gl)), rest) else try (exec_thm word, rest) with _ -> try (assoc word (fst gl), rest) with _ -> try firstPairMult (exec_thm_thm word) (theoremify rest gl) with _ -> try CombTermThm_Term word rest gl with Noparse -> try CombThmlistTermThm_Thmlist_Term word rest gl with Noparse -> try CombTermlistThmThm_Termlist word rest gl with Noparse -> raise (Readable_fail ("Not a theorem:\n"^ string)) else raise (Readable_fail ("Empty theorem:\n"^ string)) and firstPairMult f (a, b) = (f a, b) and CombTermlistThmThm_Termlist word rest gl = let TermlistThmThm = exec_termlist_thm_thm word in try let (stermlist, WsThm) = ExtractWsStringList rest in let termlist = map (parse_env_string (make_env gl)) stermlist in firstPairMult (TermlistThmThm termlist) (theoremify WsThm gl) with Not_found -> raise (Readable_fail ("termlist->thm->thm "^ word ^"\n not followed by term list in\n"^ rest)) and CombThmlistTermThm_Thmlist_Term word rest gl = let thm_create sthm = let (thm, rest) = theoremify (" "^ sthm) gl in if rest = "" then thm else raise (Readable_fail ("an argument of thmlist->term->thm "^ word ^ "\n is not a theorem, but instead \n"^ sthm)) in let ThmlistTermThm = exec_thmlist_term_thm word in try let (stermlist, wsTermRest) = ExtractWsStringList rest in let thmlist = map thm_create stermlist in if Str.string_match (Str.regexp (ws^ "\[")) wsTermRest 0 then let termRest = Str.string_after wsTermRest (Str.match_end()) in let RightBrace = FindMatch "\[" "\]" termRest in let rest = Str.string_after termRest RightBrace and sterm = Str.string_before termRest (RightBrace - 1) in let term = parse_env_string (make_env gl) sterm in (ThmlistTermThm thmlist term, rest) else raise (Readable_fail ("thmlist->term->thm "^ word ^" followed by list of theorems ["^ String.concat ";" stermlist ^"] not followed by term in\n"^ wsTermRest)) with Not_found -> raise (Readable_fail ("thmlist->term->thm "^ word ^" not followed by thm list in\n"^ rest));; let CombThmtactic_Thm step = if Str.string_match (Str.regexp (ws^ "\([a-zA-Z0-9_]+\)")) step 0 then let sthm_tactic = Str.matched_group 1 step and sthm = Str.string_after step (Str.match_end()) in let thm_tactic = exec_thmtactic sthm_tactic in fun gl -> let (thm, rest) = theoremify sthm gl in if rest = "" then thm_tactic thm gl else raise (Readable_fail ("thm_tactic "^ sthm_tactic ^" not followed by a theorem, but instead\n"^ sthm)) else raise Not_found;; let CombThmlisttactic_Thmlist step = let rec makeThmListAccum string list gl = if StringRegexpEqual (Str.regexp ws0) string then list else let (thm, rest) = theoremify string gl in makeThmListAccum rest (thm :: list) gl in if Str.string_match (Str.regexp (ws^ "\([a-zA-Z0-9_]+\)")) step 0 then let ttac = exec_thmlist_tactic (Str.matched_group 1 step) and LabThmString = Str.string_after step (Str.match_end()) in fun gl -> let LabThmList = List.rev (makeThmListAccum LabThmString [] gl) in ttac LabThmList gl else raise Not_found;; (* StringToTactic uses regexp functions from the Str library to transform a *) (* string into a tactic. The allowable tactics are written in BNF form as *) (* *) (* Tactic := ALL_TAC | Tactic THEN Tactic | thm->tactic Thm | *) (* one-word-tactic (e.g. ARITH_TAC) | thmlist->tactic Thm-list | *) (* intro_TAC string | exists_TAC term | X_genl_TAC term-list | *) (* case_split string Tactic statement-list Tactic-list | *) (* consider variable-list statement label Tactic | *) (* eq_tac (Right | Left) Tactic | conj_tac (Right | Left) Tactic | *) (* (assume | subgoal_TAC) statement label Tactic *) (* *) (* Thm := theorem-name | label | - [i.e. last assumption] | thm->thm Thm | *) (* term->thm term | thmlist->term->thm Thm-list term | *) (* termlist->thm->thm term-list Thm *) (* *) (* The string proofs allowed by StringToTactic are written in BNF form as *) (* *) (* Proof := Proof THEN Proof | case_split destruct_string ByProofQed *) (* suppose statement; Proof end; ... suppose statement; Proof end; | *) (* OneStepProof; | consider variable-list statement [label] ByProofQed | *) (* eq_tac [Right|Left] ByProofQed | conj_tac [Right|Left] ByProofQed | *) (* (assume | ) statement [label] ByProofQed *) (* *) (* OneStepProof := one-word-tactic | thm->tactic Thm | intro_TAC string | *) (* exists_TAC term-string | X_genl_TAC variable-string-list | *) (* thmlist->tactic Thm-list *) (* *) (* ByProofQed := by OneStepProof; | proof Proof Proof ... Proof qed; *) (* *) (* theorem is a version of prove based on the miz3.ml thm, with argument *) (* statement ByProofQed *) (* *) (* Miz3-style comments are supported. If a line contains ::, then the *) (* substring of the line beginning with :: is ignored by StringToTactic. *) let rec StringToTactic s = let s = Str.global_replace (Str.regexp "::[^\n]*") "" s in if StringRegexpEqual (Str.regexp ws0) s then ALL_TAC else try makeCaseSplit s with _ -> let pos = FindSemicolon s in let step, rest = Str.string_before s pos, Str.string_after s (pos + 1) in try let tactic = StepToTactic step in tactic THEN StringToTactic rest with Not_found -> let (tactic, rest) = BigStepToTactic s step in tactic THEN StringToTactic rest and GetProof ByProof s = if ByProof = "by" then let pos = FindSemicolon s in let step, rest = Str.string_before s pos, Str.string_after s (pos + 1) in (StepToTactic step, rest) else let pos_after_qed = FindMatch (ws^"proof"^ws) (ws^"qed"^ws0^";") s in let pos = Str.search_backward (Str.regexp "qed") s pos_after_qed in let proof = StringToTactic (Str.string_before s pos) in (proof, Str.string_after s pos_after_qed) and makeCaseSplit s = if Str.string_match (Str.regexp (ws^ "case_split" ^ws^ "\([^;]+\)" ^ws^ "\(by\|proof\)" ^ws)) s 0 then let sDestruct = Str.matched_group 1 s and (proof, rest) = GetProof (Str.matched_group 2 s) (Str.string_after s (Str.group_end 2)) and SplitAtSemicolon case = let pos = FindSemicolon case in [Str.string_before case pos; Str.string_after case (pos + 1)] in let list2Case = map SplitAtSemicolon (FindCases rest) in let listofDisj = map hd list2Case and listofTac = map (StringToTactic o hd o tl) list2Case in case_split sDestruct proof listofDisj listofTac else raise Not_found and StepToTactic step = try if StringRegexpEqual (Str.regexp (ws^ "\([^ \t\n]+\)" ^ws0)) step then exec_tactic (Str.matched_group 1 step) else raise Not_found with _ -> try CombThmtactic_Thm step with _ -> try CombThmlisttactic_Thmlist step with _ -> if Str.string_match (Str.regexp (ws^ "intro_TAC" ^ws)) step 0 then let intro_string = Str.string_after step (Str.match_end()) in intro_TAC intro_string else if Str.string_match (Str.regexp (ws^ "exists_TAC" ^ws)) step 0 then let exists_string = Str.string_after step (Str.match_end()) in exists_TAC exists_string else if Str.string_match (Str.regexp (ws^ "X_genl_TAC" ^ws)) step 0 then let genl_string = Str.string_after step (Str.match_end()) in let svarlist = Str.split (Str.regexp ws) genl_string in X_genl_TAC svarlist else raise Not_found and BigStepToTactic s step = if Str.string_match (Str.regexp (ws^ "consider" ^ws^ "\(\(.\|\n\)+\)" ^ws^ "such" ^ws^ "that" ^ws^ "\(\(.\|\n\)+\)" ^ws^ "\[\(\(.\|\n\)*\)\]" ^ws^ "\(by\|proof\)" ^ws)) step 0 then let vars, t = Str.matched_group 1 step, Str.matched_group 3 step and lab = Str.matched_group 5 step and KeyWord, endKeyWord = Str.matched_group 7 step, (Str.group_end 7) in let (proof, rest) = GetProof KeyWord (Str.string_after s endKeyWord) in (consider vars t lab proof, rest) else try let start = Str.search_forward (Str.regexp (ws^ "\[\([^]]*\)\]" ^ws^ "\(by\|proof\)" ^ws)) step 0 in let statement = Str.string_before step start and lab = Str.matched_group 1 step and KeyWord = Str.matched_group 2 step and AfterWord = Str.string_after s (Str.group_end 2) in let (proof, rest) = GetProof KeyWord AfterWord in if StringRegexpEqual (Str.regexp (ws^ "eq_tac")) statement then (eq_tac lab proof, rest) else if StringRegexpEqual (Str.regexp (ws^ "conj_tac")) statement then (conj_tac lab proof, rest) else if Str.string_match (Str.regexp (ws^ "\(assume\)" ^ws)) statement 0 then let statement = Str.string_after statement (Str.match_end()) in (assume statement lab proof, rest) else (subgoal_TAC statement lab proof, rest) with Not_found -> raise (Readable_fail ("Can't parse as a Proof:\n"^ step));; let theorem s = let s = CleanMathFontsForHOL_Light s in try let start = Str.search_forward (Str.regexp (ws^ "proof\(" ^ws^ "\(.\|\n\)*\)" ^ws ^ "qed" ^ws0^ ";" ^ws0)) s 0 in let thm = Str.string_before s start and proof = Str.matched_group 1 s and rest = Str.string_after s (Str.match_end()) in if rest = "" then prove (parse_env_string [] thm, StringToTactic proof) else raise (Readable_fail ("Trailing garbage after the proof...qed:\n" ^ rest)) with Not_found -> try let start = Str.search_forward (Str.regexp (ws^ "by")) s 0 in let thm = Str.string_before s start and proof = Str.string_after s (Str.match_end()) in try prove (parse_env_string [] thm, StepToTactic proof) with Not_found -> raise (Readable_fail ("Not a proof:\n" ^ proof)) with Not_found -> raise (Readable_fail ("Missing initial \"proof\", \"by\", or final \"qed;\" in\n" ^ s));; let interactive_goal s = let thm = CleanMathFontsForHOL_Light s in g (parse_env_string [] thm);; let interactive_proof s = let proof = CleanMathFontsForHOL_Light s in e (StringToTactic proof);; (* Two examples illustrating intro_TAC, eq_tac, exists_TAC MP_TAC and SPECL, *) (* then a port of the HOL Light tutorial proof that sqrt 2 is irrational. *) let SKOLEM_THM_GEN = theorem `; ∀P R. (∀x. P x ⇒ ∃y. R x y) ⇔ ∃f. ∀x. P x ⇒ R x (f x) proof intro_TAC ∀P R; eq_tac [Right] by fol; intro_TAC H1; exists_TAC λx. @y. R x y; fol H1; qed; `;; let MOD_MOD_REFL = theorem `; ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) proof intro_TAC !m n, H1; MP_TAC SPECL [m; n; 1] MOD_MOD; fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; qed; `;; let NSQRT_2 = theorem `; ∀p q. p * p = 2 * q * q ⇒ q = 0 proof MATCH_MP_TAC num_WF; intro_TAC ∀p, A, ∀q, B; EVEN(p * p) ⇔ EVEN(2 * q * q) [] by fol B; EVEN(p) [] by fol - EVEN_DOUBLE EVEN_MULT; consider m such that p = 2 * m [C] by fol - EVEN_EXISTS; case_split qp | pq by arithmetic; suppose q < p; q * q = 2 * m * m ⇒ m = 0 [] by fol qp A; num_ring - B C; end; suppose p <= q; p * p <= q * q [] by fol - LE_MULT2; q * q = 0 [] by arithmetic - B; num_ring -; end; qed; `;; (* The following interactive version of the above proof shows a feature of *) (* proof/qed and case_split/suppose. You can evaluate an incomplete proof *) (* of a statement in an interactive_proof and complete the proof afterward, *) (* as indicated below. The "suppose" clauses of a case_split can also be *) (* incomplete. Do not include code below the incomplete proof or case_split *) (* in an interactive_proof body, for the usual THEN vs THENL reason. *) interactive_goal `;∀p q. p * p = 2 * q * q ⇒ q = 0 `;; interactive_proof `; MATCH_MP_TAC num_WF; intro_TAC ∀p, A, ∀q, B; EVEN(p * p) ⇔ EVEN(2 * q * q) [] proof qed; `;; interactive_proof `; fol B; `;; interactive_proof `; EVEN(p) [] by fol - EVEN_DOUBLE EVEN_MULT; consider m such that p = 2 * m [C] proof fol - EVEN_EXISTS; qed; `;; interactive_proof `; case_split qp | pq by arithmetic; suppose q < p; end; suppose p <= q; end; `;; interactive_proof `; q * q = 2 * m * m ⇒ m = 0 [] by fol qp A; num_ring - B C; `;; interactive_proof `; p * p <= q * q [] by fol - LE_MULT2; q * q = 0 [] by arithmetic - B; num_ring -; `;; let NSQRT_2 = top_thm();; (* An port from arith.ml uses by instead of proof...qed; in a short proof: *) let EXP_2 = theorem `; ∀n:num. n EXP 2 = n * n by rewrite BIT0_THM BIT1_THM EXP EXP_ADD MULT_CLAUSES ADD_CLAUSES`;; (* An example using GSYM, ARITH_RULE, MESON and GEN_REWRITE_TAC, reproving *) (* the binomial theorem from sec 13.1--2 of the HOL Light tutorial. *) let binom = define `(!n. binom(n,0) = 1) /\ (!k. binom(0,SUC(k)) = 0) /\ (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; let BINOM_LT = theorem `; ∀n k. n < k ⇒ binom(n,k) = 0 proof INDUCT_TAC; INDUCT_TAC; rewrite binom ARITH LT_SUC LT; ASM_SIMP_TAC ARITH_RULE [n < k ==> n < SUC(k)] ARITH; qed; `;; let BINOMIAL_THEOREM = theorem `; ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) proof ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; MATCH_MP_TAC num_INDUCTION; simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; intro_TAC ∀n, nThm; rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; rewriteR ADD_SYM; rewriteRLDepth SUB_SUC EXP; rewrite MULT_AC EQ_ADD_LCANCEL MESON [binom] [1 = binom(n, 0)] GSYM Nsum0SUC; simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; qed; `;; hol-light/RichterHilbertAxiomGeometry/thmFontHilbertAxiom000066400000000000000000000747661303454263000242670ustar00rootroot00000000000000theorem and interactive proof templates: let = theorem `; proof qed; `;; interactive_goal `; `;; interactive_proof `; `;; interactive_proof `; `;; interactive_proof `; `;; interactive_proof `; `;; interactive_proof `; `;; ∉ |- ∀ a l. a ∉ l ⇔ ¬(a ∈ l) Interval_DEF |- ∀ A B X. open (A,B) = {X | Between A X B} Collinear_DEF |- ∀ A B C. Collinear A B C ⇔ ∃ l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l SameSide_DEF |- ∀ l A B. A,B same_side l ⇔ Line l ∧ ¬ ∃ X. X ∈ l ∧ X ∈ open (A,B) Ray_DEF |- ∀ A B. ray A B = {X | ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B)} Ordered_DEF |- ∀ A C B D. ordered A B C D ⇔ B ∈ open (A,C) ∧ B ∈ open (A,D) ∧ C ∈ open (A,D) ∧ C ∈ open (B,D) InteriorAngle_DEF |- ∀ A O B. int_angle A O B = {P | ¬Collinear A O B ∧ ∃ a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b} InteriorTriangle_DEF |- ∀ A B C. int_triangle A B C = {P | P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B} Tetralateral_DEF |- ∀ C D A B. Tetralateral A B C D ⇔ ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B Quadrilateral_DEF |- ∀ B C D A. Quadrilateral A B C D ⇔ Tetralateral A B C D ∧ open (A,B) ∩ open (C,D) = ∅ ∧ open (B,C) ∩ open (D,A) = ∅ ConvexQuad_DEF |- ∀ D A B C. ConvexQuadrilateral A B C D ⇔ Quadrilateral A B C D ∧ A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C Segment_DEF |- ∀ A B. seg A B = {A, B} ∪ open (A,B) SEGMENT |- ∀ s. Segment s ⇔ ∃ A B. s = seg A B ∧ ¬(A = B) SegmentOrdering_DEF |- ∀ t s. s <__ t ⇔ Segment s ∧ ∃ C D X. t = seg C D ∧ X ∈ open (C,D) ∧ s ≡ seg C X Angle_DEF |- ∀ A O B. ∡ A O B = ray O A ∪ ray O B ANGLE |- ∀ α. Angle α ⇔ ∃ A O B. α = ∡ A O B ∧ ¬Collinear A O B AngleOrdering_DEF |- ∀ β α. α <_ang β ⇔ Angle α ∧ ∃ A O B G. ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G RAY |- ∀ r. Ray r ⇔ ∃ O A. ¬(O = A) ∧ r = ray O A TriangleCong_DEF |- ∀ A B C A' B' C'. A,B,C ≅ A',B',C' ⇔ ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B' SupplementaryAngles_DEF |- ∀α β. α suppl β ⇔ ∃ A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A' RightAngle_DEF |- ∀α. Right α ⇔ ∃ β. α suppl β ∧ α ≡ β PlaneComplement_DEF |- ∀ α. complement α = {P | P ∉ α} CONVEX |- ∀α. Convex α ⇔ ∀ A B. A ∈ α ∧ B ∈ α ⇒ open (A,B) ⊂ α PARALLEL |- ∀ l k. l ∥ k ⇔ Line l ∧ Line k ∧ l ∩ k = ∅ Parallelogram_DEF |- ∀ A B C D. Parallelogram A B C D ⇔ Quadrilateral A B C D ∧ ∃ a b c d. Line a ∧ A ∈ a ∧ B ∈ a ∧ Line b ∧ B ∈ b ∧ C ∈ b ∧ Line c ∧ C ∈ c ∧ D ∈ d ∧ Line d ∧ D ∈ d ∧ A ∈ d ∧ a ∥ c ∧ b ∥ d InteriorCircle_DEF |- ∀ O R. int_circle O R = {P | ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R)} I1 |- ∀ A B. ¬(A = B) ⇒ (∃! l. Line l ∧ A ∈ l ∧ B ∈ l) I2 |- ∀ l. Line l ⇒ (∃ A B. A ∈ l ∧ B ∈ l ∧ ¬(A = B)) I3 |- ∃ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C B1 |- ∀ A B C. Between A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Between C B A ∧ Collinear A B C B2 |- ∀ A B. ¬(A = B) ⇒ ∃C. Between A B C B3 |- ∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (Between A B C ∨ Between B C A ∨ Between C A B) ∧ ¬(Between A B C ∧ Between B C A) ∧ ¬(Between A B C ∧ Between C A B) ∧ ¬(Between B C A ∧ Between C A B) B4 |- ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃X. X ∈ l ∧ Between A X C) ⇒ (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C) C1 |- ∀ s O Z. Segment s ∧ ¬(O = Z) ⇒ ∃! P. P ∈ ray O Z â” O ∧ seg O P ≡ s C2Reflexive |- Segment s ⇒ s ≡ s C2Symmetric |- Segment s ∧ Segment t ∧ s ≡ t ⇒ t ≡ s C2Transitive |- Segment s ∧ Segment t ∧ Segment u ∧ s ≡ t ∧ t ≡ u ⇒ s ≡ u C3 |- ∀ A B C A' B' C'. B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ seg A B ≡ seg A' B' ∧ seg B C ≡ seg B' C' ⇒ seg A C ≡ seg A' C' C4 |- ∀ α O A l Y. Angle α ∧ ¬(O = A) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ ∃! r. Ray r ∧ ∃ B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α C5Reflexive |- Angle α ⇒ α ≡ α C5Symmetric |- Angle α ∧ Angle β ∧ α ≡ β ⇒ β ≡ α C5Transitive |- Angle α ∧ Angle β ∧ Angle γ ∧ α ≡ β ∧ β ≡ γ ⇒ α ≡ γ C6 |- ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ⇒ ∡ B C A ≡ ∡ B' C' A' IN_Interval |- ∀ A B X. X ∈ open (A,B) ⇔ Between A X B IN_Ray |- ∀ A B X. X ∈ ray A B ⇔ ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B) IN_InteriorAngle |- ∀A O B P. P ∈ int_angle A O B ⇔ ¬Collinear A O B ∧ ∃ a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b IN_InteriorTriangle |- ∀A B C P. P ∈ int_triangle A B C ⇔ P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B IN_PlaneComplement |- ∀α P. P ∈ complement α ⇔ P ∉ α IN_InteriorCircle |- ∀ O R P. P ∈ int_circle O R ⇔ ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R) B1' |- ∀ A B C. B ∈ open (A,C) ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ open (C,A) ∧ Collinear A B C B2' |- ∀ A B. ¬(A = B) ⇒ (∃ C. B ∈ open (A,C)) B3' |- ∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B)) ∧ ¬(B ∈ open (A,C) ∧ C ∈ open (B,A)) ∧ ¬(B ∈ open (A,C) ∧ A ∈ open (C,B)) ∧ ¬(C ∈ open (B,A) ∧ A ∈ open (C,B)) B4' |- ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ X ∈ open (A,C)) ⇒ (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) B4'' |- ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l DisjointOneNotOther |- ∀ l m. (∀x. x ∈ m ⇒ x ∉ l) ⇔ l ∩ m = ∅ EquivIntersectionHelp |- ∀ e x l m. (l ∩ m = {x} ∨ m ∩ l = {x}) ∧ e ∈ m â” x ⇒ e ∉ l CollinearSymmetry |- ∀ A B C. Collinear A B C ⇒ Collinear A C B ∧ Collinear B A C ∧ Collinear B C A ∧ Collinear C A B ∧ Collinear C B A ExistsNewPointOnLine |- ∀ P l. Line l ∧ P ∈ l ⇒ ∃ Q. Q ∈ l ∧ ¬(P = Q) ExistsPointOffLine |- ∀ l. Line l ⇒ ∃ Q. Q ∉ l BetweenLinear |- ∀ A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B) ⇒ B ∈ m CollinearLinear |- ∀ A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ ¬(A = C) ∧ Collinear A B C ∨ Collinear B C A ∨ Collinear C A B ⇒ B ∈ m NonCollinearImpliesDistinct |- ∀ A B C. ¬Collinear A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) NonCollinearRaa |- ∀A B C l. ¬(A = C) ∧ Line l ∧ A ∈ l ∧ C ∈ l ∧ B ∉ l ⇒ ¬Collinear A B C TwoSidesTriangle1Intersection |- ∀A B C Y. ¬Collinear A B C ∧ Collinear B C Y ∧ Collinear A C Y ⇒ Y = C OriginInRay |- ∀ O Q. ¬(Q = O) ⇒ O ∈ ray O Q EndpointInRay |- ∀ O Q. ¬(Q = O) ⇒ Q ∈ ray O Q I1Uniqueness |- ∀ X l m. Line l ∧ Line m ∧ ¬(l = m) ∧ X ∈ l ∧ X ∈ m ⇒ l ∩ m = {X} EquivIntersection |- ∀ A B X l m. Line l ∧ Line m ∧ l ∩ m = {X} ∧ A ∈ m â” X ∧ B ∈ m â” X ∧ X ∉ open (A,B) ⇒ A,B same_side l RayLine |- ∀ O P l. Line l ∧ O ∈ l ∧ P ∈ l ⇒ ray O P ⊂ l RaySameSide |- ∀ l O A P. Line l ∧ O ∈ l ∧ A ∉ l ∧ P ∈ ray O A â” O ⇒ P ∉ l ∧ P,A same_side l IntervalRayEZ |- ∀ A B C. B ∈ open (A,C) ⇒ B ∈ ray A C â” A ∧ C ∈ ray A B â” A NoncollinearityExtendsToLine |- ∀ A O B X. ¬Collinear A O B ∧ Collinear O B X ∧ ¬(X = O) ⇒ ¬Collinear A O X SameSideReflexive |- ∀ l A. Line l ∧ A ∉ l ⇒ A,A same_side l SameSideSymmetric |- ∀ l A B. Line l ∧ A ∉ l ∧ B ∉ l ∧ A,B same_side l ⇒ B,A same_side l SameSideTransitive |- ∀l A B C. Line l ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l ConverseCrossbar |- ∀ O A B G. ¬Collinear A O B ∧ G ∈ open (A,B) ⇒ G ∈ int_angle A O B InteriorUse |- ∀ A O B P a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∈ int_angle A O B ⇒ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b InteriorEZHelp |- ∀ A O B P. P ∈ int_angle A O B ⇒ ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) ∧ ¬Collinear A O P InteriorAngleSymmetry |- ∀ A O B P. P ∈ int_angle A O B ⇒ P ∈ int_angle B O A InteriorWellDefined |- ∀ A O B X P. P ∈ int_angle A O B ∧ X ∈ ray O B â” O ⇒ P ∈ int_angle A O X WholeRayInterior |- ∀A O B X P. X ∈ int_angle A O B ∧ P ∈ ray O X â” O ⇒ P ∈ int_angle A O B AngleOrdering |- ∀ O A P Q a. ¬(O = A) ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ P ∉ a ∧ Q ∉ a ∧ P,Q same_side a ∧ ¬Collinear P O Q ⇒ P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A InteriorsDisjointSupplement |- ∀A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ⇒ int_angle A O B ∩ int_angle B O A' = ∅ InteriorReflectionInterior |- ∀ A O B D A'. O ∈ open (A,A') ∧ D ∈ int_angle A O B ⇒ B ∈ int_angle D O A' Crossbar_THM |- ∀ O A B D. D ∈ int_angle A O B ⇒ ∃ G. G ∈ open (A,B) ∧ G ∈ ray O D â” O AlternateConverseCrossbar |- ∀ O A B G. Collinear A G B ∧ G ∈ int_angle A O B ⇒ G ∈ open (A,B) InteriorOpposite |- ∀ A O B P p. P ∈ int_angle A O B ∧ Line p ∧ O ∈ p ∧ P ∈ p ⇒ ¬(A,B same_side p) IntervalTransitivity |- ∀ O P Q R m. Line m ∧ O ∈ m ∧ P ∈ m â” O ∧ Q ∈ m â” O ∧ R ∈ m â” O ∧ O ∉ open (P,Q) ∧ O ∉ open (Q,R) ⇒ O ∉ open (P,R) RayWellDefinedHalfway |- ∀ O P Q. ¬(Q = O) ∧ P ∈ ray O Q â” O ⇒ ray O P ⊂ ray O Q RayWellDefined |- ∀ O P Q. ¬(Q = O) ∧ P ∈ ray O Q â” O ⇒ ray O P = ray O Q OppositeRaysIntersect1pointHelp |- ∀ A O B X. O ∈ open (A,B) ∧ X ∈ ray O B â” O ⇒ X ∉ ray O A ∧ O ∈ open (X,A) OppositeRaysIntersect1point |- ∀ A O B. O ∈ open (A,B) ⇒ ray O A ∩ ray O B = {O} IntervalRay |- ∀ A B C. B ∈ open (A,C) ⇒ ray A B = ray A C Reverse4Order |- ∀ A B C D. ordered A B C D ⇒ ordered D C B A TransitivityBetweennessHelp |- ∀ A B C D. B ∈ open (A,C) ∧ C ∈ open (B,D) ⇒ B ∈ open (A,D) TransitivityBetweenness |- ∀ A B C D. B ∈ open (A,C) ∧ C ∈ open (B,D) ⇒ ordered A B C D IntervalsAreConvex |- ∀ A B C. B ∈ open (A,C) ⇒ open (A,B) ⊂ open (A,C) TransitivityBetweennessVariant |- ∀ A X B C. X ∈ open (A,B) ∧ B ∈ open (A,C) ⇒ ordered A X B C Interval2sides2aLineHelp |- ∀ A B C X. B ∈ open (A,C) ⇒ X ∉ open (A,B) ∨ X ∉ open (B,C) Interval2sides2aLine |- ∀ A B C X. Collinear A B C ⇒ X ∉ open (A,B) ∨ X ∉ open (A,C) ∨ X ∉ open (B,C) TwosidesTriangle2aLine |- ∀A B C Y l m. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ Line m ∧ A ∈ m ∧ C ∈ m ∧ Y ∈ l ∧ Y ∈ m ∧ ¬(A,B same_side l) ∧ ¬(B,C same_side l) ⇒ A,C same_side l LineUnionOf2Rays |- ∀ A O B l. Line l ∧ A ∈ l ∧ B ∈ l ∧ O ∈ open (A,B) ⇒ l = ray O A ∪ ray O B AtMost2Sides |- ∀ A B C l. Line l ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ⇒ A,B same_side l ∨ A,C same_side l ∨ B,C same_side l FourPointsOrder |- ∀ A B C X l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ X ∈ l ∧ B ∈ open (A,C) ∧ ¬(X = A) ∧ ¬(X = B) ∧ ¬(X = C) ⇒ ordered X A B C ∨ ordered A X B C ∨ ordered A B X C ∨ ordered A B C X HilbertAxiomRedundantByMoore |- ∀ A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ D ∈ l ∧ ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ⇒ ordered D A B C ∨ ordered A D B C ∨ ordered A B D C ∨ ordered A B C D ∨ ordered D A C B ∨ ordered A D C B ∨ ordered A C D B ∨ ordered A C B D ∨ ordered D C A B ∨ ordered C D A B ∨ ordered C A D B ∨ ordered C A B D InteriorTransitivity |- ∀A O B F G. G ∈ int_angle A O B ∧ F ∈ int_angle A O G ⇒ F ∈ int_angle A O B HalfPlaneConvexNonempty |- ∀l H A. Line l ∧ A ∉ l ∧ H = {X | X ∉ l ∧ X,A same_side l} ⇒ ¬(H = ∅) ∧ H ⊂ complement l ∧ Convex H PlaneSeparation |- ∀ l. Line l ⇒ ∃ H1 H2. H1 ∩ H2 = ∅ ∧ ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ Convex H1 ∧ Convex H2 ∧ complement l = H1 ∪ H2 ∧ ∀ P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) TetralateralSymmetry |- ∀ A B C D. Tetralateral A B C D ⇒ Tetralateral B C D A ∧ Tetralateral A B D C EasyEmptyIntersectionsTetralateralHelp |- ∀ A B C D. Tetralateral A B C D ⇒ open (A,B) ∩ open (B,C) = ∅ EasyEmptyIntersectionsTetralateral |- ∀ A B C D. Tetralateral A B C D ⇒ open (A,B) ∩ open (B,C) = ∅ ∧ open (B,C) ∩ open (C,D) = ∅ ∧ open (C,D) ∩ open (D,A) = ∅ ∧ open (D,A) ∩ open (A,B) = ∅ SegmentSameSideOppositeLine |- ∀ A B C D a c. Quadrilateral A B C D ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c ⇒ A,B same_side c ∨ C,D same_side a ConvexImpliesQuad |- ∀ A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C ⇒ Quadrilateral A B C D DiagonalsIntersectImpliesConvexQuad |- ∀ A B C D G. ¬Collinear B C D ∧ G ∈ open (A,C) ∧ G ∈ open (B,D) ⇒ ConvexQuadrilateral A B C D DoubleNotSimImpliesDiagonalsIntersect |- ∀ A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m ∧ Tetralateral A B C D ∧ ¬(B,D same_side l) ∧ ¬(A,C same_side m) ⇒ (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ConvexQuadrilateral A B C D ConvexQuadImpliesDiagonalsIntersect |- ∀ A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m ∧ ConvexQuadrilateral A B C D ⇒ ¬(B,D same_side l) ∧ ¬(A,C same_side m) ∧ (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ¬Quadrilateral A B D C FourChoicesTetralateralHelp |- ∀ A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B ⇒ ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B InteriorTriangleSymmetry |- ∀ A B C P. P ∈ int_triangle A B C ⇒ P ∈ int_triangle B C A FourChoicesTetralateral |- ∀ A B C D a. Tetralateral A B C D ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ C,D same_side a ⇒ ConvexQuadrilateral A B C D ∨ ConvexQuadrilateral A B D C ∨ D ∈ int_triangle A B C ∨ C ∈ int_triangle D A B QuadrilateralSymmetry |- ∀ A B C D. Quadrilateral A B C D ⇒ Quadrilateral B C D A ∧ Quadrilateral C D A B ∧ Quadrilateral D A B C FiveChoicesQuadrilateral |- ∀ A B C D l m. Quadrilateral A B C D ∧ Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m ⇒ (ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) ∧ (¬(B,D same_side l) ∨ ¬(A,C same_side m)) IntervalSymmetry |- ∀ A B. open (A,B) = open (B,A) SegmentSymmetry |- ∀ A B. seg A B = seg B A C1OppositeRay |- ∀ O P s. Segment s ∧ ¬(O = P) ⇒ ∃ Q. P ∈ open (O,Q) ∧ seg P Q ≡ s OrderedCongruentSegments |- ∀ A B C D F. ¬(A = C) ∧ ¬(D = F) ∧ seg A C ≡ seg D F ∧ B ∈ open (A,C) ⇒ ∃ E. E ∈ open (D,F) ∧ seg A B ≡ seg D E SegmentSubtraction |- ∀ A B C A' B' C'. B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ⇒ seg B C ≡ seg B' C' SegmentOrderingUse |- ∀A B s. Segment s ∧ ¬(A = B) ∧ s <__ seg A B ⇒ ∃ G. G ∈ open (A,B) ∧ s ≡ seg A G SegmentTrichotomy1 |- ∀ s t. s <__ t ⇒ ¬(s ≡ t) SegmentTrichotomy2 |- ∀ s t u. s <__ t ∧ Segment u ∧ t ≡ u ⇒ s <__ u SegmentOrderTransitivity |- ∀ s t u. s <__ t ∧ t <__ u ⇒ s <__ u SegmentTrichotomy |- ∀ s t. Segment s ∧ Segment t ⇒ (s ≡ t ∨ s <__ t ∨ t <__ s) ∧ ¬(s ≡ t ∧ s <__ t) ∧ ¬(s ≡ t ∧ t <__ s) ∧ ¬(s <__ t ∧ t <__ s) C4Uniqueness |- ∀ O A B P l. Line l ∧ O ∈ l ∧ A ∈ l ∧ ¬(O = A) ∧ B ∉ l ∧ P ∉ l ∧ P,B same_side l ∧ ∡ A O P ≡ ∡ A O B ⇒ ray O B = ray O P AngleSymmetry |- ∀ A O B. ∡ A O B = ∡ B O A TriangleCongSymmetry |- ∀ A B C A' B' C'. A,B,C ≅ A',B',C' ⇒ A,C,B ≅ A',C',B' ∧ B,A,C ≅ B',A',C' ∧ B,C,A ≅ B',C',A' ∧ C,A,B ≅ C',A',B' ∧ C,B,A ≅ C',B',A' SAS |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ⇒ A,B,C ≅ A',B',C' ASA |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A C ≡ seg A' C' ∧ ∡ C A B ≡ ∡ C' A' B' ∧ ∡ B C A ≡ ∡ B' C' A' ⇒ A,B,C ≅ A',B',C' AngleSubtraction |- ∀ A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ∧ ∡ A O B ≡ ∡ A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' ⇒ ∡ G O B ≡ ∡ G' O' B' OrderedCongruentAngles |- ∀ A O B A' O' B' G. ¬Collinear A' O' B' ∧ ∡ A O B ≡ ∡ A' O' B' ∧ G ∈ int_angle A O B ⇒ ∃ G'. G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' AngleAddition |- ∀ A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' ∧ ∡ G O B ≡ ∡ G' O' B' ∧ ⇒ ∡ A O B ≡ ∡ A' O' B' AngleOrderingUse |- ∀ A O B α. Angle α ∧ ¬Collinear A O B ∧ α <_ang ∡ A O B ⇒ (∃ G. G ∈ int_angle A O B ∧ α ≡ ∡ A O G) AngleTrichotomy1 |- ∀ α β. α <_ang β ⇒ ¬(α ≡ β) AngleTrichotomy2 |- ∀ α β γ. α <_ang β ∧ Angle γ ∧ β ≡ γ ⇒ α <_ang γ AngleOrderTransitivity |- ∀α β γ. α <_ang β ∧ β <_ang γ ⇒ α <_ang γ AngleTrichotomy |- ∀ α β. Angle α ∧ Angle β ⇒ (α ≡ β ∨ α <_ang β ∨ β <_ang α) ∧ ¬(α ≡ β ∧ α <_ang β) ∧ ¬(α ≡ β ∧ β <_ang α) ∧ ¬(α <_ang β ∧ β <_ang α) SupplementExists |- ∀ α. Angle α ⇒ ∃ α'. α suppl α' SupplementImpliesAngle |- ∀ α β. α suppl β ⇒ Angle α ∧ Angle β RightImpliesAngle |- ∀ α. Right α ⇒ Angle α SupplementSymmetry |- ∀ α β. α suppl β ⇒ β suppl α SupplementsCongAnglesCong |- ∀ α β α' β'. α suppl α' ∧ β suppl β' ∧ α ≡ β ⇒ α' ≡ β' SupplementUnique |- ∀ α β β'. α suppl β ∧ α suppl β' ⇒ β ≡ β' CongRightImpliesRight |- ∀ α β. Angle α ∧ Right β ∧ α ≡ β ⇒ Right α RightAnglesCongruentHelp |- ∀ A O B A' P a. ¬Collinear A O B ∧ O ∈ open (A,A') Right (∡ A O B) ∧ Right (∡ A O P) ⇒ P ∉ int_angle A O B RightAnglesCongruent |- ∀ α β. Right α ∧ Right β ⇒ α ≡ β OppositeRightAnglesLinear |- ∀ A B O H h. ¬Collinear A O H ∧ ¬Collinear H O B ∧ Right (∡ A O H) ∧ Right (∡ H O B) ∧ Line h ∧ O ∈ h ∧ H ∈ h ∧ ¬(A,B same_side h) ⇒ O ∈ open (A,B) RightImpliesSupplRight |- ∀ A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ Right (∡ A O B) ⇒ Right (∡ B O A') IsoscelesCongBaseAngles |- ∀ A B C. ¬Collinear A B C ∧ seg B A ≡ seg B C ⇒ ∡ C A B ≡ ∡ A C B C4withC1 |- ∀ α l O A Y P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ ∃ N. ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α C4OppositeSide |- ∀ α l O A Z P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Z ∉ l ⇒ ∃ N. ¬(O = N) ∧ N ∉ l ∧ ¬(Z,N same_side l) ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α SSS |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ⇒ A,B,C ≅ A',B',C' AngleBisector |- ∀ A B C. ¬Collinear B A C ⇒ ∃ F. F ∈ int_angle B A C ∧ ∡ B A F ≡ ∡ F A C EuclidPropositionI_6 |- ∀ A B C. ¬Collinear A B C ∧ ∡ B A C ≡ ∡ B C A ⇒ seg B A ≡ seg B C IsoscelesExists |- ∀ A B. ¬(A = B) ⇒ ∃ D. ¬Collinear A D B ∧ seg D A ≡ seg D B MidpointExists |- ∀ A B. ¬(A = B) ⇒ ∃ M. M ∈ open (A,B) ∧ seg A M ≡ seg M B EuclidPropositionI_7short |- ∀ A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ∧ seg A C ≡ seg A D ⇒ ¬(seg B C ≡ seg B D) EuclidPropI_7Help |- ∀ A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ∧ seg A C ≡ seg A D ∧ (C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B C D) ⇒ ¬(seg B C ≡ seg B D) EuclidPropositionI_7 |- ∀ A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ∧ seg A C ≡ seg A D ⇒ ¬(seg B C ≡ seg B D) EuclidPropositionI_11 |- ∀A B. ¬(A = B) ⇒ ∃ F. Right (∡ A B F) DropPerpendicularToLine |- ∀ P l. Line l ∧ P ∉ l ⇒ ∃ E Q. E ∈ l ∧ Q ∈ l ∧ Right (∡ P Q E) EuclidPropositionI_14 |- ∀ A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ ¬(A = B) ∧ C ∉ l ∧ D ∉ l ∧ ¬(C,D same_side l) ∧ ∡ C B A suppl ∡ A B D ⇒ B ∈ open (C,D) VerticalAnglesCong |- ∀ A B O A' B'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ O ∈ open (B,B') ⇒ ∡ B O A' ≡ ∡ B' O A EuclidPropositionI_16 |- ∀ A B C D. ¬Collinear A B C ∧ C ∈ open (B,D) ⇒ ∡ B A C <_ang ∡ D C A ExteriorAngle |- ∀ A B C D. ¬Collinear A B C ∧ C ∈ open (B,D) ⇒ ∡ A B C <_ang ∡ A C D EuclidPropositionI_17 |- ∀ A B C α β γ. ¬Collinear A B C ∧ α = ∡ A B C ∧ β = ∡ B C A ∧ β suppl γ ⇒ α <_ang γ EuclidPropositionI_18 |- ∀ A B C. ¬Collinear A B C ∧ seg A C <__ seg A B ⇒ ∡ A B C <_ang ∡ B C A EuclidPropositionI_19 |- ∀ A B C. ¬Collinear A B C ∧ ∡ A B C <_ang ∡ B C A ⇒ seg A C <__ seg A B EuclidPropositionI_20 |- ∀ A B C D. ¬Collinear A B C ∧ A ∈ open (B,D) ∧ seg A D ≡ seg A C ⇒ seg B C <__ seg B D EuclidPropositionI_21 |- ∀ A B C D. ¬Collinear A B C ∧ D ∈ int_triangle A B C ⇒ ∡ A B C <_ang ∡ C D A AngleTrichotomy3 |- ∀ α β γ. α <_ang β ∧ Angle γ ∧ γ ≡ α ⇒ γ <_ang β InteriorCircleConvexHelp |- ∀ O A B C. ¬Collinear A O C ∧ B ∈ open (A,C) ∧ seg O A <__ seg O C ∨ seg O A ≡ seg O C ⇒ seg O B <__ seg O C InteriorCircleConvex |- ∀ O R A B C. ¬(O = R) ∧ B ∈ open (A,C) ∧ A ∈ int_circle O R ∧ C ∈ int_circle O R ⇒ B ∈ int_circle O R SegmentTrichotomy3 |- ∀ s t u. s <__ t ∧ Segment u ∧ u ≡ s ⇒ u <__ t EuclidPropositionI_24Help |- ∀ O A C O' D F. ¬Collinear A O C ∧ ¬Collinear D O' F ∧ seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ ∡ D O' F <_ang ∡ A O C ∧ seg O A <__ seg O C ∨ seg O A ≡ seg O C ⇒ seg D F <__ seg A C EuclidPropositionI_24 |- ∀ O A C O' D F. ¬Collinear A O C ∧ ¬Collinear D O' F ∧ seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ ∡ D O' F <_ang ∡ A O C ⇒ seg D F <__ seg A C EuclidPropositionI_25 |- ∀ O A C O' D F. ¬Collinear A O C ∧ ¬Collinear D O' F ∧ seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ seg D F <__ seg A C ⇒ ∡ D O' F <_ang ∡ A O C AAS |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ seg A B ≡ seg A' B' ⇒ A,B,C ≅ A',B',C' ParallelSymmetry |- ∀ l k. l ∥ k ⇒ k ∥ l AlternateInteriorAngles |- ∀ A B C E l m t. Line l ∧ A ∈ l ∧ E ∈ l ∧ Line m ∧ B ∈ m ∧ C ∈ m ∧ Line t ∧ A ∈ t ∧ B ∈ t ∧ ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ∧ ¬(C,E same_side t) ∧ ∡ E A B ≡ ∡ C B A ⇒ l ∥ m EuclidPropositionI_28 |- ∀ A B C D E F G H l m t. Line l ∧ A ∈ l ∧ B ∈ l ∧ G ∈ l ∧ Line m ∧ C ∈ m ∧ D ∈ m ∧ H ∈ m ∧ Line t ∧ G ∈ t ∧ H ∈ t ∧ G ∉ m ∧ H ∉ l ∧ G ∈ open (A,B) ∧ H ∈ open (C,D) ∧ G ∈ open (E,H) ∧ H ∈ open (F,G) ∧ ¬(D,A same_side t) ∧ ∡ E G B ≡ ∡ G H D ∨ ∡ B G H suppl ∡ G H D ⇒ l ∥ m OppositeSidesCongImpliesParallelogram |- ∀ A B C D. Quadrilateral A B C D ∧ seg A B ≡ seg C D ∧ seg B C ≡ seg D A ⇒ Parallelogram A B C D OppositeAnglesCongImpliesParallelogramHelp |- ∀ A B C D a c. Quadrilateral A B C D ∧ ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c ⇒ a ∥ c OppositeAnglesCongImpliesParallelogram |- ∀ A B C D. Quadrilateral A B C D ∧ ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ⇒ Parallelogram A B C D P |- ∀ P l. Line l ∧ P ∉ l ⇒ ∃! m. Line m ∧ P ∈ m ∧ m ∥ l AMa |- ∀ α. Angle α ⇒ &0 < μ α ∧ μ α < &180 AMb |- ∀ α. Right α ⇒ μ α = &90 AMc |- ∀ α β. Angle α ∧ Angle β ∧ α ≡ β ⇒ μ α = μ β AMd |- ∀ A O B P. P ∈ int_angle A O B ⇒ μ (∡ A O B) = μ (∡ A O P) + μ (∡ P O B) ConverseAlternateInteriorAngles |- ∀ A B C E l m t. Line l ∧ A ∈ l ∧ E ∈ l ∧ Line m ∧ B ∈ m ∧ C ∈ m ∧ Line t ∧ A ∈ t ∧ B ∈ t ∧ ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ∧ ¬(C,E same_side t) ∧ l ∥ m ⇒ ∡ E A B ≡ ∡ C B A HilbertTriangleSum |- ∀ A B C. ¬Collinear A B C ⇒ ∃ E F. B ∈ open (E,F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A EuclidPropositionI_13 |- ∀A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ⇒ μ (∡ A O B) + μ (∡ B O A') = &180 TriangleSum |- ∀ A B C. ¬Collinear A B C ⇒ μ (∡ A B C) + μ (∡ B C A) + μ (∡ C A B) = &180 hol-light/RichterHilbertAxiomGeometry/thmFontHilbertAxiom.ml000066400000000000000000000751421303454263000246630ustar00rootroot00000000000000ocaml #use "hol.ml";; #load "unix.cma";; loadt "miz3/miz3.ml";; reset_miz3 0;; verbose := true;; report_timing := true;; Theorem/Proof templates: let = theorem `; proof qed; `;; interactive_goal `; `;; interactive_proof `; `;; interactive_proof `; `;; interactive_proof `; `;; interactive_proof `; `;; interactive_proof `; `;; ∉ |- ∀ a l. a ∉ l ⇔ ¬(a ∈ l) Interval_DEF |- ∀ A B X. open (A,B) = {X | Between A X B} Collinear_DEF |- ∀ A B C. Collinear A B C ⇔ ∃ l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l SameSide_DEF |- ∀ l A B. A,B same_side l ⇔ Line l ∧ ¬ ∃ X. X ∈ l ∧ X ∈ open (A,B) Ray_DEF |- ∀ A B. ray A B = {X | ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B)} Ordered_DEF |- ∀ A C B D. ordered A B C D ⇔ B ∈ open (A,C) ∧ B ∈ open (A,D) ∧ C ∈ open (A,D) ∧ C ∈ open (B,D) InteriorAngle_DEF |- ∀ A O B. int_angle A O B = {P | ¬Collinear A O B ∧ ∃ a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b} InteriorTriangle_DEF |- ∀ A B C. int_triangle A B C = {P | P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B} Tetralateral_DEF |- ∀ C D A B. Tetralateral A B C D ⇔ ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B Quadrilateral_DEF |- ∀ B C D A. Quadrilateral A B C D ⇔ Tetralateral A B C D ∧ open (A,B) ∩ open (C,D) = ∅ ∧ open (B,C) ∩ open (D,A) = ∅ ConvexQuad_DEF |- ∀ D A B C. ConvexQuadrilateral A B C D ⇔ Quadrilateral A B C D ∧ A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C Segment_DEF |- ∀ A B. seg A B = {A, B} ∪ open (A,B) SEGMENT |- ∀ s. Segment s ⇔ ∃ A B. s = seg A B ∧ ¬(A = B) SegmentOrdering_DEF |- ∀ t s. s <__ t ⇔ Segment s ∧ ∃ C D X. t = seg C D ∧ X ∈ open (C,D) ∧ s ≡ seg C X Angle_DEF |- ∀ A O B. ∡ A O B = ray O A ∪ ray O B ANGLE |- ∀ α. Angle α ⇔ ∃ A O B. α = ∡ A O B ∧ ¬Collinear A O B AngleOrdering_DEF |- ∀ β α. α <_ang β ⇔ Angle α ∧ ∃ A O B G. ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G RAY |- ∀ r. Ray r ⇔ ∃ O A. ¬(O = A) ∧ r = ray O A TriangleCong_DEF |- ∀ A B C A' B' C'. A,B,C ≅ A',B',C' ⇔ ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B' SupplementaryAngles_DEF |- ∀α β. α suppl β ⇔ ∃ A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A' RightAngle_DEF |- ∀α. Right α ⇔ ∃ β. α suppl β ∧ α ≡ β PlaneComplement_DEF |- ∀ α. complement α = {P | P ∉ α} CONVEX |- ∀α. Convex α ⇔ ∀ A B. A ∈ α ∧ B ∈ α ⇒ open (A,B) ⊂ α PARALLEL |- ∀ l k. l ∥ k ⇔ Line l ∧ Line k ∧ l ∩ k = ∅ Parallelogram_DEF |- ∀ A B C D. Parallelogram A B C D ⇔ Quadrilateral A B C D ∧ ∃ a b c d. Line a ∧ A ∈ a ∧ B ∈ a ∧ Line b ∧ B ∈ b ∧ C ∈ b ∧ Line c ∧ C ∈ c ∧ D ∈ d ∧ Line d ∧ D ∈ d ∧ A ∈ d ∧ a ∥ c ∧ b ∥ d InteriorCircle_DEF |- ∀ O R. int_circle O R = {P | ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R)} I1 |- ∀ A B. ¬(A = B) ⇒ (∃! l. Line l ∧ A ∈ l ∧ B ∈ l) I2 |- ∀ l. Line l ⇒ (∃ A B. A ∈ l ∧ B ∈ l ∧ ¬(A = B)) I3 |- ∃ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C B1 |- ∀ A B C. Between A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Between C B A ∧ Collinear A B C B2 |- ∀ A B. ¬(A = B) ⇒ ∃C. Between A B C B3 |- ∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (Between A B C ∨ Between B C A ∨ Between C A B) ∧ ¬(Between A B C ∧ Between B C A) ∧ ¬(Between A B C ∧ Between C A B) ∧ ¬(Between B C A ∧ Between C A B) B4 |- ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃X. X ∈ l ∧ Between A X C) ⇒ (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C) C1 |- ∀ s O Z. Segment s ∧ ¬(O = Z) ⇒ ∃! P. P ∈ ray O Z â” O ∧ seg O P ≡ s C2Reflexive |- Segment s ⇒ s ≡ s C2Symmetric |- Segment s ∧ Segment t ∧ s ≡ t ⇒ t ≡ s C2Transitive |- Segment s ∧ Segment t ∧ Segment u ∧ s ≡ t ∧ t ≡ u ⇒ s ≡ u C3 |- ∀ A B C A' B' C'. B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ seg A B ≡ seg A' B' ∧ seg B C ≡ seg B' C' ⇒ seg A C ≡ seg A' C' C4 |- ∀ α O A l Y. Angle α ∧ ¬(O = A) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ ∃! r. Ray r ∧ ∃ B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α C5Reflexive |- Angle α ⇒ α ≡ α C5Symmetric |- Angle α ∧ Angle β ∧ α ≡ β ⇒ β ≡ α C5Transitive |- Angle α ∧ Angle β ∧ Angle γ ∧ α ≡ β ∧ β ≡ γ ⇒ α ≡ γ C6 |- ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ⇒ ∡ B C A ≡ ∡ B' C' A' IN_Interval |- ∀ A B X. X ∈ open (A,B) ⇔ Between A X B IN_Ray |- ∀ A B X. X ∈ ray A B ⇔ ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B) IN_InteriorAngle |- ∀A O B P. P ∈ int_angle A O B ⇔ ¬Collinear A O B ∧ ∃ a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b IN_InteriorTriangle |- ∀A B C P. P ∈ int_triangle A B C ⇔ P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B IN_PlaneComplement |- ∀α P. P ∈ complement α ⇔ P ∉ α IN_InteriorCircle |- ∀ O R P. P ∈ int_circle O R ⇔ ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R) B1' |- ∀ A B C. B ∈ open (A,C) ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ open (C,A) ∧ Collinear A B C B2' |- ∀ A B. ¬(A = B) ⇒ (∃ C. B ∈ open (A,C)) B3' |- ∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C ⇒ (B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B)) ∧ ¬(B ∈ open (A,C) ∧ C ∈ open (B,A)) ∧ ¬(B ∈ open (A,C) ∧ A ∈ open (C,B)) ∧ ¬(C ∈ open (B,A) ∧ A ∈ open (C,B)) B4' |- ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ (∃ X. X ∈ l ∧ X ∈ open (A,C)) ⇒ (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) B4'' |- ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l DisjointOneNotOther |- ∀ l m. (∀x. x ∈ m ⇒ x ∉ l) ⇔ l ∩ m = ∅ EquivIntersectionHelp |- ∀ e x l m. (l ∩ m = {x} ∨ m ∩ l = {x}) ∧ e ∈ m â” x ⇒ e ∉ l CollinearSymmetry |- ∀ A B C. Collinear A B C ⇒ Collinear A C B ∧ Collinear B A C ∧ Collinear B C A ∧ Collinear C A B ∧ Collinear C B A ExistsNewPointOnLine |- ∀ P l. Line l ∧ P ∈ l ⇒ ∃ Q. Q ∈ l ∧ ¬(P = Q) ExistsPointOffLine |- ∀ l. Line l ⇒ ∃ Q. Q ∉ l BetweenLinear |- ∀ A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B) ⇒ B ∈ m CollinearLinear |- ∀ A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ ¬(A = C) ∧ Collinear A B C ∨ Collinear B C A ∨ Collinear C A B ⇒ B ∈ m NonCollinearImpliesDistinct |- ∀ A B C. ¬Collinear A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) NonCollinearRaa |- ∀A B C l. ¬(A = C) ∧ Line l ∧ A ∈ l ∧ C ∈ l ∧ B ∉ l ⇒ ¬Collinear A B C TwoSidesTriangle1Intersection |- ∀A B C Y. ¬Collinear A B C ∧ Collinear B C Y ∧ Collinear A C Y ⇒ Y = C OriginInRay |- ∀ O Q. ¬(Q = O) ⇒ O ∈ ray O Q EndpointInRay |- ∀ O Q. ¬(Q = O) ⇒ Q ∈ ray O Q I1Uniqueness |- ∀ X l m. Line l ∧ Line m ∧ ¬(l = m) ∧ X ∈ l ∧ X ∈ m ⇒ l ∩ m = {X} EquivIntersection |- ∀ A B X l m. Line l ∧ Line m ∧ l ∩ m = {X} ∧ A ∈ m â” X ∧ B ∈ m â” X ∧ X ∉ open (A,B) ⇒ A,B same_side l RayLine |- ∀ O P l. Line l ∧ O ∈ l ∧ P ∈ l ⇒ ray O P ⊂ l RaySameSide |- ∀ l O A P. Line l ∧ O ∈ l ∧ A ∉ l ∧ P ∈ ray O A â” O ⇒ P ∉ l ∧ P,A same_side l IntervalRayEZ |- ∀ A B C. B ∈ open (A,C) ⇒ B ∈ ray A C â” A ∧ C ∈ ray A B â” A NoncollinearityExtendsToLine |- ∀ A O B X. ¬Collinear A O B ∧ Collinear O B X ∧ ¬(X = O) ⇒ ¬Collinear A O X SameSideReflexive |- ∀ l A. Line l ∧ A ∉ l ⇒ A,A same_side l SameSideSymmetric |- ∀ l A B. Line l ∧ A ∉ l ∧ B ∉ l ∧ A,B same_side l ⇒ B,A same_side l SameSideTransitive |- ∀l A B C. Line l ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l ConverseCrossbar |- ∀ O A B G. ¬Collinear A O B ∧ G ∈ open (A,B) ⇒ G ∈ int_angle A O B InteriorUse |- ∀ A O B P a b. Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∈ int_angle A O B ⇒ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b InteriorEZHelp |- ∀ A O B P. P ∈ int_angle A O B ⇒ ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) ∧ ¬Collinear A O P InteriorAngleSymmetry |- ∀ A O B P. P ∈ int_angle A O B ⇒ P ∈ int_angle B O A InteriorWellDefined |- ∀ A O B X P. P ∈ int_angle A O B ∧ X ∈ ray O B â” O ⇒ P ∈ int_angle A O X WholeRayInterior |- ∀A O B X P. X ∈ int_angle A O B ∧ P ∈ ray O X â” O ⇒ P ∈ int_angle A O B AngleOrdering |- ∀ O A P Q a. ¬(O = A) ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ P ∉ a ∧ Q ∉ a ∧ P,Q same_side a ∧ ¬Collinear P O Q ⇒ P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A InteriorsDisjointSupplement |- ∀A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ⇒ int_angle A O B ∩ int_angle B O A' = ∅ InteriorReflectionInterior |- ∀ A O B D A'. O ∈ open (A,A') ∧ D ∈ int_angle A O B ⇒ B ∈ int_angle D O A' Crossbar_THM |- ∀ O A B D. D ∈ int_angle A O B ⇒ ∃ G. G ∈ open (A,B) ∧ G ∈ ray O D â” O AlternateConverseCrossbar |- ∀ O A B G. Collinear A G B ∧ G ∈ int_angle A O B ⇒ G ∈ open (A,B) InteriorOpposite |- ∀ A O B P p. P ∈ int_angle A O B ∧ Line p ∧ O ∈ p ∧ P ∈ p ⇒ ¬(A,B same_side p) IntervalTransitivity |- ∀ O P Q R m. Line m ∧ O ∈ m ∧ P ∈ m â” O ∧ Q ∈ m â” O ∧ R ∈ m â” O ∧ O ∉ open (P,Q) ∧ O ∉ open (Q,R) ⇒ O ∉ open (P,R) RayWellDefinedHalfway |- ∀ O P Q. ¬(Q = O) ∧ P ∈ ray O Q â” O ⇒ ray O P ⊂ ray O Q RayWellDefined |- ∀ O P Q. ¬(Q = O) ∧ P ∈ ray O Q â” O ⇒ ray O P = ray O Q OppositeRaysIntersect1pointHelp |- ∀ A O B X. O ∈ open (A,B) ∧ X ∈ ray O B â” O ⇒ X ∉ ray O A ∧ O ∈ open (X,A) OppositeRaysIntersect1point |- ∀ A O B. O ∈ open (A,B) ⇒ ray O A ∩ ray O B = {O} IntervalRay |- ∀ A B C. B ∈ open (A,C) ⇒ ray A B = ray A C Reverse4Order |- ∀ A B C D. ordered A B C D ⇒ ordered D C B A TransitivityBetweennessHelp |- ∀ A B C D. B ∈ open (A,C) ∧ C ∈ open (B,D) ⇒ B ∈ open (A,D) TransitivityBetweenness |- ∀ A B C D. B ∈ open (A,C) ∧ C ∈ open (B,D) ⇒ ordered A B C D IntervalsAreConvex |- ∀ A B C. B ∈ open (A,C) ⇒ open (A,B) ⊂ open (A,C) TransitivityBetweennessVariant |- ∀ A X B C. X ∈ open (A,B) ∧ B ∈ open (A,C) ⇒ ordered A X B C Interval2sides2aLineHelp |- ∀ A B C X. B ∈ open (A,C) ⇒ X ∉ open (A,B) ∨ X ∉ open (B,C) Interval2sides2aLine |- ∀ A B C X. Collinear A B C ⇒ X ∉ open (A,B) ∨ X ∉ open (A,C) ∨ X ∉ open (B,C) TwosidesTriangle2aLine |- ∀A B C Y l m. Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ Line m ∧ A ∈ m ∧ C ∈ m ∧ Y ∈ l ∧ Y ∈ m ∧ ¬(A,B same_side l) ∧ ¬(B,C same_side l) ⇒ A,C same_side l LineUnionOf2Rays |- ∀ A O B l. Line l ∧ A ∈ l ∧ B ∈ l ∧ O ∈ open (A,B) ⇒ l = ray O A ∪ ray O B AtMost2Sides |- ∀ A B C l. Line l ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ⇒ A,B same_side l ∨ A,C same_side l ∨ B,C same_side l FourPointsOrder |- ∀ A B C X l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ X ∈ l ∧ B ∈ open (A,C) ∧ ¬(X = A) ∧ ¬(X = B) ∧ ¬(X = C) ⇒ ordered X A B C ∨ ordered A X B C ∨ ordered A B X C ∨ ordered A B C X HilbertAxiomRedundantByMoore |- ∀ A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ D ∈ l ∧ ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ⇒ ordered D A B C ∨ ordered A D B C ∨ ordered A B D C ∨ ordered A B C D ∨ ordered D A C B ∨ ordered A D C B ∨ ordered A C D B ∨ ordered A C B D ∨ ordered D C A B ∨ ordered C D A B ∨ ordered C A D B ∨ ordered C A B D InteriorTransitivity |- ∀A O B F G. G ∈ int_angle A O B ∧ F ∈ int_angle A O G ⇒ F ∈ int_angle A O B HalfPlaneConvexNonempty |- ∀l H A. Line l ∧ A ∉ l ∧ H = {X | X ∉ l ∧ X,A same_side l} ⇒ ¬(H = ∅) ∧ H ⊂ complement l ∧ Convex H PlaneSeparation |- ∀ l. Line l ⇒ ∃ H1 H2. H1 ∩ H2 = ∅ ∧ ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ Convex H1 ∧ Convex H2 ∧ complement l = H1 ∪ H2 ∧ ∀ P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) TetralateralSymmetry |- ∀ A B C D. Tetralateral A B C D ⇒ Tetralateral B C D A ∧ Tetralateral A B D C EasyEmptyIntersectionsTetralateralHelp |- ∀ A B C D. Tetralateral A B C D ⇒ open (A,B) ∩ open (B,C) = ∅ EasyEmptyIntersectionsTetralateral |- ∀ A B C D. Tetralateral A B C D ⇒ open (A,B) ∩ open (B,C) = ∅ ∧ open (B,C) ∩ open (C,D) = ∅ ∧ open (C,D) ∩ open (D,A) = ∅ ∧ open (D,A) ∩ open (A,B) = ∅ SegmentSameSideOppositeLine |- ∀ A B C D a c. Quadrilateral A B C D ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c ⇒ A,B same_side c ∨ C,D same_side a ConvexImpliesQuad |- ∀ A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C ⇒ Quadrilateral A B C D DiagonalsIntersectImpliesConvexQuad |- ∀ A B C D G. ¬Collinear B C D ∧ G ∈ open (A,C) ∧ G ∈ open (B,D) ⇒ ConvexQuadrilateral A B C D DoubleNotSimImpliesDiagonalsIntersect |- ∀ A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m ∧ Tetralateral A B C D ∧ ¬(B,D same_side l) ∧ ¬(A,C same_side m) ⇒ (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ConvexQuadrilateral A B C D ConvexQuadImpliesDiagonalsIntersect |- ∀ A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m ∧ ConvexQuadrilateral A B C D ⇒ ¬(B,D same_side l) ∧ ¬(A,C same_side m) ∧ (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ¬Quadrilateral A B D C FourChoicesTetralateralHelp |- ∀ A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B ⇒ ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B InteriorTriangleSymmetry |- ∀ A B C P. P ∈ int_triangle A B C ⇒ P ∈ int_triangle B C A FourChoicesTetralateral |- ∀ A B C D a. Tetralateral A B C D ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ C,D same_side a ⇒ ConvexQuadrilateral A B C D ∨ ConvexQuadrilateral A B D C ∨ D ∈ int_triangle A B C ∨ C ∈ int_triangle D A B QuadrilateralSymmetry |- ∀ A B C D. Quadrilateral A B C D ⇒ Quadrilateral B C D A ∧ Quadrilateral C D A B ∧ Quadrilateral D A B C FiveChoicesQuadrilateral |- ∀ A B C D l m. Quadrilateral A B C D ∧ Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m ⇒ (ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) ∧ (¬(B,D same_side l) ∨ ¬(A,C same_side m)) IntervalSymmetry |- ∀ A B. open (A,B) = open (B,A) SegmentSymmetry |- ∀ A B. seg A B = seg B A C1OppositeRay |- ∀ O P s. Segment s ∧ ¬(O = P) ⇒ ∃ Q. P ∈ open (O,Q) ∧ seg P Q ≡ s OrderedCongruentSegments |- ∀ A B C D F. ¬(A = C) ∧ ¬(D = F) ∧ seg A C ≡ seg D F ∧ B ∈ open (A,C) ⇒ ∃ E. E ∈ open (D,F) ∧ seg A B ≡ seg D E SegmentSubtraction |- ∀ A B C A' B' C'. B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ⇒ seg B C ≡ seg B' C' SegmentOrderingUse |- ∀A B s. Segment s ∧ ¬(A = B) ∧ s <__ seg A B ⇒ ∃ G. G ∈ open (A,B) ∧ s ≡ seg A G SegmentTrichotomy1 |- ∀ s t. s <__ t ⇒ ¬(s ≡ t) SegmentTrichotomy2 |- ∀ s t u. s <__ t ∧ Segment u ∧ t ≡ u ⇒ s <__ u SegmentOrderTransitivity |- ∀ s t u. s <__ t ∧ t <__ u ⇒ s <__ u SegmentTrichotomy |- ∀ s t. Segment s ∧ Segment t ⇒ (s ≡ t ∨ s <__ t ∨ t <__ s) ∧ ¬(s ≡ t ∧ s <__ t) ∧ ¬(s ≡ t ∧ t <__ s) ∧ ¬(s <__ t ∧ t <__ s) C4Uniqueness |- ∀ O A B P l. Line l ∧ O ∈ l ∧ A ∈ l ∧ ¬(O = A) ∧ B ∉ l ∧ P ∉ l ∧ P,B same_side l ∧ ∡ A O P ≡ ∡ A O B ⇒ ray O B = ray O P AngleSymmetry |- ∀ A O B. ∡ A O B = ∡ B O A TriangleCongSymmetry |- ∀ A B C A' B' C'. A,B,C ≅ A',B',C' ⇒ A,C,B ≅ A',C',B' ∧ B,A,C ≅ B',A',C' ∧ B,C,A ≅ B',C',A' ∧ C,A,B ≅ C',A',B' ∧ C,B,A ≅ C',B',A' SAS |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ⇒ A,B,C ≅ A',B',C' ASA |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A C ≡ seg A' C' ∧ ∡ C A B ≡ ∡ C' A' B' ∧ ∡ B C A ≡ ∡ B' C' A' ⇒ A,B,C ≅ A',B',C' AngleSubtraction |- ∀ A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ∧ ∡ A O B ≡ ∡ A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' ⇒ ∡ G O B ≡ ∡ G' O' B' OrderedCongruentAngles |- ∀ A O B A' O' B' G. ¬Collinear A' O' B' ∧ ∡ A O B ≡ ∡ A' O' B' ∧ G ∈ int_angle A O B ⇒ ∃ G'. G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' AngleAddition |- ∀ A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' ∧ ∡ G O B ≡ ∡ G' O' B' ∧ ⇒ ∡ A O B ≡ ∡ A' O' B' AngleOrderingUse |- ∀ A O B α. Angle α ∧ ¬Collinear A O B ∧ α <_ang ∡ A O B ⇒ (∃ G. G ∈ int_angle A O B ∧ α ≡ ∡ A O G) AngleTrichotomy1 |- ∀ α β. α <_ang β ⇒ ¬(α ≡ β) AngleTrichotomy2 |- ∀ α β γ. α <_ang β ∧ Angle γ ∧ β ≡ γ ⇒ α <_ang γ AngleOrderTransitivity |- ∀α β γ. α <_ang β ∧ β <_ang γ ⇒ α <_ang γ AngleTrichotomy |- ∀ α β. Angle α ∧ Angle β ⇒ (α ≡ β ∨ α <_ang β ∨ β <_ang α) ∧ ¬(α ≡ β ∧ α <_ang β) ∧ ¬(α ≡ β ∧ β <_ang α) ∧ ¬(α <_ang β ∧ β <_ang α) SupplementExists |- ∀ α. Angle α ⇒ ∃ α'. α suppl α' SupplementImpliesAngle |- ∀ α β. α suppl β ⇒ Angle α ∧ Angle β RightImpliesAngle |- ∀ α. Right α ⇒ Angle α SupplementSymmetry |- ∀ α β. α suppl β ⇒ β suppl α SupplementsCongAnglesCong |- ∀ α β α' β'. α suppl α' ∧ β suppl β' ∧ α ≡ β ⇒ α' ≡ β' SupplementUnique |- ∀ α β β'. α suppl β ∧ α suppl β' ⇒ β ≡ β' CongRightImpliesRight |- ∀ α β. Angle α ∧ Right β ∧ α ≡ β ⇒ Right α RightAnglesCongruentHelp |- ∀ A O B A' P a. ¬Collinear A O B ∧ O ∈ open (A,A') Right (∡ A O B) ∧ Right (∡ A O P) ⇒ P ∉ int_angle A O B RightAnglesCongruent |- ∀ α β. Right α ∧ Right β ⇒ α ≡ β OppositeRightAnglesLinear |- ∀ A B O H h. ¬Collinear A O H ∧ ¬Collinear H O B ∧ Right (∡ A O H) ∧ Right (∡ H O B) ∧ Line h ∧ O ∈ h ∧ H ∈ h ∧ ¬(A,B same_side h) ⇒ O ∈ open (A,B) RightImpliesSupplRight |- ∀ A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ Right (∡ A O B) ⇒ Right (∡ B O A') IsoscelesCongBaseAngles |- ∀ A B C. ¬Collinear A B C ∧ seg B A ≡ seg B C ⇒ ∡ C A B ≡ ∡ A C B C4withC1 |- ∀ α l O A Y P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ ∃ N. ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α C4OppositeSide |- ∀ α l O A Z P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Z ∉ l ⇒ ∃ N. ¬(O = N) ∧ N ∉ l ∧ ¬(Z,N same_side l) ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α SSS |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ⇒ A,B,C ≅ A',B',C' AngleBisector |- ∀ A B C. ¬Collinear B A C ⇒ ∃ F. F ∈ int_angle B A C ∧ ∡ B A F ≡ ∡ F A C EuclidPropositionI_6 |- ∀ A B C. ¬Collinear A B C ∧ ∡ B A C ≡ ∡ B C A ⇒ seg B A ≡ seg B C IsoscelesExists |- ∀ A B. ¬(A = B) ⇒ ∃ D. ¬Collinear A D B ∧ seg D A ≡ seg D B MidpointExists |- ∀ A B. ¬(A = B) ⇒ ∃ M. M ∈ open (A,B) ∧ seg A M ≡ seg M B EuclidPropositionI_7short |- ∀ A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ∧ seg A C ≡ seg A D ⇒ ¬(seg B C ≡ seg B D) EuclidPropI_7Help |- ∀ A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ∧ seg A C ≡ seg A D ∧ (C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B C D) ⇒ ¬(seg B C ≡ seg B D) EuclidPropositionI_7 |- ∀ A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ∧ seg A C ≡ seg A D ⇒ ¬(seg B C ≡ seg B D) EuclidPropositionI_11 |- ∀A B. ¬(A = B) ⇒ ∃ F. Right (∡ A B F) DropPerpendicularToLine |- ∀ P l. Line l ∧ P ∉ l ⇒ ∃ E Q. E ∈ l ∧ Q ∈ l ∧ Right (∡ P Q E) EuclidPropositionI_14 |- ∀ A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ ¬(A = B) ∧ C ∉ l ∧ D ∉ l ∧ ¬(C,D same_side l) ∧ ∡ C B A suppl ∡ A B D ⇒ B ∈ open (C,D) VerticalAnglesCong |- ∀ A B O A' B'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ O ∈ open (B,B') ⇒ ∡ B O A' ≡ ∡ B' O A EuclidPropositionI_16 |- ∀ A B C D. ¬Collinear A B C ∧ C ∈ open (B,D) ⇒ ∡ B A C <_ang ∡ D C A ExteriorAngle |- ∀ A B C D. ¬Collinear A B C ∧ C ∈ open (B,D) ⇒ ∡ A B C <_ang ∡ A C D EuclidPropositionI_17 |- ∀ A B C α β γ. ¬Collinear A B C ∧ α = ∡ A B C ∧ β = ∡ B C A ∧ β suppl γ ⇒ α <_ang γ EuclidPropositionI_18 |- ∀ A B C. ¬Collinear A B C ∧ seg A C <__ seg A B ⇒ ∡ A B C <_ang ∡ B C A EuclidPropositionI_19 |- ∀ A B C. ¬Collinear A B C ∧ ∡ A B C <_ang ∡ B C A ⇒ seg A C <__ seg A B EuclidPropositionI_20 |- ∀ A B C D. ¬Collinear A B C ∧ A ∈ open (B,D) ∧ seg A D ≡ seg A C ⇒ seg B C <__ seg B D EuclidPropositionI_21 |- ∀ A B C D. ¬Collinear A B C ∧ D ∈ int_triangle A B C ⇒ ∡ A B C <_ang ∡ C D A AngleTrichotomy3 |- ∀ α β γ. α <_ang β ∧ Angle γ ∧ γ ≡ α ⇒ γ <_ang β InteriorCircleConvexHelp |- ∀ O A B C. ¬Collinear A O C ∧ B ∈ open (A,C) ∧ seg O A <__ seg O C ∨ seg O A ≡ seg O C ⇒ seg O B <__ seg O C InteriorCircleConvex |- ∀ O R A B C. ¬(O = R) ∧ B ∈ open (A,C) ∧ A ∈ int_circle O R ∧ C ∈ int_circle O R ⇒ B ∈ int_circle O R SegmentTrichotomy3 |- ∀ s t u. s <__ t ∧ Segment u ∧ u ≡ s ⇒ u <__ t EuclidPropositionI_24Help |- ∀ O A C O' D F. ¬Collinear A O C ∧ ¬Collinear D O' F ∧ seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ ∡ D O' F <_ang ∡ A O C ∧ seg O A <__ seg O C ∨ seg O A ≡ seg O C ⇒ seg D F <__ seg A C EuclidPropositionI_24 |- ∀ O A C O' D F. ¬Collinear A O C ∧ ¬Collinear D O' F ∧ seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ ∡ D O' F <_ang ∡ A O C ⇒ seg D F <__ seg A C EuclidPropositionI_25 |- ∀ O A C O' D F. ¬Collinear A O C ∧ ¬Collinear D O' F ∧ seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ seg D F <__ seg A C ⇒ ∡ D O' F <_ang ∡ A O C AAS |- ∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ seg A B ≡ seg A' B' ⇒ A,B,C ≅ A',B',C' ParallelSymmetry |- ∀ l k. l ∥ k ⇒ k ∥ l AlternateInteriorAngles |- ∀ A B C E l m t. Line l ∧ A ∈ l ∧ E ∈ l ∧ Line m ∧ B ∈ m ∧ C ∈ m ∧ Line t ∧ A ∈ t ∧ B ∈ t ∧ ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ∧ ¬(C,E same_side t) ∧ ∡ E A B ≡ ∡ C B A ⇒ l ∥ m EuclidPropositionI_28 |- ∀ A B C D E F G H l m t. Line l ∧ A ∈ l ∧ B ∈ l ∧ G ∈ l ∧ Line m ∧ C ∈ m ∧ D ∈ m ∧ H ∈ m ∧ Line t ∧ G ∈ t ∧ H ∈ t ∧ G ∉ m ∧ H ∉ l ∧ G ∈ open (A,B) ∧ H ∈ open (C,D) ∧ G ∈ open (E,H) ∧ H ∈ open (F,G) ∧ ¬(D,A same_side t) ∧ ∡ E G B ≡ ∡ G H D ∨ ∡ B G H suppl ∡ G H D ⇒ l ∥ m OppositeSidesCongImpliesParallelogram |- ∀ A B C D. Quadrilateral A B C D ∧ seg A B ≡ seg C D ∧ seg B C ≡ seg D A ⇒ Parallelogram A B C D OppositeAnglesCongImpliesParallelogramHelp |- ∀ A B C D a c. Quadrilateral A B C D ∧ ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c ⇒ a ∥ c OppositeAnglesCongImpliesParallelogram |- ∀ A B C D. Quadrilateral A B C D ∧ ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ⇒ Parallelogram A B C D P |- ∀ P l. Line l ∧ P ∉ l ⇒ ∃! m. Line m ∧ P ∈ m ∧ m ∥ l AMa |- ∀ α. Angle α ⇒ &0 < μ α ∧ μ α < &180 AMb |- ∀ α. Right α ⇒ μ α = &90 AMc |- ∀ α β. Angle α ∧ Angle β ∧ α ≡ β ⇒ μ α = μ β AMd |- ∀ A O B P. P ∈ int_angle A O B ⇒ μ (∡ A O B) = μ (∡ A O P) + μ (∡ P O B) ConverseAlternateInteriorAngles |- ∀ A B C E l m t. Line l ∧ A ∈ l ∧ E ∈ l ∧ Line m ∧ B ∈ m ∧ C ∈ m ∧ Line t ∧ A ∈ t ∧ B ∈ t ∧ ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ∧ ¬(C,E same_side t) ∧ l ∥ m ⇒ ∡ E A B ≡ ∡ C B A HilbertTriangleSum |- ∀ A B C. ¬Collinear A B C ⇒ ∃ E F. B ∈ open (E,F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A EuclidPropositionI_13 |- ∀A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ⇒ μ (∡ A O B) + μ (∡ B O A') = &180 TriangleSum |- ∀ A B C. ¬Collinear A B C ⇒ μ (∡ A B C) + μ (∡ B C A) + μ (∡ C A B) = &180 hol-light/RichterHilbertAxiomGeometry/thmTopology000066400000000000000000001570571303454263000226600ustar00rootroot00000000000000EXTENSION |- ∀s t. s = t ⇔ (∀x. x ∈ s ⇔ x ∈ t) SUBSET |- ∀s t. s ⊂ t ⇔ (∀x. x ∈ s ⇒ x ∈ t) SUBSET_REFL |- ∀s. s ⊂ s SUBSET_TRANS |- ∀s t u. s ⊂ t ∧ t ⊂ u ⇒ s ⊂ u SUBSET_ANTISYM |- ∀s t. s ⊂ t ∧ t ⊂ s ⇒ s = t SUBSET_ANTISYM_EQ |- ∀s t. s ⊂ t ∧ t ⊂ s ⇔ s = t SUBSET_INTER_ABSORPTION |- ∀s t. s ⊂ t ⇔ s ∩ t = s SUBSET_UNIV |- ∀s. s ⊂ (:A) IN_INSERT |- ∀x y s. x ∈ y INSERT s ⇔ x = y ∨ x ∈ s IN_DIFF |- ∀s t x. x ∈ s â” t ⇔ x ∈ s ∧ ¬(x ∈ t) IN_SING |- ∀x y. x ∈ {y} ⇔ x = y IN_UNION |- ∀s t x. x ∈ s ∪ t ⇔ x ∈ s ∨ x ∈ t IN_INTER |- ∀s t x. x ∈ s ∩ t ⇔ x ∈ s ∧ x ∈ t IN_UNIONS |- ∀s x. x ∈ UNIONS s ⇔ (∃t. t ∈ s ∧ x ∈ t) IN_INTERS |- ∀s x. x ∈ INTERS s ⇔ (∀t. t ∈ s ⇒ x ∈ t) IN_UNIV |- ∀x. x ∈ (:A) EMPTY |- ∅ = (λx. F) NOT_IN_EMPTY |- ∀x. ¬(x ∈ ∅) SUBSET_EMPTY |- ∀s. s ⊂ ∅ ⇔ s = ∅ MEMBER_NOT_EMPTY |- ∀s. (∃x. x ∈ s) ⇔ ¬(s = ∅) EMPTY_SUBSET |- ∀s. ∅ ⊂ s DIFF_EMPTY |- ∀s. s ┠∅ = s DIFF_EQ_EMPTY |- ∀s. s â” s = ∅ EMPTY_DIFF |- ∀s. ∅ â” s = ∅ INTER_EMPTY |- (∀s. ∅ ∩ s = ∅) ∧ (∀s. s ∩ ∅ = ∅) NOT_INSERT_EMPTY |- ∀x s. ¬(x INSERT s = ∅) SUBSET_DIFF |- ∀s t. s â” t ⊂ s SING_SUBSET |- ∀s x. {x} ⊂ s ⇔ x ∈ s INSERT_SUBSET |- ∀x s t. x INSERT s ⊂ t ⇔ x ∈ t ∧ s ⊂ t INTER_SUBSET |- (∀s t. s ∩ t ⊂ s) ∧ (∀s t. t ∩ s ⊂ s) SUBSET_INTER |- ∀s t u. s ⊂ t ∩ u ⇔ s ⊂ t ∧ s ⊂ u SUBSET_UNION |- (∀s t. s ⊂ s ∪ t) ∧ (∀s t. s ⊂ t ∪ s) UNION_SUBSET |- ∀s t u. s ∪ t ⊂ u ⇔ s ⊂ u ∧ t ⊂ u UNION_IDEMPOT |- ∀s. s ∪ s = s UNION_COMM |- ∀s t. s ∪ t = t ∪ s INTER_IDEMPOT |- ∀s. s ∩ s = s INTER_COMM |- ∀s t. s ∩ t = t ∩ s INTERS_SUBSET |- ∀f t. ¬(f = ∅) ∧ (∀s. s ∈ f ⇒ s ⊂ t) ⇒ INTERS f ⊂ t UNIONS_SUBSET |- ∀f t. UNIONS f ⊂ t ⇔ (∀s. s ∈ f ⇒ s ⊂ t) FORALL_SUBSET_IMAGE |- ∀P f s. (∀t. t ⊂ IMAGE f s ⇒ P t) ⇔ (∀t. t ⊂ s ⇒ P (IMAGE f t)) INTERS_INSERT |- INTERS (s INSERT u) = s ∩ INTERS u FORALL_IN_INSERT |- ∀P a s. (∀x. x ∈ a INSERT s ⇒ P x) ⇔ P a ∧ (∀x. x ∈ s ⇒ P x) INTERS_0 |- INTERS ∅ = (:A) INTER_UNIV |- (∀s. (:A) ∩ s = s) ∧ (∀s. s ∩ (:A) = s) ∉ |- ∀a l. a ∉ l ⇔ ¬(a ∈ l) DIFF_UNION |- ∀u s t. u â” (s ∪ t) = (u â” s) ∩ (u â” t) DIFF_INTER |- ∀u s t. u â” s ∩ t = u â” s ∪ u â” t DIFF_REFL |- ∀u t. t ⊂ u ⇒ u â” (u â” t) = t DIFF_SUBSET |- ∀u s t. s ⊂ t ⇒ s â” u ⊂ t â” u DOUBLE_DIFF_UNION |- ∀A s t. A â” s â” t = A â” (s ∪ t) SUBSET_COMPLEMENT |- ∀s t A. s ⊂ A ⇒ (s ⊂ A â” t ⇔ s ∩ t = ∅) COMPLEMENT_DISJOINT |- ∀s t A. s ⊂ A ⇒ (s ⊂ t ⇔ s ∩ (A â” t) = ∅) COMPLEMENT_DUALITY |- ∀A s t. s ⊂ A ∧ t ⊂ A ⇒ (s = t ⇔ A â” s = A â” t) COMPLEMENT_DUALITY_UNION |- ∀A s t. s ⊂ A ∧ t ⊂ A ∧ u ⊂ A ⇒ (s = t ∪ u ⇔ A â” s = (A â” t) ∩ (A â” u)) SUBSET_DUALITY |- ∀s t u. t ⊂ u ⇒ s â” u ⊂ s â” t COMPLEMENT_INTER_DIFF |- ∀A s t. s ⊂ A ⇒ s â” t = s ∩ (A â” t) INTERS_SUBSET |- ∀f t. ¬(f = ∅) ∧ (∀s. s ∈ f ⇒ s ⊂ t) ⇒ INTERS f ⊂ t IN_SET_FUNCTION_PREDICATE |- ∀x f P. x ∈ {f y | P y} ⇔ (∃y. x = f y ∧ P y) INTER_TENSOR |- ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∩ t ⊂ s' ∩ t' UNION_TENSOR |- ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∪ t ⊂ s' ∪ t' ExistsTensorInter |- ∀F G H. (∀x y. F x ∧ G y ⇒ H (x ∩ y)) ⇒ (∃x. F x) ∧ (∃y. G y) ⇒ (∃z. H z) istopology |- ∀X L. istopology (X,L) ⇔ (∀U. U ∈ L ⇒ U ⊂ X) ∧ ∅ ∈ L ∧ X ∈ L ∧ (∀s t. s ∈ L ∧ t ∈ L ⇒ s ∩ t ∈ L) ∧ (∀k. k ⊂ L ⇒ UNIONS k ∈ L) UnderlyingSpace |- ∀α. UnderlyingSpace α = FST α OpenSets |- ∀α. OpenSets α = SND α ExistsTopology |- ∀X. ∃α. istopology α ∧ UnderlyingSpace α = X topology_tybij_th |- ∃t. istopology t topology_tybij |- (∀a. mk_topology (dest_topology a) = a) ∧ (∀r. istopology r ⇔ dest_topology (mk_topology r) = r) ISTOPOLOGYdest_topology |- ∀α. istopology (dest_topology α) OpenIn |- ∀α. open_in α = OpenSets (dest_topology α) topspace |- ∀α. topspace α = UnderlyingSpace (dest_topology α) TopologyPAIR |- ∀α. dest_topology α = topspace α,open_in α Topology_Eq |- ∀α β. topspace α = topspace β ∧ (∀U. open_in α U ⇔ open_in β U) ⇔ α = β OpenInCLAUSES |- ∀α X. topspace α = X ⇒ (∀U. open_in α U ⇒ U ⊂ X) ∧ open_in α ∅ ∧ open_in α X ∧ (∀s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∩ t)) ∧ (∀k. (∀s. s ∈ k ⇒ open_in α s) ⇒ open_in α (UNIONS k)) OPEN_IN_SUBSET |- ∀α s. open_in α s ⇒ s ⊂ topspace α OPEN_IN_EMPTY |- ∀α. open_in α ∅ OPEN_IN_INTER |- ∀α s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∩ t) OPEN_IN_UNIONS |- ∀α k. (∀s. s ∈ k ⇒ open_in α s) ⇒ open_in α (UNIONS k) OpenInTopspace |- ∀α. open_in α (topspace α) OPEN_IN_UNION |- ∀α s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∪ t) OPEN_IN_TOPSPACE |- ∀α. open_in α (topspace α) OPEN_IN_INTERS |- ∀α s. FINITE s ∧ ¬(s = ∅) ∧ (∀t. t ∈ s ⇒ open_in α t) ⇒ open_in α (INTERS s) OPEN_IN_SUBOPEN |- ∀α s. open_in α s ⇔ (∀x. x ∈ s ⇒ (∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s)) closed_in |- ∀α s. closed_in α s ⇔ s ⊂ topspace α ∧ open_in α (topspace α â” s) CLOSED_IN_SUBSET |- ∀α s. closed_in α s ⇒ s ⊂ topspace α CLOSED_IN_EMPTY |- ∀α. closed_in α ∅ CLOSED_IN_TOPSPACE |- ∀α. closed_in α (topspace α) CLOSED_IN_UNION |- ∀α s t. closed_in α s ∧ closed_in α t ⇒ closed_in α (s ∪ t) CLOSED_IN_INTERS |- ∀α k. ¬(k = ∅) ∧ (∀s. s ∈ k ⇒ closed_in α s) ⇒ closed_in α (INTERS k) CLOSED_IN_FORALL_IN |- ∀α P Q. ¬(P = ∅) ∧ (∀a. P a ⇒ closed_in α {x | Q a x}) ⇒ closed_in α {x | ∀a. P a ⇒ Q a x} CLOSED_IN_INTER |- ∀α s t. closed_in α s ∧ closed_in α t ⇒ closed_in α (s ∩ t) OPEN_IN_CLOSED_IN_EQ |- ∀α s. open_in α s ⇔ s ⊂ topspace α ∧ closed_in α (topspace α â” s) OPEN_IN_CLOSED_IN |- ∀s. s ⊂ topspace α ⇒ (open_in α s ⇔ closed_in α (topspace α â” s)) OPEN_IN_DIFF |- ∀α s t. open_in α s ∧ closed_in α t ⇒ open_in α (s â” t) CLOSED_IN_DIFF |- ∀α s t. closed_in α s ∧ open_in α t ⇒ closed_in α (s â” t) CLOSED_IN_UNIONS |- ∀α s. FINITE s ∧ (∀t. t ∈ s ⇒ closed_in α t) ⇒ closed_in α (UNIONS s) subtopology |- ∀α u. subtopology α u = mk_topology (u,{s ∩ u | open_in α s}) IstopologySubtopology |- ∀α u. u ⊂ topspace α ⇒ istopology (u,{s ∩ u | open_in α s}) OpenInSubtopology |- ∀α u s. u ⊂ topspace α ⇒ (open_in (subtopology α u) s ⇔ ∃t. open_in α t ∧ s = t ∩ u) TopspaceSubtopology |- ∀α u. u ⊂ topspace α ⇒ topspace (subtopology α u) = u OpenInRefl |- ∀α s. s ⊂ topspace α ⇒ open_in (subtopology α s) s ClosedInRefl |- ∀α s. s ⊂ topspace α ⇒ closed_in (subtopology α s) s ClosedInSubtopology |- ∀α u C. u ⊂ topspace α ⇒ (closed_in (subtopology α u) C ⇔ ∃D. closed_in α D ∧ C = D ∩ u) OPEN_IN_SUBTOPOLOGY_EMPTY |- ∀α s. open_in (subtopology α ∅) s ⇔ s = ∅ CLOSED_IN_SUBTOPOLOGY_EMPTY |- ∀α s. closed_in (subtopology α ∅) s ⇔ s = ∅ SUBTOPOLOGY_TOPSPACE |- ∀α. subtopology α (topspace α) = α OpenInImpSubset |- ∀α s t. s ⊂ topspace α ⇒ open_in (subtopology α s) t ⇒ t ⊂ s ClosedInImpSubset |- ∀α s t. s ⊂ topspace α ⇒ closed_in (subtopology α s) t ⇒ t ⊂ s OpenInSubtopologyUnion |- ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ open_in (subtopology α t) s ∧ open_in (subtopology α u) s ⇒ open_in (subtopology α (t ∪ u)) s ClosedInSubtopologyUnion |- ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ closed_in (subtopology α t) s ∧ closed_in (subtopology α u) s ⇒ closed_in (subtopology α (t ∪ u)) s OpenInSubtopologyInterOpen |- ∀α s t u. u ⊂ topspace α ⇒ open_in (subtopology α u) s ∧ open_in α t ⇒ open_in (subtopology α u) (s ∩ t) OpenInOpenInter |- ∀α u s. u ⊂ topspace α ⇒ open_in α s ⇒ open_in (subtopology α u) (u ∩ s) OpenOpenInTrans |- ∀α s t. open_in α s ∧ open_in α t ∧ t ⊂ s ⇒ open_in (subtopology α s) t ClosedClosedInTrans |- ∀α s t. closed_in α s ∧ closed_in α t ∧ t ⊂ s ⇒ closed_in (subtopology α s) t OpenSubset |- ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ∧ open_in α s ⇒ open_in (subtopology α t) s ClosedSubsetEq |- ∀α u s. u ⊂ topspace α ⇒ closed_in α s ⇒ (closed_in (subtopology α u) s ⇔ s ⊂ u) ClosedInInterClosed |- ∀α s t u. u ⊂ topspace α ⇒ closed_in (subtopology α u) s ∧ closed_in α t ⇒ closed_in (subtopology α u) (s ∩ t) ClosedInClosedInter |- ∀α u s. u ⊂ topspace α ⇒ closed_in α s ⇒ closed_in (subtopology α u) (u ∩ s) ClosedSubset |- ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ∧ closed_in α s ⇒ closed_in (subtopology α t) s OpenInSubsetTrans |- ∀α s t u. u ⊂ topspace α ∧ t ⊂ topspace α ⇒ open_in (subtopology α u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ open_in (subtopology α t) s ClosedInSubsetTrans |- ∀α s t u. u ⊂ topspace α ∧ t ⊂ topspace α ⇒ closed_in (subtopology α u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ closed_in (subtopology α t) s OpenInTrans |- ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ open_in (subtopology α t) s ∧ open_in (subtopology α u) t ⇒ open_in (subtopology α u) s OpenInTransEq |- ∀α s t. t ⊂ topspace α ∧ s ⊂ topspace α ⇒ ((∀u. open_in (subtopology α t) u ⇒ open_in (subtopology α s) t) ⇔ open_in (subtopology α s) t) OpenInOpenTrans |- ∀α u s. u ⊂ topspace α ⇒ open_in (subtopology α u) s ∧ open_in α u ⇒ open_in α s OpenInSubtopologyTrans |- ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ open_in (subtopology α t) s ∧ open_in (subtopology α u) t ⇒ open_in (subtopology α u) s SubtopologyOpenInSubopen |- ∀α u s. u ⊂ topspace α ⇒ (open_in (subtopology α u) s ⇔ s ⊂ u ∧ (∀x. x ∈ s ⇒ (∃t. open_in α t ∧ x ∈ t ∧ t ∩ u ⊂ s))) ClosedInSubtopologyTrans |- ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ closed_in (subtopology α t) s ∧ closed_in (subtopology α u) t ⇒ closed_in (subtopology α u) s ClosedInSubtopologyTransEq |- ∀α s t. t ⊂ topspace α ∧ s ⊂ topspace α ⇒ ((∀u. closed_in (subtopology α t) u ⇒ closed_in (subtopology α s) t) ⇔ closed_in (subtopology α s) t) ClosedInClosedTrans |- ∀α s t. u ⊂ topspace α ⇒ closed_in (subtopology α u) s ∧ closed_in α u ⇒ closed_in α s OpenInSubtopologyInterSubset |- ∀α s u v. u ⊂ topspace α ∧ v ⊂ topspace α ⇒ open_in (subtopology α u) (u ∩ s) ∧ v ⊂ u ⇒ open_in (subtopology α v) (v ∩ s) OpenInOpenEq |- ∀α s t. s ⊂ topspace α ⇒ open_in α s ⇒ (open_in (subtopology α s) t ⇔ open_in α t ∧ t ⊂ s) ClosedInClosedEq |- ∀α s t. s ⊂ topspace α ⇒ closed_in α s ⇒ (closed_in (subtopology α s) t ⇔ closed_in α t ∧ t ⊂ s) OpenImpliesSubtopologyInterOpen |- ∀α u s. u ⊂ topspace α ⇒ open_in α s ⇒ open_in (subtopology α u) (u ∩ s) OPEN_IN_EXISTS_IN |- ∀α P Q. (∀a. P a ⇒ open_in α {x | Q a x}) ⇒ open_in α {x | ∃a. P a ∧ Q a x} Connected_DEF |- ∀α. Connected α ⇔ ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) ConnectedClosedHelp |- ∀α e1 e2. topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ⇒ (closed_in α e1 ∧ closed_in α e2 ⇔ open_in α e1 ∧ open_in α e2) ConnectedClosed |- ∀α. Connected α ⇔ ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) ConnectedOpenIn |- ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. open_in (subtopology α s) e1 ∧ open_in (subtopology α s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))) ConnectedClosedIn |- ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. closed_in (subtopology α s) e1 ∧ closed_in (subtopology α s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))) ConnectedSubtopology |- ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅))) ConnectedSubtopology_ALT |- ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ (∀e1 e2. open_in α e1 ∧ open_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ⇒ e1 ∩ s = ∅ ∨ e2 ∩ s = ∅)) ConnectedClosedSubtopology |- ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅))) ConnectedClosedSubtopology_ALT |- ∀α s. s ⊂ topspace α ⇒ (Connected (subtopology α s) ⇔ (∀e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ⇒ e1 ∩ s = ∅ ∨ e2 ∩ s = ∅)) ConnectedClopen |- ∀α. Connected α ⇔ (∀t. open_in α t ∧ closed_in α t ⇒ t = ∅ ∨ t = topspace α) ConnectedClosedSet |- ∀α s. s ⊂ topspace α ⇒ closed_in α s ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) ConnectedOpenSet |- ∀α s. open_in α s ⇒ (Connected (subtopology α s) ⇔ ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) ConnectedEmpty |- ∀α. Connected (subtopology α ∅) ConnectedSing |- ∀α a. a ∈ topspace α ⇒ Connected (subtopology α {a}) ConnectedUnions |- ∀α P. (∀s. s ∈ P ⇒ s ⊂ topspace α) ⇒ (∀s. s ∈ P ⇒ Connected (subtopology α s)) ∧ ¬(INTERS P = ∅) ⇒ Connected (subtopology α (UNIONS P)) ConnectedUnion |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ∧ ¬(s ∩ t = ∅) ∧ Connected (subtopology α s) ∧ Connected (subtopology α t) ⇒ Connected (subtopology α (s ∪ t)) ConnectedDiffOpenFromClosed |- ∀α s t u. u ⊂ topspace α ⇒ s ⊂ t ∧ t ⊂ u ∧ open_in α s ∧ closed_in α t ∧ Connected (subtopology α u) ∧ Connected (subtopology α (t â” s)) ⇒ Connected (subtopology α (u â” s)) ConnectedDisjointUnionsOpenUniquePart1 |- ∀α f f' s t a. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ (∀s. s ∈ f ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ (∀s. s ∈ f' ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ UNIONS f = UNIONS f' ∧ s ∈ f ∧ t ∈ f' ∧ a ∈ s ∧ a ∈ t ⇒ s ⊂ t ConnectedDisjointUnionsOpenUnique |- ∀α f f'. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ (∀s. s ∈ f ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ (∀s. s ∈ f' ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ UNIONS f = UNIONS f' ⇒ f = f' ConnectedFromClosedUnionAndInter |- ∀α s t. s ∪ t ⊂ topspace α ∧ closed_in α s ∧ closed_in α t ∧ Connected (subtopology α (s ∪ t)) ∧ Connected (subtopology α (s ∩ t)) ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) ConnectedFromOpenUnionAndInter |- ∀α s t. s ∪ t ⊂ topspace α ∧ open_in α s ∧ open_in α t ∧ Connected (subtopology α (s ∪ t)) ∧ Connected (subtopology α (s ∩ t)) ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) ConnectedInduction |- ∀α P Q s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀t a. open_in (subtopology α s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ∧ Q a ⇒ Q b) ConnectedEquivalenceRelationGen |- ∀α P R s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀t a. open_in (subtopology α s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b) ConnectedEquivalenceRelationGen |- ∀α P R s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀t a. open_in (subtopology α s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b) ConnectedInductionSimple |- ∀α P s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ⇒ P y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ⇒ P b) ConnectedEquivalenceRelation |- ∀α R s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ (∀x. x ∈ t ⇒ R a x))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ⇒ R a b) LimitPointOf |- ∀α s. LimitPointOf α s = {x | s ⊂ topspace α ∧ x ∈ topspace α ∧ (∀t. x ∈ t ∧ open_in α t ⇒ (∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t))} IN_LimitPointOf |- ∀α s x. s ⊂ topspace α ⇒ (x ∈ LimitPointOf α s ⇔ x ∈ topspace α ∧ (∀t. x ∈ t ∧ open_in α t ⇒ (∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t))) NotLimitPointOf |- ∀α s x. s ⊂ topspace α ∧ x ∈ topspace α ⇒ (x ∉ LimitPointOf α s ⇔ (∃t. x ∈ t ∧ open_in α t ∧ s ∩ (t â” {x}) = ∅)) LimptSubset |- ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ LimitPointOf α s ⊂ LimitPointOf α t ClosedLimpt |- ∀α s. s ⊂ topspace α ⇒ (closed_in α s ⇔ LimitPointOf α s ⊂ s) LimptEmpty |- ∀α x. x ∈ topspace α ⇒ x ∉ LimitPointOf α ∅ NoLimitPointImpClosed |- ∀α s. s ⊂ topspace α ⇒ (∀x. x ∉ LimitPointOf α s) ⇒ closed_in α s LimitPointUnion |- ∀α s t. s ∪ t ⊂ topspace α ⇒ LimitPointOf α (s ∪ t) = LimitPointOf α s ∪ LimitPointOf α t Interior_DEF |- ∀α s. Interior α s = {x | s ⊂ topspace α ∧ (∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s)} Interior_THM |- ∀α s x. s ⊂ topspace α ⇒ Interior α s = {x | (∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s)} IN_Interior |- ∀α s x. s ⊂ topspace α ⇒ (x ∈ Interior α s ⇔ (∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s)) InteriorEq |- ∀α s. s ⊂ topspace α ⇒ (open_in α s ⇔ s = Interior α s) InteriorOpen |- ∀α s. open_in α s ⇒ Interior α s = s InteriorEmpty |- ∀α. Interior α ∅ = ∅ InteriorUniv |- ∀α. Interior α (topspace α) = topspace α OpenInterior |- ∀α s. s ⊂ topspace α ⇒ open_in α (Interior α s) InteriorInterior |- ∀α s. s ⊂ topspace α ⇒ Interior α (Interior α s) = Interior α s InteriorSubset |- ∀α s. s ⊂ topspace α ⇒ Interior α s ⊂ s InteriorTopspace |- ∀α s. s ⊂ topspace α ⇒ Interior α s ⊂ topspace α SubsetInterior |- ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ Interior α s ⊂ Interior α t InteriorMaximal |- ∀α s t. s ⊂ topspace α ⇒ t ⊂ s ∧ open_in α t ⇒ t ⊂ Interior α s InteriorMaximalEq |- ∀s t. t ⊂ topspace α ⇒ open_in α s ⇒ (s ⊂ Interior α t ⇔ s ⊂ t) InteriorUnique |- ∀α s t. s ⊂ topspace α ⇒ t ⊂ s ∧ open_in α t ∧ (∀t'. t' ⊂ s ∧ open_in α t' ⇒ t' ⊂ t) ⇒ Interior α s = t OpenSubsetInterior |- ∀α s t. t ⊂ topspace α ⇒ open_in α s ⇒ (s ⊂ Interior α t ⇔ s ⊂ t) InteriorInter |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α (s ∩ t) = Interior α s ∩ Interior α t InteriorFiniteInters |- ∀α s. FINITE s ⇒ ¬(s = ∅) ⇒ (∀t. t ∈ s ⇒ t ⊂ topspace α) ⇒ Interior α (INTERS s) = INTERS (IMAGE (Interior α) s) InteriorIntersSubset |- ∀α f. ¬(f = ∅) ∧ (∀t. t ∈ f ⇒ t ⊂ topspace α) ⇒ Interior α (INTERS f) ⊂ INTERS (IMAGE (Interior α) f) UnionInteriorSubset |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α s ∪ Interior α t ⊂ Interior α (s ∪ t) InteriorEqEmpty |- ∀α s. s ⊂ topspace α ⇒ (Interior α s = ∅ ⇔ (∀t. open_in α t ∧ t ⊂ s ⇒ t = ∅)) InteriorEqEmptyAlt |- ∀α s. s ⊂ topspace α ⇒ (Interior α s = ∅ ⇔ (∀t. open_in α t ∧ ¬(t = ∅) ⇒ ¬(t â” s = ∅))) InteriorUnionsOpenSubsets |- ∀α s. s ⊂ topspace α ⇒ UNIONS {t | open_in α t ∧ t ⊂ s} = Interior α s InteriorClosedUnionEmptyInterior |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ closed_in α s ∧ Interior α t = ∅ ⇒ Interior α (s ∪ t) = Interior α s InteriorUnionEqEmpty |- ∀α s t. s ∪ t ⊂ topspace α ⇒ closed_in α s ∨ closed_in α t ⇒ (Interior α (s ∪ t) = ∅ ⇔ Interior α s = ∅ ∧ Interior α t = ∅) Closure_DEF |- ∀α s. Closure α s = s ∪ LimitPointOf α s Closure_THM |- ∀α s. s ⊂ topspace α ⇒ Closure α s = s ∪ LimitPointOf α s IN_Closure |- ∀α s x. s ⊂ topspace α ⇒ (x ∈ Closure α s ⇔ x ∈ topspace α ∧ (∀t. x ∈ t ∧ open_in α t ⇒ (∃y. y ∈ s ∧ y ∈ t))) ClosureSubset |- ∀α s. s ⊂ topspace α ⇒ s ⊂ Closure α s ClosureTopspace |- ∀α s. s ⊂ topspace α ⇒ Closure α s ⊂ topspace α ClosureInterior |- ∀α s. s ⊂ topspace α ⇒ Closure α s = topspace α â” Interior α (topspace α â” s) InteriorClosure |- ∀α s. s ⊂ topspace α ⇒ Interior α s = topspace α â” Closure α (topspace α â” s) ClosedClosure |- ∀α s. s ⊂ topspace α ⇒ closed_in α (Closure α s) SubsetClosure |- ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ Closure α s ⊂ Closure α t ClosureHull |- ∀α s. s ⊂ topspace α ⇒ Closure α s = closed_in α hull s ClosureEq |- ∀α s. s ⊂ topspace α ⇒ (Closure α s = s ⇔ closed_in α s) ClosureClosed |- ∀α s. closed_in α s ⇒ Closure α s = s ClosureClosure |- ∀α s. s ⊂ topspace α ⇒ Closure α (Closure α s) = Closure α s ClosureUnion |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α (s ∪ t) = Closure α s ∪ Closure α t ClosureInterSubset |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Closure α (s ∩ t) ⊂ Closure α s ∩ Closure α t ClosureIntersSubset |- ∀α f. (∀s. s ∈ f ⇒ s ⊂ topspace α) ⇒ Closure α (INTERS f) ⊂ INTERS (IMAGE (Closure α) f) ClosureMinimal |- ∀α s t. s ⊂ t ∧ closed_in α t ⇒ Closure α s ⊂ t ClosureMinimalEq |- ∀α s t. s ⊂ topspace α ⇒ closed_in α t ⇒ (Closure α s ⊂ t ⇔ s ⊂ t) ClosureUnique |- ∀α s t. s ⊂ t ∧ closed_in α t ∧ (∀u. s ⊂ u ∧ closed_in α u ⇒ t ⊂ u) ⇒ Closure α s = t ClosureEmpty |- Closure α ∅ = ∅ ClosureUniv |- ∀α. Closure α (topspace α) = topspace α ClosureUnions |- ∀α f. FINITE f ⇒ (∀t. t ∈ f ⇒ t ⊂ topspace α) ⇒ Closure α (UNIONS f) = UNIONS {Closure α t | t ∈ f} ClosureEqEmpty |- ∀α s. s ⊂ topspace α ⇒ (Closure α s = ∅ ⇔ s = ∅) ClosureSubsetEq |- ∀α s. s ⊂ topspace α ⇒ (Closure α s ⊂ s ⇔ closed_in α s) OpenInterClosureEqEmpty |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ open_in α s ⇒ (s ∩ Closure α t = ∅ ⇔ s ∩ t = ∅) OpenInterClosureSubset |- ∀α s t. t ⊂ topspace α ⇒ open_in α s ⇒ s ∩ Closure α t ⊂ Closure α (s ∩ t) ClosureOpenInterSuperset |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ open_in α s ∧ s ⊂ Closure α t ⇒ Closure α (s ∩ t) = Closure α s ClosureComplement |- ∀α s. s ⊂ topspace α ⇒ Closure α (topspace α â” s) = topspace α â” Interior α s InteriorComplement |- ∀α s. s ⊂ topspace α ⇒ Interior α (topspace α â” s) = topspace α â” Closure α s ClosureInteriorComplement |- ∀α s. s ⊂ topspace α ⇒ topspace α â” Closure α (Interior α s) = Interior α (Closure α (topspace α â” s)) InteriorClosureComplement |- ∀α s. s ⊂ topspace α ⇒ topspace α â” Interior α (Closure α s) = Closure α (Interior α (topspace α â” s)) ConnectedIntermediateClosure |- ∀α s t. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ s ⊂ t ∧ t ⊂ Closure α s ⇒ Connected (subtopology α t) ConnectedClosure |- ∀α s. s ⊂ topspace α ⇒ Connected (subtopology α s) ⇒ Connected (subtopology α (Closure α s)) ConnectedUnionStrong |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) ∧ ¬(Closure α s ∩ t = ∅) ⇒ Connected (subtopology α (s ∪ t)) InteriorDiff |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α (s â” t) = Interior α s â” Closure α t ClosedInLimpt |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ (closed_in (subtopology α t) s ⇔ s ⊂ t ∧ LimitPointOf α s ∩ t ⊂ s) ClosedInLimpt_ALT |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ (closed_in (subtopology α t) s ⇔ s ⊂ t ∧ (∀x. x ∈ LimitPointOf α s ∧ x ∈ t ⇒ x ∈ s)) ClosedInInterClosure |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ (closed_in (subtopology α s) t ⇔ s ∩ Closure α t = t) InteriorClosureIdemp |- ∀α s. s ⊂ topspace α ⇒ Interior α (Closure α (Interior α (Closure α s))) = Interior α (Closure α s) ClosureInteriorIdemp |- ∀α s. s ⊂ topspace α ⇒ Closure α (Interior α (Closure α (Interior α s))) = Closure α (Interior α s) NowhereDenseUnion |- ∀α s t. s ∪ t ⊂ topspace α ⇒ (Interior α (Closure α (s ∪ t)) = ∅ ⇔ Interior α (Closure α s) = ∅ ∧ Interior α (Closure α t) = ∅) NowhereDense |- ∀α s. s ⊂ topspace α ⇒ (Interior α (Closure α s) = ∅ ⇔ (∀t. open_in α t ∧ ¬(t = ∅) ⇒ (∃u. open_in α u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅))) InteriorClosureDiffSpaceEmpty |- ∀α s. s ⊂ topspace α ⇒ Interior α (Closure α s â” s) = ∅ InteriorClosureInterOpen |- ∀α s t. open_in α s ∧ open_in α t ⇒ Interior α (Closure α (s ∩ t)) = Interior α (Closure α s) ∩ Interior α (Closure α t) ClosureInteriorUnionClosed |- ∀α s t. closed_in α s ∧ closed_in α t ⇒ Closure α (Interior α (s ∪ t)) = Closure α (Interior α s) ∪ Closure α (Interior α t) RegularOpenInter |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Interior α (Closure α s) = s ∧ Interior α (Closure α t) = t ⇒ Interior α (Closure α (s ∩ t)) = s ∩ t RegularClosedUnion |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Closure α (Interior α s) = s ∧ Closure α (Interior α t) = t ⇒ Closure α (Interior α (s ∪ t)) = s ∪ t DiffClosureSubset |- ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ Closure α s â” Closure α t ⊂ Closure α (s â” t) Frontier_DEF |- ∀α s. Frontier α s = Closure α s â” Interior α s Frontier_THM |- ∀α s. s ⊂ topspace α ⇒ Frontier α s = Closure α s â” Interior α s FrontierTopspace |- ∀α s. s ⊂ topspace α ⇒ Frontier α s ⊂ topspace α FrontierClosed |- ∀α s. s ⊂ topspace α ⇒ closed_in α (Frontier α s) FrontierClosures |- ∀s. s ⊂ topspace α ⇒ Frontier α s = Closure α s ∩ Closure α (topspace α â” s) FrontierStraddle |- ∀α a s. s ⊂ topspace α ⇒ (a ∈ Frontier α s ⇔ a ∈ topspace α ∧ (∀t. open_in α t ∧ a ∈ t ⇒ (∃x. x ∈ s ∧ x ∈ t) ∧ (∃x. ¬(x ∈ s) ∧ x ∈ t))) FrontierSubsetClosed |- ∀α s. closed_in α s ⇒ Frontier α s ⊂ s FrontierEmpty |- ∀α. Frontier α ∅ = ∅ FrontierUniv |- ∀α. Frontier α (topspace α) = ∅ FrontierSubsetEq |- ∀α s. s ⊂ topspace α ⇒ (Frontier α s ⊂ s ⇔ closed_in α s) FrontierComplement |- ∀α s. s ⊂ topspace α ⇒ Frontier α (topspace α â” s) = Frontier α s FrontierDisjointEq |- ∀α s. s ⊂ topspace α ⇒ (Frontier α s ∩ s = ∅ ⇔ open_in α s) FrontierInterSubset |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∩ t) ⊂ Frontier α s ∪ Frontier α t FrontierUnionSubset |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∪ t) ⊂ Frontier α s ∪ Frontier α t FrontierInteriors |- ∀α s. s ⊂ topspace α ⇒ Frontier α s = topspace α â” Interior α s â” Interior α (topspace α â” s) FrontierFrontierSubset |- ∀α s. s ⊂ topspace α ⇒ Frontier α (Frontier α s) ⊂ Frontier α s InteriorFrontier |- ∀α s. s ⊂ topspace α ⇒ Interior α (Frontier α s) = Interior α (Closure α s) â” Closure α (Interior α s) InteriorFrontierEmpty |- ∀α s. open_in α s ∨ closed_in α s ⇒ Interior α (Frontier α s) = ∅ FrontierFrontier |- ∀α s. open_in α s ∨ closed_in α s ⇒ Frontier α (Frontier α s) = Frontier α s UnionFrontierPart1 |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α s ∩ Interior α t ⊂ Frontier α (s ∩ t) UnionFrontierPart2 |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α s â” Frontier α t ⊂ Frontier α (s ∩ t) ∪ Frontier α (s ∪ t) UnionFrontierPart3 |- ∀α s t a. s ∪ t ⊂ topspace α ⇒ a ∈ Frontier α s ∧ a ∉ Frontier α t ⇒ a ∈ Frontier α (s ∩ t) ∨ a ∈ Frontier α (s ∪ t) UnionFrontier |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α s ∪ Frontier α t = Frontier α (s ∪ t) ∪ Frontier α (s ∩ t) ∪ Frontier α s ∩ Frontier α t ConnectedInterFrontier |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Connected (subtopology α s) ∧ ¬(s ∩ t = ∅) ∧ ¬(s â” t = ∅) ⇒ ¬(s ∩ Frontier α t = ∅) InteriorClosedEqEmptyAsFrontier |- ∀α s. s ⊂ topspace α ⇒ (closed_in α s ∧ Interior α s = ∅ ⇔ (∃t. open_in α t ∧ s = Frontier α t)) ClosureUnionFrontier |- ∀α s. s ⊂ topspace α ⇒ Closure α s = s ∪ Frontier α s FrontierInteriorSubset |- ∀α s. s ⊂ topspace α ⇒ Frontier α (Interior α s) ⊂ Frontier α s FrontierClosureSubset |- ∀α s. s ⊂ topspace α ⇒ Frontier α (Closure α s) ⊂ Frontier α s SetDiffFrontier |- ∀α s. s ⊂ topspace α ⇒ s â” Frontier α s = Interior α s FrontierInterSubsetInter |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∩ t) ⊂ Closure α s ∩ Frontier α t ∪ Frontier α s ∩ Closure α t FrontierUnionPart1 |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ ⇒ Frontier α s ∩ Interior α (s ∪ t) = ∅ FrontierUnion |- ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ ⇒ Frontier α (s ∪ t) = Frontier α s ∪ Frontier α t open_def |- ∀s. open s ⇔ (∀x. x ∈ s ⇒ (∃e. &0 < e ∧ (∀x'. dist (x',x) < e ⇒ x' ∈ s))) closed |- ∀s. closed s ⇔ open ((:real^∃179064) â” s) euclidean |- euclidean = mk_topology ((:real^∃179083),open) OPEN_EMPTY |- open ∅ OPEN_UNIV |- open (:real^∃255944) OPEN_INTER |- ∀s t. open s ∧ open t ⇒ open (s ∩ t) OPEN_UNIONS |- (∀s. s ∈ f ⇒ open s) ⇒ open (UNIONS f) IstopologyEuclidean |- istopology ((:real^∃255954),open) OPEN_IN |- ∀s. open s ⇔ open_in euclidean s TOPSPACE_EUCLIDEAN |- topspace euclidean = (:real^∃255961) OPEN_EXISTS_IN |- ∀P Q. (∀a. P a ⇒ open {x | Q a x}) ⇒ open {x | ∃a. P a ∧ Q a x} OPEN_EXISTS |- ∀Q. (∀a. open {x | Q a x}) ⇒ open {x | ∃a. Q a x} TOPSPACE_EUCLIDEAN_SUBTOPOLOGY |- ∀s. topspace (subtopology euclidean s) = s OPEN_IN_REFL |- ∀s. open_in (subtopology euclidean s) s CLOSED_IN_REFL |- ∀s. closed_in (subtopology euclidean s) s CLOSED_IN |- ∀s. closed = closed_in euclidean OPEN_UNION |- ∀s t. open s ∧ open t ⇒ open (s ∪ t) OPEN_SUBOPEN |- ∀s. open s ⇔ (∀x. x ∈ s ⇒ (∃t. open t ∧ x ∈ t ∧ t ⊂ s)) CLOSED_EMPTY |- closed ∅ CLOSED_UNIV |- closed (:real^∃254909) CLOSED_UNION |- ∀s t. closed s ∧ closed t ⇒ closed (s ∪ t) CLOSED_INTER |- ∀s t. closed s ∧ closed t ⇒ closed (s ∩ t) CLOSED_INTERS |- ∀f. (∀s. s ∈ f ⇒ closed s) ⇒ closed (INTERS f) CLOSED_FORALL_IN |- ∀P Q. (∀a. P a ⇒ closed {x | Q a x}) ⇒ closed {x | ∀a. P a ⇒ Q a x} CLOSED_FORALL |- ∀Q. (∀a. closed {x | Q a x}) ⇒ closed {x | ∀a. Q a x} OPEN_CLOSED |- ∀s. open s ⇔ closed ((:real^∃318274) â” s) OPEN_DIFF |- ∀s t. open s ∧ closed t ⇒ open (s â” t) CLOSED_DIFF |- ∀s t. closed s ∧ open t ⇒ closed (s â” t) OPEN_INTERS |- ∀s. FINITE s ∧ (∀t. t ∈ s ⇒ open t) ⇒ open (INTERS s) CLOSED_UNIONS |- ∀s. FINITE s ∧ (∀t. t ∈ s ⇒ closed t) ⇒ closed (UNIONS s) ball |- ∀x e. ball (x,e) = {y | dist (x,y) < e} cball |- ∀x e. cball (x,e) = {y | dist (x,y) <= e} IN_BALL |- ∀x y e. y ∈ ball (x,e) ⇔ dist (x,y) < e IN_CBALL |- ∀x y e. y ∈ cball (x,e) ⇔ dist (x,y) <= e BALL_SUBSET_CBALL |- ∀x e. ball (x,e) ⊂ cball (x,e) OPEN_BALL |- ∀x e. open (ball (x,e)) CENTRE_IN_BALL |- ∀x e. x ∈ ball (x,e) ⇔ &0 < e OPEN_CONTAINS_BALL |- ∀s. open s ⇔ (∀x. x ∈ s ⇒ (∃e. &0 < e ∧ ball (x,e) ⊂ s)) HALF_CBALL_IN_BALL |- ∀e. &0 < e ⇒ &0 < e / &2 ∧ e / &2 < e ∧ cball (x,e / &2) ⊂ ball (x,e) OPEN_IN_CONTAINS_CBALL_LEMMA |- ∀t s x. x ∈ s ⇒ ((∃e. &0 < e ∧ ball (x,e) ∩ t ⊂ s) ⇔ (∃e. &0 < e ∧ cball (x,e) ∩ t ⊂ s)) OPEN_IN_OPEN |- ∀s u. open_in (subtopology euclidean u) s ⇔ (∃t. open t ∧ s = u ∩ t) OPEN_IN_INTER_OPEN |- ∀s t u. open_in (subtopology euclidean u) s ∧ open t ⇒ open_in (subtopology euclidean u) (s ∩ t) OPEN_IN_OPEN_INTER |- ∀u s. open s ⇒ open_in (subtopology euclidean u) (u ∩ s) OPEN_OPEN_IN_TRANS |- ∀s t. open s ∧ open t ∧ t ⊂ s ⇒ open_in (subtopology euclidean s) t OPEN_SUBSET |- ∀s t. s ⊂ t ∧ open s ⇒ open_in (subtopology euclidean t) s CLOSED_IN_CLOSED |- ∀s u. closed_in (subtopology euclidean u) s ⇔ (∃t. closed t ∧ s = u ∩ t) CLOSED_SUBSET_EQ |- ∀u s. closed s ⇒ (closed_in (subtopology euclidean u) s ⇔ s ⊂ u) CLOSED_IN_INTER_CLOSED |- ∀s t u. closed_in (subtopology euclidean u) s ∧ closed t ⇒ closed_in (subtopology euclidean u) (s ∩ t) CLOSED_IN_CLOSED_INTER |- ∀u s. closed s ⇒ closed_in (subtopology euclidean u) (u ∩ s) CLOSED_SUBSET |- ∀s t. s ⊂ t ∧ closed s ⇒ closed_in (subtopology euclidean t) s OPEN_IN_SUBSET_TRANS |- ∀s t u. open_in (subtopology euclidean u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ open_in (subtopology euclidean t) s CLOSED_IN_SUBSET_TRANS |- ∀s t u. closed_in (subtopology euclidean u) s ∧ s ⊂ t ∧ t ⊂ u ⇒ closed_in (subtopology euclidean t) s OPEN_IN_CONTAINS_BALL_LEMMA |- ∀t s x. x ∈ s ⇒ ((∃E. open E ∧ x ∈ E ∧ E ∩ t ⊂ s) ⇔ (∃e. &0 < e ∧ ball (x,e) ∩ t ⊂ s)) OPEN_IN_CONTAINS_BALL |- ∀s t. open_in (subtopology euclidean t) s ⇔ s ⊂ t ∧ (∀x. x ∈ s ⇒ (∃e. &0 < e ∧ ball (x,e) ∩ t ⊂ s)) OPEN_IN_CONTAINS_CBALL |- ∀s t. open_in (subtopology euclidean t) s ⇔ s ⊂ t ∧ (∀x. x ∈ s ⇒ (∃e. &0 < e ∧ cball (x,e) ∩ t ⊂ s)) open_in |- ∀u s. open_in (subtopology euclidean u) s ⇔ s ⊂ u ∧ (∀x. x ∈ s ⇒ (∃e. &0 < e ∧ (∀x'. x' ∈ u ∧ dist (x',x) < e ⇒ x' ∈ s))) OPEN_IN_TRANS |- ∀s t u. open_in (subtopology euclidean t) s ∧ open_in (subtopology euclidean u) t ⇒ open_in (subtopology euclidean u) s OPEN_IN_TRANS_EQ |- ∀s t. (∀u. open_in (subtopology euclidean t) u ⇒ open_in (subtopology euclidean s) t) ⇔ open_in (subtopology euclidean s) t OPEN_IN_OPEN_TRANS |- ∀u s. open_in (subtopology euclidean u) s ∧ open u ⇒ open s CLOSED_IN_TRANS |- ∀s t u. closed_in (subtopology euclidean t) s ∧ closed_in (subtopology euclidean u) t ⇒ closed_in (subtopology euclidean u) s CLOSED_IN_TRANS_EQ |- ∀s t. (∀u. closed_in (subtopology euclidean t) u ⇒ closed_in (subtopology euclidean s) t) ⇔ closed_in (subtopology euclidean s) t CLOSED_IN_CLOSED_TRANS |- ∀s u. closed_in (subtopology euclidean u) s ∧ closed u ⇒ closed s OPEN_IN_SUBTOPOLOGY_INTER_SUBSET |- ∀s u v. open_in (subtopology euclidean u) (u ∩ s) ∧ v ⊂ u ⇒ open_in (subtopology euclidean v) (v ∩ s) OPEN_IN_OPEN_EQ |- ∀s t. open s ⇒ (open_in (subtopology euclidean s) t ⇔ open t ∧ t ⊂ s) CLOSED_IN_CLOSED_EQ |- ∀s t. closed s ⇒ (closed_in (subtopology euclidean s) t ⇔ closed t ∧ t ⊂ s) OPEN_IN_INJECTIVE_LINEAR_IMAGE |- ∀f s t. linear f ∧ (∀x y. f x = f y ⇒ x = y) ⇒ (open_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) ⇔ open_in (subtopology euclidean t) s) CLOSED_IN_INJECTIVE_LINEAR_IMAGE |- ∀f s t. linear f ∧ (∀x y. f x = f y ⇒ x = y) ⇒ (closed_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) ⇔ closed_in (subtopology euclidean t) s) OPEN_IN_SUBTOPOLOGY |- ∀u s. open_in (subtopology euclidean u) s ⇔ (∃t. open_in euclidean t ∧ s = t ∩ u) TOPSPACE_SUBTOPOLOGY |- ∀u. topspace (subtopology euclidean u) = topspace euclidean ∩ u CLOSED_IN_SUBTOPOLOGY |- ∀u s. closed_in (subtopology euclidean u) s ⇔ (∃t. closed_in euclidean t ∧ s = t ∩ u) OPEN_IN_SUBTOPOLOGY_REFL |- ∀u. open_in (subtopology euclidean u) u ⇔ u ⊂ topspace euclidean CLOSED_IN_SUBTOPOLOGY_REFL |- ∀u. closed_in (subtopology euclidean u) u ⇔ u ⊂ topspace euclidean SUBTOPOLOGY_UNIV |- subtopology euclidean (:real^∃181173) = euclidean SUBTOPOLOGY_SUPERSET |- ∀s. topspace euclidean ⊂ s ⇒ subtopology euclidean s = euclidean OPEN_IN_IMP_SUBSET |- ∀s t. open_in (subtopology euclidean s) t ⇒ t ⊂ s CLOSED_IN_IMP_SUBSET |- ∀s t. closed_in (subtopology euclidean s) t ⇒ t ⊂ s OPEN_IN_SUBTOPOLOGY_UNION |- ∀s t u. open_in (subtopology euclidean t) s ∧ open_in (subtopology euclidean u) s ⇒ open_in (subtopology euclidean (t ∪ u)) s CLOSED_IN_SUBTOPOLOGY_UNION |- ∀s t u. closed_in (subtopology euclidean t) s ∧ closed_in (subtopology euclidean u) s ⇒ closed_in (subtopology euclidean (t ∪ u)) s connected_DEF |- ∀s. connected s ⇔ Connected (subtopology euclidean s) connected |- ∀s. connected s ⇔ ¬(∃e1 e2. open e1 ∧ open e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅)) CONNECTED_CLOSED |- ∀s. connected s ⇔ ¬(∃e1 e2. closed e1 ∧ closed e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅)) CONNECTED_OPEN_IN |- ∀s. connected s ⇔ ¬(∃e1 e2. open_in (subtopology euclidean s) e1 ∧ open_in (subtopology euclidean s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) CONNECTED_OPEN_IN_EQ |- ∀s. connected s ⇔ ¬(∃e1 e2. open_in (subtopology euclidean s) e1 ∧ open_in (subtopology euclidean s) e2 ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) CONNECTED_CLOSED_IN |- ∀s. connected s ⇔ ¬(∃e1 e2. closed_in (subtopology euclidean s) e1 ∧ closed_in (subtopology euclidean s) e2 ∧ s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) CONNECTED_CLOSED_IN_EQ |- ∀s. connected s ⇔ ¬(∃e1 e2. closed_in (subtopology euclidean s) e1 ∧ closed_in (subtopology euclidean s) e2 ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) CONNECTED_CLOPEN |- ∀s. connected s ⇔ (∀t. open_in (subtopology euclidean s) t ∧ closed_in (subtopology euclidean s) t ⇒ t = ∅ ∨ t = s) CONNECTED_CLOSED_SET |- ∀s. closed s ⇒ (connected s ⇔ ¬(∃e1 e2. closed e1 ∧ closed e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) CONNECTED_OPEN_SET |- ∀s. open s ⇒ (connected s ⇔ ¬(∃e1 e2. open e1 ∧ open e2 ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) CONNECTED_EMPTY |- connected ∅ CONNECTED_SING |- ∀a. connected {a} CONNECTED_UNIONS |- ∀P. (∀s. s ∈ P ⇒ connected s) ∧ ¬(INTERS P = ∅) ⇒ connected (UNIONS P) CONNECTED_UNION |- ∀s t. connected s ∧ connected t ∧ ¬(s ∩ t = ∅) ⇒ connected (s ∪ t) CONNECTED_DIFF_OPEN_FROM_CLOSED |- ∀s t u. s ⊂ t ∧ t ⊂ u ∧ open s ∧ closed t ∧ connected u ∧ connected (t â” s) ⇒ connected (u â” s) CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE |- ∀f f'. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ (∀s. s ∈ f ⇒ open s ∧ connected s ∧ ¬(s = ∅)) ∧ (∀s. s ∈ f' ⇒ open s ∧ connected s ∧ ¬(s = ∅)) ∧ UNIONS f = UNIONS f' ⇒ f = f' CONNECTED_FROM_CLOSED_UNION_AND_INTER |- ∀s t. closed s ∧ closed t ∧ connected (s ∪ t) ∧ connected (s ∩ t) ⇒ connected s ∧ connected t CONNECTED_FROM_OPEN_UNION_AND_INTER |- ∀s t. open s ∧ open t ∧ connected (s ∪ t) ∧ connected (s ∩ t) ⇒ connected s ∧ connected t CONNECTED_INDUCTION |- ∀P Q s. connected s ∧ (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ∧ Q a ⇒ Q b) CONNECTED_EQUIVALENCE_RELATION_GEN_LEMMA |- ∀P R s. connected s ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b) CONNECTED_EQUIVALENCE_RELATION_GEN |- ∀P R s. connected s ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ (∃z. z ∈ t ∧ P z)) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b) CONNECTED_INDUCTION_SIMPLE |- ∀P s. connected s ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x y. x ∈ t ∧ y ∈ t ∧ P x ⇒ P y))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ∧ P a ⇒ P b) CONNECTED_EQUIVALENCE_RELATION |- ∀R s. connected s ∧ (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ (∀a. a ∈ s ⇒ (∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ (∀x. x ∈ t ⇒ R a x))) ⇒ (∀a b. a ∈ s ∧ b ∈ s ⇒ R a b) limit_point_of_DEF |- ∀x s. x limit_point_of s ⇔ x ∈ LimitPointOf euclidean s limit_point_of |- x limit_point_of s ⇔ (∀t. x ∈ t ∧ open t ⇒ (∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t)) LIMPT_SUBSET |- ∀x s t. x limit_point_of s ∧ s ⊂ t ⇒ x limit_point_of t CLOSED_LIMPT |- ∀s. closed s ⇔ (∀x. x limit_point_of s ⇒ x ∈ s) LIMPT_EMPTY |- ∀x. ¬(x limit_point_of ∅) NO_LIMIT_POINT_IMP_CLOSED |- ∀s. ¬(∃x. x limit_point_of s) ⇒ closed s LIMIT_POINT_UNION |- ∀s t x. x limit_point_of s ∪ t ⇔ x limit_point_of s ∨ x limit_point_of t LimitPointOf_euclidean |- ∀s. LimitPointOf euclidean s = {x | x limit_point_of s} interior_DEF |- interior = Interior euclidean interior |- ∀s. interior s = {x | ∃t. open t ∧ x ∈ t ∧ t ⊂ s} INTERIOR_EQ |- ∀s. interior s = s ⇔ open s INTERIOR_OPEN |- ∀s. open s ⇒ interior s = s INTERIOR_EMPTY |- interior ∅ = ∅ INTERIOR_UNIV |- interior (:real^∃200598) = (:real^∃200598) OPEN_INTERIOR |- ∀s. open (interior s) INTERIOR_INTERIOR |- ∀s. interior (interior s) = interior s INTERIOR_SUBSET |- ∀s. interior s ⊂ s SUBSET_INTERIOR |- ∀s t. s ⊂ t ⇒ interior s ⊂ interior t INTERIOR_MAXIMAL |- ∀s t. t ⊂ s ∧ open t ⇒ t ⊂ interior s INTERIOR_MAXIMAL_EQ |- ∀s t. open s ⇒ (s ⊂ interior t ⇔ s ⊂ t) INTERIOR_UNIQUE |- ∀s t. t ⊂ s ∧ open t ∧ (∀t'. t' ⊂ s ∧ open t' ⇒ t' ⊂ t) ⇒ interior s = t IN_INTERIOR |- ∀x s. x ∈ interior s ⇔ (∃e. &0 < e ∧ ball (x,e) ⊂ s) OPEN_SUBSET_INTERIOR |- ∀s t. open s ⇒ (s ⊂ interior t ⇔ s ⊂ t) INTERIOR_INTER |- ∀s t. interior (s ∩ t) = interior s ∩ interior t INTERIOR_FINITE_INTERS |- ∀s. FINITE s ⇒ interior (INTERS s) = INTERS (IMAGE interior s) INTERIOR_INTERS_SUBSET |- ∀f. interior (INTERS f) ⊂ INTERS (IMAGE interior f) UNION_INTERIOR_SUBSET |- ∀s t. interior s ∪ interior t ⊂ interior (s ∪ t) INTERIOR_EQ_EMPTY |- ∀s. interior s = ∅ ⇔ (∀t. open t ∧ t ⊂ s ⇒ t = ∅) INTERIOR_EQ_EMPTY_ALT |- ∀s. interior s = ∅ ⇔ (∀t. open t ∧ ¬(t = ∅) ⇒ ¬(t â” s = ∅)) INTERIOR_UNIONS_OPEN_SUBSETS |- ∀s. UNIONS {t | open t ∧ t ⊂ s} = interior s closure_DEF |- closure = Closure euclidean closure |- ∀s. closure s = s ∪ {x | x limit_point_of s} CLOSURE_INTERIOR |- ∀s. closure s = (:real^∃186277) â” interior ((:real^∃186277) â” s) INTERIOR_CLOSURE |- ∀s. interior s = (:real^∃304511) â” closure ((:real^∃304511) â” s) CLOSED_CLOSURE |- ∀s. closed (closure s) CLOSURE_SUBSET |- ∀s. s ⊂ closure s SUBSET_CLOSURE |- ∀s t. s ⊂ t ⇒ closure s ⊂ closure t CLOSURE_HULL |- ∀s. closure s = closed hull s CLOSURE_EQ |- ∀s. closure s = s ⇔ closed s CLOSURE_CLOSED |- ∀s. closed s ⇒ closure s = s CLOSURE_CLOSURE |- ∀s. closure (closure s) = closure s CLOSURE_UNION |- ∀s t. closure (s ∪ t) = closure s ∪ closure t CLOSURE_INTER_SUBSET |- ∀s t. closure (s ∩ t) ⊂ closure s ∩ closure t CLOSURE_INTERS_SUBSET |- ∀f. closure (INTERS f) ⊂ INTERS (IMAGE closure f) CLOSURE_MINIMAL |- ∀s t. s ⊂ t ∧ closed t ⇒ closure s ⊂ t CLOSURE_MINIMAL_EQ |- ∀s t. closed t ⇒ (closure s ⊂ t ⇔ s ⊂ t) CLOSURE_UNIQUE |- ∀s t. s ⊂ t ∧ closed t ∧ (∀t'. s ⊂ t' ∧ closed t' ⇒ t ⊂ t') ⇒ closure s = t CLOSURE_EMPTY |- closure ∅ = ∅ CLOSURE_UNIV |- closure (:real^∃303929) = (:real^∃303929) CLOSURE_UNIONS |- ∀f. FINITE f ⇒ closure (UNIONS f) = UNIONS {closure s | s ∈ f} CLOSURE_EQ_EMPTY |- ∀s. closure s = ∅ ⇔ s = ∅ CLOSURE_SUBSET_EQ |- ∀s. closure s ⊂ s ⇔ closed s OPEN_INTER_CLOSURE_EQ_EMPTY |- ∀s t. open s ⇒ (s ∩ closure t = ∅ ⇔ s ∩ t = ∅) OPEN_INTER_CLOSURE_SUBSET |- ∀s t. open s ⇒ s ∩ closure t ⊂ closure (s ∩ t) CLOSURE_OPEN_INTER_SUPERSET |- ∀s t. open s ∧ s ⊂ closure t ⇒ closure (s ∩ t) = closure s CLOSURE_COMPLEMENT |- ∀s. closure ((:real^∃430163) â” s) = (:real^∃430163) â” interior s INTERIOR_COMPLEMENT |- ∀s. interior ((:real^∃430675) â” s) = (:real^∃430675) â” closure s CONNECTED_INTERMEDIATE_CLOSURE |- ∀s t. connected s ∧ s ⊂ t ∧ t ⊂ closure s ⇒ connected t CONNECTED_CLOSURE |- ∀s. connected s ⇒ connected (closure s) CONNECTED_UNION_STRONG |- ∀s t. connected s ∧ connected t ∧ ¬(closure s ∩ t = ∅) ⇒ connected (s ∪ t) INTERIOR_DIFF |- ∀s t. interior (s â” t) = interior s â” closure t CLOSED_IN_LIMPT |- ∀s t. closed_in (subtopology euclidean t) s ⇔ s ⊂ t ∧ (∀x. x limit_point_of s ∧ x ∈ t ⇒ x ∈ s) CLOSED_IN_INTER_CLOSURE |- ∀s t. closed_in (subtopology euclidean s) t ⇔ s ∩ closure t = t INTERIOR_CLOSURE_IDEMP |- ∀s. interior (closure (interior (closure s))) = interior (closure s) CLOSURE_INTERIOR_IDEMP |- ∀s. closure (interior (closure (interior s))) = closure (interior s) INTERIOR_CLOSED_UNION_EMPTY_INTERIOR |- ∀s t. closed s ∧ interior t = ∅ ⇒ interior (s ∪ t) = interior s INTERIOR_UNION_EQ_EMPTY |- ∀s t. closed s ∨ closed t ⇒ (interior (s ∪ t) = ∅ ⇔ interior s = ∅ ∧ interior t = ∅) NOWHERE_DENSE_UNION |- ∀s t. interior (closure (s ∪ t)) = ∅ ⇔ interior (closure s) = ∅ ∧ interior (closure t) = ∅ NOWHERE_DENSE |- ∀s. interior (closure s) = ∅ ⇔ (∀t. open t ∧ ¬(t = ∅) ⇒ (∃u. open u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅)) INTERIOR_CLOSURE_INTER_OPEN |- ∀s t. open s ∧ open t ⇒ interior (closure (s ∩ t)) = interior (closure s) ∩ interior (closure t) CLOSURE_INTERIOR_UNION_CLOSED |- ∀s t. closed s ∧ closed t ⇒ closure (interior (s ∪ t)) = closure (interior s) ∪ closure (interior t) REGULAR_OPEN_INTER |- ∀s t. interior (closure s) = s ∧ interior (closure t) = t ⇒ interior (closure (s ∩ t)) = s ∩ t REGULAR_CLOSED_UNION |- ∀s t. closure (interior s) = s ∧ closure (interior t) = t ⇒ closure (interior (s ∪ t)) = s ∪ t DIFF_CLOSURE_SUBSET |- ∀s t. closure s â” closure t ⊂ closure (s â” t) frontier_DEF |- frontier = Frontier euclidean frontier |- ∀s. frontier s = closure s â” interior s FRONTIER_CLOSED |- ∀s. closed (frontier s) FRONTIER_CLOSURES |- ∀s. frontier s = closure s ∩ closure ((:real^∃217012) â” s) FRONTIER_STRADDLE |- ∀a s. a ∈ frontier s ⇔ (∀e. &0 < e ⇒ (∃x. x ∈ s ∧ dist (a,x) < e) ∧ (∃x. ¬(x ∈ s) ∧ dist (a,x) < e)) FRONTIER_SUBSET_CLOSED |- ∀s. closed s ⇒ frontier s ⊂ s FRONTIER_EMPTY |- frontier ∅ = ∅ FRONTIER_UNIV |- frontier (:real^∃315769) = ∅ FRONTIER_SUBSET_EQ |- ∀s. frontier s ⊂ s ⇔ closed s FRONTIER_COMPLEMENT |- ∀s. frontier ((:real^∃353474) â” s) = frontier s FRONTIER_DISJOINT_EQ |- ∀s. frontier s ∩ s = ∅ ⇔ open s FRONTIER_INTER_SUBSET |- ∀s t. frontier (s ∩ t) ⊂ frontier s ∪ frontier t FRONTIER_UNION_SUBSET |- ∀s t. frontier (s ∪ t) ⊂ frontier s ∪ frontier t FRONTIER_INTERIORS |- frontier s = (:real^∃338259) â” interior s â” interior ((:real^∃338259) â” s) FRONTIER_FRONTIER_SUBSET |- ∀s. frontier (frontier s) ⊂ frontier s INTERIOR_FRONTIER |- ∀s. interior (frontier s) = interior (closure s) â” closure (interior s) INTERIOR_FRONTIER_EMPTY |- ∀s. open s ∨ closed s ⇒ interior (frontier s) = ∅ FRONTIER_FRONTIER |- ∀s. open s ∨ closed s ⇒ frontier (frontier s) = frontier s UNION_FRONTIER |- ∀s t. frontier s ∪ frontier t = frontier (s ∪ t) ∪ frontier (s ∩ t) ∪ frontier s ∩ frontier t CONNECTED_INTER_FRONTIER |- ∀s t. connected s ∧ ¬(s ∩ t = ∅) ∧ ¬(s â” t = ∅) ⇒ ¬(s ∩ frontier t = ∅) INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER |- ∀s. closed s ∧ interior s = ∅ ⇔ (∃t. open t ∧ s = frontier t) FRONTIER_UNION |- ∀s t. closure s ∩ closure t = ∅ ⇒ frontier (s ∪ t) = frontier s ∪ frontier t CLOSURE_UNION_FRONTIER |- ∀s. closure s = s ∪ frontier s FRONTIER_INTERIOR_SUBSET |- ∀s. frontier (interior s) ⊂ frontier s FRONTIER_CLOSURE_SUBSET |- ∀s. frontier (closure s) ⊂ frontier s SET_DIFF_FRONTIER |- ∀s. s â” frontier s = interior s FRONTIER_INTER_SUBSET_INTER |- ∀s t. frontier (s ∩ t) ⊂ closure s ∩ frontier t ∪ frontier s ∩ closure t hol-light/Rqe/000077500000000000000000000000001303454263000134745ustar00rootroot00000000000000hol-light/Rqe/asym.ml000066400000000000000000002476121303454263000150130ustar00rootroot00000000000000override_interface ("-->",`(tends_num_real)`);; prioritize_real();; (* ---------------------------------------------------------------------- *) (* properites of num sequences *) (* ---------------------------------------------------------------------- *) let LIM_INV_1N = prove_by_refinement( `(\n. &1 / &n) --> &0`, (* {{{ Proof *) [ REWRITE_TAC[SEQ;real_sub;REAL_ADD_RID;REAL_NEG_0;real_gt;real_ge;GT;GE]; REPEAT STRIP_TAC; MP_TAC (ISPEC `&2 / e` REAL_ARCH_SIMPLE); STRIP_TAC; EXISTS_TAC `n`; REPEAT STRIP_TAC; CLAIM `&0 < &2 / e`; ASM_MESON_TAC[REAL_LT_RDIV_0;REAL_ARITH `&0 < &2`]; STRIP_TAC; CLAIM `&0 < &n`; ASM_MESON_TAC[REAL_LTE_TRANS;REAL_LE]; STRIP_TAC; CLAIM `&0 < &n'`; ASM_MESON_TAC[REAL_LTE_TRANS;REAL_LE]; STRIP_TAC; CLAIM `~(&n' = &0)`; ASM_MESON_TAC[REAL_LT_IMP_NZ]; STRIP_TAC; ASM_SIMP_TAC[ABS_DIV]; REWRITE_TAC[REAL_ABS_NUM]; ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; CLAIM `&2 <= e * &n`; ASM_MESON_TAC[REAL_LE_LDIV_EQ;REAL_MUL_SYM]; STRIP_TAC; CLAIM `e * &n <= e * &n'`; MATCH_MP_TAC REAL_LE_LMUL; ASM_MESON_TAC [REAL_LT_LE;REAL_LE]; STRIP_TAC; ASM_MESON_TAC[REAL_LTE_TRANS;REAL_LE_TRANS;REAL_ARITH `&1 < &2`]; ]);; (* }}} *) let LIM_INV_CONST = prove_by_refinement( `!c. (\n. c / &n) --> &0`, (* {{{ Proof *) [ ONCE_REWRITE_TAC[REAL_ARITH `c / &n = c * &1 / &n`]; STRIP_TAC; CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV[REAL_ARITH `&0 = c * &0`])); MATCH_MP_TAC SEQ_MUL; CONJ_TAC THENL [MATCH_ACCEPT_TAC SEQ_CONST;MATCH_ACCEPT_TAC LIM_INV_1N]; ]);; (* }}} *) let LIM_INV_1NP = prove_by_refinement( `!c k. 0 < k ==> (\n. c / &n pow k) --> &0`, (* {{{ Proof *) [ STRIP_TAC; INDUCT_TAC; REWRITE_TAC[ARITH_RULE `~(0 < 0)`]; REWRITE_TAC[real_pow;REAL_DIV_DISTRIB_R]; STRIP_TAC; CASES_ON `k = 0`; ASM_REWRITE_TAC[real_pow;GSYM REAL_DIV_DISTRIB_R;REAL_MUL_RID]; MATCH_ACCEPT_TAC LIM_INV_CONST; CLAIM `(\n. c / &n pow k) --> &0`; FIRST_ASSUM MATCH_MP_TAC; EVERY_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 * &0`]; MATCH_MP_TAC SEQ_MUL; CONJ_TAC THENL [MATCH_ACCEPT_TAC LIM_INV_1N;FIRST_ASSUM MATCH_ACCEPT_TAC]; ]);; (* }}} *) let LIM_INV_CON = prove_by_refinement( `!c d k. 0 < k ==> (\n. c / (d * &n pow k)) --> &0`, (* {{{ Proof *) [ REWRITE_TAC[REAL_DIV_DISTRIB_R]; REPEAT STRIP_TAC; ONCE_REWRITE_TAC[REAL_ARITH `&0 = (&1 / d) * &0`]; MATCH_MP_TAC SEQ_MUL; CONJ_TAC; MATCH_ACCEPT_TAC SEQ_CONST; POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC LIM_INV_1NP; ]);; (* }}} *) let LIM_NN = prove_by_refinement( `(\n. &n / &n) --> &1`, (* {{{ Proof *) [ REWRITE_TAC[SEQ]; REPEAT STRIP_TAC; EXISTS_TAC `1`; REWRITE_TAC[GT;GE]; REPEAT STRIP_TAC; CLAIM `~(&n = &0)`; MATCH_MP_TAC REAL_LT_IMP_NZ; ASM_MESON_TAC[REAL_LE;REAL_ARITH `&0 < &1`;REAL_LTE_TRANS]; STRIP_TAC; ASM_SIMP_TAC[REAL_DIV_REFL;real_sub;REAL_ADD_RINV;ABS_0]; ]);; (* }}} *) let LIM_NNC = prove_by_refinement( `~(k = &0) ==> (\n. (k * &n) / (k * &n)) --> &1`, (* {{{ Proof *) [ REWRITE_TAC[REAL_DIV_DISTRIB_2]; ONCE_REWRITE_TAC[REAL_ARITH `&1 = &1 * &1`]; STRIP_TAC; MATCH_MP_TAC SEQ_MUL; CONJ_TAC; ASM_SIMP_TAC[real_div;REAL_MUL_RINV]; MATCH_ACCEPT_TAC SEQ_CONST; MATCH_ACCEPT_TAC LIM_NN; ]);; (* }}} *) let LIM_MONO = prove_by_refinement( `!c d a b. ~(d = &0) /\ a < b ==> (\n. (c * &n pow a) / (d * &n pow b)) --> &0`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC; INDUCT_TAC; REPEAT STRIP_TAC; REWRITE_TAC[real_pow;REAL_MUL_RID]; POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC LIM_INV_CON; REPEAT STRIP_TAC; REWRITE_TAC[real_pow]; CLAIM `(b = SUC(PRE b))`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; ONCE_ASM_REWRITE_TAC[]; REWRITE_TAC[real_pow]; ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c`]; ONCE_REWRITE_TAC[REAL_DIV_DISTRIB_2]; ONCE_REWRITE_TAC[REAL_ARITH `&0 = &1 * &0`]; MATCH_MP_TAC SEQ_MUL; CONJ_TAC; MATCH_ACCEPT_TAC LIM_NN; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC; ARITH_TAC; ]);; (* }}} *) let LIM_POLY_LT = prove_by_refinement( `!p k. LENGTH p <= k ==> (\n. poly p (&n) / &n pow k) --> &0`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[poly;LENGTH]; REPEAT STRIP_TAC; REWRITE_TAC[REAL_DIV_LZERO;SEQ_CONST]; REWRITE_TAC[poly;LENGTH]; REPEAT STRIP_TAC; CLAIM `~(k = 0)`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; LABEL_ALL_TAC; CLAIM `LENGTH t <= PRE k`; USE_THEN "Z-1" MP_TAC THEN ARITH_TAC; DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); STRIP_TAC; REWRITE_TAC[REAL_DIV_ADD_DISTRIB]; ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 + &0`]; MATCH_MP_TAC SEQ_ADD; CONJ_TAC; ONCE_REWRITE_TAC[ARITH_RULE `n pow k = &1 * n pow k`]; MATCH_MP_TAC LIM_INV_CON; USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; CLAIM `k = SUC (PRE k)`; USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; STRIP_TAC; ONCE_ASM_REWRITE_TAC[]; REWRITE_TAC[real_pow]; REWRITE_TAC[REAL_DIV_DISTRIB_2]; ONCE_REWRITE_TAC[REAL_ARITH `&0 = &1 * &0`]; MATCH_MP_TAC SEQ_MUL; CONJ_TAC; MATCH_ACCEPT_TAC LIM_NN; FIRST_ASSUM MATCH_MP_TAC; USE_THEN "Z-1" MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let LIM_POLY = prove_by_refinement( `!p. (0 < LENGTH p /\ ~(LAST p = &0)) ==> (\n. poly p (&n) / (LAST p * &n pow PRE (LENGTH p))) --> &1`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[LENGTH;LT]; ASM_REWRITE_TAC[LENGTH;poly]; REPEAT STRIP_TAC; CASES_ON `t = []`; ASM_REWRITE_TAC[PRE;real_pow;REAL_POW_1;LAST;poly;REAL_MUL_RZERO;REAL_ADD_RID;LENGTH;REAL_DIV_DISTRIB_L]; CLAIM `~(h = &0)`; ASM_MESON_TAC[LAST]; STRIP_TAC; CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV[REAL_ARITH `&1 = &1 * &1`])); MATCH_MP_TAC SEQ_MUL; CONJ_TAC; ASM_SIMP_TAC[DIV_ID]; MATCH_ACCEPT_TAC SEQ_CONST; ASM_SIMP_TAC[DIV_ID;REAL_10]; MATCH_ACCEPT_TAC SEQ_CONST; CLAIM `LAST (CONS h t) = LAST t`; ASM_REWRITE_TAC[LAST]; STRIP_TAC; ASM_REWRITE_TAC[LAST;PRE]; REWRITE_TAC[REAL_DIV_ADD_DISTRIB]; ONCE_REWRITE_TAC [REAL_ARITH `&1 = &0 + &1`]; MATCH_MP_TAC SEQ_ADD; CLAIM `~(LENGTH t = 0)`; ASM_MESON_TAC[LENGTH_0]; STRIP_TAC; CONJ_TAC; MATCH_MP_TAC LIM_INV_CON; POP_ASSUM MP_TAC THEN ARITH_TAC; CLAIM `(LENGTH t = SUC (PRE (LENGTH t)))`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; ONCE_ASM_REWRITE_TAC[]; REWRITE_TAC[real_pow]; ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c`]; REWRITE_TAC[REAL_DIV_DISTRIB_2]; ONCE_REWRITE_TAC [REAL_ARITH `&1 = &1 * &1`]; MATCH_MP_TAC SEQ_MUL; CONJ_TAC; MATCH_ACCEPT_TAC LIM_NN; FIRST_ASSUM MATCH_MP_TAC; CONJ_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN ARITH_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let mono_inc = new_definition( `mono_inc (f:num -> real) = !(m:num) n. m <= n ==> f m <= f n`);; let mono_dec = new_definition( `mono_dec (f:num -> real) = !(m:num) n. m <= n ==> f n <= f m`);; let mono_inc_dec = prove_by_refinement( `!f. mono f <=> mono_inc f \/ mono_dec f`, (* {{{ Proof *) [ REWRITE_TAC[mono_inc;mono_dec;mono;real_ge] ]);; (* }}} *) let mono_inc_pow = prove_by_refinement( `!k. mono_inc (\n. &n pow k)`, (* {{{ Proof *) [ REWRITE_TAC[mono_inc]; INDUCT_TAC THEN REWRITE_TAC[real_pow;REAL_LE_REFL]; GEN_TAC THEN GEN_TAC; DISCH_THEN (fun x -> (RULE_ASSUM_TAC (fun y -> MATCH_MP y x)) THEN ASSUME_TAC x); MATCH_MP_TAC REAL_LE_MUL2; REPEAT STRIP_TAC; MATCH_ACCEPT_TAC REAL_NUM_LE_0; ASM_REWRITE_TAC[REAL_LE]; MATCH_MP_TAC REAL_POW_LE; MATCH_ACCEPT_TAC REAL_NUM_LE_0; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let mono_inc_pow_const = prove_by_refinement( `!k c. &0 < c ==> mono_inc (\n. c * &n pow k)`, (* {{{ Proof *) [ REWRITE_TAC[mono_inc]; REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LE_MUL2; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_LE]; REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LE; MATCH_ACCEPT_TAC REAL_NUM_LE_0; ASM_MESON_TAC[mono_inc_pow;mono_inc] ]);; (* }}} *) (* ---------------------------------------------------------------------- *) (* Unbounded sequences *) (* ---------------------------------------------------------------------- *) let mono_unbounded_above = new_definition( `mono_unbounded_above (f:num -> real) = !c. ?N. !n. N <= n ==> c < f n`);; let mono_unbounded_below = new_definition( `mono_unbounded_below (f:num -> real) = !c. ?N. !n. N <= n ==> f n < c`);; let mono_unbounded_above_pos = prove_by_refinement( `mono_unbounded_above (f:num -> real) = !c. &0 <= c ==> ?N. !n. N <= n ==> c < f n`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded_above]; EQ_TAC THENL [ASM_MESON_TAC[];ALL_TAC]; REPEAT STRIP_TAC; POP_ASSUM (ASSUME_TAC o ISPEC `abs c`); POP_ASSUM (MP_TAC o (C MATCH_MP) (ISPEC `c:real` ABS_POS)); STRIP_TAC; EXISTS_TAC `N`; GEN_TAC; DISCH_THEN (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); ASM_MESON_TAC[ABS_LE;REAL_LET_TRANS]; ]);; (* }}} *) let mono_unbounded_below_neg = prove_by_refinement( `mono_unbounded_below (f:num -> real) = !c. c <= &0 ==> ?N. !n. N <= n ==> f n < c`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded_below]; EQ_TAC THENL [ASM_MESON_TAC[];ALL_TAC]; REPEAT STRIP_TAC; POP_ASSUM (ASSUME_TAC o ISPEC `-- (abs c)`); POP_ASSUM (MP_TAC o (C MATCH_MP) (ISPEC `c:real` NEG_ABS)); STRIP_TAC; EXISTS_TAC `N`; GEN_TAC; DISCH_THEN (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let mua_quotient_limit = prove_by_refinement( `!k f g. &0 < k /\ (\n. f n / g n) --> k /\ mono_unbounded_above g ==> mono_unbounded_above f`, (* {{{ Proof *) [ REWRITE_TAC[SEQ;mono_unbounded_above_pos;AND_IMP_THM]; REPEAT GEN_TAC; STRIP_TAC; CLAIM `&0 < k / &2`; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; DISCH_THEN (fun x -> DISCH_THEN (fun y -> (ASSUME_TAC (MATCH_MP (ISPEC `k / &2` y) x)))); POP_ASSUM (X_CHOOSE_TAC `M:num`); STRIP_TAC; X_GEN_TAC `d:real`; STRIP_TAC; CLAIM `&0 <= &2 * d / k`; MATCH_MP_TAC REAL_LE_MUL; CONJ_TAC THENL [REAL_ARITH_TAC;ALL_TAC]; MATCH_MP_TAC REAL_LE_DIV; CONJ_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC;ASM_MESON_TAC[REAL_LT_LE]]; STRIP_TAC; LABEL_ALL_TAC; MOVE_TO_FRONT "Z-2"; POP_ASSUM (fun x -> USE_THEN "Z-0" (fun y -> MP_TAC (MATCH_MP x y))); DISCH_THEN (X_CHOOSE_TAC `K:num`); EXISTS_TAC `nmax M K`; REPEAT STRIP_TAC; CLAIM `M <= n /\ K <= (n:num)`; POP_ASSUM MP_TAC THEN REWRITE_TAC[nmax] THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; RULE_ASSUM_TAC (REWRITE_RULE[GE]); FIRST_X_ASSUM (fun x -> FIRST_X_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); FIRST_X_ASSUM (fun x -> FIRST_X_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); RULE_ASSUM_TAC (REWRITE_RULE[real_div]); CASES_ON `k <= f n * inv (g n)`; MATCH_MP_TAC (prove(`d <= &2 * d /\ &2 * d < k * (g n) /\ k * (g n) <= f n ==> d < f n`,MESON_TAC !REAL_REWRITES)); REPEAT STRIP_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; FIRST_ASSUM (fun x -> ASSUME_TAC (MATCH_MP (REWRITE_RULE[AND_IMP_THM] REAL_LT_LMUL) x)); LABEL_ALL_TAC; POP_ASSUM (fun y -> USE_THEN "Z-6" (fun x -> ASSUME_TAC (MATCH_MP y x))); CLAIM `k * &2 * d * inv k = (k * inv k) * &2 * d`; REAL_ARITH_TAC; CLAIM `k * inv k = &1`; ASM_MESON_TAC[REAL_MUL_RINV;REAL_LT_NZ]; STRIP_TAC; ASM_REWRITE_TAC[REAL_MUL_LID]; ASM_MESON_TAC[]; (* *) MATCH_MP_TAC REAL_LE_RCANCEL_IMP; EXISTS_TAC `inv (g n)`; REWRITE_TAC[GSYM REAL_MUL_ASSOC]; CLAIM `&0 < inv (g n)`; CLAIM `&0 < inv k`; MATCH_MP_TAC REAL_LT_INV THEN FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; CLAIM `&0 < g n`; ASM_MESON_TAC !REAL_REWRITES; STRIP_TAC; ASM_MESON_TAC[REAL_LT_INV]; STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `g n * inv (g n) = &1`; ASM_MESON_TAC[REAL_MUL_RINV;REAL_LT_NZ;REAL_LT_INV_EQ]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[REAL_MUL_RID]; FIRST_ASSUM MATCH_ACCEPT_TAC; (* *) RULE_ASSUM_TAC (REWRITE_RULE[REAL_NOT_LE]); CLAIM `f n * inv (g n) - k < &0`; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `abs (f n * inv (g n) - k) = k - (f n * inv (g n))`; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; DISCH_THEN (RULE_ASSUM_TAC o REWRITE_RULE o list); CLAIM `k * inv(&2) < f n * inv (g n)`; LABEL_ALL_TAC; USE_THEN "Z-5" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `k * g n < &2 * f n`; CLAIM `&0 < g n`; LABEL_ALL_TAC; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `&2 * d * inv k`; CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; MATCH_MP_TAC REAL_LT_LCANCEL_IMP; EXISTS_TAC `inv(&2)`; CONJ_TAC THENL [REAL_ARITH_TAC;ALL_TAC]; REWRITE_TAC[ARITH_RULE `inv(&2) * &2 = &1`;REAL_MUL_LID;REAL_MUL_ASSOC]; MATCH_MP_TAC REAL_LT_LCANCEL_IMP; EXISTS_TAC `inv(g n)`; CONJ_TAC; ASM_MESON_TAC[REAL_LT_INV]; ONCE_REWRITE_TAC[ARITH_RULE `a * (b * c) * d = c * b * (d * a)`]; CLAIM `g n * inv (g n) = &1`; POP_ASSUM MP_TAC THEN ASM_MESON_TAC[REAL_MUL_RINV;REAL_POS_NZ]; DISCH_THEN SUBST1_TAC; ASM_MESON_TAC[REAL_MUL_RID;REAL_MUL_SYM]; STRIP_TAC; CLAIM `&2 * d < k * g n`; MATCH_MP_TAC REAL_LT_RCANCEL_IMP; EXISTS_TAC `inv k`; STRIP_TAC; ASM_MESON_TAC[REAL_LT_INV]; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `g n`; CONJ_TAC; REWRITE_TAC[GSYM REAL_MUL_ASSOC]; FIRST_ASSUM MATCH_ACCEPT_TAC; LABEL_ALL_TAC; ONCE_REWRITE_TAC[ARITH_RULE `(a * b) * c = b * (a * c)`]; CLAIM `k * inv k = &1`; ASM_MESON_TAC[REAL_MUL_RINV;REAL_POS_NZ]; DISCH_THEN SUBST1_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&2 * d < &2 * f n`; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let mua_neg = prove_by_refinement( `!f. mono_unbounded_above f = mono_unbounded_below (\n. -- (f n))`, (* {{{ Proof *) [ MESON_TAC[mono_unbounded_above;mono_unbounded_below;REAL_ARITH `x < y ==> --y < -- x`;REAL_ARITH `-- (-- x) = x`]; ]);; (* }}} *) let mua_neg2 = prove_by_refinement( `!f. mono_unbounded_below f = mono_unbounded_above (\n. -- (f n))`, (* {{{ Proof *) [ MESON_TAC[mono_unbounded_above;mono_unbounded_below;REAL_ARITH `x < y ==> --y < -- x`;REAL_ARITH `-- (-- x) = x`]; ]);; (* }}} *) let mua_quotient_limit_neg = prove_by_refinement( `!k f g. &0 < k /\ (\n. f n / g n) --> k /\ mono_unbounded_below g ==> mono_unbounded_below f`, (* {{{ Proof *) [ REWRITE_TAC[mua_neg2]; REPEAT STRIP_TAC; MATCH_MP_TAC (mua_quotient_limit); EXISTS_TAC `k`; EXISTS_TAC `\n. -- g n`; ASM_REWRITE_TAC[]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; REWRITE_TAC[SEQ]; DISCH_THEN (fun x -> REPEAT STRIP_TAC THEN MP_TAC x); DISCH_THEN (MP_TAC o ISPEC `e:real`); ANTS_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; EXISTS_TAC `N`; REPEAT STRIP_TAC; REWRITE_TAC[real_div;REAL_NEG_MUL2;REAL_INV_NEG]; ASM_MESON_TAC[real_div]; ]);; (* }}} *) (* ---------------------------------------------------------------------- *) (* Polynomial properties *) (* ---------------------------------------------------------------------- *) let normal = new_definition( `normal p <=> ((normalize p = p) /\ ~(p = []))`);; let nonconstant = new_definition( `nonconstant p <=> normal p /\ (!x. ~(p = [x]))`);; let NORMALIZE_SING = prove_by_refinement( `!x. (normalize [x] = [x]) <=> ~(x = &0)`, (* {{{ Proof *) [ MESON_TAC[NOT_CONS_NIL;normalize]; ]);; (* }}} *) let NORMALIZE_PAIR = prove_by_refinement( `!x y. ~(y = &0) <=> (normalize [x; y] = [x; y])`, (* {{{ Proof *) [ REWRITE_TAC[normalize;NOT_CONS_NIL]; REPEAT GEN_TAC; COND_CASES_TAC; CLAIM `y = &0`; ASM_MESON_TAC !LIST_REWRITES; DISCH_THEN SUBST1_TAC; ASM_MESON_TAC !LIST_REWRITES; ASM_MESON_TAC !LIST_REWRITES; ]);; (* }}} *) let POLY_NORMALIZE = prove (`!p. poly (normalize p) = poly p`, (* {{{ Proof *) LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; poly] THEN ASM_CASES_TAC `h = &0` THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM] THEN UNDISCH_TAC `poly (normalize t) = poly t` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[poly] THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID]);; (* }}} *) let NORMAL_CONS = prove_by_refinement( `!h t. normal t ==> normal (CONS h t)`, (* {{{ Proof *) [ REWRITE_TAC[normal;normalize]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[NOT_CONS_NIL]; ]);; (* }}} *) let NORMAL_TAIL = prove_by_refinement( `!h t. ~(t = []) /\ normal (CONS h t) ==> normal t`, (* {{{ Proof *) [ REWRITE_TAC[normal;normalize]; REPEAT STRIP_TAC THENL [ALL_TAC;ASM_MESON_TAC[]]; CASES_ON `normalize t = []`; ASM_MESON_TAC[NOT_CONS_NIL;CONS_11]; ASM_MESON_TAC[NOT_CONS_NIL;CONS_11]; ]);; (* }}} *) let NORMAL_LAST_NONZERO = prove_by_refinement( `!p. normal p ==> ~(LAST p = &0)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; ASM_MESON_TAC[normal]; CASES_ON `t = []`; ASM_REWRITE_TAC[normal;normalize;NOT_CONS_NIL;LAST]; MESON_TAC[NOT_CONS_NIL]; ASM_SIMP_TAC[GSYM LAST_CONS]; ASM_REWRITE_TAC[LAST;NOT_CONS_NIL;]; STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; MATCH_MP_TAC NORMAL_TAIL; ASM_MESON_TAC[]; ]);; (* }}} *) let NORMAL_LENGTH = prove_by_refinement( `!p. normal p ==> 0 < LENGTH p`, (* {{{ Proof *) [ MESON_TAC[normal;LENGTH_0;ARITH_RULE `~(n = 0) <=> 0 < n`] ]);; (* }}} *) let NORMAL_LAST_LENGTH = prove_by_refinement( `!p. 0 < LENGTH p /\ ~(LAST p = &0) ==> normal p`, (* {{{ Proof *) [ LIST_INDUCT_TAC; MESON_TAC[LENGTH;LT_REFL]; STRIP_TAC; CASES_ON `t = []`; ASM_REWRITE_TAC[normal;NORMALIZE_SING;NOT_CONS_NIL;]; ASM_MESON_TAC[LAST]; MATCH_MP_TAC NORMAL_CONS; FIRST_ASSUM MATCH_MP_TAC; STRIP_TAC; ASM_MESON_TAC[LENGTH_0;ARITH_RULE `~(n = 0) <=> 0 < n`]; ASM_MESON_TAC[LAST_CONS]; ]);; (* }}} *) let NORMAL_ID = prove_by_refinement( `!p. normal p <=> 0 < LENGTH p /\ ~(LAST p = &0)`, (* {{{ Proof *) [ MESON_TAC[NORMAL_LAST_LENGTH;NORMAL_LENGTH;NORMAL_LAST_NONZERO]; ]);; (* }}} *) let LIM_POLY2 = prove_by_refinement( `!p. normal p ==> (\n. poly p (&n) / (LAST p * &n pow (degree p))) --> &1`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[degree]; CLAIM `normalize p = p`; ASM_MESON_TAC[normal]; DISCH_THEN SUBST1_TAC; MATCH_MP_TAC LIM_POLY; ASM_MESON_TAC[NORMAL_ID]; ]);; (* }}} *) let POW_UNB = prove_by_refinement( `!k. 0 < k ==> mono_unbounded_above (\n. (&n) pow k)`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded_above]; REPEAT STRIP_TAC; MP_TAC (ISPEC `max (&1) c` REAL_ARCH_SIMPLE_LT); STRIP_TAC; EXISTS_TAC `n`; REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `&n`; CONJ_TAC; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `max (&1) c`; ASM_MESON_TAC[REAL_MAX_MAX]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `&n'`; STRIP_TAC; ASM_MESON_TAC[REAL_LE]; CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[REAL_ARITH `x = x pow 1`])); MATCH_MP_TAC REAL_POW_MONO; STRIP_TAC; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `max (&1) c`; CONJ_TAC THENL [ASM_MESON_TAC[REAL_MAX_MAX];ALL_TAC]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `&n`; ASM_MESON_TAC (!REAL_REWRITES @ [REAL_LE;REAL_LT_LE]); EVERY_ASSUM MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let POW_UNB_CON = prove_by_refinement( `!k a. 0 < k /\ &0 < a ==> mono_unbounded_above (\n. a * (&n) pow k)`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded_above;AND_IMP_THM;]; REPEAT STRIP_TAC; LABEL_ALL_TAC; MOVE_TO_FRONT "Z-1"; POP_ASSUM (fun x -> MP_TAC (MATCH_MP POW_UNB x)); REWRITE_TAC[mono_unbounded_above]; DISCH_THEN (MP_TAC o ISPEC `inv a * c`); STRIP_TAC; EXISTS_TAC `N`; STRIP_TAC; DISCH_THEN (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); CLAIM `inv a * a = &1`; MATCH_MP_TAC REAL_MUL_LINV; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; MATCH_MP_TAC REAL_LT_LCANCEL_IMP; EXISTS_TAC `inv a`; CONJ_TAC; ASM_MESON_TAC[REAL_LT_INV]; ASM_REWRITE_TAC[REAL_MUL_ASSOC;REAL_MUL_LID]; ]);; (* }}} *) let POW_UNBB_CON = prove_by_refinement( `!k a. 0 < k /\ a < &0 ==> mono_unbounded_below (\n. a * (&n) pow k)`, (* {{{ Proof *) [ REWRITE_TAC[mua_neg2;ARITH_RULE `--(x * y) = -- x * y`]; REPEAT STRIP_TAC; MATCH_MP_TAC POW_UNB_CON; STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_SING = prove_by_refinement( `!x y. poly [x] y = x`, (* {{{ Proof *) [ REWRITE_TAC[poly]; REAL_ARITH_TAC; ]);; (* }}} *) let POLY_LAST_GT = prove_by_refinement( `!p. normal p /\ (?X. !x. X < x ==> &0 < poly p x) ==> &0 < LAST p`, (* {{{ Proof *) [ GEN_TAC; CASES_ON `LENGTH p = 1`; RULE_ASSUM_TAC (REWRITE_RULE[LENGTH_1]); POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[LAST_SING;POLY_SING]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; EXISTS_TAC `X + &1`; REAL_ARITH_TAC; (* *) REWRITE_TAC[AND_IMP_THM;]; DISCH_THEN (fun x -> MP_TAC (MATCH_MP LIM_POLY2 x) THEN ASSUME_TAC x); REPEAT STRIP_TAC; DISJ_CASES_TAC (ISPECL [`&0`;`LAST (p:real list)`] REAL_LT_TOTAL); ASM_MESON_TAC[NORMAL_ID]; POP_ASSUM DISJ_CASES_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; (* save *) CLAIM `mono_unbounded_below (\n. LAST p * &n pow degree p)`; MATCH_MP_TAC POW_UNBB_CON; REWRITE_TAC[degree]; CONJ_TAC THENL [ALL_TAC;FIRST_ASSUM MATCH_ACCEPT_TAC]; CLAIM `normalize p = p`; ASM_MESON_TAC[normal]; DISCH_THEN SUBST1_TAC; CLAIM `~(LENGTH p = 0)`; ASM_MESON_TAC[normal;LENGTH_EQ_NIL]; LABEL_ALL_TAC; USE_THEN "Z-4" MP_TAC; ARITH_TAC; (* save *) STRIP_TAC; CLAIM `mono_unbounded_below (\n. poly p (&n))`; MATCH_MP_TAC mua_quotient_limit_neg; BETA_TAC; EXISTS_TAC `&1`; EXISTS_TAC `(\n. LAST p * &n pow degree p)`; REPEAT STRIP_TAC; REAL_ARITH_TAC; BETA_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; REWRITE_TAC[mono_unbounded_below]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM_LIST (fun x -> ALL_TAC); MP_TAC (ISPEC `X:real` REAL_ARCH_SIMPLE); STRIP_TAC; DISCH_THEN (ASSUME_TAC o ISPEC `1 + nmax N n`); DISCH_THEN (ASSUME_TAC o ISPEC `&1 + &(nmax N n)`); POP_ASSUM MP_TAC THEN ANTS_TAC; REWRITE_TAC[nmax]; COND_CASES_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[NOT_LE;GSYM REAL_LT]); EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; POP_ASSUM MP_TAC THEN ANTS_TAC; REWRITE_TAC[nmax]; ARITH_TAC; ASM_MESON_TAC[ARITH_RULE `~(x < y /\ y < x)`;GSYM REAL_OF_NUM_ADD]; ]);; (* }}} *) let POLY_LAST_LT = prove_by_refinement( `!p. normal p /\ (?X. !x. X < x ==> poly p x < &0) ==> LAST p < &0`, (* {{{ Proof *) [ GEN_TAC; CASES_ON `LENGTH p = 1`; RULE_ASSUM_TAC (REWRITE_RULE[LENGTH_1]); POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[LAST_SING;POLY_SING]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; EXISTS_TAC `X + &1`; REAL_ARITH_TAC; (* *) REWRITE_TAC[AND_IMP_THM;]; DISCH_THEN (fun x -> MP_TAC (MATCH_MP LIM_POLY2 x) THEN ASSUME_TAC x); REPEAT STRIP_TAC; DISJ_CASES_TAC (ISPECL [`&0`;`LAST (p:real list)`] REAL_LT_TOTAL); ASM_MESON_TAC[NORMAL_ID]; POP_ASSUM DISJ_CASES_TAC THENL [ALL_TAC;FIRST_ASSUM MATCH_ACCEPT_TAC]; (* save *) CLAIM `mono_unbounded_above (\n. LAST p * &n pow degree p)`; MATCH_MP_TAC POW_UNB_CON; REWRITE_TAC[degree]; CONJ_TAC THENL [ALL_TAC;FIRST_ASSUM MATCH_ACCEPT_TAC]; CLAIM `normalize p = p`; ASM_MESON_TAC[normal]; DISCH_THEN SUBST1_TAC; CLAIM `~(LENGTH p = 0)`; ASM_MESON_TAC[normal;LENGTH_EQ_NIL]; LABEL_ALL_TAC; USE_THEN "Z-4" MP_TAC; ARITH_TAC; (* save *) STRIP_TAC; CLAIM `mono_unbounded_above (\n. poly p (&n))`; MATCH_MP_TAC mua_quotient_limit; BETA_TAC; EXISTS_TAC `&1`; EXISTS_TAC `(\n. LAST p * &n pow degree p)`; REPEAT STRIP_TAC; REAL_ARITH_TAC; BETA_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; REWRITE_TAC[mono_unbounded_above]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM_LIST (fun x -> ALL_TAC); MP_TAC (ISPEC `X:real` REAL_ARCH_SIMPLE); STRIP_TAC; DISCH_THEN (ASSUME_TAC o ISPEC `1 + nmax N n`); DISCH_THEN (ASSUME_TAC o ISPEC `&1 + &(nmax N n)`); POP_ASSUM MP_TAC THEN ANTS_TAC; REWRITE_TAC[nmax]; COND_CASES_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (REWRITE_RULE[NOT_LE;GSYM REAL_LT]); EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; POP_ASSUM MP_TAC THEN ANTS_TAC; REWRITE_TAC[nmax]; ARITH_TAC; ASM_MESON_TAC[ARITH_RULE `~(x < y /\ y < x)`;GSYM REAL_OF_NUM_ADD]; ]);; (* }}} *) let NORMALIZE_LENGTH_MONO = prove_by_refinement( `!l. LENGTH (normalize l) <= LENGTH l`, (* {{{ Proof *) [ LIST_INDUCT_TAC; MESON_TAC[normalize;LE_REFL]; REWRITE_TAC[LENGTH;normalize]; REPEAT COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN EVERY_ASSUM MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let DEGREE_SING = prove_by_refinement( `!x. (degree [x] = 0)`, (* {{{ Proof *) [ REWRITE_TAC[degree]; STRIP_TAC; CASES_ON `x = &0`; ASM_REWRITE_TAC[normalize;LENGTH]; ARITH_TAC; CLAIM `normalize [x] = [x]`; ASM_MESON_TAC[NORMALIZE_SING]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; ]);; (* }}} *) let DEGREE_CONS = prove_by_refinement( `!h t. normal t ==> (degree (CONS h t) = 1 + degree t)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `normal (CONS h t)`; ASM_MESON_TAC[NORMAL_CONS]; REWRITE_TAC[normal;degree]; STRIP_TAC; ASM_REWRITE_TAC[]; RULE_ASSUM_TAC (REWRITE_RULE[normal]); CLAIM `~(LENGTH t = 0)`; ASM_MESON_TAC[LENGTH_0]; STRIP_TAC; ASM_REWRITE_TAC[LENGTH]; POP_ASSUM MP_TAC THEN ARITH_TAC; ]);; (* }}} *) (* ---------------------------------------------------------------------- *) (* Now the derivative *) (* ---------------------------------------------------------------------- *) let PDA_LENGTH = prove_by_refinement( `!p n. ~(p = []) ==> (LENGTH(poly_diff_aux n p) = LENGTH p)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; GEN_TAC THEN DISCH_THEN IGNORE; REWRITE_TAC[LENGTH;poly_diff_aux;]; CASES_ON `t = []`; ASM_REWRITE_TAC[LENGTH;poly_diff_aux;]; ASM_MESON_TAC[]; ]);; (* }}} *) let POLY_DIFF_LENGTH = prove_by_refinement( `!p. LENGTH (poly_diff p) = PRE (LENGTH p)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[poly_diff;LENGTH;PRE]; CASES_ON `t = []`; ASM_REWRITE_TAC[LENGTH;PRE]; REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;PRE;poly_diff_aux;LENGTH;]; REWRITE_TAC[poly_diff;TL;LENGTH;PRE;NOT_CONS_NIL;]; MATCH_MP_TAC PDA_LENGTH; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let POLY_DIFF_SING = prove_by_refinement( `!p h. (poly_diff p = [h]) <=> ?x. p = [x; h]`, (* {{{ Proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (ISPEC `LENGTH (p:real list)` (ARITH_RULE `!n. (n = 0) \/ (n = 1) \/ (n = 2) \/ 2 < n`)); ASM_MESON_TAC[poly_diff;LENGTH_0;NOT_CONS_NIL;]; POP_ASSUM DISJ_CASES_TAC; RULE_ASSUM_TAC (REWRITE_RULE[LENGTH_1]); POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC; REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;poly_diff_aux;]; ASM_MESON_TAC !LIST_REWRITES; POP_ASSUM DISJ_CASES_TAC; RULE_ASSUM_TAC (MATCH_EQ_MP LENGTH_PAIR); POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;poly_diff_aux;REAL_MUL_LID;]; ASM_MESON_TAC[CONS_11]; EQ_TAC; STRIP_TAC; POP_ASSUM (ASSUME_TAC o (AP_TERM `LENGTH:((real) list) -> num`)); RULE_ASSUM_TAC(REWRITE_RULE[LENGTH]); CLAIM `PRE (LENGTH p) = 1`; ASM_MESON_TAC[POLY_DIFF_LENGTH;ARITH_RULE `SUC 0 = 1`]; STRIP_TAC; CLAIM `LENGTH p = 2`; POP_ASSUM MP_TAC THEN ARITH_TAC; ASM_MESON_TAC[LT_REFL]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;poly_diff_aux;REAL_MUL_LID;]; ]);; (* }}} *) let lem = prove_by_refinement( `!p n. ~(p = []) ==> (LAST (poly_diff_aux n p) = LAST p * &(PRE(LENGTH p) + n))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REPEAT STRIP_TAC; POP_ASSUM IGNORE; REWRITE_TAC[LENGTH;poly_diff_aux;]; CASES_ON `t = []`; ASM_REWRITE_TAC[poly_diff_aux;LAST;LENGTH;GSYM REAL_OF_NUM_ADD]; CLAIM `((SUC 0) - 1) + n = n`; ARITH_TAC; DISCH_THEN SUBST1_TAC; REWRITE_TAC[PRE]; REAL_ARITH_TAC; POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x)) THEN ASSUME_TAC x); STRIP_TAC; ASM_REWRITE_TAC[]; LIST_SIMP_TAC; ASM_REWRITE_TAC[]; COND_CASES_TAC; REWRITE_TAC[PRE]; ASM_MESON_TAC[PDA_LENGTH;LENGTH;LENGTH_0]; REWRITE_TAC[PRE]; MATCH_EQ_MP_TAC (GSYM REAL_EQ_MUL_LCANCEL); DISJ2_TAC; AP_TERM_TAC; CLAIM `~(LENGTH t = 0)`; ASM_MESON_TAC[LENGTH_0]; ARITH_TAC; ]);; (* }}} *) let NONCONSTANT_LENGTH = prove_by_refinement( `!p. nonconstant p ==> 1 < LENGTH p`, (* {{{ Proof *) [ REWRITE_TAC[nonconstant;normal]; ASM_MESON_TAC[LENGTH_0;LENGTH_1;ARITH_RULE `(x = 0) \/ (x = 1) \/ 1 < x`]; ]);; (* }}} *) let NONCONSTANT_DIFF_NIL = prove_by_refinement( `!p. nonconstant p ==> ~(poly_diff p = [])`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `1 < LENGTH p`; ASM_MESON_TAC[NONCONSTANT_LENGTH]; STRIP_TAC; CLAIM `0 < LENGTH (poly_diff p)`; REWRITE_TAC[POLY_DIFF_LENGTH]; POP_ASSUM MP_TAC THEN ARITH_TAC; ASM_REWRITE_TAC[LENGTH]; ARITH_TAC; ]);; (* }}} *) let NONCONSTANT_DEGREE = prove_by_refinement( `!p. nonconstant p ==> 0 < degree p`, (* {{{ Proof *) [ GEN_TAC; DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); REWRITE_TAC[nonconstant;degree]; REPEAT STRIP_TAC; CLAIM `normalize p = p`; ASM_MESON_TAC[normal]; STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `1 < LENGTH p`; ASM_MESON_TAC[NONCONSTANT_LENGTH]; ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_LAST_LEM = prove_by_refinement( `!p. nonconstant p ==> (LAST (poly_diff p) = LAST p * &(degree p))`, (* {{{ Proof *) [ REWRITE_TAC[nonconstant;poly_diff;]; REPEAT STRIP_TAC; COND_CASES_TAC; ASM_MESON_TAC[normal]; CLAIM `~(TL p = [])`; ASM_MESON_TAC[TL;NOT_CONS_NIL;list_CASES;TL_NIL]; DISCH_THEN (fun x -> MP_TAC (MATCH_MP lem x) THEN ASSUME_TAC x); DISCH_THEN (ASSUME_TAC o ISPEC `1`); ASM_REWRITE_TAC[]; CLAIM `LAST (TL p) = LAST p`; ASM_MESON_TAC[LAST_TL]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[degree]; CLAIM `normalize p = p`; ASM_MESON_TAC[normal]; DISCH_THEN SUBST1_TAC; MATCH_EQ_MP_TAC (GSYM REAL_EQ_MUL_LCANCEL); DISJ2_TAC; AP_TERM_TAC; ASM_SIMP_TAC[LENGTH_TL]; CLAIM `~(LENGTH p = 0)`; ASM_MESON_TAC[LENGTH_0]; CLAIM `~(LENGTH p = 1)`; ASM_MESON_TAC[LENGTH_1]; ARITH_TAC; ]);; (* }}} *) let NONCONSTANT_DIFF_0 = prove_by_refinement( `!p. nonconstant p ==> ~(poly_diff p = [&0])`, (* {{{ Proof *) [ STRIP_TAC; DISCH_THEN (fun x -> MP_TAC x THEN ASSUME_TAC x); REWRITE_TAC[nonconstant]; REPEAT STRIP_TAC; CLAIM `~(p = [])`; ASM_MESON_TAC[normal]; DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE[x]) THEN ASSUME_TAC x); CLAIM `~(LAST p = &0)`; MATCH_MP_TAC NORMAL_LAST_NONZERO; FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; CLAIM `LAST p * &(degree p) = &0`; ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_LEM]; REWRITE_TAC[LAST]; STRIP_TAC; CLAIM `(LAST p = &0) \/ (&(degree p) = &0)`; ASM_MESON_TAC[REAL_ENTIRE]; STRIP_TAC; ASM_MESON_TAC[]; CLAIM `?h t. p = CONS h t`; ASM_MESON_TAC[list_CASES]; STRIP_TAC; CLAIM `normal t`; ASM_MESON_TAC[NORMAL_TAIL]; STRIP_TAC; FIRST_ASSUM (MP_TAC o (MATCH_MP (ISPECL [`h:real`;`t:real list`] DEGREE_CONS))); STRIP_TAC; CLAIM `degree p = 0`; ASM_MESON_TAC [REAL_OF_NUM_EQ]; ASM_REWRITE_TAC[]; ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_LAST_LT = prove_by_refinement( `!p. nonconstant p ==> (LAST (poly_diff p) < &0 <=> LAST p < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ASM_SIMP_TAC[POLY_DIFF_LAST_LEM]; CLAIM `&0 <= &(degree p)`; REAL_ARITH_TAC; STRIP_TAC; EQ_TAC; ASM_MESON_TAC([REAL_MUL_LT] @ !REAL_REWRITES); STRIP_TAC; CLAIM `0 < degree p`; ASM_MESON_TAC[NONCONSTANT_DEGREE]; STRIP_TAC; CLAIM `&0 < &(degree p)`; REAL_SIMP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; MATCH_EQ_MP_TAC (GSYM REAL_MUL_LT); ASM_REWRITE_TAC[]; ]);; (* }}} *) let POLY_DIFF_LAST_GT = prove_by_refinement( `!p. nonconstant p ==> (&0 < LAST (poly_diff p) <=> &0 < LAST p)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ASM_SIMP_TAC[POLY_DIFF_LAST_LEM]; CLAIM `&0 < &(degree p)`; ASM_MESON_TAC[NONCONSTANT_DEGREE;REAL_OF_NUM_LT]; STRIP_TAC; EQ_TAC; REWRITE_TAC[REAL_MUL_GT]; STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; MATCH_MP_TAC REAL_LT_MUL2; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let NONCONSTANT_DIFF_NORMAL = prove_by_refinement( `!p. nonconstant p ==> normal (poly_diff p)`, (* {{{ Proof *) [ GEN_TAC; DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); REWRITE_TAC[nonconstant]; REPEAT STRIP_TAC; MATCH_MP_TAC NORMAL_LAST_LENGTH; STRIP_TAC; CLAIM `1 < LENGTH p`; ASM_MESON_TAC[NONCONSTANT_LENGTH]; STRIP_TAC; CLAIM `LENGTH (poly_diff p) = PRE (LENGTH p)`; ASM_MESON_TAC[POLY_DIFF_LENGTH]; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CASES_ON `LAST p < &0`; CLAIM `LAST (poly_diff p) < &0`; ASM_MESON_TAC[POLY_DIFF_LAST_LT]; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; REWRITE_ASSUMS !REAL_REWRITES; REWRITE_ASSUMS[REAL_LE_LT]; POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 < LAST (poly_diff p)`; ASM_MESON_TAC[POLY_DIFF_LAST_GT]; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ASM_MESON_TAC[NORMAL_ID]; ]);; (* }}} *) let PDIFF_POS_LAST = prove_by_refinement( `!p. nonconstant p /\ (?X. !x. X < x ==> &0 < poly (poly_diff p) x) ==> &0 < LAST p`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `&0 < LAST (poly_diff p)`; MATCH_MP_TAC POLY_LAST_GT; ASM_SIMP_TAC[NONCONSTANT_DIFF_NORMAL]; ASM_MESON_TAC[]; STRIP_TAC; ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_GT]; ]);; (* }}} *) let LAST_UNB = prove_by_refinement( `!p. nonconstant p /\ &0 < LAST p ==> mono_unbounded_above (\n. poly p (&n))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC mua_quotient_limit; EXISTS_TAC `&1`; EXISTS_TAC `(\n. (LAST p) * (&n) pow (degree p))`; BETA_TAC; STRIP_TAC; REAL_ARITH_TAC; STRIP_TAC; MATCH_MP_TAC LIM_POLY2; ASM_MESON_TAC[nonconstant]; MATCH_MP_TAC POW_UNB_CON; ASM_REWRITE_TAC[]; ASM_MESON_TAC[NONCONSTANT_DEGREE]; ]);; (* }}} *) (* ---------------------------------------------------------------------- *) (* Finally, the positive theorems *) (* ---------------------------------------------------------------------- *) let POLY_DIFF_UP_RIGHT = prove_by_refinement( `nonconstant p /\ (?X. !x. X < x ==> &0 < poly (poly_diff p) x) ==> (?Y. !y. Y < y ==> &0 < poly p y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `mono_unbounded_above (\n. poly p (&n))`; MATCH_MP_TAC LAST_UNB; ASM_MESON_TAC[PDIFF_POS_LAST]; REWRITE_TAC[mono_unbounded_above]; DISCH_THEN (MP_TAC o (ISPEC `&0`)); STRIP_TAC; CLAIM `?K. max X (&N) < &K`; ASM_MESON_TAC[REAL_ARCH_SIMPLE_LT]; STRIP_TAC; EXISTS_TAC `&K`; REPEAT STRIP_TAC; CCONTR_TAC; REWRITE_ASSUMS[REAL_NOT_LT]; CLAIM `&N < y /\ X < y`; ASM_MESON_TAC([REAL_MAX_MAX] @ !REAL_REWRITES); REPEAT STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`&K`;`y:real`] POLY_MVT); ANTS_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; CLAIM `poly p y - poly p (&K) <= &0`; MATCH_MP_TAC (REAL_ARITH `x <= &0 /\ &0 < y ==> x - y <= &0`); ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC; CLAIM `&N < &K`; ASM_MESON_TAC [REAL_MAX_MAX;REAL_LET_TRANS]; STRIP_TAC; CLAIM `N:num < K`; ASM_MESON_TAC [REAL_OF_NUM_LT]; ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - &K`; LABEL_ALL_TAC; USE_THEN "Z-7" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < poly (poly_diff p) x`; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_MAX_MAX;REAL_LET_TRANS;REAL_LT_TRANS]; STRIP_TAC; CLAIM `&0 < (y - &K) * poly (poly_diff p) x`; ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; MATCH_MP_TAC REAL_LT_MUL2 THEN REPEAT STRIP_TAC THEN TRY REAL_ARITH_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; REAL_SOLVE_TAC; ]);; (* }}} *) let PDIFF_NEG_LAST = prove_by_refinement( `!p. nonconstant p /\ (?X. !x. X < x ==> poly (poly_diff p) x < &0) ==> LAST p < &0`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LAST (poly_diff p) < &0`; MATCH_MP_TAC POLY_LAST_LT; ASM_SIMP_TAC[NONCONSTANT_DIFF_NORMAL]; ASM_MESON_TAC[]; STRIP_TAC; ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_LT]; ]);; (* }}} *) let LAST_UNB_NEG = prove_by_refinement( `!p. nonconstant p /\ LAST p < &0 ==> mono_unbounded_below (\n. poly p (&n))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC mua_quotient_limit_neg; EXISTS_TAC `&1`; EXISTS_TAC `(\n. (LAST p) * (&n) pow (degree p))`; BETA_TAC; STRIP_TAC; REAL_ARITH_TAC; STRIP_TAC; MATCH_MP_TAC LIM_POLY2; ASM_MESON_TAC[nonconstant]; MATCH_MP_TAC POW_UNBB_CON; ASM_REWRITE_TAC[]; ASM_MESON_TAC[NONCONSTANT_DEGREE]; ]);; (* }}} *) let POLY_DIFF_DOWN_RIGHT = prove_by_refinement( `nonconstant p /\ (?X. !x. X < x ==> poly (poly_diff p) x < &0) ==> (?Y. !y. Y < y ==> poly p y < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `mono_unbounded_below (\n. poly p (&n))`; MATCH_MP_TAC LAST_UNB_NEG; ASM_MESON_TAC[PDIFF_NEG_LAST]; REWRITE_TAC[mono_unbounded_below]; DISCH_THEN (MP_TAC o (ISPEC `&0`)); STRIP_TAC; CLAIM `?K. max X (&N) < &K`; ASM_MESON_TAC[REAL_ARCH_SIMPLE_LT]; STRIP_TAC; EXISTS_TAC `&K`; REPEAT STRIP_TAC; CCONTR_TAC; REWRITE_ASSUMS[REAL_NOT_LT]; CLAIM `&N < y /\ X < y`; ASM_MESON_TAC([REAL_MAX_MAX] @ !REAL_REWRITES); REPEAT STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`&K`;`y:real`] POLY_MVT); ANTS_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC; CLAIM `&0 <= poly p y - poly p (&K)`; MATCH_MP_TAC (REAL_ARITH `&0 <= x /\ y < &0 ==> &0 <= x - y`); ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC; CLAIM `&N < &K`; ASM_MESON_TAC (!REAL_REWRITES @ !NUM_REWRITES); STRIP_TAC; CLAIM `N:num < K`; ASM_MESON_TAC [REAL_OF_NUM_LT]; ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - &K`; LABEL_ALL_TAC; USE_THEN "Z-7" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `poly (poly_diff p) x < &0`; FIRST_ASSUM MATCH_MP_TAC; REAL_SOLVE_TAC; STRIP_TAC; CLAIM `(y - &K) * poly (poly_diff p) x < &0`; ASM_MESON_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; REAL_SOLVE_TAC; ]);; (* }}} *) (* ---------------------------------------------------------------------- *) (* Now the negative ones *) (* ---------------------------------------------------------------------- *) let UNB_LEFT_EVEN = prove_by_refinement( `!k. 0 < k /\ EVEN k ==> mono_unbounded_above (\n. (-- &n) pow k)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ASM_REWRITE_TAC[REAL_POW_NEG]; MATCH_MP_TAC POW_UNB; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let UNB_LEFT_ODD = prove_by_refinement( `!k. 0 < k /\ ODD k ==> mono_unbounded_below (\n. (-- &n) pow k)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_ASSUMS[GSYM NOT_EVEN]; ASM_REWRITE_TAC[REAL_POW_NEG]; MATCH_EQ_MP_TAC mua_neg; MATCH_MP_TAC POW_UNB; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let EVEN_CONS = prove_by_refinement( `!t h. ODD (LENGTH (CONS h t)) = EVEN (LENGTH t)`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN ASM_MESON_TAC[LENGTH_SING;LENGTH;EVEN;ODD;ONE]; ]);; (* }}} *) let ODD_CONS = prove_by_refinement( `!t h. EVEN (LENGTH (CONS h t)) = ODD (LENGTH t)`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN ASM_MESON_TAC[LENGTH_SING;LENGTH;EVEN;ODD;ONE]; ]);; (* }}} *) let MUA_DIV_CONST = prove_by_refinement( `!a b p. mono_unbounded_above (\n. p n) ==> (\n. a / (b + p n)) --> &0`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded_above;SEQ]; REPEAT STRIP_TAC; REAL_SIMP_TAC; CASES_ON `a = &0`; ASM_REWRITE_TAC[real_div;REAL_MUL_LZERO;ABS_0]; ABBREV_TAC `k = (max (&1) (abs a / e - b))`; FIRST_ASSUM (MP_TAC o (ISPEC `k:real`)); STRIP_TAC; EXISTS_TAC `N`; REPEAT STRIP_TAC; REWRITE_ASSUMS (!REAL_REWRITES @ !NUM_REWRITES); POP_ASSUM (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); REWRITE_TAC[REAL_ABS_DIV]; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `abs a / (b + k)`; STRIP_TAC; MATCH_MP_TAC REAL_DIV_DENOM_LT; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ABS_NZ]; LABEL_ALL_TAC; CLAIM `(abs a / e - b) <= k`; ASM_MESON_TAC[REAL_MAX_MAX]; STRIP_TAC; CLAIM `&0 < abs a / e`; REWRITE_TAC[real_div]; MATCH_MP_TAC REAL_LT_MUL; ASM_MESON_TAC[REAL_INV_POS;REAL_ABS_NZ]; STRIP_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; CLAIM `-- b < p n`; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `k`; ASM_REWRITE_TAC[]; CLAIM `(abs a / e - b) <= k`; ASM_MESON_TAC[REAL_MAX_MAX]; STRIP_TAC; CLAIM `&0 < abs a / e`; REWRITE_TAC[real_div]; MATCH_MP_TAC REAL_LT_MUL; ASM_MESON_TAC[REAL_INV_POS;REAL_ABS_NZ]; STRIP_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `abs (b + p n) = b + p n`; MATCH_EQ_MP_TAC REAL_ABS_REFL; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; CLAIM `(abs a / e - b) <= k`; ASM_MESON_TAC[REAL_MAX_MAX]; STRIP_TAC; CLAIM `&0 < abs a / e`; REWRITE_TAC[real_div]; MATCH_MP_TAC REAL_LT_MUL; ASM_MESON_TAC[REAL_INV_POS;REAL_ABS_NZ]; STRIP_TAC; LABEL_ALL_TAC; CLAIM `abs a / e <= b + k`; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CASES_ON `&1 <= abs a / e - b`; CLAIM `k = abs a / e - b`; USE_THEN "Z-3" (SUBST1_TAC o GSYM); ASM_REWRITE_TAC[real_max]; ASM_MESON_TAC[real_max]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[ARITH_RULE `b + a - b = a`]; REWRITE_TAC[real_div;]; REAL_SIMP_TAC; REWRITE_TAC[REAL_MUL_ASSOC]; CLAIM `~(abs a = &0)`; ASM_MESON_TAC[REAL_ABS_NZ;REAL_LT_LE]; STRIP_TAC; ASM_SIMP_TAC[REAL_MUL_RINV]; REAL_SIMP_TAC; (* save *) REWRITE_ASSUMS !REAL_REWRITES; CLAIM `k = &1`; ASM_MESON_TAC([real_max] @ !REAL_REWRITES); STRIP_TAC; CLAIM `&0 < b + k`; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `abs a / e`; ASM_MESON_TAC[]; STRIP_TAC; MATCH_MP_TAC REAL_LE_RCANCEL_IMP; EXISTS_TAC `b + k`; ASM_REWRITE_TAC[]; REWRITE_TAC[real_div]; REWRITE_TAC[GSYM REAL_MUL_ASSOC]; CLAIM `inv (b + &1) * (b + &1) = &1`; LABEL_ALL_TAC; POP_ASSUM MP_TAC; ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[REAL_MUL_LINV;REAL_LT_LE]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[REAL_MUL_RID]; MATCH_MP_TAC REAL_LE_LCANCEL_IMP; EXISTS_TAC `inv e`; REPEAT STRIP_TAC; USE_THEN "Z-5" MP_TAC; MESON_TAC[REAL_INV_POS;REAL_LT_LE]; REWRITE_TAC[REAL_MUL_ASSOC]; CLAIM `~(e = &0)`; ASM_MESON_TAC[REAL_INV_NZ;REAL_LT_LE]; STRIP_TAC; ASM_SIMP_TAC[REAL_MUL_LINV]; REAL_SIMP_TAC; ASM_MESON_TAC[real_div;REAL_MUL_SYM] ]);; (* }}} *) let SEQ_0_NEG = prove_by_refinement( `!p. (\n. p n) --> &0 <=> (\n. -- p n) --> &0`, (* {{{ Proof *) [ REWRITE_TAC[SEQ]; GEN_TAC THEN EQ_TAC; REPEAT STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-0" (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); STRIP_TAC; EXISTS_TAC `N`; REPEAT STRIP_TAC; POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); REAL_SIMP_TAC; STRIP_TAC; ASM_MESON_TAC[REAL_ABS_NEG]; REPEAT STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-0" (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); STRIP_TAC; EXISTS_TAC `N`; REPEAT STRIP_TAC; POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); REAL_SIMP_TAC; STRIP_TAC; ASM_MESON_TAC[REAL_ABS_NEG]; ]);; (* }}} *) let lem = prove_by_refinement( `!x y z. --(x / (y + z)) = x / (-- y + -- z)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[real_div]; REWRITE_TAC[ARITH_RULE `--(x * y) = x * -- y`]; REWRITE_TAC[ARITH_RULE `-- y + -- z = --(y + z)`]; REWRITE_TAC[REAL_INV_NEG]; ]);; (* }}} *) let MUB_DIV_CONST = prove_by_refinement( `!a b p. mono_unbounded_below (\n. p n) ==> (\n. a / (b + p n)) --> &0`, (* {{{ Proof *) [ REWRITE_TAC[mua_neg2]; REPEAT STRIP_TAC; ONCE_REWRITE_TAC[SEQ_0_NEG]; REWRITE_TAC[lem]; MATCH_MP_TAC MUA_DIV_CONST; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let mono_unbounded = new_definition( `mono_unbounded p <=> mono_unbounded_above p \/ mono_unbounded_below p`);; let MU_DIV_CONST = prove_by_refinement( `!a b p. mono_unbounded p ==> (\n. a / (b + p n)) --> &0`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded]; REPEAT STRIP_TAC; MATCH_MP_TAC MUA_DIV_CONST; REWRITE_TAC[ETA_AX]; POP_ASSUM MATCH_ACCEPT_TAC; MATCH_MP_TAC MUB_DIV_CONST; REWRITE_TAC[ETA_AX]; POP_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let MUA_MUA = prove_by_refinement( `!p q. mono_unbounded_above (\n. p n) /\ mono_unbounded_above (\n. q n) ==> mono_unbounded_above (\n. p n * q n)`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded_above_pos]; REPEAT STRIP_TAC; CLAIM `&0 <= max c (&1)`; REWRITE_TAC[real_max]; COND_CASES_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; DISCH_THEN (fun y -> POP_ASSUM (fun x -> RULE_ASSUM_TAC (C MATCH_MP y) THEN ASSUME_TAC x)); EVERY_ASSUM MP_TAC THEN REPEAT STRIP_TAC; EXISTS_TAC `nmax N N'`; REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `max c (&1)`; ASM_REWRITE_TAC[REAL_MAX_MAX]; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `max c (&1) * max c (&1)`; REPEAT STRIP_TAC; CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV [GSYM REAL_MUL_RID])); MATCH_MP_TAC REAL_LE_MUL2; REPEAT STRIP_TAC; REAL_SOLVE_TAC; REAL_SIMP_TAC; REAL_ARITH_TAC; REAL_SOLVE_TAC; MATCH_MP_TAC REAL_LT_MUL2; REPEAT STRIP_TAC; REAL_SOLVE_TAC; CLAIM `N <= n /\ N' <= (n:num)`; POP_ASSUM MP_TAC; REWRITE_TAC[nmax]; COND_CASES_TAC; REPEAT STRIP_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; REAL_SOLVE_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REWRITE_TAC[nmax] THEN ARITH_TAC; ]);; (* }}} *) let MUA_MUB = prove_by_refinement( `!p q. mono_unbounded_above (\n. p n) /\ mono_unbounded_below (\n. q n) ==> mono_unbounded_below (\n. p n * q n)`, (* {{{ Proof *) [ REWRITE_TAC[mua_neg2]; REWRITE_TAC[ARITH_RULE `--(x * y) = x * -- y`]; REPEAT STRIP_TAC; MATCH_MP_TAC MUA_MUA; ASM_REWRITE_TAC[]; ]);; (* }}} *) let MUB_MUA = prove_by_refinement( `!p q. mono_unbounded_below (\n. p n) /\ mono_unbounded_above (\n. q n) ==> mono_unbounded_below (\n. p n * q n)`, (* {{{ Proof *) [ REWRITE_TAC[mua_neg2]; REWRITE_TAC[ARITH_RULE `--(x * y) = -- x * y`]; REPEAT STRIP_TAC; MATCH_MP_TAC MUA_MUA; ASM_REWRITE_TAC[]; ]);; (* }}} *) let MUB_MUB = prove_by_refinement( `!p q. mono_unbounded_below (\n. p n) /\ mono_unbounded_below (\n. q n) ==> mono_unbounded_above (\n. p n * q n)`, (* {{{ Proof *) [ REWRITE_TAC[mua_neg2]; ONCE_REWRITE_TAC[ARITH_RULE `(x * y) = -- x * -- y`]; REPEAT STRIP_TAC; MATCH_MP_TAC MUA_MUA; ASM_REWRITE_TAC[]; ]);; (* }}} *) let MU_PROD = prove_by_refinement( `!p q. mono_unbounded (\n. p n) /\ mono_unbounded (\n. q n) ==> mono_unbounded (\n. p n * q n)`, (* {{{ Proof *) [ REWRITE_TAC[mono_unbounded]; ASM_MESON_TAC[MUA_MUA;MUA_MUB;MUB_MUA;MUB_MUB]; ]);; (* }}} *) let mub_quotient_limit = prove_by_refinement( `!k f g. &0 < k /\ (\n. f n / g n) --> k /\ mono_unbounded_below g ==> mono_unbounded_below f`, (* {{{ Proof *) [ REWRITE_TAC[mua_neg2]; REPEAT STRIP_TAC; MATCH_MP_TAC mua_quotient_limit; EXISTS_TAC `k`; EXISTS_TAC `\n. -- g n`; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; BETA_TAC; REWRITE_TAC[REAL_NEG_DIV]; FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let POLY_UB = prove_by_refinement( `!p. nonconstant p ==> mono_unbounded (\n. poly p (&n))`, (* {{{ Proof *) [ GEN_TAC; DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); REWRITE_TAC[nonconstant]; REPEAT STRIP_TAC; FIRST_ASSUM (fun x -> ASSUME_TAC (MATCH_MP LIM_POLY2 x)); CASES_ON `LAST p < &0`; REWRITE_TAC[mono_unbounded]; DISJ2_TAC; MATCH_MP_TAC mub_quotient_limit; EXISTS_TAC `&1`; EXISTS_TAC `(\n. LAST p * &n pow degree p)`; REPEAT STRIP_TAC; REAL_ARITH_TAC; BETA_TAC; MATCH_MP_TAC LIM_POLY2; FIRST_ASSUM MATCH_ACCEPT_TAC; MATCH_MP_TAC POW_UNBB_CON; ASM_REWRITE_TAC[]; MATCH_MP_TAC NONCONSTANT_DEGREE; FIRST_ASSUM MATCH_ACCEPT_TAC; REWRITE_ASSUMS !REAL_REWRITES; REWRITE_ASSUMS[REAL_LE_LT]; POP_ASSUM MP_TAC THEN STRIP_TAC; (* save *) REWRITE_TAC[mono_unbounded]; DISJ1_TAC; MATCH_MP_TAC mua_quotient_limit; EXISTS_TAC `&1`; EXISTS_TAC `(\n. LAST p * &n pow degree p)`; REPEAT STRIP_TAC; REAL_ARITH_TAC; BETA_TAC; MATCH_MP_TAC LIM_POLY2; FIRST_ASSUM MATCH_ACCEPT_TAC; MATCH_MP_TAC POW_UNB_CON; ASM_REWRITE_TAC[]; MATCH_MP_TAC NONCONSTANT_DEGREE; FIRST_ASSUM MATCH_ACCEPT_TAC; ASM_MESON_TAC[NORMAL_LAST_NONZERO]; ]);; (* }}} *) (* ---------------------------------------------------------------------- *) (* A polynomial applied to a negative argument *) (* ---------------------------------------------------------------------- *) let pneg_aux = new_recursive_definition list_RECURSION `(pneg_aux n [] = []) /\ (pneg_aux n (CONS h t) = CONS (--(&1) pow n * h) (pneg_aux (SUC n) t))`;; let pneg = new_recursive_definition list_RECURSION `(pneg [] = []) /\ (pneg (CONS h t) = pneg_aux 0 (CONS h t))`;; let POLY_PNEG_AUX_SUC = prove_by_refinement( `!t n. pneg_aux (SUC (SUC n)) t = pneg_aux n t`, (* {{{ Proof *) [ LIST_INDUCT_TAC; STRIP_TAC; REWRITE_TAC[pneg_aux]; REWRITE_TAC[pneg_aux;pow]; REAL_SIMP_TAC; STRIP_TAC; AP_TERM_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let POLY_NEG_NEG = prove_by_refinement( `!p. poly_neg (poly_neg p) = p`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[poly_neg;poly_cmul]; REWRITE_TAC[poly_neg;poly_cmul]; REAL_SIMP_TAC; AP_TERM_TAC; ASM_MESON_TAC[poly_neg;poly_cmul]; ]);; (* }}} *) let POLY_PNEG_NEG = prove_by_refinement( `!p n. poly_neg (pneg_aux (SUC n) p) = pneg_aux n p`, (* {{{ Proof *) [ LIST_INDUCT_TAC; ASM_REWRITE_TAC[pneg_aux;poly_neg;poly_cmul]; REWRITE_TAC[pneg_aux]; REPEAT STRIP_TAC; REWRITE_TAC[POLY_PNEG_AUX_SUC]; REWRITE_TAC[poly_neg;poly_cmul]; REAL_SIMP_TAC; AP_TERM_TAC; REWRITE_TAC[GSYM poly_neg]; CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV[GSYM POLY_NEG_NEG])); POP_ASSUM (ONCE_REWRITE_TAC o list); REWRITE_TAC[]; ]);; (* }}} *) let POLY_PNEG_AUX = prove_by_refinement( `!k p n. EVEN n ==> (poly p (-- k) = poly (pneg_aux n p) k)`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REPEAT STRIP_TAC; REWRITE_TAC[pneg_aux;poly]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> RULE_ASSUM_TAC (fun y -> MATCH_MP y x) THEN ASSUME_TAC x); REWRITE_TAC[poly;pneg_aux]; REAL_SIMP_TAC; ASM_REWRITE_TAC[]; REAL_SIMP_TAC; CLAIM `-- &1 pow n = &1`; REWRITE_TAC[REAL_POW_NEG]; ASM_REWRITE_TAC[]; REAL_SIMP_TAC; DISCH_THEN SUBST1_TAC; REAL_SIMP_TAC; AP_TERM_TAC; CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[GSYM POLY_PNEG_NEG])); REWRITE_TAC[POLY_NEG]; REAL_SIMP_TAC; ]);; (* }}} *) let POLY_PNEG = prove_by_refinement( `!p x. poly p (-- x) = poly (pneg p) x`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[pneg;poly]; REWRITE_TAC[pneg;poly]; REPEAT STRIP_TAC; CLAIM `poly (pneg_aux 0 (CONS h t)) x = poly (CONS h t) (--x)`; ASM_MESON_TAC[POLY_PNEG_AUX;EVEN]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[poly]; ]);; (* }}} *) let DEGREE_0 = prove_by_refinement( `degree [] = 0 `, (* {{{ Proof *) [ REWRITE_TAC[degree]; REWRITE_TAC[normalize;LENGTH]; ARITH_TAC; ]);; (* }}} *) let EVEN_ODD = prove_by_refinement( `!x. EVEN (SUC x) = ODD x`, (* {{{ Proof *) [ REWRITE_TAC[EVEN;NOT_EVEN]; ]);; (* }}} *) let ODD_EVEN = prove_by_refinement( `!x. ODD (SUC x) = EVEN x`, (* {{{ Proof *) [ REWRITE_TAC[ODD;NOT_ODD]; ]);; (* }}} *) let PNEG_CONS = prove_by_refinement( `!p. pneg (CONS h t) = CONS h (neg (pneg t))`, (* {{{ Proof *) [ REWRITE_TAC[pneg;pneg_aux]; REAL_SIMP_TAC; ONCE_REWRITE_TAC[GSYM POLY_PNEG_NEG]; REWRITE_TAC[POLY_PNEG_AUX_SUC]; CASES_ON `t = []`; ASM_REWRITE_TAC[pneg;pneg_aux;]; REWRITE_ASSUMS !LIST_REWRITES; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[GSYM pneg]; ]);; (* }}} *) let PNEG_NIL = prove_by_refinement( `!p. (pneg p = []) <=> (p = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN MESON_TAC[pneg;NOT_CONS_NIL;pneg_aux]; ]);; (* }}} *) let PNEG_AUX_NIL = prove_by_refinement( `!p n. (pneg_aux n p = []) <=> (p = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN MESON_TAC[pneg;NOT_CONS_NIL;pneg_aux]; ]);; (* }}} *) let POLY_CMUL_NIL = prove_by_refinement( `!p. (c ## p = []) <=> (p = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN MESON_TAC[poly_cmul;NOT_CONS_NIL;pneg_aux]; ]);; (* }}} *) let POLY_NEG_NIL = prove_by_refinement( `!p. (poly_neg p = []) <=> (p = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN MESON_TAC[poly_neg;poly_cmul;NOT_CONS_NIL]; ]);; (* }}} *) let NEG_LAST = prove_by_refinement( `!p. ~(p = []) ==> (LAST (neg p) = -- LAST p)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; DISCH_THEN IGNORE; CASES_ON `t = []`; ASM_REWRITE_TAC[poly_neg;poly_cmul;LAST;]; REAL_ARITH_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); ASM_SIMP_TAC[LAST_CONS;poly_neg;poly_cmul;]; CLAIM `~(-- &1 ## t = [])`; ASM_MESON_TAC[POLY_CMUL_NIL]; STRIP_TAC; ASM_SIMP_TAC[LAST_CONS]; ASM_MESON_TAC[poly_neg;]; ]);; (* }}} *) let POLY_PNEG_LAST = prove_by_refinement( `!p. normal p ==> (EVEN (degree p) ==> (LAST p = LAST (pneg p))) /\ (ODD (degree p) ==> (LAST p = -- LAST (pneg p)))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[normal]; STRIP_TAC; CASES_ON `t = []`; ASM_REWRITE_TAC[LAST;pneg;pneg_aux]; REAL_SIMP_TAC; ASM_MESON_TAC[DEGREE_SING;EVEN;NOT_EVEN]; CLAIM `normal t`; MATCH_MP_TAC NORMAL_TAIL; ASM_MESON_TAC[]; DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE [x]) THEN ASSUME_TAC x); STRIP_TAC; STRIP_TAC; CLAIM `ODD (degree t)`; MATCH_EQ_MP_TAC EVEN_ODD; ASM_MESON_TAC[DEGREE_CONS;ADD1;ADD_SYM]; DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE [x]) THEN ASSUME_TAC x); ASM_SIMP_TAC[LAST_CONS]; REWRITE_TAC[PNEG_CONS]; CLAIM `~(neg (pneg t) = [])`; ASM_MESON_TAC[POLY_NEG_NIL;PNEG_NIL]; STRIP_TAC; ASM_SIMP_TAC[LAST_CONS]; ASM_MESON_TAC[NEG_LAST;PNEG_NIL]; CLAIM `normal t`; MATCH_MP_TAC NORMAL_TAIL; ASM_MESON_TAC[]; REPEAT STRIP_TAC; CLAIM `EVEN (degree t)`; MATCH_EQ_MP_TAC ODD_EVEN; ASM_MESON_TAC[DEGREE_CONS;ADD1;ADD_SYM]; DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE [x]) THEN ASSUME_TAC x); ASM_SIMP_TAC[LAST_CONS]; REWRITE_TAC[PNEG_CONS]; CLAIM `~(neg (pneg t) = [])`; ASM_MESON_TAC[POLY_NEG_NIL;PNEG_NIL]; STRIP_TAC; ASM_SIMP_TAC[LAST_CONS]; ASM_SIMP_TAC[NEG_LAST;PNEG_NIL]; REAL_SIMP_TAC; ]);; (* }}} *) let PNEG_AUX_LENGTH = prove_by_refinement( `!p n. LENGTH (pneg_aux n p) = LENGTH p`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[LENGTH;pneg;pneg_aux;]; REWRITE_TAC[LENGTH;pneg;pneg_aux;]; ASM_MESON_TAC[]; ]);; (* }}} *) let PNEG_LENGTH = prove_by_refinement( `!p. LENGTH (pneg p) = LENGTH p`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[LENGTH;pneg;pneg_aux;]; REWRITE_TAC[LENGTH;pneg;pneg_aux;]; ASM_MESON_TAC[PNEG_AUX_LENGTH]; ]);; (* }}} *) let LAST_PNEG_AUX_0 = prove_by_refinement( `!p n. ~(p = []) ==> ((LAST p = &0) <=> (LAST (pneg_aux n p) = &0))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; STRIP_TAC; DISCH_THEN IGNORE; CASES_ON `t = []`; ASM_REWRITE_TAC[LAST;pneg;pneg_aux;]; REAL_SIMP_TAC; ASM_SIMP_TAC[LAST_CONS;pneg;pneg_aux;]; REAL_SIMP_TAC; EQ_TAC; DISCH_THEN SUBST1_TAC; REAL_SIMP_TAC; STRIP_TAC; MP_TAC (ISPECL[`-- &1`;`n:num`] POW_NZ); REAL_SIMP_TAC; REWRITE_TAC[ARITH_RULE `~(-- &1 = &0)`]; STRIP_TAC; ASM_MESON_TAC[REAL_ENTIRE]; ASM_SIMP_TAC[LAST_CONS]; REWRITE_TAC[pneg_aux]; CLAIM `~(pneg_aux (SUC n) t = [])`; ASM_MESON_TAC[PNEG_AUX_NIL]; STRIP_TAC; ASM_SIMP_TAC[LAST_CONS]; ASM_MESON_TAC[]; ]);; (* }}} *) let LAST_PNEG_0 = prove_by_refinement( `!p n. ~(p = []) ==> ((LAST p = &0) = (LAST (pneg p) = &0))`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN MESON_TAC[LAST_PNEG_AUX_0;pneg]; ]);; (* }}} *) let PNEG_LAST = prove_by_refinement( `!p. ~(p = []) ==> (LAST (pneg p) = LAST p) \/ (LAST (pneg p) = -- LAST p)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CASES_ON `normal p`; MP_TAC (ISPEC `p:real list` POLY_PNEG_LAST); ASM_REWRITE_TAC[]; STRIP_TAC; DISJ_CASES_TAC (ISPEC `degree p` EVEN_OR_ODD); ASM_MESON_TAC[]; ASM_MESON_TAC !REAL_REWRITES; REWRITE_ASSUMS[NORMAL_ID;DE_MORGAN_THM;]; POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `LENGTH p = 0`; POP_ASSUM MP_TAC THEN ARITH_TAC; ASM_MESON_TAC[LENGTH_0]; ASM_REWRITE_TAC[]; DISJ1_TAC; ASM_MESON_TAC[LAST_PNEG_0]; ]);; (* }}} *) let NORMAL_PNEG = prove_by_refinement( `!p. normal p = normal (pneg p)`, (* {{{ Proof *) [ REWRITE_TAC[NORMAL_ID]; REPEAT STRIP_TAC; EQ_TAC; REPEAT STRIP_TAC; ASM_MESON_TAC[PNEG_LENGTH]; MP_TAC (ISPEC `p:real list` PNEG_LAST); CLAIM `~(p = [])`; ASM_MESON_TAC[LENGTH_NZ]; STRIP_TAC; ASM_REWRITE_TAC[]; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; (* save *) REPEAT STRIP_TAC; ONCE_REWRITE_TAC[GSYM PNEG_LENGTH]; ASM_REWRITE_TAC[]; MP_TAC (ISPEC `p:real list` PNEG_LAST); CLAIM `~(p = [])`; ASM_MESON_TAC[LENGTH_NZ;PNEG_LENGTH]; STRIP_TAC; ASM_REWRITE_TAC[]; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let PNEG_AUX_NORMALIZE_LENGTH = prove_by_refinement( `!p n. LENGTH (normalize (pneg_aux n p)) = LENGTH (normalize p)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[normalize;LENGTH;pneg_aux;]; REWRITE_TAC[normalize;LENGTH;pneg;pneg_aux;]; STRIP_TAC; REPEAT COND_CASES_TAC THEN TRY (ASM_SIMP_TAC !LIST_REWRITES); LABEL_ALL_TAC; KEEP ["Z-2";"Z-0"]; CLAIM `~(-- &1 pow n = &0)`; MATCH_MP_TAC REAL_POW_NZ; REAL_ARITH_TAC; STRIP_TAC; ASM_MESON_TAC[REAL_ENTIRE]; ASM_MESON_TAC[LENGTH_0]; CLAIM `~(-- &1 pow n = &0)`; MATCH_MP_TAC REAL_POW_NZ; REAL_ARITH_TAC; STRIP_TAC; ASM_MESON_TAC[REAL_ENTIRE]; ASM_MESON_TAC[LENGTH_0]; ASM_MESON_TAC[LENGTH_0]; ]);; (* }}} *) let PNEG_NORMALIZE_LENGTH = prove_by_refinement( `!p n. LENGTH (normalize (pneg p)) = LENGTH (normalize p)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[pneg]; ASM_MESON_TAC[PNEG_AUX_NORMALIZE_LENGTH;pneg;pneg_aux;]; ]);; (* }}} *) let DEGREE_PNEG = prove_by_refinement( `!p. degree (pneg p) = degree p`, (* {{{ Proof *) [ REWRITE_TAC[degree]; ASM_MESON_TAC[PNEG_NORMALIZE_LENGTH]; ]);; (* }}} *) let PNEG_SING = prove_by_refinement( `!p. (pneg p = [x]) <=> (p = [x])`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[pneg;pneg_aux]; EQ_TAC; REPEAT STRIP_TAC; LIST_SIMP_TAC; STRIP_TAC; REWRITE_ASSUMS[pneg;pneg_aux]; POP_ASSUM MP_TAC; REAL_SIMP_TAC; LIST_SIMP_TAC; MESON_TAC[]; POP_ASSUM MP_TAC; REWRITE_TAC[pneg;pneg_aux]; LIST_SIMP_TAC; ASM_MESON_TAC[PNEG_AUX_NIL]; REWRITE_TAC[pneg;pneg_aux]; REAL_SIMP_TAC; LIST_SIMP_TAC; STRIP_TAC; ASM_MESON_TAC[pneg_aux]; ]);; (* }}} *) let PNEG_NONCONSTANT = prove_by_refinement( `!p. nonconstant (pneg p) = nonconstant p`, (* {{{ Proof *) [ REWRITE_TAC[nonconstant]; STRIP_TAC THEN EQ_TAC; REPEAT STRIP_TAC; ASM_MESON_TAC[NORMAL_PNEG]; POP_ASSUM (REWRITE_ASSUMS o list); REWRITE_ASSUMS[pneg;pneg_aux]; POP_ASSUM MP_TAC; REAL_SIMP_TAC; MESON_TAC[]; REPEAT STRIP_TAC; ASM_MESON_TAC[NORMAL_PNEG]; ASM_MESON_TAC[PNEG_SING]; ]);; (* }}} *) let LAST_UNBB_EVEN_NEG = prove_by_refinement( `!p. nonconstant p /\ EVEN (degree p) /\ LAST p < &0 ==> mono_unbounded_below (\n. poly p (-- &n))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[POLY_PNEG]; MATCH_MP_TAC LAST_UNB_NEG; ASM_REWRITE_TAC[PNEG_NONCONSTANT]; ASM_MESON_TAC[POLY_PNEG_LAST;nonconstant;]; ]);; (* }}} *) let POLY_PNEG_LAST2 = prove_by_refinement( `!p. normal p ==> (EVEN (degree p) ==> (LAST (pneg p) = LAST p)) /\ (ODD (degree p) ==> (LAST (pneg p) = -- LAST p))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ASM_MESON_TAC[POLY_PNEG_LAST]; ASM_MESON_TAC([POLY_PNEG_LAST; ARITH_RULE `(--x = y) <=> (x = -- y)` ]); ]);; (* }}} *) let LAST_UNB_ODD_NEG = prove_by_refinement( `!p. nonconstant p /\ ODD (degree p) /\ LAST p < &0 ==> mono_unbounded_above (\n. poly p (-- &n))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[POLY_PNEG]; MATCH_MP_TAC LAST_UNB; ASM_REWRITE_TAC[PNEG_NONCONSTANT]; CLAIM `LAST (pneg p) = -- LAST p`; ASM_MESON_TAC[POLY_PNEG_LAST2;nonconstant;]; DISCH_THEN SUBST1_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let LAST_UNB_EVEN_POS = prove_by_refinement( `!p. nonconstant p /\ EVEN (degree p) /\ &0 < LAST p ==> mono_unbounded_above (\n. poly p (-- &n))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[POLY_PNEG]; MATCH_MP_TAC LAST_UNB; ASM_REWRITE_TAC[PNEG_NONCONSTANT]; ASM_MESON_TAC[POLY_PNEG_LAST2;nonconstant;]; ]);; (* }}} *) let LAST_UNB_ODD_POS = prove_by_refinement( `!p. nonconstant p /\ ODD (degree p) /\ &0 < LAST p ==> mono_unbounded_below (\n. poly p (-- &n))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[POLY_PNEG]; MATCH_MP_TAC LAST_UNB_NEG; ASM_REWRITE_TAC[PNEG_NONCONSTANT]; CLAIM `LAST (pneg p) = -- LAST p`; ASM_MESON_TAC[POLY_PNEG_LAST2;nonconstant;]; DISCH_THEN SUBST1_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let PNEG_NORMALIZE_LENGTH = prove_by_refinement( `!p n. LENGTH (normalize (pneg p)) = LENGTH (normalize p)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[pneg]; ASM_MESON_TAC[PNEG_AUX_NORMALIZE_LENGTH;pneg;pneg_aux;]; ]);; (* }}} *) let POLY_DIFF_AUX_NORMAL = prove_by_refinement( `!p n. ~(n = 0) ==> (normal p = normal (poly_diff_aux n p))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[normal;poly_diff_aux;]; REPEAT STRIP_TAC; REWRITE_TAC[poly_diff_aux]; CASES_ON `t = []`; ASM_REWRITE_TAC[poly_diff_aux;]; REWRITE_TAC[normal]; EQ_TAC; REPEAT STRIP_TAC; REWRITE_TAC[normalize]; COND_CASES_TAC; CLAIM `~(h = &0)`; ASM_MESON_TAC[normal;normalize]; STRIP_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_INJ]; ASM_REWRITE_TAC[]; ASM_MESON_TAC[NOT_CONS_NIL]; STRIP_TAC; ASM_REWRITE_TAC[NOT_CONS_NIL]; REWRITE_TAC[NORMALIZE_SING]; CLAIM `~(&n * h = &0)`; ASM_MESON_TAC[normalize]; ASM_MESON_TAC[REAL_ENTIRE;REAL_INJ;normalize]; EQ_TAC; REPEAT STRIP_TAC; CLAIM `normal t`; ASM_MESON_TAC[NORMAL_TAIL]; STRIP_TAC; MATCH_MP_TAC NORMAL_CONS; ASM_MESON_TAC[ARITH_RULE `~(SUC x = 0)`]; STRIP_TAC; MATCH_MP_TAC NORMAL_CONS; MP_TAC (ARITH_RULE `~(SUC n = 0)`); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> (MP_TAC (MATCH_MP y x)))); STRIP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC NORMAL_TAIL; EXISTS_TAC `&n * h`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[poly_diff_aux;NOT_CONS_NIL;list_CASES]; ]);; (* }}} *) let POLY_DIFF_NORMAL = prove_by_refinement( `!p. nonconstant p ==> normal (poly_diff p)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; ASM_MESON_TAC[normal;poly_diff;poly_diff_aux;POLY_DIFF_AUX_NORMAL;ARITH_RULE `~(1 = 0)`;nonconstant;]; REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL]; REWRITE_TAC[nonconstant]; STRIP_TAC; CLAIM `normal t`; MATCH_MP_TAC NORMAL_TAIL; EXISTS_TAC `h:real`; ASM_MESON_TAC[normal]; STRIP_TAC; ASM_MESON_TAC[normal;poly_diff;poly_diff_aux;POLY_DIFF_AUX_NORMAL;ARITH_RULE `~(1 = 0)`]; ]);; (* }}} *) let POLY_DIFF_AUX_NORMAL2 = prove_by_refinement( `!p n. ~(n = 0) ==> (normal (poly_diff_aux n p) <=> normal p)`, (* {{{ Proof *) [MESON_TAC[POLY_DIFF_AUX_NORMAL]]);; (* }}} *) let POLY_DIFF_AUX_DEGREE = prove_by_refinement( `!p m n. ~(n = 0) /\ ~(m = 0) /\ normal p ==> (degree (poly_diff_aux n p) = degree (poly_diff_aux m p))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[poly_diff_aux]; REPEAT STRIP_TAC; REWRITE_TAC[poly_diff_aux]; CASES_ON `t = []`; ASM_REWRITE_TAC[poly_diff_aux;DEGREE_SING]; CLAIM `normal (poly_diff_aux (SUC n) t)`; ASM_SIMP_TAC[POLY_DIFF_AUX_NORMAL2;NOT_SUC]; MATCH_MP_TAC NORMAL_TAIL; ASM_REWRITE_TAC[]; EXISTS_TAC `h:real`; ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `normal (poly_diff_aux (SUC m) t)`; ASM_SIMP_TAC[POLY_DIFF_AUX_NORMAL2;NOT_SUC]; MATCH_MP_TAC NORMAL_TAIL; ASM_REWRITE_TAC[]; EXISTS_TAC `h:real`; ASM_REWRITE_TAC[]; STRIP_TAC; ASM_SIMP_TAC[DEGREE_CONS]; AP_TERM_TAC; FIRST_ASSUM MATCH_MP_TAC; STRIP_TAC; ARITH_TAC; STRIP_TAC; ARITH_TAC; MATCH_MP_TAC NORMAL_TAIL; ASM_MESON_TAC[]; ]);; (* }}} *) let poly_diff_aux_odd = prove_by_refinement( `!p n. nonconstant p ==> (EVEN (degree p) = EVEN (degree (poly_diff_aux n p))) /\ (ODD (degree p) = ODD (degree (poly_diff_aux n p)))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[normal;nonconstant;]; STRIP_TAC; DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); REWRITE_TAC[nonconstant]; STRIP_TAC; CASES_ON `t = []`; ASM_MESON_TAC[nonconstant;normal]; REWRITE_TAC[poly_diff_aux]; CLAIM `normal t`; ASM_MESON_TAC[NORMAL_TAIL]; STRIP_TAC; CLAIM `normal (poly_diff_aux (SUC n) t)`; ASM_MESON_TAC[nonconstant;normal;POLY_DIFF_AUX_NORMAL;NOT_SUC]; STRIP_TAC; CASES_ON `?x. t = [x]`; POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `~(x = &0)`; ASM_MESON_TAC[normal;normalize]; STRIP_TAC; CLAIM `degree [h; x] = 1`; CLAIM `normalize [h; x] = [h; x]`; ASM_MESON_TAC[normal]; DISCH_THEN SUBST1_TAC; CLAIM `LENGTH [h; x] = 2`; ASM_MESON_TAC[LENGTH_PAIR]; STRIP_TAC; REWRITE_TAC[degree]; CLAIM `normal [h; x]`; ASM_MESON_TAC[normal;normalize]; DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); REWRITE_TAC[normal]; STRIP_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; STRIP_TAC; ASM_REWRITE_TAC[poly_diff_aux;]; CLAIM `~(&(SUC n) * x = &0)`; ASM_MESON_TAC[normal;normalize;REAL_ENTIRE;ARITH_RULE `~(SUC n = 0)`;REAL_INJ]; STRIP_TAC; CLAIM `degree [&n * h; &(SUC n) * x] = 1`; REWRITE_TAC[degree]; ASM_REWRITE_TAC[normalize;NOT_CONS_NIL;LENGTH;]; ARITH_TAC; STRIP_TAC; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[DEGREE_CONS]; CLAIM `nonconstant t`; ASM_MESON_TAC[nonconstant]; STRIP_TAC; ONCE_REWRITE_TAC[ADD_SYM]; REWRITE_TAC[GSYM ADD1]; ASM_SIMP_TAC[EVEN;ODD]; ASM_MESON_TAC[POLY_DIFF_AUX_DEGREE]; ]);; (* }}} *) let poly_diff_parity = prove_by_refinement( `!p n. nonconstant p ==> (EVEN (degree p) = ODD (degree (poly_diff p))) /\ (ODD (degree p) = EVEN (degree (poly_diff p)))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[nonconstant;normal]; STRIP_TAC; DISCH_ASS; REWRITE_TAC[nonconstant]; STRIP_TAC; REWRITE_TAC[poly_diff]; LIST_SIMP_TAC; CLAIM `~(1 = 0)`; ARITH_TAC; STRIP_TAC; CLAIM `normal t`; MATCH_MP_TAC NORMAL_TAIL; ASM_MESON_TAC[nonconstant;normal]; STRIP_TAC; ASM_SIMP_TAC[DEGREE_CONS]; CASES_ON `?x. t = [x]`; POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `~(x = &0)`; ASM_MESON_TAC[normal;normalize]; STRIP_TAC; ASM_REWRITE_TAC[poly_diff_aux;DEGREE_SING;degree;normalize;LENGTH;NOT_CONS_NIL;]; CLAIM `~(&1 * x = &0)`; ASM_MESON_TAC[REAL_ENTIRE;ARITH_RULE `~(&1 = &0)`]; STRIP_TAC; ASM_REWRITE_TAC[LENGTH]; REWRITE_TAC[ARITH_RULE `1 + x = SUC x`]; ASM_MESON_TAC[EVEN;ODD;NOT_EVEN;NOT_ODD;]; CLAIM `nonconstant t`; ASM_MESON_TAC[nonconstant]; DISCH_ASS; DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); ONCE_REWRITE_TAC[ADD_SYM]; REWRITE_TAC[GSYM ADD1;EVEN;ODD]; CLAIM `?h' t'. t = CONS h' t'`; ASM_MESON_TAC[nonconstant;normal;list_CASES]; STRIP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS [x] THEN REWRITE_TAC[x] THEN ASSUME_TAC x); REWRITE_ASSUMS[poly_diff;NOT_CONS_NIL;TL]; REWRITE_TAC[poly_diff_aux]; CLAIM `normal t'`; ASM_MESON_TAC[nonconstant;NORMAL_TAIL;normal]; STRIP_TAC; CLAIM `normal (poly_diff_aux (SUC 1) t')`; ASM_MESON_TAC[POLY_DIFF_AUX_NORMAL2;NOT_SUC]; STRIP_TAC; ASM_SIMP_TAC[DEGREE_CONS]; ONCE_REWRITE_TAC[ADD_SYM]; REWRITE_TAC[GSYM ADD1;EVEN;ODD]; CLAIM `normal (poly_diff_aux 1 t')`; ASM_MESON_TAC[POLY_DIFF_AUX_NORMAL2;ONE;NOT_SUC]; STRIP_TAC; ASM_MESON_TAC[POLY_DIFF_AUX_DEGREE;ONE;NOT_SUC]; ]);; (* }}} *) let poly_diff_parity2 = prove_by_refinement( `!p n. nonconstant p ==> (ODD (degree (poly_diff p)) = EVEN (degree p)) /\ (EVEN (degree (poly_diff p)) = ODD (degree p))`, (* {{{ Proof *) [MESON_TAC[poly_diff_parity]]);; (* }}} *) let normal_nonconstant = prove_by_refinement( `!p. normal p /\ 0 < degree p ==> nonconstant p`, (* {{{ Proof *) [ REWRITE_TAC[nonconstant]; ASM_MESON_TAC[DEGREE_SING;LT_REFL]; ]);; (* }}} *) let nmax_le = prove_by_refinement( `!n m. n <= nmax n m /\ m <= nmax n m`, (* {{{ Proof *) [ REWRITE_TAC[nmax]; REPEAT STRIP_TAC; COND_CASES_TAC; ARITH_TAC; ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_UP_LEFT = prove_by_refinement( `!p. nonconstant p /\ (?X. !x. x < X ==> poly (poly_diff p) x < &0) ==> (?Y. !y. y < Y ==> &0 < poly p y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `mono_unbounded_above (\n. poly p (-- &n))`; REWRITE_TAC[POLY_PNEG]; DISJ_CASES_TAC (ISPEC `degree p` EVEN_OR_ODD); MATCH_MP_TAC mua_quotient_limit; EXISTS_TAC `&1`; EXISTS_TAC `(\n. LAST (pneg p) * &n pow degree (pneg p))`; REPEAT STRIP_TAC; REAL_ARITH_TAC; BETA_TAC; MATCH_MP_TAC LIM_POLY2; MATCH_EQ_MP_TAC NORMAL_PNEG; ASM_MESON_TAC[nonconstant]; MATCH_MP_TAC POW_UNB_CON; STRIP_TAC; REWRITE_TAC[DEGREE_PNEG]; REWRITE_TAC[degree]; CLAIM `normalize p = p`; ASM_MESON_TAC[nonconstant;normal]; DISCH_THEN SUBST1_TAC; CLAIM `~(LENGTH p = 0)`; ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_0;degree]; STRIP_TAC; CLAIM `~(LENGTH p = 1)`; ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_1;degree]; POP_ASSUM MP_TAC THEN ARITH_TAC; (* save *) CLAIM `LAST (pneg p) = LAST p`; ASM_MESON_TAC[GSYM POLY_PNEG_LAST;nonconstant;]; DISCH_THEN SUBST1_TAC; ONCE_REWRITE_TAC[REAL_ARITH `x < y <=> ~(x = y) /\ ~(y < x)`]; STRIP_TAC; ASM_MESON_TAC[NORMAL_ID;nonconstant]; STRIP_TAC; CLAIM `ODD (degree (poly_diff p))`; ASM_SIMP_TAC[poly_diff_parity2]; STRIP_TAC; CLAIM `nonconstant (poly_diff p)`; MATCH_MP_TAC normal_nonconstant; STRIP_TAC; MATCH_MP_TAC NONCONSTANT_DIFF_NORMAL; FIRST_ASSUM MATCH_ACCEPT_TAC; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `mono_unbounded_above (\n. poly (poly_diff p) (-- &n))`; MATCH_MP_TAC LAST_UNB_ODD_NEG; ASM_REWRITE_TAC[]; ASM_MESON_TAC[POLY_DIFF_LAST_LT]; REWRITE_TAC[mono_unbounded_above]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; (* save *) MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); DISCH_THEN (X_CHOOSE_TAC `M:num`); CLAIM `-- &M <= X - &1`; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); STRIP_TAC; CLAIM `N <= nmax M N`; REWRITE_TAC[nmax_le]; DISCH_THEN (REWRITE_ASSUMS o list); CLAIM `-- &(nmax M N) < X`; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `-- &M`; STRIP_TAC; REWRITE_TAC[nmax]; REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; STRIP_TAC; ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; (* save *) REWRITE_TAC[GSYM POLY_PNEG]; MATCH_MP_TAC LAST_UNB_ODD_NEG; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_LT]; CASES_ON `?x. poly_diff p = [x]`; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[LAST]; LABEL_ALL_TAC; USE_THEN "Z-2" MP_TAC; POP_ASSUM (fun x -> REWRITE_TAC[x] THEN ASSUME_TAC x); REWRITE_TAC[poly]; REAL_SIMP_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; EXISTS_TAC `X - &1`; REAL_ARITH_TAC; CLAIM `nonconstant (poly_diff p)`; REWRITE_TAC[nonconstant]; STRIP_TAC; MATCH_MP_TAC POLY_DIFF_NORMAL; FIRST_ASSUM MATCH_ACCEPT_TAC; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `EVEN (degree (poly_diff p))`; ASM_MESON_TAC[poly_diff_parity]; STRIP_TAC; ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x) /\ ~(y = x)`]; REPEAT STRIP_TAC; CLAIM `mono_unbounded_above (\n. poly (poly_diff p) (-- (&n)))`; MATCH_MP_TAC LAST_UNB_EVEN_POS; ASM_REWRITE_TAC[]; REWRITE_TAC[mono_unbounded_above]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; (* save *) MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); DISCH_THEN (X_CHOOSE_TAC `M:num`); CLAIM `-- &M <= X - &1`; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); STRIP_TAC; CLAIM `N <= nmax M N`; REWRITE_TAC[nmax_le]; DISCH_THEN (REWRITE_ASSUMS o list); CLAIM `-- &(nmax M N) < X`; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `-- &M`; STRIP_TAC; REWRITE_TAC[nmax]; REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; STRIP_TAC; ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; ASM_MESON_TAC[nonconstant;NORMAL_ID]; (* save xxx *) REWRITE_TAC[mono_unbounded_above]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); DISCH_THEN (X_CHOOSE_TAC `M:num`); ABBREV_TAC `k = nmax N M`; EXISTS_TAC `-- &k`; REPEAT STRIP_TAC; REWRITE_TAC [ARITH_RULE `x < y <=> ~(y <= x)`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`y:real`;`-- &k`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; CLAIM `&0 < (-- &k) - y`; USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `poly (poly_diff p) x < &0`; FIRST_ASSUM MATCH_MP_TAC; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `-- &k`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `-- &M`; STRIP_TAC; USE_THEN "Z-5" (SUBST1_TAC o GSYM); REWRITE_TAC[nmax]; REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; (* save *) CLAIM `N <= k:num`; USE_THEN "Z-5" (SUBST1_TAC o GSYM); REWRITE_TAC[nmax] THEN ARITH_TAC; STRIP_TAC; CLAIM `&0 < poly p (-- &k)`; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `&0 < poly p (-- &k) - poly p y`; LABEL_ALL_TAC; USE_ASSUM_LIST ["Z-10";"Z-3"] MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(-- &k - y) * poly (poly_diff p) x < &0`; REWRITE_TAC[REAL_MUL_LT]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC; USE_THEN "Z-0" MP_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_DOWN_LEFT = prove_by_refinement( `!p. nonconstant p /\ (?X. !x. x < X ==> &0 < poly (poly_diff p) x) ==> (?Y. !y. y < Y ==> poly p y < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `mono_unbounded_below (\n. poly p (-- &n))`; REWRITE_TAC[POLY_PNEG]; DISJ_CASES_TAC (ISPEC `degree p` EVEN_OR_ODD); MATCH_MP_TAC mua_quotient_limit_neg; EXISTS_TAC `&1`; EXISTS_TAC `(\n. LAST (pneg p) * &n pow degree (pneg p))`; REPEAT STRIP_TAC; REAL_ARITH_TAC; BETA_TAC; MATCH_MP_TAC LIM_POLY2; MATCH_EQ_MP_TAC NORMAL_PNEG; ASM_MESON_TAC[nonconstant]; MATCH_MP_TAC POW_UNBB_CON; STRIP_TAC; REWRITE_TAC[DEGREE_PNEG]; REWRITE_TAC[degree]; CLAIM `normalize p = p`; ASM_MESON_TAC[nonconstant;normal]; DISCH_THEN SUBST1_TAC; CLAIM `~(LENGTH p = 0)`; ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_0;degree]; STRIP_TAC; CLAIM `~(LENGTH p = 1)`; ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_1;degree]; POP_ASSUM MP_TAC THEN ARITH_TAC; (* save *) CLAIM `LAST (pneg p) = LAST p`; ASM_MESON_TAC[GSYM POLY_PNEG_LAST;nonconstant;]; DISCH_THEN SUBST1_TAC; ONCE_REWRITE_TAC[REAL_ARITH `x < y <=> ~(x = y) /\ ~(y < x)`]; STRIP_TAC; ASM_MESON_TAC[NORMAL_ID;nonconstant]; STRIP_TAC; CLAIM `ODD (degree (poly_diff p))`; ASM_SIMP_TAC[poly_diff_parity2]; STRIP_TAC; CLAIM `nonconstant (poly_diff p)`; MATCH_MP_TAC normal_nonconstant; STRIP_TAC; MATCH_MP_TAC NONCONSTANT_DIFF_NORMAL; FIRST_ASSUM MATCH_ACCEPT_TAC; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `mono_unbounded_below (\n. poly (poly_diff p) (-- &n))`; MATCH_MP_TAC LAST_UNB_ODD_POS; ASM_REWRITE_TAC[]; ASM_MESON_TAC[POLY_DIFF_LAST_GT]; REWRITE_TAC[mono_unbounded_below]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; (* save *) MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); DISCH_THEN (X_CHOOSE_TAC `M:num`); CLAIM `-- &M <= X - &1`; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); STRIP_TAC; CLAIM `N <= nmax M N`; REWRITE_TAC[nmax_le]; DISCH_THEN (REWRITE_ASSUMS o list); CLAIM `-- &(nmax M N) < X`; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `-- &M`; STRIP_TAC; REWRITE_TAC[nmax]; REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; STRIP_TAC; ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; (* save *) REWRITE_TAC[GSYM POLY_PNEG]; MATCH_MP_TAC LAST_UNB_ODD_POS; ASM_REWRITE_TAC[]; ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_GT]; CASES_ON `?x. poly_diff p = [x]`; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[LAST]; LABEL_ALL_TAC; USE_THEN "Z-2" MP_TAC; POP_ASSUM (fun x -> REWRITE_TAC[x] THEN ASSUME_TAC x); REWRITE_TAC[poly]; REAL_SIMP_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; EXISTS_TAC `X - &1`; REAL_ARITH_TAC; CLAIM `nonconstant (poly_diff p)`; REWRITE_TAC[nonconstant]; STRIP_TAC; MATCH_MP_TAC POLY_DIFF_NORMAL; FIRST_ASSUM MATCH_ACCEPT_TAC; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `EVEN (degree (poly_diff p))`; ASM_MESON_TAC[poly_diff_parity]; STRIP_TAC; ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x) /\ ~(y = x)`]; REPEAT STRIP_TAC; CLAIM `mono_unbounded_below (\n. poly (poly_diff p) (-- (&n)))`; MATCH_MP_TAC LAST_UNBB_EVEN_NEG; ASM_REWRITE_TAC[]; REWRITE_TAC[mono_unbounded_below]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; (* save *) MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); DISCH_THEN (X_CHOOSE_TAC `M:num`); CLAIM `-- &M <= X - &1`; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); STRIP_TAC; CLAIM `N <= nmax M N`; REWRITE_TAC[nmax_le]; DISCH_THEN (REWRITE_ASSUMS o list); CLAIM `-- &(nmax M N) < X`; MATCH_MP_TAC REAL_LET_TRANS; EXISTS_TAC `-- &M`; STRIP_TAC; REWRITE_TAC[nmax]; REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; STRIP_TAC; ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; ASM_MESON_TAC[nonconstant;NORMAL_ID]; (* save *) REWRITE_TAC[mono_unbounded_below]; DISCH_THEN (MP_TAC o ISPEC `&0`); STRIP_TAC; MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); DISCH_THEN (X_CHOOSE_TAC `M:num`); ABBREV_TAC `k = nmax N M`; EXISTS_TAC `-- &k`; REPEAT STRIP_TAC; REWRITE_TAC [ARITH_RULE `x < y <=> ~(y <= x)`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`y:real`;`-- &k`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; CLAIM `&0 < (-- &k) - y`; USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < poly (poly_diff p) x`; FIRST_ASSUM MATCH_MP_TAC; MATCH_MP_TAC REAL_LTE_TRANS; EXISTS_TAC `-- &k`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `-- &M`; STRIP_TAC; USE_THEN "Z-5" (SUBST1_TAC o GSYM); REWRITE_TAC[nmax]; REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; (* save *) CLAIM `N <= k:num`; USE_THEN "Z-5" (SUBST1_TAC o GSYM); REWRITE_TAC[nmax] THEN ARITH_TAC; STRIP_TAC; CLAIM `poly p (-- &k) < &0`; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `poly p (-- &k) - poly p y < &0`; LABEL_ALL_TAC; USE_ASSUM_LIST ["Z-10";"Z-3"] MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < (-- &k - y) * poly (poly_diff p) x`; REWRITE_TAC[REAL_MUL_GT]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC; USE_THEN "Z-0" MP_TAC; REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_DOWN_LEFT2 = prove_by_refinement( `!p X. nonconstant p /\ (!x. x < X ==> &0 < poly (poly_diff p) x) ==> (?Y. Y < X /\ (!y. y < Y ==> poly p y < &0))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPEC `p:real list` POLY_DIFF_DOWN_LEFT); ASM_REWRITE_TAC[]; ANTS_TAC; ASM_MESON_TAC[]; STRIP_TAC; EXISTS_TAC `min X Y - &1`; REPEAT STRIP_TAC; REAL_ARITH_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_UP_LEFT2 = prove_by_refinement( `!p X. nonconstant p /\ (!x. x < X ==> poly (poly_diff p) x < &0) ==> (?Y. Y < X /\ (!y. y < Y ==> &0 < poly p y))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPEC `p:real list` POLY_DIFF_UP_LEFT); ASM_REWRITE_TAC[]; ANTS_TAC; ASM_MESON_TAC[]; STRIP_TAC; EXISTS_TAC `min X Y - &1`; REPEAT STRIP_TAC; REAL_ARITH_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_DOWN_LEFT3 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. x < X ==> &0 < poly p' x) ==> (?Y. Y < X /\ (!y. y < Y ==> poly p y < &0))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPEC `p:real list` POLY_DIFF_DOWN_LEFT); ASM_REWRITE_TAC[]; ANTS_TAC; ASM_MESON_TAC[]; STRIP_TAC; EXISTS_TAC `min X Y - &1`; REPEAT STRIP_TAC; REAL_ARITH_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_UP_LEFT3 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. x < X ==> poly p' x < &0) ==> (?Y. Y < X /\ (!y. y < Y ==> &0 < poly p y))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPEC `p:real list` POLY_DIFF_UP_LEFT); ASM_REWRITE_TAC[]; ANTS_TAC; ASM_MESON_TAC[]; STRIP_TAC; EXISTS_TAC `min X Y - &1`; REPEAT STRIP_TAC; REAL_ARITH_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_DOWN_LEFT4 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. x < X ==> &0 < poly p' x) ==> (?Y. Y < X /\ (!y. y <= Y ==> poly p y < &0))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL[ `p:real list`;`p':real list`;`X:real`] POLY_DIFF_DOWN_LEFT3); ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; EXISTS_TAC `Y - &1`; STRIP_TAC; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; REAL_ARITH_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_UP_LEFT4 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. x < X ==> poly p' x < &0) ==> (?Y. Y < X /\ (!y. y <= Y ==> &0 < poly p y))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL[ `p:real list`;`p':real list`;`X:real`] POLY_DIFF_UP_LEFT3); ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; EXISTS_TAC `Y - &1`; STRIP_TAC; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; REAL_ARITH_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_DOWN_LEFT5 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. x < X ==> poly p' x > &0) ==> (?Y. Y < X /\ (!y. y <= Y ==> poly p y < &0))`, (* {{{ Proof *) [ REWRITE_TAC[real_gt]; ASM_MESON_TAC[POLY_DIFF_DOWN_LEFT4]; ]);; (* }}} *) let POLY_DIFF_UP_LEFT5 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. x < X ==> poly p' x < &0) ==> (?Y. Y < X /\ (!y. y <= Y ==> poly p y > &0))`, (* {{{ Proof *) [ REWRITE_TAC[real_gt]; MESON_TAC[POLY_DIFF_UP_LEFT4]; ]);; (* }}} *) let NORMAL_PDIFF_LEM = prove_by_refinement( `!p. normal (poly_diff p) ==> nonconstant p`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[normal;poly_diff;poly_diff_aux]; REWRITE_TAC[nonconstant]; REWRITE_TAC[poly_diff;poly_diff_aux;NOT_CONS_NIL;TL;]; REPEAT STRIP_TAC; MATCH_MP_TAC NORMAL_CONS; ASM_MESON_TAC[POLY_DIFF_AUX_NORMAL;ARITH_RULE `~(1 = 0)`]; CLAIM `t = []`; ASM_MESON_TAC !LIST_REWRITES; DISCH_THEN (REWRITE_ASSUMS o list); ASM_MESON_TAC[normal;poly_diff_aux]; ]);; (* }}} *) let NORMAL_PDIFF = prove_by_refinement( `!p. nonconstant p = normal (poly_diff p)`, (* {{{ Proof *) [ MESON_TAC[NORMAL_PDIFF_LEM;POLY_DIFF_NORMAL]; ]);; (* }}} *) let POLY_DIFF_UP_RIGHT2 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. X < x ==> &0 < poly p' x) ==> (?Y. X < Y /\ (!y. Y <= y ==> &0 < poly p y))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL[ `p:real list`] (GEN_ALL POLY_DIFF_UP_RIGHT)); ASM_REWRITE_TAC[]; ANTS_TAC; ASM_MESON_TAC[]; REPEAT STRIP_TAC; EXISTS_TAC `(max X Y) + &1`; STRIP_TAC; REAL_ARITH_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_DOWN_RIGHT2 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. X < x ==> poly p' x < &0) ==> (?Y. X < Y /\ (!y. Y <= y ==> poly p y < &0))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL[ `p:real list`] (GEN_ALL POLY_DIFF_DOWN_RIGHT)); ASM_REWRITE_TAC[]; ANTS_TAC; ASM_MESON_TAC[]; REPEAT STRIP_TAC; EXISTS_TAC `(max X Y) + &1`; STRIP_TAC; REAL_ARITH_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let POLY_DIFF_UP_RIGHT3 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. X < x ==> poly p' x > &0) ==> (?Y. X < Y /\ (!y. Y <= y ==> poly p y > &0))`, (* {{{ Proof *) [ REWRITE_TAC[real_gt;real_ge]; MESON_TAC[POLY_DIFF_UP_RIGHT2]; ]);; (* }}} *) let POLY_DIFF_DOWN_RIGHT3 = prove_by_refinement( `!p p' X. nonconstant p ==> (poly_diff p = p') ==> (!x. X < x ==> poly p' x < &0) ==> (?Y. X < Y /\ (!y. Y <= y ==> poly p y < &0))`, (* {{{ Proof *) [ REWRITE_TAC[real_gt;real_ge]; MESON_TAC[POLY_DIFF_DOWN_RIGHT2]; ]);; (* }}} *) hol-light/Rqe/basic.ml000066400000000000000000000020551303454263000151110ustar00rootroot00000000000000 (* ---------------------------------------------------------------------- *) (* Operators *) (* ---------------------------------------------------------------------- *) let dest_beq = dest_binop `(<=>)`;; let t_tm = `T`;; let f_tm = `F`;; parse_as_infix ("<>",(12,"right"));; let NEQ = new_definition `x <> y <=> ~(x = y)`;; let nqt = `(<>):A -> A -> bool`;; let mk_neq (l,r) = try let ty = type_of l in let nqt' = inst[ty,aty] nqt in mk_comb(mk_comb(nqt',l),r) with Failure _ -> failwith "mk_neq";; (* ---------------------------------------------------------------------- *) (* Unfiled *) (* ---------------------------------------------------------------------- *) let IMP_AND_THM = TAUT `(p ==> q ==> r) <=> (p /\ q ==> r)`;; let AND_IMP_THM = TAUT `(p /\ q ==> r) <=> (p ==> q ==> r)`;; let is_pos tm = not (is_neg tm);; let CONJ_LIST thms = end_itlist CONJ thms;; (* CONJ_LIST [TRUTH;TRUTH;TRUTH] *) hol-light/Rqe/condense.ml000066400000000000000000000475151303454263000156400ustar00rootroot00000000000000(* ====================================================================== *) (* CONDENSE *) (* ====================================================================== *) (* let merge_interpsign ord_thm (thm1,thm2,thm3) = let thm1' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm1) in let thm2' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm2) in let thm3' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm3) in let set1,_,_ = dest_interpsign thm1 in let _,s1 = dest_abs set1 in let set3,_,_ = dest_interpsign thm3 in let _,s3 = dest_abs set3 in let gthm = if is_conj s1 && is_conj s3 then gen_thm else if is_conj s1 && not (is_conj s3) then gen_thm_noright else if not (is_conj s1) && is_conj s3 then gen_thm_noleft else gen_thm_noboth in PURE_REWRITE_RULE[GSYM interpsign] (MATCH_MPL[gthm;ord_thm;thm1';thm2';thm3']);; *) (* {{{ Examples *) (* length thms merge_interpsign ord_thm (hd thms) let thm1,thm2,thm3 = hd thms let ord_thm = ASSUME `x2 < x3`;; let thm1 = ASSUME `interpsign (\x. x < x2) [&1; &2; &3] Pos`;; let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Pos`;; let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Pos`;; merge_interpsign ord_thm (thm1,thm2,thm3);; let ord_thm = ASSUME `x1 < x2`;; let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Pos`;; let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Pos`;; let thm3 = ASSUME `interpsign (\x. x2 < x) [&1; &2; &3] Pos`;; merge_interpsign ord_thm (thm1,thm2,thm3);; let ord_thm = TRUTH;; let thm1 = ASSUME `interpsign (\x. x < x1) [&1; &2; &3] Pos`;; let thm2 = ASSUME `interpsign (\x. x = x1) [&1; &2; &3] Pos`;; let thm3 = ASSUME `interpsign (\x. x1 < x) [&1; &2; &3] Pos`;; merge_interpsign ord_thm (thm1,thm2,thm3);; let ord_thm = ASSUME `x1 < x2 /\ x2 < x3`;; let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Pos`;; let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Pos`;; let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Pos`;; merge_interpsign ord_thm (thm1,thm2,thm3);; let ord_thm = ASSUME `x1 < x3`;; let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Neg`;; let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Neg`;; let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Neg`;; merge_interpsign ord_thm (thm1,thm2,thm3);; let ord_thm = ASSUME `x1 < x3`;; let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Zero`;; let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Zero`;; let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Zero`;; merge_interpsign ord_thm (thm1,thm2,thm3);; let ord_thm = ASSUME `x1 < x3`;; let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Nonzero`;; let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Nonzero`;; let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Nonzero`;; merge_interpsign ord_thm (thm1,thm2,thm3);; let ord_thm = ASSUME `x1 < x3`;; let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Unknown`;; let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Unknown`;; let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Unknown`;; merge_interpsign ord_thm (thm1,thm2,thm3);; *) (* }}} *) (* let rec merge_three l1 l2 l3 = match l1 with [] -> [] | h::t -> (hd l1,hd l2,hd l3)::merge_three (tl l1) (tl l2) (tl l3);; *) (* {{{ Doc *) (* combine_interpsigns |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x1 < x /\ x < x2) [Unknown; Pos; Pos; Neg] |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x2) [Unknown; Pos; Pos; Neg]; |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x2 < x /\ x < x3) [Unknown; Pos; Pos; Neg]; --> |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x1 < x /\ x < x3) [Unknown; Pos; Pos; Neg]; *) (* }}} *) (* let combine_interpsigns ord_thm thm1 thm2 thm3 = let _,_,s1 = dest_interpsigns thm1 in let _,_,s2 = dest_interpsigns thm2 in let _,_,s3 = dest_interpsigns thm3 in if not (s1 = s2) || not (s1 = s3) then failwith "combine_interpsigns: signs not equal" else try let thms1 = CONJUNCTS(PURE_REWRITE_RULE[interpsigns;ALL2] thm1) in let thms2 = CONJUNCTS(PURE_REWRITE_RULE[interpsigns;ALL2] thm2) in let thms3 = CONJUNCTS(PURE_REWRITE_RULE[interpsigns;ALL2] thm3) in let thms = butlast (merge_three thms1 thms2 thms3) (* ignore the T at end *) in let thms' = map (merge_interpsign ord_thm) thms in mk_interpsigns thms' with Failure s -> failwith ("combine_interpsigns: " ^ s);; *) (* {{{ Examples *) (* let thm = combine_interpsigns let ord_thm,thm1,thm2,thm3 = ord_thm5 ,ci1 ,ci2 ,ci3 let h1 = combine_interpsigns ord_thm int1 pt int2 in let thm1,thm2,thm3 = int1,pt,int2 let tmp = (ith 0 thms) merge_interpsign ord_thm tmp let thm1 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x1 < x /\ x < x2) [Unknown; Pos; Pos; Neg]`;; let thm2 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x2) [Unknown; Pos; Pos; Neg]`;; let thm3 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x2 < x /\ x < x3) [Unknown; Pos; Pos; Neg]`;; let ord_thm = ASSUME `x1 < x2 /\ x2 < x3` combine_interpsigns ord_thm thm1 thm2 thm3;; let thm1 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x < x5) [Unknown; Pos; Pos; Neg]`;; let thm2 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x5) [Unknown; Pos; Pos; Neg]`;; let thm3 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x5 < x /\ x < x6) [Unknown; Pos; Pos; Neg]`;; let ord_thm = ASSUME `x5 < x6`;; combine_interpsigns ord_thm thm1 thm2 thm3;; let thm1 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x < x6) [Unknown; Pos; Pos; Neg]`;; let thm2 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x6) [Unknown; Pos; Pos; Neg]`;; let thm3 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x6 < x) [Unknown; Pos; Pos; Neg]`;; let ord_thm = ASSUME `x5 < x6`;; combine_interpsigns ord_thm thm1 thm2 thm3;; *) (* }}} *) (* {{{ Doc *) (* get_bounds `\x. x < x1` `\x. x1 < x /\ x < x2` --> x1 < x2 get_bounds `\x. x0 < x < x1` `\x. x1 < x /\ x < x2` --> x0 < x1 /\ x1 < x2 get_bounds `\x. x < x1` `\x. x1 < x` --> T *) (* }}} *) (* let get_bounds set1 set2 = let _,s1 = dest_abs set1 in let _,s2 = dest_abs set2 in let c1 = if is_conj s1 then let l,r = dest_conj s1 in let l1,l2 = dest_binop rlt l in let l3,l4 = dest_binop rlt r in mk_binop rlt l1 l4 else t_tm in let c2 = if is_conj s2 then let l,r = dest_conj s2 in let l1,l2 = dest_binop rlt l in let l3,l4 = dest_binop rlt r in mk_binop rlt l1 l4 else t_tm in if c1 = t_tm then c2 else if c2 = t_tm then c1 else mk_conj (c1,c2);; *) (* {{{ Examples *) (* get_bounds `\x. x < x1` `\x. x1 < x /\ x < x2` get_bounds `\x. x0 < x /\ x < x1` `\x. x1 < x /\ x < x2` get_bounds `\x. x < x1` `\x. x1 < x` *) (* }}} *) (* {{{ Doc *) (* collect_pts |- interpsigns ... (\x. x < x1) ... |- interpsigns ... (\x. x1 < x /\ x < x4) ... |- interpsigns ... (\x. x4 < x /\ x < x7) ... |- interpsigns ... (\x. x7 < x) ... --> [x1,x4,x7] *) (* }}} *) (* let rec collect_pts thms = match thms with [] -> [] | h::t -> let rest = collect_pts t in let _,set,_ = dest_interpsigns h in let x,b = dest_abs set in let bds = if b = t_tm then [] else if is_conj b then let l,r = dest_conj b in [fst(dest_binop rlt l);snd(dest_binop rlt r)] else let _,l,r = get_binop b in if x = l then [r] else [l] in match rest with [] -> bds | h::t -> if not (h = (last bds)) then failwith "pts not in order" else if length bds = 2 then hd bds::rest else rest;; *) (* {{{ Examples *) (* let thms = [ASSUME `interpsigns [\x. &0 + x * &1; \x. &1] (\x. T) [Unknown; Pos]`] let h::t = [ASSUME `interpsigns [\x. &0 + x * &1; \x. &1] (\x. T) [Unknown; Pos]`] collect_pts [ASSUME `interpsigns [\x. &0 + x * &1; \x. &1] (\x. T) [Unknown; Pos]`] let t1 = ASSUME `interpsigns [[&1]] (\x. x < x1) [Pos]` let t2 = ASSUME `interpsigns [[&1]] (\x. x1 < x /\ x < x4) [Pos]` let t3 = ASSUME `interpsigns [[&1]] (\x. x4 < x /\ x < x7) [Pos]` let t4 = ASSUME `interpsigns [[&1]] (\x. x7 < x) [Pos]` collect_pts [t1;t2;t3;t4] let t1 = ASSUME `interpsigns [[&1]] (\x. x0 < x /\ x < x1) [Pos]` let t2 = ASSUME `interpsigns [[&1]] (\x. x1 < x /\ x < x4) [Pos]` let t3 = ASSUME `interpsigns [[&1]] (\x. x4 < x /\ x < x7) [Pos]` let t4 = ASSUME `interpsigns [[&1]] (\x. x7 < x) [Pos]` collect_pts [t1;t2;t3;t4] let t1 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x < x1) [Unknown; Pos; Pos; Pos]`;; let t2 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x1) [Neg; Pos; Pos; Zero]`;; let t3 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x1 < x /\ x < x4) [Unknown; Pos; Pos; Neg]`;; let t4 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x4) [Pos; Pos; Zero; Neg]`;; let t5 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x4 < x /\ x < x5) [Unknown; Pos; Neg; Neg]`;; let t6 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x5) [Pos; Pos; Zero; Zero]`;; let t7 = ASSUME `interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x5 < x) [Unknown; Pos; Pos; Pos]`;; let thms = [t1;t2;t3;t4;t5;t6;t7] collect_pts thms *) (* combine_identical_lines |- real_ordered_list [x1; x2; x3; x4; x5] |- ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) (partition_line [x1; x2; x3; x4; x5]) [[Unknown; Pos; Pos; Pos]; x1 [Neg; Pos; Pos; Zero]; [Unknown; Pos; Pos; Neg]; x2 [Unknown; Pos; Pos; Neg]; [Unknown; Pos; Pos; Neg]; x3 [Unknown; Pos; Pos; Neg]; [Unknown; Pos; Pos; Neg]; x4 [Pos; Pos; Zero; Neg]; [Unknown; Pos; Neg; Neg]; x5 [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]] --> |- ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) (partition_line [x1; x4; x5]) [[Unknown; Pos; Pos; Pos]; x1 [Neg; Pos; Pos; Zero]; [Unknown; Pos; Pos; Neg]; x4 [Pos; Pos; Zero; Neg]; [Unknown; Pos; Neg; Neg]; x5 [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]] *) (* }}} *) (* let sublist i j l = let _,r = chop_list i l in let l2,r2 = chop_list (j-i+1) r in l2;; *) (* {{{ Examples *) (* let i,j,l = 1,4,[1;2;3;4;5;6;7] sublist 1 4 [1;2;3;4;5;6;7] sublist 2 4 [1;2;3;4;5;6;7] sublist 1 1 [1;2;3;4;5;6;7] *) (* }}} *) (* let rec combine ord_thms l = let lem = REWRITE_RULE[AND_IMP_THM] REAL_LT_TRANS in match l with [int] -> [int] | [int1;int2] -> [int1;int2] | int1::pt::int2::rest -> try let _,set1,_ = dest_interpsigns int1 in let _,set2,_ = dest_interpsigns int2 in let ord_tm = get_bounds set1 set2 in if ord_tm = t_tm then let h1 = combine_interpsigns TRUTH int1 pt int2 in combine ord_thms (h1::rest) else let lt,rt = if is_conj ord_tm then let c1,c2 = dest_conj ord_tm in let l,_ = dest_binop rlt c1 in let _,r = dest_binop rlt c2 in l,r else dest_binop rlt ord_tm in let e1 = find (fun x -> lt = fst(dest_binop rlt (concl x))) ord_thms in let i1 = index e1 ord_thms in let e2 = find (fun x -> rt = snd(dest_binop rlt (concl x))) ord_thms in let i2 = index e2 ord_thms in let ord_thms' = sublist i1 i2 ord_thms in let ord_thm = end_itlist (fun x y -> MATCH_MPL[lem;x;y]) ord_thms' in let h1 = combine_interpsigns ord_thm int1 pt int2 in combine ord_thms (h1::rest) with Failure "combine_interpsigns: signs not equal" -> int1::pt::(combine ord_thms(int2::rest));; *) (* let combine_identical_lines rol_thm all_thm = let tmp,mat = dest_comb (concl all_thm) in let _,line = dest_comb tmp in let _,pts = dest_comb line in let part_thm = PARTITION_LINE_CONV pts in let thm' = REWRITE_RULE[ALL2;part_thm] all_thm in let thms = CONJUNCTS thm' in let ord_thms = rol_thms rol_thm in let thms' = combine ord_thms thms in let pts = collect_pts thms' in let part_thm' = PARTITION_LINE_CONV (mk_list (pts,real_ty)) in mk_all2_interpsigns part_thm' thms';; *) (* {{{ Examples *) (* #untrace combine #trace combine let int1::pt::int2::rest = snd (chop_list 6 thms) let int1::pt::int2::rest = snd (chop_list 0 thms) let int1::pt::int2::rest = snd (chop_list 2 thms) let l = thms let int1::pt::int2::rest = l combine thms let rol_thm = ASSUME `real_ordered_list [x1; x2; x3; x4; x5]` let all_thm = ASSUME `ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) (partition_line [x1; x2; x3; x4; x5]) [[Unknown; Pos; Pos; Pos]; [Neg; Pos; Pos; Zero]; [Unknown; Pos; Pos; Neg]; [Unknown; Pos; Pos; Neg]; [Unknown; Pos; Pos; Neg]; [Unknown; Pos; Pos; Neg]; [Unknown; Pos; Pos; Neg]; [Pos; Pos; Zero; Neg]; [Unknown; Pos; Neg; Neg]; [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]]`;; let all_thm' = combine_identical_lines rol_thm all_thm *) (* }}} *) (* {{{ Doc *) (* assumes l2 is a sublist of l1 list_diff [1;2;3;4] [2;3] --> [1;4] *) (* }}} *) (* let rec list_diff l1 l2 = match l1 with [] -> if l2 = [] then [] else failwith "l2 not a sublist of l1" | h::t -> match l2 with [] -> l1 | h'::t' -> if h = h' then list_diff t t' else h::list_diff t l2;; *) (* {{{ Examples *) (* list_diff [1;2;3;4] [2;3] list_diff [1;2;3;4] [1;3;4] *) (* }}} *) (* let CONDENSE mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let pts = dest_list (snd (dest_comb (concl rol_thm))) in let all_thm' = combine_identical_lines rol_thm all_thm in let _,part,_ = dest_all2 (concl all_thm) in let plist = dest_list (snd (dest_comb part)) in let _,part',_ = dest_all2 (concl all_thm') in let plist' = dest_list (snd (dest_comb part')) in let rol_thm' = itlist ROL_REMOVE (list_diff plist plist') rol_thm in let mat_thm' = mk_interpmat_thm rol_thm' all_thm' in mat_thm';; *) (* ---------------------------------------------------------------------- *) (* OPT *) (* ---------------------------------------------------------------------- *) let rec triple_index l = match l with [] -> failwith "triple_index" | [x] -> failwith "triple_index" | [x;y] -> failwith "triple_index" | x::y::z::rest -> if x = y && y = z then 0 else 1 + triple_index (y::z::rest);; let tmp = ref TRUTH;; (* let tmp let mat_thm = !tmp let mat_thm = mat_thm' *) let rec CONDENSE = let real_app = `APPEND:real list -> real list -> real list` in let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in let real_len = `LENGTH:real list -> num` in let sign_len = `LENGTH:(sign list) list -> num` in let num_mul = `( * ):num -> num -> num` in let real_ty = `:real` in let two = `2` in let sl_ty = `:sign list` in fun mat_thm -> try tmp := mat_thm; let pts,_,sgns = dest_interpmat (concl mat_thm) in let sgnl = dest_list sgns in let ptl = dest_list pts in let i = triple_index sgnl (* fail here if fully condensed *) in if not (i mod 2 = 0) then failwith "misshifted matrix" else if i = 0 then if length ptl = 1 then MATCH_MP INTERPMAT_SING mat_thm else CONDENSE (MATCH_MP INTERPMAT_TRIO mat_thm) else let l,r = chop_list (i - 2) sgnl in let sgn1,sgn2 = mk_list(l,sl_ty),mk_list(r,sl_ty) in let sgns' = mk_comb(mk_comb(sign_app,sgn1),sgn2) in let sgn_thm = prove(mk_eq(sgns,sgns'),REWRITE_TAC[APPEND]) in let l',r' = chop_list (i / 2 - 1) ptl (* i always even *) in let pt1,pt2 = mk_list(l',real_ty),mk_list(r',real_ty) in let pts' = mk_comb(mk_comb(real_app,pt1),pt2) in let pt_thm = prove(mk_eq(pts,pts'),REWRITE_TAC[APPEND]) in let mat_thm' = ONCE_REWRITE_RULE[sgn_thm;pt_thm] mat_thm in let len_thm = prove((mk_eq(mk_comb(sign_len,sgn1),mk_binop num_mul two (mk_comb(real_len,pt1)))),REWRITE_TAC[LENGTH] THEN ARITH_TAC) in CONDENSE (REWRITE_RULE[APPEND] (MATCH_MP (MATCH_MP INTERPMAT_TRIO_INNER mat_thm') len_thm)) with Failure "triple_index" -> mat_thm | Failure x -> failwith ("CONDENSE: " ^ x);; (* {{{ Examples *) (* let mat_thm = mat_thm' CONDENSE mat_thm let mat_thm = ASSUME `interpmat [x1; x2; x3; x4; x5] [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] [ [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Pos; Neg; Neg; Neg]; [Zero; Pos; Pos; Neg; Neg; Neg]; [Neg; Pos; Pos; Neg; Neg; Neg] ]` let mat_thm = ASSUME `interpmat [x1; x2; x3; x4; x5] [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] [[Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Zero; Zero; Neg; Neg]; [Pos; Pos; Neg; Pos; Neg; Neg]; [Pos; Pos; Neg; Pos; Neg; Zero]; [Pos; Pos; Neg; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos; Zero; Pos]; [Pos; Pos; Neg; Pos; Pos; Pos]; [Pos; Zero; Neg; Pos; Pos; Pos]; [Pos; Neg; Neg; Pos; Pos; Pos]; [Pos; Zero; Zero; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos; Pos; Pos]]` let mat_thm' = INFERPSIGN vars sgns mat_thm div_thms CONDENSE mat_thm *) (* }}} *) (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let CONDENSE mat_thm = let start_time = Sys.time() in let res = CONDENSE mat_thm in condense_timer +.= (Sys.time() -. start_time); res;; hol-light/Rqe/condense_thms.ml000066400000000000000000000027721303454263000166670ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Condense subdivision by removing points with no relevant zeros. *) (* ------------------------------------------------------------------------- *) let real_cases = prove(`!x y. x < y \/ (x = y) \/ y < x`,REAL_ARITH_TAC);; let gt_aux = prove( `!x. (x1 < x2 /\ x2 < x3) /\ ((x1 < x /\ x < x2) \/ (x = x2) \/ (x2 < x /\ x < x3)) ==> x1 < x /\ x < x3`, REAL_ARITH_TAC);; let gen_thm = prove_by_refinement( `!P x1 x2 x3. (x1 < x3) ==> (!x. x1 < x /\ x < x2 ==> P x) ==> (!x. (x = x2) ==> P x) ==> (!x. x2 < x /\ x < x3 ==> P x) ==> (!x. x1 < x /\ x < x3 ==> P x)`, (* {{{ Proof *) [ MESON_TAC[real_cases;gt_aux;DE_MORGAN_THM;REAL_NOT_LT;REAL_LE_LT]; ]);; (* }}} *) let gen_thm_noleft = prove( `!P x2 x3. (x2 < x3) ==> (!x. x < x2 ==> P x) ==> (!x. (x = x2) ==> P x) ==> (!x. x2 < x /\ x < x3 ==> P x) ==> (!x. x < x3 ==> P x)`, MESON_TAC[real_cases;gt_aux]);; let gen_thm_noright = prove( `!P x1 x2. (x1 < x2) ==> (!x. x1 < x /\ x < x2 ==> P x) ==> (!x. (x = x2) ==> P x) ==> (!x. x2 < x ==> P x) ==> (!x. x1 < x ==> P x)`, MESON_TAC[real_cases;gt_aux]);; let gen_thm_noboth = prove( `!P Q x2. Q ==> (!x. x < x2 ==> P x) ==> (!x. (x = x2) ==> P x) ==> (!x. x2 < x ==> P x) ==> (!x. T ==> P x)`, MESON_TAC[real_cases;gt_aux]);; hol-light/Rqe/dedmatrix.ml000066400000000000000000000225361303454263000160170ustar00rootroot00000000000000(* ====================================================================== *) (* DEDMATRIX *) (* ====================================================================== *) (* ------------------------------------------------------------------------- *) (* Deduce matrix for p,p1,...,pn from matrix for p',p1,...,pn,q0,...,qn *) (* where qi = rem(p,pi) with p0 = p' *) (* ------------------------------------------------------------------------- *) let prove_nonconstant = let nonconstant_tm = `nonconstant` in fun pdiff_thm normal_thm -> let thm = ONCE_REWRITE_RULE[GSYM pdiff_thm] normal_thm in let ret = REWRITE_RULE[GSYM NORMAL_PDIFF] thm in let f,_ = strip_comb (concl ret) in if not (f = nonconstant_tm) then failwith "prove_nonconstant" else ret;; let REMOVE_COLUMN1 mat_thm = let mat_thm1 = MATCH_MP REMOVE_COL1 mat_thm in REWRITE_RULE[MAP;HD;TL] mat_thm1;; let APPENDIZE l n = let lty = type_of l in let ty = hd(snd(dest_type lty)) in let app_tm = mk_const("APPEND",[ty,aty]) in let l1,l2 = chop_list n (dest_list l) in let app = mk_comb(mk_comb(app_tm,mk_list(l1,ty)),mk_list(l2,ty)) in GSYM (REWRITE_CONV[APPEND] app);; let REMOVE_INFINITIES thm = let thm' = MATCH_MP INTERPMAT_TRIO thm in let pts,_,sgns = dest_interpmat (concl thm') in let p_thm = APPENDIZE pts (length (dest_list pts) - 2) in let pts',_,sgns = dest_interpmat (concl thm') in let s_thm = APPENDIZE sgns (length (dest_list sgns) - 5) in let thm'' = MATCH_MP INTERPMAT_TRIO_TL (ONCE_REWRITE_RULE[p_thm;s_thm] thm') in REWRITE_RULE[APPEND] thm'';; let get_dirs = let pos = `Pos` in let neg = `Neg` in fun lb_deriv ub_deriv -> if lb_deriv = pos && ub_deriv = pos then INFIN_POS_POS else if lb_deriv = pos && ub_deriv = neg then INFIN_POS_NEG else if lb_deriv = neg && ub_deriv = pos then INFIN_NEG_POS else if lb_deriv = neg && ub_deriv = neg then INFIN_NEG_NEG else failwith "get_dirs: bad signs";; let get_sing_dirs = let pos = `Pos` in let neg = `Neg` in fun lb_deriv ub_deriv -> if lb_deriv = pos && ub_deriv = pos then INFIN_SING_POS_POS else if lb_deriv = pos && ub_deriv = neg then INFIN_SING_POS_NEG else if lb_deriv = neg && ub_deriv = pos then INFIN_SING_NEG_POS else if lb_deriv = neg && ub_deriv = neg then INFIN_SING_NEG_NEG else failwith "get_dirs: bad signs";; let aitvars,aitdiff,aitnorm,aitmat = ref [],ref TRUTH,ref TRUTH,ref TRUTH;; (* let vars,diff_thm,normal_thm,mat_thm = !aitvars,!aitdiff,!tnorm,!tmat let vars,diff_thm,normal_thm,mat_thm = vars, pdiff_thm, normal_thm, mat_thm'' *) let ADD_INFINITIES = let real_app = `APPEND:real list -> real list -> real list` in let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in let imat = `interpmat` in let pos = `Pos` in let neg = `Neg` in let sl_ty = `:sign list` in let real_ty = `:real` in fun vars diff_thm normal_thm mat_thm -> aitvars := vars; aitdiff := diff_thm; aitnorm := normal_thm; aitmat := mat_thm; let nc_thm = prove_nonconstant diff_thm normal_thm in let pts,pols,sgns = dest_interpmat (concl mat_thm) in let polsl = dest_list pols in let p::p'::_ = polsl in let p_thm = ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p))) in let p'_thm = ONCE_REWRITE_RULE[GSYM diff_thm] (ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p')))) in let pols_thm = REWRITE_CONV[p_thm;p'_thm] pols in let sgnsl = dest_list sgns in let sgns_len = length sgnsl in let thm1 = if sgns_len = 1 then let sgn = (hd(tl(dest_list (hd sgnsl)))) in let mp_thm = if sgn = pos then INFIN_NIL_POS else if sgn = neg then INFIN_NIL_NEG else failwith "bad sign in mat" in let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),REFL sgns) in let mat_thm2 = EQ_MP mat_thm1 mat_thm in MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm else if sgns_len = 3 then let lb_deriv = hd (tl (dest_list (hd sgnsl))) in let ub_deriv = hd (tl (dest_list (last sgnsl))) in let mp_thm = get_sing_dirs lb_deriv ub_deriv in let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),REFL sgns) in let mat_thm2 = EQ_MP mat_thm1 mat_thm in MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm else let s1,s2 = chop_list (sgns_len - 3) sgnsl in let s3 = mk_list(s1,sl_ty) in let s4 = mk_comb(mk_comb(sign_app,s3),mk_list(s2,sl_ty)) in let sgns_thm = prove(mk_eq(sgns,s4),REWRITE_TAC[APPEND]) in let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),sgns_thm) in let mat_thm2 = EQ_MP mat_thm1 mat_thm in let lb_deriv = hd (tl (dest_list (hd sgnsl))) in let ub_deriv = hd (tl (dest_list (last sgnsl))) in let mp_thm = get_dirs lb_deriv ub_deriv in MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm in let thm2 = REWRITE_RULE[APPEND;GSYM pols_thm] thm1 in let c = concl thm2 in let x,bod = dest_exists c in let x' = new_var real_ty in let bod1 = subst [x',x] bod in let assume_thm1 = ASSUME bod1 in let x2,bod2 = dest_exists bod1 in let x'' = new_var real_ty in let assume_thm2 = ASSUME (subst [x'',x2] bod2) in assume_thm2,(x',thm2),(x'',assume_thm1);; (* print_timers() print_times() reset_timers() *) let tvars,tsgns,tdivs,tdiff,tnorm,tcont,tmat,tex = ref [],ref [],ref [], ref TRUTH,ref TRUTH, ref (fun x y -> x), ref TRUTH, ref [];; (* let vars,sgns,div_thms,pdiff_thm,normal_thm,cont,mat_thm,ex_thms = !tvars,!tsgns,!tdivs,!tdiff,!tnorm,!tcont,!tmat,!tex DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms *) let DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms = try tvars := vars; tsgns := sgns; tdivs := div_thms; tdiff := pdiff_thm; tnorm := normal_thm; tmat := mat_thm; tex := ex_thms; tcont := cont; let start_time = Sys.time() in let pts,pols,signll = dest_interpmat (concl mat_thm) in let mat_thm' = INFERPSIGN vars sgns mat_thm div_thms in let mat_thm'' = CONDENSE mat_thm' in let mat_thm''',(v1,exthm1),(v2,exthm2) = ADD_INFINITIES vars pdiff_thm normal_thm mat_thm'' in let mat_thm4,new_ex_pairs = INFERISIGN vars pdiff_thm mat_thm''' ((v1,exthm1)::(v2,exthm2)::ex_thms) in let mat_thm5 = REMOVE_INFINITIES mat_thm4 in let mat_thm6 = REMOVE_COLUMN1 mat_thm5 in let mat_thm7 = CONDENSE mat_thm6 in (* hack for changing renamed vars *) let mat_thm8 = CONV_RULE (RATOR_CONV (RAND_CONV (LIST_CONV (ALPHA_CONV (hd vars))))) mat_thm7 in let ex_pairs = [(v1,exthm1);(v2,exthm2)] @ new_ex_pairs in let cont' mat_thm ex_thms = cont mat_thm (ex_thms @ ex_pairs) in cont' mat_thm8 ex_thms with (Isign (false_thm,ex_thms)) -> raise (Isign (false_thm,ex_thms)) | Failure x -> failwith ("DEDMATRIX: " ^ x);; (* {{{ Examples *) (* let NOT_NIL_CONV tm = let h,t = dest_cons tm in ISPECL [h;t] NOT_CONS_NIL;; let NORMAL_CONV tm = let normalize_thm = POLY_NORMALIZE_CONV (mk_comb (`normalize`,tm)) in let nonnil_thm = NOT_NIL_CONV tm in let conj_thm = CONJ normalize_thm nonnil_thm in REWRITE_RULE[GSYM normal] conj_thm;; let vars = [`x:real`];; let cont a b = a;; let sgns = [ARITH_RULE `&1 > &0`];; let normal_thm = NORMAL_CONV `[&1; &2; &3]`;; let pdiff_thm = POLY_DIFF_CONV `poly_diff [&1; &1; &1; &1]`;; let ex_thms = [];; let _,l1 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(&1 + x * (&2 + x * &3))`;; let _,l2 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(&2 + x * (-- &3 + x * &1))`;; let _,l3 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(-- &4 + x * (&0 + x * &1))`;; let div_thms = [l1;l2;l3];; let mat_thm = ASSUME `interpmat [x1; x2; x3; x4; x5] [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] [[Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Zero; Zero; Neg; Neg]; [Pos; Pos; Neg; Pos; Neg; Neg]; [Pos; Zero; Neg; Pos; Neg; Zero]; [Pos; Pos; Neg; Pos; Neg; Pos]; [Pos; Pos; Zero; Pos; Zero; Pos]; [Pos; Pos; Neg; Pos; Pos; Pos]; [Pos; Zero; Neg; Pos; Zero; Pos]; [Pos; Neg; Neg; Pos; Pos; Pos]; [Pos; Zero; Zero; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos; Pos; Pos]]` ;; time (DEDMATRIX vars sgns div_thms pdiff_thm normal_thm (fun x y -> x) mat_thm) [] *) (* }}} *) (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let REMOVE_COLUMN1 mat_thm = let start_time = Sys.time() in let res = REMOVE_COLUMN1 mat_thm in remove_column1_timer +.= (Sys.time() -. start_time); res;; let ADD_INFINITIES vars pdiff_thm normal_thm mat_thm = let start_time = Sys.time() in let res = ADD_INFINITIES vars pdiff_thm normal_thm mat_thm in add_infinities_timer +.= (Sys.time() -. start_time); res;; let REMOVE_INFINITIES thm = let start_time = Sys.time() in let res = REMOVE_INFINITIES thm in remove_infinities_timer +.= (Sys.time() -. start_time); res;; hol-light/Rqe/dedmatrix_thms.ml000066400000000000000000000070641303454263000170510ustar00rootroot00000000000000let le_lem = prove_by_refinement( `(!y. y <= Y ==> P y) ==> (!y. y < Y ==> P y) /\ (!y. (y = Y) ==> P y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let lt_int_lem = prove_by_refinement( `(!y. y < Y ==> P y) ==> X < Y ==> (!y. X < y /\ y < Y ==> P y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let ge_lem = prove_by_refinement( `(!y. Y <= y ==> P y) ==> (!y. Y < y ==> P y) /\ (!y. (y = Y) ==> P y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; FIRST_ASSUM MATCH_MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let gt_int_lem = prove_by_refinement( `(!y. Y < y ==> P y) ==> Y < X ==> (!y. Y < y /\ y < X ==> P y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let rest_lt_lem = prove_by_refinement( `Y < X ==> (!x. x < X ==> P x) ==> (!x. x < Y ==> P x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_TRANS;real_gt]; ]);; (* }}} *) let rest_gt_lem = prove_by_refinement( `X < Y ==> (!x. X < x ==> P x) ==> (!x. Y < x ==> P x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_TRANS;real_gt]; ]);; (* }}} *) let rest_eq_lt_lem = prove_by_refinement( `Y < X ==> (!x. x < X ==> P x) ==> (!x. (x = Y) ==> P x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ]);; (* }}} *) let rest_eq_gt_lem = prove_by_refinement( `X < Y ==> (!x. X < x ==> P x) ==> (!x. (x = Y) ==> P x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ]);; (* }}} *) let rest_int_lt_lem = prove_by_refinement( `Y < X ==> (!x. x < X ==> P x) ==> (!x. Y < x /\ x < X ==> P x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ]);; (* }}} *) let rest_int_gt_lem = prove_by_refinement( `X < Y ==> (!x. X < x ==> P x) ==> (!x. X < x /\ x < Y ==> P x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ]);; (* }}} *) let INTERPSIGN_SUBSET = prove_by_refinement( `!P Q p s. interpsign P p s /\ Q SUBSET P ==> interpsign Q p s`, (* {{{ Proof *) [ REWRITE_TAC[SUBSET;IN]; REPEAT_N 4 STRIP_TAC; STRUCT_CASES_TAC (ISPEC `s:sign` SIGN_CASES) THEN REWRITE_TAC[interpsign] THEN MESON_TAC[]; ]);; (* }}} *) let INTERPSIGNS_SUBSET = prove_by_refinement( `!P Q ps ss. interpsigns ps P ss /\ Q SUBSET P ==> interpsigns ps Q ss`, (* {{{ Proof *) [ REWRITE_TAC[SUBSET;IN]; REPEAT_N 2 STRIP_TAC; LIST_INDUCT_TAC; LIST_INDUCT_TAC; REWRITE_TAC[ALL2;interpsigns;interpsign]; REWRITE_TAC[ALL2;interpsigns;interpsign]; LIST_INDUCT_TAC; REWRITE_TAC[ALL2;interpsigns;interpsign]; REWRITE_TAC[ALL2;interpsigns;interpsign]; (* save *) REPEAT STRIP_TAC; MATCH_MP_TAC INTERPSIGN_SUBSET; ASM_MESON_TAC[SUBSET;IN]; REWRITE_ASSUMS[ALL2;interpsigns;interpsign]; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let NOPOINT_LEM = prove_by_refinement( `!pl sl. interpsigns pl (\x. T) sl ==> (interpsigns pl (\x. x < &0) sl /\ interpsigns pl (\x. x = &0) sl /\ interpsigns pl (\x. &0 < x) sl)`, (* {{{ Proof *) [ REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERPSIGNS_SUBSET THEN ASM_MESON_TAC[SUBSET;IN] ]);; (* }}} *) hol-light/Rqe/defs.ml000066400000000000000000000226461303454263000147610ustar00rootroot00000000000000(* ====================================================================== *) (* Signs *) (* ====================================================================== *) (* ---------------------------------------------------------------------- *) (* Datatype *) (* ---------------------------------------------------------------------- *) let sign_INDUCT,sign_RECURSION = define_type "sign = Zero | Pos | Neg | Nonzero | Unknown";; let SIGN_CASES = prove_by_refinement( `!s. (s = Pos) \/ (s = Neg) \/ (s = Zero) \/ (s = Nonzero) \/ (s = Unknown)`, (* {{{ Proof *) [ MATCH_MP_TAC sign_INDUCT; REWRITE_TAC[]; ]);; (* }}} *) let szero_tm,spos_tm,sneg_tm,snonz_tm,sunk_tm = `Zero`,`Pos`,`Neg`,`Nonzero`,`Unknown`;; (* ------------------------------------------------------------------------- *) (* Intepretation of signs. *) (* ------------------------------------------------------------------------- *) (* An interpretation of the sign of a polynomial over a set. *) let interpsign = new_recursive_definition sign_RECURSION `(interpsign set ply Zero = (!x:real. set x ==> (ply x = &0))) /\ (interpsign set ply Pos = (!x. set x ==> (ply x > &0))) /\ (interpsign set ply Neg = (!x. set x ==> (ply x < &0))) /\ (interpsign set ply Nonzero = (!x. set x ==> (ply x <> &0))) /\ (interpsign set ply Unknown = (!x. set x ==> (ply x = ply x)))`;; let interpsign_tm = `interpsign`;; let dest_interpsign interpthm = let int,[set;poly;sign] = strip_ncomb 3 (concl interpthm) in if not (int = interpsign_tm) then failwith "not an interpsign" else set,poly,sign;; (* let k0 = prove_by_refinement( `interpsign (\x. x = &10) (\x. -- &10 + x * &1) Zero`,[ REWRITE_TAC[interpsign;poly]; REPEAT STRIP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC ]);; *) (* A version for one set but multiple polynomials *) let interpsigns = new_definition `interpsigns polyl set signl = ALL2 (interpsign set) polyl signl`;; let t0 = TAUT `a /\ T <=> a`;; let interpsigns_thms interpthm = let ret = map BETA_RULE( CONJUNCTS (PURE_REWRITE_RULE[interpsign;interpsigns;ALL2;t0] interpthm)) in ret;; (* keep interpsign *) let interpsigns_thms2 interpthm = CONJUNCTS (PURE_REWRITE_RULE[interpsigns;ALL2;t0] interpthm);; let interpsigns_tm = `interpsigns`;; let dest_interpsigns interpthm = let int,[polys;set;signs] = strip_ncomb 3 (concl interpthm) in if not (int = interpsigns_tm) then failwith "not an interpsigns" else polys,set,signs;; let interp_sing = prove( `interpsign set p s = interpsigns [p] set [s]`, REWRITE_TAC[interpsigns;ALL2]);; let interp_doub = prove( `interpsigns [p1] set [s1] ==> interpsigns pl set sl ==> interpsigns (CONS p1 pl) set (CONS s1 sl)`, ASM_MESON_TAC[interpsigns;ALL2]);; let mk_interpsigns thms = let thms' = map (PURE_REWRITE_RULE[interp_sing]) thms in end_itlist (fun t1 t2 -> MATCH_MPL [interp_doub;t1;t2]) thms';; (* let t0 = ASSUME `interpsign s1 p1 Zero`;; let t1 = ASSUME `interpsign s1 p2 Pos`;; let t2 = ASSUME `interpsign s1 p3 Neg`;; mk_interpsigns [t0;t1;t2];; map (PURE_REWRITE_RULE[interp_sing]) [t0;t1;t2];; *) (* let k0 = prove_by_refinement( `interpsigns [(\x. &1 + x * &1); (\x. &2 + x * &3)] (\x. x = (-- &1)) [Zero; Neg]`, [ REWRITE_TAC[interpsigns;ALL2;interpsign;poly]; REAL_ARITH_TAC ]);; *) (* ---------------------------------------------------------------------- *) (* Partition line *) (* ---------------------------------------------------------------------- *) let partition_line = new_recursive_definition list_RECURSION `(partition_line [] = [(\x. T)]) /\ (partition_line (CONS h t) = if t = [] then [(\x. x < h); (\x. x = h); (\x. h < x)] else APPEND [(\x. x < h); (\x. x = h); (\x. h < x /\ x < HD t)] (TL (partition_line t)))`;; (* let ex0 = prove( `partition_line [&1] = [(\x. x < &1); (\x. x = &1); (\x. &1 < x)]`, REWRITE_TAC[partition_line]) let ex1 = prove( `partition_line [&1; &2] = [(\x. x < &1); (\x. x = &1); (\x. &1 < x /\ x < &2); (\x. x = &2); (\x. &2 < x)]`, REWRITE_TAC[partition_line;APPEND;COND_CLAUSES;NOT_CONS_NIL;TL;HD]);; *) let make_partition_list = let lxt = `\x:real. T` and htm = `h:real` and h1tm = `h1:real` and h2tm = `h2:real` and x_lt_h = `(\x. x < h)` and x_eq_h = `(\x:real. x = h)` and h_lt_x = `(\x. h < x)` and x_lt_h1 = `(\x. x < h1)` and x_eq_h1 = `(\x:real. x = h1)` and x_h1_h2 = `(\x. h1 < x /\ x < h2)` in let rec make_partition_list ps = match ps with [] -> [lxt] | [h] -> map (subst [h,htm]) [x_lt_h; x_eq_h;h_lt_x] | h1::h2::t -> (map (subst [(h1,h1tm);(h2,h2tm)]) [x_lt_h1; x_eq_h1;x_h1_h2]) @ tl (make_partition_list (h2::t)) in make_partition_list;; (* make_partition_list [`&1`;`&2`] *) (* partition a line based on a list of points this is just a compact representation of a list of terms *) let part_line_tm = `partition_line`;; let real_bool_ty = `:real->bool`;; let PARTITION_LINE_CONV pts = let ptm = mk_comb (part_line_tm,pts) in let ltm = mk_list ((make_partition_list (dest_list pts)),real_bool_ty) in let tm = mk_eq (ptm,ltm) in prove(tm,REWRITE_TAC [partition_line;APPEND;COND_CLAUSES;NOT_CONS_NIL;TL;HD]);; (* PARTITION_LINE_CONV `[]:real list` PARTITION_LINE_CONV `[&1; &2]` PARTITION_LINE_CONV `[&2; &1]` PARTITION_LINE_CONV `[a:real; b]` *) (* an interpretation of a sign matrix arguments are a list of points, a list of polynomials, and a sign matrix the points form an ordered list (smallest first), each zero of each polynomial must appear among the list of points and finally, the sign matrix corresponds to the correct sign for the polynomial in the region represented by the set. *) let interpmat = new_definition `interpmat ptl polyl signll <=> real_ordered_list ptl /\ ALL2 (interpsigns polyl) (partition_line ptl) signll`;; let interpmat_tm = `interpmat`;; let dest_interpmat = let imat_tm = interpmat_tm in fun tm -> let sc,args = strip_comb tm in if not (sc = imat_tm) then failwith "dest_interpmat: not an interpmat term" else let [ptl;polyl;signll] = args in ptl,polyl,signll;; let interpmat_thms thm = let [rol_thm;interpsigns_thm] = CONJUNCTS (PURE_REWRITE_RULE[interpmat] thm) in rol_thm,interpsigns_thm;; let mk_interpmat_thm rol_thm = fun all_thm -> let ret = REWRITE_RULE[GSYM interpmat] (CONJ rol_thm all_thm) in let l,_ = strip_comb (concl ret) in if not (l = interpmat_tm) then failwith "mk_interpmat" else ret;; (* let rol_thm = rol_thm''' let all_thm = all_thm'' *) (* {{{ Doc *) (* mk_all2_interpsigns |- partition_line [x1; x2; x3; x4; x5] = [(\x. x < x1); (\x. x = x1); (\x. x1 < x /\ x < x2); (\x. x = x2); (\x. x2 < x /\ x < x3); (\x. x = x3); (\x. x3 < x /\ x < x4); (\x. x = x4); (\x. x4 < x /\ x < x5); (\x. x = x5); (\x. x5 < x)] [ |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x < x1) [Unknown; Pos; Pos; Pos] . . . . |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x = x5) [Pos; Pos; Zero; Zero] |- interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] (\x. x5 < x) [Unknown; Pos; Pos; Pos] ] --> |- ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) (partition_line [x1;x2;x3;x4;x5]) [[Unknown; Pos; Pos; Pos];...; [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]] *) (* }}} *) let all2_thm0 = GEN_ALL(EQT_ELIM(hd (CONJUNCTS ALL2)));; let all2_thm = GEN_ALL (REWRITE_RULE[AND_IMP_THM] (fst (EQ_IMP_RULE (GSYM (last (CONJUNCTS ALL2))))));; let mk_all2_interpsigns part_thm is_thms = let is_tm = fst(dest_comb(fst (dest_comb (concl (hd is_thms))))) in let all2_thm0' = ISPEC is_tm all2_thm0 in (* it`s having trouble matching *) let ret = itlist (fun x -> fun y -> MATCH_MPL[all2_thm;x;y]) is_thms all2_thm0' in REWRITE_RULE[GSYM part_thm] ret;; let dest_all2 tm = let a2,l = strip_comb tm in if fst(dest_const a2) = "ALL2" then let [a1;a2;a3] = l in a1,a2,a3 else failwith "dest_all2: not an ALL2";; (* ---------------------------------------------------------------------- *) (* Sets *) (* ---------------------------------------------------------------------- *) let is_interval set = try let x,bod = dest_abs set in if is_conj bod then let l,r = dest_conj bod in can (dest_binop rlt) l && can (dest_binop rlt) r else can (dest_binop rlt) bod with _ -> false;; (* is_interval `\x. &4 < x /\ x < &5`;; is_interval `\x. x = &4`;; *) let is_point set = try let x,bod = dest_abs set in if is_eq bod then true else false with _ -> false;; (* is_point `\x. x = &5` is_point `\x. x = y:real` *) (* ---------------------------------------------------------------------- *) (* We generate new var names *) (* ---------------------------------------------------------------------- *) let new_var,reset_vars = let id = ref 0 in let pre = "x_" in let new_var ty = id := !id + 1; mk_var (pre ^ (string_of_int !id),ty) in let reset_vars () = id := 0 in new_var,reset_vars;; hol-light/Rqe/examples.ml000066400000000000000000001151061303454263000156500ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Paper *) (* ---------------------------------------------------------------------- *) (* ---------------------------- Chebychev ----------------------------- *) time REAL_QELIM_CONV `!x. --(&1) <= x /\ x <= &1 ==> -- (&1) <= &2 * x pow 2 - &1 /\ &2 * x pow 2 - &1 <= &1`;; (* DATE ------- HOL -------- 5/20 4.92 5/22 4.67 *) time REAL_QELIM_CONV `!x. --(&1) <= x /\ x <= &1 ==> -- (&1) <= &4 * x pow 3 - &3 * x /\ &4 * x pow 3 - &3 * x <= &1`;; (* DATE ------- HOL -------- 5/20 14.38 5/22 13.65 *) time REAL_QELIM_CONV `&1 < &2 /\ (!x. &1 < x ==> &1 < x pow 2) /\ (!x y. &1 < x /\ &1 < y ==> &1 < x * (&1 + &2 * y))`;; (* DATE ------- HOL -------- 5/22 23.61 *) time REAL_QELIM_CONV `&0 <= b /\ &0 <= c /\ &0 < a * c ==> ?u. &0 < u /\ u * (u * c - a * c) - (u * a * c - (a pow 2 * c + b)) < a pow 2 * c + b`;; (* DATE ------- HOL -------- 5/22 8.78 *) (* ------------------------------------------------------------------------- *) (* Examples. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 0.01 let fm = `?x. x pow 4 + x pow 2 + &1 = &0`;; let vars = [] *) time REAL_QELIM_CONV `?x. x pow 4 + x pow 2 + &1 = &0`;; (* DATE ------- HOL -------- 4/29/2005 3.19 5/19 2.2 5/20 1.96 5/22 1.53 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 0.01 *) time REAL_QELIM_CONV `?x. x pow 3 - x pow 2 + x - &1 = &0`;; (* DATE ------- HOL -------- 4/29/2005 3.83 5/22/2005 1.69 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 0.23 *) time REAL_QELIM_CONV `?x y. (x pow 3 - x pow 2 + x - &1 = &0) /\ (y pow 3 - y pow 2 + y - &1 = &0) /\ ~(x = y)`;; (* DATE ------- HOL -------- Factor 4/29/2005 682.85 3000 5/17/2005 345.27 5/22 269 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < f < a * e) ==> f <= a * k>>;; 0.02 *) time REAL_QELIM_CONV `!a f k. (!e. k < e ==> f < a * e) ==> f <= a * k`;; (* DATE ------- HOL -------- Factor 4/29/2005 20.91 1000 5/15/2005 17.98 5/17/2005 15.12 5/18/2005 12.87 5/22 12.09 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 0.01 *) time REAL_QELIM_CONV `?x. a * x pow 2 + b * x + c = &0`;; (* DATE ------- HOL -------- Factor 4/29/2005 10.99 1000 5/17/2005 6.42 5/18 5.39 5/22 4.74 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < b^2 >= 4 * a * c>>;; 0.51 *) time REAL_QELIM_CONV `!a b c. (?x. a * x pow 2 + b * x + c = &0) <=> b pow 2 >= &4 * a * c`;; (* DATE ------- HOL -------- Factor 4/29/2005 1200.99 2400 5/17 878.25 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < a = 0 /\ (~(b = 0) \/ c = 0) \/ ~(a = 0) /\ b^2 >= 4 * a * c>>;; 0.51 *) time REAL_QELIM_CONV `!a b c. (?x. a * x pow 2 + b * x + c = &0) <=> (a = &0) /\ (~(b = &0) \/ (c = &0)) \/ ~(a = &0) /\ b pow 2 >= &4 * a * c`;; (* DATE ------- HOL -------- Factor 4/29/2005 1173.9 2400 5/17 848.4 5/20 816 1095 during depot update *) (* time real_qelim <> *) time REAL_QELIM_CONV `?x. &0 <= x /\ x <= &1 /\ (r pow 2 * x pow 2 - r * (&1 + r) * x + (&1 + r) = &0) /\ ~(&2 * r * x = &1 + r)`;; (* DATE ------- HOL -------- Factor 5/20/2005 19021 1460 4000 line output *) (* ------------------------------------------------------------------------- *) (* Termination ordering for group theory completion. *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* Left this out *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* This one works better using DNF. *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* And this *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* Linear examples. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0>>;; 0 *) time REAL_QELIM_CONV `?x. x - &1 > &0`;; (* DATE ------- HOL 4/29/2005 .56 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 /\ x - 1 > 0>>;; 0 *) time REAL_QELIM_CONV `?x. &3 - x > &0 /\ x - &1 > &0`;; (* DATE ------- HOL 4/29/2005 1.66 *) (* ------------------------------------------------------------------------- *) (* Quadratics. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 0 *) time REAL_QELIM_CONV `?x. x pow 2 = &0`;; (* DATE ------- HOL 4/29/2005 1.12 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 2 + &1 = &0`;; (* DATE ------- HOL 4/29/2005 1.11 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 2 - &1 = &0`;; (* DATE ------- HOL 4/29/2005 1.54 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 2 - &2 * x + &1 = &0`;; (* DATE ------- HOL 4/29/2005 1.21 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 2 - &3 * x + &1 = &0`;; (* DATE ------- HOL 4/29/2005 1.75 *) (* ------------------------------------------------------------------------- *) (* Cubics. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0>>;; *) time REAL_QELIM_CONV `?x. x pow 3 - &1 > &0`;; (* DATE ------- HOL 4/29/2005 1.96 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0>>;; *) time REAL_QELIM_CONV `?x. x pow 3 - &3 * x pow 2 + &3 * x - &1 > &0`;; (* DATE ------- HOL 4/29/2005 1.97 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0>>;; *) time REAL_QELIM_CONV `?x. x pow 3 - &4 * x pow 2 + &5 * x - &2 > &0`;; (* DATE ------- HOL 4/29/2005 4.89 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 3 - &6 * x pow 2 + &11 * x - &6 = &0`;; (* DATE ------- HOL 4/29/2005 4.17 *) (* ------------------------------------------------------------------------- *) (* Quartics. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0>>;; *) time REAL_QELIM_CONV `?x. x pow 4 - &1 > &0`;; (* DATE ------- HOL 4/29/2005 3.07 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0>>;; *) time REAL_QELIM_CONV `?x. x pow 4 + &1 > &0`;; (* DATE ------- HOL 4/29/2005 2.47 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 4 = &0`;; (* DATE ------- HOL 4/29/2005 2.48 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 4 - x pow 3 = &0`;; (* DATE ------- HOL 4/29/2005 1.76 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 4 - x pow 2 = &0`;; (* DATE ------- HOL 4/29/2005 2.16 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 4 - &2 * x pow 2 + &2 = &0`;; (* DATE ------- HOL 4/29/2005 6.87 5/16/2005 5.22 *) (* ------------------------------------------------------------------------- *) (* Quintics. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 0.03 print_timers() *) time REAL_QELIM_CONV `?x. x pow 5 - &15 * x pow 4 + &85 * x pow 3 - &225 * x pow 2 + &274 * x - &120 = &0`;; (* DATE ------- HOL -------- Factor 4/29/2005 65.64 2500 5/15/2005 55.93 5/16/2005 47.72 *) (* ------------------------------------------------------------------------- *) (* Sextics(?) *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 0.15 *) time REAL_QELIM_CONV `?x. x pow 6 - &21 * x pow 5 + &175 * x pow 4 - &735 * x pow 3 + &1624 * x pow 2 - &1764 * x + &720 = &0`;; `?x. x pow 5 - &15 * x pow 4 + &85 * x pow 3 - &225 * x pow 2 + &274 * x - &120 = &0`;; (* DATE ------- HOL -------- Factor 4/29/2005 1400.4 10000 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; 7.54 *) (* NOT YET *) (* time REAL_QELIM_CONV `?x. x pow 6 - &12 * x pow 5 + &56 * x pow 4 - &130 * x pow 3 + &159 * x pow 2 - &98 * x + &24 = &0`;; *) (* ------------------------------------------------------------------------- *) (* Multiple polynomials. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 /\ x^3 - 11 = 0 /\ x + 131 >= 0>>;; *) time REAL_QELIM_CONV `?x. x pow 2 + &2 > &0 /\ (x pow 3 - &11 = &0) /\ x + &131 >= &0`;; (* DATE ------- HOL 4/29/2005 13.1 *) (* ------------------------------------------------------------------------- *) (* With more variables. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. a * x pow 2 + b * x + c = &0`;; (* DATE ------- HOL 4/29/2005 10.94 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. a * x pow 3 + b * x pow 2 + c * x + d = &0`;; (* DATE ------- HOL 4/29/2005 269.17 *) (* ------------------------------------------------------------------------- *) (* Constraint solving. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0>>;; *) time REAL_QELIM_CONV `?x1 x2. x1 pow 2 + x2 pow 2 - u1 <= &0 /\ x1 pow 2 - u2 > &0`;; (* DATE ------- HOL 4/29/2005 89.97 *) (* ------------------------------------------------------------------------- *) (* Huet & Oppen (interpretation of group theory). *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 /\ y > 0 ==> x * (1 + 2 * y) > 0>>;; *) time REAL_QELIM_CONV `!x y. x > &0 /\ y > &0 ==> x * (&1 + &2 * y) > &0`;; (* DATE ------- HOL 4/29/2005 5.03 *) (* ------------------------------------------------------------------------- *) (* Other examples. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 2 - x + &1 = &0`;; (* DATE ------- HOL 4/29/2005 1.19 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 2 - &3 * x + &1 = &0`;; (* DATE ------- HOL 4/29/2005 1.65 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 6 /\ (x^2 - 3 * x + 1 = 0)>>;; *) time REAL_QELIM_CONV `?x. x > &6 /\ (x pow 2 - &3 * x + &1 = &0)`;; (* DATE ------- HOL 4/29/2005 3.63 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 /\ x^2 - 3 * x + 1 = 0>>;; *) time REAL_QELIM_CONV `?x. &7 * x pow 2 - &5 * x + &3 > &0 /\ (x pow 2 - &3 * x + &1 = &0)`;; (* DATE ------- HOL 4/29/2005 8.62 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 /\ x^2 - 8 * x + 1 = 0>>;; *) time REAL_QELIM_CONV `?x. (&11 * x pow 3 - &7 * x pow 2 - &2 * x + &1 = &0) /\ &7 * x pow 2 - &5 * x + &3 > &0 /\ (x pow 2 - &8 * x + &1 = &0)`;; (* DATE ------- HOL 4/29/2005 221.4 *) (* ------------------------------------------------------------------------- *) (* Quadratic inequality from Liska and Steinberg *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < C * (x - 1) * (4 * x * a * C - x * C - 4 * a * C + C - 2) >= 0>>;; *) time REAL_QELIM_CONV `!x. -- &1 <= x /\ x <= &1 ==> C * (x - &1) * (&4 * x * a * C - x * C - &4 * a * C + C - &2) >= &0`;; (* DATE ------- HOL 4/29/2005 1493 *) (* ------------------------------------------------------------------------- *) (* Metal-milling example from Loos and Weispfenning *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x y. &0 < x /\ y < &0 /\ (x * r - x * t + t = q * x - s * x + s) /\ (x * b - x * d + d = a * y - c * y + c)`;; (* ------------------------------------------------------------------------- *) (* Linear example from Collins and Johnson *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?r. &0 < r /\ r < &1 /\ &0 < (&1 - &3 * r) * (a pow 2 + b pow 2) + &2 * a * r /\ (&2 - &3 * r) * (a pow 2 + b pow 2) + &4 * a * r - &2 * a - r < &0`;; (* ------------------------------------------------------------------------- *) (* Dave Griffioen #4 *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 <= y>>;; *) time REAL_QELIM_CONV `!x y. (&1 - t) * x <= (&1 + t) * y /\ (&1 - t) * y <= (&1 + t) * x ==> &0 <= y`;; (* DATE ------- HOL 4/29/2005 893 *) (* ------------------------------------------------------------------------- *) (* Some examples from "Real Quantifier Elimination in practice". *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < u2>>;; *) time REAL_QELIM_CONV `?x2. x1 pow 2 + x2 pow 2 <= u1 /\ x1 pow 2 > u2`;; (* DATE ------- HOL 4/29/2005 4 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < u2>>;; *) time REAL_QELIM_CONV `?x1 x2. x1 pow 2 + x2 pow 2 <= u1 /\ x1 pow 2 > u2`;; (* DATE ------- HOL 4/29/2005 90 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <= 0 /\ x2 >= 0 ==> 3 * (x1 + 3 * x2^2 + 2) <= 8 * (2 * x1 + x2 + 1)>>;; *) time REAL_QELIM_CONV `!x1 x2. x1 + x2 <= &2 /\ x1 <= &1 /\ x1 >= &0 /\ x2 >= &0 ==> &3 * (x1 + &3 * x2 pow 2 + &2) <= &8 * (&2 * x1 + x2 + &1)`;; (* DATE ------- HOL 4/29/2005 18430 *) (* ------------------------------------------------------------------------- *) (* From Collins & Johnson's "Sign variation..." article. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 /\ (2 - 3 * r) * (a^2 + b^2) + 4 * a * r - 2 * a - r < 0>>;; *) time REAL_QELIM_CONV `?r. &0 < r /\ r < &1 /\ (&1 - &3 * r) * (a pow 2 + b pow 2) + &2 * a * r > &0 /\ (&2 - &3 * r) * (a pow 2 + b pow 2) + &4 * a * r - &2 * a - r < &0`;; (* DATE ------- HOL 4/29/2005 4595.11 *) (* ------------------------------------------------------------------------- *) (* From "Parallel implementation of CAD" article. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 1 /\ x * y >= 1>>;; *) time REAL_QELIM_CONV `?x. !y. x pow 2 + y pow 2 > &1 /\ x * y >= &1`;; (* DATE ------- HOL 4/29/2005 89.51 *) (* ------------------------------------------------------------------------- *) (* Other misc examples. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 2 * x * y <= 1>>;; *) time REAL_QELIM_CONV `!x y. (x pow 2 + y pow 2 = &1) ==> &2 * x * y <= &1`;; (* DATE ------- HOL 4/29/2005 83.02 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 2 * x * y < 1>>;; *) time REAL_QELIM_CONV `!x y. (x pow 2 + y pow 2 = &1) ==> &2 * x * y < &1`;; (* DATE ------- HOL 4/29/2005 83.7 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 <=> x > 0 /\ y > 0 \/ x < 0 /\ y < 0>>;; *) time REAL_QELIM_CONV `!x y. x * y > &0 <=> x > &0 /\ y > &0 \/ x < &0 /\ y < &0`;; (* DATE ------- HOL 4/29/2005 27.4 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < y /\ x^2 < y^2>>;; *) time REAL_QELIM_CONV `?x y. x > y /\ x pow 2 < y pow 2`;; (* DATE ------- HOL 4/29/2005 1.19 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < exists z. x < z /\ z < y>>;; *) time REAL_QELIM_CONV `!x y. x < y ==> ?z. x < z /\ z < y`;; (* DATE ------- HOL 4/29/2005 3.8 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < exists y. x * y^2 = 1>>;; *) time REAL_QELIM_CONV `!x. &0 < x <=> ?y. x * y pow 2 = &1`;; (* DATE ------- HOL 4/29/2005 3.76 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < exists y. x * y^2 = 1>>;; *) time REAL_QELIM_CONV `!x. &0 <= x <=> ?y. x * y pow 2 = &1`;; (* DATE ------- HOL 4/29/2005 4.38 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < exists y. x = y^2>>;; *) time REAL_QELIM_CONV `!x. &0 <= x <=> ?y. x = y pow 2`;; (* DATE ------- HOL 4/29/2005 4.38 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < exists z. x < z^2 /\ z^2 < y>>;; *) time REAL_QELIM_CONV `!x y. &0 < x /\ x < y ==> ?z. x < z pow 2 /\ z pow 2 < y`;; (* DATE ------- HOL 4/29/2005 93.1 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < exists z. x < z^2 /\ z^2 < y>>;; *) time REAL_QELIM_CONV `!x y. x < y ==> ?z. x < z pow 2 /\ z pow 2 < y`;; (* DATE ------- HOL 4/29/2005 93.22 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < x = 0 /\ y = 0>>;; *) time REAL_QELIM_CONV `!x y. (x pow 2 + y pow 2 = &0) ==> (x = &0) /\ (y = &0)`;; (* DATE ------- HOL 4/29/2005 17.21 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < x = 0 /\ y = 0 /\ z = 0>>;; *) time REAL_QELIM_CONV `!x y z. (x pow 2 + y pow 2 + z pow 2 = &0) ==> (x = &0) /\ (y = &0) /\ (z = &0)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < w = 0 /\ x = 0 /\ y = 0 /\ z = 0>>;; *) time REAL_QELIM_CONV `!w x y z. (w pow 2 + x pow 2 + y pow 2 + z pow 2 = &0) ==> (w = &0) /\ (x = &0) /\ (y = &0) /\ (z = &0)`;; (* DATE ------- HOL 4/29/2005 596 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < forall x. ~(x^2 + a*x + 1 = 0)>>;; *) time REAL_QELIM_CONV `!a. (a pow 2 = &2) ==> !x. ~(x pow 2 + a*x + &1 = &0)`;; (* DATE ------- HOL 4/29/2005 8.7 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < forall x. ~(x^2 - a*x + 1 = 0)>>;; *) time REAL_QELIM_CONV `!a. (a pow 2 = &2) ==> !x. ~(x pow 2 - a*x + &1 = &0)`;; (* DATE ------- HOL 4/29/2005 8.82 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < (x * y)^2 = 6>>;; *) time REAL_QELIM_CONV `!x y. (x pow 2 = &2) /\ (y pow 2 = &3) ==> ((x * y) pow 2 = &6)`;; (* DATE ------- HOL 4/29/2005 48.59 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!x. ?y. x pow 2 = y pow 3`;; (* DATE ------- HOL 4/29/2005 6.93 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!x. ?y. x pow 3 = y pow 2`;; (* DATE ------- HOL 4/29/2005 5.76 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < (a * (x + y) + b = 0)>>;; *) time REAL_QELIM_CONV `!a b c. (a * x pow 2 + b * x + c = &0) /\ (a * y pow 2 + b * y + c = &0) /\ ~(x = y) ==> (a * (x + y) + b = &0)`;; (* DATE ------- HOL 4/29/2005 76.5 *) (* --------------------------------- --------------------------------- *) (* time real_qelim < (y_1^2 = y_2^2)>>;; *) time REAL_QELIM_CONV `!y_1 y_2 y_3 y_4. (y_1 = &2 * y_3) /\ (y_2 = &2 * y_4) /\ (y_1 * y_3 = y_2 * y_4) ==> (y_1 pow 2 = y_2 pow 2)`;; (* time real_qelim < x^4 < 1>>;; *) (* DATE ------- HOL 4/29/2005 1327 *) (* ------------------------------------------------------------------------- *) (* Counting roots. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 3 - x pow 2 + x - &1 = &0`;; (* DATE ------- HOL 4/29/2005 3.8 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x y. (x pow 3 - x pow 2 + x - &1 = &0) /\ (y pow 3 - y pow 2 + y - &1 = &0) /\ ~(x = y)`;; (* DATE ------- HOL 4/29/2005 670 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x. x pow 4 + x pow 2 - &2 = &0`;; (* DATE ------- HOL 4/29/2005 4.9 *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x y. x pow 4 + x pow 2 - &2 = &0 /\ y pow 4 + y pow 2 - &2 = &0 /\ ~(x = y)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x y. (x pow 3 + x pow 2 - x - &1 = &0) /\ (y pow 3 + y pow 2 - y - &1 = &0) /\ ~(x = y)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?x y z. (x pow 3 + x pow 2 - x - &1 = &0) /\ (y pow 3 + y pow 2 - y - &1 = &0) /\ (z pow 3 + z pow 2 - z - &1 = &0) /\ ~(x = y) /\ ~(x = z)`;; (* ------------------------------------------------------------------------- *) (* Existence of tangents, so to speak. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!x y. ?s c. (s pow 2 + c pow 2 = &1) /\ s * x + c * y = &0`;; (* ------------------------------------------------------------------------- *) (* Another useful thing (componentwise ==> normwise accuracy etc.) *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!x y. (x + y) pow 2 <= &2 * (x pow 2 + y pow 2)`;; (* ------------------------------------------------------------------------- *) (* Some related quantifier elimination problems. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!x y. (x + y) pow 2 <= c * (x pow 2 + y pow 2)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < 2 <= c>>;; *) time REAL_QELIM_CONV `!c. (!x y. (x + y) pow 2 <= c * (x pow 2 + y pow 2)) <=> &2 <= c`;; (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!a b. a * b * c <= a pow 2 + b pow 2`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < c^2 <= 4>>;; *) time REAL_QELIM_CONV `!c. (!a b. a * b * c <= a pow 2 + b pow 2) <=> c pow 2 <= &4`;; (* ------------------------------------------------------------------------- *) (* Tedious lemmas I once proved manually in HOL. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 < a * b /\ 0 < a * c /\ 0 < b * c>>;; *) time REAL_QELIM_CONV `!a b c. &0 < a /\ &0 < b /\ &0 < c ==> &0 < a * b /\ &0 < a * c /\ &0 < b * c`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 ==> (c * a < 0 <=> c * b < 0)>>;; *) time REAL_QELIM_CONV `!a b c. a * b > &0 ==> (c * a < &0 <=> c * b < &0)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < 0 ==> (a * c < 0 <=> b * c < 0)>>;; *) time REAL_QELIM_CONV `!a b c. a * b > &0 ==> (a * c < &0 <=> b * c < &0)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < (a * b > 0 <=> b < 0)>>;; *) time REAL_QELIM_CONV `!a b. a < &0 ==> (a * b > &0 <=> b < &0)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < (c * a < 0 <=> ~(c * b < 0))>>;; *) time REAL_QELIM_CONV `!a b c. a * b < &0 /\ ~(c = &0) ==> (c * a < &0 <=> ~(c * b < &0))`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < a > 0 /\ b < 0 \/ a < 0 /\ b > 0>>;; *) time REAL_QELIM_CONV `!a b. a * b < &0 <=> a > &0 /\ b < &0 \/ a < &0 /\ b > &0`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < a >= 0 /\ b <= 0 \/ a <= 0 /\ b >= 0>>;; *) time REAL_QELIM_CONV `!a b. a * b <= &0 <=> a >= &0 /\ b <= &0 \/ a <= &0 /\ b >= &0`;; (* ------------------------------------------------------------------------- *) (* Vaguely connected with reductions for Robinson arithmetic. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < forall d. d <= b ==> d < a>>;; *) time REAL_QELIM_CONV `!a b. ~(a <= b) <=> !d. d <= b ==> d < a`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < forall d. d <= b ==> ~(d = a)>>;; *) time REAL_QELIM_CONV `!a b. ~(a <= b) <=> !d. d <= b ==> ~(d = a)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < forall d. d < b ==> d < a>>;; *) time REAL_QELIM_CONV `!a b. ~(a < b) <=> !d. d < b ==> d < a`;; (* ------------------------------------------------------------------------- *) (* Another nice problem. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim < (x + y)^2 <= 2>>;; *) time REAL_QELIM_CONV `!x y. (x pow 2 + y pow 2 = &1) ==> (x + y) pow 2 <= &2`;; (* ------------------------------------------------------------------------- *) (* Some variants / intermediate steps in Cauchy-Schwartz inequality. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!x y. &2 * x * y <= x pow 2 + y pow 2`;; (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!a b c d. &2 * a * b * c * d <= a pow 2 * b pow 2 + c pow 2 * d pow 2`;; (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `!x1 x2 y1 y2. (x1 * y1 + x2 * y2) pow 2 <= (x1 pow 2 + x2 pow 2) * (y1 pow 2 + y2 pow 2)`;; (* ------------------------------------------------------------------------- *) (* The determinant example works OK here too. *) (* ------------------------------------------------------------------------- *) (* --------------------------------- --------------------------------- *) (* time real_qelim <>;; *) time REAL_QELIM_CONV `?w x y z. (a * w + b * y = &1) /\ (a * x + b * z = &0) /\ (c * w + d * y = &0) /\ (c * x + d * z = &1)`;; (* --------------------------------- --------------------------------- *) (* time real_qelim < ~(a * d = b * c)>>;; *) time REAL_QELIM_CONV `!a b c d. (?w x y z. (a * w + b * y = &1) /\ (a * x + b * z = &0) /\ (c * w + d * y = &0) /\ (c * x + d * z = &1)) <=> ~(a * d = b * c)`;; (* ------------------------------------------------------------------------- *) (* From applying SOLOVAY_VECTOR_TAC. *) (* ------------------------------------------------------------------------- *) let th = prove (`&0 <= c' /\ &0 <= c /\ &0 < h * c' ==> (?u. &0 < u /\ (!v. &0 < v /\ v <= u ==> v * (v * (h * h * c' + c) - h * c') - (v * h * c' - c') < c'))`, W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN CONV_TAC REAL_QELIM_CONV);; (* ------------------------------------------------------------------------- *) (* Two notions of parallelism. *) (* ------------------------------------------------------------------------- *) time REAL_QELIM_CONV `!x1 x2 y1 y2. (?c. (x2 = c * x1) /\ (y2 = c * y1)) <=> (x1 = &0 /\ y1 = &0 ==> x2 = &0 /\ y2 = &0) /\ x1 * y2 = x2 * y1`;; (* ------------------------------------------------------------------------- *) (* From Behzad Akbarpour (takes about 300 seconds). *) (* ------------------------------------------------------------------------- *) time REAL_QELIM_CONV `!x. &0 <= x /\ x <= &1 ==> &0 < &1 - x + x pow 2 / &2 - x pow 3 / &6 /\ &1 <= (&1 + x + x pow 2) * (&1 - x + x pow 2 / &2 - x pow 3 / &6)`;; (* ------------------------------------------------------------------------- *) (* A natural simplification of "limit of a product" result. *) (* Takes about 450 seconds. *) (* ------------------------------------------------------------------------- *) (*** Would actually like to get rid of abs internally and state it like this: time REAL_QELIM_CONV `!x y e. &0 < e ==> ?d. &0 < d /\ abs((x + d) * (y + d) - x * y) < e`;; ****) time REAL_QELIM_CONV `!x y e. &0 < e ==> ?d. &0 < d /\ (x + d) * (y + d) - x * y < e /\ x * y - (x + d) * (y + d) < e`;; hol-light/Rqe/inferisign.ml000066400000000000000000000214611303454263000161670ustar00rootroot00000000000000exception Isign of (thm * ((term * thm) list));; (* ---------------------------------------------------------------------- *) (* Opt *) (* ---------------------------------------------------------------------- *) let get_mp = let unknown = `Unknown` in let pos = `Pos` in let zero = `Zero` in let neg = `Neg` in fun upper_sign lower_sign deriv_sign -> (* Pos Pos *) if upper_sign = pos && lower_sign = pos && deriv_sign = pos then INFERISIGN_POS_POS_POS else if upper_sign = pos && lower_sign = pos && deriv_sign = neg then INFERISIGN_POS_POS_NEG (* Pos Neg *) else if upper_sign = pos && lower_sign = neg && deriv_sign = pos then INFERISIGN_POS_NEG_POS else if upper_sign = pos && lower_sign = neg && deriv_sign = neg then INFERISIGN_POS_NEG_NEG (* Pos Zero *) else if upper_sign = pos && lower_sign = zero && deriv_sign = pos then INFERISIGN_POS_ZERO_POS else if upper_sign = pos && lower_sign = zero && deriv_sign = neg then INFERISIGN_POS_ZERO_NEG (* Neg Pos *) else if upper_sign = neg && lower_sign = pos && deriv_sign = pos then INFERISIGN_NEG_POS_POS else if upper_sign = neg && lower_sign = pos && deriv_sign = neg then INFERISIGN_NEG_POS_NEG (* Neg Neg *) else if upper_sign = neg && lower_sign = neg && deriv_sign = pos then INFERISIGN_NEG_NEG_POS else if upper_sign = neg && lower_sign = neg && deriv_sign = neg then INFERISIGN_NEG_NEG_NEG (* Neg Zero *) else if upper_sign = neg && lower_sign = zero && deriv_sign = pos then INFERISIGN_NEG_ZERO_POS else if upper_sign = neg && lower_sign = zero && deriv_sign = neg then INFERISIGN_NEG_ZERO_NEG (* Zero Pos *) else if upper_sign = zero && lower_sign = pos && deriv_sign = pos then INFERISIGN_ZERO_POS_POS else if upper_sign = zero && lower_sign = pos && deriv_sign = neg then INFERISIGN_ZERO_POS_NEG (* Zero Neg *) else if upper_sign = zero && lower_sign = neg && deriv_sign = pos then INFERISIGN_ZERO_NEG_POS else if upper_sign = zero && lower_sign = neg && deriv_sign = neg then INFERISIGN_ZERO_NEG_NEG (* Zero Zero *) else if upper_sign = zero && lower_sign = zero && deriv_sign = pos then INFERISIGN_ZERO_ZERO_POS else if upper_sign = zero && lower_sign = zero && deriv_sign = neg then INFERISIGN_ZERO_ZERO_NEG else failwith "bad signs in thm";; let tvars,tdiff,tmat,tex = ref [],ref TRUTH,ref TRUTH,ref [];; (* let vars,diff_thm,mat_thm,ex_thms = !tvars,!tdiff,!tmat,!tex INFERISIGN vars diff_thm mat_thm ex_thms let vars,diff_thm,mat_thm,ex_thms = vars, pdiff_thm, mat_thm''', ((v1,exthm1)::(v2,exthm2)::ex_thms) *) let rec INFERISIGN = let real_app = `APPEND:real list -> real list -> real list` in let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in let real_len = `LENGTH:real list -> num` in let sign_len = `LENGTH:(sign list) list -> num` in let unknown = `Unknown` in let pos = `Pos` in let zero = `Zero` in let neg = `Neg` in let num_mul = `( * ):num -> num -> num` in let num_add = `( + ):num -> num -> num` in let real_ty = `:real` in let one = `1` in let two = `2` in let f = `F` in let imat = `interpmat` in let sl_ty = `:sign list` in fun vars diff_thm mat_thm ex_thms -> try tvars := vars; tdiff := diff_thm; tmat := mat_thm; tex := ex_thms; let pts,ps,sgns = dest_interpmat (concl mat_thm) in let pts' = dest_list pts in if pts' = [] then mat_thm,ex_thms else let sgns' = dest_list sgns in let sgnl = map dest_list sgns' in let i = get_index (fun x -> hd x = unknown) sgnl in if i mod 2 = 1 then failwith "bad shifted matrix" else let p::p'::_ = dest_list ps in let p_thm = ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p))) in let p'_thm = ONCE_REWRITE_RULE[GSYM diff_thm] (ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p')))) in let pts1,qts1 = chop_list (i / 2 - 1) pts' in let ps_thm = REWRITE_CONV[p_thm;p'_thm] ps in let pts2 = mk_list(pts1,real_ty) in let pts3 = mk_comb(mk_comb(real_app,pts2),mk_list(qts1,real_ty)) in let pts_thm = prove(mk_eq(pts,pts3),REWRITE_TAC[APPEND]) in let sgns1,rgns1 = chop_list (i - 1) sgns' in let sgns2 = mk_list(sgns1,sl_ty) in let sgns3 = mk_comb(mk_comb(sign_app,sgns2),mk_list(rgns1,sl_ty)) in let sgns_thm = prove(mk_eq(sgns,sgns3),REWRITE_TAC[APPEND]) in let len1 = mk_comb(sign_len,sgns2) in let len2 = mk_binop num_add (mk_binop num_mul two (mk_comb(real_len,pts2))) one in let len_thm = prove(mk_eq(len1,len2),REWRITE_TAC[LENGTH] THEN ARITH_TAC) in let mat_thm1 = MK_COMB(MK_COMB((AP_TERM imat pts_thm), ps_thm),sgns_thm) in let mat_thm2 = EQ_MP mat_thm1 mat_thm in let upper_sign = hd (ith (i - 1) sgnl) in let lower_sign = hd (ith (i + 1) sgnl) in let deriv_sign = hd (tl (ith i sgnl)) in let mp_thm = get_mp upper_sign lower_sign deriv_sign in let mat_thm3 = MATCH_MP (MATCH_MP mp_thm mat_thm2) len_thm in let mat_thm4 = REWRITE_RULE[GSYM p_thm;GSYM p'_thm;APPEND] mat_thm3 in let c = concl mat_thm4 in if c = f then raise (Isign (mat_thm4,ex_thms)) else if not (is_exists c) then INFERISIGN vars diff_thm mat_thm4 ex_thms else let x,bod = dest_exists c in let x' = new_var real_ty in let assume_thm = ASSUME (subst [x',x] bod) in INFERISIGN vars diff_thm assume_thm ((x',mat_thm4)::ex_thms) with Failure "get_index" -> mat_thm,ex_thms | Failure x -> failwith ("INFERISIGN: " ^ x);; (* let vars,diff_thm,mat_thm,ex_thms = vars,pdiff_thm, mat_thm''',[] let mat_thm = ASSUME ` interpmat [x_25; x1; x2; x4; x5; x_26] [\x. &1 + x * (&1 + x * (&1 + x * &1)); \x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1)] [[Neg; Pos; Pos; Pos]; [Neg; Pos; Pos; Pos]; [Unknown; Pos; Pos; Pos]; [Pos; Pos; Pos; Zero]; [Unknown; Neg; Pos; Neg]; [Unknown; Neg; Neg; Neg]; [Unknown; Neg; Pos; Neg]; [Pos; Zero; Zero; Neg]; [Unknown; Pos; Neg; Neg]; [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos]]` *) (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let INFERISIGN vars diff_thm mat_thm ex_thms = let start_time = Sys.time() in let res = INFERISIGN vars diff_thm mat_thm ex_thms in inferisign_timer +.= (Sys.time() -. start_time); res;; (* {{{ Examples *) (* let is_thms = isigns_thms''' let vars,diff_thm,mat_thm = [`w:real`; `z:real`; `y:real`; `x:real`], ASSUME `poly_diff [&0 + y * (&0 + x * &1); &0 + z * -- &1] = [&0 + z * -- &1]`, ASSUME `interpmat [x_178; x_179] [\w. (&0 + y * (&0 + x * &1)) + w * (&0 + z * -- &1); \w. &0 + z * -- &1] [[Pos; Neg]; [Pos; Neg]; [Unknown; Neg]; [Neg; Neg]; [Neg; Neg]]` INFERISIGN vars pdiff_thm mat_thm let diff let vars,diff_thm,mat_thm = let vars,diff_thm,mat_thm = [`x:real`], ASSUME `poly_diff [&0; &2; &0; &4] = [&2; &0; &12]`, ASSUME `interpmat [x_79; x_68; x_80] [\x. &0 + x * (&2 + x * (&0 + x * &4)); \x. &2 + x * (&0 + x * &12); \x. &4 + x * (&0 + x * &2)] [[Neg; Pos; Pos]; [Neg; Pos; Pos]; [Unknown; Pos; Pos]; [Unknown; Pos; Pos]; [Unknown; Pos; Pos]; [Pos; Pos; Pos]; [Pos; Pos; Pos]]` let mat_thm = mat_thm''' let diff_thm = pdiff_thm INFERISIGN vars pdiff_thm mat_thm''' let diff_thm = POLY_DIFF_CONV `poly_diff [&1; &1; &1; &1]`;; let vars = [`x:real`] let mat_thm = ASSUME `interpmat [xminf; x1; x4; x5; xinf] [\x. &1 + x * (&1 + x * (&1 + x * &1)); \x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1)] [[Neg; Pos; Pos; Pos]; [Neg; Pos; Pos; Pos]; [Unknown; Pos; Pos; Pos]; [Neg; Pos; Pos; Zero]; [Unknown; Pos; Pos; Neg]; [Pos; Pos; Zero; Neg]; [Unknown; Pos; Neg; Neg]; [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos]]`;; let mat_thm1,_ = INFERISIGN vars diff_thm mat_thm [] *) (* }}} *) hol-light/Rqe/inferisign_thms.ml000066400000000000000000000662151303454263000172300ustar00rootroot00000000000000let inferisign_lem00 = prove_by_refinement( `x1 < x3 ==> x3 < x2 ==> (!x. x1 < x /\ x < x2 ==> P x) ==> (!x. x1 < x /\ x < x3 ==> P x) /\ (!x. (x = x3) ==> P x) /\ (!x. x3 < x /\ x < x2 ==> P x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x3`; ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x3`; ASM_REWRITE_TAC[]; ]);; (* }}} *) let neg_neg_neq_thm = prove_by_refinement( `!x y p. x < y /\ poly p x < &0 /\ poly p y < &0 /\ (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `&0 < poly p z - poly p x`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; USE_THEN "Z-8" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < (z - x) * poly (poly_diff p) x'`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p y - poly p z < &0`; LABEL_ALL_TAC; USE_THEN "Z-13" MP_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - z`; LABEL_ALL_TAC; USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(y - z) * poly (poly_diff p) x'' < &0`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `x < x''' /\ x''' < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x'`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let neg_neg_neq_thm2 = prove_by_refinement( `!x y p. x < y ==> poly p x < &0 ==> poly p y < &0 ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ REPEAT_N 7 STRIP_TAC; MATCH_MP_TAC neg_neg_neq_thm; ASM_MESON_TAC[]; ]);; (* }}} *) let pos_pos_neq_thm = prove_by_refinement( `!x y p. x < y /\ &0 < poly p x /\ &0 < poly p y /\ (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> &0 < poly p z)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p z - poly p x < &0`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; USE_THEN "Z-8" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `(z - x) * poly (poly_diff p) x' < &0`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `&0 < poly p y - poly p z`; LABEL_ALL_TAC; USE_THEN "Z-13" MP_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - z`; LABEL_ALL_TAC; USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < (y - z) * poly (poly_diff p) x''`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `x < x''' /\ x''' < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x'`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let pos_pos_neq_thm2 = prove_by_refinement( `!x y p. x < y ==> poly p x > &0 ==> poly p y > &0 ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) [ REWRITE_TAC[real_gt]; REPEAT_N 7 STRIP_TAC; MATCH_MP_TAC pos_pos_neq_thm; ASM_MESON_TAC[]; ]);; (* }}} *) let pos_neg_neq_thm = prove_by_refinement( `!x y p. x < y /\ &0 < poly p x /\ poly p y < &0 /\ (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> ?X. x < X /\ X < y /\ (poly p X = &0) /\ (!z. x < z /\ z < X ==> &0 < poly p z) /\ (!z. X < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`y:real`] POLY_IVT_NEG); REWRITE_TAC[real_gt]; ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `X:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; STRIP_TAC; REPEAT STRIP_TAC; (* save *) ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `N:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `poly p z - poly p x < &0`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; USE_THEN "Z-11" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `(z - x) * poly (poly_diff p) N < &0`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 < &0 - poly p z`; LABEL_ALL_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < X - z`; LABEL_ALL_TAC; USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < (X - z) * poly (poly_diff p) M`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; CLAIM `N < M`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `N`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `M`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) POP_ASSUM (ASSUME_TAC o GSYM); MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; REAL_SIMP_TAC; ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; ASM_REWRITE_TAC[REAL_ENTIRE]; DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; LABEL_ALL_TAC; POP_ASSUM MP_TAC; USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; CLAIM `x < M /\ M < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) REPEAT STRIP_TAC; ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `N:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; POP_ASSUM MP_TAC; REAL_SIMP_TAC; STRIP_TAC; CLAIM `&0 < (z - X) * poly (poly_diff p) N`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; CLAIM `&0 < z - X`; LABEL_ALL_TAC; USE_THEN "Z-7" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); LABEL_ALL_TAC; USE_THEN "Z-6" (REWRITE_TAC o list); DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `poly p y - poly p z < &0`; LABEL_ALL_TAC; USE_THEN "Z-12" MP_TAC; USE_THEN "Z-5" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - z`; LABEL_ALL_TAC; USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(y - z) * poly (poly_diff p) M < &0`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; CLAIM `N < M`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `N`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `M`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; REAL_SIMP_TAC; ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; ASM_REWRITE_TAC[REAL_ENTIRE]; DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; LABEL_ALL_TAC; POP_ASSUM MP_TAC; USE_THEN "Z-5" MP_TAC THEN REAL_ARITH_TAC; CLAIM `x < M /\ M < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let pos_neg_neq_thm2 = prove_by_refinement( `!x y p. x < y ==> poly p x > &0 ==> poly p y < &0 ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> ?X. x < X /\ X < y /\ (!z. (z = X) ==> (poly p z = &0)) /\ (!z. x < z /\ z < X ==> poly p z > &0) /\ (!z. X < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ REWRITE_TAC[real_gt]; REPEAT STRIP_TAC; MP_TAC (ISPECL[`x:real`;`y:real`;`p:real list`] pos_neg_neq_thm); ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; EXISTS_TAC `X`; ASM_MESON_TAC[]; ]);; (* }}} *) let neg_pos_neq_thm = prove_by_refinement( `!x y p. x < y /\ poly p x < &0 /\ &0 < poly p y /\ (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> ?X. x < X /\ X < y /\ (poly p X = &0) /\ (!z. x < z /\ z < X ==> poly p z < &0) /\ (!z. X < z /\ z < y ==> &0 < poly p z)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`y:real`] POLY_IVT_POS); REWRITE_TAC[real_gt]; ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `X:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; STRIP_TAC; REPEAT STRIP_TAC; (* save *) ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `N:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 < poly p z - poly p x`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; USE_THEN "Z-11" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < (z - x) * poly (poly_diff p) N`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 - poly p z < &0`; LABEL_ALL_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < X - z`; LABEL_ALL_TAC; USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(X - z) * poly (poly_diff p) M < &0`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; CLAIM `N < M`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `N`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `M`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); ASM_REWRITE_TAC[]; REAL_SIMP_TAC; ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; ASM_REWRITE_TAC[REAL_ENTIRE]; DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; LABEL_ALL_TAC; POP_ASSUM MP_TAC; USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; CLAIM `x < M /\ M < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) REPEAT STRIP_TAC; ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `N:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; POP_ASSUM MP_TAC; REAL_SIMP_TAC; STRIP_TAC; CLAIM `(z - X) * poly (poly_diff p) N < &0`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; CLAIM `&0 < z - X`; LABEL_ALL_TAC; USE_THEN "Z-7" MP_TAC THEN REAL_ARITH_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); LABEL_ALL_TAC; USE_THEN "Z-6" (REWRITE_TAC o list); DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `&0 < poly p y - poly p z`; LABEL_ALL_TAC; USE_THEN "Z-12" MP_TAC; USE_THEN "Z-5" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - z`; LABEL_ALL_TAC; USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < (y - z) * poly (poly_diff p) M`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; CLAIM `N < M`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); ASM_REWRITE_TAC[]; DISCH_THEN (X_CHOOSE_TAC `K:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; (* save *) CLAIM `x < K /\ K < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `N`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `M`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) POP_ASSUM (ASSUME_TAC o GSYM); MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; REAL_SIMP_TAC; ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; ASM_REWRITE_TAC[REAL_ENTIRE]; DISCH_THEN (X_CHOOSE_TAC `M:real`); POP_ASSUM MP_TAC THEN STRIP_TAC; LABEL_ALL_TAC; POP_ASSUM MP_TAC; USE_THEN "Z-5" MP_TAC THEN REAL_ARITH_TAC; CLAIM `x < M /\ M < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `X`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let neg_pos_neq_thm2 = prove_by_refinement( `!x y p. x < y ==> poly p x < &0 ==> poly p y > &0 ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> ?X. x < X /\ X < y /\ (!z. (z = X) ==> (poly p z = &0)) /\ (!z. x < z /\ z < X ==> poly p z < &0) /\ (!z. X < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) [ REWRITE_TAC[real_gt]; REPEAT STRIP_TAC; MP_TAC (ISPECL[`x:real`;`y:real`;`p:real list`] neg_pos_neq_thm); ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; EXISTS_TAC `X`; ASM_MESON_TAC[]; ]);; (* }}} *) let lt_nz_thm = prove_by_refinement( `(!x. x1 < x /\ x < x2 ==> poly p x < &0) ==> (!x. x1 < x /\ x < x2 ==> ~(poly p x = &0))`, (* {{{ Proof *) [ MESON_TAC[REAL_LT_NZ]; ]);; (* }}} *) let gt_nz_thm = prove_by_refinement( `(!x. x1 < x /\ x < x2 ==> poly p x > &0) ==> (!x. x1 < x /\ x < x2 ==> ~(poly p x = &0))`, (* {{{ Proof *) [ MESON_TAC[REAL_LT_NZ;real_gt]; ]);; (* }}} *) let eq_eq_false_thm = prove_by_refinement( `!x y p. x < y ==> (poly p x = &0) ==> (poly p y = &0) ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> F`, (* {{{ Proof *) [ REPEAT_N 3 STRIP_TAC; DISCH_THEN (fun x -> MP_TAC (MATCH_MP (ISPEC `p:real list` POLY_MVT) x) THEN ASSUME_TAC x); REPEAT STRIP_TAC; LABEL_ALL_TAC; CLAIM `poly p y - poly p x = &0`; REWRITE_TAC[real_sub]; ASM_REWRITE_TAC[]; REAL_ARITH_TAC; DISCH_THEN (REWRITE_ASSUMS o list); CLAIM `&0 < y - x`; USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; POP_ASSUM (MP_TAC o ISPEC `x':real`); RULE_ASSUM_TAC GSYM; POP_ASSUM IGNORE THEN POP_ASSUM IGNORE; ASM_REWRITE_TAC[]; STRIP_TAC; STRIP_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_POS_NZ]; ]);; (* }}} *) let neg_zero_neg_thm = prove_by_refinement( `!x y p. x < y ==> poly p x < &0 ==> (poly p y = &0) ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; REWRITE_TAC[ARITH_RULE `x <= y <=> (x < y \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p z - poly p x > &0`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; USE_THEN "Z-8" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `(z - x) * poly (poly_diff p) x' > &0`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; REWRITE_TAC[real_gt]; ASM_REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(z - x) * poly (poly_diff p) x' < &0`; REWRITE_TAC[REAL_MUL_LT]; DISJ2_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_ANTISYM]; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `&0 - poly p z < &0`; LABEL_ALL_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - z`; LABEL_ALL_TAC; USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(y - z) * poly (poly_diff p) x'' < &0`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* save *) CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); REWRITE_ASSUMS[real_gt]; ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `x < x''' /\ x''' < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x'`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) MP_TAC (ISPECL[`z:real`;`y:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; REPEAT_N 2 STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; ]);; (* }}} *) let pos_zero_pos_thm = prove_by_refinement( `!x y p. x < y ==> poly p x > &0 ==> (poly p y = &0) ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[ARITH_RULE `x > y <=> ~(y >= x)`]; REWRITE_TAC[ARITH_RULE `x >= y <=> (x > y \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p z - poly p x < &0`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; USE_THEN "Z-8" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `(z - x) * poly (poly_diff p) x' < &0`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; REWRITE_TAC[real_gt]; ASM_REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < (z - x) * poly (poly_diff p) x'`; REWRITE_TAC[REAL_MUL_GT]; DISJ2_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_ANTISYM]; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `&0 - poly p z > &0`; LABEL_ALL_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - z`; LABEL_ALL_TAC; USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(y - z) * poly (poly_diff p) x'' > &0`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;]; REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* save *) CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); REWRITE_ASSUMS[real_gt]; ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `x < x''' /\ x''' < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x'`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) MP_TAC (ISPECL[`z:real`;`y:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; REPEAT_N 2 STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; ]);; (* }}} *) let zero_neg_neg_thm = prove_by_refinement( `!x y p. x < y ==> (poly p x = &0) ==> (poly p y < &0) ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; REWRITE_TAC[ARITH_RULE `x <= y <=> (x < y \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p z - &0 > &0`; LABEL_ALL_TAC; USE_THEN "Z-3" MP_TAC; USE_THEN "Z-8" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `(z - x) * poly (poly_diff p) x' > &0`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; REWRITE_TAC[real_gt]; ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;]; REPEAT STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 > (z - x) * poly (poly_diff p) x'`; REWRITE_TAC[REAL_MUL_GT;real_gt;REAL_MUL_LT;]; DISJ2_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_ANTISYM]; (* save *) MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p y - poly p z < &0`; LABEL_ALL_TAC; USE_THEN "Z-13" MP_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < y - z`; LABEL_ALL_TAC; USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(y - z) * poly (poly_diff p) x'' < &0`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;]; REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* save *) CLAIM `x' < x''`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); REWRITE_ASSUMS[real_gt]; ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `x < x''' /\ x''' < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x'`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) MP_TAC (ISPECL[`x:real`;`z:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; REPEAT_N 2 STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; ]);; (* }}} *) let zero_pos_pos_thm = prove_by_refinement( `!x y p. x < y ==> (poly p x = &0) ==> (poly p y > &0) ==> (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> (!z. x < z /\ z < y ==> poly p z > &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[ARITH_RULE `x > y <=> ~(y >= x)`]; REWRITE_TAC[ARITH_RULE `x >= y <=> (x > y \/ (x = y))`]; STRIP_TAC; MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p y - poly p z > &0`; LABEL_ALL_TAC; USE_THEN "Z-7" MP_TAC; USE_THEN "Z-3" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `(y - z) * poly (poly_diff p) x' > &0`; REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; REWRITE_TAC[real_gt]; ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;]; REPEAT STRIP_TAC; LABEL_ALL_TAC; USE_THEN "Z-1" MP_TAC; USE_THEN "Z-7" MP_TAC; REAL_ARITH_TAC; (* save *) MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `poly p z - &0 < &0`; LABEL_ALL_TAC; USE_THEN "Z-9" MP_TAC; REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 < z - x`; LABEL_ALL_TAC; USE_THEN "Z-12" MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `(z - x) * poly (poly_diff p) x'' < &0`; POP_ASSUM IGNORE; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;]; REPEAT STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REAL_ARITH_TAC; (* save *) CLAIM `x'' < x'`; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; STRIP_TAC; MP_TAC (ISPECL [`poly_diff p`;`x'':real`;`x':real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); REWRITE_ASSUMS[real_gt]; ASM_REWRITE_TAC[]; STRIP_TAC; CLAIM `x < x''' /\ x''' < y`; STRIP_TAC; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x''`; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `x'`; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; (* save *) MP_TAC (ISPECL[`x:real`;`z:real`;`p:real list`] eq_eq_false_thm); POP_ASSUM (ASSUME_TAC o GSYM); ASM_REWRITE_TAC[]; REPEAT_N 2 STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LT_TRANS; EXISTS_TAC `z`; ASM_REWRITE_TAC[]; ]);; (* }}} *) hol-light/Rqe/inferpsign.ml000066400000000000000000000317411303454263000162000ustar00rootroot00000000000000(* ====================================================================== *) (* INFERPSIGN *) (* ====================================================================== *) (* ------------------------------------------------------------------------- *) (* Infer sign of p(x) at points from corresponding qi(x) with pi(x) = 0 *) (* ------------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *) (* INFERPSIGN *) (* ---------------------------------------------------------------------- *) let isign_eq_zero thm = let __,_,sign = dest_interpsign thm in sign = szero_tm;; let isign_lt_zero thm = let __,_,sign = dest_interpsign thm in sign = sneg_tm;; let isign_gt_zero thm = let __,_,sign = dest_interpsign thm in sign = spos_tm;; (* let p_thm,q_thm = ith 1 split_thms *) let inferpsign_row vars sgns p_thm q_thm div_thms = let pthms = map (BETA_RULE o (PURE_REWRITE_RULE[interpsigns])) (interpsigns_thms2 p_thm) in let qthms = map (BETA_RULE o (PURE_REWRITE_RULE[interpsigns])) (interpsigns_thms2 q_thm) in let _,set,_ = dest_interpsigns p_thm in if can (get_index isign_eq_zero) pthms then (* there's a zero *) let ind = get_index isign_eq_zero pthms in let pthm = ith ind pthms in let qthm = ith ind qthms in let div_thm = ith ind div_thms in let div_thm' = GEN (hd vars) div_thm in let aks,pqr = dest_eq (concl div_thm) in let ak,s = dest_mult aks in let a,k = dest_pow ak in let pq,r = dest_plus pqr in let p,q = dest_mult pq in let parity_thm = PARITY_CONV k in let evenp = fst(dest_comb (concl parity_thm)) = even_tm in let sign_thm = FINDSIGN vars sgns a in let op,_,_ = get_binop (concl sign_thm) in if evenp then let nz_thm = if op = rlt then MATCH_MP ips_lt_nz_thm sign_thm else if op = rgt then MATCH_MP ips_gt_nz_thm sign_thm else if op = rneq then sign_thm else failwith "inferpsign: 0" in let imp_thms = CONJUNCTS(ISPEC set (MATCH_MPL[EVEN_DIV_LEM;div_thm';nz_thm;parity_thm])) in let _,_,qsign = dest_interpsign qthm in let mp_thm = if qsign = sneg_tm then ith 0 imp_thms else if qsign = spos_tm then ith 1 imp_thms else if qsign = szero_tm then ith 2 imp_thms else failwith "inferpsign: 1" in let final_thm = MATCH_MPL[mp_thm;pthm;qthm] in mk_interpsigns (final_thm::pthms) else (* k is odd *) if op = rgt then (* a > &0 *) let imp_thms = CONJUNCTS(ISPEC set (MATCH_MPL[GT_DIV_LEM;div_thm';sign_thm])) in let _,_,qsign = dest_interpsign qthm in let mp_thm = if qsign = sneg_tm then ith 0 imp_thms else if qsign = spos_tm then ith 1 imp_thms else if qsign = szero_tm then ith 2 imp_thms else failwith "inferpsign: 1" in let final_thm = MATCH_MPL[mp_thm;pthm;qthm] in mk_interpsigns (final_thm::pthms) else failwith "inferpsign: shouldn`t reach this point with an odd power and negative sign! See PDIVIDES and return the correct div_thm" else (* no zero *) let p = snd(dest_mult (lhs(concl (hd div_thms)))) in let p1 = mk_abs(hd vars,p) in let pthm = ISPECL [set;p1] unknown_thm in mk_interpsigns (pthm::pthms);; (* {{{ Doc *) (* split_interpsigns |- interpsigns [p0; p1; p2; q0; q1; q2] (\x. x < x1) [Pos; Pos; Pos; Neg; Neg; Neg] --> ( |- interpsigns [p0; p1; p2] (\x. x < x1) [Pos; Pos; Pos] , |- interpsigns [q0; q1; q2] (\x. x < x1) [ Neg; Neg; Neg] ) *) (* }}} *) let split_interpsigns thm = let thms = interpsigns_thms2 thm in let n = length thms / 2 in let l,r = chop_list n thms in (mk_interpsigns l,mk_interpsigns r);; let INFERPSIGN vars sgns mat_thm div_thms = let pts,pols,signs = dest_interpmat (concl mat_thm) in let n = length (dest_list pols) / 2 in let rol_thm,sgn_thm = interpmat_thms mat_thm in let part_thm = PARTITION_LINE_CONV (snd (dest_comb (concl rol_thm))) in let conj_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] sgn_thm) in let split_thms = map split_interpsigns conj_thms in let conj_thms' = map (fun (x,y) -> inferpsign_row vars sgns x y div_thms) split_thms in let all_thm = mk_all2_interpsigns part_thm conj_thms' in let mat_thm' = mk_interpmat_thm rol_thm all_thm in mat_thm';; (* ---------------------------------------------------------------------- *) (* Opt *) (* ---------------------------------------------------------------------- *) let MK_REP = let rep_tm = `REPLICATE:num -> sign -> sign list` in let len_tm = `LENGTH:real list -> num` in let one = `1` in let two = `2` in let unknown = `Unknown` in fun pts -> let num = mk_binop np (mk_binop nm two (mk_comb(len_tm,pts))) one in let len = length (dest_list pts) in let num2 = MK_SUC (2 * len + 1) in let lthm = ARITH_SIMP_CONV[LENGTH] num in let lthm2 = TRANS lthm num2 in let lthm3 = AP_THM (AP_TERM rep_tm lthm2) unknown in REWRITE_RULE[REPLICATE] lthm3;; let INSERT_UNKNOWN_COL = fun mat_thm p -> let pts,_,_ = dest_interpmat (concl mat_thm) in let rep_thm = MK_REP pts in let mat_thm' = MATCH_MP INFERPSIGN_MATINSERT_THM mat_thm in let mat_thm'' = PURE_REWRITE_RULE[MAP2;rep_thm] mat_thm' in ISPEC p mat_thm'';; let REMOVE_QS = fun mat_thm -> let _,pols,_ = dest_interpmat (concl mat_thm) in let len = length (dest_list pols) in if not (len mod 2 = 1) then failwith "odd pols?" else let mat_thm' = funpow (len / 2) (MATCH_MP REMOVE_LAST) mat_thm in REWRITE_RULE[MAP;BUTLAST;NOT_CONS_NIL;TL;HD;] mat_thm';; let SPLIT_LIST n l ty = let l' = dest_list l in let l1',l2' = chop_list n l' in let l1,l2 = (mk_list(l1',ty),mk_list(l2',ty)) in let app_tm = mk_const("APPEND",[ty,aty]) in let l3 = mk_comb(mk_comb(app_tm,l1),l2) in SYM(REWRITE_CONV[APPEND] l3);; (* let thm = asign *) let prove_nonzero thm = let op,_,_ = get_binop (concl thm) in if op = rgt then MATCH_MP ips_gt_nz_thm thm else if op = rlt then MATCH_MP ips_lt_nz_thm thm else if op = rneq then thm else failwith "prove_nonzero: bad op";; (* let mat_thm = mat_thm' let ind = 7 *) let INFERPT = let unknown = `Unknown` in let zero = `Zero` in let pos = `Pos` in let neg = `Neg` in let pow = `(pow)` in let even_tm = `(EVEN)` in let odd_tm = `(ODD)` in let rr_ty = `:real -> real` in let sl_ty = `:sign list` in let s_ty = `:sign` in let imat = `interpmat` in let rr_length = mk_const("LENGTH",[rr_ty,aty]) in let s_length = mk_const("LENGTH",[s_ty,aty]) in let sl_length = mk_const("LENGTH",[sl_ty,aty]) in let imat = `interpmat` in fun vars sgns mat_thm div_thms ind -> let pts,pols,signs = dest_interpmat (concl mat_thm) in let pols' = dest_list pols in let signsl = dest_list signs in let signs' = map dest_list signsl in let pols_len = length (hd signs') in let pols_len2 = pols_len / 2 in let pt_sgnl = ith ind signsl in let pt_sgns = ith ind signs' in let zind = index zero pt_sgns in if zind > pols_len2 then mat_thm else (* return if not a zero of a p, only a q *) let psgn = ith (pols_len2 + zind) pt_sgns in let div_thm = ith (zind - 1) div_thms in let a,n = dest_binop pow (fst (dest_binop rm (lhs (concl div_thm)))) in let asign = FINDSIGN vars sgns a in let op,_,_ = get_binop (concl asign) in let par_thm = PARITY_CONV n in let par = fst(dest_comb(concl par_thm)) in let mp_thm = (* note: by def of PDIVIDES, we can`t have negative sign and odd power at this point *) (* n is even *) if par = even_tm then if psgn = pos then INFERPSIGN_POS_EVEN else if psgn = neg then INFERPSIGN_NEG_EVEN else if psgn = zero then INFERPSIGN_ZERO_EVEN else failwith "INFERPT: bad sign" else (* n is odd *) if psgn = pos then INFERPSIGN_POS_ODD_POS else if psgn = neg then INFERPSIGN_NEG_ODD_POS else if psgn = zero then INFERPSIGN_ZERO_ODD_POS else failwith "INFERPT: bad sign" in (* pols *) let split_pols1 = SPLIT_LIST zind pols rr_ty in let _,l2 = chop_list zind pols' in let split_pols2 = SPLIT_LIST pols_len2 (mk_list(l2,rr_ty)) rr_ty in let s1,t1 = dest_comb (rhs (concl split_pols1)) in let split_pols_thm = TRANS split_pols1 (AP_TERM s1 split_pols2) in (* pt_sgns *) let split_sgns1 = SPLIT_LIST zind pt_sgnl s_ty in let _,l3 = chop_list zind pt_sgns in let split_sgns2 = SPLIT_LIST pols_len2 (mk_list(l3,s_ty)) s_ty in let s2,t2 = dest_comb (rhs (concl split_sgns1)) in let split_pt_sgns_thm = TRANS split_sgns1 (AP_TERM s2 split_sgns2) in (* sgns *) let split_signs = SPLIT_LIST ind signs sl_ty in let r1,r3 = dest_comb(rhs (concl split_signs)) in let tl_thm = HD_CONV (ONCE_REWRITE_CONV[split_pt_sgns_thm]) r3 in let r4,_ = dest_comb (rhs (concl split_signs)) in let split_sgns_thm = TRANS split_signs (AP_TERM r4 tl_thm) in (* imat *) let mat1 = mk_comb(imat,pts) in let mat_thm1 = AP_TERM mat1 split_pols_thm in let mat_thm2 = MK_COMB(mat_thm1,split_sgns_thm) in let mat_thm3 = EQ_MP mat_thm2 mat_thm in (* length thms *) (* LENGTH ps = LENGTH s1 *) let ps = mk_list(tl(dest_list(snd(dest_comb s1))),rr_ty) in let ps_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,ps)) in let ss = mk_list(tl(dest_list(snd(dest_comb s2))),s_ty) in let ss_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,ss)) in let ps_s1_thm = TRANS ps_len (SYM ss_len) in (* LENGTH qs = LENGTH s2 *) let k1 = tl (fst (chop_list pols_len2 (dest_list t1))) in let qs = mk_list(k1,rr_ty) in let qs_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,qs)) in let k2 = tl (fst (chop_list pols_len2 (dest_list t2))) in let s2s = mk_list(k2,s_ty) in let s2s_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,s2s)) in let qs_s2_thm = TRANS qs_len (SYM s2s_len) in (* ODD (LENGTH sgns) *) let _,hdsgns = dest_comb r1 in let odd_thm = EQT_ELIM(REWRITE_CONV[LENGTH;ODD;EVEN;NOT_ODD;NOT_EVEN] (mk_comb(odd_tm,mk_comb(sl_length,hdsgns)))) in (* a <> 0 *) let a_thm = if par = even_tm then prove_nonzero asign else asign in let div_thm' = GEN (hd vars) div_thm in (* main *) let thm1 = BETA_RULE(MATCH_MPL[mp_thm;mat_thm3;ps_s1_thm;qs_s2_thm;odd_thm]) in let thm2 = if par = even_tm then MATCH_MPL[thm1;div_thm';a_thm;par_thm] else MATCH_MPL[thm1;div_thm';a_thm] in REWRITE_RULE[APPEND] thm2;; (* let mat_thm = mat_thm' *) let INFERPTS vars sgns mat_thm div_thms = let pts,_,_ = dest_interpmat (concl mat_thm) in let len = 2 * length (dest_list pts) in let ods = filter odd (1--len) in itlist (fun i matthm -> INFERPT vars sgns matthm div_thms i) ods mat_thm;; let itvars,itsgns,itmat,itdivs = ref [],ref [],ref TRUTH,ref [];; (* let vars,sgns,mat_thm,div_thms = !itvars,!itsgns,!itmat,!itdivs *) let INFERPSIGN2 vars sgns mat_thm div_thms = itvars := vars; itsgns := sgns; itmat := mat_thm; itdivs := div_thms; let _,bod = dest_binop rm (lhs (concl (hd div_thms))) in let p = mk_abs(hd vars,bod) in let mat_thm' = INSERT_UNKNOWN_COL mat_thm p in let mat_thm'' = INFERPTS vars sgns mat_thm' div_thms in REMOVE_QS mat_thm'';; (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let INFERPSIGN vars sgns mat_thm div_thms = let start_time = Sys.time() in let res = INFERPSIGN vars sgns mat_thm div_thms in inferpsign_timer +.= (Sys.time() -. start_time); res;; (* let l1 = PDIVIDE [`x:real`] `&1 + x * (&1 + x * (&1 + x * &1))` `&1 + x * (&2 + x * &3)`;; let l2 = PDIVIDE [`x:real`] `&1 + x * (&1 + x * (&1 + x * &1))` `&2 + x * (-- &3 + x * &1)`;; let l3 = PDIVIDE [`x:real`] `&1 + x * (&1 + x * (&1 + x * &1))` `-- &4 + x * (&0 + x * &1)`;; let div_thms = [l1;l2;l3];; let vars = [`x:real`];; let sgns = [ARITH_RULE `&1 > &0`];; let mat_thm = ASSUME `interpmat [x1; x2; x3; x4; x5] [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] [[Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Zero; Zero; Neg; Neg]; [Pos; Pos; Neg; Pos; Neg; Neg]; [Pos; Pos; Neg; Pos; Neg; Zero]; [Pos; Pos; Neg; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos; Zero; Pos]; [Pos; Pos; Neg; Pos; Pos; Pos]; [Pos; Zero; Neg; Pos; Pos; Pos]; [Pos; Neg; Neg; Pos; Pos; Pos]; [Pos; Zero; Zero; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos; Pos; Pos]]` ;; INFERPSIGN vars sgns mat_thm div_thms *) hol-light/Rqe/inferpsign_thms.ml000066400000000000000000000270041303454263000172300ustar00rootroot00000000000000let EVEN_DIV_LEM = prove_by_refinement( `!set p q c d a n. (!x. a pow n * p x = c x * q x + d x) ==> a <> &0 ==> EVEN n ==> ((interpsign set q Zero) ==> (interpsign set d Neg) ==> (interpsign set p Neg)) /\ ((interpsign set q Zero) ==> (interpsign set d Pos) ==> (interpsign set p Pos)) /\ ((interpsign set q Zero) ==> (interpsign set d Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) [ REWRITE_TAC[interpsign]; REPEAT STRIP_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `&0 < a pow n`; ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; STRIP_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `&0 < a pow n`; ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; STRIP_TAC; CLAIM `a pow n * p x > &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `&0 < a pow n`; ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; STRIP_TAC; CLAIM `a pow n * p x = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_POS_NZ]; ]);; (* }}} *) let GT_DIV_LEM = prove_by_refinement( `!set p q c d a n. (!x. a pow n * p x = c x * q x + d x) ==> a > &0 ==> ((interpsign set q Zero) ==> (interpsign set d Neg) ==> (interpsign set p Neg)) /\ ((interpsign set q Zero) ==> (interpsign set d Pos) ==> (interpsign set p Pos)) /\ ((interpsign set q Zero) ==> (interpsign set d Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) [ REWRITE_TAC[interpsign]; REPEAT_N 9 STRIP_TAC; CLAIM `a pow n > &0`; ASM_MESON_TAC[REAL_POW_LT;real_gt;]; STRIP_TAC; REPEAT STRIP_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `a pow n * p x > &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `a pow n * p x = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; ]);; (* }}} *) let NEG_ODD_LEM = prove_by_refinement( `!set p q c d a n. (!x. a pow n * p x = c x * q x + d x) ==> a < &0 ==> ODD n ==> ((interpsign set q Zero) ==> (interpsign set (\x. -- d x) Neg) ==> (interpsign set p Neg)) /\ ((interpsign set q Zero) ==> (interpsign set (\x. -- d x) Pos) ==> (interpsign set p Pos)) /\ ((interpsign set q Zero) ==> (interpsign set (\x. -- d x) Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;POLY_NEG]; REPEAT_N 10 STRIP_TAC; CLAIM `a pow n < &0`; ASM_MESON_TAC[PARITY_POW_LT;real_gt;]; STRIP_TAC; REAL_SIMP_TAC; REPEAT STRIP_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `a pow n * p x > &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `a pow n * p x = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; ]);; (* }}} *) let NEQ_ODD_LEM = prove_by_refinement( `!set p q c d a n. (!x. a pow n * p x = c x * q x + d x) ==> a <> &0 ==> ODD n ==> ((interpsign set q Zero) ==> (interpsign set (\x. a * d x) Neg) ==> (interpsign set p Neg)) /\ ((interpsign set q Zero) ==> (interpsign set (\x. a * d x) Pos) ==> (interpsign set p Pos)) /\ ((interpsign set q Zero) ==> (interpsign set (\x. a * d x) Zero) ==> (interpsign set p Zero))`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;POLY_CMUL]; REPEAT_N 10 STRIP_TAC; CLAIM `a < &0 \/ a > &0 \/ (a = &0)`; REAL_ARITH_TAC; REWRITE_ASSUMS[NEQ]; ASM_REWRITE_TAC[]; LABEL_ALL_TAC; STRIP_TAC; (* save *) CLAIM `a pow n < &0`; ASM_MESON_TAC[PARITY_POW_LT]; STRIP_TAC; REPEAT STRIP_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `d x > &0`; POP_ASSUM MP_TAC; ASM_REWRITE_TAC[real_gt;REAL_MUL_LT]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; CLAIM `&0 < a pow n * p x`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_GT]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `d x < &0`; POP_ASSUM MP_TAC; REWRITE_TAC[REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `d x = &0`; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; STRIP_TAC; CLAIM `a pow n * p x = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; (* save *) CLAIM `a pow n > &0`; ASM_MESON_TAC[EVEN_ODD_POW;NEQ;real_gt]; STRIP_TAC; REPEAT STRIP_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `d x < &0`; POP_ASSUM MP_TAC; ASM_REWRITE_TAC[real_gt;REAL_MUL_LT]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; REWRITE_TAC[REAL_MUL_LT]; REPEAT STRIP_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; (* save *) RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `d x > &0`; POP_ASSUM MP_TAC; REWRITE_TAC[REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; CLAIM `a pow n * p x < &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `a pow n * p x > &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; REPEAT STRIP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); STRIP_TAC; CLAIM `d x = &0`; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; STRIP_TAC; CLAIM `a pow n * p x = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; ]);; (* }}} *) let NEQ_MULT_LT_LEM = prove_by_refinement( `!a q d d' set. a < &0 ==> ((interpsign set d Neg) ==> (interpsign set (\x. a * d x) Pos)) /\ ((interpsign set d Pos) ==> (interpsign set (\x. a * d x) Neg)) /\ ((interpsign set d Zero) ==> (interpsign set (\x. a * d x) Zero))`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;POLY_NEG]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_MUL_GT;real_gt]; ASM_MESON_TAC[REAL_MUL_LT;real_gt]; ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; ]);; (* }}} *) let NEQ_MULT_GT_LEM = prove_by_refinement( `!a q d d' set. a > &0 ==> ((interpsign set d Neg) ==> (interpsign set (\x. a * d x) Neg)) /\ ((interpsign set d Pos) ==> (interpsign set (\x. a * d x) Pos)) /\ ((interpsign set d Zero) ==> (interpsign set (\x. a * d x) Zero))`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;POLY_NEG] THEN MESON_TAC[REAL_MUL_LT;REAL_ENTIRE;REAL_NOT_EQ;REAL_MUL_GT;real_gt]; ]);; (* }}} *) let unknown_thm = prove( `!set p. (interpsign set p Unknown)`, MESON_TAC[interpsign]);; let ips_gt_nz_thm = prove_by_refinement( `!x. x > &0 ==> x <> &0`, (* {{{ Proof *) [ REWRITE_TAC[NEQ]; REAL_ARITH_TAC; ]);; (* }}} *) let ips_lt_nz_thm = prove_by_refinement( `!x. x < &0 ==> x <> &0`, (* {{{ Proof *) [ REWRITE_TAC[NEQ]; REAL_ARITH_TAC; ]);; (* }}} *) hol-light/Rqe/lift_qelim.ml000066400000000000000000000113761303454263000161630ustar00rootroot00000000000000let ACI_CONJ = let rec build ths tm = if is_conj tm then let l,r = dest_conj tm in CONJ (build ths l) (build ths r) else find (fun th -> concl th = tm) ths in fun p p' -> let cjs = CONJUNCTS(ASSUME p) and cjs' = CONJUNCTS(ASSUME p') in let th = build cjs p' and th' = build cjs' p in IMP_ANTISYM_RULE (DISCH_ALL th) (DISCH_ALL th');; let QE_SIMPLIFY_CONV = let NOT_EXISTS_UNIQUE_THM = prove (`~(?!x. P x) <=> (!x. ~P x) \/ ?x x'. P x /\ P x' /\ ~(x = x')`, REWRITE_TAC[EXISTS_UNIQUE_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; CONJ_ASSOC]) in let tauts = [TAUT `~(~p) <=> p`; TAUT `~(p /\ q) <=> ~p \/ ~q`; TAUT `~(p \/ q) <=> ~p /\ ~q`; TAUT `~(p ==> q) <=> p /\ ~q`; TAUT `p ==> q <=> ~p \/ q`; NOT_FORALL_THM; NOT_EXISTS_THM; EXISTS_UNIQUE_THM; NOT_EXISTS_UNIQUE_THM; TAUT `~(p <=> q) <=> (p /\ ~q) \/ (~p /\ q)`; TAUT `(p <=> q) <=> (p /\ q) \/ (~p /\ ~q)`; TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;; let OR_ASSOC = TAUT `(a \/ b) \/ c <=> a \/ b \/ c`;; let forall_thm = prove(`!P. (!x. P x) <=> ~ (?x. ~ P x)`,MESON_TAC[]) and or_exists_conv = PURE_REWRITE_CONV[OR_EXISTS_THM] and triv_exists_conv = REWR_CONV EXISTS_SIMP and push_exists_conv = REWR_CONV RIGHT_EXISTS_AND_THM and not_tm = `(~)` and or_tm = `(\/)` and t_tm = `T` and f_tm = `F`;; let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = let rec qelift_conv vars fm = if fm = t_tm || fm = f_tm then REFL fm else if is_neg fm then let thm1 = qelift_conv vars (dest_neg fm) in MK_COMB(REFL not_tm,thm1) else if is_conj fm || is_disj fm || is_imp fm || is_iff fm then let (op,p,q) = get_binop fm in let thm1 = qelift_conv vars p in let thm2 = qelift_conv vars q in MK_COMB(MK_COMB((REFL op),thm1),thm2) else if is_forall fm then let (x,p) = dest_forall fm in let nex_thm = BETA_RULE (ISPEC (mk_abs(x,p)) forall_thm) in let nex_thm' = CONV_RULE (LAND_CONV (RAND_CONV (ALPHA_CONV x))) nex_thm in let nex_thm'' = CONV_RULE (RAND_CONV (RAND_CONV (RAND_CONV (ALPHA_CONV x)))) nex_thm' in let elim_thm = qelift_conv vars (mk_exists(x,mk_neg p)) in TRANS nex_thm'' (MK_COMB (REFL not_tm,elim_thm)) else if is_exists fm then let (x,p) = dest_exists fm in let thm1 = qelift_conv (x::vars) p in let thm1a = MK_EXISTS x thm1 in let thm1b = PURE_REWRITE_RULE[OR_ASSOC] thm1a in let thm2 = nfn_conv (rhs(concl thm1)) in let thm2a = MK_EXISTS x thm2 in let thm2b = PURE_REWRITE_RULE[OR_ASSOC] thm2a in let djs = disjuncts (rhs (concl thm2)) in let djthms = map (qelim x vars) djs in let thm3 = end_itlist (fun thm1 thm2 -> MK_COMB(MK_COMB (REFL or_tm,thm1),thm2)) djthms in let split_ex_thm = GSYM (or_exists_conv (lhs (concl thm3))) in let thm3a = TRANS split_ex_thm thm3 in TRANS (TRANS thm1b thm2b) thm3a else afn_conv vars fm and qelim x vars p = let cjs = conjuncts p in let ycjs,ncjs = partition (mem x o frees) cjs in if ycjs = [] then triv_exists_conv(mk_exists(x,p)) else if ncjs = [] then qfn_conv vars (mk_exists(x,p)) else let th1 = ACI_CONJ p (mk_conj(list_mk_conj ncjs,list_mk_conj ycjs)) in let th2 = CONV_RULE (RAND_CONV push_exists_conv) (MK_EXISTS x th1) in let t1,t2 = dest_comb (rand(concl th2)) in TRANS th2 (AP_TERM t1 (qfn_conv vars t2)) in fun fm -> ((qelift_conv (frees fm)) THENC QE_SIMPLIFY_CONV) fm;; (* let afn_conv,nfn_conv,qfn_conv = POLYATOM_CONV,(EVALC_CONV THENC SIMPLIFY_CONV),BASIC_REAL_QELIM_CONV let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = fun fm -> ((qelift_conv (frees fm)) THENC QE_SIMPLIFY_CONV) fm;; let k0 = (TRANS thm1a thm2a) let k1 = thm3a let k2 = CONV_RULE (LAND_CONV (RAND_CONV (ALPHA_CONV `x:real`))) k1 TRANS k0 k2 let vars = [] let fm,vars = !lqc_fm,!lqc_vars let fm = `?x y z. x * y * z < &0` let p = `~((&0 + y * (&0 + x * &1) = &0) <=> (&0 + x * &1 = &0) \/ (&0 + y * &1 = &0))` #trace qelift_conv #trace qelim TRANS (ASSUME `T <=> (?x. x * y > &0)`) (ASSUME `(?z. z * y > &0) <=> F`) MATCH_TRANS (ASSUME `T <=> (?x. x * y > &0)`) (ASSUME `?z. z * y > &0 <=> F`) MATCH_EQ_MP (ASSUME `(?x. x * y > &0) <=> F`) (ASSUME `?z. z * y > &0`) qelift_conv vars fm let fm = `?x y. x * y = &0` let fm = `!y. (x * y = &0) <=> (x = &0) \/ (y = &0)` let fm = `?y. (x * y = &0) <=> (x = &0) \/ (y = &0)` let fm = `?y. ~ ((x * y = &0) <=> (x = &0) \/ (y = &0))` let fm = `?x. ~(!y. (x * y = &0) <=> (x = &0) \/ (y = &0))` let vars = [ry;rx] let vars = [rx] let QELIM_DLO_CONV = (LIFT_QELIM_CONV AFN_DLO_CONV ((CNNF_CONV LFN_DLO_CONV) THENC DNF_CONV) (fun v -> DLOBASIC_CONV)) THENC (REWRITE_CONV[]);; *) hol-light/Rqe/list_rewrites.ml000066400000000000000000000013211303454263000167220ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* List *) (* ---------------------------------------------------------------------- *) let NOT_NIL = prove_by_refinement( `!l. ~(l = []) <=> ?(h:A) t. l = CONS h t`, (* {{{ Proof *) [ STRIP_TAC THEN EQ_TAC; MESON_TAC[list_CASES]; STRIP_TAC; ASM_MESON_TAC[NOT_CONS_NIL]; ]);; (* }}} *) let LIST_REWRITES = ref [ NOT_CONS_NIL; HD; TL; CONS_11; LENGTH; LAST; list_CASES; NOT_NIL; ];; let LIST_SIMP_TAC = REWRITE_TAC ( !LIST_REWRITES );; let extend_list_rewrites l = LIST_REWRITES := !LIST_REWRITES @ l;; BASIC_REWRITES := !LIST_REWRITES @ !BASIC_REWRITES;; hol-light/Rqe/main_thms.ml000066400000000000000000000176231303454263000160160ustar00rootroot00000000000000let empty_mat = prove_by_refinement( `interpmat [] [] [[]]`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;ROL_EMPTY;interpsigns;ALL2;partition_line]; ]);; (* }}} *) let empty_sgns = [ARITH_RULE `&1 > &0`];; let monic_isign_lem = prove( `(!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Pos ==> interpsign s p Pos) /\ (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Pos ==> interpsign s p Neg) /\ (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Neg ==> interpsign s p Neg) /\ (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Neg ==> interpsign s p Pos) /\ (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Zero ==> interpsign s p Zero) /\ (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Zero ==> interpsign s p Zero)`, (* {{{ Proof *) REWRITE_TAC[interpsign] THEN REPEAT STRIP_TAC THEN POP_ASSUM (fun x -> POP_ASSUM (fun y -> MP_TAC (MATCH_MP y x))) THEN POP_ASSUM MP_TAC THEN POP_ASSUM (ASSUME_TAC o GSYM o (ISPEC `x:real`)) THEN ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_ENTIRE] THEN REAL_ARITH_TAC);; (* }}} *) let gtpos::ltpos::gtneg::ltneg::gtzero::ltzero::[] = CONJUNCTS monic_isign_lem;; let main_lem000 = prove_by_refinement( `!l n. (LENGTH l = SUC n) ==> 0 < LENGTH l`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; ARITH_TAC; ]);; (* }}} *) let main_lem001 = prove_by_refinement( `x <> &0 ==> (LAST l = x) ==> LAST l <> &0`, [MESON_TAC[]]);; let main_lem002 = prove_by_refinement( `(x <> y ==> x <> y) /\ (x < y ==> x <> y) /\ (x > y ==> x <> y) /\ (~(x >= y) ==> x <> y) /\ (~(x <= y) ==> x <> y) /\ (~(x = y) ==> x <> y)`, (* {{{ Proof *) [ REWRITE_TAC[NEQ] THEN REAL_ARITH_TAC ]);; (* }}} *) let factor_pos_pos = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Pos ==> (!x. x pow k * p x = q x) ==> interpsign s q Pos`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;real_gt]; DISJ2_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt]; ]);; (* }}} *) let factor_pos_neg = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Neg ==> (!x. x pow k * p x = q x) ==> interpsign s q Neg`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_LT;real_gt]; DISJ2_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt]; ]);; (* }}} *) let factor_pos_zero = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Zero ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_LT;REAL_ENTIRE;real_gt]; ]);; (* }}} *) let factor_zero_pos = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Pos ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;REAL_ENTIRE]; DISJ1_TAC; ASM_MESON_TAC[POW_0;num_CASES;]; ]);; (* }}} *) let factor_zero_neg = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Neg ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;REAL_ENTIRE]; DISJ1_TAC; ASM_MESON_TAC[POW_0;num_CASES;]; ]);; (* }}} *) let factor_zero_zero = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Zero ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REAL_ARITH_TAC; ]);; (* }}} *) let factor_neg_even_pos = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> EVEN k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Pos`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt]; DISJ2_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; ]);; (* }}} *) let factor_neg_even_neg = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> EVEN k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Neg`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt]; DISJ2_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; ]);; (* }}} *) let factor_neg_even_zero = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> EVEN k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; ]);; (* }}} *) let factor_neg_odd_pos = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> ODD k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Neg`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; DISJ1_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; ]);; (* }}} *) let factor_neg_odd_neg = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> ODD k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Pos`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; DISJ1_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; ]);; (* }}} *) let factor_neg_odd_zero = prove_by_refinement( `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> ODD k ==> ~(k = 0) ==> (!x. x pow k * p x = q x) ==> interpsign s q Zero`, (* {{{ Proof *) [ REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; ]);; (* }}} *) hol-light/Rqe/make.ml000066400000000000000000000030261303454263000147440ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Library requirements. *) (* ------------------------------------------------------------------------- *) needs "Library/analysis.ml";; needs "Library/poly.ml";; (* ------------------------------------------------------------------------- *) (* The main code. *) (* ------------------------------------------------------------------------- *) loads "Rqe/rqe_lib.ml";; loads "Rqe/rqe_tactics_ext.ml";; loads "Rqe/util.ml";; loads "Rqe/rewrites.ml";; loads "Rqe/basic.ml";; loads "Rqe/rqe_num.ml";; loads "Rqe/rqe_real.ml";; loads "Rqe/list_rewrites.ml";; loads "Rqe/rqe_list.ml";; loads "Rqe/timers.ml";; loads "Rqe/num_calc_simp.ml";; loads "Rqe/asym.ml";; loads "Rqe/rol.ml";; loads "Rqe/poly_ext.ml";; loads "Rqe/simplify.ml";; loads "Rqe/lift_qelim.ml";; loads "Rqe/defs.ml";; loads "Rqe/testform_thms.ml";; loads "Rqe/condense_thms.ml";; loads "Rqe/inferisign_thms.ml";; loads "Rqe/matinsert_thms.ml";; loads "Rqe/signs_thms.ml";; loads "Rqe/inferpsign_thms.ml";; loads "Rqe/dedmatrix_thms.ml";; loads "Rqe/pdivides_thms.ml";; loads "Rqe/main_thms.ml";; loads "Rqe/work_thms.ml";; loads "Rqe/testform.ml";; loads "Rqe/condense.ml";; loads "Rqe/inferisign.ml";; loads "Rqe/matinsert.ml";; loads "Rqe/signs.ml";; loads "Rqe/inferpsign.ml";; loads "Rqe/dedmatrix.ml";; loads "Rqe/pdivides.ml";; loads "Rqe/rqe_main.ml";; (**** loads "Rqe/examples.ml";; ****) hol-light/Rqe/matinsert.ml000066400000000000000000000073061303454263000160420ustar00rootroot00000000000000 let ROWINSERT = let lxt = `\x:real. T` in fun i const_thm interpsigns_thm -> let isigns_thms = interpsigns_thms2 interpsigns_thm in let isigns_thm = hd isigns_thms in let set,_,_ = if concl isigns_thm = t_tm then lxt,t_tm,t_tm else dest_interpsign (hd isigns_thms) in let const_thm' = MATCH_MP (ISPEC set matinsert_lem0) const_thm in let const_thm'' = PURE_REWRITE_RULE[GSYM interpsign] const_thm' in let isigns_thms' = insertat i const_thm'' isigns_thms in let isigns_thms'' = if isigns_thm = TRUTH then butlast isigns_thms' else isigns_thms' in mk_interpsigns isigns_thms'';; let MATINSERT vars i const_thm cont mat_thm = let const_thm' = GEN (hd vars) const_thm in let rol_thm,all2_thm = interpmat_thms mat_thm in let part_thm = PARTITION_LINE_CONV (snd (dest_comb (concl rol_thm))) in let isigns_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] all2_thm) in let isigns_thms' = map (ROWINSERT i const_thm') isigns_thms in let all2_thm' = mk_all2_interpsigns part_thm isigns_thms' in let mat_thm' = mk_interpmat_thm rol_thm all2_thm' in cont mat_thm';; (* ---------------------------------------------------------------------- *) (* Opt *) (* ---------------------------------------------------------------------- *) (* OPT FAILED... slightly slower, even with hashtables *) let rec mk_suc = let zero = `0` in let suc = `SUC` in fun n -> match n with 0 -> zero | n -> mk_comb(suc,mk_suc (n-1));; let rec MK_SUC = let f n = prove(mk_eq(mk_small_numeral n,mk_suc n),ARITH_TAC) in let size = 100 in let range = 0--size in let suc_tbl = Hashtbl.create size in map2 (Hashtbl.add suc_tbl) range (map f range); fun n -> try Hashtbl.find suc_tbl n with _ -> f n;; let PL_LENGTH = let pl_tm = `partition_line` in let len_tm = `LENGTH:(real -> bool) list -> num` in fun pts -> let lpts = mk_comb(len_tm,mk_comb(pl_tm,pts)) in let lthm = ARITH_SIMP_CONV[PARTITION_LINE_LENGTH;LENGTH] lpts in let pts' = snd(dest_eq(concl lthm)) in let n = dest_small_numeral pts' in let suc_thm = MK_SUC n in TRANS lthm suc_thm;; let rec MK_LT = let f(n1,n2) = prove(mk_binop nle (mk_suc n1) (mk_suc n2),ARITH_TAC) in let size1 = 20 in let size2 = 20 in let range1 = 0--size1 in let range2 = 0--size2 in let range = filter (fun (x,y) -> x <= y) (allpairs (fun x y -> x,y) range1 range2) in let suc_tbl = Hashtbl.create (size1 * size2) in map2 (Hashtbl.add suc_tbl) range (map f range); fun (n1,n2) -> try Hashtbl.find suc_tbl (n1,n2) with _ -> f(n1,n2);; (* let vars,i,const_thm,mat_thm = !ti,!tconst,!tmat #trace MATINSERT *) (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let MATINSERT vars i const_thm cont mat_thm = let start_time = Sys.time() in let res = MATINSERT vars i const_thm cont mat_thm in matinsert_timer +.= (Sys.time() -. start_time); res;; (* let vars,i,const_thm, cont,mat_thm = [ry;rx], 0, ASSUME `-- &1 < &0`, I, ASSUME `interpmat [x_24] [\x. &0 + x * &1] [[Neg]; [Zero]; [Pos]]` MATINSERT vars i const_thm cont mat_thm let vars,i,const_thm, cont,mat_thm = [ry;rx], 0, ASSUME `&0 + x * &1 < &0`, I, ASSUME `interpmat [] [\y. &1] [[Pos]]` MATINSERT vars i const_thm cont mat_thm let vars,i,const_thm, cont,mat_thm = [`x:real`; `a:real`; `b:real`; `c:real`], 0, ASSUME `&0 + a * &2 < &0`, I, ASSUME `interpmat [x_408] [\x. (&0 + b * &1) + x * (&0 + a * &2)] [[Pos]; [Zero]; [Neg]]` MATINSERT vars i const_thm cont mat_thm *) hol-light/Rqe/matinsert_thms.ml000066400000000000000000000002011303454263000170600ustar00rootroot00000000000000 let matinsert_lem0 = prove_by_refinement( `!S. (!x. P x) ==> (!x. S x ==> P x)`, (* {{{ Proof *) [MESON_TAC[]]);; (* }}} *) hol-light/Rqe/num_calc_simp.ml000066400000000000000000000034461303454263000166460ustar00rootroot00000000000000 (* PUT BASIC ARITHMETIC OF THE NATURALS INTO THE SIMPLIFIER *) (* based on NUM_RED_CONV in num_calc *) let arith_ss thml = itlist (fun (x,y) ss -> ss_of_conv x y ss) [`SUC(NUMERAL n)`,NUM_SUC_CONV; `PRE(NUMERAL n)`,NUM_PRE_CONV; `FACT(NUMERAL n)`,NUM_FACT_CONV; `NUMERAL m < NUMERAL n`,NUM_REL_CONV; `NUMERAL m <= NUMERAL n`,NUM_REL_CONV; `NUMERAL m > NUMERAL n`,NUM_REL_CONV; `NUMERAL m >= NUMERAL n`,NUM_REL_CONV; `NUMERAL m = NUMERAL n`,NUM_REL_CONV; `EVEN(NUMERAL n)`,NUM_EVEN_CONV; `ODD(NUMERAL n)`,NUM_ODD_CONV; `NUMERAL m + NUMERAL n`,NUM_ADD_CONV; `NUMERAL m - NUMERAL n`,NUM_SUB_CONV; `NUMERAL m * NUMERAL n`,NUM_MULT_CONV; `(NUMERAL m) EXP (NUMERAL n)`,NUM_EXP_CONV; `(NUMERAL m) DIV (NUMERAL n)`,NUM_DIV_CONV; `(NUMERAL m) MOD (NUMERAL n)`,NUM_MOD_CONV] (basic_ss thml);; let ARITH_SIMP_CONV thl = SIMPLIFY_CONV (arith_ss []) thl;; let arith_net() = itlist (uncurry net_of_conv) [`SUC(NUMERAL n)`,NUM_SUC_CONV; `PRE(NUMERAL n)`,NUM_PRE_CONV; `FACT(NUMERAL n)`,NUM_FACT_CONV; `NUMERAL m < NUMERAL n`,NUM_REL_CONV; `NUMERAL m <= NUMERAL n`,NUM_REL_CONV; `NUMERAL m > NUMERAL n`,NUM_REL_CONV; `NUMERAL m >= NUMERAL n`,NUM_REL_CONV; `NUMERAL m = NUMERAL n`,NUM_REL_CONV; `EVEN(NUMERAL n)`,NUM_EVEN_CONV; `ODD(NUMERAL n)`,NUM_ODD_CONV; `NUMERAL m + NUMERAL n`,NUM_ADD_CONV; `NUMERAL m - NUMERAL n`,NUM_SUB_CONV; `NUMERAL m * NUMERAL n`,NUM_MULT_CONV; `(NUMERAL m) EXP (NUMERAL n)`,NUM_EXP_CONV; `(NUMERAL m) DIV (NUMERAL n)`,NUM_DIV_CONV; `(NUMERAL m) MOD (NUMERAL n)`,NUM_MOD_CONV] (basic_net());; let ARITH_REWRITE_CONV thl = GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (arith_net()) thl;; let ARITH_SIMP_TAC thl = CONV_TAC (ARITH_SIMP_CONV thl);; hol-light/Rqe/pdivides.ml000066400000000000000000000065721303454263000156470ustar00rootroot00000000000000 (* ---------------------------------------------------------------------- *) (* PDIVIDES *) (* ---------------------------------------------------------------------- *) let PDIVIDES vars sgns p q = let s_thm = FINDSIGN vars sgns (head vars q) in let op,l1,r1 = get_binop (concl s_thm) in if op = req then failwith "PDIVIDES : head coefficient is zero" else let div_thm = PDIVIDE vars p q in let asx,pqr = dest_eq (concl div_thm) in let pq,r = dest_plus pqr in let p',q' = dest_mult pq in let ak,s = dest_mult asx in let a,k = dest_pow ak in let k' = dest_small_numeral k in if op = rgt || even k' then r,div_thm else if odd k' && op = rlt then let par_thm = PARITY_CONV k in let mp_thm = MATCH_MPL[neg_odd_lem;div_thm;par_thm] in let mp_thm1 = (CONV_RULE (LAND_CONV (LAND_CONV (LAND_CONV POLY_NEG_CONV)))) mp_thm in let mp_thm2 = (CONV_RULE (RAND_CONV (LAND_CONV (LAND_CONV (POLY_NEG_CONV))))) mp_thm1 in let mp_thm3 = (CONV_RULE (RAND_CONV (RAND_CONV POLY_NEG_CONV))) mp_thm2 in let ret = (snd o dest_plus o rhs o concl) mp_thm3 in ret,mp_thm3 else if odd k' && op = rneq then let par_thm = PARITY_CONV k in let mp_thm = MATCH_MPL[mul_odd_lem;div_thm;par_thm] in let mp_thm1 = (CONV_RULE (LAND_CONV (LAND_CONV (LAND_CONV (POLYNATE_CONV vars))))) mp_thm in let mp_thm2 = (CONV_RULE (RAND_CONV (LAND_CONV (POLYNATE_CONV vars)))) mp_thm1 in let mp_thm3 = (CONV_RULE (RAND_CONV (RAND_CONV (POLY_MUL_CONV vars)))) mp_thm2 in let ret = (snd o dest_plus o rhs o concl) mp_thm3 in ret,mp_thm3 else failwith "PDIVIDES: 1";; (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let PDIVIDES vars sgns mat_thm div_thms = let start_time = Sys.time() in let res = PDIVIDES vars sgns mat_thm div_thms in pdivides_timer +.= (Sys.time() -. start_time); res;; (* PDIVIDES vars sgns p let q = (ith 2 qs) let vars = [`x:real`;`y:real`];; let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 < &0`];; let q = rhs(concl (POLYNATE_CONV vars `x * y`));; let p = rhs(concl (POLYNATE_CONV vars `&1 + y * x * x + x * x * x * &5 * y`));; PDIVIDE vars p q;; PDIVIDES vars sgns p q;; let vars = [`x:real`;`y:real`];; let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 > &0`];; let q = rhs(concl (POLYNATE_CONV vars `x * x * y`));; let p = rhs(concl (POLYNATE_CONV vars `&1 + x * x + x * x * x * y`));; PDIVIDE vars p q;; PDIVIDES vars sgns p q;; let vars = [`x:real`;`y:real`];; let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 < &0`];; let q = rhs(concl (POLYNATE_CONV vars `x * x * y`));; let p = rhs(concl (POLYNATE_CONV vars `&1 + x * x + x * x * x * y`));; PDIVIDE vars p q;; PDIVIDES vars sgns p q;; let vars = [`x:real`;`y:real`];; let sgns = [ASSUME `&0 + y * &1 < &0`];; let q = rhs(concl (POLYNATE_CONV vars `-- x:real`));; let p = rhs(concl (POLYNATE_CONV vars `x * x * y`));; PDIVIDE vars p q;; PDIVIDES vars sgns p q let vars = [`x:real`;`y:real`];; let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 <> &0`];; let q = rhs(concl (POLYNATE_CONV vars `x * x * y`));; let p = rhs(concl (POLYNATE_CONV vars `&1 + x * x + x * x * x * y`));; PDIVIDE vars p q;; PDIVIDES vars sgns p q;; *) hol-light/Rqe/pdivides_thms.ml000066400000000000000000000025561303454263000167000ustar00rootroot00000000000000let neg_odd_lem = prove_by_refinement( `!a n p c q d. (a pow n * p x = c x * q x + d x) ==> ODD n ==> ((-- a) pow n * p x = (-- c x) * q x + (-- d x))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[REAL_ARITH `-- x * y = -- (x * y)`]; REWRITE_TAC[REAL_ARITH `-- x + -- y = -- (x + y)`]; CLAIM `-- a pow n = -- (a pow n)`; DISJ_CASES_TAC (ARITH_RULE `a < &0 \/ (a = &0) \/ a > &0`); MP_TAC (ISPECL[`a:real`;`n:num`] REAL_POW_NEG); ASM_REWRITE_TAC[GSYM NOT_ODD]; POP_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[real_pow]; CLAIM `~(n = 0)`; ASM_MESON_TAC[ODD]; STRIP_TAC; CLAIM `?n'. n = SUC n'`; ASM_MESON_TAC[num_CASES]; STRIP_TAC; ASM_REWRITE_TAC[real_pow]; REAL_ARITH_TAC; MP_TAC (ISPECL[`a:real`;`n:num`] REAL_POW_NEG); ASM_REWRITE_TAC[GSYM NOT_ODD]; STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[ARITH_RULE `-- x * y = -- (x * y)`]; REWRITE_TAC[ARITH_RULE `(-- x = -- y) <=> (x = y)`]; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let mul_odd_lem = prove_by_refinement( `!a n p c q d. (a pow n * p x = c x * q x + d x) ==> ODD n ==> ((a * a pow n) * p x = (a * c x) * q x + (a * d x))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[REAL_ARITH `(a * x) * y = a * (x * y)`]; REWRITE_TAC[REAL_ARITH `a * x + a * y = a * (x + y)`]; AP_TERM_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) hol-light/Rqe/poly_ext.ml000066400000000000000000000642761303454263000157100ustar00rootroot00000000000000let poly_tm = `poly`;; let dest_poly tm = let poly,[l;var] = strip_ncomb 2 tm in if not (poly = poly_tm) then failwith "dest_poly: not a poly" else l,var;; let is_poly tm = fst (strip_comb tm) = `poly`;; (* ------------------------------------------------------------------------- *) (* Get the lead variable in polynomial; &1 if a constant. *) (* ------------------------------------------------------------------------- *) let polyvar = let dummy_tm = `&1` in fun tm -> if is_ratconst tm then dummy_tm else lhand(rand tm);; (* let k00 = `&3 * x * y pow 2 + &2 * x pow 2 * y * z + z * x + &3 * y * z` let k0 = `(&0 + y * (&0 + z * &3)) + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))`;; # polyvar k0;; val it : Term.term = `x` *) (* ---------------------------------------------------------------------- *) (* Is a constant polynomial (wrt variable ordering) *) (* ---------------------------------------------------------------------- *) let is_constant vars p = assert (not (vars = [])); try let l,r = dest_plus p in let x,r2 = dest_mult r in if x = hd vars then false else true with _ -> if p = hd vars then false else true;; (* ------------------------------------------------------------------------- *) (* We only use this as a handy way to do derivatives. *) (* ------------------------------------------------------------------------- *) let POLY = prove (`(poly [] x = &0) /\ (poly [__c__] x = __c__) /\ (poly (CONS __h__ __t__) x = __h__ + x * poly __t__ x)`, REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Convert in and out of list representations. *) (* ------------------------------------------------------------------------- *) (* THIS IS BAD CODE!!! It depends on the names of the variables in POLY *) let POLY_ENLIST_CONV vars = let lem = GEN rx POLY in let [cnv_0; cnv_1; cnv_2] = map (fun th -> GEN_REWRITE_CONV I [GSYM th]) (CONJUNCTS (ISPEC (hd vars) lem)) and zero_tm = rzero in let rec conv tm = if polyvar tm = hd vars then (funpow 2 RAND_CONV conv THENC cnv_2) tm else if tm = zero_tm then cnv_0 tm else cnv_1 tm in conv;; (* map GSYM (CONJUNCTS (ISPEC (hd vars) lem)) POLY_ENLIST_CONV vars p in let tm = `&0 + c * &1` POLY_ENLIST_CONV vars tm #trace conv POLY_ENLIST_CONV vars tm let vars = [ry;rx] let tm = `&0 + y * (&0 + x * &1)` let k1 = rhs(concl (POLY_ENLIST_CONV [`x:real`;`y:real`;`z:real`] k0));; POLY_ENLIST_CONV [`x:real`;`y:real`;`z:real`] k0;; val it : Hol.thm = |- k0 = poly [&0 + y * (&0 + z * &3); &0 * z * &1 + y * (&0 + y * &3); &0 + y * (&0 + z * &2)] x *) let POLY_DELIST_CONV = let [cnv_0; cnv_1; cnv_2] = map (fun th -> GEN_REWRITE_CONV I [th]) (CONJUNCTS POLY) in let rec conv tm = (cnv_0 ORELSEC cnv_1 ORELSEC (cnv_2 THENC funpow 2 RAND_CONV conv)) tm in conv;; (* # POLY_DELIST_CONV `poly [&5; &6; &7] x`;; val it : Hol.thm = |- poly [&5; &6; &7] x = &5 + x * (&6 + x * &7) *) (* ------------------------------------------------------------------------- *) (* Differentiation within list representation. *) (* ------------------------------------------------------------------------- *) (* let poly_diff_aux = new_recursive_definition list_RECURSION *) (* `(poly_diff_aux n [] = []) /\ *) (* (poly_diff_aux n (CONS h t) = CONS (&n * h) (poly_diff_aux (SUC n) t))`;; *) (* let poly_diff = new_definition *) (* `poly_diff l = if l = [] then [] else poly_diff_aux 1 (TL l)`;; *) let POLY_DIFF_CLAUSES = prove (`(poly_diff [] = []) /\ (poly_diff [c] = []) /\ (poly_diff (CONS h t) = poly_diff_aux 1 t)`, REWRITE_TAC[poly_diff; NOT_CONS_NIL; HD; TL; poly_diff_aux]);; let POLY_DIFF_LEMMA = prove (`!l n x. ((\x. (x pow (SUC n)) * poly l x) diffl ((x pow n) * poly (poly_diff_aux (SUC n) l) x))(x)`, (* {{{ Proof *) LIST_INDUCT_TAC THEN REWRITE_TAC[poly; poly_diff_aux; REAL_MUL_RZERO; DIFF_CONST] THEN MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN REWRITE_TAC[REAL_LDISTRIB; REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 pow))] THEN POP_ASSUM(MP_TAC o SPECL [`SUC n`; `x:real`]) THEN SUBGOAL_THEN `(((\x. (x pow (SUC n)) * h)) diffl ((x pow n) * &(SUC n) * h))(x)` (fun th -> DISCH_THEN(MP_TAC o CONJ th)) THENL [REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MP_TAC(SPEC `\x. x pow (SUC n)` DIFF_CMUL) THEN BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN MP_TAC(SPEC `SUC n` DIFF_POW) THEN REWRITE_TAC[SUC_SUB1] THEN DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[REAL_MUL_SYM]); DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC]]);; (* }}} *) let POLY_DIFF = prove (`!l x. ((\x. poly l x) diffl (poly (poly_diff l) x))(x)`, (* {{{ Proof *) LIST_INDUCT_TAC THEN REWRITE_TAC[POLY_DIFF_CLAUSES] THEN ONCE_REWRITE_TAC[SYM(ETA_CONV `\x. poly l x`)] THEN REWRITE_TAC[poly; DIFF_CONST] THEN MAP_EVERY X_GEN_TAC [`x:real`] THEN MP_TAC(SPECL [`t:(real)list`; `0`; `x:real`] POLY_DIFF_LEMMA) THEN REWRITE_TAC[SYM(num_CONV `1`)] THEN REWRITE_TAC[pow; REAL_MUL_LID] THEN REWRITE_TAC[POW_1] THEN DISCH_THEN(MP_TAC o CONJ (SPECL [`h:real`; `x:real`] DIFF_CONST)) THEN DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID]);; (* }}} *) let CANON_POLY_DIFF_CONV = let aux_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_diff_aux] and aux_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_diff_aux] and diff_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_DIFF_CLAUSES)) and diff_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_DIFF_CLAUSES)] in let rec POLY_DIFF_AUX_CONV tm = (aux_conv0 ORELSEC (aux_conv1 THENC RAND_CONV (LAND_CONV NUM_SUC_CONV THENC POLY_DIFF_AUX_CONV))) tm in diff_conv0 ORELSEC (diff_conv1 THENC POLY_DIFF_AUX_CONV);; (* # POLY_DIFF_CONV (mk_comb(`poly_diff`,k2));; val it : Hol.thm = |- poly_diff k2 = [&1 * (&0 * z * &1 + y * (&0 + y * &3)); &2 * (&0 + y * (&0 + z * &2))] *) (* ------------------------------------------------------------------------- *) (* Whether the first of two items comes earlier in the list. *) (* ------------------------------------------------------------------------- *) let rec earlier l x y = match l with h::t -> if h = y then false else if h = x then true else earlier t x y | [] -> false;; (* ------------------------------------------------------------------------- *) (* Add polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_ADD_CONV = let [cnv_r; cnv_l; cnv_2; cnv_0] = (map REWR_CONV o CONJUNCTS o REAL_ARITH) `(pol1 + (d + y * q) = (pol1 + d) + y * q) /\ ((c + x * p) + pol2 = (c + pol2) + x * p) /\ ((c + x * p) + (d + x * q) = (c + d) + x * (p + q)) /\ (c + x * &0 = c)` and dest_add = dest_binop `(+)` in let rec POLY_ADD_CONV vars tm = let pol1,pol2 = dest_add tm in let x = polyvar pol1 and y = polyvar pol2 in if not(is_var x) && not(is_var y) then REAL_RAT_REDUCE_CONV tm else if not(is_var y) || earlier vars x y then (cnv_l THENC LAND_CONV (POLY_ADD_CONV vars)) tm else if not(is_var x) || earlier vars y x then (cnv_r THENC LAND_CONV (POLY_ADD_CONV vars)) tm else (cnv_2 THENC COMB_CONV(RAND_CONV(POLY_ADD_CONV vars)) THENC TRY_CONV cnv_0) tm in POLY_ADD_CONV;; (* # POLY_ADD_CONV [`x:real`;`y:real`;`z:real`] (mk_binop `(+)` k0 k0) ;; val it : Hol.thm = |- ((&0 + y * (&0 + z * &3)) + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) + (&0 + y * (&0 + z * &3)) + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2))) = (&0 + y * (&0 + z * &6)) + x * (((&0 + z * &2) + y * (&0 + y * &6)) + x * (&0 + y * (&0 + z * &4))) *) (* ------------------------------------------------------------------------- *) (* Negate polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_NEG_CONV = let cnv = REWR_CONV(REAL_ARITH `--(c + x * p) = --c + x * --p`) in let rec POLY_NEG_CONV tm = if is_ratconst(rand tm) then REAL_RAT_NEG_CONV tm else (cnv THENC COMB_CONV(RAND_CONV POLY_NEG_CONV)) tm in POLY_NEG_CONV;; (* ------------------------------------------------------------------------- *) (* Subtract polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_SUB_CONV = let cnv = REWR_CONV real_sub in fun vars -> cnv THENC RAND_CONV POLY_NEG_CONV THENC POLY_ADD_CONV vars;; (* ------------------------------------------------------------------------- *) (* Multiply polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_MUL_CONV = let [cnv_l1; cnv_r1; cnv_2; cnv_l0; cnv_r0] = (map REWR_CONV o CONJUNCTS o REAL_ARITH) `(pol1 * (d + y * q) = (pol1 * d) + y * (pol1 * q)) /\ ((c + x * p) * pol2 = (c * pol2) + x * (p * pol2)) /\ (pol1 * (d + x * q) = pol1 * d + (&0 + x * pol1 * q)) /\ (&0 * pol2 = &0) /\ (pol1 * &0 = &0)` and dest_mul = dest_binop `( * )` and zero_tm = `&0` in let rec POLY_MUL_CONV vars tm = let pol1,pol2 = dest_mul tm in if pol1 = zero_tm then cnv_l0 tm else if pol2 = zero_tm then cnv_r0 tm else if is_ratconst pol1 && is_ratconst pol2 then REAL_RAT_MUL_CONV tm else let x = polyvar pol1 and y = polyvar pol2 in if not(is_var y) || earlier vars x y then (cnv_r1 THENC COMB_CONV(RAND_CONV(POLY_MUL_CONV vars))) tm else if not(is_var x) || earlier vars y x then (cnv_l1 THENC COMB_CONV(RAND_CONV(POLY_MUL_CONV vars))) tm else (cnv_2 THENC COMB2_CONV (RAND_CONV(POLY_MUL_CONV vars)) (funpow 2 RAND_CONV (POLY_MUL_CONV vars)) THENC POLY_ADD_CONV vars) tm in POLY_MUL_CONV;; (* # POLY_MUL_CONV [`x:real`;`y:real`;`z:real`] (mk_binop `( * )` k0 k0) ;; val it : Hol.thm = |- ((&0 + y * (&0 + z * &3)) + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) * ((&0 + y * (&0 + z * &3)) + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) = (&0 + y * (&0 + y * (&0 + z * (&0 + z * &9)))) + x * ((&0 + y * ((&0 + z * (&0 + z * &6)) + y * (&0 + y * (&0 + z * &18)))) + x * (((&0 + z * (&0 + z * &1)) + y * (&0 + y * ((&0 + z * (&6 + z * &12)) + y * (&0 + y * &9)))) + x * ((&0 + y * ((&0 + z * (&0 + z * &4)) + y * (&0 + y * (&0 + z * &12)))) + x * (&0 + y * (&0 + y * (&0 + z * (&0 + z * &4))))))) *) (* ------------------------------------------------------------------------- *) (* Exponentiate polynomials. *) (* ------------------------------------------------------------------------- *) let POLY_POW_CONV = let [cnv_0; cnv_1] = map REWR_CONV (CONJUNCTS real_pow) and zero_tm = `0` in let rec POLY_POW_CONV vars tm = if rand tm = zero_tm then cnv_0 tm else (RAND_CONV num_CONV THENC cnv_1 THENC RAND_CONV (POLY_POW_CONV vars) THENC POLY_MUL_CONV vars) tm in POLY_POW_CONV;; (* # POLY_POW_CONV [`x:real`;`y:real`;`z:real`] (mk_binop `(pow)` k0 `2`) ;; val it : Hol.thm = |- ((&0 + y * (&0 + z * &3)) + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) pow 2 = (&0 + y * (&0 + y * (&0 + z * (&0 + z * &9)))) + x * ((&0 + y * ((&0 + z * (&0 + z * &6)) + y * (&0 + y * (&0 + z * &18)))) + x * (((&0 + z * (&0 + z * &1)) + y * (&0 + y * ((&0 + z * (&6 + z * &12)) + y * (&0 + y * &9)))) + x * ((&0 + y * ((&0 + z * (&0 + z * &4)) + y * (&0 + y * (&0 + z * &12)))) + x * (&0 + y * (&0 + y * (&0 + z * (&0 + z * &4))))))) *) (* ------------------------------------------------------------------------- *) (* Convert expression to canonical polynomials. *) (* ------------------------------------------------------------------------- *) let POLYNATE_CONV = let cnv_var = REWR_CONV(REAL_ARITH `x = &0 + x * &1`) and cnv_div = REWR_CONV real_div and neg_tm = `(--)` and add_tm = `(+)` and sub_tm = `(-)` and mul_tm = `( * )` and pow_tm = `(pow)` and div_tm = `(/)` in let rec POLYNATE_CONV vars tm = if is_var tm then cnv_var tm else if is_ratconst tm then REFL tm else let lop,r = dest_comb tm in if lop = neg_tm then (RAND_CONV(POLYNATE_CONV vars) THENC POLY_NEG_CONV) tm else let op,l = dest_comb lop in if op = pow_tm then (LAND_CONV(POLYNATE_CONV vars) THENC POLY_POW_CONV vars) tm else if op = div_tm then (cnv_div THENC COMB2_CONV (RAND_CONV(POLYNATE_CONV vars)) REAL_RAT_REDUCE_CONV THENC POLY_MUL_CONV vars) tm else let cnv = if op = add_tm then POLY_ADD_CONV else if op = sub_tm then POLY_SUB_CONV else if op = mul_tm then POLY_MUL_CONV else failwith "POLYNATE_CONV: unknown operation" in (BINOP_CONV (POLYNATE_CONV vars) THENC cnv vars) tm in POLYNATE_CONV;; (* POLYNATE_CONV [`x:real`;`y:real`] `x + y`;; POLYNATE_CONV [`x:real`;`y:real`] `x * y + &2 * y`;; *) (* ------------------------------------------------------------------------- *) (* Pure term manipulation versions; will optimize eventually. *) (* ------------------------------------------------------------------------- *) let poly_add_ = let add_tm = `(+)` in fun vars p1 p2 -> rand(concl(POLY_ADD_CONV vars (mk_comb(mk_comb(add_tm,p1),p2))));; let poly_sub_ = let sub_tm = `(-)` in fun vars p1 p2 -> rand(concl(POLY_SUB_CONV vars (mk_comb(mk_comb(sub_tm,p1),p2))));; let poly_mul_ = let mul_tm = `( * )` in fun vars p1 p2 -> rand(concl(POLY_MUL_CONV vars (mk_comb(mk_comb(mul_tm,p1),p2))));; let poly_neg_ = let neg_tm = `(--)` in fun p -> rand(concl(POLY_NEG_CONV(mk_comb(neg_tm,p))));; let poly_pow_ = let pow_tm = `(pow)` in fun vars p k -> rand(concl(POLY_POW_CONV vars (mk_comb(mk_comb(pow_tm,p),mk_small_numeral k))));; (* ------------------------------------------------------------------------- *) (* Get the degree of a polynomial. *) (* ------------------------------------------------------------------------- *) let rec degree_ vars tm = if polyvar tm = hd vars then 1 + degree_ vars (funpow 2 rand tm) else 0;; (* ------------------------------------------------------------------------- *) (* Get the list of coefficients. *) (* ------------------------------------------------------------------------- *) let rec coefficients vars tm = if polyvar tm = hd vars then (lhand tm)::coefficients vars (funpow 2 rand tm) else [tm];; (* ------------------------------------------------------------------------- *) (* Get the head constant. *) (* ------------------------------------------------------------------------- *) let head vars p = last(coefficients vars p);; (* ---------------------------------------------------------------------- *) (* Remove the head coefficient *) (* ---------------------------------------------------------------------- *) let rec behead vars tm = try let c,r = dest_plus tm in let x,p = dest_mult r in if not (x = hd vars) then failwith "" else let p' = behead vars p in if p' = rzero then c else mk_plus c (mk_mult x p') with _ -> rzero;; (* behead [`x:real`] `&1 + x * (&1 + x * (&0 + y * &1))` *) let BEHEAD = let lem = ARITH_RULE `a + b * &0 = a` in fun vars zthm tm -> let tm' = behead vars tm in (* note: pure rewrite is ok here, as tm is in canonical form *) let thm1 = PURE_REWRITE_CONV[zthm] tm in let thm2 = PURE_REWRITE_CONV[lem] (rhs(concl thm1)) in let thm3 = TRANS thm1 thm2 in thm3;; let BEHEAD3 = let lem = ARITH_RULE `a + b * &0 = a` in fun vars zthm tm -> let tm' = behead vars tm in (* note slight hack here: BEHEAD was working fine if p = a + x * b where a <> b. But when they were equal, dropping multiple levels broke the reconstruction. Thus, we only do conversion on the right except when the head variable has been fully eliminated *) let conv = let l,r = dest_binop rp tm in let l1,r1 = dest_binop rm r in if l1 = hd vars then RAND_CONV(PURE_ONCE_REWRITE_CONV[zthm]) else PURE_ONCE_REWRITE_CONV[zthm] in let thm1 = conv tm in let thm2 = PURE_REWRITE_CONV[lem] (rhs(concl thm1)) in let thm3 = TRANS thm1 thm2 in thm3;; let BEHEAD = BEHEAD3;; (* let vars = [`z:real`;`x:real`] let zthm = (ASSUME `&0 + x * &1 = &0`) let tm = `(&0 + x * &1) + z * (&0 + x * &1)` behead vars tm BEHEAD vars zthm tm BEHEAD2 vars zthm tm BEHEAD3 vars zthm tm let tm = `(&0 + x * &1)` BEHEAD3 vars zthm tm let vars = [`x:real`] let tm = `&1 + x * (&1 + x * (&0 + y * &1))` let zthm = (ASSUME `&0 + y * &1 = &0`) BEHEAD vars zthm tm BEHEAD2 vars zthm tm *) (* ------------------------------------------------------------------------- *) (* Test whether a polynomial is a constant w.r.t. the head variable. *) (* ------------------------------------------------------------------------- *) let is_const_poly vars tm = polyvar tm <> hd vars;; (* ------------------------------------------------------------------------- *) (* Get the constant multiple of the "maximal" monomial (implicit lex order) *) (* ------------------------------------------------------------------------- *) let rec headconst p = try rat_of_term p with Failure _ -> headconst(funpow 2 rand p);; (* ------------------------------------------------------------------------- *) (* Monicize; return |- const * pol = monic-pol *) (* ------------------------------------------------------------------------- *) let MONIC_CONV = let mul_tm = `( * ):real->real->real` in fun vars p -> let c = Int 1 // headconst p in POLY_MUL_CONV vars (mk_comb(mk_comb(mul_tm,term_of_rat c),p));; (* ------------------------------------------------------------------------- *) (* Pseudo-division of s by p; head coefficient of p assumed nonzero. *) (* Returns |- a^k s = p q + r for some q and r with deg(r) < deg(p). *) (* Optimized only for the trivial case of equal head coefficients; no GCDs. *) (* ------------------------------------------------------------------------- *) let PDIVIDE = let zero_tm = `&0` and add0_tm = `(+) (&0)` and add_tm = `(+)` and mul_tm = `( * )` and pow_tm = `(pow)` and one_tm = `&1` in let mk_varpow vars k = let mulx_tm = mk_comb(mul_tm,hd vars) in funpow k (fun t -> mk_comb(add0_tm,mk_comb(mulx_tm,t))) one_tm in let rec pdivide_aux vars a n p s = if s = zero_tm then (0,zero_tm,s) else let b = head vars s and m = degree_ vars s in if m < n then (0,zero_tm,s) else let xp = mk_varpow vars (m - n) in let p' = poly_mul_ vars xp p in if a = b then let (k,q,r) = pdivide_aux vars a n p (poly_sub_ vars s p') in (k,poly_add_ vars q (poly_mul_ vars xp (poly_pow_ vars a k)),r) else let (k,q,r) = pdivide_aux vars a n p (poly_sub_ vars (poly_mul_ vars a s) (poly_mul_ vars b p')) in let q' = poly_add_ vars q (poly_mul_ vars b (poly_mul_ vars (poly_pow_ vars a k) xp)) in (k+1,q',r) in fun vars s p -> let a = head vars p in let (k,q,r) = pdivide_aux vars a (degree_ vars p) p s in let th1 = POLY_MUL_CONV vars (mk_comb(mk_comb(mul_tm,q),p)) in let th2 = AP_THM (AP_TERM add_tm th1) r in let th3 = CONV_RULE(RAND_CONV(POLY_ADD_CONV vars)) th2 in let th4 = POLY_POW_CONV vars (mk_comb(mk_comb(pow_tm,a),mk_small_numeral k)) in let th5 = AP_THM (AP_TERM mul_tm th4) s in let th6 = CONV_RULE(RAND_CONV(POLY_MUL_CONV vars)) th5 in TRANS th6 (GSYM th3);; (* ------------------------------------------------------------------------- *) (* Produce sign theorem for rational constant. *) (* ------------------------------------------------------------------------- *) let SIGN_CONST = let zero = Int 0 and zero_tm = `&0` and eq_tm = `(=):real->real->bool` and gt_tm = `(>):real->real->bool` and lt_tm = `(<):real->real->bool` in fun tm -> let x = rat_of_term tm in if x =/ zero then EQT_ELIM(REAL_RAT_EQ_CONV(mk_comb(mk_comb(eq_tm,tm),zero_tm))) else if x >/ zero then EQT_ELIM(REAL_RAT_GT_CONV(mk_comb(mk_comb(gt_tm,tm),zero_tm))) else EQT_ELIM(REAL_RAT_LT_CONV(mk_comb(mk_comb(lt_tm,tm),zero_tm)));; (* SIGN_CONST `-- &5`;; val it : Hol.thm = |- &5 > &0 *) (* ------------------------------------------------------------------------- *) (* Differentiation conversion in main representation. *) (* ------------------------------------------------------------------------- *) let POLY_DERIV_CONV = let poly_diff_tm = `poly_diff` and pth = GEN_REWRITE_RULE I [SWAP_FORALL_THM] POLY_DIFF in fun vars tm -> let th1 = POLY_ENLIST_CONV vars tm in let th2 = SPECL [hd vars; lhand(rand(concl th1))] pth in CONV_RULE(RATOR_CONV (COMB2_CONV (RAND_CONV(ABS_CONV(POLY_DELIST_CONV))) (LAND_CONV(CANON_POLY_DIFF_CONV THENC LIST_CONV (POLY_MUL_CONV vars)) THENC POLY_DELIST_CONV))) th2;; (* let k0 = (rhs o concl) (POLYNATE_CONV [`x:real`] `x pow 2 * y`);; let vars = [`x:real`] let tm = k0 let k1 = concl th2 let k2 = rator k1 let l,r = dest_comb k2 RATOR_CONV (RAND_CONV(ABS_CONV(POLY_DELIST_CONV))) l (LAND_CONV(POLY_DIFF_CONV THENC LIST_CONV (CANON_POLY_MUL_CONV vars)) THENC POLY_DELIST_CONV) r (LAND_CONV(POLY_DIFF_CONV THENC LIST_CONV (CANON_POLY_MUL_CONV vars))) r (LAND_CONV(POLY_DIFF_CONV)) r POLY_DERIV_CONV [`x:real`] (rhs(concl((POLYNATE_CONV [`x:real`] `x pow 2 * y`))));; val it : Hol.thm = |- ((\x. &0 + x * (&0 + x * (&0 + y * &1))) diffl &0 + x * (&0 + y * &2)) x *) (* ---------------------------------------------------------------------- *) (* POLYATOM_CONV *) (* ---------------------------------------------------------------------- *) (* This is the AFN_CONV argument to the lifting function LIFT_QELIM_CONV *) let lt_lem = prove_by_refinement( `!x y. x < y <=> x - y < &0`, (* {{{ Proof *) [ REAL_ARITH_TAC; ]);; (* }}} *) let le_lem = prove_by_refinement( `!x y. x <= y <=> x - y <= &0`, (* {{{ Proof *) [ REAL_ARITH_TAC; ]);; (* }}} *) let eq_lem = prove_by_refinement( `!x y. (x = y) <=> (x - y = &0)`, (* {{{ Proof *) [ REAL_ARITH_TAC; ]);; (* }}} *) let POLYATOM_CONV vars tm = let thm1 = ONCE_REWRITE_CONV[real_gt;real_ge;eq_lem] tm in let l,r = dest_eq (concl thm1) in let thm2 = ONCE_REWRITE_CONV[lt_lem;le_lem] r in let op,l',r' = get_binop (rhs (concl thm2)) in let thm3a = POLYNATE_CONV vars l' in let thm3b = AP_TERM op thm3a in let thm3 = AP_THM thm3b rzero in end_itlist TRANS [thm1;thm2;thm3];; (* let k0 = `x pow 2 + y * x - &5 > x + &10` let k0 = `x pow 2 + y * x - &5 >= x + &10` let k0 = `x pow 2 + y * x - &5 < x + &10` let k0 = `x pow 2 + y * x - &5 <= x + &10` let k0 = `x pow 2 + y * x - &5 = x + &10` let tm = k0;; let vars = [`x:real`;`y:real`] POLYATOM_CONV vars k0 let vars = [`e:real`; `k:real`;`f:real`;`a:real`] prioritize_real() let tm = `k < e` let liouville = `&6 * (w pow 2 + x pow 2 + y pow 2 + z pow 2) pow 2 = (((w + x) pow 4 + (w + y) pow 4 + (w + z) pow 4 + (x + y) pow 4 + (x + z) pow 4 + (y + z) pow 4) + ((w - x) pow 4 + (w - y) pow 4 + (w - z) pow 4 + (x - y) pow 4 + (x - z) pow 4 + (y - z) pow 4))` let lvars = [`w:real`;`x:real`;`y:real`; `z:real`] POLYATOM_CONV lvars liouville *) (* ---------------------------------------------------------------------- *) (* Factoring *) (* ---------------------------------------------------------------------- *) let weakfactor x pol = let rec weakfactor k x pol = try let ls,rs = dest_plus pol in if not (ls = rzero) then failwith "" else let lm,rm = dest_mult rs in if not (lm = x) then failwith "" else weakfactor (k + 1) x rm with Failure _ -> k,pol in weakfactor 0 x pol;; let poly_var x = mk_plus rzero (mk_mult x rone);; (* poly_var rx *) let POW_PROD_SUM = prove_by_refinement( `!x n m. (x pow n) * x pow m = x pow (n + m)`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC; REWRITE_TAC[real_pow]; NUM_SIMP_TAC; REAL_SIMP_TAC; REWRITE_TAC[real_pow]; REWRITE_TAC[ARITH_RULE `n + SUC m = SUC (n + m)`]; REWRITE_TAC[real_pow]; POP_ASSUM (SUBST1_TAC o GSYM); REAL_ARITH_TAC; ]);; (* }}} *) let lem1 = REAL_ARITH `x * x = x pow 2`;; let lem2 = GSYM (CONJUNCT2 real_pow);; let lem3 = REAL_ARITH `!x. x = x pow 1`;; let SIMP_POW_CONV tm = let thm1 = ((REWRITE_CONV [GSYM REAL_MUL_ASSOC;lem1;lem2;POW_PROD_SUM]) THENC (ARITH_SIMP_CONV[])) tm in let _,r = dest_eq (concl thm1) in if can dest_pow r then thm1 else let thm2 = ISPEC r lem3 in thm2;; (* SIMP_POW_CONV `x * x * x * x * x` SIMP_POW_CONV `x * x * (x * x) * x` SIMP_POW_CONV `x * (x * (x * x)) *(x * x)` SIMP_POW_CONV `x:real` *) let WEAKFACTOR_CONV x pol = let k,pol' = weakfactor x pol in let thm1 = ((itlist2 (fun x y z -> ((funpow y RAND_CONV) x) THENC z) (replicate (GEN_REWRITE_CONV I [REAL_ADD_LID]) k) (0--(k-1)) ALL_CONV) THENC (PURE_REWRITE_CONV[REAL_MUL_ASSOC])) pol in let thm2 = (CONV_RULE (RAND_CONV (LAND_CONV SIMP_POW_CONV))) thm1 in thm2;; (* let pol = `&0 + x * (&0 + x * (&0 + y * &1))` let pol = `&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + y * &1))))))` let pol = `&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + x * (&1 + x * (&0 + y * &1))))))` let pol = `&1 + x * (&0 + x * (&0 + y * &1))` let pol = `&0 + x * (&1 + x * (&0 + y * &1))` WEAKFACTOR_CONV rx pol weakfactor rx pol *) hol-light/Rqe/rewrites.ml000066400000000000000000000033661303454263000157020ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Num *) (* ---------------------------------------------------------------------- *) let NUM_REWRITES = ref [ LT_TRANS; LET_TRANS; LTE_TRANS; LE_TRANS; GT; GE; PRE; ARITH_RULE `x + 0 = x`; ARITH_RULE `0 + x = x`; ARITH_RULE `1 * x = x`; ARITH_RULE `x * 1 = x`; ];; let NUM_SIMP_TAC = REWRITE_TAC !NUM_REWRITES;; let extend_num_rewrites l = NUM_REWRITES := !NUM_REWRITES @ l;; (* ---------------------------------------------------------------------- *) (* Real *) (* ---------------------------------------------------------------------- *) (* search [`(pow)`;rp] *) let REAL_REWRITES = ref [ REAL_MUL_LID; REAL_MUL_RID; REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_LT_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS; REAL_LE_TRANS; REAL_LE_MUL; REAL_NOT_LT; REAL_LT_REFL; REAL_LE_REFL; REAL_ADD_RID; REAL_ADD_LID; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB; REAL_NEG_0; REAL_NEG_MUL2; REAL_OF_NUM_LT; REAL_MAX_MAX; real_pow; REAL_ARITH `x - &0 = x`; REAL_NOT_LT; REAL_NOT_LE; REAL_INV_INV; REAL_INV_MUL; real_gt; real_ge; REAL_POW_1; ARITH_RULE `-- &1 * x = -- x`; ARITH_RULE `-- &1 * -- &1 = &1`; ARITH_RULE `-- (-- x * y) = x * y`; ARITH_RULE `x - x = &0`; REAL_POW_ONE; REAL_NEG_NEG; ];; let REAL_ELIM = ref [ REAL_LT_INV; REAL_ADD_SYM; REAL_ADD_ASSOC; REAL_MUL_SYM; REAL_MUL_ASSOC; REAL_LT_LE; REAL_LE_LT; real_div; ];; let REAL_SIMP_TAC = REWRITE_TAC ( !REAL_REWRITES );; let REAL_SOLVE_TAC = ASM_MESON_TAC (!REAL_REWRITES @ !REAL_ELIM);; let extend_real_rewrites l = REAL_REWRITES := !REAL_REWRITES @ l;; let BASIC_REWRITES = ref (!REAL_REWRITES @ !NUM_REWRITES);; hol-light/Rqe/rol.ml000066400000000000000000000405441303454263000146310ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Util *) (* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *) (* Real Ordered Lists *) (* ---------------------------------------------------------------------- *) let real_ordered_list = new_recursive_definition list_RECURSION `(real_ordered_list [] <=> T) /\ (real_ordered_list (CONS h t) <=> real_ordered_list t /\ ((t = []) \/ (h < HD t)))`;; let ROL_EMPTY = EQT_ELIM (CONJUNCT1 real_ordered_list);; let ROL_SING = prove_by_refinement( `!x. real_ordered_list [x]`, (* {{{ Proof *) [ REWRITE_TAC[real_ordered_list]; ]);; (* }}} *) let ROL_TAIL = prove( `!l. ~(l = []) /\ real_ordered_list l ==> real_ordered_list (TL l)`, (* {{{ Proof *) LIST_INDUCT_TAC THEN MESON_TAC[real_ordered_list;TL]; );; (* }}} *) let EL_CONS = prove_by_refinement( `!l h n. EL n t = EL (SUC n) (CONS h t)`, (* {{{ Proof *) [ MESON_TAC[TL;EL]; ]);; (* }}} *) let NOT_ROL = prove_by_refinement( `!l. ~(real_ordered_list l) ==> ?n. EL n l >= EL (SUC n) l`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[real_ordered_list]; REWRITE_TAC[real_ordered_list;DE_MORGAN_THM]; STRIP_TAC; POP_ASSUM (fun x -> POP_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); STRIP_TAC; EXISTS_TAC `SUC n`; ASM_MESON_TAC[EL_CONS]; EXISTS_TAC `0`; REWRITE_TAC[EL;HD;TL;real_ge]; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let ROL_CONS = prove_by_refinement( `!h t. real_ordered_list (CONS h t) ==> real_ordered_list t`, (* {{{ Proof *) [ REWRITE_TAC[real_ordered_list]; REPEAT STRIP_TAC; ]);; (* }}} *) let ROL_CONS_CONS = prove_by_refinement( `!h t. real_ordered_list (CONS h1 (CONS h2 t)) <=> real_ordered_list (CONS h2 t) /\ h1 < h2`, (* {{{ Proof *) [ REPEAT GEN_TAC; EQ_TAC; REWRITE_TAC[real_ordered_list]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL;HD]; ASM_MESON_TAC[NOT_CONS_NIL]; ASM_MESON_TAC[HD]; ASM_MESON_TAC[NOT_CONS_NIL]; ASM_MESON_TAC[HD]; REWRITE_TAC[real_ordered_list]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL;HD]; ]);; (* }}} *) let ROL_APPEND = prove_by_refinement( `!l1 l2. real_ordered_list (APPEND l1 l2) ==> real_ordered_list l1 /\ real_ordered_list l2`, (* {{{ Proof *) [ LIST_INDUCT_TAC; MESON_TAC[APPEND;real_ordered_list]; GEN_TAC; REWRITE_TAC[APPEND]; STRIP_TAC; CLAIM `real_ordered_list (APPEND t l2)`; ASM_MESON_TAC[ROL_CONS]; STRIP_TAC; CLAIM `real_ordered_list t /\ real_ordered_list l2`; ASM_MESON_TAC[]; STRIP_TAC; ASM_REWRITE_TAC[]; CASES_ON `t = []`; ASM_MESON_TAC[real_ordered_list]; POP_ASSUM MP_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC; ASM_REWRITE_TAC[ROL_CONS_CONS]; CONJ_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; USE_THEN "Z-4" MP_TAC; POP_ASSUM SUBST1_TAC; REWRITE_TAC[APPEND]; ASM_MESON_TAC[ROL_CONS_CONS]; ]);; (* }}} *) let ROL_CONS_CONS_LT = prove_by_refinement( `!h1 h2 t. real_ordered_list (CONS h1 (CONS h2 t)) ==> h1 < h2`, (* {{{ Proof *) [ REWRITE_TAC[real_ordered_list]; REPEAT STRIP_TAC THEN ASM_MESON_TAC[NOT_CONS_NIL;HD]; ]);; (* }}} *) let ROL_INSERT_THM = prove_by_refinement( `!x l1 l2. real_ordered_list l1 /\ real_ordered_list l2 /\ ~(l1 = []) /\ ~(l2 = []) /\ LAST l1 < x /\ x < HD l2 ==> real_ordered_list (APPEND l1 (CONS x l2))`, (* {{{ Proof *) [ GEN_TAC; LIST_INDUCT_TAC; REWRITE_TAC[APPEND]; CASES_ON `t = []`; ASM_REWRITE_TAC[APPEND;LAST_SING;NOT_CONS_NIL]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[ROL_CONS_CONS;real_ordered_list]; POP_ASSUM MP_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; CLAIM `real_ordered_list (APPEND t (CONS x l2))`; REWRITE_ASSUMS[TAUT `(p ==> q ==> r) <=> (p /\ q ==> r)`]; FIRST_ASSUM MATCH_MP_TAC; REPEAT STRIP_TAC; ASM_MESON_TAC[ROL_CONS]; FIRST_ASSUM MATCH_ACCEPT_TAC; ASM_MESON_TAC[NOT_CONS_NIL]; ASM_MESON_TAC[NOT_CONS_NIL]; ASM_MESON_TAC[LAST_CONS;NOT_CONS_NIL]; FIRST_ASSUM MATCH_ACCEPT_TAC; ASM_REWRITE_TAC[]; LABEL_ALL_TAC; USE_THEN "Z-3" (SUBST1_TAC o GSYM); REWRITE_TAC[APPEND]; STRIP_TAC; REWRITE_TAC[ROL_CONS_CONS]; STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ASM_MESON_TAC[ROL_CONS_CONS]; ]);; (* }}} *) let ROL_INSERT_FRONT_THM = prove_by_refinement( `!x l. real_ordered_list l /\ ~(l = []) /\ x < HD l ==> real_ordered_list (CONS x l)`, (* {{{ Proof *) [ REWRITE_TAC[NOT_NIL;AND_IMP_THM]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[ROL_CONS_CONS;HD]; ]);; (* }}} *) let ROL_CONS_CONS_DELETE = prove_by_refinement( `!h1 h2 t. real_ordered_list (CONS h1 (CONS h2 t)) ==> real_ordered_list (CONS h1 t)`, (* {{{ Proof *) [ REWRITE_TAC[real_ordered_list]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[NOT_CONS_NIL]; REWRITE_ASSUMS[HD]; ASM_MESON_TAC[REAL_LT_TRANS]; ]);; (* }}} *) let LAST_CONS_LT = prove_by_refinement( `!x t h. real_ordered_list (CONS h t) /\ LAST (CONS h t) < x ==> h < x`, (* {{{ Proof *) [ GEN_TAC; LIST_INDUCT_TAC; REWRITE_TAC[LAST]; REPEAT STRIP_TAC; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; CONJ_TAC; ASM_MESON_TAC[ROL_CONS_CONS_DELETE]; CASES_ON `t = []`; ASM_REWRITE_TAC[LAST]; ASM_MESON_TAC[LAST;ROL_CONS_CONS;REAL_LT_TRANS]; ASM_MESON_TAC[LAST_CONS;ROL_CONS_CONS_DELETE;LAST_CONS_CONS]; ]);; (* }}} *) let ROL_INSERT_BACK_THM = prove_by_refinement( `!x l. real_ordered_list l /\ ~(l = []) /\ LAST l < x ==> real_ordered_list (APPEND l [x])`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[APPEND;ROL_SING]; LABEL_ALL_TAC; STRIP_TAC; CASES_ON `t = []`; ASM_REWRITE_TAC[APPEND;ROL_CONS_CONS;ROL_SING]; ASM_MESON_TAC[LAST;COND_CLAUSES]; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[ROL_CONS]; ASM_MESON_TAC[]; ASM_MESON_TAC[LAST_CONS]; REWRITE_TAC[APPEND]; REWRITE_TAC[real_ordered_list]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; DISJ2_TAC; REWRITE_ASSUMS[NOT_NIL]; LABEL_ALL_TAC; USE_IASSUM 2 MP_TAC; STRIP_TAC; ASM_REWRITE_TAC[HD_APPEND]; ASM_MESON_TAC[ROL_CONS_CONS]; ]);; (* }}} *) (* CHOP_REAL_LIST 1 `[&1; &2; &3]` --> |- [&1; &2; &3] = APPEND [&1; &2] [&3] let n,l = 1,`[&1; &2; &3]` *) let CHOP_REAL_LIST n l = let l' = dest_list l in let l1',l2' = chop_list n l' in let l1,l2 = mk_list (l1',real_ty),mk_list (l2',real_ty) in let tm = mk_binop rappend l1 l2 in GSYM (REWRITE_CONV [APPEND] tm);; (* ROL_CHOP_LT 2 let n = 1 *) let ROL_CHOP_LT n thm = let thm' = funpow (n - 1) (MATCH_MP ROL_CONS) thm in CONJUNCT2 (PURE_REWRITE_RULE[ROL_CONS_CONS] thm');; let t1 = prove_by_refinement( `real_ordered_list [&1; &2; &3; &4]`, [ REWRITE_TAC[HD;real_ordered_list]; REAL_ARITH_TAC; ]);; (* ROL_CHOP_LIST 2 |- real_ordered_list [&1; &2; &3; &4] --> |- real_ordered_list [&1; &2; &3], |- real_ordered_list [&4], |- &3 < &4 let thm = ASSUME `real_ordered_list [&1; &2; &3; &4]` let n = 2 ROL_CHOP_LIST 2 thm *) let ROL_CHOP_LIST n thm = let _,l = dest_comb (concl thm) in let lthm = CHOP_REAL_LIST n l in let thm' = REWRITE_RULE[lthm] thm in let thm'' = MATCH_MP ROL_APPEND thm' in let [lthm;rthm] = CONJUNCTS thm'' in let lt_thm = ROL_CHOP_LT n thm in lthm,rthm,lt_thm;; (* rol_insert (|- x1 < x4 /\ x4 < x2) (|- real_ordered_list [x1; x2; x3]) --> (|- real_ordered_list [x1; x4; x2; x3]); rol_insert (|- &2 < &5 /\ &5 < &6) (|- real_ordered_list [&1; &2; &6]) --> (|- real_ordered_list [&1; &2; &5; &6]); rol_insert (|- x4 < x1) (|- real_ordered_list [x1; x2; x3]) --> (|- real_ordered_list [x4; x1; x2; x3]); rol_insert (|- x1 < x4) (|- real_ordered_list [x1; x2; x3]) --> (|- real_ordered_list [x1; x2; x3; x4]); *) let lem1 = prove( `!e x l. e < x /\ (LAST l = e) ==> LAST l < x`, MESON_TAC[]);; let ROL_INSERT_MIDDLE place_thm rol_thm = let [pl1;pl2] = CONJUNCTS place_thm in let list = snd(dest_comb(concl rol_thm)) in let new_x,slot = let ltl,ltr = dest_conj (concl place_thm) in let x1,x4 = dest_binop rlt ltl in let _,x2 = dest_binop rlt ltr in let n = (index x1 (dest_list list)) + 1 in x4,n in let lthm,rthm,lt_thm = ROL_CHOP_LIST slot rol_thm in let llist = snd(dest_comb(concl lthm)) in let hllist = hd (dest_list llist) in let tllist = mk_rlist (tl (dest_list llist)) in let rlist = snd(dest_comb(concl rthm)) in let hrlist = hd (dest_list rlist) in let trlist = mk_rlist (tl (dest_list rlist)) in let gthm = REWRITE_RULE[AND_IMP_THM] ROL_INSERT_THM in let a1 = lthm in let a2 = rthm in let a3 = ISPECL [hllist;tllist] NOT_CONS_NIL in let a4 = ISPECL [hrlist;trlist] NOT_CONS_NIL in let l,r = dest_binop rlt (concl pl1) in let a5_aux = prove(mk_eq (mk_comb(rlast,llist),l),REWRITE_TAC[LAST;COND_CLAUSES;NOT_CONS_NIL]) in let a5 = MATCH_MPL [ISPECL [l;r;llist] (REWRITE_RULE[AND_IMP_THM] lem1);pl1;a5_aux] in let a6_aux = ISPECL [trlist;hrlist] (GEN_ALL HD) in let a6 = CONV_RULE (RAND_CONV (ONCE_REWRITE_CONV[GSYM a6_aux])) pl2 in let thm = MATCH_MPL [gthm;a1;a2;a3;a4;a5;a6] in REWRITE_RULE[APPEND] thm;; (* ROL_INSERT_MIDDLE (ASSUME `x1 < x4 /\ x4 < x2`) (ASSUME `real_ordered_list [x1; x2; x3]`);; ROL_INSERT_MIDDLE (ASSUME `x1 < x6 /\ x6 < x2`) (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`);; ROL_INSERT_MIDDLE (ASSUME `x2 < x6 /\ x6 < x3`) (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`);; ROL_INSERT_MIDDLE (ASSUME `x4 < x6 /\ x6 < x5`) (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`);; ROL_INSERT_MIDDLE (ASSUME `x2 < x4 /\ x4 < x3`) (ASSUME `real_ordered_list [x1; x2; x3]`);; *) let ROL_INSERT_FRONT place_thm rol_thm = let _,rlist = dest_comb (concl rol_thm) in let h,t = hd (dest_list rlist),mk_rlist (tl (dest_list rlist)) in let imp_thm = ISPECL [h;t] (GSYM ROL_CONS_CONS) in let imp_thm' = REWRITE_RULE[AND_IMP_THM] (fst (EQ_IMP_RULE imp_thm)) in MATCH_MPL[imp_thm';rol_thm;place_thm];; (* ROL_INSERT_FRONT (ASSUME `x4 < x1`) (ASSUME `real_ordered_list [x1; x2; x3]`);; ROL_INSERT_FRONT (ASSUME `x4 < x1`) (ASSUME `real_ordered_list [x1]`);; *) let ROL_INSERT_BACK place_thm rol_thm = let _,rlist = dest_comb (concl rol_thm) in let rlist' = dest_list rlist in let h,t = hd rlist',mk_rlist (tl rlist') in let lst = last rlist' in let b,x = dest_binop rlt (concl place_thm) in let imp_thm = REWRITE_RULE[AND_IMP_THM] (ISPECL [x;rlist] ROL_INSERT_BACK_THM) in let a1 = rol_thm in let a2 = ISPECL [h;t] NOT_CONS_NIL in let a3_aux = prove(mk_eq (mk_comb(rlast,rlist),lst), REWRITE_TAC[LAST;COND_CLAUSES;NOT_CONS_NIL]) in let a3 = MATCH_MPL [ISPECL [lst;x;rlist] (REWRITE_RULE[AND_IMP_THM] lem1);place_thm;a3_aux] in REWRITE_RULE[APPEND] (MATCH_MPL[imp_thm;a1;a2;a3]);; (* ROL_INSERT_BACK (ASSUME `x3 < x4`) (ASSUME `real_ordered_list [x1; x2; x3]`);; *) let ROL_INSERT place_thm rol_thm = let place_thm' = REWRITE_RULE[real_gt] place_thm in if is_conj (concl place_thm') then ROL_INSERT_MIDDLE place_thm' rol_thm else let _,rlist = dest_comb (concl rol_thm) in let rlist' = dest_list rlist in let h = hd rlist' in let l,r = dest_binop rlt (concl place_thm') in if r = h then ROL_INSERT_FRONT place_thm' rol_thm else ROL_INSERT_BACK place_thm' rol_thm;; (* let k00 = ROL_INSERT (ASSUME `x1 < x4 /\ x4 < x2`) (ASSUME `real_ordered_list [x1; x2; x3]`);; rol_thms k00 PARTITION_LINE_CONV `[x1; x4; x2; x3:real]` ROL_INSERT (ASSUME `x4 < x1`) (ASSUME `real_ordered_list [x1]`);; ROL_INSERT (ASSUME `x3 < x4`) (ASSUME `real_ordered_list [x1; x2; x3]`);; *) (* rol_thms |- real_ordered_list [x;y;z] ---> |- x < y; |- y < z *) let rol_thms rol_thm = let thm = REWRITE_RULE[real_ordered_list;NOT_CONS_NIL;HD] rol_thm in rev(CONJUNCTS thm);; (* let rol_thm = ASSUME `real_ordered_list [x;y;z]` rol_thms rol_thm *) let lem = prove(`!x. ?y. y = x`,MESON_TAC[]);; let rec interleave l1 l2 = match l1 with [] -> l2 | h::t -> match l2 with [] -> l1 | h1::t1 -> h::h1::(interleave t t1);; let lem0 = prove(`?x:real. T`,MESON_TAC[]);; let lem1 = prove_by_refinement( `!x. (?y. y < x) /\ (?y. y = x) /\ (?y. x < y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; EXISTS_TAC `x - &1`; REAL_ARITH_TAC; MESON_TAC[]; EXISTS_TAC `x + &1`; REAL_ARITH_TAC; ]);; (* }}} *) let rol_nonempty_thms rol_thm = let pts = dest_list (snd(dest_comb(concl rol_thm))) in if length pts = 0 then [lem0] else if length pts = 1 then CONJUNCTS (ISPEC (hd pts) lem1) else let rthms = rol_thms rol_thm in let pt_thms = map (C ISPEC lem) pts in let left_thm = ISPEC (hd pts) REAL_GT_EXISTS in let right_thm = ISPEC (last pts) REAL_LT_EXISTS in let int_thms = map (MATCH_MP REAL_DENSE) rthms in let thms = interleave pt_thms int_thms in left_thm::thms @ [right_thm];; (* rol_nonempty_thms (ASSUME `real_ordered_list [y]`) *) let lem0 = prove_by_refinement( `real_ordered_list []`, (* {{{ Proof *) [REWRITE_TAC[real_ordered_list]]);; (* }}} *) let lem1 = prove_by_refinement( `!x y. x < y ==> real_ordered_list [x; y]`, (* {{{ Proof *) [ REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD]; ]);; (* }}} *) let lem2 = prove_by_refinement( `!x y. x < y ==> real_ordered_list (CONS y t) ==> real_ordered_list (CONS x (CONS y t))`, (* {{{ Proof *) [ ASM_MESON_TAC[real_ordered_list;NOT_CONS_NIL;HD;TL]; ]);; (* }}} *) let mk_rol ord_thms = match ord_thms with [] -> lem0 | [x] -> MATCH_MP lem1 x | h1::h2::rest -> itlist (fun x y -> MATCH_MPL[lem2;x;y]) (butlast ord_thms) (MATCH_MP lem1 (last ord_thms));; (* let k0 = rol_thms (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) mk_rol k0 *) let real_nil = `[]:real list`;; let ROL_NIL = prove (`real_ordered_list ([]:real list)`, REWRITE_TAC[real_ordered_list]);; let ROL_REMOVE x rol_thm = let list = dest_list (snd (dest_comb (concl rol_thm))) in if length list = 0 then failwith "ROL_REMOVE: 0" else if length list = 1 then if x = hd list then ROL_NIL else failwith "ROL_REMOVE: Not an elem" else if length list = 2 then let l::r::[] = list in if l = x then ISPEC r ROL_SING else if r = x then ISPEC l ROL_SING else failwith "ROL_REMOVE: Not an elem" else let ord_thms = rol_thms rol_thm in let partition_fun thm = let l,r = dest_binop rlt (concl thm) in not (x = l) && not (x = r) in let ord_thms',elim_thms = partition partition_fun ord_thms in if length elim_thms = 1 then mk_rol ord_thms' else let [xy_thm; yz_thm] = elim_thms in let connect_thm = MATCH_MP REAL_LT_TRANS (CONJ xy_thm yz_thm) in let rec insert xz_thm thms = match thms with [] -> [connect_thm] | h::t -> let l,r = dest_binop rlt (concl h) in let l1,r1 = dest_binop rlt (concl xz_thm) in if (r1 = l) then xz_thm::h::t else h::insert xz_thm t in let ord_thms'' = insert connect_thm ord_thms' in mk_rol ord_thms'';; (* ROL_REMOVE `x1:real` (ASSUME `real_ordered_list [x1]`) ROL_REMOVE `x1:real` (ASSUME `real_ordered_list [x1; x3]`) ROL_REMOVE `x3:real` (ASSUME `real_ordered_list [x1; x3]`) ROL_REMOVE `x3:real` (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) ROL_REMOVE `x1:real` (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) ROL_REMOVE `x5:real` (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) ROL_REMOVE `-- &1` (ASSUME `real_ordered_list [-- &1; &0; &1]`) let rol_thm = (ASSUME `real_ordered_list [-- &1; &0; &1]`) let x = `&0` *) let lem = prove( `!y x. x < y \/ (x = y) \/ y < x`, (* {{{ Proof *) REAL_ARITH_TAC);; (* }}} *) let lem2 = prove( `!x y z. y < z ==> (y < x <=> (y < x /\ x < z) \/ (x = z) \/ z < x)`, (* {{{ Proof *) REAL_ARITH_TAC);; (* }}} *) let ROL_COVERS rol_thm = let pts = dest_list (snd(dest_comb(concl rol_thm))) in if length pts = 1 then ISPEC (hd pts) lem else let thms = rol_thms rol_thm in let thms' = map (MATCH_MP lem2) thms in let base = ISPEC (hd pts) lem in itlist (fun x y -> ONCE_REWRITE_RULE[MATCH_MP lem2 x] y) (rev thms) base;; (* ROL_COVERS (ASSUME `real_ordered_list [x; y; z]`) ROL_COVERS (ASSUME `real_ordered_list [x; y]`) ROL_COVERS (ASSUME `real_ordered_list [x]`) *) hol-light/Rqe/rqe_lib.ml000066400000000000000000000072161303454263000154510ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Refs *) (* ---------------------------------------------------------------------- *) let (+=) a b = a := !a + b;; let (+.=) a b = a := !a +. b;; (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let ptime f x = let start_time = Sys.time() in try let result = f x in let finish_time = Sys.time() in let total_time = finish_time -. start_time in (result,total_time) with e -> let finish_time = Sys.time() in let total_time = finish_time -. start_time in (print_string("Failed after (user) CPU time of "^ (string_of_float(total_time) ^": ")); raise e);; (* ---------------------------------------------------------------------- *) (* Lists *) (* ---------------------------------------------------------------------- *) let mappair f g l = let a,b = unzip l in let la = map f a in let lb = map g b in zip la lb;; let rec insertat i x l = if i = 0 then x::l else match l with [] -> failwith "insertat: list too short for position to exist" | h::t -> h::(insertat (i-1) x t);; let rec allcombs f l = match l with [] -> [] | h::t -> map (f h) t @ allcombs f t;; let rec assoc_list keys assl = match keys with [] -> [] | h::t -> assoc h assl::assoc_list t assl;; let add_to_list l1 l2 = l1 := !l1 @ l2;; let list x = [x];; let rec ith i l = if i = 0 then hd l else ith (i-1) (tl l);; let rev_ith i l = ith (length l - i - 1) l;; let get_index p l = let rec get_index p l n = match l with [] -> failwith "get_index" | h::t -> if p h then n else get_index p t (n + 1) in get_index p l 0;; (* get_index (fun x -> x > 5) [1;2;3;7;9] *) let bindex p l = let rec bindex p l i = match l with [] -> failwith "bindex: not found" | h::t -> if p h then i else bindex p t (i + 1) in bindex p l 0;; let cons x y = x :: y;; let rec swap_lists l store = match l with [] -> store | h::t -> let store' = map2 cons h store in swap_lists t store';; (* swap_lists [[1;2;3];[4;5;6];[7;8;9];[10;11;12]] --> [[1; 4; 7; 10]; [2; 5; 8; 11]; [3; 6; 9; 12]] *) let swap_lists l = let n = length (hd l) in let l' = swap_lists l (replicate [] n) in map rev l';; (* bindex (fun x -> x = 5) [1;2;5];; *) let fst3 (a,_,_) = a;; let snd3 (_,a,_) = a;; let thd3 (_,_,a) = a;; let odd n = (n mod 2 = 1);; let even n = (n mod 2 = 0);; (* ---------------------------------------------------------------------- *) (* Terms *) (* ---------------------------------------------------------------------- *) let dest_var_or_const t = match t with Var(s,ty) -> s,ty | Const(s,ty) -> s,ty | _ -> failwith "not a var or const";; let can_match t1 t2 = try let n1,_ = dest_var_or_const t1 in let n2,_ = dest_var_or_const t2 in n1 = n2 && can (term_match [] t1) t2 with Failure _ -> false;; let dest_quant tm = if is_forall tm then dest_forall tm else if is_exists tm then dest_exists tm else failwith "dest_quant: not a quantified term";; let get_binop tm = try let f,r = dest_comb tm in let xop,l = dest_comb f in xop,l,r with Failure _ -> failwith "get_binop";; hol-light/Rqe/rqe_list.ml000066400000000000000000000152521303454263000156550ustar00rootroot00000000000000 let aacons_tm = `CONS:A -> A list -> A list` ;; let HD_CONV conv tm = let h::rest = dest_list tm in let ty = type_of h in let thm = conv h in let thm2 = REFL (mk_list(rest,ty)) in let cs = inst [ty,aty] aacons_tm in MK_COMB ((AP_TERM cs thm),thm2);; let TL_CONV conv tm = (* try *) let h::t = dest_list tm in let lty = type_of h in let cs = inst [lty,aty] aacons_tm in MK_COMB ((AP_TERM cs (REFL h)), (LIST_CONV conv (mk_list(t,lty)))) (* with _ -> failwith "TL_CONV" *) let rec EL_CONV conv i tm = if i = 0 then HD_CONV conv tm else let h::t = dest_list tm in let lty = type_of h in let cs = inst [lty,aty] aacons_tm in MK_COMB ((AP_TERM cs (REFL h)), (EL_CONV conv (i - 1) (mk_list(t,lty)))) (* let conv = (REWRITE_CONV[ARITH_RULE `x + x = &2 * x`]) let tm = `[&5 + &5; &6 + &6; &7 + &7]` HD_CONV conv tm TL_CONV conv tm HD_CONV(TL_CONV conv) tm CONS_CONV conv tm EL_CONV conv 0 tm EL_CONV conv 1 tm EL_CONV conv 2 tm *) let NOT_CONS = prove_by_refinement( `!l. (~ ?(h:A) t. (l = CONS h t)) ==> (l = [])`, (* {{{ Proof *) [ MESON_TAC[list_CASES]; ]);; (* }}} *) let REMOVE = new_recursive_definition list_RECURSION `(REMOVE x [] = []) /\ (REMOVE x (CONS (h:A) t) = let rest = REMOVE x t in if x = h then rest else CONS h rest)`;; let CHOP_LIST = new_recursive_definition num_RECURSION `(CHOP_LIST 0 l = [],l) /\ (CHOP_LIST (SUC n) l = let a,b = CHOP_LIST n (TL l) in CONS (HD l) a,b)`;; let REM_NIL = prove( `REMOVE x [] = []`, MESON_TAC[REMOVE]);; let REM_FALSE = prove_by_refinement( `!x l. ~(MEM x (REMOVE x l))`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; ASM_MESON_TAC[MEM;REM_NIL]; CASES_ON `x = h`; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; ASM_MESON_TAC[MEM]; ]);; (* }}} *) let MEM_REMOVE = prove_by_refinement( `!x y z l. MEM x (REMOVE y l) ==> MEM x (REMOVE y (CONS z l))`, (* {{{ Proof *) [ REPEAT_N 3 STRIP_TAC; CASES_ON `y = z`; ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; ASM_MESON_TAC[MEM]; ]);; (* }}} *) let REM_NEQ = prove_by_refinement( `!x x1 l. MEM x l /\ ~(x = x1) ==> MEM x (REMOVE x1 l)`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC; LIST_INDUCT_TAC; MESON_TAC[MEM]; CASES_ON `x = h`; POP_ASSUM SUBST1_TAC; STRIP_TAC; ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF;COND_CLAUSES;MEM]; STRIP_TAC; CLAIM `MEM x t`; ASM_MESON_TAC[MEM]; STRIP_TAC; CLAIM `MEM x (REMOVE x1 t)`; ASM_MESON_TAC[]; STRIP_TAC; MATCH_MP_TAC MEM_REMOVE; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let LAST_SING = prove_by_refinement( `!h. LAST [h] = h`, (* {{{ Proof *) [ MESON_TAC[LAST]; ]);; (* }}} *) let LAST_CONS = prove_by_refinement( `!h t. ~(t = []) ==> (LAST (CONS h t) = LAST t)`, (* {{{ Proof *) [ ASM_MESON_TAC[LAST]; ]);; (* }}} *) let LAST_CONS_CONS = prove_by_refinement( `!h1 h2 t. ~(t = []) ==> (LAST (CONS h1 (CONS h2 t)) = LAST (CONS h1 t))`, (* {{{ Proof *) [ REWRITE_TAC[LAST;NOT_CONS_NIL]; MESON_TAC[LAST;NOT_CONS_NIL;COND_CLAUSES]; ]);; (* }}} *) let HD_APPEND = prove_by_refinement( `!h t l. HD (APPEND (CONS h t) l) = h`, (* {{{ Proof *) [ ASM_MESON_TAC[HD;APPEND]; ]);; (* }}} *) let LENGTH_0 = prove_by_refinement( `!l. (LENGTH l = 0) <=> (l = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[LENGTH]; ASM_MESON_TAC[LENGTH;NOT_CONS_NIL;ARITH_RULE `~(0 = SUC n)`]; ]);; (* }}} *) let LENGTH_1 = prove_by_refinement( `!l. (LENGTH l = 1) <=> ?x. l = [x]`, (* {{{ Proof *) [ LIST_INDUCT_TAC; EQ_TAC; MESON_TAC[LENGTH;ARITH_RULE `~(1 = 0)`]; MESON_TAC[NOT_CONS_NIL]; EQ_TAC; REWRITE_TAC[LENGTH;ARITH_RULE `~(0 = 1)`]; REWRITE_TAC[LENGTH]; STRIP_TAC; CLAIM `LENGTH t = 0`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `t = []`; ASM_MESON_TAC[LENGTH_0]; STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; STRIP_TAC; ASM_MESON_TAC[LENGTH;ONE]; ]);; (* }}} *) let LIST_TRI = prove_by_refinement( `!p. (p = []) \/ (?x. p = [x:A]) \/ (?x y t. p = CONS x (CONS y t))`, (* {{{ Proof *) [ STRIP_TAC; DISJ_CASES_TAC (ISPEC `p:A list` list_CASES); ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN STRIP_TAC; DISJ_CASES_TAC (ISPEC `t:A list` list_CASES); ASM_MESON_TAC[]; ASM_MESON_TAC[]; ]);; (* }}} *) let LENGTH_PAIR = prove_by_refinement( `!p. (LENGTH p = 2) <=> ?h t. p = [h:A; t]`, (* {{{ Proof *) [ STRIP_TAC THEN EQ_TAC; STRIP_TAC; MP_TAC (ISPEC `p:A list` list_CASES); STRIP_TAC; ASM_MESON_TAC[LENGTH_0;ARITH_RULE `~(2 = 0)`]; MP_TAC (ISPEC `t:A list` list_CASES); STRIP_TAC; ASM_MESON_TAC[LENGTH_1;ARITH_RULE `~(1 = 2)`]; MP_TAC (ISPEC `t':A list` list_CASES); STRIP_TAC; EXISTS_TAC `h:A`; EXISTS_TAC `h':A`; ASM_MESON_TAC[]; CLAIM `p = CONS h (CONS h' (CONS h'' t''))`; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `2 < LENGTH p`; POP_ASSUM SUBST1_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; ASM_MESON_TAC[LT_REFL]; STRIP_TAC; ASM_REWRITE_TAC[LENGTH]; ARITH_TAC; ]);; (* }}} *) let LENGTH_SING = prove_by_refinement( `!p. (LENGTH p = 1) <=> ?h. p = [h:A]`, (* {{{ Proof *) [ STRIP_TAC THEN EQ_TAC; STRIP_TAC; MP_TAC (ISPEC `p:A list` list_CASES); STRIP_TAC; ASM_MESON_TAC[LENGTH_0;ARITH_RULE `~(1 = 0)`]; MP_TAC (ISPEC `t:A list` list_CASES); STRIP_TAC; EXISTS_TAC `h:A`; ASM_MESON_TAC[]; CLAIM `p = CONS h (CONS h' t')`; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `1 < LENGTH p`; POP_ASSUM SUBST1_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; ASM_REWRITE_TAC[]; ARITH_TAC; STRIP_TAC; ASM_REWRITE_TAC[LENGTH;]; ARITH_TAC; ]);; (* }}} *) let TL_NIL = prove_by_refinement( `!l. ~(l = []) ==> ((TL l = []) <=> ?x. l = [x])`, (* {{{ Proof *) [ REPEAT STRIP_TAC THEN EQ_TAC; CLAIM `?h t. l = CONS h t`; ASM_MESON_TAC[list_CASES]; STRIP_TAC; ASM_REWRITE_TAC[TL]; ASM_MESON_TAC !LIST_REWRITES; ASM_MESON_TAC !LIST_REWRITES; ]);; (* }}} *) let LAST_TL = prove_by_refinement( `!l. ~(l = []) /\ ~(TL l = []) ==> (LAST (TL l) = LAST l)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REWRITE_TAC[TL;LAST]; ASM_MESON_TAC[NOT_CONS_NIL]; ]);; (* }}} *) let LENGTH_TL = prove_by_refinement( `!l. ~(l = []) /\ ~(TL l = []) ==> (LENGTH (TL l) = PRE(LENGTH l))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REPEAT STRIP_TAC; LIST_SIMP_TAC; NUM_SIMP_TAC; ]);; (* }}} *) let LENGTH_NZ = prove_by_refinement( `!p. 0 < LENGTH p <=> ~(p = [])`, (* {{{ Proof *) [ REPEAT STRIP_TAC; EQ_TAC; ASM_MESON_TAC[LENGTH;NOT_CONS_NIL;LT_REFL]; REWRITE_TAC[LENGTH;NOT_CONS_NIL;LT_REFL;NOT_NIL]; STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[LENGTH]; ARITH_TAC; ]);; (* }}} *) hol-light/Rqe/rqe_main.ml000066400000000000000000000557061303454263000156360ustar00rootroot00000000000000let TRAPOUT cont mat_thm ex_thms fm = try cont mat_thm ex_thms with Isign (false_thm,ex_thms) -> let ftm = mk_eq(fm,f_tm) in let fthm = CONTR ftm false_thm in let ex_thms' = sort (fun x y -> xterm_lt (fst y) (fst x)) ex_thms in let fthm' = rev_itlist CHOOSE ex_thms' fthm in fthm';; let get_repeats l = let rec get_repeats l seen ind = match l with [] -> [] | h::t -> if mem h seen then ind::get_repeats t seen (ind + 1) else get_repeats t (h::seen) (ind + 1) in get_repeats l [] 0;; let subtract_index l = let rec subtract_index l ind = match l with [] -> [] | h::t -> (h - ind):: (subtract_index t (ind + 1)) in subtract_index l 0;; (* subtract_index (get_repeats [1; 2; 1; 2 ; 3]) *) let remove_column n isigns_thm = let thms = interpsigns_thms2 isigns_thm in let l,r = chop_list n thms in let thms' = l @ tl r in mk_interpsigns thms';; let REMOVE_COLUMN n mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in let isigns_thms' = map (remove_column n) isigns_thms in let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; let SETIFY_CONV mat_thm = let _,pols,_ = dest_interpmat(concl mat_thm) in let pols' = dest_list pols in let sols = setify (dest_list pols) in let indices = map (fun p -> try index p sols with _ -> failwith "SETIFY: no index") pols' in let subtract_cols = subtract_index (get_repeats indices) in rev_itlist REMOVE_COLUMN subtract_cols mat_thm;; (* SETIFY_CONV (ASSUME `interpmat [] [(\x. x + &1); (\x. x + &1); (\x. x + &2); (\x. x + &3); (\x. x + &1); (\x. x + &2)][[Pos; Pos; Pos; Pos; Neg; Zero]]`) *) (* let duplicate_column i j isigns_thm = let thms = interpsigns_thms2 isigns_thm in let col = ith i thms in let l,r = chop_list j thms in let thms' = l @ (col :: r) in mk_interpsigns thms';; let DUPLICATE_COLUMN i j mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in let isigns_thms' = map (duplicate_column i j) isigns_thms in let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; *) let duplicate_columns new_cols isigns_thm = let thms = interpsigns_thms2 isigns_thm in let thms' = map (fun i -> el i thms) new_cols in mk_interpsigns thms';; let DUPLICATE_COLUMNS mat_thm ls = if ls = [] then if mat_thm = empty_mat then empty_mat else failwith "empty duplication list" else let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in let isigns_thms' = map (duplicate_columns ls) isigns_thms in let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; let DUPLICATE_COLUMNS mat_thm ls = let start_time = Sys.time() in let res = DUPLICATE_COLUMNS mat_thm ls in duplicate_columns_timer +.= (Sys.time() -. start_time); res;; let UNMONICIZE_ISIGN vars monic_thm isign_thm = let _,_,sign = dest_interpsign isign_thm in let const = (fst o dest_mult o lhs o concl) monic_thm in let const_thm = SIGN_CONST const in let op,_,_ = get_binop (concl const_thm) in let mp_thm = if op = rgt then if sign = spos_tm then gtpos else if sign = sneg_tm then gtneg else if sign = szero_tm then gtzero else failwith "bad sign" else if op = rlt then if sign = spos_tm then ltpos else if sign = sneg_tm then ltneg else if sign = szero_tm then ltzero else failwith "bad sign" else (failwith "bad op") in let monic_thm' = GEN (hd vars) monic_thm in MATCH_MPL[mp_thm;monic_thm';const_thm;isign_thm];; let UNMONICIZE_ISIGNS vars monic_thms isigns_thm = let isign_thms = interpsigns_thms2 isigns_thm in let isign_thms' = map2 (UNMONICIZE_ISIGN vars) monic_thms isign_thms in mk_interpsigns isign_thms';; let UNMONICIZE_MAT vars monic_thms mat_thm = if monic_thms = [] then mat_thm else let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let consts = map (fst o dest_mult o lhs o concl) monic_thms in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in let isigns_thms' = map (UNMONICIZE_ISIGNS vars monic_thms) isigns_thms in let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; let UNMONICIZE_MAT vars monic_thms mat_thm = let start_time = Sys.time() in let res = UNMONICIZE_MAT vars monic_thms mat_thm in unmonicize_mat_timer +.= (Sys.time() -. start_time); res;; (* {{{ Examples *) (* let vars,monic_thms,mat_thm = [], [], empty_mat let monic_thm = hd monic_thms length isigns_thms MONIC_CONV [rx] `&1 + x * (&1 + x * (&1 + x * &7))` let isign_thm = hd isign_thms let isigns_thm = hd isigns_thms mk_interpsigns [TRUTH];; let ls = [0;1;2;0;1;2] let mat_thm,ls = empty_mat,[] 1,3, DUPLICATE_COLUMNS (ASSUME `interpmat [] [(\x. x + &1); (\x. x + &1); (\x. x + &2); (\x. x + &3); (\x. x + &1); (\x. x + &2)][[Pos; Pos; Pos; Pos; Neg; Zero]]`) [5] duplicate_columns [] (ASSUME `interpsigns [] (\x. T) []`) let new_cols, isigns_thm = [],(ASSUME `interpsigns [] (\x. T) []`) let isigns_thm = hd isigns_thms *) (* }}} *) let SWAP_HEAD_COL_ROW i isigns_thm = let s_thms = interpsigns_thms2 isigns_thm in let s_thms' = insertat i (hd s_thms) (tl s_thms) in mk_interpsigns s_thms';; let SWAP_HEAD_COL i mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in let isigns_thms' = map (SWAP_HEAD_COL_ROW i) isigns_thms in let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in mk_interpmat_thm rol_thm all_thm';; let SWAP_HEAD_COL i mat_thm = let start_time = Sys.time() in let res = SWAP_HEAD_COL i mat_thm in swap_head_col_timer +.= (Sys.time() -. start_time); res;; let LENGTH_CONV = let alength_tm = `LENGTH:(A list) -> num` in fun tm -> try let ty = type_of tm in let lty,[cty] = dest_type ty in if lty <> "list" then failwith "LENGTH_CONV: not a list" else let ltm = mk_comb(inst[cty,aty] alength_tm,tm) in let lthm = REWRITE_CONV[LENGTH] ltm in MATCH_MP main_lem000 lthm with _ -> failwith "LENGTH_CONV";; let LAST_NZ_CONV = let alast_tm = `LAST:(A list) -> A` in fun nz_thm tm -> try let ty = type_of tm in let lty,[cty] = dest_type ty in if lty <> "list" then failwith "LAST_NZ_CONV: not a list" else let ltm = mk_comb(inst[cty,aty] alast_tm,tm) in let lthm = REWRITE_CONV[LAST;NOT_CONS_NIL] ltm in MATCH_MPL[main_lem001;nz_thm;lthm] with _ -> failwith "LAST_NZ_CONV";; let rec first f l = match l with [] -> failwith "first" | h::t -> if can f h then f h else first f t;; let NEQ_RULE thm = let thms = CONJUNCTS main_lem002 in first (C MATCH_MP thm) thms;; (* NEQ_CONV (ARITH_RULE `~(&11 <= &2)`) *) let NORMAL_LIST_CONV nz_thm tm = let nz_thm' = NEQ_RULE nz_thm in let len_thm = LENGTH_CONV tm in let last_thm = LAST_NZ_CONV nz_thm' tm in let cthm = CONJ len_thm last_thm in MATCH_EQ_MP (GSYM (REWRITE_RULE[GSYM NEQ] NORMAL_ID)) cthm;; (* |- poly_diff [&0; &0; &0 + a * &1] = [&0; &0 + a * &2] let tm = `poly_diff [&0; &0 + a * &1]` *) let pdiff_tm = `poly_diff`;; let GEN_POLY_DIFF_CONV vars tm = let thm1 = POLY_ENLIST_CONV vars tm in let l,x = dest_poly (rhs (concl thm1)) in let thm2 = CANON_POLY_DIFF_CONV (mk_comb(pdiff_tm,l)) in let thm3 = CONV_RULE (RAND_CONV (LIST_CONV (POLYNATE_CONV vars))) thm2 in thm3;; (* if \x. p = \x. q, where \x. p is the leading polynomial replace p by q in mat_thm, *) (* let peq,mat_thm = !rppeq,!rpmat *) let rppeq,rpmat = ref TRUTH,ref TRUTH;; let REPLACE_POL = let imat_tm = `interpmat` in fun peq mat_thm -> rppeq := peq; rpmat := mat_thm; let pts,pols,sgnll = dest_interpmat (concl mat_thm) in let rep_p = lhs(concl peq) in let i = try index rep_p (dest_list pols) with _ -> failwith "REPLACE_POL: index" in let thm1 = EL_CONV (fun x -> GEN_REWRITE_CONV I [peq] x) i pols in end_itlist (C (curry MK_COMB)) (rev [REFL imat_tm;REFL pts;thm1;REFL sgnll]);; let REPLACE_POL peq mat_thm = let start_time = Sys.time() in let res = REPLACE_POL peq mat_thm in replace_pol_timer +.= (Sys.time() -. start_time); res;; (* {{{ Examples *) (* let peq,mat_thm = ASSUME `(\x. &0) = (\x. &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)))`, ASSUME `interpmat [x_44] [\x. (&0 + b * &1) + x * (&0 + a * &2); \x. &0] [[Pos; Zero]; [Zero; Zero]; [Neg; Zero]]` let peq = ASSUME `(\x. &1 + x * (&1 + x * (&1 + x * &1))) = (\x. &1 + x)` REPLACE_POL peq mat_thm is_constant [`y:real`] `&1 + x * -- &1` let vars,pols,cont,sgns,ex_thms = [`c:real`; `b:real`; `a:real`], [`&0 + c * &1`], (fun x y -> x), [ASSUME `&0 + b * (&0 + b * -- &1) = &0`; ASSUME ` &0 + b * (&0 + b * (&0 + a * -- &1)) = &0`; ASSUME `&0 + a * (&0 + a * &1) = &0`;ASSUME `&0 + b * &1 = &0`; ASSUME `&0 + a * &1 = &0`; ASSUME ` &1 > &0`], [] *) (* }}} *) (* ---------------------------------------------------------------------- *) (* Factoring *) (* ---------------------------------------------------------------------- *) let UNFACTOR_ISIGN vars xsign_thm pol isign_thm = let x = hd vars in let k,pol' = weakfactor x pol in if k = 0 then isign_thm else let fact_thm = GEN x (GSYM (WEAKFACTOR_CONV x pol)) in let par_thm = PARITY_CONV (mk_small_numeral k) in let _,_,xsign = dest_interpsign xsign_thm in let _,_,psign = dest_interpsign isign_thm in let parity,_ = dest_comb (concl par_thm) in if xsign = spos_tm then let mp_thm = if psign = spos_tm then factor_pos_pos else if psign = sneg_tm then factor_pos_neg else if psign = szero_tm then factor_pos_zero else failwith "bad sign" in let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm]) in MATCH_MP ret fact_thm else if xsign = szero_tm then let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in let mp_thm = if psign = spos_tm then factor_zero_pos else if psign = sneg_tm then factor_zero_neg else if psign = szero_tm then factor_zero_zero else failwith "bad sign" in let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm;k_thm]) in MATCH_MP ret fact_thm else if xsign = sneg_tm && parity = even_tm then let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in let mp_thm = if psign = spos_tm then factor_neg_even_pos else if psign = sneg_tm then factor_neg_even_neg else if psign = szero_tm then factor_neg_even_zero else failwith "bad sign" in let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm;par_thm;k_thm]) in MATCH_MP ret fact_thm else if xsign = sneg_tm && parity = odd_tm then let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in let mp_thm = if psign = spos_tm then factor_neg_odd_pos else if psign = sneg_tm then factor_neg_odd_neg else if psign = szero_tm then factor_neg_odd_zero else failwith "bad sign" in let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm;par_thm;k_thm]) in MATCH_MP ret fact_thm else failwith "bad something...";; (* {{{ Examples *) (* let vars,xsign_thm,pol,isign_thm = [ry;rx], `interpsign (\x. x < x1) (\x. x) Pos`, ASSUME `interpsign (\x. x < x_254) (\y. &0 + y * &1) Neg` `\x. &0 + x * (&4 + x * &6)`, ASSUME `interpsign (\x. x < x1) (\x. &4 + x * &6) Pos` let xsign_thm,pol,isign_thm = ASSUME `interpsign (\x. x < x1) (\x. x) Pos`, `\x. &0 + x * (&4 + x * &6)`, ASSUME `interpsign (\x. x < x1) (\x. &4 + x * &6) Pos` *) (* }}} *) let UNFACTOR_ISIGNS vars pols isigns_thm = let isign_thms = interpsigns_thms2 isigns_thm in let isign_thms' = map2 (UNFACTOR_ISIGN vars (hd isign_thms)) pols (tl isign_thms) in mk_interpsigns isign_thms';; let UNFACTOR_MAT vars pols mat_thm = let rol_thm,all_thm = interpmat_thms mat_thm in let ints,part,signs = dest_all2 (concl all_thm) in let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in let isigns_thms' = map (UNFACTOR_ISIGNS vars pols) isigns_thms in let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in mat_thm';; let UNFACTOR_MAT vars pols mat_thm = let start_time = Sys.time() in let res = UNFACTOR_MAT vars pols mat_thm in unfactor_mat_timer +.= (Sys.time() -. start_time); res;; (* {{{ Examples *) (* #untrace UNFACTOR_ISIGN let isigns_thm = el 0 isigns_thms UNFACTOR_ISIGNS pols isigns_thm let isign_thm = el 1 isign_thm pols let isigns_thms' = map (UNFACTOR_ISIGNS pols) isigns_thms in let xsign_thm = hd isign_thms let xsign_thm = ASSUME `interpsign (\x. x < x1) (\x. x) Neg` let isign_thm = hd (tl isign_thms) let pol = hd pols let pol = `\x. &0 + x * (&0 + x * (&0 + x * (&0 + y * &1)))` let isigns_thm = hd isigns_thms let vars = [rx;ry;rz] let pols = [`\x. &0 + x * (&0 + x * (&0 + y * &1))`; `\x. &0 + x * (&4 + x * &6)`; `\x. &3 + x * (&6 + x * &9)`; `\x. &0 + x * (&0 + x * (&0 + x * (&0 + z * &1)))`; `\x. -- &4 + x * (&0 + x * &1)`] let mat_thm = ASSUME `interpmat [x1; x2; x3; x4; x5] [\x. x; \x. &0 + y * &1; \x. &4 + x * &6; \x. &3 + x * (&6 + x * &9); \x. &0 + z * &1; \x. -- &4 + x * (&0 + x * &1)] [[Pos; Pos; Pos; Neg; Neg; Neg]; [Neg; Pos; Zero; Zero; Neg; Neg]; [Neg; Pos; Neg; Pos; Neg; Neg]; [Neg; Pos; Neg; Pos; Neg; Zero]; [Neg; Pos; Neg; Pos; Neg; Pos]; [Zero; Pos; Neg; Pos; Zero; Pos]; [Pos; Pos; Neg; Pos; Pos; Pos]; [Pos; Zero; Neg; Pos; Pos; Pos]; [Pos; Neg; Neg; Pos; Pos; Pos]; [Pos; Zero; Zero; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos; Pos; Pos]]` UNFACTOR_MAT pols mat_thm *) (* }}} *) let message_time s f x = report s; time f x;; (* ---------------------------------------------------------------------- *) (* Matrix *) (* ---------------------------------------------------------------------- *) let matrix_count,splitzero_count,splitsigns_count,monicize_count = ref 0,ref 0,ref 0,ref 0;; let reset_counts() = matrix_count := 0;splitzero_count := 0;splitsigns_count := 0;monicize_count := 0;; let print_counts() = !matrix_count,!splitzero_count,!splitsigns_count,!monicize_count;; (* let vars,dun,pols,cont,sgns,ex_thms,fm = !szvars,!szdun,!szpols,!szcont,!szsgns,!szex_thms,!szfm *) let rec MATRIX vars pols cont sgns ex_thms fm = incr matrix_count; if pols = [] then TRAPOUT cont empty_mat [] fm else if exists (is_constant vars) pols then let p = find (is_constant vars) pols in let i = try index p pols with _ -> failwith "MATRIX: no such pol" in let pols1,pols2 = chop_list i pols in let pols' = pols1 @ tl pols2 in let cont' = MATINSERT vars i (FINDSIGN vars sgns p) cont in MATRIX vars pols' cont' sgns ex_thms fm else let kqs = map (weakfactor (hd vars)) pols in if exists (fun (k,q) -> k <> 0 && not(is_constant vars q)) kqs then let pols' = poly_var(hd vars) :: map snd kqs in let ks = map fst kqs in let cont' mat_thm ex_thms = cont (UNFACTOR_MAT vars pols mat_thm) ex_thms in MATRIX vars pols' cont' sgns ex_thms fm else let d = itlist (max o degree_ vars) pols (-1) in let p = find (fun p -> degree_ vars p = d) pols in let pl_thm = POLY_ENLIST_CONV vars p in let pl = rhs(concl pl_thm) in let l,x = dest_poly pl in let pdiff_thm = GEN_POLY_DIFF_CONV vars p in let p'l = rhs (concl pdiff_thm) in let p' = mk_comb(mk_comb(poly_tm,p'l),hd vars) in let p'thm = (POLY_DELIST_CONV THENC (POLYNATE_CONV vars)) p' in let p'c = rhs (concl p'thm) in let hdp' = last (dest_list p'l) in let sign_thm = FINDSIGN vars sgns hdp' in let normal_thm = NORMAL_LIST_CONV sign_thm p'l in let i = try index p pols with _ -> failwith "MATRIX: no such pol1" in let qs = let p1,p2 = chop_list i pols in p'c::p1 @ tl p2 in let gs,div_thms = unzip (map (PDIVIDES vars sgns p) qs) in let cont' mat_thm = cont (SWAP_HEAD_COL i mat_thm) in let dedcont mat_thm ex_thms = DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont' mat_thm ex_thms in SPLITZERO vars qs gs dedcont sgns ex_thms fm and SPLITZERO vars dun pols cont sgns ex_thms fm = incr splitzero_count; match pols with [] -> SPLITSIGNS vars [] dun cont sgns ex_thms fm | p::ops -> if p = rzero then let cont' mat_thm ex_thms = MATINSERT vars (length dun) (REFL rzero) cont mat_thm ex_thms in SPLITZERO vars dun ops cont' sgns ex_thms fm else let hp = behead vars p in let h = head vars p in let nzcont = let tmp = SPLITZERO vars (dun@[p]) ops cont in fun sgns ex_thms -> tmp sgns ex_thms fm in let zcont = let tmp = SPLITZERO vars dun (hp :: ops) in fun sgns ex_thms -> let zthm = FINDSIGN vars sgns h in let b_thm = GSYM (BEHEAD vars zthm p) in let lam_thm = ABS (hd vars) b_thm in let cont' mat_thm ex_thms = let mat_thm' = REPLACE_POL (lam_thm) mat_thm in let mat_thm'' = MATCH_EQ_MP mat_thm' mat_thm in cont mat_thm'' ex_thms in tmp cont' sgns ex_thms fm in SPLIT_ZERO (tl vars) sgns (head vars p) zcont nzcont ex_thms and SPLITSIGNS vars dun pols cont sgns ex_thms fm = incr splitsigns_count; match pols with [] -> MONICIZE vars dun cont sgns ex_thms fm (* [] -> MATRIX vars dun cont sgns ex_thms fm *) | p::ops -> let cont' sgns ex_thms = SPLITSIGNS vars (dun@[p]) ops cont sgns ex_thms fm in SPLIT_SIGN (tl vars) sgns (head vars p) cont' cont' ex_thms and MONICIZE vars pols cont sgns ex_thms fm = incr monicize_count; let monic_thms = map (MONIC_CONV vars) pols in let monic_pols = map (rhs o concl) monic_thms in let sols = setify monic_pols in let indices = map (fun p -> try index p sols with _ -> failwith "MONICIZE: no such pol") monic_pols in let transform mat_thm = let mat_thm' = DUPLICATE_COLUMNS mat_thm indices in (* mat_thm' *) UNMONICIZE_MAT vars monic_thms mat_thm' in let cont' mat_thm ex_thms = cont (transform mat_thm) ex_thms in MATRIX vars sols cont' sgns ex_thms fm ;; (* {{{ Examples *) (* let vars,pols,sgns,ex_thms = [],[],[],[] let mat_thm = mat_thm' monic_thms let vars = [rx] let mat_thm = ASSUME `interpmat [x1; x2; x3; x4; x5] [(\x. &1 + x * (&2 + x * &3)); (\x. &2 + x * (&4 + x * &6)); \x. &3 + x * (&6 + x * &9); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4] [[Pos; Pos; Pos; Neg; Neg; Neg]; [Pos; Pos; Zero; Zero; Neg; Neg]; [Pos; Pos; Neg; Pos; Neg; Neg]; [Pos; Pos; Neg; Pos; Neg; Zero]; [Pos; Pos; Neg; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos; Zero; Pos]; [Pos; Pos; Neg; Pos; Pos; Pos]; [Pos; Zero; Neg; Pos; Pos; Pos]; [Pos; Neg; Neg; Pos; Pos; Pos]; [Pos; Zero; Zero; Pos; Pos; Pos]; [Pos; Pos; Pos; Pos; Pos; Pos]]` let mat_thm = ASSUME `interpmat [x1; x2; x3; x4; x5] [\x. -- &4 + x * (&0 + x * &1); \x. &2 + x * &1; \x. &2 + x * (-- &3 + x * &1); \x. &1 / &3 + x * (&2 / &3 + x * &1)] [[Pos; Pos; Pos; Neg]; [Pos; Pos; Zero; Zero]; [Pos; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos]; [Pos; Pos; Neg; Pos]; [Pos; Zero; Neg; Pos]; [Pos; Neg; Neg; Pos]; [Pos; Zero; Zero; Pos]; [Pos; Pos; Pos; Pos]]`;; let vars = [rx] let pols = [`&1 + x * (&2 + x * &3)`;`&2 + x * (&4 + x * &6)`;`&3 + x * (&6 + x * &9)`; `&2 + x * (-- &3 + x * &1)`;`-- &4 + x * (&0 + x * &1)`;`&8 + x * &4`] *) (* }}} *) (* ---------------------------------------------------------------------- *) (* Set up RQE *) (* ---------------------------------------------------------------------- *) let polynomials tm = let rec polynomials tm = if tm = t_tm || tm = f_tm then [] else if is_conj tm || is_disj tm || is_imp tm || is_iff tm then let _,l,r = get_binop tm in polynomials l @ polynomials r else if is_neg tm then polynomials (dest_neg tm) else if can (dest_binop rlt) tm || can (dest_binop rgt) tm || can (dest_binop rle) tm || can (dest_binop rge) tm || can (dest_binop req) tm || can (dest_binop rneq) tm then let _,l,_ = get_binop tm in [l] else failwith "not a fol atom" in setify (polynomials tm);; (* {{{ Examples *) (* let pols = polynomials `(poly [&1; -- &2] x > &0 ==> poly [&1; -- &2] x >= &0 /\ (poly [&8] x = &0)) /\ ~(poly [y] x <= &0)` *) (* }}} *) let BASIC_REAL_QELIM_CONV vars fm = let x,bod = dest_exists fm in let pols = polynomials bod in let cont mat_thm ex_thms = let ex_thms' = sort (fun x y -> xterm_lt (fst y) (fst x)) ex_thms in let comb_thm = COMBINE_TESTFORMS x mat_thm bod in let comb_thm' = rev_itlist CHOOSE ex_thms' comb_thm in comb_thm' in let ret_thm = SPLITZERO (x::vars) [] pols cont empty_sgns [] fm in PURE_REWRITE_RULE[NEQ] ret_thm;; let REAL_QELIM_CONV fm = reset_counts(); ((LIFT_QELIM_CONV POLYATOM_CONV (EVALC_CONV THENC SIMPLIFY_CONV) BASIC_REAL_QELIM_CONV) THENC EVALC_CONV THENC SIMPLIFY_CONV) fm;; (* ---------------------------------------------------------------------- *) (* timers *) (* ---------------------------------------------------------------------- *) hol-light/Rqe/rqe_num.ml000066400000000000000000000015741303454263000155030ustar00rootroot00000000000000 (* ---------------------------------------------------------------------- *) (* Nums *) (* ---------------------------------------------------------------------- *) let neq = `(=):num->num->bool`;; let nlt = `(<):num->num->bool`;; let ngt = `(>):num->num->bool`;; let nle = `(<=):num->num->bool`;; let nge = `(>=):num->num->bool`;; let nm = `( * ):num->num->num`;; let np = `(+):num->num->num`;; let nzero = `0`;; let even_tm = `EVEN`;; let odd_tm = `ODD`;; let nmax = new_definition( `nmax (n:num) m = if n <= m then m else n`);; let SUC_1 = prove( `1 + x = SUC x`, (* {{{ Proof *) ARITH_TAC);; (* }}} *) let even_tm = `EVEN`;; let odd_tm = `ODD`;; let PARITY_CONV tm = let k = dest_small_numeral tm in if even k then prove(mk_comb(even_tm,tm),ARITH_TAC) else prove(mk_comb(odd_tm,tm),ARITH_TAC);; hol-light/Rqe/rqe_real.ml000066400000000000000000000271571303454263000156340ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Reals *) (* ---------------------------------------------------------------------- *) let real_ty = `:real`;; let rx = `x:real`;; let ry = `y:real`;; let rz = `z:real`;; let rzero = `&0`;; let req = `(=):real->real->bool`;; let rneq = `(<>):real->real->bool`;; let rlt = `(<):real->real->bool`;; let rgt = `(>):real->real->bool`;; let rle = `(<=):real->real->bool`;; let rge = `(>=):real->real->bool`;; let rm = `( * ):real->real->real`;; let rs = `(-):real->real->real`;; let rn = `(--):real->real`;; let rd = `(/):real->real->real`;; let rp = `(+):real->real->real`;; let rzero = `&0`;; let rone = `&1`;; let rlast = `LAST:(real) list -> real`;; let rappend = `APPEND:(real) list -> real list -> real list`;; let mk_rlist l = mk_list (l,real_ty);; let diffl_tm = `(diffl)`;; let dest_diffl tm = try let l,var = dest_comb tm in let dp,p' = dest_comb l in let d,p = dest_comb dp in if not (d = diffl_tm) then failwith "dest_diffl: not a diffl" else let _,bod = dest_abs p in bod,p' with _ -> failwith "dest_diffl";; let dest_mult = try dest_binop rm with _ -> failwith "dest_mult";; let mk_mult = mk_binop rm;; let pow_tm = `(pow)`;; let dest_pow = try dest_binop pow_tm with _ -> failwith "dest_pow";; let mk_plus = mk_binop rp;; let mk_negative = curry mk_comb rn;; let dest_plus = try dest_binop rp with _ -> failwith "dest_plus";; let REAL_DENSE = prove( `!x y. x < y ==> ?z. x < z /\ z < y`, (* {{{ Proof *) REPEAT STRIP_TAC THEN CLAIM `&0 < y - x` THENL [REWRITE_TAC[REAL_LT_SUB_LADD;REAL_ADD_LID] THEN POP_ASSUM MATCH_ACCEPT_TAC; DISCH_THEN (ASSUME_TAC o (MATCH_MP REAL_DOWN)) THEN POP_ASSUM MP_TAC THEN STRIP_TAC THEN EXISTS_TAC `e + x` THEN STRIP_TAC THENL [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[GSYM REAL_ADD_RID])) THEN MATCH_MP_TAC REAL_LET_ADD2 THEN STRIP_TAC THENL [MATCH_ACCEPT_TAC REAL_LE_REFL; FIRST_ASSUM MATCH_ACCEPT_TAC]; MATCH_EQ_MP_TAC ((GEN `y:real` (GEN `z:real` (ISPECL [`y:real`;`z:real`;`-- x`] REAL_LT_RADD)))) THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_ADD_RINV;REAL_ADD_RID] THEN REWRITE_TAC[GSYM real_sub] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]]);; (* }}} *) let REAL_LT_EXISTS = prove( `!x. ?y. x < y`, (* {{{ Proof *) GEN_TAC THEN EXISTS_TAC `x + &1` THEN REAL_ARITH_TAC);; (* }}} *) let REAL_GT_EXISTS = prove( `!x. ?y. y < x`, (* {{{ Proof *) GEN_TAC THEN EXISTS_TAC `x - &1` THEN REAL_ARITH_TAC);; (* }}} *) let REAL_DIV_DISTRIB_L = prove_by_refinement( `!x y z. x / (y * z) = (x / y) * (&1 / z)`, (* {{{ Proof *) [ REWRITE_TAC[real_div;REAL_INV_MUL]; REAL_ARITH_TAC; ]);; (* }}} *) let REAL_DIV_DISTRIB_R = prove_by_refinement( `!x y z. x / (y * z) = (&1 / y) * (x / z)`, (* {{{ Proof *) [ REWRITE_TAC[real_div;REAL_INV_MUL]; REAL_ARITH_TAC; ]);; (* }}} *) let REAL_DIV_DISTRIB_2 = prove_by_refinement( `!x y z. (x * w) / (y * z) = (x / y) * (w / z)`, (* {{{ Proof *) [ REWRITE_TAC[real_div;REAL_INV_MUL]; REAL_ARITH_TAC; ]);; (* }}} *) let REAL_DIV_ADD_DISTRIB = prove_by_refinement( `!x y z. (x + y) / z = (x / z) + (y / z)`, (* {{{ Proof *) [ REWRITE_TAC[real_div;REAL_INV_MUL]; REAL_ARITH_TAC; ]);; (* }}} *) let DIV_ID = prove_by_refinement( `!x. ~(x = &0) ==> (x / x = &1)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[real_div]; ASM_MESON_TAC[REAL_MUL_LINV;REAL_MUL_SYM]; ]);; (* }}} *) let POS_POW = prove_by_refinement( `!c x. &0 < c /\ &0 < x ==> &0 < c * x pow k`, (* {{{ Proof *) [ MESON_TAC[REAL_POW_LT;REAL_LT_MUL] ]);; (* }}} *) let POS_NAT_POW = prove_by_refinement( `!c n. 0 < n /\ &0 < c ==> &0 < c * &n pow k`, (* {{{ Proof *) [ MESON_TAC[REAL_POW_LT;REAL_LT_MUL;REAL_LT;] ]);; (* }}} *) let REAL_NUM_LE_0 = prove_by_refinement( `!n. &0 <= (&n)`, (* {{{ Proof *) [ INDUCT_TAC; REAL_ARITH_TAC; REWRITE_TAC[REAL]; REAL_ARITH_TAC; ]);; (* }}} *) let REAL_ARCH_SIMPLE_LT = prove_by_refinement( `!x. ?n. x < &n`, (* {{{ Proof *) [ STRIP_TAC; CHOOSE_THEN ASSUME_TAC (ISPEC `x:real` REAL_ARCH_SIMPLE); EXISTS_TAC `SUC n`; REWRITE_TAC[REAL]; POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let BINOMIAL_LEMMA_LT = prove_by_refinement( `!x y. &0 < x /\ &0 < y ==> !n. 0 < n ==> x pow n + y pow n <= (x + y) pow n`, (* {{{ Proof *) [ REPEAT GEN_TAC; STRIP_TAC; INDUCT_TAC; ARITH_TAC; REWRITE_TAC[real_pow]; STRIP_TAC; CASES_ON `n = 0`; ASM_REWRITE_TAC[real_pow;REAL_MUL_RID;REAL_LE_REFL]; CLAIM `0 < n`; POP_ASSUM MP_TAC THEN ARITH_TAC; DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); MATCH_MP_TAC REAL_LE_TRANS; EXISTS_TAC `(x + y) * (x pow n + y pow n)`; STRIP_TAC; REWRITE_TAC[REAL_ADD_RDISTRIB]; MATCH_MP_TAC REAL_LE_ADD2; CONJ_TAC; MATCH_MP_TAC REAL_LE_LMUL; STRIP_TAC; FIRST_ASSUM (fun x -> MP_TAC x THEN ARITH_TAC); MATCH_MP_TAC (REAL_ARITH `&0 <= y ==> x <= x + y`); MATCH_MP_TAC REAL_POW_LE; FIRST_ASSUM (fun x -> MP_TAC x THEN ARITH_TAC); REWRITE_TAC[REAL_ADD_LDISTRIB]; MATCH_MP_TAC (REAL_ARITH `&0 <= y ==> x <= y + x`); MATCH_MP_TAC REAL_LE_MUL; CONJ_TAC; FIRST_ASSUM (fun x -> MP_TAC x THEN REAL_ARITH_TAC); MATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); MATCH_MP_TAC REAL_POW_LT; FIRST_ASSUM MATCH_ACCEPT_TAC; MATCH_MP_TAC REAL_LE_LMUL; CONJ_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let BINOMIAL_LEMMA = prove_by_refinement( `!x y. &0 <= x /\ &0 <= y ==> !n. 0 < n ==> x pow n + y pow n <= (x + y) pow n`, (* {{{ Proof *) [ REPEAT GEN_TAC; STRIP_TAC; CASES_ON `(x = &0) \/ (y = &0)`; POP_ASSUM DISJ_CASES_TAC; ASM_REWRITE_TAC[real_pow;REAL_ADD_LID;POW_0]; REPEAT STRIP_TAC; CLAIM `n = SUC (PRE n)`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; ONCE_ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[POW_0;REAL_ADD_LID;real_pow;REAL_LE_REFL]; REPEAT STRIP_TAC; CLAIM `n = SUC (PRE n)`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; ONCE_ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[POW_0;REAL_ADD_LID;REAL_ADD_RID;real_pow;REAL_LE_REFL]; POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC; MATCH_MP_TAC BINOMIAL_LEMMA_LT; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let NEG_ABS = prove_by_refinement( `!x. -- (abs x) <= &0`, (* {{{ Proof *) [ REAL_ARITH_TAC; ]);; (* }}} *) let REAL_MUL_LT = prove_by_refinement( `!x y. x * y < &0 <=> (x < &0 /\ &0 < y) \/ (&0 < x /\ y < &0)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; EQ_TAC; REPEAT STRIP_TAC; CCONTR_TAC; REWRITE_ASSUMS ([REAL_NOT_LT;DE_MORGAN_THM;] @ !REAL_REWRITES); POP_ASSUM MP_TAC THEN STRIP_TAC; CLAIM `x = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; DISCH_THEN (REWRITE_ASSUMS o list); REWRITE_ASSUMS !REAL_REWRITES; ASM_MESON_TAC !REAL_REWRITES; CLAIM `&0 * &0 <= x * y`; MATCH_MP_TAC REAL_LE_MUL2; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REAL_SIMP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; CLAIM `&0 * &0 <= --x * --y`; MATCH_MP_TAC REAL_LE_MUL2; REAL_SIMP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REAL_SIMP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; CLAIM `y = &0`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; DISCH_THEN (REWRITE_ASSUMS o list); REWRITE_ASSUMS !REAL_REWRITES; ASM_REWRITE_TAC[]; EVERY_ASSUM MP_TAC THEN ARITH_TAC; (* save *) REPEAT STRIP_TAC; CLAIM `&0 < --x`; EVERY_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `&0 * &0 < --x * y`; MATCH_MP_TAC REAL_LT_MUL2; REAL_SIMP_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REAL_SIMP_TAC; REWRITE_TAC[REAL_ARITH `--y * x = --(y * x)`]; REAL_ARITH_TAC; CLAIM `&0 < --y`; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; STRIP_TAC; CLAIM `&0 * &0 < x * --y`; MATCH_MP_TAC REAL_LT_MUL2; REAL_SIMP_TAC; ASM_REWRITE_TAC[]; REAL_SIMP_TAC; REWRITE_TAC[REAL_ARITH `x * --y = --(x * y)`]; REAL_ARITH_TAC; ]);; (* }}} *) let REAL_MUL_GT = prove_by_refinement( `!x y. &0 < x * y <=> (x < &0 /\ y < &0) \/ (&0 < x /\ &0 < y)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; EQ_TAC; REPEAT STRIP_TAC; ONCE_REWRITE_ASSUMS[ARITH_RULE `x < y <=> -- y < -- x`]; REWRITE_ASSUMS[GSYM REAL_MUL_RNEG]; REWRITE_ASSUMS[REAL_ARITH `-- &0 = &0`; REAL_MUL_LT]; POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC; DISJ1_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; REPEAT STRIP_TAC; ONCE_REWRITE_TAC [ARITH_RULE `x * y = --x * --y`]; ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; MATCH_MP_TAC REAL_LT_MUL2; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; MATCH_MP_TAC REAL_LT_MUL2; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ]);; (* }}} *) let REAL_DIV_INV = prove_by_refinement( `!y z. &0 < y /\ y < z ==> &1 / z < &1 / y`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_TAC[real_div]; REAL_SIMP_TAC; MATCH_MP_TAC REAL_LT_INV2; ASM_MESON_TAC[]; ]);; (* }}} *) let REAL_DIV_DENOM_LT = prove_by_refinement( `!x y z. &0 < x /\ &0 < y /\ y < z ==> x / z < x / y`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LT_LCANCEL_IMP; EXISTS_TAC `inv x`; REPEAT STRIP_TAC; REAL_SOLVE_TAC; REWRITE_TAC[real_div]; ASM_SIMP_TAC[REAL_LT_IMP_NZ;REAL_MUL_ASSOC;REAL_MUL_LINV;]; REAL_SIMP_TAC; MATCH_MP_TAC (REWRITE_RULE [REAL_MUL_LID;real_div] REAL_DIV_INV); ASM_MESON_TAC[]; ]);; (* }}} *) let REAL_DIV_DENOM_LE = prove_by_refinement( `!x y z. &0 <= x /\ &0 < y /\ y <= z ==> x / z <= x / y`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CASES_ON `x = &0`; ASM_REWRITE_TAC[]; REWRITE_TAC[real_div;REAL_MUL_LZERO;REAL_LE_REFL]; MATCH_MP_TAC REAL_LE_LCANCEL_IMP; EXISTS_TAC `inv x`; REPEAT STRIP_TAC; MATCH_MP_TAC REAL_LT_INV; ASM_MESON_TAC[REAL_LT_LE]; REWRITE_TAC[real_div]; ASM_SIMP_TAC[REAL_LT_IMP_NZ;REAL_MUL_ASSOC;REAL_MUL_LINV;]; REAL_SIMP_TAC; MATCH_MP_TAC REAL_LE_INV2; ASM_REWRITE_TAC[]; ]);; (* }}} *) let REAL_NEG_DIV = prove_by_refinement( `!x y. -- x / -- y = x / y`, (* {{{ Proof *) [ REWRITE_TAC[real_div]; REWRITE_TAC[REAL_INV_NEG]; REAL_ARITH_TAC; ]);; (* }}} *) let REAL_GT_IMP_NZ = prove( `!x. x < &0 ==> ~(x = &0)`, (* {{{ Proof *) REAL_ARITH_TAC);; (* }}} *) let REAL_NEG_NZ = prove( `!x. x < &0 ==> ~(x = &0)`, (* {{{ Proof *) REAL_ARITH_TAC);; (* }}} *) let PARITY_POW_LT = prove_by_refinement( `!a n. a < &0 ==> (EVEN n ==> a pow n > &0) /\ (ODD n ==> a pow n < &0)`, (* {{{ Proof *) [ STRIP_TAC; INDUCT_TAC; REWRITE_TAC[EVEN;ODD;real_pow]; REAL_ARITH_TAC; DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); REWRITE_TAC[EVEN;ODD;real_pow;NOT_EVEN;NOT_ODD]; DISJ_CASES_TAC (ISPEC `n:num` EVEN_OR_ODD); ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[real_gt;REAL_MUL_GT]; ASM_MESON_TAC[EVEN_AND_ODD]; ASM_REWRITE_TAC[real_gt;REAL_MUL_LT]; ASM_MESON_TAC[real_gt]; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[real_gt;REAL_MUL_LT;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[EVEN_AND_ODD]; ]);; (* }}} *) let EVEN_ODD_POW = prove_by_refinement( `!a n. a <> &0 ==> (EVEN n ==> a pow n > &0) /\ (ODD n ==> a < &0 ==> a pow n < &0) /\ (ODD n ==> a > &0 ==> a pow n > &0)`, (* {{{ Proof *) [ REWRITE_TAC[NEQ]; REPEAT_N 2 STRIP_TAC; CLAIM `a < &0 \/ a > &0 \/ (a = &0)`; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; STRIP_TAC; REPEAT STRIP_TAC; ASM_MESON_TAC[PARITY_POW_LT]; ASM_MESON_TAC[PARITY_POW_LT]; ASM_MESON_TAC[REAL_POW_LT;real_gt]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt]; EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; ASM_MESON_TAC[REAL_POW_LT;real_gt]; ASM_REWRITE_TAC[]; ]);; (* }}} *) hol-light/Rqe/rqe_tactics_ext.ml000066400000000000000000000203541303454263000172130ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Labels *) (* ---------------------------------------------------------------------- *) let labels_flag = ref false;; let LABEL_ALL_TAC:tactic = let mk_label avoid = let rec mk_one_label i avoid = let label = "Z-"^(string_of_int i) in if not(mem label avoid) then label else mk_one_label (i+1) avoid in mk_one_label 0 avoid in let update_label i asl = let rec f_at_i f j = function [] -> [] | a::b -> if (j=0) then (f a)::b else a::(f_at_i f (j-1) b) in let avoid = map fst asl in let current = el i avoid in let new_label = mk_label avoid in if (String.length current > 0) then asl else f_at_i (fun (_,y) -> (new_label,y) ) i asl in fun (asl,w) -> let aslp = ref asl in (for i=0 to ((length asl)-1) do (aslp := update_label i !aslp) done; (ALL_TAC (!aslp,w)));; let e tac = refine(by(VALID (if !labels_flag then (tac THEN LABEL_ALL_TAC) else tac)));; (* ---------------------------------------------------------------------- *) (* Refinement *) (* ---------------------------------------------------------------------- *) let prove_by_refinement(t,(tacl:tactic list)) = let gstate = mk_goalstate ([],t) in let _,sgs,just = rev_itlist (fun tac gs -> by (if !labels_flag then (tac THEN LABEL_ALL_TAC) else tac) gs) tacl gstate in let th = if sgs = [] then just null_inst [] else failwith "BY_REFINEMENT_PROOF: Unsolved goals" in let t' = concl th in if t' = t then th else try EQ_MP (ALPHA t' t) th with Failure _ -> failwith "prove_by_refinement: generated wrong theorem";; (* ---------------------------------------------------------------------- *) (* Term Type Inference Tactics *) (* ---------------------------------------------------------------------- *) let exclude_list = ref ["=";"FINITE";"COND";"@";"!";"?";"UNION";"DELETE";"CARD";"swap";"IN"];; (* exclude is needed because polymorphic operators were causing problems *) let get_var_list tm = let rec get_var_list tm = match tm with Var(name,ty) -> [name,ty] | Const(name,ty) -> [name,ty] | Abs(bv,bod) -> union (get_var_list bv) (get_var_list bod) | Comb(s,t) -> union (get_var_list s) (get_var_list t) in filter (fun x -> not (mem (fst x) !exclude_list)) (get_var_list tm);; let rec auto_theta new_type old_type = let tyvar_prefix = "?" in let is_generated ty_name = let first_char = hd(explode ty_name) in if first_char = tyvar_prefix then true else false in match new_type with Tyvar(ns) -> (match old_type with Tyvar(os) -> if is_generated ns then [old_type,new_type] else [] | Tyapp (old_name,old_list) -> [old_type,new_type]) | Tyapp(new_ty_op,new_ty_list) -> (match old_type with Tyvar _ -> [] | Tyapp (old_ty_op,old_ty_list) -> if new_ty_op = old_ty_op then itlist2 (fun newt oldt b -> union (auto_theta newt oldt) b) new_ty_list old_ty_list [] else []);; let rec auto_theta_list newl oldl = match newl with [] -> [] | (h::t) -> let head_list = (try let new_name,new_type = h in let old_type = assoc new_name oldl in (auto_theta new_type old_type) with Failure _ -> []) in union head_list (auto_theta_list t oldl);; let auto_type new_tm old_tm = let old_list = get_var_list old_tm in let new_list = get_var_list new_tm in let theta = auto_theta_list new_list old_list in inst theta new_tm;; let rec auto_type_list tm tml = match tml with [] -> tm | (h::t) -> auto_type_list (auto_type tm h) t;; let auto_type_goal tm (asl,w) = let thm_list = snd(unzip asl) in let term_list = map (fun x -> snd (dest_thm x)) thm_list in auto_type_list tm ([w] @ term_list);; let TYPE_TAC (f:term->tactic) tm = function (asl,w) as g -> let typed_term = auto_type_goal tm g in f typed_term g;; let TYPE_TACL (f:term list -> tactic) tml = function (asl,w) as g -> let typed_terms = map (C auto_type_goal g) tml in f typed_terms g;; (* ---------------------------------------------------------------------- *) (* Unfiled *) (* ---------------------------------------------------------------------- *) let CLAIM t = TYPE_TAC (C SUBGOAL_THEN MP_TAC) t;; let lem = TAUT `(a = b) <=> (a ==> b) /\ (b ==> a)`;; let MATCH_EQ_MP t1 t2 = try EQ_MP t1 t2 with Failure _ -> let k1 = (SPEC_ALL (PURE_REWRITE_RULE[lem] t1)) in let left,right = CONJUNCT1 k1,CONJUNCT2 k1 in try MATCH_MP left t2 with Failure _ -> try MATCH_MP right t2 with Failure _ -> failwith "MATCH_EQ_MP";; let MATCH_EQ_MP_TAC thm = let t1,t2 = EQ_IMP_RULE (SPEC_ALL thm) in MATCH_MP_TAC t1 ORELSE MATCH_MP_TAC t2;; let rec REPEAT_N_CONV n conv = if n = 0 then ALL_CONV else conv THENC (REPEAT_N_CONV (n-1) conv);; let rec REPEAT_N n tac = if n = 0 then ALL_TAC else tac THEN REPEAT_N (n-1) tac;; let dest_goal g = let (asms,conc) = g in (asms:(string * thm) list),(conc:term);; let DISJ_LCASE g = let _,c = dest_goal g in let l,r = dest_disj c in let thm = ISPEC l EXCLUDED_MIDDLE in (DISJ_CASES_TAC thm THENL [ DISJ1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; DISJ2_TAC ]) g;; let DISJ_RCASE g = let _,c = dest_goal g in let l,r = dest_disj c in let thm = ISPEC r EXCLUDED_MIDDLE in (DISJ_CASES_TAC thm THENL [ DISJ2_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; DISJ1_TAC ]) g;; let CASES_ON tm = let ty,_ = dest_type (type_of tm) in match ty with "num" -> DISJ_CASES_TAC (SPEC tm num_CASES) THENL [ POP_ASSUM SUBST1_TAC; POP_ASSUM STRIP_ASSUME_TAC THEN POP_ASSUM SUBST1_TAC ] | "bool" -> DISJ_CASES_TAC (SPEC tm EXCLUDED_MIDDLE) | _ -> failwith "not a case type";; let CASES_ON t = TYPE_TAC CASES_ON t;; let EXISTS_TAC t = TYPE_TAC EXISTS_TAC t;; let REWRITE_ASSUMS thl = RULE_ASSUM_TAC (REWRITE_RULE thl);; let ONCE_REWRITE_ASSUMS thl = RULE_ASSUM_TAC (ONCE_REWRITE_RULE thl);; let REWRITE_ALL thl = REWRITE_ASSUMS thl THEN REWRITE_TAC thl;; let USE_IASSUM n = USE_THEN ("Z-" ^ string_of_int n);; let PROVE_ASSUM_ANTECEDENT_TAC n = fun ((asl,w) as g) -> let assum = assoc ("Z-" ^ string_of_int n) asl in let ant,_ = dest_imp (concl assum) in SUBGOAL_THEN ant (fun x -> (USE_IASSUM n (fun y-> ASSUME_TAC (MATCH_MP y x)))) g;; let FALSE_ANTECEDENT_TAC = fun ((asl,w) as g) -> let l,r = dest_imp w in (SUBGOAL_THEN (mk_neg l) (fun x -> REWRITE_TAC[x])) g;; let REWRITE_ASSUMS thl = RULE_ASSUM_TAC (REWRITE_RULE thl);; let ONCE_REWRITE_ASSUMS thl = RULE_ASSUM_TAC (ONCE_REWRITE_RULE thl);; let REWRITE_ALL_TAC l = REWRITE_ASSUMS l THEN REWRITE_TAC l;; let rec MATCH_MPL thms = match thms with [thm] -> thm | impl::ant::rest -> MATCH_MPL ((MATCH_MP impl ant)::rest);; let rec MATCH_EQ_MPL thms = match thms with [thm] -> thm | impl::ant::rest -> MATCH_EQ_MPL ((MATCH_EQ_MP impl ant)::rest);; (* MATCH_MPL [ASSUME `a ==> b ==> c ==> d`;ASSUME `a:bool`;ASSUME `b:bool`;ASSUME `c:bool`] ;; *) let (USE_ASSUM_LIST: string list -> thm_tactic -> tactic) = fun l ttac ((asl,w) as g) -> try let l' = assoc_list l asl in let l'' = map ttac l' in (EVERY l'') g with Failure _ -> failwith "USE_ASSUM_LIST";; let (KEEP: string list -> tactic) = fun l (asl,w) -> try let asl' = filter (fun x -> mem (fst x) l) asl in ALL_TAC (asl',w) with Failure _ -> failwith "USE_ASSUM_LIST";; let PROVE_THM_ANTECEDENT_TAC thm = let ant,cons = dest_imp (concl thm) in SUBGOAL_THEN ant (fun x -> MP_TAC (MATCH_MP thm x));; let MOVE_TO_FRONT s = fun (asl,w) -> let k,asl' = remove (fun x -> fst x = s) asl in ALL_TAC (k::asl',w);; let IGNORE x = ALL_TAC;; let CCONTR_TAC = MATCH_MP_TAC (TAUT `(~x ==> F) ==> x`) THEN STRIP_TAC;; let DISCH_ASS = DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x);; let pgoal() = !current_goalstack;; hol-light/Rqe/signs.ml000066400000000000000000000265341303454263000151630ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Find sign of polynomial, using modulo-constant lookup and computation. *) (* ------------------------------------------------------------------------- *) let xterm_lt t1 t2 = try let n1,_ = dest_var t1 in let n2,_ = dest_var t2 in let i1 = String.sub n1 2 (String.length n1 - 2) in let i2 = String.sub n2 2 (String.length n2 - 2) in let x1 = int_of_string i1 in let x2 = int_of_string i2 in x1 < x2 with _ -> failwith "xterm_lt: not an xvar?";; (* String.sub n1 2 (String.length n1 - 2) substring let t1,t2 = `x_99:real`,`x_100:real` xterm_sort t1 t2 t1 < t2 *) let FINDSIGN = let p_tm = `p:real` and c_tm = `c:real` and fth = prove (`r (a * b * p) (&0) ==> (a * b = &1) ==> r p (&0)`, DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID]) in let rec FINDSIGN vars sgns p = try try SIGN_CONST p with Failure _ -> let mth = MONIC_CONV vars p in let p' = rand(concl mth) in let pth = find (fun th -> lhand(concl th) = p') sgns in let c = lhand(lhand(concl mth)) in let c' = term_of_rat(Int 1 // rat_of_term c) in let sth = SIGN_CONST c' in let rel_c = funpow 2 rator (concl sth) in let rel_p = funpow 2 rator (concl pth) in let th1 = if rel_p = req then if rel_c = rgt then pth_0g else pth_0l else if rel_p = rgt then if rel_c = rgt then pth_gg else pth_gl else if rel_p = rlt then if rel_c = rgt then pth_lg else pth_ll else if rel_p = rneq then if rel_c = rgt then pth_nzg else pth_nzl else failwith "FINDSIGN" in let th2 = MP (MP (INST [p',p_tm; c',c_tm] th1) pth) sth in let th3 = EQ_MP (LAND_CONV(RAND_CONV(K(SYM mth))) (concl th2)) th2 in let th4 = MATCH_MP fth th3 in MP th4 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th4)))) with Failure _ -> failwith "FINDSIGN" in FINDSIGN;; (* let vars = [`x:real`;`y:real`] let p = `&7 + x * (&11 + x * (&10 + y * &7))` let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) < &0`] let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) = &0`] let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) > &0`] let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] FINDSIGN vars sgns p FINDSIGN vars sgns `-- &1` *) (* ASSERTSIGN [x,y] [] (|- &7 + x * (&11 + x * (&10 + y * -- &7)) < &0 --> [-- &1 + x * (-- &11 / &7 + x * (-- &10 / &7 + y * &1)) > &0] ASSERTSIGN [x,y] [] (|- &7 + x * (&11 + x * (&10 + y * &7)) < &0 --> [&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) < &0] *) let ASSERTSIGN vars sgns sgn_thm = let op,l,r = get_binop (concl sgn_thm) in let p_thm = MONIC_CONV vars l in let _,pl,pr = get_binop (concl p_thm) in let c,_ = dest_binop rm pl in let c_thm = SIGN_CONST c in let c_op,_,_ = get_binop (concl c_thm) in let sgn_thm' = if c_op = rlt && op = rlt then MATCH_MPL[signs_lem01;c_thm;sgn_thm;p_thm] else if c_op = rgt && op = rlt then MATCH_MPL[signs_lem02;c_thm;sgn_thm;p_thm] else if c_op = rlt && op = rgt then MATCH_MPL[signs_lem03;c_thm;sgn_thm;p_thm] else if c_op = rgt && op = rgt then MATCH_MPL[signs_lem04;c_thm;sgn_thm;p_thm] else if c_op = rlt && op = req then MATCH_MPL[signs_lem05;c_thm;sgn_thm;p_thm] else if c_op = rgt && op = req then MATCH_MPL[signs_lem06;c_thm;sgn_thm;p_thm] else if c_op = rlt && op = rneq then MATCH_MPL[signs_lem07;c_thm;sgn_thm;p_thm] else if c_op = rgt && op = rneq then MATCH_MPL[signs_lem08;c_thm;sgn_thm;p_thm] else failwith "ASSERTSIGN : 0" in try let sgn_thm'' = find (fun th -> lhand(concl th) = pr) sgns in let op1,l1,r1 = get_binop (concl sgn_thm') in let op2,l2,r2 = get_binop (concl sgn_thm'') in if (concl sgn_thm') = (concl sgn_thm'') then sgns else if op2 = rneq && (op1 = rlt || op1 = rgt) then sgn_thm'::snd (remove ((=) sgn_thm'') sgns) else failwith "ASSERTSIGN : 1" with Failure "find" -> sgn_thm'::sgns;; (* let k0 = `&7 + x * (&11 + x * (&10 + y * -- &7))` MONIC_CONV vars k0 let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) < &0` let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` let sgn_thm = k1 ASSERTSIGN vars [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] k1 *) (* ---------------------------------------------------------------------- *) (* Case splitting *) (* ---------------------------------------------------------------------- *) let SPLIT_ZERO vars sgns p cont_z cont_n ex_thms = try let sgn_thm = FINDSIGN vars sgns p in let op,l,r = get_binop (concl sgn_thm) in (if op = req then cont_z else cont_n) sgns ex_thms with Failure "FINDSIGN" -> let eq_tm = mk_eq(p,rzero) in let neq_tm = mk_neq(p,rzero) in let or_thm = ISPEC p signs_lem002 in (* zero *) let z_thm = cont_z (ASSERTSIGN vars sgns (ASSUME eq_tm)) ex_thms in let z_thm' = DISCH eq_tm z_thm in (* nonzero *) let nz_thm = cont_n (ASSERTSIGN vars sgns (ASSUME neq_tm)) ex_thms in let nz_thm' = DISCH neq_tm nz_thm in (* combine *) let ret = MATCH_MPL[signs_lem003;or_thm;z_thm';nz_thm'] in (* matching problem... must continue by hand *) let ldj,rdj = dest_disj (concl ret) in let lcj,rcj = dest_conj ldj in let a,_ = dest_binop req lcj in let p,p1 = dest_beq rcj in let _,rcj = dest_conj rdj in let p2 = rhs rcj in let pull_thm = ISPECL[a;p;p1;p2] PULL_CASES_THM in let ret' = MATCH_EQ_MP pull_thm ret in ret';; (* let ret = MATCH_MPL[lem3;or_thm] MATCH_MP ret z_thm' ;nz_thm'] in let vars,sgns,p,cont_z,cont_n,ex_thms = !sz_vars, !sz_sgns, !sz_p,!sz_cont_z, !sz_cont_n ,!sz_ex_thms let ret = MATCH_MPL[lem3;or_thm;] let mp_thm = MATCH_MPL[lem3;or_thm;] in let vars, sgns, p,cont_z, cont_n = !sz_vars,!sz_sgns,!sz_p,!sz_cont_z,!sz_cont_n let mp_thm = k1 let t1 = ISPECL[`(?y. &0 + y * (&0 + x * &1) = &0)`;`T`;`T`;`&0 + x * &1`;`T`] t0 MATCH_EQ_MP t1 k1 EQ_MP t1 k1 MATCH_EQ_MP PULL_CASES_THM k1 concl k1 = lhs (concl t1) MATCH_EQ_MP PULL_CASES_THM k0 let k0 = ASSUME `(&0 + x * &1 = &0) /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T) \/ &0 + x * &1 <> &0 /\ (&0 + x * &1 > &0 /\ ((?x_1089. &0 + x_1089 * (&0 + x * &1) = &0) <=> T) \/ &0 + x * &1 < &0 /\ ((?x_1084. &0 + x_1084 * (&0 + x * &1) = &0) <=> T))`;; let k1 = ASSUME `(&0 + x * &1 = &0) /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T) \/ &0 + x * &1 <> &0 /\ (&0 + x * &1 > &0 /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T) \/ &0 + x * &1 < &0 /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T))`;; MATCH_MPL[PULL_CASES_THM;!sz_z_thm;!sz_nz_thm] in let thm1 = ASSUME `(?x_32. (&0 + c * &1) + x_32 * ((&0 + b * &1) + x_32 * (&0 + a * &1)) = &0) <=> T` let thm2 = ASSUME `(&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 ==> ((?x. (&0 + c * &1) + x * ((&0 + b * &1) + x * (&0 + a * &1)) = &0) <=> F)) /\ (&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 ==> ((?x_26. (&0 + c * &1) + x_26 * ((&0 + b * &1) + x_26 * (&0 + a * &1)) = &0) <=> T)) ` MATCH_MPL (* let PULL_CASES_THM = prove_by_refinement( *) (* `((a = &0) ==> (p <=> p0)) ==> ((a <> &0) ==> (a < &0 ==> (p <=> p1)) /\ (a > &0 ==> (p <=> p2))) *) (* ==> (p <=> ((a = &0) /\ p0) \/ ((a < &0) /\ p1) \/ (a > &0 /\ p2))`, *) (* (\* {{{ Proof *\) [ REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN ASM_REWRITE_TAC[NEQ] THEN TRY REAL_ARITH_TAC ]);; (\* }}} *\) *) let PULL_CASES_THM = prove (`!a p p0 p1 p2. ((a = &0) /\ (p <=> p0) \/ (a <> &0) /\ (a > &0 /\ (p <=> p1) \/ a < &0 /\ (p <=> p2))) <=> ((p <=> (a = &0) /\ p0 \/ a > &0 /\ p1 \/ a < &0 /\ p2))`, (* {{{ Proof *) REPEAT STRIP_TAC THEN REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; (* }}} *) let vars, sgns, p, cont_z, cont_n = [`x:real`;`y:real`], empty_sgns, `&0 + y * &1`, (fun x -> (ASSUME `abc > def`,[])), (fun x -> (ASSUME `sean > steph`,[])) SPLIT_ZERO vars sgns p cont_z cont_n ASSERTSIGN vars empty_sgns (ASSUME `&0 + y * &1 = &0`) , let vars = [`x:real`;`y:real`] let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` let cont_z = hd let cont_n = hd SPLIT_ZERO vars sgns p cont_z cont_n let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` let sgn_thm = k1 ASSERTSIGN vars [] k1 *) let SPLIT_SIGN vars sgns p cont_p cont_n ex_thms = let sgn_thm = try FINDSIGN vars sgns p with Failure "FINDSIGN" -> failwith "SPLIT_SIGN: no sign -- should have sign assumption by now" in let gt_tm = mk_binop rgt p rzero in let lt_tm = mk_binop rlt p rzero in let op,_,_ = get_binop (concl sgn_thm) in if op = rgt then cont_p sgns ex_thms else if op = rlt then cont_n sgns ex_thms else if op = req then failwith "SPLIT_SIGN: lead coef is 0" else if op = rneq then let or_thm = MATCH_MP signs_lem0002 sgn_thm in (* < *) let lt_sgns = ASSERTSIGN vars sgns (ASSUME lt_tm) in let lt_thm = cont_n lt_sgns ex_thms in let lt_thm' = DISCH lt_tm lt_thm in (* > *) let gt_sgns = ASSERTSIGN vars sgns (ASSUME gt_tm) in let gt_thm = cont_p gt_sgns ex_thms in let gt_thm' = DISCH gt_tm gt_thm in (* combine *) let ret = MATCH_MPL[signs_lem0003;or_thm;gt_thm';lt_thm'] in (* matching problem... must continue by hand *) let ldj,rdj = dest_disj (concl ret) in let lcj,rcj = dest_conj ldj in let a,_ = dest_binop rgt lcj in let p,p1 = dest_beq rcj in let _,rcj = dest_conj rdj in let p2 = rhs rcj in let pull_thm = ISPECL[a;p;p1;p2] PULL_CASES_THM_NZ in let ret' = MATCH_EQ_MP (MATCH_MP pull_thm sgn_thm) ret in ret' else failwith "SPLIT_SIGN: unknown op";; (* let vars, sgns, p,cont_p, cont_n = !ss_vars,!ss_sgns,!ss_p,!ss_cont_p,!ss_cont_n [`x`], [ASSUME `&0 + x * &1 <> &0`; ARITH_RULE ` &1 > &0`], `&0 + x * &1` let ss_vars, ss_sgns, ss_p,ss_cont_p, ss_cont_n = ref [],ref [],ref `T`,ref (fun x -> TRUTH,[]),ref(fun x -> TRUTH,[]);; ss_vars := vars; ss_sgns := sgns; ss_p := p; ss_cont_p := cont_p; ss_cont_n := cont_n; let vars, sgns, p, cont_p, cont_n = [`x:real`;`y:real`], ASSERTSIGN vars empty_sgns (ASSUME `&0 + y * &1 <> &0`) , `&0 + y * &1`, (fun x -> (ASSUME `P > def`,[])), (fun x -> (ASSUME `sean > steph`,[])) SPLIT_SIGN vars sgns p cont_z cont_n let vars = [`x:real`;`y:real`] let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` let cont_p = hd let cont_n = hd SPLIT_SIGN vars sgns p cont_p cont_n let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` let sgn_thm = k1 ASSERTSIGN vars [] k1 *) hol-light/Rqe/signs_thms.ml000066400000000000000000000072261303454263000162130ustar00rootroot00000000000000let [pth_0g;pth_0l;pth_gg;pth_gl;pth_lg;pth_ll] = (CONJUNCTS o prove) (`((p = &0) ==> c > &0 ==> (c * p = &0)) /\ ((p = &0) ==> c < &0 ==> (c * p = &0)) /\ (p > &0 ==> c > &0 ==> c * p > &0) /\ (p > &0 ==> c < &0 ==> c * p < &0) /\ (p < &0 ==> c > &0 ==> c * p < &0) /\ (p < &0 ==> c < &0 ==> c * p > &0)`, SIMP_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[REAL_ARITH `(x > &0 <=> &0 < x) /\ (x < &0 <=> &0 < --x)`; REAL_ARITH `~(p = &0) <=> p < &0 \/ p > &0`] THEN REWRITE_TAC[IMP_IMP] THEN REPEAT CONJ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN REAL_ARITH_TAC);; let pth_nzg = prove_by_refinement( `p <> &0 ==> c > &0 ==> c * p <> &0`, (* {{{ Proof *) [ REWRITE_TAC[NEQ;REAL_ENTIRE] THEN REAL_ARITH_TAC; ]);; (* }}} *) let pth_nzl = prove_by_refinement( `p <> &0 ==> c < &0 ==> c * p <> &0`, (* {{{ Proof *) [ REWRITE_TAC[NEQ;REAL_ENTIRE] THEN REAL_ARITH_TAC; ]);; (* }}} *) let signs_lem01 = prove_by_refinement( `c < &0 ==> p < &0 ==> (c * p = p') ==> p' > &0`, (* {{{ Proof *) [ ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; ]);; (* }}} *) let signs_lem02 = prove_by_refinement( `c > &0 ==> p < &0 ==> (c * p = p') ==> p' < &0`, (* {{{ Proof *) [ ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; ]);; (* }}} *) let signs_lem03 = prove_by_refinement( `c < &0 ==> p > &0 ==> (c * p = p') ==> p' < &0`, (* {{{ Proof *) [ ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; ]);; (* }}} *) let signs_lem04 = prove_by_refinement( `c > &0 ==> p > &0 ==> (c * p = p') ==> p' > &0`, (* {{{ Proof *) [ ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; ]);; (* }}} *) let signs_lem05 = prove_by_refinement( `c < &0 ==> (p = &0) ==> (c * p = p') ==> (p' = &0)`, (* {{{ Proof *) [ ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO]; ]);; (* }}} *) let signs_lem06 = prove_by_refinement( `c > &0 ==> (p = &0) ==> (c * p = p') ==> (p' = &0)`, (* {{{ Proof *) [ ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO]; ]);; (* }}} *) let signs_lem07 = prove_by_refinement( `c < &0 ==> p <> &0 ==> (c * p = p') ==> p' <> &0`, (* {{{ Proof *) [ ASM_MESON_TAC[NEQ;REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO;REAL_ENTIRE;REAL_GT_IMP_NZ]; ]);; (* }}} *) let signs_lem08 = prove_by_refinement( `c > &0 ==> p <> &0 ==> (c * p = p') ==> p' <> &0`, (* {{{ Proof *) [ ASM_MESON_TAC[NEQ;REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO;REAL_ENTIRE;REAL_LT_IMP_NZ]; ]);; (* }}} *) let signs_lem002 = prove_by_refinement( `!p. (p = &0) \/ (p <> &0)`, (* {{{ Proof *) [ MESON_TAC[NEQ]; ]);; (* }}} *) let signs_lem003 = TAUT `a \/ b ==> (a ==> x) ==> (b ==> y) ==> (a /\ x \/ b /\ y)`;; let sz_z_thm = ref TRUTH;; let sz_nz_thm = ref TRUTH;; let PULL_CASES_THM = prove (`!a p p0 p1. ((a = &0) /\ (p <=> p0) \/ (a <> &0) /\ (p <=> p1)) <=> ((p <=> (a = &0) /\ p0 \/ a <> &0 /\ p1 ))`, (* {{{ Proof *) REPEAT STRIP_TAC THEN REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; (* }}} *) let signs_lem0002 = prove( `!p. p <> &0 ==> (p > &0) \/ (p < &0)`,REWRITE_TAC [NEQ] THEN REAL_ARITH_TAC);; let signs_lem0003 = TAUT `a \/ b ==> (a ==> x) ==> (b ==> y) ==> (a /\ x \/ b /\ y)`;; let PULL_CASES_THM_NZ = prove (`!a p p1 p2. (a <> &0) ==> ((a > &0 /\ (p <=> p1) \/ a < &0 /\ (p <=> p2)) <=> ((p <=> a > &0 /\ p1 \/ a < &0 /\ p2)))`, (* {{{ Proof *) REWRITE_TAC[NEQ] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN ASM_REWRITE_TAC[] THEN TRY (POP_ASSUM MP_TAC THEN REAL_ARITH_TAC) );; (* }}} *) hol-light/Rqe/simplify.ml000066400000000000000000000120741303454263000156660ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Simplification *) (* ---------------------------------------------------------------------- *) (* let psimplify1 fm = match fm with Not False -> True | Not True -> False | And(False,q) -> False | And(p,False) -> False | And(True,q) -> q | And(p,True) -> p | Or(False,q) -> q | Or(p,False) -> p | Or(True,q) -> True | Or(p,True) -> True | Imp(False,q) -> True | Imp(True,q) -> q | Imp(p,True) -> True | Imp(p,False) -> Not p | Iff(True,q) -> q | Iff(p,True) -> p | Iff(False,q) -> Not q | Iff(p,False) -> Not p | _ -> fm;; *) let PSIMPLIFY1_CONV = let nt = `~T` and t = `T` and f = `F` and nf = `~F` in fun fm -> try let fm' = if fm = nt then f else if fm = nf then t else if is_conj fm then let l,r = dest_conj fm in if l = f || r = f then f else if l = t then r else if r = t then l else fm else if is_disj fm then let l,r = dest_disj fm in if l = t || r = t then t else if l = f then r else if r = f then l else fm else if is_imp fm then let l,r = dest_imp fm in if l = f then t else if r = t then t else if l = t then r else if r = f then mk_neg l else fm else if is_iff fm then let l,r = dest_beq fm in if l = f then mk_neg r else if l = t then r else if r = t then l else if r = f then mk_neg l else fm else failwith "PSIMPLIFY: 0" in let fm'' = mk_eq(fm,fm') in prove(fm'',REWRITE_TAC[]) with _ -> REFL fm;; (* let fm = `T /\ T` PSIMPLIFY1_CONV `T /\ A` let simplify1 fm = match fm with Forall(x,p) -> if mem x (fv p) then fm else p | Exists(x,p) -> if mem x (fv p) then fm else p | _ -> psimplify1 fm;; *) let SIMPLIFY1_CONV fm = if is_forall fm || is_exists fm then let x,p = dest_forall fm in if mem x (frees p) then REFL fm else prove(mk_eq(fm,p),REWRITE_TAC[]) else PSIMPLIFY1_CONV fm;; (* let rec simplify fm = match fm with Not p -> simplify1 (Not(simplify p)) | And(p,q) -> simplify1 (And(simplify p,simplify q)) | Or(p,q) -> simplify1 (Or(simplify p,simplify q)) | Imp(p,q) -> simplify1 (Imp(simplify p,simplify q)) | Iff(p,q) -> simplify1 (Iff(simplify p,simplify q)) | Forall(x,p) -> simplify1(Forall(x,simplify p)) | Exists(x,p) -> simplify1(Exists(x,simplify p)) | _ -> fm;; *) let rec SIMPLIFY_CONV = let not_tm = `(~)` and ex_tm = `(?)` in fun fm -> if is_neg fm then let thm1 = SIMPLIFY_CONV (dest_neg fm) in let thm2 = AP_TERM not_tm thm1 in let l,r = dest_eq (concl thm2) in let thm3 = SIMPLIFY1_CONV r in TRANS thm2 thm3 else if is_conj fm || is_disj fm || is_imp fm || is_iff fm then let op,l,r = get_binop fm in let l_thm = SIMPLIFY_CONV l in let r_thm = SIMPLIFY_CONV r in let a_thm = (curry MK_COMB) (AP_TERM op l_thm) r_thm in let al,ar = dest_eq (concl a_thm) in let thm = SIMPLIFY1_CONV ar in TRANS a_thm thm else if is_forall fm || is_exists fm then let x,bod = dest_quant fm in let bod_thm = SIMPLIFY_CONV bod in let lam_thm = ABS x bod_thm in let q_thm = AP_TERM ex_tm lam_thm in let l,r = dest_eq (concl q_thm) in let thm = SIMPLIFY1_CONV r in TRANS q_thm thm else REFL fm;; (* SIMPLIFY_CONV `T /\ T \/ F` let operations = ["=",(=/); "<",(",(>/); "<=",(<=/); ">=",(>=/); "divides",(fun x y -> mod_num y x =/ Int 0)];; let evalc_atom at = match at with R(p,[s;t]) -> (try if assoc p operations (dest_numeral s) (dest_numeral t) then True else False with Failure _ -> Atom at) | _ -> Atom at;; let evalc = onatoms evalc_atom;; *) let REAL_LEAF_CONV fm = let op,l,r = get_binop fm in if op = rlt then REAL_RAT_LT_CONV fm else if op = rgt then REAL_RAT_GT_CONV fm else if op = rle then REAL_RAT_LE_CONV fm else if op = rge then REAL_RAT_GE_CONV fm else if op = req then REAL_RAT_EQ_CONV fm else failwith "REAL_LEAF_CONV";; let EVALC_CONV = DEPTH_CONV REAL_LEAF_CONV;; (* EVALC_CONV `x < &0 /\ &1 < &2` (EVALC_CONV THENC SIMPLIFY_CONV) `(&0 + a * &1 = &0) /\ ((&0 + b * &1 = &0) /\ ((&0 + c * &1 = &0) /\ T \/ &0 + c * &1 < &0 /\ F \/ &0 + c * &1 > &0 /\ F) \/ &0 + b * &1 < &0 /\ T \/ &0 + b * &1 > &0 /\ T) \/ &0 + a * &1 < &0 /\ ((&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) = &0) /\ T \/ &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 /\ F \/ &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 /\ T) \/ &0 + a * &1 > &0 /\ ((&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) = &0) /\ T \/ &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 /\ T \/ &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 /\ &1 < &2)` *) hol-light/Rqe/testform.ml000066400000000000000000000227201303454263000156740ustar00rootroot00000000000000(* ====================================================================== *) (* TESTFORM *) (* ====================================================================== *) let rec TESTFORM var interpsigns_thm set_thm fm = let polys,set,signs = dest_interpsigns interpsigns_thm in let polys' = dest_list polys in let signs' = dest_list signs in if fm = t_tm then BETA_RULE (ISPECL [set] t_thm) else if fm = f_tm then BETA_RULE (ISPECL [set] f_thm) else if is_neg fm then let lam = mk_abs (var,dest_neg fm) in let thm = TESTFORM var interpsigns_thm set_thm (dest_neg fm) in if is_pos (concl thm) then MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_p)) thm else if is_neg (concl thm) then MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_n)) thm else failwith "error" else if is_conj fm then let a,b = dest_conj fm in let a',b' = mk_abs (var,a),mk_abs (var,b) in let thma = TESTFORM var interpsigns_thm set_thm a in let thmb = TESTFORM var interpsigns_thm set_thm b in if is_neg (concl thma) && is_neg (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_nn);set_thm;thma;thmb] else if is_neg (concl thma) && is_pos (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_np);set_thm;thma;thmb] else if is_pos (concl thma) && is_neg (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_pn);set_thm;thma;thmb] else if is_pos (concl thma) && is_pos (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_pp);set_thm;thma;thmb] else failwith "error" else if is_disj fm then let a,b = dest_disj fm in let a',b' = mk_abs (var,a),mk_abs (var,b) in let thma = TESTFORM var interpsigns_thm set_thm a in let thmb = TESTFORM var interpsigns_thm set_thm b in if is_neg (concl thma) && is_neg (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] or_thm_nn);set_thm;thma;thmb] else if is_pos (concl thma) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] or_thm_p);set_thm;thma] else if is_pos (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] or_thm_q);set_thm;thmb] else failwith "error" else if is_imp fm then let a,b = dest_imp fm in let a',b' = mk_abs (var,a),mk_abs (var,b) in let thma = TESTFORM var interpsigns_thm set_thm a in let thmb = TESTFORM var interpsigns_thm set_thm b in if is_neg (concl thma) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] imp_thm_n);set_thm;thma] else if is_pos (concl thma) && is_neg (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] imp_thm_pn);set_thm;thma;thmb] else if is_pos (concl thma) && is_pos (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] imp_thm_pp);set_thm;thmb] else failwith "error" else if is_iff fm then let a,b = dest_eq fm in let a',b' = mk_abs (var,a),mk_abs (var,b) in let thma = TESTFORM var interpsigns_thm set_thm a in let thmb = TESTFORM var interpsigns_thm set_thm b in if is_neg (concl thma) && is_neg (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_nn);set_thm;thma;thmb] else if is_neg (concl thma) && is_pos (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_np);set_thm;thma;thmb] else if is_pos (concl thma) && is_neg (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_pn);set_thm;thma;thmb] else if is_pos (concl thma) && is_pos (concl thmb) then MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_pp);set_thm;thma;thmb] else failwith "error" else (* an atom *) let op,p,_ = get_binop fm in let lam = mk_abs (var,p) in let ind = try index lam polys' with Failure "index" -> failwith "TESTFORM: Poly not present in list" in let sign = ith ind signs' in let thm = ith ind (interpsigns_thms interpsigns_thm) in let thm_op,thm_p,_ = get_binop (snd (dest_imp (snd (dest_forall (concl thm))))) in if op = req then if thm_op = req then thm else if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_eq_thm);thm] else if thm_op = rgt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_eq_thm);thm] else failwith "error" else if op = rlt then if thm_op = rlt then thm else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_lt_thm);thm] else if thm_op = rgt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_lt_thm);thm] else failwith "error" else if op = rgt then if thm_op = rgt then thm else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_gt_thm);thm] else if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_gt_thm);thm] else failwith "error" else if op = rle then if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_le_thm);thm] else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_le_thm);thm] else if thm_op = rgt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_le_thm);thm] else failwith "error" else if op = rge then if thm_op = rlt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_ge_thm);thm] else if thm_op = req then MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_ge_thm);thm] else if thm_op = rgt then MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_ge_thm);thm] else failwith "error" else failwith "error" ;; let TESTFORM var interpsigns_thm set_thm fm = let start_time = Sys.time() in let res = TESTFORM var interpsigns_thm set_thm fm in testform_timer +.= (Sys.time() -. start_time); res;; let tvar,tmat,tfm = ref `T`,ref TRUTH,ref `T`;; (* let var,mat_thm,fm = !tvar,!tmat,!tfm *) let COMBINE_TESTFORMS = let lem1 = TAUT `(T ==> a) <=> a` and lem2 = TAUT `(T /\ x) <=> x` and imat_tm = `interpmat` in fun var mat_thm fm -> tvar := var; tmat := mat_thm; tfm := fm; (* if not (fst (strip_comb (concl mat_thm)) = imat_tm) then failwith "not a mat thm" else *) let mat_thm' = (CONV_RULE (RATOR_CONV (RAND_CONV (LIST_CONV (ALPHA_CONV var))))) mat_thm in let rol_thm,all2_thm = interpmat_thms mat_thm' in let ord_thms = rol_nonempty_thms rol_thm in let part_thm = PARTITION_LINE_CONV (snd(dest_comb(concl rol_thm))) in let isigns_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] all2_thm) in let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in if exists (fun x -> is_forall(concl x)) ex_thms then let witness_thm = find (fun x -> is_forall(concl x)) ex_thms in let i = try index witness_thm ex_thms with _ -> failwith "COMBINE_TESTFORMS: witness not present" in let ord_thm = ith i ord_thms in let x,bod = dest_exists (concl ord_thm) in if bod = t_tm then let thm1 = ISPEC var witness_thm in let thm2 = PURE_REWRITE_RULE[lem1] thm1 in let exists_thm = EXISTS (mk_exists(var,concl thm2),var) thm2 in EQT_INTRO exists_thm else let nv = new_var real_ty in let ord_thm' = CONV_RULE (RAND_CONV (ALPHA_CONV nv)) ord_thm in let y,bod = dest_exists (concl ord_thm') in let ass_thm = ASSUME bod in let thm = MATCH_MP witness_thm ass_thm in let exists_thm = EXISTS (mk_exists(y,concl thm) ,y) thm in let ret = CHOOSE (nv,ord_thm) exists_thm in EQT_INTRO ret else if length ord_thms = 1 && snd(dest_exists(concl (hd ord_thms))) = t_tm then PURE_REWRITE_RULE[lem2] (EQF_INTRO (hd ex_thms)) else let ex_thms' = map (MATCH_MP NOT_EXISTS_CONJ_THM) ex_thms in let len = length ex_thms' in let first,[t1;t2] = chop_list (len-2) ex_thms' in let base = MATCH_MPL[testform_itlem;t1;t2] in let ex_thm = itlist (fun x y -> MATCH_MPL[testform_itlem;x;y]) first base in let cover_thm = ROL_COVERS rol_thm in let pre_thm = MATCH_MP ex_thm (ISPEC var cover_thm) in let gen_thm = GEN var pre_thm in let ret = MATCH_EQ_MP FORALL_NOT_THM gen_thm in EQF_INTRO ret;; let COMBINE_TESTFORMS var mat_thm fm = let start_time = Sys.time() in let res = COMBINE_TESTFORMS var mat_thm fm in combine_testforms_timer +.= (Sys.time() -. start_time); res;; (* {{{ Examples *) (* let var,mat_thm,fm = rx,ASSUME `interpsigns [\x. &1 + x * (&0 + x * &1)] (\x. T) [Pos]`,ASSUME `?x:real. T` let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in TESTFORM ry (hd isigns_thms) (hd ord_thms) fm TESTFORM ry (hd isigns_thms) (hd ord_thms) `&1 + y * (&0 + x * -- &1) <= &0` TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` let fm = `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` let var,mat_thm,fm = ry, ASSUME `interpmat [] [\y. (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1); \y. &1 + y * (&0 + x * -- &1)] [[Neg; Pos]]`, `~((&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0 /\ &1 + y * (&0 + x * -- &1) <= &0)` let var,mat_thm,fm = ry, ASSUME `interpmat [x_354] [\y. (&1 + x * -- &1) + y * (&0 + x * -- &2); \x. &1 + x * -- &1; \y. (&1 + x * -- &1) + y * (&0 + x * -- &2)] [[Neg; Pos; Neg]; [Neg; Zero; Neg]; [Neg; Neg; Neg]]`, `~(&1 + x * -- &1 < &0 /\ &1 + y * -- &1 < &0 ==> (&1 + x * -- &1) + y * (&0 + x * -- &2) < &0)` *) (* }}} *) hol-light/Rqe/testform_thms.ml000066400000000000000000000160741303454263000167340ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Evaluate a quantifier-free formula given a sign matrix row for its polys. *) (* ------------------------------------------------------------------------- *) (* let rec testform pmat fm = match fm with Atom(R(a,[p;Fn("0",[])])) -> let s = assoc p pmat in if a = "=" then s = Zero else if a = "<=" then s = Zero || s = Negative else if a = ">=" then s = Zero || s = Positive else if a = "<" then s = Negative else if a = ">" then s = Positive else failwith "testform: unknown literal" | False -> false | True -> true | Not(p) -> not(testform pmat p) | And(p,q) -> testform pmat p && testform pmat q | Or(p,q) -> testform pmat p || testform pmat q | Imp(p,q) -> not(testform pmat p) || testform pmat q | Iff(p,q) -> (testform pmat p = testform pmat q) | _ -> failwith "testform: non-propositional formula";; The model version of testform takes a row of the sign matrix in the form (p_1,s_1),(p_2,s_2),...,(p_n,s_n) The corresponding argument of TESTFORM is a theorem representing an `interpsigns` proposition. This is natural. The next argument, the formula to be tested, is the same. *) (* ====================================================================== *) (* Theorems *) (* ====================================================================== *) (* -------------------------------- T -------------------------------- *) let t_thm = prove(`!set:real->bool. (!x. set x ==> T)`,MESON_TAC[]);; (* -------------------------------- F --------------------------------- *) let f_thm = prove(`!set:real->bool. ~(?x. set x /\ F)`,MESON_TAC[]);; (* -------------------------------- ~ --------------------------------- *) let neg_thm_p = prove( `!P set. (!x. set x ==> P x) ==> (~ ?x. set x /\ ~ P x)`,MESON_TAC[]);; let neg_thm_n = prove( `!P set. (~ ?x. set x /\ P x) ==> (!x. set x ==> ~ P x)`,MESON_TAC[]);; (* -------------------------------- /\ -------------------------------- *) let and_thm_pp = prove( `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (!x. set x ==> Q x) ==> (!x. set x ==> (P x /\ Q x))`,MESON_TAC[]);; let and_thm_pn = prove( `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; let and_thm_np = prove( `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (!x. set x ==> Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; let and_thm_nn = prove( `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; (* -------------------------------- \/ -------------------------------- *) let or_thm_p = prove( `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (!x. set x ==> (P x \/ Q x))`, MESON_TAC[]);; let or_thm_q = prove( `!P Q set. (?x. set x) ==> (!x. set x ==> Q x) ==> (!x. set x ==> (P x \/ Q x))`, MESON_TAC[]);; let or_thm_nn = prove(`!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x \/ Q x))`,MESON_TAC[]);; (* ------------------------------- ==> -------------------------------- *) let imp_thm_pp = prove(`!P Q set. (?x. set x) ==> (!x. set x ==> Q x) ==> (!x. set x ==> (P x ==> Q x))`,MESON_TAC[]);; let imp_thm_pn = prove(`!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x ==> Q x))`,MESON_TAC[]);; let imp_thm_n = prove(`!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (!x. set x ==> (P x ==> Q x))`,MESON_TAC[]);; (* -------------------------------- = --------------------------------- *) let iff_thm_pp = prove( `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (!x. set x ==> Q x) ==> (!x. set x ==> (P x <=> Q x))`,MESON_TAC[]);; let iff_thm_pn = prove( `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x <=> Q x))`,MESON_TAC[]);; let iff_thm_np = prove( `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (!x. set x ==> Q x) ==> (~ ?x. set x /\ (P x <=> Q x))`,MESON_TAC[]);; let iff_thm_nn = prove( `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> (~ ?x. set x /\ Q x) ==> (!x. set x ==> (P x <=> Q x))`,MESON_TAC[]);; (* ---------------------------------------------------------------------- *) (* Atoms *) (* ---------------------------------------------------------------------- *) (* --------------------------- ?x. p x < &0 --------------------------- *) let eq_lt_thm = prove( `!P set. (!x. set x ==> (P x = &0)) ==> ~ ?x. set x /\ P x < &0`, MESON_TAC[REAL_LT_LE]);; let gt_lt_thm = prove( `!P set. (!x. set x ==> (P x > &0)) ==> ~ ?x. set x /\ P x < &0`, MESON_TAC[real_gt;REAL_LT_REFL;REAL_LT_TRANS]);; (* --------------------------- ?x. p x = &0 --------------------------- *) let lt_eq_thm = prove( `!P set. (!x. set x ==> (P x < &0)) ==> ~ ?x. set x /\ (P x = &0)`, MESON_TAC[REAL_LT_LE]);; let gt_eq_thm = prove( `!P set. (!x. set x ==> (P x > &0)) ==> ~ ?x. set x /\ (P x = &0)`, MESON_TAC[real_gt;REAL_LT_LE]);; (* --------------------------- ?x. p x > &0 --------------------------- *) let eq_gt_thm = prove( `!P set. (!x. set x ==> (P x = &0)) ==> ~ ?x. set x /\ (P x > &0)`, MESON_TAC[real_gt;REAL_LT_LE]);; let lt_gt_thm = prove( `!P set. (!x. set x ==> (P x < &0)) ==> ~ ?x. set x /\ (P x > &0)`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS]);; (* -------------------------- ?x. p x <= &0 --------------------------- *) let lt_le_thm = prove( `!P set. (!x. set x ==> (P x < &0)) ==> !x. set x ==> (P x <= &0)`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS]);; let eq_le_thm = prove( `!P set. (!x. set x ==> (P x = &0)) ==> (!x. set x ==> (P x <= &0))`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_le]);; let gt_le_thm = prove( `!P set. (!x. set x ==> (P x > &0)) ==> ~ ?x. set x /\ (P x <= &0)`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_le]);; (* -------------------------- ?x. p x >= &0 --------------------------- *) let lt_ge_thm = prove( `!P set. (!x. set x ==> (P x < &0)) ==> ~ ?x. set x /\ (P x >= &0)`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_ge]);; let eq_ge_thm = prove( `!P set. (!x. set x ==> (P x = &0)) ==> (!x. set x ==> (P x >= &0))`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_ge;real_le]);; let gt_ge_thm = prove( `!P set. (!x. set x ==> (P x > &0)) ==> (!x. set x ==> (P x >= &0))`, MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_ge;real_le]);; (* let lookup_sign isigns_thm fm = *) (* let asms,_ = dest_thm isigns_thm in *) (* let *) let NOT_EXISTS_CONJ_THM = prove_by_refinement( `~(?x. P x /\ Q x) ==> (!x. P x ==> ~Q x)`, (* {{{ Proof *) [ MESON_TAC[]; ]);; (* }}} *) let testform_itlem = prove_by_refinement( `(!x. P x ==> ~Q x) ==> (!x. P2 x ==> ~Q x) ==> (!x. P x \/ P2 x ==> ~ Q x)`, (* {{{ Proof *) [MESON_TAC[]]);; (* }}} *) hol-light/Rqe/timers.ml000066400000000000000000000046731303454263000153430ustar00rootroot00000000000000let testform_timer = ref 0.0;; let combine_testforms_timer = ref 0.0;; let condense_timer = ref 0.0;; let inferisign_timer = ref 0.0;; let matinsert_timer = ref 0.0;; let inferpsign_timer = ref 0.0;; let remove_column1_timer = ref 0.0;; let add_infinities_timer = ref 0.0;; let remove_infinities_timer = ref 0.0;; let pdivides_timer = ref 0.0;; let duplicate_columns_timer = ref 0.0;; let unmonicize_mat_timer = ref 0.0;; let swap_head_col_timer = ref 0.0;; let replace_pol_timer = ref 0.0;; let unfactor_mat_timer = ref 0.0;; let reset_timers() = testform_timer := 0.0; combine_testforms_timer := 0.0; condense_timer := 0.0; inferisign_timer := 0.0; matinsert_timer := 0.0; inferpsign_timer := 0.0; remove_column1_timer := 0.0; add_infinities_timer := 0.0; remove_infinities_timer := 0.0; pdivides_timer := 0.0; duplicate_columns_timer := 0.0; unmonicize_mat_timer := 0.0; swap_head_col_timer := 0.0; replace_pol_timer := 0.0; unfactor_mat_timer := 0.0; ;; let print_timers() = print_string "\n----------TIMERS---------\n\n"; print_string "TESTFORM: "; print_float !testform_timer; print_string "\n"; print_string "COMBINE_TESTFORMS: "; print_float !combine_testforms_timer; print_string "\n"; print_string "CONDENSE: "; print_float !condense_timer; print_string "\n"; print_string "INFERISIGN: "; print_float !inferisign_timer; print_string "\n"; print_string "MATINSERT: "; print_float !matinsert_timer; print_string "\n"; print_string "INFERPSIGN: "; print_float !inferpsign_timer; print_string "\n"; print_string "REMOVE_COLUMN1: "; print_float !remove_column1_timer; print_string "\n"; print_string "ADD_INFINITIES: "; print_float !add_infinities_timer; print_string "\n"; print_string "REMOVE_INFINITIES: "; print_float !remove_infinities_timer; print_string "\n"; print_string "PDIVIDES: "; print_float !pdivides_timer; print_string "\n"; print_string "DUPLICATE_COLUMNS: "; print_float !duplicate_columns_timer; print_string "\n"; print_string "UNMONICIZE_MAT: "; print_float !unmonicize_mat_timer; print_string "\n"; print_string "SWAP_HEAD_COL: "; print_float !swap_head_col_timer; print_string "\n"; print_string "REPLACE_POL: "; print_float !replace_pol_timer; print_string "\n"; print_string "UNFACTOR_MAT: "; print_float !unfactor_mat_timer; print_string "\n"; print_string "\n-------------------------\n"; ;; hol-light/Rqe/util.ml000066400000000000000000000057411303454263000150120ustar00rootroot00000000000000(* ---------------------------------------------------------------------- *) (* Strings *) (* ---------------------------------------------------------------------- *) let string_of_char c = String.make 1 c;; (* ---------------------------------------------------------------------- *) (* Types *) (* ---------------------------------------------------------------------- *) let gensort = sort (<);; let suppress = ref ([]:string list);; suppress := ["==>";"?";"!";"/\\";"\\/";",";"~";"APPEND";"CONS";"HD";"LAST"; "NIL";"=";"real_lt";"real_gt";"real_le";"real_ge";"BIT0";"BIT1";"NUMERAL"; "real_of_num";"_0";"_1";"real_div";"real_mul";"real_pow";"COND"];; let rec get_type_list tm = match tm with Var(s,t) -> if mem s !suppress then [] else [(s,t)] | Const(s,t) -> if mem s !suppress then [] else [(s,t)] | Comb (t1,t2) -> get_type_list t1 @ get_type_list t2 | Abs (t1,t2) -> get_type_list t1 @ get_type_list t2;; let my_print_type (s,t) = print_string ("(\"" ^ s ^ "\", "); print_qtype t; print_string ")\n";; let rec my_print_typel l = match l with [] -> (); | (h::t) -> my_print_type h; my_print_typel t;; let set_types tm = (gensort o setify o get_type_list) tm;; let print_term_types = my_print_typel o set_types;; let print_thm_types tm = print_term_types (concl tm);; let goal_types() = (print_term_types o snd o top_goal)();; let assum i = (rev_ith i o fst o top_goal)();; let assum_types i = (print_term_types o rev_ith i o fst o top_goal)();; let (get_type:string->thm->hol_type) = fun s thm -> assoc s (get_type_list (concl thm));; (* ---------------------------------------------------------------------- *) (* Proof Stack *) (* ---------------------------------------------------------------------- *) exception Empty_stack;; let proof_stack = ref ([]:goalstack list);; let push_proof t = proof_stack := [!current_goalstack] @ !proof_stack; g t;; let pop_proof() = match !proof_stack with [] -> raise Empty_stack | h::t -> current_goalstack := h; proof_stack := t; p();; (* ---------------------------------------------------------------------- *) (* Printing *) (* ---------------------------------------------------------------------- *) let print_thm_no_hyps th = let asl,tm = dest_thm th in (if not (asl = []) then print_string "..." else (); open_hbox(); print_string "|- "; print_term tm; close_box());; let print_trace_thm hyps msg th = let asl,tm = dest_thm th in open_hbox(); print_string "------------------------\n "; print_string (msg ^ "\n"); if hyps then print_thm th else print_thm_no_hyps th; print_string "\n========================\n "; close_box();; (* #install_printer print_thm_no_hyps;; #install_printer print_thm;; *) hol-light/Rqe/work_thms.ml000066400000000000000000010640311303454263000160500ustar00rootroot00000000000000let rec DISJ_TAC thm = DISJ_CASES_TAC thm THENL[ALL_TAC;TRY (POP_ASSUM DISJ_TAC)];; let INTERPSIGNS_CONJ = prove_by_refinement( `!P Q eqs l. interpsigns eqs (\x. P x) l /\ interpsigns eqs (\x. Q x) l ==> interpsigns eqs (\x. P x \/ Q x) l`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC; REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[interpsigns;ALL2;interpsign]; REPEAT (POP_ASSUM MP_TAC); DISJ_TAC (ISPEC `h':sign` SIGN_CASES) THEN ASM_REWRITE_TAC[interpsign;interpsigns] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[]; ]);; (* }}} *) let INTERPMAT_TRIO = prove_by_refinement( `!eqs x y l r t. interpmat (CONS x (CONS y t)) eqs (CONS l (CONS l (CONS l r))) ==> interpmat (CONS y t) eqs (CONS l r)`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;partition_line;NOT_CONS_NIL;ALL2;HD;TL;APPEND]; REPEAT_N 6 STRIP_TAC; DISJ_CASES_TAC (ISPEC `t:real list` list_CASES); ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; MATCH_ACCEPT_TAC ROL_SING; REWRITE_TAC[ALL2]; REWRITE_ASSUMS[TL]; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\z. z < x \/ (z = x) \/ (x < z /\ z < y)`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[NOT_CONS_NIL;TL]; REPEAT STRIP_TAC; ASM_MESON_TAC[ROL_TAIL;TL;NOT_CONS_NIL;]; REWRITE_TAC[ALL2]; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\z. z < x \/ (z = x) \/ (x < z /\ z < y)`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; ]);; (* }}} *) let PARTITION_LINE_NOT_NIL = prove_by_refinement( `!l. ~(partition_line l = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[partition_line;NOT_CONS_NIL;]; REWRITE_TAC[partition_line]; COND_CASES_TAC; REWRITE_TAC[NOT_CONS_NIL]; ASM_MESON_TAC[APPEND_EQ_NIL;NOT_CONS_NIL]; ]);; (* }}} *) let ALL2_LENGTH = prove_by_refinement( `!P l1 l2. ALL2 P l1 l2 ==> (LENGTH l1 = LENGTH l2)`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[ALL2;LENGTH]; ASM_MESON_TAC[]; ]);; (* }}} *) let LENGTH_TL = prove_by_refinement( `!l:A list. ~(l = []) ==> (LENGTH (TL l) = PRE (LENGTH l))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REWRITE_TAC[NOT_CONS_NIL;TL;LENGTH;]; ARITH_TAC; ]);; (* }}} *) let PARTITION_LINE_LENGTH = prove_by_refinement( `!l. LENGTH (partition_line l) = 2 * LENGTH l + 1`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[partition_line;LENGTH;]; ARITH_TAC; REWRITE_TAC[partition_line;LENGTH;]; COND_CASES_TAC; ASM_REWRITE_TAC[LENGTH;]; ARITH_TAC; REWRITE_TAC[APPEND;LENGTH;]; ASM_SIMP_TAC[PARTITION_LINE_NOT_NIL;LENGTH_TL]; ARITH_TAC; ]);; (* }}} *) let PARTITION_LINE_LENGTH_TL = prove_by_refinement( `!l. LENGTH (TL (partition_line l)) = 2 * LENGTH l`, (* {{{ Proof *) [ STRIP_TAC; REWRITE_TAC[MATCH_MP LENGTH_TL (ISPEC `l:real list` PARTITION_LINE_NOT_NIL)]; REWRITE_TAC[PARTITION_LINE_LENGTH]; ARITH_TAC; ]);; (* }}} *) let PL_ALL2_LENGTH = prove_by_refinement( `!eqs pts sgns. ALL2 (interpsigns eqs) (partition_line pts) sgns ==> (LENGTH sgns = 2 * LENGTH pts + 1)`, (* {{{ Proof *) [ REPEAT_N 3 STRIP_TAC; DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); ASM_REWRITE_TAC[interpmat;LENGTH;ROL_NIL;partition_line;]; ARITH_SIMP_TAC[]; DISJ_CASES_TAC (ISPEC `sgns:(sign list) list` list_CASES); ASM_REWRITE_TAC[ALL2]; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[ALL2]; DISJ_CASES_TAC (ISPEC `t:(sign list) list` list_CASES); ASM_REWRITE_TAC[ALL2;LENGTH;ONE]; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[ALL2]; (* save *) POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[interpmat;partition_line;]; COND_CASES_TAC; ASM_REWRITE_TAC[ROL_SING;LENGTH;GSYM ONE]; ARITH_SIMP_TAC[]; STRIP_TAC; CLAIM `LENGTH [\x. x < h; \x. x = h; \x. h < x] = LENGTH sgns`; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH]; ARITH_TAC; REWRITE_ASSUMS[NOT_NIL]; POP_ASSUM MP_TAC THEN STRIP_TAC; REWRITE_TAC[LENGTH]; STRIP_TAC; CLAIM `LENGTH sgns = LENGTH (APPEND [\x. x < h; \x. x = h; \x. h < x /\ x < HD t] (TL (partition_line t)))`; ASM_MESON_TAC[ ALL2_LENGTH]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[LENGTH_APPEND]; REWRITE_TAC[PARTITION_LINE_LENGTH_TL]; REWRITE_TAC[LENGTH]; ARITH_TAC; ]);; (* }}} *) let INTERPMAT_LENGTH = prove_by_refinement( `!eqs pts sgns. interpmat pts eqs sgns ==> (LENGTH sgns = 2 * LENGTH pts + 1)`, (* {{{ Proof *) [ REPEAT_N 3 STRIP_TAC; DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); ASM_REWRITE_TAC[interpmat;LENGTH;ROL_NIL;partition_line;]; ARITH_SIMP_TAC[]; DISJ_CASES_TAC (ISPEC `sgns:(sign list) list` list_CASES); ASM_REWRITE_TAC[ALL2]; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[ALL2]; DISJ_CASES_TAC (ISPEC `t:(sign list) list` list_CASES); ASM_REWRITE_TAC[ALL2;LENGTH;ONE]; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[ALL2]; (* save *) POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[interpmat;partition_line;]; COND_CASES_TAC; ASM_REWRITE_TAC[ROL_SING;LENGTH;GSYM ONE]; ARITH_SIMP_TAC[]; STRIP_TAC; CLAIM `LENGTH [\x. x < h; \x. x = h; \x. h < x] = LENGTH sgns`; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH]; ARITH_TAC; REWRITE_ASSUMS[NOT_NIL]; POP_ASSUM MP_TAC THEN STRIP_TAC; REWRITE_TAC[LENGTH]; STRIP_TAC; CLAIM `LENGTH sgns = LENGTH (APPEND [\x. x < h; \x. x = h; \x. h < x /\ x < HD t] (TL (partition_line t)))`; ASM_MESON_TAC[ ALL2_LENGTH]; DISCH_THEN SUBST1_TAC; REWRITE_TAC[LENGTH_APPEND]; REWRITE_TAC[PARTITION_LINE_LENGTH_TL]; REWRITE_TAC[LENGTH]; ARITH_TAC; ]);; (* }}} *) let ALL2_HD = prove_by_refinement( `!b d a c. (LENGTH a = LENGTH c) ==> ALL2 P (APPEND a b) (APPEND c d) ==> ALL2 P a c`, (* {{{ Proof *) [ REPEAT_N 2 STRIP_TAC; LIST_INDUCT_TAC; ONCE_REWRITE_TAC[prove(`(x = y) <=> (y = x)`,MESON_TAC[])]; REWRITE_TAC[LENGTH;LENGTH_EQ_NIL]; MESON_TAC[ALL2]; REWRITE_TAC[LENGTH;APPEND;]; LIST_INDUCT_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; REWRITE_TAC[LENGTH;APPEND;ALL2;SUC_INJ]; ASM_MESON_TAC[]; ]);; (* }}} *) let ALL2_TL = prove_by_refinement( `!b d a c. (LENGTH a = LENGTH c) ==> ALL2 P (APPEND a b) (APPEND c d) ==> ALL2 P b d`, (* {{{ Proof *) [ REPEAT_N 2 STRIP_TAC; LIST_INDUCT_TAC; ONCE_REWRITE_TAC[prove(`(x = y) <=> (y = x)`,MESON_TAC[])]; REWRITE_TAC[LENGTH;LENGTH_EQ_NIL]; MESON_TAC[APPEND]; REWRITE_TAC[LENGTH;APPEND;]; LIST_INDUCT_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; REWRITE_TAC[ALL2;APPEND;LENGTH;SUC_INJ]; ASM_MESON_TAC[]; ]);; (* }}} *) let ALL2_APPEND_LENGTH = prove_by_refinement( `!P a c b d. (LENGTH a = LENGTH c) ==> ALL2 P (APPEND a b) (APPEND c d) ==> ALL2 P a c /\ ALL2 P b d`, (* {{{ Proof *) [ ASM_MESON_TAC[ALL2_HD;ALL2_TL]; ]);; (* }}} *) let ALL2_APPEND = prove_by_refinement( `!a c b d. ALL2 P a c /\ ALL2 P b d ==> ALL2 P (APPEND a b) (APPEND c d)`, (* {{{ Proof *) [ REPEAT LIST_INDUCT_TAC THEN REWRITE_ALL[APPEND;ALL2;LENGTH;ARITH_RULE `~(0 = SUC x)`;APPEND_NIL]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[ALL2]; ]);; (* }}} *) let ALL2_SPLIT = prove_by_refinement( `!a c b d. (LENGTH a = LENGTH c) ==> (ALL2 P (APPEND a b) (APPEND c d) <=> ALL2 P a c /\ ALL2 P b d)`, (* {{{ Proof *) [ ASM_MESON_TAC[ALL2_APPEND;ALL2_APPEND_LENGTH]; ]);; (* }}} *) let BUTLAST_THM = prove_by_refinement( `(BUTLAST [] = []) /\ (BUTLAST [x] = []) /\ (BUTLAST (CONS h1 (CONS h2 t)) = CONS h1 (BUTLAST (CONS h2 t)))`, (* {{{ Proof *) [ ASM_MESON_TAC[BUTLAST;NOT_CONS_NIL;]; ]);; (* }}} *) let HD_BUTLAST = prove_by_refinement( `!l. ~(l = []) ==> (!x. ~(l = [x])) ==> (HD (BUTLAST l) = HD l)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REWRITE_TAC[NOT_CONS_NIL;HD;BUTLAST]; COND_CASES_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; REPEAT STRIP_TAC; REWRITE_TAC[HD]; ]);; (* }}} *) let SUBLIST = new_recursive_definition list_RECURSION `(SUBLIST l [] <=> (l = [])) /\ (SUBLIST l (CONS h t) <=> (l = []) \/ SUBLIST l t \/ ((HD l = h) /\ SUBLIST (TL l) t))`;; let SUBLIST_NIL = prove_by_refinement( `!l. SUBLIST [] l`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST]; ]);; (* }}} *) let SUBLIST_CONS = prove_by_refinement( `!l1 l2 h. SUBLIST l1 l2 ==> SUBLIST l1 (CONS h l2)`, (* {{{ Proof *) [ REPEAT LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST]; ]);; (* }}} *) let SUBLIST_TL = prove_by_refinement( `!l1 l2. SUBLIST l1 l2 ==> ~(l1 = []) ==> SUBLIST (TL l1) l2`, (* {{{ Proof *) [ REPEAT LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST;] ]);; (* }}} *) let SUBLIST_CONS2 = prove_by_refinement( `!h t l. SUBLIST (CONS h t) l ==> SUBLIST t l`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; ]);; (* }}} *) let SUBLIST_ID = prove_by_refinement( `!l. SUBLIST l l`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;NOT_CONS_NIL;HD;TL]; ]);; (* }}} *) let SUBLIST_CONS_CONS = prove_by_refinement( `!h t1 t2. SUBLIST (CONS h t1) (CONS h t2) = SUBLIST t1 t2`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC; ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID]; ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID]; REWRITE_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID;NOT_CONS_NIL;HD;TL]; REWRITE_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID;NOT_CONS_NIL;HD;TL;SUBLIST_CONS2;SUBLIST_CONS]; ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID;NOT_CONS_NIL;HD;TL]; ]);; (* }}} *) let SUBLIST_NEQ = prove_by_refinement( `!h1 h2 t1 t2. SUBLIST (CONS h1 t1) (CONS h2 t2) ==> ~(h1 = h2) ==> SUBLIST (CONS h1 t1) t2`, (* {{{ Proof *) [ ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; ]);; (* }}} *) let SUBLIST_TRANS = prove_by_refinement( `!l1 l2 l3. SUBLIST l1 l2 ==> SUBLIST l2 l3 ==> SUBLIST l1 l3`, (* {{{ Proof *) [ REPEAT LIST_INDUCT_TAC; ASM_MESON_TAC[SUBLIST]; ASM_MESON_TAC[SUBLIST]; ASM_MESON_TAC[SUBLIST]; ASM_MESON_TAC[SUBLIST]; ASM_MESON_TAC[SUBLIST]; ASM_MESON_TAC[SUBLIST]; ASM_MESON_TAC[SUBLIST]; REPEAT STRIP_TAC; REWRITE_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; CASES_ON `h = h''`; DISJ2_TAC; ASM_REWRITE_TAC[]; POP_ASSUM (REWRITE_ALL o list); CASES_ON `h' = h''`; POP_ASSUM (REWRITE_ALL o list); ASM_MESON_TAC[SUBLIST_CONS_CONS]; REWRITE_ASSUMS[IMP_AND_THM]; FIRST_ASSUM MATCH_MP_TAC; EVERY_ASSUM (fun x -> try MP_TAC (MATCH_MP SUBLIST_CONS2 x) with _ -> ALL_TAC); REPEAT STRIP_TAC; ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL;SUBLIST_CONS;SUBLIST_CONS2]; DISJ1_TAC; CASES_ON `h' = h''`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ASSUMS[SUBLIST_CONS_CONS]; CLAIM `SUBLIST (CONS h t) t'`; ASM_MESON_TAC[SUBLIST_NEQ]; STRIP_TAC; ASM_MESON_TAC[]; CASES_ON `h = h'`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ASSUMS[SUBLIST_CONS_CONS]; ASM_MESON_TAC[SUBLIST_NEQ]; CLAIM `SUBLIST (CONS h t) t'`; ASM_MESON_TAC[SUBLIST_NEQ]; STRIP_TAC; CLAIM `SUBLIST (CONS h' t') t''`; ASM_MESON_TAC[SUBLIST_NEQ]; STRIP_TAC; CLAIM `SUBLIST t' t''`; ASM_MESON_TAC[SUBLIST_CONS2]; STRIP_TAC; ASM_MESON_TAC[]; ]);; (* }}} *) let ROL_MEM = prove_by_refinement( `!h t. real_ordered_list (CONS h t) ==> !x. MEM x t ==> h < x`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[MEM]; REPEAT STRIP_TAC; CASES_ON `x = h'`; POP_ASSUM (REWRITE_ALL o list); ASM_MESON_TAC[ROL_CONS_CONS]; CLAIM `real_ordered_list (CONS h t)`; ASM_MESON_TAC[ROL_CONS_CONS_DELETE]; DISCH_THEN (REWRITE_ASSUMS o list); FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[MEM]; ]);; (* }}} *) let SUBLIST_MEM = prove_by_refinement( `!x l1 l2. SUBLIST l1 l2 ==> MEM x l1 ==> MEM x l2`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC; REWRITE_TAC[MEM]; REWRITE_TAC[MEM]; REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; REPEAT STRIP_TAC; CASES_ON `h = h'`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ASSUMS[SUBLIST_CONS_CONS]; CASES_ON `x = h'`; ASM_MESON_TAC[MEM]; REWRITE_ASSUMS[IMP_AND_THM]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[MEM;SUBLIST_CONS]; CASES_ON `x = h'`; ASM_MESON_TAC[MEM]; ASM_MESON_TAC[SUBLIST_NEQ;SUBLIST;MEM]; ]);; (* }}} *) let ROL_SUBLIST_LT = prove_by_refinement( `!h t1 t2. real_ordered_list (CONS h t2) ==> SUBLIST (CONS h t1) (CONS h t2) ==> !x. MEM x t1 ==> h < x`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC; REWRITE_TAC[MEM]; REWRITE_TAC[MEM]; ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; REPEAT STRIP_TAC; REWRITE_ASSUMS[SUBLIST_CONS_CONS]; CLAIM `MEM x (CONS h'' t')`; ASM_MESON_TAC[SUBLIST_MEM]; STRIP_TAC; ASM_MESON_TAC[ROL_MEM]; ]);; (* }}} *) let SUBLIST_DELETE = prove_by_refinement( `!h1 h2 t l. SUBLIST (CONS h1 (CONS h2 t)) l ==> SUBLIST (CONS h1 t) l`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC; REPEAT LIST_INDUCT_TAC; REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; CASES_ON `h1 = h`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[SUBLIST;NOT_CONS_NIL;HD;TL;SUBLIST_NIL]; STRIP_TAC; CLAIM `SUBLIST [h1; h2] t`; ASM_MESON_TAC[SUBLIST_NEQ]; DISCH_THEN (REWRITE_ASSUMS o list); ASM_MESON_TAC[SUBLIST_CONS]; REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; CASES_ON `h1 = h'`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[SUBLIST_CONS_CONS]; MESON_TAC[SUBLIST_CONS2]; STRIP_TAC; CLAIM `SUBLIST (CONS h1 (CONS h2 (CONS h t))) t'`; ASM_MESON_TAC[SUBLIST_NEQ]; DISCH_THEN (REWRITE_ASSUMS o list); ASM_MESON_TAC[SUBLIST_CONS]; ]);; (* }}} *) let SUBLIST_MATCH = prove_by_refinement( `!h t l. SUBLIST (CONS h t) l ==> ?(l1:A list) l2. (l = APPEND l1 (CONS h l2)) /\ SUBLIST t l2`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC; REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; CASES_ON `h = h'`; POP_ASSUM (REWRITE_ALL o list); STRIP_TAC; EXISTS_TAC `[]`; REWRITE_TAC[APPEND;SUBLIST_NIL]; ASM_MESON_TAC[]; REWRITE_TAC[SUBLIST_NIL]; STRIP_TAC; CLAIM `SUBLIST [h] t`; ASM_MESON_TAC[SUBLIST_NEQ]; DISCH_THEN (REWRITE_ASSUMS o list); REPEAT (POP_ASSUM MP_TAC); REPEAT STRIP_TAC; EXISTS_TAC `CONS h' l1`; EXISTS_TAC `l2`; REWRITE_TAC[APPEND]; AP_TERM_TAC; ASM_MESON_TAC[]; REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; (* save *) CASES_ON `h = h''`; POP_ASSUM (REWRITE_ALL o list); STRIP_TAC; REWRITE_ASSUMS[SUBLIST_CONS_CONS]; EXISTS_TAC `[]:A list`; EXISTS_TAC `t'`; ASM_MESON_TAC[APPEND]; (* save *) STRIP_TAC; CLAIM `SUBLIST (CONS h (CONS h' t)) t'`; ASM_MESON_TAC[SUBLIST_NEQ]; DISCH_THEN (REWRITE_ASSUMS o list); REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; EXISTS_TAC `CONS h'' l1`; EXISTS_TAC `l2`; ASM_REWRITE_TAC[APPEND]; ]);; (* }}} *) let ROL_SUBLIST = prove_by_refinement( `!l1 l2. real_ordered_list l2 ==> SUBLIST l1 l2 ==> real_ordered_list l1`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[ROL_NIL]; REWRITE_TAC[real_ordered_list]; REPEAT STRIP_TAC; REWRITE_ASSUMS[IMP_AND_THM]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[SUBLIST_CONS2]; CASES_ON `t = []`; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REWRITE_ASSUMS[NOT_NIL]; POP_ASSUM MP_TAC THEN STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[HD]; DISJ_CASES_TAC (ISPEC `l2:real list` list_CASES); ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL]; POP_ASSUM MP_TAC THEN STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); CASES_ON `h = h''`; POP_ASSUM (REWRITE_ALL o list); ASM_MESON_TAC[ROL_SUBLIST_LT;MEM]; FIRST_ASSUM (fun x -> MP_TAC (MATCH_MP SUBLIST_MATCH x)); STRIP_TAC; CLAIM `real_ordered_list (CONS h l2')`; ASM_MESON_TAC[ROL_APPEND]; STRIP_TAC; CLAIM `MEM h' l2'`; ASM_MESON_TAC[SUBLIST_MEM;MEM]; STRIP_TAC; ASM_MESON_TAC[ROL_MEM]; ]);; (* }}} *) let SUBLIST_BUTLAST = prove_by_refinement( `!l. SUBLIST (BUTLAST l) l`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[BUTLAST;SUBLIST_NIL]; REWRITE_TAC[BUTLAST;SUBLIST_NIL;SUBLIST]; REPEAT COND_CASES_TAC; REWRITE_TAC[SUBLIST_NIL]; ASM_REWRITE_TAC[HD;TL;NOT_CONS_NIL;]; ]);; (* }}} *) let SUBLIST_APPEND_HD = prove_by_refinement( `!l2 l3 l1. SUBLIST (APPEND l1 l2) (APPEND l1 l3) = SUBLIST l2 l3`, (* {{{ Proof *) [ REPEAT_N 2 STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[APPEND]; ASM_REWRITE_TAC[APPEND;SUBLIST_CONS_CONS]; ]);; (* }}} *) let SUBLIST_ID_CONS = prove_by_refinement( `!h l. ~(SUBLIST (CONS h l) l)`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; ASM_REWRITE_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; ASM_MESON_TAC[SUBLIST_DELETE]; ]);; (* }}} *) let SUBLIST_ID_APPEND = prove_by_refinement( `!m l. ~(l = []) ==> ~(SUBLIST (APPEND l m) m)`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[]; REWRITE_TAC[APPEND;]; DISCH_THEN (fun x -> ALL_TAC); CASES_ON `t = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[APPEND;SUBLIST_ID_CONS]; POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); ASM_MESON_TAC[SUBLIST_CONS2]; ]);; (* }}} *) let SUBLIST_APPEND_TL = prove_by_refinement( `!l3 l1 l2. SUBLIST (APPEND l1 l3) (APPEND l2 l3) = SUBLIST l1 l2`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC; REWRITE_TAC[APPEND;APPEND_NIL;SUBLIST;SUBLIST_ID]; REWRITE_ALL[SUBLIST_NIL;APPEND;APPEND_NIL;SUBLIST;SUBLIST_ID]; ASM_REWRITE_TAC[]; REWRITE_ALL[SUBLIST_NIL;SUBLIST;SUBLIST_ID;NOT_CONS_NIL;]; ASM_MESON_TAC[SUBLIST_ID_APPEND;APPEND;NOT_CONS_NIL;]; REWRITE_TAC[APPEND]; CASES_ON `h = h'`; POP_ASSUM (REWRITE_ALL o list); EQ_TAC; REWRITE_TAC[SUBLIST;APPEND;HD;TL;NOT_CONS_NIL;]; STRIP_TAC; ASM_MESON_TAC[APPEND;]; ASM_MESON_TAC[APPEND;]; REWRITE_TAC[SUBLIST_CONS_CONS]; ASM_MESON_TAC[]; EQ_TAC; STRIP_TAC; MATCH_MP_TAC SUBLIST_CONS; CLAIM `SUBLIST (CONS h (APPEND t l3)) (APPEND t' l3)`; ASM_MESON_TAC[SUBLIST_NEQ]; STRIP_TAC; ASM_MESON_TAC[APPEND;]; ASM_REWRITE_TAC[NOT_CONS_NIL;SUBLIST;HD;TL]; STRIP_TAC; ASM_MESON_TAC[APPEND;]; ]);; (* }}} *) let SUBLIST_TRANS2 = REWRITE_RULE[IMP_AND_THM] SUBLIST_TRANS;; let APPEND_CONS = prove_by_refinement( `!h l1 l2. APPEND l1 (CONS h l2) = APPEND (APPEND l1 [h]) l2`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[APPEND_NIL;APPEND]; ASM_MESON_TAC[]; ]);; (* }}} *) let SUBLIST_APPEND = prove_by_refinement( `!l1 l2 m1 m2. SUBLIST l1 l2 ==> SUBLIST m1 m2 ==> SUBLIST (APPEND l1 m1) (APPEND l2 m2)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[SUBLIST_NIL;APPEND]; LIST_INDUCT_TAC; REWRITE_TAC[APPEND]; REPEAT STRIP_TAC; POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x) THEN ASSUME_TAC x)); REWRITE_TAC[APPEND]; ASM_MESON_TAC[SUBLIST_CONS]; LIST_INDUCT_TAC; MESON_TAC[SUBLIST;NOT_CONS_NIL]; CASES_ON `h = h'`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[SUBLIST_CONS_CONS]; REWRITE_TAC[SUBLIST_CONS_CONS;APPEND;]; ASM_MESON_TAC[]; REPEAT STRIP_TAC; CLAIM `SUBLIST (CONS h t) t'`; ASM_MESON_TAC[SUBLIST_NEQ]; DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); POP_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); ASM_MESON_TAC[APPEND;SUBLIST_CONS]; ]);; (* }}} *) let SUBLIST_APPEND2 = REWRITE_RULE[IMP_AND_THM] SUBLIST_APPEND;; let ROL_APPEND2 = prove_by_refinement( `!l2 l1. real_ordered_list (APPEND l1 l2) ==> real_ordered_list (APPEND l1 (BUTLAST l2))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ROL_SUBLIST); EXISTS_TAC `APPEND l1 l2`; ASM_REWRITE_TAC[SUBLIST_APPEND_HD;SUBLIST_BUTLAST]; ]);; (* }}} *) let PL_LEM = prove_by_refinement( `!l. ~(l = []) ==> ~(TL (partition_line l) = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; STRIP_TAC; REWRITE_TAC[partition_line]; ASM_MESON_TAC[NOT_CONS_NIL;APPEND;TL]; ]);; (* }}} *) let HD_APPEND2 = prove_by_refinement( `!l m. ~(l = []) ==> (HD (APPEND l m) = HD l)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REPEAT STRIP_TAC; REWRITE_TAC[APPEND;HD]; ]);; (* }}} *) let BUTLAST_TL = prove_by_refinement( `!l. LENGTH l > 1 ==> (BUTLAST (TL l) = TL (BUTLAST l))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[LENGTH] THEN ARITH_TAC; REWRITE_TAC[LENGTH]; STRIP_TAC; REWRITE_TAC[TL;BUTLAST]; COND_CASES_TAC; REWRITE_ASSUMS [GSYM LENGTH_0]; REPEAT (POP_ASSUM MP_TAC) THEN ARITH_TAC; REWRITE_ASSUMS[NOT_NIL]; POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[TL;BUTLAST]; ]);; (* }}} *) let APPEND_TL = prove_by_refinement( `!m l. ~(l = []) ==> (APPEND (TL l) m = TL (APPEND l m))`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[]; REWRITE_TAC[APPEND;TL]; ]);; (* }}} *) let APPEND_HD = prove_by_refinement( `!m l. ~(l = []) ==> (HD (APPEND l m) = HD l)`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[]; STRIP_TAC; REWRITE_TAC[APPEND;HD]; ]);; (* }}} *) let PL_LEM2 = prove_by_refinement( `!l. ~(l = []) ==> LENGTH (partition_line l) > 1`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN REWRITE_TAC[]; REWRITE_TAC[partition_line]; STRIP_TAC; COND_CASES_TAC; REWRITE_TAC[LENGTH] THEN ARITH_TAC; REWRITE_TAC[APPEND;LENGTH] THEN ARITH_TAC; ]);; (* }}} *) let BUTLAST_APPEND = prove_by_refinement( `!l m. ~(m = []) ==> (BUTLAST (APPEND l m) = APPEND l (BUTLAST m))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[APPEND]; REPEAT STRIP_TAC; REWRITE_TAC[APPEND;BUTLAST]; ASM_MESON_TAC[APPEND_EQ_NIL]; ]);; (* }}} *) let LENGTH_TL1 = prove_by_refinement( `!l. LENGTH l > 1 ==> ~(TL l = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[LENGTH] THEN ARITH_TAC; REWRITE_TAC[LENGTH;TL]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ASSUMS o list); REWRITE_ASSUMS[LENGTH]; POP_ASSUM MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let PL_BUTLAST = prove_by_refinement( `!l. ~(l = []) ==> ~(BUTLAST (partition_line l) = [])`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REWRITE_TAC[partition_line]; COND_CASES_TAC; (* XXX REWRITE_TAC works here, but not MESON_TAC *) REWRITE_TAC[APPEND;NOT_CONS_NIL;BUTLAST]; REWRITE_TAC[APPEND;NOT_CONS_NIL;BUTLAST]; ]);; (* }}} *) let PARTITION_LINE_APPEND = prove_by_refinement( `!h t l. ~(l = []) ==> (partition_line (APPEND l (CONS h t)) = APPEND (BUTLAST (partition_line l)) (CONS (\x. LAST l < x /\ x < h) (TL (partition_line (CONS h t)))))`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[]; DISCH_THEN (fun x -> ALL_TAC); CASES_ON `t' = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[HD;APPEND;partition_line;BUTLAST;LAST;TL;NOT_CONS_NIL;]; POP_ASSUM (fun x -> REWRITE_ASSUMS [x] THEN ASSUME_TAC x); REWRITE_TAC[APPEND]; CONV_TAC (LAND_CONV (REWRITE_CONV[partition_line])); COND_CASES_TAC; ASM_MESON_TAC[NOT_CONS_NIL;APPEND_EQ_NIL]; POP_ASSUM (fun x -> ALL_TAC); ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[LAST]; ASM_SIMP_TAC[APPEND_HD]; CONV_TAC (RAND_CONV (LAND_CONV (RAND_CONV (REWRITE_CONV[partition_line])))); ASM_REWRITE_TAC[]; REWRITE_TAC[APPEND;BUTLAST;NOT_CONS_NIL;]; REPEAT AP_TERM_TAC; COND_CASES_TAC; ASM_MESON_TAC[PL_LEM2;LENGTH_TL1]; REWRITE_TAC[APPEND]; AP_TERM_TAC; MP_TAC (ISPEC `t':real list` PL_LEM2); ASM_REWRITE_TAC[]; STRIP_TAC; ASM_SIMP_TAC[BUTLAST_TL]; MP_TAC (ISPEC `t':real list` PL_BUTLAST); ASM_REWRITE_TAC[]; STRIP_TAC; ASM_SIMP_TAC[APPEND_TL]; ]);; (* }}} *) let HD_TL = prove_by_refinement( `!l. ~(l = []) ==> (l = CONS (HD l) (TL l))`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; REWRITE_TAC[HD;TL]; ]);; (* }}} *) let HD_LEM = prove_by_refinement( `!l1 l2. (TL l1 = l2) <=> (CONS (HD l1) (TL l1) = CONS (HD l1) l2)`, (* {{{ Proof *) [ MESON_TAC[CONS_11]; ]);; (* }}} *) let rec LENGTH_N n ty = let zero = `0` in let neg = `(~)` in let imp_thm = TAUT `(a ==> b) ==> (b ==> a) ==> (a <=> b)` in match n with 0 -> CONJUNCT1 LENGTH | 1 -> LENGTH_SING | n -> let len_tm = mk_const ("LENGTH",[ty,aty]) in let tl_tm = mk_const ("TL",[ty,aty]) in let hd_tm = mk_const ("HD",[ty,aty]) in let t = mk_var("t",mk_type("list",[ty])) in let n_tm = mk_small_numeral n in let pren_tm = mk_small_numeral (n - 1) in let len_thm = ASSUME (mk_eq(mk_comb(len_tm,t),n_tm)) in let pre_thm = LENGTH_N (n - 1) ty in let n_nz = prove(mk_neg(mk_eq(n_tm,zero)),ARITH_TAC) in let not_nil_thm = EQ_MP (REWRITE_RULE[len_thm] (AP_TERM neg (ISPEC t LENGTH_0))) n_nz in let n_suc = prove(mk_eq(n_tm,mk_comb(`SUC`,pren_tm)),ARITH_TAC) in let len_tl = REWRITE_RULE[n_suc;PRE;ISPEC (mk_comb(tl_tm,t)) pre_thm;len_thm] (MATCH_MP LENGTH_TL not_nil_thm) in let cons_thm = MATCH_MP (ISPEC t HD_TL) not_nil_thm in let hd_thm = ONCE_REWRITE_RULE[HD_LEM] len_tl in let thm = REWRITE_RULE[GSYM cons_thm] hd_thm in let x0 = mk_var("x" ^ string_of_int n,ty) in let hdt = mk_comb(hd_tm,t) in let ex_thm = EXISTS (mk_exists(x0,subst[x0,hdt] (concl thm)),mk_comb(hd_tm,t)) thm in let left = DISCH (concl len_thm) ex_thm in let right = prove(mk_imp(concl ex_thm,concl len_thm),REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LENGTH] THEN ARITH_TAC) in GEN_ALL(MATCH_MPL[imp_thm;left;right]);; let BUTLAST_LENGTH = prove_by_refinement( `!l. ~(l = []) ==> (LENGTH (BUTLAST l) = PRE (LENGTH l))`, (* {{{ Proof *) [ LIST_INDUCT_TAC THEN REWRITE_TAC[]; REWRITE_TAC[BUTLAST;LENGTH]; COND_CASES_TAC; ASM_REWRITE_TAC[NOT_CONS_NIL;LENGTH;]; ARITH_TAC; ASM_REWRITE_TAC[NOT_CONS_NIL;LENGTH;]; ASM_SIMP_TAC[]; MATCH_MP_TAC (ARITH_RULE `~(n = 0) ==> (SUC(PRE n) = PRE(SUC n))`); ASM_MESON_TAC[LENGTH_0]; ]);; (* }}} *) let ALL2_LEM = prove_by_refinement( `!a b x y s eqs pts sgns. ALL2 (interpsigns eqs) (partition_line (APPEND pts [x; y])) (APPEND sgns [a; b; s; s; s]) ==> ALL2 (interpsigns eqs) (partition_line (APPEND pts [x])) (APPEND sgns [a; b; s])`, (* {{{ Proof *) [ REPEAT STRIP_TAC; DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;NOT_CONS_NIL;HD;TL]; CLAIM `sgns = []`; CLAIM `LENGTH [\x'. x' < x; \x'. x' = x; \x'. x < x' /\ x' < y; \x. x = y; \x. y < x] = LENGTH (APPEND sgns [a; b; s; s; s])`; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH;LENGTH_APPEND;GSYM LENGTH_0]; ARITH_TAC; DISCH_THEN (REWRITE_ALL o list); REWRITE_ALL [APPEND;ALL2;]; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\z. x < z /\ z < y \/ (z = y) \/ y < z`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; (* save *) POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); POP_ASSUM MP_TAC; ASM_SIMP_TAC[PARTITION_LINE_APPEND;NOT_CONS_NIL;]; STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line (CONS (h:real) t))) (CONS (\x'. LAST (CONS h t) < x' /\ x' < x) (TL (partition_line [x; y])))) = LENGTH (APPEND sgns [(a:sign list); b; s; s; s])`; ASM_MESON_TAC[ALL2_LENGTH]; CLAIM `~(partition_line [x; y] = [])`; REWRITE_TAC[APPEND;NOT_CONS_NIL;partition_line;]; REWRITE_TAC[TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; STRIP_TAC; ASM_SIMP_TAC[LENGTH_TL]; REWRITE_TAC[partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[HD;LENGTH;APPEND;TL;BUTLAST;NOT_CONS_NIL;]; ARITH_SIMP_TAC[]; STRIP_TAC; CLAIM `LENGTH sgns = 2`; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_PAIR]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[partition_line;BUTLAST;LAST;ALL2;TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; ASM_REWRITE_TAC[]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_SUBSET; REWRITE_ASSUMS[HD]; EXISTS_TAC `\z. x < z /\ z < y \/ (z = y) \/ y < z`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; (* save *) REWRITE_ALL[HD;partition_line;BUTLAST;LAST;ALL2;TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); COND_CASES_TAC; ASM_MESON_TAC[PL_LEM2;LENGTH_TL1]; ARITH_SIMP_TAC[LENGTH;]; ASM_SIMP_TAC[PARTITION_LINE_LENGTH]; ASM_SIMP_TAC[BUTLAST_LENGTH]; CLAIM `~(partition_line t = [])`; REWRITE_ASSUMS[NOT_NIL]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[partition_line;NOT_CONS_NIL;list_CASES;APPEND;]; COND_CASES_TAC; MESON_TAC[NOT_CONS_NIL]; MESON_TAC[NOT_CONS_NIL]; STRIP_TAC; ASM_SIMP_TAC[LENGTH_TL]; STRIP_TAC; MP_TAC (ISPEC `t:real list` PARTITION_LINE_LENGTH); STRIP_TAC; CLAIM `~(LENGTH (partition_line t) = 0)`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP PL_LEM2); STRIP_TAC; CLAIM `~(PRE (LENGTH (partition_line t)) = 0)`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `SUC(LENGTH (partition_line t)) = LENGTH sgns`; REPEAT_N 5 (POP_ASSUM MP_TAC) THEN ARITH_TAC; DISCH_THEN (ASSUME_TAC o GSYM); POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); REWRITE_TAC[GSYM APPEND]; CLAIM `(ALL2 (interpsigns eqs) (BUTLAST (CONS (\x. x < h) (CONS (\x. x = h) (CONS (\x. h < x /\ x < HD t) (TL (partition_line t)))))) sgns) /\ (ALL2 (interpsigns eqs) [\x'. LAST t < x' /\ x' < x; \x'. x' = x; \x'. x < x' /\ x' < y; \x. x = y; \x. y < x] [a; b; s; s; s])`; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_APPEND_LENGTH); REPEAT STRIP_TAC; ASM_REWRITE_TAC[BUTLAST;NOT_CONS_NIL;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;LENGTH_TL]; CLAIM `~(LENGTH t = 0)`; ASM_MESON_TAC[LENGTH_0]; ARITH_TAC; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; STRIP_TAC; REWRITE_ASSUMS[BUTLAST;NOT_CONS_NIL;]; ASM_MESON_TAC[]; REWRITE_ALL[BUTLAST;LAST;ALL2;TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\z. x < z /\ z < y \/ (z = y) \/ y < z`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; ]);; (* }}} *) let INTERPMAT_TRIO_TL = prove_by_refinement( `!a b x y s eqs pts sgns. interpmat (APPEND pts [x; y]) eqs (APPEND sgns [a; b; s; s; s]) ==> interpmat (APPEND pts [x]) eqs (APPEND sgns [a; b; s])`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ROL_SUBLIST); EXISTS_TAC `APPEND pts [x; y]`; ASM_REWRITE_TAC[SUBLIST_APPEND_HD;SUBLIST_CONS_CONS;SUBLIST_NIL]; MATCH_MP_TAC ALL2_LEM; ASM_MESON_TAC[]; ]);; (* }}} *) let LAST_APPEND = prove_by_refinement( `!l1 l2. ~(l2 = []) ==> (LAST (APPEND l1 l2) = LAST l2)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[APPEND]; REWRITE_TAC[APPEND;LAST;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[APPEND_EQ_NIL]; ASM_MESON_TAC[]; ]);; (* }}} *) let APPEND_APPEND = prove_by_refinement( `!l1 l2 l3. APPEND (APPEND l1 l2) l3 = APPEND l1 (APPEND l2 l3)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[APPEND]; REWRITE_TAC[APPEND]; ASM_MESON_TAC[]; ]);; (* }}} *) let ALL2_LEM2 = prove_by_refinement( `!a b x y s eqs pts sgns qts rgns. ALL2 (interpsigns eqs) (partition_line (APPEND pts (CONS x (CONS y qts)))) (APPEND sgns (CONS a (CONS b (CONS s (CONS s (CONS s rgns)))))) ==> (LENGTH sgns = 2 * LENGTH pts) ==> ALL2 (interpsigns eqs) (partition_line (APPEND pts (CONS x qts))) (APPEND sgns (CONS a (CONS b (CONS s rgns))))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS x (CONS y qts)))) = LENGTH (APPEND sgns (CONS (a:sign list) (CONS b (CONS s (CONS s (CONS s rgns))))))`; ASM_MESON_TAC[ALL2_LENGTH]; ASM_REWRITE_TAC[PARTITION_LINE_LENGTH;LENGTH;APPEND;LENGTH_APPEND]; STRIP_TAC; CLAIM `LENGTH rgns = 2 * LENGTH qts`; POP_ASSUM MP_TAC THEN ARITH_TAC; POP_ASSUM (fun x -> ALL_TAC); STRIP_TAC; CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); CLAIM `sgns = []`; ASM_MESON_TAC[ARITH_RULE `2 * 0 = 0`;LENGTH_0;LENGTH]; DISCH_THEN (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;NOT_CONS_NIL;HD;TL;APPEND;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[ALL2;partition_line;NOT_CONS_NIL;HD;TL;APPEND;]; REPEAT_N 3 STRIP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; ASM_REWRITE_TAC[]; REWRITE_TAC[ALL2;partition_line;NOT_CONS_NIL;HD;TL;APPEND;]; REPEAT_N 3 STRIP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z /\ z < HD qts`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; CLAIM `LENGTH (BUTLAST (partition_line pts)) = LENGTH sgns`; ASM_REWRITE_TAC[]; ASSUME_TAC (ISPEC `pts:real list` PARTITION_LINE_NOT_NIL); ASM_SIMP_TAC[BUTLAST_LENGTH]; REWRITE_TAC[PARTITION_LINE_LENGTH]; ARITH_TAC; STRIP_TAC; POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[ALL2_SPLIT]; REWRITE_ALL[partition_line;NOT_CONS_NIL;HD;TL;]; COND_CASES_TAC; REWRITE_TAC[ALL2;TL;HD;APPEND;]; REPEAT_N 4 STRIP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT_N 4 STRIP_TAC; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z /\ z < HD qts`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; ]);; (* }}} *) let INTERPMAT_TRIO_INNER = prove_by_refinement( `!a b x y s eqs qts rgns pts sgns. interpmat (APPEND pts (CONS x (CONS y qts))) eqs (APPEND sgns (CONS a (CONS b (CONS s (CONS s (CONS s rgns)))))) ==> (LENGTH sgns = 2 * LENGTH pts) ==> interpmat (APPEND pts (CONS x qts)) eqs (APPEND sgns (CONS a (CONS b (CONS s rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ROL_SUBLIST); EXISTS_TAC `(APPEND pts (CONS x (CONS y qts)))`; ASM_REWRITE_TAC[SUBLIST_APPEND_HD;SUBLIST_CONS_CONS;SUBLIST_NIL]; MESON_TAC[SUBLIST_CONS;SUBLIST_ID]; ASM_MESON_TAC[ALL2_LEM2]; ]);; (* }}} *) let INTERPMAT_SING = prove_by_refinement( `!x l. interpmat [x] eqs [l; l; l] ==> interpmat [] eqs [l]`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REWRITE_TAC[ROL_SING;partition_line;ROL_NIL;ALL2;]; REPEAT STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_SUBSET; EXISTS_TAC `\(z:real). x < z \/ (z = x) \/ z < x`; STRIP_TAC; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; MATCH_MP_TAC INTERPSIGNS_CONJ; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REAL_ARITH_TAC; ]);; (* }}} *) let INFERISIGN_POS_POS_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Pos (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_POS_POS_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Pos (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_NEG_NEG_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Neg (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_NEG_NEG_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Neg (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let ALL2_INTERPSIGN_SUBSET = prove_by_refinement( `!P Q l1 l2. ALL2 (interpsign P) l1 l2 ==> Q SUBSET P ==> ALL2 (interpsign Q) l1 l2`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC THEN REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[ALL2]; ASM_MESON_TAC[INTERPSIGN_SUBSET]; ]);; (* }}} *) let HD_APPEND1 = prove_by_refinement( `!h i l1 l2. HD (APPEND l1 (CONS h l2)) = HD (APPEND l1 (CONS h (CONS i l2)))`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC; LIST_INDUCT_TAC; ASM_REWRITE_TAC[HD;APPEND]; ASM_REWRITE_TAC[HD;APPEND]; ]);; (* }}} *) let ROL_APPEND_INSERT = prove_by_refinement( `!h j l1 l2. real_ordered_list (APPEND l1 (CONS h (CONS i l2))) ==> h < j ==> j < i ==> real_ordered_list (APPEND l1 (CONS h (CONS j (CONS i l2))))`, (* {{{ Proof *) [ STRIP_TAC THEN STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[APPEND;real_ordered_list;HD;TL;NOT_CONS_NIL;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[APPEND;real_ordered_list]; REPEAT STRIP_TAC; ASM_MESON_TAC[]; ASM_MESON_TAC[APPEND_EQ_NIL;NOT_CONS_NIL;]; ASM_MESON_TAC[]; DISJ2_TAC; ASM_MESON_TAC[HD_APPEND1]; ]);; (* }}} *) let INFERISIGN_POS_NEG_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Pos (CONS Pos r2)) (CONS (CONS Zero (CONS Pos r2)) (CONS (CONS Neg (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; (* save *) REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS]; ASM_MESON_TAC[REAL_LT_TRANS]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) rts) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) rts`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (ONCE_REWRITE_TAC o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; (* save *) COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; (* save *) REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; ]);; (* }}} *) let INFERISIGN_POS_NEG_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Pos (CONS Neg r2)) (CONS (CONS Zero (CONS Neg r2)) (CONS (CONS Neg (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; (* save *) REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) rts) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) rts`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (ONCE_REWRITE_TAC o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;real_gt;ROL_APPEND]; REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; (* save *) COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; (* save *) REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ]);; (* }}} *) let INFERISIGN_NEG_POS_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Neg (CONS Neg r2)) (CONS (CONS Zero (CONS Neg r2)) (CONS (CONS Pos (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; (* save *) REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) rts) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) rts`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (ONCE_REWRITE_TAC o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;real_gt;ROL_APPEND]; REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; (* save *) COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; (* save *) REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ]);; (* }}} *) let INFERISIGN_NEG_POS_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Neg (CONS Pos r2)) (CONS (CONS Zero (CONS Pos r2)) (CONS (CONS Pos (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; (* save *) REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; ASM_REWRITE_TAC[]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET;IN]; REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) rts) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) rts`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (ONCE_REWRITE_TAC o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;real_gt;ROL_APPEND]; REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; (* save *) COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; (* save *) REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; REPEAT STRIP_TAC; MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); REPEAT STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; POP_ASSUM MP_TAC THEN STRIP_TAC; EXISTS_TAC `X`; REWRITE_ALL[interpsign;real_gt]; (* save *) REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); REPEAT STRIP_TAC; ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;interpsign]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. y < x /\ x < z`; REWRITE_TAC[SUBSET;IN]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; ]);; (* }}} *) let INFERISIGN_ZERO_POS_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Pos (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_ZERO_POS_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Pos (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_POS_ZERO_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Pos (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_POS_ZERO_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Pos (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_ZERO_NEG_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Neg (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_ZERO_NEG_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Neg (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_NEG_ZERO_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Neg (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_NEG_ZERO_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Neg (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH sgns = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[real_gt]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y (CONS z qts))`; ASM_MESON_TAC[real_gt;ROL_APPEND]; REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_ZERO_ZERO_POS = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> F`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~((sgns:(sign list) list) = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH (sgns:(sign list) list) = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list) list)`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list)list)`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y(CONS z qts))`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; STRIP_TAC; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; ]);; (* }}} *) let INFERISIGN_ZERO_ZERO_NEG = prove_by_refinement( `!y z p pts qts eqs sgns rgns r1 r2 r3. interpmat (APPEND pts (CONS y (CONS z qts))) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns)))) ==> (LENGTH sgns = 2 * LENGTH pts + 1) ==> F`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~((sgns:(sign list) list) = [])`; REWRITE_TAC[GSYM LENGTH_0]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`; ASM_MESON_TAC[real_gt;ALL2_LENGTH]; STRIP_TAC; (* save *) CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;]; CLAIM `LENGTH (sgns:(sign list) list) = 1`; POP_ASSUM (fun x -> ALL_TAC); REWRITE_ALL[LENGTH]; ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[LENGTH_1]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND]; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;APPEND;ALL2;real_gt]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;ALL2;]; ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign]; REWRITE_ALL[real_gt]; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[interpsign;real_gt;]; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[TL;HD;APPEND;ALL2;]; CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; MESON_TAC[real_gt;APPEND;APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list) list)`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list [y; z]`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; (* save *) REWRITE_TAC[APPEND;TL;HD;ALL2;]; REPEAT STRIP_TAC; CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; MESON_TAC[APPEND;APPEND_CONS]; DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list)list)`; REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; ARITH_TAC; REWRITE_ALL[TL;APPEND;HD]; DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REPEAT STRIP_TAC; REPEAT STRIP_TAC; REWRITE_ALL[ALL2;interpsigns;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_ALL[interpsign;real_gt]; MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); EXISTS_TAC `y`; EXISTS_TAC `z`; EXISTS_TAC `p`; REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; CLAIM `real_ordered_list (CONS y(CONS z qts))`; ASM_MESON_TAC[ROL_APPEND]; REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; STRIP_TAC; ASM_MESON_TAC[real_gt;]; ASM_MESON_TAC[real_gt;real_gt;]; ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; ]);; (* }}} *) let BUTLAST_ID = prove_by_refinement( `!l. ~(l = []) ==> (APPEND (BUTLAST l) [LAST l] = l)`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[]; DISCH_THEN (fun x -> ALL_TAC); REWRITE_TAC[BUTLAST;APPEND;LAST;]; COND_CASES_TAC; ASM_REWRITE_TAC[BUTLAST;APPEND;LAST;]; ASM_REWRITE_TAC[APPEND;]; ASM_MESON_TAC[]; ]);; (* }}} *) let BUTLAST_ID = prove_by_refinement( `!l. ~(l = []) ==> (l = APPEND (BUTLAST l) [LAST l])`, (* {{{ Proof *) [ MESON_TAC[BUTLAST_ID]; ]);; (* }}} *) let BUTLAST_NIL = prove_by_refinement( `!l. (BUTLAST l = []) <=> (l = []) \/ (?x. l = [x])`, (* {{{ Proof *) [ LIST_INDUCT_TAC; REWRITE_TAC[BUTLAST;]; REWRITE_TAC[BUTLAST;NOT_CONS_NIL;]; COND_CASES_TAC; ASM_REWRITE_TAC[]; MESON_TAC[]; ASM_REWRITE_TAC[]; POP_ASSUM (fun x -> REWRITE_ALL[x] THEN ASSUME_TAC x); REWRITE_TAC[NOT_CONS_NIL]; STRIP_TAC; ASM_MESON_TAC[NOT_CONS_NIL;CONS_11]; ]);; (* }}} *) let INFIN_HD_POS_LEM = prove_by_refinement( `!pts p ps r1 sgns. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (CONS (CONS Unknown (CONS Pos r1)) sgns) ==> nonconstant p ==> ?xminf. interpmat (CONS xminf pts) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (CONS (CONS Neg (CONS Pos r1)) (CONS (CONS Neg (CONS Pos r1)) (CONS (CONS Unknown (CONS Pos r1)) sgns)))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;partition_line;]; REPEAT STRIP_TAC; DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_DOWN_LEFT5)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN]; (* save *) POP_ASSUM MP_TAC THEN STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_DOWN_LEFT5)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; (* save *) POP_ASSUM (fun x -> (REWRITE_ALL[x] THEN ASSUME_TAC x)); REWRITE_ALL[APPEND;NOT_CONS_NIL;HD;TL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_DOWN_LEFT5)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ]);; (* }}} *) let INFIN_TL_POS_LEM = prove_by_refinement( `!pts p ps r1 sgns r2. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND sgns [a; b; CONS Unknown (CONS Pos r2)]) ==> nonconstant p ==> ?xinf. interpmat (APPEND pts [xinf]) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND sgns [a; b; CONS Unknown (CONS Pos r2); CONS Pos (CONS Pos r2); CONS Pos (CONS Pos r2)])`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;partition_line;]; REPEAT STRIP_TAC; CLAIM `LENGTH (partition_line pts) = LENGTH (APPEND sgns [a; b; CONS Unknown (CONS Pos r2)])`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; CLAIM `LENGTH sgns = LENGTH (partition_line pts) - 3`; REWRITE_ALL[PARTITION_LINE_LENGTH]; ASM_REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ARITH_TAC; STRIP_TAC; CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN FALSE_ANTECEDENT_TAC; ARITH_TAC; (* save *) ASM_SIMP_TAC[PARTITION_LINE_APPEND]; CLAIM `pts = APPEND (BUTLAST pts) [LAST (pts:real list)]`; MATCH_MP_TAC BUTLAST_ID; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `ALL2 (interpsigns (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps))) (partition_line (APPEND (BUTLAST pts) [LAST pts])) (APPEND sgns [a; b; CONS Unknown (CONS Pos r2)])`; ASM_MESON_TAC[]; CASES_ON `BUTLAST (pts:real list) = []`; CLAIM `?w. pts = [w:real]`; ASM_MESON_TAC[BUTLAST_NIL]; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; CLAIM `sgns = []`; REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); REWRITE_TAC[GSYM LENGTH_0]; POP_ASSUM MP_TAC THEN ARITH_TAC; DISCH_THEN (REWRITE_ALL o list); REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`w:real`] POLY_DIFF_UP_RIGHT3)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; REPEAT STRIP_TAC; ASM_REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. w < x`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE]; ASM_MESON_TAC[REAL_LT_TRANS]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. w < x`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]; ASM_MESON_TAC[REAL_LT_IMP_LE;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. w < x`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; (* save *) CLAIM `LENGTH (BUTLAST (partition_line (BUTLAST pts))) = LENGTH sgns`; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;]; REWRITE_ALL[PARTITION_LINE_LENGTH;LENGTH_APPEND;LENGTH;]; MP_TAC (ISPEC `pts:real list` BUTLAST_LENGTH); STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; ASM_MESON_TAC[]; POP_ASSUM SUBST1_TAC; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM SUBST1_TAC; ARITH_TAC; STRIP_TAC; ASM_SIMP_TAC[PARTITION_LINE_APPEND]; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`LAST pts:real`] POLY_DIFF_UP_RIGHT3)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; REPEAT STRIP_TAC; MATCH_MP_TAC ROL_INSERT_BACK_THM; ASM_REWRITE_TAC[]; ONCE_ASM_REWRITE_TAC[]; ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REWRITE_TAC[partition_line;TL;]; SIMP_TAC[NOT_CONS_NIL;LAST_APPEND]; REWRITE_TAC[LAST]; SIMP_TAC[BUTLAST_APPEND;NOT_CONS_NIL;]; REWRITE_TAC[BUTLAST;NOT_CONS_NIL;]; REWRITE_TAC[APPEND_APPEND]; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. LAST pts < x`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE]; ASM_MESON_TAC[REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. LAST pts < x`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. LAST pts < x`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ]);; (* }}} *) let INFIN_HD_NEG_LEM = prove_by_refinement( `!pts p ps r1 sgns. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (CONS (CONS Unknown (CONS Neg r1)) sgns) ==> nonconstant p ==> ?xminf. interpmat (CONS xminf pts) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (CONS (CONS Pos (CONS Neg r1)) (CONS (CONS Pos (CONS Neg r1)) (CONS (CONS Unknown (CONS Neg r1)) sgns)))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;partition_line;]; REPEAT STRIP_TAC; DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_UP_LEFT5)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN]; (* save *) POP_ASSUM MP_TAC THEN STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_UP_LEFT5)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; (* save *) POP_ASSUM (fun x -> (REWRITE_ALL[x] THEN ASSUME_TAC x)); REWRITE_ALL[APPEND;NOT_CONS_NIL;HD;TL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_UP_LEFT5)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. x < h`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; ]);; (* }}} *) let INFIN_TL_NEG_LEM = prove_by_refinement( `!pts p ps r1 sgns r2. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND sgns [a; b; CONS Unknown (CONS Neg r2)]) ==> nonconstant p ==> ?xinf. interpmat (APPEND pts [xinf]) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND sgns [a; b; CONS Unknown (CONS Neg r2); CONS Neg (CONS Neg r2); CONS Neg (CONS Neg r2)])`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;partition_line;]; REPEAT STRIP_TAC; CLAIM `LENGTH (partition_line pts) = LENGTH (APPEND sgns [a; b; CONS Unknown (CONS Neg r2)])`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; CLAIM `LENGTH sgns = LENGTH (partition_line pts) - 3`; REWRITE_ALL[PARTITION_LINE_LENGTH]; ASM_REWRITE_TAC[LENGTH_APPEND;LENGTH;]; ARITH_TAC; STRIP_TAC; CASES_ON `pts = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN FALSE_ANTECEDENT_TAC; ARITH_TAC; (* save *) ASM_SIMP_TAC[PARTITION_LINE_APPEND]; CLAIM `pts = APPEND (BUTLAST pts) [LAST (pts:real list)]`; MATCH_MP_TAC BUTLAST_ID; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `ALL2 (interpsigns (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps))) (partition_line (APPEND (BUTLAST pts) [LAST pts])) (APPEND sgns [a; b; CONS Unknown (CONS Neg r2)])`; ASM_MESON_TAC[]; CASES_ON `BUTLAST (pts:real list) = []`; CLAIM `?w. pts = [w:real]`; ASM_MESON_TAC[BUTLAST_NIL]; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; CLAIM `sgns = []`; REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); REWRITE_TAC[GSYM LENGTH_0]; POP_ASSUM MP_TAC THEN ARITH_TAC; DISCH_THEN (REWRITE_ALL o list); REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`w:real`] POLY_DIFF_DOWN_RIGHT3)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; REPEAT STRIP_TAC; ASM_REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. w < x`; ASM_MESON_TAC[SUBSET;IN]; ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_TRANS;]; ASM_MESON_TAC[REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. w < x`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]; ASM_MESON_TAC[REAL_LT_IMP_LE;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. w < x`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; (* save *) CLAIM `LENGTH (BUTLAST (partition_line (BUTLAST pts))) = LENGTH sgns`; ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;]; REWRITE_ALL[PARTITION_LINE_LENGTH;LENGTH_APPEND;LENGTH;]; MP_TAC (ISPEC `pts:real list` BUTLAST_LENGTH); STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; ASM_MESON_TAC[]; POP_ASSUM SUBST1_TAC; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM SUBST1_TAC; ARITH_TAC; STRIP_TAC; ASM_SIMP_TAC[PARTITION_LINE_APPEND]; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`LAST pts:real`] POLY_DIFF_DOWN_RIGHT3)); ASM_REWRITE_TAC[real_gt;]; STRIP_TAC; EXISTS_TAC `Y`; REPEAT STRIP_TAC; MATCH_MP_TAC ROL_INSERT_BACK_THM; ASM_REWRITE_TAC[]; ONCE_ASM_REWRITE_TAC[]; ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REWRITE_TAC[partition_line;TL;]; SIMP_TAC[NOT_CONS_NIL;LAST_APPEND]; REWRITE_TAC[LAST]; SIMP_TAC[BUTLAST_APPEND;NOT_CONS_NIL;]; REWRITE_TAC[BUTLAST;NOT_CONS_NIL;]; REWRITE_TAC[APPEND_APPEND]; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2;BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. LAST pts < x`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE]; ASM_MESON_TAC[REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. LAST pts < x`; ASM_MESON_TAC[SUBSET;IN]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE]; FIRST_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. LAST pts < x`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ]);; (* }}} *) let INFIN_POS_POS = prove_by_refinement( `!pts p ps r1 sgns r2. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Unknown (CONS Pos r1)) sgns) [a; b; CONS Unknown (CONS Pos r2)]) ==> nonconstant p ==> ?xminf xinf. interpmat (APPEND (CONS xminf pts) [xinf]) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Neg (CONS Pos r1)) (CONS (CONS Neg (CONS Pos r1)) (CONS (CONS Unknown (CONS Pos r1)) sgns))) [a; b; CONS Unknown (CONS Pos r2); CONS Pos (CONS Pos r2); CONS Pos (CONS Pos r2)])`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_ASSUMS[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; EXISTS_TAC `xminf`; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_POS_LEM); ASM_REWRITE_TAC[APPEND;]; ]);; (* }}} *) let INFIN_POS_NEG = prove_by_refinement( `!pts p ps r1 sgns r2. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Unknown (CONS Pos r1)) sgns) [a; b; CONS Unknown (CONS Neg r2)]) ==> nonconstant p ==> ?xminf xinf. interpmat (APPEND (CONS xminf pts) [xinf]) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Neg (CONS Pos r1)) (CONS (CONS Neg (CONS Pos r1)) (CONS (CONS Unknown (CONS Pos r1)) sgns))) [a; b; CONS Unknown (CONS Neg r2); CONS Neg (CONS Neg r2); CONS Neg (CONS Neg r2)])`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_ASSUMS[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; EXISTS_TAC `xminf`; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_NEG_LEM); ASM_REWRITE_TAC[APPEND;]; ]);; (* }}} *) let INFIN_NEG_POS = prove_by_refinement( `!pts p ps r1 sgns r2. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Unknown (CONS Neg r1)) sgns) [a; b; CONS Unknown (CONS Pos r2)]) ==> nonconstant p ==> ?xminf xinf. interpmat (APPEND (CONS xminf pts) [xinf]) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Pos (CONS Neg r1)) (CONS (CONS Pos (CONS Neg r1)) (CONS (CONS Unknown (CONS Neg r1)) sgns))) [a; b; CONS Unknown (CONS Pos r2); CONS Pos (CONS Pos r2); CONS Pos (CONS Pos r2)])`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_ASSUMS[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; EXISTS_TAC `xminf`; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_POS_LEM); ASM_REWRITE_TAC[APPEND;]; ]);; (* }}} *) let INFIN_NEG_NEG = prove_by_refinement( `!pts p ps r1 sgns r2. interpmat pts (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Unknown (CONS Neg r1)) sgns) [a; b; CONS Unknown (CONS Neg r2)]) ==> nonconstant p ==> ?xminf xinf. interpmat (APPEND (CONS xminf pts) [xinf]) (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) (APPEND (CONS (CONS Pos (CONS Neg r1)) (CONS (CONS Pos (CONS Neg r1)) (CONS (CONS Unknown (CONS Neg r1)) sgns))) [a; b; CONS Unknown (CONS Neg r2); CONS Neg (CONS Neg r2); CONS Neg (CONS Neg r2)])`, (* {{{ Proof *) [ REPEAT STRIP_TAC; REWRITE_ASSUMS[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; EXISTS_TAC `xminf`; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_NEG_LEM); ASM_REWRITE_TAC[APPEND;]; ]);; (* }}} *) let INFIN_NIL_POS = prove_by_refinement( `!p ps r1. interpmat [] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Unknown (CONS Pos r1)] ==> nonconstant p ==> ?xminf xinf. interpmat [xminf; xinf] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Neg (CONS Pos r1); CONS Neg (CONS Pos r1); CONS Unknown (CONS Pos r1); CONS Pos (CONS Pos r1); CONS Pos (CONS Pos r1)]`, (* {{{ Proof *) [ REWRITE_TAC[real_gt;interpmat;partition_line;ROL_NIL;ALL2;interpsigns;interpsign]; REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_UP_RIGHT3)); ASM_REWRITE_TAC[real_gt]; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_DOWN_LEFT5)); ASM_REWRITE_TAC[real_gt]; STRIP_TAC; EXISTS_TAC `Y'`; EXISTS_TAC `Y`; ASM_REWRITE_TAC[real_gt;NOT_CONS_NIL;HD;TL;APPEND;ALL2;interpsigns;interpsign]; REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ]);; (* }}} *) let INFIN_NIL_NEG = prove_by_refinement( `!p ps r1. interpmat [] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Unknown (CONS Neg r1)] ==> nonconstant p ==> ?xminf xinf. interpmat [xminf; xinf] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Pos (CONS Neg r1); CONS Pos (CONS Neg r1); CONS Unknown (CONS Neg r1); CONS Neg (CONS Neg r1); CONS Neg (CONS Neg r1)]`, (* {{{ Proof *) [ REWRITE_TAC[real_gt;interpmat;partition_line;ROL_NIL;ALL2;interpsigns;interpsign]; REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_DOWN_RIGHT3)); ASM_REWRITE_TAC[real_gt]; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_UP_LEFT5)); ASM_REWRITE_TAC[real_gt]; STRIP_TAC; EXISTS_TAC `Y'`; EXISTS_TAC `Y`; ASM_REWRITE_TAC[real_gt;NOT_CONS_NIL;HD;TL;APPEND;ALL2;interpsigns;interpsign]; REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); EXISTS_TAC `\x. T`; ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; ]);; (* }}} *) let INFIN_SING_POS_POS = prove_by_refinement( `!p ps r1 x s2 r2 r3. interpmat [x] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Unknown (CONS Pos r1);CONS s2 r2;CONS Unknown (CONS Pos r3)] ==> nonconstant p ==> ?xminf xinf. interpmat [xminf; x; xinf] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Neg (CONS Pos r1); CONS Neg (CONS Pos r1); CONS Unknown (CONS Pos r1); CONS s2 r2; CONS Unknown (CONS Pos r3); CONS Pos (CONS Pos r3); CONS Pos (CONS Pos r3)]`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_POS_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); EXISTS_TAC `xinf`; REWRITE_ALL[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); ASM_REWRITE_TAC[]; ]);; (* }}} *) let INFIN_SING_POS_NEG = prove_by_refinement( `!p ps r1 x s2 r2 r3. interpmat [x] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Unknown (CONS Pos r1);CONS s2 r2;CONS Unknown (CONS Neg r3)] ==> nonconstant p ==> ?xminf xinf. interpmat [xminf; x; xinf] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Neg (CONS Pos r1); CONS Neg (CONS Pos r1); CONS Unknown (CONS Pos r1); CONS s2 r2; CONS Unknown (CONS Neg r3); CONS Neg (CONS Neg r3); CONS Neg (CONS Neg r3)]`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_NEG_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); EXISTS_TAC `xinf`; REWRITE_ALL[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); ASM_REWRITE_TAC[]; ]);; (* }}} *) let INFIN_SING_NEG_POS = prove_by_refinement( `!p ps r1 x s2 r2 r3. interpmat [x] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Unknown (CONS Neg r1);CONS s2 r2;CONS Unknown (CONS Pos r3)] ==> nonconstant p ==> ?xminf xinf. interpmat [xminf; x; xinf] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Pos (CONS Neg r1); CONS Pos (CONS Neg r1); CONS Unknown (CONS Neg r1); CONS s2 r2; CONS Unknown (CONS Pos r3); CONS Pos (CONS Pos r3); CONS Pos (CONS Pos r3)]`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_POS_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); EXISTS_TAC `xinf`; REWRITE_ALL[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); ASM_REWRITE_TAC[]; ]);; (* }}} *) let INFIN_SING_NEG_NEG = prove_by_refinement( `!p ps r1 x s2 r2 r3. interpmat [x] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Unknown (CONS Neg r1);CONS s2 r2;CONS Unknown (CONS Neg r3)] ==> nonconstant p ==> ?xminf xinf. interpmat [xminf; x; xinf] (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) [CONS Pos (CONS Neg r1); CONS Pos (CONS Neg r1); CONS Unknown (CONS Neg r1); CONS s2 r2; CONS Unknown (CONS Neg r3); CONS Neg (CONS Neg r3); CONS Neg (CONS Neg r3)]`, (* {{{ Proof *) [ REPEAT STRIP_TAC; ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_NEG_LEM); ASM_REWRITE_TAC[]; STRIP_TAC; MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); EXISTS_TAC `xinf`; REWRITE_ALL[APPEND]; FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); ASM_REWRITE_TAC[]; ]);; (* }}} *) let EL_SUC = prove_by_refinement( `!i h t. EL (SUC i) (CONS h t) = EL i t`, (* {{{ Proof *) [ REWRITE_TAC[EL;TL]; ]);; (* }}} *) let EL_PRE = prove_by_refinement( `!i h t. ~(i = 0) ==> (EL i (CONS h t) = EL (PRE i) t)`, (* {{{ Proof *) [ INDUCT_TAC; REWRITE_TAC[]; REPEAT STRIP_TAC; REWRITE_TAC[EL;TL;PRE]; ]);; (* }}} *) let ALL2_EL_LT_LEM = prove_by_refinement( `!k P l1 l2 n. (k = LENGTH l1) /\ ALL2 P l1 l2 /\ n < k ==> P (EL n l1) (EL n l2)`, (* {{{ Proof *) [ INDUCT_TAC; REPEAT STRIP_TAC; POP_ASSUM MP_TAC THEN ARITH_TAC; REPEAT STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); STRIP_TAC; CLAIM `~(l1 = [])`; REWRITE_TAC[GSYM LENGTH_0]; REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL;]; STRIP_TAC; CLAIM `~(l2 = [])`; REWRITE_TAC[GSYM LENGTH_0]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (SUBST1_TAC o GSYM); REPEAT_N 2 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL;]; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ASSUMS[LENGTH;SUC_INJ;ALL2;]; REPEAT_N 3 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; (* save *) DISJ_CASES_TAC (ISPEC `n:num` num_CASES); POP_ASSUM (REWRITE_ALL o list); ASM_REWRITE_TAC[EL;HD]; POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;TL;]; REWRITE_ASSUMS[LENGTH;SUC_INJ;ALL2;LT_SUC]; FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; ]);; (* }}} *) let ALL2_EL_LT = prove_by_refinement( `!P l1 l2 n. ALL2 P l1 l2 /\ n < LENGTH l1 ==> P (EL n l1) (EL n l2)`, (* {{{ Proof *) [ MESON_TAC[ALL2_EL_LT_LEM]; ]);; (* }}} *) let ALL2_EL_LEM = prove_by_refinement( `!k P (l1:A list) (l2:B list). (k = LENGTH l1) /\ (k = LENGTH l2) /\ ~(?i. i < LENGTH l1 /\ ~(P (EL i l1) (EL i l2))) ==> ALL2 P l1 l2`, (* {{{ Proof *) [ INDUCT_TAC; REPEAT STRIP_TAC; EVERY_ASSUM (MP_TAC o GSYM); ASM_MESON_TAC[LENGTH_0;ALL2]; REPEAT STRIP_TAC; CLAIM `~(l1 = [])`; REWRITE_TAC[GSYM LENGTH_0]; REPEAT_N 2 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL;]; STRIP_TAC; CLAIM `~(l2 = [])`; REWRITE_TAC[GSYM LENGTH_0]; REPEAT_N 2 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL;]; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[LENGTH;SUC_INJ;ALL2;]; STRIP_TAC; ASM_MESON_TAC[LT_0;EL;HD;]; (* save *) FIRST_ASSUM MATCH_MP_TAC; ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[]; REPEAT STRIP_TAC; CLAIM `SUC i < SUC (LENGTH t)`; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; REPEAT_N 3 (POP_ASSUM MP_TAC); REWRITE_ASSUMS[NOT_EXISTS_THM]; POP_ASSUM (ASSUME_TAC o ISPEC `SUC i`); REWRITE_ALL[LT_SUC]; REWRITE_ALL[EL;TL;]; ASM_MESON_TAC[]; ]);; (* }}} *) let ALL2_EL = prove_by_refinement( `!P (l1:A list) (l2:B list). ALL2 P l1 l2 <=> (LENGTH l1 = LENGTH l2) /\ ~(?i. i < LENGTH l1 /\ ~(P (EL i l1) (EL i l2)))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; EQ_TAC; REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_LENGTH; ASM_MESON_TAC[]; ASM_MESON_TAC[ALL2_EL_LT]; (* save *) ASM_MESON_TAC[ALL2_EL_LEM]; ]);; (* }}} *) let EL_MAP = prove_by_refinement( `!f l n. n < LENGTH l ==> (EL n (MAP f l) = f (EL n l))`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[LENGTH]; ARITH_TAC; REWRITE_TAC[MAP;LENGTH;]; INDUCT_TAC; REWRITE_TAC[MAP;LENGTH;EL;HD;]; REWRITE_ALL[LT_SUC;TL;MAP;LENGTH;EL;HD;]; ASM_REWRITE_TAC[]; ]);; (* }}} *) let REMOVE_HD_COL = prove_by_refinement( `!p ps sgns pts. interpmat pts (CONS p ps) sgns ==> interpmat pts ps (MAP TL sgns)`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;ALL2_EL]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[ALL2_EL]; ASM_MESON_TAC[LENGTH_MAP]; REWRITE_ASSUMS[NOT_EXISTS_THM]; REPEAT_N 2 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `i:num`); REWRITE_TAC[DE_MORGAN_THM]; REPEAT STRIP_TAC; ASM_MESON_TAC[]; REWRITE_ALL[interpsigns]; CLAIM `i < LENGTH sgns`; ASM_MESON_TAC[]; STRIP_TAC; ASM_SIMP_TAC[EL_MAP]; REWRITE_ALL[interpsigns]; CLAIM `~(EL i sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); REWRITE_TAC[LENGTH]; ARITH_TAC; (* save *) DISCH_THEN (MP_TAC o MATCH_MP HD_TL); DISCH_THEN (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN SUBST1_TAC x); REWRITE_TAC[ALL2;TL;]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let REMOVE_COL1 = prove_by_refinement( `!sgns pts p1 p2 ps. interpmat pts (CONS p1 (CONS p2 ps)) sgns ==> interpmat pts (CONS p1 ps) (MAP (\x. CONS (HD x) (TL (TL x))) sgns)`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;ALL2_EL]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[LENGTH_MAP]; REWRITE_ASSUMS[NOT_EXISTS_THM]; REPEAT_N 2 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `i:num`); REWRITE_TAC[DE_MORGAN_THM]; REPEAT STRIP_TAC; ASM_MESON_TAC[]; REWRITE_ALL[interpsigns]; CLAIM `i < LENGTH sgns`; ASM_MESON_TAC[]; STRIP_TAC; ASM_SIMP_TAC[EL_MAP]; REWRITE_ALL[interpsigns]; CLAIM `~(EL i sgns = [])`; REWRITE_TAC[GSYM LENGTH_0]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); REWRITE_TAC[LENGTH]; ARITH_TAC; (* save *) DISCH_THEN (MP_TAC o MATCH_MP HD_TL); DISCH_THEN (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN SUBST1_TAC x); REWRITE_TAC[ALL2;TL;]; REPEAT STRIP_TAC; ASM_MESON_TAC[HD;]; CLAIM `~(TL (EL i sgns) = [])`; REWRITE_TAC[GSYM LENGTH_0]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); REWRITE_TAC[LENGTH]; ARITH_TAC; (* save *) DISCH_THEN (MP_TAC o MATCH_MP HD_TL); DISCH_THEN (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN SUBST1_TAC x); REWRITE_TAC[ALL2;TL;]; REPEAT STRIP_TAC; ASM_MESON_TAC[HD;]; ]);; (* }}} *) let ALL_EL = prove_by_refinement( `!P l. ALL P l <=> !n. n < LENGTH l ==> P (EL n l)`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[ALL;LENGTH]; ARITH_TAC; ASM_REWRITE_TAC[ALL]; POP_ASSUM (fun x -> ALL_TAC); EQ_TAC; REPEAT STRIP_TAC; CASES_ON `n = 0`; POP_ASSUM (REWRITE_ALL o list); ASM_REWRITE_TAC[EL;HD;]; REWRITE_ASSUMS[LENGTH]; CLAIM `PRE n < LENGTH t`; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; DISCH_THEN (fun x -> FIRST_ASSUM (MP_TAC o C MATCH_MP x)); ASM_MESON_TAC[EL_PRE]; (* save *) REPEAT STRIP_TAC; REWRITE_ASSUMS[LENGTH]; FIRST_ASSUM (MP_TAC o ISPEC `0`); REWRITE_TAC[EL;HD;]; MESON_TAC[LT_0]; REWRITE_ASSUMS[LENGTH]; CLAIM `SUC n < SUC (LENGTH t)`; ASM_MESON_TAC[LT_SUC]; DISCH_THEN (fun x -> FIRST_ASSUM (MP_TAC o C MATCH_MP x)); REWRITE_TAC[EL_SUC]; ]);; (* }}} *) let INTERPMAT_POL_LENGTH_LEM = prove_by_refinement( `!k pols l1 l2. ALL2 (interpsigns pols) l1 l2 /\ (k = LENGTH l2) ==> ALL (\x. LENGTH x = LENGTH pols) l2`, (* {{{ Proof *) [ INDUCT_TAC; REPEAT STRIP_TAC; CLAIM `l2 = []`; ASM_MESON_TAC[NOT_CONS_NIL;LENGTH_0;ALL2_LENGTH]; DISCH_THEN (REWRITE_ALL o list); REWRITE_TAC[ALL]; REPEAT STRIP_TAC; CLAIM `~(l2 = [])`; ASM_MESON_TAC[NOT_CONS_NIL;LENGTH_0;ALL2_LENGTH;NOT_SUC]; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN (POP_ASSUM (REWRITE_ALL o list)); CLAIM `~(l1 = [])`; ASM_MESON_TAC[NOT_CONS_NIL;LENGTH_0;ALL2_LENGTH;NOT_SUC]; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN (POP_ASSUM (REWRITE_ALL o list)); REWRITE_ALL[ALL2;ALL;interpsigns]; STRIP_TAC; ASM_MESON_TAC[ALL2_LENGTH]; FIRST_ASSUM MATCH_MP_TAC; EXISTS_TAC `t'`; ASM_REWRITE_TAC[]; REWRITE_ALL[LENGTH]; POP_ASSUM MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let INTERPMAT_POL_LENGTH = prove_by_refinement( `!pts pols sgns. interpmat pts pols sgns ==> ALL (\x. LENGTH x = LENGTH pols) sgns`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; MESON_TAC[INTERPMAT_POL_LENGTH_LEM]; ]);; (* }}} *) let RESTRIP_TAC = REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC;; let ALL2_BUTLAST = prove_by_refinement( `!P l1 l2. ALL2 P l1 l2 ==> ALL2 P (BUTLAST l1) (BUTLAST l2)`, (* {{{ Proof *) [ STRIP_TAC; REPEAT LIST_INDUCT_TAC; REWRITE_TAC[ALL2;BUTLAST]; REWRITE_TAC[ALL2;BUTLAST]; REWRITE_TAC[ALL2;BUTLAST]; POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[ALL2;BUTLAST;]; REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL;ALL2;]; REWRITE_ASSUMS[NOT_NIL]; POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[ALL2]; REWRITE_ASSUMS[NOT_NIL]; RESTRIP_TAC; ASM_MESON_TAC[ALL2]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; ]);; (* }}} *) let REMOVE_LAST = prove_by_refinement( `!pts pols sgns . interpmat pts pols sgns ==> interpmat pts (BUTLAST pols) (MAP BUTLAST sgns)`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;ALL2_EL]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_MESON_TAC[LENGTH_MAP]; REWRITE_ASSUMS[NOT_EXISTS_THM]; REPEAT_N 2 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `i:num`); REWRITE_TAC[DE_MORGAN_THM]; REPEAT STRIP_TAC; ASM_MESON_TAC[]; REWRITE_ALL[interpsigns]; CLAIM `i < LENGTH sgns`; ASM_MESON_TAC[]; STRIP_TAC; (* save *) ASM_SIMP_TAC[EL_MAP]; ASM_MESON_TAC[ALL2_BUTLAST]; ]);; (* }}} *) let INSERTAT = new_recursive_definition num_RECURSION `(INSERTAT 0 x l = CONS x l) /\ (INSERTAT (SUC n) x l = CONS (HD l) (INSERTAT n x (TL l)))`;; let MAP2_EL_LEM = prove_by_refinement( `!f k l1 l2 i. (LENGTH l1 = LENGTH l2) ==> i < LENGTH l1 ==> (k = LENGTH l1) ==> (EL i (MAP2 f l1 l2) = f (EL i l1) (EL i l2))`, (* {{{ Proof *) [ STRIP_TAC; INDUCT_TAC; REPEAT STRIP_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; REPEAT STRIP_TAC; CLAIM `~(l1 = [])`; ASM_MESON_TAC[LENGTH_0;NOT_SUC]; CLAIM `~(l2 = [])`; ASM_MESON_TAC[LENGTH_0;NOT_SUC]; REWRITE_TAC[NOT_NIL]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[MAP2]; REWRITE_ALL[LENGTH;SUC_INJ]; DISJ_CASES_TAC (ISPEC `i:num` num_CASES); POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;HD;]; POP_ASSUM MP_TAC THEN STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;TL;]; REWRITE_ASSUMS[LT_SUC]; ASM_MESON_TAC[]; ]);; (* }}} *) let MAP2_EL = prove_by_refinement( `!f i l1 l2. (LENGTH l1 = LENGTH l2) ==> i < LENGTH l1 ==> (EL i (MAP2 f l1 l2) = f (EL i l1) (EL i l2))`, (* {{{ Proof *) [ MESON_TAC[MAP2_EL_LEM]; ]);; (* }}} *) let INSERTAT_LENGTH = prove_by_refinement( `!x n l. n <= LENGTH l ==> (LENGTH (INSERTAT n x l) = SUC (LENGTH l))`, (* {{{ Proof *) [ STRIP_TAC; INDUCT_TAC; REWRITE_TAC[INSERTAT;LENGTH;]; REWRITE_TAC[INSERTAT;LENGTH;]; REPEAT STRIP_TAC; AP_TERM_TAC; CLAIM `~(l = [])`; ASM_MESON_TAC[LENGTH_0;NOT_LE;ARITH_RULE `~(SUC n <= 0)`]; REWRITE_TAC[NOT_NIL]; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[LENGTH;TL;LE_SUC]; ASM_MESON_TAC[]; ]);; (* }}} *) let NUM_CASES_TAC = TYPE_TAC (fun x -> DISJ_CASES_TAC (ISPEC x num_CASES));; let INSERTAT_TL = prove_by_refinement( `!x n l. n < LENGTH l ==> (INSERTAT n x (TL l) = TL (INSERTAT (SUC n) x l))`, (* {{{ Proof *) [ STRIP_TAC; INDUCT_TAC; REPEAT STRIP_TAC; REWRITE_TAC[INSERTAT;TL;]; REPEAT STRIP_TAC; CLAIM `n < LENGTH l \/ (n = LENGTH l)`; POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; REWRITE_TAC[INSERTAT;HD;TL;]; REWRITE_TAC[INSERTAT;HD;TL;]; ]);; (* }}} *) let INSERTAT_EL = prove_by_refinement( `!n (x:A) i l. n <= LENGTH l ==> i <= LENGTH l ==> ((i < n ==> (EL i (INSERTAT n x l) = EL i l)) /\ ((i = n) ==> (EL i (INSERTAT n x l) = x)) /\ (i > n ==> (EL i (INSERTAT n x l) = EL (PRE i) l)))`, (* {{{ Proof *) [ INDUCT_TAC; REPEAT STRIP_TAC; POP_ASSUM MP_TAC THEN ARITH_TAC; ASM_REWRITE_TAC[INSERTAT;EL;HD;]; ASM_REWRITE_TAC[INSERTAT;EL;HD;]; DISJ_CASES_TAC (ISPEC `i:num` num_CASES); EVERY_ASSUM MP_TAC THEN ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;TL;PRE]; (* save *) REPEAT_N 5 STRIP_TAC; CLAIM `~(l = [])`; ASM_MESON_TAC[LENGTH_0;NOT_LE;ARITH_RULE `~(SUC n <= 0)`]; STRIP_TAC; CLAIM `n <= LENGTH (TL l)`; ASM_SIMP_TAC[LENGTH_TL]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; (* save *) REPEAT STRIP_TAC; REWRITE_TAC[INSERTAT]; NUM_CASES_TAC `i`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;HD;]; POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;TL;]; CLAIM `n' <= LENGTH (TL l)`; REWRITE_ASSUMS[LT_SUC]; ASM_MESON_TAC[LTE_TRANS;LT_TRANS;LET_TRANS;LT_IMP_LE]; STRIP_TAC; REWRITE_ASSUMS[LT_SUC]; ASM_MESON_TAC[]; (* save *) POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;INSERTAT;TL;]; ASM_MESON_TAC[]; REWRITE_TAC[INSERTAT]; NUM_CASES_TAC `i`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;HD;PRE]; (* save *) POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;TL;PRE]; CLAIM `n' <= LENGTH (TL l)`; ASM_SIMP_TAC[LENGTH_TL]; REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; REWRITE_ASSUMS[GT;LT_SUC]; FIRST_X_ASSUM (MP_TAC o ISPECL[`x:A`;`n':num`;`TL l:A list`]); ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; NUM_CASES_TAC `n'`; ASM_MESON_TAC[ARITH_RULE `x < y ==> ~(y = 0)`]; POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[PRE;EL]; ]);; (* }}} *) let USE_X_ASSUM lab ttac = USE_THEN lab (fun th -> UNDISCH_THEN (concl th) ttac);; let MATINSERT_THM = prove_by_refinement( `!pts p pols n psgns sgns. interpmat pts pols sgns ==> ALL2 (\x y. interpsign x p y) (partition_line pts) psgns ==> n <= LENGTH pols ==> interpmat pts (INSERTAT n p pols) (MAP2 (INSERTAT n) psgns sgns)`, (* {{{ Proof *) [ REWRITE_TAC[interpmat;ALL2_EL;NOT_EXISTS_THM;DE_MORGAN_THM;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; CLAIM `LENGTH (psgns:sign list) = LENGTH sgns`; ASM_MESON_TAC[LENGTH_MAP2]; ASM_MESON_TAC[LENGTH_MAP2]; DISJ_LCASE; REWRITE_ASSUMS[]; (* save *) REWRITE_ALL[interpsigns]; CLAIM `LENGTH psgns = LENGTH sgns`; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `i < LENGTH psgns`; ASM_MESON_TAC[]; STRIP_TAC; ASM_SIMP_TAC[MAP2_EL]; (* save *) REWRITE_TAC[ALL2_EL]; REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM]; REPEAT STRIP_TAC; ASM_SIMP_TAC[INSERTAT_LENGTH]; CLAIM `LENGTH (EL i (sgns:(sign list) list)) = LENGTH pols`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; ASM_SIMP_TAC[INSERTAT_LENGTH]; (* save *) DISJ_LCASE; REWRITE_ASSUMS[]; MP_TAC (ARITH_RULE `i' < n \/ (i' = n) \/ i' > (n:num)`); REPEAT STRIP_TAC; CLAIM `LENGTH (EL i sgns) = LENGTH pols`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; CLAIM `n <= LENGTH (EL i sgns)`; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `i' <= LENGTH (EL i sgns)`; ASM_MESON_TAC[LTE_TRANS;LET_TRANS;LT_TRANS;LT_IMP_LE]; STRIP_TAC; ASM_SIMP_TAC[INSERTAT_EL]; CLAIM `i' <= LENGTH pols`; ASM_MESON_TAC[LTE_TRANS;LET_TRANS;LT_TRANS;LT_IMP_LE]; STRIP_TAC; ASM_SIMP_TAC[INSERTAT_EL]; REPEAT_N 12 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `i:num`); REPEAT STRIP_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; USE_THEN "Z-12" MP_TAC; REWRITE_TAC[ALL2_EL]; REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM]; STRIP_TAC; POP_ASSUM (MP_TAC o ISPEC `i':num`); POP_ASSUM (fun x -> ALL_TAC); ASM_REWRITE_TAC[]; POP_ASSUM (fun x -> ALL_TAC); STRIP_TAC; ASM_MESON_TAC[ARITH_RULE `x <= y /\ z < x ==> z < (y:num)`]; (* save *) POP_ASSUM (REWRITE_ALL o list); CLAIM `LENGTH (EL i sgns) = LENGTH pols`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; CLAIM `n <= LENGTH (EL i sgns)`; ASM_MESON_TAC[]; STRIP_TAC; ASM_SIMP_TAC[INSERTAT_EL]; ASM_MESON_TAC[ALL2_EL]; (* save *) CLAIM `LENGTH (EL i sgns) = LENGTH pols`; ASM_MESON_TAC[ALL2_LENGTH]; STRIP_TAC; CLAIM `n <= LENGTH (EL i sgns)`; ASM_MESON_TAC[]; STRIP_TAC; CLAIM `i' <= LENGTH (EL i sgns)`; ASM_REWRITE_TAC[]; LABEL_ALL_TAC; USE_THEN "Z-7" (MP_TAC o MATCH_MP INSERTAT_LENGTH); TYPE_TAC (fun x -> DISCH_THEN (MP_TAC o ISPEC x)) `p`; USE_THEN "Z-3" MP_TAC THEN ARITH_TAC; STRIP_TAC; CLAIM `i' <= LENGTH pols`; ASM_MESON_TAC[]; STRIP_TAC; ASM_SIMP_TAC[INSERTAT_EL]; LABEL_ALL_TAC; (* save *) USE_X_ASSUM "Z-12" (MP_TAC o ISPEC `i:num`); ASM_REWRITE_TAC[]; REWRITE_TAC[ALL2_EL]; ASM_REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM;]; DISCH_THEN (MP_TAC o ISPEC `PRE i':num`); STRIP_TAC; CLAIM `~(i' = 0)`; USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let INTERP_CONST_POS = prove_by_refinement( `!c l. c > &0 ==> ALL2 (\x y. interpsign x (\x. c) y) l (REPLICATE (LENGTH l) Pos)`, (* {{{ Proof *) [ REWRITE_TAC[real_gt;]; STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[REPLICATE;LENGTH;ALL2;]; DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); REWRITE_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; ]);; (* }}} *) let INTERP_CONST_NEG = prove_by_refinement( `!c l. c < &0 ==> ALL2 (\x y. interpsign x (\x. c) y) l (REPLICATE (LENGTH l) Neg)`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[REPLICATE;LENGTH;ALL2;]; DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); REWRITE_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; ASM_MESON_TAC[]; ]);; (* }}} *) let INTERP_CONST_ZERO = prove_by_refinement( `!c l. (c = &0) ==> ALL2 (\x y. interpsign x (\x. c) y) l (REPLICATE (LENGTH l) Zero)`, (* {{{ Proof *) [ STRIP_TAC; LIST_INDUCT_TAC; REWRITE_TAC[REPLICATE;LENGTH;ALL2;]; DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); REWRITE_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; ASM_REWRITE_TAC[]; (* XXX MESON FAILS HERE *) ]);; (* }}} *) let QUANT_CONV conv = RAND_CONV(ABS_CONV conv);; let rec PATH_CONV2 s cnv = match s with [] -> cnv | "l"::t -> RATOR_CONV (PATH_CONV2 t cnv) | "r"::t -> RAND_CONV (PATH_CONV2 t cnv) | "q"::t -> QUANT_CONV (PATH_CONV2 t cnv) | "a"::t -> ABS_CONV (PATH_CONV2 t cnv) | _ -> failwith "PATH_CONV2: unknown direction";; let EL_REPLICATE = prove_by_refinement( `!n x i. i < n ==> (EL i (REPLICATE n x) = x)`, (* {{{ Proof *) [ INDUCT_TAC; ARITH_TAC; REPEAT STRIP_TAC; REWRITE_TAC[REPLICATE]; NUM_CASES_TAC `i`; POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;HD;]; POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); REWRITE_TAC[EL;TL;]; ASM_MESON_TAC[LT_SUC]; ]);; (* }}} *) let ALL2_UNKNOWN = prove_by_refinement( `!p pts. ALL2 (\x y. interpsign x p y) (partition_line pts) (REPLICATE (LENGTH (partition_line pts)) Unknown)`, (* {{{ Proof *) [ REWRITE_TAC[ALL2_EL]; REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM]; REPEAT STRIP_TAC; ASM_MESON_TAC[LENGTH_REPLICATE]; DISJ_LCASE; REWRITE_ASSUMS[]; ASM_SIMP_TAC[EL_REPLICATE]; REWRITE_TAC[interpsign]; ]);; (* }}} *) let MATINSERT_THM2 = prove_by_refinement( `!pts p pols n psgns sgns. ALL2 (\x y. interpsign x p y) (partition_line pts) psgns ==> n <= LENGTH pols ==> interpmat pts pols sgns ==> interpmat pts (INSERTAT n p pols) (MAP2 (INSERTAT n) psgns sgns)`, (* {{{ Proof *) [ MESON_TAC[MATINSERT_THM] ]);; (* }}} *) let FUN_EQ_TAC = MATCH_EQ_MP_TAC (GSYM FUN_EQ_THM);; let INSERTAT_0 = prove_by_refinement( `INSERTAT 0 = CONS`, (* {{{ Proof *) [ FUN_EQ_TAC; STRIP_TAC; FUN_EQ_TAC; REWRITE_TAC[INSERTAT]; ]);; (* }}} *) let INFERPSIGN_MATINSERT_THM = prove_by_refinement( `!pts p pols sgns. interpmat pts pols sgns ==> interpmat pts (CONS p pols) (MAP2 CONS (REPLICATE (2 * LENGTH pts + 1) Unknown) sgns)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l MATINSERT_THM)) [`pts`;`p`;`pols`;`0`;`REPLICATE (LENGTH (partition_line pts)) Unknown`;`sgns`]; ASM_REWRITE_TAC[ALL2_UNKNOWN;ARITH_RULE `0 <= x`;INSERTAT;PARTITION_LINE_LENGTH]; MESON_TAC[INSERTAT_0]; ]);; (* }}} *) let INFERPSIGN_POS = prove_by_refinement( `!p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. p x = s x * q x + r x) ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Pos s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 5 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* save *) CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 6 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; (* save *) REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; ]);; (* }}} *) let INFERPSIGN_NEG = prove_by_refinement( `!p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. p x = s x * q x + r x) ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Neg s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, (* {{{ Proof *) [ REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 5 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* save *) CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 6 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; (* save *) REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; FIRST_ASSUM MATCH_MP_TAC; REWRITE_TAC[]; ]);; (* }}} *) let INFERPSIGN_POS_EVEN_LEM = prove_by_refinement( `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a <> &0) ==> EVEN n ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Pos s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `a pow n > &0`; ASM_MESON_TAC[EVEN_ODD_POW]; STRIP_TAC; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 8 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 9 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 15 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; (* save *) CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 10 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 17 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; ]);; (* }}} *) let SPLIT_LIST_THM = prove_by_refinement( `!n (l:A list). n < LENGTH l ==> ?l1 l2. (l = APPEND l1 l2) /\ (LENGTH l1 = n)`, (* {{{ Proof *) [ INDUCT_TAC; REPEAT STRIP_TAC; EXISTS_TAC `[]:A list`; EXISTS_TAC `l`; REWRITE_TAC[APPEND;LENGTH]; REPEAT STRIP_TAC; CLAIM `n < LENGTH l`; POP_ASSUM MP_TAC THEN ARITH_TAC; DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); STRIP_TAC; EXISTS_TAC `APPEND l1 [HD l2]`; EXISTS_TAC `TL (l2:A list)`; CLAIM `~((l2:A list) = [])`; REWRITE_TAC[GSYM LENGTH_0]; STRIP_TAC; POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC; POP_ASSUM (MP_TAC o AP_TERM `LENGTH:A list -> num`); REWRITE_TAC[LENGTH_APPEND]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL;]; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); ASM_REWRITE_TAC[TL;HD;LENGTH_APPEND;LENGTH;]; STRIP_TAC; REWRITE_TAC[APPEND_APPEND;APPEND;]; ARITH_TAC; ]);; (* }}} *) let rec EXISTS_TACL = (fun l -> match l with [] -> ALL_TAC | h::t -> TYPE_TAC EXISTS_TAC h THEN EXISTS_TACL t);; let DIV_EVEN = prove_by_refinement( `!x. EVEN x ==> (2 * x DIV 2 = x)`, (* {{{ Proof *) [ REPEAT STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l DIVISION)) [`x`;`2`]; ARITH_SIMP_TAC[]; REWRITE_ASSUMS[EVEN_MOD]; ASM_REWRITE_TAC[]; ARITH_SIMP_TAC[]; STRIP_TAC; REWRITE_ASSUMS[ARITH_RULE `x + 0 = x`]; ONCE_REWRITE_ASSUMS[ARITH_RULE `x * y = y * x:num`]; ASM_MESON_TAC[]; ]);; (* }}} *) let PRE_LEM = prove_by_refinement( `!n. (ODD n ==> EVEN (PRE n)) /\ (~(n = 0) ==> (EVEN n ==> ODD (PRE n)))`, (* {{{ Proof *) [ INDUCT_TAC; ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; REPEAT STRIP_TAC; REWRITE_TAC[PRE]; ASM_MESON_TAC[ODD;NOT_ODD]; ASM_MESON_TAC[ODD;PRE;NOT_ODD]; ]);; (* }}} *) let EVEN_PRE = GEN_ALL (CONJUNCT1 (SPEC_ALL PRE_LEM));; let ODD_PRE = GEN_ALL (CONJUNCT2 (SPEC_ALL PRE_LEM));; let INFERPSIGN_POS_EVEN = prove_by_refinement( `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a <> &0) ==> EVEN n ==> interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Pos s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) = LENGTH (partition_line pts)`; REWRITE_ALL[interpmat]; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(l2 = [])`; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; REWRITE_ALL[APPEND_NIL]; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_POS_EVEN_LEM); ASM_REWRITE_TAC[]; EXISTS_TACL [`a`;`n`;`s`]; (* save *) ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; CLAIM `EVEN (LENGTH sgns - 1)`; ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; STRIP_TAC; ASM_SIMP_TAC[DIV_EVEN]; USE_THEN "Z-5" MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let INFERPSIGN_NEG_EVEN_LEM = prove_by_refinement( `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a <> &0) ==> EVEN n ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Neg s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `a pow n > &0`; ASM_MESON_TAC[EVEN_ODD_POW]; STRIP_TAC; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 8 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[]; REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 9 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[]; REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[]; REPEAT_N 15 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; (* save *) CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 10 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 17 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; ]);; (* }}} *) let INFERPSIGN_NEG_EVEN = prove_by_refinement( `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a <> &0) ==> EVEN n ==> interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Neg s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) = LENGTH (partition_line pts)`; REWRITE_ALL[interpmat]; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(l2 = [])`; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; REWRITE_ALL[APPEND_NIL]; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_NEG_EVEN_LEM); ASM_REWRITE_TAC[]; EXISTS_TACL [`a`;`n`;`s`]; (* save *) ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; CLAIM `EVEN (LENGTH sgns - 1)`; ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; STRIP_TAC; ASM_SIMP_TAC[DIV_EVEN]; USE_THEN "Z-5" MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let INFERPSIGN_ZERO_EVEN_LEM = prove_by_refinement( `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a <> &0) ==> EVEN n ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Zero s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `a pow n > &0`; ASM_MESON_TAC[EVEN_ODD_POW]; STRIP_TAC; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 8 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[]; REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 9 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[]; REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[]; REPEAT_N 15 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; (* save *) CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 10 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 17 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERPSIGN_ZERO_EVEN = prove_by_refinement( `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a <> &0) ==> EVEN n ==> interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Zero s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) = LENGTH (partition_line pts)`; REWRITE_ALL[interpmat]; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(l2 = [])`; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; REWRITE_ALL[APPEND_NIL]; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_ZERO_EVEN_LEM); ASM_REWRITE_TAC[]; EXISTS_TACL [`a`;`n`;`s`]; (* save *) ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; CLAIM `EVEN (LENGTH sgns - 1)`; ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; STRIP_TAC; ASM_SIMP_TAC[DIV_EVEN]; USE_THEN "Z-5" MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let INFERPSIGN_POS_ODD_POS_LEM = prove_by_refinement( `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a > &0) ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Pos s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `a pow n > &0`; ASM_MESON_TAC[REAL_POW_LT;real_gt;]; STRIP_TAC; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 7 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 5 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 8 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 14 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; (* save *) CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x > &0`; ASM_MESON_TAC[]; REPEAT_N 15 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERPSIGN_POS_ODD_POS = prove_by_refinement( `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a > &0) ==> interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Pos s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) = LENGTH (partition_line pts)`; REWRITE_ALL[interpmat]; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(l2 = [])`; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; REWRITE_ALL[APPEND_NIL]; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_POS_ODD_POS_LEM); ASM_REWRITE_TAC[]; EXISTS_TACL [`a`;`n`;`s`]; (* save *) ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; CLAIM `EVEN (LENGTH sgns - 1)`; ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; STRIP_TAC; ASM_SIMP_TAC[DIV_EVEN]; USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let INFERPSIGN_NEG_ODD_POS_LEM = prove_by_refinement( `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a > &0) ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Neg s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `a pow n > &0`; ASM_MESON_TAC[REAL_POW_LT;real_gt;]; STRIP_TAC; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 7 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[real_gt]; REPEAT_N 5 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 8 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[]; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[]; REPEAT_N 14 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; (* save *) CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x < &0`; ASM_MESON_TAC[]; REPEAT_N 15 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ]);; (* }}} *) let INFERPSIGN_NEG_ODD_POS = prove_by_refinement( `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a > &0) ==> interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Neg s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) = LENGTH (partition_line pts)`; REWRITE_ALL[interpmat]; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(l2 = [])`; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; REWRITE_ALL[APPEND_NIL]; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_NEG_ODD_POS_LEM); ASM_REWRITE_TAC[]; EXISTS_TACL [`a`;`n`;`s`]; (* save *) ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; CLAIM `EVEN (LENGTH sgns - 1)`; ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; STRIP_TAC; ASM_SIMP_TAC[DIV_EVEN]; USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; ]);; (* }}} *) let INFERPSIGN_ZERO_ODD_POS_LEM = prove_by_refinement( `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a > &0) ==> interpmat (APPEND pts1 (CONS x pts2)) (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Zero s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `a pow n > &0`; ASM_MESON_TAC[REAL_POW_LT;real_gt;]; STRIP_TAC; REPEAT (POP_ASSUM MP_TAC); REWRITE_TAC[interpmat]; REPEAT STRIP_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC; CASES_ON `pts1 = []`; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;]; COND_CASES_TAC; CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 7 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[real_gt]; REPEAT_N 5 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 6 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); CLAIM `?k. sgns = [k]`; MATCH_EQ_MP_TAC (GSYM LENGTH_1); REWRITE_ALL[LENGTH]; REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); POP_ASSUM MP_TAC THEN ARITH_TAC; STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[APPEND;partition_line;ALL2;]; REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; REWRITE_ALL[interpsigns;interpsign;ALL2;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 8 (POP_ASSUM MP_TAC); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[]; REPEAT_N 7 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; ASM_REWRITE_TAC[]; (* save *) POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); ASM_SIMP_TAC[PARTITION_LINE_APPEND]; REPEAT STRIP_TAC; CLAIM `(APPEND (BUTLAST (partition_line pts1)) (CONS (\x'. LAST pts1 < x' /\ x' < x) (TL (partition_line (CONS x pts2))))) = (APPEND (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) (TL (partition_line (CONS x pts2))))`; ASM_MESON_TAC[APPEND_CONS]; DISCH_THEN (REWRITE_ALL o list); REPEAT (POP_ASSUM MP_TAC); REWRITE_ALL[partition_line]; COND_CASES_TAC; POP_ASSUM (REWRITE_ALL o list); REPEAT STRIP_TAC; REWRITE_ALL[TL;]; CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REPEAT_N 8 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; RESTRIP_TAC; POP_ASSUM (REWRITE_ALL o list); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[]; REPEAT_N 14 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT;REAL_LT_IMP_NZ]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; (* save *) CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; ARITH_TAC; STRIP_TAC; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REPEAT STRIP_TAC; MATCH_MP_TAC ALL2_APPEND; ASM_REWRITE_TAC[]; (* save *) REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; ASM_REWRITE_TAC[]; REPEAT STRIP_TAC; REPEAT_N 9 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; ASM_REWRITE_TAC[]; FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; REPEAT_N 4 (POP_ASSUM MP_TAC); POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); REWRITE_TAC[ALL2;interpsign;]; REPEAT STRIP_TAC; REWRITE_ALL[interpsigns;ALL2;interpsign;]; ASM_REWRITE_TAC[]; CLAIM `q x = &0`; ASM_MESON_TAC[]; CLAIM `r x = &0`; ASM_MESON_TAC[]; REPEAT_N 15 (POP_ASSUM MP_TAC); POP_ASSUM (MP_TAC o ISPEC `x:real`); REPEAT STRIP_TAC; POP_ASSUM (REWRITE_ALL o list); REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; REPEAT_N 16 (POP_ASSUM MP_TAC); POP_ASSUM (REWRITE_ALL o list o GSYM); REWRITE_TAC[real_gt;REAL_MUL_GT]; REPEAT STRIP_TAC; ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT;REAL_LT_IMP_NZ]; ]);; (* }}} *) let INFERPSIGN_ZERO_ODD_POS = prove_by_refinement( `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> (LENGTH ps = LENGTH s1) ==> (LENGTH qs = LENGTH s2) ==> ODD (LENGTH sgns) ==> (!x. a pow n * p x = s x * q x + r x) ==> (a > &0) ==> interpmat pts (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) (APPEND sgns (CONS (APPEND (CONS Zero s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, (* {{{ Proof *) [ REPEAT STRIP_TAC; CLAIM `LENGTH (APPEND sgns (CONS (APPEND (CONS Unknown s1) (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) = LENGTH (partition_line pts)`; REWRITE_ALL[interpmat]; ASM_MESON_TAC[ALL2_LENGTH]; REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; STRIP_TAC; TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; STRIP_TAC; LABEL_ALL_TAC; PROVE_ASSUM_ANTECEDENT_TAC 0; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC; ARITH_TAC; POP_ASSUM MP_TAC THEN STRIP_TAC; ASM_REWRITE_TAC[]; CLAIM `~(l2 = [])`; DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; REWRITE_ALL[APPEND_NIL]; POP_ASSUM (REWRITE_ALL o list); POP_ASSUM (fun x -> ALL_TAC); DISCH_THEN (REWRITE_ALL o list); POP_ASSUM MP_TAC; POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM (fun x -> ALL_TAC); POP_ASSUM MP_TAC THEN ARITH_TAC; REWRITE_TAC[NOT_NIL]; STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_ZERO_ODD_POS_LEM); ASM_REWRITE_TAC[]; EXISTS_TACL [`a`;`n`;`s`]; (* save *) ASM_REWRITE_TAC[]; STRIP_TAC; ASM_MESON_TAC[]; LABEL_ALL_TAC; CLAIM `EVEN (LENGTH sgns - 1)`; ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; STRIP_TAC; ASM_SIMP_TAC[DIV_EVEN]; USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; ]);; (* }}} *) hol-light/Tutorial/000077500000000000000000000000001303454263000145505ustar00rootroot00000000000000hol-light/Tutorial/Abstractions_and_quantifiers.ml000066400000000000000000000014641303454263000227770ustar00rootroot00000000000000MESON[] `((?x. !y. P(x) <=> P(y)) <=> ((?x. Q(x)) <=> (!y. Q(y)))) <=> ((?x. !y. Q(x) <=> Q(y)) <=> ((?x. P(x)) <=> (!y. P(y))))`;; MESON[] `(!x y z. P x y /\ P y z ==> P x z) /\ (!x y z. Q x y /\ Q y z ==> Q x z) /\ (!x y. P x y ==> P y x) /\ (!x y. P x y \/ Q x y) ==> (!x y. P x y) \/ (!x y. Q x y)`;; let ewd1062 = MESON[] `(!x. x <= x) /\ (!x y z. x <= y /\ y <= z ==> x <= z) /\ (!x y. f(x) <= y <=> x <= g(y)) ==> (!x y. x <= y ==> f(x) <= f(y)) /\ (!x y. x <= y ==> g(x) <= g(y))`;; let ewd1062 = MESON[] `(!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R (f x) y <=> R x (g y)) ==> (!x y. R x y ==> R (f x) (f y)) /\ (!x y. R x y ==> R (g x) (g y))`;; MESON[] `(?!x. g(f x) = x) <=> (?!y. f(g y) = y)`;; MESON [ADD_ASSOC; ADD_SYM] `m + (n + p) = n + (m + p)`;; hol-light/Tutorial/Changing_proof_style.ml000066400000000000000000000034731303454263000212540ustar00rootroot00000000000000let fix ts = MAP_EVERY X_GEN_TAC ts;; let assume lab t = DISCH_THEN(fun th -> if concl th = t then LABEL_TAC lab th else failwith "assume");; let we're finished tac = tac;; let suffices_to_prove q tac = SUBGOAL_THEN q (fun th -> MP_TAC th THEN tac);; let note(lab,t) tac = SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN DISCH_THEN(fun th -> LABEL_TAC lab th);; let have t = note("",t);; let cases (lab,t) tac = SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (LABEL_TAC lab));; let consider (x,lab,t) tac = let tm = mk_exists(x,t) in SUBGOAL_THEN tm (X_CHOOSE_THEN x (LABEL_TAC lab)) THENL [tac; ALL_TAC];; let trivial = MESON_TAC[];; let algebra = CONV_TAC NUM_RING;; let arithmetic = ARITH_TAC;; let by labs tac = MAP_EVERY (fun l -> USE_THEN l MP_TAC) labs THEN tac;; let using ths tac = MAP_EVERY MP_TAC ths THEN tac;; let so constr arg tac = constr arg (FIRST_ASSUM MP_TAC THEN tac);; let NSQRT_2 = prove (`!p q. p * p = 2 * q * q ==> q = 0`, suffices_to_prove `!p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) ==> (!q. p * p = 2 * q * q ==> q = 0)` (MATCH_ACCEPT_TAC num_WF) THEN fix [`p:num`] THEN assume("A") `!m. m < p ==> !q. m * m = 2 * q * q ==> q = 0` THEN fix [`q:num`] THEN assume("B") `p * p = 2 * q * q` THEN so have `EVEN(p * p) <=> EVEN(2 * q * q)` (trivial) THEN so have `EVEN(p)` (using [ARITH; EVEN_MULT] trivial) THEN so consider (`m:num`,"C",`p = 2 * m`) (using [EVEN_EXISTS] trivial) THEN cases ("D",`q < p \/ p <= q`) (arithmetic) THENL [so have `q * q = 2 * m * m ==> m = 0` (by ["A"] trivial) THEN so we're finished (by ["B"; "C"] algebra); so have `p * p <= q * q` (using [LE_MULT2] trivial) THEN so have `q * q = 0` (by ["B"] arithmetic) THEN so we're finished (algebra)]);; hol-light/Tutorial/Custom_inference_rules.ml000066400000000000000000000137111303454263000216070ustar00rootroot00000000000000let near_ring_axioms = `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z))`;; (**** Works eventually but takes a very long time MESON[] `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z)) ==> !a. 0 * a = 0`;; ****) let is_realvar w x = is_var x && not(mem x w);; let rec real_strip w tm = if mem tm w then tm,[] else let l,r = dest_comb tm in let f,args = real_strip w l in f,args@[r];; let weight lis (f,n) (g,m) = let i = index f lis and j = index g lis in i > j || i = j && n > m;; let rec lexord ord l1 l2 = match (l1,l2) with (h1::t1,h2::t2) -> if ord h1 h2 then length t1 = length t2 else h1 = h2 && lexord ord t1 t2 | _ -> false;; let rec lpo_gt w s t = if is_realvar w t then not(s = t) && mem t (frees s) else if is_realvar w s || is_abs s || is_abs t then false else let f,fargs = real_strip w s and g,gargs = real_strip w t in exists (fun si -> lpo_ge w si t) fargs || forall (lpo_gt w s) gargs & (f = g && lexord (lpo_gt w) fargs gargs || weight w (f,length fargs) (g,length gargs)) and lpo_ge w s t = (s = t) || lpo_gt w s t;; let rec istriv w env x t = if is_realvar w t then t = x || defined env t && istriv w env x (apply env t) else if is_const t then false else let f,args = strip_comb t in exists (istriv w env x) args && failwith "cyclic";; let rec unify w env tp = match tp with ((Var(_,_) as x),t) | (t,(Var(_,_) as x)) when not(mem x w) -> if defined env x then unify w env (apply env x,t) else if istriv w env x t then env else (x|->t) env | (Comb(f,x),Comb(g,y)) -> unify w (unify w env (x,y)) (f,g) | (s,t) -> if s = t then env else failwith "unify: not unifiable";; let fullunify w (s,t) = let env = unify w undefined (s,t) in let th = map (fun (x,t) -> (t,x)) (graph env) in let rec subs t = let t' = vsubst th t in if t' = t then t else subs t' in map (fun (t,x) -> (subs t,x)) th;; let rec listcases fn rfn lis acc = match lis with [] -> acc | h::t -> fn h (fun i h' -> rfn i (h'::map REFL t)) @ listcases fn (fun i t' -> rfn i (REFL h::t')) t acc;; let LIST_MK_COMB f ths = rev_itlist (fun s t -> MK_COMB(t,s)) ths (REFL f);; let rec overlaps w th tm rfn = let l,r = dest_eq(concl th) in if not (is_comb tm) then [] else let f,args = strip_comb tm in listcases (overlaps w th) (fun i a -> rfn i (LIST_MK_COMB f a)) args (try [rfn (fullunify w (l,tm)) th] with Failure _ -> []);; let crit1 w eq1 eq2 = let l1,r1 = dest_eq(concl eq1) and l2,r2 = dest_eq(concl eq2) in overlaps w eq1 l2 (fun i th -> TRANS (SYM(INST i th)) (INST i eq2));; let fixvariables s th = let fvs = subtract (frees(concl th)) (freesl(hyp th)) in let gvs = map2 (fun v n -> mk_var(s^string_of_int n,type_of v)) fvs (1--length fvs) in INST (zip gvs fvs) th;; let renamepair (th1,th2) = fixvariables "x" th1,fixvariables "y" th2;; let critical_pairs w tha thb = let th1,th2 = renamepair (tha,thb) in crit1 w th1 th2 @ crit1 w th2 th1;; let normalize_and_orient w eqs th = let th' = GEN_REWRITE_RULE TOP_DEPTH_CONV eqs th in let s',t' = dest_eq(concl th') in if lpo_ge w s' t' then th' else if lpo_ge w t' s' then SYM th' else failwith "Can't orient equation";; let status(eqs,crs) eqs0 = if eqs = eqs0 && (length crs) mod 1000 <> 0 then () else (print_string(string_of_int(length eqs)^" equations and "^ string_of_int(length crs)^" pending critical pairs"); print_newline());; let left_reducible eqs eq = can (CHANGED_CONV(GEN_REWRITE_CONV (LAND_CONV o ONCE_DEPTH_CONV) eqs)) (concl eq);; let rec complete w (eqs,crits) = match crits with (eq::ocrits) -> let trip = try let eq' = normalize_and_orient w eqs eq in let s',t' = dest_eq(concl eq') in if s' = t' then (eqs,ocrits) else let crits',eqs' = partition(left_reducible [eq']) eqs in let eqs'' = eq'::eqs' in eqs'', ocrits @ crits' @ itlist ((@) o critical_pairs w eq') eqs'' [] with Failure _ -> if exists (can (normalize_and_orient w eqs)) ocrits then (eqs,ocrits@[eq]) else failwith "complete: no orientable equations" in status trip eqs; complete w trip | [] -> eqs;; let complete_equations wts eqs = let eqs' = map (normalize_and_orient wts []) eqs in complete wts ([],eqs');; complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] [SPEC_ALL(ASSUME `!a b. i(a) * a * b = b`)];; complete_equations [`c:A`; `f:A->A`] (map SPEC_ALL (CONJUNCTS (ASSUME `((f(f(f(f(f c))))) = c:A) /\ (f(f(f c)) = c)`)));; let eqs = map SPEC_ALL (CONJUNCTS (ASSUME `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ (!x y z. (x * y) * z = x * y * z)`)) in map concl (complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] eqs);; let COMPLETE_TAC w th = let eqs = map SPEC_ALL (CONJUNCTS(SPEC_ALL th)) in let eqs' = complete_equations w eqs in MAP_EVERY (ASSUME_TAC o GEN_ALL) eqs';; g `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ (!x y z. (x * y) * z = x * y * z) ==> !x y. i(y) * i(i(i(x * i(y)))) * x = 1`;; e (DISCH_THEN(COMPLETE_TAC [`1`; `( * ):num->num->num`; `i:num->num`]));; e(ASM_REWRITE_TAC[]);; g `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z)) ==> (neg 0 * (x * y + z + neg(neg(w + z))) + neg(neg b + neg a) = a + b)`;; e (DISCH_THEN(COMPLETE_TAC [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`]));; e(ASM_REWRITE_TAC[]);; (**** Could have done this instead e (DISCH_THEN(COMPLETE_TAC [`0`; `(+):num->num->num`; `( * ):num->num->num`; `neg:num->num`]));; ****) hol-light/Tutorial/Custom_tactics.ml000066400000000000000000000122151303454263000200670ustar00rootroot00000000000000needs "Tutorial/Vectors.ml";; let points = [((0, -1), (0, -1), (2, 0)); ((0, -1), (0, 0), (2, 0)); ((0, -1), (0, 1), (2, 0)); ((0, -1), (2, 0), (0, -1)); ((0, -1), (2, 0), (0, 0)); ((0, -1), (2, 0), (0, 1)); ((0, 0), (0, -1), (2, 0)); ((0, 0), (0, 0), (2, 0)); ((0, 0), (0, 1), (2, 0)); ((0, 0), (2, 0), (-2, 0)); ((0, 0), (2, 0), (0, -1)); ((0, 0), (2, 0), (0, 0)); ((0, 0), (2, 0), (0, 1)); ((0, 0), (2, 0), (2, 0)); ((0, 1), (0, -1), (2, 0)); ((0, 1), (0, 0), (2, 0)); ((0, 1), (0, 1), (2, 0)); ((0, 1), (2, 0), (0, -1)); ((0, 1), (2, 0), (0, 0)); ((0, 1), (2, 0), (0, 1)); ((2, 0), (-2, 0), (0, 0)); ((2, 0), (0, -1), (0, -1)); ((2, 0), (0, -1), (0, 0)); ((2, 0), (0, -1), (0, 1)); ((2, 0), (0, 0), (-2, 0)); ((2, 0), (0, 0), (0, -1)); ((2, 0), (0, 0), (0, 0)); ((2, 0), (0, 0), (0, 1)); ((2, 0), (0, 0), (2, 0)); ((2, 0), (0, 1), (0, -1)); ((2, 0), (0, 1), (0, 0)); ((2, 0), (0, 1), (0, 1)); ((2, 0), (2, 0), (0, 0))];; let ortho = let mult (x1,y1) (x2,y2) = (x1 * x2 + 2 * y1 * y2,x1 * y2 + y1 * x2) and add (x1,y1) (x2,y2) = (x1 + x2,y1 + y2) in let dot (x1,y1,z1) (x2,y2,z2) = end_itlist add [mult x1 x2; mult y1 y2; mult z1 z2] in fun (v1,v2) -> dot v1 v2 = (0,0);; let opairs = filter ortho (allpairs (fun a b -> a,b) points points);; let otrips = filter (fun (a,b,c) -> ortho(a,b) && ortho(a,c)) (allpairs (fun a (b,c) -> a,b,c) points opairs);; let hol_of_value = let tm0 = `&0` and tm1 = `&2` and tm2 = `-- &2` and tm3 = `sqrt(&2)` and tm4 = `--sqrt(&2)` in function 0,0 -> tm0 | 2,0 -> tm1 | -2,0 -> tm2 | 0,1 -> tm3 | 0,-1 -> tm4;; let hol_of_point = let ptm = `vector:(real)list->real^3` in fun (x,y,z) -> mk_comb(ptm,mk_flist(map hol_of_value [x;y;z]));; let SQRT_2_POW = prove (`sqrt(&2) pow 2 = &2`, SIMP_TAC[SQRT_POW_2; REAL_POS]);; let PROVE_NONTRIVIAL = let ptm = `~(x :real^3 = vec 0)` and xtm = `x:real^3` in fun x -> prove(vsubst [hol_of_point x,xtm] ptm, GEN_REWRITE_TAC RAND_CONV [VECTOR_ZERO] THEN MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; let PROVE_ORTHOGONAL = let ptm = `orthogonal:real^3->real^3->bool` in fun (x,y) -> prove(list_mk_comb(ptm,[hol_of_point x;hol_of_point y]), ONCE_REWRITE_TAC[ORTHOGONAL_VECTOR] THEN MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; let ppoint = let p = `P:real^3->bool` in fun v -> mk_comb(p,hol_of_point v);; let DEDUCE_POINT_TAC pts = FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC (map hol_of_point pts) THEN ASM_REWRITE_TAC[];; let rec KOCHEN_SPECKER_TAC set_0 set_1 = if intersect set_0 set_1 <> [] then let p = ppoint(hd(intersect set_0 set_1)) in let th1 = ASSUME(mk_neg p) and th2 = ASSUME p in ACCEPT_TAC(EQ_MP (EQF_INTRO th1) th2) else let prf_1 = filter (fun (a,b) -> mem a set_0) opairs and prf_0 = filter (fun (a,b,c) -> mem a set_1 && mem b set_1) otrips in let new_1 = map snd prf_1 and new_0 = map (fun (a,b,c) -> c) prf_0 in let set_0' = union new_0 set_0 and set_1' = union new_1 set_1 in let del_0 = subtract set_0' set_0 and del_1 = subtract set_1' set_1 in if del_0 <> [] || del_1 <> [] then let prv_0 x = let a,b,_ = find (fun (a,b,c) -> c = x) prf_0 in DEDUCE_POINT_TAC [a;b] and prv_1 x = let a,_ = find (fun (a,c) -> c = x) prf_1 in DEDUCE_POINT_TAC [a] in let newuns = list_mk_conj (map ppoint del_1 @ map (mk_neg o ppoint) del_0) and tacs = map prv_1 del_1 @ map prv_0 del_0 in SUBGOAL_THEN newuns STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THENL tacs; ALL_TAC] THEN KOCHEN_SPECKER_TAC set_0' set_1' else let v = find (fun i -> not(mem i set_0) && not(mem i set_1)) points in ASM_CASES_TAC (ppoint v) THENL [KOCHEN_SPECKER_TAC set_0 (v::set_1); KOCHEN_SPECKER_TAC (v::set_0) set_1];; let KOCHEN_SPECKER_LEMMA = prove (`!P. (!x y:real^3. ~(x = vec 0) /\ ~(y = vec 0) /\ orthogonal x y /\ ~(P x) ==> P y) /\ (!x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ orthogonal x y /\ orthogonal x z /\ orthogonal y z /\ P x /\ P y ==> ~(P z)) ==> F`, REPEAT STRIP_TAC THEN MAP_EVERY (ASSUME_TAC o PROVE_NONTRIVIAL) points THEN MAP_EVERY (ASSUME_TAC o PROVE_ORTHOGONAL) opairs THEN KOCHEN_SPECKER_TAC [] []);; let NONTRIVIAL_CROSS = prove (`!x y. orthogonal x y /\ ~(x = vec 0) /\ ~(y = vec 0) ==> ~(x cross y = vec 0)`, REWRITE_TAC[GSYM DOT_EQ_0] THEN VEC3_TAC);; let KOCHEN_SPECKER_PARADOX = prove (`~(?spin:real^3->num. !x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ orthogonal x y /\ orthogonal x z /\ orthogonal y z ==> (spin x = 0) /\ (spin y = 1) /\ (spin z = 1) \/ (spin x = 1) /\ (spin y = 0) /\ (spin z = 1) \/ (spin x = 1) /\ (spin y = 1) /\ (spin z = 0))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x:real^3. spin(x) = 1` KOCHEN_SPECKER_LEMMA) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`; NONTRIVIAL_CROSS; ORTHOGONAL_CROSS]);; hol-light/Tutorial/Defining_new_types.ml000066400000000000000000000107511303454263000207260ustar00rootroot00000000000000needs "Tutorial/Vectors.ml";; let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") (MESON[LEMMA_0] `?x:real^3. ~(x = vec 0)`);; parse_as_infix("||",(11,"right"));; parse_as_infix("_|_",(11,"right"));; let perpdir = new_definition `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; let pardir = new_definition `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; let DIRECTION_CLAUSES = prove (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, MESON_TAC[direction_tybij]);; let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) (`(!x. x || x) /\ (!x y. x || y <=> y || x) /\ (!x y z. x || y /\ y || z ==> x || z)`, REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let DIRECTION_AXIOM_1 = prove (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_2 = prove (`!l l'. ?p. p _|_ l /\ p _|_ l'`, REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; let DIRECTION_AXIOM_3 = prove (`?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN MAP_EVERY (fun t -> EXISTS_TAC t THEN REWRITE_TAC[LEMMA_0]) [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN VEC3_TAC);; let CROSS_0 = VEC3_RULE `x cross vec 0 = vec 0 /\ vec 0 cross x = vec 0`;; let DIRECTION_AXIOM_4_WEAK = prove (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 2) cross (l cross basis 3) = vec 0)` MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; let ORTHOGONAL_COMBINE = prove (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_4 = prove (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ p _|_ l /\ p' _|_ l /\ p'' _|_ l`, MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; let PERPDIR_WELLDEF = prove (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let perpl,perpl_th = lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) "perpl" PERPDIR_WELLDEF;; let line_lift_thm = lift_theorem line_tybij (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; let point_tybij = new_type_definition "point" ("mk_point","dest_point") (prove(`?x:line. T`,REWRITE_TAC[]));; parse_as_infix("on",(11,"right"));; let on = new_definition `p on l <=> perpl (dest_point p) l`;; let POINT_CLAUSES = prove (`((p = p') <=> (dest_point p = dest_point p')) /\ ((!p. P (dest_point p)) <=> (!l. P l)) /\ ((?p. P (dest_point p)) <=> (?l. P l))`, MESON_TAC[point_tybij]);; let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; let AXIOM_1 = prove (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ !l'. p on l' /\ p' on l' ==> (l' = l)`, POINT_TAC LINE_AXIOM_1);; let AXIOM_2 = prove (`!l l'. ?p. p on l /\ p on l'`, POINT_TAC LINE_AXIOM_2);; let AXIOM_3 = prove (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p on l /\ p' on l /\ p'' on l)`, POINT_TAC LINE_AXIOM_3);; let AXIOM_4 = prove (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p on l /\ p' on l /\ p'' on l`, POINT_TAC LINE_AXIOM_4);; hol-light/Tutorial/Embedding_of_logics_deep.ml000066400000000000000000000105461303454263000220070ustar00rootroot00000000000000let string_INDUCT,string_RECURSION = define_type "string = String num";; parse_as_infix("&&",(16,"right"));; parse_as_infix("||",(15,"right"));; parse_as_infix("-->",(14,"right"));; parse_as_infix("<->",(13,"right"));; parse_as_prefix "Not";; parse_as_prefix "Box";; parse_as_prefix "Diamond";; let form_INDUCT,form_RECURSION = define_type "form = False | True | Atom string | Not form | && form form | || form form | --> form form | <-> form form | Box form | Diamond form";; let holds = define `(holds (W,R) V False w <=> F) /\ (holds (W,R) V True w <=> T) /\ (holds (W,R) V (Atom a) w <=> V a w) /\ (holds (W,R) V (Not p) w <=> ~(holds (W,R) V p w)) /\ (holds (W,R) V (p && q) w <=> holds (W,R) V p w /\ holds (W,R) V q w) /\ (holds (W,R) V (p || q) w <=> holds (W,R) V p w \/ holds (W,R) V q w) /\ (holds (W,R) V (p --> q) w <=> holds (W,R) V p w ==> holds (W,R) V q w) /\ (holds (W,R) V (p <-> q) w <=> holds (W,R) V p w <=> holds (W,R) V q w) /\ (holds (W,R) V (Box p) w <=> !w'. w' IN W /\ R w w' ==> holds (W,R) V p w') /\ (holds (W,R) V (Diamond p) w <=> ?w'. w' IN W /\ R w w' /\ holds (W,R) V p w')`;; let holds_in = new_definition `holds_in (W,R) p = !V w. w IN W ==> holds (W,R) V p w`;; parse_as_infix("|=",(11,"right"));; let valid = new_definition `L |= p <=> !f. L f ==> holds_in f p`;; let S4 = new_definition `S4(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ (!x. x IN W ==> R x x) /\ (!x y z. R x y /\ R y z ==> R x z)`;; let LTL = new_definition `LTL(W,R) <=> (W = UNIV) /\ !x y:num. R x y <=> x <= y`;; let GL = new_definition `GL(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ WF(\x y. R y x) /\ (!x y z:num. R x y /\ R y z ==> R x z)`;; let MODAL_TAC = REWRITE_TAC[valid; FORALL_PAIR_THM; holds_in; holds] THEN MESON_TAC[];; let MODAL_RULE tm = prove(tm,MODAL_TAC);; let TAUT_1 = MODAL_RULE `L |= Box True`;; let TAUT_2 = MODAL_RULE `L |= Box(A --> B) --> Box A --> Box B`;; let TAUT_3 = MODAL_RULE `L |= Diamond(A --> B) --> Box A --> Diamond B`;; let TAUT_4 = MODAL_RULE `L |= Box(A --> B) --> Diamond A --> Diamond B`;; let TAUT_5 = MODAL_RULE `L |= Box(A && B) --> Box A && Box B`;; let TAUT_6 = MODAL_RULE `L |= Diamond(A || B) --> Diamond A || Diamond B`;; let HOLDS_FORALL_LEMMA = prove (`!W R P. (!A V. P(holds (W,R) V A)) <=> (!p:W->bool. P p)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC; SIMP_TAC[]] THEN POP_ASSUM(MP_TAC o SPECL [`Atom a`; `\a:string. (p:W->bool)`]) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[holds] THEN REWRITE_TAC[ETA_AX]);; let MODAL_SCHEMA_TAC = REWRITE_TAC[holds_in; holds] THEN MP_TAC HOLDS_FORALL_LEMMA THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]);; let MODAL_REFL = prove (`!W R. (!w:W. w IN W ==> R w w) <=> !A. holds_in (W,R) (Box A --> A)`, MODAL_SCHEMA_TAC THEN MESON_TAC[]);; let MODAL_TRANS = prove (`!W R. (!w w' w'':W. w IN W /\ w' IN W /\ w'' IN W /\ R w w' /\ R w' w'' ==> R w w'') <=> (!A. holds_in (W,R) (Box A --> Box(Box A)))`, MODAL_SCHEMA_TAC THEN MESON_TAC[]);; let MODAL_SERIAL = prove (`!W R. (!w:W. w IN W ==> ?w'. w' IN W /\ R w w') <=> (!A. holds_in (W,R) (Box A --> Diamond A))`, MODAL_SCHEMA_TAC THEN MESON_TAC[]);; let MODAL_SYM = prove (`!W R. (!w w':W. w IN W /\ w' IN W /\ R w w' ==> R w' w) <=> (!A. holds_in (W,R) (A --> Box(Diamond A)))`, MODAL_SCHEMA_TAC THEN EQ_TAC THENL [MESON_TAC[]; REPEAT STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\v:W. v = w`; `w:W`]) THEN ASM_MESON_TAC[]);; let MODAL_WFTRANS = prove (`!W R. (!x y z:W. x IN W /\ y IN W /\ z IN W /\ R x y /\ R y z ==> R x z) /\ WF(\x y. x IN W /\ y IN W /\ R y x) <=> (!A. holds_in (W,R) (Box(Box A --> A) --> Box A))`, MODAL_SCHEMA_TAC THEN REWRITE_TAC[WF_IND] THEN EQ_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; X_GEN_TAC `w:W` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\v:W. v IN W /\ R w v /\ !w''. w'' IN W /\ R v w'' ==> R w w''`; `w:W`]); X_GEN_TAC `P:W->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:W. !w:W. x IN W /\ R w x ==> P x`) THEN MATCH_MP_TAC MONO_FORALL] THEN ASM_MESON_TAC[]);; hol-light/Tutorial/Embedding_of_logics_shallow.ml000066400000000000000000000015341303454263000225400ustar00rootroot00000000000000parse_as_prefix "Not";; parse_as_infix("&&",(16,"right"));; parse_as_infix("||",(15,"right"));; parse_as_infix("-->",(14,"right"));; parse_as_infix("<->",(13,"right"));; let false_def = define `False = \t:num. F`;; let true_def = define `True = \t:num. T`;; let not_def = define `Not p = \t:num. ~(p t)`;; let and_def = define `p && q = \t:num. p t /\ q t`;; let or_def = define `p || q = \t:num. p t \/ q t`;; let imp_def = define `p --> q = \t:num. p t ==> q t`;; let iff_def = define `p <-> q = \t:num. p t <=> q t`;; let forever = define `forever p = \t:num. !t'. t <= t' ==> p t'`;; let sometime = define `sometime p = \t:num. ?t'. t <= t' /\ p t'`;; let next = define `next p = \t:num. p(t + 1)`;; parse_as_infix("until",(17,"right"));; let until = define `p until q = \t:num. ?t'. t <= t' /\ (!t''. t <= t'' /\ t'' < t' ==> p t'') /\ q t'`;; hol-light/Tutorial/HOL_as_a_functional_programming_language.ml000066400000000000000000000150171303454263000252020ustar00rootroot00000000000000type ite = False | True | Atomic of int | Ite of ite*ite*ite;; let rec norm e = match e with Ite(False,y,z) -> norm z | Ite(True,y,z) -> norm y | Ite(Atomic i,y,z) -> Ite(Atomic i,norm y,norm z) | Ite(Ite(u,v,w),y,z) -> norm(Ite(u,Ite(v,y,z),Ite(w,y,z))) | _ -> e;; let ite_INDUCT,ite_RECURSION = define_type "ite = False | True | Atomic num | Ite ite ite ite";; let eth = prove_general_recursive_function_exists `?norm. (norm False = False) /\ (norm True = True) /\ (!i. norm (Atomic i) = Atomic i) /\ (!y z. norm (Ite False y z) = norm z) /\ (!y z. norm (Ite True y z) = norm y) /\ (!i y z. norm (Ite (Atomic i) y z) = Ite (Atomic i) (norm y) (norm z)) /\ (!u v w y z. norm (Ite (Ite u v w) y z) = norm (Ite u (Ite v y z) (Ite w y z)))`;; let sizeof = define `(sizeof False = 1) /\ (sizeof True = 1) /\ (sizeof(Atomic i) = 1) /\ (sizeof(Ite x y z) = sizeof x * (1 + sizeof y + sizeof z))`;; let eth' = let th = prove (hd(hyp eth), EXISTS_TAC `MEASURE sizeof` THEN REWRITE_TAC[WF_MEASURE; MEASURE_LE; MEASURE; sizeof] THEN ARITH_TAC) in PROVE_HYP th eth;; let norm = new_specification ["norm"] eth';; let SIZEOF_INDUCT = REWRITE_RULE[WF_IND; MEASURE] (ISPEC`sizeof` WF_MEASURE);; let SIZEOF_NZ = prove (`!e. ~(sizeof e = 0)`, MATCH_MP_TAC ite_INDUCT THEN SIMP_TAC[sizeof; ADD_EQ_0; MULT_EQ_0; ARITH]);; let ITE_INDUCT = prove (`!P. P False /\ P True /\ (!i. P(Atomic i)) /\ (!y z. P z ==> P(Ite False y z)) /\ (!y z. P y ==> P(Ite True y z)) /\ (!i y z. P y /\ P z ==> P (Ite (Atomic i) y z)) /\ (!u v w x y z. P(Ite u (Ite v y z) (Ite w y z)) ==> P(Ite (Ite u v w) y z)) ==> !e. P e`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SIZEOF_INDUCT THEN MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ite_INDUCT THEN POP_ASSUM_LIST (fun ths -> REPEAT STRIP_TAC THEN FIRST(mapfilter MATCH_MP_TAC ths)) THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[sizeof] THEN TRY ARITH_TAC THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[MULT_AC; ADD_AC; LT_ADD_LCANCEL] THEN REWRITE_TAC[ADD_ASSOC; LT_ADD_RCANCEL] THEN MATCH_MP_TAC(ARITH_RULE `~(b = 0) /\ ~(c = 0) ==> a < (b + a) + c`) THEN REWRITE_TAC[MULT_EQ_0; SIZEOF_NZ]);; let normalized = define `(normalized False <=> T) /\ (normalized True <=> T) /\ (normalized(Atomic a) <=> T) /\ (normalized(Ite False x y) <=> F) /\ (normalized(Ite True x y) <=> F) /\ (normalized(Ite (Atomic a) x y) <=> normalized x /\ normalized y) /\ (normalized(Ite (Ite u v w) x y) <=> F)`;; let NORMALIZED_NORM = prove (`!e. normalized(norm e)`, MATCH_MP_TAC ITE_INDUCT THEN REWRITE_TAC[norm; normalized]);; let NORMALIZED_INDUCT = prove (`P False /\ P True /\ (!i. P (Atomic i)) /\ (!i x y. P x /\ P y ==> P (Ite (Atomic i) x y)) ==> !e. normalized e ==> P e`, STRIP_TAC THEN MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[normalized] THEN MATCH_MP_TAC ite_INDUCT THEN ASM_MESON_TAC[normalized]);; let holds = define `(holds v False <=> F) /\ (holds v True <=> T) /\ (holds v (Atomic i) <=> v(i)) /\ (holds v (Ite b x y) <=> if holds v b then holds v x else holds v y)`;; let HOLDS_NORM = prove (`!e v. holds v (norm e) <=> holds v e`, MATCH_MP_TAC ITE_INDUCT THEN SIMP_TAC[holds; norm] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let taut = define `(taut (t,f) False <=> F) /\ (taut (t,f) True <=> T) /\ (taut (t,f) (Atomic i) <=> MEM i t) /\ (taut (t,f) (Ite (Atomic i) x y) <=> if MEM i t then taut (t,f) x else if MEM i f then taut (t,f) y else taut (CONS i t,f) x /\ taut (t,CONS i f) y)`;; let tautology = define `tautology e = taut([],[]) (norm e)`;; let NORMALIZED_TAUT = prove (`!e. normalized e ==> !f t. (!a. ~(MEM a t /\ MEM a f)) ==> (taut (t,f) e <=> !v. (!a. MEM a t ==> v(a)) /\ (!a. MEM a f ==> ~v(a)) ==> holds v e)`, MATCH_MP_TAC NORMALIZED_INDUCT THEN REWRITE_TAC[holds; taut] THEN REWRITE_TAC[NOT_FORALL_THM] THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `\a:num. MEM a t` THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN MATCH_MP_TAC] THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[])] THEN ASM_SIMP_TAC[MEM; RIGHT_OR_DISTRIB; LEFT_OR_DISTRIB; MESON[] `(!a. ~(MEM a t /\ a = i)) <=> ~(MEM i t)`; MESON[] `(!a. ~(a = i /\ MEM a f)) <=> ~(MEM i f)`] THEN ASM_REWRITE_TAC[AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[]);; let TAUTOLOGY = prove (`!e. tautology e <=> !v. holds v e`, MESON_TAC[tautology; HOLDS_NORM; NORMALIZED_TAUT; MEM; NORMALIZED_NORM]);; let HOLDS_BACK = prove (`!v. (F <=> holds v False) /\ (T <=> holds v True) /\ (!i. v i <=> holds v (Atomic i)) /\ (!p. ~holds v p <=> holds v (Ite p False True)) /\ (!p q. (holds v p /\ holds v q) <=> holds v (Ite p q False)) /\ (!p q. (holds v p \/ holds v q) <=> holds v (Ite p True q)) /\ (!p q. (holds v p <=> holds v q) <=> holds v (Ite p q (Ite q False True))) /\ (!p q. holds v p ==> holds v q <=> holds v (Ite p q True))`, REWRITE_TAC[holds] THEN CONV_TAC TAUT);; let COND_CONV = GEN_REWRITE_CONV I [COND_CLAUSES];; let AND_CONV = GEN_REWRITE_CONV I [TAUT `(F /\ a <=> F) /\ (T /\ a <=> a)`];; let OR_CONV = GEN_REWRITE_CONV I [TAUT `(F \/ a <=> a) /\ (T \/ a <=> T)`];; let rec COMPUTE_DEPTH_CONV conv tm = if is_cond tm then (RATOR_CONV(LAND_CONV(COMPUTE_DEPTH_CONV conv)) THENC COND_CONV THENC COMPUTE_DEPTH_CONV conv) tm else if is_conj tm then (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC AND_CONV THENC COMPUTE_DEPTH_CONV conv) tm else if is_disj tm then (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC OR_CONV THENC COMPUTE_DEPTH_CONV conv) tm else (SUB_CONV (COMPUTE_DEPTH_CONV conv) THENC TRY_CONV(conv THENC COMPUTE_DEPTH_CONV conv)) tm;; g `!v. v 1 \/ v 2 \/ v 3 \/ v 4 \/ v 5 \/ v 6 \/ ~v 1 \/ ~v 2 \/ ~v 3 \/ ~v 4 \/ ~v 5 \/ ~v 6`;; e(MP_TAC HOLDS_BACK THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN SPEC_TAC(`v:num->bool`,`v:num->bool`) THEN REWRITE_TAC[GSYM TAUTOLOGY; tautology]);; time e (GEN_REWRITE_TAC COMPUTE_DEPTH_CONV [norm; taut; MEM; ARITH_EQ]);; ignore(b()); time e (REWRITE_TAC[norm; taut; MEM; ARITH_EQ]);; hol-light/Tutorial/HOL_basics.ml000066400000000000000000000003241303454263000170470ustar00rootroot00000000000000ARITH_RULE `(a * x + b * y + a * y) EXP 3 + (b * x) EXP 3 + (a * x + b * y + b * x) EXP 3 + (a * y) EXP 3 = (a * x + a * y + b * x) EXP 3 + (b * y) EXP 3 + (a * y + b * y + b * x) EXP 3 + (a * x) EXP 3`;; hol-light/Tutorial/HOLs_number_systems.ml000066400000000000000000000067521303454263000210600ustar00rootroot00000000000000REAL_ARITH `!x y:real. (abs(x) - abs(y)) <= abs(x - y)`;; INT_ARITH `!a b a' b' D:int. (a pow 2 - D * b pow 2) * (a' pow 2 - D * b' pow 2) = (a * a' + D * b * b') pow 2 - D * (a * b' + a' * b) pow 2`;; REAL_ARITH `!x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11:real. x3 = abs(x2) - x1 /\ x4 = abs(x3) - x2 /\ x5 = abs(x4) - x3 /\ x6 = abs(x5) - x4 /\ x7 = abs(x6) - x5 /\ x8 = abs(x7) - x6 /\ x9 = abs(x8) - x7 /\ x10 = abs(x9) - x8 /\ x11 = abs(x10) - x9 ==> x1 = x10 /\ x2 = x11`;; REAL_ARITH `!x y:real. x < y ==> x < (x + y) / &2 /\ (x + y) / &2 < y`;; REAL_ARITH `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2) = ((&1 / &6) * ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) + (&1 / &6) * ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4))`;; ARITH_RULE `x < 2 ==> 2 * x + 1 < 4`;; (**** Fails ARITH_RULE `~(2 * m + 1 = 2 * n)`;; ****) ARITH_RULE `x < 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; (**** Fails ARITH_RULE `x <= 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; ****) (**** Fails ARITH_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; ****) (**** Fails REAL_ARITH `!x y:real. x = y ==> x * y = y pow 2`;; ****) prioritize_real();; REAL_RING `s = (a + b + c) / &2 ==> s * (s - b) * (s - c) + s * (s - c) * (s - a) + s * (s - a) * (s - b) - (s - a) * (s - b) * (s - c) = a * b * c`;; REAL_RING `a pow 2 = &2 /\ x pow 2 + a * x + &1 = &0 ==> x pow 4 + &1 = &0`;; REAL_RING `(a * x pow 2 + b * x + c = &0) /\ (a * y pow 2 + b * y + c = &0) /\ ~(x = y) ==> (a * x * y = c) /\ (a * (x + y) + b = &0)`;; REAL_RING `p = (&3 * a1 - a2 pow 2) / &3 /\ q = (&9 * a1 * a2 - &27 * a0 - &2 * a2 pow 3) / &27 /\ x = z + a2 / &3 /\ x * w = w pow 2 - p / &3 ==> (z pow 3 + a2 * z pow 2 + a1 * z + a0 = &0 <=> if p = &0 then x pow 3 = q else (w pow 3) pow 2 - q * (w pow 3) - p pow 3 / &27 = &0)`;; REAL_FIELD `&0 < x ==> &1 / x - &1 / (&1 + x) = &1 / (x * (&1 + x))`;; REAL_FIELD `s pow 2 = b pow 2 - &4 * a * c ==> (a * x pow 2 + b * x + c = &0 <=> if a = &0 then if b = &0 then if c = &0 then T else F else x = --c / b else x = (--b + s) / (&2 * a) \/ x = (--b + --s) / (&2 * a))`;; (**** This needs an external SDP solver to assist with proof needs "Examples/sos.ml";; SOS_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; REAL_SOS `!a1 a2 a3 a4:real. &0 <= a1 /\ &0 <= a2 /\ &0 <= a3 /\ &0 <= a4 ==> a1 pow 2 + ((a1 + a2) / &2) pow 2 + ((a1 + a2 + a3) / &3) pow 2 + ((a1 + a2 + a3 + a4) / &4) pow 2 <= &4 * (a1 pow 2 + a2 pow 2 + a3 pow 2 + a4 pow 2)`;; REAL_SOS `!a b c:real. a >= &0 /\ b >= &0 /\ c >= &0 ==> &3 / &2 * (b + c) * (a + c) * (a + b) <= a * (a + c) * (a + b) + b * (b + c) * (a + b) + c * (b + c) * (a + c)`;; SOS_CONV `&2 * x pow 4 + &2 * x pow 3 * y - x pow 2 * y pow 2 + &5 * y pow 4`;; PURE_SOS `x pow 4 + &2 * x pow 2 * z + x pow 2 - &2 * x * y * z + &2 * y pow 2 * z pow 2 + &2 * y * z pow 2 + &2 * z pow 2 - &2 * x + &2 * y * z + &1 >= &0`;; ****) needs "Examples/cooper.ml";; COOPER_RULE `ODD n ==> 2 * n DIV 2 < n`;; COOPER_RULE `!n. n >= 8 ==> ?a b. n = 3 * a + 5 * b`;; needs "Rqe/make.ml";; REAL_QELIM_CONV `!x. &0 <= x ==> ?y. y pow 2 = x`;; hol-light/Tutorial/Inductive_datatypes.ml000066400000000000000000000052501303454263000211140ustar00rootroot00000000000000let line_INDUCT,line_RECURSION = define_type "line = Line_1 | Line_2 | Line_3 | Line_4 | Line_5 | Line_6 | Line_7";; let point_INDUCT,point_RECURSION = define_type "point = Point_1 | Point_2 | Point_3 | Point_4 | Point_5 | Point_6 | Point_7";; let fano_incidence = [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; let fano_point i = mk_const("Point_"^string_of_int i,[]);; let fano_line i = mk_const("Line_"^string_of_int i,[]);; let p = `p:point` and l = `l:line` ;; let fano_clause (i,j) = mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; parse_as_infix("ON",(11,"right"));; let ON = new_definition (mk_eq(`((ON):point->line->bool) p l`, list_mk_disj(map fano_clause fano_incidence)));; let ON_CLAUSES = prove (list_mk_conj(allpairs (fun i j -> mk_eq(mk_comb(mk_comb(`(ON)`,fano_point i),fano_line j), if mem (i,j) fano_incidence then `T` else `F`)) (1--7) (1--7)), REWRITE_TAC[ON; distinctness "line"; distinctness "point"]);; let FORALL_POINT = prove (`(!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ P Point_5 /\ P Point_6 /\ P Point_7`, EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[point_INDUCT]]);; let FORALL_LINE = prove (`(!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ P Line_5 /\ P Line_6 /\ P Line_7`, EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[line_INDUCT]]);; let EXISTS_POINT = prove (`(?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ P Point_5 \/ P Point_6 \/ P Point_7`, MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_POINT]);; let EXISTS_LINE = prove (`(?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ P Line_5 \/ P Line_6 \/ P Line_7`, MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_LINE]);; let FANO_TAC = GEN_REWRITE_TAC DEPTH_CONV [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN GEN_REWRITE_TAC DEPTH_CONV (basic_rewrites() @ [ON_CLAUSES; distinctness "point"; distinctness "line"]);; let FANO_RULE tm = prove(tm,FANO_TAC);; let AXIOM_1 = FANO_RULE `!p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ !l'. p ON l' /\ p' ON l' ==> l' = l`;; let AXIOM_2 = FANO_RULE `!l l'. ?p. p ON l /\ p ON l'`;; let AXIOM_3 = FANO_RULE `?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l)`;; let AXIOM_4 = FANO_RULE `!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON l /\ p' ON l /\ p'' ON l`;; hol-light/Tutorial/Inductive_definitions.ml000066400000000000000000000075341303454263000214400ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Bug puzzle. *) (* ------------------------------------------------------------------------- *) prioritize_real();; let move = new_definition `move ((ax,ay),(bx,by),(cx,cy)) ((ax',ay'),(bx',by'),(cx',cy')) <=> (?a. ax' = ax + a * (cx - bx) /\ ay' = ay + a * (cy - by) /\ bx' = bx /\ by' = by /\ cx' = cx /\ cy' = cy) \/ (?b. bx' = bx + b * (ax - cx) /\ by' = by + b * (ay - cy) /\ ax' = ax /\ ay' = ay /\ cx' = cx /\ cy' = cy) \/ (?c. ax' = ax /\ ay' = ay /\ bx' = bx /\ by' = by /\ cx' = cx + c * (bx - ax) /\ cy' = cy + c * (by - ay))`;; let reachable_RULES,reachable_INDUCT,reachable_CASES = new_inductive_definition `(!p. reachable p p) /\ (!p q r. move p q /\ reachable q r ==> reachable p r)`;; let oriented_area = new_definition `oriented_area ((ax,ay),(bx,by),(cx,cy)) = ((bx - ax) * (cy - ay) - (cx - ax) * (by - ay)) / &2`;; let MOVE_INVARIANT = prove (`!p p'. move p p' ==> oriented_area p = oriented_area p'`, REWRITE_TAC[FORALL_PAIR_THM; move; oriented_area] THEN CONV_TAC REAL_RING);; let REACHABLE_INVARIANT = prove (`!p p'. reachable p p' ==> oriented_area p = oriented_area p'`, MATCH_MP_TAC reachable_INDUCT THEN MESON_TAC[MOVE_INVARIANT]);; let IMPOSSIBILITY_B = prove (`~(reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(&2,&5),(-- &2,&3)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(-- &2,&3),(&2,&5)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(&1,&2),(-- &2,&3)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(-- &2,&3),(&1,&2)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&1,&2),(&2,&5)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&2,&5),(&1,&2)))`, STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REACHABLE_INVARIANT) THEN REWRITE_TAC[oriented_area] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Verification of a simple concurrent program. *) (* ------------------------------------------------------------------------- *) let init = new_definition `init (x,y,pc1,pc2,sem) <=> pc1 = 10 /\ pc2 = 10 /\ x = 0 /\ y = 0 /\ sem = 1`;; let trans = new_definition `trans (x,y,pc1,pc2,sem) (x',y',pc1',pc2',sem') <=> pc1 = 10 /\ sem > 0 /\ pc1' = 20 /\ sem' = sem - 1 /\ (x',y',pc2') = (x,y,pc2) \/ pc2 = 10 /\ sem > 0 /\ pc2' = 20 /\ sem' = sem - 1 /\ (x',y',pc1') = (x,y,pc1) \/ pc1 = 20 /\ pc1' = 30 /\ x' = x + 1 /\ (y',pc2',sem') = (y,pc2,sem) \/ pc2 = 20 /\ pc2' = 30 /\ y' = y + 1 /\ x' = x /\ pc1' = pc1 /\ sem' = sem \/ pc1 = 30 /\ pc1' = 10 /\ sem' = sem + 1 /\ (x',y',pc2') = (x,y,pc2) \/ pc2 = 30 /\ pc2' = 10 /\ sem' = sem + 1 /\ (x',y',pc1') = (x,y,pc1)`;; let mutex = new_definition `mutex (x,y,pc1,pc2,sem) <=> pc1 = 10 \/ pc2 = 10`;; let indinv = new_definition `indinv (x:num,y:num,pc1,pc2,sem) <=> sem + (if pc1 = 10 then 0 else 1) + (if pc2 = 10 then 0 else 1) = 1`;; needs "Library/rstc.ml";; let INDUCTIVE_INVARIANT = prove (`!init invariant transition P. (!s. init s ==> invariant s) /\ (!s s'. invariant s /\ transition s s' ==> invariant s') /\ (!s. invariant s ==> P s) ==> !s s':A. init s /\ RTC transition s s' ==> P s'`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`transition:A->A->bool`; `\s s':A. invariant s ==> invariant s'`] RTC_INDUCT) THEN MESON_TAC[]);; let MUTEX = prove (`!s s'. init s /\ RTC trans s s' ==> mutex s'`, MATCH_MP_TAC INDUCTIVE_INVARIANT THEN EXISTS_TAC `indinv` THEN REWRITE_TAC[init; trans; indinv; mutex; FORALL_PAIR_THM; PAIR_EQ] THEN ARITH_TAC);; hol-light/Tutorial/Linking_external_tools.ml000066400000000000000000000130221303454263000216150ustar00rootroot00000000000000needs "Library/transc.ml";; let maximas e = let filename = Filename.temp_file "maxima" ".out" in let s = "echo 'linel:10000; display2d:false;" ^ e ^ ";' | maxima | grep '^(%o3)' | sed -e 's/^(%o3) //' >" ^ filename in if Sys.command s <> 0 then failwith "maxima" else let fd = Pervasives.open_in filename in let data = input_line fd in close_in fd; Sys.remove filename; data;; prioritize_real();; let maxima_ops = ["+",`(+)`; "-",`(-)`; "*",`( * )`; "/",`(/)`; "^",`(pow)`];; let maxima_funs = ["sin",`sin`; "cos",`cos`];; let mk_uneg = curry mk_comb `(--)`;; let dest_uneg = let ntm = `(--)` in fun tm -> let op,t = dest_comb tm in if op = ntm then t else failwith "dest_uneg";; let mk_pow = let f = mk_binop `(pow)` in fun x y -> f x (rand y);; let mk_realvar = let real_ty = `:real` in fun x -> mk_var(x,real_ty);; let rec string_of_hol tm = if is_ratconst tm then "("^string_of_num(rat_of_term tm)^")" else if is_numeral tm then string_of_num(dest_numeral tm) else if is_var tm then fst(dest_var tm) else if can dest_uneg tm then "-(" ^ string_of_hol(rand tm) ^ ")" else let lop,r = dest_comb tm in try let op,l = dest_comb lop in "("^string_of_hol l^" "^ rev_assoc op maxima_ops^" "^string_of_hol r^")" with Failure _ -> rev_assoc lop maxima_funs ^ "(" ^ string_of_hol r ^ ")";; string_of_hol `(x + sin(-- &2 * x)) pow 2 - cos(x - &22 / &7)`;; let lexe s = map (function Resword s -> s | Ident s -> s) (lex(explode s));; let parse_bracketed prs inp = match prs inp with ast,")"::rst -> ast,rst | _ -> failwith "Closing bracket expected";; let rec parse_ginfix op opup sof prs inp = match prs inp with e1,hop::rst when hop = op -> parse_ginfix op opup (opup sof e1) prs rst | e1,rest -> sof e1,rest;; let parse_general_infix op = let opcon = if op = "^" then mk_pow else mk_binop (assoc op maxima_ops) in let constr = if op <> "^" && snd(get_infix_status op) = "right" then fun f e1 e2 -> f(opcon e1 e2) else fun f e1 e2 -> opcon(f e1) e2 in parse_ginfix op constr (fun x -> x);; let rec parse_atomic_expression inp = match inp with [] -> failwith "expression expected" | "(" :: rest -> parse_bracketed parse_expression rest | s :: rest when forall isnum (explode s) -> term_of_rat(num_of_string s),rest | s :: "(" :: rest when forall isalnum (explode s) -> let e,rst = parse_bracketed parse_expression rest in mk_comb(assoc s maxima_funs,e),rst | s :: rest when forall isalnum (explode s) -> mk_realvar s,rest and parse_exp inp = parse_general_infix "^" parse_atomic_expression inp and parse_neg inp = match inp with | "-" :: rest -> let e,rst = parse_neg rest in mk_uneg e,rst | _ -> parse_exp inp and parse_expression inp = itlist parse_general_infix (map fst maxima_ops) parse_neg inp;; let hol_of_string = fst o parse_expression o lexe;; hol_of_string "sin(x) - cos(-(- - 1 + x))";; let FACTOR_CONV tm = let s = "factor("^string_of_hol tm^")" in let tm' = hol_of_string(maximas s) in REAL_RING(mk_eq(tm,tm'));; FACTOR_CONV `&1234567890`;; FACTOR_CONV `x pow 6 - &1`;; FACTOR_CONV `r * (r * x * (&1 - x)) * (&1 - r * x * (&1 - x)) - x`;; let ANTIDERIV_CONV tm = let x,bod = dest_abs tm in let s = "integrate("^string_of_hol bod^","^fst(dest_var x)^")" in let tm' = mk_abs(x,hol_of_string(maximas s)) in let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) (SPEC x (DIFF_CONV tm')) in let th2 = REAL_RING(mk_eq(lhand(concl th1),bod)) in GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; ANTIDERIV_CONV `\x. (x + &5) pow 2 + &77 * x`;; ANTIDERIV_CONV `\x. sin(x) + x pow 11`;; (**** This one fails as expected so we need more simplification later ANTIDERIV_CONV `\x. sin(x) pow 3`;; ****) let SIN_N_CLAUSES = prove (`(sin(&(NUMERAL(BIT0 n)) * x) = &2 * sin(&(NUMERAL n) * x) * cos(&(NUMERAL n) * x)) /\ (sin(&(NUMERAL(BIT1 n)) * x) = sin(&(NUMERAL(BIT0 n)) * x) * cos(x) + sin(x) * cos(&(NUMERAL(BIT0 n)) * x)) /\ (cos(&(NUMERAL(BIT0 n)) * x) = cos(&(NUMERAL n) * x) pow 2 - sin(&(NUMERAL n) * x) pow 2) /\ (cos(&(NUMERAL(BIT1 n)) * x) = cos(&(NUMERAL(BIT0 n)) * x) * cos(x) - sin(x) * sin(&(NUMERAL(BIT0 n)) * x))`, REWRITE_TAC[REAL_MUL_2; REAL_POW_2] THEN REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SIN_ADD; COS_ADD; REAL_MUL_LID] THEN CONV_TAC REAL_RING);; let TRIG_IDENT_TAC x = REWRITE_TAC[SIN_N_CLAUSES; SIN_ADD; COS_ADD] THEN REWRITE_TAC[REAL_MUL_LZERO; SIN_0; COS_0; REAL_MUL_RZERO] THEN MP_TAC(SPEC x SIN_CIRCLE) THEN CONV_TAC REAL_RING;; let ANTIDERIV_CONV tm = let x,bod = dest_abs tm in let s = "expand(integrate("^string_of_hol bod^","^fst(dest_var x)^"))" in let tm' = mk_abs(x,hol_of_string(maximas s)) in let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) (SPEC x (DIFF_CONV tm')) in let th2 = prove(mk_eq(lhand(concl th1),bod),TRIG_IDENT_TAC x) in GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; time ANTIDERIV_CONV `\x. sin(x) pow 3`;; time ANTIDERIV_CONV `\x. sin(x) * sin(x) pow 5 * cos(x) pow 4 + cos(x)`;; let FCT1_WEAK = prove (`(!x. (f diffl f'(x)) x) ==> !x. &0 <= x ==> defint(&0,x) f' (f x - f(&0))`, MESON_TAC[FTC1]);; let INTEGRAL_CONV tm = let th1 = MATCH_MP FCT1_WEAK (ANTIDERIV_CONV tm) in (CONV_RULE REAL_RAT_REDUCE_CONV o REWRITE_RULE[SIN_0; COS_0; REAL_MUL_LZERO; REAL_MUL_RZERO] o CONV_RULE REAL_RAT_REDUCE_CONV o BETA_RULE) th1;; INTEGRAL_CONV `\x. sin(x) pow 13`;; hol-light/Tutorial/Number_theory.ml000066400000000000000000000110741303454263000177270ustar00rootroot00000000000000needs "Library/prime.ml";; needs "Library/pocklington.ml";; needs "Library/binomial.ml";; prioritize_num();; let FERMAT_PRIME_CONV n = let tm = subst [mk_small_numeral n,`x:num`] `prime(2 EXP (2 EXP x) + 1)` in (RAND_CONV NUM_REDUCE_CONV THENC PRIME_CONV) tm;; FERMAT_PRIME_CONV 0;; FERMAT_PRIME_CONV 1;; FERMAT_PRIME_CONV 2;; FERMAT_PRIME_CONV 3;; FERMAT_PRIME_CONV 4;; FERMAT_PRIME_CONV 5;; FERMAT_PRIME_CONV 6;; FERMAT_PRIME_CONV 7;; FERMAT_PRIME_CONV 8;; let CONG_TRIVIAL = prove (`!x y. n divides x /\ n divides y ==> (x == y) (mod n)`, MESON_TAC[CONG_0; CONG_SYM; CONG_TRANS]);; let LITTLE_CHECK_CONV tm = EQT_ELIM((RATOR_CONV(LAND_CONV NUM_EXP_CONV) THENC CONG_CONV) tm);; LITTLE_CHECK_CONV `(9 EXP 8 == 9) (mod 3)`;; LITTLE_CHECK_CONV `(9 EXP 3 == 9) (mod 3)`;; LITTLE_CHECK_CONV `(10 EXP 7 == 10) (mod 7)`;; LITTLE_CHECK_CONV `(2 EXP 7 == 2) (mod 7)`;; LITTLE_CHECK_CONV `(777 EXP 13 == 777) (mod 13)`;; let DIVIDES_FACT_PRIME = prove (`!p. prime p ==> !n. p divides (FACT n) <=> p <= n`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_0; PRIME_1]; ASM_MESON_TAC[PRIME_DIVPROD_EQ; DIVIDES_LE; NOT_SUC; DIVIDES_REFL; ARITH_RULE `~(p <= n) /\ p <= SUC n ==> p = SUC n`]]);; let DIVIDES_BINOM_PRIME = prove (`!n p. prime p /\ 0 < n /\ n < p ==> p divides binom(p,n)`, REPEAT STRIP_TAC THEN MP_TAC(AP_TERM `(divides) p` (SPECL [`p - n`; `n:num`] BINOM_FACT)) THEN ASM_SIMP_TAC[DIVIDES_FACT_PRIME; PRIME_DIVPROD_EQ; SUB_ADD; LT_IMP_LE] THEN ASM_REWRITE_TAC[GSYM NOT_LT; LT_REFL] THEN ASM_SIMP_TAC[ARITH_RULE `0 < n /\ n < p ==> p - n < p`]);; let DIVIDES_NSUM = prove (`!m n. (!i. m <= i /\ i <= n ==> p divides f(i)) ==> p divides nsum(m..n) f`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ASM_MESON_TAC[LE; LE_TRANS; DIVIDES_0; DIVIDES_ADD; LE_REFL]);; let FLT_LEMMA = prove (`!p a b. prime p ==> ((a + b) EXP p == a EXP p + b EXP p) (mod p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[BINOMIAL_THEOREM] THEN SUBGOAL_THEN `1 <= p /\ 0 < p` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0; ARITH; NSUM_CLAUSES_RIGHT] THEN REWRITE_TAC[SUB_0; SUB_REFL; EXP; binom; BINOM_REFL; MULT_CLAUSES] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a + b = (b + 0) + a`] THEN REPEAT(MATCH_MP_TAC CONG_ADD THEN REWRITE_TAC[CONG_REFL]) THEN REWRITE_TAC[CONG_0] THEN MATCH_MP_TAC DIVIDES_NSUM THEN ASM_MESON_TAC[DIVIDES_RMUL; DIVIDES_BINOM_PRIME; ARITH_RULE `0 < p /\ 1 <= i /\ i <= p - 1 ==> 0 < i /\ i < p`]);; let FERMAT_LITTLE = prove (`!p a. prime p ==> (a EXP p == a) (mod p)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THENL [ASM_MESON_TAC[EXP_EQ_0; CONG_REFL; PRIME_0]; ASM_MESON_TAC[ADD1; FLT_LEMMA; EXP_ONE; CONG_ADD; CONG_TRANS; CONG_REFL]]);; let FERMAT_LITTLE_COPRIME = prove (`!p a. prime p /\ coprime(a,p) ==> (a EXP (p - 1) == 1) (mod p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN ASM_SIMP_TAC[PRIME_IMP_NZ; ARITH_RULE `~(p = 0) ==> SUC(p - 1) = p`] THEN ASM_SIMP_TAC[FERMAT_LITTLE; MULT_CLAUSES]);; let FERMAT_LITTLE_VARIANT = prove (`!p a. prime p ==> (a EXP (1 + m * (p - 1)) == a) (mod p)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME_STRONG) THENL [ASM_MESON_TAC[CONG_TRIVIAL; ADD_AC; ADD1; DIVIDES_REXP_SUC]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN REWRITE_TAC[EXP_ADD; EXP_1] THEN MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[GSYM EXP_EXP; CONG_REFL] THEN ASM_MESON_TAC[COPRIME_SYM; COPRIME_EXP; PHI_PRIME; FERMAT_LITTLE_COPRIME]);; let RSA = prove (`prime p /\ prime q /\ ~(p = q) /\ (d * e == 1) (mod ((p - 1) * (q - 1))) /\ plaintext < p * q /\ (ciphertext = (plaintext EXP e) MOD (p * q)) ==> (plaintext = (ciphertext EXP d) MOD (p * q))`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MOD_EXP_MOD; MULT_EQ_0; PRIME_IMP_NZ; EXP_EXP] THEN SUBGOAL_THEN `(plaintext == plaintext EXP (e * d)) (mod (p * q))` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[CONG; MULT_EQ_0; PRIME_IMP_NZ; MOD_LT]] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [CONG_TO_1]) THENL [ASM_MESON_TAC[MULT_EQ_1; ARITH_RULE `p - 1 = 1 <=> p = 2`]; ALL_TAC] THEN MATCH_MP_TAC CONG_CHINESE THEN ASM_SIMP_TAC[DISTINCT_PRIME_COPRIME] THEN ASM_MESON_TAC[FERMAT_LITTLE_VARIANT; MULT_AC; CONG_SYM]);; hol-light/Tutorial/Propositional_logic.ml000066400000000000000000000013611303454263000211220ustar00rootroot00000000000000TAUT `(~input_a ==> (internal <=> T)) /\ (~input_b ==> (output <=> internal)) /\ (input_a ==> (output <=> F)) /\ (input_b ==> (output <=> F)) ==> (output <=> ~(input_a \/ input_b))`;; TAUT `(i1 /\ i2 <=> a) /\ (i1 /\ i3 <=> b) /\ (i2 /\ i3 <=> c) /\ (i1 /\ c <=> d) /\ (m /\ r <=> e) /\ (m /\ w <=> f) /\ (n /\ w <=> g) /\ (p /\ w <=> h) /\ (q /\ w <=> i) /\ (s /\ x <=> j) /\ (t /\ x <=> k) /\ (v /\ x <=> l) /\ (i1 \/ i2 <=> m) /\ (i1 \/ i3 <=> n) /\ (i1 \/ q <=> p) /\ (i2 \/ i3 <=> q) /\ (i3 \/ a <=> r) /\ (a \/ w <=> s) /\ (b \/ w <=> t) /\ (d \/ h <=> u) /\ (c \/ w <=> v) /\ (~e <=> w) /\ (~u <=> x) /\ (i \/ l <=> o1) /\ (g \/ k <=> o2) /\ (f \/ j <=> o3) ==> (o1 <=> ~i1) /\ (o2 <=> ~i2) /\ (o3 <=> ~i3)`;; hol-light/Tutorial/Real_analysis.ml000066400000000000000000000057661303454263000177060ustar00rootroot00000000000000needs "Library/analysis.ml";; needs "Library/transc.ml";; let cheb = define `(!x. cheb 0 x = &1) /\ (!x. cheb 1 x = x) /\ (!n x. cheb (n + 2) x = &2 * x * cheb (n + 1) x - cheb n x)`;; let CHEB_INDUCT = prove (`!P. P 0 /\ P 1 /\ (!n. P n /\ P(n + 1) ==> P(n + 2)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN ASM_SIMP_TAC[ARITH]);; let CHEB_COS = prove (`!n x. cheb n (cos x) = cos(&n * x)`, MATCH_MP_TAC CHEB_INDUCT THEN REWRITE_TAC[cheb; REAL_MUL_LZERO; REAL_MUL_LID; COS_0] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_MUL_LID; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[COS_ADD; COS_DOUBLE; SIN_DOUBLE] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; let CHEB_RIPPLE = prove (`!x. abs(x) <= &1 ==> abs(cheb n x) <= &1`, REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN MESON_TAC[CHEB_COS; ACS_COS; COS_BOUNDS]);; let NUM_ADD2_CONV = let add_tm = `(+):num->num->num` and two_tm = `2` in fun tm -> let m = mk_numeral(dest_numeral tm -/ Int 2) in let tm' = mk_comb(mk_comb(add_tm,m),two_tm) in SYM(NUM_ADD_CONV tm');; let CHEB_CONV = let [pth0;pth1;pth2] = CONJUNCTS cheb in let rec conv tm = (GEN_REWRITE_CONV I [pth0; pth1] ORELSEC (LAND_CONV NUM_ADD2_CONV THENC GEN_REWRITE_CONV I [pth2] THENC COMB2_CONV (funpow 3 RAND_CONV ((LAND_CONV NUM_ADD_CONV) THENC conv)) conv THENC REAL_POLY_CONV)) tm in conv;; CHEB_CONV `cheb 8 x`;; let CHEB_2N1 = prove (`!n x. ((x - &1) * (cheb (2 * n + 1) x - &1) = (cheb (n + 1) x - cheb n x) pow 2) /\ (&2 * (x pow 2 - &1) * (cheb (2 * n + 2) x - &1) = (cheb (n + 2) x - cheb n x) pow 2)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC CHEB_INDUCT THEN REWRITE_TAC[ARITH; cheb; CHEB_CONV `cheb 2 x`; CHEB_CONV `cheb 3 x`] THEN REPEAT(CHANGED_TAC (REWRITE_TAC[GSYM ADD_ASSOC; LEFT_ADD_DISTRIB; ARITH] THEN REWRITE_TAC[ARITH_RULE `n + 5 = (n + 3) + 2`; ARITH_RULE `n + 4 = (n + 2) + 2`; ARITH_RULE `n + 3 = (n + 1) + 2`; cheb])) THEN CONV_TAC REAL_RING);; let IVT_LEMMA1 = prove (`!f. (!x. f contl x) ==> !x y. f(x) <= &0 /\ &0 <= f(y) ==> ?x. f(x) = &0`, ASM_MESON_TAC[IVT; IVT2; REAL_LE_TOTAL]);; let IVT_LEMMA2 = prove (`!f. (!x. f contl x) /\ (?x. f(x) <= x) /\ (?y. y <= f(y)) ==> ?x. f(x) = x`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. f x - x` IVT_LEMMA1) THEN ASM_SIMP_TAC[CONT_SUB; CONT_X] THEN SIMP_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD; REAL_SUB_0; REAL_ADD_LID] THEN ASM_MESON_TAC[]);; let SARKOVSKII_TRIVIAL = prove (`!f:real->real. (!x. f contl x) /\ (?x. f(f(f(x))) = x) ==> ?x. f(x) = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_LEMMA2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC (MESON[] `P x \/ P (f x) \/ P (f(f x)) ==> ?x:real. P x`) THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN REAL_ARITH_TAC);; hol-light/Tutorial/Recursive_definitions.ml000066400000000000000000000050461303454263000214510ustar00rootroot00000000000000let fib = define `fib n = if n = 0 \/ n = 1 then 1 else fib(n - 1) + fib(n - 2)`;; let fib2 = define `(fib2 0 = 1) /\ (fib2 1 = 1) /\ (fib2 (n + 2) = fib2(n) + fib2(n + 1))`;; let halve = define `halve (2 * n) = n`;; let unknown = define `unknown n = unknown(n + 1)`;; define `!n. collatz(n) = if n <= 1 then n else if EVEN(n) then collatz(n DIV 2) else collatz(3 * n + 1)`;; let fusc_def = define `(fusc (2 * n) = if n = 0 then 0 else fusc(n)) /\ (fusc (2 * n + 1) = if n = 0 then 1 else fusc(n) + fusc(n + 1))`;; let fusc = prove (`fusc 0 = 0 /\ fusc 1 = 1 /\ fusc (2 * n) = fusc(n) /\ fusc (2 * n + 1) = fusc(n) + fusc(n + 1)`, REWRITE_TAC[fusc_def] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(INST [`0`,`n:num`] fusc_def) THEN ARITH_TAC);; let binom = define `(!n. binom(n,0) = 1) /\ (!k. binom(0,SUC(k)) = 0) /\ (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; let BINOM_LT = prove (`!n k. n < k ==> (binom(n,k) = 0)`, INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; let BINOM_REFL = prove (`!n. binom(n,n) = 1`, INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; let BINOM_FACT = prove (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; let BINOMIAL_THEOREM = prove (`!n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k))`, INDUCT_TAC THEN ASM_REWRITE_TAC[EXP] THEN REWRITE_TAC[NSUM_SING_NUMSEG; binom; SUB_REFL; EXP; MULT_CLAUSES] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; NSUM_OFFSET] THEN ASM_REWRITE_TAC[EXP; binom; GSYM ADD1; GSYM NSUM_LMUL] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; NSUM_ADD_NUMSEG; MULT_CLAUSES; SUB_0] THEN MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN CONJ_TAC THENL [REWRITE_TAC[MULT_AC; SUB_SUC]; REWRITE_TAC[GSYM EXP]] THEN SIMP_TAC[ADD1; SYM(REWRITE_CONV[NSUM_OFFSET]`nsum(m+1..n+1) (\i. f i)`)] THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0] THEN SIMP_TAC[BINOM_LT; LT; MULT_CLAUSES; ADD_CLAUSES; SUB_0; EXP; binom] THEN SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; EXP] THEN REWRITE_TAC[MULT_AC]);; hol-light/Tutorial/Semantics_of_programming_languages_deep.ml000066400000000000000000000067351303454263000251540ustar00rootroot00000000000000let string_INDUCT,string_RECURSION = define_type "string = String (int list)";; let expression_INDUCT,expression_RECURSION = define_type "expression = Literal num | Variable string | Plus expression expression | Times expression expression";; let command_INDUCT,command_RECURSION = define_type "command = Assign string expression | Sequence command command | If expression command command | While expression command";; parse_as_infix(";;",(18,"right"));; parse_as_infix(":=",(20,"right"));; override_interface(";;",`Sequence`);; override_interface(":=",`Assign`);; overload_interface("+",`Plus`);; overload_interface("*",`Times`);; let value = define `(value (Literal n) s = n) /\ (value (Variable x) s = s(x)) /\ (value (e1 + e2) s = value e1 s + value e2 s) /\ (value (e1 * e2) s = value e1 s * value e2 s)`;; let sem_RULES,sem_INDUCT,sem_CASES = new_inductive_definition `(!x e s s'. s'(x) = value e s /\ (!y. ~(y = x) ==> s'(y) = s(y)) ==> sem (x := e) s s') /\ (!c1 c2 s s' s''. sem(c1) s s' /\ sem(c2) s' s'' ==> sem(c1 ;; c2) s s'') /\ (!e c1 c2 s s'. ~(value e s = 0) /\ sem(c1) s s' ==> sem(If e c1 c2) s s') /\ (!e c1 c2 s s'. value e s = 0 /\ sem(c2) s s' ==> sem(If e c1 c2) s s') /\ (!e c s. value e s = 0 ==> sem(While e c) s s) /\ (!e c s s' s''. ~(value e s = 0) /\ sem(c) s s' /\ sem(While e c) s' s'' ==> sem(While e c) s s'')`;; (**** Fails define `sem(While e c) s s' <=> if value e s = 0 then (s' = s) else ?s''. sem c s s'' /\ sem(While e c) s'' s'`;; ****) let DETERMINISM = prove (`!c s s' s''. sem c s s' /\ sem c s s'' ==> (s' = s'')`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC sem_INDUCT THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[sem_CASES] THEN REWRITE_TAC[distinctness "command"; injectivity "command"] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);; let wlp = new_definition `wlp c q s <=> !s'. sem c s s' ==> q s'`;; let terminates = new_definition `terminates c s <=> ?s'. sem c s s'`;; let wp = new_definition `wp c q s <=> terminates c s /\ wlp c q s`;; let WP_TOTAL = prove (`!c. (wp c EMPTY = EMPTY)`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; EMPTY] THEN MESON_TAC[]);; let WP_MONOTONIC = prove (`q SUBSET r ==> wp c q SUBSET wp c r`, REWRITE_TAC[SUBSET; IN; wp; wlp; terminates] THEN MESON_TAC[]);; let WP_DISJUNCTIVE = prove (`(wp c p) UNION (wp c q) = wp c (p UNION q)`, REWRITE_TAC[FUN_EQ_THM; IN; wp; wlp; IN_ELIM_THM; UNION; terminates] THEN MESON_TAC[DETERMINISM]);; let WP_SEQ = prove (`!c1 c2 q. wp (c1 ;; c2) = wp c1 o wp c2`, REWRITE_TAC[wp; wlp; terminates; FUN_EQ_THM; o_THM] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sem_CASES] THEN REWRITE_TAC[injectivity "command"; distinctness "command"] THEN MESON_TAC[DETERMINISM]);; let correct = new_definition `correct p c q <=> p SUBSET (wp c q)`;; let CORRECT_PRESTRENGTH = prove (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, REWRITE_TAC[correct; SUBSET_TRANS]);; let CORRECT_POSTWEAK = prove (`!p c q q'. correct p c q' /\ q' SUBSET q ==> correct p c q`, REWRITE_TAC[correct] THEN MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; let CORRECT_SEQ = prove (`!p q r c1 c2. correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; c2) q`, REWRITE_TAC[correct; WP_SEQ; o_THM] THEN MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; hol-light/Tutorial/Semantics_of_programming_languages_shallow.ml000066400000000000000000000210001303454263000256660ustar00rootroot00000000000000let assign = new_definition `Assign (f:S->S) (q:S->bool) = q o f`;; parse_as_infix(";;",(18,"right"));; let sequence = new_definition `(c1:(S->bool)->(S->bool)) ;; (c2:(S->bool)->(S->bool)) = c1 o c2`;; let if_def = new_definition `If e (c:(S->bool)->(S->bool)) q = {s | if e s then c q s else q s}`;; let ite_def = new_definition `Ite e (c1:(S->bool)->(S->bool)) c2 q = {s | if e s then c1 q s else c2 q s}`;; let while_RULES,while_INDUCT,while_CASES = new_inductive_definition `!q s. If e (c ;; while e c) q s ==> while e c q s`;; let while_def = new_definition `While e c q = {s | !w. (!s:S. (if e(s) then c w s else q s) ==> w s) ==> w s}`;; let monotonic = new_definition `monotonic c <=> !q q'. q SUBSET q' ==> (c q) SUBSET (c q')`;; let MONOTONIC_ASSIGN = prove (`monotonic (Assign f)`, SIMP_TAC[monotonic; assign; SUBSET; o_THM; IN]);; let MONOTONIC_IF = prove (`monotonic c ==> monotonic (If e c)`, REWRITE_TAC[monotonic; if_def] THEN SET_TAC[]);; let MONOTONIC_ITE = prove (`monotonic c1 /\ monotonic c2 ==> monotonic (Ite e c1 c2)`, REWRITE_TAC[monotonic; ite_def] THEN SET_TAC[]);; let MONOTONIC_SEQ = prove (`monotonic c1 /\ monotonic c2 ==> monotonic (c1 ;; c2)`, REWRITE_TAC[monotonic; sequence; o_THM] THEN SET_TAC[]);; let MONOTONIC_WHILE = prove (`monotonic c ==> monotonic(While e c)`, REWRITE_TAC[monotonic; while_def] THEN SET_TAC[]);; let WHILE_THM = prove (`!e c q:S->bool. monotonic c ==> (!s. If e (c ;; While e c) q s ==> While e c q s) /\ (!w'. (!s. If e (c ;; (\q. w')) q s ==> w' s) ==> (!a. While e c q a ==> w' a)) /\ (!s. While e c q s <=> If e (c ;; While e c) q s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN (MP_TAC o GEN_ALL o DISCH_ALL o derive_nonschematic_inductive_relations) `!s:S. (if e s then c w s else q s) ==> w s` THEN REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[FUN_EQ_THM; while_def; IN_ELIM_THM] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[monotonic] THEN SET_TAC[]);; let WHILE_FIX = prove (`!e c. monotonic c ==> (While e c = If e (c ;; While e c))`, REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[WHILE_THM]);; let correct = new_definition `correct p c q <=> p SUBSET (c q)`;; let CORRECT_PRESTRENGTH = prove (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, REWRITE_TAC[correct; SUBSET_TRANS]);; let CORRECT_POSTWEAK = prove (`!p c q q'. monotonic c /\ correct p c q' /\ q' SUBSET q ==> correct p c q`, REWRITE_TAC[correct; monotonic] THEN SET_TAC[]);; let CORRECT_ASSIGN = prove (`!p f q. (p SUBSET (q o f)) ==> correct p (Assign f) q`, REWRITE_TAC[correct; assign]);; let CORRECT_SEQ = prove (`!p q r c1 c2. monotonic c1 /\ correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; c2) q`, REWRITE_TAC[correct; sequence; monotonic; o_THM] THEN SET_TAC[]);; let CORRECT_ITE = prove (`!p e c1 c2 q. correct (p INTER e) c1 q /\ correct (p INTER (UNIV DIFF e)) c2 q ==> correct p (Ite e c1 c2) q`, REWRITE_TAC[correct; ite_def] THEN SET_TAC[]);; let CORRECT_IF = prove (`!p e c q. correct (p INTER e) c q /\ p INTER (UNIV DIFF e) SUBSET q ==> correct p (If e c) q`, REWRITE_TAC[correct; if_def] THEN SET_TAC[]);; let CORRECT_WHILE = prove (`!(<<) p c q e invariant. monotonic c /\ WF(<<) /\ p SUBSET invariant /\ (UNIV DIFF e) INTER invariant SUBSET q /\ (!X:S. correct (invariant INTER e INTER (\s. X = s)) c (invariant INTER (\s. s << X))) ==> correct p (While e c) q`, REWRITE_TAC[correct; SUBSET; IN_INTER; IN_UNIV; IN_DIFF; IN] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!s:S. invariant s ==> While e c q s` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND]) THEN X_GEN_TAC `s:S` THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP WHILE_FIX th]) THEN REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:S`; `s:S`]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [monotonic]) THEN REWRITE_TAC[SUBSET; IN; RIGHT_IMP_FORALL_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[INTER; IN_ELIM_THM; IN]);; let assert_def = new_definition `assert (p:S->bool) (q:S->bool) = q`;; let variant_def = new_definition `variant ((<<):S->S->bool) (q:S->bool) = q`;; let CORRECT_SEQ_VC = prove (`!p q r c1 c2. monotonic c1 /\ correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; assert r ;; c2) q`, REWRITE_TAC[correct; sequence; monotonic; assert_def; o_THM] THEN SET_TAC[]);; let CORRECT_WHILE_VC = prove (`!(<<) p c q e invariant. monotonic c /\ WF(<<) /\ p SUBSET invariant /\ (UNIV DIFF e) INTER invariant SUBSET q /\ (!X:S. correct (invariant INTER e INTER (\s. X = s)) c (invariant INTER (\s. s << X))) ==> correct p (While e (assert invariant ;; variant(<<) ;; c)) q`, REPEAT STRIP_TAC THEN REWRITE_TAC[sequence; variant_def; assert_def; o_DEF; ETA_AX] THEN ASM_MESON_TAC[CORRECT_WHILE]);; let MONOTONIC_ASSERT = prove (`monotonic (assert p)`, REWRITE_TAC[assert_def; monotonic]);; let MONOTONIC_VARIANT = prove (`monotonic (variant p)`, REWRITE_TAC[variant_def; monotonic]);; let MONO_TAC = REPEAT(MATCH_MP_TAC MONOTONIC_WHILE ORELSE (MAP_FIRST MATCH_MP_TAC [MONOTONIC_SEQ; MONOTONIC_IF; MONOTONIC_ITE] THEN CONJ_TAC)) THEN MAP_FIRST MATCH_ACCEPT_TAC [MONOTONIC_ASSIGN; MONOTONIC_ASSERT; MONOTONIC_VARIANT];; let VC_TAC = FIRST [MATCH_MP_TAC CORRECT_SEQ_VC THEN CONJ_TAC THENL [MONO_TAC; CONJ_TAC]; MATCH_MP_TAC CORRECT_ITE THEN CONJ_TAC; MATCH_MP_TAC CORRECT_IF THEN CONJ_TAC; MATCH_MP_TAC CORRECT_WHILE_VC THEN REPEAT CONJ_TAC THENL [MONO_TAC; TRY(MATCH_ACCEPT_TAC WF_MEASURE); ALL_TAC; ALL_TAC; REWRITE_TAC[FORALL_PAIR_THM; MEASURE] THEN REPEAT GEN_TAC]; MATCH_MP_TAC CORRECT_ASSIGN];; needs "Library/prime.ml";; (* ------------------------------------------------------------------------- *) (* x = m, y = n; *) (* while (!(x == 0 || y == 0)) *) (* { if (x < y) y = y - x; *) (* else x = x - y; *) (* } *) (* if (x == 0) x = y; *) (* ------------------------------------------------------------------------- *) g `correct (\(m,n,x,y). T) (Assign (\(m,n,x,y). m,n,m,n) ;; // x,y := m,n assert (\(m,n,x,y). x = m /\ y = n) ;; While (\(m,n,x,y). ~(x = 0 \/ y = 0)) (assert (\(m,n,x,y). gcd(x,y) = gcd(m,n)) ;; variant(MEASURE(\(m,n,x,y). x + y)) ;; Ite (\(m,n,x,y). x < y) (Assign (\(m,n,x,y). m,n,x,y - x)) (Assign (\(m,n,x,y). m,n,x - y,y))) ;; assert (\(m,n,x,y). (x = 0 \/ y = 0) /\ gcd(x,y) = gcd(m,n)) ;; If (\(m,n,x,y). x = 0) (Assign (\(m,n,x,y). (m,n,y,y)))) (\(m,n,x,y). gcd(m,n) = x)`;; e(REPEAT VC_TAC);; b();; e(REPEAT VC_TAC THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:num`; `y:num`] THEN REWRITE_TAC[IN; INTER; UNIV; DIFF; o_DEF; IN_ELIM_THM; PAIR_EQ] THEN CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN SIMP_TAC[]);; e(SIMP_TAC[GCD_SUB; LT_IMP_LE]);; e ARITH_TAC;; e(SIMP_TAC[GCD_SUB; NOT_LT] THEN ARITH_TAC);; e(MESON_TAC[GCD_0]);; e(MESON_TAC[GCD_0; GCD_SYM]);; parse_as_infix("refines",(12,"right"));; let refines = new_definition `c2 refines c1 <=> !q. c1(q) SUBSET c2(q)`;; let REFINES_REFL = prove (`!c. c refines c`, REWRITE_TAC[refines; SUBSET_REFL]);; let REFINES_TRANS = prove (`!c1 c2 c3. c3 refines c2 /\ c2 refines c1 ==> c3 refines c1`, REWRITE_TAC[refines] THEN MESON_TAC[SUBSET_TRANS]);; let REFINES_CORRECT = prove (`correct p c1 q /\ c2 refines c1 ==> correct p c2 q`, REWRITE_TAC[correct; refines] THEN MESON_TAC[SUBSET_TRANS]);; let REFINES_WHILE = prove (`c' refines c ==> While e c' refines While e c`, REWRITE_TAC[refines; while_def; SUBSET; IN_ELIM_THM; IN] THEN MESON_TAC[]);; let specification = new_definition `specification(p,q) r = if q SUBSET r then p else {}`;; let REFINES_SPECIFICATION = prove (`c refines specification(p,q) ==> correct p c q`, REWRITE_TAC[specification; correct; refines] THEN MESON_TAC[SUBSET_REFL; SUBSET_EMPTY]);; hol-light/Tutorial/Sets_and_functions.ml000066400000000000000000000036721303454263000207420ustar00rootroot00000000000000let SURJECTIVE_IFF_RIGHT_INVERSE = prove (`(!y. ?x. g x = y) <=> (?f. g o f = I)`, REWRITE_TAC[FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; let INJECTIVE_IFF_LEFT_INVERSE = prove (`(!x y. f x = f y ==> x = y) <=> (?g. g o f = I)`, let lemma = MESON[] `(!x x'. f x = f x' ==> x = x') <=> (!y:B. ?u:A. !x. f x = y ==> u = x)` in REWRITE_TAC[lemma; FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; let cantor = new_definition `cantor(x,y) = ((x + y) EXP 2 + 3 * x + y) DIV 2`;; (**** Needs external SDP solver needs "Examples/sos.ml";; let CANTOR_LEMMA = prove (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, REWRITE_TAC[cantor] THEN CONV_TAC SOS_RULE);; ****) let CANTOR_LEMMA_LEMMA = prove (`x + y < x' + y' ==> cantor(x,y) < cantor(x',y')`, REWRITE_TAC[ARITH_RULE `x + y < z <=> x + y + 1 <= z`] THEN DISCH_TAC THEN REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN MATCH_MP_TAC(ARITH_RULE `x + 2 <= y ==> x DIV 2 < y DIV 2`) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(x + y + 1) EXP 2 + (x + y + 1)` THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `a:num <= b /\ c <= d ==> a + c <= b + d + e`) THEN ASM_SIMP_TAC[EXP_2; LE_MULT2]);; let CANTOR_LEMMA = prove (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, MESON_TAC[LT_CASES; LT_REFL; CANTOR_LEMMA_LEMMA]);; let CANTOR_INJ = prove (`!w z. cantor w = cantor z ==> w = z`, REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP CANTOR_LEMMA th)) THEN ASM_REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN REWRITE_TAC[ARITH_RULE `(a + b + 2 * x) DIV 2 = (a + b) DIV 2 + x`] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let CANTOR_THM = prove (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, REWRITE_TAC[INJECTIVE_IFF_LEFT_INVERSE; FUN_EQ_THM; I_DEF; o_DEF] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN MESON_TAC[]);; hol-light/Tutorial/Tactics_and_tacticals.ml000066400000000000000000000034651303454263000213550ustar00rootroot00000000000000g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; e DISCH_TAC;; b();; e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; e(SIMP_TAC[]);; e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; e DISCH_TAC;; e(ASM_REWRITE_TAC[]);; e(CONV_TAC ARITH_RULE);; let trivial = top_thm();; g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; e(SIMP_TAC[]);; e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; e DISCH_TAC;; e(ASM_REWRITE_TAC[]);; e(CONV_TAC ARITH_RULE);; let trivial = top_thm();; g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; let trivial = top_thm();; let trivial = prove (`2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`, CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; let trivial = prove (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN MP_TAC(SPECL [`x:real`; `--y`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; let trivial = prove (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THEN REPEAT GEN_TAC THEN MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; let SUM_OF_NUMBERS = prove (`!n. nsum(1..n) (\i. i) = (n * (n + 1)) DIV 2`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let SUM_OF_SQUARES = prove (`!n. nsum(1..n) (\i. i * i) = (n * (n + 1) * (2 * n + 1)) DIV 6`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let SUM_OF_CUBES = prove (`!n. nsum(1..n) (\i. i*i*i) = (n * n * (n + 1) * (n + 1)) DIV 4`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; hol-light/Tutorial/Vectors.ml000066400000000000000000000067731303454263000165440ustar00rootroot00000000000000needs "Multivariate/vectors.ml";; needs "Examples/solovay.ml";; g `orthogonal (A - B) (C - B) ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`;; e SOLOVAY_VECTOR_TAC;; e(CONV_TAC REAL_RING);; g`!x y:real^N. x dot y <= norm x * norm y`;; e SOLOVAY_VECTOR_TAC;; (**** Needs external SDP solver needs "Examples/sos.ml";; e(CONV_TAC REAL_SOS);; let EXAMPLE_0 = prove (`!a x y:real^N. (y - x) dot (a - y) >= &0 ==> norm(y - a) <= norm(x - a)`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; ****) (*** Needs Rqe loaded needs "Rqe/make.ml";; let EXAMPLE_10 = prove (`!x:real^N y. x dot y > &0 ==> ?u. &0 < u /\ !v. &0 < v /\ v <= u ==> norm(v % y - x) < norm x`, SOLOVAY_VECTOR_TAC THEN W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN CONV_TAC REAL_QELIM_CONV);; ****) let FORALL_3 = prove (`(!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`, MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> (i = 1) \/ (i = 2) \/ (i = 3)`]);; let SUM_3 = prove (`!t. sum(1..3) t = t(1) + t(2) + t(3)`, REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; let VECTOR_3 = prove (`(vector [x;y;z] :real^3)$1 = x /\ (vector [x;y;z] :real^3)$2 = y /\ (vector [x;y;z] :real^3)$3 = z`, SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; LENGTH; ARITH] THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; EL; HD; TL]);; let DOT_VECTOR = prove (`(vector [x1;y1;z1] :real^3) dot (vector [x2;y2;z2]) = x1 * x2 + y1 * y2 + z1 * z2`, REWRITE_TAC[dot; DIMINDEX_3; SUM_3; VECTOR_3]);; let VECTOR_ZERO = prove (`(vector [x;y;z] :real^3 = vec 0) <=> x = &0 /\ y = &0 /\ z = &0`, SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT; VECTOR_3; ARITH]);; let ORTHOGONAL_VECTOR = prove (`orthogonal (vector [x1;y1;z1] :real^3) (vector [x2;y2;z2]) = (x1 * x2 + y1 * y2 + z1 * z2 = &0)`, REWRITE_TAC[orthogonal; DOT_VECTOR]);; parse_as_infix("cross",(20,"right"));; let cross = new_definition `(a:real^3) cross (b:real^3) = vector [a$2 * b$3 - a$3 * b$2; a$3 * b$1 - a$1 * b$3; a$1 * b$2 - a$2 * b$1] :real^3`;; let VEC3_TAC = SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_3; SUM_3; DIMINDEX_3; VECTOR_3; vector_add; vec; dot; cross; orthogonal; basis; ARITH] THEN CONV_TAC REAL_RING;; let VEC3_RULE tm = prove(tm,VEC3_TAC);; let ORTHOGONAL_CROSS = VEC3_RULE `!x y. orthogonal (x cross y) x /\ orthogonal (x cross y) y /\ orthogonal x (x cross y) /\ orthogonal y (x cross y)`;; let LEMMA_0 = VEC3_RULE `~(basis 1 :real^3 = vec 0) /\ ~(basis 2 :real^3 = vec 0) /\ ~(basis 3 :real^3 = vec 0)`;; let LEMMA_1 = VEC3_RULE `!u v. u dot (u cross v) = &0`;; let LEMMA_2 = VEC3_RULE `!u v. v dot (u cross v) = &0`;; let LEMMA_3 = VEC3_RULE `!u:real^3. vec 0 dot u = &0`;; let LEMMA_4 = VEC3_RULE `!u:real^3. u dot vec 0 = &0`;; let LEMMA_5 = VEC3_RULE `!x. x cross x = vec 0`;; let LEMMA_6 = VEC3_RULE `!u. ~(u = vec 0) ==> ~(u cross basis 1 = vec 0) \/ ~(u cross basis 2 = vec 0) \/ ~(u cross basis 3 = vec 0)`;; let LEMMA_7 = VEC3_RULE `!u v w. (u cross v = vec 0) ==> (u dot (v cross w) = &0)`;; let NORMAL_EXISTS = prove (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`u:real^3 = vec 0`; `v:real^3 = vec 0`; `u cross v = vec 0`] THEN ASM_REWRITE_TAC[orthogonal] THEN ASM_MESON_TAC[LEMMA_0; LEMMA_1; LEMMA_2; LEMMA_3; LEMMA_4; LEMMA_5; LEMMA_6; LEMMA_7]);; hol-light/Tutorial/Wellfounded_induction.ml000066400000000000000000000011011303454263000214170ustar00rootroot00000000000000let NSQRT_2 = prove (`!p q. p * p = 2 * q * q ==> q = 0`, MATCH_MP_TAC num_WF THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN REWRITE_TAC[EVEN_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `m:num`]) THEN ASM_REWRITE_TAC[ARITH_RULE `q < 2 * m ==> q * q = 2 * m * m ==> m = 0 <=> (2 * m) * 2 * m = 2 * q * q ==> 2 * m <= q`] THEN ASM_MESON_TAC[LE_MULT2; MULT_EQ_0; ARITH_RULE `2 * x <= x <=> x = 0`]);; hol-light/Tutorial/all.ml000066400000000000000000002426301303454263000156610ustar00rootroot00000000000000(* ========================================================================= *) (* HOL basics *) (* ========================================================================= *) ARITH_RULE `(a * x + b * y + a * y) EXP 3 + (b * x) EXP 3 + (a * x + b * y + b * x) EXP 3 + (a * y) EXP 3 = (a * x + a * y + b * x) EXP 3 + (b * y) EXP 3 + (a * y + b * y + b * x) EXP 3 + (a * x) EXP 3`;; (* ========================================================================= *) (* Propositional logic *) (* ========================================================================= *) TAUT `(~input_a ==> (internal <=> T)) /\ (~input_b ==> (output <=> internal)) /\ (input_a ==> (output <=> F)) /\ (input_b ==> (output <=> F)) ==> (output <=> ~(input_a \/ input_b))`;; TAUT `(i1 /\ i2 <=> a) /\ (i1 /\ i3 <=> b) /\ (i2 /\ i3 <=> c) /\ (i1 /\ c <=> d) /\ (m /\ r <=> e) /\ (m /\ w <=> f) /\ (n /\ w <=> g) /\ (p /\ w <=> h) /\ (q /\ w <=> i) /\ (s /\ x <=> j) /\ (t /\ x <=> k) /\ (v /\ x <=> l) /\ (i1 \/ i2 <=> m) /\ (i1 \/ i3 <=> n) /\ (i1 \/ q <=> p) /\ (i2 \/ i3 <=> q) /\ (i3 \/ a <=> r) /\ (a \/ w <=> s) /\ (b \/ w <=> t) /\ (d \/ h <=> u) /\ (c \/ w <=> v) /\ (~e <=> w) /\ (~u <=> x) /\ (i \/ l <=> o1) /\ (g \/ k <=> o2) /\ (f \/ j <=> o3) ==> (o1 <=> ~i1) /\ (o2 <=> ~i2) /\ (o3 <=> ~i3)`;; (* ========================================================================= *) (* Abstractions and quantifiers *) (* ========================================================================= *) MESON[] `((?x. !y. P(x) <=> P(y)) <=> ((?x. Q(x)) <=> (!y. Q(y)))) <=> ((?x. !y. Q(x) <=> Q(y)) <=> ((?x. P(x)) <=> (!y. P(y))))`;; MESON[] `(!x y z. P x y /\ P y z ==> P x z) /\ (!x y z. Q x y /\ Q y z ==> Q x z) /\ (!x y. P x y ==> P y x) /\ (!x y. P x y \/ Q x y) ==> (!x y. P x y) \/ (!x y. Q x y)`;; let ewd1062 = MESON[] `(!x. x <= x) /\ (!x y z. x <= y /\ y <= z ==> x <= z) /\ (!x y. f(x) <= y <=> x <= g(y)) ==> (!x y. x <= y ==> f(x) <= f(y)) /\ (!x y. x <= y ==> g(x) <= g(y))`;; let ewd1062 = MESON[] `(!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R (f x) y <=> R x (g y)) ==> (!x y. R x y ==> R (f x) (f y)) /\ (!x y. R x y ==> R (g x) (g y))`;; MESON[] `(?!x. g(f x) = x) <=> (?!y. f(g y) = y)`;; MESON [ADD_ASSOC; ADD_SYM] `m + (n + p) = n + (m + p)`;; (* ========================================================================= *) (* Tactics and tacticals *) (* ========================================================================= *) g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; e DISCH_TAC;; b();; e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; e(SIMP_TAC[]);; e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; e DISCH_TAC;; e(ASM_REWRITE_TAC[]);; e(CONV_TAC ARITH_RULE);; let trivial = top_thm();; g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; e(SIMP_TAC[]);; e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; e DISCH_TAC;; e(ASM_REWRITE_TAC[]);; e(CONV_TAC ARITH_RULE);; let trivial = top_thm();; g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; let trivial = top_thm();; let trivial = prove (`2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`, CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; let trivial = prove (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN MP_TAC(SPECL [`x:real`; `--y`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; let trivial = prove (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THEN REPEAT GEN_TAC THEN MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; let SUM_OF_NUMBERS = prove (`!n. nsum(1..n) (\i. i) = (n * (n + 1)) DIV 2`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let SUM_OF_SQUARES = prove (`!n. nsum(1..n) (\i. i * i) = (n * (n + 1) * (2 * n + 1)) DIV 6`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let SUM_OF_CUBES = prove (`!n. nsum(1..n) (\i. i*i*i) = (n * n * (n + 1) * (n + 1)) DIV 4`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; (* ========================================================================= *) (* HOL's number systems *) (* ========================================================================= *) REAL_ARITH `!x y:real. (abs(x) - abs(y)) <= abs(x - y)`;; INT_ARITH `!a b a' b' D:int. (a pow 2 - D * b pow 2) * (a' pow 2 - D * b' pow 2) = (a * a' + D * b * b') pow 2 - D * (a * b' + a' * b) pow 2`;; REAL_ARITH `!x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11:real. x3 = abs(x2) - x1 /\ x4 = abs(x3) - x2 /\ x5 = abs(x4) - x3 /\ x6 = abs(x5) - x4 /\ x7 = abs(x6) - x5 /\ x8 = abs(x7) - x6 /\ x9 = abs(x8) - x7 /\ x10 = abs(x9) - x8 /\ x11 = abs(x10) - x9 ==> x1 = x10 /\ x2 = x11`;; REAL_ARITH `!x y:real. x < y ==> x < (x + y) / &2 /\ (x + y) / &2 < y`;; REAL_ARITH `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2) = ((&1 / &6) * ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) + (&1 / &6) * ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4))`;; ARITH_RULE `x < 2 ==> 2 * x + 1 < 4`;; (**** Fails ARITH_RULE `~(2 * m + 1 = 2 * n)`;; ****) ARITH_RULE `x < 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; (**** Fails ARITH_RULE `x <= 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; ****) (**** Fails ARITH_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; ****) (**** Fails REAL_ARITH `!x y:real. x = y ==> x * y = y pow 2`;; ****) prioritize_real();; REAL_RING `s = (a + b + c) / &2 ==> s * (s - b) * (s - c) + s * (s - c) * (s - a) + s * (s - a) * (s - b) - (s - a) * (s - b) * (s - c) = a * b * c`;; REAL_RING `a pow 2 = &2 /\ x pow 2 + a * x + &1 = &0 ==> x pow 4 + &1 = &0`;; REAL_RING `(a * x pow 2 + b * x + c = &0) /\ (a * y pow 2 + b * y + c = &0) /\ ~(x = y) ==> (a * x * y = c) /\ (a * (x + y) + b = &0)`;; REAL_RING `p = (&3 * a1 - a2 pow 2) / &3 /\ q = (&9 * a1 * a2 - &27 * a0 - &2 * a2 pow 3) / &27 /\ x = z + a2 / &3 /\ x * w = w pow 2 - p / &3 ==> (z pow 3 + a2 * z pow 2 + a1 * z + a0 = &0 <=> if p = &0 then x pow 3 = q else (w pow 3) pow 2 - q * (w pow 3) - p pow 3 / &27 = &0)`;; REAL_FIELD `&0 < x ==> &1 / x - &1 / (&1 + x) = &1 / (x * (&1 + x))`;; REAL_FIELD `s pow 2 = b pow 2 - &4 * a * c ==> (a * x pow 2 + b * x + c = &0 <=> if a = &0 then if b = &0 then if c = &0 then T else F else x = --c / b else x = (--b + s) / (&2 * a) \/ x = (--b + --s) / (&2 * a))`;; (**** This needs an external SDP solver to assist with proof needs "Examples/sos.ml";; SOS_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; REAL_SOS `!a1 a2 a3 a4:real. &0 <= a1 /\ &0 <= a2 /\ &0 <= a3 /\ &0 <= a4 ==> a1 pow 2 + ((a1 + a2) / &2) pow 2 + ((a1 + a2 + a3) / &3) pow 2 + ((a1 + a2 + a3 + a4) / &4) pow 2 <= &4 * (a1 pow 2 + a2 pow 2 + a3 pow 2 + a4 pow 2)`;; REAL_SOS `!a b c:real. a >= &0 /\ b >= &0 /\ c >= &0 ==> &3 / &2 * (b + c) * (a + c) * (a + b) <= a * (a + c) * (a + b) + b * (b + c) * (a + b) + c * (b + c) * (a + c)`;; SOS_CONV `&2 * x pow 4 + &2 * x pow 3 * y - x pow 2 * y pow 2 + &5 * y pow 4`;; PURE_SOS `x pow 4 + &2 * x pow 2 * z + x pow 2 - &2 * x * y * z + &2 * y pow 2 * z pow 2 + &2 * y * z pow 2 + &2 * z pow 2 - &2 * x + &2 * y * z + &1 >= &0`;; *****) needs "Examples/cooper.ml";; COOPER_RULE `ODD n ==> 2 * n DIV 2 < n`;; COOPER_RULE `!n. n >= 8 ==> ?a b. n = 3 * a + 5 * b`;; needs "Rqe/make.ml";; REAL_QELIM_CONV `!x. &0 <= x ==> ?y. y pow 2 = x`;; (* ========================================================================= *) (* Inductive definitions *) (* ========================================================================= *) (* ------------------------------------------------------------------------- *) (* Bug puzzle. *) (* ------------------------------------------------------------------------- *) prioritize_real();; let move = new_definition `move ((ax,ay),(bx,by),(cx,cy)) ((ax',ay'),(bx',by'),(cx',cy')) <=> (?a. ax' = ax + a * (cx - bx) /\ ay' = ay + a * (cy - by) /\ bx' = bx /\ by' = by /\ cx' = cx /\ cy' = cy) \/ (?b. bx' = bx + b * (ax - cx) /\ by' = by + b * (ay - cy) /\ ax' = ax /\ ay' = ay /\ cx' = cx /\ cy' = cy) \/ (?c. ax' = ax /\ ay' = ay /\ bx' = bx /\ by' = by /\ cx' = cx + c * (bx - ax) /\ cy' = cy + c * (by - ay))`;; let reachable_RULES,reachable_INDUCT,reachable_CASES = new_inductive_definition `(!p. reachable p p) /\ (!p q r. move p q /\ reachable q r ==> reachable p r)`;; let oriented_area = new_definition `oriented_area ((ax,ay),(bx,by),(cx,cy)) = ((bx - ax) * (cy - ay) - (cx - ax) * (by - ay)) / &2`;; let MOVE_INVARIANT = prove (`!p p'. move p p' ==> oriented_area p = oriented_area p'`, REWRITE_TAC[FORALL_PAIR_THM; move; oriented_area] THEN CONV_TAC REAL_RING);; let REACHABLE_INVARIANT = prove (`!p p'. reachable p p' ==> oriented_area p = oriented_area p'`, MATCH_MP_TAC reachable_INDUCT THEN MESON_TAC[MOVE_INVARIANT]);; let IMPOSSIBILITY_B = prove (`~(reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(&2,&5),(-- &2,&3)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(-- &2,&3),(&2,&5)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(&1,&2),(-- &2,&3)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(-- &2,&3),(&1,&2)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&1,&2),(&2,&5)) \/ reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&2,&5),(&1,&2)))`, STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REACHABLE_INVARIANT) THEN REWRITE_TAC[oriented_area] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Verification of a simple concurrent program. *) (* ------------------------------------------------------------------------- *) let init = new_definition `init (x,y,pc1,pc2,sem) <=> pc1 = 10 /\ pc2 = 10 /\ x = 0 /\ y = 0 /\ sem = 1`;; let trans = new_definition `trans (x,y,pc1,pc2,sem) (x',y',pc1',pc2',sem') <=> pc1 = 10 /\ sem > 0 /\ pc1' = 20 /\ sem' = sem - 1 /\ (x',y',pc2') = (x,y,pc2) \/ pc2 = 10 /\ sem > 0 /\ pc2' = 20 /\ sem' = sem - 1 /\ (x',y',pc1') = (x,y,pc1) \/ pc1 = 20 /\ pc1' = 30 /\ x' = x + 1 /\ (y',pc2',sem') = (y,pc2,sem) \/ pc2 = 20 /\ pc2' = 30 /\ y' = y + 1 /\ x' = x /\ pc1' = pc1 /\ sem' = sem \/ pc1 = 30 /\ pc1' = 10 /\ sem' = sem + 1 /\ (x',y',pc2') = (x,y,pc2) \/ pc2 = 30 /\ pc2' = 10 /\ sem' = sem + 1 /\ (x',y',pc1') = (x,y,pc1)`;; let mutex = new_definition `mutex (x,y,pc1,pc2,sem) <=> pc1 = 10 \/ pc2 = 10`;; let indinv = new_definition `indinv (x:num,y:num,pc1,pc2,sem) <=> sem + (if pc1 = 10 then 0 else 1) + (if pc2 = 10 then 0 else 1) = 1`;; needs "Library/rstc.ml";; let INDUCTIVE_INVARIANT = prove (`!init invariant transition P. (!s. init s ==> invariant s) /\ (!s s'. invariant s /\ transition s s' ==> invariant s') /\ (!s. invariant s ==> P s) ==> !s s':A. init s /\ RTC transition s s' ==> P s'`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`transition:A->A->bool`; `\s s':A. invariant s ==> invariant s'`] RTC_INDUCT) THEN MESON_TAC[]);; let MUTEX = prove (`!s s'. init s /\ RTC trans s s' ==> mutex s'`, MATCH_MP_TAC INDUCTIVE_INVARIANT THEN EXISTS_TAC `indinv` THEN REWRITE_TAC[init; trans; indinv; mutex; FORALL_PAIR_THM; PAIR_EQ] THEN ARITH_TAC);; (* ========================================================================= *) (* Wellfounded induction *) (* ========================================================================= *) let NSQRT_2 = prove (`!p q. p * p = 2 * q * q ==> q = 0`, MATCH_MP_TAC num_WF THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN REWRITE_TAC[EVEN_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `m:num`]) THEN ASM_REWRITE_TAC[ARITH_RULE `q < 2 * m ==> q * q = 2 * m * m ==> m = 0 <=> (2 * m) * 2 * m = 2 * q * q ==> 2 * m <= q`] THEN ASM_MESON_TAC[LE_MULT2; MULT_EQ_0; ARITH_RULE `2 * x <= x <=> x = 0`]);; (* ========================================================================= *) (* Changing proof style *) (* ========================================================================= *) let fix ts = MAP_EVERY X_GEN_TAC ts;; let assume lab t = DISCH_THEN(fun th -> if concl th = t then LABEL_TAC lab th else failwith "assume");; let we're finished tac = tac;; let suffices_to_prove q tac = SUBGOAL_THEN q (fun th -> MP_TAC th THEN tac);; let note(lab,t) tac = SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN DISCH_THEN(fun th -> LABEL_TAC lab th);; let have t = note("",t);; let cases (lab,t) tac = SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (LABEL_TAC lab));; let consider (x,lab,t) tac = let tm = mk_exists(x,t) in SUBGOAL_THEN tm (X_CHOOSE_THEN x (LABEL_TAC lab)) THENL [tac; ALL_TAC];; let trivial = MESON_TAC[];; let algebra = CONV_TAC NUM_RING;; let arithmetic = ARITH_TAC;; let by labs tac = MAP_EVERY (fun l -> USE_THEN l MP_TAC) labs THEN tac;; let using ths tac = MAP_EVERY MP_TAC ths THEN tac;; let so constr arg tac = constr arg (FIRST_ASSUM MP_TAC THEN tac);; let NSQRT_2 = prove (`!p q. p * p = 2 * q * q ==> q = 0`, suffices_to_prove `!p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) ==> (!q. p * p = 2 * q * q ==> q = 0)` (MATCH_ACCEPT_TAC num_WF) THEN fix [`p:num`] THEN assume("A") `!m. m < p ==> !q. m * m = 2 * q * q ==> q = 0` THEN fix [`q:num`] THEN assume("B") `p * p = 2 * q * q` THEN so have `EVEN(p * p) <=> EVEN(2 * q * q)` (trivial) THEN so have `EVEN(p)` (using [ARITH; EVEN_MULT] trivial) THEN so consider (`m:num`,"C",`p = 2 * m`) (using [EVEN_EXISTS] trivial) THEN cases ("D",`q < p \/ p <= q`) (arithmetic) THENL [so have `q * q = 2 * m * m ==> m = 0` (by ["A"] trivial) THEN so we're finished (by ["B"; "C"] algebra); so have `p * p <= q * q` (using [LE_MULT2] trivial) THEN so have `q * q = 0` (by ["B"] arithmetic) THEN so we're finished (algebra)]);; (* ========================================================================= *) (* Recursive definitions *) (* ========================================================================= *) let fib = define `fib n = if n = 0 \/ n = 1 then 1 else fib(n - 1) + fib(n - 2)`;; let fib2 = define `(fib2 0 = 1) /\ (fib2 1 = 1) /\ (fib2 (n + 2) = fib2(n) + fib2(n + 1))`;; let halve = define `halve (2 * n) = n`;; let unknown = define `unknown n = unknown(n + 1)`;; define `!n. collatz(n) = if n <= 1 then n else if EVEN(n) then collatz(n DIV 2) else collatz(3 * n + 1)`;; let fusc_def = define `(fusc (2 * n) = if n = 0 then 0 else fusc(n)) /\ (fusc (2 * n + 1) = if n = 0 then 1 else fusc(n) + fusc(n + 1))`;; let fusc = prove (`fusc 0 = 0 /\ fusc 1 = 1 /\ fusc (2 * n) = fusc(n) /\ fusc (2 * n + 1) = fusc(n) + fusc(n + 1)`, REWRITE_TAC[fusc_def] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(INST [`0`,`n:num`] fusc_def) THEN ARITH_TAC);; let binom = define `(!n. binom(n,0) = 1) /\ (!k. binom(0,SUC(k)) = 0) /\ (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; let BINOM_LT = prove (`!n k. n < k ==> (binom(n,k) = 0)`, INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; let BINOM_REFL = prove (`!n. binom(n,n) = 1`, INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; let BINOM_FACT = prove (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; let BINOMIAL_THEOREM = prove (`!n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k))`, INDUCT_TAC THEN ASM_REWRITE_TAC[EXP] THEN REWRITE_TAC[NSUM_SING_NUMSEG; binom; SUB_REFL; EXP; MULT_CLAUSES] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; NSUM_OFFSET] THEN ASM_REWRITE_TAC[EXP; binom; GSYM ADD1; GSYM NSUM_LMUL] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; NSUM_ADD_NUMSEG; MULT_CLAUSES; SUB_0] THEN MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN CONJ_TAC THENL [REWRITE_TAC[MULT_AC; SUB_SUC]; REWRITE_TAC[GSYM EXP]] THEN SIMP_TAC[ADD1; SYM(REWRITE_CONV[NSUM_OFFSET]`nsum(m+1..n+1) (\i. f i)`)] THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0] THEN SIMP_TAC[BINOM_LT; LT; MULT_CLAUSES; ADD_CLAUSES; SUB_0; EXP; binom] THEN SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; EXP] THEN REWRITE_TAC[MULT_AC]);; (* ========================================================================= *) (* Sets and functions *) (* ========================================================================= *) let SURJECTIVE_IFF_RIGHT_INVERSE = prove (`(!y. ?x. g x = y) <=> (?f. g o f = I)`, REWRITE_TAC[FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; let INJECTIVE_IFF_LEFT_INVERSE = prove (`(!x y. f x = f y ==> x = y) <=> (?g. g o f = I)`, let lemma = MESON[] `(!x x'. f x = f x' ==> x = x') <=> (!y:B. ?u:A. !x. f x = y ==> u = x)` in REWRITE_TAC[lemma; FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; let cantor = new_definition `cantor(x,y) = ((x + y) EXP 2 + 3 * x + y) DIV 2`;; (**** Needs external SDP solver needs "Examples/sos.ml";; let CANTOR_LEMMA = prove (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, REWRITE_TAC[cantor] THEN CONV_TAC SOS_RULE);; ****) let CANTOR_LEMMA_LEMMA = prove (`x + y < x' + y' ==> cantor(x,y) < cantor(x',y')`, REWRITE_TAC[ARITH_RULE `x + y < z <=> x + y + 1 <= z`] THEN DISCH_TAC THEN REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN MATCH_MP_TAC(ARITH_RULE `x + 2 <= y ==> x DIV 2 < y DIV 2`) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(x + y + 1) EXP 2 + (x + y + 1)` THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(ARITH_RULE `a:num <= b /\ c <= d ==> a + c <= b + d + e`) THEN ASM_SIMP_TAC[EXP_2; LE_MULT2]);; let CANTOR_LEMMA = prove (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, MESON_TAC[LT_CASES; LT_REFL; CANTOR_LEMMA_LEMMA]);; let CANTOR_INJ = prove (`!w z. cantor w = cantor z ==> w = z`, REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP CANTOR_LEMMA th)) THEN ASM_REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN REWRITE_TAC[ARITH_RULE `(a + b + 2 * x) DIV 2 = (a + b) DIV 2 + x`] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let CANTOR_THM = prove (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, REWRITE_TAC[INJECTIVE_IFF_LEFT_INVERSE; FUN_EQ_THM; I_DEF; o_DEF] THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN MESON_TAC[]);; (* ========================================================================= *) (* Inductive datatypes *) (* ========================================================================= *) let line_INDUCT,line_RECURSION = define_type "line = Line_1 | Line_2 | Line_3 | Line_4 | Line_5 | Line_6 | Line_7";; let point_INDUCT,point_RECURSION = define_type "point = Point_1 | Point_2 | Point_3 | Point_4 | Point_5 | Point_6 | Point_7";; let fano_incidence = [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; let fano_point i = mk_const("Point_"^string_of_int i,[]);; let fano_line i = mk_const("Line_"^string_of_int i,[]);; let p = `p:point` and l = `l:line` ;; let fano_clause (i,j) = mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; parse_as_infix("ON",(11,"right"));; let ON = new_definition (mk_eq(`((ON):point->line->bool) p l`, list_mk_disj(map fano_clause fano_incidence)));; let ON_CLAUSES = prove (list_mk_conj(allpairs (fun i j -> mk_eq(mk_comb(mk_comb(`(ON)`,fano_point i),fano_line j), if mem (i,j) fano_incidence then `T` else `F`)) (1--7) (1--7)), REWRITE_TAC[ON; distinctness "line"; distinctness "point"]);; let FORALL_POINT = prove (`(!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ P Point_5 /\ P Point_6 /\ P Point_7`, EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[point_INDUCT]]);; let FORALL_LINE = prove (`(!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ P Line_5 /\ P Line_6 /\ P Line_7`, EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[line_INDUCT]]);; let EXISTS_POINT = prove (`(?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ P Point_5 \/ P Point_6 \/ P Point_7`, MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_POINT]);; let EXISTS_LINE = prove (`(?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ P Line_5 \/ P Line_6 \/ P Line_7`, MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_LINE]);; let FANO_TAC = GEN_REWRITE_TAC DEPTH_CONV [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN GEN_REWRITE_TAC DEPTH_CONV (basic_rewrites() @ [ON_CLAUSES; distinctness "point"; distinctness "line"]);; let FANO_RULE tm = prove(tm,FANO_TAC);; let AXIOM_1 = FANO_RULE `!p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ !l'. p ON l' /\ p' ON l' ==> l' = l`;; let AXIOM_2 = FANO_RULE `!l l'. ?p. p ON l /\ p ON l'`;; let AXIOM_3 = FANO_RULE `?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l)`;; let AXIOM_4 = FANO_RULE `!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON l /\ p' ON l /\ p'' ON l`;; (* ========================================================================= *) (* Semantics of programming languages *) (* ========================================================================= *) let string_INDUCT,string_RECURSION = define_type "string = String (int list)";; let expression_INDUCT,expression_RECURSION = define_type "expression = Literal num | Variable string | Plus expression expression | Times expression expression";; let command_INDUCT,command_RECURSION = define_type "command = Assign string expression | Sequence command command | If expression command command | While expression command";; parse_as_infix(";;",(18,"right"));; parse_as_infix(":=",(20,"right"));; override_interface(";;",`Sequence`);; override_interface(":=",`Assign`);; overload_interface("+",`Plus`);; overload_interface("*",`Times`);; let value = define `(value (Literal n) s = n) /\ (value (Variable x) s = s(x)) /\ (value (e1 + e2) s = value e1 s + value e2 s) /\ (value (e1 * e2) s = value e1 s * value e2 s)`;; let sem_RULES,sem_INDUCT,sem_CASES = new_inductive_definition `(!x e s s'. s'(x) = value e s /\ (!y. ~(y = x) ==> s'(y) = s(y)) ==> sem (x := e) s s') /\ (!c1 c2 s s' s''. sem(c1) s s' /\ sem(c2) s' s'' ==> sem(c1 ;; c2) s s'') /\ (!e c1 c2 s s'. ~(value e s = 0) /\ sem(c1) s s' ==> sem(If e c1 c2) s s') /\ (!e c1 c2 s s'. value e s = 0 /\ sem(c2) s s' ==> sem(If e c1 c2) s s') /\ (!e c s. value e s = 0 ==> sem(While e c) s s) /\ (!e c s s' s''. ~(value e s = 0) /\ sem(c) s s' /\ sem(While e c) s' s'' ==> sem(While e c) s s'')`;; (**** Fails define `sem(While e c) s s' <=> if value e s = 0 then (s' = s) else ?s''. sem c s s'' /\ sem(While e c) s'' s'`;; ****) let DETERMINISM = prove (`!c s s' s''. sem c s s' /\ sem c s s'' ==> (s' = s'')`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC sem_INDUCT THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[sem_CASES] THEN REWRITE_TAC[distinctness "command"; injectivity "command"] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);; let wlp = new_definition `wlp c q s <=> !s'. sem c s s' ==> q s'`;; let terminates = new_definition `terminates c s <=> ?s'. sem c s s'`;; let wp = new_definition `wp c q s <=> terminates c s /\ wlp c q s`;; let WP_TOTAL = prove (`!c. (wp c EMPTY = EMPTY)`, REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; EMPTY] THEN MESON_TAC[]);; let WP_MONOTONIC = prove (`q SUBSET r ==> wp c q SUBSET wp c r`, REWRITE_TAC[SUBSET; IN; wp; wlp; terminates] THEN MESON_TAC[]);; let WP_DISJUNCTIVE = prove (`(wp c p) UNION (wp c q) = wp c (p UNION q)`, REWRITE_TAC[FUN_EQ_THM; IN; wp; wlp; IN_ELIM_THM; UNION; terminates] THEN MESON_TAC[DETERMINISM]);; let WP_SEQ = prove (`!c1 c2 q. wp (c1 ;; c2) = wp c1 o wp c2`, REWRITE_TAC[wp; wlp; terminates; FUN_EQ_THM; o_THM] THEN REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sem_CASES] THEN REWRITE_TAC[injectivity "command"; distinctness "command"] THEN MESON_TAC[DETERMINISM]);; let correct = new_definition `correct p c q <=> p SUBSET (wp c q)`;; let CORRECT_PRESTRENGTH = prove (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, REWRITE_TAC[correct; SUBSET_TRANS]);; let CORRECT_POSTWEAK = prove (`!p c q q'. correct p c q' /\ q' SUBSET q ==> correct p c q`, REWRITE_TAC[correct] THEN MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; let CORRECT_SEQ = prove (`!p q r c1 c2. correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; c2) q`, REWRITE_TAC[correct; WP_SEQ; o_THM] THEN MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; (* ------------------------------------------------------------------------- *) (* Need a fresh HOL session here; now doing shallow embedding. *) (* ------------------------------------------------------------------------- *) let assign = new_definition `Assign (f:S->S) (q:S->bool) = q o f`;; parse_as_infix(";;",(18,"right"));; let sequence = new_definition `(c1:(S->bool)->(S->bool)) ;; (c2:(S->bool)->(S->bool)) = c1 o c2`;; let if_def = new_definition `If e (c:(S->bool)->(S->bool)) q = {s | if e s then c q s else q s}`;; let ite_def = new_definition `Ite e (c1:(S->bool)->(S->bool)) c2 q = {s | if e s then c1 q s else c2 q s}`;; let while_RULES,while_INDUCT,while_CASES = new_inductive_definition `!q s. If e (c ;; while e c) q s ==> while e c q s`;; let while_def = new_definition `While e c q = {s | !w. (!s:S. (if e(s) then c w s else q s) ==> w s) ==> w s}`;; let monotonic = new_definition `monotonic c <=> !q q'. q SUBSET q' ==> (c q) SUBSET (c q')`;; let MONOTONIC_ASSIGN = prove (`monotonic (Assign f)`, SIMP_TAC[monotonic; assign; SUBSET; o_THM; IN]);; let MONOTONIC_IF = prove (`monotonic c ==> monotonic (If e c)`, REWRITE_TAC[monotonic; if_def] THEN SET_TAC[]);; let MONOTONIC_ITE = prove (`monotonic c1 /\ monotonic c2 ==> monotonic (Ite e c1 c2)`, REWRITE_TAC[monotonic; ite_def] THEN SET_TAC[]);; let MONOTONIC_SEQ = prove (`monotonic c1 /\ monotonic c2 ==> monotonic (c1 ;; c2)`, REWRITE_TAC[monotonic; sequence; o_THM] THEN SET_TAC[]);; let MONOTONIC_WHILE = prove (`monotonic c ==> monotonic(While e c)`, REWRITE_TAC[monotonic; while_def] THEN SET_TAC[]);; let WHILE_THM = prove (`!e c q:S->bool. monotonic c ==> (!s. If e (c ;; While e c) q s ==> While e c q s) /\ (!w'. (!s. If e (c ;; (\q. w')) q s ==> w' s) ==> (!a. While e c q a ==> w' a)) /\ (!s. While e c q s <=> If e (c ;; While e c) q s)`, REPEAT GEN_TAC THEN DISCH_TAC THEN (MP_TAC o GEN_ALL o DISCH_ALL o derive_nonschematic_inductive_relations) `!s:S. (if e s then c w s else q s) ==> w s` THEN REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[FUN_EQ_THM; while_def; IN_ELIM_THM] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[monotonic] THEN SET_TAC[]);; let WHILE_FIX = prove (`!e c. monotonic c ==> (While e c = If e (c ;; While e c))`, REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[WHILE_THM]);; let correct = new_definition `correct p c q <=> p SUBSET (c q)`;; let CORRECT_PRESTRENGTH = prove (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, REWRITE_TAC[correct; SUBSET_TRANS]);; let CORRECT_POSTWEAK = prove (`!p c q q'. monotonic c /\ correct p c q' /\ q' SUBSET q ==> correct p c q`, REWRITE_TAC[correct; monotonic] THEN SET_TAC[]);; let CORRECT_ASSIGN = prove (`!p f q. (p SUBSET (q o f)) ==> correct p (Assign f) q`, REWRITE_TAC[correct; assign]);; let CORRECT_SEQ = prove (`!p q r c1 c2. monotonic c1 /\ correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; c2) q`, REWRITE_TAC[correct; sequence; monotonic; o_THM] THEN SET_TAC[]);; let CORRECT_ITE = prove (`!p e c1 c2 q. correct (p INTER e) c1 q /\ correct (p INTER (UNIV DIFF e)) c2 q ==> correct p (Ite e c1 c2) q`, REWRITE_TAC[correct; ite_def] THEN SET_TAC[]);; let CORRECT_IF = prove (`!p e c q. correct (p INTER e) c q /\ p INTER (UNIV DIFF e) SUBSET q ==> correct p (If e c) q`, REWRITE_TAC[correct; if_def] THEN SET_TAC[]);; let CORRECT_WHILE = prove (`!(<<) p c q e invariant. monotonic c /\ WF(<<) /\ p SUBSET invariant /\ (UNIV DIFF e) INTER invariant SUBSET q /\ (!X:S. correct (invariant INTER e INTER (\s. X = s)) c (invariant INTER (\s. s << X))) ==> correct p (While e c) q`, REWRITE_TAC[correct; SUBSET; IN_INTER; IN_UNIV; IN_DIFF; IN] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!s:S. invariant s ==> While e c q s` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND]) THEN X_GEN_TAC `s:S` THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP WHILE_FIX th]) THEN REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM] THEN COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`s:S`; `s:S`]) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [monotonic]) THEN REWRITE_TAC[SUBSET; IN; RIGHT_IMP_FORALL_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[INTER; IN_ELIM_THM; IN]);; let assert_def = new_definition `assert (p:S->bool) (q:S->bool) = q`;; let variant_def = new_definition `variant ((<<):S->S->bool) (q:S->bool) = q`;; let CORRECT_SEQ_VC = prove (`!p q r c1 c2. monotonic c1 /\ correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; assert r ;; c2) q`, REWRITE_TAC[correct; sequence; monotonic; assert_def; o_THM] THEN SET_TAC[]);; let CORRECT_WHILE_VC = prove (`!(<<) p c q e invariant. monotonic c /\ WF(<<) /\ p SUBSET invariant /\ (UNIV DIFF e) INTER invariant SUBSET q /\ (!X:S. correct (invariant INTER e INTER (\s. X = s)) c (invariant INTER (\s. s << X))) ==> correct p (While e (assert invariant ;; variant(<<) ;; c)) q`, REPEAT STRIP_TAC THEN REWRITE_TAC[sequence; variant_def; assert_def; o_DEF; ETA_AX] THEN ASM_MESON_TAC[CORRECT_WHILE]);; let MONOTONIC_ASSERT = prove (`monotonic (assert p)`, REWRITE_TAC[assert_def; monotonic]);; let MONOTONIC_VARIANT = prove (`monotonic (variant p)`, REWRITE_TAC[variant_def; monotonic]);; let MONO_TAC = REPEAT(MATCH_MP_TAC MONOTONIC_WHILE ORELSE (MAP_FIRST MATCH_MP_TAC [MONOTONIC_SEQ; MONOTONIC_IF; MONOTONIC_ITE] THEN CONJ_TAC)) THEN MAP_FIRST MATCH_ACCEPT_TAC [MONOTONIC_ASSIGN; MONOTONIC_ASSERT; MONOTONIC_VARIANT];; let VC_TAC = FIRST [MATCH_MP_TAC CORRECT_SEQ_VC THEN CONJ_TAC THENL [MONO_TAC; CONJ_TAC]; MATCH_MP_TAC CORRECT_ITE THEN CONJ_TAC; MATCH_MP_TAC CORRECT_IF THEN CONJ_TAC; MATCH_MP_TAC CORRECT_WHILE_VC THEN REPEAT CONJ_TAC THENL [MONO_TAC; TRY(MATCH_ACCEPT_TAC WF_MEASURE); ALL_TAC; ALL_TAC; REWRITE_TAC[FORALL_PAIR_THM; MEASURE] THEN REPEAT GEN_TAC]; MATCH_MP_TAC CORRECT_ASSIGN];; needs "Library/prime.ml";; (* ------------------------------------------------------------------------- *) (* x = m, y = n; *) (* while (!(x == 0 || y == 0)) *) (* { if (x < y) y = y - x; *) (* else x = x - y; *) (* } *) (* if (x == 0) x = y; *) (* ------------------------------------------------------------------------- *) g `correct (\(m,n,x,y). T) (Assign (\(m,n,x,y). m,n,m,n) ;; // x,y := m,n assert (\(m,n,x,y). x = m /\ y = n) ;; While (\(m,n,x,y). ~(x = 0 \/ y = 0)) (assert (\(m,n,x,y). gcd(x,y) = gcd(m,n)) ;; variant(MEASURE(\(m,n,x,y). x + y)) ;; Ite (\(m,n,x,y). x < y) (Assign (\(m,n,x,y). m,n,x,y - x)) (Assign (\(m,n,x,y). m,n,x - y,y))) ;; assert (\(m,n,x,y). (x = 0 \/ y = 0) /\ gcd(x,y) = gcd(m,n)) ;; If (\(m,n,x,y). x = 0) (Assign (\(m,n,x,y). (m,n,y,y)))) (\(m,n,x,y). gcd(m,n) = x)`;; e(REPEAT VC_TAC);; b();; e(REPEAT VC_TAC THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:num`; `y:num`] THEN REWRITE_TAC[IN; INTER; UNIV; DIFF; o_DEF; IN_ELIM_THM; PAIR_EQ] THEN CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN SIMP_TAC[]);; e(SIMP_TAC[GCD_SUB; LT_IMP_LE]);; e ARITH_TAC;; e(SIMP_TAC[GCD_SUB; NOT_LT] THEN ARITH_TAC);; e(MESON_TAC[GCD_0]);; e(MESON_TAC[GCD_0; GCD_SYM]);; parse_as_infix("refines",(12,"right"));; let refines = new_definition `c2 refines c1 <=> !q. c1(q) SUBSET c2(q)`;; let REFINES_REFL = prove (`!c. c refines c`, REWRITE_TAC[refines; SUBSET_REFL]);; let REFINES_TRANS = prove (`!c1 c2 c3. c3 refines c2 /\ c2 refines c1 ==> c3 refines c1`, REWRITE_TAC[refines] THEN MESON_TAC[SUBSET_TRANS]);; let REFINES_CORRECT = prove (`correct p c1 q /\ c2 refines c1 ==> correct p c2 q`, REWRITE_TAC[correct; refines] THEN MESON_TAC[SUBSET_TRANS]);; let REFINES_WHILE = prove (`c' refines c ==> While e c' refines While e c`, REWRITE_TAC[refines; while_def; SUBSET; IN_ELIM_THM; IN] THEN MESON_TAC[]);; let specification = new_definition `specification(p,q) r = if q SUBSET r then p else {}`;; let REFINES_SPECIFICATION = prove (`c refines specification(p,q) ==> correct p c q`, REWRITE_TAC[specification; correct; refines] THEN MESON_TAC[SUBSET_REFL; SUBSET_EMPTY]);; (* ========================================================================= *) (* Number theory *) (* ========================================================================= *) needs "Library/prime.ml";; needs "Library/pocklington.ml";; needs "Library/binomial.ml";; prioritize_num();; let FERMAT_PRIME_CONV n = let tm = subst [mk_small_numeral n,`x:num`] `prime(2 EXP (2 EXP x) + 1)` in (RAND_CONV NUM_REDUCE_CONV THENC PRIME_CONV) tm;; FERMAT_PRIME_CONV 0;; FERMAT_PRIME_CONV 1;; FERMAT_PRIME_CONV 2;; FERMAT_PRIME_CONV 3;; FERMAT_PRIME_CONV 4;; FERMAT_PRIME_CONV 5;; FERMAT_PRIME_CONV 6;; FERMAT_PRIME_CONV 7;; FERMAT_PRIME_CONV 8;; let CONG_TRIVIAL = prove (`!x y. n divides x /\ n divides y ==> (x == y) (mod n)`, MESON_TAC[CONG_0; CONG_SYM; CONG_TRANS]);; let LITTLE_CHECK_CONV tm = EQT_ELIM((RATOR_CONV(LAND_CONV NUM_EXP_CONV) THENC CONG_CONV) tm);; LITTLE_CHECK_CONV `(9 EXP 8 == 9) (mod 3)`;; LITTLE_CHECK_CONV `(9 EXP 3 == 9) (mod 3)`;; LITTLE_CHECK_CONV `(10 EXP 7 == 10) (mod 7)`;; LITTLE_CHECK_CONV `(2 EXP 7 == 2) (mod 7)`;; LITTLE_CHECK_CONV `(777 EXP 13 == 777) (mod 13)`;; let DIVIDES_FACT_PRIME = prove (`!p. prime p ==> !n. p divides (FACT n) <=> p <= n`, GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL [ASM_MESON_TAC[DIVIDES_ONE; PRIME_0; PRIME_1]; ASM_MESON_TAC[PRIME_DIVPROD_EQ; DIVIDES_LE; NOT_SUC; DIVIDES_REFL; ARITH_RULE `~(p <= n) /\ p <= SUC n ==> p = SUC n`]]);; let DIVIDES_BINOM_PRIME = prove (`!n p. prime p /\ 0 < n /\ n < p ==> p divides binom(p,n)`, REPEAT STRIP_TAC THEN MP_TAC(AP_TERM `(divides) p` (SPECL [`p - n`; `n:num`] BINOM_FACT)) THEN ASM_SIMP_TAC[DIVIDES_FACT_PRIME; PRIME_DIVPROD_EQ; SUB_ADD; LT_IMP_LE] THEN ASM_REWRITE_TAC[GSYM NOT_LT; LT_REFL] THEN ASM_SIMP_TAC[ARITH_RULE `0 < n /\ n < p ==> p - n < p`]);; let DIVIDES_NSUM = prove (`!m n. (!i. m <= i /\ i <= n ==> p divides f(i)) ==> p divides nsum(m..n) f`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ASM_MESON_TAC[LE; LE_TRANS; DIVIDES_0; DIVIDES_ADD; LE_REFL]);; let FLT_LEMMA = prove (`!p a b. prime p ==> ((a + b) EXP p == a EXP p + b EXP p) (mod p)`, REPEAT STRIP_TAC THEN REWRITE_TAC[BINOMIAL_THEOREM] THEN SUBGOAL_THEN `1 <= p /\ 0 < p` STRIP_ASSUME_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC; ALL_TAC] THEN ASM_SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0; ARITH; NSUM_CLAUSES_RIGHT] THEN REWRITE_TAC[SUB_0; SUB_REFL; EXP; binom; BINOM_REFL; MULT_CLAUSES] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a + b = (b + 0) + a`] THEN REPEAT(MATCH_MP_TAC CONG_ADD THEN REWRITE_TAC[CONG_REFL]) THEN REWRITE_TAC[CONG_0] THEN MATCH_MP_TAC DIVIDES_NSUM THEN ASM_MESON_TAC[DIVIDES_RMUL; DIVIDES_BINOM_PRIME; ARITH_RULE `0 < p /\ 1 <= i /\ i <= p - 1 ==> 0 < i /\ i < p`]);; let FERMAT_LITTLE = prove (`!p a. prime p ==> (a EXP p == a) (mod p)`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THENL [ASM_MESON_TAC[EXP_EQ_0; CONG_REFL; PRIME_0]; ASM_MESON_TAC[ADD1; FLT_LEMMA; EXP_ONE; CONG_ADD; CONG_TRANS; CONG_REFL]]);; let FERMAT_LITTLE_COPRIME = prove (`!p a. prime p /\ coprime(a,p) ==> (a EXP (p - 1) == 1) (mod p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN ASM_SIMP_TAC[PRIME_IMP_NZ; ARITH_RULE `~(p = 0) ==> SUC(p - 1) = p`] THEN ASM_SIMP_TAC[FERMAT_LITTLE; MULT_CLAUSES]);; let FERMAT_LITTLE_VARIANT = prove (`!p a. prime p ==> (a EXP (1 + m * (p - 1)) == a) (mod p)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME_STRONG) THENL [ASM_MESON_TAC[CONG_TRIVIAL; ADD_AC; ADD1; DIVIDES_REXP_SUC]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN REWRITE_TAC[EXP_ADD; EXP_1] THEN MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[GSYM EXP_EXP; CONG_REFL] THEN ASM_MESON_TAC[COPRIME_SYM; COPRIME_EXP; PHI_PRIME; FERMAT_LITTLE_COPRIME]);; let RSA = prove (`prime p /\ prime q /\ ~(p = q) /\ (d * e == 1) (mod ((p - 1) * (q - 1))) /\ plaintext < p * q /\ (ciphertext = (plaintext EXP e) MOD (p * q)) ==> (plaintext = (ciphertext EXP d) MOD (p * q))`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MOD_EXP_MOD; MULT_EQ_0; PRIME_IMP_NZ; EXP_EXP] THEN SUBGOAL_THEN `(plaintext == plaintext EXP (e * d)) (mod (p * q))` MP_TAC THENL [ALL_TAC; ASM_SIMP_TAC[CONG; MULT_EQ_0; PRIME_IMP_NZ; MOD_LT]] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [CONG_TO_1]) THENL [ASM_MESON_TAC[MULT_EQ_1; ARITH_RULE `p - 1 = 1 <=> p = 2`]; ALL_TAC] THEN MATCH_MP_TAC CONG_CHINESE THEN ASM_SIMP_TAC[DISTINCT_PRIME_COPRIME] THEN ASM_MESON_TAC[FERMAT_LITTLE_VARIANT; MULT_AC; CONG_SYM]);; (* ========================================================================= *) (* Real analysis *) (* ========================================================================= *) needs "Library/analysis.ml";; needs "Library/transc.ml";; let cheb = define `(!x. cheb 0 x = &1) /\ (!x. cheb 1 x = x) /\ (!n x. cheb (n + 2) x = &2 * x * cheb (n + 1) x - cheb n x)`;; let CHEB_INDUCT = prove (`!P. P 0 /\ P 1 /\ (!n. P n /\ P(n + 1) ==> P(n + 2)) ==> !n. P n`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN ASM_SIMP_TAC[ARITH]);; let CHEB_COS = prove (`!n x. cheb n (cos x) = cos(&n * x)`, MATCH_MP_TAC CHEB_INDUCT THEN REWRITE_TAC[cheb; REAL_MUL_LZERO; REAL_MUL_LID; COS_0] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_MUL_LID; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[COS_ADD; COS_DOUBLE; SIN_DOUBLE] THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; let CHEB_RIPPLE = prove (`!x. abs(x) <= &1 ==> abs(cheb n x) <= &1`, REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN MESON_TAC[CHEB_COS; ACS_COS; COS_BOUNDS]);; let NUM_ADD2_CONV = let add_tm = `(+):num->num->num` and two_tm = `2` in fun tm -> let m = mk_numeral(dest_numeral tm -/ Int 2) in let tm' = mk_comb(mk_comb(add_tm,m),two_tm) in SYM(NUM_ADD_CONV tm');; let CHEB_CONV = let [pth0;pth1;pth2] = CONJUNCTS cheb in let rec conv tm = (GEN_REWRITE_CONV I [pth0; pth1] ORELSEC (LAND_CONV NUM_ADD2_CONV THENC GEN_REWRITE_CONV I [pth2] THENC COMB2_CONV (funpow 3 RAND_CONV ((LAND_CONV NUM_ADD_CONV) THENC conv)) conv THENC REAL_POLY_CONV)) tm in conv;; CHEB_CONV `cheb 8 x`;; let CHEB_2N1 = prove (`!n x. ((x - &1) * (cheb (2 * n + 1) x - &1) = (cheb (n + 1) x - cheb n x) pow 2) /\ (&2 * (x pow 2 - &1) * (cheb (2 * n + 2) x - &1) = (cheb (n + 2) x - cheb n x) pow 2)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC CHEB_INDUCT THEN REWRITE_TAC[ARITH; cheb; CHEB_2; CHEB_3] THEN REPEAT(CHANGED_TAC (REWRITE_TAC[GSYM ADD_ASSOC; LEFT_ADD_DISTRIB; ARITH] THEN REWRITE_TAC[ARITH_RULE `n + 5 = (n + 3) + 2`; ARITH_RULE `n + 4 = (n + 2) + 2`; ARITH_RULE `n + 3 = (n + 1) + 2`; cheb])) THEN CONV_TAC REAL_RING);; let IVT_LEMMA1 = prove (`!f. (!x. f contl x) ==> !x y. f(x) <= &0 /\ &0 <= f(y) ==> ?x. f(x) = &0`, ASM_MESON_TAC[IVT; IVT2; REAL_LE_TOTAL]);; let IVT_LEMMA2 = prove (`!f. (!x. f contl x) /\ (?x. f(x) <= x) /\ (?y. y <= f(y)) ==> ?x. f(x) = x`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. f x - x` IVT_LEMMA1) THEN ASM_SIMP_TAC[CONT_SUB; CONT_X] THEN SIMP_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD; REAL_SUB_0; REAL_ADD_LID] THEN ASM_MESON_TAC[]);; let SARKOVSKII_TRIVIAL = prove (`!f:real->real. (!x. f contl x) /\ (?x. f(f(f(x))) = x) ==> ?x. f(x) = x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_LEMMA2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC (MESON[] `P x \/ P (f x) \/ P (f(f x)) ==> ?x:real. P x`) THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN REAL_ARITH_TAC);; (* ========================================================================= *) (* Embedding of logics *) (* ========================================================================= *) let string_INDUCT,string_RECURSION = define_type "string = String num";; parse_as_infix("&&",(16,"right"));; parse_as_infix("||",(15,"right"));; parse_as_infix("-->",(14,"right"));; parse_as_infix("<->",(13,"right"));; parse_as_prefix "Not";; parse_as_prefix "Box";; parse_as_prefix "Diamond";; let form_INDUCT,form_RECURSION = define_type "form = False | True | Atom string | Not form | && form form | || form form | --> form form | <-> form form | Box form | Diamond form";; let holds = define `(holds (W,R) V False w <=> F) /\ (holds (W,R) V True w <=> T) /\ (holds (W,R) V (Atom a) w <=> V a w) /\ (holds (W,R) V (Not p) w <=> ~(holds (W,R) V p w)) /\ (holds (W,R) V (p && q) w <=> holds (W,R) V p w /\ holds (W,R) V q w) /\ (holds (W,R) V (p || q) w <=> holds (W,R) V p w \/ holds (W,R) V q w) /\ (holds (W,R) V (p --> q) w <=> holds (W,R) V p w ==> holds (W,R) V q w) /\ (holds (W,R) V (p <-> q) w <=> holds (W,R) V p w <=> holds (W,R) V q w) /\ (holds (W,R) V (Box p) w <=> !w'. w' IN W /\ R w w' ==> holds (W,R) V p w') /\ (holds (W,R) V (Diamond p) w <=> ?w'. w' IN W /\ R w w' /\ holds (W,R) V p w')`;; let holds_in = new_definition `holds_in (W,R) p = !V w. w IN W ==> holds (W,R) V p w`;; parse_as_infix("|=",(11,"right"));; let valid = new_definition `L |= p <=> !f. L f ==> holds_in f p`;; let S4 = new_definition `S4(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ (!x. x IN W ==> R x x) /\ (!x y z. R x y /\ R y z ==> R x z)`;; let LTL = new_definition `LTL(W,R) <=> (W = UNIV) /\ !x y:num. R x y <=> x <= y`;; let GL = new_definition `GL(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ WF(\x y. R y x) /\ (!x y z:num. R x y /\ R y z ==> R x z)`;; let MODAL_TAC = REWRITE_TAC[valid; FORALL_PAIR_THM; holds_in; holds] THEN MESON_TAC[];; let MODAL_RULE tm = prove(tm,MODAL_TAC);; let TAUT_1 = MODAL_RULE `L |= Box True`;; let TAUT_2 = MODAL_RULE `L |= Box(A --> B) --> Box A --> Box B`;; let TAUT_3 = MODAL_RULE `L |= Diamond(A --> B) --> Box A --> Diamond B`;; let TAUT_4 = MODAL_RULE `L |= Box(A --> B) --> Diamond A --> Diamond B`;; let TAUT_5 = MODAL_RULE `L |= Box(A && B) --> Box A && Box B`;; let TAUT_6 = MODAL_RULE `L |= Diamond(A || B) --> Diamond A || Diamond B`;; let HOLDS_FORALL_LEMMA = prove (`!W R P. (!A V. P(holds (W,R) V A)) <=> (!p:W->bool. P p)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC; SIMP_TAC[]] THEN POP_ASSUM(MP_TAC o SPECL [`Atom a`; `\a:string. (p:W->bool)`]) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[holds] THEN REWRITE_TAC[ETA_AX]);; let MODAL_SCHEMA_TAC = REWRITE_TAC[holds_in; holds] THEN MP_TAC HOLDS_FORALL_LEMMA THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]);; let MODAL_REFL = prove (`!W R. (!w:W. w IN W ==> R w w) <=> !A. holds_in (W,R) (Box A --> A)`, MODAL_SCHEMA_TAC THEN MESON_TAC[]);; let MODAL_TRANS = prove (`!W R. (!w w' w'':W. w IN W /\ w' IN W /\ w'' IN W /\ R w w' /\ R w' w'' ==> R w w'') <=> (!A. holds_in (W,R) (Box A --> Box(Box A)))`, MODAL_SCHEMA_TAC THEN MESON_TAC[]);; let MODAL_SERIAL = prove (`!W R. (!w:W. w IN W ==> ?w'. w' IN W /\ R w w') <=> (!A. holds_in (W,R) (Box A --> Diamond A))`, MODAL_SCHEMA_TAC THEN MESON_TAC[]);; let MODAL_SYM = prove (`!W R. (!w w':W. w IN W /\ w' IN W /\ R w w' ==> R w' w) <=> (!A. holds_in (W,R) (A --> Box(Diamond A)))`, MODAL_SCHEMA_TAC THEN EQ_TAC THENL [MESON_TAC[]; REPEAT STRIP_TAC] THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\v:W. v = w`; `w:W`]) THEN ASM_MESON_TAC[]);; let MODAL_WFTRANS = prove (`!W R. (!x y z:W. x IN W /\ y IN W /\ z IN W /\ R x y /\ R y z ==> R x z) /\ WF(\x y. x IN W /\ y IN W /\ R y x) <=> (!A. holds_in (W,R) (Box(Box A --> A) --> Box A))`, MODAL_SCHEMA_TAC THEN REWRITE_TAC[WF_IND] THEN EQ_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL [REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; X_GEN_TAC `w:W` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`\v:W. v IN W /\ R w v /\ !w''. w'' IN W /\ R v w'' ==> R w w''`; `w:W`]); X_GEN_TAC `P:W->bool` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:W. !w:W. x IN W /\ R w x ==> P x`) THEN MATCH_MP_TAC MONO_FORALL] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Need a fresh HOL session here: doing shallow embedding. *) (* ------------------------------------------------------------------------- *) parse_as_prefix "Not";; parse_as_infix("&&",(16,"right"));; parse_as_infix("||",(15,"right"));; parse_as_infix("-->",(14,"right"));; parse_as_infix("<->",(13,"right"));; let false_def = define `False = \t:num. F`;; let true_def = define `True = \t:num. T`;; let not_def = define `Not p = \t:num. ~(p t)`;; let and_def = define `p && q = \t:num. p t /\ q t`;; let or_def = define `p || q = \t:num. p t \/ q t`;; let imp_def = define `p --> q = \t:num. p t ==> q t`;; let iff_def = define `p <-> q = \t:num. p t <=> q t`;; let forever = define `forever p = \t:num. !t'. t <= t' ==> p t'`;; let sometime = define `sometime p = \t:num. ?t'. t <= t' /\ p t'`;; let next = define `next p = \t:num. p(t + 1)`;; parse_as_infix("until",(17,"right"));; let until = define `p until q = \t:num. ?t'. t <= t' /\ (!t''. t <= t'' /\ t'' < t' ==> p t'') /\ q t'`;; (* ========================================================================= *) (* HOL as a functional programming language *) (* ========================================================================= *) type ite = False | True | Atomic of int | Ite of ite*ite*ite;; let rec norm e = match e with Ite(False,y,z) -> norm z | Ite(True,y,z) -> norm y | Ite(Atomic i,y,z) -> Ite(Atomic i,norm y,norm z) | Ite(Ite(u,v,w),y,z) -> norm(Ite(u,Ite(v,y,z),Ite(w,y,z))) | _ -> e;; let ite_INDUCT,ite_RECURSION = define_type "ite = False | True | Atomic num | Ite ite ite ite";; let eth = prove_general_recursive_function_exists `?norm. (norm False = False) /\ (norm True = True) /\ (!i. norm (Atomic i) = Atomic i) /\ (!y z. norm (Ite False y z) = norm z) /\ (!y z. norm (Ite True y z) = norm y) /\ (!i y z. norm (Ite (Atomic i) y z) = Ite (Atomic i) (norm y) (norm z)) /\ (!u v w y z. norm (Ite (Ite u v w) y z) = norm (Ite u (Ite v y z) (Ite w y z)))`;; let sizeof = define `(sizeof False = 1) /\ (sizeof True = 1) /\ (sizeof(Atomic i) = 1) /\ (sizeof(Ite x y z) = sizeof x * (1 + sizeof y + sizeof z))`;; let eth' = let th = prove (hd(hyp eth), EXISTS_TAC `MEASURE sizeof` THEN REWRITE_TAC[WF_MEASURE; MEASURE_LE; MEASURE; sizeof] THEN ARITH_TAC) in PROVE_HYP th eth;; let norm = new_specification ["norm"] eth';; let SIZEOF_INDUCT = REWRITE_RULE[WF_IND; MEASURE] (ISPEC`sizeof` WF_MEASURE);; let SIZEOF_NZ = prove (`!e. ~(sizeof e = 0)`, MATCH_MP_TAC ite_INDUCT THEN SIMP_TAC[sizeof; ADD_EQ_0; MULT_EQ_0; ARITH]);; let ITE_INDUCT = prove (`!P. P False /\ P True /\ (!i. P(Atomic i)) /\ (!y z. P z ==> P(Ite False y z)) /\ (!y z. P y ==> P(Ite True y z)) /\ (!i y z. P y /\ P z ==> P (Ite (Atomic i) y z)) /\ (!u v w x y z. P(Ite u (Ite v y z) (Ite w y z)) ==> P(Ite (Ite u v w) y z)) ==> !e. P e`, GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SIZEOF_INDUCT THEN MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ite_INDUCT THEN POP_ASSUM_LIST (fun ths -> REPEAT STRIP_TAC THEN FIRST(mapfilter MATCH_MP_TAC ths)) THEN REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[sizeof] THEN TRY ARITH_TAC THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[MULT_AC; ADD_AC; LT_ADD_LCANCEL] THEN REWRITE_TAC[ADD_ASSOC; LT_ADD_RCANCEL] THEN MATCH_MP_TAC(ARITH_RULE `~(b = 0) /\ ~(c = 0) ==> a < (b + a) + c`) THEN REWRITE_TAC[MULT_EQ_0; SIZEOF_NZ]);; let normalized = define `(normalized False <=> T) /\ (normalized True <=> T) /\ (normalized(Atomic a) <=> T) /\ (normalized(Ite False x y) <=> F) /\ (normalized(Ite True x y) <=> F) /\ (normalized(Ite (Atomic a) x y) <=> normalized x /\ normalized y) /\ (normalized(Ite (Ite u v w) x y) <=> F)`;; let NORMALIZED_NORM = prove (`!e. normalized(norm e)`, MATCH_MP_TAC ITE_INDUCT THEN REWRITE_TAC[norm; normalized]);; let NORMALIZED_INDUCT = prove (`P False /\ P True /\ (!i. P (Atomic i)) /\ (!i x y. P x /\ P y ==> P (Ite (Atomic i) x y)) ==> !e. normalized e ==> P e`, STRIP_TAC THEN MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[normalized] THEN MATCH_MP_TAC ite_INDUCT THEN ASM_MESON_TAC[normalized]);; let holds = define `(holds v False <=> F) /\ (holds v True <=> T) /\ (holds v (Atomic i) <=> v(i)) /\ (holds v (Ite b x y) <=> if holds v b then holds v x else holds v y)`;; let HOLDS_NORM = prove (`!e v. holds v (norm e) <=> holds v e`, MATCH_MP_TAC ITE_INDUCT THEN SIMP_TAC[holds; norm] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let taut = define `(taut (t,f) False <=> F) /\ (taut (t,f) True <=> T) /\ (taut (t,f) (Atomic i) <=> MEM i t) /\ (taut (t,f) (Ite (Atomic i) x y) <=> if MEM i t then taut (t,f) x else if MEM i f then taut (t,f) y else taut (CONS i t,f) x /\ taut (t,CONS i f) y)`;; let tautology = define `tautology e = taut([],[]) (norm e)`;; let NORMALIZED_TAUT = prove (`!e. normalized e ==> !f t. (!a. ~(MEM a t /\ MEM a f)) ==> (taut (t,f) e <=> !v. (!a. MEM a t ==> v(a)) /\ (!a. MEM a f ==> ~v(a)) ==> holds v e)`, MATCH_MP_TAC NORMALIZED_INDUCT THEN REWRITE_TAC[holds; taut] THEN REWRITE_TAC[NOT_FORALL_THM] THEN REPEAT CONJ_TAC THENL [REPEAT STRIP_TAC THEN EXISTS_TAC `\a:num. MEM a t` THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN MATCH_MP_TAC] THEN ASM_MESON_TAC[]; REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[])] THEN ASM_SIMP_TAC[MEM; RIGHT_OR_DISTRIB; LEFT_OR_DISTRIB; MESON[] `(!a. ~(MEM a t /\ a = i)) <=> ~(MEM i t)`; MESON[] `(!a. ~(a = i /\ MEM a f)) <=> ~(MEM i f)`] THEN ASM_REWRITE_TAC[AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[]);; let TAUTOLOGY = prove (`!e. tautology e <=> !v. holds v e`, MESON_TAC[tautology; HOLDS_NORM; NORMALIZED_TAUT; MEM; NORMALIZED_NORM]);; let HOLDS_BACK = prove (`!v. (F <=> holds v False) /\ (T <=> holds v True) /\ (!i. v i <=> holds v (Atomic i)) /\ (!p. ~holds v p <=> holds v (Ite p False True)) /\ (!p q. (holds v p /\ holds v q) <=> holds v (Ite p q False)) /\ (!p q. (holds v p \/ holds v q) <=> holds v (Ite p True q)) /\ (!p q. (holds v p <=> holds v q) <=> holds v (Ite p q (Ite q False True))) /\ (!p q. holds v p ==> holds v q <=> holds v (Ite p q True))`, REWRITE_TAC[holds] THEN CONV_TAC TAUT);; let COND_CONV = GEN_REWRITE_CONV I [COND_CLAUSES];; let AND_CONV = GEN_REWRITE_CONV I [TAUT `(F /\ a <=> F) /\ (T /\ a <=> a)`];; let OR_CONV = GEN_REWRITE_CONV I [TAUT `(F \/ a <=> a) /\ (T \/ a <=> T)`];; let rec COMPUTE_DEPTH_CONV conv tm = if is_cond tm then (RATOR_CONV(LAND_CONV(COMPUTE_DEPTH_CONV conv)) THENC COND_CONV THENC COMPUTE_DEPTH_CONV conv) tm else if is_conj tm then (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC AND_CONV THENC COMPUTE_DEPTH_CONV conv) tm else if is_disj tm then (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC OR_CONV THENC COMPUTE_DEPTH_CONV conv) tm else (SUB_CONV (COMPUTE_DEPTH_CONV conv) THENC TRY_CONV(conv THENC COMPUTE_DEPTH_CONV conv)) tm;; g `!v. v 1 \/ v 2 \/ v 3 \/ v 4 \/ v 5 \/ v 6 \/ ~v 1 \/ ~v 2 \/ ~v 3 \/ ~v 4 \/ ~v 5 \/ ~v 6`;; e(MP_TAC HOLDS_BACK THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN SPEC_TAC(`v:num->bool`,`v:num->bool`) THEN REWRITE_TAC[GSYM TAUTOLOGY; tautology]);; time e (GEN_REWRITE_TAC COMPUTE_DEPTH_CONV [norm; taut; MEM; ARITH_EQ]);; ignore(b()); time e (REWRITE_TAC[norm; taut; MEM; ARITH_EQ]);; (* ========================================================================= *) (* Vectors *) (* ========================================================================= *) needs "Multivariate/vectors.ml";; needs "Examples/solovay.ml";; g `orthogonal (A - B) (C - B) ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`;; e SOLOVAY_VECTOR_TAC;; e(CONV_TAC REAL_RING);; g`!x y:real^N. x dot y <= norm x * norm y`;; e SOLOVAY_VECTOR_TAC;; (**** Needs external SDP solver needs "Examples/sos.ml";; e(CONV_TAC REAL_SOS);; let EXAMPLE_0 = prove (`!a x y:real^N. (y - x) dot (a - y) >= &0 ==> norm(y - a) <= norm(x - a)`, SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; ****) needs "Rqe/make.ml";; let EXAMPLE_10 = prove (`!x:real^N y. x dot y > &0 ==> ?u. &0 < u /\ !v. &0 < v /\ v <= u ==> norm(v % y - x) < norm x`, SOLOVAY_VECTOR_TAC THEN W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN CONV_TAC REAL_QELIM_CONV);; let FORALL_3 = prove (`(!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`, MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> (i = 1) \/ (i = 2) \/ (i = 3)`]);; let SUM_3 = prove (`!t. sum(1..3) t = t(1) + t(2) + t(3)`, REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; let VECTOR_3 = prove (`(vector [x;y;z] :real^3)$1 = x /\ (vector [x;y;z] :real^3)$2 = y /\ (vector [x;y;z] :real^3)$3 = z`, SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; LENGTH; ARITH] THEN REWRITE_TAC[num_CONV `2`; num_CONV `1`; EL; HD; TL]);; let DOT_VECTOR = prove (`(vector [x1;y1;z1] :real^3) dot (vector [x2;y2;z2]) = x1 * x2 + y1 * y2 + z1 * z2`, REWRITE_TAC[dot; DIMINDEX_3; SUM_3; VECTOR_3]);; let VECTOR_ZERO = prove (`(vector [x;y;z] :real^3 = vec 0) <=> x = &0 /\ y = &0 /\ z = &0`, SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT; VECTOR_3; ARITH]);; let ORTHOGONAL_VECTOR = prove (`orthogonal (vector [x1;y1;z1] :real^3) (vector [x2;y2;z2]) = (x1 * x2 + y1 * y2 + z1 * z2 = &0)`, REWRITE_TAC[orthogonal; DOT_VECTOR]);; parse_as_infix("cross",(20,"right"));; let cross = new_definition `(a:real^3) cross (b:real^3) = vector [a$2 * b$3 - a$3 * b$2; a$3 * b$1 - a$1 * b$3; a$1 * b$2 - a$2 * b$1] :real^3`;; let VEC3_TAC = SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_3; SUM_3; DIMINDEX_3; VECTOR_3; vector_add; vec; dot; cross; orthogonal; basis; ARITH] THEN CONV_TAC REAL_RING;; let VEC3_RULE tm = prove(tm,VEC3_TAC);; let ORTHOGONAL_CROSS = VEC3_RULE `!x y. orthogonal (x cross y) x /\ orthogonal (x cross y) y /\ orthogonal x (x cross y) /\ orthogonal y (x cross y)`;; let LEMMA_0 = VEC3_RULE `~(basis 1 :real^3 = vec 0) /\ ~(basis 2 :real^3 = vec 0) /\ ~(basis 3 :real^3 = vec 0)`;; let LEMMA_1 = VEC3_RULE `!u v. u dot (u cross v) = &0`;; let LEMMA_2 = VEC3_RULE `!u v. v dot (u cross v) = &0`;; let LEMMA_3 = VEC3_RULE `!u:real^3. vec 0 dot u = &0`;; let LEMMA_4 = VEC3_RULE `!u:real^3. u dot vec 0 = &0`;; let LEMMA_5 = VEC3_RULE `!x. x cross x = vec 0`;; let LEMMA_6 = VEC3_RULE `!u. ~(u = vec 0) ==> ~(u cross basis 1 = vec 0) \/ ~(u cross basis 2 = vec 0) \/ ~(u cross basis 3 = vec 0)`;; let LEMMA_7 = VEC3_RULE `!u v w. (u cross v = vec 0) ==> (u dot (v cross w) = &0)`;; let NORMAL_EXISTS = prove (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`u:real^3 = vec 0`; `v:real^3 = vec 0`; `u cross v = vec 0`] THEN ASM_REWRITE_TAC[orthogonal] THEN ASM_MESON_TAC[LEMMA_0; LEMMA_1; LEMMA_2; LEMMA_3; LEMMA_4; LEMMA_5; LEMMA_6; LEMMA_7]);; (* ========================================================================= *) (* Custom tactics *) (* ========================================================================= *) let points = [((0, -1), (0, -1), (2, 0)); ((0, -1), (0, 0), (2, 0)); ((0, -1), (0, 1), (2, 0)); ((0, -1), (2, 0), (0, -1)); ((0, -1), (2, 0), (0, 0)); ((0, -1), (2, 0), (0, 1)); ((0, 0), (0, -1), (2, 0)); ((0, 0), (0, 0), (2, 0)); ((0, 0), (0, 1), (2, 0)); ((0, 0), (2, 0), (-2, 0)); ((0, 0), (2, 0), (0, -1)); ((0, 0), (2, 0), (0, 0)); ((0, 0), (2, 0), (0, 1)); ((0, 0), (2, 0), (2, 0)); ((0, 1), (0, -1), (2, 0)); ((0, 1), (0, 0), (2, 0)); ((0, 1), (0, 1), (2, 0)); ((0, 1), (2, 0), (0, -1)); ((0, 1), (2, 0), (0, 0)); ((0, 1), (2, 0), (0, 1)); ((2, 0), (-2, 0), (0, 0)); ((2, 0), (0, -1), (0, -1)); ((2, 0), (0, -1), (0, 0)); ((2, 0), (0, -1), (0, 1)); ((2, 0), (0, 0), (-2, 0)); ((2, 0), (0, 0), (0, -1)); ((2, 0), (0, 0), (0, 0)); ((2, 0), (0, 0), (0, 1)); ((2, 0), (0, 0), (2, 0)); ((2, 0), (0, 1), (0, -1)); ((2, 0), (0, 1), (0, 0)); ((2, 0), (0, 1), (0, 1)); ((2, 0), (2, 0), (0, 0))];; let ortho = let mult (x1,y1) (x2,y2) = (x1 * x2 + 2 * y1 * y2,x1 * y2 + y1 * x2) and add (x1,y1) (x2,y2) = (x1 + x2,y1 + y2) in let dot (x1,y1,z1) (x2,y2,z2) = end_itlist add [mult x1 x2; mult y1 y2; mult z1 z2] in fun (v1,v2) -> dot v1 v2 = (0,0);; let opairs = filter ortho (allpairs (fun a b -> a,b) points points);; let otrips = filter (fun (a,b,c) -> ortho(a,b) && ortho(a,c)) (allpairs (fun a (b,c) -> a,b,c) points opairs);; let hol_of_value = let tm0 = `&0` and tm1 = `&2` and tm2 = `-- &2` and tm3 = `sqrt(&2)` and tm4 = `--sqrt(&2)` in function 0,0 -> tm0 | 2,0 -> tm1 | -2,0 -> tm2 | 0,1 -> tm3 | 0,-1 -> tm4;; let hol_of_point = let ptm = `vector:(real)list->real^3` in fun (x,y,z) -> mk_comb(ptm,mk_flist(map hol_of_value [x;y;z]));; let SQRT_2_POW = prove (`sqrt(&2) pow 2 = &2`, SIMP_TAC[SQRT_POW_2; REAL_POS]);; let PROVE_NONTRIVIAL = let ptm = `~(x :real^3 = vec 0)` and xtm = `x:real^3` in fun x -> prove(vsubst [hol_of_point x,xtm] ptm, GEN_REWRITE_TAC RAND_CONV [VECTOR_ZERO] THEN MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; let PROVE_ORTHOGONAL = let ptm = `orthogonal:real^3->real^3->bool` in fun (x,y) -> prove(list_mk_comb(ptm,[hol_of_point x;hol_of_point y]), ONCE_REWRITE_TAC[ORTHOGONAL_VECTOR] THEN MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; let ppoint = let p = `P:real^3->bool` in fun v -> mk_comb(p,hol_of_point v);; let DEDUCE_POINT_TAC pts = FIRST_X_ASSUM MATCH_MP_TAC THEN MAP_EVERY EXISTS_TAC (map hol_of_point pts) THEN ASM_REWRITE_TAC[];; let rec KOCHEN_SPECKER_TAC set_0 set_1 = if intersect set_0 set_1 <> [] then let p = ppoint(hd(intersect set_0 set_1)) in let th1 = ASSUME(mk_neg p) and th2 = ASSUME p in ACCEPT_TAC(EQ_MP (EQF_INTRO th1) th2) else let prf_1 = filter (fun (a,b) -> mem a set_0) opairs and prf_0 = filter (fun (a,b,c) -> mem a set_1 && mem b set_1) otrips in let new_1 = map snd prf_1 and new_0 = map (fun (a,b,c) -> c) prf_0 in let set_0' = union new_0 set_0 and set_1' = union new_1 set_1 in let del_0 = subtract set_0' set_0 and del_1 = subtract set_1' set_1 in if del_0 <> [] || del_1 <> [] then let prv_0 x = let a,b,_ = find (fun (a,b,c) -> c = x) prf_0 in DEDUCE_POINT_TAC [a;b] and prv_1 x = let a,_ = find (fun (a,c) -> c = x) prf_1 in DEDUCE_POINT_TAC [a] in let newuns = list_mk_conj (map ppoint del_1 @ map (mk_neg o ppoint) del_0) and tacs = map prv_1 del_1 @ map prv_0 del_0 in SUBGOAL_THEN newuns STRIP_ASSUME_TAC THENL [REPEAT CONJ_TAC THENL tacs; ALL_TAC] THEN KOCHEN_SPECKER_TAC set_0' set_1' else let v = find (fun i -> not(mem i set_0) && not(mem i set_1)) points in ASM_CASES_TAC (ppoint v) THENL [KOCHEN_SPECKER_TAC set_0 (v::set_1); KOCHEN_SPECKER_TAC (v::set_0) set_1];; let KOCHEN_SPECKER_LEMMA = prove (`!P. (!x y:real^3. ~(x = vec 0) /\ ~(y = vec 0) /\ orthogonal x y /\ ~(P x) ==> P y) /\ (!x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ orthogonal x y /\ orthogonal x z /\ orthogonal y z /\ P x /\ P y ==> ~(P z)) ==> F`, REPEAT STRIP_TAC THEN MAP_EVERY (ASSUME_TAC o PROVE_NONTRIVIAL) points THEN MAP_EVERY (ASSUME_TAC o PROVE_ORTHOGONAL) opairs THEN KOCHEN_SPECKER_TAC [] []);; let NONTRIVIAL_CROSS = prove (`!x y. orthogonal x y /\ ~(x = vec 0) /\ ~(y = vec 0) ==> ~(x cross y = vec 0)`, REWRITE_TAC[GSYM DOT_EQ_0] THEN VEC3_TAC);; let KOCHEN_SPECKER_PARADOX = prove (`~(?spin:real^3->num. !x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ orthogonal x y /\ orthogonal x z /\ orthogonal y z ==> (spin x = 0) /\ (spin y = 1) /\ (spin z = 1) \/ (spin x = 1) /\ (spin y = 0) /\ (spin z = 1) \/ (spin x = 1) /\ (spin y = 1) /\ (spin z = 0))`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x:real^3. spin(x) = 1` KOCHEN_SPECKER_LEMMA) THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`; NONTRIVIAL_CROSS; ORTHOGONAL_CROSS]);; (* ========================================================================= *) (* Defining new types *) (* ========================================================================= *) let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") (MESON[LEMMA_0] `?x:real^3. ~(x = vec 0)`);; parse_as_infix("||",(11,"right"));; parse_as_infix("_|_",(11,"right"));; let perpdir = new_definition `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; let pardir = new_definition `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; let DIRECTION_CLAUSES = prove (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, MESON_TAC[direction_tybij]);; let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) (`(!x. x || x) /\ (!x y. x || y <=> y || x) /\ (!x y z. x || y /\ y || z ==> x || z)`, REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let DIRECTION_AXIOM_1 = prove (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_2 = prove (`!l l'. ?p. p _|_ l /\ p _|_ l'`, REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; let DIRECTION_AXIOM_3 = prove (`?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN MAP_EVERY (fun t -> EXISTS_TAC t THEN REWRITE_TAC[LEMMA_0]) [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN VEC3_TAC);; let CROSS_0 = VEC3_RULE `x cross vec 0 = vec 0 /\ vec 0 cross x = vec 0`;; let DIRECTION_AXIOM_4_WEAK = prove (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ ~((l cross basis 2) cross (l cross basis 3) = vec 0)` MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; let ORTHOGONAL_COMBINE = prove (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; let DIRECTION_AXIOM_4 = prove (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ p _|_ l /\ p' _|_ l /\ p'' _|_ l`, MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; let PERPDIR_WELLDEF = prove (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; let perpl,perpl_th = lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) "perpl" PERPDIR_WELLDEF;; let line_lift_thm = lift_theorem line_tybij (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; let point_tybij = new_type_definition "point" ("mk_point","dest_point") (prove(`?x:line. T`,REWRITE_TAC[]));; parse_as_infix("on",(11,"right"));; let on = new_definition `p on l <=> perpl (dest_point p) l`;; let POINT_CLAUSES = prove (`((p = p') <=> (dest_point p = dest_point p')) /\ ((!p. P (dest_point p)) <=> (!l. P l)) /\ ((?p. P (dest_point p)) <=> (?l. P l))`, MESON_TAC[point_tybij]);; let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; let AXIOM_1 = prove (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ !l'. p on l' /\ p' on l' ==> (l' = l)`, POINT_TAC LINE_AXIOM_1);; let AXIOM_2 = prove (`!l l'. ?p. p on l /\ p on l'`, POINT_TAC LINE_AXIOM_2);; let AXIOM_3 = prove (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p on l /\ p' on l /\ p'' on l)`, POINT_TAC LINE_AXIOM_3);; let AXIOM_4 = prove (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p on l /\ p' on l /\ p'' on l`, POINT_TAC LINE_AXIOM_4);; (* ========================================================================= *) (* Custom inference rules *) (* ========================================================================= *) let near_ring_axioms = `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z))`;; (**** Works eventually but takes a very long time MESON[] `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z)) ==> !a. 0 * a = 0`;; ****) let is_realvar w x = is_var x && not(mem x w);; let rec real_strip w tm = if mem tm w then tm,[] else let l,r = dest_comb tm in let f,args = real_strip w l in f,args@[r];; let weight lis (f,n) (g,m) = let i = index f lis and j = index g lis in i > j || i = j && n > m;; let rec lexord ord l1 l2 = match (l1,l2) with (h1::t1,h2::t2) -> if ord h1 h2 then length t1 = length t2 else h1 = h2 && lexord ord t1 t2 | _ -> false;; let rec lpo_gt w s t = if is_realvar w t then not(s = t) && mem t (frees s) else if is_realvar w s || is_abs s || is_abs t then false else let f,fargs = real_strip w s and g,gargs = real_strip w t in exists (fun si -> lpo_ge w si t) fargs || forall (lpo_gt w s) gargs & (f = g && lexord (lpo_gt w) fargs gargs || weight w (f,length fargs) (g,length gargs)) and lpo_ge w s t = (s = t) || lpo_gt w s t;; let rec istriv w env x t = if is_realvar w t then t = x || defined env t && istriv w env x (apply env t) else if is_const t then false else let f,args = strip_comb t in exists (istriv w env x) args && failwith "cyclic";; let rec unify w env tp = match tp with ((Var(_,_) as x),t) | (t,(Var(_,_) as x)) when not(mem x w) -> if defined env x then unify w env (apply env x,t) else if istriv w env x t then env else (x|->t) env | (Comb(f,x),Comb(g,y)) -> unify w (unify w env (x,y)) (f,g) | (s,t) -> if s = t then env else failwith "unify: not unifiable";; let fullunify w (s,t) = let env = unify w undefined (s,t) in let th = map (fun (x,t) -> (t,x)) (graph env) in let rec subs t = let t' = vsubst th t in if t' = t then t else subs t' in map (fun (t,x) -> (subs t,x)) th;; let rec listcases fn rfn lis acc = match lis with [] -> acc | h::t -> fn h (fun i h' -> rfn i (h'::map REFL t)) @ listcases fn (fun i t' -> rfn i (REFL h::t')) t acc;; let LIST_MK_COMB f ths = rev_itlist (fun s t -> MK_COMB(t,s)) ths (REFL f);; let rec overlaps w th tm rfn = let l,r = dest_eq(concl th) in if not (is_comb tm) then [] else let f,args = strip_comb tm in listcases (overlaps w th) (fun i a -> rfn i (LIST_MK_COMB f a)) args (try [rfn (fullunify w (l,tm)) th] with Failure _ -> []);; let crit1 w eq1 eq2 = let l1,r1 = dest_eq(concl eq1) and l2,r2 = dest_eq(concl eq2) in overlaps w eq1 l2 (fun i th -> TRANS (SYM(INST i th)) (INST i eq2));; let fixvariables s th = let fvs = subtract (frees(concl th)) (freesl(hyp th)) in let gvs = map2 (fun v n -> mk_var(s^string_of_int n,type_of v)) fvs (1--length fvs) in INST (zip gvs fvs) th;; let renamepair (th1,th2) = fixvariables "x" th1,fixvariables "y" th2;; let critical_pairs w tha thb = let th1,th2 = renamepair (tha,thb) in crit1 w th1 th2 @ crit1 w th2 th1;; let normalize_and_orient w eqs th = let th' = GEN_REWRITE_RULE TOP_DEPTH_CONV eqs th in let s',t' = dest_eq(concl th') in if lpo_ge w s' t' then th' else if lpo_ge w t' s' then SYM th' else failwith "Can't orient equation";; let status(eqs,crs) eqs0 = if eqs = eqs0 && (length crs) mod 1000 <> 0 then () else (print_string(string_of_int(length eqs)^" equations and "^ string_of_int(length crs)^" pending critical pairs"); print_newline());; let left_reducible eqs eq = can (CHANGED_CONV(GEN_REWRITE_CONV (LAND_CONV o ONCE_DEPTH_CONV) eqs)) (concl eq);; let rec complete w (eqs,crits) = match crits with (eq::ocrits) -> let trip = try let eq' = normalize_and_orient w eqs eq in let s',t' = dest_eq(concl eq') in if s' = t' then (eqs,ocrits) else let crits',eqs' = partition(left_reducible [eq']) eqs in let eqs'' = eq'::eqs' in eqs'', ocrits @ crits' @ itlist ((@) o critical_pairs w eq') eqs'' [] with Failure _ -> if exists (can (normalize_and_orient w eqs)) ocrits then (eqs,ocrits@[eq]) else failwith "complete: no orientable equations" in status trip eqs; complete w trip | [] -> eqs;; let complete_equations wts eqs = let eqs' = map (normalize_and_orient wts []) eqs in complete wts ([],eqs');; complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] [SPEC_ALL(ASSUME `!a b. i(a) * a * b = b`)];; complete_equations [`c:A`; `f:A->A`] (map SPEC_ALL (CONJUNCTS (ASSUME `((f(f(f(f(f c))))) = c:A) /\ (f(f(f c)) = c)`)));; let eqs = map SPEC_ALL (CONJUNCTS (ASSUME `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ (!x y z. (x * y) * z = x * y * z)`)) in map concl (complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] eqs);; let COMPLETE_TAC w th = let eqs = map SPEC_ALL (CONJUNCTS(SPEC_ALL th)) in let eqs' = complete_equations w eqs in MAP_EVERY (ASSUME_TAC o GEN_ALL) eqs';; g `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ (!x y z. (x * y) * z = x * y * z) ==> !x y. i(y) * i(i(i(x * i(y)))) * x = 1`;; e (DISCH_THEN(COMPLETE_TAC [`1`; `( * ):num->num->num`; `i:num->num`]));; e(ASM_REWRITE_TAC[]);; g `(!x. 0 + x = x) /\ (!x. neg x + x = 0) /\ (!x y z. (x + y) + z = x + y + z) /\ (!x y z. (x * y) * z = x * y * z) /\ (!x y z. (x + y) * z = (x * z) + (y * z)) ==> (neg 0 * (x * y + z + neg(neg(w + z))) + neg(neg b + neg a) = a + b)`;; e (DISCH_THEN(COMPLETE_TAC [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`]));; e(ASM_REWRITE_TAC[]);; (**** Could have done this instead e (DISCH_THEN(COMPLETE_TAC [`0`; `(+):num->num->num`; `( * ):num->num->num`; `neg:num->num`]));; ****) (* ========================================================================= *) (* Linking external tools *) (* ========================================================================= *) let maximas e = let filename = Filename.temp_file "maxima" ".out" in let s = "echo 'linel:10000; display2d:false;" ^ e ^ ";' | maxima | grep '^(%o3)' | sed -e 's/^(%o3) //' >" ^ filename in if Sys.command s <> 0 then failwith "maxima" else let fd = Pervasives.open_in filename in let data = input_line fd in close_in fd; Sys.remove filename; data;; prioritize_real();; let maxima_ops = ["+",`(+)`; "-",`(-)`; "*",`( * )`; "/",`(/)`; "^",`(pow)`];; let maxima_funs = ["sin",`sin`; "cos",`cos`];; let mk_uneg = curry mk_comb `(--)`;; let dest_uneg = let ntm = `(--)` in fun tm -> let op,t = dest_comb tm in if op = ntm then t else failwith "dest_uneg";; let mk_pow = let f = mk_binop `(pow)` in fun x y -> f x (rand y);; let mk_realvar = let real_ty = `:real` in fun x -> mk_var(x,real_ty);; let rec string_of_hol tm = if is_ratconst tm then "("^string_of_num(rat_of_term tm)^")" else if is_numeral tm then string_of_num(dest_numeral tm) else if is_var tm then fst(dest_var tm) else if can dest_uneg tm then "-(" ^ string_of_hol(rand tm) ^ ")" else let lop,r = dest_comb tm in try let op,l = dest_comb lop in "("^string_of_hol l^" "^ rev_assoc op maxima_ops^" "^string_of_hol r^")" with Failure _ -> rev_assoc lop maxima_funs ^ "(" ^ string_of_hol r ^ ")";; string_of_hol `(x + sin(-- &2 * x)) pow 2 - cos(x - &22 / &7)`;; let lexe s = map (function Resword s -> s | Ident s -> s) (lex(explode s));; let parse_bracketed prs inp = match prs inp with ast,")"::rst -> ast,rst | _ -> failwith "Closing bracket expected";; let rec parse_ginfix op opup sof prs inp = match prs inp with e1,hop::rst when hop = op -> parse_ginfix op opup (opup sof e1) prs rst | e1,rest -> sof e1,rest;; let parse_general_infix op = let opcon = if op = "^" then mk_pow else mk_binop (assoc op maxima_ops) in let constr = if op <> "^" && snd(get_infix_status op) = "right" then fun f e1 e2 -> f(opcon e1 e2) else fun f e1 e2 -> opcon(f e1) e2 in parse_ginfix op constr (fun x -> x);; let rec parse_atomic_expression inp = match inp with [] -> failwith "expression expected" | "(" :: rest -> parse_bracketed parse_expression rest | s :: rest when forall isnum (explode s) -> term_of_rat(num_of_string s),rest | s :: "(" :: rest when forall isalnum (explode s) -> let e,rst = parse_bracketed parse_expression rest in mk_comb(assoc s maxima_funs,e),rst | s :: rest when forall isalnum (explode s) -> mk_realvar s,rest and parse_exp inp = parse_general_infix "^" parse_atomic_expression inp and parse_neg inp = match inp with | "-" :: rest -> let e,rst = parse_neg rest in mk_uneg e,rst | _ -> parse_exp inp and parse_expression inp = itlist parse_general_infix (map fst maxima_ops) parse_neg inp;; let hol_of_string = fst o parse_expression o lexe;; hol_of_string "sin(x) - cos(-(- - 1 + x))";; let FACTOR_CONV tm = let s = "factor("^string_of_hol tm^")" in let tm' = hol_of_string(maximas s) in REAL_RING(mk_eq(tm,tm'));; FACTOR_CONV `&1234567890`;; FACTOR_CONV `x pow 6 - &1`;; FACTOR_CONV `r * (r * x * (&1 - x)) * (&1 - r * x * (&1 - x)) - x`;; let ANTIDERIV_CONV tm = let x,bod = dest_abs tm in let s = "integrate("^string_of_hol bod^","^fst(dest_var x)^")" in let tm' = mk_abs(x,hol_of_string(maximas s)) in let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) (SPEC x (DIFF_CONV tm')) in let th2 = REAL_RING(mk_eq(lhand(concl th1),bod)) in GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; ANTIDERIV_CONV `\x. (x + &5) pow 2 + &77 * x`;; ANTIDERIV_CONV `\x. sin(x) + x pow 11`;; (**** This one fails ANTIDERIV_CONV `\x. sin(x) pow 3`;; ****) let SIN_N_CLAUSES = prove (`(sin(&(NUMERAL(BIT0 n)) * x) = &2 * sin(&(NUMERAL n) * x) * cos(&(NUMERAL n) * x)) /\ (sin(&(NUMERAL(BIT1 n)) * x) = sin(&(NUMERAL(BIT0 n)) * x) * cos(x) + sin(x) * cos(&(NUMERAL(BIT0 n)) * x)) /\ (cos(&(NUMERAL(BIT0 n)) * x) = cos(&(NUMERAL n) * x) pow 2 - sin(&(NUMERAL n) * x) pow 2) /\ (cos(&(NUMERAL(BIT1 n)) * x) = cos(&(NUMERAL(BIT0 n)) * x) * cos(x) - sin(x) * sin(&(NUMERAL(BIT0 n)) * x))`, REWRITE_TAC[REAL_MUL_2; REAL_POW_2] THEN REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SIN_ADD; COS_ADD; REAL_MUL_LID] THEN CONV_TAC REAL_RING);; let TRIG_IDENT_TAC x = REWRITE_TAC[SIN_N_CLAUSES; SIN_ADD; COS_ADD] THEN REWRITE_TAC[REAL_MUL_LZERO; SIN_0; COS_0; REAL_MUL_RZERO] THEN MP_TAC(SPEC x SIN_CIRCLE) THEN CONV_TAC REAL_RING;; let ANTIDERIV_CONV tm = let x,bod = dest_abs tm in let s = "expand(integrate("^string_of_hol bod^","^fst(dest_var x)^"))" in let tm' = mk_abs(x,hol_of_string(maximas s)) in let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) (SPEC x (DIFF_CONV tm')) in let th2 = prove(mk_eq(lhand(concl th1),bod),TRIG_IDENT_TAC x) in GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; time ANTIDERIV_CONV `\x. sin(x) pow 3`;; time ANTIDERIV_CONV `\x. sin(x) * sin(x) pow 5 * cos(x) pow 4 + cos(x)`;; let FCT1_WEAK = prove (`(!x. (f diffl f'(x)) x) ==> !x. &0 <= x ==> defint(&0,x) f' (f x - f(&0))`, MESON_TAC[FTC1]);; let INTEGRAL_CONV tm = let th1 = MATCH_MP FCT1_WEAK (ANTIDERIV_CONV tm) in (CONV_RULE REAL_RAT_REDUCE_CONV o REWRITE_RULE[SIN_0; COS_0; REAL_MUL_LZERO; REAL_MUL_RZERO] o CONV_RULE REAL_RAT_REDUCE_CONV o BETA_RULE) th1;; INTEGRAL_CONV `\x. sin(x) pow 13`;; hol-light/Unity/000077500000000000000000000000001303454263000140555ustar00rootroot00000000000000hol-light/Unity/README000066400000000000000000000066131303454263000147430ustar00rootroot00000000000000(*-------------------------------------------------------------------------*) Author: (c) Copyright 1989-2008 by Flemming Andersen Date: November 17, 2003 Last update: January 27, 2008 Distributed with HOL Light under same license terms (*-------------------------------------------------------------------------*) This is a very brief introduction to the first version of UNITY defined in HOL Light. Defining UNITY in HOL started as part of my PhD-work back in 1989. At that time only HOL88 was available. I was very excited when Prof. Mike Gordon first sent me a version on tape of his powerful theorem prover that allows us to reason about specifications defined in the implementation of a polymorphic, typed higher order logic. Later I ported HOL_UNITY to HOL90, HOL98, and HOL4, but this is the first port to HOL Light. I would like to thank John Harrison for encouraging me to finally publish this work as it has been resting on my book shelf for way too long. Since HOL88 did originally not support built-in functions for specifying recursive functions (they were later added by Konrad Slind), the UNITY LEADSTO property is defined as a basic inductive definition in HOL. The UNITY theory defined in this directory was the first implementation of UNITY the way it was originally defined in [CM88]: Parallel Program Design - A Foundation K. Mani Chandy Jayadev Misra Addison Wesley, 1988. Many other mechanizations and other derivatives of this logic has been developed since then. Using the HOL theorem prover, the files: aux_definitions.ml mk_state_logic.ml mk_unless.ml mk_ensures.ml mk_leadsto.ml mk_comp_unity.ml define the UNLESS, STABLE, and ENSURES properties as pre-post conditions for a general state transition system over the entire domain as defined by the polymorphic type system supported by the HOL logic. The LEADSTO property is defined as the transitive and disjunctive closure of ENSURES properties. The file: mk_comp_unity.ml proves the compositional properties presented in [CM88], and mk_unity_prog.ml defines the combinator expressions used by the HOL_UNITY compiler (to be released later). Using the definition of UNLESS, STABLE, ENSURES, and LEADSTO, it was possible to prove all lemmas, theorems, and corollaries presented in [CM88] for the above mentioned properties. Furthermore, the HOL implementation made it possible to formally derive the two induction principles used in the book and the formal definition of the much discussed substitution axiom is naturally derived from the implementation in HOL. More documentation, features, and examples will be added as soon as I get time to port the HOL_UNITY compiler and other sub-tools that were originally part of the HOL_UNITY system that my research group and I developed while we were working at Tele Danmark until it was closed in 1996. If you have any questions regarding the current first release of HOL_UNITY in HOL Light, you may reach me through email to either: fa AT vip.cybercity.dk or Flemming.L.Andersen AT intel.com You can also look for my old thesis and some published papers that describes more about the HOL_UNITY implementation and its use at: http://fa.homepage.dk The web-page is unfortunately not up-to-date but it is a quick reference for some of my past work until my next release. (*-------------------------------------------------------------------------*) hol-light/Unity/aux_definitions.ml000066400000000000000000000036111303454263000176000ustar00rootroot00000000000000(* File: aux_definitions.ml Description: This file defines a few useful functions Author: (c) Copyright 1989-2008 by Flemming Andersen Date: October 23, 1989 Last Update: December 30, 2007 *) let prove_thm ((thm_name:string), thm_term, thm_tactic) = prove (thm_term, thm_tactic);; (* Uniform error facility *) let UNITY_ERR (func,mesg) = ( failwith func, Failure mesg );; (*----------------------------------------------------------------------*) (* Auxilliary definitions *) (*----------------------------------------------------------------------*) let UNDISCH_ALL_TAC = let th_tac (th:thm) (tac:tactic) = (MP_TAC th) THEN tac in let u_asml (thml:thm list) = itlist th_tac thml ALL_TAC in POP_ASSUM_LIST u_asml ;; let UNDISCH_ONE_TAC = let th_tac (th:thm) (tac:tactic) = (UNDISCH_TAC (concl th)) THEN tac in let u_asm (th:thm) = itlist th_tac [th] ALL_TAC in FIRST_ASSUM u_asm ;; let LIST_INDUCT = list_INDUCT;; let CONTRAPOS = let a = `a:bool` and b = `b:bool` in let pth = ITAUT `(a ==> b) ==> (~b ==> ~a)` in fun th -> try let P,Q = dest_imp(concl th) in MP (INST [P,a; Q,b] pth) th with Failure _ -> failwith "CONTRAPOS";; let OP_FIX = 200;; let new_infix_definition (define_name, name_org, define_term, fixity) = ( let defined_thm = new_definition define_term in let (infix_num, assoc_str) = get_infix_status name_org in let defined_infix = ( parse_as_infix ( define_name, (infix_num + fixity, assoc_str) ) ) in (fst (defined_thm, defined_infix)) );; (* get_infix_status infixes();; get_prefix_status prefixes();; *) let new_binder_definition def_term def_binder = ( let def_thm = ( new_definition def_term ) in let def_bind = ( parse_as_binder def_binder ) in (fst (def_thm, def_bind)) );; hol-light/Unity/make.ml000066400000000000000000000011721303454263000153250ustar00rootroot00000000000000(*-------------------------------------------------------------------------*) (* File: unity Description: This file loads and opens the HOL Light theory unity, called HOL_UNITY Author: Flemming Andersen Date: November 17, 2003 *) (*-------------------------------------------------------------------------*) loadt "Examples/hol88.ml";; loadt "Unity/aux_definitions.ml";; loadt "Unity/mk_state_logic.ml";; loadt "Unity/mk_unless.ml";; loadt "Unity/mk_ensures.ml";; loadt "Unity/mk_gen_induct.ml";; loadt "Unity/mk_leadsto.ml";; loadt "Unity/mk_comp_unity.ml";; loadt "Unity/mk_unity_prog.ml";; hol-light/Unity/mk_comp_unity.ml000066400000000000000000000412361303454263000172720ustar00rootroot00000000000000(*---------------------------------------------------------------------------*) (* File: mk_comp_unity.ml Description: This file proves the unity compositionality theorems and corrollaries valid. Author: (c) Copyright 1989-2008 by Flemming Andersen Date: December 1, 1989 Last Update: December 30, 2007 *) (*---------------------------------------------------------------------------*) (*---------------------------------------------------------------------------*) (* Theorems *) (*---------------------------------------------------------------------------*) (* Prove: !p q FPr GPr. (p UNLESS q) (APPEND FPr GPr) ==> (p UNLESS q) FPr /\ (p UNLESS q) GPr *) let COMP_UNLESS_thm1_lemma_1 = TAC_PROOF (([], (`!(p:'a->bool) q FPr GPr. (p UNLESS q) (APPEND FPr GPr) ==> (p UNLESS q) FPr /\ (p UNLESS q) GPr`)), REPEAT GEN_TAC THEN SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN LIST_INDUCT_TAC THENL [ REWRITE_TAC [UNLESS;APPEND] ; REWRITE_TAC [APPEND] THEN REWRITE_TAC [UNLESS] THEN REPEAT STRIP_TAC THENL [ ASM_REWRITE_TAC [] ; RES_TAC ; RES_TAC]]);; (* Prove: !p q FPr GPr. (p UNLESS q) FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr) *) let COMP_UNLESS_thm1_lemma_2 = TAC_PROOF (([], (`!(p:'a->bool) q FPr GPr. (p UNLESS q) FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr)`)), REPEAT GEN_TAC THEN SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN LIST_INDUCT_TAC THENL [ REWRITE_TAC [UNLESS;APPEND] ; REWRITE_TAC [APPEND] THEN REWRITE_TAC [UNLESS] THEN REPEAT STRIP_TAC THENL [ ASM_REWRITE_TAC [] ; RES_TAC ]]);; (* Prove: !p q FPr GPr. (p UNLESS q) (APPEND FPr GPr) = (p UNLESS q) FPr /\ (p UNLESS q) GPr *) let COMP_UNLESS_thm1 = prove_thm ("COMP_UNLESS_thm1", (`!(p:'a->bool) q FPr GPr. (p UNLESS q) (APPEND FPr GPr) <=> (p UNLESS q) FPr /\ (p UNLESS q) GPr`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL COMP_UNLESS_thm1_lemma_1) (SPEC_ALL COMP_UNLESS_thm1_lemma_2)));; (* Prove: !p q FPr GPr. (p ENSURES q) (APPEND FPr GPr) ==> (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ (p ENSURES q) GPr /\ (p UNLESS q) FPr *) let COMP_ENSURES_thm1_lemma_1 = TAC_PROOF (([], (`!(p:'a->bool) q FPr GPr. (p ENSURES q) (APPEND FPr GPr) ==> (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ (p ENSURES q) GPr /\ (p UNLESS q) FPr`)), REPEAT GEN_TAC THEN SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN LIST_INDUCT_TAC THENL [ REWRITE_TAC [ENSURES;EXIST_TRANSITION;UNLESS;APPEND] ; GEN_TAC THEN REWRITE_TAC [ENSURES;EXIST_TRANSITION;UNLESS;APPEND] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THENL [ DISJ1_TAC THEN ASM_REWRITE_TAC [] THEN ASM_REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL COMP_UNLESS_thm1))] ; ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS q)(APPEND t GPr)`); (`((p:'a->bool) EXIST_TRANSITION q)(APPEND t GPr)`)] AND_INTRO_THM)) THEN UNDISCH_TAC (`((p:'a->bool) UNLESS q)(APPEND t GPr) /\ (p EXIST_TRANSITION q)(APPEND t GPr)`) THEN REWRITE_TAC [SPECL [(`q:'a->bool`); (`p:'a->bool`); (`APPEND (t:('a->'a)list) GPr`)] (GEN_ALL (SYM (SPEC_ALL ENSURES)))] THEN DISCH_TAC THEN RES_TAC THENL [ UNDISCH_TAC (`((p:'a->bool) ENSURES q) t`) THEN REWRITE_TAC [ENSURES] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] ; UNDISCH_TAC (`((p:'a->bool) ENSURES q) GPr`) THEN REWRITE_TAC [ENSURES] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] ]]]);; (* Prove: !p q FPr GPr. (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ (p ENSURES q) GPr /\ (p UNLESS q) FPr ==> (p ENSURES q) (APPEND FPr GPr) *) let COMP_ENSURES_thm1_lemma_2 = TAC_PROOF (([], `!(p:'a->bool) q FPr GPr. ((p ENSURES q) FPr /\ (p UNLESS q) GPr \/ (p ENSURES q) GPr /\ (p UNLESS q) FPr) ==> (p ENSURES q) (APPEND FPr GPr)`), GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ENSURES;EXIST_TRANSITION;UNLESS;APPEND] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [COMP_UNLESS_thm1;ENSURES;EXIST_TRANSITION; UNLESS;APPEND] THEN REWRITE_TAC [UNDISCH_ALL (ONCE_REWRITE_RULE [EXIST_TRANSITION_thm12] (SPEC_ALL EXIST_TRANSITION_thm8))] THENL [ REWRITE_TAC [ONCE_REWRITE_RULE [EXIST_TRANSITION_thm12] (UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`t:('a->'a)list`;`GPr:('a->'a)list`] EXIST_TRANSITION_thm8))] ; REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`GPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm8)] ]);; (* Prove: !p q FPr GPr. (p ENSURES q) (APPEND FPr GPr) = (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ (p ENSURES q) GPr /\ (p UNLESS q) FPr *) let COMP_ENSURES_thm1 = prove_thm ("COMP_ENSURES_thm1", (`!(p:'a->bool) q FPr GPr. (p ENSURES q) (APPEND FPr GPr) <=> ((p ENSURES q) FPr /\ (p UNLESS q) GPr \/ (p ENSURES q) GPr /\ (p UNLESS q) FPr)`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL COMP_ENSURES_thm1_lemma_1) (SPEC_ALL COMP_ENSURES_thm1_lemma_2)));; (* Prove: |- !p q FPr GPr. (p ENSURES q)FPr /\ (p UNLESS q)GPr ==> (p ENSURES q)(APPEND FPr GPr) *) let COMP_ENSURES_cor0 = prove_thm ("COMP_ENSURES_cor0", (`!(p:'a->bool) q FPr GPr. (p ENSURES q) FPr /\ (p UNLESS q) GPr ==> (p ENSURES q) (APPEND FPr GPr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`((p:'a->bool) ENSURES q)FPr`);ASSUME (`((p:'a->bool) UNLESS q)GPr`)] (SPEC_ALL COMP_ENSURES_thm1)));; (* Prove: |- !p q FPr GPr. (p ENSURES q)GPr /\ (p UNLESS q)FPr ==> (p ENSURES q)(APPEND FPr GPr) *) let COMP_ENSURES_cor1 = prove_thm ("COMP_ENSURES_cor1", (`!(p:'a->bool) q FPr GPr. (p ENSURES q) GPr /\ (p UNLESS q) FPr ==> (p ENSURES q) (APPEND FPr GPr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`((p:'a->bool) ENSURES q)GPr`);ASSUME (`((p:'a->bool) UNLESS q)FPr`)] (SPEC_ALL COMP_ENSURES_thm1)));; (* Prove: !p q FPr GPr. (p INVARIANT q) (APPEND FPr GPr) = (p INVARIANT q) FPr /\ (p INVARIANT q) GPr *) let COMP_UNITY_cor0 = prove_thm ("COMP_UNITY_cor0", (`!(p0:'a->bool) p FPr GPr. (p INVARIANT (p0, APPEND FPr GPr)) = (p INVARIANT (p0,FPr) /\ p INVARIANT (p0,GPr))`), REWRITE_TAC [INVARIANT;STABLE;COMP_UNLESS_thm1] THEN REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; (* Prove: !p FPr GPr. p STABLE (APPEND FPr GPr) = p STABLE FPr /\ p STABLE GPr *) let COMP_UNITY_cor1 = prove_thm ("COMP_UNITY_cor1", (`!(p:'a->bool) FPr GPr. (p STABLE (APPEND FPr GPr)) = (p STABLE FPr /\ p STABLE GPr)`), REWRITE_TAC [STABLE;COMP_UNLESS_thm1]);; (* Prove: !p q FPr GPr. (p UNLESS q) FPr /\ p STABLE GPr ==>(p UNLESS q) (APPEND FPr GPr) *) let COMP_UNITY_cor2 = prove_thm ("COMP_UNITY_cor2", (`!(p:'a->bool) q FPr GPr. (p UNLESS q) FPr /\ p STABLE GPr ==>(p UNLESS q) (APPEND FPr GPr)`), REWRITE_TAC [STABLE;COMP_UNLESS_thm1] THEN REPEAT STRIP_TAC THENL [ ASM_REWRITE_TAC [] ; UNDISCH_TAC (`((p:'a->bool) UNLESS False)GPr`) THEN SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN LIST_INDUCT_TAC THENL [ REWRITE_TAC [UNLESS] ; REWRITE_TAC [UNLESS;UNLESS_STMT] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THENL [ RES_TAC THEN UNDISCH_TAC (`~(False:'a->bool) s ==> (p:'a->bool)(h s) \/ False(h s)`) THEN REWRITE_TAC [FALSE_def;NOT_CLAUSES;OR_INTRO_THM1] ; RES_TAC]]]);; (* Prove: !p0 p FPr GPr. p INVARIANT (p0; FPr) /\ p STABLE GPr ==> p INVARIANT (p0; (APPEND FPr GPr)) *) let COMP_UNITY_cor3 = prove_thm ("COMP_UNITY_cor3", (`!(p0:'a->bool) p FPr GPr. p INVARIANT (p0, FPr) /\ p STABLE GPr ==> p INVARIANT (p0, (APPEND FPr GPr))`), REWRITE_TAC [INVARIANT;STABLE;COMP_UNLESS_thm1] THEN REPEAT STRIP_TAC THENL [ RES_TAC ; ASM_REWRITE_TAC [] ; ASM_REWRITE_TAC []]);; (* Prove: !p q FPr GPr. (p ENSURES q) FPr /\ p STABLE GPr ==> (p ENSURES q) (APPEND FPr GPr) *) let COMP_UNITY_cor4 = prove_thm ("COMP_UNITY_cor4", (`!(p:'a->bool) q FPr GPr. (p ENSURES q) FPr /\ p STABLE GPr ==> (p ENSURES q) (APPEND FPr GPr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`);(`q:'a->bool`);(`FPr:('a->'a)list`)] ENSURES_cor2)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS q)FPr`);(`(p:'a->bool) STABLE GPr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`);(`q:'a->bool`);(`FPr:('a->'a)list`);(`GPr:('a->'a)list`)] COMP_UNITY_cor2)) THEN REWRITE_TAC [ENSURES] THEN ASM_REWRITE_TAC [] THEN UNDISCH_TAC (`((p:'a->bool) ENSURES q)FPr`) THEN REWRITE_TAC [ENSURES] THEN STRIP_TAC THEN UNDISCH_TAC (`((p:'a->bool) EXIST_TRANSITION q)FPr`) THEN SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN LIST_INDUCT_TAC THENL [ REWRITE_TAC [EXIST_TRANSITION] ; REWRITE_TAC [APPEND;EXIST_TRANSITION] THEN REPEAT STRIP_TAC THENL [ ASM_REWRITE_TAC [] ; RES_TAC THEN ASM_REWRITE_TAC []]]);; (* Prove: !p q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) GPr *) let COMP_UNITY_cor5 = prove_thm ("COMP_UNITY_cor5", (`!(p:'a->bool) q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) GPr`), REWRITE_TAC [COMP_UNLESS_thm1] THEN REPEAT STRIP_TAC);; (* Prove: !p q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) FPr *) let COMP_UNITY_cor6 = prove_thm ("COMP_UNITY_cor6", (`!(p:'a->bool) q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) FPr`), REWRITE_TAC [COMP_UNLESS_thm1] THEN REPEAT STRIP_TAC);; (* Prove: !p q st FPr. (p UNLESS q)(CONS st FPr) ==> (p UNLESS q) FPr *) let COMP_UNITY_cor7 = prove_thm ("COMP_UNITY_cor7", (`!(p:'a->bool) q st FPr. (p UNLESS q)(CONS st FPr) ==> (p UNLESS q) FPr`), REWRITE_TAC [UNLESS] THEN REPEAT STRIP_TAC);; (* Prove: !p FPr GPr. (p ENSURES (NotX p)) FPr ==> (p ENSURES (NotX p)) (APPEND FPr GPr) *) let COMP_UNITY_cor8 = prove_thm ("COMP_UNITY_cor8", (`!(p:'a->bool) FPr GPr. (p ENSURES (Not p)) FPr ==> (p ENSURES (Not p)) (APPEND FPr GPr)`), GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND;ENSURES;UNLESS;EXIST_TRANSITION] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [UNLESS_thm2] THEN REWRITE_TAC [UNDISCH_ALL (ONCE_REWRITE_RULE [EXIST_TRANSITION_thm12] (SPECL [`p:'a->bool`;`Not (p:'a->bool)`;`t:('a->'a)list`;`GPr:('a->'a)list`] EXIST_TRANSITION_thm8))]);; (* Prove: !p q FPr GPr. p STABLE FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr) *) let COMP_UNITY_cor9 = prove_thm ("COMP_UNITY_cor9", (`!(p:'a->bool) q FPr GPr. p STABLE FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr)`), REWRITE_TAC [STABLE;COMP_UNLESS_thm1] THEN REPEAT STRIP_TAC THENL [ UNDISCH_TAC (`((p:'a->bool) UNLESS False)FPr`) THEN SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN LIST_INDUCT_TAC THENL [ REWRITE_TAC [UNLESS] ; REWRITE_TAC [UNLESS;UNLESS_STMT] THEN BETA_TAC THEN REPEAT STRIP_TAC THENL [ RES_TAC THEN UNDISCH_TAC (`~(False:'a->bool) s ==> (p:'a->bool)(h s) \/ False(h s)`) THEN REWRITE_TAC [FALSE_def;NOT_CLAUSES;OR_INTRO_THM1] ; RES_TAC ] ] ; ASM_REWRITE_TAC [] ]);; (* Prove: !p q FPr GPr. (p UNLESS q) (APPEND FPr GPr) = (p UNLESS q) (APPEND GPr FPr) *) let COMP_UNITY_cor10 = prove_thm ("COMP_UNITY_cor10", (`!(p:'a->bool) q FPr GPr. (p UNLESS q) (APPEND FPr GPr) = (p UNLESS q) (APPEND GPr FPr)`), REPEAT GEN_TAC THEN REWRITE_TAC [COMP_UNLESS_thm1] THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; (* Prove: !p q FPr GPr. (p ENSURES q) (APPEND FPr GPr) = (p ENSURES q) (APPEND GPr FPr) *) let COMP_UNITY_cor11 = prove_thm ("COMP_UNITY_cor11", (`!(p:'a->bool) q FPr GPr. (p ENSURES q) (APPEND FPr GPr) = (p ENSURES q) (APPEND GPr FPr)`), REPEAT GEN_TAC THEN REWRITE_TAC [COMP_ENSURES_thm1] THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; (* Prove: !p q FPr GPr. (p LEADSTO q) (APPEND FPr GPr) = (p LEADSTO q) (APPEND GPr FPr) *) (* |- (!p' q'. ((p' ENSURES q')(APPEND Pr1 Pr2) ==> (p' LEADSTO q')(APPEND Pr2 Pr1)) /\ (!r. (p' LEADSTO r)(APPEND Pr1 Pr2) /\ (p' LEADSTO r)(APPEND Pr2 Pr1) /\ (r LEADSTO q')(APPEND Pr1 Pr2) /\ (r LEADSTO q')(APPEND Pr2 Pr1) ==> (p' LEADSTO q')(APPEND Pr1 Pr2) ==> (p' LEADSTO q')(APPEND Pr2 Pr1)) /\ (!P. (!i. ((P i) LEADSTO q')(APPEND Pr1 Pr2)) /\ (!i. ((P i) LEADSTO q')(APPEND Pr2 Pr1)) ==> (($ExistsX P) LEADSTO q')(APPEND Pr1 Pr2) ==> (($ExistsX P) LEADSTO q')(APPEND Pr2 Pr1))) ==> (p LEADSTO q)(APPEND Pr1 Pr2) ==> (p LEADSTO q)(APPEND Pr2 Pr1) *) let COMP_UNITY_cor12_lemma00 = (BETA_RULE (SPECL [(`\(p:'a->bool) q. (p LEADSTO q)(APPEND Pr2 Pr1)`); (`p:'a->bool`);(`q:'a->bool`);(`APPEND (Pr1:('a->'a)list) Pr2`)] LEADSTO_thm37));; let COMP_UNITY_cor12_lemma01 = TAC_PROOF (([], (`!(p':'a->bool) q' Pr1 Pr2. (p' ENSURES q')(APPEND Pr1 Pr2) ==> (p' LEADSTO q')(APPEND Pr2 Pr1)`)), REPEAT STRIP_TAC THEN ASSUME_TAC (ONCE_REWRITE_RULE [COMP_UNITY_cor11] (ASSUME (`((p':'a->bool) ENSURES q')(APPEND Pr1 Pr2)`))) THEN IMP_RES_TAC LEADSTO_thm0);; let COMP_UNITY_cor12_lemma02 = TAC_PROOF (([], (`!(p':'a->bool) q' Pr1 Pr2. (!r. (p' LEADSTO r)(APPEND Pr1 Pr2) /\ (p' LEADSTO r)(APPEND Pr2 Pr1) /\ (r LEADSTO q')(APPEND Pr1 Pr2) /\ (r LEADSTO q')(APPEND Pr2 Pr1) ==> (p' LEADSTO q')(APPEND Pr2 Pr1))`)), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm1);; let COMP_UNITY_cor12_lemma03 = TAC_PROOF (([], (`!(p':'a->bool) q' Pr1 Pr2. (!P:('a->bool)->bool. (!p''. p'' In P ==> (p'' LEADSTO q')(APPEND Pr1 Pr2)) /\ (!p''. p'' In P ==> (p'' LEADSTO q')(APPEND Pr2 Pr1)) ==> ((LUB P) LEADSTO q')(APPEND Pr2 Pr1))`)), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm3a);; (* |- !p q Pr1 Pr2. (p LEADSTO q)(APPEND Pr1 Pr2) ==> (p LEADSTO q)(APPEND Pr2 Pr1) *) let COMP_UNITY_cor12_lemma04 = (GEN_ALL (REWRITE_RULE [COMP_UNITY_cor12_lemma01;COMP_UNITY_cor12_lemma02;COMP_UNITY_cor12_lemma03] (SPEC_ALL COMP_UNITY_cor12_lemma00)));; (* |- !p q Pr1 Pr2. (p LEADSTO q)(APPEND Pr1 Pr2) = (p LEADSTO q)(APPEND Pr2 Pr1) *) let COMP_UNITY_cor12 = prove_thm ("COMP_UNITY_cor12", (`!(p:'a->bool) q Pr1 Pr2. (p LEADSTO q)(APPEND Pr1 Pr2) = (p LEADSTO q)(APPEND Pr2 Pr1)`), REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC [COMP_UNITY_cor12_lemma04]);; (* |- !p FPr GPr. p STABLE (APPEND FPr GPr) = p STABLE (APPEND GPr FPr) *) let COMP_UNITY_cor13 = prove_thm ("COMP_UNITY_cor13", (`!(p:'a->bool) FPr GPr. (p STABLE (APPEND FPr GPr)) = (p STABLE (APPEND GPr FPr))`), REPEAT GEN_TAC THEN REWRITE_TAC [STABLE] THEN EQ_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC [COMP_UNITY_cor10] THEN ASM_REWRITE_TAC []);; (* |- !p0 p FPr GPr. p INVARIANT (p0, APPEND FPr GPr) = p INVARIANT (p0, APPEND GPr FPr) *) let COMP_UNITY_cor14 = prove_thm ("COMP_UNITY_cor14", (`!(p0:'a->bool) p FPr GPr. (p INVARIANT (p0, (APPEND FPr GPr))) = (p INVARIANT (p0, (APPEND GPr FPr)))`), REPEAT GEN_TAC THEN REWRITE_TAC [INVARIANT] THEN EQ_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC [COMP_UNITY_cor13] THEN ASM_REWRITE_TAC []);; hol-light/Unity/mk_ensures.ml000066400000000000000000000560051303454263000165700ustar00rootroot00000000000000(*---------------------------------------------------------------------------*) (* File: mk_ensures.sml Description: This file defines ENSURES and the theorems and corrollaries described in [CM88]. Author: (c) Copyright 1989-2008 by Flemming Andersen Date: June 29, 1989 Last Update: December 30, 2007 *) (*---------------------------------------------------------------------------*) (*---------------------------------------------------------------------------*) (* The definition of ENSURES is based on the definition: p ensures q in Pr =

where p and q are state dependent first order logic predicates and s in the program Pr are conditionally enabled statements transforming a state into a new state. ENSURES then requires safety and the existance of at least one state transition statement s which makes q valid. *) let EXIST_TRANSITION_term = `(!p q. EXIST_TRANSITION (p:'a->bool) q [] <=> F) /\ (!p q. EXIST_TRANSITION p q (CONS (st:'a->'a) Pr) <=> ((!s. (p s /\ ~q s) ==> q (st s)) \/ (EXIST_TRANSITION p q Pr)))`;; let EXIST_TRANSITION = new_recursive_definition list_RECURSION EXIST_TRANSITION_term;; parse_as_infix ( "EXIST_TRANSITION", (TL_FIX, "right") );; let ENSURES = new_infix_definition ("ENSURES", "<=>", `!(p:'a->bool) q (Pr:('a->'a)list). ENSURES p q Pr = (((p UNLESS q) Pr) /\ ((p EXIST_TRANSITION q) Pr))`, TL_FIX);; let ENSURES_STMT = new_infix_definition ("ENSURES_STMT", "<=>", `!(p:'a->bool) q (st:'a->'a). ENSURES_STMT p q st = (\s. p s /\ ~(q s) ==> q (st s))`, TL_FIX);; (*-------------------------------------------------------------------------*) (* Lemmas *) (*-------------------------------------------------------------------------*) let ENSURES_lemma0 = TAC_PROOF (([], (`!(p:'a->bool) q r st. ((!s. p s /\ ~q s ==> q (st s)) /\ (!s. q s ==> r s)) ==> (!s. p s /\ ~r s ==> r (st s))`)), REPEAT STRIP_TAC THEN ASSUME_TAC (CONTRAPOS (SPEC_ALL (ASSUME (`!s:'a. q s ==> r s`)))) THEN ASSUME_TAC (SPEC (`(st:'a->'a) s`) (ASSUME (`!s:'a. q s ==> r s`))) THEN RES_TAC THEN RES_TAC);; set_goal([], (`!(p:'a->bool) p' q q' h. (!s. (p UNLESS_STMT q) h s) ==> (!s. (p' UNLESS_STMT q') h s) ==> (!s. p' s /\ ~q' s ==> q' (h s)) ==> (!s. (p /\* p') s /\ ~((p /\* q' \/* p' /\* q) \/* q /\* q') s) ==> (((p /\* q' \/* p' /\* q) \/* q /\* q') (h s))`) );; let ENSURES_lemma1 = TAC_PROOF (([], `!(p:'a->bool) p' q q' h. (!s. (p UNLESS_STMT q) h s) ==> (!s. (p' UNLESS_STMT q') h s) ==> (!s. p' s /\ ~q' s ==> q' (h s)) ==> (!s. (p /\* p') s /\ ~((p /\* q' \/* p' /\* q) \/* q /\* q') s ==> ((p /\* q' \/* p' /\* q) \/* q /\* q') (h s))`), REWRITE_TAC [UNLESS_STMT; AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN MESON_TAC []);; let ENSURES_lemma2 = TAC_PROOF (([], (`!(p:'a->bool) q r st. (!s. p s /\ ~q s ==> q (st s)) ==> (!s. (p s \/ r s) /\ ~(q s \/ r s) ==> q (st s) \/ r (st s))`)), REWRITE_TAC [(GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC))); (SYM (SPEC_ALL DISJ_ASSOC));NOT_CLAUSES;DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let ENSURES_lemma3 = TAC_PROOF (([], (`!(p:'a->bool) q r Pr. (p ENSURES (q \/* r)) Pr ==> (((p /\* (Not q)) \/* (p /\* q)) ENSURES (q \/* r)) Pr`)), REWRITE_TAC [AND_COMPL_OR_lemma]);; let ENSURES_lemma4 = TAC_PROOF (([], `!(p:'a->bool) q r (st:'a->'a). (!s. p s /\ ~q s ==> q (st s)) ==> (!s. (p \/* r) s /\ ~(q \/* r) s ==> (q \/* r) (st s))`), REPEAT GEN_TAC THEN REWRITE_TAC [OR_def] THEN MESON_TAC []);; (*---------------------------------------------------------------------------*) (* Theorems about EXIST_TRANSITION *) (*---------------------------------------------------------------------------*) (* EXIST_TRANSITION Consequence Weakening Theorem: p EXIST_TRANSITION q in Pr; q ==> r ------------------------------------- p EXIST_TRANSITION r in Pr *) let EXIST_TRANSITION_thm1 = prove_thm ("EXIST_TRANSITION_thm1", (`!(p:'a->bool) q r Pr. ((p EXIST_TRANSITION q) Pr /\ (!s. (q s) ==> (r s))) ==> ((p EXIST_TRANSITION r) Pr)`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [EXIST_TRANSITION] THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [REWRITE_RULE [ASSUME `!s:'a. p s /\ ~q s ==> q (h s)`; ASSUME `!s:'a. q s ==> r s`] (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] ENSURES_lemma0)]);; (* Impossibility EXIST_TRANSITION Theorem: p EXIST_TRANSITION false in Pr -------------------------------- ~p *) let EXIST_TRANSITION_thm2 = prove_thm ("EXIST_TRANSITION_thm2", (`!(p:'a->bool) Pr. ((p EXIST_TRANSITION False) Pr) ==> !s. (Not p) s`), GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [EXIST_TRANSITION; NOT_def1] THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] THENL [ UNDISCH_TAC (`!s:'a. ((p:'a->bool) s) /\ ~(False s) ==> (False ((h:'a->'a) s))`) THEN REWRITE_TAC [FALSE_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) ; UNDISCH_TAC (`!s:'a. (Not (p:'a->bool)) s`) THEN REWRITE_TAC [NOT_def1] THEN CONV_TAC (DEPTH_CONV BETA_CONV) ]);; (* Always EXIST_TRANSITION Theorem: false EXIST_TRANSITION p in Pr *) let EXIST_TRANSITION_thm3 = prove_thm ("EXIST_TRANSITION_thm3", (`!(p:'a->bool) st Pr. (False EXIST_TRANSITION p) (CONS st Pr)`), REPEAT GEN_TAC THEN REWRITE_TAC [EXIST_TRANSITION; FALSE_def]);; let EXIST_TRANSITION_thm4 = prove_thm ("EXIST_TRANSITION_thm4", (`!(p:'a->bool) q r Pr. (p EXIST_TRANSITION q) Pr ==> ((p \/* r) EXIST_TRANSITION (q \/* r)) Pr`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [EXIST_TRANSITION] THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [REWRITE_RULE [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] ENSURES_lemma4)]);; let APPEND_lemma01 = TAC_PROOF (([], `!(l:('a)list). (APPEND l []) = l`), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND]);; let EXIST_TRANSITION_thm5 = prove_thm ("EXIST_TRANSITION_thm5", (`!(p:'a->bool) q st Pr. (!s. p s /\ ~q s ==> q (st s)) ==> (p EXIST_TRANSITION q) (CONS st Pr)`), REPEAT GEN_TAC THEN REWRITE_TAC [EXIST_TRANSITION] THEN STRIP_TAC THEN ASM_REWRITE_TAC []);; let APPEND_lemma02 = TAC_PROOF (([], `!st (l:('a)list). (APPEND [st] l) = (CONS st l)`), GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND]);; let APPEND_lemma03 = TAC_PROOF (([], `!st (l1:('a)list) l2. (APPEND (APPEND l1 [st]) l2) = (APPEND l1 (CONS st l2))`), GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND]);; let APPEND_lemma04 = TAC_PROOF (([], `!st (l1:('a)list) l2. (APPEND (CONS st l1) l2) = (CONS st (APPEND l1 l2))`), GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND]);; let EXIST_TRANSITION_thm6 = prove_thm ("EXIST_TRANSITION_thm6", (`!(p:'a->bool) q st Pr1 Pr2. (!s. p s /\ ~q s ==> q (st s)) ==> (p EXIST_TRANSITION q) (APPEND Pr1 (CONS st Pr2))`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [EXIST_TRANSITION;APPEND] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let EXIST_TRANSITION_thm7 = prove_thm ("EXIST_TRANSITION_thm7", (`!(p:'a->bool) q FPr GPr. (p EXIST_TRANSITION q) FPr ==> (p EXIST_TRANSITION q) (APPEND FPr GPr)`), GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [EXIST_TRANSITION;APPEND] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND]);; let EXIST_TRANSITION_thm8 = prove_thm ("EXIST_TRANSITION_thm8", (`!(p:'a->bool) q FPr GPr. (p EXIST_TRANSITION q) FPr ==> (p EXIST_TRANSITION q) (APPEND GPr FPr)`), GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THENL [ REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`;`t':('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm6)] ; REWRITE_TAC [REWRITE_RULE [APPEND_lemma03] (SPECL [`(APPEND (t':('a->'a)list) [h])`] (ASSUME `!GPr:('a->'a)list. (p EXIST_TRANSITION q) (APPEND GPr t)`))] ]);; let EXIST_TRANSITION_thm9 = prove_thm ("EXIST_TRANSITION_thm9", (`!(p:'a->bool) q st FPr GPr. (p EXIST_TRANSITION q) (APPEND FPr GPr) ==> (p EXIST_TRANSITION q) (APPEND FPr (CONS st GPr))`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND]);; let EXIST_TRANSITION_thm10 = prove_thm ("EXIST_TRANSITION_thm10", (`!(p:'a->bool) q st Pr. (p EXIST_TRANSITION q) Pr ==> (p EXIST_TRANSITION q) (CONS st Pr)`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN STRIP_TAC THEN ASM_REWRITE_TAC []);; let EXIST_TRANSITION_thm11 = prove_thm ("EXIST_TRANSITION_thm11", (`!(p:'a->bool) q st Pr. (p EXIST_TRANSITION q) (APPEND [st] Pr) = (p EXIST_TRANSITION q) (APPEND Pr [st])`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN EQ_TAC THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THENL [ REWRITE_TAC [REWRITE_RULE [APPEND_lemma02] (SYM (ASSUME `(((p:'a->bool) EXIST_TRANSITION q) (APPEND [st] t)) <=> ((p EXIST_TRANSITION q) (APPEND t [st]))`))] THEN ASM_REWRITE_TAC [EXIST_TRANSITION] ; REWRITE_TAC [REWRITE_RULE [APPEND_lemma02] (SYM (ASSUME `(((p:'a->bool) EXIST_TRANSITION q) (APPEND [st] t)) <=> ((p EXIST_TRANSITION q) (APPEND t [st]))`))] THEN ASM_REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`st:'a->'a`;`t:('a->'a)list`] EXIST_TRANSITION_thm10)] ; STRIP_ASSUME_TAC (REWRITE_RULE [APPEND_lemma02;EXIST_TRANSITION] (ASSUME `((p:'a->bool) EXIST_TRANSITION q) (APPEND [st] t)`)) THEN ASM_REWRITE_TAC [] ]);; let EXIST_TRANSITION_thm12a = prove_thm ("EXIST_TRANSITION_thm12a", (`!(p:'a->bool) q FPr GPr. (p EXIST_TRANSITION q) (APPEND FPr GPr) ==> (p EXIST_TRANSITION q) (APPEND GPr FPr)`), GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THENL [ REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; `GPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm6)] ; REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; `GPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm9)] ]);; let EXIST_TRANSITION_thm12b = prove_thm ("EXIST_TRANSITION_thm12b", (`!(p:'a->bool) q FPr GPr. (p EXIST_TRANSITION q) (APPEND GPr FPr) ==> (p EXIST_TRANSITION q) (APPEND FPr GPr)`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THENL [ REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; `FPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm6)] ; REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; `FPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm9)] ]);; let EXIST_TRANSITION_thm12 = prove_thm ("EXIST_TRANSITION_thm12", (`!(p:'a->bool) q FPr GPr. (p EXIST_TRANSITION q) (APPEND GPr FPr) = (p EXIST_TRANSITION q) (APPEND FPr GPr)`), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN REWRITE_TAC [UNDISCH_ALL (SPEC_ALL EXIST_TRANSITION_thm12a); UNDISCH_ALL (SPEC_ALL EXIST_TRANSITION_thm12b)]);; (*---------------------------------------------------------------------------*) (* Theorems about ENSURES *) (*---------------------------------------------------------------------------*) (* Reflexivity Theorem: p ensures p in Pr The theorem is only valid for non-empty programs *) let ENSURES_thm0 = prove_thm ("ENSURES_thm0", (`!(p:'a->bool) q. (p ENSURES q) [] = F`), REWRITE_TAC [ENSURES] THEN STRIP_TAC THEN REWRITE_TAC [UNLESS;EXIST_TRANSITION]);; let ENSURES_thm1 = prove_thm ("ENSURES_thm1", (`!(p:'a->bool) st Pr. (p ENSURES p) (CONS st Pr)`), REWRITE_TAC [ENSURES] THEN STRIP_TAC THEN REWRITE_TAC [UNLESS;EXIST_TRANSITION] THEN REWRITE_TAC [UNLESS_thm1;UNLESS_STMT] THEN REWRITE_TAC [BETA_CONV (`(\s:'a. (p s /\ ~p s) ==> p (st s))s`)] THEN REWRITE_TAC[NOT_AND;IMP_CLAUSES]);; (* Consequence Weakening Theorem: p ensures q in Pr; q ==> r ---------------------------- p ensures r in Pr *) let ENSURES_thm2 = prove_thm ("ENSURES_thm2", (`!(p:'a->bool) q r Pr. ((p ENSURES q) Pr /\ (!s:'a. (q s) ==> (r s))) ==> ((p ENSURES r) Pr)`), REWRITE_TAC [ENSURES] THEN REPEAT STRIP_TAC THENL [ ASSUME_TAC (UNDISCH_ALL (SPEC (`!s:'a. q s ==> r s`) (SPEC (`((p:'a->bool) UNLESS q) Pr`) AND_INTRO_THM))) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL UNLESS_thm3)) ; ASSUME_TAC (UNDISCH_ALL (SPEC (`!s:'a. q s ==> r s`) (SPEC (`((p:'a->bool) EXIST_TRANSITION q) Pr`) AND_INTRO_THM))) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL EXIST_TRANSITION_thm1)) ]);; (* Impossibility Theorem: p ensures false in Pr ---------------------- ~p *) let ENSURES_thm3 = prove_thm ("ENSURES_thm3", (`!(p:'a->bool) Pr. ((p ENSURES False) Pr) ==> !s. (Not p)s`), GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [ENSURES; UNLESS; EXIST_TRANSITION] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THENL [ UNDISCH_TAC `!s:'a. (p:'a->bool) s /\ ~(False s) ==> False ((h:'a->'a) s)` THEN REWRITE_TAC [FALSE_def; NOT_def1] THEN CONV_TAC (DEPTH_CONV BETA_CONV) ; IMP_RES_TAC EXIST_TRANSITION_thm2 ]);; (* Conjunction Theorem: p unless q in Pr; p' ensures q' in Pr ----------------------------------------------- p/\p' ensures (p/\q')\/(p'/\q)\/(q/\q') in Pr *) let ENSURES_thm4 = prove_thm ("ENSURES_thm4", (`!(p:'a->bool) q p' q' Pr. (p UNLESS q) Pr /\ (p' ENSURES q') Pr ==> ((p /\* p') ENSURES (((p /\* q') \/* (p' /\* q)) \/* (q /\* q'))) Pr`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ENSURES;UNLESS;EXIST_TRANSITION] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THENL [ REWRITE_TAC [REWRITE_RULE [ASSUME `!s:'a. ((p:'a->bool) UNLESS_STMT q) (h:'a->'a) s`; ASSUME `!s:'a. ((p':'a->bool) UNLESS_STMT q') (h:'a->'a) s`] (SPECL [`p:'a->bool`;`q:'a->bool`;`p':'a->bool`;`q':'a->bool`;`h:'a->'a`] UNLESS_STMT_thm3)] ; REWRITE_TAC [REWRITE_RULE [ASSUME `((p:'a->bool) UNLESS q) (t:('a->'a)list)`; ASSUME `((p':'a->bool) UNLESS q') (t:('a->'a)list)`] (SPECL [`p:'a->bool`;`q:'a->bool`;`p':'a->bool`;`q':'a->bool`;`t:('a->'a)list`] UNLESS_thm4)] ; REWRITE_TAC [REWRITE_RULE [ASSUME `!s:'a. ((p:'a->bool) UNLESS_STMT q) (h:'a->'a) s`; ASSUME `!s:'a. ((p':'a->bool) UNLESS_STMT q') (h:'a->'a) s`; ASSUME `!s:'a. (p':'a->bool) s /\ ~(q' s) ==> q' ((h:'a->'a) s)`] (SPEC_ALL ENSURES_lemma1)] ; REWRITE_TAC [REWRITE_RULE [ASSUME `!s:'a. ((p:'a->bool) UNLESS_STMT q) (h:'a->'a) s`; ASSUME `!s:'a. ((p':'a->bool) UNLESS_STMT q') (h:'a->'a) s`] (SPECL [`p:'a->bool`;`q:'a->bool`;`p':'a->bool`;`q':'a->bool`;`h:'a->'a`] UNLESS_STMT_thm3)] ; UNDISCH_TAC `((p:'a->bool) UNLESS q) t /\ (p' ENSURES q') (t:('a->'a)list) ==> (p /\* p' ENSURES (p /\* q' \/* p' /\* q) \/* q /\* q') t` THEN ASM_REWRITE_TAC [ENSURES] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] ; UNDISCH_TAC `((p:'a->bool) UNLESS q) t /\ (p' ENSURES q') (t:('a->'a)list) ==> (p /\* p' ENSURES (p /\* q' \/* p' /\* q) \/* q /\* q') t` THEN ASM_REWRITE_TAC [ENSURES] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] ]);; (* Conjunction Theorem: p ensures q in Pr ------------------------- p\/r ensures q\/r in Pr *) let ENSURES_thm5 = prove_thm ("ENSURES_thm5", (`!(p:'a->bool) q r Pr. ((p ENSURES q) Pr) ==> (((p \/* r) ENSURES (q \/* r)) Pr)`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ENSURES;UNLESS;EXIST_TRANSITION] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THENL [ IMP_RES_TAC UNLESS_STMT_thm6 THEN ASM_REWRITE_TAC [] ; IMP_RES_TAC UNLESS_cor23 THEN ASM_REWRITE_TAC [] ; REWRITE_TAC [REWRITE_RULE [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] ENSURES_lemma4)] ; IMP_RES_TAC UNLESS_STMT_thm6 THEN ASM_REWRITE_TAC [] ; IMP_RES_TAC UNLESS_cor23 THEN ASM_REWRITE_TAC [] ; IMP_RES_TAC EXIST_TRANSITION_thm4 THEN ASM_REWRITE_TAC [] ]);; (* ----------------------------------------------------------------------------- Corollaries about ENSURES ----------------------------------------------------------------------------- *) (* Implies Corollary: p => q ------------------- p ensures q in Pr This corollary is only valid for non-empty programs. *) let ENSURES_cor1 = prove_thm ("ENSURES_cor1", (`!(p:'a->bool) q st Pr. (!s. p s ==> q s) ==> (p ENSURES q) (CONS st Pr)`), REPEAT GEN_TAC THEN DISCH_TAC THEN ASSUME_TAC (SPEC_ALL ENSURES_thm1) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) ENSURES p)(CONS st Pr)`);(`!s:'a. p s ==> q s`)] AND_INTRO_THM)) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`);(`p:'a->bool`);(`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] ENSURES_thm2)));; let ENSURES_cor2 = prove_thm ("ENSURES_cor2", (`!(p:'a->bool) q Pr. (p ENSURES q) Pr ==> (p UNLESS q) Pr`), REWRITE_TAC [ENSURES] THEN REPEAT STRIP_TAC);; let ENSURES_cor3 = prove_thm ("ENSURES_cor3", (`!(p:'a->bool) q r Pr. ((p \/* q) ENSURES r)Pr ==> (p ENSURES (q \/* r))Pr`), REPEAT GEN_TAC THEN DISCH_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) \/* q)`);(`r:'a->bool`); (`Pr:('a->'a)list`)] ENSURES_cor2)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`);(`q:'a->bool`);(`r:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_cor4)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS (q \/* r))Pr`); (`(((p:'a->bool) \/* q) ENSURES r)Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`);(`((q:'a->bool) \/* r)`); (`((p:'a->bool) \/* q)`);(`r:'a->bool`); (`Pr:('a->'a)list`)] ENSURES_thm4)) THEN UNDISCH_TAC (`(((p:'a->bool) /\* (p \/* q)) ENSURES (((p /\* r) \/* ((p \/* q) /\* (q \/* r))) \/* ((q \/* r) /\* r))) Pr`) THEN REWRITE_TAC [AND_OR_EQ_lemma] THEN REWRITE_TAC [OR_ASSOC_lemma;AND_ASSOC_lemma] THEN PURE_ONCE_REWRITE_TAC [SPECL [(`((q:'a->bool) \/* r)`); (`r:'a->bool`)] AND_COMM_lemma] THEN ONCE_REWRITE_TAC [AND_OR_EQ_AND_COMM_OR_lemma] THEN REWRITE_TAC [AND_OR_EQ_lemma] THEN DISCH_TAC THEN ASSUME_TAC (SPECL [(`p:'a->bool`);(`q:'a->bool`);(`r:'a->bool`)] IMPLY_WEAK_lemma5) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) ENSURES ((p /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r)))Pr`); (`!s:'a. ((p /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r))s ==> (q \/* r)s`)] AND_INTRO_THM)) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`); (`(((p:'a->bool) /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r))`); (`((q:'a->bool) \/* r)`);(`Pr:('a->'a)list`)] ENSURES_thm2)));; let ENSURES_cor4 = prove_thm ("ENSURES_cor4", (`!(p:'a->bool) q r Pr. (p ENSURES (q \/* r)) Pr ==> ((p /\* (Not q)) ENSURES (q \/* r)) Pr`), REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL ENSURES_lemma3)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) /\* (Not q))`);(`((p:'a->bool) /\* q)`); (`((q:'a->bool) \/* r)`);(`Pr:('a->'a)list`)] ENSURES_cor3)) THEN UNDISCH_TAC (`(((p:'a->bool) /\* (Not q)) ENSURES ((p /\* q) \/* (q \/* r)))Pr`) THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL OR_ASSOC_lemma))] THEN REWRITE_TAC [P_AND_Q_OR_Q_lemma]);; (* Consequence Weakening Corollary: p ensures q in Pr ------------------------- p ensures (q \/ r) in Pr *) let ENSURES_cor5 = prove_thm ("ENSURES_cor5", (`!(p:'a->bool) q r Pr. (p ENSURES q) Pr ==> (p ENSURES (q \/* r)) Pr`), REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL [(`q:'a->bool`);(`r:'a->bool`)] IMPLY_WEAK_lemma_b) THEN ASSUME_TAC (SPECL [(`p:'a->bool`);(`q:'a->bool`);(`(q:'a->bool) \/* r`)] ENSURES_thm2) THEN RES_TAC);; (* Always Corollary: false ensures p in Pr *) let ENSURES_cor6 = prove_thm ("ENSURES_cor6", (`!(p:'a->bool) st Pr. (False ENSURES p) (CONS st Pr)`), REWRITE_TAC [ENSURES;UNLESS_cor7;EXIST_TRANSITION_thm3]);; let ENSURES_cor7 = prove_thm ("ENSURES_cor7", (`!(p:'a->bool) q r Pr. (p ENSURES q) Pr /\ (r STABLE Pr) ==> ((p /\* r) ENSURES (q /\* r))Pr`), REPEAT GEN_TAC THEN REWRITE_TAC [STABLE] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC (ONCE_REWRITE_RULE [AND_COMM_lemma] (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (ONCE_REWRITE_RULE [OR_AND_COMM_lemma] (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL [(`r:'a->bool`);(`False:'a->bool`); (`p:'a->bool`);(`q:'a->bool`); (`Pr:('a->'a)list`)] ENSURES_thm4))))));; hol-light/Unity/mk_gen_induct.ml000066400000000000000000000016151303454263000172200ustar00rootroot00000000000000(* -*- Emacs Mode: sml -*- *) (*---------------------------------------------------------------------------*) (* File: mk_gen_induct.sml Description: This file proves the theorem of general induction on natural numbers by using the theorem of primitive recursion. Author: (c) Copyright 1990-2008 by Flemming Andersen Modified by John Harrison to just pick up num_WF instead Date: June 7. 1990 Last Update: January 18, 2008 *) (*---------------------------------------------------------------------------*) (* !P. (!(m:num). (!n. n < m ==> (P n)) ==> (P m)) ==> (!m. P m) *) let GEN_INDUCT_thm = prove_thm ("GEN_INDUCT_thm", (`!P. (!(m:num). (!n. n < m ==> (P n)) ==> (P m)) ==> (!m. P m)`), MATCH_ACCEPT_TAC num_WF);; (* Emacs editor information | Local variables: | mode:sml | sml-prog-name:"hol90" | End: *) hol-light/Unity/mk_leadsto.ml000066400000000000000000004514311303454263000165410ustar00rootroot00000000000000(*---------------------------------------------------------------------------*) (* File: mk_leadsto.ml Description: This file defines LEADSTO and the theorems and corrollaries described in [CM88]. Author: (c) Copyright 1990-2008 by Flemming Andersen Date: July 24. 1990 Updated: November 11, 1991 (including LUB) Updated: October 3, 1992 (including state space restriction) Last Update: December 30, 2007 *) (*---------------------------------------------------------------------------*) (* We want to define a function LeadstoRel, which satisfies the three properties of the given axiomatic definition of LEADSTO: p ensures q in Pr ------------------- (1) p leadsto q in Pr p leadsto q in Pr, q leadsto r in Pr -------------------------------------- (2) p leadsto r in Pr !i. (p i) leadsto q in Pr ------------------------- (3) (?i. p i) leadsto q in Pr *) let LUB = new_definition `LUB (P:('a->bool)->bool) = \s:'a. ?p. (P p) /\ p s`;; let IN = new_infix_definition ("In", "<=>", `In (p:'a->bool) (P:('a->bool)->bool) = P p`, TL_FIX);; let LeadstoRel = new_definition (`LeadstoRel R Pr = !(p:'a->bool) q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. (R p r Pr /\ R r q Pr) ==> R p q Pr) /\ (!P. (p = LUB P) /\ (!p. (p In P) ==> R p q Pr) ==> R p q Pr)`);; (* Now we may define LEADSTO: *) let LEADSTO = new_infix_definition ("LEADSTO", "<=>", (`LEADSTO (p:'a->bool) q Pr = (!R. (LeadstoRel R Pr) ==> (R p q Pr))`), TL_FIX);; (* Prove that the given axioms 1, 2, 3 are really theorems for the family *) (* Prove: !P Q Pr. (P ENSURES Q)Pr ==> (P LEADSTO Q)Pr *) let LEADSTO_thm0 = prove_thm ("LEADSTO_thm0", (`!(p:'a->bool) q Pr. (p ENSURES q) Pr ==> (p LEADSTO q)Pr`), REWRITE_TAC [LEADSTO; LeadstoRel] THEN REPEAT STRIP_TAC THEN RES_TAC);; (* Prove: !P Q R Pr. (P LEADSTO Q)Pr /\ (Q LEADSTO R)Pr ==> (P LEADSTO R)Pr *) let LEADSTO_thm1 = prove_thm ("LEADSTO_thm1", (`!(p:'a->bool) r q Pr. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr ==> (p LEADSTO q) Pr`), REWRITE_TAC [LEADSTO; LeadstoRel] THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC);; (* Prove: !P Q R Pr. (P ENSURES Q)Pr /\ (Q LEADSTO R)Pr ==> (P LEADSTO R)Pr *) let LEADSTO_thm2 = prove_thm ("LEADSTO_thm2", (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr ==> (p LEADSTO q) Pr`), REWRITE_TAC [LEADSTO; LeadstoRel] THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC);; (* Prove: !P Q R Pr. (P ENSURES Q)Pr /\ (Q ENSURES R)Pr ==> (P LEADSTO R)Pr *) let LEADSTO_thm2a = prove_thm ("LEADSTO_thm2a", (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r ENSURES q)Pr ==> (p LEADSTO q) Pr`), REWRITE_TAC [LEADSTO; LeadstoRel] THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC);; (* Prove: !P q Pr. (!i. (P i) LEADSTO q)Pr ==> ((( ?* ) P) LEADSTO q)Pr *) let LEADSTO_thm3_lemma01 = TAC_PROOF (([], (`(!p:'a->bool. p In P ==> (!R. (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)) ==> R p q Pr)) ==> (!p:'a->bool. p In P ==> ((!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)) ==> R p q Pr))`)), REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm3 = prove_thm ("LEADSTO_thm3", (`!p (P:('a->bool)->bool) q Pr. ((p = LUB P) /\ (!p. (p In P) ==> (p LEADSTO q)Pr)) ==> (p LEADSTO q)Pr`), REPEAT GEN_TAC THEN REWRITE_TAC [LEADSTO;LeadstoRel] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (GEN_ALL (REWRITE_RULE[ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)`)] (SPEC_ALL (UNDISCH (SPEC_ALL LEADSTO_thm3_lemma01))))) THEN RES_TAC);; let LEADSTO_thm3a = prove_thm ("LEADSTO_thm3a", (`!(P:('a->bool)->bool) q Pr. (!p. (p In P) ==> (p LEADSTO q)Pr) ==> ((LUB P) LEADSTO q)Pr`), REPEAT GEN_TAC THEN ACCEPT_TAC (SPEC_ALL (REWRITE_RULE [] (SPECL [(`LUB (P:('a->bool)->bool)`); (`P:('a->bool)->bool`)] LEADSTO_thm3))));; let LEADSTO_thm3c_lemma01 = TAC_PROOF (([], (`!p:'a->bool. p In (\p. ?i. p = P (i:num)) = (?i. p = P i)`)), REWRITE_TAC [IN] THEN BETA_TAC THEN REWRITE_TAC []);; let LEADSTO_thm3c_lemma02 = TAC_PROOF (([], (`!(P:num->'a->bool) q i. ((?i'. P i = P i') ==> q) = (!i'. (P i = P i') ==> q)`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ ASM_CASES_TAC (`?i'. (P:num->'a->bool) i = P i'`) THEN RES_TAC ; ACCEPT_TAC (REWRITE_RULE [SYM (ASSUME (`(P:num->'a->bool) i = P i'`))] (SPEC_ALL (ASSUME (`!i'. ((P:num->'a->bool) i = P i') ==> q`)))) ]);; let LEADSTO_thm3c_lemma03 = TAC_PROOF (([], (`(!p:'a->bool. (?i. p = P i) ==> (p LEADSTO q)Pr) = (!i:num. ((P i) LEADSTO q)Pr)`)), EQ_TAC THEN REPEAT STRIP_TAC THENL [ ACCEPT_TAC (REWRITE_RULE [] (SPEC (`i:num`) (REWRITE_RULE [LEADSTO_thm3c_lemma02] (SPEC (`(P:num->'a->bool)i`) (ASSUME (`!p:'a->bool. (?i:num. p = P i) ==> (p LEADSTO q)Pr`)))))) ; ASM_REWRITE_TAC [] ]);; let LEADSTO_thm3c_lemma04 = TAC_PROOF (([], (`!s. ((?*) (P:num->'a->bool))s <=> (LUB(\p. ?i. p = P i))s`)), REPEAT GEN_TAC THEN REWRITE_TAC [EXISTS_def; LUB] THEN BETA_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ EXISTS_TAC (`(P:num->'a->bool)x`) THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC (`x:num`) THEN REFL_TAC ; EXISTS_TAC (`i:num`) THEN ACCEPT_TAC (ONCE_REWRITE_RULE [ASSUME (`p = (P:num->'a->bool)i`)] (ASSUME (`(p:'a->bool) s`))) ]);; let LEADSTO_thm3c = prove_thm ("LEADSTO_thm3c", (`!(P:num->'a->bool) q Pr. (!i. ((P i) LEADSTO q)Pr) ==> (((?*) P) LEADSTO q)Pr`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm3c_lemma03] (REWRITE_RULE [LEADSTO_thm3c_lemma01] (ISPEC (`\p. ?i. (p = (P:num->'a->bool)i)`) LEADSTO_thm3a))) THEN RES_TAC THEN ASM_REWRITE_TAC [REWRITE_RULE [ETA_AX] (MK_ABS LEADSTO_thm3c_lemma04)]);; (* Prove: !p1 p2 q Pr. (p1 LEADSTO q)Pr /\ (p2 LEADSTO q)Pr ==> ((p1 \/* p2) LEADSTO q)Pr *) (* To prove this we need some general lemmas about expressing two known relations as one relation: *) (* |- !p1 p2 s. (p1 \/* p2)s = LUB(\p. (p = p1) \/ (p = p2))s *) let LEADSTO_thm4_lemma1a = TAC_PROOF (([], (`!(p1:'a->bool) p2 s. (p1 \/* p2) s = (LUB (\p. (p = p1) \/ (p = p2))) s`)), REPEAT GEN_TAC THEN REWRITE_TAC [LUB; OR_def ] THEN BETA_TAC THEN EQ_TAC THENL [ STRIP_TAC THENL [ EXISTS_TAC (`p1:'a->bool`) THEN ASM_REWRITE_TAC [] ; EXISTS_TAC (`p2:'a->bool`) THEN ASM_REWRITE_TAC [] ] ; STRIP_TAC THENL [ REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p1`)] (ASSUME (`(p:'a->bool) s`))] ; REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p2`)] (ASSUME (`(p:'a->bool) s`))] ] ]);; (* |- !p1 p2. p1 \/* p2 = LUB(\p. (p = p1) \/ (p = p2)) *) let LEADSTO_thm4_lemma1 = (GEN_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`s:'a`) (SPEC_ALL LEADSTO_thm4_lemma1a)))));; (* |- !R p1 p2 q Pr. R p1 q Pr ==> R p2 q Pr ==> (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr) *) let LEADSTO_thm4_lemma2 = TAC_PROOF (([], (`!R (p1:'a->bool) p2 (q:'a->bool) (Pr:('a->'a)list). R p1 q Pr ==> R p2 q Pr ==> (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr)`)), BETA_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; (* |- !R p1 p2 q Pr. R p1 q Pr ==> R p2 q Pr ==> (!p q P. (p = LUB P) /\ (!p. P p ==> R p q Pr) ==> R p q Pr) ==> R(p1 \/* p2) q Pr *) let LEADSTO_thm4_lemma3 = TAC_PROOF (([], (`!R (p1:'a->bool) p2 (q:'a->bool) (Pr:('a->'a)list). R p1 q Pr ==> R p2 q Pr ==> (!p q P. (p = LUB P) /\ (!p. P p ==> R p q Pr) ==> R p q Pr) ==> R (p1 \/* p2) q Pr`)), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm4_lemma1); UNDISCH_ALL (SPEC_ALL LEADSTO_thm4_lemma2)] (SPECL [(`(p1:'a->bool) \/* p2`); (`q:'a->bool`); (`\p:'a->bool. (p = p1) \/ (p = p2)`)] (ASSUME (`!p (q:'a->bool) (P:('a->bool)->bool). (p = LUB P) /\ (!p. P p ==> R p q Pr) ==> R p q (Pr:('a->'a)list)`)))));; (* Now Prove that the finite disjunction is satisfied *) (* |- !p1 p2 q Pr. (p1 LEADSTO q)Pr /\ (p2 LEADSTO q)Pr ==> ((p1 \/* p2) LEADSTO q)Pr *) let LEADSTO_thm4 = prove_thm ("LEADSTO_thm4", (`!(p1:'a->bool) p2 q Pr. (p1 LEADSTO q)Pr /\ (p2 LEADSTO q)Pr ==> ((p1 \/* p2) LEADSTO q)Pr`), REWRITE_TAC [LEADSTO;LeadstoRel] THEN (* BETA_TAC THEN *) REPEAT STRIP_TAC THEN RES_TAC THEN ASSUME_TAC (GEN(`p:'a->bool`)(GEN(`q:'a->bool`)(REWRITE_RULE [IN] (CONJUNCT2 (CONJUNCT2 (SPEC_ALL (ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)`)))))))) THEN ACCEPT_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm4_lemma3)));; (* Prove: ((p ENSURES q)Pr \/ (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = (( ?* ) P)) /\ (!i. ((P i) LEADSTO q)Pr))) = (p LEADSTO q)Pr *) let LEADSTO_thm5_lemma1 = TAC_PROOF (([], `!(p:'a->bool) s. (p s = (\s. ?p'. (if (p = p') then T else F) /\ p' s)s)`), REPEAT GEN_TAC THEN BETA_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ EXISTS_TAC (`p:'a->bool`) THEN ASM_REWRITE_TAC [] ; UNDISCH_TAC (`(if ((p:'a->bool) = p') then T else F)`) THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC [] ]);; (* |- !p. p = (\s. ?p'. ((p = p') => T | F) /\ p' s) *) let LEADSTO_thm5_lemma2 = (GEN_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (SPEC (`p:'a->bool`) LEADSTO_thm5_lemma1))));; let LEADSTO_thm5_lemma3 = TAC_PROOF (([], (`!(p:'a->bool) p'. (if (p = p') then T else F) = (p = p')`)), REPEAT GEN_TAC THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC []);; (* |- !p q Pr. (p ENSURES q)Pr \/ (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr *) let LEADSTO_thm5 = prove_thm ("LEADSTO_thm5", (`!(p:'a->bool) q Pr. ((p ENSURES q) Pr \/ (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) \/ (?P:('a->bool)->bool. (p = LUB P) /\ (!p. (p In P) ==> (p LEADSTO q)Pr))) = (p LEADSTO q)Pr`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THENL [ ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) ; IMP_RES_TAC LEADSTO_thm1 ; IMP_RES_TAC LEADSTO_thm3 ] ; REPEAT STRIP_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; GEN_TAC THEN REWRITE_TAC [LEADSTO_thm5_lemma3] THEN DISCH_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) ] ]);; (* Prove: ((p ENSURES q)Pr \/ (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr *) let LEADSTO_thm6 = prove_thm ("LEADSTO_thm6", (`!(p:'a->bool) q Pr. ((p ENSURES q) Pr \/ (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = (p LEADSTO q)Pr`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THENL [ ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) ; IMP_RES_TAC LEADSTO_thm2 ; IMP_RES_TAC LEADSTO_thm3 ] ; REPEAT STRIP_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; GEN_TAC THEN REWRITE_TAC [LEADSTO_thm5_lemma3] THEN DISCH_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) ] ]);; (* Prove: ((p ENSURES q)Pr \/ (?r. (p ENSURES r)Pr /\ (r ENSURES q)Pr) \/ (?P. (p = (( ?* ) P)) /\ (!i. ((P i) LEADSTO q)Pr))) = (p LEADSTO q)Pr *) let LEADSTO_thm7 = prove_thm ("LEADSTO_thm7", (`!(p:'a->bool) q Pr. ((p ENSURES q) Pr \/ (?r. (p ENSURES r)Pr /\ (r ENSURES q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = (p LEADSTO q)Pr`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THENL [ ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) ; IMP_RES_TAC LEADSTO_thm2a ; IMP_RES_TAC LEADSTO_thm3 ] ; REPEAT STRIP_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; GEN_TAC THEN REWRITE_TAC [LEADSTO_thm5_lemma3] THEN DISCH_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) ] ]);; (* Prove: ((p ENSURES q)Pr \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr *) let LEADSTO_thm8 = prove_thm ("LEADSTO_thm8", (`!(p:'a->bool) q Pr. ((p ENSURES q) Pr \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = (p LEADSTO q)Pr`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THENL [ ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) ; IMP_RES_TAC LEADSTO_thm3 THEN ASM_REWRITE_TAC [] ] ; REPEAT STRIP_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; GEN_TAC THEN REWRITE_TAC [LEADSTO_thm5_lemma3] THEN DISCH_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) ] ]);; (* Prove: (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr *) let LEADSTO_thm9 = prove_thm ("LEADSTO_thm9", (`!(p:'a->bool) q Pr. (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm3 THEN ASM_REWRITE_TAC [] ; REPEAT STRIP_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; GEN_TAC THEN REWRITE_TAC [LEADSTO_thm5_lemma3] THEN DISCH_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) ] ]);; (* Prove: !P Q Pr. (P LEADSTO Q) [] = false *) (* Theorem LEADSTO_thm10 does Not hold for the generalised disjunctive rule, since: (!P. (p = LUB P) /\ (!p'. p' In P ==> F) ==> F)) is only satisfied when P is non-empty let LEADSTO_thm10 = prove_thm ("LEADSTO_thm10", (`!(p:'a->bool) q. (p LEADSTO q) [] = F`), REPEAT GEN_TAC THEN REWRITE_TAC [LEADSTO;LeadstoRel] THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). F`) THEN BETA_TAC THEN REWRITE_TAC [ENSURES_thm0] THEN REPEAT GEN_TAC THEN REWRITE_TAC [DE_MORGAN_THM] THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL IMP_DISJ_THM))] THEN REWRITE_TAC [In,LUB] THEN STRIP_TAC THEN CONV_TAC NOT_FORALL_CONV THEN REWRITE_TAC [] THEN ... *) (* Prove: (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) = (p LEADSTO q)Pr *) let LEADSTO_thm11 = prove_thm ("LEADSTO_thm11", (`!(p:'a->bool) q st Pr. (?r. (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr)) = (p LEADSTO q)(CONS st Pr)`), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ IMP_RES_TAC LEADSTO_thm2 ; EXISTS_TAC (`p:'a->bool`) THEN ASM_REWRITE_TAC [ENSURES_thm1] ]);; (* Prove: !P Pr. (P LEADSTO P) (CONS st Pr) *) let LEADSTO_thm12 = prove_thm ("LEADSTO_thm12", (`!(p:'a->bool) st Pr. (p LEADSTO p) (CONS st Pr)`), REPEAT GEN_TAC THEN ONCE_REWRITE_TAC [SYM (SPEC_ALL LEADSTO_thm5)] THEN DISJ1_TAC THEN REWRITE_TAC [ENSURES_thm1]);; (* Prove: (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) = (p LEADSTO q)Pr *) let LEADSTO_thm13 = prove_thm ("LEADSTO_thm13", (`!(p:'a->bool) q st Pr. (?r. (p LEADSTO r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr)) = (p LEADSTO q)(CONS st Pr)`), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ IMP_RES_TAC LEADSTO_thm1 ; EXISTS_TAC (`p:'a->bool`) THEN ASM_REWRITE_TAC [LEADSTO_thm12] ]);; (* Prove: (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) = (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) *) let LEADSTO_thm14 = prove_thm ("LEADSTO_thm14", (`!(p:'a->bool) q st Pr. (?r. (p LEADSTO r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr)) = (?r. (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr))`), REPEAT GEN_TAC THEN REWRITE_TAC [LEADSTO_thm11; LEADSTO_thm13]);; (* Prove: |- !p q Pr. (p ENSURES q)Pr \/ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr *) let LEADSTO_thm15 = prove_thm ("LEADSTO_thm15", (`!(p:'a->bool) q Pr. ((p ENSURES q) Pr \/ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = (p LEADSTO q)Pr`), REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ IMP_RES_TAC LEADSTO_thm0 ; ACCEPT_TAC (MP (SPEC_ALL LEADSTO_thm2) (SPEC_ALL (ASSUME (`!r:'a->bool. (p ENSURES r)Pr /\ (r LEADSTO q)Pr`)))) ; IMP_RES_TAC LEADSTO_thm3 ; DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; GEN_TAC THEN REWRITE_TAC [LEADSTO_thm5_lemma3] THEN DISCH_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) ] ]);; (* Prove: |- !p q Pr. (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr *) let LEADSTO_thm16 = prove_thm ("LEADSTO_thm16", (`!(p:'a->bool) q Pr. ((!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = (p LEADSTO q)Pr`), REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ ACCEPT_TAC (MP (SPEC_ALL LEADSTO_thm2) (SPEC_ALL (ASSUME (`!r:'a->bool. (p ENSURES r)Pr /\ (r LEADSTO q)Pr`)))) ; IMP_RES_TAC LEADSTO_thm3 ; DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; GEN_TAC THEN REWRITE_TAC [LEADSTO_thm5_lemma3] THEN DISCH_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) ] ]);; (* Finally prove one of the used LEADSTO induction principles in CM88: |- !X p q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) ==> (p LEADSTO q)Pr ==> X p q Pr *) let STRUCT_lemma0 = TAC_PROOF (([], (` (!p:'a->bool. p In P ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) = ((!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr))`)), EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let STRUCT_lemma00 = TAC_PROOF (([], (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) = (!p q. ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!r. ((p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr)) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr /\ ((p' LEADSTO q)Pr ==> X p' q Pr)) ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ IMP_RES_TAC LEADSTO_thm0 ; RES_TAC ; IMP_RES_TAC LEADSTO_thm1 ; RES_TAC ; IMP_RES_TAC STRUCT_lemma0 THEN IMP_RES_TAC LEADSTO_thm3a THEN RES_TAC THEN ASM_REWRITE_TAC [] ; IMP_RES_TAC STRUCT_lemma0 THEN IMP_RES_TAC LEADSTO_thm3a THEN RES_TAC THEN ASM_REWRITE_TAC [] ; RES_TAC ; RES_TAC ; ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma0)] (CONJ (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr ==> X p q Pr`)))) THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`((LUB P) LEADSTO (q:'a->bool))Pr`)] (SPEC (`LUB (P:('a->bool)->bool)`) (GEN_ALL (REWRITE_RULE [ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)`)] (SPEC_ALL (CONJUNCT2 (CONJUNCT2 (SPEC_ALL (ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!r. ((p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr)) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr /\ ((p' LEADSTO q)Pr ==> X p' q Pr)) ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr))`)))))))))) ]);; (* The induction theorem: *) let LEADSTO_thm17 = prove_thm ("LEADSTO_thm17", (`!X (p:'a->bool) q Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> (((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr))) ==> ((p LEADSTO q)Pr ==> X p q Pr)`), REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma00)] (BETA_RULE (SPEC (`\(p:'a->bool) q Pr. (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)`) (REWRITE_RULE [LEADSTO;LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`)))))) THEN RES_TAC);; (* A derived theorem for an induction tactic *) let LEADSTO_thm18 = prove_thm ("LEADSTO_thm18", (`!X. ((!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q Pr. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!(p:'a->bool) P q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma00)] (BETA_RULE (SPEC (`\ (p:'a->bool) q Pr. (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)`) (REWRITE_RULE [LEADSTO;LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`)))))) THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) r q Pr. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) P (q:'a->bool) Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr`); ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (ASSUME (`(!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p'. p' In P ==> (p' LEADSTO q)Pr) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr ==> X p' q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)`))));; (* Now prove another LEADSTO induction principle: *) let STRUCT_lemma1 = TAC_PROOF (([], (`(!p:'a->bool. p In P ==> (p LEADSTO q)Pr /\ X p q Pr) = ((!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr))`)), EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let STRUCT_lemma01 = TAC_PROOF (([], (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ X p q Pr) /\ (!r. ((p LEADSTO r)Pr /\ X p r Pr) /\ (r LEADSTO q)Pr /\ X r q Pr ==> (p LEADSTO q)Pr /\ X p q Pr) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr) ==> (p LEADSTO q)Pr /\ X p q Pr)) = (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ X p r Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ RES_TAC ; RES_TAC ; ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma1)] (CONJ (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) (ASSUME (`!p. p In P ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool) p q Pr`)))) THEN RES_TAC THEN ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p. (p = LUB P) ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool)p q Pr`)))) ; IMP_RES_TAC LEADSTO_thm0 ; RES_TAC ; IMP_RES_TAC LEADSTO_thm1 ; IMP_RES_TAC LEADSTO_thm1 THEN RES_TAC ; IMP_RES_TAC STRUCT_lemma1 THEN IMP_RES_TAC LEADSTO_thm3 ; IMP_RES_TAC STRUCT_lemma1 THEN IMP_RES_TAC LEADSTO_thm3a THEN RES_TAC THEN ASM_REWRITE_TAC [] ]);; (* The induction theorem: *) let LEADSTO_thm19 = prove_thm ("LEADSTO_thm19", (`!X (p:'a->bool) q Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ (X p r Pr) /\ (r LEADSTO q)Pr /\ (X r q Pr) ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) ==> ((p LEADSTO q)Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [STRUCT_lemma01] (BETA_RULE (SPEC (`\(p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q Pr)`) (REWRITE_RULE [LEADSTO;LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`)))))) THEN RES_TAC);; (* The derived theorem for the induction tactic *) let LEADSTO_thm20 = prove_thm ("LEADSTO_thm20", (`!X. ((!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q Pr. (p LEADSTO r)Pr /\ X p r Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ (!(p:'a->bool) P q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) r q Pr. (p LEADSTO r)Pr /\ X p r Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> (p LEADSTO q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) P q Pr. (!p:'a->bool. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr`); ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (REWRITE_RULE [STRUCT_lemma01](BETA_RULE (SPEC (`\(p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q Pr)`) (REWRITE_RULE [LEADSTO;LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))))));; (* Now prove a third LEADSTO induction principle: |- !X p q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (X p r Pr) /\ (X r q Pr) ==> X p q Pr) /\ (!P. (!i. X(P i)q Pr) ==> X(( ?* ) P)q Pr)) ==> (p LEADSTO q)Pr ==> X p q Pr *) let LEADSTO_thm21 = prove_thm ("LEADSTO_thm21", (`!X (p:'a->bool) q Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (X p r Pr) /\ (X r q Pr) ==> X p q Pr) /\ (!P. (p = LUB P) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) ==> ((p LEADSTO q)Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (BETA_RULE (SPEC (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). X p q Pr:bool`) (REWRITE_RULE [LEADSTO;LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))) THEN RES_TAC);; (* The theorem derived for an induction tactic *) let LEADSTO_thm22 = prove_thm ("LEADSTO_thm22", (`!X. ((!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q Pr. (X p r Pr) /\ (X r q Pr) ==> (X p q Pr)) /\ (!p P q Pr. (p = LUB P) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) (r:'a->bool) q (Pr:('a->'a)list). X p r Pr /\ X r q Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) P (q:'a->bool) (Pr:('a->'a)list). (p = LUB P) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr`); ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (REWRITE_RULE [SYM (SPEC_ALL CONJ_ASSOC)] (BETA_RULE (SPEC (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). X p q Pr:bool`) (REWRITE_RULE [LEADSTO;LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))))));; (* yet another LEADSTO induction principle: *) let LEADSTO_thm23_lemma00 = TAC_PROOF (([], (`!X Pr. ((!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr)) = (!p:'a->bool. p In P ==> (p LEADSTO q)Pr /\ X p q Pr)`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm23_lemma01 = TAC_PROOF (([], (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ X p q Pr) /\ (!r. ((p LEADSTO r)Pr /\ X p r Pr) /\ (r LEADSTO q)Pr /\ X r q Pr ==> (p LEADSTO q)Pr /\ X p q Pr) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr) ==> (p LEADSTO q)Pr /\ X p q Pr)) = (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ RES_TAC ; RES_TAC ; ASSUME_TAC (REWRITE_RULE [LEADSTO_thm23_lemma00] (CONJ (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) (ASSUME (`!p. p In P ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool) p q Pr`)))) THEN RES_TAC ; IMP_RES_TAC LEADSTO_thm0 ; RES_TAC ; IMP_RES_TAC LEADSTO_thm1 ; RES_TAC ; STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm23_lemma00)] (ASSUME (`!p':'a->bool. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr`))) THEN IMP_RES_TAC LEADSTO_thm3a THEN ASM_REWRITE_TAC [] ; STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm23_lemma00)] (ASSUME (`!p':'a->bool. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr`))) THEN RES_TAC ]);; let LEADSTO_thm23 = prove_thm ("LEADSTO_thm23", (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) ==> (!p q. (p LEADSTO q) Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm23_lemma01] (BETA_RULE (SPEC (`\(p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q Pr)`) (REWRITE_RULE [LEADSTO;LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q) Pr`)))))) THEN RES_TAC);; let LEADSTO_thm24_lemma01 = TAC_PROOF (([], (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) = (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THENL [ ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p. (p = LUB P) ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool) p q Pr`)))) ; ASM_REWRITE_TAC [] ]);; let LEADSTO_thm24 = prove_thm ("LEADSTO_thm24", (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X (LUB P) q Pr)) ==> (!p q. (p LEADSTO q) Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (UNDISCH (SPEC_ALL (UNDISCH (REWRITE_RULE [LEADSTO_thm24_lemma01] (SPEC_ALL LEADSTO_thm23))))));; (* Prove: !P Q st Pr. (!s. P s ==> Q s) ==> (P LEADSTO Q) (CONS st Pr) *) let LEADSTO_thm25 = prove_thm ("LEADSTO_thm25", (`!(p:'a->bool) q st Pr. (!s. p s ==> q s) ==> (p LEADSTO q) (CONS st Pr)`), REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm0) (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] ENSURES_cor1) (ASSUME (`!s:'a. p s ==> q s`)))));; (* Prove: |- !p q q' st Pr. (p LEADSTO q)(CONS st Pr) ==> (p LEADSTO (q \/* q'))(CONS st Pr) *) let LEADSTO_thm26 = prove_thm ("LEADSTO_thm26", (`!(p:'a->bool) q q' st Pr. (p LEADSTO q)(CONS st Pr) ==> (p LEADSTO (q \/* q'))(CONS st Pr)`), REPEAT GEN_TAC THEN DISCH_TAC THEN ASSUME_TAC (SPECL [(`q:'a->bool`); (`q':'a->bool`)] IMPLY_WEAK_lemma_b) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`q:'a->bool`); (`(q:'a->bool) \/* q'`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm25)) THEN IMP_RES_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`(q:'a->bool) \/* q'`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm1));; (* Prove: |- !p q p' q' st Pr. (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) ==> ((p \/* p') LEADSTO (q \/* q'))(CONS st Pr) *) let LEADSTO_thm27 = prove_thm ("LEADSTO_thm27", (`!(p:'a->bool) q p' q' st Pr. (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) ==> ((p \/* p') LEADSTO (q \/* q'))(CONS st Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm26)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p':'a->bool`); (`q':'a->bool`); (`q:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm26)) THEN ASSUME_TAC (ONCE_REWRITE_RULE [OR_COMM_lemma] (ASSUME (`((p':'a->bool) LEADSTO (q' \/* q))(CONS st Pr)`))) THEN IMP_RES_TAC (SPECL [(`p:'a->bool`); (`p':'a->bool`); (`(q:'a->bool) \/* q'`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm4));; (* Prove: |- !p q b r st Pr. (p LEADSTO (q \/* b))(CONS st Pr) /\ (b LEADSTO r)(CONS st Pr) ==> (p LEADSTO (q \/* r))(CONS st Pr) *) let LEADSTO_thm28 = prove_thm ("LEADSTO_thm28", (`!(p:'a->bool) q b r st Pr. (p LEADSTO (q \/* b))(CONS st Pr) /\ (b LEADSTO r)(CONS st Pr) ==> (p LEADSTO (q \/* r))(CONS st Pr)`), REPEAT GEN_TAC THEN STRIP_TAC THEN ASSUME_TAC (SPEC_ALL (SPEC (`q:'a->bool`) LEADSTO_thm12)) THEN ASSUME_TAC (MP (SPECL [(`b:'a->bool`); (`r:'a->bool`); (`q:'a->bool`); (`q:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm27) (CONJ (ASSUME (`((b:'a->bool) LEADSTO r)(CONS st Pr)`)) (ASSUME (`((q:'a->bool) LEADSTO q)(CONS st Pr)`)))) THEN ACCEPT_TAC (MP (SPECL [(`p:'a->bool`); (`(q:'a->bool) \/* b`); (`(q:'a->bool) \/* r`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm1) (CONJ (ASSUME (`((p:'a->bool) LEADSTO (q \/* b))(CONS st Pr)`)) (ONCE_REWRITE_RULE [OR_COMM_lemma] (ASSUME (`(((b:'a->bool) \/* q) LEADSTO (r \/* q))(CONS st Pr)`))))));; (* Prove: !p q r b Pr. (p LEADSTO q)Pr /\ (r UNLESS b)Pr ==> ((p /\* r) LEADSTO ((q /\* r) \/* b))Pr *) let LEADSTO_thm29_lemma00 = (SPEC (`CONS (st:'a->'a) Pr`) (GEN (`Pr:('a->'a)list`) (BETA_RULE (SPEC_ALL (SPEC (`\(p:'a->bool) q Pr. (r UNLESS b) Pr ==> ((p /\* r) LEADSTO ((q /\* r) \/* b)) Pr`) LEADSTO_thm17)))));; let LEADSTO_thm29_lemma05_1 = TAC_PROOF (([], (`(!p'':'a->bool. p'' In P ==> (p'' LEADSTO q')(CONS st Pr)) ==> (!p''. p'' In P ==> (p'' LEADSTO q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> (!p''. p'' In P ==> (r UNLESS b)(CONS st Pr) ==> ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC);; let LEADSTO_thm29_lemma05_2 = TAC_PROOF (([], (`!(P:('a->bool)->bool) r q st Pr. (!p. p In P ==> ((p /\* r) LEADSTO q)(CONS st Pr)) ==> (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) ==> (((LUB P) /\* r) LEADSTO q)(CONS st Pr)`)), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm3a THEN ASSUME_TAC (SPECL [(`LUB (P:('a->bool)->bool)`); (`r:'a->bool`)] SYM_AND_IMPLY_WEAK_lemma) THEN ASSUME_TAC (UNDISCH (SPEC_ALL (SPECL [(`(LUB P) /\* (r:'a->bool)`); (`(LUB P):'a->bool`)] ENSURES_cor1))) THEN IMP_RES_TAC LEADSTO_thm0 THEN IMP_RES_TAC LEADSTO_thm1);; let LEADSTO_thm29_lemma05_3 = TAC_PROOF (([], (`!(p:'a->bool) P r. p In (\p''. ?p'. p' In P /\ (p'' = p' /\* r)) = (?p'. p' In P /\ (p = p' /\* r))`)), REWRITE_TAC [IN] THEN BETA_TAC THEN REWRITE_TAC []);; let LEADSTO_thm29_lemma05_4 = TAC_PROOF (([], (`!s:'a. ((LUB P) /\* r)s = (LUB(\p. ?p'. p' In P /\ (p = p' /\* r)))s`)), REPEAT GEN_TAC THEN REWRITE_TAC [LUB; AND_def ] THEN BETA_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ EXISTS_TAC (`\s:'a. p s /\ r s`) THEN BETA_TAC THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC (`p:'a->bool`) THEN ASM_REWRITE_TAC [IN] ; EXISTS_TAC (`p':'a->bool`) THEN REWRITE_TAC [REWRITE_RULE [IN] (ASSUME (`(p':'a->bool) In P`))] THEN STRIP_ASSUME_TAC (BETA_RULE (SUBS [ASSUME (`p = (\s:'a. p' s /\ r s)`)] (ASSUME (`(p:'a->bool) s`)))) ; STRIP_ASSUME_TAC (BETA_RULE (SUBS [ASSUME (`p = (\s:'a. p' s /\ r s)`)] (ASSUME (`(p:'a->bool) s`)))) ]);; let LEADSTO_thm29_lemma05_5 = TAC_PROOF (([], (`!(P:('a->bool)->bool) r q' b st Pr. (!p''. p'' In P ==> ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> (!p. (?p'. p' In P /\ (p = p' /\* r)) ==> (p LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let LEADSTO_thm29_lemma05_6 = TAC_PROOF (([], (`!(P:('a->bool)->bool) r q' b st Pr. (!p''. p'' In P ==> ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> ((((LUB P) /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm29_lemma05_3] (SPECL [(`\p:'a->bool. ?p'. p' In P /\ (p = (p' /\* r))`); (`(q' /\* r) \/* (b:'a->bool)`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm3a)) THEN ASSUME_TAC (REWRITE_RULE [UNDISCH (SPEC_ALL LEADSTO_thm29_lemma05_5)] (ASSUME (`(!p:'a->bool. (?p'. p' In P /\ (p = p' /\* r)) ==> (p LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> ((LUB(\p. ?p'. p' In P /\ (p = p' /\* r))) LEADSTO ((q' /\* r) \/* b)) (CONS st Pr)`))) THEN ASM_REWRITE_TAC [REWRITE_RULE [ETA_AX] (MK_ABS LEADSTO_thm29_lemma05_4)]);; let LEADSTO_thm29_lemma05 = TAC_PROOF (([], (`!(p':'a->bool) q' r b st Pr. ((p' ENSURES q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((p' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) /\ (!r'. (p' LEADSTO r')(CONS st Pr) /\ ((p' LEADSTO r')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((p' /\* r) LEADSTO ((r' /\* r) \/* b))(CONS st Pr)) /\ (r' LEADSTO q')(CONS st Pr) /\ ((r' LEADSTO q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((r' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> (p' LEADSTO q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((p' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) /\ (!P. (!p''. p'' In P ==> (p'' LEADSTO q')(CONS st Pr)) /\ (!p''. p'' In P ==> (p'' LEADSTO q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> ((LUB P) LEADSTO q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> (((LUB P) /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), REPEAT GEN_TAC THEN REPEAT CONJ_TAC THENL [ REPEAT STRIP_TAC THEN IMP_RES_TAC ENSURES_thm4 THEN ASSUME_TAC (SPECL [(`p':'a->bool`); (`q':'a->bool`); (`b:'a->bool`); (`r:'a->bool`)] IMPLY_WEAK_lemma6) THEN ASSUME_TAC (MP (SPECL [(`(r:'a->bool) /\* p'`); (`((r:'a->bool) /\* q') \/* ((p' /\* b) \/* (b /\* q'))`); (`((q':'a->bool) /\* r) \/* b`); (`(CONS st Pr):('a->'a)list`)] ENSURES_thm2) (CONJ (REWRITE_RULE [OR_ASSOC_lemma] (ASSUME (`(((r:'a->bool) /\* p') ENSURES (((r /\* q') \/* (p' /\* b)) \/* (b /\* q')))(CONS st Pr)`))) (ASSUME (`!s:'a. ((r /\* q') \/* ((p' /\* b) \/* (b /\* q')))s ==> ((q' /\* r) \/* b)s`)))) THEN ONCE_REWRITE_TAC [AND_COMM_lemma] THEN ONCE_REWRITE_TAC [AND_COMM_OR_lemma] THEN IMP_RES_TAC (SPECL [(`(r:'a->bool) /\* p'`); (`((q':'a->bool) /\* r) \/* b`); (`(CONS st Pr):('a->'a)list`)] LEADSTO_thm0) ; REPEAT STRIP_TAC THEN ASSUME_TAC (MP (MP (ASSUME (`((p':'a->bool) LEADSTO r')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((p' /\* r) LEADSTO ((r' /\* r) \/* b))(CONS st Pr)`)) (ASSUME (`((p':'a->bool) LEADSTO r')(CONS st Pr)`))) (ASSUME (`((r:'a->bool) UNLESS b)(CONS st Pr)`))) THEN ASSUME_TAC (MP (MP (ASSUME (`((r':'a->bool) LEADSTO q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> ((r' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)`)) (ASSUME (`((r':'a->bool) LEADSTO q')(CONS st Pr)`))) (ASSUME (`((r:'a->bool) UNLESS b)(CONS st Pr)`))) THEN ACCEPT_TAC (REWRITE_RULE [OR_ASSOC_lemma; OR_OR_lemma] (ONCE_REWRITE_RULE [OR_COMM_lemma] (MP (SPECL [(`(p':'a->bool) /\* r`); (`b:'a->bool`); (`(r':'a->bool) /\* r`); (`((q':'a->bool) /\* r) \/* b`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28) (CONJ (ONCE_REWRITE_RULE [OR_COMM_lemma] (ASSUME (`(((p':'a->bool) /\* r) LEADSTO ((r' /\* r) \/* b))(CONS st Pr)`))) (ASSUME (`(((r':'a->bool) /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)`)))))) ; REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`((r:'a->bool) UNLESS b)(CONS st Pr)`)] (UNDISCH_ALL LEADSTO_thm29_lemma05_1)) THEN IMP_RES_TAC LEADSTO_thm29_lemma05_6 ]);; let LEADSTO_thm29_lemma06 = GEN_ALL (MP (SPEC_ALL LEADSTO_thm29_lemma00) (GEN (`p':'a->bool`) (GEN (`q':'a->bool`) (SPEC_ALL LEADSTO_thm29_lemma05))));; let LEADSTO_thm29 = prove_thm ("LEADSTO_thm29", (`!(p:'a->bool) q r b st Pr. (p LEADSTO q)(CONS st Pr) /\ (r UNLESS b)(CONS st Pr) ==> ((p /\* r) LEADSTO ((q /\* r) \/* b))(CONS st Pr)`), REPEAT STRIP_TAC THEN REWRITE_TAC [UNDISCH_ALL (SPEC_ALL LEADSTO_thm29_lemma06)]);; (* Prove: !p st Pr. (p LEADSTO False)(CONS st Pr) ==> (!s. Not p s) *) let LEADSTO_thm30_lemma00 = BETA_RULE (SPEC (`CONS (st:'a->'a) Pr`) (GEN (`Pr:('a->'a)list`) (BETA_RULE (SPEC_ALL (SPEC (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). (q = False) ==> (!s. Not p s)`) LEADSTO_thm21)))));; let LEADSTO_thm30_lemma01 = TAC_PROOF (([], (`!(r:'a->bool). (!s. Not r s) ==> (!s. r s = False s)`)), REWRITE_TAC [NOT_def1; FALSE_def] THEN BETA_TAC THEN REWRITE_TAC []);; (* |- (!s. Not r s) ==> (r = False) *) let LEADSTO_thm30_lemma02 = (DISCH_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (UNDISCH (SPEC_ALL LEADSTO_thm30_lemma01)))));; let LEADSTO_thm30_lemma03 = TAC_PROOF (([], (`!p:'a->bool. (p' = (\s:'a->'a. ?p. P p /\ p s)) ==> (!s. p' s = ?p. P p /\ p s)`)), GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN ONCE_ASM_REWRITE_TAC [] THEN BETA_TAC THEN REFL_TAC);; let LEADSTO_thm30_lemma04 = TAC_PROOF (([], (`!(p':'a->bool) (q':'a->bool). ((p' ENSURES q')(CONS st Pr) ==> (q' = False) ==> (!s. Not p' s)) /\ (!r:'a->bool. ((r = False) ==> (!s. Not p' s)) /\ ((q' = False) ==> (!s. Not r s)) ==> (q' = False) ==> (!s. Not p' s)) /\ (!P:('a->bool)->bool. (p' = LUB P) /\ (!p''. p'' In P ==> (q' = False) ==> (!s. Not p'' s)) ==> (q' = False) ==> (!s. Not p' s))`)), REPEAT GEN_TAC THEN REPEAT CONJ_TAC THENL [ REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`(q':'a->bool) = False`)] (ASSUME (`((p':'a->bool) ENSURES q')(CONS st Pr)`))) THEN IMP_RES_TAC ENSURES_thm3 THEN ASM_REWRITE_TAC [] ; REPEAT STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC LEADSTO_thm30_lemma02 THEN RES_TAC THEN ASM_REWRITE_TAC [] ; REPEAT GEN_TAC THEN REWRITE_TAC [LUB; IN; NOT_def1; FALSE_def] THEN BETA_TAC THEN REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`(q':'a->bool) = \s. F`)] (ASSUME (`!p'':'a->bool. P p'' ==> ((q':'a->bool) = \s. F) ==> (!s. ~p'' s)`))) THEN IMP_RES_TAC LEADSTO_thm30_lemma03 THEN UNDISCH_TAC(`(p':'a->bool)s`) THEN ASM_REWRITE_TAC [] THEN BETA_TAC THEN REPEAT STRIP_TAC THEN RES_TAC ]);; (* |- !p q st Pr. (p LEADSTO q)(CONS st Pr) ==> (q = False) ==> (!s. Not p s) *) let LEADSTO_thm30_lemma05 = GEN_ALL (MP (SPEC_ALL LEADSTO_thm30_lemma00) LEADSTO_thm30_lemma04);; let LEADSTO_thm30_lemma06 = TAC_PROOF (([], (`!(p:'a->bool) st Pr. (p LEADSTO False)(CONS st Pr) ==> (?q. (q = False) /\ (p LEADSTO q)(CONS st Pr))`)), REPEAT STRIP_TAC THEN EXISTS_TAC (`False:'a->bool`) THEN ASM_REWRITE_TAC []);; (* Now Prove: |- !p st Pr. (p LEADSTO False)(CONS st Pr) ==> (!s. Not p s) *) let LEADSTO_thm30 = prove_thm ("LEADSTO_thm30", (`!(p:'a->bool) st Pr. (p LEADSTO False)(CONS st Pr) ==> (!s. Not p s)`), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm30_lemma06 THEN REWRITE_TAC [UNDISCH_ALL (SPEC_ALL LEADSTO_thm30_lemma05)]);; (* Prove: |- !p b q Pr. ((p /\* b) LEADSTO q)Pr /\ ((p /\* (Not b)) LEADSTO q)Pr ==> (p LEADSTO q)Pr *) let LEADSTO_cor1 = prove_thm ("LEADSTO_cor1", (`!(p:'a->bool) b q Pr. ((p /\* b) LEADSTO q) Pr /\ ((p /\* (Not b)) LEADSTO q) Pr ==> (p LEADSTO q) Pr`), REPEAT STRIP_TAC THEN IMP_RES_TAC (SPECL [(`(p:'a->bool) /\* b`); (`(p:'a->bool) /\* (Not b)`); (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO_thm4) THEN ACCEPT_TAC (REWRITE_RULE [SYM (SPEC_ALL AND_OR_DISTR_lemma); P_OR_NOT_P_lemma; AND_True_lemma] (ASSUME (`((((p:'a->bool) /\* b) \/* (p /\* (Not b))) LEADSTO q)Pr`))));; (* Prove: |- !p q r st Pr. (p LEADSTO q)(CONS st Pr) /\ r STABLE (CONS st Pr) ==> ((p /\* r) LEADSTO (q /\* r))(CONS st Pr) *) let LEADSTO_cor2 = prove_thm ("LEADSTO_cor2", (`!(p:'a->bool) q r st Pr. (p LEADSTO q)(CONS st Pr) /\ r STABLE (CONS st Pr) ==> ((p /\* r) LEADSTO (q /\* r))(CONS st Pr)`), REPEAT GEN_TAC THEN REWRITE_TAC [STABLE] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm29 THEN ACCEPT_TAC (REWRITE_RULE [OR_False_lemma] (ASSUME (`(((p:'a->bool) /\* r) LEADSTO ((q /\* r) \/* False))(CONS st Pr)`))));; (* Prove: |- !p q st Pr. (p LEADSTO q)(CONS st Pr) = ((p /\* (Not q)) LEADSTO q)(CONS st Pr) *) let LEADSTO_cor3 = prove_thm ("LEADSTO_cor3", (`!(p:'a->bool) q st Pr. (p LEADSTO q)(CONS st Pr) = ((p /\* (Not q)) LEADSTO q)(CONS st Pr)`), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ ASSUME_TAC (REWRITE_RULE [NOT_NOT_lemma] (SPECL [(`Not (q:'a->bool)`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm2)) THEN IMP_RES_TAC LEADSTO_thm29 THEN ASSUME_TAC (REWRITE_RULE [P_AND_NOT_P_lemma] (ASSUME (`(((p:'a->bool) /\* (Not q)) LEADSTO ((q /\* (Not q)) \/* q))(CONS st Pr)`))) THEN ACCEPT_TAC (REWRITE_RULE [OR_False_lemma] (ONCE_REWRITE_RULE [OR_COMM_lemma] (ASSUME (`(((p:'a->bool) /\* (Not q)) LEADSTO (False \/* q))(CONS st Pr)`)))) ; ASSUME_TAC (MP (SPECL [(`(p:'a->bool) /\* q`); (`q:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm25) (SPECL [(`p:'a->bool`); (`q:'a->bool`)] AND_IMPLY_WEAK_lemma)) THEN IMP_RES_TAC LEADSTO_cor1 ]);; (* Prove: |- !p b q st Pr. ((p /\* b) LEADSTO q)(CONS st Pr) /\ ((p /\* (Not b)) LEADSTO ((p /\* b) \/* q))(CONS st Pr) ==> (p LEADSTO q)(CONS st Pr) *) let LEADSTO_cor4 = prove_thm ("LEADSTO_cor4", (`!(p:'a->bool) b q st Pr. ((p /\* b) LEADSTO q)(CONS st Pr) /\ ((p /\* (Not b)) LEADSTO ((p /\* b) \/* q))(CONS st Pr) ==> (p LEADSTO q)(CONS st Pr)`), ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm28 THEN ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] (ASSUME (`(((p:'a->bool) /\* (Not b)) LEADSTO (q \/* q))(CONS st Pr)`))) THEN IMP_RES_TAC LEADSTO_cor1);; (* Prove: |- !p q r st Pr. ((p /\* q) LEADSTO r)(CONS st Pr) ==> (p LEADSTO ((Not q) \/* r))(CONS st Pr) *) let LEADSTO_cor5 = prove_thm ("LEADSTO_cor5", (`!(p:'a->bool) q r st Pr. ((p /\* q) LEADSTO r)(CONS st Pr) ==> (p LEADSTO ((Not q) \/* r))(CONS st Pr)`), REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [LEADSTO_cor3] THEN REWRITE_TAC [NOT_OR_AND_NOT_lemma; NOT_NOT_lemma] THEN ASSUME_TAC (REWRITE_RULE [NOT_NOT_lemma] (SPECL [(`Not (r:'a->bool)`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm2)) THEN IMP_RES_TAC LEADSTO_thm29 THEN ASSUME_TAC (REWRITE_RULE [AND_ASSOC_lemma; P_AND_NOT_P_lemma] (ASSUME (`((((p:'a->bool) /\* q) /\* (Not r)) LEADSTO ((r /\* (Not r)) \/* r)) (CONS st Pr)`))) THEN ASSUME_TAC (REWRITE_RULE [OR_False_lemma] (ONCE_REWRITE_RULE [OR_COMM_lemma] (ASSUME (`(((p:'a->bool) /\* (q /\* (Not r))) LEADSTO (False \/* r))(CONS st Pr)`)))) THEN ASSUME_TAC (MP (SPEC_ALL (SPECL [(`r:'a->bool`); (`(Not (q:'a->bool)) \/* r`)] LEADSTO_thm25)) (SPECL [(`r:'a->bool`); (`Not (q:'a->bool)`)] SYM_OR_IMPLY_WEAK_lemma)) THEN IMP_RES_TAC LEADSTO_thm1);; (* Prove: |- !p q r st Pr. (p LEADSTO q)(CONS st Pr) /\ (r UNLESS (q /\* r))(CONS st Pr) ==> ((p /\* r) LEADSTO (q /\* r))(CONS st Pr) *) let LEADSTO_cor6 = prove_thm ("LEADSTO_cor6", (`!(p:'a->bool) q r st Pr. (p LEADSTO q)(CONS st Pr) /\ (r UNLESS (q /\* r))(CONS st Pr) ==> ((p /\* r) LEADSTO (q /\* r))(CONS st Pr)`), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm29 THEN ACCEPT_TAC (REWRITE_RULE [OR_OR_lemma] (ASSUME (`(((p:'a->bool) /\* r) LEADSTO ((q /\* r) \/* (q /\* r)))(CONS st Pr)`))));; (* Prove: |- !p q r st Pr. (p LEADSTO q)(CONS st Pr) /\ (r /\* (Not q)) STABLE (CONS st Pr) ==> (!s. (p /\* r)s ==> q s) *) let LEADSTO_cor7 = prove_thm ("LEADSTO_cor7", (`!(p:'a->bool) q r st Pr. (p LEADSTO q)(CONS st Pr) /\ (r /\* (Not q)) STABLE (CONS st Pr) ==> (!s. (p /\* r)s ==> q s)`), REPEAT GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC LEADSTO_cor2 THEN ASSUME_TAC (REWRITE_RULE [(SYM (SPEC_ALL AND_ASSOC_lemma)); P_AND_NOT_P_lemma] (ONCE_REWRITE_RULE [AND_AND_COMM_lemma] (ASSUME (`(((p:'a->bool) /\* (r /\* (Not q))) LEADSTO (q /\* (r /\* (Not q))))(CONS st Pr)`)))) THEN ASSUME_TAC (REWRITE_RULE [AND_False_lemma] (ONCE_REWRITE_RULE [AND_COMM_lemma] (ASSUME (`((((p:'a->bool) /\* (Not q)) /\* r) LEADSTO (False /\* r)) (CONS st Pr)`)))) THEN IMP_RES_TAC LEADSTO_thm30 THEN GEN_TAC THEN MP_TAC (SPEC_ALL (ASSUME (`!s:'a. Not (r /\* (p /\* (Not q)))s`))) THEN REWRITE_TAC [NOT_def1; AND_def] THEN BETA_TAC THEN REWRITE_TAC [DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; (* Prove: |- !p r q st Pr. (p LEADSTO r)(CONS st Pr) ==> ((p /\* q) LEADSTO r)(CONS st Pr) *) let LEADSTO_cor8 = prove_thm ("LEADSTO_cor8", (`!(p:'a->bool) r q st Pr. (p LEADSTO r)(CONS st Pr) ==> ((p /\* q) LEADSTO r)(CONS st Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL [`p:'a->bool`; `q:'a->bool`] SYM_AND_IMPLY_WEAK_lemma) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [`(p:'a->bool) /\* q`; `p:'a->bool`; `st:'a->'a`; `Pr:('a->'a)list`] LEADSTO_thm25)) THEN IMP_RES_TAC LEADSTO_thm1);; (* Prove: |- !p q r st Pr. (p LEADSTO q)(CONS st Pr) /\ (!s. q s ==> r s) ==> (p LEADSTO r)(CONS st Pr) *) let LEADSTO_cor9 = prove_thm ("LEADSTO_cor9", (`!(p:'a->bool) q r st Pr. (p LEADSTO q)(CONS st Pr) /\ (!s. q s ==> r s) ==> (p LEADSTO r)(CONS st Pr)`), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm25 THEN ASSUME_TAC (SPEC_ALL (ASSUME (`!st Pr. ((q:'a->bool) LEADSTO r)(CONS st Pr)`))) THEN IMP_RES_TAC LEADSTO_thm1);; (* Prove: |- !P q Pr. (!i. ((P i) LEADSTO q)Pr) ==> (!i. (( \<=/* P i) LEADSTO q)Pr) *) let LEADSTO_cor10 = prove_thm ("LEADSTO_cor10", (`!(P:num->'a->bool) q Pr. (!i. ((P i) LEADSTO q)Pr) ==> (!i. (( \<=/* P i) LEADSTO q)Pr)`), REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [ ASM_REWRITE_TAC [OR_LE_N_def] ; REWRITE_TAC [OR_LE_N_def] THEN ACCEPT_TAC (MP (SPECL [(` \<=/* (P:num->'a->bool) i`); (`(P:num->'a->bool) (SUC i)`); (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO_thm4) (CONJ (ASSUME (`(( \<=/* (P:num->'a->bool) i) LEADSTO q)Pr`)) (SPEC (`SUC i`) (ASSUME (`!i. (((P:num->'a->bool) i) LEADSTO q)Pr`))))) ]);; (* Prove: !p st Pr. (False LEADSTO p) (CONS st Pr) *) let LEADSTO_cor11 = prove_thm ("LEADSTO_cor11", (`!(p:'a->bool) st Pr. (False LEADSTO p) (CONS st Pr)`), REPEAT GEN_TAC THEN REWRITE_TAC [LEADSTO;LeadstoRel] THEN REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ENSURES_cor6] (CONJUNCT1 (SPECL [(`False:'a->bool`); (`p:'a->bool`)] (ASSUME (`!(p:'a->bool) q. ((p ENSURES q)(CONS st Pr) ==> R p q(CONS st Pr)) /\ (!r. R p r(CONS st Pr) /\ R r q(CONS st Pr) ==> R p q(CONS st Pr)) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q(CONS st Pr)) ==> R p q(CONS st Pr))`))))));; (* Prove: |- !P q st Pr. (!i. ((P i) LEADSTO q)(CONS st Pr)) ==> (!i. (( \'a->bool) q st Pr. (!i. ((P i) LEADSTO q)(CONS st Pr)) ==> (!i. (( \'a->bool) i`); (`(P:num->'a->bool) i`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm4) (CONJ (ASSUME (`(( \'a->bool) i) LEADSTO q)(CONS st Pr)`)) (SPEC (`i:num`) (ASSUME (`!i. (((P:num->'a->bool) i) LEADSTO q)(CONS st Pr)`))))));; (* We now want to introduce some tactics for allowing structural induction of leadsto relations, but we have problems with the induction principle for the completion theorem: !P Q R P' Q' Pr. (P LEADSTO Q)Pr /\ (P' LEADSTO Q')Pr /\ (Q UNLESS R)Pr /\ (Q' UNLESS R)Pr ==> ((P /\* P') LEADSTO ((Q /\* Q') \/* R))Pr since this theorems demands another induction principle not directly derivable from the given definition of leadsto. We circumvent the problem by proving that leadsto may be defined by another functional. This time we use the results of Tarski directly. *) (* *) (* Suppose we wanted to change the transitive inductitive axiom into p ensures r, r leadsto q --------------------------- (2) p leadsto q instead of the previous given. Let us investigate the following definition a litte: Now the functional becomes *) (* |- !R Pr. LEADSTO2Fn R Pr = (\p q. (p ENSURES q) Pr \/ (?r. (p ENSURES r) Pr /\ R r q Pr) \/ (?P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr))) *) let LEADSTO2Fn = new_definition (`LEADSTO2Fn R = \(p:'a->bool) q Pr. (p ENSURES q) Pr \/ (?r. (p ENSURES r) Pr /\ R r q Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> R p q Pr))`);; (* |- !p q Pr. LEADSTO2 p q Pr = (!R Pr. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) ==> R p q Pr) *) let LEADSTO2 = new_definition (`LEADSTO2 (p:'a->bool) q Pr = !R. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> R p q Pr`);; (* |- !R p q Pr. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> (!p q. (\p q Pr. !R. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> R p q Pr) p q Pr ==> R p q Pr) *) let LEADSTO2Imply_1 = TAC_PROOF (([], (`!R (p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> (!p q. (\p q Pr. !R. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> R p q Pr) p q Pr ==> R p q Pr)`)), BETA_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; (* |- !R1 R2 Pr. (!p q. R1 p q Pr ==> R2 p q Pr) ==> (!p q. LEADSTO2Fn R1 p q Pr ==> LEADSTO2Fn R2 p q Pr) *) let IsMonoLEADSTO2 = TAC_PROOF (([], (`!R1 R2 (Pr:('a->'a)list). (!p q. R1 p q Pr ==> R2 p q Pr) ==> (!p q. LEADSTO2Fn R1 p q Pr ==> LEADSTO2Fn R2 p q Pr)`)), REWRITE_TAC [LEADSTO2Fn] THEN BETA_TAC THEN REPEAT STRIP_TAC THENL [ ASM_REWRITE_TAC [] ; RES_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN EXISTS_TAC (`r:'a->bool`) THEN ASM_REWRITE_TAC [] ; DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`P:('a->bool)->bool`) THEN ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC ]);; (* LEADSTO2th = |- LEADSTO2 = (\p q Pr. !R. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) ==> R p q Pr) *) let LEADSTO2th = (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`p:'a->bool`) (MK_ABS (GEN (`q:'a->bool`) (MK_ABS (GEN (`Pr:('a->'a)list`) (SPEC_ALL LEADSTO2))))))));; (* |- !p q Pr. LEADSTO2Fn LEADSTO2 p q Pr ==> LEADSTO2 p q Pr *) let LEADSTO2Imply1 = TAC_PROOF (([], (`!(p:'a->bool) q Pr. LEADSTO2Fn LEADSTO2 p q Pr ==> LEADSTO2 p q Pr`)), REPEAT GEN_TAC THEN ASSUME_TAC (GENL [(`R1:('a->bool)->('a->bool)->(('a->'a)list)->bool`); (`R2:('a->bool)->('a->bool)->(('a->'a)list)->bool`)] (SPEC_ALL IsMonoLEADSTO2)) THEN REWRITE_TAC [LEADSTO2th] THEN BETA_TAC THEN REPEAT STRIP_TAC THEN ASSUME_TAC (MP (SPEC_ALL (MP (BETA_RULE (SPEC_ALL (SPECL [(`\(p:'a->bool) q Pr. !R. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) ==> R p q Pr`); (`R:('a->bool)->('a->bool)->(('a->'a)list)->bool`)] IsMonoLEADSTO2))) (BETA_RULE (MP (SPEC_ALL LEADSTO2Imply_1) (ASSUME (`!(p':'a->bool) q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr`)))))) (ASSUME (`LEADSTO2Fn (\(p:'a->bool) q Pr. !R. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) ==> R p q Pr) p q Pr`))) THEN RES_TAC);; (* |- !p q Pr. LEADSTO2 p q Pr ==> LEADSTO2Fn LEADSTO2 p q Pr *) let LEADSTO2Imply2 = TAC_PROOF (([], (`!(p:'a->bool) q Pr. LEADSTO2 p q Pr ==> LEADSTO2Fn LEADSTO2 p q Pr`)), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ETA_AX] (MP (BETA_RULE (SPECL [(`\p q Pr. LEADSTO2Fn LEADSTO2 (p:'a->bool) q Pr`); (`LEADSTO2:('a->bool)->('a->bool)->(('a->'a)list)->bool`); (`Pr:('a->'a)list`)] IsMonoLEADSTO2)) (GENL [(`p:'a->bool`); (`q:'a->bool`)] (SPEC_ALL LEADSTO2Imply1)))) THEN ACCEPT_TAC (UNDISCH (GEN_ALL (SPEC (`LEADSTO2Fn (LEADSTO2:('a->bool)->('a->bool)->(('a->'a)list)->bool)`) (BETA_RULE (REWRITE_RULE [LEADSTO2] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`))))))));; (* |- !p q Pr. LEADSTO2 p q Pr = LEADSTO2Fn LEADSTO2 p q Pr *) let LEADSTO2EQs = TAC_PROOF (([], (`!(p:'a->bool) q Pr. LEADSTO2 p q Pr = LEADSTO2Fn LEADSTO2 p q Pr`)), REPEAT STRIP_TAC THEN EQ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO2Imply2) ; ACCEPT_TAC (SPEC_ALL LEADSTO2Imply1) ]);; (* |- LEADSTO2 = LEADSTO2Fn LEADSTO2 *) let LEADSTO2EQ = (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`p:'a->bool`) (MK_ABS (GEN (`q:'a->bool`) (MK_ABS (GEN (`Pr:('a->'a)list`) (SPEC_ALL LEADSTO2EQs))))))));; (* |- !R. (R = LEADSTO2Fn R) ==> (!p q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr) *) let LEADSTO2Thm1_1 = TAC_PROOF (([], (`!R. (R = LEADSTO2Fn R) ==> (!(p:'a->bool) q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr)`)), REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [ASSUME (`R = LEADSTO2Fn (R:('a->bool)->('a->bool)->(('a->'a)list)->bool)`)] THEN REWRITE_TAC [ASSUME (`LEADSTO2Fn R (p:'a->bool) q Pr`)]);; (* |- !R. (R = LEADSTO2Fn R) ==> (!p q Pr. LEADSTO2 p q Pr ==> R p q Pr) *) let LEADSTO2MinFixThm = TAC_PROOF (([], (`!R. (R = LEADSTO2Fn R) ==> (!(p:'a->bool) q Pr. LEADSTO2 p q Pr ==> R p q Pr)`)), REWRITE_TAC [LEADSTO2] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (SPEC_ALL (ASSUME (`!R. (!(p':'a->bool) q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) ==> R p q Pr`))) THEN ASSUME_TAC (GENL [(`p:'a->bool`); (`q:'a->bool`)] (SPEC_ALL (UNDISCH (SPEC_ALL LEADSTO2Thm1_1)))) THEN RES_TAC);; (* |- !R. (!p q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> (!p q Pr. LEADSTO2 p q Pr ==> R p q Pr) *) let LEADSTO2InductThm = TAC_PROOF (([], (`!R. (!(p:'a->bool) q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> (!p q Pr. LEADSTO2 p q Pr ==> R p q Pr)`)), REPEAT GEN_TAC THEN REWRITE_TAC [LEADSTO2] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (GENL [(`p:'a->bool`); (`q:'a->bool`)] (SPEC_ALL (ASSUME (`!(p:'a->bool) q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr`)))) THEN RES_TAC);; (* |- !R Pr. LEADSTO2Fam R Pr = (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr) *) let LEADSTO2Fam = new_definition (`LEADSTO2Fam R Pr = !(p:'a->bool) (q:'a->bool). ((p ENSURES q) Pr ==> R p q Pr) /\ (!r. (p ENSURES r) Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr)`);; (* |- !R Pr. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) = LEADSTO2Fam R Pr *) let LEADSTO2Fn_EQ_LEADSTO2Fam = TAC_PROOF (([], (`!R Pr. (!(p:'a->bool) q. LEADSTO2Fn R p q Pr ==> R p q Pr) = LEADSTO2Fam R Pr`)), REWRITE_TAC [LEADSTO2Fam; LEADSTO2Fn] THEN BETA_TAC THEN REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THENL [ REWRITE_TAC [REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p. (p = LUB (P:('a->bool)->bool)) ==> (R:('a->bool)->('a->bool)->(('a->'a)list)->bool) p q Pr`)))] ; ASM_REWRITE_TAC [] ]);; (* Prove that the wanted axioms 1; 2, 3 are really theorems for the found fixed point *) (* |- !p q Pr. (p ENSURES q)Pr ==> LEADSTO2 p q Pr *) let LEADSTO2_thm0 = prove_thm ("LEADSTO2_thm0", (`!(p:'a->bool) q Pr. (p ENSURES q) Pr ==> LEADSTO2 p q Pr`), REWRITE_TAC [LEADSTO2; LEADSTO2Fn] THEN BETA_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; (* |- !p r q Pr. (p ENSURES r)Pr /\ LEADSTO2 r q Pr ==> LEADSTO2 p q Pr *) let LEADSTO2_thm1 = prove_thm ("LEADSTO2_thm1", (`!(p:'a->bool) r q Pr. (p ENSURES r) Pr /\ (LEADSTO2 r q Pr) ==> (LEADSTO2 p q Pr)`), REWRITE_TAC [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC);; (* Prove: |- !P q Pr. (!p. p In P ==> LEADSTO2 p q Pr) ==> LEADSTO2(LUB P)q Pr *) let LEADSTO2_thm3_lemma1 = TAC_PROOF (([], (`(!p:'a->bool. p In P ==> (!R. (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr)) ==> R p q Pr)) ==> (!p. p In P ==> (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr)) ==> R p q Pr)`)), REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO2_thm3 = prove_thm ("LEADSTO2_thm3", (`!(P:('a->bool)->bool) q Pr. (!p. p In P ==> LEADSTO2 p q Pr) ==> LEADSTO2 (LUB P) q Pr`), REPEAT GEN_TAC THEN REWRITE_TAC [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (GEN_ALL (REWRITE_RULE[ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr)`)] (SPEC_ALL (UNDISCH (SPEC_ALL LEADSTO2_thm3_lemma1))))) THEN RES_TAC);; let LEADSTO2_thm3a = prove_thm ("LEADSTO2_thm3a", (`!(P:('a->bool)->bool) q Pr. (p = LUB P) /\ (!p. p In P ==> LEADSTO2 p q Pr) ==> LEADSTO2 p q Pr`), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO2_thm3 THEN ASM_REWRITE_TAC []);; (* !p1 p2 q Pr. (LEADSTO2 p1 q Pr) /\ (LEADSTO2 p2 q Pr) ==> (LEADSTO2 (p1 \/* p2) q Pr) *) (* To prove this we need some general lemmas about expressing two known relations as one relation: *) (* |- !p1 p2 s. (p1 \/* p2)s = LUB(\p. (p = p1) \/ (p = p2))s *) let LEADSTO2_thm4_lemma1a = TAC_PROOF (([], (`!(p1:'a->bool) p2 s. (p1 \/* p2) s = (LUB (\p. (p = p1) \/ (p = p2))) s`)), REPEAT GEN_TAC THEN REWRITE_TAC [LUB; OR_def] THEN BETA_TAC THEN EQ_TAC THENL [ STRIP_TAC THENL [ EXISTS_TAC (`p1:'a->bool`) THEN ASM_REWRITE_TAC [] ; EXISTS_TAC (`p2:'a->bool`) THEN ASM_REWRITE_TAC [] ] ; STRIP_TAC THENL [ REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p1`)] (ASSUME (`(p:'a->bool) s`))] ; REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p2`)] (ASSUME (`(p:'a->bool) s`))] ] ]);; (* |- !p1 p2. p1 \/* p2 = LUB(\p. (p = p1) \/ (p = p2)) *) let LEADSTO2_thm4_lemma1 = (GEN_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`s:'a`) (SPEC_ALL LEADSTO2_thm4_lemma1a)))));; (* |- !R Pr. (!p' q'. (p' ENSURES q')Pr \/ (?r. (p' ENSURES r)Pr /\ R r q' Pr) \/ (?P. (p' = LUB P) /\ (!p. p In P ==> R p q' Pr)) ==> R p' q' Pr) ==> (!p q P. (p = LUB P) /\ (!p. p In P ==> R p q Pr) ==> R p q Pr) *) let LEADSTO2_thm4_lemma2 = TAC_PROOF (([], (`!(R:('a->bool)->('a->bool)->(('a->'a)list)->bool) Pr. (!p' q'. (p' ENSURES q') Pr \/ (?r. (p' ENSURES r) Pr /\ R r q' Pr) \/ (?P. (p' = LUB P) /\ (!p. p In P ==> R p q' Pr)) ==> R p' q' Pr) ==> (!p q P. ((p = LUB P) /\ (!p. p In P ==> R p q Pr)) ==> R p q Pr)`)), REPEAT STRIP_TAC THEN RES_TAC);; (* |- !R p1 p2 q Pr Pr. R p1 q Pr ==> R p2 q Pr ==> (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr) *) let LEADSTO2_thm4_lemma3 = TAC_PROOF (([], (`!R (p1:'a->bool) p2 (q:'a->bool) (Pr:('a->'a)list) (Pr:('a->'a)list). R p1 q Pr ==> R p2 q Pr ==> (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr)`)), BETA_TAC THEN REPEAT STRIP_TAC THENL [ ASM_REWRITE_TAC [] ; ASM_REWRITE_TAC [] ]);; (* |- !R p1 p2 q Pr. R p1 q Pr ==> R p2 q Pr ==> (!p q P. (p = LUB P) /\ (!p. p In P ==> R p q Pr) ==> R p q Pr) ==> R(p1 \/* p2)q Pr *) let LEADSTO2_thm4_lemma4 = TAC_PROOF (([], (`!R (p1:'a->bool) (p2:'a->bool) (q:'a->bool) (Pr:('a->'a)list). R p1 q Pr ==> R p2 q Pr ==> (!p q P. (p = LUB P) /\ (!p. p In P ==> R p q Pr) ==> R p q Pr) ==> R (p1 \/* p2) q Pr`)), REWRITE_TAC [IN] THEN REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO2_thm4_lemma1); UNDISCH_ALL (SPEC_ALL LEADSTO2_thm4_lemma3)] (SPECL [(`(p1:'a->bool) \/* p2`); (`q:'a->bool`); (`\p:'a->bool. (p = p1) \/ (p = p2)`)] (ASSUME (`!p (q:'a->bool) (P:('a->bool)->bool). (p = LUB P) /\ (!p. P p ==> R p q Pr) ==> R p q (Pr:('a->'a)list)`)))));; (* Now Prove that the finite disjunction is satisfied *) (* |- !p1 p2 q Pr. LEADSTO2 p1 q Pr /\ LEADSTO2 p2 q Pr ==> LEADSTO2(p1 \/* p2)q Pr *) let LEADSTO2_thm4 = prove_thm ("LEADSTO2_thm4", (`!(p1:'a->bool) p2 q Pr. (LEADSTO2 p1 q Pr) /\ (LEADSTO2 p2 q Pr) ==> LEADSTO2 (p1 \/* p2) q Pr`), REWRITE_TAC [LEADSTO2; LEADSTO2Fn] THEN BETA_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO2_thm4_lemma2)) THEN ACCEPT_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO2_thm4_lemma4)));; (* Prove: This is more difficult and we need to use structural induction *) (* Prove the induction theorem: |- !X p q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr)) ==> LEADSTO2 p q Pr ==> X p q Pr *) let LEADSTO2_thm8 = prove_thm ("LEADSTO2_thm8", (`!X (p:'a->bool) q Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ X r q Pr ==> (X p q Pr)) /\ (!P. (!p. p In P ==> X p q Pr) ==> (X (LUB P) q Pr))) ==> ((LEADSTO2 p q Pr) ==> X p q Pr)`), REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL CONJ_ASSOC)] (BETA_RULE (SPEC (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). X p q Pr:bool`) (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`)))))) THEN RES_TAC);; (* We now use LEADSTO2_thm8 to prove a slightly modified writing of the wanted theorem: !p q Pr. (LEADSTO2 p q Pr) ==> (!r. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr) *) (* We get by specialization: |- (!p' q'. ((p' ENSURES q')Pr ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr)) /\ (!r. (p' ENSURES r)Pr /\ (!r'. LEADSTO2 q' r' Pr ==> LEADSTO2 r r' Pr) ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr)) /\ (!P. (!p''. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2(LUB P)r Pr))) ==> LEADSTO2 p q Pr ==> (!r. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr) *) let LEADSTO2_thm2a = (BETA_RULE (SPECL [(`\p q Pr. !r:'a->bool. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr`); (`p:'a->bool`); (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO2_thm8));; (* We prove the implications of Rel_thm2a: *) (* |- !p' q'. (p' ENSURES q')Pr ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr) *) let LEADSTO2_thm2b = TAC_PROOF (([], (`!(p':'a->bool) q'. ((p' ENSURES q')Pr ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr))`)), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO2_thm1);; (* |- !p' q' r. (p' ENSURES r)Pr /\ (!r'. LEADSTO2 q' r' Pr ==> LEADSTO2 r r' Pr) ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr) *) let LEADSTO2_thm2c = TAC_PROOF (([], (`!(p':'a->bool) q'. (!r. (p' ENSURES r)Pr /\ (!r'. LEADSTO2 q' r' Pr ==> LEADSTO2 r r' Pr) ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr))`)), REPEAT STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC LEADSTO2_thm1);; (* |- !p' q' P. (!p''. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2(LUB P)r Pr) *) let LEADSTO2_thm2d_lemma1 = TAC_PROOF (([], (`!(q':'a->bool) r Pr. LEADSTO2 q' r Pr ==> (!p'':'a->bool. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) ==> (!p'':'a->bool. p'' In P ==> LEADSTO2 p'' r Pr)`)), REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO2_thm2d = TAC_PROOF (([], (`!(p':'a->bool) q'. (!P:('a->bool)->bool. (!p''. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2(LUB P)r Pr))`)), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO2_thm2d_lemma1 THEN IMP_RES_TAC LEADSTO2_thm3);; (* Hence by rewriting we get: |- LEADSTO2 p q Pr ==> (!r. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr) *) let LEADSTO2_thm2e = (REWRITE_RULE [LEADSTO2_thm2b; LEADSTO2_thm2c; LEADSTO2_thm2d] LEADSTO2_thm2a);; (* Now we may Prove: |- !p r q Pr. LEADSTO2 p r Pr /\ LEADSTO2 r q Pr ==> LEADSTO2 p q Pr *) let LEADSTO2_thm2 = prove_thm ("LEADSTO2_thm2", (`!(p:'a->bool) r q Pr. (LEADSTO2 p r Pr) /\ (LEADSTO2 r q Pr) ==> (LEADSTO2 p q Pr)`), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO2_thm2e);; (* |- !p q Pr. (p ENSURES q)Pr \/ (?r. LEADSTO2 p r Pr /\ LEADSTO2 r q Pr) \/ (?P. (p = LUB P) /\ (!p. p In P ==> LEADSTO2 p q Pr)) = LEADSTO2 p q Pr *) let LEADSTO2_thm5 = prove_thm ("LEADSTO2_thm5", (`!(p:'a->bool) q Pr. ((p ENSURES q)Pr \/ (?r. (LEADSTO2 p r Pr) /\ (LEADSTO2 r q Pr)) \/ (?P. (p = (LUB P)) /\ (!p. p In P ==> LEADSTO2 p q Pr))) = (LEADSTO2 p q Pr)`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THENL [ ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO2_thm0)) ; IMP_RES_TAC LEADSTO2_thm2 ; IMP_RES_TAC LEADSTO2_thm3 THEN ASM_REWRITE_TAC [] ] ; REPEAT STRIP_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; REWRITE_TAC [LEADSTO_thm5_lemma3] THEN REPEAT STRIP_TAC THEN ACCEPT_TAC (ONCE_REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`))) ] ]);; (* |- !p q Pr. (p ENSURES q)Pr \/ (?r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr) \/ (?P. (p = ?* P) /\ (!i. LEADSTO2(P i)q Pr)) = LEADSTO2 p q Pr *) let LEADSTO2_thm6 = prove_thm ("LEADSTO2_thm6", (`!(p:'a->bool) q Pr. ((p ENSURES q)Pr \/ (?r. (p ENSURES r)Pr /\ (LEADSTO2 r q Pr)) \/ (?P. (p = (LUB P)) /\ (!p. p In P ==> LEADSTO2 p q Pr))) = (LEADSTO2 p q Pr)`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THENL [ ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO2_thm0)) ; IMP_RES_TAC LEADSTO2_thm1 ; IMP_RES_TAC LEADSTO2_thm3 THEN ASM_REWRITE_TAC [] ] ; REPEAT STRIP_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN REWRITE_TAC [LUB; IN] THEN BETA_TAC THEN CONJ_TAC THENL [ ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) ; REWRITE_TAC [LEADSTO_thm5_lemma3] THEN REPEAT STRIP_TAC THEN ACCEPT_TAC (ONCE_REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`))) ] ]);; (* Now we are able to prove another induction principle *) (* We need a lemma *) let LEADSTO2_thm7_lemma01 = TAC_PROOF (([], (`(!p':'a->bool. p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)) = ((!p'. p' In P ==> LEADSTO2 p' q Pr) /\ (!p'. p' In P ==> LEADSTO2 p' q Pr ==> X p' q Pr))`)), EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO2_thm7_lemma = TAC_PROOF (([], (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ (LEADSTO2 r q Pr ==> X r q Pr) ==> LEADSTO2 p q Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> LEADSTO2 p q Pr ==> X p q Pr) ==> LEADSTO2(LUB P)q Pr ==> X(LUB P)q Pr)) = (!(p:'a->bool) q. ((p ENSURES q)Pr ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q Pr)) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ (LEADSTO2 r q Pr ==> X r q Pr) ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q Pr)) /\ (!P. (!p'. p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)) ==> LEADSTO2(LUB P)q Pr /\ (LEADSTO2(LUB P)q Pr ==> X(LUB P)q Pr)))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ IMP_RES_TAC LEADSTO2_thm0 ; RES_TAC ; IMP_RES_TAC LEADSTO2_thm1 ; RES_TAC ; STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO2_thm7_lemma01] (ASSUME (`!p':'a->bool. p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)`))) THEN IMP_RES_TAC LEADSTO2_thm3 ; STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO2_thm7_lemma01] (ASSUME (`!p':'a->bool. p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)`))) THEN RES_TAC ; RES_TAC ; RES_TAC ; ASSUME_TAC (REWRITE_RULE [SYM LEADSTO2_thm7_lemma01] (CONJ (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr`)) (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr ==> X p q Pr`)))) THEN RES_TAC ]);; (* The induction theorem: |- !X p q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ (LEADSTO2 r q Pr ==> X r q Pr) ==> LEADSTO2 p q Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> LEADSTO2 p q Pr ==> X p q Pr) ==> LEADSTO2(LUB P)q Pr ==> X(LUB P)q Pr)) ==> LEADSTO2 p q Pr ==> X p q Pr *) let LEADSTO2_thm7 = prove_thm ("LEADSTO2_thm7", (`!X (p:'a->bool) q Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (LEADSTO2 r q Pr) /\ ((LEADSTO2 r q Pr) ==> X r q Pr) ==> ((LEADSTO2 p q Pr) ==> X p q Pr)) /\ (!P. (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> LEADSTO2 p q Pr ==> X p q Pr) ==> ((LEADSTO2 (LUB P) q Pr) ==> X (LUB P) q Pr))) ==> ((LEADSTO2 p q Pr) ==> X p q Pr)`), REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO2_thm7_lemma)] (BETA_RULE (SPEC (`\(p:'a->bool) q Pr. (LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q Pr))`) (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`)))))) THEN RES_TAC);; (* Finally we want to prove that LEADSTO is equal to LEADSTO2: *) (* We do the proving as two implication proofs: *) (* |- !R Pr. (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p. p In P ==> R p q Pr) ==> R(LUB P)q Pr)) ==> (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p. p In P ==> R p q Pr) ==> R(LUB P)q Pr)) *) let LEADSTO_EQ_LEADSTO2a = TAC_PROOF (([], (`!R (Pr:('a->'a)list). (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr)) ==> (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr))`)), REPEAT STRIP_TAC THEN RES_TAC);; (* |- !p q Pr. LEADSTO2 p q Pr ==> (p LEADSTO q)Pr *) let LEADSTO_EQ_LEADSTO2b_lemma = TAC_PROOF (([], (`(!(p:'a->bool) q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)) ==> (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr))`)), REPEAT STRIP_TAC THEN RES_TAC THEN ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p:'a->bool. (p = LUB P) ==> R p (q:'a->bool) (Pr:('a->'a)list)`)))));; let LEADSTO_EQ_LEADSTO2b = TAC_PROOF (([], (`!(p:'a->bool) q Pr. LEADSTO2 p q Pr ==> (p LEADSTO q) Pr`)), REWRITE_TAC [LEADSTO; LeadstoRel; LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO_EQ_LEADSTO2b_lemma)) THEN ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO_EQ_LEADSTO2a)) THEN RES_TAC);; (* |- (!p' q'. ((p' ENSURES q')Pr ==> LEADSTO2 p' q' Pr) /\ (!r. LEADSTO2 p' r Pr /\ LEADSTO2 r q' Pr ==> LEADSTO2 p' q' Pr) /\ (!P. (p' = LUB P) /\ (!p''. p'' In P ==> LEADSTO2 p'' q' Pr) ==> LEADSTO2 p' q' Pr)) ==> (p LEADSTO q)Pr ==> LEADSTO2 p q Pr *) let LEADSTO_EQ_LEADSTO2c = (SPECL [(`LEADSTO2:('a->bool)->('a->bool)->(('a->'a)list)->bool`); (`p:'a->bool`); (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO_thm21);; (* |- !p q Pr. (p LEADSTO q)Pr ==> LEADSTO2 p q Pr *) let LEADSTO_EQ_LEADSTO2d = (GEN_ALL (REWRITE_RULE [LEADSTO2_thm0; LEADSTO2_thm2; LEADSTO2_thm3a] LEADSTO_EQ_LEADSTO2c));; (* The equivalence proof: |- !p q Pr. (p LEADSTO q)Pr = LEADSTO2 p q Pr *) let LEADSTO_EQ_LEADSTO2 = prove_thm ("LEADSTO_EQ_LEADSTO2", (`!(p:'a->bool) q Pr. (p LEADSTO q)Pr = LEADSTO2 p q Pr`), REPEAT GEN_TAC THEN EQ_TAC THENL [ REWRITE_TAC [LEADSTO_EQ_LEADSTO2d] ; REWRITE_TAC [LEADSTO_EQ_LEADSTO2b] ]);; (* Hence now we may conclude all theorems proven valid for both relations *) (* We get the last two induction principles for LEADSTO: *) (* |- !X p q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr)) ==> ==> (p LEADSTO q)Pr ==> X p q Pr *) let LEADSTO_thm31 = prove_thm ("LEADSTO_thm31", (`!X (p:'a->bool) q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> X p q Pr) ==> X (LUB P) q Pr)) ==> (p LEADSTO q)Pr ==> X p q Pr`), ACCEPT_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_EQ_LEADSTO2)] LEADSTO2_thm8));; (* The theorem may also be written: *) let LEADSTO_thm32 = prove_thm ("LEADSTO_thm32", (`!X. (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q Pr. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ (!P q Pr. (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr) ==> !(p:'a->bool) q Pr. (p LEADSTO q)Pr ==> X p q Pr`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) (r:'a->bool) (q:'a->bool) Pr. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr`); ASSUME (`!(P:('a->bool)->bool) (q:'a->bool) (Pr:('a->'a)list). (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr`)] (SPEC_ALL LEADSTO_thm31)) THEN RES_TAC);; (* |- !X p q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) ==> (p LEADSTO q)Pr ==> X p q Pr *) let LEADSTO_thm33 = prove_thm ("LEADSTO_thm33", (`!X (p:'a->bool) q Pr. (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X (LUB P) q Pr)) ==> (p LEADSTO q)Pr ==> X p q Pr`), ACCEPT_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_EQ_LEADSTO2)] LEADSTO2_thm7));; (* We may now derive the theorem: *) let LEADSTO_thm34 = prove_thm ("LEADSTO_thm34", (`!X. (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X (LUB P) q Pr) ==> !(p:'a->bool) q Pr. (p LEADSTO q)Pr ==> X p q Pr`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr`); ASSUME (`!(P:('a->bool)->bool) q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr`)] (SPEC_ALL LEADSTO_thm33)) THEN RES_TAC);; (* And the theorem: |- !X Pr. (!p q. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr) /\ (!P q. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr) ==> (!p q. (p LEADSTO q)Pr ==> X p q Pr) which may be used for deriving a tactic supporting given programs. *) let LEADSTO_thm34a_lemma1 = TAC_PROOF (([], (`!P q Pr. (!p:'a->bool. p In P ==> (p LEADSTO q)Pr) ==> (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> (!p. p In P ==> X p q Pr)`)), REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC);; let LEADSTO_thm34a_lemma2 = TAC_PROOF (([], (`!P q Pr. (!p:'a->bool. p In P ==> (p LEADSTO q)Pr) ==> (!p. p In P ==> X p q Pr) ==> (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr)`)), REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm34a_lemma3 = TAC_PROOF (([], (`((!(p:'a->bool) q. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr) /\ (!P q. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr)) = (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr))`)), EQ_TAC THEN REPEAT STRIP_TAC THENL [ RES_TAC ; RES_TAC ; ASSUME_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm34a_lemma1)) THEN RES_TAC ; RES_TAC ; IMP_RES_TAC LEADSTO_thm2 THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`((p:'a->bool) ENSURES r)Pr`); ASSUME (`((r:'a->bool) LEADSTO q)Pr`); ASSUME (`(X:('a->bool)->('a->bool)->('a->'a)list->bool) r q Pr`); ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (SPEC_ALL (CONJUNCT1 (CONJUNCT2 (SPEC_ALL (ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)`))))))) ; IMP_RES_TAC LEADSTO_thm3a THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm34a_lemma2)) THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`); ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr ==> X p q Pr`); ASSUME (`((LUB (P:('a->bool)->bool)) LEADSTO q)Pr`)] (SPEC_ALL (CONJUNCT2 (CONJUNCT2 (SPEC_ALL (ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)`))))))) ]);; (* The theorem for the tactic *) let LEADSTO_thm34a = prove_thm ("LEADSTO_thm34a", (`!X Pr. (!p q. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr) /\ (!P q. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X (LUB P) q Pr) ==> !(p:'a->bool) q. (p LEADSTO q)Pr ==> X p q Pr`), REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) r q. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr`); ASSUME (`!P (q:'a->bool). (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr`)] (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm34a_lemma3)] (SPEC_ALL LEADSTO_thm33))));; let LEADSTO_thm34b = prove_thm ("LEADSTO_thm34b", (`!X:('a->bool)->('a->bool)->('a->'a)list->bool. (!p q st Pr. (p ENSURES q)(CONS st Pr) ==> X p q (CONS st Pr)) /\ (!p r q st Pr. (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr) /\ X r q (CONS st Pr) ==> X p q (CONS st Pr)) /\ (!P q st Pr. (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) /\ (!p. p In P ==> X p q (CONS st Pr)) ==> X (LUB P) q (CONS st Pr)) ==> !p q st Pr. (p LEADSTO q)(CONS st Pr) ==> X p q (CONS st Pr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`((p:'a->bool) LEADSTO q)(CONS st Pr)`)] (SPEC_ALL (REWRITE_RULE [ASSUME (`!(p:'a->bool) q st Pr. (p ENSURES q)(CONS st Pr) ==> X p q(CONS st Pr)`); ASSUME (`!(p:'a->bool) r q st Pr. (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr) /\ X r q(CONS st Pr) ==> X p q(CONS st Pr)`); ASSUME (`!P (q:'a->bool) st Pr. (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) /\ (!p. p In P ==> X p q(CONS st Pr)) ==> X(LUB P)q(CONS st Pr)`)] (SPECL [(`X:('a->bool)->('a->bool)->('a->'a)list->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm34a)))));; (* Now we may introduce some tactics for supporting structural induction of leadsto relations: *) (* use"leadsto_induct0.sml";; *) (* |- !X st Pr. (!p q. (p ENSURES q)(CONS st Pr) ==> X p q(CONS st Pr)) /\ (!p r q. (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr) /\ X r q(CONS st Pr) ==> X p q(CONS st Pr)) /\ (!P q. (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) /\ (!p. p In P ==> X p q(CONS st Pr)) ==> X (LUB P) q (CONS st Pr)) ==> (!p q. (p LEADSTO q)(CONS st Pr) ==> X p q(CONS st Pr)) *) let LEADSTO_thm34a_lemma00 = TAC_PROOF (([], `!(p:'a->bool) q Pr X. (!p q. (p ENSURES q) Pr ==> X p q Pr) /\ (!p r q. (p ENSURES r) Pr /\ (r LEADSTO q) Pr /\ X r q Pr ==> X p q Pr) /\ (!P q. (!p. p In P ==> (p LEADSTO q) Pr) /\ (!p. p In P ==> X p q Pr) ==> X (LUB P) q Pr) ==> ((p LEADSTO q) Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN IMP_RES_TAC (SPEC_ALL LEADSTO_thm34a));; let LEADSTO_thm34a_lemma01 = GENL [`p:'a->bool`;`q:'a->bool`;`st:'a->'a`;`Pr:('a->'a)list`; `X:('a->bool)->('a->bool)->('a->'a)list->bool`] (SPECL [`p:'a->bool`;`q:'a->bool`;`(CONS st Pr):('a->'a)list`; `X:('a->bool)->('a->bool)->('a->'a)list->bool`] LEADSTO_thm34a_lemma00);; (* Prove: |- !p q st Pr. (p ENSURES q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr) *) let LEADSTO_thm35_lemma00 = TAC_PROOF (([], (`!(p:'a->bool) q r st Pr. (p ENSURES q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`)), REPEAT STRIP_TAC THEN ASSUME_TAC (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`(CONS st Pr):('a->'a)list`)] ENSURES_cor2) (ASSUME (`((p:'a->bool) ENSURES q)(CONS st Pr)`))) THEN ASSUME_TAC (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`r:'a->bool`); (`(CONS st Pr):('a->'a)list`)] UNLESS_thm8) (CONJ (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`(CONS st Pr):('a->'a)list`)] ENSURES_cor2) (ASSUME (`((p:'a->bool) ENSURES q)(CONS st Pr)`))) (ASSUME (`((q:'a->bool) UNLESS r)(CONS st Pr)`)))) THEN ASSUME_TAC (MP (SPECL [(`p':'a->bool`); (`q':'a->bool`); (`(p:'a->bool) \/* q`); (`r:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm29) (CONJ (ASSUME (`((p':'a->bool) LEADSTO q')(CONS st Pr)`)) (ASSUME (`(((p:'a->bool) \/* q) UNLESS r)(CONS st Pr)`)))) THEN ASSUME_TAC (MP (SPECL [(`p:'a->bool`); (`(p:'a->bool) \/* q`); (`p':'a->bool`)] IMPLY_WEAK_AND_lemma) (SPECL [(`p:'a->bool`); (`q:'a->bool`)] OR_IMPLY_WEAK_lemma)) THEN ASSUME_TAC (MP (SPECL [(`(p:'a->bool) /\* p'`); (`(p':'a->bool) /\* (p \/* q)`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm25) (ONCE_REWRITE_RULE [(SPECL [(`(p:'a->bool) \/* q`); (`p':'a->bool`)] AND_COMM_lemma)] (ASSUME (`!s:'a. (p /\* p')s ==> ((p \/* q) /\* p')s`)))) THEN ASSUME_TAC (MP (SPECL [(`(p:'a->bool) /\* p'`); (`(p':'a->bool) /\* (p \/* q)`); (`((q':'a->bool) /\* (p \/* q)) \/* r`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm1) (CONJ (ASSUME (`(((p:'a->bool) /\* p') LEADSTO (p' /\* (p \/* q)))(CONS st Pr)`)) (ASSUME (`((p' /\* (p \/* q)) LEADSTO ((q' /\* (p \/* q)) \/* r)) (CONS (st:'a->'a) Pr)`)))) THEN ASSUME_TAC (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`q':'a->bool`); (`r:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm29) (CONJ (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm0) (ASSUME (`((p:'a->bool) ENSURES q)(CONS st Pr)`))) (ASSUME (`((q':'a->bool) UNLESS r)(CONS st Pr)`)))) THEN ASSUME_TAC (ONCE_REWRITE_RULE [SPECL [(`((q':'a->bool) /\* q) \/* r`); (`p:'a->bool`); (`q':'a->bool`)] OR_AND_COMM_lemma] (ONCE_REWRITE_RULE [SPECL [(`(q':'a->bool) /\* p`); (`((q':'a->bool) /\* q) \/* r`)] OR_COMM_lemma] (REWRITE_RULE [OR_ASSOC_lemma] (REWRITE_RULE [AND_OR_DISTR_lemma] (ASSUME (`(((p:'a->bool) /\* p') LEADSTO ((q' /\* (p \/* q)) \/* r))(CONS st Pr)`)))))) THEN ACCEPT_TAC (ONCE_REWRITE_RULE [OR_COMM_lemma] (REWRITE_RULE [OR_OR_lemma] (REWRITE_RULE [OR_ASSOC_lemma] (ONCE_REWRITE_RULE[OR_AND_COMM_lemma] (REWRITE_RULE [OR_OR_lemma] (REWRITE_RULE [SYM (SPEC_ALL OR_ASSOC_lemma)] (ONCE_REWRITE_RULE [OR_COMM_lemma] (REWRITE_RULE [OR_ASSOC_lemma] (ONCE_REWRITE_RULE [OR_OR_COMM_lemma] (MP (SPECL [(`(p:'a->bool) /\* p'`); (`((q':'a->bool) /\* q) \/* r`); (`(p:'a->bool) /\* q'`); (`((q:'a->bool) /\* q') \/* r`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28) (CONJ (ASSUME (`((p /\* p') LEADSTO (((q' /\* q) \/* r) \/* (p /\* q'))) (CONS (st:'a->'a) Pr)`)) (ASSUME (`((p /\* q') LEADSTO ((q /\* q') \/* r)) (CONS (st:'a->'a) Pr)`))))))))))))));; let LEADSTO_thm35_lemma01_1 = TAC_PROOF (([], (`!(q:'a->bool) (q':'a->bool) r'' p r s. ((((q /\* q') \/* r'') \/* (p /\* r)) \/* ((q' /\* q) \/* r''))s = (((q /\* q') \/* r'') \/* (p /\* r))s`)), REWRITE_TAC [OR_def; AND_def] THEN BETA_TAC THEN REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let LEADSTO_thm35_lemma01_2 = GEN_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`s:'a`) (SPEC_ALL LEADSTO_thm35_lemma01_1))));; let LEADSTO_thm35_lemma01_3 = TAC_PROOF (([], (`(!p:'a->bool. p In P ==> (!p'' q r r'. (r LEADSTO q)(CONS st Pr) ==> (p'' ENSURES r)(CONS st Pr) ==> (q' UNLESS r')(CONS st Pr) ==> (q UNLESS r')(CONS st Pr) ==> (!p' q' r''. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r'')(CONS st Pr) ==> (q' UNLESS r'')(CONS st Pr) ==> ((r /\* p') LEADSTO ((q /\* q') \/* r''))(CONS st Pr)) ==> ((p'' /\* p) LEADSTO ((q /\* q') \/* r'))(CONS st Pr))) ==> (!p'' q r r'. (r LEADSTO q)(CONS st Pr) ==> (p'' ENSURES r)(CONS st Pr) ==> (q' UNLESS r')(CONS st Pr) ==> (q UNLESS r')(CONS st Pr) ==> (!p' q' r''. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r'')(CONS st Pr) ==> (q' UNLESS r'')(CONS st Pr) ==> ((r /\* p') LEADSTO ((q /\* q') \/* r''))(CONS st Pr)) ==> (!p. p In P ==> ((p'' /\* p) LEADSTO ((q /\* q') \/* r'))(CONS st Pr)))`)), REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm35_lemma01_4 = TAC_PROOF (([], (`!(P:('a->bool)->bool) r q st Pr. (!p. p In P ==> ((p /\* r) LEADSTO q)(CONS st Pr)) ==> (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) ==> (((LUB P) /\* r) LEADSTO q)(CONS st Pr)`)), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm3a THEN ASSUME_TAC (SPECL [(`LUB (P:('a->bool)->bool)`); (`r:'a->bool`)] SYM_AND_IMPLY_WEAK_lemma) THEN ASSUME_TAC (UNDISCH (SPEC_ALL (SPECL [(`(LUB P) /\* (r:'a->bool)`); (`(LUB P):'a->bool`)] ENSURES_cor1))) THEN IMP_RES_TAC LEADSTO_thm0 THEN IMP_RES_TAC LEADSTO_thm1);; let LEADSTO_thm35_lemma01_5 = TAC_PROOF (([], (`!(p':'a->bool) P p (p'':'a->bool). p' In (\p''. ?p'''. p''' In P /\ (p'' = p /\* p''')) = (?p'''. p''' In P /\ (p' = p /\* p'''))`)), REWRITE_TAC [IN] THEN BETA_TAC THEN REWRITE_TAC []);; let LEADSTO_thm35_lemma01_6 = TAC_PROOF (([], (`!s:'a. (p /\* (LUB P))s = (LUB(\p''. ?p'. p' In P /\ (p'' = p /\* p')))s`)), REPEAT GEN_TAC THEN REWRITE_TAC [LUB; AND_def] THEN BETA_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ EXISTS_TAC (`\s:'a. p s /\ p' s`) THEN BETA_TAC THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC (`p':'a->bool`) THEN ASM_REWRITE_TAC [IN] ; STRIP_ASSUME_TAC (BETA_RULE (SUBS [ASSUME (`p' = (\s:'a. p s /\ p'' s)`)] (ASSUME (`(p':'a->bool) s`)))) ; EXISTS_TAC (`p'':'a->bool`) THEN REWRITE_TAC [REWRITE_RULE [IN] (ASSUME (`(p'':'a->bool) In P`))] THEN STRIP_ASSUME_TAC (BETA_RULE (SUBS [ASSUME (`p' = (\s:'a. p s /\ p'' s)`)] (ASSUME (`(p':'a->bool) s`)))) ]);; let LEADSTO_thm35_lemma01_7 = TAC_PROOF (([], (`!(P:('a->bool)->bool) r' q q' st Pr. (!p'. p' In P ==> ((p /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) ==> (!p'. (?p'''. p''' In P /\ (p' = p /\* p''')) ==> (p' LEADSTO ((q /\* q') \/* r'))(CONS st Pr))`)), REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let LEADSTO_thm35_lemma01_8 = TAC_PROOF (([], (`!(P:('a->bool)->bool) r' q q' st Pr. (!p'. p' In P ==> ((p /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) ==> (((p /\* (LUB P)) LEADSTO ((q /\* q') \/* r'))(CONS st Pr))`)), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm35_lemma01_5] (SPECL [(`\p'':'a->bool. ?p'. p' In P /\ (p'' = (p /\* p'))`); (`(q /\* q') \/* (r':'a->bool)`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm3a)) THEN ASSUME_TAC (REWRITE_RULE [(UNDISCH (SPEC_ALL LEADSTO_thm35_lemma01_7))] (ASSUME (`(!p':'a->bool. (?p'''. p''' In P /\ (p' = p /\* p''')) ==> (p' LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) ==> ((LUB(\p''. ?p'. p' In P /\ (p'' = p /\* p'))) LEADSTO ((q /\* q') \/* r')) (CONS st Pr)`))) THEN ASM_REWRITE_TAC [REWRITE_RULE [ETA_AX] (MK_ABS LEADSTO_thm35_lemma01_6)]);; let LEADSTO_thm35_lemma01_9 = TAC_PROOF (([], (`(!p:'a->bool. p In P ==> (!p' q' r. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r)(CONS st Pr) ==> (q' UNLESS r)(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr))) ==> ((!p' q' r. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r)(CONS st Pr) ==> (q' UNLESS r)(CONS st Pr) ==> (!p. p In P ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr))))`)), REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm35_lemma01_10 = TAC_PROOF (([], (`(!p:'a->bool. p In P ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)) ==> (!p. p In P ==> ((p' /\* p) LEADSTO ((q /\* q') \/* r))(CONS st Pr))`)), REPEAT STRIP_TAC THEN RES_TAC THEN ONCE_REWRITE_TAC [SPECL [(`p':'a->bool`); (`p:'a->bool`)] AND_COMM_lemma] THEN ONCE_REWRITE_TAC [AND_COMM_OR_lemma] THEN ASM_REWRITE_TAC []);; let LEADSTO_thm35_lemma01a = TAC_PROOF (([], (`(!(p:'a->bool) q r'' r'. (r'' LEADSTO q)(CONS st Pr) ==> (p ENSURES r'')(CONS st Pr) ==> (q' UNLESS r')(CONS st Pr) ==> (q UNLESS r')(CONS st Pr) ==> (!p' q' r'. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r')(CONS st Pr) ==> (q' UNLESS r')(CONS st Pr) ==> ((r'' /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) ==> ((p /\* r) LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) ==> (!(p:'a->bool) q r' r''. (r' LEADSTO q)(CONS st Pr) ==> (p ENSURES r')(CONS st Pr) ==> (q' UNLESS r'')(CONS st Pr) ==> (q UNLESS r'')(CONS st Pr) ==> (!p' q' r''. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r'')(CONS st Pr) ==> (q' UNLESS r'')(CONS st Pr) ==> ((r' /\* p') LEADSTO ((q /\* q') \/* r''))(CONS st Pr)) ==> ((p /\* r) LEADSTO ((q /\* q') \/* r''))(CONS st Pr))`)), REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[] );; (* Now we define a tactic that given one of the LEADSTO induction theorems can be used as a tactic to prove properties that require structural induction to prove the required propertie *) let LEADSTO_INDUCT0_TAC : tactic = ( try MATCH_MP_TAC LEADSTO_thm34b THEN REPEAT CONJ_TAC with Failure _ -> failwith "LEADSTO_INDUCT0_TAC Failed" );; let LEADSTO_thm35_lemma01 = TAC_PROOF (([], (`!(p:'a->bool) q st Pr. (p LEADSTO q)(CONS st Pr) ==> !p' q' r. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r)(CONS st Pr) ==> (q' UNLESS r)(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`)), LEADSTO_INDUCT0_TAC THENL [ REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm35_lemma00 ; REPEAT STRIP_TAC THEN UNDISCH_TAC (`!(p':'a->bool) q' r'. (p' LEADSTO q')(CONS st Pr) ==> (q UNLESS r')(CONS st Pr) ==> (q' UNLESS r')(CONS st Pr) ==> ((r /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)`) THEN UNDISCH_TAC (`((q:'a->bool) UNLESS r')(CONS st Pr)`) THEN UNDISCH_TAC (`((q':'a->bool) UNLESS r')(CONS st Pr)`) THEN UNDISCH_TAC (`((p:'a->bool) ENSURES r)(CONS st Pr)`) THEN UNDISCH_TAC (`((r:'a->bool) LEADSTO q)(CONS st Pr)`) THEN SPEC_TAC ((`r':'a->bool`), (`r':'a->bool`)) THEN SPEC_TAC ((`r:'a->bool`), (`r:'a->bool`)) THEN SPEC_TAC ((`q:'a->bool`), (`q:'a->bool`)) THEN SPEC_TAC ((`p:'a->bool`), (`p:'a->bool`)) THEN UNDISCH_TAC (`((p':'a->bool) LEADSTO q')(CONS st Pr)`) THEN SPEC_TAC ((`Pr:('a->'a)list`), (`Pr:('a->'a)list`)) THEN SPEC_TAC ((`st:'a->'a`), (`st:'a->'a`)) THEN SPEC_TAC ((`q':'a->bool`), (`q':'a->bool`)) THEN SPEC_TAC ((`p':'a->bool`), (`p':'a->bool`)) THEN LEADSTO_INDUCT0_TAC THENL [ REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm2 THEN IMP_RES_TAC LEADSTO_thm35_lemma00 THEN ONCE_REWRITE_TAC [AND_COMM_lemma] THEN ACCEPT_TAC (ASSUME (`(((p':'a->bool) /\* p) LEADSTO ((q' /\* q) \/* r'))(CONS st Pr)`)) ; REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm2 THEN IMP_RES_TAC LEADSTO_thm0 THEN ASSUME_TAC (UNDISCH (SPECL [(`p:'a->bool`); (`r':'a->bool`); (`CONS (st:'a->'a) Pr`)] ENSURES_cor2)) THEN ASSUME_TAC (UNDISCH (SPECL [(`p':'a->bool`); (`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] ENSURES_cor2)) THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`((p:'a->bool)UNLESS r')(CONS st Pr)`); ASSUME (`((p':'a->bool)ENSURES r)(CONS st Pr)`)] (SPECL [(`p:'a->bool`); (`r':'a->bool`); (`p':'a->bool`); (`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] ENSURES_thm4)) THEN IMP_RES_TAC LEADSTO_thm0 THEN RES_TAC THEN ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL OR_ASSOC_lemma)] (ONCE_REWRITE_RULE [OR_COMM_lemma] (REWRITE_RULE [ (ASSUME (`(((r':'a->bool) /\* r) LEADSTO ((q /\* q') \/* r'')) (CONS st Pr)`)); (ASSUME (`(((p:'a->bool) /\* p') LEADSTO (((p /\* r) \/* (p' /\* r')) \/* (r' /\* r))) (CONS st Pr)`))] (SPECL [(`(p:'a->bool) /\* p'`); (`((p:'a->bool) /\* r) \/* (p' /\* r')`); (`(r':'a->bool) /\* r`); (`((q:'a->bool) /\* q') \/* r''`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28)))) THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm35_lemma01_2] (REWRITE_RULE [(ONCE_REWRITE_RULE [SPECL [(`r':'a->bool`); (`p':'a->bool`)] AND_COMM_lemma] (ASSUME (`(((r':'a->bool) /\* p') LEADSTO ((q /\* q') \/* r'')) (CONS st Pr)`))); (ASSUME (`(((p:'a->bool) /\* p') LEADSTO ((((q /\* q') \/* r'') \/* (p /\* r)) \/* (p' /\* r'))) (CONS st Pr)`))] (SPECL [(`(p:'a->bool) /\* p'`); (`(((q:'a->bool) /\* q') \/* r'') \/* (p /\* r)`); (`(p':'a->bool) /\* r'`); (`((q':'a->bool) /\* q) \/* r''`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28))) THEN ASM_REWRITE_TAC [REWRITE_RULE [OR_OR_lemma] (REWRITE_RULE [(ASSUME (`(((p:'a->bool) /\* r) LEADSTO ((q /\* q') \/* r''))(CONS st Pr)`)); (ASSUME (`(((p:'a->bool) /\* p') LEADSTO (((q /\* q') \/* r'') \/* (p /\* r)))(CONS st Pr)`))] (SPECL [(`(p:'a->bool) /\* p'`); (`((q:'a->bool) /\* q') \/* r''`); (`(p:'a->bool) /\* r`); (`((q:'a->bool) /\* q') \/* r''`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28))] ; REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm0 THEN IMP_RES_TAC LEADSTO_thm2 THEN IMP_RES_TAC LEADSTO_thm35_lemma01_3 THEN IMP_RES_TAC LEADSTO_thm35_lemma01_8 ] ; REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm35_lemma01_9 THEN IMP_RES_TAC LEADSTO_thm35_lemma01_10 THEN IMP_RES_TAC LEADSTO_thm35_lemma01_8 THEN ONCE_REWRITE_TAC [SPECL [(`LUB (P:('a->bool)->bool)`); (`p':'a->bool`)] AND_COMM_lemma] THEN ASM_REWRITE_TAC [] ]);; (* Now prove the completion theorem: |- !p q p' q' r st Pr. (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr) *) let LEADSTO_thm35 = prove_thm ("LEADSTO_thm35", (`!(p:'a->bool) q p' q' r st Pr. (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm35_lemma01);; (* We now prove the theorem valid for proving bounds of progress. *) (* We need to define the metric predicates EQmetric and LESSmetric *) (* EQmetric is the state abstracted predicate expressing that the metric function M must have the value m in the state s. *) let EQmetric = new_infix_definition ("EQmetric", "<=>", (`EQmetric (M:'a->num) m = \s. M s = m`), TL_FIX);; (* LESSmetric is the state abstracted predicate expressing that the metric function M must have a value less than m in the state s. *) let LESSmetric = new_infix_definition ("LESSmetric", "<=>", (`LESSmetric (M:'a->num) m = \s. M s < m`), TL_FIX);; (*---------------------------------------------------------------------------*) (* Lemmas *) (*---------------------------------------------------------------------------*) let LEADSTO_thm36_lemma00 = BETA_RULE (SPEC (`\n. (((p:'a->bool) /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)`) GEN_INDUCT_thm);; let LEADSTO_thm36_lemma01 = TAC_PROOF (([], (`!(M:'a->num) m. (p /\* (M EQmetric m)) = ((\i. p /\* (M EQmetric i))m)`)), BETA_TAC THEN REWRITE_TAC []);; let LEADSTO_thm36_lemma02 = TAC_PROOF (([], (`!(p:'a->bool) q st Pr M m. (!n. n < (SUC m) ==> ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)) ==> (!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr))`)), REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MP (SPEC (`n:num`) (ASSUME (`!n. n < (SUC m) ==> (((p:'a->bool) /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)`))) (MP (SPECL [(`n:num`); (`m:num`)] LESS_SUC) (ASSUME (`n < m`)))));; let LEADSTO_thm36_lemma03 = TAC_PROOF (([], (`!(p:'a->bool) q st Pr M m. (!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q) (CONS st Pr)) ==> (( \ ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)) ==> (( \'a) Pr)`)) (ASSUME (`!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q) (CONS (st:'a->'a) Pr)`))) THEN ASSUME_TAC (REWRITE_RULE [LESS_SUC_REFL] (SPEC (`m:num`) (ASSUME (`!n. n < (SUC m) ==> ((p /\* (M EQmetric n)) LEADSTO q) (CONS (st:'a->'a) Pr)`)))) THEN STRIP_ASSUME_TAC (MP (SPECL [(` \bool) /\* (M EQmetric i))m`); (`(p:'a->bool) /\* (M EQmetric m)`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm4) (CONJ (ASSUME (`(( \'a) Pr)`)) (ASSUME (`((p /\* (M EQmetric m)) LEADSTO q)(CONS (st:'a->'a) Pr)`)))) ]);; let LEADSTO_thm36_lemma04 = TAC_PROOF (([], (`!M:'a->num. (!m s. (M LESSmetric m)s = ( \num) m. (M LESSmetric m) = ( \num`); (`m:num`)] LEADSTO_thm36_lemma04)))] THEN REWRITE_TAC [ETA_AX]);; let LEADSTO_thm36_lemma06 = TAC_PROOF (([], (`!(p:'a->bool) M q Pr. (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q))Pr) ==> (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* ( \bool) M m. ( \bool) q st Pr M. (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q)) (CONS st Pr)) ==> (!m. (!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)) ==> ((p /\* (M EQmetric m)) LEADSTO q) (CONS st Pr))`)), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm36_lemma07] (MP (SPEC_ALL LEADSTO_thm36_lemma03) (ASSUME (`!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q) (CONS (st:'a->'a) Pr)`)))) THEN ASSUME_TAC (ONCE_REWRITE_RULE [OR_COMM_lemma] (SPEC_ALL (UNDISCH (SPECL [(`p:'a->bool`); (`M:'a->num`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm36_lemma06)))) THEN STRIP_ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] (MP (SPECL [(`(p:'a->bool) /\* (M EQmetric m)`); (`q:'a->bool`); (`(p:'a->bool) /\* ( \bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28) (CONJ (ASSUME (`(((p:'a->bool) /\* (M EQmetric m)) LEADSTO (q \/* (p /\* ( \'a) Pr)`))))));; let LEADSTO_thm36_lemma09 = TAC_PROOF (([], (`!(p:'a->bool) q st Pr M. (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q)) (CONS st Pr)) ==> (!m. ((p /\* (M EQmetric m)) LEADSTO q) (CONS st Pr))`)), REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO_thm36_lemma08)) THEN STRIP_ASSUME_TAC (SPEC (`m:num`) (UNDISCH_ALL LEADSTO_thm36_lemma00)));; let LEADSTO_thm36_lemma10s = TAC_PROOF (([], (`!(p:'a->bool) M s. (p /\* ((?*) (\n. M EQmetric n)))s = ((?*) (\i. p /\* (M EQmetric i)))s`)), REPEAT STRIP_TAC THEN REWRITE_TAC [AND_def; EXISTS_def; EQmetric] THEN BETA_TAC THEN EQ_TAC THENL [ STRIP_TAC THEN EXISTS_TAC (`x:num`) THEN ASM_REWRITE_TAC [] ; STRIP_TAC THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC (`x:num`) THEN ASM_REWRITE_TAC [] ]);; (* |- !p M. p /\* ( ?* ) ((EQmetric) M) = (?*i. p /\* (M EQmetric i)) *) let LEADSTO_thm36_lemma10 = (GENL [`p:'a->bool`;`M:'a->num`] (ONCE_REWRITE_RULE [ETA_AX] (MK_ABS (SPECL [`p:'a->bool`;`M:'a->num`] LEADSTO_thm36_lemma10s))));; let LEADSTO_thm36_lemma11s = TAC_PROOF (([], (`!(M:'a->num) s. ((?*) (\n. M EQmetric n))s = True s`)), REWRITE_TAC [EXISTS_def; EQmetric; TRUE_def] THEN BETA_TAC THEN REPEAT GEN_TAC THEN EXISTS_TAC (`(M:'a->num) s`) THEN REFL_TAC);; (* |- !M. ( ?* ) ((EQmetric) M) = True *) let LEADSTO_thm36_lemma11 = (GENL [`M:'a->num`] (ONCE_REWRITE_RULE [ETA_AX] (MK_ABS (SPECL [`M:'a->num`] LEADSTO_thm36_lemma11s))));; let LEADSTO_thm36_lemma12 = TAC_PROOF (([], (`!(p:'a->bool) q st Pr M. (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q))(CONS st Pr)) ==> ((p /\* ((?*) (\n. M EQmetric n))) LEADSTO q)(CONS st Pr)`)), REPEAT STRIP_TAC THEN ASSUME_TAC (ONCE_REWRITE_RULE [LEADSTO_thm36_lemma01] (MP (SPEC_ALL LEADSTO_thm36_lemma09) (ASSUME (`!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q)) (CONS (st:'a->'a) Pr)`)))) THEN IMP_RES_TAC (SPECL [`\i:num. (p:'a->bool) /\* (M EQmetric i)`] LEADSTO_thm3c) THEN ASM_REWRITE_TAC [LEADSTO_thm36_lemma10]);; let LEADSTO_thm36 = prove_thm ("LEADSTO_thm36", (`!(p:'a->bool) q st Pr M. (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q)) (CONS st Pr)) ==> (p LEADSTO q)(CONS st Pr)`), REPEAT STRIP_TAC THEN IMP_RES_TAC LEADSTO_thm36_lemma12 THEN ACCEPT_TAC (REWRITE_RULE [LEADSTO_thm36_lemma11; AND_True_lemma] (ASSUME (`(((p:'a->bool) /\* ((?*) (\n. M EQmetric n))) LEADSTO q)(CONS st Pr)`))));; (* We prove a new induction theorem: *) let LEADSTO_thm37_lemma00 = TAC_PROOF (([], (`((!p:'a->bool. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q)) = (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q)`)), EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm37_lemma01 = TAC_PROOF (([], (`(!p':'a->bool. p' In P ==> (p' LEADSTO q)Pr /\ X p' q) = ((!p'. p' In P ==> (p' LEADSTO q)Pr) /\ (!p'. p' In P ==> X p' q))`)), EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm37_lemma02 = TAC_PROOF (([], (`!(X:('a->bool)->('a->bool)->bool) Pr. (!p q. ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ X p q) /\ (!r. (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q ==> (p LEADSTO q)Pr /\ X p q) /\ (!P. (p = LUB P) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q) ==> (p LEADSTO q)Pr /\ X p q)) = (!p q. ((p ENSURES q)Pr ==> X p q) /\ (!r. (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q ==> X p q) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> X(LUB P)q))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ RES_TAC ; RES_TAC ; ASSUME_TAC (REWRITE_RULE [LEADSTO_thm37_lemma00] (CONJ (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) (ASSUME (`!p. p In P ==> (X:('a->bool)->('a->bool)->bool) p q`)))) THEN RES_TAC THEN ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p. (p = LUB P) ==> (X:('a->bool)->('a->bool)->bool) p q`)))) ; IMP_RES_TAC LEADSTO_thm0 ; RES_TAC ; IMP_RES_TAC LEADSTO_thm1 THEN RES_TAC ; IMP_RES_TAC LEADSTO_thm1 THEN RES_TAC ; IMP_RES_TAC LEADSTO_thm37_lemma01 THEN IMP_RES_TAC LEADSTO_thm3 ; IMP_RES_TAC LEADSTO_thm37_lemma01 THEN RES_TAC THEN ASM_REWRITE_TAC [] ]);; let LEADSTO_thm37 = prove_thm ("LEADSTO_thm37", (`!X p q Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q) /\ (!r. (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q ==> X p q) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> X (LUB P) q)) ==> ((p LEADSTO q)Pr ==> X p q)`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm37_lemma02] (REWRITE_RULE [SYM (SPEC_ALL CONJ_ASSOC)] (BETA_RULE (SPEC (`\ (p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q)`) (REWRITE_RULE [LEADSTO; LeadstoRel] (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))))) THEN RES_TAC);; (* The theorem useful for an induction tactic *) let LEADSTO_thm38 = prove_thm ("LEADSTO_thm38", (`!X. (!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q) /\ (!p r q Pr. (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q ==> X p q) /\ (!P q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> X (LUB P) q) ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q`); ASSUME (`!(p:'a->bool) r q Pr. (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q ==> X p q`); ASSUME (`!(P:('a->bool)->bool) q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> X (LUB P) q`); ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (SPEC_ALL LEADSTO_thm37)));; let LEADSTO_thm39_lemma00 = TAC_PROOF (([], (`!(X:('a->bool)->('a->bool)->bool) Pr. ((!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q)) = (!p. p In P ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm39_lemma01 = TAC_PROOF (([], (`!(X:('a->bool)->('a->bool)->bool) Pr. (!p q. ((p ENSURES q)Pr ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ (LEADSTO2 r q Pr ==> X r q) ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ (!P. (!p'. p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q)) ==> LEADSTO2(LUB P)q Pr /\ (LEADSTO2(LUB P)q Pr ==> X(LUB P)q))) = (!p q. ((p ENSURES q)Pr ==> X p q) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q ==> X p q) /\ (!P. (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q) ==> X(LUB P)q))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ RES_TAC ; IMP_RES_TAC LEADSTO2_thm1 THEN ACCEPT_TAC (REWRITE_RULE [ASSUME (`((p:'a->bool) ENSURES r)Pr`); ASSUME (`LEADSTO2 (r:'a->bool) q Pr`); ASSUME (`LEADSTO2 (p:'a->bool) q Pr`); ASSUME (`(X:('a->bool)->('a->bool)->bool) r q`)] (SPEC_ALL (CONJUNCT1 (CONJUNCT2 (SPEC_ALL (ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ (LEADSTO2 r q Pr ==> X r q) ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ (!P. (!p'. p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q)) ==> LEADSTO2(LUB P)q Pr /\ (LEADSTO2(LUB P)q Pr ==> X(LUB P)q))`))))))) ; ASSUME_TAC (REWRITE_RULE [LEADSTO_thm39_lemma00] (CONJ (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr`)) (ASSUME (`!p. p In P ==> (X:('a->bool)->('a->bool)->bool) p q`)))) THEN IMP_RES_TAC LEADSTO2_thm3a THEN ASSUME_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p:'a->bool. (p = LUB P) ==> LEADSTO2 p q Pr`)))) THEN RES_TAC ; IMP_RES_TAC LEADSTO2_thm0 ; RES_TAC ; IMP_RES_TAC LEADSTO2_thm1 ; RES_TAC ; STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm39_lemma00)] (ASSUME (`!p':'a->bool. p' In P ==> (LEADSTO2 p' q)Pr /\ (LEADSTO2 p' q Pr ==> X p' q)`))) THEN IMP_RES_TAC LEADSTO2_thm3a THEN ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p:'a->bool. (p = LUB P) ==> LEADSTO2 p q Pr`)))) ; STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm39_lemma00)] (ASSUME (`!p':'a->bool. p' In P ==> (LEADSTO2 p' q)Pr /\ (LEADSTO2 p' q Pr ==> X p' q)`))) THEN RES_TAC ]);; let LEADSTO_thm39 = prove_thm ("LEADSTO_thm39", (`!(X:('a->bool)->('a->bool)->bool) p q Pr. (!p q. ((p ENSURES q)Pr ==> X p q) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ (X r q) ==> X p q) /\ (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> X (LUB P) q)) ==> ((p LEADSTO q)Pr ==> X p q)`), REWRITE_TAC [LEADSTO_EQ_LEADSTO2] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm39_lemma01] (BETA_RULE (SPEC (`\(p:'a->bool) q Pr. (LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q))`) (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`)))))) THEN RES_TAC);; (* The theorem useful for an induction tactic *) let LEADSTO_thm40 = prove_thm ("LEADSTO_thm40", (`!X. (!p q Pr. (p ENSURES q)Pr ==> X p q) /\ (!p r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q ==> X p q) /\ (!P q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> X (LUB P) q) ==> (!(p:'a->bool) q Pr. (p LEADSTO q)Pr ==> X p q)`), REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q`); ASSUME (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q ==> X p q`); ASSUME (`!P (q:'a->bool) Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> X (LUB P) q`)] (SPEC_ALL LEADSTO_thm39)) THEN RES_TAC);; (* Finally let us present the most compact form of the two induction principles used in [CM88] *) (* The first induction principle (actually a weakening of LEADSTO_thm23): *) let LEADSTO_thm41 = prove_thm ("LEADSTO_thm41", (`!X. (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q Pr. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!p P q Pr. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr) ==> (!(p:'a->bool) q Pr. (p LEADSTO q) Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (UNDISCH (SPEC_ALL (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) r q Pr. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) P q Pr. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr`); ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (SPEC_ALL LEADSTO_thm23)))));; (* Now prove the second induction principle: *) let LEADSTO_thm42_lemma00 = TAC_PROOF (([], (`!X Pr. (!p:'a->bool. p In P ==> LEADSTO2 p q Pr /\ X p q Pr) = ((!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q Pr))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm42_lemma01 = TAC_PROOF (([], (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = (LUB P)) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) = (!p q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = (LUB P)) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; let LEADSTO_thm42_lemma02 = TAC_PROOF (([], (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = LUB P) /\ (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) = (!p q. ((p ENSURES q)Pr ==> LEADSTO2 p q Pr /\ X p q Pr) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q Pr ==> LEADSTO2 p q Pr /\ X p q Pr) /\ (!P. (!p. p In P ==> LEADSTO2 p q Pr /\ X p q Pr) ==> LEADSTO2 (LUB P) q Pr /\ X (LUB P) q Pr))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THENL [ IMP_RES_TAC LEADSTO2_thm0 ; IMP_RES_TAC LEADSTO2_thm1 ; STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO_thm42_lemma00] (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr /\ X p q Pr`))) THEN IMP_RES_TAC LEADSTO2_thm3 ; STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO_thm42_lemma00] (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr /\ X p q Pr`))) THEN RES_TAC THEN ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME (`!p. (p = LUB P) ==> (X:('a->bool)->('a->bool)->(('a->'a)list)->bool)p q Pr`)))) ; ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm42_lemma00)] (CONJ (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr`)) (ASSUME (`!p. p In P ==> (X:('a->bool)->('a->bool)->(('a->'a)list)->bool) p q Pr`)))) THEN RES_TAC THEN ASM_REWRITE_TAC [] ]);; (* The strongest version of the second induction theorem: *) let LEADSTO_thm42 = prove_thm ("LEADSTO_thm42", (`!X Pr. (!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = (LUB P)) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) ==> (!(p:'a->bool) q. (p LEADSTO q) Pr ==> X p q Pr)`), REWRITE_TAC [LEADSTO_thm42_lemma01] THEN REWRITE_TAC [LEADSTO_EQ_LEADSTO2] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (BETA_RULE (SPEC (`\(p:'a->bool) q Pr. (LEADSTO2 p q Pr) /\ (X p q Pr)`) (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`))))) THEN ASSUME_TAC (REWRITE_RULE [LEADSTO_thm42_lemma02] (ASSUME (`!(p:'a->bool) q. ((p ENSURES q)Pr ==> X p q Pr) /\ (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q Pr ==> X p q Pr) /\ (!P. (p = LUB P) /\ (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)`))) THEN RES_TAC);; (* The second induction principle (actually a weakening of LEADSTO_thm42a): *) let LEADSTO_thm43 = prove_thm ("LEADSTO_thm43", (`!X. (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ (!p r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr) /\ (!p P q Pr. (p = (LUB P)) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr) ==> (!(p:'a->bool) q Pr. (p LEADSTO q) Pr ==> X p q Pr)`), REPEAT STRIP_TAC THEN ACCEPT_TAC (UNDISCH (SPEC_ALL (REWRITE_RULE [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr`); ASSUME (`!(p:'a->bool) P q Pr. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr`); ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (SPEC_ALL LEADSTO_thm42)))));; (* The last corollaries using the completion theorem: *) let LEADSTO_cor13_lemma01 = TAC_PROOF (([], (`!(Q:num->('a->bool)) r s. ((((/<=\* Q i) \/* r) /\* ((Q(SUC i)) \/* r)) \/* r)s = ((/<=\* Q (SUC i)) \/* r)s`)), REPEAT GEN_TAC THEN REWRITE_TAC [AND_LE_N_def; OR_def; AND_def] THEN BETA_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let LEADSTO_cor13 = prove_thm ("LEADSTO_cor13", (`!(P:num->('a->bool)) Q r st Pr. (!i. ((P i) LEADSTO ((Q i) \/* r)) (CONS st Pr)) /\ (!i. ((Q i) UNLESS r) (CONS st Pr)) ==> (!i. ((/<=\* P i) LEADSTO ((/<=\* Q i) \/* r)) (CONS st Pr))`), REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [ ASM_REWRITE_TAC [AND_LE_N_def] ; IMP_RES_TAC UNLESS_cor17 THEN ASSUME_TAC (SPEC_ALL (ASSUME (`!i. ((/<=\* (Q:num->'a->bool) i) UNLESS r)(CONS st Pr)`))) THEN ASSUME_TAC (SPEC (`SUC i`) (ASSUME (`!i. (((P:num->('a->bool)) i) LEADSTO ((Q i) \/* r))(CONS st Pr)`))) THEN ASSUME_TAC (SPEC (`SUC i`) (ASSUME (`!i. (((Q:num->('a->bool)) i) UNLESS r)(CONS st Pr)`))) THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`((/<=\* (Q:num->'a->bool) i) UNLESS r)(CONS st Pr)`); UNLESS_thm1] (SPECL [(`/<=\* (Q:num->('a->bool))i`); (`r:'a->bool`); (`r:'a->bool`); (`CONS(st:'a->'a)Pr`)] UNLESS_thm8)) THEN ASSUME_TAC (REWRITE_RULE [ASSUME (`(((Q:num->'a->bool)(SUC i)) UNLESS r)(CONS st Pr)`); UNLESS_thm1] (SPECL [(`(Q:num->('a->bool))(SUC i)`); (`r:'a->bool`); (`r:'a->bool`); (`CONS(st:'a->'a)Pr`)] UNLESS_thm8)) THEN ACCEPT_TAC (REWRITE_RULE [REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`s:'a`) (SPEC_ALL LEADSTO_cor13_lemma01))); SYM (SPEC_ALL (CONJUNCT2 AND_LE_N_def))] (REWRITE_RULE [ASSUME (`((/<=\* (P:num->'a->bool)i) LEADSTO ((/<=\* Q i) \/* r)) (CONS st Pr)`); ASSUME (`(((P:num->'a->bool)(SUC i)) LEADSTO ((Q(SUC i)) \/* r)) (CONS st Pr)`); ASSUME (`(((/<=\* (Q:num->'a->bool) i) \/* r) UNLESS r)(CONS st Pr)`); ASSUME (`((((Q:num->'a->bool)(SUC i)) \/* r) UNLESS r)(CONS st Pr)`)] (SPECL [(`/<=\* (P:num->'a->bool)i`); (`(/<=\* (Q:num->'a->bool)i) \/* r`); (`(P:num->'a->bool)(SUC i)`); (`((Q:num->'a->bool)(SUC i)) \/* r`); (`r:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm35))) ]);; (* Prove: !p q r b p' q' r' b' Pr. (p LEADSTO (q \/* r)) Pr /\ (q UNLESS b) Pr /\ (p' LEADSTO (q' \/* r')) Pr /\ (q' UNLESS b') Pr ==> ((p /\* p') LEADSTO ((q /\* q') \/* ((r \/* b) \/* (r' \/* b'))) Pr Hint: Show that: b ==> (r \/* b) \/* (r' \/* b') b' ==> (r \/* b) \/* (r' \/* b') use these as assumptions for the unless properties in using the weakening theorem we then have q unless (r \/* b) \/* (r' \/* b') in st^Pr, q' unless (R \/* B) \/* (R' \/* B') in st^Pr, now show that: r ==> (r \/* b) \/* (r' \/* b') r' ==> (r \/* b) \/* (r' \/* b') use these to derive the leadto properties: r leadsto ((r \/* b) \/* (r' \/* b')) in st^Pr r' leadsto ((r \/* b) \/* (r' \/* b')) in st^Pr by using the cancellation theorem of leadsto we get p leadsto q \/* ((r \/* b) \/* (r' \/* b')) in st^Pr p' leadsto q' \/* ((r \/* b) \/* (r' \/* b')) in st^Pr now we are ready to use the theorem of completion: p leadsto q \/* ((r \/* b) \/* (r' \/* b')) in st^Pr, q unless (r \/* b) \/* (r' \/* b') in st^Pr, p' leadsto q \/* ((r \/* b) \/* (r' \/* b')) in st^Pr, q' unless (r \/* b) \/* (r' \/* b') in st^Pr ---------------------------------------------------------------------- (p /\* p') leadsto (q /\* q') \/* ((r \/* b) \/* (r' \/* b')) in st^Pr *) (* Prove: !p q r p' q' Pr. (p LEADSTO (q \/* r)) Pr /\ (q UNLESS r) Pr /\ (p' LEADSTO (q' \/* r)) Pr /\ (q' UNLESS r) Pr ==> ((p /\* p') LEADSTO ((q /\* q') \/* r)) Pr *) let LEADSTO_cor14 = prove_thm ("LEADSTO_cor14", (`!(p:'a->bool) q r p' q' st Pr. (p LEADSTO (q \/* r))(CONS st Pr) /\ (q UNLESS r)(CONS st Pr) /\ (p' LEADSTO (q' \/* r))(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL [(`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm1) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((q:'a->bool) UNLESS r)(CONS st Pr)`); (`((r:'a->bool) UNLESS r)(CONS st Pr)`)] AND_INTRO_THM)) THEN ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] (UNDISCH_ALL (SPECL [(`q:'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm7))) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((q':'a->bool)UNLESS r)(CONS st Pr)`); (`((r:'a->bool) UNLESS r)(CONS st Pr)`)] AND_INTRO_THM)) THEN ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] (UNDISCH_ALL (SPECL [(`q':'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm7))) THEN ASSUME_TAC (SPECL [(`p:'a->bool`); (`(q:'a->bool) \/* r`); (`p':'a->bool`); (`(q':'a->bool) \/* r`); (`r:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm35) THEN RES_TAC THEN UNDISCH_TAC (`(((p:'a->bool) /\* p') LEADSTO (((q \/* r) /\* (q' \/* r)) \/* r))(CONS st Pr)`) THEN ONCE_REWRITE_TAC [SPECL [(`(q:'a->bool) \/* r`); (`r:'a->bool`); (`q':'a->bool`)] AND_OR_COMM_lemma] THEN ONCE_REWRITE_TAC [SPECL [(`(r:'a->bool) \/* q'`); (`r:'a->bool`); (`q:'a->bool`)] OR_COMM_AND_lemma] THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL OR_AND_DISTR_lemma))] THEN ONCE_REWRITE_TAC [SPECL [(`r:'a->bool`); (`(q:'a->bool) /\* q'`)] OR_COMM_lemma] THEN REWRITE_TAC [OR_ASSOC_lemma; OR_OR_lemma]);; (* !p q r b p' q' r' b' Pr. (p LEADSTO (q \/* r)) Pr /\ (q UNLESS b) Pr /\ (p' LEADSTO (q' \/* r')) Pr /\ (q' UNLESS b') Pr ==> ((p /\* p') LEADSTO ((q /\* q') \/* ((r \/* b) \/* (r' \/* b')))) Pr *) let LEADSTO_cor15 = prove_thm ("LEADSTO_cor15", (`!(p:'a->bool) q r b p' q' r' b' st Pr. (p LEADSTO (q \/* r))(CONS st Pr) /\ (q UNLESS b)(CONS st Pr) /\ (p' LEADSTO (q' \/* r'))(CONS st Pr) /\ (q' UNLESS b')(CONS st Pr) ==> ((p /\* p') LEADSTO ((q /\* q') \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr)`), REPEAT STRIP_TAC THEN MP_TAC (SPECL [(`b:'a->bool`); (`(r:'a->bool) \/* (r' \/* b')`)] OR_IMPLY_WEAK_lemma) THEN REWRITE_TAC [SYM (SPECL [(`b:'a->bool`); (`r:'a->bool`); (`(r':'a->bool) \/* b'`)] OR_ASSOC_lemma)] THEN ONCE_REWRITE_TAC [SPECL [(`(r':'a->bool) \/* b'`); (`r:'a->bool`); (`b:'a->bool`)] OR_COMM_OR_lemma] THEN DISCH_TAC THEN MP_TAC (SPECL [(`b':'a->bool`); (`(r':'a->bool) \/* (r \/* b)`)] OR_IMPLY_WEAK_lemma) THEN REWRITE_TAC [SYM (SPECL [(`b':'a->bool`); (`r':'a->bool`); (`(r:'a->bool) \/* b`)] OR_ASSOC_lemma)] THEN ONCE_REWRITE_TAC [SPECL [(`(r:'a->bool) \/* b`); (`r':'a->bool`); (`b':'a->bool`)] OR_COMM_OR_lemma] THEN ONCE_REWRITE_TAC [SPECL [(`(r':'a->bool) \/* b'`); (`(r:'a->bool) \/* b`)] OR_COMM_lemma] THEN DISCH_TAC THEN MP_TAC (SPECL [(`r:'a->bool`); (`(b:'a->bool) \/* (r' \/* b')`)] OR_IMPLY_WEAK_lemma) THEN REWRITE_TAC [SYM (SPECL [(`r:'a->bool`); (`b:'a->bool`); (`(r':'a->bool) \/* b'`)] OR_ASSOC_lemma)] THEN DISCH_TAC THEN MP_TAC (SPECL [(`r':'a->bool`); (`(b':'a->bool) \/* (r \/* b)`)] OR_IMPLY_WEAK_lemma) THEN REWRITE_TAC [SYM (SPECL [(`r':'a->bool`); (`b':'a->bool`); (`(r:'a->bool) \/* b`)] OR_ASSOC_lemma)] THEN ONCE_REWRITE_TAC [SPECL [(`(r':'a->bool) \/* b'`); (`(r:'a->bool) \/* b`)] OR_COMM_lemma] THEN DISCH_TAC THEN REWRITE_TAC [SYM (SPECL [(`(r:'a->bool) \/* b`); (`(r':'a->bool) \/* b'`); (`(q:'a->bool) /\* q'`)] OR_ASSOC_lemma)] THEN ONCE_REWRITE_TAC [SPECL [(`(((r:'a->bool) \/* b) \/* (r' \/* b'))`); (`(q:'a->bool) /\* q'`)] OR_COMM_lemma] THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((q:'a->bool) UNLESS b)(CONS st Pr)`); (`!s:'a. b s ==> ((r \/* b) \/* (r' \/* b'))s`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`q:'a->bool`); (`b:'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm3)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((q':'a->bool) UNLESS b')(CONS st Pr)`); (`!s:'a. b' s ==> ((r \/* b) \/* (r' \/* b'))s`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`q':'a->bool`); (`b':'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm3)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`r:'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm25)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`r':'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm25)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) LEADSTO (q \/* r))(CONS st Pr)`); (`((r:'a->bool) LEADSTO ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`r:'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p':'a->bool) LEADSTO (q' \/* r'))(CONS st Pr)`); (`((r':'a->bool) LEADSTO ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p':'a->bool`); (`q':'a->bool`); (`r':'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) LEADSTO (q \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr)`); (`((q:'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p':'a->bool) LEADSTO(q' \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr)`); (`((q':'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) LEADSTO(q \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ ((q:'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`); (`((p':'a->bool)LEADSTO(q' \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ ((q':'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] AND_INTRO_THM)) THEN UNDISCH_TAC (`(((p:'a->bool) LEADSTO(q \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ (q UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)) /\ (p' LEADSTO (q' \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ (q' UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`) THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC))] THEN DISCH_TAC THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b'):'a->bool`); (`p':'a->bool`); (`q':'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_cor14)));; (* Prove: |- !P Q R B Pr. (!i. ((P i) LEADSTO ((Q i) \/* (R i)))Pr) /\ (!i. ((Q i) UNLESS (B i))Pr) ==> (!i. ((/<=\* P i) LEADSTO ((/<=\* Q i) \/* (( \<=/* R i) \/* ( \<=/* B i))))Pr) *) let LEADSTO_cor16_lemma1 = TAC_PROOF (([], (`!(Q:num->('a->bool)) R B i s. ((/<=\* Q(SUC i)) \/* (((( \<=/* R i) \/* ( \<=/* B i)) \/* ( \<=/* B i)) \/* ((R(SUC i)) \/* (B(SUC i)))))s = ((/<=\* Q(SUC i)) \/* (( \<=/* R(SUC i)) \/* ( \<=/* B(SUC i))))s`)), REPEAT GEN_TAC THEN REWRITE_TAC [OR_def; AND_LE_N_def; OR_LE_N_def; AND_def] THEN BETA_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let LEADSTO_cor16 = prove_thm ("LEADSTO_cor16", (`!(P:num->('a->bool)) Q R B st Pr. (!i. ((P i) LEADSTO ((Q i) \/* (R i)))(CONS st Pr)) /\ (!i. ((Q i) UNLESS (B i))(CONS st Pr)) ==> (!i. ((/<=\* P i) LEADSTO ((/<=\* Q i) \/* (( \<=/* R i) \/* ( \<=/* B i)))) (CONS st Pr))`), REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [ ASM_REWRITE_TAC [AND_LE_N_def; OR_LE_N_def] THEN ASSUME_TAC (ONCE_REWRITE_RULE [OR_ASSOC_lemma] (SPECL [(`((Q:num->('a->bool))0) \/* (R 0)`); (`((B:num->('a->bool))0)`)] OR_IMPLY_WEAK_lemma)) THEN ASSUME_TAC (SPEC (`0`) (ASSUME (`!i.(((P:num->('a->bool))i) LEADSTO ((Q i) \/* (R i)))(CONS st Pr)`))) THEN IMP_RES_TAC (SPECL [`(P:num->('a->bool)) 0`; `(Q:num->('a->bool)) 0 \/* R 0`; `(Q:num->('a->bool)) 0 \/* R 0 \/* B 0` ] LEADSTO_cor9) ; ASSUME_TAC (SPEC (`SUC i`) (ASSUME (`!i.(((P:num->('a->bool))i) LEADSTO ((Q i) \/* (R i)))(CONS st Pr)`))) THEN ASSUME_TAC (SPEC (`SUC i`) (ASSUME (`!i. (((Q:num->('a->bool)) i) UNLESS (B i))(CONS st Pr)`))) THEN ASSUME_TAC (SPEC (`i:num`) (UNDISCH_ALL (SPECL [(`Q:num->('a->bool)`); (`B:num->('a->bool)`); (`CONS st Pr:('a->'a)list`)] UNLESS_cor16))) THEN ACCEPT_TAC (REWRITE_RULE [ONCE_REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`s:'a`) (SPEC_ALL LEADSTO_cor16_lemma1)))] (REWRITE_RULE [SYM (SPEC_ALL (CONJUNCT2 AND_LE_N_def))] (REWRITE_RULE [ASSUME (`((/<=\* (P:num->'a->bool) i) LEADSTO ((/<=\* Q i) \/* (( \<=/* R i) \/* ( \<=/* B i))))(CONS st Pr)`); ASSUME (`(((P:num->'a->bool)(SUC i)) LEADSTO ((Q(SUC i)) \/* (R(SUC i)))) (CONS st Pr)`); ASSUME (`(((Q:num->'a->bool)(SUC i)) UNLESS (B(SUC i)))(CONS st Pr)`); ASSUME (`((/<=\* (Q:num->'a->bool) i) UNLESS ( \<=/* B i))(CONS st Pr)`)] (SPECL [(`/<=\* (P:num->('a->bool))i`); (`/<=\* (Q:num->('a->bool))i`); (`( \<=/* (R:num->('a->bool))i) \/* ( \<=/* (B:num->('a->bool))i)`); (` \<=/* (B:num->('a->bool))i`); (`(P:num->('a->bool))(SUC i)`); (`(Q:num->('a->bool))(SUC i)`); (`(R:num->('a->bool))(SUC i)`); (`(B:num->('a->bool))(SUC i)`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_cor15)))) ]);; hol-light/Unity/mk_state_logic.ml000066400000000000000000001017261303454263000174020ustar00rootroot00000000000000(* File: mk_state_logic.ml Description: This file defines the state abstracted logical operators used in unity and some theorems valid for the combination of these operators. Author: (c) Copyright 1989-2008 by Flemming Andersen Date: October 23, 1989 Last Update: December 30, 2007 *) (* loadt"aux_definitions.ml";; *) let FALSE_def = new_definition (`(False:'a->bool) = \s:'a. F`);; let TRUE_def = new_definition (`(True:'a->bool) = \s:'a. T`);; let NOT_def1 = new_definition (`Not (p:'a->bool) = \s. ~p s`);; let NOT_def2 = new_definition (`~* (p:'a->bool) = \s. ~p s`);; let AND_def = new_infix_definition ("/\*", "/\\", `/\* (p:'a->bool) (q:'a->bool) = \s. (p s) /\ (q s)`, OP_FIX);; let OR_def = new_infix_definition ("\/*", "\/", `\/* (p:'a->bool) (q:'a->bool) = \s. (p s) \/ (q s)`, OP_FIX);; let FORALL_def = new_binder_definition (`!* (P:'b->('a->bool)) = (\s. (!x. ((P x)s)))`) "!*";; let EXISTS_def = new_binder_definition (`?* (P:'b->('a->bool)) = (\s. (?x. ((P x)s)))`) "?*";; let CHOICE_def = new_binder_definition (`@* P = (\s:'a. (@x:'b. ((P x)s)))`) "@*";; let IMPLIES_def = new_infix_definition ("==>*", "==>", `==>* (p:'a->bool) (q:'a->bool) = \s. (p s) ==> (q s)`, OP_FIX);; let LESS_def = new_infix_definition ("<*", "<", `<* (p:'a->num) (q:'a->num) = \s. (p s) < (q s)`, OP_FIX);; let GREATER_def = new_infix_definition (">*", ">", `>* (p:'a->num) (q:'a->num) = \s. (p s) > (q s)`, OP_FIX);; let LESS_EQ_def = new_infix_definition ("<=*", "<=", `<=* (p:'a->num) (q:'a->num) = \s. (p s) <= (q s)`, OP_FIX);; let GREATER_EQ_def = new_infix_definition (">=*", ">=", `>=* (p:'a->num) (q:'a->num) = \s. (p s) >= (q s)`, OP_FIX);; let EQ_def = new_infix_definition ("=*", "=", `=* (p:'a->'b) (q:'a->'b) = \s. (p s) = (q s)`, OP_FIX);; let NEQ_def = new_infix_definition ("<>*", "=", `<>* (p:'a->'b) (q:'a->'b) = \s. ~((p s) = (q s))`, OP_FIX);; let GE_def = new_infix_definition ("=>*", "<=>", `=>* (p:'a->bool) (r1:'a->'b) (r2:'a->'b) = \s. if (p s) then r1 s else r2 s`, OP_FIX);; let PLUS_def = new_infix_definition ("+*", "+", `+* (p:'a->num) (q:'a->num) = \s. (p s) + (q s)`, OP_FIX);; let SUB_def = new_infix_definition ("-*", "-", `-* (p:'a->num) (q:'a->num) = \s. (p s) - (q s)`, OP_FIX);; let MUL_def = new_infix_definition ("**", "*", `(**) (p:'a->num) (q:'a->num) = \s. ((p s) * (q s))`, OP_FIX);; let SUC_def = new_definition (`Suc (p:'a->num) = \s. SUC (p s)`);; let PRE_def = new_definition (`Pre (p:'a->num) = \s. PRE (p s)`);; let MOD_def = new_infix_definition ("%*", "MOD", `%* (p:'a->num) (q:'a->num) = \s. (p s) MOD (q s)`, OP_FIX);; let DIV_def = new_infix_definition ("/*", "/", `/* (p:'a->num) (q:'a->num) = \s. (p s) DIV (q s)`, OP_FIX);; let EXP_def = new_infix_definition ("***", "EXP", `*** (p:'a->num) (q:'a->num) = \s. (p s) EXP (q s)`, OP_FIX);; (* State dependent index *) (* Weakness in defining priority: does o have same prio as Ind? *) let IND_def = new_infix_definition ("Ind", "o", `Ind (a:'a->('b->'c)) (i:'a->'b) = \s. (a s) (i s)`, OP_FIX);; (* More State dependent operators to be defined ??? *) (* Be aware that (!i :: i <= m. P i) = (!i. i <= m ==> P i) *) let FORALL_LE_def = new_definition (`!<=* (P:num->('a->bool)) m = (\s:'a. (!i. i <= m ==> ((P i)s)))`);; (* Be aware that ?i :: i <= m. P i == ?i. i <= m /\ P i *) let EXISTS_LE_def = new_definition (`?<=* (P:num->('a->bool)) m = (\s:'a. (?i. i <= m /\ ((P i)s)))`);; let EXISTS_LT_def = new_definition (`?<* (P:num->('a->bool)) m = (\s:'a. (?i. i < m /\ ((P i)s)))`);; let AND_LE_N_def = new_recursive_definition num_RECURSION (`(!P. /<=\* P 0 = (P:num->('a->bool)) 0) /\ (!P. /<=\* P (SUC i) = ((/<=\* P i) /\* (P (SUC i))))`);; let OR_LE_N_def = new_recursive_definition num_RECURSION (`(!P. \<=/* P 0 = (P:num->('a->bool)) 0) /\ (!P. (\<=/* P (SUC i)) = ((\<=/* P i) \/* (P (SUC i))))`);; let AND_LT_N_def = new_recursive_definition num_RECURSION (`(!P. /<\* P 0 = (False:'a->bool)) /\ (!P. /<\* P (SUC i) = ((/<\* P i) /\* (P i)))`);; let OR_LT_N_def = new_recursive_definition num_RECURSION (`(!P. \bool)) /\ (!P. \bool`;; let q = `q:'a->bool`;; let r = `r:'a->bool`;; let i = `i:num`;; let P = `P:num->('a->bool)`;; let IMPLY_WEAK_lemma1 = prove_thm ("IMPLY_WEAK_lemma1", (`!p q p' q' (s:'a). ( (((p /\* q') \/* (p' /\* q)) \/* (q /\* q')) s ) ==> ((q \/* q') s)`), REPEAT(GEN_TAC) THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [(SYM (SPEC_ALL DISJ_ASSOC))] THEN REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let IMPLY_WEAK_lemma2 = prove_thm ("IMPLY_WEAK_lemma2", `!p q p' q' (s:'a). ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))s ==> (q \/* q')s`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN BETA_TAC THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); SYM (SPEC_ALL DISJ_ASSOC); NOT_CLAUSES; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let IMPLY_WEAK_lemma3 = prove_thm ("IMPLY_WEAK_lemma3", `!p q r (s:'a). ((((Not p) /\* r) \/* ((Not q) /\* q)) \/* (q /\* r))s ==> r s`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [(SYM (SPEC_ALL DISJ_ASSOC))] THEN REPEAT STRIP_TAC THEN RES_TAC);; let IMPLY_WEAK_lemma4 = prove_thm ("IMPLY_WEAK_lemma4", `!p q p' q' r r' (s:'a). ((((Not(p \/* p')) /\* (p \/* r')) \/* ((Not(q \/* q')) /\* (q \/* r))) \/* ((q \/* r) /\* (p \/* r')))s ==> ((p /\* q) \/* r \/* r')s`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [SYM (SPEC_ALL DISJ_ASSOC); GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); NOT_CLAUSES; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let IMPLY_WEAK_lemma5 = prove_thm ("IMPLY_WEAK_lemma5", `!p q r (s:'a). ((p /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r)) s ==> (q \/* r) s`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let IMPLY_WEAK_lemma6 = prove_thm ("IMPLY_WEAK_lemma6", `!p q b r (s:'a). ((r /\* q) \/* (p /\* b) \/* (b /\* q)) s ==> ((q /\* r) \/* b) s`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let IMPLY_WEAK_lemma7 = prove_thm ("IMPLY_WEAK_lemma7", `!p q b r (s:'a). (((r /\* q) \/* ((r /\* p) /\* b)) \/* (b /\* q)) s ==> ((q /\* r) \/* b) s`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let CONJ_COMM_DISJ_lemma_a = TAC_PROOF (([], `!p q r (s:'a). (r s /\ q s) \/ p s ==> (q s /\ r s) \/ p s`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let CONJ_COMM_DISJ_lemma_b = TAC_PROOF (([], `!p q r (s:'a). (q s /\ r s) \/ p s ==> (r s /\ q s) \/ p s`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let CONJ_COMM_DISJ_lemma = TAC_PROOF (([], `!p q r (s:'a). (r s /\ q s) \/ p s <=> (q s /\ r s) \/ p s`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL CONJ_COMM_DISJ_lemma_a) (SPEC_ALL CONJ_COMM_DISJ_lemma_b)));; let AND_COMM_OR_lemma = prove_thm ("AND_COMM_OR_lemma", `!(p:'a->bool) q r. ((r /\* q) \/* p) = ((q /\* r) \/* p)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_COMM_DISJ_lemma)));; let CONJ_DISJ_COMM_lemma_a = TAC_PROOF (([], `!p q r (s:'a). (p s /\ (r s \/ q s)) ==> (p s /\ (q s \/ r s))`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let CONJ_DISJ_COMM_lemma_b = TAC_PROOF (([], `!p q r (s:'a). (p s /\ (q s \/ r s)) ==> (p s /\ (r s \/ q s))`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let CONJ_DISJ_COMM_lemma = TAC_PROOF (([], `!p q r (s:'a). (p s /\ (r s \/ q s)) = (p s /\ (q s \/ r s))`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL CONJ_DISJ_COMM_lemma_a) (SPEC_ALL CONJ_DISJ_COMM_lemma_b)));; let AND_OR_COMM_lemma = prove_thm ("AND_OR_COMM_lemma", `!(p:'a->bool) q r. p /\* (r \/* q) = p /\* (q \/* r)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_DISJ_COMM_lemma)));; let DISJ_COMM_CONJ_lemma_a = TAC_PROOF (([], `!p q r (s:'a). (r s \/ q s) /\ p s ==> (q s \/ r s) /\ p s`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_COMM_CONJ_lemma_b = TAC_PROOF (([], `!p q r (s:'a). (q s \/ r s) /\ p s ==> (r s \/ q s) /\ p s`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_COMM_CONJ_lemma = TAC_PROOF (([], `!p q r (s:'a). (r s \/ q s) /\ p s <=> (q s \/ r s) /\ p s`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL DISJ_COMM_CONJ_lemma_a) (SPEC_ALL DISJ_COMM_CONJ_lemma_b)));; let OR_COMM_AND_lemma = prove_thm ("OR_COMM_AND_lemma", `!(p:'a->bool) q r. (r \/* q) /\* p = (q \/* r) /\* p`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_COMM_CONJ_lemma)));; let DISJ_COMM_DISJ_lemma_a = TAC_PROOF (([], `!p q r (s:'a). (r s \/ q s) \/ p s ==> (q s \/ r s) \/ p s`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_COMM_DISJ_lemma_b = TAC_PROOF (([], `!p q r (s:'a). (q s \/ r s) \/ p s ==> (r s \/ q s) \/ p s`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_COMM_DISJ_lemma = TAC_PROOF (([], `!(p:'a->bool) q r s. (r s \/ q s) \/ p s <=> (q s \/ r s) \/ p s`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL DISJ_COMM_DISJ_lemma_a) (SPEC_ALL DISJ_COMM_DISJ_lemma_b)));; let OR_COMM_OR_lemma = prove_thm ("OR_COMM_OR_lemma", `!(p:'a->bool) q r. (r \/* q) \/* p = (q \/* r) \/* p`, REPEAT GEN_TAC THEN REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_COMM_DISJ_lemma)));; let DISJ_DISJ_COMM_lemma_a = TAC_PROOF (([], `!p q r (s:'a). p s \/ (r s \/ q s) ==> p s \/ (q s \/ r s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_DISJ_COMM_lemma_b = TAC_PROOF (([], `!p q r (s:'a). p s \/ (q s \/ r s) ==> p s \/ (r s \/ q s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_DISJ_COMM_lemma = TAC_PROOF (([], `!p q r (s:'a). p s \/ (r s \/ q s) <=> p s \/ (q s \/ r s) `), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL DISJ_DISJ_COMM_lemma_a) (SPEC_ALL DISJ_DISJ_COMM_lemma_b)));; let OR_OR_COMM_lemma = prove_thm ("OR_OR_COMM_lemma", (`!(p:'a->bool) q r. p \/* (r \/* q) = p \/* (q \/* r)`), REPEAT GEN_TAC THEN REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_DISJ_COMM_lemma)));; let CONJ_COMM_CONJ_lemma_a = TAC_PROOF (([], `!p q r (s:'a). (r s /\ q s) /\ p s ==> (q s /\ r s) /\ p s`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let CONJ_COMM_CONJ_lemma_b = TAC_PROOF (([], `!p q r (s:'a). (q s /\ r s) /\ p s ==> (r s /\ q s) /\ p s`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let CONJ_COMM_CONJ_lemma = TAC_PROOF (([], `!p q r (s:'a). (r s /\ q s) /\ p s <=> (q s /\ r s) /\ p s`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL CONJ_COMM_CONJ_lemma_a) (SPEC_ALL CONJ_COMM_CONJ_lemma_b)));; let AND_COMM_AND_lemma = prove_thm ("AND_COMM_AND_lemma", `!(p:'a->bool) q r. (r /\* q) /\* p = (q /\* r) /\* p`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_COMM_CONJ_lemma)));; let CONJ_CONJ_COMM_lemma_a = TAC_PROOF (([], `!p q r (s:'a). p s /\ (r s /\ q s) ==> p s /\ (q s /\ r s)`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let CONJ_CONJ_COMM_lemma_b = TAC_PROOF (([], `!p q r (s:'a). p s /\ (q s /\ r s) ==> p s /\ (r s /\ q s)`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let CONJ_CONJ_COMM_lemma = TAC_PROOF (([], `!p q r (s:'a). p s /\ (r s /\ q s) <=> p s /\ (q s /\ r s) `), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL CONJ_CONJ_COMM_lemma_a) (SPEC_ALL CONJ_CONJ_COMM_lemma_b)));; let AND_AND_COMM_lemma = prove_thm ("AND_AND_COMM_lemma", `!(p:'a->bool) q r. p /\* (r /\* q) = p /\* (q /\* r)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_CONJ_COMM_lemma)));; let DISJ_CONJ_COMM_lemma_a = TAC_PROOF (([], `!p q r (s:'a). p s \/ (r s /\ q s) ==> p s \/ (q s /\ r s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_CONJ_COMM_lemma_b = TAC_PROOF (([], `!p q r (s:'a). p s \/ (q s /\ r s) ==> p s \/ (r s /\ q s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_CONJ_COMM_lemma = TAC_PROOF (([], `!p q r (s:'a). p s \/ (r s /\ q s) <=> p s \/ (q s /\ r s)`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (IMP_ANTISYM_RULE (SPEC_ALL DISJ_CONJ_COMM_lemma_a) (SPEC_ALL DISJ_CONJ_COMM_lemma_b)));; let OR_AND_COMM_lemma = prove_thm ("OR_AND_COMM_lemma", `!(p:'a->bool) q r. p \/* (r /\* q) = p \/* (q /\* r)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_CONJ_COMM_lemma)));; let NOT_NOT_lemma = prove_thm ("NOT_NOT_lemma", `!(p:'a->bool). (Not (Not p)) = p`, REWRITE_TAC [NOT_def1] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [NOT_CLAUSES; ETA_AX]);; let DISJ_COMM_lemma = TAC_PROOF (([], `!p q (s:'a). p s \/ q s <=> q s \/ p s`), REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (SPECL [`(p (s:'a)):bool`; `(q (s:'a)):bool`] DISJ_SYM));; let OR_COMM_lemma = prove_thm ("OR_COMM_lemma", `!(p:'a->bool) q. (p \/* q) = (q \/* p)`, REPEAT STRIP_TAC THEN REWRITE_TAC [OR_def] THEN ASSUME_TAC DISJ_COMM_lemma THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q] (ASSUME (`!(p:'a->bool) q s. p s \/ q s <=> q s \/ p s`)))));; let OR_OR_lemma = prove_thm ("OR_OR_lemma", `!p:'a->bool. p \/* p = p`, GEN_TAC THEN REWRITE_TAC [OR_def; ETA_AX]);; let DISJ_ASSOC_lemma = TAC_PROOF (([], `!p q r (s:'a). ((p s \/ q s) \/ r s) <=> (p s \/ (q s \/ r s))`), REWRITE_TAC [(SYM (SPEC_ALL DISJ_ASSOC))]);; let OR_ASSOC_lemma = prove_thm ("OR_ASSOC_lemma", (`!(p:'a->bool) q r. (p \/* q) \/* r = p \/* (q \/* r)`), REPEAT STRIP_TAC THEN REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASSUME_TAC DISJ_ASSOC_lemma THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] (ASSUME (`!p q r (s:'a). ((p s \/ q s) \/ r s) <=> (p s \/ (q s \/ r s))`)))));; let CONJ_WEAK_lemma = TAC_PROOF (([], `!p q (s:'a). p s /\ q s ==> q s`), REPEAT STRIP_TAC THEN RES_TAC);; let AND_IMPLY_WEAK_lemma = prove_thm ("AND_IMPLY_WEAK_lemma", `!p q (s:'a). (p /\* q) s ==> q s`, REWRITE_TAC [AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [CONJ_WEAK_lemma]);; let SYM_CONJ_WEAK_lemma = TAC_PROOF (([], `!p q (s:'a). p s /\ q s ==> p s`), REPEAT STRIP_TAC THEN RES_TAC);; let SYM_AND_IMPLY_WEAK_lemma = prove_thm ("SYM_AND_IMPLY_WEAK_lemma", `!p q (s:'a). (p /\* q) s ==> p s`, REWRITE_TAC [AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [SYM_CONJ_WEAK_lemma]);; let OR_IMPLY_WEAK_lemma = prove_thm ("OR_IMPLY_WEAK_lemma", `!p q (s:'a). p s ==> (p \/* q) s`, REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let SYM_OR_IMPLY_WEAK_lemma = prove_thm ("SYM_OR_IMPLY_WEAK_lemma", `!p q (s:'a). p s ==> (q \/* p) s`, REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let IMPLY_WEAK_AND_lemma = prove_thm ("IMPLY_WEAK_AND_lemma", `!(p:'a->bool) q r. (!s. p s ==> q s) ==> (!s. (p /\* r) s ==> (q /\* r) s)`, REWRITE_TAC [AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THENL [RES_TAC; RES_TAC THEN ASM_REWRITE_TAC []]);; let IMPLY_WEAK_OR_lemma = prove_thm ("IMPLY_WEAK_OR_lemma", `!(p:'a->bool) q r. (!s. p s ==> q s) ==> (!s. (p \/* r) s ==> (q \/* r) s)`, REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THENL [RES_TAC THEN ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let AND_AND_lemma = prove_thm ("AND_AND_lemma", `!p:'a->bool. p /\* p = p`, REWRITE_TAC [AND_def; ETA_AX]);; let CONJ_COMM_lemma = TAC_PROOF (([], `!p q (s:'a). (p s /\ q s) <=> (q s /\ p s)`), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPECL [`(p:'a->bool) s`; `(q:'a->bool) s`] CONJ_SYM));; let AND_COMM_lemma = prove_thm ("AND_COMM_lemma", (`!(p:'a->bool) q. (p /\* q) = (q /\* p)`), REWRITE_TAC [AND_def] THEN REPEAT GEN_TAC THEN ASSUME_TAC CONJ_COMM_lemma THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q] (ASSUME (`!p q (s:'a). p s /\ q s <=> q s /\ p s`)))));; let CONJ_ASSOC_lemma = TAC_PROOF (([], `!p q r (s:'a). ((p s /\ q s) /\ r s) <=> (p s /\ (q s /\ r s))`), REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC))]);; let AND_ASSOC_lemma = prove_thm ("AND_ASSOC_lemma", `!(p:'a->bool) q r. (p /\* q) /\* r = p /\* (q /\* r)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASSUME_TAC CONJ_ASSOC_lemma THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] (ASSUME (`!p q r (s:'a). ((p s /\ q s) /\ r s) <=> (p s /\ (q s /\ r s))`)))));; let NOT_True_lemma = prove_thm ("NOT_True_lemma", `Not (True:'a->bool) = False`, REWRITE_TAC [NOT_def1; TRUE_def; FALSE_def; ETA_AX]);; let NOT_False_lemma = prove_thm ("NOT_False_lemma", `Not (False:'a->bool) = True`, REWRITE_TAC [NOT_def1; TRUE_def; FALSE_def; ETA_AX]);; let AND_True_lemma = prove_thm ("AND_True_lemma", `!p:'a->bool. p /\* True = p`, REWRITE_TAC [AND_def; TRUE_def; ETA_AX]);; let OR_True_lemma = prove_thm ("OR_True_lemma", `!p:'a->bool. p \/* True = True`, REWRITE_TAC [OR_def; TRUE_def; ETA_AX]);; let AND_False_lemma = prove_thm ("AND_False_lemma", `!p:'a->bool. p /\* False = False`, REWRITE_TAC [AND_def; FALSE_def; ETA_AX]);; let OR_False_lemma = prove_thm ("OR_False_lemma", `!p:'a->bool. p \/* False = p`, REWRITE_TAC [OR_def; FALSE_def; ETA_AX]);; let P_OR_NOT_P_lemma = prove_thm ("P_OR_NOT_P_lemma", `!p:'a->bool. p \/* (Not p) = True`, REWRITE_TAC [OR_def; NOT_def1; TRUE_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [EXCLUDED_MIDDLE; OR_CLAUSES; NOT_CLAUSES; ETA_AX]);; let P_AND_NOT_P_lemma = prove_thm ("P_AND_NOT_P_lemma", `!p:'a->bool. p /\* (Not p) = False`, REWRITE_TAC [AND_def; NOT_def1; FALSE_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [NOT_AND; AND_CLAUSES; NOT_CLAUSES; ETA_AX]);; let CONJ_COMPL_DISJ_lemma1 = TAC_PROOF (([], `!p q. p /\ ~q \/ p /\ q ==> p`), REPEAT STRIP_TAC);; let CONJ_COMPL_DISJ_lemma2 = TAC_PROOF (([], `!p q. p ==> p /\ ~q \/ p /\ q`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THEN PURE_ONCE_REWRITE_TAC [DISJ_SYM] THEN REWRITE_TAC [EXCLUDED_MIDDLE]);; let CONJ_COMPL_DISJ_lemma = TAC_PROOF (([], `!p q. p /\ ~q \/ p /\ q <=> p`), REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL CONJ_COMPL_DISJ_lemma1) (SPEC_ALL CONJ_COMPL_DISJ_lemma2)]);; let AND_COMPL_OR_lemma = prove_thm ("AND_COMPL_OR_lemma", `!(p:'a->bool) q. ((p /\* (Not q)) \/* (p /\* q)) = p`, REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [CONJ_COMPL_DISJ_lemma; ETA_AX]);; let DISJ_NOT_CONJ_lemma1 = TAC_PROOF (([], `!p q. (p \/ q) /\ ~q ==> p /\ ~q`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THEN RES_TAC);; let DISJ_NOT_CONJ_lemma2 = TAC_PROOF (([], `!p q. p /\ ~q ==> (p \/ q) /\ ~q`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THEN RES_TAC);; let DISJ_NOT_CONJ_lemma = TAC_PROOF (([], `!p q. (p \/ q) /\ ~q <=> p /\ ~q`), REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL DISJ_NOT_CONJ_lemma1) (SPEC_ALL DISJ_NOT_CONJ_lemma2)]);; let OR_NOT_AND_lemma = prove_thm ("OR_NOT_AND_lemma", `!(p:'a->bool) q. ((p \/* q) /\* (Not q)) = p /\* (Not q)`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [DISJ_NOT_CONJ_lemma]);; let P_CONJ_Q_DISJ_Q_lemma1 = TAC_PROOF (([], `!(p:'a->bool) q s. (p s /\ q s) \/ q s ==> q s`), REPEAT STRIP_TAC);; let P_CONJ_Q_DISJ_Q_lemma2 = TAC_PROOF (([], `!(p:'a->bool) q s. q s ==> (p s /\ q s) \/ q s`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let P_CONJ_Q_DISJ_Q_lemma = TAC_PROOF (([], `!(p:'a->bool) q s. (p s /\ q s) \/ q s <=> q s`), ASM_REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL P_CONJ_Q_DISJ_Q_lemma1) (SPEC_ALL P_CONJ_Q_DISJ_Q_lemma2)]);; let P_AND_Q_OR_Q_lemma = prove_thm ("P_AND_Q_OR_Q_lemma", `!(p:'a->bool) q. (p /\* q) \/* q = q`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [GEN_ALL (MK_ABS (SPECL [p;q] P_CONJ_Q_DISJ_Q_lemma)); ETA_AX]);; let P_DISJ_Q_CONJ_Q_lemma1 = TAC_PROOF (([], `!(p:'a->bool) q s. (p s \/ q s) /\ q s ==> q s`), REPEAT STRIP_TAC);; let P_DISJ_Q_CONJ_Q_lemma2 = TAC_PROOF (([], `!(p:'a->bool) q s. q s ==> (p s \/ q s) /\ q s`), REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let P_DISJ_Q_CONJ_Q_lemma = TAC_PROOF (([], `!(p:'a->bool) q s. (p s \/ q s) /\ q s <=> q s`), ASM_REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL P_DISJ_Q_CONJ_Q_lemma1) (SPEC_ALL P_DISJ_Q_CONJ_Q_lemma2)]);; let P_OR_Q_AND_Q_lemma = prove_thm ("P_OR_Q_AND_Q_lemma", `!(p:'a->bool) q. (p \/* q) /\* q = q`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [GEN_ALL (MK_ABS (SPECL [p;q] P_DISJ_Q_CONJ_Q_lemma)); ETA_AX]);; let NOT_OR_AND_NOT_lemma = prove_thm ("NOT_OR_AND_NOT_lemma", `!(p:'a->bool) q. Not (p \/* q) = (Not p) /\* (Not q)`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [NOT_CLAUSES; DE_MORGAN_THM]);; let NOT_AND_OR_NOT_lemma = prove_thm ("NOT_AND_OR_NOT_lemma", `!(p:'a->bool) q. Not (p /\* q) = (Not p) \/* (Not q)`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [NOT_CLAUSES; DE_MORGAN_THM]);; let NOT_IMPLY_OR_lemma = prove_thm ("NOT_IMPLY_OR_lemma", `!(p:'a->bool) q. (!s. (Not p)s ==> q s) = (!s. (p \/* q)s)`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [IMP_DISJ_THM]);; let IMPLY_OR_lemma = prove_thm ("IMPLY_OR_lemma", `!(p:'a->bool) q. (!s. p s ==> q s) = (!s. ((Not p) \/* q)s)`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [IMP_DISJ_THM]);; let OR_IMPLY_lemma = prove_thm ("OR_IMPLY_lemma", `!(p:'a->bool) q. (!s. (p \/* q)s) = (!s. (Not p)s ==> q s)`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [IMP_DISJ_THM; NOT_CLAUSES]);; let NOT_OR_IMPLY_lemma = prove_thm ("NOT_OR_IMPLY_lemma", `!(p:'a->bool) q. (!s. ((Not p) \/* q)s) = (!s. p s ==> q s)`, REPEAT GEN_TAC THEN REWRITE_TAC [NOT_def1; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [IMP_DISJ_THM; NOT_CLAUSES]);; let DISJ_CONJ_lemma1 = TAC_PROOF (([], `!p q r (s:'a). (p s \/ q s /\ r s) ==> ((p s \/ q s) /\ (p s \/ r s))`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_CONJ_lemma2 = TAC_PROOF (([], `!(p:'a->bool) q r s. ((p s \/ q s) /\ (p s \/ r s)) ==> (p s \/ q s /\ r s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let DISJ_CONJ_lemma = TAC_PROOF (([], `!(p:'a->bool) q r s. (p s \/ q s /\ r s) <=> ((p s \/ q s) /\ (p s \/ r s))`), REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL DISJ_CONJ_lemma1) (SPEC_ALL DISJ_CONJ_lemma2)]);; let OR_AND_DISTR_lemma = prove_thm ("OR_AND_DISTR_lemma", `!(p:'a->bool) q r. p \/* (q /\* r) = (p \/* q) /\* (p \/* r)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_CONJ_lemma)));; let CONJ_DISJ_lemma1 = TAC_PROOF (([], `!(p:'a->bool) q r s. (p s /\ (q s \/ r s)) ==> (p s /\ q s \/ p s /\ r s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let CONJ_DISJ_lemma2 = TAC_PROOF (([], `!(p:'a->bool) q r s. (p s /\ q s \/ p s /\ r s) ==> (p s /\ (q s \/ r s))`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let CONJ_DISJ_lemma = TAC_PROOF (([], `!(p:'a->bool) q r s. (p s /\ (q s \/ r s)) <=> (p s /\ q s \/ p s /\ r s)`), REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL CONJ_DISJ_lemma1) (SPEC_ALL CONJ_DISJ_lemma2)]);; let AND_OR_DISTR_lemma = prove_thm ("AND_OR_DISTR_lemma", `!(p:'a->bool) q r. p /\* (q \/* r) = (p /\* q) \/* (p /\* r)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_DISJ_lemma)));; let NOT_IMPLIES_False_lemma = prove_thm ("NOT_IMPLIES_False_lemma", `!(p:'a->bool). (!s. (Not p)s) ==> (!s. p s = False s)`, REWRITE_TAC [FALSE_def; NOT_def1] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC []);; let NOT_P_IMPLIES_P_EQ_False_lemma = prove_thm ("NOT_P_IMPLIES_P_EQ_False_lemma", `!(p:'a->bool). (!s. (Not p)s) ==> (p = False)`, REPEAT STRIP_TAC THEN ASSUME_TAC (MK_ABS (UNDISCH_ALL (SPEC_ALL NOT_IMPLIES_False_lemma))) THEN UNDISCH_TAC (`(\s:'a. p s) = (\s. False s)`) THEN REWRITE_TAC [ETA_AX]);; let NOT_AND_IMPLIES_lemma = prove_thm ("NOT_AND_IMPLIES_lemma", `!(p:'a->bool) q. (!s. (Not (p /\* q))s) <=> (!s. p s ==> Not q s)`, REWRITE_TAC [NOT_def1; AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [DE_MORGAN_THM; NOT_CLAUSES; IMP_DISJ_THM]);; let NOT_AND_IMPLIES_lemma1 = prove_thm ("NOT_AND_IMPLIES_lemma1", `!(p:'a->bool) q. (!s. (Not (p /\* q))s) ==> (!s. p s ==> Not q s)`, REWRITE_TAC [NOT_AND_IMPLIES_lemma]);; let NOT_AND_IMPLIES_lemma2 = prove_thm ("NOT_AND_IMPLIES_lemma2", `!(p:'a->bool) q. (!s. (Not (p /\* q))s) ==> (!s. q s ==> Not p s)`, REWRITE_TAC [NOT_AND_IMPLIES_lemma; NOT_def1] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC);; let CONJ_DISJ_IMPLY_lemma1 = TAC_PROOF (([], `!(p:'a->bool) q s. p s /\ (p s \/ q s) ==> p s`), REPEAT STRIP_TAC);; let CONJ_DISJ_IMPLY_lemma2 = TAC_PROOF (([], `!(p:'a->bool) q s. p s ==> p s /\ (p s \/ q s)`), REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; let CONJ_DISJ_IMPLY_lemma = TAC_PROOF (([], `!(p:'a->bool) q s. p s /\ (p s \/ q s) <=> p s`), REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL CONJ_DISJ_IMPLY_lemma1) (SPEC_ALL CONJ_DISJ_IMPLY_lemma2)]);; let CONJ_DISJ_ABS_IMPLY_lemma = TAC_PROOF (([], `!(p:'a->bool) q. (\s. p s /\ (p s \/ q s)) = p`), REPEAT GEN_TAC THEN REWRITE_TAC [CONJ_DISJ_IMPLY_lemma; ETA_AX]);; let AND_OR_EQ_lemma = prove_thm ("AND_OR_EQ_lemma", `!(p:'a->bool) q. p /\* (p \/* q) = p`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_def; OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [CONJ_DISJ_ABS_IMPLY_lemma]);; let AND_OR_EQ_AND_COMM_OR_lemma = prove_thm ("AND_OR_EQ_AND_COMM_OR_lemma", `!(p:'a->bool) q. p /\* (q \/* p) = p /\* (p \/* q)`, REPEAT GEN_TAC THEN REWRITE_TAC [AND_OR_EQ_lemma] THEN ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [AND_OR_EQ_lemma]);; let IMPLY_WEAK_lemma = prove_thm ("IMPLY_WEAK_lemma", `!(p:'a->bool) q. (!s. p s) ==> (!s. (p \/* q) s)`, REPEAT STRIP_TAC THEN REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC []);; let IMPLY_WEAK_lemma_b = prove_thm ("IMPLY_WEAK_lemma_b", `!(p:'a->bool) q s. p s ==> (p \/* q) s`, REPEAT STRIP_TAC THEN REWRITE_TAC [OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC []);; let ALL_AND_lemma1 = TAC_PROOF (([], `!(P:num->('a->bool)) i s. (!i. P i s) <=> (P i s /\ (!i. P i s))`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THENL [ ASM_REWRITE_TAC [] ; ASM_REWRITE_TAC [] ]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []]);; let ALL_OR_lemma1 = TAC_PROOF (([], `!(P:num->('a->bool)) i s. (?i. P i s) <=> (P i s \/ (?i. P i s))`), REPEAT GEN_TAC THEN EQ_TAC THENL [ REPEAT STRIP_TAC THEN DISJ2_TAC THEN EXISTS_TAC (`i':num`) THEN ASM_REWRITE_TAC [] ; REPEAT STRIP_TAC THENL [ EXISTS_TAC (`i:num`) THEN ASM_REWRITE_TAC [] ; EXISTS_TAC (`i:num`) THEN ASM_REWRITE_TAC [] ] ]);; let ALL_OR_lemma = prove_thm ("ALL_OR_lemma", `!(P:num->('a->bool)) i. (((?*) P) = ((P i) \/* ((?*) P)))`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC [EXISTS_def; OR_def] THEN BETA_TAC THEN STRIP_ASSUME_TAC (MK_ABS (SPECL [P;i] ALL_OR_lemma1)));; let ALL_i_OR_lemma1 = TAC_PROOF (([], `!P (s:'a). (?i. \<=/* P i s) = (?i. P i s)`), REPEAT STRIP_TAC THEN EQ_TAC THENL [ STRIP_TAC THEN UNDISCH_TAC (`\<=/* (P:num->('a->bool)) i s`) THEN SPEC_TAC (i,i) THEN INDUCT_TAC THENL [ REWRITE_TAC [OR_LE_N_def] THEN DISCH_TAC THEN EXISTS_TAC (`0`) THEN ASM_REWRITE_TAC [] ; REWRITE_TAC [OR_LE_N_def; OR_def] THEN BETA_TAC THEN REPEAT STRIP_TAC THENL [ RES_TAC THEN EXISTS_TAC (`i':num`) THEN ASM_REWRITE_TAC [] ; EXISTS_TAC (`SUC i`) THEN ASM_REWRITE_TAC [] ] ] ; STRIP_TAC THEN UNDISCH_TAC (`(P (i:num) (s:'a)):bool`) THEN SPEC_TAC (i,i) THEN INDUCT_TAC THENL [ DISCH_TAC THEN EXISTS_TAC (`0`) THEN ASM_REWRITE_TAC [OR_LE_N_def] ; DISCH_TAC THEN EXISTS_TAC (`SUC i`) THEN REWRITE_TAC [OR_LE_N_def; OR_def] THEN BETA_TAC THEN ASM_REWRITE_TAC [] ] ]);; let ALL_i_OR_lemma = prove_thm ("ALL_i_OR_lemma", (`!P. ((\s:'a. ?i. \<=/* P i s) = ((?*) P))`), REWRITE_TAC [EXISTS_def] THEN GEN_TAC THEN STRIP_ASSUME_TAC (MK_ABS (SPEC P ALL_i_OR_lemma1)));; hol-light/Unity/mk_unity_prog.ml000066400000000000000000001152161303454263000173030ustar00rootroot00000000000000(*---------------------------------------------------------------------------*) (* File: mk_unity_prog.sml Description: A back-end definition for the HOL-UNITY compiler programming language. ===================================================================== This file introduces general definitions for describing a program in HOL-UNITY. Author: (c) Copyright 1992-2008 by Flemming Andersen & Kim Dam Petersen Date: August 3, 1992 Updated: May 4, 1995 Updated: March 22, 2006 Last Update: December 30, 2007 The functions below are based on the following representations: type 'loc = ``program variable location'' type 'val = ``program value'' type state = ('loc -> 'val) ``program state'' type t xpr = state -> t ``expression of type t'' type t asg = t -> state -> state -> state ``assignment of type t'' type t var = (t xpr, t asg) ``variable of type t'' type atom = state -> state ``atomic (singleton action)'' type par = state -> state -> state ``parallel action'' type int = atom list ``interleaved action (program)'' type seq = var -> num -> (int list # num)``sequential action'' Description of type representation: (Added: March 22, 2006) ----------------------------------------------------------- 'loc is an atomic (location) value that identifies a variable. Composite variables, such as arrays and lists has a single identifier. Assignment to a composite part is considered an assignment to the complete variable, that doesn't change the non-assigned parts of the variable. 'val is a generic value type of all variables. It is constructed as a union of the types of the variables in the program. Each program will for each type of variable define a pair of functions to respectively encode and decode values of the type of the variable into and from the generic type 'val. state is a state that associates each variable (identified by it's 'loc location) with it's current value (encoded in the generic type 'val of value). A state represents the values of every variable at a given moment. A state is implemented as a map from variable locations ('loc) to the generic value ('val) of the applied variable location. ----- xpr 'val xpr - generic typed expression. t xpr is an expression of some (decoded) type t. An expression represents a state dependent value, ie. a value that depends on the values of variables. An expression is implemented as map from a state (in which the value is to be interpreted) to the value of the expression in that state. t asg is a assignment to a variable of type t. An assignment represents the change in state due to assignment of some variable to a value. An assignment is implemented as a map from the value to be assigned, the original state and a previous state to the final state. The need for two parameter states: original and previous is due to the fact that assignment Consider the (high-level) assignment: INITIALLY a[0] = 0 /\ a[1] = 1 ASSIGN a[a[0]], a[a[1]] := 1, 0 The right-hand-side expression, and the left-hand-side index expression should be evaluated in the original state. The parallel assignments of: a[a[0]], a[a[1]] := 1, 0 must be "transformed" into a single assignment of a: a := a[a[i] => 1, a[j] => 0] If more variables are to be assigned we get: i, j, a := 1, 0, a[a[i] => 1, a[j] => 0] A parallel assignment is evaluated in sequence; it is transformed into: [ i := <1> ] ; [ j := <0> ] ; [ a := 1, a[j] => 0> ] It should be obvious that the expression in <>-braces has to be evaluated in the original state of the parallel assignment, whereas the sequential assignments has to be evaluated in the state that is the result of the previous assignment. This explains the need for two state parameters. ** To Be Changed ** t var is a variable of type t. A variable is represented by a pair that allow read- and write- access to the variable. ** To Be Changed ** atom is an atomic action. An atomic action represents the state change associated with a single variable assignments. An atomic action is implemented as a function, that given an initial state returns the state after executing the atomic action. ** To Be Changed ** par is a parallel action. A parallel action represents the state change associated with multiple atomic actions, ex. (a[0] := a[1]) || (a[1] := a[0]). A parallel action is implemented as a function of an original- and previous state, that return a next state. The use of original- and previous state is explained above under section "t asg". ** To Be Changed ** int is an interleaved action. An interleaved action represents the semantic of an interleaved action. An interleaved action is implemented as a funtion that given an initial state returns the state after evaluating the interleaved action. seq is a sequential action. A sequential action is a sequence of interleaved actions. Each interleaved action is identified with a numeric label. A sequential action is represented as a function that takes a program counter variable location, a NUM -encode and -decode function and an initial label for the action and returns a pair with a list of interleaved actions that implements the individual actions to be executed in sequence and a numeric label that represents the end of the sequential action. This label is used as initial label for an optional sequential action that is compositionally added to the current. Example: val s1 : seq = `` Computer generated seq ''; val s2 : seq = `` Computer generated seq ''; val s1s2 : seq = fn pc => mk => ds => l0 => let val (lst1, l1) = s1 pc mk ds l0 in let val (lst2, l2) = s2 pc mk ds l1 in (APPEND lst1 lst2, l2) [Flemming, May 1995: Whereas we leave it for now due to the otherwize need for updating the compiler, assignment COULD BE CHANGED to the alternative below...] An alternative way of implementing multiple parallel assignment exists: 1. Introduce a parallel variable assignment operator, which takes a list of locations and a list of evaluated generic typed expressions and performs the assignment. There will no problems with side-effects, due to the fact that all values has been evaluated. define ParAsg ([]: 'loc list) ([] : 'val list) (s : state) : state = s | ParAsg (loc::locs) (val :: vals) = ParAsg locs vals (fn l => (l == loc) ? val | s l)) | ParAsg _ _ = raise "ParAsg: location and value list differ in length"; The new type of ParAsg becomes: ParAsg : 'loc list -> 'val list -> state -> state If we redefine the type asg we get ParAsg : 'loc list -> 'val list -> asg 2. Introduce a list evaluation operator: define EvalList ([] : (state -> 'val) list) (s : state) : 'val list = [] | EvalList (genExp :: genExps) s = (genExp s) :: EvalList genExps s; 3. Compile a source parallel assignment into two lists: locs of the variables being assigned, and exps of component transformed expressions using decoded types. This process is part of the exisiting compiler. 4. Prepend each expression in exps with the proper encode function This produces a list genExps where every element is a generic typed expression. 5. The final representaion can now be expressed as: ... val locs_123 : 'loc list = [ ``Generated by compiler'' ] val genExps_123 : 'val list = [ ``Generated by compiler'' ] val parAsg_123 : asg = (ParAsg locs_123) o (EvalList genExps_123) ... a) A consequence of this is that VAR parameters should be represented by their 'loc location. b) A variable component can not be used as argument for a VAR parameter, but still be used for a value parameter. c) The assignment and update funtion will be deprecated. d) The write part of a variable pair has to be replaced with it's 'loc location. e) The representation of an atomic action should be changed such that it is based on the variable locations and the assigned expressions. (How do we handle components???) *) (*---------------------------------------------------------------------------*) let NUM = `:num`;; let BOOL = `:bool`;; let VAR_TP = (fun s -> mk_vartype("'"^s));; let LST = (fun t -> mk_type("list",[t]));; let PRD = (fun (l,r) -> mk_type("prod",[l;r]));; let FUN = (fun (l,r) -> mk_type("fun",[l;r]));; let rec FNC = function (l,[]) -> l | (l,(r::rs)) -> FUN(l,FNC(r,rs));; let LOC = VAR_TP"loc";; let VAL = VAR_TP"val";; let STA = FUN(LOC,VAL);; let ACT = FUN(STA,STA);; let INT = LST(ACT);; let XPR = (fun t -> FUN(STA,t));; let ASG = (fun t -> FNC(XPR t,[STA; STA; STA]));; let VAR = (fun t -> PRD(XPR t, ASG t));; let PAR = FNC(STA,[STA; STA]);; let SEQ = FUN(LOC, FUN(FUN(NUM,VAL), FUN(FUN(VAL,NUM), FUN(NUM, PRD(INT,NUM)))));; (*---------------------------------------------------------------------------*) (* Defining Variable extraction functions *) (*---------------------------------------------------------------------------*) let t = mk_vartype"'t";; let v = mk_var("v", VAR t);; new_type_abbrev("stype", `:'loc->'val`);; new_type_abbrev("vtype", `:(stype->'t)#((stype->'t)->stype->stype->stype)`);; new_type_abbrev("vindex_type", `:(stype->'i->'t)#((stype->'i->'t)->stype->stype->stype)`);; new_type_abbrev("vpair_type", `:(stype->'a#'b)#((stype->'a#'b)->stype->stype->stype)`);; new_type_abbrev("seq_type", `:'loc->(num->'val)->('val->num)->num->(stype->stype)list#num`);; (* * Extraction expression of a variable *) let VAR_EXP = new_definition (`VAR_EXP (v:vtype) = FST v`);; (* * Extraction assignment of a variable *) let VAR_ASG = new_definition (`VAR_ASG (v:vtype) = SND v`);; (*---------------------------------------------------------------------------*) (* Location to variable translator functions *) (*---------------------------------------------------------------------------*) let loc = mk_var("loc",LOC);; let s = mk_var("s", STA);; let s0 = mk_var("s0", STA);; let ds = mk_var("ds", FUN(VAL,t));; let mk = mk_var("mk", FUN(t,VAL));; let e = mk_var("e", XPR t);; (* * Translate a location to an expression *) let LOC_EXP = new_definition (`LOC_EXP loc (ds:'val->'t) (s:stype) = ds (s loc)`);; (* * Translate a location to an assignment *) let LOC_ASG = new_definition (`LOC_ASG loc (mk:'t->'val) (e:stype->'t) (s0:stype) (s:stype) l = (if (l = loc) then (mk (e s0)) else (s l))`);; (* * Translate a location to a variable pair *) let LOC_VAR = new_definition (`LOC_VAR (loc:'loc) (mk:'t->'val) (ds:'val->'t) = (LOC_EXP loc ds, LOC_ASG loc mk)`);; (*---------------------------------------------------------------------------*) (* Array (index) functions *) (*---------------------------------------------------------------------------*) (* * Generate index expression * * IndexExp [(i,v),...] a *) let INDEX_EXP = new_definition (`(INDEX_EXP (a:stype->('i->'t)) (i:stype->'i) (s:stype) = (a s) (i s))`);; (* * Generate updated index expression (index, exp and array are frozen) * * UpdIndex [(i,v),...] a *) let UPD_INDEX = new_definition (`(UPD_INDEX (i:'i) (c:'t) (a:'i->'t) j = (if (j = i) then c else (a j)))`);; (* * Generate updated index expression (index and exp are frozen) * * UPD_INDEX_XPR [(i,v),...] a *) let UPD_INDEX_EXP = new_definition (`(UPD_INDEX_EXP (i:'i) (c:'t) (a:stype->'i->'t) (s:stype) = UPD_INDEX i c (a s))`);; (* * Assignment part from Index of a variable *) let VAR_INDEX_ASG = new_definition (`VAR_INDEX_ASG (i:stype->'i) (v:vindex_type) (e:stype->'t) (s0:stype) (s:stype) = VAR_ASG v (UPD_INDEX_EXP (i s0) (e s0) (VAR_EXP v)) s0 s`);; (* * Expression part from Index of a variable *) let VAR_INDEX_EXP = new_definition (`VAR_INDEX_EXP (i:stype->'i) (v:vindex_type) (s:stype) = (VAR_EXP v s) (i s)`);; (* * Index variable *) let VAR_INDEXVAR = new_definition (`VAR_INDEXVAR (i:stype->'i) (v:vindex_type) = (VAR_INDEX_EXP i v, VAR_INDEX_ASG i v)`);; (*---------------------------------------------------------------------------*) (* List functions (not complete) *) (*---------------------------------------------------------------------------*) (* * List of expressions *) let LIST_EXP_term = (`(LIST_EXP [] (s:stype) = []) /\ (LIST_EXP (CONS (e:stype->'t) t) s = (CONS (e s) (LIST_EXP t s)))`);; let LIST_EXP = new_recursive_definition list_RECURSION LIST_EXP_term;; (*---------------------------------------------------------------------------*) (* Record (pair,fst,snd) functions *) (*---------------------------------------------------------------------------*) (* * State abstracted FST and SND *) let s_FST = new_definition (`s_FST (e:'sta->('a # 'b)) s = FST (e s)`);; let s_SND = new_definition (`s_SND (e:'sta->('a # 'b)) s = SND (e s)`);; (* * Update PAIR *) let UPD_FST = new_definition (`UPD_FST (c:'a) (p:'sta->('a#'b)) s = (c, SND(p s))`);; let UPD_SND = new_definition (`UPD_SND (c:'b) (p:'sta->('a#'b)) s = (FST(p s),c)`);; (* * Assignment to FST and SND *) let VAR_FST_ASG = new_definition (`VAR_FST_ASG (v:vpair_type) (e:stype->'a) (s0:stype) (s:stype) = VAR_ASG v (UPD_FST (e s0) (VAR_EXP v)) s0 s`);; let VAR_SND_ASG = new_definition (`VAR_SND_ASG (v:vpair_type) (e:stype->'b) (s0:stype) (s:stype) = VAR_ASG v (UPD_SND (e s0) (VAR_EXP v)) s0 s`);; (* * Variables of FST and SND *) let FST_VAR = new_definition (`FST_VAR (v:vpair_type) = (s_FST (VAR_EXP v), VAR_FST_ASG v)`);; let SND_VAR = new_definition (`SND_VAR (v:vpair_type) = (s_SND (VAR_EXP v), VAR_SND_ASG v)`);; (*---------------------------------------------------------------------------*) (* Parallel actions *) (*---------------------------------------------------------------------------*) (* * Execute two parallel actions simultaneously *) let PAR_PAR = new_definition (`(PAR_PAR (p1:stype->stype->stype) (p2:stype->stype->stype) (s0:stype) (s:stype) = p2 s0 (p1 s0 s))`);; (* * Execute a list of parallel actions *) let LIST_PAR_term = (`(LIST_PAR [] (s0:stype) (s:stype) = s) /\ (LIST_PAR (CONS (h:stype->stype->stype) t) s0 s = LIST_PAR t s0 (h s0 s))`);; let LIST_PAR = new_recursive_definition list_RECURSION LIST_PAR_term;; (* * Translate a parallel action into an atomic action *) let PAR_ATOM = new_definition (`PAR_ATOM (p:stype->stype->stype) (s:stype) = p s s`);; (* * Guard a parallel action *) let WHEN_PAR = new_definition (`WHEN_PAR (p:stype->stype->stype) g (s0:stype) (s:stype) = (if (g s0) then (p s0 s) else s)`);; (* * Conditional parallel action *) let IF_PAR = new_definition (`IF_PAR (p1:stype->stype->stype) (p2:stype->stype->stype) g (s0:stype) (s:stype) = (if (g s0) then (p1 s0 s) else (p2 s0 s))`);; (* * Identity parallel action *) let ID_PAR = new_definition (`ID_PAR (s0:stype) (s:stype) = s`);; (* * Iterated parallel assignment *) let ITER_PAR0_term = (`(ITER_PAR0 (low:num) 0 (f:num->bool) (fi:num->stype->stype->stype) = ID_PAR) /\ (ITER_PAR0 low (SUC n) f fi = (if (f low) then PAR_PAR (fi low) (ITER_PAR0 (SUC low) n f fi) else (ITER_PAR0 (SUC low) n f fi)))`);; let ITER_PAR0 = new_recursive_definition num_RECURSION ITER_PAR0_term;; let ITER_PAR = new_definition (`ITER_PAR low high (f:num->bool) (fi:num->stype->stype->stype) = (ITER_PAR0 low ((1+high)-low) f fi)`);; (*---------------------------------------------------------------------------*) (* Atomic actions *) (*---------------------------------------------------------------------------*) (* * Translate a parallel action into an atomic action *) (* K and S are removed from HOL Light. I and o are defined in trivia.ml So I introduce K myself *) let K_DEF = new_definition (`K x y = x`);; let ASG_ACT = new_definition (`ASG_ACT (par:stype->stype->stype) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = PAR_ATOM (WHEN_PAR (LIST_PAR [par; LOC_ASG pc mk (K (SUC l0))]) (LOC_EXP pc ds =* (K l0)))`);; (* * Test atomic action *) let TST_ACT = new_definition (`TST_ACT (g:stype->bool) (l:num) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = (PAR_ATOM (WHEN_PAR (LOC_ASG pc mk ((g =>* K(SUC l0)) (K l))) (LOC_EXP pc ds =* K l0)))`);; (* * Goto atomic action *) let GTO_ACT = new_definition (`GTO_ACT (l:num) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = PAR_ATOM (WHEN_PAR (LOC_ASG pc mk (K l)) (LOC_EXP pc ds =* K l0))`);; (*---------------------------------------------------------------------------*) (* Sequential actions *) (*---------------------------------------------------------------------------*) (* * Translate parallel to sequential action *) let PAR_SEQ = new_definition (`PAR_SEQ (par:stype->stype->stype) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = ([ASG_ACT par pc mk ds l0], SUC l0)`);; (* * Identity sequential action *) let ID_SEQ = new_definition (`ID_SEQ (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = ([], l0)`);; (* * Execute two sequential actions in a row *) let SEQ_SEQ = new_definition (`SEQ_SEQ (s1:seq_type) (s2:seq_type) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = let b1 = s1 pc mk ds l0 in let b2 = s2 pc mk ds (SND b1) in (APPEND (FST b1) (FST b2), (SND b2))`);; (* * Iterated sequential actions *) let ITER_SEQ0_term = (`(ITER_SEQ0 (low:num) 0 (f:num->bool) (fi:num->seq_type) = ID_SEQ) /\ (ITER_SEQ0 low (SUC n) f fi = (if (f low) then (SEQ_SEQ (fi low) (ITER_SEQ0 (SUC low) n f fi)) else (ITER_SEQ0 (SUC low) n f fi)))`);; let ITER_SEQ0 = new_recursive_definition num_RECURSION ITER_SEQ0_term;; let ITER_SEQ = new_definition (`ITER_SEQ low high (f:num->bool) (fi:num->seq_type) = ITER_SEQ0 low ((1+high)-low) f fi`);; (* * List of sequential actions *) let LIST_SEQ_term = (`(LIST_SEQ [] (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = ([], l0)) /\ (LIST_SEQ (CONS (sa:seq_type) sas) pc mk ds l0 = let b1 = sa pc mk ds l0 in let bs = LIST_SEQ sas pc mk ds (SND b1) in (APPEND (FST b1) (FST bs), (SND bs)))`);; let LIST_SEQ = new_recursive_definition list_RECURSION LIST_SEQ_term;; (* * Conditional sequential actions *) let IF1_SEQ = new_definition (`(IF1_SEQ (g:stype->bool) (sa:seq_type) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = let b1 = sa pc mk ds (SUC l0) in let a1 = TST_ACT g (SND b1) pc mk ds l0 in (CONS a1 (FST b1), (SND b1)))`);; (* * Conditional (else) sequential actions *) let IF2_SEQ = new_definition (`(IF2_SEQ (g:stype->bool) (sa1:seq_type) (sa2:seq_type) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = let b1 = sa1 pc mk ds (SUC l0) in let b2 = sa2 pc mk ds (SUC (SND b1)) in let a1 = TST_ACT g (SUC (SND b1)) pc mk ds l0 in let a2 = GTO_ACT (SND b2) pc mk ds (SND b1) in (APPEND (CONS a1 (FST b1)) (CONS a2 (FST b2)), (SND b2)))`);; (* * While loop sequential actions *) let WHL_SEQ = new_definition (`(WHL_SEQ (g:stype->bool) (sa:seq_type) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = let b1 = sa pc mk ds (SUC l0) in let a1 = TST_ACT g (SUC (SND b1)) pc mk ds l0 in let a2 = GTO_ACT l0 pc mk ds (SND b1) in (APPEND (CONS a1 (FST b1)) [a2], (SUC(SND b1))))`);; (*---------------------------------------------------------------------------*) (* Interleaved actions *) (*---------------------------------------------------------------------------*) (* * Translate a parallel action into an interleaved action *) let PAR_INT = new_definition (`PAR_INT (par:stype->stype->stype) = [PAR_ATOM par]`);; (* * Composition of two interleaved actions *) let INT_INT = new_definition (`INT_INT (i1:(stype->stype)list) i2 = APPEND i1 i2`);; (* * Translate a list of interleaved action into a single interleaved action *) let LIST_INT_term = (`(LIST_INT [] = ([]:(stype->stype)list)) /\ (LIST_INT (CONS (h:(stype->stype)list) t) = (APPEND h (LIST_INT t)))`);; let LIST_INT = new_recursive_definition list_RECURSION LIST_INT_term;; (* * Translate a parallel action into an interleaved action *) let ID_INT = new_definition (`ID_INT = ([]:(stype->stype)list)`);; (*######################################################################## # # # Iterated interleaving # # # # << i : 1 <= i <= N :: Pr[i] >> # # # # is defined as: # # # # IteratedINTerleaving low n Pr[.] --> # # Pr[low] [] ... [] Pr[low+n-1] # # # ########################################################################*) (* * Iterated interleaved assignment *) let ITER_INT0_term = (`(ITER_INT0 (low:num) 0 (f:num->bool) (fi:num->(stype->stype)list) = ID_INT) /\ (ITER_INT0 low (SUC n) f fi = (if (f low) then (INT_INT (fi low) (ITER_INT0 (SUC low) n f fi)) else (ITER_INT0 (SUC low) n f fi)))`);; let ITER_INT0 = new_recursive_definition num_RECURSION ITER_INT0_term;; let ITER_INT = new_definition (`ITER_INT low high (f:num->bool) (fi:num->(stype->stype)list) = ITER_INT0 low ((1+high)-low) f fi`);; (*####################################################################### # # # Absolute and relative Label predicates # # # # AT,AFTER : At first, first following action # # IN : Inside action # # BEFORE,FOLLOW : Strictly before,following action # # # ########################################################################*) let AT_LBL = new_definition (`AT_LBL ds pc (label:num#num) = (LOC_EXP pc ds:stype->num) =* K (FST label)`);; let AFTER_LBL = new_definition (`AFTER_LBL ds pc (label:num#num) = (LOC_EXP pc ds:stype->num) =* K (SND label)`);; let BEFORE_LBL = new_definition (`BEFORE_LBL ds pc (label:num#num) = (LOC_EXP pc ds:stype->num) <* K (FST label)`);; let INSIDE_LBL = new_definition (`INSIDE_LBL ds pc (label:num#num) = ((LOC_EXP pc ds:stype->num) >=* K (FST label)) /\* ((LOC_EXP pc ds:stype->num) <* K (SND label))`);; let FOLLOW_LBL = new_definition (`FOLLOW_LBL ds pc (label:num#num) = (LOC_EXP pc ds:stype->num) >=* K (SND label)`);; (* Absolute label handler *) let AT_ABS = new_definition (`AT_ABS (pc:stype->num) (l:num) (u:num) = (pc =* K l)`);; let AT_REL = new_definition (`AT_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) (label:(num#num)) = VAR_EXP pc =* K (FST label)`);; let AFTER_ABS = new_definition (`AFTER_ABS (pc:stype->num) (l:num) (u:num) = (pc =* K u)`);; let AFTER_REL = new_definition (`AFTER_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) (label:(num#num)) = VAR_EXP pc =* K (SND label)`);; let BEFORE_ABS = new_definition (`BeforeAbs (pc:stype->num) (l:num) (u:num) = (pc <* K l)`);; let BEFORE_REL = new_definition (`BEFORE_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) (label:(num#num)) = VAR_EXP pc <* K (FST label)`);; let INSIDE_ABS = new_definition (`INSIDE_ABS (pc:stype->num) (l:num) (u:num) = (pc >=* K l) /\* (pc <* K u)`);; let INSIDE_REL = new_definition (`INSIDE_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) (label:(num#num)) = (VAR_EXP pc >=* K (FST label)) /\* (VAR_EXP pc <* K (SND label))`);; let FOLLOW_ABS = new_definition (`FollowAbs (pc:stype->num) (l:num) (u:num) = (pc >=* K l)`);; let FOLLOW_REL = new_definition (`FOLLOW_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) (label:(num#num)) = VAR_EXP pc >=* K (SND label)`);; (*######################################################################## # # # Restricted UNLESS # # # # (p UNLESS{valid} q) Pr # # # # is defined as: # # # # RESTRICTED_UNLESS valid p q Pr = # # {p /\ valid /\ ~q)} Pr {p \/ q} # # # ########################################################################*) let RESTRICTED_UNLESS_STMT = new_definition (`RESTRICTED_UNLESS_STMT v p q st = (!s:'state. p s /\ v s /\ ~(q s) ==> p (st s) \/ q (st s))`);; let RESTRICTED_UNLESS_term = (`(RESTRICTED_UNLESS (v:'state->bool) p q [] = T) /\ (RESTRICTED_UNLESS (v:'state->bool) p q (CONS st Pr) = (RESTRICTED_UNLESS_STMT v p q st /\ RESTRICTED_UNLESS v p q Pr))`);; let RESTRICTED_UNLESS = new_recursive_definition list_RECURSION RESTRICTED_UNLESS_term;; (*####################################################################### # # # RESTRICTED STABLE # # # # (p STABLE{valid} q) Pr # # # # is defined as: # # # # RESTRICTED_STABLE valid p q Pr = # # {p /\ valid} Pr {p} # # # ########################################################################*) let RESTRICTED_STABLE_STMT = new_definition (`RESTRICTED_STABLE_STMT v p st = (!s:'state. p s /\ v s ==> p (st s))`);; let RESTRICTED_STABLE_term = (`(RESTRICTED_STABLE (v:'state->bool) p [] = T) /\ (RESTRICTED_STABLE (v:'state->bool) p (CONS st Pr) = (RESTRICTED_STABLE_STMT v p st /\ RESTRICTED_STABLE v p Pr))`);; let RESTRICTED_STABLE = new_recursive_definition list_RECURSION RESTRICTED_STABLE_term;; (*######################################################################## # # # RESTRICTED EXISTS_TRANSITION # # # # (p EXISTS_TRANSITION{valid} q) Pr # # # # is defined as: # # # # RESTRICTED_EXISTS_TRANSITION valid p q Pr = # # ?st In Pr. {p /\ valid /\ ~q} Pr {q} # # # ########################################################################*) let RESTRICTED_EXISTS_TRANSITION_STMT = new_definition (`RESTRICTED_EXISTS_TRANSITION_STMT v p q st = (!s:'state. p s /\ v s /\ ~(q s) ==> q (st s))`);; let RESTRICTED_EXISTS_TRANSITION_term = (`(RESTRICTED_EXISTS_TRANSITION (v:'state->bool) p q [] = F) /\ (RESTRICTED_EXISTS_TRANSITION (v:'state->bool) p q (CONS st Pr) = (RESTRICTED_EXISTS_TRANSITION_STMT v p q st \/ RESTRICTED_EXISTS_TRANSITION v p q Pr))`);; let RESTRICTED_EXISTS_TRANSITION = new_recursive_definition list_RECURSION RESTRICTED_EXISTS_TRANSITION_term;; (*######################################################################## # # # RESTRICTED ENSURES # # # # (p ENSURES{valid} q) Pr # # # # is defined as: # # # # RESTRICTED_ENSURES valid p q Pr = # # RESTRICTED_UNLESS valid p q Pr /\ # # RESTRICTED_EXISTS_TRANSITION valid p q Pr # # # ########################################################################*) let RESTRICTED_ENSURES = new_definition (`RESTRICTED_ENSURES (v:'state->bool) p q Pr = (RESTRICTED_UNLESS v p q Pr /\ RESTRICTED_EXISTS_TRANSITION v p q Pr)`);; (*######################################################################## # # # RESTRICTED LEADSTO # # # # (p LEADSTO{valid} q) Pr # # # # is defined as: # # # # RESTRICTED_LEADSTO valid p q Pr = # # (p /\ valid p) LEADSTO q Pr /\ # # # ########################################################################*) let RESTRICTED_LEADSTO = new_definition (`RESTRICTED_LEADSTO (v:'state->bool) p q Pr = (((p /\* v) LEADSTO q) Pr)`);; (*######################################################################## # # # Valid # # # # Valid p # # # # is defined as: # # # # Valid p = # # !s. p s # # # ########################################################################*) let VALID = new_definition (`VALID (p:'state->bool) = !s. p s`);; let TRIPLE_term = (`(TRIPLE (p:'state->bool) q [] = T) /\ (TRIPLE p q (CONS (st:'state->'state) Pr) = ((!s. p s ==> q(st s)) /\ TRIPLE p q Pr))`);; let RESTRICTED_TRIPLE = new_recursive_definition list_RECURSION TRIPLE_term;; (*######################################################################## # # # SUMMA lwb len filter body = # # Body(lwb) + ... Body(i) ... + Body(lwb+len-1) , when filter(i)# # # # SUMMA lwb 0 f b = 0 # # SUMMA lwb (SUC n) f b = (f lwb => b lwb | 0) + SUMMA lwb n f b # # # ########################################################################*) let SUMMA0_term = (`(SUMMA0 lwb 0 f b = 0) /\ (SUMMA0 lwb (SUC n) f b = ((if (f lwb) then (b lwb) else 0) + (SUMMA0 (SUC lwb) n f b)))`);; let SUMMA0 = new_recursive_definition num_RECURSION SUMMA0_term;; let SUMMA = new_definition (`SUMMA lwb upb f b = SUMMA0 lwb ((1 + upb)-lwb) f b`);; let SUMMA_S = new_definition (`SUMMA_S lwb upb f b (s:'state) = SUMMA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; (*######################################################################## # # # MULTA lwb len filter body = # # Body(lwb) * ... Body(i) ... * Body(lwb+len-1) , when filter(i)# # # # MULTA lwb 0 f b = 1 # # MULTA lwb (SUC n) f b = (f lwb => b lwb | 1) * MULTA lwb n f b # # # ########################################################################*) let MULTA0_term = (`(MULTA0 lwb 0 f b = 1) /\ (MULTA0 lwb (SUC n) f b = ((if (f lwb) then (b lwb) else 1) * (MULTA0 (SUC lwb) n f b)))`);; let MULTA0 = new_recursive_definition num_RECURSION MULTA0_term;; let MULTA = new_definition (`MULTA lwb upb f b = MULTA0 lwb ((1 + upb)-lwb) f b`);; let MULTA_S = new_definition (`MULTA_S lwb upb f b (s:'state) = MULTA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; (*######################################################################## # # # CONJA lwb len filter body = # # Body(lwb) & ... Body(i) ... & Body(lwb+len-1) , when filter(i)# # # # CONJA lwb 0 f b = T # # CONJA lwb (SUC n) f b = (f lwb => b lwb | 1) & CONJA lwb n f b # # # ########################################################################*) let CONJA0_term = (`(CONJA0 lwb 0 f b = T) /\ (CONJA0 lwb (SUC n) f b = ((if (f lwb) then (b lwb) else T) /\ (CONJA0 (SUC lwb) n f b)))`);; let CONJA0 = new_recursive_definition num_RECURSION CONJA0_term;; let CONJA = new_definition (`CONJA lwb upb f b = CONJA0 lwb ((1 + upb)-lwb) f b`);; let CONJA_S = new_definition (`CONJA_S lwb upb f b (s:'state) = CONJA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; (*######################################################################## # # # DISJA lwb len filter body = # # Body(lwb) | ... Body(i) ... | Body(lwb+len-1) , when filter(i)# # # # DISJA lwb 0 f b = F # # DISJA lwb (SUC n) f b = (f lwb => b lwb | 1) | DISJA lwb n f b # # # ########################################################################*) let DISJA0_term = (`(DISJA0 lwb 0 f b = F) /\ (DISJA0 lwb (SUC n) f b = ((if (f lwb) then (b lwb) else F) \/ (DISJA0 (SUC lwb) n f b)))`);; let DISJA0 = new_recursive_definition num_RECURSION DISJA0_term;; let DISJA = new_definition (`DISJA lwb upb f b = DISJA0 lwb ((1 + upb)-lwb) f b`);; let DISJA_S = new_definition (`DISJA_S lwb upb f b (s:'state) = DISJA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; (*---------------------------------------------------------------------------*) (* Miscellaneous *) (*---------------------------------------------------------------------------*) (* * Test for list membership *) let MEMBER_term = (`(MEMBER (x:'a) [] = F) /\ (MEMBER x (CONS h t) = ((x=h) \/ (MEMBER x t)))`);; let MEMBER = new_recursive_definition list_RECURSION MEMBER_term;; (* * Test for unique elements in list *) let UNIQUE_term = (`(UNIQUE [] = T) /\ (UNIQUE (CONS (h:'a) t) = ((~(MEMBER h t)) /\ UNIQUE t))`);; let UNIQUE = new_recursive_definition list_RECURSION UNIQUE_term;; hol-light/Unity/mk_unless.ml000066400000000000000000001111511303454263000164070ustar00rootroot00000000000000(*-------------------------------------------------------------------------*) (* File: mk_unless.ml Description: This file defines the theorems for the UNLESS definition. Author: (c) Copyright 1989-2008 by Flemming Andersen Date: June 29, 1989 Last Update: December 30, 2007 *) (*-------------------------------------------------------------------------*) (*-------------------------------------------------------------------------*) (* The definition of UNLESS is based on the definition: p UNLESS q in Pr = where p and q are state dependent first order logic predicates or all s in the program Pr are conditionally enabled statements transforming a state into a new state. To define UNLESS as a relation UNLESS_STMT to be satisfied for a finite number of program statements, we define the UNLESS_STMT to be fulfilled as a separate HOARE tripple relation between pre- or post predicates to be satisfied for state transitions. The pre- or post predicates of the UNLESS_STMT relation must be satisfiable for all states possible in the finite state space of the program. *) let TL_FIX = 100;; let UNLESS_STMT = new_infix_definition ("UNLESS_STMT", "<=>", `UNLESS_STMT (p:'a->bool) q st = \s:'a. (p s /\ ~q s) ==> (p (st s) \/ q (st s))`, TL_FIX);; (* Since a program is defined as a set (list) of statements, we recursively define the UNLESS relation itself using the UNLESS_STMT relation to be satisfied for every statement in the program. As the bottom of the recursion we choose the empty program always to be satisfied. For every statement in the program the UNLESS_STMT relation must be satisfied in all possible states. *) let UNLESS_term = (`(!p q. UNLESS p q [] <=> T) /\ (!p q. UNLESS p q (CONS (st:'a->'a) Pr) <=> ((!s:'a. (p UNLESS_STMT q) st s) /\ (UNLESS p q Pr)))`);; let UNLESS = new_recursive_definition list_RECURSION UNLESS_term;; parse_as_infix ( "UNLESS", (TL_FIX, "right") );; let STABLE_STMT = new_infix_definition ("STABLE_STMT", "<=>", `STABLE_STMT (p:'a->bool) st = \s:'a. p s ==> p (st s)`, TL_FIX);; (* * The state predicate STABLE is a special case of UNLESS. * * stable p in Pr = p unless false in Pr *) let STABLE = new_infix_definition ("STABLE", "<=>", `STABLE (p:'a->bool) Pr = (p UNLESS False) Pr`, TL_FIX);; (* * The state predicate INVARIANT is a special case of UNLESS too. * However invariant is dependent of a program /\* its initial state. * * invariant P in (initial condition, Pr) = * (initial condition ==> p) /\ (p stable in Pr) *) let INVARIANT = new_infix_definition ("INVARIANT", "<=>", `INVARIANT p (p0, Pr) = ((!s:'a. p0 s ==> p s) /\ (p STABLE Pr))`, TL_FIX);; (************************************************************************ * * * Lemmas used in the UNLESS Theory * * * ************************************************************************) let s = `s:'a`;; let p = `p:'a->bool`;; let q = `q:'a->bool`;; let r = `r:'a->bool`;; let P = `P:num->'a->bool`;; let IMP_IMP_CONJIMP_lemma = TAC_PROOF (([], (`!p q ps qs p' q' p's q's. (p /\ ~q ==> ps \/ qs) ==> (p' /\ ~q' ==> p's \/ q's) ==> (p /\ p' /\ (~p \/ ~q') /\ (~p' \/ ~q) /\ (~q \/ ~q') ==> ps /\ p's \/ ps /\ q's \/ p's /\ qs \/ qs /\ q's)`)), REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let NOT_NOT_OR_lemma = TAC_PROOF (([], (`!t1 t2 t3. t1 \/ t2 \/ t3 <=> ~(~t1 /\ ~t2) \/ t3`)), REWRITE_TAC [NOT_CLAUSES; DE_MORGAN_THM; (SYM (SPEC_ALL DISJ_ASSOC))]);; let CONJ_IMPLY_THM = TAC_PROOF (([], (`!p p' q q'. ((p \/ p') /\ (p \/ ~q') /\ (p' \/ ~q) /\ (~q \/ ~q')) = ((p /\ ~q) \/ (p' /\ ~q'))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN REPEAT (ASM_REWRITE_TAC []));; (************************************************************************ * * * Theorems about UNLESS_STMT * * * ************************************************************************) (* * The reflexivity theorem: * * p unless_stmt P in Prog *) let UNLESS_STMT_thm0 = prove_thm ("UNLESS_STMT_thm0", `!p st (s:'a). (p UNLESS_STMT p)st s`, REPEAT STRIP_TAC THEN REWRITE_TAC [UNLESS_STMT] THEN REWRITE_TAC [BETA_CONV (`(\s:'a. p s /\ ~(p s) ==> p (st s))s`)] THEN REPEAT STRIP_TAC THEN RES_TAC);; (* * Theorem: * p unless_stmt Q in stmt, q ==> r * ------------------------------ * p unless_stmt r in stmt *) let UNLESS_STMT_thm1 = prove_thm ("UNLESS_STMT_thm1", `!(p:'a->bool) q r st. ((!s. (p UNLESS_STMT q) st s) /\ (!s. (q s) ==> (r s))) ==> (!s. (p UNLESS_STMT r) st s)`, REPEAT GEN_TAC THEN REWRITE_TAC [UNLESS_STMT] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (REWRITE_RULE [ASSUME `~r (s:'a)`] ( CONTRAPOS (SPEC `s:'a` (ASSUME `!s:'a. q s ==> r s`)))) THEN STRIP_ASSUME_TAC (REWRITE_RULE [ASSUME `(p:'a->bool) s`; ASSUME `~q (s:'a)`] (SPEC `s:'a` (ASSUME `!s:'a. p s /\ ~q s ==> p (st s) \/ q (st s)`))) THEN ASM_REWRITE_TAC [] THEN STRIP_ASSUME_TAC (REWRITE_RULE [ASSUME `(q:'a->bool) ((st:'a->'a) s)`] (SPEC `(st:'a->'a) s` (ASSUME `!s:'a. q s ==> r s`))) THEN ASM_REWRITE_TAC []);; (* Theorem: p unless_stmt Q in st, p' unless_stmt q' in st ------------------------------------------------ p\/p' unless_stmt q\/q' in st *) let UNLESS_STMT_thm2 = prove_thm ("UNLESS_STMT_thm2", `!p q p' q' (st:'a->'a). ((!s. (p UNLESS_STMT q) st s) /\ (!s. (p' UNLESS_STMT q') st s)) ==> (!s. ((p \/* p') UNLESS_STMT (q \/* q')) st s)`, REWRITE_TAC [UNLESS_STMT;OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); (SYM (SPEC_ALL DISJ_ASSOC)); NOT_CLAUSES; DE_MORGAN_THM] THEN (REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []));; (* Conjunction Theorem: p unless_stmt Q in stmt, p' unless_stmt q' in stmt ------------------------------------------------------------------ (p /\ p') unless_stmt (p /\ q') \/ (p' /\ q) \/ (q /\ q') in stmt *) let UNLESS_STMT_thm3 = prove_thm ("UNLESS_STMT_thm3", `!p q p' q' (st:'a->'a). ((!s. (p UNLESS_STMT q) st s) /\ (!s. (p' UNLESS_STMT q') st s)) ==> (!s. ((p /\* p') UNLESS_STMT (((p /\* q') \/* (p' /\* q)) \/* (q /\* q'))) st s)`, PURE_REWRITE_TAC [UNLESS_STMT;AND_def;OR_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); (SYM (SPEC_ALL DISJ_ASSOC)); NOT_CLAUSES; DE_MORGAN_THM] THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN DISCH_TAC THEN STRIP_TAC THEN DISCH_TAC THEN ASSUME_TAC (CONJUNCT1 (ASSUME (`(!s. p s /\ ~q s ==> p ((st:'a->'a) s) \/ q (st s)) /\ (!s. p' s /\ ~q' s ==> p'((st:'a->'a) s) \/ q'(st s))`))) THEN ASSUME_TAC (CONJUNCT2 (ASSUME (`(!s. p s /\ ~q s ==> p ((st:'a->'a) s) \/ q (st s)) /\ (!s. p' s /\ ~q' s ==> p'((st:'a->'a) s) \/ q'(st s))`))) THEN STRIP_ASSUME_TAC (SPEC_ALL (ASSUME (`(!s. p s /\ ~q s ==> p ((st:'a->'a) s) \/ q (st s))`))) THEN STRIP_ASSUME_TAC (SPEC_ALL (ASSUME (`(!s. p' s /\ ~q' s ==> p'((st:'a->'a) s) \/ q'(st s))`))) THEN ASSUME_TAC (UNDISCH_ALL (SPEC (`(q':'a->bool) ((st:'a->'a) s)`) (SPEC (`(p':'a->bool) ((st:'a->'a) s)`) (SPEC (`(q':'a->bool) s`) (SPEC (`(p':'a->bool) s`) (SPEC (`(q:'a->bool) ((st:'a->'a) s)`) (SPEC (`(p:'a->bool) ((st:'a->'a) s)`) (SPEC (`(q:'a->bool) s`) (SPEC (`(p:'a->bool) s`) IMP_IMP_CONJIMP_lemma))))))))) THEN ASM_REWRITE_TAC []);; (* Disjunction Theorem: p unless_stmt Q in stmt, p' unless_stmt q' in stmt ------------------------------------------------------------------ (p \/ p') unless_stmt (~p /\ q') \/ (~p' /\ q) \/ (q /\ q') in stmt *) let UNLESS_STMT_thm4 = prove_thm ("UNLESS_STMT_thm4", `!p q p' q' (st:'a->'a). ((!s. (p UNLESS_STMT q) st s) /\ (!s. (p' UNLESS_STMT q') st s)) ==> (!s. ((p \/* p') UNLESS_STMT ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))) st s)`, REPEAT GEN_TAC THEN PURE_REWRITE_TAC [UNLESS_STMT;AND_def;OR_def;NOT_def1] THEN MESON_TAC []);; let UNLESS_STMT_thm5_lemma1 = TAC_PROOF (([], `!p q r. (p ==> q) ==> (p \/ r ==> q \/ r)`), REPEAT STRIP_TAC THENL [RES_TAC THEN ASM_REWRITE_TAC [] ;ASM_REWRITE_TAC []]);; let UNLESS_STMT_thm5_lemma2 = TAC_PROOF (([], `!(P:num->('a->bool)) q s. ((?n. P n s) \/ q s) = (?n. P n s \/ q s)`), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ EXISTS_TAC (`n:num`) THEN ASM_REWRITE_TAC [] ; EXISTS_TAC (`n:num`) THEN ASM_REWRITE_TAC [] ; DISJ1_TAC THEN EXISTS_TAC (`n:num`) THEN ASM_REWRITE_TAC [] ; DISJ2_TAC THEN ASM_REWRITE_TAC [] ]);; let UNLESS_STMT_thm5 = prove_thm ("UNLESS_STMT_thm5", `!(P:num->('a->bool)) q st. (!m. (!s. ((P m) UNLESS_STMT q)st s)) ==> (!s. ((\s. ?n. P n s) UNLESS_STMT q)st s)`, REPEAT GEN_TAC THEN REWRITE_TAC [UNLESS_STMT] THEN BETA_TAC THEN REPEAT STRIP_TAC THEN REWRITE_TAC [UNLESS_STMT_thm5_lemma2] THEN EXISTS_TAC (`n:num`) THEN RES_TAC THEN ASM_REWRITE_TAC []);; let UNLESS_STMT_thm6 = prove_thm ("UNLESS_STMT_thm6", `!(p:'a->bool) q r (st:'a->'a). (!s. (p UNLESS_STMT q) st s) ==> (!s. ((p \/* r) UNLESS_STMT (q \/* r)) st s)`, REPEAT GEN_TAC THEN REWRITE_TAC [UNLESS_STMT; OR_def] THEN MESON_TAC []);; (* Theorems about UNLESS *) (* The reflexivity theorem: p unless p in Prog *) let UNLESS_thm1 = prove_thm ("UNLESS_thm1", `!(p:'a->bool) Pr. (p UNLESS p) Pr`, GEN_TAC THEN LIST_INDUCT_TAC THEN PURE_REWRITE_TAC [UNLESS] THEN ASM_REWRITE_TAC [] THEN PURE_REWRITE_TAC [UNLESS_STMT] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC);; (* * The anti reflexivity theorem: * * p unless ~p in Prog *) let UNLESS_thm2 = prove_thm ("UNLESS_thm2", (`!(p:'a->bool) Pr. (p UNLESS (Not p)) Pr`), GEN_TAC THEN LIST_INDUCT_TAC THEN PURE_REWRITE_TAC [UNLESS] THEN ASM_REWRITE_TAC [] THEN PURE_REWRITE_TAC [UNLESS_STMT;NOT_def1] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN REWRITE_TAC [EXCLUDED_MIDDLE]);; (* The unless implies theorem: p unless q in Pr, q ==> r --------------------------- p unless r in Pr *) let UNLESS_thm3 = prove_thm ("UNLESS_thm3", `!(p:'a->bool) q r Pr. (((p UNLESS q) Pr) /\ (!s. (q s) ==> (r s))) ==> ((p UNLESS r) Pr)`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN IMP_RES_TAC UNLESS_STMT_thm1);; (* Conjunction Theorem: p unless q in Pr, p' unless q' in Pr ----------------------------------------------------------- (p /\ p') unless (p /\ q') \/ (p' /\ q) \/ (q /\ q') in Pr *) let UNLESS_thm4 = prove_thm ("UNLESS_thm4", `!(p:'a->bool) q p' q' Pr. (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) ==> (((p /\* p') UNLESS (((p /\* q') \/* (p' /\* q)) \/* (q /\* q'))) Pr)`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN IMP_RES_TAC UNLESS_STMT_thm3);; (* Disjunction Theorem: p unless q in Pr, p' unless q' in Pr ------------------------------------------------------------- (p \/ p') unless (~p /\ q') \/ (~p' /\ q) \/ (q /\ q') in Pr *) let UNLESS_thm5 = prove_thm ("UNLESS_thm5", `!(p:'a->bool) q p' q' Pr. (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) ==> (((p \/* p') UNLESS ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))) Pr)`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN IMP_RES_TAC UNLESS_STMT_thm4);; (* Simple Conjunction Theorem: p unless q in Pr, p' unless q' in Pr ------------------------------------------- (p /\ p') unless (q \/ q') in Pr *) let UNLESS_thm6 = prove_thm ("UNLESS_thm6", `!(p:'a->bool) q p' q' Pr. (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) ==> (((p /\* p') UNLESS (q \/* q')) Pr)`, REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS q)Pr`); (`((p':'a->bool) UNLESS q')Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL UNLESS_thm4)) THEN ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`p':'a->bool`); (`q':'a->bool`)] IMPLY_WEAK_lemma1) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(((p:'a->bool) /\* p') UNLESS (((p /\* q') \/* (p' /\* q)) \/* (q /\* q')))Pr`); (`!s. ((((p:'a->bool) /\* q') \/* (p' /\* q)) \/* (q /\* q'))s ==> (q \/* q')s`)] AND_INTRO_THM)) THEN ASM_REWRITE_TAC [UNDISCH_ALL (SPECL [(`(p:'a->bool) /\* p'`); (`((((p:'a->bool) /\* q') \/* (p' /\* q)) \/* (q /\* q'))`); (`(q:'a->bool) \/* q'`); (`Pr:('a->'a)list`)] UNLESS_thm3)]);; (* Simple Disjunction Theorem: p unless Q in Pr, p' unless q' in Pr --------------------------------------- (p \/ p') unless (q \/ q') in Pr *) let UNLESS_thm7 = prove_thm ("UNLESS_thm7", `!(p:'a->bool) q p' q' Pr. (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) ==> (((p \/* p') UNLESS (q \/* q')) Pr)`, REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS q)Pr`); (`((p':'a->bool) UNLESS q')Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL UNLESS_thm5)) THEN ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`p':'a->bool`); (`q':'a->bool`)] IMPLY_WEAK_lemma2) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(((p:'a->bool) \/* p') UNLESS ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))) Pr`); (`!s. ((((Not (p:'a->bool)) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))s ==> (q \/* q')s`)] AND_INTRO_THM)) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL [`(p:'a->bool) \/* p'`; `(((Not (p:'a->bool)) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q')`; `(q:'a->bool) \/* q'`; `Pr:('a->'a)list`] UNLESS_thm3)));; (* Cancellation Theorem: p unless Q in Pr, q unless r in Pr ------------------------------------ (p \/ q) unless r in Pr *) let UNLESS_thm8 = prove_thm ("UNLESS_thm8", `!(p:'a->bool) q r Pr. (((p UNLESS q) Pr) /\ ((q UNLESS r) Pr)) ==> (((p \/* q) UNLESS r) Pr)`, REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [`((p:'a->bool) UNLESS q)Pr`; `((q:'a->bool) UNLESS r)Pr`] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`q:'a->bool`); (`r:'a->bool`)] UNLESS_thm5))) THEN ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`r:'a->bool`)] IMPLY_WEAK_lemma3) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(((p:'a->bool) \/* q) UNLESS ((((Not p) /\* r) \/* ((Not q) /\* q)) \/* (q /\* r))) Pr`); (`!s:'a. ((((Not p) /\* r) \/* ((Not q) /\* q)) \/* (q /\* r))s ==> r s`)] AND_INTRO_THM)) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`((p:'a->bool) \/* q)`); (`((((Not (p:'a->bool)) /\* r) \/* ((Not q) /\* q)) \/* (q /\* r))`); (`r:'a->bool`)] UNLESS_thm3))));; (* Corollaries *) let UNLESS_cor1 = prove_thm ("UNLESS_cor1", `!(p:'a->bool) q Pr. (!s. p s ==> q s) ==> ((p UNLESS q) Pr)`, REPEAT STRIP_TAC THEN ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [`((p:'a->bool) UNLESS p)Pr`; `!s:'a. p s ==> q s`] AND_INTRO_THM)) THEN ASM_REWRITE_TAC [UNDISCH_ALL (SPECL [(`p:'a->bool`); (`p:'a->bool`); (`q:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm3)]);; let UNLESS_cor2 = prove_thm ("UNLESS_cor2", (`!(p:'a->bool) q Pr. (!s. (Not p)s ==> q s) ==> ((p UNLESS q) Pr)`), REPEAT STRIP_TAC THEN ASSUME_TAC (SPEC_ALL UNLESS_thm2) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS (Not p))Pr`); (`!s:'a. (Not p) s ==> q s`)] AND_INTRO_THM)) THEN ASM_REWRITE_TAC [UNDISCH_ALL (SPECL [(`p:'a->bool`); (`Not (p:'a->bool)`); (`q:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm3)]);; let UNLESS_cor3a = TAC_PROOF (([], (`!(p:'a->bool) q r Pr. (p UNLESS (q \/* r)) Pr ==> ((p /\* (Not q)) UNLESS (q \/* r)) Pr`)), REPEAT GEN_TAC THEN ASSUME_TAC (SPECL [(`Not (q:'a->bool)`); (`Pr:('a->'a)list`)] UNLESS_thm2) THEN UNDISCH_TAC (`((Not (q:'a->bool)) UNLESS (Not(Not q)))Pr`) THEN REWRITE_TAC [NOT_NOT_lemma] THEN REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS (q \/* r))Pr`); (`((Not (q:'a->bool)) UNLESS q)Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`); (`((q:'a->bool) \/* r)`); (`(Not (q:'a->bool))`); (`q:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm6)) THEN UNDISCH_TAC (`(((p:'a->bool) /\* (Not q)) UNLESS ((q \/* r) \/* q))Pr`) THEN PURE_ONCE_REWRITE_TAC [SPECL [(`(q:'a->bool) \/* r`); (`q:'a->bool`)] OR_COMM_lemma] THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL OR_ASSOC_lemma))] THEN REWRITE_TAC [OR_OR_lemma]);; let UNLESS_cor3b = TAC_PROOF (([], (`!(p:'a->bool) q r Pr. ((p /\* (Not q)) UNLESS (q \/* r)) Pr ==> (p UNLESS (q \/* r)) Pr`)), REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL [(`(p:'a->bool) /\* q`); (`Pr:('a->'a)list`)] UNLESS_thm1) THEN ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`)] AND_IMPLY_WEAK_lemma) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(((p:'a->bool) /\* q) UNLESS (p /\* q))Pr`); (`!s:'a. (p /\* q)s ==> q s`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(p:'a->bool) /\* q`); (`(p:'a->bool) /\* q`); (`q:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm3)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(((p:'a->bool) /\* (Not q)) UNLESS (q \/* r))Pr`); (`(((p:'a->bool) /\* q) UNLESS q)Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) /\* (Not q))`); (`((q:'a->bool) \/* r)`); (`((p:'a->bool) /\* q)`); (`q:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm7)) THEN UNDISCH_TAC (`((((p:'a->bool) /\* (Not q)) \/* (p /\* q)) UNLESS ((q \/* r) \/* q))Pr`) THEN REWRITE_TAC [AND_COMPL_OR_lemma] THEN ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL (OR_ASSOC_lemma)))] THEN REWRITE_TAC [OR_OR_lemma] THEN STRIP_TAC THEN ONCE_REWRITE_TAC [OR_COMM_lemma] THEN ASM_REWRITE_TAC []);; let UNLESS_cor3 = prove_thm ("UNLESS_cor3", (`!(p:'a->bool) q r Pr. ((p /\* (Not q)) UNLESS (q \/* r)) Pr = (p UNLESS (q \/* r)) Pr`), REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL UNLESS_cor3b) (SPEC_ALL UNLESS_cor3a)]);; let UNLESS_cor4 = prove_thm ("UNLESS_cor4", (`!(p:'a->bool) q r Pr. ((p \/* q) UNLESS r) Pr ==> (p UNLESS (q \/* r)) Pr`), REPEAT STRIP_TAC THEN ASSUME_TAC (SPEC_ALL ((SPEC (`Not (q:'a->bool)`) UNLESS_thm2))) THEN UNDISCH_TAC (`((Not (q:'a->bool)) UNLESS (Not(Not q)))Pr`) THEN REWRITE_TAC [NOT_NOT_lemma] THEN STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`(((p:'a->bool) \/* q) UNLESS r)Pr`); (`((Not (q:'a->bool)) UNLESS q)Pr`)] AND_INTRO_THM))) THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`((p:'a->bool) \/* q)`); (`r:'a->bool`); (`(Not (q:'a->bool))`); (`q:'a->bool`)] UNLESS_thm6))) THEN UNDISCH_TAC (`((((p:'a->bool) \/* q) /\* (Not q)) UNLESS (r \/* q))Pr`) THEN REWRITE_TAC [OR_NOT_AND_lemma] THEN PURE_ONCE_REWRITE_TAC [SPECL [(`r:'a->bool`); (`q:'a->bool`)] OR_COMM_lemma] THEN REWRITE_TAC [UNLESS_cor3] THEN STRIP_TAC THEN PURE_ONCE_REWRITE_TAC [SPECL [(`r:'a->bool`); (`q:'a->bool`)] OR_COMM_lemma] THEN ASM_REWRITE_TAC []);; let UNLESS_cor5 = prove_thm ("UNLESS_cor5", (`!(p:'a->bool) Pr. (p UNLESS True) Pr`), REPEAT GEN_TAC THEN ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN ASSUME_TAC (SPEC_ALL UNLESS_thm2) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS p)Pr`); (`((p:'a->bool) UNLESS (Not p))Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`p:'a->bool`); (`p:'a->bool`); (`p:'a->bool`); (`(Not (p:'a->bool))`)] UNLESS_thm6))) THEN UNDISCH_TAC (`(((p:'a->bool) /\* p) UNLESS (p \/* (Not p)))Pr`) THEN REWRITE_TAC [AND_AND_lemma;P_OR_NOT_P_lemma]);; let UNLESS_cor6 = prove_thm ("UNLESS_cor6", (`!(p:'a->bool) Pr. (True UNLESS p) Pr`), REPEAT GEN_TAC THEN ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN ASSUME_TAC (SPEC_ALL (SPEC (`(Not (p:'a->bool))`) UNLESS_thm2)) THEN UNDISCH_TAC (`((Not (p:'a->bool)) UNLESS (Not(Not p)))Pr`) THEN REWRITE_TAC [NOT_NOT_lemma] THEN DISCH_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((Not (p:'a->bool)) UNLESS p)Pr`); (`((p:'a->bool) UNLESS p)Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`(Not (p:'a->bool))`); (`p:'a->bool`); (`p:'a->bool`); (`p:'a->bool`)] UNLESS_thm7))) THEN UNDISCH_TAC (`(((Not (p:'a->bool)) \/* p) UNLESS (p \/* p))Pr`) THEN PURE_ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [OR_OR_lemma;P_OR_NOT_P_lemma]);; let UNLESS_cor7 = prove_thm ("UNLESS_cor7", (`!(p:'a->bool) Pr. (False UNLESS p) Pr`), REPEAT GEN_TAC THEN ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN ASSUME_TAC (SPEC_ALL (SPEC (`(Not (p:'a->bool))`) UNLESS_thm2)) THEN UNDISCH_TAC (`((Not (p:'a->bool)) UNLESS (Not(Not p)))Pr`) THEN REWRITE_TAC [NOT_NOT_lemma] THEN DISCH_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((Not (p:'a->bool)) UNLESS p)Pr`); (`((p:'a->bool) UNLESS p)Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`(Not (p:'a->bool))`); (`p:'a->bool`); (`p:'a->bool`); (`p:'a->bool`)] UNLESS_thm6))) THEN UNDISCH_TAC (`(((Not (p:'a->bool)) /\* p) UNLESS (p \/* p))Pr`) THEN PURE_ONCE_REWRITE_TAC [AND_COMM_lemma] THEN REWRITE_TAC [OR_OR_lemma;P_AND_NOT_P_lemma]);; let HeJiFeng_lemma1 = TAC_PROOF (([], (`!(p:'a->bool) q p'. (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) ==> (!s. p s /\ ~q s ==> p' s /\ ~q s)`)), REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let HeJiFeng_lemma2 = TAC_PROOF (([], (`!(p:'a->bool) q p'. (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) ==> (!s. p' s /\ ~q s ==> p s /\ ~q s)`)), REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; let HeJiFeng_lemma = TAC_PROOF (([], (`!(p:'a->bool) q p'. (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) ==> (!s. p s /\ ~q s <=> p' s /\ ~q s)`)), REPEAT STRIP_TAC THEN REWRITE_TAC [IMP_ANTISYM_RULE (SPEC_ALL (UNDISCH (UNDISCH (UNDISCH (SPEC_ALL HeJiFeng_lemma1))))) (SPEC_ALL (UNDISCH (UNDISCH (UNDISCH (SPEC_ALL HeJiFeng_lemma2)))))]);; let HeJiFeng_lemma_f = MK_ABS (UNDISCH_ALL (SPEC_ALL HeJiFeng_lemma));; let UNLESS_cor8 = prove_thm ("UNLESS_cor8", (`!(p:'a->bool) q p' Pr. (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) ==> (((p /\* (Not q)) UNLESS q) Pr = ((p' /\* (Not q)) UNLESS q) Pr)`), REPEAT STRIP_TAC THEN REWRITE_TAC [AND_def;OR_def;NOT_def1] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [HeJiFeng_lemma_f]);; (* Corollary of generalized cancellation *) let UNLESS_cor9 = prove_thm ("UNLESS_cor9", (`!(p:'a->bool) q p' q' r r' Pr. ((p \/* p') UNLESS (q \/* r)) Pr /\ ((q \/* q') UNLESS (p \/* r')) Pr ==> ((p \/* p' \/* q \/* q') UNLESS ((p /\* q) \/* r \/* r')) Pr`), REPEAT GEN_TAC THEN DISCH_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) \/* p')`); (`((q:'a->bool) \/* r)`); (`((q:'a->bool) \/* q')`); (`((p:'a->bool) \/* r')`); (`Pr:('a->'a)list`)] UNLESS_thm5)) THEN ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`p':'a->bool`); (`q':'a->bool`); (`r:'a->bool`); (`r':'a->bool`)] IMPLY_WEAK_lemma4) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((((p:'a->bool) \/* p') \/* (q \/* q')) UNLESS ((((Not(p \/* p')) /\* (p \/* r')) \/* ((Not(q \/* q')) /\* (q \/* r))) \/* ((q \/* r) /\* (p \/* r')))) Pr`); (`!s:'a. ((((Not(p \/* p')) /\* (p \/* r')) \/* ((Not(q \/* q')) /\* (q \/* r))) \/* ((q \/* r) /\* (p \/* r'))) s ==> ((p /\* q) \/* (r \/* r'))s`)] AND_INTRO_THM)) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL [(`(((p:'a->bool) \/* p') \/* (q \/* q'))`); (`((((Not((p:'a->bool) \/* p')) /\* (p \/* r')) \/* ((Not(q \/* q')) /\* (q \/* r))) \/* ((q \/* r) /\* (p \/* r')))`); (`(((p:'a->bool) /\* q) \/* (r \/* r'))`)] UNLESS_thm3))) THEN UNDISCH_TAC (`((((p:'a->bool) \/* p') \/* (q \/* q')) UNLESS ((p /\* q) \/* (r \/* r')))Pr`) THEN REWRITE_TAC [OR_ASSOC_lemma]);; let UNLESS_cor10 = prove_thm ("UNLESS_cor10", (`!(p:'a->bool) q Pr. (p \/* q) STABLE Pr ==> (p UNLESS q) Pr`), REPEAT GEN_TAC THEN REWRITE_TAC [STABLE] THEN DISCH_TAC THEN STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`False:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_cor4)) THEN UNDISCH_TAC (`((p:'a->bool) UNLESS (q \/* False))Pr`) THEN REWRITE_TAC [OR_False_lemma]);; let UNLESS_cor11 = prove_thm ("UNLESS_cor11", (`!(p:'a->bool) Pr. (!s. (Not p)s) ==> p STABLE Pr`), GEN_TAC THEN REWRITE_TAC [STABLE] THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN GEN_TAC THEN REWRITE_TAC [UNLESS_STMT; FALSE_def] THEN STRIP_ASSUME_TAC (REWRITE_RULE [NOT_def1] (SPEC `s:'a` (ASSUME `!s:'a. Not (p:'a->bool) s`))) THEN STRIP_TAC THEN RES_TAC);; let UNLESS_cor12 = prove_thm ("UNLESS_cor12", (`!(p:'a->bool) Pr. (!s. (Not p)s) ==> (Not p) STABLE Pr`), GEN_TAC THEN REWRITE_TAC [STABLE] THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [UNLESS_STMT]);; let UNLESS_cor13 = prove_thm ("UNLESS_cor13", (`!(p:'a->bool) q Pr. (p UNLESS q) Pr /\ (q UNLESS p) Pr /\ (!s. Not (p /\* q) s) ==> (p \/* q) STABLE Pr`), REPEAT STRIP_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) /\* q)`); (`Pr:('a->'a)list`)] UNLESS_cor11)) THEN UNDISCH_TAC (`((p:'a->bool) /\* q) STABLE Pr`) THEN REWRITE_TAC [STABLE] THEN DISCH_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((p:'a->bool) UNLESS q)Pr`); (`((q:'a->bool) UNLESS p)Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(p:'a->bool)`); (`(q:'a->bool)`); (`(q:'a->bool)`); (`(p:'a->bool)`); (`Pr:('a->'a)list`)] UNLESS_thm5)) THEN UNDISCH_TAC (`(((p:'a->bool) \/* q) UNLESS ((((Not p) /\* p) \/* ((Not q) /\* q)) \/* (q /\* p)) ) Pr`) THEN PURE_ONCE_REWRITE_TAC [AND_COMM_lemma] THEN REWRITE_TAC [P_AND_NOT_P_lemma;OR_False_lemma] THEN PURE_ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [OR_False_lemma] THEN DISCH_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(((q:'a->bool) \/* p) UNLESS (p /\* q))Pr`); (`(((p:'a->bool) /\* q) UNLESS False)Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`((q:'a->bool) \/* p)`); (`((p:'a->bool) /\* q)`); (`False:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm8)) THEN UNDISCH_TAC (`((((q:'a->bool) \/* p) \/* (p /\* q)) UNLESS False)Pr`) THEN REWRITE_TAC [OR_AND_DISTR_lemma] THEN REWRITE_TAC [OR_ASSOC_lemma;OR_OR_lemma] THEN PURE_ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [OR_ASSOC_lemma;OR_OR_lemma;AND_AND_lemma]);; let UNLESS_cor14 = prove_thm ("UNLESS_cor14", (`!(p:'a->bool) q Pr. (p UNLESS (Not q)) Pr /\ q STABLE Pr ==> (p UNLESS (p /\* (Not q))) Pr`), REWRITE_TAC [STABLE] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`p:'a->bool`); (`Not (q:'a->bool)`); (`q:'a->bool`); (`False:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm4)) THEN UNDISCH_TAC (`(((p:'a->bool) /\* q) UNLESS (((p /\* False) \/* (q /\* (Not q))) \/* ((Not q) /\* False)))Pr`) THEN REWRITE_TAC [AND_False_lemma;P_AND_NOT_P_lemma;OR_False_lemma] THEN DISCH_TAC THEN ASSUME_TAC (SPECL [(`(p:'a->bool) /\* (Not q)`); (`Pr:('a->'a)list`)] UNLESS_thm1) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(((p:'a->bool) /\* q) UNLESS False)Pr`); (`(((p:'a->bool) /\* (Not q)) UNLESS (p /\* (Not q)))Pr`)] AND_INTRO_THM)) THEN ASSUME_TAC (UNDISCH_ALL (SPECL [(`(p:'a->bool) /\* q`); (`False:'a->bool`); (`(p:'a->bool) /\* (Not q)`); (`(p:'a->bool) /\* (Not q)`); (`Pr:('a->'a)list`)] UNLESS_thm5)) THEN UNDISCH_TAC (`((((p:'a->bool) /\* q) \/* (p /\* (Not q))) UNLESS ((((Not(p /\* q)) /\* (p /\* (Not q))) \/* ((Not(p /\* (Not q))) /\* False)) \/* (False /\* (p /\* (Not q)))))Pr`) THEN REWRITE_TAC [AND_False_lemma;OR_False_lemma] THEN ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [AND_COMPL_OR_lemma] THEN ONCE_REWRITE_TAC [AND_COMM_lemma] THEN REWRITE_TAC [AND_False_lemma] THEN ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [OR_False_lemma] THEN REWRITE_TAC [NOT_AND_OR_NOT_lemma] THEN REWRITE_TAC [AND_OR_DISTR_lemma] THEN REWRITE_TAC [AND_ASSOC_lemma] THEN REWRITE_TAC [AND_AND_lemma] THEN ONCE_REWRITE_TAC [AND_AND_COMM_lemma] THEN REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL AND_ASSOC_lemma))] THEN REWRITE_TAC [P_AND_NOT_P_lemma] THEN ONCE_REWRITE_TAC [AND_COMM_OR_lemma] THEN REWRITE_TAC [AND_False_lemma] THEN ONCE_REWRITE_TAC [OR_COMM_lemma] THEN REWRITE_TAC [OR_False_lemma] THEN DISCH_TAC THEN ONCE_REWRITE_TAC [AND_COMM_lemma] THEN ASM_REWRITE_TAC []);; let UNLESS_cor15_lem1 = TAC_PROOF (([], (`!p q. p /\ (~p \/ ~q) <=> p /\ ~q`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN (RES_TAC THEN ASM_REWRITE_TAC []));; let UNLESS_cor15_lem2 = TAC_PROOF (([], (`!p q. p \/ (p /\ q) <=> p`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; let UNLESS_cor15_lem3 = TAC_PROOF (([], (`!P Q. (!(i:num). (P i) /\ (Q i)) <=> ((!i. P i) /\ (!i. Q i))`)), REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; (* MESON_TAC is powerful, but I should change this proof to not use MESON_TAC as a detailed proof will better show why the UNLESS_STMT property holds *) let UNLESS_STMT_cor15 = prove_thm ("UNLESS_STMT_cor15", `!(P:num->('a->bool)) Q st. (!i s. (P i UNLESS_STMT P i /\* Q i) st s) ==> (!s. ((!*) P UNLESS_STMT (!*) P /\* (?*) Q) st s)`, REPEAT GEN_TAC THEN REWRITE_TAC [FORALL_def; EXISTS_def; UNLESS_STMT; AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN MESON_TAC []);; let UNLESS_cor15 = prove_thm ("UNLESS_cor15", `!(P:num->('a->bool)) Q Pr. (!i. ((P i) UNLESS ((P i) /\* (Q i))) Pr) ==> (((!*) P) UNLESS (((!*) P) /\* ((?*) Q))) Pr`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN STRIP_ASSUME_TAC (REWRITE_RULE [UNLESS_cor15_lem3] (ASSUME `!i:num. (!s:'a. (P i UNLESS_STMT P i /\* Q i) h s) /\ (P i UNLESS P i /\* Q i) t`)) THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN IMP_RES_TAC UNLESS_STMT_cor15);; let UNLESS_cor16 = prove_thm ("UNLESS_cor16", `!(P:num->('a->bool)) Q Pr. (!i. ((P i) UNLESS (Q i))Pr) ==> (!i. ((/<=\* P i) UNLESS (\<=/* Q i))Pr)`, REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [ ASM_REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] ; REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] THEN ASSUME_TAC (SPEC (`SUC i`) (ASSUME (`!i. (((P:num->('a->bool)) i) UNLESS (Q i))Pr`))) THEN STRIP_ASSUME_TAC (UNDISCH_ALL (hd (IMP_CANON (SPECL [(`/<=\* (P:num->('a->bool)) i`); (`\<=/* (Q:num->('a->bool)) i`); (`(P:num->('a->bool))(SUC i)`); (`(Q:num->('a->bool))(SUC i)`); (`Pr:('a->'a)list`)] UNLESS_thm6)))) ]);; let UNLESS_cor17 = prove_thm ("UNLESS_cor17", (`!(P:num->('a->bool)) q Pr. (!i. ((P i) UNLESS q)Pr) ==> (!i. ((/<=\* P i) UNLESS q)Pr)`), REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [ ASM_REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] ; REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] THEN ASSUME_TAC (SPEC (`SUC i`) (ASSUME (`!i. (((P:num->('a->bool)) i) UNLESS q)Pr`))) THEN ASSUME_TAC (UNDISCH_ALL (hd (IMP_CANON (SPECL [(`/<=\* (P:num->('a->bool)) i`); (`q:'a->bool`); (`(P:num->('a->bool))(SUC i)`); (`q:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm6)))) THEN UNDISCH_ONE_TAC THEN REWRITE_TAC [OR_OR_lemma] ]);; (* MESON_TAC is powerful, but I should change this proof to not use MESON_TAC as a detailed proof will better show why the UNLESS_STMT property holds *) let UNLESS_STMT_cor18 = prove_thm ("UNLESS_STMT_cor18", `!(P:num->('a->bool)) Q st. (!i s. ((P i) UNLESS_STMT q) st s) ==> (!s. (((?*) P) UNLESS_STMT q) st s)`, REPEAT GEN_TAC THEN REWRITE_TAC [FORALL_def; EXISTS_def; UNLESS_STMT; AND_def] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN MESON_TAC []);; let UNLESS_cor18 = prove_thm ("UNLESS_cor18", (`!(P:num->('a->bool)) q Pr. (!m. ((P m) UNLESS q) Pr) ==> (((?*) P) UNLESS q) Pr`), GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN STRIP_ASSUME_TAC (REWRITE_RULE [UNLESS_cor15_lem3] (ASSUME `!m:num. (!s:'a. (P m UNLESS_STMT q) h s) /\ (P m UNLESS q) t`)) THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN IMP_RES_TAC UNLESS_STMT_cor18);; let UNLESS_cor19 = prove_thm ("UNLESS_cor19", (`!Pr. (False:'a->bool) STABLE Pr`), GEN_TAC THEN REWRITE_TAC [STABLE] THEN REWRITE_TAC [UNLESS_thm1]);; let UNLESS_cor20 = prove_thm ("UNLESS_cor20", (`!(p:'a->bool) q Pr. (p STABLE Pr) /\ (q STABLE Pr) ==> ((p /\* q) STABLE Pr)`), REPEAT GEN_TAC THEN REWRITE_TAC [STABLE] THEN ACCEPT_TAC (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL [(`p:'a->bool`); (`False:'a->bool`); (`q:'a->bool`); (`False:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm4)));; let UNLESS_cor21 = prove_thm ("UNLESS_cor21", (`!(p:'a->bool) q Pr. (p STABLE Pr) /\ (q STABLE Pr) ==> ((p \/* q) STABLE Pr)`), REPEAT GEN_TAC THEN REWRITE_TAC [STABLE] THEN ACCEPT_TAC (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL [(`p:'a->bool`); (`False:'a->bool`); (`q:'a->bool`); (`False:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm7)));; let UNLESS_cor22 = prove_thm ("UNLESS_cor22", (`!(p:'a->bool) q r Pr. (p UNLESS q) Pr /\ (r STABLE Pr) ==> ((p /\* r) UNLESS (q /\* r))Pr`), REPEAT GEN_TAC THEN REWRITE_TAC [STABLE] THEN ACCEPT_TAC (REWRITE_RULE [OR_False_lemma] (ONCE_REWRITE_RULE [OR_COMM_lemma] (ONCE_REWRITE_RULE [OR_AND_COMM_lemma] (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`r:'a->bool`); (`False:'a->bool`); (`Pr:('a->'a)list`)] UNLESS_thm4))))));; let UNLESS_cor23 = prove_thm ("UNLESS_cor23", (`!(p:'a->bool) q r Pr. ((p UNLESS q) Pr) ==> ((p \/* r) UNLESS (q \/* r)) Pr`), GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [UNLESS] THEN STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN IMP_RES_TAC UNLESS_STMT_thm6 THEN ASM_REWRITE_TAC []);; hol-light/VERYQUICK_REFERENCE.txt000066400000000000000000000464321303454263000164570ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* Theorems (type thm) *) (* ------------------------------------------------------------------------- *) ADD1 |- SUC m = m + 1 ADD_AC |- m + n = n + m /\ (m + n) + p = m + n + p /\ m + n + p = n + m + p ADD_ASSOC |- m + n + p = (m + n) + p ADD_CLAUSES |- (!n. 0 + n = n) /\ (!m. m + 0 = m) /\ (!m n. SUC m + n = SUC (m + n)) /\ (!m n. m + SUC n = SUC (m + n)) ADD_SUB |- (m + n) - n = m ADD_SYM |- m + n = n + m ALL |- (ALL P [] <=> T) /\ (ALL P (CONS h t) <=> P h /\ ALL P t) ALL2 |- (ALL2 P [] [] <=> T) /\ ... /\ (ALL2 P (CONS h1 t1) (CONS h2 t2) <=> P h1 h2 /\ ALL2 P t1 t2) APPEND |- (!l. APPEND [] l = l) /\ (!h t l. APPEND (CONS h t) l = CONS h (APPEND t l)) ARITH |- (NUMERAL 0 = 0 /\ BIT0 _0 = _0) /\ ((!n. SUC (NUMERAL n) = NUMERAL (SUC n)) /\ ... ARITH_EQ |- (!m n. NUMERAL m = NUMERAL n <=> m = n) /\ (_0 = _0 <=> T) /\ ... CARD_CLAUSES |- CARD {} = 0 /\ (!x s. FINITE s ==> CARD (x INSERT s) = (if x IN s then CARD s else SUC (CARD s))) CART_EQ |- x = y <=> (!i. 1 <= i /\ i <= dimindex UNIV ==> x $ i = y $ i) CONJ_ASSOC |- t1 /\ t2 /\ t3 <=> (t1 /\ t2) /\ t3 DE_MORGAN_THM |- (~(t1 /\ t2) <=> ~t1 \/ ~t2) /\ (~(t1 \/ t2) <=> ~t1 /\ ~t2) DIVISION |- ~(n = 0) ==> m = m DIV n * n + m MOD n /\ m MOD n < n ETA_AX |- (\x. t x) = t EVEN |- (EVEN 0 <=> T) /\ (!n. EVEN (SUC n) <=> ~EVEN n) EXISTS_REFL |- ?x. x = a EXP |- (!m. m EXP 0 = 1) /\ (!m n. m EXP SUC n = m * m EXP n) EXTENSION |- s = t <=> (!x. x IN s <=> x IN t) FACT |- FACT 0 = 1 /\ (!n. FACT (SUC n) = SUC n * FACT n) FINITE_INDUCT_STRONG |- P {} /\ (!x s. P s /\ ~(x IN s) /\ FINITE s ==> P (x INSERT s)) ==> (!s. FINITE s ==> P s) FINITE_NUMSEG |- FINITE (m .. n) FINITE_RULES |- FINITE {} /\ (!x s. FINITE s ==> FINITE (x INSERT s)) FINITE_SUBSET |- FINITE t /\ s SUBSET t ==> FINITE s FORALL_PAIR_THM |- (!p. P p) <=> (!p1 p2. P (p1,p2)) FUN_EQ_THM |- f = g <=> (!x. f x = g x) GE |- m >= n <=> n <= m HAS_SIZE |- s HAS_SIZE n <=> FINITE s /\ CARD s = n HD |- HD (CONS h t) = h IMP_IMP |- p ==> q ==> r <=> p /\ q ==> r IN |- x IN P <=> P x IN_DELETE |- x IN s DELETE y <=> x IN s /\ ~(x = y) IN_ELIM_THM |- (!P x. x IN GSPEC (\v. P (SETSPEC v)) <=> P (\p t. p /\ x = t)) /\ ... IN_IMAGE |- y IN IMAGE f s <=> (?x. y = f x /\ x IN s) IN_INSERT |- x IN y INSERT s <=> x = y \/ x IN s IN_INTER |- x IN s INTER t <=> x IN s /\ x IN t IN_NUMSEG |- p IN m .. n <=> m <= p /\ p <= n IN_SING |- x IN {y} <=> x = y IN_UNION |- x IN s UNION t <=> x IN s \/ x IN t IN_UNIV |- x IN UNIV LAMBDA_BETA |- 1 <= i /\ i <= dimindex UNIV ==> (lambda) g $ i = g i LAST |- LAST (CONS h t) = (if t = [] then h else LAST t) LE |- (!m. m <= 0 <=> m = 0) /\ (!m n. m <= SUC n <=> m = SUC n \/ m <= n) LEFT_ADD_DISTRIB |- m * (n + p) = m * n + m * p LEFT_IMP_EXISTS_THM |- (?x. P x) ==> Q <=> (!x. P x ==> Q) LENGTH |- LENGTH [] = 0 /\ (!h t. LENGTH (CONS h t) = SUC (LENGTH t)) LENGTH_APPEND |- LENGTH (APPEND l m) = LENGTH l + LENGTH m LE_0 |- 0 <= n LE_ADD |- m <= m + n LE_EXISTS |- m <= n <=> (?d. n = m + d) LE_MULT_LCANCEL |- m * n <= m * p <=> m = 0 \/ n <= p LE_REFL |- n <= n LE_TRANS |- m <= n /\ n <= p ==> m <= p LT |- (!m. m < 0 <=> F) /\ (!m n. m < SUC n <=> m = n \/ m < n) LT_0 |- 0 < SUC n LT_REFL |- ~(n < n) MEM |- (MEM x [] <=> F) /\ (MEM x (CONS h t) <=> x = h \/ MEM x t) MEMBER_NOT_EMPTY |- (?x. x IN s) <=> ~(s = {}) MONO_EXISTS |- (!x. P x ==> Q x) ==> (?x. P x) ==> (?x. Q x) MONO_FORALL |- (!x. P x ==> Q x) ==> (!x. P x) ==> (!x. Q x) MULT_AC |- m * n = n * m /\ (m * n) * p = m * n * p /\ m * n * p = n * m * p MULT_ASSOC |- m * n * p = (m * n) * p MULT_CLAUSES |- (!n. 0 * n = 0) /\ ... /\ (!m n. m * SUC n = m + m * n) MULT_SYM |- m * n = n * m NOT_CONS_NIL |- ~(CONS h t = []) NOT_EXISTS_THM |- ~(?x. P x) <=> (!x. ~P x) NOT_FORALL_THM |- ~(!x. P x) <=> (?x. ~P x) NOT_IMP |- ~(t1 ==> t2) <=> t1 /\ ~t2 NOT_IN_EMPTY |- ~(x IN {}) NOT_LE |- ~(m <= n) <=> n < m NOT_LT |- ~(m < n) <=> n <= m NOT_SUC |- ~(SUC n = 0) PAIR_EQ |- x,y = a,b <=> x = a /\ y = b PRE |- PRE 0 = 0 /\ (!n. PRE (SUC n) = n) REAL_ABS_MUL |- abs (x * y) = abs x * abs y REAL_ABS_NEG |- abs (--x) = abs x REAL_ABS_NUM |- abs (&n) = &n REAL_ABS_POS |- &0 <= abs x REAL_ABS_POW |- abs (x pow n) = abs x pow n REAL_ADD_ASSOC |- x + y + z = (x + y) + z REAL_ADD_LID |- &0 + x = x REAL_ADD_LINV |- --x + x = &0 REAL_ADD_RID |- x + &0 = x REAL_ADD_SYM |- x + y = y + x REAL_ENTIRE |- x * y = &0 <=> x = &0 \/ y = &0 REAL_EQ_IMP_LE |- x = y ==> x <= y REAL_INV_MUL |- inv (x * y) = inv x * inv y REAL_LET_TRANS |- x <= y /\ y < z ==> x < z REAL_LE_LMUL |- &0 <= x /\ y <= z ==> x * y <= x * z REAL_LE_LT |- x <= y <=> x < y \/ x = y REAL_LE_REFL |- x <= x REAL_LE_SQUARE |- &0 <= x * x REAL_LE_TOTAL |- x <= y \/ y <= x REAL_LTE_TRANS |- x < y /\ y <= z ==> x < z REAL_LT_01 |- &0 < &1 REAL_LT_DIV |- &0 < x /\ &0 < y ==> &0 < x / y REAL_LT_IMP_LE |- x < y ==> x <= y REAL_LT_IMP_NZ |- &0 < x ==> ~(x = &0) REAL_LT_LE |- x < y <=> x <= y /\ ~(x = y) REAL_LT_MUL |- &0 < x /\ &0 < y ==> &0 < x * y REAL_LT_REFL |- ~(x < x) REAL_LT_TRANS |- x < y /\ y < z ==> x < z REAL_MUL_AC |- m * n = n * m /\ (m * n) * p = m * n * p /\ m * n * p = n * m * p REAL_MUL_ASSOC |- x * y * z = (x * y) * z REAL_MUL_LID |- &1 * x = x REAL_MUL_LINV |- ~(x = &0) ==> inv x * x = &1 REAL_MUL_LZERO |- &0 * x = &0 REAL_MUL_RID |- x * &1 = x REAL_MUL_RINV |- ~(x = &0) ==> x * inv x = &1 REAL_MUL_RZERO |- x * &0 = &0 REAL_MUL_SYM |- x * y = y * x REAL_NEGNEG |- -- --x = x REAL_NEG_NEG |- -- --x = x REAL_NOT_LE |- ~(x <= y) <=> y < x REAL_NOT_LT |- ~(x < y) <=> y <= x REAL_OF_NUM_ADD |- &m + &n = &(m + n) REAL_OF_NUM_EQ |- &m = &n <=> m = n REAL_OF_NUM_LE |- &m <= &n <=> m <= n REAL_OF_NUM_LT |- &m < &n <=> m < n REAL_OF_NUM_MUL |- &m * &n = &(m * n) REAL_OF_NUM_POW |- &x pow n = &(x EXP n) REAL_POS |- &0 <= &n REAL_POW_2 |- x pow 2 = x * x REAL_POW_ADD |- x pow (m + n) = x pow m * x pow n REAL_SUB_0 |- x - y = &0 <=> x = y REAL_SUB_LDISTRIB |- x * (y - z) = x * y - x * z REAL_SUB_LE |- &0 <= x - y <=> y <= x REAL_SUB_LT |- &0 < x - y <=> y < x REAL_SUB_REFL |- x - x = &0 REAL_SUB_RZERO |- x - &0 = x RIGHT_ADD_DISTRIB |- (m + n) * p = m * p + n * p RIGHT_FORALL_IMP_THM |- (!x. P ==> Q x) <=> P ==> (!x. Q x) SKOLEM_THM |- (!x. ?y. P x y) <=> (?y. !x. P x (y x)) SUBSET |- s SUBSET t <=> (!x. x IN s ==> x IN t) SUC_INJ |- SUC m = SUC n <=> m = n TL |- TL (CONS h t) = t TRUTH |- T (* ------------------------------------------------------------------------- *) (* Inference rules (result type "thm") *) (* ------------------------------------------------------------------------- *) AC th tm Prove equivalence by associativity and commutativity AP_TERM tm th From |- s = t to |- f s = f t AP_THM th tm From |- f = g to |- f x = g x ARITH_RULE tm Linear arithmetic prover over N ASSUME tm Generate trivial theorem p |- p BETA_RULE th Reduce all beta-redexes in theorem CONJ th th From |- p and |- q to |- p /\ q CONJUNCT1 th From |- p /\ q to |- p CONJUNCT2 th From |- p /\ q to |- q CONV_RULE conv th Apply conversion to conclusion of theorem DISCH tm th From p |- q to |- p ==> q DISCH_ALL th From p1, ..., pn |- q to |- p1 ==> ... ==> pn ==> q EQT_ELIM th From |- p <=> T to |- p EQT_INTRO th From |- p to |- p <=> T EQ_MP th th From |- p <=> q and |- p to |- q GEN tm th From |- p[x] to |- !x. p[x] GENL tml th From |- p[x1,...,xn] to |- !x1 .. xn. p[x1,...,xn] GEN_ALL th From |- p[x1,...,xn] to |- !x1 .. xn. p[x1,...,xn], all variables GEN_REWRITE_RULE convfn thl th Rewrite conclusion of theorem using precise depth conversion GSYM th Switch topmost equations, e.g. from |- !x. s[x] = t[x] to !x. t[x] = s[x] INST tmtml th Instantiate |- p[x1,...xn] to |- p[t1,...,tn] INT_ARITH tm Linear arithmetic prover over Z INT_OF_REAL_THM th Map universal theorem from R to analog over Z ISPEC tm th From |- !x. p[x] to |- p[t] with type instantiation ISPECL tml th From |- !x1 .. xn. p[x1,...,xn] to |- p[t1,...,tn] with type instantiation MATCH_MP th th From |- p ==> q and |- p' to |- q', instantiating first theorem to match MK_COMB thth From |- f = g and |- x = y to |- f(x) = g(y) MP th th From |- p ==> q and |- p to |- q, no matching ONCE_REWRITE_RULE thl th Rewrite conclusion of theorem once at topmost subterms PART_MATCH tmfn th tm Instantiate theorem by matching part of it to a term PROVE_HYP th th From |- p and p |- q to |- q REAL_ARITH tm Linear arithmetic prover over R REFL tm Produce trivial theorem |- t = t REWRITE_RULE thl th Rewrite conclusion of theorem with equational theorems SPEC tm th From |- !x. p[x] to |- p[t] SPECL tml th From |- !x1 .. xn. p[x1,...,xn] to |- p[t1,...,tn] SPEC_ALL th From |- !x1 .. xn. p[x1,...,xn] to |- p[x1,...,xn] SYM th From |- s = t to |- t = s TAUT tm Prove propositional tautology like `p /\ q ==> p` TRANS th th From |- s = t and |- t = u and |- s = u UNDISCH th From |- p ==> q to p |- q (* ------------------------------------------------------------------------- *) (* Inference rule with return type "thm list" *) (* ------------------------------------------------------------------------- *) CONJUNCTS th From |- p1 /\ ... /\ pn to [|- p1; ...; |- pn] (* ------------------------------------------------------------------------- *) (* Conversions (type "conv = term -> thm") *) (* ------------------------------------------------------------------------- *) BETA_CONV tm Reduce toplevel beta-redex |- (\x. s[x]) t = s[t] CONTRAPOS_CONV From `p ==> q` give |- (p ==> q) <=> (~q ==> ~p) GEN_BETA_CONV Reduce general beta-redex like |- (\(x,y). p[x,y]) (a,b) = p[a,b] GEN_REWRITE_CONV convfn thl Rewriting conversion using precise depth conversion NUM_REDUCE_CONV Evaluate numerical expressions over N like `2 + 7 DIV (FACT 3)` conv ORELSEC conv Try to apply one conversion and if it fails, apply the other REAL_RAT_REDUCE_CONV Evaluate numerical expressions over R like `&22 / &7 - &3 * &1` REWRITE_CONV thl Conversion to rewrite a term t to t' giving |- t = t' REWR_CONV th Conversion to rewrite a term t once at top level giving |- t = t' SYM_CONV Conversion to switch equations once |- P[s = t] <=> P[t = s] conv THENC conv Apply one conversion then the other TOP_DEPTH_CONV conv Apply conversion once to top-level terms (* ------------------------------------------------------------------------- *) (* Conversionals (type "conv -> conv") *) (* ------------------------------------------------------------------------- *) BINDER_CONV Apply conversion to body of quantifier etc. LAND_CONV Apply conversion to LHS of binary operator, e.g. `s` in `s + t` ONCE_DEPTH_CONV Apply conversion to first possible subterms top-down RAND_CONV Apply conversion to rand of combination, e.g. x in f(x) RATOR_CONV Apply conversion to rator of combination, e.g. f in f(x) (* ------------------------------------------------------------------------- *) (* Tactics (return type "tactic") *) (* ------------------------------------------------------------------------- *) ABBREV_TAC tm Introduce abbreviation for t, from ?- p[t] to t = x ?- p[x] ABS_TAC From ?- (\x. s[x]) = (\x. t[x]) to ?- s[x] = t[x] ALL_TAC Tactic with no effect ANTS_TAC From ?- (p ==> q) ==> r to ?- p and ?- q ==> r AP_TERM_TAC From ?- f s = f t to ?- s = t AP_THM_TAC From ?- f x = g x to ?- f = g ARITH_TAC Tactic to solve linear arithmetic over N ASM_CASES_TAC tm Split ?- q into p ?- q and ~p ?- q ASM_MESON_TAC thl Tactic for first-order logic including assumptions ASM_REWRITE_TAC thl Rewrite goal by theorems including assumptions ASM_SIMP_TAC thl Simplify goal by theorems including assumptions BETA_TAC Reduce all beta-redexes in conclusion of goal COND_CASES_TAC From ?- P[if p then x else y] to p ?- p[x] and ~p ?- p[y] CONJ_TAC Split ?- p /\ q into ?- p and ?- q CONV_TAC conv Apply conversion to conclusion of goal DISCH_TAC From ?- p ==> q to p ?- q DISCH_THEN ttac From ?- p ==> q to ?- q after using |- p DISJ1_TAC From ?- p \/ q to ?- p DISJ2_TAC From ?- p \/ q to ?- q EQ_TAC Split ?- p <=> q into ?- p ==> q and ?- q ==> p EVERY_ASSUM ttac Apply function to each assumption of goal EXISTS_TAC tm From ?- ?x. p[x] to ?- p[t] EXPAND_TAC s Expand an abbreviation in a goal FIRST_ASSUM ttac Apply function to first possible assumption of goal FIRST_X_ASSUM ttac Apply function to and remove first possible assumption of goal GEN_REWRITE_TAC convfn thl Rewrite conclusion of goal using precise depth conversion GEN_TAC From ?- !x. p[x] to ?- p[x] INDUCT_TAC Apply ordinary mathematical induction to goal LIST_INDUCT_TAC Apply list induction to goal MAP_EVERY atac al Map tactic-producing function over a list of arguments, apply in sequence MESON_TAC thl Solve goal using first-order automation, ignoring assumptions ONCE_REWRITE_TAC thl Rewrite conclusion of goal once at topmost subterms tac ORELSE tac Try to apply one tactic and if it fails, apply the other POP_ASSUM ttac Remove first assumption of goal and apply function to it POP_ASSUM_LIST tltac Remove assumptions of goal and apply function to it REAL_ARITH_TAC Tactic to solve linear arithmetic over R REFL_TAC Solve trivial goal ?- t = t REPEAT tac Apply a tactic repeatedly until it fails REWRITE_TAC thl Rewrite conclusion of goal with equational theorems RULE_ASSUM_TAC thfn Apply inference rule to all hypotheses of goal SET_TAC thl Solve trivial set-theoretic goal like `x IN (x INSERT s)` SIMP_TAC thl Simplify goal by theorems ignoring assumptions SPEC_TAC tmtm From ?- p[t] to ?- !x. p[x] STRIP_TAC Break down goal, ?- p /\ q to ?- p and ?- q etc. etc. SUBGOAL_THEN tm ttac Split off a separate subgoal TRY tac Try a tactic but do nothing if it fails tac THEN tac Apply one tactic then the other to all resulting subgoals tac THENL tacl Apply one tactic then second list to corresponding subgoals UNDISCH_TAC tm From p ?- q to ?- p ==> q USE_THEN s ttac Apply function to assumption with particular label X_GEN_TAC tm From ?- !x. p[x] to ?- p[y] with specified `y` (* ------------------------------------------------------------------------- *) (* thm_tactic = thm -> tactic *) (* ------------------------------------------------------------------------- *) ACCEPT_TAC Solve goal ?- p by theorem |- p ANTE_RES_THEN ttac Using |- p ==> q in goal p ?- r apply theorem-tactic to |- q ASSUME_TAC Given |- p, from ?- q to p ?- q, no label on new assumption CHOOSE_THEN ttac Using |- ?x. p[x] apply theorem-tactic to |- p[x] CONJUNCTS_THEN ttac Using |- p /\ q apply theorem-tactic to |- p and |- q CONJUNCTS_THEN2 ttac ttac Using |- p /\ q apply respective theorem-tactics to |- p and |- q DISJ_CASES_TAC Use |- p \/ q, from ?- r to p ?- r and q ?- r DISJ_CASES_THEN ttac Use |- p \/ q, apply theorem-tactic to |- p and |- q separately LABEL_TAC s Given |- p, from ?- q to p ?- q, labelling new assumption "s" MATCH_ACCEPT_TAC From |- p[x1,...,xn] solve goal ?- p[t1,...,tn] that's an instance MATCH_MP_TAC Use |- p ==> q to go from ?- q' to ?- p', instantiation theorem to match MP_TAC Use |- p to go from ?- q to ?- p ==> q REPEAT_TCL ttacfn ttac Apply theorem-tactical repeatedly until it fails STRIP_ASSUME_TAC Break theorem down into pieces and add them as assumptions SUBST1_TAC Substitute equation in conclusion of goal, no matching SUBST_ALL_TAC Substitute equation in hypotheses and conclusion of goal, no matching X_CHOOSE_TAC tm From |- ?x. p[x] and ?- q to p[y] ?- q, specified y X_CHOOSE_THEN tm ttac From |- ?x. p[x] apply theorem-tactic to |- p[y], specified y (* ------------------------------------------------------------------------- *) (* *) (* ------------------------------------------------------------------------- *) tm : term tml : term list tmtm : term * term tmtml : (term * term) list tmfn : term -> term th : thm thl : thm list thth : thm * thm thfn : thm -> thm conv : conv convfn : conv -> conv tac : tactic tacl : tactic list ttac : thm_tactic = thm -> tactic tltac : thm list -> tactic ttacfn : thm_tactical = thm_tactic -> thm_tactic atac : 'a -> tactic al : 'a list s : string hol-light/arith.ml000066400000000000000000001730171303454263000144170ustar00rootroot00000000000000(* ========================================================================= *) (* Natural number arithmetic. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Marco Maggesi 2015 *) (* ========================================================================= *) needs "recursion.ml";; (* ------------------------------------------------------------------------- *) (* Note: all the following proofs are intuitionistic and intensional, except *) (* for the least number principle num_WOP. *) (* (And except the arith rewrites at the end; these could be done that way *) (* but they use the conditional anyway.) In fact, one could very easily *) (* write a "decider" returning P \/ ~P for quantifier-free P. *) (* ------------------------------------------------------------------------- *) parse_as_infix("<",(12,"right"));; parse_as_infix("<=",(12,"right"));; parse_as_infix(">",(12,"right"));; parse_as_infix(">=",(12,"right"));; parse_as_infix("+",(16,"right"));; parse_as_infix("-",(18,"left"));; parse_as_infix("*",(20,"right"));; parse_as_infix("EXP",(24,"left"));; parse_as_infix("DIV",(22,"left"));; parse_as_infix("MOD",(22,"left"));; (* ------------------------------------------------------------------------- *) (* The predecessor function. *) (* ------------------------------------------------------------------------- *) let PRE = new_recursive_definition num_RECURSION `(PRE 0 = 0) /\ (!n. PRE (SUC n) = n)`;; (* ------------------------------------------------------------------------- *) (* Addition. *) (* ------------------------------------------------------------------------- *) let ADD = new_recursive_definition num_RECURSION `(!n. 0 + n = n) /\ (!m n. (SUC m) + n = SUC(m + n))`;; let ADD_0 = prove (`!m. m + 0 = m`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]);; let ADD_SUC = prove (`!m n. m + (SUC n) = SUC(m + n)`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]);; let ADD_CLAUSES = prove (`(!n. 0 + n = n) /\ (!m. m + 0 = m) /\ (!m n. (SUC m) + n = SUC(m + n)) /\ (!m n. m + (SUC n) = SUC(m + n))`, REWRITE_TAC[ADD; ADD_0; ADD_SUC]);; let ADD_SYM = prove (`!m n. m + n = n + m`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; let ADD_ASSOC = prove (`!m n p. m + (n + p) = (m + n) + p`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; let ADD_AC = prove (`(m + n = n + m) /\ ((m + n) + p = m + (n + p)) /\ (m + (n + p) = n + (m + p))`, MESON_TAC[ADD_ASSOC; ADD_SYM]);; let ADD_EQ_0 = prove (`!m n. (m + n = 0) <=> (m = 0) /\ (n = 0)`, REPEAT INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; NOT_SUC]);; let EQ_ADD_LCANCEL = prove (`!m n p. (m + n = m + p) <=> (n = p)`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUC_INJ]);; let EQ_ADD_RCANCEL = prove (`!m n p. (m + p = n + p) <=> (m = n)`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC EQ_ADD_LCANCEL);; let EQ_ADD_LCANCEL_0 = prove (`!m n. (m + n = m) <=> (n = 0)`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUC_INJ]);; let EQ_ADD_RCANCEL_0 = prove (`!m n. (m + n = n) <=> (m = 0)`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC EQ_ADD_LCANCEL_0);; (* ------------------------------------------------------------------------- *) (* Now define "bitwise" binary representation of numerals. *) (* ------------------------------------------------------------------------- *) let BIT0 = prove (`!n. BIT0 n = n + n`, INDUCT_TAC THEN ASM_REWRITE_TAC[BIT0_DEF; ADD_CLAUSES]);; let BIT1 = prove (`!n. BIT1 n = SUC(n + n)`, REWRITE_TAC[BIT1_DEF; BIT0]);; let BIT0_THM = prove (`!n. NUMERAL (BIT0 n) = NUMERAL n + NUMERAL n`, REWRITE_TAC[NUMERAL; BIT0]);; let BIT1_THM = prove (`!n. NUMERAL (BIT1 n) = SUC(NUMERAL n + NUMERAL n)`, REWRITE_TAC[NUMERAL; BIT1]);; (* ------------------------------------------------------------------------- *) (* Following is handy before num_CONV arrives. *) (* ------------------------------------------------------------------------- *) let ONE = prove (`1 = SUC 0`, REWRITE_TAC[BIT1; REWRITE_RULE[NUMERAL] ADD_CLAUSES; NUMERAL]);; let TWO = prove (`2 = SUC 1`, REWRITE_TAC[BIT0; BIT1; REWRITE_RULE[NUMERAL] ADD_CLAUSES; NUMERAL]);; (* ------------------------------------------------------------------------- *) (* One immediate consequence. *) (* ------------------------------------------------------------------------- *) let ADD1 = prove (`!m. SUC m = m + 1`, REWRITE_TAC[BIT1_THM; ADD_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Multiplication. *) (* ------------------------------------------------------------------------- *) let MULT = new_recursive_definition num_RECURSION `(!n. 0 * n = 0) /\ (!m n. (SUC m) * n = (m * n) + n)`;; let MULT_0 = prove (`!m. m * 0 = 0`, INDUCT_TAC THEN ASM_REWRITE_TAC[MULT; ADD_CLAUSES]);; let MULT_SUC = prove (`!m n. m * (SUC n) = m + (m * n)`, INDUCT_TAC THEN ASM_REWRITE_TAC[MULT; ADD_CLAUSES; ADD_ASSOC]);; let MULT_CLAUSES = prove (`(!n. 0 * n = 0) /\ (!m. m * 0 = 0) /\ (!n. 1 * n = n) /\ (!m. m * 1 = m) /\ (!m n. (SUC m) * n = (m * n) + n) /\ (!m n. m * (SUC n) = m + (m * n))`, REWRITE_TAC[BIT1_THM; MULT; MULT_0; MULT_SUC; ADD_CLAUSES]);; let MULT_SYM = prove (`!m n. m * n = n * m`, INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; EQT_INTRO(SPEC_ALL ADD_SYM)]);; let LEFT_ADD_DISTRIB = prove (`!m n p. m * (n + p) = (m * n) + (m * p)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD; MULT_CLAUSES; ADD_ASSOC]);; let RIGHT_ADD_DISTRIB = prove (`!m n p. (m + n) * p = (m * p) + (n * p)`, ONCE_REWRITE_TAC[MULT_SYM] THEN MATCH_ACCEPT_TAC LEFT_ADD_DISTRIB);; let MULT_ASSOC = prove (`!m n p. m * (n * p) = (m * n) * p`, INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; RIGHT_ADD_DISTRIB]);; let MULT_AC = prove (`(m * n = n * m) /\ ((m * n) * p = m * (n * p)) /\ (m * (n * p) = n * (m * p))`, MESON_TAC[MULT_ASSOC; MULT_SYM]);; let MULT_EQ_0 = prove (`!m n. (m * n = 0) <=> (m = 0) \/ (n = 0)`, REPEAT INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; NOT_SUC]);; let EQ_MULT_LCANCEL = prove (`!m n p. (m * n = m * p) <=> (m = 0) \/ (n = p)`, INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; NOT_SUC] THEN REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; GSYM NOT_SUC; NOT_SUC] THEN ASM_REWRITE_TAC[SUC_INJ; GSYM ADD_ASSOC; EQ_ADD_LCANCEL]);; let EQ_MULT_RCANCEL = prove (`!m n p. (m * p = n * p) <=> (m = n) \/ (p = 0)`, ONCE_REWRITE_TAC[MULT_SYM; DISJ_SYM] THEN MATCH_ACCEPT_TAC EQ_MULT_LCANCEL);; let MULT_2 = prove (`!n. 2 * n = n + n`, GEN_TAC THEN REWRITE_TAC[BIT0_THM; MULT_CLAUSES; RIGHT_ADD_DISTRIB]);; let MULT_EQ_1 = prove (`!m n. (m * n = 1) <=> (m = 1) /\ (n = 1)`, INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC [MULT_CLAUSES; ADD_CLAUSES; BIT0_THM; BIT1_THM; GSYM NOT_SUC] THEN REWRITE_TAC[SUC_INJ; ADD_EQ_0; MULT_EQ_0] THEN CONV_TAC TAUT);; (* ------------------------------------------------------------------------- *) (* Exponentiation. *) (* ------------------------------------------------------------------------- *) let EXP = new_recursive_definition num_RECURSION `(!m. m EXP 0 = 1) /\ (!m n. m EXP (SUC n) = m * (m EXP n))`;; let EXP_EQ_0 = prove (`!m n. (m EXP n = 0) <=> (m = 0) /\ ~(n = 0)`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC [BIT1_THM; NOT_SUC; NOT_SUC; EXP; MULT_CLAUSES; ADD_CLAUSES; ADD_EQ_0]);; let EXP_EQ_1 = prove (`!x n. x EXP n = 1 <=> x = 1 \/ n = 0`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_EQ_1; NOT_SUC] THEN CONV_TAC TAUT);; let EXP_ZERO = prove (`!n. 0 EXP n = if n = 0 then 1 else 0`, GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[EXP_EQ_0; EXP_EQ_1]);; let EXP_ADD = prove (`!m n p. m EXP (n + p) = (m EXP n) * (m EXP p)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; ADD_CLAUSES; MULT_CLAUSES; MULT_AC]);; let EXP_ONE = prove (`!n. 1 EXP n = 1`, INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES]);; let EXP_1 = prove (`!n. n EXP 1 = n`, REWRITE_TAC[ONE; EXP; MULT_CLAUSES; ADD_CLAUSES]);; let EXP_2 = prove (`!n. n EXP 2 = n * n`, REWRITE_TAC[BIT0_THM; BIT1_THM; EXP; EXP_ADD; MULT_CLAUSES; ADD_CLAUSES]);; let MULT_EXP = prove (`!p m n. (m * n) EXP p = m EXP p * n EXP p`, INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES; MULT_AC]);; let EXP_MULT = prove (`!m n p. m EXP (n * p) = (m EXP n) EXP p`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EXP_ADD; EXP; MULT_CLAUSES] THENL [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES]; REWRITE_TAC[MULT_EXP] THEN MATCH_ACCEPT_TAC MULT_SYM]);; (* ------------------------------------------------------------------------- *) (* Define the orderings recursively too. *) (* ------------------------------------------------------------------------- *) let LE = new_recursive_definition num_RECURSION `(!m. (m <= 0) <=> (m = 0)) /\ (!m n. (m <= SUC n) <=> (m = SUC n) \/ (m <= n))`;; let LT = new_recursive_definition num_RECURSION `(!m. (m < 0) <=> F) /\ (!m n. (m < SUC n) <=> (m = n) \/ (m < n))`;; let GE = new_definition `m >= n <=> n <= m`;; let GT = new_definition `m > n <=> n < m`;; (* ------------------------------------------------------------------------- *) (* Maximum and minimum of natural numbers. *) (* ------------------------------------------------------------------------- *) let MAX = new_definition `!m n. MAX m n = if m <= n then n else m`;; let MIN = new_definition `!m n. MIN m n = if m <= n then m else n`;; (* ------------------------------------------------------------------------- *) (* Step cases. *) (* ------------------------------------------------------------------------- *) let LE_SUC_LT = prove (`!m n. (SUC m <= n) <=> (m < n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LE; LT; NOT_SUC; SUC_INJ]);; let LT_SUC_LE = prove (`!m n. (m < SUC n) <=> (m <= n)`, GEN_TAC THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[LT; LE] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LT]);; let LE_SUC = prove (`!m n. (SUC m <= SUC n) <=> (m <= n)`, REWRITE_TAC[LE_SUC_LT; LT_SUC_LE]);; let LT_SUC = prove (`!m n. (SUC m < SUC n) <=> (m < n)`, REWRITE_TAC[LT_SUC_LE; LE_SUC_LT]);; (* ------------------------------------------------------------------------- *) (* Base cases. *) (* ------------------------------------------------------------------------- *) let LE_0 = prove (`!n. 0 <= n`, INDUCT_TAC THEN ASM_REWRITE_TAC[LE]);; let LT_0 = prove (`!n. 0 < SUC n`, REWRITE_TAC[LT_SUC_LE; LE_0]);; (* ------------------------------------------------------------------------- *) (* Reflexivity. *) (* ------------------------------------------------------------------------- *) let LE_REFL = prove (`!n. n <= n`, INDUCT_TAC THEN REWRITE_TAC[LE]);; let LT_REFL = prove (`!n. ~(n < n)`, INDUCT_TAC THEN ASM_REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[LT]);; (* ------------------------------------------------------------------------- *) (* Antisymmetry. *) (* ------------------------------------------------------------------------- *) let LE_ANTISYM = prove (`!m n. (m <= n /\ n <= m) <=> (m = n)`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; SUC_INJ] THEN REWRITE_TAC[LE; NOT_SUC; GSYM NOT_SUC]);; let LT_ANTISYM = prove (`!m n. ~(m < n /\ n < m)`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[LT]);; let LET_ANTISYM = prove (`!m n. ~(m <= n /\ n < m)`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC] THEN REWRITE_TAC[LE; LT; NOT_SUC]);; let LTE_ANTISYM = prove (`!m n. ~(m < n /\ n <= m)`, ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[LET_ANTISYM]);; (* ------------------------------------------------------------------------- *) (* Transitivity. *) (* ------------------------------------------------------------------------- *) let LE_TRANS = prove (`!m n p. m <= n /\ n <= p ==> m <= p`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LE_0] THEN REWRITE_TAC[LE; NOT_SUC]);; let LT_TRANS = prove (`!m n p. m < n /\ n < p ==> m < p`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LT_SUC; LT_0] THEN REWRITE_TAC[LT; NOT_SUC]);; let LET_TRANS = prove (`!m n p. m <= n /\ n < p ==> m < p`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC; LT_0] THEN REWRITE_TAC[LT; LE; NOT_SUC]);; let LTE_TRANS = prove (`!m n p. m < n /\ n <= p ==> m < p`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC; LT_0] THEN REWRITE_TAC[LT; LE; NOT_SUC]);; (* ------------------------------------------------------------------------- *) (* Totality. *) (* ------------------------------------------------------------------------- *) let LE_CASES = prove (`!m n. m <= n \/ n <= m`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_0; LE_SUC]);; let LT_CASES = prove (`!m n. (m < n) \/ (n < m) \/ (m = n)`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LT_SUC; SUC_INJ] THEN REWRITE_TAC[LT; NOT_SUC; GSYM NOT_SUC] THEN W(W (curry SPEC_TAC) o hd o frees o snd) THEN INDUCT_TAC THEN REWRITE_TAC[LT_0]);; let LET_CASES = prove (`!m n. m <= n \/ n < m`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC_LT; LT_SUC_LE; LE_0]);; let LTE_CASES = prove (`!m n. m < n \/ n <= m`, ONCE_REWRITE_TAC[DISJ_SYM] THEN MATCH_ACCEPT_TAC LET_CASES);; (* ------------------------------------------------------------------------- *) (* Relationship between orderings. *) (* ------------------------------------------------------------------------- *) let LE_LT = prove (`!m n. (m <= n) <=> (m < n) \/ (m = n)`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC; SUC_INJ; LE_0; LT_0] THEN REWRITE_TAC[LE; LT]);; let LT_LE = prove (`!m n. (m < n) <=> (m <= n) /\ ~(m = n)`, REWRITE_TAC[LE_LT] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[LT_REFL]; DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[]]);; let NOT_LE = prove (`!m n. ~(m <= n) <=> (n < m)`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC] THEN REWRITE_TAC[LE; LT; NOT_SUC; GSYM NOT_SUC; LE_0] THEN W(W (curry SPEC_TAC) o hd o frees o snd) THEN INDUCT_TAC THEN REWRITE_TAC[LT_0]);; let NOT_LT = prove (`!m n. ~(m < n) <=> n <= m`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC] THEN REWRITE_TAC[LE; LT; NOT_SUC; GSYM NOT_SUC; LE_0] THEN W(W (curry SPEC_TAC) o hd o frees o snd) THEN INDUCT_TAC THEN REWRITE_TAC[LT_0]);; let LT_IMP_LE = prove (`!m n. m < n ==> m <= n`, REWRITE_TAC[LT_LE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; let EQ_IMP_LE = prove (`!m n. (m = n) ==> m <= n`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Often useful to shuffle between different versions of "0 < n". *) (* ------------------------------------------------------------------------- *) let LT_NZ = prove (`!n. 0 < n <=> ~(n = 0)`, INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC; LT; EQ_SYM_EQ] THEN CONV_TAC TAUT);; let LE_1 = prove (`(!n. ~(n = 0) ==> 0 < n) /\ (!n. ~(n = 0) ==> 1 <= n) /\ (!n. 0 < n ==> ~(n = 0)) /\ (!n. 0 < n ==> 1 <= n) /\ (!n. 1 <= n ==> 0 < n) /\ (!n. 1 <= n ==> ~(n = 0))`, REWRITE_TAC[LT_NZ; GSYM NOT_LT; ONE; LT]);; (* ------------------------------------------------------------------------- *) (* Relate the orderings to arithmetic operations. *) (* ------------------------------------------------------------------------- *) let LE_EXISTS = prove (`!m n. (m <= n) <=> (?d. n = m + d)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LE] THENL [REWRITE_TAC[CONV_RULE(LAND_CONV SYM_CONV) (SPEC_ALL ADD_EQ_0)] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL]; EQ_TAC THENL [DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THENL [EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES]; DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN EXISTS_TAC `SUC d` THEN REWRITE_TAC[ADD_CLAUSES]]; ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN DISJ2_TAC THEN REWRITE_TAC[EQ_ADD_LCANCEL; GSYM EXISTS_REFL]]]);; let LT_EXISTS = prove (`!m n. (m < n) <=> (?d. n = m + SUC d)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT; ADD_CLAUSES; GSYM NOT_SUC] THEN ASM_REWRITE_TAC[SUC_INJ] THEN EQ_TAC THENL [DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THENL [EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES]; DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN EXISTS_TAC `SUC d` THEN REWRITE_TAC[ADD_CLAUSES]]; ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN DISJ2_TAC THEN REWRITE_TAC[SUC_INJ; EQ_ADD_LCANCEL; GSYM EXISTS_REFL]]);; (* ------------------------------------------------------------------------- *) (* Interaction with addition. *) (* ------------------------------------------------------------------------- *) let LE_ADD = prove (`!m n. m <= m + n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LE; ADD_CLAUSES; LE_REFL]);; let LE_ADDR = prove (`!m n. n <= m + n`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LE_ADD);; let LT_ADD = prove (`!m n. (m < m + n) <=> (0 < n)`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_SUC]);; let LT_ADDR = prove (`!m n. (n < m + n) <=> (0 < m)`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LT_ADD);; let LE_ADD_LCANCEL = prove (`!m n p. (m + n) <= (m + p) <=> n <= p`, REWRITE_TAC[LE_EXISTS; GSYM ADD_ASSOC; EQ_ADD_LCANCEL]);; let LE_ADD_RCANCEL = prove (`!m n p. (m + p) <= (n + p) <=> (m <= n)`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LE_ADD_LCANCEL);; let LT_ADD_LCANCEL = prove (`!m n p. (m + n) < (m + p) <=> n < p`, REWRITE_TAC[LT_EXISTS; GSYM ADD_ASSOC; EQ_ADD_LCANCEL; SUC_INJ]);; let LT_ADD_RCANCEL = prove (`!m n p. (m + p) < (n + p) <=> (m < n)`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LT_ADD_LCANCEL);; let LE_ADD2 = prove (`!m n p q. m <= p /\ n <= q ==> m + n <= p + q`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num`) (X_CHOOSE_TAC `b:num`)) THEN EXISTS_TAC `a + b` THEN ASM_REWRITE_TAC[ADD_AC]);; let LET_ADD2 = prove (`!m n p q. m <= p /\ n < q ==> m + n < p + q`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS; LT_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num`) (X_CHOOSE_TAC `b:num`)) THEN EXISTS_TAC `a + b` THEN ASM_REWRITE_TAC[SUC_INJ; ADD_CLAUSES; ADD_AC]);; let LTE_ADD2 = prove (`!m n p q. m < p /\ n <= q ==> m + n < p + q`, ONCE_REWRITE_TAC[ADD_SYM; CONJ_SYM] THEN MATCH_ACCEPT_TAC LET_ADD2);; let LT_ADD2 = prove (`!m n p q. m < p /\ n < q ==> m + n < p + q`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* And multiplication. *) (* ------------------------------------------------------------------------- *) let LT_MULT = prove (`!m n. (0 < m * n) <=> (0 < m) /\ (0 < n)`, REPEAT INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LT_0]);; let LE_MULT2 = prove (`!m n p q. m <= n /\ p <= q ==> m * p <= n * q`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num`) (X_CHOOSE_TAC `b:num`)) THEN EXISTS_TAC `a * p + m * b + a * b` THEN ASM_REWRITE_TAC[LEFT_ADD_DISTRIB] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; ADD_ASSOC]);; let LT_LMULT = prove (`!m n p. ~(m = 0) /\ n < p ==> m * n < m * p`, REPEAT GEN_TAC THEN REWRITE_TAC[LT_LE] THEN STRIP_TAC THEN CONJ_TAC THENL [MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[LE_REFL]; ASM_REWRITE_TAC[EQ_MULT_LCANCEL]]);; let LE_MULT_LCANCEL = prove (`!m n p. (m * n) <= (m * p) <=> (m = 0) \/ n <= p`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LE_REFL; LE_0; NOT_SUC] THEN REWRITE_TAC[LE_SUC] THEN REWRITE_TAC[LE; LE_ADD_LCANCEL; GSYM ADD_ASSOC] THEN ASM_REWRITE_TAC[GSYM(el 4(CONJUNCTS MULT_CLAUSES)); NOT_SUC]);; let LE_MULT_RCANCEL = prove (`!m n p. (m * p) <= (n * p) <=> (m <= n) \/ (p = 0)`, ONCE_REWRITE_TAC[MULT_SYM; DISJ_SYM] THEN MATCH_ACCEPT_TAC LE_MULT_LCANCEL);; let LT_MULT_LCANCEL = prove (`!m n p. (m * n) < (m * p) <=> ~(m = 0) /\ n < p`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LT_REFL; LT_0; NOT_SUC] THEN REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[LT; LT_ADD_LCANCEL; GSYM ADD_ASSOC] THEN ASM_REWRITE_TAC[GSYM(el 4(CONJUNCTS MULT_CLAUSES)); NOT_SUC]);; let LT_MULT_RCANCEL = prove (`!m n p. (m * p) < (n * p) <=> (m < n) /\ ~(p = 0)`, ONCE_REWRITE_TAC[MULT_SYM; CONJ_SYM] THEN MATCH_ACCEPT_TAC LT_MULT_LCANCEL);; let LT_MULT2 = prove (`!m n p q. m < n /\ p < q ==> m * p < n * q`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n * p` THEN ASM_SIMP_TAC[LE_MULT_RCANCEL; LT_IMP_LE; LT_MULT_LCANCEL] THEN UNDISCH_TAC `m < n` THEN CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[LT]);; let LE_SQUARE_REFL = prove (`!n. n <= n * n`, INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; LE_0; LE_ADDR]);; let LT_POW2_REFL = prove (`!n. n < 2 EXP n`, INDUCT_TAC THEN REWRITE_TAC[EXP] THEN REWRITE_TAC[MULT_2; ADD1] THEN REWRITE_TAC[ONE; LT] THEN MATCH_MP_TAC LTE_ADD2 THEN ASM_REWRITE_TAC[LE_SUC_LT; TWO] THEN MESON_TAC[EXP_EQ_0; LE_1; NOT_SUC]);; (* ------------------------------------------------------------------------- *) (* Useful "without loss of generality" lemmas. *) (* ------------------------------------------------------------------------- *) let WLOG_LE = prove (`(!m n. P m n <=> P n m) /\ (!m n. m <= n ==> P m n) ==> !m n. P m n`, MESON_TAC[LE_CASES]);; let WLOG_LT = prove (`(!m. P m m) /\ (!m n. P m n <=> P n m) /\ (!m n. m < n ==> P m n) ==> !m y. P m y`, MESON_TAC[LT_CASES]);; (* ------------------------------------------------------------------------- *) (* Existence of least and greatest elements of (finite) set. *) (* ------------------------------------------------------------------------- *) let num_WF = prove (`!P. (!n. (!m. m < n ==> P m) ==> P n) ==> !n. P n`, GEN_TAC THEN MP_TAC(SPEC `\n. !m. m < n ==> P m` num_INDUCTION) THEN REWRITE_TAC[LT; BETA_THM] THEN MESON_TAC[LT]);; let num_WOP = prove (`!P. (?n. P n) <=> (?n. P(n) /\ !m. m < n ==> ~P(m))`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN ASM_MESON_TAC[]);; let num_MAX = prove (`!P. (?x. P x) /\ (?M. !x. P x ==> x <= M) <=> ?m. P m /\ (!x. P x ==> x <= m)`, GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num`) MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC o ONCE_REWRITE_RULE[num_WOP]) THEN DISCH_THEN(fun th -> EXISTS_TAC `m:num` THEN MP_TAC th) THEN REWRITE_TAC[TAUT `(a /\ b ==> c /\ a) <=> (a /\ b ==> c)`] THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[LE; LT] THEN DISCH_THEN(IMP_RES_THEN SUBST_ALL_TAC) THEN POP_ASSUM ACCEPT_TAC; DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `m:num`)) THEN REWRITE_TAC[LT] THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN REWRITE_TAC[] THEN X_GEN_TAC `p:num` THEN FIRST_ASSUM(MP_TAC o SPEC `p:num`) THEN REWRITE_TAC[LE] THEN ASM_CASES_TAC `p = SUC m` THEN ASM_REWRITE_TAC[]]; REPEAT STRIP_TAC THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Another variant of induction. *) (* ------------------------------------------------------------------------- *) let LE_INDUCT = prove (`!P. (!m:num. P m m) /\ (!m n. m <= n /\ P m n ==> P m (SUC n)) ==> (!m n. m <= n ==> P m n)`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; MESON[LE_EXISTS] `(!m n:num. m <= n ==> R m n) <=> (!m d. R m (m + d))`] THEN REPEAT DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Oddness and evenness (recursively rather than inductively!) *) (* ------------------------------------------------------------------------- *) let EVEN = new_recursive_definition num_RECURSION `(EVEN 0 <=> T) /\ (!n. EVEN (SUC n) <=> ~(EVEN n))`;; let ODD = new_recursive_definition num_RECURSION `(ODD 0 <=> F) /\ (!n. ODD (SUC n) <=> ~(ODD n))`;; let NOT_EVEN = prove (`!n. ~(EVEN n) <=> ODD n`, INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; ODD]);; let NOT_ODD = prove (`!n. ~(ODD n) <=> EVEN n`, INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; ODD]);; let EVEN_OR_ODD = prove (`!n. EVEN n \/ ODD n`, INDUCT_TAC THEN REWRITE_TAC[EVEN; ODD; NOT_EVEN; NOT_ODD] THEN ONCE_REWRITE_TAC[DISJ_SYM] THEN ASM_REWRITE_TAC[]);; let EVEN_AND_ODD = prove (`!n. ~(EVEN n /\ ODD n)`, REWRITE_TAC[GSYM NOT_EVEN; ITAUT `~(p /\ ~p)`]);; let EVEN_ADD = prove (`!m n. EVEN(m + n) <=> (EVEN m <=> EVEN n)`, INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; ADD_CLAUSES] THEN X_GEN_TAC `p:num` THEN DISJ_CASES_THEN MP_TAC (SPEC `n:num` EVEN_OR_ODD) THEN DISJ_CASES_THEN MP_TAC (SPEC `p:num` EVEN_OR_ODD) THEN REWRITE_TAC[GSYM NOT_EVEN] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; let EVEN_MULT = prove (`!m n. EVEN(m * n) <=> EVEN(m) \/ EVEN(n)`, INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; EVEN_ADD; EVEN] THEN X_GEN_TAC `p:num` THEN DISJ_CASES_THEN MP_TAC (SPEC `n:num` EVEN_OR_ODD) THEN DISJ_CASES_THEN MP_TAC (SPEC `p:num` EVEN_OR_ODD) THEN REWRITE_TAC[GSYM NOT_EVEN] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; let EVEN_EXP = prove (`!m n. EVEN(m EXP n) <=> EVEN(m) /\ ~(n = 0)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; EXP; ONE; EVEN_MULT; NOT_SUC] THEN CONV_TAC ITAUT);; let ODD_ADD = prove (`!m n. ODD(m + n) <=> ~(ODD m <=> ODD n)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NOT_EVEN; EVEN_ADD] THEN CONV_TAC ITAUT);; let ODD_MULT = prove (`!m n. ODD(m * n) <=> ODD(m) /\ ODD(n)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NOT_EVEN; EVEN_MULT] THEN CONV_TAC ITAUT);; let ODD_EXP = prove (`!m n. ODD(m EXP n) <=> ODD(m) \/ (n = 0)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ODD; EXP; ONE; ODD_MULT; NOT_SUC] THEN CONV_TAC ITAUT);; let EVEN_DOUBLE = prove (`!n. EVEN(2 * n)`, GEN_TAC THEN REWRITE_TAC[EVEN_MULT] THEN DISJ1_TAC THEN PURE_REWRITE_TAC[BIT0_THM; BIT1_THM] THEN REWRITE_TAC[EVEN; EVEN_ADD]);; let ODD_DOUBLE = prove (`!n. ODD(SUC(2 * n))`, REWRITE_TAC[ODD] THEN REWRITE_TAC[NOT_ODD; EVEN_DOUBLE]);; let EVEN_EXISTS_LEMMA = prove (`!n. (EVEN n ==> ?m. n = 2 * m) /\ (~EVEN n ==> ?m. n = SUC(2 * m))`, INDUCT_TAC THEN REWRITE_TAC[EVEN] THENL [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES]; POP_ASSUM STRIP_ASSUME_TAC THEN CONJ_TAC THEN DISCH_THEN(ANTE_RES_THEN(X_CHOOSE_TAC `m:num`)) THENL [EXISTS_TAC `SUC m` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MULT_2] THEN REWRITE_TAC[ADD_CLAUSES]; EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]]]);; let EVEN_EXISTS = prove (`!n. EVEN n <=> ?m. n = 2 * m`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MATCH_MP_TAC(CONJUNCT1(SPEC_ALL EVEN_EXISTS_LEMMA)) THEN ASM_REWRITE_TAC[]; POP_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[EVEN_DOUBLE]]);; let ODD_EXISTS = prove (`!n. ODD n <=> ?m. n = SUC(2 * m)`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MATCH_MP_TAC(CONJUNCT2(SPEC_ALL EVEN_EXISTS_LEMMA)) THEN ASM_REWRITE_TAC[NOT_EVEN]; POP_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[ODD_DOUBLE]]);; let EVEN_ODD_DECOMPOSITION = prove (`!n. (?k m. ODD m /\ (n = 2 EXP k * m)) <=> ~(n = 0)`, MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THENL [ALL_TAC; ASM_MESON_TAC[ODD; EXP; MULT_CLAUSES]] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_EQ_0] THENL [REWRITE_TAC[MULT_CLAUSES; LT] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[EXP_EQ_0; MULT_EQ_0; TWO; NOT_SUC] THEN MESON_TAC[ODD]; ALL_TAC] THEN ANTS_TAC THENL [GEN_REWRITE_TAC LAND_CONV [GSYM(el 2 (CONJUNCTS MULT_CLAUSES))] THEN ASM_REWRITE_TAC[LT_MULT_RCANCEL; TWO; LT]; ALL_TAC] THEN REWRITE_TAC[TWO; NOT_SUC] THEN REWRITE_TAC[GSYM TWO] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[EXP; MULT_ASSOC]);; (* ------------------------------------------------------------------------- *) (* Cutoff subtraction, also defined recursively. (Not the HOL88 defn.) *) (* ------------------------------------------------------------------------- *) let SUB = new_recursive_definition num_RECURSION `(!m. m - 0 = m) /\ (!m n. m - (SUC n) = PRE(m - n))`;; let SUB_0 = prove (`!m. (0 - m = 0) /\ (m - 0 = m)`, REWRITE_TAC[SUB] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[SUB; PRE]);; let SUB_PRESUC = prove (`!m n. PRE(SUC m - n) = m - n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[SUB; PRE]);; let SUB_SUC = prove (`!m n. SUC m - SUC n = m - n`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[SUB; PRE; SUB_PRESUC]);; let SUB_REFL = prove (`!n. n - n = 0`, INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_SUC; SUB_0]);; let ADD_SUB = prove (`!m n. (m + n) - n = m`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUB_SUC; SUB_0]);; let ADD_SUB2 = prove (`!m n. (m + n) - m = n`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC ADD_SUB);; let SUB_EQ_0 = prove (`!m n. (m - n = 0) <=> m <= n`, REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_SUC; LE_SUC; SUB_0] THEN REWRITE_TAC[LE; LE_0]);; let ADD_SUBR2 = prove (`!m n. m - (m + n) = 0`, REWRITE_TAC[SUB_EQ_0; LE_ADD]);; let ADD_SUBR = prove (`!m n. n - (m + n) = 0`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC ADD_SUBR2);; let SUB_ADD = prove (`!m n. n <= m ==> ((m - n) + n = m)`, REWRITE_TAC[LE_EXISTS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN MATCH_ACCEPT_TAC ADD_SYM);; let SUB_ADD_LCANCEL = prove (`!m n p. (m + n) - (m + p) = n - p`, INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUB_0; SUB_SUC]);; let SUB_ADD_RCANCEL = prove (`!m n p. (m + p) - (n + p) = m - n`, ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC SUB_ADD_LCANCEL);; let LEFT_SUB_DISTRIB = prove (`!m n p. m * (n - p) = m * n - m * p`, REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN DISJ_CASES_TAC(SPECL [`n:num`; `p:num`] LE_CASES) THENL [FIRST_ASSUM(fun th -> REWRITE_TAC[REWRITE_RULE[GSYM SUB_EQ_0] th]) THEN ASM_REWRITE_TAC[MULT_CLAUSES; SUB_EQ_0; LE_MULT_LCANCEL]; POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[LEFT_ADD_DISTRIB] THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB]]);; let RIGHT_SUB_DISTRIB = prove (`!m n p. (m - n) * p = m * p - n * p`, ONCE_REWRITE_TAC[MULT_SYM] THEN MATCH_ACCEPT_TAC LEFT_SUB_DISTRIB);; let SUC_SUB1 = prove (`!n. SUC n - 1 = n`, REWRITE_TAC[ONE; SUB_SUC; SUB_0]);; let EVEN_SUB = prove (`!m n. EVEN(m - n) <=> m <= n \/ (EVEN(m) <=> EVEN(n))`, REPEAT GEN_TAC THEN ASM_CASES_TAC `m <= n:num` THENL [ASM_MESON_TAC[SUB_EQ_0; EVEN]; ALL_TAC] THEN DISJ_CASES_TAC(SPECL [`m:num`; `n:num`] LE_CASES) THEN ASM_SIMP_TAC[] THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN` o MATCH_MP SUB_ADD) THEN ASM_MESON_TAC[EVEN_ADD]);; let ODD_SUB = prove (`!m n. ODD(m - n) <=> n < m /\ ~(ODD m <=> ODD n)`, REWRITE_TAC[GSYM NOT_EVEN; EVEN_SUB; DE_MORGAN_THM; NOT_LE] THEN CONV_TAC TAUT);; (* ------------------------------------------------------------------------- *) (* The factorial function. *) (* ------------------------------------------------------------------------- *) let FACT = new_recursive_definition num_RECURSION `(FACT 0 = 1) /\ (!n. FACT (SUC n) = (SUC n) * FACT(n))`;; let FACT_LT = prove (`!n. 0 < FACT n`, INDUCT_TAC THEN ASM_REWRITE_TAC[FACT; LT_MULT] THEN REWRITE_TAC[ONE; LT_0]);; let FACT_LE = prove (`!n. 1 <= FACT n`, REWRITE_TAC[ONE; LE_SUC_LT; FACT_LT]);; let FACT_NZ = prove (`!n. ~(FACT n = 0)`, REWRITE_TAC[GSYM LT_NZ; FACT_LT]);; let FACT_MONO = prove (`!m n. m <= n ==> FACT m <= FACT n`, REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN REWRITE_TAC[FACT] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `FACT(m + d)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM(el 2 (CONJUNCTS MULT_CLAUSES))] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN REWRITE_TAC[ONE; LE_SUC; LE_0]);; (* ------------------------------------------------------------------------- *) (* More complicated theorems about exponential. *) (* ------------------------------------------------------------------------- *) let EXP_LT_0 = prove (`!n x. 0 < x EXP n <=> ~(x = 0) \/ (n = 0)`, REWRITE_TAC[GSYM NOT_LE; LE; EXP_EQ_0; DE_MORGAN_THM]);; let LT_EXP = prove (`!x m n. x EXP m < x EXP n <=> 2 <= x /\ m < n \/ (x = 0) /\ ~(m = 0) /\ (n = 0)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `x = 0` THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC[GSYM NOT_LT; TWO; ONE; LT] THEN SPEC_TAC (`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[EXP; NOT_SUC; MULT_CLAUSES; LT] THEN SPEC_TAC (`m:num`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_CLAUSES; NOT_SUC; LT_REFL; LT] THEN REWRITE_TAC[ONE; LT_0]; ALL_TAC] THEN EQ_TAC THENL [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LT; DE_MORGAN_THM; NOT_LE] THEN REWRITE_TAC[TWO; ONE; LT] THEN ASM_REWRITE_TAC[SYM ONE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[EXP_ONE; LE_REFL] THEN FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP; LE_REFL] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `1 * x EXP (n + d)` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[MULT_CLAUSES]; REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN UNDISCH_TAC `~(x = 0)` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN REWRITE_TAC[ONE; LT]]; STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LT_EXISTS]) THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP] THENL [MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `2 * x EXP m` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[MULT_2; LT_ADD; EXP_LT_0]; ASM_REWRITE_TAC[LE_MULT_RCANCEL]]; MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `x EXP (m + SUC d)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ADD_CLAUSES; EXP; MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `x * 1` THEN CONJ_TAC THENL [REWRITE_TAC[MULT_CLAUSES; LE_REFL]; REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN UNDISCH_TAC `~(x = 0)` THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN REWRITE_TAC[ONE; LT]]]]);; let LE_EXP = prove (`!x m n. x EXP m <= x EXP n <=> if x = 0 then (m = 0) ==> (n = 0) else (x = 1) \/ m <= n`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NOT_LT; LT_EXP; DE_MORGAN_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[TWO; LT; ONE] THEN CONV_TAC(EQT_INTRO o TAUT));; let EQ_EXP = prove (`!x m n. x EXP m = x EXP n <=> if x = 0 then (m = 0 <=> n = 0) else (x = 1) \/ m = n`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM LE_ANTISYM; LE_EXP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_EXP] THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONV_TAC TAUT);; let EXP_MONO_LE_IMP = prove (`!x y n. x <= y ==> x EXP n <= y EXP n`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[LE_MULT2; EXP; LE_REFL]);; let EXP_MONO_LT_IMP = prove (`!x y n. x < y /\ ~(n = 0) ==> x EXP n < y EXP n`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; EXP] THEN DISCH_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `x * y EXP n` THEN ASM_SIMP_TAC[LT_IMP_LE; LE_MULT_LCANCEL; LT_MULT_RCANCEL; EXP_MONO_LE_IMP; EXP_EQ_0] THEN ASM_MESON_TAC[CONJUNCT1 LT]);; let EXP_MONO_LE = prove (`!x y n. x EXP n <= y EXP n <=> x <= y \/ n = 0`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[EXP; LE_REFL; EXP_MONO_LE_IMP] THEN ASM_MESON_TAC[NOT_LE; EXP_MONO_LT_IMP]);; let EXP_MONO_LT = prove (`!x y n. x EXP n < y EXP n <=> x < y /\ ~(n = 0)`, REWRITE_TAC[GSYM NOT_LE; EXP_MONO_LE; DE_MORGAN_THM]);; let EXP_MONO_EQ = prove (`!x y n. x EXP n = y EXP n <=> x = y \/ n = 0`, REWRITE_TAC[GSYM LE_ANTISYM; EXP_MONO_LE] THEN CONV_TAC TAUT);; (* ------------------------------------------------------------------------- *) (* Division and modulus, via existence proof of their basic property. *) (* ------------------------------------------------------------------------- *) let DIVMOD_EXIST = prove (`!m n. ~(n = 0) ==> ?q r. (m = q * n + r) /\ r < n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\r. ?q. m = q * n + r` num_WOP) THEN BETA_TAC THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`m:num`; `0`]) THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `q:num`) MP_TAC) THEN DISCH_THEN(fun th -> MAP_EVERY EXISTS_TAC [`q:num`; `r:num`] THEN MP_TAC th) THEN CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[NOT_LT] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `d:num` THEN REWRITE_TAC[NOT_IMP; RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `q + 1` THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_CLAUSES; ADD_ASSOC; LT_ADDR] THEN ASM_REWRITE_TAC[GSYM NOT_LE; LE]);; let DIVMOD_EXIST_0 = prove (`!m n. ?q r. if n = 0 then q = 0 /\ r = m else m = q * n + r /\ r < n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[DIVMOD_EXIST; RIGHT_EXISTS_AND_THM; EXISTS_REFL]);; let DIVISION_0 = new_specification ["DIV"; "MOD"] (REWRITE_RULE[SKOLEM_THM] DIVMOD_EXIST_0);; let DIVISION = prove (`!m n. ~(n = 0) ==> (m = m DIV n * n + m MOD n) /\ m MOD n < n`, MESON_TAC[DIVISION_0]);; let DIVISION_SIMP = prove (`(!m n. ~(n = 0) ==> m DIV n * n + m MOD n = m) /\ (!m n. ~(n = 0) ==> n * m DIV n + m MOD n = m)`, MESON_TAC[DIVISION; MULT_SYM]);; let DIVMOD_UNIQ_LEMMA = prove (`!m n q1 r1 q2 r2. ((m = q1 * n + r1) /\ r1 < n) /\ ((m = q2 * n + r2) /\ r2 < n) ==> (q1 = q2) /\ (r1 = r2)`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `r1:num = r2` MP_TAC THENL [UNDISCH_TAC `m = q2 * n + r2` THEN ASM_REWRITE_TAC[] THEN DISJ_CASES_THEN MP_TAC (SPECL [`q1:num`; `q2:num`] LE_CASES) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; EQ_ADD_LCANCEL] THENL [DISCH_TAC THEN UNDISCH_TAC `r1 < n`; DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `r2 < n`] THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; GSYM NOT_LE; LE_ADD; GSYM ADD_ASSOC]; DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN UNDISCH_TAC `m = q1 * n + r2` THEN ASM_REWRITE_TAC[EQ_ADD_RCANCEL; EQ_MULT_RCANCEL] THEN REPEAT (UNDISCH_TAC `r2 < n`) THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[GSYM NOT_LE; LE_0]]);; let DIVMOD_UNIQ = prove (`!m n q r. (m = q * n + r) /\ r < n ==> (m DIV n = q) /\ (m MOD n = r)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC o GSYM) THEN MATCH_MP_TAC DIVMOD_UNIQ_LEMMA THEN MAP_EVERY EXISTS_TAC [`m:num`; `n:num`] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION THEN DISCH_TAC THEN UNDISCH_TAC `r < n` THEN ASM_REWRITE_TAC[GSYM NOT_LE; LE_0]);; let MOD_UNIQ = prove (`!m n q r. (m = q * n + r) /\ r < n ==> (m MOD n = r)`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP DIVMOD_UNIQ th]));; let DIV_UNIQ = prove (`!m n q r. (m = q * n + r) /\ r < n ==> (m DIV n = q)`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP DIVMOD_UNIQ th]));; let DIV_MULT,MOD_MULT = (CONJ_PAIR o prove) (`(!m n. ~(m = 0) ==> (m * n) DIV m = n) /\ (!m n. ~(m = 0) ==> (m * n) MOD m = 0)`, SIMP_TAC[AND_FORALL_THM; TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIVMOD_UNIQ THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; MULT_AC; LT_NZ]);; let MOD_LT = prove (`!m n. m < n ==> (m MOD n = m)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]);; let MOD_EQ = prove (`!m n p q. (m = n + q * p) ==> (m MOD p = n MOD p)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `p = 0` THENL [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC; DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `q + n DIV p` THEN POP_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM o SPEC `n:num`) THEN ASM_REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN MATCH_ACCEPT_TAC ADD_SYM]);; let DIV_LE = prove (`!m n. ~(n = 0) ==> m DIV n <= m`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [MATCH_MP DIVISION th]) THEN UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; GSYM ADD_ASSOC; LE_ADD]);; let DIV_MUL_LE = prove (`!m n. n * (m DIV n) <= m`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LE_0] THEN POP_ASSUM(MP_TAC o SPEC `m:num` o MATCH_MP DIVISION) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [CONJUNCT1 th]) THEN REWRITE_TAC[LE_ADD; MULT_AC]);; let DIV_0,MOD_0 = (CONJ_PAIR o prove) (`(!n. ~(n = 0) ==> 0 DIV n = 0) /\ (!n. ~(n = 0) ==> 0 MOD n = 0)`, SIMP_TAC[AND_FORALL_THM; TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIVMOD_UNIQ THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LT_NZ]);; let DIV_1,MOD_1 = (CONJ_PAIR o prove) (`(!n. n DIV 1 = n) /\ (!n. n MOD 1 = 0)`, SIMP_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC DIVMOD_UNIQ THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[ONE; LT]);; let DIV_LT = prove (`!m n. m < n ==> (m DIV n = 0)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]);; let MOD_MOD = prove (`!m n p. ~(n * p = 0) ==> ((m MOD (n * p)) MOD n = m MOD n)`, REPEAT GEN_TAC THEN REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `m DIV (n * p) * p` THEN MP_TAC(SPECL [`m:num`; `n * p:num`] DIVISION) THEN ASM_REWRITE_TAC[MULT_EQ_0; MULT_AC; ADD_AC] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]));; let MOD_MOD_REFL = prove (`!m n. ~(n = 0) ==> ((m MOD n) MOD n = m MOD n)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`m:num`; `n:num`; `1`] MOD_MOD) THEN ASM_REWRITE_TAC[MULT_CLAUSES; MULT_EQ_0] THEN REWRITE_TAC[ONE; NOT_SUC]);; let DIV_MULT2 = prove (`!m n p. ~(m * p = 0) ==> ((m * n) DIV (m * p) = n DIV p)`, REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `m * (n MOD p)` THEN ASM_SIMP_TAC[LT_MULT_LCANCEL; DIVISION] THEN ONCE_REWRITE_TAC[AC MULT_AC `a * b * c:num = b * a * c`] THEN REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; EQ_MULT_LCANCEL] THEN ASM_SIMP_TAC[GSYM DIVISION]);; let MOD_MULT2 = prove (`!m n p. ~(m * p = 0) ==> ((m * n) MOD (m * p) = m * n MOD p)`, REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `n DIV p` THEN ASM_SIMP_TAC[LT_MULT_LCANCEL; DIVISION] THEN ONCE_REWRITE_TAC[AC MULT_AC `a * b * c:num = b * a * c`] THEN REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; EQ_MULT_LCANCEL] THEN ASM_SIMP_TAC[GSYM DIVISION]);; let MOD_EXISTS = prove (`!m n. (?q. m = n * q) <=> if n = 0 then (m = 0) else (m MOD n = 0)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[MOD_MULT] THEN EXISTS_TAC `m DIV n` THEN SUBGOAL_THEN `m = (m DIV n) * n + m MOD n` (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL [ASM_MESON_TAC[DIVISION]; ASM_REWRITE_TAC[ADD_CLAUSES; MULT_AC]]);; let LE_RDIV_EQ = prove (`!a b n. ~(a = 0) ==> (n <= b DIV a <=> a * n <= b)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `a * (b DIV a)` THEN ASM_REWRITE_TAC[DIV_MUL_LE; LE_MULT_LCANCEL]; SUBGOAL_THEN `a * n < a * (b DIV a + 1)` MP_TAC THENL [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `(b DIV a) * a + b MOD a` THEN CONJ_TAC THENL [ASM_MESON_TAC[DIVISION]; ALL_TAC] THEN SIMP_TAC[LEFT_ADD_DISTRIB; MULT_SYM; MULT_CLAUSES; LT_ADD_LCANCEL] THEN ASM_MESON_TAC[DIVISION]; ASM_REWRITE_TAC[LT_MULT_LCANCEL; GSYM ADD1; LT_SUC_LE]]]);; let RDIV_LT_EQ = prove (`!a b n. ~(a = 0) ==> (b DIV a < n <=> b < a * n)`, SIMP_TAC[GSYM NOT_LE; LE_RDIV_EQ]);; let LE_LDIV_EQ = prove (`!a b n. ~(a = 0) ==> (b DIV a <= n <=> b < a * (n + 1))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NOT_LT] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM LE_SUC_LT] THEN ASM_SIMP_TAC[LE_RDIV_EQ] THEN REWRITE_TAC[NOT_LT; NOT_LE; ADD1]);; let LDIV_LT_EQ = prove (`!a b n. ~(a = 0) ==> (n < b DIV a <=> a * (n + 1) <= b)`, SIMP_TAC[GSYM NOT_LE; LE_LDIV_EQ]);; let LE_LDIV = prove (`!a b n. ~(a = 0) /\ b <= a * n ==> b DIV a <= n`, SIMP_TAC[LE_LDIV_EQ; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN MESON_TAC[LT_ADD; LT_NZ; LET_TRANS]);; let DIV_MONO = prove (`!m n p. ~(p = 0) /\ m <= n ==> m DIV p <= n DIV p`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[LE_REFL] `(!k:num. k <= a ==> k <= b) ==> a <= b`) THEN ASM_SIMP_TAC[LE_RDIV_EQ] THEN ASM_MESON_TAC[LE_TRANS]);; let DIV_MONO_LT = prove (`!m n p. ~(p = 0) /\ m + p <= n ==> m DIV p < n DIV p`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[ADD1; LE_SUC_LT; LE_REFL] `(!k:num. k <= a ==> k + 1 <= b) ==> a < b`) THEN ASM_SIMP_TAC[LE_RDIV_EQ; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN ASM_MESON_TAC[LE_REFL; LE_TRANS; LE_ADD2; ADD_SYM]);; let DIV_EQ_0 = prove (`!m n. ~(n = 0) ==> ((m DIV n = 0) <=> m < n)`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM(SUBST1_TAC o CONJUNCT1 o SPEC `m:num` o MATCH_MP DIVISION) THEN ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; DIVISION]; MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]]);; let MOD_EQ_0 = prove (`!m n. ~(n = 0) ==> ((m MOD n = 0) <=> (?q. m = q * n))`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM(SUBST1_TAC o CONJUNCT1 o SPEC `m:num` o MATCH_MP DIVISION) THEN ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; DIVISION] THEN MESON_TAC[]; MATCH_MP_TAC MOD_UNIQ THEN ASM_SIMP_TAC[ADD_CLAUSES; MULT_AC] THEN ASM_MESON_TAC[NOT_LE; CONJUNCT1 LE]]);; let MOD_REFL = prove (`!n. ~(n = 0) ==> n MOD n = 0`, SIMP_TAC[MOD_EQ_0] THEN MESON_TAC[MULT_CLAUSES]);; let EVEN_MOD = prove (`!n. EVEN(n) <=> (n MOD 2 = 0)`, GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN MATCH_MP_TAC(GSYM MOD_EQ_0) THEN REWRITE_TAC[TWO; NOT_SUC]);; let ODD_MOD = prove (`!n. ODD(n) <=> (n MOD 2 = 1)`, GEN_TAC THEN REWRITE_TAC[GSYM NOT_EVEN; EVEN_MOD] THEN SUBGOAL_THEN `n MOD 2 < 2` MP_TAC THENL [SIMP_TAC[DIVISION; TWO; NOT_SUC]; ALL_TAC] THEN SPEC_TAC(`n MOD 2`,`n:num`) THEN REWRITE_TAC[TWO; ONE; LT] THEN MESON_TAC[NOT_SUC]);; let MOD_MULT_RMOD = prove (`!m n p. ~(n = 0) ==> ((m * (p MOD n)) MOD n = (m * p) MOD n)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `m * p DIV n` THEN REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN REWRITE_TAC[EQ_MULT_LCANCEL] THEN DISJ2_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[DIVISION]);; let MOD_MULT_LMOD = prove (`!m n p. ~(n = 0) ==> (((m MOD n) * p) MOD n = (m * p) MOD n)`, ONCE_REWRITE_TAC[MULT_SYM] THEN SIMP_TAC[MOD_MULT_RMOD]);; let MOD_MULT_MOD2 = prove (`!m n p. ~(n = 0) ==> (((m MOD n) * (p MOD n)) MOD n = (m * p) MOD n)`, SIMP_TAC[MOD_MULT_RMOD; MOD_MULT_LMOD]);; let MOD_EXP_MOD = prove (`!m n p. ~(n = 0) ==> (((m MOD n) EXP p) MOD n = (m EXP p) MOD n)`, REPEAT STRIP_TAC THEN SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EXP] THEN ASM_SIMP_TAC[MOD_MULT_LMOD] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(m * ((m MOD n) EXP p) MOD n) MOD n` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN ASM_SIMP_TAC[MOD_MULT_RMOD]);; let MOD_MULT_ADD = prove (`!m n p. (m * n + p) MOD n = p MOD n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `m + p DIV n` THEN ASM_SIMP_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; EQ_ADD_LCANCEL; DIVISION]);; let DIV_MULT_ADD = prove (`!a b n. ~(n = 0) ==> (a * n + b) DIV n = a + b DIV n`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `b MOD n` THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN ASM_MESON_TAC[DIVISION]);; let MOD_ADD_MOD = prove (`!a b n. ~(n = 0) ==> ((a MOD n + b MOD n) MOD n = (a + b) MOD n)`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `a DIV n + b DIV n` THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + (c + d) = (c + a) + (d + b)`] THEN BINOP_TAC THEN ASM_SIMP_TAC[DIVISION]);; let DIV_ADD_MOD = prove (`!a b n. ~(n = 0) ==> (((a + b) MOD n = a MOD n + b MOD n) <=> ((a + b) DIV n = a DIV n + b DIV n))`, REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN DISCH_THEN(fun th -> MAP_EVERY (MP_TAC o CONJUNCT1 o C SPEC th) [`a + b:num`; `a:num`; `b:num`]) THEN DISCH_THEN(fun th1 -> DISCH_THEN(fun th2 -> MP_TAC(MK_COMB(AP_TERM `(+)` th2,th1)))) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [th]) THEN ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + c + d = (a + c) + (b + d)`] THEN REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN DISCH_THEN(fun th -> EQ_TAC THEN DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[EQ_ADD_RCANCEL; EQ_ADD_LCANCEL; EQ_MULT_RCANCEL] THEN REWRITE_TAC[EQ_SYM_EQ]);; let DIV_REFL = prove (`!n. ~(n = 0) ==> (n DIV n = 1)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[LT_0]);; let MOD_LE = prove (`!m n. ~(n = 0) ==> m MOD n <= m`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [MATCH_MP DIVISION th]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]);; let DIV_MONO2 = prove (`!m n p. ~(p = 0) /\ p <= m ==> n DIV m <= n DIV p`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LE_RDIV_EQ] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m * n DIV m` THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN MP_TAC(SPECL [`n:num`; `m:num`] DIVISION) THEN ASM_MESON_TAC[LE_ADD; LE]);; let DIV_LE_EXCLUSION = prove (`!a b c d. ~(b = 0) /\ b * c < (a + 1) * d ==> c DIV d <= a DIV b`, REPEAT GEN_TAC THEN ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LT] THEN STRIP_TAC THEN MATCH_MP_TAC(MESON[LE_REFL] `(!k:num. k <= a ==> k <= b) ==> a <= b`) THEN X_GEN_TAC `k:num` THEN SUBGOAL_THEN `b * d * k <= b * c ==> (b * k) * d < (a + 1) * d` MP_TAC THENL [ASM_MESON_TAC[LET_TRANS; MULT_AC]; ALL_TAC] THEN MATCH_MP_TAC MONO_IMP THEN ASM_SIMP_TAC[LE_MULT_LCANCEL; LT_MULT_RCANCEL; LE_RDIV_EQ] THEN REWRITE_TAC[GSYM ADD1; LT_SUC_LE]);; let DIV_EQ_EXCLUSION = prove (`b * c < (a + 1) * d /\ a * d < (c + 1) * b ==> (a DIV b = c DIV d)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `b = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LT] THEN ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LT] THEN ASM_MESON_TAC[MULT_SYM; LE_ANTISYM; DIV_LE_EXCLUSION]);; let MULT_DIV_LE = prove (`!m n p. ~(p = 0) ==> m * (n DIV p) <= (m * n) DIV p`, REPEAT GEN_TAC THEN SIMP_TAC[LE_RDIV_EQ] THEN DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [CONJUNCT1 th]) THEN REWRITE_TAC[LEFT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC; LE_ADD]);; let DIV_DIV = prove (`!m n p. ~(n * p = 0) ==> ((m DIV n) DIV p = m DIV (n * p))`, REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[LE_ANTISYM] `(!k. k <= m <=> k <= n) ==> m = n`) THEN ASM_SIMP_TAC[LE_RDIV_EQ; MULT_EQ_0; MULT_ASSOC]);; let DIV_MOD = prove (`!m n p. ~(n * p = 0) ==> ((m DIV n) MOD p = (m MOD (n * p)) DIV n)`, REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[LE_ANTISYM] `(!k. k <= m <=> k <= n) ==> m = n`) THEN X_GEN_TAC `k:num` THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `k + p * ((m DIV n) DIV p) <= (m DIV n)` THEN CONJ_TAC THENL [MP_TAC(SPECL [`m DIV n`; `p:num`] DIVISION) THEN ASM_REWRITE_TAC[]; MP_TAC(SPECL [`m:num`; `n * p:num`] DIVISION) THEN ASM_SIMP_TAC[LE_RDIV_EQ; MULT_EQ_0; DIV_DIV; LEFT_ADD_DISTRIB]] THEN REWRITE_TAC[MULT_AC] THEN MESON_TAC[ADD_SYM; MULT_SYM; LE_ADD_RCANCEL]);; let MOD_MOD_EXP_MIN = prove (`!x p m n. ~(p = 0) ==> x MOD (p EXP m) MOD (p EXP n) = x MOD (p EXP (MIN m n))`, REPEAT STRIP_TAC THEN REWRITE_TAC[MIN] THEN ASM_CASES_TAC `m:num <= n` THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN MATCH_MP_TAC MOD_LT THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `p EXP m` THEN ASM_SIMP_TAC[DIVISION; EXP_EQ_0; LE_EXP; LE_ADD]; SUBGOAL_THEN `?d. m = n + d` (CHOOSE_THEN SUBST1_TAC) THENL [ASM_MESON_TAC[LE_CASES; LE_EXISTS]; ASM_SIMP_TAC[EXP_ADD; MOD_MOD; MULT_EQ_0; EXP_EQ_0]]]);; (* ------------------------------------------------------------------------- *) (* Theorems for eliminating cutoff subtraction, predecessor, DIV and MOD. *) (* We have versions that introduce universal or existential quantifiers. *) (* ------------------------------------------------------------------------- *) let PRE_ELIM_THM = prove (`P(PRE n) <=> !m. n = SUC m \/ m = 0 /\ n = 0 ==> P m`, SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_INJ; PRE] THEN MESON_TAC[]);; let PRE_ELIM_THM' = prove (`P(PRE n) <=> ?m. (n = SUC m \/ m = 0 /\ n = 0) /\ P m`, MP_TAC(INST [`\x:num. ~P x`,`P:num->bool`] PRE_ELIM_THM) THEN MESON_TAC[]);; let SUB_ELIM_THM = prove (`P(a - b) <=> !d. a = b + d \/ a < b /\ d = 0 ==> P d`, DISJ_CASES_TAC(SPECL [`a:num`; `b:num`] LTE_CASES) THENL [ASM_MESON_TAC[NOT_LT; SUB_EQ_0; LT_IMP_LE; LE_ADD]; ALL_TAC] THEN FIRST_ASSUM(X_CHOOSE_THEN `e:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN SIMP_TAC[ADD_SUB2; GSYM NOT_LE; LE_ADD; EQ_ADD_LCANCEL] THEN MESON_TAC[]);; let SUB_ELIM_THM' = prove (`P(a - b) <=> ?d. (a = b + d \/ a < b /\ d = 0) /\ P d`, MP_TAC(INST [`\x:num. ~P x`,`P:num->bool`] SUB_ELIM_THM) THEN MESON_TAC[]);; let DIVMOD_ELIM_THM = prove (`P (m DIV n) (m MOD n) <=> !q r. n = 0 /\ q = 0 /\ r = m \/ m = q * n + r /\ r < n ==> P q r`, ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[DIVISION_0; LT]; FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN MESON_TAC[DIVMOD_UNIQ]]);; let DIVMOD_ELIM_THM' = prove (`P (m DIV n) (m MOD n) <=> ?q r. (n = 0 /\ q = 0 /\ r = m \/ m = q * n + r /\ r < n) /\ P q r`, MP_TAC(INST [`\x:num y:num. ~P x y`,`P:num->num->bool`] DIVMOD_ELIM_THM) THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Crude but useful conversion for cancelling down equations. *) (* ------------------------------------------------------------------------- *) let NUM_CANCEL_CONV = let rec minter i l1' l2' l1 l2 = if l1 = [] then (i,l1',l2'@l2) else if l2 = [] then (i,l1@l1',l2') else let h1 = hd l1 and h2 = hd l2 in if h1 = h2 then minter (h1::i) l1' l2' (tl l1) (tl l2) else if h1 < h2 then minter i (h1::l1') l2' (tl l1) l2 else minter i l1' (h2::l2') l1 (tl l2) in let add_tm = `(+)` and eq_tm = `(=) :num->num->bool` in let EQ_ADD_LCANCEL_0' = GEN_REWRITE_RULE (funpow 2 BINDER_CONV o LAND_CONV) [EQ_SYM_EQ] EQ_ADD_LCANCEL_0 in let AC_RULE = AC ADD_AC in fun tm -> let l,r = dest_eq tm in let lats = sort (<=) (binops `(+)` l) and rats = sort (<=) (binops `(+)` r) in let i,lats',rats' = minter [] [] [] lats rats in let l' = list_mk_binop add_tm (i @ lats') and r' = list_mk_binop add_tm (i @ rats') in let lth = AC_RULE (mk_eq(l,l')) and rth = AC_RULE (mk_eq(r,r')) in let eth = MK_COMB(AP_TERM eq_tm lth,rth) in GEN_REWRITE_RULE (RAND_CONV o REPEATC) [EQ_ADD_LCANCEL; EQ_ADD_LCANCEL_0; EQ_ADD_LCANCEL_0'] eth;; (* ------------------------------------------------------------------------- *) (* This is handy for easing MATCH_MP on inequalities. *) (* ------------------------------------------------------------------------- *) let LE_IMP = let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] LE_TRANS in fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));; (* ------------------------------------------------------------------------- *) (* Binder for "the minimal n such that". *) (* ------------------------------------------------------------------------- *) parse_as_binder "minimal";; let minimal = new_definition `(minimal) (P:num->bool) = @n. P n /\ !m. m < n ==> ~(P m)`;; let MINIMAL = prove (`!P. (?n. P n) <=> P((minimal) P) /\ (!m. m < (minimal) P ==> ~(P m))`, GEN_TAC THEN REWRITE_TAC[minimal] THEN CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[GSYM num_WOP]);; (* ------------------------------------------------------------------------- *) (* A common lemma for transitive relations. *) (* ------------------------------------------------------------------------- *) let TRANSITIVE_STEPWISE_LT_EQ = prove (`!R. (!x y z. R x y /\ R y z ==> R x z) ==> ((!m n. m < n ==> R m n) <=> (!n. R n (SUC n)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[LT] THEN DISCH_TAC THEN SIMP_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; ADD_CLAUSES] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN ASM_MESON_TAC[]);; let TRANSITIVE_STEPWISE_LT = prove (`!R. (!x y z. R x y /\ R y z ==> R x z) /\ (!n. R n (SUC n)) ==> !m n. m < n ==> R m n`, REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> (c <=> b)) ==> a /\ b ==> c`) THEN MATCH_ACCEPT_TAC TRANSITIVE_STEPWISE_LT_EQ);; let TRANSITIVE_STEPWISE_LE_EQ = prove (`!R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) ==> ((!m n. m <= n ==> R m n) <=> (!n. R n (SUC n)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[LE; LE_REFL] THEN DISCH_TAC THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; ADD_CLAUSES] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN ASM_MESON_TAC[]);; let TRANSITIVE_STEPWISE_LE = prove (`!R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!n. R n (SUC n)) ==> !m n. m <= n ==> R m n`, REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(a /\ a' ==> (c <=> b)) ==> a /\ a' /\ b ==> c`) THEN MATCH_ACCEPT_TAC TRANSITIVE_STEPWISE_LE_EQ);; (* ------------------------------------------------------------------------- *) (* A couple of forms of Dependent Choice. *) (* ------------------------------------------------------------------------- *) let DEPENDENT_CHOICE_FIXED = prove (`!P R a:A. P 0 a /\ (!n x. P n x ==> ?y. P (SUC n) y /\ R n x y) ==> ?f. f 0 = a /\ (!n. P n (f n)) /\ (!n. R n (f n) (f(SUC n)))`, REPEAT STRIP_TAC THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `f 0 = (a:A) /\ (!n. f(SUC n) = @y. P (SUC n) y /\ R n (f n) y)` THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [MESON[num_CASES] `(!n. P n) <=> P 0 /\ !n. P(SUC n)`] THEN ASM_REWRITE_TAC[AND_FORALL_THM] THEN INDUCT_TAC THEN ASM_MESON_TAC[]);; let DEPENDENT_CHOICE = prove (`!P R:num->A->A->bool. (?a. P 0 a) /\ (!n x. P n x ==> ?y. P (SUC n) y /\ R n x y) ==> ?f. (!n. P n (f n)) /\ (!n. R n (f n) (f(SUC n)))`, MESON_TAC[DEPENDENT_CHOICE_FIXED]);; hol-light/basics.ml000066400000000000000000000401131303454263000145420ustar00rootroot00000000000000(* ========================================================================= *) (* More syntax constructors, and prelogical utilities like matching. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "fusion.ml";; (* ------------------------------------------------------------------------- *) (* Create probably-fresh variable *) (* ------------------------------------------------------------------------- *) let genvar = let gcounter = ref 0 in fun ty -> let count = !gcounter in (gcounter := count + 1; mk_var("_"^(string_of_int count),ty));; (* ------------------------------------------------------------------------- *) (* Convenient functions for manipulating types. *) (* ------------------------------------------------------------------------- *) let dest_fun_ty ty = match ty with Tyapp("fun",[ty1;ty2]) -> (ty1,ty2) | _ -> failwith "dest_fun_ty";; let rec occurs_in ty bigty = bigty = ty || is_type bigty && exists (occurs_in ty) (snd(dest_type bigty));; let rec tysubst alist ty = try rev_assoc ty alist with Failure _ -> if is_vartype ty then ty else let tycon,tyvars = dest_type ty in mk_type(tycon,map (tysubst alist) tyvars);; (* ------------------------------------------------------------------------- *) (* A bit more syntax. *) (* ------------------------------------------------------------------------- *) let bndvar tm = try fst(dest_abs tm) with Failure _ -> failwith "bndvar: Not an abstraction";; let body tm = try snd(dest_abs tm) with Failure _ -> failwith "body: Not an abstraction";; let list_mk_comb(h,t) = rev_itlist (C (curry mk_comb)) t h;; let list_mk_abs(vs,bod) = itlist (curry mk_abs) vs bod;; let strip_comb = rev_splitlist dest_comb;; let strip_abs = splitlist dest_abs;; (* ------------------------------------------------------------------------- *) (* Generic syntax to deal with some binary operators. *) (* *) (* Note that "mk_binary" only works for monomorphic functions. *) (* ------------------------------------------------------------------------- *) let is_binary s tm = match tm with Comb(Comb(Const(s',_),_),_) -> s' = s | _ -> false;; let dest_binary s tm = match tm with Comb(Comb(Const(s',_),l),r) when s' = s -> (l,r) | _ -> failwith "dest_binary";; let mk_binary s = let c = mk_const(s,[]) in fun (l,r) -> try mk_comb(mk_comb(c,l),r) with Failure _ -> failwith "mk_binary";; (* ------------------------------------------------------------------------- *) (* Produces a sequence of variants, considering previous inventions. *) (* ------------------------------------------------------------------------- *) let rec variants av vs = if vs = [] then [] else let vh = variant av (hd vs) in vh::(variants (vh::av) (tl vs));; (* ------------------------------------------------------------------------- *) (* Gets all variables (free and/or bound) in a term. *) (* ------------------------------------------------------------------------- *) let variables = let rec vars(acc,tm) = if is_var tm then insert tm acc else if is_const tm then acc else if is_abs tm then let v,bod = dest_abs tm in vars(insert v acc,bod) else let l,r = dest_comb tm in vars(vars(acc,l),r) in fun tm -> vars([],tm);; (* ------------------------------------------------------------------------- *) (* General substitution (for any free expression). *) (* ------------------------------------------------------------------------- *) let subst = let rec ssubst ilist tm = if ilist = [] then tm else try fst (find ((aconv tm) o snd) ilist) with Failure _ -> match tm with Comb(f,x) -> let f' = ssubst ilist f and x' = ssubst ilist x in if f' == f && x' == x then tm else mk_comb(f',x') | Abs(v,bod) -> let ilist' = filter (not o (vfree_in v) o snd) ilist in mk_abs(v,ssubst ilist' bod) | _ -> tm in fun ilist -> let theta = filter (fun (s,t) -> Pervasives.compare s t <> 0) ilist in if theta = [] then (fun tm -> tm) else let ts,xs = unzip theta in fun tm -> let gs = variants (variables tm) (map (genvar o type_of) xs) in let tm' = ssubst (zip gs xs) tm in if tm' == tm then tm else vsubst (zip ts gs) tm';; (* ------------------------------------------------------------------------- *) (* Alpha conversion term operation. *) (* ------------------------------------------------------------------------- *) let alpha v tm = let v0,bod = try dest_abs tm with Failure _ -> failwith "alpha: Not an abstraction"in if v = v0 then tm else if type_of v = type_of v0 && not (vfree_in v bod) then mk_abs(v,vsubst[v,v0]bod) else failwith "alpha: Invalid new variable";; (* ------------------------------------------------------------------------- *) (* Type matching. *) (* ------------------------------------------------------------------------- *) let rec type_match vty cty sofar = if is_vartype vty then try if rev_assoc vty sofar = cty then sofar else failwith "type_match" with Failure "find" -> (cty,vty)::sofar else let vop,vargs = dest_type vty and cop,cargs = dest_type cty in if vop = cop then itlist2 type_match vargs cargs sofar else failwith "type_match";; (* ------------------------------------------------------------------------- *) (* Conventional matching version of mk_const (but with a sanity test). *) (* ------------------------------------------------------------------------- *) let mk_mconst(c,ty) = try let uty = get_const_type c in let mat = type_match uty ty [] in let con = mk_const(c,mat) in if type_of con = ty then con else fail() with Failure _ -> failwith "mk_const: generic type cannot be instantiated";; (* ------------------------------------------------------------------------- *) (* Like mk_comb, but instantiates type variables in rator if necessary. *) (* ------------------------------------------------------------------------- *) let mk_icomb(tm1,tm2) = let "fun",[ty;_] = dest_type (type_of tm1) in let tyins = type_match ty (type_of tm2) [] in mk_comb(inst tyins tm1,tm2);; (* ------------------------------------------------------------------------- *) (* Instantiates types for constant c and iteratively makes combination. *) (* ------------------------------------------------------------------------- *) let list_mk_icomb cname args = let atys,_ = nsplit dest_fun_ty args (get_const_type cname) in let tyin = itlist2 (fun g a -> type_match g (type_of a)) atys args [] in list_mk_comb(mk_const(cname,tyin),args);; (* ------------------------------------------------------------------------- *) (* Free variables in assumption list and conclusion of a theorem. *) (* ------------------------------------------------------------------------- *) let thm_frees th = let asl,c = dest_thm th in itlist (union o frees) asl (frees c);; (* ------------------------------------------------------------------------- *) (* Is one term free in another? *) (* ------------------------------------------------------------------------- *) let rec free_in tm1 tm2 = if aconv tm1 tm2 then true else if is_comb tm2 then let l,r = dest_comb tm2 in free_in tm1 l || free_in tm1 r else if is_abs tm2 then let bv,bod = dest_abs tm2 in not (vfree_in bv tm1) && free_in tm1 bod else false;; (* ------------------------------------------------------------------------- *) (* Searching for terms. *) (* ------------------------------------------------------------------------- *) let rec find_term p tm = if p tm then tm else if is_abs tm then find_term p (body tm) else if is_comb tm then let l,r = dest_comb tm in try find_term p l with Failure _ -> find_term p r else failwith "find_term";; let find_terms = let rec accum tl p tm = let tl' = if p tm then insert tm tl else tl in if is_abs tm then accum tl' p (body tm) else if is_comb tm then accum (accum tl' p (rator tm)) p (rand tm) else tl' in accum [];; (* ------------------------------------------------------------------------- *) (* General syntax for binders. *) (* *) (* NB! The "mk_binder" function expects polytype "A", which is the domain. *) (* ------------------------------------------------------------------------- *) let is_binder s tm = match tm with Comb(Const(s',_),Abs(_,_)) -> s' = s | _ -> false;; let dest_binder s tm = match tm with Comb(Const(s',_),Abs(x,t)) when s' = s -> (x,t) | _ -> failwith "dest_binder";; let mk_binder op = let c = mk_const(op,[]) in fun (v,tm) -> mk_comb(inst [type_of v,aty] c,mk_abs(v,tm));; (* ------------------------------------------------------------------------- *) (* Syntax for binary operators. *) (* ------------------------------------------------------------------------- *) let is_binop op tm = match tm with Comb(Comb(op',_),_) -> op' = op | _ -> false;; let dest_binop op tm = match tm with Comb(Comb(op',l),r) when op' = op -> (l,r) | _ -> failwith "dest_binop";; let mk_binop op tm1 = let f = mk_comb(op,tm1) in fun tm2 -> mk_comb(f,tm2);; let list_mk_binop op = end_itlist (mk_binop op);; let binops op = striplist (dest_binop op);; (* ------------------------------------------------------------------------- *) (* Some common special cases *) (* ------------------------------------------------------------------------- *) let is_conj = is_binary "/\\";; let dest_conj = dest_binary "/\\";; let conjuncts = striplist dest_conj;; let is_imp = is_binary "==>";; let dest_imp = dest_binary "==>";; let is_forall = is_binder "!";; let dest_forall = dest_binder "!";; let strip_forall = splitlist dest_forall;; let is_exists = is_binder "?";; let dest_exists = dest_binder "?";; let strip_exists = splitlist dest_exists;; let is_disj = is_binary "\\/";; let dest_disj = dest_binary "\\/";; let disjuncts = striplist dest_disj;; let is_neg tm = try fst(dest_const(rator tm)) = "~" with Failure _ -> false;; let dest_neg tm = try let n,p = dest_comb tm in if fst(dest_const n) = "~" then p else fail() with Failure _ -> failwith "dest_neg";; let is_uexists = is_binder "?!";; let dest_uexists = dest_binder "?!";; let dest_cons = dest_binary "CONS";; let is_cons = is_binary "CONS";; let dest_list tm = try let tms,nil = splitlist dest_cons tm in if fst(dest_const nil) = "NIL" then tms else fail() with Failure _ -> failwith "dest_list";; let is_list = can dest_list;; (* ------------------------------------------------------------------------- *) (* Syntax for numerals. *) (* ------------------------------------------------------------------------- *) let dest_numeral = let rec dest_num tm = if try fst(dest_const tm) = "_0" with Failure _ -> false then num_0 else let l,r = dest_comb tm in let n = num_2 */ dest_num r in let cn = fst(dest_const l) in if cn = "BIT0" then n else if cn = "BIT1" then n +/ num_1 else fail() in fun tm -> try let l,r = dest_comb tm in if fst(dest_const l) = "NUMERAL" then dest_num r else fail() with Failure _ -> failwith "dest_numeral";; (* ------------------------------------------------------------------------- *) (* Syntax for generalized abstractions. *) (* *) (* These are here because they are used by the preterm->term translator; *) (* preterms regard generalized abstractions as an atomic notion. This is *) (* slightly unclean --- for example we need locally some operations on *) (* universal quantifiers --- but probably simplest. It has to go somewhere! *) (* ------------------------------------------------------------------------- *) let dest_gabs = let dest_geq = dest_binary "GEQ" in fun tm -> try if is_abs tm then dest_abs tm else let l,r = dest_comb tm in if not (fst(dest_const l) = "GABS") then fail() else let ltm,rtm = dest_geq(snd(strip_forall(body r))) in rand ltm,rtm with Failure _ -> failwith "dest_gabs: Not a generalized abstraction";; let is_gabs = can dest_gabs;; let mk_gabs = let mk_forall(v,t) = let cop = mk_const("!",[type_of v,aty]) in mk_comb(cop,mk_abs(v,t)) in let list_mk_forall(vars,bod) = itlist (curry mk_forall) vars bod in let mk_geq(t1,t2) = let p = mk_const("GEQ",[type_of t1,aty]) in mk_comb(mk_comb(p,t1),t2) in fun (tm1,tm2) -> if is_var tm1 then mk_abs(tm1,tm2) else let fvs = frees tm1 in let fty = mk_fun_ty (type_of tm1) (type_of tm2) in let f = variant (frees tm1 @ frees tm2) (mk_var("f",fty)) in let bod = mk_abs(f,list_mk_forall(fvs,mk_geq(mk_comb(f,tm1),tm2))) in mk_comb(mk_const("GABS",[fty,aty]),bod);; let list_mk_gabs(vs,bod) = itlist (curry mk_gabs) vs bod;; let strip_gabs = splitlist dest_gabs;; (* ------------------------------------------------------------------------- *) (* Syntax for let terms. *) (* ------------------------------------------------------------------------- *) let dest_let tm = try let l,aargs = strip_comb tm in if fst(dest_const l) <> "LET" then fail() else let vars,lebod = strip_gabs (hd aargs) in let eqs = zip vars (tl aargs) in let le,bod = dest_comb lebod in if fst(dest_const le) = "LET_END" then eqs,bod else fail() with Failure _ -> failwith "dest_let: not a let-term";; let is_let = can dest_let;; let mk_let(assigs,bod) = let lefts,rights = unzip assigs in let lend = mk_comb(mk_const("LET_END",[type_of bod,aty]),bod) in let lbod = list_mk_gabs(lefts,lend) in let ty1,ty2 = dest_fun_ty(type_of lbod) in let ltm = mk_const("LET",[ty1,aty; ty2,bty]) in list_mk_comb(ltm,lbod::rights);; (* ------------------------------------------------------------------------- *) (* Useful function to create stylized arguments using numbers. *) (* ------------------------------------------------------------------------- *) let make_args = let rec margs n s avoid tys = if tys = [] then [] else let v = variant avoid (mk_var(s^(string_of_int n),hd tys)) in v::(margs (n + 1) s (v::avoid) (tl tys)) in fun s avoid tys -> if length tys = 1 then [variant avoid (mk_var(s,hd tys))] else margs 0 s avoid tys;; (* ------------------------------------------------------------------------- *) (* Director strings down a term. *) (* ------------------------------------------------------------------------- *) let find_path = let rec find_path p tm = if p tm then [] else if is_abs tm then "b"::(find_path p (body tm)) else try "r"::(find_path p (rand tm)) with Failure _ -> "l"::(find_path p (rator tm)) in fun p tm -> implode(find_path p tm);; let follow_path = let rec follow_path s tm = match s with [] -> tm | "l"::t -> follow_path t (rator tm) | "r"::t -> follow_path t (rand tm) | _::t -> follow_path t (body tm) in fun s tm -> follow_path (explode s) tm;; hol-light/bool.ml000066400000000000000000000422721303454263000142410ustar00rootroot00000000000000(* ========================================================================= *) (* Boolean theory including (intuitionistic) defs of logical connectives. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "equal.ml";; (* ------------------------------------------------------------------------- *) (* Set up parse status of basic and derived logical constants. *) (* ------------------------------------------------------------------------- *) parse_as_prefix "~";; parse_as_binder "\\";; parse_as_binder "!";; parse_as_binder "?";; parse_as_binder "?!";; parse_as_infix ("==>",(4,"right"));; parse_as_infix ("\\/",(6,"right"));; parse_as_infix ("/\\",(8,"right"));; (* ------------------------------------------------------------------------- *) (* Set up more orthodox notation for equations and equivalence. *) (* ------------------------------------------------------------------------- *) parse_as_infix("<=>",(2,"right"));; override_interface ("<=>",`(=):bool->bool->bool`);; parse_as_infix("=",(12,"right"));; (* ------------------------------------------------------------------------- *) (* Special syntax for Boolean equations (IFF). *) (* ------------------------------------------------------------------------- *) let is_iff tm = match tm with Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> true | _ -> false;; let dest_iff tm = match tm with Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> (l,r) | _ -> failwith "dest_iff";; let mk_iff = let eq_tm = `(<=>)` in fun (l,r) -> mk_comb(mk_comb(eq_tm,l),r);; (* ------------------------------------------------------------------------- *) (* Rule allowing easy instantiation of polymorphic proformas. *) (* ------------------------------------------------------------------------- *) let PINST tyin tmin = let iterm_fn = INST (map (I F_F (inst tyin)) tmin) and itype_fn = INST_TYPE tyin in fun th -> try iterm_fn (itype_fn th) with Failure _ -> failwith "PINST";; (* ------------------------------------------------------------------------- *) (* Useful derived deductive rule. *) (* ------------------------------------------------------------------------- *) let PROVE_HYP ath bth = if exists (aconv (concl ath)) (hyp bth) then EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath else bth;; (* ------------------------------------------------------------------------- *) (* Rules for T *) (* ------------------------------------------------------------------------- *) let T_DEF = new_basic_definition `T = ((\p:bool. p) = (\p:bool. p))`;; let TRUTH = EQ_MP (SYM T_DEF) (REFL `\p:bool. p`);; let EQT_ELIM th = try EQ_MP (SYM th) TRUTH with Failure _ -> failwith "EQT_ELIM";; let EQT_INTRO = let t = `t:bool` in let pth = let th1 = DEDUCT_ANTISYM_RULE (ASSUME t) TRUTH in let th2 = EQT_ELIM(ASSUME(concl th1)) in DEDUCT_ANTISYM_RULE th2 th1 in fun th -> EQ_MP (INST[concl th,t] pth) th;; (* ------------------------------------------------------------------------- *) (* Rules for /\ *) (* ------------------------------------------------------------------------- *) let AND_DEF = new_basic_definition `(/\) = \p q. (\f:bool->bool->bool. f p q) = (\f. f T T)`;; let mk_conj = mk_binary "/\\";; let list_mk_conj = end_itlist (curry mk_conj);; let CONJ = let f = `f:bool->bool->bool` and p = `p:bool` and q = `q:bool` in let pth1 = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF p) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 q) in let th3 = EQ_MP th2 (ASSUME(mk_conj(p,q))) in EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). q`)) and pth2 = let pth = ASSUME p and qth = ASSUME q in let th1 = MK_COMB(AP_TERM f (EQT_INTRO pth),EQT_INTRO qth) in let th2 = ABS f th1 in let th3 = BETA_RULE (AP_THM (AP_THM AND_DEF p) q) in EQ_MP (SYM th3) th2 in let pth = DEDUCT_ANTISYM_RULE pth1 pth2 in fun th1 th2 -> let th = INST [concl th1,p; concl th2,q] pth in EQ_MP (PROVE_HYP th1 th) th2;; let CONJUNCT1 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF P) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 Q) in let th3 = EQ_MP th2 (ASSUME(mk_conj(P,Q))) in EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). p`)) in fun th -> try let l,r = dest_conj(concl th) in PROVE_HYP th (INST [l,P; r,Q] pth) with Failure _ -> failwith "CONJUNCT1";; let CONJUNCT2 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF P) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 Q) in let th3 = EQ_MP th2 (ASSUME(mk_conj(P,Q))) in EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). q`)) in fun th -> try let l,r = dest_conj(concl th) in PROVE_HYP th (INST [l,P; r,Q] pth) with Failure _ -> failwith "CONJUNCT2";; let CONJ_PAIR th = try CONJUNCT1 th,CONJUNCT2 th with Failure _ -> failwith "CONJ_PAIR: Not a conjunction";; let CONJUNCTS = striplist CONJ_PAIR;; (* ------------------------------------------------------------------------- *) (* Rules for ==> *) (* ------------------------------------------------------------------------- *) let IMP_DEF = new_basic_definition `(==>) = \p q. p /\ q <=> p`;; let mk_imp = mk_binary "==>";; let MP = let p = `p:bool` and q = `q:bool` in let pth = let th1 = BETA_RULE (AP_THM (AP_THM IMP_DEF p) q) and th2 = CONJ (ASSUME p) (ASSUME q) and th3 = CONJUNCT1(ASSUME(mk_conj(p,q))) in EQ_MP (SYM th1) (DEDUCT_ANTISYM_RULE th2 th3) and qth = let th1 = BETA_RULE (AP_THM (AP_THM IMP_DEF p) q) in let th2 = EQ_MP th1 (ASSUME(mk_imp(p,q))) in CONJUNCT2 (EQ_MP (SYM th2) (ASSUME p)) in let rth = DEDUCT_ANTISYM_RULE pth qth in fun ith th -> let ant,con = dest_imp (concl ith) in if aconv ant (concl th) then EQ_MP (PROVE_HYP th (INST [ant,p; con,q] rth)) ith else failwith "MP: theorems do not agree";; let DISCH = let p = `p:bool` and q = `q:bool` in let pth = SYM(BETA_RULE (AP_THM (AP_THM IMP_DEF p) q)) in fun a th -> let th1 = CONJ (ASSUME a) th in let th2 = CONJUNCT1 (ASSUME (concl th1)) in let th3 = DEDUCT_ANTISYM_RULE th1 th2 in let th4 = INST [a,p; concl th,q] pth in EQ_MP th4 th3;; let rec DISCH_ALL th = try DISCH_ALL (DISCH (hd (hyp th)) th) with Failure _ -> th;; let UNDISCH th = try MP th (ASSUME(rand(rator(concl th)))) with Failure _ -> failwith "UNDISCH";; let rec UNDISCH_ALL th = if is_imp (concl th) then UNDISCH_ALL (UNDISCH th) else th;; let IMP_ANTISYM_RULE = let p = `p:bool` and q = `q:bool` and imp_tm = `(==>)` in let pq = mk_imp(p,q) and qp = mk_imp(q,p) in let pth1,pth2 = CONJ_PAIR(ASSUME(mk_conj(pq,qp))) in let pth3 = DEDUCT_ANTISYM_RULE (UNDISCH pth2) (UNDISCH pth1) in let pth4 = DISCH_ALL(ASSUME q) and pth5 = ASSUME(mk_eq(p,q)) in let pth6 = CONJ (EQ_MP (SYM(AP_THM (AP_TERM imp_tm pth5) q)) pth4) (EQ_MP (SYM(AP_TERM (mk_comb(imp_tm,q)) pth5)) pth4) in let pth = DEDUCT_ANTISYM_RULE pth6 pth3 in fun th1 th2 -> let p1,q1 = dest_imp(concl th1) in EQ_MP (INST [p1,p; q1,q] pth) (CONJ th1 th2);; let ADD_ASSUM tm th = MP (DISCH tm th) (ASSUME tm);; let EQ_IMP_RULE = let peq = `p <=> q` in let p,q = dest_iff peq in let pth1 = DISCH peq (DISCH p (EQ_MP (ASSUME peq) (ASSUME p))) and pth2 = DISCH peq (DISCH q (EQ_MP (SYM(ASSUME peq)) (ASSUME q))) in fun th -> let l,r = dest_iff(concl th) in MP (INST [l,p; r,q] pth1) th,MP (INST [l,p; r,q] pth2) th;; let IMP_TRANS = let pq = `p ==> q` and qr = `q ==> r` in let p,q = dest_imp pq and r = rand qr in let pth = itlist DISCH [pq; qr; p] (MP (ASSUME qr) (MP (ASSUME pq) (ASSUME p))) in fun th1 th2 -> let x,y = dest_imp(concl th1) and y',z = dest_imp(concl th2) in if y <> y' then failwith "IMP_TRANS" else MP (MP (INST [x,p; y,q; z,r] pth) th1) th2;; (* ------------------------------------------------------------------------- *) (* Rules for ! *) (* ------------------------------------------------------------------------- *) let FORALL_DEF = new_basic_definition `(!) = \P:A->bool. P = \x. T`;; let mk_forall = mk_binder "!";; let list_mk_forall(vs,bod) = itlist (curry mk_forall) vs bod;; let SPEC = let P = `P:A->bool` and x = `x:A` in let pth = let th1 = EQ_MP(AP_THM FORALL_DEF `P:A->bool`) (ASSUME `(!)(P:A->bool)`) in let th2 = AP_THM (CONV_RULE BETA_CONV th1) `x:A` in let th3 = CONV_RULE (RAND_CONV BETA_CONV) th2 in DISCH_ALL (EQT_ELIM th3) in fun tm th -> try let abs = rand(concl th) in CONV_RULE BETA_CONV (MP (PINST [snd(dest_var(bndvar abs)),aty] [abs,P; tm,x] pth) th) with Failure _ -> failwith "SPEC";; let SPECL tms th = try rev_itlist SPEC tms th with Failure _ -> failwith "SPECL";; let SPEC_VAR th = let bv = variant (thm_frees th) (bndvar(rand(concl th))) in bv,SPEC bv th;; let rec SPEC_ALL th = if is_forall(concl th) then SPEC_ALL(snd(SPEC_VAR th)) else th;; let ISPEC t th = let x,_ = try dest_forall(concl th) with Failure _ -> failwith "ISPEC: input theorem not universally quantified" in let tyins = try type_match (snd(dest_var x)) (type_of t) [] with Failure _ -> failwith "ISPEC can't type-instantiate input theorem" in try SPEC t (INST_TYPE tyins th) with Failure _ -> failwith "ISPEC: type variable(s) free in assumptions";; let ISPECL tms th = try if tms = [] then th else let avs = fst (chop_list (length tms) (fst(strip_forall(concl th)))) in let tyins = itlist2 type_match (map (snd o dest_var) avs) (map type_of tms) [] in SPECL tms (INST_TYPE tyins th) with Failure _ -> failwith "ISPECL";; let GEN = let pth = SYM(CONV_RULE (RAND_CONV BETA_CONV) (AP_THM FORALL_DEF `P:A->bool`)) in fun x -> let qth = INST_TYPE[snd(dest_var x),aty] pth in let ptm = rand(rand(concl qth)) in fun th -> let th' = ABS x (EQT_INTRO th) in let phi = lhand(concl th') in let rth = INST[phi,ptm] qth in EQ_MP rth th';; let GENL = itlist GEN;; let GEN_ALL th = let asl,c = dest_thm th in let vars = subtract (frees c) (freesl asl) in GENL vars th;; (* ------------------------------------------------------------------------- *) (* Rules for ? *) (* ------------------------------------------------------------------------- *) let EXISTS_DEF = new_basic_definition `(?) = \P:A->bool. !q. (!x. P x ==> q) ==> q`;; let mk_exists = mk_binder "?";; let list_mk_exists(vs,bod) = itlist (curry mk_exists) vs bod;; let EXISTS = let P = `P:A->bool` and x = `x:A` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in let th2 = SPEC `x:A` (ASSUME `!x:A. P x ==> Q`) in let th3 = DISCH `!x:A. P x ==> Q` (MP th2 (ASSUME `(P:A->bool) x`)) in EQ_MP (SYM th1) (GEN `Q:bool` th3) in fun (etm,stm) th -> try let qf,abs = dest_comb etm in let bth = BETA_CONV(mk_comb(abs,stm)) in let cth = PINST [type_of stm,aty] [abs,P; stm,x] pth in PROVE_HYP (EQ_MP (SYM bth) th) cth with Failure _ -> failwith "EXISTS";; let SIMPLE_EXISTS v th = EXISTS (mk_exists(v,concl th),v) th;; let CHOOSE = let P = `P:A->bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in let th2 = SPEC `Q:bool` (UNDISCH(fst(EQ_IMP_RULE th1))) in DISCH_ALL (DISCH `(?) (P:A->bool)` (UNDISCH th2)) in fun (v,th1) th2 -> try let abs = rand(concl th1) in let bv,bod = dest_abs abs in let cmb = mk_comb(abs,v) in let pat = vsubst[v,bv] bod in let th3 = CONV_RULE BETA_CONV (ASSUME cmb) in let th4 = GEN v (DISCH cmb (MP (DISCH pat th2) th3)) in let th5 = PINST [snd(dest_var v),aty] [abs,P; concl th2,Q] pth in MP (MP th5 th4) th1 with Failure _ -> failwith "CHOOSE";; let SIMPLE_CHOOSE v th = CHOOSE(v,ASSUME (mk_exists(v,hd(hyp th)))) th;; (* ------------------------------------------------------------------------- *) (* Rules for \/ *) (* ------------------------------------------------------------------------- *) let OR_DEF = new_basic_definition `(\/) = \p q. !r. (p ==> r) ==> (q ==> r) ==> r`;; let mk_disj = mk_binary "\\/";; let list_mk_disj = end_itlist (curry mk_disj);; let DISJ1 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = MP (ASSUME `P ==> t`) (ASSUME `P:bool`) in let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in EQ_MP (SYM th2) th4 in fun th tm -> try PROVE_HYP th (INST [concl th,P; tm,Q] pth) with Failure _ -> failwith "DISJ1";; let DISJ2 = let P = `P:bool` and Q = `Q:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = MP (ASSUME `Q ==> t`) (ASSUME `Q:bool`) in let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in EQ_MP (SYM th2) th4 in fun tm th -> try PROVE_HYP th (INST [tm,P; concl th,Q] pth) with Failure _ -> failwith "DISJ2";; let DISJ_CASES = let P = `P:bool` and Q = `Q:bool` and R = `R:bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in let th3 = SPEC `R:bool` (EQ_MP th2 (ASSUME `P \/ Q`)) in UNDISCH (UNDISCH th3) in fun th0 th1 th2 -> try let c1 = concl th1 and c2 = concl th2 in if not (aconv c1 c2) then failwith "DISJ_CASES" else let l,r = dest_disj (concl th0) in let th = INST [l,P; r,Q; c1,R] pth in PROVE_HYP (DISCH r th2) (PROVE_HYP (DISCH l th1) (PROVE_HYP th0 th)) with Failure _ -> failwith "DISJ_CASES";; let SIMPLE_DISJ_CASES th1 th2 = DISJ_CASES (ASSUME(mk_disj(hd(hyp th1),hd(hyp th2)))) th1 th2;; (* ------------------------------------------------------------------------- *) (* Rules for negation and falsity. *) (* ------------------------------------------------------------------------- *) let F_DEF = new_basic_definition `F = !p:bool. p`;; let NOT_DEF = new_basic_definition `(~) = \p. p ==> F`;; let mk_neg = let neg_tm = `(~)` in fun tm -> try mk_comb(neg_tm,tm) with Failure _ -> failwith "mk_neg";; let NOT_ELIM = let P = `P:bool` in let pth = CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P) in fun th -> try EQ_MP (INST [rand(concl th),P] pth) th with Failure _ -> failwith "NOT_ELIM";; let NOT_INTRO = let P = `P:bool` in let pth = SYM(CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P)) in fun th -> try EQ_MP (INST [rand(rator(concl th)),P] pth) th with Failure _ -> failwith "NOT_INTRO";; let EQF_INTRO = let P = `P:bool` in let pth = let th1 = NOT_ELIM (ASSUME `~ P`) and th2 = DISCH `F` (SPEC P (EQ_MP F_DEF (ASSUME `F`))) in DISCH_ALL (IMP_ANTISYM_RULE th1 th2) in fun th -> try MP (INST [rand(concl th),P] pth) th with Failure _ -> failwith "EQF_INTRO";; let EQF_ELIM = let P = `P:bool` in let pth = let th1 = EQ_MP (ASSUME `P = F`) (ASSUME `P:bool`) in let th2 = DISCH P (SPEC `F` (EQ_MP F_DEF th1)) in DISCH_ALL (NOT_INTRO th2) in fun th -> try MP (INST [rand(rator(concl th)),P] pth) th with Failure _ -> failwith "EQF_ELIM";; let CONTR = let P = `P:bool` and f_tm = `F` in let pth = SPEC P (EQ_MP F_DEF (ASSUME `F`)) in fun tm th -> if concl th <> f_tm then failwith "CONTR" else PROVE_HYP th (INST [tm,P] pth);; (* ------------------------------------------------------------------------- *) (* Rules for unique existence. *) (* ------------------------------------------------------------------------- *) let EXISTS_UNIQUE_DEF = new_basic_definition `(?!) = \P:A->bool. ((?) P) /\ (!x y. P x /\ P y ==> x = y)`;; let mk_uexists = mk_binder "?!";; let EXISTENCE = let P = `P:A->bool` in let pth = let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_UNIQUE_DEF P) in let th2 = UNDISCH (fst(EQ_IMP_RULE th1)) in DISCH_ALL (CONJUNCT1 th2) in fun th -> try let abs = rand(concl th) in let ty = snd(dest_var(bndvar abs)) in MP (PINST [ty,aty] [abs,P] pth) th with Failure _ -> failwith "EXISTENCE";; hol-light/calc_int.ml000066400000000000000000000353211303454263000150570ustar00rootroot00000000000000(* ========================================================================= *) (* Calculation with integer-valued reals. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "realax.ml";; (* ------------------------------------------------------------------------- *) (* Syntax operations on integer constants of type ":real". *) (* ------------------------------------------------------------------------- *) let is_realintconst tm = match tm with Comb(Const("real_of_num",_),n) -> is_numeral n | Comb(Const("real_neg",_),Comb(Const("real_of_num",_),n)) -> is_numeral n && not(dest_numeral n = num_0) | _ -> false;; let dest_realintconst tm = match tm with Comb(Const("real_of_num",_),n) -> dest_numeral n | Comb(Const("real_neg",_),Comb(Const("real_of_num",_),n)) -> let nn = dest_numeral n in if nn <>/ num_0 then minus_num(dest_numeral n) else failwith "dest_realintconst" | _ -> failwith "dest_realintconst";; let mk_realintconst = let cast_tm = `real_of_num` and neg_tm = `(--)` in let mk_numconst n = mk_comb(cast_tm,mk_numeral n) in fun x -> if x is_realintconst p && is_realintconst q & (let m = dest_realintconst p and n = dest_realintconst q in n >/ num_1 && gcd_num m n =/ num_1) | _ -> is_realintconst tm;; let rat_of_term tm = match tm with Comb(Comb(Const("real_div",_),p),q) -> let m = dest_realintconst p and n = dest_realintconst q in if n >/ num_1 && gcd_num m n =/ num_1 then m // n else failwith "rat_of_term" | _ -> dest_realintconst tm;; let term_of_rat = let div_tm = `(/)` in fun x -> let p,q = numdom x in let ptm = mk_realintconst p in if q = num_1 then ptm else mk_comb(mk_comb(div_tm,ptm),mk_realintconst q);; (* ------------------------------------------------------------------------- *) (* Some elementary "bootstrapping" lemmas we need below. *) (* ------------------------------------------------------------------------- *) let REAL_ADD_AC = prove (`(m + n = n + m) /\ ((m + n) + p = m + (n + p)) /\ (m + (n + p) = n + (m + p))`, MESON_TAC[REAL_ADD_ASSOC; REAL_ADD_SYM]);; let REAL_ADD_RINV = prove (`!x. x + --x = &0`, MESON_TAC[REAL_ADD_SYM; REAL_ADD_LINV]);; let REAL_EQ_ADD_LCANCEL = prove (`!x y z. (x + y = x + z) <=> (y = z)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o AP_TERM `(+) (--x)`) THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]);; let REAL_EQ_ADD_RCANCEL = prove (`!x y z. (x + z = y + z) <=> (x = y)`, MESON_TAC[REAL_ADD_SYM; REAL_EQ_ADD_LCANCEL]);; let REAL_MUL_RZERO = prove (`!x. x * &0 = &0`, MESON_TAC[REAL_EQ_ADD_RCANCEL; REAL_ADD_LDISTRIB; REAL_ADD_LID]);; let REAL_MUL_LZERO = prove (`!x. &0 * x = &0`, MESON_TAC[REAL_MUL_SYM; REAL_MUL_RZERO]);; let REAL_NEG_NEG = prove (`!x. --(--x) = x`, MESON_TAC [REAL_EQ_ADD_RCANCEL; REAL_ADD_LINV; REAL_ADD_SYM; REAL_ADD_LINV]);; let REAL_MUL_RNEG = prove (`!x y. x * (--y) = -- (x * y)`, MESON_TAC[REAL_EQ_ADD_RCANCEL; REAL_ADD_LDISTRIB; REAL_ADD_LINV; REAL_MUL_RZERO]);; let REAL_MUL_LNEG = prove (`!x y. (--x) * y = -- (x * y)`, MESON_TAC[REAL_MUL_SYM; REAL_MUL_RNEG]);; let REAL_NEG_ADD = prove (`!x y. --(x + y) = --x + --y`, REPEAT GEN_TAC THEN MATCH_MP_TAC(GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL REAL_EQ_ADD_RCANCEL)))) THEN EXISTS_TAC `x + y` THEN REWRITE_TAC[REAL_ADD_LINV] THEN ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (a + c) + (b + d)`] THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; let REAL_ADD_RID = prove (`!x. x + &0 = x`, MESON_TAC[REAL_ADD_SYM; REAL_ADD_LID]);; let REAL_NEG_0 = prove (`--(&0) = &0`, MESON_TAC[REAL_ADD_LINV; REAL_ADD_RID]);; let REAL_LE_LNEG = prove (`!x y. --x <= y <=> &0 <= x + y`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_LADD_IMP) THENL [DISCH_THEN(MP_TAC o SPEC `x:real`) THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LINV]; DISCH_THEN(MP_TAC o SPEC `--x`) THEN REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_ASSOC; REAL_ADD_LID; ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]);; let REAL_LE_NEG2 = prove (`!x y. --x <= --y <=> y <= x`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_NEG_NEG] THEN REWRITE_TAC[REAL_LE_LNEG] THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_ADD_SYM);; let REAL_LE_RNEG = prove (`!x y. x <= --y <=> x + y <= &0`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_NEG_NEG] THEN REWRITE_TAC[REAL_LE_LNEG; GSYM REAL_NEG_ADD] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_LE_NEG2] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_ADD_LINV] THEN REWRITE_TAC[REAL_NEG_ADD; REAL_NEG_NEG] THEN MATCH_ACCEPT_TAC REAL_ADD_SYM);; let REAL_OF_NUM_POW = prove (`!x n. (&x) pow n = &(x EXP n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; EXP; REAL_OF_NUM_MUL]);; let REAL_POW_NEG = prove (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; EVEN] THEN ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_NEG_NEG]);; let REAL_ABS_NUM = prove (`!n. abs(&n) = &n`, REWRITE_TAC[real_abs; REAL_OF_NUM_LE; LE_0]);; let REAL_ABS_NEG = prove (`!x. abs(--x) = abs x`, REWRITE_TAC[real_abs; REAL_LE_RNEG; REAL_NEG_NEG; REAL_ADD_LID] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM; REAL_NEG_0]);; (* ------------------------------------------------------------------------- *) (* First, the conversions on integer constants. *) (* ------------------------------------------------------------------------- *) let REAL_INT_LE_CONV,REAL_INT_LT_CONV, REAL_INT_GE_CONV,REAL_INT_GT_CONV,REAL_INT_EQ_CONV = let tth = TAUT `(F /\ F <=> F) /\ (F /\ T <=> F) /\ (T /\ F <=> F) /\ (T /\ T <=> T)` in let nth = TAUT `(~T <=> F) /\ (~F <=> T)` in let NUM2_EQ_CONV = BINOP_CONV NUM_EQ_CONV THENC GEN_REWRITE_CONV I [tth] in let NUM2_NE_CONV = RAND_CONV NUM2_EQ_CONV THENC GEN_REWRITE_CONV I [nth] in let [pth_le1; pth_le2a; pth_le2b; pth_le3] = (CONJUNCTS o prove) (`(--(&m) <= &n <=> T) /\ (&m <= &n <=> m <= n) /\ (--(&m) <= --(&n) <=> n <= m) /\ (&m <= --(&n) <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[REAL_LE_NEG2] THEN REWRITE_TAC[REAL_LE_LNEG; REAL_LE_RNEG] THEN REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; LE_0] THEN REWRITE_TAC[LE; ADD_EQ_0]) in let REAL_INT_LE_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_le1]; GEN_REWRITE_CONV I [pth_le2a; pth_le2b] THENC NUM_LE_CONV; GEN_REWRITE_CONV I [pth_le3] THENC NUM2_EQ_CONV] in let [pth_lt1; pth_lt2a; pth_lt2b; pth_lt3] = (CONJUNCTS o prove) (`(&m < --(&n) <=> F) /\ (&m < &n <=> m < n) /\ (--(&m) < --(&n) <=> n < m) /\ (--(&m) < &n <=> ~((m = 0) /\ (n = 0)))`, REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; GSYM NOT_LE; real_lt] THEN CONV_TAC TAUT) in let REAL_INT_LT_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_lt1]; GEN_REWRITE_CONV I [pth_lt2a; pth_lt2b] THENC NUM_LT_CONV; GEN_REWRITE_CONV I [pth_lt3] THENC NUM2_NE_CONV] in let [pth_ge1; pth_ge2a; pth_ge2b; pth_ge3] = (CONJUNCTS o prove) (`(&m >= --(&n) <=> T) /\ (&m >= &n <=> n <= m) /\ (--(&m) >= --(&n) <=> m <= n) /\ (--(&m) >= &n <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; real_ge] THEN CONV_TAC TAUT) in let REAL_INT_GE_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_ge1]; GEN_REWRITE_CONV I [pth_ge2a; pth_ge2b] THENC NUM_LE_CONV; GEN_REWRITE_CONV I [pth_ge3] THENC NUM2_EQ_CONV] in let [pth_gt1; pth_gt2a; pth_gt2b; pth_gt3] = (CONJUNCTS o prove) (`(--(&m) > &n <=> F) /\ (&m > &n <=> n < m) /\ (--(&m) > --(&n) <=> m < n) /\ (&m > --(&n) <=> ~((m = 0) /\ (n = 0)))`, REWRITE_TAC[pth_lt1; pth_lt2a; pth_lt2b; pth_lt3; real_gt] THEN CONV_TAC TAUT) in let REAL_INT_GT_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_gt1]; GEN_REWRITE_CONV I [pth_gt2a; pth_gt2b] THENC NUM_LT_CONV; GEN_REWRITE_CONV I [pth_gt3] THENC NUM2_NE_CONV] in let [pth_eq1a; pth_eq1b; pth_eq2a; pth_eq2b] = (CONJUNCTS o prove) (`((&m = &n) <=> (m = n)) /\ ((--(&m) = --(&n)) <=> (m = n)) /\ ((--(&m) = &n) <=> (m = 0) /\ (n = 0)) /\ ((&m = --(&n)) <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; GSYM LE_ANTISYM] THEN REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; LE; LE_0] THEN CONV_TAC TAUT) in let REAL_INT_EQ_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_eq1a; pth_eq1b] THENC NUM_EQ_CONV; GEN_REWRITE_CONV I [pth_eq2a; pth_eq2b] THENC NUM2_EQ_CONV] in REAL_INT_LE_CONV,REAL_INT_LT_CONV, REAL_INT_GE_CONV,REAL_INT_GT_CONV,REAL_INT_EQ_CONV;; let REAL_INT_NEG_CONV = let pth = prove (`(--(&0) = &0) /\ (--(--(&x)) = &x)`, REWRITE_TAC[REAL_NEG_NEG; REAL_NEG_0]) in GEN_REWRITE_CONV I [pth];; let REAL_INT_MUL_CONV = let pth0 = prove (`(&0 * &x = &0) /\ (&0 * --(&x) = &0) /\ (&x * &0 = &0) /\ (--(&x) * &0 = &0)`, REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]) and pth1,pth2 = (CONJ_PAIR o prove) (`((&m * &n = &(m * n)) /\ (--(&m) * --(&n) = &(m * n))) /\ ((--(&m) * &n = --(&(m * n))) /\ (&m * --(&n) = --(&(m * n))))`, REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_OF_NUM_MUL]) in FIRST_CONV [GEN_REWRITE_CONV I [pth0]; GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_MULT_CONV; GEN_REWRITE_CONV I [pth2] THENC RAND_CONV(RAND_CONV NUM_MULT_CONV)];; let REAL_INT_ADD_CONV = let neg_tm = `(--)` in let amp_tm = `&` in let add_tm = `(+)` in let dest = dest_binop `(+)` in let m_tm = `m:num` and n_tm = `n:num` in let pth0 = prove (`(--(&m) + &m = &0) /\ (&m + --(&m) = &0)`, REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_RINV]) in let [pth1; pth2; pth3; pth4; pth5; pth6] = (CONJUNCTS o prove) (`(--(&m) + --(&n) = --(&(m + n))) /\ (--(&m) + &(m + n) = &n) /\ (--(&(m + n)) + &m = --(&n)) /\ (&(m + n) + --(&m) = &n) /\ (&m + --(&(m + n)) = --(&n)) /\ (&m + &n = &(m + n))`, REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_NEG_ADD] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID] THEN REWRITE_TAC[REAL_ADD_RINV; REAL_ADD_LID] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID] THEN REWRITE_TAC[REAL_ADD_RINV; REAL_ADD_LID]) in GEN_REWRITE_CONV I [pth0] ORELSEC (fun tm -> try let l,r = dest tm in if rator l = neg_tm then if rator r = neg_tm then let th1 = INST [rand(rand l),m_tm; rand(rand r),n_tm] pth1 in let tm1 = rand(rand(rand(concl th1))) in let th2 = AP_TERM neg_tm (AP_TERM amp_tm (NUM_ADD_CONV tm1)) in TRANS th1 th2 else let m = rand(rand l) and n = rand r in let m' = dest_numeral m and n' = dest_numeral n in if m' <=/ n' then let p = mk_numeral (n' -/ m') in let th1 = INST [m,m_tm; p,n_tm] pth2 in let th2 = NUM_ADD_CONV (rand(rand(lhand(concl th1)))) in let th3 = AP_TERM (rator tm) (AP_TERM amp_tm (SYM th2)) in TRANS th3 th1 else let p = mk_numeral (m' -/ n') in let th1 = INST [n,m_tm; p,n_tm] pth3 in let th2 = NUM_ADD_CONV (rand(rand(lhand(lhand(concl th1))))) in let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_THM (AP_TERM add_tm th3) (rand tm) in TRANS th4 th1 else if rator r = neg_tm then let m = rand l and n = rand(rand r) in let m' = dest_numeral m and n' = dest_numeral n in if n' <=/ m' then let p = mk_numeral (m' -/ n') in let th1 = INST [n,m_tm; p,n_tm] pth4 in let th2 = NUM_ADD_CONV (rand(lhand(lhand(concl th1)))) in let th3 = AP_TERM add_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_THM th3 (rand tm) in TRANS th4 th1 else let p = mk_numeral (n' -/ m') in let th1 = INST [m,m_tm; p,n_tm] pth5 in let th2 = NUM_ADD_CONV (rand(rand(rand(lhand(concl th1))))) in let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_TERM (rator tm) th3 in TRANS th4 th1 else let th1 = INST [rand l,m_tm; rand r,n_tm] pth6 in let tm1 = rand(rand(concl th1)) in let th2 = AP_TERM amp_tm (NUM_ADD_CONV tm1) in TRANS th1 th2 with Failure _ -> failwith "REAL_INT_ADD_CONV");; let REAL_INT_SUB_CONV = GEN_REWRITE_CONV I [real_sub] THENC TRY_CONV(RAND_CONV REAL_INT_NEG_CONV) THENC REAL_INT_ADD_CONV;; let REAL_INT_POW_CONV = let pth1,pth2 = (CONJ_PAIR o prove) (`(&x pow n = &(x EXP n)) /\ ((--(&x)) pow n = if EVEN n then &(x EXP n) else --(&(x EXP n)))`, REWRITE_TAC[REAL_OF_NUM_POW; REAL_POW_NEG]) in let tth = prove (`((if T then x:real else y) = x) /\ ((if F then x:real else y) = y)`, REWRITE_TAC[]) in let neg_tm = `(--)` in (GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_EXP_CONV) ORELSEC (GEN_REWRITE_CONV I [pth2] THENC RATOR_CONV(RATOR_CONV(RAND_CONV NUM_EVEN_CONV)) THENC GEN_REWRITE_CONV I [tth] THENC (fun tm -> if rator tm = neg_tm then RAND_CONV(RAND_CONV NUM_EXP_CONV) tm else RAND_CONV NUM_EXP_CONV tm));; let REAL_INT_ABS_CONV = let pth = prove (`(abs(--(&x)) = &x) /\ (abs(&x) = &x)`, REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM]) in GEN_REWRITE_CONV I [pth];; let REAL_INT_RED_CONV = let gconv_net = itlist (uncurry net_of_conv) [`x <= y`,REAL_INT_LE_CONV; `x < y`,REAL_INT_LT_CONV; `x >= y`,REAL_INT_GE_CONV; `x > y`,REAL_INT_GT_CONV; `x:real = y`,REAL_INT_EQ_CONV; `--x`,CHANGED_CONV REAL_INT_NEG_CONV; `abs(x)`,REAL_INT_ABS_CONV; `x + y`,REAL_INT_ADD_CONV; `x - y`,REAL_INT_SUB_CONV; `x * y`,REAL_INT_MUL_CONV; `x pow n`,REAL_INT_POW_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let REAL_INT_REDUCE_CONV = DEPTH_CONV REAL_INT_RED_CONV;; hol-light/calc_num.ml000066400000000000000000002043521303454263000150660ustar00rootroot00000000000000(* ========================================================================= *) (* Calculation with naturals. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "wf.ml";; (* ------------------------------------------------------------------------- *) (* Simple rule to get rid of NUMERAL constant. *) (* ------------------------------------------------------------------------- *) let DENUMERAL = GEN_REWRITE_RULE DEPTH_CONV [NUMERAL];; (* ------------------------------------------------------------------------- *) (* Big collection of rewrites to do trivial arithmetic. *) (* *) (* Note that we have none for DIV and MOD, and that PRE and SUB are a bit *) (* inefficient; log(n)^2 instead of log(n). *) (* ------------------------------------------------------------------------- *) let ARITH_ZERO = prove (`(NUMERAL 0 = 0) /\ (BIT0 _0 = _0)`, REWRITE_TAC[NUMERAL; BIT0; DENUMERAL ADD_CLAUSES]);; let ARITH_SUC = prove (`(!n. SUC(NUMERAL n) = NUMERAL(SUC n)) /\ (SUC _0 = BIT1 _0) /\ (!n. SUC (BIT0 n) = BIT1 n) /\ (!n. SUC (BIT1 n) = BIT0 (SUC n))`, REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL ADD_CLAUSES]);; let ARITH_PRE = prove (`(!n. PRE(NUMERAL n) = NUMERAL(PRE n)) /\ (PRE _0 = _0) /\ (!n. PRE(BIT0 n) = if n = _0 then _0 else BIT1 (PRE n)) /\ (!n. PRE(BIT1 n) = BIT0 n)`, REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL PRE] THEN INDUCT_TAC THEN REWRITE_TAC[NUMERAL; DENUMERAL PRE; DENUMERAL ADD_CLAUSES; DENUMERAL NOT_SUC; ARITH_ZERO]);; let ARITH_ADD = prove (`(!m n. NUMERAL(m) + NUMERAL(n) = NUMERAL(m + n)) /\ (_0 + _0 = _0) /\ (!n. _0 + BIT0 n = BIT0 n) /\ (!n. _0 + BIT1 n = BIT1 n) /\ (!n. BIT0 n + _0 = BIT0 n) /\ (!n. BIT1 n + _0 = BIT1 n) /\ (!m n. BIT0 m + BIT0 n = BIT0 (m + n)) /\ (!m n. BIT0 m + BIT1 n = BIT1 (m + n)) /\ (!m n. BIT1 m + BIT0 n = BIT1 (m + n)) /\ (!m n. BIT1 m + BIT1 n = BIT0 (SUC(m + n)))`, PURE_REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL ADD_CLAUSES; SUC_INJ] THEN REWRITE_TAC[ADD_AC]);; let ARITH_MULT = prove (`(!m n. NUMERAL(m) * NUMERAL(n) = NUMERAL(m * n)) /\ (_0 * _0 = _0) /\ (!n. _0 * BIT0 n = _0) /\ (!n. _0 * BIT1 n = _0) /\ (!n. BIT0 n * _0 = _0) /\ (!n. BIT1 n * _0 = _0) /\ (!m n. BIT0 m * BIT0 n = BIT0 (BIT0 (m * n))) /\ (!m n. BIT0 m * BIT1 n = BIT0 m + BIT0 (BIT0 (m * n))) /\ (!m n. BIT1 m * BIT0 n = BIT0 n + BIT0 (BIT0 (m * n))) /\ (!m n. BIT1 m * BIT1 n = BIT1 m + BIT0 n + BIT0 (BIT0 (m * n)))`, PURE_REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL MULT_CLAUSES; DENUMERAL ADD_CLAUSES; SUC_INJ] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; ADD_AC]);; let ARITH_EXP = prove (`(!m n. (NUMERAL m) EXP (NUMERAL n) = NUMERAL(m EXP n)) /\ (_0 EXP _0 = BIT1 _0) /\ (!m. (BIT0 m) EXP _0 = BIT1 _0) /\ (!m. (BIT1 m) EXP _0 = BIT1 _0) /\ (!n. _0 EXP (BIT0 n) = (_0 EXP n) * (_0 EXP n)) /\ (!m n. (BIT0 m) EXP (BIT0 n) = ((BIT0 m) EXP n) * ((BIT0 m) EXP n)) /\ (!m n. (BIT1 m) EXP (BIT0 n) = ((BIT1 m) EXP n) * ((BIT1 m) EXP n)) /\ (!n. _0 EXP (BIT1 n) = _0) /\ (!m n. (BIT0 m) EXP (BIT1 n) = BIT0 m * ((BIT0 m) EXP n) * ((BIT0 m) EXP n)) /\ (!m n. (BIT1 m) EXP (BIT1 n) = BIT1 m * ((BIT1 m) EXP n) * ((BIT1 m) EXP n))`, REWRITE_TAC[NUMERAL] THEN REPEAT STRIP_TAC THEN TRY(GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [BIT0; BIT1]) THEN REWRITE_TAC[DENUMERAL EXP; DENUMERAL MULT_CLAUSES; EXP_ADD]);; let ARITH_EVEN = prove (`(!n. EVEN(NUMERAL n) <=> EVEN n) /\ (EVEN _0 <=> T) /\ (!n. EVEN(BIT0 n) <=> T) /\ (!n. EVEN(BIT1 n) <=> F)`, REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL EVEN; EVEN_ADD]);; let ARITH_ODD = prove (`(!n. ODD(NUMERAL n) <=> ODD n) /\ (ODD _0 <=> F) /\ (!n. ODD(BIT0 n) <=> F) /\ (!n. ODD(BIT1 n) <=> T)`, REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL ODD; ODD_ADD]);; let ARITH_LE = prove (`(!m n. NUMERAL m <= NUMERAL n <=> m <= n) /\ ((_0 <= _0) <=> T) /\ (!n. (BIT0 n <= _0) <=> n <= _0) /\ (!n. (BIT1 n <= _0) <=> F) /\ (!n. (_0 <= BIT0 n) <=> T) /\ (!n. (_0 <= BIT1 n) <=> T) /\ (!m n. (BIT0 m <= BIT0 n) <=> m <= n) /\ (!m n. (BIT0 m <= BIT1 n) <=> m <= n) /\ (!m n. (BIT1 m <= BIT0 n) <=> m < n) /\ (!m n. (BIT1 m <= BIT1 n) <=> m <= n)`, REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL NOT_SUC; DENUMERAL(GSYM NOT_SUC); SUC_INJ] THEN REWRITE_TAC[DENUMERAL LE_0] THEN REWRITE_TAC[DENUMERAL LE; GSYM MULT_2] THEN REWRITE_TAC[LE_MULT_LCANCEL; SUC_INJ; DENUMERAL MULT_EQ_0; DENUMERAL NOT_SUC] THEN REWRITE_TAC[DENUMERAL NOT_SUC] THEN REWRITE_TAC[LE_SUC_LT] THEN REWRITE_TAC[LT_MULT_LCANCEL] THEN SUBGOAL_THEN `2 = SUC 1` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL ADD_CLAUSES]; REWRITE_TAC[DENUMERAL NOT_SUC; NOT_SUC; EQ_MULT_LCANCEL] THEN REWRITE_TAC[ONCE_REWRITE_RULE[DISJ_SYM] LE_LT] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN SUBGOAL_THEN `~(SUC 1 * m = SUC (SUC 1 * n))` (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; EVEN_ADD; NUMERAL; BIT1; EVEN]]);; let ARITH_LT = prove (`(!m n. NUMERAL m < NUMERAL n <=> m < n) /\ ((_0 < _0) <=> F) /\ (!n. (BIT0 n < _0) <=> F) /\ (!n. (BIT1 n < _0) <=> F) /\ (!n. (_0 < BIT0 n) <=> _0 < n) /\ (!n. (_0 < BIT1 n) <=> T) /\ (!m n. (BIT0 m < BIT0 n) <=> m < n) /\ (!m n. (BIT0 m < BIT1 n) <=> m <= n) /\ (!m n. (BIT1 m < BIT0 n) <=> m < n) /\ (!m n. (BIT1 m < BIT1 n) <=> m < n)`, REWRITE_TAC[NUMERAL; GSYM NOT_LE; ARITH_LE] THEN REWRITE_TAC[DENUMERAL LE]);; let ARITH_GE = REWRITE_RULE[GSYM GE; GSYM GT] ARITH_LE;; let ARITH_GT = REWRITE_RULE[GSYM GE; GSYM GT] ARITH_LT;; let ARITH_EQ = prove (`(!m n. (NUMERAL m = NUMERAL n) <=> (m = n)) /\ ((_0 = _0) <=> T) /\ (!n. (BIT0 n = _0) <=> (n = _0)) /\ (!n. (BIT1 n = _0) <=> F) /\ (!n. (_0 = BIT0 n) <=> (_0 = n)) /\ (!n. (_0 = BIT1 n) <=> F) /\ (!m n. (BIT0 m = BIT0 n) <=> (m = n)) /\ (!m n. (BIT0 m = BIT1 n) <=> F) /\ (!m n. (BIT1 m = BIT0 n) <=> F) /\ (!m n. (BIT1 m = BIT1 n) <=> (m = n))`, REWRITE_TAC[NUMERAL; GSYM LE_ANTISYM; ARITH_LE] THEN REWRITE_TAC[LET_ANTISYM; LTE_ANTISYM; DENUMERAL LE_0]);; let ARITH_SUB = prove (`(!m n. NUMERAL m - NUMERAL n = NUMERAL(m - n)) /\ (_0 - _0 = _0) /\ (!n. _0 - BIT0 n = _0) /\ (!n. _0 - BIT1 n = _0) /\ (!n. BIT0 n - _0 = BIT0 n) /\ (!n. BIT1 n - _0 = BIT1 n) /\ (!m n. BIT0 m - BIT0 n = BIT0 (m - n)) /\ (!m n. BIT0 m - BIT1 n = PRE(BIT0 (m - n))) /\ (!m n. BIT1 m - BIT0 n = if n <= m then BIT1 (m - n) else _0) /\ (!m n. BIT1 m - BIT1 n = BIT0 (m - n))`, REWRITE_TAC[NUMERAL; DENUMERAL SUB_0] THEN PURE_REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2; SUB_SUC; LEFT_SUB_DISTRIB] THEN REWRITE_TAC[SUB] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DENUMERAL SUB_EQ_0] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE]) THEN ASM_REWRITE_TAC[LE_SUC_LT; LT_MULT_LCANCEL; ARITH_EQ] THEN POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[ADD1; LEFT_ADD_DISTRIB] THEN REWRITE_TAC[ADD_SUB2; GSYM ADD_ASSOC]);; let ARITH = end_itlist CONJ [ARITH_ZERO; ARITH_SUC; ARITH_PRE; ARITH_ADD; ARITH_MULT; ARITH_EXP; ARITH_EVEN; ARITH_ODD; ARITH_EQ; ARITH_LE; ARITH_LT; ARITH_GE; ARITH_GT; ARITH_SUB];; (* ------------------------------------------------------------------------- *) (* Now more delicate conversions for situations where efficiency matters. *) (* ------------------------------------------------------------------------- *) let NUM_EVEN_CONV = let tth,rths = CONJ_PAIR ARITH_EVEN in GEN_REWRITE_CONV I [tth] THENC GEN_REWRITE_CONV I [rths];; let NUM_ODD_CONV = let tth,rths = CONJ_PAIR ARITH_ODD in GEN_REWRITE_CONV I [tth] THENC GEN_REWRITE_CONV I [rths];; let NUM_SUC_CONV,NUM_ADD_CONV,NUM_MULT_CONV,NUM_EXP_CONV, NUM_LT_CONV,NUM_LE_CONV,NUM_EQ_CONV = let num_ty = type_of(lhand(concl ZERO_DEF)) in let Comb(NUMERAL_tm,Comb(BIT0_tm,Comb(BIT1_tm,zero_tm))) = mk_small_numeral 2 and suc_tm = rator(rand(concl TWO)) and one_tm = rand(mk_small_numeral 1) and add_tm = rator(rator(lhand(snd(strip_forall(concl ADD_0))))) and mul_tm = rator(rator(rand(snd(strip_forall(concl EXP_2))))) and exp_tm = rator(rator(lhand(snd(strip_forall(concl EXP_2))))) and eq_tm = rator(rator(concl TWO)) in let num_0 = Int 0 and num_1 = Int 1 and num_2 = Int 2 in let a_tm = mk_var("a",num_ty) and b_tm = mk_var("b",num_ty) and c_tm = mk_var("c",num_ty) and d_tm = mk_var("d",num_ty) and e_tm = mk_var("e",num_ty) and h_tm = mk_var("h",num_ty) and l_tm = mk_var("l",num_ty) and m_tm = mk_var("m",num_ty) and n_tm = mk_var("n",num_ty) and p_tm = mk_var("p",num_ty) in let STANDARDIZE = let ilist = [BIT0_tm,BIT0_tm; BIT1_tm,BIT1_tm; zero_tm,zero_tm; suc_tm,suc_tm; add_tm,add_tm; mul_tm,mul_tm; exp_tm,exp_tm; eq_tm,eq_tm; NUMERAL_tm,NUMERAL_tm; a_tm,a_tm; b_tm,b_tm; c_tm,c_tm; d_tm,d_tm; e_tm,e_tm; h_tm,h_tm; l_tm,l_tm; m_tm,m_tm; n_tm,n_tm; p_tm,p_tm] in let rec replace tm = match tm with Var(_,_) | Const(_,_) -> rev_assocd tm ilist tm | Comb(s,t) -> mk_comb(replace s,replace t) | Abs(_,_) -> failwith "replace" in fun th -> let tm' = replace (concl th) in EQ_MP (REFL tm') th in let REFL_bit0 = STANDARDIZE(REFL BIT0_tm) and REFL_bit1 = STANDARDIZE(REFL BIT1_tm) in let AP_BIT0 th = MK_COMB(REFL_bit0,th) and AP_BIT1 th = MK_COMB(REFL_bit1,th) and QUICK_PROVE_HYP ath bth = EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath in let rec dest_raw_numeral tm = match tm with Comb(Const("BIT1",_),t) -> num_2 */ dest_raw_numeral t +/ num_1 | Comb(Const("BIT0",_),t) -> num_2 */ dest_raw_numeral t | Const("_0",_) -> num_0 in let bitcounts = let rec bctr w z tm = match tm with Const("_0",_) -> (w,z) | Comb(Const("BIT0",_),t) -> bctr w (z + 1) t | Comb(Const("BIT1",_),t) -> bctr (w + 1) z t | _ -> failwith "malformed numeral" in bctr 0 0 in let rec wellformed tm = match tm with Const("_0",_) -> true | Comb(Const("BIT0",_),t)|Comb(Const("BIT1",_),t) -> wellformed t | _ -> false in let rec orderrelation mtm ntm = if mtm == ntm then if wellformed mtm then 0 else failwith "orderrelation" else match (mtm,ntm) with Const("_0",_),Const("_0",_) -> 0 | Const("_0",_),_ -> if wellformed ntm then -1 else failwith "orderrelation" | _, Const("_0",_) -> if wellformed ntm then 1 else failwith "orderrelation" | Comb(Const("BIT0",_),mt),Comb(Const("BIT0",_),nt) | Comb(Const("BIT1",_),mt),Comb(Const("BIT1",_),nt) -> orderrelation mt nt | Comb(Const("BIT0",_),mt),Comb(Const("BIT1",_),nt) -> if orderrelation mt nt > 0 then 1 else -1 | Comb(Const("BIT1",_),mt),Comb(Const("BIT0",_),nt) -> if orderrelation mt nt < 0 then -1 else 1 in let doublebn tm = if tm = zero_tm then tm else mk_comb(BIT0_tm,tm) in let rec subbn mtm ntm = match (mtm,ntm) with (_,Const("_0",_)) -> mtm | (Comb(Const("BIT0",_),mt),Comb(Const("BIT0",_),nt)) -> doublebn (subbn mt nt) | (Comb(Const("BIT1",_),mt),Comb(Const("BIT1",_),nt)) -> doublebn (subbn mt nt) | (Comb(Const("BIT1",_),mt),Comb(Const("BIT0",_),nt)) -> mk_comb(BIT1_tm,subbn mt nt) | (Comb(Const("BIT0",_),mt),Comb(Const("BIT1",_),nt)) -> mk_comb(BIT1_tm,sbcbn mt nt) | _ -> failwith "malformed numeral or wrong relation" and sbcbn mtm ntm = match (mtm,ntm) with | (Comb(Const("BIT0",_),mt),Const("_0",_)) -> mk_comb(BIT1_tm,sbcbn mt ntm) | (Comb(Const("BIT1",_),mt),Const("_0",_)) -> doublebn mt | (Comb(Const("BIT0",_),mt),Comb(Const("BIT0",_),nt)) -> mk_comb(BIT1_tm,sbcbn mt nt) | (Comb(Const("BIT1",_),mt),Comb(Const("BIT1",_),nt)) -> mk_comb(BIT1_tm,sbcbn mt nt) | (Comb(Const("BIT1",_),mt),Comb(Const("BIT0",_),nt)) -> doublebn (subbn mt nt) | (Comb(Const("BIT0",_),mt),Comb(Const("BIT1",_),nt)) -> doublebn (sbcbn mt nt) | _ -> failwith "malformed numeral or wrong relation" in let topsplit tm = match tm with Const("_0",_) -> 0,zero_tm | Comb(Const("BIT1",_),Const("_0",_)) -> 1,zero_tm | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Const("_0",_))) -> 2,zero_tm | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Const("_0",_))) -> 3,zero_tm | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 4,zero_tm | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 5,zero_tm | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 6,zero_tm | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 7,zero_tm | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 0,n | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 1,n | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 2,n | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 3,n | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 4,n | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 5,n | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 6,n | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 7,n | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 8,n | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 9,n | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 10,n | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 11,n | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 12,n | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 13,n | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 14,n | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 15,n | _ -> failwith "malformed numeral" in let NUM_ADD_RULE,NUM_ADC_RULE = let rec mk_compnumeral k base = if k = 0 then base else let t = mk_compnumeral (k / 2) base in if k mod 2 = 1 then mk_comb(BIT1_tm,t) else mk_comb(BIT0_tm,t) in let bases v = let part2 = map (fun k -> mk_compnumeral k v) (8--15) in let part1 = map (subst[mk_comb(BIT0_tm,v),mk_comb(BIT1_tm,v)]) part2 and part0 = map (fun k -> mk_compnumeral k zero_tm) (0--15) in part0 @ part1 @ part2 in let starts = allpairs (fun mtm ntm -> mk_comb(mk_comb(add_tm,mtm),ntm)) (bases m_tm) (bases n_tm) in let BITS_INJ = (STANDARDIZE o prove) (`(BIT0 m = BIT0 n <=> m = n) /\ (BIT1 m = BIT1 n <=> m = n)`, REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ]) in let ARITH_0 = (STANDARDIZE o MESON[NUMERAL; ADD_CLAUSES]) `m + _0 = m /\ _0 + n = n` in let patadj = subst[`SUC(m + _0)`,`SUC m`; `SUC(_0 + n)`,`SUC n`] in let mkclauses sucflag t = let tm = if sucflag then mk_comb(suc_tm,t) else t in let th1 = PURE_REWRITE_CONV[ARITH_ADD; ARITH_SUC; ARITH_0] tm in let tm1 = patadj(rand(concl th1)) in if not(free_in add_tm tm1) then th1, (if free_in m_tm tm1 then 0 else 1) else let ptm = rand(rand(rand(rand tm1))) in let tmc = mk_eq(mk_eq(ptm,p_tm),mk_eq(tm,subst[p_tm,ptm] tm1)) in EQT_ELIM(REWRITE_CONV[ARITH_ADD; ARITH_SUC; ARITH_0; BITS_INJ] tmc), (if free_in suc_tm tm1 then 3 else 2) in let add_clauses,add_flags = let l1,l2 = unzip(map (mkclauses false) starts) in Array.of_list(map STANDARDIZE l1),Array.of_list l2 in let adc_clauses,adc_flags = let l1,l2 = unzip(map (mkclauses true) starts) in Array.of_list(map STANDARDIZE l1),Array.of_list l2 in let rec NUM_ADD_RULE mtm ntm = let m_lo,m_hi = topsplit mtm and n_lo,n_hi = topsplit ntm in let m_ind = if m_hi = zero_tm then m_lo else m_lo + 16 and n_ind = if n_hi = zero_tm then n_lo else n_lo + 16 in let ind = 32 * m_ind + n_ind in let th1 = Array.get add_clauses ind and fl = Array.get add_flags ind in match fl with 0 -> INST [m_hi,m_tm] th1 | 1 -> INST [n_hi,n_tm] th1 | 2 -> let th2 = NUM_ADD_RULE m_hi n_hi in (match concl th2 with Comb(_,ptm) -> let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in EQ_MP th3 th2) | 3 -> let th2 = NUM_ADC_RULE m_hi n_hi in (match concl th2 with Comb(_,ptm) -> let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in EQ_MP th3 th2) and NUM_ADC_RULE mtm ntm = let m_lo,m_hi = topsplit mtm and n_lo,n_hi = topsplit ntm in let m_ind = if m_hi = zero_tm then m_lo else m_lo + 16 and n_ind = if n_hi = zero_tm then n_lo else n_lo + 16 in let ind = 32 * m_ind + n_ind in let th1 = Array.get adc_clauses ind and fl = Array.get adc_flags ind in match fl with 0 -> INST [m_hi,m_tm] th1 | 1 -> INST [n_hi,n_tm] th1 | 2 -> let th2 = NUM_ADD_RULE m_hi n_hi in (match concl th2 with Comb(_,ptm) -> let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in EQ_MP th3 th2) | 3 -> let th2 = NUM_ADC_RULE m_hi n_hi in (match concl th2 with Comb(_,ptm) -> let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in EQ_MP th3 th2) in NUM_ADD_RULE,NUM_ADC_RULE in let NUM_SHIFT_CONV = let pth_0 = (STANDARDIZE o prove) (`(n = a + p * b <=> BIT0 n = BIT0 a + BIT0 p * b)`, REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2; GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) and pth_z = (STANDARDIZE o prove) (`n = _0 + p * b <=> BIT0 n = _0 + BIT0 p * b`, SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN REWRITE_TAC[BIT1; BIT0] THEN REWRITE_TAC[ADD_CLAUSES; GSYM MULT_2] THEN REWRITE_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL; ARITH_EQ]) and pth_1 = (STANDARDIZE o prove) (`(n = a + p * b <=> BIT1 n = BIT1 a + BIT0 p * b)`, REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2; GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB; ADD_CLAUSES; SUC_INJ] THEN REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) and pth_base = (STANDARDIZE o prove) (`n = _0 + BIT1 _0 * n`, MESON_TAC[ADD_CLAUSES; MULT_CLAUSES; NUMERAL]) and pth_triv = (STANDARDIZE o prove) (`_0 = a + p * b <=> _0 = a + BIT0 p * b`, CONV_TAC(BINOP_CONV SYM_CONV) THEN SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN REWRITE_TAC[ADD_EQ_0; MULT_EQ_0; BIT0]) and pths_1 = (Array.of_list o CONJUNCTS o STANDARDIZE o prove) (`(n = a + p * b <=> BIT0(BIT0(BIT0(BIT0 n))) = BIT0(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT0(BIT0(BIT0 n))) = BIT1(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT0(BIT1(BIT0(BIT0 n))) = BIT0(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT1(BIT0(BIT0 n))) = BIT1(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT0(BIT0(BIT1(BIT0 n))) = BIT0(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT0(BIT1(BIT0 n))) = BIT1(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT0(BIT1(BIT1(BIT0 n))) = BIT0(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT1(BIT1(BIT0 n))) = BIT1(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT0(BIT0(BIT0(BIT1 n))) = BIT0(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT0(BIT0(BIT1 n))) = BIT1(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT0(BIT1(BIT0(BIT1 n))) = BIT0(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT1(BIT0(BIT1 n))) = BIT1(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT0(BIT0(BIT1(BIT1 n))) = BIT0(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT0(BIT1(BIT1 n))) = BIT1(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT0(BIT1(BIT1(BIT1 n))) = BIT0(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = a + p * b <=> BIT1(BIT1(BIT1(BIT1 n))) = BIT1(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b)`, MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT0) THEN MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT1) THEN ABBREV_TAC `two = 2` THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ; GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC]) and pths_0 = (Array.of_list o CONJUNCTS o STANDARDIZE o prove) (`(n = _0 + p * b <=> BIT0(BIT0(BIT0(BIT0 n))) = _0 + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT0(BIT0(BIT0 n))) = BIT1 _0 + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT0(BIT1(BIT0(BIT0 n))) = BIT0(BIT1 _0) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT1(BIT0(BIT0 n))) = BIT1(BIT1 _0) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT0(BIT0(BIT1(BIT0 n))) = BIT0(BIT0(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT0(BIT1(BIT0 n))) = BIT1(BIT0(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT0(BIT1(BIT1(BIT0 n))) = BIT0(BIT1(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT1(BIT1(BIT0 n))) = BIT1(BIT1(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT0(BIT0(BIT0(BIT1 n))) = BIT0(BIT0(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT0(BIT0(BIT1 n))) = BIT1(BIT0(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT0(BIT1(BIT0(BIT1 n))) = BIT0(BIT1(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT1(BIT0(BIT1 n))) = BIT1(BIT1(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT0(BIT0(BIT1(BIT1 n))) = BIT0(BIT0(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT0(BIT1(BIT1 n))) = BIT1(BIT0(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT0(BIT1(BIT1(BIT1 n))) = BIT0(BIT1(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ (n = _0 + p * b <=> BIT1(BIT1(BIT1(BIT1 n))) = BIT1(BIT1(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b)`, SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT0) THEN MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT1) THEN ABBREV_TAC `two = 2` THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ; GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC]) in let rec NUM_SHIFT_CONV k tm = if k <= 0 then INST [tm,n_tm] pth_base else match tm with Comb(_,Comb(_,Comb(_,Comb(_,_)))) when k >= 4 -> let i,ntm = topsplit tm in let th1 = NUM_SHIFT_CONV (k - 4) ntm in (match concl th1 with Comb(_,Comb(Comb(_,Const("_0",_)),Comb(Comb(_,ptm),btm))) -> let th2 = Array.get pths_0 i in let th3 = INST [ntm,n_tm; btm,b_tm; ptm,p_tm] th2 in EQ_MP th3 th1 | Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> let th2 = Array.get pths_1 i in let th3 = INST[ntm,n_tm; atm,a_tm; btm,b_tm; ptm,p_tm] th2 in EQ_MP th3 th1) | Comb(Const("BIT0",_),ntm) -> let th1 = NUM_SHIFT_CONV (k - 1) ntm in (match concl th1 with Comb(_,Comb(Comb(_,Const("_0",_)),Comb(Comb(_,ptm),btm))) -> EQ_MP (INST [ntm,n_tm; btm,b_tm; ptm,p_tm] pth_z) th1 | Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> EQ_MP (INST[ntm,n_tm; atm,a_tm; btm,b_tm; ptm,p_tm] pth_0) th1) | Comb(Const("BIT1",_),ntm) -> let th1 = NUM_SHIFT_CONV (k - 1) ntm in (match concl th1 with Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> EQ_MP (INST [ntm,n_tm; atm,a_tm; btm,b_tm; ptm,p_tm] pth_1) th1) | Const("_0",_) -> let th1 = NUM_SHIFT_CONV (k - 1) tm in (match concl th1 with Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> EQ_MP (INST [atm,a_tm; btm,b_tm; ptm,p_tm] pth_triv) th1) | _ -> failwith "malformed numeral" in NUM_SHIFT_CONV in let NUM_UNSHIFT_CONV = let pth_triv = (STANDARDIZE o prove) (`a + p * _0 = a`, SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]) and pth_base = (STANDARDIZE o prove) (`a + BIT1 _0 * b = a + b`, SUBST1_TAC(SYM(SPEC `BIT1 _0` NUMERAL)) THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]) and pth_0 = (STANDARDIZE o prove) (`BIT0 a + BIT0 p * b = BIT0(a + p * b)`, REWRITE_TAC[BIT0] THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB]) and pth_1 = (STANDARDIZE o prove) (`BIT1 a + BIT0 p * b = BIT1(a + p * b)`, REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ] THEN REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) and pth_z = (STANDARDIZE o prove) (`_0 + BIT0 p * b = BIT0(_0 + p * b)`, SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN REWRITE_TAC[BIT1; BIT0] THEN REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB]) and puths_1 = (Array.of_list o CONJUNCTS o STANDARDIZE o prove) (`(a + p * b = n <=> BIT0(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT0(BIT0(BIT0 n)))) /\ (a + p * b = n <=> BIT1(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT0(BIT0(BIT0 n)))) /\ (a + p * b = n <=> BIT0(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT1(BIT0(BIT0 n)))) /\ (a + p * b = n <=> BIT1(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT1(BIT0(BIT0 n)))) /\ (a + p * b = n <=> BIT0(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT0(BIT1(BIT0 n)))) /\ (a + p * b = n <=> BIT1(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT0(BIT1(BIT0 n)))) /\ (a + p * b = n <=> BIT0(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT1(BIT1(BIT0 n)))) /\ (a + p * b = n <=> BIT1(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT1(BIT1(BIT0 n)))) /\ (a + p * b = n <=> BIT0(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT0(BIT0(BIT1 n)))) /\ (a + p * b = n <=> BIT1(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT0(BIT0(BIT1 n)))) /\ (a + p * b = n <=> BIT0(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT1(BIT0(BIT1 n)))) /\ (a + p * b = n <=> BIT1(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT1(BIT0(BIT1 n)))) /\ (a + p * b = n <=> BIT0(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT0(BIT1(BIT1 n)))) /\ (a + p * b = n <=> BIT1(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT0(BIT1(BIT1 n)))) /\ (a + p * b = n <=> BIT0(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT0(BIT1(BIT1(BIT1 n)))) /\ (a + p * b = n <=> BIT1(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = BIT1(BIT1(BIT1(BIT1 n))))`, SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT0) THEN MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT1) THEN ABBREV_TAC `two = 2` THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ; GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC]) in let puths_2 = Array.of_list (map (fun i -> let th1 = Array.get puths_1 (i mod 16) and th2 = Array.get puths_1 (i / 16) in let th3 = GEN_REWRITE_RULE RAND_CONV [th1] th2 in STANDARDIZE th3) (0--255)) in let rec NUM_UNSHIFT_CONV tm = match tm with Comb(Comb(Const("+",_),atm),Comb(Comb(Const("*",_),ptm),btm)) -> (match (atm,ptm,btm) with (_,_,Const("_0",_)) -> INST [atm,a_tm; ptm,p_tm] pth_triv | (_,Comb(Const("BIT1",_),Const("_0",_)),_) -> let th1 = INST [atm,a_tm; btm,b_tm] pth_base in let Comb(_,Comb(Comb(_,mtm),ntm)) = concl th1 in TRANS th1 (NUM_ADD_RULE mtm ntm) | (Comb(_,Comb(_,Comb(_,Comb(_,atm')))), Comb(_,Comb(_,Comb(_,Comb(_,(Comb(_,_) as ptm'))))),_) -> let i,_ = topsplit atm in (match (atm',ptm') with (Comb(_,Comb(_,Comb(_,Comb(_,atm'')))), Comb(_,Comb(_,Comb(_,Comb(_,(Comb(_,_) as ptm'')))))) -> let j,_ = topsplit atm' in let tm' = mk_comb(mk_comb(add_tm,atm''), mk_comb(mk_comb(mul_tm,ptm''),btm)) in let th1 = NUM_UNSHIFT_CONV tm' in let th2 = INST [atm'',a_tm; ptm'',p_tm; btm,b_tm; rand(concl th1),n_tm] (Array.get puths_2 (16 * j + i)) in EQ_MP th2 th1 | _ -> let tm' = mk_comb(mk_comb(add_tm,atm'), mk_comb(mk_comb(mul_tm,ptm'),btm)) in let th1 = NUM_UNSHIFT_CONV tm' in let th2 = INST [atm',a_tm; ptm',p_tm; btm,b_tm; rand(concl th1),n_tm] (Array.get puths_1 i) in EQ_MP th2 th1) | (Const("_0",_),Comb(Const("BIT0",_),qtm),_) -> let th1 = INST [btm,b_tm; qtm,p_tm] pth_z in CONV_RULE(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV)) th1 | (Comb(Const("BIT0",_),ctm),Comb(Const("BIT0",_),qtm),_) -> let th1 = INST [ctm,a_tm; btm,b_tm; qtm,p_tm] pth_0 in CONV_RULE(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV)) th1 | (Comb(Const("BIT1",_),ctm),Comb(Const("BIT0",_),qtm),_) -> let th1 = INST [ctm,a_tm; btm,b_tm; qtm,p_tm] pth_1 in CONV_RULE(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV)) th1 | _ -> failwith "malformed numeral") | _ -> failwith "malformed numeral" in NUM_UNSHIFT_CONV in let NUM_SQUARE_RULE = let pth_0 = (STANDARDIZE o prove) (`_0 EXP 2 = _0`, MESON_TAC[NUMERAL; REWRITE_CONV[ARITH] `0 EXP 2`]) and pth_1 = (STANDARDIZE o prove) (`(BIT1 _0) EXP 2 = BIT1 _0`, MESON_TAC[NUMERAL; REWRITE_CONV[ARITH] `1 EXP 2`]) and pth_even = (STANDARDIZE o prove) (`m EXP 2 = n <=> (BIT0 m) EXP 2 = BIT0(BIT0 n)`, ABBREV_TAC `two = 2` THEN REWRITE_TAC[BIT0] THEN EXPAND_TAC "two" THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[EXP_2] THEN REWRITE_TAC[AC MULT_AC `(2 * m) * (2 * n) = 2 * 2 * m * n`] THEN REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) and pth_odd = (STANDARDIZE o prove) (`m EXP 2 = n <=> (BIT1 m) EXP 2 = BIT1(BIT0(m + n))`, ABBREV_TAC `two = 2` THEN REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN EXPAND_TAC "two" THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[SUC_INJ; GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN REWRITE_TAC[AC ADD_AC `(m + m * 2 * m) + m = m * 2 * m + m + m`] THEN REWRITE_TAC[GSYM MULT_2; AC MULT_AC `m * 2 * m = 2 * m * m`] THEN REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ADD_SYM] THEN REWRITE_TAC[EQ_ADD_RCANCEL]) and pth_qstep = (UNDISCH o STANDARDIZE o prove) (`n + BIT1 _0 = m /\ m EXP 2 = p /\ m + a = BIT0(BIT0 p) ==> (BIT1(BIT1(BIT1 n))) EXP 2 = BIT1(BIT0(BIT0(BIT0 a)))`, ABBREV_TAC `two = 2` THEN SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN REWRITE_TAC[BIT1; BIT0] THEN EXPAND_TAC "two" THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[ADD1; LEFT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN REWRITE_TAC[MULT_ASSOC] THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_TAC THEN MATCH_MP_TAC(MESON[EQ_ADD_LCANCEL] `!m:num. m + n = m + p ==> n = p`) THEN EXISTS_TAC `16 * (n + 1)` THEN ASM_REWRITE_TAC[ADD_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN EXPAND_TAC "two" THEN REWRITE_TAC[EXP_2] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_CLAUSES; MULT_ASSOC] THEN REWRITE_TAC[AC MULT_AC `(8 * n) * NUMERAL p = (8 * NUMERAL p) * n`] THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[AC ADD_AC `(n + 16) + p + q + 49 = (n + p + q) + (16 + 49)`] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[ADD_ASSOC; EQ_ADD_RCANCEL] THEN REWRITE_TAC[GSYM ADD_ASSOC; GSYM MULT_2; MULT_ASSOC] THEN ONCE_REWRITE_TAC[AC ADD_AC `a + b + c:num = b + a + c`] THEN REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[ARITH]) and pth_rec = (UNDISCH o STANDARDIZE o prove) (`n = l + p * h /\ h + l = m /\ h EXP 2 = a /\ l EXP 2 = c /\ m EXP 2 = d /\ a + c = e /\ e + b = d ==> n EXP 2 = c + p * (b + p * a)`, REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN SUBST1_TAC THEN REPLICATE_TAC 5 (DISCH_THEN(SUBST1_TAC o SYM)) THEN REWRITE_TAC[EXP_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC] THEN CONV_TAC(BINOP_CONV NUM_CANCEL_CONV) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]) and pth_toom3 = (STANDARDIZE o prove) (`h EXP 2 = e /\ l EXP 2 = a /\ (l + BIT1 _0 * (m + BIT1 _0 * h)) EXP 2 = a + BIT1 _0 * (b + BIT1 _0 * (c + BIT1 _0 * (d + BIT1 _0 * e))) /\ (l + BIT0(BIT1 _0) * (m + BIT0(BIT1 _0) * h)) EXP 2 = a + BIT0(BIT1 _0) * (b + BIT0(BIT1 _0) * (c + BIT0(BIT1 _0) * (d + BIT0(BIT1 _0) * e))) /\ (h + BIT0(BIT1 _0) * (m + BIT0(BIT1 _0) * l)) EXP 2 = e + BIT0(BIT1 _0) * (d + BIT0(BIT1 _0) * (c + BIT0(BIT1 _0) * (b + BIT0(BIT1 _0) * a))) ==> (l + p * (m + p * h)) EXP 2 = a + p * (b + p * (c + p * (d + p * e)))`, ABBREV_TAC `two = 2` THEN SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN REWRITE_TAC[BIT1; BIT0] THEN EXPAND_TAC "two" THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[ARITH] THEN SUBGOAL_THEN `!p x y z. (x + p * (y + p * z)) EXP 2 = x * x + p * (2 * x * y + p * ((2 * x * z + y * y) + p * (2 * y * z + p * z * z)))` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXP_2; MULT_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]; REWRITE_TAC[EXP_2]] THEN MAP_EVERY ABBREV_TAC [`a':num = l * l`; `b' = 2 * l * m`; `c' = 2 * l * h + m * m`; `d' = 2 * m * h`; `e':num = h * h`] THEN SUBST1_TAC(AC MULT_AC `2 * m * l = 2 * l * m`) THEN SUBST1_TAC(AC MULT_AC `2 * h * l = 2 * l * h`) THEN SUBST1_TAC(AC MULT_AC `2 * h * m = 2 * m * h`) THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "two" THEN POP_ASSUM_LIST(K ALL_TAC) THEN ASM_CASES_TAC `a':num = a` THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `e':num = e` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC] THEN REWRITE_TAC[ARITH] THEN REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN REWRITE_TAC[ADD_ASSOC; EQ_ADD_RCANCEL] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[] `b = b' /\ c = c' /\ d = d' ==> 5 * b + c' + d' = 5 * b' + c + d`)) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC] THEN REWRITE_TAC(map (fun k -> SYM(REWRITE_CONV[ARITH_SUC] (mk_comb(suc_tm,mk_small_numeral(k - 1))))) (1--5)) THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN CONV_TAC(LAND_CONV NUM_CANCEL_CONV) THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[] `b = b' /\ c = c' /\ d = d' ==> b + d':num = b' + d /\ 4 * b + d' = 4 * b' + d`)) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC] THEN REWRITE_TAC(map (fun k -> SYM(REWRITE_CONV[ARITH_SUC] (mk_comb(suc_tm,mk_small_numeral(k - 1))))) (1--4)) THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN CONV_TAC(LAND_CONV(BINOP_CONV NUM_CANCEL_CONV)) THEN REWRITE_TAC[GSYM MULT_2] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM(el 4 (CONJUNCTS MULT_CLAUSES))] THEN SIMP_TAC[EQ_MULT_LCANCEL; NOT_SUC]) and pth_even3 = (STANDARDIZE o prove) (`m EXP 2 = n <=> (BIT0(BIT0(BIT0 m))) EXP 2 = BIT0(BIT0(BIT0(BIT0(BIT0(BIT0 n)))))`, ABBREV_TAC `two = 2` THEN REWRITE_TAC[BIT0] THEN REWRITE_TAC[GSYM MULT_2] THEN EXPAND_TAC "two" THEN REWRITE_TAC[EXP_2] THEN REWRITE_TAC[AC MULT_AC `(2 * 2 * 2 * m) * 2 * 2 * 2 * m = 2 * 2 * 2 * 2 * 2 * 2 * m * m`] THEN REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) in let NUM_UNSHIFT2_CONV = RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV) THENC NUM_UNSHIFT_CONV in let NUM_UNSHIFT3_CONV = RAND_CONV(RAND_CONV NUM_UNSHIFT2_CONV) THENC NUM_UNSHIFT_CONV in let NUM_UNSHIFT4_CONV = RAND_CONV(RAND_CONV NUM_UNSHIFT3_CONV) THENC NUM_UNSHIFT_CONV in let BINOP2_CONV conv1 conv2 = COMB2_CONV (RAND_CONV conv1) conv2 in let TOOM3_CONV = BINOP2_CONV (LAND_CONV NUM_UNSHIFT2_CONV) NUM_UNSHIFT4_CONV in let rec GEN_NUM_SQUARE_RULE w z tm = match tm with Const("_0",_) -> pth_0 | Comb(Const("BIT0",_),mtm) -> (match mtm with Comb(Const("BIT0",_),Comb(Const("BIT0",_),ptm)) -> let th1 = GEN_NUM_SQUARE_RULE w (z - 3) ptm in let ntm = rand(concl th1) in EQ_MP (INST [ptm,m_tm; ntm,n_tm] pth_even3) th1 | _ -> let th1 = GEN_NUM_SQUARE_RULE w (z - 1) mtm in let ntm = rand(concl th1) in EQ_MP (INST [mtm,m_tm; ntm,n_tm] pth_even) th1) | Comb(Const("BIT1",_),mtm) -> if mtm = zero_tm then pth_1 else if (w < 100 || z < 20) && w + z < 150 then match mtm with Comb(Const("BIT1",_),Comb(Const("BIT1",_),ntm)) -> let th1 = NUM_ADD_RULE ntm one_tm in let mtm = rand(concl th1) in let th2 = NUM_SQUARE_RULE mtm in let ptm = rand(concl th2) in let atm = subbn (mk_comb(BIT0_tm,mk_comb(BIT0_tm,ptm))) mtm in let th3 = NUM_ADD_RULE mtm atm in let th4 = INST [atm,a_tm; mtm,m_tm; ntm,n_tm; ptm,p_tm] pth_qstep in QUICK_PROVE_HYP (CONJ th1 (CONJ th2 th3)) th4 | _ -> let th1 = GEN_NUM_SQUARE_RULE (w - 1) z mtm in let ntm = rand(concl th1) in let th2 = EQ_MP (INST [mtm,m_tm; ntm,n_tm] pth_odd) th1 in (match concl th2 with Comb(_,Comb(_,Comb(_,Comb(Comb(_,ptm),qtm)))) -> let th3 = NUM_ADD_RULE ptm qtm in TRANS th2 (AP_BIT1 (AP_BIT0 th3))) else if w + z < 800 then let k2 = (w + z) / 2 in let th1 = NUM_SHIFT_CONV k2 tm in let Comb(Comb(_,ltm),Comb(Comb(_,ptm),htm)) = rand(concl th1) in let th2 = NUM_ADD_RULE htm ltm in let mtm = rand(concl th2) in let th3 = NUM_SQUARE_RULE htm and th4 = NUM_SQUARE_RULE ltm and th5 = NUM_SQUARE_RULE mtm in let atm = rand(concl th3) and ctm = rand(concl th4) and dtm = rand(concl th5) in let th6 = NUM_ADD_RULE atm ctm in let etm = rand(concl th6) in let btm = subbn dtm etm in let th7 = NUM_ADD_RULE etm btm in let dtm = rand(concl th7) in let th8 = INST [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; etm,e_tm; htm,h_tm; ltm,l_tm; mtm,m_tm; tm,n_tm; ptm,p_tm] pth_rec in let th9 = QUICK_PROVE_HYP (end_itlist CONJ [th1;th2;th3;th4;th5;th6;th7]) th8 in CONV_RULE(RAND_CONV(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV) THENC NUM_UNSHIFT_CONV)) th9 else let k3 = (w + z) / 3 in let th0 = (NUM_SHIFT_CONV k3 THENC RAND_CONV(RAND_CONV(NUM_SHIFT_CONV k3))) tm in let Comb(Comb(_,ltm),Comb(Comb(_,ptm), Comb(Comb(_,mtm),Comb(Comb(_,_),htm)))) = rand(concl th0) in let th1 = NUM_SQUARE_RULE htm and th2 = NUM_SQUARE_RULE ltm in let atm = rand(concl th2) and etm = rand(concl th1) in let lnum = dest_raw_numeral ltm and mnum = dest_raw_numeral mtm and hnum = dest_raw_numeral htm in let btm = rand(mk_numeral(num_2 */ lnum */ mnum)) and ctm = rand(mk_numeral(mnum */ mnum +/ num_2 */ lnum */ hnum)) and dtm = rand(mk_numeral(num_2 */ hnum */ mnum)) in let th = INST [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; etm,e_tm; htm,h_tm; mtm,m_tm; ltm,l_tm; ptm,p_tm] pth_toom3 in let th' = CONV_RULE (BINOP2_CONV (RAND_CONV(RAND_CONV (BINOP2_CONV TOOM3_CONV (BINOP2_CONV TOOM3_CONV TOOM3_CONV)))) TOOM3_CONV) th in let [tm3;tm4;tm5] = conjuncts(rand(rand(lhand(concl th')))) in let th3 = NUM_SQUARE_RULE (lhand(lhand tm3)) and th4 = NUM_SQUARE_RULE (lhand(lhand tm4)) and th5 = NUM_SQUARE_RULE (lhand(lhand tm5)) in MP th' (end_itlist CONJ [th1;th2;th3;th4;th5]) and NUM_SQUARE_RULE tm = let w,z = bitcounts tm in GEN_NUM_SQUARE_RULE w z tm in NUM_SQUARE_RULE in let NUM_MUL_RULE = let QUICK_PROVE_HYP ath bth = EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath and pth_0l,pth_0r = (CONJ_PAIR o STANDARDIZE o prove) (`_0 * n = _0 /\ m * _0 = _0`, MESON_TAC[NUMERAL; MULT_CLAUSES]) and pth_1l,pth_1r = (CONJ_PAIR o STANDARDIZE o prove) (`(BIT1 _0) * n = n /\ m * (BIT1 _0) = m`, MESON_TAC[NUMERAL; MULT_CLAUSES]) and pth_evenl,pth_evenr = (CONJ_PAIR o STANDARDIZE o prove) (`(m * n = p <=> (BIT0 m) * n = BIT0 p) /\ (m * n = p <=> m * BIT0 n = BIT0 p)`, REWRITE_TAC[BIT0] THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[AC MULT_AC `m * 2 * n = 2 * m * n`] THEN REWRITE_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL; ARITH_EQ]) and pth_oddl,pth_oddr = (CONJ_PAIR o STANDARDIZE o prove) (`(m * n = p <=> BIT1 m * n = BIT0 p + n) /\ (m * n = p <=> m * BIT1 n = BIT0 p + m)`, REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[MULT_CLAUSES] THEN REWRITE_TAC[MESON[MULT_AC; ADD_SYM] `m + m * 2 * n = 2 * m * n + m`] THEN REWRITE_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL; EQ_ADD_RCANCEL] THEN REWRITE_TAC[ARITH_EQ]) in let pth_oo1 = (UNDISCH_ALL o STANDARDIZE o prove) (`n + p = m /\ SUC(m + n) = a /\ p EXP 2 = b /\ a EXP 2 = c /\ b + d = c ==> ((BIT1 m) * (BIT1 n) = d)`, ABBREV_TAC `two = 2` THEN REWRITE_TAC[BIT1; IMP_CONJ] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[EXP_2; GSYM MULT_2] THEN REPLICATE_TAC 4 (DISCH_THEN(SUBST1_TAC o SYM)) THEN REWRITE_TAC[ADD1; AC ADD_AC `((n + p) + n) + 1 = (p + (n + n)) + 1`] THEN REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[GSYM ADD_ASSOC; MULT_CLAUSES; EQ_ADD_LCANCEL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[MULT_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]) in let pth_oo2 = PURE_ONCE_REWRITE_RULE[MULT_SYM] (INST [n_tm,m_tm; m_tm,n_tm] pth_oo1) in let pth_recodel = (UNDISCH_ALL o STANDARDIZE o prove) (`SUC(_0 + m) = p ==> (p * n = a + n <=> m * n = a)`, SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; EQ_ADD_RCANCEL]) and pth_recoder = (UNDISCH_ALL o STANDARDIZE o prove) (`SUC(_0 + n) = p ==> (m * p = a + m <=> m * n = a)`, ONCE_REWRITE_TAC[MULT_SYM] THEN SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; EQ_ADD_RCANCEL]) in let rec NUM_MUL_RULE k l tm tm' = match (tm,tm') with (Const("_0",_),_) -> INST [tm',n_tm] pth_0l | (_,Const("_0",_)) -> INST [tm,m_tm] pth_0r | (Comb(Const("BIT1",_),Const("_0",_)),_) -> INST [tm',n_tm] pth_1l | (_,Comb(Const("BIT1",_),Const("_0",_))) -> INST [tm,m_tm] pth_1r | (Comb(Const("BIT0",_),mtm),_) -> let th0 = NUM_MUL_RULE (k - 1) l mtm tm' in let th1 = INST [mtm,m_tm; tm',n_tm; rand(concl th0),p_tm] pth_evenl in EQ_MP th1 th0 | (_,Comb(Const("BIT0",_),ntm)) -> let th0 = NUM_MUL_RULE k (l - 1) tm ntm in let th1 = INST [tm,m_tm; ntm,n_tm; rand(concl th0),p_tm] pth_evenr in EQ_MP th1 th0 | (Comb(Const("BIT1",_),mtm),Comb(Const("BIT1",_),ntm)) -> if k <= 50 || l <= 50 || Int k */ Int k <=/ Int l || Int l */ Int l <= Int k then match (mtm,ntm) with (Comb(Const("BIT1",_),Comb(Const("BIT1",_),_)),_) -> let th1 = NUM_ADC_RULE zero_tm tm in let ptm = rand(concl th1) in let th2 = NUM_MUL_RULE k l ptm tm' in let atm = subbn (rand(concl th2)) tm' in let th3 = INST [tm,m_tm; tm',n_tm; ptm,p_tm; atm,a_tm] pth_recodel in let th4 = PROVE_HYP th1 th3 in EQ_MP th4 (TRANS th2 (SYM(NUM_ADD_RULE atm tm'))) | (_,Comb(Const("BIT1",_),Comb(Const("BIT1",_),_))) -> let th1 = NUM_ADC_RULE zero_tm tm' in let ptm = rand(concl th1) in let th2 = NUM_MUL_RULE k l tm ptm in let atm = subbn (rand(concl th2)) tm in let th3 = INST [tm,m_tm; tm',n_tm; ptm,p_tm; atm,a_tm] pth_recoder in let th4 = PROVE_HYP th1 th3 in EQ_MP th4 (TRANS th2 (SYM(NUM_ADD_RULE atm tm))) | _ -> if k <= l then let th0 = NUM_MUL_RULE (k - 1) l mtm tm' in let ptm = rand(concl th0) in let th1 = EQ_MP (INST [mtm,m_tm; tm',n_tm; ptm,p_tm] pth_oddl) th0 in let tm1 = lhand(rand(concl th1)) in TRANS th1 (NUM_ADD_RULE tm1 tm') else let th0 = NUM_MUL_RULE k (l - 1) tm ntm in let ptm = rand(concl th0) in let th1 = EQ_MP (INST [tm,m_tm; ntm,n_tm; ptm,p_tm] pth_oddr) th0 in let tm1 = lhand(rand(concl th1)) in TRANS th1 (NUM_ADD_RULE tm1 tm) else let mval = dest_raw_numeral mtm and nval = dest_raw_numeral ntm in if nval <=/ mval then let ptm = rand(mk_numeral(mval -/ nval)) in let th2 = NUM_ADD_RULE ntm ptm and th3 = NUM_ADC_RULE mtm ntm in let atm = rand(concl th3) in let th4 = NUM_SQUARE_RULE ptm in let btm = rand(concl th4) in let th5 = NUM_SQUARE_RULE atm in let ctm = rand(concl th5) in let dtm = subbn ctm btm in let th6 = NUM_ADD_RULE btm dtm in let th1 = INST [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; mtm,m_tm; ntm,n_tm; ptm,p_tm] pth_oo1 in QUICK_PROVE_HYP (end_itlist CONJ [th2;th3;th4;th5;th6]) th1 else let ptm = rand(mk_numeral(nval -/ mval)) in let th2 = NUM_ADD_RULE mtm ptm and th3 = NUM_ADC_RULE ntm mtm in let atm = rand(concl th3) in let th4 = NUM_SQUARE_RULE ptm in let btm = rand(concl th4) in let th5 = NUM_SQUARE_RULE atm in let ctm = rand(concl th5) in let dtm = subbn ctm btm in let th6 = NUM_ADD_RULE btm dtm in let th1 = INST [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; mtm,m_tm; ntm,n_tm; ptm,p_tm] pth_oo2 in QUICK_PROVE_HYP (end_itlist CONJ [th2;th3;th4;th5;th6]) th1 | _ -> failwith "NUM_MUL_RULE" in NUM_MUL_RULE in let NUM_MULT_CONV' = let pth_refl = (STANDARDIZE o MESON[EXP_2]) `m EXP 2 = p <=> m * m = p` in fun tm -> match tm with Comb(Comb(Const("*",_),mtm),ntm) -> if Pervasives.compare mtm ntm = 0 then let th1 = NUM_SQUARE_RULE mtm in let ptm = rand(concl th1) in EQ_MP (INST [mtm,m_tm;ptm,p_tm] pth_refl) th1 else let w1,z1 = bitcounts mtm and w2,z2 = bitcounts ntm in NUM_MUL_RULE (w1+z1) (w2+z2) mtm ntm | _ -> failwith "NUM_MULT_CONV'" in let NUM_SUC_CONV = let pth = (STANDARDIZE o prove) (`SUC(_0 + m) = n <=> SUC(NUMERAL m) = NUMERAL n`, BINOP_TAC THEN MESON_TAC[NUMERAL; ADD_CLAUSES]) in fun tm -> match tm with Comb(Const("SUC",_),Comb(Const("NUMERAL",_),mtm)) when wellformed mtm -> let th1 = NUM_ADC_RULE zero_tm mtm in let ntm = rand(concl th1) in EQ_MP(INST [mtm,m_tm; ntm,n_tm] pth) th1 | _ -> failwith "NUM_SUC_CONV" in let NUM_ADD_CONV = let topthm_add = (STANDARDIZE o MESON[NUMERAL]) `m + n = p <=> NUMERAL m + NUMERAL n = NUMERAL p` in fun tm -> match tm with Comb(Comb(Const("+",_),Comb(Const("NUMERAL",_),mtm)), Comb(Const("NUMERAL",_),ntm)) when wellformed mtm && wellformed ntm -> let th1 = NUM_ADD_RULE mtm ntm in let ptm = rand(concl th1) in let th2 = INST [mtm,m_tm; ntm,n_tm; ptm,p_tm] topthm_add in EQ_MP th2 th1 | _ -> failwith "NUM_ADD_CONV" in let NUM_MULT_CONV = let topthm_mul = (STANDARDIZE o MESON[NUMERAL]) `m * n = p <=> NUMERAL m * NUMERAL n = NUMERAL p` and pth_refl = (STANDARDIZE o MESON[NUMERAL; EXP_2]) `m EXP 2 = p <=> NUMERAL m * NUMERAL m = NUMERAL p` in fun tm -> match tm with Comb(Comb(Const("*",_),Comb(Const("NUMERAL",_),mtm)), Comb(Const("NUMERAL",_),ntm)) -> if Pervasives.compare mtm ntm = 0 then let th1 = NUM_SQUARE_RULE mtm in let ptm = rand(concl th1) in EQ_MP (INST [mtm,m_tm;ptm,p_tm] pth_refl) th1 else let w1,z1 = bitcounts mtm and w2,z2 = bitcounts ntm in let th1 = NUM_MUL_RULE (w1+z1) (w2+z2) mtm ntm in let ptm = rand(concl th1) in let th2 = INST [mtm,m_tm; ntm,n_tm; ptm,p_tm] topthm_mul in EQ_MP th2 th1 | _ -> failwith "NUM_MULT_CONV" in let NUM_EXP_CONV = let pth0 = (STANDARDIZE o prove) (`(m EXP n = p) ==> (p * p = a) ==> (m EXP (BIT0 n) = a)`, REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN REWRITE_TAC[BIT0; EXP_ADD]) and pth1 = (STANDARDIZE o prove) (`(m EXP n = p) ==> (p * p = b) ==> (m * b = a) ==> (m EXP (BIT1 n) = a)`, REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN REWRITE_TAC[BIT1; EXP_ADD; EXP]) and pth = (STANDARDIZE o prove) (`m EXP _0 = BIT1 _0`, MP_TAC (CONJUNCT1 EXP) THEN REWRITE_TAC[NUMERAL; BIT1] THEN DISCH_THEN MATCH_ACCEPT_TAC) and tth = (STANDARDIZE o prove) (`(NUMERAL m) EXP (NUMERAL n) = m EXP n`, REWRITE_TAC[NUMERAL]) and fth = (STANDARDIZE o prove) (`m = NUMERAL m`, REWRITE_TAC[NUMERAL]) in let tconv = GEN_REWRITE_CONV I [tth] in let rec NUM_EXP_CONV l r = if r = zero_tm then INST [l,m_tm] pth else let b,r' = dest_comb r in if b = BIT0_tm then let th1 = NUM_EXP_CONV l r' in let tm1 = rand(concl th1) in let th2 = NUM_MULT_CONV' (mk_binop mul_tm tm1 tm1) in let tm2 = rand(concl th2) in MP (MP (INST [l,m_tm; r',n_tm; tm1,p_tm; tm2,a_tm] pth0) th1) th2 else let th1 = NUM_EXP_CONV l r' in let tm1 = rand(concl th1) in let th2 = NUM_MULT_CONV' (mk_binop mul_tm tm1 tm1) in let tm2 = rand(concl th2) in let th3 = NUM_MULT_CONV' (mk_binop mul_tm l tm2) in let tm3 = rand(concl th3) in MP (MP (MP (INST [l,m_tm; r',n_tm; tm1,p_tm; tm2,b_tm; tm3,a_tm] pth1) th1) th2) th3 in fun tm -> try let th = tconv tm in let lop,r = dest_comb (rand(concl th)) in let _,l = dest_comb lop in if not (wellformed l && wellformed r) then failwith "" else let th' = NUM_EXP_CONV l r in let tm' = rand(concl th') in TRANS (TRANS th th') (INST [tm',m_tm] fth) with Failure _ -> failwith "NUM_EXP_CONV" in let NUM_LT_CONV = let pth = (UNDISCH o STANDARDIZE o prove) (`SUC(m + n) = p ==> ((NUMERAL n < NUMERAL p) <=> T)`, REWRITE_TAC[NUMERAL; LT_EXISTS; ADD_CLAUSES] THEN MESON_TAC[ADD_SYM]) and qth = (UNDISCH o STANDARDIZE o prove) (`m + p = n ==> (NUMERAL n < NUMERAL p <=> F)`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[NOT_LT; NUMERAL] THEN MESON_TAC[LE_ADD; ADD_SYM]) and rth = (STANDARDIZE o prove) (`NUMERAL n < NUMERAL n <=> F`, MESON_TAC[LT_REFL]) in fun tm -> match tm with Comb(Comb(Const("<",_),Comb(Const("NUMERAL",_),mtm)), Comb(Const("NUMERAL",_),ntm)) -> let rel = orderrelation mtm ntm in if rel = 0 then INST[ntm,n_tm] rth else if rel < 0 then let dtm = sbcbn ntm mtm in let th = NUM_ADC_RULE dtm mtm in QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] pth) else let dtm = subbn mtm ntm in let th = NUM_ADD_RULE dtm ntm in QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] qth) | _ -> failwith "NUM_LT_CONV" and NUM_LE_CONV = let pth = (UNDISCH o STANDARDIZE o prove) (`m + n = p ==> ((NUMERAL n <= NUMERAL p) <=> T)`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[NUMERAL] THEN MESON_TAC[LE_ADD; ADD_SYM]) and qth = (UNDISCH o STANDARDIZE o prove) (`SUC(m + p) = n ==> (NUMERAL n <= NUMERAL p <=> F)`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[NUMERAL; NOT_LE; ADD_CLAUSES; LT_EXISTS] THEN MESON_TAC[ADD_SYM]) and rth = (STANDARDIZE o prove) (`NUMERAL n <= NUMERAL n <=> T`, REWRITE_TAC[LE_REFL]) in fun tm -> match tm with Comb(Comb(Const("<=",_),Comb(Const("NUMERAL",_),mtm)), Comb(Const("NUMERAL",_),ntm)) -> let rel = orderrelation mtm ntm in if rel = 0 then INST[ntm,n_tm] rth else if rel < 0 then let dtm = subbn ntm mtm in let th = NUM_ADD_RULE dtm mtm in QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] pth) else let dtm = sbcbn mtm ntm in let th = NUM_ADC_RULE dtm ntm in QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] qth) | _ -> failwith "NUM_LE_CONV" and NUM_EQ_CONV = let pth = (UNDISCH o STANDARDIZE o prove) (`SUC(m + n) = p ==> ((NUMERAL n = NUMERAL p) <=> F)`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[NUMERAL; GSYM LE_ANTISYM; DE_MORGAN_THM] THEN REWRITE_TAC[NOT_LE; LT_EXISTS; ADD_CLAUSES] THEN MESON_TAC[ADD_SYM]) and qth = (UNDISCH o STANDARDIZE o prove) (`SUC(m + p) = n ==> ((NUMERAL n = NUMERAL p) <=> F)`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[NUMERAL; GSYM LE_ANTISYM; DE_MORGAN_THM] THEN REWRITE_TAC[NOT_LE; LT_EXISTS; ADD_CLAUSES] THEN MESON_TAC[ADD_SYM]) and rth = (STANDARDIZE o prove) (`(NUMERAL n = NUMERAL n) <=> T`, REWRITE_TAC[]) in fun tm -> match tm with Comb(Comb(Const("=",_),Comb(Const("NUMERAL",_),mtm)), Comb(Const("NUMERAL",_),ntm)) -> let rel = orderrelation mtm ntm in if rel = 0 then INST [ntm,n_tm] rth else if rel < 0 then let dtm = sbcbn ntm mtm in let th = NUM_ADC_RULE dtm mtm in QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] pth) else let dtm = sbcbn mtm ntm in let th = NUM_ADC_RULE dtm ntm in QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] qth) | _ -> failwith "NUM_EQ_CONV" in NUM_SUC_CONV,NUM_ADD_CONV,NUM_MULT_CONV,NUM_EXP_CONV, NUM_LT_CONV,NUM_LE_CONV,NUM_EQ_CONV;; let NUM_GT_CONV = GEN_REWRITE_CONV I [GT] THENC NUM_LT_CONV;; let NUM_GE_CONV = GEN_REWRITE_CONV I [GE] THENC NUM_LE_CONV;; let NUM_PRE_CONV = let tth = prove (`PRE 0 = 0`, REWRITE_TAC[PRE]) in let pth = prove (`(SUC m = n) ==> (PRE n = m)`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[PRE]) and m = `m:num` and n = `n:num` in let suc = `SUC` in let pre = `PRE` in fun tm -> try let l,r = dest_comb tm in if not (l = pre) then fail() else let x = dest_numeral r in if x =/ Int 0 then tth else let tm' = mk_numeral (x -/ Int 1) in let th1 = NUM_SUC_CONV (mk_comb(suc,tm')) in MP (INST [tm',m; r,n] pth) th1 with Failure _ -> failwith "NUM_PRE_CONV";; let NUM_SUB_CONV = let pth0 = prove (`p <= n ==> (p - n = 0)`, REWRITE_TAC[SUB_EQ_0]) and pth1 = prove (`(m + n = p) ==> (p - n = m)`, DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD_SUB]) and m = `m:num` and n = `n:num` and p = `p:num` and minus = `(-)` and plus = `(+)` and le = `(<=)` in fun tm -> try let l,r = dest_binop minus tm in let ln = dest_numeral l and rn = dest_numeral r in if ln <=/ rn then let pth = INST [l,p; r,n] pth0 and th0 = EQT_ELIM(NUM_LE_CONV (mk_binop le l r)) in MP pth th0 else let kn = ln -/ rn in let k = mk_numeral kn in let pth = INST [k,m; l,p; r,n] pth1 and th0 = NUM_ADD_CONV (mk_binop plus k r) in MP pth th0 with Failure _ -> failwith "NUM_SUB_CONV";; let NUM_DIV_CONV,NUM_MOD_CONV = let pth = prove (`(q * n + r = m) ==> r < n ==> (m DIV n = q) /\ (m MOD n = r)`, MESON_TAC[DIVMOD_UNIQ]) and m = `m:num` and n = `n:num` and q = `q:num` and r = `r:num` and dtm = `(DIV)` and mtm = `(MOD)` in let NUM_DIVMOD_CONV x y = let k = quo_num x y and l = mod_num x y in let th0 = INST [mk_numeral x,m; mk_numeral y,n; mk_numeral k,q; mk_numeral l,r] pth in let tm0 = lhand(lhand(concl th0)) in let th1 = (LAND_CONV NUM_MULT_CONV THENC NUM_ADD_CONV) tm0 in let th2 = MP th0 th1 in let tm2 = lhand(concl th2) in MP th2 (EQT_ELIM(NUM_LT_CONV tm2)) in (fun tm -> try let xt,yt = dest_binop dtm tm in CONJUNCT1(NUM_DIVMOD_CONV (dest_numeral xt) (dest_numeral yt)) with Failure _ -> failwith "NUM_DIV_CONV"), (fun tm -> try let xt,yt = dest_binop mtm tm in CONJUNCT2(NUM_DIVMOD_CONV (dest_numeral xt) (dest_numeral yt)) with Failure _ -> failwith "NUM_MOD_CONV");; let NUM_FACT_CONV = let suc = `SUC` and mul = `(*)` in let pth_0 = prove (`FACT 0 = 1`, REWRITE_TAC[FACT]) and pth_suc = prove (`(SUC x = y) ==> (FACT x = w) ==> (y * w = z) ==> (FACT y = z)`, REPEAT (DISCH_THEN(SUBST1_TAC o SYM)) THEN REWRITE_TAC[FACT]) and w = `w:num` and x = `x:num` and y = `y:num` and z = `z:num` in let mksuc n = let n' = n -/ (Int 1) in NUM_SUC_CONV (mk_comb(suc,mk_numeral n')) in let rec NUM_FACT_CONV n = if n =/ Int 0 then pth_0 else let th0 = mksuc n in let tmx = rand(lhand(concl th0)) in let tm0 = rand(concl th0) in let th1 = NUM_FACT_CONV (n -/ Int 1) in let tm1 = rand(concl th1) in let th2 = NUM_MULT_CONV (mk_binop mul tm0 tm1) in let tm2 = rand(concl th2) in let pth = INST [tmx,x; tm0, y; tm1,w; tm2,z] pth_suc in MP (MP (MP pth th0) th1) th2 in fun tm -> try let l,r = dest_comb tm in if fst(dest_const l) = "FACT" then NUM_FACT_CONV (dest_numeral r) else fail() with Failure _ -> failwith "NUM_FACT_CONV";; let NUM_MAX_CONV = REWR_CONV MAX THENC RATOR_CONV(RATOR_CONV(RAND_CONV NUM_LE_CONV)) THENC GEN_REWRITE_CONV I [COND_CLAUSES];; let NUM_MIN_CONV = REWR_CONV MIN THENC RATOR_CONV(RATOR_CONV(RAND_CONV NUM_LE_CONV)) THENC GEN_REWRITE_CONV I [COND_CLAUSES];; (* ------------------------------------------------------------------------- *) (* Final hack-together. *) (* ------------------------------------------------------------------------- *) let NUM_REL_CONV = let gconv_net = itlist (uncurry net_of_conv) [`NUMERAL m < NUMERAL n`,NUM_LT_CONV; `NUMERAL m <= NUMERAL n`,NUM_LE_CONV; `NUMERAL m > NUMERAL n`,NUM_GT_CONV; `NUMERAL m >= NUMERAL n`,NUM_GE_CONV; `NUMERAL m = NUMERAL n`,NUM_EQ_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let NUM_RED_CONV = let gconv_net = itlist (uncurry net_of_conv) [`SUC(NUMERAL n)`,NUM_SUC_CONV; `PRE(NUMERAL n)`,NUM_PRE_CONV; `FACT(NUMERAL n)`,NUM_FACT_CONV; `NUMERAL m < NUMERAL n`,NUM_LT_CONV; `NUMERAL m <= NUMERAL n`,NUM_LE_CONV; `NUMERAL m > NUMERAL n`,NUM_GT_CONV; `NUMERAL m >= NUMERAL n`,NUM_GE_CONV; `NUMERAL m = NUMERAL n`,NUM_EQ_CONV; `EVEN(NUMERAL n)`,NUM_EVEN_CONV; `ODD(NUMERAL n)`,NUM_ODD_CONV; `NUMERAL m + NUMERAL n`,NUM_ADD_CONV; `NUMERAL m - NUMERAL n`,NUM_SUB_CONV; `NUMERAL m * NUMERAL n`,NUM_MULT_CONV; `(NUMERAL m) EXP (NUMERAL n)`,NUM_EXP_CONV; `(NUMERAL m) DIV (NUMERAL n)`,NUM_DIV_CONV; `(NUMERAL m) MOD (NUMERAL n)`,NUM_MOD_CONV; `MAX (NUMERAL m) (NUMERAL n)`,NUM_MAX_CONV; `MIN (NUMERAL m) (NUMERAL n)`,NUM_MIN_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let NUM_REDUCE_CONV = DEPTH_CONV NUM_RED_CONV;; let NUM_REDUCE_TAC = CONV_TAC NUM_REDUCE_CONV;; (* ------------------------------------------------------------------------- *) (* I do like this after all... *) (* ------------------------------------------------------------------------- *) let num_CONV = let SUC_tm = `SUC` in fun tm -> let n = dest_numeral tm -/ Int 1 in if n P(n)" into all the cases. *) (* ------------------------------------------------------------------------- *) let EXPAND_CASES_CONV = let pth_base = prove (`(!n. n < 0 ==> P n) <=> T`, REWRITE_TAC[LT]) and pth_step = prove (`(!n. n < SUC k ==> P n) <=> (!n. n < k ==> P n) /\ P k`, REWRITE_TAC[LT] THEN MESON_TAC[]) in let base_CONV = GEN_REWRITE_CONV I [pth_base] and step_CONV = BINDER_CONV(LAND_CONV(RAND_CONV num_CONV)) THENC GEN_REWRITE_CONV I [pth_step] in let rec conv tm = (base_CONV ORELSEC (step_CONV THENC LAND_CONV conv)) tm in conv THENC (REWRITE_CONV[GSYM CONJ_ASSOC]);; hol-light/calc_rat.ml000066400000000000000000000616431303454263000150610ustar00rootroot00000000000000(* ========================================================================= *) (* Calculation with rational-valued reals. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "real.ml";; (* ------------------------------------------------------------------------- *) (* Constant for decimal fractions written #xxx.yyy *) (* ------------------------------------------------------------------------- *) let DECIMAL = new_definition `DECIMAL x y = &x / &y`;; (* ------------------------------------------------------------------------- *) (* Various handy lemmas. *) (* ------------------------------------------------------------------------- *) let RAT_LEMMA1 = prove (`~(y1 = &0) /\ ~(y2 = &0) ==> ((x1 / y1) + (x2 / y2) = (x1 * y2 + x2 * y1) * inv(y1) * inv(y2))`, STRIP_TAC THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN BINOP_TAC THENL [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC [AC REAL_MUL_AC `a * b * c = (b * a) * c`]; REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN DISJ2_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]);; let RAT_LEMMA2 = prove (`&0 < y1 /\ &0 < y2 ==> ((x1 / y1) + (x2 / y2) = (x1 * y2 + x2 * y1) * inv(y1) * inv(y2))`, DISCH_TAC THEN MATCH_MP_TAC RAT_LEMMA1 THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_REFL]);; let RAT_LEMMA3 = prove (`&0 < y1 /\ &0 < y2 ==> ((x1 / y1) - (x2 / y2) = (x1 * y2 - x2 * y1) * inv(y1) * inv(y2))`, DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP RAT_LEMMA2) THEN REWRITE_TAC[real_div] THEN DISCH_TAC THEN ASM_REWRITE_TAC[real_sub; GSYM REAL_MUL_LNEG]);; let RAT_LEMMA4 = prove (`&0 < y1 /\ &0 < y2 ==> (x1 / y1 <= x2 / y2 <=> x1 * y2 <= x2 * y1)`, let lemma = prove (`&0 < y ==> (&0 <= x * y <=> &0 <= x)`, DISCH_TAC THEN EQ_TAC THEN DISCH_TAC THENL [SUBGOAL_THEN `&0 <= x * (y * inv y)` MP_TAC THENL [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `y * inv y = &1` (fun th -> REWRITE_TAC[th; REAL_MUL_RID]) THEN MATCH_MP_TAC REAL_MUL_RINV THEN UNDISCH_TAC `&0 < y` THEN REAL_ARITH_TAC]; MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]) in ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `a <= b <=> &0 <= b - a`] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RAT_LEMMA3 th]) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&0 <= (x2 * y1 - x1 * y2) * inv y2` THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN CONJ_TAC THEN MATCH_MP_TAC lemma THEN MATCH_MP_TAC REAL_LT_INV THEN ASM_REWRITE_TAC[]);; let RAT_LEMMA5 = prove (`&0 < y1 /\ &0 < y2 ==> ((x1 / y1 = x2 / y2) <=> (x1 * y2 = x2 * y1))`, REPEAT DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(TAUT `(a <=> a') /\ (b <=> b') ==> (a /\ b <=> a' /\ b')`) THEN CONJ_TAC THEN MATCH_MP_TAC RAT_LEMMA4 THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Create trivial rational from integer or decimal, and postconvert back. *) (* ------------------------------------------------------------------------- *) let REAL_INT_RAT_CONV = let pth = prove (`(&x = &x / &1) /\ (--(&x) = --(&x) / &1) /\ (DECIMAL x y = &x / &y) /\ (--(DECIMAL x y) = --(&x) / &y)`, REWRITE_TAC[REAL_DIV_1; DECIMAL] THEN REWRITE_TAC[real_div; REAL_MUL_LNEG]) in TRY_CONV(GEN_REWRITE_CONV I [pth]);; (* ------------------------------------------------------------------------- *) (* Relational operations. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_LE_CONV = let pth = prove (`&0 < y1 ==> &0 < y2 ==> (x1 / y1 <= x2 / y2 <=> x1 * y2 <= x2 * y1)`, REWRITE_TAC[IMP_IMP; RAT_LEMMA4]) and x1 = `x1:real` and x2 = `x2:real` and y1 = `y1:real` and y2 = `y2:real` and dest_le = dest_binop `(<=)` and dest_div = dest_binop `(/)` in let RAW_REAL_RAT_LE_CONV tm = let l,r = dest_le tm in let lx,ly = dest_div l and rx,ry = dest_div r in let th0 = INST [lx,x1; ly,y1; rx,x2; ry,y2] pth in let th1 = funpow 2 (MP_CONV REAL_INT_LT_CONV) th0 in let th2 = (BINOP_CONV REAL_INT_MUL_CONV THENC REAL_INT_LE_CONV) (rand(concl th1)) in TRANS th1 th2 in BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_LE_CONV;; let REAL_RAT_LT_CONV = let pth = prove (`&0 < y1 ==> &0 < y2 ==> (x1 / y1 < x2 / y2 <=> x1 * y2 < x2 * y1)`, REWRITE_TAC[IMP_IMP] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_NOT_LE] THEN SIMP_TAC[TAUT `(~a <=> ~b) <=> (a <=> b)`; RAT_LEMMA4]) and x1 = `x1:real` and x2 = `x2:real` and y1 = `y1:real` and y2 = `y2:real` and dest_lt = dest_binop `(<)` and dest_div = dest_binop `(/)` in let RAW_REAL_RAT_LT_CONV tm = let l,r = dest_lt tm in let lx,ly = dest_div l and rx,ry = dest_div r in let th0 = INST [lx,x1; ly,y1; rx,x2; ry,y2] pth in let th1 = funpow 2 (MP_CONV REAL_INT_LT_CONV) th0 in let th2 = (BINOP_CONV REAL_INT_MUL_CONV THENC REAL_INT_LT_CONV) (rand(concl th1)) in TRANS th1 th2 in BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_LT_CONV;; let REAL_RAT_GE_CONV = GEN_REWRITE_CONV I [real_ge] THENC REAL_RAT_LE_CONV;; let REAL_RAT_GT_CONV = GEN_REWRITE_CONV I [real_gt] THENC REAL_RAT_LT_CONV;; let REAL_RAT_EQ_CONV = let pth = prove (`&0 < y1 ==> &0 < y2 ==> ((x1 / y1 = x2 / y2) <=> (x1 * y2 = x2 * y1))`, REWRITE_TAC[IMP_IMP; RAT_LEMMA5]) and x1 = `x1:real` and x2 = `x2:real` and y1 = `y1:real` and y2 = `y2:real` and dest_eq = dest_binop `(=) :real->real->bool` and dest_div = dest_binop `(/)` in let RAW_REAL_RAT_EQ_CONV tm = let l,r = dest_eq tm in let lx,ly = dest_div l and rx,ry = dest_div r in let th0 = INST [lx,x1; ly,y1; rx,x2; ry,y2] pth in let th1 = funpow 2 (MP_CONV REAL_INT_LT_CONV) th0 in let th2 = (BINOP_CONV REAL_INT_MUL_CONV THENC REAL_INT_EQ_CONV) (rand(concl th1)) in TRANS th1 th2 in BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_EQ_CONV;; (* ------------------------------------------------------------------------- *) (* The unary operations; all easy. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_NEG_CONV = let pth = prove (`(--(&0) = &0) /\ (--(--(&n)) = &n) /\ (--(&m / &n) = --(&m) / &n) /\ (--(--(&m) / &n) = &m / &n) /\ (--(DECIMAL m n) = --(&m) / &n)`, REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_NEG_NEG; REAL_NEG_0; DECIMAL]) and ptm = `(--)` in let conv1 = GEN_REWRITE_CONV I [pth] in fun tm -> try conv1 tm with Failure _ -> try let l,r = dest_comb tm in if l = ptm && is_realintconst r && dest_realintconst r >/ num_0 then REFL tm else fail() with Failure _ -> failwith "REAL_RAT_NEG_CONV";; let REAL_RAT_ABS_CONV = let pth = prove (`(abs(&n) = &n) /\ (abs(--(&n)) = &n) /\ (abs(&m / &n) = &m / &n) /\ (abs(--(&m) / &n) = &m / &n) /\ (abs(DECIMAL m n) = &m / &n) /\ (abs(--(DECIMAL m n)) = &m / &n)`, REWRITE_TAC[DECIMAL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_NUM]) in GEN_REWRITE_CONV I [pth];; let REAL_RAT_INV_CONV = let pth1 = prove (`(inv(&0) = &0) /\ (inv(&1) = &1) /\ (inv(-- &1) = --(&1)) /\ (inv(&1 / &n) = &n) /\ (inv(-- &1 / &n) = -- &n)`, REWRITE_TAC[REAL_INV_0; REAL_INV_1; REAL_INV_NEG; REAL_INV_DIV; REAL_DIV_1] THEN REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_RNEG; REAL_INV_1; REAL_MUL_RID]) and pth2 = prove (`(inv(&n) = &1 / &n) /\ (inv(--(&n)) = --(&1) / &n) /\ (inv(&m / &n) = &n / &m) /\ (inv(--(&m) / &n) = --(&n) / &m) /\ (inv(DECIMAL m n) = &n / &m) /\ (inv(--(DECIMAL m n)) = --(&n) / &m)`, REWRITE_TAC[DECIMAL; REAL_INV_DIV] THEN REWRITE_TAC[REAL_INV_NEG; real_div; REAL_MUL_RNEG; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_LNEG; REAL_INV_MUL; REAL_INV_INV]) in GEN_REWRITE_CONV I [pth1] ORELSEC GEN_REWRITE_CONV I [pth2];; (* ------------------------------------------------------------------------- *) (* Addition. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_ADD_CONV = let pth = prove (`&0 < y1 ==> &0 < y2 ==> &0 < y3 ==> ((x1 * y2 + x2 * y1) * y3 = x3 * y1 * y2) ==> (x1 / y1 + x2 / y2 = x3 / y3)`, REPEAT DISCH_TAC THEN MP_TAC RAT_LEMMA2 THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM REAL_INV_MUL; GSYM real_div] THEN SUBGOAL_THEN `&0 < y1 * y2 /\ &0 < y3` MP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; DISCH_THEN(fun th -> ASM_REWRITE_TAC[MATCH_MP RAT_LEMMA5 th])]) and dest_divop = dest_binop `(/)` and dest_addop = dest_binop `(+)` and x1 = `x1:real` and x2 = `x2:real` and x3 = `x3:real` and y1 = `y1:real` and y2 = `y2:real` and y3 = `y3:real` in let RAW_REAL_RAT_ADD_CONV tm = let r1,r2 = dest_addop tm in let x1',y1' = dest_divop r1 and x2',y2' = dest_divop r2 in let x1n = dest_realintconst x1' and y1n = dest_realintconst y1' and x2n = dest_realintconst x2' and y2n = dest_realintconst y2' in let x3n = x1n */ y2n +/ x2n */ y1n and y3n = y1n */ y2n in let d = gcd_num x3n y3n in let x3n' = quo_num x3n d and y3n' = quo_num y3n d in let x3n'',y3n'' = if y3n' >/ Int 0 then x3n',y3n' else minus_num x3n',minus_num y3n' in let x3' = mk_realintconst x3n'' and y3' = mk_realintconst y3n'' in let th0 = INST [x1',x1; y1',y1; x2',x2; y2',y2; x3',x3; y3',y3] pth in let th1 = funpow 3 (MP_CONV REAL_INT_LT_CONV) th0 in let tm2,tm3 = dest_eq(fst(dest_imp(concl th1))) in let th2 = (LAND_CONV (BINOP_CONV REAL_INT_MUL_CONV THENC REAL_INT_ADD_CONV) THENC REAL_INT_MUL_CONV) tm2 and th3 = (RAND_CONV REAL_INT_MUL_CONV THENC REAL_INT_MUL_CONV) tm3 in MP th1 (TRANS th2 (SYM th3)) in BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_ADD_CONV THENC TRY_CONV(GEN_REWRITE_CONV I [REAL_DIV_1]);; (* ------------------------------------------------------------------------- *) (* Subtraction. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_SUB_CONV = let pth = prove (`x - y = x + --y`, REWRITE_TAC[real_sub]) in GEN_REWRITE_CONV I [pth] THENC RAND_CONV REAL_RAT_NEG_CONV THENC REAL_RAT_ADD_CONV;; (* ------------------------------------------------------------------------- *) (* Multiplication. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_MUL_CONV = let pth_nocancel = prove (`(x1 / y1) * (x2 / y2) = (x1 * x2) / (y1 * y2)`, REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC]) and pth_cancel = prove (`~(d1 = &0) /\ ~(d2 = &0) /\ (d1 * u1 = x1) /\ (d2 * u2 = x2) /\ (d2 * v1 = y1) /\ (d1 * v2 = y2) ==> ((x1 / y1) * (x2 / y2) = (u1 * u2) / (v1 * v2))`, DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN ASM_REWRITE_TAC[real_div; REAL_INV_MUL] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `((d1 * u1) * (id2 * iv1)) * ((d2 * u2) * id1 * iv2) = (u1 * u2) * (iv1 * iv2) * (id2 * d2) * (id1 * d1)`] THEN ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID]) and dest_divop = dest_binop `(/)` and dest_mulop = dest_binop `(*)` and x1 = `x1:real` and x2 = `x2:real` and y1 = `y1:real` and y2 = `y2:real` and u1 = `u1:real` and u2 = `u2:real` and v1 = `v1:real` and v2 = `v2:real` and d1 = `d1:real` and d2 = `d2:real` in let RAW_REAL_RAT_MUL_CONV tm = let r1,r2 = dest_mulop tm in let x1',y1' = dest_divop r1 and x2',y2' = dest_divop r2 in let x1n = dest_realintconst x1' and y1n = dest_realintconst y1' and x2n = dest_realintconst x2' and y2n = dest_realintconst y2' in let d1n = gcd_num x1n y2n and d2n = gcd_num x2n y1n in if d1n = num_1 && d2n = num_1 then let th0 = INST [x1',x1; y1',y1; x2',x2; y2',y2] pth_nocancel in let th1 = BINOP_CONV REAL_INT_MUL_CONV (rand(concl th0)) in TRANS th0 th1 else let u1n = quo_num x1n d1n and u2n = quo_num x2n d2n and v1n = quo_num y1n d2n and v2n = quo_num y2n d1n in let u1' = mk_realintconst u1n and u2' = mk_realintconst u2n and v1' = mk_realintconst v1n and v2' = mk_realintconst v2n and d1' = mk_realintconst d1n and d2' = mk_realintconst d2n in let th0 = INST [x1',x1; y1',y1; x2',x2; y2',y2; u1',u1; v1',v1; u2',u2; v2',v2; d1',d1; d2',d2] pth_cancel in let th1 = EQT_ELIM(REAL_INT_REDUCE_CONV(lhand(concl th0))) in let th2 = MP th0 th1 in let th3 = BINOP_CONV REAL_INT_MUL_CONV (rand(concl th2)) in TRANS th2 th3 in BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_MUL_CONV THENC TRY_CONV(GEN_REWRITE_CONV I [REAL_DIV_1]);; (* ------------------------------------------------------------------------- *) (* Division. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_DIV_CONV = let pth = prove (`x / y = x * inv(y)`, REWRITE_TAC[real_div]) in GEN_REWRITE_CONV I [pth] THENC RAND_CONV REAL_RAT_INV_CONV THENC REAL_RAT_MUL_CONV;; (* ------------------------------------------------------------------------- *) (* Powers. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_POW_CONV = let pth = prove (`(x / y) pow n = (x pow n) / (y pow n)`, REWRITE_TAC[REAL_POW_DIV]) in REAL_INT_POW_CONV ORELSEC (LAND_CONV REAL_INT_RAT_CONV THENC GEN_REWRITE_CONV I [pth] THENC BINOP_CONV REAL_INT_POW_CONV);; (* ------------------------------------------------------------------------- *) (* Max and min. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_MAX_CONV = REWR_CONV real_max THENC RATOR_CONV(RATOR_CONV(RAND_CONV REAL_RAT_LE_CONV)) THENC GEN_REWRITE_CONV I [COND_CLAUSES];; let REAL_RAT_MIN_CONV = REWR_CONV real_min THENC RATOR_CONV(RATOR_CONV(RAND_CONV REAL_RAT_LE_CONV)) THENC GEN_REWRITE_CONV I [COND_CLAUSES];; (* ------------------------------------------------------------------------- *) (* Everything. *) (* ------------------------------------------------------------------------- *) let REAL_RAT_RED_CONV = let gconv_net = itlist (uncurry net_of_conv) [`x <= y`,REAL_RAT_LE_CONV; `x < y`,REAL_RAT_LT_CONV; `x >= y`,REAL_RAT_GE_CONV; `x > y`,REAL_RAT_GT_CONV; `x:real = y`,REAL_RAT_EQ_CONV; `--x`,CHANGED_CONV REAL_RAT_NEG_CONV; `abs(x)`,REAL_RAT_ABS_CONV; `inv(x)`,REAL_RAT_INV_CONV; `x + y`,REAL_RAT_ADD_CONV; `x - y`,REAL_RAT_SUB_CONV; `x * y`,REAL_RAT_MUL_CONV; `x / y`,CHANGED_CONV REAL_RAT_DIV_CONV; `x pow n`,REAL_RAT_POW_CONV; `max x y`,REAL_RAT_MAX_CONV; `min x y`,REAL_RAT_MIN_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let REAL_RAT_REDUCE_CONV = DEPTH_CONV REAL_RAT_RED_CONV;; (* ------------------------------------------------------------------------- *) (* Real normalizer dealing with rational constants. *) (* ------------------------------------------------------------------------- *) let REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_SUB_CONV, REAL_POLY_MUL_CONV,REAL_POLY_POW_CONV,REAL_POLY_CONV = SEMIRING_NORMALIZERS_CONV REAL_POLY_CLAUSES REAL_POLY_NEG_CLAUSES (is_ratconst, REAL_RAT_ADD_CONV,REAL_RAT_MUL_CONV,REAL_RAT_POW_CONV) (<);; (* ------------------------------------------------------------------------- *) (* Extend normalizer to handle "inv" and division by rational constants, and *) (* normalize inside nested "max", "min" and "abs" terms. *) (* ------------------------------------------------------------------------- *) let REAL_POLY_CONV = let neg_tm = `(--):real->real` and inv_tm = `inv:real->real` and add_tm = `(+):real->real->real` and sub_tm = `(-):real->real->real` and mul_tm = `(*):real->real->real` and div_tm = `(/):real->real->real` and pow_tm = `(pow):real->num->real` and abs_tm = `abs:real->real` and max_tm = `max:real->real->real` and min_tm = `min:real->real->real` and div_conv = REWR_CONV real_div in let rec REAL_POLY_CONV tm = if not(is_comb tm) || is_ratconst tm then REFL tm else let lop,r = dest_comb tm in if lop = neg_tm then let th1 = AP_TERM lop (REAL_POLY_CONV r) in TRANS th1 (REAL_POLY_NEG_CONV (rand(concl th1))) else if lop = inv_tm then let th1 = AP_TERM lop (REAL_POLY_CONV r) in TRANS th1 (TRY_CONV REAL_RAT_INV_CONV (rand(concl th1))) else if lop = abs_tm then AP_TERM lop (REAL_POLY_CONV r) else if not(is_comb lop) then REFL tm else let op,l = dest_comb lop in if op = pow_tm then let th1 = AP_THM (AP_TERM op (REAL_POLY_CONV l)) r in TRANS th1 (TRY_CONV REAL_POLY_POW_CONV (rand(concl th1))) else if op = add_tm || op = mul_tm || op = sub_tm then let th1 = MK_COMB(AP_TERM op (REAL_POLY_CONV l), REAL_POLY_CONV r) in let fn = if op = add_tm then REAL_POLY_ADD_CONV else if op = mul_tm then REAL_POLY_MUL_CONV else REAL_POLY_SUB_CONV in TRANS th1 (fn (rand(concl th1))) else if op = div_tm then let th1 = div_conv tm in TRANS th1 (REAL_POLY_CONV (rand(concl th1))) else if op = min_tm || op = max_tm then MK_COMB(AP_TERM op (REAL_POLY_CONV l),REAL_POLY_CONV r) else REFL tm in REAL_POLY_CONV;; (* ------------------------------------------------------------------------- *) (* Basic ring and ideal conversions. *) (* ------------------------------------------------------------------------- *) let REAL_RING,real_ideal_cofactors = let REAL_INTEGRAL = prove (`(!x. &0 * x = &0) /\ (!x y z. (x + y = x + z) <=> (y = z)) /\ (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[GSYM REAL_ENTIRE] THEN REAL_ARITH_TAC) and REAL_RABINOWITSCH = prove (`!x y:real. ~(x = y) <=> ?z. (x - y) * z = &1`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_SUB_0] THEN MESON_TAC[REAL_MUL_RINV; REAL_MUL_LZERO; REAL_ARITH `~(&1 = &0)`]) and init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] and real_ty = `:real` in let pure,ideal = RING_AND_IDEAL_CONV (rat_of_term,term_of_rat,REAL_RAT_EQ_CONV, `(--):real->real`,`(+):real->real->real`,`(-):real->real->real`, `(inv):real->real`,`(*):real->real->real`,`(/):real->real->real`, `(pow):real->num->real`, REAL_INTEGRAL,REAL_RABINOWITSCH,REAL_POLY_CONV) in (fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)))), (fun tms tm -> if forall (fun t -> type_of t = real_ty) (tm::tms) then ideal tms tm else failwith "real_ideal_cofactors: not all terms have type :real");; (* ------------------------------------------------------------------------- *) (* Conversion for ideal membership. *) (* ------------------------------------------------------------------------- *) let REAL_IDEAL_CONV = let mk_add = mk_binop `( + ):real->real->real` and mk_mul = mk_binop `( * ):real->real->real` in fun tms tm -> let cfs = real_ideal_cofactors tms tm in let tm' = end_itlist mk_add (map2 mk_mul cfs tms) in let th = REAL_POLY_CONV tm and th' = REAL_POLY_CONV tm' in TRANS th (SYM th');; (* ------------------------------------------------------------------------- *) (* Further specialize GEN_REAL_ARITH and REAL_ARITH (final versions). *) (* ------------------------------------------------------------------------- *) let GEN_REAL_ARITH PROVER = GEN_REAL_ARITH (term_of_rat, REAL_RAT_EQ_CONV,REAL_RAT_GE_CONV,REAL_RAT_GT_CONV, REAL_POLY_CONV,REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_MUL_CONV, PROVER);; let REAL_ARITH = let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] and pure = GEN_REAL_ARITH REAL_LINEAR_PROVER in fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; let REAL_ARITH_TAC = CONV_TAC REAL_ARITH;; let ASM_REAL_ARITH_TAC = REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN REAL_ARITH_TAC;; (* ------------------------------------------------------------------------- *) (* A few handy equivalential forms of transitivity. *) (* ------------------------------------------------------------------------- *) let REAL_LE_TRANS_LE = prove (`!x y:real. x <= y <=> (!z. y <= z ==> x <= z)`, MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; let REAL_LE_TRANS_LTE = prove (`!x y:real. x <= y <=> (!z. y < z ==> x <= z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `y + (x - y) / &2`) THEN REAL_ARITH_TAC);; let REAL_LE_TRANS_LT = prove (`!x y:real. x <= y <=> (!z. y < z ==> x < z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `y + (x - y) / &2`) THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* A simple "field" rule. *) (* ------------------------------------------------------------------------- *) let REAL_FIELD = let norm_net = itlist (net_of_thm false o SPEC_ALL) [FORALL_SIMP; EXISTS_SIMP; real_div; REAL_INV_INV; REAL_INV_MUL; REAL_POW_ADD] (net_of_conv `inv((x:real) pow n)` (REWR_CONV(GSYM REAL_POW_INV) o check (is_numeral o rand o rand)) empty_net) and easy_nz_conv = LAND_CONV (GEN_REWRITE_CONV TRY_CONV [MESON[REAL_POW_EQ_0; REAL_OF_NUM_EQ] `~(x pow n = &0) <=> ~((x:real) = &0) \/ (&n = &0) \/ ~(x pow n = &0)`]) THENC TRY_CONV(LAND_CONV REAL_RAT_REDUCE_CONV THENC GEN_REWRITE_CONV I [TAUT `(T ==> p) <=> p`]) in let prenex_conv = TOP_DEPTH_CONV BETA_CONV THENC NUM_REDUCE_CONV THENC TOP_DEPTH_CONV(REWRITES_CONV norm_net) THENC NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC PRENEX_CONV THENC ONCE_REWRITE_CONV[REAL_ARITH `x < y <=> x < y /\ ~(x = y)`] and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV and core_rule t = try REAL_RING t with Failure _ -> REAL_ARITH t and is_inv = let inv_tm = `inv:real->real` and is_div = is_binop `(/):real->real->real` in fun tm -> (is_div tm || (is_comb tm && rator tm = inv_tm)) & not(is_ratconst(rand tm)) in let BASIC_REAL_FIELD tm = let is_freeinv t = is_inv t && free_in t tm in let itms = setify(map rand (find_terms is_freeinv tm)) in let hyps = map (fun t -> CONV_RULE easy_nz_conv (SPEC t REAL_MUL_RINV)) itms in let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in let th1 = setup_conv tm' in let cjs = conjuncts(rand(concl th1)) in let ths = map core_rule cjs in let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in rev_itlist (C MP) hyps th2 in fun tm -> let th0 = prenex_conv tm in let tm0 = rand(concl th0) in let avs,bod = strip_forall tm0 in let th1 = setup_conv bod in let ths = map BASIC_REAL_FIELD (conjuncts(rand(concl th1))) in EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; hol-light/canon.ml000066400000000000000000001020711303454263000143760ustar00rootroot00000000000000(* ========================================================================= *) (* Reasonably efficient conversions for various canonical forms. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "trivia.ml";; (* ------------------------------------------------------------------------- *) (* Pre-simplification. *) (* ------------------------------------------------------------------------- *) let PRESIMP_CONV = GEN_REWRITE_CONV TOP_DEPTH_CONV [NOT_CLAUSES; AND_CLAUSES; OR_CLAUSES; IMP_CLAUSES; EQ_CLAUSES; FORALL_SIMP; EXISTS_SIMP; EXISTS_OR_THM; FORALL_AND_THM; LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; LEFT_FORALL_OR_THM; RIGHT_FORALL_OR_THM];; (* ------------------------------------------------------------------------- *) (* ACI rearrangements of conjunctions and disjunctions. This is much faster *) (* than AC xxx_ACI on large problems, as well as being more controlled. *) (* ------------------------------------------------------------------------- *) let CONJ_ACI_RULE = let rec mk_fun th fn = let tm = concl th in if is_conj tm then let th1,th2 = CONJ_PAIR th in mk_fun th1 (mk_fun th2 fn) else (tm |-> th) fn and use_fun fn tm = if is_conj tm then let l,r = dest_conj tm in CONJ (use_fun fn l) (use_fun fn r) else apply fn tm in fun fm -> let p,p' = dest_eq fm in if p = p' then REFL p else let th = use_fun (mk_fun (ASSUME p) undefined) p' and th' = use_fun (mk_fun (ASSUME p') undefined) p in IMP_ANTISYM_RULE (DISCH_ALL th) (DISCH_ALL th');; let DISJ_ACI_RULE = let pth_left = UNDISCH(TAUT `~(a \/ b) ==> ~a`) and pth_right = UNDISCH(TAUT `~(a \/ b) ==> ~b`) and pth = repeat UNDISCH (TAUT `~a ==> ~b ==> ~(a \/ b)`) and pth_neg = UNDISCH(TAUT `(~a <=> ~b) ==> (a <=> b)`) and a_tm = `a:bool` and b_tm = `b:bool` in let NOT_DISJ_PAIR th = let p,q = dest_disj(rand(concl th)) in let ilist = [p,a_tm; q,b_tm] in PROVE_HYP th (INST ilist pth_left), PROVE_HYP th (INST ilist pth_right) and NOT_DISJ th1 th2 = let th3 = INST [rand(concl th1),a_tm; rand(concl th2),b_tm] pth in PROVE_HYP th1 (PROVE_HYP th2 th3) in let rec mk_fun th fn = let tm = rand(concl th) in if is_disj tm then let th1,th2 = NOT_DISJ_PAIR th in mk_fun th1 (mk_fun th2 fn) else (tm |-> th) fn and use_fun fn tm = if is_disj tm then let l,r = dest_disj tm in NOT_DISJ (use_fun fn l) (use_fun fn r) else apply fn tm in fun fm -> let p,p' = dest_eq fm in if p = p' then REFL p else let th = use_fun (mk_fun (ASSUME(mk_neg p)) undefined) p' and th' = use_fun (mk_fun (ASSUME(mk_neg p')) undefined) p in let th1 = IMP_ANTISYM_RULE (DISCH_ALL th) (DISCH_ALL th') in PROVE_HYP th1 (INST [p,a_tm; p',b_tm] pth_neg);; (* ------------------------------------------------------------------------- *) (* Order canonically, right-associate and remove duplicates. *) (* ------------------------------------------------------------------------- *) let CONJ_CANON_CONV tm = let tm' = list_mk_conj(setify(conjuncts tm)) in CONJ_ACI_RULE(mk_eq(tm,tm'));; let DISJ_CANON_CONV tm = let tm' = list_mk_disj(setify(disjuncts tm)) in DISJ_ACI_RULE(mk_eq(tm,tm'));; (* ------------------------------------------------------------------------- *) (* General NNF conversion. The user supplies some conversion to be applied *) (* to atomic formulas. *) (* *) (* "Iff"s are split conjunctively or disjunctively according to the flag *) (* argument (conjuctively = true) until a universal quantifier (modulo *) (* current parity) is passed; after that they are split conjunctively. This *) (* is appropriate when the result is passed to a disjunctive splitter *) (* followed by a clausal form inner core, such as MESON. *) (* *) (* To avoid some duplicate computation, this function will in general *) (* enter a recursion where it simultaneously computes NNF representations *) (* for "p" and "~p", so the user needs to supply an atomic "conversion" *) (* that does the same. *) (* ------------------------------------------------------------------------- *) let (GEN_NNF_CONV:bool->conv*(term->thm*thm)->conv) = let and_tm = `(/\)` and or_tm = `(\/)` and not_tm = `(~)` and pth_not_not = TAUT `~ ~ p = p` and pth_not_and = TAUT `~(p /\ q) <=> ~p \/ ~q` and pth_not_or = TAUT `~(p \/ q) <=> ~p /\ ~q` and pth_imp = TAUT `p ==> q <=> ~p \/ q` and pth_not_imp = TAUT `~(p ==> q) <=> p /\ ~q` and pth_eq = TAUT `(p <=> q) <=> p /\ q \/ ~p /\ ~q` and pth_not_eq = TAUT `~(p <=> q) <=> p /\ ~q \/ ~p /\ q` and pth_eq' = TAUT `(p <=> q) <=> (p \/ ~q) /\ (~p \/ q)` and pth_not_eq' = TAUT `~(p <=> q) <=> (p \/ q) /\ (~p \/ ~q)` and [pth_not_forall; pth_not_exists; pth_not_exu] = (CONJUNCTS o prove) (`(~((!) P) <=> ?x:A. ~(P x)) /\ (~((?) P) <=> !x:A. ~(P x)) /\ (~((?!) P) <=> (!x:A. ~(P x)) \/ ?x y. P x /\ P y /\ ~(y = x))`, REPEAT CONJ_TAC THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; EXISTS_UNIQUE_DEF; DE_MORGAN_THM; NOT_IMP] THEN REWRITE_TAC[CONJ_ASSOC; EQ_SYM_EQ]) and pth_exu = prove (`((?!) P) <=> (?x:A. P x) /\ !x y. ~(P x) \/ ~(P y) \/ (y = x)`, GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[EXISTS_UNIQUE_DEF; TAUT `a /\ b ==> c <=> ~a \/ ~b \/ c`] THEN REWRITE_TAC[EQ_SYM_EQ]) and p_tm = `p:bool` and q_tm = `q:bool` in let rec NNF_DCONV cf baseconvs tm = match tm with Comb(Comb(Const("/\\",_),l),r) -> let th_lp,th_ln = NNF_DCONV cf baseconvs l and th_rp,th_rn = NNF_DCONV cf baseconvs r in MK_COMB(AP_TERM and_tm th_lp,th_rp), TRANS (INST [l,p_tm; r,q_tm] pth_not_and) (MK_COMB(AP_TERM or_tm th_ln,th_rn)) | Comb(Comb(Const("\\/",_),l),r) -> let th_lp,th_ln = NNF_DCONV cf baseconvs l and th_rp,th_rn = NNF_DCONV cf baseconvs r in MK_COMB(AP_TERM or_tm th_lp,th_rp), TRANS (INST [l,p_tm; r,q_tm] pth_not_or) (MK_COMB(AP_TERM and_tm th_ln,th_rn)) | Comb(Comb(Const("==>",_),l),r) -> let th_lp,th_ln = NNF_DCONV cf baseconvs l and th_rp,th_rn = NNF_DCONV cf baseconvs r in TRANS (INST [l,p_tm; r,q_tm] pth_imp) (MK_COMB(AP_TERM or_tm th_ln,th_rp)), TRANS (INST [l,p_tm; r,q_tm] pth_not_imp) (MK_COMB(AP_TERM and_tm th_lp,th_rn)) | Comb(Comb(Const("=",Tyapp("fun",Tyapp("bool",_)::_)),l),r) -> let th_lp,th_ln = NNF_DCONV cf baseconvs l and th_rp,th_rn = NNF_DCONV cf baseconvs r in if cf then TRANS (INST [l,p_tm; r,q_tm] pth_eq') (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rn)), MK_COMB(AP_TERM or_tm th_ln,th_rp))), TRANS (INST [l,p_tm; r,q_tm] pth_not_eq') (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rp)), MK_COMB(AP_TERM or_tm th_ln,th_rn))) else TRANS (INST [l,p_tm; r,q_tm] pth_eq) (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rp)), MK_COMB(AP_TERM and_tm th_ln,th_rn))), TRANS (INST [l,p_tm; r,q_tm] pth_not_eq) (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rn)), MK_COMB(AP_TERM and_tm th_ln,th_rp))) | Comb(Const("!",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, (Abs(x,t) as bod)) -> let th_p,th_n = NNF_DCONV true baseconvs t in AP_TERM q (ABS x th_p), let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_not_forall) and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in TRANS th1 (MK_EXISTS x th2) | Comb(Const("?",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, (Abs(x,t) as bod)) -> let th_p,th_n = NNF_DCONV cf baseconvs t in AP_TERM q (ABS x th_p), let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_not_exists) and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in TRANS th1 (MK_FORALL x th2) | Comb(Const("?!",Tyapp("fun",Tyapp("fun",ty::_)::_)), (Abs(x,t) as bod)) -> let y = variant (x::frees t) x and th_p,th_n = NNF_DCONV cf baseconvs t in let eq = mk_eq(y,x) in let eth_p,eth_n = baseconvs eq and bth = BETA (mk_comb(bod,x)) and bth' = BETA_CONV(mk_comb(bod,y)) in let th_p' = INST [y,x] th_p and th_n' = INST [y,x] th_n in let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_exu) and th1' = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_not_exu) and th2 = MK_COMB(AP_TERM and_tm (MK_EXISTS x (TRANS bth th_p)), MK_FORALL x (MK_FORALL y (MK_COMB(AP_TERM or_tm (TRANS (AP_TERM not_tm bth) th_n), MK_COMB(AP_TERM or_tm (TRANS (AP_TERM not_tm bth') th_n'), eth_p))))) and th2' = MK_COMB(AP_TERM or_tm (MK_FORALL x (TRANS (AP_TERM not_tm bth) th_n)), MK_EXISTS x (MK_EXISTS y (MK_COMB(AP_TERM and_tm (TRANS bth th_p), MK_COMB(AP_TERM and_tm (TRANS bth' th_p'), eth_n))))) in TRANS th1 th2,TRANS th1' th2' | Comb(Const("~",_),t) -> let th1,th2 = NNF_DCONV cf baseconvs t in th2,TRANS (INST [t,p_tm] pth_not_not) th1 | _ -> try baseconvs tm with Failure _ -> REFL tm,REFL(mk_neg tm) in let rec NNF_CONV cf (base1,base2 as baseconvs) tm = match tm with Comb(Comb(Const("/\\",_),l),r) -> let th_lp = NNF_CONV cf baseconvs l and th_rp = NNF_CONV cf baseconvs r in MK_COMB(AP_TERM and_tm th_lp,th_rp) | Comb(Comb(Const("\\/",_),l),r) -> let th_lp = NNF_CONV cf baseconvs l and th_rp = NNF_CONV cf baseconvs r in MK_COMB(AP_TERM or_tm th_lp,th_rp) | Comb(Comb(Const("==>",_),l),r) -> let th_ln = NNF_CONV' cf baseconvs l and th_rp = NNF_CONV cf baseconvs r in TRANS (INST [l,p_tm; r,q_tm] pth_imp) (MK_COMB(AP_TERM or_tm th_ln,th_rp)) | Comb(Comb(Const("=",Tyapp("fun",Tyapp("bool",_)::_)),l),r) -> let th_lp,th_ln = NNF_DCONV cf base2 l and th_rp,th_rn = NNF_DCONV cf base2 r in if cf then TRANS (INST [l,p_tm; r,q_tm] pth_eq') (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rn)), MK_COMB(AP_TERM or_tm th_ln,th_rp))) else TRANS (INST [l,p_tm; r,q_tm] pth_eq) (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rp)), MK_COMB(AP_TERM and_tm th_ln,th_rn))) | Comb(Const("!",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, (Abs(x,t))) -> let th_p = NNF_CONV true baseconvs t in AP_TERM q (ABS x th_p) | Comb(Const("?",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, (Abs(x,t))) -> let th_p = NNF_CONV cf baseconvs t in AP_TERM q (ABS x th_p) | Comb(Const("?!",Tyapp("fun",Tyapp("fun",ty::_)::_)), (Abs(x,t) as bod)) -> let y = variant (x::frees t) x and th_p,th_n = NNF_DCONV cf base2 t in let eq = mk_eq(y,x) in let eth_p,eth_n = base2 eq and bth = BETA (mk_comb(bod,x)) and bth' = BETA_CONV(mk_comb(bod,y)) in let th_n' = INST [y,x] th_n in let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_exu) and th2 = MK_COMB(AP_TERM and_tm (MK_EXISTS x (TRANS bth th_p)), MK_FORALL x (MK_FORALL y (MK_COMB(AP_TERM or_tm (TRANS (AP_TERM not_tm bth) th_n), MK_COMB(AP_TERM or_tm (TRANS (AP_TERM not_tm bth') th_n'), eth_p))))) in TRANS th1 th2 | Comb(Const("~",_),t) -> NNF_CONV' cf baseconvs t | _ -> try base1 tm with Failure _ -> REFL tm and NNF_CONV' cf (base1,base2 as baseconvs) tm = match tm with Comb(Comb(Const("/\\",_),l),r) -> let th_ln = NNF_CONV' cf baseconvs l and th_rn = NNF_CONV' cf baseconvs r in TRANS (INST [l,p_tm; r,q_tm] pth_not_and) (MK_COMB(AP_TERM or_tm th_ln,th_rn)) | Comb(Comb(Const("\\/",_),l),r) -> let th_ln = NNF_CONV' cf baseconvs l and th_rn = NNF_CONV' cf baseconvs r in TRANS (INST [l,p_tm; r,q_tm] pth_not_or) (MK_COMB(AP_TERM and_tm th_ln,th_rn)) | Comb(Comb(Const("==>",_),l),r) -> let th_lp = NNF_CONV cf baseconvs l and th_rn = NNF_CONV' cf baseconvs r in TRANS (INST [l,p_tm; r,q_tm] pth_not_imp) (MK_COMB(AP_TERM and_tm th_lp,th_rn)) | Comb(Comb(Const("=",Tyapp("fun",Tyapp("bool",_)::_)),l),r) -> let th_lp,th_ln = NNF_DCONV cf base2 l and th_rp,th_rn = NNF_DCONV cf base2 r in if cf then TRANS (INST [l,p_tm; r,q_tm] pth_not_eq') (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rp)), MK_COMB(AP_TERM or_tm th_ln,th_rn))) else TRANS (INST [l,p_tm; r,q_tm] pth_not_eq) (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rn)), MK_COMB(AP_TERM and_tm th_ln,th_rp))) | Comb(Const("!",Tyapp("fun",Tyapp("fun",ty::_)::_)), (Abs(x,t) as bod)) -> let th_n = NNF_CONV' cf baseconvs t in let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_not_forall) and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in TRANS th1 (MK_EXISTS x th2) | Comb(Const("?",Tyapp("fun",Tyapp("fun",ty::_)::_)), (Abs(x,t) as bod)) -> let th_n = NNF_CONV' true baseconvs t in let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_not_exists) and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in TRANS th1 (MK_FORALL x th2) | Comb(Const("?!",Tyapp("fun",Tyapp("fun",ty::_)::_)), (Abs(x,t) as bod)) -> let y = variant (x::frees t) x and th_p,th_n = NNF_DCONV cf base2 t in let eq = mk_eq(y,x) in let eth_p,eth_n = base2 eq and bth = BETA (mk_comb(bod,x)) and bth' = BETA_CONV(mk_comb(bod,y)) in let th_p' = INST [y,x] th_p in let th1' = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] (INST_TYPE [ty,aty] pth_not_exu) and th2' = MK_COMB(AP_TERM or_tm (MK_FORALL x (TRANS (AP_TERM not_tm bth) th_n)), MK_EXISTS x (MK_EXISTS y (MK_COMB(AP_TERM and_tm (TRANS bth th_p), MK_COMB(AP_TERM and_tm (TRANS bth' th_p'), eth_n))))) in TRANS th1' th2' | Comb(Const("~",_),t) -> let th1 = NNF_CONV cf baseconvs t in TRANS (INST [t,p_tm] pth_not_not) th1 | _ -> let tm' = mk_neg tm in try base1 tm' with Failure _ -> REFL tm' in NNF_CONV;; (* ------------------------------------------------------------------------- *) (* Some common special cases. *) (* ------------------------------------------------------------------------- *) let NNF_CONV = (GEN_NNF_CONV false (ALL_CONV,fun t -> REFL t,REFL(mk_neg t)) :conv);; let NNFC_CONV = (GEN_NNF_CONV true (ALL_CONV,fun t -> REFL t,REFL(mk_neg t)) :conv);; (* ------------------------------------------------------------------------- *) (* Skolemize a term already in NNF (doesn't matter if it's not prenex). *) (* ------------------------------------------------------------------------- *) let SKOLEM_CONV = GEN_REWRITE_CONV TOP_DEPTH_CONV [EXISTS_OR_THM; LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; FORALL_AND_THM; LEFT_FORALL_OR_THM; RIGHT_FORALL_OR_THM; FORALL_SIMP; EXISTS_SIMP] THENC GEN_REWRITE_CONV REDEPTH_CONV [RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; OR_EXISTS_THM; RIGHT_OR_EXISTS_THM; LEFT_OR_EXISTS_THM; SKOLEM_THM];; (* ------------------------------------------------------------------------- *) (* Put a term already in NNF into prenex form. *) (* ------------------------------------------------------------------------- *) let PRENEX_CONV = GEN_REWRITE_CONV REDEPTH_CONV [AND_FORALL_THM; LEFT_AND_FORALL_THM; RIGHT_AND_FORALL_THM; LEFT_OR_FORALL_THM; RIGHT_OR_FORALL_THM; OR_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM];; (* ------------------------------------------------------------------------- *) (* Weak and normal DNF conversion. The "weak" form gives a disjunction of *) (* conjunctions, but has no particular associativity at either level and *) (* may contain duplicates. The regular forms give canonical right-associate *) (* lists without duplicates, but do not remove subsumed disjuncts. *) (* *) (* In both cases the input term is supposed to be in NNF already. We do go *) (* inside quantifiers and transform their body, but don't move them. *) (* ------------------------------------------------------------------------- *) let WEAK_DNF_CONV,DNF_CONV = let pth1 = TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c` and pth2 = TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c` and a_tm = `a:bool` and b_tm = `b:bool` and c_tm = `c:bool` in let rec distribute tm = match tm with Comb(Comb(Const("/\\",_),a),Comb(Comb(Const("\\/",_),b),c)) -> let th = INST [a,a_tm; b,b_tm; c,c_tm] pth1 in TRANS th (BINOP_CONV distribute (rand(concl th))) | Comb(Comb(Const("/\\",_),Comb(Comb(Const("\\/",_),a),b)),c) -> let th = INST [a,a_tm; b,b_tm; c,c_tm] pth2 in TRANS th (BINOP_CONV distribute (rand(concl th))) | _ -> REFL tm in let strengthen = DEPTH_BINOP_CONV `(\/)` CONJ_CANON_CONV THENC DISJ_CANON_CONV in let rec weakdnf tm = match tm with Comb(Const("!",_),Abs(_,_)) | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV weakdnf tm | Comb(Comb(Const("\\/",_),_),_) -> BINOP_CONV weakdnf tm | Comb(Comb(Const("/\\",_) as op,l),r) -> let th = MK_COMB(AP_TERM op (weakdnf l),weakdnf r) in TRANS th (distribute(rand(concl th))) | _ -> REFL tm and substrongdnf tm = match tm with Comb(Const("!",_),Abs(_,_)) | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV strongdnf tm | Comb(Comb(Const("\\/",_),_),_) -> BINOP_CONV substrongdnf tm | Comb(Comb(Const("/\\",_) as op,l),r) -> let th = MK_COMB(AP_TERM op (substrongdnf l),substrongdnf r) in TRANS th (distribute(rand(concl th))) | _ -> REFL tm and strongdnf tm = let th = substrongdnf tm in TRANS th (strengthen(rand(concl th))) in weakdnf,strongdnf;; (* ------------------------------------------------------------------------- *) (* Likewise for CNF. *) (* ------------------------------------------------------------------------- *) let WEAK_CNF_CONV,CNF_CONV = let pth1 = TAUT `a \/ (b /\ c) <=> (a \/ b) /\ (a \/ c)` and pth2 = TAUT `(a /\ b) \/ c <=> (a \/ c) /\ (b \/ c)` and a_tm = `a:bool` and b_tm = `b:bool` and c_tm = `c:bool` in let rec distribute tm = match tm with Comb(Comb(Const("\\/",_),a),Comb(Comb(Const("/\\",_),b),c)) -> let th = INST [a,a_tm; b,b_tm; c,c_tm] pth1 in TRANS th (BINOP_CONV distribute (rand(concl th))) | Comb(Comb(Const("\\/",_),Comb(Comb(Const("/\\",_),a),b)),c) -> let th = INST [a,a_tm; b,b_tm; c,c_tm] pth2 in TRANS th (BINOP_CONV distribute (rand(concl th))) | _ -> REFL tm in let strengthen = DEPTH_BINOP_CONV `(/\)` DISJ_CANON_CONV THENC CONJ_CANON_CONV in let rec weakcnf tm = match tm with Comb(Const("!",_),Abs(_,_)) | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV weakcnf tm | Comb(Comb(Const("/\\",_),_),_) -> BINOP_CONV weakcnf tm | Comb(Comb(Const("\\/",_) as op,l),r) -> let th = MK_COMB(AP_TERM op (weakcnf l),weakcnf r) in TRANS th (distribute(rand(concl th))) | _ -> REFL tm and substrongcnf tm = match tm with Comb(Const("!",_),Abs(_,_)) | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV strongcnf tm | Comb(Comb(Const("/\\",_),_),_) -> BINOP_CONV substrongcnf tm | Comb(Comb(Const("\\/",_) as op,l),r) -> let th = MK_COMB(AP_TERM op (substrongcnf l),substrongcnf r) in TRANS th (distribute(rand(concl th))) | _ -> REFL tm and strongcnf tm = let th = substrongcnf tm in TRANS th (strengthen(rand(concl th))) in weakcnf,strongcnf;; (* ------------------------------------------------------------------------- *) (* Simply right-associate w.r.t. a binary operator. *) (* ------------------------------------------------------------------------- *) let ASSOC_CONV th = let th' = SYM(SPEC_ALL th) in let opx,yopz = dest_comb(rhs(concl th')) in let op,x = dest_comb opx in let y = lhand yopz and z = rand yopz in let rec distrib tm = match tm with Comb(Comb(op',Comb(Comb(op'',p),q)),r) when op' = op && op'' = op -> let th1 = INST [p,x; q,y; r,z] th' in let l,r' = dest_comb(rand(concl th1)) in let th2 = AP_TERM l (distrib r') in let th3 = distrib(rand(concl th2)) in TRANS th1 (TRANS th2 th3) | _ -> REFL tm in let rec assoc tm = match tm with Comb(Comb(op',p) as l,q) when op' = op -> let th = AP_TERM l (assoc q) in TRANS th (distrib(rand(concl th))) | _ -> REFL tm in assoc;; (* ------------------------------------------------------------------------- *) (* Eliminate select terms from a goal. *) (* ------------------------------------------------------------------------- *) let SELECT_ELIM_TAC = let SELECT_ELIM_CONV = let SELECT_ELIM_THM = let pth = prove (`(P:A->bool)((@) P) <=> (?) P`, REWRITE_TAC[EXISTS_THM] THEN BETA_TAC THEN REFL_TAC) and ptm = `P:A->bool` in fun tm -> let stm,atm = dest_comb tm in if is_const stm && fst(dest_const stm) = "@" then CONV_RULE(LAND_CONV BETA_CONV) (PINST [type_of(bndvar atm),aty] [atm,ptm] pth) else failwith "SELECT_ELIM_THM: not a select-term" in fun tm -> PURE_REWRITE_CONV (map SELECT_ELIM_THM (find_terms is_select tm)) tm in let SELECT_ELIM_ICONV = let SELECT_AX_THM = let pth = ISPEC `P:A->bool` SELECT_AX and ptm = `P:A->bool` in fun tm -> let stm,atm = dest_comb tm in if is_const stm && fst(dest_const stm) = "@" then let fvs = frees atm in let th1 = PINST [type_of(bndvar atm),aty] [atm,ptm] pth in let th2 = CONV_RULE(BINDER_CONV (BINOP_CONV BETA_CONV)) th1 in GENL fvs th2 else failwith "SELECT_AX_THM: not a select-term" in let SELECT_ELIM_ICONV tm = let t = find_term is_select tm in let th1 = SELECT_AX_THM t in let itm = mk_imp(concl th1,tm) in let th2 = DISCH_ALL (MP (ASSUME itm) th1) in let fvs = frees t in let fty = itlist (mk_fun_ty o type_of) fvs (type_of t) in let fn = genvar fty and atm = list_mk_abs(fvs,t) in let rawdef = mk_eq(fn,atm) in let def = GENL fvs (SYM(RIGHT_BETAS fvs (ASSUME rawdef))) in let th3 = PURE_REWRITE_CONV[def] (lhand(concl th2)) in let gtm = mk_forall(fn,rand(concl th3)) in let th4 = EQ_MP (SYM th3) (SPEC fn (ASSUME gtm)) in let th5 = IMP_TRANS (DISCH gtm th4) th2 in MP (INST [atm,fn] (DISCH rawdef th5)) (REFL atm) in let rec SELECT_ELIMS_ICONV tm = try let th = SELECT_ELIM_ICONV tm in let tm' = lhand(concl th) in IMP_TRANS (SELECT_ELIMS_ICONV tm') th with Failure _ -> DISCH tm (ASSUME tm) in SELECT_ELIMS_ICONV in CONV_TAC SELECT_ELIM_CONV THEN W(MATCH_MP_TAC o SELECT_ELIM_ICONV o snd);; (* ------------------------------------------------------------------------- *) (* Eliminate all lambda-terms except those part of quantifiers. *) (* ------------------------------------------------------------------------- *) let LAMBDA_ELIM_CONV = let HALF_MK_ABS_CONV = let pth = prove (`(s = \x. t x) <=> (!x. s x = t x)`, REWRITE_TAC[FUN_EQ_THM]) in let rec conv vs tm = if vs = [] then REFL tm else (GEN_REWRITE_CONV I [pth] THENC BINDER_CONV(conv (tl vs))) tm in conv in let rec find_lambda tm = if is_abs tm then tm else if is_var tm || is_const tm then failwith "find_lambda" else if is_abs tm then tm else if is_forall tm || is_exists tm || is_uexists tm then find_lambda (body(rand tm)) else let l,r = dest_comb tm in try find_lambda l with Failure _ -> find_lambda r in let rec ELIM_LAMBDA conv tm = try conv tm with Failure _ -> if is_abs tm then ABS_CONV (ELIM_LAMBDA conv) tm else if is_var tm || is_const tm then REFL tm else if is_forall tm || is_exists tm || is_uexists tm then BINDER_CONV (ELIM_LAMBDA conv) tm else COMB_CONV (ELIM_LAMBDA conv) tm in let APPLY_PTH = let pth = prove (`(!a. (a = c) ==> (P = Q a)) ==> (P <=> !a. (a = c) ==> Q a)`, SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL]) in MATCH_MP pth in let LAMB1_CONV tm = let atm = find_lambda tm in let v,bod = dest_abs atm in let vs = frees atm in let vs' = vs @ [v] in let aatm = list_mk_abs(vs,atm) in let f = genvar(type_of aatm) in let eq = mk_eq(f,aatm) in let th1 = SYM(RIGHT_BETAS vs (ASSUME eq)) in let th2 = ELIM_LAMBDA(GEN_REWRITE_CONV I [th1]) tm in let th3 = APPLY_PTH (GEN f (DISCH_ALL th2)) in CONV_RULE(RAND_CONV(BINDER_CONV(LAND_CONV (HALF_MK_ABS_CONV vs')))) th3 in let rec conv tm = try (LAMB1_CONV THENC conv) tm with Failure _ -> REFL tm in conv;; (* ------------------------------------------------------------------------- *) (* Eliminate conditionals; CONDS_ELIM_CONV aims for disjunctive splitting, *) (* for refutation procedures, and CONDS_CELIM_CONV for conjunctive. *) (* Both switch modes "sensibly" when going through a quantifier. *) (* ------------------------------------------------------------------------- *) let CONDS_ELIM_CONV,CONDS_CELIM_CONV = let th_cond = prove (`((b <=> F) ==> x = x0) /\ ((b <=> T) ==> x = x1) ==> x = (b /\ x1 \/ ~b /\ x0)`, BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[]) and th_cond' = prove (`((b <=> F) ==> x = x0) /\ ((b <=> T) ==> x = x1) ==> x = ((~b \/ x1) /\ (b \/ x0))`, BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[]) and propsimps = basic_net() and false_tm = `F` and true_tm = `T` in let match_th = MATCH_MP th_cond and match_th' = MATCH_MP th_cond' and propsimp_conv = DEPTH_CONV(REWRITES_CONV propsimps) and proptsimp_conv = let cnv = TRY_CONV(REWRITES_CONV propsimps) in BINOP_CONV cnv THENC cnv in let rec find_conditional fvs tm = match tm with Comb(s,t) -> if is_cond tm && intersect (frees(lhand s)) fvs = [] then tm else (try (find_conditional fvs s) with Failure _ -> find_conditional fvs t) | Abs(x,t) -> find_conditional (x::fvs) t | _ -> failwith "find_conditional" in let rec CONDS_ELIM_CONV dfl tm = try let t = find_conditional [] tm in let p = lhand(rator t) in let th_new = if p = false_tm || p = true_tm then propsimp_conv tm else let asm_0 = mk_eq(p,false_tm) and asm_1 = mk_eq(p,true_tm) in let simp_0 = net_of_thm false (ASSUME asm_0) propsimps and simp_1 = net_of_thm false (ASSUME asm_1) propsimps in let th_0 = DISCH asm_0 (DEPTH_CONV(REWRITES_CONV simp_0) tm) and th_1 = DISCH asm_1 (DEPTH_CONV(REWRITES_CONV simp_1) tm) in let th_2 = CONJ th_0 th_1 in let th_3 = if dfl then match_th th_2 else match_th' th_2 in TRANS th_3 (proptsimp_conv(rand(concl th_3))) in CONV_RULE (RAND_CONV (CONDS_ELIM_CONV dfl)) th_new with Failure _ -> if is_neg tm then RAND_CONV (CONDS_ELIM_CONV (not dfl)) tm else if is_conj tm || is_disj tm then BINOP_CONV (CONDS_ELIM_CONV dfl) tm else if is_imp tm || is_iff tm then COMB2_CONV (RAND_CONV (CONDS_ELIM_CONV (not dfl))) (CONDS_ELIM_CONV dfl) tm else if is_forall tm then BINDER_CONV (CONDS_ELIM_CONV false) tm else if is_exists tm || is_uexists tm then BINDER_CONV (CONDS_ELIM_CONV true) tm else REFL tm in CONDS_ELIM_CONV true,CONDS_ELIM_CONV false;; (* ------------------------------------------------------------------------- *) (* Fix up all head arities to be consistent, in "first order logic" style. *) (* Applied to the assumptions (not conclusion) in a goal. *) (* ------------------------------------------------------------------------- *) let ASM_FOL_TAC = let rec get_heads lconsts tm (cheads,vheads as sofar) = try let v,bod = dest_forall tm in get_heads (subtract lconsts [v]) bod sofar with Failure _ -> try let l,r = try dest_conj tm with Failure _ -> dest_disj tm in get_heads lconsts l (get_heads lconsts r sofar) with Failure _ -> try let tm' = dest_neg tm in get_heads lconsts tm' sofar with Failure _ -> let hop,args = strip_comb tm in let len = length args in let newheads = if is_const hop || mem hop lconsts then (insert (hop,len) cheads,vheads) else if len > 0 then (cheads,insert (hop,len) vheads) else sofar in itlist (get_heads lconsts) args newheads in let get_thm_heads th sofar = get_heads (freesl(hyp th)) (concl th) sofar in let APP_CONV = let th = prove (`!(f:A->B) x. f x = I f x`, REWRITE_TAC[I_THM]) in REWR_CONV th in let rec APP_N_CONV n tm = if n = 1 then APP_CONV tm else (RATOR_CONV (APP_N_CONV (n - 1)) THENC APP_CONV) tm in let rec FOL_CONV hddata tm = if is_forall tm then BINDER_CONV (FOL_CONV hddata) tm else if is_conj tm || is_disj tm then BINOP_CONV (FOL_CONV hddata) tm else let op,args = strip_comb tm in let th = rev_itlist (C (curry MK_COMB)) (map (FOL_CONV hddata) args) (REFL op) in let tm' = rand(concl th) in let n = try length args - assoc op hddata with Failure _ -> 0 in if n = 0 then th else TRANS th (APP_N_CONV n tm') in let GEN_FOL_CONV (cheads,vheads) = let hddata = if vheads = [] then let hops = setify (map fst cheads) in let getmin h = let ns = mapfilter (fun (k,n) -> if k = h then n else fail()) cheads in if length ns < 2 then fail() else h,end_itlist min ns in mapfilter getmin hops else map (fun t -> if is_const t && fst(dest_const t) = "=" then t,2 else t,0) (setify (map fst (vheads @ cheads))) in FOL_CONV hddata in fun (asl,w as gl) -> let headsp = itlist (get_thm_heads o snd) asl ([],[]) in RULE_ASSUM_TAC(CONV_RULE(GEN_FOL_CONV headsp)) gl;; (* ------------------------------------------------------------------------- *) (* Depth conversion to apply at "atomic" formulas in "first-order" term. *) (* ------------------------------------------------------------------------- *) let rec PROP_ATOM_CONV conv tm = match tm with Comb((Const("!",_) | Const("?",_) | Const("?!",_)),Abs(_,_)) -> BINDER_CONV (PROP_ATOM_CONV conv) tm | Comb(Comb ((Const("/\\",_) | Const("\\/",_) | Const("==>",_) | (Const("=",Tyapp("fun",[Tyapp("bool",[]);_])))),_),_) -> BINOP_CONV (PROP_ATOM_CONV conv) tm | Comb(Const("~",_),_) -> RAND_CONV (PROP_ATOM_CONV conv) tm | _ -> TRY_CONV conv tm;; hol-light/cart.ml000066400000000000000000000602501303454263000142330ustar00rootroot00000000000000(* ========================================================================= *) (* Definition of finite Cartesian product types. *) (* *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "iterate.ml";; (* ------------------------------------------------------------------------- *) (* Association of a number with an indexing type. *) (* ------------------------------------------------------------------------- *) let dimindex = new_definition `dimindex(s:A->bool) = if FINITE(:A) then CARD(:A) else 1`;; let DIMINDEX_NONZERO = prove (`!s:A->bool. ~(dimindex(s) = 0)`, GEN_TAC THEN REWRITE_TAC[dimindex] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CARD_EQ_0; ARITH] THEN SET_TAC[]);; let DIMINDEX_GE_1 = prove (`!s:A->bool. 1 <= dimindex(s)`, REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; DIMINDEX_NONZERO]);; let DIMINDEX_UNIV = prove (`!s. dimindex(s:A->bool) = dimindex(:A)`, REWRITE_TAC[dimindex]);; let DIMINDEX_UNIQUE = prove (`(:A) HAS_SIZE n ==> dimindex(:A) = n`, MESON_TAC[dimindex; HAS_SIZE]);; (* ------------------------------------------------------------------------- *) (* An indexing type with that size, parametrized by base type. *) (* ------------------------------------------------------------------------- *) let finite_image_tybij = new_type_definition "finite_image" ("finite_index","dest_finite_image") (prove (`?x. x IN 1..dimindex(:A)`, EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1]));; let FINITE_IMAGE_IMAGE = prove (`UNIV:(A)finite_image->bool = IMAGE finite_index (1..dimindex(:A))`, REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN MESON_TAC[finite_image_tybij]);; (* ------------------------------------------------------------------------- *) (* Dimension of such a type, and indexing over it. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_FINITE_IMAGE = prove (`!s. (UNIV:(A)finite_image->bool) HAS_SIZE dimindex(s:A->bool)`, GEN_TAC THEN SIMP_TAC[FINITE_IMAGE_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ONCE_REWRITE_TAC[DIMINDEX_UNIV] THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN MESON_TAC[finite_image_tybij]);; let CARD_FINITE_IMAGE = prove (`!s. CARD(UNIV:(A)finite_image->bool) = dimindex(s:A->bool)`, MESON_TAC[HAS_SIZE_FINITE_IMAGE; HAS_SIZE]);; let FINITE_FINITE_IMAGE = prove (`FINITE(UNIV:(A)finite_image->bool)`, MESON_TAC[HAS_SIZE_FINITE_IMAGE; HAS_SIZE]);; let DIMINDEX_FINITE_IMAGE = prove (`!s t. dimindex(s:(A)finite_image->bool) = dimindex(t:A->bool)`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [dimindex] THEN MP_TAC(ISPEC `t:A->bool` HAS_SIZE_FINITE_IMAGE) THEN SIMP_TAC[FINITE_FINITE_IMAGE; HAS_SIZE]);; let FINITE_INDEX_WORKS = prove (`!i:(A)finite_image. ?!n. 1 <= n /\ n <= dimindex(:A) /\ (finite_index n = i)`, REWRITE_TAC[CONJ_ASSOC; GSYM IN_NUMSEG] THEN MESON_TAC[finite_image_tybij]);; let FINITE_INDEX_INJ = prove (`!i j. 1 <= i /\ i <= dimindex(:A) /\ 1 <= j /\ j <= dimindex(:A) ==> ((finite_index i :A finite_image = finite_index j) <=> (i = j))`, MESON_TAC[FINITE_INDEX_WORKS]);; let FORALL_FINITE_INDEX = prove (`(!k:(N)finite_image. P k) = (!i. 1 <= i /\ i <= dimindex(:N) ==> P(finite_index i))`, MESON_TAC[FINITE_INDEX_WORKS]);; (* ------------------------------------------------------------------------- *) (* Hence finite Cartesian products, with indexing and lambdas. *) (* ------------------------------------------------------------------------- *) let cart_tybij = new_type_definition "cart" ("mk_cart","dest_cart") (prove(`?f:(B)finite_image->A. T`,REWRITE_TAC[]));; parse_as_infix("$",(25,"left"));; let finite_index = new_definition `x$i = dest_cart x (finite_index i)`;; let CART_EQ = prove (`!x:A^B y. (x = y) <=> !i. 1 <= i /\ i <= dimindex(:B) ==> (x$i = y$i)`, REPEAT GEN_TAC THEN REWRITE_TAC[finite_index; GSYM FORALL_FINITE_INDEX] THEN REWRITE_TAC[GSYM FUN_EQ_THM; ETA_AX] THEN MESON_TAC[cart_tybij]);; parse_as_binder "lambda";; let lambda = new_definition `(lambda) g = @f:A^B. !i. 1 <= i /\ i <= dimindex(:B) ==> (f$i = g i)`;; let LAMBDA_BETA = prove (`!i. 1 <= i /\ i <= dimindex(:B) ==> (((lambda) g:A^B) $i = g i)`, REWRITE_TAC[lambda] THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC `mk_cart(\k. g(@i. 1 <= i /\ i <= dimindex(:B) /\ (finite_index i = k))):A^B` THEN REWRITE_TAC[finite_index; REWRITE_RULE[] cart_tybij] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN GEN_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[FINITE_INDEX_INJ; DIMINDEX_FINITE_IMAGE]);; let LAMBDA_UNIQUE = prove (`!f:A^B g. (!i. 1 <= i /\ i <= dimindex(:B) ==> (f$i = g i)) <=> ((lambda) g = f)`, SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]);; let LAMBDA_ETA = prove (`!g. (lambda i. g$i) = g`, REWRITE_TAC[CART_EQ; LAMBDA_BETA]);; (* ------------------------------------------------------------------------- *) (* For some purposes we can avoid side-conditions on the index. *) (* ------------------------------------------------------------------------- *) let FINITE_INDEX_INRANGE = prove (`!i. ?k. 1 <= k /\ k <= dimindex(:N) /\ !x:A^N. x$i = x$k`, REWRITE_TAC[finite_index] THEN MESON_TAC[FINITE_INDEX_WORKS]);; let FINITE_INDEX_INRANGE_2 = prove (`!i. ?k. 1 <= k /\ k <= dimindex(:N) /\ (!x:A^N. x$i = x$k) /\ (!y:B^N. y$i = y$k)`, REWRITE_TAC[finite_index] THEN MESON_TAC[FINITE_INDEX_WORKS]);; let CART_EQ_FULL = prove (`!x y:A^N. x = y <=> !i. x$i = y$i`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN SIMP_TAC[CART_EQ]);; (* ------------------------------------------------------------------------- *) (* We need a non-standard sum to "paste" together Cartesian products. *) (* ------------------------------------------------------------------------- *) let finite_sum_tybij = let th = prove (`?x. x IN 1..(dimindex(:A) + dimindex(:B))`, EXISTS_TAC `1` THEN SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1; ARITH_RULE `1 <= a ==> 1 <= a + b`]) in new_type_definition "finite_sum" ("mk_finite_sum","dest_finite_sum") th;; let pastecart = new_definition `(pastecart:A^M->A^N->A^(M,N)finite_sum) f g = lambda i. if i <= dimindex(:M) then f$i else g$(i - dimindex(:M))`;; let fstcart = new_definition `(fstcart:A^(M,N)finite_sum->A^M) f = lambda i. f$i`;; let sndcart = new_definition `(sndcart:A^(M,N)finite_sum->A^N) f = lambda i. f$(i + dimindex(:M))`;; let FINITE_SUM_IMAGE = prove (`UNIV:(A,B)finite_sum->bool = IMAGE mk_finite_sum (1..(dimindex(:A)+dimindex(:B)))`, REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN MESON_TAC[finite_sum_tybij]);; let DIMINDEX_HAS_SIZE_FINITE_SUM = prove (`(UNIV:(M,N)finite_sum->bool) HAS_SIZE (dimindex(:M) + dimindex(:N))`, SIMP_TAC[FINITE_SUM_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ONCE_REWRITE_TAC[DIMINDEX_UNIV] THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN MESON_TAC[finite_sum_tybij]);; let DIMINDEX_FINITE_SUM = prove (`dimindex(:(M,N)finite_sum) = dimindex(:M) + dimindex(:N)`, GEN_REWRITE_TAC LAND_CONV [dimindex] THEN REWRITE_TAC[REWRITE_RULE[HAS_SIZE] DIMINDEX_HAS_SIZE_FINITE_SUM]);; let FSTCART_PASTECART = prove (`!x y. fstcart(pastecart (x:A^M) (y:A^N)) = x`, SIMP_TAC[pastecart; fstcart; CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ARITH_RULE `a <= b ==> a <= b + c`]);; let SNDCART_PASTECART = prove (`!x y. sndcart(pastecart (x:A^M) (y:A^N)) = y`, SIMP_TAC[pastecart; sndcart; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN W(fun (_,w) -> MP_TAC (PART_MATCH (lhs o rand) LAMBDA_BETA (lhand w))) THEN ANTS_TAC THENL [REWRITE_TAC[DIMINDEX_FINITE_SUM] THEN MATCH_MP_TAC (ARITH_RULE `1 <= i /\ i <= b ==> 1 <= i + a /\ i + a <= a + b`) THEN ASM_REWRITE_TAC[]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[ADD_SUB; ARITH_RULE `1 <= i ==> ~(i + a <= a)`]]);; let PASTECART_FST_SND = prove (`!z. pastecart (fstcart z) (sndcart z) = z`, SIMP_TAC[pastecart; fstcart; sndcart; CART_EQ; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DIMINDEX_FINITE_SUM; LAMBDA_BETA; ARITH_RULE `i <= a + b ==> i - a <= b`; ARITH_RULE `~(i <= a) ==> 1 <= i - a`; ARITH_RULE `~(i <= a) ==> ((i - a) + a = i)`]);; let PASTECART_EQ = prove (`!x y. (x = y) <=> (fstcart x = fstcart y) /\ (sndcart x = sndcart y)`, MESON_TAC[PASTECART_FST_SND]);; let FORALL_PASTECART = prove (`(!p. P p) <=> !x y. P (pastecart x y)`, MESON_TAC[PASTECART_FST_SND; FSTCART_PASTECART; SNDCART_PASTECART]);; let EXISTS_PASTECART = prove (`(?p. P p) <=> ?x y. P (pastecart x y)`, MESON_TAC[PASTECART_FST_SND; FSTCART_PASTECART; SNDCART_PASTECART]);; let PASTECART_INJ = prove (`!x:real^M y:real^N w z. pastecart x y = pastecart w z <=> x = w /\ y = z`, REWRITE_TAC[PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART]);; (* ------------------------------------------------------------------------- *) (* Likewise a "subtraction" function on type indices. *) (* ------------------------------------------------------------------------- *) let finite_diff_tybij = let th = prove (`?x. x IN 1..(if dimindex(:B) < dimindex(:A) then dimindex(:A) - dimindex(:B) else 1)`, EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC) in new_type_definition "finite_diff" ("mk_finite_diff","dest_finite_diff") th;; let FINITE_DIFF_IMAGE = prove (`UNIV:(A,B)finite_diff->bool = IMAGE mk_finite_diff (1..(if dimindex(:B) < dimindex(:A) then dimindex(:A) - dimindex(:B) else 1))`, REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN MESON_TAC[finite_diff_tybij]);; let DIMINDEX_HAS_SIZE_FINITE_DIFF = prove (`(UNIV:(M,N)finite_diff->bool) HAS_SIZE (if dimindex(:N) < dimindex(:M) then dimindex(:M) - dimindex(:N) else 1)`, SIMP_TAC[FINITE_DIFF_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ONCE_REWRITE_TAC[DIMINDEX_UNIV] THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN MESON_TAC[finite_diff_tybij]);; let DIMINDEX_FINITE_DIFF = prove (`dimindex(:(M,N)finite_diff) = if dimindex(:N) < dimindex(:M) then dimindex(:M) - dimindex(:N) else 1`, GEN_REWRITE_TAC LAND_CONV [dimindex] THEN REWRITE_TAC[REWRITE_RULE[HAS_SIZE] DIMINDEX_HAS_SIZE_FINITE_DIFF]);; (* ------------------------------------------------------------------------- *) (* And a finite-forcing "multiplication" on type indices. *) (* ------------------------------------------------------------------------- *) let finite_prod_tybij = let th = prove (`?x. x IN 1..(dimindex(:A) * dimindex(:B))`, EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL] THEN MESON_TAC[LE_1; DIMINDEX_GE_1; MULT_EQ_0]) in new_type_definition "finite_prod" ("mk_finite_prod","dest_finite_prod") th;; let FINITE_PROD_IMAGE = prove (`UNIV:(A,B)finite_prod->bool = IMAGE mk_finite_prod (1..(dimindex(:A)*dimindex(:B)))`, REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN MESON_TAC[finite_prod_tybij]);; let DIMINDEX_HAS_SIZE_FINITE_PROD = prove (`(UNIV:(M,N)finite_prod->bool) HAS_SIZE (dimindex(:M) * dimindex(:N))`, SIMP_TAC[FINITE_PROD_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ONCE_REWRITE_TAC[DIMINDEX_UNIV] THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN MESON_TAC[finite_prod_tybij]);; let DIMINDEX_FINITE_PROD = prove (`dimindex(:(M,N)finite_prod) = dimindex(:M) * dimindex(:N)`, GEN_REWRITE_TAC LAND_CONV [dimindex] THEN REWRITE_TAC[REWRITE_RULE[HAS_SIZE] DIMINDEX_HAS_SIZE_FINITE_PROD]);; (* ------------------------------------------------------------------------- *) (* Automatically define a type of size n. *) (* ------------------------------------------------------------------------- *) let define_finite_type = let lemma_pre = prove (`~(n = 0) ==> ?x. x IN 1..n`, DISCH_TAC THEN EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC) and lemma_post = prove (`(!a:A. mk(dest a) = a) /\ (!r. r IN 1..n <=> dest(mk r) = r) ==> (:A) HAS_SIZE n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(:A) = IMAGE mk (1..n)` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ] THEN ASM_MESON_TAC[HAS_SIZE_NUMSEG_1]) in let POST_RULE = MATCH_MP lemma_post and n_tm = `n:num` in fun n -> let ns = string_of_int n in let ns' = "auto_define_finite_type_"^ns in let th0 = INST [mk_small_numeral n,n_tm] lemma_pre in let th1 = MP th0 (EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th0))))) in POST_RULE(new_type_definition ns ("mk_"^ns',"dest_"^ns') th1);; (* ------------------------------------------------------------------------- *) (* Predefine the cases 2, 3 and 4, which are especially useful for real^N. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_1 = prove (`(:1) HAS_SIZE 1`, SUBGOAL_THEN `(:1) = {one}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNIV; IN_SING] THEN MESON_TAC[one]; SIMP_TAC[NOT_IN_EMPTY; HAS_SIZE; FINITE_RULES; CARD_CLAUSES; ARITH]]);; let HAS_SIZE_2 = define_finite_type 2;; let HAS_SIZE_3 = define_finite_type 3;; let HAS_SIZE_4 = define_finite_type 4;; let DIMINDEX_1 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_1;; let DIMINDEX_2 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_2;; let DIMINDEX_3 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_3;; let DIMINDEX_4 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_4;; (* ------------------------------------------------------------------------- *) (* Finiteness lemma. *) (* ------------------------------------------------------------------------- *) let FINITE_CART = prove (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> FINITE {x | P i x}) ==> FINITE {v:A^N | !i. 1 <= i /\ i <= dimindex(:N) ==> P i (v$i)}`, GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!n. n <= dimindex(:N) ==> FINITE {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n ==> P i (v$i)) /\ (!i. 1 <= i /\ i <= dimindex(:N) /\ n < i ==> v$i = @x. F)}` (MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL; LET_ANTISYM] THEN INDUCT_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= n /\ i <= 0 <=> F`] THEN SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n /\ 0 < i <=> 1 <= i /\ i <= n`] THEN SUBGOAL_THEN `{v | !i. 1 <= i /\ i <= dimindex (:N) ==> v$i = (@x. F)} = {(lambda i. @x. F):A^N}` (fun th -> SIMP_TAC[FINITE_RULES;th]) THEN SIMP_TAC[EXTENSION; IN_SING; IN_ELIM_THM; CART_EQ; LAMBDA_BETA]; ALL_TAC] THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\(x:A,v:A^N). (lambda i. if i = SUC n then x else v$i):A^N) {x,v | x IN {x:A | P (SUC n) x} /\ v IN {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n ==> P i (v$i)) /\ (!i. 1 <= i /\ i <= dimindex (:N) /\ n < i ==> v$i = (@x. F))}}` THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[FINITE_PRODUCT; ARITH_RULE `1 <= SUC n`; ARITH_RULE `SUC n <= m ==> n <= m`]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN X_GEN_TAC `v:A^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `(v:A^N)$(SUC n)` THEN EXISTS_TAC `(lambda i. if i = SUC n then @x. F else (v:A^N)$i):A^N` THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; ARITH_RULE `i <= n ==> ~(i = SUC n)`] THEN ASM_MESON_TAC[LE; ARITH_RULE `1 <= SUC n`; ARITH_RULE `n < i /\ ~(i = SUC n) ==> SUC n < i`]);; (* ------------------------------------------------------------------------- *) (* More cardinality results for whole universe. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_CART_UNIV = prove (`!m. (:A) HAS_SIZE m ==> (:A^N) HAS_SIZE m EXP (dimindex(:N))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `(:(N)finite_image->A) HAS_SIZE m EXP (dimindex(:N))` MP_TAC THENL [ASM_SIMP_TAC[HAS_SIZE_FUNSPACE_UNIV; HAS_SIZE_FINITE_IMAGE]; DISCH_THEN(MP_TAC o ISPEC `mk_cart:((N)finite_image->A)->A^N` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] HAS_SIZE_IMAGE_INJ)) THEN REWRITE_TAC[IN_UNIV] THEN ANTS_TAC THENL [MESON_TAC[cart_tybij]; MATCH_MP_TAC EQ_IMP] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN MESON_TAC[cart_tybij]]);; let CARD_CART_UNIV = prove (`FINITE(:A) ==> CARD(:A^N) = CARD(:A) EXP dimindex(:N)`, MESON_TAC[HAS_SIZE_CART_UNIV; HAS_SIZE]);; let FINITE_CART_UNIV = prove (`FINITE(:A) ==> FINITE(:A^N)`, MESON_TAC[HAS_SIZE_CART_UNIV; HAS_SIZE]);; (* ------------------------------------------------------------------------- *) (* Explicit construction of a vector from a list of components. *) (* ------------------------------------------------------------------------- *) let vector = new_definition `(vector l):A^N = lambda i. EL (i - 1) l`;; (* ------------------------------------------------------------------------- *) (* Convenient set membership elimination theorem. *) (* ------------------------------------------------------------------------- *) let IN_ELIM_PASTECART_THM = prove (`!P a b. pastecart a b IN {pastecart x y | P x y} <=> P a b`, REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Variant of product types using pasting of vectors. *) (* ------------------------------------------------------------------------- *) parse_as_infix("PCROSS",(22,"right"));; let PCROSS = new_definition `s PCROSS t = {pastecart (x:A^M) (y:A^N) | x IN s /\ y IN t}`;; let FORALL_IN_PCROSS = prove (`(!z. z IN s PCROSS t ==> P z) <=> (!x y. x IN s /\ y IN t ==> P(pastecart x y))`, REWRITE_TAC[PCROSS; FORALL_IN_GSPEC]);; let EXISTS_IN_PCROSS = prove (`(?z. z IN s PCROSS t /\ P z) <=> (?x y. x IN s /\ y IN t /\ P(pastecart x y))`, REWRITE_TAC[PCROSS; EXISTS_IN_GSPEC; CONJ_ASSOC]);; let PASTECART_IN_PCROSS = prove (`!s t x y. (pastecart x y) IN (s PCROSS t) <=> x IN s /\ y IN t`, REWRITE_TAC[PCROSS; IN_ELIM_PASTECART_THM]);; let PCROSS_EQ_EMPTY = prove (`!s t. s PCROSS t = {} <=> s = {} \/ t = {}`, REWRITE_TAC[PCROSS] THEN SET_TAC[]);; let PCROSS_EMPTY = prove (`(!s. s PCROSS {} = {}) /\ (!t. {} PCROSS t = {})`, REWRITE_TAC[PCROSS_EQ_EMPTY]);; let SUBSET_PCROSS = prove (`!s t s' t'. s PCROSS t SUBSET s' PCROSS t' <=> s = {} \/ t = {} \/ s SUBSET s' /\ t SUBSET t'`, SIMP_TAC[PCROSS; EXTENSION; IN_ELIM_PASTECART_THM; SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS; NOT_IN_EMPTY] THEN MESON_TAC[]);; let PCROSS_MONO = prove (`!s t s' t'. s SUBSET s' /\ t SUBSET t' ==> s PCROSS t SUBSET s' PCROSS t'`, SIMP_TAC[SUBSET_PCROSS]);; let PCROSS_EQ = prove (`!s s':real^M->bool t t':real^N->bool. s PCROSS t = s' PCROSS t' <=> (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/ s = s' /\ t = t'`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_PCROSS] THEN SET_TAC[]);; let UNIV_PCROSS_UNIV = prove (`(:A^M) PCROSS (:A^N) = (:A^(M,N)finite_sum)`, REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNIV]);; let HAS_SIZE_PCROSS = prove (`!(s:A^M->bool) (t:A^N->bool) m n. s HAS_SIZE m /\ t HAS_SIZE n ==> (s PCROSS t) HAS_SIZE (m * n)`, REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HAS_SIZE_PRODUCT) THEN MATCH_MP_TAC EQ_IMP THEN SPEC_TAC(`m * n:num`,`k:num`) THEN MATCH_MP_TAC BIJECTIONS_HAS_SIZE_EQ THEN EXISTS_TAC `\(x:A^M,y:A^N). pastecart x y` THEN EXISTS_TAC `\z:A^(M,N)finite_sum. fstcart z,sndcart z` THEN REWRITE_TAC[FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN REWRITE_TAC[IN_ELIM_PAIR_THM; PASTECART_FST_SND] THEN REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);; let FINITE_PCROSS = prove (`!(s:A^M->bool) (t:A^N->bool). FINITE s /\ FINITE t ==> FINITE(s PCROSS t)`, MESON_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_PCROSS]);; let FINITE_PCROSS_EQ = prove (`!(s:A^M->bool) (t:A^N->bool). FINITE(s PCROSS t) <=> s = {} \/ t = {} \/ FINITE s /\ FINITE t`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`s:A^M->bool = {}`; `t:A^N->bool = {}`] THEN ASM_REWRITE_TAC[PCROSS_EMPTY; FINITE_EMPTY] THEN EQ_TAC THEN SIMP_TAC[FINITE_PCROSS] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THENL [EXISTS_TAC `IMAGE fstcart ((s PCROSS t):A^(M,N)finite_sum->bool)`; EXISTS_TAC `IMAGE sndcart ((s PCROSS t):A^(M,N)finite_sum->bool)`] THEN ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; EXISTS_PASTECART] THEN REWRITE_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let IMAGE_FSTCART_PCROSS = prove (`!s:real^M->bool t:real^N->bool. IMAGE fstcart (s PCROSS t) = if t = {} then {} else s`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[PCROSS_EMPTY; IMAGE_CLAUSES] THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_PCROSS; FSTCART_PASTECART] THEN ASM SET_TAC[]);; let IMAGE_SNDCART_PCROSS = prove (`!s:real^M->bool t:real^N->bool. IMAGE sndcart (s PCROSS t) = if s = {} then {} else t`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[PCROSS_EMPTY; IMAGE_CLAUSES] THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_PCROSS; SNDCART_PASTECART] THEN ASM SET_TAC[]);; let PCROSS_INTER = prove (`(!s t u. s PCROSS (t INTER u) = (s PCROSS t) INTER (s PCROSS u)) /\ (!s t u. (s INTER t) PCROSS u = (s PCROSS u) INTER (t PCROSS u))`, REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let PCROSS_UNION = prove (`(!s t u. s PCROSS (t UNION u) = (s PCROSS t) UNION (s PCROSS u)) /\ (!s t u. (s UNION t) PCROSS u = (s PCROSS u) UNION (t PCROSS u))`, REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let PCROSS_DIFF = prove (`(!s t u. s PCROSS (t DIFF u) = (s PCROSS t) DIFF (s PCROSS u)) /\ (!s t u. (s DIFF t) PCROSS u = (s PCROSS u) DIFF (t PCROSS u))`, REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; PASTECART_IN_PCROSS] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let INTER_PCROSS = prove (`!s s' t t'. (s PCROSS t) INTER (s' PCROSS t') = (s INTER s') PCROSS (t INTER t')`, REWRITE_TAC[EXTENSION; IN_INTER; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN CONV_TAC TAUT);; let PCROSS_UNIONS_UNIONS,PCROSS_UNIONS = (CONJ_PAIR o prove) (`(!f g. (UNIONS f) PCROSS (UNIONS g) = UNIONS {s PCROSS t | s IN f /\ t IN g}) /\ (!s f. s PCROSS (UNIONS f) = UNIONS {s PCROSS t | t IN f}) /\ (!f t. (UNIONS f) PCROSS t = UNIONS {s PCROSS t | s IN f})`, REWRITE_TAC[UNIONS_GSPEC; EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN SET_TAC[]);; let PCROSS_INTERS_INTERS,PCROSS_INTERS = (CONJ_PAIR o prove) (`(!f g. (INTERS f) PCROSS (INTERS g) = if f = {} then INTERS {UNIV PCROSS t | t IN g} else if g = {} then INTERS {s PCROSS UNIV | s IN f} else INTERS {s PCROSS t | s IN f /\ t IN g}) /\ (!s f. s PCROSS (INTERS f) = if f = {} then s PCROSS UNIV else INTERS {s PCROSS t | t IN f}) /\ (!f t. (INTERS f) PCROSS t = if f = {} then UNIV PCROSS t else INTERS {s PCROSS t | s IN f})`, REPEAT STRIP_TAC THEN REPEAT (COND_CASES_TAC THEN REWRITE_TAC[]) THEN ASM_REWRITE_TAC[INTERS_GSPEC; EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS; NOT_IN_EMPTY] THEN ASM SET_TAC[]);; hol-light/class.ml000066400000000000000000000471161303454263000144150ustar00rootroot00000000000000(* ========================================================================= *) (* Extensional, classical reasoning with AC starts now! *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "ind_defs.ml";; (* ------------------------------------------------------------------------- *) (* Eta-axiom, corresponding conversion, and extensionality. *) (* ------------------------------------------------------------------------- *) let ETA_AX = new_axiom `!t:A->B. (\x. t x) = t`;; let ETA_CONV = let t = `t:A->B` in let pth = prove(`(\x. (t:A->B) x) = t`,MATCH_ACCEPT_TAC ETA_AX) in fun tm -> try let bv,bod = dest_abs tm in let l,r = dest_comb bod in if r = bv && not (vfree_in bv l) then TRANS (REFL tm) (PINST [type_of bv,aty; type_of bod,bty] [l,t] pth) else fail() with Failure _ -> failwith "ETA_CONV";; let EQ_EXT = prove (`!(f:A->B) g. (!x. f x = g x) ==> f = g`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o ABS `x:A` o SPEC `x:A`) THEN REWRITE_TAC[ETA_AX]);; let FUN_EQ_THM = prove (`!(f:A->B) g. f = g <=> (!x. f x = g x)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REFL_TAC; MATCH_ACCEPT_TAC EQ_EXT]);; (* ------------------------------------------------------------------------- *) (* Indefinite descriptor (giving AC). *) (* ------------------------------------------------------------------------- *) new_constant("@",`:(A->bool)->A`);; parse_as_binder "@";; let is_select = is_binder "@";; let dest_select = dest_binder "@";; let mk_select = mk_binder "@";; let SELECT_AX = new_axiom `!P (x:A). P x ==> P((@) P)`;; (* ------------------------------------------------------------------------- *) (* Useful for compatibility. (The old EXISTS_DEF.) *) (* ------------------------------------------------------------------------- *) let EXISTS_THM = prove (`(?) = \P:A->bool. P ((@) P)`, MATCH_MP_TAC EQ_EXT THEN BETA_TAC THEN X_GEN_TAC `P:A->bool` THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN EQ_TAC THENL [DISCH_THEN(CHOOSE_THEN MP_TAC) THEN MATCH_ACCEPT_TAC SELECT_AX; DISCH_TAC THEN EXISTS_TAC `((@) P):A` THEN POP_ASSUM ACCEPT_TAC]);; (* ------------------------------------------------------------------------- *) (* Rules and so on for the select operator. *) (* ------------------------------------------------------------------------- *) let SELECT_RULE = let P = `P:A->bool` in let pth = prove (`(?) (P:A->bool) ==> P((@) P)`, SIMP_TAC[SELECT_AX; ETA_AX]) in fun th -> try let abs = rand(concl th) in let ty = type_of(bndvar abs) in CONV_RULE BETA_CONV (MP (PINST [ty,aty] [abs,P] pth) th) with Failure _ -> failwith "SELECT_RULE";; let SELECT_CONV = let P = `P:A->bool` in let pth = prove (`(P:A->bool)((@) P) = (?) P`, REWRITE_TAC[EXISTS_THM] THEN BETA_TAC THEN REFL_TAC) in fun tm -> try let is_epsok t = is_select t & let bv,bod = dest_select t in aconv tm (vsubst [t,bv] bod) in let pickeps = find_term is_epsok tm in let abs = rand pickeps in let ty = type_of (bndvar abs) in CONV_RULE (LAND_CONV BETA_CONV) (PINST [ty,aty] [abs,P] pth) with Failure _ -> failwith "SELECT_CONV";; (* ------------------------------------------------------------------------- *) (* Some basic theorems. *) (* ------------------------------------------------------------------------- *) let SELECT_REFL = prove (`!x:A. (@y. y = x) = x`, GEN_TAC THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC `x:A` THEN REFL_TAC);; let SELECT_UNIQUE = prove (`!P x. (!y:A. P y = (y = x)) ==> ((@) P = x)`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN ASM_REWRITE_TAC[SELECT_REFL]);; extend_basic_rewrites [SELECT_REFL];; (* ------------------------------------------------------------------------- *) (* Now we can derive type definitions from existence; check benignity. *) (* ------------------------------------------------------------------------- *) let the_type_definitions = ref ([]:((string*string*string)*(thm*thm))list);; let new_type_definition tyname (absname,repname) th = try let th',tth' = assoc (tyname,absname,repname) (!the_type_definitions) in if concl th' <> concl th then failwith "" else (warn true "Benign redefinition of type"; tth') with Failure _ -> let th0 = CONV_RULE (RATOR_CONV (REWR_CONV EXISTS_THM) THENC BETA_CONV) th in let th1,th2 = new_basic_type_definition tyname (absname,repname) th0 in let tth = CONJ (GEN_ALL th1) (GEN_ALL (CONV_RULE(LAND_CONV (TRY_CONV BETA_CONV)) th2)) in the_type_definitions := ((tyname,absname,repname),(th,tth)):: (!the_type_definitions); tth;; (* ------------------------------------------------------------------------- *) (* Derive excluded middle. The proof is an optimization due to Mark Adams of *) (* the original Diaconescu proof as presented in Beeson's book. *) (* ------------------------------------------------------------------------- *) let EXCLUDED_MIDDLE = prove (`!t. t \/ ~t`, GEN_TAC THEN SUBGOAL_THEN `(((@x. (x <=> F) \/ t) <=> F) \/ t) /\ (((@x. (x <=> T) \/ t) <=> T) \/ t)` MP_TAC THENL [CONJ_TAC THEN CONV_TAC SELECT_CONV THENL [EXISTS_TAC `F`; EXISTS_TAC `T`] THEN DISJ1_TAC THEN REFL_TAC; DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN TRY(DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC) THEN DISJ2_TAC THEN DISCH_TAC THEN MP_TAC(ITAUT `~(T <=> F)`) THEN PURE_ONCE_ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[ITAUT `p \/ T <=> T`]]);; let BOOL_CASES_AX = prove (`!t. (t <=> T) \/ (t <=> F)`, GEN_TAC THEN DISJ_CASES_TAC(SPEC `t:bool` EXCLUDED_MIDDLE) THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Classically based tactics. (See also COND_CASES_TAC later on.) *) (* ------------------------------------------------------------------------- *) let BOOL_CASES_TAC p = STRUCT_CASES_TAC (SPEC p BOOL_CASES_AX);; let ASM_CASES_TAC t = DISJ_CASES_TAC(SPEC t EXCLUDED_MIDDLE);; (* ------------------------------------------------------------------------- *) (* Set up a reasonable tautology checker for classical logic. *) (* ------------------------------------------------------------------------- *) let TAUT = let PROP_REWRITE_TAC = REWRITE_TAC[] in let RTAUT_TAC (asl,w) = let ok t = type_of t = bool_ty && can (find_term is_var) t && free_in t w in (PROP_REWRITE_TAC THEN W((fun t1 t2 -> t1 THEN t2) (REWRITE_TAC[]) o BOOL_CASES_TAC o hd o sort free_in o find_terms ok o snd)) (asl,w) in let TAUT_TAC = REPEAT(GEN_TAC ORELSE CONJ_TAC) THEN REPEAT RTAUT_TAC in fun tm -> prove(tm,TAUT_TAC);; (* ------------------------------------------------------------------------- *) (* A few useful classical tautologies. *) (* ------------------------------------------------------------------------- *) let DE_MORGAN_THM = TAUT `!t1 t2. (~(t1 /\ t2) <=> ~t1 \/ ~t2) /\ (~(t1 \/ t2) <=> ~t1 /\ ~t2)`;; let NOT_CLAUSES = TAUT `(!t. ~ ~t <=> t) /\ (~T <=> F) /\ (~F <=> T)`;; let NOT_IMP = TAUT `!t1 t2. ~(t1 ==> t2) <=> t1 /\ ~t2`;; let CONTRAPOS_THM = TAUT `!t1 t2. (~t1 ==> ~t2) <=> (t2 ==> t1)`;; extend_basic_rewrites [CONJUNCT1 NOT_CLAUSES];; (* ------------------------------------------------------------------------- *) (* Some classically based rules. *) (* ------------------------------------------------------------------------- *) let CCONTR = let P = `P:bool` in let pth = TAUT `(~P ==> F) ==> P` in fun tm th -> try let tm' = mk_neg tm in MP (INST [tm,P] pth) (DISCH tm' th) with Failure _ -> failwith "CCONTR";; let CONTRAPOS_CONV = let a = `a:bool` and b = `b:bool` in let pth = TAUT `(a ==> b) <=> (~b ==> ~a)` in fun tm -> try let P,Q = dest_imp tm in INST [P,a; Q,b] pth with Failure _ -> failwith "CONTRAPOS_CONV";; (* ------------------------------------------------------------------------- *) (* A classicalal "refutation" tactic. *) (* ------------------------------------------------------------------------- *) let REFUTE_THEN = let f_tm = `F` and conv = REWR_CONV(TAUT `p <=> ~p ==> F`) in fun ttac (asl,w as gl) -> if w = f_tm then ALL_TAC gl else if is_neg w then DISCH_THEN ttac gl else (CONV_TAC conv THEN DISCH_THEN ttac) gl;; (* ------------------------------------------------------------------------- *) (* Infinite de Morgan laws. *) (* ------------------------------------------------------------------------- *) let NOT_EXISTS_THM = prove (`!P. ~(?x:A. P x) <=> (!x. ~(P x))`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_TAC THEN DISCH_TAC THEN UNDISCH_TAC `~(?x:A. P x)` THEN REWRITE_TAC[] THEN EXISTS_TAC `x:A` THEN POP_ASSUM ACCEPT_TAC; DISCH_THEN(CHOOSE_THEN MP_TAC) THEN ASM_REWRITE_TAC[]]);; let EXISTS_NOT_THM = prove (`!P. (?x:A. ~(P x)) <=> ~(!x. P x)`, ONCE_REWRITE_TAC[TAUT `(a <=> ~b) <=> (~a <=> b)`] THEN REWRITE_TAC[NOT_EXISTS_THM]);; let NOT_FORALL_THM = prove (`!P. ~(!x. P x) <=> (?x:A. ~(P x))`, MATCH_ACCEPT_TAC(GSYM EXISTS_NOT_THM));; let FORALL_NOT_THM = prove (`!P. (!x. ~(P x)) <=> ~(?x:A. P x)`, MATCH_ACCEPT_TAC(GSYM NOT_EXISTS_THM));; (* ------------------------------------------------------------------------- *) (* Expand quantification over Booleans. *) (* ------------------------------------------------------------------------- *) let FORALL_BOOL_THM = prove (`(!b. P b) <=> P T /\ P F`, EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[]);; let EXISTS_BOOL_THM = prove (`(?b. P b) <=> P T \/ P F`, MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_BOOL_THM]);; (* ------------------------------------------------------------------------- *) (* Universal quantifier and disjunction *) (* ------------------------------------------------------------------------- *) let LEFT_FORALL_OR_THM = prove (`!P Q. (!x:A. P x \/ Q) <=> (!x. P x) \/ Q`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN REWRITE_TAC[NOT_FORALL_THM; DE_MORGAN_THM; LEFT_EXISTS_AND_THM]);; let RIGHT_FORALL_OR_THM = prove (`!P Q. (!x:A. P \/ Q x) <=> P \/ (!x. Q x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN REWRITE_TAC[NOT_FORALL_THM; DE_MORGAN_THM; RIGHT_EXISTS_AND_THM]);; let LEFT_OR_FORALL_THM = prove (`!P Q. (!x:A. P x) \/ Q <=> (!x. P x \/ Q)`, MATCH_ACCEPT_TAC(GSYM LEFT_FORALL_OR_THM));; let RIGHT_OR_FORALL_THM = prove (`!P Q. P \/ (!x:A. Q x) <=> (!x. P \/ Q x)`, MATCH_ACCEPT_TAC(GSYM RIGHT_FORALL_OR_THM));; (* ------------------------------------------------------------------------- *) (* Implication and quantifiers. *) (* ------------------------------------------------------------------------- *) let LEFT_IMP_FORALL_THM = prove (`!P Q. ((!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP; LEFT_AND_FORALL_THM]);; let LEFT_EXISTS_IMP_THM = prove (`!P Q. (?x. P x ==> Q) <=> ((!x:A. P x) ==> Q)`, MATCH_ACCEPT_TAC(GSYM LEFT_IMP_FORALL_THM));; let RIGHT_IMP_EXISTS_THM = prove (`!P Q. (P ==> ?x:A. Q x) <=> (?x:A. P ==> Q x)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP; RIGHT_AND_FORALL_THM]);; let RIGHT_EXISTS_IMP_THM = prove (`!P Q. (?x:A. P ==> Q x) <=> (P ==> ?x:A. Q x)`, MATCH_ACCEPT_TAC(GSYM RIGHT_IMP_EXISTS_THM));; (* ------------------------------------------------------------------------- *) (* The conditional. *) (* ------------------------------------------------------------------------- *) let COND_DEF = new_definition `COND = \t t1 t2. @x:A. ((t <=> T) ==> (x = t1)) /\ ((t <=> F) ==> (x = t2))`;; let COND_CLAUSES = prove (`!(t1:A) t2. ((if T then t1 else t2) = t1) /\ ((if F then t1 else t2) = t2)`, REWRITE_TAC[COND_DEF]);; let is_cond tm = try fst(dest_const(rator(rator (rator tm)))) = "COND" with Failure _ -> false;; let mk_cond (b,x,y) = try let c = mk_const("COND",[type_of x,aty]) in mk_comb(mk_comb(mk_comb(c,b),x),y) with Failure _ -> failwith "mk_cond";; let dest_cond tm = try let tm1,y = dest_comb tm in let tm2,x = dest_comb tm1 in let c,b = dest_comb tm2 in if fst(dest_const c) = "COND" then (b,(x,y)) else fail() with Failure _ -> failwith "dest_cond";; extend_basic_rewrites [COND_CLAUSES];; let COND_EXPAND = prove (`!b t1 t2. (if b then t1 else t2) <=> (~b \/ t1) /\ (b \/ t2)`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; let COND_ID = prove (`!b (t:A). (if b then t else t) = t`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; let COND_RAND = prove (`!b (f:A->B) x y. f (if b then x else y) = (if b then f x else f y)`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; let COND_RATOR = prove (`!b (f:A->B) g x. (if b then f else g)(x) = (if b then f x else g x)`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; let COND_ABS = prove (`!b (f:A->B) g. (\x. if b then f x else g x) = (if b then f else g)`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[ETA_AX]);; let COND_SWAP = prove (`!p x y:A. (if ~p then x else y) = (if p then y else x)`, REPEAT GEN_TAC THEN BOOL_CASES_TAC `p:bool` THEN REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Redefine TAUT to freeze in the rewrites including COND. *) (* ------------------------------------------------------------------------- *) let TAUT = let PROP_REWRITE_TAC = REWRITE_TAC[] in let RTAUT_TAC (asl,w) = let ok t = type_of t = bool_ty && can (find_term is_var) t && free_in t w in (PROP_REWRITE_TAC THEN W((fun t1 t2 -> t1 THEN t2) (REWRITE_TAC[]) o BOOL_CASES_TAC o hd o sort free_in o find_terms ok o snd)) (asl,w) in let TAUT_TAC = REPEAT(GEN_TAC ORELSE CONJ_TAC) THEN REPEAT RTAUT_TAC in fun tm -> prove(tm,TAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Throw monotonicity in. *) (* ------------------------------------------------------------------------- *) let MONO_COND = prove (`(A ==> B) /\ (C ==> D) ==> (if b then A else C) ==> (if b then B else D)`, STRIP_TAC THEN BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[]);; monotonicity_theorems := MONO_COND::(!monotonicity_theorems);; (* ------------------------------------------------------------------------- *) (* Tactic for splitting over an arbitrarily chosen conditional. *) (* ------------------------------------------------------------------------- *) let COND_ELIM_THM = prove (`(P:A->bool) (if c then x else y) <=> (c ==> P x) /\ (~c ==> P y)`, BOOL_CASES_TAC `c:bool` THEN REWRITE_TAC[]);; let COND_ELIM_CONV = HIGHER_REWRITE_CONV[COND_ELIM_THM] true;; let (COND_CASES_TAC :tactic) = let DENEG_RULE = GEN_REWRITE_RULE I [TAUT `~ ~ p <=> p`] in CONV_TAC COND_ELIM_CONV THEN CONJ_TAC THENL [DISCH_THEN(fun th -> ASSUME_TAC th THEN SUBST1_TAC(EQT_INTRO th)); DISCH_THEN(fun th -> try let th' = DENEG_RULE th in ASSUME_TAC th' THEN SUBST1_TAC(EQT_INTRO th') with Failure _ -> ASSUME_TAC th THEN SUBST1_TAC(EQF_INTRO th))];; (* ------------------------------------------------------------------------- *) (* Skolemization. *) (* ------------------------------------------------------------------------- *) let SKOLEM_THM = prove (`!P. (!x:A. ?y:B. P x y) <=> (?y. !x. P x (y x))`, REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL [EXISTS_TAC `\x:A. @y:B. P x y` THEN GEN_TAC THEN BETA_TAC THEN CONV_TAC SELECT_CONV; EXISTS_TAC `(y:A->B) x`] THEN POP_ASSUM MATCH_ACCEPT_TAC);; let SKOLEM_THM_GEN = prove (`!P s. (!x. P x ==> ?y. R x y) <=> (?f. !x. P x ==> R x (f x))`, REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM]);; (* ------------------------------------------------------------------------- *) (* NB: this one is true intutionistically and intensionally. *) (* ------------------------------------------------------------------------- *) let UNIQUE_SKOLEM_ALT = prove (`!P:A->B->bool. (!x. ?!y. P x y) <=> ?f. !x y. P x y <=> (f x = y)`, GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_ALT; SKOLEM_THM]);; (* ------------------------------------------------------------------------- *) (* and this one intuitionistically and extensionally. *) (* ------------------------------------------------------------------------- *) let UNIQUE_SKOLEM_THM = prove (`!P. (!x:A. ?!y:B. P x y) <=> (?!f. !x. P x (f x))`, GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM; SKOLEM_THM; FORALL_AND_THM] THEN EQ_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THENL [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:A` THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; MAP_EVERY X_GEN_TAC [`x:A`; `y1:B`; `y2:B`] THEN STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `f:A->B`) THEN SUBGOAL_THEN `(\z. if z = x then y1 else (f:A->B) z) = (\z. if z = x then y2 else (f:A->B) z)` MP_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN BETA_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(MP_TAC o C AP_THM `x:A`) THEN REWRITE_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* Extend default congruences for contextual rewriting. *) (* ------------------------------------------------------------------------- *) let COND_CONG = TAUT `(g = g') ==> (g' ==> (t = t')) ==> (~g' ==> (e = e')) ==> ((if g then t else e) = (if g' then t' else e'))` in extend_basic_congs [COND_CONG];; let COND_EQ_CLAUSE = prove (`(if x = x then y else z) = y`, REWRITE_TAC[]) in extend_basic_rewrites [COND_EQ_CLAUSE];; (* ------------------------------------------------------------------------- *) (* We can now treat "bool" as an enumerated type for some purposes. *) (* ------------------------------------------------------------------------- *) let bool_INDUCT = prove (`!P. P F /\ P T ==> !x. P x`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPEC `x:bool` BOOL_CASES_AX) THEN ASM_REWRITE_TAC[]);; let bool_RECURSION = prove (`!a b:A. ?f. f F = a /\ f T = b`, REPEAT GEN_TAC THEN EXISTS_TAC `\x. if x then b:A else a` THEN REWRITE_TAC[]);; let inductive_type_store = ref ["bool",(2,bool_INDUCT,bool_RECURSION)];; hol-light/database.ml000066400000000000000000002173351303454263000150560ustar00rootroot00000000000000needs "help.ml";; theorems := [ "ABSORPTION",ABSORPTION; "ABS_SIMP",ABS_SIMP; "ADD",ADD; "ADD1",ADD1; "ADD_0",ADD_0; "ADD_AC",ADD_AC; "ADD_ASSOC",ADD_ASSOC; "ADD_CLAUSES",ADD_CLAUSES; "ADD_EQ_0",ADD_EQ_0; "ADD_SUB",ADD_SUB; "ADD_SUB2",ADD_SUB2; "ADD_SUBR",ADD_SUBR; "ADD_SUBR2",ADD_SUBR2; "ADD_SUC",ADD_SUC; "ADD_SYM",ADD_SYM; "ADMISSIBLE_BASE",ADMISSIBLE_BASE; "ADMISSIBLE_COMB",ADMISSIBLE_COMB; "ADMISSIBLE_COND",ADMISSIBLE_COND; "ADMISSIBLE_CONST",ADMISSIBLE_CONST; "ADMISSIBLE_GUARDED_PATTERN",ADMISSIBLE_GUARDED_PATTERN; "ADMISSIBLE_IMP_SUPERADMISSIBLE",ADMISSIBLE_IMP_SUPERADMISSIBLE; "ADMISSIBLE_LAMBDA",ADMISSIBLE_LAMBDA; "ADMISSIBLE_MAP",ADMISSIBLE_MAP; "ADMISSIBLE_MATCH",ADMISSIBLE_MATCH; "ADMISSIBLE_MATCH_SEQPATTERN",ADMISSIBLE_MATCH_SEQPATTERN; "ADMISSIBLE_NEST",ADMISSIBLE_NEST; "ADMISSIBLE_NSUM",ADMISSIBLE_NSUM; "ADMISSIBLE_RAND",ADMISSIBLE_RAND; "ADMISSIBLE_SEQPATTERN",ADMISSIBLE_SEQPATTERN; "ADMISSIBLE_SUM",ADMISSIBLE_SUM; "ADMISSIBLE_UNGUARDED_PATTERN",ADMISSIBLE_UNGUARDED_PATTERN; "ALL",ALL; "ALL2",ALL2; "ALL2_ALL",ALL2_ALL; "ALL2_AND_RIGHT",ALL2_AND_RIGHT; "ALL2_DEF",ALL2_DEF; "ALL2_MAP",ALL2_MAP; "ALL2_MAP2",ALL2_MAP2; "ALL_APPEND",ALL_APPEND; "ALL_EL",ALL_EL; "ALL_FILTER",ALL_FILTER; "ALL_IMP",ALL_IMP; "ALL_MAP",ALL_MAP; "ALL_MEM",ALL_MEM; "ALL_MP",ALL_MP; "ALL_T",ALL_T; "AND_ALL",AND_ALL; "AND_ALL2",AND_ALL2; "AND_CLAUSES",AND_CLAUSES; "AND_DEF",AND_DEF; "AND_FORALL_THM",AND_FORALL_THM; "APPEND",APPEND; "APPEND_ASSOC",APPEND_ASSOC; "APPEND_BUTLAST_LAST",APPEND_BUTLAST_LAST; "APPEND_EQ_NIL",APPEND_EQ_NIL; "APPEND_LCANCEL",APPEND_LCANCEL; "APPEND_NIL",APPEND_NIL; "APPEND_RCANCEL",APPEND_RCANCEL; "APPEND_SING",APPEND_SING; "ARITH",ARITH; "ARITH_ADD",ARITH_ADD; "ARITH_EQ",ARITH_EQ; "ARITH_EVEN",ARITH_EVEN; "ARITH_EXP",ARITH_EXP; "ARITH_GE",ARITH_GE; "ARITH_GT",ARITH_GT; "ARITH_LE",ARITH_LE; "ARITH_LT",ARITH_LT; "ARITH_MULT",ARITH_MULT; "ARITH_ODD",ARITH_ODD; "ARITH_PRE",ARITH_PRE; "ARITH_SUB",ARITH_SUB; "ARITH_SUC",ARITH_SUC; "ARITH_ZERO",ARITH_ZERO; "ASSOC",ASSOC; "BETA_THM",BETA_THM; "BIJ",BIJ; "BIJECTIONS_CARD_EQ",BIJECTIONS_CARD_EQ; "BIJECTIONS_HAS_SIZE",BIJECTIONS_HAS_SIZE; "BIJECTIONS_HAS_SIZE_EQ",BIJECTIONS_HAS_SIZE_EQ; "BIJECTIVE_LEFT_RIGHT_INVERSE",BIJECTIVE_LEFT_RIGHT_INVERSE; "BIJECTIVE_ON_LEFT_RIGHT_INVERSE",BIJECTIVE_ON_LEFT_RIGHT_INVERSE; "BIT0",BIT0; "BIT0_DEF",BIT0_DEF; "BIT0_THM",BIT0_THM; "BIT1",BIT1; "BIT1_DEF",BIT1_DEF; "BIT1_THM",BIT1_THM; "BOOL_CASES_AX",BOOL_CASES_AX; "BOTTOM",BOTTOM; "BOUNDS_DIVIDED",BOUNDS_DIVIDED; "BOUNDS_IGNORE",BOUNDS_IGNORE; "BOUNDS_LINEAR",BOUNDS_LINEAR; "BOUNDS_LINEAR_0",BOUNDS_LINEAR_0; "BOUNDS_NOTZERO",BOUNDS_NOTZERO; "BUTLAST",BUTLAST; "BUTLAST_APPEND",BUTLAST_APPEND; "CARD",CARD; "CARD_BOOL",CARD_BOOL; "CARD_CART_UNIV",CARD_CART_UNIV; "CARD_CLAUSES",CARD_CLAUSES; "CARD_CROSS",CARD_CROSS; "CARD_DELETE",CARD_DELETE; "CARD_DIFF",CARD_DIFF; "CARD_EQ_0",CARD_EQ_0; "CARD_EQ_BIJECTION",CARD_EQ_BIJECTION; "CARD_EQ_BIJECTIONS",CARD_EQ_BIJECTIONS; "CARD_EQ_NSUM",CARD_EQ_NSUM; "CARD_EQ_SUM",CARD_EQ_SUM; "CARD_FINITE_IMAGE",CARD_FINITE_IMAGE; "CARD_FUNSPACE",CARD_FUNSPACE; "CARD_FUNSPACE_UNIV",CARD_FUNSPACE_UNIV; "CARD_IMAGE_EQ_INJ",CARD_IMAGE_EQ_INJ; "CARD_IMAGE_INJ",CARD_IMAGE_INJ; "CARD_IMAGE_INJ_EQ",CARD_IMAGE_INJ_EQ; "CARD_IMAGE_LE",CARD_IMAGE_LE; "CARD_LE_INJ",CARD_LE_INJ; "CARD_LE_UNIONS_CHAIN",CARD_LE_UNIONS_CHAIN; "CARD_NUMSEG",CARD_NUMSEG; "CARD_NUMSEG_1",CARD_NUMSEG_1; "CARD_NUMSEG_LE",CARD_NUMSEG_LE; "CARD_NUMSEG_LEMMA",CARD_NUMSEG_LEMMA; "CARD_NUMSEG_LT",CARD_NUMSEG_LT; "CARD_POWERSET",CARD_POWERSET; "CARD_PRODUCT",CARD_PRODUCT; "CARD_PSUBSET",CARD_PSUBSET; "CARD_SET_OF_LIST_LE",CARD_SET_OF_LIST_LE; "CARD_SING",CARD_SING; "CARD_SUBSET",CARD_SUBSET; "CARD_SUBSET_EQ",CARD_SUBSET_EQ; "CARD_SUBSET_IMAGE",CARD_SUBSET_IMAGE; "CARD_SUBSET_LE",CARD_SUBSET_LE; "CARD_UNION",CARD_UNION; "CARD_UNIONS",CARD_UNIONS; "CARD_UNIONS_LE",CARD_UNIONS_LE; "CARD_UNION_EQ",CARD_UNION_EQ; "CARD_UNION_GEN",CARD_UNION_GEN; "CARD_UNION_LE",CARD_UNION_LE; "CARD_UNION_OVERLAP",CARD_UNION_OVERLAP; "CARD_UNION_OVERLAP_EQ",CARD_UNION_OVERLAP_EQ; "CART_EQ",CART_EQ; "CART_EQ_FULL",CART_EQ_FULL; "CASEWISE",CASEWISE; "CASEWISE_CASES",CASEWISE_CASES; "CASEWISE_DEF",CASEWISE_DEF; "CASEWISE_WORKS",CASEWISE_WORKS; "CHOICE",CHOICE; "CHOICE_DEF",CHOICE_DEF; "CHOICE_PAIRED_THM",CHOICE_PAIRED_THM; "CHOICE_UNPAIR_THM",CHOICE_UNPAIR_THM; "CHOOSE_SUBSET",CHOOSE_SUBSET; "CHOOSE_SUBSET_BETWEEN",CHOOSE_SUBSET_BETWEEN; "CHOOSE_SUBSET_EQ",CHOOSE_SUBSET_EQ; "CHOOSE_SUBSET_STRONG",CHOOSE_SUBSET_STRONG; "COMMA_DEF",COMMA_DEF; "COMPL_COMPL",COMPL_COMPL; "COMPONENT",COMPONENT; "COND_ABS",COND_ABS; "COND_CLAUSES",COND_CLAUSES; "COND_DEF",COND_DEF; "COND_ELIM_THM",COND_ELIM_THM; "COND_EXPAND",COND_EXPAND; "COND_ID",COND_ID; "COND_RAND",COND_RAND; "COND_RATOR",COND_RATOR; "COND_SWAP",COND_SWAP; "CONJ_ACI",CONJ_ACI; "CONJ_ASSOC",CONJ_ASSOC; "CONJ_SYM",CONJ_SYM; "CONSTR",CONSTR; "CONSTR_BOT",CONSTR_BOT; "CONSTR_IND",CONSTR_IND; "CONSTR_INJ",CONSTR_INJ; "CONSTR_REC",CONSTR_REC; "CONS_11",CONS_11; "CONS_HD_TL",CONS_HD_TL; "CONTRAPOS_THM",CONTRAPOS_THM; "COUNTABLE",COUNTABLE; "CROSS",CROSS; "CROSS_DIFF",CROSS_DIFF; "CROSS_EMPTY",CROSS_EMPTY; "CROSS_EQ",CROSS_EQ; "CROSS_EQ_EMPTY",CROSS_EQ_EMPTY; "CROSS_INTER",CROSS_INTER; "CROSS_INTERS",CROSS_INTERS; "CROSS_INTERS_INTERS",CROSS_INTERS_INTERS; "CROSS_MONO",CROSS_MONO; "CROSS_UNION",CROSS_UNION; "CROSS_UNIONS",CROSS_UNIONS; "CROSS_UNIONS_UNIONS",CROSS_UNIONS_UNIONS; "CROSS_UNIV",CROSS_UNIV; "CURRY_DEF",CURRY_DEF; "DECIMAL",DECIMAL; "DECOMPOSITION",DECOMPOSITION; "DELETE",DELETE; "DELETE_COMM",DELETE_COMM; "DELETE_DELETE",DELETE_DELETE; "DELETE_INSERT",DELETE_INSERT; "DELETE_INTER",DELETE_INTER; "DELETE_NON_ELEMENT",DELETE_NON_ELEMENT; "DELETE_SUBSET",DELETE_SUBSET; "DEPENDENT_CHOICE",DEPENDENT_CHOICE; "DEPENDENT_CHOICE_FIXED",DEPENDENT_CHOICE_FIXED; "DEST_REC_INJ",DEST_REC_INJ; "DE_MORGAN_THM",DE_MORGAN_THM; "DIFF",DIFF; "DIFF_DIFF",DIFF_DIFF; "DIFF_EMPTY",DIFF_EMPTY; "DIFF_EQ_EMPTY",DIFF_EQ_EMPTY; "DIFF_INSERT",DIFF_INSERT; "DIFF_INTERS",DIFF_INTERS; "DIFF_UNIONS",DIFF_UNIONS; "DIFF_UNIONS_NONEMPTY",DIFF_UNIONS_NONEMPTY; "DIFF_UNIONS_PAIRWISE_DISJOINT",DIFF_UNIONS_PAIRWISE_DISJOINT; "DIFF_UNIV",DIFF_UNIV; "DIMINDEX_1",DIMINDEX_1; "DIMINDEX_2",DIMINDEX_2; "DIMINDEX_3",DIMINDEX_3; "DIMINDEX_4",DIMINDEX_4; "DIMINDEX_FINITE_DIFF",DIMINDEX_FINITE_DIFF; "DIMINDEX_FINITE_IMAGE",DIMINDEX_FINITE_IMAGE; "DIMINDEX_FINITE_PROD",DIMINDEX_FINITE_PROD; "DIMINDEX_FINITE_SUM",DIMINDEX_FINITE_SUM; "DIMINDEX_GE_1",DIMINDEX_GE_1; "DIMINDEX_HAS_SIZE_FINITE_DIFF",DIMINDEX_HAS_SIZE_FINITE_DIFF; "DIMINDEX_HAS_SIZE_FINITE_PROD",DIMINDEX_HAS_SIZE_FINITE_PROD; "DIMINDEX_HAS_SIZE_FINITE_SUM",DIMINDEX_HAS_SIZE_FINITE_SUM; "DIMINDEX_NONZERO",DIMINDEX_NONZERO; "DIMINDEX_UNIQUE",DIMINDEX_UNIQUE; "DIMINDEX_UNIV",DIMINDEX_UNIV; "DISJOINT",DISJOINT; "DISJOINT_DELETE_SYM",DISJOINT_DELETE_SYM; "DISJOINT_EMPTY",DISJOINT_EMPTY; "DISJOINT_EMPTY_REFL",DISJOINT_EMPTY_REFL; "DISJOINT_INSERT",DISJOINT_INSERT; "DISJOINT_NUMSEG",DISJOINT_NUMSEG; "DISJOINT_SYM",DISJOINT_SYM; "DISJOINT_UNION",DISJOINT_UNION; "DISJ_ACI",DISJ_ACI; "DISJ_ASSOC",DISJ_ASSOC; "DISJ_SYM",DISJ_SYM; "DIST_ADD2",DIST_ADD2; "DIST_ADD2_REV",DIST_ADD2_REV; "DIST_ADDBOUND",DIST_ADDBOUND; "DIST_ELIM_THM",DIST_ELIM_THM; "DIST_EQ_0",DIST_EQ_0; "DIST_LADD",DIST_LADD; "DIST_LADD_0",DIST_LADD_0; "DIST_LE_CASES",DIST_LE_CASES; "DIST_LMUL",DIST_LMUL; "DIST_LZERO",DIST_LZERO; "DIST_RADD",DIST_RADD; "DIST_RADD_0",DIST_RADD_0; "DIST_REFL",DIST_REFL; "DIST_RMUL",DIST_RMUL; "DIST_RZERO",DIST_RZERO; "DIST_SYM",DIST_SYM; "DIST_TRIANGLE",DIST_TRIANGLE; "DIST_TRIANGLES_LE",DIST_TRIANGLES_LE; "DIST_TRIANGLE_LE",DIST_TRIANGLE_LE; "DIVIDES_LE",DIVIDES_LE; "DIVISION",DIVISION; "DIVISION_0",DIVISION_0; "DIVISION_SIMP",DIVISION_SIMP; "DIVMOD_ELIM_THM",DIVMOD_ELIM_THM; "DIVMOD_ELIM_THM'",DIVMOD_ELIM_THM'; "DIVMOD_EXIST",DIVMOD_EXIST; "DIVMOD_EXIST_0",DIVMOD_EXIST_0; "DIVMOD_UNIQ",DIVMOD_UNIQ; "DIVMOD_UNIQ_LEMMA",DIVMOD_UNIQ_LEMMA; "DIV_0",DIV_0; "DIV_1",DIV_1; "DIV_ADD_MOD",DIV_ADD_MOD; "DIV_DIV",DIV_DIV; "DIV_EQ_0",DIV_EQ_0; "DIV_EQ_EXCLUSION",DIV_EQ_EXCLUSION; "DIV_LE",DIV_LE; "DIV_LE_EXCLUSION",DIV_LE_EXCLUSION; "DIV_LT",DIV_LT; "DIV_MOD",DIV_MOD; "DIV_MONO",DIV_MONO; "DIV_MONO2",DIV_MONO2; "DIV_MONO_LT",DIV_MONO_LT; "DIV_MULT",DIV_MULT; "DIV_MULT2",DIV_MULT2; "DIV_MULT_ADD",DIV_MULT_ADD; "DIV_MUL_LE",DIV_MUL_LE; "DIV_REFL",DIV_REFL; "DIV_UNIQ",DIV_UNIQ; "EL",EL; "ELEMENT_LE_SUP",ELEMENT_LE_SUP; "EL_APPEND",EL_APPEND; "EL_CONS",EL_CONS; "EL_LIST_OF_SEQ",EL_LIST_OF_SEQ; "EL_MAP",EL_MAP; "EL_TL",EL_TL; "EMPTY",EMPTY; "EMPTY_DELETE",EMPTY_DELETE; "EMPTY_DIFF",EMPTY_DIFF; "EMPTY_GSPEC",EMPTY_GSPEC; "EMPTY_NOT_UNIV",EMPTY_NOT_UNIV; "EMPTY_SUBSET",EMPTY_SUBSET; "EMPTY_UNION",EMPTY_UNION; "EMPTY_UNIONS",EMPTY_UNIONS; "EQ_ADD_LCANCEL",EQ_ADD_LCANCEL; "EQ_ADD_LCANCEL_0",EQ_ADD_LCANCEL_0; "EQ_ADD_RCANCEL",EQ_ADD_RCANCEL; "EQ_ADD_RCANCEL_0",EQ_ADD_RCANCEL_0; "EQ_CLAUSES",EQ_CLAUSES; "EQ_EXP",EQ_EXP; "EQ_EXT",EQ_EXT; "EQ_IMP",EQ_IMP; "EQ_IMP_LE",EQ_IMP_LE; "EQ_MULT_LCANCEL",EQ_MULT_LCANCEL; "EQ_MULT_RCANCEL",EQ_MULT_RCANCEL; "EQ_REFL",EQ_REFL; "EQ_SYM",EQ_SYM; "EQ_SYM_EQ",EQ_SYM_EQ; "EQ_TRANS",EQ_TRANS; "EQ_UNIV",EQ_UNIV; "ETA_AX",ETA_AX; "EVEN",EVEN; "EVEN_ADD",EVEN_ADD; "EVEN_AND_ODD",EVEN_AND_ODD; "EVEN_DOUBLE",EVEN_DOUBLE; "EVEN_EXISTS",EVEN_EXISTS; "EVEN_EXISTS_LEMMA",EVEN_EXISTS_LEMMA; "EVEN_EXP",EVEN_EXP; "EVEN_MOD",EVEN_MOD; "EVEN_MULT",EVEN_MULT; "EVEN_ODD_DECOMPOSITION",EVEN_ODD_DECOMPOSITION; "EVEN_OR_ODD",EVEN_OR_ODD; "EVEN_SUB",EVEN_SUB; "EX",EX; "EXCLUDED_MIDDLE",EXCLUDED_MIDDLE; "EXISTS_BOOL_THM",EXISTS_BOOL_THM; "EXISTS_CURRY",EXISTS_CURRY; "EXISTS_DEF",EXISTS_DEF; "EXISTS_EX",EXISTS_EX; "EXISTS_FINITE_SUBSET_IMAGE",EXISTS_FINITE_SUBSET_IMAGE; "EXISTS_FINITE_SUBSET_IMAGE_INJ",EXISTS_FINITE_SUBSET_IMAGE_INJ; "EXISTS_IN_CLAUSES",EXISTS_IN_CLAUSES; "EXISTS_IN_CROSS",EXISTS_IN_CROSS; "EXISTS_IN_GSPEC",EXISTS_IN_GSPEC; "EXISTS_IN_IMAGE",EXISTS_IN_IMAGE; "EXISTS_IN_INSERT",EXISTS_IN_INSERT; "EXISTS_IN_PCROSS",EXISTS_IN_PCROSS; "EXISTS_IN_UNION",EXISTS_IN_UNION; "EXISTS_IN_UNIONS",EXISTS_IN_UNIONS; "EXISTS_NOT_THM",EXISTS_NOT_THM; "EXISTS_ONE_REP",EXISTS_ONE_REP; "EXISTS_OR_THM",EXISTS_OR_THM; "EXISTS_PAIRED_THM",EXISTS_PAIRED_THM; "EXISTS_PAIR_THM",EXISTS_PAIR_THM; "EXISTS_PASTECART",EXISTS_PASTECART; "EXISTS_REFL",EXISTS_REFL; "EXISTS_SIMP",EXISTS_SIMP; "EXISTS_SUBSET_IMAGE",EXISTS_SUBSET_IMAGE; "EXISTS_SUBSET_IMAGE_INJ",EXISTS_SUBSET_IMAGE_INJ; "EXISTS_SUBSET_INSERT",EXISTS_SUBSET_INSERT; "EXISTS_SUBSET_UNION",EXISTS_SUBSET_UNION; "EXISTS_THM",EXISTS_THM; "EXISTS_TRIPLED_THM",EXISTS_TRIPLED_THM; "EXISTS_UNCURRY",EXISTS_UNCURRY; "EXISTS_UNIQUE",EXISTS_UNIQUE; "EXISTS_UNIQUE_ALT",EXISTS_UNIQUE_ALT; "EXISTS_UNIQUE_DEF",EXISTS_UNIQUE_DEF; "EXISTS_UNIQUE_REFL",EXISTS_UNIQUE_REFL; "EXISTS_UNIQUE_THM",EXISTS_UNIQUE_THM; "EXISTS_UNPAIR_THM",EXISTS_UNPAIR_THM; "EXP",EXP; "EXP_1",EXP_1; "EXP_2",EXP_2; "EXP_ADD",EXP_ADD; "EXP_EQ_0",EXP_EQ_0; "EXP_EQ_1",EXP_EQ_1; "EXP_LT_0",EXP_LT_0; "EXP_MONO_EQ",EXP_MONO_EQ; "EXP_MONO_LE",EXP_MONO_LE; "EXP_MONO_LE_IMP",EXP_MONO_LE_IMP; "EXP_MONO_LT",EXP_MONO_LT; "EXP_MONO_LT_IMP",EXP_MONO_LT_IMP; "EXP_MULT",EXP_MULT; "EXP_ONE",EXP_ONE; "EXP_ZERO",EXP_ZERO; "EXTENSION",EXTENSION; "EX_IMP",EX_IMP; "EX_MAP",EX_MAP; "EX_MEM",EX_MEM; "FACT",FACT; "FACT_LE",FACT_LE; "FACT_LT",FACT_LT; "FACT_MONO",FACT_MONO; "FACT_NZ",FACT_NZ; "FCONS",FCONS; "FCONS_UNDO",FCONS_UNDO; "FILTER",FILTER; "FILTER_APPEND",FILTER_APPEND; "FILTER_MAP",FILTER_MAP; "FINITE_BOOL",FINITE_BOOL; "FINITE_CART",FINITE_CART; "FINITE_CART_UNIV",FINITE_CART_UNIV; "FINITE_CASES",FINITE_CASES; "FINITE_CROSS",FINITE_CROSS; "FINITE_CROSS_EQ",FINITE_CROSS_EQ; "FINITE_DELETE",FINITE_DELETE; "FINITE_DELETE_IMP",FINITE_DELETE_IMP; "FINITE_DIFF",FINITE_DIFF; "FINITE_DIFF_IMAGE",FINITE_DIFF_IMAGE; "FINITE_EMPTY",FINITE_EMPTY; "FINITE_FINITE_IMAGE",FINITE_FINITE_IMAGE; "FINITE_FINITE_PREIMAGE",FINITE_FINITE_PREIMAGE; "FINITE_FINITE_PREIMAGE_GENERAL",FINITE_FINITE_PREIMAGE_GENERAL; "FINITE_FINITE_UNIONS",FINITE_FINITE_UNIONS; "FINITE_FUNSPACE",FINITE_FUNSPACE; "FINITE_FUNSPACE_UNIV",FINITE_FUNSPACE_UNIV; "FINITE_HAS_SIZE",FINITE_HAS_SIZE; "FINITE_IMAGE",FINITE_IMAGE; "FINITE_IMAGE_EXPAND",FINITE_IMAGE_EXPAND; "FINITE_IMAGE_IMAGE",FINITE_IMAGE_IMAGE; "FINITE_IMAGE_INJ",FINITE_IMAGE_INJ; "FINITE_IMAGE_INJ_EQ",FINITE_IMAGE_INJ_EQ; "FINITE_IMAGE_INJ_GENERAL",FINITE_IMAGE_INJ_GENERAL; "FINITE_INDEX_INJ",FINITE_INDEX_INJ; "FINITE_INDEX_INRANGE",FINITE_INDEX_INRANGE; "FINITE_INDEX_INRANGE_2",FINITE_INDEX_INRANGE_2; "FINITE_INDEX_NUMBERS",FINITE_INDEX_NUMBERS; "FINITE_INDEX_NUMSEG",FINITE_INDEX_NUMSEG; "FINITE_INDEX_WORKS",FINITE_INDEX_WORKS; "FINITE_INDUCT",FINITE_INDUCT; "FINITE_INDUCT_DELETE",FINITE_INDUCT_DELETE; "FINITE_INDUCT_STRONG",FINITE_INDUCT_STRONG; "FINITE_INSERT",FINITE_INSERT; "FINITE_INTER",FINITE_INTER; "FINITE_INTSEG",FINITE_INTSEG; "FINITE_NUMSEG",FINITE_NUMSEG; "FINITE_NUMSEG_LE",FINITE_NUMSEG_LE; "FINITE_NUMSEG_LT",FINITE_NUMSEG_LT; "FINITE_PCROSS",FINITE_PCROSS; "FINITE_PCROSS_EQ",FINITE_PCROSS_EQ; "FINITE_POWERSET",FINITE_POWERSET; "FINITE_PRODUCT",FINITE_PRODUCT; "FINITE_PRODUCT_DEPENDENT",FINITE_PRODUCT_DEPENDENT; "FINITE_PROD_IMAGE",FINITE_PROD_IMAGE; "FINITE_REAL_INTERVAL",FINITE_REAL_INTERVAL; "FINITE_RECURSION",FINITE_RECURSION; "FINITE_RECURSION_DELETE",FINITE_RECURSION_DELETE; "FINITE_RESTRICT",FINITE_RESTRICT; "FINITE_RULES",FINITE_RULES; "FINITE_SET_OF_LIST",FINITE_SET_OF_LIST; "FINITE_SING",FINITE_SING; "FINITE_SUBSET",FINITE_SUBSET; "FINITE_SUBSET_IMAGE",FINITE_SUBSET_IMAGE; "FINITE_SUBSET_IMAGE_IMP",FINITE_SUBSET_IMAGE_IMP; "FINITE_SUBSET_NUMSEG",FINITE_SUBSET_NUMSEG; "FINITE_SUBSET_UNIONS",FINITE_SUBSET_UNIONS; "FINITE_SUBSET_UNIONS_CHAIN",FINITE_SUBSET_UNIONS_CHAIN; "FINITE_SUM_IMAGE",FINITE_SUM_IMAGE; "FINITE_SUPPORT",FINITE_SUPPORT; "FINITE_SUPPORT_DELTA",FINITE_SUPPORT_DELTA; "FINITE_TRANSITIVITY_CHAIN",FINITE_TRANSITIVITY_CHAIN; "FINITE_UNION",FINITE_UNION; "FINITE_UNIONS",FINITE_UNIONS; "FINITE_UNION_IMP",FINITE_UNION_IMP; "FINITE_UNIV_PAIR",FINITE_UNIV_PAIR; "FINREC",FINREC; "FINREC_1_LEMMA",FINREC_1_LEMMA; "FINREC_EXISTS_LEMMA",FINREC_EXISTS_LEMMA; "FINREC_FUN",FINREC_FUN; "FINREC_FUN_LEMMA",FINREC_FUN_LEMMA; "FINREC_SUC_LEMMA",FINREC_SUC_LEMMA; "FINREC_UNIQUE_LEMMA",FINREC_UNIQUE_LEMMA; "FNIL",FNIL; "FORALL_ALL",FORALL_ALL; "FORALL_AND_THM",FORALL_AND_THM; "FORALL_BOOL_THM",FORALL_BOOL_THM; "FORALL_CURRY",FORALL_CURRY; "FORALL_DEF",FORALL_DEF; "FORALL_FINITE_INDEX",FORALL_FINITE_INDEX; "FORALL_FINITE_SUBSET_IMAGE",FORALL_FINITE_SUBSET_IMAGE; "FORALL_FINITE_SUBSET_IMAGE_INJ",FORALL_FINITE_SUBSET_IMAGE_INJ; "FORALL_IN_CLAUSES",FORALL_IN_CLAUSES; "FORALL_IN_CROSS",FORALL_IN_CROSS; "FORALL_IN_GSPEC",FORALL_IN_GSPEC; "FORALL_IN_IMAGE",FORALL_IN_IMAGE; "FORALL_IN_IMAGE_2",FORALL_IN_IMAGE_2; "FORALL_IN_INSERT",FORALL_IN_INSERT; "FORALL_IN_PCROSS",FORALL_IN_PCROSS; "FORALL_IN_UNION",FORALL_IN_UNION; "FORALL_IN_UNIONS",FORALL_IN_UNIONS; "FORALL_NOT_THM",FORALL_NOT_THM; "FORALL_PAIRED_THM",FORALL_PAIRED_THM; "FORALL_PAIR_THM",FORALL_PAIR_THM; "FORALL_PASTECART",FORALL_PASTECART; "FORALL_SIMP",FORALL_SIMP; "FORALL_SUBSET_IMAGE",FORALL_SUBSET_IMAGE; "FORALL_SUBSET_IMAGE_INJ",FORALL_SUBSET_IMAGE_INJ; "FORALL_SUBSET_INSERT",FORALL_SUBSET_INSERT; "FORALL_SUBSET_UNION",FORALL_SUBSET_UNION; "FORALL_TRIPLED_THM",FORALL_TRIPLED_THM; "FORALL_UNCURRY",FORALL_UNCURRY; "FORALL_UNPAIR_THM",FORALL_UNPAIR_THM; "FORALL_UNWIND_THM1",FORALL_UNWIND_THM1; "FORALL_UNWIND_THM2",FORALL_UNWIND_THM2; "FST",FST; "FSTCART_PASTECART",FSTCART_PASTECART; "FST_DEF",FST_DEF; "FUNCTION_FACTORS_LEFT",FUNCTION_FACTORS_LEFT; "FUNCTION_FACTORS_LEFT_GEN",FUNCTION_FACTORS_LEFT_GEN; "FUNCTION_FACTORS_RIGHT",FUNCTION_FACTORS_RIGHT; "FUNCTION_FACTORS_RIGHT_GEN",FUNCTION_FACTORS_RIGHT_GEN; "FUN_EQ_THM",FUN_EQ_THM; "FUN_IN_IMAGE",FUN_IN_IMAGE; "F_DEF",F_DEF; "GABS_DEF",GABS_DEF; "GE",GE; "GEQ_DEF",GEQ_DEF; "GE_C",GE_C; "GSPEC",GSPEC; "GT",GT; "HAS_SIZE",HAS_SIZE; "HAS_SIZE_0",HAS_SIZE_0; "HAS_SIZE_1",HAS_SIZE_1; "HAS_SIZE_2",HAS_SIZE_2; "HAS_SIZE_3",HAS_SIZE_3; "HAS_SIZE_4",HAS_SIZE_4; "HAS_SIZE_BOOL",HAS_SIZE_BOOL; "HAS_SIZE_CARD",HAS_SIZE_CARD; "HAS_SIZE_CART_UNIV",HAS_SIZE_CART_UNIV; "HAS_SIZE_CLAUSES",HAS_SIZE_CLAUSES; "HAS_SIZE_CROSS",HAS_SIZE_CROSS; "HAS_SIZE_DIFF",HAS_SIZE_DIFF; "HAS_SIZE_FINITE_IMAGE",HAS_SIZE_FINITE_IMAGE; "HAS_SIZE_FUNSPACE",HAS_SIZE_FUNSPACE; "HAS_SIZE_FUNSPACE_UNIV",HAS_SIZE_FUNSPACE_UNIV; "HAS_SIZE_IMAGE_INJ",HAS_SIZE_IMAGE_INJ; "HAS_SIZE_IMAGE_INJ_EQ",HAS_SIZE_IMAGE_INJ_EQ; "HAS_SIZE_INDEX",HAS_SIZE_INDEX; "HAS_SIZE_NUMSEG",HAS_SIZE_NUMSEG; "HAS_SIZE_NUMSEG_1",HAS_SIZE_NUMSEG_1; "HAS_SIZE_NUMSEG_LE",HAS_SIZE_NUMSEG_LE; "HAS_SIZE_NUMSEG_LT",HAS_SIZE_NUMSEG_LT; "HAS_SIZE_PCROSS",HAS_SIZE_PCROSS; "HAS_SIZE_POWERSET",HAS_SIZE_POWERSET; "HAS_SIZE_PRODUCT",HAS_SIZE_PRODUCT; "HAS_SIZE_PRODUCT_DEPENDENT",HAS_SIZE_PRODUCT_DEPENDENT; "HAS_SIZE_SET_OF_LIST",HAS_SIZE_SET_OF_LIST; "HAS_SIZE_SUC",HAS_SIZE_SUC; "HAS_SIZE_UNION",HAS_SIZE_UNION; "HAS_SIZE_UNIONS",HAS_SIZE_UNIONS; "HD",HD; "HD_APPEND",HD_APPEND; "HREAL_ADD_AC",HREAL_ADD_AC; "HREAL_ADD_ASSOC",HREAL_ADD_ASSOC; "HREAL_ADD_LCANCEL",HREAL_ADD_LCANCEL; "HREAL_ADD_LDISTRIB",HREAL_ADD_LDISTRIB; "HREAL_ADD_LID",HREAL_ADD_LID; "HREAL_ADD_RDISTRIB",HREAL_ADD_RDISTRIB; "HREAL_ADD_RID",HREAL_ADD_RID; "HREAL_ADD_SYM",HREAL_ADD_SYM; "HREAL_ARCH",HREAL_ARCH; "HREAL_COMPLETE",HREAL_COMPLETE; "HREAL_EQ_ADD_LCANCEL",HREAL_EQ_ADD_LCANCEL; "HREAL_EQ_ADD_RCANCEL",HREAL_EQ_ADD_RCANCEL; "HREAL_INV_0",HREAL_INV_0; "HREAL_LE_ADD",HREAL_LE_ADD; "HREAL_LE_ADD2",HREAL_LE_ADD2; "HREAL_LE_ADD_LCANCEL",HREAL_LE_ADD_LCANCEL; "HREAL_LE_ADD_RCANCEL",HREAL_LE_ADD_RCANCEL; "HREAL_LE_ANTISYM",HREAL_LE_ANTISYM; "HREAL_LE_EXISTS",HREAL_LE_EXISTS; "HREAL_LE_EXISTS_DEF",HREAL_LE_EXISTS_DEF; "HREAL_LE_MUL_RCANCEL_IMP",HREAL_LE_MUL_RCANCEL_IMP; "HREAL_LE_REFL",HREAL_LE_REFL; "HREAL_LE_TOTAL",HREAL_LE_TOTAL; "HREAL_LE_TRANS",HREAL_LE_TRANS; "HREAL_MUL_ASSOC",HREAL_MUL_ASSOC; "HREAL_MUL_LID",HREAL_MUL_LID; "HREAL_MUL_LINV",HREAL_MUL_LINV; "HREAL_MUL_LZERO",HREAL_MUL_LZERO; "HREAL_MUL_RZERO",HREAL_MUL_RZERO; "HREAL_MUL_SYM",HREAL_MUL_SYM; "HREAL_OF_NUM_ADD",HREAL_OF_NUM_ADD; "HREAL_OF_NUM_EQ",HREAL_OF_NUM_EQ; "HREAL_OF_NUM_LE",HREAL_OF_NUM_LE; "HREAL_OF_NUM_MUL",HREAL_OF_NUM_MUL; "IMAGE",IMAGE; "IMAGE_CLAUSES",IMAGE_CLAUSES; "IMAGE_CONST",IMAGE_CONST; "IMAGE_DELETE_INJ",IMAGE_DELETE_INJ; "IMAGE_DELETE_INJ_ALT",IMAGE_DELETE_INJ_ALT; "IMAGE_DIFF_INJ",IMAGE_DIFF_INJ; "IMAGE_DIFF_INJ_ALT",IMAGE_DIFF_INJ_ALT; "IMAGE_EQ_EMPTY",IMAGE_EQ_EMPTY; "IMAGE_FSTCART_PCROSS",IMAGE_FSTCART_PCROSS; "IMAGE_FST_CROSS",IMAGE_FST_CROSS; "IMAGE_I",IMAGE_I; "IMAGE_ID",IMAGE_ID; "IMAGE_IMP_INJECTIVE",IMAGE_IMP_INJECTIVE; "IMAGE_IMP_INJECTIVE_GEN",IMAGE_IMP_INJECTIVE_GEN; "IMAGE_INJECTIVE_IMAGE_OF_SUBSET",IMAGE_INJECTIVE_IMAGE_OF_SUBSET; "IMAGE_INTERS",IMAGE_INTERS; "IMAGE_INTERS_SATURATED",IMAGE_INTERS_SATURATED; "IMAGE_INTERS_SATURATED_GEN",IMAGE_INTERS_SATURATED_GEN; "IMAGE_INTERS_SUBSET",IMAGE_INTERS_SUBSET; "IMAGE_INTER_INJ",IMAGE_INTER_INJ; "IMAGE_INTER_SATURATED",IMAGE_INTER_SATURATED; "IMAGE_INTER_SATURATED_GEN",IMAGE_INTER_SATURATED_GEN; "IMAGE_INTER_SUBSET",IMAGE_INTER_SUBSET; "IMAGE_SNDCART_PCROSS",IMAGE_SNDCART_PCROSS; "IMAGE_SND_CROSS",IMAGE_SND_CROSS; "IMAGE_SUBSET",IMAGE_SUBSET; "IMAGE_UNION",IMAGE_UNION; "IMAGE_UNIONS",IMAGE_UNIONS; "IMAGE_o",IMAGE_o; "IMP_CLAUSES",IMP_CLAUSES; "IMP_CONJ",IMP_CONJ; "IMP_CONJ_ALT",IMP_CONJ_ALT; "IMP_DEF",IMP_DEF; "IMP_IMP",IMP_IMP; "IN",IN; "IND_SUC_0",IND_SUC_0; "IND_SUC_0_EXISTS",IND_SUC_0_EXISTS; "IND_SUC_INJ",IND_SUC_INJ; "IND_SUC_SPEC",IND_SUC_SPEC; "INF",INF; "INFINITE",INFINITE; "INFINITE_DIFF_FINITE",INFINITE_DIFF_FINITE; "INFINITE_ENUMERATE",INFINITE_ENUMERATE; "INFINITE_ENUMERATE_EQ",INFINITE_ENUMERATE_EQ; "INFINITE_IMAGE",INFINITE_IMAGE; "INFINITE_IMAGE_INJ",INFINITE_IMAGE_INJ; "INFINITE_NONEMPTY",INFINITE_NONEMPTY; "INFINITE_SUPERSET",INFINITE_SUPERSET; "INFINITE_UNIV_PAIR",INFINITE_UNIV_PAIR; "INFINITY_AX",INFINITY_AX; "INF_EQ",INF_EQ; "INF_FINITE",INF_FINITE; "INF_FINITE_LEMMA",INF_FINITE_LEMMA; "INF_INSERT_FINITE",INF_INSERT_FINITE; "INF_INSERT_INSERT",INF_INSERT_INSERT; "INF_LE_ELEMENT",INF_LE_ELEMENT; "INF_SING",INF_SING; "INF_UNION",INF_UNION; "INF_UNIQUE",INF_UNIQUE; "INF_UNIQUE_FINITE",INF_UNIQUE_FINITE; "INJ",INJ; "INJA",INJA; "INJA_INJ",INJA_INJ; "INJECTIVE_ALT",INJECTIVE_ALT; "INJECTIVE_IMAGE",INJECTIVE_IMAGE; "INJECTIVE_LEFT_INVERSE",INJECTIVE_LEFT_INVERSE; "INJECTIVE_MAP",INJECTIVE_MAP; "INJECTIVE_ON_ALT",INJECTIVE_ON_ALT; "INJECTIVE_ON_IMAGE",INJECTIVE_ON_IMAGE; "INJECTIVE_ON_LEFT_INVERSE",INJECTIVE_ON_LEFT_INVERSE; "INJECTIVE_ON_PREIMAGE",INJECTIVE_ON_PREIMAGE; "INJECTIVE_PREIMAGE",INJECTIVE_PREIMAGE; "INJF",INJF; "INJF_INJ",INJF_INJ; "INJN",INJN; "INJN_INJ",INJN_INJ; "INJP",INJP; "INJP_INJ",INJP_INJ; "INJ_INVERSE2",INJ_INVERSE2; "INSERT",INSERT; "INSERT_AC",INSERT_AC; "INSERT_COMM",INSERT_COMM; "INSERT_DEF",INSERT_DEF; "INSERT_DELETE",INSERT_DELETE; "INSERT_DIFF",INSERT_DIFF; "INSERT_INSERT",INSERT_INSERT; "INSERT_INTER",INSERT_INTER; "INSERT_SUBSET",INSERT_SUBSET; "INSERT_UNION",INSERT_UNION; "INSERT_UNION_EQ",INSERT_UNION_EQ; "INSERT_UNIV",INSERT_UNIV; "INTEGER_REAL_OF_INT",INTEGER_REAL_OF_INT; "INTER",INTER; "INTERS",INTERS; "INTERSECTION_OF",INTERSECTION_OF; "INTERSECTION_OF_INC",INTERSECTION_OF_INC; "INTERSECTION_OF_MONO",INTERSECTION_OF_MONO; "INTERS_0",INTERS_0; "INTERS_1",INTERS_1; "INTERS_2",INTERS_2; "INTERS_EQ_UNIV",INTERS_EQ_UNIV; "INTERS_GSPEC",INTERS_GSPEC; "INTERS_IMAGE",INTERS_IMAGE; "INTERS_INSERT",INTERS_INSERT; "INTERS_IN_CHAIN",INTERS_IN_CHAIN; "INTERS_OVER_UNIONS",INTERS_OVER_UNIONS; "INTERS_SUBSET",INTERS_SUBSET; "INTERS_SUBSET_STRONG",INTERS_SUBSET_STRONG; "INTERS_UNION",INTERS_UNION; "INTERS_UNIONS",INTERS_UNIONS; "INTER_ACI",INTER_ACI; "INTER_ASSOC",INTER_ASSOC; "INTER_COMM",INTER_COMM; "INTER_CROSS",INTER_CROSS; "INTER_EMPTY",INTER_EMPTY; "INTER_IDEMPOT",INTER_IDEMPOT; "INTER_INTERS",INTER_INTERS; "INTER_NUMSEG",INTER_NUMSEG; "INTER_OVER_UNION",INTER_OVER_UNION; "INTER_PCROSS",INTER_PCROSS; "INTER_SUBSET",INTER_SUBSET; "INTER_UNIONS",INTER_UNIONS; "INTER_UNIONS_PAIRWISE_DISJOINT",INTER_UNIONS_PAIRWISE_DISJOINT; "INTER_UNIV",INTER_UNIV; "INT_ABS",INT_ABS; "INT_ABS_0",INT_ABS_0; "INT_ABS_1",INT_ABS_1; "INT_ABS_ABS",INT_ABS_ABS; "INT_ABS_BETWEEN",INT_ABS_BETWEEN; "INT_ABS_BETWEEN1",INT_ABS_BETWEEN1; "INT_ABS_BETWEEN2",INT_ABS_BETWEEN2; "INT_ABS_BOUND",INT_ABS_BOUND; "INT_ABS_CASES",INT_ABS_CASES; "INT_ABS_CIRCLE",INT_ABS_CIRCLE; "INT_ABS_LE",INT_ABS_LE; "INT_ABS_MUL",INT_ABS_MUL; "INT_ABS_MUL_1",INT_ABS_MUL_1; "INT_ABS_NEG",INT_ABS_NEG; "INT_ABS_NUM",INT_ABS_NUM; "INT_ABS_NZ",INT_ABS_NZ; "INT_ABS_POS",INT_ABS_POS; "INT_ABS_POW",INT_ABS_POW; "INT_ABS_REFL",INT_ABS_REFL; "INT_ABS_SGN",INT_ABS_SGN; "INT_ABS_SIGN",INT_ABS_SIGN; "INT_ABS_SIGN2",INT_ABS_SIGN2; "INT_ABS_STILLNZ",INT_ABS_STILLNZ; "INT_ABS_SUB",INT_ABS_SUB; "INT_ABS_SUB_ABS",INT_ABS_SUB_ABS; "INT_ABS_TRIANGLE",INT_ABS_TRIANGLE; "INT_ABS_ZERO",INT_ABS_ZERO; "INT_ADD2_SUB2",INT_ADD2_SUB2; "INT_ADD_AC",INT_ADD_AC; "INT_ADD_ASSOC",INT_ADD_ASSOC; "INT_ADD_LDISTRIB",INT_ADD_LDISTRIB; "INT_ADD_LID",INT_ADD_LID; "INT_ADD_LINV",INT_ADD_LINV; "INT_ADD_RDISTRIB",INT_ADD_RDISTRIB; "INT_ADD_RID",INT_ADD_RID; "INT_ADD_RINV",INT_ADD_RINV; "INT_ADD_SUB",INT_ADD_SUB; "INT_ADD_SUB2",INT_ADD_SUB2; "INT_ADD_SYM",INT_ADD_SYM; "INT_ARCH",INT_ARCH; "INT_BOUNDS_LE",INT_BOUNDS_LE; "INT_BOUNDS_LT",INT_BOUNDS_LT; "INT_DIFFSQ",INT_DIFFSQ; "INT_DIVISION",INT_DIVISION; "INT_DIVISION_0",INT_DIVISION_0; "INT_DIVMOD_EXIST_0",INT_DIVMOD_EXIST_0; "INT_DIVMOD_UNIQ",INT_DIVMOD_UNIQ; "INT_ENTIRE",INT_ENTIRE; "INT_EQ_ADD_LCANCEL",INT_EQ_ADD_LCANCEL; "INT_EQ_ADD_LCANCEL_0",INT_EQ_ADD_LCANCEL_0; "INT_EQ_ADD_RCANCEL",INT_EQ_ADD_RCANCEL; "INT_EQ_ADD_RCANCEL_0",INT_EQ_ADD_RCANCEL_0; "INT_EQ_IMP_LE",INT_EQ_IMP_LE; "INT_EQ_MUL_LCANCEL",INT_EQ_MUL_LCANCEL; "INT_EQ_MUL_RCANCEL",INT_EQ_MUL_RCANCEL; "INT_EQ_NEG2",INT_EQ_NEG2; "INT_EQ_SGN_ABS",INT_EQ_SGN_ABS; "INT_EQ_SQUARE_ABS",INT_EQ_SQUARE_ABS; "INT_EQ_SUB_LADD",INT_EQ_SUB_LADD; "INT_EQ_SUB_RADD",INT_EQ_SUB_RADD; "INT_EXISTS_ABS",INT_EXISTS_ABS; "INT_EXISTS_POS",INT_EXISTS_POS; "INT_FORALL_ABS",INT_FORALL_ABS; "INT_FORALL_POS",INT_FORALL_POS; "INT_GCD_EXISTS",INT_GCD_EXISTS; "INT_GCD_EXISTS_POS",INT_GCD_EXISTS_POS; "INT_GE",INT_GE; "INT_GT",INT_GT; "INT_GT_DISCRETE",INT_GT_DISCRETE; "INT_IMAGE",INT_IMAGE; "INT_LET_ADD",INT_LET_ADD; "INT_LET_ADD2",INT_LET_ADD2; "INT_LET_ANTISYM",INT_LET_ANTISYM; "INT_LET_TOTAL",INT_LET_TOTAL; "INT_LET_TRANS",INT_LET_TRANS; "INT_LE_01",INT_LE_01; "INT_LE_ADD",INT_LE_ADD; "INT_LE_ADD2",INT_LE_ADD2; "INT_LE_ADDL",INT_LE_ADDL; "INT_LE_ADDR",INT_LE_ADDR; "INT_LE_ANTISYM",INT_LE_ANTISYM; "INT_LE_DISCRETE",INT_LE_DISCRETE; "INT_LE_DOUBLE",INT_LE_DOUBLE; "INT_LE_LADD",INT_LE_LADD; "INT_LE_LADD_IMP",INT_LE_LADD_IMP; "INT_LE_LMUL",INT_LE_LMUL; "INT_LE_LNEG",INT_LE_LNEG; "INT_LE_LT",INT_LE_LT; "INT_LE_MAX",INT_LE_MAX; "INT_LE_MIN",INT_LE_MIN; "INT_LE_MUL",INT_LE_MUL; "INT_LE_MUL_EQ",INT_LE_MUL_EQ; "INT_LE_NEG",INT_LE_NEG; "INT_LE_NEG2",INT_LE_NEG2; "INT_LE_NEGL",INT_LE_NEGL; "INT_LE_NEGR",INT_LE_NEGR; "INT_LE_NEGTOTAL",INT_LE_NEGTOTAL; "INT_LE_POW2",INT_LE_POW2; "INT_LE_RADD",INT_LE_RADD; "INT_LE_REFL",INT_LE_REFL; "INT_LE_RMUL",INT_LE_RMUL; "INT_LE_RNEG",INT_LE_RNEG; "INT_LE_SQUARE",INT_LE_SQUARE; "INT_LE_SQUARE_ABS",INT_LE_SQUARE_ABS; "INT_LE_SUB_LADD",INT_LE_SUB_LADD; "INT_LE_SUB_RADD",INT_LE_SUB_RADD; "INT_LE_TOTAL",INT_LE_TOTAL; "INT_LE_TRANS",INT_LE_TRANS; "INT_LE_TRANS_LE",INT_LE_TRANS_LE; "INT_LE_TRANS_LT",INT_LE_TRANS_LT; "INT_LNEG_UNIQ",INT_LNEG_UNIQ; "INT_LT",INT_LT; "INT_LTE_ADD",INT_LTE_ADD; "INT_LTE_ADD2",INT_LTE_ADD2; "INT_LTE_ANTISYM",INT_LTE_ANTISYM; "INT_LTE_TOTAL",INT_LTE_TOTAL; "INT_LTE_TRANS",INT_LTE_TRANS; "INT_LT_01",INT_LT_01; "INT_LT_ADD",INT_LT_ADD; "INT_LT_ADD1",INT_LT_ADD1; "INT_LT_ADD2",INT_LT_ADD2; "INT_LT_ADDL",INT_LT_ADDL; "INT_LT_ADDNEG",INT_LT_ADDNEG; "INT_LT_ADDNEG2",INT_LT_ADDNEG2; "INT_LT_ADDR",INT_LT_ADDR; "INT_LT_ADD_SUB",INT_LT_ADD_SUB; "INT_LT_ANTISYM",INT_LT_ANTISYM; "INT_LT_DISCRETE",INT_LT_DISCRETE; "INT_LT_GT",INT_LT_GT; "INT_LT_IMP_LE",INT_LT_IMP_LE; "INT_LT_IMP_NE",INT_LT_IMP_NE; "INT_LT_LADD",INT_LT_LADD; "INT_LT_LE",INT_LT_LE; "INT_LT_LMUL_EQ",INT_LT_LMUL_EQ; "INT_LT_MAX",INT_LT_MAX; "INT_LT_MIN",INT_LT_MIN; "INT_LT_MUL",INT_LT_MUL; "INT_LT_MUL_EQ",INT_LT_MUL_EQ; "INT_LT_NEG",INT_LT_NEG; "INT_LT_NEG2",INT_LT_NEG2; "INT_LT_NEGTOTAL",INT_LT_NEGTOTAL; "INT_LT_POW2",INT_LT_POW2; "INT_LT_RADD",INT_LT_RADD; "INT_LT_REFL",INT_LT_REFL; "INT_LT_RMUL_EQ",INT_LT_RMUL_EQ; "INT_LT_SQUARE_ABS",INT_LT_SQUARE_ABS; "INT_LT_SUB_LADD",INT_LT_SUB_LADD; "INT_LT_SUB_RADD",INT_LT_SUB_RADD; "INT_LT_TOTAL",INT_LT_TOTAL; "INT_LT_TRANS",INT_LT_TRANS; "INT_MAX",INT_MAX; "INT_MAX_ACI",INT_MAX_ACI; "INT_MAX_ASSOC",INT_MAX_ASSOC; "INT_MAX_LE",INT_MAX_LE; "INT_MAX_LT",INT_MAX_LT; "INT_MAX_MAX",INT_MAX_MAX; "INT_MAX_MIN",INT_MAX_MIN; "INT_MAX_SYM",INT_MAX_SYM; "INT_MIN",INT_MIN; "INT_MIN_ACI",INT_MIN_ACI; "INT_MIN_ASSOC",INT_MIN_ASSOC; "INT_MIN_LE",INT_MIN_LE; "INT_MIN_LT",INT_MIN_LT; "INT_MIN_MAX",INT_MIN_MAX; "INT_MIN_MIN",INT_MIN_MIN; "INT_MIN_SYM",INT_MIN_SYM; "INT_MUL_AC",INT_MUL_AC; "INT_MUL_ASSOC",INT_MUL_ASSOC; "INT_MUL_LID",INT_MUL_LID; "INT_MUL_LNEG",INT_MUL_LNEG; "INT_MUL_LZERO",INT_MUL_LZERO; "INT_MUL_POS_LE",INT_MUL_POS_LE; "INT_MUL_POS_LT",INT_MUL_POS_LT; "INT_MUL_RID",INT_MUL_RID; "INT_MUL_RNEG",INT_MUL_RNEG; "INT_MUL_RZERO",INT_MUL_RZERO; "INT_MUL_SYM",INT_MUL_SYM; "INT_NEGNEG",INT_NEGNEG; "INT_NEG_0",INT_NEG_0; "INT_NEG_ADD",INT_NEG_ADD; "INT_NEG_EQ",INT_NEG_EQ; "INT_NEG_EQ_0",INT_NEG_EQ_0; "INT_NEG_GE0",INT_NEG_GE0; "INT_NEG_GT0",INT_NEG_GT0; "INT_NEG_LE0",INT_NEG_LE0; "INT_NEG_LMUL",INT_NEG_LMUL; "INT_NEG_LT0",INT_NEG_LT0; "INT_NEG_MINUS1",INT_NEG_MINUS1; "INT_NEG_MUL2",INT_NEG_MUL2; "INT_NEG_NEG",INT_NEG_NEG; "INT_NEG_RMUL",INT_NEG_RMUL; "INT_NEG_SUB",INT_NEG_SUB; "INT_NOT_EQ",INT_NOT_EQ; "INT_NOT_LE",INT_NOT_LE; "INT_NOT_LT",INT_NOT_LT; "INT_OF_NUM_ADD",INT_OF_NUM_ADD; "INT_OF_NUM_EQ",INT_OF_NUM_EQ; "INT_OF_NUM_EXISTS",INT_OF_NUM_EXISTS; "INT_OF_NUM_GE",INT_OF_NUM_GE; "INT_OF_NUM_GT",INT_OF_NUM_GT; "INT_OF_NUM_LE",INT_OF_NUM_LE; "INT_OF_NUM_LT",INT_OF_NUM_LT; "INT_OF_NUM_MAX",INT_OF_NUM_MAX; "INT_OF_NUM_MIN",INT_OF_NUM_MIN; "INT_OF_NUM_MUL",INT_OF_NUM_MUL; "INT_OF_NUM_OF_INT",INT_OF_NUM_OF_INT; "INT_OF_NUM_POW",INT_OF_NUM_POW; "INT_OF_NUM_SUB",INT_OF_NUM_SUB; "INT_OF_NUM_SUC",INT_OF_NUM_SUC; "INT_POS",INT_POS; "INT_POS_NZ",INT_POS_NZ; "INT_POW",INT_POW; "INT_POW2_ABS",INT_POW2_ABS; "INT_POW_1",INT_POW_1; "INT_POW_1_LE",INT_POW_1_LE; "INT_POW_1_LT",INT_POW_1_LT; "INT_POW_2",INT_POW_2; "INT_POW_ADD",INT_POW_ADD; "INT_POW_EQ",INT_POW_EQ; "INT_POW_EQ_0",INT_POW_EQ_0; "INT_POW_EQ_ABS",INT_POW_EQ_ABS; "INT_POW_LE",INT_POW_LE; "INT_POW_LE2",INT_POW_LE2; "INT_POW_LE2_ODD",INT_POW_LE2_ODD; "INT_POW_LE2_REV",INT_POW_LE2_REV; "INT_POW_LE_1",INT_POW_LE_1; "INT_POW_LT",INT_POW_LT; "INT_POW_LT2",INT_POW_LT2; "INT_POW_LT2_REV",INT_POW_LT2_REV; "INT_POW_LT_1",INT_POW_LT_1; "INT_POW_MONO",INT_POW_MONO; "INT_POW_MONO_LT",INT_POW_MONO_LT; "INT_POW_MUL",INT_POW_MUL; "INT_POW_NEG",INT_POW_NEG; "INT_POW_NZ",INT_POW_NZ; "INT_POW_ONE",INT_POW_ONE; "INT_POW_POW",INT_POW_POW; "INT_POW_ZERO",INT_POW_ZERO; "INT_RNEG_UNIQ",INT_RNEG_UNIQ; "INT_SGN",INT_SGN; "INT_SGNS_EQ",INT_SGNS_EQ; "INT_SGNS_EQ_ALT",INT_SGNS_EQ_ALT; "INT_SGN_0",INT_SGN_0; "INT_SGN_ABS",INT_SGN_ABS; "INT_SGN_ABS_ALT",INT_SGN_ABS_ALT; "INT_SGN_CASES",INT_SGN_CASES; "INT_SGN_EQ",INT_SGN_EQ; "INT_SGN_EQ_INEQ",INT_SGN_EQ_INEQ; "INT_SGN_INEQS",INT_SGN_INEQS; "INT_SGN_INT_SGN",INT_SGN_INT_SGN; "INT_SGN_MUL",INT_SGN_MUL; "INT_SGN_NEG",INT_SGN_NEG; "INT_SGN_POW",INT_SGN_POW; "INT_SGN_POW_2",INT_SGN_POW_2; "INT_SOS_EQ_0",INT_SOS_EQ_0; "INT_SUB",INT_SUB; "INT_SUB_0",INT_SUB_0; "INT_SUB_ABS",INT_SUB_ABS; "INT_SUB_ADD",INT_SUB_ADD; "INT_SUB_ADD2",INT_SUB_ADD2; "INT_SUB_LDISTRIB",INT_SUB_LDISTRIB; "INT_SUB_LE",INT_SUB_LE; "INT_SUB_LNEG",INT_SUB_LNEG; "INT_SUB_LT",INT_SUB_LT; "INT_SUB_LZERO",INT_SUB_LZERO; "INT_SUB_NEG2",INT_SUB_NEG2; "INT_SUB_RDISTRIB",INT_SUB_RDISTRIB; "INT_SUB_REFL",INT_SUB_REFL; "INT_SUB_RNEG",INT_SUB_RNEG; "INT_SUB_RZERO",INT_SUB_RZERO; "INT_SUB_SUB",INT_SUB_SUB; "INT_SUB_SUB2",INT_SUB_SUB2; "INT_SUB_TRIANGLE",INT_SUB_TRIANGLE; "INT_WOP",INT_WOP; "IN_CROSS",IN_CROSS; "IN_DELETE",IN_DELETE; "IN_DELETE_EQ",IN_DELETE_EQ; "IN_DIFF",IN_DIFF; "IN_DISJOINT",IN_DISJOINT; "IN_ELIM_PAIR_THM",IN_ELIM_PAIR_THM; "IN_ELIM_PASTECART_THM",IN_ELIM_PASTECART_THM; "IN_ELIM_THM",IN_ELIM_THM; "IN_IMAGE",IN_IMAGE; "IN_INSERT",IN_INSERT; "IN_INTER",IN_INTER; "IN_INTERS",IN_INTERS; "IN_NUMSEG",IN_NUMSEG; "IN_NUMSEG_0",IN_NUMSEG_0; "IN_REST",IN_REST; "IN_SET_OF_LIST",IN_SET_OF_LIST; "IN_SING",IN_SING; "IN_SUPPORT",IN_SUPPORT; "IN_UNION",IN_UNION; "IN_UNIONS",IN_UNIONS; "IN_UNIV",IN_UNIV; "ISO",ISO; "ISO_FUN",ISO_FUN; "ISO_REFL",ISO_REFL; "ISO_USAGE",ISO_USAGE; "ITERATE_BIJECTION",ITERATE_BIJECTION; "ITERATE_CASES",ITERATE_CASES; "ITERATE_CLAUSES",ITERATE_CLAUSES; "ITERATE_CLAUSES_GEN",ITERATE_CLAUSES_GEN; "ITERATE_CLAUSES_NUMSEG",ITERATE_CLAUSES_NUMSEG; "ITERATE_CLOSED",ITERATE_CLOSED; "ITERATE_DELETE",ITERATE_DELETE; "ITERATE_DELTA",ITERATE_DELTA; "ITERATE_DIFF",ITERATE_DIFF; "ITERATE_DIFF_GEN",ITERATE_DIFF_GEN; "ITERATE_EQ",ITERATE_EQ; "ITERATE_EQ_GENERAL",ITERATE_EQ_GENERAL; "ITERATE_EQ_GENERAL_INVERSES",ITERATE_EQ_GENERAL_INVERSES; "ITERATE_EQ_NEUTRAL",ITERATE_EQ_NEUTRAL; "ITERATE_EXPAND_CASES",ITERATE_EXPAND_CASES; "ITERATE_IMAGE",ITERATE_IMAGE; "ITERATE_IMAGE_GEN",ITERATE_IMAGE_GEN; "ITERATE_IMAGE_NONZERO",ITERATE_IMAGE_NONZERO; "ITERATE_INCL_EXCL",ITERATE_INCL_EXCL; "ITERATE_INJECTION",ITERATE_INJECTION; "ITERATE_ITERATE_PRODUCT",ITERATE_ITERATE_PRODUCT; "ITERATE_OP",ITERATE_OP; "ITERATE_OP_GEN",ITERATE_OP_GEN; "ITERATE_PAIR",ITERATE_PAIR; "ITERATE_REFLECT",ITERATE_REFLECT; "ITERATE_RELATED",ITERATE_RELATED; "ITERATE_RESTRICT_SET",ITERATE_RESTRICT_SET; "ITERATE_SING",ITERATE_SING; "ITERATE_SUPERSET",ITERATE_SUPERSET; "ITERATE_SUPPORT",ITERATE_SUPPORT; "ITERATE_SWAP",ITERATE_SWAP; "ITERATE_UNION",ITERATE_UNION; "ITERATE_UNION_GEN",ITERATE_UNION_GEN; "ITERATE_UNION_NONZERO",ITERATE_UNION_NONZERO; "ITERATE_UNIV",ITERATE_UNIV; "ITLIST",ITLIST; "ITLIST2",ITLIST2; "ITLIST2_DEF",ITLIST2_DEF; "ITLIST_APPEND",ITLIST_APPEND; "ITLIST_EXTRA",ITLIST_EXTRA; "ITSET",ITSET; "ITSET_EQ",ITSET_EQ; "I_DEF",I_DEF; "I_O_ID",I_O_ID; "I_THM",I_THM; "LAMBDA_BETA",LAMBDA_BETA; "LAMBDA_ETA",LAMBDA_ETA; "LAMBDA_PAIR_THM",LAMBDA_PAIR_THM; "LAMBDA_UNIQUE",LAMBDA_UNIQUE; "LAMBDA_UNPAIR_THM",LAMBDA_UNPAIR_THM; "LAST",LAST; "LAST_APPEND",LAST_APPEND; "LAST_CLAUSES",LAST_CLAUSES; "LAST_EL",LAST_EL; "LDIV_LT_EQ",LDIV_LT_EQ; "LE",LE; "LEFT_ADD_DISTRIB",LEFT_ADD_DISTRIB; "LEFT_AND_EXISTS_THM",LEFT_AND_EXISTS_THM; "LEFT_AND_FORALL_THM",LEFT_AND_FORALL_THM; "LEFT_EXISTS_AND_THM",LEFT_EXISTS_AND_THM; "LEFT_EXISTS_IMP_THM",LEFT_EXISTS_IMP_THM; "LEFT_FORALL_IMP_THM",LEFT_FORALL_IMP_THM; "LEFT_FORALL_OR_THM",LEFT_FORALL_OR_THM; "LEFT_IMP_EXISTS_THM",LEFT_IMP_EXISTS_THM; "LEFT_IMP_FORALL_THM",LEFT_IMP_FORALL_THM; "LEFT_OR_DISTRIB",LEFT_OR_DISTRIB; "LEFT_OR_EXISTS_THM",LEFT_OR_EXISTS_THM; "LEFT_OR_FORALL_THM",LEFT_OR_FORALL_THM; "LEFT_SUB_DISTRIB",LEFT_SUB_DISTRIB; "LENGTH",LENGTH; "LENGTH_APPEND",LENGTH_APPEND; "LENGTH_EQ_CONS",LENGTH_EQ_CONS; "LENGTH_EQ_NIL",LENGTH_EQ_NIL; "LENGTH_LIST_OF_SEQ",LENGTH_LIST_OF_SEQ; "LENGTH_LIST_OF_SET",LENGTH_LIST_OF_SET; "LENGTH_MAP",LENGTH_MAP; "LENGTH_MAP2",LENGTH_MAP2; "LENGTH_REPLICATE",LENGTH_REPLICATE; "LENGTH_TL",LENGTH_TL; "LENGTH_ZIP",LENGTH_ZIP; "LET_ADD2",LET_ADD2; "LET_ANTISYM",LET_ANTISYM; "LET_CASES",LET_CASES; "LET_DEF",LET_DEF; "LET_END_DEF",LET_END_DEF; "LET_TRANS",LET_TRANS; "LE_0",LE_0; "LE_1",LE_1; "LE_ADD",LE_ADD; "LE_ADD2",LE_ADD2; "LE_ADDR",LE_ADDR; "LE_ADD_LCANCEL",LE_ADD_LCANCEL; "LE_ADD_RCANCEL",LE_ADD_RCANCEL; "LE_ANTISYM",LE_ANTISYM; "LE_C",LE_C; "LE_CASES",LE_CASES; "LE_EXISTS",LE_EXISTS; "LE_EXP",LE_EXP; "LE_INDUCT",LE_INDUCT; "LE_LDIV",LE_LDIV; "LE_LDIV_EQ",LE_LDIV_EQ; "LE_LT",LE_LT; "LE_MULT2",LE_MULT2; "LE_MULT_LCANCEL",LE_MULT_LCANCEL; "LE_MULT_RCANCEL",LE_MULT_RCANCEL; "LE_RDIV_EQ",LE_RDIV_EQ; "LE_REFL",LE_REFL; "LE_SQUARE_REFL",LE_SQUARE_REFL; "LE_SUC",LE_SUC; "LE_SUC_LT",LE_SUC_LT; "LE_TRANS",LE_TRANS; "LIST_EQ",LIST_EQ; "LIST_OF_SEQ_EQ_NIL",LIST_OF_SEQ_EQ_NIL; "LIST_OF_SET_EMPTY",LIST_OF_SET_EMPTY; "LIST_OF_SET_PROPERTIES",LIST_OF_SET_PROPERTIES; "LIST_OF_SET_SING",LIST_OF_SET_SING; "LT",LT; "LTE_ADD2",LTE_ADD2; "LTE_ANTISYM",LTE_ANTISYM; "LTE_CASES",LTE_CASES; "LTE_TRANS",LTE_TRANS; "LT_0",LT_0; "LT_ADD",LT_ADD; "LT_ADD2",LT_ADD2; "LT_ADDR",LT_ADDR; "LT_ADD_LCANCEL",LT_ADD_LCANCEL; "LT_ADD_RCANCEL",LT_ADD_RCANCEL; "LT_ANTISYM",LT_ANTISYM; "LT_CASES",LT_CASES; "LT_EXISTS",LT_EXISTS; "LT_EXP",LT_EXP; "LT_IMP_LE",LT_IMP_LE; "LT_LE",LT_LE; "LT_LMULT",LT_LMULT; "LT_MULT",LT_MULT; "LT_MULT2",LT_MULT2; "LT_MULT_LCANCEL",LT_MULT_LCANCEL; "LT_MULT_RCANCEL",LT_MULT_RCANCEL; "LT_NZ",LT_NZ; "LT_POW2_REFL",LT_POW2_REFL; "LT_REFL",LT_REFL; "LT_SUC",LT_SUC; "LT_SUC_LE",LT_SUC_LE; "LT_TRANS",LT_TRANS; "MAP",MAP; "MAP2",MAP2; "MAP2_DEF",MAP2_DEF; "MAP_APPEND",MAP_APPEND; "MAP_EQ",MAP_EQ; "MAP_EQ_ALL2",MAP_EQ_ALL2; "MAP_EQ_DEGEN",MAP_EQ_DEGEN; "MAP_EQ_NIL",MAP_EQ_NIL; "MAP_FST_ZIP",MAP_FST_ZIP; "MAP_I",MAP_I; "MAP_ID",MAP_ID; "MAP_REVERSE",MAP_REVERSE; "MAP_SND_ZIP",MAP_SND_ZIP; "MAP_o",MAP_o; "MATCH_SEQPATTERN",MATCH_SEQPATTERN; "MAX",MAX; "MEASURE",MEASURE; "MEASURE_LE",MEASURE_LE; "MEM",MEM; "MEMBER_NOT_EMPTY",MEMBER_NOT_EMPTY; "MEM_APPEND",MEM_APPEND; "MEM_APPEND_DECOMPOSE",MEM_APPEND_DECOMPOSE; "MEM_APPEND_DECOMPOSE_LEFT",MEM_APPEND_DECOMPOSE_LEFT; "MEM_ASSOC",MEM_ASSOC; "MEM_EL",MEM_EL; "MEM_EXISTS_EL",MEM_EXISTS_EL; "MEM_FILTER",MEM_FILTER; "MEM_LIST_OF_SET",MEM_LIST_OF_SET; "MEM_MAP",MEM_MAP; "MIN",MIN; "MINIMAL",MINIMAL; "MK_REC_INJ",MK_REC_INJ; "MOD_0",MOD_0; "MOD_1",MOD_1; "MOD_ADD_MOD",MOD_ADD_MOD; "MOD_EQ",MOD_EQ; "MOD_EQ_0",MOD_EQ_0; "MOD_EXISTS",MOD_EXISTS; "MOD_EXP_MOD",MOD_EXP_MOD; "MOD_LE",MOD_LE; "MOD_LT",MOD_LT; "MOD_MOD",MOD_MOD; "MOD_MOD_EXP_MIN",MOD_MOD_EXP_MIN; "MOD_MOD_REFL",MOD_MOD_REFL; "MOD_MULT",MOD_MULT; "MOD_MULT2",MOD_MULT2; "MOD_MULT_ADD",MOD_MULT_ADD; "MOD_MULT_LMOD",MOD_MULT_LMOD; "MOD_MULT_MOD2",MOD_MULT_MOD2; "MOD_MULT_RMOD",MOD_MULT_RMOD; "MOD_NSUM_MOD",MOD_NSUM_MOD; "MOD_NSUM_MOD_NUMSEG",MOD_NSUM_MOD_NUMSEG; "MOD_REFL",MOD_REFL; "MOD_UNIQ",MOD_UNIQ; "MONOIDAL_AC",MONOIDAL_AC; "MONOIDAL_ADD",MONOIDAL_ADD; "MONOIDAL_MUL",MONOIDAL_MUL; "MONOIDAL_REAL_ADD",MONOIDAL_REAL_ADD; "MONOIDAL_REAL_MUL",MONOIDAL_REAL_MUL; "MONO_ALL",MONO_ALL; "MONO_ALL2",MONO_ALL2; "MONO_AND",MONO_AND; "MONO_COND",MONO_COND; "MONO_EXISTS",MONO_EXISTS; "MONO_FORALL",MONO_FORALL; "MONO_IMP",MONO_IMP; "MONO_NOT",MONO_NOT; "MONO_OR",MONO_OR; "MULT",MULT; "MULT_0",MULT_0; "MULT_2",MULT_2; "MULT_AC",MULT_AC; "MULT_ASSOC",MULT_ASSOC; "MULT_CLAUSES",MULT_CLAUSES; "MULT_DIV_LE",MULT_DIV_LE; "MULT_EQ_0",MULT_EQ_0; "MULT_EQ_1",MULT_EQ_1; "MULT_EXP",MULT_EXP; "MULT_SUC",MULT_SUC; "MULT_SYM",MULT_SYM; "NADD_ADD",NADD_ADD; "NADD_ADDITIVE",NADD_ADDITIVE; "NADD_ADD_ASSOC",NADD_ADD_ASSOC; "NADD_ADD_LCANCEL",NADD_ADD_LCANCEL; "NADD_ADD_LID",NADD_ADD_LID; "NADD_ADD_SYM",NADD_ADD_SYM; "NADD_ADD_WELLDEF",NADD_ADD_WELLDEF; "NADD_ALTMUL",NADD_ALTMUL; "NADD_ARCH",NADD_ARCH; "NADD_ARCH_LEMMA",NADD_ARCH_LEMMA; "NADD_ARCH_MULT",NADD_ARCH_MULT; "NADD_ARCH_ZERO",NADD_ARCH_ZERO; "NADD_BOUND",NADD_BOUND; "NADD_CAUCHY",NADD_CAUCHY; "NADD_COMPLETE",NADD_COMPLETE; "NADD_DIST",NADD_DIST; "NADD_DIST_LEMMA",NADD_DIST_LEMMA; "NADD_EQ_IMP_LE",NADD_EQ_IMP_LE; "NADD_EQ_REFL",NADD_EQ_REFL; "NADD_EQ_SYM",NADD_EQ_SYM; "NADD_EQ_TRANS",NADD_EQ_TRANS; "NADD_INV",NADD_INV; "NADD_INV_0",NADD_INV_0; "NADD_INV_WELLDEF",NADD_INV_WELLDEF; "NADD_LBOUND",NADD_LBOUND; "NADD_LDISTRIB",NADD_LDISTRIB; "NADD_LE_0",NADD_LE_0; "NADD_LE_ADD",NADD_LE_ADD; "NADD_LE_ANTISYM",NADD_LE_ANTISYM; "NADD_LE_EXISTS",NADD_LE_EXISTS; "NADD_LE_LADD",NADD_LE_LADD; "NADD_LE_LMUL",NADD_LE_LMUL; "NADD_LE_RADD",NADD_LE_RADD; "NADD_LE_REFL",NADD_LE_REFL; "NADD_LE_RMUL",NADD_LE_RMUL; "NADD_LE_TOTAL",NADD_LE_TOTAL; "NADD_LE_TOTAL_LEMMA",NADD_LE_TOTAL_LEMMA; "NADD_LE_TRANS",NADD_LE_TRANS; "NADD_LE_WELLDEF",NADD_LE_WELLDEF; "NADD_LE_WELLDEF_LEMMA",NADD_LE_WELLDEF_LEMMA; "NADD_MUL",NADD_MUL; "NADD_MULTIPLICATIVE",NADD_MULTIPLICATIVE; "NADD_MUL_ASSOC",NADD_MUL_ASSOC; "NADD_MUL_LID",NADD_MUL_LID; "NADD_MUL_LINV",NADD_MUL_LINV; "NADD_MUL_LINV_LEMMA0",NADD_MUL_LINV_LEMMA0; "NADD_MUL_LINV_LEMMA1",NADD_MUL_LINV_LEMMA1; "NADD_MUL_LINV_LEMMA2",NADD_MUL_LINV_LEMMA2; "NADD_MUL_LINV_LEMMA3",NADD_MUL_LINV_LEMMA3; "NADD_MUL_LINV_LEMMA4",NADD_MUL_LINV_LEMMA4; "NADD_MUL_LINV_LEMMA5",NADD_MUL_LINV_LEMMA5; "NADD_MUL_LINV_LEMMA6",NADD_MUL_LINV_LEMMA6; "NADD_MUL_LINV_LEMMA7",NADD_MUL_LINV_LEMMA7; "NADD_MUL_LINV_LEMMA7a",NADD_MUL_LINV_LEMMA7a; "NADD_MUL_LINV_LEMMA8",NADD_MUL_LINV_LEMMA8; "NADD_MUL_SYM",NADD_MUL_SYM; "NADD_MUL_WELLDEF",NADD_MUL_WELLDEF; "NADD_MUL_WELLDEF_LEMMA",NADD_MUL_WELLDEF_LEMMA; "NADD_NONZERO",NADD_NONZERO; "NADD_OF_NUM",NADD_OF_NUM; "NADD_OF_NUM_ADD",NADD_OF_NUM_ADD; "NADD_OF_NUM_EQ",NADD_OF_NUM_EQ; "NADD_OF_NUM_LE",NADD_OF_NUM_LE; "NADD_OF_NUM_MUL",NADD_OF_NUM_MUL; "NADD_OF_NUM_WELLDEF",NADD_OF_NUM_WELLDEF; "NADD_RDISTRIB",NADD_RDISTRIB; "NADD_SUC",NADD_SUC; "NADD_UBOUND",NADD_UBOUND; "NEUTRAL_ADD",NEUTRAL_ADD; "NEUTRAL_MUL",NEUTRAL_MUL; "NEUTRAL_REAL_ADD",NEUTRAL_REAL_ADD; "NEUTRAL_REAL_MUL",NEUTRAL_REAL_MUL; "NOT_ALL",NOT_ALL; "NOT_CLAUSES",NOT_CLAUSES; "NOT_CLAUSES_WEAK",NOT_CLAUSES_WEAK; "NOT_CONS_NIL",NOT_CONS_NIL; "NOT_DEF",NOT_DEF; "NOT_EMPTY_INSERT",NOT_EMPTY_INSERT; "NOT_EQUAL_SETS",NOT_EQUAL_SETS; "NOT_EVEN",NOT_EVEN; "NOT_EX",NOT_EX; "NOT_EXISTS_THM",NOT_EXISTS_THM; "NOT_FORALL_THM",NOT_FORALL_THM; "NOT_IMP",NOT_IMP; "NOT_INSERT_EMPTY",NOT_INSERT_EMPTY; "NOT_IN_EMPTY",NOT_IN_EMPTY; "NOT_LE",NOT_LE; "NOT_LT",NOT_LT; "NOT_ODD",NOT_ODD; "NOT_PSUBSET_EMPTY",NOT_PSUBSET_EMPTY; "NOT_SUC",NOT_SUC; "NOT_UNIV_PSUBSET",NOT_UNIV_PSUBSET; "NSUM_0",NSUM_0; "NSUM_ADD",NSUM_ADD; "NSUM_ADD_GEN",NSUM_ADD_GEN; "NSUM_ADD_NUMSEG",NSUM_ADD_NUMSEG; "NSUM_ADD_SPLIT",NSUM_ADD_SPLIT; "NSUM_BIJECTION",NSUM_BIJECTION; "NSUM_BOUND",NSUM_BOUND; "NSUM_BOUND_GEN",NSUM_BOUND_GEN; "NSUM_BOUND_LT",NSUM_BOUND_LT; "NSUM_BOUND_LT_ALL",NSUM_BOUND_LT_ALL; "NSUM_BOUND_LT_GEN",NSUM_BOUND_LT_GEN; "NSUM_CASES",NSUM_CASES; "NSUM_CLAUSES",NSUM_CLAUSES; "NSUM_CLAUSES_LEFT",NSUM_CLAUSES_LEFT; "NSUM_CLAUSES_NUMSEG",NSUM_CLAUSES_NUMSEG; "NSUM_CLAUSES_RIGHT",NSUM_CLAUSES_RIGHT; "NSUM_CLOSED",NSUM_CLOSED; "NSUM_CONST",NSUM_CONST; "NSUM_CONST_NUMSEG",NSUM_CONST_NUMSEG; "NSUM_DEGENERATE",NSUM_DEGENERATE; "NSUM_DELETE",NSUM_DELETE; "NSUM_DELTA",NSUM_DELTA; "NSUM_DIFF",NSUM_DIFF; "NSUM_EQ",NSUM_EQ; "NSUM_EQ_0",NSUM_EQ_0; "NSUM_EQ_0_IFF",NSUM_EQ_0_IFF; "NSUM_EQ_0_IFF_NUMSEG",NSUM_EQ_0_IFF_NUMSEG; "NSUM_EQ_0_NUMSEG",NSUM_EQ_0_NUMSEG; "NSUM_EQ_GENERAL",NSUM_EQ_GENERAL; "NSUM_EQ_GENERAL_INVERSES",NSUM_EQ_GENERAL_INVERSES; "NSUM_EQ_NUMSEG",NSUM_EQ_NUMSEG; "NSUM_EQ_SUPERSET",NSUM_EQ_SUPERSET; "NSUM_GROUP",NSUM_GROUP; "NSUM_GROUP_RELATION",NSUM_GROUP_RELATION; "NSUM_IMAGE",NSUM_IMAGE; "NSUM_IMAGE_GEN",NSUM_IMAGE_GEN; "NSUM_IMAGE_NONZERO",NSUM_IMAGE_NONZERO; "NSUM_INCL_EXCL",NSUM_INCL_EXCL; "NSUM_INJECTION",NSUM_INJECTION; "NSUM_LE",NSUM_LE; "NSUM_LE_GEN",NSUM_LE_GEN; "NSUM_LE_NUMSEG",NSUM_LE_NUMSEG; "NSUM_LMUL",NSUM_LMUL; "NSUM_LT",NSUM_LT; "NSUM_LT_ALL",NSUM_LT_ALL; "NSUM_MULTICOUNT",NSUM_MULTICOUNT; "NSUM_MULTICOUNT_GEN",NSUM_MULTICOUNT_GEN; "NSUM_MUL_BOUND",NSUM_MUL_BOUND; "NSUM_NSUM_PRODUCT",NSUM_NSUM_PRODUCT; "NSUM_NSUM_RESTRICT",NSUM_NSUM_RESTRICT; "NSUM_OFFSET",NSUM_OFFSET; "NSUM_OFFSET_0",NSUM_OFFSET_0; "NSUM_PAIR",NSUM_PAIR; "NSUM_POS_BOUND",NSUM_POS_BOUND; "NSUM_POS_LT",NSUM_POS_LT; "NSUM_POS_LT_ALL",NSUM_POS_LT_ALL; "NSUM_REFLECT",NSUM_REFLECT; "NSUM_RESTRICT",NSUM_RESTRICT; "NSUM_RESTRICT_SET",NSUM_RESTRICT_SET; "NSUM_RMUL",NSUM_RMUL; "NSUM_SING",NSUM_SING; "NSUM_SING_NUMSEG",NSUM_SING_NUMSEG; "NSUM_SUBSET",NSUM_SUBSET; "NSUM_SUBSET_SIMPLE",NSUM_SUBSET_SIMPLE; "NSUM_SUPERSET",NSUM_SUPERSET; "NSUM_SUPPORT",NSUM_SUPPORT; "NSUM_SWAP",NSUM_SWAP; "NSUM_SWAP_NUMSEG",NSUM_SWAP_NUMSEG; "NSUM_TRIV_NUMSEG",NSUM_TRIV_NUMSEG; "NSUM_UNION",NSUM_UNION; "NSUM_UNIONS_NONZERO",NSUM_UNIONS_NONZERO; "NSUM_UNION_EQ",NSUM_UNION_EQ; "NSUM_UNION_LZERO",NSUM_UNION_LZERO; "NSUM_UNION_NONZERO",NSUM_UNION_NONZERO; "NSUM_UNION_RZERO",NSUM_UNION_RZERO; "NSUM_UNIV",NSUM_UNIV; "NULL",NULL; "NUMERAL",NUMERAL; "NUMPAIR",NUMPAIR; "NUMPAIR_DEST",NUMPAIR_DEST; "NUMPAIR_INJ",NUMPAIR_INJ; "NUMPAIR_INJ_LEMMA",NUMPAIR_INJ_LEMMA; "NUMSEG_ADD_SPLIT",NUMSEG_ADD_SPLIT; "NUMSEG_CLAUSES",NUMSEG_CLAUSES; "NUMSEG_COMBINE_L",NUMSEG_COMBINE_L; "NUMSEG_COMBINE_R",NUMSEG_COMBINE_R; "NUMSEG_EMPTY",NUMSEG_EMPTY; "NUMSEG_LE",NUMSEG_LE; "NUMSEG_LREC",NUMSEG_LREC; "NUMSEG_LT",NUMSEG_LT; "NUMSEG_OFFSET_IMAGE",NUMSEG_OFFSET_IMAGE; "NUMSEG_REC",NUMSEG_REC; "NUMSEG_RREC",NUMSEG_RREC; "NUMSEG_SING",NUMSEG_SING; "NUMSUM",NUMSUM; "NUMSUM_DEST",NUMSUM_DEST; "NUMSUM_INJ",NUMSUM_INJ; "NUM_GCD",NUM_GCD; "NUM_OF_INT",NUM_OF_INT; "NUM_OF_INT_OF_NUM",NUM_OF_INT_OF_NUM; "NUM_REP_CASES",NUM_REP_CASES; "NUM_REP_INDUCT",NUM_REP_INDUCT; "NUM_REP_RULES",NUM_REP_RULES; "ODD",ODD; "ODD_ADD",ODD_ADD; "ODD_DOUBLE",ODD_DOUBLE; "ODD_EXISTS",ODD_EXISTS; "ODD_EXP",ODD_EXP; "ODD_MOD",ODD_MOD; "ODD_MULT",ODD_MULT; "ODD_SUB",ODD_SUB; "ONE",ONE; "ONE_ONE",ONE_ONE; "ONTO",ONTO; "OR_CLAUSES",OR_CLAUSES; "OR_DEF",OR_DEF; "OR_EXISTS_THM",OR_EXISTS_THM; "OUTL",OUTL; "OUTR",OUTR; "PAIR",PAIR; "PAIRED_ETA_THM",PAIRED_ETA_THM; "PAIRWISE",PAIRWISE; "PAIRWISE_AND",PAIRWISE_AND; "PAIRWISE_APPEND",PAIRWISE_APPEND; "PAIRWISE_CHAIN_UNIONS",PAIRWISE_CHAIN_UNIONS; "PAIRWISE_EMPTY",PAIRWISE_EMPTY; "PAIRWISE_IMAGE",PAIRWISE_IMAGE; "PAIRWISE_IMP",PAIRWISE_IMP; "PAIRWISE_IMPLIES",PAIRWISE_IMPLIES; "PAIRWISE_INSERT",PAIRWISE_INSERT; "PAIRWISE_MAP",PAIRWISE_MAP; "PAIRWISE_MONO",PAIRWISE_MONO; "PAIRWISE_SING",PAIRWISE_SING; "PAIRWISE_TRANSITIVE",PAIRWISE_TRANSITIVE; "PAIRWISE_UNION",PAIRWISE_UNION; "PAIR_EQ",PAIR_EQ; "PAIR_EXISTS_THM",PAIR_EXISTS_THM; "PAIR_SURJECTIVE",PAIR_SURJECTIVE; "PASSOC_DEF",PASSOC_DEF; "PASTECART_EQ",PASTECART_EQ; "PASTECART_FST_SND",PASTECART_FST_SND; "PASTECART_INJ",PASTECART_INJ; "PASTECART_IN_PCROSS",PASTECART_IN_PCROSS; "PCROSS",PCROSS; "PCROSS_DIFF",PCROSS_DIFF; "PCROSS_EMPTY",PCROSS_EMPTY; "PCROSS_EQ",PCROSS_EQ; "PCROSS_EQ_EMPTY",PCROSS_EQ_EMPTY; "PCROSS_INTER",PCROSS_INTER; "PCROSS_INTERS",PCROSS_INTERS; "PCROSS_INTERS_INTERS",PCROSS_INTERS_INTERS; "PCROSS_MONO",PCROSS_MONO; "PCROSS_UNION",PCROSS_UNION; "PCROSS_UNIONS",PCROSS_UNIONS; "PCROSS_UNIONS_UNIONS",PCROSS_UNIONS_UNIONS; "POLYNOMIAL_FUNCTION_ADD",POLYNOMIAL_FUNCTION_ADD; "POLYNOMIAL_FUNCTION_CONST",POLYNOMIAL_FUNCTION_CONST; "POLYNOMIAL_FUNCTION_FINITE_ROOTS",POLYNOMIAL_FUNCTION_FINITE_ROOTS; "POLYNOMIAL_FUNCTION_I",POLYNOMIAL_FUNCTION_I; "POLYNOMIAL_FUNCTION_ID",POLYNOMIAL_FUNCTION_ID; "POLYNOMIAL_FUNCTION_INDUCT",POLYNOMIAL_FUNCTION_INDUCT; "POLYNOMIAL_FUNCTION_LMUL",POLYNOMIAL_FUNCTION_LMUL; "POLYNOMIAL_FUNCTION_MUL",POLYNOMIAL_FUNCTION_MUL; "POLYNOMIAL_FUNCTION_NEG",POLYNOMIAL_FUNCTION_NEG; "POLYNOMIAL_FUNCTION_POW",POLYNOMIAL_FUNCTION_POW; "POLYNOMIAL_FUNCTION_RMUL",POLYNOMIAL_FUNCTION_RMUL; "POLYNOMIAL_FUNCTION_SUB",POLYNOMIAL_FUNCTION_SUB; "POLYNOMIAL_FUNCTION_SUM",POLYNOMIAL_FUNCTION_SUM; "POLYNOMIAL_FUNCTION_o",POLYNOMIAL_FUNCTION_o; "POWERSET_CLAUSES",POWERSET_CLAUSES; "PRE",PRE; "PRE_ELIM_THM",PRE_ELIM_THM; "PRE_ELIM_THM'",PRE_ELIM_THM'; "PSUBSET",PSUBSET; "PSUBSET_ALT",PSUBSET_ALT; "PSUBSET_INSERT_SUBSET",PSUBSET_INSERT_SUBSET; "PSUBSET_IRREFL",PSUBSET_IRREFL; "PSUBSET_MEMBER",PSUBSET_MEMBER; "PSUBSET_SUBSET_TRANS",PSUBSET_SUBSET_TRANS; "PSUBSET_TRANS",PSUBSET_TRANS; "PSUBSET_UNIONS_PAIRWISE_DISJOINT",PSUBSET_UNIONS_PAIRWISE_DISJOINT; "PSUBSET_UNIV",PSUBSET_UNIV; "RAT_LEMMA1",RAT_LEMMA1; "RAT_LEMMA2",RAT_LEMMA2; "RAT_LEMMA3",RAT_LEMMA3; "RAT_LEMMA4",RAT_LEMMA4; "RAT_LEMMA5",RAT_LEMMA5; "RDIV_LT_EQ",RDIV_LT_EQ; "REAL_ABS_0",REAL_ABS_0; "REAL_ABS_1",REAL_ABS_1; "REAL_ABS_ABS",REAL_ABS_ABS; "REAL_ABS_BETWEEN",REAL_ABS_BETWEEN; "REAL_ABS_BETWEEN1",REAL_ABS_BETWEEN1; "REAL_ABS_BETWEEN2",REAL_ABS_BETWEEN2; "REAL_ABS_BOUND",REAL_ABS_BOUND; "REAL_ABS_BOUNDS",REAL_ABS_BOUNDS; "REAL_ABS_CASES",REAL_ABS_CASES; "REAL_ABS_CIRCLE",REAL_ABS_CIRCLE; "REAL_ABS_DIV",REAL_ABS_DIV; "REAL_ABS_INF_LE",REAL_ABS_INF_LE; "REAL_ABS_INV",REAL_ABS_INV; "REAL_ABS_LE",REAL_ABS_LE; "REAL_ABS_MUL",REAL_ABS_MUL; "REAL_ABS_NEG",REAL_ABS_NEG; "REAL_ABS_NUM",REAL_ABS_NUM; "REAL_ABS_NZ",REAL_ABS_NZ; "REAL_ABS_POS",REAL_ABS_POS; "REAL_ABS_POW",REAL_ABS_POW; "REAL_ABS_REFL",REAL_ABS_REFL; "REAL_ABS_SGN",REAL_ABS_SGN; "REAL_ABS_SIGN",REAL_ABS_SIGN; "REAL_ABS_SIGN2",REAL_ABS_SIGN2; "REAL_ABS_STILLNZ",REAL_ABS_STILLNZ; "REAL_ABS_SUB",REAL_ABS_SUB; "REAL_ABS_SUB_ABS",REAL_ABS_SUB_ABS; "REAL_ABS_SUP_LE",REAL_ABS_SUP_LE; "REAL_ABS_TRIANGLE",REAL_ABS_TRIANGLE; "REAL_ABS_TRIANGLE_LE",REAL_ABS_TRIANGLE_LE; "REAL_ABS_TRIANGLE_LT",REAL_ABS_TRIANGLE_LT; "REAL_ABS_ZERO",REAL_ABS_ZERO; "REAL_ADD2_SUB2",REAL_ADD2_SUB2; "REAL_ADD_AC",REAL_ADD_AC; "REAL_ADD_ASSOC",REAL_ADD_ASSOC; "REAL_ADD_LDISTRIB",REAL_ADD_LDISTRIB; "REAL_ADD_LID",REAL_ADD_LID; "REAL_ADD_LINV",REAL_ADD_LINV; "REAL_ADD_RDISTRIB",REAL_ADD_RDISTRIB; "REAL_ADD_RID",REAL_ADD_RID; "REAL_ADD_RINV",REAL_ADD_RINV; "REAL_ADD_SUB",REAL_ADD_SUB; "REAL_ADD_SUB2",REAL_ADD_SUB2; "REAL_ADD_SYM",REAL_ADD_SYM; "REAL_ARCH",REAL_ARCH; "REAL_ARCH_LT",REAL_ARCH_LT; "REAL_ARCH_SIMPLE",REAL_ARCH_SIMPLE; "REAL_BOUNDS_LE",REAL_BOUNDS_LE; "REAL_BOUNDS_LT",REAL_BOUNDS_LT; "REAL_COMPLETE",REAL_COMPLETE; "REAL_COMPLETE_SOMEPOS",REAL_COMPLETE_SOMEPOS; "REAL_DIFFSQ",REAL_DIFFSQ; "REAL_DIV_1",REAL_DIV_1; "REAL_DIV_EQ_0",REAL_DIV_EQ_0; "REAL_DIV_LMUL",REAL_DIV_LMUL; "REAL_DIV_POW2",REAL_DIV_POW2; "REAL_DIV_POW2_ALT",REAL_DIV_POW2_ALT; "REAL_DIV_REFL",REAL_DIV_REFL; "REAL_DIV_RMUL",REAL_DIV_RMUL; "REAL_DOWN",REAL_DOWN; "REAL_DOWN2",REAL_DOWN2; "REAL_ENTIRE",REAL_ENTIRE; "REAL_EQ_ADD_LCANCEL",REAL_EQ_ADD_LCANCEL; "REAL_EQ_ADD_LCANCEL_0",REAL_EQ_ADD_LCANCEL_0; "REAL_EQ_ADD_RCANCEL",REAL_EQ_ADD_RCANCEL; "REAL_EQ_ADD_RCANCEL_0",REAL_EQ_ADD_RCANCEL_0; "REAL_EQ_IMP_LE",REAL_EQ_IMP_LE; "REAL_EQ_INV2",REAL_EQ_INV2; "REAL_EQ_LCANCEL_IMP",REAL_EQ_LCANCEL_IMP; "REAL_EQ_LDIV_EQ",REAL_EQ_LDIV_EQ; "REAL_EQ_MUL_LCANCEL",REAL_EQ_MUL_LCANCEL; "REAL_EQ_MUL_RCANCEL",REAL_EQ_MUL_RCANCEL; "REAL_EQ_NEG2",REAL_EQ_NEG2; "REAL_EQ_RCANCEL_IMP",REAL_EQ_RCANCEL_IMP; "REAL_EQ_RDIV_EQ",REAL_EQ_RDIV_EQ; "REAL_EQ_SGN_ABS",REAL_EQ_SGN_ABS; "REAL_EQ_SQUARE_ABS",REAL_EQ_SQUARE_ABS; "REAL_EQ_SUB_LADD",REAL_EQ_SUB_LADD; "REAL_EQ_SUB_RADD",REAL_EQ_SUB_RADD; "REAL_HREAL_LEMMA1",REAL_HREAL_LEMMA1; "REAL_HREAL_LEMMA2",REAL_HREAL_LEMMA2; "REAL_INF_ASCLOSE",REAL_INF_ASCLOSE; "REAL_INF_BOUNDS",REAL_INF_BOUNDS; "REAL_INF_LE",REAL_INF_LE; "REAL_INF_LE_FINITE",REAL_INF_LE_FINITE; "REAL_INF_LT_FINITE",REAL_INF_LT_FINITE; "REAL_INF_UNIQUE",REAL_INF_UNIQUE; "REAL_INV_0",REAL_INV_0; "REAL_INV_1",REAL_INV_1; "REAL_INV_1_LE",REAL_INV_1_LE; "REAL_INV_1_LT",REAL_INV_1_LT; "REAL_INV_DIV",REAL_INV_DIV; "REAL_INV_EQ_0",REAL_INV_EQ_0; "REAL_INV_EQ_1",REAL_INV_EQ_1; "REAL_INV_INV",REAL_INV_INV; "REAL_INV_LE_1",REAL_INV_LE_1; "REAL_INV_LT_1",REAL_INV_LT_1; "REAL_INV_MUL",REAL_INV_MUL; "REAL_INV_NEG",REAL_INV_NEG; "REAL_INV_POW",REAL_INV_POW; "REAL_INV_SGN",REAL_INV_SGN; "REAL_LET_ADD",REAL_LET_ADD; "REAL_LET_ADD2",REAL_LET_ADD2; "REAL_LET_ANTISYM",REAL_LET_ANTISYM; "REAL_LET_TOTAL",REAL_LET_TOTAL; "REAL_LET_TRANS",REAL_LET_TRANS; "REAL_LE_01",REAL_LE_01; "REAL_LE_ADD",REAL_LE_ADD; "REAL_LE_ADD2",REAL_LE_ADD2; "REAL_LE_ADDL",REAL_LE_ADDL; "REAL_LE_ADDR",REAL_LE_ADDR; "REAL_LE_ANTISYM",REAL_LE_ANTISYM; "REAL_LE_DIV",REAL_LE_DIV; "REAL_LE_DIV2_EQ",REAL_LE_DIV2_EQ; "REAL_LE_DOUBLE",REAL_LE_DOUBLE; "REAL_LE_INF",REAL_LE_INF; "REAL_LE_INF_EQ",REAL_LE_INF_EQ; "REAL_LE_INF_FINITE",REAL_LE_INF_FINITE; "REAL_LE_INF_SUBSET",REAL_LE_INF_SUBSET; "REAL_LE_INV",REAL_LE_INV; "REAL_LE_INV2",REAL_LE_INV2; "REAL_LE_INV_EQ",REAL_LE_INV_EQ; "REAL_LE_LADD",REAL_LE_LADD; "REAL_LE_LADD_IMP",REAL_LE_LADD_IMP; "REAL_LE_LCANCEL_IMP",REAL_LE_LCANCEL_IMP; "REAL_LE_LDIV_EQ",REAL_LE_LDIV_EQ; "REAL_LE_LINV",REAL_LE_LINV; "REAL_LE_LMUL",REAL_LE_LMUL; "REAL_LE_LMUL_EQ",REAL_LE_LMUL_EQ; "REAL_LE_LNEG",REAL_LE_LNEG; "REAL_LE_LT",REAL_LE_LT; "REAL_LE_MAX",REAL_LE_MAX; "REAL_LE_MIN",REAL_LE_MIN; "REAL_LE_MUL",REAL_LE_MUL; "REAL_LE_MUL2",REAL_LE_MUL2; "REAL_LE_MUL_EQ",REAL_LE_MUL_EQ; "REAL_LE_NEG",REAL_LE_NEG; "REAL_LE_NEG2",REAL_LE_NEG2; "REAL_LE_NEGL",REAL_LE_NEGL; "REAL_LE_NEGR",REAL_LE_NEGR; "REAL_LE_NEGTOTAL",REAL_LE_NEGTOTAL; "REAL_LE_POW2",REAL_LE_POW2; "REAL_LE_POW_2",REAL_LE_POW_2; "REAL_LE_RADD",REAL_LE_RADD; "REAL_LE_RCANCEL_IMP",REAL_LE_RCANCEL_IMP; "REAL_LE_RDIV_EQ",REAL_LE_RDIV_EQ; "REAL_LE_REFL",REAL_LE_REFL; "REAL_LE_RINV",REAL_LE_RINV; "REAL_LE_RMUL",REAL_LE_RMUL; "REAL_LE_RMUL_EQ",REAL_LE_RMUL_EQ; "REAL_LE_RNEG",REAL_LE_RNEG; "REAL_LE_SQUARE",REAL_LE_SQUARE; "REAL_LE_SQUARE_ABS",REAL_LE_SQUARE_ABS; "REAL_LE_SUB_LADD",REAL_LE_SUB_LADD; "REAL_LE_SUB_RADD",REAL_LE_SUB_RADD; "REAL_LE_SUP",REAL_LE_SUP; "REAL_LE_SUP_FINITE",REAL_LE_SUP_FINITE; "REAL_LE_TOTAL",REAL_LE_TOTAL; "REAL_LE_TRANS",REAL_LE_TRANS; "REAL_LE_TRANS_LE",REAL_LE_TRANS_LE; "REAL_LE_TRANS_LT",REAL_LE_TRANS_LT; "REAL_LE_TRANS_LTE",REAL_LE_TRANS_LTE; "REAL_LNEG_UNIQ",REAL_LNEG_UNIQ; "REAL_LTE_ADD",REAL_LTE_ADD; "REAL_LTE_ADD2",REAL_LTE_ADD2; "REAL_LTE_ANTISYM",REAL_LTE_ANTISYM; "REAL_LTE_TOTAL",REAL_LTE_TOTAL; "REAL_LTE_TRANS",REAL_LTE_TRANS; "REAL_LT_01",REAL_LT_01; "REAL_LT_ADD",REAL_LT_ADD; "REAL_LT_ADD1",REAL_LT_ADD1; "REAL_LT_ADD2",REAL_LT_ADD2; "REAL_LT_ADDL",REAL_LT_ADDL; "REAL_LT_ADDNEG",REAL_LT_ADDNEG; "REAL_LT_ADDNEG2",REAL_LT_ADDNEG2; "REAL_LT_ADDR",REAL_LT_ADDR; "REAL_LT_ADD_SUB",REAL_LT_ADD_SUB; "REAL_LT_ANTISYM",REAL_LT_ANTISYM; "REAL_LT_DIV",REAL_LT_DIV; "REAL_LT_DIV2_EQ",REAL_LT_DIV2_EQ; "REAL_LT_GT",REAL_LT_GT; "REAL_LT_IMP_LE",REAL_LT_IMP_LE; "REAL_LT_IMP_NE",REAL_LT_IMP_NE; "REAL_LT_IMP_NZ",REAL_LT_IMP_NZ; "REAL_LT_INF_FINITE",REAL_LT_INF_FINITE; "REAL_LT_INV",REAL_LT_INV; "REAL_LT_INV2",REAL_LT_INV2; "REAL_LT_INV_EQ",REAL_LT_INV_EQ; "REAL_LT_LADD",REAL_LT_LADD; "REAL_LT_LADD_IMP",REAL_LT_LADD_IMP; "REAL_LT_LCANCEL_IMP",REAL_LT_LCANCEL_IMP; "REAL_LT_LDIV_EQ",REAL_LT_LDIV_EQ; "REAL_LT_LE",REAL_LT_LE; "REAL_LT_LINV",REAL_LT_LINV; "REAL_LT_LMUL",REAL_LT_LMUL; "REAL_LT_LMUL_EQ",REAL_LT_LMUL_EQ; "REAL_LT_LNEG",REAL_LT_LNEG; "REAL_LT_MAX",REAL_LT_MAX; "REAL_LT_MIN",REAL_LT_MIN; "REAL_LT_MUL",REAL_LT_MUL; "REAL_LT_MUL2",REAL_LT_MUL2; "REAL_LT_MUL_EQ",REAL_LT_MUL_EQ; "REAL_LT_NEG",REAL_LT_NEG; "REAL_LT_NEG2",REAL_LT_NEG2; "REAL_LT_NEGTOTAL",REAL_LT_NEGTOTAL; "REAL_LT_POW2",REAL_LT_POW2; "REAL_LT_POW_2",REAL_LT_POW_2; "REAL_LT_RADD",REAL_LT_RADD; "REAL_LT_RCANCEL_IMP",REAL_LT_RCANCEL_IMP; "REAL_LT_RDIV_EQ",REAL_LT_RDIV_EQ; "REAL_LT_REFL",REAL_LT_REFL; "REAL_LT_RINV",REAL_LT_RINV; "REAL_LT_RMUL",REAL_LT_RMUL; "REAL_LT_RMUL_EQ",REAL_LT_RMUL_EQ; "REAL_LT_RNEG",REAL_LT_RNEG; "REAL_LT_SQUARE",REAL_LT_SQUARE; "REAL_LT_SQUARE_ABS",REAL_LT_SQUARE_ABS; "REAL_LT_SUB_LADD",REAL_LT_SUB_LADD; "REAL_LT_SUB_RADD",REAL_LT_SUB_RADD; "REAL_LT_SUP_FINITE",REAL_LT_SUP_FINITE; "REAL_LT_TOTAL",REAL_LT_TOTAL; "REAL_LT_TRANS",REAL_LT_TRANS; "REAL_MAX_ACI",REAL_MAX_ACI; "REAL_MAX_ASSOC",REAL_MAX_ASSOC; "REAL_MAX_LE",REAL_MAX_LE; "REAL_MAX_LT",REAL_MAX_LT; "REAL_MAX_MAX",REAL_MAX_MAX; "REAL_MAX_MIN",REAL_MAX_MIN; "REAL_MAX_SYM",REAL_MAX_SYM; "REAL_MIN_ACI",REAL_MIN_ACI; "REAL_MIN_ASSOC",REAL_MIN_ASSOC; "REAL_MIN_LE",REAL_MIN_LE; "REAL_MIN_LT",REAL_MIN_LT; "REAL_MIN_MAX",REAL_MIN_MAX; "REAL_MIN_MIN",REAL_MIN_MIN; "REAL_MIN_SYM",REAL_MIN_SYM; "REAL_MUL_2",REAL_MUL_2; "REAL_MUL_AC",REAL_MUL_AC; "REAL_MUL_ASSOC",REAL_MUL_ASSOC; "REAL_MUL_LID",REAL_MUL_LID; "REAL_MUL_LINV",REAL_MUL_LINV; "REAL_MUL_LINV_UNIQ",REAL_MUL_LINV_UNIQ; "REAL_MUL_LNEG",REAL_MUL_LNEG; "REAL_MUL_LZERO",REAL_MUL_LZERO; "REAL_MUL_POS_LE",REAL_MUL_POS_LE; "REAL_MUL_POS_LT",REAL_MUL_POS_LT; "REAL_MUL_RID",REAL_MUL_RID; "REAL_MUL_RINV",REAL_MUL_RINV; "REAL_MUL_RINV_UNIQ",REAL_MUL_RINV_UNIQ; "REAL_MUL_RNEG",REAL_MUL_RNEG; "REAL_MUL_RZERO",REAL_MUL_RZERO; "REAL_MUL_SYM",REAL_MUL_SYM; "REAL_NEGNEG",REAL_NEGNEG; "REAL_NEG_0",REAL_NEG_0; "REAL_NEG_ADD",REAL_NEG_ADD; "REAL_NEG_EQ",REAL_NEG_EQ; "REAL_NEG_EQ_0",REAL_NEG_EQ_0; "REAL_NEG_GE0",REAL_NEG_GE0; "REAL_NEG_GT0",REAL_NEG_GT0; "REAL_NEG_LE0",REAL_NEG_LE0; "REAL_NEG_LMUL",REAL_NEG_LMUL; "REAL_NEG_LT0",REAL_NEG_LT0; "REAL_NEG_MINUS1",REAL_NEG_MINUS1; "REAL_NEG_MUL2",REAL_NEG_MUL2; "REAL_NEG_NEG",REAL_NEG_NEG; "REAL_NEG_RMUL",REAL_NEG_RMUL; "REAL_NEG_SUB",REAL_NEG_SUB; "REAL_NOT_EQ",REAL_NOT_EQ; "REAL_NOT_LE",REAL_NOT_LE; "REAL_NOT_LT",REAL_NOT_LT; "REAL_OF_NUM_ADD",REAL_OF_NUM_ADD; "REAL_OF_NUM_EQ",REAL_OF_NUM_EQ; "REAL_OF_NUM_GE",REAL_OF_NUM_GE; "REAL_OF_NUM_GT",REAL_OF_NUM_GT; "REAL_OF_NUM_LE",REAL_OF_NUM_LE; "REAL_OF_NUM_LT",REAL_OF_NUM_LT; "REAL_OF_NUM_MAX",REAL_OF_NUM_MAX; "REAL_OF_NUM_MIN",REAL_OF_NUM_MIN; "REAL_OF_NUM_MUL",REAL_OF_NUM_MUL; "REAL_OF_NUM_POW",REAL_OF_NUM_POW; "REAL_OF_NUM_SUB",REAL_OF_NUM_SUB; "REAL_OF_NUM_SUB_CASES",REAL_OF_NUM_SUB_CASES; "REAL_OF_NUM_SUC",REAL_OF_NUM_SUC; "REAL_OF_NUM_SUM",REAL_OF_NUM_SUM; "REAL_OF_NUM_SUM_GEN",REAL_OF_NUM_SUM_GEN; "REAL_OF_NUM_SUM_NUMSEG",REAL_OF_NUM_SUM_NUMSEG; "REAL_POLYFUN_EQ_0",REAL_POLYFUN_EQ_0; "REAL_POLYFUN_EQ_CONST",REAL_POLYFUN_EQ_CONST; "REAL_POLYFUN_FINITE_ROOTS",REAL_POLYFUN_FINITE_ROOTS; "REAL_POLYFUN_ROOTBOUND",REAL_POLYFUN_ROOTBOUND; "REAL_POLY_CLAUSES",REAL_POLY_CLAUSES; "REAL_POLY_NEG_CLAUSES",REAL_POLY_NEG_CLAUSES; "REAL_POS",REAL_POS; "REAL_POS_NZ",REAL_POS_NZ; "REAL_POW2_ABS",REAL_POW2_ABS; "REAL_POW_1",REAL_POW_1; "REAL_POW_1_LE",REAL_POW_1_LE; "REAL_POW_1_LT",REAL_POW_1_LT; "REAL_POW_2",REAL_POW_2; "REAL_POW_ADD",REAL_POW_ADD; "REAL_POW_DIV",REAL_POW_DIV; "REAL_POW_EQ",REAL_POW_EQ; "REAL_POW_EQ_0",REAL_POW_EQ_0; "REAL_POW_EQ_1",REAL_POW_EQ_1; "REAL_POW_EQ_1_IMP",REAL_POW_EQ_1_IMP; "REAL_POW_EQ_ABS",REAL_POW_EQ_ABS; "REAL_POW_EQ_EQ",REAL_POW_EQ_EQ; "REAL_POW_EQ_ODD",REAL_POW_EQ_ODD; "REAL_POW_EQ_ODD_EQ",REAL_POW_EQ_ODD_EQ; "REAL_POW_INV",REAL_POW_INV; "REAL_POW_LE",REAL_POW_LE; "REAL_POW_LE2",REAL_POW_LE2; "REAL_POW_LE2_ODD",REAL_POW_LE2_ODD; "REAL_POW_LE2_ODD_EQ",REAL_POW_LE2_ODD_EQ; "REAL_POW_LE2_REV",REAL_POW_LE2_REV; "REAL_POW_LE_1",REAL_POW_LE_1; "REAL_POW_LT",REAL_POW_LT; "REAL_POW_LT2",REAL_POW_LT2; "REAL_POW_LT2_ODD",REAL_POW_LT2_ODD; "REAL_POW_LT2_ODD_EQ",REAL_POW_LT2_ODD_EQ; "REAL_POW_LT2_REV",REAL_POW_LT2_REV; "REAL_POW_LT_1",REAL_POW_LT_1; "REAL_POW_MONO",REAL_POW_MONO; "REAL_POW_MONO_INV",REAL_POW_MONO_INV; "REAL_POW_MONO_LT",REAL_POW_MONO_LT; "REAL_POW_MUL",REAL_POW_MUL; "REAL_POW_NEG",REAL_POW_NEG; "REAL_POW_NZ",REAL_POW_NZ; "REAL_POW_ONE",REAL_POW_ONE; "REAL_POW_POW",REAL_POW_POW; "REAL_POW_SUB",REAL_POW_SUB; "REAL_POW_ZERO",REAL_POW_ZERO; "REAL_RNEG_UNIQ",REAL_RNEG_UNIQ; "REAL_SGN",REAL_SGN; "REAL_SGNS_EQ",REAL_SGNS_EQ; "REAL_SGNS_EQ_ALT",REAL_SGNS_EQ_ALT; "REAL_SGN_0",REAL_SGN_0; "REAL_SGN_ABS",REAL_SGN_ABS; "REAL_SGN_ABS_ALT",REAL_SGN_ABS_ALT; "REAL_SGN_CASES",REAL_SGN_CASES; "REAL_SGN_DIV",REAL_SGN_DIV; "REAL_SGN_EQ",REAL_SGN_EQ; "REAL_SGN_EQ_INEQ",REAL_SGN_EQ_INEQ; "REAL_SGN_INEQS",REAL_SGN_INEQS; "REAL_SGN_INV",REAL_SGN_INV; "REAL_SGN_MUL",REAL_SGN_MUL; "REAL_SGN_NEG",REAL_SGN_NEG; "REAL_SGN_POW",REAL_SGN_POW; "REAL_SGN_POW_2",REAL_SGN_POW_2; "REAL_SGN_REAL_SGN",REAL_SGN_REAL_SGN; "REAL_SOS_EQ_0",REAL_SOS_EQ_0; "REAL_SUB_0",REAL_SUB_0; "REAL_SUB_ABS",REAL_SUB_ABS; "REAL_SUB_ADD",REAL_SUB_ADD; "REAL_SUB_ADD2",REAL_SUB_ADD2; "REAL_SUB_INV",REAL_SUB_INV; "REAL_SUB_LDISTRIB",REAL_SUB_LDISTRIB; "REAL_SUB_LE",REAL_SUB_LE; "REAL_SUB_LNEG",REAL_SUB_LNEG; "REAL_SUB_LT",REAL_SUB_LT; "REAL_SUB_LZERO",REAL_SUB_LZERO; "REAL_SUB_NEG2",REAL_SUB_NEG2; "REAL_SUB_POLYFUN",REAL_SUB_POLYFUN; "REAL_SUB_POLYFUN_ALT",REAL_SUB_POLYFUN_ALT; "REAL_SUB_POW",REAL_SUB_POW; "REAL_SUB_POW_L1",REAL_SUB_POW_L1; "REAL_SUB_POW_R1",REAL_SUB_POW_R1; "REAL_SUB_RDISTRIB",REAL_SUB_RDISTRIB; "REAL_SUB_REFL",REAL_SUB_REFL; "REAL_SUB_RNEG",REAL_SUB_RNEG; "REAL_SUB_RZERO",REAL_SUB_RZERO; "REAL_SUB_SUB",REAL_SUB_SUB; "REAL_SUB_SUB2",REAL_SUB_SUB2; "REAL_SUB_TRIANGLE",REAL_SUB_TRIANGLE; "REAL_SUP_ASCLOSE",REAL_SUP_ASCLOSE; "REAL_SUP_BOUNDS",REAL_SUP_BOUNDS; "REAL_SUP_EQ_INF",REAL_SUP_EQ_INF; "REAL_SUP_LE",REAL_SUP_LE; "REAL_SUP_LE_EQ",REAL_SUP_LE_EQ; "REAL_SUP_LE_FINITE",REAL_SUP_LE_FINITE; "REAL_SUP_LE_SUBSET",REAL_SUP_LE_SUBSET; "REAL_SUP_LT_FINITE",REAL_SUP_LT_FINITE; "REAL_SUP_UNIQUE",REAL_SUP_UNIQUE; "REAL_WLOG_LE",REAL_WLOG_LE; "REAL_WLOG_LT",REAL_WLOG_LT; "RECURSION_CASEWISE",RECURSION_CASEWISE; "RECURSION_CASEWISE_PAIRWISE",RECURSION_CASEWISE_PAIRWISE; "RECURSION_SUPERADMISSIBLE",RECURSION_SUPERADMISSIBLE; "REFL_CLAUSE",REFL_CLAUSE; "REPLICATE",REPLICATE; "REP_ABS_PAIR",REP_ABS_PAIR; "REST",REST; "REVERSE",REVERSE; "REVERSE_APPEND",REVERSE_APPEND; "REVERSE_REVERSE",REVERSE_REVERSE; "RIGHT_ADD_DISTRIB",RIGHT_ADD_DISTRIB; "RIGHT_AND_EXISTS_THM",RIGHT_AND_EXISTS_THM; "RIGHT_AND_FORALL_THM",RIGHT_AND_FORALL_THM; "RIGHT_EXISTS_AND_THM",RIGHT_EXISTS_AND_THM; "RIGHT_EXISTS_IMP_THM",RIGHT_EXISTS_IMP_THM; "RIGHT_FORALL_IMP_THM",RIGHT_FORALL_IMP_THM; "RIGHT_FORALL_OR_THM",RIGHT_FORALL_OR_THM; "RIGHT_IMP_EXISTS_THM",RIGHT_IMP_EXISTS_THM; "RIGHT_IMP_FORALL_THM",RIGHT_IMP_FORALL_THM; "RIGHT_OR_DISTRIB",RIGHT_OR_DISTRIB; "RIGHT_OR_EXISTS_THM",RIGHT_OR_EXISTS_THM; "RIGHT_OR_FORALL_THM",RIGHT_OR_FORALL_THM; "RIGHT_SUB_DISTRIB",RIGHT_SUB_DISTRIB; "SELECT_AX",SELECT_AX; "SELECT_REFL",SELECT_REFL; "SELECT_UNIQUE",SELECT_UNIQUE; "SETSPEC",SETSPEC; "SET_CASES",SET_CASES; "SET_OF_LIST_APPEND",SET_OF_LIST_APPEND; "SET_OF_LIST_EQ_EMPTY",SET_OF_LIST_EQ_EMPTY; "SET_OF_LIST_MAP",SET_OF_LIST_MAP; "SET_OF_LIST_OF_SET",SET_OF_LIST_OF_SET; "SET_PAIR_THM",SET_PAIR_THM; "SET_PROVE_CASES",SET_PROVE_CASES; "SET_RECURSION_LEMMA",SET_RECURSION_LEMMA; "SIMPLE_IMAGE",SIMPLE_IMAGE; "SIMPLE_IMAGE_GEN",SIMPLE_IMAGE_GEN; "SING",SING; "SING_GSPEC",SING_GSPEC; "SING_SUBSET",SING_SUBSET; "SKOLEM_THM",SKOLEM_THM; "SKOLEM_THM_GEN",SKOLEM_THM_GEN; "SND",SND; "SNDCART_PASTECART",SNDCART_PASTECART; "SND_DEF",SND_DEF; "SUB",SUB; "SUBSET",SUBSET; "SUBSET_ANTISYM",SUBSET_ANTISYM; "SUBSET_ANTISYM_EQ",SUBSET_ANTISYM_EQ; "SUBSET_CARD_EQ",SUBSET_CARD_EQ; "SUBSET_CROSS",SUBSET_CROSS; "SUBSET_DELETE",SUBSET_DELETE; "SUBSET_DIFF",SUBSET_DIFF; "SUBSET_EMPTY",SUBSET_EMPTY; "SUBSET_IMAGE",SUBSET_IMAGE; "SUBSET_IMAGE_INJ",SUBSET_IMAGE_INJ; "SUBSET_INSERT",SUBSET_INSERT; "SUBSET_INSERT_DELETE",SUBSET_INSERT_DELETE; "SUBSET_INTER",SUBSET_INTER; "SUBSET_INTERS",SUBSET_INTERS; "SUBSET_INTER_ABSORPTION",SUBSET_INTER_ABSORPTION; "SUBSET_NUMSEG",SUBSET_NUMSEG; "SUBSET_PCROSS",SUBSET_PCROSS; "SUBSET_PSUBSET_TRANS",SUBSET_PSUBSET_TRANS; "SUBSET_REFL",SUBSET_REFL; "SUBSET_RESTRICT",SUBSET_RESTRICT; "SUBSET_TRANS",SUBSET_TRANS; "SUBSET_UNION",SUBSET_UNION; "SUBSET_UNIONS",SUBSET_UNIONS; "SUBSET_UNION_ABSORPTION",SUBSET_UNION_ABSORPTION; "SUBSET_UNIV",SUBSET_UNIV; "SUB_0",SUB_0; "SUB_ADD",SUB_ADD; "SUB_ADD_LCANCEL",SUB_ADD_LCANCEL; "SUB_ADD_RCANCEL",SUB_ADD_RCANCEL; "SUB_ELIM_THM",SUB_ELIM_THM; "SUB_ELIM_THM'",SUB_ELIM_THM'; "SUB_EQ_0",SUB_EQ_0; "SUB_PRESUC",SUB_PRESUC; "SUB_REFL",SUB_REFL; "SUB_SUC",SUB_SUC; "SUC_DEF",SUC_DEF; "SUC_INJ",SUC_INJ; "SUC_SUB1",SUC_SUB1; "SUM_0",SUM_0; "SUM_ABS",SUM_ABS; "SUM_ABS_BOUND",SUM_ABS_BOUND; "SUM_ABS_LE",SUM_ABS_LE; "SUM_ABS_NUMSEG",SUM_ABS_NUMSEG; "SUM_ADD",SUM_ADD; "SUM_ADD_GEN",SUM_ADD_GEN; "SUM_ADD_NUMSEG",SUM_ADD_NUMSEG; "SUM_ADD_SPLIT",SUM_ADD_SPLIT; "SUM_BIJECTION",SUM_BIJECTION; "SUM_BOUND",SUM_BOUND; "SUM_BOUND_GEN",SUM_BOUND_GEN; "SUM_BOUND_LT",SUM_BOUND_LT; "SUM_BOUND_LT_ALL",SUM_BOUND_LT_ALL; "SUM_BOUND_LT_GEN",SUM_BOUND_LT_GEN; "SUM_CASES",SUM_CASES; "SUM_CASES_1",SUM_CASES_1; "SUM_CLAUSES",SUM_CLAUSES; "SUM_CLAUSES_LEFT",SUM_CLAUSES_LEFT; "SUM_CLAUSES_NUMSEG",SUM_CLAUSES_NUMSEG; "SUM_CLAUSES_RIGHT",SUM_CLAUSES_RIGHT; "SUM_CLOSED",SUM_CLOSED; "SUM_COMBINE_L",SUM_COMBINE_L; "SUM_COMBINE_R",SUM_COMBINE_R; "SUM_CONST",SUM_CONST; "SUM_CONST_NUMSEG",SUM_CONST_NUMSEG; "SUM_DEGENERATE",SUM_DEGENERATE; "SUM_DELETE",SUM_DELETE; "SUM_DELETE_CASES",SUM_DELETE_CASES; "SUM_DELTA",SUM_DELTA; "SUM_DIFF",SUM_DIFF; "SUM_DIFFS",SUM_DIFFS; "SUM_DIFFS_ALT",SUM_DIFFS_ALT; "SUM_EQ",SUM_EQ; "SUM_EQ_0",SUM_EQ_0; "SUM_EQ_0_NUMSEG",SUM_EQ_0_NUMSEG; "SUM_EQ_GENERAL",SUM_EQ_GENERAL; "SUM_EQ_GENERAL_INVERSES",SUM_EQ_GENERAL_INVERSES; "SUM_EQ_NUMSEG",SUM_EQ_NUMSEG; "SUM_EQ_SUPERSET",SUM_EQ_SUPERSET; "SUM_GROUP",SUM_GROUP; "SUM_GROUP_RELATION",SUM_GROUP_RELATION; "SUM_IMAGE",SUM_IMAGE; "SUM_IMAGE_GEN",SUM_IMAGE_GEN; "SUM_IMAGE_LE",SUM_IMAGE_LE; "SUM_IMAGE_NONZERO",SUM_IMAGE_NONZERO; "SUM_INCL_EXCL",SUM_INCL_EXCL; "SUM_INJECTION",SUM_INJECTION; "SUM_LE",SUM_LE; "SUM_LE_INCLUDED",SUM_LE_INCLUDED; "SUM_LE_NUMSEG",SUM_LE_NUMSEG; "SUM_LMUL",SUM_LMUL; "SUM_LT",SUM_LT; "SUM_LT_ALL",SUM_LT_ALL; "SUM_MULTICOUNT",SUM_MULTICOUNT; "SUM_MULTICOUNT_GEN",SUM_MULTICOUNT_GEN; "SUM_MUL_BOUND",SUM_MUL_BOUND; "SUM_NEG",SUM_NEG; "SUM_OFFSET",SUM_OFFSET; "SUM_OFFSET_0",SUM_OFFSET_0; "SUM_PAIR",SUM_PAIR; "SUM_PARTIAL_PRE",SUM_PARTIAL_PRE; "SUM_PARTIAL_SUC",SUM_PARTIAL_SUC; "SUM_POS_BOUND",SUM_POS_BOUND; "SUM_POS_EQ_0",SUM_POS_EQ_0; "SUM_POS_EQ_0_NUMSEG",SUM_POS_EQ_0_NUMSEG; "SUM_POS_LE",SUM_POS_LE; "SUM_POS_LE_NUMSEG",SUM_POS_LE_NUMSEG; "SUM_POS_LT",SUM_POS_LT; "SUM_POS_LT_ALL",SUM_POS_LT_ALL; "SUM_REFLECT",SUM_REFLECT; "SUM_RESTRICT",SUM_RESTRICT; "SUM_RESTRICT_SET",SUM_RESTRICT_SET; "SUM_RMUL",SUM_RMUL; "SUM_SING",SUM_SING; "SUM_SING_NUMSEG",SUM_SING_NUMSEG; "SUM_SUB",SUM_SUB; "SUM_SUBSET",SUM_SUBSET; "SUM_SUBSET_SIMPLE",SUM_SUBSET_SIMPLE; "SUM_SUB_NUMSEG",SUM_SUB_NUMSEG; "SUM_SUM_PRODUCT",SUM_SUM_PRODUCT; "SUM_SUM_RESTRICT",SUM_SUM_RESTRICT; "SUM_SUPERSET",SUM_SUPERSET; "SUM_SUPPORT",SUM_SUPPORT; "SUM_SWAP",SUM_SWAP; "SUM_SWAP_NUMSEG",SUM_SWAP_NUMSEG; "SUM_TRIV_NUMSEG",SUM_TRIV_NUMSEG; "SUM_UNION",SUM_UNION; "SUM_UNIONS_NONZERO",SUM_UNIONS_NONZERO; "SUM_UNION_EQ",SUM_UNION_EQ; "SUM_UNION_LZERO",SUM_UNION_LZERO; "SUM_UNION_NONZERO",SUM_UNION_NONZERO; "SUM_UNION_RZERO",SUM_UNION_RZERO; "SUM_UNIV",SUM_UNIV; "SUM_ZERO_EXISTS",SUM_ZERO_EXISTS; "SUP",SUP; "SUPERADMISSIBLE_COND",SUPERADMISSIBLE_COND; "SUPERADMISSIBLE_CONST",SUPERADMISSIBLE_CONST; "SUPERADMISSIBLE_MATCH_GUARDED_PATTERN",SUPERADMISSIBLE_MATCH_GUARDED_PATTERN; "SUPERADMISSIBLE_MATCH_SEQPATTERN",SUPERADMISSIBLE_MATCH_SEQPATTERN; "SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN",SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN; "SUPERADMISSIBLE_T",SUPERADMISSIBLE_T; "SUPERADMISSIBLE_TAIL",SUPERADMISSIBLE_TAIL; "SUPPORT_CLAUSES",SUPPORT_CLAUSES; "SUPPORT_DELTA",SUPPORT_DELTA; "SUPPORT_EMPTY",SUPPORT_EMPTY; "SUPPORT_SUBSET",SUPPORT_SUBSET; "SUPPORT_SUPPORT",SUPPORT_SUPPORT; "SUP_EQ",SUP_EQ; "SUP_FINITE",SUP_FINITE; "SUP_FINITE_LEMMA",SUP_FINITE_LEMMA; "SUP_INSERT_FINITE",SUP_INSERT_FINITE; "SUP_INSERT_INSERT",SUP_INSERT_INSERT; "SUP_SING",SUP_SING; "SUP_UNION",SUP_UNION; "SUP_UNIQUE",SUP_UNIQUE; "SUP_UNIQUE_FINITE",SUP_UNIQUE_FINITE; "SURJ",SURJ; "SURJECTIVE_EXISTS_THM",SURJECTIVE_EXISTS_THM; "SURJECTIVE_FORALL_THM",SURJECTIVE_FORALL_THM; "SURJECTIVE_IFF_INJECTIVE",SURJECTIVE_IFF_INJECTIVE; "SURJECTIVE_IFF_INJECTIVE_GEN",SURJECTIVE_IFF_INJECTIVE_GEN; "SURJECTIVE_IMAGE",SURJECTIVE_IMAGE; "SURJECTIVE_IMAGE_EQ",SURJECTIVE_IMAGE_EQ; "SURJECTIVE_IMAGE_THM",SURJECTIVE_IMAGE_THM; "SURJECTIVE_MAP",SURJECTIVE_MAP; "SURJECTIVE_ON_IMAGE",SURJECTIVE_ON_IMAGE; "SURJECTIVE_ON_PREIMAGE",SURJECTIVE_ON_PREIMAGE; "SURJECTIVE_ON_RIGHT_INVERSE",SURJECTIVE_ON_RIGHT_INVERSE; "SURJECTIVE_PREIMAGE",SURJECTIVE_PREIMAGE; "SURJECTIVE_RIGHT_INVERSE",SURJECTIVE_RIGHT_INVERSE; "SWAP_EXISTS_THM",SWAP_EXISTS_THM; "SWAP_FORALL_THM",SWAP_FORALL_THM; "TL",TL; "TOPOLOGICAL_SORT",TOPOLOGICAL_SORT; "TRANSITIVE_STEPWISE_LE",TRANSITIVE_STEPWISE_LE; "TRANSITIVE_STEPWISE_LE_EQ",TRANSITIVE_STEPWISE_LE_EQ; "TRANSITIVE_STEPWISE_LT",TRANSITIVE_STEPWISE_LT; "TRANSITIVE_STEPWISE_LT_EQ",TRANSITIVE_STEPWISE_LT_EQ; "TREAL_ADD_ASSOC",TREAL_ADD_ASSOC; "TREAL_ADD_LDISTRIB",TREAL_ADD_LDISTRIB; "TREAL_ADD_LID",TREAL_ADD_LID; "TREAL_ADD_LINV",TREAL_ADD_LINV; "TREAL_ADD_SYM",TREAL_ADD_SYM; "TREAL_ADD_SYM_EQ",TREAL_ADD_SYM_EQ; "TREAL_ADD_WELLDEF",TREAL_ADD_WELLDEF; "TREAL_ADD_WELLDEFR",TREAL_ADD_WELLDEFR; "TREAL_EQ_AP",TREAL_EQ_AP; "TREAL_EQ_IMP_LE",TREAL_EQ_IMP_LE; "TREAL_EQ_REFL",TREAL_EQ_REFL; "TREAL_EQ_SYM",TREAL_EQ_SYM; "TREAL_EQ_TRANS",TREAL_EQ_TRANS; "TREAL_INV_0",TREAL_INV_0; "TREAL_INV_WELLDEF",TREAL_INV_WELLDEF; "TREAL_LE_ANTISYM",TREAL_LE_ANTISYM; "TREAL_LE_LADD_IMP",TREAL_LE_LADD_IMP; "TREAL_LE_MUL",TREAL_LE_MUL; "TREAL_LE_REFL",TREAL_LE_REFL; "TREAL_LE_TOTAL",TREAL_LE_TOTAL; "TREAL_LE_TRANS",TREAL_LE_TRANS; "TREAL_LE_WELLDEF",TREAL_LE_WELLDEF; "TREAL_MUL_ASSOC",TREAL_MUL_ASSOC; "TREAL_MUL_LID",TREAL_MUL_LID; "TREAL_MUL_LINV",TREAL_MUL_LINV; "TREAL_MUL_SYM",TREAL_MUL_SYM; "TREAL_MUL_SYM_EQ",TREAL_MUL_SYM_EQ; "TREAL_MUL_WELLDEF",TREAL_MUL_WELLDEF; "TREAL_MUL_WELLDEFR",TREAL_MUL_WELLDEFR; "TREAL_NEG_WELLDEF",TREAL_NEG_WELLDEF; "TREAL_OF_NUM_ADD",TREAL_OF_NUM_ADD; "TREAL_OF_NUM_EQ",TREAL_OF_NUM_EQ; "TREAL_OF_NUM_LE",TREAL_OF_NUM_LE; "TREAL_OF_NUM_MUL",TREAL_OF_NUM_MUL; "TREAL_OF_NUM_WELLDEF",TREAL_OF_NUM_WELLDEF; "TRIV_AND_EXISTS_THM",TRIV_AND_EXISTS_THM; "TRIV_EXISTS_AND_THM",TRIV_EXISTS_AND_THM; "TRIV_EXISTS_IMP_THM",TRIV_EXISTS_IMP_THM; "TRIV_FORALL_IMP_THM",TRIV_FORALL_IMP_THM; "TRIV_FORALL_OR_THM",TRIV_FORALL_OR_THM; "TRIV_OR_FORALL_THM",TRIV_OR_FORALL_THM; "TRUTH",TRUTH; "TWO",TWO; "T_DEF",T_DEF; "UNCURRY_DEF",UNCURRY_DEF; "UNION",UNION; "UNIONS",UNIONS; "UNIONS_0",UNIONS_0; "UNIONS_1",UNIONS_1; "UNIONS_2",UNIONS_2; "UNIONS_DELETE_EMPTY",UNIONS_DELETE_EMPTY; "UNIONS_DIFF",UNIONS_DIFF; "UNIONS_GSPEC",UNIONS_GSPEC; "UNIONS_IMAGE",UNIONS_IMAGE; "UNIONS_INSERT",UNIONS_INSERT; "UNIONS_INSERT_EMPTY",UNIONS_INSERT_EMPTY; "UNIONS_INTERS",UNIONS_INTERS; "UNIONS_IN_CHAIN",UNIONS_IN_CHAIN; "UNIONS_MAXIMAL_SETS",UNIONS_MAXIMAL_SETS; "UNIONS_MONO",UNIONS_MONO; "UNIONS_MONO_IMAGE",UNIONS_MONO_IMAGE; "UNIONS_OVER_INTERS",UNIONS_OVER_INTERS; "UNIONS_SUBSET",UNIONS_SUBSET; "UNIONS_UNION",UNIONS_UNION; "UNIONS_UNIV",UNIONS_UNIV; "UNION_ACI",UNION_ACI; "UNION_ASSOC",UNION_ASSOC; "UNION_COMM",UNION_COMM; "UNION_EMPTY",UNION_EMPTY; "UNION_IDEMPOT",UNION_IDEMPOT; "UNION_OF",UNION_OF; "UNION_OF_INC",UNION_OF_INC; "UNION_OF_MONO",UNION_OF_MONO; "UNION_OVER_INTER",UNION_OVER_INTER; "UNION_SUBSET",UNION_SUBSET; "UNION_UNIV",UNION_UNIV; "UNIQUE_SKOLEM_ALT",UNIQUE_SKOLEM_ALT; "UNIQUE_SKOLEM_THM",UNIQUE_SKOLEM_THM; "UNIV",UNIV; "UNIV_GSPEC",UNIV_GSPEC; "UNIV_NOT_EMPTY",UNIV_NOT_EMPTY; "UNIV_PCROSS_UNIV",UNIV_PCROSS_UNIV; "UNIV_SUBSET",UNIV_SUBSET; "UNWIND_THM1",UNWIND_THM1; "UNWIND_THM2",UNWIND_THM2; "WF",WF; "WF_ANTISYM",WF_ANTISYM; "WF_DCHAIN",WF_DCHAIN; "WF_EQ",WF_EQ; "WF_EREC",WF_EREC; "WF_FALSE",WF_FALSE; "WF_FINITE",WF_FINITE; "WF_IND",WF_IND; "WF_INT_MEASURE",WF_INT_MEASURE; "WF_INT_MEASURE_2",WF_INT_MEASURE_2; "WF_LEX",WF_LEX; "WF_LEX_DEPENDENT",WF_LEX_DEPENDENT; "WF_MEASURE",WF_MEASURE; "WF_MEASURE_GEN",WF_MEASURE_GEN; "WF_POINTWISE",WF_POINTWISE; "WF_PSUBSET",WF_PSUBSET; "WF_REC",WF_REC; "WF_REC_CASES",WF_REC_CASES; "WF_REC_CASES'",WF_REC_CASES'; "WF_REC_EXISTS",WF_REC_EXISTS; "WF_REC_INVARIANT",WF_REC_INVARIANT; "WF_REC_TAIL",WF_REC_TAIL; "WF_REC_TAIL_GENERAL",WF_REC_TAIL_GENERAL; "WF_REC_TAIL_GENERAL'",WF_REC_TAIL_GENERAL'; "WF_REC_WF",WF_REC_WF; "WF_REC_num",WF_REC_num; "WF_REFL",WF_REFL; "WF_SUBSET",WF_SUBSET; "WF_UREC",WF_UREC; "WF_UREC_WF",WF_UREC_WF; "WF_num",WF_num; "WLOG_LE",WLOG_LE; "WLOG_LT",WLOG_LT; "WLOG_RELATION",WLOG_RELATION; "ZBOT",ZBOT; "ZCONSTR",ZCONSTR; "ZCONSTR_ZBOT",ZCONSTR_ZBOT; "ZERO_DEF",ZERO_DEF; "ZIP",ZIP; "ZIP_DEF",ZIP_DEF; "ZRECSPACE_CASES",ZRECSPACE_CASES; "ZRECSPACE_INDUCT",ZRECSPACE_INDUCT; "ZRECSPACE_RULES",ZRECSPACE_RULES; "_FALSITY_",_FALSITY_; "_FUNCTION",_FUNCTION; "_GUARDED_PATTERN",_GUARDED_PATTERN; "_MATCH",_MATCH; "_SEQPATTERN",_SEQPATTERN; "_UNGUARDED_PATTERN",_UNGUARDED_PATTERN; "admissible",admissible; "bool_INDUCT",bool_INDUCT; "bool_RECURSION",bool_RECURSION; "cart_tybij",cart_tybij; "char_INDUCT",char_INDUCT; "char_RECURSION",char_RECURSION; "cong",cong; "dest_int_rep",dest_int_rep; "dimindex",dimindex; "dist",dist; "divides",divides; "eq_c",eq_c; "finite_diff_tybij",finite_diff_tybij; "finite_image_tybij",finite_image_tybij; "finite_index",finite_index; "finite_prod_tybij",finite_prod_tybij; "finite_sum_tybij",finite_sum_tybij; "fstcart",fstcart; "ge_c",ge_c; "gt_c",gt_c; "hreal_add",hreal_add; "hreal_add_th",hreal_add_th; "hreal_inv",hreal_inv; "hreal_inv_th",hreal_inv_th; "hreal_le",hreal_le; "hreal_le_th",hreal_le_th; "hreal_mul",hreal_mul; "hreal_mul_th",hreal_mul_th; "hreal_of_num",hreal_of_num; "hreal_of_num_th",hreal_of_num_th; "inf",inf; "int_abs",int_abs; "int_abs_th",int_abs_th; "int_abstr",int_abstr; "int_add",int_add; "int_add_th",int_add_th; "int_congruent",int_congruent; "int_coprime",int_coprime; "int_divides",int_divides; "int_eq",int_eq; "int_gcd",int_gcd; "int_ge",int_ge; "int_gt",int_gt; "int_le",int_le; "int_lt",int_lt; "int_max",int_max; "int_max_th",int_max_th; "int_min",int_min; "int_min_th",int_min_th; "int_mod",int_mod; "int_mul",int_mul; "int_mul_th",int_mul_th; "int_neg",int_neg; "int_neg_th",int_neg_th; "int_of_num",int_of_num; "int_of_num_th",int_of_num_th; "int_pow",int_pow; "int_pow_th",int_pow_th; "int_rep",int_rep; "int_sgn",int_sgn; "int_sgn_th",int_sgn_th; "int_sub",int_sub; "int_sub_th",int_sub_th; "int_tybij",int_tybij; "integer",integer; "is_int",is_int; "is_nadd",is_nadd; "is_nadd_0",is_nadd_0; "iterate",iterate; "lambda",lambda; "le_c",le_c; "list_CASES",list_CASES; "list_INDUCT",list_INDUCT; "list_RECURSION",list_RECURSION; "list_of_seq",list_of_seq; "list_of_set",list_of_set; "lt_c",lt_c; "minimal",minimal; "mk_pair_def",mk_pair_def; "monoidal",monoidal; "nadd_abs",nadd_abs; "nadd_add",nadd_add; "nadd_eq",nadd_eq; "nadd_inv",nadd_inv; "nadd_le",nadd_le; "nadd_mul",nadd_mul; "nadd_of_num",nadd_of_num; "nadd_rep",nadd_rep; "nadd_rinv",nadd_rinv; "neutral",neutral; "nsum",nsum; "num_Axiom",num_Axiom; "num_CASES",num_CASES; "num_FINITE",num_FINITE; "num_FINITE_AVOID",num_FINITE_AVOID; "num_INDUCTION",num_INDUCTION; "num_INFINITE",num_INFINITE; "num_INFINITE_EQ",num_INFINITE_EQ; "num_MAX",num_MAX; "num_RECURSION",num_RECURSION; "num_RECURSION_STD",num_RECURSION_STD; "num_WF",num_WF; "num_WOP",num_WOP; "num_congruent",num_congruent; "num_coprime",num_coprime; "num_divides",num_divides; "num_gcd",num_gcd; "num_mod",num_mod; "num_of_int",num_of_int; "numseg",numseg; "o_ASSOC",o_ASSOC; "o_DEF",o_DEF; "o_THM",o_THM; "one",one; "one_Axiom",one_Axiom; "one_DEF",one_DEF; "one_INDUCT",one_INDUCT; "one_RECURSION",one_RECURSION; "one_axiom",one_axiom; "one_tydef",one_tydef; "option_INDUCT",option_INDUCT; "option_RECURSION",option_RECURSION; "pair_INDUCT",pair_INDUCT; "pair_RECURSION",pair_RECURSION; "pairwise",pairwise; "pastecart",pastecart; "polynomial_function",polynomial_function; "prod_tybij",prod_tybij; "real_INFINITE",real_INFINITE; "real_abs",real_abs; "real_add",real_add; "real_add_th",real_add_th; "real_div",real_div; "real_ge",real_ge; "real_gt",real_gt; "real_inv",real_inv; "real_inv_th",real_inv_th; "real_le",real_le; "real_le_th",real_le_th; "real_lt",real_lt; "real_max",real_max; "real_min",real_min; "real_mod",real_mod; "real_mul",real_mul; "real_mul_th",real_mul_th; "real_neg",real_neg; "real_neg_th",real_neg_th; "real_of_num",real_of_num; "real_of_num_th",real_of_num_th; "real_pow",real_pow; "real_sgn",real_sgn; "real_sub",real_sub; "set_of_list",set_of_list; "sndcart",sndcart; "string_INFINITE",string_INFINITE; "sum",sum; "sum_INDUCT",sum_INDUCT; "sum_RECURSION",sum_RECURSION; "sup",sup; "superadmissible",superadmissible; "support",support; "tailadmissible",tailadmissible; "treal_add",treal_add; "treal_eq",treal_eq; "treal_inv",treal_inv; "treal_le",treal_le; "treal_mul",treal_mul; "treal_neg",treal_neg; "treal_of_num",treal_of_num; "vector",vector ];; hol-light/define.ml000066400000000000000000001307061303454263000145400ustar00rootroot00000000000000(* ========================================================================= *) (* Automated support for general recursive definitions. *) (* *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "cart.ml";; (* ------------------------------------------------------------------------- *) (* Constant supporting casewise definitions. *) (* ------------------------------------------------------------------------- *) let CASEWISE_DEF = new_recursive_definition list_RECURSION `(CASEWISE [] f x = @y. T) /\ (CASEWISE (CONS h t) f x = if ?y. FST h y = x then SND h f (@y. FST h y = x) else CASEWISE t f x)`;; let CASEWISE = prove (`(CASEWISE [] f x = @y. T) /\ (CASEWISE (CONS (s,t) clauses) f x = if ?y. s y = x then t f (@y. s y = x) else CASEWISE clauses f x)`, REWRITE_TAC[CASEWISE_DEF]);; (* ------------------------------------------------------------------------- *) (* Conditions for all the clauses in a casewise definition to hold. *) (* ------------------------------------------------------------------------- *) let CASEWISE_CASES = prove (`!clauses c x. (?s t a. MEM (s,t) clauses /\ (s a = x) /\ (CASEWISE clauses c x = t c a)) \/ ~(?s t a. MEM (s,t) clauses /\ (s a = x)) /\ (CASEWISE clauses c x = @y. T)`, MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[MEM; CASEWISE; FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[]);; let CASEWISE_WORKS = prove (`!clauses c:C. (!s t s' t' x y. MEM (s,t) clauses /\ MEM (s',t') clauses /\ (s x = s' y) ==> (t c x = t' c y)) ==> ALL (\(s:P->A,t). !x. CASEWISE clauses c (s x) :B = t c x) clauses`, REWRITE_TAC[GSYM ALL_MEM; FORALL_PAIR_THM] THEN MESON_TAC[CASEWISE_CASES]);; (* ------------------------------------------------------------------------- *) (* Various notions of admissibility, with tail recursion and preconditions. *) (* ------------------------------------------------------------------------- *) let admissible = new_definition `admissible(<<) p s t <=> !f g a. p f a /\ p g a /\ (!z. z << s(a) ==> (f z = g z)) ==> (t f a = t g a)`;; let tailadmissible = new_definition `tailadmissible(<<) p s t <=> ?P G H. (!f a y. P f a /\ y << G f a ==> y << s a) /\ (!f g a. (!z. z << s(a) ==> (f z = g z)) ==> (P f a = P g a) /\ (G f a = G g a) /\ (H f a = H g a)) /\ (!f a:P. p f a ==> (t (f:A->B) a = if P f a then f(G f a) else H f a))`;; let superadmissible = new_definition `superadmissible(<<) p s t <=> admissible(<<) (\f a. T) s p ==> tailadmissible(<<) p s t`;; (* ------------------------------------------------------------------------- *) (* A lemma. *) (* ------------------------------------------------------------------------- *) let MATCH_SEQPATTERN = prove (`_MATCH x (_SEQPATTERN r s) = if ?y. r x y then _MATCH x r else _MATCH x s`, REWRITE_TAC[_MATCH; _SEQPATTERN] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Admissibility combinators. *) (* ------------------------------------------------------------------------- *) let ADMISSIBLE_CONST = prove (`!p s c. admissible(<<) p s (\f. c)`, REWRITE_TAC[admissible]);; let ADMISSIBLE_BASE = prove (`!(<<) p s t. (!f a. p f a ==> t a << s a) ==> admissible((<<):A->A->bool) p s (\f:A->B x:P. f(t x))`, REWRITE_TAC[admissible] THEN MESON_TAC[]);; let ADMISSIBLE_COMB = prove (`!(<<) p s:P->A g:(A->B)->P->C->D y:(A->B)->P->C. admissible(<<) p s g /\ admissible(<<) p s y ==> admissible(<<) p s (\f x. (g f x) (y f x))`, SIMP_TAC[admissible] THEN MESON_TAC[]);; let ADMISSIBLE_RAND = prove (`!(<<) p s:P->A g:P->C->D y:(A->B)->P->C. admissible(<<) p s y ==> admissible(<<) p s (\f x. (g x) (y f x))`, SIMP_TAC[admissible] THEN MESON_TAC[]);; let ADMISSIBLE_LAMBDA = prove (`!(<<) p s:P->A t:(A->B)->C->P->bool. admissible(<<) (\f (u,x). p f x) (\(u,x). s x) (\f (u,x). t f u x) ==> admissible(<<) p s (\f x. \u. t f u x)`, REWRITE_TAC[admissible; FUN_EQ_THM; FORALL_PAIR_THM] THEN MESON_TAC[]);; let ADMISSIBLE_NEST = prove (`!(<<) p s t. admissible(<<) p s t /\ (!f a. p f a ==> t f a << s a) ==> admissible((<<):A->A->bool) p s (\f:A->B x:P. f(t f x))`, REWRITE_TAC[admissible] THEN MESON_TAC[]);; let ADMISSIBLE_COND = prove (`!(<<) p P s h k. admissible(<<) p s P /\ admissible(<<) (\f x. p f x /\ P f x) s h /\ admissible(<<) (\f x. p f x /\ ~P f x) s k ==> admissible(<<) p s (\f x:P. if P f x then h f x else k f x)`, REPEAT GEN_TAC THEN REWRITE_TAC[admissible; AND_FORALL_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let ADMISSIBLE_MATCH = prove (`!(<<) p s e c. admissible(<<) p s e /\ admissible(<<) p s (\f x. c f x (e f x)) ==> admissible(<<) p s (\f x:P. _MATCH (e f x) (c f x))`, REWRITE_TAC[admissible; _MATCH] THEN REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_MESON_TAC[]);; let ADMISSIBLE_SEQPATTERN = prove (`!(<<) p s c1 c2 e. admissible(<<) p s (\f x:P. ?y. c1 f x (e f x) y) /\ admissible(<<) (\f x. p f x /\ ?y. c1 f x (e f x) y) s (\f x. c1 f x (e f x)) /\ admissible(<<) (\f x. p f x /\ ~(?y. c1 f x (e f x) y)) s (\f x. c2 f x (e f x)) ==> admissible(<<) p s (\f x. _SEQPATTERN (c1 f x) (c2 f x) (e f x))`, REWRITE_TAC[_SEQPATTERN; admissible] THEN MESON_TAC[]);; let ADMISSIBLE_UNGUARDED_PATTERN = prove (`!(<<) p s pat e t y. admissible (<<) p s pat /\ admissible (<<) p s e /\ admissible (<<) (\f x. p f x /\ pat f x = e f x) s t /\ admissible (<<) (\f x. p f x /\ pat f x = e f x) s y ==> admissible(<<) p s (\f x:P. _UNGUARDED_PATTERN (GEQ (pat f x) (e f x)) (GEQ (t f x) (y f x)))`, REPEAT GEN_TAC THEN REWRITE_TAC[admissible; FORALL_PAIR_THM; _UNGUARDED_PATTERN] THEN REWRITE_TAC[GEQ_DEF] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(a <=> a') /\ (a /\ a' ==> (b <=> b')) ==> (a /\ b <=> a' /\ b')`) THEN ASM_MESON_TAC[]);; let ADMISSIBLE_GUARDED_PATTERN = prove (`!(<<) p s pat q e t y. admissible (<<) p s pat /\ admissible (<<) p s e /\ admissible (<<) (\f x. p f x /\ pat f x = e f x /\ q f x) s t /\ admissible (<<) (\f x. p f x /\ pat f x = e f x) s q /\ admissible (<<) (\f x. p f x /\ pat f x = e f x /\ q f x) s y ==> admissible(<<) p s (\f x:P. _GUARDED_PATTERN (GEQ (pat f x) (e f x)) (q f x) (GEQ (t f x) (y f x)))`, REPEAT GEN_TAC THEN REWRITE_TAC[admissible; FORALL_PAIR_THM; _GUARDED_PATTERN] THEN REWRITE_TAC[GEQ_DEF] THEN REPEAT STRIP_TAC THEN REPEAT(MATCH_MP_TAC(TAUT `(a <=> a') /\ (a /\ a' ==> (b <=> b')) ==> (a /\ b <=> a' /\ b')`) THEN REPEAT STRIP_TAC) THEN TRY(MATCH_MP_TAC(MESON[] `x = x' /\ y = y' ==> (x = y <=> x' = y')`)) THEN ASM_MESON_TAC[]);; let ADMISSIBLE_NSUM = prove (`!(<<) p:(B->C)->P->bool s:P->A h a b. admissible(<<) (\f (k,x). a(x) <= k /\ k <= b(x) /\ p f x) (\(k,x). s x) (\f (k,x). h f x k) ==> admissible(<<) p s (\f x. nsum(a(x)..b(x)) (h f x))`, REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_EQ_NUMSEG THEN ASM_MESON_TAC[]);; let ADMISSIBLE_SUM = prove (`!(<<) p:(B->C)->P->bool s:P->A h a b. admissible(<<) (\f (k,x). a(x) <= k /\ k <= b(x) /\ p f x) (\(k,x). s x) (\f (k,x). h f x k) ==> admissible(<<) p s (\f x. sum(a(x)..b(x)) (h f x))`, REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN ASM_MESON_TAC[]);; let ADMISSIBLE_MAP = prove (`!(<<) p s h l. admissible(<<) p s l /\ admissible (<<) (\f (y,x). p f x /\ MEM y (l f x)) (\(y,x). s x) (\f (y,x). h f x y) ==> admissible (<<) p s (\f:A->B x:P. MAP (h f x) (l f x))`, REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `x = y /\ MAP f x = MAP g x ==> MAP f x = MAP g y`) THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC MAP_EQ THEN REWRITE_TAC[GSYM ALL_MEM] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN ASM_MESON_TAC[]);; let ADMISSIBLE_MATCH_SEQPATTERN = prove (`!(<<) p s c1 c2 e. admissible(<<) p s (\f x. ?y. c1 f x (e f x) y) /\ admissible(<<) (\f x. p f x /\ ?y. c1 f x (e f x) y) s (\f x. _MATCH (e f x) (c1 f x)) /\ admissible(<<) (\f x. p f x /\ ~(?y. c1 f x (e f x) y)) s (\f x. _MATCH (e f x) (c2 f x)) ==> admissible(<<) p s (\f x:P. _MATCH (e f x) (_SEQPATTERN (c1 f x) (c2 f x)))`, REWRITE_TAC[MATCH_SEQPATTERN; ADMISSIBLE_COND]);; (* ------------------------------------------------------------------------- *) (* Superadmissible generalizations where applicable. *) (* *) (* Note that we can't take the "higher type" route in the simple theorem *) (* ADMISSIBLE_MATCH because that isn't a context where tail recursion makes *) (* sense. Instead, we use specific theorems for the two _MATCH instances. *) (* Note that also, because of some delicacy over assessing welldefinedness *) (* of patterns, a special well-formedness hypothesis crops up here. (We need *) (* to separate it from the function f or we lose the "tail" optimization.) *) (* ------------------------------------------------------------------------- *) let ADMISSIBLE_IMP_SUPERADMISSIBLE = prove (`!(<<) p s t:(A->B)->P->B. admissible(<<) p s t ==> superadmissible(<<) p s t`, REWRITE_TAC[admissible; superadmissible; tailadmissible] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`\f:A->B x:P. F`; `\f:A->B. (anything:P->A)`; `\f:A->B a:P. if p f a then t f a :B else fixed`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let SUPERADMISSIBLE_CONST = prove (`!p s c. superadmissible(<<) p s (\f. c)`, REPEAT GEN_TAC THEN MATCH_MP_TAC ADMISSIBLE_IMP_SUPERADMISSIBLE THEN REWRITE_TAC[ADMISSIBLE_CONST]);; let SUPERADMISSIBLE_TAIL = prove (`!(<<) p s t:(A->B)->P->A. admissible(<<) p s t /\ (!f a. p f a ==> !y. y << t f a ==> y << s a) ==> superadmissible(<<) p s (\f x. f(t f x))`, REWRITE_TAC[admissible; superadmissible; tailadmissible] THEN REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`\f:A->B x:P. T`; `\f:A->B a:P. if p f a then t f a :A else s a`; `\f:A->B. anything:P->B`] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let SUPERADMISSIBLE_COND = prove (`!(<<) p P s h k:(A->B)->P->B. admissible(<<) p s P /\ superadmissible(<<) (\f x. p f x /\ P f x) s h /\ superadmissible(<<) (\f x. p f x /\ ~P f x) s k ==> superadmissible(<<) p s (\f x. if P f x then h f x else k f x)`, REWRITE_TAC[superadmissible; admissible] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN CONJUNCTS_THEN MP_TAC th) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> ANTS_TAC THENL [ASM_MESON_TAC[]; MP_TAC th]) THEN REWRITE_TAC[tailadmissible] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`P1:(A->B)->P->bool`; `G1:(A->B)->P->A`; `H1:(A->B)->P->B`; `P2:(A->B)->P->bool`; `G2:(A->B)->P->A`; `H2:(A->B)->P->B`] THEN REWRITE_TAC[TAUT `(a1 /\ b1 /\ c1 ==> a2 /\ b2 /\ c2 ==> x) <=> (a1 /\ a2) /\ (b1 /\ b2) /\ (c1 /\ c2) ==> x`] THEN DISCH_THEN(fun th -> MAP_EVERY EXISTS_TAC [`\f:A->B a:P. if p f a then if P f a then P2 f a else P1 f a else F`; `\f:A->B a:P. if p f a then if P f a then G2 f a else G1 f a else z:A`; `\f:A->B a:P. if p f a then if P f a then H2 f a else H1 f a else w:B`] THEN MP_TAC th) THEN REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL [ASM_MESON_TAC[]; POP_ASSUM_LIST(MP_TAC o end_itlist CONJ); ALL_TAC] THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; let SUPERADMISSIBLE_MATCH_SEQPATTERN = prove (`!(<<) p s c1 c2 e. admissible(<<) p s (\f x. ?y. c1 f x (e f x) y) /\ superadmissible(<<) (\f x. p f x /\ ?y. c1 f x (e f x) y) s (\f x. _MATCH (e f x) (c1 f x)) /\ superadmissible(<<) (\f x. p f x /\ ~(?y. c1 f x (e f x) y)) s (\f x. _MATCH (e f x) (c2 f x)) ==> superadmissible(<<) p s (\f x:P. _MATCH (e f x) (_SEQPATTERN (c1 f x) (c2 f x)))`, REWRITE_TAC[MATCH_SEQPATTERN; SUPERADMISSIBLE_COND]);; let SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN = prove (`!(<<) p s e:P->D pat:Q->D arg. (!f a t u. p f a /\ pat t = e a /\ pat u = e a ==> arg a t = arg a u) /\ (!f a t. p f a /\ pat t = e a ==> !y. y << arg a t ==> y << s a) ==> superadmissible(<<) p s (\f:A->B x. _MATCH (e x) (\u v. ?t. _UNGUARDED_PATTERN (GEQ (pat t) u) (GEQ (f(arg x t)) v)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[superadmissible] THEN DISCH_TAC THEN REWRITE_TAC[_UNGUARDED_PATTERN; GEQ_DEF; _MATCH] THEN REWRITE_TAC[tailadmissible] THEN SUBGOAL_THEN `!f:A->B x:P. p f x ==> ((?!v. ?t:Q. pat t:D = e x /\ f(arg x t) = v) <=> ?t. pat t = e x)` (fun th -> SIMP_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`\(f:A->B) x:P. p f x /\ ?t:Q. pat t:D = e x`; `\f:A->B x:P. arg x (@t. (pat:Q->D) t = e x):A`; `\(f:A->B) x:P. (@z:B. F)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[admissible]) THEN SIMP_TAC[] THEN ASM_MESON_TAC[]);; let SUPERADMISSIBLE_MATCH_GUARDED_PATTERN = prove (`!(<<) p s e:P->D pat:Q->D q arg. (!f a t u. p f a /\ pat t = e a /\ q a t /\ pat u = e a /\ q a u ==> arg a t = arg a u) /\ (!f a t. p f a /\ q a t /\ pat t = e a ==> !y. y << arg a t ==> y << s a) ==> superadmissible(<<) p s (\f:A->B x. _MATCH (e x) (\u v. ?t. _GUARDED_PATTERN (GEQ (pat t) u) (q x t) (GEQ (f(arg x t)) v)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[superadmissible] THEN DISCH_TAC THEN REWRITE_TAC[_GUARDED_PATTERN; GEQ_DEF; _MATCH] THEN REWRITE_TAC[tailadmissible] THEN SUBGOAL_THEN `!f:A->B x:P. p f x ==> ((?!v. ?t:Q. pat t:D = e x /\ q x t /\ f(arg x t) = v) <=> ?t. pat t = e x /\ q x t)` (fun th -> SIMP_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MAP_EVERY EXISTS_TAC [`\(f:A->B) x:P. p f x /\ ?t:Q. pat t:D = e x /\ q x t`; `\f:A->B x:P. arg x (@t. (pat:Q->D) t = e x /\ q x t):A`; `\(f:A->B) x:P. (@z:B. F)`] THEN RULE_ASSUM_TAC(REWRITE_RULE[admissible]) THEN SIMP_TAC[] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Combine general WF/tail recursion theorem with casewise definitions. *) (* ------------------------------------------------------------------------- *) let WF_REC_TAIL_GENERAL' = prove (`!P G H H'. WF (<<) /\ (!f g x. (!z. z << x ==> (f z = g z)) ==> (P f x <=> P g x) /\ (G f x = G g x) /\ (H' f x = H' g x)) /\ (!f x y. P f x /\ y << G f x ==> y << x) /\ (!f x. H f x = if P f x then f(G f x) else H' f x) ==> ?f. !x. f x = H f x`, REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC WF_REC_TAIL_GENERAL THEN ASM_MESON_TAC[]);; let WF_REC_CASES = prove (`!(<<) clauses. WF((<<):A->A->bool) /\ ALL (\(s,t). ?P G H. (!f a y. P f a /\ y << G f a ==> y << s a) /\ (!f g a. (!z. z << s(a) ==> (f z = g z)) ==> (P f a = P g a) /\ (G f a = G g a) /\ (H f a = H g a)) /\ (!f a:P. t f a = if P f a then f(G f a) else H f a)) clauses ==> ?f:A->B. !x. f x = CASEWISE clauses f x`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WF_REC_TAIL_GENERAL' THEN FIRST_X_ASSUM(MP_TAC o check(is_binary "ALL" o concl)) THEN SPEC_TAC(`clauses:((P->A)#((A->B)->P->B))list`, `clauses:((P->A)#((A->B)->P->B))list`) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALL; CASEWISE; FORALL_PAIR_THM] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`\f:A->B x:A. F`; `\f:A->B. anything:A->A`; `\f:A->B x:A. @y:B. T`] THEN REWRITE_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`s:P->A`; `t:(A->B)->P->B`; `clauses:((P->A)#((A->B)->P->B))list`] THEN DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`P1:(A->B)->A->bool`; `G1:(A->B)->A->A`; `H1:(A->B)->A->B`; `P2:(A->B)->P->bool`; `G2:(A->B)->P->A`; `H2:(A->B)->P->B`] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `\f:A->B x:A. if ?y:P. s y = x then P2 f (@y. s y = x) else P1 f x:bool` THEN EXISTS_TAC `\f:A->B x:A. if ?y:P. s y = x then G2 f (@y. s y = x) else G1 f x:A` THEN EXISTS_TAC `\f:A->B x:A. if ?y:P. s y = x then H2 f (@y. s y = x) else H1 f x:B` THEN ASM_MESON_TAC[]);; let WF_REC_CASES' = prove (`!(<<) clauses. WF((<<):A->A->bool) /\ ALL (\(s,t). tailadmissible(<<) (\f a. T) s t) clauses ==> ?f:A->B. !x. f x = CASEWISE clauses f x`, REWRITE_TAC[WF_REC_CASES; tailadmissible]);; let RECURSION_CASEWISE = prove (`!clauses. (?(<<). WF(<<) /\ ALL (\(s:P->A,t). tailadmissible(<<) (\f a. T) s t) clauses) /\ (!s t s' t' f x y. MEM (s,t) clauses /\ MEM (s',t') clauses ==> (s x = s' y) ==> (t f x = t' f y)) ==> ?f:A->B. ALL (\(s,t). !x. f (s x) = t f x) clauses`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP; CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(CHOOSE_THEN (MP_TAC o MATCH_MP WF_REC_CASES')) THEN MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CASEWISE_WORKS]);; let RECURSION_CASEWISE_PAIRWISE = prove (`!clauses. (?(<<). WF (<<) /\ ALL (\(s,t). tailadmissible(<<) (\f a. T) s t) clauses) /\ ALL (\(s,t). !f x y. (s x = s y) ==> (t f x = t f y)) clauses /\ PAIRWISE (\(s,t) (s',t'). !f x y. (s x = s' y) ==> (t f x = t' f y)) clauses ==> (?f. ALL (\(s,t). !x. f (s x) = t f x) clauses)`, let lemma = prove (`!P. (!x y. P x y ==> P y x) ==> !l. (!x y. MEM x l /\ MEM y l ==> P x y) <=> ALL (\x. P x x) l /\ PAIRWISE P l`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; GSYM ALL_MEM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[PAIRWISE; MEM; GSYM ALL_MEM] THEN ASM_MESON_TAC[]) and paired_lambda = prove (`(\x. P x) = (\(a,b). P (a,b))`, REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) in let pth = REWRITE_RULE[FORALL_PAIR_THM; paired_lambda] (ISPEC `\(s,t) (s',t'). !c x:A y:A. (s x = s' y) ==> (t c x = t' c y)` lemma) in let cth = prove(lhand(concl pth),MESON_TAC[]) in REWRITE_TAC[GSYM(MATCH_MP pth cth); RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[RECURSION_CASEWISE]);; let SUPERADMISSIBLE_T = prove (`superadmissible(<<) (\f x. T) s t <=> tailadmissible(<<) (\f x. T) s t`, REWRITE_TAC[superadmissible; admissible]);; let RECURSION_SUPERADMISSIBLE = REWRITE_RULE[GSYM SUPERADMISSIBLE_T] RECURSION_CASEWISE_PAIRWISE;; (* ------------------------------------------------------------------------- *) (* The main suite of functions for justifying recursion. *) (* ------------------------------------------------------------------------- *) let instantiate_casewise_recursion, pure_prove_recursive_function_exists, prove_general_recursive_function_exists = (* ------------------------------------------------------------------------- *) (* Make some basic simplification of conjunction of welldefinedness clauses. *) (* ------------------------------------------------------------------------- *) let SIMPLIFY_WELLDEFINEDNESS_CONV = let LSYM = GEN_ALL o CONV_RULE(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) o SPEC_ALL and evensimps = prove (`((2 * m + 2 = 2 * n + 1) <=> F) /\ ((2 * m + 1 = 2 * n + 2) <=> F) /\ ((2 * m = 2 * n + 1) <=> F) /\ ((2 * m + 1 = 2 * n) <=> F) /\ ((2 * m = SUC(2 * n)) <=> F) /\ ((SUC(2 * m) = 2 * n) <=> F)`, REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH; EVEN]) in let allsimps = itlist (mk_rewrites false) [EQ_ADD_RCANCEL; EQ_ADD_LCANCEL; EQ_ADD_RCANCEL_0; EQ_ADD_LCANCEL_0; LSYM EQ_ADD_RCANCEL_0; LSYM EQ_ADD_LCANCEL_0; EQ_MULT_RCANCEL; EQ_MULT_LCANCEL; EQT_INTRO(SPEC_ALL EQ_REFL); ADD_EQ_0; LSYM ADD_EQ_0; MULT_EQ_0; LSYM MULT_EQ_0; MULT_EQ_1; LSYM MULT_EQ_1; ARITH_RULE `(m + n = 1) <=> (m = 1) /\ (n = 0) \/ (m = 0) /\ (n = 1)`; ARITH_RULE `(1 = m + n) <=> (m = 1) /\ (n = 0) \/ (m = 0) /\ (n = 1)`; evensimps; ARITH_EQ] [] and [simp1; simp2; simp3] = map MATCH_MP (CONJUNCTS (TAUT `((a <=> F) /\ (b <=> b) ==> ((a ==> b) <=> T)) /\ ((a <=> a') /\ (a' ==> (b <=> T)) ==> ((a ==> b) <=> T)) /\ ((a <=> a') /\ (a' ==> (b <=> b')) ==> ((a ==> b) <=> (a' ==> b')))`)) and false_tm = `F` and and_tm = `(/\)` and eq_refl = EQT_INTRO(SPEC_ALL EQ_REFL) in fun tm -> let net = itlist (net_of_thm false) allsimps (!basic_rectype_net) in let RECTYPE_ARITH_EQ_CONV = TOP_SWEEP_CONV(REWRITES_CONV net) THENC GEN_REWRITE_CONV DEPTH_CONV [AND_CLAUSES; OR_CLAUSES] in let SIMPLIFY_CASE_DISTINCTNESS_CLAUSE tm = let avs,bod = strip_forall tm in let ant,cons = dest_imp bod in let ath = RECTYPE_ARITH_EQ_CONV ant in let atm = rand(concl ath) in let bth = CONJ ath (if atm = false_tm then REFL cons else DISCH atm (PURE_REWRITE_CONV[eq_refl; ASSUME atm] cons)) in let cth = try simp1 bth with Failure _ -> try simp2 bth with Failure _ -> simp3 bth in itlist MK_FORALL avs cth in (DEPTH_BINOP_CONV and_tm SIMPLIFY_CASE_DISTINCTNESS_CLAUSE THENC GEN_REWRITE_CONV DEPTH_CONV [FORALL_SIMP; AND_CLAUSES]) tm in (* ------------------------------------------------------------------------- *) (* Simplify an existential question about a pattern. *) (* ------------------------------------------------------------------------- *) let EXISTS_PAT_CONV = let pth = prove (`((?y. _UNGUARDED_PATTERN (GEQ s t) (GEQ z y)) <=> s = t) /\ ((?y. _GUARDED_PATTERN (GEQ s t) g (GEQ z y)) <=> g /\ s = t)`, REWRITE_TAC[_UNGUARDED_PATTERN; _GUARDED_PATTERN; GEQ_DEF] THEN MESON_TAC[]) in let basecnv = GEN_REWRITE_CONV I [pth] and pushcnv = GEN_REWRITE_CONV I [SWAP_EXISTS_THM] in let rec EXISTS_PAT_CONV tm = ((pushcnv THENC BINDER_CONV EXISTS_PAT_CONV) ORELSEC basecnv) tm in fun tm -> if is_exists tm then EXISTS_PAT_CONV tm else failwith "EXISTS_PAT_CONV" in (* ------------------------------------------------------------------------- *) (* Hack a proforma to introduce new pairing or pattern variables. *) (* ------------------------------------------------------------------------- *) let HACK_PROFORMA,EACK_PROFORMA = let elemma0 = prove (`((!z. GEQ (f z) (g z)) <=> (!x y. GEQ (f(x,y)) (g(x,y)))) /\ ((\p. P p) = (\(x,y). P(x,y)))`, REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) and elemma1 = prove (`(!P. (!t:A->B->C#D->E. P t) <=> (!t. P (\a b (c,d). t a b d c))) /\ (!P. (!t:B->C#D->E. P t) <=> (!t. P (\b (c,d). t b d c))) /\ (!P. (!t:C#D->E. P t) <=> (!t. P (\(c,d). t d c)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [FIRST_X_ASSUM(MP_TAC o SPEC `\a b d c. (t:A->B->C#D->E) a b (c,d)`); FIRST_X_ASSUM(MP_TAC o SPEC `\b d c. (t:B->C#D->E) b (c,d)`); FIRST_X_ASSUM(MP_TAC o SPEC `\d c. (t:C#D->E) (c,d)`)] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) in let HACK_PROFORMA n th = if n <= 1 then th else let mkname i = "_P"^string_of_int i in let ty = end_itlist (fun s t -> mk_type("prod",[s;t])) (map (mk_vartype o mkname) (1--n)) in let conv i = let name = "x"^string_of_int i in let cnv = ALPHA_CONV (mk_var(name,mk_vartype(mkname i))) in fun tm -> if is_abs tm && name_of(bndvar tm) <> name then cnv tm else failwith "conv" in let convs = FIRST_CONV (map conv (1--n)) in let th1 = INST_TYPE [ty,`:P`] th in let th2 = REWRITE_RULE[FORALL_PAIR_THM] th1 in let th3 = REWRITE_RULE[elemma0; elemma1] th2 in CONV_RULE(REDEPTH_CONV convs) th3 and EACK_PROFORMA n th = if n <= 1 then th else let mkname i = "_Q"^string_of_int i in let ty = end_itlist (fun s t -> mk_type("prod",[s;t])) (map (mk_vartype o mkname) (1--n)) in let conv i = let name = "t"^string_of_int i in let cnv = ALPHA_CONV (mk_var(name,mk_vartype(mkname i))) in fun tm -> if is_abs tm && name_of(bndvar tm) <> name then cnv tm else failwith "conv" in let convs = FIRST_CONV (map conv (1--n)) in let th1 = INST_TYPE [ty,`:Q`] th in let th2 = REWRITE_RULE[EXISTS_PAIR_THM] th1 in let th3 = REWRITE_RULE[elemma1] th2 in let th4 = REWRITE_RULE[FORALL_PAIR_THM] th3 in CONV_RULE(REDEPTH_CONV convs) th4 in HACK_PROFORMA,EACK_PROFORMA in (* ------------------------------------------------------------------------- *) (* Hack and apply. *) (* ------------------------------------------------------------------------- *) let APPLY_PROFORMA_TAC th (asl,w as gl) = let vs = fst(dest_gabs(body(rand w))) in let n = 1 + length(fst(splitlist dest_pair vs)) in (MATCH_MP_TAC(HACK_PROFORMA n th) THEN BETA_TAC) gl in let is_pattern p n tm = try let f,args = strip_comb(snd(strip_exists (body(body tm)))) in is_const f && name_of f = p && length args = n with Failure _ -> false in let SIMPLIFY_MATCH_WELLDEFINED_TAC = let pth0 = MESON[] `(a /\ x = k ==> x = y ==> d) ==> (a /\ x = k /\ y = k ==> d)` and pth1 = MESON[] `(a /\ b /\ c /\ x = k ==> x = y ==> d) ==> (a /\ x = k /\ b /\ y = k /\ c ==> d)` in REPEAT GEN_TAC THEN (MATCH_MP_TAC pth1 ORELSE MATCH_MP_TAC pth0) THEN CONV_TAC(RAND_CONV SIMPLIFY_WELLDEFINEDNESS_CONV) THEN PURE_REWRITE_TAC [AND_CLAUSES; IMP_CLAUSES; OR_CLAUSES; EQ_CLAUSES; NOT_CLAUSES] in let rec headonly f tm = match tm with Comb(s,t) -> headonly f s && headonly f t && not(t = f) | Abs(x,t) -> headonly f t | _ -> true in let MAIN_ADMISS_TAC (asl,w as gl) = let had,args = strip_comb w in if not(is_const had) then failwith "ADMISS_TAC" else let f,fbod = dest_abs(last args) in let xtup,bod = dest_gabs fbod in let hop,args = strip_comb bod in match (name_of had,name_of hop) with "superadmissible","COND" -> APPLY_PROFORMA_TAC SUPERADMISSIBLE_COND gl | "superadmissible","_MATCH" when name_of(repeat rator (last args)) = "_SEQPATTERN" -> (APPLY_PROFORMA_TAC SUPERADMISSIBLE_MATCH_SEQPATTERN THEN CONV_TAC(ONCE_DEPTH_CONV EXISTS_PAT_CONV)) gl | "superadmissible","_MATCH" when is_pattern "_UNGUARDED_PATTERN" 2 (last args) -> let n = length(fst(strip_exists(body(body(last args))))) in let th = EACK_PROFORMA n SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN in (APPLY_PROFORMA_TAC th THEN CONJ_TAC THENL [SIMPLIFY_MATCH_WELLDEFINED_TAC; ALL_TAC]) gl | "superadmissible","_MATCH" when is_pattern "_GUARDED_PATTERN" 3 (last args) -> let n = length(fst(strip_exists(body(body(last args))))) in let th = EACK_PROFORMA n SUPERADMISSIBLE_MATCH_GUARDED_PATTERN in (APPLY_PROFORMA_TAC th THEN CONJ_TAC THENL [SIMPLIFY_MATCH_WELLDEFINED_TAC; ALL_TAC]) gl | "superadmissible",_ when is_comb bod && rator bod = f -> APPLY_PROFORMA_TAC SUPERADMISSIBLE_TAIL gl | "admissible","sum" -> APPLY_PROFORMA_TAC ADMISSIBLE_SUM gl | "admissible","nsum" -> APPLY_PROFORMA_TAC ADMISSIBLE_NSUM gl | "admissible","MAP" -> APPLY_PROFORMA_TAC ADMISSIBLE_MAP gl | "admissible","_MATCH" when name_of(repeat rator (last args)) = "_SEQPATTERN" -> (APPLY_PROFORMA_TAC ADMISSIBLE_MATCH_SEQPATTERN THEN CONV_TAC(ONCE_DEPTH_CONV EXISTS_PAT_CONV)) gl | "admissible","_MATCH" -> APPLY_PROFORMA_TAC ADMISSIBLE_MATCH gl | "admissible","_UNGUARDED_PATTERN" -> APPLY_PROFORMA_TAC ADMISSIBLE_UNGUARDED_PATTERN gl | "admissible","_GUARDED_PATTERN" -> APPLY_PROFORMA_TAC ADMISSIBLE_GUARDED_PATTERN gl | "admissible",_ when is_abs bod -> APPLY_PROFORMA_TAC ADMISSIBLE_LAMBDA gl | "admissible",_ when is_comb bod && rator bod = f -> if free_in f (rand bod) then APPLY_PROFORMA_TAC ADMISSIBLE_NEST gl else APPLY_PROFORMA_TAC ADMISSIBLE_BASE gl | "admissible",_ when is_comb bod && headonly f bod -> APPLY_PROFORMA_TAC ADMISSIBLE_COMB gl | _ -> failwith "MAIN_ADMISS_TAC" in let ADMISS_TAC = CONJ_TAC ORELSE MATCH_ACCEPT_TAC ADMISSIBLE_CONST ORELSE MATCH_ACCEPT_TAC SUPERADMISSIBLE_CONST ORELSE MAIN_ADMISS_TAC ORELSE MATCH_MP_TAC ADMISSIBLE_IMP_SUPERADMISSIBLE in (* ------------------------------------------------------------------------- *) (* Instantiate the casewise recursion theorem for existential claim. *) (* Also make a first attempt to simplify the distinctness clause. This may *) (* yield a theorem with just the wellfoundedness "?(<<)" assumption, or it *) (* may be that and an additional distinctness one. *) (* ------------------------------------------------------------------------- *) let instantiate_casewise_recursion = let EXPAND_PAIRED_ALL_CONV = let pth0,pth1 = (CONJ_PAIR o prove) (`(ALL (\(s,t). P s t) [a,b] <=> P a b) /\ (ALL (\(s,t). P s t) (CONS (a,b) l) <=> P a b /\ ALL (\(s,t). P s t) l)`, REWRITE_TAC[ALL]) in let conv0 = REWR_CONV pth0 and conv1 = REWR_CONV pth1 in let rec conv tm = try conv0 tm with Failure _ -> let th = conv1 tm in CONV_RULE (funpow 2 RAND_CONV conv) th in conv and LAMBDA_PAIR_CONV = let rewr1 = GEN_REWRITE_RULE I [GSYM FORALL_PAIR_THM] and rewr2 = GEN_REWRITE_CONV I [FUN_EQ_THM] in fun parms tm -> let parm = end_itlist (curry mk_pair) parms in let x,bod = dest_abs tm in let tm' = mk_gabs(parm,vsubst[parm,x] bod) in let th1 = BETA_CONV(mk_comb(tm,parm)) and th2 = GEN_BETA_CONV (mk_comb(tm',parm)) in let th3 = TRANS th1 (SYM th2) in let th4 = itlist (fun v th -> rewr1 (GEN v th)) (butlast parms) (GEN (last parms) th3) in EQ_MP (SYM(rewr2(mk_eq(tm,tm')))) th4 and FORALL_PAIR_CONV = let rule = GEN_REWRITE_RULE RAND_CONV [GSYM FORALL_PAIR_THM] in let rec depair l t = match l with [v] -> REFL t | v::vs -> rule(BINDER_CONV (depair vs) t) in fun parm parms -> let p = mk_var("P",mk_fun_ty (type_of parm) bool_ty) in let tm = list_mk_forall(parms,mk_comb(p,parm)) in GEN p (SYM(depair parms tm)) in let ELIM_LISTOPS_CONV = PURE_REWRITE_CONV[PAIRWISE; ALL; GSYM CONJ_ASSOC; AND_CLAUSES] THENC TOP_DEPTH_CONV GEN_BETA_CONV in let tuple_function_existence tm = let f,def = dest_exists tm in let domtys0,ranty0 = splitlist dest_fun_ty (type_of f) in let nargs = itlist (max o length o snd o strip_comb o lhs o snd o strip_forall) (conjuncts(snd(strip_forall def))) 0 in let domtys,midtys = chop_list nargs domtys0 in let ranty = itlist mk_fun_ty midtys ranty0 in if length domtys <= 1 then ASSUME tm else let dty = end_itlist (fun ty1 ty2 -> mk_type("prod",[ty1;ty2])) domtys in let f' = variant (frees tm) (mk_var(fst(dest_var f),mk_fun_ty dty ranty)) in let gvs = map genvar domtys in let f'' = list_mk_abs(gvs,mk_comb(f',end_itlist (curry mk_pair) gvs)) in let def' = subst [f'',f] def in let th1 = EXISTS (tm,f'') (ASSUME def') and bth = BETAS_CONV (list_mk_comb(f'',gvs)) in let th2 = GEN_REWRITE_CONV TOP_DEPTH_CONV [bth] (hd(hyp th1)) in SIMPLE_CHOOSE f' (PROVE_HYP (UNDISCH(snd(EQ_IMP_RULE th2))) th1) in let pinstantiate_casewise_recursion def = try PART_MATCH I EXISTS_REFL def with Failure _ -> let f,bod = dest_exists def in let cjs = conjuncts bod in let eqs = map (snd o strip_forall) cjs in let lefts,rights = unzip(map dest_eq eqs) in let arglists = map (snd o strip_comb) lefts in let parms0 = freesl(unions arglists) in let parms = if parms0 <> [] then parms0 else [genvar aty] in let parm = end_itlist (curry mk_pair) parms in let ss = map (fun a -> mk_gabs(parm,end_itlist (curry mk_pair) a)) arglists and ts = map (fun a -> mk_abs(f,mk_gabs(parm,a))) rights in let clauses = mk_flist(map2 (curry mk_pair) ss ts) in let pth = ISPEC clauses RECURSION_SUPERADMISSIBLE in let FIDDLE_CONV = (LAND_CONV o LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o GABS_CONV o RATOR_CONV o LAND_CONV o ABS_CONV) in let th0 = UNDISCH(CONV_RULE(FIDDLE_CONV(LAMBDA_PAIR_CONV parms)) pth) in let th1 = EQ_MP (GEN_ALPHA_CONV f (concl th0)) th0 in let rewr_forall_th = REWR_CONV(FORALL_PAIR_CONV parm parms) in let th2 = CONV_RULE (BINDER_CONV (LAND_CONV(GABS_CONV rewr_forall_th) THENC EXPAND_PAIRED_ALL_CONV)) th1 in let f2,bod2 = dest_exists(concl th2) in let ths3 = map (CONV_RULE (COMB2_CONV (funpow 2 RAND_CONV GEN_BETA_CONV) (RATOR_CONV BETA_CONV THENC GEN_BETA_CONV)) o SPEC_ALL) (CONJUNCTS(ASSUME bod2)) in let ths4 = map2 (fun th t -> let avs,tbod = strip_forall t in itlist GEN avs (PART_MATCH I th tbod)) ths3 cjs in let th5 = SIMPLE_EXISTS f (end_itlist CONJ ths4) in let th6 = PROVE_HYP th2 (SIMPLE_CHOOSE f th5) in let th7 = (RAND_CONV(COMB2_CONV (RAND_CONV (LAND_CONV (GABS_CONV(BINDER_CONV (BINDER_CONV(rewr_forall_th) THENC rewr_forall_th))))) (LAND_CONV (funpow 2 GABS_CONV(BINDER_CONV (BINDER_CONV(rewr_forall_th) THENC rewr_forall_th))))) THENC ELIM_LISTOPS_CONV) (hd(hyp th6)) in let th8 = PROVE_HYP (UNDISCH(snd(EQ_IMP_RULE th7))) th6 in let wfasm,cdasm = dest_conj(hd(hyp th8)) in let th9 = PROVE_HYP (CONJ (ASSUME wfasm) (ASSUME cdasm)) th8 in let th10 = SIMPLIFY_WELLDEFINEDNESS_CONV cdasm in let th11 = PROVE_HYP (UNDISCH(snd(EQ_IMP_RULE th10))) th9 in PROVE_HYP TRUTH th11 in fun etm -> let eth = tuple_function_existence etm in let dtm = hd(hyp eth) in let dth = pinstantiate_casewise_recursion dtm in PROVE_HYP dth eth in (* ------------------------------------------------------------------------- *) (* Justify existence assertion and try to simplify/remove side-conditions. *) (* ------------------------------------------------------------------------- *) let pure_prove_recursive_function_exists = let break_down_admissibility th1 = if hyp th1 = [] then th1 else let def = concl th1 in let f,bod = dest_exists def in let cjs = conjuncts bod in let eqs = map (snd o strip_forall) cjs in let lefts,rights = unzip(map dest_eq eqs) in let arglists = map (snd o strip_comb) lefts in let parms0 = freesl(unions arglists) in let parms = if parms0 <> [] then parms0 else [genvar aty] in let wfasm = find is_exists (hyp th1) in let ord,bod = dest_exists wfasm in let SIMP_ADMISS_TAC = REWRITE_TAC[LET_DEF; LET_END_DEF] THEN REPEAT ADMISS_TAC THEN TRY(W(fun (asl,w) -> let v = fst(dest_forall w) in X_GEN_TAC v THEN MAP_EVERY (fun v -> TRY(GEN_REWRITE_TAC I [FORALL_PAIR_THM]) THEN X_GEN_TAC v) parms THEN CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN MAP_EVERY (fun v -> SPEC_TAC(v,v)) (rev parms @ [v]))) THEN PURE_REWRITE_TAC[FORALL_SIMP] THEN W(fun (asl,w) -> MAP_EVERY (fun t -> SPEC_TAC(t,t)) (subtract (frees w) [ord])) THEN W(fun (asl,w) -> ACCEPT_TAC(ASSUME w)) in let th2 = prove(bod,SIMP_ADMISS_TAC) in let th3 = SIMPLE_EXISTS ord th2 in let allasms = hyp th3 and wfasm = lhand(concl th2) in let th4 = ASSUME(list_mk_conj(wfasm::subtract allasms [wfasm])) in let th5 = SIMPLE_CHOOSE ord (itlist PROVE_HYP (CONJUNCTS th4) th3) in PROVE_HYP th5 th1 in fun dtm -> let th = break_down_admissibility(instantiate_casewise_recursion dtm) in if concl th = dtm then th else failwith "prove_general_recursive_function_exists: sanity" in (* ------------------------------------------------------------------------- *) (* Same, but attempt to prove the wellfoundedness hyp by good guesses. *) (* ------------------------------------------------------------------------- *) let prove_general_recursive_function_exists = let prove_depth_measure_exists = let num_ty = `:num` in fun tyname -> let _,_,sth = assoc tyname (!inductive_type_store) in let ty,zty = dest_fun_ty (type_of(fst(dest_exists(snd(strip_forall(concl sth)))))) in let rth = INST_TYPE [num_ty,zty] sth in let avs,bod = strip_forall(concl rth) in let ev,cbod = dest_exists bod in let process_clause k t = let avs,eq = strip_forall t in let l,r = dest_eq eq in let fn,cargs = dest_comb l in let con,args = strip_comb cargs in let bargs = filter (fun t -> type_of t = ty) args in let r' = list_mk_binop `(+):num->num->num` (mk_small_numeral k :: map (curry mk_comb fn) bargs) in list_mk_forall(avs,mk_eq(l,r')) in let cjs = conjuncts cbod in let def = map2 process_clause (1--length cjs) cjs in prove_recursive_functions_exist sth (list_mk_conj def) in let INDUCTIVE_MEASURE_THEN tac (asl,w) = let ev,bod = dest_exists w in let ty = fst(dest_type(fst(dest_fun_ty(type_of ev)))) in let th = prove_depth_measure_exists ty in let ev',bod' = dest_exists(concl th) in let th' = INST_TYPE(type_match (type_of ev') (type_of ev) []) th in (MP_TAC th' THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN tac) (asl,w) in let CONSTANT_MEASURE_THEN = let one_tm = `1` in fun tac (asl,w) -> let ev,bod = dest_exists w in let ty = fst(dest_fun_ty(type_of ev)) in (EXISTS_TAC(mk_abs(genvar ty,one_tm)) THEN tac) (asl,w) in let GUESS_MEASURE_THEN tac = (EXISTS_TAC `\n. n + 1` THEN tac) ORELSE (INDUCTIVE_MEASURE_THEN tac) ORELSE CONSTANT_MEASURE_THEN tac in let pth_lexleft = prove (`(?r. WF(r) /\ ?s. WF(s) /\ P(\(x1,y1) (x2,y2). r x1 x2 \/ (x1 = x2) /\ s y1 y2)) ==> ?t:A#B->A#B->bool. WF(t) /\ P t`, REPEAT STRIP_TAC THEN EXISTS_TAC `\(x1:A,y1:B) (x2:A,y2:B). r x1 x2 \/ (x1 = x2) /\ s y1 y2` THEN ASM_SIMP_TAC[WF_LEX]) in let pth_lexright = prove (`(?r. WF(r) /\ ?s. WF(s) /\ P(\(x1,y1) (x2,y2). r y1 y2 \/ (y1 = y2) /\ s x1 x2)) ==> ?t:A#B->A#B->bool. WF(t) /\ P t`, REPEAT STRIP_TAC THEN EXISTS_TAC `\u:A#B v:A#B. (\(x1:B,y1:A) (x2:B,y2:A). r x1 x2 \/ (x1 = x2) /\ s y1 y2) ((\(a,b). b,a) u) ((\(a,b). b,a) v)` THEN ASM_SIMP_TAC[ISPEC `\(a,b). b,a` WF_MEASURE_GEN; WF_LEX; ETA_AX] THEN FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC) THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) in let pth_measure = prove (`(?m:A->num. P(MEASURE m)) ==> ?r:A->A->bool. WF(r) /\ P r`, MESON_TAC[WF_MEASURE]) in let rec GUESS_WF_THEN tac (asl,w) = ((MATCH_MP_TAC pth_lexleft THEN GUESS_WF_THEN (GUESS_WF_THEN tac)) ORELSE (MATCH_MP_TAC pth_lexright THEN GUESS_WF_THEN (GUESS_WF_THEN tac)) ORELSE (MATCH_MP_TAC pth_measure THEN REWRITE_TAC[MEASURE; MEASURE_LE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN GUESS_MEASURE_THEN tac)) (asl,w) in let PRE_GUESS_TAC = CONV_TAC(BINDER_CONV(DEPTH_BINOP_CONV `(/\)` (TRY_CONV SIMPLIFY_WELLDEFINEDNESS_CONV THENC TRY_CONV FORALL_UNWIND_CONV))) in let GUESS_ORDERING_TAC = let false_tm = `\x:A y:A. F` in W(fun (asl,w) -> let ty = fst(dest_fun_ty(type_of(fst(dest_exists w)))) in EXISTS_TAC(inst [ty,aty] false_tm) THEN REWRITE_TAC[WF_FALSE] THEN NO_TAC) ORELSE GUESS_WF_THEN (REWRITE_TAC[FORALL_PAIR_THM] THEN ARITH_TAC) in fun etm -> let th = pure_prove_recursive_function_exists etm in try let wtm = find is_exists (hyp th) in let wth = prove(wtm,PRE_GUESS_TAC THEN GUESS_ORDERING_TAC) in PROVE_HYP wth th with Failure _ -> th in instantiate_casewise_recursion, pure_prove_recursive_function_exists, prove_general_recursive_function_exists;; (* ------------------------------------------------------------------------- *) (* Simple "define" function. *) (* ------------------------------------------------------------------------- *) let define = let close_definition_clauses tm = let avs,bod = strip_forall tm in let cjs = conjuncts bod in let fs = try map (repeat rator o lhs o snd o strip_forall) cjs with Failure _ -> failwith "close_definition_clauses: non-equation" in if length (setify fs) <> 1 then failwith "close_definition_clauses: defining multiple functions" else let f = hd fs in if mem f avs then failwith "close_definition_clauses: fn quantified" else let do_clause t = let lvs,bod = strip_forall t in let fvs = subtract (frees(lhs bod)) (f::lvs) in SPECL fvs (ASSUME(list_mk_forall(fvs,t))) in let ths = map do_clause cjs in let ajs = map (hd o hyp) ths in let th = ASSUME(list_mk_conj ajs) in f,itlist GEN avs (itlist PROVE_HYP (CONJUNCTS th) (end_itlist CONJ ths)) in fun tm -> let tm' = snd(strip_forall tm) in try let th,th' = tryfind (fun th -> th,PART_MATCH I th tm') (!the_definitions) in if can (PART_MATCH I th') (concl th) then (warn true "Benign redefinition"; th') else failwith "" with Failure _ -> let f,th = close_definition_clauses tm in let etm = mk_exists(f,hd(hyp th)) in let th1 = prove_general_recursive_function_exists etm in let th2 = new_specification[fst(dest_var f)] th1 in let g = mk_mconst(dest_var f) in let th3 = PROVE_HYP th2 (INST [g,f] th) in the_definitions := th3::(!the_definitions); th3;; hol-light/doc-to-help.sed000066400000000000000000000017131303454263000155570ustar00rootroot00000000000000# Script to convert .doc file into a presentable ASCII form # # This is essentially a copy of an old file from the HOL88 distribution. /^\\KEYWORDS/,/^ *$/d /^\\LIBRARY/,/^ *$/d s/\\#/#/g s/\\char'136/^/g s/\\char'056/./g s/\\char'100/@/g s/{{/<<<<<>>>>>/g s/{//g s/}//g s/^{\\verb%[ ]*$/\\begin{verbatim}/g s/^%}[ ]*$/\\end{verbatim}/g /^\\DOC.*$/d /^\\TYPE/s/^\\TYPE[ ]*// /^\\BLTYPE.*$/d /^\\ELTYPE.*$/d s/^\\noindent[ ]//g /\\SYNOPSIS.*/a\ s/^\\SYNOPSIS[ ]*$/SYNOPSIS/g /\\CATEGORIES.*/a\ s/^\\CATEGORIES[ ]*$/CATEGORIES/g /\\DESCRIBE.*/a\ s/^\\DESCRIBE[ ]*$/DESCRIPTION/g /\\FAILURE.*/a\ s/^\\FAILURE[ ]*$/FAILURE CONDITIONS/g /\\EXAMPLE.*/a\ s/^\\EXAMPLE[ ]*$/EXAMPLES/g /\\USES.*/a\ s/^\\USES[ ]*$/USES/g /\\COMMENTS.*/a\ s/^\\COMMENTS[ ]*$/COMMENTS/g s/^\\SEEALSO[ ]*$/SEE ALSO/g /\\ENDDOC.*/d s/<<<<<>>>>>/}/g s/\\begin{itemize}/---------/ s/\\end{itemize}/---------/ s/\\item/ */ s/{\\em \([a-z]*\)}/*\1*/ hol-light/drule.ml000066400000000000000000000503311303454263000144140ustar00rootroot00000000000000(* ========================================================================= *) (* More sophisticated derived rules including definitions and rewriting. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "bool.ml";; (* ------------------------------------------------------------------------- *) (* Type of instantiations, with terms, types and higher-order data. *) (* ------------------------------------------------------------------------- *) type instantiation = (int * term) list * (term * term) list * (hol_type * hol_type) list;; (* ------------------------------------------------------------------------- *) (* The last recourse when all else fails! *) (* ------------------------------------------------------------------------- *) let mk_thm(asl,c) = let ax = new_axiom(itlist (curry mk_imp) (rev asl) c) in rev_itlist (fun t th -> MP th (ASSUME t)) (rev asl) ax;; (* ------------------------------------------------------------------------- *) (* Derived congruence rules; very useful things! *) (* ------------------------------------------------------------------------- *) let MK_CONJ = let andtm = `(/\)` in fun eq1 eq2 -> MK_COMB(AP_TERM andtm eq1,eq2);; let MK_DISJ = let ortm = `(\/)` in fun eq1 eq2 -> MK_COMB(AP_TERM ortm eq1,eq2);; let MK_FORALL = let atm = mk_const("!",[]) in fun v th -> AP_TERM (inst [type_of v,aty] atm) (ABS v th);; let MK_EXISTS = let atm = mk_const("?",[]) in fun v th -> AP_TERM (inst [type_of v,aty] atm) (ABS v th);; (* ------------------------------------------------------------------------- *) (* Eliminate the antecedent of a theorem using a conversion/proof rule. *) (* ------------------------------------------------------------------------- *) let MP_CONV (cnv:conv) th = let l,r = dest_imp(concl th) in let ath = cnv l in try MP th (EQT_ELIM ath) with Failure _ -> MP th ath;; (* ------------------------------------------------------------------------- *) (* Multiple beta-reduction (we use a slight variant below). *) (* ------------------------------------------------------------------------- *) let rec BETAS_CONV tm = match tm with Comb(Abs(_,_),_) -> BETA_CONV tm | Comb(Comb(_,_),_) -> (RATOR_CONV BETAS_CONV THENC BETA_CONV) tm | _ -> failwith "BETAS_CONV";; (* ------------------------------------------------------------------------- *) (* Instantiators. *) (* ------------------------------------------------------------------------- *) let (instantiate :instantiation->term->term) = let betas n tm = let args,lam = funpow n (fun (l,t) -> (rand t)::l,rator t) ([],tm) in rev_itlist (fun a l -> let v,b = dest_abs l in vsubst[a,v] b) args lam in let rec ho_betas bcs pat tm = if is_var pat || is_const pat then fail() else try let bv,bod = dest_abs tm in mk_abs(bv,ho_betas bcs (body pat) bod) with Failure _ -> let hop,args = strip_comb pat in try let n = rev_assoc hop bcs in if length args = n then betas n tm else fail() with Failure _ -> let lpat,rpat = dest_comb pat in let ltm,rtm = dest_comb tm in try let lth = ho_betas bcs lpat ltm in try let rth = ho_betas bcs rpat rtm in mk_comb(lth,rth) with Failure _ -> mk_comb(lth,rtm) with Failure _ -> let rth = ho_betas bcs rpat rtm in mk_comb(ltm,rth) in fun (bcs,tmin,tyin) tm -> let itm = if tyin = [] then tm else inst tyin tm in if tmin = [] then itm else let ttm = vsubst tmin itm in if bcs = [] then ttm else try ho_betas bcs itm ttm with Failure _ -> ttm;; let (INSTANTIATE : instantiation->thm->thm) = let rec BETAS_CONV n tm = if n = 1 then TRY_CONV BETA_CONV tm else (RATOR_CONV (BETAS_CONV (n-1)) THENC TRY_CONV BETA_CONV) tm in let rec HO_BETAS bcs pat tm = if is_var pat || is_const pat then fail() else try let bv,bod = dest_abs tm in ABS bv (HO_BETAS bcs (body pat) bod) with Failure _ -> let hop,args = strip_comb pat in try let n = rev_assoc hop bcs in if length args = n then BETAS_CONV n tm else fail() with Failure _ -> let lpat,rpat = dest_comb pat in let ltm,rtm = dest_comb tm in try let lth = HO_BETAS bcs lpat ltm in try let rth = HO_BETAS bcs rpat rtm in MK_COMB(lth,rth) with Failure _ -> AP_THM lth rtm with Failure _ -> let rth = HO_BETAS bcs rpat rtm in AP_TERM ltm rth in fun (bcs,tmin,tyin) th -> let ith = if tyin = [] then th else INST_TYPE tyin th in if tmin = [] then ith else let tth = INST tmin ith in if hyp tth = hyp th then if bcs = [] then tth else try let eth = HO_BETAS bcs (concl ith) (concl tth) in EQ_MP eth tth with Failure _ -> tth else failwith "INSTANTIATE: term || type var free in assumptions";; let (INSTANTIATE_ALL : instantiation->thm->thm) = fun ((_,tmin,tyin) as i) th -> if tmin = [] && tyin = [] then th else let hyps = hyp th in if hyps = [] then INSTANTIATE i th else let tyrel,tyiirel = if tyin = [] then [],hyps else let tvs = itlist (union o tyvars o snd) tyin [] in partition (fun tm -> let tvs' = type_vars_in_term tm in not(intersect tvs tvs' = [])) hyps in let tmrel,tmirrel = if tmin = [] then [],tyiirel else let vs = itlist (union o frees o snd) tmin [] in partition (fun tm -> let vs' = frees tm in not (intersect vs vs' = [])) tyiirel in let rhyps = union tyrel tmrel in let th1 = rev_itlist DISCH rhyps th in let th2 = INSTANTIATE i th1 in funpow (length rhyps) UNDISCH th2;; (* ------------------------------------------------------------------------- *) (* Higher order matching of terms. *) (* *) (* Note: in the event of spillover patterns, this may return false results; *) (* but there's usually an implicit check outside that the match worked *) (* anyway. A test could be put in (see if any "env" variables are left in *) (* the term after abstracting out the pattern instances) but it'd be slower. *) (* ------------------------------------------------------------------------- *) let (term_match:term list -> term -> term -> instantiation) = let safe_inserta ((y,x) as n) l = try let z = rev_assoc x l in if aconv y z then l else failwith "safe_inserta" with Failure "find" -> n::l in let safe_insert ((y,x) as n) l = try let z = rev_assoc x l in if Pervasives.compare y z = 0 then l else failwith "safe_insert" with Failure "find" -> n::l in let mk_dummy = let name = fst(dest_var(genvar aty)) in fun ty -> mk_var(name,ty) in let rec term_pmatch lconsts env vtm ctm ((insts,homs) as sofar) = match (vtm,ctm) with Var(_,_),_ -> (try let ctm' = rev_assoc vtm env in if Pervasives.compare ctm' ctm = 0 then sofar else failwith "term_pmatch" with Failure "find" -> if mem vtm lconsts then if Pervasives.compare ctm vtm = 0 then sofar else failwith "term_pmatch: can't instantiate local constant" else safe_inserta (ctm,vtm) insts,homs) | Const(vname,vty),Const(cname,cty) -> if Pervasives.compare vname cname = 0 then if Pervasives.compare vty cty = 0 then sofar else safe_insert (mk_dummy cty,mk_dummy vty) insts,homs else failwith "term_pmatch" | Abs(vv,vbod),Abs(cv,cbod) -> let sofar' = safe_insert (mk_dummy(snd(dest_var cv)),mk_dummy(snd(dest_var vv))) insts,homs in term_pmatch lconsts ((cv,vv)::env) vbod cbod sofar' | _ -> let vhop = repeat rator vtm in if is_var vhop && not (mem vhop lconsts) & not (can (rev_assoc vhop) env) then let vty = type_of vtm and cty = type_of ctm in let insts' = if Pervasives.compare vty cty = 0 then insts else safe_insert (mk_dummy cty,mk_dummy vty) insts in (insts',(env,ctm,vtm)::homs) else let lv,rv = dest_comb vtm and lc,rc = dest_comb ctm in let sofar' = term_pmatch lconsts env lv lc sofar in term_pmatch lconsts env rv rc sofar' in let get_type_insts insts = itlist (fun (t,x) -> type_match (snd(dest_var x)) (type_of t)) insts in let separate_insts insts = let realinsts,patterns = partition (is_var o snd) insts in let betacounts = if patterns = [] then [] else itlist (fun (_,p) sof -> let hop,args = strip_comb p in try safe_insert (length args,hop) sof with Failure _ -> (warn true "Inconsistent patterning in higher order match"; sof)) patterns [] in let tyins = get_type_insts realinsts [] in betacounts, mapfilter (fun (t,x) -> let x' = let xn,xty = dest_var x in mk_var(xn,type_subst tyins xty) in if Pervasives.compare t x' = 0 then fail() else (t,x')) realinsts, tyins in let rec term_homatch lconsts tyins (insts,homs) = if homs = [] then insts else let (env,ctm,vtm) = hd homs in if is_var vtm then if Pervasives.compare ctm vtm = 0 then term_homatch lconsts tyins (insts,tl homs) else let newtyins = safe_insert (type_of ctm,snd(dest_var vtm)) tyins and newinsts = (ctm,vtm)::insts in term_homatch lconsts newtyins (newinsts,tl homs) else let vhop,vargs = strip_comb vtm in let afvs = freesl vargs in let inst_fn = inst tyins in try let tmins = map (fun a -> (try rev_assoc a env with Failure _ -> try rev_assoc a insts with Failure _ -> if mem a lconsts then a else fail()), inst_fn a) afvs in let pats0 = map inst_fn vargs in let pats = map (vsubst tmins) pats0 in let vhop' = inst_fn vhop in let ni = let chop,cargs = strip_comb ctm in if Pervasives.compare cargs pats = 0 then if Pervasives.compare chop vhop = 0 then insts else safe_inserta (chop,vhop) insts else let ginsts = map (fun p -> (if is_var p then p else genvar(type_of p)),p) pats in let ctm' = subst ginsts ctm and gvs = map fst ginsts in let abstm = list_mk_abs(gvs,ctm') in let vinsts = safe_inserta (abstm,vhop) insts in let icpair = ctm',list_mk_comb(vhop',gvs) in icpair::vinsts in term_homatch lconsts tyins (ni,tl homs) with Failure _ -> let lc,rc = dest_comb ctm and lv,rv = dest_comb vtm in let pinsts_homs' = term_pmatch lconsts env rv rc (insts,(env,lc,lv)::(tl homs)) in let tyins' = get_type_insts (fst pinsts_homs') [] in term_homatch lconsts tyins' pinsts_homs' in fun lconsts vtm ctm -> let pinsts_homs = term_pmatch lconsts [] vtm ctm ([],[]) in let tyins = get_type_insts (fst pinsts_homs) [] in let insts = term_homatch lconsts tyins pinsts_homs in separate_insts insts;; (* ------------------------------------------------------------------------- *) (* First order unification (no type instantiation -- yet). *) (* ------------------------------------------------------------------------- *) let (term_unify:term list -> term -> term -> instantiation) = let augment1 sofar (s,x) = let s' = subst sofar s in if vfree_in x s && not (s = x) then failwith "augment_insts" else (s',x) in let raw_augment_insts p insts = p::(map (augment1 [p]) insts) in let augment_insts(t,v) insts = let t' = vsubst insts t in if t' = v then insts else if vfree_in v t' then failwith "augment_insts" else raw_augment_insts (t',v) insts in let rec unify vars tm1 tm2 sofar = if tm1 = tm2 then sofar else if is_var tm1 && mem tm1 vars then try let tm1' = rev_assoc tm1 sofar in unify vars tm1' tm2 sofar with Failure "find" -> augment_insts (tm2,tm1) sofar else if is_var tm2 && mem tm2 vars then try let tm2' = rev_assoc tm2 sofar in unify vars tm1 tm2' sofar with Failure "find" -> augment_insts (tm1,tm2) sofar else if is_abs tm1 then let tm1' = body tm1 and tm2' = subst [bndvar tm1,bndvar tm2] (body tm2) in unify vars tm1' tm2' sofar else let l1,r1 = dest_comb tm1 and l2,r2 = dest_comb tm2 in unify vars l1 l2 (unify vars r1 r2 sofar) in fun vars tm1 tm2 -> [],unify vars tm1 tm2 [],[];; (* ------------------------------------------------------------------------- *) (* Modify bound variable names at depth. (Not very efficient...) *) (* ------------------------------------------------------------------------- *) let deep_alpha = let tryalpha v tm = try alpha v tm with Failure _ -> try let v' = variant (frees tm) v in alpha v' tm with Failure _ -> tm in let rec deep_alpha env tm = if env = [] then tm else try let v,bod = dest_abs tm in let vn,vty = dest_var v in try let (vn',_),newenv = remove (fun (_,x) -> x = vn) env in let v' = mk_var(vn',vty) in let tm' = tryalpha v' tm in let iv,ib = dest_abs tm' in mk_abs(iv,deep_alpha newenv ib) with Failure _ -> mk_abs(v,deep_alpha env bod) with Failure _ -> try let l,r = dest_comb tm in mk_comb(deep_alpha env l,deep_alpha env r) with Failure _ -> tm in deep_alpha;; (* ------------------------------------------------------------------------- *) (* Instantiate theorem by matching part of it to a term. *) (* The GEN_PART_MATCH version renames free vars to avoid clashes. *) (* ------------------------------------------------------------------------- *) let PART_MATCH,GEN_PART_MATCH = let rec match_bvs t1 t2 acc = try let v1,b1 = dest_abs t1 and v2,b2 = dest_abs t2 in let n1 = fst(dest_var v1) and n2 = fst(dest_var v2) in let newacc = if n1 = n2 then acc else insert (n1,n2) acc in match_bvs b1 b2 newacc with Failure _ -> try let l1,r1 = dest_comb t1 and l2,r2 = dest_comb t2 in match_bvs l1 l2 (match_bvs r1 r2 acc) with Failure _ -> acc in let PART_MATCH partfn th = let sth = SPEC_ALL th in let bod = concl sth in let pbod = partfn bod in let lconsts = intersect (frees (concl th)) (freesl(hyp th)) in fun tm -> let bvms = match_bvs tm pbod [] in let abod = deep_alpha bvms bod in let ath = EQ_MP (ALPHA bod abod) sth in let insts = term_match lconsts (partfn abod) tm in let fth = INSTANTIATE insts ath in if hyp fth <> hyp ath then failwith "PART_MATCH: instantiated hyps" else let tm' = partfn (concl fth) in if Pervasives.compare tm' tm = 0 then fth else try SUBS[ALPHA tm' tm] fth with Failure _ -> failwith "PART_MATCH: Sanity check failure" and GEN_PART_MATCH partfn th = let sth = SPEC_ALL th in let bod = concl sth in let pbod = partfn bod in let lconsts = intersect (frees (concl th)) (freesl(hyp th)) in let fvs = subtract (subtract (frees bod) (frees pbod)) lconsts in fun tm -> let bvms = match_bvs tm pbod [] in let abod = deep_alpha bvms bod in let ath = EQ_MP (ALPHA bod abod) sth in let insts = term_match lconsts (partfn abod) tm in let eth = INSTANTIATE insts (GENL fvs ath) in let fth = itlist (fun v th -> snd(SPEC_VAR th)) fvs eth in if hyp fth <> hyp ath then failwith "PART_MATCH: instantiated hyps" else let tm' = partfn (concl fth) in if Pervasives.compare tm' tm = 0 then fth else try SUBS[ALPHA tm' tm] fth with Failure _ -> failwith "PART_MATCH: Sanity check failure" in PART_MATCH,GEN_PART_MATCH;; (* ------------------------------------------------------------------------- *) (* Matching modus ponens. *) (* ------------------------------------------------------------------------- *) let MATCH_MP ith = let sth = try let tm = concl ith in let avs,bod = strip_forall tm in let ant,con = dest_imp bod in let svs,pvs = partition (C vfree_in ant) avs in if pvs = [] then ith else let th1 = SPECL avs (ASSUME tm) in let th2 = GENL svs (DISCH ant (GENL pvs (UNDISCH th1))) in MP (DISCH tm th2) ith with Failure _ -> failwith "MATCH_MP: Not an implication" in let match_fun = PART_MATCH (fst o dest_imp) sth in fun th -> try MP (match_fun (concl th)) th with Failure _ -> failwith "MATCH_MP: No match";; (* ------------------------------------------------------------------------- *) (* Useful instance of more general higher order matching. *) (* ------------------------------------------------------------------------- *) let HIGHER_REWRITE_CONV = let BETA_VAR = let rec BETA_CONVS n = if n = 1 then TRY_CONV BETA_CONV else RATOR_CONV (BETA_CONVS (n - 1)) THENC TRY_CONV BETA_CONV in let rec free_beta v tm = if is_abs tm then let bv,bod = dest_abs tm in if v = bv then failwith "unchanged" else ABS_CONV(free_beta v bod) else let op,args = strip_comb tm in if args = [] then failwith "unchanged" else if op = v then BETA_CONVS (length args) else let l,r = dest_comb tm in try let lconv = free_beta v l in (try let rconv = free_beta v r in COMB2_CONV lconv rconv with Failure _ -> RATOR_CONV lconv) with Failure _ -> RAND_CONV (free_beta v r) in free_beta in let GINST th = let fvs = subtract (frees(concl th)) (freesl (hyp th)) in let gvs = map (genvar o type_of) fvs in INST (zip gvs fvs) th in fun ths -> let thl = map (GINST o SPEC_ALL) ths in let concs = map concl thl in let lefts = map lhs concs in let preds,pats = unzip(map dest_comb lefts) in let beta_fns = map2 BETA_VAR preds concs in let ass_list = zip pats (zip preds (zip thl beta_fns)) in let mnet = itlist (fun p n -> enter [] (p,p) n) pats empty_net in let look_fn t = mapfilter (fun p -> if can (term_match [] p) t then p else fail()) (lookup t mnet) in fun top tm -> let pred t = not (look_fn t = []) && free_in t tm in let stm = if top then find_term pred tm else hd(sort free_in (find_terms pred tm)) in let pat = hd(look_fn stm) in let _,tmin,tyin = term_match [] pat stm in let pred,(th,beta_fn) = assoc pat ass_list in let gv = genvar(type_of stm) in let abs = mk_abs(gv,subst[gv,stm] tm) in let _,tmin0,tyin0 = term_match [] pred abs in CONV_RULE beta_fn (INST tmin (INST tmin0 (INST_TYPE tyin0 th)));; (* ------------------------------------------------------------------------- *) (* Derived principle of definition justifying |- c x1 .. xn = t[x1,..,xn] *) (* ------------------------------------------------------------------------- *) let new_definition tm = let avs,bod = strip_forall tm in let l,r = try dest_eq bod with Failure _ -> failwith "new_definition: Not an equation" in let lv,largs = strip_comb l in let rtm = try list_mk_abs(largs,r) with Failure _ -> failwith "new_definition: Non-variable in LHS pattern" in let def = mk_eq(lv,rtm) in let th1 = new_basic_definition def in let th2 = rev_itlist (fun tm th -> let ith = AP_THM th tm in TRANS ith (BETA_CONV(rand(concl ith)))) largs th1 in let rvs = filter (not o C mem avs) largs in itlist GEN rvs (itlist GEN avs th2);; hol-light/equal.ml000066400000000000000000000301101303454263000144010ustar00rootroot00000000000000(* ========================================================================= *) (* Basic equality reasoning including conversionals. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "printer.ml";; (* ------------------------------------------------------------------------- *) (* Type abbreviation for conversions. *) (* ------------------------------------------------------------------------- *) type conv = term->thm;; (* ------------------------------------------------------------------------- *) (* A bit more syntax. *) (* ------------------------------------------------------------------------- *) let lhand = rand o rator;; let lhs = fst o dest_eq;; let rhs = snd o dest_eq;; (* ------------------------------------------------------------------------- *) (* Similar to variant, but even avoids constants, and ignores types. *) (* ------------------------------------------------------------------------- *) let mk_primed_var = let rec svariant avoid s = if mem s avoid || (can get_const_type s && not(is_hidden s)) then svariant avoid (s^"'") else s in fun avoid v -> let s,ty = dest_var v in let s' = svariant (mapfilter (fst o dest_var) avoid) s in mk_var(s',ty);; (* ------------------------------------------------------------------------- *) (* General case of beta-conversion. *) (* ------------------------------------------------------------------------- *) let BETA_CONV tm = try BETA tm with Failure _ -> try let f,arg = dest_comb tm in let v = bndvar f in INST [arg,v] (BETA (mk_comb(f,v))) with Failure _ -> failwith "BETA_CONV: Not a beta-redex";; (* ------------------------------------------------------------------------- *) (* A few very basic derived equality rules. *) (* ------------------------------------------------------------------------- *) let AP_TERM tm = let rth = REFL tm in fun th -> try MK_COMB(rth,th) with Failure _ -> failwith "AP_TERM";; let AP_THM th tm = try MK_COMB(th,REFL tm) with Failure _ -> failwith "AP_THM";; let SYM th = let tm = concl th in let l,r = dest_eq tm in let lth = REFL l in EQ_MP (MK_COMB(AP_TERM (rator (rator tm)) th,lth)) lth;; let ALPHA tm1 tm2 = try TRANS (REFL tm1) (REFL tm2) with Failure _ -> failwith "ALPHA";; let ALPHA_CONV v tm = let res = alpha v tm in ALPHA tm res;; let GEN_ALPHA_CONV v tm = if is_abs tm then ALPHA_CONV v tm else let b,abs = dest_comb tm in AP_TERM b (ALPHA_CONV v abs);; let MK_BINOP op = let afn = AP_TERM op in fun (lth,rth) -> MK_COMB(afn lth,rth);; (* ------------------------------------------------------------------------- *) (* Terminal conversion combinators. *) (* ------------------------------------------------------------------------- *) let (NO_CONV:conv) = fun tm -> failwith "NO_CONV";; let (ALL_CONV:conv) = REFL;; (* ------------------------------------------------------------------------- *) (* Combinators for sequencing, trying, repeating etc. conversions. *) (* ------------------------------------------------------------------------- *) let ((THENC):conv -> conv -> conv) = fun conv1 conv2 t -> let th1 = conv1 t in let th2 = conv2 (rand(concl th1)) in TRANS th1 th2;; let ((ORELSEC):conv -> conv -> conv) = fun conv1 conv2 t -> try conv1 t with Failure _ -> conv2 t;; let (FIRST_CONV:conv list -> conv) = end_itlist (fun c1 c2 -> c1 ORELSEC c2);; let (EVERY_CONV:conv list -> conv) = fun l -> itlist (fun c1 c2 -> c1 THENC c2) l ALL_CONV;; let REPEATC = let rec REPEATC conv t = ((conv THENC (REPEATC conv)) ORELSEC ALL_CONV) t in (REPEATC:conv->conv);; let (CHANGED_CONV:conv->conv) = fun conv tm -> let th = conv tm in let l,r = dest_eq (concl th) in if aconv l r then failwith "CHANGED_CONV" else th;; let TRY_CONV conv = conv ORELSEC ALL_CONV;; (* ------------------------------------------------------------------------- *) (* Subterm conversions. *) (* ------------------------------------------------------------------------- *) let (RATOR_CONV:conv->conv) = fun conv tm -> match tm with Comb(l,r) -> AP_THM (conv l) r | _ -> failwith "RATOR_CONV: Not a combination";; let (RAND_CONV:conv->conv) = fun conv tm -> match tm with Comb(l,r) -> MK_COMB(REFL l,conv r) | _ -> failwith "RAND_CONV: Not a combination";; let LAND_CONV = RATOR_CONV o RAND_CONV;; let (COMB2_CONV: conv->conv->conv) = fun lconv rconv tm -> match tm with Comb(l,r) -> MK_COMB(lconv l,rconv r) | _ -> failwith "COMB2_CONV: Not a combination";; let COMB_CONV = W COMB2_CONV;; let (ABS_CONV:conv->conv) = fun conv tm -> let v,bod = dest_abs tm in let th = conv bod in try ABS v th with Failure _ -> let gv = genvar(type_of v) in let gbod = vsubst[gv,v] bod in let gth = ABS gv (conv gbod) in let gtm = concl gth in let l,r = dest_eq gtm in let v' = variant (frees gtm) v in let l' = alpha v' l and r' = alpha v' r in EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth;; let BINDER_CONV conv tm = if is_abs tm then ABS_CONV conv tm else RAND_CONV(ABS_CONV conv) tm;; let SUB_CONV conv tm = match tm with Comb(_,_) -> COMB_CONV conv tm | Abs(_,_) -> ABS_CONV conv tm | _ -> REFL tm;; let BINOP_CONV conv tm = let lop,r = dest_comb tm in let op,l = dest_comb lop in MK_COMB(AP_TERM op (conv l),conv r);; (* ------------------------------------------------------------------------- *) (* Depth conversions; internal use of a failure-propagating `Boultonized' *) (* version to avoid a great deal of reuilding of terms. *) (* ------------------------------------------------------------------------- *) let (ONCE_DEPTH_CONV: conv->conv), (DEPTH_CONV: conv->conv), (REDEPTH_CONV: conv->conv), (TOP_DEPTH_CONV: conv->conv), (TOP_SWEEP_CONV: conv->conv) = let THENQC conv1 conv2 tm = try let th1 = conv1 tm in try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 with Failure _ -> th1 with Failure _ -> conv2 tm and THENCQC conv1 conv2 tm = let th1 = conv1 tm in try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 with Failure _ -> th1 and COMB_QCONV conv tm = match tm with Comb(l,r) -> (try let th1 = conv l in try let th2 = conv r in MK_COMB(th1,th2) with Failure _ -> AP_THM th1 r with Failure _ -> AP_TERM l (conv r)) | _ -> failwith "COMB_QCONV: Not a combination" in let rec REPEATQC conv tm = THENCQC conv (REPEATQC conv) tm in let SUB_QCONV conv tm = match tm with Abs(_,_) -> ABS_CONV conv tm | _ -> COMB_QCONV conv tm in let rec ONCE_DEPTH_QCONV conv tm = (conv ORELSEC (SUB_QCONV (ONCE_DEPTH_QCONV conv))) tm and DEPTH_QCONV conv tm = THENQC (SUB_QCONV (DEPTH_QCONV conv)) (REPEATQC conv) tm and REDEPTH_QCONV conv tm = THENQC (SUB_QCONV (REDEPTH_QCONV conv)) (THENCQC conv (REDEPTH_QCONV conv)) tm and TOP_DEPTH_QCONV conv tm = THENQC (REPEATQC conv) (THENCQC (SUB_QCONV (TOP_DEPTH_QCONV conv)) (THENCQC conv (TOP_DEPTH_QCONV conv))) tm and TOP_SWEEP_QCONV conv tm = THENQC (REPEATQC conv) (SUB_QCONV (TOP_SWEEP_QCONV conv)) tm in (fun c -> TRY_CONV (ONCE_DEPTH_QCONV c)), (fun c -> TRY_CONV (DEPTH_QCONV c)), (fun c -> TRY_CONV (REDEPTH_QCONV c)), (fun c -> TRY_CONV (TOP_DEPTH_QCONV c)), (fun c -> TRY_CONV (TOP_SWEEP_QCONV c));; (* ------------------------------------------------------------------------- *) (* Apply at leaves of op-tree; NB any failures at leaves cause failure. *) (* ------------------------------------------------------------------------- *) let rec DEPTH_BINOP_CONV op conv tm = match tm with Comb(Comb(op',l),r) when Pervasives.compare op' op = 0 -> let l,r = dest_binop op tm in let lth = DEPTH_BINOP_CONV op conv l and rth = DEPTH_BINOP_CONV op conv r in MK_COMB(AP_TERM op' lth,rth) | _ -> conv tm;; (* ------------------------------------------------------------------------- *) (* Follow a path. *) (* ------------------------------------------------------------------------- *) let PATH_CONV = let rec path_conv s cnv = match s with [] -> cnv | "l"::t -> RATOR_CONV (path_conv t cnv) | "r"::t -> RAND_CONV (path_conv t cnv) | _::t -> ABS_CONV (path_conv t cnv) in fun s cnv -> path_conv (explode s) cnv;; (* ------------------------------------------------------------------------- *) (* Follow a pattern *) (* ------------------------------------------------------------------------- *) let PAT_CONV = let rec PCONV xs pat conv = if mem pat xs then conv else if not(exists (fun x -> free_in x pat) xs) then ALL_CONV else if is_comb pat then COMB2_CONV (PCONV xs (rator pat) conv) (PCONV xs (rand pat) conv) else ABS_CONV (PCONV xs (body pat) conv) in fun pat -> let xs,pbod = strip_abs pat in PCONV xs pbod;; (* ------------------------------------------------------------------------- *) (* Symmetry conversion. *) (* ------------------------------------------------------------------------- *) let SYM_CONV tm = try let th1 = SYM(ASSUME tm) in let tm' = concl th1 in let th2 = SYM(ASSUME tm') in DEDUCT_ANTISYM_RULE th2 th1 with Failure _ -> failwith "SYM_CONV";; (* ------------------------------------------------------------------------- *) (* Conversion to a rule. *) (* ------------------------------------------------------------------------- *) let CONV_RULE (conv:conv) th = EQ_MP (conv(concl th)) th;; (* ------------------------------------------------------------------------- *) (* Substitution conversion. *) (* ------------------------------------------------------------------------- *) let SUBS_CONV ths tm = try if ths = [] then REFL tm else let lefts = map (lhand o concl) ths in let gvs = map (genvar o type_of) lefts in let pat = subst (zip gvs lefts) tm in let abs = list_mk_abs(gvs,pat) in let th = rev_itlist (fun y x -> CONV_RULE (RAND_CONV BETA_CONV THENC LAND_CONV BETA_CONV) (MK_COMB(x,y))) ths (REFL abs) in if rand(concl th) = tm then REFL tm else th with Failure _ -> failwith "SUBS_CONV";; (* ------------------------------------------------------------------------- *) (* Get a few rules. *) (* ------------------------------------------------------------------------- *) let BETA_RULE = CONV_RULE(REDEPTH_CONV BETA_CONV);; let GSYM = CONV_RULE(ONCE_DEPTH_CONV SYM_CONV);; let SUBS ths = CONV_RULE (SUBS_CONV ths);; (* ------------------------------------------------------------------------- *) (* A cacher for conversions. *) (* ------------------------------------------------------------------------- *) let CACHE_CONV = let ALPHA_HACK th = let tm' = lhand(concl th) in fun tm -> if tm' = tm then th else TRANS (ALPHA tm tm') th in fun conv -> let net = ref empty_net in fun tm -> try tryfind (fun f -> f tm) (lookup tm (!net)) with Failure _ -> let th = conv tm in (net := enter [] (tm,ALPHA_HACK th) (!net); th);; hol-light/fusion.ml000066400000000000000000000674651303454263000146240ustar00rootroot00000000000000(* ========================================================================= *) (* Complete HOL kernel of types, terms and theorems. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "lib.ml";; module type Hol_kernel = sig type hol_type = private Tyvar of string | Tyapp of string * hol_type list type term = private Var of string * hol_type | Const of string * hol_type | Comb of term * term | Abs of term * term type thm val types: unit -> (string * int)list val get_type_arity : string -> int val new_type : (string * int) -> unit val mk_type: (string * hol_type list) -> hol_type val mk_vartype : string -> hol_type val dest_type : hol_type -> (string * hol_type list) val dest_vartype : hol_type -> string val is_type : hol_type -> bool val is_vartype : hol_type -> bool val tyvars : hol_type -> hol_type list val type_subst : (hol_type * hol_type)list -> hol_type -> hol_type val bool_ty : hol_type val aty : hol_type val constants : unit -> (string * hol_type) list val get_const_type : string -> hol_type val new_constant : string * hol_type -> unit val type_of : term -> hol_type val alphaorder : term -> term -> int val is_var : term -> bool val is_const : term -> bool val is_abs : term -> bool val is_comb : term -> bool val mk_var : string * hol_type -> term val mk_const : string * (hol_type * hol_type) list -> term val mk_abs : term * term -> term val mk_comb : term * term -> term val dest_var : term -> string * hol_type val dest_const : term -> string * hol_type val dest_comb : term -> term * term val dest_abs : term -> term * term val frees : term -> term list val freesl : term list -> term list val freesin : term list -> term -> bool val vfree_in : term -> term -> bool val type_vars_in_term : term -> hol_type list val variant : term list -> term -> term val vsubst : (term * term) list -> term -> term val inst : (hol_type * hol_type) list -> term -> term val rand: term -> term val rator: term -> term val dest_eq: term -> term * term val dest_thm : thm -> term list * term val hyp : thm -> term list val concl : thm -> term val REFL : term -> thm val TRANS : thm -> thm -> thm val MK_COMB : thm * thm -> thm val ABS : term -> thm -> thm val BETA : term -> thm val ASSUME : term -> thm val EQ_MP : thm -> thm -> thm val DEDUCT_ANTISYM_RULE : thm -> thm -> thm val INST_TYPE : (hol_type * hol_type) list -> thm -> thm val INST : (term * term) list -> thm -> thm val axioms : unit -> thm list val new_axiom : term -> thm val definitions : unit -> thm list val new_basic_definition : term -> thm val new_basic_type_definition : string -> string * string -> thm -> thm * thm end;; (* ------------------------------------------------------------------------- *) (* This is the implementation of those primitives. *) (* ------------------------------------------------------------------------- *) module Hol : Hol_kernel = struct type hol_type = Tyvar of string | Tyapp of string * hol_type list type term = Var of string * hol_type | Const of string * hol_type | Comb of term * term | Abs of term * term type thm = Sequent of (term list * term) (* ------------------------------------------------------------------------- *) (* List of current type constants with their arities. *) (* *) (* Initially we just have the boolean type and the function space *) (* constructor. Later on we add as primitive the type of individuals. *) (* All other new types result from definitional extension. *) (* ------------------------------------------------------------------------- *) let the_type_constants = ref ["bool",0; "fun",2] (* ------------------------------------------------------------------------- *) (* Return all the defined types. *) (* ------------------------------------------------------------------------- *) let types() = !the_type_constants (* ------------------------------------------------------------------------- *) (* Lookup function for type constants. Returns arity if it succeeds. *) (* ------------------------------------------------------------------------- *) let get_type_arity s = assoc s (!the_type_constants) (* ------------------------------------------------------------------------- *) (* Declare a new type. *) (* ------------------------------------------------------------------------- *) let new_type(name,arity) = if can get_type_arity name then failwith ("new_type: type "^name^" has already been declared") else the_type_constants := (name,arity)::(!the_type_constants) (* ------------------------------------------------------------------------- *) (* Basic type constructors. *) (* ------------------------------------------------------------------------- *) let mk_type(tyop,args) = let arity = try get_type_arity tyop with Failure _ -> failwith ("mk_type: type "^tyop^" has not been defined") in if arity = length args then Tyapp(tyop,args) else failwith ("mk_type: wrong number of arguments to "^tyop) let mk_vartype v = Tyvar(v) (* ------------------------------------------------------------------------- *) (* Basic type destructors. *) (* ------------------------------------------------------------------------- *) let dest_type = function (Tyapp (s,ty)) -> s,ty | (Tyvar _) -> failwith "dest_type: type variable not a constructor" let dest_vartype = function (Tyapp(_,_)) -> failwith "dest_vartype: type constructor not a variable" | (Tyvar s) -> s (* ------------------------------------------------------------------------- *) (* Basic type discriminators. *) (* ------------------------------------------------------------------------- *) let is_type = can dest_type let is_vartype = can dest_vartype (* ------------------------------------------------------------------------- *) (* Return the type variables in a type and in a list of types. *) (* ------------------------------------------------------------------------- *) let rec tyvars = function (Tyapp(_,args)) -> itlist (union o tyvars) args [] | (Tyvar v as tv) -> [tv] (* ------------------------------------------------------------------------- *) (* Substitute types for type variables. *) (* *) (* NB: non-variables in subst list are just ignored (a check would be *) (* repeated many times), as are repetitions (first possibility is taken). *) (* ------------------------------------------------------------------------- *) let rec type_subst i ty = match ty with Tyapp(tycon,args) -> let args' = qmap (type_subst i) args in if args' == args then ty else Tyapp(tycon,args') | _ -> rev_assocd ty i ty let bool_ty = Tyapp("bool",[]) let aty = Tyvar "A" (* ------------------------------------------------------------------------- *) (* List of term constants and their types. *) (* *) (* We begin with just equality (over all types). Later, the Hilbert choice *) (* operator is added. All other new constants are defined. *) (* ------------------------------------------------------------------------- *) let the_term_constants = ref ["=",Tyapp("fun",[aty;Tyapp("fun",[aty;bool_ty])])] (* ------------------------------------------------------------------------- *) (* Return all the defined constants with generic types. *) (* ------------------------------------------------------------------------- *) let constants() = !the_term_constants (* ------------------------------------------------------------------------- *) (* Gets type of constant if it succeeds. *) (* ------------------------------------------------------------------------- *) let get_const_type s = assoc s (!the_term_constants) (* ------------------------------------------------------------------------- *) (* Declare a new constant. *) (* ------------------------------------------------------------------------- *) let new_constant(name,ty) = if can get_const_type name then failwith ("new_constant: constant "^name^" has already been declared") else the_term_constants := (name,ty)::(!the_term_constants) (* ------------------------------------------------------------------------- *) (* Finds the type of a term (assumes it is well-typed). *) (* ------------------------------------------------------------------------- *) let rec type_of tm = match tm with Var(_,ty) -> ty | Const(_,ty) -> ty | Comb(s,_) -> (match type_of s with Tyapp("fun",[dty;rty]) -> rty) | Abs(Var(_,ty),t) -> Tyapp("fun",[ty;type_of t]) (* ------------------------------------------------------------------------- *) (* Primitive discriminators. *) (* ------------------------------------------------------------------------- *) let is_var = function (Var(_,_)) -> true | _ -> false let is_const = function (Const(_,_)) -> true | _ -> false let is_abs = function (Abs(_,_)) -> true | _ -> false let is_comb = function (Comb(_,_)) -> true | _ -> false (* ------------------------------------------------------------------------- *) (* Primitive constructors. *) (* ------------------------------------------------------------------------- *) let mk_var(v,ty) = Var(v,ty) let mk_const(name,theta) = let uty = try get_const_type name with Failure _ -> failwith "mk_const: not a constant name" in Const(name,type_subst theta uty) let mk_abs(bvar,bod) = match bvar with Var(_,_) -> Abs(bvar,bod) | _ -> failwith "mk_abs: not a variable" let mk_comb(f,a) = match type_of f with Tyapp("fun",[ty;_]) when Pervasives.compare ty (type_of a) = 0 -> Comb(f,a) | _ -> failwith "mk_comb: types do not agree" (* ------------------------------------------------------------------------- *) (* Primitive destructors. *) (* ------------------------------------------------------------------------- *) let dest_var = function (Var(s,ty)) -> s,ty | _ -> failwith "dest_var: not a variable" let dest_const = function (Const(s,ty)) -> s,ty | _ -> failwith "dest_const: not a constant" let dest_comb = function (Comb(f,x)) -> f,x | _ -> failwith "dest_comb: not a combination" let dest_abs = function (Abs(v,b)) -> v,b | _ -> failwith "dest_abs: not an abstraction" (* ------------------------------------------------------------------------- *) (* Finds the variables free in a term (list of terms). *) (* ------------------------------------------------------------------------- *) let rec frees tm = match tm with Var(_,_) -> [tm] | Const(_,_) -> [] | Abs(bv,bod) -> subtract (frees bod) [bv] | Comb(s,t) -> union (frees s) (frees t) let freesl tml = itlist (union o frees) tml [] (* ------------------------------------------------------------------------- *) (* Whether all free variables in a term appear in a list. *) (* ------------------------------------------------------------------------- *) let rec freesin acc tm = match tm with Var(_,_) -> mem tm acc | Const(_,_) -> true | Abs(bv,bod) -> freesin (bv::acc) bod | Comb(s,t) -> freesin acc s && freesin acc t (* ------------------------------------------------------------------------- *) (* Whether a variable (or constant in fact) is free in a term. *) (* ------------------------------------------------------------------------- *) let rec vfree_in v tm = match tm with Abs(bv,bod) -> v <> bv && vfree_in v bod | Comb(s,t) -> vfree_in v s || vfree_in v t | _ -> Pervasives.compare tm v = 0 (* ------------------------------------------------------------------------- *) (* Finds the type variables (free) in a term. *) (* ------------------------------------------------------------------------- *) let rec type_vars_in_term tm = match tm with Var(_,ty) -> tyvars ty | Const(_,ty) -> tyvars ty | Comb(s,t) -> union (type_vars_in_term s) (type_vars_in_term t) | Abs(Var(_,ty),t) -> union (tyvars ty) (type_vars_in_term t) (* ------------------------------------------------------------------------- *) (* For name-carrying syntax, we need this early. *) (* ------------------------------------------------------------------------- *) let rec variant avoid v = if not(exists (vfree_in v) avoid) then v else match v with Var(s,ty) -> variant avoid (Var(s^"'",ty)) | _ -> failwith "variant: not a variable" (* ------------------------------------------------------------------------- *) (* Substitution primitive (substitution for variables only!) *) (* ------------------------------------------------------------------------- *) let vsubst = let rec vsubst ilist tm = match tm with Var(_,_) -> rev_assocd tm ilist tm | Const(_,_) -> tm | Comb(s,t) -> let s' = vsubst ilist s and t' = vsubst ilist t in if s' == s && t' == t then tm else Comb(s',t') | Abs(v,s) -> let ilist' = filter (fun (t,x) -> x <> v) ilist in if ilist' = [] then tm else let s' = vsubst ilist' s in if s' == s then tm else if exists (fun (t,x) -> vfree_in v t && vfree_in x s) ilist' then let v' = variant [s'] v in Abs(v',vsubst ((v',v)::ilist') s) else Abs(v,s') in fun theta -> if theta = [] then (fun tm -> tm) else if forall (function (t,Var(_,y)) -> Pervasives.compare (type_of t) y = 0 | _ -> false) theta then vsubst theta else failwith "vsubst: Bad substitution list" (* ------------------------------------------------------------------------- *) (* Type instantiation primitive. *) (* ------------------------------------------------------------------------- *) exception Clash of term let inst = let rec inst env tyin tm = match tm with Var(n,ty) -> let ty' = type_subst tyin ty in let tm' = if ty' == ty then tm else Var(n,ty') in if Pervasives.compare (rev_assocd tm' env tm) tm = 0 then tm' else raise (Clash tm') | Const(c,ty) -> let ty' = type_subst tyin ty in if ty' == ty then tm else Const(c,ty') | Comb(f,x) -> let f' = inst env tyin f and x' = inst env tyin x in if f' == f && x' == x then tm else Comb(f',x') | Abs(y,t) -> let y' = inst [] tyin y in let env' = (y,y')::env in try let t' = inst env' tyin t in if y' == y && t' == t then tm else Abs(y',t') with (Clash(w') as ex) -> if w' <> y' then raise ex else let ifrees = map (inst [] tyin) (frees t) in let y'' = variant ifrees y' in let z = Var(fst(dest_var y''),snd(dest_var y)) in inst env tyin (Abs(z,vsubst[z,y] t)) in fun tyin -> if tyin = [] then fun tm -> tm else inst [] tyin (* ------------------------------------------------------------------------- *) (* A few bits of general derived syntax. *) (* ------------------------------------------------------------------------- *) let rator tm = match tm with Comb(l,r) -> l | _ -> failwith "rator: Not a combination" let rand tm = match tm with Comb(l,r) -> r | _ -> failwith "rand: Not a combination" (* ------------------------------------------------------------------------- *) (* Syntax operations for equations. *) (* ------------------------------------------------------------------------- *) let safe_mk_eq l r = let ty = type_of l in Comb(Comb(Const("=",Tyapp("fun",[ty;Tyapp("fun",[ty;bool_ty])])),l),r) let dest_eq tm = match tm with Comb(Comb(Const("=",_),l),r) -> l,r | _ -> failwith "dest_eq" (* ------------------------------------------------------------------------- *) (* Useful to have term union modulo alpha-conversion for assumption lists. *) (* ------------------------------------------------------------------------- *) let rec ordav env x1 x2 = match env with [] -> Pervasives.compare x1 x2 | (t1,t2)::oenv -> if Pervasives.compare x1 t1 = 0 then if Pervasives.compare x2 t2 = 0 then 0 else -1 else if Pervasives.compare x2 t2 = 0 then 1 else ordav oenv x1 x2 let rec orda env tm1 tm2 = if tm1 == tm2 && forall (fun (x,y) -> x = y) env then 0 else match (tm1,tm2) with Var(x1,ty1),Var(x2,ty2) -> ordav env tm1 tm2 | Const(x1,ty1),Const(x2,ty2) -> Pervasives.compare tm1 tm2 | Comb(s1,t1),Comb(s2,t2) -> let c = orda env s1 s2 in if c <> 0 then c else orda env t1 t2 | Abs(Var(_,ty1) as x1,t1),Abs(Var(_,ty2) as x2,t2) -> let c = Pervasives.compare ty1 ty2 in if c <> 0 then c else orda ((x1,x2)::env) t1 t2 | Const(_,_),_ -> -1 | _,Const(_,_) -> 1 | Var(_,_),_ -> -1 | _,Var(_,_) -> 1 | Comb(_,_),_ -> -1 | _,Comb(_,_) -> 1 let alphaorder = orda [] let rec term_union l1 l2 = match (l1,l2) with ([],l2) -> l2 | (l1,[]) -> l1 | (h1::t1,h2::t2) -> let c = alphaorder h1 h2 in if c = 0 then h1::(term_union t1 t2) else if c < 0 then h1::(term_union t1 l2) else h2::(term_union l1 t2) let rec term_remove t l = match l with s::ss -> let c = alphaorder t s in if c > 0 then let ss' = term_remove t ss in if ss' == ss then l else s::ss' else if c = 0 then ss else l | [] -> l let rec term_image f l = match l with h::t -> let h' = f h and t' = term_image f t in if h' == h && t' == t then l else term_union [h'] t' | [] -> l (* ------------------------------------------------------------------------- *) (* Basic theorem destructors. *) (* ------------------------------------------------------------------------- *) let dest_thm (Sequent(asl,c)) = (asl,c) let hyp (Sequent(asl,c)) = asl let concl (Sequent(asl,c)) = c (* ------------------------------------------------------------------------- *) (* Basic equality properties; TRANS is derivable but included for efficiency *) (* ------------------------------------------------------------------------- *) let REFL tm = Sequent([],safe_mk_eq tm tm) let TRANS (Sequent(asl1,c1)) (Sequent(asl2,c2)) = match (c1,c2) with Comb((Comb(Const("=",_),_) as eql),m1),Comb(Comb(Const("=",_),m2),r) when alphaorder m1 m2 = 0 -> Sequent(term_union asl1 asl2,Comb(eql,r)) | _ -> failwith "TRANS" (* ------------------------------------------------------------------------- *) (* Congruence properties of equality. *) (* ------------------------------------------------------------------------- *) let MK_COMB(Sequent(asl1,c1),Sequent(asl2,c2)) = match (c1,c2) with Comb(Comb(Const("=",_),l1),r1),Comb(Comb(Const("=",_),l2),r2) -> (match type_of r1 with Tyapp("fun",[ty;_]) when Pervasives.compare ty (type_of r2) = 0 -> Sequent(term_union asl1 asl2, safe_mk_eq (Comb(l1,l2)) (Comb(r1,r2))) | _ -> failwith "MK_COMB: types do not agree") | _ -> failwith "MK_COMB: not both equations" let ABS v (Sequent(asl,c)) = match (v,c) with Var(_,_),Comb(Comb(Const("=",_),l),r) when not(exists (vfree_in v) asl) -> Sequent(asl,safe_mk_eq (Abs(v,l)) (Abs(v,r))) | _ -> failwith "ABS";; (* ------------------------------------------------------------------------- *) (* Trivial case of lambda calculus beta-conversion. *) (* ------------------------------------------------------------------------- *) let BETA tm = match tm with Comb(Abs(v,bod),arg) when Pervasives.compare arg v = 0 -> Sequent([],safe_mk_eq tm bod) | _ -> failwith "BETA: not a trivial beta-redex" (* ------------------------------------------------------------------------- *) (* Rules connected with deduction. *) (* ------------------------------------------------------------------------- *) let ASSUME tm = if Pervasives.compare (type_of tm) bool_ty = 0 then Sequent([tm],tm) else failwith "ASSUME: not a proposition" let EQ_MP (Sequent(asl1,eq)) (Sequent(asl2,c)) = match eq with Comb(Comb(Const("=",_),l),r) when alphaorder l c = 0 -> Sequent(term_union asl1 asl2,r) | _ -> failwith "EQ_MP" let DEDUCT_ANTISYM_RULE (Sequent(asl1,c1)) (Sequent(asl2,c2)) = let asl1' = term_remove c2 asl1 and asl2' = term_remove c1 asl2 in Sequent(term_union asl1' asl2',safe_mk_eq c1 c2) (* ------------------------------------------------------------------------- *) (* Type and term instantiation. *) (* ------------------------------------------------------------------------- *) let INST_TYPE theta (Sequent(asl,c)) = let inst_fn = inst theta in Sequent(term_image inst_fn asl,inst_fn c) let INST theta (Sequent(asl,c)) = let inst_fun = vsubst theta in Sequent(term_image inst_fun asl,inst_fun c) (* ------------------------------------------------------------------------- *) (* Handling of axioms. *) (* ------------------------------------------------------------------------- *) let the_axioms = ref ([]:thm list) let axioms() = !the_axioms let new_axiom tm = if Pervasives.compare (type_of tm) bool_ty = 0 then let th = Sequent([],tm) in (the_axioms := th::(!the_axioms); th) else failwith "new_axiom: Not a proposition" (* ------------------------------------------------------------------------- *) (* Handling of (term) definitions. *) (* ------------------------------------------------------------------------- *) let the_definitions = ref ([]:thm list) let definitions() = !the_definitions let new_basic_definition tm = match tm with Comb(Comb(Const("=",_),Var(cname,ty)),r) -> if not(freesin [] r) then failwith "new_definition: term not closed" else if not (subset (type_vars_in_term r) (tyvars ty)) then failwith "new_definition: Type variables not reflected in constant" else let c = new_constant(cname,ty); Const(cname,ty) in let dth = Sequent([],safe_mk_eq c r) in the_definitions := dth::(!the_definitions); dth | _ -> failwith "new_basic_definition" (* ------------------------------------------------------------------------- *) (* Handling of type definitions. *) (* *) (* This function now involves no logical constants beyond equality. *) (* *) (* |- P t *) (* --------------------------- *) (* |- abs(rep a) = a *) (* |- P r = (rep(abs r) = r) *) (* *) (* Where "abs" and "rep" are new constants with the nominated names. *) (* ------------------------------------------------------------------------- *) let new_basic_type_definition tyname (absname,repname) (Sequent(asl,c)) = if exists (can get_const_type) [absname; repname] then failwith "new_basic_type_definition: Constant(s) already in use" else if not (asl = []) then failwith "new_basic_type_definition: Assumptions in theorem" else let P,x = try dest_comb c with Failure _ -> failwith "new_basic_type_definition: Not a combination" in if not(freesin [] P) then failwith "new_basic_type_definition: Predicate is not closed" else let tyvars = sort (<=) (type_vars_in_term P) in let _ = try new_type(tyname,length tyvars) with Failure _ -> failwith "new_basic_type_definition: Type already defined" in let aty = Tyapp(tyname,tyvars) and rty = type_of x in let absty = Tyapp("fun",[rty;aty]) and repty = Tyapp("fun",[aty;rty]) in let abs = (new_constant(absname,absty); Const(absname,absty)) and rep = (new_constant(repname,repty); Const(repname,repty)) in let a = Var("a",aty) and r = Var("r",rty) in Sequent([],safe_mk_eq (Comb(abs,mk_comb(rep,a))) a), Sequent([],safe_mk_eq (Comb(P,r)) (safe_mk_eq (mk_comb(rep,mk_comb(abs,r))) r)) end;; include Hol;; (* ------------------------------------------------------------------------- *) (* Stuff that didn't seem worth putting in. *) (* ------------------------------------------------------------------------- *) let mk_fun_ty ty1 ty2 = mk_type("fun",[ty1; ty2]);; let bty = mk_vartype "B";; let is_eq tm = match tm with Comb(Comb(Const("=",_),_),_) -> true | _ -> false;; let mk_eq = let eq = mk_const("=",[]) in fun (l,r) -> try let ty = type_of l in let eq_tm = inst [ty,aty] eq in mk_comb(mk_comb(eq_tm,l),r) with Failure _ -> failwith "mk_eq";; (* ------------------------------------------------------------------------- *) (* Tests for alpha-convertibility (equality ignoring names in abstractions). *) (* ------------------------------------------------------------------------- *) let aconv s t = alphaorder s t = 0;; (* ------------------------------------------------------------------------- *) (* Comparison function on theorems. Currently the same as equality, but *) (* it's useful to separate because in the proof-recording version it isn't. *) (* ------------------------------------------------------------------------- *) let equals_thm th th' = dest_thm th = dest_thm th';; hol-light/grobner.ml000066400000000000000000000765601303454263000147530ustar00rootroot00000000000000(* ========================================================================= *) (* Generic Grobner basis algorithm. *) (* *) (* Whatever the instantiation, it basically solves the universal theory of *) (* the complex numbers, or equivalently something like the theory of all *) (* commutative cancellation semirings with no nilpotent elements and having *) (* characteristic zero. We could do "all rings" by a more elaborate integer *) (* version of Grobner bases, but I don't have any useful applications. *) (* *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "normalizer.ml";; (* ------------------------------------------------------------------------- *) (* Type for recording history, i.e. how a polynomial was obtained. *) (* ------------------------------------------------------------------------- *) type history = Start of int | Mmul of (num * (int list)) * history | Add of history * history;; (* ------------------------------------------------------------------------- *) (* Overall function; everything else is local. *) (* ------------------------------------------------------------------------- *) let RING_AND_IDEAL_CONV = (* ----------------------------------------------------------------------- *) (* Monomial ordering. *) (* ----------------------------------------------------------------------- *) let morder_lt = let rec lexorder l1 l2 = match (l1,l2) with [],[] -> false | (x1::o1,x2::o2) -> x1 > x2 || x1 = x2 && lexorder o1 o2 | _ -> failwith "morder: inconsistent monomial lengths" in fun m1 m2 -> let n1 = itlist (+) m1 0 and n2 = itlist (+) m2 0 in n1 < n2 || n1 = n2 && lexorder m1 m2 in (* ----------------------------------------------------------------------- *) (* Arithmetic on canonical polynomials. *) (* ----------------------------------------------------------------------- *) let grob_neg = map (fun (c,m) -> (minus_num c,m)) in let rec grob_add l1 l2 = match (l1,l2) with ([],l2) -> l2 | (l1,[]) -> l1 | ((c1,m1)::o1,(c2,m2)::o2) -> if m1 = m2 then let c = c1+/c2 and rest = grob_add o1 o2 in if c =/ num_0 then rest else (c,m1)::rest else if morder_lt m2 m1 then (c1,m1)::(grob_add o1 l2) else (c2,m2)::(grob_add l1 o2) in let grob_sub l1 l2 = grob_add l1 (grob_neg l2) in let grob_mmul (c1,m1) (c2,m2) = (c1*/c2,map2 (+) m1 m2) in let rec grob_cmul cm pol = map (grob_mmul cm) pol in let rec grob_mul l1 l2 = match l1 with [] -> [] | (h1::t1) -> grob_add (grob_cmul h1 l2) (grob_mul t1 l2) in let grob_inv l = match l with [c,vs] when forall (fun x -> x = 0) vs -> if c =/ num_0 then failwith "grob_inv: division by zero" else [num_1 // c,vs] | _ -> failwith "grob_inv: non-constant divisor polynomial" in let grob_div l1 l2 = match l2 with [c,l] when forall (fun x -> x = 0) l -> if c =/ num_0 then failwith "grob_div: division by zero" else grob_cmul (num_1 // c,l) l1 | _ -> failwith "grob_div: non-constant divisor polynomial" in let rec grob_pow vars l n = if n < 0 then failwith "grob_pow: negative power" else if n = 0 then [num_1,map (fun v -> 0) vars] else grob_mul l (grob_pow vars l (n - 1)) in (* ----------------------------------------------------------------------- *) (* Monomial division operation. *) (* ----------------------------------------------------------------------- *) let mdiv (c1,m1) (c2,m2) = (c1//c2, map2 (fun n1 n2 -> if n1 < n2 then failwith "mdiv" else n1-n2) m1 m2) in (* ----------------------------------------------------------------------- *) (* Lowest common multiple of two monomials. *) (* ----------------------------------------------------------------------- *) let mlcm (c1,m1) (c2,m2) = (num_1,map2 max m1 m2) in (* ----------------------------------------------------------------------- *) (* Reduce monomial cm by polynomial pol, returning replacement for cm. *) (* ----------------------------------------------------------------------- *) let reduce1 cm (pol,hpol) = match pol with [] -> failwith "reduce1" | cm1::cms -> try let (c,m) = mdiv cm cm1 in (grob_cmul (minus_num c,m) cms, Mmul((minus_num c,m),hpol)) with Failure _ -> failwith "reduce1" in (* ----------------------------------------------------------------------- *) (* Try this for all polynomials in a basis. *) (* ----------------------------------------------------------------------- *) let reduceb cm basis = tryfind (fun p -> reduce1 cm p) basis in (* ----------------------------------------------------------------------- *) (* Reduction of a polynomial (always picking largest monomial possible). *) (* ----------------------------------------------------------------------- *) let rec reduce basis (pol,hist) = match pol with [] -> (pol,hist) | cm::ptl -> try let q,hnew = reduceb cm basis in reduce basis (grob_add q ptl,Add(hnew,hist)) with Failure _ -> let q,hist' = reduce basis (ptl,hist) in cm::q,hist' in (* ----------------------------------------------------------------------- *) (* Check for orthogonality w.r.t. LCM. *) (* ----------------------------------------------------------------------- *) let orthogonal l p1 p2 = snd l = snd(grob_mmul (hd p1) (hd p2)) in (* ----------------------------------------------------------------------- *) (* Compute S-polynomial of two polynomials. *) (* ----------------------------------------------------------------------- *) let spoly cm ph1 ph2 = match (ph1,ph2) with ([],h),p -> ([],h) | p,([],h) -> ([],h) | (cm1::ptl1,his1),(cm2::ptl2,his2) -> (grob_sub (grob_cmul (mdiv cm cm1) ptl1) (grob_cmul (mdiv cm cm2) ptl2), Add(Mmul(mdiv cm cm1,his1), Mmul(mdiv (minus_num(fst cm),snd cm) cm2,his2))) in (* ----------------------------------------------------------------------- *) (* Make a polynomial monic. *) (* ----------------------------------------------------------------------- *) let monic (pol,hist) = if pol = [] then (pol,hist) else let c',m' = hd pol in (map (fun (c,m) -> (c//c',m)) pol, Mmul((num_1 // c',map (K 0) m'),hist)) in (* ----------------------------------------------------------------------- *) (* The most popular heuristic is to order critical pairs by LCM monomial. *) (* ----------------------------------------------------------------------- *) let forder ((c1,m1),_) ((c2,m2),_) = morder_lt m1 m2 in (* ----------------------------------------------------------------------- *) (* Stupid stuff forced on us by lack of equality test on num type. *) (* ----------------------------------------------------------------------- *) let rec poly_lt p q = match (p,q) with p,[] -> false | [],q -> true | (c1,m1)::o1,(c2,m2)::o2 -> c1 c1 =/ c2 && m1 = m2) p1 p2 in let memx ((p1,h1),(p2,h2)) ppairs = not (exists (fun ((q1,_),(q2,_)) -> poly_eq p1 q1 && poly_eq p2 q2) ppairs) in (* ----------------------------------------------------------------------- *) (* Buchberger's second criterion. *) (* ----------------------------------------------------------------------- *) let criterion2 basis (lcm,((p1,h1),(p2,h2))) opairs = exists (fun g -> not(poly_eq (fst g) p1) && not(poly_eq (fst g) p2) & can (mdiv lcm) (hd(fst g)) & not(memx (align(g,(p1,h1))) (map snd opairs)) & not(memx (align(g,(p2,h2))) (map snd opairs))) basis in (* ----------------------------------------------------------------------- *) (* Test for hitting constant polynomial. *) (* ----------------------------------------------------------------------- *) let constant_poly p = length p = 1 && forall ((=) 0) (snd(hd p)) in (* ----------------------------------------------------------------------- *) (* Grobner basis algorithm. *) (* ----------------------------------------------------------------------- *) let rec grobner_basis basis pairs = Format.print_string(string_of_int(length basis)^" basis elements and "^ string_of_int(length pairs)^" critical pairs"); Format.print_newline(); match pairs with [] -> basis | (l,(p1,p2))::opairs -> let (sp,hist as sph) = monic (reduce basis (spoly l p1 p2)) in if sp = [] || criterion2 basis (l,(p1,p2)) opairs then grobner_basis basis opairs else if constant_poly sp then grobner_basis (sph::basis) [] else let rawcps = map (fun p -> mlcm (hd(fst p)) (hd sp),align(p,sph)) basis in let newcps = filter (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) rawcps in grobner_basis (sph::basis) (merge forder opairs (mergesort forder newcps)) in (* ----------------------------------------------------------------------- *) (* Interreduce initial polynomials. *) (* ----------------------------------------------------------------------- *) let rec grobner_interreduce rpols ipols = match ipols with [] -> map monic (rev rpols) | p::ps -> let p' = reduce (rpols @ ps) p in if fst p' = [] then grobner_interreduce rpols ps else grobner_interreduce (p'::rpols) ps in (* ----------------------------------------------------------------------- *) (* Overall function. *) (* ----------------------------------------------------------------------- *) let grobner pols = let npols = map2 (fun p n -> p,Start n) pols (0--(length pols - 1)) in let phists = filter (fun (p,_) -> p <> []) npols in let bas = grobner_interreduce [] (map monic phists) in let prs0 = allpairs (fun x y -> x,y) bas bas in let prs1 = filter (fun ((x,_),(y,_)) -> poly_lt x y) prs0 in let prs2 = map (fun (p,q) -> mlcm (hd(fst p)) (hd(fst q)),(p,q)) prs1 in let prs3 = filter (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) prs2 in grobner_basis bas (mergesort forder prs3) in (* ----------------------------------------------------------------------- *) (* Get proof of contradiction from Grobner basis. *) (* ----------------------------------------------------------------------- *) let grobner_refute pols = let gb = grobner pols in snd(find (fun (p,h) -> length p = 1 && forall ((=)0) (snd(hd p))) gb) in (* ----------------------------------------------------------------------- *) (* Turn proof into a certificate as sum of multipliers. *) (* *) (* In principle this is very inefficient: in a heavily shared proof it may *) (* make the same calculation many times. Could add a cache or something. *) (* ----------------------------------------------------------------------- *) let rec resolve_proof vars prf = match prf with Start(-1) -> [] | Start m -> [m,[num_1,map (K 0) vars]] | Mmul(pol,lin) -> let lis = resolve_proof vars lin in map (fun (n,p) -> n,grob_cmul pol p) lis | Add(lin1,lin2) -> let lis1 = resolve_proof vars lin1 and lis2 = resolve_proof vars lin2 in let dom = setify(union (map fst lis1) (map fst lis2)) in map (fun n -> let a = try assoc n lis1 with Failure _ -> [] and b = try assoc n lis2 with Failure _ -> [] in n,grob_add a b) dom in (* ----------------------------------------------------------------------- *) (* Run the procedure and produce Weak Nullstellensatz certificate. *) (* ----------------------------------------------------------------------- *) let grobner_weak vars pols = let cert = resolve_proof vars (grobner_refute pols) in let l = itlist (itlist (lcm_num o denominator o fst) o snd) cert (num_1) in l,map (fun (i,p) -> i,map (fun (d,m) -> (l*/d,m)) p) cert in (* ----------------------------------------------------------------------- *) (* Prove polynomial is in ideal generated by others, using Grobner basis. *) (* ----------------------------------------------------------------------- *) let grobner_ideal vars pols pol = let pol',h = reduce (grobner pols) (grob_neg pol,Start(-1)) in if pol' <> [] then failwith "grobner_ideal: not in the ideal" else resolve_proof vars h in (* ----------------------------------------------------------------------- *) (* Produce Strong Nullstellensatz certificate for a power of pol. *) (* ----------------------------------------------------------------------- *) let grobner_strong vars pols pol = if pol = [] then 1,num_1,[] else let vars' = (concl TRUTH)::vars in let grob_z = [num_1,1::(map (fun x -> 0) vars)] and grob_1 = [num_1,(map (fun x -> 0) vars')] and augment = map (fun (c,m) -> (c,0::m)) in let pols' = map augment pols and pol' = augment pol in let allpols = (grob_sub (grob_mul grob_z pol') grob_1)::pols' in let l,cert = grobner_weak vars' allpols in let d = itlist (itlist (max o hd o snd) o snd) cert 0 in let transform_monomial (c,m) = grob_cmul (c,tl m) (grob_pow vars pol (d - hd m)) in let transform_polynomial q = itlist (grob_add o transform_monomial) q [] in let cert' = map (fun (c,q) -> c-1,transform_polynomial q) (filter (fun (k,_) -> k <> 0) cert) in d,l,cert' in (* ----------------------------------------------------------------------- *) (* Overall parametrized universal procedure for (semi)rings. *) (* We return an IDEAL_CONV and the actual ring prover. *) (* ----------------------------------------------------------------------- *) let pth_step = prove (`!(add:A->A->A) (mul:A->A->A) (n0:A). (!x. mul n0 x = n0) /\ (!x y z. (add x y = add x z) <=> (y = z)) /\ (!w x y z. (add (mul w y) (mul x z) = add (mul w z) (mul x y)) <=> (w = x) \/ (y = z)) ==> (!a b c d. ~(a = b) /\ ~(c = d) <=> ~(add (mul a c) (mul b d) = add (mul a d) (mul b c))) /\ (!n a b c d. ~(n = n0) ==> (a = b) /\ ~(c = d) ==> ~(add a (mul n c) = add b (mul n d)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM DE_MORGAN_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n0:A`; `n:A`; `d:A`; `c:A`]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_SIMP_TAC[]) and FINAL_RULE = MATCH_MP(TAUT `(p ==> F) ==> (~q = p) ==> q`) and false_tm = `F` in let rec refute_disj rfn tm = match tm with Comb(Comb(Const("\\/",_),l),r) -> DISJ_CASES (ASSUME tm) (refute_disj rfn l) (refute_disj rfn r) | _ -> rfn tm in fun (ring_dest_const,ring_mk_const,RING_EQ_CONV, ring_neg_tm,ring_add_tm,ring_sub_tm, ring_inv_tm,ring_mul_tm,ring_div_tm,ring_pow_tm, RING_INTEGRAL,RABINOWITSCH_THM,RING_NORMALIZE_CONV) -> let INITIAL_CONV = TOP_DEPTH_CONV BETA_CONV THENC PRESIMP_CONV THENC CONDS_ELIM_CONV THENC NNF_CONV THENC (if is_iff(snd(strip_forall(concl RABINOWITSCH_THM))) then GEN_REWRITE_CONV ONCE_DEPTH_CONV [RABINOWITSCH_THM] else ALL_CONV) THENC GEN_REWRITE_CONV REDEPTH_CONV [AND_FORALL_THM; LEFT_AND_FORALL_THM; RIGHT_AND_FORALL_THM; LEFT_OR_FORALL_THM; RIGHT_OR_FORALL_THM; OR_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] in let ring_dest_neg t = let l,r = dest_comb t in if l = ring_neg_tm then r else failwith "ring_dest_neg" and ring_dest_inv t = let l,r = dest_comb t in if l = ring_inv_tm then r else failwith "ring_dest_inv" and ring_dest_add = dest_binop ring_add_tm and ring_mk_add = mk_binop ring_add_tm and ring_dest_sub = dest_binop ring_sub_tm and ring_dest_mul = dest_binop ring_mul_tm and ring_mk_mul = mk_binop ring_mul_tm and ring_dest_div = dest_binop ring_div_tm and ring_dest_pow = dest_binop ring_pow_tm and ring_mk_pow = mk_binop ring_pow_tm in let rec grobvars tm acc = if can ring_dest_const tm then acc else if can ring_dest_neg tm then grobvars (rand tm) acc else if can ring_dest_pow tm && is_numeral (rand tm) then grobvars (lhand tm) acc else if can ring_dest_add tm || can ring_dest_sub tm || can ring_dest_mul tm then grobvars (lhand tm) (grobvars (rand tm) acc) else if can ring_dest_inv tm then let gvs = grobvars (rand tm) [] in if gvs = [] then acc else tm::acc else if can ring_dest_div tm then let lvs = grobvars (lhand tm) acc and gvs = grobvars (rand tm) [] in if gvs = [] then lvs else tm::acc else tm::acc in let rec grobify_term vars tm = try if not(mem tm vars) then failwith "" else [num_1,map (fun i -> if i = tm then 1 else 0) vars] with Failure _ -> try let x = ring_dest_const tm in if x =/ num_0 then [] else [x,map (fun v -> 0) vars] with Failure _ -> try grob_neg(grobify_term vars (ring_dest_neg tm)) with Failure _ -> try grob_inv(grobify_term vars (ring_dest_inv tm)) with Failure _ -> try let l,r = ring_dest_add tm in grob_add (grobify_term vars l) (grobify_term vars r) with Failure _ -> try let l,r = ring_dest_sub tm in grob_sub (grobify_term vars l) (grobify_term vars r) with Failure _ -> try let l,r = ring_dest_mul tm in grob_mul (grobify_term vars l) (grobify_term vars r) with Failure _ -> try let l,r = ring_dest_div tm in grob_div (grobify_term vars l) (grobify_term vars r) with Failure _ -> try let l,r = ring_dest_pow tm in grob_pow vars (grobify_term vars l) (dest_small_numeral r) with Failure _ -> failwith "grobify_term: unknown || invalid term" in let grobify_equation vars tm = let l,r = dest_eq tm in grob_sub (grobify_term vars l) (grobify_term vars r) in let grobify_equations tm = let cjs = conjuncts tm in let rawvars = itlist (fun eq a -> grobvars (lhand eq) (grobvars (rand eq) a)) cjs [] in let vars = sort (fun x y -> x < y) (setify rawvars) in vars,map (grobify_equation vars) cjs in let holify_polynomial = let holify_varpow (v,n) = if n = 1 then v else ring_mk_pow v (mk_small_numeral n) in let holify_monomial vars (c,m) = let xps = map holify_varpow (filter (fun (_,n) -> n <> 0) (zip vars m)) in end_itlist ring_mk_mul (ring_mk_const c :: xps) in let holify_polynomial vars p = if p = [] then ring_mk_const (num_0) else end_itlist ring_mk_add (map (holify_monomial vars) p) in holify_polynomial in let (pth_idom,pth_ine) = CONJ_PAIR(MATCH_MP pth_step RING_INTEGRAL) in let IDOM_RULE = CONV_RULE(REWR_CONV pth_idom) in let PROVE_NZ n = EQF_ELIM(RING_EQ_CONV (mk_eq(ring_mk_const n,ring_mk_const(num_0)))) in let NOT_EQ_01 = PROVE_NZ (num_1) and INE_RULE n = MATCH_MP(MATCH_MP pth_ine (PROVE_NZ n)) and MK_ADD th1 th2 = MK_COMB(AP_TERM ring_add_tm th1,th2) in let execute_proof vars eths prf = let x,th1 = SPEC_VAR(CONJUNCT1(CONJUNCT2 RING_INTEGRAL)) in let y,th2 = SPEC_VAR th1 in let z,th3 = SPEC_VAR th2 in let SUB_EQ_RULE = GEN_REWRITE_RULE I [SYM(INST [mk_comb(ring_neg_tm,z),x] th3)] in let initpols = map (CONV_RULE(BINOP_CONV RING_NORMALIZE_CONV) o SUB_EQ_RULE) eths in let ADD_RULE th1 th2 = CONV_RULE (BINOP_CONV RING_NORMALIZE_CONV) (MK_COMB(AP_TERM ring_add_tm th1,th2)) and MUL_RULE vars m th = CONV_RULE (BINOP_CONV RING_NORMALIZE_CONV) (AP_TERM (mk_comb(ring_mul_tm,holify_polynomial vars [m])) th) in let execache = ref [] in let memoize prf x = (execache := (prf,x)::(!execache)); x in let rec assoceq a l = match l with [] -> failwith "assoceq" | (x,y)::t -> if x==a then y else assoceq a t in let rec run_proof vars prf = try assoceq prf (!execache) with Failure _ -> (match prf with Start m -> el m initpols | Add(p1,p2) -> memoize prf (ADD_RULE (run_proof vars p1) (run_proof vars p2)) | Mmul(m,p2) -> memoize prf (MUL_RULE vars m (run_proof vars p2))) in let th = run_proof vars prf in execache := []; CONV_RULE RING_EQ_CONV th in let REFUTE tm = if tm = false_tm then ASSUME tm else let nths0,eths0 = partition (is_neg o concl) (CONJUNCTS(ASSUME tm)) in let nths = filter (is_eq o rand o concl) nths0 and eths = filter (is_eq o concl) eths0 in if eths = [] then let th1 = end_itlist (fun th1 th2 -> IDOM_RULE(CONJ th1 th2)) nths in let th2 = CONV_RULE(RAND_CONV(BINOP_CONV RING_NORMALIZE_CONV)) th1 in let l,r = dest_eq(rand(concl th2)) in EQ_MP (EQF_INTRO th2) (REFL l) else if nths = [] && not(is_var ring_neg_tm) then let vars,pols = grobify_equations(list_mk_conj(map concl eths)) in execute_proof vars eths (grobner_refute pols) else let vars,l,cert,noteqth = if nths = [] then let vars,pols = grobify_equations(list_mk_conj(map concl eths)) in let l,cert = grobner_weak vars pols in vars,l,cert,NOT_EQ_01 else let nth = end_itlist (fun th1 th2 -> IDOM_RULE(CONJ th1 th2)) nths in let vars,pol::pols = grobify_equations(list_mk_conj(rand(concl nth)::map concl eths)) in let deg,l,cert = grobner_strong vars pols pol in let th1 = CONV_RULE(RAND_CONV(BINOP_CONV RING_NORMALIZE_CONV)) nth in let th2 = funpow deg (IDOM_RULE o CONJ th1) NOT_EQ_01 in vars,l,cert,th2 in Format.print_string("Translating certificate to HOL inferences"); Format.print_newline(); let cert_pos = map (fun (i,p) -> i,filter (fun (c,m) -> c >/ num_0) p) cert and cert_neg = map (fun (i,p) -> i,map (fun (c,m) -> minus_num c,m) (filter (fun (c,m) -> c i,holify_polynomial vars p) cert_pos and herts_neg = map (fun (i,p) -> i,holify_polynomial vars p) cert_neg in let thm_fn pols = if pols = [] then REFL(ring_mk_const num_0) else end_itlist MK_ADD (map (fun (i,p) -> AP_TERM(mk_comb(ring_mul_tm,p)) (el i eths)) pols) in let th1 = thm_fn herts_pos and th2 = thm_fn herts_neg in let th3 = CONJ(MK_ADD (SYM th1) th2) noteqth in let th4 = CONV_RULE (RAND_CONV(BINOP_CONV RING_NORMALIZE_CONV)) (INE_RULE l th3) in let l,r = dest_eq(rand(concl th4)) in EQ_MP (EQF_INTRO th4) (REFL l) in let RING tm = let avs = frees tm in let tm' = list_mk_forall(avs,tm) in let th1 = INITIAL_CONV(mk_neg tm') in let evs,bod = strip_exists(rand(concl th1)) in if is_forall bod then failwith "RING: non-universal formula" else let th1a = WEAK_DNF_CONV bod in let boda = rand(concl th1a) in let th2a = refute_disj REFUTE boda in let th2b = TRANS th1a (EQF_INTRO(NOT_INTRO(DISCH boda th2a))) in let th2 = UNDISCH(NOT_ELIM(EQF_ELIM th2b)) in let th3 = itlist SIMPLE_CHOOSE evs th2 in SPECL avs (MATCH_MP (FINAL_RULE (DISCH_ALL th3)) th1) and ideal tms tm = let rawvars = itlist grobvars (tm::tms) [] in let vars = sort (fun x y -> x < y) (setify rawvars) in let pols = map (grobify_term vars) tms and pol = grobify_term vars tm in let cert = grobner_ideal vars pols pol in map (fun n -> let p = assocd n cert [] in holify_polynomial vars p) (0--(length pols-1)) in RING,ideal;; (* ----------------------------------------------------------------------- *) (* Separate out the cases. *) (* ----------------------------------------------------------------------- *) let RING parms = fst(RING_AND_IDEAL_CONV parms);; let ideal_cofactors parms = snd(RING_AND_IDEAL_CONV parms);; (* ------------------------------------------------------------------------- *) (* Simplify a natural number assertion to eliminate conditionals, DIV, MOD, *) (* PRE, cutoff subtraction, EVEN and ODD. Try to do it in a way that makes *) (* new quantifiers universal. At the moment we don't split "<=>" which would *) (* make this quantifier selection work there too; better to do NNF first if *) (* you care. This also applies to EVEN and ODD. *) (* ------------------------------------------------------------------------- *) let NUM_SIMPLIFY_CONV = let pre_tm = `PRE` and div_tm = `(DIV):num->num->num` and mod_tm = `(MOD):num->num->num` and p_tm = `P:num->bool` and n_tm = `n:num` and m_tm = `m:num` and q_tm = `P:num->num->bool` and a_tm = `a:num` and b_tm = `b:num` in let is_pre tm = is_comb tm && rator tm = pre_tm and is_sub = is_binop `(-):num->num->num` and is_divmod = let is_div = is_binop div_tm and is_mod = is_binop mod_tm in fun tm -> is_div tm || is_mod tm and contains_quantifier = can (find_term (fun t -> is_forall t || is_exists t || is_uexists t)) and BETA2_CONV = RATOR_CONV BETA_CONV THENC BETA_CONV and PRE_ELIM_THM'' = CONV_RULE (RAND_CONV NNF_CONV) PRE_ELIM_THM and SUB_ELIM_THM'' = CONV_RULE (RAND_CONV NNF_CONV) SUB_ELIM_THM and DIVMOD_ELIM_THM'' = CONV_RULE (RAND_CONV NNF_CONV) DIVMOD_ELIM_THM and pth_evenodd = prove (`(EVEN(x) <=> (!y. ~(x = SUC(2 * y)))) /\ (ODD(x) <=> (!y. ~(x = 2 * y))) /\ (~EVEN(x) <=> (!y. ~(x = 2 * y))) /\ (~ODD(x) <=> (!y. ~(x = SUC(2 * y))))`, REWRITE_TAC[GSYM NOT_EXISTS_THM; GSYM EVEN_EXISTS; GSYM ODD_EXISTS] THEN REWRITE_TAC[NOT_EVEN; NOT_ODD]) in let rec NUM_MULTIPLY_CONV pos tm = if is_forall tm || is_exists tm || is_uexists tm then BINDER_CONV (NUM_MULTIPLY_CONV pos) tm else if is_imp tm && contains_quantifier tm then COMB2_CONV (RAND_CONV(NUM_MULTIPLY_CONV(not pos))) (NUM_MULTIPLY_CONV pos) tm else if (is_conj tm || is_disj tm || is_iff tm) & contains_quantifier tm then BINOP_CONV (NUM_MULTIPLY_CONV pos) tm else if is_neg tm && not pos && contains_quantifier tm then RAND_CONV (NUM_MULTIPLY_CONV (not pos)) tm else try let t = find_term (fun t -> is_pre t && free_in t tm) tm in let ty = type_of t in let v = genvar ty in let p = mk_abs(v,subst [v,t] tm) in let th0 = if pos then PRE_ELIM_THM'' else PRE_ELIM_THM' in let th1 = INST [p,p_tm; rand t,n_tm] th0 in let th2 = CONV_RULE(COMB2_CONV (RAND_CONV BETA_CONV) (BINDER_CONV(RAND_CONV BETA_CONV))) th1 in CONV_RULE(RAND_CONV (NUM_MULTIPLY_CONV pos)) th2 with Failure _ -> try let t = find_term (fun t -> is_sub t && free_in t tm) tm in let ty = type_of t in let v = genvar ty in let p = mk_abs(v,subst [v,t] tm) in let th0 = if pos then SUB_ELIM_THM'' else SUB_ELIM_THM' in let th1 = INST [p,p_tm; lhand t,a_tm; rand t,b_tm] th0 in let th2 = CONV_RULE(COMB2_CONV (RAND_CONV BETA_CONV) (BINDER_CONV(RAND_CONV BETA_CONV))) th1 in CONV_RULE(RAND_CONV (NUM_MULTIPLY_CONV pos)) th2 with Failure _ -> try let t = find_term (fun t -> is_divmod t && free_in t tm) tm in let x = lhand t and y = rand t in let dtm = mk_comb(mk_comb(div_tm,x),y) and mtm = mk_comb(mk_comb(mod_tm,x),y) in let vd = genvar(type_of dtm) and vm = genvar(type_of mtm) in let p = list_mk_abs([vd;vm],subst[vd,dtm; vm,mtm] tm) in let th0 = if pos then DIVMOD_ELIM_THM'' else DIVMOD_ELIM_THM' in let th1 = INST [p,q_tm; x,m_tm; y,n_tm] th0 in let th2 = CONV_RULE(COMB2_CONV(RAND_CONV BETA2_CONV) (funpow 2 BINDER_CONV(RAND_CONV BETA2_CONV))) th1 in CONV_RULE(RAND_CONV (NUM_MULTIPLY_CONV pos)) th2 with Failure _ -> REFL tm in NUM_REDUCE_CONV THENC CONDS_CELIM_CONV THENC NNF_CONV THENC NUM_MULTIPLY_CONV true THENC NUM_REDUCE_CONV THENC GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth_evenodd];; (* ----------------------------------------------------------------------- *) (* Natural number version of ring procedure with this normalization. *) (* ----------------------------------------------------------------------- *) let NUM_RING = let NUM_INTEGRAL_LEMMA = prove (`(w = x + d) /\ (y = z + e) ==> ((w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[AC ADD_AC `a + b + c + d + e = a + c + e + b + d`] THEN REWRITE_TAC[EQ_ADD_LCANCEL; EQ_ADD_LCANCEL_0; MULT_EQ_0]) in let NUM_INTEGRAL = prove (`(!x. 0 * x = 0) /\ (!x y z. (x + y = x + z) <=> (y = z)) /\ (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN REPEAT GEN_TAC THEN DISJ_CASES_TAC (SPECL [`w:num`; `x:num`] LE_CASES) THEN DISJ_CASES_TAC (SPECL [`y:num`; `z:num`] LE_CASES) THEN REPEAT(FIRST_X_ASSUM (CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS])) THEN ASM_MESON_TAC[NUM_INTEGRAL_LEMMA; ADD_SYM; MULT_SYM]) in let rawring = RING(dest_numeral,mk_numeral,NUM_EQ_CONV, genvar bool_ty,`(+):num->num->num`,genvar bool_ty, genvar bool_ty,`(*):num->num->num`,genvar bool_ty, `(EXP):num->num->num`, NUM_INTEGRAL,TRUTH,NUM_NORMALIZE_CONV) in let initconv = NUM_SIMPLIFY_CONV THENC GEN_REWRITE_CONV DEPTH_CONV [ADD1] and t_tm = `T` in fun tm -> let th = initconv tm in if rand(concl th) = t_tm then th else EQ_MP (SYM th) (rawring(rand(concl th)));; hol-light/help.ml000066400000000000000000000132551303454263000142350ustar00rootroot00000000000000(* ========================================================================= *) (* Simple online help system, based on old HOL88 one. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "define.ml";; (* ------------------------------------------------------------------------- *) (* Help system. *) (* ------------------------------------------------------------------------- *) let help_path = ref ["$/Help"];; let help s = let funny_filenames = ["++", ".joinparsers"; "|||", ".orparser"; ">>", ".pipeparser"; "|=>", ".singlefun"; "--", ".upto"; "|->", ".valmod"; "insert'", "insert_prime"; "mem'", "mem_prime"; "subtract'", "subtract_prime"; "union'", "union_prime"; "unions'", "unions_prime"; "ALPHA", "ALPHA_UPPERCASE"; "CHOOSE", "CHOOSE_UPPERCASE"; "CONJUNCTS", "CONJUNCTS_UPPERCASE"; "EXISTS", "EXISTS_UPPERCASE"; "HYP", "HYP_UPPERCASE"; "INSTANTIATE", "INSTANTIATE_UPPERCASE"; "INST", "INST_UPPERCASE"; "MK_BINOP", "MK_BINOP_UPPERCASE"; "MK_COMB", "MK_COMB_UPPERCASE"; "MK_CONJ", "MK_CONJ_UPPERCASE"; "MK_DISJ", "MK_DISJ_UPPERCASE"; "MK_EXISTS", "MK_EXISTS_UPPERCASE"; "MK_FORALL", "MK_FORALL_UPPERCASE"; "REPEAT", "REPEAT_UPPERCASE"] in let true_path = map hol_expand_directory (!help_path) in let raw_listing = map (fun s -> String.sub s 0 (String.length s - 4)) (itlist (fun a l -> Array.to_list (Sys.readdir a) @ l) true_path []) in let mod_listing = map fst funny_filenames @ subtract raw_listing (map snd funny_filenames) in let edit_distance s1 s2 = let l1 = String.length s1 and l2 = String.length s2 in let a = Array.make_matrix (l1 + 1) (l2 + 1) 0 in for i = 1 to l1 do a.(i).(0) <- i done; for j = 1 to l2 do a.(0).(j) <- j done; for i = 1 to l1 do for j = 1 to l2 do let cost = if String.get s1 (i-1) = String.get s2 (j-1) then 0 else 1 in a.(i).(j) <- min (min a.(i-1).(j) a.(i).(j-1) + 1) (a.(i-1).(j-1) + cost) done done; a.(l1).(l2) in let closeness s s' = s',2.0 *. float_of_int (edit_distance (String.uppercase s) (String.uppercase s')) /. float_of_int(String.length s + String.length s') in let guess s = let guesses = mergesort(increasing snd) (map (closeness s) mod_listing) in map fst (fst(chop_list 3 guesses)) in Format.print_string "-------------------------------------------------------------------\n"; Format.print_flush(); (if mem s mod_listing then let fn = assocd s funny_filenames s ^".doc" in let file = file_on_path true_path fn and script = file_on_path [!hol_dir] "doc-to-help.sed" in ignore(Sys.command("sed -f "^script^" "^file)) else let guesses = map (fun s -> "help \""^String.escaped s^"\";;\n") (guess s) in (Format.print_string o end_itlist(^)) (["No help found for \""; String.escaped s; "\"; did you mean:\n\n"] @ guesses @ ["\n?\n"])); Format.print_string "--------------------------------------------------------------------\n"; Format.print_flush();; (* ------------------------------------------------------------------------- *) (* Set up a theorem database, but leave contents clear for now. *) (* ------------------------------------------------------------------------- *) let theorems = ref([]:(string*thm)list);; (* ------------------------------------------------------------------------- *) (* Some hacky term modifiers to encode searches. *) (* ------------------------------------------------------------------------- *) let omit t = mk_comb(mk_var("",W mk_fun_ty (type_of t)),t);; let exactly t = mk_comb(mk_var("",W mk_fun_ty (type_of t)),t);; let name s = mk_comb(mk_var("",W mk_fun_ty aty), mk_var(s,aty));; (* ------------------------------------------------------------------------- *) (* The main search function. *) (* ------------------------------------------------------------------------- *) let search = let rec immediatesublist l1 l2 = match (l1,l2) with [],_ -> true | _,[] -> false | (h1::t1,h2::t2) -> h1 = h2 && immediatesublist t1 t2 in let rec sublist l1 l2 = match (l1,l2) with [],_ -> true | _,[] -> false | (h1::t1,h2::t2) -> immediatesublist l1 l2 || sublist l1 t2 in let exists_subterm_satisfying p (n,th) = can (find_term p) (concl th) and name_contains s (n,th) = sublist (explode s) (explode n) in let rec filterpred tm = match tm with Comb(Var("",_),t) -> not o filterpred t | Comb(Var("",_),Var(pat,_)) -> name_contains pat | Comb(Var("",_),pat) -> exists_subterm_satisfying (aconv pat) | pat -> exists_subterm_satisfying (can (term_match [] pat)) in fun pats -> let triv,nontriv = partition is_var pats in (if triv <> [] then warn true ("Ignoring plain variables in search: "^ end_itlist (fun s t -> s^", "^t) (map (fst o dest_var) triv)) else ()); (if nontriv = [] && triv <> [] then [] else itlist (filter o filterpred) pats (!theorems));; hol-light/hol.ml000066400000000000000000000214511303454263000140640ustar00rootroot00000000000000(* ========================================================================= *) (* HOL LIGHT *) (* *) (* Modern OCaml version of the HOL theorem prover *) (* *) (* John Harrison *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) let hol_version = "2.20++";; #directory "+compiler-libs";; let hol_dir = ref (try Sys.getenv "HOLLIGHT_DIR" with Not_found -> Sys.getcwd());; (* ------------------------------------------------------------------------- *) (* Should eventually change to "ref(Filename.temp_dir_name)". *) (* However that's not available in 3.08, which is still the default *) (* in Cygwin, and I don't want to force people to upgrade Ocaml. *) (* ------------------------------------------------------------------------- *) let temp_path = ref "/tmp";; (* ------------------------------------------------------------------------- *) (* Load in parsing extensions. *) (* For Ocaml < 3.10, use the built-in camlp4 *) (* and for Ocaml >= 3.10, use camlp5 instead. *) (* ------------------------------------------------------------------------- *) if let v = String.sub Sys.ocaml_version 0 4 in v >= "3.10" then (Topdirs.dir_directory "+camlp5"; Topdirs.dir_load Format.std_formatter "camlp5o.cma") else (Topdirs.dir_load Format.std_formatter "camlp4o.cma");; Topdirs.dir_load Format.std_formatter (Filename.concat (!hol_dir) "pa_j.cmo");; (* ------------------------------------------------------------------------- *) (* Load files from system and/or user-settable directories. *) (* Paths map initial "$/" to !hol_dir dynamically; use $$ to get the actual *) (* $ character at the start of a directory. *) (* ------------------------------------------------------------------------- *) let use_file s = if Toploop.use_file Format.std_formatter s then () else (Format.print_string("Error in included file "^s); Format.print_newline());; let hol_expand_directory s = if s = "$" || s = "$/" then !hol_dir else if s = "$$" then "$" else if String.length s <= 2 then s else if String.sub s 0 2 = "$$" then (String.sub s 1 (String.length s - 1)) else if String.sub s 0 2 = "$/" then Filename.concat (!hol_dir) (String.sub s 2 (String.length s - 2)) else s;; let load_path = ref ["."; "$"];; let loaded_files = ref [];; let file_on_path p s = if not (Filename.is_relative s) then s else let p' = List.map hol_expand_directory p in let d = List.find (fun d -> Sys.file_exists(Filename.concat d s)) p' in Filename.concat (if d = "." then Sys.getcwd() else d) s;; let load_on_path p s = let s' = file_on_path p s in let fileid = (Filename.basename s',Digest.file s') in (use_file s'; loaded_files := fileid::(!loaded_files));; let loads s = load_on_path ["$"] s;; let loadt s = load_on_path (!load_path) s;; let needs s = let s' = file_on_path (!load_path) s in let fileid = (Filename.basename s',Digest.file s') in if List.mem fileid (!loaded_files) then Format.print_string("File \""^s^"\" already loaded\n") else loadt s;; (* ------------------------------------------------------------------------- *) (* Various tweaks to OCaml and general library functions. *) (* ------------------------------------------------------------------------- *) loads "system.ml";; (* Set up proper parsing and load bignums *) loads "lib.ml";; (* Various useful general library functions *) (* ------------------------------------------------------------------------- *) (* The logical core. *) (* ------------------------------------------------------------------------- *) loads "fusion.ml";; (* ------------------------------------------------------------------------- *) (* Some extra support stuff needed outside the core. *) (* ------------------------------------------------------------------------- *) loads "basics.ml";; (* Additional syntax operations and other utilities *) loads "nets.ml";; (* Term nets for fast matchability-based lookup *) (* ------------------------------------------------------------------------- *) (* The interface. *) (* ------------------------------------------------------------------------- *) loads "printer.ml";; (* Crude prettyprinter *) loads "preterm.ml";; (* Preterms and their interconversion with terms *) loads "parser.ml";; (* Lexer and parser *) (* ------------------------------------------------------------------------- *) (* Higher level deductive system. *) (* ------------------------------------------------------------------------- *) loads "equal.ml";; (* Basic equality reasoning and conversionals *) loads "bool.ml";; (* Boolean theory and basic derived rules *) loads "drule.ml";; (* Additional derived rules *) loads "tactics.ml";; (* Tactics, tacticals and goal stack *) loads "itab.ml";; (* Toy prover for intuitionistic logic *) loads "simp.ml";; (* Basic rewriting and simplification tools. *) loads "theorems.ml";; (* Additional theorems (mainly for quantifiers) etc. *) loads "ind_defs.ml";; (* Derived rules for inductive definitions *) loads "class.ml";; (* Classical reasoning: Choice and Extensionality *) loads "trivia.ml";; (* Some very basic theories, e.g. type ":1" *) loads "canon.ml";; (* Tools for putting terms in canonical forms *) loads "meson.ml";; (* First order automation: MESON (model elimination) *) loads "metis.ml";; (* More advanced first-order automation: Metis *) loads "quot.ml";; (* Derived rules for defining quotient types *) loads "impconv.ml";; (* More powerful implicational rewriting etc. *) (* ------------------------------------------------------------------------- *) (* Mathematical theories and additional proof tools. *) (* ------------------------------------------------------------------------- *) loads "pair.ml";; (* Theory of pairs *) loads "nums.ml";; (* Axiom of Infinity, definition of natural numbers *) loads "recursion.ml";; (* Tools for primitive recursion on inductive types *) loads "arith.ml";; (* Natural number arithmetic *) loads "wf.ml";; (* Theory of wellfounded relations *) loads "calc_num.ml";; (* Calculation with natural numbers *) loads "normalizer.ml";; (* Polynomial normalizer for rings and semirings *) loads "grobner.ml";; (* Groebner basis procedure for most semirings. *) loads "ind_types.ml";; (* Tools for defining inductive types *) loads "lists.ml";; (* Theory of lists *) loads "realax.ml";; (* Definition of real numbers *) loads "calc_int.ml";; (* Calculation with integer-valued reals *) loads "realarith.ml";; (* Universal linear real decision procedure *) loads "real.ml";; (* Derived properties of reals *) loads "calc_rat.ml";; (* Calculation with rational-valued reals *) loads "int.ml";; (* Definition of integers *) loads "sets.ml";; (* Basic set theory. *) loads "iterate.ml";; (* Iterated operations *) loads "cart.ml";; (* Finite Cartesian products *) loads "define.ml";; (* Support for general recursive definitions *) (* ------------------------------------------------------------------------- *) (* The help system. *) (* ------------------------------------------------------------------------- *) loads "help.ml";; (* Online help using the entries in Help directory *) loads "database.ml";; (* List of name-theorem pairs for search system *) hol-light/holtest000077500000000000000000000360621303454263000143640ustar00rootroot00000000000000#!/bin/bash ####################################################################### # Load in a bunch of examples to test HOL Light is working properly # Try examining the output using something like # # egrep -i '###|error|not.found' nohup.out # # to see progress and whether anything has gone wrong. # # You might first want to install the necessary external tools, # for instance with # # aptitude install prover9 coinor-csdp pari-gp libocamlgraph-ocaml-dev # ####################################################################### set -e if which hol-light > /dev/null ; then hollight=hol-light elif type ckpt > /dev/null; then make clean; make hol (cd Mizarlight; make clean; make) hollight=./hol else make clean; make (cd Mizarlight; make clean; make) hollight="ocaml -init hol.ml" fi # Standalone examples echo '### Loading Library/agm.ml'; echo 'loadt "Library/agm.ml";;' | (time $hollight) echo '### Loading Library/binary.ml'; echo 'loadt "Library/binary.ml";;' | (time $hollight) echo '### Loading Library/binomial.ml'; echo 'loadt "Library/binomial.ml";;' | (time $hollight) echo '### Loading Examples/borsuk.ml'; echo 'loadt "Examples/borsuk.ml";;' | (time $hollight) echo '### Loading Examples/brunn_minkowski.ml'; echo 'loadt "Examples/brunn_minkowski.ml";;' | (time $hollight) echo '### Loading Library/card.ml'; echo 'loadt "Library/card.ml";;' | (time $hollight) echo '### Loading Examples/combin.ml'; echo 'loadt "Examples/combin.ml";;' | (time $hollight) echo '### Loading Examples/cong.ml'; echo 'loadt "Examples/cong.ml";;' | (time $hollight) echo '### Loading Examples/cooper.ml'; echo 'loadt "Examples/cooper.ml";;' | (time $hollight) echo '### Loading Examples/dickson.ml'; echo 'loadt "Examples/dickson.ml";;' | (time $hollight) echo '### Loading Examples/division_algebras.ml'; echo 'loadt "Examples/division_algebras.ml";;' | (time $hollight) echo '### Loading Examples/dlo.ml'; echo 'loadt "Examples/dlo.ml";;' | (time $hollight) echo '### Loading Library/floor.ml'; echo 'loadt "Library/floor.ml";;' | (time $hollight) echo '### Loading Examples/forster.ml'; echo 'loadt "Examples/forster.ml";;' | (time $hollight) echo '### Loading Examples/gcdrecurrence.ml'; echo 'loadt "Examples/gcdrecurrence.ml";;' | (time $hollight) echo '### Loading Examples/harmonicsum.ml'; echo 'loadt "Examples/harmonicsum.ml";;' | (time $hollight) echo '### Loading Examples/hol88.ml'; echo 'loadt "Examples/hol88.ml";;' | (time $hollight) echo '### Loading Examples/holby.ml'; echo 'loadt "Examples/holby.ml";;' | (time $hollight) echo '### Loading Library/integer.ml'; echo 'loadt "Library/integer.ml";;' | (time $hollight) echo '### Loading Examples/inverse_bug_puzzle_miz3.ml'; echo 'loadt "Examples/inverse_bug_puzzle_miz3.ml";;' | (time $hollight) echo '### Loading Examples/inverse_bug_puzzle_tac.ml'; echo 'loadt "Examples/inverse_bug_puzzle_tac.ml";;' | (time $hollight) echo '### Loading RichterHilbertAxiomGeometry/inverse_bug_puzzle_read.ml'; echo 'loadt "RichterHilbertAxiomGeometry/inverse_bug_puzzle_read.ml";;' | (time $hollight) echo '### Loading Library/isum.ml'; echo 'loadt "Library/isum.ml";;' | (time $hollight) echo '### Loading Examples/kb.ml'; echo 'loadt "Examples/kb.ml";;' | (time $hollight) echo '### Loading Examples/lagrange_lemma.ml'; echo 'loadt "Examples/lagrange_lemma.ml";;' | (time $hollight) echo '### Loading Examples/lucas_lehmer.ml'; echo 'loadt "Examples/lucas_lehmer.ml";;' | (time $hollight) echo '### Loading Examples/mangoldt.ml'; echo 'loadt "Examples/mangoldt.ml";;' | (time $hollight) echo '### Loading Examples/mccarthy.ml'; echo 'loadt "Examples/mccarthy.ml";;' | (time $hollight) echo '### Loading Examples/misiurewicz.ml'; echo 'loadt "Examples/misiurewicz.ml";;' | (time $hollight) echo '### Loading Examples/mizar.ml'; echo 'loadt "Examples/mizar.ml";;' | (time $hollight) echo '### Loading Library/multiplicative.ml'; echo 'loadt "Library/multiplicative.ml";;' | (time $hollight) echo '### Loading Examples/multiwf.ml'; echo 'loadt "Examples/multiwf.ml";;' | (time $hollight) echo '### Loading Examples/pell.ml'; echo 'loadt "Examples/pell.ml";;' | (time $hollight) echo '### Loading Library/permutations.ml'; echo 'loadt "Library/permutations.ml";;' | (time $hollight) echo '### Loading Library/primitive.ml'; echo 'loadt "Library/primitive.ml";;' | (time $hollight) echo '### Loading Library/products.ml'; echo 'loadt "Library/products.ml";;' | (time $hollight) echo '### Loading Examples/prog.ml'; echo 'loadt "Examples/prog.ml";;' | (time $hollight) echo '### Loading Examples/prover9.ml'; echo 'loadt "Examples/prover9.ml";;' | (time $hollight) echo '### Loading Library/q.ml'; echo 'loadt "Library/q.ml";;' | (time $hollight) echo '### Loading Examples/rectypes.ml'; echo 'loadt "Examples/rectypes.ml";;' | (time $hollight) echo '### Loading Examples/schnirelmann.ml'; echo 'loadt "Examples/schnirelmann.ml";;' | (time $hollight) echo '### Loading Examples/solovay.ml'; echo 'loadt "Examples/solovay.ml";;' | (time $hollight) echo '### Loading Examples/sos.ml'; echo 'loadt "Examples/sos.ml";;' | (time $hollight) echo '### Loading Examples/ste.ml'; echo 'loadt "Examples/ste.ml";;' | (time $hollight) echo '### Loading Examples/sylvester_gallai.ml'; echo 'loadt "Examples/sylvester_gallai.ml";;' | (time $hollight) echo '### Loading Examples/vitali.ml'; echo 'loadt "Examples/vitali.ml";;' | (time $hollight) echo '### Loading Library/wo.ml'; echo 'loadt "Library/wo.ml";;' | (time $hollight) echo '### Loading Library/analysis.ml,/transc.ml,calc_real.ml,machin.ml,polylog.ml,poly.ml'; (echo 'loadt "Library/analysis.ml";;'; echo 'loadt "Library/transc.ml";;'; echo 'loadt "Library/calc_real.ml";;'; echo 'loadt "Examples/machin.ml";;'; echo 'loadt "Examples/polylog.ml";;'; echo 'loadt "Library/poly.ml";;') | (time $hollight) echo '### Loading Library/prime.ml,pratt.ml'; (echo 'loadt "Library/prime.ml";;'; echo 'loadt "Library/pratt.ml";;') | (time $hollight) echo '### Loading Library/prime.ml,pocklington.ml'; (echo 'loadt "Library/prime.ml";;'; echo 'loadt "Library/pocklington.ml";;') | (time $hollight) echo '### Loading Library/rstc.ml,reduct.ml'; (echo 'loadt "Library/rstc.ml";;'; echo 'loadt "Examples/reduct.ml";;') | (time $hollight) # Extended examples echo '### Loading Arithmetic/make.ml'; echo 'loadt "Arithmetic/make.ml";;' | (time $hollight) echo '### Loading Boyer_Moore/make.ml'; echo 'loadt "Boyer_Moore/make.ml";;' | (time $hollight) echo '### Loading Complex/make.ml'; echo 'loadt "Complex/make.ml";;' | (time $hollight) echo '### Loading IEEE/make.ml'; echo 'loadt "IEEE/make.ml";;' | (time $hollight) echo '### Loading IsabelleLight/make.ml'; echo 'loadt "IsabelleLight/make.ml";;' | (time $hollight) echo '### Loading Jordan/make.ml'; echo 'loadt "Jordan/make.ml";;' | (time $hollight) echo '### Loading Mizarlight/make.ml'; echo 'loadt "Mizarlight/make.ml";;' | (time $hollight) echo '### Loading miz3/make.ml, miz3/test.ml (twice)'; (echo 'loadt "miz3/make.ml";;'; echo 'loadt "miz3/test.ml";;'; echo 'loadt "miz3/test.ml";;') | (time $hollight) if which zchaff > /dev/null ; then echo '### Loading Minisat/make.ml,Minisat/taut.ml'; (echo 'loadt "Minisat/make.ml";;'; echo 'loadt "Minisat/taut.ml";;') | (time $hollight) else echo '### Error: skip Minisat/make.ml, Minisat/taut.ml because zchaff is not available' fi echo '### Loading Model/make.ml'; echo 'loadt "Model/make.ml";;' | (time $hollight) echo '### Loading Multivariate/make.ml'; echo 'loadt "Multivariate/make.ml";;' | (time $hollight) echo '### Loading Multivariate/make_complex.ml'; echo 'loadt "Multivariate/make_complex.ml";;' | (time $hollight) echo '### Loading Ntrie/ntrie.ml'; echo 'loadt "Ntrie/ntrie.ml";;' | (time $hollight) echo '### Loading Permutation/make.ml'; echo 'loadt "Permutation/make.ml";;' | (time $hollight) echo '### Loading QBF/make.ml'; echo 'loadt "QBF/make.ml";;' | (time $hollight) echo '### Loading Quaternions/make.ml'; echo 'loadt "Quaternions/make.ml";;' | (time $hollight) echo '### Loading RichterHilbertAxiomGeometry/miz3/make.ml'; echo 'loadt "RichterHilbertAxiomGeometry/miz3/make.ml";;' | (time $hollight) echo '### Loading RichterHilbertAxiomGeometry/HilbertAxiom_read.ml'; echo 'loadt "RichterHilbertAxiomGeometry/HilbertAxiom_read.ml";;' | (time $hollight) echo '### Loading Rqe/make.ml'; echo 'loadt "Rqe/make.ml";;' | (time $hollight) echo '### Loading Unity/make.ml'; echo 'loadt "Unity/make.ml";;' | (time $hollight) echo '### Loading Multivariate/cross.ml'; echo 'loadt "Multivariate/cross.ml";;' | (time $hollight) echo '### Loading Multivariate/cvectors.ml'; echo 'loadt "Multivariate/cvectors.ml";;' | (time $hollight) echo '### Loading Multivariate/flyspeck.ml'; echo 'loadt "Multivariate/flyspeck.ml";;' | (time $hollight) echo '### Loading Multivariate/gamma.ml'; echo 'loadt "Multivariate/gamma.ml";;' | (time $hollight) echo '### Loading Multivariate/geom.ml'; echo 'loadt "Multivariate/geom.ml";;' | (time $hollight) echo '### Loading Multivariate/tarski.ml'; echo 'loadt "Multivariate/tarski.ml";;' | (time $hollight) echo '### Loading RichterHilbertAxiomGeometry/Topology.ml'; echo 'loadt "RichterHilbertAxiomGeometry/Topology.ml";;' | (time $hollight) echo '### Loading RichterHilbertAxiomGeometry/TarskiAxiomGeometry_read.ml'; echo 'loadt "RichterHilbertAxiomGeometry/TarskiAxiomGeometry_read.ml";;' | (time $hollight) echo '### Loading Functionspaces/make.ml'; echo 'loadt "Functionspaces/make.ml";;' | (time $hollight) echo '### Loading Formal_ineqs/make.ml,examples.hl,examples_poly.hl,examples_flyspeck.hl'; (echo 'loadt "Formal_ineqs/make.ml";;'; echo 'loadt "Formal_ineqs/examples.hl";;'; echo 'loadt "Formal_ineqs/examples_poly.hl";;'; echo 'loadt "Formal_ineqs/examples_flyspeck.hl";;') | (time $hollight) # Some of the "Great 100 theorems" echo '### Loading 100/arithmetic_geometric_mean.ml'; echo 'loadt "100/arithmetic_geometric_mean.ml";;' | (time $hollight) echo '### Loading 100/arithmetic.ml'; echo 'loadt "100/arithmetic.ml";;' | (time $hollight) echo '### Loading 100/ballot.ml'; echo 'loadt "100/ballot.ml";;' | (time $hollight) echo '### Loading 100/bernoulli.ml'; echo 'loadt "100/bernoulli.ml";;' | (time $hollight) echo '### Loading 100/bertrand.ml,100/primerecip.ml'; (echo 'loadt "100/bertrand.ml";;'; echo 'loadt "100/primerecip.ml";;') | (time $hollight) echo '### Loading 100/birthday.ml'; echo 'loadt "100/birthday.ml";;' | (time $hollight) echo '### Loading 100/cantor.ml'; echo 'loadt "100/cantor.ml";;' | (time $hollight) echo '### Loading 100/cayley_hamilton.ml'; echo 'loadt "100/cayley_hamilton.ml";;' | (time $hollight) echo '### Loading 100/ceva.ml'; echo 'loadt "100/ceva.ml";;' | (time $hollight) echo '### Loading 100/circle.ml'; echo 'loadt "100/circle.ml";;' | (time $hollight) echo '### Loading 100/chords.ml'; echo 'loadt "100/chords.ml";;' | (time $hollight) echo '### Loading 100/combinations.ml'; echo 'loadt "100/combinations.ml";;' | (time $hollight) echo '### Loading 100/constructible.ml'; echo 'loadt "100/constructible.ml";;' | (time $hollight) echo '### Loading 100/cosine.ml'; echo 'loadt "100/cosine.ml";;' | (time $hollight) echo '### Loading 100/cubic.ml'; echo 'loadt "100/cubic.ml";;' | (time $hollight) echo '### Loading 100/derangements.ml'; echo 'loadt "100/derangements.ml";;' | (time $hollight) echo '### Loading 100/desargues.ml'; echo 'loadt "100/desargues.ml";;' | (time $hollight) echo '### Loading 100/descartes.ml'; echo 'loadt "100/descartes.ml";;' | (time $hollight) echo '### Loading 100/dirichlet.ml'; echo 'loadt "100/dirichlet.ml";;' | (time $hollight) echo '### Loading 100/div3.ml'; echo 'loadt "100/div3.ml";;' | (time $hollight) echo '### Loading 100/divharmonic.ml'; echo 'loadt "100/divharmonic.ml";;' | (time $hollight) echo '### Loading 100/e_is_transcendental.ml'; echo 'loadt "100/e_is_transcendental.ml";;' | (time $hollight) echo '### Loading 100/euler.ml'; echo 'loadt "100/euler.ml";;' | (time $hollight) echo '### Loading 100/feuerbach.ml'; echo 'loadt "100/feuerbach.ml";;' | (time $hollight) echo '### Loading 100/fourier.ml'; echo 'loadt "100/fourier.ml";;' | (time $hollight) echo '### Loading 100/four_squares.ml'; echo 'loadt "100/four_squares.ml";;' | (time $hollight) echo '### Loading 100/friendship.ml'; echo 'loadt "100/friendship.ml";;' | (time $hollight) echo '### Loading 100/fta.ml'; echo 'loadt "100/fta.ml";;' | (time $hollight) echo '### Loading 100/gcd.ml'; echo 'loadt "100/gcd.ml";;' | (time $hollight) echo '### Loading 100/heron.ml'; echo 'loadt "100/heron.ml";;' | (time $hollight) echo '### Loading 100/inclusion_exclusion.ml'; echo 'loadt "100/inclusion_exclusion.ml";;' | (time $hollight) echo '### Loading 100/independence.ml'; echo 'loadt "100/independence.ml";;' | (time $hollight) echo '### Loading 100/isosceles.ml'; echo 'loadt "100/isosceles.ml";;' | (time $hollight) echo '### Loading 100/konigsberg.ml'; echo 'loadt "100/konigsberg.ml";;' | (time $hollight) echo '### Loading 100/lagrange.ml'; echo 'loadt "100/lagrange.ml";;' | (time $hollight) echo '### Loading 100/leibniz.ml'; echo 'loadt "100/leibniz.ml";;' | (time $hollight) echo '### Loading 100/lhopital.ml'; echo 'loadt "100/lhopital.ml";;' | (time $hollight) echo '### Loading 100/liouville.ml'; echo 'loadt "100/liouville.ml";;' | (time $hollight) echo '### Loading 100/minkowski.ml'; echo 'loadt "100/minkowski.ml";;' | (time $hollight) echo '### Loading 100/morley.ml'; echo 'loadt "100/morley.ml";;' | (time $hollight) echo '### Loading 100/pascal.ml'; echo 'loadt "100/pascal.ml";;' | (time $hollight) echo '### Loading 100/perfect.ml'; echo 'loadt "100/perfect.ml";;' | (time $hollight) echo '### Loading 100/pick.ml'; echo 'loadt "100/pick.ml";;' | (time $hollight) echo '### Loading 100/piseries.ml'; echo 'loadt "100/piseries.ml";;' | (time $hollight) echo '### Loading 100/platonic.ml'; echo 'loadt "100/platonic.ml";;' | (time $hollight) echo '### Loading 100/pnt.ml'; echo 'loadt "100/pnt.ml";;' | (time $hollight) echo '### Loading 100/polyhedron.ml'; echo 'loadt "100/polyhedron.ml";;' | (time $hollight) echo '### Loading 100/ptolemy.ml'; echo 'loadt "100/ptolemy.ml";;' | (time $hollight) echo '### Loading 100/pythagoras.ml'; echo 'loadt "100/pythagoras.ml";;' | (time $hollight) echo '### Loading 100/quartic.ml'; echo 'loadt "100/quartic.ml";;' | (time $hollight) echo '### Loading 100/ramsey.ml'; echo 'loadt "100/ramsey.ml";;' | (time $hollight) echo '### Loading 100/ratcountable.ml'; echo 'loadt "100/ratcountable.ml";;' | (time $hollight) echo '### Loading 100/realsuncountable.ml'; echo 'loadt "100/realsuncountable.ml";;' | (time $hollight) echo '### Loading 100/reciprocity.ml'; echo 'loadt "100/reciprocity.ml";;' | (time $hollight) echo '### Loading 100/stirling.ml'; echo 'loadt "100/stirling.ml";;' | (time $hollight) echo '### Loading 100/subsequence.ml'; echo 'loadt "100/subsequence.ml";;' | (time $hollight) echo '### Loading 100/thales.ml'; echo 'loadt "100/thales.ml";;' | (time $hollight) echo '### Loading 100/triangular.ml'; echo 'loadt "100/triangular.ml";;' | (time $hollight) echo '### Loading 100/two_squares.ml'; echo 'loadt "100/two_squares.ml";;' | (time $hollight) echo '### Loading 100/wilson.ml'; echo 'loadt "100/wilson.ml";;' | (time $hollight) # Build the proof-recording version of HOL echo '### Building proof-recording version'; cd Proofrecording/hol_light make clean; make hol hol-light/holtest.mk000066400000000000000000000140731303454263000147650ustar00rootroot00000000000000HOLLIGHT:=ocaml -init hol.ml STANDALONE_EXAMPLES:=\ Library/agm \ Library/binary \ Library/binomial \ Examples/borsuk \ Examples/brunn_minkowski \ Library/card \ Examples/combin \ Examples/cong \ Examples/cooper \ Examples/dickson \ Examples/division_algebras \ Examples/dlo \ Library/floor \ Examples/forster \ Examples/gcdrecurrence \ Examples/harmonicsum \ Examples/hol88 \ Examples/holby \ Library/integer \ Examples/inverse_bug_puzzle_miz3 \ Examples/inverse_bug_puzzle_tac \ RichterHilbertAxiomGeometry/inverse_bug_puzzle_read \ Library/isum \ Examples/kb \ Examples/lagrange_lemma \ Examples/lucas_lehmer \ Examples/mangoldt \ Examples/mccarthy \ Examples/misiurewicz \ Examples/mizar \ Library/multiplicative \ Examples/multiwf \ Examples/pell \ Library/permutations \ Library/primitive \ Library/products \ Examples/prog \ Examples/prover9 \ Library/q \ Examples/rectypes \ Examples/schnirelmann \ Examples/solovay \ Examples/sos \ Examples/ste \ Examples/sylvester_gallai \ Examples/vitali \ Library/wo \ Library/analysis-transc \ Library/prime-pratt \ Library/prime-pocklington \ Library/rstc-reduct EXTENDED_EXAMPLES:=\ Arithmetic/make \ Boyer_Moore/make \ Complex/make \ IEEE/make \ IsabelleLight/make \ Jordan/make \ Mizarlight/make \ miz3/make-test \ Minisat/make-taut \ Model/make \ Multivariate/make \ Multivariate/make_complex \ Ntrie/ntrie \ Permutation/make \ QBF/make \ Quaternions/make \ RichterHilbertAxiomGeometry/miz3/make \ RichterHilbertAxiomGeometry/HilbertAxiom_read \ Rqe/make \ Unity/make \ Multivariate/cross \ Multivariate/cvectors \ Multivariate/flyspeck \ Multivariate/gamma \ Multivariate/geom \ Multivariate/tarski \ RichterHilbertAxiomGeometry/Topology \ RichterHilbertAxiomGeometry/TarskiAxiomGeometry_read \ Functionspaces/make \ Formal_ineqs/make-ineqs GREAT_100_THEOREMS:= \ 100/arithmetic_geometric_mean \ 100/arithmetic \ 100/ballot \ 100/bernoulli \ 100/bertrand-primerecip \ 100/birthday \ 100/cantor \ 100/cayley_hamilton \ 100/ceva \ 100/circle \ 100/chords \ 100/combinations \ 100/constructible \ 100/cosine \ 100/cubic \ 100/derangements \ 100/desargues \ 100/descartes \ 100/dirichlet \ 100/div3 \ 100/divharmonic \ 100/e_is_transcendental \ 100/euler \ 100/feuerbach \ 100/fourier \ 100/four_squares \ 100/friendship \ 100/fta \ 100/gcd \ 100/heron \ 100/inclusion_exclusion \ 100/independence \ 100/isosceles \ 100/konigsberg \ 100/lagrange \ 100/leibniz \ 100/lhopital \ 100/liouville \ 100/minkowski \ 100/morley \ 100/pascal \ 100/perfect \ 100/pick \ 100/piseries \ 100/platonic \ 100/pnt \ 100/polyhedron \ 100/ptolemy \ 100/pythagoras \ 100/quartic \ 100/ramsey \ 100/ratcountable \ 100/realsuncountable \ 100/reciprocity \ 100/stirling \ 100/subsequence \ 100/thales \ 100/triangular \ 100/two_squares \ 100/wilson TESTS:=$(STANDALONE_EXAMPLES) $(EXTENDED_EXAMPLES) $(GREAT_100_THEOREMS) LOGDIR:=/tmp/hollog_$(shell date '+%Y%m%d_%H%M') LOGS:=$(patsubst %,$(LOGDIR)/%,$(TESTS)) all: $(TESTS) cat $(LOGS) > $(LOGDIR)/holtest.log Library/analysis-transc: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading Library/analysis.ml,/transc.ml,calc_real.ml,machin.ml,polylog.ml,poly.ml' @echo '### Loading Library/analysis.ml,/transc.ml,calc_real.ml,machin.ml,polylog.ml,poly.ml' > $(LOGDIR)/$@ @(echo 'loadt "Library/analysis.ml";;'; echo 'loadt "Library/transc.ml";;'; \ echo 'loadt "Library/calc_real.ml";;'; echo 'loadt "Examples/machin.ml";;'; \ echo 'loadt "Examples/polylog.ml";;'; echo 'loadt "Library/poly.ml";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 Library/prime-pratt: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading Library/prime.ml,pratt.ml' @echo '### Loading Library/prime.ml,pratt.ml' > $(LOGDIR)/$@ @(echo 'loadt "Library/prime.ml";;'; echo 'loadt "Library/pratt.ml";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 Library/prime-pocklington: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading Library/prime.ml,pocklington.ml' @echo '### Loading Library/prime.ml,pocklington.ml' > $(LOGDIR)/$@ @(echo 'loadt "Library/prime.ml";;'; echo 'loadt "Library/pocklington.ml";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 Library/rstc-reduct: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading Library/rstc.ml,reduct.ml' @echo '### Loading Library/rstc.ml,reduct.ml' > $(LOGDIR)/$@ @(echo 'loadt "Library/rstc.ml";;'; echo 'loadt "Examples/reduct.ml";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 miz3/make-test: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading miz3/make.ml, miz3/test.ml (twice)' @echo '### Loading miz3/make.ml, miz3/test.ml (twice)' > $(LOGDIR)/$@ @(echo 'loadt "miz3/make.ml";;'; echo 'loadt "miz3/test.ml";;'; echo 'loadt "miz3/test.ml";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 Minisat/make-taut: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading Minisat/make.ml,Minisat/taut.ml' if which zchaff > /dev/null ; then \ echo '### Loading Minisat/make.ml,Minisat/taut.ml' > $(LOGDIR)/$@ ; \ (echo 'loadt "Minisat/make.ml";;'; echo 'loadt "Minisat/taut.ml";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 ; \ else \ echo '### Error: skip Minisat/make.ml, Minisat/taut.ml because zchaff is not available' > $(LOGDIR)/$@ ; \ fi Formal_ineqs/make-ineqs: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading Formal_ineqs/make.ml, examples.hl, examples_poly.hl, examples_flyspeck.hl' > $(LOGDIR)/$@ @(echo 'loadt "Formal_ineqs/make.ml";;'; echo 'loadt "Formal_ineqs/examples.hl";;'; echo 'loadt "Formal_ineqs/examples_poly.hl";;'; echo 'loadt "Formal_ineqs/examples_flyspeck.hl";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 100/bertrand-primerecip: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading 100/bertrand.ml,100/primerecip.ml' @echo '### Loading 100/bertrand.ml,100/primerecip.ml' > $(LOGDIR)/$@ @(echo 'loadt "100/bertrand.ml";;'; echo 'loadt "100/primerecip.ml";;') | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 %: @mkdir -p $(LOGDIR)/$$(dirname $@) @echo '### Loading $@.ml' @echo '### Loading $@.ml' > $(LOGDIR)/$@ @echo 'loadt "$@.ml";;' | (time $(HOLLIGHT)) >> $(LOGDIR)/$@ 2>&1 hol-light/holtest_parallel000077500000000000000000000023501303454263000162310ustar00rootroot00000000000000#!/bin/bash ####################################################################### # Load in a bunch of examples to test HOL Light is working properly # # This script attempts to distribute the tests over available cores # and should be faster in many cases than the sequential "holtest". # # Try examining the output using something like # # egrep -i '###|error in|not.found' /tmp/hollog_*/holtest.log # # to see progress and whether anything has gone wrong. # # You might first want to install the necessary external tools, # for instance with # # aptitude install prover9 coinor-csdp pari-gp libocamlgraph-ocaml-dev # ####################################################################### set -e if which hol-light > /dev/null ; then hollight=hol-light elif type ckpt > /dev/null; then make clean; make hol (cd Mizarlight; make clean; make) hollight=./hol else make clean; make (cd Mizarlight; make clean; make) hollight="ocaml -init hol.ml" fi make -j $(getconf _NPROCESSORS_ONLN) "HOLLIGHT=$hollight" SHELL=bash \ -f holtest.mk all # Remove "#"s in the follwing lines to build the proof-recording version # # echo '### Building proof-recording version'; # cd Proofrecording/hol_light # make clean; make hol hol-light/impconv.ml000066400000000000000000002011321303454263000147510ustar00rootroot00000000000000(* ========================================================================= *) (* Implicational conversions, implicational rewriting and target rewriting. *) (* *) (* (c) Copyright, Vincent Aravantinos, 2012-2013 *) (* Analysis and Design of Dependable Systems *) (* fortiss GmbH, Munich, Germany *) (* *) (* Formerly: Hardware Verification Group, *) (* Concordia University *) (* *) (* Contact: *) (* *) (* Distributed under the same license as HOL Light. *) (* ========================================================================= *) let IMP_REWRITE_TAC,TARGET_REWRITE_TAC,HINT_EXISTS_TAC, SEQ_IMP_REWRITE_TAC,CASE_REWRITE_TAC = let I = fun x -> x in (* Same as [UNDISCH] but also returns the undischarged term *) let UNDISCH_TERM th = let p = (fst o dest_imp o concl) th in p,UNDISCH th in (* Same as [UNDISCH_ALL] but also returns the undischarged terms *) let rec UNDISCH_TERMS th = try let t,th' = UNDISCH_TERM th in let ts,th'' = UNDISCH_TERMS th' in t::ts,th'' with Failure _ -> [],th in (* Comblies the function [f] to the conclusion of an implicational theorem. *) let MAP_CONCLUSION f th = let p,th = UNDISCH_TERM th in DISCH p (f th) in let strip_conj = binops `(/\)` in (* For a list [f1;...;fk], returns the first [fi x] that succeeds. *) let rec tryfind_fun fs x = match fs with |[] -> failwith "tryfind_fun" |f::fs' -> try f x with Failure _ -> tryfind_fun fs' x in (* Same as [mapfilter] but also provides the rank of the iteration as an * argument to [f]. *) let mapfilteri f = let rec self i = function |[] -> [] |h::t -> let rest = self (i+1) t in try f i h :: rest with Failure _ -> rest in self 0 in let list_of_option = function None -> [] | Some x -> [x] in let try_list f x = try f x with Failure _ -> [] in (* A few constants. *) let A_ = `A:bool` and B_ = `B:bool` and C_ = `C:bool` and D_ = `D:bool` in let T_ = `T:bool` in (* For a term t, builds `t ==> t` *) let IMP_REFL = let lem = TAUT `A ==> A` in fun t -> INST [t,A_] lem in (* Conversion version of [variant]: * Given variables [v1;...;vk] to avoid and a term [t], * returns [|- t = t'] where [t'] is the same as [t] without any use of the * variables [v1;...;vk]. *) let VARIANT_CONV av t = let vs = variables t in let mapping = filter (fun (x,y) -> x <> y) (zip vs (variants av vs)) in DEPTH_CONV (fun u -> ALPHA_CONV (assoc (bndvar u) mapping) u) t in (* Rule version of [VARIANT_CONV] *) let VARIANT_RULE = CONV_RULE o VARIANT_CONV in (* Discharges the first hypothesis of a theorem. *) let DISCH_HD th = DISCH (hd (hyp th)) th in (* Rule version of [REWR_CONV] *) let REWR_RULE = CONV_RULE o REWR_CONV in (* Given a list [A1;...;Ak] and a theorem [th], * returns [|- A1 /\ ... /\ Ak ==> th]. *) let DISCH_IMP_IMP = let f = function |[] -> I |t::ts -> rev_itlist (fun t -> REWR_RULE IMP_IMP o DISCH t) ts o DISCH t in f o rev in (* Given a term [A /\ B] and a theorem [th], returns [|- A ==> B ==> th]. *) let rec DISCH_CONJ t th = try let t1,t2 = dest_conj t in REWR_RULE IMP_IMP (DISCH_CONJ t1 (DISCH_CONJ t2 th)) with Failure _ -> DISCH t th in (* Specializes all the universally quantified variables of a theorem, * and returns both the theorem and the list of variables. *) let rec SPEC_VARS th = try let v,th' = SPEC_VAR th in let vs,th'' = SPEC_VARS th' in v::vs,th'' with Failure _ -> [],th in (* Comblies the function [f] to the body of a universally quantified theorem. *) let MAP_FORALL_BODY f th = let vs,th = SPEC_VARS th in GENL vs (f th) in (* Given a theorem of the form [!xyz. P ==> !uvw. C] and a function [f], * return [!xyz. P ==> !uvw. f C]. *) let GEN_MAP_CONCLUSION = MAP_FORALL_BODY o MAP_CONCLUSION o MAP_FORALL_BODY in (* Turn a theorem of the form [x ==> y /\ z] into [(x==>y) /\ (x==>z)]. * Also deals with universal quantifications if necessary * (e.g., [x ==> !v. y /\ z] will be turned into * [(x ==> !v. y) /\ (x ==> !v. z)]) * * possible improvement: apply the rewrite more locally *) let IMPLY_AND = let IMPLY_AND_RDISTRIB = TAUT `(x ==> y /\ z) <=> (x==>y) /\(x==>z)` in PURE_REWRITE_RULE [GSYM AND_FORALL_THM;IMP_IMP; RIGHT_IMP_FORALL_THM;IMPLY_AND_RDISTRIB;GSYM CONJ_ASSOC] in (* Returns the two operands of a binary combination. * Contrary to [dest_binary], does not check what is the operator. *) let dest_binary_blind = function |Comb(Comb(_,l),r) -> l,r |_ -> failwith "dest_binary_blind" in let spec_all = repeat (snd o dest_forall) in let thm_lt (th1:thm) th2 = th1 < th2 in (* GMATCH_MP (U1 |- !x1...xn. H1 /\ ... /\ Hk ==> C) (U2 |- P) * = (U1 u U2 |- !y1...ym. G1' /\ ... /\ Gl' ==> C') * where: * - P matches some Hi * - C' is the result of applying the matching substitution to C * - Gj' is the result of applying the matching substitution to Hj * - G1',...,Gl' is the list corresponding to H1,...,Hk but without Hi * - y1...ym are the variables among x1,...,xn that are not instantiated * * possible improvement: make a specific conversion, * define a MATCH_MP that also returns the instantiated variables *) let GMATCH_MP = let swap = CONV_RULE (REWR_CONV (TAUT `(p==>q==>r) <=> (q==>p==>r)`)) in fun th1 -> let vs,th1' = SPEC_VARS th1 in let hs,th1'' = UNDISCH_TERMS (PURE_REWRITE_RULE [IMP_CONJ] th1') in fun th2 -> let f h hs = let th1''' = DISCH h th1'' in let th1'''' = try swap (DISCH_IMP_IMP hs th1''') with Failure _ -> th1''' in MATCH_MP (GENL vs th1'''') th2 in let rec loop acc = function |[] -> [] |h::hs -> (try [f h (acc @ hs)] with Failure _ -> []) @ loop (h::acc) hs in loop [] hs in let GMATCH_MPS ths1 ths2 = let insert (y:thm) = function |[] -> [y] |x::_ as xs when equals_thm x y -> xs |x::xs when thm_lt x y -> x :: insert y xs |_::_ as xs -> y::xs in let inserts ys = itlist insert ys in match ths1 with |[] -> [] |th1::ths1' -> let rec self acc th1 ths1 = function |[] -> (match ths1 with [] -> acc | th::ths1' -> self acc th ths1' ths2) |th2::ths2' -> self (inserts (GMATCH_MP th1 th2) acc) th1 ths1 ths2' in self [] th1 ths1' ths2 in let MP_CLOSURE ths1 ths2 = let ths1 = filter (is_imp o spec_all o concl) ths1 in let rec self ths2 = function |[] -> [] |_::_ as ths1 -> let ths1'' = GMATCH_MPS ths1 ths2 in self ths2 ths1'' @ ths1'' in self ths2 ths1 in (* Set of terms. Implemented as ordered lists. *) let module Tset = struct type t = term list let cmp (x:term) y = Pervasives.compare x y let lt (x:term) y = Pervasives.compare x y < 0 let lift f = List.sort cmp o f let of_list = lift I let insert ts t = let rec self = function |[] -> [t] |x::xs when lt x t -> x::self xs |x::_ as xs when x = t -> xs |xs -> t::xs in if t = T_ then ts else self ts let remove ts t = let rec self = function |[] -> [] |x::xs when lt x t -> x::self xs |x::xs when x = t -> xs |_::_ as xs -> xs in self ts let strip_conj = let rec self acc t = try let t1,t2 = dest_conj t in self (self acc t1) t2 with Failure _ -> insert acc t in self [] let rec union l1 l2 = match l1 with |[] -> l2 |h1::t1 -> match l2 with |[] -> l1 |h2::t2 when lt h1 h2 -> h1::union t1 l2 |h2::t2 when h1 = h2 -> h1::union t1 t2 |h2::t2 -> h2::union l1 t2 let rec mem x = function |x'::xs when x' = x -> true |x'::xs when lt x' x -> mem x xs |_ -> false let subtract l1 l2 = filter (fun x -> not (mem x l2)) l1 let empty = [] let flat_revmap f = let rec self acc = function |[] -> acc |x::xs -> self (union (f x) acc) xs in self [] let flat_map f = flat_revmap f o rev let rec frees acc = function |Var _ as t -> insert acc t |Const _ -> acc |Abs(v,b) -> remove (frees acc b) v |Comb(u,v) -> frees (frees acc u) v let freesl ts = itlist (C frees) ts empty let frees = frees empty end in let module Type_annoted_term = struct type t = |Var_ of string * hol_type |Const_ of string * hol_type * term |Comb_ of t * t * hol_type |Abs_ of t * t * hol_type let type_of = function |Var_(_,ty) -> ty |Const_(_,ty,_) -> ty |Comb_(_,_,ty) -> ty |Abs_(_,_,ty) -> ty let rec of_term = function |Var(s,ty) -> Var_(s,ty) |Const(s,ty) as t -> Const_(s,ty,t) |Comb(u,v) -> let u' = of_term u and v' = of_term v in Comb_(u',v',snd (dest_fun_ty (type_of u'))) |Abs(x,b) -> let x' = of_term x and b' = of_term b in Abs_(x',b',mk_fun_ty (type_of x') (type_of b')) let rec equal t1 t2 = match t1,t2 with |Var_(s1,ty1),Var_(s2,ty2) |Const_(s1,ty1,_),Const_(s2,ty2,_) -> s1 = s2 && ty1 = ty2 |Comb_(u1,v1,_),Comb_(u2,v2,_) -> equal u1 u2 && equal v1 v2 |Abs_(v1,b1,_),Abs_(v2,b2,_) -> equal v1 v2 && equal b1 b2 |_ -> false let rec to_term = function |Var_(s,ty) -> mk_var(s,ty) |Const_(_,_,t) -> t |Comb_(u,v,_) -> mk_comb(to_term u,to_term v) |Abs_(v,b,_) -> mk_abs(to_term v,to_term b) let dummy = Var_("",aty) let rec find_term p t = if p t then t else match t with |Abs_(_,b,_) -> find_term p b |Comb_(u,v,_) -> try find_term p u with Failure _ -> find_term p v |_ -> failwith "Annot.find_term" end in let module Annot = Type_annoted_term in (* ------------------------------------------------------------------------- *) (* First-order matching of terms. *) (* *) (* Same note as in [drule.ml]: *) (* in the event of spillover patterns, this may return false results; *) (* but there's usually an implicit check outside that the match worked *) (* anyway. A test could be put in (see if any "env" variables are left in *) (* the term after abstracting out the pattern instances) but it'd be slower. *) (* ------------------------------------------------------------------------- *) let fo_term_match lcs p t = let fail () = failwith "fo_term_match" in let rec self bnds (tenv,tyenv as env) p t = match p,t with |Comb(p1,p2),Annot.Comb_(t1,t2,_) -> self bnds (self bnds env p1 t1) p2 t2 |Abs(v,p),Annot.Abs_(v',t,_) -> let tyenv' = type_match (type_of v) (Annot.type_of v') tyenv in self ((v',v)::bnds) (tenv,tyenv') p t |Const(n,ty),Annot.Const_(n',ty',_) -> if n <> n' then fail () else let tyenv' = type_match ty ty' tyenv in tenv,tyenv' |Var(n,ty) as v,t -> (* Is [v] bound? *) (try if Annot.equal t (rev_assoc v bnds) then env else fail () (* No *) with Failure _ -> if mem v lcs then match t with |Annot.Var_(n',ty') when n' = n && ty' = ty -> env |_ -> fail () else let tyenv' = type_match ty (Annot.type_of t) tyenv in let t' = try Some (rev_assoc v tenv) with Failure _ -> None in match t' with |Some t' -> if t = t' then tenv,tyenv' else fail () |None -> (t,v)::tenv,tyenv') |_ -> fail () in let tenv,tyenv = self [] ([],[]) p (Annot.of_term t) in let inst = inst tyenv in List.rev_map (fun t,v -> Annot.to_term t,inst v) tenv,tyenv in let GEN_PART_MATCH_ALL = let rec match_bvs t1 t2 acc = try let v1,b1 = dest_abs t1 and v2,b2 = dest_abs t2 in let n1 = fst(dest_var v1) and n2 = fst(dest_var v2) in let newacc = if n1 = n2 then acc else insert (n1,n2) acc in match_bvs b1 b2 newacc with Failure _ -> try let l1,r1 = dest_comb t1 and l2,r2 = dest_comb t2 in match_bvs l1 l2 (match_bvs r1 r2 acc) with Failure _ -> acc in fun partfn th -> let sth = SPEC_ALL th in let bod = concl sth in let pbod = partfn bod in let lcs = intersect (frees (concl th)) (freesl(hyp th)) in let fvs = subtract (subtract (frees bod) (frees pbod)) lcs in fun tm -> let bvms = match_bvs tm pbod [] in let abod = deep_alpha bvms bod in let ath = EQ_MP (ALPHA bod abod) sth in let insts,tyinsts = fo_term_match lcs (partfn abod) tm in let eth = INSTANTIATE_ALL ([],insts,tyinsts) (GENL fvs ath) in let fth = itlist (fun v th -> snd(SPEC_VAR th)) fvs eth in let tm' = partfn (concl fth) in if Pervasives.compare tm' tm = 0 then fth else try SUBS[ALPHA tm' tm] fth with Failure _ -> failwith "PART_MATCH: Sanity check failure" in let module Fo_nets = struct type term_label = |Vnet of int |Lcnet of string * int |Cnet of string * int |Lnet of int type 'a t = Netnode of (term_label * 'a t) list * 'a list let empty_net = Netnode([],[]) let enter = let label_to_store lcs t = let op,args = strip_comb t in let nargs = length args in match op with |Const(n,_) -> Cnet(n,nargs),args |Abs(v,b) -> let b' = if mem v lcs then vsubst [genvar(type_of v),v] b else b in Lnet nargs,b'::args |Var(n,_) when mem op lcs -> Lcnet(n,nargs),args |Var(_,_) -> Vnet nargs,args |_ -> assert false in let rec net_update lcs elem (Netnode(edges,tips)) = function |[] -> Netnode(edges,elem::tips) |t::rts -> let label,nts = label_to_store lcs t in let child,others = try (snd F_F I) (remove (fun (x,y) -> x = label) edges) with Failure _ -> empty_net,edges in let new_child = net_update lcs elem child (nts@rts) in Netnode ((label,new_child)::others,tips) in fun lcs (t,elem) net -> net_update lcs elem net [t] let lookup = let label_for_lookup t = let op,args = strip_comb t in let nargs = length args in match op with |Const(n,_) -> Cnet(n,nargs),args |Abs(_,b) -> Lnet nargs,b::args |Var(n,_) -> Lcnet(n,nargs),args |Comb _ -> assert false in let rec follow (Netnode(edges,tips)) = function |[] -> tips |t::rts -> let label,nts = label_for_lookup t in let collection = try follow (assoc label edges) (nts@rts) with Failure _ -> [] in let rec support = function |[] -> [0,rts] |t::ts -> let ((k,nts')::res') as res = support ts in (k+1,(t::nts'))::res in let follows = let f (k,nts) = try follow (assoc (Vnet k) edges) nts with Failure _ -> [] in map f (support nts) in collection @ flat follows in fun t net -> follow net [t] let rec filter p (Netnode(edges,tips)) = Netnode( List.map (fun l,n -> l,filter p n) edges, List.filter p tips) end in let module Variance = struct type t = Co | Contra let neg = function Co -> Contra | Contra -> Co end in (*****************************************************************************) (* IMPLICATIONAL RULES *) (* i.e., rules to build propositions based on implications rather than *) (* equivalence. *) (*****************************************************************************) let module Impconv = struct let MKIMP_common lem th1 th2 = let a,b = dest_imp (concl th1) and c,d = dest_imp (concl th2) in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) (* Similar to [MK_CONJ] but theorems should be implicational instead of * equational, i.e., conjoin both sides of two implicational theorems. * * More precisely: given two theorems [A ==> B] and [C ==> D], * returns [A /\ C ==> B /\ D]. *) let MKIMP_CONJ = MKIMP_common MONO_AND (* Similar to [MK_DISJ] but theorems should be implicational instead of * equational, i.e., disjoin both sides of two implicational theorems. * * More precisely: given two theorems [A ==> B] and [C ==> D], * returns [A \/ C ==> B \/ D]. *) let MKIMP_DISJ = MKIMP_common MONO_OR let MKIMP_IFF = let lem = TAUT `((A ==> B) ==> (C ==> D)) /\ ((B ==> A) ==> (D ==> C)) ==> (A <=> B) ==> (C <=> D)` in fun th1 th2 -> let ab,cd = dest_imp (concl th1) in let a,b = dest_imp ab and c,d = dest_imp cd in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) (* th1 = (A ==> B) ==> C1 * th2 = (B ==> A) ==> C2 * output = (A <=> B) ==> (C1 /\ C2) *) let MKIMP_CONTRA_IFF = let lem = TAUT `((A ==> B) ==> C) /\ ((B ==> A) ==> D) ==> (A <=> B) ==> C /\ D` in fun th1 th2 -> let ab,c = dest_imp (concl th1) and _,d = dest_imp (concl th2) in let a,b = dest_imp ab in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) let MKIMPL_CONTRA_IFF = let lem = TAUT `((A ==> B) ==> C) ==> (A <=> B) ==> C /\ (B ==> A)` in fun th -> let ab,c = dest_imp (concl th) in let a,b = dest_imp ab in MP (INST [a,A_;b,B_;c,C_] lem) th let MKIMPR_CONTRA_IFF = let lem = TAUT `((B ==> A) ==> D) ==> (A <=> B) ==> (A ==> B) /\ D` in fun th -> let ba,d = dest_imp (concl th) in let b,a = dest_imp ba in MP (INST [a,A_;b,B_;d,D_] lem) th let MKIMP_CO_IFF = let lem = TAUT `(C ==> A ==> B) /\ (D ==> B ==> A) ==> C /\ D ==> (A <=> B)` in fun th1 th2 -> let c,ab = dest_imp (concl th1) and d,_ = dest_imp (concl th2) in let a,b = dest_imp ab in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) let MKIMPL_CO_IFF = let lem = TAUT `(C ==> A ==> B) ==> C /\ (B ==> A) ==> (A <=> B)` in fun th -> let c,ab = dest_imp (concl th) in let a,b = dest_imp ab in MP (INST [a,A_;b,B_;c,C_] lem) th let MKIMPR_CO_IFF = let lem = TAUT `(D ==> B ==> A) ==> (A ==> B) /\ D ==> (A <=> B)` in fun th -> let d,ba = dest_imp (concl th) in let b,a = dest_imp ba in MP (INST [a,A_;b,B_;d,D_] lem) th (* Given two theorems [A ==> B] and [C ==> D], * returns [(B ==> C) ==> (A ==> D)]. *) let MKIMP_IMP th1 th2 = let b,a = dest_imp (concl th1) and c,d = dest_imp (concl th2) in MP (INST [a,A_;b,B_;c,C_;d,D_] MONO_IMP) (CONJ th1 th2) let MKIMPL_common lem = let lem' = REWRITE_RULE[] (INST [C_,D_] lem) in fun th t -> let a,b = dest_imp (concl th) in MP (INST [a,A_;b,B_;t,C_] lem') th (* Given a theorem [A ==> B] and a term [C], * returns [A /\ C ==> B /\ C]. *) let MKIMPL_CONJ = MKIMPL_common MONO_AND (* Given a theorem [A ==> B] and a term [C], * returns [A \/ C ==> B \/ C]. *) let MKIMPL_DISJ = MKIMPL_common MONO_OR (* Given a theorem [A ==> B] and a term [C], * returns [(B ==> C) ==> (A ==> C)]. *) let MKIMPL_IMP = let MONO_IMP' = REWRITE_RULE[] (INST [C_,D_] MONO_IMP) in fun th t -> let b,a = dest_imp (concl th) in MP (INST [a,A_;b,B_;t,C_] MONO_IMP') th let MKIMPR_common lem = let lem' = REWRITE_RULE[] (INST [A_,B_] lem) in fun t th -> let c,d = dest_imp (concl th) in MP (INST [c,C_;d,D_;t,A_] lem') th (* Given a term [A] and a theorem [B ==> C], * returns [A /\ B ==> A /\ C]. *) let MKIMPR_CONJ = MKIMPR_common MONO_AND (* Given a term [A] and a theorem [B ==> C], * returns [A \/ B ==> A \/ C]. *) let MKIMPR_DISJ = MKIMPR_common MONO_OR (* Given a term [A] and a theorem [B ==> C], * returns [(A ==> B) ==> (A ==> C)]. *) let MKIMPR_IMP = MKIMPR_common MONO_IMP (* Given a theorem [A ==> B], returns [~B ==> ~A]. *) let MKIMP_NOT th = let b,a = dest_imp (concl th) in MP (INST [a,A_;b,B_] MONO_NOT) th let MKIMP_QUANT lem x th = let x_ty = type_of x and p,q = dest_imp (concl th) in let p' = mk_abs(x,p) and q' = mk_abs(x,q) in let P = mk_var("P",mk_fun_ty x_ty bool_ty) in let Q = mk_var("Q",mk_fun_ty x_ty bool_ty) in let lem = INST [p',P;q',Q] (INST_TYPE [x_ty,aty] lem) in let c = ONCE_DEPTH_CONV (ALPHA_CONV x) THENC ONCE_DEPTH_CONV BETA_CONV in MP (CONV_RULE c lem) (GEN x th) (* Given a variable [x] and a theorem [A ==> B], * returns [(!x. A) ==> (!x. B)]. *) let MKIMP_FORALL = MKIMP_QUANT MONO_FORALL (* Given a variable [x] and a theorem [A ==> B], * returns [(?x. A) ==> (?x. B)]. *) let MKIMP_EXISTS = MKIMP_QUANT MONO_EXISTS (* Given two theorems [A ==> B] and [B ==> C ==> D], * returns [(B ==> C) ==> (A ==> D)], * i.e., similar to [MKIMP_IMP] but allows to remove the context [B] * since it is a consequence of [A]. *) let MKIMP_IMP_CONTRA_CTXT = let lem = TAUT `(B==>A) /\ (A==>B==>C==>D) ==> (A==>C) ==> (B==>D)` in fun th1 th2 -> let a,bcd = dest_imp (concl th2) in let b,cd = dest_imp bcd in let c,d = dest_imp cd in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) let MKIMP_IMP_CO_CTXT = let lem = TAUT `(A==>B) /\ (A==>B==>D==>C) ==> (B==>D) ==> (A==>C)` in fun th1 th2 -> let a,bdc = dest_imp (concl th2) in let b,dc = dest_imp bdc in let d,c = dest_imp dc in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) (* Given a theorem [B ==> C ==> D], returns [(B ==> C) ==> (B ==> D)], * i.e., similar to [MKIMP_IMP] but allows to remove the context [B] * since it is a consequence of [A]. *) let MKIMPR_IMP_CTXT = let lem = TAUT `(A==>C==>D) ==> (A==>C) ==> (A==>D)` in fun th -> let a,cd = dest_imp (concl th) in let c,d = dest_imp cd in MP (INST [c,C_;d,D_;a,A_] lem) th (* Given two theorems [A ==> B] and [A ==> B ==> C ==> D], * returns [(A /\ C) ==> (B /\ D)], * i.e., similar to [MKIMP_CONJ] but allows to remove the contexts [A] and [B]. *) let MKIMP_CONJ_CONTRA_CTXT = let lem = TAUT `(C==>A==>B) /\ (A==>B==>C==>D) ==> (A/\C==>B/\D)` in fun th1 th2 -> let a,bcd = dest_imp (concl th2) in let b,cd = dest_imp bcd in let c,d = dest_imp cd in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) let MKIMPL_CONJ_CONTRA_CTXT = let lem = TAUT `(C==>A==>B) ==> (A/\C==>B/\C)` in fun th -> let c,ab = dest_imp (concl th) in let a,b = dest_imp ab in MP (INST [a,A_;b,B_;c,C_] lem) th let MKIMPR_CONJ_CONTRA_CTXT = let lem = TAUT `(A==>C==>D) ==> (A/\C==>A/\D)` in fun th -> let a,cd = dest_imp (concl th) in let c,d = dest_imp cd in MP (INST [a,A_;c,C_;d,D_] lem) th let MKIMP_CONJ_CO_CTXT = let lem = TAUT `(B==>A) /\ (B==>D==>C) ==> (B/\D==>A/\C)` in fun th1 th2 -> let b,a = dest_imp (concl th1) in let d,c = dest_imp (snd (dest_imp (concl th2))) in MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) let MKIMPL_CONJ_CO_CTXT = let lem = TAUT `(B==>A) ==> (B/\C==>A/\C)` in fun th -> let b,a = dest_imp (concl th) in fun c -> MP (INST [a,A_;b,B_;c,C_] lem) th let MKIMPL_CONJ_CO2_CTXT = let lem = TAUT `(C==>B==>A) ==> (B/\C==>A/\C)` in fun th -> let c,ba = dest_imp (concl th) in let b,a = dest_imp ba in MP (INST [a,A_;b,B_;c,C_] lem) th let MKIMPR_CONJ_CO_CTXT = MKIMPR_CONJ_CONTRA_CTXT (*****************************************************************************) (* IMPLICATIONAL CONVERSIONS *) (*****************************************************************************) open Variance (* An implicational conversion maps a term t to a theorem of the form: * t' ==> t if covariant * t ==> t' if contravariant *) type imp_conv = Variance.t -> term -> thm (* Trivial embedding of conversions into implicational conversions. *) let imp_conv_of_conv:conv->imp_conv = fun c v t -> let th1,th2 = EQ_IMP_RULE (c t) in match v with Co -> th2 | Contra -> th1 (* Retrieves the outcome of an implicational conversion, i.e., t'. *) let imp_conv_outcome th v = let t1,t2 = dest_binary_blind (concl th) in match v with Co -> t1 | Contra -> t2 (* [ALL_IMPCONV _ t] returns `t==>t` *) let ALL_IMPCONV:imp_conv = fun _ -> IMP_REFL (* The implicational conversion which always fails. *) let NO_IMPCONV:imp_conv = fun _ _ -> failwith "NO_IMPCONV" let bind_impconv (c:imp_conv) v th = let t1,t2 = dest_imp (concl th) in match v with |Co -> IMP_TRANS (c v t1) th |Contra -> IMP_TRANS th (c v t2) let THEN_IMPCONV (c1:imp_conv) c2 v t = bind_impconv c2 v (c1 v t) (*****************************************************************************) (* SOME USEFUL IMPLICATIONAL CONVERSIONS *) (*****************************************************************************) (* Given a theorem [p ==> c], returns the implicational conversion which: * - in the covariant case, matches the input term [t] against [c] and returns * [s(p) ==> t], where [s] is the matching substitution * - in the contravariant case, matches the input term [t] against [p] and returns * [t ==> s(c)], where [s] is the matching substitution *) let MATCH_MP_IMPCONV:thm->imp_conv = fun th -> function |Co -> GEN_PART_MATCH rand th |Contra -> GEN_PART_MATCH lhand th (*****************************************************************************) (* INTERFACE *) (*****************************************************************************) (* From an implicational conversion builds a rule, i.e., a function which * takes a theorem and returns a new theorem. *) let IMPCONV_RULE:imp_conv->thm->thm = fun c th -> let t = concl th in MATCH_MP (c Contra t) th (* From an implicational conversion builds a tactic. *) let IMPCONV_TAC:imp_conv->tactic = fun cnv (_,c as g) -> (MATCH_MP_TAC (cnv Co c) THEN TRY (ACCEPT_TAC TRUTH)) g (*****************************************************************************) (* CONTEXT HANDLING *) (*****************************************************************************) (* [term list] = terms to add to the context *) type 'a with_context = With_context of 'a * (Tset.t -> 'a with_context) * (term -> 'a with_context) let apply (With_context(c,_,_)) = c (* Maybe avoid the augment if the input list is empty? *) let augment (With_context(_,a,_)) = a let diminish (With_context(_,_,d)) = d let apply_with_context c ctx v t = DISCH_CONJ ctx (apply (augment c (Tset.strip_conj ctx)) v t) let imp_conv_of_ctx_imp_conv = (apply:imp_conv with_context -> imp_conv) (* Consider two implicational conversions ic1, ic2. * Suppose [ic1 Co A] returns [B ==> A], and [ic2 Co C] returns [D ==> C], * then [CONJ_IMPCONV ic1 ic2 Co (A /\ C)] returns [B /\ D ==> A /\ C]. * Suppose [ic1 Contra A] returns [A ==> B], and [ic2 Contra C] returns * [C ==> D], then [CONJ_IMPCONV ic1 ic2 Contra (A /\ B)] * returns [A /\ B ==> C /\ D]. * * Additionally takes the context into account, i.e., if [ic2 Co C] returns * [A |- D ==> C], * then [CONJ_IMPCONV ic1 ic2 Co (A /\ B)] returns [|- C /\ D ==> A /\ B] * (i.e., [A] does not appear in the hypotheses). *) let rec CONJ_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> let t1,t2 = dest_conj t in match v with |Co -> (try let th1 = apply c Co t1 in try let t1' = imp_conv_outcome th1 Co in MKIMP_CONJ_CO_CTXT th1 (apply_with_context c t1' Co t2) with Failure _ -> MKIMPL_CONJ_CO_CTXT th1 t2 with Failure _ -> MKIMPR_CONJ_CO_CTXT (apply_with_context c t1 Co t2)) |Contra -> try (* note: we remove t1 in case it appears in t2, since otherwise, * t1 removes t2 and t2 removes t1 *) let t2s = Tset.remove (Tset.strip_conj t2) t1 in let th1 = apply (augment c t2s) Contra t1 in try let t1' = imp_conv_outcome th1 Contra in let t1s = Tset.strip_conj t1 and t1s' = Tset.strip_conj t1' in let t1s'' = Tset.union t1s t1s' in let th2 = apply (augment c t1s'') Contra t2 in let th2' = DISCH_CONJ t1 (DISCH_CONJ t1' th2) in MKIMP_CONJ_CONTRA_CTXT (DISCH_CONJ t2 th1) th2' with Failure _ -> MKIMPL_CONJ_CONTRA_CTXT (DISCH_CONJ t2 th1) with Failure _ -> MKIMPR_CONJ_CONTRA_CTXT (apply_with_context c t1 Contra t2)) :imp_conv), CONJ_CTXIMPCONV o augment c, CONJ_CTXIMPCONV o diminish c) (* Consider two implicational conversions ic1, ic2. * Suppose [ic1 Co A] returns [B ==> A], and [ic2 Co C] returns [D ==> C], * then [DISJ_IMPCONV ic1 ic2 Co (A \/ C)] returns [B \/ D ==> A \/ C]. * Suppose [ic1 Contra A] returns [A ==> B], and [ic2 Contra C] returns * [C ==> D], then [DISJ_IMPCONV ic1 ic2 Contra (A \/ B)] * returns [A \/ B ==> C \/ D]. *) let rec DISJ_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> let t1,t2 = dest_disj t in try let th1 = apply c v t1 in try MKIMP_DISJ th1 (apply c v t2) with Failure _ -> MKIMPL_DISJ th1 t2 with Failure _ -> MKIMPR_DISJ t1 (apply c v t2)):imp_conv), DISJ_CTXIMPCONV o augment c, DISJ_CTXIMPCONV o diminish c) (* Consider two implicational conversions ic1, ic2. * Suppose [ic1 Contra A] returns [A ==> B], and [ic2 Co C] returns [D ==> C], * then [IMP_IMPCONV ic1 ic2 Co (A ==> C)] returns [(B ==> D) ==> (A ==> C)]. * Suppose [ic1 Co A] returns [B ==> A], and [ic2 Contra C] returns * [C ==> D], then [IMP_IMPCONV ic1 ic2 Contra (A ==> C)] * returns [(A ==> C) ==> (B ==> D)]. * * Additionally takes the context into account, i.e., if [ic2 Co C] returns * [B |- D ==> C], then [IMP_IMPCONV ic1 ic2 Co (A ==> C)] returns * [|- (B ==> D) ==> (A ==> C)] (i.e., [B] does not appear in the hypotheses). *) let rec IMP_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> let t1,t2 = dest_imp t in try let v' = Variance.neg v in let th1 = apply c v' t1 in let t1' = imp_conv_outcome th1 v' in let t1s = Tset.union (Tset.strip_conj t1) (Tset.strip_conj t1') in let c' = augment c t1s in let mk = match v with Co -> MKIMP_IMP_CO_CTXT | Contra -> MKIMP_IMP_CONTRA_CTXT in try mk th1 (DISCH_CONJ t1 (DISCH_CONJ t1' (apply c' v t2))) with Failure _ -> MKIMPL_IMP th1 t2 with Failure _ -> MKIMPR_IMP_CTXT (apply_with_context c t1 v t2) ):imp_conv), IMP_CTXIMPCONV o augment c, IMP_CTXIMPCONV o diminish c) let rec IFF_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> let t1,t2 = dest_iff t in let lr,l,r = match v with |Co -> MKIMP_CO_IFF,MKIMPL_CO_IFF,MKIMPR_CO_IFF |Contra -> MKIMP_CONTRA_IFF,MKIMPL_CONTRA_IFF,MKIMPR_CONTRA_IFF in (try let th1 = apply c v (mk_imp (t1,t2)) in try let th2 = apply c v (mk_imp (t2,t1)) in (try MKIMP_IFF th1 th2 with Failure _ -> lr th1 th2) with Failure _ -> l th1 with Failure _ -> r (apply c v (mk_imp (t2,t1))))):imp_conv), IFF_CTXIMPCONV o augment c, IFF_CTXIMPCONV o diminish c) (* Consider an implicational conversion ic. * Suppose [ic Contra A] returns [A ==> B] * then [NOT_IMPCONV ic Co ~A] returns [~B ==> ~A]. * Suppose [ic Co A] returns [B ==> A] * then [NOT_IMPCONV ic Contra ~A] returns [~A ==> ~B]. *) let rec NOT_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> MKIMP_NOT (apply c (Variance.neg v) (dest_neg t))):imp_conv), NOT_CTXIMPCONV o augment c, NOT_CTXIMPCONV o diminish c) let rec QUANT_CTXIMPCONV mkimp sel (c:imp_conv with_context) = With_context( ((fun v t -> let x,b = sel t in let c' = diminish c x in mkimp x (apply c' v b)):imp_conv), QUANT_CTXIMPCONV mkimp sel o augment c, QUANT_CTXIMPCONV mkimp sel o diminish c) (* Consider an implicational conversion ic. * Suppose [ic Co A] returns [B ==> A] * then [FORALL_IMPCONV ic Co (!x.A)] returns [(!x.B) ==> (!x.A)]. * Suppose [ic Contra A] returns [A ==> B] * then [FORALL_IMPCONV ic Contra (!x.A)] returns [(!x.A) ==> (!x.B)]. *) let FORALL_CTXIMPCONV = QUANT_CTXIMPCONV MKIMP_FORALL dest_forall (* Consider an implicational conversion ic. * Suppose [ic Co A] returns [B ==> A] * then [EXISTS_IMPCONV ic Co (?x.A)] returns [(?x.B) ==> (?x.A)]. * Suppose [ic Contra A] returns [A ==> B] * then [EXISTS_IMPCONV ic Contra (?x.A)] returns [(?x.A) ==> (?x.B)]. *) let EXISTS_CTXIMPCONV = QUANT_CTXIMPCONV MKIMP_EXISTS dest_exists (* Applies an implicational conversion on the subformula(s) of the input term*) let rec SUB_CTXIMPCONV = let iff_ty = `:bool->bool->bool` in fun c -> With_context( ((fun v t -> let n,ty = dest_const (fst (strip_comb t)) in apply ((match n with |"==>" -> IMP_CTXIMPCONV |"/\\" -> CONJ_CTXIMPCONV |"\\/" -> DISJ_CTXIMPCONV |"=" when ty = iff_ty -> IFF_CTXIMPCONV |"!" -> FORALL_CTXIMPCONV |"?" -> EXISTS_CTXIMPCONV |"~" -> NOT_CTXIMPCONV |_ -> failwith "SUB_CTXIMPCONV") c) v t):imp_conv), SUB_CTXIMPCONV o augment c, SUB_CTXIMPCONV o diminish c) (* Takes a theorem which results of an implicational conversion and applies * another implicational conversion on the outcome. *) let bind_ctximpconv (c:imp_conv with_context) v th = let t1,t2 = dest_imp (concl th) in match v with |Co -> IMP_TRANS (apply c v t1) th |Contra -> IMP_TRANS th (apply c v t2) let rec BIND_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v th -> bind_ctximpconv c v th), BIND_CTXIMPCONV o augment c, BIND_CTXIMPCONV o diminish c)) (* Sequential combinator. *) let rec THEN_CTXIMPCONV (c1:imp_conv with_context) (c2:imp_conv with_context) = With_context( ((fun v t -> bind_ctximpconv c2 v (apply c1 v t)):imp_conv), (fun x -> THEN_CTXIMPCONV (augment c1 x) (augment c2 x)), (fun x -> THEN_CTXIMPCONV (diminish c1 x) (diminish c2 x))) (* Try combinator *) let rec TRY_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> try apply c v t with Failure _ | Unchanged -> ALL_IMPCONV v t):imp_conv), TRY_CTXIMPCONV o augment c, TRY_CTXIMPCONV o diminish c) (* Applies the first of two implicational conversions that succeeds. *) let rec ORELSE_CTXIMPCONV (c1:imp_conv with_context) (c2:imp_conv with_context) = With_context( ((fun v t -> try apply c1 v t with Failure _ -> apply c2 v t):imp_conv), (fun x -> ORELSE_CTXIMPCONV (augment c1 x) (augment c2 x)), (fun x -> ORELSE_CTXIMPCONV (diminish c1 x) (diminish c2 x))) (* Makes an implicational conversion fail if applying it leaves a term * unchanged. *) let rec CHANGED_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> let th = apply c v t in let l,r = dest_imp (concl th) in if aconv l r then failwith "CHANGED_CTXIMPCONV" else th):imp_conv), CHANGED_CTXIMPCONV o augment c, CHANGED_CTXIMPCONV o diminish c) let rec UNCHANGED_OF_FAIL_CTXIMPCONV (c:imp_conv with_context) = With_context( ((fun v t -> try apply c v t with Failure _ -> raise Unchanged ):imp_conv), UNCHANGED_OF_FAIL_CTXIMPCONV o augment c, UNCHANGED_OF_FAIL_CTXIMPCONV o diminish c) let rec REPEAT_UNCHANGED_CTXIMPCONV = let rec map_all f xs x = match xs with |[] -> [] |y::ys -> f y x :: map_all f ys x in fun (cs:imp_conv with_context list) -> With_context( ((fun v t -> let rec loop changed acc = function |[] when changed -> loop false acc cs |[] -> acc |c::cs' -> try let acc' = bind_ctximpconv c v acc in loop true acc' cs' with Unchanged -> loop changed acc cs' in loop false (IMP_REFL t) cs):imp_conv), REPEAT_UNCHANGED_CTXIMPCONV o map_all augment cs, REPEAT_UNCHANGED_CTXIMPCONV o map_all diminish cs) type atomic = Atomic | Non_atomic let DEPTH_CTXIMPCONV = let bind c na v th = let t1,t2 = dest_imp (concl th) in match v with |Co -> IMP_TRANS (apply c na v t1) th |Contra -> IMP_TRANS th (apply c na v t2) in let rec self (c:(atomic->imp_conv) with_context) = With_context( (fun v t -> try let th1 = apply (SUB_CTXIMPCONV (self c)) v t in (try bind c Non_atomic v th1 with Failure _ -> th1) with | Failure "SUB_CTXIMPCONV" -> let th1 = apply c Atomic v t in (try bind_ctximpconv (self c) v th1 with Failure _ -> th1) | Failure _ -> apply c Non_atomic v t), self o augment c, self o diminish c) in UNCHANGED_OF_FAIL_CTXIMPCONV o self let TOP_DEPTH_CTXIMPCONV = let rec self (c:imp_conv with_context) = With_context( (fun v t -> try let th = apply c v t in try bind_ctximpconv (self c) v th with Failure _ -> th with Failure _ -> apply (SUB_CTXIMPCONV (self c)) v t), self o augment c, self o diminish c) in UNCHANGED_OF_FAIL_CTXIMPCONV o self let ONCE_DEPTH_CTXIMPCONV = let rec self (c:(atomic->imp_conv) with_context) = With_context( (fun v t -> try apply (SUB_CTXIMPCONV (self c)) v t with | Failure "SUB_CTXIMPCONV" -> apply c Atomic v t | Failure _ -> apply c Non_atomic v t), self o augment c, self o diminish c) in UNCHANGED_OF_FAIL_CTXIMPCONV o self let CTXIMPCONV_RULE (c:imp_conv with_context) th = MATCH_MP (apply c Contra (concl th)) th let CTXIMPCONV_TAC (cnv:imp_conv with_context) : tactic = fun (asms,c as g) -> let cnv' = augment cnv (map (concl o snd) asms) in (MATCH_MP_TAC (apply cnv' Co c) THEN TRY (ACCEPT_TAC TRUTH)) g (*****************************************************************************) (* REWRITE IMPLICATIONAL CONVERSION *) (*****************************************************************************) (* Given a theorem [H1,...,Hn |- P ==> l = r], * returns the variables that occur in [P] and [r] but not in the rest. * Basically represents the variables that are introduced by the implicational * rewrite (similar status as variables occurring in the r.h.s. of a rewrite * but not in the l.h.s.). *) let indep_vars th = let hs,c = dest_thm (SPEC_ALL th) in let p,c = dest_imp c in let all_vars = union (frees p) (frees (rhs c)) in let dep_vars = union (frees (lhs c)) (freesl hs) in subtract all_vars dep_vars (* Given a list of variables to avoid [v1,...,vk], a theorem of the form * [hs |- !x1...xn. p ==> !y1...ym. l = r], and a term [t], matches [t] with * [l], yielding the substitution [s], and returns the theorem * [s(hs) |- !z1...zp. s(p) ==> s(l) = s(r)] where [z1], ..., [zp] are the * variables among [x1], ..., [xn], [y1], ..., [ym] that are not instantiated * by [s], and renamed so as to avoid [v1], ..., [vk]. *) let GEN_IMPREWR_CONV avs = let sel = lhs o snd o strip_forall o snd o dest_imp in let pmatch = GEN_PART_MATCH_ALL sel in fun th -> let pmatch' = pmatch th in fun t -> let th' = pmatch' t in VARIANT_RULE avs (GENL (indep_vars th') th') (* A conversion which returns not only a theorem but also a list of terms * which is a sublist of the theorem hypotheses, and a list of terms which * are the variables newly introduced by the conversion. * * See [IMPREWR_CONV] for an example. *) type annot_conv = term -> thm * term option * term list (* Takes a list of variables to avoid [av], a theorem [th] of the form * [h1,..,hk |- !x1...xn. p ==> !y1...ym. l = r], and a term [t] * and returns a conversion with hypotheses defined as follows: * for a term [t], if [t] matches [l] with substitution [s], then return * the theorem [h1,...,hk,s(p) |- t = s(r)] and the the list containing only * [s(p)]. * * The purpose of the conversion with hypothesis is to be able to distinguish * which hypothesis comes from the input theorem and which is added by the * conversion itself. *) let IMPREWR_CONV:Tset.t->thm->annot_conv = fun avs th -> let f t = SPEC_VARS (GEN_IMPREWR_CONV avs th t) in fun t -> let vs,uh = f t in let u = fst (dest_imp (concl uh)) in UNDISCH uh,Some u,Tset.of_list vs let REWR_ANNOTCONV avs th t = let th' = PART_MATCH lhs th t in let _,t' = dest_binary_blind (concl th') in let new_vars = Tset.frees t' in let old_vars = Tset.union (Tset.frees t) (Tset.freesl (hyp th')) in th',None,Tset.subtract new_vars old_vars let ORDER_ANNOTCONV cnv t = let th,_,_ as res = cnv t in let l,r = dest_binary_blind (concl th) in if term_order l r then res else failwith "ORDER_ANNOTCONV" (* Takes a theorem, a net of conversions with hypotheses (which also take * variables to avoid), and adds to the net the conversion corresponding to * the theorem. * * Special cases: * - usual term rewriting is handled with [REWR_CONV] instead of introducing * a fake premise. Might be useful though to introduce a fake premise since * the conversion would benefit from a better handling of variables occurring * in the r.h.s. but not in the l.h.s. * - a theorem of the form [p ==> c] where [c] is not equational is turned into * [p ==> c = T] * - a theorem of the form [p ==> ~c] is turned into [p ==> c = F] *) let pat_cnv_of_thm th : (term * (term list->annot_conv)) = let th = SPEC_ALL th in let lconsts = freesl (hyp th) and c = concl th in match c with |Comb(Comb(Const("=",_),l),r) as t -> let matches = C (can o term_match lconsts) in if free_in l r || (matches l r && matches r l) then t,C REWR_ANNOTCONV (MAP_FORALL_BODY EQT_INTRO th) else l,C REWR_ANNOTCONV th |Comb(Comb(Const("==>",_),p),c) as t -> let matches = C (can o fo_term_match lconsts) in let imprewr_concl f = C IMPREWR_CONV (GEN_MAP_CONCLUSION f th) in (match c with |Comb(Comb(Const("=",_),l),r) -> if free_in l r || (matches l r && matches r l) || is_var l then if matches p c then t, C REWR_ANNOTCONV (EQT_INTRO th) else c, imprewr_concl EQT_INTRO else l, C IMPREWR_CONV th |Comb(Const("~",_),l) -> l, imprewr_concl EQF_INTRO |l -> l, imprewr_concl EQT_INTRO) |Comb(Const("~",_),l) -> l, C REWR_ANNOTCONV (EQF_INTRO th) |Const("T",bool_ty) -> failwith "pat_cnv_of_thm" |l -> l, C REWR_ANNOTCONV (EQT_INTRO th) let impconv_net_of_thm th = try let p,c = pat_cnv_of_thm th in let vs = Tset.freesl (hyp th) in Fo_nets.enter vs (p,(c,vs,th)) with Failure _ -> I let patterns_of_thm = fst o pat_cnv_of_thm (* Apply a conversion net to the term at the top level, taking * avoided variables as parameter too. *) let REWRITES_IMPCONV (net:((term list -> annot_conv) * Tset.t * thm) Fo_nets.t) avs t = tryfind (fun c,_,_ -> c avs t) (Fo_nets.lookup t net) let extra_basic_rewrites = itlist (mk_rewrites false) [NOT_FORALL_THM;NOT_IMP] [] let IMPREWR_CTXCONV :thm list -> (atomic->annot_conv) with_context = let rec top_depth c avs t = let rec (++) c1 c2 avs t = match c1 avs t with |_,Some _,_ as c1t -> c1t |th1,None,vs1 as c1t -> (try let th2,ho2,vs2 = c2 (Tset.union vs1 avs) (rand (concl th1)) in TRANS th1 th2, ho2, Tset.union vs1 vs2 with Failure _ -> c1t) and (+) c1 c2 avs t = try (c1 ++ c2) avs t with Failure _ -> c2 avs t and COMB_QCONV c avs l r = try match c avs l with |th,(Some _ as ho),vs -> AP_THM th r,ho,vs |th1,None,vs1 -> (try let th2,ho2,vs2 = c (Tset.union vs1 avs) r in MK_COMB (th1,th2), ho2, Tset.union vs1 vs2 with Failure _ -> AP_THM th1 r,None,vs1) with Failure _ -> let th2,ho2,vs2 = c avs r in AP_TERM l th2,ho2,vs2 in let SUB_QCONV c avs t = match t with |Comb(l,r) -> COMB_QCONV c avs l r |Abs(v,_) -> let ho = ref None and vs = ref [] in let c' t = let th,ho',vs' = c (Tset.insert avs v) t in ho := ho'; vs := vs'; th in let res = ABS_CONV c' t in res,!ho,!vs |_ -> failwith "SUB_QCONV" in let rec (!) c avs t = (c ++ !c) avs t in (!c + (SUB_QCONV (top_depth c) ++ top_depth c)) avs t in let bigger_net() = itlist (net_of_thm false) extra_basic_rewrites (basic_net()) in let basic_cnv t = REWRITES_CONV (bigger_net ()) t,None,[] in let rec self net ths = let avs = Tset.flat_revmap (Tset.freesl o hyp) ths in let cnv avs t = try REWRITES_IMPCONV net avs t with Failure _ -> basic_cnv t in With_context( (fun a t -> let f = match a with Atomic -> top_depth | Non_atomic -> I in f cnv (Tset.union (Tset.frees t) avs) t), (fun ts -> let ths' = map ASSUME ts in (*let ths'' = ths' @ GMATCH_MPS ths ths' in*) let ths'' = MP_CLOSURE ths' ths' @ ths' @ MP_CLOSURE ths ths' in self (itlist impconv_net_of_thm ths'' net) (ths'' @ ths)), (fun v -> let ths = ref [] in let f (_,vs,th) = if not (Tset.mem v vs) then (ths := th :: !ths; true) else false in let net' = Fo_nets.filter f net in self net' !ths)) in fun ths -> self (itlist impconv_net_of_thm ths Fo_nets.empty_net) ths (*****************************************************************************) (* SOME USEFUL IMPLICATIONAL CONVERSIONS *) (*****************************************************************************) (* Takes a conversion with hypotheses (with context) and makes an * implicational conversion out of it. * Basically turns a rewrite with hypotheses into an implicational rewrite * withouth hypotheses. * Adds existential quantifications for variables introduced by the rewrite. *) let rec REWR_IMPCONV_OF_CONV = let IMP_SYM = REWR_RULE (TAUT `A==>B==>C <=> B==>A==>C`) in let IMP_EXIST = GSYM LEFT_IMP_EXISTS_THM in let TRY_GEN v th = try GEN v th with Failure _ -> th in fun (c:(atomic -> annot_conv) with_context) -> With_context( ((fun a v t -> let th,ho,new_vars = apply c a t in let th1,th2 = EQ_IMP_RULE th in let res = match v with |Co -> let p,th2' = UNDISCH_TERM th2 in let rec exists_intro = function |[] -> DISCH_IMP_IMP (p::list_of_option ho) th2' |v::vs -> let th = exists_intro vs in try REWR_RULE IMP_EXIST (GEN v th) with Failure _ -> th in exists_intro new_vars |Contra -> let th1' = match ho with None -> th1 | Some h -> IMP_SYM (DISCH h th1) in match new_vars with |[] -> th1' |_::_ -> MAP_CONCLUSION (itlist TRY_GEN new_vars) th1' in let t1,t2 = dest_imp (concl res) in if t1 = t2 then raise Unchanged else res):atomic->imp_conv), REWR_IMPCONV_OF_CONV o augment c, REWR_IMPCONV_OF_CONV o diminish c) (* Applies the implicational rewrite, with context simplifications. *) let REWRITE_CTXIMPCONV = DEPTH_CTXIMPCONV o REWR_IMPCONV_OF_CONV o IMPREWR_CTXCONV (*****************************************************************************) (* INTERFACE *) (*****************************************************************************) (* Preprocessor. For now takes a theorem of the form [p ==> c1 /\ ... /\ ck] * and returns the list of theorems [p ==> c1], ..., [p ==> ck]. *) let preprocess = CONJUNCTS o IMPLY_AND (* Tactic for implicational rewrite. *) let IMP_REWRITE_TAC ths = CTXIMPCONV_TAC (REWRITE_CTXIMPCONV (flat (map preprocess ths))) let SEQ_IMP_REWRITE_TAC ths = let cnv = match ths with |[] -> REWRITE_CTXIMPCONV [TRUTH] |[th] -> REWRITE_CTXIMPCONV (preprocess th) |_::_ -> let fcnv = REWRITE_CTXIMPCONV o preprocess in REPEAT_UNCHANGED_CTXIMPCONV (map fcnv ths) in CTXIMPCONV_TAC cnv (* Tactic for implicational rewrite with assumptions. *) let ASM_IMP_REWRITE_TAC = ASM IMP_REWRITE_TAC (* Cases-like conversion for implicational theorems, i.e., for a theorem of * the form: * [h1,..,hk |- !x1...xn. p ==> !y1...ym. l = r], and a term [t], * return [(p ==> t') /\ (~p ==> t)], where [t'] is the result of rewriting * [t] by [l=r]. *) let rec CASE_REWR_IMPCONV_OF_CONV = let MP_TAUT th = MATCH_MP (TAUT th) in let MP_LEM1 = MP_TAUT `(~P ==> Q = R) ==> (Q <=> (~P ==> R) /\ (P ==> Q))` in let MP_LEM2 = MP_TAUT `(P ==> Q = R) ==> (Q <=> (P ==> R) /\ (~P ==> Q))` in fun (c:(atomic -> annot_conv) with_context) -> With_context( (fun a v t -> match apply c a t with |_,None,_ -> failwith "CASE_REWR_IMPCONV_OF_CONV" |th,Some h,_ -> let th' = DISCH h th in let th'' = try MP_LEM1 th' with Failure _ -> MP_LEM2 th' in imp_conv_of_conv (REWR_CONV th'') v t), CASE_REWR_IMPCONV_OF_CONV o augment c, CASE_REWR_IMPCONV_OF_CONV o diminish c) let CASE_REWRITE_CTXIMPCONV = ONCE_DEPTH_CTXIMPCONV o CASE_REWR_IMPCONV_OF_CONV o IMPREWR_CTXCONV (* Tactic version of it. *) let CASE_REWRITE_TAC = CTXIMPCONV_TAC o CASE_REWRITE_CTXIMPCONV o preprocess (*****************************************************************************) (* IMPLICATIONAL CONVERSIONS WITH MULTIPLE RESULTS *) (*****************************************************************************) (* Multiple implicational conversion. *) type imp_mconv = Variance.t -> term -> thm list let mapply_with_context c ctx v t = map (DISCH_CONJ ctx) (apply (augment c (Tset.strip_conj ctx)) v t) (* Consider two multiple implicational conversions ic1, ic2. * Suppose [ic1 Co A] returns a list [B1 ==> A; ...; Bk ==> A], * and [ic2 Co C] returns [D1 ==> C; ...; Dn ==> C], * then [CONJ_IMPMCONV ic1 ic2 Co (A /\ C)] returns * [B1 /\ C ==> A /\ C; ...; Bk /\ C ==> A /\ C; A /\ D1 ==> A /\ C; ...; Dn * ==> A /\ C]. * * And similarly for the contravariant case. *) let rec CONJ_CTXIMPMCONV (c:imp_mconv with_context) : imp_mconv with_context = With_context( (fun v t -> let t1,t2 = dest_conj t in let left,right = match v with |Co -> MKIMPL_CONJ_CO2_CTXT,MKIMPR_CONJ_CO_CTXT |Contra -> MKIMPL_CONJ_CONTRA_CTXT,MKIMPR_CONJ_CONTRA_CTXT in let th1s = map left (mapply_with_context c t2 v t1) in let th2s = map right (mapply_with_context c t1 v t2) in th1s @ th2s), CONJ_CTXIMPMCONV o augment c, CONJ_CTXIMPMCONV o diminish c) (* Consider two multiple implicational conversions ic1, ic2. * Suppose [ic1 Co A] returns a list [B1 ==> A; ...; Bk ==> A], * and [ic2 Co C] returns [D1 ==> C; ...; Dn ==> C], * then [DISJ_IMPMCONV ic1 ic2 Co (A \/ C)] returns * [B1 \/ C ==> A \/ C; ...; Bk \/ C ==> A \/ C; A \/ D1 ==> A \/ C; ...; Dn * ==> A \/ C]. * * And similarly for the contravariant case. *) let rec DISJ_CTXIMPMCONV (c:imp_mconv with_context) : imp_mconv with_context = With_context( (fun v t -> let t1,t2 = dest_disj t in let th1s = map (C MKIMPL_DISJ t2) (apply c v t1) in let th2s = map (MKIMPR_DISJ t1) (apply c v t2) in th1s @ th2s), DISJ_CTXIMPMCONV o augment c, DISJ_CTXIMPMCONV o diminish c) (* Consider two multiple implicational conversions ic1, ic2. * Suppose [ic1 Contra A] returns a list [A ==> B1; ...; A ==> Bk], * and [ic2 Co C] returns [D1 ==> C; ...; Dn ==> C], * then [DISJ_IMPMCONV ic1 ic2 Co (A \/ C)] returns * [(B1 ==> C) ==> (A ==> C); ...; (Bk ==> C) ==> (A ==> C); (A ==> D1) ==> (A * ==> C); ...; (A ==> Dn) ==> (A ==> C)]. * * And similarly for the contravariant case. *) let rec IMP_CTXIMPMCONV (c:imp_mconv with_context) : imp_mconv with_context = With_context( (fun v t -> let t1,t2 = dest_imp t in let th1s = map (C MKIMPL_IMP t2) (apply c (Variance.neg v) t1) in let th2s = map MKIMPR_IMP_CTXT (mapply_with_context c t1 v t2) in th1s @ th2s), CONJ_CTXIMPMCONV o augment c, CONJ_CTXIMPMCONV o diminish c) let rec IFF_CTXIMPCONV (c:imp_mconv with_context) = With_context( ((fun v t -> let t1,t2 = dest_iff t in let left,right = match v with |Co -> MKIMPL_CO_IFF,MKIMPR_CO_IFF |Contra -> MKIMPL_CONTRA_IFF,MKIMPR_CONTRA_IFF in let th1s = map left (apply c v (mk_imp(t1,t2))) in let th2s = map right (apply c v (mk_imp(t2,t1))) in th1s @ th2s):imp_mconv), IFF_CTXIMPCONV o augment c, IFF_CTXIMPCONV o diminish c) (* Consider one multiple implicational conversion ic. * Suppose [ic Contra A] returns a list [A ==> B1; ...; A ==> Bk], * then [NOT_IMPMCONV ic Co ~A] returns [~B1 ==> ~A; ...; ~Bk ==> ~A]. * * And similarly for the contravariant case. *) let rec NOT_CTXIMPMCONV (c:imp_mconv with_context) : imp_mconv with_context = With_context( (fun v t -> map MKIMP_NOT (try_list (apply c (Variance.neg v)) (dest_neg t))), NOT_CTXIMPMCONV o augment c, NOT_CTXIMPMCONV o diminish c) let rec QUANT_CTXIMPMCONV mkimp sel (c:imp_mconv with_context) : imp_mconv with_context = With_context( (fun v t -> let x,b = sel t in let c' = diminish c x in map (mkimp x) (try_list (apply c' v) b)), QUANT_CTXIMPMCONV mkimp sel o augment c, QUANT_CTXIMPMCONV mkimp sel o diminish c) (* Consider one multiple implicational conversion ic. * Suppose [ic Co A] returns a list [B1 ==> A; ...; Bk ==> A], * then [FORALL_IMPMCONV ic Co (!x.A)] returns [(!x.B1) ==> (!x.A); ...; * (!x.Bk) ==> (!x.A)]. * * And similarly for the contravariant case. *) let FORALL_CTXIMPMCONV = QUANT_CTXIMPMCONV MKIMP_FORALL dest_forall (* Consider one multiple implicational conversion ic. * Suppose [ic Co A] returns a list [B1 ==> A; ...; Bk ==> A], * then [EXISTS_IMPMCONV ic Co (?x.A)] returns [(?x.B1) ==> (?x.A); ...; * (?x.Bk) ==> (?x.A)]. * * And similarly for the contravariant case. *) let EXISTS_CTXIMPMCONV = QUANT_CTXIMPMCONV MKIMP_EXISTS dest_exists (* Applies a multiple implicational conversion on the subformula(s) of the * input term *) let rec SUB_CTXIMPMCONV = let iff_ty = `:bool->bool->bool` in fun c -> With_context( ((fun v t -> let n,ty = dest_const (fst (strip_comb t)) in apply ((match n with |"==>" -> IMP_CTXIMPMCONV |"/\\" -> CONJ_CTXIMPMCONV |"\\/" -> DISJ_CTXIMPMCONV |"!" -> FORALL_CTXIMPMCONV |"?" -> EXISTS_CTXIMPMCONV |"~" -> NOT_CTXIMPMCONV |"=" when ty = iff_ty -> IFF_CTXIMPCONV |_ -> failwith "SUB_CTXIMPMCONV") c) v t):imp_mconv), SUB_CTXIMPMCONV o augment c, SUB_CTXIMPMCONV o diminish c) (* Applies a multiple implicational conversion once to the first suitable sub-term(s) * encountered in bottom-up order. *) let rec DEPTH_CTXIMPMCONV (c : (atomic->imp_mconv) with_context) = With_context( (fun v t -> try let ths = apply (SUB_CTXIMPMCONV (DEPTH_CTXIMPMCONV c)) v t in apply c Non_atomic v t @ ths with Failure "SUB_CTXIMPMCONV" -> (apply c Atomic v t)), DEPTH_CTXIMPMCONV o augment c, DEPTH_CTXIMPMCONV o diminish c) (*****************************************************************************) (* REWRITE IMPLICATIONAL CONVERSIONS *) (*****************************************************************************) (* Multiple implicational conversion with hypotheses. *) type annot_mconv = term -> (thm * term option * term list) list (* Takes a theorem, a net of conversions with hypotheses (which also take * variables to avoid), and adds to the net the conversion corresponding to * the theorem. * * Special cases: * - usual term rewriting is handled with [REWR_CONV] instead of introducing * a fake premise. Might be useful though to introduce a fake premise since * the conversion would benefit from a better handling of variables occurring * in the r.h.s. but not in the l.h.s. * - a theorem of the form [p ==> c] where [c] is not equational is turned into * [p ==> c = T] * - a theorem of the form [p ==> ~c] is turned into [p ==> c = F] *) let target_pat_cnv_of_thm th : (term * (term list->annot_conv)) = let th = SPEC_ALL th in match concl th with |Comb(Comb(Const("=",_),l),_) -> l,C REWR_ANNOTCONV th |Comb(Comb(Const("==>",_),_),c) -> let pat,th' = match c with |Comb(Comb(Const("=",_),l),_) -> l, th |Comb(Const("~",_),l) -> l, GEN_MAP_CONCLUSION EQF_INTRO th |l -> c, GEN_MAP_CONCLUSION EQT_INTRO th in pat, C IMPREWR_CONV th' |Comb(Const("~",_),l) -> l, C REWR_ANNOTCONV (EQF_INTRO th) |Const("T",bool_ty) -> failwith "target_pat_cnv_of_thm" |l -> l, C REWR_ANNOTCONV (EQT_INTRO th) let target_impconv_net_of_thm th = try let p,c = target_pat_cnv_of_thm th in let vs = Tset.freesl (hyp th) in Fo_nets.enter vs (p,(c,vs,th)) with Failure _ -> I let target_patterns_of_thm = fst o target_pat_cnv_of_thm (* Multiple conversion which returns all the possible rewrites (on one subterm * only) by one theorem. *) let DEEP_IMP_REWR_MCONV:thm list->(atomic->annot_mconv) with_context = let map_fst f (x,y,z) = f x,y,z in let COMB_MCONV c l r = map (map_fst (C AP_THM r)) (c l) @ map (map_fst (AP_TERM l)) (c r) and ABS_MCONV c v b = let ths = c b in try map (map_fst (ABS v)) ths with Failure _ -> let gv = genvar(type_of v) in let f (gth,ho,vs) = let gtm = concl gth in let l,r = dest_eq gtm in let v' = variant (frees gtm) v in let l' = alpha v' l and r' = alpha v' r in EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth,ho,vs in let b' = vsubst[gv,v] b in map f (map (map_fst (ABS gv)) (c b')) in let SUB_MCONV c = function |Comb(l,r) -> COMB_MCONV c l r |Abs(v,b) -> ABS_MCONV c v b |Const _ | Var _ -> [] in let rec top_depth c t = SUB_MCONV (top_depth c) t @ c t in let REWRITES_IMPCONV (net:((term list -> annot_conv) * Tset.t * thm) Fo_nets.t) avs t = mapfilter (fun c,_,_ -> c avs t) (Fo_nets.lookup t net) in let rec self net ths = let avs = Tset.flat_revmap (Tset.freesl o hyp) ths in With_context( (fun a t -> let avs' = Tset.union (Tset.frees t) avs in let cnv t = REWRITES_IMPCONV net avs' t in let f = match a with |Atomic -> top_depth |Non_atomic -> (fun cnv avs -> cnv avs) in f cnv t), (fun _ -> self net ths), (fun v -> let ths = ref [] in let f (_,vs,th) = if not (Tset.mem v vs) then (ths := th :: !ths; true) else false in let net' = Fo_nets.filter f net in self net' !ths)) in fun ths -> self (itlist target_impconv_net_of_thm ths Fo_nets.empty_net) ths (* Takes a multiple conversion with hypotheses (which also takes a context as * parameter) and makes a multiple implicational conversion out of it. * * Basically extends [GENERAL_REWRITE_IMPCONV] to the multiple conversion * case. *) let rec REWR_IMPMCONV_OF_MCONV = let IMP_SYM = REWR_RULE (TAUT `A==>B==>C <=> B==>A==>C`) in let IMP_EXIST = GSYM LEFT_IMP_EXISTS_THM in let TRY_GEN v th = try GEN v th with Failure _ -> th in fun (c:(atomic -> annot_mconv) with_context) -> With_context( ((fun a v t -> let f (th,ho,new_vars) = let th1,th2 = EQ_IMP_RULE th in match v with |Co -> let p,th2' = UNDISCH_TERM th2 in let rec exists_intro = function |[] -> DISCH_IMP_IMP (p::list_of_option ho) th2' |v::vs -> let th = exists_intro vs in try REWR_RULE IMP_EXIST (GEN v th) with Failure _ -> th in exists_intro new_vars |Contra -> let th1' = match ho with None -> th1 | Some h -> IMP_SYM (DISCH h th1) in match new_vars with |[] -> th1' |_::_ -> MAP_CONCLUSION (itlist TRY_GEN new_vars) th1' in map f (apply c a t)):atomic->imp_mconv), REWR_IMPMCONV_OF_MCONV o augment c, REWR_IMPMCONV_OF_MCONV o diminish c) (*****************************************************************************) (* TARGET REWRITING *) (*****************************************************************************) let EXISTS_CTXIMPCONV:imp_conv with_context = let EXISTSs i p = let codom,dom = unzip i in let f i ps = vsubst [i] (snd (dest_exists (hd ps))) :: ps in let h::ps = rev_itlist f i [list_mk_exists(dom,p)] in rev_itlist EXISTS (zip ps (rev codom)) (ASSUME h) in let LEFT_FORALL_IMP = REWR_RULE LEFT_FORALL_IMP_THM in let rec self ts = With_context ((fun v t -> match v,t with |Co,Comb(Const("?",_),_) -> let vs,b = strip_exists t in let bs = strip_conj b in let hmatch (n,b) = match partition (C mem vs) (variables b) with |[],_ -> failwith "EXISTS_CTXIMPCONV" |_::_ as lvs,lcs -> fun h -> match term_match lcs b h with |_,i,j when filter (uncurry (<>)) j = [] -> (if i = [] then zip lvs lvs else i),n |_ -> failwith "EXISTS_CTXIMPCONV" in let s,n = tryfind_fun (mapfilteri (curry (tryfind o hmatch)) bs) ts in let th = EXISTSs (map (fun v -> rev_assocd v s v,v) vs) b in let th' = DISCH_HD th in let h = fst (dest_imp (concl th')) in (match strip_conj h with |[] -> assert false |[h] -> DISCH T_ th |_::_ as hs -> let hs1,h'::hs2 = chop_list n hs in let hs_th = CONJ_ACI_RULE (mk_eq(h,list_mk_conj (h'::(hs1@hs2)))) in let th1 = CONV_RULE (LAND_CONV (REWR_CONV hs_th)) th' in let th2 = UNDISCH (CONV_RULE (REWR_CONV IMP_CONJ) th1) in let vs' = subtract vs (map snd s) in let f v th = try LEFT_FORALL_IMP (GEN v th) with Failure _ -> th in itlist f vs' th2) |_ -> failwith "EXISTS_CTXIMPCONV"), (fun ts' -> self (Tset.union ts' ts)), (fun _ -> self ts)) in self [] (* Takes a theorem which results of an implicational conversion and applies a * multiple implicational conversion on the outcome. *) let bind_impmconv (c:imp_mconv) v th = let t1,t2 = dest_imp (concl th) in match v with |Co -> map (C IMP_TRANS th) (c v t1) |Contra -> map (IMP_TRANS th) (c v t2) (* Target rewrite implicational conversion: * [TARGET_REWRITE_IMPCONV sths ts] is an implicational conversion which * applies all the possible implicational rewrites on the input term until * one of the resulting terms matches one of the terms in [ts]. * * Note that we allow several target terms and not just one. See * TARGET_REWRITE_TAC for a justification. *) let TARGET_REWRITE_IMPCONV : thm list -> term list -> imp_conv = let PRE = apply (TRY_CTXIMPCONV (REWRITE_CTXIMPCONV [])) in let POST = TRY_CTXIMPCONV (TOP_DEPTH_CTXIMPCONV EXISTS_CTXIMPCONV) in fun sths -> let one_step_sths v uh = let pre v th = try bind_impconv PRE v th with Unchanged -> th in let post v = bind_ctximpconv POST v in let f = DEPTH_CTXIMPMCONV o REWR_IMPMCONV_OF_MCONV o DEEP_IMP_REWR_MCONV in map (post v) (bind_impmconv (apply (f sths)) v (pre v uh)) in let flat l = uniq (itlist (merge thm_lt) l []) in fun ts v t -> let rec self ths = let pool = flat (map (mergesort thm_lt o one_step_sths v) ths) in let sel th = imp_conv_outcome th v in let is_one_sol g = (can o find_term o can o fo_term_match []) g o sel in let is_sol th = tryfind is_one_sol ts th in try bind_ctximpconv POST v (find is_sol pool) with _ -> match pool with |[] -> failwith "TARGET_REWRITE_IMPCONV: no path found" |_::_ -> self (map (bind_ctximpconv POST v) pool) in self [IMP_REFL t] (* Tactic version of it. * * Since the target theorem is preprocessed, it can yield several theorems. * Therefore, there is not just one possible target pattern but several. *) let TARGET_REWRITE_TAC sths th = let sths' = flat (map preprocess sths) in let ths = preprocess th and (+) = THEN_IMPCONV in IMPCONV_TAC (TARGET_REWRITE_IMPCONV sths' (map patterns_of_thm ths) + imp_conv_of_ctx_imp_conv (REWRITE_CTXIMPCONV ths)) let HINT_EXISTS_TAC = CTXIMPCONV_TAC (TOP_DEPTH_CTXIMPCONV EXISTS_CTXIMPCONV) end in Impconv.IMP_REWRITE_TAC, Impconv.TARGET_REWRITE_TAC, Impconv.HINT_EXISTS_TAC, Impconv.SEQ_IMP_REWRITE_TAC, Impconv.CASE_REWRITE_TAC;; hol-light/ind_defs.ml000066400000000000000000000475511303454263000150660ustar00rootroot00000000000000(* ========================================================================= *) (* Mutually inductively defined relations. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "theorems.ml";; (* ------------------------------------------------------------------------- *) (* Strip off exactly n arguments from combination. *) (* ------------------------------------------------------------------------- *) let strip_ncomb = let rec strip(n,tm,acc) = if n < 1 then tm,acc else let l,r = dest_comb tm in strip(n - 1,l,r::acc) in fun n tm -> strip(n,tm,[]);; (* ------------------------------------------------------------------------- *) (* Expand lambda-term function definition with its arguments. *) (* ------------------------------------------------------------------------- *) let RIGHT_BETAS = rev_itlist (fun a -> CONV_RULE (RAND_CONV BETA_CONV) o C AP_THM a);; (* ------------------------------------------------------------------------- *) (* A, x = t |- P[x] *) (* ------------------ EXISTS_EQUATION *) (* A |- ?x. P[x] *) (* ------------------------------------------------------------------------- *) let EXISTS_EQUATION = let pth = prove (`!P t. (!x:A. (x = t) ==> P x) ==> (?) P`, REWRITE_TAC[EXISTS_DEF] THEN BETA_TAC THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:A` THEN FIRST_ASSUM MATCH_MP_TAC THEN REFL_TAC) in fun tm th -> let l,r = dest_eq tm in let P = mk_abs(l,concl th) in let th1 = BETA_CONV(mk_comb(P,l)) in let th2 = ISPECL [P; r] pth in let th3 = EQ_MP (SYM th1) th in let th4 = GEN l (DISCH tm th3) in MP th2 th4;; (* ========================================================================= *) (* Part 1: The main part of the inductive definitions package. *) (* This proves that a certain definition yields the requires theorems. *) (* ========================================================================= *) let derive_nonschematic_inductive_relations = let getconcl tm = let bod = repeat (snd o dest_forall) tm in try snd(dest_imp bod) with Failure _ -> bod and CONJ_ACI_RULE = AC CONJ_ACI and SIMPLE_DISJ_PAIR th = let l,r = dest_disj(hd(hyp th)) in PROVE_HYP (DISJ1 (ASSUME l) r) th,PROVE_HYP (DISJ2 l (ASSUME r)) th and HALF_BETA_EXPAND args th = GENL args (RIGHT_BETAS args th) in let AND_IMPS_CONV tm = let ths = CONJUNCTS(ASSUME tm) in let avs = fst(strip_forall(concl(hd ths))) in let thl = map (DISCH tm o UNDISCH o SPEC_ALL) ths in let th1 = end_itlist SIMPLE_DISJ_CASES thl in let tm1 = hd(hyp th1) in let th2 = GENL avs (DISCH tm1 (UNDISCH th1)) in let tm2 = concl th2 in let th3 = DISCH tm2 (UNDISCH (SPEC_ALL (ASSUME tm2))) in let thts,tht = nsplit SIMPLE_DISJ_PAIR (tl ths) th3 in let proc_fn th = let t = hd(hyp th) in GENL avs (DISCH t (UNDISCH th)) in let th4 = itlist (CONJ o proc_fn) thts (proc_fn tht) in IMP_ANTISYM_RULE (DISCH_ALL th2) (DISCH_ALL th4) in let t_tm = `T` in let calculate_simp_sequence = let rec getequs(avs,plis) = if plis = [] then [] else let h::t = plis in let r = snd h in if mem r avs then h::(getequs(avs,filter ((<>) r o snd) t)) else getequs(avs,t) in fun avs plis -> let oks = getequs(avs,plis) in oks,subtract plis oks and FORALL_IMPS_CONV tm = let avs,bod = strip_forall tm in let th1 = DISCH tm (UNDISCH(SPEC_ALL(ASSUME tm))) in let th2 = itlist SIMPLE_CHOOSE avs th1 in let tm2 = hd(hyp th2) in let th3 = DISCH tm2 (UNDISCH th2) in let th4 = ASSUME (concl th3) in let ant = lhand bod in let th5 = itlist SIMPLE_EXISTS avs (ASSUME ant) in let th6 = GENL avs (DISCH ant (MP th4 th5)) in IMP_ANTISYM_RULE (DISCH_ALL th3) (DISCH_ALL th6) in let canonicalize_clause cls args = let avs,bimp = strip_forall cls in let ant,con = try dest_imp bimp with Failure _ -> t_tm,bimp in let rel,xargs = strip_comb con in let plis = zip args xargs in let yes,no = calculate_simp_sequence avs plis in let nvs = filter (not o C mem (map snd yes)) avs in let eth = if is_imp bimp then let atm = itlist (curry mk_conj o mk_eq) (yes@no) ant in let ths,tth = nsplit CONJ_PAIR plis (ASSUME atm) in let thl = map (fun t -> find (fun th -> lhs(concl th) = t) ths) args in let th0 = MP (SPECL avs (ASSUME cls)) tth in let th1 = rev_itlist (C (curry MK_COMB)) thl (REFL rel) in let th2 = EQ_MP (SYM th1) th0 in let th3 = INST yes (DISCH atm th2) in let tm4 = funpow (length yes) rand (lhand(concl th3)) in let th4 = itlist (CONJ o REFL o fst) yes (ASSUME tm4) in let th5 = GENL args (GENL nvs (DISCH tm4 (MP th3 th4))) in let th6 = SPECL nvs (SPECL (map snd plis) (ASSUME (concl th5))) in let th7 = itlist (CONJ o REFL o snd) no (ASSUME ant) in let th8 = GENL avs (DISCH ant (MP th6 th7)) in IMP_ANTISYM_RULE (DISCH_ALL th5) (DISCH_ALL th8) else let atm = list_mk_conj(map mk_eq (yes@no)) in let ths = CONJUNCTS (ASSUME atm) in let thl = map (fun t -> find (fun th -> lhs(concl th) = t) ths) args in let th0 = SPECL avs (ASSUME cls) in let th1 = rev_itlist (C (curry MK_COMB)) thl (REFL rel) in let th2 = EQ_MP (SYM th1) th0 in let th3 = INST yes (DISCH atm th2) in let tm4 = funpow (length yes) rand (lhand(concl th3)) in let th4 = itlist (CONJ o REFL o fst) yes (ASSUME tm4) in let th5 = GENL args (GENL nvs (DISCH tm4 (MP th3 th4))) in let th6 = SPECL nvs (SPECL (map snd plis) (ASSUME (concl th5))) in let th7 = end_itlist CONJ (map (REFL o snd) no) in let th8 = GENL avs (MP th6 th7) in IMP_ANTISYM_RULE (DISCH_ALL th5) (DISCH_ALL th8) in let ftm = funpow (length args) (body o rand) (rand(concl eth)) in TRANS eth (itlist MK_FORALL args (FORALL_IMPS_CONV ftm)) in let canonicalize_clauses clauses = let concls = map getconcl clauses in let uncs = map strip_comb concls in let rels = itlist (insert o fst) uncs [] in let xargs = map (C assoc uncs) rels in let closed = list_mk_conj clauses in let avoids = variables closed in let flargs = make_args "a" avoids (map type_of (end_itlist (@) xargs)) in let zargs = zip rels (shareout xargs flargs) in let cargs = map (fun (r,a) -> assoc r zargs) uncs in let cthms = map2 canonicalize_clause clauses cargs in let pclauses = map (rand o concl) cthms in let collectclauses tm = mapfilter (fun t -> if fst t = tm then snd t else fail()) (zip (map fst uncs) pclauses) in let clausell = map collectclauses rels in let cclausel = map list_mk_conj clausell in let cclauses = list_mk_conj cclausel and oclauses = list_mk_conj pclauses in let eth = CONJ_ACI_RULE(mk_eq(oclauses,cclauses)) in let pth = TRANS (end_itlist MK_CONJ cthms) eth in TRANS pth (end_itlist MK_CONJ (map AND_IMPS_CONV cclausel)) and derive_canon_inductive_relations clauses = let closed = list_mk_conj clauses in let clauses = conjuncts closed in let vargs,bodies = unzip(map strip_forall clauses) in let ants,concs = unzip(map dest_imp bodies) in let rels = map (repeat rator) concs in let avoids = variables closed in let rels' = variants avoids rels in let crels = zip rels' rels in let prime_fn = subst crels in let closed' = prime_fn closed in let mk_def arg con = mk_eq(repeat rator con, list_mk_abs(arg,list_mk_forall(rels',mk_imp(closed',prime_fn con)))) in let deftms = map2 mk_def vargs concs in let defthms = map2 HALF_BETA_EXPAND vargs (map ASSUME deftms) in let mk_ind args th = let th1 = fst(EQ_IMP_RULE(SPEC_ALL th)) in let ant = lhand(concl th1) in let th2 = SPECL rels' (UNDISCH th1) in GENL args (DISCH ant (UNDISCH th2)) in let indthms = map2 mk_ind vargs defthms in let indthmr = end_itlist CONJ indthms in let indthm = GENL rels' (DISCH closed' indthmr) in let mconcs = map2 (fun a t -> list_mk_forall(a,mk_imp(t,prime_fn t))) vargs ants in let monotm = mk_imp(concl indthmr,list_mk_conj mconcs) in let monothm = ASSUME(list_mk_forall(rels,list_mk_forall(rels',monotm))) in let closthm = ASSUME closed' in let monothms = CONJUNCTS (MP (SPEC_ALL monothm) (MP (SPECL rels' indthm) closthm)) in let closthms = CONJUNCTS closthm in let prove_rule mth (cth,dth) = let avs,bod = strip_forall(concl mth) in let th1 = IMP_TRANS (SPECL avs mth) (SPECL avs cth) in let th2 = GENL rels' (DISCH closed' (UNDISCH th1)) in let th3 = EQ_MP (SYM (SPECL avs dth)) th2 in GENL avs (DISCH (lhand bod) th3) in let rulethms = map2 prove_rule monothms (zip closthms defthms) in let rulethm = end_itlist CONJ rulethms in let dtms = map2 (curry list_mk_abs) vargs ants in let double_fn = subst (zip dtms rels) in let mk_unbetas tm dtm = let avs,bod = strip_forall tm in let il,r = dest_comb bod in let i,l = dest_comb il in let bth = RIGHT_BETAS avs (REFL dtm) in let munb = AP_THM (AP_TERM i bth) r in let iunb = AP_TERM (mk_comb(i,double_fn l)) bth in let junb = AP_TERM (mk_comb(i,r)) bth in let quantify = itlist MK_FORALL avs in (quantify munb,(quantify iunb,quantify junb)) in let unths = map2 mk_unbetas clauses dtms in let irthm = EQ_MP (SYM(end_itlist MK_CONJ (map fst unths))) rulethm in let mrthm = MP (SPECL rels (SPECL dtms monothm)) irthm in let imrth = EQ_MP (SYM(end_itlist MK_CONJ (map (fst o snd) unths))) mrthm in let ifthm = MP (SPECL dtms indthm) imrth in let fthm = EQ_MP (end_itlist MK_CONJ (map (snd o snd) unths)) ifthm in let mk_case th1 th2 = let avs = fst(strip_forall(concl th1)) in GENL avs (IMP_ANTISYM_RULE (SPEC_ALL th1) (SPEC_ALL th2)) in let casethm = end_itlist CONJ (map2 mk_case (CONJUNCTS fthm) (CONJUNCTS rulethm)) in CONJ rulethm (CONJ indthm casethm) in fun tm -> let clauses = conjuncts tm in let canonthm = canonicalize_clauses clauses in let canonthm' = SYM canonthm in let pclosed = rand(concl canonthm) in let pclauses = conjuncts pclosed in let rawthm = derive_canon_inductive_relations pclauses in let rulethm,otherthms = CONJ_PAIR rawthm in let indthm,casethm = CONJ_PAIR otherthms in let rulethm' = EQ_MP canonthm' rulethm and indthm' = CONV_RULE (ONCE_DEPTH_CONV (REWR_CONV canonthm')) indthm in CONJ rulethm' (CONJ indthm' casethm);; (* ========================================================================= *) (* Part 2: Tactic-integrated tools for proving monotonicity automatically. *) (* ========================================================================= *) let monotonicity_theorems = ref [MONO_AND; MONO_OR; MONO_IMP; MONO_NOT; MONO_EXISTS; MONO_FORALL];; (* ------------------------------------------------------------------------- *) (* Attempt to backchain through the monotonicity theorems. *) (* ------------------------------------------------------------------------- *) let MONO_TAC = let imp = `(==>)` and IMP_REFL = ITAUT `!p. p ==> p` in let BACKCHAIN_TAC th = let match_fn = PART_MATCH (snd o dest_imp) th in fun (asl,w) -> let th1 = match_fn w in let ant,con = dest_imp(concl th1) in null_meta,[asl,ant],fun i [t] -> MATCH_MP (INSTANTIATE i th1) t and MONO_ABS_TAC (asl,w) = let ant,con = dest_imp w in let vars = snd(strip_comb con) in let rnum = length vars - 1 in let hd1,args1 = strip_ncomb rnum ant and hd2,args2 = strip_ncomb rnum con in let th1 = rev_itlist (C AP_THM) args1 (BETA_CONV hd1) and th2 = rev_itlist (C AP_THM) args1 (BETA_CONV hd2) in let th3 = MK_COMB(AP_TERM imp th1,th2) in CONV_TAC(REWR_CONV th3) (asl,w) and APPLY_MONOTAC tacs (asl,w) = let a,c = dest_imp w in if aconv a c then ACCEPT_TAC (SPEC a IMP_REFL) (asl,w) else let cn = try fst(dest_const(repeat rator c)) with Failure _ -> "" in tryfind (fun (k,t) -> if k = cn then t (asl,w) else fail()) tacs in fun gl -> let tacs = itlist (fun th l -> let ft = repeat rator (funpow 2 rand (concl th)) in let c = try fst(dest_const ft) with Failure _ -> "" in (c,BACKCHAIN_TAC th THEN REPEAT CONJ_TAC)::l) (!monotonicity_theorems) ["",MONO_ABS_TAC] in let MONO_STEP_TAC = REPEAT GEN_TAC THEN APPLY_MONOTAC tacs in (REPEAT MONO_STEP_TAC THEN ASM_REWRITE_TAC[]) gl;; (* ------------------------------------------------------------------------- *) (* Attempt to dispose of the non-equational assumption(s) of a theorem. *) (* ------------------------------------------------------------------------- *) let prove_monotonicity_hyps = let tac = REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN REPEAT CONJ_TAC THEN MONO_TAC in let prove_mth t = prove(t,tac) in fun th -> let mths = mapfilter prove_mth (filter (not o is_eq) (hyp th)) in itlist PROVE_HYP mths th;; (* ========================================================================= *) (* Part 3: The final user wrapper, with schematic variables added. *) (* ========================================================================= *) let the_inductive_definitions = ref [];; let prove_inductive_relations_exist,new_inductive_definition = let rec pare_comb qvs tm = if intersect (frees tm) qvs = [] && forall is_var (snd(strip_comb tm)) then tm else pare_comb qvs (rator tm) in let generalize_schematic_variables gflag vs = let generalize_def tm th = let l,r = dest_eq tm in let lname,lty = dest_var l in let l' = mk_var(lname,itlist (mk_fun_ty o type_of) vs lty) in let r' = list_mk_abs(vs,r) in let tm' = mk_eq(l',r') in let th0 = RIGHT_BETAS vs (ASSUME tm') in let th1 = INST [lhs(concl th0),l] (DISCH tm th) in MP th1 th0 in fun th -> let defs,others = partition is_eq (hyp th) in let th1 = itlist generalize_def defs th in if gflag then let others' = map (fun t -> let fvs = frees t in SPECL fvs (ASSUME (list_mk_forall(fvs,t)))) others in GENL vs (itlist PROVE_HYP others' th1) else th1 and derive_existence th = let defs = filter is_eq (hyp th) in itlist EXISTS_EQUATION defs th and make_definitions th = let defs = filter is_eq (hyp th) in let dths = map new_definition defs in let insts = zip (map (lhs o concl) dths) (map lhs defs) in rev_itlist (C MP) dths (INST insts (itlist DISCH defs th)) and unschematize_clauses clauses = let schem = map (fun cls -> let avs,bod = strip_forall cls in pare_comb avs (try snd(dest_imp bod) with Failure _ -> bod)) clauses in let schems = setify schem in if is_var(hd schem) then (clauses,[]) else if not (length(setify (map (snd o strip_comb) schems)) = 1) then failwith "Schematic variables not used consistently" else let avoids = variables (list_mk_conj clauses) in let hack_fn tm = mk_var(fst(dest_var(repeat rator tm)),type_of tm) in let grels = variants avoids (map hack_fn schems) in let crels = zip grels schems in let clauses' = map (subst crels) clauses in clauses',snd(strip_comb(hd schems)) in let find_redefinition tm (rth,ith,cth as trip) = if aconv tm (concl rth) then trip else failwith "find_redefinition" in let prove_inductive_properties tm = let clauses = conjuncts tm in let clauses',fvs = unschematize_clauses clauses in let th = derive_nonschematic_inductive_relations (list_mk_conj clauses') in fvs,prove_monotonicity_hyps th in let prove_inductive_relations_exist tm = let fvs,th1 = prove_inductive_properties tm in let th2 = generalize_schematic_variables true fvs th1 in derive_existence th2 and new_inductive_definition tm = try let th = tryfind (find_redefinition tm) (!the_inductive_definitions) in warn true "Benign redefinition of inductive predicate"; th with Failure _ -> let fvs,th1 = prove_inductive_properties tm in let th2 = generalize_schematic_variables true fvs th1 in let th3 = make_definitions th2 in let avs = fst(strip_forall(concl th3)) in let r,ic = CONJ_PAIR(SPECL avs th3) in let i,c = CONJ_PAIR ic in let thtr = GENL avs r,GENL avs i,GENL avs c in the_inductive_definitions := thtr::(!the_inductive_definitions); thtr in prove_inductive_relations_exist,new_inductive_definition;; (* ------------------------------------------------------------------------- *) (* Derivation of "strong induction". *) (* ------------------------------------------------------------------------- *) let derive_strong_induction = let dest_ibod tm = let avs,ibod = strip_forall tm in let n = length avs in let prator = funpow n rator in let ant,con = dest_imp ibod in n,(prator ant,prator con) in let rec prove_triv tm = if is_conj tm then CONJ (prove_triv(lhand tm)) (prove_triv(rand tm)) else let avs,bod = strip_forall tm in let a,c = dest_imp bod in let ths = CONJUNCTS(ASSUME a) in let th = find (aconv c o concl) ths in GENL avs (DISCH a th) in let rec weaken_triv th = if is_conj(concl th) then CONJ (weaken_triv(CONJUNCT1 th)) (weaken_triv(CONJUNCT2 th)) else let avs,bod = strip_forall(concl th) in let th1 = SPECL avs th in let a = fst(dest_imp(concl th1)) in GENL avs (DISCH a (CONJUNCT2 (UNDISCH th1))) in let MATCH_IMPS = MATCH_MP MONO_AND in fun (rth,ith) -> let ovs,ibod = strip_forall(concl ith) in let iant,icon = dest_imp ibod in let ns,prrs = unzip (map dest_ibod (conjuncts icon)) in let rs,ps = unzip prrs in let gs = variants (variables ibod) ps in let svs,tvs = chop_list (length ovs - length ns) ovs in let sth = SPECL svs rth and jth = SPECL svs ith in let gimps = subst (zip gs rs) icon in let prs = map2 (fun n (r,p) -> let tys,ty = nsplit dest_fun_ty (1--n) (type_of r) in let gvs = map genvar tys in list_mk_abs(gvs,mk_conj(list_mk_comb(r,gvs),list_mk_comb(p,gvs)))) ns prrs in let modify_rule rcl itm = let avs,bod = strip_forall itm in if is_imp bod then let a,c = dest_imp bod in let mgoal = mk_imp(gimps,mk_imp(vsubst(zip gs ps) a,a)) in let mth = ASSUME(list_mk_forall(gs@ps@avs,mgoal)) in let ith_r = BETA_RULE(SPECL (prs @ rs @ avs) mth) in let jth_r = MP ith_r (prove_triv(lhand(concl ith_r))) in let t = lhand(concl jth_r) in let kth_r = UNDISCH jth_r in let ntm = list_mk_forall(avs,mk_imp(t,c)) in let lth_r = MP(SPECL avs rcl) kth_r and lth_p = UNDISCH(SPECL avs (ASSUME ntm)) in DISCH ntm (GENL avs (DISCH t (CONJ lth_r lth_p))) else DISCH itm (GENL avs (CONJ (SPECL avs rcl) (SPECL avs (ASSUME itm)))) in let mimps = map2 modify_rule (CONJUNCTS sth) (conjuncts iant) in let th1 = end_itlist (fun th th' -> MATCH_IMPS(CONJ th th')) mimps in let th2 = BETA_RULE(SPECL prs jth) in let th3 = IMP_TRANS th1 th2 in let nasm = lhand(concl th3) in let th4 = GENL ps (DISCH nasm (weaken_triv(UNDISCH th3))) in GENL svs (prove_monotonicity_hyps th4);; hol-light/ind_types.ml000066400000000000000000002150701303454263000153020ustar00rootroot00000000000000(* ========================================================================= *) (* Inductive (or free recursive) types. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "grobner.ml";; (* ------------------------------------------------------------------------- *) (* Abstract left inverses for binary injections (we could construct them...) *) (* ------------------------------------------------------------------------- *) let INJ_INVERSE2 = prove (`!P:A->B->C. (!x1 y1 x2 y2. (P x1 y1 = P x2 y2) <=> (x1 = x2) /\ (y1 = y2)) ==> ?X Y. !x y. (X(P x y) = x) /\ (Y(P x y) = y)`, GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `\z:C. @x:A. ?y:B. P x y = z` THEN EXISTS_TAC `\z:C. @y:B. ?x:A. P x y = z` THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[BETA_THM] THEN CONJ_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN GEN_TAC THEN BETA_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN W(EXISTS_TAC o rand o snd o dest_exists o snd) THEN REFL_TAC);; (* ------------------------------------------------------------------------- *) (* Define an injective pairing function on ":num". *) (* ------------------------------------------------------------------------- *) let NUMPAIR = new_definition `NUMPAIR x y = (2 EXP x) * (2 * y + 1)`;; let NUMPAIR_INJ_LEMMA = prove (`!x1 y1 x2 y2. (NUMPAIR x1 y1 = NUMPAIR x2 y2) ==> (x1 = x2)`, REWRITE_TAC[NUMPAIR] THEN REPEAT(INDUCT_TAC THEN GEN_TAC) THEN ASM_REWRITE_TAC[EXP; GSYM MULT_ASSOC; ARITH; EQ_MULT_LCANCEL; NOT_SUC; GSYM NOT_SUC; SUC_INJ] THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH]);; let NUMPAIR_INJ = prove (`!x1 y1 x2 y2. (NUMPAIR x1 y1 = NUMPAIR x2 y2) <=> (x1 = x2) /\ (y1 = y2)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(SUBST_ALL_TAC o MATCH_MP NUMPAIR_INJ_LEMMA) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[NUMPAIR] THEN REWRITE_TAC[EQ_MULT_LCANCEL; EQ_ADD_RCANCEL; EXP_EQ_0; ARITH]);; let NUMPAIR_DEST = new_specification ["NUMFST"; "NUMSND"] (MATCH_MP INJ_INVERSE2 NUMPAIR_INJ);; (* ------------------------------------------------------------------------- *) (* Also, an injective map bool->num->num (even easier!) *) (* ------------------------------------------------------------------------- *) let NUMSUM = new_definition `NUMSUM b x = if b then SUC(2 * x) else 2 * x`;; let NUMSUM_INJ = prove (`!b1 x1 b2 x2. (NUMSUM b1 x1 = NUMSUM b2 x2) <=> (b1 = b2) /\ (x1 = x2)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o REWRITE_RULE[NUMSUM]) THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(AP_TERM `EVEN` th)) THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[EVEN; EVEN_DOUBLE] THEN REWRITE_TAC[SUC_INJ; EQ_MULT_LCANCEL; ARITH]);; let NUMSUM_DEST = new_specification ["NUMLEFT"; "NUMRIGHT"] (MATCH_MP INJ_INVERSE2 NUMSUM_INJ);; (* ------------------------------------------------------------------------- *) (* Injection num->Z, where Z == num->A->bool. *) (* ------------------------------------------------------------------------- *) let INJN = new_definition `INJN (m:num) = \(n:num) (a:A). n = m`;; let INJN_INJ = prove (`!n1 n2. (INJN n1 :num->A->bool = INJN n2) <=> (n1 = n2)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o C AP_THM `n1:num` o REWRITE_RULE[INJN]) THEN DISCH_THEN(MP_TAC o C AP_THM `a:A`) THEN REWRITE_TAC[BETA_THM]);; (* ------------------------------------------------------------------------- *) (* Injection A->Z, where Z == num->A->bool. *) (* ------------------------------------------------------------------------- *) let INJA = new_definition `INJA (a:A) = \(n:num) b. b = a`;; let INJA_INJ = prove (`!a1 a2. (INJA a1 = INJA a2) <=> (a1:A = a2)`, REPEAT GEN_TAC THEN REWRITE_TAC[INJA; FUN_EQ_THM] THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `a1:A`) THEN REWRITE_TAC[]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Injection (num->Z)->Z, where Z == num->A->bool. *) (* ------------------------------------------------------------------------- *) let INJF = new_definition `INJF (f:num->(num->A->bool)) = \n. f (NUMFST n) (NUMSND n)`;; let INJF_INJ = prove (`!f1 f2. (INJF f1 :num->A->bool = INJF f2) <=> (f1 = f2)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FUN_EQ_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `m:num`; `a:A`] THEN POP_ASSUM(MP_TAC o REWRITE_RULE[INJF]) THEN DISCH_THEN(MP_TAC o C AP_THM `a:A` o C AP_THM `NUMPAIR n m`) THEN REWRITE_TAC[NUMPAIR_DEST]);; (* ------------------------------------------------------------------------- *) (* Injection Z->Z->Z, where Z == num->A->bool. *) (* ------------------------------------------------------------------------- *) let INJP = new_definition `INJP f1 f2:num->A->bool = \n a. if NUMLEFT n then f1 (NUMRIGHT n) a else f2 (NUMRIGHT n) a`;; let INJP_INJ = prove (`!(f1:num->A->bool) f1' f2 f2'. (INJP f1 f2 = INJP f1' f2') <=> (f1 = f1') /\ (f2 = f2')`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `n:num` THEN POP_ASSUM(MP_TAC o REWRITE_RULE[INJP]) THEN DISCH_THEN(MP_TAC o GEN `b:bool` o C AP_THM `NUMSUM b n`) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `T` th) THEN MP_TAC(SPEC `F` th)) THEN ASM_SIMP_TAC[NUMSUM_DEST; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Now, set up "constructor" and "bottom" element. *) (* ------------------------------------------------------------------------- *) let ZCONSTR = new_definition `ZCONSTR c i r :num->A->bool = INJP (INJN (SUC c)) (INJP (INJA i) (INJF r))`;; let ZBOT = new_definition `ZBOT = INJP (INJN 0) (@z:num->A->bool. T)`;; let ZCONSTR_ZBOT = prove (`!c i r. ~(ZCONSTR c i r :num->A->bool = ZBOT)`, REWRITE_TAC[ZCONSTR; ZBOT; INJP_INJ; INJN_INJ; NOT_SUC]);; (* ------------------------------------------------------------------------- *) (* Carve out an inductively defined set. *) (* ------------------------------------------------------------------------- *) let ZRECSPACE_RULES,ZRECSPACE_INDUCT,ZRECSPACE_CASES = new_inductive_definition `ZRECSPACE (ZBOT:num->A->bool) /\ (!c i r. (!n. ZRECSPACE (r n)) ==> ZRECSPACE (ZCONSTR c i r))`;; let recspace_tydef = new_basic_type_definition "recspace" ("_mk_rec","_dest_rec") (CONJUNCT1 ZRECSPACE_RULES);; (* ------------------------------------------------------------------------- *) (* Define lifted constructors. *) (* ------------------------------------------------------------------------- *) let BOTTOM = new_definition `BOTTOM = _mk_rec (ZBOT:num->A->bool)`;; let CONSTR = new_definition `CONSTR c i r :(A)recspace = _mk_rec (ZCONSTR c i (\n. _dest_rec(r n)))`;; (* ------------------------------------------------------------------------- *) (* Some lemmas. *) (* ------------------------------------------------------------------------- *) let MK_REC_INJ = prove (`!x y. (_mk_rec x :(A)recspace = _mk_rec y) ==> (ZRECSPACE x /\ ZRECSPACE y ==> (x = y))`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[snd recspace_tydef] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN ASM_REWRITE_TAC[]);; let DEST_REC_INJ = prove (`!x y. (_dest_rec x = _dest_rec y) <=> (x:(A)recspace = y)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o AP_TERM `_mk_rec:(num->A->bool)->(A)recspace`) THEN REWRITE_TAC[fst recspace_tydef]);; (* ------------------------------------------------------------------------- *) (* Show that the set is freely inductively generated. *) (* ------------------------------------------------------------------------- *) let CONSTR_BOT = prove (`!c i r. ~(CONSTR c i r :(A)recspace = BOTTOM)`, REPEAT GEN_TAC THEN REWRITE_TAC[CONSTR; BOTTOM] THEN DISCH_THEN(MP_TAC o MATCH_MP MK_REC_INJ) THEN REWRITE_TAC[ZCONSTR_ZBOT; ZRECSPACE_RULES] THEN MATCH_MP_TAC(CONJUNCT2 ZRECSPACE_RULES) THEN REWRITE_TAC[fst recspace_tydef; snd recspace_tydef]);; let CONSTR_INJ = prove (`!c1 i1 r1 c2 i2 r2. (CONSTR c1 i1 r1 :(A)recspace = CONSTR c2 i2 r2) <=> (c1 = c2) /\ (i1 = i2) /\ (r1 = r2)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o REWRITE_RULE[CONSTR]) THEN DISCH_THEN(MP_TAC o MATCH_MP MK_REC_INJ) THEN W(C SUBGOAL_THEN ASSUME_TAC o funpow 2 lhand o snd) THENL [CONJ_TAC THEN MATCH_MP_TAC(CONJUNCT2 ZRECSPACE_RULES) THEN REWRITE_TAC[fst recspace_tydef; snd recspace_tydef]; ASM_REWRITE_TAC[] THEN REWRITE_TAC[ZCONSTR] THEN REWRITE_TAC[INJP_INJ; INJN_INJ; INJF_INJ; INJA_INJ] THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN BETA_TAC THEN REWRITE_TAC[SUC_INJ; DEST_REC_INJ]]);; let CONSTR_IND = prove (`!P. P(BOTTOM) /\ (!c i r. (!n. P(r n)) ==> P(CONSTR c i r)) ==> !x:(A)recspace. P(x)`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\z:num->A->bool. ZRECSPACE(z) /\ P(_mk_rec z)` ZRECSPACE_INDUCT) THEN BETA_TAC THEN ASM_REWRITE_TAC[ZRECSPACE_RULES; GSYM BOTTOM] THEN W(C SUBGOAL_THEN ASSUME_TAC o funpow 2 lhand o snd) THENL [REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC(CONJUNCT2 ZRECSPACE_RULES) THEN ASM_REWRITE_TAC[]; FIRST_ASSUM(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[CONSTR] THEN RULE_ASSUM_TAC(REWRITE_RULE[snd recspace_tydef]) THEN ASM_SIMP_TAC[ETA_AX]]; ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `_dest_rec (x:(A)recspace)`) THEN REWRITE_TAC[fst recspace_tydef] THEN REWRITE_TAC[ITAUT `(a ==> a /\ b) <=> (a ==> b)`] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[fst recspace_tydef; snd recspace_tydef]]);; (* ------------------------------------------------------------------------- *) (* Now prove the recursion theorem (this subcase is all we need). *) (* ------------------------------------------------------------------------- *) let CONSTR_REC = prove (`!Fn:num->A->(num->(A)recspace)->(num->B)->B. ?f. (!c i r. f (CONSTR c i r) = Fn c i r (\n. f (r n)))`, REPEAT STRIP_TAC THEN (MP_TAC o prove_inductive_relations_exist) `(Z:(A)recspace->B->bool) BOTTOM b /\ (!c i r y. (!n. Z (r n) (y n)) ==> Z (CONSTR c i r) (Fn c i r y))` THEN DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `!x. ?!y. (Z:(A)recspace->B->bool) x y` MP_TAC THENL [W(MP_TAC o PART_MATCH rand CONSTR_IND o snd) THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THEN REPEAT GEN_TAC THENL [FIRST_ASSUM(fun t -> GEN_REWRITE_TAC BINDER_CONV [GSYM t]) THEN REWRITE_TAC[GSYM CONSTR_BOT; EXISTS_UNIQUE_REFL]; DISCH_THEN(MP_TAC o REWRITE_RULE[EXISTS_UNIQUE_THM; FORALL_AND_THM]) THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(MP_TAC o REWRITE_RULE[SKOLEM_THM]) THEN DISCH_THEN(X_CHOOSE_THEN `y:num->B` ASSUME_TAC) THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN FIRST_ASSUM(fun th -> CHANGED_TAC(ONCE_REWRITE_TAC[GSYM th])) THEN CONJ_TAC THENL [EXISTS_TAC `(Fn:num->A->(num->(A)recspace)->(num->B)->B) c i r y` THEN REWRITE_TAC[CONSTR_BOT; CONSTR_INJ; GSYM CONJ_ASSOC] THEN REWRITE_TAC[UNWIND_THM1; RIGHT_EXISTS_AND_THM] THEN EXISTS_TAC `y:num->B` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[CONSTR_BOT; CONSTR_INJ; GSYM CONJ_ASSOC] THEN REWRITE_TAC[UNWIND_THM1; RIGHT_EXISTS_AND_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT AP_TERM_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:num` THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `w:num` THEN ASM_REWRITE_TAC[]]]; REWRITE_TAC[UNIQUE_SKOLEM_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `fn:(A)recspace->B` (ASSUME_TAC o GSYM)) THEN EXISTS_TAC `fn:(A)recspace->B` THEN ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN REWRITE_TAC[BETA_THM]]);; (* ------------------------------------------------------------------------- *) (* The following is useful for coding up functions casewise. *) (* ------------------------------------------------------------------------- *) let FCONS = new_recursive_definition num_RECURSION `(!a f. FCONS (a:A) f 0 = a) /\ (!a f n. FCONS (a:A) f (SUC n) = f n)`;; let FCONS_UNDO = prove (`!f:num->A. f = FCONS (f 0) (f o SUC)`, GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN INDUCT_TAC THEN REWRITE_TAC[FCONS; o_THM]);; let FNIL = new_definition `FNIL (n:num) = @x:A. T`;; (* ------------------------------------------------------------------------- *) (* The initial mutual type definition function, with a type-restricted *) (* recursion theorem. *) (* ------------------------------------------------------------------------- *) let define_type_raw = (* ----------------------------------------------------------------------- *) (* Handy utility to produce "SUC o SUC o SUC ..." form of numeral. *) (* ----------------------------------------------------------------------- *) let sucivate = let zero = `0` and suc = `SUC` in fun n -> funpow n (curry mk_comb suc) zero in (* ----------------------------------------------------------------------- *) (* Eliminate local "definitions" in hyps. *) (* ----------------------------------------------------------------------- *) let SCRUB_EQUATION eq (th,insts) = (*HA*) let eq' = itlist subst (map (fun t -> [t]) insts) eq in let l,r = dest_eq eq' in (MP (INST [r,l] (DISCH eq' th)) (REFL r),(r,l)::insts) in (* ----------------------------------------------------------------------- *) (* Proves existence of model (inductively); use pseudo-constructors. *) (* *) (* Returns suitable definitions of constructors in terms of CONSTR, and *) (* the rule and induction theorems from the inductive relation package. *) (* ----------------------------------------------------------------------- *) let justify_inductive_type_model = let t_tm = `T` and n_tm = `n:num` and beps_tm = `@x:bool. T` in let rec munion s1 s2 = if s1 = [] then s2 else let h1 = hd s1 and s1' = tl s1 in try let _,s2' = remove (fun h2 -> h2 = h1) s2 in h1::(munion s1' s2') with Failure _ -> h1::(munion s1' s2) in fun def -> let newtys,rights = unzip def in let tyargls = itlist ((@) o map snd) rights [] in let alltys = itlist (munion o C subtract newtys) tyargls [] in let epstms = map (fun ty -> mk_select(mk_var("v",ty),t_tm)) alltys in let pty = try end_itlist (fun ty1 ty2 -> mk_type("prod",[ty1;ty2])) alltys with Failure _ -> bool_ty in let recty = mk_type("recspace",[pty]) in let constr = mk_const("CONSTR",[pty,aty]) in let fcons = mk_const("FCONS",[recty,aty]) in let bot = mk_const("BOTTOM",[pty,aty]) in let bottail = mk_abs(n_tm,bot) in let mk_constructor n (cname,cargs) = let ttys = map (fun ty -> if mem ty newtys then recty else ty) cargs in let args = make_args "a" [] ttys in let rargs,iargs = partition (fun t -> type_of t = recty) args in let rec mk_injector epstms alltys iargs = if alltys = [] then [] else let ty = hd alltys in try let a,iargs' = remove (fun t -> type_of t = ty) iargs in a::(mk_injector (tl epstms) (tl alltys) iargs') with Failure _ -> (hd epstms)::(mk_injector (tl epstms) (tl alltys) iargs) in let iarg = try end_itlist (curry mk_pair) (mk_injector epstms alltys iargs) with Failure _ -> beps_tm in let rarg = itlist (mk_binop fcons) rargs bottail in let conty = itlist mk_fun_ty (map type_of args) recty in let condef = list_mk_comb(constr,[sucivate n; iarg; rarg]) in mk_eq(mk_var(cname,conty),list_mk_abs(args,condef)) in let rec mk_constructors n rights = if rights = [] then [] else (mk_constructor n (hd rights))::(mk_constructors (n + 1) (tl rights)) in let condefs = mk_constructors 0 (itlist (@) rights []) in let conths = map ASSUME condefs in let predty = mk_fun_ty recty bool_ty in let edefs = itlist (fun (x,l) acc -> map (fun t -> x,t) l @ acc) def [] in let idefs = map2 (fun (r,(_,atys)) def -> (r,atys),def) edefs condefs in let mk_rule ((r,a),condef) = let left,right = dest_eq condef in let args,bod = strip_abs right in let lapp = list_mk_comb(left,args) in let conds = itlist2 (fun arg argty sofar -> if mem argty newtys then mk_comb(mk_var(dest_vartype argty,predty),arg)::sofar else sofar) args a [] in let conc = mk_comb(mk_var(dest_vartype r,predty),lapp) in let rule = if conds = [] then conc else mk_imp(list_mk_conj conds,conc) in list_mk_forall(args,rule) in let rules = list_mk_conj (map mk_rule idefs) in let th0 = derive_nonschematic_inductive_relations rules in let th1 = prove_monotonicity_hyps th0 in let th2a,th2bc = CONJ_PAIR th1 in let th2b = CONJUNCT1 th2bc in conths,th2a,th2b in (* ----------------------------------------------------------------------- *) (* Shows that the predicates defined by the rules are all nonempty. *) (* (This could be done much more efficiently/cleverly, but it's OK.) *) (* ----------------------------------------------------------------------- *) let prove_model_inhabitation rth = let srules = map SPEC_ALL (CONJUNCTS rth) in let imps,bases = partition (is_imp o concl) srules in let concs = map concl bases @ map (rand o concl) imps in let preds = setify (map (repeat rator) concs) in let rec exhaust_inhabitations ths sofar = let dunnit = setify(map (fst o strip_comb o concl) sofar) in let useful = filter (fun th -> not (mem (fst(strip_comb(rand(concl th)))) dunnit)) ths in if useful = [] then sofar else let follow_horn thm = let preds = map (fst o strip_comb) (conjuncts(lhand(concl thm))) in let asms = map (fun p -> find (fun th -> fst(strip_comb(concl th)) = p) sofar) preds in MATCH_MP thm (end_itlist CONJ asms) in let newth = tryfind follow_horn useful in exhaust_inhabitations ths (newth::sofar) in let ithms = exhaust_inhabitations imps bases in let exths = map (fun p -> find (fun th -> fst(strip_comb(concl th)) = p) ithms) preds in exths in (* ----------------------------------------------------------------------- *) (* Makes a type definition for one of the defined subsets. *) (* ----------------------------------------------------------------------- *) let define_inductive_type cdefs exth = let extm = concl exth in let epred = fst(strip_comb extm) in let ename = fst(dest_var epred) in let th1 = ASSUME (find (fun eq -> lhand eq = epred) (hyp exth)) in let th2 = TRANS th1 (SUBS_CONV cdefs (rand(concl th1))) in let th3 = EQ_MP (AP_THM th2 (rand extm)) exth in let th4,_ = itlist SCRUB_EQUATION (hyp th3) (th3,[]) in let mkname = "_mk_"^ename and destname = "_dest_"^ename in let bij1,bij2 = new_basic_type_definition ename (mkname,destname) th4 in let bij2a = AP_THM th2 (rand(rand(concl bij2))) in let bij2b = TRANS bij2a bij2 in bij1,bij2b in (* ----------------------------------------------------------------------- *) (* Defines a type constructor corresponding to current pseudo-constructor. *) (* ----------------------------------------------------------------------- *) let define_inductive_type_constructor defs consindex th = let avs,bod = strip_forall(concl th) in let asms,conc = if is_imp bod then conjuncts(lhand bod),rand bod else [],bod in let asmlist = map dest_comb asms in let cpred,cterm = dest_comb conc in let oldcon,oldargs = strip_comb cterm in let modify_arg v = try let dest = snd(assoc (rev_assoc v asmlist) consindex) in let ty' = hd(snd(dest_type(type_of dest))) in let v' = mk_var(fst(dest_var v),ty') in mk_comb(dest,v'),v' with Failure _ -> v,v in let newrights,newargs = unzip(map modify_arg oldargs) in let retmk = fst(assoc cpred consindex) in let defbod = mk_comb(retmk,list_mk_comb(oldcon,newrights)) in let defrt = list_mk_abs(newargs,defbod) in let expth = find (fun th -> lhand(concl th) = oldcon) defs in let rexpth = SUBS_CONV [expth] defrt in let deflf = mk_var(fst(dest_var oldcon),type_of defrt) in let defth = new_definition(mk_eq(deflf,rand(concl rexpth))) in TRANS defth (SYM rexpth) in (* ----------------------------------------------------------------------- *) (* Instantiate the induction theorem on the representatives to transfer *) (* it to the new type(s). Uses "\x. rep-pred(x) /\ P(mk x)" for "P". *) (* ----------------------------------------------------------------------- *) let instantiate_induction_theorem consindex ith = let avs,bod = strip_forall(concl ith) in let corlist = map((repeat rator F_F repeat rator) o dest_imp o body o rand) (conjuncts(rand bod)) in let consindex' = map (fun v -> let w = rev_assoc v corlist in w,assoc w consindex) avs in let recty = (hd o snd o dest_type o type_of o fst o snd o hd) consindex in let newtys = map (hd o snd o dest_type o type_of o snd o snd) consindex' in let ptypes = map (C mk_fun_ty bool_ty) newtys in let preds = make_args "P" [] ptypes in let args = make_args "x" [] (map (K recty) preds) in let lambs = map2 (fun (r,(m,d)) (p,a) -> mk_abs(a,mk_conj(mk_comb(r,a),mk_comb(p,mk_comb(m,a))))) consindex' (zip preds args) in SPECL lambs ith in (* ----------------------------------------------------------------------- *) (* Reduce a single clause of the postulated induction theorem (old_ver) ba *) (* to the kind wanted for the new type (new_ver); |- new_ver ==> old_ver *) (* ----------------------------------------------------------------------- *) let pullback_induction_clause tybijpairs conthms = let PRERULE = GEN_REWRITE_RULE (funpow 3 RAND_CONV) (map SYM conthms) in let IPRULE = SYM o GEN_REWRITE_RULE I (map snd tybijpairs) in fun rthm tm -> let avs,bimp = strip_forall tm in if is_imp bimp then let ant,con = dest_imp bimp in let ths = map (CONV_RULE BETA_CONV) (CONJUNCTS (ASSUME ant)) in let tths,pths = unzip (map CONJ_PAIR ths) in let tth = MATCH_MP (SPEC_ALL rthm) (end_itlist CONJ tths) in let mths = map IPRULE (tth::tths) in let conth1 = BETA_CONV con in let contm1 = rand(concl conth1) in let conth2 = TRANS conth1 (AP_TERM (rator contm1) (SUBS_CONV (tl mths) (rand contm1))) in let conth3 = PRERULE conth2 in let lctms = map concl pths in let asmin = mk_imp(list_mk_conj lctms,rand(rand(concl conth3))) in let argsin = map rand (conjuncts(lhand asmin)) in let argsgen = map (fun tm -> mk_var(fst(dest_var(rand tm)),type_of tm)) argsin in let asmgen = subst (zip argsgen argsin) asmin in let asmquant = list_mk_forall(snd(strip_comb(rand(rand asmgen))),asmgen) in let th1 = INST (zip argsin argsgen) (SPEC_ALL (ASSUME asmquant)) in let th2 = MP th1 (end_itlist CONJ pths) in let th3 = EQ_MP (SYM conth3) (CONJ tth th2) in DISCH asmquant (GENL avs (DISCH ant th3)) else let con = bimp in let conth2 = BETA_CONV con in let tth = PART_MATCH I rthm (lhand(rand(concl conth2))) in let conth3 = PRERULE conth2 in let asmgen = rand(rand(concl conth3)) in let asmquant = list_mk_forall(snd(strip_comb(rand asmgen)),asmgen) in let th2 = SPEC_ALL (ASSUME asmquant) in let th3 = EQ_MP (SYM conth3) (CONJ tth th2) in DISCH asmquant (GENL avs th3) in (* ----------------------------------------------------------------------- *) (* Finish off a consequence of the induction theorem. *) (* ----------------------------------------------------------------------- *) let finish_induction_conclusion consindex tybijpairs = let tybij1,tybij2 = unzip tybijpairs in let PRERULE = GEN_REWRITE_RULE (LAND_CONV o LAND_CONV o RAND_CONV) tybij1 o GEN_REWRITE_RULE LAND_CONV tybij2 and FINRULE = GEN_REWRITE_RULE RAND_CONV tybij1 in fun th -> let av,bimp = dest_forall(concl th) in let pv = lhand(body(rator(rand bimp))) in let p,v = dest_comb pv in let mk,dest = assoc p consindex in let ty = hd(snd(dest_type(type_of dest))) in let v' = mk_var(fst(dest_var v),ty) in let dv = mk_comb(dest,v') in let th1 = PRERULE (SPEC dv th) in let th2 = MP th1 (REFL (rand(lhand(concl th1)))) in let th3 = CONV_RULE BETA_CONV th2 in GEN v' (FINRULE (CONJUNCT2 th3)) in (* ----------------------------------------------------------------------- *) (* Derive the induction theorem. *) (* ----------------------------------------------------------------------- *) let derive_induction_theorem consindex tybijpairs conthms iith rth = let bths = map2 (pullback_induction_clause tybijpairs conthms) (CONJUNCTS rth) (conjuncts(lhand(concl iith))) in let asm = list_mk_conj(map (lhand o concl) bths) in let ths = map2 MP bths (CONJUNCTS (ASSUME asm)) in let th1 = MP iith (end_itlist CONJ ths) in let th2 = end_itlist CONJ (map (finish_induction_conclusion consindex tybijpairs) (CONJUNCTS th1)) in let th3 = DISCH asm th2 in let preds = map (rator o body o rand) (conjuncts(rand(concl th3))) in let th4 = GENL preds th3 in let pasms = filter (C mem (map fst consindex) o lhand) (hyp th4) in let th5 = itlist DISCH pasms th4 in let th6,_ = itlist SCRUB_EQUATION (hyp th5) (th5,[]) in let th7 = UNDISCH_ALL th6 in fst (itlist SCRUB_EQUATION (hyp th7) (th7,[])) in (* ----------------------------------------------------------------------- *) (* Create the recursive functions and eliminate pseudo-constructors. *) (* (These are kept just long enough to derive the key property.) *) (* ----------------------------------------------------------------------- *) let create_recursive_functions tybijpairs consindex conthms rth = let domtys = map (hd o snd o dest_type o type_of o snd o snd) consindex in let recty = (hd o snd o dest_type o type_of o fst o snd o hd) consindex in let ranty = mk_vartype "Z" in let fn = mk_var("fn",mk_fun_ty recty ranty) and fns = make_args "fn" [] (map (C mk_fun_ty ranty) domtys) in let args = make_args "a" [] domtys in let rights = map2 (fun (_,(_,d)) a -> mk_abs(a,mk_comb(fn,mk_comb(d,a)))) consindex args in let eqs = map2 (curry mk_eq) fns rights in let fdefs = map ASSUME eqs in let fxths1 = map (fun th1 -> tryfind (fun th2 -> MK_COMB(th2,th1)) fdefs) conthms in let fxths2 = map (fun th -> TRANS th (BETA_CONV (rand(concl th)))) fxths1 in let mk_tybijcons (th1,th2) = let th3 = INST [rand(lhand(concl th1)),rand(lhand(concl th2))] th2 in let th4 = AP_TERM (rator(lhand(rand(concl th2)))) th1 in EQ_MP (SYM th3) th4 in let SCONV = GEN_REWRITE_CONV I (map mk_tybijcons tybijpairs) and ERULE = GEN_REWRITE_RULE I (map snd tybijpairs) in let simplify_fxthm rthm fxth = let pat = funpow 4 rand (concl fxth) in if is_imp(repeat (snd o dest_forall) (concl rthm)) then let th1 = PART_MATCH (rand o rand) rthm pat in let tms1 = conjuncts(lhand(concl th1)) in let ths2 = map (fun t -> EQ_MP (SYM(SCONV t)) TRUTH) tms1 in ERULE (MP th1 (end_itlist CONJ ths2)) else ERULE (PART_MATCH rand rthm pat) in let fxths3 = map2 simplify_fxthm (CONJUNCTS rth) fxths2 in let fxths4 = map2 (fun th1 -> TRANS th1 o AP_TERM fn) fxths2 fxths3 in let cleanup_fxthm cth fxth = let tms = snd(strip_comb(rand(rand(concl fxth)))) in let kth = RIGHT_BETAS tms (ASSUME (hd(hyp cth))) in TRANS fxth (AP_TERM fn kth) in let fxth5 = end_itlist CONJ (map2 cleanup_fxthm conthms fxths4) in let pasms = filter (C mem (map fst consindex) o lhand) (hyp fxth5) in let fxth6 = itlist DISCH pasms fxth5 in let fxth7,_ = itlist SCRUB_EQUATION (itlist (union o hyp) conthms []) (fxth6,[]) in let fxth8 = UNDISCH_ALL fxth7 in fst (itlist SCRUB_EQUATION (subtract (hyp fxth8) eqs) (fxth8,[])) in (* ----------------------------------------------------------------------- *) (* Create a function for recursion clause. *) (* ----------------------------------------------------------------------- *) let create_recursion_iso_constructor = let s = `s:num->Z` in let zty = `:Z` in let numty = `:num` in let rec extract_arg tup v = if v = tup then REFL tup else let t1,t2 = dest_pair tup in let PAIR_th = ISPECL [t1;t2] (if free_in v t1 then FST else SND) in let tup' = rand(concl PAIR_th) in if tup' = v then PAIR_th else let th = extract_arg (rand(concl PAIR_th)) v in SUBS[SYM PAIR_th] th in fun consindex -> let recty = hd(snd(dest_type(type_of(fst(hd consindex))))) in let domty = hd(snd(dest_type recty)) in let i = mk_var("i",domty) and r = mk_var("r",mk_fun_ty numty recty) in let mks = map (fst o snd) consindex in let mkindex = map (fun t -> hd(tl(snd(dest_type(type_of t)))),t) mks in fun cth -> let artms = snd(strip_comb(rand(rand(concl cth)))) in let artys = mapfilter (type_of o rand) artms in let args,bod = strip_abs(rand(hd(hyp cth))) in let ccitm,rtm = dest_comb bod in let cctm,itm = dest_comb ccitm in let rargs,iargs = partition (C free_in rtm) args in let xths = map (extract_arg itm) iargs in let cargs' = map (subst [i,itm] o lhand o concl) xths in let indices = map sucivate (0--(length rargs - 1)) in let rindexed = map (curry mk_comb r) indices in let rargs' = map2 (fun a rx -> mk_comb(assoc a mkindex,rx)) artys rindexed in let sargs' = map (curry mk_comb s) indices in let allargs = cargs'@ rargs' @ sargs' in let funty = itlist (mk_fun_ty o type_of) allargs zty in let funname = fst(dest_const(repeat rator (lhand(concl cth))))^"'" in let funarg = mk_var(funname,funty) in list_mk_abs([i;r;s],list_mk_comb(funarg,allargs)) in (* ----------------------------------------------------------------------- *) (* Derive the recursion theorem. *) (* ----------------------------------------------------------------------- *) let derive_recursion_theorem = let CCONV = funpow 3 RATOR_CONV (REPEATC (GEN_REWRITE_CONV I [FCONS])) in fun tybijpairs consindex conthms rath -> let isocons = map (create_recursion_iso_constructor consindex) conthms in let ty = type_of(hd isocons) in let fcons = mk_const("FCONS",[ty,aty]) and fnil = mk_const("FNIL",[ty,aty]) in let bigfun = itlist (mk_binop fcons) isocons fnil in let eth = ISPEC bigfun CONSTR_REC in let fn = rator(rand(hd(conjuncts(concl rath)))) in let betm = let v,bod = dest_abs(rand(concl eth)) in vsubst[fn,v] bod in let LCONV = REWR_CONV (ASSUME betm) in let fnths = map (fun t -> RIGHT_BETAS [bndvar(rand t)] (ASSUME t)) (hyp rath) in let SIMPER = PURE_REWRITE_RULE (map SYM fnths @ map fst tybijpairs @ [FST; SND; FCONS; BETA_THM]) in let hackdown_rath th = let ltm,rtm = dest_eq(concl th) in let wargs = snd(strip_comb(rand ltm)) in let th1 = TRANS th (LCONV rtm) in let th2 = TRANS th1 (CCONV (rand(concl th1))) in let th3 = TRANS th2 (funpow 2 RATOR_CONV BETA_CONV (rand(concl th2))) in let th4 = TRANS th3 (RATOR_CONV BETA_CONV (rand(concl th3))) in let th5 = TRANS th4 (BETA_CONV (rand(concl th4))) in GENL wargs (SIMPER th5) in let rthm = end_itlist CONJ (map hackdown_rath (CONJUNCTS rath)) in let seqs = let unseqs = filter is_eq (hyp rthm) in let tys = map (hd o snd o dest_type o type_of o snd o snd) consindex in map (fun ty -> find (fun t -> hd(snd(dest_type(type_of(lhand t)))) = ty) unseqs) tys in let rethm = itlist EXISTS_EQUATION seqs rthm in let fethm = CHOOSE(fn,eth) rethm in let pcons = map (repeat rator o rand o repeat (snd o dest_forall)) (conjuncts(concl rthm)) in GENL pcons fethm in (* ----------------------------------------------------------------------- *) (* Basic function: returns induction and recursion separately. No parser. *) (* ----------------------------------------------------------------------- *) fun def -> let defs,rth,ith = justify_inductive_type_model def in let neths = prove_model_inhabitation rth in let tybijpairs = map (define_inductive_type defs) neths in let preds = map (repeat rator o concl) neths in let mkdests = map (fun (th,_) -> let tm = lhand(concl th) in rator tm,rator(rand tm)) tybijpairs in let consindex = zip preds mkdests in let condefs = map (define_inductive_type_constructor defs consindex) (CONJUNCTS rth) in let conthms = map (fun th -> let args = fst(strip_abs(rand(concl th))) in RIGHT_BETAS args th) condefs in let iith = instantiate_induction_theorem consindex ith in let fth = derive_induction_theorem consindex tybijpairs conthms iith rth in let rath = create_recursive_functions tybijpairs consindex conthms rth in let kth = derive_recursion_theorem tybijpairs consindex conthms rath in fth,kth;; (* ------------------------------------------------------------------------- *) (* Parser to present a nice interface a la Melham. *) (* ------------------------------------------------------------------------- *) let parse_inductive_type_specification = let parse_type_loc src = let pty,rst = parse_pretype src in type_of_pretype pty,rst in let parse_type_conapp src = let cn,sps = match src with (Ident cn)::sps -> cn,sps | _ -> fail() in let tys,rst = many parse_type_loc sps in (cn,tys),rst in let parse_type_clause src = let tn,sps = match src with (Ident tn)::sps -> tn,sps | _ -> fail() in let tys,rst = (a (Ident "=") ++ listof parse_type_conapp (a (Resword "|")) "type definition clauses" >> snd) sps in (mk_vartype tn,tys),rst in let parse_type_definition = listof parse_type_clause (a (Resword ";")) "type definition" in fun s -> let spec,rst = (parse_type_definition o lex o explode) s in if rst = [] then spec else failwith "parse_inductive_type_specification: junk after def";; (* ------------------------------------------------------------------------- *) (* Use this temporary version to define the sum type. *) (* ------------------------------------------------------------------------- *) let sum_INDUCT,sum_RECURSION = define_type_raw (parse_inductive_type_specification "sum = INL A | INR B");; let OUTL = new_recursive_definition sum_RECURSION `OUTL (INL x :A+B) = x`;; let OUTR = new_recursive_definition sum_RECURSION `OUTR (INR y :A+B) = y`;; (* ------------------------------------------------------------------------- *) (* Generalize the recursion theorem to multiple domain types. *) (* (We needed to use a single type to justify it via a proforma theorem.) *) (* *) (* NB! Before this is called nontrivially (i.e. more than one new type) *) (* the type constructor ":sum", used internally, must have been defined. *) (* ------------------------------------------------------------------------- *) let define_type_raw = let generalize_recursion_theorem = let ELIM_OUTCOMBS = GEN_REWRITE_RULE TOP_DEPTH_CONV [OUTL; OUTR] in let rec mk_sum tys = let k = length tys in if k = 1 then hd tys else let tys1,tys2 = chop_list (k / 2) tys in mk_type("sum",[mk_sum tys1; mk_sum tys2]) in let mk_inls = let rec mk_inls ty = if is_vartype ty then [mk_var("x",ty)] else let _,[ty1;ty2] = dest_type ty in let inls1 = mk_inls ty1 and inls2 = mk_inls ty2 in let inl = mk_const("INL",[ty1,aty; ty2,bty]) and inr = mk_const("INR",[ty1,aty; ty2,bty]) in map (curry mk_comb inl) inls1 @ map (curry mk_comb inr) inls2 in fun ty -> let bods = mk_inls ty in map (fun t -> mk_abs(find_term is_var t,t)) bods in let mk_outls = let rec mk_inls sof ty = if is_vartype ty then [sof] else let _,[ty1;ty2] = dest_type ty in let outl = mk_const("OUTL",[ty1,aty; ty2,bty]) and outr = mk_const("OUTR",[ty1,aty; ty2,bty]) in mk_inls (mk_comb(outl,sof)) ty1 @ mk_inls (mk_comb(outr,sof)) ty2 in fun ty -> let x = mk_var("x",ty) in map (curry mk_abs x) (mk_inls x ty) in let mk_newfun fn outl = let s,ty = dest_var fn in let dty = hd(snd(dest_type ty)) in let x = mk_var("x",dty) in let y,bod = dest_abs outl in let r = mk_abs(x,vsubst[mk_comb(fn,x),y] bod) in let l = mk_var(s,type_of r) in let th1 = ASSUME (mk_eq(l,r)) in RIGHT_BETAS [x] th1 in fun th -> let avs,ebod = strip_forall(concl th) in let evs,bod = strip_exists ebod in let n = length evs in if n = 1 then th else let tys = map (fun i -> mk_vartype ("Z"^(string_of_int i))) (0--(n - 1)) in let sty = mk_sum tys in let inls = mk_inls sty and outls = mk_outls sty in let zty = type_of(rand(snd(strip_forall(hd(conjuncts bod))))) in let ith = INST_TYPE [sty,zty] th in let avs,ebod = strip_forall(concl ith) in let evs,bod = strip_exists ebod in let fns' = map2 mk_newfun evs outls in let fnalist = zip evs (map (rator o lhs o concl) fns') and inlalist = zip evs inls and outlalist = zip evs outls in let hack_clause tm = let avs,bod = strip_forall tm in let l,r = dest_eq bod in let fn,args = strip_comb r in let pargs = map (fun a -> let g = genvar(type_of a) in if is_var a then g,g else let outl = assoc (rator a) outlalist in mk_comb(outl,g),g) args in let args',args'' = unzip pargs in let inl = assoc (rator l) inlalist in let rty = hd(snd(dest_type(type_of inl))) in let nty = itlist (mk_fun_ty o type_of) args' rty in let fn' = mk_var(fst(dest_var fn),nty) in let r' = list_mk_abs(args'',mk_comb(inl,list_mk_comb(fn',args'))) in r',fn in let defs = map hack_clause (conjuncts bod) in let jth = BETA_RULE (SPECL (map fst defs) ith) in let bth = ASSUME (snd(strip_exists(concl jth))) in let finish_clause th = let avs,bod = strip_forall (concl th) in let outl = assoc (rator (lhand bod)) outlalist in GENL avs (BETA_RULE (AP_TERM outl (SPECL avs th))) in let cth = end_itlist CONJ (map finish_clause (CONJUNCTS bth)) in let dth = ELIM_OUTCOMBS cth in let eth = GEN_REWRITE_RULE ONCE_DEPTH_CONV (map SYM fns') dth in let fth = itlist SIMPLE_EXISTS (map snd fnalist) eth in let dtms = map (hd o hyp) fns' in let gth = itlist (fun e th -> let l,r = dest_eq e in MP (INST [r,l] (DISCH e th)) (REFL r)) dtms fth in let hth = PROVE_HYP jth (itlist SIMPLE_CHOOSE evs gth) in let xvs = map (fst o strip_comb o rand o snd o strip_forall) (conjuncts(concl eth)) in GENL xvs hth in fun def -> let ith,rth = define_type_raw def in ith,generalize_recursion_theorem rth;; (* ------------------------------------------------------------------------- *) (* Set up options and lists. *) (* ------------------------------------------------------------------------- *) let option_INDUCT,option_RECURSION = define_type_raw (parse_inductive_type_specification "option = NONE | SOME A");; let list_INDUCT,list_RECURSION = define_type_raw (parse_inductive_type_specification "list = NIL | CONS A list");; (* ------------------------------------------------------------------------- *) (* Tools for proving injectivity and distinctness of constructors. *) (* ------------------------------------------------------------------------- *) let prove_constructors_injective = let DEPAIR = GEN_REWRITE_RULE TOP_SWEEP_CONV [PAIR_EQ] in let prove_distinctness ax pat = let f,args = strip_comb pat in let rt = end_itlist (curry mk_pair) args in let ty = mk_fun_ty (type_of pat) (type_of rt) in let fn = genvar ty in let dtm = mk_eq(mk_comb(fn,pat),rt) in let eth = prove_recursive_functions_exist ax (list_mk_forall(args,dtm)) in let args' = variants args args in let atm = mk_eq(pat,list_mk_comb(f,args')) in let ath = ASSUME atm in let bth = AP_TERM fn ath in let cth1 = SPECL args (ASSUME(snd(dest_exists(concl eth)))) in let cth2 = INST (zip args' args) cth1 in let pth = TRANS (TRANS (SYM cth1) bth) cth2 in let qth = DEPAIR pth in let qtm = concl qth in let rth = rev_itlist (C(curry MK_COMB)) (CONJUNCTS(ASSUME qtm)) (REFL f) in let tth = IMP_ANTISYM_RULE (DISCH atm qth) (DISCH qtm rth) in let uth = GENL args (GENL args' tth) in PROVE_HYP eth (SIMPLE_CHOOSE fn uth) in fun ax -> let cls = conjuncts(snd(strip_exists(snd(strip_forall(concl ax))))) in let pats = map (rand o lhand o snd o strip_forall) cls in end_itlist CONJ (mapfilter (prove_distinctness ax) pats);; let prove_constructors_distinct = let num_ty = `:num` in let rec allopairs f l m = if l = [] then [] else map (f (hd l)) (tl m) @ allopairs f (tl l) (tl m) in let NEGATE = GEN_ALL o CONV_RULE (REWR_CONV (TAUT `a ==> F <=> ~a`)) in let prove_distinct ax pat = let nums = map mk_small_numeral (0--(length pat - 1)) in let fn = genvar (mk_type("fun",[type_of(hd pat); num_ty])) in let ls = map (curry mk_comb fn) pat in let defs = map2 (fun l r -> list_mk_forall(frees (rand l),mk_eq(l,r))) ls nums in let eth = prove_recursive_functions_exist ax (list_mk_conj defs) in let ev,bod = dest_exists(concl eth) in let REWRITE = GEN_REWRITE_RULE ONCE_DEPTH_CONV (CONJUNCTS (ASSUME bod)) in let pat' = map (fun t -> let f,args = if is_numeral t then t,[] else strip_comb t in list_mk_comb(f,variants args args)) pat in let pairs = allopairs (curry mk_eq) pat pat' in let nths = map (REWRITE o AP_TERM fn o ASSUME) pairs in let fths = map2 (fun t th -> NEGATE (DISCH t (CONV_RULE NUM_EQ_CONV th))) pairs nths in CONJUNCTS(PROVE_HYP eth (SIMPLE_CHOOSE ev (end_itlist CONJ fths))) in fun ax -> let cls = conjuncts(snd(strip_exists(snd(strip_forall(concl ax))))) in let lefts = map (dest_comb o lhand o snd o strip_forall) cls in let fns = itlist (insert o fst) lefts [] in let pats = map (fun f -> map snd (filter ((=)f o fst) lefts)) fns in end_itlist CONJ (end_itlist (@) (mapfilter (prove_distinct ax) pats));; (* ------------------------------------------------------------------------- *) (* Automatically prove the case analysis theorems. *) (* ------------------------------------------------------------------------- *) let prove_cases_thm = let mk_exclauses x rpats = let xts = map (fun t -> list_mk_exists(frees t,mk_eq(x,t))) rpats in mk_abs(x,list_mk_disj xts) in let prove_triv tm = let evs,bod = strip_exists tm in let l,r = dest_eq bod in if l = r then REFL l else let lf,largs = strip_comb l and rf,rargs = strip_comb r in if lf = rf then let ths = map (ASSUME o mk_eq) (zip rargs largs) in let th1 = rev_itlist (C (curry MK_COMB)) ths (REFL lf) in itlist EXISTS_EQUATION (map concl ths) (SYM th1) else failwith "prove_triv" in let rec prove_disj tm = if is_disj tm then let l,r = dest_disj tm in try DISJ1 (prove_triv l) r with Failure _ -> DISJ2 l (prove_disj r) else prove_triv tm in let prove_eclause tm = let avs,bod = strip_forall tm in let ctm = if is_imp bod then rand bod else bod in let cth = prove_disj ctm in let dth = if is_imp bod then DISCH (lhand bod) cth else cth in GENL avs dth in fun th -> let avs,bod = strip_forall(concl th) in let cls = map (snd o strip_forall) (conjuncts(lhand bod)) in let pats = map (fun t -> if is_imp t then rand t else t) cls in let spats = map dest_comb pats in let preds = itlist (insert o fst) spats [] in let rpatlist = map (fun pr -> map snd (filter (fun (p,x) -> p = pr) spats)) preds in let xs = make_args "x" (freesl pats) (map (type_of o hd) rpatlist) in let xpreds = map2 mk_exclauses xs rpatlist in let ith = BETA_RULE (INST (zip xpreds preds) (SPEC_ALL th)) in let eclauses = conjuncts(fst(dest_imp(concl ith))) in MP ith (end_itlist CONJ (map prove_eclause eclauses));; (* ------------------------------------------------------------------------- *) (* Now deal with nested recursion. Need a store of previous theorems. *) (* ------------------------------------------------------------------------- *) inductive_type_store := ["list",(2,list_INDUCT,list_RECURSION); "option",(2,option_INDUCT,option_RECURSION); "sum",(2,sum_INDUCT,sum_RECURSION)] @ (!inductive_type_store);; (* ------------------------------------------------------------------------- *) (* Also add a cached rewrite of distinctness and injectivity theorems. Since *) (* there can be quadratically many distinctness clauses, it would really be *) (* preferable to have a conversion, but this seems OK up 100 constructors. *) (* ------------------------------------------------------------------------- *) let basic_rectype_net = ref empty_net;; let distinctness_store = ref ["bool",TAUT `(T <=> F) <=> F`];; let injectivity_store = ref [];; let extend_rectype_net (tyname,(_,_,rth)) = let ths1 = try [prove_constructors_distinct rth] with Failure _ -> [] and ths2 = try [prove_constructors_injective rth] with Failure _ -> [] in let canon_thl = itlist (mk_rewrites false) (ths1 @ ths2) [] in distinctness_store := map (fun th -> tyname,th) ths1 @ (!distinctness_store); injectivity_store := map (fun th -> tyname,th) ths2 @ (!injectivity_store); basic_rectype_net := itlist (net_of_thm true) canon_thl (!basic_rectype_net);; do_list extend_rectype_net (!inductive_type_store);; (* ------------------------------------------------------------------------- *) (* Return distinctness and injectivity for a type by simple lookup. *) (* ------------------------------------------------------------------------- *) let distinctness ty = assoc ty (!distinctness_store);; let injectivity ty = assoc ty (!injectivity_store);; let cases ty = if ty = "num" then num_CASES else let _,ith,_ = assoc ty (!inductive_type_store) in prove_cases_thm ith;; (* ------------------------------------------------------------------------- *) (* Convenient definitions for type isomorphism. *) (* ------------------------------------------------------------------------- *) let ISO = new_definition `ISO (f:A->B) (g:B->A) <=> (!x. f(g x) = x) /\ (!y. g(f y) = y)`;; let ISO_REFL = prove (`ISO (\x:A. x) (\x. x)`, REWRITE_TAC[ISO]);; let ISO_FUN = prove (`ISO (f:A->A') f' /\ ISO (g:B->B') g' ==> ISO (\h a'. g(h(f' a'))) (\h a. g'(h(f a)))`, REWRITE_TAC[ISO; FUN_EQ_THM] THEN MESON_TAC[]);; let ISO_USAGE = prove (`ISO f g ==> (!P. (!x. P x) <=> (!x. P(g x))) /\ (!P. (?x. P x) <=> (?x. P(g x))) /\ (!a b. (a = g b) <=> (f a = b))`, REWRITE_TAC[ISO; FUN_EQ_THM] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Hence extend type definition to nested types. *) (* ------------------------------------------------------------------------- *) let define_type_raw = (* ----------------------------------------------------------------------- *) (* Dispose of trivial antecedent. *) (* ----------------------------------------------------------------------- *) let TRIV_ANTE_RULE = let TRIV_IMP_CONV tm = let avs,bod = strip_forall tm in let bth = if is_eq bod then REFL (rand bod) else let ant,con = dest_imp bod in let ith = SUBS_CONV (CONJUNCTS(ASSUME ant)) (lhs con) in DISCH ant ith in GENL avs bth in fun th -> let tm = concl th in if is_imp tm then let ant,con = dest_imp(concl th) in let cjs = conjuncts ant in let cths = map TRIV_IMP_CONV cjs in MP th (end_itlist CONJ cths) else th in (* ----------------------------------------------------------------------- *) (* Lift type bijections to "arbitrary" (well, free rec or function) type. *) (* ----------------------------------------------------------------------- *) let ISO_EXPAND_CONV = PURE_ONCE_REWRITE_CONV[ISO] in let rec lift_type_bijections iths cty = let itys = map (hd o snd o dest_type o type_of o lhand o concl) iths in try assoc cty (zip itys iths) with Failure _ -> if not (exists (C occurs_in cty) itys) then INST_TYPE [cty,aty] ISO_REFL else let tycon,isotys = dest_type cty in if tycon = "fun" then MATCH_MP ISO_FUN (end_itlist CONJ (map (lift_type_bijections iths) isotys)) else failwith ("lift_type_bijections: Unexpected type operator \""^tycon^"\"") in (* ----------------------------------------------------------------------- *) (* Prove isomorphism of nested types where former is the smaller. *) (* ----------------------------------------------------------------------- *) let DE_EXISTENTIALIZE_RULE = let pth = prove (`(?) P ==> (c = (@)P) ==> P c`, GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN DISCH_TAC THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SELECT_AX THEN POP_ASSUM ACCEPT_TAC) in let USE_PTH = MATCH_MP pth in let rec DE_EXISTENTIALIZE_RULE th = if not (is_exists(concl th)) then [],th else let th1 = USE_PTH th in let v1 = rand(rand(concl th1)) in let gv = genvar(type_of v1) in let th2 = CONV_RULE BETA_CONV (UNDISCH (INST [gv,v1] th1)) in let vs,th3 = DE_EXISTENTIALIZE_RULE th2 in gv::vs,th3 in DE_EXISTENTIALIZE_RULE in let grab_type = type_of o rand o lhand o snd o strip_forall in let clause_corresponds cl0 = let f0,ctm0 = dest_comb (lhs cl0) in let c0 = fst(dest_const(fst(strip_comb ctm0))) in let dty0,rty0 = dest_fun_ty (type_of f0) in fun cl1 -> let f1,ctm1 = dest_comb (lhs cl1) in let c1 = fst(dest_const(fst(strip_comb ctm1))) in let dty1,rty1 = dest_fun_ty (type_of f1) in c0 = c1 && dty0 = rty1 && rty0 = dty1 in let prove_inductive_types_isomorphic n k (ith0,rth0) (ith1,rth1) = let sth0 = SPEC_ALL rth0 and sth1 = SPEC_ALL rth1 and t_tm = concl TRUTH in let pevs0,pbod0 = strip_exists (concl sth0) and pevs1,pbod1 = strip_exists (concl sth1) in let pcjs0,qcjs0 = chop_list k (conjuncts pbod0) and pcjs1,qcjs1 = chop_list k (snd(chop_list n (conjuncts pbod1))) in let tyal0 = setify (zip (map grab_type pcjs1) (map grab_type pcjs0)) in let tyal1 = map (fun (a,b) -> (b,a)) tyal0 in let tyins0 = map (fun f -> let domty,ranty = dest_fun_ty (type_of f) in tysubst tyal0 domty,ranty) pevs0 and tyins1 = map (fun f -> let domty,ranty = dest_fun_ty (type_of f) in tysubst tyal1 domty,ranty) pevs1 in let tth0 = INST_TYPE tyins0 sth0 and tth1 = INST_TYPE tyins1 sth1 in let evs0,bod0 = strip_exists(concl tth0) and evs1,bod1 = strip_exists(concl tth1) in let lcjs0,rcjs0 = chop_list k (map (snd o strip_forall) (conjuncts bod0)) and lcjs1,rcjsx = chop_list k (map (snd o strip_forall) (snd(chop_list n (conjuncts bod1)))) in let rcjs1 = map (fun t -> find (clause_corresponds t) rcjsx) rcjs0 in let proc_clause tm0 tm1 = let l0,r0 = dest_eq tm0 and l1,r1 = dest_eq tm1 in let vc0,wargs0 = strip_comb r0 in let con0,vargs0 = strip_comb(rand l0) in let gargs0 = map (genvar o type_of) wargs0 in let nestf0 = map (fun a -> can (find (fun t -> is_comb t && rand t = a)) wargs0) vargs0 in let targs0 = map2 (fun a f -> if f then find (fun t -> is_comb t && rand t = a) wargs0 else a) vargs0 nestf0 in let gvlist0 = zip wargs0 gargs0 in let xargs = map (fun v -> assoc v gvlist0) targs0 in let inst0 = list_mk_abs(gargs0,list_mk_comb(fst(strip_comb(rand l1)),xargs)),vc0 in let vc1,wargs1 = strip_comb r1 in let con1,vargs1 = strip_comb(rand l1) in let gargs1 = map (genvar o type_of) wargs1 in let targs1 = map2 (fun a f -> if f then find (fun t -> is_comb t && rand t = a) wargs1 else a) vargs1 nestf0 in let gvlist1 = zip wargs1 gargs1 in let xargs = map (fun v -> assoc v gvlist1) targs1 in let inst1 = list_mk_abs(gargs1,list_mk_comb(fst(strip_comb(rand l0)),xargs)),vc1 in inst0,inst1 in let insts0,insts1 = unzip (map2 proc_clause (lcjs0@rcjs0) (lcjs1@rcjs1)) in let uth0 = BETA_RULE(INST insts0 tth0) and uth1 = BETA_RULE(INST insts1 tth1) in let efvs0,sth0 = DE_EXISTENTIALIZE_RULE uth0 and efvs1,sth1 = DE_EXISTENTIALIZE_RULE uth1 in let efvs2 = map (fun t1 -> find (fun t2 -> hd(tl(snd(dest_type(type_of t1)))) = hd(snd(dest_type(type_of t2)))) efvs1) efvs0 in let isotms = map2 (fun ff gg -> list_mk_icomb "ISO" [ff;gg]) efvs0 efvs2 in let ctm = list_mk_conj isotms in let cth1 = ISO_EXPAND_CONV ctm in let ctm1 = rand(concl cth1) in let cjs = conjuncts ctm1 in let eee = map (fun n -> n mod 2 = 0) (0--(length cjs - 1)) in let cjs1,cjs2 = partition fst (zip eee cjs) in let ctm2 = mk_conj(list_mk_conj (map snd cjs1), list_mk_conj (map snd cjs2)) in let DETRIV_RULE = TRIV_ANTE_RULE o REWRITE_RULE[sth0;sth1] in let jth0 = let itha = SPEC_ALL ith0 in let icjs = conjuncts(rand(concl itha)) in let cinsts = map (fun tm -> tryfind (fun vtm -> term_match [] vtm tm) icjs) (conjuncts (rand ctm2)) in let tvs = subtract (fst(strip_forall(concl ith0))) (itlist (fun (_,x,_) -> union (map snd x)) cinsts []) in let ctvs = map (fun p -> let x = mk_var("x",hd(snd(dest_type(type_of p)))) in mk_abs(x,t_tm),p) tvs in DETRIV_RULE (INST ctvs (itlist INSTANTIATE cinsts itha)) and jth1 = let itha = SPEC_ALL ith1 in let icjs = conjuncts(rand(concl itha)) in let cinsts = map (fun tm -> tryfind (fun vtm -> term_match [] vtm tm) icjs) (conjuncts (lhand ctm2)) in let tvs = subtract (fst(strip_forall(concl ith1))) (itlist (fun (_,x,_) -> union (map snd x)) cinsts []) in let ctvs = map (fun p -> let x = mk_var("x",hd(snd(dest_type(type_of p)))) in mk_abs(x,t_tm),p) tvs in DETRIV_RULE (INST ctvs (itlist INSTANTIATE cinsts itha)) in let cths4 = map2 CONJ (CONJUNCTS jth0) (CONJUNCTS jth1) in let cths5 = map (PURE_ONCE_REWRITE_RULE[GSYM ISO]) cths4 in let cth6 = end_itlist CONJ cths5 in cth6,CONJ sth0 sth1 in (* ----------------------------------------------------------------------- *) (* Define nested type by doing a 1-level unwinding. *) (* ----------------------------------------------------------------------- *) let SCRUB_ASSUMPTION th = let hyps = hyp th in let eqn = find (fun t -> let x = lhs t in forall (fun u -> not (free_in x (rand u))) hyps) hyps in let l,r = dest_eq eqn in MP (INST [r,l] (DISCH eqn th)) (REFL r) in let define_type_basecase def = let add_id s = fst(dest_var(genvar bool_ty)) in let def' = map (I F_F (map (add_id F_F I))) def in define_type_raw def' in let SIMPLE_BETA_RULE = GSYM o PURE_REWRITE_RULE[BETA_THM; FUN_EQ_THM] in let ISO_USAGE_RULE = MATCH_MP ISO_USAGE in let SIMPLE_ISO_EXPAND_RULE = CONV_RULE(REWR_CONV ISO) in let REWRITE_FUN_EQ_RULE = let ths = itlist (mk_rewrites false) [FUN_EQ_THM] [] in let net = itlist (net_of_thm false) ths (basic_net()) in CONV_RULE o GENERAL_REWRITE_CONV true TOP_DEPTH_CONV net in let is_nested vs ty = not (is_vartype ty) && not (intersect (tyvars ty) vs = []) in let rec modify_type alist ty = try rev_assoc ty alist with Failure _ -> try let tycon,tyargs = dest_type ty in mk_type(tycon,map (modify_type alist) tyargs) with Failure _ -> ty in let modify_item alist (s,l) = s,map (modify_type alist) l in let modify_clause alist (l,lis) = l,map (modify_item alist) lis in let recover_clause id tm = let con,args = strip_comb tm in fst(dest_const con)^id,map type_of args in let rec create_auxiliary_clauses nty = let id = fst(dest_var(genvar bool_ty)) in let tycon,tyargs = dest_type nty in let k,ith,rth = try assoc tycon (!inductive_type_store) with Failure _ -> failwith ("Can't find definition for nested type: "^tycon) in let evs,bod = strip_exists(snd(strip_forall(concl rth))) in let cjs = map (lhand o snd o strip_forall) (conjuncts bod) in let rtys = map (hd o snd o dest_type o type_of) evs in let tyins = tryfind (fun vty -> type_match vty nty []) rtys in let cjs' = map (inst tyins o rand) (fst(chop_list k cjs)) in let mtys = itlist (insert o type_of) cjs' [] in let pcons = map (fun ty -> filter (fun t -> type_of t = ty) cjs') mtys in let cls' = zip mtys (map (map (recover_clause id)) pcons) in let tyal = map (fun ty -> mk_vartype(fst(dest_type ty)^id),ty) mtys in let cls'' = map (modify_type tyal F_F map (modify_item tyal)) cls' in k,tyal,cls'',INST_TYPE tyins ith,INST_TYPE tyins rth in let rec define_type_nested def = let n = length(itlist (@) (map (map fst o snd) def) []) in let newtys = map fst def in let utys = unions (itlist (union o map snd o snd) def []) in let rectys = filter (is_nested newtys) utys in if rectys = [] then let th1,th2 = define_type_basecase def in n,th1,th2 else let nty = hd (sort (fun t1 t2 -> occurs_in t2 t1) rectys) in let k,tyal,ncls,ith,rth = create_auxiliary_clauses nty in let cls = map (modify_clause tyal) def @ ncls in let _,ith1,rth1 = define_type_nested cls in let xnewtys = map (hd o snd o dest_type o type_of) (fst(strip_exists(snd(strip_forall(concl rth1))))) in let xtyal = map (fun ty -> let s = dest_vartype ty in find (fun t -> fst(dest_type t) = s) xnewtys,ty) (map fst cls) in let ith0 = INST_TYPE xtyal ith and rth0 = INST_TYPE xtyal rth in let isoth,rclauses = prove_inductive_types_isomorphic n k (ith0,rth0) (ith1,rth1) in let irth3 = CONJ ith1 rth1 in let vtylist = itlist (insert o type_of) (variables(concl irth3)) [] in let isoths = CONJUNCTS isoth in let isotys = map (hd o snd o dest_type o type_of o lhand o concl) isoths in let ctylist = filter (fun ty -> exists (fun t -> occurs_in t ty) isotys) vtylist in let atylist = itlist (union o striplist dest_fun_ty) ctylist [] in let isoths' = map (lift_type_bijections isoths) (filter (fun ty -> exists (fun t -> occurs_in t ty) isotys) atylist) in let cisoths = map (BETA_RULE o lift_type_bijections isoths') ctylist in let uisoths = map ISO_USAGE_RULE cisoths in let visoths = map (ASSUME o concl) uisoths in let irth4 = itlist PROVE_HYP uisoths (REWRITE_FUN_EQ_RULE visoths irth3) in let irth5 = REWRITE_RULE (rclauses :: map SIMPLE_ISO_EXPAND_RULE isoths') irth4 in let irth6 = repeat SCRUB_ASSUMPTION irth5 in let ncjs = filter (fun t -> exists (fun v -> not(is_var v)) (snd(strip_comb(rand(lhs(snd(strip_forall t))))))) (conjuncts(snd(strip_exists (snd(strip_forall(rand(concl irth6))))))) in let mk_newcon tm = let vs,bod = strip_forall tm in let rdeb = rand(lhs bod) in let rdef = list_mk_abs(vs,rdeb) in let newname = fst(dest_var(genvar bool_ty)) in let def = mk_eq(mk_var(newname,type_of rdef),rdef) in let dth = new_definition def in SIMPLE_BETA_RULE dth in let dths = map mk_newcon ncjs in let ith6,rth6 = CONJ_PAIR(PURE_REWRITE_RULE dths irth6) in n,ith6,rth6 in fun def -> let newtys = map fst def in let truecons = itlist (@) (map (map fst o snd) def) [] in let (p,ith0,rth0) = define_type_nested def in let avs,etm = strip_forall(concl rth0) in let allcls = conjuncts(snd(strip_exists etm)) in let relcls = fst(chop_list (length truecons) allcls) in let gencons = map (repeat rator o rand o lhand o snd o strip_forall) relcls in let cdefs = map2 (fun s r -> SYM(new_definition (mk_eq(mk_var(s,type_of r),r)))) truecons gencons in let tavs = make_args "f" [] (map type_of avs) in let ith1 = SUBS cdefs ith0 and rth1 = GENL tavs (SUBS cdefs (SPECL tavs rth0)) in let retval = p,ith1,rth1 in let newentries = map (fun s -> dest_vartype s,retval) newtys in (inductive_type_store := newentries @ (!inductive_type_store); do_list extend_rectype_net newentries; ith1,rth1);; (* ----------------------------------------------------------------------- *) (* The overall function, with rather crude string-based benignity. *) (* ----------------------------------------------------------------------- *) let the_inductive_types = ref ["list = NIL | CONS A list",(list_INDUCT,list_RECURSION); "option = NONE | SOME A",(option_INDUCT,option_RECURSION); "sum = INL A | INR B",(sum_INDUCT,sum_RECURSION)];; let define_type s = try let retval = assoc s (!the_inductive_types) in (warn true "Benign redefinition of inductive type"; retval) with Failure _ -> let defspec = parse_inductive_type_specification s in let newtypes = map fst defspec and constructors = itlist ((@) o map fst) (map snd defspec) [] in if not(length(setify newtypes) = length newtypes) then failwith "define_type: multiple definitions of a type" else if not(length(setify constructors) = length constructors) then failwith "define_type: multiple instances of a constructor" else if exists (can get_type_arity o dest_vartype) newtypes then let t = find (can get_type_arity) (map dest_vartype newtypes) in failwith("define_type: type :"^t^" already defined") else if exists (can get_const_type) constructors then let t = find (can get_const_type) constructors in failwith("define_type: constant "^t^" already defined") else let retval = define_type_raw defspec in the_inductive_types := (s,retval)::(!the_inductive_types); retval;; (* ------------------------------------------------------------------------- *) (* Unwinding, and application of patterns. Add easy cases to default net. *) (* ------------------------------------------------------------------------- *) let UNWIND_CONV,MATCH_CONV = let pth_0 = prove (`(if ?!x. x = a /\ p then @x. x = a /\ p else @x. F) = (if p then a else @x. F)`, BOOL_CASES_TAC `p:bool` THEN ASM_REWRITE_TAC[COND_ID] THEN MESON_TAC[]) and pth_1 = prove (`_MATCH x (_SEQPATTERN r s) = (if ?y. r x y then _MATCH x r else _MATCH x s) /\ _FUNCTION (_SEQPATTERN r s) x = (if ?y. r x y then _FUNCTION r x else _FUNCTION s x)`, REWRITE_TAC[_MATCH; _SEQPATTERN; _FUNCTION] THEN MESON_TAC[]) and pth_2 = prove (`((?y. _UNGUARDED_PATTERN (GEQ s t) (GEQ u y)) <=> s = t) /\ ((?y. _GUARDED_PATTERN (GEQ s t) p (GEQ u y)) <=> s = t /\ p)`, REWRITE_TAC[_UNGUARDED_PATTERN; _GUARDED_PATTERN; GEQ_DEF] THEN MESON_TAC[]) and pth_3 = prove (`(_MATCH x (\y z. P y z) = if ?!z. P x z then @z. P x z else @x. F) /\ (_FUNCTION (\y z. P y z) x = if ?!z. P x z then @z. P x z else @x. F)`, REWRITE_TAC[_MATCH; _FUNCTION]) and pth_4 = prove (`(_UNGUARDED_PATTERN (GEQ s t) (GEQ u y) <=> y = u /\ s = t) /\ (_GUARDED_PATTERN (GEQ s t) p (GEQ u y) <=> y = u /\ s = t /\ p)`, REWRITE_TAC[_UNGUARDED_PATTERN; _GUARDED_PATTERN; GEQ_DEF] THEN MESON_TAC[]) and pth_5 = prove (`(if ?!z. z = k then @z. z = k else @x. F) = k`, MESON_TAC[]) in let rec INSIDE_EXISTS_CONV conv tm = if is_exists tm then BINDER_CONV (INSIDE_EXISTS_CONV conv) tm else conv tm in let PUSH_EXISTS_CONV = let econv = REWR_CONV SWAP_EXISTS_THM in let rec conv bc tm = try (econv THENC BINDER_CONV(conv bc)) tm with Failure _ -> bc tm in conv in let BREAK_CONS_CONV = let conv2 = GEN_REWRITE_CONV DEPTH_CONV [AND_CLAUSES; OR_CLAUSES] THENC ASSOC_CONV CONJ_ASSOC in fun tm -> let conv0 = TOP_SWEEP_CONV(REWRITES_CONV(!basic_rectype_net)) in let conv1 = if is_conj tm then LAND_CONV conv0 else conv0 in (conv1 THENC conv2) tm in let UNWIND_CONV = let baseconv = GEN_REWRITE_CONV I [UNWIND_THM1; UNWIND_THM2; EQT_INTRO(SPEC_ALL EXISTS_REFL); EQT_INTRO(GSYM(SPEC_ALL EXISTS_REFL))] in let rec UNWIND_CONV tm = let evs,bod = strip_exists tm in let eqs = conjuncts bod in try let eq = find (fun tm -> is_eq tm & let l,r = dest_eq tm in (mem l evs && not (free_in l r)) || (mem r evs && not (free_in r l))) eqs in let l,r = dest_eq eq in let v = if mem l evs && not (free_in l r) then l else r in let cjs' = eq::(subtract eqs [eq]) in let n = length evs - (1 + index v (rev evs)) in let th1 = CONJ_ACI_RULE(mk_eq(bod,list_mk_conj cjs')) in let th2 = itlist MK_EXISTS evs th1 in let th3 = funpow n BINDER_CONV (PUSH_EXISTS_CONV baseconv) (rand(concl th2)) in CONV_RULE (RAND_CONV UNWIND_CONV) (TRANS th2 th3) with Failure _ -> REFL tm in UNWIND_CONV in let MATCH_SEQPATTERN_CONV = GEN_REWRITE_CONV I [pth_1] THENC RATOR_CONV(LAND_CONV (BINDER_CONV(RATOR_CONV BETA_CONV THENC BETA_CONV) THENC PUSH_EXISTS_CONV(GEN_REWRITE_CONV I [pth_2] THENC BREAK_CONS_CONV) THENC UNWIND_CONV THENC GEN_REWRITE_CONV DEPTH_CONV [EQT_INTRO(SPEC_ALL EQ_REFL); AND_CLAUSES] THENC GEN_REWRITE_CONV DEPTH_CONV [EXISTS_SIMP])) and MATCH_ONEPATTERN_CONV tm = let th1 = GEN_REWRITE_CONV I [pth_3] tm in let tm' = body(rand(lhand(rand(concl th1)))) in let th2 = (INSIDE_EXISTS_CONV (GEN_REWRITE_CONV I [pth_4] THENC RAND_CONV BREAK_CONS_CONV) THENC UNWIND_CONV THENC GEN_REWRITE_CONV DEPTH_CONV [EQT_INTRO(SPEC_ALL EQ_REFL); AND_CLAUSES] THENC GEN_REWRITE_CONV DEPTH_CONV [EXISTS_SIMP]) tm' in let conv tm = if tm = lhand(concl th2) then th2 else fail() in CONV_RULE (RAND_CONV (RATOR_CONV (COMB2_CONV (RAND_CONV (BINDER_CONV conv)) (BINDER_CONV conv)))) th1 in let MATCH_SEQPATTERN_CONV_TRIV = MATCH_SEQPATTERN_CONV THENC GEN_REWRITE_CONV I [COND_CLAUSES] and MATCH_SEQPATTERN_CONV_GEN = MATCH_SEQPATTERN_CONV THENC GEN_REWRITE_CONV TRY_CONV [COND_CLAUSES] and MATCH_ONEPATTERN_CONV_TRIV = MATCH_ONEPATTERN_CONV THENC GEN_REWRITE_CONV I [pth_5] and MATCH_ONEPATTERN_CONV_GEN = MATCH_ONEPATTERN_CONV THENC GEN_REWRITE_CONV TRY_CONV [pth_0; pth_5] in do_list extend_basic_convs ["MATCH_SEQPATTERN_CONV", (`_MATCH x (_SEQPATTERN r s)`,MATCH_SEQPATTERN_CONV_TRIV); "FUN_SEQPATTERN_CONV", (`_FUNCTION (_SEQPATTERN r s) x`,MATCH_SEQPATTERN_CONV_TRIV); "MATCH_ONEPATTERN_CONV", (`_MATCH x (\y z. P y z)`,MATCH_ONEPATTERN_CONV_TRIV); "FUN_ONEPATTERN_CONV", (`_FUNCTION (\y z. P y z) x`,MATCH_ONEPATTERN_CONV_TRIV)]; (CHANGED_CONV UNWIND_CONV, (MATCH_SEQPATTERN_CONV_GEN ORELSEC MATCH_ONEPATTERN_CONV_GEN));; let FORALL_UNWIND_CONV = let PUSH_FORALL_CONV = let econv = REWR_CONV SWAP_FORALL_THM in let rec conv bc tm = try (econv THENC BINDER_CONV(conv bc)) tm with Failure _ -> bc tm in conv in let baseconv = GEN_REWRITE_CONV I [MESON[] `(!x. x = a /\ p x ==> q x) <=> (p a ==> q a)`; MESON[] `(!x. a = x /\ p x ==> q x) <=> (p a ==> q a)`; MESON[] `(!x. x = a ==> q x) <=> q a`; MESON[] `(!x. a = x ==> q x) <=> q a`] in let rec FORALL_UNWIND_CONV tm = try let avs,bod = strip_forall tm in let ant,con = dest_imp bod in let eqs = conjuncts ant in let eq = find (fun tm -> is_eq tm & let l,r = dest_eq tm in (mem l avs && not (free_in l r)) || (mem r avs && not (free_in r l))) eqs in let l,r = dest_eq eq in let v = if mem l avs && not (free_in l r) then l else r in let cjs' = eq::(subtract eqs [eq]) in let n = length avs - (1 + index v (rev avs)) in let th1 = CONJ_ACI_RULE(mk_eq(ant,list_mk_conj cjs')) in let th2 = AP_THM (AP_TERM (rator(rator bod)) th1) con in let th3 = itlist MK_FORALL avs th2 in let th4 = funpow n BINDER_CONV (PUSH_FORALL_CONV baseconv) (rand(concl th3)) in CONV_RULE (RAND_CONV FORALL_UNWIND_CONV) (TRANS th3 th4) with Failure _ -> REFL tm in FORALL_UNWIND_CONV;; hol-light/int.ml000066400000000000000000001752231303454263000141030ustar00rootroot00000000000000(* ========================================================================= *) (* Theory of integers. *) (* *) (* The integers are carved out of the real numbers; hence all the *) (* universal theorems can be derived trivially from the real analog. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "calc_rat.ml";; (* ------------------------------------------------------------------------- *) (* Representing predicate. The "is_int" variant is useful for backwards *) (* compatibility with former definition of "is_int" constant, now removed. *) (* ------------------------------------------------------------------------- *) let integer = new_definition `integer(x) <=> ?n. abs(x) = &n`;; let is_int = prove (`integer(x) <=> ?n. x = &n \/ x = -- &n`, REWRITE_TAC[integer] THEN AP_TERM_TAC THEN ABS_TAC THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Type of integers. *) (* ------------------------------------------------------------------------- *) let int_tybij = new_type_definition "int" ("int_of_real","real_of_int") (prove(`?x. integer x`, EXISTS_TAC `&0` THEN REWRITE_TAC[is_int; REAL_OF_NUM_EQ; EXISTS_OR_THM; GSYM EXISTS_REFL]));; let int_abstr,int_rep = SPEC_ALL(CONJUNCT1 int_tybij),SPEC_ALL(CONJUNCT2 int_tybij);; let dest_int_rep = prove (`!i. ?n. (real_of_int i = &n) \/ (real_of_int i = --(&n))`, REWRITE_TAC[GSYM is_int; int_rep; int_abstr]);; let INTEGER_REAL_OF_INT = prove (`!x. integer(real_of_int x)`, MESON_TAC[int_tybij]);; (* ------------------------------------------------------------------------- *) (* We want the following too. *) (* ------------------------------------------------------------------------- *) let int_eq = prove (`!x y. (x = y) <=> (real_of_int x = real_of_int y)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o AP_TERM `int_of_real`) THEN REWRITE_TAC[int_abstr]);; (* ------------------------------------------------------------------------- *) (* Set up interface map. *) (* ------------------------------------------------------------------------- *) do_list overload_interface ["+",`int_add:int->int->int`; "-",`int_sub:int->int->int`; "*",`int_mul:int->int->int`; "<",`int_lt:int->int->bool`; "<=",`int_le:int->int->bool`; ">",`int_gt:int->int->bool`; ">=",`int_ge:int->int->bool`; "--",`int_neg:int->int`; "pow",`int_pow:int->num->int`; "abs",`int_abs:int->int`; "max",`int_max:int->int->int`; "min",`int_min:int->int->int`; "&",`int_of_num:num->int`];; let prioritize_int() = prioritize_overload(mk_type("int",[]));; (* ------------------------------------------------------------------------- *) (* Definitions and closure derivations of all operations but "inv" and "/". *) (* ------------------------------------------------------------------------- *) let int_le = new_definition `x <= y <=> (real_of_int x) <= (real_of_int y)`;; let int_lt = new_definition `x < y <=> (real_of_int x) < (real_of_int y)`;; let int_ge = new_definition `x >= y <=> (real_of_int x) >= (real_of_int y)`;; let int_gt = new_definition `x > y <=> (real_of_int x) > (real_of_int y)`;; let int_of_num = new_definition `&n = int_of_real(real_of_num n)`;; let int_of_num_th = prove (`!n. real_of_int(int_of_num n) = real_of_num n`, REWRITE_TAC[int_of_num; GSYM int_rep; is_int] THEN REWRITE_TAC[REAL_OF_NUM_EQ; EXISTS_OR_THM; GSYM EXISTS_REFL]);; let int_neg = new_definition `--i = int_of_real(--(real_of_int i))`;; let int_neg_th = prove (`!x. real_of_int(int_neg x) = --(real_of_int x)`, REWRITE_TAC[int_neg; GSYM int_rep; is_int] THEN GEN_TAC THEN STRIP_ASSUME_TAC(SPEC `x:int` dest_int_rep) THEN ASM_REWRITE_TAC[REAL_NEG_NEG; EXISTS_OR_THM; REAL_EQ_NEG2; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; let int_add = new_definition `x + y = int_of_real((real_of_int x) + (real_of_int y))`;; let int_add_th = prove (`!x y. real_of_int(x + y) = (real_of_int x) + (real_of_int y)`, REWRITE_TAC[int_add; GSYM int_rep; is_int] THEN REPEAT GEN_TAC THEN X_CHOOSE_THEN `m:num` DISJ_CASES_TAC (SPEC `x:int` dest_int_rep) THEN X_CHOOSE_THEN `n:num` DISJ_CASES_TAC (SPEC `y:int` dest_int_rep) THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; EXISTS_OR_THM] THEN REWRITE_TAC[GSYM EXISTS_REFL] THEN DISJ_CASES_THEN MP_TAC (SPECL [`m:num`; `n:num`] LE_CASES) THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; OR_EXISTS_THM; REAL_NEG_ADD] THEN TRY(EXISTS_TAC `d:num` THEN REAL_ARITH_TAC) THEN REWRITE_TAC[EXISTS_OR_THM; GSYM REAL_NEG_ADD; REAL_EQ_NEG2; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; let int_sub = new_definition `x - y = int_of_real(real_of_int x - real_of_int y)`;; let int_sub_th = prove (`!x y. real_of_int(x - y) = (real_of_int x) - (real_of_int y)`, REWRITE_TAC[int_sub; real_sub; GSYM int_neg_th; GSYM int_add_th] THEN REWRITE_TAC[int_abstr]);; let int_mul = new_definition `x * y = int_of_real ((real_of_int x) * (real_of_int y))`;; let int_mul_th = prove (`!x y. real_of_int(x * y) = (real_of_int x) * (real_of_int y)`, REPEAT GEN_TAC THEN REWRITE_TAC[int_mul; GSYM int_rep; is_int] THEN X_CHOOSE_THEN `m:num` DISJ_CASES_TAC (SPEC `x:int` dest_int_rep) THEN X_CHOOSE_THEN `n:num` DISJ_CASES_TAC (SPEC `y:int` dest_int_rep) THEN ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; EXISTS_OR_THM] THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG; REAL_OF_NUM_MUL] THEN REWRITE_TAC[REAL_EQ_NEG2; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; let int_abs = new_definition `abs x = int_of_real(abs(real_of_int x))`;; let int_abs_th = prove (`!x. real_of_int(abs x) = abs(real_of_int x)`, GEN_TAC THEN REWRITE_TAC[int_abs; real_abs] THEN COND_CASES_TAC THEN REWRITE_TAC[GSYM int_neg; int_neg_th; int_abstr]);; let int_sgn = new_definition `int_sgn x = int_of_real(real_sgn(real_of_int x))`;; let int_sgn_th = prove (`!x. real_of_int(int_sgn x) = real_sgn(real_of_int x)`, GEN_TAC THEN REWRITE_TAC[int_sgn; real_sgn; GSYM int_rep] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN MESON_TAC[is_int]);; let int_max = new_definition `int_max x y = int_of_real(max (real_of_int x) (real_of_int y))`;; let int_max_th = prove (`!x y. real_of_int(max x y) = max (real_of_int x) (real_of_int y)`, REPEAT GEN_TAC THEN REWRITE_TAC[int_max; real_max] THEN COND_CASES_TAC THEN REWRITE_TAC[int_abstr]);; let int_min = new_definition `int_min x y = int_of_real(min (real_of_int x) (real_of_int y))`;; let int_min_th = prove (`!x y. real_of_int(min x y) = min (real_of_int x) (real_of_int y)`, REPEAT GEN_TAC THEN REWRITE_TAC[int_min; real_min] THEN COND_CASES_TAC THEN REWRITE_TAC[int_abstr]);; let int_pow = new_definition `x pow n = int_of_real((real_of_int x) pow n)`;; let int_pow_th = prove (`!x n. real_of_int(x pow n) = (real_of_int x) pow n`, GEN_TAC THEN REWRITE_TAC[int_pow] THEN INDUCT_TAC THEN REWRITE_TAC[real_pow] THENL [REWRITE_TAC[GSYM int_of_num; int_of_num_th]; POP_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[GSYM int_mul; int_mul_th]]);; (* ------------------------------------------------------------------------- *) (* A couple of theorems peculiar to the integers. *) (* ------------------------------------------------------------------------- *) let INT_IMAGE = prove (`!x. (?n. x = &n) \/ (?n. x = --(&n))`, GEN_TAC THEN X_CHOOSE_THEN `n:num` DISJ_CASES_TAC (SPEC `x:int` dest_int_rep) THEN POP_ASSUM(MP_TAC o AP_TERM `int_of_real`) THEN REWRITE_TAC[int_abstr] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[int_of_num; int_neg] THENL [DISJ1_TAC; DISJ2_TAC] THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[int_abstr] THEN REWRITE_TAC[GSYM int_of_num; int_of_num_th]);; let INT_LT_DISCRETE = prove (`!x y. x < y <=> (x + &1) <= y`, REPEAT GEN_TAC THEN REWRITE_TAC[int_le; int_lt; int_add_th] THEN DISJ_CASES_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC ) (SPEC `x:int` INT_IMAGE) THEN DISJ_CASES_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC ) (SPEC `y:int` INT_IMAGE) THEN REWRITE_TAC[int_neg_th; int_of_num_th] THEN REWRITE_TAC[REAL_LE_NEG2; REAL_LT_NEG2] THEN REWRITE_TAC[REAL_LE_LNEG; REAL_LT_LNEG; REAL_LE_RNEG; REAL_LT_RNEG] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM real_sub; REAL_LE_SUB_RADD] THEN REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN REWRITE_TAC[GSYM ADD1; ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN REWRITE_TAC[SYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN REWRITE_TAC[ADD_CLAUSES; LE_SUC_LT; LT_SUC_LE]);; let INT_GT_DISCRETE = prove (`!x y. x > y <=> x >= (y + &1)`, REWRITE_TAC[int_gt; int_ge; real_ge; real_gt; GSYM int_le; GSYM int_lt] THEN MATCH_ACCEPT_TAC INT_LT_DISCRETE);; (* ------------------------------------------------------------------------- *) (* Conversions of integer constants to and from OCaml numbers. *) (* ------------------------------------------------------------------------- *) let is_intconst tm = match tm with Comb(Const("int_of_num",_),n) -> is_numeral n | Comb(Const("int_neg",_),Comb(Const("int_of_num",_),n)) -> is_numeral n && not(dest_numeral n = num_0) | _ -> false;; let dest_intconst tm = match tm with Comb(Const("int_of_num",_),n) -> dest_numeral n | Comb(Const("int_neg",_),Comb(Const("int_of_num",_),n)) -> let nn = dest_numeral n in if nn <>/ num_0 then minus_num(dest_numeral n) else failwith "dest_intconst" | _ -> failwith "dest_intconst";; let mk_intconst = let cast_tm = `int_of_num` and neg_tm = `int_neg` in let mk_numconst n = mk_comb(cast_tm,mk_numeral n) in fun x -> if x (!i:int. &0 <= i ==> P(i))`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THENL [DISJ_CASES_THEN (CHOOSE_THEN SUBST1_TAC) (SPEC `i:int` INT_IMAGE) THEN ASM_REWRITE_TAC[INT_LE_RNEG; INT_ADD_LID; INT_OF_NUM_LE; LE] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[INT_NEG_0]; FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[INT_OF_NUM_LE; LE_0]]);; let INT_EXISTS_POS = prove (`!P. (?n. P(&n)) <=> (?i:int. &0 <= i /\ P(i))`, GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN REWRITE_TAC[NOT_EXISTS_THM; INT_FORALL_POS] THEN MESON_TAC[]);; let INT_FORALL_ABS = prove (`!P. (!n. P(&n)) <=> (!x:int. P(abs x))`, REWRITE_TAC[INT_FORALL_POS] THEN MESON_TAC[INT_ABS_POS; INT_ABS_REFL]);; let INT_EXISTS_ABS = prove (`!P. (?n. P(&n)) <=> (?x:int. P(abs x))`, GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN REWRITE_TAC[NOT_EXISTS_THM; INT_FORALL_ABS] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Sometimes handy in number-theoretic applications. *) (* ------------------------------------------------------------------------- *) let INT_ABS_MUL_1 = prove (`!x y. (abs(x * y) = &1) <=> (abs(x) = &1) /\ (abs(y) = &1)`, REPEAT GEN_TAC THEN REWRITE_TAC[INT_ABS_MUL] THEN MP_TAC(SPEC `y:int` INT_ABS_POS) THEN SPEC_TAC(`abs(y)`,`b:int`) THEN MP_TAC(SPEC `x:int` INT_ABS_POS) THEN SPEC_TAC(`abs(x)`,`a:int`) THEN REWRITE_TAC[GSYM INT_FORALL_POS; INT_OF_NUM_MUL; INT_OF_NUM_EQ; MULT_EQ_1]);; let INT_WOP = prove (`(?x. &0 <= x /\ P x) <=> (?x. &0 <= x /\ P x /\ !y. &0 <= y /\ P y ==> x <= y)`, ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x) <=> ~(!x. P x ==> ~Q x)`] THEN REWRITE_TAC[IMP_CONJ; GSYM INT_FORALL_POS; INT_OF_NUM_LE] THEN REWRITE_TAC[NOT_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[GSYM NOT_LE; CONTRAPOS_THM]);; (* ------------------------------------------------------------------------- *) (* A few "pseudo definitions". *) (* ------------------------------------------------------------------------- *) let INT_POW = prove (`(x pow 0 = &1) /\ (!n. x pow (SUC n) = x * x pow n)`, REWRITE_TAC(map INT_OF_REAL_THM (CONJUNCTS real_pow)));; let INT_ABS = prove (`!x. abs(x) = if &0 <= x then x else --x`, GEN_TAC THEN MP_TAC(INT_OF_REAL_THM(SPEC `x:real` real_abs)) THEN COND_CASES_TAC THEN REWRITE_TAC[int_eq]);; let INT_GE = prove (`!x y. x >= y <=> y <= x`, REWRITE_TAC[int_ge; int_le; real_ge]);; let INT_GT = prove (`!x y. x > y <=> y < x`, REWRITE_TAC[int_gt; int_lt; real_gt]);; let INT_LT = prove (`!x y. x < y <=> ~(y <= x)`, REWRITE_TAC[int_lt; int_le; real_lt]);; (* ------------------------------------------------------------------------- *) (* Now a decision procedure for the integers. *) (* ------------------------------------------------------------------------- *) let INT_ARITH = let atom_CONV = let pth = prove (`(~(x <= y) <=> y + &1 <= x) /\ (~(x < y) <=> y <= x) /\ (~(x = y) <=> x + &1 <= y \/ y + &1 <= x) /\ (x < y <=> x + &1 <= y)`, REWRITE_TAC[INT_NOT_LE; INT_NOT_LT; INT_NOT_EQ; INT_LT_DISCRETE]) in GEN_REWRITE_CONV I [pth] and bub_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV [int_eq; int_le; int_lt; int_ge; int_gt; int_of_num_th; int_neg_th; int_add_th; int_mul_th; int_sub_th; int_pow_th; int_abs_th; int_max_th; int_min_th] in let base_CONV = TRY_CONV atom_CONV THENC bub_CONV in let NNF_NORM_CONV = GEN_NNF_CONV false (base_CONV,fun t -> base_CONV t,base_CONV(mk_neg t)) in let init_CONV = TOP_DEPTH_CONV BETA_CONV THENC PRESIMP_CONV THENC GEN_REWRITE_CONV DEPTH_CONV [INT_GT; INT_GE] THENC NNF_CONV THENC DEPTH_BINOP_CONV `(\/)` CONDS_ELIM_CONV THENC NNF_NORM_CONV in let p_tm = `p:bool` and not_tm = `(~)` in let pth = TAUT(mk_eq(mk_neg(mk_neg p_tm),p_tm)) in fun tm -> let th0 = INST [tm,p_tm] pth and th1 = init_CONV (mk_neg tm) in let th2 = REAL_ARITH(mk_neg(rand(concl th1))) in EQ_MP th0 (EQ_MP (AP_TERM not_tm (SYM th1)) th2);; let INT_ARITH_TAC = CONV_TAC(EQT_INTRO o INT_ARITH);; let ASM_INT_ARITH_TAC = REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN INT_ARITH_TAC;; (* ------------------------------------------------------------------------- *) (* Some pseudo-definitions. *) (* ------------------------------------------------------------------------- *) let INT_SUB = INT_ARITH `!x y. x - y = x + --y`;; let INT_MAX = INT_ARITH `!x y. max x y = if x <= y then y else x`;; let INT_MIN = INT_ARITH `!x y. min x y = if x <= y then x else y`;; (* ------------------------------------------------------------------------- *) (* Additional useful lemmas. *) (* ------------------------------------------------------------------------- *) let INT_OF_NUM_EXISTS = prove (`!x:int. (?n. x = &n) <=> &0 <= x`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[INT_POS] THEN MP_TAC(ISPEC `x:int` INT_IMAGE) THEN REWRITE_TAC[OR_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_INT_ARITH_TAC);; let INT_LE_DISCRETE = INT_ARITH `!x y:int. x <= y <=> x < y + &1`;; let INT_LE_TRANS_LE = prove (`!x y:int. x <= y <=> (!z. y <= z ==> x <= z)`, MESON_TAC[INT_LE_TRANS; INT_LE_REFL]);; let INT_LE_TRANS_LT = prove (`!x y:int. x <= y <=> (!z. y < z ==> x < z)`, REPEAT GEN_TAC THEN EQ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `y + &1:int`) THEN INT_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Archimedian property for the integers. *) (* ------------------------------------------------------------------------- *) let INT_ARCH = prove (`!x d. ~(d = &0) ==> ?c. x < c * d`, SUBGOAL_THEN `!x. &0 <= x ==> ?n. x <= &n` ASSUME_TAC THENL [REWRITE_TAC[GSYM INT_FORALL_POS; INT_OF_NUM_LE] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `!x. ?n. x <= &n` ASSUME_TAC THENL [ASM_MESON_TAC[INT_LE_TOTAL]; ALL_TAC] THEN SUBGOAL_THEN `!x d. &0 < d ==> ?c. x < c * d` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[INT_LT_DISCRETE; INT_ADD_LID] THEN ASM_MESON_TAC[INT_POS; INT_LE_LMUL; INT_ARITH `x + &1 <= &n /\ &n * &1 <= &n * d ==> x + &1 <= &n * d`]; ALL_TAC] THEN SUBGOAL_THEN `!x d. ~(d = &0) ==> ?c. x < c * d` ASSUME_TAC THENL [ASM_MESON_TAC[INT_ARITH `--x * y = x * --y`; INT_ARITH `~(d = &0) ==> &0 < d \/ &0 < --d`]; ALL_TAC] THEN ASM_MESON_TAC[INT_ARITH `--x * y = x * --y`; INT_ARITH `~(d = &0) ==> &0 < d \/ &0 < --d`]);; (* ------------------------------------------------------------------------- *) (* Definitions of ("Euclidean") integer division and remainder. *) (* ------------------------------------------------------------------------- *) let INT_DIVMOD_EXIST_0 = prove (`!m n:int. ?q r. if n = &0 then q = &0 /\ r = m else &0 <= r /\ r < abs(n) /\ m = q * n + r`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN SUBGOAL_THEN `?r. &0 <= r /\ ?q:int. m = n * q + r` MP_TAC THENL [FIRST_ASSUM(MP_TAC o SPEC `--m:int` o MATCH_MP INT_ARCH) THEN DISCH_THEN(X_CHOOSE_TAC `s:int`) THEN EXISTS_TAC `m + s * n:int` THEN CONJ_TAC THENL [ASM_INT_ARITH_TAC; EXISTS_TAC `--s:int` THEN INT_ARITH_TAC]; GEN_REWRITE_TAC LAND_CONV [INT_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:int` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:int` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `r - abs n`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `if &0 <= n then q + &1 else q - &1`) THEN ASM_INT_ARITH_TAC]);; parse_as_infix("div",(22,"left"));; parse_as_infix("rem",(22,"left"));; let INT_DIVISION_0 = new_specification ["div"; "rem"] (REWRITE_RULE[SKOLEM_THM] INT_DIVMOD_EXIST_0);; let INT_DIVISION = prove (`!m n. ~(n = &0) ==> m = m div n * n + m rem n /\ &0 <= m rem n /\ m rem n < abs n`, MESON_TAC[INT_DIVISION_0]);; (* ------------------------------------------------------------------------- *) (* Arithmetic operations on integers. Essentially a clone of stuff for reals *) (* in the file "calc_int.ml", except for div and rem, which are more like N. *) (* ------------------------------------------------------------------------- *) let INT_LE_CONV,INT_LT_CONV,INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV = let tth = TAUT `(F /\ F <=> F) /\ (F /\ T <=> F) /\ (T /\ F <=> F) /\ (T /\ T <=> T)` in let nth = TAUT `(~T <=> F) /\ (~F <=> T)` in let NUM2_EQ_CONV = BINOP_CONV NUM_EQ_CONV THENC GEN_REWRITE_CONV I [tth] in let NUM2_NE_CONV = RAND_CONV NUM2_EQ_CONV THENC GEN_REWRITE_CONV I [nth] in let [pth_le1; pth_le2a; pth_le2b; pth_le3] = (CONJUNCTS o prove) (`(--(&m) <= &n <=> T) /\ (&m <= &n <=> m <= n) /\ (--(&m) <= --(&n) <=> n <= m) /\ (&m <= --(&n) <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[INT_LE_NEG2] THEN REWRITE_TAC[INT_LE_LNEG; INT_LE_RNEG] THEN REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE; LE_0] THEN REWRITE_TAC[LE; ADD_EQ_0]) in let INT_LE_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_le1]; GEN_REWRITE_CONV I [pth_le2a; pth_le2b] THENC NUM_LE_CONV; GEN_REWRITE_CONV I [pth_le3] THENC NUM2_EQ_CONV] in let [pth_lt1; pth_lt2a; pth_lt2b; pth_lt3] = (CONJUNCTS o prove) (`(&m < --(&n) <=> F) /\ (&m < &n <=> m < n) /\ (--(&m) < --(&n) <=> n < m) /\ (--(&m) < &n <=> ~((m = 0) /\ (n = 0)))`, REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; GSYM NOT_LE; INT_LT] THEN CONV_TAC TAUT) in let INT_LT_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_lt1]; GEN_REWRITE_CONV I [pth_lt2a; pth_lt2b] THENC NUM_LT_CONV; GEN_REWRITE_CONV I [pth_lt3] THENC NUM2_NE_CONV] in let [pth_ge1; pth_ge2a; pth_ge2b; pth_ge3] = (CONJUNCTS o prove) (`(&m >= --(&n) <=> T) /\ (&m >= &n <=> n <= m) /\ (--(&m) >= --(&n) <=> m <= n) /\ (--(&m) >= &n <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; INT_GE] THEN CONV_TAC TAUT) in let INT_GE_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_ge1]; GEN_REWRITE_CONV I [pth_ge2a; pth_ge2b] THENC NUM_LE_CONV; GEN_REWRITE_CONV I [pth_ge3] THENC NUM2_EQ_CONV] in let [pth_gt1; pth_gt2a; pth_gt2b; pth_gt3] = (CONJUNCTS o prove) (`(--(&m) > &n <=> F) /\ (&m > &n <=> n < m) /\ (--(&m) > --(&n) <=> m < n) /\ (&m > --(&n) <=> ~((m = 0) /\ (n = 0)))`, REWRITE_TAC[pth_lt1; pth_lt2a; pth_lt2b; pth_lt3; INT_GT] THEN CONV_TAC TAUT) in let INT_GT_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_gt1]; GEN_REWRITE_CONV I [pth_gt2a; pth_gt2b] THENC NUM_LT_CONV; GEN_REWRITE_CONV I [pth_gt3] THENC NUM2_NE_CONV] in let [pth_eq1a; pth_eq1b; pth_eq2a; pth_eq2b] = (CONJUNCTS o prove) (`((&m = &n) <=> (m = n)) /\ ((--(&m) = --(&n)) <=> (m = n)) /\ ((--(&m) = &n) <=> (m = 0) /\ (n = 0)) /\ ((&m = --(&n)) <=> (m = 0) /\ (n = 0))`, REWRITE_TAC[GSYM INT_LE_ANTISYM; GSYM LE_ANTISYM] THEN REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; LE; LE_0] THEN CONV_TAC TAUT) in let INT_EQ_CONV = FIRST_CONV [GEN_REWRITE_CONV I [pth_eq1a; pth_eq1b] THENC NUM_EQ_CONV; GEN_REWRITE_CONV I [pth_eq2a; pth_eq2b] THENC NUM2_EQ_CONV] in INT_LE_CONV,INT_LT_CONV, INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV;; let INT_NEG_CONV = let pth = prove (`(--(&0) = &0) /\ (--(--(&x)) = &x)`, REWRITE_TAC[INT_NEG_NEG; INT_NEG_0]) in GEN_REWRITE_CONV I [pth];; let INT_MUL_CONV = let pth0 = prove (`(&0 * &x = &0) /\ (&0 * --(&x) = &0) /\ (&x * &0 = &0) /\ (--(&x) * &0 = &0)`, REWRITE_TAC[INT_MUL_LZERO; INT_MUL_RZERO]) and pth1,pth2 = (CONJ_PAIR o prove) (`((&m * &n = &(m * n)) /\ (--(&m) * --(&n) = &(m * n))) /\ ((--(&m) * &n = --(&(m * n))) /\ (&m * --(&n) = --(&(m * n))))`, REWRITE_TAC[INT_MUL_LNEG; INT_MUL_RNEG; INT_NEG_NEG] THEN REWRITE_TAC[INT_OF_NUM_MUL]) in FIRST_CONV [GEN_REWRITE_CONV I [pth0]; GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_MULT_CONV; GEN_REWRITE_CONV I [pth2] THENC RAND_CONV(RAND_CONV NUM_MULT_CONV)];; let INT_ADD_CONV = let neg_tm = `(--)` in let amp_tm = `&` in let add_tm = `(+)` in let dest = dest_binop `(+)` in let m_tm = `m:num` and n_tm = `n:num` in let pth0 = prove (`(--(&m) + &m = &0) /\ (&m + --(&m) = &0)`, REWRITE_TAC[INT_ADD_LINV; INT_ADD_RINV]) in let [pth1; pth2; pth3; pth4; pth5; pth6] = (CONJUNCTS o prove) (`(--(&m) + --(&n) = --(&(m + n))) /\ (--(&m) + &(m + n) = &n) /\ (--(&(m + n)) + &m = --(&n)) /\ (&(m + n) + --(&m) = &n) /\ (&m + --(&(m + n)) = --(&n)) /\ (&m + &n = &(m + n))`, REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_NEG_ADD] THEN REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID] THEN ONCE_REWRITE_TAC[INT_ADD_SYM] THEN REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID]) in GEN_REWRITE_CONV I [pth0] ORELSEC (fun tm -> try let l,r = dest tm in if rator l = neg_tm then if rator r = neg_tm then let th1 = INST [rand(rand l),m_tm; rand(rand r),n_tm] pth1 in let tm1 = rand(rand(rand(concl th1))) in let th2 = AP_TERM neg_tm (AP_TERM amp_tm (NUM_ADD_CONV tm1)) in TRANS th1 th2 else let m = rand(rand l) and n = rand r in let m' = dest_numeral m and n' = dest_numeral n in if m' <=/ n' then let p = mk_numeral (n' -/ m') in let th1 = INST [m,m_tm; p,n_tm] pth2 in let th2 = NUM_ADD_CONV (rand(rand(lhand(concl th1)))) in let th3 = AP_TERM (rator tm) (AP_TERM amp_tm (SYM th2)) in TRANS th3 th1 else let p = mk_numeral (m' -/ n') in let th1 = INST [n,m_tm; p,n_tm] pth3 in let th2 = NUM_ADD_CONV (rand(rand(lhand(lhand(concl th1))))) in let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_THM (AP_TERM add_tm th3) (rand tm) in TRANS th4 th1 else if rator r = neg_tm then let m = rand l and n = rand(rand r) in let m' = dest_numeral m and n' = dest_numeral n in if n' <=/ m' then let p = mk_numeral (m' -/ n') in let th1 = INST [n,m_tm; p,n_tm] pth4 in let th2 = NUM_ADD_CONV (rand(lhand(lhand(concl th1)))) in let th3 = AP_TERM add_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_THM th3 (rand tm) in TRANS th4 th1 else let p = mk_numeral (n' -/ m') in let th1 = INST [m,m_tm; p,n_tm] pth5 in let th2 = NUM_ADD_CONV (rand(rand(rand(lhand(concl th1))))) in let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in let th4 = AP_TERM (rator tm) th3 in TRANS th4 th1 else let th1 = INST [rand l,m_tm; rand r,n_tm] pth6 in let tm1 = rand(rand(concl th1)) in let th2 = AP_TERM amp_tm (NUM_ADD_CONV tm1) in TRANS th1 th2 with Failure _ -> failwith "INT_ADD_CONV");; let INT_SUB_CONV = GEN_REWRITE_CONV I [INT_SUB] THENC TRY_CONV(RAND_CONV INT_NEG_CONV) THENC INT_ADD_CONV;; let INT_POW_CONV = let pth1,pth2 = (CONJ_PAIR o prove) (`(&x pow n = &(x EXP n)) /\ ((--(&x)) pow n = if EVEN n then &(x EXP n) else --(&(x EXP n)))`, REWRITE_TAC[INT_OF_NUM_POW; INT_POW_NEG]) in let tth = prove (`((if T then x:int else y) = x) /\ ((if F then x:int else y) = y)`, REWRITE_TAC[]) in let neg_tm = `(--)` in (GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_EXP_CONV) ORELSEC (GEN_REWRITE_CONV I [pth2] THENC RATOR_CONV(RATOR_CONV(RAND_CONV NUM_EVEN_CONV)) THENC GEN_REWRITE_CONV I [tth] THENC (fun tm -> if rator tm = neg_tm then RAND_CONV(RAND_CONV NUM_EXP_CONV) tm else RAND_CONV NUM_EXP_CONV tm));; let INT_ABS_CONV = let pth = prove (`(abs(--(&x)) = &x) /\ (abs(&x) = &x)`, REWRITE_TAC[INT_ABS_NEG; INT_ABS_NUM]) in GEN_REWRITE_CONV I [pth];; let INT_MAX_CONV = REWR_CONV INT_MAX THENC RATOR_CONV(RATOR_CONV(RAND_CONV INT_LE_CONV)) THENC GEN_REWRITE_CONV I [COND_CLAUSES];; let INT_MIN_CONV = REWR_CONV INT_MIN THENC RATOR_CONV(RATOR_CONV(RAND_CONV INT_LE_CONV)) THENC GEN_REWRITE_CONV I [COND_CLAUSES];; (* ------------------------------------------------------------------------- *) (* Instantiate the normalizer. *) (* ------------------------------------------------------------------------- *) let INT_POLY_CONV = let sth = prove (`(!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. &0 + x = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x y. x * y = y * x) /\ (!x. &1 * x = x) /\ (!x. &0 * x = &0) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x. x pow 0 = &1) /\ (!x n. x pow (SUC n) = x * x pow n)`, REWRITE_TAC[INT_POW] THEN INT_ARITH_TAC) and rth = prove (`(!x. --x = --(&1) * x) /\ (!x y. x - y = x + --(&1) * y)`, INT_ARITH_TAC) and is_semiring_constant = is_intconst and SEMIRING_ADD_CONV = INT_ADD_CONV and SEMIRING_MUL_CONV = INT_MUL_CONV and SEMIRING_POW_CONV = INT_POW_CONV in let _,_,_,_,_,INT_POLY_CONV = SEMIRING_NORMALIZERS_CONV sth rth (is_semiring_constant, SEMIRING_ADD_CONV,SEMIRING_MUL_CONV,SEMIRING_POW_CONV) (<) in INT_POLY_CONV;; (* ------------------------------------------------------------------------- *) (* Instantiate the ring and ideal procedures. *) (* ------------------------------------------------------------------------- *) let INT_RING,int_ideal_cofactors = let INT_INTEGRAL = prove (`(!x. &0 * x = &0) /\ (!x y z. (x + y = x + z) <=> (y = z)) /\ (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN ONCE_REWRITE_TAC[GSYM INT_SUB_0] THEN REWRITE_TAC[GSYM INT_ENTIRE] THEN INT_ARITH_TAC) and int_ty = `:int` in let pure,ideal = RING_AND_IDEAL_CONV (dest_intconst,mk_intconst,INT_EQ_CONV, `(--):int->int`,`(+):int->int->int`,`(-):int->int->int`, genvar bool_ty,`(*):int->int->int`,genvar bool_ty, `(pow):int->num->int`, INT_INTEGRAL,TRUTH,INT_POLY_CONV) in pure, (fun tms tm -> if forall (fun t -> type_of t = int_ty) (tm::tms) then ideal tms tm else failwith "int_ideal_cofactors: not all terms have type :int");; (* ------------------------------------------------------------------------- *) (* Arithmetic operations also on div and rem, hence the whole lot. *) (* ------------------------------------------------------------------------- *) let INT_DIVMOD_UNIQ = prove (`!m n q r:int. m = q * n + r /\ &0 <= r /\ r < abs n ==> m div n = q /\ m rem n = r`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(n = &0)` MP_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(STRIP_ASSUME_TAC o SPEC `m:int` o MATCH_MP INT_DIVISION) THEN ASM_CASES_TAC `m div n = q` THENL [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC INT_RING; ALL_TAC] THEN SUBGOAL_THEN `abs(m rem n - r) < abs n` MP_TAC THENL [ASM_INT_ARITH_TAC; MATCH_MP_TAC(TAUT `~p ==> p ==> q`)] THEN MATCH_MP_TAC(INT_ARITH `&1 * abs n <= abs(q - m div n) * abs n /\ abs(m rem n - r) = abs((q - m div n) * n) ==> ~(abs(m rem n - r) < abs n)`) THEN CONJ_TAC THENL [MATCH_MP_TAC INT_LE_RMUL THEN ASM_INT_ARITH_TAC; AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC INT_RING]);; let INT_DIV_CONV,INT_REM_CONV = let pth = prove (`q * n + r = m ==> &0 <= r ==> r < abs n ==> m div n = q /\ m rem n = r`, MESON_TAC[INT_DIVMOD_UNIQ]) and m = `m:int` and n = `n:int` and q = `q:int` and r = `r:int` and dtm = `(div)` and mtm = `(rem)` in let emod_num x y = let r = mod_num x y in if r try let l,r = dest_binop dtm tm in CONJUNCT1(INT_DIVMOD_CONV (dest_intconst l) (dest_intconst r)) with Failure _ -> failwith "INT_DIV_CONV"), (fun tm -> try let l,r = dest_binop mtm tm in CONJUNCT2(INT_DIVMOD_CONV (dest_intconst l) (dest_intconst r)) with Failure _ -> failwith "INT_MOD_CONV");; let INT_RED_CONV = let gconv_net = itlist (uncurry net_of_conv) [`x <= y`,INT_LE_CONV; `x < y`,INT_LT_CONV; `x >= y`,INT_GE_CONV; `x > y`,INT_GT_CONV; `x:int = y`,INT_EQ_CONV; `--x`,CHANGED_CONV INT_NEG_CONV; `abs(x)`,INT_ABS_CONV; `x + y`,INT_ADD_CONV; `x - y`,INT_SUB_CONV; `x * y`,INT_MUL_CONV; `x div y`,INT_DIV_CONV; `x rem y`,INT_REM_CONV; `x pow n`,INT_POW_CONV; `max x y`,INT_MAX_CONV; `min x y`,INT_MIN_CONV] (basic_net()) in REWRITES_CONV gconv_net;; let INT_REDUCE_CONV = DEPTH_CONV INT_RED_CONV;; (* ------------------------------------------------------------------------- *) (* Set up overloading so we can use same symbols for N, Z and even R. *) (* ------------------------------------------------------------------------- *) make_overloadable "divides" `:A->A->bool`;; make_overloadable "mod" `:A->A->A->bool`;; make_overloadable "coprime" `:A#A->bool`;; make_overloadable "gcd" `:A#A->A`;; (* ------------------------------------------------------------------------- *) (* The general notion of congruence: just syntax for equivalence relation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("==",(10,"right"));; let cong = new_definition `(x == y) (rel:A->A->bool) <=> rel x y`;; (* ------------------------------------------------------------------------- *) (* Get real moduli defined and out of the way first. *) (* ------------------------------------------------------------------------- *) let real_mod = new_definition `real_mod n (x:real) y = ?q. integer q /\ x - y = q * n`;; overload_interface ("mod",`real_mod`);; (* ------------------------------------------------------------------------- *) (* Integer divisibility. *) (* ------------------------------------------------------------------------- *) parse_as_infix("divides",(12,"right"));; overload_interface("divides",`int_divides:int->int->bool`);; let int_divides = new_definition `a divides b <=> ?x. b = a * x`;; (* ------------------------------------------------------------------------- *) (* Integer congruences. *) (* ------------------------------------------------------------------------- *) parse_as_prefix "mod";; overload_interface ("mod",`int_mod:int->int->int->bool`);; let int_mod = new_definition `(mod n) x y = n divides (x - y)`;; let int_congruent = prove (`!x y n. (x == y) (mod n) <=> ?d. x - y = n * d`, REWRITE_TAC[int_mod; cong; int_divides]);; (* ------------------------------------------------------------------------- *) (* Integer coprimality. *) (* ------------------------------------------------------------------------- *) overload_interface("coprime",`int_coprime:int#int->bool`);; let int_coprime = new_definition `!a b. coprime(a,b) <=> ?x y. a * x + b * y = &1`;; (* ------------------------------------------------------------------------- *) (* A tactic for simple divisibility/congruence/coprimality goals. *) (* ------------------------------------------------------------------------- *) let INTEGER_TAC = let int_ty = `:int` in let INT_POLYEQ_CONV = GEN_REWRITE_CONV I [GSYM INT_SUB_0] THENC LAND_CONV INT_POLY_CONV in let ISOLATE_VARIABLE = let pth = INT_ARITH `!a x. a = &0 <=> x = x + a` in let is_defined v t = let mons = striplist(dest_binary "int_add") t in mem v mons && forall (fun m -> v = m || not(free_in v m)) mons in fun vars tm -> let th = INT_POLYEQ_CONV tm and th' = (SYM_CONV THENC INT_POLYEQ_CONV) tm in let v,th1 = try find (fun v -> is_defined v (lhand(rand(concl th)))) vars,th' with Failure _ -> find (fun v -> is_defined v (lhand(rand(concl th')))) vars,th in let th2 = TRANS th1 (SPECL [lhs(rand(concl th1)); v] pth) in CONV_RULE(RAND_CONV(RAND_CONV INT_POLY_CONV)) th2 in let UNWIND_POLYS_CONV tm = let vars,bod = strip_exists tm in let cjs = conjuncts bod in let th1 = tryfind (ISOLATE_VARIABLE vars) cjs in let eq = lhand(concl th1) in let bod' = list_mk_conj(eq::(subtract cjs [eq])) in let th2 = CONJ_ACI_RULE(mk_eq(bod,bod')) in let th3 = TRANS th2 (MK_CONJ th1 (REFL(rand(rand(concl th2))))) in let v = lhs(lhand(rand(concl th3))) in let vars' = (subtract vars [v]) @ [v] in let th4 = CONV_RULE(RAND_CONV(REWR_CONV UNWIND_THM2)) (MK_EXISTS v th3) in let IMP_RULE v v' = DISCH_ALL(itlist SIMPLE_CHOOSE v (itlist SIMPLE_EXISTS v' (ASSUME bod))) in let th5 = IMP_ANTISYM_RULE (IMP_RULE vars vars') (IMP_RULE vars' vars) in TRANS th5 (itlist MK_EXISTS (subtract vars [v]) th4) in let zero_tm = `&0` and one_tm = `&1` in let isolate_monomials = let mul_tm = `(int_mul)` and add_tm = `(int_add)` and neg_tm = `(int_neg)` in let dest_mul = dest_binop mul_tm and dest_add = dest_binop add_tm and mk_mul = mk_binop mul_tm and mk_add = mk_binop add_tm in let scrub_var v m = let ps = striplist dest_mul m in let ps' = subtract ps [v] in if ps' = [] then one_tm else end_itlist mk_mul ps' in let find_multipliers v mons = let mons1 = filter (fun m -> free_in v m) mons in let mons2 = map (scrub_var v) mons1 in if mons2 = [] then zero_tm else end_itlist mk_add mons2 in fun vars tm -> let cmons,vmons = partition (fun m -> intersect (frees m) vars = []) (striplist dest_add tm) in let cofactors = map (fun v -> find_multipliers v vmons) vars and cnc = if cmons = [] then zero_tm else mk_comb(neg_tm,end_itlist mk_add cmons) in cofactors,cnc in let isolate_variables evs ps eq = let vars = filter (fun v -> vfree_in v eq) evs in let qs,p = isolate_monomials vars eq in let rs = filter (fun t -> type_of t = int_ty) (qs @ ps) in let rs = int_ideal_cofactors rs p in eq,zip (fst(chop_list(length qs) rs)) vars in let subst_in_poly i p = rhs(concl(INT_POLY_CONV (vsubst i p))) in let rec solve_idealism evs ps eqs = if evs = [] then [] else let eq,cfs = tryfind (isolate_variables evs ps) eqs in let evs' = subtract evs (map snd cfs) and eqs' = map (subst_in_poly cfs) (subtract eqs [eq]) in cfs @ solve_idealism evs' ps eqs' in let rec GENVAR_EXISTS_CONV tm = if not(is_exists tm) then REFL tm else let ev,bod = dest_exists tm in let gv = genvar(type_of ev) in (GEN_ALPHA_CONV gv THENC BINDER_CONV GENVAR_EXISTS_CONV) tm in let EXISTS_POLY_TAC (asl,w as gl) = let evs,bod = strip_exists w and ps = mapfilter (check (fun t -> type_of t = int_ty) o lhs o concl o snd) asl in let cfs = solve_idealism evs ps (map lhs (conjuncts bod)) in (MAP_EVERY EXISTS_TAC(map (fun v -> rev_assocd v cfs zero_tm) evs) THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC INT_RING) gl in let SCRUB_NEQ_TAC = MATCH_MP_TAC o MATCH_MP (MESON[] `~(x = y) ==> x = y \/ p ==> p`) in REWRITE_TAC[int_coprime; int_congruent; int_divides] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM] THEN CONV_TAC(REPEATC UNWIND_POLYS_CONV) THEN REPEAT(FIRST_X_ASSUM SCRUB_NEQ_TAC) THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM] THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC(ONCE_DEPTH_CONV INT_POLYEQ_CONV) THEN REWRITE_TAC[GSYM INT_ENTIRE; TAUT `a \/ (b /\ c) <=> (a \/ b) /\ (a \/ c)`] THEN POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT DISCH_TAC THEN CONV_TAC GENVAR_EXISTS_CONV THEN CONV_TAC(ONCE_DEPTH_CONV INT_POLYEQ_CONV) THEN EXISTS_POLY_TAC;; let INTEGER_RULE tm = prove(tm,INTEGER_TAC);; (* ------------------------------------------------------------------------- *) (* Existence of integer gcd, and the Bezout identity. *) (* ------------------------------------------------------------------------- *) let WF_INT_MEASURE = prove (`!P m. (!x. &0 <= m(x)) /\ (!x. (!y. m(y) < m(x) ==> P(y)) ==> P(x)) ==> !x:A. P(x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n x:A. m(x) = &n ==> P(x)` MP_TAC THENL [MATCH_MP_TAC num_WF; ALL_TAC] THEN REWRITE_TAC[GSYM INT_OF_NUM_LT; INT_FORALL_POS] THEN ASM_MESON_TAC[]);; let WF_INT_MEASURE_2 = prove (`!P m. (!x y. &0 <= m x y) /\ (!x y. (!x' y'. m x' y' < m x y ==> P x' y') ==> P x y) ==> !x:A y:B. P x y`, REWRITE_TAC[FORALL_UNCURRY; GSYM FORALL_PAIR_THM; WF_INT_MEASURE]);; let INT_GCD_EXISTS = prove (`!a b. ?d. d divides a /\ d divides b /\ ?x y. d = a * x + b * y`, let INT_GCD_EXISTS_CASES = INT_ARITH `(a = &0 \/ b = &0) \/ abs(a - b) + abs b < abs a + abs b \/ abs(a + b) + abs b < abs a + abs b \/ abs a + abs(b - a) < abs a + abs b \/ abs a + abs(b + a) < abs a + abs b` in MATCH_MP_TAC WF_INT_MEASURE_2 THEN EXISTS_TAC `\x y. abs(x) + abs(y)` THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN DISJ_CASES_THEN MP_TAC INT_GCD_EXISTS_CASES THENL [STRIP_TAC THEN ASM_REWRITE_TAC[INTEGER_RULE `d divides &0`] THEN REWRITE_TAC[INT_MUL_LZERO; INT_ADD_LID; INT_ADD_RID] THEN MESON_TAC[INTEGER_RULE `d divides d`; INT_MUL_RID]; DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (ANTE_RES_THEN MP_TAC)) THEN MATCH_MP_TAC MONO_EXISTS THEN INTEGER_TAC]);; let INT_GCD_EXISTS_POS = prove (`!a b. ?d. &0 <= d /\ d divides a /\ d divides b /\ ?x y. d = a * x + b * y`, REPEAT GEN_TAC THEN X_CHOOSE_TAC `d:int` (SPECL [`a:int`; `b:int`] INT_GCD_EXISTS) THEN DISJ_CASES_TAC(SPEC `d:int` INT_LE_NEGTOTAL) THEN ASM_MESON_TAC[INTEGER_RULE `(--d) divides x <=> d divides x`; INT_ARITH `a * --x + b * --y = --(a * x + b * y)`]);; (* ------------------------------------------------------------------------- *) (* Hence define (positive) gcd function; add elimination to INTEGER_TAC. *) (* ------------------------------------------------------------------------- *) overload_interface("gcd",`int_gcd:int#int->int`);; let int_gcd = new_specification ["int_gcd"] (REWRITE_RULE[EXISTS_UNCURRY; SKOLEM_THM] INT_GCD_EXISTS_POS);; let INTEGER_TAC = let GCD_ELIM_TAC = let gcd_tm = `gcd` in let dest_gcd tm = let l,r = dest_comb tm in if l = gcd_tm then dest_pair r else failwith "dest_gcd" in REPEAT GEN_TAC THEN W(fun (asl,w) -> let gts = find_terms (can dest_gcd) w in let ths = map (fun tm -> let a,b = dest_gcd tm in SPECL [a;b] int_gcd) gts in MAP_EVERY MP_TAC ths THEN MAP_EVERY SPEC_TAC (zip gts (map (genvar o type_of) gts))) in REPEAT(GEN_TAC ORELSE CONJ_TAC) THEN GCD_ELIM_TAC THEN INTEGER_TAC;; let INTEGER_RULE tm = prove(tm,INTEGER_TAC);; (* ------------------------------------------------------------------------- *) (* Mapping from nonnegative integers back to natural numbers. *) (* ------------------------------------------------------------------------- *) let num_of_int = new_definition `num_of_int x = @n. &n = x`;; let NUM_OF_INT_OF_NUM = prove (`!n. num_of_int(&n) = n`, REWRITE_TAC[num_of_int; INT_OF_NUM_EQ; SELECT_UNIQUE]);; let INT_OF_NUM_OF_INT = prove (`!x. &0 <= x ==> &(num_of_int x) = x`, REWRITE_TAC[GSYM INT_FORALL_POS; num_of_int] THEN GEN_TAC THEN CONV_TAC SELECT_CONV THEN MESON_TAC[]);; let NUM_OF_INT = prove (`!x. &0 <= x <=> (&(num_of_int x) = x)`, MESON_TAC[INT_OF_NUM_OF_INT; INT_POS]);; (* ------------------------------------------------------------------------- *) (* Now define similar notions over the natural numbers. *) (* ------------------------------------------------------------------------- *) overload_interface("divides",`num_divides:num->num->bool`);; overload_interface ("mod",`num_mod:num->num->num->bool`);; overload_interface("coprime",`num_coprime:num#num->bool`);; overload_interface("gcd",`num_gcd:num#num->num`);; let num_divides = new_definition `a divides b <=> &a divides &b`;; let num_mod = new_definition `(mod n) x y <=> (mod &n) (&x) (&y)`;; let num_congruent = prove (`!x y n. (x == y) (mod n) <=> (&x == &y) (mod &n)`, REWRITE_TAC[cong; num_mod]);; let num_coprime = new_definition `coprime(a,b) <=> coprime(&a,&b)`;; let num_gcd = new_definition `gcd(a,b) = num_of_int(gcd(&a,&b))`;; (* ------------------------------------------------------------------------- *) (* Map an assertion over N to an integer equivalent. *) (* To make this work nicely, all variables of type num should be quantified. *) (* ------------------------------------------------------------------------- *) let NUM_TO_INT_CONV = let pth_relativize = prove (`((!n. P(&n)) <=> (!i. ~(&0 <= i) \/ P i)) /\ ((?n. P(&n)) <=> (?i. &0 <= i /\ P i))`, REWRITE_TAC[INT_EXISTS_POS; INT_FORALL_POS] THEN MESON_TAC[]) in let relation_conv = (GEN_REWRITE_CONV TOP_SWEEP_CONV o map GSYM) [INT_OF_NUM_EQ; INT_OF_NUM_LE; INT_OF_NUM_LT; INT_OF_NUM_GE; INT_OF_NUM_GT; INT_OF_NUM_SUC; INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW] and quantifier_conv = GEN_REWRITE_CONV DEPTH_CONV [pth_relativize] in NUM_SIMPLIFY_CONV THENC relation_conv THENC quantifier_conv;; (* ------------------------------------------------------------------------- *) (* Linear decision procedure for the naturals at last! *) (* ------------------------------------------------------------------------- *) let ARITH_RULE = let init_conv = NUM_SIMPLIFY_CONV THENC GEN_REWRITE_CONV DEPTH_CONV [ADD1] THENC PROP_ATOM_CONV (BINOP_CONV NUM_NORMALIZE_CONV) THENC PRENEX_CONV THENC (GEN_REWRITE_CONV TOP_SWEEP_CONV o map GSYM) [INT_OF_NUM_EQ; INT_OF_NUM_LE; INT_OF_NUM_LT; INT_OF_NUM_GE; INT_OF_NUM_GT; INT_OF_NUM_ADD; SPEC `NUMERAL k` INT_OF_NUM_MUL; INT_OF_NUM_MAX; INT_OF_NUM_MIN] and is_numimage t = match t with Comb(Const("int_of_num",_),n) when not(is_numeral n) -> true | _ -> false in fun tm -> let th1 = init_conv tm in let tm1 = rand(concl th1) in let avs,bod = strip_forall tm1 in let nim = setify(find_terms is_numimage bod) in let gvs = map (genvar o type_of) nim in let pths = map (fun v -> SPEC (rand v) INT_POS) nim in let ibod = itlist (curry mk_imp o concl) pths bod in let gbod = subst (zip gvs nim) ibod in let th2 = INST (zip nim gvs) (INT_ARITH gbod) in let th3 = GENL avs (rev_itlist (C MP) pths th2) in EQ_MP (SYM th1) th3;; let ARITH_TAC = CONV_TAC(EQT_INTRO o ARITH_RULE);; let ASM_ARITH_TAC = REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN ARITH_TAC;; (* ------------------------------------------------------------------------- *) (* Also a similar divisibility procedure for natural numbers. *) (* ------------------------------------------------------------------------- *) let NUM_GCD = prove (`!a b. &(gcd(a,b)) = gcd(&a,&b)`, REWRITE_TAC[num_gcd; GSYM NUM_OF_INT; int_gcd]);; let NUMBER_TAC = let pth_relativize = prove (`((!n. P(&n)) <=> (!i. &0 <= i ==> P i)) /\ ((?n. P(&n)) <=> (?i. &0 <= i /\ P i))`, GEN_REWRITE_TAC RAND_CONV [TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN REWRITE_TAC[NOT_EXISTS_THM; INT_FORALL_POS] THEN MESON_TAC[]) in let relation_conv = GEN_REWRITE_CONV TOP_SWEEP_CONV (num_divides::num_congruent::num_coprime::NUM_GCD::(map GSYM [INT_OF_NUM_EQ; INT_OF_NUM_LE; INT_OF_NUM_LT; INT_OF_NUM_GE; INT_OF_NUM_GT; INT_OF_NUM_SUC; INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW])) and quantifier_conv = GEN_REWRITE_CONV DEPTH_CONV [pth_relativize] in W(fun (_,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN CONV_TAC(relation_conv THENC quantifier_conv) THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN INTEGER_TAC;; let NUMBER_RULE tm = prove(tm,NUMBER_TAC);; let divides = prove (`a divides b <=> ?x. b = a * x`, EQ_TAC THENL [REWRITE_TAC[num_divides; int_divides]; NUMBER_TAC] THEN DISCH_THEN(X_CHOOSE_TAC `x:int`) THEN EXISTS_TAC `num_of_int(abs x)` THEN SIMP_TAC[GSYM INT_OF_NUM_EQ; INT_ARITH `&m:int = &n <=> abs(&m :int) = abs(&n)`] THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_MUL; INT_ABS_MUL] THEN SIMP_TAC[INT_OF_NUM_OF_INT; INT_ABS_POS; INT_ABS_ABS]);; let DIVIDES_LE = prove (`!m n. m divides n ==> m <= n \/ n = 0`, SUBGOAL_THEN `!m n. m <= m * n \/ m * n = 0` (fun th -> MESON_TAC[divides; th]) THEN REWRITE_TAC[LE_MULT_LCANCEL; MULT_EQ_0; ARITH_RULE `m <= m * n <=> m * 1 <= m * n`] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Make sure we give priority to N. *) (* ------------------------------------------------------------------------- *) prioritize_num();; hol-light/itab.ml000066400000000000000000000075601303454263000142260ustar00rootroot00000000000000(* ========================================================================= *) (* Intuitionistic theorem prover (complete for propositional fragment). *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "tactics.ml";; (* ------------------------------------------------------------------------- *) (* Accept a theorem modulo unification. *) (* ------------------------------------------------------------------------- *) let UNIFY_ACCEPT_TAC mvs th (asl,w) = let insts = term_unify mvs (concl th) w in ([],insts),[], let th' = INSTANTIATE insts th in fun i [] -> INSTANTIATE i th';; (* ------------------------------------------------------------------------- *) (* The actual prover, as a tactic. *) (* ------------------------------------------------------------------------- *) let ITAUT_TAC = let CONJUNCTS_THEN' ttac cth = ttac(CONJUNCT1 cth) THEN ttac(CONJUNCT2 cth) in let IMPLICATE t = let th1 = AP_THM NOT_DEF (dest_neg t) in CONV_RULE (RAND_CONV BETA_CONV) th1 in let RIGHT_REVERSIBLE_TAC = FIRST [CONJ_TAC; (* and *) GEN_TAC; (* forall *) DISCH_TAC; (* implies *) (fun gl -> CONV_TAC(K(IMPLICATE(snd gl))) gl); (* not *) EQ_TAC] (* iff *) and LEFT_REVERSIBLE_TAC th gl = tryfind (fun ttac -> ttac th gl) [CONJUNCTS_THEN' ASSUME_TAC; (* and *) DISJ_CASES_TAC; (* or *) CHOOSE_TAC; (* exists *) (fun th -> ASSUME_TAC (EQ_MP (IMPLICATE (concl th)) th)); (* not *) (CONJUNCTS_THEN' MP_TAC o uncurry CONJ o EQ_IMP_RULE)] (* iff *) in let rec ITAUT_TAC mvs n gl = if n <= 0 then failwith "ITAUT_TAC: Too deep" else ((FIRST_ASSUM (UNIFY_ACCEPT_TAC mvs)) ORELSE (ACCEPT_TAC TRUTH) ORELSE (FIRST_ASSUM CONTR_TAC) ORELSE (RIGHT_REVERSIBLE_TAC THEN TRY (ITAUT_TAC mvs n)) ORELSE (FIRST_X_ASSUM LEFT_REVERSIBLE_TAC THEN TRY(ITAUT_TAC mvs n)) ORELSE (FIRST_X_ASSUM(fun th -> ASSUME_TAC th THEN (let gv = genvar(type_of(fst(dest_forall(concl th)))) in META_SPEC_TAC gv th THEN ITAUT_TAC (gv::mvs) (n - 2) THEN NO_TAC))) ORELSE (DISJ1_TAC THEN ITAUT_TAC mvs n THEN NO_TAC) ORELSE (DISJ2_TAC THEN ITAUT_TAC mvs n THEN NO_TAC) ORELSE (fun gl -> let gv = genvar(type_of(fst(dest_exists(snd gl)))) in (X_META_EXISTS_TAC gv THEN ITAUT_TAC (gv::mvs) (n - 2) THEN NO_TAC) gl) ORELSE (FIRST_ASSUM(fun th -> SUBGOAL_THEN (fst(dest_imp(concl th))) (fun ath -> ASSUME_TAC (MP th ath)) THEN ITAUT_TAC mvs (n - 1) THEN NO_TAC))) gl in let rec ITAUT_ITERDEEP_TAC n gl = remark ("Searching with limit "^(string_of_int n)); ((ITAUT_TAC [] n THEN NO_TAC) ORELSE ITAUT_ITERDEEP_TAC (n + 1)) gl in ITAUT_ITERDEEP_TAC 0;; (* ------------------------------------------------------------------------- *) (* Alternative interface. *) (* ------------------------------------------------------------------------- *) let ITAUT tm = prove(tm,ITAUT_TAC);; hol-light/iterate.ml000066400000000000000000003207431303454263000147450ustar00rootroot00000000000000(* ========================================================================= *) (* Generic iterated operations and special cases of sums over N and R. *) (* *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Lars Schewe 2007 *) (* ========================================================================= *) needs "sets.ml";; prioritize_num();; (* ------------------------------------------------------------------------- *) (* A natural notation for segments of the naturals. *) (* ------------------------------------------------------------------------- *) parse_as_infix("..",(15,"right"));; let numseg = new_definition `m..n = {x:num | m <= x /\ x <= n}`;; let FINITE_NUMSEG = prove (`!m n. FINITE(m..n)`, REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:num | x <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; numseg]);; let NUMSEG_COMBINE_R = prove (`!m p n. m <= p + 1 /\ p <= n ==> ((m..p) UNION ((p+1)..n) = m..n)`, REWRITE_TAC[EXTENSION; IN_UNION; numseg; IN_ELIM_THM] THEN ARITH_TAC);; let NUMSEG_COMBINE_L = prove (`!m p n. m <= p /\ p <= n + 1 ==> ((m..(p-1)) UNION (p..n) = m..n)`, REWRITE_TAC[EXTENSION; IN_UNION; numseg; IN_ELIM_THM] THEN ARITH_TAC);; let NUMSEG_LREC = prove (`!m n. m <= n ==> (m INSERT ((m+1)..n) = m..n)`, REWRITE_TAC[EXTENSION; IN_INSERT; numseg; IN_ELIM_THM] THEN ARITH_TAC);; let NUMSEG_RREC = prove (`!m n. m <= n ==> (n INSERT (m..(n-1)) = m..n)`, REWRITE_TAC[EXTENSION; IN_INSERT; numseg; IN_ELIM_THM] THEN ARITH_TAC);; let NUMSEG_REC = prove (`!m n. m <= SUC n ==> (m..SUC n = (SUC n) INSERT (m..n))`, SIMP_TAC[GSYM NUMSEG_RREC; SUC_SUB1]);; let IN_NUMSEG = prove (`!m n p. p IN (m..n) <=> m <= p /\ p <= n`, REWRITE_TAC[numseg; IN_ELIM_THM]);; let IN_NUMSEG_0 = prove (`!m n. m IN (0..n) <=> m <= n`, REWRITE_TAC[IN_NUMSEG; LE_0]);; let NUMSEG_SING = prove (`!n. n..n = {n}`, REWRITE_TAC[EXTENSION; IN_SING; IN_NUMSEG] THEN ARITH_TAC);; let NUMSEG_EMPTY = prove (`!m n. (m..n = {}) <=> n < m`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_NUMSEG] THEN MESON_TAC[NOT_LE; LE_TRANS; LE_REFL]);; let FINITE_SUBSET_NUMSEG = prove (`!s:num->bool. FINITE s <=> ?n. s SUBSET 0..n`, GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[SUBSET; IN_NUMSEG; LE_0] THEN SPEC_TAC(`s:num->bool`,`s:num->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]; MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG]]);; let CARD_NUMSEG_LEMMA = prove (`!m d. CARD(m..(m+d)) = d + 1`, GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[ADD_CLAUSES; NUMSEG_REC; NUMSEG_SING; FINITE_RULES; ARITH_RULE `m <= SUC(m + d)`; CARD_CLAUSES; FINITE_NUMSEG; NOT_IN_EMPTY; ARITH; IN_NUMSEG; ARITH_RULE `~(SUC n <= n)`]);; let CARD_NUMSEG = prove (`!m n. CARD(m..n) = (n + 1) - m`, REPEAT GEN_TAC THEN DISJ_CASES_THEN MP_TAC (ARITH_RULE `n:num < m \/ m <= n`) THENL [ASM_MESON_TAC[NUMSEG_EMPTY; CARD_CLAUSES; ARITH_RULE `n < m ==> ((n + 1) - m = 0)`]; SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; CARD_NUMSEG_LEMMA] THEN REPEAT STRIP_TAC THEN ARITH_TAC]);; let HAS_SIZE_NUMSEG = prove (`!m n. (m..n) HAS_SIZE ((n + 1) - m)`, REWRITE_TAC[HAS_SIZE; FINITE_NUMSEG; CARD_NUMSEG]);; let CARD_NUMSEG_1 = prove (`!n. CARD(1..n) = n`, REWRITE_TAC[CARD_NUMSEG] THEN ARITH_TAC);; let HAS_SIZE_NUMSEG_1 = prove (`!n. (1..n) HAS_SIZE n`, REWRITE_TAC[CARD_NUMSEG; HAS_SIZE; FINITE_NUMSEG] THEN ARITH_TAC);; let NUMSEG_CLAUSES = prove (`(!m. m..0 = if m = 0 then {0} else {}) /\ (!m n. m..SUC n = if m <= SUC n then (SUC n) INSERT (m..n) else m..n)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_NUMSEG; NOT_IN_EMPTY; IN_INSERT] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; let FINITE_INDEX_NUMSEG = prove (`!s:A->bool. FINITE s = ?f. (!i j. i IN (1..CARD(s)) /\ j IN (1..CARD(s)) /\ (f i = f j) ==> (i = j)) /\ (s = IMAGE f (1..CARD(s)))`, GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FINITE_NUMSEG; FINITE_IMAGE]] THEN DISCH_TAC THEN MP_TAC(ISPECL [`s:A->bool`; `CARD(s:A->bool)`] HAS_SIZE_INDEX) THEN ASM_REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\n. f(n - 1):A` THEN ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN CONJ_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= n <=> ~(i = 0) /\ i - 1 < n`] THEN ASM_MESON_TAC[ARITH_RULE `~(x = 0) /\ ~(y = 0) /\ (x - 1 = y - 1) ==> (x = y)`]; ASM_MESON_TAC [ARITH_RULE `m < C ==> (m = (m + 1) - 1) /\ 1 <= m + 1 /\ m + 1 <= C`; ARITH_RULE `1 <= i /\ i <= n <=> ~(i = 0) /\ i - 1 < n`]]);; let FINITE_INDEX_NUMBERS = prove (`!s:A->bool. FINITE s = ?k:num->bool f. (!i j. i IN k /\ j IN k /\ (f i = f j) ==> (i = j)) /\ FINITE k /\ (s = IMAGE f k)`, MESON_TAC[FINITE_INDEX_NUMSEG; FINITE_NUMSEG; FINITE_IMAGE]);; let INTER_NUMSEG = prove (`!m n p q. (m..n) INTER (p..q) = (MAX m p)..(MIN n q)`, REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG] THEN ARITH_TAC);; let DISJOINT_NUMSEG = prove (`!m n p q. DISJOINT (m..n) (p..q) <=> n < p \/ q < m \/ n < m \/ q < p`, REWRITE_TAC[DISJOINT; NUMSEG_EMPTY; INTER_NUMSEG] THEN ARITH_TAC);; let NUMSEG_ADD_SPLIT = prove (`!m n p. m <= n + 1 ==> (m..(n+p) = (m..n) UNION (n+1..n+p))`, REWRITE_TAC[EXTENSION; IN_UNION; IN_NUMSEG] THEN ARITH_TAC);; let NUMSEG_OFFSET_IMAGE = prove (`!m n p. (m+p..n+p) = IMAGE (\i. i + p) (m..n)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(fun th -> EXISTS_TAC `x - p:num` THEN MP_TAC th); ALL_TAC] THEN ARITH_TAC);; let SUBSET_NUMSEG = prove (`!m n p q. (m..n) SUBSET (p..q) <=> n < m \/ p <= m /\ n <= q`, REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_NUMSEG] THEN EQ_TAC THENL [MESON_TAC[LE_TRANS; NOT_LE; LE_REFL]; ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Equivalence with the more ad-hoc comprehension notation. *) (* ------------------------------------------------------------------------- *) let NUMSEG_LE = prove (`!n. {x | x <= n} = 0..n`, REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC);; let NUMSEG_LT = prove (`!n. {x | x < n} = if n = 0 then {} else 0..(n-1)`, GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Conversion to evaluate m..n for specific numerals. *) (* ------------------------------------------------------------------------- *) let NUMSEG_CONV = let pth_0 = MESON[NUMSEG_EMPTY] `n < m ==> m..n = {}` and pth_1 = MESON[NUMSEG_SING] `m..m = {m}` and pth_2 = MESON[NUMSEG_LREC; ADD1] `m <= n ==> m..n = m INSERT (SUC m..n)` and ns_tm = `(..)` and m_tm = `m:num` and n_tm = `n:num` in let rec NUMSEG_CONV tm = let nstm,nt = dest_comb tm in let nst,mt = dest_comb nstm in if nst <> ns_tm then failwith "NUMSEG_CONV" else let m = dest_numeral mt and n = dest_numeral nt in if n x = y) /\ (!x y z. x << y /\ y << z ==> x << z) ==> !n s. s HAS_SIZE n ==> ?f. s = IMAGE f (1..n) /\ (!j k. j IN 1..n /\ k IN 1..n /\ j < k ==> ~(f k << f j))`, GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `!n s. s HAS_SIZE n /\ ~(s = {}) ==> ?a:A. a IN s /\ !b. b IN (s DELETE a) ==> ~(b << a)` ASSUME_TAC THENL [INDUCT_TAC THEN REWRITE_TAC[HAS_SIZE_0; HAS_SIZE_SUC; TAUT `~(a /\ ~a)`] THEN X_GEN_TAC `s:A->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A)`) THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> (s DELETE a = {} <=> s = {a})`] THEN ASM_CASES_TAC `s = {a:A}` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `a:A` THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN ASM_CASES_TAC `((a:A) << (b:A)) :bool` THENL [EXISTS_TAC `a:A`; EXISTS_TAC `b:A`] THEN ASM SET_TAC[]; ALL_TAC] THEN INDUCT_TAC THENL [SIMP_TAC[HAS_SIZE_0; NUMSEG_CLAUSES; ARITH; IMAGE_CLAUSES; NOT_IN_EMPTY]; ALL_TAC] THEN REWRITE_TAC[HAS_SIZE_SUC] THEN X_GEN_TAC `s:A->bool` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`SUC n`; `s:A->bool`]) THEN ASM_REWRITE_TAC[HAS_SIZE_SUC] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` MP_TAC) THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A)`) THEN ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\k. if k = 1 then a:A else f(k - 1)` THEN SIMP_TAC[ARITH_RULE `1 <= k ==> ~(SUC k = 1)`; SUC_SUB1] THEN SUBGOAL_THEN `!i. i IN 1..SUC n <=> i = 1 \/ 1 < i /\ (i - 1) IN 1..n` (fun th -> REWRITE_TAC[EXTENSION; IN_IMAGE; th]) THENL [REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `b:A` THEN ASM_CASES_TAC `b:A = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP (SET_RULE `~(b = a) ==> (b IN s <=> b IN (s DELETE a))`) th]) THEN ONCE_REWRITE_TAC[COND_RAND] THEN ASM_REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN EXISTS_TAC `i + 1` THEN ASM_SIMP_TAC[ARITH_RULE `1 <= x ==> 1 < x + 1 /\ ~(x + 1 = 1)`; ADD_SUB]; MAP_EVERY X_GEN_TAC [`j:num`; `k:num`] THEN MAP_EVERY ASM_CASES_TAC [`j = 1`; `k = 1`] THEN ASM_REWRITE_TAC[LT_REFL] THENL [STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ARITH_TAC; STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; (* ------------------------------------------------------------------------- *) (* Analogous finiteness theorem for segments of integers. *) (* ------------------------------------------------------------------------- *) let FINITE_INTSEG = prove (`(!l r. FINITE {x:int | l <= x /\ x <= r}) /\ (!l r. FINITE {x:int | l <= x /\ x < r}) /\ (!l r. FINITE {x:int | l < x /\ x <= r}) /\ (!l r. FINITE {x:int | l < x /\ x < r})`, MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL [DISCH_TAC THEN REPEAT CONJ_TAC THEN POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN INT_ARITH_TAC; REPEAT GEN_TAC THEN ASM_CASES_TAC `&0:int <= r - l` THEN ASM_SIMP_TAC[INT_ARITH `~(&0 <= r - l:int) ==> ~(l <= x /\ x <= r)`] THEN ASM_SIMP_TAC[EMPTY_GSPEC; FINITE_EMPTY] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\n. l + &n) (0..num_of_int(r - l))` THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN REWRITE_TAC[GSYM INT_OF_NUM_LE; IN_NUMSEG] THEN X_GEN_TAC `x:int` THEN STRIP_TAC THEN EXISTS_TAC `num_of_int(x - l)` THEN ASM_SIMP_TAC[INT_OF_NUM_OF_INT; INT_SUB_LE] THEN ASM_INT_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) (* Generic iteration of operation over set with finite support. *) (* ------------------------------------------------------------------------- *) let neutral = new_definition `neutral op = @x. !y. (op x y = y) /\ (op y x = y)`;; let monoidal = new_definition `monoidal op <=> (!x y. op x y = op y x) /\ (!x y z. op x (op y z) = op (op x y) z) /\ (!x:A. op (neutral op) x = x)`;; let MONOIDAL_AC = prove (`!op. monoidal op ==> (!a. op (neutral op) a = a) /\ (!a. op a (neutral op) = a) /\ (!a b. op a b = op b a) /\ (!a b c. op (op a b) c = op a (op b c)) /\ (!a b c. op a (op b c) = op b (op a c))`, REWRITE_TAC[monoidal] THEN MESON_TAC[]);; let support = new_definition `support op (f:A->B) s = {x | x IN s /\ ~(f x = neutral op)}`;; let iterate = new_definition `iterate op (s:A->bool) f = if FINITE(support op f s) then ITSET (\x a. op (f x) a) (support op f s) (neutral op) else neutral op`;; let IN_SUPPORT = prove (`!op f x s. x IN (support op f s) <=> x IN s /\ ~(f x = neutral op)`, REWRITE_TAC[support; IN_ELIM_THM]);; let SUPPORT_SUPPORT = prove (`!op f s. support op f (support op f s) = support op f s`, REWRITE_TAC[support; IN_ELIM_THM; EXTENSION] THEN REWRITE_TAC[CONJ_ACI]);; let SUPPORT_EMPTY = prove (`!op f s. (!x. x IN s ==> (f(x) = neutral op)) <=> (support op f s = {})`, REWRITE_TAC[IN_SUPPORT; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN MESON_TAC[]);; let SUPPORT_SUBSET = prove (`!op f s. (support op f s) SUBSET s`, SIMP_TAC[SUBSET; IN_SUPPORT]);; let FINITE_SUPPORT = prove (`!op f s. FINITE s ==> FINITE(support op f s)`, MESON_TAC[SUPPORT_SUBSET; FINITE_SUBSET]);; let SUPPORT_CLAUSES = prove (`(!f. support op f {} = {}) /\ (!f x s. support op f (x INSERT s) = if f(x) = neutral op then support op f s else x INSERT (support op f s)) /\ (!f x s. support op f (s DELETE x) = (support op f s) DELETE x) /\ (!f s t. support op f (s UNION t) = (support op f s) UNION (support op f t)) /\ (!f s t. support op f (s INTER t) = (support op f s) INTER (support op f t)) /\ (!f s t. support op f (s DIFF t) = (support op f s) DIFF (support op f t)) /\ (!f g s. support op g (IMAGE f s) = IMAGE f (support op (g o f) s))`, REWRITE_TAC[support; EXTENSION; IN_ELIM_THM; IN_INSERT; IN_DELETE; o_THM; IN_IMAGE; NOT_IN_EMPTY; IN_UNION; IN_INTER; IN_DIFF; COND_RAND] THEN REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN ASM_MESON_TAC[]);; let SUPPORT_DELTA = prove (`!op s f a. support op (\x. if x = a then f(x) else neutral op) s = if a IN s then support op f {a} else {}`, REWRITE_TAC[EXTENSION; support; IN_ELIM_THM; IN_SING] THEN REPEAT GEN_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY]);; let FINITE_SUPPORT_DELTA = prove (`!op f a. FINITE(support op (\x. if x = a then f(x) else neutral op) s)`, REWRITE_TAC[SUPPORT_DELTA] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN SIMP_TAC[FINITE_RULES; FINITE_SUPPORT]);; (* ------------------------------------------------------------------------- *) (* Key lemmas about the generic notion. *) (* ------------------------------------------------------------------------- *) let ITERATE_SUPPORT = prove (`!op f s. iterate op (support op f s) f = iterate op s f`, SIMP_TAC[iterate; SUPPORT_SUPPORT]);; let ITERATE_EXPAND_CASES = prove (`!op f s. iterate op s f = if FINITE(support op f s) then iterate op (support op f s) f else neutral op`, SIMP_TAC[iterate; SUPPORT_SUPPORT]);; let ITERATE_CLAUSES_GEN = prove (`!op. monoidal op ==> (!(f:A->B). iterate op {} f = neutral op) /\ (!f x s. monoidal op /\ FINITE(support op (f:A->B) s) ==> (iterate op (x INSERT s) f = if x IN s then iterate op s f else op (f x) (iterate op s f)))`, GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MP_TAC(ISPECL [`\x a. (op:B->B->B) ((f:A->B)(x)) a`; `neutral op :B`] FINITE_RECURSION) THEN ANTS_TAC THENL [ASM_MESON_TAC[monoidal]; ALL_TAC] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[iterate; SUPPORT_CLAUSES; FINITE_RULES] THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [COND_RAND] THEN ASM_REWRITE_TAC[SUPPORT_CLAUSES; FINITE_INSERT; COND_ID] THEN ASM_CASES_TAC `(f:A->B) x = neutral op` THEN ASM_SIMP_TAC[IN_SUPPORT] THEN COND_CASES_TAC THEN ASM_MESON_TAC[monoidal]);; let ITERATE_CLAUSES = prove (`!op. monoidal op ==> (!f. iterate op {} f = neutral op) /\ (!f x s. FINITE(s) ==> (iterate op (x INSERT s) f = if x IN s then iterate op s f else op (f x) (iterate op s f)))`, SIMP_TAC[ITERATE_CLAUSES_GEN; FINITE_SUPPORT]);; let ITERATE_UNION = prove (`!op. monoidal op ==> !f s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> (iterate op (s UNION t) f = op (iterate op s f) (iterate op t f))`, let lemma = prove (`(s UNION (x INSERT t) = x INSERT (s UNION t)) /\ (DISJOINT s (x INSERT t) <=> ~(x IN s) /\ DISJOINT s t)`, SET_TAC[]) in GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; IN_UNION; UNION_EMPTY; REAL_ADD_RID; lemma; FINITE_UNION] THEN ASM_MESON_TAC[monoidal]);; let ITERATE_UNION_GEN = prove (`!op. monoidal op ==> !(f:A->B) s t. FINITE(support op f s) /\ FINITE(support op f t) /\ DISJOINT (support op f s) (support op f t) ==> (iterate op (s UNION t) f = op (iterate op s f) (iterate op t f))`, ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN SIMP_TAC[SUPPORT_CLAUSES; ITERATE_UNION]);; let ITERATE_DIFF = prove (`!op. monoidal op ==> !f s t. FINITE s /\ t SUBSET s ==> (op (iterate op (s DIFF t) f) (iterate op t f) = iterate op s f)`, let lemma = prove (`t SUBSET s ==> (s = (s DIFF t) UNION t) /\ DISJOINT (s DIFF t) t`, SET_TAC[]) in MESON_TAC[lemma; ITERATE_UNION; FINITE_UNION; FINITE_SUBSET; SUBSET_DIFF]);; let ITERATE_DIFF_GEN = prove (`!op. monoidal op ==> !f:A->B s t. FINITE (support op f s) /\ (support op f t) SUBSET (support op f s) ==> (op (iterate op (s DIFF t) f) (iterate op t f) = iterate op s f)`, ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN SIMP_TAC[SUPPORT_CLAUSES; ITERATE_DIFF]);; let ITERATE_INCL_EXCL = prove (`!op. monoidal op ==> !s t f. FINITE s /\ FINITE t ==> op (iterate op s f) (iterate op t f) = op (iterate op (s UNION t) f) (iterate op (s INTER t) f)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a UNION b = ((a DIFF b) UNION (b DIFF a)) UNION (a INTER b)`] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SET_RULE `s:A->bool = s DIFF t UNION s INTER t`] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SET_RULE `t:A->bool = t DIFF s UNION s INTER t`] THEN ASM_SIMP_TAC[ITERATE_UNION; FINITE_UNION; FINITE_DIFF; FINITE_INTER; SET_RULE `DISJOINT (s DIFF s' UNION s' DIFF s) (s INTER s')`; SET_RULE `DISJOINT (s DIFF s') (s' DIFF s)`; SET_RULE `DISJOINT (s DIFF s') (s' INTER s)`; SET_RULE `DISJOINT (s DIFF s') (s INTER s')`] THEN FIRST_X_ASSUM(fun th -> REWRITE_TAC[MATCH_MP MONOIDAL_AC th]));; let ITERATE_CLOSED = prove (`!op. monoidal op ==> !P. P(neutral op) /\ (!x y. P x /\ P y ==> P (op x y)) ==> !f:A->B s. (!x. x IN s /\ ~(f x = neutral op) ==> P(f x)) ==> P(iterate op s f)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM IN_SUPPORT] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN POP_ASSUM MP_TAC THEN SPEC_TAC(`support op (f:A->B) s`,`s:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_INSERT; IN_INSERT]);; let ITERATE_RELATED = prove (`!op. monoidal op ==> !R. R (neutral op) (neutral op) /\ (!x1 y1 x2 y2. R x1 x2 /\ R y1 y2 ==> R (op x1 y1) (op x2 y2)) ==> !f:A->B g s. FINITE s /\ (!x. x IN s ==> R (f x) (g x)) ==> R (iterate op s f) (iterate op s g)`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_INSERT; IN_INSERT]);; let ITERATE_EQ_NEUTRAL = prove (`!op. monoidal op ==> !f:A->B s. (!x. x IN s ==> (f(x) = neutral op)) ==> (iterate op s f = neutral op)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `support op (f:A->B) s = {}` ASSUME_TAC THENL [ASM_MESON_TAC[EXTENSION; NOT_IN_EMPTY; IN_SUPPORT]; ASM_MESON_TAC[ITERATE_CLAUSES; FINITE_RULES; ITERATE_SUPPORT]]);; let ITERATE_SING = prove (`!op. monoidal op ==> !f:A->B x. (iterate op {x} f = f x)`, SIMP_TAC[ITERATE_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN MESON_TAC[monoidal]);; let ITERATE_DELETE = prove (`!op. monoidal op ==> !f:A->B s a. FINITE s /\ a IN s ==> op (f a) (iterate op (s DELETE a) f) = iterate op s f`, MESON_TAC[ITERATE_CLAUSES; FINITE_DELETE; IN_DELETE; INSERT_DELETE]);; let ITERATE_DELTA = prove (`!op. monoidal op ==> !f a s. iterate op s (\x. if x = a then f(x) else neutral op) = if a IN s then f(a) else neutral op`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN REWRITE_TAC[SUPPORT_DELTA] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ITERATE_CLAUSES] THEN REWRITE_TAC[SUPPORT_CLAUSES] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ITERATE_CLAUSES; ITERATE_SING]);; let ITERATE_IMAGE = prove (`!op. monoidal op ==> !f:A->B g:B->C s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> (iterate op (IMAGE f s) g = iterate op s (g o f))`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN SUBGOAL_THEN `!s. FINITE s /\ (!x y:A. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> (iterate op (IMAGE f s) (g:B->C) = iterate op s (g o f))` ASSUME_TAC THENL [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; IMAGE_CLAUSES; FINITE_IMAGE] THEN REWRITE_TAC[o_THM; IN_INSERT] THEN ASM_MESON_TAC[IN_IMAGE]; GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(a <=> a') /\ (a' ==> (b = b')) ==> (if a then b else c) = (if a' then b' else c)`) THEN REWRITE_TAC[SUPPORT_CLAUSES] THEN REPEAT STRIP_TAC THENL [MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN ASM_MESON_TAC[IN_SUPPORT]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_SUPPORT]]]);; let ITERATE_BIJECTION = prove (`!op. monoidal op ==> !f:A->B p s. (!x. x IN s ==> p(x) IN s) /\ (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) ==> iterate op s f = iterate op s (f o p)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `iterate op (IMAGE (p:A->A) s) (f:A->B)` THEN CONJ_TAC THENL [AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE]; FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INST_TYPE [aty,bty] ITERATE_IMAGE))] THEN ASM_MESON_TAC[]);; let ITERATE_ITERATE_PRODUCT = prove (`!op. monoidal op ==> !s:A->bool t:A->B->bool x:A->B->C. FINITE s /\ (!i. i IN s ==> FINITE(t i)) ==> iterate op s (\i. iterate op (t i) (x i)) = iterate op {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{a,b | F} = {}`; ITERATE_CLAUSES] THEN REWRITE_TAC[SET_RULE `{i,j | i IN a INSERT s /\ j IN t i} = IMAGE (\j. a,j) (t a) UNION {i,j | i IN s /\ j IN t i}`] THEN ASM_SIMP_TAC[FINITE_INSERT; ITERATE_CLAUSES; IN_INSERT] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) (MATCH_MP ITERATE_UNION th) o rand o snd)) THEN ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_PRODUCT_DEPENDENT; IN_INSERT] THEN REWRITE_TAC[DISJOINT; EXTENSION; IN_IMAGE; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM; EXISTS_PAIR_THM; FORALL_PAIR_THM; PAIR_EQ] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) (MATCH_MP ITERATE_IMAGE th) o rand o snd)) THEN ANTS_TAC THENL [SIMP_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_SIMP_TAC[PAIR_EQ]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[ETA_AX]]);; let ITERATE_EQ = prove (`!op. monoidal op ==> !f:A->B g s. (!x. x IN s ==> f x = g x) ==> iterate op s f = iterate op s g`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN SUBGOAL_THEN `support op g s = support op (f:A->B) s` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_SUPPORT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `FINITE(support op (f:A->B) s) /\ (!x. x IN (support op f s) ==> f x = g x)` MP_TAC THENL [ASM_MESON_TAC[IN_SUPPORT]; REWRITE_TAC[IMP_CONJ]] THEN SPEC_TAC(`support op (f:A->B) s`,`t:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES] THEN MESON_TAC[IN_INSERT]);; let ITERATE_RESTRICT_SET = prove (`!op. monoidal op ==> !P s f:A->B. iterate op {x | x IN s /\ P x} f = iterate op s (\x. if P x then f x else neutral op)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN REWRITE_TAC[support; IN_ELIM_THM] THEN REWRITE_TAC[MESON[] `~((if P x then f x else a) = a) <=> P x /\ ~(f x = a)`; GSYM CONJ_ASSOC] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ) THEN SIMP_TAC[IN_ELIM_THM]);; let ITERATE_EQ_GENERAL = prove (`!op. monoidal op ==> !s:A->bool t:B->bool f:A->C g h. (!y. y IN t ==> ?!x. x IN s /\ h(x) = y) /\ (!x. x IN s ==> h(x) IN t /\ g(h x) = f x) ==> iterate op s f = iterate op t g`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `t = IMAGE (h:A->B) s` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `iterate op s ((g:B->C) o (h:A->B))` THEN CONJ_TAC THENL [ASM_MESON_TAC[ITERATE_EQ; o_THM]; CONV_TAC SYM_CONV THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_IMAGE) THEN ASM_MESON_TAC[]]);; let ITERATE_EQ_GENERAL_INVERSES = prove (`!op. monoidal op ==> !s:A->bool t:B->bool f:A->C g h k. (!y. y IN t ==> k(y) IN s /\ h(k y) = y) /\ (!x. x IN s ==> h(x) IN t /\ k(h x) = x /\ g(h x) = f x) ==> iterate op s f = iterate op t g`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ_GENERAL) THEN EXISTS_TAC `h:A->B` THEN ASM_MESON_TAC[]);; let ITERATE_INJECTION = prove (`!op. monoidal op ==> !f:A->B p:A->A s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> iterate op s (f o p) = iterate op s f`, REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_BIJECTION) THEN MP_TAC(ISPECL [`s:A->bool`; `p:A->A`] SURJECTIVE_IFF_INJECTIVE) THEN ASM_REWRITE_TAC[SUBSET; IN_IMAGE] THEN ASM_MESON_TAC[]);; let ITERATE_UNION_NONZERO = prove (`!op. monoidal op ==> !f:A->B s t. FINITE(s) /\ FINITE(t) /\ (!x. x IN (s INTER t) ==> f x = neutral(op)) ==> iterate op (s UNION t) f = op (iterate op s f) (iterate op t f)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN REWRITE_TAC[SUPPORT_CLAUSES] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_UNION) THEN ASM_SIMP_TAC[FINITE_SUPPORT; DISJOINT; IN_INTER; IN_SUPPORT; EXTENSION] THEN ASM_MESON_TAC[IN_INTER; NOT_IN_EMPTY]);; let ITERATE_OP = prove (`!op. monoidal op ==> !f g s. FINITE s ==> iterate op s (\x. op (f x) (g x)) = op (iterate op s f) (iterate op s g)`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_AC]);; let ITERATE_SUPERSET = prove (`!op. monoidal op ==> !f:A->B u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f(x) = neutral op) ==> iterate op v f = iterate op u f`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[support; EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]);; let ITERATE_UNIV = prove (`!op. monoidal op ==> !f:A->B s. support op f UNIV SUBSET s ==> iterate op s f = iterate op UNIV f`, REWRITE_TAC[support; SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_SUPERSET) THEN ASM SET_TAC[]);; let ITERATE_SWAP = prove (`!op. monoidal op ==> !f:A->B->C s t. FINITE s /\ FINITE t ==> iterate op s (\i. iterate op t (f i)) = iterate op t (\j. iterate op s (\i. f i j))`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES] THEN ASM_SIMP_TAC[ITERATE_EQ_NEUTRAL; GSYM ITERATE_OP]);; let ITERATE_IMAGE_NONZERO = prove (`!op. monoidal op ==> !g:B->C f:A->B s. FINITE s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) /\ f x = f y ==> g(f x) = neutral op) ==> iterate op (IMAGE f s) g = iterate op s (g o f)`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[IMAGE_CLAUSES; ITERATE_CLAUSES; FINITE_IMAGE] THEN MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `iterate op s ((g:B->C) o (f:A->B)) = iterate op (IMAGE f s) g` SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN SUBGOAL_THEN `(g:B->C) ((f:A->B) a) = neutral op` SUBST1_TAC THEN ASM_MESON_TAC[MONOIDAL_AC]);; let ITERATE_IMAGE_GEN = prove (`!op. monoidal op ==> !f:A->B g:A->C s. FINITE s ==> iterate op s g = iterate op (IMAGE f s) (\y. iterate op {x | x IN s /\ f x = y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `iterate op s (\x:A. iterate op {y:B | y IN IMAGE f s /\ (f x = y)} (\y. (g:A->C) x))` THEN CONJ_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ) THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN SUBGOAL_THEN `{y | y IN IMAGE (f:A->B) s /\ f x = y} = {(f x)}` SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[ITERATE_SING]]; ASM_SIMP_TAC[ITERATE_RESTRICT_SET] THEN FIRST_ASSUM(fun th -> W(MP_TAC o PART_MATCH (lhand o rand) (MATCH_MP ITERATE_SWAP th) o lhand o snd)) THEN ASM_SIMP_TAC[FINITE_IMAGE]]);; let ITERATE_CASES = prove (`!op. monoidal op ==> !s P f g:A->B. FINITE s ==> iterate op s (\x. if P x then f x else g x) = op (iterate op {x | x IN s /\ P x} f) (iterate op {x | x IN s /\ ~P x} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `op (iterate op {x | x IN s /\ P x} (\x. if P x then f x else (g:A->B) x)) (iterate op {x | x IN s /\ ~P x} (\x. if P x then f x else g x))` THEN CONJ_TAC THENL [FIRST_ASSUM(fun th -> ASM_SIMP_TAC[GSYM(MATCH_MP ITERATE_UNION th); FINITE_RESTRICT; SET_RULE `DISJOINT {x | x IN s /\ P x} {x | x IN s /\ ~P x}`]) THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]; BINOP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ) THEN SIMP_TAC[IN_ELIM_THM]]);; let ITERATE_OP_GEN = prove (`!op. monoidal op ==> !f g:A->B s. FINITE(support op f s) /\ FINITE(support op g s) ==> iterate op s (\x. op (f x) (g x)) = op (iterate op s f) (iterate op s g)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `iterate op (support op f s UNION support op g s) (\x. op ((f:A->B) x) (g x))` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV; ASM_SIMP_TAC[ITERATE_OP; FINITE_UNION] THEN BINOP_TAC] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_SUPERSET) THEN REWRITE_TAC[support; IN_ELIM_THM; SUBSET; IN_UNION] THEN ASM_MESON_TAC[monoidal]);; let ITERATE_CLAUSES_NUMSEG = prove (`!op. monoidal op ==> (!m. iterate op (m..0) f = if m = 0 then f(0) else neutral op) /\ (!m n. iterate op (m..SUC n) f = if m <= SUC n then op (iterate op (m..n) f) (f(SUC n)) else iterate op (m..n) f)`, REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; FINITE_EMPTY] THEN REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; NOT_IN_EMPTY] THEN ASM_MESON_TAC[monoidal]);; let ITERATE_PAIR = prove (`!op. monoidal op ==> !f m n. iterate op (2*m..2*n+1) f = iterate op (m..n) (\i. op (f(2*i)) (f(2*i+1)))`, GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN CONV_TAC NUM_REDUCE_CONV THENL [ASM_SIMP_TAC[num_CONV `1`; ITERATE_CLAUSES_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `2 * m <= SUC 0 <=> m = 0`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH]; REWRITE_TAC[ARITH_RULE `2 * SUC n + 1 = SUC(SUC(2 * n + 1))`] THEN ASM_SIMP_TAC[ITERATE_CLAUSES_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `2 * m <= SUC(SUC(2 * n + 1)) <=> m <= SUC n`; ARITH_RULE `2 * m <= SUC(2 * n + 1) <=> m <= SUC n`] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `2 * SUC n = SUC(2 * n + 1)`; ARITH_RULE `2 * SUC n + 1 = SUC(SUC(2 * n + 1))`] THEN ASM_MESON_TAC[monoidal]]);; let ITERATE_REFLECT = prove (`!op:A->A->A. monoidal op ==> !x m n. iterate op (m..n) x = if n < m then neutral op else iterate op (0..n-m) (\i. x(n - i))`, REWRITE_TAC[GSYM NUMSEG_EMPTY] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [ASM_MESON_TAC[ITERATE_CLAUSES]; RULE_ASSUM_TAC(REWRITE_RULE[NUMSEG_EMPTY; NOT_LT])] THEN FIRST_ASSUM(MP_TAC o ISPECL [`\i:num. n - i`; `x:num->A`; `0..n-m`] o MATCH_MP (INST_TYPE [`:X`,`:A`] ITERATE_IMAGE)) THEN REWRITE_TAC[o_DEF; IN_NUMSEG] THEN ANTS_TAC THENL [ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN REWRITE_TAC[UNWIND_THM2; ARITH_RULE `x = n - y /\ 0 <= y /\ y <= n - m <=> y = n - x /\ x <= n /\ y <= n - m`] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Sums of natural numbers. *) (* ------------------------------------------------------------------------- *) prioritize_num();; let nsum = new_definition `nsum = iterate (+)`;; let NEUTRAL_ADD = prove (`neutral((+):num->num->num) = 0`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[ADD_CLAUSES]);; let NEUTRAL_MUL = prove (`neutral(( * ):num->num->num) = 1`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[MULT_CLAUSES; MULT_EQ_1]);; let MONOIDAL_ADD = prove (`monoidal((+):num->num->num)`, REWRITE_TAC[monoidal; NEUTRAL_ADD] THEN ARITH_TAC);; let MONOIDAL_MUL = prove (`monoidal(( * ):num->num->num)`, REWRITE_TAC[monoidal; NEUTRAL_MUL] THEN ARITH_TAC);; let NSUM_DEGENERATE = prove (`!f s. ~(FINITE {x | x IN s /\ ~(f x = 0)}) ==> nsum s f = 0`, REPEAT GEN_TAC THEN REWRITE_TAC[nsum] THEN SIMP_TAC[iterate; support; NEUTRAL_ADD]);; let NSUM_CLAUSES = prove (`(!f. nsum {} f = 0) /\ (!x f s. FINITE(s) ==> (nsum (x INSERT s) f = if x IN s then nsum s f else f(x) + nsum s f))`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_UNION = prove (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> (nsum (s UNION t) f = nsum s f + nsum t f)`, SIMP_TAC[nsum; ITERATE_UNION; MONOIDAL_ADD]);; let NSUM_DIFF = prove (`!f s t. FINITE s /\ t SUBSET s ==> (nsum (s DIFF t) f = nsum s f - nsum t f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE `(x + z = y:num) ==> (x = y - z)`) THEN ASM_SIMP_TAC[nsum; ITERATE_DIFF; MONOIDAL_ADD]);; let NSUM_INCL_EXCL = prove (`!s t (f:A->num). FINITE s /\ FINITE t ==> nsum s f + nsum t f = nsum (s UNION t) f + nsum (s INTER t) f`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN MATCH_MP_TAC ITERATE_INCL_EXCL THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_SUPPORT = prove (`!f s. nsum (support (+) f s) f = nsum s f`, SIMP_TAC[nsum; iterate; SUPPORT_SUPPORT]);; let NSUM_ADD = prove (`!f g s. FINITE s ==> (nsum s (\x. f(x) + g(x)) = nsum s f + nsum s g)`, SIMP_TAC[nsum; ITERATE_OP; MONOIDAL_ADD]);; let NSUM_ADD_GEN = prove (`!f g s. FINITE {x | x IN s /\ ~(f x = 0)} /\ FINITE {x | x IN s /\ ~(g x = 0)} ==> nsum s (\x. f x + g x) = nsum s f + nsum s g`, REWRITE_TAC[GSYM NEUTRAL_ADD; GSYM support; nsum] THEN MATCH_MP_TAC ITERATE_OP_GEN THEN ACCEPT_TAC MONOIDAL_ADD);; let NSUM_EQ_0 = prove (`!f s. (!x:A. x IN s ==> (f(x) = 0)) ==> (nsum s f = 0)`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_ADD]);; let NSUM_0 = prove (`!s:A->bool. nsum s (\n. 0) = 0`, SIMP_TAC[NSUM_EQ_0]);; let NSUM_LMUL = prove (`!f c s:A->bool. nsum s (\x. c * f(x)) = c * nsum s f`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; NSUM_0] THEN REWRITE_TAC[nsum] THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN SUBGOAL_THEN `support (+) (\x:A. c * f(x)) s = support (+) f s` SUBST1_TAC THENL [ASM_SIMP_TAC[support; MULT_EQ_0; NEUTRAL_ADD]; ALL_TAC] THEN COND_CASES_TAC THEN REWRITE_TAC[NEUTRAL_ADD; MULT_CLAUSES] THEN UNDISCH_TAC `FINITE (support (+) f (s:A->bool))` THEN SPEC_TAC(`support (+) f (s:A->bool)`,`t:A->bool`) THEN REWRITE_TAC[GSYM nsum] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES; MULT_CLAUSES; LEFT_ADD_DISTRIB]);; let NSUM_RMUL = prove (`!f c s:A->bool. nsum s (\x. f(x) * c) = nsum s f * c`, ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[NSUM_LMUL]);; let NSUM_LE = prove (`!f g s. FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) ==> nsum s f <= nsum s g`, ONCE_REWRITE_TAC[IMP_CONJ] THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES; LE_REFL; LE_ADD2; IN_INSERT]);; let NSUM_LT = prove (`!f g s:A->bool. FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) /\ (?x. x IN s /\ f(x) < g(x)) ==> nsum s f < nsum s g`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN ASM_SIMP_TAC[LTE_ADD2; NSUM_LE; IN_DELETE; FINITE_DELETE]);; let NSUM_LT_ALL = prove (`!f g s. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < g(x)) ==> nsum s f < nsum s g`, MESON_TAC[MEMBER_NOT_EMPTY; LT_IMP_LE; NSUM_LT]);; let NSUM_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (nsum s f = nsum s g)`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_CONST = prove (`!c s. FINITE s ==> (nsum s (\n. c) = (CARD s) * c)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES; CARD_CLAUSES] THEN REPEAT STRIP_TAC THEN ARITH_TAC);; let NSUM_POS_BOUND = prove (`!f b s. FINITE s /\ nsum s f <= b ==> !x:A. x IN s ==> f x <= b`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES; NOT_IN_EMPTY; IN_INSERT] THEN MESON_TAC[LE_0; ARITH_RULE `0 <= x /\ 0 <= y /\ x + y <= b ==> x <= b /\ y <= b`]);; let NSUM_EQ_0_IFF = prove (`!s. FINITE s ==> (nsum s f = 0 <=> !x. x IN s ==> f x = 0)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[NSUM_EQ_0] THEN ASM_MESON_TAC[ARITH_RULE `n = 0 <=> n <= 0`; NSUM_POS_BOUND]);; let NSUM_POS_LT = prove (`!f s:A->bool. FINITE s /\ (?x. x IN s /\ 0 < f x) ==> 0 < nsum s f`, SIMP_TAC[ARITH_RULE `0 < n <=> ~(n = 0)`; NSUM_EQ_0_IFF] THEN MESON_TAC[]);; let NSUM_POS_LT_ALL = prove (`!s f:A->num. FINITE s /\ ~(s = {}) /\ (!i. i IN s ==> 0 < f i) ==> 0 < nsum s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_POS_LT THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE]);; let NSUM_DELETE = prove (`!f s a. FINITE s /\ a IN s ==> f(a) + nsum(s DELETE a) f = nsum s f`, SIMP_TAC[nsum; ITERATE_DELETE; MONOIDAL_ADD]);; let NSUM_SING = prove (`!f x. nsum {x} f = f(x)`, SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ADD_CLAUSES]);; let NSUM_DELTA = prove (`!s a. nsum s (\x. if x = a:A then b else 0) = if a IN s then b else 0`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN SIMP_TAC[ITERATE_DELTA; MONOIDAL_ADD]);; let NSUM_SWAP = prove (`!f:A->B->num s t. FINITE(s) /\ FINITE(t) ==> (nsum s (\i. nsum t (f i)) = nsum t (\j. nsum s (\i. f i j)))`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES; NSUM_0; NSUM_ADD; ETA_AX]);; let NSUM_IMAGE = prove (`!f g s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> (nsum (IMAGE f s) g = nsum s (g o f))`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_SUPERSET = prove (`!f:A->num u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = 0)) ==> (nsum v f = nsum u f)`, SIMP_TAC[nsum; GSYM NEUTRAL_ADD; ITERATE_SUPERSET; MONOIDAL_ADD]);; let NSUM_UNIV = prove (`!f:A->num s. support (+) f (:A) SUBSET s ==> nsum s f = nsum (:A) f`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_UNIV THEN REWRITE_TAC[MONOIDAL_ADD]);; let ITERATE_UNIV = prove (`!op. monoidal op ==> !f s. support op f UNIV SUBSET s ==> iterate op s f = iterate op UNIV f`, REWRITE_TAC[support; SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_SUPERSET) THEN ASM SET_TAC[]);; let NSUM_UNION_RZERO = prove (`!f:A->num u v. FINITE u /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = 0)) ==> (nsum (u UNION v) f = nsum u f)`, let lemma = prove(`u UNION v = u UNION (v DIFF u)`,SET_TAC[]) in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[lemma] THEN MATCH_MP_TAC NSUM_SUPERSET THEN ASM_MESON_TAC[IN_UNION; IN_DIFF; SUBSET]);; let NSUM_UNION_LZERO = prove (`!f:A->num u v. FINITE v /\ (!x. x IN u /\ ~(x IN v) ==> (f(x) = 0)) ==> (nsum (u UNION v) f = nsum v f)`, MESON_TAC[NSUM_UNION_RZERO; UNION_COMM]);; let NSUM_RESTRICT = prove (`!f s. FINITE s ==> (nsum s (\x. if x IN s then f(x) else 0) = nsum s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_EQ THEN ASM_SIMP_TAC[]);; let NSUM_BOUND = prove (`!s f b. FINITE s /\ (!x:A. x IN s ==> f(x) <= b) ==> nsum s f <= (CARD s) * b`, SIMP_TAC[GSYM NSUM_CONST; NSUM_LE]);; let NSUM_BOUND_GEN = prove (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) <= b DIV (CARD s)) ==> nsum s f <= b`, SIMP_TAC[IMP_CONJ; CARD_EQ_0; LE_RDIV_EQ] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `nsum s (\x. CARD(s:A->bool) * f x) <= CARD s * b` MP_TAC THENL [ASM_SIMP_TAC[NSUM_BOUND]; ASM_SIMP_TAC[NSUM_LMUL; LE_MULT_LCANCEL; CARD_EQ_0]]);; let NSUM_BOUND_LT = prove (`!s f b. FINITE s /\ (!x:A. x IN s ==> f x <= b) /\ (?x. x IN s /\ f x < b) ==> nsum s f < (CARD s) * b`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `nsum s (\x:A. b)` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_LT THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[NSUM_CONST; LE_REFL]]);; let NSUM_BOUND_LT_ALL = prove (`!s f b. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < b) ==> nsum s f < (CARD s) * b`, MESON_TAC[MEMBER_NOT_EMPTY; LT_IMP_LE; NSUM_BOUND_LT]);; let NSUM_BOUND_LT_GEN = prove (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) < b DIV (CARD s)) ==> nsum s f < b`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `nsum (s:A->bool) (\a. f(a) + 1)` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_LT_ALL THEN ASM_SIMP_TAC[] THEN ARITH_TAC; MATCH_MP_TAC NSUM_BOUND_GEN THEN ASM_REWRITE_TAC[ARITH_RULE `a + 1 <= b <=> a < b`]]);; let NSUM_UNION_EQ = prove (`!s t u. FINITE u /\ (s INTER t = {}) /\ (s UNION t = u) ==> (nsum s f + nsum t f = nsum u f)`, MESON_TAC[NSUM_UNION; DISJOINT; FINITE_SUBSET; SUBSET_UNION]);; let NSUM_EQ_SUPERSET = prove (`!f s t:A->bool. FINITE t /\ t SUBSET s /\ (!x. x IN t ==> (f x = g x)) /\ (!x. x IN s /\ ~(x IN t) ==> (f(x) = 0)) ==> (nsum s f = nsum t g)`, MESON_TAC[NSUM_SUPERSET; NSUM_EQ]);; let NSUM_RESTRICT_SET = prove (`!P s f. nsum {x:A | x IN s /\ P x} f = nsum s (\x. if P x then f(x) else 0)`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN MATCH_MP_TAC ITERATE_RESTRICT_SET THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_NSUM_RESTRICT = prove (`!R f s t. FINITE s /\ FINITE t ==> (nsum s (\x. nsum {y | y IN t /\ R x y} (\y. f x y)) = nsum t (\y. nsum {x | x IN s /\ R x y} (\x. f x y)))`, REPEAT GEN_TAC THEN SIMP_TAC[NSUM_RESTRICT_SET] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP NSUM_SWAP th]));; let CARD_EQ_NSUM = prove (`!s. FINITE s ==> ((CARD s) = nsum s (\x. 1))`, SIMP_TAC[NSUM_CONST; MULT_CLAUSES]);; let NSUM_MULTICOUNT_GEN = prove (`!R:A->B->bool s t k. FINITE s /\ FINITE t /\ (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k(j))) ==> (nsum s (\i. (CARD {j | j IN t /\ R i j})) = nsum t (\i. (k i)))`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `nsum s (\i:A. nsum {j:B | j IN t /\ R i j} (\j. 1))` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_EQ THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CARD_EQ_NSUM; FINITE_RESTRICT]; FIRST_ASSUM(fun t -> ONCE_REWRITE_TAC[MATCH_MP NSUM_NSUM_RESTRICT t]) THEN MATCH_MP_TAC NSUM_EQ THEN ASM_SIMP_TAC[NSUM_CONST; FINITE_RESTRICT] THEN REWRITE_TAC[MULT_CLAUSES]]);; let NSUM_MULTICOUNT = prove (`!R:A->B->bool s t k. FINITE s /\ FINITE t /\ (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k)) ==> (nsum s (\i. (CARD {j | j IN t /\ R i j})) = (k * CARD t))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `nsum t (\i:B. k)` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_MULTICOUNT_GEN THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[NSUM_CONST] THEN REWRITE_TAC[MULT_AC]]);; let NSUM_IMAGE_GEN = prove (`!f:A->B g s. FINITE s ==> nsum s g = nsum (IMAGE f s) (\y. nsum {x | x IN s /\ f x = y} g)`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_IMAGE_GEN THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_GROUP = prove (`!f:A->B g s t. FINITE s /\ IMAGE f s SUBSET t ==> nsum t (\y. nsum {x | x IN s /\ f(x) = y} g) = nsum s g`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:A->B`; `g:A->num`; `s:A->bool`] NSUM_IMAGE_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC NSUM_SUPERSET THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_EQ_0 THEN ASM SET_TAC[]);; let NSUM_GROUP_RELATION = prove (`!R:A->B->bool g s t. FINITE s /\ (!x. x IN s ==> ?!y. y IN t /\ R x y) ==> nsum t (\y. nsum {x | x IN s /\ R x y} g) = nsum s g`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:A. @y:B. y IN t /\ R x y`; `g:A->num`; `s:A->bool`; `t:B->bool`] NSUM_GROUP) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC NSUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let NSUM_SUBSET = prove (`!u v f. FINITE u /\ FINITE v /\ (!x:A. x IN (u DIFF v) ==> f(x) = 0) ==> nsum u f <= nsum v f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:A->num`; `u INTER v :A->bool`] NSUM_UNION) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `v DIFF u :A->bool` th) THEN MP_TAC(SPEC `u DIFF v :A->bool` th)) THEN REWRITE_TAC[SET_RULE `(u INTER v) UNION (u DIFF v) = u`; SET_RULE `(u INTER v) UNION (v DIFF u) = v`] THEN ASM_SIMP_TAC[FINITE_DIFF; FINITE_INTER] THEN REPEAT(ANTS_TAC THENL [SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN ASM_SIMP_TAC[NSUM_EQ_0] THEN ARITH_TAC);; let NSUM_SUBSET_SIMPLE = prove (`!u v f. FINITE v /\ u SUBSET v ==> nsum u f <= nsum v f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_SUBSET THEN ASM_MESON_TAC[IN_DIFF; SUBSET; FINITE_SUBSET]);; let NSUM_LE_GEN = prove (`!f g s. (!x:A. x IN s ==> f x <= g x) /\ FINITE {x | x IN s /\ ~(g x = 0)} ==> nsum s f <= nsum s g`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NSUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_ADD] THEN TRANS_TAC LE_TRANS `nsum {x | x IN s /\ ~(g(x:A) = 0)} f` THEN CONJ_TAC THENL [MATCH_MP_TAC NSUM_SUBSET THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE]] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[LE]; MATCH_MP_TAC NSUM_LE THEN ASM_SIMP_TAC[IN_ELIM_THM]]);; let NSUM_MUL_BOUND = prove (`!a b s:A->bool. FINITE s ==> nsum s (\i. a i * b i) <= nsum s a * nsum s b`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM NSUM_LMUL] THEN MATCH_MP_TAC NSUM_LE THEN ASM_REWRITE_TAC[LE_MULT_RCANCEL] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN DISJ1_TAC THEN ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM NSUM_SING] THEN MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[SING_SUBSET; IN_DIFF]);; let NSUM_IMAGE_NONZERO = prove (`!d:B->num i:A->B s. FINITE s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = 0) ==> nsum (IMAGE i s) d = nsum s (d o i)`, REWRITE_TAC[GSYM NEUTRAL_ADD; nsum] THEN MATCH_MP_TAC ITERATE_IMAGE_NONZERO THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_BIJECTION = prove (`!f p s:A->bool. (!x. x IN s ==> p(x) IN s) /\ (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) ==> nsum s f = nsum s (f o p)`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_BIJECTION THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_NSUM_PRODUCT = prove (`!s:A->bool t:A->B->bool x. FINITE s /\ (!i. i IN s ==> FINITE(t i)) ==> nsum s (\i. nsum (t i) (x i)) = nsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_ITERATE_PRODUCT THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_EQ_GENERAL = prove (`!s:A->bool t:B->bool f g h. (!y. y IN t ==> ?!x. x IN s /\ h(x) = y) /\ (!x. x IN s ==> h(x) IN t /\ g(h x) = f x) ==> nsum s f = nsum t g`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_EQ_GENERAL_INVERSES = prove (`!s:A->bool t:B->bool f g h k. (!y. y IN t ==> k(y) IN s /\ h(k y) = y) /\ (!x. x IN s ==> h(x) IN t /\ k(h x) = x /\ g(h x) = f x) ==> nsum s f = nsum t g`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL_INVERSES THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_INJECTION = prove (`!f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> nsum s (f o p) = nsum s f`, REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_INJECTION THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_UNION_NONZERO = prove (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = 0) ==> nsum (s UNION t) f = nsum s f + nsum t f`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN MATCH_MP_TAC ITERATE_UNION_NONZERO THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_UNIONS_NONZERO = prove (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\ (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 ==> f x = 0) ==> nsum (UNIONS s) f = nsum s (\t. nsum t f)`, GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; NSUM_CLAUSES; IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[NSUM_CLAUSES] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN STRIP_TAC THEN MATCH_MP_TAC NSUM_UNION_NONZERO THEN ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);; let NSUM_CASES = prove (`!s P f g. FINITE s ==> nsum s (\x:A. if P x then f x else g x) = nsum {x | x IN s /\ P x} f + nsum {x | x IN s /\ ~P x} g`, REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN MATCH_MP_TAC ITERATE_CASES THEN REWRITE_TAC[MONOIDAL_ADD]);; let NSUM_CLOSED = prove (`!P f:A->num s. P(0) /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!a. a IN s ==> P(f a)) ==> P(nsum s f)`, REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_ADD) THEN DISCH_THEN(MP_TAC o SPEC `P:num->bool`) THEN ASM_SIMP_TAC[NEUTRAL_ADD; GSYM nsum]);; let NSUM_ADD_NUMSEG = prove (`!f g m n. nsum(m..n) (\i. f(i) + g(i)) = nsum(m..n) f + nsum(m..n) g`, SIMP_TAC[NSUM_ADD; FINITE_NUMSEG]);; let NSUM_LE_NUMSEG = prove (`!f g m n. (!i. m <= i /\ i <= n ==> f(i) <= g(i)) ==> nsum(m..n) f <= nsum(m..n) g`, SIMP_TAC[NSUM_LE; FINITE_NUMSEG; IN_NUMSEG]);; let NSUM_EQ_NUMSEG = prove (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) ==> (nsum(m..n) f = nsum(m..n) g)`, MESON_TAC[NSUM_EQ; FINITE_NUMSEG; IN_NUMSEG]);; let NSUM_CONST_NUMSEG = prove (`!c m n. nsum(m..n) (\n. c) = ((n + 1) - m) * c`, SIMP_TAC[NSUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);; let NSUM_EQ_0_NUMSEG = prove (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = 0)) ==> (nsum(m..n) f = 0)`, SIMP_TAC[NSUM_EQ_0; IN_NUMSEG]);; let NSUM_EQ_0_IFF_NUMSEG = prove (`!f m n. nsum (m..n) f = 0 <=> !i. m <= i /\ i <= n ==> f i = 0`, SIMP_TAC[NSUM_EQ_0_IFF; FINITE_NUMSEG; IN_NUMSEG]);; let NSUM_TRIV_NUMSEG = prove (`!f m n. n < m ==> (nsum(m..n) f = 0)`, MESON_TAC[NSUM_EQ_0_NUMSEG; LE_TRANS; NOT_LT]);; let NSUM_SING_NUMSEG = prove (`!f n. nsum(n..n) f = f(n)`, SIMP_TAC[NSUM_SING; NUMSEG_SING]);; let NSUM_CLAUSES_NUMSEG = prove (`(!m. nsum(m..0) f = if m = 0 then f(0) else 0) /\ (!m n. nsum(m..SUC n) f = if m <= SUC n then nsum(m..n) f + f(SUC n) else nsum(m..n) f)`, MP_TAC(MATCH_MP ITERATE_CLAUSES_NUMSEG MONOIDAL_ADD) THEN REWRITE_TAC[NEUTRAL_ADD; nsum]);; let NSUM_SWAP_NUMSEG = prove (`!a b c d f. nsum(a..b) (\i. nsum(c..d) (f i)) = nsum(c..d) (\j. nsum(a..b) (\i. f i j))`, REPEAT GEN_TAC THEN MATCH_MP_TAC NSUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);; let NSUM_ADD_SPLIT = prove (`!f m n p. m <= n + 1 ==> (nsum (m..(n+p)) f = nsum(m..n) f + nsum(n+1..n+p) f)`, SIMP_TAC[NUMSEG_ADD_SPLIT; NSUM_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; ARITH_RULE `x < x + 1`]);; let NSUM_OFFSET = prove (`!p f m n. nsum(m+p..n+p) f = nsum(m..n) (\i. f(i + p))`, SIMP_TAC[NUMSEG_OFFSET_IMAGE; NSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[o_DEF]);; let NSUM_OFFSET_0 = prove (`!f m n. m <= n ==> (nsum(m..n) f = nsum(0..n-m) (\i. f(i + m)))`, SIMP_TAC[GSYM NSUM_OFFSET; ADD_CLAUSES; SUB_ADD]);; let NSUM_CLAUSES_LEFT = prove (`!f m n. m <= n ==> nsum(m..n) f = f(m) + nsum(m+1..n) f`, SIMP_TAC[GSYM NUMSEG_LREC; NSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; let NSUM_CLAUSES_RIGHT = prove (`!f m n. 0 < n /\ m <= n ==> nsum(m..n) f = nsum(m..n-1) f + f(n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[LT_REFL; NSUM_CLAUSES_NUMSEG; SUC_SUB1]);; let NSUM_PAIR = prove (`!f m n. nsum(2*m..2*n+1) f = nsum(m..n) (\i. f(2*i) + f(2*i+1))`, MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_ADD) THEN REWRITE_TAC[nsum; NEUTRAL_ADD]);; let NSUM_REFLECT = prove (`!x m n. nsum(m..n) x = if n < m then 0 else nsum(0..n-m) (\i. x(n - i))`, REPEAT GEN_TAC THEN REWRITE_TAC[nsum] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP ITERATE_REFLECT MONOIDAL_ADD] THEN REWRITE_TAC[NEUTRAL_ADD]);; let MOD_NSUM_MOD = prove (`!f:A->num n s. FINITE s /\ ~(n = 0) ==> (nsum s f) MOD n = nsum s (\i. f(i) MOD n) MOD n`, GEN_TAC THEN GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES] THEN REPEAT STRIP_TAC THEN W(MP_TAC o PART_MATCH (rand o rand) MOD_ADD_MOD o lhand o snd) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN W(MP_TAC o PART_MATCH (rand o rand) MOD_ADD_MOD o rand o snd) THEN ASM_SIMP_TAC[MOD_MOD_REFL]);; let MOD_NSUM_MOD_NUMSEG = prove (`!f a b n. ~(n = 0) ==> (nsum(a..b) f) MOD n = nsum(a..b) (\i. f i MOD n) MOD n`, MESON_TAC[MOD_NSUM_MOD; FINITE_NUMSEG]);; let th = prove (`(!f g s. (!x. x IN s ==> f(x) = g(x)) ==> nsum s (\i. f(i)) = nsum s g) /\ (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) ==> nsum(a..b) (\i. f(i)) = nsum(a..b) g) /\ (!f g p. (!x. p x ==> f x = g x) ==> nsum {y | p y} (\i. f(i)) = nsum {y | p y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; (* ------------------------------------------------------------------------- *) (* Thanks to finite sums, we can express cardinality of finite union. *) (* ------------------------------------------------------------------------- *) let CARD_UNIONS = prove (`!s:(A->bool)->bool. FINITE s /\ (!t. t IN s ==> FINITE t) /\ (!t u. t IN s /\ u IN s /\ ~(t = u) ==> t INTER u = {}) ==> CARD(UNIONS s) = nsum s CARD`, ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; NOT_IN_EMPTY; IN_INSERT] THEN REWRITE_TAC[CARD_CLAUSES; NSUM_CLAUSES] THEN MAP_EVERY X_GEN_TAC [`t:A->bool`; `f:(A->bool)->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[NSUM_CLAUSES] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[FINITE_UNIONS; FINITE_UNION; INTER_UNIONS] THEN REWRITE_TAC[EMPTY_UNIONS; IN_ELIM_THM] THEN ASM MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Sums of real numbers. *) (* ------------------------------------------------------------------------- *) prioritize_real();; let sum = new_definition `sum = iterate (+)`;; let NEUTRAL_REAL_ADD = prove (`neutral((+):real->real->real) = &0`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[REAL_ADD_LID; REAL_ADD_RID]);; let NEUTRAL_REAL_MUL = prove (`neutral(( * ):real->real->real) = &1`, REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MESON_TAC[REAL_MUL_LID; REAL_MUL_RID]);; let MONOIDAL_REAL_ADD = prove (`monoidal((+):real->real->real)`, REWRITE_TAC[monoidal; NEUTRAL_REAL_ADD] THEN REAL_ARITH_TAC);; let MONOIDAL_REAL_MUL = prove (`monoidal(( * ):real->real->real)`, REWRITE_TAC[monoidal; NEUTRAL_REAL_MUL] THEN REAL_ARITH_TAC);; let SUM_DEGENERATE = prove (`!f s. ~(FINITE {x | x IN s /\ ~(f x = &0)}) ==> sum s f = &0`, REPEAT GEN_TAC THEN REWRITE_TAC[sum] THEN SIMP_TAC[iterate; support; NEUTRAL_REAL_ADD]);; let SUM_CLAUSES = prove (`(!f. sum {} f = &0) /\ (!x f s. FINITE(s) ==> (sum (x INSERT s) f = if x IN s then sum s f else f(x) + sum s f))`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_UNION = prove (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> (sum (s UNION t) f = sum s f + sum t f)`, SIMP_TAC[sum; ITERATE_UNION; MONOIDAL_REAL_ADD]);; let SUM_DIFF = prove (`!f s t. FINITE s /\ t SUBSET s ==> (sum (s DIFF t) f = sum s f - sum t f)`, SIMP_TAC[REAL_EQ_SUB_LADD; sum; ITERATE_DIFF; MONOIDAL_REAL_ADD]);; let SUM_INCL_EXCL = prove (`!s t (f:A->real). FINITE s /\ FINITE t ==> sum s f + sum t f = sum (s UNION t) f + sum (s INTER t) f`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC ITERATE_INCL_EXCL THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_SUPPORT = prove (`!f s. sum (support (+) f s) f = sum s f`, SIMP_TAC[sum; iterate; SUPPORT_SUPPORT]);; let SUM_ADD = prove (`!f g s. FINITE s ==> (sum s (\x. f(x) + g(x)) = sum s f + sum s g)`, SIMP_TAC[sum; ITERATE_OP; MONOIDAL_REAL_ADD]);; let SUM_ADD_GEN = prove (`!f g s. FINITE {x | x IN s /\ ~(f x = &0)} /\ FINITE {x | x IN s /\ ~(g x = &0)} ==> sum s (\x. f x + g x) = sum s f + sum s g`, REWRITE_TAC[GSYM NEUTRAL_REAL_ADD; GSYM support; sum] THEN MATCH_MP_TAC ITERATE_OP_GEN THEN ACCEPT_TAC MONOIDAL_REAL_ADD);; let SUM_EQ_0 = prove (`!f s. (!x:A. x IN s ==> (f(x) = &0)) ==> (sum s f = &0)`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_REAL_ADD]);; let SUM_0 = prove (`!s:A->bool. sum s (\n. &0) = &0`, SIMP_TAC[SUM_EQ_0]);; let SUM_LMUL = prove (`!f c s:A->bool. sum s (\x. c * f(x)) = c * sum s f`, REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; SUM_0] THEN REWRITE_TAC[sum] THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN SUBGOAL_THEN `support (+) (\x:A. c * f(x)) s = support (+) f s` SUBST1_TAC THENL [ASM_SIMP_TAC[support; REAL_ENTIRE; NEUTRAL_REAL_ADD]; ALL_TAC] THEN COND_CASES_TAC THEN REWRITE_TAC[NEUTRAL_REAL_ADD; REAL_MUL_RZERO] THEN UNDISCH_TAC `FINITE (support (+) f (s:A->bool))` THEN SPEC_TAC(`support (+) f (s:A->bool)`,`t:A->bool`) THEN REWRITE_TAC[GSYM sum] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_ADD_LDISTRIB]);; let SUM_RMUL = prove (`!f c s:A->bool. sum s (\x. f(x) * c) = sum s f * c`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[SUM_LMUL]);; let SUM_NEG = prove (`!f s. sum s (\x. --(f(x))) = --(sum s f)`, ONCE_REWRITE_TAC[REAL_ARITH `--x = --(&1) * x`] THEN SIMP_TAC[SUM_LMUL]);; let SUM_SUB = prove (`!f g s. FINITE s ==> (sum s (\x. f(x) - g(x)) = sum s f - sum s g)`, ONCE_REWRITE_TAC[real_sub] THEN SIMP_TAC[SUM_NEG; SUM_ADD]);; let SUM_LE = prove (`!f g s. FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) ==> sum s f <= sum s g`, ONCE_REWRITE_TAC[IMP_CONJ] THEN GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; REAL_LE_REFL; REAL_LE_ADD2; IN_INSERT]);; let SUM_LT = prove (`!f g s:A->bool. FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) /\ (?x. x IN s /\ f(x) < g(x)) ==> sum s f < sum s g`, REPEAT GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[SUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN ASM_SIMP_TAC[REAL_LTE_ADD2; SUM_LE; IN_DELETE; FINITE_DELETE]);; let SUM_LT_ALL = prove (`!f g s. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < g(x)) ==> sum s f < sum s g`, MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE; SUM_LT]);; let SUM_POS_LT = prove (`!f s:A->bool. FINITE s /\ (!x. x IN s ==> &0 <= f x) /\ (?x. x IN s /\ &0 < f x) ==> &0 < sum s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum (s:A->bool) (\i. &0)` THEN CONJ_TAC THENL [REWRITE_TAC[SUM_0; REAL_LE_REFL]; MATCH_MP_TAC SUM_LT] THEN ASM_MESON_TAC[]);; let SUM_POS_LT_ALL = prove (`!s f:A->real. FINITE s /\ ~(s = {}) /\ (!i. i IN s ==> &0 < f i) ==> &0 < sum s f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LT THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE]);; let SUM_EQ = prove (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (sum s f = sum s g)`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_ABS = prove (`!f s. FINITE(s) ==> abs(sum s f) <= sum s (\x. abs(f x))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; REAL_ABS_NUM; REAL_LE_REFL; REAL_ARITH `abs(a) <= b ==> abs(x + a) <= abs(x) + b`]);; let SUM_ABS_LE = prove (`!f:A->real g s. FINITE s /\ (!x. x IN s ==> abs(f x) <= g x) ==> abs(sum s f) <= sum s g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\x:A. abs(f x))` THEN ASM_SIMP_TAC[SUM_ABS] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[]);; let SUM_CONST = prove (`!c s. FINITE s ==> (sum s (\n. c) = &(CARD s) * c)`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; CARD_CLAUSES; GSYM REAL_OF_NUM_SUC] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC);; let SUM_POS_LE = prove (`!s:A->bool. (!x. x IN s ==> &0 <= f x) ==> &0 <= sum s f`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE {x:A | x IN s /\ ~(f x = &0)}` THEN ASM_SIMP_TAC[SUM_DEGENERATE; REAL_LE_REFL] THEN ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN MP_TAC(ISPECL [`\x:A. &0`; `f:A->real`; `{x:A | x IN s /\ ~(f x = &0)}`] SUM_LE) THEN ASM_SIMP_TAC[SUM_0; IN_ELIM_THM]);; let SUM_POS_BOUND = prove (`!f b s. FINITE s /\ (!x. x IN s ==> &0 <= f x) /\ sum s f <= b ==> !x:A. x IN s ==> f x <= b`, GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; NOT_IN_EMPTY; IN_INSERT] THEN MESON_TAC[SUM_POS_LE; REAL_ARITH `&0 <= x /\ &0 <= y /\ x + y <= b ==> x <= b /\ y <= b`]);; let SUM_POS_EQ_0 = prove (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f x) /\ (sum s f = &0) ==> !x. x IN s ==> f x = &0`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[SUM_POS_BOUND; SUM_POS_LE]);; let SUM_ZERO_EXISTS = prove (`!(u:A->real) s. FINITE s /\ sum s u = &0 ==> (!i. i IN s ==> u i = &0) \/ (?j k. j IN s /\ u j < &0 /\ k IN s /\ u k > &0)`, REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (MESON[REAL_ARITH `(&0 <= --u <=> ~(u > &0)) /\ (&0 <= u <=> ~(u < &0))`] `(?j k:A. j IN s /\ u j < &0 /\ k IN s /\ u k > &0) \/ (!i. i IN s ==> &0 <= u i) \/ (!i. i IN s ==> &0 <= --(u i))`) THEN ASM_REWRITE_TAC[] THEN DISJ1_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[REAL_ARITH `x = &0 <=> --x = &0`]] THEN MATCH_MP_TAC SUM_POS_EQ_0 THEN ASM_REWRITE_TAC[SUM_NEG; REAL_NEG_0]);; let SUM_DELETE = prove (`!f s a. FINITE s /\ a IN s ==> sum (s DELETE a) f = sum s f - f(a)`, SIMP_TAC[REAL_ARITH `y = z - x <=> x + y = z:real`; sum; ITERATE_DELETE; MONOIDAL_REAL_ADD]);; let SUM_DELETE_CASES = prove (`!f s a. FINITE s ==> sum (s DELETE a) f = if a IN s then sum s f - f(a) else sum s f`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> (s DELETE a = s)`; SUM_DELETE]);; let SUM_SING = prove (`!f x. sum {x} f = f(x)`, SIMP_TAC[SUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; REAL_ADD_RID]);; let SUM_DELTA = prove (`!s a. sum s (\x. if x = a:A then b else &0) = if a IN s then b else &0`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN SIMP_TAC[ITERATE_DELTA; MONOIDAL_REAL_ADD]);; let SUM_SWAP = prove (`!f:A->B->real s t. FINITE(s) /\ FINITE(t) ==> (sum s (\i. sum t (f i)) = sum t (\j. sum s (\i. f i j)))`, GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; SUM_0; SUM_ADD; ETA_AX]);; let SUM_IMAGE = prove (`!f g s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) ==> (sum (IMAGE f s) g = sum s (g o f))`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_SUPERSET = prove (`!f:A->real u v. u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = &0)) ==> (sum v f = sum u f)`, SIMP_TAC[sum; GSYM NEUTRAL_REAL_ADD; ITERATE_SUPERSET; MONOIDAL_REAL_ADD]);; let SUM_UNIV = prove (`!f:A->real s. support (+) f (:A) SUBSET s ==> sum s f = sum (:A) f`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_UNIV THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_UNION_RZERO = prove (`!f:A->real u v. FINITE u /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = &0)) ==> (sum (u UNION v) f = sum u f)`, let lemma = prove(`u UNION v = u UNION (v DIFF u)`,SET_TAC[]) in REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM_MESON_TAC[IN_UNION; IN_DIFF; SUBSET]);; let SUM_UNION_LZERO = prove (`!f:A->real u v. FINITE v /\ (!x. x IN u /\ ~(x IN v) ==> (f(x) = &0)) ==> (sum (u UNION v) f = sum v f)`, MESON_TAC[SUM_UNION_RZERO; UNION_COMM]);; let SUM_RESTRICT = prove (`!f s. FINITE s ==> (sum s (\x. if x IN s then f(x) else &0) = sum s f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]);; let SUM_BOUND = prove (`!s f b. FINITE s /\ (!x:A. x IN s ==> f(x) <= b) ==> sum s f <= &(CARD s) * b`, SIMP_TAC[GSYM SUM_CONST; SUM_LE]);; let SUM_BOUND_GEN = prove (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) <= b / &(CARD s)) ==> sum s f <= b`, MESON_TAC[SUM_BOUND; REAL_DIV_LMUL; REAL_OF_NUM_EQ; HAS_SIZE_0; HAS_SIZE]);; let SUM_ABS_BOUND = prove (`!s f b. FINITE s /\ (!x:A. x IN s ==> abs(f(x)) <= b) ==> abs(sum s f) <= &(CARD s) * b`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\x:A. abs(f x))` THEN ASM_SIMP_TAC[SUM_BOUND; SUM_ABS]);; let SUM_BOUND_LT = prove (`!s f b. FINITE s /\ (!x:A. x IN s ==> f x <= b) /\ (?x. x IN s /\ f x < b) ==> sum s f < &(CARD s) * b`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `sum s (\x:A. b)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LT THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ASM_SIMP_TAC[SUM_CONST; REAL_LE_REFL]]);; let SUM_BOUND_LT_ALL = prove (`!s f b. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < b) ==> sum s f < &(CARD s) * b`, MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE; SUM_BOUND_LT]);; let SUM_BOUND_LT_GEN = prove (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) < b / &(CARD s)) ==> sum s f < b`, MESON_TAC[SUM_BOUND_LT_ALL; REAL_DIV_LMUL; REAL_OF_NUM_EQ; HAS_SIZE_0; HAS_SIZE]);; let SUM_UNION_EQ = prove (`!s t u. FINITE u /\ (s INTER t = {}) /\ (s UNION t = u) ==> (sum s f + sum t f = sum u f)`, MESON_TAC[SUM_UNION; DISJOINT; FINITE_SUBSET; SUBSET_UNION]);; let SUM_EQ_SUPERSET = prove (`!f s t:A->bool. FINITE t /\ t SUBSET s /\ (!x. x IN t ==> (f x = g x)) /\ (!x. x IN s /\ ~(x IN t) ==> (f(x) = &0)) ==> (sum s f = sum t g)`, MESON_TAC[SUM_SUPERSET; SUM_EQ]);; let SUM_RESTRICT_SET = prove (`!P s f. sum {x | x IN s /\ P x} f = sum s (\x. if P x then f x else &0)`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC ITERATE_RESTRICT_SET THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_SUM_RESTRICT = prove (`!R f s t. FINITE s /\ FINITE t ==> (sum s (\x. sum {y | y IN t /\ R x y} (\y. f x y)) = sum t (\y. sum {x | x IN s /\ R x y} (\x. f x y)))`, REPEAT GEN_TAC THEN SIMP_TAC[SUM_RESTRICT_SET] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP SUM_SWAP th]));; let CARD_EQ_SUM = prove (`!s. FINITE s ==> (&(CARD s) = sum s (\x. &1))`, SIMP_TAC[SUM_CONST; REAL_MUL_RID]);; let SUM_MULTICOUNT_GEN = prove (`!R:A->B->bool s t k. FINITE s /\ FINITE t /\ (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k(j))) ==> (sum s (\i. &(CARD {j | j IN t /\ R i j})) = sum t (\i. &(k i)))`, REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum s (\i:A. sum {j:B | j IN t /\ R i j} (\j. &1))` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CARD_EQ_SUM; FINITE_RESTRICT]; FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP SUM_SUM_RESTRICT th]) THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT] THEN REWRITE_TAC[REAL_MUL_RID]]);; let SUM_MULTICOUNT = prove (`!R:A->B->bool s t k. FINITE s /\ FINITE t /\ (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k)) ==> (sum s (\i. &(CARD {j | j IN t /\ R i j})) = &(k * CARD t))`, REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum t (\i:B. &k)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_MULTICOUNT_GEN THEN ASM_REWRITE_TAC[]; ASM_SIMP_TAC[SUM_CONST; REAL_OF_NUM_MUL] THEN REWRITE_TAC[MULT_AC]]);; let SUM_IMAGE_GEN = prove (`!f:A->B g s. FINITE s ==> sum s g = sum (IMAGE f s) (\y. sum {x | x IN s /\ f x = y} g)`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_IMAGE_GEN THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_GROUP = prove (`!f:A->B g s t. FINITE s /\ IMAGE f s SUBSET t ==> sum t (\y. sum {x | x IN s /\ f(x) = y} g) = sum s g`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:A->B`; `g:A->real`; `s:A->bool`] SUM_IMAGE_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN ASM SET_TAC[]);; let SUM_GROUP_RELATION = prove (`!R:A->B->bool g s t. FINITE s /\ (!x. x IN s ==> ?!y. y IN t /\ R x y) ==> sum t (\y. sum {x | x IN s /\ R x y} g) = sum s g`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`\x:A. @y:B. y IN t /\ R x y`; `g:A->real`; `s:A->bool`; `t:B->bool`] SUM_GROUP) THEN ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN MATCH_MP_TAC SUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);; let REAL_OF_NUM_SUM = prove (`!f s. FINITE s ==> (&(nsum s f) = sum s (\x. &(f x)))`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; NSUM_CLAUSES; GSYM REAL_OF_NUM_ADD]);; let SUM_SUBSET = prove (`!u v f. FINITE u /\ FINITE v /\ (!x. x IN (u DIFF v) ==> f(x) <= &0) /\ (!x:A. x IN (v DIFF u) ==> &0 <= f(x)) ==> sum u f <= sum v f`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:A->real`; `u INTER v :A->bool`] SUM_UNION) THEN DISCH_THEN(fun th -> MP_TAC(SPEC `v DIFF u :A->bool` th) THEN MP_TAC(SPEC `u DIFF v :A->bool` th)) THEN REWRITE_TAC[SET_RULE `(u INTER v) UNION (u DIFF v) = u`; SET_RULE `(u INTER v) UNION (v DIFF u) = v`] THEN ASM_SIMP_TAC[FINITE_DIFF; FINITE_INTER] THEN REPEAT(ANTS_TAC THENL [SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ &0 <= y ==> a + x <= a + y`) THEN ASM_SIMP_TAC[GSYM SUM_NEG; FINITE_DIFF] THEN CONJ_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_DIFF; REAL_LE_RNEG; REAL_ADD_LID]);; let SUM_SUBSET_SIMPLE = prove (`!u v f. FINITE v /\ u SUBSET v /\ (!x:A. x IN (v DIFF u) ==> &0 <= f(x)) ==> sum u f <= sum v f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_SUBSET THEN ASM_MESON_TAC[IN_DIFF; SUBSET; FINITE_SUBSET]);; let SUM_MUL_BOUND = prove (`!a b s:A->bool. FINITE s /\ (!i. i IN s ==> &0 <= a i /\ &0 <= b i) ==> sum s (\i. a i * b i) <= sum s a * sum s b`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUM_SING] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[SING_SUBSET; IN_DIFF]);; let SUM_IMAGE_NONZERO = prove (`!d:B->real i:A->B s. FINITE s /\ (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = &0) ==> sum (IMAGE i s) d = sum s (d o i)`, REWRITE_TAC[GSYM NEUTRAL_REAL_ADD; sum] THEN MATCH_MP_TAC ITERATE_IMAGE_NONZERO THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_BIJECTION = prove (`!f p s:A->bool. (!x. x IN s ==> p(x) IN s) /\ (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) ==> sum s f = sum s (f o p)`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_BIJECTION THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_SUM_PRODUCT = prove (`!s:A->bool t:A->B->bool x. FINITE s /\ (!i. i IN s ==> FINITE(t i)) ==> sum s (\i. sum (t i) (x i)) = sum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_ITERATE_PRODUCT THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_EQ_GENERAL = prove (`!s:A->bool t:B->bool f g h. (!y. y IN t ==> ?!x. x IN s /\ h(x) = y) /\ (!x. x IN s ==> h(x) IN t /\ g(h x) = f x) ==> sum s f = sum t g`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_EQ_GENERAL_INVERSES = prove (`!s:A->bool t:B->bool f g h k. (!y. y IN t ==> k(y) IN s /\ h(k y) = y) /\ (!x. x IN s ==> h(x) IN t /\ k(h x) = x /\ g(h x) = f x) ==> sum s f = sum t g`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL_INVERSES THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_INJECTION = prove (`!f p s. FINITE s /\ (!x. x IN s ==> p x IN s) /\ (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) ==> sum s (f o p) = sum s f`, REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_INJECTION THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_UNION_NONZERO = prove (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = &0) ==> sum (s UNION t) f = sum s f + sum t f`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC ITERATE_UNION_NONZERO THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_UNIONS_NONZERO = prove (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\ (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 ==> f x = &0) ==> sum (UNIONS s) f = sum s (\t. sum t f)`, GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES; IN_INSERT] THEN MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[SUM_CLAUSES] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN STRIP_TAC THEN MATCH_MP_TAC SUM_UNION_NONZERO THEN ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);; let SUM_CASES = prove (`!s P f g. FINITE s ==> sum s (\x:A. if P x then f x else g x) = sum {x | x IN s /\ P x} f + sum {x | x IN s /\ ~P x} g`, REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN MATCH_MP_TAC ITERATE_CASES THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; let SUM_CASES_1 = prove (`!s a. FINITE s /\ a IN s ==> sum s (\x. if x = a then y else f(x)) = sum s f + (y - f a)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SUM_CASES] THEN ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE] THEN ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN REWRITE_TAC[SUM_SING] THEN REAL_ARITH_TAC);; let SUM_LE_INCLUDED = prove (`!f:A->real g:B->real s t i. FINITE s /\ FINITE t /\ (!y. y IN t ==> &0 <= g y) /\ (!x. x IN s ==> ?y. y IN t /\ i y = x /\ f(x) <= g(y)) ==> sum s f <= sum t g`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (IMAGE (i:B->A) t) (\y. sum {x | x IN t /\ i x = y} g)` THEN CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(GSYM SUM_IMAGE_GEN) THEN ASM_REWRITE_TAC[]] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum s (\y. sum {x | x IN t /\ (i:B->A) x = y} g)` THEN CONJ_TAC THENL [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:B` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum {y:B} g` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[SUM_SING]; ALL_TAC]; ALL_TAC] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM_SIMP_TAC[SUM_POS_LE; FINITE_RESTRICT; IN_ELIM_THM] THEN ASM SET_TAC[]);; let SUM_IMAGE_LE = prove (`!f:A->B g s. FINITE s /\ (!x. x IN s ==> &0 <= g(f x)) ==> sum (IMAGE f s) g <= sum s (g o f)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[o_THM] THEN EXISTS_TAC `f:A->B` THEN MESON_TAC[REAL_LE_REFL]);; let SUM_CLOSED = prove (`!P f:A->real s. P(&0) /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!a. a IN s ==> P(f a)) ==> P(sum s f)`, REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_REAL_ADD) THEN DISCH_THEN(MP_TAC o SPEC `P:real->bool`) THEN ASM_SIMP_TAC[NEUTRAL_REAL_ADD; GSYM sum]);; let REAL_OF_NUM_SUM_GEN = prove (`!f s:A->bool. FINITE {i | i IN s /\ ~(f i = 0)} ==> &(nsum s f) = sum s (\x. &(f x))`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUM_SUPPORT; GSYM NSUM_SUPPORT] THEN REWRITE_TAC[support; NEUTRAL_ADD; NEUTRAL_REAL_ADD; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[REAL_OF_NUM_SUM]);; (* ------------------------------------------------------------------------- *) (* Specialize them to sums over intervals of numbers. *) (* ------------------------------------------------------------------------- *) let SUM_ADD_NUMSEG = prove (`!f g m n. sum(m..n) (\i. f(i) + g(i)) = sum(m..n) f + sum(m..n) g`, SIMP_TAC[SUM_ADD; FINITE_NUMSEG]);; let SUM_SUB_NUMSEG = prove (`!f g m n. sum(m..n) (\i. f(i) - g(i)) = sum(m..n) f - sum(m..n) g`, SIMP_TAC[SUM_SUB; FINITE_NUMSEG]);; let SUM_LE_NUMSEG = prove (`!f g m n. (!i. m <= i /\ i <= n ==> f(i) <= g(i)) ==> sum(m..n) f <= sum(m..n) g`, SIMP_TAC[SUM_LE; FINITE_NUMSEG; IN_NUMSEG]);; let SUM_EQ_NUMSEG = prove (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) ==> (sum(m..n) f = sum(m..n) g)`, MESON_TAC[SUM_EQ; FINITE_NUMSEG; IN_NUMSEG]);; let SUM_ABS_NUMSEG = prove (`!f m n. abs(sum(m..n) f) <= sum(m..n) (\i. abs(f i))`, SIMP_TAC[SUM_ABS; FINITE_NUMSEG]);; let SUM_CONST_NUMSEG = prove (`!c m n. sum(m..n) (\n. c) = &((n + 1) - m) * c`, SIMP_TAC[SUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);; let SUM_EQ_0_NUMSEG = prove (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = &0)) ==> (sum(m..n) f = &0)`, SIMP_TAC[SUM_EQ_0; IN_NUMSEG]);; let SUM_TRIV_NUMSEG = prove (`!f m n. n < m ==> (sum(m..n) f = &0)`, MESON_TAC[SUM_EQ_0_NUMSEG; LE_TRANS; NOT_LT]);; let SUM_POS_LE_NUMSEG = prove (`!m n f. (!p. m <= p /\ p <= n ==> &0 <= f(p)) ==> &0 <= sum(m..n) f`, SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; IN_NUMSEG]);; let SUM_POS_EQ_0_NUMSEG = prove (`!f m n. (!p. m <= p /\ p <= n ==> &0 <= f(p)) /\ (sum(m..n) f = &0) ==> !p. m <= p /\ p <= n ==> (f(p) = &0)`, MESON_TAC[SUM_POS_EQ_0; FINITE_NUMSEG; IN_NUMSEG]);; let SUM_SING_NUMSEG = prove (`!f n. sum(n..n) f = f(n)`, SIMP_TAC[SUM_SING; NUMSEG_SING]);; let SUM_CLAUSES_NUMSEG = prove (`(!m. sum(m..0) f = if m = 0 then f(0) else &0) /\ (!m n. sum(m..SUC n) f = if m <= SUC n then sum(m..n) f + f(SUC n) else sum(m..n) f)`, MP_TAC(MATCH_MP ITERATE_CLAUSES_NUMSEG MONOIDAL_REAL_ADD) THEN REWRITE_TAC[NEUTRAL_REAL_ADD; sum]);; let SUM_SWAP_NUMSEG = prove (`!a b c d f. sum(a..b) (\i. sum(c..d) (f i)) = sum(c..d) (\j. sum(a..b) (\i. f i j))`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);; let SUM_ADD_SPLIT = prove (`!f m n p. m <= n + 1 ==> (sum (m..(n+p)) f = sum(m..n) f + sum(n+1..n+p) f)`, SIMP_TAC[NUMSEG_ADD_SPLIT; SUM_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; ARITH_RULE `x < x + 1`]);; let SUM_OFFSET = prove (`!p f m n. sum(m+p..n+p) f = sum(m..n) (\i. f(i + p))`, SIMP_TAC[NUMSEG_OFFSET_IMAGE; SUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN REWRITE_TAC[o_DEF]);; let SUM_OFFSET_0 = prove (`!f m n. m <= n ==> (sum(m..n) f = sum(0..n-m) (\i. f(i + m)))`, SIMP_TAC[GSYM SUM_OFFSET; ADD_CLAUSES; SUB_ADD]);; let SUM_CLAUSES_LEFT = prove (`!f m n. m <= n ==> sum(m..n) f = f(m) + sum(m+1..n) f`, SIMP_TAC[GSYM NUMSEG_LREC; SUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; let SUM_CLAUSES_RIGHT = prove (`!f m n. 0 < n /\ m <= n ==> sum(m..n) f = sum(m..n-1) f + f(n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[LT_REFL; SUM_CLAUSES_NUMSEG; SUC_SUB1]);; let SUM_PAIR = prove (`!f m n. sum(2*m..2*n+1) f = sum(m..n) (\i. f(2*i) + f(2*i+1))`, MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_REAL_ADD) THEN REWRITE_TAC[sum; NEUTRAL_REAL_ADD]);; let SUM_REFLECT = prove (`!x m n. sum(m..n) x = if n < m then &0 else sum(0..n-m) (\i. x(n - i))`, REPEAT GEN_TAC THEN REWRITE_TAC[sum] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP ITERATE_REFLECT MONOIDAL_REAL_ADD] THEN REWRITE_TAC[NEUTRAL_REAL_ADD]);; let REAL_OF_NUM_SUM_NUMSEG = prove (`!f m n. (&(nsum(m..n) f) = sum (m..n) (\i. &(f i)))`, SIMP_TAC[REAL_OF_NUM_SUM; FINITE_NUMSEG]);; (* ------------------------------------------------------------------------- *) (* Partial summation and other theorems specific to number segments. *) (* ------------------------------------------------------------------------- *) let SUM_PARTIAL_SUC = prove (`!f g m n. sum (m..n) (\k. f(k) * (g(k + 1) - g(k))) = if m <= n then f(n + 1) * g(n + 1) - f(m) * g(m) - sum (m..n) (\k. g(k + 1) * (f(k + 1) - f(k))) else &0`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SUM_TRIV_NUMSEG; GSYM NOT_LE] THEN ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THENL [COND_CASES_TAC THEN ASM_SIMP_TAC[] THENL [REAL_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN ASM_SIMP_TAC[GSYM NOT_LT; SUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN REAL_ARITH_TAC);; let SUM_PARTIAL_PRE = prove (`!f g m n. sum (m..n) (\k. f(k) * (g(k) - g(k - 1))) = if m <= n then f(n + 1) * g(n) - f(m) * g(m - 1) - sum (m..n) (\k. g k * (f(k + 1) - f(k))) else &0`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:num->real`; `\k. (g:num->real)(k - 1)`; `m:num`; `n:num`] SUM_PARTIAL_SUC) THEN REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[]);; let SUM_DIFFS = prove (`!m n. sum(m..n) (\k. f(k) - f(k + 1)) = if m <= n then f(m) - f(n + 1) else &0`, ONCE_REWRITE_TAC[REAL_ARITH `a - b = -- &1 * (b - a)`] THEN ONCE_REWRITE_TAC[SUM_PARTIAL_SUC] THEN REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0] THEN REAL_ARITH_TAC);; let SUM_DIFFS_ALT = prove (`!m n. sum(m..n) (\k. f(k + 1) - f(k)) = if m <= n then f(n + 1) - f(m) else &0`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN SIMP_TAC[SUM_NEG; SUM_DIFFS] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_NEG_0]);; let SUM_COMBINE_R = prove (`!f m n p. m <= n + 1 /\ n <= p ==> sum(m..n) f + sum(n+1..p) f = sum(m..p) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_UNION_EQ THEN REWRITE_TAC[FINITE_NUMSEG; EXTENSION; IN_INTER; IN_UNION; NOT_IN_EMPTY; IN_NUMSEG] THEN ASM_ARITH_TAC);; let SUM_COMBINE_L = prove (`!f m n p. 0 < n /\ m <= n /\ n <= p + 1 ==> sum(m..n-1) f + sum(n..p) f = sum(m..p) f`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_UNION_EQ THEN REWRITE_TAC[FINITE_NUMSEG; EXTENSION; IN_INTER; IN_UNION; NOT_IN_EMPTY; IN_NUMSEG] THEN ASM_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Extend congruences to deal with sum. Note that we must have the eta *) (* redex or we'll get a loop since f(x) will lambda-reduce recursively. *) (* ------------------------------------------------------------------------- *) let th = prove (`(!f g s. (!x. x IN s ==> f(x) = g(x)) ==> sum s (\i. f(i)) = sum s g) /\ (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) ==> sum(a..b) (\i. f(i)) = sum(a..b) g) /\ (!f g p. (!x. p x ==> f x = g x) ==> sum {y | p y} (\i. f(i)) = sum {y | p y} g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; (* ------------------------------------------------------------------------- *) (* Expand "sum (m..n) f" where m and n are numerals. *) (* ------------------------------------------------------------------------- *) let EXPAND_SUM_CONV = let [pth_0; pth_1; pth_2] = (CONJUNCTS o prove) (`(n < m ==> sum(m..n) f = &0) /\ sum(m..m) f = f m /\ (m <= n ==> sum (m..n) f = f m + sum (m + 1..n) f)`, REWRITE_TAC[SUM_CLAUSES_LEFT; SUM_SING_NUMSEG; SUM_TRIV_NUMSEG]) and ns_tm = `..` and f_tm = `f:num->real` and m_tm = `m:num` and n_tm = `n:num` in let rec conv tm = let smn,ftm = dest_comb tm in let s,mn = dest_comb smn in if not(is_const s && fst(dest_const s) = "sum") then failwith "EXPAND_SUM_CONV" else let mtm,ntm = dest_binop ns_tm mn in let m = dest_numeral mtm and n = dest_numeral ntm in if n < m then let th1 = INST [ftm,f_tm; mtm,m_tm; ntm,n_tm] pth_0 in MP th1 (EQT_ELIM(NUM_LT_CONV(lhand(concl th1)))) else if n = m then CONV_RULE (RAND_CONV(TRY_CONV BETA_CONV)) (INST [ftm,f_tm; mtm,m_tm] pth_1) else let th1 = INST [ftm,f_tm; mtm,m_tm; ntm,n_tm] pth_2 in let th2 = MP th1 (EQT_ELIM(NUM_LE_CONV(lhand(concl th1)))) in CONV_RULE (RAND_CONV(COMB2_CONV (RAND_CONV(TRY_CONV BETA_CONV)) (LAND_CONV(LAND_CONV NUM_ADD_CONV) THENC conv))) th2 in conv;; (* ------------------------------------------------------------------------- *) (* Some special algebraic rearrangements. *) (* ------------------------------------------------------------------------- *) let REAL_SUB_POW = prove (`!x y n. 1 <= n ==> x pow n - y pow n = (x - y) * sum(0..n-1) (\i. x pow i * y pow (n - 1 - i))`, REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_ARITH `(x - y) * (a * b):real = (x * a) * b - a * (y * b)`] THEN SIMP_TAC[GSYM real_pow; ADD1; ARITH_RULE `1 <= n /\ x <= n - 1 ==> n - 1 - x = n - (x + 1) /\ SUC(n - 1 - x) = n - x`] THEN REWRITE_TAC[SUM_DIFFS_ALT; LE_0] THEN SIMP_TAC[SUB_0; SUB_ADD; SUB_REFL; real_pow; REAL_MUL_LID; REAL_MUL_RID]);; let REAL_SUB_POW_R1 = prove (`!x n. 1 <= n ==> x pow n - &1 = (x - &1) * sum(0..n-1) (\i. x pow i)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`x:real`; `&1`] o MATCH_MP REAL_SUB_POW) THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID]);; let REAL_SUB_POW_L1 = prove (`!x n. 1 <= n ==> &1 - x pow n = (&1 - x) * sum(0..n-1) (\i. x pow i)`, ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN SIMP_TAC[REAL_SUB_POW_R1] THEN REWRITE_TAC[REAL_MUL_LNEG]);; (* ------------------------------------------------------------------------- *) (* Some useful facts about real polynomial functions. *) (* ------------------------------------------------------------------------- *) let REAL_SUB_POLYFUN = prove (`!a x y n. 1 <= n ==> sum(0..n) (\i. a i * x pow i) - sum(0..n) (\i. a i * y pow i) = (x - y) * sum(0..n-1) (\j. sum(j+1..n) (\i. a i * y pow (i - j - 1)) * x pow j)`, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG; GSYM REAL_SUB_LDISTRIB] THEN GEN_REWRITE_TAC LAND_CONV [MATCH_MP SUM_CLAUSES_LEFT (SPEC_ALL LE_0)] THEN REWRITE_TAC[REAL_SUB_REFL; real_pow; REAL_MUL_RZERO; REAL_ADD_LID] THEN SIMP_TAC[REAL_SUB_POW; ADD_CLAUSES] THEN ONCE_REWRITE_TAC[REAL_ARITH `a * x * s:real = x * a * s`] THEN REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL; SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN REPEAT(EXISTS_TAC `\(x:num,y:num). (y,x)`) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN REWRITE_TAC[ARITH_RULE `a - b - c:num = a - (b + c)`; ADD_SYM] THEN REWRITE_TAC[REAL_MUL_AC] THEN ARITH_TAC);; let REAL_SUB_POLYFUN_ALT = prove (`!a x y n. 1 <= n ==> sum(0..n) (\i. a i * x pow i) - sum(0..n) (\i. a i * y pow i) = (x - y) * sum(0..n-1) (\j. sum(0..n-j-1) (\k. a(j+k+1) * y pow k) * x pow j)`, REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_SUB_POLYFUN] THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN MAP_EVERY EXISTS_TAC [`\i. i - (j + 1)`; `\k. j + k + 1`] THEN REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN TRY(BINOP_TAC THEN AP_TERM_TAC) THEN ASM_ARITH_TAC);; let REAL_POLYFUN_ROOTBOUND = prove (`!n c. ~(!i. i IN 0..n ==> c i = &0) ==> FINITE {x | sum(0..n) (\i. c i * x pow i) = &0} /\ CARD {x | sum(0..n) (\i. c i * x pow i) = &0} <= n`, REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN INDUCT_TAC THENL [REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2; SUM_CLAUSES_NUMSEG] THEN SIMP_TAC[real_pow; REAL_MUL_RID; EMPTY_GSPEC; CARD_CLAUSES; FINITE_EMPTY; LE_REFL]; X_GEN_TAC `c:num->real` THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN ASM_CASES_TAC `(c:num->real) (SUC n) = &0` THENL [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; REAL_MUL_LZERO; REAL_ADD_RID] THEN REWRITE_TAC[LE; LEFT_OR_DISTRIB] THEN DISJ2_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_NUMSEG; LE]; ASM_CASES_TAC `{x | sum (0..SUC n) (\i. c i * x pow i) = &0} = {}` THEN ASM_REWRITE_TAC[FINITE_RULES; CARD_CLAUSES; LE_0] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN DISCH_TAC THEN MP_TAC(GEN `x:real` (ISPECL [`c:num->real`; `x:real`; `r:real`; `SUC n`] REAL_SUB_POLYFUN)) THEN ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; REAL_SUB_RZERO] THEN DISCH_THEN(fun th -> REWRITE_TAC[th; REAL_ENTIRE; REAL_SUB_0]) THEN REWRITE_TAC[SET_RULE `{x | x = c \/ P x} = c INSERT {x | P x}`] THEN MATCH_MP_TAC(MESON[FINITE_INSERT; CARD_CLAUSES; ARITH_RULE `x <= n ==> SUC x <= SUC n /\ x <= SUC n`] `FINITE s /\ CARD s <= n ==> FINITE(r INSERT s) /\ CARD(r INSERT s) <= SUC n`) THEN REWRITE_TAC[SUC_SUB1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG; ADD1; LE_REFL; LE_0] THEN REWRITE_TAC[SUM_SING_NUMSEG; ARITH_RULE `(n + 1) - n - 1 = 0`] THEN ASM_REWRITE_TAC[GSYM ADD1; real_pow; REAL_MUL_RID]]]);; let REAL_POLYFUN_FINITE_ROOTS = prove (`!n c. FINITE {x | sum(0..n) (\i. c i * x pow i) = &0} <=> ?i. i IN 0..n /\ ~(c i = &0)`, REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `a /\ ~b <=> ~(a ==> b)`] THEN REWRITE_TAC[GSYM NOT_FORALL_THM] THEN EQ_TAC THEN SIMP_TAC[REAL_POLYFUN_ROOTBOUND] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[REAL_MUL_LZERO; SUM_0] THEN REWRITE_TAC[SET_RULE `{x | T} = (:real)`; real_INFINITE; GSYM INFINITE]);; let REAL_POLYFUN_EQ_0 = prove (`!n c. (!x. sum(0..n) (\i. c i * x pow i) = &0) <=> (!i. i IN 0..n ==> c i = &0)`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_POLYFUN_ROOTBOUND) THEN ASM_REWRITE_TAC[real_INFINITE; GSYM INFINITE; DE_MORGAN_THM; SET_RULE `{x | T} = (:real)`]; ASM_SIMP_TAC[IN_NUMSEG; LE_0; REAL_MUL_LZERO; SUM_0]]);; let REAL_POLYFUN_EQ_CONST = prove (`!n c k. (!x. sum(0..n) (\i. c i * x pow i) = k) <=> c 0 = k /\ (!i. i IN 1..n ==> c i = &0)`, REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `!x. sum(0..n) (\i. (if i = 0 then c 0 - k else c i) * x pow i) = &0` THEN CONJ_TAC THENL [SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; real_pow; REAL_MUL_RID] THEN REWRITE_TAC[REAL_ARITH `(c - k) + s = &0 <=> c + s = k`] THEN AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]; REWRITE_TAC[REAL_POLYFUN_EQ_0; IN_NUMSEG; LE_0] THEN GEN_REWRITE_TAC LAND_CONV [MESON[] `(!n. P n) <=> P 0 /\ (!n. ~(n = 0) ==> P n)`] THEN SIMP_TAC[LE_0; REAL_SUB_0] THEN MESON_TAC[LE_1]]);; (* ------------------------------------------------------------------------- *) (* A general notion of polynomial function. *) (* ------------------------------------------------------------------------- *) let polynomial_function = new_definition `polynomial_function p <=> ?m c. !x. p x = sum(0..m) (\i. c i * x pow i)`;; let POLYNOMIAL_FUNCTION_CONST = prove (`!c. polynomial_function (\x. c)`, GEN_TAC THEN REWRITE_TAC[polynomial_function] THEN MAP_EVERY EXISTS_TAC [`0`; `(\i. c):num->real`] THEN REWRITE_TAC[SUM_SING_NUMSEG; real_pow; REAL_MUL_RID]);; let POLYNOMIAL_FUNCTION_ID = prove (`polynomial_function (\x. x)`, REWRITE_TAC[polynomial_function] THEN MAP_EVERY EXISTS_TAC [`SUC 0`; `\i. if i = 1 then &1 else &0`] THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; ARITH] THEN REAL_ARITH_TAC);; let POLYNOMIAL_FUNCTION_I = prove (`polynomial_function I`, REWRITE_TAC[I_DEF; POLYNOMIAL_FUNCTION_ID]);; let POLYNOMIAL_FUNCTION_ADD = prove (`!p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (\x. p x + q x)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; polynomial_function; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`m:num`; `a:num->real`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`n:num`; `b:num->real`] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `MAX m n` THEN EXISTS_TAC `\i:num. (if i <= m then a i else &0) + (if i <= n then b i else &0)` THEN GEN_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG] THEN REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN BINOP_TAC THEN BINOP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN ARITH_TAC);; let POLYNOMIAL_FUNCTION_LMUL = prove (`!p c. polynomial_function p ==> polynomial_function (\x. c * p x)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; polynomial_function; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`] THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`n:num`; `\i. c * (a:num->real) i`] THEN ASM_REWRITE_TAC[SUM_LMUL; GSYM REAL_MUL_ASSOC]);; let POLYNOMIAL_FUNCTION_RMUL = prove (`!p c. polynomial_function p ==> polynomial_function (\x. p x * c)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[POLYNOMIAL_FUNCTION_LMUL]);; let POLYNOMIAL_FUNCTION_NEG = prove (`!p. polynomial_function(\x. --(p x)) <=> polynomial_function p`, GEN_TAC THEN EQ_TAC THEN DISCH_THEN(MP_TAC o SPEC `--(&1)` o MATCH_MP POLYNOMIAL_FUNCTION_LMUL) THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID; ETA_AX; REAL_NEG_NEG]);; let POLYNOMIAL_FUNCTION_SUB = prove (`!p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (\x. p x - q x)`, SIMP_TAC[real_sub; POLYNOMIAL_FUNCTION_NEG; POLYNOMIAL_FUNCTION_ADD]);; let POLYNOMIAL_FUNCTION_MUL = prove (`!p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (\x. p x * q x)`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV) [polynomial_function] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!q m c. P q m c) <=> (!m c q. P q m c)`] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN INDUCT_TAC THEN ASM_SIMP_TAC[SUM_SING_NUMSEG; real_pow; POLYNOMIAL_FUNCTION_RMUL] THEN X_GEN_TAC `c:num->real` THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ADD1] THEN REWRITE_TAC[REAL_ADD_LDISTRIB; real_pow] THEN MATCH_MP_TAC POLYNOMIAL_FUNCTION_ADD THEN ASM_SIMP_TAC[POLYNOMIAL_FUNCTION_RMUL] THEN REWRITE_TAC[SPEC `1` SUM_OFFSET] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_ASSOC; SUM_RMUL] THEN FIRST_X_ASSUM(MP_TAC o SPEC `\i. (c:num->real)(i + 1)`) THEN ABBREV_TAC `q = \x. p x * sum (0..m) (\i. c (i + 1) * x pow i)` THEN RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[polynomial_function; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`] THEN STRIP_TAC THEN EXISTS_TAC `n + 1` THEN EXISTS_TAC `\i. if i = 0 then &0 else (a:num->real)(i - 1)` THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN ASM_REWRITE_TAC[SPEC `1` SUM_OFFSET; ADD_EQ_0; ARITH_EQ; ADD_SUB] THEN REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; SUM_RMUL] THEN REAL_ARITH_TAC);; let POLYNOMIAL_FUNCTION_SUM = prove (`!s:A->bool p. FINITE s /\ (!i. i IN s ==> polynomial_function(\x. p x i)) ==> polynomial_function (\x. sum s (p x))`, REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES; POLYNOMIAL_FUNCTION_CONST] THEN SIMP_TAC[FORALL_IN_INSERT; POLYNOMIAL_FUNCTION_ADD]);; let POLYNOMIAL_FUNCTION_POW = prove (`!p n. polynomial_function p ==> polynomial_function (\x. p x pow n)`, REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_pow; POLYNOMIAL_FUNCTION_CONST; POLYNOMIAL_FUNCTION_MUL]);; let POLYNOMIAL_FUNCTION_INDUCT = prove (`!P. P (\x. x) /\ (!c. P (\x. c)) /\ (!p q. P p /\ P q ==> P (\x. p x + q x)) /\ (!p q. P p /\ P q ==> P (\x. p x * q x)) ==> !p. polynomial_function p ==> P p`, GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[polynomial_function; LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[MESON[] `(!q m c. P q m c) <=> (!m c q. P q m c)`] THEN ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG; real_pow] THEN GEN_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; ADD1; LE_0] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[real_pow] THEN REWRITE_TAC[SPEC `1` SUM_OFFSET] THEN REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_ASSOC; SUM_RMUL] THEN ASM_SIMP_TAC[]);; let POLYNOMIAL_FUNCTION_o = prove (`!p q. polynomial_function p /\ polynomial_function q ==> polynomial_function (p o q)`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ_ALT; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC POLYNOMIAL_FUNCTION_INDUCT THEN SIMP_TAC[o_DEF; POLYNOMIAL_FUNCTION_ADD; POLYNOMIAL_FUNCTION_MUL] THEN ASM_REWRITE_TAC[ETA_AX; POLYNOMIAL_FUNCTION_CONST]);; let POLYNOMIAL_FUNCTION_FINITE_ROOTS = prove (`!p a. polynomial_function p ==> (FINITE {x | p x = a} <=> ~(!x. p x = a))`, ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN SUBGOAL_THEN `!p. polynomial_function p ==> (FINITE {x | p x = &0} <=> ~(!x. p x = &0))` (fun th -> SIMP_TAC[th; POLYNOMIAL_FUNCTION_SUB; POLYNOMIAL_FUNCTION_CONST]) THEN GEN_TAC THEN REWRITE_TAC[polynomial_function] THEN STRIP_TAC THEN EQ_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THENL [SIMP_TAC[UNIV_GSPEC; GSYM INFINITE; real_INFINITE]; ASM_REWRITE_TAC[REAL_POLYFUN_FINITE_ROOTS] THEN SIMP_TAC[NOT_EXISTS_THM; TAUT `~(p /\ ~q) <=> p ==> q`] THEN REWRITE_TAC[REAL_MUL_LZERO; SUM_0]]);; (* ------------------------------------------------------------------------- *) (* Make natural numbers the default again. *) (* ------------------------------------------------------------------------- *) prioritize_num();; hol-light/lib.ml000066400000000000000000000713761303454263000140630ustar00rootroot00000000000000(* ========================================================================= *) (* Convenient library functions. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) let fail() = failwith "";; (* ------------------------------------------------------------------------- *) (* Combinators. *) (* ------------------------------------------------------------------------- *) let curry f x y = f(x,y);; let uncurry f(x,y) = f x y;; let I x = x;; let K x y = x;; let C f x y = f y x;; let W f x = f x x;; let (o) = fun f g x -> f(g x);; let (F_F) = fun f g (x,y) -> (f x,g y);; (* ------------------------------------------------------------------------- *) (* List basics. *) (* ------------------------------------------------------------------------- *) let hd l = match l with h::t -> h | _ -> failwith "hd";; let tl l = match l with h::t -> t | _ -> failwith "tl";; let map f = let rec mapf l = match l with [] -> [] | (x::t) -> let y = f x in y::(mapf t) in mapf;; let rec last l = match l with [x] -> x | (h::t) -> last t | [] -> failwith "last";; let rec butlast l = match l with [_] -> [] | (h::t) -> h::(butlast t) | [] -> failwith "butlast";; let rec el n l = if n = 0 then hd l else el (n - 1) (tl l);; let rev = let rec rev_append acc l = match l with [] -> acc | h::t -> rev_append (h::acc) t in fun l -> rev_append [] l;; let rec map2 f l1 l2 = match (l1,l2) with [],[] -> [] | (h1::t1),(h2::t2) -> let h = f h1 h2 in h::(map2 f t1 t2) | _ -> failwith "map2: length mismatch";; (* ------------------------------------------------------------------------- *) (* Attempting function or predicate applications. *) (* ------------------------------------------------------------------------- *) let can f x = try (f x; true) with Failure _ -> false;; let check p x = if p x then x else failwith "check";; (* ------------------------------------------------------------------------- *) (* Repetition of a function. *) (* ------------------------------------------------------------------------- *) let rec funpow n f x = if n < 1 then x else funpow (n-1) f (f x);; let rec repeat f x = try let y = f x in repeat f y with Failure _ -> x;; (* ------------------------------------------------------------------------- *) (* To avoid consing in various situations, we propagate this exception. *) (* I should probably eliminate this and use pointer EQ tests instead. *) (* ------------------------------------------------------------------------- *) exception Unchanged;; (* ------------------------------------------------------------------------- *) (* Various versions of list iteration. *) (* ------------------------------------------------------------------------- *) let rec itlist f l b = match l with [] -> b | (h::t) -> f h (itlist f t b);; let rec rev_itlist f l b = match l with [] -> b | (h::t) -> rev_itlist f t (f h b);; let rec end_itlist f l = match l with [] -> failwith "end_itlist" | [x] -> x | (h::t) -> f h (end_itlist f t);; let rec itlist2 f l1 l2 b = match (l1,l2) with ([],[]) -> b | (h1::t1,h2::t2) -> f h1 h2 (itlist2 f t1 t2 b) | _ -> failwith "itlist2";; let rec rev_itlist2 f l1 l2 b = match (l1,l2) with ([],[]) -> b | (h1::t1,h2::t2) -> rev_itlist2 f t1 t2 (f h1 h2 b) | _ -> failwith "rev_itlist2";; (* ------------------------------------------------------------------------- *) (* Iterative splitting (list) and stripping (tree) via destructor. *) (* ------------------------------------------------------------------------- *) let rec splitlist dest x = try let l,r = dest x in let ls,res = splitlist dest r in (l::ls,res) with Failure _ -> ([],x);; let rev_splitlist dest = let rec rsplist ls x = try let l,r = dest x in rsplist (r::ls) l with Failure _ -> (x,ls) in fun x -> rsplist [] x;; let striplist dest = let rec strip x acc = try let l,r = dest x in strip l (strip r acc) with Failure _ -> x::acc in fun x -> strip x [];; (* ------------------------------------------------------------------------- *) (* Apply a destructor as many times as elements in list. *) (* ------------------------------------------------------------------------- *) let rec nsplit dest clist x = if clist = [] then [],x else let l,r = dest x in let ll,y = nsplit dest (tl clist) r in l::ll,y;; (* ------------------------------------------------------------------------- *) (* Replication and sequences. *) (* ------------------------------------------------------------------------- *) let rec replicate x n = if n < 1 then [] else x::(replicate x (n - 1));; let rec (--) = fun m n -> if m > n then [] else m::((m + 1) -- n);; (* ------------------------------------------------------------------------- *) (* Various useful list operations. *) (* ------------------------------------------------------------------------- *) let rec forall p l = match l with [] -> true | h::t -> p(h) && forall p t;; let rec forall2 p l1 l2 = match (l1,l2) with [],[] -> true | (h1::t1,h2::t2) -> p h1 h2 && forall2 p t1 t2 | _ -> false;; let rec exists p l = match l with [] -> false | h::t -> p(h) || exists p t;; let length = let rec len k l = if l = [] then k else len (k + 1) (tl l) in fun l -> len 0 l;; let rec filter p l = match l with [] -> l | h::t -> let t' = filter p t in if p(h) then if t'==t then l else h::t' else t';; let rec partition p l = match l with [] -> [],l | h::t -> let yes,no = partition p t in if p(h) then (if yes == t then l,[] else h::yes,no) else (if no == t then [],l else yes,h::no);; let rec mapfilter f l = match l with [] -> [] | (h::t) -> let rest = mapfilter f t in try (f h)::rest with Failure _ -> rest;; let rec find p l = match l with [] -> failwith "find" | (h::t) -> if p(h) then h else find p t;; let rec tryfind f l = match l with [] -> failwith "tryfind" | (h::t) -> try f h with Failure _ -> tryfind f t;; let flat l = itlist (@) l [];; let rec remove p l = match l with [] -> failwith "remove" | (h::t) -> if p(h) then h,t else let y,n = remove p t in y,h::n;; let rec chop_list n l = if n = 0 then [],l else try let m,l' = chop_list (n-1) (tl l) in (hd l)::m,l' with Failure _ -> failwith "chop_list";; let index x = let rec ind n l = match l with [] -> failwith "index" | (h::t) -> if Pervasives.compare x h = 0 then n else ind (n + 1) t in ind 0;; (* ------------------------------------------------------------------------- *) (* "Set" operations on lists. *) (* ------------------------------------------------------------------------- *) let rec mem x lis = match lis with [] -> false | (h::t) -> Pervasives.compare x h = 0 || mem x t;; let insert x l = if mem x l then l else x::l;; let union l1 l2 = itlist insert l1 l2;; let unions l = itlist union l [];; let intersect l1 l2 = filter (fun x -> mem x l2) l1;; let subtract l1 l2 = filter (fun x -> not (mem x l2)) l1;; let subset l1 l2 = forall (fun t -> mem t l2) l1;; let set_eq l1 l2 = subset l1 l2 && subset l2 l1;; (* ------------------------------------------------------------------------- *) (* Association lists. *) (* ------------------------------------------------------------------------- *) let rec assoc a l = match l with (x,y)::t -> if Pervasives.compare x a = 0 then y else assoc a t | [] -> failwith "find";; let rec rev_assoc a l = match l with (x,y)::t -> if Pervasives.compare y a = 0 then x else rev_assoc a t | [] -> failwith "find";; (* ------------------------------------------------------------------------- *) (* Zipping, unzipping etc. *) (* ------------------------------------------------------------------------- *) let rec zip l1 l2 = match (l1,l2) with ([],[]) -> [] | (h1::t1,h2::t2) -> (h1,h2)::(zip t1 t2) | _ -> failwith "zip";; let rec unzip = function [] -> [],[] | ((a,b)::rest) -> let alist,blist = unzip rest in (a::alist,b::blist);; (* ------------------------------------------------------------------------- *) (* Sharing out a list according to pattern in list-of-lists. *) (* ------------------------------------------------------------------------- *) let rec shareout pat all = if pat = [] then [] else let l,r = chop_list (length (hd pat)) all in l::(shareout (tl pat) r);; (* ------------------------------------------------------------------------- *) (* Iterating functions over lists. *) (* ------------------------------------------------------------------------- *) let rec do_list f l = match l with [] -> () | (h::t) -> (f h; do_list f t);; (* ------------------------------------------------------------------------- *) (* Sorting. *) (* ------------------------------------------------------------------------- *) let rec sort cmp lis = match lis with [] -> [] | piv::rest -> let r,l = partition (cmp piv) rest in (sort cmp l) @ (piv::(sort cmp r));; (* ------------------------------------------------------------------------- *) (* Removing adjacent (NB!) equal elements from list. *) (* ------------------------------------------------------------------------- *) let rec uniq l = match l with x::(y::_ as t) -> let t' = uniq t in if Pervasives.compare x y = 0 then t' else if t'==t then l else x::t' | _ -> l;; (* ------------------------------------------------------------------------- *) (* Convert list into set by eliminating duplicates. *) (* ------------------------------------------------------------------------- *) let setify s = uniq (sort (fun x y -> Pervasives.compare x y <= 0) s);; (* ------------------------------------------------------------------------- *) (* String operations (surely there is a better way...) *) (* ------------------------------------------------------------------------- *) let implode l = itlist (^) l "";; let explode s = let rec exap n l = if n < 0 then l else exap (n - 1) ((String.sub s n 1)::l) in exap (String.length s - 1) [];; (* ------------------------------------------------------------------------- *) (* Greatest common divisor. *) (* ------------------------------------------------------------------------- *) let gcd = let rec gxd x y = if y = 0 then x else gxd y (x mod y) in fun x y -> let x' = abs x and y' = abs y in if x' < y' then gxd y' x' else gxd x' y';; (* ------------------------------------------------------------------------- *) (* Some useful functions on "num" type. *) (* ------------------------------------------------------------------------- *) let num_0 = Int 0 and num_1 = Int 1 and num_2 = Int 2 and num_10 = Int 10;; let pow2 n = power_num num_2 (Int n);; let pow10 n = power_num num_10 (Int n);; let numdom r = let r' = Ratio.normalize_ratio (ratio_of_num r) in num_of_big_int(Ratio.numerator_ratio r'), num_of_big_int(Ratio.denominator_ratio r');; let numerator = fst o numdom and denominator = snd o numdom;; let gcd_num n1 n2 = num_of_big_int(Big_int.gcd_big_int (big_int_of_num n1) (big_int_of_num n2));; let lcm_num x y = if x =/ num_0 && y =/ num_0 then num_0 else abs_num((x */ y) // gcd_num x y);; (* ------------------------------------------------------------------------- *) (* All pairs arising from applying a function over two lists. *) (* ------------------------------------------------------------------------- *) let rec allpairs f l1 l2 = match l1 with h1::t1 -> itlist (fun x a -> f h1 x :: a) l2 (allpairs f t1 l2) | [] -> [];; (* ------------------------------------------------------------------------- *) (* Issue a report with a newline. *) (* ------------------------------------------------------------------------- *) let report s = Format.print_string s; Format.print_newline();; (* ------------------------------------------------------------------------- *) (* Convenient function for issuing a warning. *) (* ------------------------------------------------------------------------- *) let warn cond s = if cond then report ("Warning: "^s) else ();; (* ------------------------------------------------------------------------- *) (* Flags to switch on verbose mode. *) (* ------------------------------------------------------------------------- *) let verbose = ref true;; let report_timing = ref true;; (* ------------------------------------------------------------------------- *) (* Switchable version of "report". *) (* ------------------------------------------------------------------------- *) let remark s = if !verbose then report s else ();; (* ------------------------------------------------------------------------- *) (* Time a function. *) (* ------------------------------------------------------------------------- *) let time f x = if not (!report_timing) then f x else let start_time = Sys.time() in try let result = f x in let finish_time = Sys.time() in report("CPU time (user): "^(string_of_float(finish_time -. start_time))); result with e -> let finish_time = Sys.time() in Format.print_string("Failed after (user) CPU time of "^ (string_of_float(finish_time -. start_time))^": "); raise e;; (* ------------------------------------------------------------------------- *) (* Versions of assoc and rev_assoc with default rather than failure. *) (* ------------------------------------------------------------------------- *) let rec assocd a l d = match l with [] -> d | (x,y)::t -> if Pervasives.compare x a = 0 then y else assocd a t d;; let rec rev_assocd a l d = match l with [] -> d | (x,y)::t -> if Pervasives.compare y a = 0 then x else rev_assocd a t d;; (* ------------------------------------------------------------------------- *) (* Version of map that avoids rebuilding unchanged subterms. *) (* ------------------------------------------------------------------------- *) let rec qmap f l = match l with h::t -> let h' = f h and t' = qmap f t in if h' == h && t' == t then l else h'::t' | _ -> l;; (* ------------------------------------------------------------------------- *) (* Merging and bottom-up mergesort. *) (* ------------------------------------------------------------------------- *) let rec merge ord l1 l2 = match l1 with [] -> l2 | h1::t1 -> match l2 with [] -> l1 | h2::t2 -> if ord h1 h2 then h1::(merge ord t1 l2) else h2::(merge ord l1 t2);; let mergesort ord = let rec mergepairs l1 l2 = match (l1,l2) with ([s],[]) -> s | (l,[]) -> mergepairs [] l | (l,[s1]) -> mergepairs (s1::l) [] | (l,(s1::s2::ss)) -> mergepairs ((merge ord s1 s2)::l) ss in fun l -> if l = [] then [] else mergepairs [] (map (fun x -> [x]) l);; (* ------------------------------------------------------------------------- *) (* Common measure predicates to use with "sort". *) (* ------------------------------------------------------------------------- *) let increasing f x y = Pervasives.compare (f x) (f y) < 0;; let decreasing f x y = Pervasives.compare (f x) (f y) > 0;; (* ------------------------------------------------------------------------- *) (* Polymorphic finite partial functions via Patricia trees. *) (* *) (* The point of this strange representation is that it is canonical (equal *) (* functions have the same encoding) yet reasonably efficient on average. *) (* *) (* Idea due to Diego Olivier Fernandez Pons (OCaml list, 2003/11/10). *) (* ------------------------------------------------------------------------- *) type ('a,'b)func = Empty | Leaf of int * ('a*'b)list | Branch of int * int * ('a,'b)func * ('a,'b)func;; (* ------------------------------------------------------------------------- *) (* Undefined function. *) (* ------------------------------------------------------------------------- *) let undefined = Empty;; (* ------------------------------------------------------------------------- *) (* In case of equality comparison worries, better use this. *) (* ------------------------------------------------------------------------- *) let is_undefined f = match f with Empty -> true | _ -> false;; (* ------------------------------------------------------------------------- *) (* Operation analagous to "map" for lists. *) (* ------------------------------------------------------------------------- *) let mapf = let rec map_list f l = match l with [] -> [] | (x,y)::t -> (x,f(y))::(map_list f t) in let rec mapf f t = match t with Empty -> Empty | Leaf(h,l) -> Leaf(h,map_list f l) | Branch(p,b,l,r) -> Branch(p,b,mapf f l,mapf f r) in mapf;; (* ------------------------------------------------------------------------- *) (* Operations analogous to "fold" for lists. *) (* ------------------------------------------------------------------------- *) let foldl = let rec foldl_list f a l = match l with [] -> a | (x,y)::t -> foldl_list f (f a x y) t in let rec foldl f a t = match t with Empty -> a | Leaf(h,l) -> foldl_list f a l | Branch(p,b,l,r) -> foldl f (foldl f a l) r in foldl;; let foldr = let rec foldr_list f l a = match l with [] -> a | (x,y)::t -> f x y (foldr_list f t a) in let rec foldr f t a = match t with Empty -> a | Leaf(h,l) -> foldr_list f l a | Branch(p,b,l,r) -> foldr f l (foldr f r a) in foldr;; (* ------------------------------------------------------------------------- *) (* Mapping to sorted-list representation of the graph, domain and range. *) (* ------------------------------------------------------------------------- *) let graph f = setify (foldl (fun a x y -> (x,y)::a) [] f);; let dom f = setify(foldl (fun a x y -> x::a) [] f);; let ran f = setify(foldl (fun a x y -> y::a) [] f);; (* ------------------------------------------------------------------------- *) (* Application. *) (* ------------------------------------------------------------------------- *) let applyd = let rec apply_listd l d x = match l with (a,b)::t -> let c = Pervasives.compare x a in if c = 0 then b else if c > 0 then apply_listd t d x else d x | [] -> d x in fun f d x -> let k = Hashtbl.hash x in let rec look t = match t with Leaf(h,l) when h = k -> apply_listd l d x | Branch(p,b,l,r) when (k lxor p) land (b - 1) = 0 -> look (if k land b = 0 then l else r) | _ -> d x in look f;; let apply f = applyd f (fun x -> failwith "apply");; let tryapplyd f a d = applyd f (fun x -> d) a;; let defined f x = try apply f x; true with Failure _ -> false;; (* ------------------------------------------------------------------------- *) (* Undefinition. *) (* ------------------------------------------------------------------------- *) let undefine = let rec undefine_list x l = match l with (a,b as ab)::t -> let c = Pervasives.compare x a in if c = 0 then t else if c < 0 then l else let t' = undefine_list x t in if t' == t then l else ab::t' | [] -> [] in fun x -> let k = Hashtbl.hash x in let rec und t = match t with Leaf(h,l) when h = k -> let l' = undefine_list x l in if l' == l then t else if l' = [] then Empty else Leaf(h,l') | Branch(p,b,l,r) when k land (b - 1) = p -> if k land b = 0 then let l' = und l in if l' == l then t else (match l' with Empty -> r | _ -> Branch(p,b,l',r)) else let r' = und r in if r' == r then t else (match r' with Empty -> l | _ -> Branch(p,b,l,r')) | _ -> t in und;; (* ------------------------------------------------------------------------- *) (* Redefinition and combination. *) (* ------------------------------------------------------------------------- *) let (|->),combine = let newbranch p1 t1 p2 t2 = let zp = p1 lxor p2 in let b = zp land (-zp) in let p = p1 land (b - 1) in if p1 land b = 0 then Branch(p,b,t1,t2) else Branch(p,b,t2,t1) in let rec define_list (x,y as xy) l = match l with (a,b as ab)::t -> let c = Pervasives.compare x a in if c = 0 then xy::t else if c < 0 then xy::l else ab::(define_list xy t) | [] -> [xy] and combine_list op z l1 l2 = match (l1,l2) with [],_ -> l2 | _,[] -> l1 | ((x1,y1 as xy1)::t1,(x2,y2 as xy2)::t2) -> let c = Pervasives.compare x1 x2 in if c < 0 then xy1::(combine_list op z t1 l2) else if c > 0 then xy2::(combine_list op z l1 t2) else let y = op y1 y2 and l = combine_list op z t1 t2 in if z(y) then l else (x1,y)::l in let (|->) x y = let k = Hashtbl.hash x in let rec upd t = match t with Empty -> Leaf (k,[x,y]) | Leaf(h,l) -> if h = k then Leaf(h,define_list (x,y) l) else newbranch h t k (Leaf(k,[x,y])) | Branch(p,b,l,r) -> if k land (b - 1) <> p then newbranch p t k (Leaf(k,[x,y])) else if k land b = 0 then Branch(p,b,upd l,r) else Branch(p,b,l,upd r) in upd in let rec combine op z t1 t2 = match (t1,t2) with Empty,_ -> t2 | _,Empty -> t1 | Leaf(h1,l1),Leaf(h2,l2) -> if h1 = h2 then let l = combine_list op z l1 l2 in if l = [] then Empty else Leaf(h1,l) else newbranch h1 t1 h2 t2 | (Leaf(k,lis) as lf),(Branch(p,b,l,r) as br) -> if k land (b - 1) = p then if k land b = 0 then (match combine op z lf l with Empty -> r | l' -> Branch(p,b,l',r)) else (match combine op z lf r with Empty -> l | r' -> Branch(p,b,l,r')) else newbranch k lf p br | (Branch(p,b,l,r) as br),(Leaf(k,lis) as lf) -> if k land (b - 1) = p then if k land b = 0 then (match combine op z l lf with Empty -> r | l' -> Branch(p,b,l',r)) else (match combine op z r lf with Empty -> l | r' -> Branch(p,b,l,r')) else newbranch p br k lf | Branch(p1,b1,l1,r1),Branch(p2,b2,l2,r2) -> if b1 < b2 then if p2 land (b1 - 1) <> p1 then newbranch p1 t1 p2 t2 else if p2 land b1 = 0 then (match combine op z l1 t2 with Empty -> r1 | l -> Branch(p1,b1,l,r1)) else (match combine op z r1 t2 with Empty -> l1 | r -> Branch(p1,b1,l1,r)) else if b2 < b1 then if p1 land (b2 - 1) <> p2 then newbranch p1 t1 p2 t2 else if p1 land b2 = 0 then (match combine op z t1 l2 with Empty -> r2 | l -> Branch(p2,b2,l,r2)) else (match combine op z t1 r2 with Empty -> l2 | r -> Branch(p2,b2,l2,r)) else if p1 = p2 then (match (combine op z l1 l2,combine op z r1 r2) with (Empty,r) -> r | (l,Empty) -> l | (l,r) -> Branch(p1,b1,l,r)) else newbranch p1 t1 p2 t2 in (|->),combine;; (* ------------------------------------------------------------------------- *) (* Special case of point function. *) (* ------------------------------------------------------------------------- *) let (|=>) = fun x y -> (x |-> y) undefined;; (* ------------------------------------------------------------------------- *) (* Grab an arbitrary element. *) (* ------------------------------------------------------------------------- *) let rec choose t = match t with Empty -> failwith "choose: completely undefined function" | Leaf(h,l) -> hd l | Branch(b,p,t1,t2) -> choose t1;; (* ------------------------------------------------------------------------- *) (* Install a trivial printer for the general polymorphic case. *) (* ------------------------------------------------------------------------- *) let print_fpf (f:('a,'b)func) = Format.print_string "";; #install_printer print_fpf;; (* ------------------------------------------------------------------------- *) (* Set operations parametrized by equality (from Steven Obua). *) (* ------------------------------------------------------------------------- *) let rec mem' eq = let rec mem x lis = match lis with [] -> false | (h::t) -> eq x h || mem x t in mem;; let insert' eq x l = if mem' eq x l then l else x::l;; let union' eq l1 l2 = itlist (insert' eq) l1 l2;; let unions' eq l = itlist (union' eq) l [];; let subtract' eq l1 l2 = filter (fun x -> not (mem' eq x l2)) l1;; (* ------------------------------------------------------------------------- *) (* Accepts decimal, hex or binary numeral, using C notation 0x... for hex *) (* and analogous 0b... for binary. *) (* ------------------------------------------------------------------------- *) let num_of_string = let values = ["0",0; "1",1; "2",2; "3",3; "4",4; "5",5; "6",6; "7",7; "8",8; "9",9; "a",10; "A",10; "b",11; "B",11; "c",12; "C",12; "d",13; "D",13; "e",14; "E",14; "f",15; "F",15] in let valof b s = let v = Int(assoc s values) in if v failwith "num_of_string: no digits after base indicator" | [h] -> valof b h | h::t -> valof b h +/ b */ num_of_stringlist b t in fun s -> match explode(s) with [] -> failwith "num_of_string: no digits" | "0"::"x"::hexdigits -> num_of_stringlist sixteen (rev hexdigits) | "0"::"b"::bindigits -> num_of_stringlist two (rev bindigits) | decdigits -> num_of_stringlist ten (rev decdigits);; (* ------------------------------------------------------------------------- *) (* Convenient conversion between files and (lists of) strings. *) (* ------------------------------------------------------------------------- *) let strings_of_file filename = let fd = try Pervasives.open_in filename with Sys_error _ -> failwith("strings_of_file: can't open "^filename) in let rec suck_lines acc = try let l = Pervasives.input_line fd in suck_lines (l::acc) with End_of_file -> rev acc in let data = suck_lines [] in (Pervasives.close_in fd; data);; let string_of_file filename = end_itlist (fun s t -> s^"\n"^t) (strings_of_file filename);; let file_of_string filename s = let fd = Pervasives.open_out filename in output_string fd s; close_out fd;; hol-light/lists.ml000066400000000000000000000710461303454263000144450ustar00rootroot00000000000000(* ========================================================================= *) (* Theory of lists, plus characters and strings as lists of characters. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Marco Maggesi 2014 *) (* ========================================================================= *) needs "ind_types.ml";; (* ------------------------------------------------------------------------- *) (* Standard tactic for list induction using MATCH_MP_TAC list_INDUCT *) (* ------------------------------------------------------------------------- *) let LIST_INDUCT_TAC = let list_INDUCT = prove (`!P:(A)list->bool. P [] /\ (!h t. P t ==> P (CONS h t)) ==> !l. P l`, MATCH_ACCEPT_TAC list_INDUCT) in MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN GEN_TAC THEN DISCH_TAC];; (* ------------------------------------------------------------------------- *) (* Basic definitions. *) (* ------------------------------------------------------------------------- *) let HD = new_recursive_definition list_RECURSION `HD(CONS (h:A) t) = h`;; let TL = new_recursive_definition list_RECURSION `TL(CONS (h:A) t) = t`;; let APPEND = new_recursive_definition list_RECURSION `(!l:(A)list. APPEND [] l = l) /\ (!h t l. APPEND (CONS h t) l = CONS h (APPEND t l))`;; let REVERSE = new_recursive_definition list_RECURSION `(REVERSE [] = []) /\ (REVERSE (CONS (x:A) l) = APPEND (REVERSE l) [x])`;; let LENGTH = new_recursive_definition list_RECURSION `(LENGTH [] = 0) /\ (!h:A. !t. LENGTH (CONS h t) = SUC (LENGTH t))`;; let MAP = new_recursive_definition list_RECURSION `(!f:A->B. MAP f NIL = NIL) /\ (!f h t. MAP f (CONS h t) = CONS (f h) (MAP f t))`;; let LAST = new_recursive_definition list_RECURSION `LAST (CONS (h:A) t) = if t = [] then h else LAST t`;; let BUTLAST = new_recursive_definition list_RECURSION `(BUTLAST [] = []) /\ (BUTLAST (CONS h t) = if t = [] then [] else CONS h (BUTLAST t))`;; let REPLICATE = new_recursive_definition num_RECURSION `(REPLICATE 0 x = []) /\ (REPLICATE (SUC n) x = CONS x (REPLICATE n x))`;; let NULL = new_recursive_definition list_RECURSION `(NULL [] = T) /\ (NULL (CONS h t) = F)`;; let ALL = new_recursive_definition list_RECURSION `(ALL P [] = T) /\ (ALL P (CONS h t) <=> P h /\ ALL P t)`;; let EX = new_recursive_definition list_RECURSION `(EX P [] = F) /\ (EX P (CONS h t) <=> P h \/ EX P t)`;; let ITLIST = new_recursive_definition list_RECURSION `(ITLIST f [] b = b) /\ (ITLIST f (CONS h t) b = f h (ITLIST f t b))`;; let MEM = new_recursive_definition list_RECURSION `(MEM x [] <=> F) /\ (MEM x (CONS h t) <=> (x = h) \/ MEM x t)`;; let ALL2_DEF = new_recursive_definition list_RECURSION `(ALL2 P [] l2 <=> (l2 = [])) /\ (ALL2 P (CONS h1 t1) l2 <=> if l2 = [] then F else P h1 (HD l2) /\ ALL2 P t1 (TL l2))`;; let ALL2 = prove (`(ALL2 P [] [] <=> T) /\ (ALL2 P (CONS h1 t1) [] <=> F) /\ (ALL2 P [] (CONS h2 t2) <=> F) /\ (ALL2 P (CONS h1 t1) (CONS h2 t2) <=> P h1 h2 /\ ALL2 P t1 t2)`, REWRITE_TAC[distinctness "list"; ALL2_DEF; HD; TL]);; let MAP2_DEF = new_recursive_definition list_RECURSION `(MAP2 f [] l = []) /\ (MAP2 f (CONS h1 t1) l = CONS (f h1 (HD l)) (MAP2 f t1 (TL l)))`;; let MAP2 = prove (`(MAP2 f [] [] = []) /\ (MAP2 f (CONS h1 t1) (CONS h2 t2) = CONS (f h1 h2) (MAP2 f t1 t2))`, REWRITE_TAC[MAP2_DEF; HD; TL]);; let EL = new_recursive_definition num_RECURSION `(EL 0 l = HD l) /\ (EL (SUC n) l = EL n (TL l))`;; let FILTER = new_recursive_definition list_RECURSION `(FILTER P [] = []) /\ (FILTER P (CONS h t) = if P h then CONS h (FILTER P t) else FILTER P t)`;; let ASSOC = new_recursive_definition list_RECURSION `ASSOC a (CONS h t) = if FST h = a then SND h else ASSOC a t`;; let ITLIST2_DEF = new_recursive_definition list_RECURSION `(ITLIST2 f [] l2 b = b) /\ (ITLIST2 f (CONS h1 t1) l2 b = f h1 (HD l2) (ITLIST2 f t1 (TL l2) b))`;; let ITLIST2 = prove (`(ITLIST2 f [] [] b = b) /\ (ITLIST2 f (CONS h1 t1) (CONS h2 t2) b = f h1 h2 (ITLIST2 f t1 t2 b))`, REWRITE_TAC[ITLIST2_DEF; HD; TL]);; let ZIP_DEF = new_recursive_definition list_RECURSION `(ZIP [] l2 = []) /\ (ZIP (CONS h1 t1) l2 = CONS (h1,HD l2) (ZIP t1 (TL l2)))`;; let ZIP = prove (`(ZIP [] [] = []) /\ (ZIP (CONS h1 t1) (CONS h2 t2) = CONS (h1,h2) (ZIP t1 t2))`, REWRITE_TAC[ZIP_DEF; HD; TL]);; let PAIRWISE = new_recursive_definition list_RECURSION `(PAIRWISE (r:A->A->bool) [] <=> T) /\ (PAIRWISE (r:A->A->bool) (CONS h t) <=> ALL (r h) t /\ PAIRWISE r t)`;; let list_of_seq = new_recursive_definition num_RECURSION `list_of_seq (s:num->A) 0 = [] /\ list_of_seq s (SUC n) = APPEND (list_of_seq s n) [s n]`;; (* ------------------------------------------------------------------------- *) (* Various trivial theorems. *) (* ------------------------------------------------------------------------- *) let NOT_CONS_NIL = prove (`!(h:A) t. ~(CONS h t = [])`, REWRITE_TAC[distinctness "list"]);; let LAST_CLAUSES = prove (`(LAST [h:A] = h) /\ (LAST (CONS h (CONS k t)) = LAST (CONS k t))`, REWRITE_TAC[LAST; NOT_CONS_NIL]);; let APPEND_NIL = prove (`!l:A list. APPEND l [] = l`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND]);; let APPEND_ASSOC = prove (`!(l:A list) m n. APPEND l (APPEND m n) = APPEND (APPEND l m) n`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND]);; let REVERSE_APPEND = prove (`!(l:A list) m. REVERSE (APPEND l m) = APPEND (REVERSE m) (REVERSE l)`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; REVERSE; APPEND_NIL; APPEND_ASSOC]);; let REVERSE_REVERSE = prove (`!l:A list. REVERSE(REVERSE l) = l`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE; REVERSE_APPEND; APPEND]);; let CONS_11 = prove (`!(h1:A) h2 t1 t2. (CONS h1 t1 = CONS h2 t2) <=> (h1 = h2) /\ (t1 = t2)`, REWRITE_TAC[injectivity "list"]);; let list_CASES = prove (`!l:(A)list. (l = []) \/ ?h t. l = CONS h t`, LIST_INDUCT_TAC THEN REWRITE_TAC[CONS_11; NOT_CONS_NIL] THEN MESON_TAC[]);; let LIST_EQ = prove (`!l1 l2:A list. l1 = l2 <=> LENGTH l1 = LENGTH l2 /\ !n. n < LENGTH l2 ==> EL n l1 = EL n l2`, REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL; CONS_11; LENGTH; CONJUNCT1 LT; NOT_SUC] THEN ASM_REWRITE_TAC[SUC_INJ] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MESON[num_CASES] `(!n. P n) <=> P 0 /\ (!n. P(SUC n))`] THEN REWRITE_TAC[EL; HD; TL; LT_0; LT_SUC; CONJ_ACI]);; let LENGTH_APPEND = prove (`!(l:A list) m. LENGTH(APPEND l m) = LENGTH l + LENGTH m`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; LENGTH; ADD_CLAUSES]);; let MAP_APPEND = prove (`!f:A->B. !l1 l2. MAP f (APPEND l1 l2) = APPEND (MAP f l1) (MAP f l2)`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; APPEND]);; let LENGTH_MAP = prove (`!l. !f:A->B. LENGTH (MAP f l) = LENGTH l`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; LENGTH]);; let LENGTH_EQ_NIL = prove (`!l:A list. (LENGTH l = 0) <=> (l = [])`, LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_CONS_NIL; NOT_SUC]);; let LENGTH_EQ_CONS = prove (`!l n. (LENGTH l = SUC n) <=> ?h t. (l = CONS h t) /\ (LENGTH t = n)`, LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_SUC; NOT_CONS_NIL] THEN ASM_REWRITE_TAC[SUC_INJ; CONS_11] THEN MESON_TAC[]);; let MAP_o = prove (`!f:A->B. !g:B->C. !l. MAP (g o f) l = MAP g (MAP f l)`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; o_THM]);; let MAP_EQ = prove (`!f g l. ALL (\x. f x = g x) l ==> (MAP f l = MAP g l)`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; ALL] THEN ASM_MESON_TAC[]);; let ALL_IMP = prove (`!P Q l. (!x. MEM x l /\ P x ==> Q x) /\ ALL P l ==> ALL Q l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MEM; ALL] THEN ASM_MESON_TAC[]);; let NOT_EX = prove (`!P l. ~(EX P l) <=> ALL (\x. ~(P x)) l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EX; ALL; DE_MORGAN_THM]);; let NOT_ALL = prove (`!P l. ~(ALL P l) <=> EX (\x. ~(P x)) l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EX; ALL; DE_MORGAN_THM]);; let ALL_MAP = prove (`!P f l. ALL P (MAP f l) <=> ALL (P o f) l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; MAP; o_THM]);; let ALL_T = prove (`!l. ALL (\x. T) l`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL]);; let MAP_EQ_ALL2 = prove (`!l m. ALL2 (\x y. f x = f y) l m ==> (MAP f l = MAP f m)`, REPEAT LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; ALL2; CONS_11] THEN ASM_MESON_TAC[]);; let ALL2_MAP = prove (`!P f l. ALL2 P (MAP f l) l <=> ALL (\a. P (f a) a) l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL2; MAP; ALL]);; let MAP_EQ_DEGEN = prove (`!l f. ALL (\x. f(x) = x) l ==> (MAP f l = l)`, LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; MAP; CONS_11] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let ALL2_AND_RIGHT = prove (`!l m P Q. ALL2 (\x y. P x /\ Q x y) l m <=> ALL P l /\ ALL2 Q l m`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; ALL2] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; ALL2] THEN REWRITE_TAC[CONJ_ACI]);; let ITLIST_APPEND = prove (`!f a l1 l2. ITLIST f (APPEND l1 l2) a = ITLIST f l1 (ITLIST f l2 a)`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ITLIST; APPEND]);; let ITLIST_EXTRA = prove (`!l. ITLIST f (APPEND l [a]) b = ITLIST f l (f a b)`, REWRITE_TAC[ITLIST_APPEND; ITLIST]);; let ALL_MP = prove (`!P Q l. ALL (\x. P x ==> Q x) l /\ ALL P l ==> ALL Q l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL] THEN ASM_MESON_TAC[]);; let AND_ALL = prove (`!l. ALL P l /\ ALL Q l <=> ALL (\x. P x /\ Q x) l`, CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; CONJ_ACI]);; let EX_IMP = prove (`!P Q l. (!x. MEM x l /\ P x ==> Q x) /\ EX P l ==> EX Q l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MEM; EX] THEN ASM_MESON_TAC[]);; let ALL_MEM = prove (`!P l. (!x. MEM x l ==> P x) <=> ALL P l`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; MEM] THEN ASM_MESON_TAC[]);; let LENGTH_REPLICATE = prove (`!n x. LENGTH(REPLICATE n x) = n`, INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH; REPLICATE]);; let EX_MAP = prove (`!P f l. EX P (MAP f l) <=> EX (P o f) l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; EX; o_THM]);; let EXISTS_EX = prove (`!P l. (?x. EX (P x) l) <=> EX (\s. ?x. P x s) l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EX] THEN ASM_MESON_TAC[]);; let FORALL_ALL = prove (`!P l. (!x. ALL (P x) l) <=> ALL (\s. !x. P x s) l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN ASM_MESON_TAC[]);; let MEM_APPEND = prove (`!x l1 l2. MEM x (APPEND l1 l2) <=> MEM x l1 \/ MEM x l2`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; APPEND; DISJ_ACI]);; let MEM_MAP = prove (`!f y l. MEM y (MAP f l) <=> ?x. MEM x l /\ (y = f x)`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; MAP] THEN MESON_TAC[]);; let FILTER_APPEND = prove (`!P l1 l2. FILTER P (APPEND l1 l2) = APPEND (FILTER P l1) (FILTER P l2)`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FILTER; APPEND] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[APPEND]);; let FILTER_MAP = prove (`!P f l. FILTER P (MAP f l) = MAP f (FILTER (P o f) l)`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; FILTER; o_THM] THEN COND_CASES_TAC THEN REWRITE_TAC[MAP]);; let MEM_FILTER = prove (`!P l x. MEM x (FILTER P l) <=> P x /\ MEM x l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; FILTER] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MEM] THEN ASM_MESON_TAC[]);; let EX_MEM = prove (`!P l. (?x. P x /\ MEM x l) <=> EX P l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EX; MEM] THEN ASM_MESON_TAC[]);; let MAP_FST_ZIP = prove (`!l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP FST (ZIP l1 l2) = l1)`, LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_SIMP_TAC[LENGTH; SUC_INJ; MAP; FST; ZIP; NOT_SUC]);; let MAP_SND_ZIP = prove (`!l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP SND (ZIP l1 l2) = l2)`, LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_SIMP_TAC[LENGTH; SUC_INJ; MAP; FST; ZIP; NOT_SUC]);; let LENGTH_ZIP = prove (`!l1 l2. LENGTH l1 = LENGTH l2 ==> LENGTH(ZIP l1 l2) = LENGTH l2`, REPEAT(LIST_INDUCT_TAC ORELSE GEN_TAC) THEN ASM_SIMP_TAC[LENGTH; NOT_SUC; ZIP; SUC_INJ]);; let MEM_ASSOC = prove (`!l x. MEM (x,ASSOC x l) l <=> MEM x (MAP FST l)`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; MAP; ASSOC] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PAIR; FST]);; let ALL_APPEND = prove (`!P l1 l2. ALL P (APPEND l1 l2) <=> ALL P l1 /\ ALL P l2`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; APPEND; GSYM CONJ_ASSOC]);; let MEM_EL = prove (`!l n. n < LENGTH l ==> MEM (EL n l) l`, LIST_INDUCT_TAC THEN REWRITE_TAC[MEM; CONJUNCT1 LT; LENGTH] THEN INDUCT_TAC THEN ASM_SIMP_TAC[EL; HD; LT_SUC; TL]);; let MEM_EXISTS_EL = prove (`!l x. MEM x l <=> ?i. i < LENGTH l /\ x = EL i l`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH; EL; MEM; CONJUNCT1 LT] THEN GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [MESON[num_CASES] `(?i. P i) <=> P 0 \/ (?i. P(SUC i))`] THEN REWRITE_TAC[LT_SUC; LT_0; EL; HD; TL]);; let ALL_EL = prove (`!P l. (!i. i < LENGTH l ==> P (EL i l)) <=> ALL P l`, REWRITE_TAC[GSYM ALL_MEM; MEM_EXISTS_EL] THEN MESON_TAC[]);; let ALL2_MAP2 = prove (`!l m. ALL2 P (MAP f l) (MAP g m) = ALL2 (\x y. P (f x) (g y)) l m`, LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL2; MAP]);; let AND_ALL2 = prove (`!P Q l m. ALL2 P l m /\ ALL2 Q l m <=> ALL2 (\x y. P x y /\ Q x y) l m`, GEN_TAC THEN GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL2] THEN REWRITE_TAC[CONJ_ACI]);; let ALL2_ALL = prove (`!P l. ALL2 P l l <=> ALL (\x. P x x) l`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL2; ALL]);; let APPEND_EQ_NIL = prove (`!l m. (APPEND l m = []) <=> (l = []) /\ (m = [])`, REWRITE_TAC[GSYM LENGTH_EQ_NIL; LENGTH_APPEND; ADD_EQ_0]);; let APPEND_LCANCEL = prove (`!l1 l2 l3:A list. APPEND l1 l2 = APPEND l1 l3 <=> l2 = l3`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; CONS_11]);; let APPEND_RCANCEL = prove (`!l1 l2 l3:A list. APPEND l1 l3 = APPEND l2 l3 <=> l1 = l2`, ONCE_REWRITE_TAC[MESON[REVERSE_REVERSE] `l = l' <=> REVERSE l = REVERSE l'`] THEN REWRITE_TAC[REVERSE_APPEND; APPEND_LCANCEL]);; let LENGTH_MAP2 = prove (`!f l m. (LENGTH l = LENGTH m) ==> (LENGTH(MAP2 f l m) = LENGTH m)`, GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_SIMP_TAC[LENGTH; NOT_CONS_NIL; NOT_SUC; MAP2; SUC_INJ]);; let MAP_EQ_NIL = prove (`!f l. MAP f l = [] <=> l = []`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; NOT_CONS_NIL]);; let INJECTIVE_MAP = prove (`!f:A->B. (!l m. MAP f l = MAP f m ==> l = m) <=> (!x y. f x = f y ==> x = y)`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`[x:A]`; `[y:A]`]) THEN ASM_REWRITE_TAC[MAP; CONS_11]; REPEAT LIST_INDUCT_TAC THEN ASM_SIMP_TAC[MAP; NOT_CONS_NIL; CONS_11] THEN ASM_MESON_TAC[]]);; let SURJECTIVE_MAP = prove (`!f:A->B. (!m. ?l. MAP f l = m) <=> (!y. ?x. f x = y)`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [X_GEN_TAC `y:B` THEN FIRST_X_ASSUM(MP_TAC o SPEC `[y:B]`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; CONS_11; NOT_CONS_NIL; MAP_EQ_NIL]; MATCH_MP_TAC list_INDUCT] THEN ASM_MESON_TAC[MAP]);; let MAP_ID = prove (`!l. MAP (\x. x) l = l`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP]);; let MAP_I = prove (`MAP I = I`, REWRITE_TAC[FUN_EQ_THM; I_DEF; MAP_ID]);; let BUTLAST_APPEND = prove (`!l m:A list. BUTLAST(APPEND l m) = if m = [] then BUTLAST l else APPEND l (BUTLAST m)`, SIMP_TAC[COND_RAND; APPEND_NIL; MESON[] `(if p then T else q) <=> ~p ==> q`] THEN LIST_INDUCT_TAC THEN ASM_SIMP_TAC[APPEND; BUTLAST; APPEND_EQ_NIL]);; let APPEND_BUTLAST_LAST = prove (`!l. ~(l = []) ==> APPEND (BUTLAST l) [LAST l] = l`, LIST_INDUCT_TAC THEN REWRITE_TAC[LAST; BUTLAST; NOT_CONS_NIL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[APPEND]);; let LAST_APPEND = prove (`!p q. LAST(APPEND p q) = if q = [] then LAST p else LAST q`, LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; LAST; APPEND_EQ_NIL] THEN MESON_TAC[]);; let LENGTH_TL = prove (`!l. ~(l = []) ==> LENGTH(TL l) = LENGTH l - 1`, LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; TL; ARITH; SUC_SUB1]);; let EL_APPEND = prove (`!k l m. EL k (APPEND l m) = if k < LENGTH l then EL k l else EL (k - LENGTH l) m`, INDUCT_TAC THEN REWRITE_TAC[EL] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[HD; APPEND; LENGTH; SUB_0; EL; LT_0; CONJUNCT1 LT] THEN ASM_REWRITE_TAC[TL; LT_SUC; SUB_SUC]);; let EL_TL = prove (`!n. EL n (TL l) = EL (n + 1) l`, REWRITE_TAC[GSYM ADD1; EL]);; let EL_CONS = prove (`!n h t. EL n (CONS h t) = if n = 0 then h else EL (n - 1) t`, INDUCT_TAC THEN REWRITE_TAC[EL; HD; TL; NOT_SUC; SUC_SUB1]);; let LAST_EL = prove (`!l. ~(l = []) ==> LAST l = EL (LENGTH l - 1) l`, LIST_INDUCT_TAC THEN REWRITE_TAC[LAST; LENGTH; SUC_SUB1] THEN DISCH_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LENGTH; EL; HD; EL_CONS; LENGTH_EQ_NIL]);; let HD_APPEND = prove (`!l m:A list. HD(APPEND l m) = if l = [] then HD m else HD l`, LIST_INDUCT_TAC THEN REWRITE_TAC[HD; APPEND; NOT_CONS_NIL]);; let CONS_HD_TL = prove (`!l. ~(l = []) ==> l = CONS (HD l) (TL l)`, LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL;HD;TL]);; let EL_MAP = prove (`!f n l. n < LENGTH l ==> EL n (MAP f l) = f(EL n l)`, GEN_TAC THEN INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH; CONJUNCT1 LT; LT_0; EL; HD; TL; MAP; LT_SUC]);; let MAP_REVERSE = prove (`!f l. REVERSE(MAP f l) = MAP f (REVERSE l)`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; REVERSE; MAP_APPEND]);; let ALL_FILTER = prove (`!P Q l:A list. ALL P (FILTER Q l) <=> ALL (\x. Q x ==> P x) l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; FILTER] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ALL]);; let APPEND_SING = prove (`!h t. APPEND [h] t = CONS h t`, REWRITE_TAC[APPEND]);; let MEM_APPEND_DECOMPOSE_LEFT = prove (`!x:A l. MEM x l <=> ?l1 l2. ~(MEM x l1) /\ l = APPEND l1 (CONS x l2)`, REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; MEM_APPEND; MEM] THEN X_GEN_TAC `x:A` THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[MEM] THEN MAP_EVERY X_GEN_TAC [`y:A`; `l:A list`] THEN ASM_CASES_TAC `x:A = y` THEN ASM_MESON_TAC[MEM; APPEND]);; let MEM_APPEND_DECOMPOSE = prove (`!x:A l. MEM x l <=> ?l1 l2. l = APPEND l1 (CONS x l2)`, REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM; MEM_APPEND; MEM] THEN ONCE_REWRITE_TAC[MEM_APPEND_DECOMPOSE_LEFT] THEN MESON_TAC[]);; let PAIRWISE_APPEND = prove (`!R:A->A->bool l m. PAIRWISE R (APPEND l m) <=> PAIRWISE R l /\ PAIRWISE R m /\ (!x y. MEM x l /\ MEM y m ==> R x y)`, GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[APPEND; PAIRWISE; MEM; ALL_APPEND; GSYM ALL_MEM] THEN MESON_TAC[]);; let PAIRWISE_MAP = prove (`!R f:A->B l. PAIRWISE R (MAP f l) <=> PAIRWISE (\x y. R (f x) (f y)) l`, GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[PAIRWISE; MAP; ALL_MAP; o_DEF]);; let PAIRWISE_IMPLIES = prove (`!R:A->A->bool R' l. PAIRWISE R l /\ (!x y. MEM x l /\ MEM y l /\ R x y ==> R' x y) ==> PAIRWISE R' l`, GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[PAIRWISE; GSYM ALL_MEM; MEM] THEN MESON_TAC[]);; let PAIRWISE_TRANSITIVE = prove (`!R x y:A l. (!x y z. R x y /\ R y z ==> R x z) ==> (PAIRWISE R (CONS x (CONS y l)) <=> R x y /\ PAIRWISE R (CONS y l))`, REPEAT STRIP_TAC THEN REWRITE_TAC[PAIRWISE; ALL; GSYM CONJ_ASSOC; TAUT `(p /\ q /\ r /\ s <=> p /\ r /\ s) <=> p /\ s ==> r ==> q`] THEN STRIP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN ASM_MESON_TAC[]);; let LENGTH_LIST_OF_SEQ = prove (`!s:num->A n. LENGTH(list_of_seq s n) = n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[list_of_seq; LENGTH; LENGTH_APPEND; ADD_CLAUSES]);; let EL_LIST_OF_SEQ = prove (`!s:num->A m n. m < n ==> EL m (list_of_seq s n) = s m`, GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN REWRITE_TAC[list_of_seq; LT; EL_APPEND; LENGTH_LIST_OF_SEQ] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SUB_REFL; EL; HD; LT_REFL]);; let LIST_OF_SEQ_EQ_NIL = prove (`!s:num->A n. list_of_seq s n = [] <=> n = 0`, REWRITE_TAC[GSYM LENGTH_EQ_NIL; LENGTH_LIST_OF_SEQ; LENGTH]);; (* ------------------------------------------------------------------------- *) (* Syntax. *) (* ------------------------------------------------------------------------- *) let mk_cons h t = try let cons = mk_const("CONS",[type_of h,aty]) in mk_comb(mk_comb(cons,h),t) with Failure _ -> failwith "mk_cons";; let mk_list (tms,ty) = try let nil = mk_const("NIL",[ty,aty]) in if tms = [] then nil else let cons = mk_const("CONS",[ty,aty]) in itlist (mk_binop cons) tms nil with Failure _ -> failwith "mk_list";; let mk_flist tms = try mk_list(tms,type_of(hd tms)) with Failure _ -> failwith "mk_flist";; (* ------------------------------------------------------------------------- *) (* Extra monotonicity theorems for inductive definitions. *) (* ------------------------------------------------------------------------- *) let MONO_ALL = prove (`(!x:A. P x ==> Q x) ==> ALL P l ==> ALL Q l`, DISCH_TAC THEN SPEC_TAC(`l:A list`,`l:A list`) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN ASM_MESON_TAC[]);; let MONO_ALL2 = prove (`(!x y. (P:A->B->bool) x y ==> Q x y) ==> ALL2 P l l' ==> ALL2 Q l l'`, DISCH_TAC THEN SPEC_TAC(`l':B list`,`l':B list`) THEN SPEC_TAC(`l:A list`,`l:A list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL2_DEF] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]);; monotonicity_theorems := [MONO_ALL; MONO_ALL2] @ !monotonicity_theorems;; (* ------------------------------------------------------------------------- *) (* Apply a conversion down a list. *) (* ------------------------------------------------------------------------- *) let rec LIST_CONV conv tm = if is_cons tm then COMB2_CONV (RAND_CONV conv) (LIST_CONV conv) tm else if fst(dest_const tm) = "NIL" then REFL tm else failwith "LIST_CONV";; (* ------------------------------------------------------------------------- *) (* Type of characters, like the HOL88 "ascii" type, with syntax *) (* constructors and equality conversions for chars and strings. *) (* ------------------------------------------------------------------------- *) let char_INDUCT,char_RECURSION = define_type "char = ASCII bool bool bool bool bool bool bool bool";; new_type_abbrev("string",`:char list`);; let dest_char,mk_char,dest_string,mk_string,CHAR_EQ_CONV,STRING_EQ_CONV = let bool_of_term t = match t with Const("T",_) -> true | Const("F",_) -> false | _ -> failwith "bool_of_term" in let code_of_term t = let f,tms = strip_comb t in if not(is_const f && fst(dest_const f) = "ASCII") || not(length tms = 8) then failwith "code_of_term" else itlist (fun b f -> if b then 1 + 2 * f else 2 * f) (map bool_of_term (rev tms)) 0 in let char_of_term = Char.chr o code_of_term in let dest_string tm = try let tms = dest_list tm in if fst(dest_type(hd(snd(dest_type(type_of tm))))) <> "char" then fail() else let ccs = map (String.make 1 o char_of_term) tms in String.escaped (implode ccs) with Failure _ -> failwith "dest_string" in let mk_bool b = let true_tm,false_tm = `T`,`F` in if b then true_tm else false_tm in let mk_code = let ascii_tm = `ASCII` in let mk_code c = let lis = map (fun i -> mk_bool((c / (1 lsl i)) mod 2 = 1)) (0--7) in itlist (fun x y -> mk_comb(y,x)) lis ascii_tm in let codes = Array.map mk_code (Array.of_list (0--255)) in fun c -> Array.get codes c in let mk_char = mk_code o Char.code in let mk_string s = let ns = map (fun i -> Char.code(String.get s i)) (0--(String.length s - 1)) in mk_list(map mk_code ns,`:char`) in let CHAR_DISTINCTNESS = let avars,bvars,cvars = [`a0:bool`;`a1:bool`;`a2:bool`;`a3:bool`;`a4:bool`;`a5:bool`;`a6:bool`], [`b1:bool`;`b2:bool`;`b3:bool`;`b4:bool`;`b5:bool`;`b6:bool`;`b7:bool`], [`c1:bool`;`c2:bool`;`c3:bool`;`c4:bool`;`c5:bool`;`c6:bool`;`c7:bool`] in let ASCII_NEQS_FT = (map EQF_INTRO o CONJUNCTS o prove) (`~(ASCII F b1 b2 b3 b4 b5 b6 b7 = ASCII T c1 c2 c3 c4 c5 c6 c7) /\ ~(ASCII a0 F b2 b3 b4 b5 b6 b7 = ASCII a0 T c2 c3 c4 c5 c6 c7) /\ ~(ASCII a0 a1 F b3 b4 b5 b6 b7 = ASCII a0 a1 T c3 c4 c5 c6 c7) /\ ~(ASCII a0 a1 a2 F b4 b5 b6 b7 = ASCII a0 a1 a2 T c4 c5 c6 c7) /\ ~(ASCII a0 a1 a2 a3 F b5 b6 b7 = ASCII a0 a1 a2 a3 T c5 c6 c7) /\ ~(ASCII a0 a1 a2 a3 a4 F b6 b7 = ASCII a0 a1 a2 a3 a4 T c6 c7) /\ ~(ASCII a0 a1 a2 a3 a4 a5 F b7 = ASCII a0 a1 a2 a3 a4 a5 T c7) /\ ~(ASCII a0 a1 a2 a3 a4 a5 a6 F = ASCII a0 a1 a2 a3 a4 a5 a6 T)`, REWRITE_TAC[injectivity "char"]) in let ASCII_NEQS_TF = let ilist = zip bvars cvars @ zip cvars bvars in let f = EQF_INTRO o INST ilist o GSYM o EQF_ELIM in map f ASCII_NEQS_FT in let rec prefix n l = if n = 0 then [] else match l with h::t -> h :: prefix (n-1) t | _ -> l in let rec findneq n prefix a b = match a,b with b1::a, b2::b -> if b1 <> b2 then n,rev prefix,bool_of_term b2,a,b else findneq (n+1) (b1 :: prefix) a b | _, _ -> fail() in fun c1 c2 -> let _,a = strip_comb c1 and _,b = strip_comb c2 in let n,p,b,s1,s2 = findneq 0 [] a b in let ss1 = funpow n tl bvars and ss2 = funpow n tl cvars in let pp = prefix n avars in let pth = if b then ASCII_NEQS_FT else ASCII_NEQS_TF in INST (zip p pp @ zip s1 ss1 @ zip s2 ss2) (el n pth) in let rec STRING_DISTINCTNESS = let xtm,xstm = `x:char`,`xs:string` and ytm,ystm = `y:char`,`ys:string` and niltm = `[]:string` in let NIL_EQ_THM = EQT_INTRO (REFL niltm) and CONS_EQ_THM,CONS_NEQ_THM = (CONJ_PAIR o prove) (`(CONS x xs:string = CONS x ys <=> xs = ys) /\ ((x = y <=> F) ==> (CONS x xs:string = CONS y ys <=> F))`, REWRITE_TAC[CONS_11] THEN MESON_TAC[]) and NIL_NEQ_CONS,CONS_NEQ_NIL = (CONJ_PAIR o prove) (`(NIL:string = CONS x xs <=> F) /\ (CONS x xs:string = NIL <=> F)`, REWRITE_TAC[NOT_CONS_NIL]) in fun s1 s2 -> if s1 = niltm then if s2 = niltm then NIL_EQ_THM else let c2,s2 = rand (rator s2),rand s2 in INST [c2,xtm;s2,xstm] NIL_NEQ_CONS else let c1,s1 = rand (rator s1),rand s1 in if s2 = niltm then INST [c1,xtm;s1,xstm] CONS_NEQ_NIL else let c2,s2 = rand (rator s2),rand s2 in if c1 = c2 then let th1 = INST [c1,xtm; s1,xstm; s2,ystm] CONS_EQ_THM and th2 = STRING_DISTINCTNESS s1 s2 in TRANS th1 th2 else let ilist = [c1,xtm; c2,ytm; s1,xstm; s2,ystm] in let itm = INST ilist CONS_NEQ_THM in MP itm (CHAR_DISTINCTNESS c1 c2) in let CHAR_EQ_CONV : conv = fun tm -> let c1,c2 = dest_eq tm in if compare c1 c2 = 0 then EQT_INTRO (REFL c1) else CHAR_DISTINCTNESS c1 c2 and STRING_EQ_CONV tm = let ltm,rtm = dest_eq tm in if compare ltm rtm = 0 then EQT_INTRO (REFL ltm) else STRING_DISTINCTNESS ltm rtm in char_of_term,mk_char,dest_string,mk_string,CHAR_EQ_CONV,STRING_EQ_CONV;; hol-light/make.ml000066400000000000000000000047561303454263000142300ustar00rootroot00000000000000(* ========================================================================= *) (* Create a standalone HOL image. Assumes that we are running under Linux *) (* and have the program "ckpt" available to create checkpoints. *) (* *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) #use "hol.ml";; (* ------------------------------------------------------------------------- *) (* Record the build date and OCaml version for the startup banner. *) (* ------------------------------------------------------------------------- *) #load "unix.cma";; let startup_banner = let {Unix.tm_mday = d;Unix.tm_mon = m;Unix.tm_year = y;Unix.tm_wday = w} = Unix.localtime(Unix.time()) in let nice_date = string_of_int d ^ " " ^ el m ["January"; "February"; "March"; "April"; "May"; "June"; "July"; "August"; "September"; "October"; "November"; "December"] ^ " " ^ string_of_int(1900+y) in " HOL Light "^hol_version^ ", built "^nice_date^" on OCaml "^Sys.ocaml_version;; (* ------------------------------------------------------------------------- *) (* Self-destruct to create checkpoint file; print banner when restarted. *) (* ------------------------------------------------------------------------- *) let self_destruct bannerstring = let longer_banner = startup_banner ^ " with ckpt" in let complete_banner = if bannerstring = "" then longer_banner else longer_banner^"\n "^bannerstring in (Gc.compact(); ignore(Unix.system "sleep 1s; kill -USR1 $PPID"); Format.print_string complete_banner; Format.print_newline(); Format.print_newline());; (* ------------------------------------------------------------------------- *) (* Non-destructive checkpoint using CryoPID "freeze". *) (* ------------------------------------------------------------------------- *) let checkpoint bannerstring = let rec waste_time n = if n = 0 then () else waste_time(n - 1) in let longer_banner = startup_banner ^ " with CryoPID" in let complete_banner = if bannerstring = "" then longer_banner else longer_banner^"\n "^bannerstring in (Gc.compact(); ignore(Unix.system "(sleep 1s; freeze -l hol.snapshot $PPID) &"); waste_time 100000000; Format.print_string complete_banner; Format.print_newline(); Format.print_newline());; hol-light/meson.ml000066400000000000000000001075661303454263000144370ustar00rootroot00000000000000(* ========================================================================= *) (* Version of the MESON procedure a la PTTP. Various search options. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "canon.ml";; (* ------------------------------------------------------------------------- *) (* Some parameters controlling MESON behaviour. *) (* ------------------------------------------------------------------------- *) let meson_depth = ref false;; (* Use depth not inference bound. *) let meson_prefine = ref true;; (* Use Plaisted's positive refinement. *) let meson_dcutin = ref 1;; (* Min size for d-and-c optimization cut-in. *) let meson_skew = ref 3;; (* Skew proof bias (one side is <= n / skew) *) let meson_brand = ref false;; (* Use Brand transformation *) let meson_split_limit = ref 8;; (* Limit of case splits before MESON proper *) let meson_chatty = ref false;; (* Old-style verbose MESON output *) (* ------------------------------------------------------------------------- *) (* Prolog exception. *) (* ------------------------------------------------------------------------- *) exception Cut;; (* ------------------------------------------------------------------------- *) (* Shadow syntax for FOL terms in NNF. Functions and predicates have *) (* numeric codes, and negation is done by negating the predicate code. *) (* ------------------------------------------------------------------------- *) type fol_term = Fvar of int | Fnapp of int * fol_term list;; type fol_atom = int * fol_term list;; type fol_form = Atom of fol_atom | Conj of fol_form * fol_form | Disj of fol_form * fol_form | Forallq of int * fol_form;; (* ------------------------------------------------------------------------- *) (* Type for recording a MESON proof tree. *) (* ------------------------------------------------------------------------- *) type fol_goal = Subgoal of fol_atom * fol_goal list * (int * thm) * int * (fol_term * int)list;; (* ------------------------------------------------------------------------- *) (* General MESON procedure, using assumptions and with settable limits. *) (* ------------------------------------------------------------------------- *) module Meson = struct let offinc = 10000 and inferences = ref 0 (* ----------------------------------------------------------------------- *) (* Negate a clause. *) (* ----------------------------------------------------------------------- *) let mk_negated (p,a) = -p,a (* ----------------------------------------------------------------------- *) (* Like partition, but with short-circuiting for special situation. *) (* ----------------------------------------------------------------------- *) let qpartition p m = let rec qpartition l = if l == m then raise Unchanged else match l with [] -> raise Unchanged | (h::t) -> if p h then try let yes,no = qpartition t in h::yes,no with Unchanged -> [h],t else let yes,no = qpartition t in yes,h::no in function l -> try qpartition l with Unchanged -> [],l (* ----------------------------------------------------------------------- *) (* Translate a term (in NNF) into the shadow syntax. *) (* ----------------------------------------------------------------------- *) let reset_vars,fol_of_var,hol_of_var = let vstore = ref [] and gstore = ref [] and vcounter = ref 0 in let inc_vcounter() = let n = !vcounter in let m = n + 1 in if m >= offinc then failwith "inc_vcounter: too many variables" else (vcounter := m; n) in let reset_vars() = vstore := []; gstore := []; vcounter := 0 in let fol_of_var v = let currentvars = !vstore in try assoc v currentvars with Failure _ -> let n = inc_vcounter() in vstore := (v,n)::currentvars; n in let hol_of_var v = try rev_assoc v (!vstore) with Failure _ -> rev_assoc v (!gstore) in let hol_of_bumped_var v = try hol_of_var v with Failure _ -> let v' = v mod offinc in let hv' = hol_of_var v' in let gv = genvar(type_of hv') in gstore := (gv,v)::(!gstore); gv in reset_vars,fol_of_var,hol_of_bumped_var let reset_consts,fol_of_const,hol_of_const = let false_tm = `F` in let cstore = ref ([]:(term * int)list) and ccounter = ref 2 in let reset_consts() = cstore := [false_tm,1]; ccounter := 2 in let fol_of_const c = let currentconsts = !cstore in try assoc c currentconsts with Failure _ -> let n = !ccounter in ccounter := n + 1; cstore := (c,n)::currentconsts; n in let hol_of_const c = rev_assoc c (!cstore) in reset_consts,fol_of_const,hol_of_const let rec fol_of_term env consts tm = if is_var tm && not (mem tm consts) then Fvar(fol_of_var tm) else let f,args = strip_comb tm in if mem f env then failwith "fol_of_term: higher order" else let ff = fol_of_const f in Fnapp(ff,map (fol_of_term env consts) args) let fol_of_atom env consts tm = let f,args = strip_comb tm in if mem f env then failwith "fol_of_atom: higher order" else let ff = fol_of_const f in ff,map (fol_of_term env consts) args let fol_of_literal env consts tm = try let tm' = dest_neg tm in let p,a = fol_of_atom env consts tm' in -p,a with Failure _ -> fol_of_atom env consts tm let rec fol_of_form env consts tm = try let v,bod = dest_forall tm in let fv = fol_of_var v in let fbod = fol_of_form (v::env) (subtract consts [v]) bod in Forallq(fv,fbod) with Failure _ -> try let l,r = dest_conj tm in let fl = fol_of_form env consts l and fr = fol_of_form env consts r in Conj(fl,fr) with Failure _ -> try let l,r = dest_disj tm in let fl = fol_of_form env consts l and fr = fol_of_form env consts r in Disj(fl,fr) with Failure _ -> Atom(fol_of_literal env consts tm) (* ----------------------------------------------------------------------- *) (* Further translation functions for HOL formulas. *) (* ----------------------------------------------------------------------- *) let rec hol_of_term tm = match tm with Fvar v -> hol_of_var v | Fnapp(f,args) -> list_mk_comb(hol_of_const f,map hol_of_term args) let hol_of_atom (p,args) = list_mk_comb(hol_of_const p,map hol_of_term args) let hol_of_literal (p,args) = if p < 0 then mk_neg(hol_of_atom(-p,args)) else hol_of_atom (p,args) (* ----------------------------------------------------------------------- *) (* Versions of shadow syntax operations with variable bumping. *) (* ----------------------------------------------------------------------- *) let rec fol_free_in v tm = match tm with Fvar x -> x = v | Fnapp(_,lis) -> exists (fol_free_in v) lis let rec fol_subst theta tm = match tm with Fvar v -> rev_assocd v theta tm | Fnapp(f,args) -> let args' = qmap (fol_subst theta) args in if args' == args then tm else Fnapp(f,args') let fol_inst theta ((p,args) as at:fol_atom) = let args' = qmap (fol_subst theta) args in if args' == args then at else p,args' let rec fol_subst_bump offset theta tm = match tm with Fvar v -> if v < offinc then let v' = v + offset in rev_assocd v' theta (Fvar(v')) else rev_assocd v theta tm | Fnapp(f,args) -> let args' = qmap (fol_subst_bump offset theta) args in if args' == args then tm else Fnapp(f,args') let fol_inst_bump offset theta ((p,args) as at:fol_atom) = let args' = qmap (fol_subst_bump offset theta) args in if args' == args then at else p,args' (* ----------------------------------------------------------------------- *) (* Main unification function, maintaining a "graph" instantiation. *) (* We implicitly apply an offset to variables in the second term, so this *) (* is not symmetric between the arguments. *) (* ----------------------------------------------------------------------- *) let rec istriv env x t = match t with Fvar y -> y = x || (try let t' = rev_assoc y env in istriv env x t' with Failure "find" -> false) | Fnapp(f,args) -> exists (istriv env x) args && failwith "cyclic" let rec fol_unify offset tm1 tm2 sofar = match tm1,tm2 with Fnapp(f,fargs),Fnapp(g,gargs) -> if f <> g then failwith "" else itlist2 (fol_unify offset) fargs gargs sofar | _,Fvar(x) -> (let x' = x + offset in try let tm2' = rev_assoc x' sofar in fol_unify 0 tm1 tm2' sofar with Failure "find" -> if istriv sofar x' tm1 then sofar else (tm1,x')::sofar) | Fvar(x),_ -> (try let tm1' = rev_assoc x sofar in fol_unify offset tm1' tm2 sofar with Failure "find" -> let tm2' = fol_subst_bump offset [] tm2 in if istriv sofar x tm2' then sofar else (tm2',x)::sofar) (* ----------------------------------------------------------------------- *) (* Test for equality under the pending instantiations. *) (* ----------------------------------------------------------------------- *) let rec fol_eq insts tm1 tm2 = tm1 == tm2 || match tm1,tm2 with Fnapp(f,fargs),Fnapp(g,gargs) -> f = g && forall2 (fol_eq insts) fargs gargs | _,Fvar(x) -> (try let tm2' = rev_assoc x insts in fol_eq insts tm1 tm2' with Failure "find" -> try istriv insts x tm1 with Failure _ -> false) | Fvar(x),_ -> (try let tm1' = rev_assoc x insts in fol_eq insts tm1' tm2 with Failure "find" -> try istriv insts x tm2 with Failure _ -> false) let fol_atom_eq insts (p1,args1) (p2,args2) = p1 = p2 && forall2 (fol_eq insts) args1 args2 (* ----------------------------------------------------------------------- *) (* Cacheing continuations. Very crude, but it works remarkably well. *) (* ----------------------------------------------------------------------- *) let cacheconts f = let memory = ref [] in fun (gg,(insts,offset,size) as input) -> if exists (fun (_,(insts',_,size')) -> insts = insts' && (size <= size' || !meson_depth)) (!memory) then failwith "cachecont" else memory := input::(!memory); f input (* ----------------------------------------------------------------------- *) (* Check ancestor list for repetition. *) (* ----------------------------------------------------------------------- *) let checkan insts (p,a) ancestors = let p' = -p in let t' = (p',a) in try let ours = assoc p' ancestors in if exists (fun u -> fol_atom_eq insts t' (snd(fst u))) ours then failwith "checkan" else ancestors with Failure "find" -> ancestors (* ----------------------------------------------------------------------- *) (* Insert new goal's negation in ancestor clause, given refinement. *) (* ----------------------------------------------------------------------- *) let insertan insts (p,a) ancestors = let p' = -p in let t' = (p',a) in let ourancp,otheranc = try remove (fun (pr,_) -> pr = p') ancestors with Failure _ -> (p',[]),ancestors in let ouranc = snd ourancp in if exists (fun u -> fol_atom_eq insts t' (snd(fst u))) ouranc then failwith "insertan: loop" else (p',(([],t'),(0,TRUTH))::ouranc)::otheranc (* ----------------------------------------------------------------------- *) (* Apply a multi-level "graph" instantiation. *) (* ----------------------------------------------------------------------- *) let rec fol_subst_partial insts tm = match tm with Fvar(v) -> (try let t = rev_assoc v insts in fol_subst_partial insts t with Failure "find" -> tm) | Fnapp(f,args) -> Fnapp(f,map (fol_subst_partial insts) args) (* ----------------------------------------------------------------------- *) (* Tease apart local and global instantiations. *) (* At the moment we also force a full evaluation; should eliminate this. *) (* ----------------------------------------------------------------------- *) let separate_insts offset oldinsts newinsts = let locins,globins = qpartition (fun (_,v) -> offset <= v) oldinsts newinsts in if globins = oldinsts then map (fun (t,x) -> fol_subst_partial newinsts t,x) locins,oldinsts else map (fun (t,x) -> fol_subst_partial newinsts t,x) locins, map (fun (t,x) -> fol_subst_partial newinsts t,x) globins (* ----------------------------------------------------------------------- *) (* Perform basic MESON expansion. *) (* ----------------------------------------------------------------------- *) let meson_single_expand loffset rule ((g,ancestors),(insts,offset,size)) = let (hyps,conc),tag = rule in let allins = rev_itlist2 (fol_unify loffset) (snd g) (snd conc) insts in let locin,globin = separate_insts offset insts allins in let mk_ihyp h = let h' = fol_inst_bump offset locin h in h',checkan insts h' ancestors in let newhyps = map mk_ihyp hyps in inferences := !inferences + 1; newhyps,(globin,offset+offinc,size-length hyps) (* ----------------------------------------------------------------------- *) (* Perform first basic expansion which allows continuation call. *) (* ----------------------------------------------------------------------- *) let meson_expand_cont loffset rules state cont = tryfind (fun r -> cont (snd r) (meson_single_expand loffset r state)) rules (* ----------------------------------------------------------------------- *) (* Try expansion and continuation call with ancestor or initial rule. *) (* ----------------------------------------------------------------------- *) let meson_expand rules ((g,ancestors),((insts,offset,size) as tup)) cont = let pr = fst g in let newancestors = insertan insts g ancestors in let newstate = (g,newancestors),tup in try if !meson_prefine && pr > 0 then failwith "meson_expand" else let arules = assoc pr ancestors in meson_expand_cont 0 arules newstate cont with Cut -> failwith "meson_expand" | Failure _ -> try let crules = filter (fun ((h,_),_) -> length h <= size) (assoc pr rules) in meson_expand_cont offset crules newstate cont with Cut -> failwith "meson_expand" | Failure _ -> failwith "meson_expand" (* ----------------------------------------------------------------------- *) (* Simple Prolog engine organizing search and backtracking. *) (* ----------------------------------------------------------------------- *) let expand_goal rules = let rec expand_goal depth ((g,_),(insts,offset,size) as state) cont = if depth < 0 then failwith "expand_goal: too deep" else meson_expand rules state (fun apprule (_,(pinsts,_,_) as newstate) -> expand_goals (depth-1) newstate (cacheconts(fun (gs,(newinsts,newoffset,newsize)) -> let locin,globin = separate_insts offset pinsts newinsts in let g' = Subgoal(g,gs,apprule,offset,locin) in if globin = insts && gs = [] then try cont(g',(globin,newoffset,size)) with Failure _ -> raise Cut else try cont(g',(globin,newoffset,newsize)) with Cut -> failwith "expand_goal" | Failure _ -> failwith "expand_goal"))) and expand_goals depth (gl,(insts,offset,size as tup)) cont = match gl with [] -> cont ([],tup) | [g] -> expand_goal depth (g,tup) (fun (g',stup) -> cont([g'],stup)) | gl -> if size >= !meson_dcutin then let lsize = size / (!meson_skew) in let rsize = size - lsize in let lgoals,rgoals = chop_list (length gl / 2) gl in try expand_goals depth (lgoals,(insts,offset,lsize)) (cacheconts(fun (lg',(i,off,n)) -> expand_goals depth (rgoals,(i,off,n + rsize)) (cacheconts(fun (rg',ztup) -> cont (lg'@rg',ztup))))) with Failure _ -> expand_goals depth (rgoals,(insts,offset,lsize)) (cacheconts(fun (rg',(i,off,n)) -> expand_goals depth (lgoals,(i,off,n + rsize)) (cacheconts (fun (lg',((_,_,fsize) as ztup)) -> if n + rsize <= lsize + fsize then failwith "repetition of demigoal pair" else cont (lg'@rg',ztup))))) else let g::gs = gl in expand_goal depth (g,tup) (cacheconts(fun (g',stup) -> expand_goals depth (gs,stup) (cacheconts(fun (gs',ftup) -> cont(g'::gs',ftup))))) in fun g maxdep maxinf cont -> expand_goal maxdep (g,([],2 * offinc,maxinf)) cont (* ----------------------------------------------------------------------- *) (* With iterative deepening of inferences or depth. *) (* ----------------------------------------------------------------------- *) let solve_goal rules incdepth min max incsize = let rec solve n g = if n > max then failwith "solve_goal: Too deep" else (if !meson_chatty && !verbose then (Format.print_string ((string_of_int (!inferences))^" inferences so far. "^ "Searching with maximum size "^(string_of_int n)^"."); Format.print_newline()) else if !verbose then (Format.print_string(string_of_int (!inferences)^".."); Format.print_flush()) else ()); try let gi = if incdepth then expand_goal rules g n 100000 (fun x -> x) else expand_goal rules g 100000 n (fun x -> x) in (if !meson_chatty && !verbose then (Format.print_string ("Goal solved with "^(string_of_int (!inferences))^ " inferences."); Format.print_newline()) else if !verbose then (Format.print_string("solved at "^string_of_int (!inferences)); Format.print_newline()) else ()); gi with Failure _ -> solve (n + incsize) g in fun g -> solve min (g,[]) (* ----------------------------------------------------------------------- *) (* Creation of tagged contrapositives from a HOL clause. *) (* This includes any possible support clauses (1 = falsity). *) (* The rules are partitioned into association lists. *) (* ----------------------------------------------------------------------- *) let fol_of_hol_clauses = let eqt (a1,(b1,c1)) (a2, (b2,c2)) = ((a1 = a2) && (b1 = b2) && (equals_thm c1 c2)) in let rec mk_contraposes n th used unused sofar = match unused with [] -> sofar | h::t -> let nw = (map mk_negated (used @ t),h),(n,th) in mk_contraposes (n + 1) th (used@[h]) t (nw::sofar) in let fol_of_hol_clause th = let lconsts = freesl (hyp th) in let tm = concl th in let hlits = disjuncts tm in let flits = map (fol_of_literal [] lconsts) hlits in let basics = mk_contraposes 0 th [] flits [] in if forall (fun (p,_) -> p < 0) flits then ((map mk_negated flits,(1,[])),(-1,th))::basics else basics in fun thms -> let rawrules = itlist (union' eqt o fol_of_hol_clause) thms [] in let prs = setify (map (fst o snd o fst) rawrules) in let prules = map (fun t -> t,filter ((=) t o fst o snd o fst) rawrules) prs in let srules = sort (fun (p,_) (q,_) -> abs(p) <= abs(q)) prules in srules (* ----------------------------------------------------------------------- *) (* Optimize set of clauses; changing literal order complicates HOL stuff. *) (* ----------------------------------------------------------------------- *) let optimize_rules = let optimize_clause_order cls = sort (fun ((l1,_),_) ((l2,_),_) -> length l1 <= length l2) cls in map (fun (a,b) -> a,optimize_clause_order b) (* ----------------------------------------------------------------------- *) (* Create a HOL contrapositive on demand, with a cache. *) (* ----------------------------------------------------------------------- *) let clear_contrapos_cache,make_hol_contrapos = let DISJ_AC = AC DISJ_ACI and imp_CONV = REWR_CONV(TAUT `a \/ b <=> ~b ==> a`) and push_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV [TAUT `~(a \/ b) <=> ~a /\ ~b`; TAUT `~(~a) <=> a`] and pull_CONV = GEN_REWRITE_CONV DEPTH_CONV [TAUT `~a \/ ~b <=> ~(a /\ b)`] and imf_CONV = REWR_CONV(TAUT `~p <=> p ==> F`) in let memory = ref [] in let clear_contrapos_cache() = memory := [] in let make_hol_contrapos (n,th) = let tm = concl th in let key = (n,tm) in try assoc key (!memory) with Failure _ -> if n < 0 then CONV_RULE (pull_CONV THENC imf_CONV) th else let djs = disjuncts tm in let acth = if n = 0 then th else let ldjs,rdjs = chop_list n djs in let ndjs = (hd rdjs)::(ldjs@(tl rdjs)) in EQ_MP (DISJ_AC(mk_eq(tm,list_mk_disj ndjs))) th in let fth = if length djs = 1 then acth else CONV_RULE (imp_CONV THENC push_CONV) acth in (memory := (key,fth)::(!memory); fth) in clear_contrapos_cache,make_hol_contrapos (* ---------------------------------------------------------------------- *) (* Handle trivial start/finish stuff. *) (* ---------------------------------------------------------------------- *) let finish_RULE = GEN_REWRITE_RULE I [TAUT `(~p ==> p) <=> p`; TAUT `(p ==> ~p) <=> ~p`] (* ----------------------------------------------------------------------- *) (* Translate back the saved proof into HOL. *) (* ----------------------------------------------------------------------- *) let meson_to_hol = let hol_negate tm = try dest_neg tm with Failure _ -> mk_neg tm in let merge_inst (t,x) current = (fol_subst current t,x)::current in let rec meson_to_hol insts (Subgoal(g,gs,(n,th),offset,locin)) = let newins = itlist merge_inst locin insts in let g' = fol_inst newins g in let hol_g = hol_of_literal g' in let ths = map (meson_to_hol newins) gs in let hth = if equals_thm th TRUTH then ASSUME hol_g else let cth = make_hol_contrapos(n,th) in if ths = [] then cth else MATCH_MP cth (end_itlist CONJ ths) in let ith = PART_MATCH I hth hol_g in finish_RULE (DISCH (hol_negate(concl ith)) ith) in meson_to_hol (* ----------------------------------------------------------------------- *) (* Create equality axioms for all the function and predicate symbols in *) (* a HOL term. Not very efficient (but then neither is throwing them into *) (* automated proof search!) *) (* ----------------------------------------------------------------------- *) let create_equality_axioms = let eq_thms = (CONJUNCTS o prove) (`(x:A = x) /\ (~(x:A = y) \/ ~(x = z) \/ (y = z))`, REWRITE_TAC[] THEN ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THEN CONV_TAC TAUT) in let imp_elim_CONV = REWR_CONV (TAUT `(a ==> b) <=> ~a \/ b`) in let eq_elim_RULE = MATCH_MP(TAUT `(a <=> b) ==> b \/ ~a`) in let veq_tm = rator(rator(concl(hd eq_thms))) in let create_equivalence_axioms (eq,_) = let tyins = type_match (type_of veq_tm) (type_of eq) [] in map (INST_TYPE tyins) eq_thms in let rec tm_consts tm acc = let fn,args = strip_comb tm in if args = [] then acc else itlist tm_consts args (insert (fn,length args) acc) in let rec fm_consts tm ((preds,funs) as acc) = try fm_consts(snd(dest_forall tm)) acc with Failure _ -> try fm_consts(snd(dest_exists tm)) acc with Failure _ -> try let l,r = dest_conj tm in fm_consts l (fm_consts r acc) with Failure _ -> try let l,r = dest_disj tm in fm_consts l (fm_consts r acc) with Failure _ -> try let l,r = dest_imp tm in fm_consts l (fm_consts r acc) with Failure _ -> try fm_consts (dest_neg tm) acc with Failure _ -> try let l,r = dest_eq tm in if type_of l = bool_ty then fm_consts r (fm_consts l acc) else failwith "atomic equality" with Failure _ -> let pred,args = strip_comb tm in if args = [] then acc else insert (pred,length args) preds,itlist tm_consts args funs in let create_congruence_axiom pflag (tm,len) = let atys,rty = splitlist (fun ty -> let op,l = dest_type ty in if op = "fun" then hd l,hd(tl l) else fail()) (type_of tm) in let ctys = fst(chop_list len atys) in let largs = map genvar ctys and rargs = map genvar ctys in let th1 = rev_itlist (C (curry MK_COMB)) (map (ASSUME o mk_eq) (zip largs rargs)) (REFL tm) in let th2 = if pflag then eq_elim_RULE th1 else th1 in itlist (fun e th -> CONV_RULE imp_elim_CONV (DISCH e th)) (hyp th2) th2 in fun tms -> let preds,funs = itlist fm_consts tms ([],[]) in let eqs0,noneqs = partition (fun (t,_) -> is_const t && fst(dest_const t) = "=") preds in if eqs0 = [] then [] else let pcongs = map (create_congruence_axiom true) noneqs and fcongs = map (create_congruence_axiom false) funs in let preds1,_ = itlist fm_consts (map concl (pcongs @ fcongs)) ([],[]) in let eqs1 = filter (fun (t,_) -> is_const t && fst(dest_const t) = "=") preds1 in let eqs = union eqs0 eqs1 in let equivs = itlist (union' equals_thm o create_equivalence_axioms) eqs [] in equivs@pcongs@fcongs (* ----------------------------------------------------------------------- *) (* Brand's transformation. *) (* ----------------------------------------------------------------------- *) let perform_brand_modification = let rec subterms_irrefl lconsts tm acc = if is_var tm || is_const tm then acc else let fn,args = strip_comb tm in itlist (subterms_refl lconsts) args acc and subterms_refl lconsts tm acc = if is_var tm then if mem tm lconsts then insert tm acc else acc else if is_const tm then insert tm acc else let fn,args = strip_comb tm in itlist (subterms_refl lconsts) args (insert tm acc) in let CLAUSIFY = CONV_RULE(REWR_CONV(TAUT `a ==> b <=> ~a \/ b`)) in let rec BRAND tms th = if tms = [] then th else let tm = hd tms in let gv = genvar (type_of tm) in let eq = mk_eq(gv,tm) in let th' = CLAUSIFY (DISCH eq (SUBS [SYM (ASSUME eq)] th)) and tms' = map (subst [gv,tm]) (tl tms) in BRAND tms' th' in let BRAND_CONGS th = let lconsts = freesl (hyp th) in let lits = disjuncts (concl th) in let atoms = map (fun t -> try dest_neg t with Failure _ -> t) lits in let eqs,noneqs = partition (fun t -> try fst(dest_const(fst(strip_comb t))) = "=" with Failure _ -> false) atoms in let acc = itlist (subterms_irrefl lconsts) noneqs [] in let uts = itlist (itlist (subterms_irrefl lconsts) o snd o strip_comb) eqs acc in let sts = sort (fun s t -> not(free_in s t)) uts in BRAND sts th in let BRANDE th = let tm = concl th in let l,r = dest_eq tm in let gv = genvar(type_of l) in let eq = mk_eq(r,gv) in CLAUSIFY(DISCH eq (EQ_MP (AP_TERM (rator tm) (ASSUME eq)) th)) in let LDISJ_CASES th lth rth = DISJ_CASES th (DISJ1 lth (concl rth)) (DISJ2 (concl lth) rth) in let ASSOCIATE = CONV_RULE(REWR_CONV(GSYM DISJ_ASSOC)) in let rec BRAND_TRANS th = let tm = concl th in try let l,r = dest_disj tm in if is_eq l then let lth = ASSUME l in let lth1 = BRANDE lth and lth2 = BRANDE (SYM lth) and rth = BRAND_TRANS (ASSUME r) in map (ASSOCIATE o LDISJ_CASES th lth1) rth @ map (ASSOCIATE o LDISJ_CASES th lth2) rth else let rth = BRAND_TRANS (ASSUME r) in map (LDISJ_CASES th (ASSUME l)) rth with Failure _ -> if is_eq tm then [BRANDE th; BRANDE (SYM th)] else [th] in let find_eqs = find_terms (fun t -> try fst(dest_const t) = "=" with Failure _ -> false) in let REFLEXATE ths = let eqs = itlist (union o find_eqs o concl) ths [] in let tys = map (hd o snd o dest_type o snd o dest_const) eqs in let gvs = map genvar tys in itlist (fun v acc -> (REFL v)::acc) gvs ths in fun ths -> if exists (can (find_term is_eq o concl)) ths then let ths' = map BRAND_CONGS ths in let ths'' = itlist (union' equals_thm o BRAND_TRANS) ths' [] in REFLEXATE ths'' else ths (* ----------------------------------------------------------------------- *) (* Push duplicated copies of poly theorems to match existing assumptions. *) (* ----------------------------------------------------------------------- *) let POLY_ASSUME_TAC = let rec uniq' eq = fun l -> match l with x::(y::_ as t) -> let t' = uniq' eq t in if eq x y then t' else if t'==t then l else x::t' | _ -> l in let setify' le eq s = uniq' eq (sort le s) in let rec grab_constants tm acc = if is_forall tm || is_exists tm then grab_constants (body(rand tm)) acc else if is_iff tm || is_imp tm || is_conj tm || is_disj tm then grab_constants (rand tm) (grab_constants (lhand tm) acc) else if is_neg tm then grab_constants (rand tm) acc else union (find_terms is_const tm) acc in let match_consts (tm1,tm2) = let s1,ty1 = dest_const tm1 and s2,ty2 = dest_const tm2 in if s1 = s2 then type_match ty1 ty2 [] else failwith "match_consts" in let polymorph mconsts th = let tvs = subtract (type_vars_in_term (concl th)) (unions (map type_vars_in_term (hyp th))) in if tvs = [] then [th] else let pconsts = grab_constants (concl th) [] in let tyins = mapfilter match_consts (allpairs (fun x y -> x,y) pconsts mconsts) in let ths' = setify' (fun th th' -> dest_thm th <= dest_thm th') equals_thm (mapfilter (C INST_TYPE th) tyins) in if ths' = [] then (warn true "No useful-looking instantiations of lemma"; [th]) else ths' in let rec polymorph_all mconsts ths acc = if ths = [] then acc else let ths' = polymorph mconsts (hd ths) in let mconsts' = itlist grab_constants (map concl ths') mconsts in polymorph_all mconsts' (tl ths) (union' equals_thm ths' acc) in fun ths (asl,w as gl) -> let mconsts = itlist (grab_constants o concl o snd) asl [] in let ths' = polymorph_all mconsts ths [] in MAP_EVERY ASSUME_TAC ths' gl (* ----------------------------------------------------------------------- *) (* Basic HOL MESON procedure. *) (* ----------------------------------------------------------------------- *) let SIMPLE_MESON_REFUTE min max inc ths = clear_contrapos_cache(); inferences := 0; let old_dcutin = !meson_dcutin in if !meson_depth then meson_dcutin := 100001 else (); let ths' = if !meson_brand then perform_brand_modification ths else ths @ create_equality_axioms (map concl ths) in let rules = optimize_rules(fol_of_hol_clauses ths') in let proof,(insts,_,_) = solve_goal rules (!meson_depth) min max inc (1,[]) in meson_dcutin := old_dcutin; meson_to_hol insts proof let CONJUNCTS_THEN' ttac cth = ttac(CONJUNCT1 cth) THEN ttac(CONJUNCT2 cth) let PURE_MESON_TAC min max inc gl = reset_vars(); reset_consts(); (FIRST_ASSUM CONTR_TAC ORELSE W(ACCEPT_TAC o SIMPLE_MESON_REFUTE min max inc o map snd o fst)) gl let QUANT_BOOL_CONV = PURE_REWRITE_CONV[FORALL_BOOL_THM; EXISTS_BOOL_THM; COND_CLAUSES; NOT_CLAUSES; IMP_CLAUSES; AND_CLAUSES; OR_CLAUSES; EQ_CLAUSES; FORALL_SIMP; EXISTS_SIMP] let rec SPLIT_TAC n g = ((FIRST_X_ASSUM(CONJUNCTS_THEN' ASSUME_TAC) THEN SPLIT_TAC n) ORELSE (if n > 0 then FIRST_X_ASSUM DISJ_CASES_TAC THEN SPLIT_TAC (n - 1) else NO_TAC) ORELSE ALL_TAC) g end;; (* ------------------------------------------------------------------------- *) (* Basic MESON tactic with settable parameters. *) (* ------------------------------------------------------------------------- *) let GEN_MESON_TAC min max step ths = REFUTE_THEN ASSUME_TAC THEN Meson.POLY_ASSUME_TAC (map GEN_ALL ths) THEN W(MAP_EVERY(UNDISCH_TAC o concl o snd) o fst) THEN SELECT_ELIM_TAC THEN W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN CONV_TAC(PRESIMP_CONV THENC TOP_DEPTH_CONV BETA_CONV THENC LAMBDA_ELIM_CONV THENC CONDS_CELIM_CONV THENC Meson.QUANT_BOOL_CONV) THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN REFUTE_THEN ASSUME_TAC THEN RULE_ASSUM_TAC(CONV_RULE(NNF_CONV THENC SKOLEM_CONV)) THEN REPEAT (FIRST_X_ASSUM CHOOSE_TAC) THEN ASM_FOL_TAC THEN Meson.SPLIT_TAC (!meson_split_limit) THEN RULE_ASSUM_TAC(CONV_RULE(PRENEX_CONV THENC WEAK_CNF_CONV)) THEN RULE_ASSUM_TAC(repeat (fun th -> SPEC(genvar(type_of(fst(dest_forall(concl th))))) th)) THEN REPEAT (FIRST_X_ASSUM (Meson.CONJUNCTS_THEN' ASSUME_TAC)) THEN RULE_ASSUM_TAC(CONV_RULE(ASSOC_CONV DISJ_ASSOC)) THEN REPEAT (FIRST_X_ASSUM SUBST_VAR_TAC) THEN Meson.PURE_MESON_TAC min max step;; (* ------------------------------------------------------------------------- *) (* Common cases. *) (* ------------------------------------------------------------------------- *) let ASM_MESON_TAC = GEN_MESON_TAC 0 50 1;; let MESON_TAC ths = POP_ASSUM_LIST(K ALL_TAC) THEN ASM_MESON_TAC ths;; (* ------------------------------------------------------------------------- *) (* Also introduce a rule. *) (* ------------------------------------------------------------------------- *) let MESON ths tm = prove(tm,MESON_TAC ths);; hol-light/metis.ml000066400000000000000000012062221303454263000144250ustar00rootroot00000000000000(* ========================================================================= *) (* Metis first-order theorem proving derived rule/tactic for HOL Light. *) (* *) (* The original Metis was written by Joe Hurd, and it has been widely used *) (* for first-order proofs in HOL4 and Isabelle; see: *) (* *) (* http://www.gilith.com/research/metis/ *) (* *) (* This is a port from SML to OCaml and proof-reconstructing integration *) (* with HOL Light, written by Michael Färber and Cezary Kaliszyk. *) (* *) (* (c) Copyright, Joe Hurd, 2001 *) (* (c) Copyright, Joe Leslie-Hurd, 2004 *) (* (c) Copyright, Michael Färber and Cezary Kaliszyk, 2014-2016. *) (* *) (* Distributed under the same license as HOL Light. *) (* ========================================================================= *) needs "meson.ml";; (* ------------------------------------------------------------------------- *) (* Convenient utility modules. *) (* ------------------------------------------------------------------------- *) module Portable = struct let pointerEqual (p1, p2) = p1 == p2;; let randomInt x = Random.int x;; let randomWord () = Random.bits ();; let critical x = x;; end module Option = struct let getOpt = function (Some s, _) -> s | (None, x) -> x;; let isSome = function Some _ -> true | None -> false;; let mapPartial f = function None -> None | Some x -> f x;; end module Order = struct type order = Less | Equal | Greater;; let orderOfInt = function -1 -> Less | 0 -> Equal | 1 -> Greater | _ -> failwith "orderOfInt" ;; let intOfOrder = function Less -> -1 | Equal -> 0 | Greater -> 1 ;; let toCompare f = fun (x, y) -> orderOfInt (f x y);; let fromCompare f = fun x y -> intOfOrder (f (x, y));; end module Int = struct let toString = string_of_int;; let compare = Order.toCompare (compare : int -> int -> int);; let maxInt = Some max_int;; let div x y = x / y;; let abs = Pervasives.abs;; end module Real = struct open Order type real = float;; let compare = toCompare (compare : float -> float -> int);; let fromInt = float_of_int;; let floor x = int_of_float (floor x);; end (* ------------------------------------------------------------------------- *) (* Emulating SML Word type (which is unsigned) and other operations. *) (* ------------------------------------------------------------------------- *) module Word = struct open Order type word = int;; let compare = toCompare (compare: word -> word -> int);; let shiftLeft (x, y) = x lsl y;; let shiftRight (x, y) = x lsr y;; (* This is only the same as the SML version, if there is no overflow *) let minus (x,y) = x - y;; let andb (x,y) = x land y;; let orb (x,y) = x lor y;; let xorb (x,y) = x lxor y;; let notb x = lnot x let toInt x = x;; let fromInt x = x;; end module Math = struct let exp = Pervasives.exp;; let ln = Pervasives.log;; let sqrt = Pervasives.sqrt;; let pow (x,y) = x ** y;; end module Mlist = struct let foldl f a l = List.fold_left (fun acc x -> f (x, acc)) a l;; let foldr f a l = List.fold_right (fun x acc -> f (x, acc)) l a;; let nth (l, i) = List.nth l i;; let null = function [] -> true | _ -> false let tabulate (n,f) = let rec go i = if i == n then [] else f i :: go (i+1) in go 0 let revAppend (l1, l2) = List.rev_append l1 l2;; let find p l = try Some (List.find p l) with Not_found -> None;; let all = List.for_all;; end (* ========================================================================= *) (* ML UTILITY FUNCTIONS *) (* ========================================================================= *) module Useful = struct open Order (* ------------------------------------------------------------------------- *) (* OCaml lists (MF). *) (* ------------------------------------------------------------------------- *) let length = List.length;; let app = List.iter;; (* ------------------------------------------------------------------------- *) (* Characters (MF). *) (* ------------------------------------------------------------------------- *) let isDigit c = '0' <= c && c <= '9' (* ------------------------------------------------------------------------- *) (* Exceptions. *) (* ------------------------------------------------------------------------- *) exception Error of string;; exception Bug of string;; exception Subscript;; let total f x = try Some (f x) with Error _ -> None;; let isSome = function (Some _) -> true | None -> false ;; let can f x = isSome (total f x);; (* ------------------------------------------------------------------------- *) (* Combinators. *) (* ------------------------------------------------------------------------- *) let cComb f x y = f y x;; let iComb x = x;; let kComb x y = x;; let sComb f g x = f x (g x);; let wComb f x = f x x;; let rec funpow n f x = match n with 0 -> x | _ -> funpow (n - 1) f (f x);; let exp m = let rec f x y z = match y with 0 -> z | _ -> f (m (x,x)) (Int.div y 2) (if y mod 2 = 0 then z else m (z,x)) in f ;; (* ------------------------------------------------------------------------- *) (* Pairs. *) (* ------------------------------------------------------------------------- *) let pair x y = (x,y);; let swap (x,y) = (y,x);; let curry f x y = f (x,y);; let uncurry f (x,y) = f x y;; (* ------------------------------------------------------------------------- *) (* State transformers. *) (* ------------------------------------------------------------------------- *) let return : 'a -> 's -> 'a * 's = pair;; let bind f (g : 'a -> 's -> 'b * 's) x = uncurry g (f x);; (*fun mmap f (m : 's -> 'a * 's) = bind m (unit o f); fun mjoin (f : 's -> ('s -> 'a * 's) * 's) = bind f I; fun mwhile c b = let fun f a = if c a then bind (b a) f else unit a in f end;*) (* ------------------------------------------------------------------------- *) (* Comparisons. *) (* ------------------------------------------------------------------------- *) let revCompare cmp x_y = match cmp x_y with Less -> Greater | Equal -> Equal | Greater -> Less;; let prodCompare xCmp yCmp ((x1,y1),(x2,y2)) = match xCmp (x1,x2) with Less -> Less | Equal -> yCmp (y1,y2) | Greater -> Greater;; let lexCompare cmp = let rec lex = function ([],[]) -> Equal | ([], _ :: _) -> Less | (_ :: _, []) -> Greater | (x :: xs, y :: ys) -> (match cmp (x,y) with Less -> Less | Equal -> lex (xs,ys) | Greater -> Greater) in lex ;; let boolCompare = function (false,true) -> Less | (true,false) -> Greater | _ -> Equal;; (* ------------------------------------------------------------------------- *) (* Lists. *) (* ------------------------------------------------------------------------- *) let rec first f = function [] -> None | (x :: xs) -> (match f x with None -> first f xs | s -> s);; let rec maps (f : 'a -> 's -> 'b * 's) = function [] -> return [] | (x :: xs) -> bind (f x) (fun y -> bind (maps f xs) (fun ys -> return (y :: ys)));; let zipWith f = let rec z l = function ([], []) -> l | (x :: xs, y :: ys) -> z (f x y :: l) (xs, ys) | _ -> raise (Error "zipWith: lists different lengths") in fun xs -> fun ys -> List.rev (z [] (xs, ys)) ;; let zip xs ys = zipWith pair xs ys;; let unzip ab = let inc ((x,y),(xs,ys)) = (x :: xs, y :: ys) in Mlist.foldl inc ([],[]) (List.rev ab);; let enumerate l = fst (maps (fun x m -> ((m, x), m + 1)) l 0);; let revDivide l = let rec revDiv acc = function (l, 0) -> (acc,l) | ([], _) -> raise Subscript | (h :: t, n) -> revDiv (h :: acc) (t, n - 1) in fun n -> revDiv [] (l, n);; let divide l n = let (a,b) = revDivide l n in (List.rev a, b);; let updateNth (n,x) l = let (a,b) = revDivide l n in match b with [] -> raise Subscript | (_ :: t) -> List.rev_append a (x :: t) ;; let deleteNth n l = let (a,b) = revDivide l n in match b with [] -> raise Subscript | (_ :: t) -> List.rev_append a t ;; (* ------------------------------------------------------------------------- *) (* Sets implemented with lists. *) (* ------------------------------------------------------------------------- *) let mem x l = List.mem x l;; (* ------------------------------------------------------------------------- *) (* Strings. *) (* ------------------------------------------------------------------------- *) let mkPrefix p s = p ^ s let stripSuffix pred s = let rec strip pos = if pos < 0 then "" else if pred (s.[pos]) then strip (pos - 1) else String.sub s 0 (pos + 1) in strip (String.length s - 1);; (* ------------------------------------------------------------------------- *) (* Sorting and searching. *) (* ------------------------------------------------------------------------- *) let sort cmp = List.sort (fromCompare cmp);; let sortMap f cmp = function [] -> [] | ([_] as l) -> l | xs -> let ncmp ((m,_),(n,_)) = cmp (m,n) in let nxs = List.map (fun x -> (f x, x)) xs in let nys = List.sort (fromCompare ncmp) nxs in List.map snd nys ;; (* ------------------------------------------------------------------------- *) (* Integers. *) (* ------------------------------------------------------------------------- *) let rec interval m = function 0 -> [] | len -> m :: interval (m + 1) (len - 1);; let divides = function (_, 0) -> true | (0, _) -> false | (a, b) -> b mod (Int.abs a) = 0;; let divides = curry divides;; (* ------------------------------------------------------------------------- *) (* Useful impure features. *) (* ------------------------------------------------------------------------- *) let generator = ref 0;; let newIntThunk () = let n = !generator in generator := n + 1; n ;; let newIntsThunk k () = let n = !generator in generator := n + k; interval n k ;; let newInt () = newIntThunk ();; let newInts k = if k <= 0 then [] else (newIntsThunk k) ();; end (* ========================================================================= *) (* FINITE MAPS IMPLEMENTED WITH RANDOMLY BALANCED TREES *) (* ========================================================================= *) module Pmap = struct open Order (* ------------------------------------------------------------------------- *) (* Importing useful functionality. *) (* ------------------------------------------------------------------------- *) exception Bug = Useful.Bug;; exception Error = Useful.Error;; let pointerEqual = Portable.pointerEqual;; let kComb = Useful.kComb;; let randomInt = Portable.randomInt;; let randomWord = Portable.randomWord;; (* ------------------------------------------------------------------------- *) (* Converting a comparison function to an equality function. *) (* ------------------------------------------------------------------------- *) let equalKey compareKey key1 key2 = compareKey (key1,key2) = Equal;; (* ------------------------------------------------------------------------- *) (* Priorities. *) (* ------------------------------------------------------------------------- *) type priority = Word.word;; let randomPriority = randomWord;; let comparePriority = Word.compare;; (* ------------------------------------------------------------------------- *) (* Priority search trees. *) (* ------------------------------------------------------------------------- *) type ('key,'value) tree = Empty | Tree of ('key,'value) node and ('key,'value) node = {size : int; priority : priority; left : ('key,'value) tree; key : 'key; value : 'value; right : ('key,'value) tree};; let lowerPriorityNode node1 node2 = let {priority = p1} = node1 and {priority = p2} = node2 in comparePriority (p1,p2) = Less ;; (* ------------------------------------------------------------------------- *) (* Tree debugging functions. *) (* ------------------------------------------------------------------------- *) (*BasicDebug local let checkSizes tree = match tree with Empty -> 0 | Tree (Node {size,left,right,...}) -> let let l = checkSizes left and r = checkSizes right let () = if l + 1 + r = size then () else raise Bug "wrong size" in size end;; let checkSorted compareKey x tree = match tree with Empty -> x | Tree (Node {left,key,right,...}) -> let let x = checkSorted compareKey x left let () = match x with None -> () | Some k -> match compareKey (k,key) with Less -> () | Equal -> raise Bug "duplicate keys" | Greater -> raise Bug "unsorted" let x = Some key in checkSorted compareKey x right end;; let checkPriorities compareKey tree = match tree with Empty -> None | Tree node -> let let Node {left,right,...} = node let () = match checkPriorities compareKey left with None -> () | Some lnode -> if not (lowerPriorityNode node lnode) then () else raise Bug "left child has greater priority" let () = match checkPriorities compareKey right with None -> () | Some rnode -> if not (lowerPriorityNode node rnode) then () else raise Bug "right child has greater priority" in Some node end;; in let treeCheckInvariants compareKey tree = let let _ = checkSizes tree let _ = checkSorted compareKey None tree let _ = checkPriorities compareKey tree in tree end handle Error err -> raise (Bug err);; end;; *) (* ------------------------------------------------------------------------- *) (* Tree operations. *) (* ------------------------------------------------------------------------- *) let treeNew () = Empty;; let nodeSize ({size = x}) = x;; let treeSize tree = match tree with Empty -> 0 | Tree x -> nodeSize x;; let mkNode priority left key value right = let size = treeSize left + 1 + treeSize right in {size = size; priority = priority; left = left; key = key; value = value; right = right} ;; let mkTree priority left key value right = let node = mkNode priority left key value right in Tree node ;; (* ------------------------------------------------------------------------- *) (* Extracting the left and right spines of a tree. *) (* ------------------------------------------------------------------------- *) let rec treeLeftSpine acc tree = match tree with Empty -> acc | Tree node -> nodeLeftSpine acc node and nodeLeftSpine acc node = let {left=left} = node in treeLeftSpine (node :: acc) left ;; let rec treeRightSpine acc tree = match tree with Empty -> acc | Tree node -> nodeRightSpine acc node and nodeRightSpine acc node = let {right=right} = node in treeRightSpine (node :: acc) right ;; (* ------------------------------------------------------------------------- *) (* Singleton trees. *) (* ------------------------------------------------------------------------- *) let mkNodeSingleton priority key value = let size = 1 and left = Empty and right = Empty in {size = size; priority = priority; left = left; key = key; value = value; right = right} ;; let nodeSingleton (key,value) = let priority = randomPriority () in mkNodeSingleton priority key value ;; let treeSingleton key_value = let node = nodeSingleton key_value in Tree node ;; (* ------------------------------------------------------------------------- *) (* Appending two trees, where every element of the first tree is less than *) (* every element of the second tree. *) (* ------------------------------------------------------------------------- *) let rec treeAppend tree1 tree2 = match tree1 with Empty -> tree2 | Tree node1 -> match tree2 with Empty -> tree1 | Tree node2 -> if lowerPriorityNode node1 node2 then let {priority=priority;left=left;key=key;value=value;right=right} = node2 in let left = treeAppend tree1 left in mkTree priority left key value right else let {priority=priority;left=left;key=key;value=value;right=right} = node1 in let right = treeAppend right tree2 in mkTree priority left key value right ;; (* ------------------------------------------------------------------------- *) (* Appending two trees and a node, where every element of the first tree is *) (* less than the node, which in turn is less than every element of the *) (* second tree. *) (* ------------------------------------------------------------------------- *) let treeCombine left node right = let left_node = treeAppend left (Tree node) in treeAppend left_node right ;; (* ------------------------------------------------------------------------- *) (* Searching a tree for a value. *) (* ------------------------------------------------------------------------- *) let rec treePeek compareKey pkey tree = match tree with Empty -> None | Tree node -> nodePeek compareKey pkey node and nodePeek compareKey pkey node = let {left=left;key=key;value=value;right=right} = node in match compareKey (pkey,key) with Less -> treePeek compareKey pkey left | Equal -> Some value | Greater -> treePeek compareKey pkey right ;; (* ------------------------------------------------------------------------- *) (* Tree paths. *) (* ------------------------------------------------------------------------- *) (* Generating a path by searching a tree for a key/value pair *) let rec treePeekPath compareKey pkey path tree = match tree with Empty -> (path,None) | Tree node -> nodePeekPath compareKey pkey path node and nodePeekPath compareKey pkey path node = let {left=left;key=key;right=right} = node in match compareKey (pkey,key) with Less -> treePeekPath compareKey pkey ((true,node) :: path) left | Equal -> (path, Some node) | Greater -> treePeekPath compareKey pkey ((false,node) :: path) right ;; (* A path splits a tree into left/right components *) let addSidePath ((wentLeft,node),(leftTree,rightTree)) = let {priority=priority;left=left;key=key;value=value;right=right} = node in if wentLeft then (leftTree, mkTree priority rightTree key value right) else (mkTree priority left key value leftTree, rightTree) ;; let addSidesPath left_right = Mlist.foldl addSidePath left_right;; let mkSidesPath path = addSidesPath (Empty,Empty) path;; (* Updating the subtree at a path *) let updateTree ((wentLeft,node),tree) = let {priority=priority;left=left;key=key;value=value;right=right} = node in if wentLeft then mkTree priority tree key value right else mkTree priority left key value tree;; let updateTreePath tree = Mlist.foldl updateTree tree;; (* Inserting a new node at a path position *) let insertNodePath node = let rec insert left_right path = match path with [] -> let (left,right) = left_right in treeCombine left node right | ((_,snode) as step) :: rest -> if lowerPriorityNode snode node then let left_right = addSidePath (step,left_right) in insert left_right rest else let (left,right) = left_right in let tree = treeCombine left node right in updateTreePath tree path in insert (Empty,Empty) ;; (* ------------------------------------------------------------------------- *) (* Using a key to split a node into three components: the keys comparing *) (* less than the supplied key, an optional equal key, and the keys comparing *) (* greater. *) (* ------------------------------------------------------------------------- *) let nodePartition compareKey pkey node = let (path,pnode) = nodePeekPath compareKey pkey [] node in match pnode with None -> let (left,right) = mkSidesPath path in (left,None,right) | Some node -> let {left=left;key=key;value=value;right=right} = node in let (left,right) = addSidesPath (left,right) path in (left, Some (key,value), right) ;; (* ------------------------------------------------------------------------- *) (* Searching a tree for a key/value pair. *) (* ------------------------------------------------------------------------- *) let rec treePeekKey compareKey pkey tree = match tree with Empty -> None | Tree node -> nodePeekKey compareKey pkey node and nodePeekKey compareKey pkey node = let {left=left;key=key;value=value;right=right} = node in match compareKey (pkey,key) with Less -> treePeekKey compareKey pkey left | Equal -> Some (key,value) | Greater -> treePeekKey compareKey pkey right ;; (* ------------------------------------------------------------------------- *) (* Inserting new key/values into the tree. *) (* ------------------------------------------------------------------------- *) let treeInsert compareKey key_value tree = let (key,value) = key_value in let (path,inode) = treePeekPath compareKey key [] tree in match inode with None -> let node = nodeSingleton (key,value) in insertNodePath node path | Some node -> let {size=size;priority=priority;left=left;right=right} = node in let node = {size = size; priority = priority; left = left; key = key; value = value; right = right} in updateTreePath (Tree node) path ;; (* ------------------------------------------------------------------------- *) (* Deleting key/value pairs: it raises an exception if the supplied key is *) (* not present. *) (* ------------------------------------------------------------------------- *) let rec treeDelete compareKey dkey tree = match tree with Empty -> raise (Bug "Map.delete: element not found") | Tree node -> nodeDelete compareKey dkey node and nodeDelete compareKey dkey node = let {size=size;priority=priority;left=left;key=key;value=value;right=right} = node in match compareKey (dkey,key) with Less -> let size = size - 1 and left = treeDelete compareKey dkey left in let node = {size = size; priority = priority; left = left; key = key; value = value; right = right} in Tree node | Equal -> treeAppend left right | Greater -> let size = size - 1 and right = treeDelete compareKey dkey right in let node = {size = size; priority = priority; left = left; key = key; value = value; right = right} in Tree node ;; (* ------------------------------------------------------------------------- *) (* Partial map is the basic operation for preserving tree structure. *) (* It applies its argument function to the elements *in order*. *) (* ------------------------------------------------------------------------- *) let rec treeMapPartial f tree = match tree with Empty -> Empty | Tree node -> nodeMapPartial f node and nodeMapPartial f ({priority=priority;left=left;key=key;value=value;right=right}) = let left = treeMapPartial f left and vo = f (key,value) and right = treeMapPartial f right in match vo with None -> treeAppend left right | Some value -> mkTree priority left key value right ;; (* ------------------------------------------------------------------------- *) (* Mapping tree values. *) (* ------------------------------------------------------------------------- *) let rec treeMap f tree = match tree with Empty -> Empty | Tree node -> Tree (nodeMap f node) and nodeMap f node = let {size=size;priority=priority;left=left;key=key;value=value;right=right} = node in let left = treeMap f left and value = f (key,value) and right = treeMap f right in {size = size; priority = priority; left = left; key = key; value = value; right = right} ;; (* ------------------------------------------------------------------------- *) (* Merge is the basic operation for joining two trees. Note that the merged *) (* key is always the one from the second map. *) (* ------------------------------------------------------------------------- *) let rec treeMerge compareKey f1 f2 fb tree1 tree2 = match tree1 with Empty -> treeMapPartial f2 tree2 | Tree node1 -> match tree2 with Empty -> treeMapPartial f1 tree1 | Tree node2 -> nodeMerge compareKey f1 f2 fb node1 node2 and nodeMerge compareKey f1 f2 fb node1 node2 = let {priority=priority;left=left;key=key;value=value;right=right} = node2 in let (l,kvo,r) = nodePartition compareKey key node1 in let left = treeMerge compareKey f1 f2 fb l left and right = treeMerge compareKey f1 f2 fb r right in let vo = match kvo with None -> f2 (key,value) | Some kv -> fb (kv,(key,value)) in match vo with None -> treeAppend left right | Some value -> let node = mkNodeSingleton priority key value in treeCombine left node right ;; (* ------------------------------------------------------------------------- *) (* A union operation on trees. *) (* ------------------------------------------------------------------------- *) let rec treeUnion compareKey f f2 tree1 tree2 = match tree1 with Empty -> tree2 | Tree node1 -> match tree2 with Empty -> tree1 | Tree node2 -> nodeUnion compareKey f f2 node1 node2 and nodeUnion compareKey f f2 node1 node2 = if pointerEqual (node1,node2) then nodeMapPartial f2 node1 else let {priority=priority;left=left;key=key;value=value;right=right} = node2 in let (l,kvo,r) = nodePartition compareKey key node1 in let left = treeUnion compareKey f f2 l left and right = treeUnion compareKey f f2 r right in let vo = match kvo with None -> Some value | Some kv -> f (kv,(key,value)) in match vo with None -> treeAppend left right | Some value -> let node = mkNodeSingleton priority key value in treeCombine left node right ;; (* ------------------------------------------------------------------------- *) (* An intersect operation on trees. *) (* ------------------------------------------------------------------------- *) let rec treeIntersect compareKey f t1 t2 = match t1 with Empty -> Empty | Tree n1 -> match t2 with Empty -> Empty | Tree n2 -> nodeIntersect compareKey f n1 n2 and nodeIntersect compareKey f n1 n2 = let {priority=priority;left=left;key=key;value=value;right=right} = n2 in let (l,kvo,r) = nodePartition compareKey key n1 in let left = treeIntersect compareKey f l left and right = treeIntersect compareKey f r right in let vo = match kvo with None -> None | Some kv -> f (kv,(key,value)) in match vo with None -> treeAppend left right | Some value -> mkTree priority left key value right ;; (* ------------------------------------------------------------------------- *) (* A union operation on trees which simply chooses the second value. *) (* ------------------------------------------------------------------------- *) let rec treeUnionDomain compareKey tree1 tree2 = match tree1 with Empty -> tree2 | Tree node1 -> match tree2 with Empty -> tree1 | Tree node2 -> if pointerEqual (node1,node2) then tree2 else nodeUnionDomain compareKey node1 node2 and nodeUnionDomain compareKey node1 node2 = let {priority=priority;left=left;key=key;value=value;right=right} = node2 in let (l,_,r) = nodePartition compareKey key node1 in let left = treeUnionDomain compareKey l left and right = treeUnionDomain compareKey r right in let node = mkNodeSingleton priority key value in treeCombine left node right ;; (* ------------------------------------------------------------------------- *) (* An intersect operation on trees which simply chooses the second value. *) (* ------------------------------------------------------------------------- *) let rec treeIntersectDomain compareKey tree1 tree2 = match tree1 with Empty -> Empty | Tree node1 -> match tree2 with Empty -> Empty | Tree node2 -> if pointerEqual (node1,node2) then tree2 else nodeIntersectDomain compareKey node1 node2 and nodeIntersectDomain compareKey node1 node2 = let {priority=priority;left=left;key=key;value=value;right=right} = node2 in let (l,kvo,r) = nodePartition compareKey key node1 in let left = treeIntersectDomain compareKey l left and right = treeIntersectDomain compareKey r right in if Option.isSome kvo then mkTree priority left key value right else treeAppend left right ;; (* ------------------------------------------------------------------------- *) (* A difference operation on trees. *) (* ------------------------------------------------------------------------- *) let rec treeDifferenceDomain compareKey t1 t2 = match t1 with Empty -> Empty | Tree n1 -> match t2 with Empty -> t1 | Tree n2 -> nodeDifferenceDomain compareKey n1 n2 and nodeDifferenceDomain compareKey n1 n2 = if pointerEqual (n1,n2) then Empty else let {priority=priority;left=left;key=key;value=value;right=right} = n1 in let (l,kvo,r) = nodePartition compareKey key n2 in let left = treeDifferenceDomain compareKey left l and right = treeDifferenceDomain compareKey right r in if Option.isSome kvo then treeAppend left right else mkTree priority left key value right ;; (* ------------------------------------------------------------------------- *) (* A subset operation on trees. *) (* ------------------------------------------------------------------------- *) let rec treeSubsetDomain compareKey tree1 tree2 = match tree1 with Empty -> true | Tree node1 -> match tree2 with Empty -> false | Tree node2 -> nodeSubsetDomain compareKey node1 node2 and nodeSubsetDomain compareKey node1 node2 = pointerEqual (node1,node2) || let {size=size;left=left;key=key;right=right} = node1 in size <= nodeSize node2 && let (l,kvo,r) = nodePartition compareKey key node2 in Option.isSome kvo && treeSubsetDomain compareKey left l && treeSubsetDomain compareKey right r ;; (* ------------------------------------------------------------------------- *) (* Picking an arbitrary key/value pair from a tree. *) (* ------------------------------------------------------------------------- *) let rec nodePick node = let {key=key;value=value} = node in (key,value) ;; let treePick tree = match tree with Empty -> raise (Bug "Map.treePick") | Tree node -> nodePick node;; (* ------------------------------------------------------------------------- *) (* Removing an arbitrary key/value pair from a tree. *) (* ------------------------------------------------------------------------- *) let rec nodeDeletePick node = let {left=left;key=key;value=value;right=right} = node in ((key,value), treeAppend left right) ;; let treeDeletePick tree = match tree with Empty -> raise (Bug "Map.treeDeletePick") | Tree node -> nodeDeletePick node;; (* ------------------------------------------------------------------------- *) (* Finding the nth smallest key/value (counting from 0). *) (* ------------------------------------------------------------------------- *) let rec treeNth n tree = match tree with Empty -> raise (Bug "Map.treeNth") | Tree node -> nodeNth n node and nodeNth n node = let {left=left;key=key;value=value;right=right} = node in let k = treeSize left in if n = k then (key,value) else if n < k then treeNth n left else treeNth (n - (k + 1)) right ;; (* ------------------------------------------------------------------------- *) (* Removing the nth smallest key/value (counting from 0). *) (* ------------------------------------------------------------------------- *) let rec treeDeleteNth n tree = match tree with Empty -> raise (Bug "Map.treeDeleteNth") | Tree node -> nodeDeleteNth n node and nodeDeleteNth n node = let {size=size;priority=priority;left=left;key=key;value=value;right=right} = node in let k = treeSize left in if n = k then ((key,value), treeAppend left right) else if n < k then let (key_value,left) = treeDeleteNth n left in let size = size - 1 in let node = {size = size; priority = priority; left = left; key = key; value = value; right = right} in (key_value, Tree node) else let n = n - (k + 1) in let (key_value,right) = treeDeleteNth n right in let size = size - 1 in let node = {size = size; priority = priority; left = left; key = key; value = value; right = right} in (key_value, Tree node) ;; (* ------------------------------------------------------------------------- *) (* Iterators. *) (* ------------------------------------------------------------------------- *) type ('key,'value) iterator = Left_to_right_iterator of ('key * 'value) * ('key,'value) tree * ('key,'value) node list | Right_to_left_iterator of ('key * 'value) * ('key,'value) tree * ('key,'value) node list;; let fromSpineLeftToRightIterator nodes = match nodes with [] -> None | {key=key;value=value;right=right} :: nodes -> Some (Left_to_right_iterator ((key,value),right,nodes));; let fromSpineRightToLeftIterator nodes = match nodes with [] -> None | {key=key;value=value;left=left} :: nodes -> Some (Right_to_left_iterator ((key,value),left,nodes));; let addLeftToRightIterator nodes tree = fromSpineLeftToRightIterator (treeLeftSpine nodes tree);; let addRightToLeftIterator nodes tree = fromSpineRightToLeftIterator (treeRightSpine nodes tree);; let treeMkIterator tree = addLeftToRightIterator [] tree;; let treeMkRevIterator tree = addRightToLeftIterator [] tree;; let readIterator iter = match iter with Left_to_right_iterator (key_value,_,_) -> key_value | Right_to_left_iterator (key_value,_,_) -> key_value;; let advanceIterator iter = match iter with Left_to_right_iterator (_,tree,nodes) -> addLeftToRightIterator nodes tree | Right_to_left_iterator (_,tree,nodes) -> addRightToLeftIterator nodes tree;; let rec foldIterator f acc io = match io with None -> acc | Some iter -> let (key,value) = readIterator iter in foldIterator f (f (key,value,acc)) (advanceIterator iter) ;; let rec findIterator pred io = match io with None -> None | Some iter -> let key_value = readIterator iter in if pred key_value then Some key_value else findIterator pred (advanceIterator iter) ;; let rec firstIterator f io = match io with None -> None | Some iter -> let key_value = readIterator iter in match f key_value with None -> firstIterator f (advanceIterator iter) | s -> s ;; let rec compareIterator compareKey compareValue io1 io2 = match (io1,io2) with (None,None) -> Equal | (None, Some _) -> Less | (Some _, None) -> Greater | (Some i1, Some i2) -> let (k1,v1) = readIterator i1 and (k2,v2) = readIterator i2 in match compareKey (k1,k2) with Less -> Less | Equal -> (match compareValue (v1,v2) with Less -> Less | Equal -> let io1 = advanceIterator i1 and io2 = advanceIterator i2 in compareIterator compareKey compareValue io1 io2 | Greater -> Greater) | Greater -> Greater ;; let rec equalIterator equalKey equalValue io1 io2 = match (io1,io2) with (None,None) -> true | (None, Some _) -> false | (Some _, None) -> false | (Some i1, Some i2) -> let (k1,v1) = readIterator i1 and (k2,v2) = readIterator i2 in equalKey k1 k2 && equalValue v1 v2 && let io1 = advanceIterator i1 and io2 = advanceIterator i2 in equalIterator equalKey equalValue io1 io2 ;; (* ------------------------------------------------------------------------- *) (* A type of finite maps. *) (* ------------------------------------------------------------------------- *) type ('key,'value) map = Map of ('key * 'key -> order) * ('key,'value) tree;; (* ------------------------------------------------------------------------- *) (* Map debugging functions. *) (* ------------------------------------------------------------------------- *) (*BasicDebug let checkInvariants s m = let let Map (compareKey,tree) = m let _ = treeCheckInvariants compareKey tree in m end handle Bug bug -> raise (Bug (s ^ "\n" ^ "Map.checkInvariants: " ^ bug));; *) (* ------------------------------------------------------------------------- *) (* Constructors. *) (* ------------------------------------------------------------------------- *) let newMap compareKey = let tree = treeNew () in Map (compareKey,tree) ;; let singleton compareKey key_value = let tree = treeSingleton key_value in Map (compareKey,tree) ;; (* ------------------------------------------------------------------------- *) (* Map size. *) (* ------------------------------------------------------------------------- *) let size (Map (_,tree)) = treeSize tree;; let null m = size m = 0;; (* ------------------------------------------------------------------------- *) (* Querying. *) (* ------------------------------------------------------------------------- *) let peekKey (Map (compareKey,tree)) key = treePeekKey compareKey key tree;; let peek (Map (compareKey,tree)) key = treePeek compareKey key tree;; let inDomain key m = Option.isSome (peek m key);; let get m key = match peek m key with None -> raise (Error "Map.get: element not found") | Some value -> value;; let pick (Map (_,tree)) = treePick tree;; let nth (Map (_,tree)) n = treeNth n tree;; let random m = let n = size m in if n = 0 then raise (Bug "Map.random: empty") else nth m (randomInt n) ;; (* ------------------------------------------------------------------------- *) (* Adding. *) (* ------------------------------------------------------------------------- *) let insert (Map (compareKey,tree)) key_value = let tree = treeInsert compareKey key_value tree in Map (compareKey,tree) ;; (*BasicDebug let insert = fun m -> fun kv -> checkInvariants "Map.insert: result" (insert (checkInvariants "Map.insert: input" m) kv);; *) let insertList m = let ins (key_value,acc) = insert acc key_value in Mlist.foldl ins m ;; (* ------------------------------------------------------------------------- *) (* Removing. *) (* ------------------------------------------------------------------------- *) let delete (Map (compareKey,tree)) dkey = let tree = treeDelete compareKey dkey tree in Map (compareKey,tree) ;; (*BasicDebug let delete = fun m -> fun k -> checkInvariants "Map.delete: result" (delete (checkInvariants "Map.delete: input" m) k);; *) let remove m key = if inDomain key m then delete m key else m;; let deletePick (Map (compareKey,tree)) = let (key_value,tree) = treeDeletePick tree in (key_value, Map (compareKey,tree)) ;; (*BasicDebug let deletePick = fun m -> let let (kv,m) = deletePick (checkInvariants "Map.deletePick: input" m) in (kv, checkInvariants "Map.deletePick: result" m) end;; *) let deleteNth (Map (compareKey,tree)) n = let (key_value,tree) = treeDeleteNth n tree in (key_value, Map (compareKey,tree)) ;; (*BasicDebug let deleteNth = fun m -> fun n -> let let (kv,m) = deleteNth (checkInvariants "Map.deleteNth: input" m) n in (kv, checkInvariants "Map.deleteNth: result" m) end;; *) let deleteRandom m = let n = size m in if n = 0 then raise (Bug "Map.deleteRandom: empty") else deleteNth m (randomInt n) ;; (* ------------------------------------------------------------------------- *) (* Joining (all join operations prefer keys in the second map). *) (* ------------------------------------------------------------------------- *) let merge (first,second,both) (Map (compareKey,tree1)) (Map (_,tree2)) = let tree = treeMerge compareKey first second both tree1 tree2 in Map (compareKey,tree) ;; (*BasicDebug let merge = fun f -> fun m1 -> fun m2 -> checkInvariants "Map.merge: result" (merge f (checkInvariants "Map.merge: input 1" m1) (checkInvariants "Map.merge: input 2" m2));; *) let union f (Map (compareKey,tree1)) (Map (_,tree2)) = let f2 kv = f (kv,kv) in let tree = treeUnion compareKey f f2 tree1 tree2 in Map (compareKey,tree) ;; (*BasicDebug let union = fun f -> fun m1 -> fun m2 -> checkInvariants "Map.union: result" (union f (checkInvariants "Map.union: input 1" m1) (checkInvariants "Map.union: input 2" m2));; *) let intersect f (Map (compareKey,tree1)) (Map (_,tree2)) = let tree = treeIntersect compareKey f tree1 tree2 in Map (compareKey,tree) ;; (*BasicDebug let intersect = fun f -> fun m1 -> fun m2 -> checkInvariants "Map.intersect: result" (intersect f (checkInvariants "Map.intersect: input 1" m1) (checkInvariants "Map.intersect: input 2" m2));; *) (* ------------------------------------------------------------------------- *) (* Iterators over maps. *) (* ------------------------------------------------------------------------- *) let mkIterator (Map (_,tree)) = treeMkIterator tree;; let mkRevIterator (Map (_,tree)) = treeMkRevIterator tree;; (* ------------------------------------------------------------------------- *) (* Mapping and folding. *) (* ------------------------------------------------------------------------- *) let mapPartial f (Map (compareKey,tree)) = let tree = treeMapPartial f tree in Map (compareKey,tree) ;; (*BasicDebug let mapPartial = fun f -> fun m -> checkInvariants "Map.mapPartial: result" (mapPartial f (checkInvariants "Map.mapPartial: input" m));; *) let map f (Map (compareKey,tree)) = let tree = treeMap f tree in Map (compareKey,tree) ;; (*BasicDebug let map = fun f -> fun m -> checkInvariants "Map.map: result" (map f (checkInvariants "Map.map: input" m));; *) let transform f = map (fun (_,value) -> f value);; let filter pred = let f ((_,value) as key_value) = if pred key_value then Some value else None in mapPartial f ;; let partition p = let np x = not (p x) in fun m -> (filter p m, filter np m) ;; let foldl f b m = foldIterator f b (mkIterator m);; let foldr f b m = foldIterator f b (mkRevIterator m);; let app f m = foldl (fun (key,value,()) -> f (key,value)) () m;; (* ------------------------------------------------------------------------- *) (* Searching. *) (* ------------------------------------------------------------------------- *) let findl p m = findIterator p (mkIterator m);; let findr p m = findIterator p (mkRevIterator m);; let firstl f m = firstIterator f (mkIterator m);; let firstr f m = firstIterator f (mkRevIterator m);; let exists p m = Option.isSome (findl p m);; let all p = let np x = not (p x) in fun m -> not (exists np m) ;; let count pred = let f (k,v,acc) = if pred (k,v) then acc + 1 else acc in foldl f 0 ;; (* ------------------------------------------------------------------------- *) (* Comparing. *) (* ------------------------------------------------------------------------- *) let compare compareValue (m1,m2) = if pointerEqual (m1,m2) then Equal else match Int.compare (size m1, size m2) with Less -> Less | Equal -> let Map (compareKey,_) = m1 in let io1 = mkIterator m1 and io2 = mkIterator m2 in compareIterator compareKey compareValue io1 io2 | Greater -> Greater;; let equal equalValue m1 m2 = pointerEqual (m1,m2) || (size m1 = size m2 && let Map (compareKey,_) = m1 in let io1 = mkIterator m1 and io2 = mkIterator m2 in equalIterator (equalKey compareKey) equalValue io1 io2 );; (* ------------------------------------------------------------------------- *) (* Set operations on the domain. *) (* ------------------------------------------------------------------------- *) let unionDomain (Map (compareKey,tree1)) (Map (_,tree2)) = let tree = treeUnionDomain compareKey tree1 tree2 in Map (compareKey,tree) ;; (*BasicDebug let unionDomain = fun m1 -> fun m2 -> checkInvariants "Map.unionDomain: result" (unionDomain (checkInvariants "Map.unionDomain: input 1" m1) (checkInvariants "Map.unionDomain: input 2" m2));; *) let uncurriedUnionDomain (m,acc) = unionDomain acc m;; let unionListDomain ms = match ms with [] -> raise (Bug "Map.unionListDomain: no sets") | m :: ms -> Mlist.foldl uncurriedUnionDomain m ms;; let intersectDomain (Map (compareKey,tree1)) (Map (_,tree2)) = let tree = treeIntersectDomain compareKey tree1 tree2 in Map (compareKey,tree) ;; (*BasicDebug let intersectDomain = fun m1 -> fun m2 -> checkInvariants "Map.intersectDomain: result" (intersectDomain (checkInvariants "Map.intersectDomain: input 1" m1) (checkInvariants "Map.intersectDomain: input 2" m2));; *) let uncurriedIntersectDomain (m,acc) = intersectDomain acc m;; let intersectListDomain ms = match ms with [] -> raise (Bug "Map.intersectListDomain: no sets") | m :: ms -> Mlist.foldl uncurriedIntersectDomain m ms;; let differenceDomain (Map (compareKey,tree1)) (Map (_,tree2)) = let tree = treeDifferenceDomain compareKey tree1 tree2 in Map (compareKey,tree) ;; (*BasicDebug let differenceDomain = fun m1 -> fun m2 -> checkInvariants "Map.differenceDomain: result" (differenceDomain (checkInvariants "Map.differenceDomain: input 1" m1) (checkInvariants "Map.differenceDomain: input 2" m2));; *) let symmetricDifferenceDomain m1 m2 = unionDomain (differenceDomain m1 m2) (differenceDomain m2 m1);; let equalDomain m1 m2 = equal (kComb (kComb true)) m1 m2;; let subsetDomain (Map (compareKey,tree1)) (Map (_,tree2)) = treeSubsetDomain compareKey tree1 tree2;; let disjointDomain m1 m2 = null (intersectDomain m1 m2);; (* ------------------------------------------------------------------------- *) (* Converting to and from lists. *) (* ------------------------------------------------------------------------- *) let keys m = foldr (fun (key,_,l) -> key :: l) [] m;; let values m = foldr (fun (_,value,l) -> value :: l) [] m;; let toList m = foldr (fun (key,value,l) -> (key,value) :: l) [] m;; let fromList compareKey l = let m = newMap compareKey in insertList m l ;; (* ------------------------------------------------------------------------- *) (* Pretty-printing. *) (* ------------------------------------------------------------------------- *) let toString m = "<" ^ (if null m then "" else Int.toString (size m)) ^ ">";; end (* ------------------------------------------------------------------------- *) (* More map and set modules to support Metis. *) (* ------------------------------------------------------------------------- *) (* ========================================================================= *) (* FINITE SETS IMPLEMENTED WITH RANDOMLY BALANCED TREES *) (* ========================================================================= *) module Pset = struct open Order (* ------------------------------------------------------------------------- *) (* A type of finite sets. *) (* ------------------------------------------------------------------------- *) type ('elt,'a) map = ('elt,'a) Pmap.map;; type 'elt set = Set of ('elt,unit) map;; (* ------------------------------------------------------------------------- *) (* Converting to and from maps. *) (* ------------------------------------------------------------------------- *) let dest (Set m) = m;; let mapPartial f = let mf (elt,()) = f elt in fun (Set m) -> Pmap.mapPartial mf m ;; let map f = let mf (elt,()) = f elt in fun (Set m) -> Pmap.map mf m ;; let domain m = Set (Pmap.transform (fun _ -> ()) m);; (* ------------------------------------------------------------------------- *) (* Constructors. *) (* ------------------------------------------------------------------------- *) let empty cmp = Set (Pmap.newMap cmp);; let singleton cmp elt = Set (Pmap.singleton cmp (elt,()));; (* ------------------------------------------------------------------------- *) (* Set size. *) (* ------------------------------------------------------------------------- *) let null (Set m) = Pmap.null m;; let size (Set m) = Pmap.size m;; (* ------------------------------------------------------------------------- *) (* Querying. *) (* ------------------------------------------------------------------------- *) let peek (Set m) elt = match Pmap.peekKey m elt with Some (elt,()) -> Some elt | None -> None;; let member elt (Set m) = Pmap.inDomain elt m;; let pick (Set m) = let (elt,_) = Pmap.pick m in elt ;; let nth (Set m) n = let (elt,_) = Pmap.nth m n in elt ;; let random (Set m) = let (elt,_) = Pmap.random m in elt ;; (* ------------------------------------------------------------------------- *) (* Adding. *) (* ------------------------------------------------------------------------- *) let add (Set m) elt = let m = Pmap.insert m (elt,()) in Set m ;; let uncurriedAdd (elt,set) = add set elt;; let addList set = Mlist.foldl uncurriedAdd set;; (* ------------------------------------------------------------------------- *) (* Removing. *) (* ------------------------------------------------------------------------- *) let delete (Set m) elt = let m = Pmap.delete m elt in Set m ;; let remove (Set m) elt = let m = Pmap.remove m elt in Set m ;; let deletePick (Set m) = let ((elt,()),m) = Pmap.deletePick m in (elt, Set m) ;; let deleteNth (Set m) n = let ((elt,()),m) = Pmap.deleteNth m n in (elt, Set m) ;; let deleteRandom (Set m) = let ((elt,()),m) = Pmap.deleteRandom m in (elt, Set m) ;; (* ------------------------------------------------------------------------- *) (* Joining. *) (* ------------------------------------------------------------------------- *) let union (Set m1) (Set m2) = Set (Pmap.unionDomain m1 m2);; let unionList sets = let ms = List.map dest sets in Set (Pmap.unionListDomain ms) ;; let intersect (Set m1) (Set m2) = Set (Pmap.intersectDomain m1 m2);; let intersectList sets = let ms = List.map dest sets in Set (Pmap.intersectListDomain ms) ;; let difference (Set m1) (Set m2) = Set (Pmap.differenceDomain m1 m2);; let symmetricDifference (Set m1) (Set m2) = Set (Pmap.symmetricDifferenceDomain m1 m2);; (* ------------------------------------------------------------------------- *) (* Pmapping and folding. *) (* ------------------------------------------------------------------------- *) let filter pred = let mpred (elt,()) = pred elt in fun (Set m) -> Set (Pmap.filter mpred m) ;; let partition pred = let mpred (elt,()) = pred elt in fun (Set m) -> let (m1,m2) = Pmap.partition mpred m in (Set m1, Set m2) ;; let app f = let mf (elt,()) = f elt in fun (Set m) -> Pmap.app mf m ;; let foldl f = let mf (elt,(),acc) = f (elt,acc) in fun acc -> fun (Set m) -> Pmap.foldl mf acc m ;; let foldr f = let mf (elt,(),acc) = f (elt,acc) in fun acc -> fun (Set m) -> Pmap.foldr mf acc m ;; (* ------------------------------------------------------------------------- *) (* Searching. *) (* ------------------------------------------------------------------------- *) let findl p = let mp (elt,()) = p elt in fun (Set m) -> match Pmap.findl mp m with Some (elt,()) -> Some elt | None -> None ;; let findr p = let mp (elt,()) = p elt in fun (Set m) -> match Pmap.findr mp m with Some (elt,()) -> Some elt | None -> None ;; let firstl f = let mf (elt,()) = f elt in fun (Set m) -> Pmap.firstl mf m ;; let firstr f = let mf (elt,()) = f elt in fun (Set m) -> Pmap.firstr mf m ;; let exists p = let mp (elt,()) = p elt in fun (Set m) -> Pmap.exists mp m ;; let all p = let mp (elt,()) = p elt in fun (Set m) -> Pmap.all mp m ;; let count p = let mp (elt,()) = p elt in fun (Set m) -> Pmap.count mp m ;; (* ------------------------------------------------------------------------- *) (* Comparing. *) (* ------------------------------------------------------------------------- *) let compareValue ((),()) = Equal;; let equalValue () () = true;; let compare (Set m1, Set m2) = Pmap.compare compareValue (m1,m2);; let equal (Set m1) (Set m2) = Pmap.equal equalValue m1 m2;; let subset (Set m1) (Set m2) = Pmap.subsetDomain m1 m2;; let disjoint (Set m1) (Set m2) = Pmap.disjointDomain m1 m2;; (* ------------------------------------------------------------------------- *) (* Converting to and from lists. *) (* ------------------------------------------------------------------------- *) let transform f = let inc (x,l) = f x :: l in foldr inc [] ;; let toList (Set m) = Pmap.keys m;; let fromList cmp elts = addList (empty cmp) elts;; (* ------------------------------------------------------------------------- *) (* Pretty-printing. *) (* ------------------------------------------------------------------------- *) let toString set = "{" ^ (if null set then "" else Int.toString (size set)) ^ "}";; (* ------------------------------------------------------------------------- *) (* Iterators over sets *) (* ------------------------------------------------------------------------- *) type 'elt iterator = ('elt,unit) Pmap.iterator;; let mkIterator (Set m) = Pmap.mkIterator m;; let mkRevIterator (Set m) = Pmap.mkRevIterator m;; let readIterator iter = let (elt,()) = Pmap.readIterator iter in elt ;; let advanceIterator iter = Pmap.advanceIterator iter;; end (* ========================================================================= *) (* More map and set types for Metis. *) (* ========================================================================= *) module Mmap = struct exception Error = Useful.Error;; module type Ordered = sig type t val compare : t -> t -> int end module Make (Ord : Ordered) = struct module Ma = Map.Make (Ord) type +'a map = 'a Ma.t let newMap () = Ma.empty;; let null = Ma.is_empty;; let singleton (k, x) = Ma.singleton k x;; let size = Ma.cardinal;; let get m k = try Ma.find k m with Not_found -> raise (Error "Mmap.get: element not found");; let peek m k = try Some (Ma.find k m) with Not_found -> None;; let insert m (k, v) = Ma.add k v m;; let toList = Ma.bindings;; let fromList l = List.fold_right (fun (v,tm) -> Ma.add v tm) l Ma.empty;; let foldl f b m = List.fold_left (fun s (v, tm) -> f (v, tm, s)) b (Ma.bindings m);; let foldr = foldl;; let filter f = Ma.filter (fun x y -> f (x, y));; let inDomain = Ma.mem;; let union f m1 m2 = let f' k = function (Some x, Some y) -> f ((k, x), (k, y)) | (Some x, None) -> Some x | (None, Some y) -> Some y | (None, None) -> None in Ma.merge (fun k x y -> f' k (x, y)) m1 m2 let delete m k = Ma.remove k m let mapPartial f m = Ma.fold (fun k x acc -> match f (k, x) with Some y -> Ma.add k y acc | None -> acc) m Ma.empty;; let transform = Ma.map;; let exists f = Ma.exists (fun k m -> f (k,m));; end end module Intmap = struct open Order module Ordered = struct type t = int let compare = compare end include Mmap.Make (Ordered);; end module Stringmap = struct open Order module Ordered = struct type t = string let compare = compare end include Mmap.Make (Ordered);; end module Mset = struct module type Ordered = sig type t val compare : t -> t -> int end module Make (Ord : Ordered) = struct module Se = Set.Make (Ord) type set = Se.t;; let compare = Order.toCompare Se.compare;; let add s x = Se.add x s;; let foldr f a s = Se.fold (fun x acc -> f (x,acc)) s a;; let foldl = foldr;; let member = Se.mem;; let empty = Se.empty;; let union = Se.union;; let difference = Se.diff;; let toList = Se.elements;; let singleton = Se.singleton;; let null = Se.is_empty;; let size = Se.cardinal;; let pick = Se.choose;; let equal = Se.equal;; let exists = Se.exists;; let fromList l = List.fold_right Se.add l Se.empty;; let delete s x = Se.remove x s;; let subset = Se.subset;; let intersect = Se.inter;; let intersectList = function [] -> Se.empty | (s::ss) -> List.fold_right Se.inter ss s let findl p s = let go x = function (Some _) as s -> s | None -> if p x then Some x else None in Se.fold go s None;; let firstl f s = let go x = function (Some _) as s -> s | None -> f x in Se.fold go s None;; let transform f s = Se.fold (fun x acc -> f x :: acc) s [] let all = Se.for_all;; let count p s = Se.fold (fun x c -> if p x then c+1 else c) s 0 end end module Intset = struct open Order module Ordered = struct type t = int let compare = compare end include Mset.Make (Ordered);; end module Sharing = struct let map = List.map;; end (* ========================================================================= *) (* A HEAP DATATYPE FOR ML *) (* ========================================================================= *) module Heap = struct (* Leftist heaps as in Purely Functional Data Structures, by Chris Okasaki *) open Order exception Empty;; type 'a node = Em | Tr of int * 'a * 'a node * 'a node;; type 'a heap = Heap of ('a * 'a -> order) * int * 'a node;; let rank = function Em -> 0 | (Tr (r,_,_,_)) -> r;; let makeT (x,a,b) = if rank a >= rank b then Tr (rank b + 1, x, a, b) else Tr (rank a + 1, x, b, a);; let merge cmp = let rec mrg = function (h,Em) -> h | (Em,h) -> h | (Tr (_,x,a1,b1) as h1, (Tr (_,y,a2,b2) as h2)) -> match cmp (x,y) with Greater -> makeT (y, a2, mrg (h1,b2)) | _ -> makeT (x, a1, mrg (b1,h2)) in mrg ;; let newHeap cmp = Heap (cmp,0,Em);; let add (Heap (f,n,a)) x = Heap (f, n + 1, merge f (Tr (1,x,Em,Em), a));; let size (Heap (_, n, _)) = n;; let null h = size h = 0;; let top = function (Heap (_,_,Em)) -> raise Empty | (Heap (_, _, Tr (_,x,_,_))) -> x;; let remove = function (Heap (_,_,Em)) -> raise Empty | (Heap (f, n, Tr (_,x,a,b))) -> (x, Heap (f, n - 1, merge f (a,b)));; let app f = let rec ap = function [] -> () | (Em :: rest) -> ap rest | (Tr (_,d,a,b) :: rest) -> (f d; ap (a :: b :: rest)) in function Heap (_,_,a) -> ap [a] ;; let rec toList h = if null h then [] else let (x,h) = remove h in x :: toList h ;; let toString h = "Heap[" ^ (if null h then "" else Int.toString (size h)) ^ "]";; end (* ========================================================================= *) (* NAMES *) (* ========================================================================= *) module Name = struct open Useful;; (* ------------------------------------------------------------------------- *) (* A type of names. *) (* ------------------------------------------------------------------------- *) type name = string;; (* ------------------------------------------------------------------------- *) (* A total ordering. *) (* ------------------------------------------------------------------------- *) let compare = Order.toCompare (compare : name -> name -> int);; let equal n1 n2 = n1 = n2;; (* ------------------------------------------------------------------------- *) (* Fresh variables. *) (* ------------------------------------------------------------------------- *) let prefix = "_";; let numName i = mkPrefix prefix (Int.toString i);; let newName () = numName (newInt ());; let newNames n = List.map numName (newInts n);; let variantPrime avoid = let rec variant n = if avoid n then variant (n ^ "'") else n in variant;; let variantNum avoid n = let isDigitOrPrime c = c = '\'' || isDigit c in if not (avoid n) then n else let n = stripSuffix isDigitOrPrime n in let rec variant i = let n_i = n ^ Int.toString i in if avoid n_i then variant (i + 1) else n_i in variant 0 ;; (* ------------------------------------------------------------------------- *) (* Parsing and pretty printing. *) (* ------------------------------------------------------------------------- *) let toString s : string = s;; let fromString s : name = s;; module Ordered = struct type t = name let compare = Order.fromCompare compare end module Map = Mmap.Make (Ordered);; module Set = Mset.Make (Ordered);; end (* ========================================================================= *) (* NAME/ARITY PAIRS *) (* ========================================================================= *) module Name_arity = struct open Useful;; open Order (* ------------------------------------------------------------------------- *) (* A type of name/arity pairs. *) (* ------------------------------------------------------------------------- *) type nameArity = Name.name * int;; let name ((n,_) : nameArity) = n;; let arity ((_,i) : nameArity) = i;; (* ------------------------------------------------------------------------- *) (* Testing for different arities. *) (* ------------------------------------------------------------------------- *) let nary i n_i = arity n_i = i;; let nullary = nary 0 and unary = nary 1 and binary = nary 2 and ternary = nary 3;; (* ------------------------------------------------------------------------- *) (* A total ordering. *) (* ------------------------------------------------------------------------- *) let compare ((n1,i1),(n2,i2)) = match Name.compare (n1,n2) with Less -> Less | Equal -> Int.compare (i1,i2) | Greater -> Greater;; let equal (n1,i1) (n2,i2) = i1 = i2 && Name.equal n1 n2;; module Ordered = struct type t = nameArity let compare = fromCompare compare end module Map = struct include Mmap.Make (Ordered) let compose m1 m2 = let pk ((_,a),n) = peek m2 (n,a) in mapPartial pk m1 ;; end module Set = struct include Mset.Make (Ordered) let allNullary = all nullary; end end (* ========================================================================= *) (* FIRST ORDER LOGIC TERMS *) (* ========================================================================= *) module Term = struct open Useful open Order (* ------------------------------------------------------------------------- *) (* A type of first order logic terms. *) (* ------------------------------------------------------------------------- *) type var = Name.name;; type functionName = Name.name;; type function_t = functionName * int;; type const = functionName;; type term = Var of Name.name | Fn of (Name.name * term list);; (* ------------------------------------------------------------------------- *) (* Constructors and destructors. *) (* ------------------------------------------------------------------------- *) (* Variables *) let destVar = function (Var v) -> v | (Fn _) -> raise (Error "destVar");; let isVar = can destVar;; let equalVar v = function (Var v') -> Name.equal v v' | _ -> false;; (* Functions *) let destFn = function (Fn f) -> f | (Var _) -> raise (Error "destFn");; let isFn = can destFn;; let fnName tm = fst (destFn tm);; let fnArguments tm = snd (destFn tm);; let fnArity tm = List.length (fnArguments tm);; let fnFunction tm = (fnName tm, fnArity tm);; let functions tm = let rec letc fs = function [] -> fs | (Var _ :: tms) -> letc fs tms | (Fn (n,l) :: tms) -> letc (Name_arity.Set.add fs (n, List.length l)) (l @ tms) in letc Name_arity.Set.empty [tm];; let functionNames tm = let rec letc fs = function [] -> fs | (Var _ :: tms) -> letc fs tms | (Fn (n,l) :: tms) -> letc (Name.Set.add fs n) (l @ tms) in letc Name.Set.empty [tm];; (* Constants *) let mkConst c = (Fn (c, []));; let destConst = function (Fn (c, [])) -> c | _ -> raise (Error "destConst");; let isConst = can destConst;; (* Binary functions *) let mkBinop f (a,b) = Fn (f,[a;b]);; let destBinop f = function (Fn (x,[a;b])) -> if Name.equal x f then (a,b) else raise (Error "Term.destBinop: wrong binop") | _ -> raise (Error "Term.destBinop: not a binop");; let isBinop f = can (destBinop f);; (* ------------------------------------------------------------------------- *) (* The size of a term in symbols. *) (* ------------------------------------------------------------------------- *) let vAR_SYMBOLS = 1;; let fN_SYMBOLS = 1;; let symbols tm = let rec sz n = function [] -> n | (Var _ :: tms) -> sz (n + vAR_SYMBOLS) tms | (Fn (letc,args) :: tms) -> sz (n + fN_SYMBOLS) (args @ tms) in sz 0 [tm];; (* ------------------------------------------------------------------------- *) (* A total comparison function for terms. *) (* ------------------------------------------------------------------------- *) let compare (tm1,tm2) = let rec cmp = function ([], []) -> Equal | (tm1 :: tms1, tm2 :: tms2) -> let tm1_tm2 = (tm1,tm2) in if Portable.pointerEqual tm1_tm2 then cmp (tms1, tms2) else (match tm1_tm2 with (Var v1, Var v2) -> (match Name.compare (v1,v2) with Less -> Less | Equal -> cmp (tms1, tms2) | Greater -> Greater) | (Var _, Fn _) -> Less | (Fn _, Var _) -> Greater | (Fn (f1,a1), Fn (f2,a2)) -> (match Name.compare (f1,f2) with Less -> Less | Equal -> (match Int.compare (List.length a1, List.length a2) with Less -> Less | Equal -> cmp (a1 @ tms1, a2 @ tms2) | Greater -> Greater) | Greater -> Greater)) | _ -> raise (Bug "Term.compare") in cmp ([tm1], [tm2]);; let equal tm1 tm2 = compare (tm1,tm2) = Equal;; (* ------------------------------------------------------------------------- *) (* Subterms. *) (* ------------------------------------------------------------------------- *) type path = int list;; let rec subterm' = function (tm, []) -> tm | (Var _, _ :: _) -> raise (Error "Term.subterm: Var") | (Fn (_,tms), h :: t) -> if h >= List.length tms then raise (Error "Term.replace: Fn") else subterm' (List.nth tms h, t);; let subterm s t = subterm' (s, t);; let subterms tm = let rec subtms = function ([], acc) -> acc | ((path,tm) :: rest, acc) -> let f (n,arg) = (n :: path, arg) and acc = (List.rev path, tm) :: acc in match tm with Var _ -> subtms (rest, acc) | Fn (_,args) -> subtms ((List.map f (enumerate args) @ rest), acc) in subtms ([([],tm)], []);; let rec replace tm = function ([],res) -> if equal res tm then tm else res | (h :: t, res) -> match tm with Var _ -> raise (Error "Term.replace: Var") | Fn (letc,tms) -> if h >= List.length tms then raise (Error "Term.replace: Fn") else let arg = List.nth tms h in let arg' = replace arg (t,res) in if Portable.pointerEqual (arg',arg) then tm else Fn (letc, updateNth (h,arg') tms) ;; let find pred = let rec search = function [] -> None | ((path,tm) :: rest) -> if pred tm then Some (List.rev path) else match tm with Var _ -> search rest | Fn (_,a) -> let subtms = List.map (fun (i,t) -> (i :: path, t)) (enumerate a) in search (subtms @ rest) in fun tm -> search [([],tm)];; (* ------------------------------------------------------------------------- *) (* Free variables. *) (* ------------------------------------------------------------------------- *) let freeIn v tm = let rec free v = function [] -> false | (Var w :: tms) -> Name.equal v w || free v tms | (Fn (_,args) :: tms) -> free v (args @ tms); in free v [tm];; let freeVarsList = let rec free vs = function [] -> vs | (Var v :: tms) -> free (Name.Set.add vs v) tms | (Fn (_,args) :: tms) -> free vs (args @ tms); in free Name.Set.empty;; let freeVars tm = freeVarsList [tm];; (* ------------------------------------------------------------------------- *) (* Fresh variables. *) (* ------------------------------------------------------------------------- *) let newVar () = Var (Name.newName ());; let newVars n = List.map (fun x -> Var x) (Name.newNames n);; let avoid av n = Name.Set.member n av;; let variantPrime av = Name.variantPrime (avoid av);; let variantNum av = Name.variantNum (avoid av);; (* ------------------------------------------------------------------------- *) (* Special support for terms with type annotations. *) (* ------------------------------------------------------------------------- *) let hasTypeFunctionName = Name.fromString ":";; let hasTypeFunction = (hasTypeFunctionName,2);; let destFnHasType ((f,a) : functionName * term list) = if not (Name.equal f hasTypeFunctionName) then raise (Error "Term.destFnHasType") else match a with [tm;ty] -> (tm,ty) | _ -> raise (Error "Term.destFnHasType");; let isFnHasType = can destFnHasType;; let isTypedVar tm = match tm with Var _ -> true | Fn letc -> match total destFnHasType letc with Some (Var _, _) -> true | _ -> false;; let typedSymbols tm = let rec sz n = function [] -> n | (tm :: tms) -> match tm with Var _ -> sz (n + 1) tms | Fn letc -> match total destFnHasType letc with Some (tm,_) -> sz n (tm :: tms) | None -> let (_,a) = letc in sz (n + 1) (a @ tms) in sz 0 [tm];; let nonVarTypedSubterms tm = let rec subtms = function ([], acc) -> acc | ((path,tm) :: rest, acc) -> (match tm with Var _ -> subtms (rest, acc) | Fn letc -> (match total destFnHasType letc with Some (t,_) -> (match t with Var _ -> subtms (rest, acc) | Fn _ -> let acc = (List.rev path, tm) :: acc and rest = (0 :: path, t) :: rest in subtms (rest, acc) ) | None -> let f (n,arg) = (n :: path, arg) in let (_,args) = letc in let acc = (List.rev path, tm) :: acc in let rest = List.map f (enumerate args) @ rest in subtms (rest, acc))) in subtms ([([],tm)], []);; (* ------------------------------------------------------------------------- *) (* Special support for terms with an explicit function application operator. *) (* ------------------------------------------------------------------------- *) let appName = Name.fromString ".";; let mkFnApp (fTm,aTm) = (appName, [fTm;aTm]);; let mkApp f_a = Fn (mkFnApp f_a);; let destFnApp ((f,a) : Name.name * term list) = if not (Name.equal f appName) then raise (Error "Term.destFnApp") else match a with [fTm;aTm] -> (fTm,aTm) | _ -> raise (Error "Term.destFnApp");; let isFnApp = can destFnApp;; let destApp tm = match tm with Var _ -> raise (Error "Term.destApp") | Fn letc -> destFnApp letc;; let isApp = can destApp;; let listMkApp (f,l) = List.fold_left (fun acc x -> mkApp (x, acc)) f l;; let stripApp tm = let rec strip tms tm = match total destApp tm with Some (f,a) -> strip (a :: tms) f | None -> (tm,tms) in strip [] tm;; (* ------------------------------------------------------------------------- *) (* Parsing and pretty printing. *) (* ------------------------------------------------------------------------- *) let rec toString = function Var v -> v | Fn (n, []) -> n | Fn (n, l) -> n ^ "(" ^ String.concat ", " (List.map toString l) ^ ")";; module Ordered = struct type t = term let compare = fromCompare compare end module Map = Map.Make (Ordered);; module Set = Set.Make (Ordered);; end (* ========================================================================= *) (* FIRST ORDER LOGIC SUBSTITUTIONS *) (* ========================================================================= *) module Substitute = struct open Useful (* ------------------------------------------------------------------------- *) (* A type of first order logic substitutions. *) (* ------------------------------------------------------------------------- *) type subst = Subst of Term.term Name.Map.map;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let empty = Subst (Name.Map.newMap ());; let null (Subst m) = Name.Map.null m;; let size (Subst m) = Name.Map.size m;; let peek (Subst m) v = Name.Map.peek m v;; let insert (Subst m) v_tm = Subst (Name.Map.insert m v_tm);; let singleton v_tm = insert empty v_tm;; let toList (Subst m) = Name.Map.toList m;; let fromList l = Subst (Name.Map.fromList l);; let foldl f b (Subst m) = Name.Map.foldl f b m;; let foldr f b (Subst m) = Name.Map.foldr f b m;; (* ------------------------------------------------------------------------- *) (* Normalizing removes identity substitutions. *) (* ------------------------------------------------------------------------- *) let normalize (Subst m as sub) = let isNotId (v, tm) = not (Term.equalVar v tm) in let m' = Name.Map.filter isNotId m in if Name.Map.size m = Name.Map.size m' then sub else Subst m' ;; (* ------------------------------------------------------------------------- *) (* Applying a substitution to a first order logic term. *) (* ------------------------------------------------------------------------- *) let subst sub = let rec tmSub = function (Term.Var v as tm) -> (match peek sub v with Some tm' -> if Portable.pointerEqual (tm,tm') then tm else tm' | None -> tm) | (Term.Fn (f,args) as tm) -> let args' = Sharing.map tmSub args in if Portable.pointerEqual (args,args') then tm else Term.Fn (f,args') in fun tm -> if null sub then tm else tmSub tm ;; (* ------------------------------------------------------------------------- *) (* Restricting a substitution to a given set of variables. *) (* ------------------------------------------------------------------------- *) let restrict (Subst m as sub) varSet = let isRestrictedVar (v, _) = Name.Set.member v varSet in let m' = Name.Map.filter isRestrictedVar m in if Name.Map.size m = Name.Map.size m' then sub else Subst m' ;; let remove (Subst m as sub) varSet = let isRestrictedVar (v, _) = not (Name.Set.member v varSet) in let m' = Name.Map.filter isRestrictedVar m in if Name.Map.size m = Name.Map.size m' then sub else Subst m' ;; (* ------------------------------------------------------------------------- *) (* Composing two substitutions so that the following identity holds: *) (* *) (* subst (compose sub1 sub2) tm = subst sub2 (subst sub1 tm) *) (* ------------------------------------------------------------------------- *) let compose (Subst m1 as sub1) sub2 = let f (v,tm,s) = insert s (v, subst sub2 tm) in if null sub2 then sub1 else Name.Map.foldl f sub2 m1 ;; (* ------------------------------------------------------------------------- *) (* Creating the union of two compatible substitutions. *) (* ------------------------------------------------------------------------- *) let union (Subst m1 as s1) (Subst m2 as s2) = let compatible ((_,tm1),(_,tm2)) = if Term.equal tm1 tm2 then Some tm1 else raise (Error "Substitute.union: incompatible") in if Name.Map.null m1 then s2 else if Name.Map.null m2 then s1 else Subst (Name.Map.union compatible m1 m2) ;; (* ------------------------------------------------------------------------- *) (* Substitutions can be inverted iff they are renaming substitutions. *) (* ------------------------------------------------------------------------- *) let invert (Subst m) = let inv = function (v, Term.Var w, s) -> if Name.Map.inDomain w s then raise (Error "Substitute.invert: non-injective") else Name.Map.insert s (w, Term.Var v) | (_, Term.Fn _, _) -> raise (Error "Substitute.invert: non-variable") in Subst (Name.Map.foldl inv (Name.Map.newMap ()) m) ;; let isRenaming = can invert;; (* ------------------------------------------------------------------------- *) (* Creating a substitution to freshen variables. *) (* ------------------------------------------------------------------------- *) let freshVars s = let add (v, m) = insert m (v, Term.newVar ()) in Name.Set.foldl add empty s ;; (* ------------------------------------------------------------------------- *) (* Free variables. *) (* ------------------------------------------------------------------------- *) let redexes = let add (v,_,s) = Name.Set.add s v in foldl add Name.Set.empty ;; let residueFreeVars = let add (_,t,s) = Name.Set.union s (Term.freeVars t) in foldl add Name.Set.empty ;; let freeVars = let add (v,t,s) = Name.Set.union (Name.Set.add s v) (Term.freeVars t) in foldl add Name.Set.empty ;; (* ------------------------------------------------------------------------- *) (* Functions. *) (* ------------------------------------------------------------------------- *) let functions = let add (_,t,s) = Name_arity.Set.union s (Term.functions t) in foldl add Name_arity.Set.empty ;; (* ------------------------------------------------------------------------- *) (* Matching for first order logic terms. *) (* ------------------------------------------------------------------------- *) let matchTerms sub tm1 tm2 = let rec matchList sub = function [] -> sub | ((Term.Var v, tm) :: rest) -> let sub = match peek sub v with None -> insert sub (v,tm) | Some tm' -> if Term.equal tm tm' then sub else raise (Error "Substitute.match: incompatible matches") in matchList sub rest | ((Term.Fn (f1,args1), Term.Fn (f2,args2)) :: rest) -> if Name.equal f1 f2 && length args1 = length args2 then matchList sub (zip args1 args2 @ rest) else raise (Error "Substitute.match: different structure") | _ -> raise (Error "Substitute.match: functions can't match vars") in matchList sub [(tm1,tm2)] ;; (* ------------------------------------------------------------------------- *) (* Unification for first order logic terms. *) (* ------------------------------------------------------------------------- *) let unify sub tm1 tm2 = let rec solve sub = function [] -> sub | (((tm1,tm2) as tm1_tm2) :: rest) -> if Portable.pointerEqual tm1_tm2 then solve sub rest else solve' sub (subst sub tm1, subst sub tm2, rest) and solve' sub = function ((Term.Var v), tm, rest) -> if Term.equalVar v tm then solve sub rest else if Term.freeIn v tm then raise (Error "Substitute.unify: occurs check") else (match peek sub v with None -> solve (compose sub (singleton (v,tm))) rest | Some tm' -> solve' sub (tm', tm, rest)) | (tm1, ((Term.Var _) as tm2), rest) -> solve' sub (tm2, tm1, rest) | (Term.Fn (f1,args1), Term.Fn (f2,args2), rest) -> if Name.equal f1 f2 && length args1 = length args2 then solve sub (zip args1 args2 @ rest) else raise (Error "Substitute.unify: different structure") in solve sub [(tm1,tm2)];; end (* ========================================================================= *) (* FIRST ORDER LOGIC ATOMS *) (* ========================================================================= *) module Atom = struct open Useful open Order (* ------------------------------------------------------------------------- *) (* A type for storing first order logic atoms. *) (* ------------------------------------------------------------------------- *) type relationName = Name.name;; type relation = relationName * int;; type atom = relationName * Term.term list;; (* ------------------------------------------------------------------------- *) (* Constructors and destructors. *) (* ------------------------------------------------------------------------- *) let name ((rel,_) : atom) = rel;; let arguments ((_,args) : atom) = args;; let arity atm = length (arguments atm);; let relation atm = (name atm, arity atm);; let functions = let f (tm,acc) = Name_arity.Set.union (Term.functions tm) acc in fun atm -> Mlist.foldl f Name_arity.Set.empty (arguments atm) ;; let functionNames = let f (tm,acc) = Name.Set.union (Term.functionNames tm) acc in fun atm -> Mlist.foldl f Name.Set.empty (arguments atm) ;; (* Binary relations *) let mkBinop p (a,b) : atom = (p,[a;b]);; let destBinop p = function (x,[a;b]) -> if Name.equal x p then (a,b) else raise (Error "Atom.destBinop: wrong binop") | _ -> raise (Error "Atom.destBinop: not a binop");; let isBinop p = can (destBinop p);; (* ------------------------------------------------------------------------- *) (* The size of an atom in symbols. *) (* ------------------------------------------------------------------------- *) let symbols atm = Mlist.foldl (fun (tm,z) -> Term.symbols tm + z) 1 (arguments atm);; (* ------------------------------------------------------------------------- *) (* A total comparison function for atoms. *) (* ------------------------------------------------------------------------- *) let compare ((p1,tms1),(p2,tms2)) = match Name.compare (p1,p2) with Less -> Less | Equal -> lexCompare Term.compare (tms1,tms2) | Greater -> Greater;; let equal atm1 atm2 = compare (atm1,atm2) = Equal;; (* ------------------------------------------------------------------------- *) (* Subterms. *) (* ------------------------------------------------------------------------- *) let subterm = let subterm' = function (_, []) -> raise (Bug "Atom.subterm: empty path") | ((_,tms), h :: t) -> if h >= length tms then raise (Error "Atom.subterm: bad path") else Term.subterm (Mlist.nth (tms,h)) t in fun x y -> subterm' (x, y) let subterms ((_,tms) : atom) = let f ((n,tm),l) = List.map (fun (p,s) -> (n :: p, s)) (Term.subterms tm) @ l in Mlist.foldl f [] (enumerate tms) ;; let replace ((rel,tms) as atm) = function ([],_) -> raise (Bug "Atom.replace: empty path") | (h :: t, res) -> if h >= length tms then raise (Error "Atom.replace: bad path") else let tm = Mlist.nth (tms,h) in let tm' = Term.replace tm (t,res) in if Portable.pointerEqual (tm,tm') then atm else (rel, updateNth (h,tm') tms) ;; let find pred = let f (i,tm) = match Term.find pred tm with Some path -> Some (i :: path) | None -> None in fun (_,tms) -> first f (enumerate tms) ;; (* ------------------------------------------------------------------------- *) (* Free variables. *) (* ------------------------------------------------------------------------- *) let freeIn v atm = List.exists (Term.freeIn v) (arguments atm);; let freeVars = let f (tm,acc) = Name.Set.union (Term.freeVars tm) acc in fun atm -> Mlist.foldl f Name.Set.empty (arguments atm) ;; (* ------------------------------------------------------------------------- *) (* Substitutions. *) (* ------------------------------------------------------------------------- *) let subst sub ((p,tms) as atm) : atom = let tms' = Sharing.map (Substitute.subst sub) tms in if Portable.pointerEqual (tms',tms) then atm else (p,tms') ;; (* ------------------------------------------------------------------------- *) (* Matching. *) (* ------------------------------------------------------------------------- *) let matchAtoms sub (p1,tms1) (p2,tms2) = let matchArg ((tm1,tm2),sub) = Substitute.matchTerms sub tm1 tm2 in let _ = (Name.equal p1 p2 && length tms1 = length tms2) || raise (Error "Atom.match") in Mlist.foldl matchArg sub (zip tms1 tms2) ;; (* ------------------------------------------------------------------------- *) (* Unification. *) (* ------------------------------------------------------------------------- *) let unify sub (p1,tms1) (p2,tms2) = let unifyArg ((tm1,tm2),sub) = Substitute.unify sub tm1 tm2 in let _ = (Name.equal p1 p2 && length tms1 = length tms2) || raise (Error "Atom.unify") in Mlist.foldl unifyArg sub (zip tms1 tms2) ;; (* ------------------------------------------------------------------------- *) (* The equality relation. *) (* ------------------------------------------------------------------------- *) let eqRelationName = Name.fromString "=";; let eqRelationArity = 2;; let eqRelation = (eqRelationName,eqRelationArity);; let mkEq = mkBinop eqRelationName;; let destEq x = destBinop eqRelationName x;; let isEq x = isBinop eqRelationName x;; let mkRefl tm = mkEq (tm,tm);; let destRefl atm = let (l,r) = destEq atm in let _ = Term.equal l r || raise (Error "Atom.destRefl") in l ;; let isRefl x = can destRefl x;; let sym atm = let (l,r) = destEq atm in let _ = not (Term.equal l r) || raise (Error "Atom.sym: refl") in mkEq (r,l) ;; let lhs atm = fst (destEq atm);; let rhs atm = snd (destEq atm);; (* ------------------------------------------------------------------------- *) (* Special support for terms with type annotations. *) (* ------------------------------------------------------------------------- *) let typedSymbols ((_,tms) : atom) = Mlist.foldl (fun (tm,z) -> Term.typedSymbols tm + z) 1 tms;; let nonVarTypedSubterms (_,tms) = let addArg ((n,arg),acc) = let addTm ((path,tm),acc) = (n :: path, tm) :: acc in Mlist.foldl addTm acc (Term.nonVarTypedSubterms arg) in Mlist.foldl addArg [] (enumerate tms) ;; module Ordered = struct type t = atom let compare = fromCompare compare end module Map = Mmap.Make (Ordered);; module Set = Mset.Make (Ordered);; end (* ========================================================================= *) (* FIRST ORDER LOGIC FORMULAS *) (* ========================================================================= *) module Formula = struct open Useful open Order (* ------------------------------------------------------------------------- *) (* A type of first order logic formulas. *) (* ------------------------------------------------------------------------- *) type formula = True | False | Atom of Atom.atom | Not of formula | And of formula * formula | Or of formula * formula | Imp of formula * formula | Iff of formula * formula | Forall of Term.var * formula | Exists of Term.var * formula;; (* ------------------------------------------------------------------------- *) (* Constructors and destructors. *) (* ------------------------------------------------------------------------- *) (* Booleans *) let mkBoolean = function true -> True | false -> False;; let destBoolean = function True -> true | False -> false | _ -> raise (Error "destBoolean");; let isBoolean = can destBoolean;; let isTrue fm = match fm with True -> true | _ -> false;; let isFalse fm = match fm with False -> true | _ -> false;; (* Functions *) let functions fm = let rec funcs fs = function [] -> fs | (True :: fms) -> funcs fs fms | (False :: fms) -> funcs fs fms | (Atom atm :: fms) -> funcs (Name_arity.Set.union (Atom.functions atm) fs) fms | (Not p :: fms) -> funcs fs (p :: fms) | (And (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Or (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Imp (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Iff (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Forall (_,p) :: fms) -> funcs fs (p :: fms) | (Exists (_,p) :: fms) -> funcs fs (p :: fms) in funcs Name_arity.Set.empty [fm];; let functionNames fm = let rec funcs fs = function [] -> fs | (True :: fms) -> funcs fs fms | (False :: fms) -> funcs fs fms | (Atom atm :: fms) -> funcs (Name.Set.union (Atom.functionNames atm) fs) fms | (Not p :: fms) -> funcs fs (p :: fms) | (And (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Or (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Imp (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Iff (p,q) :: fms) -> funcs fs (p :: q :: fms) | (Forall (_,p) :: fms) -> funcs fs (p :: fms) | (Exists (_,p) :: fms) -> funcs fs (p :: fms) in funcs Name.Set.empty [fm];; (* Relations *) let relations fm = let rec rels fs = function [] -> fs | (True :: fms) -> rels fs fms | (False :: fms) -> rels fs fms | (Atom atm :: fms) -> rels (Name_arity.Set.add fs (Atom.relation atm)) fms | (Not p :: fms) -> rels fs (p :: fms) | (And (p,q) :: fms) -> rels fs (p :: q :: fms) | (Or (p,q) :: fms) -> rels fs (p :: q :: fms) | (Imp (p,q) :: fms) -> rels fs (p :: q :: fms) | (Iff (p,q) :: fms) -> rels fs (p :: q :: fms) | (Forall (_,p) :: fms) -> rels fs (p :: fms) | (Exists (_,p) :: fms) -> rels fs (p :: fms) in rels Name_arity.Set.empty [fm];; let relationNames fm = let rec rels fs = function [] -> fs | (True :: fms) -> rels fs fms | (False :: fms) -> rels fs fms | (Atom atm :: fms) -> rels (Name.Set.add fs (Atom.name atm)) fms | (Not p :: fms) -> rels fs (p :: fms) | (And (p,q) :: fms) -> rels fs (p :: q :: fms) | (Or (p,q) :: fms) -> rels fs (p :: q :: fms) | (Imp (p,q) :: fms) -> rels fs (p :: q :: fms) | (Iff (p,q) :: fms) -> rels fs (p :: q :: fms) | (Forall (_,p) :: fms) -> rels fs (p :: fms) | (Exists (_,p) :: fms) -> rels fs (p :: fms) in rels Name.Set.empty [fm];; (* Atoms *) let destAtom = function (Atom atm) -> atm | _ -> raise (Error "Formula.destAtom");; let isAtom = can destAtom;; (* Negations *) let destNeg = function (Not p) -> p | _ -> raise (Error "Formula.destNeg");; let isNeg = can destNeg;; let stripNeg = let rec strip n = function (Not fm) -> strip (n + 1) fm | fm -> (n,fm) in strip 0 ;; (* Conjunctions *) let listMkConj fms = match List.rev fms with [] -> True | fm :: fms -> Mlist.foldl (fun (x, y) -> And (x, y)) fm fms;; let stripConj = let rec strip cs = function (And (p,q)) -> strip (p :: cs) q | fm -> List.rev (fm :: cs) in function True -> [] | fm -> strip [] fm;; let flattenConj = let rec flat acc = function [] -> acc | (And (p,q) :: fms) -> flat acc (q :: p :: fms) | (True :: fms) -> flat acc fms | (fm :: fms) -> flat (fm :: acc) fms in fun fm -> flat [] [fm] ;; (* Disjunctions *) let listMkDisj fms = match List.rev fms with [] -> False | fm :: fms -> Mlist.foldl (fun (x,y) -> Or (x,y)) fm fms;; let stripDisj = let rec strip cs = function (Or (p,q)) -> strip (p :: cs) q | fm -> List.rev (fm :: cs) in function False -> [] | fm -> strip [] fm;; let flattenDisj = let rec flat acc = function [] -> acc | (Or (p,q) :: fms) -> flat acc (q :: p :: fms) | (False :: fms) -> flat acc fms | (fm :: fms) -> flat (fm :: acc) fms in fun fm -> flat [] [fm] ;; (* Equivalences *) let listMkEquiv fms = match List.rev fms with [] -> True | fm :: fms -> Mlist.foldl (fun (x,y) -> Iff (x,y)) fm fms;; let stripEquiv = let rec strip cs = function (Iff (p,q)) -> strip (p :: cs) q | fm -> List.rev (fm :: cs) in function True -> [] | fm -> strip [] fm;; let flattenEquiv = let rec flat acc = function [] -> acc | (Iff (p,q) :: fms) -> flat acc (q :: p :: fms) | (True :: fms) -> flat acc fms | (fm :: fms) -> flat (fm :: acc) fms in fun fm -> flat [] [fm] ;; (* Universal quantifiers *) let destForall = function (Forall (v,f)) -> (v,f) | _ -> raise (Error "destForall");; let isForall = can destForall;; let rec listMkForall = function ([],body) -> body | (v :: vs, body) -> Forall (v, listMkForall (vs,body));; let setMkForall (vs,body) = Name.Set.foldr (fun (x,y) -> Forall (x,y)) body vs;; let stripForall = let rec strip vs = function (Forall (v,b)) -> strip (v :: vs) b | tm -> (List.rev vs, tm) in strip [];; (* Existential quantifiers *) let destExists = function (Exists (v,f)) -> (v,f) | _ -> raise (Error "destExists");; let isExists = can destExists;; let rec listMkExists = function ([],body) -> body | (v :: vs, body) -> Exists (v, listMkExists (vs,body));; let setMkExists (vs,body) = Name.Set.foldr (fun (x,y) -> Exists (x,y)) body vs;; let stripExists = let rec strip vs = function (Exists (v,b)) -> strip (v :: vs) b | tm -> (List.rev vs, tm) in strip [];; (* ------------------------------------------------------------------------- *) (* The size of a formula in symbols. *) (* ------------------------------------------------------------------------- *) let symbols fm = let rec sz n = function [] -> n | (True :: fms) -> sz (n + 1) fms | (False :: fms) -> sz (n + 1) fms | (Atom atm :: fms) -> sz (n + Atom.symbols atm) fms | (Not p :: fms) -> sz (n + 1) (p :: fms) | (And (p,q) :: fms) -> sz (n + 1) (p :: q :: fms) | (Or (p,q) :: fms) -> sz (n + 1) (p :: q :: fms) | (Imp (p,q) :: fms) -> sz (n + 1) (p :: q :: fms) | (Iff (p,q) :: fms) -> sz (n + 1) (p :: q :: fms) | (Forall (_,p) :: fms) -> sz (n + 1) (p :: fms) | (Exists (_,p) :: fms) -> sz (n + 1) (p :: fms) in sz 0 [fm];; (* ------------------------------------------------------------------------- *) (* A total comparison function for formulas. *) (* ------------------------------------------------------------------------- *) let compare fm1_fm2 = let rec cmp = function [] -> Equal | (f1_f2 :: fs) -> if Portable.pointerEqual f1_f2 then cmp fs else match f1_f2 with (True,True) -> cmp fs | (True,_) -> Less | (_,True) -> Greater | (False,False) -> cmp fs | (False,_) -> Less | (_,False) -> Greater | (Atom atm1, Atom atm2) -> (match Atom.compare (atm1,atm2) with Less -> Less | Equal -> cmp fs | Greater -> Greater) | (Atom _, _) -> Less | (_, Atom _) -> Greater | (Not p1, Not p2) -> cmp ((p1,p2) :: fs) | (Not _, _) -> Less | (_, Not _) -> Greater | (And (p1,q1), And (p2,q2)) -> cmp ((p1,p2) :: (q1,q2) :: fs) | (And _, _) -> Less | (_, And _) -> Greater | (Or (p1,q1), Or (p2,q2)) -> cmp ((p1,p2) :: (q1,q2) :: fs) | (Or _, _) -> Less | (_, Or _) -> Greater | (Imp (p1,q1), Imp (p2,q2)) -> cmp ((p1,p2) :: (q1,q2) :: fs) | (Imp _, _) -> Less | (_, Imp _) -> Greater | (Iff (p1,q1), Iff (p2,q2)) -> cmp ((p1,p2) :: (q1,q2) :: fs) | (Iff _, _) -> Less | (_, Iff _) -> Greater | (Forall (v1,p1), Forall (v2,p2)) -> (match Name.compare (v1,v2) with Less -> Less | Equal -> cmp ((p1,p2) :: fs) | Greater -> Greater) | (Forall _, Exists _) -> Less | (Exists _, Forall _) -> Greater | (Exists (v1,p1), Exists (v2,p2)) -> (match Name.compare (v1,v2) with Less -> Less | Equal -> cmp ((p1,p2) :: fs) | Greater -> Greater) in cmp [fm1_fm2];; let equal fm1 fm2 = compare (fm1,fm2) = Equal;; (* ------------------------------------------------------------------------- *) (* Free variables. *) (* ------------------------------------------------------------------------- *) let freeIn v = let rec f = function [] -> false | (True :: fms) -> f fms | (False :: fms) -> f fms | (Atom atm :: fms) -> Atom.freeIn v atm || f fms | (Not p :: fms) -> f (p :: fms) | (And (p,q) :: fms) -> f (p :: q :: fms) | (Or (p,q) :: fms) -> f (p :: q :: fms) | (Imp (p,q) :: fms) -> f (p :: q :: fms) | (Iff (p,q) :: fms) -> f (p :: q :: fms) | (Forall (w,p) :: fms) -> if Name.equal v w then f fms else f (p :: fms) | (Exists (w,p) :: fms) -> if Name.equal v w then f fms else f (p :: fms) in fun fm -> f [fm] ;; let add (fm,vs) = let rec fv vs = function [] -> vs | ((_,True) :: fms) -> fv vs fms | ((_,False) :: fms) -> fv vs fms | ((bv, Atom atm) :: fms) -> fv (Name.Set.union vs (Name.Set.difference (Atom.freeVars atm) bv)) fms | ((bv, Not p) :: fms) -> fv vs ((bv,p) :: fms) | ((bv, And (p,q)) :: fms) -> fv vs ((bv,p) :: (bv,q) :: fms) | ((bv, Or (p,q)) :: fms) -> fv vs ((bv,p) :: (bv,q) :: fms) | ((bv, Imp (p,q)) :: fms) -> fv vs ((bv,p) :: (bv,q) :: fms) | ((bv, Iff (p,q)) :: fms) -> fv vs ((bv,p) :: (bv,q) :: fms) | ((bv, Forall (v,p)) :: fms) -> fv vs ((Name.Set.add bv v, p) :: fms) | ((bv, Exists (v,p)) :: fms) -> fv vs ((Name.Set.add bv v, p) :: fms) in fv vs [(Name.Set.empty,fm)];; let freeVars fm = add (fm,Name.Set.empty);; let freeVarsList fms = Mlist.foldl add Name.Set.empty fms;; let specialize fm = snd (stripForall fm);; let generalize fm = listMkForall (Name.Set.toList (freeVars fm), fm);; (* ------------------------------------------------------------------------- *) (* Substitutions. *) (* ------------------------------------------------------------------------- *) let rec substCheck sub fm = if Substitute.null sub then fm else substFm sub fm and substFm sub fm = match fm with True -> fm | False -> fm | Atom (p,tms) -> let tms' = Sharing.map (Substitute.subst sub) tms in if Portable.pointerEqual (tms,tms') then fm else Atom (p,tms') | Not p -> let p' = substFm sub p in if Portable.pointerEqual (p,p') then fm else Not p' | And (p,q) -> substConn sub fm (fun (x,y) -> And (x,y)) p q | Or (p,q) -> substConn sub fm (fun (x,y) -> Or (x,y)) p q | Imp (p,q) -> substConn sub fm (fun (x,y) -> Imp (x,y)) p q | Iff (p,q) -> substConn sub fm (fun (x,y) -> Iff (x,y)) p q | Forall (v,p) -> substQuant sub fm (fun (x,y) -> Forall (x,y)) v p | Exists (v,p) -> substQuant sub fm (fun (x,y) -> Exists (x,y)) v p and substConn sub fm conn p q = let p' = substFm sub p and q' = substFm sub q in if Portable.pointerEqual (p,p') && Portable.pointerEqual (q,q') then fm else conn (p',q') and substQuant sub fm quant v p = let v' = let f (w,s) = if Name.equal w v then s else match Substitute.peek sub w with None -> Name.Set.add s w | Some tm -> Name.Set.union s (Term.freeVars tm) in let vars = freeVars p in let vars = Name.Set.foldl f Name.Set.empty vars in Term.variantPrime vars v in let sub = if Name.equal v v' then Substitute.remove sub (Name.Set.singleton v) else Substitute.insert sub (v, Term.Var v') in let p' = substCheck sub p in if Name.equal v v' && Portable.pointerEqual (p,p') then fm else quant (v',p');; let subst = substCheck;; (* ------------------------------------------------------------------------- *) (* The equality relation. *) (* ------------------------------------------------------------------------- *) let mkEq a_b = Atom (Atom.mkEq a_b);; let destEq fm = Atom.destEq (destAtom fm);; let isEq = can destEq;; let mkNeq a_b = Not (mkEq a_b);; let destNeq = function (Not fm) -> destEq fm | _ -> raise (Error "Formula.destNeq");; let isNeq = can destNeq;; let mkRefl tm = Atom (Atom.mkRefl tm);; let destRefl fm = Atom.destRefl (destAtom fm);; let isRefl = can destRefl;; let sym fm = Atom (Atom.sym (destAtom fm));; let lhs fm = fst (destEq fm);; let rhs fm = snd (destEq fm);; (* ------------------------------------------------------------------------- *) (* Parsing and pretty-printing. *) (* ------------------------------------------------------------------------- *) let truthName = Name.fromString "T" and falsityName = Name.fromString "F" and conjunctionName = Name.fromString "/\\" and disjunctionName = Name.fromString "\\/" and implicationName = Name.fromString "==>" and equivalenceName = Name.fromString "<=>" and universalName = Name.fromString "!" and existentialName = Name.fromString "?";; let rec demote = function True -> Term.Fn (truthName,[]) | False -> Term.Fn (falsityName,[]) | (Atom (p,tms)) -> Term.Fn (p,tms) | (Not p) -> let s = "~" in Term.Fn (Name.fromString s, [demote p]) | (And (p,q)) -> Term.Fn (conjunctionName, [demote p; demote q]) | (Or (p,q)) -> Term.Fn (disjunctionName, [demote p; demote q]) | (Imp (p,q)) -> Term.Fn (implicationName, [demote p; demote q]) | (Iff (p,q)) -> Term.Fn (equivalenceName, [demote p; demote q]) | (Forall (v,b)) -> Term.Fn (universalName, [Term.Var v; demote b]) | (Exists (v,b)) -> Term.Fn (existentialName, [Term.Var v; demote b]);; let toString fm = Term.toString (demote fm);; (* ------------------------------------------------------------------------- *) (* Splitting goals. *) (* ------------------------------------------------------------------------- *) let add_asms asms goal = if Mlist.null asms then goal else Imp (listMkConj (List.rev asms), goal);; let add_var_asms asms v goal = add_asms asms (Forall (v,goal));; let rec split asms pol fm = match (pol,fm) with (* Positive splittables *) (true,True) -> [] | (true, Not f) -> split asms false f | (true, And (f1,f2)) -> split asms true f1 @ split (f1 :: asms) true f2 | (true, Or (f1,f2)) -> split (Not f1 :: asms) true f2 | (true, Imp (f1,f2)) -> split (f1 :: asms) true f2 | (true, Iff (f1,f2)) -> split (f1 :: asms) true f2 @ split (f2 :: asms) true f1 | (true, Forall (v,f)) -> List.map (add_var_asms asms v) (split [] true f) (* Negative splittables *) | (false,False) -> [] | (false, Not f) -> split asms true f | (false, And (f1,f2)) -> split (f1 :: asms) false f2 | (false, Or (f1,f2)) -> split asms false f1 @ split (Not f1 :: asms) false f2 | (false, Imp (f1,f2)) -> split asms true f1 @ split (f1 :: asms) false f2 | (false, Iff (f1,f2)) -> split (f1 :: asms) false f2 @ split (f2 :: asms) false f1 | (false, Exists (v,f)) -> List.map (add_var_asms asms v) (split [] false f) (* Unsplittables *) | _ -> [add_asms asms (if pol then fm else Not fm)];; let splitGoal fm = split [] true fm;; (*MetisTrace3 let splitGoal = fun fm => let let result = splitGoal fm let () = Print.trace pp "Formula.splitGoal: fm" fm let () = Print.trace (Print.ppList pp) "Formula.splitGoal: result" result in result end;; *) module Ordered = struct type t = formula let compare = fromCompare compare end module Map = Mmap.Make (Ordered);; module Set = Mset.Make (Ordered);; end (* ========================================================================= *) (* FIRST ORDER LOGIC LITERALS *) (* ========================================================================= *) module Literal = struct open Useful;; open Order (* ------------------------------------------------------------------------- *) (* A type for storing first order logic literals. *) (* ------------------------------------------------------------------------- *) type polarity = bool;; type literal = polarity * Atom.atom;; (* ------------------------------------------------------------------------- *) (* Constructors and destructors. *) (* ------------------------------------------------------------------------- *) let polarity ((pol,_) : literal) = pol;; let atom ((_,atm) : literal) = atm;; let name lit = Atom.name (atom lit);; let arguments lit = Atom.arguments (atom lit);; let arity lit = Atom.arity (atom lit);; let positive lit = polarity lit;; let negative lit = not (polarity lit);; let negate (pol,atm) : literal = (not pol, atm) let relation lit = Atom.relation (atom lit);; let functions lit = Atom.functions (atom lit);; let functionNames lit = Atom.functionNames (atom lit);; (* Binary relations *) let mkBinop rel (pol,a,b) : literal = (pol, Atom.mkBinop rel (a,b));; let destBinop rel ((pol,atm) : literal) = match Atom.destBinop rel atm with (a,b) -> (pol,a,b);; let isBinop rel = can (destBinop rel);; (* Formulas *) let toFormula = function (true,atm) -> Formula.Atom atm | (false,atm) -> Formula.Not (Formula.Atom atm);; let fromFormula = function (Formula.Atom atm) -> (true,atm) | (Formula.Not (Formula.Atom atm)) -> (false,atm) | _ -> raise (Error "Literal.fromFormula");; (* ------------------------------------------------------------------------- *) (* The size of a literal in symbols. *) (* ------------------------------------------------------------------------- *) let symbols ((_,atm) : literal) = Atom.symbols atm;; (* ------------------------------------------------------------------------- *) (* A total comparison function for literals. *) (* ------------------------------------------------------------------------- *) let compare = prodCompare boolCompare Atom.compare;; let equal (p1,atm1) (p2,atm2) = p1 = p2 && Atom.equal atm1 atm2;; (* ------------------------------------------------------------------------- *) (* Subterms. *) (* ------------------------------------------------------------------------- *) let subterm lit path = Atom.subterm (atom lit) path;; let subterms lit = Atom.subterms (atom lit);; let replace ((pol,atm) as lit) path_tm = let atm' = Atom.replace atm path_tm in if Portable.pointerEqual (atm,atm') then lit else (pol,atm') ;; (* ------------------------------------------------------------------------- *) (* Free variables. *) (* ------------------------------------------------------------------------- *) let freeIn v lit = Atom.freeIn v (atom lit);; let freeVars lit = Atom.freeVars (atom lit);; (* ------------------------------------------------------------------------- *) (* Substitutions. *) (* ------------------------------------------------------------------------- *) let subst sub ((pol,atm) as lit) : literal = let atm' = Atom.subst sub atm in if Portable.pointerEqual (atm',atm) then lit else (pol,atm') ;; (* ------------------------------------------------------------------------- *) (* Matching. *) (* ------------------------------------------------------------------------- *) let matchLiterals sub ((pol1,atm1) : literal) (pol2,atm2) = let _ = pol1 = pol2 || raise (Error "Literal.match") in Atom.matchAtoms sub atm1 atm2 ;; (* ------------------------------------------------------------------------- *) (* Unification. *) (* ------------------------------------------------------------------------- *) let unify sub ((pol1,atm1) : literal) (pol2,atm2) = let _ = pol1 = pol2 || raise (Error "Literal.unify") in Atom.unify sub atm1 atm2 ;; (* ------------------------------------------------------------------------- *) (* The equality relation. *) (* ------------------------------------------------------------------------- *) let mkEq l_r : literal = (true, Atom.mkEq l_r);; let destEq = function ((true,atm) : literal) -> Atom.destEq atm | (false,_) -> raise (Error "Literal.destEq");; let isEq = can destEq;; let mkNeq l_r : literal = (false, Atom.mkEq l_r);; let destNeq = function ((false,atm) : literal) -> Atom.destEq atm | (true,_) -> raise (Error "Literal.destNeq");; let isNeq = can destNeq;; let mkRefl tm = (true, Atom.mkRefl tm);; let destRefl = function (true,atm) -> Atom.destRefl atm | (false,_) -> raise (Error "Literal.destRefl");; let isRefl = can destRefl;; let mkIrrefl tm = (false, Atom.mkRefl tm);; let destIrrefl = function (true,_) -> raise (Error "Literal.destIrrefl") | (false,atm) -> Atom.destRefl atm;; let isIrrefl = can destIrrefl;; let sym (pol,atm) : literal = (pol, Atom.sym atm);; let lhs ((_,atm) : literal) = Atom.lhs atm;; let rhs ((_,atm) : literal) = Atom.rhs atm;; (* ------------------------------------------------------------------------- *) (* Special support for terms with type annotations. *) (* ------------------------------------------------------------------------- *) let typedSymbols ((_,atm) : literal) = Atom.typedSymbols atm;; let nonVarTypedSubterms ((_,atm) : literal) = Atom.nonVarTypedSubterms atm;; (* ------------------------------------------------------------------------- *) (* Parsing and pretty-printing. *) (* ------------------------------------------------------------------------- *) let toString literal = Formula.toString (toFormula literal);; module Ordered = struct type t = literal let compare = fromCompare compare end module Map = Mmap.Make (Ordered);; module Set = struct include Mset.Make (Ordered);; let negateMember lit set = member (negate lit) set;; let negate = let f (lit,set) = add set (negate lit) in foldl f empty ;; let relations = let f (lit,set) = Name_arity.Set.add set (relation lit) in foldl f Name_arity.Set.empty ;; let functions = let f (lit,set) = Name_arity.Set.union set (functions lit) in foldl f Name_arity.Set.empty ;; let freeIn v = exists (freeIn v);; let freeVars = let f (lit,set) = Name.Set.union set (freeVars lit) in foldl f Name.Set.empty ;; let freeVarsList = let f (lits,set) = Name.Set.union set (freeVars lits) in Mlist.foldl f Name.Set.empty ;; let symbols = let f (lit,z) = symbols lit + z in foldl f 0 ;; let typedSymbols = let f (lit,z) = typedSymbols lit + z in foldl f 0 ;; let subst sub lits = let substLit (lit,(eq,lits')) = let lit' = subst sub lit in let eq = eq && Portable.pointerEqual (lit,lit') in (eq, add lits' lit') in let (eq,lits') = foldl substLit (true,empty) lits in if eq then lits else lits' ;; let conjoin set = Formula.listMkConj (List.map toFormula (toList set));; let disjoin set = Formula.listMkDisj (List.map toFormula (toList set));; let toString cl = "{" ^ String.concat ", " (List.map toString (toList cl)) ^ "}" end module Set_ordered = struct type t = Set.set let compare = fromCompare Set.compare end module Set_map = Mmap.Make (Set_ordered);; module Set_set = Mset.Make (Set_ordered);; end (* ========================================================================= *) (* A LOGICAL KERNEL FOR FIRST ORDER CLAUSAL THEOREMS *) (* ========================================================================= *) module Thm = struct open Useful;; open Order (* ------------------------------------------------------------------------- *) (* An abstract type of first order logic theorems. *) (* ------------------------------------------------------------------------- *) type clause = Literal.Set.set;; type inferenceType = Axiom | Assume | Subst | Factor | Resolve | Refl | Equality;; type thm = Thm of clause * (inferenceType * thm list);; type inference = inferenceType * thm list;; (* ------------------------------------------------------------------------- *) (* Theorem destructors. *) (* ------------------------------------------------------------------------- *) let clause (Thm (cl,_)) = cl;; let inference (Thm (_,inf)) = inf;; (* Tautologies *) let isTautology th = let chk = function (_,None) -> None | ((pol,atm), Some set) -> if (pol && Atom.isRefl atm) || Atom.Set.member atm set then None else Some (Atom.Set.add set atm) in match Literal.Set.foldl chk (Some Atom.Set.empty) (clause th) with Some _ -> false | None -> true;; (* Contradictions *) let isContradiction th = Literal.Set.null (clause th);; (* Unit theorems *) let destUnit (Thm (cl,_)) = if Literal.Set.size cl = 1 then Literal.Set.pick cl else raise (Error "Thm.destUnit");; let isUnit = can destUnit;; (* Unit equality theorems *) let destUnitEq th = Literal.destEq (destUnit th);; let isUnitEq = can destUnitEq;; (* Literals *) let member lit (Thm (cl,_)) = Literal.Set.member lit cl;; let negateMember lit (Thm (cl,_)) = Literal.Set.negateMember lit cl;; (* ------------------------------------------------------------------------- *) (* A total order. *) (* ------------------------------------------------------------------------- *) let compare (th1,th2) = Literal.Set.compare (clause th1, clause th2);; let equal th1 th2 = Literal.Set.equal (clause th1) (clause th2);; (* ------------------------------------------------------------------------- *) (* Free variables. *) (* ------------------------------------------------------------------------- *) let freeIn v (Thm (cl,_)) = Literal.Set.freeIn v cl;; let freeVars (Thm (cl,_)) = Literal.Set.freeVars cl;; (* ------------------------------------------------------------------------- *) (* Pretty-printing. *) (* ------------------------------------------------------------------------- *) open Format let inferenceTypeToString = function Axiom -> "axiom" | Assume -> "assume" | Subst -> "subst" | Factor -> "factor" | Resolve -> "resolve" | Refl -> "refl" | Equality -> "equality" let toString (Thm (cl, (infType, ths))) = inferenceTypeToString infType ^ ": " ^ Literal.Set.toString cl let rec print_proof (Thm (cl, (infType, ths))) = print_string ("Inference: " ^ inferenceTypeToString infType); print_break 0 0; print_string ("Clauses: " ^ Literal.Set.toString cl); print_break 0 0; print_string "Theorems: "; if ths = [] then print_string "" else begin print_break 0 0; open_vbox 2; print_break 0 0; List.iter (print_proof) ths; close_box () end; print_break 0 0 (* ------------------------------------------------------------------------- *) (* Primitive rules of inference. *) (* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *) (* *) (* ----- axiom C *) (* C *) (* ------------------------------------------------------------------------- *) let axiom cl = Thm (cl,(Axiom,[]));; (* ------------------------------------------------------------------------- *) (* *) (* ----------- assume L *) (* L \/ ~L *) (* ------------------------------------------------------------------------- *) let assume lit = Thm (Literal.Set.fromList [lit; Literal.negate lit], (Assume,[]));; (* ------------------------------------------------------------------------- *) (* C *) (* -------- subst s *) (* C[s] *) (* ------------------------------------------------------------------------- *) let subst sub (Thm (cl,inf) as th) = let cl' = Literal.Set.subst sub cl in if Portable.pointerEqual (cl,cl') then th else match inf with (Subst,_) -> Thm (cl',inf) | _ -> Thm (cl',(Subst,[th])) ;; (* ------------------------------------------------------------------------- *) (* L \/ C ~L \/ D *) (* --------------------- resolve L *) (* C \/ D *) (* *) (* The literal L must occur in the first theorem, and the literal ~L must *) (* occur in the second theorem. *) (* ------------------------------------------------------------------------- *) let resolve lit (Thm (cl1,_) as th1) (Thm (cl2,_) as th2) = let cl1' = Literal.Set.delete cl1 lit and cl2' = Literal.Set.delete cl2 (Literal.negate lit) in Thm (Literal.Set.union cl1' cl2', (Resolve,[th1;th2])) ;; (*MetisDebug let resolve = fun lit -> fun pos -> fun neg -> resolve lit pos neg handle Error err -> raise Error ("Thm.resolve:\nlit = " ^ Literal.toString lit ^ "\npos = " ^ toString pos ^ "\nneg = " ^ toString neg ^ "\n" ^ err);; *) (* ------------------------------------------------------------------------- *) (* *) (* --------- refl t *) (* t = t *) (* ------------------------------------------------------------------------- *) let refl tm = Thm (Literal.Set.singleton (true, Atom.mkRefl tm), (Refl,[]));; (* ------------------------------------------------------------------------- *) (* *) (* ------------------------ equality L p t *) (* ~(s = t) \/ ~L \/ L' *) (* *) (* where s is the subterm of L at path p, and L' is L with the subterm at *) (* path p being replaced by t. *) (* ------------------------------------------------------------------------- *) let equality lit path t = let s = Literal.subterm lit path in let lit' = Literal.replace lit (path,t) in let eqLit = Literal.mkNeq (s,t) in let cl = Literal.Set.fromList [eqLit; Literal.negate lit; lit'] in Thm (cl,(Equality,[])) ;; end (* ========================================================================= *) (* PROOFS IN FIRST ORDER LOGIC *) (* ========================================================================= *) module Proof = struct open Useful;; (* ------------------------------------------------------------------------- *) (* A type of first order logic proofs. *) (* ------------------------------------------------------------------------- *) type inference = Axiom of Literal.Set.set | Assume of Atom.atom | Subst of Substitute.subst * Thm.thm | Resolve of Atom.atom * Thm.thm * Thm.thm | Refl of Term.term | Equality of Literal.literal * Term.path * Term.term;; type proof = (Thm.thm * inference) list;; (* ------------------------------------------------------------------------- *) (* Reconstructing single inferences. *) (* ------------------------------------------------------------------------- *) let parents = function (Axiom _) -> [] | (Assume _) -> [] | (Subst (_,th)) -> [th] | (Resolve (_,th,th')) -> [th;th'] | (Refl _) -> [] | (Equality _) -> [];; let inferenceToThm = function (Axiom cl) -> Thm.axiom cl | (Assume atm) -> Thm.assume (true,atm) | (Subst (sub,th)) -> Thm.subst sub th | (Resolve (atm,th,th')) -> Thm.resolve (true,atm) th th' | (Refl tm) -> Thm.refl tm | (Equality (lit,path,r)) -> Thm.equality lit path r;; let reconstructSubst cl cl' = let rec recon = function [] -> (*MetisTrace3 let () = Print.trace Literal.Set.pp "reconstructSubst: cl" cl let () = Print.trace Literal.Set.pp "reconstructSubst: cl'" cl' *) raise (Bug "can't reconstruct Subst rule") | (([],sub) :: others) -> if Literal.Set.equal (Literal.Set.subst sub cl) cl' then sub else recon others | ((lit :: lits, sub) :: others) -> let checkLit (lit',acc) = match total (Literal.matchLiterals sub lit) lit' with None -> acc | Some sub -> (lits,sub) :: acc in recon (Literal.Set.foldl checkLit others cl') in Substitute.normalize (recon [(Literal.Set.toList cl, Substitute.empty)]) ;; (*MetisDebug handle Error err -> raise (Bug ("Proof.recontructSubst: shouldn't fail:\n" ^ err));; *) let reconstructResolvant cl1 cl2 cl = (if not (Literal.Set.subset cl1 cl) then Literal.Set.pick (Literal.Set.difference cl1 cl) else if not (Literal.Set.subset cl2 cl) then Literal.negate (Literal.Set.pick (Literal.Set.difference cl2 cl)) else (* A useless resolution, but we must reconstruct it anyway *) let cl1' = Literal.Set.negate cl1 and cl2' = Literal.Set.negate cl2 in let lits = Literal.Set.intersectList [cl1;cl1';cl2;cl2'] in if not (Literal.Set.null lits) then Literal.Set.pick lits else raise (Bug "can't reconstruct Resolve rule") );; (*MetisDebug handle Error err -> raise (Bug ("Proof.recontructResolvant: shouldn't fail:\n" ^ err));; *) let reconstructEquality cl = (*MetisTrace3 let () = Print.trace Literal.Set.pp "Proof.reconstructEquality: cl" cl *) let rec sync s t path (f,a) (f',a') = if not (Name.equal f f' && length a = length a') then None else let itms = enumerate (zip a a') in (match List.filter (fun x -> not (uncurry Term.equal (snd x))) itms with [(i,(tm,tm'))] -> let path = i :: path in if Term.equal tm s && Term.equal tm' t then Some (List.rev path) else (match (tm,tm') with (Term.Fn f_a, Term.Fn f_a') -> sync s t path f_a f_a' | _ -> None) | _ -> None) in let recon (neq,(pol,atm),(pol',atm')) = if pol = pol' then None else let (s,t) = Literal.destNeq neq in let path = if not (Term.equal s t) then sync s t [] atm atm' else if not (Atom.equal atm atm') then None else Atom.find (Term.equal s) atm in match path with Some path -> Some ((pol',atm),path,t) | None -> None in let candidates = match List.partition Literal.isNeq (Literal.Set.toList cl) with ([l1],[l2;l3]) -> [(l1,l2,l3);(l1,l3,l2)] | ([l1;l2],[l3]) -> [(l1,l2,l3);(l1,l3,l2);(l2,l1,l3);(l2,l3,l1)] | ([l1],[l2]) -> [(l1,l1,l2);(l1,l2,l1)] | _ -> raise (Bug "reconstructEquality: malformed") (*MetisTrace3 let ppCands = Print.ppList (Print.ppTriple Literal.pp Literal.pp Literal.pp) let () = Print.trace ppCands "Proof.reconstructEquality: candidates" candidates *) in match first recon candidates with Some info -> info | None -> raise (Bug "can't reconstruct Equality rule") ;; (*MetisDebug handle Error err -> raise (Bug ("Proof.recontructEquality: shouldn't fail:\n" ^ err));; *) let reconstruct cl = function (Thm.Axiom,[]) -> Axiom cl | (Thm.Assume,[]) -> (match Literal.Set.findl Literal.positive cl with Some (_,atm) -> Assume atm | None -> raise (Bug "malformed Assume inference")) | (Thm.Subst,[th]) -> Subst (reconstructSubst (Thm.clause th) cl, th) | (Thm.Resolve,[th1;th2]) -> let cl1 = Thm.clause th1 and cl2 = Thm.clause th2 in let (pol,atm) = reconstructResolvant cl1 cl2 cl in if pol then Resolve (atm,th1,th2) else Resolve (atm,th2,th1) | (Thm.Refl,[]) -> (match Literal.Set.findl (kComb true) cl with Some lit -> Refl (Literal.destRefl lit) | None -> raise (Bug "malformed Refl inference")) | (Thm.Equality,[]) -> let (x,y,z) = (reconstructEquality cl) in Equality (x,y,z) | _ -> raise (Bug "malformed inference");; let thmToInference th = (*MetisTrace3 let () = Print.trace Thm.pp "Proof.thmToInference: th" th *) let cl = Thm.clause th in let thmInf = Thm.inference th (*MetisTrace3 let ppThmInf = Print.ppPair Thm.ppInferenceType (Print.ppList Thm.pp) let () = Print.trace ppThmInf "Proof.thmToInference: thmInf" thmInf *) in let inf = reconstruct cl thmInf (*MetisTrace3 let () = Print.trace ppInference "Proof.thmToInference: inf" inf *) (*MetisDebug let () = let let th' = inferenceToThm inf in if Literal.Set.equal (Thm.clause th') cl then () else raise Bug ("Proof.thmToInference: bad inference reconstruction:" ^ "\n th = " ^ Thm.toString th ^ "\n inf = " ^ inferenceToString inf ^ "\n inf th = " ^ Thm.toString th') end *) in inf (*MetisDebug handle Error err -> raise (Bug ("Proof.thmToInference: shouldn't fail:\n" ^ err));; *) ;; (* ------------------------------------------------------------------------- *) (* Reconstructing whole proofs. *) (* ------------------------------------------------------------------------- *) let proof th = let emptyThms : Thm.thm Literal.Set_map.map = Literal.Set_map.newMap () in let rec addThms (th,ths) = let cl = Thm.clause th in if Literal.Set_map.inDomain cl ths then ths else let (_,pars) = Thm.inference th in let ths = Mlist.foldl addThms ths pars in if Literal.Set_map.inDomain cl ths then ths else Literal.Set_map.insert ths (cl,th) in let mkThms th = addThms (th,emptyThms) in let rec addProof (th,(ths,acc)) = let cl = Thm.clause th in match Literal.Set_map.peek ths cl with None -> (ths,acc) | Some th -> let (_,pars) = Thm.inference th in let (ths,acc) = Mlist.foldl addProof (ths,acc) pars in let ths = Literal.Set_map.delete ths cl in let acc = (th, thmToInference th) :: acc in (ths,acc) in let mkProof ths th = let (ths,acc) = addProof (th,(ths,[])) (*MetisTrace4 let () = Print.trace Print.ppInt "Proof.proof: unnecessary clauses" (Literal.Set_map.size ths) *) in List.rev acc (*MetisTrace3 let () = Print.trace Thm.pp "Proof.proof: th" th *) in let ths = mkThms th in let infs = mkProof ths th (*MetisTrace3 let () = Print.trace Print.ppInt "Proof.proof: size" (length infs) *) in infs ;; (* ------------------------------------------------------------------------- *) (* Free variables. *) (* ------------------------------------------------------------------------- *) let freeIn v = let free th_inf = match th_inf with (_, Axiom lits) -> Literal.Set.freeIn v lits | (_, Assume atm) -> Atom.freeIn v atm | (th, Subst _) -> Thm.freeIn v th | (_, Resolve _) -> false | (_, Refl tm) -> Term.freeIn v tm | (_, Equality (lit,_,tm)) -> Literal.freeIn v lit || Term.freeIn v tm in List.exists free ;; let freeVars = let inc (th_inf,set) = Name.Set.union set (match th_inf with (_, Axiom lits) -> Literal.Set.freeVars lits | (_, Assume atm) -> Atom.freeVars atm | (th, Subst _) -> Thm.freeVars th | (_, Resolve _) -> Name.Set.empty | (_, Refl tm) -> Term.freeVars tm | (_, Equality (lit,_,tm)) -> Name.Set.union (Literal.freeVars lit) (Term.freeVars tm)) in Mlist.foldl inc Name.Set.empty ;; end (* ========================================================================= *) (* DERIVED RULES FOR CREATING FIRST ORDER LOGIC THEOREMS *) (* ========================================================================= *) module Rule = struct open Useful;; (* ------------------------------------------------------------------------- *) (* Variable names. *) (* ------------------------------------------------------------------------- *) let xVarName = Name.fromString "x";; let xVar = Term.Var xVarName;; let yVarName = Name.fromString "y";; let yVar = Term.Var yVarName;; let zVarName = Name.fromString "z";; let zVar = Term.Var zVarName;; let xIVarName i = Name.fromString ("x" ^ Int.toString i);; let xIVar i = Term.Var (xIVarName i);; let yIVarName i = Name.fromString ("y" ^ Int.toString i);; let yIVar i = Term.Var (yIVarName i);; (* ------------------------------------------------------------------------- *) (* *) (* --------- reflexivity *) (* x = x *) (* ------------------------------------------------------------------------- *) let reflexivityRule x = Thm.refl x;; let reflexivity = reflexivityRule xVar;; (* ------------------------------------------------------------------------- *) (* *) (* --------------------- symmetry *) (* ~(x = y) \/ y = x *) (* ------------------------------------------------------------------------- *) let symmetryRule x y = let reflTh = reflexivityRule x in let reflLit = Thm.destUnit reflTh in let eqTh = Thm.equality reflLit [0] y in Thm.resolve reflLit reflTh eqTh ;; let symmetry = symmetryRule xVar yVar;; (* ------------------------------------------------------------------------- *) (* *) (* --------------------------------- transitivity *) (* ~(x = y) \/ ~(y = z) \/ x = z *) (* ------------------------------------------------------------------------- *) let transitivity = let eqTh = Thm.equality (Literal.mkEq (yVar,zVar)) [0] xVar in Thm.resolve (Literal.mkEq (yVar,xVar)) symmetry eqTh ;; (* ------------------------------------------------------------------------- *) (* x = y \/ C *) (* -------------- symEq (x = y) *) (* y = x \/ C *) (* ------------------------------------------------------------------------- *) let symEq lit th = let (x,y) = Literal.destEq lit in if Term.equal x y then th else let sub = Substitute.fromList [(xVarName,x);(yVarName,y)] in let symTh = Thm.subst sub symmetry in Thm.resolve lit th symTh ;; (* ------------------------------------------------------------------------- *) (* An equation consists of two terms (t,u) plus a theorem (stronger than) *) (* t = u \/ C. *) (* ------------------------------------------------------------------------- *) type equation = (Term.term * Term.term) * Thm.thm;; let equationLiteral (t_u,th) = let lit = Literal.mkEq t_u in if Literal.Set.member lit (Thm.clause th) then Some lit else None ;; let reflEqn t = ((t,t), Thm.refl t);; let symEqn (((t,u), th) as eqn) = if Term.equal t u then eqn else ((u,t), match equationLiteral eqn with Some t_u -> symEq t_u th | None -> th);; let transEqn (((x,y), th1) as eqn1) (((_,z), th2) as eqn2) = if Term.equal x y then eqn2 else if Term.equal y z then eqn1 else if Term.equal x z then reflEqn x else ((x,z), match equationLiteral eqn1 with None -> th1 | Some x_y -> match equationLiteral eqn2 with None -> th2 | Some y_z -> let sub = Substitute.fromList [(xVarName,x);(yVarName,y);(zVarName,z)] in let th = Thm.subst sub transitivity in let th = Thm.resolve x_y th1 th in let th = Thm.resolve y_z th2 th in th );; (*MetisDebug let transEqn = fun eqn1 -> fun eqn2 -> transEqn eqn1 eqn2 handle Error err -> raise Error ("Rule.transEqn:\neqn1 = " ^ equationToString eqn1 ^ "\neqn2 = " ^ equationToString eqn2 ^ "\n" ^ err);; *) (* ------------------------------------------------------------------------- *) (* A conversion takes a term t and either: *) (* 1. Returns a term u together with a theorem (stronger than) t = u \/ C. *) (* 2. Raises an Error exception. *) (* ------------------------------------------------------------------------- *) type conv = Term.term -> Term.term * Thm.thm;; let allConv tm = (tm, Thm.refl tm);; let noConv : conv = fun _ -> raise (Error "noConv");; (*MetisDebug let traceConv s conv tm = let let res as (tm',th) = conv tm let () = trace (s ^ ": " ^ Term.toString tm ^ " --> " ^ Term.toString tm' ^ " " ^ Thm.toString th ^ "\n") in res end handle Error err -> (trace (s ^ ": " ^ Term.toString tm ^ " --> Error: " ^ err ^ "\n");; raise (Error (s ^ ": " ^ err)));; *) let thenConvTrans tm (tm',th1) (tm'',th2) = let eqn1 = ((tm,tm'),th1) and eqn2 = ((tm',tm''),th2) in let (_,th) = transEqn eqn1 eqn2 in (tm'',th) ;; let thenConv conv1 conv2 tm = let (tm',_) as res1 = conv1 tm in let res2 = conv2 tm' in thenConvTrans tm res1 res2 ;; let orelseConv (conv1 : conv) conv2 tm = try conv1 tm with Error _ -> conv2 tm;; let tryConv conv = orelseConv conv allConv;; let changedConv conv tm = let (tm',_) as res = conv tm in if tm = tm' then raise (Error "changedConv") else res ;; let rec repeatConv conv tm = tryConv (thenConv conv (repeatConv conv)) tm;; let flip f = fun x y -> f y x;; let rec firstConv tm = function [] -> raise (Error "firstConv") | [conv] -> conv tm | (conv :: convs) -> orelseConv conv (flip firstConv convs) tm;; let firstConv convs tm = firstConv tm convs;; let rec everyConv tm = function [] -> allConv tm | [conv] -> conv tm | (conv :: convs) -> thenConv conv (flip everyConv convs) tm;; let everyConv convs tm = everyConv tm convs;; let rewrConv (((x,y), eqTh) as eqn) path tm = if Term.equal x y then allConv tm else if Mlist.null path then (y,eqTh) else let reflTh = Thm.refl tm in let reflLit = Thm.destUnit reflTh in let th = Thm.equality reflLit (1 :: path) y in let th = Thm.resolve reflLit reflTh th in let th = match equationLiteral eqn with None -> th | Some x_y -> Thm.resolve x_y eqTh th in let tm' = Term.replace tm (path,y) in (tm',th) ;; (*MetisDebug let rewrConv = fun eqn as ((x,y),eqTh) -> fun path -> fun tm -> rewrConv eqn path tm handle Error err -> raise Error ("Rule.rewrConv:\nx = " ^ Term.toString x ^ "\ny = " ^ Term.toString y ^ "\neqTh = " ^ Thm.toString eqTh ^ "\npath = " ^ Term.pathToString path ^ "\ntm = " ^ Term.toString tm ^ "\n" ^ err);; *) let pathConv conv path tm = let x = Term.subterm tm path in let (y,th) = conv x in rewrConv ((x,y),th) path tm ;; let subtermConv conv i = pathConv conv [i];; let subtermsConv conv = function (Term.Var _ as tm) -> allConv tm | (Term.Fn (_,a) as tm) -> everyConv (List.map (subtermConv conv) (interval 0 (length a))) tm;; (* ------------------------------------------------------------------------- *) (* Applying a conversion to every subterm, with some traversal strategy. *) (* ------------------------------------------------------------------------- *) let rec bottomUpConv conv tm = thenConv (subtermsConv (bottomUpConv conv)) (repeatConv conv) tm;; let rec topDownConv conv tm = thenConv (repeatConv conv) (subtermsConv (topDownConv conv)) tm;; let repeatTopDownConv conv = let rec f tm = thenConv (repeatConv conv) g tm and g tm = thenConv (subtermsConv f) h tm and h tm = tryConv (thenConv conv f) tm in f ;; (*MetisDebug let repeatTopDownConv = fun conv -> fun tm -> repeatTopDownConv conv tm handle Error err -> raise (Error ("repeatTopDownConv: " ^ err));; *) (* ------------------------------------------------------------------------- *) (* A literule (bad pun) takes a literal L and either: *) (* 1. Returns a literal L' with a theorem (stronger than) ~L \/ L' \/ C. *) (* 2. Raises an Error exception. *) (* ------------------------------------------------------------------------- *) type literule = Literal.literal -> Literal.literal * Thm.thm;; let allLiterule lit = (lit, Thm.assume lit);; let noLiterule : literule = fun _ -> raise (Error "noLiterule");; let thenLiterule literule1 literule2 lit = let (lit',th1) as res1 = literule1 lit in let (lit'',th2) as res2 = literule2 lit' in if Literal.equal lit lit' then res2 else if Literal.equal lit' lit'' then res1 else if Literal.equal lit lit'' then allLiterule lit else (lit'', if not (Thm.member lit' th1) then th1 else if not (Thm.negateMember lit' th2) then th2 else Thm.resolve lit' th1 th2) ;; let orelseLiterule (literule1 : literule) literule2 lit = try literule1 lit with Error _ -> literule2 lit;; let tryLiterule literule = orelseLiterule literule allLiterule;; let changedLiterule literule lit = let (lit',_) as res = literule lit in if lit = lit' then raise (Error "changedLiterule") else res ;; let rec repeatLiterule literule lit = tryLiterule (thenLiterule literule (repeatLiterule literule)) lit;; let rec firstLiterule lit = function [] -> raise (Error "firstLiterule") | [literule] -> literule lit | (literule :: literules) -> orelseLiterule literule (flip firstLiterule literules) lit;; let firstLiterule literules lit = firstLiterule lit literules;; let rec everyLiterule lit = function [] -> allLiterule lit | [literule] -> literule lit | (literule :: literules) -> thenLiterule literule (flip everyLiterule literules) lit;; let everyLiterule literules lit = everyLiterule lit literules;; let rewrLiterule (((x,y),eqTh) as eqn) path lit = if Term.equal x y then allLiterule lit else let th = Thm.equality lit path y in let th = match equationLiteral eqn with None -> th | Some x_y -> Thm.resolve x_y eqTh th in let lit' = Literal.replace lit (path,y) in (lit',th) ;; (*MetisDebug let rewrLiterule = fun eqn -> fun path -> fun lit -> rewrLiterule eqn path lit handle Error err -> raise Error ("Rule.rewrLiterule:\neqn = " ^ equationToString eqn ^ "\npath = " ^ Term.pathToString path ^ "\nlit = " ^ Literal.toString lit ^ "\n" ^ err);; *) let pathLiterule conv path lit = let tm = Literal.subterm lit path in let (tm',th) = conv tm in rewrLiterule ((tm,tm'),th) path lit ;; let argumentLiterule conv i = pathLiterule conv [i];; let allArgumentsLiterule conv lit = everyLiterule (List.map (argumentLiterule conv) (interval 0 (Literal.arity lit))) lit;; (* ------------------------------------------------------------------------- *) (* A rule takes one theorem and either deduces another or raises an Error *) (* exception. *) (* ------------------------------------------------------------------------- *) type rule = Thm.thm -> Thm.thm;; let allRule : rule = fun th -> th;; let noRule : rule = fun _ -> raise (Error "noRule");; let thenRule (rule1 : rule) (rule2 : rule) th = rule1 (rule2 th);; let orelseRule (rule1 : rule) rule2 th = try rule1 th with Error _ -> rule2 th;; let tryRule rule = orelseRule rule allRule;; let changedRule rule th = let th' = rule th in if not (Literal.Set.equal (Thm.clause th) (Thm.clause th')) then th' else raise (Error "changedRule") ;; let rec repeatRule rule lit = tryRule (thenRule rule (repeatRule rule)) lit;; let rec firstRule th = function [] -> raise (Error "firstRule") | [rule] -> rule th | (rule :: rules) -> orelseRule rule (flip firstRule rules) th;; let firstRule rules th = firstRule th rules;; let rec everyRule th = function [] -> allRule th | [rule] -> rule th | (rule :: rules) -> thenRule rule (flip everyRule rules) th;; let everyRule rules th = everyRule th rules;; let literalRule literule lit th = let (lit',litTh) = literule lit in if Literal.equal lit lit' then th else if not (Thm.negateMember lit litTh) then litTh else Thm.resolve lit th litTh ;; (*MetisDebug let literalRule = fun literule -> fun lit -> fun th -> literalRule literule lit th handle Error err -> raise Error ("Rule.literalRule:\nlit = " ^ Literal.toString lit ^ "\nth = " ^ Thm.toString th ^ "\n" ^ err);; *) let rewrRule eqTh lit path = literalRule (rewrLiterule eqTh path) lit;; let pathRule conv lit path = literalRule (pathLiterule conv path) lit;; let literalsRule literule = let f (lit,th) = if Thm.member lit th then literalRule literule lit th else th in fun lits -> fun th -> Literal.Set.foldl f th lits ;; let allLiteralsRule literule th = literalsRule literule (Thm.clause th) th;; let convRule conv = allLiteralsRule (allArgumentsLiterule conv);; (* ------------------------------------------------------------------------- *) (* *) (* ---------------------------------------------- functionCongruence (f,n) *) (* ~(x0 = y0) \/ ... \/ ~(x{n-1} = y{n-1}) \/ *) (* f x0 ... x{n-1} = f y0 ... y{n-1} *) (* ------------------------------------------------------------------------- *) let functionCongruence (f,n) = let xs = Mlist.tabulate (n,xIVar) and ys = Mlist.tabulate (n,yIVar) in let cong ((i,yi),(th,lit)) = let path = [1;i] in let th = Thm.resolve lit th (Thm.equality lit path yi) in let lit = Literal.replace lit (path,yi) in (th,lit) in let reflTh = Thm.refl (Term.Fn (f,xs)) in let reflLit = Thm.destUnit reflTh in fst (Mlist.foldl cong (reflTh,reflLit) (enumerate ys)) ;; (* ------------------------------------------------------------------------- *) (* *) (* ---------------------------------------------- relationCongruence (R,n) *) (* ~(x0 = y0) \/ ... \/ ~(x{n-1} = y{n-1}) \/ *) (* ~R x0 ... x{n-1} \/ R y0 ... y{n-1} *) (* ------------------------------------------------------------------------- *) let relationCongruence (r,n) = let xs = Mlist.tabulate (n,xIVar) and ys = Mlist.tabulate (n,yIVar) in let cong ((i,yi),(th,lit)) = let path = [i] in let th = Thm.resolve lit th (Thm.equality lit path yi) in let lit = Literal.replace lit (path,yi) in (th,lit) in let assumeLit = (false,(r,xs)) in let assumeTh = Thm.assume assumeLit in fst (Mlist.foldl cong (assumeTh,assumeLit) (enumerate ys)) ;; (* ------------------------------------------------------------------------- *) (* ~(x = y) \/ C *) (* ----------------- symNeq ~(x = y) *) (* ~(y = x) \/ C *) (* ------------------------------------------------------------------------- *) let symNeq lit th = let (x,y) = Literal.destNeq lit in if Term.equal x y then th else let sub = Substitute.fromList [(xVarName,y);(yVarName,x)] in let symTh = Thm.subst sub symmetry in Thm.resolve lit th symTh ;; (* ------------------------------------------------------------------------- *) (* sym (x = y) = symEq (x = y) /\ sym ~(x = y) = symNeq ~(x = y) *) (* ------------------------------------------------------------------------- *) let sym ((pol,_) as lit) th = if pol then symEq lit th else symNeq lit th;; (* ------------------------------------------------------------------------- *) (* ~(x = x) \/ C *) (* ----------------- removeIrrefl *) (* C *) (* *) (* where all irreflexive equalities. *) (* ------------------------------------------------------------------------- *) let removeIrrefl th = let irrefl = function ((true,_),th) -> th | ((false,atm) as lit, th) -> match total Atom.destRefl atm with Some x -> Thm.resolve lit th (Thm.refl x) | None -> th in Literal.Set.foldl irrefl th (Thm.clause th);; (* ------------------------------------------------------------------------- *) (* x = y \/ y = x \/ C *) (* ----------------------- removeSym *) (* x = y \/ C *) (* *) (* where all duplicate copies of equalities and disequalities are removed. *) (* ------------------------------------------------------------------------- *) let removeSym th = let rem ((pol,atm) as lit, (eqs,th)) = match total Atom.sym atm with None -> (eqs, th) | Some atm' -> if Literal.Set.member lit eqs then (eqs, if pol then symEq lit th else symNeq lit th) else (Literal.Set.add eqs (pol,atm'), th) in snd (Literal.Set.foldl rem (Literal.Set.empty,th) (Thm.clause th));; (* ------------------------------------------------------------------------- *) (* ~(v = t) \/ C *) (* ----------------- expandAbbrevs *) (* C[t/v] *) (* *) (* where t must not contain any occurrence of the variable v. *) (* ------------------------------------------------------------------------- *) let rec expandAbbrevs th = let expand lit = let (x,y) = Literal.destNeq lit in let _ = Term.isTypedVar x || Term.isTypedVar y || raise (Error "Rule.expandAbbrevs: no vars") in let _ = not (Term.equal x y) || raise (Error "Rule.expandAbbrevs: equal vars") in Substitute.unify Substitute.empty x y in match Literal.Set.firstl (total expand) (Thm.clause th) with None -> removeIrrefl th | Some sub -> expandAbbrevs (Thm.subst sub th);; (* ------------------------------------------------------------------------- *) (* simplify = isTautology + expandAbbrevs + removeSym *) (* ------------------------------------------------------------------------- *) let rec simplify th = if Thm.isTautology th then None else let th' = th in let th' = expandAbbrevs th' in let th' = removeSym th' in if Thm.equal th th' then Some th else simplify th' ;; (* ------------------------------------------------------------------------- *) (* C *) (* -------- freshVars *) (* C[s] *) (* *) (* where s is a renaming substitution chosen so that all of the variables in *) (* C are replaced by fresh variables. *) (* ------------------------------------------------------------------------- *) let freshVars th = Thm.subst (Substitute.freshVars (Thm.freeVars th)) th;; (* ------------------------------------------------------------------------- *) (* C *) (* ---------------------------- factor *) (* C_s_1, C_s_2, ..., C_s_n *) (* *) (* where each s_i is a substitution that factors C, meaning that the theorem *) (* *) (* C_s_i = (removeIrrefl o removeSym o Thm.subst s_i) C *) (* *) (* has fewer literals than C. *) (* *) (* Also, if s is any substitution that factors C, then one of the s_i will *) (* result in a theorem C_s_i that strictly subsumes the theorem C_s. *) (* ------------------------------------------------------------------------- *) type edge = Factor_edge of Atom.atom * Atom.atom | Refl_edge of Term.term * Term.term;; type joinStatus = Joined | Joinable of Substitute.subst | Apart;; let joinEdge sub edge = let result = match edge with Factor_edge (atm,atm') -> total (Atom.unify sub atm) atm' | Refl_edge (tm,tm') -> total (Substitute.unify sub tm) tm' in match result with None -> Apart | Some sub' -> if Portable.pointerEqual (sub,sub') then Joined else Joinable sub' ;; let updateApart sub = let rec update acc = function [] -> Some acc | (edge :: edges) -> match joinEdge sub edge with Joined -> None | Joinable _ -> update (edge :: acc) edges | Apart -> update acc edges in update [] ;; let addFactorEdge (pol,atm) ((pol',atm'),acc) = if pol <> pol' then acc else let edge = Factor_edge (atm,atm') in match joinEdge Substitute.empty edge with Joined -> raise (Bug "addFactorEdge: joined") | Joinable sub -> (sub,edge) :: acc | Apart -> acc ;; let addReflEdge = function ((false,_), acc) -> acc | ((true,atm), acc) -> let edge = let (x,y) = (Atom.destEq atm) in Refl_edge (x,y) in match joinEdge Substitute.empty edge with Joined -> raise (Bug "addRefl: joined") | Joinable _ -> edge :: acc | Apart -> acc ;; let addReflEdge = curry addReflEdge;; let addIrreflEdge = function ((true,_), acc) -> acc | ((false,atm), acc) -> let edge = let (x,y) = (Atom.destEq atm) in Refl_edge (x,y) in match joinEdge Substitute.empty edge with Joined -> raise (Bug "addRefl: joined") | Joinable sub -> (sub,edge) :: acc | Apart -> acc ;; let addIrreflEdge = curry addIrreflEdge;; let rec init_edges acc apart = function [] -> let init ((apart,sub,edge),(edges,acc)) = (edge :: edges, (apart,sub,edges) :: acc) in snd (Mlist.foldl init ([],[]) acc) | ((sub,edge) :: sub_edges) -> (*MetisDebug let () = if not (Substitute.null sub) then () else raise Bug "Rule.factor.init_edges: empty subst" *) let (acc,apart) = match updateApart sub apart with Some apart' -> ((apart',sub,edge) :: acc, edge :: apart) | None -> (acc,apart) in init_edges acc apart sub_edges ;; let rec mk_edges apart sub_edges = function [] -> init_edges [] apart sub_edges | (lit :: lits) -> let sub_edges = Mlist.foldl (addFactorEdge lit) sub_edges lits in let (apart,sub_edges) = match total Literal.sym lit with None -> (apart,sub_edges) | Some lit' -> let apart = addReflEdge lit apart in let sub_edges = addIrreflEdge lit sub_edges in let sub_edges = Mlist.foldl (addFactorEdge lit') sub_edges lits in (apart,sub_edges) in mk_edges apart sub_edges lits ;; let rec fact acc = function [] -> acc | ((_,sub,[]) :: others) -> fact (sub :: acc) others | ((apart, sub, edge :: edges) :: others) -> let others = match joinEdge sub edge with Joinable sub' -> let others = (edge :: apart, sub, edges) :: others in (match updateApart sub' apart with None -> others | Some apart' -> (apart',sub',edges) :: others) | _ -> (apart,sub,edges) :: others in fact acc others ;; let factor' cl = (*MetisTrace6 let () = Print.trace Literal.Set.pp "Rule.factor': cl" cl *) let edges = mk_edges [] [] (Literal.Set.toList cl) (*MetisTrace6 let ppEdgesSize = Print.ppMap length Print.ppInt let ppEdgel = Print.ppList ppEdge let ppEdges = Print.ppList (Print.ppTriple ppEdgel Substitute.pp ppEdgel) let () = Print.trace ppEdgesSize "Rule.factor': |edges|" edges let () = Print.trace ppEdges "Rule.factor': edges" edges *) in let result = fact [] edges (*MetisTrace6 let ppResult = Print.ppList Substitute.pp let () = Print.trace ppResult "Rule.factor': result" result *) in result ;; let factor th = let fact sub = removeSym (Thm.subst sub th) in List.map fact (factor' (Thm.clause th)) ;; end (* ========================================================================= *) (* RANDOM FINITE MODELS *) (* ========================================================================= *) module Model = struct open Useful;; (* ------------------------------------------------------------------------- *) (* Constants. *) (* ------------------------------------------------------------------------- *) let maxSpace = 1000;; (* ------------------------------------------------------------------------- *) (* Helper functions. *) (* ------------------------------------------------------------------------- *) let multInt = match Int.maxInt with None -> (fun x -> fun y -> Some (x * y)) | Some m -> let m = Real.floor (Math.sqrt (Real.fromInt m)) in fun x -> fun y -> if x <= m && y <= m then Some (x * y) else None ;; let rec iexp x y acc = if y mod 2 = 0 then iexp' x y acc else match multInt acc x with Some acc -> iexp' x y acc | None -> None and iexp' x y acc = if y = 1 then Some acc else let y = Int.div y 2 in match multInt x x with Some x -> iexp x y acc | None -> None ;; let expInt x y = if y <= 1 then if y = 0 then Some 1 else if y = 1 then Some x else raise (Bug "expInt: negative exponent") else if x <= 1 then if 0 <= x then Some x else raise (Bug "expInt: negative exponand") else iexp x y 1;; let boolToInt = function true -> 1 | false -> 0;; let intToBool = function 1 -> true | 0 -> false | _ -> raise (Bug "Model.intToBool");; let minMaxInterval i j = interval i (1 + j - i);; (* ------------------------------------------------------------------------- *) (* Model size. *) (* ------------------------------------------------------------------------- *) type size = {size : int};; (* ------------------------------------------------------------------------- *) (* A model of size N has integer elements 0...N-1. *) (* ------------------------------------------------------------------------- *) type element = int;; let zeroElement = 0;; let incrementElement {size = n} i = let i = i + 1 in if i = n then None else Some i ;; let elementListSpace {size = n} arity = match expInt n arity with None -> None | Some m as s -> if m <= maxSpace then s else None;; let elementListIndex {size = n} = let rec f acc elts = match elts with [] -> acc | elt :: elts -> f (n * acc + elt) elts in f 0 ;; (* ------------------------------------------------------------------------- *) (* The parts of the model that are fixed. *) (* ------------------------------------------------------------------------- *) type fixedFunction = size -> element list -> element option;; type fixedRelation = size -> element list -> bool option;; type fixed = {functions : fixedFunction Name_arity.Map.map; relations : fixedRelation Name_arity.Map.map};; let uselessFixedFunction : fixedFunction = kComb (kComb None);; let uselessFixedRelation : fixedRelation = kComb (kComb None);; let emptyFunctions : fixedFunction Name_arity.Map.map = Name_arity.Map.newMap ();; let emptyRelations : fixedRelation Name_arity.Map.map = Name_arity.Map.newMap ();; let fixed0 f sz elts = match elts with [] -> f sz | _ -> raise (Bug "Model.fixed0: wrong arity");; let fixed1 f sz elts = match elts with [x] -> f sz x | _ -> raise (Bug "Model.fixed1: wrong arity");; let fixed2 f sz elts = match elts with [x;y] -> f sz x y | _ -> raise (Bug "Model.fixed2: wrong arity");; let emptyFixed = let fns = emptyFunctions and rels = emptyRelations in {functions = fns; relations = rels} ;; let peekFunctionFixed fix name_arity = let {functions = fns} = fix in Name_arity.Map.peek fns name_arity ;; let peekRelationFixed fix name_arity = let {relations = rels} = fix in Name_arity.Map.peek rels name_arity ;; let getFunctionFixed fix name_arity = match peekFunctionFixed fix name_arity with Some f -> f | None -> uselessFixedFunction;; let getRelationFixed fix name_arity = match peekRelationFixed fix name_arity with Some rel -> rel | None -> uselessFixedRelation;; let insertFunctionFixed fix name_arity_fun = let {functions = fns; relations = rels} = fix in let fns = Name_arity.Map.insert fns name_arity_fun in {functions = fns; relations = rels} ;; let insertRelationFixed fix name_arity_rel = let {functions = fns; relations = rels} = fix in let rels = Name_arity.Map.insert rels name_arity_rel in {functions = fns; relations = rels} ;; let union _ = raise (Bug "Model.unionFixed: nameArity clash");; let unionFixed fix1 fix2 = let {functions = fns1; relations = rels1} = fix1 and {functions = fns2; relations = rels2} = fix2 in let fns = Name_arity.Map.union union fns1 fns2 in let rels = Name_arity.Map.union union rels1 rels2 in {functions = fns; relations = rels} ;; let unionListFixed = let union (fix,acc) = unionFixed acc fix in Mlist.foldl union emptyFixed ;; let hasTypeFn _ elts = match elts with [x;_] -> Some x | _ -> raise (Bug "Model.hasTypeFn: wrong arity");; let eqRel _ elts = match elts with [x;y] -> Some (x = y) | _ -> raise (Bug "Model.eqRel: wrong arity");; let basicFixed = let fns = Name_arity.Map.singleton (Term.hasTypeFunction,hasTypeFn) in let rels = Name_arity.Map.singleton (Atom.eqRelation,eqRel) in {functions = fns; relations = rels} ;; (* ------------------------------------------------------------------------- *) (* Renaming fixed model parts. *) (* ------------------------------------------------------------------------- *) type fixedMap = {functionMap : Name.name Name_arity.Map.map; relationMap : Name.name Name_arity.Map.map};; let mapFixed fixMap fix = let {functionMap = fnMap; relationMap = relMap} = fixMap and {functions = fns; relations = rels} = fix in let fns = Name_arity.Map.compose fnMap fns in let rels = Name_arity.Map.compose relMap rels in {functions = fns; relations = rels} ;; (* ------------------------------------------------------------------------- *) (* Standard fixed model parts. *) (* ------------------------------------------------------------------------- *) (* Projections *) let projectionMin = 1 and projectionMax = 9;; let projectionList = minMaxInterval projectionMin projectionMax;; let projectionName i = let _ = projectionMin <= i || raise (Bug "Model.projectionName: less than projectionMin") in let _ = i <= projectionMax || raise (Bug "Model.projectionName: greater than projectionMax") in Name.fromString ("project" ^ Int.toString i) ;; let projectionFn i _ elts = Some (Mlist.nth (elts, i - 1));; let arityProjectionFixed arity = let mkProj i = ((projectionName i, arity), projectionFn i) in let rec addProj i acc = if i > arity then acc else addProj (i + 1) (Name_arity.Map.insert acc (mkProj i)) in let fns = addProj projectionMin emptyFunctions in let rels = emptyRelations in {functions = fns; relations = rels} ;; let projectionFixed = unionListFixed (List.map arityProjectionFixed projectionList);; (* Arithmetic *) let numeralMin = -100 and numeralMax = 100;; let numeralList = minMaxInterval numeralMin numeralMax;; let numeralName i = let _ = numeralMin <= i || raise (Bug "Model.numeralName: less than numeralMin") in let _ = i <= numeralMax || raise (Bug "Model.numeralName: greater than numeralMax") in let s = if i < 0 then "negative" ^ Int.toString (-i) else Int.toString i in Name.fromString s ;; let addName = Name.fromString "+" and divName = Name.fromString "div" and dividesName = Name.fromString "divides" and evenName = Name.fromString "even" and expName = Name.fromString "exp" and geName = Name.fromString ">=" and gtName = Name.fromString ">" and isZeroName = Name.fromString "isZero" and leName = Name.fromString "<=" and ltName = Name.fromString "<" and modName = Name.fromString "mod" and multName = Name.fromString "*" and negName = Name.fromString "~" and oddName = Name.fromString "odd" and preName = Name.fromString "pre" and subName = Name.fromString "-" and sucName = Name.fromString "suc";; (* Support *) let modN {size = n} x = x mod n;; let oneN sz = modN sz 1;; let multN sz (x,y) = modN sz (x * y);; (* Functions *) let numeralFn i sz = Some (modN sz i);; let addFn sz x y = Some (modN sz (x + y));; let divFn {size = n} x y = let y = if y = 0 then n else y in Some (Int.div x y) ;; let expFn sz x y = Some (exp (multN sz) x y (oneN sz));; let modFn {size = n} x y = let y = if y = 0 then n else y in Some (x mod y) ;; let multFn sz x y = Some (multN sz (x,y));; let negFn {size = n} x = Some (if x = 0 then 0 else n - x);; let preFn {size = n} x = Some (if x = 0 then n - 1 else x - 1);; let subFn {size = n} x y = Some (if x < y then n + x - y else x - y);; let sucFn {size = n} x = Some (if x = n - 1 then 0 else x + 1);; (* Relations *) let dividesRel _ x y = Some (divides x y);; let evenRel _ x = Some (x mod 2 = 0);; let geRel _ x y = Some (x >= y);; let gtRel _ x y = Some (x > y);; let isZeroRel _ x = Some (x = 0);; let leRel _ x y = Some (x <= y);; let ltRel _ x y = Some (x < y);; let oddRel _ x = Some (x mod 2 = 1);; let modularFixed = let fns = Name_arity.Map.fromList (List.map (fun i -> ((numeralName i,0), fixed0 (numeralFn i))) numeralList @ [((addName,2), fixed2 addFn); ((divName,2), fixed2 divFn); ((expName,2), fixed2 expFn); ((modName,2), fixed2 modFn); ((multName,2), fixed2 multFn); ((negName,1), fixed1 negFn); ((preName,1), fixed1 preFn); ((subName,2), fixed2 subFn); ((sucName,1), fixed1 sucFn)]) in let rels = Name_arity.Map.fromList [((dividesName,2), fixed2 dividesRel); ((evenName,1), fixed1 evenRel); ((geName,2), fixed2 geRel); ((gtName,2), fixed2 gtRel); ((isZeroName,1), fixed1 isZeroRel); ((leName,2), fixed2 leRel); ((ltName,2), fixed2 ltRel); ((oddName,1), fixed1 oddRel)] in {functions = fns; relations = rels} ;; (* Support *) let cutN {size = n} x = if x >= n then n - 1 else x;; let oneN sz = cutN sz 1;; let multN sz (x,y) = cutN sz (x * y);; (* Functions *) let numeralFn i sz = if i < 0 then None else Some (cutN sz i);; let addFn sz x y = Some (cutN sz (x + y));; let divFn _ x y = if y = 0 then None else Some (Int.div x y);; let expFn sz x y = Some (exp (multN sz) x y (oneN sz));; let modFn {size = n} x y = if y = 0 || x = n - 1 then None else Some (x mod y);; let multFn sz x y = Some (multN sz (x,y));; let negFn _ x = if x = 0 then Some 0 else None;; let preFn _ x = if x = 0 then None else Some (x - 1);; let subFn {size = n} x y = if y = 0 then Some x else if x = n - 1 || x < y then None else Some (x - y);; let sucFn sz x = Some (cutN sz (x + 1));; (* Relations *) let dividesRel {size = n} x y = if x = 1 || y = 0 then Some true else if x = 0 then Some false else if y = n - 1 then None else Some (divides x y);; let evenRel {size = n} x = if x = n - 1 then None else Some (x mod 2 = 0);; let geRel {size = n} y x = if x = n - 1 then if y = n - 1 then None else Some false else if y = n - 1 then Some true else Some (x <= y);; let gtRel {size = n} y x = if x = n - 1 then if y = n - 1 then None else Some false else if y = n - 1 then Some true else Some (x < y);; let isZeroRel _ x = Some (x = 0);; let leRel {size = n} x y = if x = n - 1 then if y = n - 1 then None else Some false else if y = n - 1 then Some true else Some (x <= y);; let ltRel {size = n} x y = if x = n - 1 then if y = n - 1 then None else Some false else if y = n - 1 then Some true else Some (x < y);; let oddRel {size = n} x = if x = n - 1 then None else Some (x mod 2 = 1);; let overflowFixed = let fns = Name_arity.Map.fromList (List.map (fun i -> ((numeralName i,0), fixed0 (numeralFn i))) numeralList @ [((addName,2), fixed2 addFn); ((divName,2), fixed2 divFn); ((expName,2), fixed2 expFn); ((modName,2), fixed2 modFn); ((multName,2), fixed2 multFn); ((negName,1), fixed1 negFn); ((preName,1), fixed1 preFn); ((subName,2), fixed2 subFn); ((sucName,1), fixed1 sucFn)]) in let rels = Name_arity.Map.fromList [((dividesName,2), fixed2 dividesRel); ((evenName,1), fixed1 evenRel); ((geName,2), fixed2 geRel); ((gtName,2), fixed2 gtRel); ((isZeroName,1), fixed1 isZeroRel); ((leName,2), fixed2 leRel); ((ltName,2), fixed2 ltRel); ((oddName,1), fixed1 oddRel)] in {functions = fns; relations = rels} ;; (* Sets *) let cardName = Name.fromString "card" and complementName = Name.fromString "complement" and differenceName = Name.fromString "difference" and emptyName = Name.fromString "empty" and memberName = Name.fromString "member" and insertName = Name.fromString "insert" and intersectName = Name.fromString "intersect" and singletonName = Name.fromString "singleton" and subsetName = Name.fromString "subset" and symmetricDifferenceName = Name.fromString "symmetricDifference" and unionName = Name.fromString "union" and universeName = Name.fromString "universe";; (* Support *) let eltN {size = n} = let rec f acc = function 0 -> acc | x -> f (acc + 1) (Int.div x 2) in f (-1) n ;; let posN i = Word.shiftLeft (1, Word.fromInt i);; let univN sz = Word.minus (posN (eltN sz), 1);; let setN sz x = Word.andb (Word.fromInt x, univN sz);; (* Functions *) let cardFn sz x = let rec f acc = function 0 -> acc | s -> let acc = if Word.andb (s,1) = 0 then acc else acc + 1 in f acc (Word.shiftRight (s,1)) in Some (f (setN sz x) 0) ;; let complementFn sz x = Some (Word.toInt (Word.xorb (univN sz, setN sz x)));; let differenceFn sz x y = let x = setN sz x and y = setN sz y in Some (Word.toInt (Word.andb (x, Word.notb y))) ;; let emptyFn _ = Some 0;; let insertFn sz x y = let x = x mod eltN sz and y = setN sz y in Some (Word.toInt (Word.orb (posN x, y))) ;; let intersectFn sz x y = Some (Word.toInt (Word.andb (setN sz x, setN sz y)));; let singletonFn sz x = let x = x mod eltN sz in Some (Word.toInt (posN x)) ;; let symmetricDifferenceFn sz x y = let x = setN sz x and y = setN sz y in Some (Word.toInt (Word.xorb (x,y))) ;; let unionFn sz x y = Some (Word.toInt (Word.orb (setN sz x, setN sz y)));; let universeFn sz = Some (Word.toInt (univN sz));; (* Relations *) let memberRel sz x y = let x = x mod eltN sz and y = setN sz y in Some (Word.andb (posN x, y) <> 0) ;; let subsetRel sz x y = let x = setN sz x and y = setN sz y in Some (Word.andb (x, Word.notb y) = 0) ;; let setFixed = let fns = Name_arity.Map.fromList [((cardName,1), fixed1 cardFn); ((complementName,1), fixed1 complementFn); ((differenceName,2), fixed2 differenceFn); ((emptyName,0), fixed0 emptyFn); ((insertName,2), fixed2 insertFn); ((intersectName,2), fixed2 intersectFn); ((singletonName,1), fixed1 singletonFn); ((symmetricDifferenceName,2), fixed2 symmetricDifferenceFn); ((unionName,2), fixed2 unionFn); ((universeName,0), fixed0 universeFn)] in let rels = Name_arity.Map.fromList [((memberName,2), fixed2 memberRel); ((subsetName,2), fixed2 subsetRel)] in {functions = fns; relations = rels} ;; (* Lists *) let appendName = Name.fromString "@" and consName = Name.fromString "::" and lengthName = Name.fromString "length" and nilName = Name.fromString "nil" and nullName = Name.fromString "null" and tailName = Name.fromString "tail";; let baseFix = let fix = unionFixed projectionFixed overflowFixed in let sucFn = getFunctionFixed fix (sucName,1) in let suc2Fn sz _ x = sucFn sz [x] in insertFunctionFixed fix ((sucName,2), fixed2 suc2Fn) ;; let fixMap = {functionMap = Name_arity.Map.fromList [((appendName,2),addName); ((consName,2),sucName); ((lengthName,1), projectionName 1); ((nilName,0), numeralName 0); ((tailName,1),preName)]; relationMap = Name_arity.Map.fromList [((nullName,1),isZeroName)]};; let listFixed = mapFixed fixMap baseFix;; (* ------------------------------------------------------------------------- *) (* Valuations. *) (* ------------------------------------------------------------------------- *) type valuation = Valuation of element Name.Map.map;; let emptyValuation = Valuation (Name.Map.newMap ());; let insertValuation (Valuation m) v_i = Valuation (Name.Map.insert m v_i);; let peekValuation (Valuation m) v = Name.Map.peek m v;; let constantValuation i = let add (v,v') = insertValuation v' (v,i) in Name.Set.foldl add emptyValuation ;; let zeroValuation = constantValuation zeroElement;; let getValuation v' v = match peekValuation v' v with Some i -> i | None -> raise (Error "Model.getValuation: incomplete valuation");; let randomValuation {size = n} vs = let f (v,v') = insertValuation v' (v, Portable.randomInt n) in Name.Set.foldl f emptyValuation vs ;; let incrementValuation n vars = let rec inc vs v' = match vs with [] -> None | v :: vs -> let (carry,i) = match incrementElement n (getValuation v' v) with Some i -> (false,i) | None -> (true,zeroElement) in let v' = insertValuation v' (v,i) in if carry then inc vs v' else Some v' in inc (Name.Set.toList vars) ;; let foldValuation n vars f = let inc = incrementValuation n vars in let rec fold v' acc = let acc = f (v',acc) in match inc v' with None -> acc | Some v' -> fold v' acc in let zero = zeroValuation vars in fold zero ;; (* ------------------------------------------------------------------------- *) (* A type of random finite mapping Z^n -> Z. *) (* ------------------------------------------------------------------------- *) let cUNKNOWN = -1;; type table = Forgetful_table | Array_table of int array;; let newTable n arity = match elementListSpace {size = n} arity with None -> Forgetful_table | Some space -> Array_table (Array.make space cUNKNOWN);; let randomResult r = Portable.randomInt r;; let lookupTable n vR table elts = match table with Forgetful_table -> randomResult vR | Array_table a -> let i = elementListIndex {size = n} elts in let r = Array.get a i in if r <> cUNKNOWN then r else let r = randomResult vR in let () = Array.set a i r in r ;; let updateTable n table (elts,r) = match table with Forgetful_table -> () | Array_table a -> let i = elementListIndex {size = n} elts in let () = Array.set a i r in () ;; (* ------------------------------------------------------------------------- *) (* A type of random finite mappings name * arity -> Z^arity -> Z. *) (* ------------------------------------------------------------------------- *) type tables = {domainSize : int; rangeSize : int; tableMap : table Name_arity.Map.map ref};; let newTables n vR = {domainSize = n; rangeSize = vR; tableMap = ref (Name_arity.Map.newMap ())};; let getTables tables n_a = let {domainSize = n; rangeSize = _; tableMap = tm} = tables in let m = !tm in match Name_arity.Map.peek m n_a with Some t -> t | None -> let (_,a) = n_a in let t = newTable n a in let m = Name_arity.Map.insert m (n_a,t) in let () = tm := m in t ;; let lookupTables tables (n,elts) = let {domainSize = vN; rangeSize = vR} = tables in let a = length elts in let table = getTables tables (n,a) in lookupTable vN vR table elts ;; let updateTables tables ((n,elts),r) = let {domainSize = vN} = tables in let a = length elts in let table = getTables tables (n,a) in updateTable vN table (elts,r) ;; (* ------------------------------------------------------------------------- *) (* A type of random finite models. *) (* ------------------------------------------------------------------------- *) type parameters = {sizep : int; fixed : fixed};; type model = {sizem : int; fixedFunctions : (element list -> element option) Name_arity.Map.map; fixedRelations : (element list -> bool option) Name_arity.Map.map; randomFunctions : tables; randomRelations : tables};; let newModel {sizep = vN; fixed = fixed} = let {functions = fns; relations = rels} = fixed in let fixFns = Name_arity.Map.transform (fun f -> f {size = vN}) fns and fixRels = Name_arity.Map.transform (fun r -> r {size = vN}) rels in let rndFns = newTables vN vN and rndRels = newTables vN 2 in {sizem = vN; fixedFunctions = fixFns; fixedRelations = fixRels; randomFunctions = rndFns; randomRelations = rndRels} ;; let msize ({sizem = vN}) = vN;; let psize ({sizep = vN}) = vN;; let peekFixedFunction vM (n,elts) = let {fixedFunctions = fixFns} = vM in match Name_arity.Map.peek fixFns (n, length elts) with None -> None | Some fixFn -> fixFn elts ;; let isFixedFunction vM n_elts = Option.isSome (peekFixedFunction vM n_elts);; let peekFixedRelation vM (n,elts) = let {fixedRelations = fixRels} = vM in match Name_arity.Map.peek fixRels (n, length elts) with None -> None | Some fixRel -> fixRel elts ;; let isFixedRelation vM n_elts = Option.isSome (peekFixedRelation vM n_elts);; (* A default model *) let defaultSize = 8;; let defaultFixed = unionListFixed [basicFixed; projectionFixed; modularFixed; setFixed; listFixed];; let default = {sizep = defaultSize; fixed = defaultFixed};; (* ------------------------------------------------------------------------- *) (* Taking apart terms to interpret them. *) (* ------------------------------------------------------------------------- *) let destTerm tm = match tm with Term.Var _ -> tm | Term.Fn f_tms -> match Term.stripApp tm with (_,[]) -> tm | (Term.Var _ as v, tms) -> Term.Fn (Term.appName, v :: tms) | (Term.Fn (f,tms), tms') -> Term.Fn (f, tms @ tms');; (* ------------------------------------------------------------------------- *) (* Interpreting terms and formulas in the model. *) (* ------------------------------------------------------------------------- *) let interpretFunction vM n_elts = match peekFixedFunction vM n_elts with Some r -> r | None -> let {randomFunctions = rndFns} = vM in lookupTables rndFns n_elts ;; let interpretRelation vM n_elts = match peekFixedRelation vM n_elts with Some r -> r | None -> let {randomRelations = rndRels} = vM in intToBool (lookupTables rndRels n_elts) ;; let interpretTerm vM vV = let rec interpret tm = match destTerm tm with Term.Var v -> getValuation vV v | Term.Fn (f,tms) -> interpretFunction vM (f, List.map interpret tms) in interpret ;; let interpretAtom vM vV (r,tms) = interpretRelation vM (r, List.map (interpretTerm vM vV) tms);; let interpretFormula vM = let vN = msize vM in let rec interpret vV fm = match fm with Formula.True -> true | Formula.False -> false | Formula.Atom atm -> interpretAtom vM vV atm | Formula.Not p -> not (interpret vV p) | Formula.Or (p,q) -> interpret vV p || interpret vV q | Formula.And (p,q) -> interpret vV p && interpret vV q | Formula.Imp (p,q) -> interpret vV (Formula.Or (Formula.Not p, q)) | Formula.Iff (p,q) -> interpret vV p = interpret vV q | Formula.Forall (v,p) -> interpret' vV p v vN | Formula.Exists (v,p) -> interpret vV (Formula.Not (Formula.Forall (v, Formula.Not p))) and interpret' vV fm v i = i = 0 || let i = i - 1 in let vV' = insertValuation vV (v,i) in interpret vV' fm && interpret' vV fm v i in interpret ;; let interpretLiteral vM vV (pol,atm) = let b = interpretAtom vM vV atm in if pol then b else not b ;; let interpretClause vM vV cl = Literal.Set.exists (interpretLiteral vM vV) cl;; (* ------------------------------------------------------------------------- *) (* Check whether random groundings of a formula are true in the model. *) (* Note: if it's cheaper, a systematic check will be performed instead. *) (* ------------------------------------------------------------------------- *) let check interpret maxChecks vM fv x = let vN = msize vM in let score (vV,(vT,vF)) = if interpret vM vV x then (vT + 1, vF) else (vT, vF + 1) in let randomCheck acc = score (randomValuation {size = vN} fv, acc) in let maxChecks = match maxChecks with None -> maxChecks | Some m -> match expInt vN (Name.Set.size fv) with Some n -> if n <= m then None else maxChecks | None -> maxChecks in match maxChecks with Some m -> funpow m randomCheck (0, 0) | None -> foldValuation {size = vN} fv score (0, 0) ;; let checkAtom maxChecks vM atm = check interpretAtom maxChecks vM (Atom.freeVars atm) atm;; let checkFormula maxChecks vM fm = check interpretFormula maxChecks vM (Formula.freeVars fm) fm;; let checkLiteral maxChecks vM lit = check interpretLiteral maxChecks vM (Literal.freeVars lit) lit;; let checkClause maxChecks vM cl = check interpretClause maxChecks vM (Literal.Set.freeVars cl) cl;; (* ------------------------------------------------------------------------- *) (* Updating the model. *) (* ------------------------------------------------------------------------- *) let updateFunction vM func_elts_elt = let {randomFunctions = rndFns} = vM in let () = updateTables rndFns func_elts_elt in () ;; let updateRelation vM (rel_elts,pol) = let {randomRelations = rndRels} = vM in let () = updateTables rndRels (rel_elts, boolToInt pol) in () ;; (* ------------------------------------------------------------------------- *) (* A type of terms with interpretations embedded in the subterms. *) (* ------------------------------------------------------------------------- *) type modelTerm = Model_var | Model_fn of Term.functionName * modelTerm list * int list;; let modelTerm vM vV = let rec modelTm tm = match destTerm tm with Term.Var v -> (Model_var, getValuation vV v) | Term.Fn (f,tms) -> let (tms,xs) = unzip (List.map modelTm tms) in (Model_fn (f,tms,xs), interpretFunction vM (f,xs)) in modelTm ;; (* ------------------------------------------------------------------------- *) (* Perturbing the model. *) (* ------------------------------------------------------------------------- *) type perturbation = Function_perturbation of (Term.functionName * element list) * element | Relation_perturbation of (Atom.relationName * element list) * bool;; let perturb vM pert = match pert with Function_perturbation ((func,elts),elt) -> updateFunction vM ((func,elts),elt) | Relation_perturbation ((rel,elts),pol) -> updateRelation vM ((rel,elts),pol);; let rec pertTerm vM target tm acc = match target with [] -> acc | _ -> (match tm with Model_var -> acc | Model_fn (func,tms,xs) -> let onTarget ys = mem (interpretFunction vM (func,ys)) target in let func_xs = (func,xs) in let acc = if isFixedFunction vM func_xs then acc else let add (y,acc) = Function_perturbation (func_xs,y) :: acc in Mlist.foldl add acc target in pertTerms vM onTarget tms xs acc) and pertTerms vM onTarget = let vN = msize vM in let filterElements pred = let rec filt i acc = match i with 0 -> acc | _ -> let i = i - 1 in let acc = if pred i then i :: acc else acc in filt i acc in filt vN [] in let rec pert = function (_, [], [], acc) -> acc | (ys, (tm :: tms), (x :: xs), acc) -> let pred y = y <> x && onTarget (Mlist.revAppend (ys, y :: xs)) in let target = filterElements pred in let acc = pertTerm vM target tm acc in pert ((x :: ys), tms, xs, acc) | (_, _, _, _) -> raise (Bug "Model.pertTerms.pert") in fun x y z -> pert ([],x,y,z) ;; let pertAtom vM vV target (rel,tms) acc = let onTarget ys = interpretRelation vM (rel,ys) = target in let (tms,xs) = unzip (List.map (modelTerm vM vV) tms) in let rel_xs = (rel,xs) in let acc = if isFixedRelation vM rel_xs then acc else Relation_perturbation (rel_xs,target) :: acc in pertTerms vM onTarget tms xs acc ;; let pertLiteral vM vV ((pol,atm),acc) = pertAtom vM vV pol atm acc;; let pertClause vM vV cl acc = Literal.Set.foldl (pertLiteral vM vV) acc cl;; let pickPerturb vM perts = if Mlist.null perts then () else perturb vM (Mlist.nth (perts, Portable.randomInt (length perts)));; let perturbTerm vM vV (tm,target) = pickPerturb vM (pertTerm vM target (fst (modelTerm vM vV tm)) []);; let perturbAtom vM vV (atm,target) = pickPerturb vM (pertAtom vM vV target atm []);; let perturbLiteral vM vV lit = pickPerturb vM (pertLiteral vM vV (lit,[]));; let perturbClause vM vV cl = pickPerturb vM (pertClause vM vV cl []);; end (* ========================================================================= *) (* MATCHING AND UNIFICATION FOR SETS OF FIRST ORDER LOGIC TERMS *) (* ========================================================================= *) module Term_net = struct open Useful;; open Order;; (* ------------------------------------------------------------------------- *) (* Anonymous variables. *) (* ------------------------------------------------------------------------- *) let anonymousName = Name.fromString "_";; let anonymousVar = Term.Var anonymousName;; (* ------------------------------------------------------------------------- *) (* Quotient terms. *) (* ------------------------------------------------------------------------- *) type qterm = Var | Fn of Name_arity.nameArity * qterm list;; let rec cmp = function [] -> Equal | (q1_q2 :: qs) -> if Portable.pointerEqual q1_q2 then cmp qs else match q1_q2 with (Var,Var) -> Equal | (Var, Fn _) -> Less | (Fn _, Var) -> Greater | (Fn (f1, f1'), Fn (f2, f2')) -> fnCmp (f1,f1') (f2,f2') qs and fnCmp (n1,q1) (n2,q2) qs = match Name_arity.compare (n1,n2) with Less -> Less | Equal -> cmp (zip q1 q2 @ qs) | Greater -> Greater;; let compareQterm q1_q2 = cmp [q1_q2];; let compareFnQterm (f1,f2) = fnCmp f1 f2 [];; let equalQterm q1 q2 = compareQterm (q1,q2) = Equal;; let equalFnQterm f1 f2 = compareFnQterm (f1,f2) = Equal;; let rec termToQterm = function (Term.Var _) -> Var | (Term.Fn (f,l)) -> Fn ((f, length l), List.map termToQterm l);; let rec qm = function [] -> true | ((Var,_) :: rest) -> qm rest | ((Fn _, Var) :: _) -> false | ((Fn (f,a), Fn (g,b)) :: rest) -> Name_arity.equal f g && qm (zip a b @ rest);; let matchQtermQterm qtm qtm' = qm [(qtm,qtm')];; let rec qm = function [] -> true | ((Var,_) :: rest) -> qm rest | ((Fn _, Term.Var _) :: _) -> false | ((Fn ((f,n),a), Term.Fn (g,b)) :: rest) -> Name.equal f g && n = length b && qm (zip a b @ rest);; let matchQtermTerm qtm tm = qm [(qtm,tm)];; let rec qn qsub = function [] -> Some qsub | ((Term.Var v, qtm) :: rest) -> (match Name.Map.peek qsub v with None -> qn (Name.Map.insert qsub (v,qtm)) rest | Some qtm' -> if equalQterm qtm qtm' then qn qsub rest else None) | ((Term.Fn _, Var) :: _) -> None | ((Term.Fn (f,a), Fn ((g,n),b)) :: rest) -> if Name.equal f g && length a = n then qn qsub (zip a b @ rest) else None;; let matchTermQterm qsub tm qtm = qn qsub [(tm,qtm)];; let rec qv s t = match (s,t) with (Var, x) -> x | (x, Var) -> x | (Fn (f,a), Fn (g,b)) -> let _ = Name_arity.equal f g || raise (Error "Term_net.qv") in Fn (f, zipWith qv a b) ;; let rec qu qsub = function [] -> qsub | ((Var, _) :: rest) -> qu qsub rest | ((qtm, Term.Var v) :: rest) -> let qtm = match Name.Map.peek qsub v with None -> qtm | Some qtm' -> qv qtm qtm' in qu (Name.Map.insert qsub (v,qtm)) rest | ((Fn ((f,n),a), Term.Fn (g,b)) :: rest) -> if Name.equal f g && n = length b then qu qsub (zip a b @ rest) else raise (Error "Term_net.qu");; let unifyQtermQterm qtm qtm' = total (qv qtm) qtm';; let unifyQtermTerm qsub qtm tm = total (qu qsub) [(qtm,tm)];; let rec qtermToTerm = function Var -> anonymousVar | (Fn ((f,_),l)) -> Term.Fn (f, List.map qtermToTerm l);; (* ------------------------------------------------------------------------- *) (* A type of term sets that can be efficiently matched and unified. *) (* ------------------------------------------------------------------------- *) type parameters = {fifo : bool};; type 'a net = Result of 'a list | Single of qterm * 'a net | Multiple of 'a net option * 'a net Name_arity.Map.map;; type 'a termNet = Net of parameters * int * (int * (int * 'a) net) option;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let newNet parm = Net (parm,0,None);; let rec computeSize = function (Result l) -> length l | (Single (_,n)) -> computeSize n | (Multiple (vs,fs)) -> Name_arity.Map.foldl (fun (_,n,acc) -> acc + computeSize n) (match vs with Some n -> computeSize n | None -> 0) fs;; let netSize = function None -> None | (Some n) -> Some (computeSize n, n);; let size = function (Net (_,_,None)) -> 0 | (Net (_, _, Some (i,_))) -> i;; let null net = size net = 0;; let singles qtms a = Mlist.foldr (fun (x, y) -> Single (x, y)) a qtms;; let pre = function None -> (0,None) | (Some (i,n)) -> (i, Some n);; let rec add a b c = match (a, b, c) with (Result l, [], Result l') -> Result (l @ l') | (a, (qtm :: qtms as input1), Single (qtm',n)) -> if equalQterm qtm qtm' then Single (qtm, add a qtms n) else add a input1 (add n [qtm'] (Multiple (None, Name_arity.Map.newMap ()))) | (a, Var :: qtms, Multiple (vs,fs)) -> Multiple (Some (oadd a qtms vs), fs) | (a, Fn (f,l) :: qtms, Multiple (vs,fs)) -> let n = Name_arity.Map.peek fs f in Multiple (vs, Name_arity.Map.insert fs (f, oadd a (l @ qtms) n)) | _ -> raise (Bug "Term_net.insert: Match") and oadd a qtms = function None -> singles qtms a | (Some n) -> add a qtms n;; let ins a qtm (i,n) = Some (i + 1, oadd (Result [a]) [qtm] n);; let insert (Net (p,k,n)) (tm,a) = try Net (p, k + 1, ins (k,a) (termToQterm tm) (pre n)) with Error _ -> raise (Bug "Term_net.insert: should never fail");; let fromList parm l = Mlist.foldl (fun (tm_a,n) -> insert n tm_a) (newNet parm) l;; let filter pred = let rec filt = function (Result l) -> (match List.filter (fun (_,a) -> pred a) l with [] -> None | l -> Some (Result l)) | (Single (qtm,n)) -> (match filt n with None -> None | Some n -> Some (Single (qtm,n))) | (Multiple (vs,fs)) -> let vs = Option.mapPartial filt vs in let fs = Name_arity.Map.mapPartial (fun (_,n) -> filt n) fs in if not (Option.isSome vs) && Name_arity.Map.null fs then None else Some (Multiple (vs,fs)) in try function Net (_,_,None) as net -> net | Net (p, k, Some (_,n)) -> Net (p, k, netSize (filt n)) with Error _ -> raise (Bug "Term_net.filter: should never fail");; let toString net = "Term_net[" ^ Int.toString (size net) ^ "]";; (* ------------------------------------------------------------------------- *) (* Specialized fold operations to support matching and unification. *) (* ------------------------------------------------------------------------- *) let rec norm = function (0 :: ks, ((_,n) as f) :: fs, qtms) -> let (a,qtms) = revDivide qtms n in addQterm (Fn (f,a)) (ks,fs,qtms) | stack -> stack and addQterm qtm (ks,fs,qtms) = let ks = match ks with [] -> [] | k :: ks -> (k - 1) :: ks in norm (ks, fs, qtm :: qtms) and addFn ((_,n) as f) (ks,fs,qtms) = norm (n :: ks, f :: fs, qtms);; let stackEmpty = ([],[],[]);; let stackAddQterm = addQterm;; let stackAddFn = addFn;; let stackValue = function ([],[],[qtm]) -> qtm | _ -> raise (Bug "Term_net.stackValue");; let rec fold inc acc = function [] -> acc | ((0,stack,net) :: rest) -> fold inc (inc (stackValue stack, net, acc)) rest | ((n, stack, Single (qtm,net)) :: rest) -> fold inc acc ((n - 1, stackAddQterm qtm stack, net) :: rest) | ((n, stack, Multiple (v,fns)) :: rest) -> let n = n - 1 in let rest = match v with None -> rest | Some net -> (n, stackAddQterm Var stack, net) :: rest in let getFns ((_,k) as f, net, x) = (k + n, stackAddFn f stack, net) :: x in fold inc acc (Name_arity.Map.foldr getFns rest fns) | _ -> raise (Bug "Term_net.foldTerms.fold");; let foldTerms inc acc net = fold inc acc [(1,stackEmpty,net)];; let foldEqualTerms pat inc acc = let rec fold = function ([],net) -> inc (pat,net,acc) | (pat :: pats, Single (qtm,net)) -> if equalQterm pat qtm then fold (pats,net) else acc | (Var :: pats, Multiple (v,_)) -> (match v with None -> acc | Some net -> fold (pats,net)) | (Fn (f,a) :: pats, Multiple (_,fns)) -> (match Name_arity.Map.peek fns f with None -> acc | Some net -> fold (a @ pats, net)) | _ -> raise (Bug "Term_net.foldEqualTerms.fold") in fun net -> fold ([pat],net) ;; let rec fold inc acc = function [] -> acc | (([],stack,net) :: rest) -> fold inc (inc (stackValue stack, net, acc)) rest | ((Var :: pats, stack, net) :: rest) -> let harvest (qtm,n,l) = (pats, stackAddQterm qtm stack, n) :: l in fold inc acc (foldTerms harvest rest net) | ((pat :: pats, stack, Single (qtm,net)) :: rest) -> (match unifyQtermQterm pat qtm with None -> fold inc acc rest | Some qtm -> fold inc acc ((pats, stackAddQterm qtm stack, net) :: rest)) | (((Fn (f,a) as pat) :: pats, stack, Multiple (v,fns)) :: rest) -> let rest = match v with None -> rest | Some net -> (pats, stackAddQterm pat stack, net) :: rest in let rest = match Name_arity.Map.peek fns f with None -> rest | Some net -> (a @ pats, stackAddFn f stack, net) :: rest in fold inc acc rest | _ -> raise (Bug "Term_net.foldUnifiableTerms.fold");; let foldUnifiableTerms pat inc acc net = fold inc acc [([pat],stackEmpty,net)];; (* ------------------------------------------------------------------------- *) (* Matching and unification queries. *) (* *) (* These function return OVER-APPROXIMATIONS! *) (* Filter afterwards to get the precise set of satisfying values. *) (* ------------------------------------------------------------------------- *) let idwise ((m,_),(n,_)) = Int.compare (m,n);; let fifoize ({fifo=fifo} : parameters) l = if fifo then sort idwise l else l;; let finally parm l = List.map snd (fifoize parm l);; let rec mat acc = function [] -> acc | ((Result l, []) :: rest) -> mat (l @ acc) rest | ((Single (qtm,n), tm :: tms) :: rest) -> mat acc (if matchQtermTerm qtm tm then (n,tms) :: rest else rest) | ((Multiple (vs,fs), tm :: tms) :: rest) -> let rest = match vs with None -> rest | Some n -> (n,tms) :: rest in let rest = match tm with Term.Var _ -> rest | Term.Fn (f,l) -> match Name_arity.Map.peek fs (f, length l) with None -> rest | Some n -> (n, l @ tms) :: rest in mat acc rest | _ -> raise (Bug "Term_net.match: Match");; let matchNet x y = match (x,y) with (Net (_,_,None), _) -> [] | (Net (p, _, Some (_,n)), tm) -> try finally p (mat [] [(n,[tm])]) with Error _ -> raise (Bug "Term_net.match: should never fail");; let unseenInc qsub v tms (qtm,net,rest) = (Name.Map.insert qsub (v,qtm), net, tms) :: rest;; let seenInc qsub tms (_,net,rest) = (qsub,net,tms) :: rest;; let rec mat acc = function [] -> acc | ((_, Result l, []) :: rest) -> mat (l @ acc) rest | ((qsub, Single (qtm,net), tm :: tms) :: rest) -> (match matchTermQterm qsub tm qtm with None -> mat acc rest | Some qsub -> mat acc ((qsub,net,tms) :: rest)) | ((qsub, (Multiple _ as net), Term.Var v :: tms) :: rest) -> (match Name.Map.peek qsub v with None -> mat acc (foldTerms (unseenInc qsub v tms) rest net) | Some qtm -> mat acc (foldEqualTerms qtm (seenInc qsub tms) rest net)) | ((qsub, Multiple (_,fns), Term.Fn (f,a) :: tms) :: rest) -> let rest = match Name_arity.Map.peek fns (f, length a) with None -> rest | Some net -> (qsub, net, a @ tms) :: rest in mat acc rest | _ -> raise (Bug "Term_net.matched.mat");; let matched x tm = match x with (Net (_,_,None)) -> [] | (Net (parm, _, Some (_,net))) -> try finally parm (mat [] [(Name.Map.newMap (), net, [tm])]) with Error _ -> raise (Bug "Term_net.matched: should never fail");; let inc qsub v tms (qtm,net,rest) = (Name.Map.insert qsub (v,qtm), net, tms) :: rest;; let rec mat acc = function [] -> acc | ((_, Result l, []) :: rest) -> mat (l @ acc) rest | ((qsub, Single (qtm,net), tm :: tms) :: rest) -> (match unifyQtermTerm qsub qtm tm with None -> mat acc rest | Some qsub -> mat acc ((qsub,net,tms) :: rest)) | ((qsub, (Multiple _ as net), Term.Var v :: tms) :: rest) -> (match Name.Map.peek qsub v with None -> mat acc (foldTerms (inc qsub v tms) rest net) | Some qtm -> mat acc (foldUnifiableTerms qtm (inc qsub v tms) rest net)) | ((qsub, Multiple (v,fns), Term.Fn (f,a) :: tms) :: rest) -> let rest = match v with None -> rest | Some net -> (qsub,net,tms) :: rest in let rest = match Name_arity.Map.peek fns (f, length a) with None -> rest | Some net -> (qsub, net, a @ tms) :: rest in mat acc rest | _ -> raise (Bug "Term_net.unify.mat");; let unify x tm = match x with (Net (_,_,None)) -> [] | (Net (parm, _, Some (_,net))) -> try finally parm (mat [] [(Name.Map.newMap (), net, [tm])]) with Error _ -> raise (Bug "Term_net.unify: should never fail");; end (* ========================================================================= *) (* MATCHING AND UNIFICATION FOR SETS OF FIRST ORDER LOGIC ATOMS *) (* ========================================================================= *) module Atom_net = struct open Useful;; (* ------------------------------------------------------------------------- *) (* Helper functions. *) (* ------------------------------------------------------------------------- *) let atomToTerm atom = Term.Fn atom;; let termToAtom = function (Term.Var _) -> raise (Bug "Atom_net.termToAtom") | (Term.Fn atom) -> atom;; (* ------------------------------------------------------------------------- *) (* A type of atom sets that can be efficiently matched and unified. *) (* ------------------------------------------------------------------------- *) type parameters = Term_net.parameters;; type 'a atomNet = 'a Term_net.termNet;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let newNet = Term_net.newNet;; let size = Term_net.size;; let insert net (atm,a) = Term_net.insert net (atomToTerm atm, a);; let fromList parm l = Mlist.foldl (fun (atm_a,n) -> insert n atm_a) (newNet parm) l;; let filter = Term_net.filter;; let toString net = "Atom_net[" ^ Int.toString (size net) ^ "]";; (* ------------------------------------------------------------------------- *) (* Matching and unification queries. *) (* *) (* These function return OVER-APPROXIMATIONS! *) (* Filter afterwards to get the precise set of satisfying values. *) (* ------------------------------------------------------------------------- *) let matchNet net atm = Term_net.matchNet net (atomToTerm atm);; let matched net atm = Term_net.matched net (atomToTerm atm);; let unify net atm = Term_net.unify net (atomToTerm atm);; end (* ========================================================================= *) (* MATCHING AND UNIFICATION FOR SETS OF FIRST ORDER LOGIC LITERALS *) (* ========================================================================= *) module Literal_net = struct open Useful;; (* ------------------------------------------------------------------------- *) (* A type of literal sets that can be efficiently matched and unified. *) (* ------------------------------------------------------------------------- *) type parameters = Atom_net.parameters;; type 'a literalNet = {positive : 'a Atom_net.atomNet; negative : 'a Atom_net.atomNet};; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let newNet parm = {positive = Atom_net.newNet parm; negative = Atom_net.newNet parm};; let pos ({positive=positive} : 'a literalNet) = Atom_net.size positive;; let neg ({negative=negative} : 'a literalNet) = Atom_net.size negative;; let size net = pos net + neg net;; (*let profile net = {positiveN = pos net; negativeN = neg net};;*) let insert {positive=positive;negative=negative} = function ((true,atm),a) -> {positive = Atom_net.insert positive (atm,a); negative = negative} | ((false,atm),a) -> {positive = positive; negative = Atom_net.insert negative (atm,a)};; let fromList parm l = Mlist.foldl (fun (lit_a,n) -> insert n lit_a) (newNet parm) l;; let filter pred {positive=positive;negative=negative} = {positive = Atom_net.filter pred positive; negative = Atom_net.filter pred negative};; let toString net = "Literal_net[" ^ Int.toString (size net) ^ "]";; (* ------------------------------------------------------------------------- *) (* Matching and unification queries. *) (* *) (* These function return OVER-APPROXIMATIONS! *) (* Filter afterwards to get the precise set of satisfying values. *) (* ------------------------------------------------------------------------- *) let matchNet ({positive=positive;negative=negative} : 'a literalNet) = function (true,atm) -> Atom_net.matchNet positive atm | (false,atm) -> Atom_net.matchNet negative atm;; let matched ({positive=positive;negative=negative} : 'a literalNet) = function (true,atm) -> Atom_net.matched positive atm | (false,atm) -> Atom_net.matched negative atm;; let unify ({positive=positive;negative=negative} : 'a literalNet) = function (true,atm) -> Atom_net.unify positive atm | (false,atm) -> Atom_net.unify negative atm;; end (* ========================================================================= *) (* SUBSUMPTION CHECKING FOR FIRST ORDER LOGIC CLAUSES *) (* ========================================================================= *) module Subsume = struct open Useful;; open Order;; (* ------------------------------------------------------------------------- *) (* Helper functions. *) (* ------------------------------------------------------------------------- *) let findRest pred = let rec f ys = function [] -> None | (x :: xs) -> if pred x then Some (x, Mlist.revAppend (ys,xs)) else f (x :: ys) xs in f [] ;; let addSym (lit,acc) = match total Literal.sym lit with None -> acc | Some lit -> lit :: acc let clauseSym lits = Mlist.foldl addSym lits lits;; let sortClause cl = let lits = Literal.Set.toList cl in sortMap Literal.typedSymbols (revCompare Int.compare) lits ;; let incompatible lit = let lits = clauseSym [lit] in fun lit' -> not (List.exists (can (Literal.unify Substitute.empty lit')) lits) ;; (* ------------------------------------------------------------------------- *) (* Clause ids and lengths. *) (* ------------------------------------------------------------------------- *) type clauseId = int;; type clauseLength = int;; type idSet = (clauseId * clauseLength) Pset.set;; let idCompare ((id1,len1),(id2,len2)) = match Int.compare (len1,len2) with Less -> Less | Equal -> Int.compare (id1,id2) | Greater -> Greater;; let idSetEmpty : idSet = Pset.empty idCompare;; let idSetAdd (id_len,set) : idSet = Pset.add set id_len;; let idSetAddMax max ((_,len) as id_len, set) : idSet = if len <= max then Pset.add set id_len else set;; let idSetIntersect set1 set2 : idSet = Pset.intersect set1 set2;; (* ------------------------------------------------------------------------- *) (* A type of clause sets that supports efficient subsumption checking. *) (* ------------------------------------------------------------------------- *) type 'a nonunit_t = {nextId : clauseId; clauses : (Literal.literal list * Thm.clause * 'a) Intmap.map; fstLits : (clauseId * clauseLength) Literal_net.literalNet; sndLits : (clauseId * clauseLength) Literal_net.literalNet};; type 'a subsume = {empty : (Thm.clause * Substitute.subst * 'a) list; unitn : (Literal.literal * Thm.clause * 'a) Literal_net.literalNet; nonunit : 'a nonunit_t};; open Term_net let newSubsume () = {empty = []; unitn = Literal_net.newNet {fifo = false}; nonunit = {nextId = 0; clauses = Intmap.newMap (); fstLits = Literal_net.newNet {fifo = false}; sndLits = Literal_net.newNet {fifo = false}}};; let size ({empty=empty; unitn=unitn; nonunit = {clauses=clauses}}) = length empty + Literal_net.size unitn + Intmap.size clauses;; let insert ({empty=empty;unitn=unitn;nonunit=nonunit}) (cl',a) = match sortClause cl' with [] -> let empty = (cl',Substitute.empty,a) :: empty in {empty = empty; unitn = unitn; nonunit = nonunit} | [lit] -> let unitn = Literal_net.insert unitn (lit,(lit,cl',a)) in {empty = empty; unitn = unitn; nonunit = nonunit} | fstLit :: (sndLit :: otherLits as nonFstLits) -> let {nextId=nextId;clauses=clauses;fstLits=fstLits;sndLits=sndLits} = nonunit in let id_length = (nextId, Literal.Set.size cl') in let fstLits = Literal_net.insert fstLits (fstLit,id_length) in let (sndLit,otherLits) = match findRest (incompatible fstLit) nonFstLits with Some sndLit_otherLits -> sndLit_otherLits | None -> (sndLit,otherLits) in let sndLits = Literal_net.insert sndLits (sndLit,id_length) in let lits' = otherLits @ [fstLit;sndLit] in let clauses = Intmap.insert clauses (nextId,(lits',cl',a)) in let nextId = nextId + 1 in let nonunit = {nextId = nextId; clauses = clauses; fstLits = fstLits; sndLits = sndLits} in {empty = empty; unitn = unitn; nonunit = nonunit} ;; let filter pred ({empty=empty;unitn=unitn;nonunit=nonunit}) = let pred3 (_,_,x) = pred x in let empty = List.filter pred3 empty in let unitn = Literal_net.filter pred3 unitn in let nonunit = let {nextId=nextId;clauses=clauses;fstLits=fstLits;sndLits=sndLits} = nonunit in let clauses' = Intmap.filter (fun x -> pred3 (snd x)) clauses in if Intmap.size clauses = Intmap.size clauses' then nonunit else let predId (id,_) = Intmap.inDomain id clauses' in let fstLits = Literal_net.filter predId fstLits and sndLits = Literal_net.filter predId sndLits in {nextId = nextId; clauses = clauses'; fstLits = fstLits; sndLits = sndLits} in {empty = empty; unitn = unitn; nonunit = nonunit} ;; let toString subsume = "Subsume{" ^ Int.toString (size subsume) ^ "}";; (* ------------------------------------------------------------------------- *) (* Subsumption checking. *) (* ------------------------------------------------------------------------- *) let matchLit lit' (lit,acc) = match total (Literal.matchLiterals Substitute.empty lit') lit with Some sub -> sub :: acc | None -> acc;; let genClauseSubsumes pred cl' lits' cl a = let rec mkSubsl acc sub = function [] -> Some (sub, sortMap length Int.compare acc) | (lit' :: lits') -> match Mlist.foldl (matchLit lit') [] cl with [] -> None | [sub'] -> (match total (Substitute.union sub) sub' with None -> None | Some sub -> mkSubsl acc sub lits') | subs -> mkSubsl (subs :: acc) sub lits' in let rec search = function [] -> None | ((sub,[]) :: others) -> let x = (cl',sub,a) in if pred x then Some x else search others | ((_, [] :: _) :: others) -> search others | ((sub, (sub' :: subs) :: subsl) :: others) -> let others = (sub, subs :: subsl) :: others in match total (Substitute.union sub) sub' with None -> search others | Some sub -> search ((sub,subsl) :: others) in match mkSubsl [] Substitute.empty lits' with None -> None | Some sub_subsl -> search [sub_subsl] ;; let emptySubsumes pred empty = Mlist.find pred empty;; let unitSubsumes pred unitn = let subLit lit = let subUnit (lit',cl',a) = match total (Literal.matchLiterals Substitute.empty lit') lit with None -> None | Some sub -> let x = (cl',sub,a) in if pred x then Some x else None in first subUnit (Literal_net.matchNet unitn lit) in first subLit ;; let nonunitSubsumes pred nonunit max cl = let addId = match max with None -> idSetAdd | Some n -> idSetAddMax n in let subLit lits (lit,acc) = Mlist.foldl addId acc (Literal_net.matchNet lits lit) in let {nextId = _; clauses=clauses; fstLits=fstLits; sndLits=sndLits} = nonunit in let subCl' (id,_) = let (lits',cl',a) = Intmap.get clauses id in genClauseSubsumes pred cl' lits' cl a in let fstCands = Mlist.foldl (subLit fstLits) idSetEmpty cl in let sndCands = Mlist.foldl (subLit sndLits) idSetEmpty cl in let cands = idSetIntersect fstCands sndCands in Pset.firstl subCl' cands ;; let genSubsumes pred ({empty=empty;unitn=unitn;nonunit=nonunit}) max cl = match emptySubsumes pred empty with (Some _) as s -> s | None -> if max = Some 0 then None else let cl = clauseSym (Literal.Set.toList cl) in match unitSubsumes pred unitn cl with Some _ as s -> s | None -> if max = Some 1 then None else nonunitSubsumes pred nonunit max cl ;; let subsumes pred subsume cl = genSubsumes pred subsume None cl;; let strictlySubsumes pred subsume cl = genSubsumes pred subsume (Some (Literal.Set.size cl)) cl;; (*MetisTrace4 let subsumes = fun pred -> fun subsume -> fun cl -> let let ppCl = Literal.Set.pp let ppSub = Substitute.pp let () = Print.trace ppCl "Subsume.subsumes: cl" cl let result = subsumes pred subsume cl let () = match result with None -> trace "Subsume.subsumes: not subsumed\n" | Some (cl,sub,_) -> (Print.trace ppCl "Subsume.subsumes: subsuming cl" cl;; Print.trace ppSub "Subsume.subsumes: subsuming sub" sub) in result end;; let strictlySubsumes = fun pred -> fun subsume -> fun cl -> let let ppCl = Literal.Set.pp let ppSub = Substitute.pp let () = Print.trace ppCl "Subsume.strictlySubsumes: cl" cl let result = strictlySubsumes pred subsume cl let () = match result with None -> trace "Subsume.subsumes: not subsumed\n" | Some (cl,sub,_) -> (Print.trace ppCl "Subsume.subsumes: subsuming cl" cl;; Print.trace ppSub "Subsume.subsumes: subsuming sub" sub) in result end;; *) let isSubsumed subs cl = Option.isSome (subsumes (kComb true) subs cl);; let isStrictlySubsumed subs cl = Option.isSome (strictlySubsumes (kComb true) subs cl);; (* ------------------------------------------------------------------------- *) (* Single clause versions. *) (* ------------------------------------------------------------------------- *) let clauseSubsumes cl' cl = let lits' = sortClause cl' and lits = clauseSym (Literal.Set.toList cl) in match genClauseSubsumes (kComb true) cl' lits' lits () with Some (_,sub,()) -> Some sub | None -> None ;; let clauseStrictlySubsumes cl' cl = if Literal.Set.size cl' > Literal.Set.size cl then None else clauseSubsumes cl' cl;; end (* ========================================================================= *) (* KNUTH-BENDIX TERM ORDERING CONSTRAINTS *) (* ========================================================================= *) module Knuth_bendix_order = struct open Useful;; open Order;; (* ------------------------------------------------------------------------- *) (* Helper functions. *) (* ------------------------------------------------------------------------- *) let notEqualTerm (x,y) = not (Term.equal x y);; let firstNotEqualTerm f l = match Mlist.find notEqualTerm l with Some (x,y) -> f x y | None -> raise (Bug "firstNotEqualTerm");; (* ------------------------------------------------------------------------- *) (* The weight of all constants must be at least 1, and there must be at most *) (* one unary function with weight 0. *) (* ------------------------------------------------------------------------- *) type kbo = {weight : Term.function_t -> int; precedence : Term.function_t * Term.function_t -> order};; (* Default weight = uniform *) let uniformWeight : Term.function_t -> int = kComb 1;; (* Default precedence = by arity *) let arityPrecedence : Term.function_t * Term.function_t -> order = fun ((f1,n1),(f2,n2)) -> match Int.compare (n1,n2) with Less -> Less | Equal -> Name.compare (f1,f2) | Greater -> Greater;; (* The default order *) let default = {weight = uniformWeight; precedence = arityPrecedence};; (* ------------------------------------------------------------------------- *) (* Term weight-1 represented as a linear function of the weight-1 of the *) (* variables in the term (plus a constant). *) (* *) (* Note that the conditions on weight functions ensure that all weights are *) (* at least 1, so all weight-1s are at least 0. *) (* ------------------------------------------------------------------------- *) type weight = Weight of int Name.Map.map * int;; let weightEmpty : int Name.Map.map = Name.Map.newMap ();; let weightZero = Weight (weightEmpty,0);; let weightIsZero (Weight (m,c)) = c = 0 && Name.Map.null m;; let weightNeg (Weight (m,c)) = Weight (Name.Map.transform (fun x -> -x) m, -c);; let add ((_,n1),(_,n2)) = let n = n1 + n2 in if n = 0 then None else Some n ;; let weightAdd (Weight (m1,c1)) (Weight (m2,c2)) = Weight (Name.Map.union add m1 m2, c1 + c2);; let weightSubtract w1 w2 = weightAdd w1 (weightNeg w2);; let weightTerm weight = let rec wt m c = function [] -> Weight (m,c) | (Term.Var v :: tms) -> let n = Option.getOpt (Name.Map.peek m v, 0) in wt (Name.Map.insert m (v, n + 1)) (c + 1) tms | (Term.Fn (f,a) :: tms) -> wt m (c + weight (f, length a)) (a @ tms) in fun tm -> wt weightEmpty (-1) [tm] ;; let weightLowerBound (Weight (m,c)) = if Name.Map.exists (fun (_,n) -> n < 0) m then None else Some c;; (*MetisDebug let ppWeightList = let let ppCoeff n = if n < 0 then Print.sequence (Print.ppString "~") (ppCoeff (~n)) else if n = 1 then Print.skip else Print.ppInt n let pp_tm (None,n) = Print.ppInt n | pp_tm (Some v, n) = Print.sequence (ppCoeff n) (Name.pp v) in fun [] -> Print.ppInt 0 | tms -> Print.ppOpList " +" pp_tm tms end;; let ppWeight (Weight (m,c)) = let let l = Name.Map.toList m let l = List.map (fun (v,n) -> (Some v, n)) l let l = if c = 0 then l else l @ [(None,c)] in ppWeightList l end;; let weightToString = Print.toString ppWeight;; *) (* ------------------------------------------------------------------------- *) (* The Knuth-Bendix term order. *) (* ------------------------------------------------------------------------- *) let compare {weight=weight;precedence=precedence} = let weightDifference tm1 tm2 = let w1 = weightTerm weight tm1 and w2 = weightTerm weight tm2 in weightSubtract w2 w1 in let rec weightLess tm1 tm2 = let w = weightDifference tm1 tm2 in if weightIsZero w then precedenceLess tm1 tm2 else weightDiffLess w tm1 tm2 and weightDiffLess w tm1 tm2 = match weightLowerBound w with None -> false | Some 0 -> precedenceLess tm1 tm2 | Some n -> n > 0 and precedenceLess x y = match (x,y) with (Term.Fn (f1,a1), Term.Fn (f2,a2)) -> (match precedence ((f1, length a1), (f2, length a2)) with Less -> true | Equal -> firstNotEqualTerm weightLess (zip a1 a2) | Greater -> false) | _ -> false in let weightDiffGreater w tm1 tm2 = weightDiffLess (weightNeg w) tm2 tm1 in let rec weightCmp tm1 tm2 = let w = weightDifference tm1 tm2 in if weightIsZero w then precedenceCmp tm1 tm2 else if weightDiffLess w tm1 tm2 then Some Less else if weightDiffGreater w tm1 tm2 then Some Greater else None and precedenceCmp x y = match (x,y) with (Term.Fn (f1,a1), Term.Fn (f2,a2)) -> (match precedence ((f1, length a1), (f2, length a2)) with Less -> Some Less | Equal -> firstNotEqualTerm weightCmp (zip a1 a2) | Greater -> Some Greater) | _ -> raise (Bug "kboOrder.precendenceCmp") in fun (tm1,tm2) -> if Term.equal tm1 tm2 then Some Equal else weightCmp tm1 tm2 ;; (*MetisTrace7 let compare = fun kbo -> fun (tm1,tm2) -> let let () = Print.trace Term.pp "Knuth_bendix_order.compare: tm1" tm1 let () = Print.trace Term.pp "Knuth_bendix_order.compare: tm2" tm2 let result = compare kbo (tm1,tm2) let () = match result with None -> trace "Knuth_bendix_order.compare: result = Incomparable\n" | Some x -> Print.trace Print.ppOrder "Knuth_bendix_order.compare: result" x in result end;; *) end (* ========================================================================= *) (* ORDERED REWRITING FOR FIRST ORDER TERMS *) (* ========================================================================= *) module Rewrite = struct open Useful;; open Order;; (* ------------------------------------------------------------------------- *) (* Orientations of equations. *) (* ------------------------------------------------------------------------- *) type orient = Left_to_right | Right_to_left;; let toStringOrient ort = match ort with Left_to_right -> "-->" | Right_to_left -> "<--";; let toStringOrientOption orto = match orto with Some ort -> toStringOrient ort | None -> "<->";; (* ------------------------------------------------------------------------- *) (* A type of rewrite systems. *) (* ------------------------------------------------------------------------- *) type reductionOrder = Term.term * Term.term -> order option;; type equationId = int;; type equation = Rule.equation;; type rewrite_t = {order : reductionOrder; known : (equation * orient option) Intmap.map; redexes : (equationId * orient) Term_net.termNet; subterms : (equationId * bool * Term.path) Term_net.termNet; waiting : Intset.set};; type rewrite = Rewrite of rewrite_t;; let updateWaiting rw waiting = let Rewrite {order=order; known=known; redexes=redexes; subterms=subterms; waiting = _} = rw in Rewrite {order = order; known = known; redexes = redexes; subterms = subterms; waiting = waiting} ;; let deleteWaiting (Rewrite {waiting=waiting} as rw) id = updateWaiting rw (Intset.delete waiting id);; (* ------------------------------------------------------------------------- *) (* Basic operations *) (* ------------------------------------------------------------------------- *) open Term_net let newRewrite order = Rewrite {order = order; known = Intmap.newMap (); redexes = Term_net.newNet {fifo = false}; subterms = Term_net.newNet {fifo = false}; waiting = Intset.empty};; let peek (Rewrite {known=known}) id = Intmap.peek known id;; let size (Rewrite {known=known}) = Intmap.size known;; let equations (Rewrite {known=known}) = Intmap.foldr (fun (_,(eqn,_),eqns) -> eqn :: eqns) [] known;; (*MetisTrace1 local let ppEq ((x_y,_),ort) = Print.ppOp2 (" " ^ toStringOrientOption ort) Term.pp Term.pp x_y;; let ppField f ppA a = Print.inconsistentBlock 2 [Print.ppString (f ^ " ="), Print.break, ppA a];; let ppKnown = ppField "known" (Print.ppMap Intmap.toList (Print.ppList (Print.ppPair Print.ppInt ppEq)));; let ppRedexes = ppField "redexes" (Term_net.pp (Print.ppPair Print.ppInt ppOrient));; let ppSubterms = ppField "subterms" (Term_net.pp (Print.ppMap (fun (i,l,p) -> (i, (if l then 0 else 1) :: p)) (Print.ppPair Print.ppInt Term.ppPath)));; let ppWaiting = ppField "waiting" (Print.ppMap (Intset.toList) (Print.ppList Print.ppInt));; in let pp (Rewrite {known,redexes,subterms,waiting,...}) = Print.inconsistentBlock 2 [Print.ppString "Rewrite", Print.break, Print.inconsistentBlock 1 [Print.ppString "{", ppKnown known, (*MetisTrace5 Print.ppString ",", Print.break, ppRedexes redexes, Print.ppString ",", Print.break, ppSubterms subterms, Print.ppString ",", Print.break, ppWaiting waiting, *) Print.skip], Print.ppString "}"] end;; *) (* ------------------------------------------------------------------------- *) (* Debug functions. *) (* ------------------------------------------------------------------------- *) let termReducible order known id = let eqnRed ((l,r),_) tm = match total (Substitute.matchTerms Substitute.empty l) tm with None -> false | Some sub -> order (tm, Substitute.subst (Substitute.normalize sub) r) = Some Greater in let knownRed tm (eqnId,(eqn,ort)) = eqnId <> id && ((ort <> Some Right_to_left && eqnRed eqn tm) || (ort <> Some Left_to_right && eqnRed (Rule.symEqn eqn) tm)) in let rec termRed tm = Intmap.exists (knownRed tm) known || subtermRed tm and subtermRed = function (Term.Var _) -> false | (Term.Fn (_,tms)) -> List.exists termRed tms in termRed ;; let literalReducible order known id lit = List.exists (termReducible order known id) (Literal.arguments lit);; let literalsReducible order known id lits = Literal.Set.exists (literalReducible order known id) lits;; let thmReducible order known id th = literalsReducible order known id (Thm.clause th);; (* ------------------------------------------------------------------------- *) (* Add equations into the system. *) (* ------------------------------------------------------------------------- *) let orderToOrient = function (Some Equal) -> raise (Error "Rewrite.orient: reflexive") | (Some Greater) -> Some Left_to_right | (Some Less) -> Some Right_to_left | None -> None;; let ins redexes redex id ort = Term_net.insert redexes (redex,(id,ort));; let addRedexes id (((l,r),_),ort) redexes = match ort with Some Left_to_right -> ins redexes l id Left_to_right | Some Right_to_left -> ins redexes r id Right_to_left | None -> ins (ins redexes l id Left_to_right) r id Right_to_left;; let add (Rewrite {known=known} as rw) (id,eqn) = if Intmap.inDomain id known then rw else let Rewrite {order=order;redexes=redexes;subterms=subterms;waiting=waiting} = rw in let ort = orderToOrient (order (fst eqn)) in let known = Intmap.insert known (id,(eqn,ort)) in let redexes = addRedexes id (eqn,ort) redexes in let waiting = Intset.add waiting id in let rw = Rewrite {order = order; known = known; redexes = redexes; subterms = subterms; waiting = waiting} (*MetisTrace5 let () = Print.trace pp "Rewrite.add: result" rw *) in rw ;; let uncurriedAdd (eqn,rw) = add rw eqn;; let addList rw = Mlist.foldl uncurriedAdd rw;; (* ------------------------------------------------------------------------- *) (* Rewriting (the order must be a refinement of the rewrite order). *) (* ------------------------------------------------------------------------- *) let reorder ((i,_),(j,_)) = Int.compare (j,i);; let matchingRedexes redexes tm = sort reorder (Term_net.matchNet redexes tm);; let wellOriented x y = match (x,y) with (None, _) -> true | (Some Left_to_right, Left_to_right) -> true | (Some Right_to_left ,Right_to_left) -> true | _ -> false;; let redexResidue x y = match (x,y) with (Left_to_right, ((l_r,_) : equation)) -> l_r | (Right_to_left, ((l,r),_)) -> (r,l);; let orientedEquation dir eqn = match dir with Left_to_right -> eqn | Right_to_left -> Rule.symEqn eqn;; let rewrIdConv' order known redexes id tm = let rewr (id',lr) = let _ = id <> id' || raise (Error "same theorem") in let (eqn,ort) = Intmap.get known id' in let _ = wellOriented ort lr || raise (Error "orientation") in let (l,r) = redexResidue lr eqn in let sub = Substitute.normalize (Substitute.matchTerms Substitute.empty l tm) in let tm' = Substitute.subst sub r in let _ = Option.isSome ort || order (tm,tm') = Some Greater || raise (Error "order") in let (_,th) = orientedEquation lr eqn in (tm', Thm.subst sub th) in match first (total rewr) (matchingRedexes redexes tm) with None -> raise (Error "Rewrite.rewrIdConv: no matching rewrites") | Some res -> res ;; let rewriteIdConv' order known redexes id = if Intmap.null known then Rule.allConv else Rule.repeatTopDownConv (rewrIdConv' order known redexes id);; let mkNeqConv order lit = let (l,r) = Literal.destNeq lit in match order (l,r) with None -> raise (Error "incomparable") | Some Less -> let th = Rule.symmetryRule l r in fun tm -> if Term.equal tm r then (l,th) else raise (Error "mkNeqConv: RL") | Some Equal -> raise (Error "irreflexive") | Some Greater -> let th = Thm.assume lit in fun tm -> if Term.equal tm l then (r,th) else raise (Error "mkNeqConv: LR") ;; type neqConvs = Neq_convs of Rule.conv Literal.Map.map;; let neqConvsEmpty = Neq_convs (Literal.Map.newMap ());; let neqConvsNull (Neq_convs m) = Literal.Map.null m;; let neqConvsAdd order (Neq_convs m) lit = match total (mkNeqConv order) lit with None -> None | Some conv -> Some (Neq_convs (Literal.Map.insert m (lit,conv)));; let mkNeqConvs order = let add (lit,(neq,lits)) = match neqConvsAdd order neq lit with Some neq -> (neq,lits) | None -> (neq, Literal.Set.add lits lit) in Literal.Set.foldl add (neqConvsEmpty,Literal.Set.empty) ;; let neqConvsDelete (Neq_convs m) lit = Neq_convs (Literal.Map.delete m lit);; let neqConvsToConv (Neq_convs m) = Rule.firstConv (Literal.Map.foldr (fun (_,c,l) -> c :: l) [] m);; let neqConvsFoldl f b (Neq_convs m) = Literal.Map.foldl (fun (l,_,z) -> f (l,z)) b m;; let neqConvsRewrIdLiterule order known redexes id neq = if Intmap.null known && neqConvsNull neq then Rule.allLiterule else let neq_conv = neqConvsToConv neq in let rewr_conv = rewrIdConv' order known redexes id in let conv = Rule.orelseConv neq_conv rewr_conv in let conv = Rule.repeatTopDownConv conv in Rule.allArgumentsLiterule conv ;; let rewriteIdEqn' order known redexes id ((l_r,th) as eqn) = let (neq,_) = mkNeqConvs order (Thm.clause th) in let literule = neqConvsRewrIdLiterule order known redexes id neq in let (strongEqn,lit) = match Rule.equationLiteral eqn with None -> (true, Literal.mkEq l_r) | Some lit -> (false,lit) in let (lit',litTh) = literule lit in if Literal.equal lit lit' then eqn else (Literal.destEq lit', if strongEqn then th else if not (Thm.negateMember lit litTh) then litTh else Thm.resolve lit th litTh);; (*MetisDebug handle Error err -> raise (Error ("Rewrite.rewriteIdEqn':\n" ^ err));; *) let rewriteIdLiteralsRule' order known redexes id lits th = let mk_literule = neqConvsRewrIdLiterule order known redexes id in let rewr_neq_lit (lit, ((changed,neq,lits,th) as acc)) = let neq = neqConvsDelete neq lit in let (lit',litTh) = mk_literule neq lit in if Literal.equal lit lit' then acc else let th = Thm.resolve lit th litTh in match neqConvsAdd order neq lit' with Some neq -> (true,neq,lits,th) | None -> (changed, neq, Literal.Set.add lits lit', th) in let rec rewr_neq_lits neq lits th = let (changed,neq,lits,th) = neqConvsFoldl rewr_neq_lit (false,neq,lits,th) neq in if changed then rewr_neq_lits neq lits th else (neq,lits,th) in let (neq,lits) = mkNeqConvs order lits in let (neq,lits,th) = rewr_neq_lits neq lits th in let rewr_literule = mk_literule neq in let rewr_lit (lit,th) = if Thm.member lit th then Rule.literalRule rewr_literule lit th else th in Literal.Set.foldl rewr_lit th lits ;; let rewriteIdRule' order known redexes id th = rewriteIdLiteralsRule' order known redexes id (Thm.clause th) th;; (*MetisDebug let rewriteIdRule' = fun order -> fun known -> fun redexes -> fun id -> fun th -> let (*MetisTrace6 let () = Print.trace Thm.pp "Rewrite.rewriteIdRule': th" th *) let result = rewriteIdRule' order known redexes id th (*MetisTrace6 let () = Print.trace Thm.pp "Rewrite.rewriteIdRule': result" result *) let _ = not (thmReducible order known id result) || raise Bug "rewriteIdRule: should be normalized" in result end handle Error err -> raise (Error ("Rewrite.rewriteIdRule:\n" ^ err));; *) let rewrIdConv (Rewrite {known=known;redexes=redexes}) order = rewrIdConv' order known redexes;; let rewrConv rewrite order = rewrIdConv rewrite order (-1);; let rewriteIdConv (Rewrite {known=known;redexes=redexes}) order = rewriteIdConv' order known redexes;; let rewriteConv rewrite order = rewriteIdConv rewrite order (-1);; let rewriteIdLiteralsRule (Rewrite {known=known;redexes=redexes}) order = rewriteIdLiteralsRule' order known redexes;; let rewriteLiteralsRule rewrite order = rewriteIdLiteralsRule rewrite order (-1);; let rewriteIdRule (Rewrite {known=known;redexes=redexes}) order = rewriteIdRule' order known redexes;; let rewriteRule rewrite order = rewriteIdRule rewrite order (-1);; (* ------------------------------------------------------------------------- *) (* Inter-reduce the equations in the system. *) (* ------------------------------------------------------------------------- *) let addSubterms id (((l,r),_) : equation) subterms = let addSubterm b ((path,tm),net) = Term_net.insert net (tm,(id,b,path)) in let subterms = Mlist.foldl (addSubterm true) subterms (Term.subterms l) in let subterms = Mlist.foldl (addSubterm false) subterms (Term.subterms r) in subterms ;; let sameRedexes x y z = match (x,y,z) with (None,_,_) -> false | (Some Left_to_right, (l0,_),(l,_)) -> Term.equal l0 l | (Some Right_to_left, (_,r0),(_,r)) -> Term.equal r0 r;; let redexResidues x (l,r) = match x with None -> [(l,r,false);(r,l,false)] | (Some Left_to_right) -> [(l,r,true)] | (Some Right_to_left) -> [(r,l,true)];; let findReducibles order known subterms id = let checkValidRewr (l,r,ord) id' left path = let (((x,y),_),_) = Intmap.get known id' in let tm = Term.subterm (if left then x else y) path in let sub = Substitute.matchTerms Substitute.empty l tm in if ord then () else let tm' = Substitute.subst (Substitute.normalize sub) r in if order (tm,tm') = Some Greater then () else raise (Error "order") in let addRed lr ((id',left,path),todo) = if id <> id' && not (Intset.member id' todo) && can (checkValidRewr lr id' left) path then Intset.add todo id' else todo in let findRed ((l,_,_) as lr, todo) = Mlist.foldl (addRed lr) todo (Term_net.matched subterms l) in Mlist.foldl findRed ;; let reduce1 newx id (eqn0,ort0) (rpl,spl,todo,rw,changed) = let (eq0,_) = eqn0 in let Rewrite {order=order;known=known;redexes=redexes;subterms=subterms;waiting=waiting} = rw in let (eq,_) as eqn = rewriteIdEqn' order known redexes id eqn0 in let identical = let (l0,r0) = eq0 and (l,r) = eq in Term.equal l l0 && Term.equal r r0 in let same_redexes = identical || sameRedexes ort0 eq0 eq in let rpl = if same_redexes then rpl else Intset.add rpl id in let spl = if newx || identical then spl else Intset.add spl id in let changed = if not newx && identical then changed else Intset.add changed id in let ort = if same_redexes then Some ort0 else total orderToOrient (order eq) in match ort with None -> let known = Intmap.delete known id in let rw = Rewrite {order = order; known = known; redexes = redexes; subterms = subterms; waiting = waiting} in (rpl,spl,todo,rw,changed) | Some ort -> let todo = if not newx && same_redexes then todo else findReducibles order known subterms id todo (redexResidues ort eq) in let known = if identical then known else Intmap.insert known (id,(eqn,ort)) in let redexes = if same_redexes then redexes else addRedexes id (eqn,ort) redexes in let subterms = if newx || not identical then addSubterms id eqn subterms else subterms in let rw = Rewrite {order = order; known = known; redexes = redexes; subterms = subterms; waiting = waiting} in (rpl,spl,todo,rw,changed) ;; let pick known set = let oriented id = match Intmap.peek known id with Some ((_, Some _) as x) -> Some (id,x) | _ -> None in let any id = match Intmap.peek known id with Some x -> Some (id,x) | _ -> None in match Intset.firstl oriented set with Some _ as x -> x | None -> Intset.firstl any set ;; let cleanRedexes known redexes rpl = if Intset.null rpl then redexes else let filt (id,_) = not (Intset.member id rpl) in let addReds (id,reds) = match Intmap.peek known id with None -> reds | Some eqn_ort -> addRedexes id eqn_ort reds in let redexes = Term_net.filter filt redexes in let redexes = Intset.foldl addReds redexes rpl in redexes ;; let cleanSubterms known subterms spl = if Intset.null spl then subterms else let filt (id,_,_) = not (Intset.member id spl) in let addSubtms (id,subtms) = match Intmap.peek known id with None -> subtms | Some (eqn,_) -> addSubterms id eqn subtms in let subterms = Term_net.filter filt subterms in let subterms = Intset.foldl addSubtms subterms spl in subterms ;; let rebuild rpl spl rw = (*MetisTrace5 let ppPl = Print.ppMap Intset.toList (Print.ppList Print.ppInt) let () = Print.trace ppPl "Rewrite.rebuild: rpl" rpl let () = Print.trace ppPl "Rewrite.rebuild: spl" spl *) let Rewrite {order=order;known=known;redexes=redexes;subterms=subterms;waiting=waiting} = rw in let redexes = cleanRedexes known redexes rpl in let subterms = cleanSubterms known subterms spl in Rewrite {order = order; known = known; redexes = redexes; subterms = subterms; waiting = waiting} ;; let rec reduceAcc (rpl, spl, todo, (Rewrite {known=known;waiting=waiting} as rw), changed) = match pick known todo with Some (id,eqn_ort) -> let todo = Intset.delete todo id in reduceAcc (reduce1 false id eqn_ort (rpl,spl,todo,rw,changed)) | None -> match pick known waiting with Some (id,eqn_ort) -> let rw = deleteWaiting rw id in reduceAcc (reduce1 true id eqn_ort (rpl,spl,todo,rw,changed)) | None -> (rebuild rpl spl rw, Intset.toList changed);; let isReduced (Rewrite {waiting=waiting}) = Intset.null waiting;; let reduce' rw = if isReduced rw then (rw,[]) else reduceAcc (Intset.empty,Intset.empty,Intset.empty,rw,Intset.empty);; (*MetisDebug let reduce' = fun rw -> let (*MetisTrace4 let () = Print.trace pp "Rewrite.reduce': rw" rw *) let Rewrite {known,order,...} = rw let result as (Rewrite {known = known', ...}, _) = reduce' rw (*MetisTrace4 let ppResult = Print.ppPair pp (Print.ppList Print.ppInt) let () = Print.trace ppResult "Rewrite.reduce': result" result *) let ths = List.map (fun (id,((_,th),_)) -> (id,th)) (Intmap.toList known') let _ = not (List.exists (uncurry (thmReducible order known')) ths) || raise Bug "Rewrite.reduce': not fully reduced" in result end handle Error err -> raise (Bug ("Rewrite.reduce': shouldn't fail\n" ^ err));; *) let reduce rw = fst (reduce' rw);; (* ------------------------------------------------------------------------- *) (* Rewriting as a derived rule. *) (* ------------------------------------------------------------------------- *) let addEqn (id_eqn,rw) = add rw id_eqn;; let orderedRewrite order ths = let rw = Mlist.foldl addEqn (newRewrite order) (enumerate ths) in rewriteRule rw order ;; let order : reductionOrder = kComb (Some Greater);; let rewrite = orderedRewrite order;; end (* ========================================================================= *) (* A STORE FOR UNIT THEOREMS *) (* ========================================================================= *) module Units = struct open Useful;; (* ------------------------------------------------------------------------- *) (* A type of unit store. *) (* ------------------------------------------------------------------------- *) type unitThm = Literal.literal * Thm.thm;; type units = Units of unitThm Literal_net.literalNet;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) open Term_net let empty = Units (Literal_net.newNet {fifo = false});; let size (Units net) = Literal_net.size net;; let toString units = "U{" ^ Int.toString (size units) ^ "}";; (* ------------------------------------------------------------------------- *) (* Add units into the store. *) (* ------------------------------------------------------------------------- *) let add (Units net) ((lit,th) as uTh) = let net = Literal_net.insert net (lit,uTh) in match total Literal.sym lit with None -> Units net | Some ((pol,_) as lit') -> let th' = (if pol then Rule.symEq else Rule.symNeq) lit th in let net = Literal_net.insert net (lit',(lit',th')) in Units net ;; let addList = Mlist.foldl (fun (th,u) -> add u th);; (* ------------------------------------------------------------------------- *) (* Matching. *) (* ------------------------------------------------------------------------- *) let matchUnits (Units net) lit = let check ((lit',_) as uTh) = match total (Literal.matchLiterals Substitute.empty lit') lit with None -> None | Some sub -> Some (uTh,sub) in first check (Literal_net.matchNet net lit) ;; (* ------------------------------------------------------------------------- *) (* Reducing by repeated matching and resolution. *) (* ------------------------------------------------------------------------- *) let reduce units = let red1 (lit,news_th) = match total Literal.destIrrefl lit with Some tm -> let (news,th) = news_th in let th = Thm.resolve lit th (Thm.refl tm) in (news,th) | None -> let lit' = Literal.negate lit in match matchUnits units lit' with None -> news_th | Some ((_,rth),sub) -> let (news,th) = news_th in let rth = Thm.subst sub rth in let th = Thm.resolve lit th rth in let newLits = Literal.Set.delete (Thm.clause rth) lit' in let news = Literal.Set.union newLits news in (news,th) in let rec red (news,th) = if Literal.Set.null news then th else red (Literal.Set.foldl red1 (Literal.Set.empty,th) news) in fun th -> Rule.removeSym (red (Thm.clause th, th)) ;; end (* ========================================================================= *) (* CLAUSE = ID + THEOREM *) (* ========================================================================= *) module Clause = struct open Useful;; open Order;; (* ------------------------------------------------------------------------- *) (* Helper functions. *) (* ------------------------------------------------------------------------- *) let newId = let r = ref 0 in let newI () = let n = !r in let () = r := n + 1 in n in fun () -> Portable.critical newI () ;; (* ------------------------------------------------------------------------- *) (* A type of clause. *) (* ------------------------------------------------------------------------- *) type literalOrder = No_literal_order | Unsigned_literal_order | Positive_literal_order;; type parameters = {ordering : Knuth_bendix_order.kbo; orderLiterals : literalOrder; orderTerms : bool};; type clauseId = int;; type clauseInfo = {parameters : parameters; id : clauseId; thm : Thm.thm};; type clause = Clause of clauseInfo;; (* ------------------------------------------------------------------------- *) (* Pretty printing. *) (* ------------------------------------------------------------------------- *) let toString (Clause {id=id;thm=thm}) = Thm.toString thm;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let default : parameters = {ordering = Knuth_bendix_order.default; orderLiterals = Positive_literal_order; orderTerms = true};; let mk info = Clause info let dest (Clause info) = info;; let id (Clause {id = i}) = i;; let thm (Clause {thm = th}) = th;; let equalThms cl cl' = Thm.equal (thm cl) (thm cl');; let newClause parameters thm = Clause {parameters = parameters; id = newId (); thm = thm};; let literals cl = Thm.clause (thm cl);; let isTautology (Clause {thm=thm}) = Thm.isTautology thm;; let isContradiction (Clause {thm=thm}) = Thm.isContradiction thm;; (* ------------------------------------------------------------------------- *) (* The term ordering is used to cut down inferences. *) (* ------------------------------------------------------------------------- *) let strictlyLess ordering x_y = match Knuth_bendix_order.compare ordering x_y with Some Less -> true | _ -> false;; let isLargerTerm ({ordering=ordering;orderTerms=orderTerms} : parameters) l_r = not orderTerms || not (strictlyLess ordering l_r);; let atomToTerms atm = match total Atom.destEq atm with None -> [Term.Fn atm] | Some (l,r) -> [l;r];; let notStrictlyLess ordering (xs,ys) = let less x = List.exists (fun y -> strictlyLess ordering (x,y)) ys in not (Mlist.all less xs) ;; let isLargerLiteral ({ordering=ordering;orderLiterals=orderLiterals} : parameters) lits = match orderLiterals with No_literal_order -> kComb true | Unsigned_literal_order -> let addLit ((_,atm),acc) = atomToTerms atm @ acc in let tms = Literal.Set.foldl addLit [] lits in fun (_,atm') -> notStrictlyLess ordering (atomToTerms atm', tms) | Positive_literal_order -> match Literal.Set.findl (kComb true) lits with None -> kComb true | Some (pol,_) -> let addLit ((p,atm),acc) = if p = pol then atomToTerms atm @ acc else acc in let tms = Literal.Set.foldl addLit [] lits in fun (pol',atm') -> if pol <> pol' then pol else notStrictlyLess ordering (atomToTerms atm', tms) ;; let largestLiterals (Clause {parameters=parameters;thm=thm}) = let litSet = Thm.clause thm in let isLarger = isLargerLiteral parameters litSet in let addLit (lit,s) = if isLarger lit then Literal.Set.add s lit else s in Literal.Set.foldr addLit Literal.Set.empty litSet ;; (*MetisTrace6 let largestLiterals = fun cl -> let let ppResult = Literal.Set.pp let () = Print.trace pp "Clause.largestLiterals: cl" cl let result = largestLiterals cl let () = Print.trace ppResult "Clause.largestLiterals: result" result in result end;; *) let largestEquations (Clause {parameters=parameters} as cl) = let addEq lit ort ((l,_) as l_r) acc = if isLargerTerm parameters l_r then (lit,ort,l) :: acc else acc in let addLit (lit,acc) = match total Literal.destEq lit with None -> acc | Some (l,r) -> let acc = addEq lit Rewrite.Right_to_left (r,l) acc in let acc = addEq lit Rewrite.Left_to_right (l,r) acc in acc in Literal.Set.foldr addLit [] (largestLiterals cl) ;; let addLit (lit,acc) = let addTm ((path,tm),acc) = (lit,path,tm) :: acc in Mlist.foldl addTm acc (Literal.nonVarTypedSubterms lit) ;; let largestSubterms cl = Literal.Set.foldl addLit [] (largestLiterals cl);; let allSubterms cl = Literal.Set.foldl addLit [] (literals cl);; (* ------------------------------------------------------------------------- *) (* Subsumption. *) (* ------------------------------------------------------------------------- *) let subsumes (subs : clause Subsume.subsume) cl = Subsume.isStrictlySubsumed subs (literals cl);; (* ------------------------------------------------------------------------- *) (* Simplifying rules: these preserve the clause id. *) (* ------------------------------------------------------------------------- *) let freshVars (Clause {parameters=parameters;id=id;thm=thm}) = Clause {parameters = parameters; id = id; thm = Rule.freshVars thm};; let simplify (Clause {parameters=parameters;id=id;thm=thm}) = match Rule.simplify thm with None -> None | Some thm -> Some (Clause {parameters = parameters; id = id; thm = thm});; let reduce units (Clause {parameters=parameters;id=id;thm=thm}) = Clause {parameters = parameters; id = id; thm = Units.reduce units thm};; let rewrite rewr (Clause {parameters=parameters;id=id;thm=thm}) = let simp th = let {ordering=ordering} = parameters in let cmp = Knuth_bendix_order.compare ordering in Rewrite.rewriteIdRule rewr cmp id th (*MetisTrace4 let () = Print.trace Rewrite.pp "Clause.rewrite: rewr" rewr let () = Print.trace Print.ppInt "Clause.rewrite: id" id let () = Print.trace pp "Clause.rewrite: cl" cl *) in let thm = match Rewrite.peek rewr id with None -> simp thm | Some ((_,thm),_) -> if Rewrite.isReduced rewr then thm else simp thm in let result = Clause {parameters = parameters; id = id; thm = thm} (*MetisTrace4 let () = Print.trace pp "Clause.rewrite: result" result *) in result;; (*MetisDebug handle Error err -> raise (Error ("Clause.rewrite:\n" ^ err));; *) (* ------------------------------------------------------------------------- *) (* Inference rules: these generate new clause ids. *) (* ------------------------------------------------------------------------- *) let factor (Clause {parameters=parameters;thm=thm} as cl) = let lits = largestLiterals cl in let apply sub = newClause parameters (Thm.subst sub thm) in List.map apply (Rule.factor' lits) ;; (*MetisTrace5 let factor = fun cl -> let let () = Print.trace pp "Clause.factor: cl" cl let result = factor cl let () = Print.trace (Print.ppList pp) "Clause.factor: result" result in result end;; *) let resolve (cl1,lit1) (cl2,lit2) = (*MetisTrace5 let () = Print.trace pp "Clause.resolve: cl1" cl1 let () = Print.trace Literal.pp "Clause.resolve: lit1" lit1 let () = Print.trace pp "Clause.resolve: cl2" cl2 let () = Print.trace Literal.pp "Clause.resolve: lit2" lit2 *) let Clause {parameters=parameters; thm = th1} = cl1 and Clause {thm = th2} = cl2 in let sub = Literal.unify Substitute.empty lit1 (Literal.negate lit2) (*MetisTrace5 let () = Print.trace Substitute.pp "Clause.resolve: sub" sub *) in let lit1 = Literal.subst sub lit1 in let lit2 = Literal.negate lit1 in let th1 = Thm.subst sub th1 and th2 = Thm.subst sub th2 in let _ = isLargerLiteral parameters (Thm.clause th1) lit1 || (*MetisTrace5 (trace "Clause.resolve: th1 violates ordering\n";; false) || *) raise (Error "resolve: clause1: ordering constraints") in let _ = isLargerLiteral parameters (Thm.clause th2) lit2 || (*MetisTrace5 (trace "Clause.resolve: th2 violates ordering\n";; false) || *) raise (Error "resolve: clause2: ordering constraints") in let th = Thm.resolve lit1 th1 th2 (*MetisTrace5 let () = Print.trace Thm.pp "Clause.resolve: th" th *) in let cl = Clause {parameters = parameters; id = newId (); thm = th} (*MetisTrace5 let () = Print.trace pp "Clause.resolve: cl" cl *) in cl ;; let paramodulate (cl1,lit1,ort1,tm1) (cl2,lit2,path2,tm2) = (*MetisTrace5 let () = Print.trace pp "Clause.paramodulate: cl1" cl1 let () = Print.trace Literal.pp "Clause.paramodulate: lit1" lit1 let () = Print.trace Rewrite.ppOrient "Clause.paramodulate: ort1" ort1 let () = Print.trace Term.pp "Clause.paramodulate: tm1" tm1 let () = Print.trace pp "Clause.paramodulate: cl2" cl2 let () = Print.trace Literal.pp "Clause.paramodulate: lit2" lit2 let () = Print.trace Term.ppPath "Clause.paramodulate: path2" path2 let () = Print.trace Term.pp "Clause.paramodulate: tm2" tm2 *) let Clause {parameters=parameters; thm = th1} = cl1 and Clause {thm = th2} = cl2 in let sub = Substitute.unify Substitute.empty tm1 tm2 in let lit1 = Literal.subst sub lit1 and lit2 = Literal.subst sub lit2 and th1 = Thm.subst sub th1 and th2 = Thm.subst sub th2 in let _ = isLargerLiteral parameters (Thm.clause th1) lit1 || raise (Error "Clause.paramodulate: with clause: ordering") in let _ = isLargerLiteral parameters (Thm.clause th2) lit2 || raise (Error "Clause.paramodulate: into clause: ordering") in let eqn = (Literal.destEq lit1, th1) in let (l_r,_) as eqn = match ort1 with Rewrite.Left_to_right -> eqn | Rewrite.Right_to_left -> Rule.symEqn eqn (*MetisTrace6 let () = Print.trace Rule.ppEquation "Clause.paramodulate: eqn" eqn *) in let _ = isLargerTerm parameters l_r || raise (Error "Clause.paramodulate: equation: ordering constraints") in let th = Rule.rewrRule eqn lit2 path2 th2 (*MetisTrace5 let () = Print.trace Thm.pp "Clause.paramodulate: th" th *) in Clause {parameters = parameters; id = newId (); thm = th} (*MetisTrace5 handle Error err -> let let () = trace ("Clause.paramodulate: failed: " ^ err ^ "\n") in raise Error err end;; *) end module Ax_cj = struct type ax_cj_thm = {axioms_thm : Thm.thm list; conjecture_thm : Thm.thm list};; type ax_cj_cl = {axioms_cl : Clause.clause list; conjecture_cl : Clause.clause list};; end (* ========================================================================= *) (* THE ACTIVE SET OF CLAUSES *) (* ========================================================================= *) module Active = struct open Useful;; open Order;; open Ax_cj (* ------------------------------------------------------------------------- *) (* Helper functions. *) (* ------------------------------------------------------------------------- *) (*MetisDebug local let mkRewrite ordering = let let add (cl,rw) = let let {id, thm = th, ...} = Clause.dest cl in match total Thm.destUnitEq th with Some l_r -> Rewrite.add rw (id,(l_r,th)) | None -> rw end in Mlist.foldl add (Rewrite.new (Knuth_bendix_order.compare ordering)) end;; let allFactors red = let let allClause cl = List.all red (cl :: Clause.factor cl) || let let () = Print.trace Clause.pp "Active.isSaturated.allFactors: cl" cl in false end in List.all allClause end;; let allResolutions red = let let allClause2 cl_lit cl = let let allLiteral2 lit = match total (Clause.resolve cl_lit) (cl,lit) with None -> true | Some cl -> allFactors red [cl] in Literal.Set.all allLiteral2 (Clause.literals cl) end || let let () = Print.trace Clause.pp "Active.isSaturated.allResolutions: cl2" cl in false end let allClause1 allCls cl = let let cl = Clause.freshVars cl let allLiteral1 lit = List.all (allClause2 (cl,lit)) allCls in Literal.Set.all allLiteral1 (Clause.literals cl) end || let let () = Print.trace Clause.pp "Active.isSaturated.allResolutions: cl1" cl in false end in fun [] -> true | allCls as cl :: cls -> allClause1 allCls cl && allResolutions red cls end;; let allParamodulations red cls = let let allClause2 cl_lit_ort_tm cl = let let allLiteral2 lit = let let para = Clause.paramodulate cl_lit_ort_tm let allSubterms (path,tm) = match total para (cl,lit,path,tm) with None -> true | Some cl -> allFactors red [cl] in List.all allSubterms (Literal.nonVarTypedSubterms lit) end || let let () = Print.trace Literal.pp "Active.isSaturated.allParamodulations: lit2" lit in false end in Literal.Set.all allLiteral2 (Clause.literals cl) end || let let () = Print.trace Clause.pp "Active.isSaturated.allParamodulations: cl2" cl let (_,_,ort,_) = cl_lit_ort_tm let () = Print.trace Rewrite.ppOrient "Active.isSaturated.allParamodulations: ort1" ort in false end let allClause1 cl = let let cl = Clause.freshVars cl let allLiteral1 lit = let let allCl2 x = List.all (allClause2 x) cls in match total Literal.destEq lit with None -> true | Some (l,r) -> allCl2 (cl,lit,Rewrite.Left_to_right,l) && allCl2 (cl,lit,Rewrite.Right_to_left,r) end || let let () = Print.trace Literal.pp "Active.isSaturated.allParamodulations: lit1" lit in false end in Literal.Set.all allLiteral1 (Clause.literals cl) end || let let () = Print.trace Clause.pp "Active.isSaturated.allParamodulations: cl1" cl in false end in List.all allClause1 cls end;; let redundant {subsume,reduce,rewrite} = let let simp cl = match Clause.simplify cl with None -> true | Some cl -> Subsume.isStrictlySubsumed subsume (Clause.literals cl) || let let cl' = cl let cl' = Clause.reduce reduce cl' let cl' = Clause.rewrite rewrite cl' in not (Clause.equalThms cl cl') && (simp cl' || let let () = Print.trace Clause.pp "Active.isSaturated.redundant: cl'" cl' in false end) end in fun cl -> simp cl || let let () = Print.trace Clause.pp "Active.isSaturated.redundant: cl" cl in false end end;; in let isSaturated ordering subs cls = let let rd = Units.empty let rw = mkRewrite ordering cls let red = redundant {subsume = subs, reduce = rd, rewrite = rw} in (allFactors red cls && allResolutions red cls && allParamodulations red cls) || let let () = Print.trace Rewrite.pp "Active.isSaturated: rw" rw let () = Print.trace (Print.ppList Clause.pp) "Active.isSaturated: clauses" cls in false end end;; end;; let checkSaturated ordering subs cls = if isSaturated ordering subs cls then () else raise (Bug "Active.checkSaturated");; *) (* ------------------------------------------------------------------------- *) (* A type of active clause sets. *) (* ------------------------------------------------------------------------- *) type simplify = {subsumes : bool; reduce : bool; rewrites : bool};; type parameters = {clause : Clause.parameters; prefactor : simplify; postfactor : simplify};; type active_t = {parameters : parameters; clauses : Clause.clause Intmap.map; units : Units.units; rewrite : Rewrite.rewrite; subsume : Clause.clause Subsume.subsume; literals : (Clause.clause * Literal.literal) Literal_net.literalNet; equations : (Clause.clause * Literal.literal * Rewrite.orient * Term.term) Term_net.termNet; subterms : (Clause.clause * Literal.literal * Term.path * Term.term) Term_net.termNet; allSubterms : (Clause.clause * Term.term) Term_net.termNet};; type active = Active of active_t;; let getSubsume (Active {subsume = s}) = s;; let setRewrite active rewrite = let Active {parameters=parameters;clauses=clauses;units=units;subsume=subsume;literals=literals;equations=equations; subterms=subterms;allSubterms=allSubterms} = active in Active {parameters = parameters; clauses = clauses; units = units; rewrite = rewrite; subsume = subsume; literals = literals; equations = equations; subterms = subterms; allSubterms = allSubterms} ;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let maxSimplify : simplify = {subsumes = true; reduce = true; rewrites = true};; let default : parameters = {clause = Clause.default; prefactor = maxSimplify; postfactor = maxSimplify};; open Term_net let empty parameters = let {clause=clause} = parameters in let {Clause.ordering=ordering} = clause in Active {parameters = parameters; clauses = Intmap.newMap (); units = Units.empty; rewrite = Rewrite.newRewrite (Knuth_bendix_order.compare ordering); subsume = Subsume.newSubsume (); literals = Literal_net.newNet {fifo = false}; equations = Term_net.newNet {fifo = false}; subterms = Term_net.newNet {fifo = false}; allSubterms = Term_net.newNet {fifo = false}} ;; let size (Active {clauses=clauses}) = Intmap.size clauses;; let clauses (Active {clauses = cls}) = let add (_,cl,acc) = cl :: acc in Intmap.foldr add [] cls ;; let saturation active = let remove (cl,(cls,subs)) = let lits = Clause.literals cl in if Subsume.isStrictlySubsumed subs lits then (cls,subs) else (cl :: cls, Subsume.insert subs (lits,())) in let cls = clauses active in let (cls,_) = Mlist.foldl remove ([], Subsume.newSubsume ()) cls in let (cls,subs) = Mlist.foldl remove ([], Subsume.newSubsume ()) cls (*MetisDebug let Active {parameters,...} = active let {clause,...} = parameters let {ordering,...} = clause let () = checkSaturated ordering subs cls *) in cls ;; (* ------------------------------------------------------------------------- *) (* Pretty printing. *) (* ------------------------------------------------------------------------- *) let toString active = "Active{" ^ string_of_int (size active) ^ "}";; (* ------------------------------------------------------------------------- *) (* Simplify clauses. *) (* ------------------------------------------------------------------------- *) let simplify simp units rewr subs = let {subsumes = s; reduce = r; rewrites = w} = simp in let rewrite cl = let cl' = Clause.rewrite rewr cl in if Clause.equalThms cl cl' then Some cl else Clause.simplify cl' in fun cl -> match Clause.simplify cl with None -> None | Some cl -> match (if w then rewrite cl else Some cl) with None -> None | Some cl -> let cl = if r then Clause.reduce units cl else cl in if s && Clause.subsumes subs cl then None else Some cl ;; (*MetisDebug let simplify = fun simp -> fun units -> fun rewr -> fun subs -> fun cl -> let let traceCl s = Print.trace Clause.pp ("Active.simplify: " ^ s) (*MetisTrace4 let ppClOpt = Print.ppOption Clause.pp let () = traceCl "cl" cl *) let cl' = simplify simp units rewr subs cl (*MetisTrace4 let () = Print.trace ppClOpt "Active.simplify: cl'" cl' *) let () = match cl' with None -> () | Some cl' -> case (match simplify simp units rewr subs cl' with None -> Some ("away", K ()) | Some cl'' -> if Clause.equalThms cl' cl'' then None else Some ("further", fun () -> traceCl "cl''" cl'')) of None -> () | Some (e,f) -> let let () = traceCl "cl" cl let () = traceCl "cl'" cl' let () = f () in raise Bug ("Active.simplify: clause should have been simplified "^e) end in cl' end;; *) let simplifyActive simp active = let Active {units=units;rewrite=rewrite;subsume=subsume} = active in simplify simp units rewrite subsume ;; (* ------------------------------------------------------------------------- *) (* Add a clause into the active set. *) (* ------------------------------------------------------------------------- *) let addUnit units cl = let th = Clause.thm cl in match total Thm.destUnit th with Some lit -> Units.add units (lit,th) | None -> units ;; let addRewrite rewrite cl = let th = Clause.thm cl in match total Thm.destUnitEq th with Some l_r -> Rewrite.add rewrite (Clause.id cl, (l_r,th)) | None -> rewrite ;; let addSubsume subsume cl = Subsume.insert subsume (Clause.literals cl, cl);; let addLiterals literals cl = let add ((_,atm) as lit, literals) = if Atom.isEq atm then literals else Literal_net.insert literals (lit,(cl,lit)) in Literal.Set.foldl add literals (Clause.largestLiterals cl) ;; let addEquations equations cl = let add ((lit,ort,tm),equations) = Term_net.insert equations (tm,(cl,lit,ort,tm)) in Mlist.foldl add equations (Clause.largestEquations cl) ;; let addSubterms subterms cl = let add ((lit,path,tm),subterms) = Term_net.insert subterms (tm,(cl,lit,path,tm)) in Mlist.foldl add subterms (Clause.largestSubterms cl) ;; let addAllSubterms allSubterms cl = let add ((_,_,tm),allSubterms) = Term_net.insert allSubterms (tm,(cl,tm)) in Mlist.foldl add allSubterms (Clause.allSubterms cl) ;; let addClause active cl = let Active {parameters=parameters;clauses=clauses;units=units;rewrite=rewrite;subsume=subsume;literals=literals; equations=equations;subterms=subterms;allSubterms=allSubterms} = active in let clauses = Intmap.insert clauses (Clause.id cl, cl) and subsume = addSubsume subsume cl and literals = addLiterals literals cl and equations = addEquations equations cl and subterms = addSubterms subterms cl and allSubterms = addAllSubterms allSubterms cl in Active {parameters = parameters; clauses = clauses; units = units; rewrite = rewrite; subsume = subsume; literals = literals; equations = equations; subterms = subterms; allSubterms = allSubterms} ;; let addFactorClause active cl = let Active {parameters=parameters;clauses=clauses;units=units;rewrite=rewrite;subsume=subsume;literals=literals; equations=equations;subterms=subterms;allSubterms=allSubterms} = active in let units = addUnit units cl and rewrite = addRewrite rewrite cl in Active {parameters = parameters; clauses = clauses; units = units; rewrite = rewrite; subsume = subsume; literals = literals; equations = equations; subterms = subterms; allSubterms = allSubterms} ;; (* ------------------------------------------------------------------------- *) (* Derive (unfactored) consequences of a clause. *) (* ------------------------------------------------------------------------- *) let deduceResolution literals cl ((_,atm) as lit, acc) = let resolve (cl_lit,acc) = (*let (cl1, lit1) = cl_lit in print_endline ("cl1 = " ^ Clause.toString cl1); print_endline ("lit1 = " ^ Literal.toString lit1); print_endline ("cl = " ^ Clause.toString cl); print_endline ("lit = " ^ Literal.toString lit);*) match total (Clause.resolve cl_lit) (cl,lit) with Some cl' -> cl' :: acc | None -> acc (*MetisTrace4 let () = Print.trace Literal.pp "Active.deduceResolution: lit" lit *) in if Atom.isEq atm then acc else Mlist.foldl resolve acc (Literal_net.unify literals (Literal.negate lit)) ;; let deduceParamodulationWith subterms cl ((lit,ort,tm),acc) = let para (cl_lit_path_tm,acc) = match total (Clause.paramodulate (cl,lit,ort,tm)) cl_lit_path_tm with Some cl' -> cl' :: acc | None -> acc in Mlist.foldl para acc (Term_net.unify subterms tm) ;; let deduceParamodulationInto equations cl ((lit,path,tm),acc) = let para (cl_lit_ort_tm,acc) = match total (Clause.paramodulate cl_lit_ort_tm) (cl,lit,path,tm) with Some cl' -> cl' :: acc | None -> acc in Mlist.foldl para acc (Term_net.unify equations tm) ;; let deduce active cl = let Active {parameters=parameters;literals=literals;equations=equations;subterms=subterms} = active in let lits = Clause.largestLiterals cl in let eqns = Clause.largestEquations cl in let subtms = if Term_net.null equations then [] else Clause.largestSubterms cl (*MetisTrace5 let () = Print.trace Literal.Set.pp "Active.deduce: lits" lits let () = Print.trace (Print.ppList (Print.ppMap (fun (lit,ort,_) -> (lit,ort)) (Print.ppPair Literal.pp Rewrite.ppOrient))) "Active.deduce: eqns" eqns let () = Print.trace (Print.ppList (Print.ppTriple Literal.pp Term.ppPath Term.pp)) "Active.deduce: subtms" subtms *) in let acc = [] in let acc = Literal.Set.foldl (deduceResolution literals cl) acc lits in let acc = Mlist.foldl (deduceParamodulationWith subterms cl) acc eqns in let acc = Mlist.foldl (deduceParamodulationInto equations cl) acc subtms in let acc = List.rev acc (*MetisTrace5 let () = Print.trace (Print.ppList Clause.pp) "Active.deduce: acc" acc *) in acc ;; (* ------------------------------------------------------------------------- *) (* Extract clauses from the active set that can be simplified. *) (* ------------------------------------------------------------------------- *) let clause_rewritables active = let Active {clauses=clauses;rewrite=rewrite} = active in let rewr (id,cl,ids) = let cl' = Clause.rewrite rewrite cl in if Clause.equalThms cl cl' then ids else Intset.add ids id in Intmap.foldr rewr Intset.empty clauses ;; let orderedRedexResidues (((l,r),_),ort) = match ort with None -> [] | Some Rewrite.Left_to_right -> [(l,r,true)] | Some Rewrite.Right_to_left -> [(r,l,true)];; let unorderedRedexResidues (((l,r),_),ort) = match ort with None -> [(l,r,false);(r,l,false)] | Some _ -> [];; let rewrite_rewritables active rewr_ids = let Active {parameters=parameters;rewrite=rewrite;clauses=clauses;allSubterms=allSubterms} = active in let {clause = {Clause.ordering=ordering}} = parameters in let order = Knuth_bendix_order.compare ordering in let addRewr (id,acc) = if Intmap.inDomain id clauses then Intset.add acc id else acc in let addReduce ((l,r,ord),acc) = let isValidRewr tm = match total (Substitute.matchTerms Substitute.empty l) tm with None -> false | Some sub -> ord || let tm' = Substitute.subst (Substitute.normalize sub) r in order (tm,tm') = Some Greater in let addRed ((cl,tm),acc) = (*MetisTrace5 let () = Print.trace Clause.pp "Active.addRed: cl" cl let () = Print.trace Term.pp "Active.addRed: tm" tm *) let id = Clause.id cl in if Intset.member id acc then acc else if not (isValidRewr tm) then acc else Intset.add acc id (*MetisTrace5 let () = Print.trace Term.pp "Active.addReduce: l" l let () = Print.trace Term.pp "Active.addReduce: r" r let () = Print.trace Print.ppBool "Active.addReduce: ord" ord *) in Mlist.foldl addRed acc (Term_net.matched allSubterms l) in let addEquation redexResidues (id,acc) = match Rewrite.peek rewrite id with None -> acc | Some eqn_ort -> Mlist.foldl addReduce acc (redexResidues eqn_ort) in let addOrdered = addEquation orderedRedexResidues in let addUnordered = addEquation unorderedRedexResidues in let ids = Intset.empty in let ids = Mlist.foldl addRewr ids rewr_ids in let ids = Mlist.foldl addOrdered ids rewr_ids in let ids = Mlist.foldl addUnordered ids rewr_ids in ids ;; let choose_clause_rewritables active ids = size active <= length ids let rewritables active ids = if choose_clause_rewritables active ids then clause_rewritables active else rewrite_rewritables active ids;; (*MetisDebug let rewritables = fun active -> fun ids -> let let clause_ids = clause_rewritables active let rewrite_ids = rewrite_rewritables active ids let () = if Intset.equal rewrite_ids clause_ids then () else let let ppIdl = Print.ppList Print.ppInt let ppIds = Print.ppMap Intset.toList ppIdl let () = Print.trace pp "Active.rewritables: active" active let () = Print.trace ppIdl "Active.rewritables: ids" ids let () = Print.trace ppIds "Active.rewritables: clause_ids" clause_ids let () = Print.trace ppIds "Active.rewritables: rewrite_ids" rewrite_ids in raise Bug "Active.rewritables: ~(rewrite_ids SUBSET clause_ids)" end in if choose_clause_rewritables active ids then clause_ids else rewrite_ids end;; *) let delete active ids = if Intset.null ids then active else let idPred id = not (Intset.member id ids) in let clausePred cl = idPred (Clause.id cl) in let Active {parameters=parameters; clauses=clauses; units=units; rewrite=rewrite; subsume=subsume; literals=literals; equations=equations; subterms=subterms; allSubterms=allSubterms} = active in let cP1 (x,_) = clausePred x in let cP1_4 (x,_,_,_) = clausePred x in let clauses = Intmap.filter (fun x -> idPred (fst x)) clauses and subsume = Subsume.filter clausePred subsume and literals = Literal_net.filter cP1 literals and equations = Term_net.filter cP1_4 equations and subterms = Term_net.filter cP1_4 subterms and allSubterms = Term_net.filter cP1 allSubterms in Active {parameters = parameters; clauses = clauses; units = units; rewrite = rewrite; subsume = subsume; literals = literals; equations = equations; subterms = subterms; allSubterms = allSubterms} ;; let extract_rewritables (Active {clauses=clauses;rewrite=rewrite} as active) = if Rewrite.isReduced rewrite then (active,[]) else (*MetisTrace3 let () = trace "Active.extract_rewritables: inter-reducing\n" *) let (rewrite,ids) = Rewrite.reduce' rewrite in let active = setRewrite active rewrite in let ids = rewritables active ids in let cls = Intset.transform (Intmap.get clauses) ids (*MetisTrace3 let ppCls = Print.ppList Clause.pp let () = Print.trace ppCls "Active.extract_rewritables: cls" cls *) in (delete active ids, cls) (*MetisDebug handle Error err -> raise (Bug ("Active.extract_rewritables: shouldn't fail\n" ^ err));; *) ;; (* ------------------------------------------------------------------------- *) (* Factor clauses. *) (* ------------------------------------------------------------------------- *) let prefactor_simplify active subsume = let Active {parameters=parameters;units=units;rewrite=rewrite} = active in let {prefactor=prefactor} = parameters in simplify prefactor units rewrite subsume ;; let postfactor_simplify active subsume = let Active {parameters=parameters;units=units;rewrite=rewrite} = active in let {postfactor=postfactor} = parameters in simplify postfactor units rewrite subsume ;; let sort_utilitywise = let utility cl = match Literal.Set.size (Clause.literals cl) with 0 -> -1 | 1 -> if Thm.isUnitEq (Clause.thm cl) then 0 else 1 | n -> n in sortMap utility Int.compare ;; let factor_add (cl, ((active,subsume,acc) as active_subsume_acc)) = match postfactor_simplify active subsume cl with None -> active_subsume_acc | Some cl -> let active = addFactorClause active cl and subsume = addSubsume subsume cl and acc = cl :: acc in (active,subsume,acc) ;; let factor1 (cl, ((active,subsume,_) as active_subsume_acc)) = match prefactor_simplify active subsume cl with None -> active_subsume_acc | Some cl -> let cls = sort_utilitywise (cl :: Clause.factor cl) in Mlist.foldl factor_add active_subsume_acc cls ;; let rec factor' active acc = function [] -> (active, List.rev acc) | cls -> let cls = sort_utilitywise cls in let subsume = getSubsume active in let (active,_,acc) = Mlist.foldl factor1 (active,subsume,acc) cls in let (active,cls) = extract_rewritables active in factor' active acc cls ;; let factor active cls = factor' active [] cls;; (*let factor active cls = let str cl = String.concat "\n" (List.map Clause.toString cl) in print_endline ("Active.factor: cls:\n" ^ str cls); let (active,cls') = factor active cls in print_endline ("Active.factor: cls':\n" ^ str cls'); (active, cls');; *) (*MetisTrace4 let factor = fun active -> fun cls -> let let ppCls = Print.ppList Clause.pp let () = Print.trace ppCls "Active.factor: cls" cls let (active,cls') = factor active cls let () = Print.trace ppCls "Active.factor: cls'" cls' in (active,cls') end;; *) (* ------------------------------------------------------------------------- *) (* Create a new active clause set and initialize clauses. *) (* ------------------------------------------------------------------------- *) let mk_clause params th = Clause.mk {Clause.parameters = params; Clause.id = Clause.newId (); Clause.thm = th};; let newActive parameters {axioms_thm=axioms_thm;conjecture_thm=conjecture_thm} = let {clause=clause} = parameters in let mk_clause = mk_clause clause in let active = empty parameters in let (active,axioms) = factor active (List.map mk_clause axioms_thm) in let (active,conjecture) = factor active (List.map mk_clause conjecture_thm) in (active, {axioms_cl = axioms; conjecture_cl = conjecture}) ;; (* ------------------------------------------------------------------------- *) (* Add a clause into the active set and deduce all consequences. *) (* ------------------------------------------------------------------------- *) let add active cl = match simplifyActive maxSimplify active cl with None -> (active,[]) | Some cl' -> if Clause.isContradiction cl' then (active,[cl']) else if not (Clause.equalThms cl cl') then factor active [cl'] else (*MetisTrace2 let () = Print.trace Clause.pp "Active.add: cl" cl *) let active = addClause active cl in let cl = Clause.freshVars cl in let cls = deduce active cl in let (active,cls) = factor active cls (*MetisTrace2 let ppCls = Print.ppList Clause.pp let () = Print.trace ppCls "Active.add: cls" cls *) in (active,cls) ;; end (* ========================================================================= *) (* THE WAITING SET OF CLAUSES *) (* ========================================================================= *) module Waiting = struct open Useful;; open Ax_cj open Real (* ------------------------------------------------------------------------- *) (* A type of waiting sets of clauses. *) (* ------------------------------------------------------------------------- *) type weight = real;; type modelParameters = {model : Model.parameters; initialPerturbations : int; maxChecks : int option; perturbations : int; weight : weight} type parameters = {symbolsWeight : weight; variablesWeight : weight; literalsWeight : weight; modelsP : modelParameters list};; type distance = real;; type waiting_t = {parameters : parameters; clauses : (weight * (distance * Clause.clause)) Heap.heap; models : Model.model list};; type waiting = Waiting of waiting_t;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let defaultModels : modelParameters list = [{model = Model.default; initialPerturbations = 100; maxChecks = Some 20; perturbations = 0; weight = 1.0}];; let default : parameters = {symbolsWeight = 1.0; literalsWeight = 1.0; variablesWeight = 1.0; modelsP = defaultModels};; let size (Waiting {clauses=clauses}) = Heap.size clauses;; let toString w = "Waiting{" ^ Int.toString (size w) ^ "}";; (*let toString (Waiting {clauses}) = "\n" ^ String.concat "\n" (List.map (fun (w, (d, c)) -> Clause.toString c) (Heap.toList clauses));;*) (*MetisDebug let pp = Print.ppMap (fun Waiting {clauses,...} -> List.map (fun (w,(_,cl)) -> (w, Clause.id cl, cl)) (Heap.toList clauses)) (Print.ppList (Print.ppTriple Print.ppReal Print.ppInt Clause.pp));; *) (* ------------------------------------------------------------------------- *) (* Perturbing the models. *) (* ------------------------------------------------------------------------- *) type modelClause = Name.Set.set * Thm.clause;; let mkModelClause cl = let lits = Clause.literals cl in let fvs = Literal.Set.freeVars lits in (fvs,lits) ;; let mkModelClauses = List.map mkModelClause;; let perturbModel vM cls = if Mlist.null cls then kComb () else let vN = {Model.size = Model.msize vM} in let perturbClause (fv,cl) = let vV = Model.randomValuation vN fv in if Model.interpretClause vM vV cl then () else Model.perturbClause vM vV cl in let perturbClauses () = app perturbClause cls in fun n -> funpow n perturbClauses () ;; let initialModel axioms conjecture parm = let {model=model;initialPerturbations=initialPerturbations} = parm in let m = Model.newModel model in let () = perturbModel m conjecture initialPerturbations in let () = perturbModel m axioms initialPerturbations in m ;; let checkModels parms models (fv,cl) = let check ((parm,model),z) = let {maxChecks=maxChecks;weight=weight} = parm in let n = maxChecks in let (vT,vF) = Model.check Model.interpretClause n model fv cl in Math.pow (1.0 +. Real.fromInt vT /. Real.fromInt (vT + vF), weight) *. z in Mlist.foldl check 1.0 (zip parms models) ;; let perturbModels parms models cls = let perturb (parm,model) = let {perturbations=perturbations} = parm in perturbModel model cls perturbations in app perturb (zip parms models) ;; (* ------------------------------------------------------------------------- *) (* Clause weights. *) (* ------------------------------------------------------------------------- *) let clauseSymbols cl = Real.fromInt (Literal.Set.typedSymbols cl);; let clauseVariables cl = Real.fromInt (Name.Set.size (Literal.Set.freeVars cl) + 1);; let clauseLiterals cl = Real.fromInt (Literal.Set.size cl);; let clausePriority cl = 1e-12 *. Real.fromInt (Clause.id cl);; let clauseWeight (parm : parameters) mods dist mcl cl = (*MetisTrace3 let () = Print.trace Clause.pp "Waiting.clauseWeight: cl" cl *) let {symbolsWeight=symbolsWeight;variablesWeight=variablesWeight;literalsWeight=literalsWeight;modelsP=modelsP} = parm in let lits = Clause.literals cl in let symbolsW = Math.pow (clauseSymbols lits, symbolsWeight) in let variablesW = Math.pow (clauseVariables lits, variablesWeight) in let literalsW = Math.pow (clauseLiterals lits, literalsWeight) in let modelsW = checkModels modelsP mods mcl (*MetisTrace4 let () = trace ("Waiting.clauseWeight: dist = " ^ Real.toString dist ^ "\n") let () = trace ("Waiting.clauseWeight: symbolsW = " ^ Real.toString symbolsW ^ "\n") let () = trace ("Waiting.clauseWeight: variablesW = " ^ Real.toString variablesW ^ "\n") let () = trace ("Waiting.clauseWeight: literalsW = " ^ Real.toString literalsW ^ "\n") let () = trace ("Waiting.clauseWeight: modelsW = " ^ Real.toString modelsW ^ "\n") *) in let weight = dist *. symbolsW *. variablesW *. literalsW *. modelsW in let weight = weight +. clausePriority cl (*MetisTrace3 let () = trace ("Waiting.clauseWeight: weight = " ^ Real.toString weight ^ "\n") *) in weight ;; (* ------------------------------------------------------------------------- *) (* Adding new clauses. *) (* ------------------------------------------------------------------------- *) let add' waiting dist mcls cls = let Waiting {parameters=parameters;clauses=clauses;models=models} = waiting in let {modelsP = modelParameters} = parameters (*MetisDebug let _ = not (Mlist.null cls) || raise Bug "Waiting.add': null" let _ = length mcls = length cls || raise Bug "Waiting.add': different lengths" *) in let dist = dist +. Math.ln (Real.fromInt (length cls)) in let addCl ((mcl,cl),acc) = let weight = clauseWeight parameters models dist mcl cl in Heap.add acc (weight,(dist,cl)) in let clauses = Mlist.foldl addCl clauses (zip mcls cls) in let () = perturbModels modelParameters models mcls in Waiting {parameters = parameters; clauses = clauses; models = models} ;; let add waiting (dist,cls) = if Mlist.null cls then waiting else (*MetisTrace3 let () = Print.trace pp "Waiting.add: waiting" waiting let () = Print.trace (Print.ppList Clause.pp) "Waiting.add: cls" cls *) let waiting = add' waiting dist (mkModelClauses cls) cls (*MetisTrace3 let () = Print.trace pp "Waiting.add: waiting" waiting *) in waiting ;; let cmp ((w1,_),(w2,_)) = Real.compare (w1,w2);; let empty parameters axioms conjecture = let {modelsP = modelParameters} = parameters in let clauses = Heap.newHeap cmp and models = List.map (initialModel axioms conjecture) modelParameters in Waiting {parameters = parameters; clauses = clauses; models = models} ;; let newWaiting parameters {axioms_cl=axioms_cl;conjecture_cl=conjecture_cl} = let mAxioms = mkModelClauses axioms_cl and mConjecture = mkModelClauses conjecture_cl in let waiting = empty parameters mAxioms mConjecture in if Mlist.null axioms_cl && Mlist.null conjecture_cl then waiting else add' waiting 0.0 (mAxioms @ mConjecture) (axioms_cl @ conjecture_cl) (*MetisDebug handle e -> let let () = Print.trace Print.ppException "Waiting.new: exception" e in raise e end;; *) (* ------------------------------------------------------------------------- *) (* Removing the lightest clause. *) (* ------------------------------------------------------------------------- *) let remove (Waiting {parameters=parameters;clauses=clauses;models=models}) = if Heap.null clauses then None else let ((_,dcl),clauses) = Heap.remove clauses in let waiting = Waiting {parameters = parameters; clauses = clauses; models = models} in Some (dcl,waiting) ;; end (* ========================================================================= *) (* THE RESOLUTION PROOF PROCEDURE *) (* ========================================================================= *) module Resolution = struct open Useful;; (* ------------------------------------------------------------------------- *) (* A type of resolution proof procedures. *) (* ------------------------------------------------------------------------- *) type parameters = {activeP : Active.parameters; waitingP : Waiting.parameters};; type resolution_t = {parameters : parameters; active : Active.active; waiting : Waiting.waiting};; type resolution = Resolution of resolution_t;; (* ------------------------------------------------------------------------- *) (* Basic operations. *) (* ------------------------------------------------------------------------- *) let default : parameters = {activeP = Active.default; waitingP = Waiting.default};; let newResolution parameters ths = let {activeP = activeParm; waitingP = waitingParm} = parameters in let (active,cls) = Active.newActive activeParm ths (* cls = factored ths *) in let waiting = Waiting.newWaiting waitingParm cls in Resolution {parameters = parameters; active = active; waiting = waiting};; (*MetisDebug handle e -> let let () = Print.trace Print.ppException "Resolution.new: exception" e in raise e end;; *) let active (Resolution {active = a}) = a;; let waiting (Resolution {waiting = w}) = w;; (* ------------------------------------------------------------------------- *) (* The main proof loop. *) (* ------------------------------------------------------------------------- *) type decision = Contradiction of Thm.thm | Satisfiable of Thm.thm list;; type state = Decided of decision | Undecided of resolution;; let iterate res = let Resolution {parameters=parameters;active=active;waiting=waiting} = res (*MetisTrace2 let () = Print.trace Active.pp "Resolution.iterate: active" active let () = Print.trace Waiting.pp "Resolution.iterate: waiting" waiting *) in (* print_endline ("Resolution.iterate:active: " ^ Active.toString active); print_endline ("Resolution.iterate:waiting: " ^ Waiting.toString waiting); *) match Waiting.remove waiting with None -> let sat = Satisfiable (List.map Clause.thm (Active.saturation active)) in Decided sat | Some ((d,cl),waiting) -> if Clause.isContradiction cl then Decided (Contradiction (Clause.thm cl)) else (*MetisTrace1 let () = Print.trace Clause.pp "Resolution.iterate: cl" cl *) (* let () = print_endline ("Resolution.iterate: cl " ^ (Clause.toString cl)) in *) let (active,cls) = Active.add active cl in let waiting = Waiting.add waiting (d,cls) in let res = Resolution {parameters = parameters; active = active; waiting = waiting} in Undecided res ;; let rec loop res = match iterate res with Decided dec -> dec | Undecided res -> loop res;; end (* ========================================================================= *) (* The basic Metis loop. *) (* ========================================================================= *) module Metis_loop = struct let rec loop res = match Resolution.iterate res with Resolution.Decided dec -> Some dec | Resolution.Undecided res -> loop res open Ax_cj let run rules = let ths = {axioms_thm = rules; conjecture_thm = []} in let res = Resolution.newResolution Resolution.default ths in match loop res with None -> failwith "metis: timeout" | Some (Resolution.Contradiction thm) -> thm | Some (Resolution.Satisfiable _) -> failwith "metis: found satisfiable assignment" end (* ========================================================================= *) (* Conversion of HOL to Metis FOL. *) (* ========================================================================= *) module Metis_generate = struct let metis_name = string_of_int let rec metis_of_term env consts tm = if is_var tm && not (mem tm consts) then (Term.Var(metis_name (Meson.fol_of_var tm))) else ( let f,args = strip_comb tm in if mem f env then failwith "metis_of_term: higher order" else let ff = Meson.fol_of_const f in Term.Fn (metis_name ff, map (metis_of_term env consts) args)) let rec metis_of_term env consts tm = if is_var tm && not (mem tm consts) then (Term.Var(metis_name (Meson.fol_of_var tm))) else ( let f,args = strip_comb tm in if mem f env then failwith "metis_of_term: higher order" else let ff = Meson.fol_of_const f in Term.Fn (metis_name ff, map (metis_of_term env consts) args)) let metis_of_atom env consts tm = try let (l, r) = dest_eq tm in let l' = metis_of_term env consts l and r' = metis_of_term env consts r in Atom.mkEq (l', r') with Failure _ -> let f,args = strip_comb tm in if mem f env then failwith "metis_of_atom: higher order" else let ff = Meson.fol_of_const f in (metis_name ff, map (metis_of_term env consts) args) let metis_of_literal env consts tm = let (pol, tm') = try (false, dest_neg tm) with Failure _ -> (true, tm) in (pol, metis_of_atom env consts tm') let metis_of_clause th = let lconsts = freesl (hyp th) in let tm = concl th in let hlits = disjuncts tm in let flits = map (metis_of_literal [] lconsts) hlits in let set = Literal.Set.fromList flits in Thm.axiom set let metis_of_clauses = map metis_of_clause end (* ========================================================================= *) (* Reconstruction of HOL proofs from Metis ones. *) (* ========================================================================= *) module Metis_reconstruct = struct let hol_of_var tymap v = try let v' = int_of_string v in Meson.hol_of_var v' with _ -> (match Name.Map.peek tymap v with Some ty -> mk_var (v, ty) | None -> failwith ("Metis_reconstruct.hol_of_var: " ^ v)) let hol_of_const c = try Meson.hol_of_const (int_of_string c) with _ -> failwith ("Metis_reconstruct.hol_of_const: " ^ c) let rec hol_of_term tymap = function Term.Var v -> hol_of_var tymap v | Term.Fn (f, args) -> list_mk_comb(hol_of_const f, map (hol_of_term tymap) args) let hol_of_atom tymap (p,args) = let args' = map (hol_of_term tymap) args in if p = "=" then match args' with eq_l :: eq_r :: [] -> mk_eq (eq_l, eq_r) | _ -> failwith "Metis_reconstruct.hol_of_atom: bad equality" else list_mk_comb(hol_of_const p,args') let hol_of_literal tymap (pol,args) = let atom = hol_of_atom tymap args in match pol with false -> mk_neg atom | true -> atom let string_of_metis_subst subst = let print_single (name, term) = name ^ " -> " ^ Term.toString term in String.concat ", " (map print_single subst) let string_of_hol_subst subst = let print_single (t, v) = string_of_term t ^ " / " ^ string_of_term v in String.concat ", " (map print_single subst) let hol_of_subst tymap subst = map (fun (name, term) -> hol_of_term tymap term, hol_of_var tymap name) subst let empty_tymap = Name.Map.newMap () (* update type map with all variables from substitution that are not covered by the type map yet *) let update_tymap tymap subst = let f (v, term) acc = try let _ = hol_of_var acc v in acc with _ -> Name.Map.insert acc (v, type_of (hol_of_term tymap term)) in List.fold_right f subst tymap let string_of_int_list = String.concat "; " o List.map string_of_int (* return polarity and atom of literal *) let atom_of_literal lit = match is_neg lit with true -> (false, dest_neg lit) | false -> (true , lit) let literal_of_atom (pol, atom) = if pol then atom else mk_neg atom let rec follow_metis_atom_path tm = function [] -> (tm, "") | i :: is -> let f,args = strip_comb tm in let arity = length args in if i < arity then let (tm', path') = follow_metis_atom_path (List.nth args i) is in (tm', String.make (arity - i - 1) 'l' ^ "r" ^ path') else failwith "follow_metis_atom_path" (* find literal subterm at a Metis path, and return it along with equivalent HOL Light path *) let follow_metis_lit_path lit path = (* Metis returns paths that indicate the position of a term inside an *atom*, even if the atom is negated, thus a literal. *) let (pol, atom) = atom_of_literal lit in let (s, path) = follow_metis_atom_path atom path in (s, if pol then path else "r" ^ path) (* retrieve axiom that proves the disjunction of the given literals *) let match_axiom axioms lits = let set = setify lits in let clause = list_mk_disj set in (* we could canonicalise just once at the beginning for all axioms *) let canonicalise = CONV_RULE DISJ_CANON_CONV in let axioms' = map canonicalise axioms in try find (fun thm -> concl thm = clause) axioms' with _ -> failwith "match_axiom" (* move a literal in the proof of a disjunction to the first position may not preserve the order of the other literals *) let FRONT lit thm = let conc = concl thm in let disj = disjuncts (concl thm) in let rest = match partition (fun l -> l = lit) disj with ([], _) -> failwith "FRONT: literal not in disjunction" | (_ , r) -> r in let disj' = lit :: rest in let conc' = list_mk_disj disj' in let eq = DISJ_ACI_RULE (mk_eq (conc, conc')) in (PURE_ONCE_REWRITE_RULE [eq] thm, rest) (* resolve two clauses, where atom has to appear at the first position of both clauses: positive in the first and negative in the second clause *) let RESOLVE_N = let RESOLVE_1 = TAUT `!a. a ==> ~a ==> F` and RESOLVE_2L = TAUT `!a b. a \/ b ==> ~a ==> b` and RESOLVE_2R = TAUT `!a c. a ==> ~a \/ c ==> c` and RESOLVE_3 = TAUT `!a b c. a \/ b ==> ~a \/ c ==> b \/ c` in fun atom -> function ([], []) -> SPEC atom RESOLVE_1 | (r1, []) -> SPECL [atom; list_mk_disj r1] RESOLVE_2L | ([], r2) -> SPECL [atom; list_mk_disj r2] RESOLVE_2R | (r1, r2) -> SPECL [atom; list_mk_disj r1; list_mk_disj r2] RESOLVE_3 (* resolve two clauses th1 and th2, where atom appears somewhere positive in th1 and negative in th2 *) let RESOLVE atom th1 th2 = (*print_endline ("Atom: " ^ string_of_term atom); print_endline ("th1 : " ^ string_of_term (concl th1)); print_endline ("th2 : " ^ string_of_term (concl th2));*) try let (th1', r1) = FRONT atom th1 and (th2', r2) = FRONT (mk_neg atom) th2 in let res = RESOLVE_N atom (r1, r2) in MP (MP res th1') th2' with _ -> failwith "resolve" (* given A, tm |- C, prove A |- ~tm \/ C or given A, ~tm |- C, prove A |- tm \/ C *) let DISCH_DISJ = let IMPL_NOT_L = TAUT `!a b. ~a ==> b <=> a \/ b` and IMPL_NOT_R = TAUT `!a b. a ==> b <=> ~a \/ b` in fun tm th -> let impl = DISCH tm th and (tm', IMPL_NOT) = try dest_neg tm, IMPL_NOT_L with _ -> tm, IMPL_NOT_R in let eq = SPECL [tm'; concl th] IMPL_NOT in PURE_ONCE_REWRITE_RULE [eq] impl (* given A, tm1, .., tmn |- th, prove A |- ~tm1 \/ .. \/ ~tmn \/ th *) let DISCH_DISJS tms th = List.fold_right DISCH_DISJ tms th let rec hol_of_proof axioms tymap th_concl = let hol_term = hol_of_term tymap and hol_atom = hol_of_atom tymap and hol_lit = hol_of_literal tymap and hol_proof = hol_of_proof axioms tymap in (*print_string ("Thm: " ^ Thm.toString th_concl); print_newline ();*) let result = match Proof.thmToInference th_concl with Proof.Axiom litset -> let lits = Literal.Set.toList litset in match_axiom axioms (map hol_lit lits) | Proof.Assume atom -> SPEC (hol_atom atom) EXCLUDED_MIDDLE | Proof.Subst (subst, th) -> let sl = Substitute.toList subst in let tymap' = update_tymap tymap sl in let subst' = hol_of_subst tymap' sl in let proof' = (hol_of_proof axioms tymap' th) in (*print_endline ("Subst (Metis): " ^ string_of_metis_subst sl); print_endline ("Subst (HOL): " ^ string_of_hol_subst subst'); print_string "Proof: "; print_thm proof'; print_newline ();*) INST subst' proof' | Proof.Resolve (atom, th1, th2) -> RESOLVE (hol_atom atom) (hol_proof th1) (hol_proof th2) | Proof.Refl term -> REFL (hol_term term) | Proof.Equality (lit, path, term) -> let lit' = hol_lit lit and t = hol_term term in let (s, path') = follow_metis_lit_path lit' path in (*print_string "Literal: "; print_term lit'; print_newline (); print_string "Path (Metis): "; print_string (string_of_int_list path); print_newline (); print_string "Path (HOL): "; print_string path'; print_newline (); print_string "Term (t, Metis): "; print_string (Term.toString term); print_newline (); print_string "Term (t, HOL): "; print_term t; print_newline (); print_string "Term (s, from fmlp): "; print_term s; print_newline (); print_string "Term (s, from fp): "; print_term (follow_path path' lit'); print_newline ();*) let eq = mk_eq (s,t) in let conv = PATH_CONV path' (PURE_ONCE_REWRITE_CONV [ASSUME eq]) in let converted = CONV_RULE conv (ASSUME lit') in (*print_thm converted; print_newline ();*) try DISCH_DISJS [eq; lit'] converted with _ -> failwith "equality" in (*print_endline ("Desired: " ^ Thm.toString th_concl); print_endline ("Result : " ^ string_of_term (concl result));*) result end (* ========================================================================= *) (* Main Metis module. *) (* ========================================================================= *) module Metis = struct (* ------------------------------------------------------------------------- *) (* Some parameters controlling Metis behaviour. *) (* ------------------------------------------------------------------------- *) let split_limit = ref 0;; (* Limit of case splits before Metis proper *) (* ----------------------------------------------------------------------- *) (* Basic HOL Metis procedure. *) (* ----------------------------------------------------------------------- *) (* Debugging tactic. *) let PRINT_TAC g = print_goal g; ALL_TAC g let PRINT_ID_TAC s g = print_endline s; PRINT_TAC g (* Slightly modified tactic from meson.ml. *) let FOL_PREPARE_TAC ths = (* We start with a single goal: P. *) REFUTE_THEN ASSUME_TAC THEN (*PRINT_ID_TAC "refuted" THEN*) (* 0 [`~P`] `F` *) Meson.POLY_ASSUME_TAC (map GEN_ALL ths) THEN (*PRINT_ID_TAC "poly_assumed" THEN*) (* 0 [`~P`] 1 [th1] ... n [thn] `F` *) W(MAP_EVERY(UNDISCH_TAC o concl o snd) o fst) THEN (* `~P ==> th1 ==> ... ==> thn ==> F` *) SELECT_ELIM_TAC THEN (* eliminate "select terms", e.g. Hilbert operators *) W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN (*PRINT_ID_TAC "all-quantified" THEN*) (* MAP_EVERY is mapM for tactics I believe that this all-quantifies all free variables in the goal *) CONV_TAC(PRESIMP_CONV THENC TOP_DEPTH_CONV BETA_CONV THENC LAMBDA_ELIM_CONV THENC CONDS_CELIM_CONV THENC Meson.QUANT_BOOL_CONV) THEN (*PRINT_ID_TAC "converted" THEN*) REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN (* remove outermost all-quantifiers (GEN_TAC) and implications (DISCH_TAC), moving them into assumptions *) REFUTE_THEN ASSUME_TAC THEN (* move conclusion negated into assumptions, replace goal by `F`*) RULE_ASSUM_TAC(CONV_RULE(NNF_CONV THENC SKOLEM_CONV)) THEN (* transform assumptions to NNF and skolemize *) REPEAT (FIRST_X_ASSUM CHOOSE_TAC) THEN (* remove existentials at the front *) ASM_FOL_TAC THEN (* fix function arities, e.g. f(x) and f(x,y) become I f x and I (I f x) y *) Meson.SPLIT_TAC (!split_limit) THEN RULE_ASSUM_TAC(CONV_RULE(PRENEX_CONV THENC WEAK_CNF_CONV)) THEN RULE_ASSUM_TAC(repeat (fun th -> SPEC(genvar(type_of(fst(dest_forall(concl th))))) th)) THEN (* destroy all-quantifiers and replace quantified variables by fresh ones *) REPEAT (FIRST_X_ASSUM (Meson.CONJUNCTS_THEN' ASSUME_TAC)) THEN (* make every conjunction a separate assumption *) RULE_ASSUM_TAC(CONV_RULE(ASSOC_CONV DISJ_ASSOC)) THEN (* associate disjunctions to the right *) REPEAT (FIRST_X_ASSUM SUBST_VAR_TAC) (* substitute variables safely among assumptions, not changing provability *) (*THEN PRINT_ID_TAC "before Metis"*) let SIMPLE_METIS_REFUTE ths = Meson.clear_contrapos_cache(); let rules = Metis_generate.metis_of_clauses ths in let res = Metis_loop.run rules in (*Thm.print_proof res;*) let proof = Metis_reconstruct.hol_of_proof ths Metis_reconstruct.empty_tymap res in (*List.iter print_thm ths;*) (*print_endline "Metis theorem:"; print_thm proof; print_endline "Metis end.";*) proof let PURE_METIS_TAC g = Meson.reset_vars(); Meson.reset_consts(); (FIRST_ASSUM CONTR_TAC ORELSE W(ACCEPT_TAC o SIMPLE_METIS_REFUTE o map snd o fst)) g let GEN_METIS_TAC ths = FOL_PREPARE_TAC ths THEN PURE_METIS_TAC end ;; (* ========================================================================= *) (* Baic Metis refutation procedure and parametrized tactic. *) (* ========================================================================= *) let ASM_METIS_TAC = Metis.GEN_METIS_TAC;; let METIS_TAC ths = POP_ASSUM_LIST(K ALL_TAC) THEN ASM_METIS_TAC ths;; let METIS ths tm = prove(tm,METIS_TAC ths);; hol-light/miz3/000077500000000000000000000000001303454263000136275ustar00rootroot00000000000000hol-light/miz3/ERRORS000066400000000000000000000003371303454263000145710ustar00rootroot000000000000001: inference error 2: inference time-out 3: skeleton error 4: unknown label 5: underspecified types hol 6: unbound free variables hol 7: syntax error justification or ocaml 8: syntax or type error hol 9: syntax error mizar hol-light/miz3/README000066400000000000000000000013201303454263000145030ustar00rootroot00000000000000(* ========================================================================= *) (* miz3: Mizar-style declarative proofs for HOL Light. *) (* *) (* (c) Freek Wiedijk 2009-2012 *) (* *) (* Distributed under the same license terms as HOL Light. *) (* *) (* See http://arxiv.org/abs/1201.3601 for more information. *) (* ========================================================================= *) hol-light/miz3/Samples/000077500000000000000000000000001303454263000152335ustar00rootroot00000000000000hol-light/miz3/Samples/NEEDS000066400000000000000000000001231303454263000160100ustar00rootroot00000000000000needs "Examples/transc.ml";; needs "Examples/sos.ml";; needs "Examples/prime.ml";; hol-light/miz3/Samples/bug0.ml000066400000000000000000000046761303454263000164370ustar00rootroot00000000000000prioritize_num();; let EGCD_INVARIANT = thm `; !m n d. d divides egcd(m,n) <=> d divides m /\ d divides n proof let m n be num; (!m'' n'. m'' + n' < m + n ==> (!d. d divides egcd (m'',n') <=> d divides m'' /\ d divides n')) ==> (!d. d divides egcd (m,n) <=> d divides m /\ d divides n) [1] proof assume !m'' n'. m'' + n' < m + n ==> (!d. d divides egcd (m'',n') <=> d divides m'' /\ d divides n') [2]; !d. d divides (if m = 0 then n else if n = 0 then m else if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> d divides m /\ d divides n [3] proof let d be num; m = 0 ==> (d divides n <=> d divides m /\ d divides n) [4] by DIVIDES_0; ~(m = 0) ==> (d divides (if n = 0 then m else if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> d divides m /\ d divides n) [5] proof assume ~(m = 0) [6]; n = 0 ==> (d divides m <=> d divides m /\ d divides n) [7] by DIVIDES_0; ~(n = 0) ==> (d divides (if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> d divides m /\ d divides n) [8] proof assume ~(n = 0) [9]; m <= n ==> (d divides egcd (m,n - m) <=> d divides m /\ d divides n) [10] proof assume m <= n; m + (n - m) < m + n by ARITH_TAC,6; qed by #; ~(m <= n) ==> (d divides egcd (m - n,n) <=> d divides m /\ d divides n) [11] proof assume ~(m <= n); (m - n) + n < m + n by ARITH_TAC,9; d divides egcd (m - n,n) <=> d divides m - n /\ d divides n by 2; ... <=> d divides (m - n) + n /\ d divides n by DIVIDES_ADD; :: #1 :: 1: inference error qed by 2,DIVIDES_SUB; :: #1 qed by COND_CASES_TAC from 10,11; qed by COND_CASES_TAC from 7,8; qed by COND_CASES_TAC from 4,5; qed by ONCE_REWRITE_TAC[egcd] from 3; qed by WF_INDUCT_TAC (parse_term "m + n") from 1; :: #1 `;; hol-light/miz3/Samples/bug1.ml000066400000000000000000000040731303454263000164270ustar00rootroot00000000000000horizon := -1;; let FOO = thm `; !x n. x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) \/ n = 0 [1] proof let x be real; let n be num; n = 0 ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) \/ n = 0) [2] proof assume n = 0 [3]; qed by ASM_REWRITE_TAC[real_pow],3; ~(n = 0) ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) \/ n = 0) [4] proof assume ~(n = 0) [5]; abs x = &1 ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n)) [6] proof assume abs x = &1 [7]; &1 < &0 ==> EVEN n [8] by REAL_ARITH_TAC,5; &1 pow n = &1 <=> &1 < &0 ==> EVEN n [9] by ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE],5 from 8; EVEN n ==> (&1 = &1 <=> -- &1 < &0 ==> T) [10] proof assume EVEN n [11]; qed by ASM_REWRITE_TAC[],5,11; ~EVEN n ==> (-- &1 = &1 <=> -- &1 < &0 ==> F) [12] proof assume ~EVEN n [13]; -- &1 = &1 <=> ~(-- &1 < &0) [14] by REAL_ARITH_TAC,5,13; qed by ASM_REWRITE_TAC[],5,13 from 14; (if EVEN n then &1 else -- &1) = &1 <=> -- &1 < &0 ==> EVEN n [15] by REPEAT COND_CASES_TAC,5 from 10,12; -- &1 pow n = &1 <=> -- &1 < &0 ==> EVEN n [16] by ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE],5 from 15; x pow n = &1 <=> x < &0 ==> EVEN n [17] by FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH (parse_term "abs x = a ==> x = a \\/ x = --a"))),5,7 from 9,16; x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) [18] by ASM_REWRITE_TAC[],5,7 from 17; qed by ALL_TAC,5,7 from 18; ~(abs x = &1) ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n)) [19] proof assume ~(abs x = &1) [20]; qed by ASM_MESON_TAC[REAL_POW_EQ_1_IMP],5,20; :: #2 :: 2: inference time-out qed by ASM_REWRITE_TAC[real_pow],5 from 18; :: #4 :: 4: unknown label qed by ASM_CASES_TAC (parse_term "n = 0") from 2,4;`;; hol-light/miz3/Samples/bug2.ml000066400000000000000000000001471303454263000164260ustar00rootroot00000000000000let FOO = thm `; let P be num->bool; assume !x. P x \/ ~P x; thus (~ ~ ?x. P x) ==> ?x. P x; `;; hol-light/miz3/Samples/bug3.ml000066400000000000000000000000451303454263000164240ustar00rootroot00000000000000 let FOO = thm `; thus T; `;; hol-light/miz3/Samples/drinker.ml000066400000000000000000000017241303454263000172270ustar00rootroot00000000000000horizon := 0;; thm `; assume ?x:A. T [1]; let P be A->bool; thus ?x. P x ==> !y. P y proof (?x. ~P x) \/ ~(?x. ~P x); // LEM cases by -; // \/E suppose ?x. ~P x; consider x such that ~P x [2] by -; // ?E take x; // ?I assume P x; // ==>I F by 2,-; // ~E qed by -; // FE suppose ~(?x. ~P x) [3]; consider x such that (\x:A. T) x by 1; // ?E take x; // ?I assume P x; // ==>I let y be A; // !I P y \/ ~P y; // LEM cases by -; // \/E suppose P y; qed by -; // suppose ~P y; ?y. ~P y proof take y; // ?I qed by -; // F by 3,-; // ~E qed by -; // FE end; end`;; hol-light/miz3/Samples/forster.ml000066400000000000000000000265321303454263000172610ustar00rootroot00000000000000(* ======== translation of "The shortest?" from Examples/forster.ml ======== *) horizon := 0;; let FORSTER_PUZZLE_1 = thm `; let f be num->num; thus (!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n proof assume !n. f(n + 1) > f(f(n)); !n. f(f(n)) < f(SUC n) [1] by -,GT,ADD1; !m n. m <= f(n + m) [2] proof !n. 0 <= f(n + 0) [3] by LE_0,ADD_CLAUSES,LE_SUC_LT; now let m be num; assume !n. m <= f(n + m); !n. m < f(SUC (n + m)) by -,1,LET_TRANS,SUB_ADD; thus !n. SUC m <= f(n + SUC m) by -,LE_0,ADD_CLAUSES,LE_SUC_LT; end; qed by INDUCT_TAC,-,3; !n. f(n) < f(SUC n) [4] by -,1,LET_TRANS,LE_TRANS,ADD_CLAUSES; !m n. f(m) < f(n) ==> m < n proof !n. f(0) < f(n) ==> 0 < n [5] by LT_LE,LE_0,LTE_TRANS,LE_SUC_LT; now let m be num; assume !n. f(m) < f(n) ==> m < n; thus !n. f(SUC m) < f(n) ==> SUC m < n by -,4,LT_LE,LE_0,LTE_TRANS,LE_SUC_LT; end; qed by INDUCT_TAC,-,5; qed by -,1,2,LE_ANTISYM,ADD_CLAUSES,LT_SUC_LE`;; (* ======== long-winded informal proof ===================================== *) (* Suppose that f(f(n)) < f(n + 1) for all n. We want to show that f has to be the identity. We will do this by successively establishing two properties of f (both in a certain sense being "monotonicity of f"): n <= f(n) m < n ==> f(m) < f(n) The first is the harder one to prove. The second is easy, but the proof uses the first. Once we know the second property we know so much about f that the result easily follows. To prove the first, suppose by contradiction that there is a counterexample, so there is an n with f "going backwards", i.e., with f(n) < n. Take such a counterexample with f(n) minimal. (That this minimality is the right one to focus on is the key to the whole proof for me. Of course one can present this proof the other way around -- as an induction -- but the intuition of a descending chain of counterexamples I find much easier to remember.) Now from the relation f(f(n - 1)) < f(n) it seems reasonable to look for an n' with f going backwards that has an image less than f(n). So look at n - 1 |-> f(n - 1) |-> f(f(n - 1)) and distinguish how f(n - 1) compares to f(n). If it's less, then the left mapping goes backward to an image < f(n). (To see that it goes backward, use that f(n) < n, so that f(n) <= n - 1.) If it's not less, then the right mapping goes backward to an image < f(n). In both cases we have a contradiction with the minimality of our choice of n. The second kind of monoticity now follows using a trivial transitivity: f(n) <= f(f(n)) < f(n + 1) This shows that f(n) < f(n + 1) for all n, from with the monotonicity of the whole function directly follows. Finally to show that f has to be the identity, notice that a strictly monotonic function always has the property that n <= f(n) (Of course we knew this already, but I like to just think about the strict monotonicity of f at this point.) However we also can get an upper bound on f(n). A strictly monototic function always has a strictly monotonic inverse, and so from the key property f(f(n)) < f(n + 1) it follows that f(n) < n + 1 Together this means that we have to have that f(n) = n. *) (* ======== formal proof sketch of this proof ============================== *) horizon := -1;; sketch_mode := true;; let FORSTER_PUZZLE_SKETCH = ref None;; FORSTER_PUZZLE_SKETCH := Some `; let f be num->num; assume !n. f(f(n)) < f(n + 1); thus !n. f(n) = n proof !n. n <= f(n) proof assume ~thesis; ?n. f(n) < n; consider n such that f(n) < n /\ !m. f(m) < m ==> f(n) <= f(m); cases; suppose f(n - 1) < f(n); f(n - 1) < n - 1 /\ f(n - 1) < f(n) proof f(n) < n; f(n) <= n - 1; qed; thus F; end; suppose f(n) <= f(n - 1); f(f(n - 1)) < f(n - 1) /\ f(f(n - 1)) < f(n); thus F; end; end; !m n. m < n ==> f(m) < f(n) proof now let n be num; f(n) <= f(f(n)) /\ f(f(n)) < f(n + 1); thus f(n) < f(n + 1); end; qed; let n be num; n <= f(n); !m n. f(m) < f(n) ==> m < n; f(f(n)) < f(n + 1); f(n) < n + 1; thus f(n) = n; end`;; sketch_mode := false;; (* ======== formalization from this formal proof sketch ==================== *) horizon := 1;; let FORSTER_PUZZLE_2 = thm `; let f be num->num; assume !n. f(f(n)) < f(n + 1) [1]; thus !n. f(n) = n proof !n. n <= f(n) [2] proof assume ~thesis; ?n. f(n) < n by NOT_LE; ?fn n. f(n) = fn /\ f(n) < n; consider fn such that (?n. f(n) = fn /\ f(n) < n) /\ !fm. fm < fn ==> ~(?m. f(m) = fm /\ f(m) < m) [3] by REWRITE_TAC,GSYM num_WOP; consider n such that f(n) = fn /\ f(n) < n; f(n) < n /\ !m. f(m) < m ==> f(n) <= f(m) [4] by 3,NOT_LE; cases; suppose f(n - 1) < f(n) [5]; f(n - 1) < n - 1 /\ f(n - 1) < f(n) proof f(n) < n by 4; f(n) <= n - 1 by ARITH_TAC; qed by 5,LTE_TRANS; thus F by 4,NOT_LE; end; suppose f(n) <= f(n - 1) [6]; 0 < n by ARITH_TAC,4; (n - 1) + 1 = n by ARITH_TAC; f(f(n - 1)) < f(n) by 1; f(f(n - 1)) < f(n - 1) /\ f(f(n - 1)) < f(n) by ARITH_TAC,6; thus F by 4,NOT_LE; end; end; !m n. m < n ==> f(m) < f(n) [7] proof now let n be num; f(n) <= f(f(n)) /\ f(f(n)) < f(n + 1) by 1,2; thus f(n) < f(SUC n) by ARITH_TAC; // modified from f(n) < f(n + 1) end; qed by LT_TRANS, SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; let n be num; n <= f(n) [8] by 2; // really should be an induction proof from 7 !m n. f(m) < f(n) ==> m < n [9] by 7,LE_LT,NOT_LE; f(f(n)) < f(n + 1) by 1; f(n) < n + 1 by 9; thus f(n) = n by ARITH_TAC,8; end`;; (* ======== ... and a slightly compressed version ========================== *) horizon := 1;; let FORSTER_PUZZLE_3 = thm `; let f be num->num; assume !n. f(f(n)) < f(n + 1) [1]; !n. n <= f(n) [2] proof assume ~thesis; ?fn n. f(n) = fn /\ f(n) < n by NOT_LE; consider fn such that (?n. f(n) = fn /\ f(n) < n) /\ !fm. fm < fn ==> ~(?m. f(m) = fm /\ f(m) < m) [3] by REWRITE_TAC,GSYM num_WOP; consider n such that f(n) = fn /\ f(n) < n [4]; cases; suppose f(n - 1) < f(n) [5]; f(n - 1) < n - 1 by ARITH_TAC,4; thus F by 3,4,5; end; suppose f(n) <= f(n - 1) [6]; (n - 1) + 1 = n by ARITH_TAC,4; thus F by 1,3,4,6,LTE_TRANS; end; end; !n. f(n) < f(SUC n) by 1,2,ADD1,LET_TRANS; !m n. m < n ==> f(m) < f(n) by LT_TRANS, SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; !m n. f(m) < f(n) ==> m < n by LE_LT,NOT_LE; thus !n. f(n) = n by 1,2,ADD1,LE_ANTISYM,LT_SUC_LE`;; (* ======== Mizar formalization from the formal proof sketch =============== *) (* environ vocabularies RELAT_1, FUNCT_1, ARYTM, ARYTM_1, ORDINAL2; notations ORDINAL1, RELSET_1, FUNCT_2, NUMBERS, XCMPLX_0, XXREAL_0, NAT_1, VALUED_0; constructors XXREAL_0, INT_1, PARTFUN1, VALUED_0, MEMBERED, RELSET_1; registrations XBOOLE_0, RELAT_1, FUNCT_1, ORDINAL1, XXREAL_0, XREAL_0, NAT_1, INT_1, VALUED_0, MEMBERED; requirements NUMERALS, REAL, SUBSET, ARITHM; theorems XXREAL_0, XREAL_1, INT_1, NAT_1, VALUED_0, VALUED_1, FUNCT_2, ORDINAL1; schemes NAT_1; begin reserve n,m,fn,fm for natural number; reserve f for Function of NAT,NAT; theorem (for n holds f.(f.n) < f.(n + 1)) implies for n holds f.n = n proof assume A1: for n holds f.(f.n) < f.(n + 1); A2: for n holds n <= f.n proof assume A3: not thesis; defpred P[Nat] means ex n st f.n < n & f.n = $1; A4: ex fn st P[fn] by A3; consider fn being Nat such that A5: P[fn] & for fm being Nat st P[fm] holds fn <= fm from NAT_1:sch 5(A4); consider n such that A6: f.n < n & f.n = fn by A5; n >= 0 + 1 by A6,NAT_1:13; then n - 1 >= 0 by XREAL_1:21; then n - 1 in NAT by INT_1:16; then reconsider m = n - 1 as natural number; per cases; suppose A7: f.m < f.n; f.n < m + 1 by A6; then f.n <= m by NAT_1:13; then f.m < m by A7,XXREAL_0:2; hence contradiction by A5,A6,A7; end; suppose A8: f.n <= f.m; A9: f.(f.m) < f.(m + 1) by A1; then f.(f.m) < f.m by A8,XXREAL_0:2; hence contradiction by A5,A6,A9; end; end; now let n; f.n <= f.(f.n) & f.(f.n) < f.(n + 1) by A1,A2; hence f.n < f.(n + 1) by XXREAL_0:2; end; then reconsider f as increasing Function of NAT,NAT by VALUED_1:def 13; A10: now let m,n; dom f = NAT & m in NAT & n in NAT by FUNCT_2:def 1,ORDINAL1:def 13; hence f.m < f.n implies m < n by VALUED_0:def 15; end; let n; f.(f.n) < f.(n + 1) by A1; then f.n < n + 1 by A10; then n <= f.n & f.n <= n by A2,NAT_1:13; hence thesis by XXREAL_0:1; end; *) (* ======== miz3 formalization close to the Mizar formalization ============ *) horizon := 0;; let FORSTER_PUZZLE_4 = thm `; !f. (!n. f(f(n)) < f(n + 1)) ==> !n. f(n) = n proof let f be num->num; assume !n. f(f(n)) < f(n + 1) [1]; !n. n <= f(n) [2] proof assume ~thesis [3]; set P = \fn. ?n. f(n) < n /\ f(n) = fn [P]; ?fn. P(fn) [4] by 3,P,NOT_LE; consider fn such that P(fn) /\ !fm. P(fm) ==> fn <= fm [5] by 4,num_WOP,NOT_LE; consider n such that f(n) < n /\ f(n) = fn [6] by P,5; set m = n - 1; n = m + 1 [m] by ARITH_TAC,6; // replaces the reconsider cases; suppose f(m) < f(n) [7]; f(n) < m + 1 by ARITH_TAC,6; f(n) <= m by ARITH_TAC,-; f(m) < m by ARITH_TAC,-,7; f(n) <= f(m) by -,P,5,6; // extra step thus F by ARITH_TAC,-,7; end; suppose f(n) <= f(m) [8]; f(f(m)) < f(m + 1) [9] by 1; f(f(m)) < f(m) by -,m,8,LTE_TRANS; f(n) <= f(f(m)) by -,P,5,6; // extra step thus F by -,m,9,NOT_LE; end; end; now let n be num; f(n) <= f(f(n)) /\ f(f(n)) < f(n + 1) by 1,2; thus f(n) < f(n + 1) by ARITH_TAC,-; end; !n. f(n) < f(SUC n) by -,ADD1; // extra step !m n. m < n ==> f(m) < f(n) by -,LT_TRANS, SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; // replaces the reconsider now [10] let m n be num; thus f(m) < f(n) ==> m < n by -,LE_LT,NOT_LE; end; let n be num; f(f(n)) < f(n + 1) by 1; f(n) < n + 1 by -,10; n <= f(n) /\ f(n) <= n by -,2,ADD1,LT_SUC_LE; thus thesis by ARITH_TAC,-; end`;; (* ======== formalization following Tobias & Sean's version ================ *) horizon := 3;; let num_MONO_LT_SUC = thm `; let f be num->num; assume !n. f(n) < f(SUC n); !n m. m < n ==> f(m) < f(n) by LT_TRANS, SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; thus !n m. m < n <=> f(m) < f(n) by LE_LT,NOT_LE`;; let FORSTER_PUZZLE_5 = thm `; let f be num->num; assume !n. f(f(n)) < f(SUC(n)); !n m. n <= m ==> n <= f(m) proof now let n be num; assume !m. n <= m ==> n <= f(m); !m. SUC n <= m ==> ?k. m = SUC k by num_CASES,LT,LE_SUC_LT; thus !m. SUC n <= m ==> SUC n <= f(m) by LE_SUC,LET_TRANS,LE_SUC_LT; end; !m. 0 <= m ==> 0 <= f(m); qed by INDUCT_TAC; !n. f(n) < f(SUC n) by LE_REFL,LET_TRANS; thus !n. f(n) = n by num_MONO_LT_SUC,LT_SUC_LE,LE_ANTISYM`;; hol-light/miz3/Samples/icms.ml000066400000000000000000000150651303454263000165270ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* From Multivariate/misc.ml *) (* ------------------------------------------------------------------------- *) prioritize_real();; let REAL_POW_LBOUND = prove (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; let REAL_ARCH_POW = prove (`!x y. &1 < x ==> ?n. y < x pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 + &n * (x - &1)` THEN ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH `&1 < x ==> &0 <= x - &1`]);; let ABS_CASES = thm `; !x. x = &0 \/ &0 < abs(x)`;; let LL = REAL_ARITH `&1 < k ==> &0 < k`;; (* ------------------------------------------------------------------------- *) (* Miz3 solutions to IMO problem from ICMS 2006. *) (* ------------------------------------------------------------------------- *) horizon := 0;; let IMO_1 = thm `; !k. &1 < k ==> &0 < k [LL] by REAL_ARITH; now let f g be real->real; let x be real; assume !x y. f (x + y) + f (x - y) = &2 * f x * g y [1]; assume ~(!x. f x = &0) [2]; assume !x. abs (f x) <= &1 [3]; now let k be real; assume sup (IMAGE (\x. abs (f x)) (:real)) = k [4]; ~(IMAGE (\x. abs (f x)) (:real) = {}) /\ (?b. !x. abs (f x) <= b) [5] by ASM SET_TAC[],-,3; now assume !x. abs (f x) <= k [6]; assume !b. (!x. abs (f x) <= b) ==> k <= b [7]; now let y be real; assume &1 < abs (g y) [8]; !x. abs (f x) <= k / abs (g y) [9] by ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_ABS_MUL; LL; REAL_ARITH (parse_term "u + v = &2 * z /\\ abs u <= k /\\ abs v <= k ==> abs z <= k") ],-,1,6; ~(k <= k / abs (g y)) by TIMED_TAC 2 (ASM_MESON_TAC[REAL_NOT_LE; REAL_LT_LDIV_EQ; REAL_LT_LMUL; REAL_MUL_RID; LL; REAL_ARITH (parse_term "~(z = &0) /\\ abs z <= k ==> &0 < k") ]),LL,2,6,8; (!x. abs (f x) <= k / abs (g y)) /\ ~(k <= k / abs (g y)) by CONJ_TAC,-,9; ((!x. abs (f x) <= k / abs (g y)) ==> k <= k / abs (g y)) ==> F by SIMP_TAC[NOT_IMP; NOT_FORALL_THM],-; thus F by FIRST_X_ASSUM(MP_TAC o SPEC (parse_term "k / abs(g(y:real))")),-,7; end; ~(?y. &1 < abs (g y)) by STRIP_TAC,-; thus !y. abs (g y) <= &1 by SIMP_TAC[GSYM REAL_NOT_LT; GSYM NOT_EXISTS_THM],-; end; (!x. abs (f x) <= k) /\ (!b. (!x. abs (f x) <= b) ==> k <= b) ==> (!y. abs (g y) <= &1) by STRIP_TAC,-; (~(IMAGE (\x. abs (f x)) (:real) = {}) /\ (?b. !x. abs (f x) <= b) ==> (!x. abs (f x) <= k) /\ (!b. (!x. abs (f x) <= b) ==> k <= b)) ==> (!y. abs (g y) <= &1) by ANTS_TAC,-,5; (~(IMAGE (\x. abs (f x)) (:real) = {}) /\ (?b. !x. x IN IMAGE (\x. abs (f x)) (:real) ==> x <= b) ==> (!x. x IN IMAGE (\x. abs (f x)) (:real) ==> x <= sup (IMAGE (\x. abs (f x)) (:real))) /\ (!b. (!x. x IN IMAGE (\x. abs (f x)) (:real) ==> x <= b) ==> sup (IMAGE (\x. abs (f x)) (:real)) <= b)) ==> (!y. abs (g y) <= &1) by ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_UNIV],-,4; thus !y. abs (g y) <= &1 by MP_TAC(SPEC (parse_term "IMAGE (\\x. abs(f(x))) (:real)") SUP),-; end; !y. abs (g y) <= &1 by ABBREV_TAC (parse_term "k = sup (IMAGE (\\x. abs(f(x))) (:real))"),-; thus abs (g x) <= &1 by SPEC_TAC ((parse_term "x:real"),(parse_term "y:real")),-; end; thus !f g. (!x y. f(x + y) + f(x - y) = &2 * f(x) * g(y)) /\ ~(!x. f(x) = &0) /\ (!x. abs(f(x)) <= &1) ==> !x. abs(g(x)) <= &1 by REPEAT STRIP_TAC,-`;; horizon := 1;; let IMO_2 = thm `; let f g be real->real; assume !x y. f (x + y) + f (x - y) = &2 * f x * g y [1]; assume ~(!x. f x = &0) [2]; assume !x. abs (f x) <= &1 [3]; thus !x. abs (g x) <= &1 proof set s = IMAGE (\x. abs (f x)) (:real); ~(s = {}) [4] by SET_TAC; !b. (!y. y IN s ==> y <= b) <=> (!x. abs (f x) <= b) by IN_IMAGE,IN_UNIV; set k = sup s; (!x. abs (f x) <= k) /\ !b. (!x. abs (f x) <= b) ==> k <= b [5] by 3,4,SUP; assume ~thesis; consider y such that &1 < abs (g y) [6] by REAL_NOT_LT; &0 < abs (g y) [7] by REAL_ARITH; !x. abs (f x) <= k / abs (g y) [8] proof let x be real; abs (f (x + y)) <= k /\ abs (f (x - y)) <= k /\ f (x + y) + f (x - y) = &2 * f x * g y by 1,5; abs (f x * g y) <= k by REAL_ARITH; qed by 7,REAL_ABS_MUL,REAL_LE_RDIV_EQ; consider x such that &0 < abs (f x) /\ abs (f x) <= k by 2,5,ABS_CASES; &0 < k by REAL_ARITH; k / abs (g y) < k by 6,7,REAL_LT_LMUL,REAL_MUL_RID,REAL_LT_LDIV_EQ; qed by 5,8,REAL_NOT_LE`;; let IMO_3 = thm `; let f g be real->real; assume !x y. f (x + y) + f (x - y) = &2 * f x * g y [1]; assume ~(!x. f x = &0) [2]; assume !x. abs (f x) <= &1 [3]; thus !x. abs (g x) <= &1 proof now [4] let y be real; !x. abs (f x * g y pow 0) <= &1 [5] by 3,real_pow,REAL_MUL_RID; now let l be num; assume !x. abs (f x * g y pow l) <= &1; let x be real; abs (f (x + y) * g y pow l) <= &1 /\ abs (f (x - y) * g y pow l) <= &1; abs ((f (x + y) + f (x - y)) * g y pow l) <= &2 by REAL_ARITH; abs ((&2 * f x * g y) * g y pow l) <= &2 by 1; abs (f x * g y * g y pow l) <= &1 by REAL_ARITH; thus abs (f x * g y pow SUC l) <= &1 by real_pow,REAL_MUL_RID; end; thus !l x. abs (f x * g y pow l) <= &1 by INDUCT_TAC,5; end; !x y. ~(x = &0) /\ &1 < abs(y) ==> ?n. &1 < abs(y pow n * x) by SIMP_TAC,REAL_ABS_MUL,REAL_ABS_POW,GSYM REAL_LT_LDIV_EQ, GSYM REAL_ABS_NZ,REAL_ARCH_POW; qed by 2,4,REAL_NOT_LE,REAL_MUL_SYM`;; hol-light/miz3/Samples/irrat2.ml000066400000000000000000000112571303454263000167760ustar00rootroot00000000000000needs "Library/transc.ml";; needs "Examples/sos.ml";; prioritize_real();; horizon := 1;; let rational = new_definition `rational(r) = ?p q. ~(q = 0) /\ abs(r) = &p/ &q`;; (* ======== Mizar-style version ============================================ *) let NSQRT_2_1 = thm `; !p q. p*p = 2*q*q ==> q = 0 proof exec MATCH_MP_TAC num_WF; let p be num; assume !p'. p' < p ==> !q. p'*p' = 2*q*q ==> q = 0 [1]; let q be num; assume p*p = 2*q*q [2]; EVEN (p*p) by EVEN_DOUBLE; EVEN p by EVEN_MULT; consider p' such that p = 2*p' [3] by EVEN_EXISTS; q*q = 2*p'*p' [4] by 2,NUM_RING; EVEN (q*q) by EVEN_DOUBLE; EVEN q by EVEN_MULT; consider q' such that q = 2*q' [5] by EVEN_EXISTS; p'*p' = 2*q'*q' [6] by 4,NUM_RING; assume ~(q = 0) [7]; ~(p = 0) by 2,NUM_RING; p > 0 by ARITH_TAC; p' < p by 3,ARITH_TAC; q' = 0 by 1,6; qed by 5,7,MULT_EQ_0`;; let SQRT_2_IRRATIONAL_1 = thm `; ~rational(sqrt(&2)) proof assume rational(sqrt(&2)); set x = abs(sqrt(&2)); consider p q such that ~(q = 0) /\ x = &p/ &q [7] by rational; ~(&q = &0) by REAL_INJ; x* &q = &p [8] by 7,REAL_DIV_RMUL; &0 <= &2 by REAL_ARITH_TAC; sqrt(&2) pow 2 = &2 by SQRT_POW2; x pow 2 = &2 by REAL_ARITH_TAC; &p* &p = &2* &q* &q by 8,REAL_RING; p*p = 2*q*q by 8,REAL_INJ,REAL_OF_NUM_MUL; qed by 7,NSQRT_2_1`;; (* ======== "automatically" converted from John's version ================== *) let NSQRT_2_2 = thm `; now now let p q be num; assume !m q. m < p ==> m * m = 2 * q * q ==> q = 0 [1]; assume p * p = 2 * q * q [2]; now let m be num; assume !m' q. m' < 2 * m ==> m' * m' = 2 * q * q ==> q = 0 [3]; assume (2 * m) * 2 * m = 2 * q * q [4]; (2 * m) * 2 * m = 2 * q * q ==> (q < 2 * m ==> q * q = 2 * m * m ==> m = 0) ==> q = 0 by TIMED_TAC 2 (CONV_TAC SOS_RULE); (q < 2 * m ==> q * q = 2 * m * m ==> m = 0) ==> q = 0 by POP_ASSUM MP_TAC,4 from -; thus q = 0 by FIRST_X_ASSUM (MP_TAC o SPECL [parse_term "q:num"; parse_term "m:num"]),3,4; end; (?m. p = 2 * m) ==> q = 0 by DISCH_THEN(X_CHOOSE_THEN (parse_term "m:num") SUBST_ALL_TAC),1,2; EVEN p ==> q = 0 by REWRITE_TAC[EVEN_EXISTS],1,2; (EVEN (p * p) <=> EVEN (2 * q * q)) ==> q = 0 by REWRITE_TAC[EVEN_MULT; ARITH],1,2; thus q = 0 by FIRST_ASSUM(MP_TAC o AP_TERM (parse_term "EVEN")),1,2; end; !p q. (!m q. m < p ==> m * m = 2 * q * q ==> q = 0) ==> p * p = 2 * q * q ==> q = 0 by REPEAT STRIP_TAC; !p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) ==> (!q. p * p = 2 * q * q ==> q = 0) by REWRITE_TAC[RIGHT_IMP_FORALL_THM]; thus !p q. p * p = 2 * q * q ==> q = 0 by MATCH_MP_TAC num_WF; end`;; let SQRT_2_IRRATIONAL_2 = thm `; now now let p q be num; now assume ~(q = 0) [1]; ~(&2 * &q * &q = &p * &p) by ASM_MESON_TAC[NSQRT_2_2; REAL_OF_NUM_EQ; REAL_OF_NUM_MUL]; ~((\x. x pow 2) (sqrt (&2)) = (\x. x pow 2) (&p / &q)) by ASM_SIMP_TAC[SQRT_POW_2; REAL_POS; REAL_POW_DIV; REAL_POW_2; REAL_LT_SQUARE; REAL_OF_NUM_EQ; REAL_EQ_RDIV_EQ],1; thus ~(sqrt (&2) = &p / &q) by DISCH_THEN(MP_TAC o AP_TERM (parse_term "\\x. x pow 2")),1; end; thus ~(~(q = 0) /\ sqrt (&2) = &p / &q) by DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC); end; !p q. ~(~(q = 0) /\ sqrt (&2) = &p / &q) by REPEAT GEN_TAC; thus ~rational (sqrt (&2)) by SIMP_TAC[rational; real_abs; SQRT_POS_LE; REAL_POS; NOT_EXISTS_THM]; end`;; (* ======== humanized version of John's version ============================ *) let NSQRT_2_3 = thm `; !p q. p*p = 2*q*q ==> q = 0 proof set P = \p. !q. p*p = 2*q*q ==> q = 0; now let p be num; assume !m. m < p ==> P m [1]; let q be num; assume p*p = 2*q*q [2]; EVEN(2*q*q) by REWRITE_TAC,EVEN_MULT,ARITH; EVEN p by 2,EVEN_MULT; consider m such that p = 2*m [3] by EVEN_EXISTS; (2*m)*2*m = 2*q*q /\ (q < 2*m /\ q*q = 2*m*m ==> m = 0) ==> q = 0 from TIMED_TAC 2 (CONV_TAC SOS_RULE); thus q = 0 by 1,2,3; end; qed by MATCH_MP_TAC num_WF`;; let SQRT_2_IRRATIONAL_3 = thm `; ~rational(sqrt(&2)) proof assume rational(sqrt(&2)); consider p q such that ~(q = 0) /\ sqrt(&2) = &p/ &q [1] by rational,real_abs,SQRT_POS_LE,REAL_POS; (&p* &p)/(&q* &q) = &2 [2] by SQRT_POW_2,REAL_POS,REAL_POW_DIV,REAL_POW_2; &0 < &q* &q by 1,REAL_LT_SQUARE,REAL_OF_NUM_EQ; &2*(&q* &q) = (&p* &p) by 2,REAL_EQ_RDIV_EQ; qed by 1,NSQRT_2_3,REAL_OF_NUM_EQ,REAL_OF_NUM_MUL`;; hol-light/miz3/Samples/lagrange.ml000066400000000000000000000266131303454263000173550ustar00rootroot00000000000000needs "Library/prime.ml";; let group = new_definition `group(g,(**),i,(e:A)) <=> (e IN g) /\ (!x. x IN g ==> i(x) IN g) /\ (!x y. x IN g /\ y IN g ==> x**y IN g) /\ (!x y z. x IN g /\ y IN g /\ z IN g ==> x**(y**z) = (x**y)**z) /\ (!x. x IN g ==> x**e = x /\ e**x = x) /\ (!x. x IN g ==> x**i(x) = e /\ i(x)**x = e)`;; let subgroup = new_definition `subgroup h (g,(**),i,(e:A)) <=> h SUBSET g /\ group(h,(**),i,e)`;; let bijection = new_definition `bijection f s t <=> ?g. (!x:A. x IN s ==> f x IN t /\ g (f x) = x) /\ (!y:B. y IN t ==> g y IN s /\ f (g y) = y)`;; parse_as_infix("PARTITIONS",(12,"right"));; let PARTITIONS = new_definition `X PARTITIONS s <=> UNIONS X = (s:A->bool) /\ !t u. t IN X /\ u IN X /\ ~(t = u) ==> t INTER u = {}`;; parse_as_infix("**",(20,"left"));; parse_as_infix("***",(20,"left"));; horizon := -1;; let LAGRANGE_SKETCH = ref None;; LAGRANGE_SKETCH := Some `; let H G be A->bool; let (**) be A->A->A; let i be A->A; let e be A; assume FINITE H /\ group (H,(**),i,e:A) /\ subgroup G (H,(**),i,e); consider (***) such that !h G. h***G = {h**g | g IN G}; // now let a be A; assume a IN H; let b be A; assume b IN H; assume i(a)**b IN G; b***G = a**i(a)**b***G; .= a***(i(a)**b***G); thus .= a***G; end; !a b. a IN H /\ b IN H /\ ~(a***G = b***G) ==> a***G INTER b***G = {} proof let a be A; assume a IN H; let b be A; assume b IN H; now assume ~(a***G INTER b***G = {}); consider g1 g2 such that g1 IN G /\ g2 IN G /\ a**g1 = b**g2; g1**i(g2) = i(a)**b; i(a)**b IN G; thus a***G = b***G; end; qed; !a. a IN H ==> a IN a***G proof let a be A; assume a IN H; a**e = a; qed; {a***G | a IN H} PARTITIONS H; !a b. a IN H /\ b IN H ==> CARD (a***G) = CARD (b***G) proof let a be A; assume a IN H; let b be A; assume b IN H; consider f such that !g. g IN G ==> f(a**g) = b**g; bijection f (a***G) (b***G); qed; set INDEX = CARD {a***G | a IN H}; set N = CARD H; set n = CARD G; set j = INDEX; N = j*n; thus CARD G divides CARD H; // `;; LAGRANGE_SKETCH := Some `; let H G be A->bool; let (**) be A->A->A; let i be A->A; let e be A; assume FINITE H /\ group (H,(**),i,e:A) /\ subgroup G (H,(**),i,e); consider (***) such that !h G. h***G = {h**g | g IN G}; :: #2 :: 2: inference time-out // now let a be A; assume a IN H; let b be A; assume b IN H; assume i(a)**b IN G; b***G = a**i(a)**b***G; .= a***(i(a)**b***G); thus .= a***G; :: #2 #2 #2 end; !a b. a IN H /\ b IN H /\ ~(a***G = b***G) ==> a***G INTER b***G = {} proof let a be A; assume a IN H; let b be A; assume b IN H; now assume ~(a***G INTER b***G = {}); consider g1 g2 such that g1 IN G /\ g2 IN G /\ a**g1 = b**g2; :: #2 g1**i(g2) = i(a)**b; :: #2 i(a)**b IN G; :: #2 thus a***G = b***G; end; qed; !a. a IN H ==> a IN a***G proof let a be A; assume a IN H; a**e = a; :: #1 :: 1: inference error qed; :: #2 {a***G | a IN H} PARTITIONS H; :: #2 !a b. a IN H /\ b IN H ==> CARD (a***G) = CARD (b***G) proof let a be A; assume a IN H; let b be A; assume b IN H; consider f such that !g. g IN G ==> f(a**g) = b**g; :: #2 bijection f (a***G) (b***G); :: #2 qed; :: #2 set INDEX = CARD {a***G | a IN H}; set N = CARD H; set n = CARD G; set j = INDEX; N = j*n; :: #2 thus CARD G divides CARD H; :: #2 // `;; horizon := 3;; let UNIONS_FINITE = thm `; !s. FINITE (UNIONS s) <=> FINITE s /\ !t:A->bool. t IN s ==> FINITE t proof let s be (A->bool)->bool; now assume FINITE (UNIONS s) [1]; now let t be A->bool; assume t IN s; now let x be A; assume x IN t; ?t. t IN s /\ x IN t; thus x IN UNIONS s by ALL_TAC,UNIONS,IN_ELIM_THM; end; thus t IN {t | t SUBSET UNIONS s} by SUBSET,IN_ELIM_THM; end; s SUBSET {t | t SUBSET UNIONS s} by REWRITE_TAC,SUBSET; FINITE {t | t SUBSET UNIONS s} by 1,FINITE_POWERSET; thus FINITE s by FINITE_SUBSET; end; qed by FINITE_UNIONS`;; let CARD_UNIONS_EQUAL = thm `; !X s n. FINITE s /\ X PARTITIONS s /\ (!t:A->bool. t IN X ==> CARD t = n) ==> CARD s = (CARD X)*n proof let X be (A->bool)->bool; let s be A->bool; let n be num; assume FINITE s; assume X PARTITIONS s [1]; assume !t. t IN X ==> CARD t = n [2]; FINITE (UNIONS X) by PARTITIONS; !t. t IN X ==> FINITE t [3] by UNIONS_FINITE; FINITE X [4] by UNIONS_FINITE; !t. t IN X ==> CARD t = (\t. n) t [5] by 2; !t u. t IN X /\ u IN X /\ ~(t = u) ==> t INTER u = {} by 1,PARTITIONS; CARD s = CARD (UNIONS X) by 1,PARTITIONS; .= nsum X CARD by 2,3,4,CARD_UNIONS; .= nsum X (\t. n) by 5,NSUM_EQ; qed by 4,NSUM_CONST`;; let BIJECTION_CARD_EQ = thm `; let f be A->B; let s be A->bool; let t be B->bool; assume FINITE s /\ bijection f s t [1]; ?g. (!x. x IN s ==> f x IN t /\ g (f x) = x) /\ (!y. y IN t ==> g y IN s /\ f (g y) = y) by REWRITE_TAC,-,GSYM bijection; thus CARD s = CARD t by -,1,BIJECTIONS_CARD_EQ`;; horizon := 0;; let LAGRANGE = thm `; let H G be A->bool; let (**) be A->A->A; let i be A->A; let e be A; assume FINITE H /\ group (H,(**),i,e) /\ subgroup G (H,(**),i,e) [1]; (e IN H) /\ (!x. x IN H ==> i(x) IN H) /\ (!x y. x IN H /\ y IN H ==> x**y IN H) /\ (!x y z. x IN H /\ y IN H /\ z IN H ==> x**(y**z) = (x**y)**z) /\ (!x. x IN H ==> x**e = x /\ e**x = x) /\ (!x. x IN H ==> x**i(x) = e /\ i(x)**x = e) [2] by REWRITE_TAC,1,GSYM group; (G SUBSET H) /\ group (G,(**),i,e) [3] by 1,subgroup; !x. x IN G ==> x IN H [4] by -,SUBSET; FINITE G [5] by 3,1,FINITE_SUBSET; (e IN G) /\ (!x. x IN G ==> i(x) IN G) /\ (!x y. x IN G /\ y IN G ==> x**y IN G) /\ (!x y z. x IN G /\ y IN G /\ z IN G ==> x**(y**z) = (x**y)**z) /\ (!x. x IN G ==> x**e = x /\ e**x = x) /\ (!x. x IN G ==> x**i(x) = e /\ i(x)**x = e) [6] by REWRITE_TAC,3,GSYM group; set (***) = \h G. {h**g | g IN G} [7]; !x h G. x IN h***G <=> ?g. g IN G /\ x = h**g [8] by ALL_TAC,-,IN_ELIM_THM; !h1 h2. h1 IN H /\ h2 IN H ==> (h1**h2)***G = h1***(h2***G) [9] proof let h1 h2 be A; assume h1 IN H /\ h2 IN H [10]; now [11] let x be A; assume x IN (h1**h2)***G; consider g such that g IN G /\ x = (h1**h2)**g [12] by -,8; g IN H by -,4; x = h1**(h2**g) [13] by -,2,10,12; h2**g IN h2***G by 8,12; thus x IN h1***(h2***G) by -,13,8; end; now let x be A; assume x IN h1***(h2***G); consider y such that y IN h2***G /\ x = h1**y [14] by -,8; consider g such that g IN G /\ y = h2**g [15] by -,8; g IN H [16] by -,4; x = h1**(h2**g) by 14,15; .= (h1**h2)**g by -,2,10,14,16; thus x IN (h1**h2)***G by -,8,15; end; qed by -,11,EXTENSION; !g. g IN G ==> g***G = G [17] proof let g be A; assume g IN G [18]; now [19] let x be A; assume x IN g***G; consider g' such that g' IN G /\ x = g**g' by -,8; thus x IN G by -,6,18; end; now let x be A; assume x IN G [20]; x = g**i(g)**x by -,6,18; .= g**(i(g)**x) [21] by -,6,18,20; i(g)**x IN G by 6,18,20; thus x IN g***G by -,21,8; end; qed by -,19,EXTENSION; // now [22] let a be A; assume a IN H [23]; let b be A; assume b IN H [24]; i(a)**b IN H [25] by 2,23,24; assume i(a)**b IN G [26]; b***G = e**b***G by 2,24; .= a**i(a)**b***G by -,2,23; .= a**(i(a)**b)***G by -,2,23,24; .= a***(i(a)**b***G) by -,9,23,25; thus .= a***G by -,17,26; end; !a b. a IN H /\ b IN H /\ ~(a***G = b***G) ==> a***G INTER b***G = {} [27] proof let a be A; assume a IN H [28]; let b be A; assume b IN H [29]; now assume ~(a***G INTER b***G = {}); consider x such that x IN a***G INTER b***G by -,MEMBER_NOT_EMPTY; x IN a***G /\ x IN b***G [30] by -,IN_INTER; consider g1 such that g1 IN G /\ x = a**g1 [31] by 8,30; consider g2 such that g2 IN G /\ x = b**g2 [32] by 8,30; g1 IN H /\ g2 IN H [33] by 4,31,32; a**g1 = b**g2 [34] by 31,32; g1**i(g2) = e**g1**i(g2) by 2,33; .= (i(a)**a)**g1**i(g2) by -,2,28; .= i(a)**(a**g1)**i(g2) by -,2,28,33; .= i(a)**(b**g2)**i(g2) by -,34; .= i(a)**(b**g2**i(g2)) by -,2,28,29,33; .= i(a)**(b**(g2**i(g2))) by -,2,29,33; .= i(a)**(b**e) by -,2,33; .= i(a)**b by -,2,29; i(a)**b IN G by -,6,31,32; thus a***G = b***G by -,22,28,29; end; qed by -,28,29; !a. a IN H ==> a IN a***G [35] proof let a be A; assume a IN H; a**e = a by -,2; qed by -,6,8; now now [36] let x be A; assume x IN UNIONS {a***G | a IN H}; consider s such that s IN {a***G | a IN H} /\ x IN s [37] by -,IN_UNIONS; consider a such that a IN H /\ s = a***G [38] by -; consider g such that g IN G /\ x = a**g by -,8,37; thus x IN H by -,2,4,38; end; now let x be A; assume x IN H; x IN x***G /\ x***G IN {a***G | a IN H} by -,35; thus x IN UNIONS {a***G | a IN H} by -,IN_UNIONS; end; thus UNIONS {a***G | a IN H} = H by -,36,EXTENSION; let t u be A->bool; assume t IN {a***G | a IN H} /\ u IN {a***G | a IN H} /\ ~(t = u) [39]; consider a b such that a IN H /\ t = a***G /\ b IN H /\ t = b***G by -; thus t INTER u = {} by -,27,39; end; {a***G | a IN H} PARTITIONS H [40] by REWRITE_TAC,-,PARTITIONS; !a b. a IN H /\ b IN H ==> CARD (a***G) = CARD (b***G) [41] proof let a be A; assume a IN H [42]; let b be A; assume b IN H [43]; set f = \x. b**(i(a)**x); set f' = \x. a**(i(b)**x); !g. g IN G ==> f(a**g) = b**g /\ f'(b**g) = a**g [44] proof let g be A; assume g IN G; g IN H [45] by -,4; f(a**g) = b**(i(a)**(a**g)); .= b**(i(a)**a**g) by -,2,42,45; .= b**(e**g) by -,2,42; .= b**g [46] by -,2,45; f'(b**g) = a**(i(b)**(b**g)); .= a**(i(b)**b**g) by -,2,43,45; .= a**(e**g) by -,2,43; .= a**g by -,2,45; qed by -,46; now take f'; thus !x. x IN a***G ==> f x IN b***G /\ f' (f x) = x proof let x be A; assume x IN a***G; consider g such that g IN G /\ x = a**g [47] by -,8; f x = b**g by -,44; qed by -,8,44,47; thus !y. y IN b***G ==> f' y IN a***G /\ f (f' y) = y proof let y be A; assume y IN b***G; consider g such that g IN G /\ y = b**g [48] by -,8; f' y = a**g by -,44; qed by -,8,44,48; end; bijection f (a***G) (b***G) [49] by ALL_TAC,-,bijection; FINITE {a**g | g IN G} by SIMP_TAC,5,SIMPLE_IMAGE,FINITE_IMAGE; qed by -,7,49,BIJECTION_CARD_EQ; set INDEX = CARD {a***G | a IN H}; now let t be A->bool; assume t IN {a***G | a IN H}; consider a such that a IN H /\ t = a***G [50] by -; CARD t = CARD (a***G) by -; .= CARD (e***G) by -,2,41,50; thus .= CARD G by -,6,17; end; set N = CARD H; set n = CARD G; set j = INDEX; N = (CARD {a***G | a IN H})*(CARD G) by -,1,40,CARD_UNIONS_EQUAL; .= j*n by -; thus CARD G divides CARD H by -,divides,MULT_SYM; // `;; parse_as_infix("**",(20,"right"));; hol-light/miz3/Samples/lagrange1.ml000066400000000000000000000376031303454263000174370ustar00rootroot00000000000000needs "Library/prime.ml";; parse_as_infix("**",(20,"right"));; let group = new_definition `group(g,(**),i,(e:A)) <=> (e IN g) /\ (!x. x IN g ==> i(x) IN g) /\ (!x y. x IN g /\ y IN g ==> x**y IN g) /\ (!x y z. x IN g /\ y IN g /\ z IN g ==> x**(y**z) = (x**y)**z) /\ (!x. x IN g ==> x**e = x /\ e**x = x) /\ (!x. x IN g ==> x**i(x) = e /\ i(x)**x = e)`;; let subgroup = new_definition `subgroup h (g,(**),i,(e:A)) <=> h SUBSET g /\ group(h,(**),i,e)`;; (* ======== translation of John's proof ==================================== *) horizon := 1;; let GROUP_LAGRANGE_COSETS = thm `; !g h (**) i e. group(g,(**),i,e:A) /\ subgroup h (g,(**),i,e) /\ FINITE g ==> ?q. CARD g = CARD q * CARD h /\ !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x proof exec REWRITE_TAC[group; subgroup; SUBSET]; let g h be A->bool; let (**) be A->A->A; let i be A->A; let e be A; assume e IN g; assume !x. x IN g ==> i(x) IN g [1]; assume !x y. x IN g /\ y IN g ==> x**y IN g [2]; assume !x y z. x IN g /\ y IN g /\ z IN g ==> x**(y**z) = (x**y)**z [3]; assume !x. x IN g ==> x**e = x /\ e**x = x [4]; assume !x. x IN g ==> x**i(x) = e /\ i(x)**x = e [5]; assume !x. x IN h ==> x IN g [6]; assume e IN h [7]; assume !x. x IN h ==> i(x) IN h [8]; assume !x y. x IN h /\ y IN h ==> x**y IN h [9]; assume !x y z. x IN h /\ y IN h /\ z IN h ==> x**(y**z) = (x**y)**z; assume !x. x IN h ==> x**e = x /\ e**x = x [10]; assume !x. x IN h ==> x**i(x) = e /\ i(x)**x = e [11]; assume FINITE g [12]; set coset = \a. {b | b IN g /\ ?x. x IN h /\ b = a**x} [coset]; !a. coset a = {b' | b' IN g /\ ?x. x IN h /\ b' = a**x} [13]; !a. a IN g ==> a IN coset a [14] proof let a be A; assume a IN g [15]; ?x. x IN h /\ a = a**x by 4,7; qed by SIMP_TAC,13,15,IN_ELIM_THM; FINITE h [16] by 6,12,FINITE_SUBSET,SUBSET; !a. FINITE (coset a) proof let a be A; ?t. FINITE t /\ coset a SUBSET t proof take g; qed by SIMP_TAC,12,13,IN_ELIM_THM,SUBSET; qed by MATCH_MP_TAC,FINITE_SUBSET; !a x y. a IN g /\ x IN g /\ y IN g /\ a**x = a**y ==> x = y [17] proof let a x y be A; assume a IN g /\ x IN g /\ y IN g /\ a**x = a**y [18]; (i(a)**a)**x = (i(a)**a)**y by 1,3; e**x = e**y by 5,18; qed by 4,18; !a. a IN g ==> CARD (coset a) = CARD h proof let a be A; assume a IN g [19]; coset a = IMAGE (\x. a**x) h [20] proof !x. x IN g /\ (?x'. x' IN h /\ x = a**x') <=> ?x'. x = a**x' /\ x' IN h by 2,6; qed by REWRITE_TAC,13,EXTENSION,IN_IMAGE,IN_ELIM_THM; (!x y. x IN h /\ y IN h /\ a**x = a**y ==> x = y) /\ FINITE h by 6,16,17,19; CARD (IMAGE (\x. a**x) h) = CARD h by MATCH_MP_TAC,CARD_IMAGE_INJ; qed by 20; !x y. x IN g /\ y IN g ==> i(x**y) = i(y)**i(x) [21] proof let x y be A; assume x IN g /\ y IN g [22]; ?a. a IN g /\ i(x**y) IN g /\ i(y)**i(x) IN g /\ a**i(x**y) = a**i(y)**i(x) proof take x**y; e = x**(y**i(y))**i(x) by 1,4,5,22; .= ((x**y)**i(y))**i(x) by 1,2,3,22; qed by SIMP_TAC,1,2,3,5,22; qed by 17; !x. x IN g ==> i(i(x)) = x [23] proof let x be A; assume x IN g; ?a. a IN g /\ i(i(x)) IN g /\ x IN g /\ a**i(i(x)) = a**x proof take i(x); qed by 1,5; qed by MATCH_MP_TAC,17; !a b. a IN g /\ b IN g ==> coset a = coset b \/ coset a INTER coset b = {} proof let a b be A; assume a IN g /\ b IN g [24]; cases; suppose i(b)**a IN h [25]; now let x be A; !x. x IN h ==> b**(i(b)**a)**x = a**x /\ a**i(i(b)**a)**x = b**x by SIMP_TAC,1,3,4,5,6,21,23,24; thus x IN g /\ (?x'. x' IN h /\ x = a**x') <=> x IN g /\ (?x'. x' IN h /\ x = b**x') by 8,9,25; end; coset a = coset b by REWRITE_TAC,13,EXTENSION,IN_ELIM_THM; qed; suppose ~(i(b)**a IN h) [26]; now let x be A; assume x IN g /\ (?y. y IN h /\ x = a**y) /\ (?z. z IN h /\ x = b**z); consider y z such that y IN h /\ x = a**y /\ z IN h /\ x = b**z [27]; (i(b)**a)**y = i(b)**a**y by 1,3,6,24,27; .= i(b)**b**z by 27; .= e**z by 1,3,5,6,24,27; .= z by 10,27; z**i(y) = ((i(b)**a)**y)**i(y); .= (i(b)**a)**y**i(y) by 1,2,3,5,6,24,27; .= (i(b)**a)**e by 11,27; .= i(b)**a by 1,2,4,24; thus F by 8,9,26,27; end; !x. ~((x IN g /\ ?y. y IN h /\ x = a**y) /\ (x IN g /\ ?z. z IN h /\ x = b**z)); coset a INTER coset b = {} by REWRITE_TAC,13,EXTENSION,NOT_IN_EMPTY,IN_INTER,IN_ELIM_THM; qed; end; set q = {c | ?a. a IN g /\ c = (@)(coset a)} [q] [28]; take q; !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x [29] proof let b be A; assume b IN g [30]; set C = (@)(coset b) [C] [31]; take C; (@)(coset b) IN {c | ?a. a IN g /\ c = (@)(coset a)} by 30; thus C IN q by q,C; C IN coset b by 14,30,C,IN,SELECT_AX; C IN {b' | b' IN g /\ ?x. x IN h /\ b' = b**x} by 13; consider c such that C IN g /\ c IN h /\ C = b**c [32]; take i(c); (b**c)**i(c) = b**c**i(c) by 1,3,6,30; .= b by 1,4,5,6,30,32; qed by 8,32; !a b. a IN g /\ b IN g /\ a IN coset b ==> b IN coset a [33] proof let a b be A; a IN g /\ b IN g /\ a IN g /\ (?x. x IN h /\ a = b**x) ==> b IN g /\ (?x. x IN h /\ b = a**x) proof assume a IN g /\ b IN g /\ a IN g /\ ?x. x IN h /\ a = b**x [34]; thus b IN g; consider c such that c IN h /\ a = b**c by 34; take i(c); qed by 3,4,6,8,11,34; qed by REWRITE_TAC,13,IN_ELIM_THM; !a b c. a IN coset b /\ b IN coset c /\ c IN g ==> a IN coset c [35] proof let a b c be A; now assume (a IN g /\ ?x. x IN h /\ a = b**x) /\ (b IN g /\ ?x. x IN h /\ b = c**x) /\ c IN g [36]; consider x x' such that x IN h /\ a = b**x /\ x' IN h /\ b = c**x'; thus a IN g /\ ?x. x IN h /\ a = c**x by 3,6,9,36; end; qed by REWRITE_TAC,13,IN_ELIM_THM; !a b. a IN coset b ==> a IN g [37] proof let a b be A; a IN g /\ (?x. x IN h /\ a = b**x) ==> a IN g; qed by REWRITE_TAC,13,IN_ELIM_THM; !a b. a IN coset b /\ b IN g ==> coset a = coset b [38] by 33,35,37,EXTENSION; !a. a IN g ==> (@)(coset a) IN coset a [39] by 14,IN,SELECT_AX; !a. a IN q ==> a IN g [40] proof let a be A; assume a IN q; a IN {c | ?a. a IN g /\ c = (@)(coset a)} by q; consider a' such that a' IN g /\ a = (@)(coset a'); qed by 37,39; !a x a' x'. a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x ==> a' = a /\ x' = x [41] proof let a x a' x' be A; assume a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x [42]; a IN {c | ?a. a IN g /\ c = (@)(coset a)} /\ a' IN {c | ?a. a IN g /\ c = (@)(coset a)} by q; consider a1 a2 such that a1 IN g /\ a = (@)(coset a1) /\ a2 IN g /\ a' = (@)(coset a2) [43]; a IN g /\ a' IN g [44] by 37,39; coset a = coset a1 /\ coset a' = coset a2 by 38,39,43; a = (@)(coset a) /\ a' = (@)(coset a') [45] by 43; ?x. x IN h /\ a' = a**x proof take x**i(x'); thus x**i(x') IN h by 8,9,42; a' = a'**x'**i(x') by 4,5,6,42,44; .= (a**x)**i(x') by 1,2,3,6,42,44; qed by 1,2,3,6,42,44; a' IN coset a by REWRITE_TAC,13,44,IN_ELIM_THM; coset a = coset a' by 38,44; qed by 6,17,42,44,45; g = IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h} proof !x. x IN g <=> ?p1 p2. (x = p1**p2 /\ p1 IN q) /\ p2 IN h by 2,6,29,40; qed by REWRITE_TAC,EXTENSION,IN_IMAGE,IN_ELIM_THM,EXISTS_PAIR_THM,PAIR_EQ, CONJ_ASSOC,ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1; CARD g = CARD (IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h}) [46]; .= CARD {(a,x) | a IN q /\ x IN h} proof !x y. x IN {(a,x) | a IN q /\ x IN h} /\ y IN {(a,x) | a IN q /\ x IN h} /\ (\(a,x). a**x) x = (\(a,x). a**x) y ==> x = y [47] proof !p1 p2 p1' p2'. (?a x. (a IN q /\ x IN h) /\ p1 = a /\ p2 = x) /\ (?a x. (a IN q /\ x IN h) /\ p1' = a /\ p2' = x) /\ p1**p2 = p1'**p2' ==> p1 = p1' /\ p2 = p2' by 41; qed by REWRITE_TAC,FORALL_PAIR_THM,IN_ELIM_THM,PAIR_EQ; FINITE q /\ FINITE h by 6,12,40,FINITE_SUBSET,SUBSET; FINITE {(a,x) | a IN q /\ x IN h} by FINITE_PRODUCT; qed by MATCH_MP_TAC CARD_IMAGE_INJ,47; .= CARD q * CARD h by 6,12,40,46,CARD_PRODUCT,FINITE_SUBSET,SUBSET; qed by 29`;; let GROUP_LAGRANGE = thm `; !g h (**) i e. group (g,( ** ),i,e:A) /\ subgroup h (g,(**),i,e) /\ FINITE g ==> CARD h divides CARD g by GROUP_LAGRANGE_COSETS,DIVIDES_LMUL,DIVIDES_REFL`;; (* ======== and formal proof sketch derived from this translation ========== *) horizon := -1;; let GROUP_LAGRANGE_COSETS_SKETCH = ref None;; GROUP_LAGRANGE_COSETS_SKETCH := Some `; !g h (**) i e. group(g,(**),i,e:A) /\ subgroup h (g,(**),i,e) /\ FINITE g ==> ?q. CARD g = CARD q * CARD h /\ !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x proof exec REWRITE_TAC[group; subgroup; SUBSET]; let g h be A->bool; let (**) be A->A->A; let i be A->A; let e be A; assume e IN g; assume !x. x IN g ==> i(x) IN g; assume !x y. x IN g /\ y IN g ==> x**y IN g; assume !x y z. x IN g /\ y IN g /\ z IN g ==> x**(y**z) = (x**y)**z; assume !x. x IN g ==> x**e = x /\ e**x = x; assume !x. x IN g ==> x**i(x) = e /\ i(x)**x = e; assume !x. x IN h ==> x IN g; assume e IN h; assume !x. x IN h ==> i(x) IN h; assume !x y. x IN h /\ y IN h ==> x**y IN h; assume !x y z. x IN h /\ y IN h /\ z IN h ==> x**(y**z) = (x**y)**z; assume !x. x IN h ==> x**e = x /\ e**x = x; assume !x. x IN h ==> x**i(x) = e /\ i(x)**x = e; assume FINITE g; set coset = \a. {b | b IN g /\ ?x. x IN h /\ b = a**x}; !a. coset a = {b' | b' IN g /\ ?x. x IN h /\ b' = a**x}; !a. a IN g ==> a IN coset a proof let a be A; assume a IN g; ?x. x IN h /\ a = a**x; qed; FINITE h; :: #1 :: 1: inference error !a. FINITE (coset a) proof let a be A; ?t. FINITE t /\ coset a SUBSET t proof take g; qed; :: #2 :: 2: inference time-out qed; :: #2 !a x y. a IN g /\ x IN g /\ y IN g /\ a**x = a**y ==> x = y proof let a x y be A; assume a IN g /\ x IN g /\ y IN g /\ a**x = a**y; (i(a)**a)**x = (i(a)**a)**y; e**x = e**y; :: #2 qed; !a. a IN g ==> CARD (coset a) = CARD h proof let a be A; assume a IN g; coset a = IMAGE (\x. a**x) h proof !x. x IN g /\ (?x'. x' IN h /\ x = a**x') <=> ?x'. x = a**x' /\ x' IN h; qed; :: #2 (!x y. x IN h /\ y IN h /\ a**x = a**y ==> x = y) /\ FINITE h; CARD (IMAGE (\x. a**x) h) = CARD h; :: #2 qed; !x y. x IN g /\ y IN g ==> i(x**y) = i(y)**i(x) proof let x y be A; assume x IN g /\ y IN g; ?a. a IN g /\ i(x**y) IN g /\ i(y)**i(x) IN g /\ a**i(x**y) = a**i(y)**i(x) proof take x**y; e = x**(y**i(y))**i(x); :: #2 .= ((x**y)**i(y))**i(x); :: #2 qed; qed; !x. x IN g ==> i(i(x)) = x proof let x be A; assume x IN g; ?a. a IN g /\ i(i(x)) IN g /\ x IN g /\ a**i(i(x)) = a**x proof take i(x); qed; qed; !a b. a IN g /\ b IN g ==> coset a = coset b \/ coset a INTER coset b = {} proof let a b be A; assume a IN g /\ b IN g; cases; suppose i(b)**a IN h; now let x be A; !x. x IN h ==> b**(i(b)**a)**x = a**x /\ a**i(i(b)**a)**x = b**x; :: #2 thus x IN g /\ (?x'. x' IN h /\ x = a**x') <=> x IN g /\ (?x'. x' IN h /\ x = b**x'); :: #2 end; coset a = coset b; :: #2 qed; suppose ~(i(b)**a IN h); now let x be A; assume x IN g /\ (?y. y IN h /\ x = a**y) /\ (?z. z IN h /\ x = b**z); consider y z such that y IN h /\ x = a**y /\ z IN h /\ x = b**z; (i(b)**a)**y = i(b)**a**y; .= i(b)**b**z; .= e**z; :: #2 .= z; z**i(y) = ((i(b)**a)**y)**i(y); .= (i(b)**a)**y**i(y); :: #2 .= (i(b)**a)**e; .= i(b)**a; :: #2 thus F; :: #2 end; !x. ~((x IN g /\ ?y. y IN h /\ x = a**y) /\ (x IN g /\ ?z. z IN h /\ x = b**z)); coset a INTER coset b = {}; :: #2 qed; end; set q = {c | ?a. a IN g /\ c = (@)(coset a)}; take q; !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x proof let b be A; assume b IN g; set C = (@)(coset b); take C; (@)(coset b) IN {c | ?a. a IN g /\ c = (@)(coset a)}; thus C IN q; C IN coset b; :: #2 C IN {b' | b' IN g /\ ?x. x IN h /\ b' = b**x}; consider c such that C IN g /\ c IN h /\ C = b**c; take i(c); (b**c)**i(c) = b**c**i(c); .= b; qed; !a b. a IN g /\ b IN g /\ a IN coset b ==> b IN coset a proof let a b be A; a IN g /\ b IN g /\ a IN g /\ (?x. x IN h /\ a = b**x) ==> b IN g /\ (?x. x IN h /\ b = a**x) proof assume a IN g /\ b IN g /\ a IN g /\ ?x. x IN h /\ a = b**x; thus b IN g; consider c such that c IN h /\ a = b**c; take i(c); qed; :: #2 qed; !a b c. a IN coset b /\ b IN coset c /\ c IN g ==> a IN coset c proof let a b c be A; now assume (a IN g /\ ?x. x IN h /\ a = b**x) /\ (b IN g /\ ?x. x IN h /\ b = c**x) /\ c IN g; consider x x' such that x IN h /\ a = b**x /\ x' IN h /\ b = c**x'; thus a IN g /\ ?x. x IN h /\ a = c**x; :: #2 end; qed; :: #2 !a b. a IN coset b ==> a IN g proof let a b be A; a IN g /\ (?x. x IN h /\ a = b**x) ==> a IN g; qed; !a b. a IN coset b /\ b IN g ==> coset a = coset b; :: #2 !a. a IN g ==> (@)(coset a) IN coset a; :: #2 !a. a IN q ==> a IN g proof let a be A; assume a IN q; a IN {c | ?a. a IN g /\ c = (@)(coset a)}; consider a' such that a' IN g /\ a = (@)(coset a'); qed; !a x a' x'. a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x ==> a' = a /\ x' = x proof let a x a' x' be A; assume a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x; a IN {c | ?a. a IN g /\ c = (@)(coset a)} /\ a' IN {c | ?a. a IN g /\ c = (@)(coset a)}; consider a1 a2 such that a1 IN g /\ a = (@)(coset a1) /\ a2 IN g /\ a' = (@)(coset a2); :: #2 a IN g /\ a' IN g; coset a = coset a1 /\ coset a' = coset a2; :: #2 a = (@)(coset a) /\ a' = (@)(coset a'); ?x. x IN h /\ a' = a**x proof take x**i(x'); thus x**i(x') IN h; :: #2 a' = a'**x'**i(x'); :: #2 .= (a**x)**i(x'); :: #2 qed; :: #2 a' IN coset a; :: #2 coset a = coset a'; qed; :: #2 g = IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h} proof !x. x IN g <=> ?p1 p2. (x = p1**p2 /\ p1 IN q) /\ p2 IN h; :: #2 qed; :: #2 CARD g = CARD (IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h}); .= CARD {(a,x) | a IN q /\ x IN h} proof !x y. x IN {(a,x) | a IN q /\ x IN h} /\ y IN {(a,x) | a IN q /\ x IN h} /\ (\(a,x). a**x) x = (\(a,x). a**x) y ==> x = y proof !p1 p2 p1' p2'. (?a x. (a IN q /\ x IN h) /\ p1 = a /\ p2 = x) /\ (?a x. (a IN q /\ x IN h) /\ p1' = a /\ p2' = x) /\ p1**p2 = p1'**p2' ==> p1 = p1' /\ p2 = p2'; qed; :: #2 FINITE q /\ FINITE h; :: #2 FINITE {(a,x) | a IN q /\ x IN h}; :: #2 qed; :: #2 .= CARD q * CARD h; :: #2 qed`;; hol-light/miz3/Samples/luxury.ml000066400000000000000000000162361303454263000171450ustar00rootroot00000000000000horizon := 0;; let SUC_INJ_1 = thm `; now now [1] let m n be num; now [2] assume mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) [3]; now [4] let p be num; NUM_REP (dest_num p) [5] by REWRITE_TAC[fst num_tydef; snd num_tydef] ; thus NUM_REP (IND_SUC (dest_num p)) by MATCH_MP_TAC (CONJUNCT2 NUM_REP_RULES) from 5; end; !p. NUM_REP (IND_SUC (dest_num p)) [6] by GEN_TAC from 4; now [7] assume !p. dest_num (mk_num (IND_SUC (dest_num p))) = IND_SUC (dest_num p) [8]; mk_num (dest_num m) = mk_num (dest_num n) ==> m = n [9] by REWRITE_TAC[fst num_tydef]; dest_num m = dest_num n ==> m = n [10] by DISCH_THEN(MP_TAC o AP_TERM (parse_term "mk_num")) from 9; thus dest_num (mk_num (IND_SUC (dest_num m))) = dest_num (mk_num (IND_SUC (dest_num n))) ==> m = n by ASM_REWRITE_TAC[IND_SUC_INJ],8 from 10; end; (!p. dest_num (mk_num (IND_SUC (dest_num p))) = IND_SUC (dest_num p)) ==> dest_num (mk_num (IND_SUC (dest_num m))) = dest_num (mk_num (IND_SUC (dest_num n))) ==> m = n [11] by DISCH_TAC from 7; (!p. NUM_REP (IND_SUC (dest_num p))) ==> dest_num (mk_num (IND_SUC (dest_num m))) = dest_num (mk_num (IND_SUC (dest_num n))) ==> m = n [12] by REWRITE_TAC[fst num_tydef; snd num_tydef] from 11; dest_num (mk_num (IND_SUC (dest_num m))) = dest_num (mk_num (IND_SUC (dest_num n))) ==> m = n [13] by SUBGOAL_THEN (parse_term "!p. NUM_REP (IND_SUC (dest_num p))") MP_TAC from 6,12; thus m = n by POP_ASSUM(MP_TAC o AP_TERM (parse_term "dest_num")),3 from 13; end; mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) ==> m = n [14] by DISCH_TAC from 2; now [15] assume m = n [16]; thus mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) by ASM_REWRITE_TAC[],16; end; m = n ==> mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) [17] by DISCH_TAC from 15; mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) <=> m = n [18] by EQ_TAC from 14,17; thus SUC m = SUC n <=> m = n by REWRITE_TAC[SUC_DEF] from 18; end; thus !m n. SUC m = SUC n <=> m = n by REPEAT GEN_TAC from 1; end; `;; let SUC_INJ_2 = thm `; !m n. SUC m = SUC n <=> m = n [1] proof let m n be num; mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) ==> m = n [2] proof assume mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) [3]; !p. NUM_REP (IND_SUC (dest_num p)) [4] proof let p be num; NUM_REP (dest_num p) [5] by REWRITE_TAC[fst num_tydef; snd num_tydef]; qed by MATCH_MP_TAC (CONJUNCT2 NUM_REP_RULES) from 5; (!p. dest_num (mk_num (IND_SUC (dest_num p))) = IND_SUC (dest_num p)) ==> dest_num (mk_num (IND_SUC (dest_num m))) = dest_num (mk_num (IND_SUC (dest_num n))) ==> m = n [6] proof assume !p. dest_num (mk_num (IND_SUC (dest_num p))) = IND_SUC (dest_num p) [7]; mk_num (dest_num m) = mk_num (dest_num n) ==> m = n [8] by REWRITE_TAC[fst num_tydef]; dest_num m = dest_num n ==> m = n [9] by DISCH_THEN(MP_TAC o AP_TERM (parse_term "mk_num")) from 8; qed by ASM_REWRITE_TAC[IND_SUC_INJ],* from 9; (!p. NUM_REP (IND_SUC (dest_num p))) ==> dest_num (mk_num (IND_SUC (dest_num m))) = dest_num (mk_num (IND_SUC (dest_num n))) ==> m = n [10] by REWRITE_TAC[fst num_tydef; snd num_tydef] from 6; dest_num (mk_num (IND_SUC (dest_num m))) = dest_num (mk_num (IND_SUC (dest_num n))) ==> m = n [11] by SUBGOAL_THEN (parse_term "!p. NUM_REP (IND_SUC (dest_num p))") MP_TAC from 4,10; qed by POP_ASSUM(MP_TAC o AP_TERM (parse_term "dest_num")),3 from 11; m = n ==> mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) [12] proof assume m = n [13]; qed by ASM_REWRITE_TAC[],*; mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) <=> m = n [14] by EQ_TAC from 2,12; qed by REWRITE_TAC[SUC_DEF] from 14;`;; let num_INDUCTION_ = thm `; now [1] let P be num->bool; let n be num; assume P _0; assume !n. P n ==> P (SUC n); now [2] let i be ind; assume NUM_REP i; assume P (mk_num i); NUM_REP i [3] by ASM_REWRITE_TAC[],*; thus NUM_REP (IND_SUC i) by MATCH_MP_TAC(CONJUNCT2 NUM_REP_RULES) from 3; end; now [4] let i be ind; assume NUM_REP i; assume P (mk_num i); NUM_REP i [5] by FIRST_ASSUM MATCH_ACCEPT_TAC,*; dest_num (mk_num i) = i [6] by REWRITE_TAC[GSYM(snd num_tydef)] from 5; i = dest_num (mk_num i) [7] by CONV_TAC SYM_CONV from 6; mk_num (IND_SUC i) = mk_num (IND_SUC (dest_num (mk_num i))) [8] by REPEAT AP_TERM_TAC from 7; mk_num (IND_SUC i) = SUC (mk_num i) [9] by REWRITE_TAC[SUC_DEF] from 8; P (mk_num i) [10] by FIRST_ASSUM MATCH_ACCEPT_TAC,*; P (SUC (mk_num i)) [11] by FIRST_ASSUM MATCH_MP_TAC,* from 10; thus P (mk_num (IND_SUC i)) by SUBGOAL_THEN (parse_term "mk_num(IND_SUC i) = SUC(mk_num i)") SUBST1_TAC from 9,11; end; !i. NUM_REP i /\ P (mk_num i) ==> NUM_REP (IND_SUC i) /\ P (mk_num (IND_SUC i)) [12] by REPEAT STRIP_TAC from 2,4; (NUM_REP (dest_num n) ==> NUM_REP (dest_num n) /\ P (mk_num (dest_num n))) ==> P n [13] by REWRITE_TAC[fst num_tydef; snd num_tydef]; (!a. NUM_REP a ==> NUM_REP a /\ P (mk_num a)) ==> P n [14] by DISCH_THEN(MP_TAC o SPEC (parse_term "dest_num n")) from 13; ((!i. NUM_REP i /\ P (mk_num i) ==> NUM_REP (IND_SUC i) /\ P (mk_num (IND_SUC i))) ==> (!a. NUM_REP a ==> NUM_REP a /\ P (mk_num a))) ==> P n [15] by W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) from 12,14; ((\i. NUM_REP i /\ P (mk_num i)) IND_0 /\ (!i. (\i. NUM_REP i /\ P (mk_num i)) i ==> (\i. NUM_REP i /\ P (mk_num i)) (IND_SUC i)) ==> (!a. NUM_REP a ==> (\i. NUM_REP i /\ P (mk_num i)) a)) ==> P n [16] by ASM_REWRITE_TAC[GSYM ZERO_DEF; NUM_REP_RULES],* from 15; thus P n by MP_TAC (SPEC (parse_term "\\i. NUM_REP i /\\ P(mk_num i):bool") NUM_REP_INDUCT) from 16; end; thus !P. P(_0) /\ (!n. P(n) ==> P(SUC n)) ==> !n. P n by REPEAT STRIP_TAC from 1; `;; let num_RECURSION_STD = thm `; !e:Z f. ?fn. (fn 0 = e) /\ (!n. fn (SUC n) = f n (fn n)) proof !e:Z f. ?fn. fn 0 = e /\ (!n. fn (SUC n) = f n (fn n)) [1] proof let e be Z; let f be num->Z->Z; (?fn. fn 0 = e /\ (!n. fn (SUC n) = (\z n. f n z) (fn n) n)) ==> (?fn. fn 0 = e /\ (!n. fn (SUC n) = f n (fn n))) [2] by REWRITE_TAC[]; qed by MP_TAC(ISPECL [(parse_term "e:Z"); (parse_term "(\\z n. (f:num->Z->Z) n z)")] num_RECURSION) from 2; qed by REPEAT GEN_TAC from 1; `;; hol-light/miz3/Samples/other_mizs.ml000066400000000000000000000334751303454263000177640ustar00rootroot00000000000000(* ======== Examples/mizar.ml ============================================== *) hide_constant "<=";; horizon := 0;; let KNASTER_TARSKI = thm `; let (<=) be A->A->bool; thus !f. (!x y. x <= y /\ y <= x ==> (x = y)) /\ (!x y z. x <= y /\ y <= z ==> x <= z) /\ (!x y. x <= y ==> f x <= f y) /\ (!X. ?s. (!x. x IN X ==> s <= x) /\ (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s)) ==> ?x. f x = x proof let f be A->A; exec DISCH_THEN (LABEL_TAC "L"); !x y. x <= y /\ y <= x ==> (x = y) [antisymmetry] by L; !x y z. x <= y /\ y <= z ==> x <= z [transitivity] by L; !x y. x <= y ==> f x <= f y [monotonicity] by L; !X. ?s:A. (!x. x IN X ==> s <= x) /\ (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s) [least_upper_bound] by L; set Y = {b | f b <= b} [Y_def]; !b. b IN Y <=> f b <= b [Y_thm] by ALL_TAC,Y_def,IN_ELIM_THM,BETA_THM; consider a such that (!x. x IN Y ==> a <= x) /\ (!a'. (!x. x IN Y ==> a' <= x) ==> a' <= a) [lub] by least_upper_bound; take a; !b. b IN Y ==> f a <= b proof let b be A; assume b IN Y [b_in_Y]; f b <= b [L0] by -,Y_thm; a <= b by b_in_Y,lub; f a <= f b by -,monotonicity; thus f a <= b by -,L0,transitivity; end; f(a) <= a [Part1] by -,lub; f(f(a)) <= f(a) by -,monotonicity; f(a) IN Y by -,Y_thm; a <= f(a) by -,lub; qed by -,Part1,antisymmetry`;; unhide_constant "<=";; (* ======== Mizarlight/duality.ml ========================================== *) parse_as_infix("ON",(11,"right"));; hide_constant "ON";; let projective = new_definition `projective((ON):Point->Line->bool) <=> (!p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l) /\ (!l l'. ?p. p ON l /\ p ON l') /\ (?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l)) /\ (!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON l /\ p' ON l /\ p'' ON l)`;; horizon := 1;; let LEMMA_1 = thm `; !(ON):Point->Line->bool. projective(ON) ==> !p. ?l. p ON l proof let (ON) be Point->Line->bool; assume projective(ON) [0]; !p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l [1] by 0,projective; ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l) [3] by 0,projective; let p be Point; consider q q' such that ~(q = q':Point); ~(p = q) \/ ~(p = q'); consider l such that p ON l by 1; take l; qed`;; let LEMMA_2 = thm `; !(ON):Point->Line->bool. projective(ON) ==> !p1 p2 q l l1 l2. p1 ON l /\ p2 ON l /\ p1 ON l1 /\ p2 ON l2 /\ q ON l2 /\ ~(q ON l) /\ ~(p1 = p2) ==> ~(l1 = l2) proof let (ON) be Point->Line->bool; assume projective(ON) [0]; !p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l [1] by 0,projective; // here qed already works let p1 p2 q be Point; let l l1 l2 be Line; assume p1 ON l [5]; assume p2 ON l [6]; assume p1 ON l1 [7]; assume p2 ON l2 [9]; assume q ON l2 [10]; assume ~(q ON l) [11]; assume ~(p1 = p2) [12]; assume l1 = l2 [13]; p1 ON l2 by 7; l = l2 by 1,5,6,9,12; thus F by 10,11; end`;; let PROJECTIVE_DUALITY = thm `; !(ON):Point->Line->bool. projective(ON) ==> projective (\l p. p ON l) proof let (ON) be Point->Line->bool; assume projective(ON) [0]; !p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l [1] by 0,projective; !l l'. ?p. p ON l /\ p ON l' [2] by 0,projective; ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l) [3] by 0,projective; !l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON l /\ p' ON l /\ p'' ON l [4] by 0,projective; // dual of axiom 1 !l1 l2. ~(l1 = l2) ==> ?!p. p ON l1 /\ p ON l2 [5] proof let l1 l2 be Line; assume ~(l1 = l2) [6]; consider p such that p ON l1 /\ p ON l2 [7] by 2; !p'. p' ON l1 /\ p' ON l2 ==> (p' = p) proof let p' be Point; assume p' ON l1 /\ p' ON l2 [8]; assume ~(p' = p); l1 = l2 by 1,7,8; thus F by 6; end; qed by 7; // dual of axiom 2 !p1 p2. ?l. p1 ON l /\ p2 ON l [9] proof let p1 p2 be Point; cases; suppose p1 = p2; qed by 0,LEMMA_1; suppose ~(p1 = p2); qed by 1; end; // dual of axiom 3 ?l1 l2 l3. ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) /\ ~(?p. p ON l1 /\ p ON l2 /\ p ON l3) [10] proof consider p1 p2 p3 such that ~(p1 = p2) /\ ~(p2 = p3) /\ ~(p1 = p3) /\ ~(?l. p1 ON l /\ p2 ON l /\ p3 ON l) [11] by 3; ~(p1 = p3) by 11; ?!l1. p1 ON l1 /\ p3 ON l1 by 1; // ADDED STEP consider l1 such that p1 ON l1 /\ p3 ON l1 /\ !l'. p1 ON l' /\ p3 ON l' ==> (l1 = l') [12]; ~(p2 = p3) by 11; ?!l2. p2 ON l2 /\ p3 ON l2 by 1; // ADDED STEP consider l2 such that p2 ON l2 /\ p3 ON l2 /\ !l'. p2 ON l' /\ p3 ON l' ==> (l2 = l') [13]; ~(p1 = p2) by 11; ?!l3. p1 ON l3 /\ p2 ON l3 by 1; // ADDED STEP consider l3 such that p1 ON l3 /\ p2 ON l3 /\ !l'. p1 ON l' /\ p2 ON l' ==> (l3 = l') [14]; take l1; take l2; take l3; thus ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) [15] by 11,12,13,14; assume ?q. q ON l1 /\ q ON l2 /\ q ON l3; consider q such that q ON l1 /\ q ON l2 /\ q ON l3; (p1 = q) /\ (p2 = q) /\ (p3 = q) by 5,12,13,14,15; thus F by 11; end; // dual of axiom 4 !p0. ?l0 L1 L2. ~(l0 = L1) /\ ~(L1 = L2) /\ ~(l0 = L2) /\ p0 ON l0 /\ p0 ON L1 /\ p0 ON L2 proof let p0 be Point; consider l0 such that p0 ON l0 [16] by 0,LEMMA_1; consider p such that ~(p = p0) /\ p ON l0 [17] by 4; consider q such that ~(q ON l0) [18] by 3; consider l1 such that p ON l1 /\ q ON l1 [19] by 1,16; consider r such that r ON l1 /\ ~(r = p) /\ ~(r = q) [20] proof consider r1 r2 r3 such that ~(r1 = r2) /\ ~(r2 = r3) /\ ~(r1 = r3) /\ r1 ON l1 /\ r2 ON l1 /\ r3 ON l1 [21] by 4; ~(r1 = p) /\ ~(r1 = q) \/ ~(r2 = p) /\ ~(r2 = q) \/ ~(r3 = p) /\ ~(r3 = q); qed by 21; ~(p0 ON l1) [22] proof assume p0 ON l1; l1 = l0 by 1,16,17,19; qed by 18,19; ~(p0 = r) by 20; consider L1 such that r ON L1 /\ p0 ON L1 [23] by 1; consider L2 such that q ON L2 /\ p0 ON L2 [24] by 1,16,18; take l0; take L1; take L2; thus ~(l0 = L1) by 0,17,19,20,22,23,LEMMA_2; thus ~(L1 = L2) by 0,19,20,22,23,24,LEMMA_2; thus ~(l0 = L2) by 18,24; thus p0 ON l0 /\ p0 ON L2 /\ p0 ON L1 by 16,24,23; end; qed by REWRITE_TAC,5,9,10,projective`;; unhide_constant "ON";; (* ======== Mizarlight/duality_holby.ml ==================================== *) horizon := 1;; let Line_INDUCT,Line_RECURSION = define_type "fano_Line = Line_1 | Line_2 | Line_3 | Line_4 | Line_5 | Line_6 | Line_7";; let Point_INDUCT,Point_RECURSION = define_type "fano_Point = Point_1 | Point_2 | Point_3 | Point_4 | Point_5 | Point_6 | Point_7";; let Point_DISTINCT = distinctness "fano_Point";; let Line_DISTINCT = distinctness "fano_Line";; let fano_incidence = [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; let fano_point i = mk_const("Point_"^string_of_int i,[]) and fano_line i = mk_const("Line_"^string_of_int i,[]);; let fano_clause (i,j) = let p = `p:fano_Point` and l = `l:fano_Line` in mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; let ON = new_definition (mk_eq(`((ON):fano_Point->fano_Line->bool) p l`, list_mk_disj(map fano_clause fano_incidence)));; let ON_CLAUSES = prove (list_mk_conj(allpairs (fun i j -> mk_eq(list_mk_comb(`(ON)`,[fano_point i; fano_line j]), if mem (i,j) fano_incidence then `T` else `F`)) (1--7) (1--7)), REWRITE_TAC[ON; Line_DISTINCT; Point_DISTINCT]);; let FORALL_POINT = thm `; !P. (!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ P Point_5 /\ P Point_6 /\ P Point_7 by Point_INDUCT`;; let EXISTS_POINT = thm `; !P. (?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ P Point_5 \/ P Point_6 \/ P Point_7 proof let P be fano_Point->bool; ~(?p. P p) <=> ~(P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ P Point_5 \/ P Point_6 \/ P Point_7) by REWRITE_TAC,DE_MORGAN_THM,NOT_EXISTS_THM,FORALL_POINT; qed`;; let FORALL_LINE = thm `; !P. (!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ P Line_5 /\ P Line_6 /\ P Line_7 by Line_INDUCT`;; let EXISTS_LINE = thm `; !P. (?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ P Line_5 \/ P Line_6 \/ P Line_7 proof let P be fano_Line->bool; ~(?p. P p) <=> ~(P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ P Line_5 \/ P Line_6 \/ P Line_7) by REWRITE_TAC,DE_MORGAN_THM,NOT_EXISTS_THM,FORALL_LINE; qed;`;; let FANO_TAC = GEN_REWRITE_TAC DEPTH_CONV [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN GEN_REWRITE_TAC DEPTH_CONV (basic_rewrites() @ [ON_CLAUSES; Point_DISTINCT; Line_DISTINCT]);; let AXIOM_1 = thm `; !p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ !l'. p ON l' /\ p' ON l' ==> (l' = l) by TIMED_TAC 3 FANO_TAC`;; let AXIOM_2 = thm `; !l l'. ?p. p ON l /\ p ON l' by FANO_TAC`;; let AXIOM_3 = thm `; ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l) by TIMED_TAC 2 FANO_TAC`;; let AXIOM_4 = thm `; !l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON l /\ p' ON l /\ p'' ON l by TIMED_TAC 3 FANO_TAC`;; let AXIOM_1' = thm `; !p p' l l'. ~(p = p') /\ p ON l /\ p' ON l /\ p ON l' /\ p' ON l' ==> (l' = l) proof let p p' be fano_Point; let l l' be fano_Line; assume ~(p = p') /\ p ON l /\ p' ON l /\ p ON l' /\ p' ON l' [1]; consider l1 such that p ON l1 /\ p' ON l1 /\ !l'. p ON l' /\ p' ON l' ==> (l' = l1) [2] by 1,AXIOM_1; l = l1 by 1,2; .= l' by 1,2; qed`;; let LEMMA_1' = thm `; !O. ?l. O ON l proof consider p p' p'' such that ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ ~(?l. p ON l /\ p' ON l /\ p'' ON l) [1] by AXIOM_3; let O be fano_Point; ~(p = O) \/ ~(p' = O) by 1; consider P such that ~(P = O) [2]; consider l such that O ON l /\ P ON l /\ !l'. O ON l' /\ P ON l' ==> (l' = l) [3] by 2,AXIOM_1; thus ?l. O ON l by 3; end`;; let DUAL_1 = thm `; !l l'. ~(l = l') ==> ?p. p ON l /\ p ON l' /\ !p'. p' ON l /\ p' ON l' ==> (p' = p) proof assume ~thesis; consider l l' such that ~(l = l') /\ !p. p ON l /\ p ON l' ==> ?p'. p' ON l /\ p' ON l' /\ ~(p' = p) [1]; consider p such that p ON l /\ p ON l' [2] by AXIOM_2; consider p' such that p' ON l /\ p' ON l' /\ ~(p' = p) [3] by 1,2; thus F by 1,2,AXIOM_1'; end`;; let DUAL_2 = thm `; !p p'. ?l. p ON l /\ p' ON l proof let p p' be fano_Point; ?l. p ON l [1] by LEMMA_1'; (p = p') \/ ?l. p ON l /\ p' ON l /\ !l'. p ON l' /\ p' ON l' ==> (l' = l) by AXIOM_1; qed by 1`;; let DUAL_3 = thm `; ?l1 l2 l3. ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) /\ ~(?p. p ON l1 /\ p ON l2 /\ p ON l3) proof consider p1 p2 p3 such that ~(p1 = p2) /\ ~(p2 = p3) /\ ~(p1 = p3) /\ ~(?l. p1 ON l /\ p2 ON l /\ p3 ON l) [1] by AXIOM_3; consider l1 such that p1 ON l1 /\ p3 ON l1 [2] by DUAL_2; consider l2 such that p2 ON l2 /\ p3 ON l2 [3] by DUAL_2; consider l3 such that p1 ON l3 /\ p2 ON l3 [4] by DUAL_2; take l1; take l2; take l3; thus ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) [5] by 1,2,3,4; assume ~thesis; consider q such that q ON l1 /\ q ON l2 /\ q ON l3 [6]; consider q' such that q' ON l1 /\ q' ON l3 /\ !p'. p' ON l1 /\ p' ON l3 ==> (p' = q') [7] by 5,DUAL_1; q = q' by 6,7; .= p1 by 2,4,7; thus F by 1,3,6; end`;; let DUAL_4 = thm `; !O. ?OP OQ OR. ~(OP = OQ) /\ ~(OQ = OR) /\ ~(OP = OR) /\ O ON OP /\ O ON OQ /\ O ON OR proof let O be fano_Point; consider OP such that O ON OP [1] by LEMMA_1'; consider p p' p'' such that ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ p ON OP /\ p' ON OP /\ p'' ON OP [2] by AXIOM_4; ~(p = O) \/ ~(p' = O) by 2; consider P such that ~(P = O) /\ P ON OP [3] by 2; consider q q' q'' such that ~(q = q') /\ ~(q' = q'') /\ ~(q = q'') /\ ~(?l. q ON l /\ q' ON l /\ q'' ON l) [4] by AXIOM_3; ~(q ON OP) \/ ~(q' ON OP) \/ ~(q'' ON OP) by 4; consider Q such that ~(Q ON OP) [5]; consider l such that P ON l /\ Q ON l [6] by DUAL_2; consider r r' r'' such that ~(r = r') /\ ~(r' = r'') /\ ~(r = r'') /\ r ON l /\ r' ON l /\ r'' ON l [7] by AXIOM_4; ((r = P) \/ (r = Q) \/ ~(r = P) /\ ~(r = Q)) /\ ((r' = P) \/ (r' = Q) \/ ~(r' = P) /\ ~(r' = Q)); consider R such that R ON l /\ ~(R = P) /\ ~(R = Q) [8] by 7; consider OQ such that O ON OQ /\ Q ON OQ [9] by DUAL_2; consider OR such that O ON OR /\ R ON OR [10] by DUAL_2; take OP; take OQ; take OR; ~(O ON l) by 1,3,5,6,AXIOM_1'; thus ~(OP = OQ) /\ ~(OQ = OR) /\ ~(OP = OR) /\ O ON OP /\ O ON OQ /\ O ON OR by 1,3,5,6,8,9,10,AXIOM_1'; end`;; (* ======== Tutorial/Changing_proof_style.ml =============================== *) horizon := 1;; let NSQRT_2_4 = thm `; !p q. p * p = 2 * q * q ==> q = 0 proof !p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) ==> (!q. p * p = 2 * q * q ==> q = 0) proof let p be num; assume !m. m < p ==> !q. m * m = 2 * q * q ==> q = 0 [A]; let q be num; assume p * p = 2 * q * q [B]; EVEN(p * p) <=> EVEN(2 * q * q); EVEN(p) by TIMED_TAC 2 o MESON_TAC,ARITH,EVEN_MULT; // "EVEN 2 by CONV_TAC o HOL_BY,ARITH;" takes over a minute... consider m such that p = 2 * m [C] by EVEN_EXISTS; cases by ARITH_TAC; suppose q < p; q * q = 2 * m * m ==> m = 0 by A; qed by NUM_RING,B,C; suppose p <= q; p * p <= q * q by LE_MULT2; q * q = 0 by ARITH_TAC,B; qed by NUM_RING; end; qed by MATCH_MP_TAC,num_WF`;; hol-light/miz3/Samples/robbins.ml000066400000000000000000000130331303454263000172230ustar00rootroot00000000000000(* ======== Robbins Conjecture proof from John ============================= *) hide_constant "+";; horizon := 0;; timeout := 2;; (* John apparently has a faster computer :-) *) let ROBBINS = thm `; let (+) be A->A->A; let n be A->A; assume !x y. x+y = y+x [COM]; assume !x y z. x+(y+z) = (x+y)+z [ASS]; assume !a b. n(n(a+b)+n(a+n(b))) = a [ROB]; consider x such that x:A = x; set u = n(x+n(x)) [U]; set d = x+u [D]; set c = x+x+x+u [C]; set j = n(c+d) [J]; set e = u+n(x+x)+n(c) [E]; n(u+n(x+x)) = x [0] proof n(u+n(x+x)) = n(n(x+n(x))+n(x+x)) by U; .= x by ROB,COM; qed by -; n(x+u+n(x+u+n(x+x)+n(c))) = n(c) [1] proof n(x+u+n(x+u+n(x+x)+n(c))) = n((x+u)+n(x+u+n(x+x)+n(c))) by ASS,COM; .= n(n(n((x+u)+x+x)+n((x+u)+n(x+x)))+n(x+u+n(x+x)+n(c))) by ROB; .= n(n(n(x+u+x+x)+n(x+u+n(x+x)))+n(x+u+n(x+x)+n(c))) by ASS; .= n(n(n(x+x+x+u)+n(x+u+n(x+x)))+n(x+u+n(x+x)+n(c))) by ASS,COM; // slow .= n(n(n(c)+n(x+u+n(x+x)))+n(n(c)+x+u+n(x+x))) by ASS,COM,C; .= n(c) by ROB,ASS,COM; qed by -; n(u+n(c)) = x [2] proof n(u+n(c)) = n(u+n(x+x+u+x)) by C,ASS,COM; .= n(u+n(x+x+u+n(u+n(x+x)))) by 0; .= n(n(n(u+x+x)+n(u+n(x+x)))+n(x+x+u+n(u+n(x+x)))) by ROB; .= n(n(x+x+u+n(u+n(x+x)))+n(n(u+x+x)+n(u+n(x+x)))) by COM; .= n(n((x+x+u)+n(u+n(x+x)))+n(n(u+x+x)+n(u+n(x+x)))) by ASS; .= n(n(n(u+n(x+x))+u+x+x)+n(n(u+n(x+x))+n(u+x+x))) by ASS,COM; .= n(u+n(x+x)) by ROB; .= x by 0; qed by -; n(j+u) = x [3] proof n(j+u) = n(n(x+c+u)+u) by J,D,COM,ASS; .= n(n(x+c+u)+n(n(u+c)+n(u+n(c)))) by ROB; .= n(n(x+c+u)+n(x+n(c+u))) by 2,COM; .= x by ROB; qed by -; n(x+n(x+n(x+x)+u+n(c))) = n(x+x) [4] proof n(x+n(x+n(x+x)+u+n(c))) = n(n(n(x+n(u+n(c)))+n(x+u+n(c)))+n(x+n(x+x)+u+n(c))) by ROB,ASS,COM; .= n(n(n(x+x)+n(x+u+n(c)))+n(n(x+x)+x+u+n(c))) by 2,ASS,COM; .= n(n(n(x+x)+x+u+n(c))+n(n(x+x)+n(x+u+n(c)))) by ASS,COM; .= n(x+x) by ROB,COM; qed by -; n(x+n(c)) = u [5] proof n(x+n(c)) = n(x+n(x+u+n(x+u+n(x+x)+n(c)))) by 1; .= n(n(u+n(x+x))+n(x+u+n(x+u+n(x+x)+n(c)))) by 0; .= n(n(u+n(x+x))+n(u+x+n(x+e))) by E,COM,ASS; .= n(n(u+n(x+n(x+n(x+x)+u+n(c))))+n(u+x+n(x+e))) by 4; .= n(n(u+n(x+n(x+(u+n(c))+n(x+x))))+n(u+x+n(x+e))) by COM; .= n(n(u+n(x+n(x+u+n(c)+n(x+x))))+n(u+x+n(x+e))) by ASS; .= n(n(u+n(x+n(x+u+n(x+x)+n(c))))+n(u+x+n(x+e))) by COM; .= n(n(u+n(x+n(x+e)))+n(u+x+n(x+e))) by E; .= u by ROB,COM; qed by -; n(j+x) = u [6] proof n(j+x) = n(j+n(n(x+c)+n(x+n(c)))) by ROB; .= n(j+n(n(x+c)+u)) by 5; .= n(n(u+x+c)+n(u+n(x+c))) by J,D,COM,ASS; .= u by ROB; qed by -; n(c+d) = n(c) proof n(c+d) = j by J; .= n(n(j+n(x+n(c)))+n(j+x+n(c))) by ROB,COM; .= n(n(j+u)+n(j+x+n(c))) by 5; .= n(x+n(j+x+n(c))) by 3; .= n(n(n(c)+u)+n(n(c)+j+x)) by 2,COM,ASS; .= n(n(n(c)+n(j+x))+n(n(c)+j+x)) by 6; .= n(c) by ROB,COM; qed by -; thus ?c d. n(c+d) = n(c) by -`;; timeout := 1;; (* ======== REWRITE version ================================================ *) let old_default_prover = !default_prover;; default_prover := "REWRITE_TAC",REWRITE_TAC;; let ROBBINS = thm `; let (+) be A->A->A; let n be A->A; assume !x y. x+y = y+x [COM]; assume !x y z. x+(y+z) = (x+y)+z [ASS]; assume !a b. n(n(a+b)+n(a+n(b))) = a [ROB]; !x y z. x+y = y+x /\ (x+y)+z = x+(y+z) /\ x+(y+z) = y+(x+z) [AC] by MESON_TAC,COM,ASS; consider x such that x:A = x; set u = n(x+n(x)) [U]; set d = x+u [D]; set c = x+x+x+u [C]; set j = n(c+d) [J]; set e = u+n(x+x)+n(c) [E]; n(u+n(x+x)) = x [0] proof n(u+n(x+x)) = n(n(x+x)+n(x+n(x))) by U,AC; .= x by ROB; qed by -; n(x+u+n(x+u+n(x+x)+n(c))) = n(c) [1] proof n(x+u+n(x+u+n(x+x)+n(c))) = n((x+u)+n(x+u+n(x+x)+n(c))) by AC; .= n(n(n((x+u)+x+x)+n((x+u)+n(x+x)))+n(x+u+n(x+x)+n(c))) by ROB; .= n(n(n(c)+x+u+n(x+x))+n(n(c)+n(x+u+n(x+x)))) by C,AC; .= n(c) by ROB; qed by -; n(u+n(c)) = x [2] proof n(u+n(c)) = n(u+n(x+x+u+n(u+n(x+x)))) by 0,C,AC; .= n(n(n(u+x+x)+n(u+n(x+x)))+n(x+x+u+n(u+n(x+x)))) by ROB; .= n(n(n(u+n(x+x))+u+x+x)+n(n(u+n(x+x))+n(u+x+x))) by AC; .= n(u+n(x+x)) by ROB; .= x by 0; qed by -; n(j+u) = x [3] proof n(j+u) = n(n(x+c+u)+u) by J,D,AC; .= n(n(x+c+u)+n(n(u+c)+n(u+n(c)))) by ROB; .= n(n(x+c+u)+n(x+n(c+u))) by 2,AC; .= x by ROB; qed by -; n(x+n(x+n(x+x)+u+n(c))) = n(x+x) [4] proof n(x+n(x+n(x+x)+u+n(c))) = n(n(n(x+u+n(c))+n(x+n(u+n(c))))+n(x+n(x+x)+u+n(c))) by ROB; .= n(n(n(x+x)+x+u+n(c))+n(n(x+x)+n(x+u+n(c)))) by 2,AC; .= n(x+x) by ROB; qed by -; n(x+n(c)) = u [5] proof n(x+n(c)) = n(n(u+n(x+x))+n(x+u+n(x+u+n(x+x)+n(c)))) by 0,1; .= n(n(u+n(x+n(x+n(x+x)+u+n(c))))+n(u+x+n(x+e))) by 4,E,AC; .= n(n(u+x+n(x+e))+n(u+n(x+n(x+e)))) by E,AC; .= u by ROB; qed by -; n(j+x) = u [6] proof n(j+x) = n(j+n(n(x+c)+n(x+n(c)))) by ROB; .= n(n(u+x+c)+n(u+n(x+c))) by 5,J,D,AC; .= u by ROB; qed by -; n(c+d) = n(c) proof n(c+d) = j by J; .= n(n(j+x+n(c))+n(j+n(x+n(c)))) by ROB; .= n(n(u+n(c))+n(j+x+n(c))) by 2,3,5,AC; .= n(n(n(c)+j+x)+n(n(c)+n(j+x))) by 6,AC; .= n(c) by ROB; qed by -; thus ?c d. n(c+d) = n(c) by MESON_TAC,-`;; unhide_constant "+";; default_prover := old_default_prover;; hol-light/miz3/Samples/sample.ml000066400000000000000000000007031303454263000170460ustar00rootroot00000000000000horizon := 1;; thm `; let R be num->num->bool; assume !x. R x x [1]; assume !x y z. R x y /\ R y z ==> R x z [2]; thus (!m n. m <= n ==> R m n) <=> (!n. R n (SUC n)) proof now [3] // back direction first assume !n. R n (SUC n); let m n be num; !d. R m (m + d) ==> R m (m + SUC d) [4] by 2,ADD_CLAUSES; R m (m + 0) by 1,ADD_CLAUSES; !d. R m (m + d) by 4,INDUCT_TAC; thus m <= n ==> R m n by LE_EXISTS; end; !n. n <= SUC n; qed by 3`;; hol-light/miz3/Samples/samples.ml000066400000000000000000000026631303454263000172400ustar00rootroot00000000000000horizon := 1;; thm `; !R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) ==> ((!m n. m <= n ==> R m n) <=> (!n. R n (SUC n))) proof let R be num->num->bool; assume !x. R x x [1]; assume !x y z. R x y /\ R y z ==> R x z [2]; !n. n <= SUC n by ARITH_TAC; (!m n. m <= n ==> R m n) ==> (!n. R n (SUC n)) [3] by SIMP_TAC; now assume !n. R n (SUC n) [4]; !m n d. n = m + d ==> R m (m + d) proof let m be num; R m m by MESON_TAC,1; R m (m + 0) [5] by REWRITE_TAC,ADD_CLAUSES; !d. R m (m + d) ==> R m (m + SUC d) proof let d be num; assume R m (m + d); R m (SUC (m + d)) by MESON_TAC,2,4; qed by REWRITE_TAC,ADD_CLAUSES; !d. R m (m + d) by INDUCT_TAC,5; !d n. n = m + d ==> R m (m + d) by REWRITE_TAC,LEFT_FORALL_IMP_THM,EXISTS_REFL,ADD_CLAUSES; qed by ONCE_REWRITE_TAC,SWAP_FORALL_THM; thus !m n. m <= n ==> R m n by SIMP_TAC,LE_EXISTS,LEFT_IMP_EXISTS_THM; end; qed by EQ_TAC,3`;; thm `; !s. INFINITE s ==> ?x:A. x IN s proof let s be A->bool; assume INFINITE s; ~(s = {}) by INFINITE_NONEMPTY; consider x such that ~(x IN s <=> x IN {}) [1] by EXTENSION; take x; ~(x IN {}) by NOT_IN_EMPTY; qed by 1`;; let NOT_EVEN = thm `; !n. ~EVEN n <=> ODD n proof ~EVEN 0 <=> ODD 0 [1] by EVEN,ODD; !n. (~EVEN n <=> ODD n) ==> (~EVEN (SUC n) <=> ODD (SUC n)) by EVEN,ODD; qed by 1,INDUCT_TAC`;; hol-light/miz3/Samples/talk.ml000066400000000000000000000055221303454263000165240ustar00rootroot00000000000000let ARITHMETIC_PROGRESSION_SIMPLE = prove (`!n. nsum(1..n) (\i. i) = (n*(n + 1)) DIV 2`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; horizon := 1;; thm `; !n. nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2 proof nsum(0..0) (\i. i) = 0 by NSUM_CLAUSES_NUMSEG; .= (0*(0 + 1)) DIV 2 [A1] by ARITH_TAC; now let n be num; assume nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2; nsum(0..SUC n) (\i. i) = (n*(n + 1)) DIV 2 + SUC n by NSUM_CLAUSES_NUMSEG,ARITH_RULE (parse_term "0 <= SUC n"); thus .= ((SUC n)*(SUC n + 1)) DIV 2 by ARITH_TAC; end; qed by INDUCT_TAC,A1`;; thm `; now (if 1 = 0 then 0 else 0) = (0 * (0 + 1)) DIV 2 [A1] by ARITH_TAC; nsum (1..0) (\i. i) = (0 * (0 + 1)) DIV 2 [A2] by REWRITE_TAC,NSUM_CLAUSES_NUMSEG,A1; now [A3] let n be num; assume nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 [A4]; (if 1 <= SUC n then (n * (n + 1)) DIV 2 + SUC n else (n * (n + 1)) DIV 2) = (SUC n * (SUC n + 1)) DIV 2 [A5] by ARITH_TAC; thus nsum (1..SUC n) (\i. i) = (SUC n * (SUC n + 1)) DIV 2 [A6] by REWRITE_TAC,NSUM_CLAUSES_NUMSEG,A4,A5; end; thus !n. nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 [A7] by INDUCT_TAC,A2,A3; end`;; let EXAMPLE = ref None;; EXAMPLE := Some `; !n. nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2 proof nsum(0..0) (\i. i) = (0*(0 + 1)) DIV 2; now let n be nat; assume nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2; thus nsum(0..SUC n) (\i. i) = ((SUC n)*(SUC n + 1)) DIV 2 by #; end; qed`;; thm `; !n. nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 proof (if 1 = 0 then 0 else 0) = (0 * (0 + 1)) DIV 2 by ARITH_TAC; nsum (1..0) (\i. i) = (0 * (0 + 1)) DIV 2 [A1] by ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG]; !n. nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 ==> nsum (1..SUC n) (\i .i) = (SUC n * (SUC n + 1)) DIV 2 proof let n be num; assume nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 [A2]; (if 1 <= SUC n then (n * (n + 1)) DIV 2 + SUC n else (n * (n + 1)) DIV 2) = (SUC n * (SUC n + 1)) DIV 2 by ARITH_TAC; qed by ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG],A2; qed by INDUCT_TAC,A1`;; let NSUM_CLAUSES_NUMSEG' = thm `; !s. nsum(0..0) s = s 0 /\ !n. nsum(0..n + 1) s = nsum(0..n) s + s (n + 1) proof !n. 0 <= SUC n by ARITH_TAC; qed by NSUM_CLAUSES_NUMSEG,ADD1`;; let num_INDUCTION' = REWRITE_RULE[ADD1] num_INDUCTION;; thm `; !s. (!i. s i = i) ==> !n. nsum(0..n) s = (n*(n + 1)) DIV 2 proof let s be num->num; assume !i. s i = i [A1]; set X = \n. (nsum(0..n) s = (n*(n + 1)) DIV 2); nsum(0..0) s = s 0 by NSUM_CLAUSES_NUMSEG'; .= 0 by A1; .= (0*(0 + 1)) DIV 2 by ARITH_TAC; X 0 [A2]; now [A3] let n be num; assume X n; nsum(0..n + 1) s = (n*(n + 1)) DIV 2 + s (n + 1) by NSUM_CLAUSES_NUMSEG'; .= (n*(n + 1)) DIV 2 + (n + 1) by A1; thus X (n + 1) by ARITH_TAC; end; !n. X n by MATCH_MP_TAC,num_INDUCTION',A2,A3; qed`;; hol-light/miz3/Samples/tobias.ml000066400000000000000000000037051303454263000170530ustar00rootroot00000000000000prioritize_real();; let rational = new_definition `rational(r) <=> ?p q. ~(q = 0) /\ (abs(r) = &p / &q)`;; horizon := 1;; let TOBIAS = thm `; let f be real->real; assume f(&0) = &1 [1]; assume !x y. f(x + y + &1) = f x + f y [2]; let r be real; assume rational r [3]; thus f r = r + &1 proof set g = \x. f(x) - &1; g(&0) = &0 [4] by 1,REAL_FIELD; now [5] let x be real; x + &1 = x + &0 + &1 by REAL_FIELD; g(x + &1) = (f x + f(&0)) - &1 by 2; thus ... = g x + &1 by 1,REAL_FIELD; end; now [6] let x be real; (x - &1) + &1 = x [7] by REAL_FIELD; g(x - &1) = (g(x - &1) + &1) - &1 by REAL_FIELD; thus ... = g(x) - &1 by 5,7; end; now [8] let x y be real; x + y = (x + y + &1) - &1 by REAL_FIELD; g(x + y) = (f x + f y) - &1 - &1 by 2,6; thus ... = g x + g y by 2,REAL_FIELD; end; now [9] let x be real; g(&0*x) = &0*(g x) [10] by 4,REAL_MUL_LZERO; now [11] let n be num; assume g(&n*x) = &n*(g x) [12]; &(SUC n) = &n + &1 [13] by ADD1,REAL_OF_NUM_ADD; &(SUC n)*x = &n*x + x by REAL_FIELD; g(&(SUC n)*x) = &n*(g x) + g x by 8,12; thus ... = &(SUC n)*g x by 13,REAL_FIELD; end; thus !n. g(&n*x) = &n*g(x) by INDUCT_TAC,10,11; end; &1 = &0 + &1 /\ -- &1 = &0 - &1 by REAL_FIELD; g(&1) = &1 /\ g(-- &1) = -- &1 [14] by 4,5,6; consider n m such that ~(m = 0) /\ (abs r = &n/ &m) [15] by 3,rational; 0 < m by ARITH_TAC; &0 < &m [16] by REAL_OF_NUM_LT; cases by REAL_FIELD; suppose &0 <= r; r = (&n* &1)/ &m [17] by 15,REAL_FIELD; &m*r = &n* &1 [18] by 16,REAL_FIELD; &m*g(r) = &n* &1 by 9,14,18; f r = r + &1 by 16,17,REAL_FIELD; qed; suppose r < &0; r = (&n*(-- &1))/ &m [19] by 15,REAL_FIELD; &m*r = &n*(-- &1) [20] by 16,REAL_FIELD; &m*g(r) = &n*(-- &1) by 9,14,20; f r = r + &1 by 16,19,REAL_FIELD; qed; end`;; hol-light/miz3/Samples/wishes.ml000066400000000000000000000011301303454263000170620ustar00rootroot00000000000000let EXAMPLE = prove (`!n. nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2`, INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; let EXAMPLE_IN_MIZAR_LIGHT = thm `; !n. nsum (0..n) (\i. i) = (n * (n + 1)) DIV 2 [1] proof nsum (0..0) (\i. i) = 0 [2] by NSUM_CLAUSES_NUMSEG; ... = (0 * (0 + 1)) DIV 2 [3] by ARITH_TAC; !n. nsum (0..n) (\i. i) = (n * (n + 1)) DIV 2 ==> nsum (0..SUC n) (\i. i) = (SUC n * (SUC n + 1)) DIV 2 [4] proof let n be num; assume nsum (0..n) (\i. i) = (n * (n + 1)) DIV 2 [5]; qed by #; qed by INDUCT_TAC from 3,4`;; hol-light/miz3/bin/000077500000000000000000000000001303454263000143775ustar00rootroot00000000000000hol-light/miz3/bin/miz3000077500000000000000000000015701303454263000152120ustar00rootroot00000000000000#!/bin/sh pidfile=/tmp/miz3_pid namefile=/tmp/miz3_filename name=$1 lemma=$2 if test "$name" = "" then echo "usage: miz3 filename [lemmaname]" 1>&2; exit 2 elif ! test -f "$name" then echo "$name: no such file" 1>&2; exit 2; fi if ! test -f "$pidfile" then echo "no server found" 1>&2; exit 1; fi pid=`cat $pidfile | head -1` echo "waiting for server to be free" 1>&2 while test -f $namefile; do sleep .1; done trap 'rm -f $namefile; exit' 2 echo "checking $name" 1>&2 perl -e 'use Cwd "realpath"; print realpath("'"$name"'")."\n";' > $namefile if test "$lemma" != "" then echo $lemma >> $namefile; fi kill -USR2 $pid >/dev/null 2>&1 if test "$?" -ne "0" then echo "server not running (pid = $pid)" 1>&2; rm -f $namefile; exit 1; fi while test -f $namefile; do sleep .1; done if grep 'MIZ3 EXCEPTION' $name >/dev/null then echo "exception" 1>&2; exit 0; fi echo "done" 1>&2 hol-light/miz3/bin/miz3e000077500000000000000000000013101303454263000153470ustar00rootroot00000000000000#!/usr/bin/perl -w use strict "subs"; $f = ($#ARGV >= 0 && $ARGV[0] eq "-e") ? (shift, 0) : 1;; $_ = << '--'; :: 1: inference error :: 2: inference time-out :: 3: skeleton error :: 4: unknown label :: 5: underspecified types hol :: 6: unbound free variables hol :: 7: syntax error justification or ocaml :: 8: syntax or type error hol :: 9: syntax error mizar -- s/(\D*(\d).*\n)/$m[$2] = $1/ge; while (<>) { @d = @e; print $_ if $f; s/\#([0-9])/$e[$1]++;/ge; if ($f) { $x = 0; foreach $i (1..9) { if (!$d[$i] && $e[$i]) { $x = 1, print "\n" if !$x && !/\n$/s; print $m[$i] } } } } if (!$f) { foreach $i (1..9) { print $m[$i] if $e[$i]; } } hol-light/miz3/bin/miz3f000077500000000000000000000022451303454263000153600ustar00rootroot00000000000000#!/usr/bin/perl -w use strict "subs"; $file = "/tmp/miz3_$$"; $x = "----------------------------------------------------------------\n"; undef $/; $_ = <>; if ($_ =~ /^(\n*[^\n]*thm\s+\`\;\s*\n)([^`]*)(\`\;\;[^`]*)$/s) { $a = $1; $b = $2; $c = $3; $b =~ s/^::.*\n//mg; $a =~ /^let ([^ ]+) / || $a =~ /^()/; $name = $1; $name =~ s/'/'"'"'/g; $s = ($b =~ /\;\s*$/s); $file = "$file.mz3"; open(FILE, "> $file"); print FILE $b; close FILE; system 'miz3 '.$file.' \''.$name.'\' > /dev/null 2>&1'; $e = $? >> 8; (print 'MIZ3 SERVER NOT RUNNING'."\n$x".$_.$x), (system "rm -f $file"), exit if $e == 1; (print 'MIZ3 FAILED'."\n$x".$_.$x), (system "rm -f $file"), exit if $e != 0 && $e != 1; $x = `cat $file`; $x =~ s/\s*;+\s*$//s if !$s; print "$a$x$c"; system "rm -f $file"; } else { $a = $_; $file = "$file.ml"; open(FILE, "> $file"); print FILE $a; close FILE; system 'miz3 '.$file.' > /dev/null 2>&1'; $e = $? >> 8; (print 'MIZ3 SERVER NOT RUNNING'."\n$x".$_.$x), (system "rm -f $file"), exit if $e == 1; (print 'MIZ3 FAILED'."\n$x".$_.$x), (system "rm -f $file"), exit if $e != 0 && $e != 1; print $a; system "rm -f $file"; } hol-light/miz3/exrc000066400000000000000000000004221303454263000145110ustar00rootroot00000000000000" put "source .../miz3/exrc" in your .exrc " in which ".../miz3" is the path of your miz3 directory :map  :w! :!miz3 % :e :map  A {/. !}miz3f / $ D^ :map  {/. !}miz3f /# l :map  :g/^::/d :map  /# :map  ?# :map  ^f`s(parse_term "/` s") hol-light/miz3/grammar/000077500000000000000000000000001303454263000152555ustar00rootroot00000000000000hol-light/miz3/grammar/miz3.y000066400000000000000000000040661303454263000163370ustar00rootroot00000000000000%{ #include extern int yylineno; %} %token ASSUME CASES CASE CONSIDER END LET NOW PROOF QED SET SUPPOSE TAKE THUS %token EXEC %token BE BEING BY FROM SUCH THAT %token OTHER /* ',' ';' '[' ']' '(' ')' */ %% steplist : | steplist step ; /* xstep : have_thus term labels by_just ';' | have_thus term labels PROOF | NOW labels | LET identlist BE term ';' | ASSUME term labels ';' | TAKE term ';' | CONSIDER identlist opttype SUCH THAT term labels by_just ';' | CONSIDER identlist opttype SUCH THAT term labels PROOF | SET term labels ';' | CASES by_just ';' | CASE ';' | SUPPOSE term labels ';' | QED by_just ';' | END ';' | EXEC ref ';' | ';' ; */ step : have_thus term labels by_just ';' | have_thus term labels PROOF proof_tail | NOW labels proof_tail | LET identlist BE term ';' | ASSUME term labels ';' | TAKE term ';' | CONSIDER identlist opttype SUCH THAT term labels by_just ';' | CONSIDER identlist opttype SUCH THAT term labels PROOF proof_tail | SET term labels ';' | CASES by_just ';' cases | EXEC ref ';' | ';' ; cases : | cases CASE ';' proof_tail | cases SUPPOSE term labels ';' proof_tail ; proof_tail : step proof_tail | QED by_just ';' | END ';' ; opttype : | BEING term ; labels : | labels '[' ident ']' ; by_just : | BY reflist | FROM reflist | BY reflist FROM reflist ; reflist : ref | reflist ',' ref ; ref : refitem | ref refitem ; refitem : OTHER | '(' expr ')' | '[' expr ']' ; term : termitem | term termitem ; termitem : OTHER | ',' | '(' expr ')' ; expr : | expr expritem ; expritem : OTHER | ',' | ';' | '(' expr ')' | '[' expr ']' ; identlist : ident | identlist ident ; ident : OTHER ; have_thus : | THUS ; %% #include /* int yylineno = 1; */ extern char *yytext; extern int yylex(); extern int yyparse(); int main() { (void) yyparse(); return 0; } int yywrap() { return 1; } int yyerror(s) char *s; { (void) fprintf(stderr, "%d: %s: unexpected \"%s\"\n", yylineno, s, yytext); return 0; } hol-light/miz3/make.ml000066400000000000000000000000521303454263000150730ustar00rootroot00000000000000#load "unix.cma";; loadt "miz3/miz3.ml";; hol-light/miz3/miz3.ml000066400000000000000000002075241303454263000150550ustar00rootroot00000000000000needs "Examples/holby.ml";; let horizon = ref 1;; let timeout = ref 1;; let default_prover = ref ("HOL_BY", CONV_TAC o HOL_BY);; let renumber_labels = ref true;; let extra_labels = ref 0;; let start_label = ref 1;; let growth_mode = ref true;; let proof_indent = ref " ";; let proof_width = ref 72;; let grow_haves = ref true;; let grow_duplicates = ref 0;; let indent_continued = ref false;; let sketch_mode = ref false;; let silent_server = ref 1;; let explain_errors = ref 1;; let miz3_pid = ref "/tmp/miz3_pid";; let miz3_filename = ref "/tmp/miz3_filename";; let ERRORS = ["1: inference error"; "2: inference time-out"; "3: skeleton error"; "4: unknown label"; "5: error ocaml (or justification)"; "6: underspecified types hol"; "7: unbound free variables hol"; "8: syntax or type error hol"; "9: syntax error mizar"];; let mizar_step_words = ["assume"; "cases"; "case"; "consider"; "end"; "let"; "now"; "proof"; "qed"; "set"; "suppose"; "take"; "thus"];; let mizar_step_words = mizar_step_words @ ["exec"];; let mizar_words = mizar_step_words @ ["be"; "being"; "by"; "from"; "such"; "that"];; let mizar_skip_bracketed = [","; ";"; "["];; reserve_words (subtract mizar_words (reserved_words()));; type by_item = | Label of string | Thm of string * thm | Tactic of string * (thm list -> tactic) | Grow of string * (thm list -> tactic) | Hole;; type step = int * (string * lexcode * string) list list * substep and substep = | Have of term * string list * just | Now of string list * just | Let of term list | Assume of term * string list | Thus of term * string list * just | Qed of just | Bracket_proof | Bracket_end | Take of term | Consider of term list * term * string list * just | Set of term * string list | Cases of just * just list | Bracket_case | Suppose of term * string list | Exec of string * tactic | Error of string * just | Error_point | Empty_step and just = | By of by_item list * by_item list * bool | Proof of step option * step list * step option | Proof_expected of bool | No_steps;; unset_jrh_lexer;; let system_ok = Unix.WEXITED 0;; let wronly = Unix.O_WRONLY;; let usr2_handler = ref (fun () -> print_string "usr2_handler\n");; Sys.signal Sys.sigusr2 (Sys.Signal_handle (fun _ -> !usr2_handler ()));; set_jrh_lexer;; let rawtoken = let collect (h,t) = end_itlist (^) (h::t) in let stringof p = atleast 1 p >> end_itlist (^) in let simple_ident = stringof(some isalnum) ||| stringof(some issymb) in let undertail = stringof (a "_") ++ possibly simple_ident >> collect in let ident = (undertail ||| simple_ident) ++ many undertail >> collect in let septok = stringof(some issep) in let stringchar = some (fun i -> i <> "\\" && i <> "\"") ||| (a "\\" ++ some (fun _ -> true) >> fun (_,x) -> "\\"^x) in let string = a "\"" ++ many stringchar ++ ((a "\"" >> K 0) ||| finished) >> (fun ((_,s),_) -> "\""^implode s^"\"") in (string ||| some isbra ||| septok ||| ident ||| a "`");; let rec whitespace e i = let non_newline i = if i <> [] && hd i <> "\n" then hd i,tl i else raise Noparse in let rest_of_line = many non_newline ++ (a "\n" ||| (finished >> K "")) >> fun x,y -> itlist (^) x y in let comment_string = match !comment_token with | Resword t -> t | Ident t -> t in match i with | [] -> if e then "",i else raise Noparse | (" " as c)::rst | ("\t" as c)::rst | ("\r" as c)::rst -> let s,rst1 = whitespace true rst in c^s,rst1 | ("\n" as c)::rst -> c,rst | _ -> let t,rst = rawtoken i in if t = comment_string then (rest_of_line >> fun x -> t^x) rst else if String.length t >= 2 && String.sub t 0 2 = "::" then (rest_of_line >> fun x -> if e then t^x else "") rst else if e then "",i else raise Noparse;; let lex1 = let reserve1 n = if is_reserved_word n then Resword n else Ident n in let rec tokens i = try (many (whitespace false) ++ rawtoken ++ whitespace true ++ tokens >> fun (((x,y),z),w) -> (implode x,reserve1 y,z)::w) i with Noparse -> [],i in fun l -> let (toks,rst) = tokens l in let rst',rst'' = many (whitespace false) rst in if rst'' <> [] then failwith "lex1" else if toks = [] then toks else let (x,y,z) = last toks in butlast toks@[x,y,z^implode rst'];; let lex2 = lex1 o explode;; let middle (_,x,_) = x;; let a' t toks = match toks with | ((_,Resword t',_) as tok)::rst when t = t' -> tok,rst | ((_,Ident t',_) as tok)::rst when t = t' -> tok,rst | _ -> raise Noparse;; let a_semi = a' ";";; let ident' toks = match toks with | (_,Ident s,_)::rst -> s,rst | (_,Resword "(",_)::(_,Ident s,_)::(_,Resword ")",_)::rst -> s,rst | _ -> raise Noparse;; let unident' s = if parses_as_binder s || can get_infix_status s || is_prefix s then ["",Resword "(",""; "",Ident s,""; "",Resword ")",""] else ["",Ident s,""];; let rec cut_to b n c l toks = match toks with | [] -> if b then [],[] else raise Noparse | tok::rst -> (match tok with | _,Resword s,_ | _,Ident s,_ -> let x = not (n > 0 && mem s mizar_skip_bracketed) in if mem s c && x then [tok],rst else if b && mem s l && x then [],toks else let stp1,rst1 = (match s with | "(" | "[" -> cut_to true (n + 1) c l rst | ")" | "]" -> cut_to true (if n > 0 then n - 1 else 0) c l rst | _ -> cut_to true n c l rst) in (tok::stp1),rst1);; let cut_step toks = match toks with | (_,Resword "proof",_ as tok)::rst -> [tok],rst | (_,Resword "now",_)::rst -> (a' "now" ++ (many (a' "[" ++ cut_to false 0 ["]"] mizar_step_words >> fun x,y -> x::y)) >> fun x,y -> x::(itlist (@) y [])) toks | _ -> cut_to false 0 [";"] mizar_step_words toks;; let rec cut_steps toks = let steps,rst = many cut_step toks in if rst = [] then steps else steps@[rst];; let strings_of_toks toks = let rec string_of_toks1 toks = match toks with | [] -> "","" | [x,Ident y,z] | [x,Resword y,z] -> x^y,z | (x,Ident y,z)::rst | (x,Resword y,z)::rst -> let u,v = string_of_toks1 rst in x^y^z^u,v in match toks with | [] -> "","","" | [x,Ident y,z] | [x,Resword y,z] -> x,y,z | (x,Ident y,z)::rst | (x,Resword y,z)::rst -> let u,v = string_of_toks1 rst in x,y^z^u,v;; let string_of_toks = middle o strings_of_toks;; let split_string = map string_of_toks o cut_steps o lex2;; let tok_of_toks toks = let x,y,z = strings_of_toks toks in x,Ident y,z;; let exec_phrase b s = let lexbuf = Lexing.from_string s in let ok = Toploop.execute_phrase b Format.std_formatter (!Toploop.parse_toplevel_phrase lexbuf) in Format.pp_print_flush Format.std_formatter (); (ok, let i = lexbuf.Lexing.lex_curr_pos in String.sub lexbuf.Lexing.lex_buffer i (lexbuf.Lexing.lex_buffer_len - i));; let exec_thm_out = ref TRUTH;; let exec_thm s = try let ok,rst = exec_phrase false ("exec_thm_out := (("^s^") : thm);;") in if not ok || rst <> "" then raise Noparse; !exec_thm_out with _ -> raise Noparse;; let exec_thmlist_tactic_out = ref REWRITE_TAC;; let exec_thmlist_tactic s = try let ok,rst = exec_phrase false ("exec_thmlist_tactic_out := (("^s^") : thm list -> tactic);;") in if not ok || rst <> "" then raise Noparse; !exec_thmlist_tactic_out with _ -> raise Noparse;; let exec_thmtactic_out = ref MATCH_MP_TAC;; let exec_thmtactic s = try let ok,rst = exec_phrase false ("exec_thmtactic_out := (("^s^") : thm -> tactic);;") in if not ok || rst <> "" then raise Noparse; !exec_thmtactic_out with _ -> raise Noparse;; let exec_tactic_out = ref ALL_TAC;; let exec_tactic s = try let ok,rst = exec_phrase false ("exec_tactic_out := (("^s^") : tactic);;") in if not ok || rst <> "" then raise Noparse; !exec_tactic_out with _ -> raise Noparse;; let exec_conv_out = ref NUM_REDUCE_CONV;; let exec_conv s = try let ok,rst = exec_phrase false ("exec_conv_out := (("^s^") : conv);;") in if not ok || rst <> "" then raise Noparse; !exec_conv_out with _ -> raise Noparse;; let (MP_ALL : tactic -> thm list -> tactic) = fun tac ths -> MAP_EVERY MP_TAC ths THEN tac;; let use_thms tac = fun ths -> tac ORELSE MP_ALL tac ths;; let by_item_cache = ref undefined;; let rec by_item_of_toks toks = match toks with | [_,Ident "#",_] -> Hole | (_,Ident "#",_)::toks' -> (match by_item_of_toks toks' with | Tactic(s,tac) -> Grow(s,tac) | _ -> failwith "by_item_of_toks") | [_,Ident "*",_] -> Label "*" | _ -> let s = string_of_toks toks in try apply (!by_item_cache) s with _ -> let i = try Thm (s, exec_thm s) with _ -> try Tactic (s, exec_thmlist_tactic s) with _ -> try Tactic (s, (exec_thmtactic s) o hd) with _ -> try Tactic (s, use_thms (exec_tactic s)) with _ -> try Tactic (s, use_thms (CONV_TAC (exec_conv s))) with _ -> match toks with | [_,Ident s,_] -> Label s | _ -> failwith "by_item_of_toks" in by_item_cache := (s |-> i) !by_item_cache; i;; let parse_by = let parse_by_item toks = match toks with | (_,Ident "#",_ as tok1)::(_,Ident s,_ as tok2)::toks when s <> "," -> [tok1;tok2],toks | (_,Ident _,_ as tok)::toks -> [tok],toks | _ -> raise Noparse in let parse_by_part = ((a' "by" ++ many (parse_by_item ++ a' "," >> fst) >> snd) ++ parse_by_item) >> (fun (x,y) -> x@[y]) ||| (nothing >> K []) and parse_from_part = ((a' "from" ++ many (parse_by_item ++ a' "," >> fst) >> snd) ++ parse_by_item) >> (fun (x,y) -> (x@[y]),true) ||| (nothing >> K ([],false)) in let rec will_grow l = match l with | [] -> false | Tactic _::_ -> false | Grow _::_ -> true | _::l' -> will_grow l' in ((parse_by_part ++ parse_from_part) ++ a_semi ++ finished >> fun (((x,(y,z)),_),_) -> let x' = map by_item_of_toks x in let y' = map by_item_of_toks y in By(x',y',z || will_grow (x'@y'))) ||| (finished >> K (Proof_expected true));; let rec parse_labels toks = match toks with | [] -> [] | (_,Resword "[",_)::(_,Ident s,_)::(_,Resword "]",_)::rst -> s::(parse_labels rst) | _ -> raise Noparse;; let rec type_of_pretype1 ty = match ty with Stv n -> failwith "type_of_pretype1" | Utv(v) -> mk_vartype(v) | Ptycon(con,args) -> mk_type(con,map type_of_pretype1 args);; let term_of_preterm1 = let rec term_of_preterm1 ptm = match ptm with Varp(s,pty) -> mk_var(s,type_of_pretype1 pty) | Constp(s,pty) -> mk_mconst(s,type_of_pretype1 pty) | Combp(l,r) -> mk_comb(term_of_preterm1 l,term_of_preterm1 r) | Absp(v,bod) -> mk_gabs(term_of_preterm1 v,term_of_preterm1 bod) | Typing(ptm,pty) -> term_of_preterm1 ptm in fun ptm -> term_of_preterm1 ptm;; let term_of_hol b = let error = mk_var("error",`:error`) in let term_of_hol1 env toks = let env' = ("thesis",Ptycon("bool",[])):: (map ((fun (s,ty) -> s,pretype_of_type ty) o dest_var) env) in try let ptm,l = (parse_preterm o map middle) toks in if l <> [] then (8,error) else try let tm = (term_of_preterm1 o retypecheck env') ptm in if not (subset (filter (fun v -> not (mem (fst (dest_var v)) ["..."; "thesis"])) (frees tm)) env) then (7,error) else if b && type_of tm <> bool_ty then (8,error) else (0,tm) with _ -> let tiw = !type_invention_warning in type_invention_warning := false; let tm = try (term_of_preterm o retypecheck env') ptm with e -> type_invention_warning := tiw; raise e in type_invention_warning := tiw; if not (subset (frees tm) env) then (7,error) else (6,error) with _ -> (8,error) in fun env toks -> match toks with | (x,Ident ".=",y)::rest -> term_of_hol1 env ((x,Ident "..."," ")::("",Ident "=",y)::rest) | _ -> term_of_hol1 env toks;; let type_of_hol = let error = `:error` in fun toks -> try (0,(parse_type o middle o strings_of_toks) toks) with _ -> (8,error);; let split_step toks = let cut_semi toks = match toks with | (_,Resword ";",_ as tok)::rst -> rev rst,[tok] | _ -> rev toks,[] in let rec cut_by_part rev_front toks = match toks with | [] | (_,Resword "by",_)::_ | (_,Resword "from",_)::_ -> rev_front,toks | tok::rst -> cut_by_part (tok::rev_front) rst in let rec group_by_items toks = match toks with | [] -> [] | (_,Resword "by",_ as tok)::rst | (_,Resword "from",_ as tok)::rst | (_,Ident ",",_ as tok)::rst | (_,Resword ";",_ as tok)::rst -> tok::group_by_items rst | (_,Ident "#",_ as tok)::toks' -> let toks1,toks2 = if toks' = [] then [],[] else cut_to false 0 [] ([","; ";"]@mizar_words) toks' in tok::(if toks1 = [] then [] else [tok_of_toks toks1])@ group_by_items toks2 | tok::rst -> let toks1,toks2 = cut_to false 0 [] ([","; ";"]@mizar_words) toks in if toks1 = [] then tok::group_by_items rst else (tok_of_toks toks1)::group_by_items toks2 in let rec cut_labs toks labs = match toks with | (_,Resword "]",_ as tok1)::(_,Ident _,_ as tok2):: (_,Resword "[",_ as tok3)::rst -> cut_labs rst (tok3::tok2::tok1::labs) | _ -> toks,labs in let rec cut_front toks tail = match toks with | [] -> [],tail | (_,Resword s,_)::rst when mem s mizar_words -> rev toks,tail | tok::rst -> cut_front rst (tok::tail) in let toks1,semi_part = cut_semi (rev toks) in let toks2,by_part = cut_by_part [] toks1 in let toks3,labs_part = cut_labs toks2 [] in let front_part,hol_part = cut_front toks3 [] in if front_part <> [] && middle (hd front_part) = Resword "exec" then let ml_tok = tok_of_toks ((tl front_part)@hol_part@labs_part@by_part) in [[hd front_part]; [ml_tok]; []; []; semi_part] else [front_part; hol_part; labs_part; group_by_items by_part; semi_part];; let parse_step env toks = let src = split_step toks in try match src with | [front_part; hol_part; labs_part; by_part; semi_part] -> let labs = parse_labels labs_part in let just,_ = parse_by (by_part@semi_part) in (match front_part with | [] -> (match toks with | [_,Resword ";",_] -> -1,src,Empty_step | _ -> let n,t = term_of_hol true env hol_part in if n <> 0 then n,src,Error(string_of_toks toks,just) else -1,src,Have(t,labs,just)) | (_,Resword key,_)::_ -> (match key,(tl front_part),(string_of_toks semi_part) with | "now",[],"" -> if hol_part <> [] || by_part <> [] then raise Noparse else -1,src,Now(labs,Proof_expected false) | "let",rst,";" -> if labs_part <> [] || by_part <> [] then raise Noparse else let x = (fst o fst o fst o many ident' ++ a' "be" ++ finished) rst in let n,t = type_of_hol hol_part in if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else -1,src,Let(map (fun s -> mk_var(s,t)) x) | "assume",[],";" -> if by_part <> [] then raise Noparse else let n,t = term_of_hol true env hol_part in if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else -1,src,Assume(t,labs) | "thus",[],_ -> let n,t = term_of_hol true env hol_part in if n <> 0 then n,src,Error(string_of_toks toks,just) else -1,src,Thus(t,labs,just) | "qed",[],_ -> if hol_part <> [] || labs_part <> [] then raise Noparse else -1,src,Qed just | "proof",[],"" -> if hol_part <> [] || labs_part <> [] || by_part <> [] then raise Noparse else -1,src,Bracket_proof | "end",[],";" -> if hol_part <> [] || labs_part <> [] || by_part <> [] then raise Noparse else -1,src,Bracket_end | "take",[],";" -> if labs_part <> [] || by_part <> [] then raise Noparse else let n,t = term_of_hol false env hol_part in if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else -1,src,Take t | "consider",rst,_ -> let cut_suchthat toks = match toks with | (_,Resword "that",_)::(_,Resword "such",_)::rst -> rst | _ -> raise Not_found in let rec cut_being toks tail = match toks with | [] -> raise Not_found | (_,Resword "being",_)::rst -> (rev rst),(rev tail) | tok::rst -> cut_being rst (tok::tail) in (try let rst1,rst2 = cut_being (cut_suchthat (rev rst)) [] in let n,t = type_of_hol rst2 in if n <> 0 then n,src,Error(string_of_toks toks,just) else let x = (fst o fst o many ident' ++ finished) rst1 in let vars = map (fun s -> mk_var(s,t)) x in let n,tm' = term_of_hol true (vars@env) hol_part in if n <> 0 then n,src,Error(string_of_toks toks,just) else -1,src,Consider(vars,tm',labs,just) with Not_found -> let x = (fst o fst o fst o fst o many ident' ++ a' "such" ++ a' "that" ++ finished) rst in let xy = (("",Ident "?","")::((flat (map unident' x))@ (("",Resword ".","")::hol_part))) in let n,tm = term_of_hol true env xy in if n <> 0 then n,src,Error(string_of_toks toks,just) else let vars,tm' = nsplit dest_exists x tm in -1,src,Consider(vars,tm',labs,just)) | "set",[],";" -> if by_part <> [] then raise Noparse else let (w,_),rst = (ident' ++ a' "=") hol_part in let n,t = term_of_hol false env rst in if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else -1,src,Set(mk_eq(mk_var(w,type_of t),t),labs) | "cases",[],_ -> if hol_part <> [] || labs_part <> [] then raise Noparse else -1,src,Cases(just,[]) | "case",[],";" -> if hol_part <> [] || labs_part <> [] || by_part <> [] then raise Noparse else -1,src,Bracket_case | "suppose",[],";" -> if by_part <> [] then raise Noparse else let n,t = term_of_hol true env hol_part in if n <> 0 then n,src,Error(string_of_toks toks,Proof_expected false) else -1,src,Suppose(t,labs) | "exec",[],";" -> let s = string_of_toks hol_part in -1,src,Exec(s,exec_tactic s) | _ -> raise Noparse) | _ -> raise Noparse) | _ -> raise Noparse with | Failure "by_item_of_toks" -> 5,src,Error(string_of_toks toks,No_steps) | _ -> 9,src,Error(string_of_toks toks,No_steps);; let rec steps_of_toks1 q e env toks = let prefix x (y,w,z) = (x@y),w,z in if toks = [] then if e then [9,[],Error_point],None,[] else [],None,[] else let stoks,rst = cut_step toks in let (status,src,substep as step) = parse_step env stoks in match substep with | Have (tm, labs, Proof_expected _) -> let just,rst1 = just_of_toks env rst in let step,rst2 = (match just with | Proof(_, _, _) -> (status,src,Have (tm, labs, just)),rst1 | _ -> (9,src,Error(string_of_toks stoks, No_steps)),rst) in prefix [step] (steps_of_toks1 q e env rst2) | Thus (tm, labs, Proof_expected _) -> let just,rst1 = just_of_toks env rst in let step,rst2 = (match just with | Proof(_, _, _) -> (status,src,Thus (tm, labs, just)),rst1 | _ -> (9,src,Error(string_of_toks stoks, No_steps)),rst) in prefix [step] (steps_of_toks1 q e env rst2) | Let vars -> prefix [step] (steps_of_toks1 q e ((rev vars)@env) rst) | Now (labs, Proof_expected _) -> let just,rst1 = now_of_toks env rst in prefix [status,src,Now (labs, just)] (steps_of_toks1 q e env rst1) | Consider (vars, _, _, By _) -> prefix [step] (steps_of_toks1 q e ((rev vars)@env) rst) | Consider (vars, tm, labs, Proof_expected _) -> let just,rst1 = just_of_toks env rst in let step,rst2 = (match just with | Proof(_, _, _) -> (status,src,Consider(vars, tm, labs, just)),rst1 | _ -> (9,src,Error(string_of_toks stoks, No_steps)),rst) in prefix [step] (steps_of_toks1 q e ((rev vars)@env) rst2) | Set (tm, _) -> prefix [step] (steps_of_toks1 q e ((fst (dest_eq tm))::env) rst) | Cases ((By _ as just), []) -> (try let justs,rst1 = many (case_of_toks env q) rst in let final,step1,rst2 = steps_of_toks1 false e env rst1 in let cases = status,src,Cases(just, justs) in if final <> [] then prefix [cases; 9,[],Error_point] (steps_of_toks1 q e env rst1) else [cases],step1,rst2 with Noparse -> prefix [9,src,Error(string_of_toks stoks, No_steps)] (steps_of_toks1 q e env rst)) | Qed just -> if q then [step],None,rst else prefix [(if e then 3 else 9),src,Error(string_of_toks stoks, No_steps)] (steps_of_toks1 q e env rst) | Bracket_end -> if e then [],Some step,rst else prefix [9,src,Error(string_of_toks stoks, No_steps)] (steps_of_toks1 q e env rst) | Bracket_proof | Cases (_, _) | Bracket_case | Suppose (_, _) -> prefix [9,src,Error(string_of_toks stoks, No_steps)] (steps_of_toks1 q e env rst) | Error (s, Proof_expected true) -> let just,rst1 = just_of_toks env rst in (match just with | Proof(_, _, _) -> prefix [status,src,Error(s, just)] (steps_of_toks1 q e env rst1) | _ -> prefix [status,src,Error(string_of_toks stoks, No_steps)] (steps_of_toks1 q e env rst)) | Error (s, Proof_expected false) -> let steps,step1,rst1 = steps_of_toks1 true true env rst in prefix [status,src,Error(s, Proof(None,steps,step1))] (steps_of_toks1 q e env rst) | Error (_, By _) -> prefix [status,src,Error(string_of_toks stoks, No_steps)] (steps_of_toks1 q e env rst) | _ -> prefix [step] (steps_of_toks1 q e env rst) and just_of_toks env toks = try let stoks,rst = cut_step toks in let (_,_,substep as step) = parse_step env stoks in if substep = Bracket_proof then let steps,step1,rst1 = steps_of_toks1 true true env rst in (Proof(Some step,steps,step1)),rst1 else (No_steps),toks with Noparse -> (No_steps),toks and now_of_toks env toks = let steps,step1,rst = steps_of_toks1 false true env toks in (Proof(None,steps,step1)),rst and case_of_toks env q toks = let stoks,rst = cut_step toks in let (_,_,substep as step) = parse_step env stoks in match substep with | Bracket_case -> let steps,step1,rst1 = steps_of_toks1 q true env rst in (Proof(Some step,steps,step1)),rst1 | Suppose (_, _) -> let steps,step1,rst1 = steps_of_toks1 q true env rst in (Proof(None,step::steps,step1)),rst1 | _ -> raise Noparse;; let steps_of_toks toks = let proof,_,rst = steps_of_toks1 false false [] toks in if rst = [] then proof else proof@[9,[rst],Error (string_of_toks rst, No_steps)];; let fix_semi toks = if toks = [] then toks else match last toks with | _,Resword ";",_ -> toks | _ -> toks@["\n",Resword ";",""];; let parse_proof = steps_of_toks o fix_semi o lex2;; exception Timeout;; Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout));; let TIMED_TAC n tac g = let _ = Unix.alarm n in try let gs = tac g in let _ = Unix.alarm 0 in gs with x -> let _ = Unix.alarm 0 in raise x;; let FAKE_TAC : bool -> thm list -> tactic = fun fake thl (asl,w as g) -> if fake then let tm' = itlist (curry mk_imp) (map concl thl) w in let vl = frees tm' in let tm = itlist (curry mk_forall) vl tm' in let th = itlist (C MP) (rev thl) (itlist SPEC (rev vl) (ASSUME tm)) in null_meta,[],(fun i _ -> INSTANTIATE_ALL i th) else NO_TAC g;; let MIZAR_NEXT : (goal -> step * goalstate) -> (goal -> step * goalstate) = let t = `T` in fun tac (asl,_ as g) -> let e,((mvs,insts),gls,just as gs) = tac g in match gls with | [] -> e,((mvs,insts),[asl,t],(fun _ _ -> just null_inst [])) | [gl] -> e,gs | _ -> failwith "MIZAR_NEXT";; let MIZAR_NEXT' : tactic -> tactic = let t = `T` in fun tac (asl,_ as g) -> let ((mvs,insts),gls,just as gs) = tac g in match gls with | [] -> ((mvs,insts),[asl,t],(fun _ _ -> just null_inst [])) | [gl] -> gs | _ -> failwith "MIZAR_NEXT'";; let fix_dots prevs tm = try let lhs,_ = dest_eq (hd prevs) in vsubst [lhs, mk_var("...",type_of lhs)] tm with _ -> tm;; let fix_dots' asl tm = try let th = snd (hd asl) in let lhs,_ = dest_eq (concl th) in let dots = mk_var("...",type_of lhs) in let rec fix_dots1 tm = (match tm with | Var _ when tm = dots -> th | Comb(t1,t2) -> MK_COMB(fix_dots1 t1,fix_dots1 t2) | Abs(x,t) -> ABS x (fix_dots1 t) | _ -> REFL tm) in if vfree_in dots tm then fix_dots1 tm else REFL tm with _ -> REFL tm;; let rec terms_of_step prevs (_,_,substep) = match substep with | Have (tm, _, _) -> [fix_dots prevs tm] | Now (_, just) -> [term_of_now just] | Assume (tm, _) -> [fix_dots prevs tm] | Thus (tm, _, _) -> [fix_dots prevs tm] | Consider (_, tm, _, _) -> [fix_dots prevs tm] | Set (tm, _) -> [fix_dots prevs tm] | Suppose (tm, _) -> [fix_dots prevs tm] | _ -> [] and term_of_now = let t = `T` in let rec term_of_steps prevs steps = match steps with | [] -> t | (_,_,substep as step)::rst -> let tm' = term_of_steps ((terms_of_step prevs step)@prevs) rst in (match substep with | Let vars -> list_mk_forall(vars,tm') | Assume (tm, _) -> mk_imp(fix_dots prevs tm,tm') | Thus (tm, _, _) -> mk_conj(fix_dots prevs tm,tm') | Take tm -> let var = genvar (type_of tm) in mk_exists(var,subst [var,tm] tm') | Consider (vars, _, _, _) -> if intersect (frees tm') vars <> [] then failwith "term_of_now" else tm' | Cases (_, _) -> failwith "term_of_now" | _ -> tm') in fun just -> match just with | Proof(_, steps, _) -> (rand o concl o PURE_REWRITE_CONV[AND_CLAUSES]) (term_of_steps [] steps) | _ -> failwith "term_of_now";; let terms_of_cases = let f = `F` in let rec terms_of_cases cases = match cases with | [] -> [],f | case::rst -> let l',tm' = terms_of_cases rst in (match case with | (_,_,Suppose (tm, _))::_ -> (()::l'),mk_disj(tm,tm') | _ -> failwith "terms_of_cases") in terms_of_cases o (map (fun just -> match just with | Proof(_, case, _) -> case | _ -> failwith "terms_of_cases"));; let print_to_string1 printer = let sbuff = ref "" in let output s m n = sbuff := (!sbuff)^(String.sub s m n) and flush() = () in let fmt = make_formatter output flush in ignore(pp_set_max_boxes fmt 100); fun prefix' n i -> let prefix = prefix'^(implode (replicate " " n)) in let m = String.length prefix in pp_set_margin fmt ((!proof_width) - m); ignore(printer fmt i); ignore(pp_print_flush fmt ()); let s = !sbuff in sbuff := ""; implode (map (fun x -> if x = "\n" then "\n"^prefix else x) (explode s));; let string_of_term1 = print_to_string1 pp_print_term;; let string_of_type1 = print_to_string1 pp_print_type;; let string_of_substep prefix substep = let string_of_vars tl = implode (map (fun v -> " "^fst (dest_var v)) tl) in let string_of_labs l = implode (map (fun s -> " ["^s^"]") l) in let rec string_of_by_items x l = match l with | [] -> "" | i::l' -> x^(match i with | Label s | Thm(s,_) | Tactic(s,_) | Grow(s,_) -> s | Hole -> "#")^string_of_by_items "," l' in let string_of_just just = match just with | By(l,l',_) -> (if l = [] then "" else " by"^string_of_by_items " " l)^ (if l' = [] then "" else " from"^string_of_by_items " " l')^";" | _ -> "" in prefix^ (match substep with | Have(tm,l,just) -> string_of_term1 prefix (if !indent_continued then String.length !proof_indent else 0) tm^ string_of_labs l^string_of_just just | Now(l,just) -> "now"^string_of_labs l | Let(tl) -> let s = "let"^string_of_vars tl^" be " in s^string_of_type1 prefix (String.length s) (type_of (hd tl))^";" | Assume(tm,l) -> let s = "assume " in s^string_of_term1 prefix (String.length s) tm^string_of_labs l^";" | Thus(tm,l,just) -> let s = "thus " in s^string_of_term1 prefix (String.length s) tm^string_of_labs l^ string_of_just just | Qed(just) -> "qed"^string_of_just just | Bracket_proof -> "proof" | Bracket_end -> "end;" | Take(tm) -> let s = "take " in s^string_of_term1 prefix (String.length s) tm^";" | Consider(tl,tm,l,just) -> let s = "consider"^string_of_vars tl^" such that " in s^string_of_term1 prefix (String.length s) tm^ string_of_labs l^string_of_just just | Set(tm,l) -> let s = "set " in s^string_of_term1 prefix (String.length s) tm^string_of_labs l^";" | Cases(just,_) -> "cases"^string_of_just just | Bracket_case -> "case;" | Suppose(tm,l) -> let s = "suppose " in s^string_of_term1 prefix (String.length s) tm^string_of_labs l^";" | Exec(s,_) -> "exec "^s^";" | Error(s,_) -> s | Empty_step -> "" | Error_point -> "")^ "\n";; let step_of_substep prefix substep = (-1,split_step (lex2 (string_of_substep prefix substep)),substep :step);; let step_of_obligation prefix lab tl ass tm = let hole = By([Hole],[],false) in let prefix' = prefix^ !proof_indent in let rec lets l = match l with | [] -> [] | t::_ -> let l',l'' = partition ((=) (type_of t) o type_of) l in step_of_substep prefix' (Let l')::lets l'' in step_of_substep prefix (if tl = [] && ass = [] then Have(tm,[lab],hole) else let ll = lets tl in let intros = ll@(map (fun a -> step_of_substep prefix' (Assume(a,[]))) ass) in if !grow_haves then Have(list_mk_forall(flat (map (function (_,_,Let l) -> l | _ -> []) ll), itlist (curry mk_imp) ass tm), [lab], Proof (Some (step_of_substep prefix Bracket_proof), intros@ [step_of_substep prefix (Qed(hole))], None)) else Now([lab], Proof (None, intros@ [step_of_substep prefix' (Thus(tm,[],hole))], Some (step_of_substep prefix Bracket_end))));; let steps_of_goals (asl,w :goal) (_,gl,_ :goalstate) prefix n = let ass = map (concl o snd) asl in let fv = union (flat (map frees ass)) (frees w) in let rec extra_ass l l' = if subset l ass then l' else extra_ass (tl l) ((hd l)::l') in let rec steps_of_goals1 n gl = match gl with | [] -> [],[],n | (asl',w')::gl' -> let ass' = map (concl o snd) asl' in let steps',labs',n' = steps_of_goals1 (n + 1) gl' in let lab = string_of_int n in ((step_of_obligation prefix lab (subtract (union (flat (map frees ass')) (frees w')) fv) (extra_ass ass' []) w')::steps'),lab::labs',n' in steps_of_goals1 n gl;; let next_growth_label = ref 0;; let connect_step (step:step) labs = let comma = "",Ident ",","" in let from_key = " ",Resword "from"," " in let rec ungrow_by src l = match l with | [] -> src,[] | Grow(name,tac)::l' -> (match src with | tok1::(_,Ident "#",_)::tok2::src' -> let src'',l'' = ungrow_by src' l' in (tok1::tok2::src''),(Tactic(name,tac)::l') | _ -> failwith "ungrow_by") | x::l' -> let toks,src' = chop_list 2 src in let src'',l'' = ungrow_by src' l' in (toks@src''),(x::l'') in let rec extra_from sep labs = match labs with | [] -> [] | lab::labs' -> sep::("",Ident lab,"")::extra_from comma labs' in let connect_just src4 just = match just with | By(l,l',b) -> let src4',l'' = ungrow_by src4 l in let src4'',l''' = ungrow_by src4' l' in (src4''@if labs = [] then [] else extra_from (if l' = [] then from_key else comma) labs), By(l'',(l'''@map (fun s -> Label s) labs),b) | _ -> src4,just in match step with | (e,[src1; src2; src3; src4; src5],substep) -> (match substep with | Have(x,y,just) -> let src4',just' = connect_just src4 just in (e,[src1; src2; src3; src4'; src5],Have(x,y,just')) | Thus(x,y,just) -> let src4',just' = connect_just src4 just in (e,[src1; src2; src3; src4'; src5],Thus(x,y,just')) | Qed just -> let src4',just' = connect_just src4 just in (e,[src1; src2; src3; src4'; src5],Qed just') | Consider(x,y,z,just) -> let src4',just' = connect_just src4 just in (e,[src1; src2; src3; src4'; src5],Consider(x,y,z,just')) | Cases(just,x) -> let src4',just' = connect_just src4 just in (e,[src1; src2; src3; src4'; src5],Cases(just',x)) | _ -> failwith "connect_step" :step) | _ -> failwith "connect_step";; let add_width n s = let rec add_width1 n s = match s with | [] -> n | "\t"::s' -> add_width1 ((n/8 + 1)*8) s' | "\n"::s' -> add_width1 0 s' | _::s' -> add_width1 (n + 1) s' in add_width1 n (explode s);; let rewrap_step (e,src,substep as step:step) = let rec rewrap_from x1 src4a src4b = match src4b with | [] -> rev src4a | (x,y,z)::(x',(Resword "from" as y'),z')::rst -> (rev src4a)@(x,y,"\n")::(x1,y',z')::rst | tok::rst -> rewrap_from x1 (tok::src4a) rst in match src with | [src1; src2; src3; src4; src5] -> if src4 = [] then step else let src123 = src1@src2@src3 in let x,y,z = strings_of_toks src123 in let x',y',_ = strings_of_toks src4 in if add_width 0 (x^y^z^x'^y') > !proof_width then let a,b,_ = last src123 in let src123' = (butlast src123)@[a,b,"\n"] in let src1',src23' = chop_list (length src1) src123' in let src2',src3' = chop_list (length src2) src23' in let _,b',c' = hd src4 in let x1 = x^ !proof_indent in let src4' = (x1,b',c')::tl src4 in let src4'' = if add_width 0 (x1^y') > !proof_width then rewrap_from x1 [] src4' else src4' in (e,[src1'; src2'; src3'; src4''; src5],substep) else (step:step) | _ -> failwith "rewrap_step";; let rec pp_step prefix step = let (e,_,substep) = step in let (_,src,substep') = rewrap_step (step_of_substep prefix substep) in let substep'' = (match substep' with | Have(x,y,just) -> Have(x,y,pp_just prefix just) | Now(x,just) -> Now(x,pp_just prefix just) | Thus(x,y,just) -> Thus(x,y,pp_just prefix just) | Qed(just) -> Qed(pp_just prefix just) | Consider(x,y,z,just) -> Consider(x,y,z,pp_just prefix just) | Cases(just,justl) -> Cases(pp_just prefix just,map (pp_just prefix) justl) | Error(x,just) -> Error(x,pp_just prefix just) | _ -> substep') in (e,src,substep'') and pp_just prefix just = let pp_step' step' = match step' with | Some step -> Some (pp_step prefix step) | None -> None in let prefix' = (!proof_indent)^prefix in let pp_step'' step = match step with | (_,_,Qed _) -> pp_step prefix step | (_,_,Suppose _) -> pp_step prefix step | _ -> pp_step prefix' step in match just with | Proof(step',stepl,step'') -> Proof(pp_step' step',map (pp_step'') stepl,pp_step' step'') | _ -> just;; let outdent n step = let (_,src,_) = step in match flat src with | (x,_,_)::_ -> let x' = explode x in if length x' < n then step else let _,x'' = chop_list n x' in pp_step (implode x'') step | _ -> step;; let replacement_steps (asl,w) f step = let n = String.length !proof_indent in let indent_of (_,src,substep) = let x,_,_ = hd (flat src) in match substep with | Qed _ -> x^ !proof_indent | _ -> x in let shift src2 src3 just = match just with | Proof _ -> if src3 <> [] then let (x,y,z) = last src3 in src2,((butlast src3)@[x,y,"\n"]) else if src2 <> [] then let (x,y,z) = last src2 in ((butlast src2)@[x,y,"\n"]),src3 else src2,src3 | _ -> src2,src3 in let steps,labs,n = f (indent_of step) (!next_growth_label) in next_growth_label := n; if !grow_duplicates > 1 then steps@[rewrap_step (connect_step step labs)] else match steps,step with | [e,[src1'; src2'; src3'; src4'; src5'],Have(tm',_,just')], (_,[src1; src2; src3; src4; src5],Have(tm,labs,_)) when tm' = tm -> let src2'',src3'' = shift src2 src3 just' in [e,[src1; src2''; src3''; src4'; src5'],Have(tm,labs,just')] | [e,[src1'; src2'; src3'; src4'; src5'],Have(tm',_,just')], (_,[src1; src2; src3; src4; src5],Thus(tm,labs,_)) when tm' = tm -> let src2'',src3'' = shift src2 src3 just' in [e,[src1; src2''; src3''; src4'; src5'],Thus(tm,labs,just')] | [e,_,Have(tm',_,Proof(_,y,_))], (_,_,Qed(_)) when tm' = w -> map (outdent n) y | [e,[src1'; src2'; src3'; src4'; src5'],Have(tm',_,(By _ as just'))], (_,[src1; src2; src3; src4; src5],Qed(_)) when tm' = w -> [e,[src1; src2; src3; src4'; src5'],Qed(just')] | _ -> if !grow_duplicates > 0 then steps@[rewrap_step (connect_step step labs)] else let al = map (fun x,y -> concl y,x) asl in let rec filter_growth steps labs steps' labs' = match steps with | [] -> (rev steps'),(rev labs') | ((_,_,Have(tm,_,_)) as step')::rst -> (try let lab' = assoc tm al in if lab' <> "" then filter_growth rst (tl labs) steps' (lab'::labs') else filter_growth rst (tl labs) (step'::steps') ((hd labs)::labs') with _ -> filter_growth rst (tl labs) (step'::steps') ((hd labs)::labs')) | step'::rst -> filter_growth rst (tl labs) (step'::steps') ((hd labs)::labs') in let steps',labs' = filter_growth steps labs [] [] in steps'@[rewrap_step (connect_step step labs')];; exception Grown of (string -> int -> step list * string list * int);; let (FILTER_ASSUMS : (int * (string * thm) -> bool) -> tactic) = let rec filter' f n l = match l with | [] -> [] | h::t -> let t' = filter' f (n + 1) t in if f (n,h) then h::t' else t' in fun f (asl,w) -> null_meta,[filter' f 0 asl,w],(fun i ths -> hd ths);; let (MAP_ASSUMS : (string * thm -> string * thm) -> tactic) = let FIRST_ASSUM' ttac' (asl,w as g) = tryfind (fun lth -> ttac' lth g) asl in fun f -> let rec recurse g = (FIRST_ASSUM' (fun (l,th as lth) -> UNDISCH_THEN (concl th) (fun th -> recurse THEN uncurry LABEL_TAC (f lth))) ORELSE ALL_TAC) g in recurse ORELSE FAIL_TAC "MAP_ASSUMS";; let (thenl': tactic -> (goal -> 'a * goalstate) list -> goal -> 'a list * goalstate) = let propagate_empty i _ = [] in let propagate_thm th i _ = INSTANTIATE_ALL i th in let compose_justs n just1 just2 i ths = let ths1,ths2 = chop_list n ths in (just1 i ths1)::(just2 i ths2) in let rec seqapply l1 l2 = match (l1,l2) with | ([],[]) -> [],(null_meta,[],propagate_empty) | (tac::tacs),(goal::goals) -> let a,((mvs1,insts1),gls1,just1) = tac goal in let goals' = map (inst_goal insts1) goals in let aa',((mvs2,insts2),gls2,just2) = seqapply tacs goals' in (a::aa'),((union mvs1 mvs2,compose_insts insts1 insts2), gls1@gls2,compose_justs (length gls1) just1 just2) | _,_ -> failwith "seqapply: Length mismatch" in let justsequence just1 just2 insts2 i ths = just1 (compose_insts insts2 i) (just2 i ths) in let tacsequence ((mvs1,insts1),gls1,just1) tacl = let aa,((mvs2,insts2),gls2,just2) = seqapply tacl gls1 in let jst = justsequence just1 just2 insts2 in let just = if gls2 = [] then propagate_thm (jst null_inst []) else jst in aa,((union mvs1 mvs2,compose_insts insts1 insts2),gls2,just) in fun tac1 tac2l g -> let _,gls,_ as gstate = tac1 g in if gls = [] then tacsequence gstate [] else tacsequence gstate tac2l;; let just_cache = ref undefined;; let tactic_of_by fake l l' b = (fun (asl,_ as g) -> let hor = if b then 0 else !horizon in let rec find_tactic l = match l with | [] -> !default_prover,false | (Tactic (name, tac))::l' -> (name,tac),false | (Grow (name, tac))::l' -> (name,tac),true | _::l' -> find_tactic l' in let sets = BETA_THM::map snd (filter (fun x,_ -> x = "=") asl) in let asl' = filter (fun x,_ -> x <> "=") asl in let rec find_thms l b = match l with | [] -> if b then [] else map (PURE_REWRITE_RULE sets o snd) (try fst (chop_list hor asl') with _ -> asl') | (Thm (_, th))::l' -> th::(find_thms l' b) | (Label "*")::l' -> (map (PURE_REWRITE_RULE sets o snd) asl')@(find_thms l' b) | (Label s)::l' -> (PURE_REWRITE_RULE sets (if s = "-" then snd (hd asl') else assoc s asl'))::(find_thms l' b) | _::l' -> find_thms l' b in let rec find_labs l = match l with | [] -> [] | (Label s)::l' -> s::(find_labs l') | _::l' -> find_labs l' in try let thms = find_thms l b in let thms' = find_thms l' true in let thms'' = thms@thms' in let (name,tac),grow = find_tactic (l@l') in if fake && (mem Hole l || mem Hole l') || not (!growth_mode) && grow then -2,FAKE_TAC fake thms'' g else let labs = find_labs l in let full_asl = hor < 0 || mem "*" labs in (try 0,((FILTER_ASSUMS (fun _,(x,_) -> x <> "=") THEN FILTER_ASSUMS (fun n,(x,_) -> mem x labs || n < hor || (n = 0 && mem "-" labs) || full_asl) THEN MAP_ASSUMS (fun l,th -> l,PURE_REWRITE_RULE sets th) THEN MIZAR_NEXT' (PURE_REWRITE_TAC sets) THEN (fun (asl',w' as g') -> let key = name,(map concl thms,map concl thms'),w' in try if grow then failwith "apply"; let e,th = apply (!just_cache) key in if e = 0 then (ACCEPT_TAC th THEN NO_TAC) g' else if e = 2 then raise Timeout else failwith "cached by" with | Failure "apply" -> try let (_,_,just as gs) = ((fun g'' -> let gs' = TIMED_TAC (!timeout) (tac thms) g'' in if grow then raise (Grown (steps_of_goals g gs')) else gs') THEN REPEAT (fun (asl'',_ as g'') -> if subset asl'' asl' then NO_TAC g'' else FIRST_ASSUM (UNDISCH_TAC o concl) g'') THEN TRY (FIRST (map ACCEPT_TAC thms'')) THEN REWRITE_TAC thms'' THEN NO_TAC) g' in let th = just null_inst [] in just_cache := (key |-> (0,th)) !just_cache; gs with | Grown _ as x -> raise x | x -> if name <> "GOAL_TAC" then just_cache := (key |-> ((if x = Timeout then 2 else 1),TRUTH)) !just_cache; raise x )) g) with | Grown _ as x -> raise x | x -> (if x = Timeout then 2 else 1),(FAKE_TAC fake thms'' g)) with Failure "find" | Failure "hd" -> 4,(FAKE_TAC fake [] g) : goal -> int * goalstate);; let LABELS_TAC ls th = if ls = [] then ASSUME_TAC th else EVERY (map (fun l -> LABEL_TAC l th) ls);; let PURE_EXACTLY_ONCE_REWRITE_TAC = let ONCE_COMB_QCONV conv tm = let l,r = dest_comb tm in try let th1 = conv l in AP_THM th1 r with Failure _ -> AP_TERM l (conv r) in let ONCE_SUB_QCONV conv tm = if is_abs tm then ABS_CONV conv tm else ONCE_COMB_QCONV conv tm in let rec EXACTLY_ONCE_DEPTH_QCONV conv tm = (conv ORELSEC (ONCE_SUB_QCONV (EXACTLY_ONCE_DEPTH_QCONV conv))) tm in let PURE_EXACTLY_ONCE_REWRITE_CONV thl = GENERAL_REWRITE_CONV false EXACTLY_ONCE_DEPTH_QCONV empty_net thl in fun thl -> CONV_TAC(PURE_EXACTLY_ONCE_REWRITE_CONV thl);; let EQTF_INTRO = let lemma = TAUT `(~t <=> T) <=> (t <=> F)` in fun th -> PURE_ONCE_REWRITE_RULE[lemma] (EQT_INTRO th);; let REWRITE_THESIS_TAC = let PROP_REWRITE_TAC = PURE_REWRITE_TAC[AND_CLAUSES; IMP_CLAUSES; NOT_CLAUSES; OR_CLAUSES; prop_2; TAUT `!t. (t <=> t) <=> T`] in fun th -> PURE_EXACTLY_ONCE_REWRITE_TAC[EQTF_INTRO th] THEN PROP_REWRITE_TAC;; let thesis_var = `thesis:bool`;; let rec tactic_of_step fake step (asl,w as g) = let justify tac just g = let (mvs,inst),gls,jst = tac g in (match gls with | [g1; g2] -> let (e,just'),((mvs',inst'),gls',jst') = tactic_of_just fake just g1 in let mvs'' = union mvs' mvs in let inst'' = compose_insts inst' inst in let gls'' = gls'@[g2] in let jst'' i ths = jst (compose_insts inst'' i) [jst' i (butlast ths); last ths] in (e,just'),((mvs'',inst''),gls'',jst'') | _ -> failwith "justify") in let SUBGOAL_THEN' tm tac = let th = fix_dots' asl tm in let lhs,_ = dest_eq (concl th) in SUBGOAL_THEN lhs tac THENL [MIZAR_NEXT' (CONV_TAC (K th)); ALL_TAC] in let fix_thesis tm = vsubst [w,thesis_var] tm in let e,src,substep = step in match substep with | Let tl -> (try (0,src,substep),(MAP_EVERY X_GEN_TAC tl g) with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) | Assume (tm, l) | Suppose (tm, l) -> (try (0,src,substep),(DISJ_CASES_THEN2 (fun th -> MIZAR_NEXT' (REWRITE_THESIS_TAC th) THEN LABELS_TAC l th) (fun th -> let th' = PURE_REWRITE_RULE[NOT_CLAUSES; IMP_CLAUSES] th in REWRITE_TAC[th'] THEN CONTR_TAC th' THEN NO_TAC) (SPEC (fix_thesis tm) EXCLUDED_MIDDLE) g) with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) | Have (tm, l, just) -> (try let (e,just'),gs = justify (SUBGOAL_THEN' (fix_thesis tm) (LABELS_TAC l)) just g in (e,src,Have(tm, l, just')),gs with x -> raise x) | Now (l, just) -> (try let (e,just'),gs = justify (SUBGOAL_THEN (term_of_now just) (LABELS_TAC l)) just g in (e,src,Now(l, just')),gs with x -> raise x) | Thus (tm, l, just) -> (try let (e,just'),gs = justify (SUBGOAL_THEN' (fix_thesis tm) (LABELS_TAC l) THENL [ALL_TAC; MIZAR_NEXT' (FIRST_ASSUM (fun th -> EVERY (map (fun th' -> REWRITE_THESIS_TAC th') (CONJUNCTS th))))]) just g in (e,src,Thus(tm, l, just')),gs with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) | Qed just -> (try let (e,just'),gs = tactic_of_just fake just g in (e,src,substep),gs with x -> raise x) | Take tm -> (try (0,src,substep),(EXISTS_TAC tm g) with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) | Consider (tl, tm, l, just) -> let tm' = itlist (curry mk_exists) tl (fix_thesis tm) in (try let (e,just'),gs = justify (SUBGOAL_THEN tm' ((EVERY_TCL (map X_CHOOSE_THEN tl)) (LABELS_TAC l))) just g in (e,src,Consider(tl, tm, l, just')),gs with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) | Set (tm, l) -> (try let v,_ = dest_eq tm in let tm' = mk_exists(v,tm) in let l' = if l = [] then ["="] else l in (0,src,substep), ((SUBGOAL_THEN tm' (X_CHOOSE_THEN v (LABELS_TAC l')) THENL [REWRITE_TAC[EXISTS_REFL] ORELSE FAKE_TAC fake []; ALL_TAC]) g) with x -> raise x) | Cases (just, cases) -> (try let l,tm = terms_of_cases cases in let steps,gs = (thenl' (SUBGOAL_THEN tm (EVERY_TCL (map (K (DISJ_CASES_THEN2 (fun th -> ASSUME_TAC th THEN FIRST_ASSUM (UNDISCH_TAC o concl)))) l) CONTR_TAC)) ((tactic_of_just fake just):: (map (fun just -> tactic_of_just fake just) cases)) g) in (match steps with | (e,just')::ecases' -> (e,src,Cases(just',map snd ecases')),gs | _ -> failwith "tactic_of_step") with x -> raise x) | Bracket_proof | Bracket_end | Bracket_case -> (3,src,substep),(ALL_TAC g) | Exec(_,tac) -> (try (0,src,substep),(TIMED_TAC (!timeout) tac THENL [ALL_TAC]) g with | Timeout as x -> if fake then (2,src,substep),(ALL_TAC g) else raise x | x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) | Error (_,_) | Error_point -> if fake then (e,src,substep),(ALL_TAC g) else failwith "tactic_of_step" | Empty_step -> (0,src,substep),(ALL_TAC g) and tactic_of_just fake just g = let bracket_step step e = match step with | None -> if e = 0 then None else Some (e, [], Error_point) | Some (_, src, substep) -> Some (e, src, substep) in let rec tactic_of_just1 l (_,w as g) = match l with | [] -> if is_const w && fst (dest_const w) = "T" then [],0,ACCEPT_TAC TRUTH g else [],3,FAKE_TAC fake (map snd (fst g)) g | step::l' -> (try let step',((mvs,inst),gls,just) = MIZAR_NEXT (tactic_of_step fake step) g in (match gls with | [g'] -> let l'',e,((mvs',inst'),gls',just') = tactic_of_just1 l' g' in let mvs'' = union mvs' mvs in let inst'' = compose_insts inst' inst in let gls'' = gls' in let just'' i ths = just (compose_insts inst'' i) [just' i ths] in step'::l'',e,((mvs'',inst''),gls'',just'') | _ -> failwith "tactic_of_just") with Grown f -> tactic_of_just1 (replacement_steps g f step@l') g) in match just with | By(l,l',b) -> let e,gs = tactic_of_by fake l l' b g in (e,just),gs | Proof(step1, l, step2) -> let l',e,gs = tactic_of_just1 l g in (0,Proof(bracket_step step1 0, l', bracket_step step2 e)),gs | _ -> failwith "tactic_of_just";; let parse_qproof s = steps_of_toks (fix_semi (tl (lex2 s)));; let rec src_of_step (e,src,substep) = [e,strings_of_toks (flat src)]@ match substep with | Have(_, _, just) -> src_of_just just | Now(_, just) -> src_of_just just | Thus(_, _, just) -> src_of_just just | Qed just -> src_of_just just | Consider(_, _, _, just) -> src_of_just just | Cases(just, cases) -> (src_of_just just)@(itlist (@) (map src_of_just cases) []) | Error(_, just) -> src_of_just just | _ -> [] and src_of_just just = let unpack step1 = match step1 with | Some step -> src_of_step step | _ -> [] in match just with | Proof(step1, steps, step2) -> (unpack step1)@(itlist (@) (map src_of_step steps) [])@(unpack step2) | _ -> [];; let src_of_steps steps = itlist (@) (map src_of_step steps) [];; let count_errors src = let rec count_errors1 src (n1,n2,n3) = match src with | [] -> n1,n2,n3 | (e,_)::src' -> count_errors1 src' (if e > 2 then (n1 + 1,n2,n3) else if e > 0 then (n1,n2 + 1,n3) else if e = -2 then (n1,n2,n3 + 1) else (n1,n2,n3)) in count_errors1 src (0,0,0);; let error_line l ee = let rec error_line1 s1 s2 n l ee = match l with | [] -> (s1^"\n"),s2,ee | (m,e)::l' -> let d = m - n - 1 in let d' = if d > 0 then d else 0 in let s' = "#"^string_of_int e in error_line1 (s1^(implode (replicate " " d'))^s') (if !explain_errors > 0 then if mem e ee then s2 else s2^":: "^(el (e - 1) ERRORS)^"\n" else s2) (add_width (n + d') s') l' (union ee [e]) in let s1,s2,ee' = error_line1 "::" "" 2 l (if !explain_errors > 1 then [] else ee) in (s1^s2),ee';; let insert_errors n s l ee = let rec insert_errors1 n s l ee = match s with | [] -> [],n,l,ee | ("\n" as c)::s' -> let s1,ee' = if l = [] then "",ee else error_line l ee in let s2,n1,l1,ee' = insert_errors1 0 s' [] ee' in (c::s1::s2),n1,l1,ee' | c::s' -> let s1,n1,l1,ee' = insert_errors1 (add_width n c) s' l ee in (c::s1),n1,l1,ee' in let s1,n1,l1,ee' = insert_errors1 n (explode s) l ee in (implode s1),n1,l1,ee';; let string_of_src m steps = let add_error l n e = if e > (if !sketch_mode then 2 else 0) then l@[n,e] else l in let rec string_of_src1 s n l s3' steps ee = match steps with | [] -> let s',n',l',ee' = insert_errors n s3' l ee in if l' = [] then s^s' else let s'',_,_,_ = insert_errors n' "\n" l' ee' in s^s'^s'' | (e,(s1,"",s3))::steps' -> string_of_src1 s n (add_error l n e) (s3'^s1^s3) steps' ee | (e,(s1,s2,s3))::steps' -> let s',n',l',ee' = insert_errors n (s3'^s1) l ee in let n'' = add_width n' s2 in string_of_src1 (s^s'^s2) n'' (add_error l' n'' e) s3 steps' ee' in string_of_src1 "" m [] "" steps [];; let print_boxed f s = let print_boxed_char c = if c = "\n" then Format.pp_print_cut f () else Format.pp_print_string f c in Format.pp_open_vbox f 0; do_list print_boxed_char (explode s); Format.pp_close_box f ();; let print_step f x = print_boxed f (string_of_src 0 (src_of_step x));; let print_qsteps f x = print_boxed f ("`;\n"^(string_of_src 0 (src_of_steps x))^"`");; #install_printer print_step;; #install_printer print_qsteps;; let GOAL_TAC g = current_goalstack := (mk_goalstate g)::!current_goalstack; ALL_TAC g;; let GOAL_FROM x = fun y -> x y THEN GOAL_TAC;; let ee s = let toks = lex2 s in let l,t = top_goal() in let env = itlist union (map frees l) (frees t) in let proof,step1,rst = steps_of_toks1 true false env toks in if rst <> [] || step1 <> None then failwith "ee" else (e o EVERY o map (fun step -> snd o tactic_of_step false step)) proof;; let check_proof steps = let step = match steps with | [_,_,Have (_, _, _) as step] -> step | [_,_,Now (_, _) as step] -> step | _ -> -1,[],Now([], Proof(None,steps, Some(-1,[],Bracket_end))) in let step',gs = tactic_of_step true step ([],thesis_var) in let steps' = match step' with | _,[],Now(_, Proof(_,steps',_)) -> steps' | step' -> [step'] in let _,gl,j = gs in if length gl <> 1 then failwith "thm" else let (asl,w) = hd gl in if length asl <> 1 || w <> thesis_var then failwith "thm" else let a = (concl o snd o hd) asl in let src' = src_of_steps steps' in steps',count_errors src',j ([],[a,thesis_var],[]) [ASSUME a];; exception Mizar_error of step list * (int * int * int);; let thm steps = let steps',(n1,n2,n3 as n),th = check_proof steps in if n1 + n2 + n3 = 0 then th else raise (Mizar_error(steps',n));; let thm_of_string = thm o parse_proof;; let rec labels_of_steps labels context steps = match steps with | [] -> labels | (_,_,substep)::rst -> (match substep with | Assume(_,labs) | Suppose(_,labs) | Set(_,(_::_ as labs)) -> let label = (labs,ref 0) in labels_of_steps (label::labels) (label::context) rst | Have(_,labs,just) | Thus(_,labs,just) | Consider(_,_,labs,just) | Now(labs,just) -> let label = (labs,ref 0) in let labels1 = labels_of_just (label::labels) context just in labels_of_steps labels1 (label::context) rst | Qed(just) -> let labels1 = labels_of_just labels context just in labels_of_steps labels1 context rst | Cases(just,justl) -> itlist (fun just' labels' -> labels_of_just labels' context just') (rev justl) (labels_of_just labels context just) | Error(_,_) -> raise Noparse | _ -> labels_of_steps labels context rst) and labels_of_just labels context just = let rec collect_strings l = match l with | [] -> [] | Label(s)::l' -> s::collect_strings l' | _::l' -> collect_strings l' in match just with | Proof(_,steps,_) -> labels_of_steps labels context steps | By(x,y,_) -> do_list (fun s -> do_list (fun _,n -> n := !n + 1) (filter (mem s o fst) context)) (subtract (collect_strings (x@y)) ["-"; "*"]); labels | _ -> labels;; let isnumber = forall isnum o explode;; let max_label labels = itlist max (map int_of_string (filter isnumber (flat (map fst labels)))) (-1);; let rec number_labels n labels = match labels with | [] -> [] | (oldlabs,count)::rst -> let newlabs,n' = (if !extra_labels > 1 || !count > 0 || (!extra_labels > 0 && exists isnumber oldlabs) then [string_of_int n],(n + 1) else [],n) in (oldlabs,newlabs)::(number_labels n' rst);; let rec renumber_steps labels context steps = let make_lab x1 y1 x2 y2 x3 y3 s = ([x1,Resword "[",y1; x2,Ident s,y2; x3,Resword "]",y3],[s]) in let rec renumber_labs b w src labs label = match labs with | [] -> if b then (make_lab "" "" "" "" "" w (hd (snd label)))," " else ([],[]),w | lab::rst when isnumber lab -> (match src with | (x1,Resword "[",y1)::(x2,Ident s',y2)::(x3,Resword "]",y3)::rstsrc -> let (src',labs'),w' = renumber_labs false y3 rstsrc rst label in let newsrc,newlabs = if b then make_lab x1 y1 x2 y2 x3 w' (hd (snd label)) else [],[] in ((newsrc@src'),(newlabs@labs')),if b then w else y3 | _ -> failwith "renumber_labs") | lab::rst -> (match src with | tok1::tok2::(x3,y3,z3)::rstsrc -> let (src',labs'),w' = renumber_labs b z3 rstsrc rst label in ((tok1::tok2::(x3,y3,w')::src'),(lab::labs')),w | _ -> failwith "renumber_labs") in let renumber_labs1 b src1 src labs label = let (x,y,w) = last src1 in let (src',labs'),w' = renumber_labs b w src labs label in let src1' = if w' <> w then (butlast src1)@[x,y,w'] else src1 in src1',src',labs' in match steps with | [] -> labels,[] | (e,src,substep)::rst -> (match src with | [src1; src2; src3; src4; src5] -> (match substep with | Assume(x,labs) -> let label = hd labels in let src2',src3',labs' = renumber_labs1 (snd label <> []) src2 src3 labs label in let labels',rst' = renumber_steps (tl labels) (label::context) rst in labels', (e,[src1; src2'; src3'; src4; src5],Assume(x,labs'))::rst' | Suppose(x,labs) -> let label = hd labels in let src2',src3',labs' = renumber_labs1 (snd label <> []) src2 src3 labs label in let labels',rst' = renumber_steps (tl labels) (label::context) rst in labels', (e,[src1; src2'; src3'; src4; src5],Suppose(x,labs'))::rst' | Set(x,(_::_ as labs)) -> let label = hd labels in let src2',src3',labs' = renumber_labs1 (snd label <> []) src2 src3 labs label in let labels',rst' = renumber_steps (tl labels) (label::context) rst in labels', (e,[src1; src2'; src3'; src4; src5],Set(x,labs'))::rst' | Have(x,labs,just) -> let label = hd labels in let src2',src3',labs' = renumber_labs1 (snd label <> []) src2 src3 labs label in let labels',src4',just' = renumber_just (tl labels) context src4 just in let labels'',rst' = renumber_steps labels' (label::context) rst in labels'', ((e,[src1; src2'; src3'; src4'; src5],Have(x,labs',just')):: rst') | Thus(x,labs,just) -> let label = hd labels in let src2',src3',labs' = renumber_labs1 (snd label <> []) src2 src3 labs label in let labels',src4',just' = renumber_just (tl labels) context src4 just in let labels'',rst' = renumber_steps labels' (label::context) rst in labels'', ((e,[src1; src2'; src3'; src4'; src5],Thus(x,labs',just')):: rst') | Qed(just) -> let labels',src4',just' = renumber_just labels context src4 just in let labels'',rst' = renumber_steps labels' context rst in labels'', ((e,[src1; src2; src3; src4'; src5],Qed(just')):: rst') | Consider(x,y,labs,just) -> let label = hd labels in let src2',src3',labs' = renumber_labs1 (snd label <> []) src2 src3 labs label in let labels',src4',just' = renumber_just (tl labels) context src4 just in let labels'',rst' = renumber_steps labels' (label::context) rst in labels'', ((e,[src1; src2'; src3'; src4'; src5], Consider(x,y,labs',just')):: rst') | Now(labs,just) -> let label = hd labels in let src1',src3',labs' = renumber_labs1 (snd label <> []) src1 src3 labs label in let labels',src4',just' = renumber_just (tl labels) context src4 just in let labels'',rst' = renumber_steps labels' (label::context) rst in labels'', ((e,[src1'; src2; src3'; src4'; src5],Now(labs',just')):: rst') | Cases(just,justl) -> let labels',src4',just' = renumber_just labels context src4 just in let labels'',justl'' = itlist (fun just' (labels',justl') -> let labels'',_,just'' = renumber_just labels' context [] just' in labels'',(just''::justl')) (rev justl) (labels',[]) in let labels''',rst' = renumber_steps labels'' context rst in labels''', ((e,[src1; src2; src3; src4'; src5],Cases(just',rev justl'')):: rst') | Error(_,_) -> raise Noparse | _ -> let labels',rst' = renumber_steps labels context rst in labels',((e,src,substep)::rst')) | _ -> failwith "renumber_steps") and renumber_just labels context src just = let rec renumber_by src l = match l with | [] -> [],src,[] | (Label s as x)::l' when isnumber s -> (match src with | tok::(x1,Ident _,x2 as tok')::src23 -> let labs = flat (map snd (filter (mem s o fst) context)) in let src2,src3,l'' = renumber_by src23 l' in if labs = [] then (tok::tok'::src2),src3,(x::l'') else let items = map (fun s -> Label s) labs in let labs' = tl labs in let src1 = flat (map (fun s -> ["",Ident ",",""; "",Ident s,x2]) labs') in (tok::(x1,Ident (hd labs), if labs' = [] then x2 else "")::src1@src2),src3,(items@l'') | _ -> failwith "renumber_by") | x::l' -> let src1,src23 = (match src with | tok::(_,Ident "#",_ as tok1)::(_,Ident s,_ as tok2)::src23 when s <> "," -> [tok;tok1;tok2],src23 | tok::(_,Ident _,_ as tok')::src23 -> [tok;tok'],src23 | _ -> failwith "renumber_by") in let src2,src3,l'' = renumber_by src23 l' in (src1@src2),src3,(x::l'') in match just with | Proof(x,steps,z) -> let labels',steps' = renumber_steps labels context steps in labels',src,Proof(x,steps',z) | By(x,y,z) -> let src1',src2,x' = renumber_by src x in let src2',_,y' = renumber_by src2 y in labels,(src1'@src2'),By(x',y',z) | _ -> labels,src,just;; let renumber_steps1 steps = let labels = rev (labels_of_steps [] [] steps) in let labels' = number_labels (!start_label) labels in snd (renumber_steps labels' [] steps);; let VERBOSE_TAC : bool -> tactic -> tactic = fun v tac g -> let call f x = let v' = !verbose in verbose := v; let y = (try f x with e -> verbose := v'; raise e) in verbose := v'; y in let (mvs,insts),gls,just = call tac g in (mvs,insts),gls,(call just);; let last_thm_internal = ref None;; let last_thm_internal' = ref None;; let last_thm () = match !last_thm_internal with | Some th -> last_thm_internal := None; th | None -> failwith "last_thm";; let check_file_verbose name lemma = let l = String.length name in if l >= 3 && String.sub name (l - 3) 3 = ".ml" then (let _ = exec_phrase false ("loadt \""^name^"\";;") in (0,0,0),TRUTH) else (last_thm_internal := None; let file = Pervasives.open_in name in let n = in_channel_length file in let s = String.create n in really_input file s 0 n; close_in file; let t,x,y = try let steps = parse_proof s in (if !growth_mode then try next_growth_label := 1 + max_label (labels_of_steps [] [] steps) with _ -> ()); let steps',((n1,n2,n3) as x),y = if !silent_server > 0 then let oldstdout = Unix.dup Unix.stdout in let cleanup () = Unix.dup2 oldstdout Unix.stdout in let newstdout = Unix.openfile "/dev/null" [wronly] 0 in Unix.dup2 newstdout Unix.stdout; try let x = check_proof steps in cleanup(); x with e -> cleanup(); raise e else check_proof steps in let steps'' = if !renumber_labels then try renumber_steps1 steps' with Noparse -> steps' else steps' in let y' = if n1 + n2 + n3 = 0 then y else ASSUME (concl y) in last_thm_internal := Some y; last_thm_internal' := Some y'; (match lemma with | Some s -> let _ = exec_phrase (!silent_server < 2 && n1 + n2 + n3 = 0) ("let "^s^" = "^ "match !last_thm_internal' with Some y -> y | None -> TRUTH;;") in by_item_cache := undefined; | None -> ()); string_of_src 0 (src_of_steps steps''),x,y with _ -> ("::#"^"10\n:: 10: MIZ3 EXCEPTION\n"^s),(1,0,0),TRUTH in let file = open_out name in output_string file t; close_out file; x,y);; let check_file name = let (n1,n2,n3),th = check_file_verbose name None in if n1 + n2 + n3 = 0 then th else failwith (string_of_int n1^"+"^string_of_int n2^"+"^string_of_int n3^ " errors");; usr2_handler := fun () -> let cleanup () = let _ = Unix.system ("rm -f "^(!miz3_filename)) in () in try let namefile = Pervasives.open_in !miz3_filename in let name = input_line namefile in let lemma = try Some (input_line namefile) with End_of_file -> None in close_in namefile; let _ = check_file_verbose name lemma in cleanup() with _ -> cleanup();; let exit_proc = ref (fun () -> ());; let server_up () = if Unix.fork() = 0 then (exit_proc := (fun () -> ()); (try let pidfile = open_out !miz3_pid in output_string pidfile ((string_of_int (Unix.getppid()))^"\n"); close_out pidfile with _ -> print_string "server_up failed\n"); exit 0) else let _ = Unix.wait() in ();; let server_down () = if Unix.fork() = 0 then (exit_proc := (fun () -> ()); (try let pidfile = Pervasives.open_in !miz3_pid in let pid_string = input_line pidfile in close_in pidfile; if pid_string <> string_of_int (Unix.getppid()) then failwith "server_down" else let _ = Unix.system ("rm -f "^(!miz3_pid)) in () with _ -> print_string "server_down failed\n"); exit 0) else let _ = Unix.wait() in ();; server_up();; exit_proc := server_down;; at_exit (fun _ -> !exit_proc ());; let reset_miz3 h = horizon := h; timeout := 1; default_prover := ("HOL_BY", CONV_TAC o HOL_BY); sketch_mode := false; just_cache := undefined; by_item_cache := undefined; current_goalstack := []; server_up();; hol-light/miz3/miz3_of_hol.ml000066400000000000000000000216031303454263000163730ustar00rootroot00000000000000needs "miz3.ml";; type script_step = | Tac of string * tactic | Par of script_step list list;; type prooftree = | Prooftree of goal * (string * tactic) * prooftree list | Open_goal of goal;; let read_script filename lemmaname = let rec check_semisemi l = match l with | ";"::";"::_ -> true | " "::l' -> check_semisemi l' | _ -> false in let file = open_in filename in let lemma_string = "let "^lemmaname^" = prove" in let n = String.length lemma_string in let rec read_script1 () = let s = input_line file in if String.length s >= n && String.sub s 0 n = lemma_string then (explode s)@"\n"::read_script2 () else read_script1 () and read_script2 () = let l = explode (input_line file) in if check_semisemi (rev l) then l else l@"\n"::read_script2 () in let l = read_script1 () in close_in file; l;; let rec tokenize l = match l with | [] -> [] | c::l' -> let l1,l23 = if isalnum c then many (some isalnum) l else [c],l' in let l2,l3 = many (some isspace) l23 in (implode l1,if l2 = [] then "" else " ")::tokenize l3;; let parse_script l = let rec parse_statement s l = match l with | ("`",_)::(",",_)::l' -> s,l' | (x,y)::l' -> parse_statement (s^x^y) l' | [] -> failwith "parse_statement" in let rec parse_tactic b n s y' l = match l with | ("\\",y)::l' when not b -> parse_tactic b n (s^y'^"\\\\") y l' | (x,y)::l' -> if n = 0 && (x = "THEN" || x = "THENL" || x = ";" || x = "]" || x = ")") then (Tac(s,exec_tactic s)),l else let n' = if x = "[" || x = "(" then n + 1 else if x = "]" || x = ")" then n - 1 else n in let x',b' = if x = "`" then if b then "(parse_term \"",(not b) else "\")",(not b) else x,b in parse_tactic b' n' (s^y'^x') y l' | [] -> failwith "parse_tactic" in let rec parse_tactics tacs l = let tac,l' = parse_tactic true 0 "" "" l in parse_tactics1 (tac::tacs) l' and parse_tactics1 tacs l = match l with | ("THEN",_)::l' -> parse_tactics tacs l' | ("THENL",_)::("[",_)::l' -> let tac,l'' = parse_par_tactics [] l' in parse_tactics1 (tac::tacs) l'' | _ -> (rev tacs),l and parse_par_tactics tacss l = let tacs,l' = parse_tactics [] l in match l' with | (";",_)::l'' -> parse_par_tactics (tacs::tacss) l'' | ("]",_)::l'' -> (Par (rev (tacs::tacss))),l'' | _ -> failwith "parse_par_tactics" in match l with | ("let",_)::_::("=",_)::("prove",_)::("(",_)::("`",_)::l' -> let s,l'' = parse_statement "" l' in let tacs,l''' = parse_tactics [] l'' in (match l''' with | [")",_; ";",_; ";",_] -> parse_term s,tacs | _ -> failwith "parse_script") | _ -> failwith "parse_script";; let read_script1 filename lemmaname = parse_script (tokenize (read_script filename lemmaname));; let tactic_of_script l = let rec tactic_of_script1 l = match l with | [] -> ALL_TAC | [Tac(_,tac)] -> tac | (Tac(_,tac))::l' -> tactic_of_script1 l' THEN tac | (Par ll)::l' -> tactic_of_script1 l' THENL (map (tactic_of_script1 o rev) ll) in tactic_of_script1 (rev l);; let run_script (tm,l) = prove(tm,tactic_of_script l);; let prooftree_of_script g l = let rec prooftrees_of gltl tl = match gltl with | [] -> [] | (gl,t)::rst -> let tl1,tl' = chop_list (length gl) tl in (t tl1)::prooftrees_of rst tl' in let prooftree_of_script2 t gltl = flat (map fst gltl),(fun tl -> t (prooftrees_of gltl tl)) in let rec prooftree_of_script1 g l = match l with | [] -> [g],(function [t] -> t | _ -> failwith "prooftree_of_script1") | (Tac(s,tac))::l' -> let gl,t = prooftree_of_script1 g l' in let gltl = map (fun g' -> let _,x,_ = tac g' in x,(fun tl -> Prooftree(g',(s,tac),tl))) gl in prooftree_of_script2 t gltl | (Par ll)::l' -> let gl,t = prooftree_of_script1 g l' in let gltl = map2 prooftree_of_script1 gl (map rev ll) in prooftree_of_script2 t gltl in let gl,t = prooftree_of_script1 g (rev l) in t (map (fun x -> Open_goal x) gl);; let goal_of_prooftree t = match t with | Prooftree(g,_,_) -> g | Open_goal(g) -> g;; let rec step_of_prooftree prefix n context t = let frees_of_goal (asl,w) = union (flat (map (frees o concl o snd) asl)) (frees w) in let rec extra_ass ass' ass = if subset ass' ass then [] else (hd ass')::(extra_ass (tl ass') ass) in let rec lets prefix l = match l with | [] -> [] | t::_ -> let l',l'' = partition ((=) (type_of t) o type_of) l in step_of_substep prefix (Let l')::lets prefix l'' in let rec intros prefix n ass = match ass with | [] -> [],n,[] | a::ass' -> let steps,n',context = intros prefix (n + 1) ass' in let lab = string_of_int n in (step_of_substep prefix (Assume(a,[lab]))::steps), n',((a,lab)::context) in let shift_labels steps = let labels = rev (labels_of_steps [] [] steps) in let labels' = map ((fun s -> [s],[string_of_int (int_of_string s - 1)]) o hd o fst) labels in snd (renumber_steps labels' [] steps) in let rec steps_of_prooftrees prefix n context (asl,_ as g) tl = match tl with | [] -> [],[],n,context | t'::tl' -> let (asl',w' as g') = goal_of_prooftree t' in let prefix' = prefix^(!proof_indent) in let ll = lets prefix' (subtract (frees_of_goal g') (frees_of_goal g)) in let vars = flat (map (function (_,_,Let l) -> l | _ -> []) ll) in let ass = extra_ass (map (concl o snd) asl') (map (concl o snd) asl) in let w'' = list_mk_forall(vars, itlist (curry mk_imp) ass w') in try let lab = assoc w'' context in let steps,labs,n',context' = steps_of_prooftrees prefix n context g tl' in steps,Label lab::labs,n',context' with Failure "find" -> if vars = [] && ass = [] then let steps,just,n',context' = steps_of_prooftree prefix n context t' in try let lab = assoc w'' context' in let steps',labs,n'',context'' = steps_of_prooftrees prefix n' context' g tl' in (steps@steps'),Label lab::labs,n'',context'' with Failure "find" -> let lab = string_of_int n' in let steps',labs,n'',context'' = steps_of_prooftrees prefix (n' + 1) ((w',lab)::context') g tl' in (steps@ [rewrap_step (step_of_substep prefix (Have(w'',[lab],just)))]@ steps'),Label lab::labs,n'',context'' else let lab = string_of_int n in let steps,n',context' = intros prefix' (n + 1) ass in let steps',just,n'',context'' = steps_of_prooftree prefix' n' (rev context'@context) t' in let qed = [rewrap_step (step_of_substep prefix (Qed just))] in let steps'',n''' = if steps' = [] then (steps'@qed),n'' else match last steps' with | _,_,Have(w''',_,Proof(_,steps''',_)) when w''' = w' -> (butlast steps'@ map (outdent (String.length !proof_indent)) (shift_labels steps''')),n'' | _ -> (steps'@qed),n'' in let steps''',labs,n'''',context''' = steps_of_prooftrees prefix n''' ((w'',lab)::context'') g tl' in (step_of_substep prefix (Have(w'',[lab], Proof (Some (step_of_substep prefix Bracket_proof), (ll@steps@steps''), None))):: steps'''),Label lab::labs,n'''',context''' and steps_of_prooftree prefix n context t = match t with | Prooftree((_,w as g),(s,tac),tl) -> let steps,f_labs,n',context' = steps_of_prooftrees prefix n context g tl in let b_labs = map ((fun x -> Label x) o C assoc context o concl o snd) (rev (fst g)) in steps,By((Tactic(s,K tac))::b_labs,f_labs,false),n',context' | Open_goal(g) -> [],By([Hole],[],false),n,context in let prefix' = prefix^(!proof_indent) in match t with | Prooftree((_,w as g),_,_) -> let steps,_,_,_ = steps_of_prooftrees prefix n context g [t] in (match last steps with | _,_,Have(_,_,just) -> step_of_substep prefix (Have(w,[string_of_int n], if length steps = 1 then just else let steps',_,_,_ = steps_of_prooftrees prefix' (n + 1) context g [t] in Proof (Some (step_of_substep prefix Bracket_proof), (butlast steps'@ [rewrap_step (step_of_substep prefix (Qed just))]), None))) | _ -> failwith "step_of_prooftree") | _ -> failwith "step_of_prooftree";; let miz3_of_hol filename lemmaname = let tm,l = read_script1 filename lemmaname in step_of_prooftree "" 1 [] (prooftree_of_script ([],tm) l);; hol-light/miz3/test.ml000066400000000000000000000006661303454263000151500ustar00rootroot00000000000000loadt "miz3/Samples/samples.ml";; loadt "miz3/Samples/sample.ml";; loadt "miz3/Samples/talk.ml";; loadt "miz3/Samples/drinker.ml";; loadt "miz3/Samples/irrat2.ml";; loadt "miz3/Samples/lagrange.ml";; loadt "miz3/Samples/lagrange1.ml";; loadt "miz3/Samples/icms.ml";; loadt "miz3/Samples/other_mizs.ml";; loadt "miz3/Samples/robbins.ml";; loadt "miz3/Samples/forster.ml";; loadt "miz3/Samples/luxury.ml";; loadt "miz3/Samples/tobias.ml";; hol-light/nets.ml000066400000000000000000000131011303454263000142440ustar00rootroot00000000000000(* ========================================================================= *) (* Term nets: reasonably fast lookup based on term matchability. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "basics.ml";; (* ------------------------------------------------------------------------- *) (* Term nets are a finitely branching tree structure; at each level we *) (* have a set of branches and a set of "values". Linearization is *) (* performed from the left of a combination; even in iterated *) (* combinations we look at the head first. This is probably fastest, and *) (* anyway it's useful to allow our restricted second order matches: if *) (* the head is a variable then then whole term is treated as a variable. *) (* ------------------------------------------------------------------------- *) type term_label = Vnet (* variable (instantiable) *) | Lcnet of (string * int) (* local constant *) | Cnet of (string * int) (* constant *) | Lnet of int;; (* lambda term (abstraction) *) type 'a net = Netnode of (term_label * 'a net) list * 'a list;; (* ------------------------------------------------------------------------- *) (* The empty net. *) (* ------------------------------------------------------------------------- *) let empty_net = Netnode([],[]);; (* ------------------------------------------------------------------------- *) (* Insert a new element into a net. *) (* ------------------------------------------------------------------------- *) let enter = let label_to_store lconsts tm = let op,args = strip_comb tm in if is_const op then Cnet(fst(dest_const op),length args),args else if is_abs op then let bv,bod = dest_abs op in let bod' = if mem bv lconsts then vsubst [genvar(type_of bv),bv] bod else bod in Lnet(length args),bod'::args else if mem op lconsts then Lcnet(fst(dest_var op),length args),args else Vnet,[] in let canon_eq x y = try Pervasives.compare x y = 0 with Invalid_argument _ -> false and canon_lt x y = try Pervasives.compare x y < 0 with Invalid_argument _ -> false in let rec sinsert x l = if l = [] then [x] else let h = hd l in if canon_eq h x then failwith "sinsert" else if canon_lt x h then x::l else h::(sinsert x (tl l)) in let set_insert x l = try sinsert x l with Failure "sinsert" -> l in let rec net_update lconsts (elem,tms,Netnode(edges,tips)) = match tms with [] -> Netnode(edges,set_insert elem tips) | (tm::rtms) -> let label,ntms = label_to_store lconsts tm in let child,others = try (snd F_F I) (remove (fun (x,y) -> x = label) edges) with Failure _ -> (empty_net,edges) in let new_child = net_update lconsts (elem,ntms@rtms,child) in Netnode ((label,new_child)::others,tips) in fun lconsts (tm,elem) net -> net_update lconsts (elem,[tm],net);; (* ------------------------------------------------------------------------- *) (* Look up a term in a net and return possible matches. *) (* ------------------------------------------------------------------------- *) let lookup = let label_for_lookup tm = let op,args = strip_comb tm in if is_const op then Cnet(fst(dest_const op),length args),args else if is_abs op then Lnet(length args),(body op)::args else Lcnet(fst(dest_var op),length args),args in let rec follow (tms,Netnode(edges,tips)) = match tms with [] -> tips | (tm::rtms) -> let label,ntms = label_for_lookup tm in let collection = try let child = assoc label edges in follow(ntms @ rtms, child) with Failure _ -> [] in if label = Vnet then collection else try collection @ follow(rtms,assoc Vnet edges) with Failure _ -> collection in fun tm net -> follow([tm],net);; (* ------------------------------------------------------------------------- *) (* Function to merge two nets (code from Don Syme's hol-lite). *) (* ------------------------------------------------------------------------- *) let merge_nets = let canon_eq x y = try Pervasives.compare x y = 0 with Invalid_argument _ -> false and canon_lt x y = try Pervasives.compare x y < 0 with Invalid_argument _ -> false in let rec set_merge l1 l2 = if l1 = [] then l2 else if l2 = [] then l1 else let h1 = hd l1 and t1 = tl l1 and h2 = hd l2 and t2 = tl l2 in if canon_eq h1 h2 then h1::(set_merge t1 t2) else if canon_lt h1 h2 then h1::(set_merge t1 l2) else h2::(set_merge l1 t2) in let rec merge_nets (Netnode(l1,data1),Netnode(l2,data2)) = let add_node ((lab,net) as p) l = try let (lab',net'),rest = remove (fun (x,y) -> x = lab) l in (lab',merge_nets (net,net'))::rest with Failure _ -> p::l in Netnode(itlist add_node l2 (itlist add_node l1 []), set_merge data1 data2) in merge_nets;; hol-light/normalizer.ml000066400000000000000000000605771303454263000155000ustar00rootroot00000000000000(* ========================================================================= *) (* Relatively efficient HOL conversions for canonical polynomial form. *) (* *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "calc_num.ml";; let SEMIRING_NORMALIZERS_CONV = let SEMIRING_PTHS = prove (`(!x:A y z. add x (add y z) = add (add x y) z) /\ (!x y. add x y = add y x) /\ (!x. add r0 x = x) /\ (!x y z. mul x (mul y z) = mul (mul x y) z) /\ (!x y. mul x y = mul y x) /\ (!x. mul r1 x = x) /\ (!x. mul r0 x = r0) /\ (!x y z. mul x (add y z) = add (mul x y) (mul x z)) /\ (!x. pwr x 0 = r1) /\ (!x n. pwr x (SUC n) = mul x (pwr x n)) ==> (mul r1 x = x) /\ (add (mul a m) (mul b m) = mul (add a b) m) /\ (add (mul a m) m = mul (add a r1) m) /\ (add m (mul a m) = mul (add a r1) m) /\ (add m m = mul (add r1 r1) m) /\ (mul r0 m = r0) /\ (add r0 a = a) /\ (add a r0 = a) /\ (mul a b = mul b a) /\ (mul (add a b) c = add (mul a c) (mul b c)) /\ (mul r0 a = r0) /\ (mul a r0 = r0) /\ (mul r1 a = a) /\ (mul a r1 = a) /\ (mul (mul lx ly) (mul rx ry) = mul (mul lx rx) (mul ly ry)) /\ (mul (mul lx ly) (mul rx ry) = mul lx (mul ly (mul rx ry))) /\ (mul (mul lx ly) (mul rx ry) = mul rx (mul (mul lx ly) ry)) /\ (mul (mul lx ly) rx = mul (mul lx rx) ly) /\ (mul (mul lx ly) rx = mul lx (mul ly rx)) /\ (mul lx rx = mul rx lx) /\ (mul lx (mul rx ry) = mul (mul lx rx) ry) /\ (mul lx (mul rx ry) = mul rx (mul lx ry)) /\ (add (add a b) (add c d) = add (add a c) (add b d)) /\ (add (add a b) c = add a (add b c)) /\ (add a (add c d) = add c (add a d)) /\ (add (add a b) c = add (add a c) b) /\ (add a c = add c a) /\ (add a (add c d) = add (add a c) d) /\ (mul (pwr x p) (pwr x q) = pwr x (p + q)) /\ (mul x (pwr x q) = pwr x (SUC q)) /\ (mul (pwr x q) x = pwr x (SUC q)) /\ (mul x x = pwr x 2) /\ (pwr (mul x y) q = mul (pwr x q) (pwr y q)) /\ (pwr (pwr x p) q = pwr x (p * q)) /\ (pwr x 0 = r1) /\ (pwr x 1 = x) /\ (mul x (add y z) = add (mul x y) (mul x z)) /\ (pwr x (SUC q) = mul x (pwr x q))`, STRIP_TAC THEN SUBGOAL_THEN `(!m:A n. add m n = add n m) /\ (!m n p. add (add m n) p = add m (add n p)) /\ (!m n p. add m (add n p) = add n (add m p)) /\ (!x. add x r0 = x) /\ (!m n. mul m n = mul n m) /\ (!m n p. mul (mul m n) p = mul m (mul n p)) /\ (!m n p. mul m (mul n p) = mul n (mul m p)) /\ (!m n p. mul (add m n) p = add (mul m p) (mul n p)) /\ (!x. mul x r1 = x) /\ (!x. mul x r0 = r0)` MP_TAC THENL [ASM_MESON_TAC[]; MAP_EVERY (fun t -> UNDISCH_THEN t (K ALL_TAC)) [`!x:A y z. add x (add y z) = add (add x y) z`; `!x:A y. add x y :A = add y x`; `!x:A y z. mul x (mul y z) = mul (mul x y) z`; `!x:A y. mul x y :A = mul y x`] THEN STRIP_TAC] THEN ASM_REWRITE_TAC[num_CONV `2`; num_CONV `1`] THEN SUBGOAL_THEN `!m n:num x:A. pwr x (m + n) :A = mul (pwr x m) (pwr x n)` ASSUME_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]; ALL_TAC] THEN SUBGOAL_THEN `!x:A y:A n:num. pwr (mul x y) n = mul (pwr x n) (pwr y n)` ASSUME_TAC THENL [GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!x:A m:num n. pwr (pwr x m) n = pwr x (m * n)` (fun th -> ASM_MESON_TAC[th]) THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES]) and true_tm = concl TRUTH in fun sth rth (is_semiring_constant, SEMIRING_ADD_CONV, SEMIRING_MUL_CONV, SEMIRING_POW_CONV) -> let [pthm_01; pthm_02; pthm_03; pthm_04; pthm_05; pthm_06; pthm_07; pthm_08; pthm_09; pthm_10; pthm_11; pthm_12; pthm_13; pthm_14; pthm_15; pthm_16; pthm_17; pthm_18; pthm_19; pthm_20; pthm_21; pthm_22; pthm_23; pthm_24; pthm_25; pthm_26; pthm_27; pthm_28; pthm_29; pthm_30; pthm_31; pthm_32; pthm_33; pthm_34; pthm_35; pthm_36; pthm_37; pthm_38] = CONJUNCTS(MATCH_MP SEMIRING_PTHS sth) in let add_tm = rator(rator(lhand(concl pthm_07))) and mul_tm = rator(rator(lhand(concl pthm_13))) and pow_tm = rator(rator(rand(concl pthm_32))) and zero_tm = rand(concl pthm_06) and one_tm = rand(lhand(concl pthm_14)) and ty = type_of(rand(concl pthm_01)) in let p_tm = `p:num` and q_tm = `q:num` and zeron_tm = `0` and onen_tm = `1` and a_tm = mk_var("a",ty) and b_tm = mk_var("b",ty) and c_tm = mk_var("c",ty) and d_tm = mk_var("d",ty) and lx_tm = mk_var("lx",ty) and ly_tm = mk_var("ly",ty) and m_tm = mk_var("m",ty) and rx_tm = mk_var("rx",ty) and ry_tm = mk_var("ry",ty) and x_tm = mk_var("x",ty) and y_tm = mk_var("y",ty) and z_tm = mk_var("z",ty) in let dest_add = dest_binop add_tm and dest_mul = dest_binop mul_tm and dest_pow tm = let l,r = dest_binop pow_tm tm in if is_numeral r then l,r else failwith "dest_pow" and is_add = is_binop add_tm and is_mul = is_binop mul_tm in let nthm_1,nthm_2,sub_tm,neg_tm,dest_sub,is_sub = if concl rth = true_tm then rth,rth,true_tm,true_tm, (fun t -> t,t),K false else let nthm_1 = SPEC x_tm (CONJUNCT1 rth) and nthm_2 = SPECL [x_tm; y_tm] (CONJUNCT2 rth) in let sub_tm = rator(rator(lhand(concl nthm_2))) and neg_tm = rator(lhand(concl nthm_1)) in let dest_sub = dest_binop sub_tm and is_sub = is_binop sub_tm in (nthm_1,nthm_2,sub_tm,neg_tm,dest_sub,is_sub) in fun variable_order -> (* ------------------------------------------------------------------------- *) (* Conversion for "x^n * x^m", with either x^n = x and/or x^m = x possible. *) (* Also deals with "const * const", but both terms must involve powers of *) (* the same variable, or both be constants, or behaviour may be incorrect. *) (* ------------------------------------------------------------------------- *) let POWVAR_MUL_CONV tm = let l,r = dest_mul tm in if is_semiring_constant l && is_semiring_constant r then SEMIRING_MUL_CONV tm else try let lx,ln = dest_pow l in try let rx,rn = dest_pow r in let th1 = INST [lx,x_tm; ln,p_tm; rn,q_tm] pthm_29 in let tm1,tm2 = dest_comb(rand(concl th1)) in TRANS th1 (AP_TERM tm1 (NUM_ADD_CONV tm2)) with Failure _ -> let th1 = INST [lx,x_tm; ln,q_tm] pthm_31 in let tm1,tm2 = dest_comb(rand(concl th1)) in TRANS th1 (AP_TERM tm1 (NUM_SUC_CONV tm2)) with Failure _ -> try let rx,rn = dest_pow r in let th1 = INST [rx,x_tm; rn,q_tm] pthm_30 in let tm1,tm2 = dest_comb(rand(concl th1)) in TRANS th1 (AP_TERM tm1 (NUM_SUC_CONV tm2)) with Failure _ -> INST [l,x_tm] pthm_32 in (* ------------------------------------------------------------------------- *) (* Remove "1 * m" from a monomial, and just leave m. *) (* ------------------------------------------------------------------------- *) let MONOMIAL_DEONE th = try let l,r = dest_mul(rand(concl th)) in if l = one_tm then TRANS th (INST [r,x_tm] pthm_01) else th with Failure _ -> th in (* ------------------------------------------------------------------------- *) (* Conversion for "(monomial)^n", where n is a numeral. *) (* ------------------------------------------------------------------------- *) let MONOMIAL_POW_CONV = let rec MONOMIAL_POW tm bod ntm = if not(is_comb bod) then REFL tm else if is_semiring_constant bod then SEMIRING_POW_CONV tm else let lop,r = dest_comb bod in if not(is_comb lop) then REFL tm else let op,l = dest_comb lop in if op = pow_tm && is_numeral r then let th1 = INST [l,x_tm; r,p_tm; ntm,q_tm] pthm_34 in let l,r = dest_comb(rand(concl th1)) in TRANS th1 (AP_TERM l (NUM_MULT_CONV r)) else if op = mul_tm then let th1 = INST [l,x_tm; r,y_tm; ntm,q_tm] pthm_33 in let xy,z = dest_comb(rand(concl th1)) in let x,y = dest_comb xy in let thl = MONOMIAL_POW y l ntm and thr = MONOMIAL_POW z r ntm in TRANS th1 (MK_COMB(AP_TERM x thl,thr)) else REFL tm in fun tm -> let lop,r = dest_comb tm in let op,l = dest_comb lop in if op <> pow_tm || not(is_numeral r) then failwith "MONOMIAL_POW_CONV" else if r = zeron_tm then INST [l,x_tm] pthm_35 else if r = onen_tm then INST [l,x_tm] pthm_36 else MONOMIAL_DEONE(MONOMIAL_POW tm l r) in (* ------------------------------------------------------------------------- *) (* Multiplication of canonical monomials. *) (* ------------------------------------------------------------------------- *) let MONOMIAL_MUL_CONV = let powvar tm = if is_semiring_constant tm then one_tm else try let lop,r = dest_comb tm in let op,l = dest_comb lop in if op = pow_tm && is_numeral r then l else failwith "" with Failure _ -> tm in let vorder x y = if x = y then 0 else if x = one_tm then -1 else if y = one_tm then 1 else if variable_order x y then -1 else 1 in let rec MONOMIAL_MUL tm l r = try let lx,ly = dest_mul l in let vl = powvar lx in try let rx,ry = dest_mul r in let vr = powvar rx in let ord = vorder vl vr in if ord = 0 then let th1 = INST [lx,lx_tm; ly,ly_tm; rx,rx_tm; ry,ry_tm] pthm_15 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = AP_THM (AP_TERM tm3 (POWVAR_MUL_CONV tm4)) tm2 in let th3 = TRANS th1 th2 in let tm5,tm6 = dest_comb(rand(concl th3)) in let tm7,tm8 = dest_comb tm6 in let th4 = MONOMIAL_MUL tm6 (rand tm7) tm8 in TRANS th3 (AP_TERM tm5 th4) else let th0 = if ord < 0 then pthm_16 else pthm_17 in let th1 = INST [lx,lx_tm; ly,ly_tm; rx,rx_tm; ry,ry_tm] th0 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm2 in TRANS th1 (AP_TERM tm1 (MONOMIAL_MUL tm2 (rand tm3) tm4)) with Failure _ -> let vr = powvar r in let ord = vorder vl vr in if ord = 0 then let th1 = INST [lx,lx_tm; ly,ly_tm; r,rx_tm] pthm_18 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = AP_THM (AP_TERM tm3 (POWVAR_MUL_CONV tm4)) tm2 in TRANS th1 th2 else if ord < 0 then let th1 = INST [lx,lx_tm; ly,ly_tm; r,rx_tm] pthm_19 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm2 in TRANS th1 (AP_TERM tm1 (MONOMIAL_MUL tm2 (rand tm3) tm4)) else INST [l,lx_tm; r,rx_tm] pthm_20 with Failure _ -> let vl = powvar l in try let rx,ry = dest_mul r in let vr = powvar rx in let ord = vorder vl vr in if ord = 0 then let th1 = INST [l,lx_tm; rx,rx_tm; ry,ry_tm] pthm_21 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in TRANS th1 (AP_THM (AP_TERM tm3 (POWVAR_MUL_CONV tm4)) tm2) else if ord > 0 then let th1 = INST [l,lx_tm; rx,rx_tm; ry,ry_tm] pthm_22 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm2 in TRANS th1 (AP_TERM tm1 (MONOMIAL_MUL tm2 (rand tm3) tm4)) else REFL tm with Failure _ -> let vr = powvar r in let ord = vorder vl vr in if ord = 0 then POWVAR_MUL_CONV tm else if ord > 0 then INST [l,lx_tm; r,rx_tm] pthm_20 else REFL tm in fun tm -> let l,r = dest_mul tm in MONOMIAL_DEONE(MONOMIAL_MUL tm l r) in (* ------------------------------------------------------------------------- *) (* Multiplication by monomial of a polynomial. *) (* ------------------------------------------------------------------------- *) let POLYNOMIAL_MONOMIAL_MUL_CONV = let rec PMM_CONV tm = let l,r = dest_mul tm in try let y,z = dest_add r in let th1 = INST [l,x_tm; y,y_tm; z,z_tm] pthm_37 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = MK_COMB(AP_TERM tm3 (MONOMIAL_MUL_CONV tm4), PMM_CONV tm2) in TRANS th1 th2 with Failure _ -> MONOMIAL_MUL_CONV tm in PMM_CONV in (* ------------------------------------------------------------------------- *) (* Addition of two monomials identical except for constant multiples. *) (* ------------------------------------------------------------------------- *) let MONOMIAL_ADD_CONV tm = let l,r = dest_add tm in if is_semiring_constant l && is_semiring_constant r then SEMIRING_ADD_CONV tm else let th1 = if is_mul l && is_semiring_constant(lhand l) then if is_mul r && is_semiring_constant(lhand r) then INST [lhand l,a_tm; lhand r,b_tm; rand r,m_tm] pthm_02 else INST [lhand l,a_tm; r,m_tm] pthm_03 else if is_mul r && is_semiring_constant(lhand r) then INST [lhand r,a_tm; l,m_tm] pthm_04 else INST [r,m_tm] pthm_05 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = AP_TERM tm3 (SEMIRING_ADD_CONV tm4) in let th3 = TRANS th1 (AP_THM th2 tm2) in let tm5 = rand(concl th3) in if lhand tm5 = zero_tm then TRANS th3 (INST [rand tm5,m_tm] pthm_06) else MONOMIAL_DEONE th3 in (* ------------------------------------------------------------------------- *) (* Ordering on monomials. *) (* ------------------------------------------------------------------------- *) let powervars tm = let ptms = striplist dest_mul tm in if is_semiring_constant (hd ptms) then tl ptms else ptms in let dest_varpow tm = try let x,n = dest_pow tm in (x,dest_numeral n) with Failure _ -> (tm,(if is_semiring_constant tm then num_0 else num_1)) in let morder = let rec lexorder l1 l2 = match (l1,l2) with [],[] -> 0 | vps,[] -> -1 | [],vps -> 1 | ((x1,n1)::vs1),((x2,n2)::vs2) -> if variable_order x1 x2 then 1 else if variable_order x2 x1 then -1 else if n1 let vdegs1 = map dest_varpow (powervars tm1) and vdegs2 = map dest_varpow (powervars tm2) in let deg1 = itlist ((+/) o snd) vdegs1 num_0 and deg2 = itlist ((+/) o snd) vdegs2 num_0 in if deg1 / deg2 then 1 else lexorder vdegs1 vdegs2 in (* ------------------------------------------------------------------------- *) (* Addition of two polynomials. *) (* ------------------------------------------------------------------------- *) let POLYNOMIAL_ADD_CONV = let DEZERO_RULE th = let tm = rand(concl th) in if not(is_add tm) then th else let lop,r = dest_comb tm in let l = rand lop in if l = zero_tm then TRANS th (INST [r,a_tm] pthm_07) else if r = zero_tm then TRANS th (INST [l,a_tm] pthm_08) else th in let rec PADD tm = let l,r = dest_add tm in if l = zero_tm then INST [r,a_tm] pthm_07 else if r = zero_tm then INST [l,a_tm] pthm_08 else if is_add l then let a,b = dest_add l in if is_add r then let c,d = dest_add r in let ord = morder a c in if ord = 0 then let th1 = INST [a,a_tm; b,b_tm; c,c_tm; d,d_tm] pthm_23 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = AP_TERM tm3 (MONOMIAL_ADD_CONV tm4) in DEZERO_RULE (TRANS th1 (MK_COMB(th2,PADD tm2))) else let th1 = if ord > 0 then INST [a,a_tm; b,b_tm; r,c_tm] pthm_24 else INST [l,a_tm; c,c_tm; d,d_tm] pthm_25 in let tm1,tm2 = dest_comb(rand(concl th1)) in DEZERO_RULE (TRANS th1 (AP_TERM tm1 (PADD tm2))) else let ord = morder a r in if ord = 0 then let th1 = INST [a,a_tm; b,b_tm; r,c_tm] pthm_26 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = AP_THM (AP_TERM tm3 (MONOMIAL_ADD_CONV tm4)) tm2 in DEZERO_RULE (TRANS th1 th2) else if ord > 0 then let th1 = INST [a,a_tm; b,b_tm; r,c_tm] pthm_24 in let tm1,tm2 = dest_comb(rand(concl th1)) in DEZERO_RULE (TRANS th1 (AP_TERM tm1 (PADD tm2))) else DEZERO_RULE (INST [l,a_tm; r,c_tm] pthm_27) else if is_add r then let c,d = dest_add r in let ord = morder l c in if ord = 0 then let th1 = INST [l,a_tm; c,c_tm; d,d_tm] pthm_28 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = AP_THM (AP_TERM tm3 (MONOMIAL_ADD_CONV tm4)) tm2 in DEZERO_RULE (TRANS th1 th2) else if ord > 0 then REFL tm else let th1 = INST [l,a_tm; c,c_tm; d,d_tm] pthm_25 in let tm1,tm2 = dest_comb(rand(concl th1)) in DEZERO_RULE (TRANS th1 (AP_TERM tm1 (PADD tm2))) else let ord = morder l r in if ord = 0 then MONOMIAL_ADD_CONV tm else if ord > 0 then DEZERO_RULE(REFL tm) else DEZERO_RULE(INST [l,a_tm; r,c_tm] pthm_27) in PADD in (* ------------------------------------------------------------------------- *) (* Multiplication of two polynomials. *) (* ------------------------------------------------------------------------- *) let POLYNOMIAL_MUL_CONV = let rec PMUL tm = let l,r = dest_mul tm in if not(is_add l) then POLYNOMIAL_MONOMIAL_MUL_CONV tm else if not(is_add r) then let th1 = INST [l,a_tm; r,b_tm] pthm_09 in TRANS th1 (POLYNOMIAL_MONOMIAL_MUL_CONV(rand(concl th1))) else let a,b = dest_add l in let th1 = INST [a,a_tm; b,b_tm; r,c_tm] pthm_10 in let tm1,tm2 = dest_comb(rand(concl th1)) in let tm3,tm4 = dest_comb tm1 in let th2 = AP_TERM tm3 (POLYNOMIAL_MONOMIAL_MUL_CONV tm4) in let th3 = TRANS th1 (MK_COMB(th2,PMUL tm2)) in TRANS th3 (POLYNOMIAL_ADD_CONV (rand(concl th3))) in fun tm -> let l,r = dest_mul tm in if l = zero_tm then INST [r,a_tm] pthm_11 else if r = zero_tm then INST [l,a_tm] pthm_12 else if l = one_tm then INST [r,a_tm] pthm_13 else if r = one_tm then INST [l,a_tm] pthm_14 else PMUL tm in (* ------------------------------------------------------------------------- *) (* Power of polynomial (optimized for the monomial and trivial cases). *) (* ------------------------------------------------------------------------- *) let POLYNOMIAL_POW_CONV = let rec PPOW tm = let l,n = dest_pow tm in if n = zeron_tm then INST [l,x_tm] pthm_35 else if n = onen_tm then INST [l,x_tm] pthm_36 else let th1 = num_CONV n in let th2 = INST [l,x_tm; rand(rand(concl th1)),q_tm] pthm_38 in let tm1,tm2 = dest_comb(rand(concl th2)) in let th3 = TRANS th2 (AP_TERM tm1 (PPOW tm2)) in let th4 = TRANS (AP_TERM (rator tm) th1) th3 in TRANS th4 (POLYNOMIAL_MUL_CONV (rand(concl th4))) in fun tm -> if is_add(lhand tm) then PPOW tm else MONOMIAL_POW_CONV tm in (* ------------------------------------------------------------------------- *) (* Negation. *) (* ------------------------------------------------------------------------- *) let POLYNOMIAL_NEG_CONV = fun tm -> let l,r = dest_comb tm in if l <> neg_tm then failwith "POLYNOMIAL_NEG_CONV" else let th1 = INST [r,x_tm] nthm_1 in TRANS th1 (POLYNOMIAL_MONOMIAL_MUL_CONV (rand(concl th1))) in (* ------------------------------------------------------------------------- *) (* Subtraction. *) (* ------------------------------------------------------------------------- *) let POLYNOMIAL_SUB_CONV = fun tm -> let l,r = dest_sub tm in let th1 = INST [l,x_tm; r,y_tm] nthm_2 in let tm1,tm2 = dest_comb(rand(concl th1)) in let th2 = AP_TERM tm1 (POLYNOMIAL_MONOMIAL_MUL_CONV tm2) in TRANS th1 (TRANS th2 (POLYNOMIAL_ADD_CONV (rand(concl th2)))) in (* ------------------------------------------------------------------------- *) (* Conversion from HOL term. *) (* ------------------------------------------------------------------------- *) let rec POLYNOMIAL_CONV tm = if not(is_comb tm) || is_semiring_constant tm then REFL tm else let lop,r = dest_comb tm in if lop = neg_tm then let th1 = AP_TERM lop (POLYNOMIAL_CONV r) in TRANS th1 (POLYNOMIAL_NEG_CONV (rand(concl th1))) else if not(is_comb lop) then REFL tm else let op,l = dest_comb lop in if op = pow_tm && is_numeral r then let th1 = AP_THM (AP_TERM op (POLYNOMIAL_CONV l)) r in TRANS th1 (POLYNOMIAL_POW_CONV (rand(concl th1))) else if op = add_tm || op = mul_tm || op = sub_tm then let th1 = MK_COMB(AP_TERM op (POLYNOMIAL_CONV l), POLYNOMIAL_CONV r) in let fn = if op = add_tm then POLYNOMIAL_ADD_CONV else if op = mul_tm then POLYNOMIAL_MUL_CONV else POLYNOMIAL_SUB_CONV in TRANS th1 (fn (rand(concl th1))) else REFL tm in POLYNOMIAL_NEG_CONV,POLYNOMIAL_ADD_CONV,POLYNOMIAL_SUB_CONV, POLYNOMIAL_MUL_CONV,POLYNOMIAL_POW_CONV,POLYNOMIAL_CONV;; (* ------------------------------------------------------------------------- *) (* Instantiate it to the natural numbers. *) (* ------------------------------------------------------------------------- *) let NUM_NORMALIZE_CONV = let sth = prove (`(!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. 0 + x = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x y. x * y = y * x) /\ (!x. 1 * x = x) /\ (!x. 0 * x = 0) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x. x EXP 0 = 1) /\ (!x n. x EXP (SUC n) = x * x EXP n)`, REWRITE_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES; LEFT_ADD_DISTRIB] THEN REWRITE_TAC[ADD_AC; MULT_AC]) and rth = TRUTH and is_semiring_constant = is_numeral and SEMIRING_ADD_CONV = NUM_ADD_CONV and SEMIRING_MUL_CONV = NUM_MULT_CONV and SEMIRING_POW_CONV = NUM_EXP_CONV in let _,_,_,_,_,NUM_NORMALIZE_CONV = SEMIRING_NORMALIZERS_CONV sth rth (is_semiring_constant, SEMIRING_ADD_CONV,SEMIRING_MUL_CONV,SEMIRING_POW_CONV) (<) in NUM_NORMALIZE_CONV;; hol-light/nums.ml000066400000000000000000000332521303454263000142660ustar00rootroot00000000000000(* ========================================================================= *) (* The axiom of infinity; construction of the natural numbers. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "pair.ml";; (* ------------------------------------------------------------------------- *) (* Declare a new type "ind" of individuals. *) (* ------------------------------------------------------------------------- *) new_type ("ind",0);; (* ------------------------------------------------------------------------- *) (* We assert the axiom of infinity as in HOL88, but then we can forget it! *) (* ------------------------------------------------------------------------- *) let ONE_ONE = new_definition `ONE_ONE(f:A->B) = !x1 x2. (f x1 = f x2) ==> (x1 = x2)`;; let ONTO = new_definition `ONTO(f:A->B) = !y. ?x. y = f x`;; let INFINITY_AX = new_axiom `?f:ind->ind. ONE_ONE f /\ ~(ONTO f)`;; (* ------------------------------------------------------------------------- *) (* Actually introduce constants. *) (* ------------------------------------------------------------------------- *) let IND_SUC_0_EXISTS = prove (`?(f:ind->ind) z. (!x1 x2. (f x1 = f x2) = (x1 = x2)) /\ (!x. ~(f x = z))`, X_CHOOSE_TAC `f:ind->ind` INFINITY_AX THEN EXISTS_TAC `f:ind->ind` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ONE_ONE; ONTO] THEN MESON_TAC[]);; let IND_SUC_SPEC = let th1 = new_definition `IND_SUC = @f:ind->ind. ?z. (!x1 x2. (f x1 = f x2) = (x1 = x2)) /\ (!x. ~(f x = z))` in let th2 = REWRITE_RULE[GSYM th1] (SELECT_RULE IND_SUC_0_EXISTS) in let th3 = new_definition `IND_0 = @z:ind. (!x1 x2. IND_SUC x1 = IND_SUC x2 <=> x1 = x2) /\ (!x. ~(IND_SUC x = z))` in REWRITE_RULE[GSYM th3] (SELECT_RULE th2);; let IND_SUC_INJ,IND_SUC_0 = CONJ_PAIR IND_SUC_SPEC;; (* ------------------------------------------------------------------------- *) (* Carve out the natural numbers inductively. *) (* ------------------------------------------------------------------------- *) let NUM_REP_RULES,NUM_REP_INDUCT,NUM_REP_CASES = new_inductive_definition `NUM_REP IND_0 /\ (!i. NUM_REP i ==> NUM_REP (IND_SUC i))`;; let num_tydef = new_basic_type_definition "num" ("mk_num","dest_num") (CONJUNCT1 NUM_REP_RULES);; let ZERO_DEF = new_definition `_0 = mk_num IND_0`;; let SUC_DEF = new_definition `SUC n = mk_num(IND_SUC(dest_num n))`;; (* ------------------------------------------------------------------------- *) (* Distinctness and injectivity of constructors. *) (* ------------------------------------------------------------------------- *) let NOT_SUC = prove (`!n. ~(SUC n = _0)`, REWRITE_TAC[SUC_DEF; ZERO_DEF] THEN MESON_TAC[NUM_REP_RULES; fst num_tydef; snd num_tydef; IND_SUC_0]);; let SUC_INJ = prove (`!m n. SUC m = SUC n <=> m = n`, REPEAT GEN_TAC THEN REWRITE_TAC[SUC_DEF] THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o AP_TERM `dest_num`) THEN SUBGOAL_THEN `!p. NUM_REP (IND_SUC (dest_num p))` MP_TAC THENL [GEN_TAC THEN MATCH_MP_TAC (CONJUNCT2 NUM_REP_RULES); ALL_TAC] THEN REWRITE_TAC[fst num_tydef; snd num_tydef] THEN DISCH_TAC THEN ASM_REWRITE_TAC[IND_SUC_INJ] THEN DISCH_THEN(MP_TAC o AP_TERM `mk_num`) THEN REWRITE_TAC[fst num_tydef]);; (* ------------------------------------------------------------------------- *) (* Induction. *) (* ------------------------------------------------------------------------- *) let num_INDUCTION = prove (`!P. P(_0) /\ (!n. P(n) ==> P(SUC n)) ==> !n. P n`, REPEAT STRIP_TAC THEN MP_TAC(SPEC `\i. NUM_REP i /\ P(mk_num i):bool` NUM_REP_INDUCT) THEN ASM_REWRITE_TAC[GSYM ZERO_DEF; NUM_REP_RULES] THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) THENL [REPEAT STRIP_TAC THENL [MATCH_MP_TAC(CONJUNCT2 NUM_REP_RULES) THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `mk_num(IND_SUC i) = SUC(mk_num i)` SUBST1_TAC THENL [REWRITE_TAC[SUC_DEF] THEN REPEAT AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM(snd num_tydef)] THEN FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC]]; DISCH_THEN(MP_TAC o SPEC `dest_num n`) THEN REWRITE_TAC[fst num_tydef; snd num_tydef]]);; (* ------------------------------------------------------------------------- *) (* Recursion. *) (* ------------------------------------------------------------------------- *) let num_Axiom = prove (`!(e:A) f. ?!fn. (fn _0 = e) /\ (!n. fn (SUC n) = f (fn n) n)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL [(MP_TAC o prove_inductive_relations_exist) `PRG _0 e /\ (!b:A n:num. PRG n b ==> PRG (SUC n) (f b n))` THEN DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN SUBGOAL_THEN `!n:num. ?!y:A. PRG n y` MP_TAC THENL [MATCH_MP_TAC num_INDUCTION THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC BINDER_CONV [GSYM th]) THEN REWRITE_TAC[GSYM NOT_SUC; NOT_SUC; SUC_INJ; EXISTS_UNIQUE_REFL] THEN REWRITE_TAC[UNWIND_THM1] THEN UNDISCH_TAC `?!y. PRG (n:num) (y:A)` THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `y:A`) ASSUME_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY EXISTS_TAC [`(f:A->num->A) y n`; `y:A`]; AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[UNIQUE_SKOLEM_ALT] THEN DISCH_THEN(X_CHOOSE_THEN `fn:num->A` (ASSUME_TAC o GSYM)) THEN EXISTS_TAC `fn:num->A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN REFL_TAC]; REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* The basic numeral tag; rewrite existing instances of "_0". *) (* ------------------------------------------------------------------------- *) let NUMERAL = let num_ty = type_of(lhand(concl ZERO_DEF)) in let funn_ty = mk_fun_ty num_ty num_ty in let numeral_tm = mk_var("NUMERAL",funn_ty) in let n_tm = mk_var("n",num_ty) in new_definition(mk_eq(mk_comb(numeral_tm,n_tm),n_tm));; let [NOT_SUC; num_INDUCTION; num_Axiom] = let th = prove(`_0 = 0`,REWRITE_TAC[NUMERAL]) in map (GEN_REWRITE_RULE DEPTH_CONV [th]) [NOT_SUC; num_INDUCTION; num_Axiom];; (* ------------------------------------------------------------------------- *) (* Induction tactic. *) (* ------------------------------------------------------------------------- *) let (INDUCT_TAC:tactic) = MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN DISCH_TAC];; let num_RECURSION = let avs = fst(strip_forall(concl num_Axiom)) in GENL avs (EXISTENCE (SPECL avs num_Axiom));; (* ------------------------------------------------------------------------- *) (* Cases theorem. *) (* ------------------------------------------------------------------------- *) let num_CASES = prove (`!m. (m = 0) \/ (?n. m = SUC n)`, INDUCT_TAC THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Augmenting inductive type store. *) (* ------------------------------------------------------------------------- *) let num_RECURSION_STD = prove (`!e:Z f. ?fn. (fn 0 = e) /\ (!n. fn (SUC n) = f n (fn n))`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`e:Z`; `(\z n. (f:num->Z->Z) n z)`] num_RECURSION) THEN REWRITE_TAC[]);; inductive_type_store := ("num",(2,num_INDUCTION,num_RECURSION_STD))::(!inductive_type_store);; (* ------------------------------------------------------------------------- *) (* "Bitwise" binary representation of numerals. *) (* ------------------------------------------------------------------------- *) let BIT0_DEF = let funn_ty = type_of(rator(lhand(snd(dest_forall(concl NUMERAL))))) in let bit0_tm = mk_var("BIT0",funn_ty) in let def = new_definition (mk_eq(bit0_tm,`@fn. fn 0 = 0 /\ (!n. fn (SUC n) = SUC (SUC(fn n)))`)) and th = BETA_RULE(ISPECL [`0`; `\m n:num. SUC(SUC m)`] num_RECURSION) in REWRITE_RULE[GSYM def] (SELECT_RULE th);; let BIT1_DEF = let funn_ty = type_of(rator(lhand(lhand(concl BIT0_DEF)))) in let num_ty = snd(dest_fun_ty funn_ty) in let n_tm = mk_var("n",num_ty) in let bit1_tm = mk_var("BIT1",funn_ty) in new_definition(mk_eq(mk_comb(bit1_tm,n_tm),`SUC (BIT0 n)`));; (* ------------------------------------------------------------------------- *) (* Syntax operations on numerals. *) (* ------------------------------------------------------------------------- *) let mk_numeral = let pow24 = pow2 24 and num_0 = Int 0 and zero_tm = mk_const("_0",[]) and BIT0_tm = mk_const("BIT0",[]) and BIT1_tm = mk_const("BIT1",[]) and NUMERAL_tm = mk_const("NUMERAL",[]) in let rec stripzeros l = match l with false::t -> stripzeros t | _ -> l in let rec raw_list_of_num l n = if n =/ num_0 then stripzeros l else let h = Num.int_of_num(mod_num n pow24) in raw_list_of_num ((h land 8388608 <> 0)::(h land 4194304 <> 0)::(h land 2097152 <> 0):: (h land 1048576 <> 0)::(h land 524288 <> 0)::(h land 262144 <> 0):: (h land 131072 <> 0)::(h land 65536 <> 0)::(h land 32768 <> 0):: (h land 16384 <> 0)::(h land 8192 <> 0)::(h land 4096 <> 0):: (h land 2048 <> 0)::(h land 1024 <> 0)::(h land 512 <> 0):: (h land 256 <> 0)::(h land 128 <> 0)::(h land 64 <> 0):: (h land 32 <> 0)::(h land 16 <> 0)::(h land 8 <> 0)::(h land 4 <> 0):: (h land 2 <> 0)::(h land 1 <> 0)::l) (quo_num n pow24) in let rec numeral_of_list t l = match l with [] -> t | b::r -> numeral_of_list(mk_comb((if b then BIT1_tm else BIT0_tm),t)) r in let mk_raw_numeral n = numeral_of_list zero_tm (raw_list_of_num [] n) in fun n -> if n if mem t res then fail() else t::res) l []; true with Failure _ -> false in let specify name th = let ntm = mk_code name in let gv = genvar(type_of ntm) in let th0 = CONV_RULE(REWR_CONV SKOLEM_THM) (GEN gv th) in let th1 = CONV_RULE(RATOR_CONV (REWR_CONV EXISTS_THM) THENC BETA_CONV) th0 in let l,r = dest_comb(concl th1) in let rn = mk_comb(r,ntm) in let ty = type_of rn in let th2 = new_definition(mk_eq(mk_var(name,ty),rn)) in GEN_REWRITE_RULE ONCE_DEPTH_CONV [GSYM th2] (SPEC ntm (CONV_RULE BETA_CONV th1)) in let rec specifies names th = match names with [] -> th | name::onames -> let th' = specify name th in specifies onames th' in fun names th -> let asl,c = dest_thm th in if not (asl = []) then failwith "new_specification: Assumptions not allowed in theorem" else if not (frees c = []) then failwith "new_specification: Free variables in predicate" else let avs = fst(strip_exists c) in if length names = 0 || length names > length avs then failwith "new_specification: Unsuitable number of constant names" else if not (check_distinct names) then failwith "new_specification: Constant names not distinct" else try let sth = snd(find (fun ((names',th'),sth') -> names' = names && aconv (concl th') (concl th)) (!the_specifications)) in warn true ("Benign respecification"); sth with Failure _ -> let sth = specifies names th in the_specifications := ((names,th),sth)::(!the_specifications); sth;; hol-light/pa_j_3.07.ml000066400000000000000000002464131303454263000146710ustar00rootroot00000000000000(* camlp4r pa_extend.cmo q_MLast.cmo *) (***********************************************************************) (* *) (* Camlp4 *) (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2002 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) (* $Id: pa_o.ml,v 1.54 2003/09/30 14:39:38 mauny Exp $ *) open Stdpp; open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* ------------------------------------------------------------------------- *) (* Hacked version of the lexer. *) (* ------------------------------------------------------------------------- *) open Token; value jrh_lexer = ref False; value no_quotations = ref False; (* The string buffering machinery *) value buff = ref (String.create 80); value store len x = do { if len >= String.length buff.val then buff.val := buff.val ^ String.create (String.length buff.val) else (); buff.val.[len] := x; succ len } ; value mstore len s = add_rec len 0 where rec add_rec len i = if i == String.length s then len else add_rec (store len s.[i]) (succ i) ; value get_buff len = String.sub buff.val 0 len; (* The lexer *) value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value rec ident len = parser [ [: `('A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '0'..'9' | '_' | ''' as c) ; s :] -> ident (store len c) s | [: :] -> len ] and ident2 len = parser [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' as c) ; s :] -> ident2 (store len c) s | [: :] -> len ] and ident3 len = parser [ [: `('0'..'9' | 'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' as c) ; s :] -> ident3 (store len c) s | [: :] -> len ] and base_number len = parser [ [: `'o' | 'O'; s :] -> digits octal (store len 'o') s | [: `'x' | 'X'; s :] -> digits hexa (store len 'x') s | [: `'b' | 'B'; s :] -> digits binary (store len 'b') s | [: a = number len :] -> a ] and digits kind len = parser [ [: d = kind; s :] -> digits_under kind (store len d) s | [: :] -> raise (Stream.Error "ill-formed integer constant") ] and digits_under kind len = parser [ [: d = kind; s :] -> digits_under kind (store len d) s | [: `'_'; s :] -> digits_under kind len s | [: :] -> ("INT", get_buff len) ] and octal = parser [ [: `('0'..'7' as d) :] -> d ] and hexa = parser [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d) :] -> d ] and binary = parser [ [: `('0'..'1' as d) :] -> d ] and number len = parser [ [: `('0'..'9' as c); s :] -> number (store len c) s | [: `'_'; s :] -> number len s | [: `'.'; s :] -> decimal_part (store len '.') s | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s | [: `'l' :] -> ("INT32", get_buff len) | [: `'L' :] -> ("INT64", get_buff len) | [: `'n' :] -> ("NATIVEINT", get_buff len) | [: :] -> ("INT", get_buff len) ] and decimal_part len = parser [ [: `('0'..'9' as c); s :] -> decimal_part (store len c) s | [: `'_'; s :] -> decimal_part len s | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s | [: :] -> ("FLOAT", get_buff len) ] and exponent_part len = parser [ [: `('+' | '-' as c); s :] -> end_exponent_part (store len c) s | [: a = end_exponent_part len :] -> a ] and end_exponent_part len = parser [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s | [: :] -> raise (Stream.Error "ill-formed floating-point constant") ] and end_exponent_part_under len = parser [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s | [: `'_'; s :] -> end_exponent_part_under len s | [: :] -> ("FLOAT", get_buff len) ] ; value error_on_unknown_keywords = ref False; value err loc msg = raise_with_loc loc (Token.Error msg); (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) (* value next_token_fun dfa find_kwd = let keyword_or_error loc s = try (("", find_kwd s), loc) with [ Not_found -> if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) else (("", s), loc) ] in let rec next_token = parser bp [ [: `' ' | '\010' | '\013' | '\t' | '\026' | '\012'; s :] -> next_token s | [: `'('; s :] -> left_paren bp s | [: `'#'; s :] -> do { spaces_tabs s; linenum bp s } | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = (bp, Stream.count s) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) ***********) | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = (bp, Stream.count s) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) **********) | [: `('1'..'9' as c); s :] -> let tok = number (store 0 c) s in let loc = (bp, Stream.count s) in (tok, loc) | [: `'0'; s :] -> let tok = base_number (store 0 '0') s in let loc = (bp, Stream.count s) in (tok, loc) | [: `'''; s :] -> match Stream.npeek 3 s with [ [_; '''; _] | ['\\'; _; _] | ['\x0D'; '\x0A'; '''] -> let tok = ("CHAR", get_buff (char bp 0 s)) in let loc = (bp, Stream.count s) in (tok, loc) | _ -> keyword_or_error (bp, Stream.count s) "'" ] | [: `'"'; s :] -> let tok = ("STRING", get_buff (string bp 0 s)) in let loc = (bp, Stream.count s) in (tok, loc) | [: `'`'; s :] -> let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in let loc = (bp, Stream.count s) in (tok, loc) | [: `'$'; s :] -> let tok = dollar bp 0 s in let loc = (bp, Stream.count s) in (tok, loc) | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id | [: `('~' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep -> (("TILDEIDENT", get_buff len), (bp, ep)) | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `('?' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep -> (("QUESTIONIDENT", get_buff len), (bp, ep)) | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `'<'; s :] -> less bp s | [: `(':' as c1); len = parser [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('>' | '|' as c1); len = parser [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('[' | '{' as c1); s :] -> let len = match Stream.npeek 2 s with [ ['<'; '<' | ':'] -> store 0 c1 | _ -> match s with parser [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] ] in let ep = Stream.count s in let id = get_buff len in keyword_or_error (bp, ep) id | [: `'.'; id = parser [ [: `'.' :] -> ".." | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> keyword_or_error (bp, ep) id | [: `';'; id = parser [ [: `';' :] -> ";;" | [: :] -> ";" ] :] ep -> keyword_or_error (bp, ep) id | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep)) | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ] and less bp strm = if no_quotations.val then match strm with parser [ [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] else match strm with parser [ [: `'<'; len = quotation bp 0 :] ep -> (("QUOTATION", ":" ^ get_buff len), (bp, ep)) | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; `'<' ? "character '<' expected"; len = quotation bp 0 :] ep -> (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep)) | [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] and string bp len = parser [ [: `'"' :] -> len | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s | [: `c; s :] -> string bp (store len c) s | [: :] ep -> err (bp, ep) "string not terminated" ] and qstring bp len = parser [ [: `'`' :] -> get_buff len | [: `c; s :] -> qstring bp (store len c) s | [: :] ep -> err (bp, ep) "quotation not terminated" ] and char bp len = parser [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s | [: `c; s :] -> char bp (store len c) s | [: :] ep -> err (bp, ep) "char not terminated" ] and dollar bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: s :] -> if dfa then match s with parser [ [: `c :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] else ("", get_buff (ident2 (store 0 '$') s)) ] and maybe_locate bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s | [: `':'; s :] -> ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] and antiquot bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> antiquot bp (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] and locate_or_antiquot_rest bp len = parser [ [: `'$' :] -> get_buff len | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] and quotation bp len = parser [ [: `'>'; s :] -> maybe_end_quotation bp len s | [: `'<'; s :] -> quotation bp (maybe_nested_quotation bp (store len '<') s) s | [: `'\\'; len = parser [ [: `('>' | '<' | '\\' as c) :] -> store len c | [: :] -> store len '\\' ]; s :] -> quotation bp len s | [: `c; s :] -> quotation bp (store len c) s | [: :] ep -> err (bp, ep) "quotation not terminated" ] and maybe_nested_quotation bp len = parser [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" | [: `':'; len = ident (store len ':'); a = parser [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" | [: :] -> len ] :] -> a | [: :] -> len ] and maybe_end_quotation bp len = parser [ [: `'>' :] -> len | [: a = quotation bp (store len '>') :] -> a ] and left_paren bp = parser [ [: `'*'; _ = comment bp; a = next_token True :] -> a | [: :] ep -> keyword_or_error (bp, ep) "(" ] and comment bp = parser [ [: `'('; s :] -> left_paren_in_comment bp s | [: `'*'; s :] -> star_in_comment bp s | [: `'"'; _ = string bp 0; s :] -> comment bp s | [: `'''; s :] -> quote_in_comment bp s | [: `c; s :] -> comment bp s | [: :] ep -> err (bp, ep) "comment not terminated" ] and quote_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: `'\013'; s :] -> quote_cr_in_comment bp s | [: `'\\'; s :] -> quote_antislash_in_comment bp s | [: `'('; s :] -> quote_left_paren_in_comment bp s | [: `'*'; s :] -> quote_star_in_comment bp s | [: `'"'; s :] -> quote_doublequote_in_comment bp s | [: `_; s :] -> quote_any_in_comment bp s | [: s :] -> comment bp s ] and quote_any_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: s :] -> comment bp s ] and quote_cr_in_comment bp = parser [ [: `'\010'; s :] -> quote_any_in_comment bp s | [: s :] -> quote_any_in_comment bp s ] and quote_left_paren_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: s :] -> left_paren_in_comment bp s ] and quote_star_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: s :] -> star_in_comment bp s ] and quote_doublequote_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: _ = string bp 0; s :] -> comment bp s ] and quote_antislash_in_comment bp = parser [ [: `'''; s :] -> quote_antislash_quote_in_comment bp s | [: `('\\' | '"' | 'n' | 't' | 'b' | 'r'); s :] -> quote_any_in_comment bp s | [: `('0'..'9'); s :] -> quote_antislash_digit_in_comment bp s | [: `'x'; s :] -> quote_antislash_x_in_comment bp s | [: s :] -> comment bp s ] and quote_antislash_quote_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: s :] -> quote_in_comment bp s ] and quote_antislash_digit_in_comment bp = parser [ [: `('0'..'9'); s :] -> quote_antislash_digit2_in_comment bp s | [: s :] -> comment bp s ] and quote_antislash_digit2_in_comment bp = parser [ [: `('0'..'9'); s :] -> quote_any_in_comment bp s | [: s :] -> comment bp s ] and quote_antislash_x_in_comment bp = parser [ [: _ = hexa; s :] -> quote_antislash_x_digit_in_comment bp s | [: s :] -> comment bp s ] and quote_antislash_x_digit_in_comment bp = parser [ [: _ = hexa; s :] -> quote_any_in_comment bp s | [: s :] -> comment bp s ] and left_paren_in_comment bp = parser [ [: `'*'; s :] -> do { comment bp s; comment bp s } | [: a = comment bp :] -> a ] and star_in_comment bp = parser [ [: `')' :] -> () | [: a = comment bp :] -> a ] and linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> False ] and linedir_digits n s = match stream_peek_nth n s with [ Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> linedir_quote n s ] and linedir_quote n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir_quote (n + 1) s | Some '"' -> True | _ -> False ] and any_to_nl = parser [ [: `'\013' | '\010' :] ep -> bolpos.val := ep | [: `_; s :] -> any_to_nl s | [: :] -> () ] in fun cstrm -> try let glex = glexr.val in let comm_bp = Stream.count cstrm in let r = next_token False cstrm in do { match glex.tok_comm with [ Some list -> if fst (snd r) > comm_bp then let comm_loc = (comm_bp, fst (snd r)) in glex.tok_comm := Some [comm_loc :: list] else () | None -> () ]; r } with [ Stream.Error str -> err (Stream.count cstrm, Stream.count cstrm + 1) str ] ; *) value next_token_fun dfa ssd find_kwd bolpos glexr = let keyword_or_error loc s = try (("", find_kwd s), loc) with [ Not_found -> if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) else (("", s), loc) ] in let error_if_keyword ( ((_,id), loc) as a) = try do { ignore(find_kwd id); err loc ("illegal use of a keyword as a label: " ^ id) } with [ Not_found -> a ] in let rec next_token after_space = parser bp [ [: `'\010' | '\013'; s :] ep -> do { bolpos.val := ep; next_token True s } | [: `' ' | '\t' | '\026' | '\012'; s :] -> next_token True s | [: `'#' when bp = bolpos.val; s :] -> if linedir 1 s then do { any_to_nl s; next_token True s } else keyword_or_error (bp, bp + 1) "#" | [: `'('; s :] -> left_paren bp s | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = (bp, Stream.count s) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) ***********) | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = (bp, Stream.count s) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) **********) | [: `('1'..'9' as c); s :] -> let tok = number (store 0 c) s in let loc = (bp, Stream.count s) in (tok, loc) | [: `'0'; s :] -> let tok = base_number (store 0 '0') s in let loc = (bp, Stream.count s) in (tok, loc) | [: `'''; s :] -> match Stream.npeek 2 s with [ [_; '''] | ['\\'; _] -> let tok = ("CHAR", get_buff (char bp 0 s)) in let loc = (bp, Stream.count s) in (tok, loc) | _ -> keyword_or_error (bp, Stream.count s) "'" ] | [: `'"'; s :] -> let tok = ("STRING", get_buff (string bp 0 s)) in let loc = (bp, Stream.count s) in (tok, loc) | [: `'`'; s :] -> let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in let loc = (bp, Stream.count s) in (tok, loc) | [: `'$'; s :] -> let tok = dollar bp 0 s in let loc = (bp, Stream.count s) in (tok, loc) | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id | [: `('~' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> let id = get_buff len in match s with parser [ [: `':' :] eb -> error_if_keyword (("LABEL", id), (bp,ep)) | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ] | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `('?' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> let id = get_buff len in match s with parser [ [: `':' :] eb -> error_if_keyword (("OPTLABEL", id), (bp,ep)) | [: :] -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep)) ] | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `'<'; s :] -> less bp s | [: `(':' as c1); len = parser [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('>' | '|' as c1); len = parser [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('[' | '{' as c1); s :] -> let len = match Stream.npeek 2 s with [ ['<'; '<' | ':'] -> store 0 c1 | _ -> match s with parser [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] ] in let ep = Stream.count s in let id = get_buff len in keyword_or_error (bp, ep) id | [: `'.'; id = parser [ [: `'.' :] -> ".." | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> keyword_or_error (bp, ep) id | [: `';'; id = parser [ [: `';' :] -> ";;" | [: :] -> ";" ] :] ep -> keyword_or_error (bp, ep) id | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep)) | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ] and less bp strm = if no_quotations.val then match strm with parser [ [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] else match strm with parser [ [: `'<'; len = quotation bp 0 :] ep -> (("QUOTATION", ":" ^ get_buff len), (bp, ep)) | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; `'<' ? "character '<' expected"; len = quotation bp 0 :] ep -> (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep)) | [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] and string bp len = parser [ [: `'"' :] -> len | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s | [: `c; s :] -> string bp (store len c) s | [: :] ep -> err (bp, ep) "string not terminated" ] and qstring bp len = parser [ [: `'`' :] -> get_buff len | [: `c; s :] -> qstring bp (store len c) s | [: :] ep -> err (bp, ep) "quotation not terminated" ] and char bp len = parser [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s | [: `c; s :] -> char bp (store len c) s | [: :] ep -> err (bp, ep) "char not terminated" ] and dollar bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: s :] -> if dfa then match s with parser [ [: `c :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] else ("", get_buff (ident2 (store 0 '$') s)) ] and maybe_locate bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s | [: `':'; s :] -> ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] and antiquot bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> antiquot bp (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] and locate_or_antiquot_rest bp len = parser [ [: `'$' :] -> get_buff len | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] and quotation bp len = parser [ [: `'>'; s :] -> maybe_end_quotation bp len s | [: `'<'; s :] -> quotation bp (maybe_nested_quotation bp (store len '<') s) s | [: `'\\'; len = parser [ [: `('>' | '<' | '\\' as c) :] -> store len c | [: :] -> store len '\\' ]; s :] -> quotation bp len s | [: `c; s :] -> quotation bp (store len c) s | [: :] ep -> err (bp, ep) "quotation not terminated" ] and maybe_nested_quotation bp len = parser [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" | [: `':'; len = ident (store len ':'); a = parser [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" | [: :] -> len ] :] -> a | [: :] -> len ] and maybe_end_quotation bp len = parser [ [: `'>' :] -> len | [: a = quotation bp (store len '>') :] -> a ] and left_paren bp = parser [ [: `'*'; _ = comment bp; a = next_token True :] -> a | [: :] ep -> keyword_or_error (bp, ep) "(" ] and comment bp = parser [ [: `'('; s :] -> left_paren_in_comment bp s | [: `'*'; s :] -> star_in_comment bp s | [: `'"'; _ = string bp 0; s :] -> comment bp s | [: `'''; s :] -> quote_in_comment bp s | [: `c; s :] -> comment bp s | [: :] ep -> err (bp, ep) "comment not terminated" ] and quote_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: `'\\'; s :] -> quote_antislash_in_comment bp 0 s | [: s :] -> do { match Stream.npeek 2 s with [ [_; '''] -> do { Stream.junk s; Stream.junk s } | _ -> () ]; comment bp s } ] and quote_any_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: a = comment bp :] -> a ] and quote_antislash_in_comment bp len = parser [ [: `'''; s :] -> comment bp s | [: `'\\' | '"' | 'n' | 't' | 'b' | 'r'; s :] -> quote_any_in_comment bp s | [: `'0'..'9'; s :] -> quote_antislash_digit_in_comment bp s | [: a = comment bp :] -> a ] and quote_antislash_digit_in_comment bp = parser [ [: `'0'..'9'; s :] -> quote_antislash_digit2_in_comment bp s | [: a = comment bp :] -> a ] and quote_antislash_digit2_in_comment bp = parser [ [: `'0'..'9'; s :] -> quote_any_in_comment bp s | [: a = comment bp :] -> a ] and left_paren_in_comment bp = parser [ [: `'*'; s :] -> do { comment bp s; comment bp s } | [: a = comment bp :] -> a ] and star_in_comment bp = parser [ [: `')' :] -> () | [: a = comment bp :] -> a ] and linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> False ] and linedir_digits n s = match stream_peek_nth n s with [ Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> linedir_quote n s ] and linedir_quote n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir_quote (n + 1) s | Some '"' -> True | _ -> False ] and any_to_nl = parser [ [: `'\013' | '\010' :] ep -> bolpos.val := ep | [: `_; s :] -> any_to_nl s | [: :] -> () ] in fun cstrm -> try let glex = glexr.val in let comm_bp = Stream.count cstrm in let r = next_token False cstrm in do { match glex.tok_comm with [ Some list -> if fst (snd r) > comm_bp then let comm_loc = (comm_bp, fst (snd r)) in glex.tok_comm := Some [comm_loc :: list] else () | None -> () ]; r } with [ Stream.Error str -> err (Stream.count cstrm, Stream.count cstrm + 1) str ] ; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value func kwd_table glexr = let bolpos = ref 0 in let find = Hashtbl.find kwd_table in let dfa = dollar_for_antiquotation.val in let ssd = specific_space_dot.val in Token.lexer_func_of_parser (next_token_fun dfa ssd find bolpos glexr) ; value rec check_keyword_stream = parser [: _ = check; _ = Stream.empty :] -> True and check = parser [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' ; s :] -> check_ident s | [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ; s :] -> check_ident2 s | [: `'<'; s :] -> match Stream.npeek 1 s with [ [':' | '<'] -> () | _ -> check_ident2 s ] | [: `':'; _ = parser [ [: `']' | ':' | '=' | '>' :] -> () | [: :] -> () ] :] ep -> () | [: `'>' | '|'; _ = parser [ [: `']' | '}' :] -> () | [: a = check_ident2 :] -> a ] :] -> () | [: `'[' | '{'; s :] -> match Stream.npeek 2 s with [ ['<'; '<' | ':'] -> () | _ -> match s with parser [ [: `'|' | '<' | ':' :] -> () | [: :] -> () ] ] | [: `';'; _ = parser [ [: `';' :] -> () | [: :] -> () ] :] -> () | [: `_ :] -> () ] and check_ident = parser [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '0'..'9' | '_' | ''' ; s :] -> check_ident s | [: :] -> () ] and check_ident2 = parser [ [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' ; s :] -> check_ident2 s | [: :] -> () ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Token.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Token.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (Hashtbl.mem kwd_table p_prm) then if check_keyword p_prm then if Hashtbl.mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "INT" | "INT32" | "INT64" | "NATIVEINT" | "FLOAT" | "CHAR" | "STRING" | "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL" | "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" -> () | _ -> raise (Token.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT32", "") -> "32 bits integer" | ("INT64", "") -> "64 bits integer" | ("NATIVEINT", "") -> "native integer" | (("INT" | "INT32" | "NATIVEINT"), s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("LOCATE", "") -> "locate" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Token.default_match tok ] ; value gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let glex = {tok_func = func kwd_table glexr; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; glex } ; value tparse = fun [ ("ANTIQUOT", p_prm) -> let p = parser [: `("ANTIQUOT", prm) when eq_before_colon p_prm prm :] -> after_colon prm in Some p | _ -> None ] ; value make () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in {func = func kwd_table glexr; using = using_token kwd_table id_table; removing = removing_token kwd_table id_table; tparse = tparse; text = text} ; (* ------------------------------------------------------------------------- *) (* Resume the main file. *) (* ------------------------------------------------------------------------- *) do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; Grammar.Unsafe.gram_reinit gram (gmake ()); dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_declaration; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value o2b = fun [ Some _ -> True | None -> False ] ; value mkumin loc f arg = match (f, arg) with [ ("-", <:expr< $int:n$ >>) when int_of_string n > 0 -> let n = "-" ^ n in <:expr< $int:n$ >> | ("-", MLast.ExInt32 loc n) when (Int32.of_string n) > 0l -> MLast.ExInt32 loc ("-" ^ n) | ("-", MLast.ExInt64 loc n) when (Int64.of_string n) > 0L -> MLast.ExInt64 loc ("-" ^ n) | ("-", MLast.ExNativeInt loc n) when (Nativeint.of_string n) > 0n -> MLast.ExNativeInt loc ("-" ^ n) | (_, <:expr< $flo:n$ >>) when float_of_string n > 0.0 -> let n = "-" ^ n in <:expr< $flo:n$ >> | _ -> let f = "~" ^ f in <:expr< $lid:f$ $arg$ >> ] ; value mklistexp loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let loc = if top then loc else (fst (MLast.loc_of_expr e1), snd loc) in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let loc = if top then loc else (fst (MLast.loc_of_patt p1), snd loc) in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = let ct = Hashtbl.create 73 in do { List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] } ; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; (*** And JRH inserted it in here ***) value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value lident_colon = Grammar.Entry.of_parser gram "lident_colon" (fun strm -> match Stream.npeek 2 strm with [ [("LIDENT", i); ("", ":")] -> do { Stream.junk strm; Stream.junk strm; i } | _ -> raise Stream.Failure ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in let rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False in loop ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e | <:expr< $e$ $_$ >> -> if is_expr_constr_call e then Stdpp.raise_with_loc loc (Stream.Error "currified constructor") else 1 | _ -> 1 ] ; value rec is_patt_constr_call = fun [ <:patt< $uid:_$ >> -> True | <:patt< $uid:_$.$p$ >> -> is_patt_constr_call p | <:patt< $p$ $_$ >> -> is_patt_constr_call p | _ -> False ] ; value rec constr_patt_arity loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p | <:patt< $p$ $_$ >> -> if is_patt_constr_call p then Stdpp.raise_with_loc loc (Stream.Error "currified constructor") else 1 | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if List.mem_assoc s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if List.mem_assoc v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; value rec patt_lid = fun [ <:patt< $p1$ $p2$ >> -> match p1 with [ <:patt< $lid:i$ >> -> Some (MLast.loc_of_patt p1, i, [p2]) | _ -> match patt_lid p1 with [ Some (loc, i, pl) -> Some (loc, i, [p2 :: pl]) | None -> None ] ] | _ -> None ] ; value bigarray_get loc arr arg = let coords = match arg with [ <:expr< ($list:el$) >> -> el | _ -> [arg] ] in match coords with [ [c1] -> <:expr< Bigarray.Array1.get $arr$ $c1$ >> | [c1; c2] -> <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> | [c1; c2; c3] -> <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> ] ; value bigarray_set loc var newval = match var with [ <:expr< Bigarray.Array1.get $arr$ $c1$ >> -> Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >> | <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> -> Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >> | <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> -> Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >> | <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> -> Some <:expr< Bigarray.Genarray.set $arr$ [| $list:coords$ |] $newval$ >> | _ -> None ] ; (* ...works bad... value rec sync cs = match cs with parser [ [: `';' :] -> sync_semi cs | [: `_ :] -> sync cs ] and sync_semi cs = match cs with parser [ [: `';' :] -> sync_semisemi cs | [: :] -> sync cs ] and sync_semisemi cs = match Stream.peek cs with [ Some ('\010' | '\013') -> () | _ -> sync_semi cs ] ; Pcaml.sync.val := sync; *) EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type class_expr class_sig_item class_str_item let_binding type_declaration; module_expr: [ [ "functor"; "("; i = UIDENT; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> | "struct"; st = LIST0 [ s = str_item; OPT ";;" -> s ]; "end" -> <:module_expr< struct $list:st$ end >> ] | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = UIDENT -> <:module_expr< $uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> <:str_item< exception $c$ of $list:tl$ = $b$ >> | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:str_item< external $i$ : $t$ = $list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:str_item< external $i$ : $t$ = $list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; i = UIDENT; mb = module_binding -> <:str_item< module $i$ = $mb$ >> | "module"; "rec"; nmtmes = LIST1 module_rec_binding SEP "and" -> MLast.StRecMod loc nmtmes | "module"; "type"; i = UIDENT; "="; mt = module_type -> <:str_item< module type $i$ = $mt$ >> | "open"; i = mod_ident -> <:str_item< open $i$ >> | "type"; tdl = LIST1 type_declaration SEP "and" -> <:str_item< type $list:tdl$ >> | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; x = expr -> let e = <:expr< let $opt:o2b r$ $list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and" -> match l with [ [(<:patt< _ >>, e)] -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $opt:o2b r$ $list:l$ >> ] | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr -> <:str_item< let module $m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = mod_ident -> sl | -> [] ] ] ; module_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; module_rec_binding: [ [ m = UIDENT; ":"; mt = module_type; "="; me = module_expr -> (m, mt, me) ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = LIST1 with_constr SEP "and" -> <:module_type< $mt$ with $list:wcl$ >> ] | [ "sig"; sg = LIST0 [ s = sig_item; OPT ";;" -> s ]; "end" -> <:module_type< sig $list:sg$ end >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = UIDENT -> <:module_type< $uid:m$ >> | m = LIDENT -> <:module_type< $lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration -> <:sig_item< exception $c$ of $list:tl$ >> | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:sig_item< external $i$ : $t$ = $list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:sig_item< external $i$ : $t$ = $list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; i = UIDENT; mt = module_declaration -> <:sig_item< module $i$ : $mt$ >> | "module"; "rec"; mds = LIST1 module_rec_declaration SEP "and" -> MLast.SgRecMod loc mds | "module"; "type"; i = UIDENT; "="; mt = module_type -> <:sig_item< module type $i$ = $mt$ >> | "module"; "type"; i = UIDENT -> <:sig_item< module type $i$ = 'abstract >> | "open"; i = mod_ident -> <:sig_item< open $i$ >> | "type"; tdl = LIST1 type_declaration SEP "and" -> <:sig_item< type $list:tdl$ >> | "val"; i = LIDENT; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ] ; module_rec_declaration: [ [ m = UIDENT; ":"; mt = module_type -> (m, mt)] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = type_parameters; i = mod_ident; "="; t = ctyp -> MLast.WcTyp loc i tpl t | "module"; i = mod_ident; "="; me = module_expr -> MLast.WcMod loc i me ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 ] | "expr1" [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; x = expr LEVEL "top" -> <:expr< let $opt:o2b o$ $list:l$ in $x$ >> | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< fun [ $list:l$ ] >> | "fun"; p = patt LEVEL "simple"; e = fun_def -> <:expr< fun [$p$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< match $e$ with [ $list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< try $e$ with [ $list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = LIDENT; "="; e1 = SELF; df = direction_flag; e2 = SELF; "do"; e = SELF; "done" -> <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >> | "while"; e1 = SELF; "do"; e2 = SELF; "done" -> <:expr< while $e1$ do { $list:get_seq e2$ } >> ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> match bigarray_set loc e1 e2 with [ Some e -> e | None -> <:expr< $e1$ := $e2$ >> ] ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; "$"; e2 = SELF -> <:expr< $lid:"\$"$ $e1$ $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< $mkumin loc "-" e$ >> | "-."; e = SELF -> <:expr< $mkumin loc "-." e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> match constr_expr_arity loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> match e with [ <:expr< False >> -> <:expr< assert False >> | _ -> <:expr< assert ($e$) >> ] | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e1 = SELF; "."; "{"; e2 = SELF; "}" -> bigarray_get loc e1 e2 | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val>> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = INT -> <:expr< $int:s$ >> | s = INT32 -> MLast.ExInt32 loc s | s = INT64 -> MLast.ExInt64 loc s | s = NATIVEINT -> MLast.ExNativeInt loc s | s = FLOAT -> <:expr< $flo:s$ >> | s = STRING -> <:expr< $str:s$ >> | c = CHAR -> <:expr< $chr:c$ >> | UIDENT "True" -> <:expr< $uid:" True"$ >> | UIDENT "False" -> <:expr< $uid:" False"$ >> | i = expr_ident -> i | s = "false" -> <:expr< False >> | s = "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = expr1_semi_list; "|]" -> <:expr< [| $list:el$ |] >> | "{"; test_label_eq; lel = lbl_expr_list; "}" -> <:expr< { $list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = lbl_expr_list; "}" -> <:expr< { ($e$) with $list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> <:expr< $e$ >> | "begin"; e = SELF; "end" -> <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = LOCATE -> let x = try let i = String.index x ':' in (int_of_string (String.sub x 0 i), String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found | Failure _ -> (0, x) ] in Pcaml.handle_expr_locate loc x | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_expr_quotation loc x ] ] ; let_binding: [ [ p = patt; e = fun_binding -> match patt_lid p with [ Some (loc, i, pl) -> let e = List.fold_left (fun e p -> <:expr< fun $p$ -> $e$ >>) e pl in (<:patt< $lid:i$ >>, e) | None -> (p, e) ] ] ] ; fun_binding: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] ; match_case: [ [ x1 = patt; w = OPT [ "when"; e = expr -> e ]; "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] | e = expr LEVEL "expr1"; ";" -> [e] | e = expr LEVEL "expr1" -> [e] ] ] ; fun_def: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "->"; e = expr -> <:expr< $e$ >> ] ] ; expr_ident: [ RIGHTA [ i = LIDENT -> <:expr< $lid:i$ >> | i = UIDENT -> <:expr< $uid:i$ >> | i = UIDENT; "."; j = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop <:expr< $uid:i$ >> j | i = UIDENT; "."; "("; j = operator_rparen -> <:expr< $uid:i$ . $lid:j$ >> ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> match constr_patt_arity loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ s = LIDENT -> <:patt< $lid:s$ >> | s = UIDENT -> <:patt< $uid:s$ >> | s = INT -> <:patt< $int:s$ >> | s = INT32 -> MLast.PaInt32 loc s | s = INT64 -> MLast.PaInt64 loc s | s = NATIVEINT -> MLast.PaNativeInt loc s | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = INT32 -> MLast.PaInt32 loc ("-" ^ s) | "-"; s = INT64 -> MLast.PaInt64 loc ("-" ^ s) | "-"; s = NATIVEINT -> MLast.PaNativeInt loc ("-" ^ s) | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = FLOAT -> <:patt< $flo:s$ >> | s = STRING -> <:patt< $str:s$ >> | s = CHAR -> <:patt< $chr:s$ >> | UIDENT "True" -> <:patt< $uid:" True"$ >> | UIDENT "False" -> <:patt< $uid:" False"$ >> | s = "false" -> <:patt< False >> | s = "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = patt_semi_list; "|]" -> <:patt< [| $list:pl$ |] >> | "{"; lpl = lbl_patt_list; "}" -> <:patt< { $list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; ")" -> <:patt< $p$ >> | "_" -> <:patt< _ >> | x = LOCATE -> let x = try let i = String.index x ':' in (int_of_string (String.sub x 0 i), String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found | Failure _ -> (0, x) ] in Pcaml.handle_patt_locate loc x | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_patt_quotation loc x ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_declaration: [ [ tpl = type_parameters; n = type_patt; "="; tk = type_kind; cl = LIST0 constrain -> (n, tpl, tk, cl) | tpl = type_parameters; n = type_patt; cl = LIST0 constrain -> (n, tpl, <:ctyp< '$choose_tvar tpl$ >>, cl) ] ] ; type_patt: [ [ n = LIDENT -> (loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ "private"; "{"; ldl = label_declarations; "}" -> <:ctyp< private { $list:ldl$ } >> | "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< private [ $list:cdl$ ] >> | test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; "private"; "{"; ldl = label_declarations; "}" -> <:ctyp< $t$ == private { $list:ldl$ } >> | t = ctyp; "="; "{"; ldl = label_declarations; "}" -> <:ctyp< $t$ == { $list:ldl$ } >> | t = ctyp; "="; "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == private [ $list:cdl$ ] >> | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == [ $list:cdl$ ] >> | "{"; ldl = label_declarations; "}" -> <:ctyp< { $list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "'"; i = ident -> (i, (False, False)) | "+"; "'"; i = ident -> (i, (True, False)) | "-"; "'"; i = ident -> (i, (False, True)) ] ] ; constructor_declaration: [ [ ci = UIDENT; "of"; cal = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> (loc, ci, cal) | ci = UIDENT -> (loc, ci, []) ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "ctyp1") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "ctyp1" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = ident -> <:ctyp< '$i$ >> | "_" -> <:ctyp< _ >> | i = LIDENT -> <:ctyp< $lid:i$ >> | i = UIDENT -> <:ctyp< $uid:i$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = LIST1 class_declaration SEP "and" -> <:str_item< class $list:cd$ >> | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> <:str_item< class type $list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = LIST1 class_description SEP "and" -> <:sig_item< class $list:cd$ >> | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> <:sig_item< class type $list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = OPT "virtual"; ctp = class_type_parameters; i = LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = patt LEVEL "simple"; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (loc, []) | "["; tpl = LIST1 type_parameter SEP ","; "]" -> (loc, tpl) ] ] ; class_fun_def: [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = patt LEVEL "simple"; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = OPT "rec"; lb = LIST1 let_binding SEP "and"; "in"; ce = SELF -> <:class_expr< let $opt:o2b rf$ $list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $ct$ ] >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> <:class_expr< object $opt:cspo$ $list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> <:class_str_item< inherit $ce$ $opt:pb$ >> | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual $l$ : $t$ >> | "method"; "private"; l = label; ":"; t = poly_type; "="; e = expr -> MLast.CrMth loc l True e (Some t) | "method"; "private"; l = label; sb = fun_binding -> MLast.CrMth loc l True sb None | "method"; l = label; ":"; t = poly_type; "="; e = expr -> MLast.CrMth loc l False e (Some t) | "method"; l = label; sb = fun_binding -> MLast.CrMth loc l False sb None | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> <:class_type< $list:id$ [ $list:tl$ ] >> | id = clty_longident -> <:class_type< $list:id$ >> | "object"; cst = OPT class_self_type; csf = LIST0 class_sig_item; "end" -> <:class_type< object $opt:cst$ $list:csf$ end >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual $l$ : $t$ >> | "method"; "private"; l = label; ":"; t = poly_type -> <:class_sig_item< method private $l$ : $t$ >> | "method"; l = label; ":"; t = poly_type -> <:class_sig_item< method $l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; ":"; ct = class_type -> {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; "="; cs = class_signature -> {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = class_longident -> <:expr< new $list:i$ >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = field_expr_list; ">}" -> <:expr< {< $list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >> | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v) | f = field; ";" -> ([f], False) | f = field -> ([f], False) | ".." -> ([], True) ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) clty_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: LEVEL "arrow" [ RIGHTA [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >> | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ = $list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ > $list:rfl$ ] >> | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ < $list:rfl$ ] >> | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; ">"; ntl = LIST1 name_tag; "]" -> <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ] ; row_field: [ [ "`"; i = ident -> MLast.RfTag i True [] | "`"; i = ident; "of"; ao = OPT "&"; l = LIST1 ctyp SEP "&" -> MLast.RfTag i (o2b ao) l | t = ctyp -> MLast.RfInh t ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] ; expr: AFTER "apply" [ "label" [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >> | i = TILDEIDENT -> <:expr< ~ $i$ >> | "~"; i = LIDENT -> <:expr< ~ $i$ >> | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >> | i = QUESTIONIDENT -> <:expr< ? $i$ >> | "?"; i = LIDENT -> <:expr< ? $i$ >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ] ; fun_def: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; patt: LEVEL "simple" [ [ "`"; s = ident -> <:patt< ` $s$ >> | "#"; t = mod_ident -> <:patt< # $list:t$ >> ] ] ; labeled_patt: [ [ i = LABEL; p = patt LEVEL "simple" -> <:patt< ~ $i$ : $p$ >> | i = TILDEIDENT -> <:patt< ~ $i$ >> | "~"; i=LIDENT -> <:patt< ~ $i$ >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~ $i$ >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~ $i$ : ($lid:i$ : $t$) >> | i = OPTLABEL; j = LIDENT -> <:patt< ? $i$ : ($lid:j$) >> | i = OPTLABEL; "("; p = patt; "="; e = expr; ")" -> <:patt< ? $i$ : ( $p$ = $e$ ) >> | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ? $i$ : ( $p$ : $t$ ) >> | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >> | i = QUESTIONIDENT -> <:patt< ? $i$ >> | "?"; i = LIDENT -> <:patt< ? $i$ >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ = $e$ ) >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> | "?"; "("; i = LIDENT; ")" -> <:patt< ? $i$ >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ? ( $lid:i$ : $t$ ) >> ] ] ; class_type: [ [ i = lident_colon; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> | i = OPTLABEL; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> | "?"; i = LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $n$ $opt:dp$ >>, loc)], True) | EOI -> ([], False) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $n$ $opt:dp$ >>, loc)], True) | EOI -> ([], False) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set Plexer.no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pa_j_3.08.ml000066400000000000000000002276001303454263000146670ustar00rootroot00000000000000(* camlp4r pa_extend.cmo q_MLast.cmo *) (***********************************************************************) (* *) (* Camlp4 *) (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2002 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) (* $Id: pa_o.ml,v 1.58.2.1 2004/08/18 11:17:37 mauny Exp $ *) open Stdpp; open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* ------------------------------------------------------------------------- *) (* Hacked version of the lexer. *) (* ------------------------------------------------------------------------- *) open Token; value jrh_lexer = ref False; value no_quotations = ref False; (* The string buffering machinery *) value buff = ref (String.create 80); value store len x = do { if len >= String.length buff.val then buff.val := buff.val ^ String.create (String.length buff.val) else (); buff.val.[len] := x; succ len } ; value mstore len s = add_rec len 0 where rec add_rec len i = if i == String.length s then len else add_rec (store len s.[i]) (succ i) ; value get_buff len = String.sub buff.val 0 len; (* The lexer *) value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value rec ident len = parser [ [: `('A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '0'..'9' | '_' | ''' as c) ; s :] -> ident (store len c) s | [: :] -> len ] and ident2 len = parser [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' as c) ; s :] -> ident2 (store len c) s | [: :] -> len ] and ident3 len = parser [ [: `('0'..'9' | 'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' as c) ; s :] -> ident3 (store len c) s | [: :] -> len ] and base_number len = parser [ [: `'o' | 'O'; s :] -> digits octal (store len 'o') s | [: `'x' | 'X'; s :] -> digits hexa (store len 'x') s | [: `'b' | 'B'; s :] -> digits binary (store len 'b') s | [: a = number len :] -> a ] and digits kind len = parser [ [: d = kind; s :] -> digits_under kind (store len d) s | [: :] -> raise (Stream.Error "ill-formed integer constant") ] and digits_under kind len = parser [ [: d = kind; s :] -> digits_under kind (store len d) s | [: `'_'; s :] -> digits_under kind len s | [: `'l' :] -> ("INT32", get_buff len) | [: `'L' :] -> ("INT64", get_buff len) | [: `'n' :] -> ("NATIVEINT", get_buff len) | [: :] -> ("INT", get_buff len) ] and octal = parser [ [: `('0'..'7' as d) :] -> d ] and hexa = parser [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d) :] -> d ] and binary = parser [ [: `('0'..'1' as d) :] -> d ] and number len = parser [ [: `('0'..'9' as c); s :] -> number (store len c) s | [: `'_'; s :] -> number len s | [: `'.'; s :] -> decimal_part (store len '.') s | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s | [: `'l' :] -> ("INT32", get_buff len) | [: `'L' :] -> ("INT64", get_buff len) | [: `'n' :] -> ("NATIVEINT", get_buff len) | [: :] -> ("INT", get_buff len) ] and decimal_part len = parser [ [: `('0'..'9' as c); s :] -> decimal_part (store len c) s | [: `'_'; s :] -> decimal_part len s | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s | [: :] -> ("FLOAT", get_buff len) ] and exponent_part len = parser [ [: `('+' | '-' as c); s :] -> end_exponent_part (store len c) s | [: a = end_exponent_part len :] -> a ] and end_exponent_part len = parser [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s | [: :] -> raise (Stream.Error "ill-formed floating-point constant") ] and end_exponent_part_under len = parser [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s | [: `'_'; s :] -> end_exponent_part_under len s | [: :] -> ("FLOAT", get_buff len) ] ; value error_on_unknown_keywords = ref False; value err loc msg = raise_with_loc loc (Token.Error msg); (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) (***** Carl's alternative version then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; *****) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) (* Debugging positions and locations *) value eprint_pos msg p = Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d\n%!" msg p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum ; value eprint_loc (bp, ep) = do { eprint_pos "P1" bp; eprint_pos "P2" ep } ; value check_location msg ((bp, ep) as loc) = let ok = if (bp.Lexing.pos_lnum > ep.Lexing.pos_lnum || bp.Lexing.pos_bol > ep.Lexing.pos_bol || bp.Lexing.pos_cnum > ep.Lexing.pos_cnum || bp.Lexing.pos_lnum < 0 || ep.Lexing.pos_lnum < 0 || bp.Lexing.pos_bol < 0 || ep.Lexing.pos_bol < 0 || bp.Lexing.pos_cnum < 0 || ep.Lexing.pos_cnum < 0) (* Here, we don't check bp.Lexing.pos_cnum < bp.Lexing.pos_bol || ep.Lexing.pos_cnum < bp.Lexing.pos_bol since the lexer is called on antiquotations, with cnum=0, but lnum and bolpos have "correct" values *) then do { Printf.eprintf "*** Warning: (%s) strange positions ***\n" msg; eprint_loc loc; False } else True in (ok, loc) ; value next_token_fun dfa ssd find_kwd fname lnum bolpos glexr = let make_pos p = {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val; Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in let mkloc (bp, ep) = (make_pos bp, make_pos ep) in let keyword_or_error (bp,ep) s = let loc = mkloc (bp, ep) in try (("", find_kwd s), loc) with [ Not_found -> if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) else (("", s), loc) ] in let error_if_keyword ( ((_,id) as a), bep) = let loc = mkloc bep in try do { ignore(find_kwd id); err loc ("illegal use of a keyword as a label: " ^ id) } with [ Not_found -> (a, loc) ] in let rec next_token after_space = parser bp [ [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; next_token True s } | [: `'\013'; s :] ep -> let ep = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; ep+1 } | _ -> ep ] in do { bolpos.val := ep; incr lnum; next_token True s } | [: `' ' | '\t' | '\026' | '\012'; s :] -> next_token True s | [: `'#' when bp = bolpos.val; s :] -> if linedir 1 s then do { line_directive s; next_token True s } else keyword_or_error (bp, bp + 1) "#" | [: `'('; s :] -> left_paren bp s | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = mkloc (bp, (Stream.count s)) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) ***********) | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = mkloc (bp, (Stream.count s)) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) **********) | [: `('1'..'9' as c); s :] -> let tok = number (store 0 c) s in let loc = mkloc (bp, (Stream.count s)) in (tok, loc) | [: `'0'; s :] -> let tok = base_number (store 0 '0') s in let loc = mkloc (bp, (Stream.count s)) in (tok, loc) | [: `'''; s :] -> match Stream.npeek 2 s with [ [_; '''] | ['\\'; _] -> let tok = ("CHAR", get_buff (char bp 0 s)) in let loc = mkloc (bp, (Stream.count s)) in (tok, loc) | _ -> keyword_or_error (bp, Stream.count s) "'" ] | [: `'"'; s :] -> let tok = ("STRING", get_buff (string bp 0 s)) in let loc = mkloc (bp, Stream.count s) in (tok, loc) | [: `'`'; s :] -> let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in let loc = mkloc (bp, Stream.count s) in (tok, loc) | [: `'$'; s :] -> let tok = dollar bp 0 s in let loc = mkloc (bp, Stream.count s) in (tok, loc) | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id | [: `('~' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> let id = get_buff len in match s with parser [ [: `':' :] eb -> error_if_keyword (("LABEL", id), (bp, ep)) | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ] | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `('?' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> let id = get_buff len in match s with parser [ [: `':' :] eb -> error_if_keyword (("OPTLABEL", id), (bp,ep)) | [: :] -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep)) ] | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `'<'; s :] -> less bp s | [: `(':' as c1); len = parser [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('>' | '|' as c1); len = parser [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('[' | '{' as c1); s :] -> let len = match Stream.npeek 2 s with [ ['<'; '<' | ':'] -> store 0 c1 | _ -> match s with parser [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] ] in let ep = Stream.count s in let id = get_buff len in keyword_or_error (bp, ep) id | [: `'.'; id = parser [ [: `'.' :] -> ".." | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> keyword_or_error (bp, ep) id | [: `';'; id = parser [ [: `';' :] -> ";;" | [: :] -> ";" ] :] ep -> keyword_or_error (bp, ep) id | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), mkloc (bp, ep)) | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) | [: _ = Stream.empty :] -> (("EOI", ""), mkloc (bp, succ bp)) ] and less bp strm = if no_quotations.val then match strm with parser [ [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] else match strm with parser [ [: `'<'; len = quotation bp 0 :] ep -> (("QUOTATION", ":" ^ get_buff len), mkloc (bp, ep)) | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; `'<' ? "character '<' expected"; len = quotation bp 0 :] ep -> (("QUOTATION", i ^ ":" ^ get_buff len), mkloc (bp, ep)) | [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] and string bp len = parser [ [: `'"' :] -> len | [: `'\\'; `c; s :] ep -> string bp (store (store len '\\') c) s | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; string bp (store len '\010') s } | [: `'\013'; s :] ep -> let (len, ep) = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) } | _ -> (store len '\013', ep) ] in do { bolpos.val := ep; incr lnum; string bp len s } | [: `c; s :] -> string bp (store len c) s | [: :] ep -> err (mkloc (bp, ep)) "string not terminated" ] and qstring bp len = parser [ [: `'`' :] -> get_buff len | [: `c; s :] -> qstring bp (store len c) s | [: :] ep -> err (mkloc (bp, ep)) "quotation not terminated" ] and char bp len = parser [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s | [: `'\010'; s :] -> do {bolpos.val := bp+1; incr lnum; char bp (store len '\010') s} | [: `'\013'; s :] -> let bol = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; bp+2 } | _ -> bp+1 ] in do { bolpos.val := bol; incr lnum; char bp (store len '\013') s} | [: `c; s :] -> char bp (store len c) s | [: :] ep -> err (mkloc (bp, ep)) "char not terminated" ] and dollar bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: s :] -> if dfa then match s with parser [ [: `c :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] else ("", get_buff (ident2 (store 0 '$') s)) ] and maybe_locate bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s | [: `':'; s :] -> ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] and antiquot bp len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> antiquot bp (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] and locate_or_antiquot_rest bp len = parser [ [: `'$' :] -> get_buff len | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] and quotation bp len = parser [ [: `'>'; s :] -> maybe_end_quotation bp len s | [: `'<'; s :] -> quotation bp (maybe_nested_quotation bp (store len '<') s) s | [: `'\\'; len = parser [ [: `('>' | '<' | '\\' as c) :] -> store len c | [: :] -> store len '\\' ]; s :] -> quotation bp len s | [: `'\010'; s :] -> do {bolpos.val := bp+1; incr lnum; quotation bp (store len '\010') s} | [: `'\013'; s :] -> let bol = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; bp+2 } | _ -> bp+1 ] in do { bolpos.val := bol; incr lnum; quotation bp (store len '\013') s} | [: `c; s :] -> quotation bp (store len c) s | [: :] ep -> err (mkloc (bp, ep)) "quotation not terminated" ] and maybe_nested_quotation bp len = parser [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" | [: `':'; len = ident (store len ':'); a = parser [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" | [: :] -> len ] :] -> a | [: :] -> len ] and maybe_end_quotation bp len = parser [ [: `'>' :] -> len | [: a = quotation bp (store len '>') :] -> a ] and left_paren bp = parser [ [: `'*'; _ = comment bp; a = next_token True :] -> a | [: :] ep -> keyword_or_error (bp, ep) "(" ] and comment bp = parser [ [: `'('; s :] -> left_paren_in_comment bp s | [: `'*'; s :] -> star_in_comment bp s | [: `'"'; _ = string bp 0; s :] -> comment bp s | [: `'''; s :] -> quote_in_comment bp s | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; comment bp s } | [: `'\013'; s :] ep -> let ep = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; ep+1 } | _ -> ep ] in do { bolpos.val := ep; incr lnum; comment bp s } | [: `c; s :] -> comment bp s | [: :] ep -> err (mkloc (bp, ep)) "comment not terminated" ] and quote_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: `'\\'; s :] -> quote_antislash_in_comment bp 0 s | [: s :] -> do { match Stream.npeek 2 s with [ [ ( '\013' | '\010' ); '''] -> do { bolpos.val := bp + 1; incr lnum; Stream.junk s; Stream.junk s } | [ '\013'; '\010' ] -> match Stream.npeek 3 s with [ [_; _; '''] -> do { bolpos.val := bp + 2; incr lnum; Stream.junk s; Stream.junk s; Stream.junk s } | _ -> () ] | [_; '''] -> do { Stream.junk s; Stream.junk s } | _ -> () ]; comment bp s } ] and quote_any_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: a = comment bp :] -> a ] and quote_antislash_in_comment bp len = parser [ [: `'''; s :] -> comment bp s | [: `'\\' | '"' | 'n' | 't' | 'b' | 'r'; s :] -> quote_any_in_comment bp s | [: `'0'..'9'; s :] -> quote_antislash_digit_in_comment bp s | [: a = comment bp :] -> a ] and quote_antislash_digit_in_comment bp = parser [ [: `'0'..'9'; s :] -> quote_antislash_digit2_in_comment bp s | [: a = comment bp :] -> a ] and quote_antislash_digit2_in_comment bp = parser [ [: `'0'..'9'; s :] -> quote_any_in_comment bp s | [: a = comment bp :] -> a ] and left_paren_in_comment bp = parser [ [: `'*'; s :] -> do { comment bp s; comment bp s } | [: a = comment bp :] -> a ] and star_in_comment bp = parser [ [: `')' :] -> () | [: a = comment bp :] -> a ] and linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> True | _ -> False ] and any_to_nl = parser [ [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum } | [: `'\013'; s :] ep -> let ep = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; ep+1 } | _ -> ep ] in do { bolpos.val := ep; incr lnum } | [: `_; s :] -> any_to_nl s | [: :] -> () ] and line_directive = parser (* we are sure that there is a line directive here *) [ [: _ = skip_spaces; n = line_directive_number 0; _ = skip_spaces; _ = line_directive_string; _ = any_to_nl :] ep -> do { bolpos.val := ep; lnum.val := n } ] and skip_spaces = parser [ [: `' ' | '\t'; s :] -> skip_spaces s | [: :] -> () ] and line_directive_number n = parser [ [: `('0'..'9' as c) ; s :] -> line_directive_number (10*n + (Char.code c - Char.code '0')) s | [: :] -> n ] and line_directive_string = parser [ [: ` '"' ; _ = line_directive_string_contents 0 :] -> () | [: :] -> () ] and line_directive_string_contents len = parser [ [: ` '\010' | '\013' :] -> () | [: ` '"' :] -> fname.val := get_buff len | [: `c; s :] -> line_directive_string_contents (store len c) s ] in fun cstrm -> try let glex = glexr.val in let comm_bp = Stream.count cstrm in let r = next_token False cstrm in do { match glex.tok_comm with [ Some list -> let next_bp = (fst (snd r)).Lexing.pos_cnum in if next_bp > comm_bp then let comm_loc = mkloc (comm_bp, next_bp) in glex.tok_comm := Some [comm_loc :: list] else () | None -> () ]; r } with [ Stream.Error str -> err (mkloc (Stream.count cstrm, Stream.count cstrm + 1)) str ] ; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value func kwd_table glexr = let bolpos = ref 0 in let lnum = ref 1 in let fname = ref "" in let find = Hashtbl.find kwd_table in let dfa = dollar_for_antiquotation.val in let ssd = specific_space_dot.val in Token.lexer_func_of_parser (next_token_fun dfa ssd find fname lnum bolpos glexr) ; value rec check_keyword_stream = parser [: _ = check; _ = Stream.empty :] -> True and check = parser [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' ; s :] -> check_ident s | [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ; s :] -> check_ident2 s | [: `'<'; s :] -> match Stream.npeek 1 s with [ [':' | '<'] -> () | _ -> check_ident2 s ] | [: `':'; _ = parser [ [: `']' | ':' | '=' | '>' :] -> () | [: :] -> () ] :] ep -> () | [: `'>' | '|'; _ = parser [ [: `']' | '}' :] -> () | [: a = check_ident2 :] -> a ] :] -> () | [: `'[' | '{'; s :] -> match Stream.npeek 2 s with [ ['<'; '<' | ':'] -> () | _ -> match s with parser [ [: `'|' | '<' | ':' :] -> () | [: :] -> () ] ] | [: `';'; _ = parser [ [: `';' :] -> () | [: :] -> () ] :] -> () | [: `_ :] -> () ] and check_ident = parser [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '0'..'9' | '_' | ''' ; s :] -> check_ident s | [: :] -> () ] and check_ident2 = parser [ [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' ; s :] -> check_ident2 s | [: :] -> () ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Token.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Token.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (Hashtbl.mem kwd_table p_prm) then if check_keyword p_prm then if Hashtbl.mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "INT" | "INT32" | "INT64" | "NATIVEINT" | "FLOAT" | "CHAR" | "STRING" | "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL" | "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" -> () | _ -> raise (Token.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT32", "") -> "32 bits integer" | ("INT64", "") -> "64 bits integer" | ("NATIVEINT", "") -> "native integer" | (("INT" | "INT32" | "NATIVEINT"), s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("LOCATE", "") -> "locate" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Token.default_match tok ] ; value gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let glex = {tok_func = func kwd_table glexr; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; glex } ; value tparse = fun [ ("ANTIQUOT", p_prm) -> let p = parser [: `("ANTIQUOT", prm) when eq_before_colon p_prm prm :] -> after_colon prm in Some p | _ -> None ] ; value make () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in {func = func kwd_table glexr; using = using_token kwd_table id_table; removing = removing_token kwd_table id_table; tparse = tparse; text = text} ; (* ------------------------------------------------------------------------- *) (* Resume the main file. *) (* ------------------------------------------------------------------------- *) do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; Grammar.Unsafe.gram_reinit gram (gmake ()); dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_declaration; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value o2b = fun [ Some _ -> True | None -> False ] ; value mkumin loc f arg = match (f, arg) with [ ("-", <:expr< $int:n$ >>) when int_of_string n > 0 -> let n = "-" ^ n in <:expr< $int:n$ >> | ("-", MLast.ExInt32 loc n) when (Int32.of_string n) > 0l -> MLast.ExInt32 loc ("-" ^ n) | ("-", MLast.ExInt64 loc n) when (Int64.of_string n) > 0L -> MLast.ExInt64 loc ("-" ^ n) | ("-", MLast.ExNativeInt loc n) when (Nativeint.of_string n) > 0n -> MLast.ExNativeInt loc ("-" ^ n) | (_, <:expr< $flo:n$ >>) when float_of_string n > 0.0 -> let n = "-" ^ n in <:expr< $flo:n$ >> | _ -> let f = "~" ^ f in <:expr< $lid:f$ $arg$ >> ] ; value mklistexp loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let loc = if top then loc else (fst (MLast.loc_of_expr e1), snd loc) in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let loc = if top then loc else (fst (MLast.loc_of_patt p1), snd loc) in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = let ct = Hashtbl.create 73 in do { List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] } ; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; (*** And JRH inserted it in here ***) value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value lident_colon = Grammar.Entry.of_parser gram "lident_colon" (fun strm -> match Stream.npeek 2 strm with [ [("LIDENT", i); ("", ":")] -> do { Stream.junk strm; Stream.junk strm; i } | _ -> raise Stream.Failure ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in let rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False in loop ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e | <:expr< $e$ $_$ >> -> if is_expr_constr_call e then Stdpp.raise_with_loc loc (Stream.Error "currified constructor") else 1 | _ -> 1 ] ; value rec is_patt_constr_call = fun [ <:patt< $uid:_$ >> -> True | <:patt< $uid:_$.$p$ >> -> is_patt_constr_call p | <:patt< $p$ $_$ >> -> is_patt_constr_call p | _ -> False ] ; value rec constr_patt_arity loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p | <:patt< $p$ $_$ >> -> if is_patt_constr_call p then Stdpp.raise_with_loc loc (Stream.Error "currified constructor") else 1 | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if List.mem_assoc s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if List.mem_assoc v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; value rec patt_lid = fun [ <:patt< $p1$ $p2$ >> -> match p1 with [ <:patt< $lid:i$ >> -> Some (MLast.loc_of_patt p1, i, [p2]) | _ -> match patt_lid p1 with [ Some (loc, i, pl) -> Some (loc, i, [p2 :: pl]) | None -> None ] ] | _ -> None ] ; value bigarray_get loc arr arg = let coords = match arg with [ <:expr< ($list:el$) >> -> el | _ -> [arg] ] in match coords with [ [c1] -> <:expr< Bigarray.Array1.get $arr$ $c1$ >> | [c1; c2] -> <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> | [c1; c2; c3] -> <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> ] ; value bigarray_set loc var newval = match var with [ <:expr< Bigarray.Array1.get $arr$ $c1$ >> -> Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >> | <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> -> Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >> | <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> -> Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >> | <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> -> Some <:expr< Bigarray.Genarray.set $arr$ [| $list:coords$ |] $newval$ >> | _ -> None ] ; (* ...works bad... value rec sync cs = match cs with parser [ [: `';' :] -> sync_semi cs | [: `_ :] -> sync cs ] and sync_semi cs = match cs with parser [ [: `';' :] -> sync_semisemi cs | [: :] -> sync cs ] and sync_semisemi cs = match Stream.peek cs with [ Some ('\010' | '\013') -> () | _ -> sync_semi cs ] ; Pcaml.sync.val := sync; *) EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type class_expr class_sig_item class_str_item let_binding type_declaration; module_expr: [ [ "functor"; "("; i = UIDENT; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> | "struct"; st = LIST0 [ s = str_item; OPT ";;" -> s ]; "end" -> <:module_expr< struct $list:st$ end >> ] | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = UIDENT -> <:module_expr< $uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> <:str_item< exception $c$ of $list:tl$ = $b$ >> | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:str_item< external $i$ : $t$ = $list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:str_item< external $i$ : $t$ = $list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; i = UIDENT; mb = module_binding -> <:str_item< module $i$ = $mb$ >> | "module"; "rec"; nmtmes = LIST1 module_rec_binding SEP "and" -> MLast.StRecMod loc nmtmes | "module"; "type"; i = UIDENT; "="; mt = module_type -> <:str_item< module type $i$ = $mt$ >> | "open"; i = mod_ident -> <:str_item< open $i$ >> | "type"; tdl = LIST1 type_declaration SEP "and" -> <:str_item< type $list:tdl$ >> | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; x = expr -> let e = <:expr< let $opt:o2b r$ $list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and" -> match l with [ [(<:patt< _ >>, e)] -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $opt:o2b r$ $list:l$ >> ] | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr -> <:str_item< let module $m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = mod_ident -> sl | -> [] ] ] ; module_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; module_rec_binding: [ [ m = UIDENT; ":"; mt = module_type; "="; me = module_expr -> (m, mt, me) ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = LIST1 with_constr SEP "and" -> <:module_type< $mt$ with $list:wcl$ >> ] | [ "sig"; sg = LIST0 [ s = sig_item; OPT ";;" -> s ]; "end" -> <:module_type< sig $list:sg$ end >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = UIDENT -> <:module_type< $uid:m$ >> | m = LIDENT -> <:module_type< $lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration -> <:sig_item< exception $c$ of $list:tl$ >> | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:sig_item< external $i$ : $t$ = $list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:sig_item< external $i$ : $t$ = $list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; i = UIDENT; mt = module_declaration -> <:sig_item< module $i$ : $mt$ >> | "module"; "rec"; mds = LIST1 module_rec_declaration SEP "and" -> MLast.SgRecMod loc mds | "module"; "type"; i = UIDENT; "="; mt = module_type -> <:sig_item< module type $i$ = $mt$ >> | "module"; "type"; i = UIDENT -> <:sig_item< module type $i$ = 'abstract >> | "open"; i = mod_ident -> <:sig_item< open $i$ >> | "type"; tdl = LIST1 type_declaration SEP "and" -> <:sig_item< type $list:tdl$ >> | "val"; i = LIDENT; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ] ; module_rec_declaration: [ [ m = UIDENT; ":"; mt = module_type -> (m, mt)] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = type_parameters; i = mod_ident; "="; t = ctyp -> MLast.WcTyp loc i tpl t | "module"; i = mod_ident; "="; me = module_expr -> MLast.WcMod loc i me ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 ] | "expr1" [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; x = expr LEVEL "top" -> <:expr< let $opt:o2b o$ $list:l$ in $x$ >> | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< fun [ $list:l$ ] >> | "fun"; p = simple_patt; e = fun_def -> <:expr< fun [$p$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< match $e$ with [ $list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< try $e$ with [ $list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = LIDENT; "="; e1 = SELF; df = direction_flag; e2 = SELF; "do"; e = SELF; "done" -> <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >> | "while"; e1 = SELF; "do"; e2 = SELF; "done" -> <:expr< while $e1$ do { $list:get_seq e2$ } >> | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> (* <:expr< object $opt:cspo$ $list:cf$ end >> *) MLast.ExObj loc cspo cf ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> match bigarray_set loc e1 e2 with [ Some e -> e | None -> <:expr< $e1$ := $e2$ >> ] ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; "$"; e2 = SELF -> <:expr< $lid:"\$"$ $e1$ $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< $mkumin loc "-" e$ >> | "-."; e = SELF -> <:expr< $mkumin loc "-." e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> match constr_expr_arity loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> match e with [ <:expr< False >> -> <:expr< assert False >> | _ -> <:expr< assert ($e$) >> ] | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e1 = SELF; "."; "{"; e2 = SELF; "}" -> bigarray_get loc e1 e2 | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val>> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = INT -> <:expr< $int:s$ >> | s = INT32 -> MLast.ExInt32 loc s | s = INT64 -> MLast.ExInt64 loc s | s = NATIVEINT -> MLast.ExNativeInt loc s | s = FLOAT -> <:expr< $flo:s$ >> | s = STRING -> <:expr< $str:s$ >> | c = CHAR -> <:expr< $chr:c$ >> | UIDENT "True" -> <:expr< $uid:" True"$ >> | UIDENT "False" -> <:expr< $uid:" False"$ >> | i = expr_ident -> i | s = "false" -> <:expr< False >> | s = "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = expr1_semi_list; "|]" -> <:expr< [| $list:el$ |] >> | "{"; test_label_eq; lel = lbl_expr_list; "}" -> <:expr< { $list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = lbl_expr_list; "}" -> <:expr< { ($e$) with $list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> <:expr< $e$ >> | "begin"; e = SELF; "end" -> <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = LOCATE -> let x = try let i = String.index x ':' in ({Lexing.pos_fname = ""; Lexing.pos_lnum = 0; Lexing.pos_bol = 0; Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found | Failure _ -> (Token.nowhere, x) ] in Pcaml.handle_expr_locate loc x | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_expr_quotation loc x ] ] ; let_binding: [ [ p = patt; e = fun_binding -> match patt_lid p with [ Some (loc, i, pl) -> let e = List.fold_left (fun e p -> <:expr< fun $p$ -> $e$ >>) e pl in (<:patt< $lid:i$ >>, e) | None -> (p, e) ] ] ] ; fun_binding: [ RIGHTA [ p = simple_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] ; match_case: [ [ x1 = patt; w = OPT [ "when"; e = expr -> e ]; "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] | e = expr LEVEL "expr1"; ";" -> [e] | e = expr LEVEL "expr1" -> [e] ] ] ; fun_def: [ RIGHTA [ p = simple_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> | "->"; e = expr -> <:expr< $e$ >> ] ] ; expr_ident: [ RIGHTA [ i = LIDENT -> <:expr< $lid:i$ >> | i = UIDENT -> <:expr< $uid:i$ >> | i = UIDENT; "."; j = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop <:expr< $uid:i$ >> j | i = UIDENT; "."; "("; j = operator_rparen -> <:expr< $uid:i$ . $lid:j$ >> ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> match constr_patt_arity loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ p = simple_patt -> p ] ] ; simple_patt: [ [ s = LIDENT -> <:patt< $lid:s$ >> | s = UIDENT -> <:patt< $uid:s$ >> | s = INT -> <:patt< $int:s$ >> | s = INT32 -> MLast.PaInt32 loc s | s = INT64 -> MLast.PaInt64 loc s | s = NATIVEINT -> MLast.PaNativeInt loc s | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = INT32 -> MLast.PaInt32 loc ("-" ^ s) | "-"; s = INT64 -> MLast.PaInt64 loc ("-" ^ s) | "-"; s = NATIVEINT -> MLast.PaNativeInt loc ("-" ^ s) | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = FLOAT -> <:patt< $flo:s$ >> | s = STRING -> <:patt< $str:s$ >> | s = CHAR -> <:patt< $chr:s$ >> | UIDENT "True" -> <:patt< $uid:" True"$ >> | UIDENT "False" -> <:patt< $uid:" False"$ >> | s = "false" -> <:patt< False >> | s = "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = patt_semi_list; "|]" -> <:patt< [| $list:pl$ |] >> | "{"; lpl = lbl_patt_list; "}" -> <:patt< { $list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = patt; ")" -> <:patt< $p$ >> | "_" -> <:patt< _ >> | "`"; s = ident -> <:patt< ` $s$ >> | "#"; t = mod_ident -> <:patt< # $list:t$ >> | x = LOCATE -> let x = try let i = String.index x ':' in ({Lexing.pos_fname = ""; Lexing.pos_lnum = 0; Lexing.pos_bol = 0; Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found | Failure _ -> (Token.nowhere, x) ] in Pcaml.handle_patt_locate loc x | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_patt_quotation loc x ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_declaration: [ [ tpl = type_parameters; n = type_patt; "="; tk = type_kind; cl = LIST0 constrain -> (n, tpl, tk, cl) | tpl = type_parameters; n = type_patt; cl = LIST0 constrain -> (n, tpl, <:ctyp< '$choose_tvar tpl$ >>, cl) ] ] ; type_patt: [ [ n = LIDENT -> (loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ "private"; "{"; ldl = label_declarations; "}" -> <:ctyp< private { $list:ldl$ } >> | "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< private [ $list:cdl$ ] >> | test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; "private"; "{"; ldl = label_declarations; "}" -> <:ctyp< $t$ == private { $list:ldl$ } >> | t = ctyp; "="; "{"; ldl = label_declarations; "}" -> <:ctyp< $t$ == { $list:ldl$ } >> | t = ctyp; "="; "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == private [ $list:cdl$ ] >> | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == [ $list:cdl$ ] >> | "{"; ldl = label_declarations; "}" -> <:ctyp< { $list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "'"; i = ident -> (i, (False, False)) | "+"; "'"; i = ident -> (i, (True, False)) | "-"; "'"; i = ident -> (i, (False, True)) ] ] ; constructor_declaration: [ [ ci = UIDENT; "of"; cal = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> (loc, ci, cal) | ci = UIDENT -> (loc, ci, []) ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "ctyp1") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "ctyp1" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = ident -> <:ctyp< '$i$ >> | "_" -> <:ctyp< _ >> | i = LIDENT -> <:ctyp< $lid:i$ >> | i = UIDENT -> <:ctyp< $uid:i$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = LIST1 class_declaration SEP "and" -> <:str_item< class $list:cd$ >> | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> <:str_item< class type $list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = LIST1 class_description SEP "and" -> <:sig_item< class $list:cd$ >> | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> <:sig_item< class type $list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = OPT "virtual"; ctp = class_type_parameters; i = LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = simple_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (loc, []) | "["; tpl = LIST1 type_parameter SEP ","; "]" -> (loc, tpl) ] ] ; class_fun_def: [ [ p = simple_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = simple_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = OPT "rec"; lb = LIST1 let_binding SEP "and"; "in"; ce = SELF -> <:class_expr< let $opt:o2b rf$ $list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $ct$ ] >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> <:class_expr< object $opt:cspo$ $list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> <:class_str_item< inherit $ce$ $opt:pb$ >> | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual $l$ : $t$ >> | "method"; "private"; l = label; ":"; t = poly_type; "="; e = expr -> MLast.CrMth loc l True e (Some t) | "method"; "private"; l = label; sb = fun_binding -> MLast.CrMth loc l True sb None | "method"; l = label; ":"; t = poly_type; "="; e = expr -> MLast.CrMth loc l False e (Some t) | "method"; l = label; sb = fun_binding -> MLast.CrMth loc l False sb None | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> <:class_type< $list:id$ [ $list:tl$ ] >> | id = clty_longident -> <:class_type< $list:id$ >> | "object"; cst = OPT class_self_type; csf = LIST0 class_sig_item; "end" -> <:class_type< object $opt:cst$ $list:csf$ end >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual $l$ : $t$ >> | "method"; "private"; l = label; ":"; t = poly_type -> <:class_sig_item< method private $l$ : $t$ >> | "method"; l = label; ":"; t = poly_type -> <:class_sig_item< method $l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; ":"; ct = class_type -> {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; "="; cs = class_signature -> {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = class_longident -> <:expr< new $list:i$ >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = field_expr_list; ">}" -> <:expr< {< $list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >> | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v) | f = field; ";" -> ([f], False) | f = field -> ([f], False) | ".." -> ([], True) ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) clty_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: LEVEL "arrow" [ RIGHTA [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >> | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ = $list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ > $list:rfl$ ] >> | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ < $list:rfl$ ] >> | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; ">"; ntl = LIST1 name_tag; "]" -> <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ] ; row_field: [ [ "`"; i = ident -> MLast.RfTag i True [] | "`"; i = ident; "of"; ao = OPT "&"; l = LIST1 ctyp SEP "&" -> MLast.RfTag i (o2b ao) l | t = ctyp -> MLast.RfInh t ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] ; expr: AFTER "apply" [ "label" [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >> | i = TILDEIDENT -> <:expr< ~ $i$ >> | "~"; i = LIDENT -> <:expr< ~ $i$ >> | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >> | i = QUESTIONIDENT -> <:expr< ? $i$ >> | "?"; i = LIDENT -> <:expr< ? $i$ >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ] ; fun_def: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; labeled_patt: [ [ i = LABEL; p = simple_patt -> <:patt< ~ $i$ : $p$ >> | i = TILDEIDENT -> <:patt< ~ $i$ >> | "~"; i=LIDENT -> <:patt< ~ $i$ >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~ $i$ >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~ $i$ : ($lid:i$ : $t$) >> | i = OPTLABEL; j = LIDENT -> <:patt< ? $i$ : ($lid:j$) >> | i = OPTLABEL; "("; p = patt; "="; e = expr; ")" -> <:patt< ? $i$ : ( $p$ = $e$ ) >> | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ? $i$ : ( $p$ : $t$ ) >> | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >> | i = QUESTIONIDENT -> <:patt< ? $i$ >> | "?"; i = LIDENT -> <:patt< ? $i$ >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ = $e$ ) >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> | "?"; "("; i = LIDENT; ")" -> <:patt< ? $i$ >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ? ( $lid:i$ : $t$ ) >> ] ] ; class_type: [ [ i = lident_colon; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> | i = OPTLABEL; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> | "?"; i = LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $n$ $opt:dp$ >>, loc)], True) | EOI -> ([], False) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $n$ $opt:dp$ >>, loc)], True) | EOI -> ([], False) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set Plexer.no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pa_j_3.09.ml000066400000000000000000002320351303454263000146660ustar00rootroot00000000000000(* camlp4r pa_extend.cmo q_MLast.cmo *) (***********************************************************************) (* *) (* Camlp4 *) (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2002 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) (* $Id: pa_o.ml,v 1.66 2005/06/29 04:11:26 garrigue Exp $ *) open Stdpp; open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* ------------------------------------------------------------------------- *) (* Hacked version of the lexer. *) (* ------------------------------------------------------------------------- *) open Token; value jrh_lexer = ref False; value no_quotations = ref False; (* The string buffering machinery *) value buff = ref (String.create 80); value store len x = do { if len >= String.length buff.val then buff.val := buff.val ^ String.create (String.length buff.val) else (); buff.val.[len] := x; succ len } ; value mstore len s = add_rec len 0 where rec add_rec len i = if i == String.length s then len else add_rec (store len s.[i]) (succ i) ; value get_buff len = String.sub buff.val 0 len; (* The lexer *) value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value rec ident len = parser [ [: `('A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '0'..'9' | '_' | ''' as c) ; s :] -> ident (store len c) s | [: :] -> len ] and ident2 len = parser [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' as c) ; s :] -> ident2 (store len c) s | [: :] -> len ] and ident3 len = parser [ [: `('0'..'9' | 'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' as c) ; s :] -> ident3 (store len c) s | [: :] -> len ] and base_number len = parser [ [: `'o' | 'O'; s :] -> digits octal (store len 'o') s | [: `'x' | 'X'; s :] -> digits hexa (store len 'x') s | [: `'b' | 'B'; s :] -> digits binary (store len 'b') s | [: a = number len :] -> a ] and digits kind len = parser [ [: d = kind; s :] -> digits_under kind (store len d) s | [: :] -> raise (Stream.Error "ill-formed integer constant") ] and digits_under kind len = parser [ [: d = kind; s :] -> digits_under kind (store len d) s | [: `'_'; s :] -> digits_under kind len s | [: `'l' :] -> ("INT32", get_buff len) | [: `'L' :] -> ("INT64", get_buff len) | [: `'n' :] -> ("NATIVEINT", get_buff len) | [: :] -> ("INT", get_buff len) ] and octal = parser [ [: `('0'..'7' as d) :] -> d ] and hexa = parser [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d) :] -> d ] and binary = parser [ [: `('0'..'1' as d) :] -> d ] and number len = parser [ [: `('0'..'9' as c); s :] -> number (store len c) s | [: `'_'; s :] -> number len s | [: `'.'; s :] -> decimal_part (store len '.') s | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s | [: `'l' :] -> ("INT32", get_buff len) | [: `'L' :] -> ("INT64", get_buff len) | [: `'n' :] -> ("NATIVEINT", get_buff len) | [: :] -> ("INT", get_buff len) ] and decimal_part len = parser [ [: `('0'..'9' as c); s :] -> decimal_part (store len c) s | [: `'_'; s :] -> decimal_part len s | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s | [: :] -> ("FLOAT", get_buff len) ] and exponent_part len = parser [ [: `('+' | '-' as c); s :] -> end_exponent_part (store len c) s | [: a = end_exponent_part len :] -> a ] and end_exponent_part len = parser [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s | [: :] -> raise (Stream.Error "ill-formed floating-point constant") ] and end_exponent_part_under len = parser [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s | [: `'_'; s :] -> end_exponent_part_under len s | [: :] -> ("FLOAT", get_buff len) ] ; value error_on_unknown_keywords = ref False; value err loc msg = raise_with_loc loc (Token.Error msg); (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) (***** Carl's alternative version then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; *****) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) (* Debugging positions and locations *) value eprint_pos msg p = Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d%!" msg p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum ; value eprint_loc (bp, ep) = do { eprint_pos "P1=" bp; eprint_pos " --P2=" ep } ; value check_location msg ((bp, ep) as loc) = let ok = if (bp.Lexing.pos_lnum > ep.Lexing.pos_lnum || bp.Lexing.pos_bol > ep.Lexing.pos_bol || bp.Lexing.pos_cnum > ep.Lexing.pos_cnum || bp.Lexing.pos_lnum < 0 || ep.Lexing.pos_lnum < 0 || bp.Lexing.pos_bol < 0 || ep.Lexing.pos_bol < 0 || bp.Lexing.pos_cnum < 0 || ep.Lexing.pos_cnum < 0) (* Here, we don't check bp.Lexing.pos_cnum < bp.Lexing.pos_bol || ep.Lexing.pos_cnum < bp.Lexing.pos_bol since the lexer is called on antiquotations, with cnum=0, but lnum and bolpos have "correct" values *) then do { Printf.eprintf "*** Warning: (%s) strange positions ***\n" msg; eprint_loc loc; False } else True in (ok, loc) ; value debug_token ((kind, tok), loc) = do { Printf.eprintf "%s(%s) at " kind tok; eprint_loc loc; Printf.eprintf "\n%!" }; value rec next_token_fun dfa ssd find_kwd fname lnum bolpos glexr = let make_pos p = {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val; Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in let mkloc (bp, ep) = (make_pos bp, make_pos ep) in let keyword_or_error (bp,ep) s = let loc = mkloc (bp, ep) in try (("", find_kwd s), loc) with [ Not_found -> if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) else (("", s), loc) ] in let error_if_keyword ( ((_,id) as a), bep) = let loc = mkloc bep in try do { ignore(find_kwd id); err loc ("illegal use of a keyword as a label: " ^ id) } with [ Not_found -> (a, loc) ] in let rec next_token after_space = parser bp [ [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; next_token True s } | [: `'\013'; s :] ep -> let ep = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; ep+1 } | _ -> ep ] in do { bolpos.val := ep; incr lnum; next_token True s } | [: `' ' | '\t' | '\026' | '\012'; s :] -> next_token True s | [: `'#' when bp = bolpos.val; s :] -> if linedir 1 s then do { line_directive s; next_token True s } else keyword_or_error (bp, bp + 1) "#" | [: `'('; s :] -> left_paren bp s | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = mkloc (bp, (Stream.count s)) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) ***********) | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> let id = get_buff (ident (store 0 c) s) in let loc = mkloc (bp, (Stream.count s)) in (jrh_identifier find_kwd id, loc) (********** original (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) **********) | [: `('1'..'9' as c); s :] -> let tok = number (store 0 c) s in let loc = mkloc (bp, (Stream.count s)) in (tok, loc) | [: `'0'; s :] -> let tok = base_number (store 0 '0') s in let loc = mkloc (bp, (Stream.count s)) in (tok, loc) | [: `'''; s :] -> match Stream.npeek 2 s with [ [_; '''] | ['\\'; _] -> let tok = ("CHAR", get_buff (char bp 0 s)) in let loc = mkloc (bp, (Stream.count s)) in (tok, loc) | _ -> keyword_or_error (bp, Stream.count s) "'" ] | [: `'"'; s :] -> let bpos = make_pos bp in let tok = ("STRING", get_buff (string bpos 0 s)) in let loc = mkloc (bp, Stream.count s) in (tok, loc) | [: `'`'; s :] -> let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in let loc = mkloc (bp, Stream.count s) in (tok, loc) | [: `'$'; s :] -> let bpos = make_pos bp in let tok = dollar bpos 0 s in let loc = (bpos, make_pos (Stream.count s)) in (tok, loc) | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id | [: `('~' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> let id = get_buff len in match s with parser [ [: `':' :] ep -> error_if_keyword (("LABEL", id), (bp, ep)) | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ] | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `('?' as c); a = parser [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> let id = get_buff len in match s with parser [ [: `':' :] ep -> error_if_keyword (("OPTLABEL", id), (bp,ep)) | [: :] -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep)) ] | [: s :] -> let id = get_buff (ident2 (store 0 c) s) in keyword_or_error (bp, Stream.count s) id ] :] -> a | [: `'<'; s :] -> less bp s | [: `(':' as c1); len = parser [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('>' | '|' as c1); len = parser [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id | [: `('[' | '{' as c1); s :] -> let len = match Stream.npeek 2 s with [ ['<'; '<' | ':'] -> store 0 c1 | _ -> match s with parser [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 | [: :] -> store 0 c1 ] ] in let ep = Stream.count s in let id = get_buff len in keyword_or_error (bp, ep) id | [: `'.'; id = parser [ [: `'.' :] -> ".." | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> keyword_or_error (bp, ep) id | [: `';'; id = parser [ [: `';' :] -> ";;" | [: :] -> ";" ] :] ep -> keyword_or_error (bp, ep) id | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), mkloc (bp, ep)) | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) | [: _ = Stream.empty :] -> (("EOI", ""), mkloc (bp, succ bp)) ] and less bp strm = if no_quotations.val then match strm with parser [ [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] else let bpos = make_pos bp in match strm with parser [ [: `'<'; len = quotation bpos 0 :] ep -> (("QUOTATION", ":" ^ get_buff len), (bpos, make_pos ep)) | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; `'<' ? "character '<' expected"; len = quotation bpos 0 :] ep -> (("QUOTATION", i ^ ":" ^ get_buff len), (bpos, make_pos ep)) | [: len = ident2 (store 0 '<') :] ep -> let id = get_buff len in keyword_or_error (bp, ep) id ] and qstring bp len = parser [ [: `'`' :] -> get_buff len | [: `c; s :] -> qstring bp (store len c) s | [: :] ep -> err (mkloc (bp, ep)) "quotation not terminated" ] and string bpos len = parser [ [: `'"' :] -> len | [: `'\\'; `c; s :] ep -> let len = store len '\\' in match c with [ '\010' -> do { bolpos.val := ep; incr lnum; string bpos (store len c) s } | '\013' -> let (len, ep) = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) } | _ -> (store len '\013', ep) ] in do { bolpos.val := ep; incr lnum; string bpos len s } | c -> string bpos (store len c) s ] | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; string bpos (store len '\010') s } | [: `'\013'; s :] ep -> let (len, ep) = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) } | _ -> (store len '\013', ep) ] in do { bolpos.val := ep; incr lnum; string bpos len s } | [: `c; s :] -> string bpos (store len c) s | [: :] ep -> err (bpos, make_pos ep) "string not terminated" ] and char bp len = parser [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s | [: `'\010'; s :] -> do {bolpos.val := bp+1; incr lnum; char bp (store len '\010') s} | [: `'\013'; s :] -> let bol = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; bp+2 } | _ -> bp+1 ] in do { bolpos.val := bol; incr lnum; char bp (store len '\013') s} | [: `c; s :] -> char bp (store len c) s | [: :] ep -> err (mkloc (bp, ep)) "char not terminated" ] and dollar bpos len s = if no_quotations.val then ("", get_buff (ident2 (store 0 '$') s)) else match s with parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bpos (store len c) s | [: `('0'..'9' as c); s :] -> maybe_locate bpos (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bpos 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) | [: s :] -> if dfa then match s with parser [ [: `c :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] else ("", get_buff (ident2 (store 0 '$') s)) ] and maybe_locate bpos len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('0'..'9' as c); s :] -> maybe_locate bpos (store len c) s | [: `':'; s :] -> ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bpos 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] and antiquot bpos len = parser [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> antiquot bpos (store len c) s | [: `':'; s :] -> let k = get_buff len in ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bpos 0 s) | [: `'\\'; `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) | [: `c; s :] -> ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] and locate_or_antiquot_rest bpos len = parser [ [: `'$' :] -> get_buff len | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bpos (store len c) s | [: `c; s :] -> locate_or_antiquot_rest bpos (store len c) s | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] and quotation bpos len = parser [ [: `'>'; s :] -> maybe_end_quotation bpos len s | [: `'<'; s :] -> quotation bpos (maybe_nested_quotation bpos (store len '<') s) s | [: `'\\'; len = parser [ [: `('>' | '<' | '\\' as c) :] -> store len c | [: :] -> store len '\\' ]; s :] -> quotation bpos len s | [: `'\010'; s :] ep -> do {bolpos.val := ep; incr lnum; quotation bpos (store len '\010') s} | [: `'\013'; s :] ep -> let bol = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; ep+1 } | _ -> ep ] in do { bolpos.val := bol; incr lnum; quotation bpos (store len '\013') s} | [: `c; s :] -> quotation bpos (store len c) s | [: :] ep -> err (bpos, make_pos ep) "quotation not terminated" ] and maybe_nested_quotation bpos len = parser [ [: `'<'; s :] -> mstore (quotation bpos (store len '<') s) ">>" | [: `':'; len = ident (store len ':'); a = parser [ [: `'<'; s :] -> mstore (quotation bpos (store len '<') s) ">>" | [: :] -> len ] :] -> a | [: :] -> len ] and maybe_end_quotation bpos len = parser [ [: `'>' :] -> len | [: a = quotation bpos (store len '>') :] -> a ] and left_paren bp = parser [ [: `'*'; _ = comment (make_pos bp); a = next_token True :] -> a | [: :] ep -> keyword_or_error (bp, ep) "(" ] and comment bpos = parser [ [: `'('; s :] -> left_paren_in_comment bpos s | [: `'*'; s :] -> star_in_comment bpos s | [: `'"'; _ = string bpos 0; s :] -> comment bpos s | [: `'''; s :] -> quote_in_comment bpos s | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; comment bpos s } | [: `'\013'; s :] ep -> let ep = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; ep+1 } | _ -> ep ] in do { bolpos.val := ep; incr lnum; comment bpos s } | [: `c; s :] -> comment bpos s | [: :] ep -> err (bpos, make_pos ep) "comment not terminated" ] and quote_in_comment bpos = parser [ [: `'''; s :] -> comment bpos s | [: `'\\'; s :] -> quote_antislash_in_comment bpos 0 s | [: s :] ep -> do { match Stream.npeek 2 s with [ [ ( '\013' | '\010' ); '''] -> do { bolpos.val := ep; incr lnum; Stream.junk s; Stream.junk s } | [ '\013'; '\010' ] -> match Stream.npeek 3 s with [ [_; _; '''] -> do { bolpos.val := ep + 1; incr lnum; Stream.junk s; Stream.junk s; Stream.junk s } | _ -> () ] | [_; '''] -> do { Stream.junk s; Stream.junk s } | _ -> () ]; comment bpos s } ] and quote_any_in_comment bp = parser [ [: `'''; s :] -> comment bp s | [: a = comment bp :] -> a ] and quote_antislash_in_comment bp len = parser [ [: `'''; s :] -> comment bp s | [: `'\\' | '"' | 'n' | 't' | 'b' | 'r'; s :] -> quote_any_in_comment bp s | [: `'0'..'9'; s :] -> quote_antislash_digit_in_comment bp s | [: a = comment bp :] -> a ] and quote_antislash_digit_in_comment bp = parser [ [: `'0'..'9'; s :] -> quote_antislash_digit2_in_comment bp s | [: a = comment bp :] -> a ] and quote_antislash_digit2_in_comment bp = parser [ [: `'0'..'9'; s :] -> quote_any_in_comment bp s | [: a = comment bp :] -> a ] and left_paren_in_comment bpos = parser [ [: `'*'; s :] -> do { comment bpos s; comment bpos s } | [: a = comment bpos :] -> a ] and star_in_comment bpos = parser [ [: `')' :] -> () | [: a = comment bpos :] -> a ] and linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> True | _ -> False ] and any_to_nl = parser [ [: `'\010'; _s :] ep -> do { bolpos.val := ep; incr lnum } | [: `'\013'; s :] ep -> let ep = match Stream.peek s with [ Some '\010' -> do { Stream.junk s; ep+1 } | _ -> ep ] in do { bolpos.val := ep; incr lnum } | [: `_; s :] -> any_to_nl s | [: :] -> () ] and line_directive = parser (* we are sure that there is a line directive here *) [ [: _ = skip_spaces; n = line_directive_number 0; _ = skip_spaces; _ = line_directive_string; _ = any_to_nl :] ep -> do { (* fname has been updated by by line_directive_string *) bolpos.val := ep; lnum.val := n } ] and skip_spaces = parser [ [: `' ' | '\t'; s :] -> skip_spaces s | [: :] -> () ] and line_directive_number n = parser [ [: `('0'..'9' as c) ; s :] -> line_directive_number (10*n + (Char.code c - Char.code '0')) s | [: :] -> n ] and line_directive_string = parser [ [: ` '"' ; _ = line_directive_string_contents 0 :] -> () | [: :] -> () ] and line_directive_string_contents len = parser [ [: ` '\010' | '\013' :] -> () | [: ` '"' :] -> fname.val := get_buff len | [: `c; s :] -> line_directive_string_contents (store len c) s ] in fun cstrm -> try let glex = glexr.val in let comm_bp = Stream.count cstrm in let r = next_token False cstrm in do { match glex.tok_comm with [ Some list -> let next_bp = (fst (snd r)).Lexing.pos_cnum in if next_bp > comm_bp then let comm_loc = mkloc (comm_bp, next_bp) in glex.tok_comm := Some [comm_loc :: list] else () | None -> () ]; (* debug_token r; *) r } with [ Stream.Error str -> err (mkloc (Stream.count cstrm, Stream.count cstrm + 1)) str ] ; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value func kwd_table glexr = let bolpos = ref 0 in let lnum = ref 1 in let fname = ref "" in let find = Hashtbl.find kwd_table in let dfa = dollar_for_antiquotation.val in let ssd = specific_space_dot.val in (Token.lexer_func_of_parser (next_token_fun dfa ssd find fname lnum bolpos glexr), (bolpos, lnum, fname)) ; value rec check_keyword_stream = parser [: _ = check; _ = Stream.empty :] -> True and check = parser [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' ; s :] -> check_ident s | [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ; s :] -> check_ident2 s | [: `'<'; s :] -> match Stream.npeek 1 s with [ [':' | '<'] -> () | _ -> check_ident2 s ] | [: `':'; _ = parser [ [: `']' | ':' | '=' | '>' :] -> () | [: :] -> () ] :] -> () | [: `'>' | '|'; _ = parser [ [: `']' | '}' :] -> () | [: a = check_ident2 :] -> a ] :] -> () | [: `'[' | '{'; s :] -> match Stream.npeek 2 s with [ ['<'; '<' | ':'] -> () | _ -> match s with parser [ [: `'|' | '<' | ':' :] -> () | [: :] -> () ] ] | [: `';'; _ = parser [ [: `';' :] -> () | [: :] -> () ] :] -> () | [: `_ :] -> () ] and check_ident = parser [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' | '0'..'9' | '_' | ''' ; s :] -> check_ident s | [: :] -> () ] and check_ident2 = parser [ [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' ; s :] -> check_ident2 s | [: :] -> () ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Token.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Token.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (Hashtbl.mem kwd_table p_prm) then if check_keyword p_prm then if Hashtbl.mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "INT" | "INT32" | "INT64" | "NATIVEINT" | "FLOAT" | "CHAR" | "STRING" | "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL" | "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" -> () | _ -> raise (Token.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT32", "") -> "32 bits integer" | ("INT64", "") -> "64 bits integer" | ("NATIVEINT", "") -> "native integer" | (("INT" | "INT32" | "NATIVEINT"), s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("LOCATE", "") -> "locate" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Token.default_match tok ] ; value make_lexer () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let (f,pos) = func kwd_table glexr in let glex = {tok_func = f; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; (glex, pos) } ; value gmake () = let (p,_) = make_lexer () in p ; value tparse = fun [ ("ANTIQUOT", p_prm) -> let p = parser [: `("ANTIQUOT", prm) when eq_before_colon p_prm prm :] -> after_colon prm in Some p | _ -> None ] ; value make () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in {func = fst(func kwd_table glexr); using = using_token kwd_table id_table; removing = removing_token kwd_table id_table; tparse = tparse; text = text} ; (* ------------------------------------------------------------------------- *) (* Resume the main file. *) (* ------------------------------------------------------------------------- *) do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; let (lexer, pos) = make_lexer () in Pcaml.position.val := pos; Grammar.Unsafe.gram_reinit gram lexer; dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_declaration; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value o2b = fun [ Some _ -> True | None -> False ] ; value mkexprident _loc ids = match ids with [ [] -> Stdpp.raise_with_loc _loc (Stream.Error "illegal long identifier") | [ id :: ids ] -> let rec loop m = fun [ [ id :: ids ] -> loop <:expr< $m$ . $id$ >> ids | [] -> m ] in loop id ids ] ; value mkumin _loc f arg = match (f, arg) with [ ("-", <:expr< $int:n$ >>) when int_of_string n > 0 -> let n = "-" ^ n in <:expr< $int:n$ >> | ("-", MLast.ExInt32 loc n) when (Int32.of_string n) > 0l -> MLast.ExInt32 loc ("-" ^ n) | ("-", MLast.ExInt64 loc n) when (Int64.of_string n) > 0L -> MLast.ExInt64 loc ("-" ^ n) | ("-", MLast.ExNativeInt loc n) when (Nativeint.of_string n) > 0n -> MLast.ExNativeInt loc ("-" ^ n) | (_, <:expr< $flo:n$ >>) when float_of_string n > 0.0 -> let n = "-" ^ n in <:expr< $flo:n$ >> | _ -> let f = "~" ^ f in <:expr< $lid:f$ $arg$ >> ] ; value mklistexp _loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let _loc = if top then _loc else (fst (MLast.loc_of_expr e1), snd _loc) in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat _loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let _loc = if top then _loc else (fst (MLast.loc_of_patt p1), snd _loc) in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = let ct = Hashtbl.create 73 in do { List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] } ; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; (*** And JRH inserted it in here ***) value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value lident_colon = Grammar.Entry.of_parser gram "lident_colon" (fun strm -> match Stream.npeek 2 strm with [ [("LIDENT", i); ("", ":")] -> do { Stream.junk strm; Stream.junk strm; i } | _ -> raise Stream.Failure ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in let rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False in loop ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity _loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity _loc e | <:expr< $e$ $_$ >> -> if is_expr_constr_call e then Stdpp.raise_with_loc _loc (Stream.Error "currified constructor") else 1 | _ -> 1 ] ; value rec is_patt_constr_call = fun [ <:patt< $uid:_$ >> -> True | <:patt< $uid:_$.$p$ >> -> is_patt_constr_call p | <:patt< $p$ $_$ >> -> is_patt_constr_call p | _ -> False ] ; value rec constr_patt_arity _loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity _loc p | <:patt< $p$ $_$ >> -> if is_patt_constr_call p then Stdpp.raise_with_loc _loc (Stream.Error "currified constructor") else 1 | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if List.mem_assoc s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if List.mem_assoc v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; value rec patt_lid = fun [ <:patt< $p1$ $p2$ >> -> match p1 with [ <:patt< $lid:i$ >> -> Some (MLast.loc_of_patt p1, i, [p2]) | _ -> match patt_lid p1 with [ Some (loc, i, pl) -> Some (loc, i, [p2 :: pl]) | None -> None ] ] | _ -> None ] ; value bigarray_get _loc arr arg = let coords = match arg with [ <:expr< ($list:el$) >> -> el | _ -> [arg] ] in match coords with [ [c1] -> <:expr< Bigarray.Array1.get $arr$ $c1$ >> | [c1; c2] -> <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> | [c1; c2; c3] -> <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> ] ; value bigarray_set _loc var newval = match var with [ <:expr< Bigarray.Array1.get $arr$ $c1$ >> -> Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >> | <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> -> Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >> | <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> -> Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >> | <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> -> Some <:expr< Bigarray.Genarray.set $arr$ [| $list:coords$ |] $newval$ >> | _ -> None ] ; (* ...works bad... value rec sync cs = match cs with parser [ [: `';' :] -> sync_semi cs | [: `_ :] -> sync cs ] and sync_semi cs = match cs with parser [ [: `';' :] -> sync_semisemi cs | [: :] -> sync cs ] and sync_semisemi cs = match Stream.peek cs with [ Some ('\010' | '\013') -> () | _ -> sync_semi cs ] ; Pcaml.sync.val := sync; *) EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type class_expr class_sig_item class_str_item let_binding type_declaration; module_expr: [ [ "functor"; "("; i = UIDENT; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> | "struct"; st = LIST0 [ s = str_item; OPT ";;" -> s ]; "end" -> <:module_expr< struct $list:st$ end >> ] | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = UIDENT -> <:module_expr< $uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> <:str_item< exception $c$ of $list:tl$ = $b$ >> | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:str_item< external $i$ : $t$ = $list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:str_item< external $i$ : $t$ = $list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; i = UIDENT; mb = module_binding -> <:str_item< module $i$ = $mb$ >> | "module"; "rec"; nmtmes = LIST1 module_rec_binding SEP "and" -> MLast.StRecMod _loc nmtmes | "module"; "type"; i = UIDENT; "="; mt = module_type -> <:str_item< module type $i$ = $mt$ >> | "open"; i = mod_ident -> <:str_item< open $i$ >> | "type"; tdl = LIST1 type_declaration SEP "and" -> <:str_item< type $list:tdl$ >> | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; x = expr -> let e = <:expr< let $opt:o2b r$ $list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and" -> match l with [ [(<:patt< _ >>, e)] -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $opt:o2b r$ $list:l$ >> ] | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr -> <:str_item< let module $m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = mod_ident -> sl | -> [] ] ] ; module_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; module_rec_binding: [ [ m = UIDENT; ":"; mt = module_type; "="; me = module_expr -> (m, mt, me) ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = LIST1 with_constr SEP "and" -> <:module_type< $mt$ with $list:wcl$ >> ] | [ "sig"; sg = LIST0 [ s = sig_item; OPT ";;" -> s ]; "end" -> <:module_type< sig $list:sg$ end >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = UIDENT -> <:module_type< $uid:m$ >> | m = LIDENT -> <:module_type< $lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration -> <:sig_item< exception $c$ of $list:tl$ >> | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:sig_item< external $i$ : $t$ = $list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = LIST1 STRING -> <:sig_item< external $i$ : $t$ = $list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; i = UIDENT; mt = module_declaration -> <:sig_item< module $i$ : $mt$ >> | "module"; "rec"; mds = LIST1 module_rec_declaration SEP "and" -> MLast.SgRecMod _loc mds | "module"; "type"; i = UIDENT; "="; mt = module_type -> <:sig_item< module type $i$ = $mt$ >> | "module"; "type"; i = UIDENT -> <:sig_item< module type $i$ = 'abstract >> | "open"; i = mod_ident -> <:sig_item< open $i$ >> | "type"; tdl = LIST1 type_declaration SEP "and" -> <:sig_item< type $list:tdl$ >> | "val"; i = LIDENT; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ] ; module_rec_declaration: [ [ m = UIDENT; ":"; mt = module_type -> (m, mt)] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = type_parameters; i = mod_ident; "="; t = ctyp -> MLast.WcTyp _loc i tpl t | "module"; i = mod_ident; "="; me = module_expr -> MLast.WcMod _loc i me ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 ] | "expr1" [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; x = expr LEVEL "top" -> <:expr< let $opt:o2b o$ $list:l$ in $x$ >> | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< fun [ $list:l$ ] >> | "fun"; p = patt LEVEL "simple"; e = fun_def -> <:expr< fun [$p$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< match $e$ with [ $list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> <:expr< try $e$ with [ $list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = LIDENT; "="; e1 = SELF; df = direction_flag; e2 = SELF; "do"; e = SELF; "done" -> <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >> | "while"; e1 = SELF; "do"; e2 = SELF; "done" -> <:expr< while $e1$ do { $list:get_seq e2$ } >> | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> (* <:expr< object $opt:cspo$ $list:cf$ end >> *) MLast.ExObj _loc cspo cf ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> match bigarray_set _loc e1 e2 with [ Some e -> e | None -> <:expr< $e1$ := $e2$ >> ] ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; "$"; e2 = SELF -> <:expr< $lid:"\$"$ $e1$ $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< $mkumin _loc "-" e$ >> | "-."; e = SELF -> <:expr< $mkumin _loc "-." e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> match constr_expr_arity _loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> match e with [ <:expr< False >> -> <:expr< assert False >> | _ -> <:expr< assert ($e$) >> ] | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e1 = SELF; "."; "{"; e2 = SELF; "}" -> bigarray_get _loc e1 e2 | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val>> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = INT -> <:expr< $int:s$ >> | s = INT32 -> MLast.ExInt32 _loc s | s = INT64 -> MLast.ExInt64 _loc s | s = NATIVEINT -> MLast.ExNativeInt _loc s | s = FLOAT -> <:expr< $flo:s$ >> | s = STRING -> <:expr< $str:s$ >> | c = CHAR -> <:expr< $chr:c$ >> | UIDENT "True" -> <:expr< $uid:" True"$ >> | UIDENT "False" -> <:expr< $uid:" False"$ >> | ids = expr_ident -> mkexprident _loc ids | s = "false" -> <:expr< False >> | s = "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp _loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = expr1_semi_list; "|]" -> <:expr< [| $list:el$ |] >> | "{"; test_label_eq; lel = lbl_expr_list; "}" -> <:expr< { $list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = lbl_expr_list; "}" -> <:expr< { ($e$) with $list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> <:expr< $e$ >> | "begin"; e = SELF; "end" -> <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = LOCATE -> let x = try let i = String.index x ':' in ({Lexing.pos_fname = ""; Lexing.pos_lnum = 0; Lexing.pos_bol = 0; Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found | Failure _ -> (Token.nowhere, x) ] in Pcaml.handle_expr_locate _loc x | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_expr_quotation _loc x ] ] ; let_binding: [ [ p = patt; e = fun_binding -> match patt_lid p with [ Some (_loc, i, pl) -> let e = List.fold_left (fun e p -> <:expr< fun $p$ -> $e$ >>) e pl in (<:patt< $lid:i$ >>, e) | None -> (p, e) ] ] ] ; fun_binding: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; match_case: [ [ x1 = patt; w = OPT [ "when"; e = expr -> e ]; "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] | e = expr LEVEL "expr1"; ";" -> [e] | e = expr LEVEL "expr1" -> [e] ] ] ; fun_def: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "->"; e = expr -> <:expr< $e$ >> ] ] ; expr_ident: [ RIGHTA [ i = LIDENT -> [ <:expr< $lid:i$ >> ] | i = UIDENT -> [ <:expr< $uid:i$ >> ] | i = UIDENT; "."; "("; j = operator_rparen -> [ <:expr< $uid:i$ >> ; <:expr< $lid:j$ >> ] | i = UIDENT; "."; j = SELF -> [ <:expr< $uid:i$ >> :: j ] ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> match constr_patt_arity _loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ s = LIDENT -> <:patt< $lid:s$ >> | s = UIDENT -> <:patt< $uid:s$ >> | s = INT -> <:patt< $int:s$ >> | s = INT32 -> MLast.PaInt32 _loc s | s = INT64 -> MLast.PaInt64 _loc s | s = NATIVEINT -> MLast.PaNativeInt _loc s | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = INT32 -> MLast.PaInt32 _loc ("-" ^ s) | "-"; s = INT64 -> MLast.PaInt64 _loc ("-" ^ s) | "-"; s = NATIVEINT -> MLast.PaNativeInt _loc ("-" ^ s) | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = FLOAT -> <:patt< $flo:s$ >> | s = STRING -> <:patt< $str:s$ >> | s = CHAR -> <:patt< $chr:s$ >> | UIDENT "True" -> <:patt< $uid:" True"$ >> | UIDENT "False" -> <:patt< $uid:" False"$ >> | s = "false" -> <:patt< False >> | s = "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat _loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = patt_semi_list; "|]" -> <:patt< [| $list:pl$ |] >> | "{"; lpl = lbl_patt_list; "}" -> <:patt< { $list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = patt; ")" -> <:patt< $p$ >> | "_" -> <:patt< _ >> | "`"; s = ident -> <:patt< ` $s$ >> | "#"; t = mod_ident -> <:patt< # $list:t$ >> | x = LOCATE -> let x = try let i = String.index x ':' in ({Lexing.pos_fname = ""; Lexing.pos_lnum = 0; Lexing.pos_bol = 0; Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found | Failure _ -> (Token.nowhere, x) ] in Pcaml.handle_patt_locate _loc x | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_patt_quotation _loc x ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_declaration: [ [ tpl = type_parameters; n = type_patt; "="; tk = type_kind; cl = LIST0 constrain -> (n, tpl, tk, cl) | tpl = type_parameters; n = type_patt; cl = LIST0 constrain -> (n, tpl, <:ctyp< '$choose_tvar tpl$ >>, cl) ] ] ; type_patt: [ [ n = LIDENT -> (_loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ "private"; tk = type_kind -> <:ctyp< private $tk$ >> | test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; "private"; tk = type_kind -> <:ctyp< $t$ == private $tk$ >> | t = ctyp; "="; "{"; ldl = label_declarations; "}" -> <:ctyp< $t$ == { $list:ldl$ } >> | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == [ $list:cdl$ ] >> | "{"; ldl = label_declarations; "}" -> <:ctyp< { $list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "'"; i = ident -> (i, (False, False)) | "+"; "'"; i = ident -> (i, (True, False)) | "-"; "'"; i = ident -> (i, (False, True)) ] ] ; constructor_declaration: [ [ ci = UIDENT; "of"; cal = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> (_loc, ci, cal) | ci = UIDENT -> (_loc, ci, []) ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (_loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (_loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "ctyp1") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "ctyp1" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = ident -> <:ctyp< '$i$ >> | "_" -> <:ctyp< _ >> | i = LIDENT -> <:ctyp< $lid:i$ >> | i = UIDENT -> <:ctyp< $uid:i$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = LIST1 class_declaration SEP "and" -> <:str_item< class $list:cd$ >> | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> <:str_item< class type $list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = LIST1 class_description SEP "and" -> <:sig_item< class $list:cd$ >> | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> <:sig_item< class type $list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = OPT "virtual"; ctp = class_type_parameters; i = LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = _loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = patt LEVEL "simple"; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (_loc, []) | "["; tpl = LIST1 type_parameter SEP ","; "]" -> (_loc, tpl) ] ] ; class_fun_def: [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = patt LEVEL "simple"; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = OPT "rec"; lb = LIST1 let_binding SEP "and"; "in"; ce = SELF -> <:class_expr< let $opt:o2b rf$ $list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $ct$ ] >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> <:class_expr< object $opt:cspo$ $list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> <:class_str_item< inherit $ce$ $opt:pb$ >> | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; l = label; ":"; t = poly_type -> <:class_str_item< method virtual $l$ : $t$ >> | "method"; "private"; l = label; ":"; t = poly_type; "="; e = expr -> MLast.CrMth _loc l True e (Some t) | "method"; "private"; l = label; sb = fun_binding -> MLast.CrMth _loc l True sb None | "method"; l = label; ":"; t = poly_type; "="; e = expr -> MLast.CrMth _loc l False e (Some t) | "method"; l = label; sb = fun_binding -> MLast.CrMth _loc l False sb None | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> <:class_type< $list:id$ [ $list:tl$ ] >> | id = clty_longident -> <:class_type< $list:id$ >> | "object"; cst = OPT class_self_type; csf = LIST0 class_sig_item; "end" -> <:class_type< object $opt:cst$ $list:csf$ end >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual private $l$ : $t$ >> | "method"; "virtual"; l = label; ":"; t = poly_type -> <:class_sig_item< method virtual $l$ : $t$ >> | "method"; "private"; l = label; ":"; t = poly_type -> <:class_sig_item< method private $l$ : $t$ >> | "method"; l = label; ":"; t = poly_type -> <:class_sig_item< method $l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; ":"; ct = class_type -> {MLast.ciLoc = _loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; "="; cs = class_signature -> {MLast.ciLoc = _loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = class_longident -> <:expr< new $list:i$ >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = field_expr_list; ">}" -> <:expr< {< $list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >> | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v) | f = field; ";" -> ([f], False) | f = field -> ([f], False) | ".." -> ([], True) ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) clty_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: LEVEL "arrow" [ RIGHTA [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >> | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ = $list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ > $list:rfl$ ] >> | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> <:ctyp< [ < $list:rfl$ ] >> | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; ">"; ntl = LIST1 name_tag; "]" -> <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ] ; row_field: [ [ "`"; i = ident -> MLast.RfTag i True [] | "`"; i = ident; "of"; ao = OPT "&"; l = LIST1 ctyp SEP "&" -> MLast.RfTag i (o2b ao) l | t = ctyp -> MLast.RfInh t ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] ; expr: AFTER "apply" [ "label" [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >> | i = TILDEIDENT -> <:expr< ~ $i$ >> | "~"; i = LIDENT -> <:expr< ~ $i$ >> | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >> | i = QUESTIONIDENT -> <:expr< ? $i$ >> | "?"; i = LIDENT -> <:expr< ? $i$ >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ] ; fun_def: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; labeled_patt: [ [ i = LABEL; p = patt LEVEL "simple" -> <:patt< ~ $i$ : $p$ >> | i = TILDEIDENT -> <:patt< ~ $i$ >> | "~"; i=LIDENT -> <:patt< ~ $i$ >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~ $i$ >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~ $i$ : ($lid:i$ : $t$) >> | i = OPTLABEL; j = LIDENT -> <:patt< ? $i$ : ($lid:j$) >> | i = OPTLABEL; "("; p = patt; "="; e = expr; ")" -> <:patt< ? $i$ : ( $p$ = $e$ ) >> | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ? $i$ : ( $p$ : $t$ ) >> | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >> | i = QUESTIONIDENT -> <:patt< ? $i$ >> | "?"; i = LIDENT -> <:patt< ? $i$ >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ = $e$ ) >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> | "?"; "("; i = LIDENT; ")" -> <:patt< ? $i$ >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ? ( $lid:i$ : $t$ ) >> ] ] ; class_type: [ [ i = lident_colon; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> | i = OPTLABEL; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> | "?"; i = LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $n$ $opt:dp$ >>, _loc)], True) | EOI -> ([], False) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, _loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $n$ $opt:dp$ >>, _loc)], True) | EOI -> ([], False) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, _loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pa_j_3.1x_5.xx.ml000066400000000000000000002070131303454263000156460ustar00rootroot00000000000000(* camlp5r pa_extend.cmo q_MLast.cmo *) (* $Id: pa_o.ml 1271 2007-10-01 08:22:47Z deraugla $ *) (* Copyright (c) INRIA 2007 *) open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* camlp5r pa_lexer.cmo *) (* $Id: plexer.ml 1402 2007-10-14 02:50:31Z deraugla $ *) (* Copyright (c) INRIA 2007 *) (* ------------------------------------------------------------------------- *) (* Added by JRH as a backdoor to change lexical conventions. *) (* ------------------------------------------------------------------------- *) value jrh_lexer = ref False; value no_quotations = ref False; value error_on_unknown_keywords = ref False; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value force_antiquot_loc = ref False; (* The string buffering machinery *) value rev_implode l = let s = String.create (List.length l) in loop (String.length s - 1) l where rec loop i = fun [ [c :: l] -> do { String.unsafe_set s i c; loop (i - 1) l } | [] -> s ] ; (* The lexer *) type context = { after_space : mutable bool; dollar_for_antiquotation : bool; specific_space_dot : bool; find_kwd : string -> string; line_cnt : int -> char -> unit; set_line_nb : unit -> unit; make_lined_loc : (int * int) -> string -> Ploc.t } ; value err ctx loc msg = Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) ; (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) (***** JRH: Carl's alternative version then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; *****) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) value keyword_or_error ctx loc s = try ("", ctx.find_kwd s) with [ Not_found -> if error_on_unknown_keywords.val then err ctx loc ("illegal token: " ^ s) else ("", s) ] ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value rec ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | '\128'-'\255' ] ident! | ] ; value rec ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' ] ident2! | ] ; value rec ident3 = lexer [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' | '\128'-'\255' ] ident3! | ] ; value binary = lexer [ '0' | '1' ]; value octal = lexer [ '0'-'7' ]; value decimal = lexer [ '0'-'9' ]; value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; value end_integer = lexer [ "l"/ -> ("INT_l", $buf) | "L"/ -> ("INT_L", $buf) | "n"/ -> ("INT_n", $buf) | -> ("INT", $buf) ] ; value rec digits_under kind = lexer [ kind (digits_under kind)! | "_" (digits_under kind)! | end_integer ] ; value digits kind = lexer [ kind (digits_under kind)! | -> raise (Stream.Error "ill-formed integer constant") ] ; value rec decimal_digits_under = lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] ; value exponent_part = lexer [ [ 'e' | 'E' ] [ '+' | '-' | ] '0'-'9' ? "ill-formed floating-point constant" decimal_digits_under! ] ; value number = lexer [ decimal_digits_under "." decimal_digits_under! exponent_part -> ("FLOAT", $buf) | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) | decimal_digits_under exponent_part -> ("FLOAT", $buf) | decimal_digits_under end_integer! ] ; value rec char_aux ctx bp = lexer [ "'"/ | _ (char_aux ctx bp)! | -> err ctx (bp, $pos) "char not terminated" ] ; value char ctx bp = lexer [ "\\" _ (char_aux ctx bp)! | "\\" -> err ctx (bp, $pos) "char not terminated" | ?= [ _ '''] _! "'"/ ] ; value any ctx buf = parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } ; value rec string ctx bp = lexer [ "\""/ | "\\" (any ctx) (string ctx bp)! | (any ctx) (string ctx bp)! | -> err ctx (bp, $pos) "string not terminated" ] ; value rec qstring ctx bp = lexer [ "`"/ | (any ctx) (qstring ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value comment ctx bp = comment where rec comment = lexer [ "*)" | "*" comment! | "(*" comment! comment! | "(" comment! | "\"" (string ctx bp)! [ -> $add "\"" ] comment! | "'" (char ctx bp) comment! | "'" comment! | (any ctx) comment! | -> err ctx (bp, $pos) "comment not terminated" ] ; value rec quotation ctx bp = lexer [ ">>"/ | ">" (quotation ctx bp)! | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! (quotation ctx bp)! | "<" (quotation ctx bp)! | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! | "\\" (quotation ctx bp)! | (any ctx) (quotation ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value less ctx bp buf strm = if no_quotations.val then match strm with lexer [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] else match strm with lexer [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) | ":"/ ident! [ -> $add ":" ]! "<"/ ? "character '<' expected" (quotation ctx bp) -> ("QUOTATION", $buf) | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value rec antiquot_rest ctx bp = lexer [ "$"/ | "\\"/ (any ctx) (antiquot_rest ctx bp)! | (any ctx) (antiquot_rest ctx bp)! | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value rec antiquot ctx bp = lexer [ "$"/ -> ":" ^ $buf | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '_' ] (antiquot ctx bp)! | ":" (antiquot_rest ctx bp)! -> $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; value rec antiquot_loc ctx bp = lexer [ "$"/ -> antiloc bp $pos (":" ^ $buf) | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '_' ] (antiquot_loc ctx bp)! | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value dollar ctx bp buf strm = if ctx.dollar_for_antiquotation then ("ANTIQUOT", antiquot ctx bp buf strm) else if force_antiquot_loc.val then ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) else match strm with lexer [ [ -> $add "$" ] ident2! -> ("", $buf) ] ; (* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?abc:d ?abc ?$abc:d$: ?abc:d: ?abc: ?$d$ ?:d ? ?$d$: ?:d: ?: *) (* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?8,13:abc:d ?abc ?$abc:d$: ?8,13:abc:d: ?abc: ?$d$ ?8,9::d ? ?$d$: ?8,9::d: ?: *) value question ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "?" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "?" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tilde ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "~" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "~" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tildeident = lexer [ ":"/ -> ("TILDEIDENTCOLON", $buf) | -> ("TILDEIDENT", $buf) ] ; value questionident = lexer [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) | -> ("QUESTIONIDENT", $buf) ] ; value rec linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> False ] and linedir_digits n s = match stream_peek_nth n s with [ Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> linedir_quote n s ] and linedir_quote n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir_quote (n + 1) s | Some '"' -> True | _ -> False ] ; value rec any_to_nl = lexer [ "\r" | "\n" | _ any_to_nl! | ] ; value next_token_after_spaces ctx bp = lexer [ 'A'-'Z' ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] *********) | [ 'a'-'z' | '_' | '\128'-'\255' ] ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! | "0" [ 'b' | 'B' ] (digits binary)! | "0" number! | "'"/ (char ctx bp) -> ("CHAR", $buf) | "'" -> keyword_or_error ctx (bp, $pos) "'" | "\""/ (string ctx bp)! -> ("STRING", $buf) (*** Line added by JRH ***) | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) | "$"/ (dollar ctx bp)! | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> keyword_or_error ctx (bp, $pos) $buf | "~"/ 'a'-'z' ident! tildeident! | "~" (tilde ctx bp) | "?"/ 'a'-'z' ident! questionident! | "?" (question ctx bp)! | "<"/ (less ctx bp)! | ":]" -> keyword_or_error ctx (bp, $pos) $buf | "::" -> keyword_or_error ctx (bp, $pos) $buf | ":=" -> keyword_or_error ctx (bp, $pos) $buf | ":>" -> keyword_or_error ctx (bp, $pos) $buf | ":" -> keyword_or_error ctx (bp, $pos) $buf | ">]" -> keyword_or_error ctx (bp, $pos) $buf | ">}" -> keyword_or_error ctx (bp, $pos) $buf | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "|]" -> keyword_or_error ctx (bp, $pos) $buf | "|}" -> keyword_or_error ctx (bp, $pos) $buf | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "[|" -> keyword_or_error ctx (bp, $pos) $buf | "[<" -> keyword_or_error ctx (bp, $pos) $buf | "[:" -> keyword_or_error ctx (bp, $pos) $buf | "[" -> keyword_or_error ctx (bp, $pos) $buf | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "{|" -> keyword_or_error ctx (bp, $pos) $buf | "{<" -> keyword_or_error ctx (bp, $pos) $buf | "{:" -> keyword_or_error ctx (bp, $pos) $buf | "{" -> keyword_or_error ctx (bp, $pos) $buf | ".." -> keyword_or_error ctx (bp, $pos) ".." | "." -> let id = if ctx.specific_space_dot && ctx.after_space then " ." else "." in keyword_or_error ctx (bp, $pos) id | ";;" -> keyword_or_error ctx (bp, $pos) ";;" | ";" -> keyword_or_error ctx (bp, $pos) ";" | "\\"/ ident3! -> ("LIDENT", $buf) | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] ; value rec next_token ctx buf = parser bp [ [: `('\n' | '\r' as c); s :] ep -> do { incr Plexing.line_nb.val; Plexing.bol_pos.val.val := ep; ctx.set_line_nb (); ctx.after_space := True; next_token ctx ($add c) s } | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { ctx.after_space := True; next_token ctx ($add c) s } | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> if linedir 1 s then do { let buf = any_to_nl ($add '#') s in incr Plexing.line_nb.val; Plexing.bol_pos.val.val := Stream.count s; ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } else let loc = ctx.make_lined_loc (bp, bp + 1) $buf in (keyword_or_error ctx (bp, bp + 1) "#", loc) | [: `'('; a = parser [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } | [: :] ep -> let loc = ctx.make_lined_loc (bp, ep) $buf in (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a | [: tok = next_token_after_spaces ctx bp $empty :] ep -> let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) $buf in (tok, loc) | [: _ = Stream.empty :] -> let loc = ctx.make_lined_loc (bp, bp + 1) $buf in (("EOI", ""), loc) ] ; value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = try do { match Plexing.restore_lexing_info.val with [ Some (line_nb, bol_pos) -> do { s_line_nb.val := line_nb; s_bol_pos.val := bol_pos; Plexing.restore_lexing_info.val := None } | None -> () ]; Plexing.line_nb.val := s_line_nb; Plexing.bol_pos.val := s_bol_pos; let comm_bp = Stream.count cstrm in ctx.set_line_nb (); ctx.after_space := False; let (r, loc) = next_token ctx $empty cstrm in match glexr.val.Plexing.tok_comm with [ Some list -> if Ploc.first_pos loc > comm_bp then let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in glexr.val.Plexing.tok_comm := Some [comm_loc :: list] else () | None -> () ]; (r, loc) } with [ Stream.Error str -> err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] ; value func kwd_table glexr = let ctx = let line_nb = ref 0 in let bol_pos = ref 0 in {after_space = False; dollar_for_antiquotation = dollar_for_antiquotation.val; specific_space_dot = specific_space_dot.val; find_kwd = Hashtbl.find kwd_table; line_cnt bp1 c = match c with [ '\n' | '\r' -> do { incr Plexing.line_nb.val; Plexing.bol_pos.val.val := bp1 + 1; } | c -> () ]; set_line_nb () = do { line_nb.val := Plexing.line_nb.val.val; bol_pos.val := Plexing.bol_pos.val.val; }; make_lined_loc loc comm = Ploc.make line_nb.val bol_pos.val loc} in Plexing.lexer_func_of_parser (next_token_fun ctx glexr) ; value rec check_keyword_stream = parser [: _ = check $empty; _ = Stream.empty :] -> True and check = lexer [ [ 'A'-'Z' | 'a'-'z' | '\128'-'\255' ] check_ident! | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ] check_ident2! | "$" check_ident2! | "<" ?= [ ":" | "<" ] | "<" check_ident2! | ":]" | "::" | ":=" | ":>" | ":" | ">]" | ">}" | ">" check_ident2! | "|]" | "|}" | "|" check_ident2! | "[" ?= [ "<<" | "<:" ] | "[|" | "[<" | "[:" | "[" | "{" ?= [ "<<" | "<:" ] | "{|" | "{<" | "{:" | "{" | ";;" | ";" | _ ] and check_ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | '\128'-'\255' ] check_ident! | ] and check_ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' ] check_ident2! | ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Plexing.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Plexing.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (Hashtbl.mem kwd_table p_prm) then if check_keyword p_prm then if Hashtbl.mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if Hashtbl.mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | "CHAR" | "STRING" | "QUOTATION" | "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> () | _ -> raise (Plexing.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT", s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value after_colon_except_last e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 2) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then if p_prm.[String.length p_prm - 1] = ':' then let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then if eq_before_colon p_prm prm then after_colon_except_last prm else raise Stream.Failure else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then raise Stream.Failure else if eq_before_colon p_prm prm then after_colon prm else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Plexing.default_match tok ] ; value gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let glex = {Plexing.tok_func = func kwd_table glexr; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; glex } ; do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; Grammar.Unsafe.gram_reinit gram (gmake ()); dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_declaration; Grammar.Unsafe.clear_entry constructor_declaration; Grammar.Unsafe.clear_entry match_case; Grammar.Unsafe.clear_entry with_constr; Grammar.Unsafe.clear_entry poly_variant; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value neg_string n = let len = String.length n in if len > 0 && n.[0] = '-' then String.sub n 1 (len - 1) else "-" ^ n ; value mkumin loc f arg = match arg with [ <:expr< $int:n$ >> -> <:expr< $int:neg_string n$ >> | <:expr< $flo:n$ >> -> <:expr< $flo:neg_string n$ >> | _ -> let f = "~" ^ f in <:expr< $lid:f$ $arg$ >> ] ; value mklistexp loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = do { let ct = Hashtbl.create 73 in List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] }; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; (*** And JRH inserted it in here ***) value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value check_not_part_of_patt = Grammar.Entry.of_parser gram "check_not_part_of_patt" (fun strm -> let tok = match Stream.npeek 4 strm with [ [("LIDENT", _); tok :: _] -> tok | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok | _ -> raise Stream.Failure ] in match tok with [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure | _ -> () ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in loop where rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"; "?!"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("ANTIQUOT_LOC", _) -> () | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e | _ -> 1 ] ; value rec constr_patt_arity loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value mem_tvar s tpl = List.exists (fun (t, _) -> Pcaml.unvala t = s) tpl; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if mem_tvar s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if mem_tvar v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type class_expr class_sig_item class_str_item let_binding type_declaration constructor_declaration match_case with_constr poly_variant; module_expr: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> | "struct"; st = V (LIST0 [ s = str_item; OPT ";;" -> s ]); "end" -> <:module_expr< struct $_list:st$ end >> ] | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> <:str_item< module $_flag:r$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:str_item< module type $_uid:i$ = $mt$ >> | "open"; i = V mod_ident "list" "" -> <:str_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_declaration SEP "and") -> <:str_item< type $_list:tdl$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr -> let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> match l with [ <:vala< [(p, e)] >> -> match p with [ <:patt< _ >> -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> <:str_item< let module $_uid:m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = V mod_ident "list" -> sl | -> <:vala< [] >> ] ] ; mod_binding: [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] ; mod_fun_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> <:module_type< $mt$ with $_list:wcl$ >> ] | [ "sig"; sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]); "end" -> <:module_type< sig $_list:sg$ end >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = V UIDENT -> <:module_type< $_uid:m$ >> | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl) = constructor_declaration -> <:sig_item< exception $_uid:c$ of $_list:tl$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; rf = V (FLAG "rec"); l = V (LIST1 mod_decl_binding SEP "and") -> <:sig_item< module $_flag:rf$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:sig_item< module type $_uid:i$ = $mt$ >> | "module"; "type"; i = V UIDENT "uid" "" -> <:sig_item< module type $_uid:i$ = 'abstract >> | "open"; i = V mod_ident "list" "" -> <:sig_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_declaration SEP "and") -> <:sig_item< type $_list:tdl$ >> | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> <:sig_item< value $_lid:i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $lid:i$ : $t$ >> ] ] ; mod_decl_binding: [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; pf = V (FLAG "private"); t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> | "module"; i = V mod_ident ""; "="; me = module_expr -> <:with_constr< module $_:i$ = $me$ >> ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] | "expr1" [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr LEVEL "top" -> <:expr< let $_flag:o$ $_list:l$ in $x$ >> | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $_uid:m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< fun [ $_list:l$ ] >> | "fun"; p = patt LEVEL "simple"; e = fun_def -> <:expr< fun [$p$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< match $e$ with [ $_list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< try $e$ with [ $_list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; e2 = SELF; "do"; e = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e in <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e2 in <:expr< while $e1$ do { $_list:el$ } >> ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< $mkumin loc "-" e$ >> | "-."; e = SELF -> <:expr< $mkumin loc "-." e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> let (e1, e2) = if is_expr_constr_call e1 then match e1 with [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) | _ -> (e1, e2) ] else (e1, e2) in match constr_expr_arity loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> <:expr< assert $e$ >> | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e = SELF; "."; "{"; el = V (LIST1 expr SEP ","); "}" -> <:expr< $e$ .{ $_list:el$ } >> | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val>> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = V INT -> <:expr< $_int:s$ >> | s = V INT_l -> <:expr< $_int32:s$ >> | s = V INT_L -> <:expr< $_int64:s$ >> | s = V INT_n -> <:expr< $_nativeint:s$ >> | s = V FLOAT -> <:expr< $_flo:s$ >> | s = V STRING -> <:expr< $_str:s$ >> | c = V CHAR -> <:expr< $_chr:c$ >> | UIDENT "True" -> <:expr< $uid:" True"$ >> | UIDENT "False" -> <:expr< $uid:" False"$ >> | i = expr_ident -> i | "false" -> <:expr< False >> | "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = V expr1_semi_list "list"; "|]" -> <:expr< [| $_list:el$ |] >> | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> <:expr< { $_list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> <:expr< { ($e$) with $_list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> <:expr< $e$ >> | "begin"; e = SELF; "end" -> <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_expr_quotation loc x ] ] ; e_phony: [ [ -> raise Stream.Failure ] ] ; let_binding: [ [ p = val_ident; e = fun_binding -> (p, e) | p = patt; "="; e = expr -> (p, e) ] ] ; (*** JRH added the "translate_operator" here ***) val_ident: [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> | check_not_part_of_patt; "("; s = ANY; ")" -> let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] ; fun_binding: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] ; match_case: [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] | e = expr LEVEL "expr1"; ";" -> [e] | e = expr LEVEL "expr1" -> [e] ] ] ; fun_def: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "->"; e = expr -> <:expr< $e$ >> ] ] ; expr_ident: [ RIGHTA [ i = V LIDENT -> <:expr< $_lid:i$ >> | i = V UIDENT -> <:expr< $_uid:i$ >> | i = V UIDENT; "."; j = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop <:expr< $_uid:i$ >> j | i = V UIDENT; "."; "("; j = operator_rparen -> <:expr< $_uid:i$ . $lid:j$ >> ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> let (p1, p2) = match p1 with [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) | _ -> (p1, p2) ] in match constr_patt_arity loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ s = V LIDENT -> <:patt< $_lid:s$ >> | s = V UIDENT -> <:patt< $_uid:s$ >> | s = V INT -> <:patt< $_int:s$ >> | s = V INT_l -> <:patt< $_int32:s$ >> | s = V INT_L -> <:patt< $_int64:s$ >> | s = V INT_n -> <:patt< $_nativeint:s$ >> | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = V FLOAT -> <:patt< $_flo:s$ >> | s = V STRING -> <:patt< $_str:s$ >> | s = V CHAR -> <:patt< $_chr:s$ >> | UIDENT "True" -> <:patt< $uid:" True"$ >> | UIDENT "False" -> <:patt< $uid:" False"$ >> | "false" -> <:patt< False >> | "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = V patt_semi_list "list"; "|]" -> <:patt< [| $_list:pl$ |] >> | "{"; lpl = V lbl_patt_list "list"; "}" -> <:patt< { $_list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; ")" -> <:patt< $p$ >> | "_" -> <:patt< _ >> | x = QUOTATION -> let x = try let i = String.index x ':' in (String.sub x 0 i, String.sub x (i + 1) (String.length x - i - 1)) with [ Not_found -> ("", x) ] in Pcaml.handle_patt_quotation loc x ] ] ; p_phony: [ [ -> raise Stream.Failure ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_declaration: [ [ tpl = type_parameters; n = type_patt; "="; pf = V (FLAG "private"); tk = type_kind; cl = V (LIST0 constrain) -> {MLast.tdNam = n; MLast.tdPrm = <:vala< tpl >>; MLast.tdPrv = pf; MLast.tdDef = tk; MLast.tdCon = cl} | tpl = type_parameters; n = type_patt; cl = V (LIST0 constrain) -> {MLast.tdNam = n; MLast.tdPrm = <:vala< tpl >>; MLast.tdPrv = <:vala< False >>; MLast.tdDef = <:ctyp< '$choose_tvar tpl$ >>; MLast.tdCon = cl} ] ] ; type_patt: [ [ n = V LIDENT -> (loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< $t$ == { $_list:ldl$ } >> | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == [ $list:cdl$ ] >> | "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< { $_list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "'"; i = V ident "" -> (i, (False, False)) | "+"; "'"; i = V ident "" -> (i, (True, False)) | "-"; "'"; i = V ident "" -> (i, (False, True)) ] ] ; constructor_declaration: [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> (loc, ci, cal) | ci = cons_ident -> (loc, ci, <:vala< [] >>) ] ] ; cons_ident: [ [ i = V UIDENT "uid" "" -> i | UIDENT "True" -> <:vala< " True" >> | UIDENT "False" -> <:vala< " False" >> ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "apply" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> | "_" -> <:ctyp< _ >> | i = V LIDENT -> <:ctyp< $_lid:i$ >> | i = V UIDENT -> <:ctyp< $_uid:i$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> <:str_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:str_item< class type $_list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = V (LIST1 class_description SEP "and") -> <:sig_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:sig_item< class type $_list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = patt LEVEL "simple"; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (loc, <:vala< [] >>) | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] ; class_fun_def: [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = patt LEVEL "simple"; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); "in"; ce = SELF -> <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< $list:ci$ [ $ct$ ] >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:class_expr< object $_opt:cspo$ $_list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> <:class_str_item< inherit $ce$ $_opt:pb$ >> | "val"; mf = V (FLAG "mutable"); lab = V label "lid" ""; e = cvalue_binding -> <:class_str_item< value $_flag:mf$ $_lid:lab$ = $e$ >> | "method"; "private"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V label "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual $_lid:l$ : $t$ >> | "method"; "private"; l = V label "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method private $_lid:l$ : $t$ = $e$ >> | "method"; "private"; l = V label "lid" ""; sb = fun_binding -> <:class_str_item< method private $_lid:l$ = $sb$ >> | "method"; l = V label "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_lid:l$ : $t$ = $e$ >> | "method"; l = V label "lid" ""; sb = fun_binding -> <:class_str_item< method $_lid:l$ = $sb$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> <:class_type< $list:id$ [ $list:tl$ ] >> | id = clty_longident -> <:class_type< $list:id$ >> | "object"; cst = V (OPT class_self_type); csf = V (LIST0 class_sig_item); "end" -> <:class_type< object $_opt:cst$ $_list:csf$ end >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = V (FLAG "mutable"); l = V label "lid" ""; ":"; t = ctyp -> <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> | "method"; "private"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V label "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual $_lid:l$ : $t$ >> | "method"; "private"; l = V label "lid" ""; ":"; t = poly_type -> <:class_sig_item< method private $_lid:l$ : $t$ >> | "method"; l = V label "lid" ""; ":"; t = poly_type -> <:class_sig_item< method $_lid:l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; ":"; ct = class_type -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; "="; cs = class_signature -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = V label "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = V field_expr_list "list"; ">}" -> <:expr< {< $_list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = V class_longident "list" -> <:ctyp< # $_list:id$ >> | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> <:ctyp< < $_list:ml$ $_flag:v$ > >> | "<"; ".."; ">" -> <:ctyp< < .. > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; ml = SELF -> [f :: ml] | f = field; ";" -> [f] | f = field -> [f] ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) clty_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: AFTER "arrow" [ NONA [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ = $_list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ > $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ < $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; ntl = V (LIST1 name_tag); "]" -> <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] ; poly_variant: [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); l = V (LIST1 ctyp SEP "&") -> <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> | t = ctyp -> MLast.PvInh t ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] ; expr: AFTER "apply" [ "label" [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~$_:i$: $e$ >> | i = V TILDEIDENT -> <:expr< ~$_:i$ >> | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?$_:i$: $e$ >> | i = V QUESTIONIDENT -> <:expr< ?$_:i$ >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] ; fun_def: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; patt: LEVEL "simple" [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> | p = labeled_patt -> p ] ] ; labeled_patt: [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> <:patt< ~$_:i$: $p$ >> | i = V TILDEIDENT -> <:patt< ~$_:i$ >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~$i$ >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~$i$: ($lid:i$ : $t$) >> | i = V QUESTIONIDENTCOLON; j = LIDENT -> <:patt< ?$_:i$: ($lid:j$) >> | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> <:patt< ?$_:i$: ( $p$ = $e$ ) >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ?$_:i$: ( $p$ : $t$ ) >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?$_:i$: ( $p$ : $t$ = $e$ ) >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> <:patt< ?$_:i$: ( $p$ ) >> | i = V QUESTIONIDENT -> <:patt< ?$_:i$ >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ = $e$ ) >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> | "?"; "("; i = LIDENT; ")" -> <:patt< ?$i$ >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ? ( $lid:i$ : $t$ ) >> ] ] ; class_type: [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ~$i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_fun_def: [ [ p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], True) | EOI -> ([], False) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], True) | EOI -> ([], False) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $lid:n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $lid:n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; (* ------------------------------------------------------------------------- *) (* Added by JRH *** *) (* ------------------------------------------------------------------------- *) EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pa_j_3.1x_6.02.1.ml000066400000000000000000002752721303454263000156040ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* New version. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: pa_o.ml,v 6.33 2010-11-16 16:48:21 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_extend.cmo"; #load "q_MLast.cmo"; #load "pa_reloc.cmo"; open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* ------------------------------------------------------------------------- *) (* The main/reloc.ml file. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: reloc.ml,v 6.16 2010-11-21 17:17:45 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_macro.cmo"; open MLast; value option_map f = fun [ Some x -> Some (f x) | None -> None ] ; value vala_map f = IFNDEF STRICT THEN fun x -> f x ELSE fun [ Ploc.VaAnt s -> Ploc.VaAnt s | Ploc.VaVal x -> Ploc.VaVal (f x) ] END ; value class_infos_map floc f x = {ciLoc = floc x.ciLoc; ciVir = x.ciVir; ciPrm = let (x1, x2) = x.ciPrm in (floc x1, x2); ciNam = x.ciNam; ciExp = f x.ciExp} ; value anti_loc qloc sh loc loc1 = (* ...<:expr<.....$lid:...xxxxxxxx...$...>>... |..|-----------------------------------| qloc <-----> sh |.........|------------| loc |..|------| loc1 *) let sh1 = Ploc.first_pos qloc + sh in let sh2 = sh1 + Ploc.first_pos loc in let line_nb_qloc = Ploc.line_nb qloc in let line_nb_loc = Ploc.line_nb loc in let line_nb_loc1 = Ploc.line_nb loc1 in if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then Ploc.make_unlined (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) else Ploc.make_loc (Ploc.file_name loc) (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) (if line_nb_loc1 = 1 then if line_nb_loc = 1 then Ploc.bol_pos qloc else sh1 + Ploc.bol_pos loc else sh2 + Ploc.bol_pos loc1) (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" ; value rec reloc_ctyp floc sh = self where rec self = fun [ TyAcc loc x1 x2 -> let loc = floc loc in TyAcc loc (self x1) (self x2) | TyAli loc x1 x2 -> let loc = floc loc in TyAli loc (self x1) (self x2) | TyAny loc -> let loc = floc loc in TyAny loc | TyApp loc x1 x2 -> let loc = floc loc in TyApp loc (self x1) (self x2) | TyArr loc x1 x2 -> let loc = floc loc in TyArr loc (self x1) (self x2) | TyCls loc x1 -> let loc = floc loc in TyCls loc x1 | TyLab loc x1 x2 -> let loc = floc loc in TyLab loc x1 (self x2) | TyLid loc x1 -> let loc = floc loc in TyLid loc x1 | TyMan loc x1 x2 x3 -> let loc = floc loc in TyMan loc (self x1) x2 (self x3) | TyObj loc x1 x2 -> let loc = floc loc in TyObj loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) x2 | TyOlb loc x1 x2 -> let loc = floc loc in TyOlb loc x1 (self x2) | TyPck loc x1 -> let loc = floc loc in TyPck loc (reloc_module_type floc sh x1) | TyPol loc x1 x2 -> let loc = floc loc in TyPol loc x1 (self x2) | TyPot loc x1 x2 -> let loc = floc loc in TyPot loc x1 (self x2) | TyQuo loc x1 -> let loc = floc loc in TyQuo loc x1 | TyRec loc x1 -> let loc = floc loc in TyRec loc (vala_map (List.map (fun (loc, x1, x2, x3) -> (floc loc, x1, x2, self x3))) x1) | TySum loc x1 -> let loc = floc loc in TySum loc (vala_map (List.map (fun (loc, x1, x2, x3) -> (floc loc, x1, vala_map (List.map self) x2, option_map self x3))) x1) | TyTup loc x1 -> let loc = floc loc in TyTup loc (vala_map (List.map self) x1) | TyUid loc x1 -> let loc = floc loc in TyUid loc x1 | TyVrn loc x1 x2 -> let loc = floc loc in TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 | IFDEF STRICT THEN TyXtr loc x1 x2 -> let loc = floc loc in TyXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_poly_variant floc sh = fun [ PvTag loc x1 x2 x3 -> let loc = floc loc in PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) | PvInh loc x1 -> let loc = floc loc in PvInh loc (reloc_ctyp floc sh x1) ] and reloc_patt floc sh = self where rec self = fun [ PaAcc loc x1 x2 -> let loc = floc loc in PaAcc loc (self x1) (self x2) | PaAli loc x1 x2 -> let loc = floc loc in PaAli loc (self x1) (self x2) | PaAnt loc x1 -> let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_patt new_floc sh x1 | PaAny loc -> let loc = floc loc in PaAny loc | PaApp loc x1 x2 -> let loc = floc loc in PaApp loc (self x1) (self x2) | PaArr loc x1 -> let loc = floc loc in PaArr loc (vala_map (List.map self) x1) | PaChr loc x1 -> let loc = floc loc in PaChr loc x1 | PaFlo loc x1 -> let loc = floc loc in PaFlo loc x1 | PaInt loc x1 x2 -> let loc = floc loc in PaInt loc x1 x2 | PaLab loc x1 x2 -> let loc = floc loc in PaLab loc (self x1) (vala_map (option_map self) x2) | PaLaz loc x1 -> let loc = floc loc in PaLaz loc (self x1) | PaLid loc x1 -> let loc = floc loc in PaLid loc x1 | PaNty loc x1 -> let loc = floc loc in PaNty loc x1 | PaOlb loc x1 x2 -> let loc = floc loc in PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) | PaOrp loc x1 x2 -> let loc = floc loc in PaOrp loc (self x1) (self x2) | PaRec loc x1 -> let loc = floc loc in PaRec loc (vala_map (List.map (fun (x1, x2) -> (self x1, self x2))) x1) | PaRng loc x1 x2 -> let loc = floc loc in PaRng loc (self x1) (self x2) | PaStr loc x1 -> let loc = floc loc in PaStr loc x1 | PaTup loc x1 -> let loc = floc loc in PaTup loc (vala_map (List.map self) x1) | PaTyc loc x1 x2 -> let loc = floc loc in PaTyc loc (self x1) (reloc_ctyp floc sh x2) | PaTyp loc x1 -> let loc = floc loc in PaTyp loc x1 | PaUid loc x1 -> let loc = floc loc in PaUid loc x1 | PaUnp loc x1 x2 -> let loc = floc loc in PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) | PaVrn loc x1 -> let loc = floc loc in PaVrn loc x1 | IFDEF STRICT THEN PaXtr loc x1 x2 -> let loc = floc loc in PaXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_expr floc sh = self where rec self = fun [ ExAcc loc x1 x2 -> let loc = floc loc in ExAcc loc (self x1) (self x2) | ExAnt loc x1 -> let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_expr new_floc sh x1 | ExApp loc x1 x2 -> let loc = floc loc in ExApp loc (self x1) (self x2) | ExAre loc x1 x2 -> let loc = floc loc in ExAre loc (self x1) (self x2) | ExArr loc x1 -> let loc = floc loc in ExArr loc (vala_map (List.map self) x1) | ExAsr loc x1 -> let loc = floc loc in ExAsr loc (self x1) | ExAss loc x1 x2 -> let loc = floc loc in ExAss loc (self x1) (self x2) | ExBae loc x1 x2 -> let loc = floc loc in ExBae loc (self x1) (vala_map (List.map self) x2) | ExChr loc x1 -> let loc = floc loc in ExChr loc x1 | ExCoe loc x1 x2 x3 -> let loc = floc loc in ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) | ExFlo loc x1 -> let loc = floc loc in ExFlo loc x1 | ExFor loc x1 x2 x3 x4 x5 -> let loc = floc loc in ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) | ExFun loc x1 -> let loc = floc loc in ExFun loc (vala_map (List.map (fun (x1, x2, x3) -> (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x1) | ExIfe loc x1 x2 x3 -> let loc = floc loc in ExIfe loc (self x1) (self x2) (self x3) | ExInt loc x1 x2 -> let loc = floc loc in ExInt loc x1 x2 | ExLab loc x1 -> let loc = floc loc in ExLab loc (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, vala_map (option_map self) x2))) x1) | ExLaz loc x1 -> let loc = floc loc in ExLaz loc (self x1) | ExLet loc x1 x2 x3 -> let loc = floc loc in ExLet loc x1 (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) x2) (self x3) | ExLid loc x1 -> let loc = floc loc in ExLid loc x1 | ExLmd loc x1 x2 x3 -> let loc = floc loc in ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) | ExMat loc x1 x2 -> let loc = floc loc in ExMat loc (self x1) (vala_map (List.map (fun (x1, x2, x3) -> (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExNew loc x1 -> let loc = floc loc in ExNew loc x1 | ExObj loc x1 x2 -> let loc = floc loc in ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | ExOlb loc x1 x2 -> let loc = floc loc in ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) | ExOvr loc x1 -> let loc = floc loc in ExOvr loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) | ExPck loc x1 x2 -> let loc = floc loc in ExPck loc (reloc_module_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | ExRec loc x1 x2 -> let loc = floc loc in ExRec loc (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) x1) (option_map self x2) | ExSeq loc x1 -> let loc = floc loc in ExSeq loc (vala_map (List.map self) x1) | ExSnd loc x1 x2 -> let loc = floc loc in ExSnd loc (self x1) x2 | ExSte loc x1 x2 -> let loc = floc loc in ExSte loc (self x1) (self x2) | ExStr loc x1 -> let loc = floc loc in ExStr loc x1 | ExTry loc x1 x2 -> let loc = floc loc in ExTry loc (self x1) (vala_map (List.map (fun (x1, x2, x3) -> (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExTup loc x1 -> let loc = floc loc in ExTup loc (vala_map (List.map self) x1) | ExTyc loc x1 x2 -> let loc = floc loc in ExTyc loc (self x1) (reloc_ctyp floc sh x2) | ExUid loc x1 -> let loc = floc loc in ExUid loc x1 | ExVrn loc x1 -> let loc = floc loc in ExVrn loc x1 | ExWhi loc x1 x2 -> let loc = floc loc in ExWhi loc (self x1) (vala_map (List.map self) x2) | IFDEF STRICT THEN ExXtr loc x1 x2 -> let loc = floc loc in ExXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_module_type floc sh = self where rec self = fun [ MtAcc loc x1 x2 -> let loc = floc loc in MtAcc loc (self x1) (self x2) | MtApp loc x1 x2 -> let loc = floc loc in MtApp loc (self x1) (self x2) | MtFun loc x1 x2 x3 -> let loc = floc loc in MtFun loc x1 (self x2) (self x3) | MtLid loc x1 -> let loc = floc loc in MtLid loc x1 | MtQuo loc x1 -> let loc = floc loc in MtQuo loc x1 | MtSig loc x1 -> let loc = floc loc in MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) | MtTyo loc x1 -> let loc = floc loc in MtTyo loc (reloc_module_expr floc sh x1) | MtUid loc x1 -> let loc = floc loc in MtUid loc x1 | MtWit loc x1 x2 -> let loc = floc loc in MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) | IFDEF STRICT THEN MtXtr loc x1 x2 -> let loc = floc loc in MtXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_sig_item floc sh = self where rec self = fun [ SgCls loc x1 -> let loc = floc loc in SgCls loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgClt loc x1 -> let loc = floc loc in SgClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgDcl loc x1 -> let loc = floc loc in SgDcl loc (vala_map (List.map self) x1) | SgDir loc x1 x2 -> let loc = floc loc in SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | SgExc loc x1 x2 -> let loc = floc loc in SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | SgExt loc x1 x2 x3 -> let loc = floc loc in SgExt loc x1 (reloc_ctyp floc sh x2) x3 | SgInc loc x1 -> let loc = floc loc in SgInc loc (reloc_module_type floc sh x1) | SgMod loc x1 x2 -> let loc = floc loc in SgMod loc x1 (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_type floc sh x2))) x2) | SgMty loc x1 x2 -> let loc = floc loc in SgMty loc x1 (reloc_module_type floc sh x2) | SgOpn loc x1 -> let loc = floc loc in SgOpn loc x1 | SgTyp loc x1 -> let loc = floc loc in SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | SgUse loc x1 x2 -> let loc = floc loc in SgUse loc x1 (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) | SgVal loc x1 x2 -> let loc = floc loc in SgVal loc x1 (reloc_ctyp floc sh x2) | IFDEF STRICT THEN SgXtr loc x1 x2 -> let loc = floc loc in SgXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_with_constr floc sh = fun [ WcMod loc x1 x2 -> let loc = floc loc in WcMod loc x1 (reloc_module_expr floc sh x2) | WcMos loc x1 x2 -> let loc = floc loc in WcMos loc x1 (reloc_module_expr floc sh x2) | WcTyp loc x1 x2 x3 x4 -> let loc = floc loc in WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) | WcTys loc x1 x2 x3 -> let loc = floc loc in WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_module_expr floc sh = self where rec self = fun [ MeAcc loc x1 x2 -> let loc = floc loc in MeAcc loc (self x1) (self x2) | MeApp loc x1 x2 -> let loc = floc loc in MeApp loc (self x1) (self x2) | MeFun loc x1 x2 x3 -> let loc = floc loc in MeFun loc x1 (reloc_module_type floc sh x2) (self x3) | MeStr loc x1 -> let loc = floc loc in MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) | MeTyc loc x1 x2 -> let loc = floc loc in MeTyc loc (self x1) (reloc_module_type floc sh x2) | MeUid loc x1 -> let loc = floc loc in MeUid loc x1 | MeUnp loc x1 x2 -> let loc = floc loc in MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | IFDEF STRICT THEN MeXtr loc x1 x2 -> let loc = floc loc in MeXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_str_item floc sh = self where rec self = fun [ StCls loc x1 -> let loc = floc loc in StCls loc (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) | StClt loc x1 -> let loc = floc loc in StClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | StDcl loc x1 -> let loc = floc loc in StDcl loc (vala_map (List.map self) x1) | StDir loc x1 x2 -> let loc = floc loc in StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | StExc loc x1 x2 x3 -> let loc = floc loc in StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 | StExp loc x1 -> let loc = floc loc in StExp loc (reloc_expr floc sh x1) | StExt loc x1 x2 x3 -> let loc = floc loc in StExt loc x1 (reloc_ctyp floc sh x2) x3 | StInc loc x1 -> let loc = floc loc in StInc loc (reloc_module_expr floc sh x1) | StMod loc x1 x2 -> let loc = floc loc in StMod loc x1 (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_expr floc sh x2))) x2) | StMty loc x1 x2 -> let loc = floc loc in StMty loc x1 (reloc_module_type floc sh x2) | StOpn loc x1 -> let loc = floc loc in StOpn loc x1 | StTyp loc x1 -> let loc = floc loc in StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | StUse loc x1 x2 -> let loc = floc loc in StUse loc x1 (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) | StVal loc x1 x2 -> let loc = floc loc in StVal loc x1 (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) | IFDEF STRICT THEN StXtr loc x1 x2 -> let loc = floc loc in StXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_type_decl floc sh x = {tdNam = vala_map (fun (loc, x1) -> (floc loc, x1)) x.tdNam; tdPrm = x.tdPrm; tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; tdCon = vala_map (List.map (fun (x1, x2) -> (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) x.tdCon} and reloc_class_type floc sh = self where rec self = fun [ CtAcc loc x1 x2 -> let loc = floc loc in CtAcc loc (self x1) (self x2) | CtApp loc x1 x2 -> let loc = floc loc in CtApp loc (self x1) (self x2) | CtCon loc x1 x2 -> let loc = floc loc in CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) | CtFun loc x1 x2 -> let loc = floc loc in CtFun loc (reloc_ctyp floc sh x1) (self x2) | CtIde loc x1 -> let loc = floc loc in CtIde loc x1 | CtSig loc x1 x2 -> let loc = floc loc in CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) (vala_map (List.map (reloc_class_sig_item floc sh)) x2) | IFDEF STRICT THEN CtXtr loc x1 x2 -> let loc = floc loc in CtXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_class_sig_item floc sh = self where rec self = fun [ CgCtr loc x1 x2 -> let loc = floc loc in CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CgDcl loc x1 -> let loc = floc loc in CgDcl loc (vala_map (List.map self) x1) | CgInh loc x1 -> let loc = floc loc in CgInh loc (reloc_class_type floc sh x1) | CgMth loc x1 x2 x3 -> let loc = floc loc in CgMth loc x1 x2 (reloc_ctyp floc sh x3) | CgVal loc x1 x2 x3 -> let loc = floc loc in CgVal loc x1 x2 (reloc_ctyp floc sh x3) | CgVir loc x1 x2 x3 -> let loc = floc loc in CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_class_expr floc sh = self where rec self = fun [ CeApp loc x1 x2 -> let loc = floc loc in CeApp loc (self x1) (reloc_expr floc sh x2) | CeCon loc x1 x2 -> let loc = floc loc in CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | CeFun loc x1 x2 -> let loc = floc loc in CeFun loc (reloc_patt floc sh x1) (self x2) | CeLet loc x1 x2 x3 -> let loc = floc loc in CeLet loc x1 (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) (self x3) | CeStr loc x1 x2 -> let loc = floc loc in CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | CeTyc loc x1 x2 -> let loc = floc loc in CeTyc loc (self x1) (reloc_class_type floc sh x2) | IFDEF STRICT THEN CeXtr loc x1 x2 -> let loc = floc loc in CeXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_class_str_item floc sh = self where rec self = fun [ CrCtr loc x1 x2 -> let loc = floc loc in CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CrDcl loc x1 -> let loc = floc loc in CrDcl loc (vala_map (List.map self) x1) | CrInh loc x1 x2 -> let loc = floc loc in CrInh loc (reloc_class_expr floc sh x1) x2 | CrIni loc x1 -> let loc = floc loc in CrIni loc (reloc_expr floc sh x1) | CrMth loc x1 x2 x3 x4 x5 -> let loc = floc loc in CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) (reloc_expr floc sh x5) | CrVal loc x1 x2 x3 x4 -> let loc = floc loc in CrVal loc x1 x2 x3 (reloc_expr floc sh x4) | CrVav loc x1 x2 x3 -> let loc = floc loc in CrVav loc x1 x2 (reloc_ctyp floc sh x3) | CrVir loc x1 x2 x3 -> let loc = floc loc in CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] ; (* Equality over syntax trees *) value eq_expr x y = reloc_expr (fun _ -> Ploc.dummy) 0 x = reloc_expr (fun _ -> Ploc.dummy) 0 y ; value eq_patt x y = reloc_patt (fun _ -> Ploc.dummy) 0 x = reloc_patt (fun _ -> Ploc.dummy) 0 y ; value eq_ctyp x y = reloc_ctyp (fun _ -> Ploc.dummy) 0 x = reloc_ctyp (fun _ -> Ploc.dummy) 0 y ; value eq_str_item x y = reloc_str_item (fun _ -> Ploc.dummy) 0 x = reloc_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_sig_item x y = reloc_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_module_expr x y = reloc_module_expr (fun _ -> Ploc.dummy) 0 x = reloc_module_expr (fun _ -> Ploc.dummy) 0 y ; value eq_module_type x y = reloc_module_type (fun _ -> Ploc.dummy) 0 x = reloc_module_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_sig_item x y = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_class_str_item x y = reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = reloc_class_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_class_type x y = reloc_class_type (fun _ -> Ploc.dummy) 0 x = reloc_class_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_expr x y = reloc_class_expr (fun _ -> Ploc.dummy) 0 x = reloc_class_expr (fun _ -> Ploc.dummy) 0 y ; (* ------------------------------------------------------------------------- *) (* Now the lexer. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: plexer.ml,v 6.11 2010-10-04 20:14:58 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_lexer.cmo"; (* ------------------------------------------------------------------------- *) (* Added by JRH as a backdoor to change lexical conventions. *) (* ------------------------------------------------------------------------- *) value jrh_lexer = ref False; open Versdep; value no_quotations = ref False; value error_on_unknown_keywords = ref False; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value force_antiquot_loc = ref False; type context = { after_space : mutable bool; dollar_for_antiquotation : bool; specific_space_dot : bool; find_kwd : string -> string; line_cnt : int -> char -> unit; set_line_nb : unit -> unit; make_lined_loc : (int * int) -> string -> Ploc.t } ; value err ctx loc msg = Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) ; (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) (***** JRH: Carl's alternative version then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; *****) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) value keyword_or_error ctx loc s = try ("", ctx.find_kwd s) with [ Not_found -> if error_on_unknown_keywords.val then err ctx loc ("illegal token: " ^ s) else ("", s) ] ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value utf8_lexing = ref False; value misc_letter buf strm = if utf8_lexing.val then match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] else match strm with lexer [ '\128'-'\255' ] ; value misc_punct buf strm = if utf8_lexing.val then match strm with lexer [ '\226' _ _ ] else match strm with parser [] ; value rec ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] ; value rec ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] ident2! | ] ; value rec ident3 = lexer [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' | '\128'-'\255' ] ident3! | ] ; value binary = lexer [ '0' | '1' ]; value octal = lexer [ '0'-'7' ]; value decimal = lexer [ '0'-'9' ]; value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; value end_integer = lexer [ "l"/ -> ("INT_l", $buf) | "L"/ -> ("INT_L", $buf) | "n"/ -> ("INT_n", $buf) | -> ("INT", $buf) ] ; value rec digits_under kind = lexer [ kind (digits_under kind)! | "_" (digits_under kind)! | end_integer ] ; value digits kind = lexer [ kind (digits_under kind)! | -> raise (Stream.Error "ill-formed integer constant") ] ; value rec decimal_digits_under = lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] ; value exponent_part = lexer [ [ 'e' | 'E' ] [ '+' | '-' | ] '0'-'9' ? "ill-formed floating-point constant" decimal_digits_under! ] ; value number = lexer [ decimal_digits_under "." decimal_digits_under! exponent_part -> ("FLOAT", $buf) | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) | decimal_digits_under exponent_part -> ("FLOAT", $buf) | decimal_digits_under end_integer! ] ; value char_after_bslash = lexer [ "'"/ | _ [ "'"/ | _ [ "'"/ | ] ] ] ; value char ctx bp = lexer [ "\\" _ char_after_bslash! | "\\" -> err ctx (bp, $pos) "char not terminated" | ?= [ _ '''] _! "'"/ ] ; value any ctx buf = parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } ; value rec string ctx bp = lexer [ "\""/ | "\\" (any ctx) (string ctx bp)! | (any ctx) (string ctx bp)! | -> err ctx (bp, $pos) "string not terminated" ] ; value rec qstring ctx bp = lexer [ "`"/ | (any ctx) (qstring ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value comment ctx bp = comment where rec comment = lexer [ "*)" | "*" comment! | "(*" comment! comment! | "(" comment! | "\"" (string ctx bp)! [ -> $add "\"" ] comment! | "'*)" | "'*" comment! | "'" (any ctx) comment! | (any ctx) comment! | -> err ctx (bp, $pos) "comment not terminated" ] ; value rec quotation ctx bp = lexer [ ">>"/ | ">" (quotation ctx bp)! | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! (quotation ctx bp)! | "<" (quotation ctx bp)! | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! | "\\" (quotation ctx bp)! | (any ctx) (quotation ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value less_expected = "character '<' expected"; value less ctx bp buf strm = if no_quotations.val then match strm with lexer [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] else match strm with lexer [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value rec antiquot_rest ctx bp = lexer [ "$"/ | "\\"/ (any ctx) (antiquot_rest ctx bp)! | (any ctx) (antiquot_rest ctx bp)! | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value rec antiquot ctx bp = lexer [ "$"/ -> ":" ^ $buf | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! | ":" (antiquot_rest ctx bp)! -> $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; value rec antiquot_loc ctx bp = lexer [ "$"/ -> antiloc bp $pos (":" ^ $buf) | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value dollar ctx bp buf strm = if not no_quotations.val && ctx.dollar_for_antiquotation then ("ANTIQUOT", antiquot ctx bp buf strm) else if force_antiquot_loc.val then ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) else match strm with lexer [ [ -> $add "$" ] ident2! -> ("", $buf) ] ; (* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?abc:d ?abc ?$abc:d$: ?abc:d: ?abc: ?$d$ ?:d ? ?$d$: ?:d: ?: *) (* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?8,13:abc:d ?abc ?$abc:d$: ?8,13:abc:d: ?abc: ?$d$ ?8,9::d ? ?$d$: ?8,9::d: ?: *) value question ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "?" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "?" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tilde ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "~" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "~" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tildeident = lexer [ ":"/ -> ("TILDEIDENTCOLON", $buf) | -> ("TILDEIDENT", $buf) ] ; value questionident = lexer [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) | -> ("QUESTIONIDENT", $buf) ] ; value rec linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> False ] and linedir_digits n s = match stream_peek_nth n s with [ Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> linedir_quote n s ] and linedir_quote n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir_quote (n + 1) s | Some '"' -> True | _ -> False ] ; value rec any_to_nl = lexer [ "\r" | "\n" | _ any_to_nl! | ] ; value next_token_after_spaces ctx bp = lexer [ 'A'-'Z' ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] *********) | [ 'a'-'z' | '_' | misc_letter ] ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! | "0" [ 'b' | 'B' ] (digits binary)! | "0" number! | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" | "'"/ (char ctx bp) -> ("CHAR", $buf) | "'" -> keyword_or_error ctx (bp, $pos) "'" | "\""/ (string ctx bp)! -> ("STRING", $buf) (*** Line added by JRH ***) | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) | "$"/ (dollar ctx bp)! | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> keyword_or_error ctx (bp, $pos) $buf | "~"/ 'a'-'z' ident! tildeident! | "~"/ '_' ident! tildeident! | "~" (tilde ctx bp) | "?"/ 'a'-'z' ident! questionident! | "?" (question ctx bp)! | "<"/ (less ctx bp)! | ":]" -> keyword_or_error ctx (bp, $pos) $buf | "::" -> keyword_or_error ctx (bp, $pos) $buf | ":=" -> keyword_or_error ctx (bp, $pos) $buf | ":>" -> keyword_or_error ctx (bp, $pos) $buf | ":" -> keyword_or_error ctx (bp, $pos) $buf | ">]" -> keyword_or_error ctx (bp, $pos) $buf | ">}" -> keyword_or_error ctx (bp, $pos) $buf | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "|]" -> keyword_or_error ctx (bp, $pos) $buf | "|}" -> keyword_or_error ctx (bp, $pos) $buf | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "[|" -> keyword_or_error ctx (bp, $pos) $buf | "[<" -> keyword_or_error ctx (bp, $pos) $buf | "[:" -> keyword_or_error ctx (bp, $pos) $buf | "[" -> keyword_or_error ctx (bp, $pos) $buf | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "{|" -> keyword_or_error ctx (bp, $pos) $buf | "{<" -> keyword_or_error ctx (bp, $pos) $buf | "{:" -> keyword_or_error ctx (bp, $pos) $buf | "{" -> keyword_or_error ctx (bp, $pos) $buf | ".." -> keyword_or_error ctx (bp, $pos) ".." | "." -> let id = if ctx.specific_space_dot && ctx.after_space then " ." else "." in keyword_or_error ctx (bp, $pos) id | ";;" -> keyword_or_error ctx (bp, $pos) ";;" | ";" -> keyword_or_error ctx (bp, $pos) ";" | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf | "\\"/ ident3! -> ("LIDENT", $buf) | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] ; value get_comment buf strm = $buf; value rec next_token ctx buf = parser bp [ [: `('\n' | '\r' as c); s :] ep -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := ep; ctx.set_line_nb (); ctx.after_space := True; next_token ctx ($add c) s } | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { ctx.after_space := True; next_token ctx ($add c) s } | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> let comm = get_comment buf () in if linedir 1 s then do { let buf = any_to_nl ($add '#') s in incr Plexing.line_nb.val; Plexing.bol_pos.val.val := Stream.count s; ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } else let loc = ctx.make_lined_loc (bp, bp + 1) comm in (keyword_or_error ctx (bp, bp + 1) "#", loc) | [: `'('; a = parser [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } | [: :] ep -> let loc = ctx.make_lined_loc (bp, ep) $buf in (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a | [: comm = get_comment buf; tok = next_token_after_spaces ctx bp $empty :] ep -> let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in (tok, loc) | [: comm = get_comment buf; _ = Stream.empty :] -> let loc = ctx.make_lined_loc (bp, bp + 1) comm in (("EOI", ""), loc) ] ; value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = try do { match Plexing.restore_lexing_info.val with [ Some (line_nb, bol_pos) -> do { s_line_nb.val := line_nb; s_bol_pos.val := bol_pos; Plexing.restore_lexing_info.val := None; } | None -> () ]; Plexing.line_nb.val := s_line_nb; Plexing.bol_pos.val := s_bol_pos; let comm_bp = Stream.count cstrm in ctx.set_line_nb (); ctx.after_space := False; let (r, loc) = next_token ctx $empty cstrm in match glexr.val.Plexing.tok_comm with [ Some list -> if Ploc.first_pos loc > comm_bp then let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in glexr.val.Plexing.tok_comm := Some [comm_loc :: list] else () | None -> () ]; (r, loc) } with [ Stream.Error str -> err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] ; value func kwd_table glexr = let ctx = let line_nb = ref 0 in let bol_pos = ref 0 in {after_space = False; dollar_for_antiquotation = dollar_for_antiquotation.val; specific_space_dot = specific_space_dot.val; find_kwd = Hashtbl.find kwd_table; line_cnt bp1 c = match c with [ '\n' | '\r' -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := bp1 + 1; } | c -> () ]; set_line_nb () = do { line_nb.val := Plexing.line_nb.val.val; bol_pos.val := Plexing.bol_pos.val.val; }; make_lined_loc loc comm = Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} in Plexing.lexer_func_of_parser (next_token_fun ctx glexr) ; value rec check_keyword_stream = parser [: _ = check $empty; _ = Stream.empty :] -> True and check = lexer [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ] check_ident2! | "$" check_ident2! | "<" ?= [ ":" | "<" ] | "<" check_ident2! | ":]" | "::" | ":=" | ":>" | ":" | ">]" | ">}" | ">" check_ident2! | "|]" | "|}" | "|" check_ident2! | "[" ?= [ "<<" | "<:" ] | "[|" | "[<" | "[:" | "[" | "{" ?= [ "<<" | "<:" ] | "{|" | "{<" | "{:" | "{" | ";;" | ";" | misc_punct check_ident2! | _ ] and check_ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] check_ident! | ] and check_ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | misc_punct ] check_ident2! | ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Plexing.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Plexing.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (hashtbl_mem kwd_table p_prm) then if check_keyword p_prm then if hashtbl_mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | "CHAR" | "STRING" | "QUOTATION" | "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> () | _ -> raise (Plexing.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT", s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value after_colon_except_last e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 2) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then if p_prm.[String.length p_prm - 1] = ':' then let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then if eq_before_colon p_prm prm then after_colon_except_last prm else raise Stream.Failure else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then raise Stream.Failure else if eq_before_colon p_prm prm then after_colon prm else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Plexing.default_match tok ] ; value gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let glex = {Plexing.tok_func = func kwd_table glexr; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; glex } ; (* ------------------------------------------------------------------------- *) (* Back to etc/pa_o.ml *) (* ------------------------------------------------------------------------- *) do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; Grammar.Unsafe.gram_reinit gram (gmake ()); dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry signature; Grammar.Unsafe.clear_entry structure; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_decl; Grammar.Unsafe.clear_entry constructor_declaration; Grammar.Unsafe.clear_entry label_declaration; Grammar.Unsafe.clear_entry match_case; Grammar.Unsafe.clear_entry with_constr; Grammar.Unsafe.clear_entry poly_variant; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value mklistexp loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = do { let ct = Hashtbl.create 73 in List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] }; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value check_not_part_of_patt = Grammar.Entry.of_parser gram "check_not_part_of_patt" (fun strm -> let tok = match Stream.npeek 4 strm with [ [("LIDENT", _); tok :: _] -> tok | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok | _ -> raise Stream.Failure ] in match tok with [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure | _ -> () ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in loop where rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"; "?!"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && (x = "$" || String.length x >= 2) && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("ANTIQUOT_LOC", _) -> () | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value e_phony = Grammar.Entry.of_parser gram "e_phony" (parser []) ; value p_phony = Grammar.Entry.of_parser gram "p_phony" (parser []) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e | _ -> 1 ] ; value rec constr_patt_arity loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value mem_tvar s tpl = List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl ; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if mem_tvar s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if mem_tvar v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; value quotation_content s = do { loop 0 where rec loop i = if i = String.length s then ("", s) else if s.[i] = ':' || s.[i] = '@' then let i = i + 1 in (String.sub s 0 i, String.sub s i (String.length s - i)) else loop (i + 1) }; value concat_comm loc e = let loc = Ploc.with_comment loc (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) in let floc = let first = ref True in fun loc1 -> if first.val then do {first.val := False; loc} else loc1 in reloc_expr floc 0 e ; EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr signature structure class_type class_expr class_sig_item class_str_item let_binding type_decl constructor_declaration label_declaration match_case with_constr poly_variant; module_expr: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> | "struct"; st = structure; "end" -> <:module_expr< struct $_list:st$ end >> ] | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; "val"; e = expr; ":"; mt = module_type; ")" -> <:module_expr< (value $e$ : $mt$) >> | "("; "val"; e = expr; ")" -> <:module_expr< (value $e$) >> | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; structure: [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration; b = rebind_exn -> <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> <:str_item< module $_flag:r$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:str_item< module type $_uid:i$ = $mt$ >> | "open"; i = V mod_ident "list" "" -> <:str_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:str_item< type $_list:tdl$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr -> let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> match l with [ <:vala< [(p, e)] >> -> match p with [ <:patt< _ >> -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> <:str_item< let module $_uid:m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = V mod_ident "list" -> sl | -> <:vala< [] >> ] ] ; mod_binding: [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] ; mod_fun_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> <:module_type< $mt$ with $_list:wcl$ >> ] | [ "sig"; sg = signature; "end" -> <:module_type< sig $_list:sg$ end >> | "module"; "type"; "of"; me = module_expr -> <:module_type< module type of $me$ >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; signature: [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = V UIDENT -> <:module_type< $_uid:m$ >> | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration -> <:sig_item< exception $_uid:c$ of $_list:tl$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; rf = V (FLAG "rec"); l = V (LIST1 mod_decl_binding SEP "and") -> <:sig_item< module $_flag:rf$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:sig_item< module type $_uid:i$ = $mt$ >> | "module"; "type"; i = V UIDENT "uid" "" -> <:sig_item< module type $_uid:i$ = 'abstract >> | "open"; i = V mod_ident "list" "" -> <:sig_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:sig_item< type $_list:tdl$ >> | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> <:sig_item< value $_lid:i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $lid:i$ : $t$ >> ] ] ; mod_decl_binding: [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; pf = V (FLAG "private"); t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> | "module"; i = V mod_ident ""; "="; me = module_expr -> <:with_constr< module $_:i$ = $me$ >> | "module"; i = V mod_ident ""; ":="; me = module_expr -> <:with_constr< module $_:i$ := $me$ >> ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] | "expr1" [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr LEVEL "top" -> <:expr< let $_flag:o$ $_list:l$ in $x$ >> | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $_uid:m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< fun [ $_list:l$ ] >> | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> <:expr< fun [$p$ $opt:eo$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< match $e$ with [ $_list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< try $e$ with [ $_list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; e2 = SELF; "do"; e = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e in <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e2 in <:expr< while $e1$ do { $_list:el$ } >> ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< - $e$ >> | "-."; e = SELF -> <:expr< -. $e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> let (e1, e2) = if is_expr_constr_call e1 then match e1 with [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) | _ -> (e1, e2) ] else (e1, e2) in match constr_expr_arity loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> <:expr< assert $e$ >> | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; op = operator_rparen -> <:expr< $e1$ .( $lid:op$ ) >> | e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> <:expr< $e$ .{ $_list:el$ } >> | e1 = SELF; "."; e2 = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop e1 e2 ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val >> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = V INT -> <:expr< $_int:s$ >> | s = V INT_l -> <:expr< $_int32:s$ >> | s = V INT_L -> <:expr< $_int64:s$ >> | s = V INT_n -> <:expr< $_nativeint:s$ >> | s = V FLOAT -> <:expr< $_flo:s$ >> | s = V STRING -> <:expr< $_str:s$ >> | c = V CHAR -> <:expr< $_chr:c$ >> | UIDENT "True" -> <:expr< True_ >> | UIDENT "False" -> <:expr< False_ >> | i = expr_ident -> i | "false" -> <:expr< False >> | "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = V expr1_semi_list "list"; "|]" -> <:expr< [| $_list:el$ |] >> | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> <:expr< { $_list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> <:expr< { ($e$) with $_list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> <:expr< (module $me$ : $mt$) >> | "("; "module"; me = module_expr; ")" -> <:expr< (module $me$) >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_expr_quotation loc con ] ] ; let_binding: [ [ p = val_ident; e = fun_binding -> (p, e) | p = patt; "="; e = expr -> (p, e) | p = patt; ":"; t = poly_type; "="; e = expr -> (<:patt< ($p$ : $t$) >>, e) ] ] ; (*** JRH added the "translate_operator" here ***) val_ident: [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> | check_not_part_of_patt; "("; s = ANY; ")" -> let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] ; fun_binding: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] ; match_case: [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] ; fun_def: [ RIGHTA [ p = patt LEVEL "simple"; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> (eo, <:expr< $e$ >>) ] ] ; expr_ident: [ RIGHTA [ i = V LIDENT -> <:expr< $_lid:i$ >> | i = V UIDENT -> <:expr< $_uid:i$ >> | i = V UIDENT; "."; j = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop <:expr< $_uid:i$ >> j | i = V UIDENT; "."; "("; j = operator_rparen -> <:expr< $_uid:i$ . $lid:j$ >> ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> let (p1, p2) = match p1 with [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) | _ -> (p1, p2) ] in match constr_patt_arity loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ s = V LIDENT -> <:patt< $_lid:s$ >> | s = V UIDENT -> <:patt< $_uid:s$ >> | s = V INT -> <:patt< $_int:s$ >> | s = V INT_l -> <:patt< $_int32:s$ >> | s = V INT_L -> <:patt< $_int64:s$ >> | s = V INT_n -> <:patt< $_nativeint:s$ >> | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = V FLOAT -> <:patt< $_flo:s$ >> | s = V STRING -> <:patt< $_str:s$ >> | s = V CHAR -> <:patt< $_chr:s$ >> | UIDENT "True" -> <:patt< True_ >> | UIDENT "False" -> <:patt< False_ >> | "false" -> <:patt< False >> | "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = V patt_semi_list "list"; "|]" -> <:patt< [| $_list:pl$ |] >> | "{"; lpl = V lbl_patt_list "list"; "}" -> <:patt< { $_list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; ")" -> <:patt< $p$ >> | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> <:patt< (module $_uid:s$ : $mt$) >> | "("; "module"; s = V UIDENT; ")" -> <:patt< (module $_uid:s$) >> | "_" -> <:patt< _ >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_patt_quotation loc con ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_decl: [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); tk = type_kind; cl = V (LIST0 constrain) -> <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> let tk = <:ctyp< '$choose_tvar tpl$ >> in <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] ; type_patt: [ [ n = V LIDENT -> (loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; pf = FLAG "private"; "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> | t = ctyp; "="; pf = FLAG "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> | "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< { $_list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "+"; p = V simple_type_parameter -> (p, Some True) | "-"; p = V simple_type_parameter -> (p, Some False) | p = V simple_type_parameter -> (p, None) ] ] ; simple_type_parameter: [ [ "'"; i = ident -> Some i | "_" -> None ] ] ; constructor_declaration: [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> (loc, ci, cal, None) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); "->"; t = ctyp -> (loc, ci, cal, Some t) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> let t = match cal with [ <:vala< [t] >> -> t | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> | _ -> assert False ] in (loc, ci, <:vala< [] >>, Some t) | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] ; cons_ident: [ [ i = V UIDENT "uid" "" -> i | UIDENT "True" -> <:vala< "True_" >> | UIDENT "False" -> <:vala< "False_" >> ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "apply" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> | "_" -> <:ctyp< _ >> | i = V LIDENT -> <:ctyp< $_lid:i$ >> | i = V UIDENT -> <:ctyp< $_uid:i$ >> | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> <:str_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:str_item< class type $_list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = V (LIST1 class_description SEP "and") -> <:sig_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:sig_item< class type $_list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = patt LEVEL "simple"; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (loc, <:vala< [] >>) | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] ; class_fun_def: [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = patt LEVEL "simple"; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); "in"; ce = SELF -> <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< [ $ct$ ] $list:ci$ >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:class_expr< object $_opt:cspo$ $_list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> <:class_str_item< inherit $ce$ $_opt:pb$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; e = cvalue_binding -> <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> if Pcaml.unvala ov then Ploc.raise loc (Stream.Error "virtual value cannot override") else <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual $_lid:l$ : $t$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> <:class_type< $id$ [ $list:tl$ ] >> | "object"; cst = V (OPT class_self_type); csf = V (LIST0 class_sig_item); "end" -> <:class_type< object $_opt:cst$ $_list:csf$ end >> ] | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] | [ i = V LIDENT -> <:class_type< $_id: i$ >> | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual $_lid:l$ : $t$ >> | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method private $_lid:l$ : $t$ >> | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method $_lid:l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; ":"; ct = class_type -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; "="; cs = class_signature -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = V field_expr_list "list"; ">}" -> <:expr< {< $_list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = V class_longident "list" -> <:ctyp< # $_list:id$ >> | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> <:ctyp< < $_list:ml$ $_flag:v$ > >> | "<"; ".."; ">" -> <:ctyp< < .. > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; ml = SELF -> [f :: ml] | f = field; ";" -> [f] | f = field -> [f] ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> <:ctyp< type $list:nt$ . $ct$ >> | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: AFTER "arrow" [ NONA [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ = $_list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ > $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ < $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; ntl = V (LIST1 name_tag); "]" -> <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] ; poly_variant: [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); l = V (LIST1 ctyp SEP "&") -> <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> | t = ctyp -> <:poly_variant< $t$ >> ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] ; expr: AFTER "apply" [ "label" [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] ; fun_def: [ [ p = labeled_patt; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; patt: LEVEL "simple" [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> | p = labeled_patt -> p ] ] ; labeled_patt: [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> <:patt< ~{$_:i$ = $p$} >> | i = V TILDEIDENT -> <:patt< ~{$_:i$} >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~{$lid:i$} >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~{$lid:i$ : $t$} >> | i = V QUESTIONIDENTCOLON; j = LIDENT -> <:patt< ?{$_:i$ = ?{$lid:j$}} >> | i = V QUESTIONIDENTCOLON; "_" -> <:patt< ?{$_:i$} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> <:patt< ?{$_:i$ = ?{$p$}} >> | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ?{$lid:i$ = $e$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$lid:i$ : $t$ = $e$} >> | "?"; "("; i = LIDENT; ")" -> <:patt< ?{$lid:i$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ?{$lid:i$ : $t$} >> ] ] ; class_type: [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ~$i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_fun_def: [ [ p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $lid:n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $lid:n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; (* ------------------------------------------------------------------------- *) (* Added by JRH *** *) (* ------------------------------------------------------------------------- *) EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pa_j_3.1x_6.02.2.ml000066400000000000000000002751111303454263000155750ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* New version. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: pa_o.ml,v 6.33 2010-11-16 16:48:21 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_extend.cmo"; #load "q_MLast.cmo"; #load "pa_reloc.cmo"; open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* ------------------------------------------------------------------------- *) (* The main/reloc.ml file. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: reloc.ml,v 6.19 2011-02-17 10:20:50 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_macro.cmo"; open MLast; value option_map f = fun [ Some x -> Some (f x) | None -> None ] ; value vala_map f = IFNDEF STRICT THEN fun x -> f x ELSE fun [ Ploc.VaAnt s -> Ploc.VaAnt s | Ploc.VaVal x -> Ploc.VaVal (f x) ] END ; value class_infos_map floc f x = {ciLoc = floc x.ciLoc; ciVir = x.ciVir; ciPrm = let (x1, x2) = x.ciPrm in (floc x1, x2); ciNam = x.ciNam; ciExp = f x.ciExp} ; value anti_loc qloc sh loc loc1 = (* ...<:reloc_expr<.....$lid:...xxxxxxxx...$...>>... |..|-----------------------------------| qloc <-----> sh |.........|------------| loc |..|------| loc1 *) let sh1 = Ploc.first_pos qloc + sh in let sh2 = sh1 + Ploc.first_pos loc in let line_nb_qloc = Ploc.line_nb qloc in let line_nb_loc = Ploc.line_nb loc in let line_nb_loc1 = Ploc.line_nb loc1 in if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then Ploc.make_unlined (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) else Ploc.make_loc (Ploc.file_name loc) (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) (if line_nb_loc1 = 1 then if line_nb_loc = 1 then Ploc.bol_pos qloc else sh1 + Ploc.bol_pos loc else sh2 + Ploc.bol_pos loc1) (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" ; value rec reloc_ctyp floc sh = self where rec self = fun [ TyAcc loc x1 x2 → let loc = floc loc in TyAcc loc (self x1) (self x2) | TyAli loc x1 x2 → let loc = floc loc in TyAli loc (self x1) (self x2) | TyAny loc → let loc = floc loc in TyAny loc | TyApp loc x1 x2 → let loc = floc loc in TyApp loc (self x1) (self x2) | TyArr loc x1 x2 → let loc = floc loc in TyArr loc (self x1) (self x2) | TyCls loc x1 → let loc = floc loc in TyCls loc x1 | TyLab loc x1 x2 → let loc = floc loc in TyLab loc x1 (self x2) | TyLid loc x1 → let loc = floc loc in TyLid loc x1 | TyMan loc x1 x2 x3 → let loc = floc loc in TyMan loc (self x1) x2 (self x3) | TyObj loc x1 x2 → let loc = floc loc in TyObj loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) x2 | TyOlb loc x1 x2 → let loc = floc loc in TyOlb loc x1 (self x2) | TyPck loc x1 → let loc = floc loc in TyPck loc (reloc_module_type floc sh x1) | TyPol loc x1 x2 → let loc = floc loc in TyPol loc x1 (self x2) | TyPot loc x1 x2 → let loc = floc loc in TyPot loc x1 (self x2) | TyQuo loc x1 → let loc = floc loc in TyQuo loc x1 | TyRec loc x1 → let loc = floc loc in TyRec loc (vala_map (List.map (fun (loc, x1, x2, x3) → (floc loc, x1, x2, self x3))) x1) | TySum loc x1 → let loc = floc loc in TySum loc (vala_map (List.map (fun (loc, x1, x2, x3) → (floc loc, x1, vala_map (List.map self) x2, option_map self x3))) x1) | TyTup loc x1 → let loc = floc loc in TyTup loc (vala_map (List.map self) x1) | TyUid loc x1 → let loc = floc loc in TyUid loc x1 | TyVrn loc x1 x2 → let loc = floc loc in TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 | TyXtr loc x1 x2 → let loc = floc loc in TyXtr loc x1 (option_map (vala_map self) x2) ] and reloc_poly_variant floc sh = fun [ PvTag loc x1 x2 x3 → let loc = floc loc in PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) | PvInh loc x1 → let loc = floc loc in PvInh loc (reloc_ctyp floc sh x1) ] and reloc_patt floc sh = self where rec self = fun [ PaAcc loc x1 x2 → let loc = floc loc in PaAcc loc (self x1) (self x2) | PaAli loc x1 x2 → let loc = floc loc in PaAli loc (self x1) (self x2) | PaAnt loc x1 → let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_patt new_floc sh x1 | PaAny loc → let loc = floc loc in PaAny loc | PaApp loc x1 x2 → let loc = floc loc in PaApp loc (self x1) (self x2) | PaArr loc x1 → let loc = floc loc in PaArr loc (vala_map (List.map self) x1) | PaChr loc x1 → let loc = floc loc in PaChr loc x1 | PaFlo loc x1 → let loc = floc loc in PaFlo loc x1 | PaInt loc x1 x2 → let loc = floc loc in PaInt loc x1 x2 | PaLab loc x1 → let loc = floc loc in PaLab loc (vala_map (List.map (fun (x1, x2) → (self x1, vala_map (option_map self) x2))) x1) | PaLaz loc x1 → let loc = floc loc in PaLaz loc (self x1) | PaLid loc x1 → let loc = floc loc in PaLid loc x1 | PaNty loc x1 → let loc = floc loc in PaNty loc x1 | PaOlb loc x1 x2 → let loc = floc loc in PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) | PaOrp loc x1 x2 → let loc = floc loc in PaOrp loc (self x1) (self x2) | PaRec loc x1 → let loc = floc loc in PaRec loc (vala_map (List.map (fun (x1, x2) → (self x1, self x2))) x1) | PaRng loc x1 x2 → let loc = floc loc in PaRng loc (self x1) (self x2) | PaStr loc x1 → let loc = floc loc in PaStr loc x1 | PaTup loc x1 → let loc = floc loc in PaTup loc (vala_map (List.map self) x1) | PaTyc loc x1 x2 → let loc = floc loc in PaTyc loc (self x1) (reloc_ctyp floc sh x2) | PaTyp loc x1 → let loc = floc loc in PaTyp loc x1 | PaUid loc x1 → let loc = floc loc in PaUid loc x1 | PaUnp loc x1 x2 → let loc = floc loc in PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) | PaVrn loc x1 → let loc = floc loc in PaVrn loc x1 | PaXtr loc x1 x2 → let loc = floc loc in PaXtr loc x1 (option_map (vala_map self) x2) ] and reloc_expr floc sh = self where rec self = fun [ ExAcc loc x1 x2 → let loc = floc loc in ExAcc loc (self x1) (self x2) | ExAnt loc x1 → let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_expr new_floc sh x1 | ExApp loc x1 x2 → let loc = floc loc in ExApp loc (self x1) (self x2) | ExAre loc x1 x2 → let loc = floc loc in ExAre loc (self x1) (self x2) | ExArr loc x1 → let loc = floc loc in ExArr loc (vala_map (List.map self) x1) | ExAsr loc x1 → let loc = floc loc in ExAsr loc (self x1) | ExAss loc x1 x2 → let loc = floc loc in ExAss loc (self x1) (self x2) | ExBae loc x1 x2 → let loc = floc loc in ExBae loc (self x1) (vala_map (List.map self) x2) | ExChr loc x1 → let loc = floc loc in ExChr loc x1 | ExCoe loc x1 x2 x3 → let loc = floc loc in ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) | ExFlo loc x1 → let loc = floc loc in ExFlo loc x1 | ExFor loc x1 x2 x3 x4 x5 → let loc = floc loc in ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) | ExFun loc x1 → let loc = floc loc in ExFun loc (vala_map (List.map (fun (x1, x2, x3) → (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x1) | ExIfe loc x1 x2 x3 → let loc = floc loc in ExIfe loc (self x1) (self x2) (self x3) | ExInt loc x1 x2 → let loc = floc loc in ExInt loc x1 x2 | ExLab loc x1 → let loc = floc loc in ExLab loc (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, vala_map (option_map self) x2))) x1) | ExLaz loc x1 → let loc = floc loc in ExLaz loc (self x1) | ExLet loc x1 x2 x3 → let loc = floc loc in ExLet loc x1 (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x2) (self x3) | ExLid loc x1 → let loc = floc loc in ExLid loc x1 | ExLmd loc x1 x2 x3 → let loc = floc loc in ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) | ExMat loc x1 x2 → let loc = floc loc in ExMat loc (self x1) (vala_map (List.map (fun (x1, x2, x3) → (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExNew loc x1 → let loc = floc loc in ExNew loc x1 | ExObj loc x1 x2 → let loc = floc loc in ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | ExOlb loc x1 x2 → let loc = floc loc in ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) | ExOvr loc x1 → let loc = floc loc in ExOvr loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) | ExPck loc x1 x2 → let loc = floc loc in ExPck loc (reloc_module_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | ExRec loc x1 x2 → let loc = floc loc in ExRec loc (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x1) (option_map self x2) | ExSeq loc x1 → let loc = floc loc in ExSeq loc (vala_map (List.map self) x1) | ExSnd loc x1 x2 → let loc = floc loc in ExSnd loc (self x1) x2 | ExSte loc x1 x2 → let loc = floc loc in ExSte loc (self x1) (self x2) | ExStr loc x1 → let loc = floc loc in ExStr loc x1 | ExTry loc x1 x2 → let loc = floc loc in ExTry loc (self x1) (vala_map (List.map (fun (x1, x2, x3) → (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExTup loc x1 → let loc = floc loc in ExTup loc (vala_map (List.map self) x1) | ExTyc loc x1 x2 → let loc = floc loc in ExTyc loc (self x1) (reloc_ctyp floc sh x2) | ExUid loc x1 → let loc = floc loc in ExUid loc x1 | ExVrn loc x1 → let loc = floc loc in ExVrn loc x1 | ExWhi loc x1 x2 → let loc = floc loc in ExWhi loc (self x1) (vala_map (List.map self) x2) | ExXtr loc x1 x2 → let loc = floc loc in ExXtr loc x1 (option_map (vala_map self) x2) ] and reloc_module_type floc sh = self where rec self = fun [ MtAcc loc x1 x2 → let loc = floc loc in MtAcc loc (self x1) (self x2) | MtApp loc x1 x2 → let loc = floc loc in MtApp loc (self x1) (self x2) | MtFun loc x1 x2 x3 → let loc = floc loc in MtFun loc x1 (self x2) (self x3) | MtLid loc x1 → let loc = floc loc in MtLid loc x1 | MtQuo loc x1 → let loc = floc loc in MtQuo loc x1 | MtSig loc x1 → let loc = floc loc in MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) | MtTyo loc x1 → let loc = floc loc in MtTyo loc (reloc_module_expr floc sh x1) | MtUid loc x1 → let loc = floc loc in MtUid loc x1 | MtWit loc x1 x2 → let loc = floc loc in MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) | MtXtr loc x1 x2 → let loc = floc loc in MtXtr loc x1 (option_map (vala_map self) x2) ] and reloc_sig_item floc sh = self where rec self = fun [ SgCls loc x1 → let loc = floc loc in SgCls loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgClt loc x1 → let loc = floc loc in SgClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgDcl loc x1 → let loc = floc loc in SgDcl loc (vala_map (List.map self) x1) | SgDir loc x1 x2 → let loc = floc loc in SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | SgExc loc x1 x2 → let loc = floc loc in SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | SgExt loc x1 x2 x3 → let loc = floc loc in SgExt loc x1 (reloc_ctyp floc sh x2) x3 | SgInc loc x1 → let loc = floc loc in SgInc loc (reloc_module_type floc sh x1) | SgMod loc x1 x2 → let loc = floc loc in SgMod loc x1 (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_type floc sh x2))) x2) | SgMty loc x1 x2 → let loc = floc loc in SgMty loc x1 (reloc_module_type floc sh x2) | SgOpn loc x1 → let loc = floc loc in SgOpn loc x1 | SgTyp loc x1 → let loc = floc loc in SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | SgUse loc x1 x2 → let loc = floc loc in SgUse loc x1 (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) | SgVal loc x1 x2 → let loc = floc loc in SgVal loc x1 (reloc_ctyp floc sh x2) | SgXtr loc x1 x2 → let loc = floc loc in SgXtr loc x1 (option_map (vala_map self) x2) ] and reloc_with_constr floc sh = fun [ WcMod loc x1 x2 → let loc = floc loc in WcMod loc x1 (reloc_module_expr floc sh x2) | WcMos loc x1 x2 → let loc = floc loc in WcMos loc x1 (reloc_module_expr floc sh x2) | WcTyp loc x1 x2 x3 x4 → let loc = floc loc in WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) | WcTys loc x1 x2 x3 → let loc = floc loc in WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_module_expr floc sh = self where rec self = fun [ MeAcc loc x1 x2 → let loc = floc loc in MeAcc loc (self x1) (self x2) | MeApp loc x1 x2 → let loc = floc loc in MeApp loc (self x1) (self x2) | MeFun loc x1 x2 x3 → let loc = floc loc in MeFun loc x1 (reloc_module_type floc sh x2) (self x3) | MeStr loc x1 → let loc = floc loc in MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) | MeTyc loc x1 x2 → let loc = floc loc in MeTyc loc (self x1) (reloc_module_type floc sh x2) | MeUid loc x1 → let loc = floc loc in MeUid loc x1 | MeUnp loc x1 x2 → let loc = floc loc in MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | MeXtr loc x1 x2 → let loc = floc loc in MeXtr loc x1 (option_map (vala_map self) x2) ] and reloc_str_item floc sh = self where rec self = fun [ StCls loc x1 → let loc = floc loc in StCls loc (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) | StClt loc x1 → let loc = floc loc in StClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | StDcl loc x1 → let loc = floc loc in StDcl loc (vala_map (List.map self) x1) | StDir loc x1 x2 → let loc = floc loc in StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | StExc loc x1 x2 x3 → let loc = floc loc in StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 | StExp loc x1 → let loc = floc loc in StExp loc (reloc_expr floc sh x1) | StExt loc x1 x2 x3 → let loc = floc loc in StExt loc x1 (reloc_ctyp floc sh x2) x3 | StInc loc x1 → let loc = floc loc in StInc loc (reloc_module_expr floc sh x1) | StMod loc x1 x2 → let loc = floc loc in StMod loc x1 (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_expr floc sh x2))) x2) | StMty loc x1 x2 → let loc = floc loc in StMty loc x1 (reloc_module_type floc sh x2) | StOpn loc x1 → let loc = floc loc in StOpn loc x1 | StTyp loc x1 → let loc = floc loc in StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | StUse loc x1 x2 → let loc = floc loc in StUse loc x1 (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) | StVal loc x1 x2 → let loc = floc loc in StVal loc x1 (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) | StXtr loc x1 x2 → let loc = floc loc in StXtr loc x1 (option_map (vala_map self) x2) ] and reloc_type_decl floc sh x = {tdNam = vala_map (fun (loc, x1) → (floc loc, x1)) x.tdNam; tdPrm = x.tdPrm; tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; tdCon = vala_map (List.map (fun (x1, x2) → (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) x.tdCon} and reloc_class_type floc sh = self where rec self = fun [ CtAcc loc x1 x2 → let loc = floc loc in CtAcc loc (self x1) (self x2) | CtApp loc x1 x2 → let loc = floc loc in CtApp loc (self x1) (self x2) | CtCon loc x1 x2 → let loc = floc loc in CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) | CtFun loc x1 x2 → let loc = floc loc in CtFun loc (reloc_ctyp floc sh x1) (self x2) | CtIde loc x1 → let loc = floc loc in CtIde loc x1 | CtSig loc x1 x2 → let loc = floc loc in CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) (vala_map (List.map (reloc_class_sig_item floc sh)) x2) | CtXtr loc x1 x2 → let loc = floc loc in CtXtr loc x1 (option_map (vala_map self) x2) ] and reloc_class_sig_item floc sh = self where rec self = fun [ CgCtr loc x1 x2 → let loc = floc loc in CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CgDcl loc x1 → let loc = floc loc in CgDcl loc (vala_map (List.map self) x1) | CgInh loc x1 → let loc = floc loc in CgInh loc (reloc_class_type floc sh x1) | CgMth loc x1 x2 x3 → let loc = floc loc in CgMth loc x1 x2 (reloc_ctyp floc sh x3) | CgVal loc x1 x2 x3 → let loc = floc loc in CgVal loc x1 x2 (reloc_ctyp floc sh x3) | CgVir loc x1 x2 x3 → let loc = floc loc in CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_class_expr floc sh = self where rec self = fun [ CeApp loc x1 x2 → let loc = floc loc in CeApp loc (self x1) (reloc_expr floc sh x2) | CeCon loc x1 x2 → let loc = floc loc in CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | CeFun loc x1 x2 → let loc = floc loc in CeFun loc (reloc_patt floc sh x1) (self x2) | CeLet loc x1 x2 x3 → let loc = floc loc in CeLet loc x1 (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) (self x3) | CeStr loc x1 x2 → let loc = floc loc in CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | CeTyc loc x1 x2 → let loc = floc loc in CeTyc loc (self x1) (reloc_class_type floc sh x2) | CeXtr loc x1 x2 → let loc = floc loc in CeXtr loc x1 (option_map (vala_map self) x2) ] and reloc_class_str_item floc sh = self where rec self = fun [ CrCtr loc x1 x2 → let loc = floc loc in CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CrDcl loc x1 → let loc = floc loc in CrDcl loc (vala_map (List.map self) x1) | CrInh loc x1 x2 → let loc = floc loc in CrInh loc (reloc_class_expr floc sh x1) x2 | CrIni loc x1 → let loc = floc loc in CrIni loc (reloc_expr floc sh x1) | CrMth loc x1 x2 x3 x4 x5 → let loc = floc loc in CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) (reloc_expr floc sh x5) | CrVal loc x1 x2 x3 x4 → let loc = floc loc in CrVal loc x1 x2 x3 (reloc_expr floc sh x4) | CrVav loc x1 x2 x3 → let loc = floc loc in CrVav loc x1 x2 (reloc_ctyp floc sh x3) | CrVir loc x1 x2 x3 → let loc = floc loc in CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] ; (* Equality over syntax trees *) value eq_expr x y = reloc_expr (fun _ -> Ploc.dummy) 0 x = reloc_expr (fun _ -> Ploc.dummy) 0 y ; value eq_patt x y = reloc_patt (fun _ -> Ploc.dummy) 0 x = reloc_patt (fun _ -> Ploc.dummy) 0 y ; value eq_ctyp x y = reloc_ctyp (fun _ -> Ploc.dummy) 0 x = reloc_ctyp (fun _ -> Ploc.dummy) 0 y ; value eq_str_item x y = reloc_str_item (fun _ -> Ploc.dummy) 0 x = reloc_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_sig_item x y = reloc_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_module_expr x y = reloc_module_expr (fun _ -> Ploc.dummy) 0 x = reloc_module_expr (fun _ -> Ploc.dummy) 0 y ; value eq_module_type x y = reloc_module_type (fun _ -> Ploc.dummy) 0 x = reloc_module_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_sig_item x y = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_class_str_item x y = reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = reloc_class_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_reloc_class_type x y = reloc_class_type (fun _ -> Ploc.dummy) 0 x = reloc_class_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_expr x y = reloc_class_expr (fun _ -> Ploc.dummy) 0 x = reloc_class_expr (fun _ -> Ploc.dummy) 0 y ; (* ------------------------------------------------------------------------- *) (* Now the lexer. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: plexer.ml,v 6.11 2010-10-04 20:14:58 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_lexer.cmo"; (* ------------------------------------------------------------------------- *) (* Added by JRH as a backdoor to change lexical conventions. *) (* ------------------------------------------------------------------------- *) value jrh_lexer = ref False; open Versdep; value no_quotations = ref False; value error_on_unknown_keywords = ref False; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value force_antiquot_loc = ref False; type context = { after_space : mutable bool; dollar_for_antiquotation : bool; specific_space_dot : bool; find_kwd : string -> string; line_cnt : int -> char -> unit; set_line_nb : unit -> unit; make_lined_loc : (int * int) -> string -> Ploc.t } ; value err ctx loc msg = Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) ; (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) (***** JRH: Carl's alternative version then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; *****) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) value keyword_or_error ctx loc s = try ("", ctx.find_kwd s) with [ Not_found -> if error_on_unknown_keywords.val then err ctx loc ("illegal token: " ^ s) else ("", s) ] ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value utf8_lexing = ref False; value misc_letter buf strm = if utf8_lexing.val then match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] else match strm with lexer [ '\128'-'\255' ] ; value misc_punct buf strm = if utf8_lexing.val then match strm with lexer [ '\226' _ _ ] else match strm with parser [] ; value rec ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] ; value rec ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] ident2! | ] ; value rec ident3 = lexer [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' | '\128'-'\255' ] ident3! | ] ; value binary = lexer [ '0' | '1' ]; value octal = lexer [ '0'-'7' ]; value decimal = lexer [ '0'-'9' ]; value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; value end_integer = lexer [ "l"/ -> ("INT_l", $buf) | "L"/ -> ("INT_L", $buf) | "n"/ -> ("INT_n", $buf) | -> ("INT", $buf) ] ; value rec digits_under kind = lexer [ kind (digits_under kind)! | "_" (digits_under kind)! | end_integer ] ; value digits kind = lexer [ kind (digits_under kind)! | -> raise (Stream.Error "ill-formed integer constant") ] ; value rec decimal_digits_under = lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] ; value exponent_part = lexer [ [ 'e' | 'E' ] [ '+' | '-' | ] '0'-'9' ? "ill-formed floating-point constant" decimal_digits_under! ] ; value number = lexer [ decimal_digits_under "." decimal_digits_under! exponent_part -> ("FLOAT", $buf) | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) | decimal_digits_under exponent_part -> ("FLOAT", $buf) | decimal_digits_under end_integer! ] ; value char_after_bslash = lexer [ "'"/ | _ [ "'"/ | _ [ "'"/ | ] ] ] ; value char ctx bp = lexer [ "\\" _ char_after_bslash! | "\\" -> err ctx (bp, $pos) "char not terminated" | ?= [ _ '''] _! "'"/ ] ; value any ctx buf = parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } ; value rec string ctx bp = lexer [ "\""/ | "\\" (any ctx) (string ctx bp)! | (any ctx) (string ctx bp)! | -> err ctx (bp, $pos) "string not terminated" ] ; value rec qstring ctx bp = lexer [ "`"/ | (any ctx) (qstring ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value comment ctx bp = comment where rec comment = lexer [ "*)" | "*" comment! | "(*" comment! comment! | "(" comment! | "\"" (string ctx bp)! [ -> $add "\"" ] comment! | "'*)" | "'*" comment! | "'" (any ctx) comment! | (any ctx) comment! | -> err ctx (bp, $pos) "comment not terminated" ] ; value rec quotation ctx bp = lexer [ ">>"/ | ">" (quotation ctx bp)! | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! (quotation ctx bp)! | "<" (quotation ctx bp)! | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! | "\\" (quotation ctx bp)! | (any ctx) (quotation ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value less_expected = "character '<' expected"; value less ctx bp buf strm = if no_quotations.val then match strm with lexer [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] else match strm with lexer [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value rec antiquot_rest ctx bp = lexer [ "$"/ | "\\"/ (any ctx) (antiquot_rest ctx bp)! | (any ctx) (antiquot_rest ctx bp)! | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value rec antiquot ctx bp = lexer [ "$"/ -> ":" ^ $buf | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! | ":" (antiquot_rest ctx bp)! -> $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; value rec antiquot_loc ctx bp = lexer [ "$"/ -> antiloc bp $pos (":" ^ $buf) | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value dollar ctx bp buf strm = if not no_quotations.val && ctx.dollar_for_antiquotation then ("ANTIQUOT", antiquot ctx bp buf strm) else if force_antiquot_loc.val then ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) else match strm with lexer [ [ -> $add "$" ] ident2! -> ("", $buf) ] ; (* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?abc:d ?abc ?$abc:d$: ?abc:d: ?abc: ?$d$ ?:d ? ?$d$: ?:d: ?: *) (* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?8,13:abc:d ?abc ?$abc:d$: ?8,13:abc:d: ?abc: ?$d$ ?8,9::d ? ?$d$: ?8,9::d: ?: *) value question ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "?" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "?" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tilde ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "~" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "~" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tildeident = lexer [ ":"/ -> ("TILDEIDENTCOLON", $buf) | -> ("TILDEIDENT", $buf) ] ; value questionident = lexer [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) | -> ("QUESTIONIDENT", $buf) ] ; value rec linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> False ] and linedir_digits n s = match stream_peek_nth n s with [ Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> linedir_quote n s ] and linedir_quote n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir_quote (n + 1) s | Some '"' -> True | _ -> False ] ; value rec any_to_nl = lexer [ "\r" | "\n" | _ any_to_nl! | ] ; value next_token_after_spaces ctx bp = lexer [ 'A'-'Z' ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] *********) | [ 'a'-'z' | '_' | misc_letter ] ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! | "0" [ 'b' | 'B' ] (digits binary)! | "0" number! | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" | "'"/ (char ctx bp) -> ("CHAR", $buf) | "'" -> keyword_or_error ctx (bp, $pos) "'" | "\""/ (string ctx bp)! -> ("STRING", $buf) (*** Line added by JRH ***) | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) | "$"/ (dollar ctx bp)! | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> keyword_or_error ctx (bp, $pos) $buf | "~"/ 'a'-'z' ident! tildeident! | "~"/ '_' ident! tildeident! | "~" (tilde ctx bp) | "?"/ 'a'-'z' ident! questionident! | "?" (question ctx bp)! | "<"/ (less ctx bp)! | ":]" -> keyword_or_error ctx (bp, $pos) $buf | "::" -> keyword_or_error ctx (bp, $pos) $buf | ":=" -> keyword_or_error ctx (bp, $pos) $buf | ":>" -> keyword_or_error ctx (bp, $pos) $buf | ":" -> keyword_or_error ctx (bp, $pos) $buf | ">]" -> keyword_or_error ctx (bp, $pos) $buf | ">}" -> keyword_or_error ctx (bp, $pos) $buf | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "|]" -> keyword_or_error ctx (bp, $pos) $buf | "|}" -> keyword_or_error ctx (bp, $pos) $buf | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "[|" -> keyword_or_error ctx (bp, $pos) $buf | "[<" -> keyword_or_error ctx (bp, $pos) $buf | "[:" -> keyword_or_error ctx (bp, $pos) $buf | "[" -> keyword_or_error ctx (bp, $pos) $buf | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "{|" -> keyword_or_error ctx (bp, $pos) $buf | "{<" -> keyword_or_error ctx (bp, $pos) $buf | "{:" -> keyword_or_error ctx (bp, $pos) $buf | "{" -> keyword_or_error ctx (bp, $pos) $buf | ".." -> keyword_or_error ctx (bp, $pos) ".." | "." -> let id = if ctx.specific_space_dot && ctx.after_space then " ." else "." in keyword_or_error ctx (bp, $pos) id | ";;" -> keyword_or_error ctx (bp, $pos) ";;" | ";" -> keyword_or_error ctx (bp, $pos) ";" | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf | "\\"/ ident3! -> ("LIDENT", $buf) | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] ; value get_comment buf strm = $buf; value rec next_token ctx buf = parser bp [ [: `('\n' | '\r' as c); s :] ep -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := ep; ctx.set_line_nb (); ctx.after_space := True; next_token ctx ($add c) s } | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { ctx.after_space := True; next_token ctx ($add c) s } | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> let comm = get_comment buf () in if linedir 1 s then do { let buf = any_to_nl ($add '#') s in incr Plexing.line_nb.val; Plexing.bol_pos.val.val := Stream.count s; ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } else let loc = ctx.make_lined_loc (bp, bp + 1) comm in (keyword_or_error ctx (bp, bp + 1) "#", loc) | [: `'('; a = parser [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } | [: :] ep -> let loc = ctx.make_lined_loc (bp, ep) $buf in (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a | [: comm = get_comment buf; tok = next_token_after_spaces ctx bp $empty :] ep -> let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in (tok, loc) | [: comm = get_comment buf; _ = Stream.empty :] -> let loc = ctx.make_lined_loc (bp, bp + 1) comm in (("EOI", ""), loc) ] ; value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = try do { match Plexing.restore_lexing_info.val with [ Some (line_nb, bol_pos) -> do { s_line_nb.val := line_nb; s_bol_pos.val := bol_pos; Plexing.restore_lexing_info.val := None; } | None -> () ]; Plexing.line_nb.val := s_line_nb; Plexing.bol_pos.val := s_bol_pos; let comm_bp = Stream.count cstrm in ctx.set_line_nb (); ctx.after_space := False; let (r, loc) = next_token ctx $empty cstrm in match glexr.val.Plexing.tok_comm with [ Some list -> if Ploc.first_pos loc > comm_bp then let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in glexr.val.Plexing.tok_comm := Some [comm_loc :: list] else () | None -> () ]; (r, loc) } with [ Stream.Error str -> err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] ; value func kwd_table glexr = let ctx = let line_nb = ref 0 in let bol_pos = ref 0 in {after_space = False; dollar_for_antiquotation = dollar_for_antiquotation.val; specific_space_dot = specific_space_dot.val; find_kwd = Hashtbl.find kwd_table; line_cnt bp1 c = match c with [ '\n' | '\r' -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := bp1 + 1; } | c -> () ]; set_line_nb () = do { line_nb.val := Plexing.line_nb.val.val; bol_pos.val := Plexing.bol_pos.val.val; }; make_lined_loc loc comm = Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} in Plexing.lexer_func_of_parser (next_token_fun ctx glexr) ; value rec check_keyword_stream = parser [: _ = check $empty; _ = Stream.empty :] -> True and check = lexer [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ] check_ident2! | "$" check_ident2! | "<" ?= [ ":" | "<" ] | "<" check_ident2! | ":]" | "::" | ":=" | ":>" | ":" | ">]" | ">}" | ">" check_ident2! | "|]" | "|}" | "|" check_ident2! | "[" ?= [ "<<" | "<:" ] | "[|" | "[<" | "[:" | "[" | "{" ?= [ "<<" | "<:" ] | "{|" | "{<" | "{:" | "{" | ";;" | ";" | misc_punct check_ident2! | _ ] and check_ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] check_ident! | ] and check_ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | misc_punct ] check_ident2! | ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Plexing.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Plexing.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (hashtbl_mem kwd_table p_prm) then if check_keyword p_prm then if hashtbl_mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | "CHAR" | "STRING" | "QUOTATION" | "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> () | _ -> raise (Plexing.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT", s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value after_colon_except_last e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 2) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then if p_prm.[String.length p_prm - 1] = ':' then let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then if eq_before_colon p_prm prm then after_colon_except_last prm else raise Stream.Failure else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then raise Stream.Failure else if eq_before_colon p_prm prm then after_colon prm else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Plexing.default_match tok ] ; value gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let glex = {Plexing.tok_func = func kwd_table glexr; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; glex } ; (* ------------------------------------------------------------------------- *) (* Back to etc/pa_o.ml *) (* ------------------------------------------------------------------------- *) do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; Grammar.Unsafe.gram_reinit gram (gmake ()); dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry signature; Grammar.Unsafe.clear_entry structure; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_decl; Grammar.Unsafe.clear_entry constructor_declaration; Grammar.Unsafe.clear_entry label_declaration; Grammar.Unsafe.clear_entry match_case; Grammar.Unsafe.clear_entry with_constr; Grammar.Unsafe.clear_entry poly_variant; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value mklistexp loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = do { let ct = Hashtbl.create 73 in List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] }; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value check_not_part_of_patt = Grammar.Entry.of_parser gram "check_not_part_of_patt" (fun strm -> let tok = match Stream.npeek 4 strm with [ [("LIDENT", _); tok :: _] -> tok | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok | _ -> raise Stream.Failure ] in match tok with [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure | _ -> () ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in loop where rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"; "?!"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && (x = "$" || String.length x >= 2) && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("ANTIQUOT_LOC", _) -> () | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value e_phony = Grammar.Entry.of_parser gram "e_phony" (parser []) ; value p_phony = Grammar.Entry.of_parser gram "p_phony" (parser []) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e | _ -> 1 ] ; value rec constr_patt_arity loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value mem_tvar s tpl = List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl ; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if mem_tvar s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if mem_tvar v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; value quotation_content s = do { loop 0 where rec loop i = if i = String.length s then ("", s) else if s.[i] = ':' || s.[i] = '@' then let i = i + 1 in (String.sub s 0 i, String.sub s i (String.length s - i)) else loop (i + 1) }; value concat_comm loc e = let loc = Ploc.with_comment loc (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) in let floc = let first = ref True in fun loc1 -> if first.val then do {first.val := False; loc} else loc1 in reloc_expr floc 0 e ; EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr signature structure class_type class_expr class_sig_item class_str_item let_binding type_decl constructor_declaration label_declaration match_case with_constr poly_variant; module_expr: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> | "struct"; st = structure; "end" -> <:module_expr< struct $_list:st$ end >> ] | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; "val"; e = expr; ":"; mt = module_type; ")" -> <:module_expr< (value $e$ : $mt$) >> | "("; "val"; e = expr; ")" -> <:module_expr< (value $e$) >> | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; structure: [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration; b = rebind_exn -> <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> <:str_item< module $_flag:r$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:str_item< module type $_uid:i$ = $mt$ >> | "open"; i = V mod_ident "list" "" -> <:str_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:str_item< type $_list:tdl$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr -> let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> match l with [ <:vala< [(p, e)] >> -> match p with [ <:patt< _ >> -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> <:str_item< let module $_uid:m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = V mod_ident "list" -> sl | -> <:vala< [] >> ] ] ; mod_binding: [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] ; mod_fun_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> <:module_type< $mt$ with $_list:wcl$ >> ] | [ "sig"; sg = signature; "end" -> <:module_type< sig $_list:sg$ end >> | "module"; "type"; "of"; me = module_expr -> <:module_type< module type of $me$ >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; signature: [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = V UIDENT -> <:module_type< $_uid:m$ >> | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration -> <:sig_item< exception $_uid:c$ of $_list:tl$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; rf = V (FLAG "rec"); l = V (LIST1 mod_decl_binding SEP "and") -> <:sig_item< module $_flag:rf$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:sig_item< module type $_uid:i$ = $mt$ >> | "module"; "type"; i = V UIDENT "uid" "" -> <:sig_item< module type $_uid:i$ = 'abstract >> | "open"; i = V mod_ident "list" "" -> <:sig_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:sig_item< type $_list:tdl$ >> | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> <:sig_item< value $_lid:i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $lid:i$ : $t$ >> ] ] ; mod_decl_binding: [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; pf = V (FLAG "private"); t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> | "module"; i = V mod_ident ""; "="; me = module_expr -> <:with_constr< module $_:i$ = $me$ >> | "module"; i = V mod_ident ""; ":="; me = module_expr -> <:with_constr< module $_:i$ := $me$ >> ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] | "expr1" [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr LEVEL "top" -> <:expr< let $_flag:o$ $_list:l$ in $x$ >> | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $_uid:m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< fun [ $_list:l$ ] >> | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> <:expr< fun [$p$ $opt:eo$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< match $e$ with [ $_list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< try $e$ with [ $_list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; e2 = SELF; "do"; e = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e in <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e2 in <:expr< while $e1$ do { $_list:el$ } >> ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< - $e$ >> | "-."; e = SELF -> <:expr< -. $e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> let (e1, e2) = if is_expr_constr_call e1 then match e1 with [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) | _ -> (e1, e2) ] else (e1, e2) in match constr_expr_arity loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> <:expr< assert $e$ >> | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; op = operator_rparen -> <:expr< $e1$ .( $lid:op$ ) >> | e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> <:expr< $e$ .{ $_list:el$ } >> | e1 = SELF; "."; e2 = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop e1 e2 ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val >> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = V INT -> <:expr< $_int:s$ >> | s = V INT_l -> <:expr< $_int32:s$ >> | s = V INT_L -> <:expr< $_int64:s$ >> | s = V INT_n -> <:expr< $_nativeint:s$ >> | s = V FLOAT -> <:expr< $_flo:s$ >> | s = V STRING -> <:expr< $_str:s$ >> | c = V CHAR -> <:expr< $_chr:c$ >> | UIDENT "True" -> <:expr< True_ >> | UIDENT "False" -> <:expr< False_ >> | i = expr_ident -> i | "false" -> <:expr< False >> | "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = V expr1_semi_list "list"; "|]" -> <:expr< [| $_list:el$ |] >> | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> <:expr< { $_list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> <:expr< { ($e$) with $_list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> <:expr< (module $me$ : $mt$) >> | "("; "module"; me = module_expr; ")" -> <:expr< (module $me$) >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_expr_quotation loc con ] ] ; let_binding: [ [ p = val_ident; e = fun_binding -> (p, e) | p = patt; "="; e = expr -> (p, e) | p = patt; ":"; t = poly_type; "="; e = expr -> (<:patt< ($p$ : $t$) >>, e) ] ] ; (*** JRH added the "translate_operator" here ***) val_ident: [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> | check_not_part_of_patt; "("; s = ANY; ")" -> let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] ; fun_binding: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] ; match_case: [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] ; fun_def: [ RIGHTA [ p = patt LEVEL "simple"; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> (eo, <:expr< $e$ >>) ] ] ; expr_ident: [ RIGHTA [ i = V LIDENT -> <:expr< $_lid:i$ >> | i = V UIDENT -> <:expr< $_uid:i$ >> | i = V UIDENT; "."; j = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop <:expr< $_uid:i$ >> j | i = V UIDENT; "."; "("; j = operator_rparen -> <:expr< $_uid:i$ . $lid:j$ >> ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> let (p1, p2) = match p1 with [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) | _ -> (p1, p2) ] in match constr_patt_arity loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ s = V LIDENT -> <:patt< $_lid:s$ >> | s = V UIDENT -> <:patt< $_uid:s$ >> | s = V INT -> <:patt< $_int:s$ >> | s = V INT_l -> <:patt< $_int32:s$ >> | s = V INT_L -> <:patt< $_int64:s$ >> | s = V INT_n -> <:patt< $_nativeint:s$ >> | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = V FLOAT -> <:patt< $_flo:s$ >> | s = V STRING -> <:patt< $_str:s$ >> | s = V CHAR -> <:patt< $_chr:s$ >> | UIDENT "True" -> <:patt< True_ >> | UIDENT "False" -> <:patt< False_ >> | "false" -> <:patt< False >> | "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = V patt_semi_list "list"; "|]" -> <:patt< [| $_list:pl$ |] >> | "{"; lpl = V lbl_patt_list "list"; "}" -> <:patt< { $_list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; ")" -> <:patt< $p$ >> | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> <:patt< (module $_uid:s$ : $mt$) >> | "("; "module"; s = V UIDENT; ")" -> <:patt< (module $_uid:s$) >> | "_" -> <:patt< _ >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_patt_quotation loc con ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_decl: [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); tk = type_kind; cl = V (LIST0 constrain) -> <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> let tk = <:ctyp< '$choose_tvar tpl$ >> in <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] ; type_patt: [ [ n = V LIDENT -> (loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; pf = FLAG "private"; "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> | t = ctyp; "="; pf = FLAG "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> | "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< { $_list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "+"; p = V simple_type_parameter -> (p, Some True) | "-"; p = V simple_type_parameter -> (p, Some False) | p = V simple_type_parameter -> (p, None) ] ] ; simple_type_parameter: [ [ "'"; i = ident -> Some i | "_" -> None ] ] ; constructor_declaration: [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> (loc, ci, cal, None) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); "->"; t = ctyp -> (loc, ci, cal, Some t) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> let t = match cal with [ <:vala< [t] >> -> t | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> | _ -> assert False ] in (loc, ci, <:vala< [] >>, Some t) | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] ; cons_ident: [ [ i = V UIDENT "uid" "" -> i | UIDENT "True" -> <:vala< "True_" >> | UIDENT "False" -> <:vala< "False_" >> ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "apply" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> | "_" -> <:ctyp< _ >> | i = V LIDENT -> <:ctyp< $_lid:i$ >> | i = V UIDENT -> <:ctyp< $_uid:i$ >> | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> <:str_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:str_item< class type $_list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = V (LIST1 class_description SEP "and") -> <:sig_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:sig_item< class type $_list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = patt LEVEL "simple"; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (loc, <:vala< [] >>) | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] ; class_fun_def: [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = patt LEVEL "simple"; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); "in"; ce = SELF -> <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< [ $ct$ ] $list:ci$ >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:class_expr< object $_opt:cspo$ $_list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> <:class_str_item< inherit $ce$ $_opt:pb$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; e = cvalue_binding -> <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> if Pcaml.unvala ov then Ploc.raise loc (Stream.Error "virtual value cannot override") else <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual $_lid:l$ : $t$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> <:class_type< $id$ [ $list:tl$ ] >> | "object"; cst = V (OPT class_self_type); csf = V (LIST0 class_sig_item); "end" -> <:class_type< object $_opt:cst$ $_list:csf$ end >> ] | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] | [ i = V LIDENT -> <:class_type< $_id: i$ >> | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual $_lid:l$ : $t$ >> | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method private $_lid:l$ : $t$ >> | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method $_lid:l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; ":"; ct = class_type -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; "="; cs = class_signature -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = V field_expr_list "list"; ">}" -> <:expr< {< $_list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = V class_longident "list" -> <:ctyp< # $_list:id$ >> | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> <:ctyp< < $_list:ml$ $_flag:v$ > >> | "<"; ".."; ">" -> <:ctyp< < .. > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; ml = SELF -> [f :: ml] | f = field; ";" -> [f] | f = field -> [f] ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> <:ctyp< type $list:nt$ . $ct$ >> | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: AFTER "arrow" [ NONA [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ = $_list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ > $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ < $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; ntl = V (LIST1 name_tag); "]" -> <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] ; poly_variant: [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); l = V (LIST1 ctyp SEP "&") -> <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> | t = ctyp -> <:poly_variant< $t$ >> ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] ; expr: AFTER "apply" [ "label" [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] ; fun_def: [ [ p = labeled_patt; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; patt: LEVEL "simple" [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> | p = labeled_patt -> p ] ] ; labeled_patt: [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> <:patt< ~{$_:i$ = $p$} >> | i = V TILDEIDENT -> <:patt< ~{$_:i$} >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~{$lid:i$} >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~{$lid:i$ : $t$} >> | i = V QUESTIONIDENTCOLON; j = LIDENT -> <:patt< ?{$_:i$ = ?{$lid:j$}} >> | i = V QUESTIONIDENTCOLON; "_" -> <:patt< ?{$_:i$} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> <:patt< ?{$_:i$ = ?{$p$}} >> | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ?{$lid:i$ = $e$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$lid:i$ : $t$ = $e$} >> | "?"; "("; i = LIDENT; ")" -> <:patt< ?{$lid:i$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ?{$lid:i$ : $t$} >> ] ] ; class_type: [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ~$i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_fun_def: [ [ p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $lid:n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $lid:n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; (* ------------------------------------------------------------------------- *) (* Added by JRH *** *) (* ------------------------------------------------------------------------- *) EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pa_j_3.1x_6.11.ml000066400000000000000000003047431303454263000154410ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* New version. *) (* ------------------------------------------------------------------------- *) (* camlp5r pa_macro.cmo *) (* $Id: pa_o.ml,v 6.50 2013-07-02 16:12:43 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2012 *) #load "pa_extend.cmo"; #load "q_MLast.cmo"; #load "pa_reloc.cmo"; open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* ------------------------------------------------------------------------- *) (* The main/reloc.ml file. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: reloc.ml,v 6.26 2012-03-09 14:01:54 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2012 *) #load "pa_macro.cmo"; open MLast; value option_map f = fun [ Some x -> Some (f x) | None -> None ] ; value vala_map f = IFNDEF STRICT THEN fun x -> f x ELSE fun [ Ploc.VaAnt s -> Ploc.VaAnt s | Ploc.VaVal x -> Ploc.VaVal (f x) ] END ; value class_infos_map floc f x = {ciLoc = floc x.ciLoc; ciVir = x.ciVir; ciPrm = let (x1, x2) = x.ciPrm in (floc x1, x2); ciNam = x.ciNam; ciExp = f x.ciExp} ; value anti_loc qloc sh loc loc1 = (* ...<:reloc_expr<.....$lid:...xxxxxxxx...$...>>... |..|-----------------------------------| qloc <-----> sh |.........|------------| loc |..|------| loc1 *) let sh1 = Ploc.first_pos qloc + sh in let sh2 = sh1 + Ploc.first_pos loc in let line_nb_qloc = Ploc.line_nb qloc in let line_nb_loc = Ploc.line_nb loc in let line_nb_loc1 = Ploc.line_nb loc1 in if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then Ploc.make_unlined (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) else Ploc.make_loc (Ploc.file_name loc) (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) (if line_nb_loc1 = 1 then if line_nb_loc = 1 then Ploc.bol_pos qloc else sh1 + Ploc.bol_pos loc else sh2 + Ploc.bol_pos loc1) (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" ; value rec reloc_ctyp floc sh = self where rec self = fun [ TyAcc loc x1 x2 → let loc = floc loc in TyAcc loc (self x1) (self x2) | TyAli loc x1 x2 → let loc = floc loc in TyAli loc (self x1) (self x2) | TyAny loc → let loc = floc loc in TyAny loc | TyApp loc x1 x2 → let loc = floc loc in TyApp loc (self x1) (self x2) | TyArr loc x1 x2 → let loc = floc loc in TyArr loc (self x1) (self x2) | TyCls loc x1 → let loc = floc loc in TyCls loc x1 | TyLab loc x1 x2 → let loc = floc loc in TyLab loc x1 (self x2) | TyLid loc x1 → let loc = floc loc in TyLid loc x1 | TyMan loc x1 x2 x3 → let loc = floc loc in TyMan loc (self x1) x2 (self x3) | TyObj loc x1 x2 → let loc = floc loc in TyObj loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) x2 | TyOlb loc x1 x2 → let loc = floc loc in TyOlb loc x1 (self x2) | TyPck loc x1 → let loc = floc loc in TyPck loc (reloc_module_type floc sh x1) | TyPol loc x1 x2 → let loc = floc loc in TyPol loc x1 (self x2) | TyPot loc x1 x2 → let loc = floc loc in TyPot loc x1 (self x2) | TyQuo loc x1 → let loc = floc loc in TyQuo loc x1 | TyRec loc x1 → let loc = floc loc in TyRec loc (vala_map (List.map (fun (loc, x1, x2, x3) → (floc loc, x1, x2, self x3))) x1) | TySum loc x1 → let loc = floc loc in TySum loc (vala_map (List.map (fun (loc, x1, x2, x3) → (floc loc, x1, vala_map (List.map self) x2, option_map self x3))) x1) | TyTup loc x1 → let loc = floc loc in TyTup loc (vala_map (List.map self) x1) | TyUid loc x1 → let loc = floc loc in TyUid loc x1 | TyVrn loc x1 x2 → let loc = floc loc in TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 | TyXtr loc x1 x2 → let loc = floc loc in TyXtr loc x1 (option_map (vala_map self) x2) ] and reloc_poly_variant floc sh = fun [ PvTag loc x1 x2 x3 → let loc = floc loc in PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) | PvInh loc x1 → let loc = floc loc in PvInh loc (reloc_ctyp floc sh x1) ] and reloc_patt floc sh = self where rec self = fun [ PaAcc loc x1 x2 → let loc = floc loc in PaAcc loc (self x1) (self x2) | PaAli loc x1 x2 → let loc = floc loc in PaAli loc (self x1) (self x2) | PaAnt loc x1 → let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_patt new_floc sh x1 | PaAny loc → let loc = floc loc in PaAny loc | PaApp loc x1 x2 → let loc = floc loc in PaApp loc (self x1) (self x2) | PaArr loc x1 → let loc = floc loc in PaArr loc (vala_map (List.map self) x1) | PaChr loc x1 → let loc = floc loc in PaChr loc x1 | PaFlo loc x1 → let loc = floc loc in PaFlo loc x1 | PaInt loc x1 x2 → let loc = floc loc in PaInt loc x1 x2 | PaLab loc x1 → let loc = floc loc in PaLab loc (vala_map (List.map (fun (x1, x2) → (self x1, vala_map (option_map self) x2))) x1) | PaLaz loc x1 → let loc = floc loc in PaLaz loc (self x1) | PaLid loc x1 → let loc = floc loc in PaLid loc x1 | PaNty loc x1 → let loc = floc loc in PaNty loc x1 | PaOlb loc x1 x2 → let loc = floc loc in PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) | PaOrp loc x1 x2 → let loc = floc loc in PaOrp loc (self x1) (self x2) | PaRec loc x1 → let loc = floc loc in PaRec loc (vala_map (List.map (fun (x1, x2) → (self x1, self x2))) x1) | PaRng loc x1 x2 → let loc = floc loc in PaRng loc (self x1) (self x2) | PaStr loc x1 → let loc = floc loc in PaStr loc x1 | PaTup loc x1 → let loc = floc loc in PaTup loc (vala_map (List.map self) x1) | PaTyc loc x1 x2 → let loc = floc loc in PaTyc loc (self x1) (reloc_ctyp floc sh x2) | PaTyp loc x1 → let loc = floc loc in PaTyp loc x1 | PaUid loc x1 → let loc = floc loc in PaUid loc x1 | PaUnp loc x1 x2 → let loc = floc loc in PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) | PaVrn loc x1 → let loc = floc loc in PaVrn loc x1 | PaXtr loc x1 x2 → let loc = floc loc in PaXtr loc x1 (option_map (vala_map self) x2) ] and reloc_expr floc sh = self where rec self = fun [ ExAcc loc x1 x2 → let loc = floc loc in ExAcc loc (self x1) (self x2) | ExAnt loc x1 → let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_expr new_floc sh x1 | ExApp loc x1 x2 → let loc = floc loc in ExApp loc (self x1) (self x2) | ExAre loc x1 x2 → let loc = floc loc in ExAre loc (self x1) (self x2) | ExArr loc x1 → let loc = floc loc in ExArr loc (vala_map (List.map self) x1) | ExAsr loc x1 → let loc = floc loc in ExAsr loc (self x1) | ExAss loc x1 x2 → let loc = floc loc in ExAss loc (self x1) (self x2) | ExBae loc x1 x2 → let loc = floc loc in ExBae loc (self x1) (vala_map (List.map self) x2) | ExChr loc x1 → let loc = floc loc in ExChr loc x1 | ExCoe loc x1 x2 x3 → let loc = floc loc in ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) | ExFlo loc x1 → let loc = floc loc in ExFlo loc x1 | ExFor loc x1 x2 x3 x4 x5 → let loc = floc loc in ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) | ExFun loc x1 → let loc = floc loc in ExFun loc (vala_map (List.map (fun (x1, x2, x3) → (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x1) | ExIfe loc x1 x2 x3 → let loc = floc loc in ExIfe loc (self x1) (self x2) (self x3) | ExInt loc x1 x2 → let loc = floc loc in ExInt loc x1 x2 | ExJdf loc x1 x2 → let loc = floc loc in ExJdf loc (vala_map (List.map (reloc_joinclause floc sh)) x1) (self x2) | ExLab loc x1 → let loc = floc loc in ExLab loc (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, vala_map (option_map self) x2))) x1) | ExLaz loc x1 → let loc = floc loc in ExLaz loc (self x1) | ExLet loc x1 x2 x3 → let loc = floc loc in ExLet loc x1 (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x2) (self x3) | ExLid loc x1 → let loc = floc loc in ExLid loc x1 | ExLmd loc x1 x2 x3 → let loc = floc loc in ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) | ExMat loc x1 x2 → let loc = floc loc in ExMat loc (self x1) (vala_map (List.map (fun (x1, x2, x3) → (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExNew loc x1 → let loc = floc loc in ExNew loc x1 | ExObj loc x1 x2 → let loc = floc loc in ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | ExOlb loc x1 x2 → let loc = floc loc in ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) | ExOvr loc x1 → let loc = floc loc in ExOvr loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) | ExPar loc x1 x2 → let loc = floc loc in ExPar loc (self x1) (self x2) | ExPck loc x1 x2 → let loc = floc loc in ExPck loc (reloc_module_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | ExRec loc x1 x2 → let loc = floc loc in ExRec loc (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x1) (option_map self x2) | ExRpl loc x1 x2 → let loc = floc loc in ExRpl loc (vala_map (option_map self) x1) ((fun (loc, x1) → (floc loc, x1)) x2) | ExSeq loc x1 → let loc = floc loc in ExSeq loc (vala_map (List.map self) x1) | ExSpw loc x1 → let loc = floc loc in ExSpw loc (self x1) | ExSnd loc x1 x2 → let loc = floc loc in ExSnd loc (self x1) x2 | ExSte loc x1 x2 → let loc = floc loc in ExSte loc (self x1) (self x2) | ExStr loc x1 → let loc = floc loc in ExStr loc x1 | ExTry loc x1 x2 → let loc = floc loc in ExTry loc (self x1) (vala_map (List.map (fun (x1, x2, x3) → (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExTup loc x1 → let loc = floc loc in ExTup loc (vala_map (List.map self) x1) | ExTyc loc x1 x2 → let loc = floc loc in ExTyc loc (self x1) (reloc_ctyp floc sh x2) | ExUid loc x1 → let loc = floc loc in ExUid loc x1 | ExVrn loc x1 → let loc = floc loc in ExVrn loc x1 | ExWhi loc x1 x2 → let loc = floc loc in ExWhi loc (self x1) (vala_map (List.map self) x2) | ExXtr loc x1 x2 → let loc = floc loc in ExXtr loc x1 (option_map (vala_map self) x2) ] and reloc_module_type floc sh = self where rec self = fun [ MtAcc loc x1 x2 → let loc = floc loc in MtAcc loc (self x1) (self x2) | MtApp loc x1 x2 → let loc = floc loc in MtApp loc (self x1) (self x2) | MtFun loc x1 x2 x3 → let loc = floc loc in MtFun loc x1 (self x2) (self x3) | MtLid loc x1 → let loc = floc loc in MtLid loc x1 | MtQuo loc x1 → let loc = floc loc in MtQuo loc x1 | MtSig loc x1 → let loc = floc loc in MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) | MtTyo loc x1 → let loc = floc loc in MtTyo loc (reloc_module_expr floc sh x1) | MtUid loc x1 → let loc = floc loc in MtUid loc x1 | MtWit loc x1 x2 → let loc = floc loc in MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) | MtXtr loc x1 x2 → let loc = floc loc in MtXtr loc x1 (option_map (vala_map self) x2) ] and reloc_sig_item floc sh = self where rec self = fun [ SgCls loc x1 → let loc = floc loc in SgCls loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgClt loc x1 → let loc = floc loc in SgClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgDcl loc x1 → let loc = floc loc in SgDcl loc (vala_map (List.map self) x1) | SgDir loc x1 x2 → let loc = floc loc in SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | SgExc loc x1 x2 → let loc = floc loc in SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | SgExt loc x1 x2 x3 → let loc = floc loc in SgExt loc x1 (reloc_ctyp floc sh x2) x3 | SgInc loc x1 → let loc = floc loc in SgInc loc (reloc_module_type floc sh x1) | SgMod loc x1 x2 → let loc = floc loc in SgMod loc x1 (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_type floc sh x2))) x2) | SgMty loc x1 x2 → let loc = floc loc in SgMty loc x1 (reloc_module_type floc sh x2) | SgOpn loc x1 → let loc = floc loc in SgOpn loc x1 | SgTyp loc x1 → let loc = floc loc in SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | SgUse loc x1 x2 → let loc = floc loc in SgUse loc x1 (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) | SgVal loc x1 x2 → let loc = floc loc in SgVal loc x1 (reloc_ctyp floc sh x2) | SgXtr loc x1 x2 → let loc = floc loc in SgXtr loc x1 (option_map (vala_map self) x2) ] and reloc_with_constr floc sh = fun [ WcMod loc x1 x2 → let loc = floc loc in WcMod loc x1 (reloc_module_expr floc sh x2) | WcMos loc x1 x2 → let loc = floc loc in WcMos loc x1 (reloc_module_expr floc sh x2) | WcTyp loc x1 x2 x3 x4 → let loc = floc loc in WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) | WcTys loc x1 x2 x3 → let loc = floc loc in WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_module_expr floc sh = self where rec self = fun [ MeAcc loc x1 x2 → let loc = floc loc in MeAcc loc (self x1) (self x2) | MeApp loc x1 x2 → let loc = floc loc in MeApp loc (self x1) (self x2) | MeFun loc x1 x2 x3 → let loc = floc loc in MeFun loc x1 (reloc_module_type floc sh x2) (self x3) | MeStr loc x1 → let loc = floc loc in MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) | MeTyc loc x1 x2 → let loc = floc loc in MeTyc loc (self x1) (reloc_module_type floc sh x2) | MeUid loc x1 → let loc = floc loc in MeUid loc x1 | MeUnp loc x1 x2 → let loc = floc loc in MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | MeXtr loc x1 x2 → let loc = floc loc in MeXtr loc x1 (option_map (vala_map self) x2) ] and reloc_str_item floc sh = self where rec self = fun [ StCls loc x1 → let loc = floc loc in StCls loc (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) | StClt loc x1 → let loc = floc loc in StClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | StDcl loc x1 → let loc = floc loc in StDcl loc (vala_map (List.map self) x1) | StDef loc x1 → let loc = floc loc in StDef loc (vala_map (List.map (reloc_joinclause floc sh)) x1) | StDir loc x1 x2 → let loc = floc loc in StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | StExc loc x1 x2 x3 → let loc = floc loc in StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 | StExp loc x1 → let loc = floc loc in StExp loc (reloc_expr floc sh x1) | StExt loc x1 x2 x3 → let loc = floc loc in StExt loc x1 (reloc_ctyp floc sh x2) x3 | StInc loc x1 → let loc = floc loc in StInc loc (reloc_module_expr floc sh x1) | StMod loc x1 x2 → let loc = floc loc in StMod loc x1 (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_expr floc sh x2))) x2) | StMty loc x1 x2 → let loc = floc loc in StMty loc x1 (reloc_module_type floc sh x2) | StOpn loc x1 → let loc = floc loc in StOpn loc x1 | StTyp loc x1 → let loc = floc loc in StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | StUse loc x1 x2 → let loc = floc loc in StUse loc x1 (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) | StVal loc x1 x2 → let loc = floc loc in StVal loc x1 (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) | StXtr loc x1 x2 → let loc = floc loc in StXtr loc x1 (option_map (vala_map self) x2) ] and reloc_joinclause floc sh x = {jcLoc = floc x.jcLoc; jcVal = vala_map (List.map (fun (loc, x1, x2) → (floc loc, vala_map (List.map (fun (loc, x1, x2) → (floc loc, (fun (loc, x1) → (floc loc, x1)) x1, vala_map (option_map (reloc_patt floc sh)) x2))) x1, reloc_expr floc sh x2))) x.jcVal} and reloc_type_decl floc sh x = {tdNam = vala_map (fun (loc, x1) → (floc loc, x1)) x.tdNam; tdPrm = x.tdPrm; tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; tdCon = vala_map (List.map (fun (x1, x2) → (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) x.tdCon} and reloc_class_type floc sh = self where rec self = fun [ CtAcc loc x1 x2 → let loc = floc loc in CtAcc loc (self x1) (self x2) | CtApp loc x1 x2 → let loc = floc loc in CtApp loc (self x1) (self x2) | CtCon loc x1 x2 → let loc = floc loc in CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) | CtFun loc x1 x2 → let loc = floc loc in CtFun loc (reloc_ctyp floc sh x1) (self x2) | CtIde loc x1 → let loc = floc loc in CtIde loc x1 | CtSig loc x1 x2 → let loc = floc loc in CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) (vala_map (List.map (reloc_class_sig_item floc sh)) x2) | CtXtr loc x1 x2 → let loc = floc loc in CtXtr loc x1 (option_map (vala_map self) x2) ] and reloc_class_sig_item floc sh = self where rec self = fun [ CgCtr loc x1 x2 → let loc = floc loc in CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CgDcl loc x1 → let loc = floc loc in CgDcl loc (vala_map (List.map self) x1) | CgInh loc x1 → let loc = floc loc in CgInh loc (reloc_class_type floc sh x1) | CgMth loc x1 x2 x3 → let loc = floc loc in CgMth loc x1 x2 (reloc_ctyp floc sh x3) | CgVal loc x1 x2 x3 → let loc = floc loc in CgVal loc x1 x2 (reloc_ctyp floc sh x3) | CgVir loc x1 x2 x3 → let loc = floc loc in CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_class_expr floc sh = self where rec self = fun [ CeApp loc x1 x2 → let loc = floc loc in CeApp loc (self x1) (reloc_expr floc sh x2) | CeCon loc x1 x2 → let loc = floc loc in CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | CeFun loc x1 x2 → let loc = floc loc in CeFun loc (reloc_patt floc sh x1) (self x2) | CeLet loc x1 x2 x3 → let loc = floc loc in CeLet loc x1 (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) (self x3) | CeStr loc x1 x2 → let loc = floc loc in CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | CeTyc loc x1 x2 → let loc = floc loc in CeTyc loc (self x1) (reloc_class_type floc sh x2) | CeXtr loc x1 x2 → let loc = floc loc in CeXtr loc x1 (option_map (vala_map self) x2) ] and reloc_class_str_item floc sh = self where rec self = fun [ CrCtr loc x1 x2 → let loc = floc loc in CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CrDcl loc x1 → let loc = floc loc in CrDcl loc (vala_map (List.map self) x1) | CrInh loc x1 x2 → let loc = floc loc in CrInh loc (reloc_class_expr floc sh x1) x2 | CrIni loc x1 → let loc = floc loc in CrIni loc (reloc_expr floc sh x1) | CrMth loc x1 x2 x3 x4 x5 → let loc = floc loc in CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) (reloc_expr floc sh x5) | CrVal loc x1 x2 x3 x4 → let loc = floc loc in CrVal loc x1 x2 x3 (reloc_expr floc sh x4) | CrVav loc x1 x2 x3 → let loc = floc loc in CrVav loc x1 x2 (reloc_ctyp floc sh x3) | CrVir loc x1 x2 x3 → let loc = floc loc in CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] ; (* Equality over syntax trees *) value eq_expr x y = reloc_expr (fun _ -> Ploc.dummy) 0 x = reloc_expr (fun _ -> Ploc.dummy) 0 y ; value eq_patt x y = reloc_patt (fun _ -> Ploc.dummy) 0 x = reloc_patt (fun _ -> Ploc.dummy) 0 y ; value eq_ctyp x y = reloc_ctyp (fun _ -> Ploc.dummy) 0 x = reloc_ctyp (fun _ -> Ploc.dummy) 0 y ; value eq_str_item x y = reloc_str_item (fun _ -> Ploc.dummy) 0 x = reloc_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_sig_item x y = reloc_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_module_expr x y = reloc_module_expr (fun _ -> Ploc.dummy) 0 x = reloc_module_expr (fun _ -> Ploc.dummy) 0 y ; value eq_module_type x y = reloc_module_type (fun _ -> Ploc.dummy) 0 x = reloc_module_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_sig_item x y = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_class_str_item x y = reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = reloc_class_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_reloc_class_type x y = reloc_class_type (fun _ -> Ploc.dummy) 0 x = reloc_class_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_expr x y = reloc_class_expr (fun _ -> Ploc.dummy) 0 x = reloc_class_expr (fun _ -> Ploc.dummy) 0 y ; (* ------------------------------------------------------------------------- *) (* Now the lexer. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: plexer.ml,v 6.19 2013-07-03 01:43:10 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2012 *) #load "pa_lexer.cmo"; (* ------------------------------------------------------------------------- *) (* Added by JRH as a backdoor to change lexical conventions. *) (* ------------------------------------------------------------------------- *) value jrh_lexer = ref False; open Versdep; value no_quotations = ref False; value error_on_unknown_keywords = ref False; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value dot_newline_is = ref "."; value force_antiquot_loc = ref False; type context = { after_space : mutable bool; dollar_for_antiquotation : bool; specific_space_dot : bool; dot_newline_is : string; find_kwd : string -> string; line_cnt : int -> char -> unit; set_line_nb : unit -> unit; make_lined_loc : (int * int) -> string -> Ploc.t } ; value err ctx loc msg = Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) ; (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) (***** JRH: Carl's alternative version then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; *****) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) value keyword_or_error ctx loc s = try ("", ctx.find_kwd s) with [ Not_found -> if error_on_unknown_keywords.val then err ctx loc ("illegal token: " ^ s) else ("", s) ] ; value implode l = List.fold_right(fun x y -> String.make 1 x ^ y) l ""; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value utf8_lexing = ref False; value greek_tab = ["α"; "β"; "γ"; "δ"; "ε"; "ζ"; "η"; "θ"; "ι"; "κ"; "λ"; "μ"; "ν"; "ξ"; "ο"; "Ï€"; "Ï"; "σ"; "Ï„"; "Ï…"; "φ"; "χ"; "ψ"; "ω"] ; value greek_letter buf strm = if utf8_lexing.val then match Stream.peek strm with [ Some c -> if Char.code c >= 128 then let x = implode (Stream.npeek 2 strm) in if List.mem x greek_tab then do { Stream.junk strm; $add c } else raise Stream.Failure else raise Stream.Failure | None -> raise Stream.Failure ] else raise Stream.Failure ; value misc_letter buf strm = if utf8_lexing.val then match Stream.peek strm with [ Some c -> if Char.code c >= 128 then match implode (Stream.npeek 3 strm) with [ "→" | "≤" | "≥" -> raise Stream.Failure | _ -> do { Stream.junk strm; $add c } ] else raise Stream.Failure | None -> raise Stream.Failure ] else match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] ; value misc_punct buf strm = if utf8_lexing.val then match strm with lexer [ '\226' _ _ ] else match strm with parser [] ; value utf8_equiv ctx bp buf strm = if utf8_lexing.val then match strm with lexer [ "→" -> keyword_or_error ctx (bp, $pos) "->" | "≤" -> keyword_or_error ctx (bp, $pos) "<=" | "≥" -> keyword_or_error ctx (bp, $pos) ">=" ] else match strm with parser [] ; value rec ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] ; value rec ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] ident2! | ] ; value rec ident3 = lexer [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' | '\128'-'\255' ] ident3! | ] ; value binary = lexer [ '0' | '1' ]; value octal = lexer [ '0'-'7' ]; value decimal = lexer [ '0'-'9' ]; value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; value end_integer = lexer [ "l"/ -> ("INT_l", $buf) | "L"/ -> ("INT_L", $buf) | "n"/ -> ("INT_n", $buf) | -> ("INT", $buf) ] ; value rec digits_under kind = lexer [ kind (digits_under kind)! | "_" (digits_under kind)! | end_integer ] ; value digits kind = lexer [ kind (digits_under kind)! | -> raise (Stream.Error "ill-formed integer constant") ] ; value rec decimal_digits_under = lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] ; value exponent_part = lexer [ [ 'e' | 'E' ] [ '+' | '-' | ] '0'-'9' ? "ill-formed floating-point constant" decimal_digits_under! ] ; value number = lexer [ decimal_digits_under "." decimal_digits_under! exponent_part -> ("FLOAT", $buf) | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) | decimal_digits_under exponent_part -> ("FLOAT", $buf) | decimal_digits_under end_integer! ] ; value char_after_bslash = lexer [ "'"/ | _ [ "'"/ | _ [ "'"/ | ] ] ] ; value char ctx bp = lexer [ "\\" _ char_after_bslash! | "\\" -> err ctx (bp, $pos) "char not terminated" | ?= [ _ '''] _! "'"/ ] ; value any ctx buf = parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } ; value rec string ctx bp = lexer [ "\""/ | "\\" (any ctx) (string ctx bp)! | (any ctx) (string ctx bp)! | -> err ctx (bp, $pos) "string not terminated" ] ; value rec qstring ctx bp = lexer [ "`"/ | (any ctx) (qstring ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value comment ctx bp = comment where rec comment = lexer [ "*)" | "*" comment! | "(*" comment! comment! | "(" comment! | "\"" (string ctx bp)! [ -> $add "\"" ] comment! | "'*)" | "'*" comment! | "'" (any ctx) comment! | (any ctx) comment! | -> err ctx (bp, $pos) "comment not terminated" ] ; value rec quotation ctx bp = lexer [ ">>"/ | ">" (quotation ctx bp)! | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! (quotation ctx bp)! | "<" (quotation ctx bp)! | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! | "\\" (quotation ctx bp)! | (any ctx) (quotation ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value less_expected = "character '<' expected"; value less ctx bp buf strm = if no_quotations.val then match strm with lexer [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] else match strm with lexer [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value rec antiquot_rest ctx bp = lexer [ "$"/ | "\\"/ (any ctx) (antiquot_rest ctx bp)! | (any ctx) (antiquot_rest ctx bp)! | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value rec antiquot ctx bp = lexer [ "$"/ -> ":" ^ $buf | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! | ":" (antiquot_rest ctx bp)! -> $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; value rec antiquot_loc ctx bp = lexer [ "$"/ -> antiloc bp $pos (":" ^ $buf) | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value dollar ctx bp buf strm = if not no_quotations.val && ctx.dollar_for_antiquotation then ("ANTIQUOT", antiquot ctx bp buf strm) else if force_antiquot_loc.val then ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) else match strm with lexer [ [ -> $add "$" ] ident2! -> ("", $buf) ] ; (* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?abc:d ?abc ?$abc:d$: ?abc:d: ?abc: ?$d$ ?:d ? ?$d$: ?:d: ?: *) (* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?8,13:abc:d ?abc ?$abc:d$: ?8,13:abc:d: ?abc: ?$d$ ?8,9::d ? ?$d$: ?8,9::d: ?: *) value question ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "?" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "?" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tilde ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "~" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "~" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tildeident = lexer [ ":"/ -> ("TILDEIDENTCOLON", $buf) | -> ("TILDEIDENT", $buf) ] ; value questionident = lexer [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) | -> ("QUESTIONIDENT", $buf) ] ; value rec linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> False ] and linedir_digits n s = match stream_peek_nth n s with [ Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> linedir_quote n s ] and linedir_quote n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir_quote (n + 1) s | Some '"' -> True | _ -> False ] ; value rec any_to_nl = lexer [ "\r" | "\n" | _ any_to_nl! | ] ; value next_token_after_spaces ctx bp = lexer [ 'A'-'Z' ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] *********) | greek_letter ident! -> ("GIDENT", $buf) | [ 'a'-'z' | '_' | misc_letter ] ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! | "0" [ 'b' | 'B' ] (digits binary)! | "0" number! | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" | "'"/ (char ctx bp) -> ("CHAR", $buf) | "'" -> keyword_or_error ctx (bp, $pos) "'" | "\""/ (string ctx bp)! -> ("STRING", $buf) (*** Line added by JRH ***) | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) | "$"/ (dollar ctx bp)! | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> keyword_or_error ctx (bp, $pos) $buf | "~"/ 'a'-'z' ident! tildeident! | "~"/ '_' ident! tildeident! | "~" (tilde ctx bp) | "?"/ 'a'-'z' ident! questionident! | "?" (question ctx bp)! | "<"/ (less ctx bp)! | ":]" -> keyword_or_error ctx (bp, $pos) $buf | "::" -> keyword_or_error ctx (bp, $pos) $buf | ":=" -> keyword_or_error ctx (bp, $pos) $buf | ":>" -> keyword_or_error ctx (bp, $pos) $buf | ":" -> keyword_or_error ctx (bp, $pos) $buf | ">]" -> keyword_or_error ctx (bp, $pos) $buf | ">}" -> keyword_or_error ctx (bp, $pos) $buf | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "|]" -> keyword_or_error ctx (bp, $pos) $buf | "|}" -> keyword_or_error ctx (bp, $pos) $buf | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "[|" -> keyword_or_error ctx (bp, $pos) $buf | "[<" -> keyword_or_error ctx (bp, $pos) $buf | "[:" -> keyword_or_error ctx (bp, $pos) $buf | "[" -> keyword_or_error ctx (bp, $pos) $buf | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "{|" -> keyword_or_error ctx (bp, $pos) $buf | "{<" -> keyword_or_error ctx (bp, $pos) $buf | "{:" -> keyword_or_error ctx (bp, $pos) $buf | "{" -> keyword_or_error ctx (bp, $pos) $buf | ".." -> keyword_or_error ctx (bp, $pos) ".." | "." ?= [ "\n" ] -> keyword_or_error ctx (bp, bp + 1) ctx.dot_newline_is | "." -> let id = if ctx.specific_space_dot && ctx.after_space then " ." else "." in keyword_or_error ctx (bp, $pos) id | ";;" -> keyword_or_error ctx (bp, $pos) ";;" | ";" -> keyword_or_error ctx (bp, $pos) ";" | (utf8_equiv ctx bp) | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf | "\\"/ ident3! -> ("LIDENT", $buf) | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] ; value get_comment buf strm = $buf; value rec next_token ctx buf = parser bp [ [: `('\n' | '\r' as c); s :] ep -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := ep; ctx.set_line_nb (); ctx.after_space := True; next_token ctx ($add c) s } | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { ctx.after_space := True; next_token ctx ($add c) s } | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> let comm = get_comment buf () in if linedir 1 s then do { let buf = any_to_nl ($add '#') s in incr Plexing.line_nb.val; Plexing.bol_pos.val.val := Stream.count s; ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } else let loc = ctx.make_lined_loc (bp, bp + 1) comm in (keyword_or_error ctx (bp, bp + 1) "#", loc) | [: `'('; a = parser [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } | [: :] ep -> let loc = ctx.make_lined_loc (bp, ep) $buf in (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a | [: comm = get_comment buf; tok = next_token_after_spaces ctx bp $empty :] ep -> let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in (tok, loc) | [: comm = get_comment buf; _ = Stream.empty :] -> let loc = ctx.make_lined_loc (bp, bp + 1) comm in (("EOI", ""), loc) ] ; value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = try do { match Plexing.restore_lexing_info.val with [ Some (line_nb, bol_pos) -> do { s_line_nb.val := line_nb; s_bol_pos.val := bol_pos; Plexing.restore_lexing_info.val := None; } | None -> () ]; Plexing.line_nb.val := s_line_nb; Plexing.bol_pos.val := s_bol_pos; let comm_bp = Stream.count cstrm in ctx.set_line_nb (); ctx.after_space := False; let (r, loc) = next_token ctx $empty cstrm in match glexr.val.Plexing.tok_comm with [ Some list -> if Ploc.first_pos loc > comm_bp then let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in glexr.val.Plexing.tok_comm := Some [comm_loc :: list] else () | None -> () ]; (r, loc) } with [ Stream.Error str -> err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] ; value func kwd_table glexr = let ctx = let line_nb = ref 0 in let bol_pos = ref 0 in {after_space = False; dollar_for_antiquotation = dollar_for_antiquotation.val; specific_space_dot = specific_space_dot.val; dot_newline_is = dot_newline_is.val; find_kwd = Hashtbl.find kwd_table; line_cnt bp1 c = match c with [ '\n' | '\r' -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := bp1 + 1; } | c -> () ]; set_line_nb () = do { line_nb.val := Plexing.line_nb.val.val; bol_pos.val := Plexing.bol_pos.val.val; }; make_lined_loc loc comm = Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} in Plexing.lexer_func_of_parser (next_token_fun ctx glexr) ; value rec check_keyword_stream = parser [: _ = check $empty; _ = Stream.empty :] -> True and check = lexer [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ] check_ident2! | "$" check_ident2! | "<" ?= [ ":" | "<" ] | "<" check_ident2! | ":]" | "::" | ":=" | ":>" | ":" | ">]" | ">}" | ">" check_ident2! | "|]" | "|}" | "|" check_ident2! | "[" ?= [ "<<" | "<:" ] | "[|" | "[<" | "[:" | "[" | "{" ?= [ "<<" | "<:" ] | "{|" | "{<" | "{:" | "{" | ";;" | ";" | misc_punct check_ident2! | _ ] and check_ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] check_ident! | ] and check_ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | misc_punct ] check_ident2! | ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Plexing.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Plexing.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (hashtbl_mem kwd_table p_prm) then if check_keyword p_prm then if hashtbl_mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | "CHAR" | "STRING" | "QUOTATION" | "GIDENT" | "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> () | _ -> raise (Plexing.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT", s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value after_colon_except_last e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 2) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then if p_prm.[String.length p_prm - 1] = ':' then let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then if eq_before_colon p_prm prm then after_colon_except_last prm else raise Stream.Failure else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then raise Stream.Failure else if eq_before_colon p_prm prm then after_colon prm else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Plexing.default_match tok ] ; value gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let glex = {Plexing.tok_func = func kwd_table glexr; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; glex } ; (* ------------------------------------------------------------------------- *) (* Back to etc/pa_o.ml *) (* ------------------------------------------------------------------------- *) do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; Plexer.utf8_lexing.val := True; Grammar.Unsafe.gram_reinit gram (gmake ()); dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry signature; Grammar.Unsafe.clear_entry structure; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_decl; Grammar.Unsafe.clear_entry constructor_declaration; Grammar.Unsafe.clear_entry label_declaration; Grammar.Unsafe.clear_entry match_case; Grammar.Unsafe.clear_entry with_constr; Grammar.Unsafe.clear_entry poly_variant; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value mklistexp loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = do { let ct = Hashtbl.create 73 in List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] }; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value check_not_part_of_patt = Grammar.Entry.of_parser gram "check_not_part_of_patt" (fun strm -> let tok = match Stream.npeek 4 strm with [ [("LIDENT", _); tok :: _] -> tok | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok | _ -> raise Stream.Failure ] in match tok with [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure | _ -> () ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in loop where rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"; "?!"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && (x = "$" || String.length x >= 2) && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("ANTIQUOT_LOC", _) -> () | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value e_phony = Grammar.Entry.of_parser gram "e_phony" (parser []) ; value p_phony = Grammar.Entry.of_parser gram "p_phony" (parser []) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e | _ -> 1 ] ; value rec constr_patt_arity loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value mem_tvar s tpl = List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl ; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if mem_tvar s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if mem_tvar v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; value quotation_content s = do { loop 0 where rec loop i = if i = String.length s then ("", s) else if s.[i] = ':' || s.[i] = '@' then let i = i + 1 in (String.sub s 0 i, String.sub s i (String.length s - i)) else loop (i + 1) }; value concat_comm loc e = let loc = Ploc.with_comment loc (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) in let floc = let first = ref True in fun loc1 -> if first.val then do {first.val := False; loc} else loc1 in reloc_expr floc 0 e ; EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr signature structure class_type class_expr class_sig_item class_str_item let_binding type_decl constructor_declaration label_declaration match_case with_constr poly_variant; module_expr: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> | "struct"; st = structure; "end" -> <:module_expr< struct $_list:st$ end >> ] | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; "val"; e = expr; ":"; mt = module_type; ")" -> <:module_expr< (value $e$ : $mt$) >> | "("; "val"; e = expr; ")" -> <:module_expr< (value $e$) >> | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; structure: [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration; b = rebind_exn -> <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> <:str_item< module $_flag:r$ $_list:l$ >> | "module"; "type"; i = V ident ""; "="; mt = module_type -> <:str_item< module type $_:i$ = $mt$ >> | "open"; i = V mod_ident "list" "" -> <:str_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:str_item< type $_list:tdl$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr -> let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> match l with [ <:vala< [(p, e)] >> -> match p with [ <:patt< _ >> -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> <:str_item< let module $_uid:m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = V mod_ident "list" -> sl | -> <:vala< [] >> ] ] ; mod_binding: [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] ; mod_fun_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> <:module_type< $mt$ with $_list:wcl$ >> ] | [ "sig"; sg = signature; "end" -> <:module_type< sig $_list:sg$ end >> | "module"; "type"; "of"; me = module_expr -> <:module_type< module type of $me$ >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; signature: [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = V UIDENT -> <:module_type< $_uid:m$ >> | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration -> <:sig_item< exception $_uid:c$ of $_list:tl$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; rf = V (FLAG "rec"); l = V (LIST1 mod_decl_binding SEP "and") -> <:sig_item< module $_flag:rf$ $_list:l$ >> | "module"; "type"; i = V ident ""; "="; mt = module_type -> <:sig_item< module type $_:i$ = $mt$ >> | "module"; "type"; i = V ident "" -> <:sig_item< module type $_:i$ = 'abstract >> | "open"; i = V mod_ident "list" "" -> <:sig_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:sig_item< type $_list:tdl$ >> | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> <:sig_item< value $_lid:i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $lid:i$ : $t$ >> ] ] ; mod_decl_binding: [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; pf = V (FLAG "private"); t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> | "module"; i = V mod_ident ""; "="; me = module_expr -> <:with_constr< module $_:i$ = $me$ >> | "module"; i = V mod_ident ""; ":="; me = module_expr -> <:with_constr< module $_:i$ := $me$ >> ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] | "expr1" [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr LEVEL "top" -> <:expr< let $_flag:o$ $_list:l$ in $x$ >> | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $_uid:m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< fun [ $_list:l$ ] >> | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> <:expr< fun [$p$ $opt:eo$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< match $e$ with [ $_list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< try $e$ with [ $_list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; e2 = SELF; "do"; e = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e in <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e2 in <:expr< while $e1$ do { $_list:el$ } >> ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< - $e$ >> | "-."; e = SELF -> <:expr< -. $e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> let (e1, e2) = if is_expr_constr_call e1 then match e1 with [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) | _ -> (e1, e2) ] else (e1, e2) in match constr_expr_arity loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> <:expr< assert $e$ >> | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; op = operator_rparen -> <:expr< $e1$ .( $lid:op$ ) >> | e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> <:expr< $e$ .{ $_list:el$ } >> | e1 = SELF; "."; e2 = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop e1 e2 ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val >> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = V INT -> <:expr< $_int:s$ >> | s = V INT_l -> <:expr< $_int32:s$ >> | s = V INT_L -> <:expr< $_int64:s$ >> | s = V INT_n -> <:expr< $_nativeint:s$ >> | s = V FLOAT -> <:expr< $_flo:s$ >> | s = V STRING -> <:expr< $_str:s$ >> | c = V CHAR -> <:expr< $_chr:c$ >> | UIDENT "True" -> <:expr< True_ >> | UIDENT "False" -> <:expr< False_ >> | i = expr_ident -> i | "false" -> <:expr< False >> | "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = V expr1_semi_list "list"; "|]" -> <:expr< [| $_list:el$ |] >> | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> <:expr< { $_list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> <:expr< { ($e$) with $_list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> <:expr< (module $me$ : $mt$) >> | "("; "module"; me = module_expr; ")" -> <:expr< (module $me$) >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_expr_quotation loc con ] ] ; let_binding: [ [ p = val_ident; e = fun_binding -> (p, e) | p = patt; "="; e = expr -> (p, e) | p = patt; ":"; t = poly_type; "="; e = expr -> (<:patt< ($p$ : $t$) >>, e) ] ] ; (*** JRH added the "translate_operator" here ***) val_ident: [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> | check_not_part_of_patt; "("; s = ANY; ")" -> let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] ; fun_binding: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] ; match_case: [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] ; fun_def: [ RIGHTA [ p = patt LEVEL "simple"; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> (eo, <:expr< $e$ >>) ] ] ; expr_ident: [ RIGHTA [ i = V LIDENT -> <:expr< $_lid:i$ >> | i = V UIDENT -> <:expr< $_uid:i$ >> | i = V UIDENT; "."; j = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop <:expr< $_uid:i$ >> j | i = V UIDENT; "."; "("; j = operator_rparen -> <:expr< $_uid:i$ . $lid:j$ >> | i = V UIDENT; "."; "("; e = expr; ")" -> <:expr< $_uid:i$ . ( $e$ ) >> ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> let (p1, p2) = match p1 with [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) | _ -> (p1, p2) ] in match constr_patt_arity loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ s = V LIDENT -> <:patt< $_lid:s$ >> | s = V UIDENT -> <:patt< $_uid:s$ >> | s = V INT -> <:patt< $_int:s$ >> | s = V INT_l -> <:patt< $_int32:s$ >> | s = V INT_L -> <:patt< $_int64:s$ >> | s = V INT_n -> <:patt< $_nativeint:s$ >> | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = INT_l -> <:patt< $int32:"-" ^ s$ >> | "-"; s = INT_L -> <:patt< $int64:"-" ^ s$ >> | "-"; s = INT_n -> <:patt< $nativeint:"-" ^ s$ >> | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = V FLOAT -> <:patt< $_flo:s$ >> | s = V STRING -> <:patt< $_str:s$ >> | s = V CHAR -> <:patt< $_chr:s$ >> | UIDENT "True" -> <:patt< True_ >> | UIDENT "False" -> <:patt< False_ >> | "false" -> <:patt< False >> | "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = V patt_semi_list "list"; "|]" -> <:patt< [| $_list:pl$ |] >> | "{"; lpl = V lbl_patt_list "list"; "}" -> <:patt< { $_list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; ")" -> <:patt< $p$ >> | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> <:patt< (module $_uid:s$ : $mt$) >> | "("; "module"; s = V UIDENT; ")" -> <:patt< (module $_uid:s$) >> | "_" -> <:patt< _ >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_patt_quotation loc con ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) | "_" -> (<:patt< _ >>, <:patt< _ >>) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_decl: [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); tk = type_kind; cl = V (LIST0 constrain) -> <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> let tk = <:ctyp< '$choose_tvar tpl$ >> in <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] ; type_patt: [ [ n = V LIDENT -> (loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; pf = FLAG "private"; "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> | t = ctyp; "="; pf = FLAG "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> | "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< { $_list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "+"; p = V simple_type_parameter -> (p, Some True) | "-"; p = V simple_type_parameter -> (p, Some False) | p = V simple_type_parameter -> (p, None) ] ] ; simple_type_parameter: [ [ "'"; i = ident -> Some i | "_" -> None ] ] ; constructor_declaration: [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> (loc, ci, cal, None) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); "->"; t = ctyp -> (loc, ci, cal, Some t) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> let t = match cal with [ <:vala< [t] >> -> t | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> | _ -> assert False ] in (loc, ci, <:vala< [] >>, Some t) | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] ; cons_ident: [ [ i = V UIDENT "uid" "" -> i | UIDENT "True" -> <:vala< "True_" >> | UIDENT "False" -> <:vala< "False_" >> ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "apply" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> | "_" -> <:ctyp< _ >> | i = V LIDENT -> <:ctyp< $_lid:i$ >> | i = V UIDENT -> <:ctyp< $_uid:i$ >> | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> <:str_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:str_item< class type $_list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = V (LIST1 class_description SEP "and") -> <:sig_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:sig_item< class type $_list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = patt LEVEL "simple"; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (loc, <:vala< [] >>) | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] ; class_fun_def: [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = patt LEVEL "simple"; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); "in"; ce = SELF -> <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< [ $ct$ ] $list:ci$ >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:class_expr< object $_opt:cspo$ $_list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> <:class_str_item< inherit $ce$ $_opt:pb$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; e = cvalue_binding -> <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> if Pcaml.unvala ov then Ploc.raise loc (Stream.Error "virtual value cannot override") else <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual $_lid:l$ : $t$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> <:class_type< $id$ [ $list:tl$ ] >> | "object"; cst = V (OPT class_self_type); csf = V (LIST0 class_sig_item); "end" -> <:class_type< object $_opt:cst$ $_list:csf$ end >> ] | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] | [ i = V LIDENT -> <:class_type< $_id: i$ >> | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual $_lid:l$ : $t$ >> | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method private $_lid:l$ : $t$ >> | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method $_lid:l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; ":"; ct = class_type -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; "="; cs = class_signature -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = V field_expr_list "list"; ">}" -> <:expr< {< $_list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = V class_longident "list" -> <:ctyp< # $_list:id$ >> | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> <:ctyp< < $_list:ml$ $_flag:v$ > >> | "<"; ".."; ">" -> <:ctyp< < .. > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; ml = SELF -> [f :: ml] | f = field; ";" -> [f] | f = field -> [f] ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> <:ctyp< type $list:nt$ . $ct$ >> | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: AFTER "arrow" [ NONA [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ = $_list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ > $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ < $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; ntl = V (LIST1 name_tag); "]" -> <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] ; poly_variant: [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); l = V (LIST1 ctyp SEP "&") -> <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> | t = ctyp -> <:poly_variant< $t$ >> ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] ; expr: AFTER "apply" [ "label" [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] ; fun_def: [ [ p = labeled_patt; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; patt: LEVEL "simple" [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> | p = labeled_patt -> p ] ] ; labeled_patt: [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> <:patt< ~{$_:i$ = $p$} >> | i = V TILDEIDENT -> <:patt< ~{$_:i$} >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~{$lid:i$} >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~{$lid:i$ : $t$} >> | i = V QUESTIONIDENTCOLON; j = LIDENT -> <:patt< ?{$_:i$ = ?{$lid:j$}} >> | i = V QUESTIONIDENTCOLON; "_" -> <:patt< ?{$_:i$} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> <:patt< ?{$_:i$ = ?{$p$}} >> | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ?{$lid:i$ = $e$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$lid:i$ : $t$ = $e$} >> | "?"; "("; i = LIDENT; ")" -> <:patt< ?{$lid:i$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ?{$lid:i$ : $t$} >> ] ] ; class_type: [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ~$i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_fun_def: [ [ p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; END; IFDEF JOCAML THEN DELETE_RULE expr: SELF; "or"; SELF END; DELETE_RULE expr: SELF; "&"; SELF END; EXTEND GLOBAL: str_item expr; str_item: [ [ "def"; jal = V (LIST1 joinautomaton SEP "and") -> <:str_item< def $_list:jal$ >> ] ] ; expr: LEVEL "top" [ [ "def"; jal = V (LIST1 joinautomaton SEP "and"); "in"; e = expr LEVEL "top"-> <:expr< def $_list:jal$ in $e$ >> ] ] ; expr: LEVEL "apply" [ [ "reply"; eo = V (OPT expr); "to"; ji = joinident -> <:expr< reply $_opt:eo$ to $jid:ji$ >> ] ] ; expr: BEFORE ":=" [ [ "spawn"; e = SELF -> <:expr< spawn $e$ >> ] ] ; expr: LEVEL "&&" [ [ e1 = SELF; "&"; e2 = SELF -> <:expr< $e1$ & $e2$ >> ] ] ; joinautomaton: [ [ jcl = V (LIST1 joinclause SEP "or") -> {MLast.jcLoc = loc; MLast.jcVal = jcl} ] ] ; joinclause: [ [ jpl = V (LIST1 joinpattern SEP "&"); "="; e = expr -> (loc, jpl, e) ] ] ; joinpattern: [ [ ji = joinident; "("; op = V (OPT patt); ")" -> (loc, ji, op) ] ] ; joinident: [ [ i = V LIDENT -> (loc, i) ] ] ; END; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $lid:n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $lid:n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; (* ------------------------------------------------------------------------- *) (* Added by JRH *** *) (* ------------------------------------------------------------------------- *) EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pa_j_3.1x_6.xx.ml000066400000000000000000002751071303454263000156600ustar00rootroot00000000000000(* ------------------------------------------------------------------------- *) (* New version. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: pa_o.ml,v 6.33 2010-11-16 16:48:21 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_extend.cmo"; #load "q_MLast.cmo"; #load "pa_reloc.cmo"; open Pcaml; Pcaml.syntax_name.val := "OCaml"; Pcaml.no_constructors_arity.val := True; (* ------------------------------------------------------------------------- *) (* The main/reloc.ml file. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: reloc.ml,v 6.15 2010-11-14 11:20:26 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_macro.cmo"; open MLast; value option_map f = fun [ Some x -> Some (f x) | None -> None ] ; value vala_map f = IFNDEF STRICT THEN fun x -> f x ELSE fun [ Ploc.VaAnt s -> Ploc.VaAnt s | Ploc.VaVal x -> Ploc.VaVal (f x) ] END ; value class_infos_map floc f x = {ciLoc = floc x.ciLoc; ciVir = x.ciVir; ciPrm = let (x1, x2) = x.ciPrm in (floc x1, x2); ciNam = x.ciNam; ciExp = f x.ciExp} ; value anti_loc qloc sh loc loc1 = (* ...<:expr<.....$lid:...xxxxxxxx...$...>>... |..|-----------------------------------| qloc <-----> sh |.........|------------| loc |..|------| loc1 *) let sh1 = Ploc.first_pos qloc + sh in let sh2 = sh1 + Ploc.first_pos loc in let line_nb_qloc = Ploc.line_nb qloc in let line_nb_loc = Ploc.line_nb loc in let line_nb_loc1 = Ploc.line_nb loc1 in if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then Ploc.make_unlined (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) else Ploc.make_loc (Ploc.file_name loc) (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) (if line_nb_loc1 = 1 then if line_nb_loc = 1 then Ploc.bol_pos qloc else sh1 + Ploc.bol_pos loc else sh2 + Ploc.bol_pos loc1) (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" ; value rec reloc_ctyp floc sh = self where rec self = fun [ TyAcc loc x1 x2 -> let loc = floc loc in TyAcc loc (self x1) (self x2) | TyAli loc x1 x2 -> let loc = floc loc in TyAli loc (self x1) (self x2) | TyAny loc -> let loc = floc loc in TyAny loc | TyApp loc x1 x2 -> let loc = floc loc in TyApp loc (self x1) (self x2) | TyArr loc x1 x2 -> let loc = floc loc in TyArr loc (self x1) (self x2) | TyCls loc x1 -> let loc = floc loc in TyCls loc x1 | TyLab loc x1 x2 -> let loc = floc loc in TyLab loc x1 (self x2) | TyLid loc x1 -> let loc = floc loc in TyLid loc x1 | TyMan loc x1 x2 x3 -> let loc = floc loc in TyMan loc (self x1) x2 (self x3) | TyObj loc x1 x2 -> let loc = floc loc in TyObj loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) x2 | TyOlb loc x1 x2 -> let loc = floc loc in TyOlb loc x1 (self x2) | TyPck loc x1 -> let loc = floc loc in TyPck loc (reloc_module_type floc sh x1) | TyPol loc x1 x2 -> let loc = floc loc in TyPol loc x1 (self x2) | TyPot loc x1 x2 -> let loc = floc loc in TyPot loc x1 (self x2) | TyQuo loc x1 -> let loc = floc loc in TyQuo loc x1 | TyRec loc x1 -> let loc = floc loc in TyRec loc (vala_map (List.map (fun (loc, x1, x2, x3) -> (floc loc, x1, x2, self x3))) x1) | TySum loc x1 -> let loc = floc loc in TySum loc (vala_map (List.map (fun (loc, x1, x2, x3) -> (floc loc, x1, vala_map (List.map self) x2, option_map self x3))) x1) | TyTup loc x1 -> let loc = floc loc in TyTup loc (vala_map (List.map self) x1) | TyUid loc x1 -> let loc = floc loc in TyUid loc x1 | TyVrn loc x1 x2 -> let loc = floc loc in TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 | IFDEF STRICT THEN TyXtr loc x1 x2 -> let loc = floc loc in TyXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_poly_variant floc sh = fun [ PvTag loc x1 x2 x3 -> let loc = floc loc in PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) | PvInh loc x1 -> let loc = floc loc in PvInh loc (reloc_ctyp floc sh x1) ] and reloc_patt floc sh = self where rec self = fun [ PaAcc loc x1 x2 -> let loc = floc loc in PaAcc loc (self x1) (self x2) | PaAli loc x1 x2 -> let loc = floc loc in PaAli loc (self x1) (self x2) | PaAnt loc x1 -> let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_patt new_floc sh x1 | PaAny loc -> let loc = floc loc in PaAny loc | PaApp loc x1 x2 -> let loc = floc loc in PaApp loc (self x1) (self x2) | PaArr loc x1 -> let loc = floc loc in PaArr loc (vala_map (List.map self) x1) | PaChr loc x1 -> let loc = floc loc in PaChr loc x1 | PaFlo loc x1 -> let loc = floc loc in PaFlo loc x1 | PaInt loc x1 x2 -> let loc = floc loc in PaInt loc x1 x2 | PaLab loc x1 x2 -> let loc = floc loc in PaLab loc (self x1) (vala_map (option_map self) x2) | PaLaz loc x1 -> let loc = floc loc in PaLaz loc (self x1) | PaLid loc x1 -> let loc = floc loc in PaLid loc x1 | PaNty loc x1 -> let loc = floc loc in PaNty loc x1 | PaOlb loc x1 x2 -> let loc = floc loc in PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) | PaOrp loc x1 x2 -> let loc = floc loc in PaOrp loc (self x1) (self x2) | PaRec loc x1 -> let loc = floc loc in PaRec loc (vala_map (List.map (fun (x1, x2) -> (self x1, self x2))) x1) | PaRng loc x1 x2 -> let loc = floc loc in PaRng loc (self x1) (self x2) | PaStr loc x1 -> let loc = floc loc in PaStr loc x1 | PaTup loc x1 -> let loc = floc loc in PaTup loc (vala_map (List.map self) x1) | PaTyc loc x1 x2 -> let loc = floc loc in PaTyc loc (self x1) (reloc_ctyp floc sh x2) | PaTyp loc x1 -> let loc = floc loc in PaTyp loc x1 | PaUid loc x1 -> let loc = floc loc in PaUid loc x1 | PaUnp loc x1 x2 -> let loc = floc loc in PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) | PaVrn loc x1 -> let loc = floc loc in PaVrn loc x1 | IFDEF STRICT THEN PaXtr loc x1 x2 -> let loc = floc loc in PaXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_expr floc sh = self where rec self = fun [ ExAcc loc x1 x2 -> let loc = floc loc in ExAcc loc (self x1) (self x2) | ExAnt loc x1 -> let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in reloc_expr new_floc sh x1 | ExApp loc x1 x2 -> let loc = floc loc in ExApp loc (self x1) (self x2) | ExAre loc x1 x2 -> let loc = floc loc in ExAre loc (self x1) (self x2) | ExArr loc x1 -> let loc = floc loc in ExArr loc (vala_map (List.map self) x1) | ExAsr loc x1 -> let loc = floc loc in ExAsr loc (self x1) | ExAss loc x1 x2 -> let loc = floc loc in ExAss loc (self x1) (self x2) | ExBae loc x1 x2 -> let loc = floc loc in ExBae loc (self x1) (vala_map (List.map self) x2) | ExChr loc x1 -> let loc = floc loc in ExChr loc x1 | ExCoe loc x1 x2 x3 -> let loc = floc loc in ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) | ExFlo loc x1 -> let loc = floc loc in ExFlo loc x1 | ExFor loc x1 x2 x3 x4 x5 -> let loc = floc loc in ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) | ExFun loc x1 -> let loc = floc loc in ExFun loc (vala_map (List.map (fun (x1, x2, x3) -> (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x1) | ExIfe loc x1 x2 x3 -> let loc = floc loc in ExIfe loc (self x1) (self x2) (self x3) | ExInt loc x1 x2 -> let loc = floc loc in ExInt loc x1 x2 | ExLab loc x1 x2 -> let loc = floc loc in ExLab loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) | ExLaz loc x1 -> let loc = floc loc in ExLaz loc (self x1) | ExLet loc x1 x2 x3 -> let loc = floc loc in ExLet loc x1 (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) x2) (self x3) | ExLid loc x1 -> let loc = floc loc in ExLid loc x1 | ExLmd loc x1 x2 x3 -> let loc = floc loc in ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) | ExMat loc x1 x2 -> let loc = floc loc in ExMat loc (self x1) (vala_map (List.map (fun (x1, x2, x3) -> (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExNew loc x1 -> let loc = floc loc in ExNew loc x1 | ExObj loc x1 x2 -> let loc = floc loc in ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | ExOlb loc x1 x2 -> let loc = floc loc in ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) | ExOvr loc x1 -> let loc = floc loc in ExOvr loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) | ExPck loc x1 x2 -> let loc = floc loc in ExPck loc (reloc_module_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | ExRec loc x1 x2 -> let loc = floc loc in ExRec loc (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) x1) (option_map self x2) | ExSeq loc x1 -> let loc = floc loc in ExSeq loc (vala_map (List.map self) x1) | ExSnd loc x1 x2 -> let loc = floc loc in ExSnd loc (self x1) x2 | ExSte loc x1 x2 -> let loc = floc loc in ExSte loc (self x1) (self x2) | ExStr loc x1 -> let loc = floc loc in ExStr loc x1 | ExTry loc x1 x2 -> let loc = floc loc in ExTry loc (self x1) (vala_map (List.map (fun (x1, x2, x3) -> (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) x2) | ExTup loc x1 -> let loc = floc loc in ExTup loc (vala_map (List.map self) x1) | ExTyc loc x1 x2 -> let loc = floc loc in ExTyc loc (self x1) (reloc_ctyp floc sh x2) | ExUid loc x1 -> let loc = floc loc in ExUid loc x1 | ExVrn loc x1 -> let loc = floc loc in ExVrn loc x1 | ExWhi loc x1 x2 -> let loc = floc loc in ExWhi loc (self x1) (vala_map (List.map self) x2) | IFDEF STRICT THEN ExXtr loc x1 x2 -> let loc = floc loc in ExXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_module_type floc sh = self where rec self = fun [ MtAcc loc x1 x2 -> let loc = floc loc in MtAcc loc (self x1) (self x2) | MtApp loc x1 x2 -> let loc = floc loc in MtApp loc (self x1) (self x2) | MtFun loc x1 x2 x3 -> let loc = floc loc in MtFun loc x1 (self x2) (self x3) | MtLid loc x1 -> let loc = floc loc in MtLid loc x1 | MtQuo loc x1 -> let loc = floc loc in MtQuo loc x1 | MtSig loc x1 -> let loc = floc loc in MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) | MtTyo loc x1 -> let loc = floc loc in MtTyo loc (reloc_module_expr floc sh x1) | MtUid loc x1 -> let loc = floc loc in MtUid loc x1 | MtWit loc x1 x2 -> let loc = floc loc in MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) | IFDEF STRICT THEN MtXtr loc x1 x2 -> let loc = floc loc in MtXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_sig_item floc sh = self where rec self = fun [ SgCls loc x1 -> let loc = floc loc in SgCls loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgClt loc x1 -> let loc = floc loc in SgClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | SgDcl loc x1 -> let loc = floc loc in SgDcl loc (vala_map (List.map self) x1) | SgDir loc x1 x2 -> let loc = floc loc in SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | SgExc loc x1 x2 -> let loc = floc loc in SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | SgExt loc x1 x2 x3 -> let loc = floc loc in SgExt loc x1 (reloc_ctyp floc sh x2) x3 | SgInc loc x1 -> let loc = floc loc in SgInc loc (reloc_module_type floc sh x1) | SgMod loc x1 x2 -> let loc = floc loc in SgMod loc x1 (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_type floc sh x2))) x2) | SgMty loc x1 x2 -> let loc = floc loc in SgMty loc x1 (reloc_module_type floc sh x2) | SgOpn loc x1 -> let loc = floc loc in SgOpn loc x1 | SgTyp loc x1 -> let loc = floc loc in SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | SgUse loc x1 x2 -> let loc = floc loc in SgUse loc x1 (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) | SgVal loc x1 x2 -> let loc = floc loc in SgVal loc x1 (reloc_ctyp floc sh x2) | IFDEF STRICT THEN SgXtr loc x1 x2 -> let loc = floc loc in SgXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_with_constr floc sh = fun [ WcMod loc x1 x2 -> let loc = floc loc in WcMod loc x1 (reloc_module_expr floc sh x2) | WcMos loc x1 x2 -> let loc = floc loc in WcMos loc x1 (reloc_module_expr floc sh x2) | WcTyp loc x1 x2 x3 x4 -> let loc = floc loc in WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) | WcTys loc x1 x2 x3 -> let loc = floc loc in WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_module_expr floc sh = self where rec self = fun [ MeAcc loc x1 x2 -> let loc = floc loc in MeAcc loc (self x1) (self x2) | MeApp loc x1 x2 -> let loc = floc loc in MeApp loc (self x1) (self x2) | MeFun loc x1 x2 x3 -> let loc = floc loc in MeFun loc x1 (reloc_module_type floc sh x2) (self x3) | MeStr loc x1 -> let loc = floc loc in MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) | MeTyc loc x1 x2 -> let loc = floc loc in MeTyc loc (self x1) (reloc_module_type floc sh x2) | MeUid loc x1 -> let loc = floc loc in MeUid loc x1 | MeUnp loc x1 x2 -> let loc = floc loc in MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) | IFDEF STRICT THEN MeXtr loc x1 x2 -> let loc = floc loc in MeXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_str_item floc sh = self where rec self = fun [ StCls loc x1 -> let loc = floc loc in StCls loc (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) | StClt loc x1 -> let loc = floc loc in StClt loc (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) | StDcl loc x1 -> let loc = floc loc in StDcl loc (vala_map (List.map self) x1) | StDir loc x1 x2 -> let loc = floc loc in StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) | StExc loc x1 x2 x3 -> let loc = floc loc in StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 | StExp loc x1 -> let loc = floc loc in StExp loc (reloc_expr floc sh x1) | StExt loc x1 x2 x3 -> let loc = floc loc in StExt loc x1 (reloc_ctyp floc sh x2) x3 | StInc loc x1 -> let loc = floc loc in StInc loc (reloc_module_expr floc sh x1) | StMod loc x1 x2 -> let loc = floc loc in StMod loc x1 (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_expr floc sh x2))) x2) | StMty loc x1 x2 -> let loc = floc loc in StMty loc x1 (reloc_module_type floc sh x2) | StOpn loc x1 -> let loc = floc loc in StOpn loc x1 | StTyp loc x1 -> let loc = floc loc in StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) | StUse loc x1 x2 -> let loc = floc loc in StUse loc x1 (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) | StVal loc x1 x2 -> let loc = floc loc in StVal loc x1 (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) | IFDEF STRICT THEN StXtr loc x1 x2 -> let loc = floc loc in StXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_type_decl floc sh x = {tdNam = vala_map (fun (loc, x1) -> (floc loc, x1)) x.tdNam; tdPrm = x.tdPrm; tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; tdCon = vala_map (List.map (fun (x1, x2) -> (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) x.tdCon} and reloc_class_type floc sh = self where rec self = fun [ CtAcc loc x1 x2 -> let loc = floc loc in CtAcc loc (self x1) (self x2) | CtApp loc x1 x2 -> let loc = floc loc in CtApp loc (self x1) (self x2) | CtCon loc x1 x2 -> let loc = floc loc in CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) | CtFun loc x1 x2 -> let loc = floc loc in CtFun loc (reloc_ctyp floc sh x1) (self x2) | CtIde loc x1 -> let loc = floc loc in CtIde loc x1 | CtSig loc x1 x2 -> let loc = floc loc in CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) (vala_map (List.map (reloc_class_sig_item floc sh)) x2) | IFDEF STRICT THEN CtXtr loc x1 x2 -> let loc = floc loc in CtXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_class_sig_item floc sh = self where rec self = fun [ CgCtr loc x1 x2 -> let loc = floc loc in CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CgDcl loc x1 -> let loc = floc loc in CgDcl loc (vala_map (List.map self) x1) | CgInh loc x1 -> let loc = floc loc in CgInh loc (reloc_class_type floc sh x1) | CgMth loc x1 x2 x3 -> let loc = floc loc in CgMth loc x1 x2 (reloc_ctyp floc sh x3) | CgVal loc x1 x2 x3 -> let loc = floc loc in CgVal loc x1 x2 (reloc_ctyp floc sh x3) | CgVir loc x1 x2 x3 -> let loc = floc loc in CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] and reloc_class_expr floc sh = self where rec self = fun [ CeApp loc x1 x2 -> let loc = floc loc in CeApp loc (self x1) (reloc_expr floc sh x2) | CeCon loc x1 x2 -> let loc = floc loc in CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) | CeFun loc x1 x2 -> let loc = floc loc in CeFun loc (reloc_patt floc sh x1) (self x2) | CeLet loc x1 x2 x3 -> let loc = floc loc in CeLet loc x1 (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) x2) (self x3) | CeStr loc x1 x2 -> let loc = floc loc in CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) (vala_map (List.map (reloc_class_str_item floc sh)) x2) | CeTyc loc x1 x2 -> let loc = floc loc in CeTyc loc (self x1) (reloc_class_type floc sh x2) | IFDEF STRICT THEN CeXtr loc x1 x2 -> let loc = floc loc in CeXtr loc x1 (option_map (vala_map self) x2) END ] and reloc_class_str_item floc sh = self where rec self = fun [ CrCtr loc x1 x2 -> let loc = floc loc in CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) | CrDcl loc x1 -> let loc = floc loc in CrDcl loc (vala_map (List.map self) x1) | CrInh loc x1 x2 -> let loc = floc loc in CrInh loc (reloc_class_expr floc sh x1) x2 | CrIni loc x1 -> let loc = floc loc in CrIni loc (reloc_expr floc sh x1) | CrMth loc x1 x2 x3 x4 x5 -> let loc = floc loc in CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) (reloc_expr floc sh x5) | CrVal loc x1 x2 x3 x4 -> let loc = floc loc in CrVal loc x1 x2 x3 (reloc_expr floc sh x4) | CrVav loc x1 x2 x3 -> let loc = floc loc in CrVav loc x1 x2 (reloc_ctyp floc sh x3) | CrVir loc x1 x2 x3 -> let loc = floc loc in CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] ; (* Equality over syntax trees *) value eq_expr x y = reloc_expr (fun _ -> Ploc.dummy) 0 x = reloc_expr (fun _ -> Ploc.dummy) 0 y ; value eq_patt x y = reloc_patt (fun _ -> Ploc.dummy) 0 x = reloc_patt (fun _ -> Ploc.dummy) 0 y ; value eq_ctyp x y = reloc_ctyp (fun _ -> Ploc.dummy) 0 x = reloc_ctyp (fun _ -> Ploc.dummy) 0 y ; value eq_str_item x y = reloc_str_item (fun _ -> Ploc.dummy) 0 x = reloc_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_sig_item x y = reloc_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_module_expr x y = reloc_module_expr (fun _ -> Ploc.dummy) 0 x = reloc_module_expr (fun _ -> Ploc.dummy) 0 y ; value eq_module_type x y = reloc_module_type (fun _ -> Ploc.dummy) 0 x = reloc_module_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_sig_item x y = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y ; value eq_class_str_item x y = reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = reloc_class_str_item (fun _ -> Ploc.dummy) 0 y ; value eq_class_type x y = reloc_class_type (fun _ -> Ploc.dummy) 0 x = reloc_class_type (fun _ -> Ploc.dummy) 0 y ; value eq_class_expr x y = reloc_class_expr (fun _ -> Ploc.dummy) 0 x = reloc_class_expr (fun _ -> Ploc.dummy) 0 y ; (* ------------------------------------------------------------------------- *) (* Now the lexer. *) (* ------------------------------------------------------------------------- *) (* camlp5r *) (* $Id: plexer.ml,v 6.11 2010-10-04 20:14:58 deraugla Exp $ *) (* Copyright (c) INRIA 2007-2010 *) #load "pa_lexer.cmo"; (* ------------------------------------------------------------------------- *) (* Added by JRH as a backdoor to change lexical conventions. *) (* ------------------------------------------------------------------------- *) value jrh_lexer = ref False; open Versdep; value no_quotations = ref False; value error_on_unknown_keywords = ref False; value dollar_for_antiquotation = ref True; value specific_space_dot = ref False; value force_antiquot_loc = ref False; type context = { after_space : mutable bool; dollar_for_antiquotation : bool; specific_space_dot : bool; find_kwd : string -> string; line_cnt : int -> char -> unit; set_line_nb : unit -> unit; make_lined_loc : (int * int) -> string -> Ploc.t } ; value err ctx loc msg = Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) ; (* ------------------------------------------------------------------------- *) (* JRH's hack to make the case distinction "unmixed" versus "mixed" *) (* ------------------------------------------------------------------------- *) value is_uppercase s = String.uppercase s = s; value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); value jrh_identifier find_kwd id = let jflag = jrh_lexer.val in if id = "set_jrh_lexer" then (let _ = jrh_lexer.val := True in ("",find_kwd "true")) else if id = "unset_jrh_lexer" then (let _ = jrh_lexer.val := False in ("",find_kwd "false")) else try ("", find_kwd id) with [ Not_found -> if not(jflag) then if is_uppercase (String.sub id 0 1) then ("UIDENT", id) else ("LIDENT", id) else if is_uppercase (String.sub id 0 1) && is_only_lowercase (String.sub id 1 (String.length id - 1)) (***** JRH: Carl's alternative version then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; *****) then ("UIDENT", id) else ("LIDENT", id)]; (* ------------------------------------------------------------------------- *) (* Back to original file with the mod of using the above. *) (* ------------------------------------------------------------------------- *) value keyword_or_error ctx loc s = try ("", ctx.find_kwd s) with [ Not_found -> if error_on_unknown_keywords.val then err ctx loc ("illegal token: " ^ s) else ("", s) ] ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; value utf8_lexing = ref False; value misc_letter buf strm = if utf8_lexing.val then match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] else match strm with lexer [ '\128'-'\255' ] ; value misc_punct buf strm = if utf8_lexing.val then match strm with lexer [ '\226' _ _ ] else match strm with parser [] ; value rec ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] ; value rec ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] ident2! | ] ; value rec ident3 = lexer [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | '$' | '\128'-'\255' ] ident3! | ] ; value binary = lexer [ '0' | '1' ]; value octal = lexer [ '0'-'7' ]; value decimal = lexer [ '0'-'9' ]; value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; value end_integer = lexer [ "l"/ -> ("INT_l", $buf) | "L"/ -> ("INT_L", $buf) | "n"/ -> ("INT_n", $buf) | -> ("INT", $buf) ] ; value rec digits_under kind = lexer [ kind (digits_under kind)! | "_" (digits_under kind)! | end_integer ] ; value digits kind = lexer [ kind (digits_under kind)! | -> raise (Stream.Error "ill-formed integer constant") ] ; value rec decimal_digits_under = lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] ; value exponent_part = lexer [ [ 'e' | 'E' ] [ '+' | '-' | ] '0'-'9' ? "ill-formed floating-point constant" decimal_digits_under! ] ; value number = lexer [ decimal_digits_under "." decimal_digits_under! exponent_part -> ("FLOAT", $buf) | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) | decimal_digits_under exponent_part -> ("FLOAT", $buf) | decimal_digits_under end_integer! ] ; value char_after_bslash = lexer [ "'"/ | _ [ "'"/ | _ [ "'"/ | ] ] ] ; value char ctx bp = lexer [ "\\" _ char_after_bslash! | "\\" -> err ctx (bp, $pos) "char not terminated" | ?= [ _ '''] _! "'"/ ] ; value any ctx buf = parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } ; value rec string ctx bp = lexer [ "\""/ | "\\" (any ctx) (string ctx bp)! | (any ctx) (string ctx bp)! | -> err ctx (bp, $pos) "string not terminated" ] ; value rec qstring ctx bp = lexer [ "`"/ | (any ctx) (qstring ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value comment ctx bp = comment where rec comment = lexer [ "*)" | "*" comment! | "(*" comment! comment! | "(" comment! | "\"" (string ctx bp)! [ -> $add "\"" ] comment! | "'*)" | "'*" comment! | "'" (any ctx) comment! | (any ctx) comment! | -> err ctx (bp, $pos) "comment not terminated" ] ; value rec quotation ctx bp = lexer [ ">>"/ | ">" (quotation ctx bp)! | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! | "<:" ident! (quotation ctx bp)! | "<" (quotation ctx bp)! | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! | "\\" (quotation ctx bp)! | (any ctx) (quotation ctx bp)! | -> err ctx (bp, $pos) "quotation not terminated" ] ; value less_expected = "character '<' expected"; value less ctx bp buf strm = if no_quotations.val then match strm with lexer [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] else match strm with lexer [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> ("QUOTATION", $buf) | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value rec antiquot_rest ctx bp = lexer [ "$"/ | "\\"/ (any ctx) (antiquot_rest ctx bp)! | (any ctx) (antiquot_rest ctx bp)! | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value rec antiquot ctx bp = lexer [ "$"/ -> ":" ^ $buf | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! | ":" (antiquot_rest ctx bp)! -> $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; value rec antiquot_loc ctx bp = lexer [ "$"/ -> antiloc bp $pos (":" ^ $buf) | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) | -> err ctx (bp, $pos) "antiquotation not terminated" ] ; value dollar ctx bp buf strm = if not no_quotations.val && ctx.dollar_for_antiquotation then ("ANTIQUOT", antiquot ctx bp buf strm) else if force_antiquot_loc.val then ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) else match strm with lexer [ [ -> $add "$" ] ident2! -> ("", $buf) ] ; (* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?abc:d ?abc ?$abc:d$: ?abc:d: ?abc: ?$d$ ?:d ? ?$d$: ?:d: ?: *) (* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON input expr patt ----- ---- ---- ?$abc:d$ ?8,13:abc:d ?abc ?$abc:d$: ?8,13:abc:d: ?abc: ?$d$ ?8,9::d ? ?$d$: ?8,9::d: ?: *) value question ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "?" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "?" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "?" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tilde ctx bp buf strm = if ctx.dollar_for_antiquotation then match strm with parser [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> ("ANTIQUOT", "~" ^ s ^ ":") | [: `'$'; s = antiquot ctx bp $empty :] -> ("ANTIQUOT", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else if force_antiquot_loc.val then match strm with parser [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> ("ANTIQUOT_LOC", "~" ^ s ^ ":") | [: `'$'; s = antiquot_loc ctx bp $empty :] -> ("ANTIQUOT_LOC", "~" ^ s) | [: :] -> match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] else match strm with lexer [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ; value tildeident = lexer [ ":"/ -> ("TILDEIDENTCOLON", $buf) | -> ("TILDEIDENT", $buf) ] ; value questionident = lexer [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) | -> ("QUESTIONIDENT", $buf) ] ; value rec linedir n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir (n + 1) s | Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> False ] and linedir_digits n s = match stream_peek_nth n s with [ Some ('0'..'9') -> linedir_digits (n + 1) s | _ -> linedir_quote n s ] and linedir_quote n s = match stream_peek_nth n s with [ Some (' ' | '\t') -> linedir_quote (n + 1) s | Some '"' -> True | _ -> False ] ; value rec any_to_nl = lexer [ "\r" | "\n" | _ any_to_nl! | ] ; value next_token_after_spaces ctx bp = lexer [ 'A'-'Z' ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] *********) | [ 'a'-'z' | '_' | misc_letter ] ident! -> let id = $buf in jrh_identifier ctx.find_kwd id (********** JRH: original was try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] *********) | '1'-'9' number! | "0" [ 'o' | 'O' ] (digits octal)! | "0" [ 'x' | 'X' ] (digits hexa)! | "0" [ 'b' | 'B' ] (digits binary)! | "0" number! | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" | "'"/ (char ctx bp) -> ("CHAR", $buf) | "'" -> keyword_or_error ctx (bp, $pos) "'" | "\""/ (string ctx bp)! -> ("STRING", $buf) (*** Line added by JRH ***) | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) | "$"/ (dollar ctx bp)! | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> keyword_or_error ctx (bp, $pos) $buf | "~"/ 'a'-'z' ident! tildeident! | "~"/ '_' ident! tildeident! | "~" (tilde ctx bp) | "?"/ 'a'-'z' ident! questionident! | "?" (question ctx bp)! | "<"/ (less ctx bp)! | ":]" -> keyword_or_error ctx (bp, $pos) $buf | "::" -> keyword_or_error ctx (bp, $pos) $buf | ":=" -> keyword_or_error ctx (bp, $pos) $buf | ":>" -> keyword_or_error ctx (bp, $pos) $buf | ":" -> keyword_or_error ctx (bp, $pos) $buf | ">]" -> keyword_or_error ctx (bp, $pos) $buf | ">}" -> keyword_or_error ctx (bp, $pos) $buf | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "|]" -> keyword_or_error ctx (bp, $pos) $buf | "|}" -> keyword_or_error ctx (bp, $pos) $buf | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "[|" -> keyword_or_error ctx (bp, $pos) $buf | "[<" -> keyword_or_error ctx (bp, $pos) $buf | "[:" -> keyword_or_error ctx (bp, $pos) $buf | "[" -> keyword_or_error ctx (bp, $pos) $buf | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf | "{|" -> keyword_or_error ctx (bp, $pos) $buf | "{<" -> keyword_or_error ctx (bp, $pos) $buf | "{:" -> keyword_or_error ctx (bp, $pos) $buf | "{" -> keyword_or_error ctx (bp, $pos) $buf | ".." -> keyword_or_error ctx (bp, $pos) ".." | "." -> let id = if ctx.specific_space_dot && ctx.after_space then " ." else "." in keyword_or_error ctx (bp, $pos) id | ";;" -> keyword_or_error ctx (bp, $pos) ";;" | ";" -> keyword_or_error ctx (bp, $pos) ";" | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf | "\\"/ ident3! -> ("LIDENT", $buf) | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] ; value get_comment buf strm = $buf; value rec next_token ctx buf = parser bp [ [: `('\n' | '\r' as c); s :] ep -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := ep; ctx.set_line_nb (); ctx.after_space := True; next_token ctx ($add c) s } | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { ctx.after_space := True; next_token ctx ($add c) s } | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> let comm = get_comment buf () in if linedir 1 s then do { let buf = any_to_nl ($add '#') s in incr Plexing.line_nb.val; Plexing.bol_pos.val.val := Stream.count s; ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } else let loc = ctx.make_lined_loc (bp, bp + 1) comm in (keyword_or_error ctx (bp, bp + 1) "#", loc) | [: `'('; a = parser [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { ctx.set_line_nb (); ctx.after_space := True; next_token ctx buf s } | [: :] ep -> let loc = ctx.make_lined_loc (bp, ep) $buf in (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a | [: comm = get_comment buf; tok = next_token_after_spaces ctx bp $empty :] ep -> let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in (tok, loc) | [: comm = get_comment buf; _ = Stream.empty :] -> let loc = ctx.make_lined_loc (bp, bp + 1) comm in (("EOI", ""), loc) ] ; value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = try do { match Plexing.restore_lexing_info.val with [ Some (line_nb, bol_pos) -> do { s_line_nb.val := line_nb; s_bol_pos.val := bol_pos; Plexing.restore_lexing_info.val := None; } | None -> () ]; Plexing.line_nb.val := s_line_nb; Plexing.bol_pos.val := s_bol_pos; let comm_bp = Stream.count cstrm in ctx.set_line_nb (); ctx.after_space := False; let (r, loc) = next_token ctx $empty cstrm in match glexr.val.Plexing.tok_comm with [ Some list -> if Ploc.first_pos loc > comm_bp then let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in glexr.val.Plexing.tok_comm := Some [comm_loc :: list] else () | None -> () ]; (r, loc) } with [ Stream.Error str -> err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] ; value func kwd_table glexr = let ctx = let line_nb = ref 0 in let bol_pos = ref 0 in {after_space = False; dollar_for_antiquotation = dollar_for_antiquotation.val; specific_space_dot = specific_space_dot.val; find_kwd = Hashtbl.find kwd_table; line_cnt bp1 c = match c with [ '\n' | '\r' -> do { if c = '\n' then incr Plexing.line_nb.val else (); Plexing.bol_pos.val.val := bp1 + 1; } | c -> () ]; set_line_nb () = do { line_nb.val := Plexing.line_nb.val.val; bol_pos.val := Plexing.bol_pos.val.val; }; make_lined_loc loc comm = Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} in Plexing.lexer_func_of_parser (next_token_fun ctx glexr) ; value rec check_keyword_stream = parser [: _ = check $empty; _ = Stream.empty :] -> True and check = lexer [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' ] check_ident2! | "$" check_ident2! | "<" ?= [ ":" | "<" ] | "<" check_ident2! | ":]" | "::" | ":=" | ":>" | ":" | ">]" | ">}" | ">" check_ident2! | "|]" | "|}" | "|" check_ident2! | "[" ?= [ "<<" | "<:" ] | "[|" | "[<" | "[:" | "[" | "{" ?= [ "<<" | "<:" ] | "{|" | "{<" | "{:" | "{" | ";;" | ";" | misc_punct check_ident2! | _ ] and check_ident = lexer [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] check_ident! | ] and check_ident2 = lexer [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | '.' | ':' | '<' | '>' | '|' | misc_punct ] check_ident2! | ] ; value check_keyword s = try check_keyword_stream (Stream.of_string s) with _ -> False ; value error_no_respect_rules p_con p_prm = raise (Plexing.Error ("the token " ^ (if p_con = "" then "\"" ^ p_prm ^ "\"" else if p_prm = "" then p_con else p_con ^ " \"" ^ p_prm ^ "\"") ^ " does not respect Plexer rules")) ; value error_ident_and_keyword p_con p_prm = raise (Plexing.Error ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ " and as keyword")) ; value using_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> if not (hashtbl_mem kwd_table p_prm) then if check_keyword p_prm then if hashtbl_mem ident_table p_prm then error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm else Hashtbl.add kwd_table p_prm p_prm else error_no_respect_rules p_con p_prm else () | "LIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'A'..'Z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "UIDENT" -> if p_prm = "" then () else match p_prm.[0] with [ 'a'..'z' -> error_no_respect_rules p_con p_prm | _ -> if hashtbl_mem kwd_table p_prm then error_ident_and_keyword p_con p_prm else Hashtbl.add ident_table p_prm p_con ] | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | "CHAR" | "STRING" | "QUOTATION" | "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> () | _ -> raise (Plexing.Error ("the constructor \"" ^ p_con ^ "\" is not recognized by Plexer")) ] ; value removing_token kwd_table ident_table (p_con, p_prm) = match p_con with [ "" -> Hashtbl.remove kwd_table p_prm | "LIDENT" | "UIDENT" -> if p_prm <> "" then Hashtbl.remove ident_table p_prm else () | _ -> () ] ; value text = fun [ ("", t) -> "'" ^ t ^ "'" | ("LIDENT", "") -> "lowercase identifier" | ("LIDENT", t) -> "'" ^ t ^ "'" | ("UIDENT", "") -> "uppercase identifier" | ("UIDENT", t) -> "'" ^ t ^ "'" | ("INT", "") -> "integer" | ("INT", s) -> "'" ^ s ^ "'" | ("FLOAT", "") -> "float" | ("STRING", "") -> "string" | ("CHAR", "") -> "char" | ("QUOTATION", "") -> "quotation" | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" | ("EOI", "") -> "end of input" | (con, "") -> con | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] ; value eq_before_colon p e = loop 0 where rec loop i = if i == String.length e then failwith "Internal error in Plexer: incorrect ANTIQUOT" else if i == String.length p then e.[i] == ':' else if p.[i] == e.[i] then loop (i + 1) else False ; value after_colon e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 1) with [ Not_found -> "" ] ; value after_colon_except_last e = try let i = String.index e ':' in String.sub e (i + 1) (String.length e - i - 2) with [ Not_found -> "" ] ; value tok_match = fun [ ("ANTIQUOT", p_prm) -> if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then if p_prm.[String.length p_prm - 1] = ':' then let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then if eq_before_colon p_prm prm then after_colon_except_last prm else raise Stream.Failure else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) -> if prm <> "" && prm.[String.length prm - 1] = ':' then raise Stream.Failure else if eq_before_colon p_prm prm then after_colon prm else raise Stream.Failure | _ -> raise Stream.Failure ] else fun [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm | _ -> raise Stream.Failure ] | tok -> Plexing.default_match tok ] ; value gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in let glexr = ref {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; tok_match = fun []; tok_text = fun []; tok_comm = None} in let glex = {Plexing.tok_func = func kwd_table glexr; tok_using = using_token kwd_table id_table; tok_removing = removing_token kwd_table id_table; tok_match = tok_match; tok_text = text; tok_comm = None} in do { glexr.val := glex; glex } ; (* ------------------------------------------------------------------------- *) (* Back to etc/pa_o.ml *) (* ------------------------------------------------------------------------- *) do { let odfa = dollar_for_antiquotation.val in dollar_for_antiquotation.val := False; Grammar.Unsafe.gram_reinit gram (gmake ()); dollar_for_antiquotation.val := odfa; Grammar.Unsafe.clear_entry interf; Grammar.Unsafe.clear_entry implem; Grammar.Unsafe.clear_entry top_phrase; Grammar.Unsafe.clear_entry use_file; Grammar.Unsafe.clear_entry module_type; Grammar.Unsafe.clear_entry module_expr; Grammar.Unsafe.clear_entry sig_item; Grammar.Unsafe.clear_entry str_item; Grammar.Unsafe.clear_entry signature; Grammar.Unsafe.clear_entry structure; Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; Grammar.Unsafe.clear_entry type_decl; Grammar.Unsafe.clear_entry constructor_declaration; Grammar.Unsafe.clear_entry label_declaration; Grammar.Unsafe.clear_entry match_case; Grammar.Unsafe.clear_entry with_constr; Grammar.Unsafe.clear_entry poly_variant; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; Grammar.Unsafe.clear_entry class_str_item }; Pcaml.parse_interf.val := Grammar.Entry.parse interf; Pcaml.parse_implem.val := Grammar.Entry.parse implem; value mklistexp loc last = loop True where rec loop top = fun [ [] -> match last with [ Some e -> e | None -> <:expr< [] >> ] | [e1 :: el] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc in <:expr< [$e1$ :: $loop False el$] >> ] ; value mklistpat loc last = loop True where rec loop top = fun [ [] -> match last with [ Some p -> p | None -> <:patt< [] >> ] | [p1 :: pl] -> let loc = if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc in <:patt< [$p1$ :: $loop False pl$] >> ] ; (*** JRH pulled this outside so user can add new infixes here too ***) value ht = Hashtbl.create 73; (*** And JRH added all the new HOL Light infixes here already ***) value is_operator = do { let ct = Hashtbl.create 73 in List.iter (fun x -> Hashtbl.add ht x True) ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; "THEN_TCL"; "ORELSE_TCL"]; List.iter (fun x -> Hashtbl.add ct x True) ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; '?'; '%'; '.'; '$']; fun x -> try Hashtbl.find ht x with [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] }; (*** JRH added this so parenthesised operators undergo same mapping ***) value translate_operator = fun s -> match s with [ "THEN" -> "then_" | "THENC" -> "thenc_" | "THENL" -> "thenl_" | "ORELSE" -> "orelse_" | "ORELSEC" -> "orelsec_" | "THEN_TCL" -> "then_tcl_" | "ORELSE_TCL" -> "orelse_tcl_" | "F_F" -> "f_f_" | _ -> s]; value operator_rparen = Grammar.Entry.of_parser gram "operator_rparen" (fun strm -> match Stream.npeek 2 strm with [ [("", s); ("", ")")] when is_operator s -> do { Stream.junk strm; Stream.junk strm; translate_operator s } | _ -> raise Stream.Failure ]) ; value check_not_part_of_patt = Grammar.Entry.of_parser gram "check_not_part_of_patt" (fun strm -> let tok = match Stream.npeek 4 strm with [ [("LIDENT", _); tok :: _] -> tok | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok | _ -> raise Stream.Failure ] in match tok with [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure | _ -> () ]) ; value symbolchar = let list = ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~'] in loop where rec loop s i = if i == String.length s then True else if List.mem s.[i] list then loop s (i + 1) else False ; value prefixop = let list = ['!'; '?'; '~'] in let excl = ["!="; "??"; "?!"] in Grammar.Entry.of_parser gram "prefixop" (parser [: `("", x) when not (List.mem x excl) && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop0 = let list = ['='; '<'; '>'; '|'; '&'; '$'] in let excl = ["<-"; "||"; "&&"] in Grammar.Entry.of_parser gram "infixop0" (parser [: `("", x) when not (List.mem x excl) && (x = "$" || String.length x >= 2) && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop1 = let list = ['@'; '^'] in Grammar.Entry.of_parser gram "infixop1" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop2 = let list = ['+'; '-'] in Grammar.Entry.of_parser gram "infixop2" (parser [: `("", x) when x <> "->" && String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop3 = let list = ['*'; '/'; '%'] in Grammar.Entry.of_parser gram "infixop3" (parser [: `("", x) when String.length x >= 2 && List.mem x.[0] list && symbolchar x 1 :] -> x) ; value infixop4 = Grammar.Entry.of_parser gram "infixop4" (parser [: `("", x) when String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && symbolchar x 2 :] -> x) ; value test_constr_decl = Grammar.Entry.of_parser gram "test_constr_decl" (fun strm -> match Stream.npeek 1 strm with [ [("UIDENT", _)] -> match Stream.npeek 2 strm with [ [_; ("", ".")] -> raise Stream.Failure | [_; ("", "(")] -> raise Stream.Failure | [_ :: _] -> () | _ -> raise Stream.Failure ] | [("", "|")] -> () | _ -> raise Stream.Failure ]) ; value stream_peek_nth n strm = loop n (Stream.npeek n strm) where rec loop n = fun [ [] -> None | [x] -> if n == 1 then Some x else None | [_ :: l] -> loop (n - 1) l ] ; (* horrible hack to be able to parse class_types *) value test_ctyp_minusgreater = Grammar.Entry.of_parser gram "test_ctyp_minusgreater" (fun strm -> let rec skip_simple_ctyp n = match stream_peek_nth n strm with [ Some ("", "->") -> n | Some ("", "[" | "[<") -> skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) | Some ("", "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | "_") -> skip_simple_ctyp (n + 1) | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> skip_simple_ctyp (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some ("", prm) when prm = end_kwd -> n | Some ("", "[" | "[<") -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in match Stream.peek strm with [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 | Some ("", "object") -> raise Stream.Failure | _ -> 1 ]) ; value test_label_eq = Grammar.Entry.of_parser gram "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm | Some ("ANTIQUOT_LOC", _) -> () | Some ("", "=") -> () | _ -> raise Stream.Failure ]) ; value test_typevar_list_dot = Grammar.Entry.of_parser gram "test_typevar_list_dot" (let rec test lev strm = match stream_peek_nth lev strm with [ Some ("", "'") -> test2 (lev + 1) strm | Some ("", ".") -> () | _ -> raise Stream.Failure ] and test2 lev strm = match stream_peek_nth lev strm with [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm | _ -> raise Stream.Failure ] in test 1) ; value e_phony = Grammar.Entry.of_parser gram "e_phony" (parser []) ; value p_phony = Grammar.Entry.of_parser gram "p_phony" (parser []) ; value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; value rec is_expr_constr_call = fun [ <:expr< $uid:_$ >> -> True | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e | <:expr< $e$ $_$ >> -> is_expr_constr_call e | _ -> False ] ; value rec constr_expr_arity loc = fun [ <:expr< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e | _ -> 1 ] ; value rec constr_patt_arity loc = fun [ <:patt< $uid:c$ >> -> try List.assoc c constr_arity.val with [ Not_found -> 0 ] | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p | _ -> 1 ] ; value get_seq = fun [ <:expr< do { $list:el$ } >> -> el | e -> [e] ] ; value mem_tvar s tpl = List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl ; value choose_tvar tpl = let rec find_alpha v = let s = String.make 1 v in if mem_tvar s tpl then if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) else Some (String.make 1 v) in let rec make_n n = let v = "a" ^ string_of_int n in if mem_tvar v tpl then make_n (succ n) else v in match find_alpha 'a' with [ Some x -> x | None -> make_n 1 ] ; value quotation_content s = do { loop 0 where rec loop i = if i = String.length s then ("", s) else if s.[i] = ':' || s.[i] = '@' then let i = i + 1 in (String.sub s 0 i, String.sub s i (String.length s - i)) else loop (i + 1) }; value concat_comm loc e = let loc = Ploc.with_comment loc (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) in let floc = let first = ref True in fun loc1 -> if first.val then do {first.val := False; loc} else loc1 in reloc_expr floc 0 e ; EXTEND GLOBAL: sig_item str_item ctyp patt expr module_type module_expr signature structure class_type class_expr class_sig_item class_str_item let_binding type_decl constructor_declaration label_declaration match_case with_constr poly_variant; module_expr: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; "->"; me = SELF -> <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> | "struct"; st = structure; "end" -> <:module_expr< struct $_list:st$ end >> ] | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] | [ i = mod_expr_ident -> i | "("; "val"; e = expr; ":"; mt = module_type; ")" -> <:module_expr< (value $e$ : $mt$) >> | "("; "val"; e = expr; ")" -> <:module_expr< (value $e$) >> | "("; me = SELF; ":"; mt = module_type; ")" -> <:module_expr< ( $me$ : $mt$ ) >> | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] ; structure: [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] ; mod_expr_ident: [ LEFTA [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] ; str_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration; b = rebind_exn -> <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; me = module_expr -> <:str_item< include $me$ >> | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> <:str_item< module $_flag:r$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:str_item< module type $_uid:i$ = $mt$ >> | "open"; i = V mod_ident "list" "" -> <:str_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:str_item< type $_list:tdl$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr -> let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in <:str_item< $exp:e$ >> | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> match l with [ <:vala< [(p, e)] >> -> match p with [ <:patt< _ >> -> <:str_item< $exp:e$ >> | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> <:str_item< let module $_uid:m$ = $mb$ in $e$ >> | e = expr -> <:str_item< $exp:e$ >> ] ] ; rebind_exn: [ [ "="; sl = V mod_ident "list" -> sl | -> <:vala< [] >> ] ] ; mod_binding: [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] ; mod_fun_binding: [ RIGHTA [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> | ":"; mt = module_type; "="; me = module_expr -> <:module_expr< ( $me$ : $mt$ ) >> | "="; me = module_expr -> <:module_expr< $me$ >> ] ] ; (* Module types *) module_type: [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; mt = SELF -> <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> <:module_type< $mt$ with $_list:wcl$ >> ] | [ "sig"; sg = signature; "end" -> <:module_type< sig $_list:sg$ end >> | "module"; "type"; "of"; me = module_expr -> <:module_type< module type of $me$ >> | i = mod_type_ident -> i | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] ; signature: [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] ; mod_type_ident: [ LEFTA [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] | [ m = V UIDENT -> <:module_type< $_uid:m$ >> | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] ; sig_item: [ "top" [ "exception"; (_, c, tl, _) = constructor_declaration -> <:sig_item< exception $_uid:c$ of $_list:tl$ >> | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; pd = V (LIST1 STRING) -> <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> | "include"; mt = module_type -> <:sig_item< include $mt$ >> | "module"; rf = V (FLAG "rec"); l = V (LIST1 mod_decl_binding SEP "and") -> <:sig_item< module $_flag:rf$ $_list:l$ >> | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> <:sig_item< module type $_uid:i$ = $mt$ >> | "module"; "type"; i = V UIDENT "uid" "" -> <:sig_item< module type $_uid:i$ = 'abstract >> | "open"; i = V mod_ident "list" "" -> <:sig_item< open $_:i$ >> | "type"; tdl = V (LIST1 type_decl SEP "and") -> <:sig_item< type $_list:tdl$ >> | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> <:sig_item< value $_lid:i$ : $t$ >> | "val"; "("; i = operator_rparen; ":"; t = ctyp -> <:sig_item< value $lid:i$ : $t$ >> ] ] ; mod_decl_binding: [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] ; module_declaration: [ RIGHTA [ ":"; mt = module_type -> <:module_type< $mt$ >> | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] ; (* "with" constraints (additional type equations over signature components) *) with_constr: [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; pf = V (FLAG "private"); t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; t = ctyp -> <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> | "module"; i = V mod_ident ""; "="; me = module_expr -> <:with_constr< module $_:i$ = $me$ >> | "module"; i = V mod_ident ""; ":="; me = module_expr -> <:with_constr< module $_:i$ := $me$ >> ] ] ; (* Core expressions *) expr: [ "top" RIGHTA [ e1 = SELF; ";"; e2 = SELF -> <:expr< do { $list:[e1 :: get_seq e2]$ } >> | e1 = SELF; ";" -> e1 | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] | "expr1" [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; x = expr LEVEL "top" -> <:expr< let $_flag:o$ $_list:l$ in $x$ >> | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr LEVEL "top" -> <:expr< let module $_uid:m$ = $mb$ in $e$ >> | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< fun [ $_list:l$ ] >> | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> <:expr< fun [$p$ $opt:eo$ -> $e$] >> | "match"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< match $e$ with [ $_list:l$ ] >> | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> <:expr< try $e$ with [ $_list:l$ ] >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; e3 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else $e3$ >> | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> <:expr< if $e1$ then $e2$ else () >> | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; e2 = SELF; "do"; e = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e in <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> let el = Pcaml.vala_map get_seq e2 in <:expr< while $e1$ do { $_list:el$ } >> ] | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> <:expr< ( $list:[e :: el]$ ) >> ] | ":=" NONA [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> <:expr< $e1$.val := $e2$ >> | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] | "||" RIGHTA [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] | "&&" RIGHTA [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] | "<" LEFTA [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "^" RIGHTA [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | RIGHTA [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] | "+" LEFTA [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "*" LEFTA [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "**" RIGHTA [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] | "unary minus" NONA [ "-"; e = SELF -> <:expr< - $e$ >> | "-."; e = SELF -> <:expr< -. $e$ >> ] | "apply" LEFTA [ e1 = SELF; e2 = SELF -> let (e1, e2) = if is_expr_constr_call e1 then match e1 with [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) | _ -> (e1, e2) ] else (e1, e2) in match constr_expr_arity loc e1 with [ 1 -> <:expr< $e1$ $e2$ >> | _ -> match e2 with [ <:expr< ( $list:el$ ) >> -> List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el | _ -> <:expr< $e1$ $e2$ >> ] ] | "assert"; e = SELF -> <:expr< assert $e$ >> | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] | "." LEFTA [ e1 = SELF; "."; "("; op = operator_rparen -> <:expr< $e1$ .( $lid:op$ ) >> | e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> <:expr< $e$ .{ $_list:el$ } >> | e1 = SELF; "."; e2 = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop e1 e2 ] | "~-" NONA [ "!"; e = SELF -> <:expr< $e$ . val >> | "~-"; e = SELF -> <:expr< ~- $e$ >> | "~-."; e = SELF -> <:expr< ~-. $e$ >> | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] | "simple" LEFTA [ s = V INT -> <:expr< $_int:s$ >> | s = V INT_l -> <:expr< $_int32:s$ >> | s = V INT_L -> <:expr< $_int64:s$ >> | s = V INT_n -> <:expr< $_nativeint:s$ >> | s = V FLOAT -> <:expr< $_flo:s$ >> | s = V STRING -> <:expr< $_str:s$ >> | c = V CHAR -> <:expr< $_chr:c$ >> | UIDENT "True" -> <:expr< True_ >> | UIDENT "False" -> <:expr< False_ >> | i = expr_ident -> i | "false" -> <:expr< False >> | "true" -> <:expr< True >> | "["; "]" -> <:expr< [] >> | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> | "[|"; "|]" -> <:expr< [| |] >> | "[|"; el = V expr1_semi_list "list"; "|]" -> <:expr< [| $_list:el$ |] >> | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> <:expr< { $_list:lel$ } >> | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> <:expr< { ($e$) with $_list:lel$ } >> | "("; ")" -> <:expr< () >> | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> <:expr< (module $me$ : $mt$) >> | "("; "module"; me = module_expr; ")" -> <:expr< (module $me$) >> | "("; op = operator_rparen -> <:expr< $lid:op$ >> | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> | "begin"; "end" -> <:expr< () >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_expr_quotation loc con ] ] ; let_binding: [ [ p = val_ident; e = fun_binding -> (p, e) | p = patt; "="; e = expr -> (p, e) | p = patt; ":"; t = poly_type; "="; e = expr -> (<:patt< ($p$ : $t$) >>, e) ] ] ; (*** JRH added the "translate_operator" here ***) val_ident: [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> | check_not_part_of_patt; "("; s = ANY; ")" -> let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] ; fun_binding: [ RIGHTA [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> | "="; e = expr -> <:expr< $e$ >> | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] ; match_case: [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> (x1, w, x2) ] ] ; lbl_expr_list: [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] | le = lbl_expr; ";" -> [le] | le = lbl_expr -> [le] ] ] ; lbl_expr: [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] ; expr1_semi_list: [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] ; fun_def: [ RIGHTA [ p = patt LEVEL "simple"; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> (eo, <:expr< $e$ >>) ] ] ; expr_ident: [ RIGHTA [ i = V LIDENT -> <:expr< $_lid:i$ >> | i = V UIDENT -> <:expr< $_uid:i$ >> | i = V UIDENT; "."; j = SELF -> let rec loop m = fun [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y | e -> <:expr< $m$ . $e$ >> ] in loop <:expr< $_uid:i$ >> j | i = V UIDENT; "."; "("; j = operator_rparen -> <:expr< $_uid:i$ . $lid:j$ >> ] ] ; (* Patterns *) patt: [ LEFTA [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] | LEFTA [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> <:patt< ( $list:[p :: pl]$) >> ] | NONA [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] | RIGHTA [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] | LEFTA [ p1 = SELF; p2 = SELF -> let (p1, p2) = match p1 with [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) | _ -> (p1, p2) ] in match constr_patt_arity loc p1 with [ 1 -> <:patt< $p1$ $p2$ >> | n -> let p2 = match p2 with [ <:patt< _ >> when n > 1 -> let pl = loop n where rec loop n = if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] in <:patt< ( $list:pl$ ) >> | _ -> p2 ] in match p2 with [ <:patt< ( $list:pl$ ) >> -> List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl | _ -> <:patt< $p1$ $p2$ >> ] ] | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] | LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | "simple" [ s = V LIDENT -> <:patt< $_lid:s$ >> | s = V UIDENT -> <:patt< $_uid:s$ >> | s = V INT -> <:patt< $_int:s$ >> | s = V INT_l -> <:patt< $_int32:s$ >> | s = V INT_L -> <:patt< $_int64:s$ >> | s = V INT_n -> <:patt< $_nativeint:s$ >> | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> | s = V FLOAT -> <:patt< $_flo:s$ >> | s = V STRING -> <:patt< $_str:s$ >> | s = V CHAR -> <:patt< $_chr:s$ >> | UIDENT "True" -> <:patt< True_ >> | UIDENT "False" -> <:patt< False_ >> | "false" -> <:patt< False >> | "true" -> <:patt< True >> | "["; "]" -> <:patt< [] >> | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> | "[|"; "|]" -> <:patt< [| |] >> | "[|"; pl = V patt_semi_list "list"; "|]" -> <:patt< [| $_list:pl$ |] >> | "{"; lpl = V lbl_patt_list "list"; "}" -> <:patt< { $_list:lpl$ } >> | "("; ")" -> <:patt< () >> | "("; op = operator_rparen -> <:patt< $lid:op$ >> | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; ")" -> <:patt< $p$ >> | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> <:patt< (module $_uid:s$ : $mt$) >> | "("; "module"; s = V UIDENT; ")" -> <:patt< (module $_uid:s$) >> | "_" -> <:patt< _ >> | x = QUOTATION -> let con = quotation_content x in Pcaml.handle_patt_quotation loc con ] ] ; patt_semi_list: [ [ p = patt; ";"; pl = SELF -> [p :: pl] | p = patt; ";" -> [p] | p = patt -> [p] ] ] ; lbl_patt_list: [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] | le = lbl_patt; ";" -> [le] | le = lbl_patt -> [le] ] ] ; lbl_patt: [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] ; patt_label_ident: [ LEFTA [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] | RIGHTA [ i = UIDENT -> <:patt< $uid:i$ >> | i = LIDENT -> <:patt< $lid:i$ >> ] ] ; (* Type declaration *) type_decl: [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); tk = type_kind; cl = V (LIST0 constrain) -> <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> let tk = <:ctyp< '$choose_tvar tpl$ >> in <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] ; type_patt: [ [ n = V LIDENT -> (loc, n) ] ] ; constrain: [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] ; type_kind: [ [ test_constr_decl; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> | t = ctyp -> <:ctyp< $t$ >> | t = ctyp; "="; pf = FLAG "private"; "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> | t = ctyp; "="; pf = FLAG "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> | "{"; ldl = V label_declarations "list"; "}" -> <:ctyp< { $_list:ldl$ } >> ] ] ; type_parameters: [ [ -> (* empty *) [] | tp = type_parameter -> [tp] | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] ; type_parameter: [ [ "+"; p = V simple_type_parameter -> (p, Some True) | "-"; p = V simple_type_parameter -> (p, Some False) | p = V simple_type_parameter -> (p, None) ] ] ; simple_type_parameter: [ [ "'"; i = ident -> Some i | "_" -> None ] ] ; constructor_declaration: [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> (loc, ci, cal, None) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); "->"; t = ctyp -> (loc, ci, cal, Some t) | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> let t = match cal with [ <:vala< [t] >> -> t | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> | _ -> assert False ] in (loc, ci, <:vala< [] >>, Some t) | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] ; cons_ident: [ [ i = V UIDENT "uid" "" -> i | UIDENT "True" -> <:vala< "True_" >> | UIDENT "False" -> <:vala< "False_" >> ] ] ; label_declarations: [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] | ld = label_declaration; ";" -> [ld] | ld = label_declaration -> [ld] ] ] ; label_declaration: [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] ; (* Core types *) ctyp: [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] | "arrow" RIGHTA [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | "star" [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> <:ctyp< ( $list:[t :: tl]$ ) >> ] | "apply" [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] | "ctyp2" [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] | "simple" [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> | "_" -> <:ctyp< _ >> | i = V LIDENT -> <:ctyp< $_lid:i$ >> | i = V UIDENT -> <:ctyp< $_uid:i$ >> | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; i = ctyp LEVEL "ctyp2" -> List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] ; (* Identifiers *) ident: [ [ i = LIDENT -> i | i = UIDENT -> i ] ] ; mod_ident: [ RIGHTA [ i = UIDENT -> [i] | i = LIDENT -> [i] | i = UIDENT; "."; j = SELF -> [i :: j] ] ] ; (* Miscellaneous *) direction_flag: [ [ "to" -> True | "downto" -> False ] ] ; (* Objects and Classes *) str_item: [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> <:str_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:str_item< class type $_list:ctd$ >> ] ] ; sig_item: [ [ "class"; cd = V (LIST1 class_description SEP "and") -> <:sig_item< class $_list:cd$ >> | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> <:sig_item< class type $_list:ctd$ >> ] ] ; (* Class expressions *) class_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; cfb = class_fun_binding -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} ] ] ; class_fun_binding: [ [ "="; ce = class_expr -> ce | ":"; ct = class_type; "="; ce = class_expr -> <:class_expr< ($ce$ : $ct$) >> | p = patt LEVEL "simple"; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_type_parameters: [ [ -> (loc, <:vala< [] >>) | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] ; class_fun_def: [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = patt LEVEL "simple"; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; class_expr: [ "top" [ "fun"; cfd = class_fun_def -> cfd | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); "in"; ce = SELF -> <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] | "apply" LEFTA [ ce = SELF; e = expr LEVEL "label" -> <:class_expr< $ce$ $e$ >> ] | "simple" [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; ci = class_longident -> <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> | "["; ct = ctyp; "]"; ci = class_longident -> <:class_expr< [ $ct$ ] $list:ci$ >> | ci = class_longident -> <:class_expr< $list:ci$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:class_expr< object $_opt:cspo$ $_list:cf$ end >> | "("; ce = SELF; ":"; ct = class_type; ")" -> <:class_expr< ($ce$ : $ct$) >> | "("; ce = SELF; ")" -> ce ] ] ; class_structure: [ [ cf = LIST0 class_str_item -> cf ] ] ; class_self_patt: [ [ "("; p = patt; ")" -> p | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] ; class_str_item: [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> <:class_str_item< inherit $ce$ $_opt:pb$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; e = cvalue_binding -> <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> if Pcaml.unvala ov then Ploc.raise loc (Stream.Error "virtual value cannot override") else <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_str_item< method virtual $_lid:l$ : $t$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; t = poly_type; "="; e = expr -> <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; sb = fun_binding -> <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_str_item< type $t1$ = $t2$ >> | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] ; cvalue_binding: [ [ "="; e = expr -> e | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> <:expr< ($e$ : $t$ :> $t2$) >> | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; label: [ [ i = LIDENT -> i ] ] ; (* Class types *) class_type: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> | cs = class_signature -> cs ] ] ; class_signature: [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> <:class_type< $id$ [ $list:tl$ ] >> | "object"; cst = V (OPT class_self_type); csf = V (LIST0 class_sig_item); "end" -> <:class_type< object $_opt:cst$ $_list:csf$ end >> ] | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] | [ i = V LIDENT -> <:class_type< $_id: i$ >> | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] ; class_self_type: [ [ "("; t = ctyp; ")" -> t ] ] ; class_sig_item: [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual private $_lid:l$ : $t$ >> | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method virtual $_lid:l$ : $t$ >> | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method private $_lid:l$ : $t$ >> | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> <:class_sig_item< method $_lid:l$ : $t$ >> | "constraint"; t1 = ctyp; "="; t2 = ctyp -> <:class_sig_item< type $t1$ = $t2$ >> ] ] ; class_description: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; ":"; ct = class_type -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} ] ] ; class_type_declaration: [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; "="; cs = class_signature -> {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} ] ] ; (* Expressions *) expr: LEVEL "simple" [ LEFTA [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> | "object"; cspo = V (OPT class_self_patt); cf = V class_structure "list"; "end" -> <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] ; expr: LEVEL "." [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] ; expr: LEVEL "simple" [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> <:expr< ($e$ : $t$ :> $t2$) >> | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> | "{<"; ">}" -> <:expr< {< >} >> | "{<"; fel = V field_expr_list "list"; ">}" -> <:expr< {< $_list:fel$ >} >> ] ] ; field_expr_list: [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> [(l, e) :: fel] | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] ; (* Core types *) ctyp: LEVEL "simple" [ [ "#"; id = V class_longident "list" -> <:ctyp< # $_list:id$ >> | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> <:ctyp< < $_list:ml$ $_flag:v$ > >> | "<"; ".."; ">" -> <:ctyp< < .. > >> | "<"; ">" -> <:ctyp< < > >> ] ] ; meth_list: [ [ f = field; ";"; ml = SELF -> [f :: ml] | f = field; ";" -> [f] | f = field -> [f] ] ] ; field: [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] ; (* Polymorphic types *) typevar: [ [ "'"; i = ident -> i ] ] ; poly_type: [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> <:ctyp< type $list:nt$ . $ct$ >> | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> <:ctyp< ! $list:tpl$ . $t2$ >> | t = ctyp -> t ] ] ; (* Identifiers *) class_longident: [ [ m = UIDENT; "."; l = SELF -> [m :: l] | i = LIDENT -> [i] ] ] ; (* Labels *) ctyp: AFTER "arrow" [ NONA [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] ; ctyp: LEVEL "simple" [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ = $_list:rfl$ ] >> | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ > $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> <:ctyp< [ < $_list:rfl$ ] >> | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; ntl = V (LIST1 name_tag); "]" -> <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] ; poly_variant: [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); l = V (LIST1 ctyp SEP "&") -> <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> | t = ctyp -> <:poly_variant< $t$ >> ] ] ; name_tag: [ [ "`"; i = ident -> i ] ] ; expr: LEVEL "expr1" [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] ; expr: AFTER "apply" [ "label" [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] ; expr: LEVEL "simple" [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] ; fun_def: [ [ p = labeled_patt; (eo, e) = SELF -> (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] ; fun_binding: [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] ; patt: LEVEL "simple" [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> | p = labeled_patt -> p ] ] ; labeled_patt: [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> <:patt< ~{$_:i$ = $p$} >> | i = V TILDEIDENT -> <:patt< ~{$_:i$} >> | "~"; "("; i = LIDENT; ")" -> <:patt< ~{$lid:i$} >> | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ~{$lid:i$ : $t$} >> | i = V QUESTIONIDENTCOLON; j = LIDENT -> <:patt< ?{$_:i$ = ?{$lid:j$}} >> | i = V QUESTIONIDENTCOLON; "_" -> <:patt< ?{$_:i$} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> <:patt< ?{$_:i$ = ?{$p$}} >> | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> | "?"; "("; i = LIDENT; "="; e = expr; ")" -> <:patt< ?{$lid:i$ = $e$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> <:patt< ?{$lid:i$ : $t$ = $e$} >> | "?"; "("; i = LIDENT; ")" -> <:patt< ?{$lid:i$} >> | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> <:patt< ?{$lid:i$ : $t$} >> ] ] ; class_type: [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ~$i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] ; class_fun_binding: [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] ; class_fun_def: [ [ p = labeled_patt; "->"; ce = class_expr -> <:class_expr< fun $p$ -> $ce$ >> | p = labeled_patt; cfd = SELF -> <:class_expr< fun $p$ -> $cfd$ >> ] ] ; END; (* Main entry points *) EXTEND GLOBAL: interf implem use_file top_phrase expr patt; interf: [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; sig_item_semi: [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] ; implem: [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) | EOI -> ([], Some loc) ] ] ; str_item_semi: [ [ si = str_item; OPT ";;" -> (si, loc) ] ] ; top_phrase: [ [ ph = phrase; ";;" -> Some ph | EOI -> None ] ] ; use_file: [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> ([si :: sil], stopped) | "#"; n = LIDENT; dp = OPT expr; ";;" -> ([<:str_item< # $lid:n$ $opt:dp$ >>], True) | EOI -> ([], False) ] ] ; phrase: [ [ sti = str_item -> sti | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $lid:n$ $opt:dp$ >> ] ] ; END; Pcaml.add_option "-no_quot" (Arg.Set no_quotations) "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; (* ------------------------------------------------------------------------- *) (* Added by JRH *** *) (* ------------------------------------------------------------------------- *) EXTEND expr: AFTER "<" [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> ]]; END; EXTEND top_phrase: [ [ sti = str_item; ";;" -> match sti with [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> | x -> Some x ] ] ] ; END; hol-light/pair.ml000066400000000000000000000436351303454263000142450ustar00rootroot00000000000000(* ========================================================================= *) (* Syntax sugaring; theory of pairing, with a bit of support. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Marco Maggesi 2015 *) (* ========================================================================= *) needs "quot.ml";; (* ------------------------------------------------------------------------- *) (* Constants implementing (or at least tagging) syntactic sugar. *) (* ------------------------------------------------------------------------- *) let LET_DEF = new_definition `LET (f:A->B) x = f x`;; let LET_END_DEF = new_definition `LET_END (t:A) = t`;; let GABS_DEF = new_definition `GABS (P:A->bool) = (@) P`;; let GEQ_DEF = new_definition `GEQ a b = (a:A = b)`;; let _SEQPATTERN = new_definition `_SEQPATTERN = \r s x. if ?y. r x y then r x else s x`;; let _UNGUARDED_PATTERN = new_definition `_UNGUARDED_PATTERN = \p r. p /\ r`;; let _GUARDED_PATTERN = new_definition `_GUARDED_PATTERN = \p g r. p /\ g /\ r`;; let _MATCH = new_definition `_MATCH = \e r. if (?!) (r e) then (@) (r e) else @z. F`;; let _FUNCTION = new_definition `_FUNCTION = \r x. if (?!) (r x) then (@) (r x) else @z. F`;; (* ------------------------------------------------------------------------- *) (* Pair type. *) (* ------------------------------------------------------------------------- *) let mk_pair_def = new_definition `mk_pair (x:A) (y:B) = \a b. (a = x) /\ (b = y)`;; let PAIR_EXISTS_THM = prove (`?x. ?(a:A) (b:B). x = mk_pair a b`, MESON_TAC[]);; let prod_tybij = new_type_definition "prod" ("ABS_prod","REP_prod") PAIR_EXISTS_THM;; let REP_ABS_PAIR = prove (`!(x:A) (y:B). REP_prod (ABS_prod (mk_pair x y)) = mk_pair x y`, MESON_TAC[prod_tybij]);; parse_as_infix (",",(14,"right"));; let COMMA_DEF = new_definition `(x:A),(y:B) = ABS_prod(mk_pair x y)`;; let FST_DEF = new_definition `FST (p:A#B) = @x. ?y. p = x,y`;; let SND_DEF = new_definition `SND (p:A#B) = @y. ?x. p = x,y`;; let PAIR_EQ = prove (`!(x:A) (y:B) a b. (x,y = a,b) <=> (x = a) /\ (y = b)`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[COMMA_DEF] THEN DISCH_THEN(MP_TAC o AP_TERM `REP_prod:A#B->A->B->bool`) THEN REWRITE_TAC[REP_ABS_PAIR] THEN REWRITE_TAC[mk_pair_def; FUN_EQ_THM]; ALL_TAC] THEN MESON_TAC[]);; let PAIR_SURJECTIVE = prove (`!p:A#B. ?x y. p = x,y`, GEN_TAC THEN REWRITE_TAC[COMMA_DEF] THEN MP_TAC(SPEC `REP_prod p :A->B->bool` (CONJUNCT2 prod_tybij)) THEN REWRITE_TAC[CONJUNCT1 prod_tybij] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` (X_CHOOSE_THEN `b:B` MP_TAC)) THEN DISCH_THEN(MP_TAC o AP_TERM `ABS_prod:(A->B->bool)->A#B`) THEN REWRITE_TAC[CONJUNCT1 prod_tybij] THEN DISCH_THEN SUBST1_TAC THEN MAP_EVERY EXISTS_TAC [`a:A`; `b:B`] THEN REFL_TAC);; let FST = prove (`!(x:A) (y:B). FST(x,y) = x`, REPEAT GEN_TAC THEN REWRITE_TAC[FST_DEF] THEN MATCH_MP_TAC SELECT_UNIQUE THEN GEN_TAC THEN BETA_TAC THEN REWRITE_TAC[PAIR_EQ] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `y:B` THEN ASM_REWRITE_TAC[]);; let SND = prove (`!(x:A) (y:B). SND(x,y) = y`, REPEAT GEN_TAC THEN REWRITE_TAC[SND_DEF] THEN MATCH_MP_TAC SELECT_UNIQUE THEN GEN_TAC THEN BETA_TAC THEN REWRITE_TAC[PAIR_EQ] THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);; let PAIR = prove (`!x:A#B. FST x,SND x = x`, GEN_TAC THEN (X_CHOOSE_THEN `a:A` (X_CHOOSE_THEN `b:B` SUBST1_TAC) (SPEC `x:A#B` PAIR_SURJECTIVE)) THEN REWRITE_TAC[FST; SND]);; let pair_INDUCT = prove (`!P. (!x y. P (x,y)) ==> !p. P p`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM PAIR] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let pair_RECURSION = prove (`!PAIR'. ?fn:A#B->C. !a0 a1. fn (a0,a1) = PAIR' a0 a1`, GEN_TAC THEN EXISTS_TAC `\p. (PAIR':A->B->C) (FST p) (SND p)` THEN REWRITE_TAC[FST; SND]);; (* ------------------------------------------------------------------------- *) (* Syntax operations. *) (* ------------------------------------------------------------------------- *) let is_pair = is_binary ",";; let dest_pair = dest_binary ",";; let mk_pair = let ptm = mk_const(",",[]) in fun (l,r) -> mk_comb(mk_comb(inst [type_of l,aty; type_of r,bty] ptm,l),r);; (* ------------------------------------------------------------------------- *) (* Extend basic rewrites; extend new_definition to allow paired varstructs. *) (* ------------------------------------------------------------------------- *) extend_basic_rewrites [FST; SND; PAIR];; (* ------------------------------------------------------------------------- *) (* Extend definitions to paired varstructs with benignity checking. *) (* ------------------------------------------------------------------------- *) let the_definitions = ref [SND_DEF; FST_DEF; COMMA_DEF; mk_pair_def; GEQ_DEF; GABS_DEF; LET_END_DEF; LET_DEF; one_DEF; I_DEF; o_DEF; COND_DEF; _FALSITY_; EXISTS_UNIQUE_DEF; NOT_DEF; F_DEF; OR_DEF; EXISTS_DEF; FORALL_DEF; IMP_DEF; AND_DEF; T_DEF];; let new_definition = let depair = let rec depair gv arg = try let l,r = dest_pair arg in (depair (list_mk_icomb "FST" [gv]) l) @ (depair (list_mk_icomb "SND" [gv]) r) with Failure _ -> [gv,arg] in fun arg -> let gv = genvar(type_of arg) in gv,depair gv arg in fun tm -> let avs,def = strip_forall tm in try let th,th' = tryfind (fun th -> th,PART_MATCH I th def) (!the_definitions) in ignore(PART_MATCH I th' (snd(strip_forall(concl th)))); warn true "Benign redefinition"; GEN_ALL (GENL avs th') with Failure _ -> let l,r = dest_eq def in let fn,args = strip_comb l in let gargs,reps = (I F_F unions) (unzip(map depair args)) in let l' = list_mk_comb(fn,gargs) and r' = subst reps r in let th1 = new_definition (mk_eq(l',r')) in let slist = zip args gargs in let th2 = INST slist (SPEC_ALL th1) in let xreps = map (subst slist o fst) reps in let threps = map (SYM o PURE_REWRITE_CONV[FST; SND]) xreps in let th3 = TRANS th2 (SYM(SUBS_CONV threps r)) in let th4 = GEN_ALL (GENL avs th3) in the_definitions := th4::(!the_definitions); th4;; (* ------------------------------------------------------------------------- *) (* A few more useful definitions. *) (* ------------------------------------------------------------------------- *) let CURRY_DEF = new_definition `CURRY(f:A#B->C) x y = f(x,y)`;; let UNCURRY_DEF = new_definition `!f x y. UNCURRY(f:A->B->C)(x,y) = f x y`;; let PASSOC_DEF = new_definition `!f x y z. PASSOC (f:(A#B)#C->D) (x,y,z) = f ((x,y),z)`;; (* ------------------------------------------------------------------------- *) (* Analog of ABS_CONV for generalized abstraction. *) (* ------------------------------------------------------------------------- *) let GABS_CONV conv tm = if is_abs tm then ABS_CONV conv tm else let gabs,bod = dest_comb tm in let f,qtm = dest_abs bod in let xs,bod = strip_forall qtm in AP_TERM gabs (ABS f (itlist MK_FORALL xs (RAND_CONV conv bod)));; (* ------------------------------------------------------------------------- *) (* General beta-conversion over linear pattern of nested constructors. *) (* ------------------------------------------------------------------------- *) let GEN_BETA_CONV = let projection_cache = ref [] in let create_projections conname = try assoc conname (!projection_cache) with Failure _ -> let genty = get_const_type conname in let conty = fst(dest_type(repeat (snd o dest_fun_ty) genty)) in let _,_,rth = assoc conty (!inductive_type_store) in let sth = SPEC_ALL rth in let evs,bod = strip_exists(concl sth) in let cjs = conjuncts bod in let ourcj = find ((=)conname o fst o dest_const o fst o strip_comb o rand o lhand o snd o strip_forall) cjs in let n = index ourcj cjs in let avs,eqn = strip_forall ourcj in let con',args = strip_comb(rand eqn) in let aargs,zargs = chop_list (length avs) args in let gargs = map (genvar o type_of) zargs in let gcon = genvar(itlist (mk_fun_ty o type_of) avs (type_of(rand eqn))) in let bth = INST [list_mk_abs(aargs @ gargs,list_mk_comb(gcon,avs)),con'] sth in let cth = el n (CONJUNCTS(ASSUME(snd(strip_exists(concl bth))))) in let dth = CONV_RULE (funpow (length avs) BINDER_CONV (RAND_CONV(BETAS_CONV))) cth in let eth = SIMPLE_EXISTS (rator(lhand(snd(strip_forall(concl dth))))) dth in let fth = PROVE_HYP bth (itlist SIMPLE_CHOOSE evs eth) in let zty = type_of (rand(snd(strip_forall(concl dth)))) in let mk_projector a = let ity = type_of a in let th = BETA_RULE(PINST [ity,zty] [list_mk_abs(avs,a),gcon] fth) in SYM(SPEC_ALL(SELECT_RULE th)) in let ths = map mk_projector avs in (projection_cache := (conname,ths)::(!projection_cache); ths) in let GEQ_CONV = REWR_CONV(GSYM GEQ_DEF) and DEGEQ_RULE = CONV_RULE(REWR_CONV GEQ_DEF) in let GABS_RULE = let pth = prove (`(?) P ==> P (GABS P)`, SIMP_TAC[GABS_DEF; SELECT_AX; ETA_AX]) in MATCH_MP pth in let rec create_iterated_projections tm = if frees tm = [] then [] else if is_var tm then [REFL tm] else let con,args = strip_comb tm in let prjths = create_projections (fst(dest_const con)) in let atm = rand(rand(concl(hd prjths))) in let instn = term_match [] atm tm in let arths = map (INSTANTIATE instn) prjths in let ths = map (fun arth -> let sths = create_iterated_projections (lhand(concl arth)) in map (CONV_RULE(RAND_CONV(SUBS_CONV[arth]))) sths) arths in unions' equals_thm ths in let GEN_BETA_CONV tm = try BETA_CONV tm with Failure _ -> let l,r = dest_comb tm in let vstr,bod = dest_gabs l in let instn = term_match [] vstr r in let prjs = create_iterated_projections vstr in let th1 = SUBS_CONV prjs bod in let bod' = rand(concl th1) in let gv = genvar(type_of vstr) in let pat = mk_abs(gv,subst[gv,vstr] bod') in let th2 = TRANS (BETA_CONV (mk_comb(pat,vstr))) (SYM th1) in let avs = fst(strip_forall(body(rand l))) in let th3 = GENL (fst(strip_forall(body(rand l)))) th2 in let efn = genvar(type_of pat) in let th4 = EXISTS(mk_exists(efn,subst[efn,pat] (concl th3)),pat) th3 in let th5 = CONV_RULE(funpow (length avs + 1) BINDER_CONV GEQ_CONV) th4 in let th6 = CONV_RULE BETA_CONV (GABS_RULE th5) in INSTANTIATE instn (DEGEQ_RULE (SPEC_ALL th6)) in GEN_BETA_CONV;; (* ------------------------------------------------------------------------- *) (* Add this to the basic "rewrites" and pairs to the inductive type store. *) (* ------------------------------------------------------------------------- *) extend_basic_convs("GEN_BETA_CONV",(`GABS (\a. b) c`,GEN_BETA_CONV));; inductive_type_store := ("prod",(1,pair_INDUCT,pair_RECURSION))::(!inductive_type_store);; (* ------------------------------------------------------------------------- *) (* Convenient rules to eliminate binders over pairs. *) (* ------------------------------------------------------------------------- *) let FORALL_PAIR_THM = prove (`!P. (!p. P p) <=> (!p1 p2. P(p1,p2))`, MESON_TAC[PAIR]);; let EXISTS_PAIR_THM = prove (`!P. (?p. P p) <=> ?p1 p2. P(p1,p2)`, MESON_TAC[PAIR]);; let LAMBDA_PAIR_THM = prove (`!t. (\p. t p) = (\(x,y). t(x,y))`, REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM]);; let LAMBDA_UNPAIR_THM = prove (`!f:A->B->C. (\ (x:A,y:B). f x y) = (\p. f (FST p) (SND p))`, REWRITE_TAC[LAMBDA_PAIR_THM]);; let PAIRED_ETA_THM = prove (`(!f. (\(x,y). f (x,y)) = f) /\ (!f. (\(x,y,z). f (x,y,z)) = f) /\ (!f. (\(w,x,y,z). f (w,x,y,z)) = f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; let FORALL_UNCURRY = prove (`!P. (!f:A->B->C. P f) <=> (!f. P (\a b. f(a,b)))`, GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `f:A->B->C` THEN FIRST_ASSUM(MP_TAC o SPEC `\(a,b). (f:A->B->C) a b`) THEN SIMP_TAC[ETA_AX]);; let EXISTS_UNCURRY = prove (`!P. (?f:A->B->C. P f) <=> (?f. P (\a b. f(a,b)))`, ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REWRITE_TAC[FORALL_UNCURRY]);; let EXISTS_CURRY = prove (`!P. (?f. P f) <=> (?f. P (\(a,b). f a b))`, REWRITE_TAC[EXISTS_UNCURRY; PAIRED_ETA_THM]);; let FORALL_CURRY = prove (`!P. (!f. P f) <=> (!f. P (\(a,b). f a b))`, REWRITE_TAC[FORALL_UNCURRY; PAIRED_ETA_THM]);; let FORALL_UNPAIR_THM = prove (`!P. (!x y. P x y) <=> !z. P (FST z) (SND z)`, REWRITE_TAC[FORALL_PAIR_THM; FST; SND] THEN MESON_TAC[]);; let EXISTS_UNPAIR_THM = prove (`!P. (?x y. P x y) <=> ?z. P (FST z) (SND z)`, REWRITE_TAC[EXISTS_PAIR_THM; FST; SND] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Related theorems for explicitly paired quantifiers. *) (* ------------------------------------------------------------------------- *) let FORALL_PAIRED_THM = prove (`!P. (!(x,y). P x y) <=> (!x y. P x y)`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV) [FORALL_DEF] THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; let EXISTS_PAIRED_THM = prove (`!P. (?(x,y). P x y) <=> (?x y. P x y)`, GEN_TAC THEN MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[REWRITE_RULE[ETA_AX] NOT_EXISTS_THM; FORALL_PAIR_THM]);; (* ------------------------------------------------------------------------- *) (* Likewise for tripled quantifiers (could continue with the same proof). *) (* ------------------------------------------------------------------------- *) let FORALL_TRIPLED_THM = prove (`!P. (!(x,y,z). P x y z) <=> (!x y z. P x y z)`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV) [FORALL_DEF] THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; let EXISTS_TRIPLED_THM = prove (`!P. (?(x,y,z). P x y z) <=> (?x y z. P x y z)`, GEN_TAC THEN MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN REWRITE_TAC[REWRITE_RULE[ETA_AX] NOT_EXISTS_THM; FORALL_PAIR_THM]);; (* ------------------------------------------------------------------------- *) (* Similar theorems for the choice operator. *) (* ------------------------------------------------------------------------- *) let CHOICE_UNPAIR_THM = prove (`!P. (@(x:A,y:B). P x y) = (@p. P (FST p) (SND p))`, REWRITE_TAC[LAMBDA_UNPAIR_THM]);; let CHOICE_PAIRED_THM = prove (`!P Q. (?x:A y:B. P x y) /\ (!x y. P x y ==> Q(x,y)) ==> Q (@(x,y). P x y)`, INTRO_TAC "!P Q; (@x0 y0. P0) PQ" THEN SUBGOAL_THEN `(\ (x:A,y:B). P x y:bool) = (\p. P (FST p) (SND p))` SUBST1_TAC THENL [REWRITE_TAC[LAMBDA_PAIR_THM]; SELECT_ELIM_TAC] THEN INTRO_TAC "![c]; c" THEN ONCE_REWRITE_TAC[GSYM PAIR] THEN REMOVE_THEN "PQ" MATCH_MP_TAC THEN REMOVE_THEN "c" MATCH_MP_TAC THEN REWRITE_TAC[EXISTS_PAIR_THM] THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Expansion of a let-term. *) (* ------------------------------------------------------------------------- *) let let_CONV = let let1_CONV = REWR_CONV LET_DEF THENC GEN_BETA_CONV and lete_CONV = REWR_CONV LET_END_DEF in let rec EXPAND_BETAS_CONV tm = let tm' = rator tm in try let1_CONV tm with Failure _ -> let th1 = AP_THM (EXPAND_BETAS_CONV tm') (rand tm) in let th2 = GEN_BETA_CONV (rand(concl th1)) in TRANS th1 th2 in fun tm -> let ltm,pargs = strip_comb tm in if fst(dest_const ltm) <> "LET" || pargs = [] then failwith "let_CONV" else let abstm = hd pargs in let vs,bod = strip_gabs abstm in let es = tl pargs in let n = length es in if length vs <> n then failwith "let_CONV" else (EXPAND_BETAS_CONV THENC lete_CONV) tm;; let (LET_TAC:tactic) = let is_trivlet tm = try let assigs,bod = dest_let tm in forall (uncurry (=)) assigs with Failure _ -> false and PROVE_DEPAIRING_EXISTS = let pth = prove (`((x,y) = a) <=> (x = FST a) /\ (y = SND a)`, MESON_TAC[PAIR; PAIR_EQ]) in let rewr1_CONV = GEN_REWRITE_CONV TOP_DEPTH_CONV [pth] and rewr2_RULE = GEN_REWRITE_RULE (LAND_CONV o DEPTH_CONV) [TAUT `(x = x) <=> T`; TAUT `a /\ T <=> a`] in fun tm -> let th1 = rewr1_CONV tm in let tm1 = rand(concl th1) in let cjs = conjuncts tm1 in let vars = map lhand cjs in let th2 = EQ_MP (SYM th1) (ASSUME tm1) in let th3 = DISCH_ALL (itlist SIMPLE_EXISTS vars th2) in let th4 = INST (map (fun t -> rand t,lhand t) cjs) th3 in MP (rewr2_RULE th4) TRUTH in fun (asl,w as gl) -> let path = try find_path is_trivlet w with Failure _ -> find_path is_let w in let tm = follow_path path w in let assigs,bod = dest_let tm in let abbrevs = mapfilter (fun (x,y) -> if x = y then fail() else mk_eq(x,y)) assigs in let lvars = itlist (union o frees o lhs) abbrevs [] and avoids = itlist (union o thm_frees o snd) asl (frees w) in let rename = vsubst (zip (variants avoids lvars) lvars) in let abbrevs' = map (fun eq -> let l,r = dest_eq eq in mk_eq(rename l,r)) abbrevs in let deprths = map PROVE_DEPAIRING_EXISTS abbrevs' in (MAP_EVERY (REPEAT_TCL CHOOSE_THEN (fun th -> let th' = SYM th in SUBST_ALL_TAC th' THEN ASSUME_TAC th')) deprths THEN W(fun (asl',w') -> let tm' = follow_path path w' in CONV_TAC(PATH_CONV path (K(let_CONV tm'))))) gl;; hol-light/parser.ml000066400000000000000000000526711303454263000146060ustar00rootroot00000000000000(* ========================================================================= *) (* Lexical analyzer, type and preterm parsers. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "preterm.ml";; (* ------------------------------------------------------------------------- *) (* Need to have this now for set enums, since "," isn't a reserved word. *) (* ------------------------------------------------------------------------- *) parse_as_infix (",",(14,"right"));; (* ------------------------------------------------------------------------- *) (* Basic parser combinators. *) (* ------------------------------------------------------------------------- *) exception Noparse;; let (|||) parser1 parser2 input = try parser1 input with Noparse -> parser2 input;; let (++) parser1 parser2 input = let result1,rest1 = parser1 input in let result2,rest2 = parser2 rest1 in (result1,result2),rest2;; let rec many prs input = try let result,next = prs input in let results,rest = many prs next in (result::results),rest with Noparse -> [],input;; let (>>) prs treatment input = let result,rest = prs input in treatment(result),rest;; let fix err prs input = try prs input with Noparse -> failwith (err ^ " expected");; let rec listof prs sep err = prs ++ many (sep ++ fix err prs >> snd) >> (fun (h,t) -> h::t);; let nothing input = [],input;; let elistof prs sep err = listof prs sep err ||| nothing;; let leftbin prs sep cons err = prs ++ many (sep ++ fix err prs) >> (fun (x,opxs) -> let ops,xs = unzip opxs in itlist2 (fun op y x -> cons op x y) (rev ops) (rev xs) x);; let rightbin prs sep cons err = prs ++ many (sep ++ fix err prs) >> (fun (x,opxs) -> if opxs = [] then x else let ops,xs = unzip opxs in itlist2 cons ops (x::butlast xs) (last xs));; let possibly prs input = try let x,rest = prs input in [x],rest with Noparse -> [],input;; let some p = function [] -> raise Noparse | (h::t) -> if p h then (h,t) else raise Noparse;; let a tok = some (fun item -> item = tok);; let rec atleast n prs i = (if n <= 0 then many prs else prs ++ atleast (n - 1) prs >> (fun (h,t) -> h::t)) i;; let finished input = if input = [] then 0,input else failwith "Unparsed input";; (* ------------------------------------------------------------------------- *) (* The basic lexical classes: identifiers, strings and reserved words. *) (* ------------------------------------------------------------------------- *) type lexcode = Ident of string | Resword of string;; (* ------------------------------------------------------------------------- *) (* Lexical analyzer. Apart from some special bracket symbols, each *) (* identifier is made up of the longest string of alphanumerics or *) (* the longest string of symbolics. *) (* ------------------------------------------------------------------------- *) reserve_words ["//"];; let comment_token = ref (Resword "//");; let lex = let collect (h,t) = end_itlist (^) (h::t) in let reserve = function (Ident n as tok) -> if is_reserved_word n then Resword(n) else tok | t -> t in let stringof p = atleast 1 p >> end_itlist (^) in let simple_ident = stringof(some isalnum) ||| stringof(some issymb) in let undertail = stringof (a "_") ++ possibly simple_ident >> collect in let ident = (undertail ||| simple_ident) ++ many undertail >> collect in let septok = stringof(some issep) in let escapecode i = match i with "\\"::rst -> "\\",rst | "\""::rst -> "\"",rst | "\'"::rst -> "\'",rst | "n"::rst -> "\n",rst | "r"::rst -> "\r",rst | "t"::rst -> "\t",rst | "b"::rst -> "\b",rst | " "::rst -> " ",rst | "x"::h::l::rst -> String.make 1 (Char.chr(int_of_string("0x"^h^l))),rst | a::b::c::rst when forall isnum [a;b;c] -> String.make 1 (Char.chr(int_of_string(a^b^c))),rst | _ -> failwith "lex:unrecognized OCaml-style escape in string" in let stringchar = some (fun i -> i <> "\\" && i <> "\"") ||| (a "\\" ++ escapecode >> snd) in let string = a "\"" ++ many stringchar ++ a "\"" >> (fun ((_,s),_) -> "\""^implode s^"\"") in let rawtoken = (string ||| some isbra ||| septok ||| ident) >> (fun x -> Ident x) in let simptoken = many (some isspace) ++ rawtoken >> (reserve o snd) in let rec tokens i = try let (t,rst) = simptoken i in if t = !comment_token then (many (fun i -> if i <> [] && hd i <> "\n" then 1,tl i else raise Noparse) ++ tokens >> snd) rst else let toks,rst1 = tokens rst in t::toks,rst1 with Noparse -> [],i in fst o (tokens ++ many (some isspace) ++ finished >> (fst o fst));; (* ------------------------------------------------------------------------- *) (* Parser for pretypes. Concrete syntax: *) (* *) (* TYPE :: SUMTYPE -> TYPE *) (* | SUMTYPE *) (* *) (* SUMTYPE :: PRODTYPE + SUMTYPE *) (* | PRODTYPE *) (* *) (* PRODTYPE :: POWTYPE # PRODTYPE *) (* | POWTYPE *) (* *) (* POWTYPE :: APPTYPE ^ POWTYPE *) (* | APPTYPE *) (* *) (* APPTYPE :: ATOMICTYPES type-constructor [Provided arity matches] *) (* | ATOMICTYPES [Provided only 1 ATOMICTYPE] *) (* *) (* ATOMICTYPES :: type-constructor [Provided arity zero] *) (* | type-variable *) (* | ( TYPE ) *) (* | ( TYPE LIST ) *) (* *) (* TYPELIST :: TYPE , TYPELIST *) (* | TYPE *) (* *) (* Two features make this different from previous HOL type syntax: *) (* *) (* o Any identifier not in use as a type constant will be parsed as a *) (* type variable; a ' is not needed and a * is not allowed. *) (* *) (* o Antiquotation is not supported. *) (* ------------------------------------------------------------------------- *) let parse_pretype = let btyop n n' x y = Ptycon(n,[x;y]) and mk_apptype = function ([s],[]) -> s | (tys,[c]) -> Ptycon(c,tys) | _ -> failwith "Bad type construction" and type_atom input = match input with (Ident s)::rest -> (try pretype_of_type(assoc s (type_abbrevs())) with Failure _ -> if try get_type_arity s = 0 with Failure _ -> false then Ptycon(s,[]) else Utv(s)),rest | _ -> raise Noparse and type_constructor input = match input with (Ident s)::rest -> if try get_type_arity s > 0 with Failure _ -> false then s,rest else raise Noparse | _ -> raise Noparse in let rec pretype i = rightbin sumtype (a (Resword "->")) (btyop "fun") "type" i and sumtype i = rightbin prodtype (a (Ident "+")) (btyop "sum") "type" i and prodtype i = rightbin carttype (a (Ident "#")) (btyop "prod") "type" i and carttype i = leftbin apptype (a (Ident "^")) (btyop "cart") "type" i and apptype i = (atomictypes ++ (type_constructor >> (fun x -> [x]) ||| nothing) >> mk_apptype) i and atomictypes i = (((a (Resword "(")) ++ typelist ++ a (Resword ")") >> (snd o fst)) ||| (type_atom >> (fun x -> [x]))) i and typelist i = listof pretype (a (Ident ",")) "type" i in pretype;; (* ------------------------------------------------------------------------- *) (* Hook to allow installation of user parsers. *) (* ------------------------------------------------------------------------- *) let install_parser,delete_parser,installed_parsers,try_user_parser = let rec try_parsers ps i = if ps = [] then raise Noparse else try snd(hd ps) i with Noparse -> try_parsers (tl ps) i in let parser_list = ref([]:(string*(lexcode list -> preterm * lexcode list))list) in (fun dat -> parser_list := dat::(!parser_list)), (fun key -> try parser_list := snd (remove (fun (key',_) -> key = key') (!parser_list)) with Failure _ -> ()), (fun () -> !parser_list), (fun i -> try_parsers (!parser_list) i);; (* ------------------------------------------------------------------------- *) (* Initial preterm parsing. This uses binder and precedence/associativity/ *) (* prefix status to guide parsing and preterm construction, but treats all *) (* identifiers as variables. *) (* *) (* PRETERM :: APPL_PRETERM binop APPL_PRETERM *) (* | APPL_PRETERM *) (* *) (* APPL_PRETERM :: APPL_PRETERM : type *) (* | APPL_PRETERM BINDER_PRETERM *) (* | BINDER_PRETERM *) (* *) (* BINDER_PRETERM :: binder VARSTRUCT_PRETERMS . PRETERM *) (* | let PRETERM and ... and PRETERM in PRETERM *) (* | ATOMIC_PRETERM *) (* *) (* VARSTRUCT_PRETERMS :: TYPED_PRETERM VARSTRUCT_PRETERMS *) (* | TYPED_PRETERM *) (* *) (* TYPED_PRETERM :: TYPED_PRETERM : type *) (* | ATOMIC_PRETERM *) (* *) (* ATOMIC_PRETERM :: ( PRETERM ) *) (* | if PRETERM then PRETERM else PRETERM *) (* | [ PRETERM; .. ; PRETERM ] *) (* | { PRETERM, .. , PRETERM } *) (* | { PRETERM | PRETERM } *) (* | identifier *) (* *) (* Note that arbitrary preterms are allowed as varstructs. This allows *) (* more general forms of matching and considerably regularizes the syntax. *) (* ------------------------------------------------------------------------- *) let parse_preterm = let rec pairwise r l = match l with [] -> true | h::t -> forall (r h) t && pairwise r t in let rec pfrees ptm acc = match ptm with Varp(v,pty) -> if v = "" && pty = dpty then acc else if can get_const_type v || can num_of_string v || exists (fun (w,_) -> v = w) (!the_interface) then acc else insert ptm acc | Constp(_,_) -> acc | Combp(p1,p2) -> pfrees p1 (pfrees p2 acc) | Absp(p1,p2) -> subtract (pfrees p2 acc) (pfrees p1 []) | Typing(p,_) -> pfrees p acc in let pdest_eq (Combp(Combp(Varp(("="|"<=>"),_),l),r)) = l,r in let pmk_let (letbindings,body) = let vars,tms = unzip (map pdest_eq letbindings) in let _ = warn(not (pairwise (fun s t -> intersect(pfrees s []) (pfrees t []) = []) vars)) "duplicate names on left of let-binding: latest is used" in let lend = Combp(Varp("LET_END",dpty),body) in let abs = itlist (fun v t -> Absp(v,t)) vars lend in let labs = Combp(Varp("LET",dpty),abs) in rev_itlist (fun x f -> Combp(f,x)) tms labs in let pmk_vbinder(n,v,bod) = if n = "\\" then Absp(v,bod) else Combp(Varp(n,dpty),Absp(v,bod)) in let pmk_binder(n,vs,bod) = itlist (fun v b -> pmk_vbinder(n,v,b)) vs bod in let pmk_set_enum ptms = itlist (fun x t -> Combp(Combp(Varp("INSERT",dpty),x),t)) ptms (Varp("EMPTY",dpty)) in let pgenvar = let gcounter = ref 0 in fun () -> let count = !gcounter in (gcounter := count + 1; Varp("GEN%PVAR%"^(string_of_int count),dpty)) in let pmk_exists(v,ptm) = Combp(Varp("?",dpty),Absp(v,ptm)) in let pmk_list els = itlist (fun x y -> Combp(Combp(Varp("CONS",dpty),x),y)) els (Varp("NIL",dpty)) in let pmk_bool = let tt = Varp("T",dpty) and ff = Varp("F",dpty) in fun b -> if b then tt else ff in let pmk_char c = let lis = map (fun i -> pmk_bool((c / (1 lsl i)) mod 2 = 1)) (0--7) in itlist (fun x y -> Combp(y,x)) lis (Varp("ASCII",dpty)) in let pmk_string s = let ns = map (fun i -> Char.code(String.get s i)) (0--(String.length s - 1)) in pmk_list(map pmk_char ns) in let pmk_setcompr (fabs,bvs,babs) = let v = pgenvar() in let bod = itlist (curry pmk_exists) bvs (Combp(Combp(Combp(Varp("SETSPEC",dpty),v),babs),fabs)) in Combp(Varp("GSPEC",dpty),Absp(v,bod)) in let pmk_setabs (fabs,babs) = let evs = let fvs = pfrees fabs [] and bvs = pfrees babs [] in if length fvs <= 1 || bvs = [] then fvs else intersect fvs bvs in pmk_setcompr (fabs,evs,babs) in let rec mk_precedence infxs prs inp = match infxs with (s,(p,at))::_ -> let topins,rest = partition (fun (s',pat') -> pat' = (p,at)) infxs in (if at = "right" then rightbin else leftbin) (mk_precedence rest prs) (end_itlist (|||) (map (fun (s,_) -> a (Ident s)) topins)) (fun (Ident op) x y -> Combp(Combp(Varp(op,dpty),x),y)) ("term after binary operator") inp | _ -> prs inp in let pmk_geq s t = Combp(Combp(Varp("GEQ",dpty),s),t) in let pmk_pattern ((pat,guards),res) = let x = pgenvar() and y = pgenvar() in let vs = pfrees pat [] and bod = if guards = [] then Combp(Combp(Varp("_UNGUARDED_PATTERN",dpty),pmk_geq pat x), pmk_geq res y) else Combp(Combp(Combp(Varp("_GUARDED_PATTERN",dpty),pmk_geq pat x), hd guards), pmk_geq res y) in Absp(x,Absp(y,itlist (curry pmk_exists) vs bod)) in let pretype = parse_pretype and string inp = match inp with Ident s::rst when String.length s >= 2 & String.sub s 0 1 = "\"" & String.sub s (String.length s - 1) 1 = "\"" -> String.sub s 1 (String.length s - 2),rst | _ -> raise Noparse and singleton1 x = [x] and lmk_ite (((((_,b),_),l),_),r) = Combp(Combp(Combp(Varp("COND",dpty),b),l),r) and lmk_typed = function (p,[]) -> p | (p,[ty]) -> Typing(p,ty) | _ -> fail() and lmk_let (((_,bnds),_),ptm) = pmk_let (bnds,ptm) and lmk_binder ((((s,h),t),_),p) = pmk_binder(s,h::t,p) and lmk_setenum(l,_) = pmk_set_enum l and lmk_setabs(((l,_),r),_) = pmk_setabs(l,r) and lmk_setcompr(((((f,_),vs),_),b),_) = pmk_setcompr(f,pfrees vs [],b) and lmk_decimal ((_,l0),ropt) = let l,r = if ropt = [] then l0,"1" else let r0 = hd ropt in let n_l = num_of_string l0 and n_r = num_of_string r0 in let n_d = power_num (Int 10) (Int (String.length r0)) in let n_n = n_l */ n_d +/ n_r in string_of_num n_n,string_of_num n_d in Combp(Combp(Varp("DECIMAL",dpty),Varp(l,dpty)),Varp(r,dpty)) and lmk_univ((_,pty),_) = Typing(Varp("UNIV",dpty),Ptycon("fun",[pty;Ptycon("bool",[])])) and any_identifier = function ((Ident s):: rest) -> s,rest | _ -> raise Noparse and identifier = function ((Ident s):: rest) -> if can get_infix_status s || is_prefix s || parses_as_binder s then raise Noparse else s,rest | _ -> raise Noparse and binder = function ((Ident s):: rest) -> if parses_as_binder s then s,rest else raise Noparse | _ -> raise Noparse and pre_fix = function ((Ident s):: rest) -> if is_prefix s then s,rest else raise Noparse | _ -> raise Noparse in let rec preterm i = mk_precedence (infixes()) typed_appl_preterm i and nocommapreterm i = let infs = filter (fun (s,_) -> s <> ",") (infixes()) in mk_precedence infs typed_appl_preterm i and typed_appl_preterm i = (appl_preterm ++ possibly (a (Resword ":") ++ pretype >> snd) >> lmk_typed) i and appl_preterm i = (pre_fix ++ appl_preterm >> (fun (x,y) -> Combp(Varp(x,dpty),y)) ||| (binder_preterm ++ many binder_preterm >> (fun (h,t) -> itlist (fun x y -> Combp(y,x)) (rev t) h))) i and binder_preterm i = ((a (Resword "let") ++ leftbin (preterm >> singleton1) (a (Resword "and")) (K (@)) "binding" ++ a (Resword "in") ++ preterm >> lmk_let) ||| (binder ++ typed_apreterm ++ many typed_apreterm ++ a (Resword ".") ++ preterm >> lmk_binder) ||| atomic_preterm) i and typed_apreterm i = (atomic_preterm ++ possibly (a (Resword ":") ++ pretype >> snd) >> lmk_typed) i and atomic_preterm i = (try_user_parser ||| ((a (Resword "(") ++ a (Resword ":")) ++ pretype ++ a (Resword ")") >> lmk_univ) ||| (string >> pmk_string) ||| (a (Resword "(") ++ (any_identifier >> (fun s -> Varp(s,dpty))) ++ a (Resword ")") >> (snd o fst)) ||| (a (Resword "(") ++ preterm ++ a (Resword ")") >> (snd o fst)) ||| (a (Resword "if") ++ preterm ++ a (Resword "then") ++ preterm ++ a (Resword "else") ++ preterm >> lmk_ite) ||| (a (Resword "[") ++ elistof preterm (a (Resword ";")) "term" ++ a (Resword "]") >> (pmk_list o snd o fst)) ||| (a (Resword "{") ++ (elistof nocommapreterm (a (Ident ",")) "term" ++ a (Resword "}") >> lmk_setenum ||| (preterm ++ a (Resword "|") ++ preterm ++ a (Resword "}") >> lmk_setabs) ||| (preterm ++ a (Resword "|") ++ preterm ++ a (Resword "|") ++ preterm ++ a (Resword "}") >> lmk_setcompr)) >> snd) ||| (a (Resword "match") ++ preterm ++ a (Resword "with") ++ clauses >> (fun (((_,e),_),c) -> Combp(Combp(Varp("_MATCH",dpty),e),c))) ||| (a (Resword "function") ++ clauses >> (fun (_,c) -> Combp(Varp("_FUNCTION",dpty),c))) ||| (a (Ident "#") ++ identifier ++ possibly (a (Resword ".") ++ identifier >> snd) >> lmk_decimal) ||| (identifier >> (fun s -> Varp(s,dpty)))) i and pattern i = (preterm ++ possibly (a (Resword "when") ++ preterm >> snd)) i and clause i = ((pattern ++ (a (Resword "->") ++ preterm >> snd)) >> pmk_pattern) i and clauses i = ((possibly (a (Resword "|")) ++ listof clause (a (Resword "|")) "pattern-match clause" >> snd) >> end_itlist (fun s t -> Combp(Combp(Varp("_SEQPATTERN",dpty),s),t))) i in (fun inp -> match inp with [Ident s] when not(String.length s >= 2 & String.sub s 0 1 = "\"" & String.sub s (String.length s - 1) 1 = "\"") -> Varp(s,dpty),[] | _ -> preterm inp);; (* ------------------------------------------------------------------------- *) (* Type and term parsers. *) (* ------------------------------------------------------------------------- *) let parse_type s = let pty,l = (parse_pretype o lex o explode) s in if l = [] then type_of_pretype pty else failwith "Unparsed input following type";; let parse_term s = let ptm,l = (parse_preterm o lex o explode) s in if l = [] then (term_of_preterm o (retypecheck [])) ptm else failwith "Unparsed input following term";; hol-light/preterm.ml000066400000000000000000000464151303454263000147670ustar00rootroot00000000000000(* ========================================================================= *) (* Preterms and pretypes; typechecking; translation to types and terms. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Marco Maggesi 2012 *) (* (c) Copyright, Vincent Aravantinos 2012 *) (* ========================================================================= *) needs "printer.ml";; (* ------------------------------------------------------------------------- *) (* Flag to say whether to treat varstruct "\const. bod" as variable. *) (* ------------------------------------------------------------------------- *) let ignore_constant_varstruct = ref true;; (* ------------------------------------------------------------------------- *) (* Flags controlling the treatment of invented type variables in quotations. *) (* It can be treated as an error, result in a warning, or neither of those. *) (* ------------------------------------------------------------------------- *) let type_invention_warning = ref true;; let type_invention_error = ref false;; (* ------------------------------------------------------------------------- *) (* Implicit types or type schemes for non-constants. *) (* ------------------------------------------------------------------------- *) let the_implicit_types = ref ([]:(string*hol_type)list);; (* ------------------------------------------------------------------------- *) (* Overloading and interface mapping. *) (* ------------------------------------------------------------------------- *) let make_overloadable s gty = if can (assoc s) (!the_overload_skeletons) then if assoc s (!the_overload_skeletons) = gty then () else failwith "make_overloadable: differs from existing skeleton" else the_overload_skeletons := (s,gty)::(!the_overload_skeletons);; let remove_interface sym = let interface = filter ((<>)sym o fst) (!the_interface) in the_interface := interface;; let reduce_interface (sym,tm) = let namty = try dest_const tm with Failure _ -> dest_var tm in the_interface := filter ((<>) (sym,namty)) (!the_interface);; let override_interface (sym,tm) = let namty = try dest_const tm with Failure _ -> dest_var tm in let interface = filter ((<>)sym o fst) (!the_interface) in the_interface := (sym,namty)::interface;; let overload_interface (sym,tm) = let gty = try assoc sym (!the_overload_skeletons) with Failure _ -> failwith ("symbol \""^sym^"\" is not overloadable") in let (name,ty) as namty = try dest_const tm with Failure _ -> dest_var tm in if not (can (type_match gty ty) []) then failwith "Not an instance of type skeleton" else let interface = filter ((<>) (sym,namty)) (!the_interface) in the_interface := (sym,namty)::interface;; let prioritize_overload ty = do_list (fun (s,gty) -> try let _,(n,t) = find (fun (s',(n,t)) -> s' = s && mem ty (map fst (type_match gty t []))) (!the_interface) in overload_interface(s,mk_var(n,t)) with Failure _ -> ()) (!the_overload_skeletons);; (* ------------------------------------------------------------------------- *) (* Type abbreviations. *) (* ------------------------------------------------------------------------- *) let new_type_abbrev,remove_type_abbrev,type_abbrevs = let the_type_abbreviations = ref ([]:(string*hol_type)list) in let remove_type_abbrev s = the_type_abbreviations := filter (fun (s',_) -> s' <> s) (!the_type_abbreviations) in let new_type_abbrev(s,ty) = (remove_type_abbrev s; the_type_abbreviations := merge(<) [s,ty] (!the_type_abbreviations)) in let type_abbrevs() = !the_type_abbreviations in new_type_abbrev,remove_type_abbrev,type_abbrevs;; (* ------------------------------------------------------------------------- *) (* Handle constant hiding. *) (* ------------------------------------------------------------------------- *) let hide_constant,unhide_constant,is_hidden = let hcs = ref ([]:string list) in let hide_constant c = hcs := union [c] (!hcs) and unhide_constant c = hcs := subtract (!hcs) [c] and is_hidden c = mem c (!hcs) in hide_constant,unhide_constant,is_hidden;; (* ------------------------------------------------------------------------- *) (* The type of pretypes. *) (* ------------------------------------------------------------------------- *) type pretype = Utv of string (* User type variable *) | Ptycon of string * pretype list (* Type constructor *) | Stv of int;; (* System type variable *) (* ------------------------------------------------------------------------- *) (* Dummy pretype for the parser to stick in before a proper typing pass. *) (* ------------------------------------------------------------------------- *) let dpty = Ptycon("",[]);; (* ------------------------------------------------------------------------- *) (* Convert type to pretype. *) (* ------------------------------------------------------------------------- *) let rec pretype_of_type ty = try let con,args = dest_type ty in Ptycon(con,map pretype_of_type args) with Failure _ -> Utv(dest_vartype ty);; (* ------------------------------------------------------------------------- *) (* Preterm syntax. *) (* ------------------------------------------------------------------------- *) type preterm = Varp of string * pretype (* Variable - v *) | Constp of string * pretype (* Constant - c *) | Combp of preterm * preterm (* Combination - f x *) | Absp of preterm * preterm (* Lambda-abstraction - \x. t *) | Typing of preterm * pretype;; (* Type constraint - t : ty *) (* ------------------------------------------------------------------------- *) (* Convert term to preterm. *) (* ------------------------------------------------------------------------- *) let rec preterm_of_term tm = try let n,ty = dest_var tm in Varp(n,pretype_of_type ty) with Failure _ -> try let n,ty = dest_const tm in Constp(n,pretype_of_type ty) with Failure _ -> try let v,bod = dest_abs tm in Absp(preterm_of_term v,preterm_of_term bod) with Failure _ -> let l,r = dest_comb tm in Combp(preterm_of_term l,preterm_of_term r);; (* ------------------------------------------------------------------------- *) (* Main pretype->type, preterm->term and retypechecking functions. *) (* ------------------------------------------------------------------------- *) let type_of_pretype,term_of_preterm,retypecheck = let tyv_num = ref 0 in let new_type_var() = let n = !tyv_num in (tyv_num := n + 1; Stv(n)) in let pmk_cv(s,pty) = if can get_const_type s then Constp(s,pty) else Varp(s,pty) in let pmk_numeral = let num_pty = Ptycon("num",[]) in let NUMERAL = Constp("NUMERAL",Ptycon("fun",[num_pty; num_pty])) and BIT0 = Constp("BIT0",Ptycon("fun",[num_pty; num_pty])) and BIT1 = Constp("BIT1",Ptycon("fun",[num_pty; num_pty])) and t_0 = Constp("_0",num_pty) in let rec pmk_numeral(n) = if n =/ num_0 then t_0 else let m = quo_num n (num_2) and b = mod_num n (num_2) in let op = if b =/ num_0 then BIT0 else BIT1 in Combp(op,pmk_numeral(m)) in fun n -> Combp(NUMERAL,pmk_numeral n) in (* ----------------------------------------------------------------------- *) (* Pretype substitution for a pretype resulting from translation of type. *) (* ----------------------------------------------------------------------- *) let rec pretype_subst th ty = match ty with Ptycon(tycon,args) -> Ptycon(tycon,map (pretype_subst th) args) | Utv v -> rev_assocd ty th ty | _ -> failwith "pretype_subst: Unexpected form of pretype" in (* ----------------------------------------------------------------------- *) (* Convert type to pretype with new Stvs for all type variables. *) (* ----------------------------------------------------------------------- *) let pretype_instance ty = let gty = pretype_of_type ty and tyvs = map pretype_of_type (tyvars ty) in let subs = map (fun tv -> new_type_var(),tv) tyvs in pretype_subst subs gty in (* ----------------------------------------------------------------------- *) (* Get a new instance of a constant's generic type modulo interface. *) (* ----------------------------------------------------------------------- *) let get_generic_type cname = match filter ((=) cname o fst) (!the_interface) with [_,(c,ty)] -> ty | _::_::_ -> assoc cname (!the_overload_skeletons) | [] -> get_const_type cname in (* ----------------------------------------------------------------------- *) (* Get the implicit generic type of a variable. *) (* ----------------------------------------------------------------------- *) let get_var_type vname = assoc vname !the_implicit_types in (* ----------------------------------------------------------------------- *) (* Unravel unifications and apply them to a type. *) (* ----------------------------------------------------------------------- *) let rec solve env pty = match pty with Ptycon(f,args) -> Ptycon(f,map (solve env) args) | Stv(i) -> if defined env i then solve env (apply env i) else pty | _ -> pty in (* ----------------------------------------------------------------------- *) (* Functions for display of preterms and pretypes, by converting them *) (* to terms and types then re-using standard printing functions. *) (* ----------------------------------------------------------------------- *) let free_stvs = let rec free_stvs = function |Stv n -> [n] |Utv _ -> [] |Ptycon(_,args) -> flat (map free_stvs args) in setify o free_stvs in let string_of_pretype stvs = let rec type_of_pretype' ns = function |Stv n -> mk_vartype (if mem n ns then "?" ^ string_of_int n else "_") |Utv v -> mk_vartype v |Ptycon(con,args) -> mk_type(con,map (type_of_pretype' ns) args) in string_of_type o type_of_pretype' stvs in let string_of_preterm = let rec untyped_t_of_pt = function |Varp(s,pty) -> mk_var(s,aty) |Constp(s,pty) -> mk_mconst(s,get_const_type s) |Combp(l,r) -> mk_comb(untyped_t_of_pt l,untyped_t_of_pt r) |Absp(v,bod) -> mk_gabs(untyped_t_of_pt v,untyped_t_of_pt bod) |Typing(ptm,pty) -> untyped_t_of_pt ptm in string_of_term o untyped_t_of_pt in let string_of_ty_error env = function |None -> "unify: types cannot be unified " ^ "(you should not see this message, please report)" |Some(t,ty1,ty2) -> let ty1 = solve env ty1 and ty2 = solve env ty2 in let sty1 = string_of_pretype (free_stvs ty2) ty1 in let sty2 = string_of_pretype (free_stvs ty1) ty2 in let default_msg s = " " ^ s ^ " cannot have type " ^ sty1 ^ " and " ^ sty2 ^ " simultaneously" in match t with |Constp(s,_) -> " " ^ s ^ " has type " ^ string_of_type (get_const_type s) ^ ", " ^ "it cannot be used with type " ^ sty2 |Varp(s,_) -> default_msg s |t -> default_msg (string_of_preterm t) in (* ----------------------------------------------------------------------- *) (* Unification of types *) (* ----------------------------------------------------------------------- *) let rec istrivial ptm env x = function |Stv y -> y = x || defined env y && istrivial ptm env x (apply env y) |Ptycon(f,args) when exists (istrivial ptm env x) args -> failwith (string_of_ty_error env ptm) |(Ptycon _ | Utv _) -> false in let unify ptm env ty1 ty2 = let rec unify env = function |[] -> env |(ty1,ty2,_)::oth when ty1 = ty2 -> unify env oth |(Ptycon(f,fargs),Ptycon(g,gargs),ptm)::oth -> if f = g && length fargs = length gargs then unify env (map2 (fun x y -> x,y,ptm) fargs gargs @ oth) else failwith (string_of_ty_error env ptm) |(Stv x,t,ptm)::oth -> if defined env x then unify env ((apply env x,t,ptm)::oth) else unify (if istrivial ptm env x t then env else (x|->t) env) oth |(t,Stv x,ptm)::oth -> unify env ((Stv x,t,ptm)::oth) |(_,_,ptm)::oth -> failwith (string_of_ty_error env ptm) in unify env [ty1,ty2,match ptm with None -> None | Some t -> Some(t,ty1,ty2)] in (* ----------------------------------------------------------------------- *) (* Attempt to attach a given type to a term, performing unifications. *) (* ----------------------------------------------------------------------- *) let rec typify ty (ptm,venv,uenv) = match ptm with |Varp(s,_) when can (assoc s) venv -> let ty' = assoc s venv in Varp(s,ty'),[],unify (Some ptm) uenv ty' ty |Varp(s,_) when can num_of_string s -> let t = pmk_numeral(num_of_string s) in let ty' = Ptycon("num",[]) in t,[],unify (Some ptm) uenv ty' ty |Varp(s,_) -> warn (s <> "" && isnum s) "Non-numeral begins with a digit"; if not(is_hidden s) && can get_generic_type s then let pty = pretype_instance(get_generic_type s) in let ptm = Constp(s,pty) in ptm,[],unify (Some ptm) uenv pty ty else let ptm = Varp(s,ty) in if not(can get_var_type s) then ptm,[s,ty],uenv else let pty = pretype_instance(get_var_type s) in ptm,[s,ty],unify (Some ptm) uenv pty ty |Combp(f,x) -> let ty'' = new_type_var() in let ty' = Ptycon("fun",[ty'';ty]) in let f',venv1,uenv1 = typify ty' (f,venv,uenv) in let x',venv2,uenv2 = typify ty'' (x,venv1@venv,uenv1) in Combp(f',x'),(venv1@venv2),uenv2 |Typing(tm,pty) -> typify ty (tm,venv,unify (Some tm) uenv ty pty) |Absp(v,bod) -> let ty',ty'' = match ty with |Ptycon("fun",[ty';ty'']) -> ty',ty'' |_ -> new_type_var(),new_type_var() in let ty''' = Ptycon("fun",[ty';ty'']) in let uenv0 = unify (Some ptm) uenv ty''' ty in let v',venv1,uenv1 = let v',venv1,uenv1 = typify ty' (v,[],uenv0) in match v' with |Constp(s,_) when !ignore_constant_varstruct -> Varp(s,ty'),[s,ty'],uenv0 |_ -> v',venv1,uenv1 in let bod',venv2,uenv2 = typify ty'' (bod,venv1@venv,uenv1) in Absp(v',bod'),venv2,uenv2 |_ -> failwith "typify: unexpected constant at this stage" in (* ----------------------------------------------------------------------- *) (* Further specialize type constraints by resolving overloadings. *) (* ----------------------------------------------------------------------- *) let rec resolve_interface ptm cont env = match ptm with Combp(f,x) -> resolve_interface f (resolve_interface x cont) env | Absp(v,bod) -> resolve_interface v (resolve_interface bod cont) env | Varp(_,_) -> cont env | Constp(s,ty) -> let maps = filter (fun (s',_) -> s' = s) (!the_interface) in if maps = [] then cont env else tryfind (fun (_,(_,ty')) -> let ty' = pretype_instance ty' in cont(unify (Some ptm) env ty' ty)) maps in (* ----------------------------------------------------------------------- *) (* Hence apply throughout a preterm. *) (* ----------------------------------------------------------------------- *) let rec solve_preterm env ptm = match ptm with Varp(s,ty) -> Varp(s,solve env ty) | Combp(f,x) -> Combp(solve_preterm env f,solve_preterm env x) | Absp(v,bod) -> Absp(solve_preterm env v,solve_preterm env bod) | Constp(s,ty) -> let tys = solve env ty in try let _,(c',_) = find (fun (s',(c',ty')) -> s = s' && can (unify None env (pretype_instance ty')) ty) (!the_interface) in pmk_cv(c',tys) with Failure _ -> Constp(s,tys) in (* ----------------------------------------------------------------------- *) (* Flag to indicate that Stvs were translated to real type variables. *) (* ----------------------------------------------------------------------- *) let stvs_translated = ref false in (* ----------------------------------------------------------------------- *) (* Pretype <-> type conversion; -> flags system type variable translation. *) (* ----------------------------------------------------------------------- *) let rec type_of_pretype ty = match ty with Stv n -> stvs_translated := true; let s = "?"^(string_of_int n) in mk_vartype(s) | Utv(v) -> mk_vartype(v) | Ptycon(con,args) -> mk_type(con,map type_of_pretype args) in (* ----------------------------------------------------------------------- *) (* Maps preterms to terms. *) (* ----------------------------------------------------------------------- *) let term_of_preterm = let rec term_of_preterm ptm = match ptm with Varp(s,pty) -> mk_var(s,type_of_pretype pty) | Constp(s,pty) -> mk_mconst(s,type_of_pretype pty) | Combp(l,r) -> mk_comb(term_of_preterm l,term_of_preterm r) | Absp(v,bod) -> mk_gabs(term_of_preterm v,term_of_preterm bod) | Typing(ptm,pty) -> term_of_preterm ptm in let report_type_invention () = if !stvs_translated then if !type_invention_error then failwith "typechecking error (cannot infer type of variables)" else warn !type_invention_warning "inventing type variables" in fun ptm -> stvs_translated := false; let tm = term_of_preterm ptm in report_type_invention (); tm in (* ----------------------------------------------------------------------- *) (* Overall typechecker: initial typecheck plus overload resolution pass. *) (* ----------------------------------------------------------------------- *) let retypecheck venv ptm = let ty = new_type_var() in let ptm',_,env = try typify ty (ptm,venv,undefined) with Failure e -> failwith ("typechecking error (initial type assignment):" ^ e) in let env' = try resolve_interface ptm' (fun e -> e) env with Failure _ -> failwith "typechecking error (overload resolution)" in let ptm'' = solve_preterm env' ptm' in ptm'' in type_of_pretype,term_of_preterm,retypecheck;; hol-light/printer.ml000066400000000000000000000570301303454263000147670ustar00rootroot00000000000000(* ========================================================================= *) (* Simplistic HOL Light prettyprinter, using the OCaml "Format" library. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "nets.ml";; (* ------------------------------------------------------------------------- *) (* Character discrimination. *) (* ------------------------------------------------------------------------- *) let isspace,issep,isbra,issymb,isalpha,isnum,isalnum = let charcode s = Char.code(String.get s 0) in let spaces = " \t\n\r" and separators = ",;" and brackets = "()[]{}" and symbs = "\\!@#$%^&*-+|\\<=>/?~.:" and alphas = "'abcdefghijklmnopqrstuvwxyz_ABCDEFGHIJKLMNOPQRSTUVWXYZ" and nums = "0123456789" in let allchars = spaces^separators^brackets^symbs^alphas^nums in let csetsize = itlist (max o charcode) (explode allchars) 256 in let ctable = Array.make csetsize 0 in do_list (fun c -> Array.set ctable (charcode c) 1) (explode spaces); do_list (fun c -> Array.set ctable (charcode c) 2) (explode separators); do_list (fun c -> Array.set ctable (charcode c) 4) (explode brackets); do_list (fun c -> Array.set ctable (charcode c) 8) (explode symbs); do_list (fun c -> Array.set ctable (charcode c) 16) (explode alphas); do_list (fun c -> Array.set ctable (charcode c) 32) (explode nums); let isspace c = Array.get ctable (charcode c) = 1 and issep c = Array.get ctable (charcode c) = 2 and isbra c = Array.get ctable (charcode c) = 4 and issymb c = Array.get ctable (charcode c) = 8 and isalpha c = Array.get ctable (charcode c) = 16 and isnum c = Array.get ctable (charcode c) = 32 and isalnum c = Array.get ctable (charcode c) >= 16 in isspace,issep,isbra,issymb,isalpha,isnum,isalnum;; (* ------------------------------------------------------------------------- *) (* Reserved words. *) (* ------------------------------------------------------------------------- *) let reserve_words,unreserve_words,is_reserved_word,reserved_words = let reswords = ref ["("; ")"; "["; "]"; "{"; "}"; ":"; ";"; "."; "|"; "let"; "in"; "and"; "if"; "then"; "else"; "match"; "with"; "function"; "->"; "when"] in (fun ns -> reswords := union (!reswords) ns), (fun ns -> reswords := subtract (!reswords) ns), (fun n -> mem n (!reswords)), (fun () -> !reswords);; (* ------------------------------------------------------------------------- *) (* Functions to access the global tables controlling special parse status. *) (* *) (* o List of binders; *) (* *) (* o List of prefixes (right-associated unary functions like negation). *) (* *) (* o List of infixes with their precedences and associations. *) (* *) (* Note that these tables are independent of constant/variable status or *) (* whether an identifier is symbolic. *) (* ------------------------------------------------------------------------- *) let unparse_as_binder,parse_as_binder,parses_as_binder,binders = let binder_list = ref ([]:string list) in (fun n -> binder_list := subtract (!binder_list) [n]), (fun n -> binder_list := union (!binder_list) [n]), (fun n -> mem n (!binder_list)), (fun () -> !binder_list);; let unparse_as_prefix,parse_as_prefix,is_prefix,prefixes = let prefix_list = ref ([]:string list) in (fun n -> prefix_list := subtract (!prefix_list) [n]), (fun n -> prefix_list := union (!prefix_list) [n]), (fun n -> mem n (!prefix_list)), (fun () -> !prefix_list);; let unparse_as_infix,parse_as_infix,get_infix_status,infixes = let cmp (s,(x,a)) (t,(y,b)) = x < y || x = y && a > b || x = y && a = b && s < t in let infix_list = ref ([]:(string * (int * string)) list) in (fun n -> infix_list := filter (((<>) n) o fst) (!infix_list)), (fun (n,d) -> infix_list := sort cmp ((n,d)::(filter (((<>) n) o fst) (!infix_list)))), (fun n -> assoc n (!infix_list)), (fun () -> !infix_list);; (* ------------------------------------------------------------------------- *) (* Interface mapping. *) (* ------------------------------------------------------------------------- *) let the_interface = ref ([] :(string * (string * hol_type)) list);; let the_overload_skeletons = ref ([] : (string * hol_type) list);; (* ------------------------------------------------------------------------- *) (* Now the printer. *) (* ------------------------------------------------------------------------- *) include Format;; set_max_boxes 100;; (* ------------------------------------------------------------------------- *) (* Flag determining whether interface/overloading is reversed on printing. *) (* ------------------------------------------------------------------------- *) let reverse_interface_mapping = ref true;; (* ------------------------------------------------------------------------- *) (* Determine binary operators that print without surrounding spaces. *) (* ------------------------------------------------------------------------- *) let unspaced_binops = ref [","; ".."; "$"];; (* ------------------------------------------------------------------------- *) (* Binary operators to print at start of line when breaking. *) (* ------------------------------------------------------------------------- *) let prebroken_binops = ref ["==>"];; (* ------------------------------------------------------------------------- *) (* Force explicit indications of bound variables in set abstractions. *) (* ------------------------------------------------------------------------- *) let print_unambiguous_comprehensions = ref false;; (* ------------------------------------------------------------------------- *) (* Print the universal set UNIV:A->bool as "(:A)". *) (* ------------------------------------------------------------------------- *) let typify_universal_set = ref true;; (* ------------------------------------------------------------------------- *) (* Flag controlling whether hypotheses print. *) (* ------------------------------------------------------------------------- *) let print_all_thm = ref true;; (* ------------------------------------------------------------------------- *) (* Get the name of a constant or variable. *) (* ------------------------------------------------------------------------- *) let name_of tm = match tm with Var(x,ty) | Const(x,ty) -> x | _ -> "";; (* ------------------------------------------------------------------------- *) (* Printer for types. *) (* ------------------------------------------------------------------------- *) let pp_print_type,pp_print_qtype = let soc sep flag ss = if ss = [] then "" else let s = end_itlist (fun s1 s2 -> s1^sep^s2) ss in if flag then "("^s^")" else s in let rec sot pr ty = try dest_vartype ty with Failure _ -> match dest_type ty with con,[] -> con | "fun",[ty1;ty2] -> soc "->" (pr > 0) [sot 1 ty1; sot 0 ty2] | "sum",[ty1;ty2] -> soc "+" (pr > 2) [sot 3 ty1; sot 2 ty2] | "prod",[ty1;ty2] -> soc "#" (pr > 4) [sot 5 ty1; sot 4 ty2] | "cart",[ty1;ty2] -> soc "^" (pr > 6) [sot 6 ty1; sot 7 ty2] | con,args -> (soc "," true (map (sot 0) args))^con in (fun fmt ty -> pp_print_string fmt (sot 0 ty)), (fun fmt ty -> pp_print_string fmt ("`:" ^ sot 0 ty ^ "`"));; (* ------------------------------------------------------------------------- *) (* Allow the installation of user printers. Must fail quickly if N/A. *) (* ------------------------------------------------------------------------- *) let install_user_printer,delete_user_printer,try_user_printer = let user_printers = ref ([]:(string*(formatter->term->unit))list) in (fun pr -> user_printers := pr::(!user_printers)), (fun s -> user_printers := snd(remove (fun (s',_) -> s = s') (!user_printers))), (fun fmt -> fun tm -> tryfind (fun (_,pr) -> pr fmt tm) (!user_printers));; (* ------------------------------------------------------------------------- *) (* Printer for terms. *) (* ------------------------------------------------------------------------- *) let pp_print_term = let reverse_interface (s0,ty0) = if not(!reverse_interface_mapping) then s0 else try fst(find (fun (s,(s',ty)) -> s' = s0 && can (type_match ty ty0) []) (!the_interface)) with Failure _ -> s0 in let DEST_BINARY c tm = try let il,r = dest_comb tm in let i,l = dest_comb il in if i = c || (is_const i && is_const c & reverse_interface(dest_const i) = reverse_interface(dest_const c)) then l,r else fail() with Failure _ -> failwith "DEST_BINARY" and ARIGHT s = match snd(get_infix_status s) with "right" -> true | _ -> false in let rec powerof10 n = if abs_num n true | Const("F",_) -> false | _ -> failwith "bool_of_term" in let code_of_term t = let f,tms = strip_comb t in if not(is_const f && fst(dest_const f) = "ASCII") || not(length tms = 8) then failwith "code_of_term" else itlist (fun b f -> if b then 1 + 2 * f else 2 * f) (map bool_of_term (rev tms)) 0 in let rec dest_clause tm = let pbod = snd(strip_exists(body(body tm))) in let s,args = strip_comb pbod in if name_of s = "_UNGUARDED_PATTERN" && length args = 2 then [rand(rator(hd args));rand(rator(hd(tl args)))] else if name_of s = "_GUARDED_PATTERN" && length args = 3 then [rand(rator(hd args)); hd(tl args); rand(rator(hd(tl(tl args))))] else failwith "dest_clause" in let rec dest_clauses tm = let s,args = strip_comb tm in if name_of s = "_SEQPATTERN" && length args = 2 then dest_clause (hd args)::dest_clauses(hd(tl args)) else [dest_clause tm] in fun fmt -> let rec print_term prec tm = try try_user_printer fmt tm with Failure _ -> try pp_print_string fmt (string_of_num(dest_numeral tm)) with Failure _ -> try (let tms = dest_list tm in try if fst(dest_type(hd(snd(dest_type(type_of tm))))) <> "char" then fail() else let ccs = map (String.make 1 o Char.chr o code_of_term) tms in let s = "\"" ^ String.escaped (implode ccs) ^ "\"" in pp_print_string fmt s with Failure _ -> pp_print_string fmt "["; print_term_sequence "; " 0 tms; pp_print_string fmt "]") with Failure _ -> if is_gabs tm then print_binder prec tm else let hop,args = strip_comb tm in let s0 = name_of hop and ty0 = type_of hop in let s = reverse_interface (s0,ty0) in try if s = "EMPTY" && is_const tm && args = [] then pp_print_string fmt "{}" else fail() with Failure _ -> try if s = "UNIV" && !typify_universal_set && is_const tm && args = [] then let ty = fst(dest_fun_ty(type_of tm)) in (pp_print_string fmt "(:"; pp_print_type fmt ty; pp_print_string fmt ")") else fail() with Failure _ -> try if s <> "INSERT" then fail() else let mems,oth = splitlist (dest_binary "INSERT") tm in if is_const oth && fst(dest_const oth) = "EMPTY" then (pp_print_string fmt "{"; print_term_sequence ", " 14 mems; pp_print_string fmt "}") else fail() with Failure _ -> try if not (s = "GSPEC") then fail() else let evs,bod = strip_exists(body(rand tm)) in let bod1,fabs = dest_comb bod in let bod2,babs = dest_comb bod1 in let c = rator bod2 in if fst(dest_const c) <> "SETSPEC" then fail() else pp_print_string fmt "{"; print_term 0 fabs; pp_print_string fmt " | "; (let fvs = frees fabs and bvs = frees babs in if not(!print_unambiguous_comprehensions) & set_eq evs (if (length fvs <= 1 || bvs = []) then fvs else intersect fvs bvs) then () else (print_term_sequence "," 14 evs; pp_print_string fmt " | ")); print_term 0 babs; pp_print_string fmt "}" with Failure _ -> try let eqs,bod = dest_let tm in (if prec = 0 then pp_open_hvbox fmt 0 else (pp_open_hvbox fmt 1; pp_print_string fmt "("); pp_print_string fmt "let "; print_term 0 (mk_eq(hd eqs)); do_list (fun (v,t) -> pp_print_break fmt 1 0; pp_print_string fmt "and "; print_term 0 (mk_eq(v,t))) (tl eqs); pp_print_string fmt " in"; pp_print_break fmt 1 0; print_term 0 bod; if prec = 0 then () else pp_print_string fmt ")"; pp_close_box fmt ()) with Failure _ -> try if s <> "DECIMAL" then fail() else let n_num = dest_numeral (hd args) and n_den = dest_numeral (hd(tl args)) in if not(powerof10 n_den) then fail() else let s_num = string_of_num(quo_num n_num n_den) in let s_den = implode(tl(explode(string_of_num (n_den +/ (mod_num n_num n_den))))) in pp_print_string fmt("#"^s_num^(if n_den = Int 1 then "" else ".")^s_den) with Failure _ -> try if s <> "_MATCH" || length args <> 2 then failwith "" else let cls = dest_clauses(hd(tl args)) in (if prec = 0 then () else pp_print_string fmt "("; pp_open_hvbox fmt 0; pp_print_string fmt "match "; print_term 0 (hd args); pp_print_string fmt " with"; pp_print_break fmt 1 2; print_clauses cls; pp_close_box fmt (); if prec = 0 then () else pp_print_string fmt ")") with Failure _ -> try if s <> "_FUNCTION" || length args <> 1 then failwith "" else let cls = dest_clauses(hd args) in (if prec = 0 then () else pp_print_string fmt "("; pp_open_hvbox fmt 0; pp_print_string fmt "function"; pp_print_break fmt 1 2; print_clauses cls; pp_close_box fmt (); if prec = 0 then () else pp_print_string fmt ")") with Failure _ -> if s = "COND" && length args = 3 then (if prec = 0 then () else pp_print_string fmt "("; pp_open_hvbox fmt (-1); pp_print_string fmt "if "; print_term 0 (hd args); pp_print_break fmt 0 0; pp_print_string fmt " then "; print_term 0 (hd(tl args)); pp_print_break fmt 0 0; pp_print_string fmt " else "; print_term 0 (hd(tl(tl args))); pp_close_box fmt (); if prec = 0 then () else pp_print_string fmt ")") else if is_prefix s && length args = 1 then (if prec = 1000 then pp_print_string fmt "(" else (); pp_print_string fmt s; (if isalnum s || s = "--" & length args = 1 & (try let l,r = dest_comb(hd args) in let s0 = name_of l and ty0 = type_of l in reverse_interface (s0,ty0) = "--" || mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] with Failure _ -> false) || s = "~" && length args = 1 && is_neg(hd args) then pp_print_string fmt " " else ()); print_term 999 (hd args); if prec = 1000 then pp_print_string fmt ")" else ()) else if parses_as_binder s && length args = 1 && is_gabs (hd args) then print_binder prec tm else if can get_infix_status s && length args = 2 then let bargs = if ARIGHT s then let tms,tmt = splitlist (DEST_BINARY hop) tm in tms@[tmt] else let tmt,tms = rev_splitlist (DEST_BINARY hop) tm in tmt::tms in let newprec = fst(get_infix_status s) in (if newprec <= prec then (pp_open_hvbox fmt 1; pp_print_string fmt "(") else pp_open_hvbox fmt 0; print_term newprec (hd bargs); do_list (fun x -> if mem s (!unspaced_binops) then () else if mem s (!prebroken_binops) then pp_print_break fmt 1 0 else pp_print_string fmt " "; pp_print_string fmt s; if mem s (!unspaced_binops) then pp_print_break fmt 0 0 else if mem s (!prebroken_binops) then pp_print_string fmt " " else pp_print_break fmt 1 0; print_term newprec x) (tl bargs); if newprec <= prec then pp_print_string fmt ")" else (); pp_close_box fmt ()) else if (is_const hop || is_var hop) && args = [] then let s' = if parses_as_binder s || can get_infix_status s || is_prefix s then "("^s^")" else s in pp_print_string fmt s' else let l,r = dest_comb tm in (pp_open_hvbox fmt 0; if prec = 1000 then pp_print_string fmt "(" else (); print_term 999 l; (if try mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] with Failure _ -> false then () else pp_print_space fmt ()); print_term 1000 r; if prec = 1000 then pp_print_string fmt ")" else (); pp_close_box fmt ()) and print_term_sequence sep prec tms = if tms = [] then () else (print_term prec (hd tms); let ttms = tl tms in if ttms = [] then () else (pp_print_string fmt sep; print_term_sequence sep prec ttms)) and print_binder prec tm = let absf = is_gabs tm in let s = if absf then "\\" else name_of(rator tm) in let rec collectvs tm = if absf then if is_abs tm then let v,t = dest_abs tm in let vs,bod = collectvs t in (false,v)::vs,bod else if is_gabs tm then let v,t = dest_gabs tm in let vs,bod = collectvs t in (true,v)::vs,bod else [],tm else if is_comb tm && name_of(rator tm) = s then if is_abs(rand tm) then let v,t = dest_abs(rand tm) in let vs,bod = collectvs t in (false,v)::vs,bod else if is_gabs(rand tm) then let v,t = dest_gabs(rand tm) in let vs,bod = collectvs t in (true,v)::vs,bod else [],tm else [],tm in let vs,bod = collectvs tm in ((if prec = 0 then pp_open_hvbox fmt 4 else (pp_open_hvbox fmt 5; pp_print_string fmt "(")); pp_print_string fmt s; (if isalnum s then pp_print_string fmt " " else ()); do_list (fun (b,x) -> (if b then pp_print_string fmt "(" else ()); print_term 0 x; (if b then pp_print_string fmt ")" else ()); pp_print_string fmt " ") (butlast vs); (if fst(last vs) then pp_print_string fmt "(" else ()); print_term 0 (snd(last vs)); (if fst(last vs) then pp_print_string fmt ")" else ()); pp_print_string fmt "."; (if length vs = 1 then pp_print_string fmt " " else pp_print_space fmt ()); print_term 0 bod; (if prec = 0 then () else pp_print_string fmt ")"); pp_close_box fmt ()) and print_clauses cls = match cls with [c] -> print_clause c | c::cs -> (print_clause c; pp_print_break fmt 1 0; pp_print_string fmt "| "; print_clauses cs) and print_clause cl = match cl with [p;g;r] -> (print_term 1 p; pp_print_string fmt " when "; print_term 1 g; pp_print_string fmt " -> "; print_term 1 r) | [p;r] -> (print_term 1 p; pp_print_string fmt " -> "; print_term 1 r) in print_term 0;; (* ------------------------------------------------------------------------- *) (* Print term with quotes. *) (* ------------------------------------------------------------------------- *) let pp_print_qterm fmt tm = pp_print_string fmt "`"; pp_print_term fmt tm; pp_print_string fmt "`";; (* ------------------------------------------------------------------------- *) (* Printer for theorems. *) (* ------------------------------------------------------------------------- *) let pp_print_thm fmt th = let asl,tm = dest_thm th in (if not (asl = []) then (if !print_all_thm then (pp_print_term fmt (hd asl); do_list (fun x -> pp_print_string fmt ","; pp_print_space fmt (); pp_print_term fmt x) (tl asl)) else pp_print_string fmt "..."; pp_print_space fmt ()) else (); pp_open_hbox fmt(); pp_print_string fmt "|- "; pp_print_term fmt tm; pp_close_box fmt ());; (* ------------------------------------------------------------------------- *) (* Print on standard output. *) (* ------------------------------------------------------------------------- *) let print_type = pp_print_type std_formatter;; let print_qtype = pp_print_qtype std_formatter;; let print_term = pp_print_term std_formatter;; let print_qterm = pp_print_qterm std_formatter;; let print_thm = pp_print_thm std_formatter;; (* ------------------------------------------------------------------------- *) (* Install all the printers. *) (* ------------------------------------------------------------------------- *) #install_printer print_qtype;; #install_printer print_qterm;; #install_printer print_thm;; (* ------------------------------------------------------------------------- *) (* Conversions to string. *) (* ------------------------------------------------------------------------- *) let print_to_string printer = let buf = Buffer.create 16 in let fmt = formatter_of_buffer buf in let () = pp_set_max_boxes fmt 100 in let print = printer fmt in let flush = pp_print_flush fmt in fun x -> let () = pp_set_margin fmt (get_margin ()) in let () = print x in let () = flush () in let s = Buffer.contents buf in let () = Buffer.reset buf in s;; let string_of_type = print_to_string pp_print_type;; let string_of_term = print_to_string pp_print_term;; let string_of_thm = print_to_string pp_print_thm;; hol-light/quot.ml000066400000000000000000000177731303454263000143060ustar00rootroot00000000000000(* ========================================================================= *) (* Tools for defining quotient types and lifting first order theorems. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "meson.ml";; (* ------------------------------------------------------------------------- *) (* Given a type name "ty" and a curried binary relation R, this defines *) (* a new type "ty" of R-equivalence classes. The abstraction and *) (* representation functions for the new type are called "mk_ty" and *) (* "dest_ty". The type bijections (after beta-conversion) are returned: *) (* *) (* |- mk_ty (dest_ty a) = a *) (* *) (* |- (?x. r = R x) <=> (dest_ty (mk_ty r) = r) *) (* ------------------------------------------------------------------------- *) let define_quotient_type = fun tyname (absname,repname) eqv -> let ty = hd(snd(dest_type(type_of eqv))) in let pty = mk_fun_ty ty bool_ty in let s = mk_var("s",pty) and x = mk_var("x",ty) in let eqvx = mk_comb(eqv,x) in let pred = mk_abs(s,mk_exists(x,mk_eq(s,eqvx))) in let th0 = BETA_CONV(mk_comb(pred,eqvx)) in let th1 = EXISTS(rand(concl th0),x) (REFL eqvx) in let th2 = EQ_MP (SYM th0) th1 in let abs,rep = new_basic_type_definition tyname (absname,repname) th2 in abs,CONV_RULE(LAND_CONV BETA_CONV) rep;; (* ------------------------------------------------------------------------- *) (* Given a welldefinedness theorem for a curried function f, of the form: *) (* *) (* |- !x1 x1' .. xn xn'. (x1 == x1') /\ ... /\ (xn == xn') *) (* ==> (f x1 .. xn == f x1' .. f nx') *) (* *) (* where each "==" is either equality or some fixed binary relation R, a *) (* new operator called "opname" is introduced which lifts "f" up to the *) (* R-equivalence classes. Two theorems are returned: the actual definition *) (* and a useful consequence for lifting theorems. *) (* *) (* The function also needs the second (more complicated) type bijection, and *) (* the reflexivity and transitivity (not symmetry!) of the equivalence *) (* relation. The use also gives a name for the new function. *) (* ------------------------------------------------------------------------- *) let lift_function = let SELECT_LEMMA = prove (`!x:A. (@y. x = y) = x`, GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [EQ_SYM_EQ] THEN MATCH_ACCEPT_TAC SELECT_REFL) in fun tybij2 -> let tybl,tybr = dest_comb(concl tybij2) in let eqvx = rand(body(rand(rand tybl))) in let eqv,xtm = dest_comb eqvx in let dmr,rtm = dest_eq tybr in let dest,mrt = dest_comb dmr in let mk = rator mrt in let ety = type_of mrt in fun (refl_th,trans_th) fname wth -> let wtm = repeat (snd o dest_forall) (concl wth) in let wfvs = frees wtm in let hyps,con = try (conjuncts F_F I) (dest_imp wtm) with Failure _ -> [],wtm in let eqs,rels = partition is_eq hyps in let rvs = map lhand rels in let qvs = map lhs eqs in let evs = variants wfvs (map (fun v -> mk_var(fst(dest_var v),ety)) rvs) in let mems = map2 (fun rv ev -> mk_comb(mk_comb(dest,ev),rv)) rvs evs in let lcon,rcon = dest_comb con in let u = variant (evs @ wfvs) (mk_var("u",type_of rcon)) in let ucon = mk_comb(lcon,u) in let dbod = list_mk_conj(ucon::mems) in let detm = list_mk_exists(rvs,dbod) in let datm = mk_abs(u,detm) in let def = if is_eq con then list_mk_icomb "@" [datm] else mk_comb(mk,datm) in let newargs = map (fun e -> try lhs e with Failure _ -> assoc (lhand e) (zip rvs evs)) hyps in let rdef = list_mk_abs(newargs,def) in let ldef = mk_var(fname,type_of rdef) in let dth = new_definition(mk_eq(ldef,rdef)) in let eth = rev_itlist (fun v th -> CONV_RULE(RAND_CONV BETA_CONV) (AP_THM th v)) newargs dth in let targs = map (fun v -> mk_comb(mk,mk_comb(eqv,v))) rvs in let dme_th = let th = INST [eqvx,rtm] tybij2 in EQ_MP th (EXISTS(lhs(concl th),xtm) (REFL eqvx)) in let ith = INST (zip targs evs) eth in let jth = SUBS (map (fun v -> INST[v,xtm] dme_th) rvs) ith in let apop,uxtm = dest_comb(rand(concl jth)) in let extm = body uxtm in let evs,bod = strip_exists extm in let th1 = ASSUME bod in let th2 = if evs = [] then th1 else let th2a,th2b = CONJ_PAIR th1 in let ethlist = CONJUNCTS th2b @ map REFL qvs in let th2c = end_itlist CONJ (map (fun v -> find ((=) (lhand v) o lhand o concl) ethlist) hyps) in let th2d = MATCH_MP wth th2c in let th2e = try TRANS th2d th2a with Failure _ -> MATCH_MP trans_th (CONJ th2d th2a) in itlist SIMPLE_CHOOSE evs th2e in let th3 = ASSUME(concl th2) in let th4 = end_itlist CONJ (th3::(map (C SPEC refl_th) rvs)) in let th5 = itlist SIMPLE_EXISTS evs (ASSUME bod) in let th6 = MATCH_MP (DISCH_ALL th5) th4 in let th7 = IMP_ANTISYM_RULE (DISCH_ALL th2) (DISCH_ALL th6) in let th8 = TRANS jth (AP_TERM apop (ABS u th7)) in let fconv = if is_eq con then REWR_CONV SELECT_LEMMA else RAND_CONV ETA_CONV in let th9 = CONV_RULE (RAND_CONV fconv) th8 in eth,GSYM th9;; (* ------------------------------------------------------------------------- *) (* Lifts a theorem. This can be done by higher order rewriting alone. *) (* *) (* NB! All and only the first order variables must be bound by quantifiers. *) (* ------------------------------------------------------------------------- *) let lift_theorem = let pth = prove (`(!x:Repty. R x x) /\ (!x y. R x y <=> R y x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!a. mk(dest a) = a) /\ (!r. (?x. r = R x) <=> (dest(mk r) = r)) ==> (!x y. R x y <=> (mk(R x) = mk(R y))) /\ (!P. (!x. P(mk(R x))) <=> (!x. P x)) /\ (!P. (?x. P(mk(R x))) <=> (?x. P x)) /\ (!x:Absty. mk(R((@)(dest x))) = x)`, STRIP_TAC THEN SUBGOAL_THEN `!x y. (mk((R:Repty->Repty->bool) x):Absty = mk(R y)) <=> (R x = R y)` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC(TAUT `(a /\ b /\ c) /\ (b ==> a ==> d) ==> a /\ b /\ c /\ d`) THEN CONJ_TAC THENL [ASM_REWRITE_TAC[] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT(DISCH_THEN(fun th -> REWRITE_TAC[GSYM th])) THEN X_GEN_TAC `x:Repty` THEN SUBGOAL_THEN `dest(mk((R:Repty->Repty->bool) x):Absty) = R x` SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [th]) THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]) in fun tybij (refl_th,sym_th,trans_th) -> let tybij1 = GEN_ALL (fst tybij) and tybij2 = GEN_ALL (snd tybij) in let cth = end_itlist CONJ [refl_th; sym_th; trans_th; tybij1; tybij2] in let ith = MATCH_MP pth cth in fun trths -> REWRITE_RULE (ith::trths);; hol-light/real.ml000066400000000000000000001410741303454263000142310ustar00rootroot00000000000000(* ========================================================================= *) (* More basic properties of the reals. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Valentina Bruno 2010 *) (* ========================================================================= *) needs "realarith.ml";; (* ------------------------------------------------------------------------- *) (* Additional commutativity properties of the inclusion map. *) (* ------------------------------------------------------------------------- *) let REAL_OF_NUM_LT = prove (`!m n. &m < &n <=> m < n`, REWRITE_TAC[real_lt; GSYM NOT_LE; REAL_OF_NUM_LE]);; let REAL_OF_NUM_GE = prove (`!m n. &m >= &n <=> m >= n`, REWRITE_TAC[GE; real_ge; REAL_OF_NUM_LE]);; let REAL_OF_NUM_GT = prove (`!m n. &m > &n <=> m > n`, REWRITE_TAC[GT; real_gt; REAL_OF_NUM_LT]);; let REAL_OF_NUM_MAX = prove (`!m n. max (&m) (&n) = &(MAX m n)`, REWRITE_TAC[REAL_OF_NUM_LE; MAX; real_max; GSYM COND_RAND]);; let REAL_OF_NUM_MIN = prove (`!m n. min (&m) (&n) = &(MIN m n)`, REWRITE_TAC[REAL_OF_NUM_LE; MIN; real_min; GSYM COND_RAND]);; let REAL_OF_NUM_SUC = prove (`!n. &n + &1 = &(SUC n)`, REWRITE_TAC[ADD1; REAL_OF_NUM_ADD]);; let REAL_OF_NUM_SUB = prove (`!m n. m <= n ==> (&n - &m = &(n - m))`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN MESON_TAC[REAL_ADD_LINV; REAL_ADD_SYM; REAL_ADD_LID]);; let REAL_OF_NUM_SUB_CASES = prove (`!m n. &m - &n = if n <= m then &(m - n) else -- &(n - m)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_OF_NUM_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_NEG_SUB] THEN AP_TERM_TAC THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN ASM_MESON_TAC[LE_CASES]);; (* ------------------------------------------------------------------------- *) (* A few theorems we need to prove explicitly for later. *) (* ------------------------------------------------------------------------- *) let REAL_MUL_AC = prove (`(m * n = n * m) /\ ((m * n) * p = m * (n * p)) /\ (m * (n * p) = n * (m * p))`, REWRITE_TAC[REAL_MUL_ASSOC; EQT_INTRO(SPEC_ALL REAL_MUL_SYM)] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; let REAL_ADD_RDISTRIB = prove (`!x y z. (x + y) * z = x * z + y * z`, MESON_TAC[REAL_MUL_SYM; REAL_ADD_LDISTRIB]);; let REAL_LT_LADD_IMP = prove (`!x y z. y < z ==> x + y < x + z`, REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[real_lt] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_LADD_IMP) THEN DISCH_THEN(MP_TAC o SPEC `--x`) THEN REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]);; let REAL_LT_MUL = prove (`!x y. &0 < x /\ &0 < y ==> &0 < x * y`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Tactic version of REAL_ARITH. *) (* ------------------------------------------------------------------------- *) let REAL_ARITH_TAC = CONV_TAC REAL_ARITH;; (* ------------------------------------------------------------------------- *) (* Prove all the linear theorems we can blow away automatically. *) (* ------------------------------------------------------------------------- *) let REAL_EQ_ADD_LCANCEL_0 = prove (`!x y. (x + y = x) <=> (y = &0)`, REAL_ARITH_TAC);; let REAL_EQ_ADD_RCANCEL_0 = prove (`!x y. (x + y = y) <=> (x = &0)`, REAL_ARITH_TAC);; let REAL_LNEG_UNIQ = prove (`!x y. (x + y = &0) <=> (x = --y)`, REAL_ARITH_TAC);; let REAL_RNEG_UNIQ = prove (`!x y. (x + y = &0) <=> (y = --x)`, REAL_ARITH_TAC);; let REAL_NEG_LMUL = prove (`!x y. --(x * y) = (--x) * y`, REAL_ARITH_TAC);; let REAL_NEG_RMUL = prove (`!x y. --(x * y) = x * (--y)`, REAL_ARITH_TAC);; let REAL_NEGNEG = prove (`!x. --(--x) = x`, REAL_ARITH_TAC);; let REAL_NEG_MUL2 = prove (`!x y. (--x) * (--y) = x * y`, REAL_ARITH_TAC);; let REAL_LT_LADD = prove (`!x y z. (x + y) < (x + z) <=> y < z`, REAL_ARITH_TAC);; let REAL_LT_RADD = prove (`!x y z. (x + z) < (y + z) <=> x < y`, REAL_ARITH_TAC);; let REAL_LT_ANTISYM = prove (`!x y. ~(x < y /\ y < x)`, REAL_ARITH_TAC);; let REAL_LT_GT = prove (`!x y. x < y ==> ~(y < x)`, REAL_ARITH_TAC);; let REAL_NOT_EQ = prove (`!x y. ~(x = y) <=> x < y \/ y < x`, REAL_ARITH_TAC);; let REAL_NOT_LE = prove (`!x y. ~(x <= y) <=> y < x`, REAL_ARITH_TAC);; let REAL_LET_ANTISYM = prove (`!x y. ~(x <= y /\ y < x)`, REAL_ARITH_TAC);; let REAL_NEG_LT0 = prove (`!x. (--x) < &0 <=> &0 < x`, REAL_ARITH_TAC);; let REAL_NEG_GT0 = prove (`!x. &0 < (--x) <=> x < &0`, REAL_ARITH_TAC);; let REAL_NEG_LE0 = prove (`!x. (--x) <= &0 <=> &0 <= x`, REAL_ARITH_TAC);; let REAL_NEG_GE0 = prove (`!x. &0 <= (--x) <=> x <= &0`, REAL_ARITH_TAC);; let REAL_LT_TOTAL = prove (`!x y. (x = y) \/ x < y \/ y < x`, REAL_ARITH_TAC);; let REAL_LT_NEGTOTAL = prove (`!x. (x = &0) \/ (&0 < x) \/ (&0 < --x)`, REAL_ARITH_TAC);; let REAL_LE_01 = prove (`&0 <= &1`, REAL_ARITH_TAC);; let REAL_LT_01 = prove (`&0 < &1`, REAL_ARITH_TAC);; let REAL_LE_LADD = prove (`!x y z. (x + y) <= (x + z) <=> y <= z`, REAL_ARITH_TAC);; let REAL_LE_RADD = prove (`!x y z. (x + z) <= (y + z) <=> x <= y`, REAL_ARITH_TAC);; let REAL_LT_ADD2 = prove (`!w x y z. w < x /\ y < z ==> (w + y) < (x + z)`, REAL_ARITH_TAC);; let REAL_LE_ADD2 = prove (`!w x y z. w <= x /\ y <= z ==> (w + y) <= (x + z)`, REAL_ARITH_TAC);; let REAL_LT_LNEG = prove (`!x y. --x < y <=> &0 < x + y`, REWRITE_TAC[real_lt; REAL_LE_RNEG; REAL_ADD_AC]);; let REAL_LT_RNEG = prove (`!x y. x < --y <=> x + y < &0`, REWRITE_TAC[real_lt; REAL_LE_LNEG; REAL_ADD_AC]);; let REAL_LT_ADDNEG = prove (`!x y z. y < (x + (--z)) <=> (y + z) < x`, REAL_ARITH_TAC);; let REAL_LT_ADDNEG2 = prove (`!x y z. (x + (--y)) < z <=> x < (z + y)`, REAL_ARITH_TAC);; let REAL_LT_ADD1 = prove (`!x y. x <= y ==> x < (y + &1)`, REAL_ARITH_TAC);; let REAL_SUB_ADD = prove (`!x y. (x - y) + y = x`, REAL_ARITH_TAC);; let REAL_SUB_ADD2 = prove (`!x y. y + (x - y) = x`, REAL_ARITH_TAC);; let REAL_SUB_REFL = prove (`!x. x - x = &0`, REAL_ARITH_TAC);; let REAL_LE_DOUBLE = prove (`!x. &0 <= x + x <=> &0 <= x`, REAL_ARITH_TAC);; let REAL_LE_NEGL = prove (`!x. (--x <= x) <=> (&0 <= x)`, REAL_ARITH_TAC);; let REAL_LE_NEGR = prove (`!x. (x <= --x) <=> (x <= &0)`, REAL_ARITH_TAC);; let REAL_NEG_EQ_0 = prove (`!x. (--x = &0) <=> (x = &0)`, REAL_ARITH_TAC);; let REAL_ADD_SUB = prove (`!x y. (x + y) - x = y`, REAL_ARITH_TAC);; let REAL_NEG_EQ = prove (`!x y. (--x = y) <=> (x = --y)`, REAL_ARITH_TAC);; let REAL_NEG_MINUS1 = prove (`!x. --x = (--(&1)) * x`, REAL_ARITH_TAC);; let REAL_LT_IMP_NE = prove (`!x y. x < y ==> ~(x = y)`, REAL_ARITH_TAC);; let REAL_LE_ADDR = prove (`!x y. x <= x + y <=> &0 <= y`, REAL_ARITH_TAC);; let REAL_LE_ADDL = prove (`!x y. y <= x + y <=> &0 <= x`, REAL_ARITH_TAC);; let REAL_LT_ADDR = prove (`!x y. x < x + y <=> &0 < y`, REAL_ARITH_TAC);; let REAL_LT_ADDL = prove (`!x y. y < x + y <=> &0 < x`, REAL_ARITH_TAC);; let REAL_SUB_SUB = prove (`!x y. (x - y) - x = --y`, REAL_ARITH_TAC);; let REAL_LT_ADD_SUB = prove (`!x y z. (x + y) < z <=> x < (z - y)`, REAL_ARITH_TAC);; let REAL_LT_SUB_RADD = prove (`!x y z. (x - y) < z <=> x < z + y`, REAL_ARITH_TAC);; let REAL_LT_SUB_LADD = prove (`!x y z. x < (y - z) <=> (x + z) < y`, REAL_ARITH_TAC);; let REAL_LE_SUB_LADD = prove (`!x y z. x <= (y - z) <=> (x + z) <= y`, REAL_ARITH_TAC);; let REAL_LE_SUB_RADD = prove (`!x y z. (x - y) <= z <=> x <= z + y`, REAL_ARITH_TAC);; let REAL_LT_NEG = prove (`!x y. --x < --y <=> y < x`, REAL_ARITH_TAC);; let REAL_LE_NEG = prove (`!x y. --x <= --y <=> y <= x`, REAL_ARITH_TAC);; let REAL_ADD2_SUB2 = prove (`!a b c d. (a + b) - (c + d) = (a - c) + (b - d)`, REAL_ARITH_TAC);; let REAL_SUB_LZERO = prove (`!x. &0 - x = --x`, REAL_ARITH_TAC);; let REAL_SUB_RZERO = prove (`!x. x - &0 = x`, REAL_ARITH_TAC);; let REAL_LET_ADD2 = prove (`!w x y z. w <= x /\ y < z ==> (w + y) < (x + z)`, REAL_ARITH_TAC);; let REAL_LTE_ADD2 = prove (`!w x y z. w < x /\ y <= z ==> w + y < x + z`, REAL_ARITH_TAC);; let REAL_SUB_LNEG = prove (`!x y. (--x) - y = --(x + y)`, REAL_ARITH_TAC);; let REAL_SUB_RNEG = prove (`!x y. x - (--y) = x + y`, REAL_ARITH_TAC);; let REAL_SUB_NEG2 = prove (`!x y. (--x) - (--y) = y - x`, REAL_ARITH_TAC);; let REAL_SUB_TRIANGLE = prove (`!a b c. (a - b) + (b - c) = a - c`, REAL_ARITH_TAC);; let REAL_EQ_SUB_LADD = prove (`!x y z. (x = y - z) <=> (x + z = y)`, REAL_ARITH_TAC);; let REAL_EQ_SUB_RADD = prove (`!x y z. (x - y = z) <=> (x = z + y)`, REAL_ARITH_TAC);; let REAL_SUB_SUB2 = prove (`!x y. x - (x - y) = y`, REAL_ARITH_TAC);; let REAL_ADD_SUB2 = prove (`!x y. x - (x + y) = --y`, REAL_ARITH_TAC);; let REAL_EQ_IMP_LE = prove (`!x y. (x = y) ==> x <= y`, REAL_ARITH_TAC);; let REAL_POS_NZ = prove (`!x. &0 < x ==> ~(x = &0)`, REAL_ARITH_TAC);; let REAL_DIFFSQ = prove (`!x y. (x + y) * (x - y) = (x * x) - (y * y)`, REAL_ARITH_TAC);; let REAL_EQ_NEG2 = prove (`!x y. (--x = --y) <=> (x = y)`, REAL_ARITH_TAC);; let REAL_LT_NEG2 = prove (`!x y. --x < --y <=> y < x`, REAL_ARITH_TAC);; let REAL_SUB_LDISTRIB = prove (`!x y z. x * (y - z) = x * y - x * z`, REAL_ARITH_TAC);; let REAL_SUB_RDISTRIB = prove (`!x y z. (x - y) * z = x * z - y * z`, REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Theorems about "abs". *) (* ------------------------------------------------------------------------- *) let REAL_ABS_ZERO = prove (`!x. (abs(x) = &0) <=> (x = &0)`, REAL_ARITH_TAC);; let REAL_ABS_0 = prove (`abs(&0) = &0`, REAL_ARITH_TAC);; let REAL_ABS_1 = prove (`abs(&1) = &1`, REAL_ARITH_TAC);; let REAL_ABS_TRIANGLE = prove (`!x y. abs(x + y) <= abs(x) + abs(y)`, REAL_ARITH_TAC);; let REAL_ABS_TRIANGLE_LE = prove (`!x y z.abs(x) + abs(y - x) <= z ==> abs(y) <= z`, REAL_ARITH_TAC);; let REAL_ABS_TRIANGLE_LT = prove (`!x y z.abs(x) + abs(y - x) < z ==> abs(y) < z`, REAL_ARITH_TAC);; let REAL_ABS_POS = prove (`!x. &0 <= abs(x)`, REAL_ARITH_TAC);; let REAL_ABS_SUB = prove (`!x y. abs(x - y) = abs(y - x)`, REAL_ARITH_TAC);; let REAL_ABS_NZ = prove (`!x. ~(x = &0) <=> &0 < abs(x)`, REAL_ARITH_TAC);; let REAL_ABS_ABS = prove (`!x. abs(abs(x)) = abs(x)`, REAL_ARITH_TAC);; let REAL_ABS_LE = prove (`!x. x <= abs(x)`, REAL_ARITH_TAC);; let REAL_ABS_REFL = prove (`!x. (abs(x) = x) <=> &0 <= x`, REAL_ARITH_TAC);; let REAL_ABS_BETWEEN = prove (`!x y d. &0 < d /\ ((x - d) < y) /\ (y < (x + d)) <=> abs(y - x) < d`, REAL_ARITH_TAC);; let REAL_ABS_BOUND = prove (`!x y d. abs(x - y) < d ==> y < (x + d)`, REAL_ARITH_TAC);; let REAL_ABS_STILLNZ = prove (`!x y. abs(x - y) < abs(y) ==> ~(x = &0)`, REAL_ARITH_TAC);; let REAL_ABS_CASES = prove (`!x. (x = &0) \/ &0 < abs(x)`, REAL_ARITH_TAC);; let REAL_ABS_BETWEEN1 = prove (`!x y z. x < z /\ (abs(y - x)) < (z - x) ==> y < z`, REAL_ARITH_TAC);; let REAL_ABS_SIGN = prove (`!x y. abs(x - y) < y ==> &0 < x`, REAL_ARITH_TAC);; let REAL_ABS_SIGN2 = prove (`!x y. abs(x - y) < --y ==> x < &0`, REAL_ARITH_TAC);; let REAL_ABS_CIRCLE = prove (`!x y h. abs(h) < (abs(y) - abs(x)) ==> abs(x + h) < abs(y)`, REAL_ARITH_TAC);; let REAL_SUB_ABS = prove (`!x y. (abs(x) - abs(y)) <= abs(x - y)`, REAL_ARITH_TAC);; let REAL_ABS_SUB_ABS = prove (`!x y. abs(abs(x) - abs(y)) <= abs(x - y)`, REAL_ARITH_TAC);; let REAL_ABS_BETWEEN2 = prove (`!x0 x y0 y. x0 < y0 /\ &2 * abs(x - x0) < (y0 - x0) /\ &2 * abs(y - y0) < (y0 - x0) ==> x < y`, REAL_ARITH_TAC);; let REAL_ABS_BOUNDS = prove (`!x k. abs(x) <= k <=> --k <= x /\ x <= k`, REAL_ARITH_TAC);; let REAL_BOUNDS_LE = prove (`!x k. --k <= x /\ x <= k <=> abs(x) <= k`, REAL_ARITH_TAC);; let REAL_BOUNDS_LT = prove (`!x k. --k < x /\ x < k <=> abs(x) < k`, REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Theorems about max and min. *) (* ------------------------------------------------------------------------- *) let REAL_MIN_MAX = prove (`!x y. min x y = --(max (--x) (--y))`, REAL_ARITH_TAC);; let REAL_MAX_MIN = prove (`!x y. max x y = --(min (--x) (--y))`, REAL_ARITH_TAC);; let REAL_MAX_MAX = prove (`!x y. x <= max x y /\ y <= max x y`, REAL_ARITH_TAC);; let REAL_MIN_MIN = prove (`!x y. min x y <= x /\ min x y <= y`, REAL_ARITH_TAC);; let REAL_MAX_SYM = prove (`!x y. max x y = max y x`, REAL_ARITH_TAC);; let REAL_MIN_SYM = prove (`!x y. min x y = min y x`, REAL_ARITH_TAC);; let REAL_LE_MAX = prove (`!x y z. z <= max x y <=> z <= x \/ z <= y`, REAL_ARITH_TAC);; let REAL_LE_MIN = prove (`!x y z. z <= min x y <=> z <= x /\ z <= y`, REAL_ARITH_TAC);; let REAL_LT_MAX = prove (`!x y z. z < max x y <=> z < x \/ z < y`, REAL_ARITH_TAC);; let REAL_LT_MIN = prove (`!x y z. z < min x y <=> z < x /\ z < y`, REAL_ARITH_TAC);; let REAL_MAX_LE = prove (`!x y z. max x y <= z <=> x <= z /\ y <= z`, REAL_ARITH_TAC);; let REAL_MIN_LE = prove (`!x y z. min x y <= z <=> x <= z \/ y <= z`, REAL_ARITH_TAC);; let REAL_MAX_LT = prove (`!x y z. max x y < z <=> x < z /\ y < z`, REAL_ARITH_TAC);; let REAL_MIN_LT = prove (`!x y z. min x y < z <=> x < z \/ y < z`, REAL_ARITH_TAC);; let REAL_MAX_ASSOC = prove (`!x y z. max x (max y z) = max (max x y) z`, REAL_ARITH_TAC);; let REAL_MIN_ASSOC = prove (`!x y z. min x (min y z) = min (min x y) z`, REAL_ARITH_TAC);; let REAL_MAX_ACI = prove (`(max x y = max y x) /\ (max (max x y) z = max x (max y z)) /\ (max x (max y z) = max y (max x z)) /\ (max x x = x) /\ (max x (max x y) = max x y)`, REAL_ARITH_TAC);; let REAL_MIN_ACI = prove (`(min x y = min y x) /\ (min (min x y) z = min x (min y z)) /\ (min x (min y z) = min y (min x z)) /\ (min x x = x) /\ (min x (min x y) = min x y)`, REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* To simplify backchaining, just as in the natural number case. *) (* ------------------------------------------------------------------------- *) let REAL_LE_IMP = let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS in fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));; let REAL_LET_IMP = let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS in fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));; (* ------------------------------------------------------------------------- *) (* Now a bit of nonlinear stuff. *) (* ------------------------------------------------------------------------- *) let REAL_ABS_MUL = prove (`!x y. abs(x * y) = abs(x) * abs(y)`, REPEAT GEN_TAC THEN DISJ_CASES_TAC (SPEC `x:real` REAL_LE_NEGTOTAL) THENL [ALL_TAC; GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_ABS_NEG]] THEN (DISJ_CASES_TAC (SPEC `y:real` REAL_LE_NEGTOTAL) THENL [ALL_TAC; GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NEG]]) THEN ASSUM_LIST(MP_TAC o MATCH_MP REAL_LE_MUL o end_itlist CONJ o rev) THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN DISCH_TAC THENL [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ABS_NEG]; GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ABS_NEG]; ALL_TAC] THEN ASM_REWRITE_TAC[real_abs; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let REAL_POW_LE = prove (`!x n. &0 <= x ==> &0 <= x pow n`, REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_POS] THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]);; let REAL_POW_LT = prove (`!x n. &0 < x ==> &0 < x pow n`, REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_LT_01] THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]);; let REAL_ABS_POW = prove (`!x n. abs(x pow n) = abs(x) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_ABS_NUM; REAL_ABS_MUL]);; let REAL_LE_LMUL = prove (`!x y z. &0 <= x /\ y <= z ==> x * y <= x * z`, ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> &0 <= y - x`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_SUB_RZERO; REAL_LE_MUL]);; let REAL_LE_RMUL = prove (`!x y z. x <= y /\ &0 <= z ==> x * z <= y * z`, MESON_TAC[REAL_MUL_SYM; REAL_LE_LMUL]);; let REAL_LT_LMUL = prove (`!x y z. &0 < x /\ y < z ==> x * y < x * z`, ONCE_REWRITE_TAC[REAL_ARITH `x < y <=> &0 < y - x`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_SUB_RZERO; REAL_LT_MUL]);; let REAL_LT_RMUL = prove (`!x y z. x < y /\ &0 < z ==> x * z < y * z`, MESON_TAC[REAL_MUL_SYM; REAL_LT_LMUL]);; let REAL_EQ_MUL_LCANCEL = prove (`!x y z. (x * y = x * z) <=> (x = &0) \/ (y = z)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `(x = y) <=> (x - y = &0)`] THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ENTIRE; REAL_SUB_RZERO]);; let REAL_EQ_MUL_RCANCEL = prove (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = &0)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN MESON_TAC[]);; let REAL_MUL_LINV_UNIQ = prove (`!x y. (x * y = &1) ==> (inv(y) = x)`, REPEAT GEN_TAC THEN ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_OF_NUM_EQ; ARITH_EQ] THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP REAL_MUL_LINV) THEN ASM_REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN DISCH_THEN(ACCEPT_TAC o SYM));; let REAL_MUL_RINV_UNIQ = prove (`!x y. (x * y = &1) ==> (inv(x) = y)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_MUL_LINV_UNIQ);; let REAL_INV_INV = prove (`!x. inv(inv x) = x`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_INV_0] THEN MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]);; let REAL_EQ_INV2 = prove (`!x y. inv(x) = inv(y) <=> x = y`, MESON_TAC[REAL_INV_INV]);; let REAL_INV_EQ_0 = prove (`!x. inv(x) = &0 <=> x = &0`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_INV_0] THEN ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN ASM_REWRITE_TAC[REAL_INV_0]);; let REAL_LT_INV = prove (`!x. &0 < x ==> &0 < inv(x)`, GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `inv(x)` REAL_LT_NEGTOTAL) THEN ASM_REWRITE_TAC[] THENL [RULE_ASSUM_TAC(REWRITE_RULE[REAL_INV_EQ_0]) THEN ASM_REWRITE_TAC[]; DISCH_TAC THEN SUBGOAL_THEN `&0 < --(inv x) * x` MP_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_MUL_LNEG]]] THEN SUBGOAL_THEN `inv(x) * x = &1` SUBST1_TAC THENL [MATCH_MP_TAC REAL_MUL_LINV THEN UNDISCH_TAC `&0 < x` THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; REAL_OF_NUM_LT; ARITH]]);; let REAL_LT_INV_EQ = prove (`!x. &0 < inv x <=> &0 < x`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[REAL_LT_INV] THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_INV_INV] THEN REWRITE_TAC[REAL_LT_INV]);; let REAL_INV_NEG = prove (`!x. inv(--x) = --(inv x)`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_NEG_0; REAL_INV_0] THEN MATCH_MP_TAC REAL_MUL_LINV_UNIQ THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]);; let REAL_LE_INV_EQ = prove (`!x. &0 <= inv x <=> &0 <= x`, REWRITE_TAC[REAL_LE_LT; REAL_LT_INV_EQ; REAL_INV_EQ_0] THEN MESON_TAC[REAL_INV_EQ_0]);; let REAL_LE_INV = prove (`!x. &0 <= x ==> &0 <= inv(x)`, REWRITE_TAC[REAL_LE_INV_EQ]);; let REAL_MUL_RINV = prove (`!x. ~(x = &0) ==> (x * inv(x) = &1)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_LINV]);; let REAL_INV_1 = prove (`inv(&1) = &1`, MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN REWRITE_TAC[REAL_MUL_LID]);; let REAL_INV_EQ_1 = prove (`!x. inv(x) = &1 <=> x = &1`, MESON_TAC[REAL_INV_INV; REAL_INV_1]);; let REAL_DIV_1 = prove (`!x. x / &1 = x`, REWRITE_TAC[real_div; REAL_INV_1; REAL_MUL_RID]);; let REAL_DIV_REFL = prove (`!x. ~(x = &0) ==> (x / x = &1)`, GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_RINV]);; let REAL_DIV_RMUL = prove (`!x y. ~(y = &0) ==> ((x / y) * y = x)`, SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID]);; let REAL_DIV_LMUL = prove (`!x y. ~(y = &0) ==> (y * (x / y) = x)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_DIV_RMUL]);; let REAL_ABS_INV = prove (`!x. abs(inv x) = inv(abs x)`, GEN_TAC THEN CONV_TAC SYM_CONV THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_0] THEN MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN REWRITE_TAC[GSYM REAL_ABS_MUL] THEN POP_ASSUM(SUBST1_TAC o MATCH_MP REAL_MUL_RINV) THEN REWRITE_TAC[REAL_ABS_1]);; let REAL_ABS_DIV = prove (`!x y. abs(x / y) = abs(x) / abs(y)`, REWRITE_TAC[real_div; REAL_ABS_INV; REAL_ABS_MUL]);; let REAL_INV_MUL = prove (`!x y. inv(x * y) = inv(x) * inv(y)`, REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC [`x = &0`; `y = &0`] THEN ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN MATCH_MP_TAC REAL_MUL_LINV_UNIQ THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (a * c) * (b * d)`] THEN EVERY_ASSUM(SUBST1_TAC o MATCH_MP REAL_MUL_LINV) THEN REWRITE_TAC[REAL_MUL_LID]);; let REAL_INV_DIV = prove (`!x y. inv(x / y) = y / x`, REWRITE_TAC[real_div; REAL_INV_INV; REAL_INV_MUL] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; let REAL_POW_MUL = prove (`!x y n. (x * y) pow n = (x pow n) * (y pow n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_MUL_AC]);; let REAL_POW_INV = prove (`!x n. (inv x) pow n = inv(x pow n)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_INV_1; REAL_INV_MUL]);; let REAL_INV_POW = prove (`!x n. inv(x pow n) = (inv x) pow n`, REWRITE_TAC[REAL_POW_INV]);; let REAL_POW_DIV = prove (`!x y n. (x / y) pow n = (x pow n) / (y pow n)`, REWRITE_TAC[real_div; REAL_POW_MUL; REAL_POW_INV]);; let REAL_DIV_EQ_0 = prove (`!x y. x / y = &0 <=> x = &0 \/ y = &0`, REWRITE_TAC[real_div; REAL_INV_EQ_0; REAL_ENTIRE]);; let REAL_POW_ADD = prove (`!x m n. x pow (m + n) = x pow m * x pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_LID; REAL_MUL_ASSOC]);; let REAL_POW_NZ = prove (`!x n. ~(x = &0) ==> ~(x pow n = &0)`, GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_OF_NUM_EQ; ARITH] THEN ASM_MESON_TAC[REAL_ENTIRE]);; let REAL_POW_SUB = prove (`!x m n. ~(x = &0) /\ m <= n ==> (x pow (n - m) = x pow n / x pow m)`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[ADD_SUB2] THEN REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV THEN MATCH_MP_TAC REAL_POW_NZ THEN ASM_REWRITE_TAC[]);; let REAL_LT_IMP_NZ = prove (`!x. &0 < x ==> ~(x = &0)`, REAL_ARITH_TAC);; let REAL_LT_LCANCEL_IMP = prove (`!x y z. &0 < x /\ x * y < x * z ==> y < z`, REPEAT GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN DISCH_THEN (MP_TAC o uncurry CONJ o (MATCH_MP REAL_LT_INV F_F I) o CONJ_PAIR) THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_LMUL) THEN POP_ASSUM(ASSUME_TAC o MATCH_MP REAL_MUL_LINV o MATCH_MP REAL_LT_IMP_NZ) THEN ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID]);; let REAL_LT_RCANCEL_IMP = prove (`!x y z. &0 < z /\ x * z < y * z ==> x < y`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_LT_LCANCEL_IMP]);; let REAL_LE_LCANCEL_IMP = prove (`!x y z. &0 < x /\ x * y <= x * z ==> y <= z`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; REAL_EQ_MUL_LCANCEL] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]);; let REAL_LE_RCANCEL_IMP = prove (`!x y z. &0 < z /\ x * z <= y * z ==> x <= y`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_LE_LCANCEL_IMP]);; let REAL_LE_RMUL_EQ = prove (`!x y z. &0 < z ==> (x * z <= y * z <=> x <= y)`, MESON_TAC[REAL_LE_RMUL; REAL_LE_RCANCEL_IMP; REAL_LT_IMP_LE]);; let REAL_LE_LMUL_EQ = prove (`!x y z. &0 < z ==> (z * x <= z * y <=> x <= y)`, MESON_TAC[REAL_LE_RMUL_EQ; REAL_MUL_SYM]);; let REAL_LT_RMUL_EQ = prove (`!x y z. &0 < z ==> (x * z < y * z <=> x < y)`, SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_RMUL_EQ]);; let REAL_LT_LMUL_EQ = prove (`!x y z. &0 < z ==> (z * x < z * y <=> x < y)`, SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_LMUL_EQ]);; let REAL_LE_MUL_EQ = prove (`(!x y. &0 < x ==> (&0 <= x * y <=> &0 <= y)) /\ (!x y. &0 < y ==> (&0 <= x * y <=> &0 <= x))`, MESON_TAC[REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ; REAL_MUL_LZERO; REAL_MUL_RZERO]);; let REAL_LT_MUL_EQ = prove (`(!x y. &0 < x ==> (&0 < x * y <=> &0 < y)) /\ (!x y. &0 < y ==> (&0 < x * y <=> &0 < x))`, MESON_TAC[REAL_LT_LMUL_EQ; REAL_LT_RMUL_EQ; REAL_MUL_LZERO; REAL_MUL_RZERO]);; let REAL_MUL_POS_LT = prove (`!x y. &0 < x * y <=> &0 < x /\ &0 < y \/ x < &0 /\ y < &0`, REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC(SPEC `x:real` REAL_LT_NEGTOTAL) THEN STRIP_ASSUME_TAC(SPEC `y:real` REAL_LT_NEGTOTAL) THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL] THEN ASSUM_LIST(MP_TAC o MATCH_MP REAL_LT_MUL o end_itlist CONJ) THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);; let REAL_MUL_POS_LE = prove (`!x y. &0 <= x * y <=> x = &0 \/ y = &0 \/ &0 < x /\ &0 < y \/ x < &0 /\ y < &0`, REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN REWRITE_TAC[REAL_MUL_POS_LT; REAL_ENTIRE] THEN REAL_ARITH_TAC);; let REAL_LE_RDIV_EQ = prove (`!x y z. &0 < z ==> (x <= y / z <=> x * z <= y)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REAL_LE_RMUL_EQ th)]) THEN ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID; REAL_LT_IMP_NZ]);; let REAL_LE_LDIV_EQ = prove (`!x y z. &0 < z ==> (x / z <= y <=> x <= y * z)`, REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REAL_LE_RMUL_EQ th)]) THEN ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID; REAL_LT_IMP_NZ]);; let REAL_LT_RDIV_EQ = prove (`!x y z. &0 < z ==> (x < y / z <=> x * z < y)`, SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_LDIV_EQ]);; let REAL_LT_LDIV_EQ = prove (`!x y z. &0 < z ==> (x / z < y <=> x < y * z)`, SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_RDIV_EQ]);; let REAL_EQ_RDIV_EQ = prove (`!x y z. &0 < z ==> ((x = y / z) <=> (x * z = y))`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ]);; let REAL_EQ_LDIV_EQ = prove (`!x y z. &0 < z ==> ((x / z = y) <=> (x = y * z))`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ]);; let REAL_LT_DIV2_EQ = prove (`!x y z. &0 < z ==> (x / z < y / z <=> x < y)`, SIMP_TAC[real_div; REAL_LT_RMUL_EQ; REAL_LT_INV_EQ]);; let REAL_LE_DIV2_EQ = prove (`!x y z. &0 < z ==> (x / z <= y / z <=> x <= y)`, SIMP_TAC[real_div; REAL_LE_RMUL_EQ; REAL_LT_INV_EQ]);; let REAL_MUL_2 = prove (`!x. &2 * x = x + x`, REAL_ARITH_TAC);; let REAL_POW_EQ_0 = prove (`!x n. (x pow n = &0) <=> (x = &0) /\ ~(n = 0)`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC; real_pow; REAL_ENTIRE] THENL [REAL_ARITH_TAC; CONV_TAC TAUT]);; let REAL_LE_MUL2 = prove (`!w x y z. &0 <= w /\ w <= x /\ &0 <= y /\ y <= z ==> w * y <= x * z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `w * z` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; MATCH_MP_TAC REAL_LE_RMUL] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[]);; let REAL_LT_MUL2 = prove (`!w x y z. &0 <= w /\ w < x /\ &0 <= y /\ y < z ==> w * y < x * z`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `w * z` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; MATCH_MP_TAC REAL_LT_RMUL] THEN ASM_REWRITE_TAC[] THENL [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[]]);; let REAL_LT_SQUARE = prove (`!x. (&0 < x * x) <=> ~(x = &0)`, GEN_TAC THEN REWRITE_TAC[REAL_LT_LE; REAL_LE_SQUARE] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[REAL_ENTIRE]);; let REAL_POW_1 = prove (`!x. x pow 1 = x`, REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[real_pow; REAL_MUL_RID]);; let REAL_POW_ONE = prove (`!n. &1 pow n = &1`, INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]);; let REAL_LT_INV2 = prove (`!x y. &0 < x /\ x < y ==> inv(y) < inv(x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `x * y` THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; SUBGOAL_THEN `(inv x * x = &1) /\ (inv y * y = &1)` ASSUME_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RID]]]);; let REAL_LE_INV2 = prove (`!x y. &0 < x /\ x <= y ==> inv(y) <= inv(x)`, REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[]);; let REAL_LT_LINV = prove (`!x y. &0 < y /\ inv y < x ==> inv x < y`, REPEAT STRIP_TAC THEN MP_TAC (SPEC `y:real` REAL_LT_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (SPECL [`(inv y:real)`; `x:real`] REAL_LT_INV2) THEN ASM_REWRITE_TAC[REAL_INV_INV]);; let REAL_LT_RINV = prove (`!x y. &0 < x /\ x < inv y ==> y < inv x`, REPEAT STRIP_TAC THEN MP_TAC (SPEC `x:real` REAL_LT_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (SPECL [`x:real`; `inv y:real`] REAL_LT_INV2) THEN ASM_REWRITE_TAC[REAL_INV_INV]);; let REAL_LE_LINV = prove (`!x y. &0 < y /\ inv y <= x ==> inv x <= y`, REPEAT STRIP_TAC THEN MP_TAC (SPEC `y:real` REAL_LT_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (SPECL [`(inv y:real)`; `x:real`] REAL_LE_INV2) THEN ASM_REWRITE_TAC[REAL_INV_INV]);; let REAL_LE_RINV = prove (`!x y. &0 < x /\ x <= inv y ==> y <= inv x`, REPEAT STRIP_TAC THEN MP_TAC (SPEC `x:real` REAL_LT_INV) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (SPECL [`x:real`; `inv y:real`] REAL_LE_INV2) THEN ASM_REWRITE_TAC[REAL_INV_INV]);; let REAL_INV_LE_1 = prove (`!x. &1 <= x ==> inv(x) <= &1`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; let REAL_INV_1_LE = prove (`!x. &0 < x /\ x <= &1 ==> &1 <= inv(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; let REAL_INV_LT_1 = prove (`!x. &1 < x ==> inv(x) < &1`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; let REAL_INV_1_LT = prove (`!x. &0 < x /\ x < &1 ==> &1 < inv(x)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; let REAL_SUB_INV = prove (`!x y. ~(x = &0) /\ ~(y = &0) ==> (inv(x) - inv(y) = (y - x) / (x * y))`, REWRITE_TAC[real_div; REAL_SUB_RDISTRIB; REAL_INV_MUL] THEN SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN SIMP_TAC[REAL_DIV_LMUL]);; let REAL_DOWN = prove (`!d. &0 < d ==> ?e. &0 < e /\ e < d`, GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `d / &2` THEN ASSUME_TAC(REAL_ARITH `&0 < &2`) THEN ASSUME_TAC(MATCH_MP REAL_MUL_LINV (REAL_ARITH `~(&2 = &0)`)) THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&2` THEN ASM_REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC);; let REAL_DOWN2 = prove (`!d1 d2. &0 < d1 /\ &0 < d2 ==> ?e. &0 < e /\ e < d1 /\ e < d2`, REPEAT GEN_TAC THEN STRIP_TAC THEN DISJ_CASES_TAC(SPECL [`d1:real`; `d2:real`] REAL_LE_TOTAL) THENL [MP_TAC(SPEC `d1:real` REAL_DOWN); MP_TAC(SPEC `d2:real` REAL_DOWN)] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN EXISTS_TAC `e:real` THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC);; let REAL_POW_LE2 = prove (`!n x y. &0 <= x /\ x <= y ==> x pow n <= y pow n`, INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_LE_REFL] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; let REAL_POW_LE_1 = prove (`!n x. &1 <= x ==> &1 <= x pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `&1`; `x:real`] REAL_POW_LE2) THEN ASM_REWRITE_TAC[REAL_POW_ONE; REAL_POS]);; let REAL_POW_1_LE = prove (`!n x. &0 <= x /\ x <= &1 ==> x pow n <= &1`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `x:real`; `&1`] REAL_POW_LE2) THEN ASM_REWRITE_TAC[REAL_POW_ONE]);; let REAL_POW_MONO = prove (`!m n x. &1 <= x /\ m <= n ==> x pow m <= x pow n`, REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[REAL_POW_ADD] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN MATCH_MP_TAC REAL_POW_LE_1 THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_POW_LE_1 THEN ASM_REWRITE_TAC[]]);; let REAL_POW_LT2 = prove (`!n x y. ~(n = 0) /\ &0 <= x /\ x < y ==> x pow n < y pow n`, INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; real_pow] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; let REAL_POW_LT_1 = prove (`!n x. ~(n = 0) /\ &1 < x ==> &1 < x pow n`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `&1`; `x:real`] REAL_POW_LT2) THEN ASM_REWRITE_TAC[REAL_POW_ONE; REAL_POS]);; let REAL_POW_1_LT = prove (`!n x. ~(n = 0) /\ &0 <= x /\ x < &1 ==> x pow n < &1`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `x:real`; `&1`] REAL_POW_LT2) THEN ASM_REWRITE_TAC[REAL_POW_ONE]);; let REAL_POW_MONO_LT = prove (`!m n x. &1 < x /\ m < n ==> x pow m < x pow n`, REPEAT GEN_TAC THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN REWRITE_TAC[REAL_POW_ADD] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; ARITH]; SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[real_pow] THENL [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID]; ALL_TAC] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE; ARITH]]);; let REAL_POW_POW = prove (`!x m n. (x pow m) pow n = x pow (m * n)`, GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; MULT_CLAUSES; REAL_POW_ADD]);; let REAL_EQ_RCANCEL_IMP = prove (`!x y z. ~(z = &0) /\ (x * z = y * z) ==> (x = y)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN REWRITE_TAC[REAL_SUB_RZERO; GSYM REAL_SUB_RDISTRIB; REAL_ENTIRE] THEN CONV_TAC TAUT);; let REAL_EQ_LCANCEL_IMP = prove (`!x y z. ~(z = &0) /\ (z * x = z * y) ==> (x = y)`, ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_RCANCEL_IMP);; let REAL_LT_DIV = prove (`!x y. &0 < x /\ &0 < y ==> &0 < x / y`, SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; real_div]);; let REAL_LE_DIV = prove (`!x y. &0 <= x /\ &0 <= y ==> &0 <= x / y`, SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; real_div]);; let REAL_DIV_POW2 = prove (`!x m n. ~(x = &0) ==> (x pow m / x pow n = if n <= m then x pow (m - n) else inv(x pow (n - m)))`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[REAL_POW_SUB] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_INV_DIV] THEN UNDISCH_TAC `~(n:num <= m)` THEN REWRITE_TAC[NOT_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP LT_IMP_LE) THEN ASM_SIMP_TAC[REAL_POW_SUB]);; let REAL_DIV_POW2_ALT = prove (`!x m n. ~(x = &0) ==> (x pow m / x pow n = if n < m then x pow (m - n) else inv(x pow (n - m)))`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN ONCE_REWRITE_TAC[REAL_INV_DIV] THEN ASM_SIMP_TAC[GSYM NOT_LE; REAL_DIV_POW2] THEN ASM_CASES_TAC `m <= n:num` THEN ASM_REWRITE_TAC[REAL_INV_INV]);; let REAL_LT_POW2 = prove (`!n. &0 < &2 pow n`, SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH]);; let REAL_LE_POW2 = prove (`!n. &1 <= &2 pow n`, GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow 0` THEN SIMP_TAC[REAL_POW_MONO; LE_0; REAL_OF_NUM_LE; ARITH] THEN REWRITE_TAC[real_pow; REAL_LE_REFL]);; let REAL_POW2_ABS = prove (`!x. abs(x) pow 2 = x pow 2`, GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_NEG; ARITH_EVEN]);; let REAL_LE_SQUARE_ABS = prove (`!x y. abs(x) <= abs(y) <=> x pow 2 <= y pow 2`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MESON_TAC[REAL_POW_LE2; REAL_ABS_POS; NUM_EQ_CONV `2 = 0`; REAL_POW_LT2; REAL_NOT_LE]);; let REAL_LT_SQUARE_ABS = prove (`!x y. abs(x) < abs(y) <=> x pow 2 < y pow 2`, REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SQUARE_ABS]);; let REAL_EQ_SQUARE_ABS = prove (`!x y. abs x = abs y <=> x pow 2 = y pow 2`, REWRITE_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_SQUARE_ABS]);; let REAL_LE_POW_2 = prove (`!x. &0 <= x pow 2`, REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; let REAL_LT_POW_2 = prove (`!x. &0 < x pow 2 <=> ~(x = &0)`, REWRITE_TAC[REAL_LE_POW_2; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN REWRITE_TAC[REAL_POW_EQ_0; ARITH]);; let REAL_SOS_EQ_0 = prove (`!x y. x pow 2 + y pow 2 = &0 <=> x = &0 /\ y = &0`, REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_LID] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x + y = &0 ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]);; let REAL_POW_ZERO = prove (`!n. &0 pow n = if n = 0 then &1 else &0`, INDUCT_TAC THEN REWRITE_TAC[real_pow; NOT_SUC; REAL_MUL_LZERO]);; let REAL_POW_MONO_INV = prove (`!m n x. &0 <= x /\ x <= &1 /\ n <= m ==> x pow m <= x pow n`, REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[REAL_POW_ZERO] THEN REPEAT(COND_CASES_TAC THEN REWRITE_TAC[REAL_POS; REAL_LE_REFL]) THEN UNDISCH_TAC `n:num <= m` THEN ASM_REWRITE_TAC[LE]; GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[GSYM REAL_POW_INV] THEN CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[REAL_LT_INV_EQ]; MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_1_LE] THEN ASM_REWRITE_TAC[REAL_LT_LE]]);; let REAL_POW_LE2_REV = prove (`!n x y. ~(n = 0) /\ &0 <= y /\ x pow n <= y pow n ==> x <= y`, MESON_TAC[REAL_POW_LT2; REAL_NOT_LE]);; let REAL_POW_LT2_REV = prove (`!n x y. &0 <= y /\ x pow n < y pow n ==> x < y`, MESON_TAC[REAL_POW_LE2; REAL_NOT_LE]);; let REAL_POW_EQ = prove (`!n x y. ~(n = 0) /\ &0 <= x /\ &0 <= y /\ x pow n = y pow n ==> x = y`, REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[REAL_POW_LE2_REV]);; let REAL_POW_EQ_ABS = prove (`!n x y. ~(n = 0) /\ x pow n = y pow n ==> abs x = abs y`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[REAL_ABS_POS; GSYM REAL_ABS_POW]);; let REAL_POW_EQ_1_IMP = prove (`!x n. ~(n = 0) /\ x pow n = &1 ==> abs(x) = &1`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ABS_NUM] THEN MATCH_MP_TAC REAL_POW_EQ_ABS THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[REAL_POW_ONE]);; let REAL_POW_EQ_1 = prove (`!x n. x pow n = &1 <=> abs(x) = &1 /\ (x < &0 ==> EVEN(n)) \/ n = 0`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[real_pow] THEN ASM_CASES_TAC `abs(x) = &1` THENL [ALL_TAC; ASM_MESON_TAC[REAL_POW_EQ_1_IMP]] THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH `abs x = a ==> x = a \/ x = --a`)) THEN ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_POW_LT2_ODD = prove (`!n x y. x < y /\ ODD n ==> x pow n < y pow n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN STRIP_TAC THEN DISJ_CASES_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THENL [DISJ_CASES_TAC(REAL_ARITH `&0 <= x \/ &0 < --x`) THEN ASM_SIMP_TAC[REAL_POW_LT2] THEN SUBGOAL_THEN `&0 < --x pow n /\ &0 <= y pow n` MP_TAC THENL [ASM_SIMP_TAC[REAL_POW_LE; REAL_POW_LT]; ASM_REWRITE_TAC[REAL_POW_NEG; GSYM NOT_ODD] THEN REAL_ARITH_TAC]; SUBGOAL_THEN `--y pow n < --x pow n` MP_TAC THENL [MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[REAL_POW_NEG; GSYM NOT_ODD]] THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC]);; let REAL_POW_LE2_ODD = prove (`!n x y. x <= y /\ ODD n ==> x pow n <= y pow n`, REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_POW_LT2_ODD]);; let REAL_POW_LT2_ODD_EQ = prove (`!n x y. ODD n ==> (x pow n < y pow n <=> x < y)`, MESON_TAC[REAL_POW_LT2_ODD; REAL_POW_LE2_ODD; REAL_NOT_LE]);; let REAL_POW_LE2_ODD_EQ = prove (`!n x y. ODD n ==> (x pow n <= y pow n <=> x <= y)`, MESON_TAC[REAL_POW_LT2_ODD; REAL_POW_LE2_ODD; REAL_NOT_LE]);; let REAL_POW_EQ_ODD_EQ = prove (`!n x y. ODD n ==> (x pow n = y pow n <=> x = y)`, SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_POW_LE2_ODD_EQ]);; let REAL_POW_EQ_ODD = prove (`!n x y. ODD n /\ x pow n = y pow n ==> x = y`, MESON_TAC[REAL_POW_EQ_ODD_EQ]);; let REAL_POW_EQ_EQ = prove (`!n x y. x pow n = y pow n <=> if EVEN n then n = 0 \/ abs x = abs y else x = y`, REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[real_pow; ARITH] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POW_EQ_ODD_EQ; GSYM NOT_EVEN] THEN EQ_TAC THENL [ASM_MESON_TAC[REAL_POW_EQ_ABS]; ALL_TAC] THEN REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN DISCH_TAC THEN FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` SUBST1_TAC o REWRITE_RULE[EVEN_EXISTS]) THEN ASM_REWRITE_TAC[GSYM REAL_POW_POW]);; (* ------------------------------------------------------------------------- *) (* Some basic forms of the Archimedian property. *) (* ------------------------------------------------------------------------- *) let REAL_ARCH_SIMPLE = prove (`!x. ?n. x <= &n`, let lemma = prove(`(!x. (?n. x = &n) ==> P x) <=> !n. P(&n)`,MESON_TAC[]) in MP_TAC(SPEC `\y. ?n. y = &n` REAL_COMPLETE) THEN REWRITE_TAC[lemma] THEN MESON_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_LE_TOTAL; REAL_ARITH `~(M <= M - &1)`]);; let REAL_ARCH_LT = prove (`!x. ?n. x < &n`, MESON_TAC[REAL_ARCH_SIMPLE; REAL_OF_NUM_ADD; REAL_ARITH `x <= n ==> x < n + &1`]);; let REAL_ARCH = prove (`!x. &0 < x ==> !y. ?n. y < &n * x`, MESON_TAC[REAL_ARCH_LT; REAL_LT_LDIV_EQ]);; (* ------------------------------------------------------------------------- *) (* The sign of a real number, as a real number. *) (* ------------------------------------------------------------------------- *) let real_sgn = new_definition `(real_sgn:real->real) x = if &0 < x then &1 else if x < &0 then -- &1 else &0`;; let REAL_SGN_0 = prove (`real_sgn(&0) = &0`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGN_NEG = prove (`!x. real_sgn(--x) = --(real_sgn x)`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGN_ABS = prove (`!x. real_sgn(x) * abs(x) = x`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGN_ABS_ALT = prove (`!x. real_sgn x * x = abs x`, GEN_TAC THEN REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_EQ_SGN_ABS = prove (`!x y:real. x = y <=> real_sgn x = real_sgn y /\ abs x = abs y`, MESON_TAC[REAL_SGN_ABS]);; let REAL_ABS_SGN = prove (`!x. abs(real_sgn x) = real_sgn(abs x)`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGN = prove (`!x. real_sgn x = x / abs x`, GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_SGN_0]; GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_SGN_ABS] THEN ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_ABS_ZERO; REAL_MUL_RINV; REAL_MUL_RID]]);; let REAL_SGN_MUL = prove (`!x y. real_sgn(x * y) = real_sgn(x) * real_sgn(y)`, REWRITE_TAC[REAL_SGN; REAL_ABS_MUL; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC);; let REAL_SGN_INV = prove (`!x. real_sgn(inv x) = real_sgn x`, REWRITE_TAC[real_sgn; REAL_LT_INV_EQ; GSYM REAL_INV_NEG; REAL_ARITH `x < &0 <=> &0 < --x`]);; let REAL_SGN_DIV = prove (`!x y. real_sgn(x / y) = real_sgn(x) / real_sgn(y)`, REWRITE_TAC[REAL_SGN; REAL_ABS_DIV] THEN REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REAL_ARITH_TAC);; let REAL_SGN_EQ = prove (`(!x. real_sgn x = &0 <=> x = &0) /\ (!x. real_sgn x = &1 <=> x > &0) /\ (!x. real_sgn x = -- &1 <=> x < &0)`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGN_CASES = prove (`!x. real_sgn x = &0 \/ real_sgn x = &1 \/ real_sgn x = -- &1`, REWRITE_TAC[real_sgn] THEN MESON_TAC[]);; let REAL_SGN_INEQS = prove (`(!x. &0 <= real_sgn x <=> &0 <= x) /\ (!x. &0 < real_sgn x <=> &0 < x) /\ (!x. &0 >= real_sgn x <=> &0 >= x) /\ (!x. &0 > real_sgn x <=> &0 > x) /\ (!x. &0 = real_sgn x <=> &0 = x) /\ (!x. real_sgn x <= &0 <=> x <= &0) /\ (!x. real_sgn x < &0 <=> x < &0) /\ (!x. real_sgn x >= &0 <=> x >= &0) /\ (!x. real_sgn x > &0 <=> x > &0) /\ (!x. real_sgn x = &0 <=> x = &0)`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGN_POW = prove (`!x n. real_sgn(x pow n) = real_sgn(x) pow n`, GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_SGN_MUL; real_pow] THEN REWRITE_TAC[real_sgn; REAL_LT_01]);; let REAL_SGN_POW_2 = prove (`!x. real_sgn(x pow 2) = real_sgn(abs x)`, REWRITE_TAC[real_sgn] THEN SIMP_TAC[GSYM REAL_NOT_LE; REAL_ABS_POS; REAL_LE_POW_2; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN REWRITE_TAC[REAL_POW_EQ_0; REAL_ABS_ZERO; ARITH]);; let REAL_SGN_REAL_SGN = prove (`!x. real_sgn(real_sgn x) = real_sgn x`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_INV_SGN = prove (`!x. real_inv(real_sgn x) = real_sgn x`, GEN_TAC THEN REWRITE_TAC[real_sgn] THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_INV_0; REAL_INV_1; REAL_INV_NEG]);; let REAL_SGN_EQ_INEQ = prove (`!x y. real_sgn x = real_sgn y <=> x = y \/ abs(x - y) < max (abs x) (abs y)`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGNS_EQ = prove (`!x y. real_sgn x = real_sgn y <=> (x = &0 <=> y = &0) /\ (x > &0 <=> y > &0) /\ (x < &0 <=> y < &0)`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; let REAL_SGNS_EQ_ALT = prove (`!x y. real_sgn x = real_sgn y <=> (x = &0 ==> y = &0) /\ (x > &0 ==> y > &0) /\ (x < &0 ==> y < &0)`, REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Useful "without loss of generality" lemmas. *) (* ------------------------------------------------------------------------- *) let REAL_WLOG_LE = prove (`(!x y. P x y <=> P y x) /\ (!x y. x <= y ==> P x y) ==> !x y. P x y`, MESON_TAC[REAL_LE_TOTAL]);; let REAL_WLOG_LT = prove (`(!x. P x x) /\ (!x y. P x y <=> P y x) /\ (!x y. x < y ==> P x y) ==> !x y. P x y`, MESON_TAC[REAL_LT_TOTAL]);; hol-light/realarith.ml000066400000000000000000000630721303454263000152620ustar00rootroot00000000000000(* ========================================================================= *) (* Framework for universal real decision procedures, and a simple instance. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "calc_int.ml";; (* ------------------------------------------------------------------------- *) (* Some lemmas needed now just to drive the decision procedure. *) (* ------------------------------------------------------------------------- *) let REAL_LTE_TOTAL = prove (`!x y. x < y \/ y <= x`, REWRITE_TAC[real_lt] THEN CONV_TAC TAUT);; let REAL_LET_TOTAL = prove (`!x y. x <= y \/ y < x`, REWRITE_TAC[real_lt] THEN CONV_TAC TAUT);; let REAL_LT_IMP_LE = prove (`!x y. x < y ==> x <= y`, MESON_TAC[real_lt; REAL_LE_TOTAL]);; let REAL_LTE_TRANS = prove (`!x y z. x < y /\ y <= z ==> x < z`, MESON_TAC[real_lt; REAL_LE_TRANS]);; let REAL_LET_TRANS = prove (`!x y z. x <= y /\ y < z ==> x < z`, MESON_TAC[real_lt; REAL_LE_TRANS]);; let REAL_LT_TRANS = prove (`!x y z. x < y /\ y < z ==> x < z`, MESON_TAC[REAL_LTE_TRANS; REAL_LT_IMP_LE]);; let REAL_LE_ADD = prove (`!x y. &0 <= x /\ &0 <= y ==> &0 <= x + y`, MESON_TAC[REAL_LE_LADD_IMP; REAL_ADD_RID; REAL_LE_TRANS]);; let REAL_LTE_ANTISYM = prove (`!x y. ~(x < y /\ y <= x)`, MESON_TAC[real_lt]);; let REAL_SUB_LE = prove (`!x y. &0 <= (x - y) <=> y <= x`, REWRITE_TAC[real_sub; GSYM REAL_LE_LNEG; REAL_LE_NEG2]);; let REAL_NEG_SUB = prove (`!x y. --(x - y) = y - x`, REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEG_NEG] THEN REWRITE_TAC[REAL_ADD_AC]);; let REAL_LE_LT = prove (`!x y. x <= y <=> x < y \/ (x = y)`, REWRITE_TAC[real_lt] THEN MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TOTAL]);; let REAL_SUB_LT = prove (`!x y. &0 < (x - y) <=> y < x`, REWRITE_TAC[real_lt] THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN REWRITE_TAC[REAL_LE_LNEG; REAL_ADD_RID; REAL_SUB_LE]);; let REAL_NOT_LT = prove (`!x y. ~(x < y) <=> y <= x`, REWRITE_TAC[real_lt]);; let REAL_SUB_0 = prove (`!x y. (x - y = &0) <=> (x = y)`, REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_NOT_LT] THEN REWRITE_TAC[REAL_SUB_LE; REAL_SUB_LT] THEN REWRITE_TAC[REAL_NOT_LT]);; let REAL_LT_LE = prove (`!x y. x < y <=> x <= y /\ ~(x = y)`, MESON_TAC[real_lt; REAL_LE_TOTAL; REAL_LE_ANTISYM]);; let REAL_LT_REFL = prove (`!x. ~(x < x)`, REWRITE_TAC[real_lt; REAL_LE_REFL]);; let REAL_LTE_ADD = prove (`!x y. &0 < x /\ &0 <= y ==> &0 < x + y`, MESON_TAC[REAL_LE_LADD_IMP; REAL_ADD_RID; REAL_LTE_TRANS]);; let REAL_LET_ADD = prove (`!x y. &0 <= x /\ &0 < y ==> &0 < x + y`, MESON_TAC[REAL_LTE_ADD; REAL_ADD_SYM]);; let REAL_LT_ADD = prove (`!x y. &0 < x /\ &0 < y ==> &0 < x + y`, MESON_TAC[REAL_LT_IMP_LE; REAL_LTE_ADD]);; let REAL_ENTIRE = prove (`!x y. (x * y = &0) <=> (x = &0) \/ (y = &0)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o AP_TERM `(*) (inv x)`) THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RZERO]);; let REAL_LE_NEGTOTAL = prove (`!x. &0 <= x \/ &0 <= --x`, REWRITE_TAC[REAL_LE_RNEG; REAL_ADD_LID; REAL_LE_TOTAL]);; let REAL_LE_SQUARE = prove (`!x. &0 <= x * x`, GEN_TAC THEN DISJ_CASES_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN POP_ASSUM(fun th -> MP_TAC(MATCH_MP REAL_LE_MUL (CONJ th th))) THEN REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; let REAL_MUL_RID = prove (`!x. x * &1 = x`, MESON_TAC[REAL_MUL_LID; REAL_MUL_SYM]);; let REAL_POW_2 = prove (`!x. x pow 2 = x * x`, REWRITE_TAC[num_CONV `2`; num_CONV `1`] THEN REWRITE_TAC[real_pow; REAL_MUL_RID]);; let REAL_POLY_CLAUSES = prove (`(!x y z. x + (y + z) = (x + y) + z) /\ (!x y. x + y = y + x) /\ (!x. &0 + x = x) /\ (!x y z. x * (y * z) = (x * y) * z) /\ (!x y. x * y = y * x) /\ (!x. &1 * x = x) /\ (!x. &0 * x = &0) /\ (!x y z. x * (y + z) = x * y + x * z) /\ (!x. x pow 0 = &1) /\ (!x n. x pow (SUC n) = x * x pow n)`, REWRITE_TAC[real_pow; REAL_ADD_LDISTRIB; REAL_MUL_LZERO] THEN REWRITE_TAC[REAL_MUL_ASSOC; REAL_ADD_LID; REAL_MUL_LID] THEN REWRITE_TAC[REAL_ADD_AC] THEN REWRITE_TAC[REAL_MUL_SYM]);; let REAL_POLY_NEG_CLAUSES = prove (`(!x. --x = --(&1) * x) /\ (!x y. x - y = x + --(&1) * y)`, REWRITE_TAC[REAL_MUL_LNEG; real_sub; REAL_MUL_LID]);; let REAL_POS = prove (`!n. &0 <= &n`, REWRITE_TAC[REAL_OF_NUM_LE; LE_0]);; (* ------------------------------------------------------------------------- *) (* Data structure for Positivstellensatz refutations. *) (* ------------------------------------------------------------------------- *) type positivstellensatz = Axiom_eq of int | Axiom_le of int | Axiom_lt of int | Rational_eq of num | Rational_le of num | Rational_lt of num | Square of term | Eqmul of term * positivstellensatz | Sum of positivstellensatz * positivstellensatz | Product of positivstellensatz * positivstellensatz;; (* ------------------------------------------------------------------------- *) (* Parametrized reals decision procedure. *) (* *) (* This is a bootstrapping version, and subsequently gets overwritten twice *) (* with more specialized versions, once here and finally in "calc_rat.ml". *) (* ------------------------------------------------------------------------- *) let GEN_REAL_ARITH = let pth = prove (`(x < y <=> y - x > &0) /\ (x <= y <=> y - x >= &0) /\ (x > y <=> x - y > &0) /\ (x >= y <=> x - y >= &0) /\ ((x = y) <=> (x - y = &0)) /\ (~(x < y) <=> x - y >= &0) /\ (~(x <= y) <=> x - y > &0) /\ (~(x > y) <=> y - x >= &0) /\ (~(x >= y) <=> y - x > &0) /\ (~(x = y) <=> x - y > &0 \/ --(x - y) > &0)`, REWRITE_TAC[real_gt; real_ge; REAL_SUB_LT; REAL_SUB_LE; REAL_NEG_SUB] THEN REWRITE_TAC[REAL_SUB_0; real_lt] THEN MESON_TAC[REAL_LE_ANTISYM]) and pth_final = TAUT `(~p ==> F) ==> p` and pth_add = prove (`((x = &0) /\ (y = &0) ==> (x + y = &0)) /\ ((x = &0) /\ y >= &0 ==> x + y >= &0) /\ ((x = &0) /\ y > &0 ==> x + y > &0) /\ (x >= &0 /\ (y = &0) ==> x + y >= &0) /\ (x >= &0 /\ y >= &0 ==> x + y >= &0) /\ (x >= &0 /\ y > &0 ==> x + y > &0) /\ (x > &0 /\ (y = &0) ==> x + y > &0) /\ (x > &0 /\ y >= &0 ==> x + y > &0) /\ (x > &0 /\ y > &0 ==> x + y > &0)`, SIMP_TAC[REAL_ADD_LID; REAL_ADD_RID; real_ge; real_gt] THEN REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_LT_ADD]) and pth_mul = prove (`((x = &0) /\ (y = &0) ==> (x * y = &0)) /\ ((x = &0) /\ y >= &0 ==> (x * y = &0)) /\ ((x = &0) /\ y > &0 ==> (x * y = &0)) /\ (x >= &0 /\ (y = &0) ==> (x * y = &0)) /\ (x >= &0 /\ y >= &0 ==> x * y >= &0) /\ (x >= &0 /\ y > &0 ==> x * y >= &0) /\ (x > &0 /\ (y = &0) ==> (x * y = &0)) /\ (x > &0 /\ y >= &0 ==> x * y >= &0) /\ (x > &0 /\ y > &0 ==> x * y > &0)`, SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; real_ge; real_gt] THEN SIMP_TAC[REAL_LT_LE; REAL_LE_MUL] THEN MESON_TAC[REAL_ENTIRE]) and pth_emul = prove (`(y = &0) ==> !x. x * y = &0`, SIMP_TAC[REAL_MUL_RZERO]) and pth_square = prove (`!x. x * x >= &0`, REWRITE_TAC[real_ge; REAL_POW_2; REAL_LE_SQUARE]) and MATCH_MP_RULE th = let net = itlist (fun th -> net_of_conv (lhand(concl th)) (PART_MATCH lhand th)) (CONJUNCTS th) empty_net in fun th -> MP (REWRITES_CONV net (concl th)) th and x_tm = `x:real` and y_tm = `y:real` and neg_tm = `(--):real->real` and gt_tm = `(>):real->real->bool` and ge_tm = `(>=):real->real->bool` and eq_tm = `(=):real->real->bool` and p_tm = `p:bool` and or_tm = `(\/)` and false_tm = `F` and z_tm = `&0 :real` and xy_lt = `(x:real) < y` and xy_nlt = `~((x:real) < y)` and xy_le = `(x:real) <= y` and xy_nle = `~((x:real) <= y)` and xy_gt = `(x:real) > y` and xy_ngt = `~((x:real) > y)` and xy_ge = `(x:real) >= y` and xy_nge = `~((x:real) >= y)` and xy_eq = `x:real = y` and xy_ne = `~(x:real = y)` in let is_ge = is_binop ge_tm and is_gt = is_binop gt_tm and is_req = is_binop eq_tm in fun (mk_numeric, NUMERIC_EQ_CONV,NUMERIC_GE_CONV,NUMERIC_GT_CONV, POLY_CONV,POLY_NEG_CONV,POLY_ADD_CONV,POLY_MUL_CONV, absconv1,absconv2,prover) -> let REAL_INEQ_CONV pth tm = let lop,r = dest_comb tm in let th = INST [rand lop,x_tm; r,y_tm] pth in TRANS th (LAND_CONV POLY_CONV (rand(concl th))) in let [REAL_LT_CONV; REAL_LE_CONV; REAL_GT_CONV; REAL_GE_CONV; REAL_EQ_CONV; REAL_NOT_LT_CONV; REAL_NOT_LE_CONV; REAL_NOT_GT_CONV; REAL_NOT_GE_CONV; _] = map REAL_INEQ_CONV (CONJUNCTS pth) and REAL_NOT_EQ_CONV = let pth = last(CONJUNCTS pth) in fun tm -> let l,r = dest_eq tm in let th = INST [l,x_tm; r,y_tm] pth in let th_p = POLY_CONV(lhand(lhand(rand(concl th)))) in let th_x = AP_TERM neg_tm th_p in let th_n = CONV_RULE (RAND_CONV POLY_NEG_CONV) th_x in let th' = MK_DISJ (AP_THM (AP_TERM gt_tm th_p) z_tm) (AP_THM (AP_TERM gt_tm th_n) z_tm) in TRANS th th' in let net_single = itlist (uncurry net_of_conv) [xy_lt,REAL_LT_CONV; xy_nlt,(fun t -> REAL_NOT_LT_CONV(rand t)); xy_le,REAL_LE_CONV; xy_nle,(fun t -> REAL_NOT_LE_CONV(rand t)); xy_gt,REAL_GT_CONV; xy_ngt,(fun t -> REAL_NOT_GT_CONV(rand t)); xy_ge,REAL_GE_CONV; xy_nge,(fun t -> REAL_NOT_GE_CONV(rand t)); xy_eq,REAL_EQ_CONV; xy_ne,(fun t -> REAL_NOT_EQ_CONV(rand t))] empty_net and net_double = itlist (uncurry net_of_conv) [xy_lt,(fun t -> REAL_LT_CONV t,REAL_NOT_LT_CONV t); xy_le,(fun t -> REAL_LE_CONV t,REAL_NOT_LE_CONV t); xy_gt,(fun t -> REAL_GT_CONV t,REAL_NOT_GT_CONV t); xy_ge,(fun t -> REAL_GE_CONV t,REAL_NOT_GE_CONV t); xy_eq,(fun t -> REAL_EQ_CONV t,REAL_NOT_EQ_CONV t)] empty_net in let REAL_INEQ_NORM_CONV = REWRITES_CONV net_single and REAL_INEQ_NORM_DCONV = REWRITES_CONV net_double in let NNF_NORM_CONV = GEN_NNF_CONV false (REAL_INEQ_NORM_CONV,REAL_INEQ_NORM_DCONV) in let MUL_RULE = let rules = MATCH_MP_RULE pth_mul in fun th -> CONV_RULE(LAND_CONV POLY_MUL_CONV) (rules th) and ADD_RULE = let rules = MATCH_MP_RULE pth_add in fun th -> CONV_RULE(LAND_CONV POLY_ADD_CONV) (rules th) and EMUL_RULE = let rule = MATCH_MP pth_emul in fun tm th -> CONV_RULE (LAND_CONV POLY_MUL_CONV) (SPEC tm (rule th)) and SQUARE_RULE t = CONV_RULE (LAND_CONV POLY_MUL_CONV) (SPEC t pth_square) in let hol_of_positivstellensatz(eqs,les,lts) = let rec translate prf = match prf with Axiom_eq n -> el n eqs | Axiom_le n -> el n les | Axiom_lt n -> el n lts | Rational_eq x -> EQT_ELIM(NUMERIC_EQ_CONV(mk_comb(mk_comb(eq_tm,mk_numeric x),z_tm))) | Rational_le x -> EQT_ELIM(NUMERIC_GE_CONV(mk_comb(mk_comb(ge_tm,mk_numeric x),z_tm))) | Rational_lt x -> EQT_ELIM(NUMERIC_GT_CONV(mk_comb(mk_comb(gt_tm,mk_numeric x),z_tm))) | Square t -> SQUARE_RULE t | Eqmul(t,p) -> EMUL_RULE t (translate p) | Sum(p1,p2) -> ADD_RULE (CONJ (translate p1) (translate p2)) | Product(p1,p2) -> MUL_RULE (CONJ (translate p1) (translate p2)) in fun prf -> CONV_RULE(FIRST_CONV[NUMERIC_GE_CONV; NUMERIC_GT_CONV; NUMERIC_EQ_CONV]) (translate prf) in let init_conv = TOP_DEPTH_CONV BETA_CONV THENC PRESIMP_CONV THENC NNF_CONV THENC DEPTH_BINOP_CONV or_tm CONDS_ELIM_CONV THENC NNF_NORM_CONV THENC SKOLEM_CONV THENC PRENEX_CONV THENC WEAK_DNF_CONV in let rec overall dun ths = match ths with [] -> let eq,ne = partition (is_req o concl) dun in let le,nl = partition (is_ge o concl) ne in let lt = filter (is_gt o concl) nl in prover hol_of_positivstellensatz (eq,le,lt) | th::oths -> let tm = concl th in if is_conj tm then let th1,th2 = CONJ_PAIR th in overall dun (th1::th2::oths) else if is_disj tm then let th1 = overall dun (ASSUME (lhand tm)::oths) and th2 = overall dun (ASSUME (rand tm)::oths) in DISJ_CASES th th1 th2 else overall (th::dun) oths in fun tm -> let NNF_NORM_CONV' = GEN_NNF_CONV false (CACHE_CONV REAL_INEQ_NORM_CONV,fun t -> failwith "") in let rec absremover t = (TOP_DEPTH_CONV(absconv1 THENC BINOP_CONV (LAND_CONV POLY_CONV)) THENC TRY_CONV(absconv2 THENC NNF_NORM_CONV' THENC BINOP_CONV absremover)) t in let th0 = init_conv(mk_neg tm) in let tm0 = rand(concl th0) in let th = if tm0 = false_tm then fst(EQ_IMP_RULE th0) else let evs,bod = strip_exists tm0 in let avs,ibod = strip_forall bod in let th1 = itlist MK_FORALL avs (DEPTH_BINOP_CONV or_tm absremover ibod) in let th2 = overall [] [SPECL avs (ASSUME(rand(concl th1)))] in let th3 = itlist SIMPLE_CHOOSE evs (PROVE_HYP (EQ_MP th1 (ASSUME bod)) th2) in DISCH_ALL(PROVE_HYP (EQ_MP th0 (ASSUME (mk_neg tm))) th3) in MP (INST [tm,p_tm] pth_final) th;; (* ------------------------------------------------------------------------- *) (* Linear prover. This works over the rationals in general, but is designed *) (* to be OK on integers provided the input contains only integers. *) (* ------------------------------------------------------------------------- *) let REAL_LINEAR_PROVER = let linear_add = combine (+/) (fun z -> z =/ num_0) and linear_cmul c = mapf (fun x -> c */ x) and one_tm = `&1` in let contradictory p (e,_) = (is_undefined e && not(p num_0)) || (dom e = [one_tm] && not(p(apply e one_tm))) in let rec linear_ineqs vars (les,lts) = try find (contradictory (fun x -> x >/ num_0)) lts with Failure _ -> try find (contradictory (fun x -> x >=/ num_0)) les with Failure _ -> if vars = [] then failwith "linear_ineqs: no contradiction" else let ineqs = les @ lts in let blowup v = length(filter (fun (e,_) -> tryapplyd e v num_0 >/ num_0) ineqs) * length(filter (fun (e,_) -> tryapplyd e v num_0 i < j) (map (fun v -> v,blowup v) vars))) in let addup (e1,p1) (e2,p2) acc = let c1 = tryapplyd e1 v num_0 and c2 = tryapplyd e2 v num_0 in if c1 */ c2 >=/ num_0 then acc else let e1' = linear_cmul (abs_num c2) e1 and e2' = linear_cmul (abs_num c1) e2 and p1' = Product(Rational_lt(abs_num c2),p1) and p2' = Product(Rational_lt(abs_num c1),p2) in (linear_add e1' e2',Sum(p1',p2'))::acc in let les0,les1 = partition (fun (e,_) -> tryapplyd e v num_0 =/ num_0) les and lts0,lts1 = partition (fun (e,_) -> tryapplyd e v num_0 =/ num_0) lts in let lesp,lesn = partition (fun (e,_) -> tryapplyd e v num_0 >/ num_0) les1 and ltsp,ltsn = partition (fun (e,_) -> tryapplyd e v num_0 >/ num_0) lts1 in let les' = itlist (fun ep1 -> itlist (addup ep1) lesp) lesn les0 and lts' = itlist (fun ep1 -> itlist (addup ep1) (lesp@ltsp)) ltsn (itlist (fun ep1 -> itlist (addup ep1) (lesn@ltsn)) ltsp lts0) in linear_ineqs (subtract vars [v]) (les',lts') in let rec linear_eqs(eqs,les,lts) = try find (contradictory (fun x -> x =/ num_0)) eqs with Failure _ -> match eqs with [] -> let vars = subtract (itlist (union o dom o fst) (les@lts) []) [one_tm] in linear_ineqs vars (les,lts) | (e,p)::es -> if is_undefined e then linear_eqs(es,les,lts) else let x,c = choose (undefine one_tm e) in let xform(t,q as inp) = let d = tryapplyd t x num_0 in if d =/ num_0 then inp else let k = minus_num d */ abs_num c // c in let e' = linear_cmul k e and t' = linear_cmul (abs_num c) t and p' = Eqmul(term_of_rat k,p) and q' = Product(Rational_lt(abs_num c),q) in linear_add e' t',Sum(p',q') in linear_eqs(map xform es,map xform les,map xform lts) in let linear_prover = fun (eq,le,lt) -> let eqs = map2 (fun p n -> p,Axiom_eq n) eq (0--(length eq-1)) and les = map2 (fun p n -> p,Axiom_le n) le (0--(length le-1)) and lts = map2 (fun p n -> p,Axiom_lt n) lt (0--(length lt-1)) in linear_eqs(eqs,les,lts) in let lin_of_hol = let one_tm = `&1` and zero_tm = `&0` and add_tm = `(+):real->real->real` and mul_tm = `(*):real->real->real` in let rec lin_of_hol tm = if tm = zero_tm then undefined else if not (is_comb tm) then (tm |=> Int 1) else if is_ratconst tm then (one_tm |=> rat_of_term tm) else let lop,r = dest_comb tm in if not (is_comb lop) then (tm |=> Int 1) else let op,l = dest_comb lop in if op = add_tm then linear_add (lin_of_hol l) (lin_of_hol r) else if op = mul_tm && is_ratconst l then (r |=> rat_of_term l) else (tm |=> Int 1) in lin_of_hol in let is_alien tm = match tm with Comb(Const("real_of_num",_),n) when not(is_numeral n) -> true | _ -> false in let n_tm = `n:num` in let pth = REWRITE_RULE[GSYM real_ge] (SPEC n_tm REAL_POS) in fun translator (eq,le,lt) -> let eq_pols = map (lin_of_hol o lhand o concl) eq and le_pols = map (lin_of_hol o lhand o concl) le and lt_pols = map (lin_of_hol o lhand o concl) lt in let aliens = filter is_alien (itlist (union o dom) (eq_pols @ le_pols @ lt_pols) []) in let le_pols' = le_pols @ map (fun v -> (v |=> Int 1)) aliens in let _,proof = linear_prover(eq_pols,le_pols',lt_pols) in let le' = le @ map (fun a -> INST [rand a,n_tm] pth) aliens in translator (eq,le',lt) proof;; (* ------------------------------------------------------------------------- *) (* Bootstrapping REAL_ARITH: trivial abs-elim and only integer constants. *) (* ------------------------------------------------------------------------- *) let REAL_ARITH = let REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_SUB_CONV, REAL_POLY_MUL_CONV,REAL_POLY_POW_CONV,REAL_POLY_CONV = SEMIRING_NORMALIZERS_CONV REAL_POLY_CLAUSES REAL_POLY_NEG_CLAUSES (is_realintconst, REAL_INT_ADD_CONV,REAL_INT_MUL_CONV,REAL_INT_POW_CONV) (<) in let rule = GEN_REAL_ARITH (mk_realintconst, REAL_INT_EQ_CONV,REAL_INT_GE_CONV,REAL_INT_GT_CONV, REAL_POLY_CONV,REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_MUL_CONV, NO_CONV,NO_CONV,REAL_LINEAR_PROVER) and deabs_conv = REWRITE_CONV[real_abs; real_max; real_min] in fun tm -> let th1 = deabs_conv tm in EQ_MP (SYM th1) (rule(rand(concl th1)));; (* ------------------------------------------------------------------------- *) (* Slightly less parametrized GEN_REAL_ARITH with more intelligent *) (* elimination of abs, max and min hardwired in. *) (* ------------------------------------------------------------------------- *) let GEN_REAL_ARITH = let ABSMAXMIN_ELIM_CONV1 = GEN_REWRITE_CONV I [time REAL_ARITH `(--(&1) * abs(x) >= r <=> --(&1) * x >= r /\ &1 * x >= r) /\ (--(&1) * abs(x) + a >= r <=> a + --(&1) * x >= r /\ a + &1 * x >= r) /\ (a + --(&1) * abs(x) >= r <=> a + --(&1) * x >= r /\ a + &1 * x >= r) /\ (a + --(&1) * abs(x) + b >= r <=> a + --(&1) * x + b >= r /\ a + &1 * x + b >= r) /\ (a + b + --(&1) * abs(x) >= r <=> a + b + --(&1) * x >= r /\ a + b + &1 * x >= r) /\ (a + b + --(&1) * abs(x) + c >= r <=> a + b + --(&1) * x + c >= r /\ a + b + &1 * x + c >= r) /\ (--(&1) * max x y >= r <=> --(&1) * x >= r /\ --(&1) * y >= r) /\ (--(&1) * max x y + a >= r <=> a + --(&1) * x >= r /\ a + --(&1) * y >= r) /\ (a + --(&1) * max x y >= r <=> a + --(&1) * x >= r /\ a + --(&1) * y >= r) /\ (a + --(&1) * max x y + b >= r <=> a + --(&1) * x + b >= r /\ a + --(&1) * y + b >= r) /\ (a + b + --(&1) * max x y >= r <=> a + b + --(&1) * x >= r /\ a + b + --(&1) * y >= r) /\ (a + b + --(&1) * max x y + c >= r <=> a + b + --(&1) * x + c >= r /\ a + b + --(&1) * y + c >= r) /\ (&1 * min x y >= r <=> &1 * x >= r /\ &1 * y >= r) /\ (&1 * min x y + a >= r <=> a + &1 * x >= r /\ a + &1 * y >= r) /\ (a + &1 * min x y >= r <=> a + &1 * x >= r /\ a + &1 * y >= r) /\ (a + &1 * min x y + b >= r <=> a + &1 * x + b >= r /\ a + &1 * y + b >= r) /\ (a + b + &1 * min x y >= r <=> a + b + &1 * x >= r /\ a + b + &1 * y >= r) /\ (a + b + &1 * min x y + c >= r <=> a + b + &1 * x + c >= r /\ a + b + &1 * y + c >= r) /\ (min x y >= r <=> x >= r /\ y >= r) /\ (min x y + a >= r <=> a + x >= r /\ a + y >= r) /\ (a + min x y >= r <=> a + x >= r /\ a + y >= r) /\ (a + min x y + b >= r <=> a + x + b >= r /\ a + y + b >= r) /\ (a + b + min x y >= r <=> a + b + x >= r /\ a + b + y >= r) /\ (a + b + min x y + c >= r <=> a + b + x + c >= r /\ a + b + y + c >= r) /\ (--(&1) * abs(x) > r <=> --(&1) * x > r /\ &1 * x > r) /\ (--(&1) * abs(x) + a > r <=> a + --(&1) * x > r /\ a + &1 * x > r) /\ (a + --(&1) * abs(x) > r <=> a + --(&1) * x > r /\ a + &1 * x > r) /\ (a + --(&1) * abs(x) + b > r <=> a + --(&1) * x + b > r /\ a + &1 * x + b > r) /\ (a + b + --(&1) * abs(x) > r <=> a + b + --(&1) * x > r /\ a + b + &1 * x > r) /\ (a + b + --(&1) * abs(x) + c > r <=> a + b + --(&1) * x + c > r /\ a + b + &1 * x + c > r) /\ (--(&1) * max x y > r <=> --(&1) * x > r /\ --(&1) * y > r) /\ (--(&1) * max x y + a > r <=> a + --(&1) * x > r /\ a + --(&1) * y > r) /\ (a + --(&1) * max x y > r <=> a + --(&1) * x > r /\ a + --(&1) * y > r) /\ (a + --(&1) * max x y + b > r <=> a + --(&1) * x + b > r /\ a + --(&1) * y + b > r) /\ (a + b + --(&1) * max x y > r <=> a + b + --(&1) * x > r /\ a + b + --(&1) * y > r) /\ (a + b + --(&1) * max x y + c > r <=> a + b + --(&1) * x + c > r /\ a + b + --(&1) * y + c > r) /\ (min x y > r <=> x > r /\ y > r) /\ (min x y + a > r <=> a + x > r /\ a + y > r) /\ (a + min x y > r <=> a + x > r /\ a + y > r) /\ (a + min x y + b > r <=> a + x + b > r /\ a + y + b > r) /\ (a + b + min x y > r <=> a + b + x > r /\ a + b + y > r) /\ (a + b + min x y + c > r <=> a + b + x + c > r /\ a + b + y + c > r)`] and ABSMAXMIN_ELIM_CONV2 = let pth_abs = prove (`P(abs x) <=> (x >= &0 /\ P x) \/ (&0 > x /\ P (--x))`, REWRITE_TAC[real_abs; real_gt; real_ge] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[real_lt]) and pth_max = prove (`P(max x y) <=> (y >= x /\ P y) \/ (x > y /\ P x)`, REWRITE_TAC[real_max; real_gt; real_ge] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[real_lt]) and pth_min = prove (`P(min x y) <=> (y >= x /\ P x) \/ (x > y /\ P y)`, REWRITE_TAC[real_min; real_gt; real_ge] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[real_lt]) and abs_tm = `real_abs` and p_tm = `P:real->bool` and x_tm = `x:real` and y_tm = `y:real` in let is_max = is_binop `real_max` and is_min = is_binop `real_min` and is_abs t = is_comb t && rator t = abs_tm in let eliminate_construct p c tm = let t = find_term (fun t -> p t && free_in t tm) tm in let v = genvar(type_of t) in let th0 = SYM(BETA_CONV(mk_comb(mk_abs(v,subst[v,t] tm),t))) in let p,ax = dest_comb(rand(concl th0)) in CONV_RULE(RAND_CONV(BINOP_CONV(RAND_CONV BETA_CONV))) (TRANS th0 (c p ax)) in let elim_abs = eliminate_construct is_abs (fun p ax -> INST [p,p_tm; rand ax,x_tm] pth_abs) and elim_max = eliminate_construct is_max (fun p ax -> let ax,y = dest_comb ax in INST [p,p_tm; rand ax,x_tm; y,y_tm] pth_max) and elim_min = eliminate_construct is_min (fun p ax -> let ax,y = dest_comb ax in INST [p,p_tm; rand ax,x_tm; y,y_tm] pth_min) in FIRST_CONV [elim_abs; elim_max; elim_min] in fun (mkconst,EQ,GE,GT,NORM,NEG,ADD,MUL,PROVER) -> GEN_REAL_ARITH(mkconst,EQ,GE,GT,NORM,NEG,ADD,MUL, ABSMAXMIN_ELIM_CONV1,ABSMAXMIN_ELIM_CONV2,PROVER);; (* ------------------------------------------------------------------------- *) (* Incorporate that. This gets overwritten again in "calc_rat.ml". *) (* ------------------------------------------------------------------------- *) let REAL_ARITH = let REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_SUB_CONV, REAL_POLY_MUL_CONV,REAL_POLY_POW_CONV,REAL_POLY_CONV = SEMIRING_NORMALIZERS_CONV REAL_POLY_CLAUSES REAL_POLY_NEG_CLAUSES (is_realintconst, REAL_INT_ADD_CONV,REAL_INT_MUL_CONV,REAL_INT_POW_CONV) (<) in GEN_REAL_ARITH (mk_realintconst, REAL_INT_EQ_CONV,REAL_INT_GE_CONV,REAL_INT_GT_CONV, REAL_POLY_CONV,REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_MUL_CONV, REAL_LINEAR_PROVER);; hol-light/realax.ml000066400000000000000000002563761303454263000145760ustar00rootroot00000000000000(* ========================================================================= *) (* Theory of real numbers. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "lists.ml";; (* ------------------------------------------------------------------------- *) (* The main infix overloaded operations *) (* ------------------------------------------------------------------------- *) parse_as_infix("++",(16,"right"));; parse_as_infix("**",(20,"right"));; parse_as_infix("<<=",(12,"right"));; parse_as_infix("===",(10,"right"));; parse_as_infix ("treal_mul",(20,"right"));; parse_as_infix ("treal_add",(16,"right"));; parse_as_infix ("treal_le",(12,"right"));; parse_as_infix ("treal_eq",(10,"right"));; make_overloadable "+" `:A->A->A`;; make_overloadable "-" `:A->A->A`;; make_overloadable "*" `:A->A->A`;; make_overloadable "/" `:A->A->A`;; make_overloadable "<" `:A->A->bool`;; make_overloadable "<=" `:A->A->bool`;; make_overloadable ">" `:A->A->bool`;; make_overloadable ">=" `:A->A->bool`;; make_overloadable "--" `:A->A`;; make_overloadable "pow" `:A->num->A`;; make_overloadable "inv" `:A->A`;; make_overloadable "abs" `:A->A`;; make_overloadable "max" `:A->A->A`;; make_overloadable "min" `:A->A->A`;; make_overloadable "&" `:num->A`;; do_list overload_interface ["+",`(+):num->num->num`; "-",`(-):num->num->num`; "*",`(*):num->num->num`; "<",`(<):num->num->bool`; "<=",`(<=):num->num->bool`; ">",`(>):num->num->bool`; ">=",`(>=):num->num->bool`];; let prioritize_num() = prioritize_overload(mk_type("num",[]));; (* ------------------------------------------------------------------------- *) (* Absolute distance function on the naturals. *) (* ------------------------------------------------------------------------- *) let dist = new_definition `dist(m,n) = (m - n) + (n - m)`;; (* ------------------------------------------------------------------------- *) (* Some easy theorems. *) (* ------------------------------------------------------------------------- *) let DIST_REFL = prove (`!n. dist(n,n) = 0`, REWRITE_TAC[dist; SUB_REFL; ADD_CLAUSES]);; let DIST_LZERO = prove (`!n. dist(0,n) = n`, REWRITE_TAC[dist; SUB_0; ADD_CLAUSES]);; let DIST_RZERO = prove (`!n. dist(n,0) = n`, REWRITE_TAC[dist; SUB_0; ADD_CLAUSES]);; let DIST_SYM = prove (`!m n. dist(m,n) = dist(n,m)`, REWRITE_TAC[dist] THEN MATCH_ACCEPT_TAC ADD_SYM);; let DIST_LADD = prove (`!m p n. dist(m + n,m + p) = dist(n,p)`, REWRITE_TAC[dist; SUB_ADD_LCANCEL]);; let DIST_RADD = prove (`!m p n. dist(m + p,n + p) = dist(m,n)`, REWRITE_TAC[dist; SUB_ADD_RCANCEL]);; let DIST_LADD_0 = prove (`!m n. dist(m + n,m) = n`, REWRITE_TAC[dist; ADD_SUB2; ADD_SUBR2; ADD_CLAUSES]);; let DIST_RADD_0 = prove (`!m n. dist(m,m + n) = n`, ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_ACCEPT_TAC DIST_LADD_0);; let DIST_LMUL = prove (`!m n p. m * dist(n,p) = dist(m * n,m * p)`, REWRITE_TAC[dist; LEFT_ADD_DISTRIB; LEFT_SUB_DISTRIB]);; let DIST_RMUL = prove (`!m n p. dist(m,n) * p = dist(m * p,n * p)`, REWRITE_TAC[dist; RIGHT_ADD_DISTRIB; RIGHT_SUB_DISTRIB]);; let DIST_EQ_0 = prove (`!m n. (dist(m,n) = 0) <=> (m = n)`, REWRITE_TAC[dist; ADD_EQ_0; SUB_EQ_0; LE_ANTISYM]);; (* ------------------------------------------------------------------------- *) (* Simplifying theorem about the distance operation. *) (* ------------------------------------------------------------------------- *) let DIST_ELIM_THM = prove (`P(dist(x,y)) <=> !d. ((x = y + d) ==> P(d)) /\ ((y = x + d) ==> P(d))`, DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THEN POP_ASSUM(X_CHOOSE_THEN `e:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[dist; ADD_SUB; ADD_SUB2; ADD_SUBR; ADD_SUBR2] THEN REWRITE_TAC[ADD_CLAUSES; EQ_ADD_LCANCEL] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[GSYM ADD_ASSOC; EQ_ADD_LCANCEL_0; ADD_EQ_0] THEN ASM_CASES_TAC `e = 0` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Now some more theorems. *) (* ------------------------------------------------------------------------- *) let DIST_LE_CASES,DIST_ADDBOUND,DIST_TRIANGLE,DIST_ADD2,DIST_ADD2_REV = let DIST_ELIM_TAC = let conv = HIGHER_REWRITE_CONV[SUB_ELIM_THM; COND_ELIM_THM; DIST_ELIM_THM] false in CONV_TAC conv THEN TRY GEN_TAC THEN CONJ_TAC THEN DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN (let l,r = dest_eq (concl th) in if is_var l && not (vfree_in l r) then ALL_TAC else ASSUME_TAC th)) in let DIST_ELIM_TAC' = REPEAT STRIP_TAC THEN REPEAT DIST_ELIM_TAC THEN REWRITE_TAC[GSYM NOT_LT; LT_EXISTS] THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN POP_ASSUM MP_TAC THEN CONV_TAC(LAND_CONV NUM_CANCEL_CONV) THEN REWRITE_TAC[ADD_CLAUSES; NOT_SUC] in let DIST_LE_CASES = prove (`!m n p. dist(m,n) <= p <=> (m <= n + p) /\ (n <= m + p)`, REPEAT GEN_TAC THEN REPEAT DIST_ELIM_TAC THEN REWRITE_TAC[GSYM ADD_ASSOC; LE_ADD; LE_ADD_LCANCEL]) and DIST_ADDBOUND = prove (`!m n. dist(m,n) <= m + n`, REPEAT GEN_TAC THEN DIST_ELIM_TAC THENL [ONCE_REWRITE_TAC[ADD_SYM]; ALL_TAC] THEN REWRITE_TAC[ADD_ASSOC; LE_ADDR]) and [DIST_TRIANGLE; DIST_ADD2; DIST_ADD2_REV] = (CONJUNCTS o prove) (`(!m n p. dist(m,p) <= dist(m,n) + dist(n,p)) /\ (!m n p q. dist(m + n,p + q) <= dist(m,p) + dist(n,q)) /\ (!m n p q. dist(m,p) <= dist(m + n,p + q) + dist(n,q))`, DIST_ELIM_TAC') in DIST_LE_CASES,DIST_ADDBOUND,DIST_TRIANGLE,DIST_ADD2,DIST_ADD2_REV;; let DIST_TRIANGLE_LE = prove (`!m n p q. dist(m,n) + dist(n,p) <= q ==> dist(m,p) <= q`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dist(m,n) + dist(n,p)` THEN ASM_REWRITE_TAC[DIST_TRIANGLE]);; let DIST_TRIANGLES_LE = prove (`!m n p q r s. dist(m,n) <= r /\ dist(p,q) <= s ==> dist(m,p) <= dist(n,q) + r + s`, REPEAT STRIP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_LE THEN EXISTS_TAC `n:num` THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_TRIANGLE_LE THEN EXISTS_TAC `q:num` THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Useful lemmas about bounds. *) (* ------------------------------------------------------------------------- *) let BOUNDS_LINEAR = prove (`!A B C. (!n. A * n <= B * n + C) <=> A <= B`, REPEAT GEN_TAC THEN EQ_TAC THENL [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LT_EXISTS]) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN DISCH_THEN(MP_TAC o SPEC `SUC C`) THEN REWRITE_TAC[NOT_LE; MULT_CLAUSES; ADD_CLAUSES; LT_SUC_LE] THEN REWRITE_TAC[ADD_ASSOC; LE_ADDR]; DISCH_THEN(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]);; let BOUNDS_LINEAR_0 = prove (`!A B. (!n. A * n <= B) <=> (A = 0)`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`A:num`; `0`; `B:num`] BOUNDS_LINEAR) THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LE]);; let BOUNDS_DIVIDED = prove (`!P. (?B. !n. P(n) <= B) <=> (?A B. !n. n * P(n) <= A * n + B)`, GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`B:num`; `0`] THEN GEN_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]; EXISTS_TAC `P(0) + A + B` THEN GEN_TAC THEN MP_TAC(SPECL [`n:num`; `(P:num->num) n`; `P(0) + A + B`] LE_MULT_LCANCEL) THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LE_ADD] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * n + B` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_ADD_DISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN REWRITE_TAC[GSYM ADD_ASSOC; LE_ADD_LCANCEL] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `B * n` THEN REWRITE_TAC[LE_ADD] THEN UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; LE_ADD]]);; let BOUNDS_NOTZERO = prove (`!P A B. (P 0 0 = 0) /\ (!m n. P m n <= A * (m + n) + B) ==> (?B. !m n. P m n <= B * (m + n))`, REPEAT STRIP_TAC THEN EXISTS_TAC `A + B` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `m + n = 0` THENL [RULE_ASSUM_TAC(REWRITE_RULE[ADD_EQ_0]) THEN ASM_REWRITE_TAC[LE_0]; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * (m + n) + B` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN UNDISCH_TAC `~(m + n = 0)` THEN SPEC_TAC(`m + n`,`p:num`) THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; LE_ADD]]);; let BOUNDS_IGNORE = prove (`!P Q. (?B. !i. P(i) <= Q(i) + B) <=> (?B N. !i. N <= i ==> P(i) <= Q(i) + B)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]; POP_ASSUM MP_TAC THEN SPEC_TAC(`B:num`,`B:num`) THEN SPEC_TAC(`N:num`,`N:num`) THEN INDUCT_TAC THENL [REWRITE_TAC[LE_0] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]; GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `B + P(N:num)` THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_CASES_TAC `SUC N <= i` THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `Q(i:num) + B` THEN REWRITE_TAC[LE_ADD; ADD_ASSOC] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; UNDISCH_TAC `~(SUC N <= i)` THEN REWRITE_TAC[NOT_LE; LT] THEN ASM_REWRITE_TAC[GSYM NOT_LE] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]]]]);; (* ------------------------------------------------------------------------- *) (* Define type of nearly additive functions. *) (* ------------------------------------------------------------------------- *) let is_nadd = new_definition `is_nadd x <=> (?B. !m n. dist(m * x(n),n * x(m)) <= B * (m + n))`;; let is_nadd_0 = prove (`is_nadd (\n. 0)`, REWRITE_TAC[is_nadd; MULT_CLAUSES; DIST_REFL; LE_0]);; let nadd_abs,nadd_rep = new_basic_type_definition "nadd" ("mk_nadd","dest_nadd") is_nadd_0;; override_interface ("fn",`dest_nadd`);; override_interface ("afn",`mk_nadd`);; (* ------------------------------------------------------------------------- *) (* Properties of nearly-additive functions. *) (* ------------------------------------------------------------------------- *) let NADD_CAUCHY = prove (`!x. ?B. !m n. dist(m * fn x n,n * fn x m) <= B * (m + n)`, REWRITE_TAC[GSYM is_nadd; nadd_rep; nadd_abs; ETA_AX]);; let NADD_BOUND = prove (`!x. ?A B. !n. fn x n <= A * n + B`, GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN MAP_EVERY EXISTS_TAC [`B + fn x 1`; `B:num`] THEN GEN_TAC THEN POP_ASSUM(MP_TAC o SPECL [`n:num`; `1`]) THEN REWRITE_TAC[DIST_LE_CASES; MULT_CLAUSES] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[ADD_AC; MULT_AC]);; let NADD_MULTIPLICATIVE = prove (`!x. ?B. !m n. dist(fn x (m * n),m * fn x n) <= B * m + B`, GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN EXISTS_TAC `B + fn x 0` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL [MATCH_MP_TAC (LE_IMP DIST_ADDBOUND) THEN ASM_REWRITE_TAC[MULT_CLAUSES; RIGHT_ADD_DISTRIB; MULT_AC] THEN REWRITE_TAC[LE_EXISTS] THEN CONV_TAC(ONCE_DEPTH_CONV NUM_CANCEL_CONV) THEN REWRITE_TAC[GSYM EXISTS_REFL]; UNDISCH_TAC `~(n = 0)`] THEN REWRITE_TAC[TAUT `(~a ==> b) <=> a \/ b`; GSYM LE_MULT_LCANCEL; DIST_LMUL] THEN REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [MULT_SYM] THEN POP_ASSUM(MATCH_MP_TAC o LE_IMP) THEN REWRITE_TAC[LE_EXISTS; RIGHT_ADD_DISTRIB; LEFT_ADD_DISTRIB; MULT_AC] THEN CONV_TAC(ONCE_DEPTH_CONV NUM_CANCEL_CONV) THEN REWRITE_TAC[GSYM EXISTS_REFL]);; let NADD_ADDITIVE = prove (`!x. ?B. !m n. dist(fn x (m + n),fn x m + fn x n) <= B`, GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN EXISTS_TAC `3 * B + fn x 0` THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `m + n = 0` THENL [RULE_ASSUM_TAC(REWRITE_RULE[ADD_EQ_0]) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[ADD_CLAUSES; DIST_LADD_0; LE_ADDR]; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `3 * B` THEN REWRITE_TAC[LE_ADD] THEN UNDISCH_TAC `~(m + n = 0)`] THEN REWRITE_TAC[TAUT `(~a ==> b) <=> a \/ b`; GSYM LE_MULT_LCANCEL] THEN REWRITE_TAC[DIST_LMUL; LEFT_ADD_DISTRIB] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [RIGHT_ADD_DISTRIB] THEN MATCH_MP_TAC(LE_IMP DIST_ADD2) THEN SUBGOAL_THEN `(m + n) * 3 * B = B * (m + m + n) + B * (n + m + n)` SUBST1_TAC THENL [REWRITE_TAC[SYM(REWRITE_CONV [ARITH] `1 + 1 + 1`)] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN REWRITE_TAC[MULT_AC] THEN CONV_TAC NUM_CANCEL_CONV THEN REFL_TAC; MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]]);; let NADD_SUC = prove (`!x. ?B. !n. dist(fn x (SUC n),fn x n) <= B`, GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_ADDITIVE) THEN EXISTS_TAC `B + fn x 1` THEN GEN_TAC THEN MATCH_MP_TAC(LE_IMP DIST_TRIANGLE) THEN EXISTS_TAC `fn x n + fn x 1` THEN ASM_REWRITE_TAC[ADD1] THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[DIST_LADD_0; LE_REFL]);; let NADD_DIST_LEMMA = prove (`!x. ?B. !m n. dist(fn x (m + n),fn x m) <= B * n`, GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_SUC) THEN EXISTS_TAC `B:num` THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; DIST_REFL; LE_0] THEN MATCH_MP_TAC(LE_IMP DIST_TRIANGLE) THEN EXISTS_TAC `fn x (m + n)` THEN REWRITE_TAC[ADD1; LEFT_ADD_DISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[GSYM ADD1; MULT_CLAUSES]);; let NADD_DIST = prove (`!x. ?B. !m n. dist(fn x m,fn x n) <= B * dist(m,n)`, GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_DIST_LEMMA) THEN EXISTS_TAC `B:num` THEN REPEAT GEN_TAC THEN DISJ_CASES_THEN MP_TAC (SPECL [`m:num`; `n:num`] LE_CASES) THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC o ONCE_REWRITE_RULE[LE_EXISTS]) THENL [ONCE_REWRITE_TAC[DIST_SYM]; ALL_TAC] THEN ASM_REWRITE_TAC[DIST_LADD_0]);; let NADD_ALTMUL = prove (`!x y. ?A B. !n. dist(n * fn x (fn y n),fn x n * fn y n) <= A * n + B`, REPEAT GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN MP_TAC(SPEC `y:nadd` NADD_BOUND) THEN DISCH_THEN(X_CHOOSE_THEN `M:num` (X_CHOOSE_TAC `L:num`)) THEN MAP_EVERY EXISTS_TAC [`B * (1 + M)`; `B * L`] THEN GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [MULT_SYM] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `B * (n + fn y n)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_CLAUSES; GSYM ADD_ASSOC; LE_ADD_LCANCEL] THEN ASM_REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC; LE_MULT_LCANCEL]);; (* ------------------------------------------------------------------------- *) (* Definition of the equivalence relation and proof that it *is* one. *) (* ------------------------------------------------------------------------- *) override_interface ("===",`(nadd_eq):nadd->nadd->bool`);; let nadd_eq = new_definition `x === y <=> ?B. !n. dist(fn x n,fn y n) <= B`;; let NADD_EQ_REFL = prove (`!x. x === x`, GEN_TAC THEN REWRITE_TAC[nadd_eq; DIST_REFL; LE_0]);; let NADD_EQ_SYM = prove (`!x y. x === y <=> y === x`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN REFL_TAC);; let NADD_EQ_TRANS = prove (`!x y z. x === y /\ y === z ==> x === z`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) (X_CHOOSE_TAC `B2:num`)) THEN EXISTS_TAC `B1 + B2` THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN EXISTS_TAC `fn y n` THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Injection of the natural numbers. *) (* ------------------------------------------------------------------------- *) override_interface ("&",`nadd_of_num:num->nadd`);; let nadd_of_num = new_definition `&k = afn(\n. k * n)`;; let NADD_OF_NUM = prove (`!k. fn(&k) = \n. k * n`, REWRITE_TAC[nadd_of_num; GSYM nadd_rep; is_nadd] THEN REWRITE_TAC[DIST_REFL; LE_0; MULT_AC]);; let NADD_OF_NUM_WELLDEF = prove (`!m n. (m = n) ==> &m === &n`, REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC NADD_EQ_REFL);; let NADD_OF_NUM_EQ = prove (`!m n. (&m === &n) <=> (m = n)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[NADD_OF_NUM_WELLDEF] THEN REWRITE_TAC[nadd_eq; NADD_OF_NUM] THEN REWRITE_TAC[GSYM DIST_RMUL; BOUNDS_LINEAR_0; DIST_EQ_0]);; (* ------------------------------------------------------------------------- *) (* Definition of (reflexive) ordering and the only special property needed. *) (* ------------------------------------------------------------------------- *) override_interface ("<<=",`nadd_le:nadd->nadd->bool`);; let nadd_le = new_definition `x <<= y <=> ?B. !n. fn x n <= fn y n + B`;; let NADD_LE_WELLDEF_LEMMA = prove (`!x x' y y'. x === x' /\ y === y' /\ x <<= y ==> x' <<= y'`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; nadd_le] THEN REWRITE_TAC[DIST_LE_CASES; FORALL_AND_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) MP_TAC) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B2:num`) MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `B:num`) THEN EXISTS_TAC `(B2 + B) + B1` THEN X_GEN_TAC `n:num` THEN FIRST_ASSUM(MATCH_MP_TAC o LE_IMP o CONJUNCT2) THEN REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL] THEN FIRST_ASSUM(MATCH_MP_TAC o LE_IMP) THEN ASM_REWRITE_TAC[LE_ADD_RCANCEL]);; let NADD_LE_WELLDEF = prove (`!x x' y y'. x === x' /\ y === y' ==> (x <<= y <=> x' <<= y')`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN MATCH_MP_TAC NADD_LE_WELLDEF_LEMMA THEN ASM_REWRITE_TAC[] THENL [MAP_EVERY EXISTS_TAC [`x:nadd`; `y:nadd`]; MAP_EVERY EXISTS_TAC [`x':nadd`; `y':nadd`] THEN ONCE_REWRITE_TAC[NADD_EQ_SYM]] THEN ASM_REWRITE_TAC[]);; let NADD_LE_REFL = prove (`!x. x <<= x`, REWRITE_TAC[nadd_le; LE_ADD]);; let NADD_LE_TRANS = prove (`!x y z. x <<= y /\ y <<= z ==> x <<= z`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) MP_TAC) THEN DISCH_THEN(X_CHOOSE_TAC `B2:num`) THEN EXISTS_TAC `B2 + B1` THEN GEN_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o LE_IMP) THEN ASM_REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL]);; let NADD_LE_ANTISYM = prove (`!x y. x <<= y /\ y <<= x <=> (x === y)`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; nadd_eq; DIST_LE_CASES] THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) (X_CHOOSE_TAC `B2:num`)) THEN EXISTS_TAC `B1 + B2` THEN GEN_TAC THEN CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o LE_IMP) THEN ASM_REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL; LE_ADD; LE_ADDR]; DISCH_THEN(X_CHOOSE_TAC `B:num`) THEN CONJ_TAC THEN EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]]);; let NADD_LE_TOTAL_LEMMA = prove (`!x y. ~(x <<= y) ==> !B. ?n. ~(n = 0) /\ fn y n + B < fn x n`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NOT_FORALL_THM; NOT_EXISTS_THM] THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM(X_CHOOSE_TAC `n:num` o SPEC `B + fn x 0`) THEN EXISTS_TAC `n:num` THEN POP_ASSUM MP_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NOT_LT; ADD_ASSOC; LE_ADDR] THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LT] THEN DISCH_THEN(MATCH_MP_TAC o LE_IMP) THEN REWRITE_TAC[ADD_ASSOC; LE_ADD]);; let NADD_LE_TOTAL = prove (`!x y. x <<= y \/ y <<= x`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~ a`] THEN X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN X_CHOOSE_TAC `B2:num` (SPEC `y:nadd` NADD_CAUCHY) THEN PURE_ONCE_REWRITE_TAC[DE_MORGAN_THM] THEN DISCH_THEN(MP_TAC o end_itlist CONJ o map (MATCH_MP NADD_LE_TOTAL_LEMMA) o CONJUNCTS) THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `B1 + B2`) THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num` MP_TAC)) THEN DISCH_THEN(MP_TAC o MATCH_MP (ITAUT `(~a /\ b) /\ (~c /\ d) ==> ~(c \/ ~b) /\ ~(a \/ ~d)`)) THEN REWRITE_TAC[NOT_LT; GSYM LE_MULT_LCANCEL] THEN REWRITE_TAC[NOT_LE] THEN DISCH_THEN(MP_TAC o MATCH_MP LT_ADD2) THEN REWRITE_TAC[NOT_LT] THEN REWRITE_TAC[LEFT_ADD_DISTRIB] THEN ONCE_REWRITE_TAC[AC ADD_AC `(a + b + c) + (d + e + f) = (d + b + e) + (a + c + f)`] THEN MATCH_MP_TAC LE_ADD2 THEN REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN CONJ_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MULT_SYM] THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_LE_CASES]) THEN ASM_REWRITE_TAC[]);; let NADD_ARCH = prove (`!x. ?n. x <<= &n`, REWRITE_TAC[nadd_le; NADD_OF_NUM; NADD_BOUND]);; let NADD_OF_NUM_LE = prove (`!m n. (&m <<= &n) <=> m <= n`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NADD_OF_NUM] THEN REWRITE_TAC[BOUNDS_LINEAR]);; (* ------------------------------------------------------------------------- *) (* Addition. *) (* ------------------------------------------------------------------------- *) override_interface ("++",`nadd_add:nadd->nadd->nadd`);; let nadd_add = new_definition `x ++ y = afn(\n. fn x n + fn y n)`;; let NADD_ADD = prove (`!x y. fn(x ++ y) = \n. fn x n + fn y n`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_add; GSYM nadd_rep; is_nadd] THEN X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN X_CHOOSE_TAC `B2:num` (SPEC `y:nadd` NADD_CAUCHY) THEN EXISTS_TAC `B1 + B2` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LEFT_ADD_DISTRIB] THEN MATCH_MP_TAC (LE_IMP DIST_ADD2) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]);; let NADD_ADD_WELLDEF = prove (`!x x' y y'. x === x' /\ y === y' ==> (x ++ y === x' ++ y')`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_ADD] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) (X_CHOOSE_TAC `B2:num`)) THEN EXISTS_TAC `B1 + B2` THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC (LE_IMP DIST_ADD2) THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Basic properties of addition. *) (* ------------------------------------------------------------------------- *) let NADD_ADD_SYM = prove (`!x y. (x ++ y) === (y ++ x)`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_add] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN REWRITE_TAC[NADD_EQ_REFL]);; let NADD_ADD_ASSOC = prove (`!x y z. (x ++ (y ++ z)) === ((x ++ y) ++ z)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[nadd_add] THEN REWRITE_TAC[NADD_ADD; ADD_ASSOC; NADD_EQ_REFL]);; let NADD_ADD_LID = prove (`!x. (&0 ++ x) === x`, GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_ADD; NADD_OF_NUM] THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; DIST_REFL; LE_0]);; let NADD_ADD_LCANCEL = prove (`!x y z. (x ++ y) === (x ++ z) ==> y === z`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_ADD; DIST_LADD]);; let NADD_LE_ADD = prove (`!x y. x <<= (x ++ y)`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NADD_ADD] THEN EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; LE_ADD]);; let NADD_LE_EXISTS = prove (`!x y. x <<= y ==> ?d. y === x ++ d`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le] THEN DISCH_THEN(X_CHOOSE_THEN `B:num` MP_TAC) THEN REWRITE_TAC[LE_EXISTS; SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `d:num->num` (ASSUME_TAC o GSYM)) THEN EXISTS_TAC `afn d` THEN REWRITE_TAC[nadd_eq; NADD_ADD] THEN EXISTS_TAC `B:num` THEN X_GEN_TAC `n:num` THEN SUBGOAL_THEN `fn(afn d) = d` SUBST1_TAC THENL [REWRITE_TAC[GSYM nadd_rep; is_nadd] THEN X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN X_CHOOSE_TAC `B2:num` (SPEC `y:nadd` NADD_CAUCHY) THEN EXISTS_TAC `B1 + (B2 + B)` THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(LE_IMP DIST_ADD2_REV) THEN MAP_EVERY EXISTS_TAC [`m * fn x n`; `n * fn x m`] THEN ONCE_REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[GSYM LEFT_ADD_DISTRIB] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LEFT_ADD_DISTRIB] THEN MATCH_MP_TAC(LE_IMP DIST_ADD2) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN MATCH_MP_TAC LE_ADD2 THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN REWRITE_TAC[GSYM DIST_LMUL; DIST_ADDBOUND; LE_MULT_LCANCEL]; ASM_REWRITE_TAC[DIST_RADD_0; LE_REFL]]);; let NADD_OF_NUM_ADD = prove (`!m n. &m ++ &n === &(m + n)`, REWRITE_TAC[nadd_eq; NADD_OF_NUM; NADD_ADD] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; DIST_REFL; LE_0]);; (* ------------------------------------------------------------------------- *) (* Multiplication. *) (* ------------------------------------------------------------------------- *) override_interface ("**",`nadd_mul:nadd->nadd->nadd`);; let nadd_mul = new_definition `x ** y = afn(\n. fn x (fn y n))`;; let NADD_MUL = prove (`!x y. fn(x ** y) = \n. fn x (fn y n)`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_mul; GSYM nadd_rep; is_nadd] THEN X_CHOOSE_TAC `B:num` (SPEC `y:nadd` NADD_CAUCHY) THEN X_CHOOSE_TAC `C:num` (SPEC `x:nadd` NADD_DIST) THEN X_CHOOSE_TAC `D:num` (SPEC `x:nadd` NADD_MULTIPLICATIVE) THEN MATCH_MP_TAC BOUNDS_NOTZERO THEN REWRITE_TAC[MULT_CLAUSES; DIST_REFL] THEN MAP_EVERY EXISTS_TAC [`D + C * B`; `D + D`] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(D * m + D) + (D * n + D) + C * B * (m + n)` THEN CONJ_TAC THENL [MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN EXISTS_TAC `fn x (m * fn y n)` THEN MATCH_MP_TAC LE_ADD2 THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN EXISTS_TAC `fn x (n * fn y m)` THEN MATCH_MP_TAC LE_ADD2 THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `C * dist(m * fn y n,n * fn y m)` THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]; MATCH_MP_TAC EQ_IMP_LE THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_ASSOC; ADD_AC]]);; (* ------------------------------------------------------------------------- *) (* Properties of multiplication. *) (* ------------------------------------------------------------------------- *) let NADD_MUL_SYM = prove (`!x y. (x ** y) === (y ** x)`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_MUL] THEN X_CHOOSE_THEN `A1:num` MP_TAC (SPECL [`x:nadd`; `y:nadd`] NADD_ALTMUL) THEN DISCH_THEN(X_CHOOSE_TAC `B1:num`) THEN X_CHOOSE_THEN `A2:num` MP_TAC (SPECL [`y:nadd`; `x:nadd`] NADD_ALTMUL) THEN DISCH_THEN(X_CHOOSE_TAC `B2:num`) THEN REWRITE_TAC[BOUNDS_DIVIDED] THEN REWRITE_TAC[DIST_LMUL] THEN MAP_EVERY EXISTS_TAC [`A1 + A2`; `B1 + B2`] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + (c + d) = (a + c) + (b + d)`] THEN MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN EXISTS_TAC `fn x n * fn y n` THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC [DIST_SYM] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [MULT_SYM] THEN ASM_REWRITE_TAC[]);; let NADD_MUL_ASSOC = prove (`!x y z. (x ** (y ** z)) === ((x ** y) ** z)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[nadd_mul] THEN REWRITE_TAC[NADD_MUL; NADD_EQ_REFL]);; let NADD_MUL_LID = prove (`!x. (&1 ** x) === x`, REWRITE_TAC[NADD_OF_NUM; nadd_mul; MULT_CLAUSES] THEN REWRITE_TAC[nadd_abs; NADD_EQ_REFL; ETA_AX]);; let NADD_LDISTRIB = prove (`!x y z. x ** (y ++ z) === (x ** y) ++ (x ** z)`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq] THEN REWRITE_TAC[NADD_ADD; NADD_MUL] THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_ADDITIVE) THEN EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]);; let NADD_MUL_WELLDEF_LEMMA = prove (`!x y y'. y === y' ==> (x ** y) === (x ** y')`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_MUL] THEN DISCH_THEN(X_CHOOSE_TAC `B1:num`) THEN X_CHOOSE_TAC `B2:num` (SPEC `x:nadd` NADD_DIST) THEN EXISTS_TAC `B2 * B1` THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `B2 * dist(fn y n,fn y' n)` THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]);; let NADD_MUL_WELLDEF = prove (`!x x' y y'. x === x' /\ y === y' ==> (x ** y) === (x' ** y')`, REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `x' ** y` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `y ** x'` THEN REWRITE_TAC[NADD_MUL_SYM] THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `y ** x` THEN REWRITE_TAC[NADD_MUL_SYM]; ALL_TAC] THEN MATCH_MP_TAC NADD_MUL_WELLDEF_LEMMA THEN ASM_REWRITE_TAC[]);; let NADD_OF_NUM_MUL = prove (`!m n. &m ** &n === &(m * n)`, REWRITE_TAC[nadd_eq; NADD_OF_NUM; NADD_MUL] THEN REWRITE_TAC[MULT_ASSOC; DIST_REFL; LE_0]);; (* ------------------------------------------------------------------------- *) (* A few handy lemmas. *) (* ------------------------------------------------------------------------- *) let NADD_LE_0 = prove (`!x. &0 <<= x`, GEN_TAC THEN REWRITE_TAC[nadd_le; NADD_OF_NUM; MULT_CLAUSES; LE_0]);; let NADD_EQ_IMP_LE = prove (`!x y. x === y ==> x <<= y`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; nadd_le; DIST_LE_CASES] THEN DISCH_THEN(X_CHOOSE_TAC `B:num`) THEN EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]);; let NADD_LE_LMUL = prove (`!x y z. y <<= z ==> (x ** y) <<= (x ** z)`, REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `d:nadd` o MATCH_MP NADD_LE_EXISTS) THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `x ** y ++ x ** d` THEN REWRITE_TAC[NADD_LE_ADD] THEN MATCH_MP_TAC NADD_EQ_IMP_LE THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `x ** (y ++ d)` THEN ONCE_REWRITE_TAC[NADD_EQ_SYM] THEN REWRITE_TAC[NADD_LDISTRIB] THEN MATCH_MP_TAC NADD_MUL_WELLDEF THEN ASM_REWRITE_TAC[NADD_EQ_REFL]);; let NADD_LE_RMUL = prove (`!x y z. x <<= y ==> (x ** z) <<= (y ** z)`, MESON_TAC[NADD_LE_LMUL; NADD_LE_WELLDEF; NADD_MUL_SYM]);; let NADD_LE_RADD = prove (`!x y z. x ++ z <<= y ++ z <=> x <<= y`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NADD_ADD] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o RAND_CONV) [ADD_SYM] THEN REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o RAND_CONV) [ADD_SYM] THEN REFL_TAC);; let NADD_LE_LADD = prove (`!x y z. x ++ y <<= x ++ z <=> y <<= z`, MESON_TAC[NADD_LE_RADD; NADD_ADD_SYM; NADD_LE_WELLDEF]);; let NADD_RDISTRIB = prove (`!x y z. (x ++ y) ** z === x ** z ++ y ** z`, MESON_TAC[NADD_LDISTRIB; NADD_MUL_SYM; NADD_ADD_WELLDEF; NADD_EQ_TRANS; NADD_EQ_REFL; NADD_EQ_SYM]);; (* ------------------------------------------------------------------------- *) (* The Archimedean property in a more useful form. *) (* ------------------------------------------------------------------------- *) let NADD_ARCH_MULT = prove (`!x k. ~(x === &0) ==> ?N. &k <<= &N ** x`, REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; nadd_le; NOT_EXISTS_THM] THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN DISCH_THEN(MP_TAC o SPEC `B + k`) THEN REWRITE_TAC[NOT_FORALL_THM; NADD_OF_NUM] THEN REWRITE_TAC[MULT_CLAUSES; DIST_RZERO; NOT_LE] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN MAP_EVERY EXISTS_TAC [`N:num`; `B * N`] THEN X_GEN_TAC `i:num` THEN REWRITE_TAC[NADD_MUL; NADD_OF_NUM] THEN MATCH_MP_TAC(GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ADD_RCANCEL)))) THEN EXISTS_TAC `B * i` THEN REWRITE_TAC[GSYM ADD_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `i * fn x N` THEN RULE_ASSUM_TAC(REWRITE_RULE[DIST_LE_CASES]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[ADD_SYM] THEN FIRST_ASSUM ACCEPT_TAC);; let NADD_ARCH_ZERO = prove (`!x k. (!n. &n ** x <<= k) ==> (x === &0)`, REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THEN X_CHOOSE_TAC `p:num` (SPEC `k:nadd` NADD_ARCH) THEN FIRST_ASSUM(MP_TAC o MATCH_MP NADD_ARCH_MULT) THEN DISCH_THEN(X_CHOOSE_TAC `N:num` o SPEC `p:num`) THEN EXISTS_TAC `N + 1` THEN DISCH_TAC THEN UNDISCH_TAC `~(x === &0)` THEN REWRITE_TAC[GSYM NADD_LE_ANTISYM; NADD_LE_0] THEN MATCH_MP_TAC(GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL NADD_LE_RADD)))) THEN EXISTS_TAC `&N ** x` THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `k:nadd` THEN CONJ_TAC THENL [SUBGOAL_THEN `&(N + 1) ** x === x ++ &N ** x` MP_TAC THENL [ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `&1 ** x ++ &N ** x` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `(&1 ++ &N) ** x` THEN CONJ_TAC THENL [MESON_TAC[NADD_OF_NUM_ADD; NADD_MUL_WELLDEF; NADD_EQ_REFL; NADD_EQ_SYM]; MESON_TAC[NADD_RDISTRIB; NADD_MUL_SYM; NADD_EQ_SYM; NADD_EQ_TRANS]]; MESON_TAC[NADD_ADD_WELLDEF; NADD_EQ_REFL; NADD_MUL_LID]]; ASM_MESON_TAC[NADD_LE_WELLDEF; NADD_EQ_REFL]]; ASM_MESON_TAC[NADD_LE_TRANS; NADD_LE_WELLDEF; NADD_EQ_REFL; NADD_ADD_LID]]);; let NADD_ARCH_LEMMA = prove (`!x y z. (!n. &n ** x <<= &n ** y ++ z) ==> x <<= y`, REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPECL [`x:nadd`; `y:nadd`] NADD_LE_TOTAL) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(X_CHOOSE_TAC `d:nadd` o MATCH_MP NADD_LE_EXISTS) THEN MATCH_MP_TAC NADD_EQ_IMP_LE THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `y ++ d` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `y ++ &0` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_ADD_WELLDEF THEN REWRITE_TAC[NADD_EQ_REFL] THEN MATCH_MP_TAC NADD_ARCH_ZERO THEN EXISTS_TAC `z:nadd` THEN ASM_MESON_TAC[NADD_MUL_WELLDEF; NADD_LE_WELLDEF; NADD_LDISTRIB; NADD_LE_LADD; NADD_EQ_REFL]; ASM_MESON_TAC[NADD_ADD_LID; NADD_ADD_WELLDEF; NADD_EQ_TRANS; NADD_ADD_SYM]]);; (* ------------------------------------------------------------------------- *) (* Completeness. *) (* ------------------------------------------------------------------------- *) let NADD_COMPLETE = prove (`!P. (?x. P x) /\ (?M. !x. P x ==> x <<= M) ==> ?M. (!x. P x ==> x <<= M) /\ !M'. (!x. P x ==> x <<= M') ==> M <<= M'`, GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:nadd`) (X_CHOOSE_TAC `m:nadd`)) THEN SUBGOAL_THEN `!n. ?r. (?x. P x /\ &r <<= &n ** x) /\ !r'. (?x. P x /\ &r' <<= &n ** x) ==> r' <= r` MP_TAC THENL [GEN_TAC THEN REWRITE_TAC[GSYM num_MAX] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`0`; `a:nadd`] THEN ASM_REWRITE_TAC[NADD_LE_0]; X_CHOOSE_TAC `N:num` (SPEC `m:nadd` NADD_ARCH) THEN EXISTS_TAC `n * N` THEN X_GEN_TAC `p:num` THEN DISCH_THEN(X_CHOOSE_THEN `w:nadd` STRIP_ASSUME_TAC) THEN ONCE_REWRITE_TAC[GSYM NADD_OF_NUM_LE] THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** w` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** &N` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_LE_LMUL THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `m:nadd` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC NADD_EQ_IMP_LE THEN MATCH_ACCEPT_TAC NADD_OF_NUM_MUL]]; ONCE_REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` (fun th -> let th1,th2 = CONJ_PAIR(SPEC `n:num` th) in MAP_EVERY (MP_TAC o GEN `n:num`) [th1; th2])) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`n:num`; `SUC(r(n:num))`]) THEN REWRITE_TAC[LE_SUC_LT; LT_REFL; NOT_EXISTS_THM] THEN DISCH_THEN(ASSUME_TAC o GENL [`n:num`; `x:nadd`] o MATCH_MP (ITAUT `(a \/ b) /\ ~(c /\ b) ==> c ==> a`) o CONJ (SPECL [`&n ** x`; `&(SUC(r(n:num)))`] NADD_LE_TOTAL) o SPEC_ALL) THEN DISCH_TAC] THEN SUBGOAL_THEN `!n i. i * r(n) <= n * r(i) + n` ASSUME_TAC THENL [REPEAT GEN_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `x:nadd` STRIP_ASSUME_TAC o SPEC `n:num`) THEN ONCE_REWRITE_TAC[GSYM NADD_OF_NUM_LE] THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&i ** &n ** x` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&i ** &(r(n:num))` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[NADD_EQ_SYM] THEN MATCH_ACCEPT_TAC NADD_OF_NUM_MUL; MATCH_MP_TAC NADD_LE_LMUL THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** &(SUC(r(i:num)))` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** &i ** x` THEN CONJ_TAC THENL [MATCH_MP_TAC NADD_EQ_IMP_LE THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `(&i ** &n) ** x` THEN REWRITE_TAC[NADD_MUL_ASSOC] THEN MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `(&n ** &i) ** x` THEN REWRITE_TAC[ONCE_REWRITE_RULE[NADD_EQ_SYM] NADD_MUL_ASSOC] THEN MATCH_MP_TAC NADD_MUL_WELLDEF THEN REWRITE_TAC[NADD_MUL_SYM; NADD_EQ_REFL]; MATCH_MP_TAC NADD_LE_LMUL THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM MULT_SUC] THEN MATCH_MP_TAC NADD_EQ_IMP_LE THEN REWRITE_TAC[NADD_OF_NUM_MUL]]]; ALL_TAC] THEN EXISTS_TAC `afn r` THEN SUBGOAL_THEN `fn(afn r) = r` ASSUME_TAC THENL [REWRITE_TAC[GSYM nadd_rep] THEN REWRITE_TAC[is_nadd; DIST_LE_CASES] THEN EXISTS_TAC `1` THEN REWRITE_TAC[MULT_CLAUSES] THEN REWRITE_TAC[FORALL_AND_THM] THEN GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o funpow 2 RAND_CONV) [ADD_SYM] THEN REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`i:num`; `n:num`] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n * r(i:num) + n` THEN ASM_REWRITE_TAC[ADD_ASSOC; LE_ADD]; ALL_TAC] THEN CONJ_TAC THENL [X_GEN_TAC `x:nadd` THEN DISCH_TAC THEN MATCH_MP_TAC NADD_ARCH_LEMMA THEN EXISTS_TAC `&2` THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&(SUC(r(n:num)))` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[nadd_le; NADD_ADD; NADD_MUL; NADD_OF_NUM] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD1; RIGHT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_2; MULT_CLAUSES; ADD_ASSOC; LE_ADD_RCANCEL] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ONCE_REWRITE_TAC[BOUNDS_IGNORE] THEN MAP_EVERY EXISTS_TAC [`0`; `n:num`] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n * r(i:num) + n` THEN ASM_REWRITE_TAC[LE_ADD_LCANCEL; ADD_CLAUSES]]; X_GEN_TAC `z:nadd` THEN DISCH_TAC THEN MATCH_MP_TAC NADD_ARCH_LEMMA THEN EXISTS_TAC `&1` THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&(r(n:num)) ++ &1` THEN CONJ_TAC THENL [ASM_REWRITE_TAC[nadd_le; NADD_ADD; NADD_MUL; NADD_OF_NUM] THEN EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [MULT_SYM] THEN ASM_REWRITE_TAC[]; REWRITE_TAC[NADD_LE_RADD] THEN FIRST_ASSUM(X_CHOOSE_THEN `x:nadd` MP_TAC o SPEC `n:num`) THEN DISCH_THEN STRIP_ASSUME_TAC THEN MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** x` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NADD_LE_LMUL THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);; (* ------------------------------------------------------------------------- *) (* A bit more on nearly-multiplicative functions. *) (* ------------------------------------------------------------------------- *) let NADD_UBOUND = prove (`!x. ?B N. !n. N <= n ==> fn x n <= B * n`, GEN_TAC THEN X_CHOOSE_THEN `A1:num` (X_CHOOSE_TAC `A2:num`) (SPEC `x:nadd` NADD_BOUND) THEN EXISTS_TAC `A1 + A2` THEN EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A1 * n + A2` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM(el 3 (CONJUNCTS MULT_CLAUSES))] THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]);; let NADD_NONZERO = prove (`!x. ~(x === &0) ==> ?N. !n. N <= n ==> ~(fn x n = 0)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_ARCH_MULT) THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[nadd_le; NADD_MUL; NADD_OF_NUM; MULT_CLAUSES] THEN DISCH_THEN(X_CHOOSE_THEN `A1:num` (X_CHOOSE_TAC `A2:num`)) THEN EXISTS_TAC `A2 + 1` THEN X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN REWRITE_TAC[NOT_FORALL_THM; NOT_LE; GSYM LE_SUC_LT; ADD1] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]);; let NADD_LBOUND = prove (`!x. ~(x === &0) ==> ?A N. !n. N <= n ==> n <= A * fn x n`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `N:num` o MATCH_MP NADD_NONZERO) THEN FIRST_ASSUM(MP_TAC o MATCH_MP NADD_ARCH_MULT) THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[nadd_le; NADD_MUL; NADD_OF_NUM; MULT_CLAUSES] THEN DISCH_THEN(X_CHOOSE_THEN `A1:num` (X_CHOOSE_TAC `A2:num`)) THEN EXISTS_TAC `A1 + A2` THEN EXISTS_TAC `N:num` THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A1 * fn x n + A2` THEN ASM_REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN GEN_REWRITE_TAC LAND_CONV [GSYM(el 3 (CONJUNCTS MULT_CLAUSES))] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN REWRITE_TAC[GSYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN ASM_REWRITE_TAC[GSYM NOT_LT; LT]);; (* ------------------------------------------------------------------------- *) (* Auxiliary function for the multiplicative inverse. *) (* ------------------------------------------------------------------------- *) let nadd_rinv = new_definition `nadd_rinv(x) = \n. (n * n) DIV (fn x n)`;; let NADD_MUL_LINV_LEMMA0 = prove (`!x. ~(x === &0) ==> ?A B. !n. nadd_rinv x n <= A * n + B`, GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[BOUNDS_IGNORE] THEN FIRST_ASSUM(MP_TAC o MATCH_MP NADD_LBOUND) THEN DISCH_THEN(X_CHOOSE_THEN `A:num` (X_CHOOSE_TAC `N:num`)) THEN MAP_EVERY EXISTS_TAC [`A:num`; `0`; `SUC N`] THEN GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN MP_TAC(SPECL [`nadd_rinv x n`; `A * n`; `n:num`] LE_MULT_RCANCEL) THEN UNDISCH_TAC `SUC N <= n` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LE; NOT_SUC] THEN DISCH_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `nadd_rinv x n * A * fn x n` THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN CONJ_TAC THENL [DISJ2_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC N` THEN ASM_REWRITE_TAC[LE; LE_REFL]; GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN REWRITE_TAC[GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN DISJ2_TAC THEN ASM_CASES_TAC `fn x n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LE_0; nadd_rinv] THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN DISCH_THEN(fun t -> GEN_REWRITE_TAC RAND_CONV [CONJUNCT1(SPEC_ALL t)]) THEN GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN REWRITE_TAC[LE_ADD]]);; let NADD_MUL_LINV_LEMMA1 = prove (`!x n. ~(fn x n = 0) ==> dist(fn x n * nadd_rinv(x) n, n * n) <= fn x n`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVISION) THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC o SPEC `n * n`) THEN REWRITE_TAC[nadd_rinv] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [MULT_SYM] THEN REWRITE_TAC[DIST_RADD_0] THEN MATCH_MP_TAC LT_IMP_LE THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let NADD_MUL_LINV_LEMMA2 = prove (`!x. ~(x === &0) ==> ?N. !n. N <= n ==> dist(fn x n * nadd_rinv(x) n, n * n) <= fn x n`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_NONZERO) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC NADD_MUL_LINV_LEMMA1 THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let NADD_MUL_LINV_LEMMA3 = prove (`!x. ~(x === &0) ==> ?N. !m n. N <= n ==> dist(m * fn x m * fn x n * nadd_rinv(x) n, m * fn x m * n * n) <= m * fn x m * fn x n`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA2) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIST_LMUL; MULT_ASSOC] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let NADD_MUL_LINV_LEMMA4 = prove (`!x. ~(x === &0) ==> ?N. !m n. N <= m /\ N <= n ==> (fn x m * fn x n) * dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= (m * n) * dist(m * fn x n,n * fn x m) + (fn x m * fn x n) * (m + n)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA3) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_LMUL; LEFT_ADD_DISTRIB] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [DIST_SYM] THEN MATCH_MP_TAC DIST_TRIANGLES_LE THEN CONJ_TAC THENL [ANTE_RES_THEN(MP_TAC o SPEC `m:num`) (ASSUME `N <= n`); ANTE_RES_THEN(MP_TAC o SPEC `n:num`) (ASSUME `N <= m`)] THEN MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[MULT_AC]);; let NADD_MUL_LINV_LEMMA5 = prove (`!x. ~(x === &0) ==> ?B N. !m n. N <= m /\ N <= n ==> (fn x m * fn x n) * dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= B * (m * n) * (m + n)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA4) THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN X_CHOOSE_THEN `B2:num` (X_CHOOSE_TAC `N2:num`) (SPEC `x:nadd` NADD_UBOUND) THEN EXISTS_TAC `B1 + B2 * B2` THEN EXISTS_TAC `N1 + N2` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(m * n) * dist(m * fn x n,n * fn x m) + (fn x m * fn x n) * (m + n)` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2` THEN ASM_REWRITE_TAC[LE_ADD; LE_ADDR]; REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN MATCH_MP_TAC LE_ADD2] THEN CONJ_TAC THENL [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM MULT_ASSOC] THEN GEN_REWRITE_TAC (funpow 2 RAND_CONV) [MULT_SYM] THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]; ONCE_REWRITE_TAC[AC MULT_AC `(a * b) * (c * d) * e = ((a * c) * (b * d)) * e`] THEN REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN MATCH_MP_TAC LE_MULT2 THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2` THEN ASM_REWRITE_TAC[LE_ADD; LE_ADDR]]);; let NADD_MUL_LINV_LEMMA6 = prove (`!x. ~(x === &0) ==> ?B N. !m n. N <= m /\ N <= n ==> (m * n) * dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= B * (m * n) * (m + n)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA5) THEN DISCH_THEN(X_CHOOSE_THEN `B1:num` (X_CHOOSE_TAC `N1:num`)) THEN FIRST_ASSUM(MP_TAC o MATCH_MP NADD_LBOUND) THEN DISCH_THEN(X_CHOOSE_THEN `B2:num` (X_CHOOSE_TAC `N2:num`)) THEN EXISTS_TAC `B1 * B2 * B2` THEN EXISTS_TAC `N1 + N2` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(B2 * B2) * (fn x m * fn x n) * dist (m * nadd_rinv x n,n * nadd_rinv x m)` THEN CONJ_TAC THENL [REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN ONCE_REWRITE_TAC[AC MULT_AC `((a * b) * c) * d = (a * c) * (b * d)`] THEN MATCH_MP_TAC LE_MULT2 THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC; ONCE_REWRITE_TAC[AC MULT_AC `(a * b * c) * (d * e) * f = (b * c) * (a * (d * e) * f)`] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2` THEN ASM_REWRITE_TAC[LE_ADD; LE_ADDR]);; let NADD_MUL_LINV_LEMMA7 = prove (`!x. ~(x === &0) ==> ?B N. !m n. N <= m /\ N <= n ==> dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= B * (m + n)`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA6) THEN DISCH_THEN(X_CHOOSE_THEN `B:num` (X_CHOOSE_TAC `N:num`)) THEN MAP_EVERY EXISTS_TAC [`B:num`; `N + 1`] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN SUBGOAL_THEN `N <= m /\ N <= n` MP_TAC THENL [CONJ_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N + 1` THEN ASM_REWRITE_TAC[LE_ADD]; DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ONCE_REWRITE_TAC[AC MULT_AC `a * b * c = b * a * c`] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN DISCH_THEN(DISJ_CASES_THEN2 MP_TAC ACCEPT_TAC) THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[GSYM(CONJUNCT1 LE)] THEN REWRITE_TAC[NOT_LE; GSYM LE_SUC_LT] THEN REWRITE_TAC[EQT_ELIM(REWRITE_CONV[ARITH] `SUC 0 = 1 * 1`)] THEN MATCH_MP_TAC LE_MULT2 THEN CONJ_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N + 1` THEN ASM_REWRITE_TAC[LE_ADDR]]);; let NADD_MUL_LINV_LEMMA7a = prove (`!x. ~(x === &0) ==> !N. ?A B. !m n. m <= N ==> dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= A * n + B`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA0) THEN DISCH_THEN(X_CHOOSE_THEN `A0:num` (X_CHOOSE_TAC `B0:num`)) THEN INDUCT_TAC THENL [MAP_EVERY EXISTS_TAC [`nadd_rinv x 0`; `0`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[MULT_CLAUSES; DIST_LZERO; ADD_CLAUSES] THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN MATCH_ACCEPT_TAC LE_REFL; FIRST_ASSUM(X_CHOOSE_THEN `A:num` (X_CHOOSE_TAC `B:num`)) THEN EXISTS_TAC `A + (nadd_rinv(x)(SUC N) + SUC N * A0)` THEN EXISTS_TAC `SUC N * B0 + B` THEN REPEAT GEN_TAC THEN REWRITE_TAC[LE] THEN DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC) THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC N * nadd_rinv x n + n * nadd_rinv x (SUC N)` THEN REWRITE_TAC[DIST_ADDBOUND] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN ONCE_REWRITE_TAC[AC ADD_AC `(a + b + c) + d + e = (c + d) + (b + a + e)`] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL [REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN ASM_REWRITE_TAC[LE_MULT_LCANCEL]; GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN MATCH_ACCEPT_TAC LE_ADD]; MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * n + B` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]]]);; let NADD_MUL_LINV_LEMMA8 = prove (`!x. ~(x === &0) ==> ?B. !m n. dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= B * (m + n)`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA7) THEN DISCH_THEN(X_CHOOSE_THEN `B0:num` (X_CHOOSE_TAC `N:num`)) THEN FIRST_ASSUM(MP_TAC o SPEC `N:num` o MATCH_MP NADD_MUL_LINV_LEMMA7a) THEN DISCH_THEN(X_CHOOSE_THEN `A:num` (X_CHOOSE_TAC `B:num`)) THEN MATCH_MP_TAC BOUNDS_NOTZERO THEN REWRITE_TAC[DIST_REFL] THEN EXISTS_TAC `A + B0` THEN EXISTS_TAC `B:num` THEN REPEAT GEN_TAC THEN DISJ_CASES_THEN2 ASSUME_TAC MP_TAC (SPECL [`N:num`; `m:num`] LE_CASES) THENL [DISJ_CASES_THEN2 ASSUME_TAC MP_TAC (SPECL [`N:num`; `n:num`] LE_CASES) THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `B0 * (m + n)` THEN CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; GEN_REWRITE_TAC (RAND_CONV o funpow 2 LAND_CONV) [ADD_SYM] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]; DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * m + B` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[LE_ADD_RCANCEL] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]; DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * n + B` THEN ASM_REWRITE_TAC[LE_ADD_RCANCEL] THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ADD_SYM] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]);; (* ------------------------------------------------------------------------- *) (* Now the multiplicative inverse proper. *) (* ------------------------------------------------------------------------- *) let nadd_inv = new_definition `nadd_inv(x) = if x === &0 then &0 else afn(nadd_rinv x)`;; override_interface ("inv",`nadd_inv:nadd->nadd`);; let NADD_INV = prove (`!x. fn(nadd_inv x) = if x === &0 then (\n. 0) else nadd_rinv x`, GEN_TAC THEN REWRITE_TAC[nadd_inv] THEN ASM_CASES_TAC `x === &0` THEN ASM_REWRITE_TAC[NADD_OF_NUM; MULT_CLAUSES] THEN REWRITE_TAC[GSYM nadd_rep; is_nadd] THEN MATCH_MP_TAC NADD_MUL_LINV_LEMMA8 THEN POP_ASSUM ACCEPT_TAC);; let NADD_MUL_LINV = prove (`!x. ~(x === &0) ==> inv(x) ** x === &1`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[nadd_eq; NADD_MUL] THEN ONCE_REWRITE_TAC[BOUNDS_DIVIDED] THEN X_CHOOSE_THEN `A1:num` (X_CHOOSE_TAC `B1:num`) (SPECL [`inv(x)`; `x:nadd`] NADD_ALTMUL) THEN REWRITE_TAC[DIST_LMUL; NADD_OF_NUM; MULT_CLAUSES] THEN FIRST_ASSUM(X_CHOOSE_TAC `N:num` o MATCH_MP NADD_MUL_LINV_LEMMA2) THEN X_CHOOSE_THEN `A':num` (X_CHOOSE_TAC `B':num`) (SPEC `x:nadd` NADD_BOUND) THEN SUBGOAL_THEN `?A2 B2. !n. dist(fn x n * nadd_rinv x n,n * n) <= A2 * n + B2` STRIP_ASSUME_TAC THENL [EXISTS_TAC `A':num` THEN ONCE_REWRITE_TAC[BOUNDS_IGNORE] THEN MAP_EVERY EXISTS_TAC [`B':num`; `N:num`] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `fn x n` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MAP_EVERY EXISTS_TAC [`A1 + A2`; `B1 + B2`] THEN GEN_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_LE THEN EXISTS_TAC `fn (inv x) n * fn x n` THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + c + d = (a + c) + (b + d)`] THEN MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [MULT_SYM] THEN ASM_REWRITE_TAC[NADD_INV]]);; let NADD_INV_0 = prove (`inv(&0) === &0`, REWRITE_TAC[nadd_inv; NADD_EQ_REFL]);; (* ------------------------------------------------------------------------- *) (* Welldefinedness follows from already established principles because if *) (* x = y then y' = y' 1 = y' (x' x) = y' (x' y) = (y' y) x' = 1 x' = x' *) (* ------------------------------------------------------------------------- *) let NADD_INV_WELLDEF = prove (`!x y. x === y ==> inv(x) === inv(y)`, let TAC tm ths = MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC ths] in REPEAT STRIP_TAC THEN ASM_CASES_TAC `x === &0` THENL [SUBGOAL_THEN `y === &0` ASSUME_TAC THENL [ASM_MESON_TAC[NADD_EQ_TRANS; NADD_EQ_SYM]; ASM_REWRITE_TAC[nadd_inv; NADD_EQ_REFL]]; SUBGOAL_THEN `~(y === &0)` ASSUME_TAC THENL [ASM_MESON_TAC[NADD_EQ_TRANS; NADD_EQ_SYM]; ALL_TAC]] THEN TAC `inv(y) ** &1` [NADD_MUL_SYM; NADD_MUL_LID; NADD_EQ_TRANS] THEN TAC `inv(y) ** (inv(x) ** x)` [NADD_MUL_LINV; NADD_MUL_WELLDEF; NADD_EQ_REFL] THEN TAC `inv(y) ** (inv(x) ** y)` [NADD_MUL_WELLDEF; NADD_EQ_REFL; NADD_EQ_SYM] THEN TAC `(inv(y) ** y) ** inv(x)` [NADD_MUL_ASSOC; NADD_MUL_SYM; NADD_EQ_TRANS; NADD_MUL_WELLDEF; NADD_EQ_REFL] THEN ASM_MESON_TAC[NADD_MUL_LINV; NADD_MUL_WELLDEF; NADD_EQ_REFL; NADD_MUL_LID; NADD_EQ_TRANS; NADD_EQ_SYM]);; (* ------------------------------------------------------------------------- *) (* Definition of the new type. *) (* ------------------------------------------------------------------------- *) let hreal_tybij = define_quotient_type "hreal" ("mk_hreal","dest_hreal") `(===)`;; do_list overload_interface ["+",`hreal_add:hreal->hreal->hreal`; "*",`hreal_mul:hreal->hreal->hreal`; "<=",`hreal_le:hreal->hreal->bool`];; do_list override_interface ["&",`hreal_of_num:num->hreal`; "inv",`hreal_inv:hreal->hreal`];; let hreal_of_num,hreal_of_num_th = lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) "hreal_of_num" NADD_OF_NUM_WELLDEF;; let hreal_add,hreal_add_th = lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) "hreal_add" NADD_ADD_WELLDEF;; let hreal_mul,hreal_mul_th = lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) "hreal_mul" NADD_MUL_WELLDEF;; let hreal_le,hreal_le_th = lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) "hreal_le" NADD_LE_WELLDEF;; let hreal_inv,hreal_inv_th = lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) "hreal_inv" NADD_INV_WELLDEF;; let HREAL_COMPLETE = let th1 = ASSUME `(P:nadd->bool) = (\x. Q(mk_hreal((===) x)))` in let th2 = BETA_RULE(AP_THM th1 `x:nadd`) in let th3 = lift_theorem hreal_tybij (NADD_EQ_REFL,NADD_EQ_SYM,NADD_EQ_TRANS) [hreal_of_num_th; hreal_add_th; hreal_mul_th; hreal_le_th; th2] (SPEC_ALL NADD_COMPLETE) in let th4 = MATCH_MP (DISCH_ALL th3) (REFL `\x. Q(mk_hreal((===) x)):bool`) in CONV_RULE(GEN_ALPHA_CONV `P:hreal->bool`) (GEN_ALL th4);; let [HREAL_OF_NUM_EQ; HREAL_OF_NUM_LE; HREAL_OF_NUM_ADD; HREAL_OF_NUM_MUL; HREAL_LE_REFL; HREAL_LE_TRANS; HREAL_LE_ANTISYM; HREAL_LE_TOTAL; HREAL_LE_ADD; HREAL_LE_EXISTS; HREAL_ARCH; HREAL_ADD_SYM; HREAL_ADD_ASSOC; HREAL_ADD_LID; HREAL_ADD_LCANCEL; HREAL_MUL_SYM; HREAL_MUL_ASSOC; HREAL_MUL_LID; HREAL_ADD_LDISTRIB; HREAL_MUL_LINV; HREAL_INV_0] = map (lift_theorem hreal_tybij (NADD_EQ_REFL,NADD_EQ_SYM,NADD_EQ_TRANS) [hreal_of_num_th; hreal_add_th; hreal_mul_th; hreal_le_th; hreal_inv_th]) [NADD_OF_NUM_EQ; NADD_OF_NUM_LE; NADD_OF_NUM_ADD; NADD_OF_NUM_MUL; NADD_LE_REFL; NADD_LE_TRANS; NADD_LE_ANTISYM; NADD_LE_TOTAL; NADD_LE_ADD; NADD_LE_EXISTS; NADD_ARCH; NADD_ADD_SYM; NADD_ADD_ASSOC; NADD_ADD_LID; NADD_ADD_LCANCEL; NADD_MUL_SYM; NADD_MUL_ASSOC; NADD_MUL_LID; NADD_LDISTRIB; NADD_MUL_LINV; NADD_INV_0];; (* ------------------------------------------------------------------------- *) (* Consequential theorems needed later. *) (* ------------------------------------------------------------------------- *) let HREAL_LE_EXISTS_DEF = prove (`!m n. m <= n <=> ?d. n = m + d`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HREAL_LE_EXISTS] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[HREAL_LE_ADD]);; let HREAL_EQ_ADD_LCANCEL = prove (`!m n p. (m + n = m + p) <=> (n = p)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HREAL_ADD_LCANCEL] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; let HREAL_EQ_ADD_RCANCEL = prove (`!m n p. (m + p = n + p) <=> (m = n)`, ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL]);; let HREAL_LE_ADD_LCANCEL = prove (`!m n p. (m + n <= m + p) <=> (n <= p)`, REWRITE_TAC[HREAL_LE_EXISTS_DEF; GSYM HREAL_ADD_ASSOC; HREAL_EQ_ADD_LCANCEL]);; let HREAL_LE_ADD_RCANCEL = prove (`!m n p. (m + p <= n + p) <=> (m <= n)`, ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN MATCH_ACCEPT_TAC HREAL_LE_ADD_LCANCEL);; let HREAL_ADD_RID = prove (`!n. n + &0 = n`, ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN MATCH_ACCEPT_TAC HREAL_ADD_LID);; let HREAL_ADD_RDISTRIB = prove (`!m n p. (m + n) * p = m * p + n * p`, ONCE_REWRITE_TAC[HREAL_MUL_SYM] THEN MATCH_ACCEPT_TAC HREAL_ADD_LDISTRIB);; let HREAL_MUL_LZERO = prove (`!m. &0 * m = &0`, GEN_TAC THEN MP_TAC(SPECL [`&0`; `&1`; `m:hreal`] HREAL_ADD_RDISTRIB) THEN REWRITE_TAC[HREAL_ADD_LID] THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM HREAL_ADD_LID] THEN REWRITE_TAC[HREAL_EQ_ADD_RCANCEL] THEN DISCH_THEN(ACCEPT_TAC o SYM));; let HREAL_MUL_RZERO = prove (`!m. m * &0 = &0`, ONCE_REWRITE_TAC[HREAL_MUL_SYM] THEN MATCH_ACCEPT_TAC HREAL_MUL_LZERO);; let HREAL_ADD_AC = prove (`(m + n = n + m) /\ ((m + n) + p = m + (n + p)) /\ (m + (n + p) = n + (m + p))`, REWRITE_TAC[HREAL_ADD_ASSOC; EQT_INTRO(SPEC_ALL HREAL_ADD_SYM)] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC HREAL_ADD_SYM);; let HREAL_LE_ADD2 = prove (`!a b c d. a <= b /\ c <= d ==> a + c <= b + d`, REPEAT GEN_TAC THEN REWRITE_TAC[HREAL_LE_EXISTS_DEF] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d1:hreal`) (X_CHOOSE_TAC `d2:hreal`)) THEN EXISTS_TAC `d1 + d2` THEN ASM_REWRITE_TAC[HREAL_ADD_AC]);; let HREAL_LE_MUL_RCANCEL_IMP = prove (`!a b c. a <= b ==> a * c <= b * c`, REPEAT GEN_TAC THEN REWRITE_TAC[HREAL_LE_EXISTS_DEF] THEN DISCH_THEN(X_CHOOSE_THEN `d:hreal` SUBST1_TAC) THEN EXISTS_TAC `d * c` THEN REWRITE_TAC[HREAL_ADD_RDISTRIB]);; (* ------------------------------------------------------------------------- *) (* Define operations on representatives of signed reals. *) (* ------------------------------------------------------------------------- *) let treal_of_num = new_definition `treal_of_num n = (&n, &0)`;; let treal_neg = new_definition `treal_neg ((x:hreal),(y:hreal)) = (y,x)`;; let treal_add = new_definition `(x1,y1) treal_add (x2,y2) = (x1 + x2, y1 + y2)`;; let treal_mul = new_definition `(x1,y1) treal_mul (x2,y2) = ((x1 * x2) + (y1 * y2),(x1 * y2) + (y1 * x2))`;; let treal_le = new_definition `(x1,y1) treal_le (x2,y2) <=> x1 + y2 <= x2 + y1`;; let treal_inv = new_definition `treal_inv(x,y) = if x = y then (&0, &0) else if y <= x then (inv(@d. x = y + d), &0) else (&0, inv(@d. y = x + d))`;; (* ------------------------------------------------------------------------- *) (* Define the equivalence relation and prove it *is* one. *) (* ------------------------------------------------------------------------- *) let treal_eq = new_definition `(x1,y1) treal_eq (x2,y2) <=> (x1 + y2 = x2 + y1)`;; let TREAL_EQ_REFL = prove (`!x. x treal_eq x`, REWRITE_TAC[FORALL_PAIR_THM; treal_eq]);; let TREAL_EQ_SYM = prove (`!x y. x treal_eq y <=> y treal_eq x`, REWRITE_TAC[FORALL_PAIR_THM; treal_eq; EQ_SYM_EQ]);; let TREAL_EQ_TRANS = prove (`!x y z. x treal_eq y /\ y treal_eq z ==> x treal_eq z`, REWRITE_TAC[FORALL_PAIR_THM; treal_eq] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MK_COMB o (AP_TERM `(+)` F_F I) o CONJ_PAIR) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HREAL_ADD_SYM] THEN REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[HREAL_ADD_ASSOC; HREAL_EQ_ADD_RCANCEL] THEN DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[HREAL_ADD_SYM]));; (* ------------------------------------------------------------------------- *) (* Useful to avoid unnecessary use of the equivalence relation. *) (* ------------------------------------------------------------------------- *) let TREAL_EQ_AP = prove (`!x y. (x = y) ==> x treal_eq y`, SIMP_TAC[TREAL_EQ_REFL]);; (* ------------------------------------------------------------------------- *) (* Commutativity properties for injector. *) (* ------------------------------------------------------------------------- *) let TREAL_OF_NUM_EQ = prove (`!m n. (treal_of_num m treal_eq treal_of_num n) <=> (m = n)`, REWRITE_TAC[treal_of_num; treal_eq; HREAL_OF_NUM_EQ; HREAL_ADD_RID]);; let TREAL_OF_NUM_LE = prove (`!m n. (treal_of_num m treal_le treal_of_num n) <=> m <= n`, REWRITE_TAC[treal_of_num; treal_le; HREAL_OF_NUM_LE; HREAL_ADD_RID]);; let TREAL_OF_NUM_ADD = prove (`!m n. (treal_of_num m treal_add treal_of_num n) treal_eq (treal_of_num(m + n))`, REWRITE_TAC[treal_of_num; treal_eq; treal_add; HREAL_OF_NUM_ADD; HREAL_ADD_RID; ADD_CLAUSES]);; let TREAL_OF_NUM_MUL = prove (`!m n. (treal_of_num m treal_mul treal_of_num n) treal_eq (treal_of_num(m * n))`, REWRITE_TAC[treal_of_num; treal_eq; treal_mul; HREAL_OF_NUM_MUL; HREAL_MUL_RZERO; HREAL_MUL_LZERO; HREAL_ADD_RID; HREAL_ADD_LID; HREAL_ADD_RID; MULT_CLAUSES]);; (* ------------------------------------------------------------------------- *) (* Strong forms of equality are useful to simplify welldefinedness proofs. *) (* ------------------------------------------------------------------------- *) let TREAL_ADD_SYM_EQ = prove (`!x y. x treal_add y = y treal_add x`, REWRITE_TAC[FORALL_PAIR_THM; treal_add; PAIR_EQ; HREAL_ADD_SYM]);; let TREAL_MUL_SYM_EQ = prove (`!x y. x treal_mul y = y treal_mul x`, REWRITE_TAC[FORALL_PAIR_THM; treal_mul; HREAL_MUL_SYM; HREAL_ADD_SYM]);; (* ------------------------------------------------------------------------- *) (* Prove the properties of operations on representatives. *) (* ------------------------------------------------------------------------- *) let TREAL_ADD_SYM = prove (`!x y. (x treal_add y) treal_eq (y treal_add x)`, REPEAT GEN_TAC THEN MATCH_MP_TAC TREAL_EQ_AP THEN MATCH_ACCEPT_TAC TREAL_ADD_SYM_EQ);; let TREAL_ADD_ASSOC = prove (`!x y z. (x treal_add (y treal_add z)) treal_eq ((x treal_add y) treal_add z)`, SIMP_TAC[FORALL_PAIR_THM; TREAL_EQ_AP; treal_add; HREAL_ADD_ASSOC]);; let TREAL_ADD_LID = prove (`!x. ((treal_of_num 0) treal_add x) treal_eq x`, REWRITE_TAC[FORALL_PAIR_THM; treal_of_num; treal_add; treal_eq; HREAL_ADD_LID]);; let TREAL_ADD_LINV = prove (`!x. ((treal_neg x) treal_add x) treal_eq (treal_of_num 0)`, REWRITE_TAC[FORALL_PAIR_THM; treal_neg; treal_add; treal_eq; treal_of_num; HREAL_ADD_LID; HREAL_ADD_RID; HREAL_ADD_SYM]);; let TREAL_MUL_SYM = prove (`!x y. (x treal_mul y) treal_eq (y treal_mul x)`, SIMP_TAC[TREAL_EQ_AP; TREAL_MUL_SYM_EQ]);; let TREAL_MUL_ASSOC = prove (`!x y z. (x treal_mul (y treal_mul z)) treal_eq ((x treal_mul y) treal_mul z)`, SIMP_TAC[FORALL_PAIR_THM; TREAL_EQ_AP; treal_mul; HREAL_ADD_LDISTRIB; HREAL_ADD_RDISTRIB; GSYM HREAL_MUL_ASSOC; HREAL_ADD_AC]);; let TREAL_MUL_LID = prove (`!x. ((treal_of_num 1) treal_mul x) treal_eq x`, SIMP_TAC[FORALL_PAIR_THM; treal_of_num; treal_mul; treal_eq] THEN REWRITE_TAC[HREAL_MUL_LZERO; HREAL_MUL_LID; HREAL_ADD_LID; HREAL_ADD_RID]);; let TREAL_ADD_LDISTRIB = prove (`!x y z. (x treal_mul (y treal_add z)) treal_eq ((x treal_mul y) treal_add (x treal_mul z))`, SIMP_TAC[FORALL_PAIR_THM; TREAL_EQ_AP; treal_mul; treal_add; HREAL_ADD_LDISTRIB; PAIR_EQ; HREAL_ADD_AC]);; let TREAL_LE_REFL = prove (`!x. x treal_le x`, REWRITE_TAC[FORALL_PAIR_THM; treal_le; HREAL_LE_REFL]);; let TREAL_LE_ANTISYM = prove (`!x y. x treal_le y /\ y treal_le x <=> (x treal_eq y)`, REWRITE_TAC[FORALL_PAIR_THM; treal_le; treal_eq; HREAL_LE_ANTISYM]);; let TREAL_LE_TRANS = prove (`!x y z. x treal_le y /\ y treal_le z ==> x treal_le z`, REWRITE_TAC[FORALL_PAIR_THM; treal_le] THEN REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HREAL_LE_ADD2) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HREAL_ADD_SYM] THEN REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_LE_ADD_LCANCEL] THEN REWRITE_TAC[HREAL_ADD_ASSOC; HREAL_LE_ADD_RCANCEL] THEN DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[HREAL_ADD_SYM]));; let TREAL_LE_TOTAL = prove (`!x y. x treal_le y \/ y treal_le x`, REWRITE_TAC[FORALL_PAIR_THM; treal_le; HREAL_LE_TOTAL]);; let TREAL_LE_LADD_IMP = prove (`!x y z. (y treal_le z) ==> (x treal_add y) treal_le (x treal_add z)`, REWRITE_TAC[FORALL_PAIR_THM; treal_le; treal_add] THEN REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_LE_ADD_LCANCEL] THEN ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_LE_ADD_LCANCEL]);; let TREAL_LE_MUL = prove (`!x y. (treal_of_num 0) treal_le x /\ (treal_of_num 0) treal_le y ==> (treal_of_num 0) treal_le (x treal_mul y)`, REWRITE_TAC[FORALL_PAIR_THM; treal_of_num; treal_le; treal_mul] THEN REPEAT GEN_TAC THEN REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP HREAL_LE_EXISTS) THEN REWRITE_TAC[HREAL_ADD_LDISTRIB; HREAL_LE_ADD_LCANCEL; GSYM HREAL_ADD_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [HREAL_ADD_SYM] THEN ASM_REWRITE_TAC[HREAL_LE_ADD_LCANCEL] THEN MATCH_MP_TAC HREAL_LE_MUL_RCANCEL_IMP THEN ASM_REWRITE_TAC[]);; let TREAL_INV_0 = prove (`treal_inv (treal_of_num 0) treal_eq (treal_of_num 0)`, REWRITE_TAC[treal_inv; treal_eq; treal_of_num]);; let TREAL_MUL_LINV = prove (`!x. ~(x treal_eq treal_of_num 0) ==> (treal_inv(x) treal_mul x) treal_eq (treal_of_num 1)`, REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x:hreal`; `y:hreal`] THEN PURE_REWRITE_TAC[treal_eq; treal_of_num; treal_mul; treal_inv] THEN PURE_REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN DISCH_TAC THEN PURE_ASM_REWRITE_TAC[COND_CLAUSES] THEN COND_CASES_TAC THEN PURE_REWRITE_TAC[treal_mul; treal_eq] THEN REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID; HREAL_MUL_LZERO; HREAL_MUL_RZERO] THENL [ALL_TAC; DISJ_CASES_THEN MP_TAC(SPECL [`x:hreal`; `y:hreal`] HREAL_LE_TOTAL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN FIRST_ASSUM(MP_TAC o MATCH_MP HREAL_LE_EXISTS) THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN DISCH_THEN(fun th -> ASSUME_TAC (SYM th) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[HREAL_ADD_LDISTRIB] THEN GEN_REWRITE_TAC RAND_CONV [HREAL_ADD_SYM] THEN AP_TERM_TAC THEN MATCH_MP_TAC HREAL_MUL_LINV THEN DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN ASM_REWRITE_TAC[HREAL_ADD_RID] THEN PURE_ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Show that the operations respect the equivalence relation. *) (* ------------------------------------------------------------------------- *) let TREAL_OF_NUM_WELLDEF = prove (`!m n. (m = n) ==> (treal_of_num m) treal_eq (treal_of_num n)`, REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC TREAL_EQ_REFL);; let TREAL_NEG_WELLDEF = prove (`!x1 x2. x1 treal_eq x2 ==> (treal_neg x1) treal_eq (treal_neg x2)`, REWRITE_TAC[FORALL_PAIR_THM; treal_neg; treal_eq] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN ASM_REWRITE_TAC[]);; let TREAL_ADD_WELLDEFR = prove (`!x1 x2 y. x1 treal_eq x2 ==> (x1 treal_add y) treal_eq (x2 treal_add y)`, REWRITE_TAC[FORALL_PAIR_THM; treal_add; treal_eq] THEN REWRITE_TAC[HREAL_EQ_ADD_RCANCEL; HREAL_ADD_ASSOC] THEN ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN REWRITE_TAC[HREAL_EQ_ADD_RCANCEL; HREAL_ADD_ASSOC]);; let TREAL_ADD_WELLDEF = prove (`!x1 x2 y1 y2. x1 treal_eq x2 /\ y1 treal_eq y2 ==> (x1 treal_add y1) treal_eq (x2 treal_add y2)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC TREAL_EQ_TRANS THEN EXISTS_TAC `x1 treal_add y2` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[TREAL_ADD_SYM_EQ]; ALL_TAC] THEN MATCH_MP_TAC TREAL_ADD_WELLDEFR THEN ASM_REWRITE_TAC[]);; let TREAL_MUL_WELLDEFR = prove (`!x1 x2 y. x1 treal_eq x2 ==> (x1 treal_mul y) treal_eq (x2 treal_mul y)`, REWRITE_TAC[FORALL_PAIR_THM; treal_mul; treal_eq] THEN REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[AC HREAL_ADD_AC `(a + b) + (c + d) = (a + d) + (b + c)`] THEN REWRITE_TAC[GSYM HREAL_ADD_RDISTRIB] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN POP_ASSUM SUBST1_TAC THEN REFL_TAC);; let TREAL_MUL_WELLDEF = prove (`!x1 x2 y1 y2. x1 treal_eq x2 /\ y1 treal_eq y2 ==> (x1 treal_mul y1) treal_eq (x2 treal_mul y2)`, REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC TREAL_EQ_TRANS THEN EXISTS_TAC `x1 treal_mul y2` THEN CONJ_TAC THENL [ONCE_REWRITE_TAC[TREAL_MUL_SYM_EQ]; ALL_TAC] THEN MATCH_MP_TAC TREAL_MUL_WELLDEFR THEN ASM_REWRITE_TAC[]);; let TREAL_EQ_IMP_LE = prove (`!x y. x treal_eq y ==> x treal_le y`, SIMP_TAC[FORALL_PAIR_THM; treal_eq; treal_le; HREAL_LE_REFL]);; let TREAL_LE_WELLDEF = prove (`!x1 x2 y1 y2. x1 treal_eq x2 /\ y1 treal_eq y2 ==> (x1 treal_le y1 <=> x2 treal_le y2)`, REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `y1:hreal#hreal` THEN CONJ_TAC THENL [MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `x1:hreal#hreal` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TREAL_EQ_IMP_LE THEN ONCE_REWRITE_TAC[TREAL_EQ_SYM]; MATCH_MP_TAC TREAL_EQ_IMP_LE]; MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `y2:hreal#hreal` THEN CONJ_TAC THENL [MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `x2:hreal#hreal` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TREAL_EQ_IMP_LE; MATCH_MP_TAC TREAL_EQ_IMP_LE THEN ONCE_REWRITE_TAC[TREAL_EQ_SYM]]] THEN ASM_REWRITE_TAC[]);; let TREAL_INV_WELLDEF = prove (`!x y. x treal_eq y ==> (treal_inv x) treal_eq (treal_inv y)`, let lemma = prove (`(@d. x = x + d) = &0`, MATCH_MP_TAC SELECT_UNIQUE THEN BETA_TAC THEN GEN_TAC THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM HREAL_ADD_RID] THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL] THEN MATCH_ACCEPT_TAC EQ_SYM_EQ) in REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`x1:hreal`; `x2:hreal`; `y1:hreal`; `y2:hreal`] THEN PURE_REWRITE_TAC[treal_eq; treal_inv] THEN ASM_CASES_TAC `x1 :hreal = x2` THEN ASM_CASES_TAC `y1 :hreal = y2` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[TREAL_EQ_REFL] THEN DISCH_THEN(MP_TAC o GEN_REWRITE_RULE RAND_CONV [HREAL_ADD_SYM]) THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; HREAL_EQ_ADD_RCANCEL] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HREAL_LE_REFL; lemma; HREAL_INV_0;TREAL_EQ_REFL] THEN ASM_CASES_TAC `x2 <= x1` THEN ASM_REWRITE_TAC[] THENL [FIRST_ASSUM(ASSUME_TAC o SYM o SELECT_RULE o MATCH_MP HREAL_LE_EXISTS) THEN UNDISCH_TAC `x1 + y2 = x2 + y1` THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; GSYM HREAL_ADD_ASSOC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[ONCE_REWRITE_RULE[HREAL_ADD_SYM] HREAL_LE_ADD] THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o BINDER_CONV o LAND_CONV) [HREAL_ADD_SYM] THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; TREAL_EQ_REFL]; DISJ_CASES_THEN MP_TAC (SPECL [`x1:hreal`; `x2:hreal`] HREAL_LE_TOTAL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o SYM o SELECT_RULE o MATCH_MP HREAL_LE_EXISTS) THEN UNDISCH_TAC `x1 + y2 = x2 + y1` THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; GSYM HREAL_ADD_ASSOC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[HREAL_ADD_SYM] HREAL_LE_ADD] THEN COND_CASES_TAC THENL [UNDISCH_TAC `(@d. x2 = x1 + d) + y1 <= y1:hreal` THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM HREAL_ADD_LID] THEN REWRITE_TAC[ONCE_REWRITE_RULE[HREAL_ADD_SYM] HREAL_LE_ADD_LCANCEL] THEN DISCH_TAC THEN SUBGOAL_THEN `(@d. x2 = x1 + d) = &0` MP_TAC THENL [ASM_REWRITE_TAC[GSYM HREAL_LE_ANTISYM] THEN GEN_REWRITE_TAC RAND_CONV [GSYM HREAL_ADD_LID] THEN REWRITE_TAC[HREAL_LE_ADD]; DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `x1 + &0 = x2` THEN ASM_REWRITE_TAC[HREAL_ADD_RID]]; GEN_REWRITE_TAC (funpow 3 RAND_CONV o BINDER_CONV o LAND_CONV) [HREAL_ADD_SYM] THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; TREAL_EQ_REFL]]]);; (* ------------------------------------------------------------------------- *) (* Now define the quotient type -- the reals at last! *) (* ------------------------------------------------------------------------- *) let real_tybij = define_quotient_type "real" ("mk_real","dest_real") `(treal_eq)`;; let real_of_num,real_of_num_th = lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) "real_of_num" TREAL_OF_NUM_WELLDEF;; let real_neg,real_neg_th = lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) "real_neg" TREAL_NEG_WELLDEF;; let real_add,real_add_th = lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) "real_add" TREAL_ADD_WELLDEF;; let real_mul,real_mul_th = lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) "real_mul" TREAL_MUL_WELLDEF;; let real_le,real_le_th = lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) "real_le" TREAL_LE_WELLDEF;; let real_inv,real_inv_th = lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) "real_inv" TREAL_INV_WELLDEF;; let [REAL_ADD_SYM; REAL_ADD_ASSOC; REAL_ADD_LID; REAL_ADD_LINV; REAL_MUL_SYM; REAL_MUL_ASSOC; REAL_MUL_LID; REAL_ADD_LDISTRIB; REAL_LE_REFL; REAL_LE_ANTISYM; REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_LADD_IMP; REAL_LE_MUL; REAL_INV_0; REAL_MUL_LINV; REAL_OF_NUM_EQ; REAL_OF_NUM_LE; REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] = map (lift_theorem real_tybij (TREAL_EQ_REFL,TREAL_EQ_SYM,TREAL_EQ_TRANS) [real_of_num_th; real_neg_th; real_add_th; real_mul_th; real_le_th; real_inv_th]) [TREAL_ADD_SYM; TREAL_ADD_ASSOC; TREAL_ADD_LID; TREAL_ADD_LINV; TREAL_MUL_SYM; TREAL_MUL_ASSOC; TREAL_MUL_LID; TREAL_ADD_LDISTRIB; TREAL_LE_REFL; TREAL_LE_ANTISYM; TREAL_LE_TRANS; TREAL_LE_TOTAL; TREAL_LE_LADD_IMP; TREAL_LE_MUL; TREAL_INV_0; TREAL_MUL_LINV; TREAL_OF_NUM_EQ; TREAL_OF_NUM_LE; TREAL_OF_NUM_ADD; TREAL_OF_NUM_MUL];; (* ------------------------------------------------------------------------- *) (* Set up a friendly interface. *) (* ------------------------------------------------------------------------- *) parse_as_prefix "--";; parse_as_infix ("/",(22,"left"));; parse_as_infix ("pow",(24,"left"));; do_list overload_interface ["+",`real_add:real->real->real`; "-",`real_sub:real->real->real`; "*",`real_mul:real->real->real`; "/",`real_div:real->real->real`; "<",`real_lt:real->real->bool`; "<=",`real_le:real->real->bool`; ">",`real_gt:real->real->bool`; ">=",`real_ge:real->real->bool`; "--",`real_neg:real->real`; "pow",`real_pow:real->num->real`; "inv",`real_inv:real->real`; "abs",`real_abs:real->real`; "max",`real_max:real->real->real`; "min",`real_min:real->real->real`; "&",`real_of_num:num->real`];; let prioritize_real() = prioritize_overload(mk_type("real",[]));; (* ------------------------------------------------------------------------- *) (* Additional definitions. *) (* ------------------------------------------------------------------------- *) let real_sub = new_definition `x - y = x + --y`;; let real_lt = new_definition `x < y <=> ~(y <= x)`;; let real_ge = new_definition `x >= y <=> y <= x`;; let real_gt = new_definition `x > y <=> y < x`;; let real_abs = new_definition `abs(x) = if &0 <= x then x else --x`;; let real_pow = new_recursive_definition num_RECURSION `(x pow 0 = &1) /\ (!n. x pow (SUC n) = x * (x pow n))`;; let real_div = new_definition `x / y = x * inv(y)`;; let real_max = new_definition `real_max m n = if m <= n then n else m`;; let real_min = new_definition `real_min m n = if m <= n then m else n`;; (*----------------------------------------------------------------------------*) (* Derive the supremum property for an arbitrary bounded nonempty set *) (*----------------------------------------------------------------------------*) let REAL_HREAL_LEMMA1 = prove (`?r:hreal->real. (!x. &0 <= x <=> ?y. x = r y) /\ (!y z. y <= z <=> r y <= r z)`, EXISTS_TAC `\y. mk_real((treal_eq)(y,hreal_of_num 0))` THEN REWRITE_TAC[GSYM real_le_th] THEN REWRITE_TAC[treal_le; HREAL_ADD_LID; HREAL_ADD_RID] THEN GEN_TAC THEN EQ_TAC THENL [MP_TAC(INST [`dest_real x`,`r:hreal#hreal->bool`] (snd real_tybij)) THEN REWRITE_TAC[fst real_tybij] THEN DISCH_THEN(X_CHOOSE_THEN `p:hreal#hreal` MP_TAC) THEN DISCH_THEN(MP_TAC o AP_TERM `mk_real`) THEN REWRITE_TAC[fst real_tybij] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM real_of_num_th; GSYM real_le_th] THEN SUBST1_TAC(GSYM(ISPEC `p:hreal#hreal` PAIR)) THEN PURE_REWRITE_TAC[treal_of_num; treal_le] THEN PURE_REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN DISCH_THEN(X_CHOOSE_THEN `d:hreal` SUBST1_TAC o MATCH_MP HREAL_LE_EXISTS) THEN EXISTS_TAC `d:hreal` THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `q:hreal#hreal` THEN SUBST1_TAC(GSYM(ISPEC `q:hreal#hreal` PAIR)) THEN PURE_REWRITE_TAC[treal_eq] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [HREAL_ADD_SYM] THEN REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[HREAL_ADD_RID]; DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[GSYM real_of_num_th; GSYM real_le_th] THEN REWRITE_TAC[treal_of_num; treal_le] THEN REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN GEN_REWRITE_TAC RAND_CONV [GSYM HREAL_ADD_LID] THEN REWRITE_TAC[HREAL_LE_ADD]]);; let REAL_HREAL_LEMMA2 = prove (`?h r. (!x:hreal. h(r x) = x) /\ (!x. &0 <= x ==> (r(h x) = x)) /\ (!x:hreal. &0 <= r x) /\ (!x y. x <= y <=> r x <= r y)`, STRIP_ASSUME_TAC REAL_HREAL_LEMMA1 THEN EXISTS_TAC `\x:real. @y:hreal. x = r y` THEN EXISTS_TAC `r:hreal->real` THEN ASM_REWRITE_TAC[BETA_THM] THEN SUBGOAL_THEN `!y z. ((r:hreal->real) y = r z) <=> (y = z)` ASSUME_TAC THENL [ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM; GSYM HREAL_LE_ANTISYM]; ALL_TAC] THEN ASM_REWRITE_TAC[GEN_REWRITE_RULE (LAND_CONV o BINDER_CONV) [EQ_SYM_EQ] (SPEC_ALL SELECT_REFL); GSYM EXISTS_REFL] THEN GEN_TAC THEN DISCH_THEN(ACCEPT_TAC o SYM o SELECT_RULE));; let REAL_COMPLETE_SOMEPOS = prove (`!P. (?x. P x /\ &0 <= x) /\ (?M. !x. P x ==> x <= M) ==> ?M. (!x. P x ==> x <= M) /\ !M'. (!x. P x ==> x <= M') ==> M <= M'`, REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC REAL_HREAL_LEMMA2 THEN MP_TAC(SPEC `\y:hreal. (P:real->bool)(r y)` HREAL_COMPLETE) THEN BETA_TAC THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THENL [EXISTS_TAC `(h:real->hreal) x` THEN UNDISCH_TAC `(P:real->bool) x` THEN MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; EXISTS_TAC `(h:real->hreal) M` THEN X_GEN_TAC `y:hreal` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; MATCH_MP_TAC(TAUT `(b ==> c) ==> a ==> (a ==> b) ==> c`) THEN DISCH_THEN(X_CHOOSE_THEN `B:hreal` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `(r:hreal->real) B` THEN CONJ_TAC THENL [X_GEN_TAC `z:real` THEN DISCH_TAC THEN DISJ_CASES_TAC(SPECL [`&0`; `z:real`] REAL_LE_TOTAL) THENL [ANTE_RES_THEN(SUBST1_TAC o SYM) (ASSUME `&0 <= z`) THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `(P:real->bool) z` THEN MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[]]; X_GEN_TAC `C:real` THEN DISCH_TAC THEN SUBGOAL_THEN `B:hreal <= (h(C:real))` MP_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `(r:hreal->real)(h C) = C` (fun th -> ASM_REWRITE_TAC[th]); ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC] THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; let REAL_COMPLETE = prove (`!P. (?x. P x) /\ (?M. !x. P x ==> x <= M) ==> ?M. (!x. P x ==> x <= M) /\ !M'. (!x. P x ==> x <= M') ==> M <= M'`, let lemma = prove (`y = (y - x) + x`, REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_LINV] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_ADD_LID]) in REPEAT STRIP_TAC THEN DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL [MATCH_MP_TAC REAL_COMPLETE_SOMEPOS THEN CONJ_TAC THENL [EXISTS_TAC `x:real`; EXISTS_TAC `M:real`] THEN ASM_REWRITE_TAC[]; FIRST_ASSUM(MP_TAC o MATCH_MP REAL_LE_LADD_IMP) THEN DISCH_THEN(MP_TAC o SPEC `--x`) THEN REWRITE_TAC[REAL_ADD_LINV] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_ADD_LID] THEN DISCH_TAC THEN MP_TAC(SPEC `\y. P(y + x) :bool` REAL_COMPLETE_SOMEPOS) THEN BETA_TAC THEN W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL [CONJ_TAC THENL [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_LID]; EXISTS_TAC `M + --x` THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN DISCH_THEN(MP_TAC o SPEC `--x` o MATCH_MP REAL_LE_LADD_IMP) THEN DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LINV] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]; MATCH_MP_TAC(TAUT `(b ==> c) ==> a ==> (a ==> b) ==> c`) THEN DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN EXISTS_TAC `B + x` THEN CONJ_TAC THENL [GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [lemma] THEN DISCH_THEN(ANTE_RES_THEN (MP_TAC o SPEC `x:real` o MATCH_MP REAL_LE_LADD_IMP)) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_LINV] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; REPEAT STRIP_TAC THEN SUBGOAL_THEN `B <= M' - x` MP_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN SUBGOAL_THEN `z + x <= M'` MP_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(MP_TAC o SPEC `--x` o MATCH_MP REAL_LE_LADD_IMP) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[real_sub] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LINV] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]; DISCH_THEN(MP_TAC o SPEC `x:real` o MATCH_MP REAL_LE_LADD_IMP) THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL [MATCH_ACCEPT_TAC REAL_ADD_SYM; ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[real_sub] THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV] THEN REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]]]]);; do_list reduce_interface ["+",`hreal_add:hreal->hreal->hreal`; "*",`hreal_mul:hreal->hreal->hreal`; "<=",`hreal_le:hreal->hreal->bool`; "inv",`hreal_inv:hreal->hreal`];; do_list remove_interface ["**"; "++"; "<<="; "==="; "fn"; "afn"];; hol-light/recursion.ml000066400000000000000000000130621303454263000153120ustar00rootroot00000000000000(* ========================================================================= *) (* Definition by primitive recursion and other tools for inductive types. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "nums.ml";; (* ------------------------------------------------------------------------- *) (* Prove existence of recursive function. The inner "raw" version requires *) (* exact correspondence with recursion theorem; "canon" requires the *) (* PR argument to come first in the arg list; the outer one is more general. *) (* ------------------------------------------------------------------------- *) let prove_recursive_functions_exist = let prove_raw_recursive_functions_exist ax tm = let rawcls = conjuncts tm in let spcls = map (snd o strip_forall) rawcls in let lpats = map (strip_comb o lhand) spcls in let ufns = itlist (insert o fst) lpats [] in let axth = SPEC_ALL ax in let exvs,axbody = strip_exists (concl axth) in let axcls = conjuncts axbody in let f = fst o dest_const o repeat rator o rand o lhand o snd o strip_forall in let findax = C assoc (map (fun t -> f t,t) axcls) in let raxs = map (findax o fst o dest_const o repeat rator o hd o snd) lpats in let axfns = map (repeat rator o lhand o snd o strip_forall) raxs in let urfns = map (fun v -> assocd v (setify (zip axfns (map fst lpats))) v) exvs in let axtm = list_mk_exists(exvs,list_mk_conj raxs) and urtm = list_mk_exists(urfns,tm) in let insts = term_match [] axtm urtm in let ixth = INSTANTIATE insts axth in let ixvs,ixbody = strip_exists (concl ixth) in let ixtm = subst (zip urfns ixvs) ixbody in let ixths = CONJUNCTS (ASSUME ixtm) in let rixths = map (fun t -> find (aconv t o concl) ixths) rawcls in let rixth = itlist SIMPLE_EXISTS ufns (end_itlist CONJ rixths) in PROVE_HYP ixth (itlist SIMPLE_CHOOSE urfns rixth) in let canonize t = let avs,bod = strip_forall t in let l,r = dest_eq bod in let fn,args = strip_comb l in let rarg = hd args and vargs = tl args in let l' = mk_comb(fn,rarg) and r' = list_mk_abs(vargs,r) in let fvs = frees rarg in let def = ASSUME(list_mk_forall(fvs,mk_eq(l',r'))) in GENL avs (RIGHT_BETAS vargs (SPECL fvs def)) in let prove_canon_recursive_functions_exist ax tm = let ths = map canonize (conjuncts tm) in let atm = list_mk_conj (map (hd o hyp) ths) in let aths = CONJUNCTS(ASSUME atm) in let rth = end_itlist CONJ (map2 PROVE_HYP aths ths) in let eth = prove_raw_recursive_functions_exist ax atm in let evs = fst(strip_exists(concl eth)) in PROVE_HYP eth (itlist SIMPLE_CHOOSE evs (itlist SIMPLE_EXISTS evs rth)) in let reshuffle fn args acc = let args' = uncurry (C (@)) (partition is_var args) in if args = args' then acc else let gvs = map (genvar o type_of) args in let gvs' = map (C assoc (zip args gvs)) args' in let lty = itlist (mk_fun_ty o type_of) gvs' (funpow (length gvs) (hd o tl o snd o dest_type) (type_of fn)) in let fn' = genvar lty in let def = mk_eq(fn,list_mk_abs(gvs,list_mk_comb(fn',gvs'))) in (ASSUME def)::acc and scrub_def t th = let l,r = dest_eq t in MP (INST [r,l] (DISCH t th)) (REFL r) in fun ax tm -> let rawcls = conjuncts tm in let spcls = map (snd o strip_forall) rawcls in let lpats = map (strip_comb o lhand) spcls in let ufns = itlist (insert o fst) lpats [] in let uxargs = map (C assoc lpats) ufns in let trths = itlist2 reshuffle ufns uxargs [] in let tth = GEN_REWRITE_CONV REDEPTH_CONV (BETA_THM::trths) tm in let eth = prove_canon_recursive_functions_exist ax (rand(concl tth)) in let evs,ebod = strip_exists(concl eth) in let fth = itlist SIMPLE_EXISTS ufns (EQ_MP (SYM tth) (ASSUME ebod)) in let gth = itlist scrub_def (map concl trths) fth in PROVE_HYP eth (itlist SIMPLE_CHOOSE evs gth);; (* ------------------------------------------------------------------------- *) (* Version that defines function(s). *) (* ------------------------------------------------------------------------- *) let new_recursive_definition = let the_recursive_definitions = ref [] in let find_redefinition tm th = let th' = PART_MATCH I th tm in ignore(PART_MATCH I th' (concl th)); th' in fun ax tm -> try let th = tryfind (find_redefinition tm) (!the_recursive_definitions) in warn true "Benign redefinition of recursive function"; th with Failure _ -> let rawcls = conjuncts tm in let spcls = map (snd o strip_forall) rawcls in let lpats = map (strip_comb o lhand) spcls in let ufns = itlist (insert o fst) lpats [] in let fvs = map (fun t -> subtract (frees t) ufns) rawcls in let gcls = map2 (curry list_mk_forall) fvs rawcls in let eth = prove_recursive_functions_exist ax (list_mk_conj gcls) in let evs,bod = strip_exists(concl eth) in let dth = new_specification (map (fst o dest_var) evs) eth in let dths = map2 SPECL fvs (CONJUNCTS dth) in let th = end_itlist CONJ dths in the_recursive_definitions := th::(!the_recursive_definitions); th;; hol-light/sets.ml000066400000000000000000004476571303454263000143040ustar00rootroot00000000000000(* ========================================================================= *) (* Very basic set theory (using predicates as sets). *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Marco Maggesi 2012-2015 *) (* ========================================================================= *) needs "int.ml";; (* ------------------------------------------------------------------------- *) (* Infix symbols for set operations. *) (* ------------------------------------------------------------------------- *) parse_as_infix("IN",(11,"right"));; parse_as_infix("SUBSET",(12,"right"));; parse_as_infix("PSUBSET",(12,"right"));; parse_as_infix("INTER",(20,"right"));; parse_as_infix("UNION",(16,"right"));; parse_as_infix("DIFF",(18,"left"));; parse_as_infix("INSERT",(21,"right"));; parse_as_infix("DELETE",(21,"left"));; parse_as_infix("HAS_SIZE",(12,"right"));; parse_as_infix("<=_c",(12,"right"));; parse_as_infix("<_c",(12,"right"));; parse_as_infix(">=_c",(12,"right"));; parse_as_infix(">_c",(12,"right"));; parse_as_infix("=_c",(12,"right"));; (* ------------------------------------------------------------------------- *) (* Set membership. *) (* ------------------------------------------------------------------------- *) let IN = new_definition `!P:A->bool. !x. x IN P <=> P x`;; (* ------------------------------------------------------------------------- *) (* Axiom of extensionality in this framework. *) (* ------------------------------------------------------------------------- *) let EXTENSION = prove (`!s t. (s = t) <=> !x:A. x IN s <=> x IN t`, REWRITE_TAC[IN; FUN_EQ_THM]);; (* ------------------------------------------------------------------------- *) (* General specification. *) (* ------------------------------------------------------------------------- *) let GSPEC = new_definition `GSPEC (p:A->bool) = p`;; let SETSPEC = new_definition `SETSPEC v P t <=> P /\ (v = t)`;; (* ------------------------------------------------------------------------- *) (* Rewrite rule for eliminating set-comprehension membership assertions. *) (* ------------------------------------------------------------------------- *) let IN_ELIM_THM = prove (`(!P x. x IN GSPEC (\v. P (SETSPEC v)) <=> P (\p t. p /\ (x = t))) /\ (!p x. x IN GSPEC (\v. ?y. SETSPEC v (p y) y) <=> p x) /\ (!P x. GSPEC (\v. P (SETSPEC v)) x <=> P (\p t. p /\ (x = t))) /\ (!p x. GSPEC (\v. ?y. SETSPEC v (p y) y) x <=> p x) /\ (!p x. x IN (\y. p y) <=> p x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[IN; GSPEC] THEN TRY(AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM]) THEN REWRITE_TAC[SETSPEC] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* These two definitions are needed first, for the parsing of enumerations. *) (* ------------------------------------------------------------------------- *) let EMPTY = new_definition `EMPTY = (\x:A. F)`;; let INSERT_DEF = new_definition `x INSERT s = \y:A. y IN s \/ (y = x)`;; (* ------------------------------------------------------------------------- *) (* The other basic operations. *) (* ------------------------------------------------------------------------- *) let UNIV = new_definition `UNIV = (\x:A. T)`;; let UNION = new_definition `s UNION t = {x:A | x IN s \/ x IN t}`;; let UNIONS = new_definition `UNIONS s = {x:A | ?u. u IN s /\ x IN u}`;; let INTER = new_definition `s INTER t = {x:A | x IN s /\ x IN t}`;; let INTERS = new_definition `INTERS s = {x:A | !u. u IN s ==> x IN u}`;; let DIFF = new_definition `s DIFF t = {x:A | x IN s /\ ~(x IN t)}`;; let INSERT = prove (`x INSERT s = {y:A | y IN s \/ (y = x)}`, REWRITE_TAC[EXTENSION; INSERT_DEF; IN_ELIM_THM]);; let DELETE = new_definition `s DELETE x = {y:A | y IN s /\ ~(y = x)}`;; (* ------------------------------------------------------------------------- *) (* Other basic predicates. *) (* ------------------------------------------------------------------------- *) let SUBSET = new_definition `s SUBSET t <=> !x:A. x IN s ==> x IN t`;; let PSUBSET = new_definition `(s:A->bool) PSUBSET t <=> s SUBSET t /\ ~(s = t)`;; let DISJOINT = new_definition `DISJOINT (s:A->bool) t <=> (s INTER t = EMPTY)`;; let SING = new_definition `SING s = ?x:A. s = {x}`;; (* ------------------------------------------------------------------------- *) (* Finiteness. *) (* ------------------------------------------------------------------------- *) let FINITE_RULES,FINITE_INDUCT,FINITE_CASES = new_inductive_definition `FINITE (EMPTY:A->bool) /\ !(x:A) s. FINITE s ==> FINITE (x INSERT s)`;; let INFINITE = new_definition `INFINITE (s:A->bool) <=> ~(FINITE s)`;; (* ------------------------------------------------------------------------- *) (* Stuff concerned with functions. *) (* ------------------------------------------------------------------------- *) let IMAGE = new_definition `IMAGE (f:A->B) s = { y | ?x. x IN s /\ (y = f x)}`;; let INJ = new_definition `INJ (f:A->B) s t <=> (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))`;; let SURJ = new_definition `SURJ (f:A->B) s t <=> (!x. x IN s ==> (f x) IN t) /\ (!x. (x IN t) ==> ?y. y IN s /\ (f y = x))`;; let BIJ = new_definition `BIJ (f:A->B) s t <=> INJ f s t /\ SURJ f s t`;; (* ------------------------------------------------------------------------- *) (* Another funny thing. *) (* ------------------------------------------------------------------------- *) let CHOICE = new_definition `CHOICE s = @x:A. x IN s`;; let REST = new_definition `REST (s:A->bool) = s DELETE (CHOICE s)`;; (* ------------------------------------------------------------------------- *) (* Basic membership properties. *) (* ------------------------------------------------------------------------- *) let NOT_IN_EMPTY = prove (`!x:A. ~(x IN EMPTY)`, REWRITE_TAC[IN; EMPTY]);; let IN_UNIV = prove (`!x:A. x IN UNIV`, REWRITE_TAC[UNIV; IN]);; let IN_UNION = prove (`!s t (x:A). x IN (s UNION t) <=> x IN s \/ x IN t`, REWRITE_TAC[IN_ELIM_THM; UNION]);; let IN_UNIONS = prove (`!s (x:A). x IN (UNIONS s) <=> ?t. t IN s /\ x IN t`, REWRITE_TAC[IN_ELIM_THM; UNIONS]);; let IN_INTER = prove (`!s t (x:A). x IN (s INTER t) <=> x IN s /\ x IN t`, REWRITE_TAC[IN_ELIM_THM; INTER]);; let IN_INTERS = prove (`!s (x:A). x IN (INTERS s) <=> !t. t IN s ==> x IN t`, REWRITE_TAC[IN_ELIM_THM; INTERS]);; let IN_DIFF = prove (`!(s:A->bool) t x. x IN (s DIFF t) <=> x IN s /\ ~(x IN t)`, REWRITE_TAC[IN_ELIM_THM; DIFF]);; let IN_INSERT = prove (`!x:A. !y s. x IN (y INSERT s) <=> (x = y) \/ x IN s`, ONCE_REWRITE_TAC[DISJ_SYM] THEN REWRITE_TAC[IN_ELIM_THM; INSERT]);; let IN_DELETE = prove (`!s. !x:A. !y. x IN (s DELETE y) <=> x IN s /\ ~(x = y)`, REWRITE_TAC[IN_ELIM_THM; DELETE]);; let IN_SING = prove (`!x y. x IN {y:A} <=> (x = y)`, REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY]);; let IN_IMAGE = prove (`!y:B. !s f. (y IN (IMAGE f s)) <=> ?x:A. (y = f x) /\ x IN s`, ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[IN_ELIM_THM; IMAGE]);; let IN_REST = prove (`!x:A. !s. x IN (REST s) <=> x IN s /\ ~(x = CHOICE s)`, REWRITE_TAC[REST; IN_DELETE]);; let FORALL_IN_INSERT = prove (`!P a s. (!x. x IN (a INSERT s) ==> P x) <=> P a /\ (!x. x IN s ==> P x)`, REWRITE_TAC[IN_INSERT] THEN MESON_TAC[]);; let EXISTS_IN_INSERT = prove (`!P a s. (?x. x IN (a INSERT s) /\ P x) <=> P a \/ ?x. x IN s /\ P x`, REWRITE_TAC[IN_INSERT] THEN MESON_TAC[]);; let FORALL_IN_UNION = prove (`!P s t:A->bool. (!x. x IN s UNION t ==> P x) <=> (!x. x IN s ==> P x) /\ (!x. x IN t ==> P x)`, REWRITE_TAC[IN_UNION] THEN MESON_TAC[]);; let EXISTS_IN_UNION = prove (`!P s t:A->bool. (?x. x IN s UNION t /\ P x) <=> (?x. x IN s /\ P x) \/ (?x. x IN t /\ P x)`, REWRITE_TAC[IN_UNION] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Basic property of the choice function. *) (* ------------------------------------------------------------------------- *) let CHOICE_DEF = prove (`!s:A->bool. ~(s = EMPTY) ==> (CHOICE s) IN s`, REWRITE_TAC[CHOICE; EXTENSION; NOT_IN_EMPTY; NOT_FORALL_THM; EXISTS_THM]);; (* ------------------------------------------------------------------------- *) (* Tactic to automate some routine set theory by reduction to FOL. *) (* ------------------------------------------------------------------------- *) let SET_TAC = let PRESET_TAC = POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN REWRITE_TAC[NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT; IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE; IN_ELIM_THM; IN] in fun ths -> (if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN PRESET_TAC THEN MESON_TAC[];; let SET_RULE tm = prove(tm,SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Misc. theorems. *) (* ------------------------------------------------------------------------- *) let NOT_EQUAL_SETS = prove (`!s:A->bool. !t. ~(s = t) <=> ?x. x IN t <=> ~(x IN s)`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* The empty set. *) (* ------------------------------------------------------------------------- *) let MEMBER_NOT_EMPTY = prove (`!s:A->bool. (?x. x IN s) <=> ~(s = EMPTY)`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* The universal set. *) (* ------------------------------------------------------------------------- *) let UNIV_NOT_EMPTY = prove (`~(UNIV:A->bool = EMPTY)`, SET_TAC[]);; let EMPTY_NOT_UNIV = prove (`~(EMPTY:A->bool = UNIV)`, SET_TAC[]);; let EQ_UNIV = prove (`(!x:A. x IN s) <=> (s = UNIV)`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Set inclusion. *) (* ------------------------------------------------------------------------- *) let SUBSET_TRANS = prove (`!(s:A->bool) t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u`, SET_TAC[]);; let SUBSET_REFL = prove (`!s:A->bool. s SUBSET s`, SET_TAC[]);; let SUBSET_ANTISYM = prove (`!(s:A->bool) t. s SUBSET t /\ t SUBSET s ==> s = t`, SET_TAC[]);; let SUBSET_ANTISYM_EQ = prove (`!(s:A->bool) t. s SUBSET t /\ t SUBSET s <=> s = t`, SET_TAC[]);; let EMPTY_SUBSET = prove (`!s:A->bool. EMPTY SUBSET s`, SET_TAC[]);; let SUBSET_EMPTY = prove (`!s:A->bool. s SUBSET EMPTY <=> (s = EMPTY)`, SET_TAC[]);; let SUBSET_UNIV = prove (`!s:A->bool. s SUBSET UNIV`, SET_TAC[]);; let UNIV_SUBSET = prove (`!s:A->bool. UNIV SUBSET s <=> (s = UNIV)`, SET_TAC[]);; let SING_SUBSET = prove (`!s x. {x} SUBSET s <=> x IN s`, SET_TAC[]);; let SUBSET_RESTRICT = prove (`!s P. {x | x IN s /\ P x} SUBSET s`, SIMP_TAC[SUBSET; IN_ELIM_THM]);; (* ------------------------------------------------------------------------- *) (* Proper subset. *) (* ------------------------------------------------------------------------- *) let PSUBSET_TRANS = prove (`!(s:A->bool) t u. s PSUBSET t /\ t PSUBSET u ==> s PSUBSET u`, SET_TAC[]);; let PSUBSET_SUBSET_TRANS = prove (`!(s:A->bool) t u. s PSUBSET t /\ t SUBSET u ==> s PSUBSET u`, SET_TAC[]);; let SUBSET_PSUBSET_TRANS = prove (`!(s:A->bool) t u. s SUBSET t /\ t PSUBSET u ==> s PSUBSET u`, SET_TAC[]);; let PSUBSET_IRREFL = prove (`!s:A->bool. ~(s PSUBSET s)`, SET_TAC[]);; let NOT_PSUBSET_EMPTY = prove (`!s:A->bool. ~(s PSUBSET EMPTY)`, SET_TAC[]);; let NOT_UNIV_PSUBSET = prove (`!s:A->bool. ~(UNIV PSUBSET s)`, SET_TAC[]);; let PSUBSET_UNIV = prove (`!s:A->bool. s PSUBSET UNIV <=> ?x. ~(x IN s)`, SET_TAC[]);; let PSUBSET_ALT = prove (`!s t:A->bool. s PSUBSET t <=> s SUBSET t /\ (?a. a IN t /\ ~(a IN s))`, REWRITE_TAC[PSUBSET] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Union. *) (* ------------------------------------------------------------------------- *) let UNION_ASSOC = prove (`!(s:A->bool) t u. (s UNION t) UNION u = s UNION (t UNION u)`, SET_TAC[]);; let UNION_IDEMPOT = prove (`!s:A->bool. s UNION s = s`, SET_TAC[]);; let UNION_COMM = prove (`!(s:A->bool) t. s UNION t = t UNION s`, SET_TAC[]);; let SUBSET_UNION = prove (`(!s:A->bool. !t. s SUBSET (s UNION t)) /\ (!s:A->bool. !t. s SUBSET (t UNION s))`, SET_TAC[]);; let SUBSET_UNION_ABSORPTION = prove (`!s:A->bool. !t. s SUBSET t <=> (s UNION t = t)`, SET_TAC[]);; let UNION_EMPTY = prove (`(!s:A->bool. EMPTY UNION s = s) /\ (!s:A->bool. s UNION EMPTY = s)`, SET_TAC[]);; let UNION_UNIV = prove (`(!s:A->bool. UNIV UNION s = UNIV) /\ (!s:A->bool. s UNION UNIV = UNIV)`, SET_TAC[]);; let EMPTY_UNION = prove (`!s:A->bool. !t. (s UNION t = EMPTY) <=> (s = EMPTY) /\ (t = EMPTY)`, SET_TAC[]);; let UNION_SUBSET = prove (`!s t u. (s UNION t) SUBSET u <=> s SUBSET u /\ t SUBSET u`, SET_TAC[]);; let FORALL_SUBSET_UNION = prove (`!t u:A->bool. (!s. s SUBSET t UNION u ==> P s) <=> (!t' u'. t' SUBSET t /\ u' SUBSET u ==> P(t' UNION u'))`, REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; DISCH_TAC THEN X_GEN_TAC `s:A->bool` THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`s INTER t:A->bool`; `s INTER u:A->bool`]) THEN ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC] THEN ASM SET_TAC[]]);; let EXISTS_SUBSET_UNION = prove (`!t u:A->bool. (?s. s SUBSET t UNION u /\ P s) <=> (?t' u'. t' SUBSET t /\ u' SUBSET u /\ P(t' UNION u'))`, REWRITE_TAC[MESON[] `(?x. P x /\ Q x) <=> ~(!x. P x ==> ~Q x)`] THEN REWRITE_TAC[FORALL_SUBSET_UNION] THEN MESON_TAC[]);; let FORALL_SUBSET_INSERT = prove (`!a:A t. (!s. s SUBSET a INSERT t ==> P s) <=> (!s. s SUBSET t ==> P s /\ P (a INSERT s))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN REWRITE_TAC[FORALL_SUBSET_UNION; SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN MESON_TAC[UNION_EMPTY]);; let EXISTS_SUBSET_INSERT = prove (`!a:A t. (?s. s SUBSET a INSERT t /\ P s) <=> (?s. s SUBSET t /\ (P s \/ P (a INSERT s)))`, REWRITE_TAC[MESON[] `(?x. P x /\ Q x) <=> ~(!x. P x ==> ~Q x)`] THEN REWRITE_TAC[FORALL_SUBSET_INSERT] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Intersection. *) (* ------------------------------------------------------------------------- *) let INTER_ASSOC = prove (`!(s:A->bool) t u. (s INTER t) INTER u = s INTER (t INTER u)`, SET_TAC[]);; let INTER_IDEMPOT = prove (`!s:A->bool. s INTER s = s`, SET_TAC[]);; let INTER_COMM = prove (`!(s:A->bool) t. s INTER t = t INTER s`, SET_TAC[]);; let INTER_SUBSET = prove (`(!s:A->bool. !t. (s INTER t) SUBSET s) /\ (!s:A->bool. !t. (t INTER s) SUBSET s)`, SET_TAC[]);; let SUBSET_INTER_ABSORPTION = prove (`!s:A->bool. !t. s SUBSET t <=> (s INTER t = s)`, SET_TAC[]);; let INTER_EMPTY = prove (`(!s:A->bool. EMPTY INTER s = EMPTY) /\ (!s:A->bool. s INTER EMPTY = EMPTY)`, SET_TAC[]);; let INTER_UNIV = prove (`(!s:A->bool. UNIV INTER s = s) /\ (!s:A->bool. s INTER UNIV = s)`, SET_TAC[]);; let SUBSET_INTER = prove (`!s t u. s SUBSET (t INTER u) <=> s SUBSET t /\ s SUBSET u`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Distributivity. *) (* ------------------------------------------------------------------------- *) let UNION_OVER_INTER = prove (`!s:A->bool. !t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u)`, SET_TAC[]);; let INTER_OVER_UNION = prove (`!s:A->bool. !t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u)`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Disjoint sets. *) (* ------------------------------------------------------------------------- *) let IN_DISJOINT = prove (`!s:A->bool. !t. DISJOINT s t <=> ~(?x. x IN s /\ x IN t)`, SET_TAC[]);; let DISJOINT_SYM = prove (`!s:A->bool. !t. DISJOINT s t <=> DISJOINT t s`, SET_TAC[]);; let DISJOINT_EMPTY = prove (`!s:A->bool. DISJOINT EMPTY s /\ DISJOINT s EMPTY`, SET_TAC[]);; let DISJOINT_EMPTY_REFL = prove (`!s:A->bool. (s = EMPTY) <=> (DISJOINT s s)`, SET_TAC[]);; let DISJOINT_UNION = prove (`!s:A->bool. !t u. DISJOINT (s UNION t) u <=> DISJOINT s u /\ DISJOINT t u`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Set difference. *) (* ------------------------------------------------------------------------- *) let DIFF_EMPTY = prove (`!s:A->bool. s DIFF EMPTY = s`, SET_TAC[]);; let EMPTY_DIFF = prove (`!s:A->bool. EMPTY DIFF s = EMPTY`, SET_TAC[]);; let DIFF_UNIV = prove (`!s:A->bool. s DIFF UNIV = EMPTY`, SET_TAC[]);; let DIFF_DIFF = prove (`!s:A->bool. !t. (s DIFF t) DIFF t = s DIFF t`, SET_TAC[]);; let DIFF_EQ_EMPTY = prove (`!s:A->bool. s DIFF s = EMPTY`, SET_TAC[]);; let SUBSET_DIFF = prove (`!s t. (s DIFF t) SUBSET s`, SET_TAC[]);; let COMPL_COMPL = prove (`!s. (:A) DIFF ((:A) DIFF s) = s`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Insertion and deletion. *) (* ------------------------------------------------------------------------- *) let COMPONENT = prove (`!x:A. !s. x IN (x INSERT s)`, SET_TAC[]);; let DECOMPOSITION = prove (`!s:A->bool. !x. x IN s <=> ?t. (s = x INSERT t) /\ ~(x IN t)`, REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_INSERT] THEN EXISTS_TAC `s DELETE x:A` THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let SET_CASES = prove (`!s:A->bool. (s = EMPTY) \/ ?x:A. ?t. (s = x INSERT t) /\ ~(x IN t)`, MESON_TAC[MEMBER_NOT_EMPTY; DECOMPOSITION]);; let ABSORPTION = prove (`!x:A. !s. x IN s <=> (x INSERT s = s)`, SET_TAC[]);; let INSERT_INSERT = prove (`!x:A. !s. x INSERT (x INSERT s) = x INSERT s`, SET_TAC[]);; let INSERT_COMM = prove (`!x:A. !y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)`, SET_TAC[]);; let INSERT_UNIV = prove (`!x:A. x INSERT UNIV = UNIV`, SET_TAC[]);; let NOT_INSERT_EMPTY = prove (`!x:A. !s. ~(x INSERT s = EMPTY)`, SET_TAC[]);; let NOT_EMPTY_INSERT = prove (`!x:A. !s. ~(EMPTY = x INSERT s)`, SET_TAC[]);; let INSERT_UNION = prove (`!x:A. !s t. (x INSERT s) UNION t = if x IN t then s UNION t else x INSERT (s UNION t)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let INSERT_UNION_EQ = prove (`!x:A. !s t. (x INSERT s) UNION t = x INSERT (s UNION t)`, SET_TAC[]);; let INSERT_INTER = prove (`!x:A. !s t. (x INSERT s) INTER t = if x IN t then x INSERT (s INTER t) else s INTER t`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let DISJOINT_INSERT = prove (`!(x:A) s t. DISJOINT (x INSERT s) t <=> (DISJOINT s t) /\ ~(x IN t)`, SET_TAC[]);; let INSERT_SUBSET = prove (`!x:A. !s t. (x INSERT s) SUBSET t <=> (x IN t /\ s SUBSET t)`, SET_TAC[]);; let SUBSET_INSERT = prove (`!x:A. !s. ~(x IN s) ==> !t. s SUBSET (x INSERT t) <=> s SUBSET t`, SET_TAC[]);; let INSERT_DIFF = prove (`!s t. !x:A. (x INSERT s) DIFF t = if x IN t then s DIFF t else x INSERT (s DIFF t)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let INSERT_AC = prove (`(x INSERT (y INSERT s) = y INSERT (x INSERT s)) /\ (x INSERT (x INSERT s) = x INSERT s)`, REWRITE_TAC[INSERT_COMM; INSERT_INSERT]);; let INTER_ACI = prove (`(p INTER q = q INTER p) /\ ((p INTER q) INTER r = p INTER q INTER r) /\ (p INTER q INTER r = q INTER p INTER r) /\ (p INTER p = p) /\ (p INTER p INTER q = p INTER q)`, SET_TAC[]);; let UNION_ACI = prove (`(p UNION q = q UNION p) /\ ((p UNION q) UNION r = p UNION q UNION r) /\ (p UNION q UNION r = q UNION p UNION r) /\ (p UNION p = p) /\ (p UNION p UNION q = p UNION q)`, SET_TAC[]);; let DELETE_NON_ELEMENT = prove (`!x:A. !s. ~(x IN s) <=> (s DELETE x = s)`, SET_TAC[]);; let IN_DELETE_EQ = prove (`!s x. !x':A. (x IN s <=> x' IN s) <=> (x IN (s DELETE x') <=> x' IN (s DELETE x))`, SET_TAC[]);; let EMPTY_DELETE = prove (`!x:A. EMPTY DELETE x = EMPTY`, SET_TAC[]);; let DELETE_DELETE = prove (`!x:A. !s. (s DELETE x) DELETE x = s DELETE x`, SET_TAC[]);; let DELETE_COMM = prove (`!x:A. !y. !s. (s DELETE x) DELETE y = (s DELETE y) DELETE x`, SET_TAC[]);; let DELETE_SUBSET = prove (`!x:A. !s. (s DELETE x) SUBSET s`, SET_TAC[]);; let SUBSET_DELETE = prove (`!x:A. !s t. s SUBSET (t DELETE x) <=> ~(x IN s) /\ (s SUBSET t)`, SET_TAC[]);; let SUBSET_INSERT_DELETE = prove (`!x:A. !s t. s SUBSET (x INSERT t) <=> ((s DELETE x) SUBSET t)`, SET_TAC[]);; let DIFF_INSERT = prove (`!s t. !x:A. s DIFF (x INSERT t) = (s DELETE x) DIFF t`, SET_TAC[]);; let PSUBSET_INSERT_SUBSET = prove (`!s t. s PSUBSET t <=> ?x:A. ~(x IN s) /\ (x INSERT s) SUBSET t`, SET_TAC[]);; let PSUBSET_MEMBER = prove (`!s:A->bool. !t. s PSUBSET t <=> (s SUBSET t /\ ?y. y IN t /\ ~(y IN s))`, SET_TAC[]);; let DELETE_INSERT = prove (`!x:A. !y s. (x INSERT s) DELETE y = if x = y then s DELETE y else x INSERT (s DELETE y)`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; let INSERT_DELETE = prove (`!x:A. !s. x IN s ==> (x INSERT (s DELETE x) = s)`, SET_TAC[]);; let DELETE_INTER = prove (`!s t. !x:A. (s DELETE x) INTER t = (s INTER t) DELETE x`, SET_TAC[]);; let DISJOINT_DELETE_SYM = prove (`!s t. !x:A. DISJOINT (s DELETE x) t = DISJOINT (t DELETE x) s`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Multiple union. *) (* ------------------------------------------------------------------------- *) let UNIONS_0 = prove (`UNIONS {} = {}`, SET_TAC[]);; let UNIONS_1 = prove (`UNIONS {s} = s`, SET_TAC[]);; let UNIONS_2 = prove (`UNIONS {s,t} = s UNION t`, SET_TAC[]);; let UNIONS_INSERT = prove (`UNIONS (s INSERT u) = s UNION (UNIONS u)`, SET_TAC[]);; let FORALL_IN_UNIONS = prove (`!P s. (!x. x IN UNIONS s ==> P x) <=> !t x. t IN s /\ x IN t ==> P x`, SET_TAC[]);; let EXISTS_IN_UNIONS = prove (`!P s. (?x. x IN UNIONS s /\ P x) <=> (?t x. t IN s /\ x IN t /\ P x)`, SET_TAC[]);; let EMPTY_UNIONS = prove (`!s. (UNIONS s = {}) <=> !t. t IN s ==> t = {}`, SET_TAC[]);; let INTER_UNIONS = prove (`(!s t. UNIONS s INTER t = UNIONS {x INTER t | x IN s}) /\ (!s t. t INTER UNIONS s = UNIONS {t INTER x | x IN s})`, ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_INTER] THEN MESON_TAC[IN_INTER]);; let UNIONS_SUBSET = prove (`!f t. UNIONS f SUBSET t <=> !s. s IN f ==> s SUBSET t`, SET_TAC[]);; let SUBSET_UNIONS = prove (`!f g. f SUBSET g ==> UNIONS f SUBSET UNIONS g`, SET_TAC[]);; let UNIONS_UNION = prove (`!s t. UNIONS(s UNION t) = (UNIONS s) UNION (UNIONS t)`, SET_TAC[]);; let INTERS_UNION = prove (`!s t. INTERS (s UNION t) = INTERS s INTER INTERS t`, SET_TAC[]);; let UNIONS_MONO = prove (`(!x. x IN s ==> ?y. y IN t /\ x SUBSET y) ==> UNIONS s SUBSET UNIONS t`, SET_TAC[]);; let UNIONS_MONO_IMAGE = prove (`(!x. x IN s ==> f x SUBSET g x) ==> UNIONS(IMAGE f s) SUBSET UNIONS(IMAGE g s)`, SET_TAC[]);; let UNIONS_UNIV = prove (`UNIONS (:A->bool) = (:A)`, REWRITE_TAC[EXTENSION; IN_UNIONS; IN_UNIV] THEN MESON_TAC[IN_SING]);; let UNIONS_INSERT_EMPTY = prove (`!s. UNIONS({} INSERT s) = UNIONS s`, ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_INSERT] THEN MESON_TAC[NOT_IN_EMPTY]);; let UNIONS_DELETE_EMPTY = prove (`!s. UNIONS(s DELETE {}) = UNIONS s`, ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_DELETE] THEN MESON_TAC[NOT_IN_EMPTY]);; let INTERS_EQ_UNIV = prove (`!f. INTERS f = (:A) <=> !s. s IN f ==> s = (:A)`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Multiple intersection. *) (* ------------------------------------------------------------------------- *) let INTERS_0 = prove (`INTERS {} = (:A)`, SET_TAC[]);; let INTERS_1 = prove (`INTERS {s} = s`, SET_TAC[]);; let INTERS_2 = prove (`INTERS {s,t} = s INTER t`, SET_TAC[]);; let INTERS_INSERT = prove (`INTERS (s INSERT u) = s INTER (INTERS u)`, SET_TAC[]);; let SUBSET_INTERS = prove (`!s f. s SUBSET INTERS f <=> (!t. t IN f ==> s SUBSET t)`, SET_TAC[]);; let INTERS_SUBSET = prove (`!u s:A->bool. ~(u = {}) /\ (!t. t IN u ==> t SUBSET s) ==> INTERS u SUBSET s`, SET_TAC[]);; let INTERS_SUBSET_STRONG = prove (`!u s:A->bool. (?t. t IN u /\ t SUBSET s) ==> INTERS u SUBSET s`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Image. *) (* ------------------------------------------------------------------------- *) let IMAGE_CLAUSES = prove (`(IMAGE f {} = {}) /\ (IMAGE f (x INSERT s) = (f x) INSERT (IMAGE f s))`, REWRITE_TAC[IMAGE; IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT; EXTENSION] THEN MESON_TAC[]);; let IMAGE_UNION = prove (`!f s t. IMAGE f (s UNION t) = (IMAGE f s) UNION (IMAGE f t)`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNION] THEN MESON_TAC[]);; let IMAGE_ID = prove (`!s. IMAGE (\x. x) s = s`, REWRITE_TAC[EXTENSION; IN_IMAGE; UNWIND_THM1]);; let IMAGE_I = prove (`!s. IMAGE I s = s`, REWRITE_TAC[I_DEF; IMAGE_ID]);; let IMAGE_o = prove (`!f g s. IMAGE (f o g) s = IMAGE f (IMAGE g s)`, REWRITE_TAC[EXTENSION; IN_IMAGE; o_THM] THEN MESON_TAC[]);; let IMAGE_SUBSET = prove (`!f s t. s SUBSET t ==> (IMAGE f s) SUBSET (IMAGE f t)`, REWRITE_TAC[SUBSET; IN_IMAGE] THEN MESON_TAC[]);; let IMAGE_INTER_INJ = prove (`!f s t. (!x y. (f(x) = f(y)) ==> (x = y)) ==> (IMAGE f (s INTER t) = (IMAGE f s) INTER (IMAGE f t))`, REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTER] THEN MESON_TAC[]);; let IMAGE_DIFF_INJ = prove (`!f:A->B s t. (!x y. x IN s /\ y IN t /\ f x = f y ==> x = y) ==> IMAGE f (s DIFF t) = IMAGE f s DIFF IMAGE f t`, SET_TAC[]);; let IMAGE_DIFF_INJ_ALT = prove (`!f:A->B s t. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ t SUBSET s ==> IMAGE f (s DIFF t) = IMAGE f s DIFF IMAGE f t`, SET_TAC[]);; let IMAGE_DELETE_INJ = prove (`!f:A->B s a. (!x. x IN s /\ f x = f a ==> x = a) ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a`, SET_TAC[]);; let IMAGE_DELETE_INJ_ALT = prove (`!f:A->B s a. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ a IN s ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a`, SET_TAC[]);; let IMAGE_EQ_EMPTY = prove (`!f s. (IMAGE f s = {}) <=> (s = {})`, REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_IMAGE] THEN MESON_TAC[]);; let FORALL_IN_IMAGE = prove (`!f s. (!y. y IN IMAGE f s ==> P y) <=> (!x. x IN s ==> P(f x))`, REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; let EXISTS_IN_IMAGE = prove (`!f s. (?y. y IN IMAGE f s /\ P y) <=> ?x. x IN s /\ P(f x)`, REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; let FORALL_IN_IMAGE_2 = prove (`!f P s. (!x y. x IN IMAGE f s /\ y IN IMAGE f s ==> P x y) <=> (!x y. x IN s /\ y IN s ==> P (f x) (f y))`, SET_TAC[]);; let IMAGE_CONST = prove (`!s c. IMAGE (\x. c) s = if s = {} then {} else {c}`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; let SIMPLE_IMAGE = prove (`!f s. {f x | x IN s} = IMAGE f s`, REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[]);; let SIMPLE_IMAGE_GEN = prove (`!f P. {f x | P x} = IMAGE f {x | P x}`, SET_TAC[]);; let IMAGE_UNIONS = prove (`!f s. IMAGE f (UNIONS s) = UNIONS (IMAGE (IMAGE f) s)`, ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_IMAGE] THEN MESON_TAC[]);; let FUN_IN_IMAGE = prove (`!f s x. x IN s ==> f(x) IN IMAGE f s`, SET_TAC[]);; let SURJECTIVE_IMAGE_EQ = prove (`!s t. (!y. y IN t ==> ?x. f x = y) /\ (!x. (f x) IN t <=> x IN s) ==> IMAGE f s = t`, SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Misc lemmas. *) (* ------------------------------------------------------------------------- *) let EMPTY_GSPEC = prove (`{x | F} = {}`, SET_TAC[]);; let UNIV_GSPEC = prove (`{x | T} = UNIV`, SET_TAC[]);; let SING_GSPEC = prove (`(!a. {x | x = a} = {a}) /\ (!a. {x | a = x} = {a})`, SET_TAC[]);; let IN_ELIM_PAIR_THM = prove (`!P a b. (a,b) IN {(x,y) | P x y} <=> P a b`, REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[PAIR_EQ]);; let SET_PAIR_THM = prove (`!P. {p | P p} = {(a,b) | P(a,b)}`, REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_THM; IN_ELIM_PAIR_THM]);; let FORALL_IN_GSPEC = prove (`(!P f. (!z. z IN {f x | P x} ==> Q z) <=> (!x. P x ==> Q(f x))) /\ (!P f. (!z. z IN {f x y | P x y} ==> Q z) <=> (!x y. P x y ==> Q(f x y))) /\ (!P f. (!z. z IN {f w x y | P w x y} ==> Q z) <=> (!w x y. P w x y ==> Q(f w x y))) /\ (!P f. (!z. z IN {f v w x y | P v w x y} ==> Q z) <=> (!v w x y. P v w x y ==> Q(f v w x y)))`, SET_TAC[]);; let EXISTS_IN_GSPEC = prove (`(!P f. (?z. z IN {f x | P x} /\ Q z) <=> (?x. P x /\ Q(f x))) /\ (!P f. (?z. z IN {f x y | P x y} /\ Q z) <=> (?x y. P x y /\ Q(f x y))) /\ (!P f. (?z. z IN {f w x y | P w x y} /\ Q z) <=> (?w x y. P w x y /\ Q(f w x y))) /\ (!P f. (?z. z IN {f v w x y | P v w x y} /\ Q z) <=> (?v w x y. P v w x y /\ Q(f v w x y)))`, SET_TAC[]);; let SET_PROVE_CASES = prove (`!P:(A->bool)->bool. P {} /\ (!a s. ~(a IN s) ==> P(a INSERT s)) ==> !s. P s`, MESON_TAC[SET_CASES]);; let UNIONS_IMAGE = prove (`!f s. UNIONS (IMAGE f s) = {y | ?x. x IN s /\ y IN f x}`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; let INTERS_IMAGE = prove (`!f s. INTERS (IMAGE f s) = {y | !x. x IN s ==> y IN f x}`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; let UNIONS_GSPEC = prove (`(!P f. UNIONS {f x | P x} = {a | ?x. P x /\ a IN (f x)}) /\ (!P f. UNIONS {f x y | P x y} = {a | ?x y. P x y /\ a IN (f x y)}) /\ (!P f. UNIONS {f x y z | P x y z} = {a | ?x y z. P x y z /\ a IN (f x y z)})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[]);; let INTERS_GSPEC = prove (`(!P f. INTERS {f x | P x} = {a | !x. P x ==> a IN (f x)}) /\ (!P f. INTERS {f x y | P x y} = {a | !x y. P x y ==> a IN (f x y)}) /\ (!P f. INTERS {f x y z | P x y z} = {a | !x y z. P x y z ==> a IN (f x y z)})`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; let IMAGE_INTERS = prove (`!f s. ~(s = {}) /\ (!x y. x IN UNIONS s /\ y IN UNIONS s /\ f x = f y ==> x = y) ==> IMAGE f (INTERS s) = INTERS(IMAGE (IMAGE f) s)`, REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]);; let DIFF_INTERS = prove (`!u s. u DIFF INTERS s = UNIONS {u DIFF t | t IN s}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]);; let INTERS_UNIONS = prove (`!s. INTERS s = UNIV DIFF (UNIONS {UNIV DIFF t | t IN s})`, REWRITE_TAC[GSYM DIFF_INTERS] THEN SET_TAC[]);; let UNIONS_INTERS = prove (`!s. UNIONS s = UNIV DIFF (INTERS {UNIV DIFF t | t IN s})`, GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_UNIV; IN_DIFF; INTERS_GSPEC; IN_ELIM_THM] THEN MESON_TAC[]);; let UNIONS_DIFF = prove (`!s t. UNIONS s DIFF t = UNIONS {x DIFF t | x IN s}`, REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]);; let DIFF_UNIONS = prove (`!u s. u DIFF UNIONS s = u INTER INTERS {u DIFF t | t IN s}`, REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]);; let DIFF_UNIONS_NONEMPTY = prove (`!u s. ~(s = {}) ==> u DIFF UNIONS s = INTERS {u DIFF t | t IN s}`, REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]);; let INTERS_OVER_UNIONS = prove (`!f:A->(B->bool)->bool s. INTERS { UNIONS(f x) | x IN s} = UNIONS { INTERS {g x | x IN s} |g| !x. x IN s ==> g x IN f x}`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[SIMPLE_IMAGE; INTERS_IMAGE; UNIONS_IMAGE; UNIONS_GSPEC] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `b:B` THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN MESON_TAC[]);; let INTER_INTERS = prove (`(!f s:A->bool. s INTER INTERS f = if f = {} then s else INTERS {s INTER t | t IN f}) /\ (!f s:A->bool. INTERS f INTER s = if f = {} then s else INTERS {t INTER s | t IN f})`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; INTERS_GSPEC] THEN ASM SET_TAC[]);; let UNIONS_OVER_INTERS = prove (`!f:A->(B->bool)->bool s. UNIONS { INTERS(f x) | x IN s} = INTERS { UNIONS {g x | x IN s} |g| !x. x IN s ==> g x IN f x}`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[SIMPLE_IMAGE; INTERS_IMAGE; UNIONS_IMAGE; INTERS_GSPEC] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN REWRITE_TAC[AND_FORALL_THM; GSYM SKOLEM_THM] THEN MESON_TAC[]);; let IMAGE_INTERS_SUBSET = prove (`!(f:A->B) g. IMAGE f (INTERS g) SUBSET INTERS (IMAGE (IMAGE f) g)`, REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]);; let IMAGE_INTER_SUBSET = prove (`!f s t. IMAGE f (s INTER t) SUBSET IMAGE f s INTER IMAGE f t`, SET_TAC[]);; let IMAGE_INTER_SATURATED_GEN = prove (`!f:A->B s t u. {x | x IN u /\ f(x) IN IMAGE f s} SUBSET s /\ t SUBSET u \/ {x | x IN u /\ f(x) IN IMAGE f t} SUBSET t /\ s SUBSET u ==> IMAGE f (s INTER t) = IMAGE f s INTER IMAGE f t`, SET_TAC[]);; let IMAGE_INTERS_SATURATED_GEN = prove (`!f:A->B g s u. ~(g = {}) /\ (!t. t IN g ==> t SUBSET u) /\ (!t. t IN g DELETE s ==> {x | x IN u /\ f(x) IN IMAGE f t} SUBSET t) ==> IMAGE f (INTERS g) = INTERS (IMAGE (IMAGE f) g)`, let lemma = prove (`~(g = {}) /\ (!t. t IN g ==> t SUBSET u /\ {x | x IN u /\ f(x) IN IMAGE f t} SUBSET t) ==> IMAGE f (INTERS g) = INTERS (IMAGE (IMAGE f) g)`, ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[INTERS_IMAGE; IN_INTERS; IN_IMAGE] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM; NOT_IN_EMPTY] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ; FORALL_UNWIND_THM2] THEN SET_TAC[]) in REPEAT GEN_TAC THEN ASM_CASES_TAC `(s:A->bool) IN g` THEN ASM_SIMP_TAC[SET_RULE `~(s IN g) ==> g DELETE s = g`] THENL [ALL_TAC; MESON_TAC[lemma]] THEN REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`)) THEN REWRITE_TAC[FORALL_IN_INSERT; NOT_INSERT_EMPTY] THEN STRIP_TAC THEN ASM_CASES_TAC `g DELETE (s:A->bool) = {}` THEN ASM_REWRITE_TAC[IMAGE_CLAUSES; INTERS_0; INTERS_1] THEN REWRITE_TAC[IMAGE_CLAUSES; INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE `IMAGE f (s INTER t) = IMAGE f s INTER IMAGE f t /\ IMAGE f t = u ==> IMAGE f (s INTER t) = IMAGE f s INTER u`) THEN CONJ_TAC THENL [MATCH_MP_TAC IMAGE_INTER_SATURATED_GEN THEN EXISTS_TAC `u:A->bool` THEN ASM SET_TAC[]; MATCH_MP_TAC lemma THEN ASM SET_TAC[]]);; let IMAGE_INTER_SATURATED = prove (`!f:A->B s t. {x | f(x) IN IMAGE f s} SUBSET s \/ {x | f(x) IN IMAGE f t} SUBSET t ==> IMAGE f (s INTER t) = IMAGE f s INTER IMAGE f t`, SET_TAC[]);; let IMAGE_INTERS_SATURATED = prove (`!f:A->B g s. ~(g = {}) /\ (!t. t IN g DELETE s ==> {x | f(x) IN IMAGE f t} SUBSET t) ==> IMAGE f (INTERS g) = INTERS (IMAGE (IMAGE f) g)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC IMAGE_INTERS_SATURATED_GEN THEN MAP_EVERY EXISTS_TAC [`s:A->bool`; `(:A)`] THEN ASM_REWRITE_TAC[IN_UNIV; SUBSET_UNIV]);; (* ------------------------------------------------------------------------- *) (* Stronger form of induction is sometimes handy. *) (* ------------------------------------------------------------------------- *) let FINITE_INDUCT_STRONG = prove (`!P:(A->bool)->bool. P {} /\ (!x s. P s /\ ~(x IN s) /\ FINITE s ==> P(x INSERT s)) ==> !s. FINITE s ==> P s`, GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `!s:A->bool. FINITE s ==> FINITE s /\ P s` MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN MATCH_MP_TAC FINITE_INDUCT THEN ASM_SIMP_TAC[FINITE_RULES] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `x:A IN s` THENL [SUBGOAL_THEN `x:A INSERT s = s` (fun th -> ASM_REWRITE_TAC[th]) THEN UNDISCH_TAC `x:A IN s` THEN SET_TAC[]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Useful general properties of functions. *) (* ------------------------------------------------------------------------- *) let INJECTIVE_ON_ALT = prove (`!P f. (!x y. P x /\ P y /\ f x = f y ==> x = y) <=> (!x y. P x /\ P y ==> (f x = f y <=> x = y))`, MESON_TAC[]);; let INJECTIVE_ALT = prove (`!f. (!x y. f x = f y ==> x = y) <=> (!x y. f x = f y <=> x = y)`, MESON_TAC[]);; let SURJECTIVE_ON_RIGHT_INVERSE = prove (`!f t. (!y. y IN t ==> ?x. x IN s /\ (f(x) = y)) <=> (?g. !y. y IN t ==> g(y) IN s /\ (f(g(y)) = y))`, REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM]);; let INJECTIVE_ON_LEFT_INVERSE = prove (`!f s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) <=> (?g. !x. x IN s ==> (g(f(x)) = x))`, let lemma = MESON[] `(!x. x IN s ==> (g(f(x)) = x)) <=> (!y x. x IN s /\ (y = f x) ==> (g y = x))` in REWRITE_TAC[lemma; GSYM SKOLEM_THM] THEN MESON_TAC[]);; let BIJECTIVE_ON_LEFT_RIGHT_INVERSE = prove (`!f s t. (!x. x IN s ==> f(x) IN t) ==> ((!x y. x IN s /\ y IN s /\ f(x) = f(y) ==> x = y) /\ (!y. y IN t ==> ?x. x IN s /\ f x = y) <=> ?g. (!y. y IN t ==> g(y) IN s) /\ (!y. y IN t ==> (f(g(y)) = y)) /\ (!x. x IN s ==> (g(f(x)) = x)))`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; SURJECTIVE_ON_RIGHT_INVERSE] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN ASM_MESON_TAC[]);; let SURJECTIVE_RIGHT_INVERSE = prove (`(!y. ?x. f(x) = y) <=> (?g. !y. f(g(y)) = y)`, MESON_TAC[SURJECTIVE_ON_RIGHT_INVERSE; IN_UNIV]);; let INJECTIVE_LEFT_INVERSE = prove (`(!x y. (f x = f y) ==> (x = y)) <=> (?g. !x. g(f(x)) = x)`, let th = REWRITE_RULE[IN_UNIV] (ISPECL [`f:A->B`; `UNIV:A->bool`] INJECTIVE_ON_LEFT_INVERSE) in REWRITE_TAC[th]);; let BIJECTIVE_LEFT_RIGHT_INVERSE = prove (`!f:A->B. (!x y. f(x) = f(y) ==> x = y) /\ (!y. ?x. f x = y) <=> ?g. (!y. f(g(y)) = y) /\ (!x. g(f(x)) = x)`, GEN_TAC THEN MP_TAC(ISPECL [`f:A->B`; `(:A)`; `(:B)`] BIJECTIVE_ON_LEFT_RIGHT_INVERSE) THEN REWRITE_TAC[IN_UNIV]);; let FUNCTION_FACTORS_LEFT_GEN = prove (`!P f g. (!x y. P x /\ P y /\ g x = g y ==> f x = f y) <=> (?h. !x. P x ==> f(x) = h(g x))`, ONCE_REWRITE_TAC[MESON[] `(!x. P x ==> f(x) = g(k x)) <=> (!y x. P x /\ y = k x ==> f x = g y)`] THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN MESON_TAC[]);; let FUNCTION_FACTORS_LEFT = prove (`!f g. (!x y. (g x = g y) ==> (f x = f y)) <=> ?h. f = h o g`, REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM(REWRITE_RULE[] (ISPEC `\x. T` FUNCTION_FACTORS_LEFT_GEN))]);; let FUNCTION_FACTORS_RIGHT_GEN = prove (`!P f g. (!x. P x ==> ?y. g(y) = f(x)) <=> (?h. !x. P x ==> f(x) = g(h x))`, REWRITE_TAC[GSYM SKOLEM_THM] THEN MESON_TAC[]);; let FUNCTION_FACTORS_RIGHT = prove (`!f g. (!x. ?y. g(y) = f(x)) <=> ?h. f = g o h`, REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM SKOLEM_THM] THEN MESON_TAC[]);; let SURJECTIVE_FORALL_THM = prove (`!f:A->B. (!y. ?x. f x = y) <=> (!P. (!x. P(f x)) <=> (!y. P y))`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN MESON_TAC[]);; let SURJECTIVE_EXISTS_THM = prove (`!f:A->B. (!y. ?x. f x = y) <=> (!P. (?x. P(f x)) <=> (?y. P y))`, GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `\y:B. !x:A. ~(f x = y)`) THEN MESON_TAC[]);; let SURJECTIVE_IMAGE_THM = prove (`!f:A->B. (!y. ?x. f x = y) <=> (!P. IMAGE f {x | P(f x)} = {x | P x})`, GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN EQ_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `\y:B. T`)] THEN MESON_TAC[]);; let IMAGE_INJECTIVE_IMAGE_OF_SUBSET = prove (`!f:A->B s. ?t. t SUBSET s /\ IMAGE f s = IMAGE f t /\ (!x y. x IN t /\ y IN t /\ f x = f y ==> x = y)`, REPEAT GEN_TAC THEN SUBGOAL_THEN `?g. !y. y IN IMAGE (f:A->B) s ==> g(y) IN s /\ f(g(y)) = y` STRIP_ASSUME_TAC THENL [REWRITE_TAC[GSYM SURJECTIVE_ON_RIGHT_INVERSE] THEN SET_TAC[]; EXISTS_TAC `IMAGE (g:B->A) (IMAGE (f:A->B) s)` THEN ASM SET_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Basic combining theorems for finite sets. *) (* ------------------------------------------------------------------------- *) let FINITE_EMPTY = prove (`FINITE {}`, REWRITE_TAC[FINITE_RULES]);; let FINITE_SUBSET = prove (`!(s:A->bool) t. FINITE t /\ s SUBSET t ==> FINITE s`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL [MESON_TAC[SUBSET_EMPTY; FINITE_RULES]; ALL_TAC] THEN X_GEN_TAC `x:A` THEN X_GEN_TAC `u:A->bool` THEN DISCH_TAC THEN X_GEN_TAC `t:A->bool` THEN DISCH_TAC THEN SUBGOAL_THEN `FINITE((x:A) INSERT (t DELETE x))` ASSUME_TAC THENL [MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `t SUBSET (x:A INSERT u)` THEN SET_TAC[]; ASM_CASES_TAC `x:A IN t` THENL [SUBGOAL_THEN `x:A INSERT (t DELETE x) = t` SUBST_ALL_TAC THENL [UNDISCH_TAC `x:A IN t` THEN SET_TAC[]; ASM_REWRITE_TAC[]]; FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `t SUBSET x:A INSERT u` THEN UNDISCH_TAC `~(x:A IN t)` THEN SET_TAC[]]]);; let FINITE_RESTRICT = prove (`!s:A->bool P. FINITE s ==> FINITE {x | x IN s /\ P x}`, MESON_TAC[SUBSET_RESTRICT; FINITE_SUBSET]);; let FINITE_UNION_IMP = prove (`!(s:A->bool) t. FINITE s /\ FINITE t ==> FINITE (s UNION t)`, REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT THEN REWRITE_TAC[UNION_EMPTY] THEN SUBGOAL_THEN `!x s t. (x:A INSERT s) UNION t = x INSERT (s UNION t)` (fun th -> REWRITE_TAC[th]) THENL [SET_TAC[]; MESON_TAC[FINITE_RULES]]);; let FINITE_UNION = prove (`!(s:A->bool) t. FINITE(s UNION t) <=> FINITE(s) /\ FINITE(t)`, REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `(s:A->bool) UNION t` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_ACCEPT_TAC FINITE_UNION_IMP]);; let FINITE_INTER = prove (`!(s:A->bool) t. FINITE s \/ FINITE t ==> FINITE (s INTER t)`, MESON_TAC[INTER_SUBSET; FINITE_SUBSET]);; let FINITE_INSERT = prove (`!(s:A->bool) x. FINITE (x INSERT s) <=> FINITE s`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `x:A INSERT s` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN ASM_REWRITE_TAC[]]);; let FINITE_SING = prove (`!a. FINITE {a}`, REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; let FINITE_DELETE_IMP = prove (`!(s:A->bool) x. FINITE s ==> FINITE (s DELETE x)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; let FINITE_DELETE = prove (`!(s:A->bool) x. FINITE (s DELETE x) <=> FINITE s`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[FINITE_DELETE_IMP] THEN ASM_CASES_TAC `x:A IN s` THENL [SUBGOAL_THEN `s = x INSERT (s DELETE x:A)` (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[FINITE_INSERT] THEN POP_ASSUM MP_TAC THEN SET_TAC[]; SUBGOAL_THEN `s DELETE x:A = s` (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM MP_TAC THEN SET_TAC[]]);; let FINITE_FINITE_UNIONS = prove (`!s. FINITE(s) ==> (FINITE(UNIONS s) <=> (!t. t IN s ==> FINITE(t)))`, MATCH_MP_TAC FINITE_INDUCT THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; UNIONS_0; UNIONS_INSERT] THEN REWRITE_TAC[FINITE_UNION; FINITE_RULES] THEN MESON_TAC[]);; let FINITE_IMAGE_EXPAND = prove (`!(f:A->B) s. FINITE s ==> FINITE {y | ?x. x IN s /\ (y = f x)}`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT THEN REWRITE_TAC[NOT_IN_EMPTY; REWRITE_RULE[] EMPTY_GSPEC; FINITE_RULES] THEN REPEAT GEN_TAC THEN SUBGOAL_THEN `{y | ?z. z IN (x INSERT s) /\ (y = (f:A->B) z)} = {y | ?z. z IN s /\ (y = f z)} UNION {(f x)}` (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN MESON_TAC[]; REWRITE_TAC[FINITE_UNION; FINITE_INSERT; FINITE_RULES]]);; let FINITE_IMAGE = prove (`!(f:A->B) s. FINITE s ==> FINITE (IMAGE f s)`, REWRITE_TAC[IMAGE; FINITE_IMAGE_EXPAND]);; let FINITE_IMAGE_INJ_GENERAL = prove (`!(f:A->B) A s. (!x y. x IN s /\ y IN s /\ f(x) = f(y) ==> x = y) /\ FINITE A ==> FINITE {x | x IN s /\ f(x) IN A}`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (g:B->A) A` THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[]);; let FINITE_FINITE_PREIMAGE_GENERAL = prove (`!f:A->B s t. FINITE t /\ (!y. y IN t ==> FINITE {x | x IN s /\ f(x) = y}) ==> FINITE {x | x IN s /\ f(x) IN t}`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x | x IN s /\ (f:A->B)(x) IN t} = UNIONS (IMAGE (\a. {x | x IN s /\ f x = a}) t)` SUBST1_TAC THENL [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIONS] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN SET_TAC[]; ASM_SIMP_TAC[FINITE_FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE]]);; let FINITE_FINITE_PREIMAGE = prove (`!f:A->B t. FINITE t /\ (!y. y IN t ==> FINITE {x | f(x) = y}) ==> FINITE {x | f(x) IN t}`, REPEAT GEN_TAC THEN MP_TAC (ISPECL [`f:A->B`; `(:A)`; `t:B->bool`] FINITE_FINITE_PREIMAGE_GENERAL) THEN REWRITE_TAC[IN_UNIV]);; let FINITE_IMAGE_INJ_EQ = prove (`!(f:A->B) s. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) ==> (FINITE(IMAGE f s) <=> FINITE s)`, REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP FINITE_IMAGE_INJ_GENERAL) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; let FINITE_IMAGE_INJ = prove (`!(f:A->B) A. (!x y. (f(x) = f(y)) ==> (x = y)) /\ FINITE A ==> FINITE {x | f(x) IN A}`, REPEAT GEN_TAC THEN MP_TAC(SPECL [`f:A->B`; `A:B->bool`; `UNIV:A->bool`] FINITE_IMAGE_INJ_GENERAL) THEN REWRITE_TAC[IN_UNIV]);; let INFINITE_IMAGE = prove (`!f:A->B s. INFINITE s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> INFINITE (IMAGE f s)`, REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ_ALT; INJECTIVE_ON_LEFT_INVERSE] THEN DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN DISCH_TAC THEN SUBGOAL_THEN `s = IMAGE (g:B->A) (IMAGE f s)` SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]]);; let INFINITE_IMAGE_INJ = prove (`!f:A->B. (!x y. (f x = f y) ==> (x = y)) ==> !s. INFINITE s ==> INFINITE(IMAGE f s)`, MESON_TAC[INFINITE_IMAGE]);; let INFINITE_NONEMPTY = prove (`!s. INFINITE(s) ==> ~(s = EMPTY)`, MESON_TAC[INFINITE; FINITE_RULES]);; let INFINITE_DIFF_FINITE = prove (`!s:A->bool t. INFINITE(s) /\ FINITE(t) ==> INFINITE(s DIFF t)`, REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(b /\ ~c ==> ~a) ==> a /\ b ==> c`) THEN REWRITE_TAC[INFINITE] THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `(t:A->bool) UNION (s DIFF t)` THEN ASM_REWRITE_TAC[FINITE_UNION] THEN SET_TAC[]);; let SUBSET_IMAGE_INJ = prove (`!f:A->B s t. s SUBSET (IMAGE f t) <=> ?u. u SUBSET t /\ (!x y. x IN u /\ y IN u ==> (f x = f y <=> x = y)) /\ s = IMAGE f u`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[IMAGE_SUBSET]] THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `s SUBSET IMAGE f t ==> !x. x IN s ==> ?y. y IN t /\ f y = x`)) THEN REWRITE_TAC[SURJECTIVE_ON_RIGHT_INVERSE] THEN DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN EXISTS_TAC `IMAGE (g:B->A) s` THEN ASM SET_TAC[]);; let SUBSET_IMAGE = prove (`!f:A->B s t. s SUBSET (IMAGE f t) <=> ?u. u SUBSET t /\ (s = IMAGE f u)`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[IMAGE_SUBSET]] THEN REWRITE_TAC[SUBSET_IMAGE_INJ] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; let EXISTS_SUBSET_IMAGE = prove (`!P f s. (?t. t SUBSET IMAGE f s /\ P t) <=> (?t. t SUBSET s /\ P (IMAGE f t))`, REWRITE_TAC[SUBSET_IMAGE] THEN MESON_TAC[]);; let FORALL_SUBSET_IMAGE = prove (`!P f s. (!t. t SUBSET IMAGE f s ==> P t) <=> (!t. t SUBSET s ==> P(IMAGE f t))`, REWRITE_TAC[SUBSET_IMAGE] THEN MESON_TAC[]);; let EXISTS_SUBSET_IMAGE_INJ = prove (`!P f s. (?t. t SUBSET IMAGE f s /\ P t) <=> (?t. t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) /\ P (IMAGE f t))`, REWRITE_TAC[SUBSET_IMAGE_INJ] THEN MESON_TAC[]);; let FORALL_SUBSET_IMAGE_INJ = prove (`!P f s. (!t. t SUBSET IMAGE f s ==> P t) <=> (!t. t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) ==> P(IMAGE f t))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MESON[] `(!t. p t) <=> ~(?t. ~p t)`] THEN REWRITE_TAC[NOT_IMP; EXISTS_SUBSET_IMAGE_INJ; GSYM CONJ_ASSOC]);; let EXISTS_FINITE_SUBSET_IMAGE_INJ = prove (`!P f s. (?t. FINITE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. FINITE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) /\ P (IMAGE f t))`, ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN REPEAT GEN_TAC THEN REWRITE_TAC[EXISTS_SUBSET_IMAGE_INJ] THEN AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[FINITE_IMAGE_INJ_EQ]);; let FORALL_FINITE_SUBSET_IMAGE_INJ = prove (`!P f s. (!t. FINITE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. FINITE t /\ t SUBSET s /\ (!x y. x IN t /\ y IN t ==> (f x = f y <=> x = y)) ==> P(IMAGE f t))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MESON[] `(!t. p t) <=> ~(?t. ~p t)`] THEN REWRITE_TAC[NOT_IMP; EXISTS_FINITE_SUBSET_IMAGE_INJ; GSYM CONJ_ASSOC]);; let EXISTS_FINITE_SUBSET_IMAGE = prove (`!P f s. (?t. FINITE t /\ t SUBSET IMAGE f s /\ P t) <=> (?t. FINITE t /\ t SUBSET s /\ P (IMAGE f t))`, REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE_INJ] THEN MESON_TAC[]; MESON_TAC[FINITE_IMAGE; IMAGE_SUBSET]]);; let FORALL_FINITE_SUBSET_IMAGE = prove (`!P f s. (!t. FINITE t /\ t SUBSET IMAGE f s ==> P t) <=> (!t. FINITE t /\ t SUBSET s ==> P(IMAGE f t))`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[MESON[] `(!x. P x) <=> ~(?x. ~P x)`] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; EXISTS_FINITE_SUBSET_IMAGE]);; let FINITE_SUBSET_IMAGE = prove (`!f:A->B s t. FINITE(t) /\ t SUBSET (IMAGE f s) <=> ?s'. FINITE s' /\ s' SUBSET s /\ (t = IMAGE f s')`, REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[FINITE_IMAGE; IMAGE_SUBSET]] THEN SPEC_TAC(`t:B->bool`,`t:B->bool`) THEN REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN MESON_TAC[]);; let FINITE_SUBSET_IMAGE_IMP = prove (`!f:A->B s t. FINITE(t) /\ t SUBSET (IMAGE f s) ==> ?s'. FINITE s' /\ s' SUBSET s /\ t SUBSET (IMAGE f s')`, MESON_TAC[SUBSET_REFL; FINITE_SUBSET_IMAGE]);; let FINITE_DIFF = prove (`!s t. FINITE s ==> FINITE(s DIFF t)`, MESON_TAC[FINITE_SUBSET; SUBSET_DIFF]);; let INFINITE_SUPERSET = prove (`!s t. INFINITE s /\ s SUBSET t ==> INFINITE t`, REWRITE_TAC[INFINITE] THEN MESON_TAC[FINITE_SUBSET]);; let FINITE_TRANSITIVITY_CHAIN = prove (`!R s:A->bool. FINITE s /\ (!x. ~(R x x)) /\ (!x y z. R x y /\ R y z ==> R x z) /\ (!x. x IN s ==> ?y. y IN s /\ R x y) ==> s = {}`, GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY] THEN SET_TAC[]);; let UNIONS_MAXIMAL_SETS = prove (`!f. FINITE f ==> UNIONS {t:A->bool | t IN f /\ !u. u IN f ==> ~(t PSUBSET u)} = UNIONS f`, SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIONS; SUBSET_RESTRICT] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC UNIONS_MONO THEN X_GEN_TAC `s:A->bool` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN DISCH_TAC THEN MP_TAC(ISPECL [`\t u:A->bool. s SUBSET t /\ t PSUBSET u`; `{t:A->bool | t IN f /\ s SUBSET t}`]FINITE_TRANSITIVITY_CHAIN) THEN ASM_SIMP_TAC[NOT_IMP; FINITE_RESTRICT; FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN REPEAT CONJ_TAC THENL [SET_TAC[]; SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN ASM_MESON_TAC[PSUBSET_TRANS; SUBSET_PSUBSET_TRANS; PSUBSET]);; let FINITE_SUBSET_UNIONS = prove (`!f s:A->bool. FINITE s /\ s SUBSET UNIONS f ==> ?f'. FINITE f' /\ f' SUBSET f /\ s SUBSET UNIONS f'`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIONS; RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:A->A->bool` THEN DISCH_TAC THEN EXISTS_TAC `IMAGE (u:A->A->bool) s` THEN ASM_SIMP_TAC[FINITE_IMAGE; UNIONS_IMAGE] THEN ASM SET_TAC[]);; let UNIONS_IN_CHAIN = prove (`!f:(A->bool)->bool. FINITE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> UNIONS f IN f`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT; UNIONS_INSERT] THEN REWRITE_TAC[FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; NOT_INSERT_EMPTY] THEN MAP_EVERY X_GEN_TAC [`s:A->bool`; `f:(A->bool)->bool`] THEN ASM_CASES_TAC `f:(A->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; IN_INSERT; UNION_EMPTY] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `s UNION t = s \/ s UNION t = t ==> t IN f ==> s UNION t = s \/ s UNION t IN f`) THEN ASM SET_TAC[]);; let INTERS_IN_CHAIN = prove (`!f:(A->bool)->bool. FINITE f /\ ~(f = {}) /\ (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) ==> INTERS f IN f`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT; INTERS_INSERT] THEN REWRITE_TAC[FORALL_AND_THM; TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; NOT_INSERT_EMPTY] THEN MAP_EVERY X_GEN_TAC [`s:A->bool`; `f:(A->bool)->bool`] THEN ASM_CASES_TAC `f:(A->bool)->bool = {}` THEN ASM_REWRITE_TAC[INTERS_0; IN_INSERT; INTER_UNIV] THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] `s INTER t = s \/ s INTER t = t ==> t IN f ==> s INTER t = s \/ s INTER t IN f`) THEN ASM SET_TAC[]);; let FINITE_SUBSET_UNIONS_CHAIN = prove (`!f s:A->bool. FINITE s /\ s SUBSET UNIONS f /\ ~(f = {}) /\ (!t u. t IN f /\ u IN f ==> t SUBSET u \/ u SUBSET t) ==> ?t. t IN f /\ s SUBSET t`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:(A->bool)->bool`; `s:A->bool`] FINITE_SUBSET_UNIONS) THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `t:(A->bool)->bool` THEN ASM_CASES_TAC `t:(A->bool)->bool = {}` THENL [ASM_SIMP_TAC[UNIONS_0] THEN ASM SET_TAC[]; STRIP_TAC] THEN EXISTS_TAC `UNIONS t:A->bool` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN MATCH_MP_TAC UNIONS_IN_CHAIN THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Recursion over finite sets; based on Ching-Tsun's code (archive 713). *) (* ------------------------------------------------------------------------- *) let FINREC = new_recursive_definition num_RECURSION `(FINREC (f:A->B->B) b s a 0 <=> (s = {}) /\ (a = b)) /\ (FINREC (f:A->B->B) b s a (SUC n) <=> ?x c. x IN s /\ FINREC f b (s DELETE x) c n /\ (a = f x c))`;; let FINREC_1_LEMMA = prove (`!f b s a. FINREC f b s a (SUC 0) <=> ?x. (s = {x}) /\ (a = f x b)`, REWRITE_TAC[FINREC] THEN REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN SET_TAC[]);; let FINREC_SUC_LEMMA = prove (`!(f:A->B->B) b. (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) ==> !n s z. FINREC f b s z (SUC n) ==> !x. x IN s ==> ?w. FINREC f b (s DELETE x) w n /\ (z = f x w)`, let lem = prove(`s DELETE (x:A) DELETE y = s DELETE y DELETE x`,SET_TAC[]) in REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[FINREC_1_LEMMA] THEN REWRITE_TAC[FINREC] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `b:B` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [FINREC] THEN DISCH_THEN(X_CHOOSE_THEN `y:A` MP_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `c:B` STRIP_ASSUME_TAC) THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THENL [EXISTS_TAC `c:B` THEN ASM_REWRITE_TAC[]; UNDISCH_TAC `FINREC (f:A->B->B) b (s DELETE y) c (SUC n)` THEN DISCH_THEN(ANTE_RES_THEN (MP_TAC o SPEC `x:A`)) THEN ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `v:B` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(f:A->B->B) y v` THEN ASM_REWRITE_TAC[FINREC] THEN CONJ_TAC THENL [MAP_EVERY EXISTS_TAC [`y:A`; `v:B`] THEN ONCE_REWRITE_TAC[lem] THEN ASM_REWRITE_TAC[IN_DELETE]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]]);; let FINREC_UNIQUE_LEMMA = prove (`!(f:A->B->B) b. (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) ==> !n1 n2 s a1 a2. FINREC f b s a1 n1 /\ FINREC f b s a2 n2 ==> (a1 = a2) /\ (n1 = n2)`, REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[FINREC] THEN MESON_TAC[NOT_IN_EMPTY]; REWRITE_TAC[FINREC] THEN MESON_TAC[NOT_IN_EMPTY]; REWRITE_TAC[FINREC] THEN MESON_TAC[NOT_IN_EMPTY]; IMP_RES_THEN ASSUME_TAC FINREC_SUC_LEMMA THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN DISCH_THEN(CONJUNCTS_THEN (ANTE_RES_THEN ASSUME_TAC)) THEN REWRITE_TAC[FINREC] THEN STRIP_TAC THEN ASM_MESON_TAC[]]);; let FINREC_EXISTS_LEMMA = prove (`!(f:A->B->B) b s. FINITE s ==> ?a n. FINREC f b s a n`, let lem = prove(`~(x IN s ) ==> ((x:A INSERT s) DELETE x = s)`,SET_TAC[]) in GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REPEAT STRIP_TAC THENL [MAP_EVERY EXISTS_TAC [`b:B`; `0`] THEN REWRITE_TAC[FINREC]; MAP_EVERY EXISTS_TAC [`(f:A->B->B) x a`; `SUC n`] THEN REWRITE_TAC[FINREC] THEN MAP_EVERY EXISTS_TAC [`x:A`; `a:B`] THEN FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP lem th; IN_INSERT])]);; let FINREC_FUN_LEMMA = prove (`!P (R:A->B->C->bool). (!s. P s ==> ?a n. R s a n) /\ (!n1 n2 s a1 a2. R s a1 n1 /\ R s a2 n2 ==> (a1 = a2) /\ (n1 = n2)) ==> ?f. !s a. P s ==> ((?n. R s a n) <=> (f s = a))`, REPEAT STRIP_TAC THEN EXISTS_TAC `\s:A. @a:B. ?n:C. R s a n` THEN REPEAT STRIP_TAC THEN BETA_TAC THEN EQ_TAC THENL [STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]]);; let FINREC_FUN = prove (`!(f:A->B->B) b. (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) ==> ?g. (g {} = b) /\ !s x. FINITE s /\ x IN s ==> (g s = f x (g (s DELETE x)))`, REPEAT STRIP_TAC THEN IMP_RES_THEN MP_TAC FINREC_UNIQUE_LEMMA THEN DISCH_THEN(MP_TAC o SPEC `b:B`) THEN DISCH_THEN (MP_TAC o CONJ (SPECL [`f:A->B->B`; `b:B`] FINREC_EXISTS_LEMMA)) THEN DISCH_THEN(MP_TAC o MATCH_MP FINREC_FUN_LEMMA) THEN DISCH_THEN(X_CHOOSE_TAC `g:(A->bool)->B`) THEN EXISTS_TAC `g:(A->bool)->B` THEN CONJ_TAC THENL [SUBGOAL_THEN `FINITE(EMPTY:A->bool)` (ANTE_RES_THEN (fun th -> GEN_REWRITE_TAC I [GSYM th])) THENL [REWRITE_TAC[FINITE_RULES]; EXISTS_TAC `0` THEN REWRITE_TAC[FINREC]]; REPEAT STRIP_TAC THEN ANTE_RES_THEN MP_TAC (ASSUME `FINITE(s:A->bool)`) THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o SPEC `(g:(A->bool)->B) s`) THEN REWRITE_TAC[] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THENL [ASM_REWRITE_TAC[FINREC] THEN DISCH_TAC THEN UNDISCH_TAC `x:A IN s` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY]; IMP_RES_THEN ASSUME_TAC FINREC_SUC_LEMMA THEN DISCH_THEN(ANTE_RES_THEN (MP_TAC o SPEC `x:A`)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `w:B` (CONJUNCTS_THEN ASSUME_TAC)) THEN SUBGOAL_THEN `(g (s DELETE x:A) = w:B)` SUBST1_TAC THENL [SUBGOAL_THEN `FINITE(s DELETE x:A)` MP_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; DISCH_THEN(ANTE_RES_THEN (MP_TAC o GSYM)) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]]; ASM_REWRITE_TAC[]]]]);; let SET_RECURSION_LEMMA = prove (`!(f:A->B->B) b. (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) ==> ?g. (g {} = b) /\ !x s. FINITE s ==> (g (x INSERT s) = if x IN s then g s else f x (g s))`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `b:B` o MATCH_MP FINREC_FUN) THEN DISCH_THEN(X_CHOOSE_THEN `g:(A->bool)->B` STRIP_ASSUME_TAC) THEN EXISTS_TAC `g:(A->bool)->B` THEN ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THENL [AP_TERM_TAC THEN REWRITE_TAC[GSYM ABSORPTION] THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN `FINITE(x:A INSERT s) /\ x IN (x INSERT s)` MP_TAC THENL [REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[FINITE_RULES]; DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN REPEAT AP_TERM_TAC THEN UNDISCH_TAC `~(x:A IN s)` THEN SET_TAC[]]]);; let ITSET = new_definition `ITSET f s b = (@g. (g {} = b) /\ !x s. FINITE s ==> (g (x INSERT s) = if x IN s then g s else f x (g s))) s`;; let FINITE_RECURSION = prove (`!(f:A->B->B) b. (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) ==> (ITSET f {} b = b) /\ !x s. FINITE s ==> (ITSET f (x INSERT s) b = if x IN s then ITSET f s b else f x (ITSET f s b))`, REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ITSET] THEN CONV_TAC SELECT_CONV THEN MATCH_MP_TAC SET_RECURSION_LEMMA THEN ASM_REWRITE_TAC[]);; let FINITE_RECURSION_DELETE = prove (`!(f:A->B->B) b. (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) ==> (ITSET f {} b = b) /\ !x s. FINITE s ==> (ITSET f s b = if x IN s then f x (ITSET f (s DELETE x) b) else ITSET f (s DELETE x) b)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FINITE_RECURSION) THEN DISCH_THEN(STRIP_ASSUME_TAC o SPEC `b:B`) THEN ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC `x:A IN s` THEN ASM_REWRITE_TAC[] THENL [DISCH_THEN(MP_TAC o MATCH_MP FINITE_DELETE_IMP) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC o SPEC `x:A`) THEN DISCH_THEN(MP_TAC o SPEC `x:A`) THEN REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `x:A IN s` THEN SET_TAC[]; DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `~(x:A IN s)` THEN SET_TAC[]]);; let ITSET_EQ = prove (`!s f g b. FINITE(s) /\ (!x. x IN s ==> (f x = g x)) /\ (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) /\ (!x y s. ~(x = y) ==> (g x (g y s) = g y (g x s))) ==> (ITSET f s b = ITSET g s b)`, ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[FINITE_RECURSION; NOT_IN_EMPTY; IN_INSERT] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cardinality. *) (* ------------------------------------------------------------------------- *) let CARD = new_definition `CARD s = ITSET (\x n. SUC n) s 0`;; let CARD_CLAUSES = prove (`(CARD ({}:A->bool) = 0) /\ (!(x:A) s. FINITE s ==> (CARD (x INSERT s) = if x IN s then CARD s else SUC(CARD s)))`, MP_TAC(ISPECL [`\(x:A) n. SUC n`; `0`] FINITE_RECURSION) THEN REWRITE_TAC[CARD]);; let CARD_UNION = prove (`!(s:A->bool) t. FINITE(s) /\ FINITE(t) /\ (s INTER t = EMPTY) ==> (CARD (s UNION t) = CARD s + CARD t)`, REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a ==> b /\ c ==> d`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[UNION_EMPTY; CARD_CLAUSES; INTER_EMPTY; ADD_CLAUSES] THEN X_GEN_TAC `x:A` THEN X_GEN_TAC `s:A->bool` THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(x:A INSERT s) UNION t = x INSERT (s UNION t)` SUBST1_TAC THENL [SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `FINITE ((s:A->bool) UNION t) /\ FINITE s` STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_UNION_IMP THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(ISPECL [`x:A`; `s:A->bool`] (CONJUNCT2 CARD_CLAUSES)) THEN MP_TAC(ISPECL [`x:A`; `s:A->bool UNION t`] (CONJUNCT2 CARD_CLAUSES)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(x:A IN (s UNION t))` ASSUME_TAC THENL [ASM_REWRITE_TAC[IN_UNION] THEN UNDISCH_TAC `(x:A INSERT s) INTER t = EMPTY` THEN REWRITE_TAC[EXTENSION; IN_INSERT; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[]; ASM_REWRITE_TAC[SUC_INJ; ADD_CLAUSES] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `x:A INSERT s INTER t = EMPTY` THEN SET_TAC[]]);; let CARD_DELETE = prove (`!x:A s. FINITE(s) ==> (CARD(s DELETE x) = if x IN s then CARD(s) - 1 else CARD(s))`, REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [SUBGOAL_THEN `s = x:A INSERT (s DELETE x)` (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THENL [UNDISCH_TAC `x:A IN s` THEN SET_TAC[]; ALL_TAC] THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; IN_DELETE; SUC_SUB1]; AP_TERM_TAC THEN UNDISCH_TAC `~(x:A IN s)` THEN SET_TAC[]]);; let CARD_UNION_EQ = prove (`!s t u. FINITE u /\ (s INTER t = {}) /\ (s UNION t = u) ==> (CARD s + CARD t = CARD u)`, MESON_TAC[CARD_UNION; FINITE_SUBSET; SUBSET_UNION]);; let CARD_DIFF = prove (`!s t. FINITE s /\ t SUBSET s ==> CARD(s DIFF t) = CARD s - CARD t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE `a + b:num = c ==> a = c - b`) THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; let CARD_EQ_0 = prove (`!s. FINITE s ==> ((CARD s = 0) <=> (s = {}))`, MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CARD_CLAUSES; NOT_INSERT_EMPTY; NOT_SUC]);; let CARD_SING = prove (`!a:A. CARD {a} = 1`, SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY; ARITH]);; (* ------------------------------------------------------------------------- *) (* A stronger still form of induction where we get to choose the element. *) (* ------------------------------------------------------------------------- *) let FINITE_INDUCT_DELETE = prove (`!P. P {} /\ (!s. FINITE s /\ ~(s = {}) ==> ?x. x IN s /\ (P(s DELETE x) ==> P s)) ==> !s:A->bool. FINITE s ==> P s`, GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `CARD(s:A->bool)` THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `!s. FINITE s /\ ~(s = {}) ==> ?x:A. x IN s /\ (P(s DELETE x) ==> P s)` THEN DISCH_THEN(MP_TAC o SPEC `s:A->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 ASSUME_TAC MATCH_MP_TAC)) THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (x:A)`) THEN ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE; CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`]);; (* ------------------------------------------------------------------------- *) (* Relational form is often more useful. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE = new_definition `s HAS_SIZE n <=> FINITE s /\ (CARD s = n)`;; let HAS_SIZE_CARD = prove (`!s n. s HAS_SIZE n ==> (CARD s = n)`, SIMP_TAC[HAS_SIZE]);; let HAS_SIZE_0 = prove (`!(s:A->bool). s HAS_SIZE 0 <=> (s = {})`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_SIZE] THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[FINITE_RULES; CARD_CLAUSES] THEN FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN SPEC_TAC(`s:A->bool`,`s:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_INSERT_EMPTY] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP (CONJUNCT2 CARD_CLAUSES) th]) THEN ASM_REWRITE_TAC[NOT_SUC]);; let HAS_SIZE_SUC = prove (`!(s:A->bool) n. s HAS_SIZE (SUC n) <=> ~(s = {}) /\ !a. a IN s ==> (s DELETE a) HAS_SIZE n`, REPEAT GEN_TAC THEN REWRITE_TAC[HAS_SIZE] THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; NOT_SUC] THEN REWRITE_TAC[FINITE_DELETE] THEN ASM_CASES_TAC `FINITE(s:A->bool)` THEN ASM_REWRITE_TAC[NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [MP_TAC(ISPECL [`a:A`; `s DELETE a:A`] (CONJUNCT2 CARD_CLAUSES)) THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN SUBGOAL_THEN `a INSERT (s DELETE a:A) = s` SUBST1_TAC THENL [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; ASM_REWRITE_TAC[SUC_INJ] THEN MESON_TAC[]]; FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN MP_TAC(ISPECL [`a:A`; `s DELETE a:A`] (CONJUNCT2 CARD_CLAUSES)) THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN SUBGOAL_THEN `a INSERT (s DELETE a:A) = s` SUBST1_TAC THENL [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; ASM_MESON_TAC[]]]);; let HAS_SIZE_UNION = prove (`!s t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ DISJOINT s t ==> (s UNION t) HAS_SIZE (m + n)`, SIMP_TAC[HAS_SIZE; FINITE_UNION; DISJOINT; CARD_UNION]);; let HAS_SIZE_DIFF = prove (`!s t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ t SUBSET s ==> (s DIFF t) HAS_SIZE (m - n)`, SIMP_TAC[HAS_SIZE; FINITE_DIFF; CARD_DIFF]);; let HAS_SIZE_UNIONS = prove (`!s t:A->B->bool m n. s HAS_SIZE m /\ (!x. x IN s ==> t(x) HAS_SIZE n) /\ (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (t x) (t y)) ==> UNIONS {t(x) | x IN s} HAS_SIZE (m * n)`, GEN_REWRITE_TAC (funpow 4 BINDER_CONV o funpow 2 LAND_CONV) [HAS_SIZE] THEN REWRITE_TAC[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 [REPEAT GEN_TAC THEN REWRITE_TAC[CARD_CLAUSES] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) (K ALL_TAC)) THEN REWRITE_TAC[MULT_CLAUSES; HAS_SIZE_0; EMPTY_UNIONS] THEN REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`t:A->B->bool`; `m:num`; `n:num`] THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN REWRITE_TAC[SET_RULE `UNIONS {t y | y IN x INSERT s} = t x UNION UNIONS {t y | y IN s}`] THEN REWRITE_TAC[ARITH_RULE `SUC a * b = b + a * b`] THEN MATCH_MP_TAC HAS_SIZE_UNION THEN ASM_SIMP_TAC[IN_INSERT] THEN REWRITE_TAC[SET_RULE `DISJOINT a (UNIONS s) <=> !x. x IN s ==> DISJOINT a x`] THEN ASM_SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN ASM_MESON_TAC[IN_INSERT]);; let FINITE_HAS_SIZE = prove (`!s. FINITE s <=> s HAS_SIZE CARD s`, REWRITE_TAC[HAS_SIZE]);; (* ------------------------------------------------------------------------- *) (* This is often more useful as a rewrite. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_CLAUSES = prove (`(s HAS_SIZE 0 <=> (s = {})) /\ (s HAS_SIZE (SUC n) <=> ?a t. t HAS_SIZE n /\ ~(a IN t) /\ (s = a INSERT t))`, let lemma = SET_RULE `a IN s ==> (s = a INSERT (s DELETE a))` in REWRITE_TAC[HAS_SIZE_0] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[HAS_SIZE_SUC; GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[lemma; IN_DELETE]; SIMP_TAC[LEFT_IMP_EXISTS_THM; HAS_SIZE; CARD_CLAUSES; FINITE_INSERT]]);; (* ------------------------------------------------------------------------- *) (* Produce an explicit expansion for "s HAS_SIZE n" for numeral n. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_CONV = let pth = prove (`(~(a IN {}) /\ P <=> P) /\ (~(a IN {b}) /\ P <=> ~(a = b) /\ P) /\ (~(a IN (b INSERT cs)) /\ P <=> ~(a = b) /\ ~(a IN cs) /\ P)`, SET_TAC[]) and qth = prove (`((?s. s HAS_SIZE 0 /\ P s) <=> P {}) /\ ((?s. s HAS_SIZE (SUC n) /\ P s) <=> (?a s. s HAS_SIZE n /\ ~(a IN s) /\ P(a INSERT s)))`, REWRITE_TAC[HAS_SIZE_CLAUSES] THEN MESON_TAC[]) in let qconv_0 = GEN_REWRITE_CONV I [CONJUNCT1 qth] and qconv_1 = GEN_REWRITE_CONV I [CONJUNCT2 qth] and rconv_0 = GEN_REWRITE_CONV I [CONJUNCT1 pth] and rconv_1 = GEN_REWRITE_CONV I [CONJUNCT2 pth] in let rec EXISTS_HAS_SIZE_AND_CONV tm = (qconv_0 ORELSEC (BINDER_CONV(LAND_CONV(RAND_CONV num_CONV)) THENC qconv_1 THENC BINDER_CONV EXISTS_HAS_SIZE_AND_CONV)) tm in let rec NOT_IN_INSERT_CONV tm = ((rconv_0 THENC NOT_IN_INSERT_CONV) ORELSEC (rconv_1 THENC RAND_CONV NOT_IN_INSERT_CONV) ORELSEC ALL_CONV) tm in let HAS_SIZE_CONV = GEN_REWRITE_CONV I [CONJUNCT1 HAS_SIZE_CLAUSES] ORELSEC (RAND_CONV num_CONV THENC GEN_REWRITE_CONV I [CONJUNCT2 HAS_SIZE_CLAUSES] THENC BINDER_CONV EXISTS_HAS_SIZE_AND_CONV) in fun tm -> let th = HAS_SIZE_CONV tm in let tm' = rand(concl th) in let evs,bod = strip_exists tm' in if evs = [] then th else let th' = funpow (length evs) BINDER_CONV NOT_IN_INSERT_CONV tm' in TRANS th th';; (* ------------------------------------------------------------------------- *) (* Various useful lemmas about cardinalities of unions etc. *) (* ------------------------------------------------------------------------- *) let CARD_SUBSET_EQ = prove (`!(a:A->bool) b. FINITE b /\ a SUBSET b /\ (CARD a = CARD b) ==> (a = b)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:A->bool`; `b DIFF (a:A->bool)`] CARD_UNION) THEN SUBGOAL_THEN `FINITE(a:A->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `FINITE(b:A->bool DIFF a)` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `b:A->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `a:A->bool INTER (b DIFF a) = EMPTY` ASSUME_TAC THENL [SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `a UNION (b:A->bool DIFF a) = b` ASSUME_TAC THENL [UNDISCH_TAC `a:A->bool SUBSET b` THEN SET_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `(a = a + b) <=> (b = 0)`] THEN DISCH_TAC THEN SUBGOAL_THEN `b:A->bool DIFF a = EMPTY` MP_TAC THENL [REWRITE_TAC[GSYM HAS_SIZE_0] THEN ASM_REWRITE_TAC[HAS_SIZE]; UNDISCH_TAC `a:A->bool SUBSET b` THEN SET_TAC[]]);; let CARD_SUBSET = prove (`!(a:A->bool) b. a SUBSET b /\ FINITE(b) ==> CARD(a) <= CARD(b)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `b:A->bool = a UNION (b DIFF a)` SUBST1_TAC THENL [UNDISCH_TAC `a:A->bool SUBSET b` THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `CARD (a UNION b DIFF a) = CARD(a:A->bool) + CARD(b DIFF a)` SUBST1_TAC THENL [MATCH_MP_TAC CARD_UNION THEN REPEAT CONJ_TAC THENL [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `b:A->bool` THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `b:A->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; SET_TAC[]]; ARITH_TAC]);; let CARD_SUBSET_LE = prove (`!(a:A->bool) b. FINITE b /\ a SUBSET b /\ (CARD b <= CARD a) ==> (a = b)`, MESON_TAC[CARD_SUBSET; CARD_SUBSET_EQ; LE_ANTISYM]);; let SUBSET_CARD_EQ = prove (`!s t. FINITE t /\ s SUBSET t ==> (CARD s = CARD t <=> s = t)`, MESON_TAC[CARD_SUBSET_EQ; LE_ANTISYM; CARD_SUBSET]);; let CARD_PSUBSET = prove (`!(a:A->bool) b. a PSUBSET b /\ FINITE(b) ==> CARD(a) < CARD(b)`, REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE `a PSUBSET b <=> ?x. x IN b /\ ~(x IN a) /\ a SUBSET (b DELETE x)` ] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(b DELETE (x:A))` THEN ASM_SIMP_TAC[CARD_SUBSET; FINITE_DELETE] THEN ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN ASM_MESON_TAC[CARD_EQ_0; MEMBER_NOT_EMPTY]);; let CARD_UNION_LE = prove (`!s t:A->bool. FINITE s /\ FINITE t ==> CARD(s UNION t) <= CARD(s) + CARD(t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(s:A->bool) + CARD(t DIFF s)` THEN ASM_SIMP_TAC[LE_ADD_LCANCEL; CARD_SUBSET; SUBSET_DIFF; FINITE_DIFF] THEN MATCH_MP_TAC EQ_IMP_LE THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN MATCH_MP_TAC CARD_UNION THEN ASM_SIMP_TAC[FINITE_DIFF] THEN SET_TAC[]);; let CARD_UNIONS_LE = prove (`!s t:A->B->bool m n. s HAS_SIZE m /\ (!x. x IN s ==> FINITE(t x) /\ CARD(t x) <= n) ==> CARD(UNIONS {t(x) | x IN s}) <= m * n`, GEN_REWRITE_TAC (funpow 4 BINDER_CONV o funpow 2 LAND_CONV) [HAS_SIZE] THEN REWRITE_TAC[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 THEN REWRITE_TAC[SET_RULE `UNIONS {t x | x IN {}} = {}`; CARD_CLAUSES; LE_0] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) ASSUME_TAC) THEN REWRITE_TAC[SET_RULE `UNIONS {t x | x IN a INSERT s} = t(a) UNION UNIONS {t x | x IN s}`] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD((t:A->B->bool) x) + CARD(UNIONS {(t:A->B->bool) y | y IN s})` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_UNION_LE THEN ASM_SIMP_TAC[IN_INSERT] THEN REWRITE_TAC[SET_RULE `{t x | x IN s} = IMAGE t s`] THEN ASM_SIMP_TAC[FINITE_FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE; IN_INSERT]; MATCH_MP_TAC(ARITH_RULE `a <= n /\ b <= x * n ==> a + b <= SUC x * n`) THEN ASM_SIMP_TAC[IN_INSERT]]);; let CARD_UNION_GEN = prove (`!s t. FINITE s /\ FINITE t ==> CARD(s UNION t) = (CARD(s) + CARD(t)) - CARD(s INTER t)`, REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN ASM_SIMP_TAC[ARITH_RULE `x:num <= y ==> (a + y) - x = a + (y - x)`; CARD_SUBSET; INTER_SUBSET; GSYM CARD_DIFF] THEN REWRITE_TAC[SET_RULE `t DIFF (s INTER t) = t DIFF s`] THEN MATCH_MP_TAC CARD_UNION THEN ASM_SIMP_TAC[FINITE_DIFF] THEN SET_TAC[]);; let CARD_UNION_OVERLAP_EQ = prove (`!s t. FINITE s /\ FINITE t ==> (CARD(s UNION t) = CARD s + CARD t <=> s INTER t = {})`, REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[CARD_UNION_GEN] THEN REWRITE_TAC[ARITH_RULE `a - b = a <=> b = 0 \/ a = 0`] THEN ASM_SIMP_TAC[ADD_EQ_0; CARD_EQ_0; FINITE_INTER] THEN SET_TAC[]);; let CARD_UNION_OVERLAP = prove (`!s t. FINITE s /\ FINITE t /\ CARD(s UNION t) < CARD(s) + CARD(t) ==> ~(s INTER t = {})`, SIMP_TAC[GSYM CARD_UNION_OVERLAP_EQ] THEN ARITH_TAC);; (* ------------------------------------------------------------------------- *) (* Cardinality of image under maps, injective or general. *) (* ------------------------------------------------------------------------- *) let CARD_IMAGE_INJ = prove (`!(f:A->B) s. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\ FINITE s ==> (CARD (IMAGE f s) = CARD s)`, GEN_TAC THEN REWRITE_TAC[TAUT `a /\ b ==> c <=> b ==> a ==> c`] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_IMAGE; IN_IMAGE] THEN COND_CASES_TAC THEN ASM_MESON_TAC[IN_INSERT]);; let HAS_SIZE_IMAGE_INJ = prove (`!(f:A->B) s n. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\ s HAS_SIZE n ==> (IMAGE f s) HAS_SIZE n`, SIMP_TAC[HAS_SIZE; FINITE_IMAGE] THEN MESON_TAC[CARD_IMAGE_INJ]);; let CARD_IMAGE_LE = prove (`!(f:A->B) s. FINITE s ==> CARD(IMAGE f s) <= CARD s`, GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[IMAGE_CLAUSES; CARD_CLAUSES; FINITE_IMAGE; LE_REFL] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN ARITH_TAC);; let CARD_IMAGE_INJ_EQ = prove (`!f:A->B s t. FINITE s /\ (!x. x IN s ==> f(x) IN t) /\ (!y. y IN t ==> ?!x. x IN s /\ f(x) = y) ==> CARD t = CARD s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `t = IMAGE (f:A->B) s` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_MESON_TAC[]]);; let CARD_SUBSET_IMAGE = prove (`!f s t. FINITE t /\ s SUBSET IMAGE f t ==> CARD s <= CARD t`, MESON_TAC[LE_TRANS; FINITE_IMAGE; CARD_IMAGE_LE; CARD_SUBSET]);; let HAS_SIZE_IMAGE_INJ_EQ = prove (`!f s n. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) ==> ((IMAGE f s) HAS_SIZE n <=> s HAS_SIZE n)`, REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC(TAUT `(a' <=> a) /\ (a ==> (b' <=> b)) ==> (a' /\ b' <=> a /\ b)`) THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE_INJ_EQ; DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ] THEN ASM_REWRITE_TAC[]);; let CARD_IMAGE_EQ_INJ = prove (`!f:A->B s. FINITE s ==> (CARD(IMAGE f s) = CARD s <=> !x y. x IN s /\ y IN s /\ f x = f y ==> x = y)`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[CARD_IMAGE_INJ]] THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `CARD(IMAGE (f:A->B) s) = CARD s` THEN SUBGOAL_THEN `IMAGE (f:A->B) s = IMAGE f (s DELETE y)` SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[]] THEN MATCH_MP_TAC(ARITH_RULE `!n. m <= n /\ n < p ==> ~(m:num = p)`) THEN EXISTS_TAC `CARD(s DELETE (y:A))` THEN ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN ASM_SIMP_TAC[CARD_DELETE; CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Choosing a smaller subset of a given size. *) (* ------------------------------------------------------------------------- *) let CHOOSE_SUBSET_STRONG = prove (`!n s:A->bool. (FINITE s ==> n <= CARD s) ==> ?t. t SUBSET s /\ t HAS_SIZE n`, INDUCT_TAC THEN REWRITE_TAC[HAS_SIZE_0; HAS_SIZE_SUC] THENL [MESON_TAC[EMPTY_SUBSET]; ALL_TAC] THEN MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[FINITE_EMPTY; CARD_CLAUSES; ARITH_RULE `~(SUC n <= 0)`] THEN MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN DISCH_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; LE_SUC] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:A->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `(a:A) INSERT t` THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[HAS_SIZE; CARD_DELETE; FINITE_INSERT; FINITE_DELETE; CARD_CLAUSES] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[SUC_SUB1] THEN ASM SET_TAC[]);; let CHOOSE_SUBSET_EQ = prove (`!n s:A->bool. (FINITE s ==> n <= CARD s) <=> (?t. t SUBSET s /\ t HAS_SIZE n)`, REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CHOOSE_SUBSET_STRONG] THEN DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN TRANS_TAC LE_TRANS `CARD(t:A->bool)` THEN ASM_MESON_TAC[CARD_SUBSET; HAS_SIZE; LE_REFL]);; let CHOOSE_SUBSET = prove (`!s:A->bool. FINITE s ==> !n. n <= CARD s ==> ?t. t SUBSET s /\ t HAS_SIZE n`, MESON_TAC[CHOOSE_SUBSET_STRONG]);; let CHOOSE_SUBSET_BETWEEN = prove (`!n s u:A->bool. s SUBSET u /\ FINITE s /\ CARD s <= n /\ (FINITE u ==> n <= CARD u) ==> ?t. s SUBSET t /\ t SUBSET u /\ t HAS_SIZE n`, REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`n - CARD(s:A->bool)`; `u DIFF s:A->bool`] CHOOSE_SUBSET_STRONG) THEN ANTS_TAC THENL [ASM_CASES_TAC `FINITE(u:A->bool)` THEN ASM_SIMP_TAC[CARD_DIFF; ARITH_RULE `n:num <= m ==> n - x <= m - x`] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN ASM_MESON_TAC[FINITE_UNION; FINITE_SUBSET; SET_RULE `u SUBSET (u DIFF s) UNION s`]; DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN EXISTS_TAC `s UNION t:A->bool` THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN SUBGOAL_THEN `n:num = CARD(s) + (n - CARD(s:A->bool))` SUBST1_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC HAS_SIZE_UNION] THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[HAS_SIZE] THEN ASM SET_TAC[]]);; let CARD_LE_UNIONS_CHAIN = prove (`!(f:(A->bool)->bool) n. (!t u. t IN f /\ u IN f ==> t SUBSET u \/ u SUBSET t) /\ (!t. t IN f ==> FINITE t /\ CARD t <= n) ==> FINITE(UNIONS f) /\ CARD(UNIONS f) <= n`, REPEAT GEN_TAC THEN ASM_CASES_TAC `f:(A->bool)->bool = {}` THEN ASM_REWRITE_TAC[UNIONS_0; FINITE_EMPTY; CARD_CLAUSES; LE_0] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; TAUT `~(p /\ q) <=> p ==> ~q`] THEN REWRITE_TAC[ARITH_RULE `~(x <= n) <=> SUC n <= x`] THEN REWRITE_TAC[CHOOSE_SUBSET_EQ] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:A->bool` THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET_UNIONS_CHAIN THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cardinality of product. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_PRODUCT_DEPENDENT = prove (`!s m t n. s HAS_SIZE m /\ (!x. x IN s ==> t(x) HAS_SIZE n) ==> {(x:A,y:B) | x IN s /\ y IN t(x)} HAS_SIZE (m * n)`, GEN_REWRITE_TAC (funpow 4 BINDER_CONV o funpow 2 LAND_CONV) [HAS_SIZE] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY; IN_INSERT] THEN CONJ_TAC THENL [GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[MULT_CLAUSES; HAS_SIZE_0] THEN SET_TAC[]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN X_GEN_TAC `m:num` THEN DISCH_THEN(ASSUME_TAC o SYM) THEN MAP_EVERY X_GEN_TAC [`t:A->B->bool`; `n:num`] THEN REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(s:A->bool)`) THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE `{(x,y) | (x = a \/ x IN s) /\ y IN t(x)} = {(x,y) | x IN s /\ y IN t(x)} UNION IMAGE (\y. (a,y)) (t a)`] THEN MATCH_MP_TAC HAS_SIZE_UNION THEN ASM_SIMP_TAC[HAS_SIZE_IMAGE_INJ; PAIR_EQ] THEN REWRITE_TAC[DISJOINT; IN_IMAGE; IN_ELIM_THM; IN_INTER; EXTENSION; NOT_IN_EMPTY; EXISTS_PAIR_THM; PAIR_EQ] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[PAIR_EQ]);; let FINITE_PRODUCT_DEPENDENT = prove (`!f:A->B->C s t. FINITE s /\ (!x. x IN s ==> FINITE(t x)) ==> FINITE {f x y | x IN s /\ y IN (t x)}`, REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (\(x,y). (f:A->B->C) x y) {x,y | x IN s /\ y IN t x}` THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE; MESON_TAC[]] THEN MAP_EVERY UNDISCH_TAC [`!x:A. x IN s ==> FINITE(t x :B->bool)`; `FINITE(s:A->bool)`] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:A->B->bool`; `s:A->bool`] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [GEN_TAC THEN SUBGOAL_THEN `{(x:A,y:B) | x IN {} /\ y IN (t x)} = {}` (fun th -> REWRITE_TAC[th; FINITE_RULES]) THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]; ALL_TAC] THEN MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN STRIP_TAC THEN X_GEN_TAC `t:A->B->bool` THEN SUBGOAL_THEN `{(x:A,y:B) | x IN (a INSERT s) /\ y IN (t x)} = IMAGE (\y. a,y) (t a) UNION {(x,y) | x IN s /\ y IN (t x)}` (fun th -> ASM_SIMP_TAC[IN_INSERT; FINITE_IMAGE; FINITE_UNION; th]) THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INSERT; IN_UNION] THEN MESON_TAC[]);; let FINITE_PRODUCT = prove (`!s t. FINITE s /\ FINITE t ==> FINITE {(x:A,y:B) | x IN s /\ y IN t}`, SIMP_TAC[FINITE_PRODUCT_DEPENDENT]);; let CARD_PRODUCT = prove (`!s t. FINITE s /\ FINITE t ==> (CARD {(x:A,y:B) | x IN s /\ y IN t} = CARD s * CARD t)`, REPEAT STRIP_TAC THEN MP_TAC(SPECL [`s:A->bool`; `CARD(s:A->bool)`; `\x:A. t:B->bool`; `CARD(t:B->bool)`] HAS_SIZE_PRODUCT_DEPENDENT) THEN ASM_SIMP_TAC[HAS_SIZE]);; let HAS_SIZE_PRODUCT = prove (`!s m t n. s HAS_SIZE m /\ t HAS_SIZE n ==> {(x:A,y:B) | x IN s /\ y IN t} HAS_SIZE (m * n)`, SIMP_TAC[HAS_SIZE; CARD_PRODUCT; FINITE_PRODUCT]);; (* ------------------------------------------------------------------------- *) (* Actually introduce a Cartesian product operation. *) (* ------------------------------------------------------------------------- *) parse_as_infix("CROSS",(22,"right"));; let CROSS = new_definition `s CROSS t = {x,y | x IN s /\ y IN t}`;; let IN_CROSS = prove (`!x y s t. (x,y) IN (s CROSS t) <=> x IN s /\ y IN t`, REWRITE_TAC[CROSS; IN_ELIM_PAIR_THM]);; let HAS_SIZE_CROSS = prove (`!s t m n. s HAS_SIZE m /\ t HAS_SIZE n ==> (s CROSS t) HAS_SIZE (m * n)`, REWRITE_TAC[CROSS; HAS_SIZE_PRODUCT]);; let FINITE_CROSS = prove (`!s t. FINITE s /\ FINITE t ==> FINITE(s CROSS t)`, SIMP_TAC[CROSS; FINITE_PRODUCT]);; let CARD_CROSS = prove (`!s t. FINITE s /\ FINITE t ==> CARD(s CROSS t) = CARD s * CARD t`, SIMP_TAC[CROSS; CARD_PRODUCT]);; let CROSS_EQ_EMPTY = prove (`!s t. s CROSS t = {} <=> s = {} \/ t = {}`, REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_CROSS; NOT_IN_EMPTY] THEN MESON_TAC[]);; let CROSS_EMPTY = prove (`(!s:A->bool. s CROSS {} = {}) /\ (!t:B->bool. {} CROSS t = {})`, REWRITE_TAC[CROSS_EQ_EMPTY]);; let CROSS_UNIV = prove (`(:A) CROSS (:B) = (:A#B)`, REWRITE_TAC[CROSS; EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM; IN_UNIV]);; let FINITE_CROSS_EQ = prove (`!s:A->bool t:B->bool. FINITE(s CROSS t) <=> s = {} \/ t = {} \/ FINITE s /\ FINITE t`, REPEAT GEN_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[CROSS_EMPTY; FINITE_EMPTY] THEN ASM_CASES_TAC `t:B->bool = {}` THEN ASM_REWRITE_TAC[CROSS_EMPTY; FINITE_EMPTY] THEN EQ_TAC THEN REWRITE_TAC[FINITE_CROSS] THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM(MP_TAC o MATCH_MP(ISPEC `FST:A#B->A` FINITE_IMAGE)); FIRST_ASSUM(MP_TAC o MATCH_MP(ISPEC `SND:A#B->B` FINITE_IMAGE))] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS] THEN ASM SET_TAC[]);; let FINITE_UNIV_PAIR = prove (`FINITE(:A#A) <=> FINITE(:A)`, MP_TAC(ISPECL [`(:A)`; `(:A)`] FINITE_CROSS_EQ) THEN REWRITE_TAC[CROSS_UNIV; UNIV_NOT_EMPTY]);; let INFINITE_UNIV_PAIR = prove (`INFINITE(:A#A) <=> INFINITE(:A)`, REWRITE_TAC[INFINITE; FINITE_UNIV_PAIR]);; let FORALL_IN_CROSS = prove (`!P s t. (!z. z IN s CROSS t ==> P z) <=> (!x y. x IN s /\ y IN t ==> P(x,y))`, REWRITE_TAC[FORALL_PAIR_THM; IN_CROSS]);; let EXISTS_IN_CROSS = prove (`!P s t. (?z. z IN s CROSS t /\ P z) <=> (?x y. x IN s /\ y IN t /\ P(x,y))`, REWRITE_TAC[EXISTS_PAIR_THM; GSYM CONJ_ASSOC; IN_CROSS]);; let SUBSET_CROSS = prove (`!s t s' t'. s CROSS t SUBSET s' CROSS t' <=> s = {} \/ t = {} \/ s SUBSET s' /\ t SUBSET t'`, SIMP_TAC[CROSS; EXTENSION; IN_ELIM_PAIR_THM; SUBSET; FORALL_PAIR_THM; IN_CROSS; NOT_IN_EMPTY] THEN MESON_TAC[]);; let CROSS_MONO = prove (`!s t s' t'. s SUBSET s' /\ t SUBSET t' ==> s CROSS t SUBSET s' CROSS t'`, SIMP_TAC[SUBSET_CROSS]);; let CROSS_EQ = prove (`!s s':A->bool t t':B->bool. s CROSS t = s' CROSS t' <=> (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/ s = s' /\ t = t'`, REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_CROSS] THEN SET_TAC[]);; let IMAGE_FST_CROSS = prove (`!s:A->bool t:B->bool. IMAGE FST (s CROSS t) = if t = {} then {} else s`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CROSS_EMPTY; IMAGE_CLAUSES] THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_CROSS; FST] THEN ASM SET_TAC[]);; let IMAGE_SND_CROSS = prove (`!s:A->bool t:B->bool. IMAGE SND (s CROSS t) = if s = {} then {} else t`, REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CROSS_EMPTY; IMAGE_CLAUSES] THEN REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[EXISTS_IN_CROSS; SND] THEN ASM SET_TAC[]);; let CROSS_INTER = prove (`(!s t u. s CROSS (t INTER u) = (s CROSS t) INTER (s CROSS u)) /\ (!s t u. (s INTER t) CROSS u = (s CROSS u) INTER (t CROSS u))`, REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_INTER; IN_CROSS] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let CROSS_UNION = prove (`(!s t u. s CROSS (t UNION u) = (s CROSS t) UNION (s CROSS u)) /\ (!s t u. (s UNION t) CROSS u = (s CROSS u) UNION (t CROSS u))`, REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_UNION; IN_CROSS] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let CROSS_DIFF = prove (`(!s t u. s CROSS (t DIFF u) = (s CROSS t) DIFF (s CROSS u)) /\ (!s t u. (s DIFF t) CROSS u = (s CROSS u) DIFF (t CROSS u))`, REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_DIFF; IN_CROSS] THEN REPEAT STRIP_TAC THEN CONV_TAC TAUT);; let INTER_CROSS = prove (`!s s' t t'. (s CROSS t) INTER (s' CROSS t') = (s INTER s') CROSS (t INTER t')`, REWRITE_TAC[EXTENSION; IN_INTER; FORALL_PAIR_THM; IN_CROSS] THEN CONV_TAC TAUT);; let CROSS_UNIONS_UNIONS,CROSS_UNIONS = (CONJ_PAIR o prove) (`(!f g. (UNIONS f) CROSS (UNIONS g) = UNIONS {s CROSS t | s IN f /\ t IN g}) /\ (!s f. s CROSS (UNIONS f) = UNIONS {s CROSS t | t IN f}) /\ (!f t. (UNIONS f) CROSS t = UNIONS {s CROSS t | s IN f})`, REWRITE_TAC[UNIONS_GSPEC; EXTENSION; FORALL_PAIR_THM; IN_ELIM_THM; IN_CROSS] THEN SET_TAC[]);; let CROSS_INTERS_INTERS,CROSS_INTERS = (CONJ_PAIR o prove) (`(!f g. (INTERS f) CROSS (INTERS g) = if f = {} then INTERS {UNIV CROSS t | t IN g} else if g = {} then INTERS {s CROSS UNIV | s IN f} else INTERS {s CROSS t | s IN f /\ t IN g}) /\ (!s f. s CROSS (INTERS f) = if f = {} then s CROSS UNIV else INTERS {s CROSS t | t IN f}) /\ (!f t. (INTERS f) CROSS t = if f = {} then UNIV CROSS t else INTERS {s CROSS t | s IN f})`, REPEAT STRIP_TAC THEN REPEAT (COND_CASES_TAC THEN REWRITE_TAC[]) THEN ASM_REWRITE_TAC[INTERS_GSPEC; EXTENSION; FORALL_PAIR_THM; IN_ELIM_THM; IN_CROSS; NOT_IN_EMPTY] THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cardinality of functions with bounded domain (support) and range. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_FUNSPACE = prove (`!d n t:B->bool m s:A->bool. s HAS_SIZE m /\ t HAS_SIZE n ==> {f | (!x. x IN s ==> f(x) IN t) /\ (!x. ~(x IN s) ==> (f x = d))} HAS_SIZE (n EXP m)`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[HAS_SIZE_CLAUSES] THENL [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; EXP] THEN CONV_TAC HAS_SIZE_CONV THEN EXISTS_TAC `(\x. d):A->B` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM]] THEN MAP_EVERY X_GEN_TAC [`s0:A->bool`; `a:A`; `s:A->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:A->bool`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN SUBGOAL_THEN `{f:A->B | (!x. x IN a INSERT s ==> f x IN t) /\ (!x. ~(x IN a INSERT s) ==> (f x = d))} = IMAGE (\(b,g) x. if x = a then b else g(x)) {b,g | b IN t /\ g IN {f | (!x. x IN s ==> f x IN t) /\ (!x. ~(x IN s) ==> (f x = d))}}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_THM; EXISTS_PAIR_THM] THEN REWRITE_TAC[PAIR_EQ; CONJ_ASSOC; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN X_GEN_TAC `f:A->B` THEN REWRITE_TAC[IN_INSERT] THEN EQ_TAC THENL [STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(f:A->B) a`; `\x. if x IN s then (f:A->B) x else d`] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; DISCH_THEN(X_CHOOSE_THEN `b:B` (X_CHOOSE_THEN `g:A->B` STRIP_ASSUME_TAC)) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; ALL_TAC] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_SIMP_TAC[EXP; HAS_SIZE_PRODUCT] THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM; PAIR_EQ; CONJ_ASSOC] THEN REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[]; X_GEN_TAC `x:A` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_MESON_TAC[]]);; let CARD_FUNSPACE = prove (`!s t. FINITE s /\ FINITE t ==> (CARD {f | (!x. x IN s ==> f(x) IN t) /\ (!x. ~(x IN s) ==> (f x = d))} = (CARD t) EXP (CARD s))`, MESON_TAC[HAS_SIZE_FUNSPACE; HAS_SIZE]);; let FINITE_FUNSPACE = prove (`!s t. FINITE s /\ FINITE t ==> FINITE {f | (!x. x IN s ==> f(x) IN t) /\ (!x. ~(x IN s) ==> (f x = d))}`, MESON_TAC[HAS_SIZE_FUNSPACE; HAS_SIZE]);; let HAS_SIZE_FUNSPACE_UNIV = prove (`!m n. (:A) HAS_SIZE m /\ (:B) HAS_SIZE n ==> (:A->B) HAS_SIZE (n EXP m)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FUNSPACE) THEN REWRITE_TAC[IN_UNIV; UNIV_GSPEC]);; let CARD_FUNSPACE_UNIV = prove (`FINITE(:A) /\ FINITE(:B) ==> CARD(:A->B) = CARD(:B) EXP CARD(:A)`, MESON_TAC[HAS_SIZE_FUNSPACE_UNIV; HAS_SIZE]);; let FINITE_FUNSPACE_UNIV = prove (`FINITE(:A) /\ FINITE(:B) ==> FINITE(:A->B)`, MESON_TAC[HAS_SIZE_FUNSPACE_UNIV; HAS_SIZE]);; (* ------------------------------------------------------------------------- *) (* Cardinality of type bool. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_BOOL = prove (`(:bool) HAS_SIZE 2`, SUBGOAL_THEN `(:bool) = {F,T}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT] THEN CONV_TAC TAUT; SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; ARITH; IN_SING; NOT_IN_EMPTY]]);; let CARD_BOOL = prove (`CARD(:bool) = 2`, MESON_TAC[HAS_SIZE_BOOL; HAS_SIZE]);; let FINITE_BOOL = prove (`FINITE(:bool)`, MESON_TAC[HAS_SIZE_BOOL; HAS_SIZE]);; (* ------------------------------------------------------------------------- *) (* Hence cardinality of powerset. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_POWERSET = prove (`!(s:A->bool) n. s HAS_SIZE n ==> {t | t SUBSET s} HAS_SIZE (2 EXP n)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `{t | t SUBSET s} = {f | (!x:A. x IN s ==> f(x) IN UNIV) /\ (!x. ~(x IN s) ==> (f x = F))}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV; SUBSET; IN; CONTRAPOS_THM]; MATCH_MP_TAC HAS_SIZE_FUNSPACE THEN ASM_REWRITE_TAC[] THEN CONV_TAC HAS_SIZE_CONV THEN MAP_EVERY EXISTS_TAC [`T`; `F`] THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC TAUT]);; let CARD_POWERSET = prove (`!s:A->bool. FINITE s ==> (CARD {t | t SUBSET s} = 2 EXP (CARD s))`, MESON_TAC[HAS_SIZE_POWERSET; HAS_SIZE]);; let FINITE_POWERSET = prove (`!s:A->bool. FINITE s ==> FINITE {t | t SUBSET s}`, MESON_TAC[HAS_SIZE_POWERSET; HAS_SIZE]);; let FINITE_UNIONS = prove (`!s:(A->bool)->bool. FINITE(UNIONS s) <=> FINITE s /\ (!t. t IN s ==> FINITE t)`, GEN_TAC THEN ASM_CASES_TAC `FINITE(s:(A->bool)->bool)` THEN ASM_SIMP_TAC[FINITE_FINITE_UNIONS] THEN DISCH_THEN(MP_TAC o MATCH_MP FINITE_POWERSET) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN SET_TAC[]);; let POWERSET_CLAUSES = prove (`{s | s SUBSET {}} = {{}} /\ (!a:A t. {s | s SUBSET (a INSERT t)} = {s | s SUBSET t} UNION IMAGE (\s. a INSERT s) {s | s SUBSET t})`, REWRITE_TAC[SUBSET_INSERT_DELETE; SUBSET_EMPTY; SING_GSPEC] THEN MAP_EVERY X_GEN_TAC [`a:A`; `t:A->bool`] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNION_SUBSET] THEN ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION; IN_IMAGE] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN X_GEN_TAC `s:A->bool` THEN ASM_CASES_TAC `(a:A) IN s` THENL [ALL_TAC; ASM SET_TAC[]] THEN STRIP_TAC THEN DISJ2_TAC THEN EXISTS_TAC `s DELETE (a:A)` THEN ASM SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Set of numbers is infinite. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_NUMSEG_LT = prove (`!n. {m | m < n} HAS_SIZE n`, INDUCT_TAC THENL [SUBGOAL_THEN `{m | m < 0} = {}` (fun th -> REWRITE_TAC[HAS_SIZE_0; th]) THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; LT]; SUBGOAL_THEN `{m | m < SUC n} = n INSERT {m | m < n}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN ARITH_TAC; ALL_TAC] THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT] THEN REWRITE_TAC[IN_ELIM_THM; LT_REFL]]);; let CARD_NUMSEG_LT = prove (`!n. CARD {m | m < n} = n`, REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LT]);; let FINITE_NUMSEG_LT = prove (`!n:num. FINITE {m | m < n}`, REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LT]);; let HAS_SIZE_NUMSEG_LE = prove (`!n. {m | m <= n} HAS_SIZE (n + 1)`, REWRITE_TAC[GSYM LT_SUC_LE; HAS_SIZE_NUMSEG_LT; ADD1]);; let FINITE_NUMSEG_LE = prove (`!n. FINITE {m | m <= n}`, REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LE]);; let CARD_NUMSEG_LE = prove (`!n. CARD {m | m <= n} = n + 1`, REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LE]);; let num_FINITE = prove (`!s:num->bool. FINITE s <=> ?a. !x. x IN s ==> x <= a`, GEN_TAC THEN EQ_TAC THENL [SPEC_TAC(`s:num->bool`,`s:num->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[LE_CASES; LE_TRANS]; DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]]);; let num_FINITE_AVOID = prove (`!s:num->bool. FINITE(s) ==> ?a. ~(a IN s)`, MESON_TAC[num_FINITE; LT; NOT_LT]);; let num_INFINITE_EQ = prove (`!s:num->bool. INFINITE s <=> !N. ?n. N <= n /\ n IN s`, GEN_TAC THEN REWRITE_TAC[INFINITE; num_FINITE] THEN MESON_TAC[NOT_LE; LT_IMP_LE; LE_SUC_LT]);; let num_INFINITE = prove (`INFINITE(:num)`, REWRITE_TAC[INFINITE] THEN MESON_TAC[num_FINITE_AVOID; IN_UNIV]);; (* ------------------------------------------------------------------------- *) (* Set of strings is infinite. *) (* ------------------------------------------------------------------------- *) let string_INFINITE = prove (`INFINITE(:string)`, MP_TAC num_INFINITE THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN DISCH_THEN(MP_TAC o ISPEC `LENGTH:string->num` o MATCH_MP FINITE_IMAGE) THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN MESON_TAC[LENGTH_REPLICATE]);; (* ------------------------------------------------------------------------- *) (* Non-trivial intervals of reals are infinite. *) (* ------------------------------------------------------------------------- *) let FINITE_REAL_INTERVAL = prove (`(!a. ~FINITE {x:real | a < x}) /\ (!a. ~FINITE {x:real | a <= x}) /\ (!b. ~FINITE {x:real | x < b}) /\ (!b. ~FINITE {x:real | x <= b}) /\ (!a b. FINITE {x:real | a < x /\ x < b} <=> b <= a) /\ (!a b. FINITE {x:real | a <= x /\ x < b} <=> b <= a) /\ (!a b. FINITE {x:real | a < x /\ x <= b} <=> b <= a) /\ (!a b. FINITE {x:real | a <= x /\ x <= b} <=> b <= a)`, SUBGOAL_THEN `!a b. FINITE {x:real | a < x /\ x < b} <=> b <= a` ASSUME_TAC THENL [REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_CASES_TAC `a:real < b` THEN ASM_SIMP_TAC[REAL_ARITH `~(a:real < b) ==> ~(a < x /\ x < b)`] THEN REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY] THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN DISCH_THEN(MP_TAC o SPEC `IMAGE (\n. a + (b - a) / (&n + &2)) (:num)`) THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN SIMP_TAC[REAL_LT_ADDR; REAL_ARITH `a + x / y < b <=> x / y < b - a`] THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_SUB_LT; REAL_LT_LDIV_EQ; NOT_IMP; REAL_ARITH `&0:real < &n + &2`] THEN REWRITE_TAC[REAL_ARITH `x:real < x * (n + &2) <=> &0 < x * (n + &1)`] THEN ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_ARITH `&0:real < &n + &1`] THEN MP_TAC num_INFINITE THEN REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD `a < b ==> (a + (b - a) / (&n + &2) = a + (b - a) / (&m + &2) <=> &n:real = &m)`]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THENL [DISCH_THEN(MP_TAC o SPEC `{x:real | a < x /\ x < a + &1}` o MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `{x:real | a < x /\ x < a + &1}` o MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `{x:real | b - &1 < x /\ x < b}` o MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `{x:real | b - &1 < x /\ x < b}` o MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; REWRITE_TAC[REAL_ARITH `a:real <= x /\ x < b <=> (a < x /\ x < b) \/ ~(b <= a) /\ x = a`]; REWRITE_TAC[REAL_ARITH `a:real < x /\ x <= b <=> (a < x /\ x < b) \/ ~(b <= a) /\ x = b`]; ASM_CASES_TAC `b:real = a` THEN ASM_SIMP_TAC[REAL_LE_ANTISYM; REAL_LE_REFL; SING_GSPEC; FINITE_SING] THEN ASM_SIMP_TAC[REAL_ARITH `~(b:real = a) ==> (a <= x /\ x <= b <=> (a < x /\ x < b) \/ ~(b <= a) /\ x = a \/ ~(b <= a) /\ x = b)`]] THEN ASM_REWRITE_TAC[FINITE_UNION; SET_RULE `{x | p x \/ q x} = {x | p x} UNION {x | q x}`] THEN ASM_CASES_TAC `b:real <= a` THEN ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY]);; let real_INFINITE = prove (`INFINITE(:real)`, REWRITE_TAC[INFINITE] THEN DISCH_THEN(MP_TAC o SPEC `{x:real | &0 <= x}` o MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN REWRITE_TAC[FINITE_REAL_INTERVAL; SUBSET_UNIV]);; (* ------------------------------------------------------------------------- *) (* Indexing of finite sets and enumeration of subsets of N in order. *) (* ------------------------------------------------------------------------- *) let HAS_SIZE_INDEX = prove (`!s n. s HAS_SIZE n ==> ?f:num->A. (!m. m < n ==> f(m) IN s) /\ (!x. x IN s ==> ?!m. m < n /\ (f m = x))`, ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN SIMP_TAC[HAS_SIZE_0; HAS_SIZE_SUC; LT; NOT_IN_EMPTY] THEN X_GEN_TAC `s:A->bool` THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN REWRITE_TAC[NOT_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:A`) (MP_TAC o SPEC `a:A`)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\m:num. if m < n then f(m) else a:A` THEN CONJ_TAC THENL [GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN CONV_TAC(ONCE_DEPTH_CONV COND_ELIM_CONV) THEN ASM_CASES_TAC `a:A = x` THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[LT_REFL; IN_DELETE]);; let INFINITE_ENUMERATE = prove (`!s:num->bool. INFINITE s ==> ?r:num->num. (!m n. m < n ==> r(m) < r(n)) /\ IMAGE r (:num) = s`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n:num. ?x. n <= x /\ x IN s` MP_TAC THENL [ASM_MESON_TAC[INFINITE; num_FINITE; LT_IMP_LE; NOT_LE]; GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [num_WOP]] THEN REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN REWRITE_TAC[TAUT `p ==> ~(q /\ r) <=> q /\ p ==> ~r`] THEN X_GEN_TAC `next:num->num` THEN STRIP_TAC THEN (MP_TAC o prove_recursive_functions_exist num_RECURSION) `(f(0) = next 0) /\ (!n. f(SUC n) = next(f n + 1))` THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN ASM_MESON_TAC[ARITH_RULE `m <= n /\ n + 1 <= p ==> m < p`; LE_LT]; DISCH_TAC] THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; FORALL_IN_IMAGE; SUBSET] THEN REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN CONJ_TAC THENL [INDUCT_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `?m:num. m < n /\ m IN s` THENL [MP_TAC(SPEC `\m:num. m < n /\ m IN s` num_MAX) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL [MESON_TAC[LT_IMP_LE]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `?q. p = (r:num->num) q` (CHOOSE_THEN SUBST_ALL_TAC) THENL [ASM_MESON_TAC[]; EXISTS_TAC `SUC q`] THEN ASM_REWRITE_TAC[GSYM LE_ANTISYM; GSYM NOT_LT] THEN ASM_MESON_TAC[NOT_LE; ARITH_RULE `r < p <=> r + 1 <= p`]; EXISTS_TAC `0` THEN ASM_REWRITE_TAC[GSYM LE_ANTISYM; GSYM NOT_LT] THEN ASM_MESON_TAC[LE_0]]);; let INFINITE_ENUMERATE_EQ = prove (`!s:num->bool. INFINITE s <=> ?r. (!m n:num. m < n ==> r m < r n) /\ IMAGE r (:num) = s`, GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[INFINITE_ENUMERATE] THEN DISCH_THEN(X_CHOOSE_THEN `r:num->num` (STRIP_ASSUME_TAC o GSYM)) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INFINITE_IMAGE THEN REWRITE_TAC[num_INFINITE; IN_UNIV] THEN MATCH_MP_TAC WLOG_LT THEN ASM_MESON_TAC[LT_REFL]);; (* ------------------------------------------------------------------------- *) (* Mapping between finite sets and lists. *) (* ------------------------------------------------------------------------- *) let set_of_list = new_recursive_definition list_RECURSION `(set_of_list ([]:A list) = {}) /\ (set_of_list (CONS (h:A) t) = h INSERT (set_of_list t))`;; let list_of_set = new_definition `list_of_set s = @l. (set_of_list l = s) /\ (LENGTH l = CARD s)`;; let LIST_OF_SET_PROPERTIES = prove (`!s:A->bool. FINITE(s) ==> (set_of_list(list_of_set s) = s) /\ (LENGTH(list_of_set s) = CARD s)`, REWRITE_TAC[list_of_set] THEN CONV_TAC(BINDER_CONV(RAND_CONV SELECT_CONV)) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REPEAT STRIP_TAC THENL [EXISTS_TAC `[]:A list` THEN REWRITE_TAC[CARD_CLAUSES; LENGTH; set_of_list]; EXISTS_TAC `CONS (x:A) l` THEN ASM_REWRITE_TAC[LENGTH] THEN ASM_REWRITE_TAC[set_of_list] THEN FIRST_ASSUM(fun th -> REWRITE_TAC [MATCH_MP (CONJUNCT2 CARD_CLAUSES) th]) THEN ASM_REWRITE_TAC[]]);; let SET_OF_LIST_OF_SET = prove (`!s. FINITE(s) ==> (set_of_list(list_of_set s) = s)`, MESON_TAC[LIST_OF_SET_PROPERTIES]);; let LENGTH_LIST_OF_SET = prove (`!s. FINITE(s) ==> (LENGTH(list_of_set s) = CARD s)`, MESON_TAC[LIST_OF_SET_PROPERTIES]);; let MEM_LIST_OF_SET = prove (`!s:A->bool. FINITE(s) ==> !x. MEM x (list_of_set s) <=> x IN s`, GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SET_OF_LIST_OF_SET) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (BINDER_CONV o funpow 2 RAND_CONV) [GSYM th]) THEN SPEC_TAC(`list_of_set(s:A->bool)`,`l:A list`) THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MEM; set_of_list; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[IN_INSERT]);; let FINITE_SET_OF_LIST = prove (`!l. FINITE(set_of_list l)`, LIST_INDUCT_TAC THEN ASM_SIMP_TAC[set_of_list; FINITE_RULES]);; let IN_SET_OF_LIST = prove (`!x l. x IN (set_of_list l) <=> MEM x l`, GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; MEM; set_of_list] THEN ASM_MESON_TAC[]);; let SET_OF_LIST_APPEND = prove (`!l1 l2. set_of_list(APPEND l1 l2) = set_of_list(l1) UNION set_of_list(l2)`, REWRITE_TAC[EXTENSION; IN_SET_OF_LIST; IN_UNION; MEM_APPEND]);; let SET_OF_LIST_MAP = prove (`!f l. set_of_list(MAP f l) = IMAGE f (set_of_list l)`, GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[set_of_list; MAP; IMAGE_CLAUSES]);; let SET_OF_LIST_EQ_EMPTY = prove (`!l. set_of_list l = {} <=> l = []`, LIST_INDUCT_TAC THEN REWRITE_TAC[set_of_list; NOT_CONS_NIL; NOT_INSERT_EMPTY]);; let LIST_OF_SET_EMPTY = prove (`list_of_set {} = []`, REWRITE_TAC[GSYM LENGTH_EQ_NIL] THEN SIMP_TAC[LENGTH_LIST_OF_SET; FINITE_EMPTY; CARD_CLAUSES]);; let LIST_OF_SET_SING = prove (`!x:A. list_of_set {a} = [a]`, GEN_TAC THEN REWRITE_TAC[list_of_set] THEN MATCH_MP_TAC SELECT_UNIQUE THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[NOT_CONS_NIL] THEN SIMP_TAC[LENGTH; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY; NOT_SUC] THEN GEN_TAC THEN LIST_INDUCT_TAC THEN DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LENGTH; set_of_list; CONS_11; SUC_INJ; NOT_CONS_NIL; NOT_SUC] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Mappings from finite set enumerations to lists (no "setification"). *) (* ------------------------------------------------------------------------- *) let dest_setenum = let fn = splitlist (dest_binary "INSERT") in fun tm -> let l,n = fn tm in if is_const n && fst(dest_const n) = "EMPTY" then l else failwith "dest_setenum: not a finite set enumeration";; let is_setenum = can dest_setenum;; let mk_setenum = let insert_atm = `(INSERT):A->(A->bool)->(A->bool)` and nil_atm = `(EMPTY):A->bool` in fun (l,ty) -> let insert_tm = inst [ty,aty] insert_atm and nil_tm = inst [ty,aty] nil_atm in itlist (mk_binop insert_tm) l nil_tm;; let mk_fset l = mk_setenum(l,type_of(hd l));; (* ------------------------------------------------------------------------- *) (* Pairwise property over sets and lists. *) (* ------------------------------------------------------------------------- *) let pairwise = new_definition `pairwise r s <=> !x y. x IN s /\ y IN s /\ ~(x = y) ==> r x y`;; let PAIRWISE_EMPTY = prove (`!r. pairwise r {} <=> T`, REWRITE_TAC[pairwise; NOT_IN_EMPTY] THEN MESON_TAC[]);; let PAIRWISE_SING = prove (`!r x. pairwise r {x} <=> T`, REWRITE_TAC[pairwise; IN_SING] THEN MESON_TAC[]);; let PAIRWISE_IMP = prove (`!P Q s:A->bool. pairwise P s /\ (!x y. x IN s /\ y IN s /\ P x y /\ ~(x = y) ==> Q x y) ==> pairwise Q s`, REWRITE_TAC[pairwise] THEN SET_TAC[]);; let PAIRWISE_MONO = prove (`!r s t. pairwise r s /\ t SUBSET s ==> pairwise r t`, REWRITE_TAC[pairwise] THEN SET_TAC[]);; let PAIRWISE_AND = prove (`!R R' s. pairwise R s /\ pairwise R' s <=> pairwise (\x y. R x y /\ R' x y) s`, REWRITE_TAC[pairwise] THEN SET_TAC[]);; let PAIRWISE_INSERT = prove (`!r x s. pairwise r (x INSERT s) <=> (!y. y IN s /\ ~(y = x) ==> r x y /\ r y x) /\ pairwise r s`, REWRITE_TAC[pairwise; IN_INSERT] THEN MESON_TAC[]);; let PAIRWISE_IMAGE = prove (`!r f. pairwise r (IMAGE f s) <=> pairwise (\x y. ~(f x = f y) ==> r (f x) (f y)) s`, REWRITE_TAC[pairwise; IN_IMAGE] THEN MESON_TAC[]);; let PAIRWISE_UNION = prove (`!R s t. pairwise R (s UNION t) <=> pairwise R s /\ pairwise R t /\ (!x y. x IN s DIFF t /\ y IN t DIFF s ==> R x y /\ R y x)`, REWRITE_TAC[pairwise] THEN SET_TAC[]);; let PAIRWISE_CHAIN_UNIONS = prove (`!R:A->A->bool c. (!s. s IN c ==> pairwise R s) /\ (!s t. s IN c /\ t IN c ==> s SUBSET t \/ t SUBSET s) ==> pairwise R (UNIONS c)`, REWRITE_TAC[pairwise] THEN SET_TAC[]);; let DIFF_UNIONS_PAIRWISE_DISJOINT = prove (`!s t:(A->bool)->bool. pairwise DISJOINT s /\ t SUBSET s ==> UNIONS s DIFF UNIONS t = UNIONS(s DIFF t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `t UNION u = s /\ DISJOINT t u ==> s DIFF t = u`) THEN CONJ_TAC THENL [REWRITE_TAC[GSYM UNIONS_UNION] THEN AP_TERM_TAC THEN ASM SET_TAC[]; REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN REWRITE_TAC[DISJOINT; IN_DIFF] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[]]);; let INTER_UNIONS_PAIRWISE_DISJOINT = prove (`!s t:(A->bool)->bool. pairwise DISJOINT (s UNION t) ==> UNIONS s INTER UNIONS t = UNIONS(s INTER t)`, REPEAT GEN_TAC THEN REWRITE_TAC[INTER_UNIONS; SIMPLE_IMAGE; UNIONS_IMAGE] THEN GEN_REWRITE_TAC RAND_CONV [EXTENSION] THEN REWRITE_TAC[pairwise; IN_UNIONS; IN_INTER; IN_ELIM_THM; IN_UNION] THEN DISCH_TAC THEN X_GEN_TAC `z:A` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; MESON_TAC[]] THEN MAP_EVERY X_GEN_TAC [`u:A->bool`; `v:A->bool`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`u:A->bool`; `v:A->bool`]) THEN ASM_CASES_TAC `u:A->bool = v` THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]);; let PSUBSET_UNIONS_PAIRWISE_DISJOINT = prove (`!u v:(A->bool)->bool. pairwise DISJOINT v /\ u PSUBSET (v DELETE {}) ==> UNIONS u PSUBSET UNIONS v`, REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE `u SUBSET v /\ ~(v DIFF u = {}) ==> u PSUBSET v`) THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN W(MP_TAC o PART_MATCH (lhand o rand) DIFF_UNIONS_PAIRWISE_DISJOINT o lhand o rand o snd) THEN ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN REWRITE_TAC[EMPTY_UNIONS] THEN FIRST_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN REWRITE_TAC[IN_DELETE; IN_DIFF] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Useful idioms for being a suitable union/intersection of somethings. *) (* ------------------------------------------------------------------------- *) parse_as_infix("UNION_OF",(20,"right"));; parse_as_infix("INTERSECTION_OF",(20,"right"));; let UNION_OF = new_definition `P UNION_OF Q = \s:A->bool. ?u. P u /\ (!c. c IN u ==> Q c) /\ UNIONS u = s`;; let INTERSECTION_OF = new_definition `P INTERSECTION_OF Q = \s:A->bool. ?u. P u /\ (!c. c IN u ==> Q c) /\ INTERS u = s`;; let UNION_OF_INC = prove (`!P Q s:A->bool. P {s} /\ Q s ==> (P UNION_OF Q) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_OF] THEN EXISTS_TAC `{s:A->bool}` THEN ASM_SIMP_TAC[UNIONS_1; IN_SING]);; let INTERSECTION_OF_INC = prove (`!P Q s:A->bool. P {s} /\ Q s ==> (P INTERSECTION_OF Q) s`, REPEAT STRIP_TAC THEN REWRITE_TAC[INTERSECTION_OF] THEN EXISTS_TAC `{s:A->bool}` THEN ASM_SIMP_TAC[INTERS_1; IN_SING]);; let UNION_OF_MONO = prove (`!P Q Q' s:A->bool. (P UNION_OF Q) s /\ (!x. Q x ==> Q' x) ==> (P UNION_OF Q') s`, REWRITE_TAC[UNION_OF] THEN MESON_TAC[]);; let INTERSECTION_OF_MONO = prove (`!P Q Q' s:A->bool. (P INTERSECTION_OF Q) s /\ (!x. Q x ==> Q' x) ==> (P INTERSECTION_OF Q') s`, REWRITE_TAC[INTERSECTION_OF] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Some additional properties of "set_of_list". *) (* ------------------------------------------------------------------------- *) let CARD_SET_OF_LIST_LE = prove (`!l. CARD(set_of_list l) <= LENGTH l`, LIST_INDUCT_TAC THEN SIMP_TAC[LENGTH; set_of_list; CARD_CLAUSES; FINITE_SET_OF_LIST] THEN ASM_ARITH_TAC);; let HAS_SIZE_SET_OF_LIST = prove (`!l. (set_of_list l) HAS_SIZE (LENGTH l) <=> PAIRWISE (\x y. ~(x = y)) l`, REWRITE_TAC[HAS_SIZE; FINITE_SET_OF_LIST] THEN LIST_INDUCT_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; LENGTH; set_of_list; PAIRWISE; ALL; FINITE_SET_OF_LIST; GSYM ALL_MEM; IN_SET_OF_LIST] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SUC_INJ] THEN ASM_MESON_TAC[CARD_SET_OF_LIST_LE; ARITH_RULE `~(SUC n <= n)`]);; (* ------------------------------------------------------------------------- *) (* Classic result on function of finite set into itself. *) (* ------------------------------------------------------------------------- *) let SURJECTIVE_IFF_INJECTIVE_GEN = prove (`!s t f:A->B. FINITE s /\ FINITE t /\ (CARD s = CARD t) /\ (IMAGE f s) SUBSET t ==> ((!y. y IN t ==> ?x. x IN s /\ (f x = y)) <=> (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)))`, REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `CARD s <= CARD (IMAGE (f:A->B) (s DELETE y))` MP_TAC THENL [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DELETE] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_DELETE] THEN ASM_MESON_TAC[]; REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(s DELETE (y:A))` THEN ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `x - 1 < x <=> ~(x = 0)`] THEN ASM_MESON_TAC[CARD_EQ_0; MEMBER_NOT_EMPTY]]; SUBGOAL_THEN `IMAGE (f:A->B) s = t` MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[EXTENSION; IN_IMAGE]] THEN ASM_MESON_TAC[CARD_SUBSET_EQ; CARD_IMAGE_INJ]]);; let SURJECTIVE_IFF_INJECTIVE = prove (`!s f:A->A. FINITE s /\ (IMAGE f s) SUBSET s ==> ((!y. y IN s ==> ?x. x IN s /\ (f x = y)) <=> (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)))`, SIMP_TAC[SURJECTIVE_IFF_INJECTIVE_GEN]);; let IMAGE_IMP_INJECTIVE_GEN = prove (`!s t f:A->B. FINITE s /\ (CARD s = CARD t) /\ (IMAGE f s = t) ==> !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN MP_TAC(ISPECL [`s:A->bool`; `t:B->bool`; `f:A->B`] SURJECTIVE_IFF_INJECTIVE_GEN) THEN ASM_SIMP_TAC[SUBSET_REFL; FINITE_IMAGE] THEN ASM_MESON_TAC[EXTENSION; IN_IMAGE]);; let IMAGE_IMP_INJECTIVE = prove (`!s f. FINITE s /\ (IMAGE f s = s) ==> !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, MESON_TAC[IMAGE_IMP_INJECTIVE_GEN]);; (* ------------------------------------------------------------------------- *) (* Converse relation between cardinality and injection. *) (* ------------------------------------------------------------------------- *) let CARD_LE_INJ = prove (`!s t. FINITE s /\ FINITE t /\ CARD s <= CARD t ==> ?f:A->B. (IMAGE f s) SUBSET t /\ !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY] THEN SIMP_TAC[CARD_CLAUSES] THEN MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[CARD_CLAUSES; LE; NOT_SUC] THEN MAP_EVERY X_GEN_TAC [`y:B`; `t:B->bool`] THEN SIMP_TAC[CARD_CLAUSES] THEN DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) STRIP_ASSUME_TAC) THEN REWRITE_TAC[LE_SUC] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:B->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\z:A. if z = x then (y:B) else f(z)` THEN REWRITE_TAC[IN_INSERT; SUBSET; IN_IMAGE] THEN ASM_MESON_TAC[SUBSET; IN_IMAGE]);; (* ------------------------------------------------------------------------- *) (* Occasionally handy rewrites. *) (* ------------------------------------------------------------------------- *) let FORALL_IN_CLAUSES = prove (`(!P. (!x. x IN {} ==> P x) <=> T) /\ (!P a s. (!x. x IN (a INSERT s) ==> P x) <=> P a /\ (!x. x IN s ==> P x))`, REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; let EXISTS_IN_CLAUSES = prove (`(!P. (?x. x IN {} /\ P x) <=> F) /\ (!P a s. (?x. x IN (a INSERT s) /\ P x) <=> P a \/ (?x. x IN s /\ P x))`, REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Injectivity and surjectivity of image and preimage under a function. *) (* ------------------------------------------------------------------------- *) let INJECTIVE_ON_IMAGE = prove (`!f:A->B u. (!s t. s SUBSET u /\ t SUBSET u /\ IMAGE f s = IMAGE f t ==> s = t) <=> (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC; SET_TAC[]] THEN MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{x:A}`; `{y:A}`]) THEN ASM_REWRITE_TAC[SING_SUBSET; IMAGE_CLAUSES] THEN SET_TAC[]);; let INJECTIVE_IMAGE = prove (`!f:A->B. (!s t. IMAGE f s = IMAGE f t ==> s = t) <=> (!x y. f x = f y ==> x = y)`, GEN_TAC THEN MP_TAC(ISPECL [`f:A->B`; `(:A)`] INJECTIVE_ON_IMAGE) THEN REWRITE_TAC[IN_UNIV; SUBSET_UNIV]);; let SURJECTIVE_ON_IMAGE = prove (`!f:A->B u v. (!t. t SUBSET v ==> ?s. s SUBSET u /\ IMAGE f s = t) <=> (!y. y IN v ==> ?x. x IN u /\ f x = y)`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN X_GEN_TAC `y:B` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{y:B}`) THEN ASM SET_TAC[]; DISCH_TAC THEN X_GEN_TAC `t:B->bool` THEN DISCH_TAC THEN EXISTS_TAC `{x | x IN u /\ (f:A->B) x IN t}` THEN ASM SET_TAC[]]);; let SURJECTIVE_IMAGE = prove (`!f:A->B. (!t. ?s. IMAGE f s = t) <=> (!y. ?x. f x = y)`, GEN_TAC THEN MP_TAC(ISPECL [`f:A->B`; `(:A)`; `(:B)`] SURJECTIVE_ON_IMAGE) THEN REWRITE_TAC[IN_UNIV; SUBSET_UNIV]);; let INJECTIVE_ON_PREIMAGE = prove (`!f:A->B s u. (!t t'. t SUBSET u /\ t' SUBSET u /\ {x | x IN s /\ f x IN t} = {x | x IN s /\ f x IN t'} ==> t = t') <=> u SUBSET IMAGE f s`, REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:B` THEN FIRST_X_ASSUM(MP_TAC o SPECL [`{y:B}`; `{}:B->bool`]) THEN ASM SET_TAC[]);; let SURJECTIVE_ON_PREIMAGE = prove (`!f:A->B s u. (!k. k SUBSET s ==> ?t. t SUBSET u /\ {x | x IN s /\ f x IN t} = k) <=> IMAGE f s SUBSET u /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)`, REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL [CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:A}`) THEN ASM SET_TAC[]; MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:A}`) THEN ASM SET_TAC[]]; X_GEN_TAC `k:A->bool` THEN STRIP_TAC THEN EXISTS_TAC `IMAGE (f:A->B) k` THEN ASM SET_TAC[]]);; let INJECTIVE_PREIMAGE = prove (`!f:A->B. (!t t'. {x | f x IN t} = {x | f x IN t'} ==> t = t') <=> IMAGE f UNIV = UNIV`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:A->B`; `(:A)`; `(:B)`] INJECTIVE_ON_PREIMAGE) THEN REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN SET_TAC[]);; let SURJECTIVE_PREIMAGE = prove (`!f:A->B. (!k. ?t. {x | f x IN t} = k) <=> (!x y. f x = f y ==> x = y)`, REPEAT GEN_TAC THEN MP_TAC(ISPECL [`f:A->B`; `(:A)`; `(:B)`] SURJECTIVE_ON_PREIMAGE) THEN REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Existence of bijections between two finite sets of same size. *) (* ------------------------------------------------------------------------- *) let CARD_EQ_BIJECTION = prove (`!s t. FINITE s /\ FINITE t /\ CARD s = CARD t ==> ?f:A->B. (!x. x IN s ==> f(x) IN t) /\ (!y. y IN t ==> ?x. x IN s /\ f x = y) /\ !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, MP_TAC CARD_LE_INJ THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[SURJECTIVE_IFF_INJECTIVE_GEN] THEN MESON_TAC[SUBSET; IN_IMAGE]);; let CARD_EQ_BIJECTIONS = prove (`!s t. FINITE s /\ FINITE t /\ CARD s = CARD t ==> ?f:A->B g. (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ (!y. y IN t ==> g(y) IN s /\ f(g y) = y)`, REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_BIJECTION) THEN MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SURJECTIVE_ON_RIGHT_INVERSE] THEN GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);; let BIJECTIONS_HAS_SIZE = prove (`!s t f:A->B g. (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ (!y. y IN t ==> g(y) IN s /\ f(g y) = y) /\ s HAS_SIZE n ==> t HAS_SIZE n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `t = IMAGE (f:A->B) s` SUBST_ALL_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_MESON_TAC[]]);; let BIJECTIONS_HAS_SIZE_EQ = prove (`!s t f:A->B g. (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ (!y. y IN t ==> g(y) IN s /\ f(g y) = y) ==> !n. s HAS_SIZE n <=> t HAS_SIZE n`, REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] BIJECTIONS_HAS_SIZE) THENL [MAP_EVERY EXISTS_TAC [`f:A->B`; `g:B->A`]; MAP_EVERY EXISTS_TAC [`g:B->A`; `f:A->B`]] THEN ASM_MESON_TAC[]);; let BIJECTIONS_CARD_EQ = prove (`!s t f:A->B g. (FINITE s \/ FINITE t) /\ (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ (!y. y IN t ==> g(y) IN s /\ f(g y) = y) ==> CARD s = CARD t`, REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (MP_TAC o MATCH_MP BIJECTIONS_HAS_SIZE_EQ)) THEN MESON_TAC[HAS_SIZE]);; (* ------------------------------------------------------------------------- *) (* Transitive relation with finitely many predecessors is wellfounded. *) (* ------------------------------------------------------------------------- *) let WF_FINITE = prove (`!(<<). (!x. ~(x << x)) /\ (!x y z. x << y /\ y << z ==> x << z) /\ (!x:A. FINITE {y | y << x}) ==> WF(<<)`, REPEAT STRIP_TAC THEN REWRITE_TAC[WF_DCHAIN] THEN DISCH_THEN(X_CHOOSE_THEN `s:num->A` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `!m n. m < n ==> (s:num->A) n << s m` ASSUME_TAC THENL [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `s:num->A` INFINITE_IMAGE_INJ) THEN ANTS_TAC THENL [ASM_MESON_TAC[LT_CASES]; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPEC `(:num)`) THEN REWRITE_TAC[num_INFINITE] THEN REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s(0) INSERT {y:A | y << s(0)}` THEN ASM_REWRITE_TAC[FINITE_INSERT] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_INSERT] THEN INDUCT_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[LT_0]);; let WF_PSUBSET = prove (`!s:A->bool. FINITE s ==> WF (\t1 t2. t1 PSUBSET t2 /\ t2 SUBSET s)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC WF_FINITE THEN SIMP_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [SET_TAC[]; X_GEN_TAC `t:A->bool`] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{t:A->bool | t SUBSET s}` THEN ASM_SIMP_TAC[FINITE_POWERSET] THEN SET_TAC[]);; (* ------------------------------------------------------------------------- *) (* Cardinal comparisons (more theory in Library/card.ml) *) (* ------------------------------------------------------------------------- *) let le_c = new_definition `s <=_c t <=> ?f. (!x. x IN s ==> f(x) IN t) /\ (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y))`;; let lt_c = new_definition `s <_c t <=> s <=_c t /\ ~(t <=_c s)`;; let eq_c = new_definition `s =_c t <=> ?f. (!x. x IN s ==> f(x) IN t) /\ !y. y IN t ==> ?!x. x IN s /\ (f x = y)`;; let ge_c = new_definition `s >=_c t <=> t <=_c s`;; let gt_c = new_definition `s >_c t <=> t <_c s`;; let LE_C = prove (`!s t. s <=_c t <=> ?g. !x. x IN s ==> ?y. y IN t /\ (g y = x)`, REWRITE_TAC[le_c; INJECTIVE_ON_LEFT_INVERSE; SURJECTIVE_ON_RIGHT_INVERSE; RIGHT_IMP_EXISTS_THM; SKOLEM_THM; RIGHT_AND_EXISTS_THM] THEN MESON_TAC[]);; let GE_C = prove (`!s t. s >=_c t <=> ?f. !y. y IN t ==> ?x. x IN s /\ (y = f x)`, REWRITE_TAC[ge_c; LE_C] THEN MESON_TAC[]);; let COUNTABLE = new_definition `COUNTABLE t <=> (:num) >=_c t`;; (* ------------------------------------------------------------------------- *) (* Supremum and infimum. *) (* ------------------------------------------------------------------------- *) let sup = new_definition `sup s = @a:real. (!x. x IN s ==> x <= a) /\ !b. (!x. x IN s ==> x <= b) ==> a <= b`;; let SUP_EQ = prove (`!s t. (!b. (!x. x IN s ==> x <= b) <=> (!x. x IN t ==> x <= b)) ==> sup s = sup t`, SIMP_TAC[sup]);; let SUP = prove (`!s. ~(s = {}) /\ (?b. !x. x IN s ==> x <= b) ==> (!x. x IN s ==> x <= sup s) /\ !b. (!x. x IN s ==> x <= b) ==> sup s <= b`, REWRITE_TAC[sup] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_COMPLETE THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; let SUP_FINITE_LEMMA = prove (`!s. FINITE s /\ ~(s = {}) ==> ?b:real. b IN s /\ !x. x IN s ==> x <= b`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_INSERT_EMPTY; IN_INSERT] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_TRANS]);; let SUP_FINITE = prove (`!s. FINITE s /\ ~(s = {}) ==> (sup s) IN s /\ !x. x IN s ==> x <= sup s`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SUP_FINITE_LEMMA) THEN ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TOTAL; SUP]);; let REAL_LE_SUP_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (a <= sup s <=> ?x. x IN s /\ a <= x)`, MESON_TAC[SUP_FINITE; REAL_LE_TRANS]);; let REAL_SUP_LE_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (sup s <= a <=> !x. x IN s ==> x <= a)`, MESON_TAC[SUP_FINITE; REAL_LE_TRANS]);; let REAL_LT_SUP_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (a < sup s <=> ?x. x IN s /\ a < x)`, MESON_TAC[SUP_FINITE; REAL_LTE_TRANS]);; let REAL_SUP_LT_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (sup s < a <=> !x. x IN s ==> x < a)`, MESON_TAC[SUP_FINITE; REAL_LET_TRANS]);; let REAL_SUP_UNIQUE = prove (`!s b. (!x. x IN s ==> x <= b) /\ (!b'. b' < b ==> ?x. x IN s /\ b' < x) ==> sup s = b`, REPEAT STRIP_TAC THEN REWRITE_TAC[sup] THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[REAL_NOT_LE; REAL_LE_ANTISYM]);; let REAL_SUP_LE = prove (`!b. ~(s = {}) /\ (!x. x IN s ==> x <= b) ==> sup s <= b`, MESON_TAC[SUP]);; let REAL_SUP_LE_SUBSET = prove (`!s t. ~(s = {}) /\ s SUBSET t /\ (?b. !x. x IN t ==> x <= b) ==> sup s <= sup t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN MP_TAC(SPEC `t:real->bool` SUP) THEN ASM SET_TAC[]);; let REAL_SUP_BOUNDS = prove (`!s a b. ~(s = {}) /\ (!x. x IN s ==> a <= x /\ x <= b) ==> a <= sup s /\ sup s <= b`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `s:real->bool` SUP) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[REAL_LE_TRANS]);; let REAL_ABS_SUP_LE = prove (`!s a. ~(s = {}) /\ (!x. x IN s ==> abs(x) <= a) ==> abs(sup s) <= a`, REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_SUP_BOUNDS]);; let REAL_SUP_ASCLOSE = prove (`!s l e. ~(s = {}) /\ (!x. x IN s ==> abs(x - l) <= e) ==> abs(sup s - l) <= e`, SIMP_TAC[REAL_ARITH `abs(x - l):real <= e <=> l - e <= x /\ x <= l + e`] THEN REWRITE_TAC[REAL_SUP_BOUNDS]);; let SUP_UNIQUE_FINITE = prove (`!s. FINITE s /\ ~(s = {}) ==> (sup s = a <=> a IN s /\ !y. y IN s ==> y <= a)`, ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_SUP_FINITE; REAL_SUP_LE_FINITE; NOT_INSERT_EMPTY; FINITE_INSERT; FINITE_EMPTY] THEN MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS; REAL_LE_ANTISYM]);; let SUP_INSERT_FINITE = prove (`!x s. FINITE s ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SUP_UNIQUE_FINITE; FINITE_INSERT; FINITE_EMPTY; NOT_INSERT_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_SING; REAL_LE_REFL] THEN REWRITE_TAC[real_max] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[SUP_FINITE; IN_INSERT; REAL_LE_REFL] THEN ASM_MESON_TAC[SUP_FINITE; REAL_LE_TOTAL; REAL_LE_TRANS]);; let SUP_SING = prove (`!a. sup {a} = a`, SIMP_TAC[SUP_INSERT_FINITE; FINITE_EMPTY]);; let SUP_INSERT_INSERT = prove (`!a b s. sup (b INSERT a INSERT s) = sup (max a b INSERT s)`, REPEAT GEN_TAC THEN MATCH_MP_TAC SUP_EQ THEN X_GEN_TAC `c:real` THEN REWRITE_TAC[FORALL_IN_INSERT] THEN ASM_CASES_TAC `!x:real. x IN s ==> x <= c` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_LE_SUP = prove (`!s a b y. y IN s /\ a <= y /\ (!x. x IN s ==> x <= b) ==> a <= sup s`, MESON_TAC[SUP; MEMBER_NOT_EMPTY; REAL_LE_TRANS]);; let REAL_SUP_LE_EQ = prove (`!s y. ~(s = {}) /\ (?b. !x. x IN s ==> x <= b) ==> (sup s <= y <=> !x. x IN s ==> x <= y)`, MESON_TAC[SUP; REAL_LE_TRANS]);; let SUP_UNIQUE = prove (`!s b. (!c. (!x. x IN s ==> x <= c) <=> b <= c) ==> sup s = b`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM SUP_SING] THEN MATCH_MP_TAC SUP_EQ THEN ASM SET_TAC[]);; let SUP_UNION = prove (`!s t. ~(s = {}) /\ ~(t = {}) /\ (?b. !x. x IN s ==> x <= b) /\ (?c. !x. x IN t ==> x <= c) ==> sup(s UNION t) = max (sup s) (sup t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC SUP_UNIQUE THEN REWRITE_TAC[FORALL_IN_UNION; REAL_MAX_LE] THEN ASM_MESON_TAC[SUP; REAL_LE_TRANS]);; let ELEMENT_LE_SUP = prove (`!s a. (?b. !x. x IN s ==> x <= b) /\ a IN s ==> a <= sup s`, MESON_TAC[REAL_LE_SUP; REAL_LE_REFL]);; let inf = new_definition `inf s = @a:real. (!x. x IN s ==> a <= x) /\ !b. (!x. x IN s ==> b <= x) ==> b <= a`;; let INF_EQ = prove (`!s t. (!a. (!x. x IN s ==> a <= x) <=> (!x. x IN t ==> a <= x)) ==> inf s = inf t`, SIMP_TAC[inf]);; let INF = prove (`!s. ~(s = {}) /\ (?b. !x. x IN s ==> b <= x) ==> (!x. x IN s ==> inf s <= x) /\ !b. (!x. x IN s ==> b <= x) ==> b <= inf s`, GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[inf] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN EXISTS_TAC `--(sup (IMAGE (--) s))` THEN MP_TAC(SPEC `IMAGE (--) (s:real->bool)` SUP) THEN REWRITE_TAC[REAL_NEG_NEG] THEN ABBREV_TAC `a = sup (IMAGE (--) s)` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE] THEN ASM_MESON_TAC[REAL_NEG_NEG; MEMBER_NOT_EMPTY; REAL_LE_NEG2]);; let INF_FINITE_LEMMA = prove (`!s. FINITE s /\ ~(s = {}) ==> ?b:real. b IN s /\ !x. x IN s ==> b <= x`, REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_INSERT_EMPTY; IN_INSERT] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[REAL_LE_TOTAL; REAL_LE_TRANS]);; let INF_FINITE = prove (`!s. FINITE s /\ ~(s = {}) ==> (inf s) IN s /\ !x. x IN s ==> inf s <= x`, GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INF_FINITE_LEMMA) THEN ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TOTAL; INF]);; let REAL_LE_INF_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (a <= inf s <=> !x. x IN s ==> a <= x)`, MESON_TAC[INF_FINITE; REAL_LE_TRANS]);; let REAL_INF_LE_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (inf s <= a <=> ?x. x IN s /\ x <= a)`, MESON_TAC[INF_FINITE; REAL_LE_TRANS]);; let REAL_LT_INF_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (a < inf s <=> !x. x IN s ==> a < x)`, MESON_TAC[INF_FINITE; REAL_LTE_TRANS]);; let REAL_INF_LT_FINITE = prove (`!s a. FINITE s /\ ~(s = {}) ==> (inf s < a <=> ?x. x IN s /\ x < a)`, MESON_TAC[INF_FINITE; REAL_LET_TRANS]);; let REAL_INF_UNIQUE = prove (`!s b. (!x. x IN s ==> b <= x) /\ (!b'. b < b' ==> ?x. x IN s /\ x < b') ==> inf s = b`, REPEAT STRIP_TAC THEN REWRITE_TAC[inf] THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[REAL_NOT_LE; REAL_LE_ANTISYM]);; let REAL_LE_INF = prove (`!b. ~(s = {}) /\ (!x. x IN s ==> b <= x) ==> b <= inf s`, MESON_TAC[INF]);; let REAL_LE_INF_SUBSET = prove (`!s t. ~(t = {}) /\ t SUBSET s /\ (?b. !x. x IN s ==> b <= x) ==> inf s <= inf t`, REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN MP_TAC(SPEC `s:real->bool` INF) THEN ASM SET_TAC[]);; let REAL_INF_BOUNDS = prove (`!s a b. ~(s = {}) /\ (!x. x IN s ==> a <= x /\ x <= b) ==> a <= inf s /\ inf s <= b`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `s:real->bool` INF) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[REAL_LE_TRANS]);; let REAL_ABS_INF_LE = prove (`!s a. ~(s = {}) /\ (!x. x IN s ==> abs(x) <= a) ==> abs(inf s) <= a`, REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_INF_BOUNDS]);; let REAL_INF_ASCLOSE = prove (`!s l e. ~(s = {}) /\ (!x. x IN s ==> abs(x - l) <= e) ==> abs(inf s - l) <= e`, SIMP_TAC[REAL_ARITH `abs(x - l):real <= e <=> l - e <= x /\ x <= l + e`] THEN REWRITE_TAC[REAL_INF_BOUNDS]);; let INF_UNIQUE_FINITE = prove (`!s. FINITE s /\ ~(s = {}) ==> (inf s = a <=> a IN s /\ !y. y IN s ==> a <= y)`, ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_INF_FINITE; REAL_INF_LE_FINITE; NOT_INSERT_EMPTY; FINITE_INSERT; FINITE_EMPTY] THEN MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS; REAL_LE_ANTISYM]);; let INF_INSERT_FINITE = prove (`!x s. FINITE s ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`, REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[INF_UNIQUE_FINITE; FINITE_INSERT; FINITE_EMPTY; NOT_INSERT_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN REWRITE_TAC[IN_SING; REAL_LE_REFL] THEN REWRITE_TAC[real_min] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[INF_FINITE; IN_INSERT; REAL_LE_REFL] THEN ASM_MESON_TAC[INF_FINITE; REAL_LE_TOTAL; REAL_LE_TRANS]);; let INF_SING = prove (`!a. inf {a} = a`, SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);; let INF_INSERT_INSERT = prove (`!a b s. inf (b INSERT a INSERT s) = inf (min a b INSERT s)`, REPEAT GEN_TAC THEN MATCH_MP_TAC INF_EQ THEN X_GEN_TAC `c:real` THEN REWRITE_TAC[FORALL_IN_INSERT] THEN ASM_CASES_TAC `!x:real. x IN s ==> c <= x` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; let REAL_SUP_EQ_INF = prove (`!s. ~(s = {}) /\ (?B. !x. x IN s ==> abs(x) <= B) ==> (sup s = inf s <=> ?a. s = {a})`, REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `sup s` THEN MATCH_MP_TAC (SET_RULE `~(s = {}) /\ (!x. x IN s ==> x = a) ==> s = {a}`) THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM_MESON_TAC[SUP; REAL_ABS_BOUNDS; INF]; STRIP_TAC THEN ASM_SIMP_TAC[SUP_INSERT_FINITE; INF_INSERT_FINITE; FINITE_EMPTY]]);; let REAL_INF_LE = prove (`!s a b y. y IN s /\ y <= b /\ (!x. x IN s ==> a <= x) ==> inf s <= b`, MESON_TAC[INF; MEMBER_NOT_EMPTY; REAL_LE_TRANS]);; let REAL_LE_INF_EQ = prove (`!s t. ~(s = {}) /\ (?b. !x. x IN s ==> b <= x) ==> (y <= inf s <=> !x. x IN s ==> y <= x)`, MESON_TAC[INF; REAL_LE_TRANS]);; let INF_UNIQUE = prove (`!s b. (!c. (!x. x IN s ==> c <= x) <=> c <= b) ==> inf s = b`, REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM INF_SING] THEN MATCH_MP_TAC INF_EQ THEN ASM SET_TAC[]);; let INF_UNION = prove (`!s t. ~(s = {}) /\ ~(t = {}) /\ (?b. !x. x IN s ==> b <= x) /\ (?c. !x. x IN t ==> c <= x) ==> inf(s UNION t) = min (inf s) (inf t)`, REPEAT STRIP_TAC THEN MATCH_MP_TAC INF_UNIQUE THEN REWRITE_TAC[FORALL_IN_UNION; REAL_LE_MIN] THEN ASM_MESON_TAC[INF; REAL_LE_TRANS]);; let INF_LE_ELEMENT = prove (`!s a. (?b. !x. x IN s ==> b <= x) /\ a IN s ==> inf s <= a`, MESON_TAC[REAL_INF_LE; REAL_LE_REFL]);; (* ------------------------------------------------------------------------- *) (* Inductive definition of sets, by reducing them to inductive relations. *) (* ------------------------------------------------------------------------- *) let new_inductive_set = let const_of_var v = mk_mconst(name_of v,type_of v) in let comb_all = let rec f (n:int) (tm:term) : hol_type list -> term = function | [] -> tm | ty::tys -> let v = variant (variables tm) (mk_var("x"^string_of_int n,ty)) in f (n+1) (mk_comb(tm,v)) tys in fun tm -> let tys = fst (splitlist dest_fun_ty (type_of tm)) in f 0 tm tys in let mk_eqin = REWR_CONV (GSYM IN) o comb_all in let transf conv = rhs o concl o conv in let remove_in_conv ptm : conv = let rconv = REWR_CONV(SYM(mk_eqin ptm)) in fun tm -> let htm = fst(strip_comb(snd(dest_binary "IN" tm))) in if htm = ptm then rconv tm else fail() in let remove_in_transf = transf o ONCE_DEPTH_CONV o FIRST_CONV o map remove_in_conv in let rule_head tm = let tm = snd(strip_forall tm) in let tm = snd(splitlist(dest_binop `(==>)`) tm) in let tm = snd(dest_binary "IN" tm) in fst(strip_comb tm) in let find_pvars = setify o map rule_head o binops `(/\)` in fun tm -> let pvars = find_pvars tm in let dtm = remove_in_transf pvars tm in let th_rules, th_induct, th_cases = new_inductive_definition dtm in let insert_in_rule = REWRITE_RULE(map (mk_eqin o const_of_var) pvars) in insert_in_rule th_rules, insert_in_rule th_induct, insert_in_rule th_cases;; hol-light/simp.ml000066400000000000000000000601361303454263000142550ustar00rootroot00000000000000(* ========================================================================= *) (* Simplification and rewriting. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "itab.ml";; (* ------------------------------------------------------------------------- *) (* Generalized conversion (conversion plus a priority). *) (* ------------------------------------------------------------------------- *) type gconv = int * conv;; (* ------------------------------------------------------------------------- *) (* Primitive rewriting conversions: unconditional and conditional equations. *) (* ------------------------------------------------------------------------- *) let REWR_CONV = PART_MATCH lhs;; let IMP_REWR_CONV = PART_MATCH (lhs o snd o dest_imp);; (* ------------------------------------------------------------------------- *) (* Versions with ordered rewriting. We must have l' > r' for the rewrite *) (* |- l = r (or |- c ==> (l = r)) to apply. *) (* ------------------------------------------------------------------------- *) let ORDERED_REWR_CONV ord th = let basic_conv = REWR_CONV th in fun tm -> let thm = basic_conv tm in let l,r = dest_eq(concl thm) in if ord l r then thm else failwith "ORDERED_REWR_CONV: wrong orientation";; let ORDERED_IMP_REWR_CONV ord th = let basic_conv = IMP_REWR_CONV th in fun tm -> let thm = basic_conv tm in let l,r = dest_eq(rand(concl thm)) in if ord l r then thm else failwith "ORDERED_IMP_REWR_CONV: wrong orientation";; (* ------------------------------------------------------------------------- *) (* Standard AC-compatible term ordering: a "dynamic" lexicographic ordering. *) (* *) (* This is a slight hack to make AC normalization work. However I *think* *) (* it's properly AC compatible, i.e. monotonic and total, WF on ground terms *) (* (over necessarily finite signature) and with the properties for any *) (* binary operator +: *) (* *) (* (x + y) + z > x + (y + z) *) (* x + y > y + x iff x > y *) (* x + (y + z) > y + (x + z) iff x > y *) (* *) (* The idea is that when invoking lex ordering with identical head operator *) (* "f", one sticks "f" at the head of an otherwise arbitrary ordering on *) (* subterms (the built-in CAML one). This avoids the potentially inefficient *) (* calculation of term size in the standard orderings. *) (* ------------------------------------------------------------------------- *) let term_order = let rec lexify ord l1 l2 = if l1 = [] then false else if l2 = [] then true else let h1 = hd l1 and h2 = hd l2 in ord h1 h2 || (h1 = h2 && lexify ord (tl l1) (tl l2)) in let rec dyn_order top tm1 tm2 = let f1,args1 = strip_comb tm1 and f2,args2 = strip_comb tm2 in if f1 = f2 then lexify (dyn_order f1) args1 args2 else if f2 = top then false else if f1 = top then true else f1 > f2 in dyn_order `T`;; (* ------------------------------------------------------------------------- *) (* Create a gconv net for a theorem as a (cond) rewrite. The "rep" flag *) (* will cause any trivially looping rewrites to be modified, and any that *) (* are permutative to be ordered w.r.t. the standard order. The idea is that *) (* this flag will be set iff the conversion is going to get repeated. *) (* This includes a completely ad hoc but useful special case for ETA_AX, *) (* which forces a first order match (otherwise it would loop on a lambda). *) (* ------------------------------------------------------------------------- *) let net_of_thm rep th = let tm = concl th in let lconsts = freesl (hyp th) in let matchable = can o term_match lconsts in match tm with Comb(Comb(Const("=",_),(Abs(x,Comb(Var(s,ty) as v,x')) as l)),v') when x' = x && v' = v && not(x = v) -> let conv tm = match tm with Abs(y,Comb(t,y')) when y = y' && not(free_in y t) -> INSTANTIATE(term_match [] v t) th | _ -> failwith "REWR_CONV (ETA_AX special case)" in enter lconsts (l,(1,conv)) | Comb(Comb(Const("=",_),l),r) -> if rep && free_in l r then let th' = EQT_INTRO th in enter lconsts (l,(1,REWR_CONV th')) else if rep && matchable l r && matchable r l then enter lconsts (l,(1,ORDERED_REWR_CONV term_order th)) else enter lconsts (l,(1,REWR_CONV th)) | Comb(Comb(_,t),Comb(Comb(Const("=",_),l),r)) -> if rep && free_in l r then let th' = DISCH t (EQT_INTRO(UNDISCH th)) in enter lconsts (l,(3,IMP_REWR_CONV th')) else if rep && matchable l r && matchable r l then enter lconsts (l,(3,ORDERED_IMP_REWR_CONV term_order th)) else enter lconsts(l,(3,IMP_REWR_CONV th));; (* ------------------------------------------------------------------------- *) (* Create a gconv net for a conversion with a term index. *) (* ------------------------------------------------------------------------- *) let net_of_conv tm conv sofar = enter [] (tm,(2,conv)) sofar;; (* ------------------------------------------------------------------------- *) (* Create a gconv net for a congruence rule (in canonical form!) *) (* ------------------------------------------------------------------------- *) let net_of_cong th sofar = let conc,n = repeat (fun (tm,m) -> snd(dest_imp tm),m+1) (concl th,0) in if n = 0 then failwith "net_of_cong: Non-implicational congruence" else let pat = lhs conc in let conv = GEN_PART_MATCH (lhand o funpow n rand) th in enter [] (pat,(4,conv)) sofar;; (* ------------------------------------------------------------------------- *) (* Rewrite maker for ordinary and conditional rewrites (via "cf" flag). *) (* *) (* We follow Don in going from ~(s = t) to (s = t) = F *and* (t = s) = F. *) (* Well, why not? However, we don't abandon s = t where FV(t) is not a *) (* subset of FV(s) in favour of (s = t) = T, as he does. *) (* Note: looping rewrites are not discarded here, only when netted. *) (* ------------------------------------------------------------------------- *) let mk_rewrites = let IMP_CONJ_CONV = REWR_CONV(ITAUT `p ==> q ==> r <=> p /\ q ==> r`) and IMP_EXISTS_RULE = let cnv = REWR_CONV(ITAUT `(!x. P x ==> Q) <=> (?x. P x) ==> Q`) in fun v th -> CONV_RULE cnv (GEN v th) in let collect_condition oldhyps th = let conds = subtract (hyp th) oldhyps in if conds = [] then th else let jth = itlist DISCH conds th in let kth = CONV_RULE (REPEATC IMP_CONJ_CONV) jth in let cond,eqn = dest_imp(concl kth) in let fvs = subtract (subtract (frees cond) (frees eqn)) (freesl oldhyps) in itlist IMP_EXISTS_RULE fvs kth in let rec split_rewrites oldhyps cf th sofar = let tm = concl th in if is_forall tm then split_rewrites oldhyps cf (SPEC_ALL th) sofar else if is_conj tm then split_rewrites oldhyps cf (CONJUNCT1 th) (split_rewrites oldhyps cf (CONJUNCT2 th) sofar) else if is_imp tm && cf then split_rewrites oldhyps cf (UNDISCH th) sofar else if is_eq tm then (if cf then collect_condition oldhyps th else th)::sofar else if is_neg tm then let ths = split_rewrites oldhyps cf (EQF_INTRO th) sofar in if is_eq (rand tm) then split_rewrites oldhyps cf (EQF_INTRO (GSYM th)) ths else ths else split_rewrites oldhyps cf (EQT_INTRO th) sofar in fun cf th sofar -> split_rewrites (hyp th) cf th sofar;; (* ------------------------------------------------------------------------- *) (* Rewriting (and application of other conversions) based on a convnet. *) (* ------------------------------------------------------------------------- *) let REWRITES_CONV net tm = let pconvs = lookup tm net in try tryfind (fun (_,cnv) -> cnv tm) pconvs with Failure _ -> failwith "REWRITES_CONV";; (* ------------------------------------------------------------------------- *) (* Decision procedures may accumulate their state in different ways (e.g. *) (* term nets and predicate-indexed lists of Horn clauses). To allow mixing *) (* of arbitrary types for state storage, we use a trick due to RJB via DRS. *) (* ------------------------------------------------------------------------- *) type prover = Prover of conv * (thm list -> prover);; let mk_prover applicator augmentor = let rec mk_prover state = let apply = applicator state and augment thms = mk_prover (augmentor state thms) in Prover(apply,augment) in mk_prover;; let augment(Prover(_,aug)) thms = aug thms;; let apply_prover(Prover(conv,_)) tm = conv tm;; (* ------------------------------------------------------------------------- *) (* Type of simpsets. We have a convnet containing rewrites (implicational *) (* and otherwise), other term-indexed context-free conversions like *) (* BETA_CONV, and congruence rules. Then there is a list of provers that *) (* have their own way of storing and using context, and finally a rewrite *) (* maker function, to allow customization. *) (* *) (* We also have a type of (traversal) strategy, following Konrad. *) (* ------------------------------------------------------------------------- *) type simpset = Simpset of gconv net (* Rewrites & congruences *) * (strategy -> strategy) (* Prover for conditions *) * prover list (* Subprovers for prover *) * (thm -> thm list -> thm list) (* Rewrite maker *) and strategy = simpset -> int -> term -> thm;; (* ------------------------------------------------------------------------- *) (* Very simple prover: recursively simplify then try provers. *) (* ------------------------------------------------------------------------- *) let basic_prover strat (Simpset(net,prover,provers,rewmaker) as ss) lev tm = let sth = try strat ss lev tm with Failure _ -> REFL tm in try EQT_ELIM sth with Failure _ -> let tth = tryfind (fun pr -> apply_prover pr (rand(concl sth))) provers in EQ_MP (SYM sth) tth;; (* ------------------------------------------------------------------------- *) (* Functions for changing or augmenting components of simpsets. *) (* ------------------------------------------------------------------------- *) let ss_of_thms thms (Simpset(net,prover,provers,rewmaker)) = let cthms = itlist rewmaker thms [] in let net' = itlist (net_of_thm true) cthms net in Simpset(net',prover,provers,rewmaker);; let ss_of_conv keytm conv (Simpset(net,prover,provers,rewmaker)) = let net' = net_of_conv keytm conv net in Simpset(net',prover,provers,rewmaker);; let ss_of_congs thms (Simpset(net,prover,provers,rewmaker)) = let net' = itlist net_of_cong thms net in Simpset(net',prover,provers,rewmaker);; let ss_of_prover newprover (Simpset(net,_,provers,rewmaker)) = Simpset(net,newprover,provers,rewmaker);; let ss_of_provers newprovers (Simpset(net,prover,provers,rewmaker)) = Simpset(net,prover,newprovers@provers,rewmaker);; let ss_of_maker newmaker (Simpset(net,prover,provers,_)) = Simpset(net,prover,provers,newmaker);; (* ------------------------------------------------------------------------- *) (* Perform a context-augmentation operation on a simpset. *) (* ------------------------------------------------------------------------- *) let AUGMENT_SIMPSET cth (Simpset(net,prover,provers,rewmaker)) = let provers' = map (C augment [cth]) provers in let cthms = rewmaker cth [] in let net' = itlist (net_of_thm true) cthms net in Simpset(net',prover,provers',rewmaker);; (* ------------------------------------------------------------------------- *) (* Depth conversions. *) (* ------------------------------------------------------------------------- *) let ONCE_DEPTH_SQCONV,DEPTH_SQCONV,REDEPTH_SQCONV, TOP_DEPTH_SQCONV,TOP_SWEEP_SQCONV = let IMP_REWRITES_CONV strat (Simpset(net,prover,provers,rewmaker) as ss) lev pconvs tm = tryfind (fun (n,cnv) -> if n >= 4 then fail() else let th = cnv tm in let etm = concl th in if is_eq etm then th else if lev <= 0 then failwith "IMP_REWRITES_CONV: Too deep" else let cth = prover strat ss (lev-1) (lhand etm) in MP th cth) pconvs in let rec RUN_SUB_CONV strat ss lev triv th = let tm = concl th in if is_imp tm then let subtm = lhand tm in let avs,bod = strip_forall subtm in let (t,t'),ss',mk_fun = try dest_eq bod,ss,I with Failure _ -> let cxt,deq = dest_imp bod in dest_eq deq,AUGMENT_SIMPSET (ASSUME cxt) ss,DISCH cxt in let eth,triv' = try strat ss' lev t,false with Failure _ -> REFL t,triv in let eth' = GENL avs (mk_fun eth) in let th' = if is_var t' then INST [rand(concl eth),t'] th else GEN_PART_MATCH lhand th (concl eth') in let th'' = MP th' eth' in RUN_SUB_CONV strat ss lev triv' th'' else if triv then fail() else th in let GEN_SUB_CONV strat ss lev pconvs tm = try tryfind (fun (n,cnv) -> if n < 4 then fail() else let th = cnv tm in RUN_SUB_CONV strat ss lev true th) pconvs with Failure _ -> if is_comb tm then let l,r = dest_comb tm in try let th1 = strat ss lev l in try let th2 = strat ss lev r in MK_COMB(th1,th2) with Failure _ -> AP_THM th1 r with Failure _ -> AP_TERM l (strat ss lev r) else if is_abs tm then let v,bod = dest_abs tm in let th = strat ss lev bod in try ABS v th with Failure _ -> let gv = genvar(type_of v) in let gbod = vsubst[gv,v] bod in let gth = ABS gv (strat ss lev gbod) in let gtm = concl gth in let l,r = dest_eq gtm in let v' = variant (frees gtm) v in let l' = alpha v' l and r' = alpha v' r in EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth else failwith "GEN_SUB_CONV" in let rec ONCE_DEPTH_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = let pconvs = lookup tm net in try IMP_REWRITES_CONV ONCE_DEPTH_SQCONV ss lev pconvs tm with Failure _ -> GEN_SUB_CONV ONCE_DEPTH_SQCONV ss lev pconvs tm in let rec DEPTH_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = let pconvs = lookup tm net in try let th1 = GEN_SUB_CONV DEPTH_SQCONV ss lev pconvs tm in let tm1 = rand(concl th1) in let pconvs1 = lookup tm1 net in try TRANS th1 (IMP_REWRITES_CONV DEPTH_SQCONV ss lev pconvs1 tm1) with Failure _ -> th1 with Failure _ -> IMP_REWRITES_CONV DEPTH_SQCONV ss lev pconvs tm in let rec REDEPTH_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = let pconvs = lookup tm net in let th = try let th1 = GEN_SUB_CONV REDEPTH_SQCONV ss lev pconvs tm in let tm1 = rand(concl th1) in let pconvs1 = lookup tm1 net in try TRANS th1 (IMP_REWRITES_CONV REDEPTH_SQCONV ss lev pconvs1 tm1) with Failure _ -> th1 with Failure _ -> IMP_REWRITES_CONV REDEPTH_SQCONV ss lev pconvs tm in try let th' = REDEPTH_SQCONV ss lev (rand(concl th)) in TRANS th th' with Failure _ -> th in let rec TOP_DEPTH_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = let pconvs = lookup tm net in let th1 = try IMP_REWRITES_CONV TOP_DEPTH_SQCONV ss lev pconvs tm with Failure _ -> GEN_SUB_CONV TOP_DEPTH_SQCONV ss lev pconvs tm in try let th2 = TOP_DEPTH_SQCONV ss lev (rand(concl th1)) in TRANS th1 th2 with Failure _ -> th1 in let rec TOP_SWEEP_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = let pconvs = lookup tm net in try let th1 = IMP_REWRITES_CONV TOP_SWEEP_SQCONV ss lev pconvs tm in try let th2 = TOP_SWEEP_SQCONV ss lev (rand(concl th1)) in TRANS th1 th2 with Failure _ -> th1 with Failure _ -> GEN_SUB_CONV TOP_SWEEP_SQCONV ss lev pconvs tm in ONCE_DEPTH_SQCONV,DEPTH_SQCONV,REDEPTH_SQCONV, TOP_DEPTH_SQCONV,TOP_SWEEP_SQCONV;; (* ------------------------------------------------------------------------- *) (* Maintenence of basic rewrites and conv nets for rewriting. *) (* ------------------------------------------------------------------------- *) let set_basic_rewrites,extend_basic_rewrites,basic_rewrites, set_basic_convs,extend_basic_convs,basic_convs,basic_net = let rewrites = ref ([]:thm list) and conversions = ref ([]:(string*(term*conv))list) and conv_net = ref (empty_net: gconv net) in let rehash_convnet() = conv_net := itlist (net_of_thm true) (!rewrites) (itlist (fun (_,(pat,cnv)) -> net_of_conv pat cnv) (!conversions) empty_net) in let set_basic_rewrites thl = let canon_thl = itlist (mk_rewrites false) thl [] in (rewrites := canon_thl; rehash_convnet()) and extend_basic_rewrites thl = let canon_thl = itlist (mk_rewrites false) thl [] in (rewrites := canon_thl @ !rewrites; rehash_convnet()) and basic_rewrites() = !rewrites and set_basic_convs cnvs = (conversions := cnvs; rehash_convnet()) and extend_basic_convs (name,patcong) = (conversions := (name,patcong)::filter(fun (name',_) -> name <> name') (!conversions); rehash_convnet()) and basic_convs() = !conversions and basic_net() = !conv_net in set_basic_rewrites,extend_basic_rewrites,basic_rewrites, set_basic_convs,extend_basic_convs,basic_convs,basic_net;; (* ------------------------------------------------------------------------- *) (* Same thing for the default congruences. *) (* ------------------------------------------------------------------------- *) let set_basic_congs,extend_basic_congs,basic_congs = let congs = ref ([]:thm list) in (fun thl -> congs := thl), (fun thl -> congs := union' equals_thm thl (!congs)), (fun () -> !congs);; (* ------------------------------------------------------------------------- *) (* Main rewriting conversions. *) (* ------------------------------------------------------------------------- *) let GENERAL_REWRITE_CONV rep (cnvl:conv->conv) (builtin_net:gconv net) thl = let thl_canon = itlist (mk_rewrites false) thl [] in let final_net = itlist (net_of_thm rep) thl_canon builtin_net in cnvl (REWRITES_CONV final_net);; let GEN_REWRITE_CONV (cnvl:conv->conv) thl = GENERAL_REWRITE_CONV false cnvl empty_net thl;; let PURE_REWRITE_CONV thl = GENERAL_REWRITE_CONV true TOP_DEPTH_CONV empty_net thl;; let REWRITE_CONV thl = GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net()) thl;; let PURE_ONCE_REWRITE_CONV thl = GENERAL_REWRITE_CONV false ONCE_DEPTH_CONV empty_net thl;; let ONCE_REWRITE_CONV thl = GENERAL_REWRITE_CONV false ONCE_DEPTH_CONV (basic_net()) thl;; (* ------------------------------------------------------------------------- *) (* Rewriting rules and tactics. *) (* ------------------------------------------------------------------------- *) let GEN_REWRITE_RULE cnvl thl = CONV_RULE(GEN_REWRITE_CONV cnvl thl);; let PURE_REWRITE_RULE thl = CONV_RULE(PURE_REWRITE_CONV thl);; let REWRITE_RULE thl = CONV_RULE(REWRITE_CONV thl);; let PURE_ONCE_REWRITE_RULE thl = CONV_RULE(PURE_ONCE_REWRITE_CONV thl);; let ONCE_REWRITE_RULE thl = CONV_RULE(ONCE_REWRITE_CONV thl);; let PURE_ASM_REWRITE_RULE thl th = PURE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; let ASM_REWRITE_RULE thl th = REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; let PURE_ONCE_ASM_REWRITE_RULE thl th = PURE_ONCE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; let ONCE_ASM_REWRITE_RULE thl th = ONCE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; let GEN_REWRITE_TAC cnvl thl = CONV_TAC(GEN_REWRITE_CONV cnvl thl);; let PURE_REWRITE_TAC thl = CONV_TAC(PURE_REWRITE_CONV thl);; let REWRITE_TAC thl = CONV_TAC(REWRITE_CONV thl);; let PURE_ONCE_REWRITE_TAC thl = CONV_TAC(PURE_ONCE_REWRITE_CONV thl);; let ONCE_REWRITE_TAC thl = CONV_TAC(ONCE_REWRITE_CONV thl);; let (PURE_ASM_REWRITE_TAC: thm list -> tactic) = ASM PURE_REWRITE_TAC;; let (ASM_REWRITE_TAC: thm list -> tactic) = ASM REWRITE_TAC;; let (PURE_ONCE_ASM_REWRITE_TAC: thm list -> tactic) = ASM PURE_ONCE_REWRITE_TAC;; let (ONCE_ASM_REWRITE_TAC: thm list -> tactic) = ASM ONCE_REWRITE_TAC;; (* ------------------------------------------------------------------------- *) (* Simplification functions. *) (* ------------------------------------------------------------------------- *) let GEN_SIMPLIFY_CONV (strat:strategy) ss lev thl = let ss' = itlist AUGMENT_SIMPSET thl ss in TRY_CONV (strat ss' lev);; let ONCE_SIMPLIFY_CONV ss = GEN_SIMPLIFY_CONV ONCE_DEPTH_SQCONV ss 1;; let SIMPLIFY_CONV ss = GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV ss 3;; (* ------------------------------------------------------------------------- *) (* Simple but useful default version. *) (* ------------------------------------------------------------------------- *) let empty_ss = Simpset(empty_net,basic_prover,[],mk_rewrites true);; let basic_ss = let rewmaker = mk_rewrites true in fun thl -> let cthms = itlist rewmaker thl [] in let net' = itlist (net_of_thm true) cthms (basic_net()) in let net'' = itlist net_of_cong (basic_congs()) net' in Simpset(net'',basic_prover,[],rewmaker);; let SIMP_CONV thl = SIMPLIFY_CONV (basic_ss []) thl;; let PURE_SIMP_CONV thl = SIMPLIFY_CONV empty_ss thl;; let ONCE_SIMP_CONV thl = ONCE_SIMPLIFY_CONV (basic_ss []) thl;; let SIMP_RULE thl = CONV_RULE(SIMP_CONV thl);; let PURE_SIMP_RULE thl = CONV_RULE(PURE_SIMP_CONV thl);; let ONCE_SIMP_RULE thl = CONV_RULE(ONCE_SIMP_CONV thl);; let SIMP_TAC thl = CONV_TAC(SIMP_CONV thl);; let PURE_SIMP_TAC thl = CONV_TAC(PURE_SIMP_CONV thl);; let ONCE_SIMP_TAC thl = CONV_TAC(ONCE_SIMP_CONV thl);; let ASM_SIMP_TAC = ASM SIMP_TAC;; let PURE_ASM_SIMP_TAC = ASM PURE_SIMP_TAC;; let ONCE_ASM_SIMP_TAC = ASM ONCE_SIMP_TAC;; (* ------------------------------------------------------------------------- *) (* Abbreviation tactics. *) (* ------------------------------------------------------------------------- *) let ABBREV_TAC tm = let cvs,t = dest_eq tm in let v,vs = strip_comb cvs in let rs = list_mk_abs(vs,t) in let eq = mk_eq(rs,v) in let th1 = itlist (fun v th -> CONV_RULE(LAND_CONV BETA_CONV) (AP_THM th v)) (rev vs) (ASSUME eq) in let th2 = SIMPLE_CHOOSE v (SIMPLE_EXISTS v (GENL vs th1)) in let th3 = PROVE_HYP (EXISTS(mk_exists(v,eq),rs) (REFL rs)) th2 in fun (asl,w as gl) -> let avoids = itlist (union o frees o concl o snd) asl (frees w) in if mem v avoids then failwith "ABBREV_TAC: variable already used" else CHOOSE_THEN (fun th -> RULE_ASSUM_TAC(PURE_ONCE_REWRITE_RULE[th]) THEN PURE_ONCE_REWRITE_TAC[th] THEN ASSUME_TAC th) th3 gl;; let EXPAND_TAC s = FIRST_ASSUM(SUBST1_TAC o SYM o check((=) s o fst o dest_var o rhs o concl)) THEN BETA_TAC;; hol-light/system.ml000066400000000000000000000045061303454263000146300ustar00rootroot00000000000000(* ========================================================================= *) (* Some miscellaneous OCaml system hacking before we get started. *) (* *) (* (c) Copyright, John Harrison 1998-2014 *) (* ========================================================================= *) Gc.set { (Gc.get()) with Gc.stack_limit = 16777216 };; (* ------------------------------------------------------------------------- *) (* Make sure user interrupts generate an exception, not kill the process. *) (* ------------------------------------------------------------------------- *) Sys.catch_break true;; (* ------------------------------------------------------------------------- *) (* Set up a quotation expander for the `...` quotes. *) (* This includes the case `;...` to support miz3, even if that isn't loaded. *) (* Other quotations ending in `...:` are treated just as (escaped) strings, *) (* so they can be parsed in a type context etc. *) (* ------------------------------------------------------------------------- *) let quotexpander s = if s = "" then failwith "Empty quotation" else let c = String.sub s 0 1 in if c = ":" then "parse_type \""^ (String.escaped (String.sub s 1 (String.length s - 1)))^"\"" else if c = ";" then "parse_qproof \""^(String.escaped s)^"\"" else let n = String.length s - 1 in if String.sub s n 1 = ":" then "\""^(String.escaped (String.sub s 0 n))^"\"" else "parse_term \""^(String.escaped s)^"\"";; Quotation.add "tot" (Quotation.ExStr (fun x -> quotexpander));; (* ------------------------------------------------------------------------- *) (* Modify the lexical analysis of uppercase identifiers. *) (* ------------------------------------------------------------------------- *) set_jrh_lexer;; (* ------------------------------------------------------------------------- *) (* Load in the bignum library and set up printing in the toplevel. *) (* ------------------------------------------------------------------------- *) #load "nums.cma";; include Num;; let print_num n = Format.open_hbox(); Format.print_string(string_of_num n); Format.close_box();; #install_printer print_num;; hol-light/tactics.ml000066400000000000000000001065021303454263000147350ustar00rootroot00000000000000(* ========================================================================= *) (* System of tactics (slightly different from any traditional LCF method). *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Marco Maggesi 2012 *) (* ========================================================================= *) needs "drule.ml";; (* ------------------------------------------------------------------------- *) (* The common case of trivial instantiations. *) (* ------------------------------------------------------------------------- *) let null_inst = ([],[],[] :instantiation);; let null_meta = (([]:term list),null_inst);; (* ------------------------------------------------------------------------- *) (* A goal has labelled assumptions, and the hyps are now thms. *) (* ------------------------------------------------------------------------- *) type goal = (string * thm) list * term;; let equals_goal ((a,w):goal) ((a',w'):goal) = forall2 (fun (s,th) (s',th') -> s = s' && equals_thm th th') a a' && w = w';; (* ------------------------------------------------------------------------- *) (* A justification function for a goalstate [A1 ?- g1; ...; An ?- gn], *) (* starting from an initial goal A ?- g, is a function f such that for any *) (* instantiation @: *) (* *) (* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A@ |- g@ *) (* ------------------------------------------------------------------------- *) type justification = instantiation -> thm list -> thm;; (* ------------------------------------------------------------------------- *) (* The goalstate stores the subgoals, justification, current instantiation, *) (* and a list of metavariables. *) (* ------------------------------------------------------------------------- *) type goalstate = (term list * instantiation) * goal list * justification;; (* ------------------------------------------------------------------------- *) (* A goalstack is just a list of goalstates. Could go for more... *) (* ------------------------------------------------------------------------- *) type goalstack = goalstate list;; (* ------------------------------------------------------------------------- *) (* A refinement, applied to a goalstate [A1 ?- g1; ...; An ?- gn] *) (* yields a new goalstate with updated justification function, to *) (* give a possibly-more-instantiated version of the initial goal. *) (* ------------------------------------------------------------------------- *) type refinement = goalstate -> goalstate;; (* ------------------------------------------------------------------------- *) (* A tactic, applied to a goal A ?- g, returns: *) (* *) (* o A list of new metavariables introduced *) (* o An instantiation (%) *) (* o A list of subgoals *) (* o A justification f such that for any instantiation @ we have *) (* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A(%;@) |- g(%;@) *) (* ------------------------------------------------------------------------- *) type tactic = goal -> goalstate;; type thm_tactic = thm -> tactic;; type thm_tactical = thm_tactic -> thm_tactic;; (* ------------------------------------------------------------------------- *) (* Apply instantiation to a goal. *) (* ------------------------------------------------------------------------- *) let (inst_goal:instantiation->goal->goal) = fun p (thms,w) -> map (I F_F INSTANTIATE_ALL p) thms,instantiate p w;; (* ------------------------------------------------------------------------- *) (* Perform a sequential composition (left first) of instantiations. *) (* ------------------------------------------------------------------------- *) let (compose_insts :instantiation->instantiation->instantiation) = fun (pats1,tmin1,tyin1) ((pats2,tmin2,tyin2) as i2) -> let tmin = map (instantiate i2 F_F inst tyin2) tmin1 and tyin = map (type_subst tyin2 F_F I) tyin1 in let tmin' = filter (fun (_,x) -> not (can (rev_assoc x) tmin)) tmin2 and tyin' = filter (fun (_,a) -> not (can (rev_assoc a) tyin)) tyin2 in pats1@pats2,tmin@tmin',tyin@tyin';; (* ------------------------------------------------------------------------- *) (* Construct A,_FALSITY_ |- p; contortion so falsity is the last element. *) (* ------------------------------------------------------------------------- *) let _FALSITY_ = new_definition `_FALSITY_ = F`;; let mk_fthm = let pth = UNDISCH(fst(EQ_IMP_RULE _FALSITY_)) and qth = ASSUME `_FALSITY_` in fun (asl,c) -> PROVE_HYP qth (itlist ADD_ASSUM (rev asl) (CONTR c pth));; (* ------------------------------------------------------------------------- *) (* Validity checking of tactics. This cannot be 100% accurate without making *) (* arbitrary theorems, but "mk_fthm" brings us quite close. *) (* ------------------------------------------------------------------------- *) let (VALID:tactic->tactic) = let fake_thm (asl,w) = let asms = itlist (union o hyp o snd) asl [] in mk_fthm(asms,w) and false_tm = `_FALSITY_` in fun tac (asl,w) -> let ((mvs,i),gls,just as res) = tac (asl,w) in let ths = map fake_thm gls in let asl',w' = dest_thm(just null_inst ths) in let asl'',w'' = inst_goal i (asl,w) in let maxasms = itlist (fun (_,th) -> union (insert (concl th) (hyp th))) asl'' [] in if aconv w' w'' & forall (fun t -> exists (aconv t) maxasms) (subtract asl' [false_tm]) then res else failwith "VALID: Invalid tactic";; (* ------------------------------------------------------------------------- *) (* Various simple combinators for tactics, identity tactic etc. *) (* ------------------------------------------------------------------------- *) let (THEN),(THENL) = let propagate_empty i [] = [] and propagate_thm th i [] = INSTANTIATE_ALL i th in let compose_justs n just1 just2 i ths = let ths1,ths2 = chop_list n ths in (just1 i ths1)::(just2 i ths2) in let rec seqapply l1 l2 = match (l1,l2) with ([],[]) -> null_meta,[],propagate_empty | ((tac:tactic)::tacs),((goal:goal)::goals) -> let ((mvs1,insts1),gls1,just1) = tac goal in let goals' = map (inst_goal insts1) goals in let ((mvs2,insts2),gls2,just2) = seqapply tacs goals' in ((union mvs1 mvs2,compose_insts insts1 insts2), gls1@gls2,compose_justs (length gls1) just1 just2) | _,_ -> failwith "seqapply: Length mismatch" in let justsequence just1 just2 insts2 i ths = just1 (compose_insts insts2 i) (just2 i ths) in let tacsequence ((mvs1,insts1),gls1,just1) tacl = let ((mvs2,insts2),gls2,just2) = seqapply tacl gls1 in let jst = justsequence just1 just2 insts2 in let just = if gls2 = [] then propagate_thm (jst null_inst []) else jst in ((union mvs1 mvs2,compose_insts insts1 insts2),gls2,just) in let (then_: tactic -> tactic -> tactic) = fun tac1 tac2 g -> let _,gls,_ as gstate = tac1 g in tacsequence gstate (replicate tac2 (length gls)) and (thenl_: tactic -> tactic list -> tactic) = fun tac1 tac2l g -> let _,gls,_ as gstate = tac1 g in if gls = [] then tacsequence gstate [] else tacsequence gstate tac2l in then_,thenl_;; let ((ORELSE): tactic -> tactic -> tactic) = fun tac1 tac2 g -> try tac1 g with Failure _ -> tac2 g;; let (FAIL_TAC: string -> tactic) = fun tok g -> failwith tok;; let (NO_TAC: tactic) = FAIL_TAC "NO_TAC";; let (ALL_TAC:tactic) = fun g -> null_meta,[g],fun _ [th] -> th;; let TRY tac = tac ORELSE ALL_TAC;; let rec REPEAT tac g = ((tac THEN REPEAT tac) ORELSE ALL_TAC) g;; let EVERY tacl = itlist (fun t1 t2 -> t1 THEN t2) tacl ALL_TAC;; let (FIRST: tactic list -> tactic) = fun tacl g -> end_itlist (fun t1 t2 -> t1 ORELSE t2) tacl g;; let MAP_EVERY tacf lst = EVERY (map tacf lst);; let MAP_FIRST tacf lst = FIRST (map tacf lst);; let (CHANGED_TAC: tactic -> tactic) = fun tac g -> let (meta,gl,_ as gstate) = tac g in if meta = null_meta && length gl = 1 && equals_goal (hd gl) g then failwith "CHANGED_TAC" else gstate;; let rec REPLICATE_TAC n tac = if n <= 0 then ALL_TAC else tac THEN (REPLICATE_TAC (n - 1) tac);; (* ------------------------------------------------------------------------- *) (* Combinators for theorem continuations / "theorem tacticals". *) (* ------------------------------------------------------------------------- *) let ((THEN_TCL): thm_tactical -> thm_tactical -> thm_tactical) = fun ttcl1 ttcl2 ttac -> ttcl1 (ttcl2 ttac);; let ((ORELSE_TCL): thm_tactical -> thm_tactical -> thm_tactical) = fun ttcl1 ttcl2 ttac th -> try ttcl1 ttac th with Failure _ -> ttcl2 ttac th;; let rec REPEAT_TCL ttcl ttac th = ((ttcl THEN_TCL (REPEAT_TCL ttcl)) ORELSE_TCL I) ttac th;; let (REPEAT_GTCL: thm_tactical -> thm_tactical) = let rec REPEAT_GTCL ttcl ttac th g = try ttcl (REPEAT_GTCL ttcl ttac) th g with Failure _ -> ttac th g in REPEAT_GTCL;; let (ALL_THEN: thm_tactical) = I;; let (NO_THEN: thm_tactical) = fun ttac th -> failwith "NO_THEN";; let EVERY_TCL ttcll = itlist (fun t1 t2 -> t1 THEN_TCL t2) ttcll ALL_THEN;; let FIRST_TCL ttcll = end_itlist (fun t1 t2 -> t1 ORELSE_TCL t2) ttcll;; (* ------------------------------------------------------------------------- *) (* Tactics to augment assumption list. Note that to allow "ASSUME p" for *) (* any assumption "p", these add a PROVE_HYP in the justification function, *) (* just in case. *) (* ------------------------------------------------------------------------- *) let (LABEL_TAC: string -> thm_tactic) = fun s thm (asl,w) -> null_meta,[(s,thm)::asl,w], fun i [th] -> PROVE_HYP (INSTANTIATE_ALL i thm) th;; let ASSUME_TAC = LABEL_TAC "";; (* ------------------------------------------------------------------------- *) (* Manipulation of assumption list. *) (* ------------------------------------------------------------------------- *) let (FIND_ASSUM: thm_tactic -> term -> tactic) = fun ttac t ((asl,w) as g) -> ttac(snd(find (fun (_,th) -> concl th = t) asl)) g;; let (POP_ASSUM: thm_tactic -> tactic) = fun ttac -> function (((_,th)::asl),w) -> ttac th (asl,w) | _ -> failwith "POP_ASSUM: No assumption to pop";; let (ASSUM_LIST: (thm list -> tactic) -> tactic) = fun aslfun (asl,w) -> aslfun (map snd asl) (asl,w);; let (POP_ASSUM_LIST: (thm list -> tactic) -> tactic) = fun asltac (asl,w) -> asltac (map snd asl) ([],w);; let (EVERY_ASSUM: thm_tactic -> tactic) = fun ttac -> ASSUM_LIST (MAP_EVERY ttac);; let (FIRST_ASSUM: thm_tactic -> tactic) = fun ttac (asl,w as g) -> tryfind (fun (_,th) -> ttac th g) asl;; let (RULE_ASSUM_TAC :(thm->thm)->tactic) = fun rule (asl,w) -> (POP_ASSUM_LIST(K ALL_TAC) THEN MAP_EVERY (fun (s,th) -> LABEL_TAC s (rule th)) (rev asl)) (asl,w);; (* ------------------------------------------------------------------------- *) (* Operate on assumption identified by a label. *) (* ------------------------------------------------------------------------- *) let (USE_THEN:string->thm_tactic->tactic) = fun s ttac (asl,w as gl) -> let th = try assoc s asl with Failure _ -> failwith("USE_TAC: didn't find assumption "^s) in ttac th gl;; let (REMOVE_THEN:string->thm_tactic->tactic) = fun s ttac (asl,w) -> let th = try assoc s asl with Failure _ -> failwith("USE_TAC: didn't find assumption "^s) in let asl1,asl2 = chop_list(index s (map fst asl)) asl in let asl' = asl1 @ tl asl2 in ttac th (asl',w);; (* ------------------------------------------------------------------------- *) (* General tools to augment a required set of theorems with assumptions. *) (* Here ASM uses all current hypotheses of the goal, while HYP uses only *) (* those whose labels are given in the string argument. *) (* ------------------------------------------------------------------------- *) let (ASM :(thm list -> tactic)->(thm list -> tactic)) = fun tltac ths (asl,w as g) -> tltac (map snd asl @ ths) g;; let HYP = let ident = function Ident s::rest when isalnum s -> s,rest | _ -> raise Noparse in let parse_using = many ident in let HYP_LIST tac l = rev_itlist (fun s k l -> USE_THEN s (fun th -> k (th::l))) l tac in fun tac s -> let l,rest = (fix "Using pattern" parse_using o lex o explode) s in if rest=[] then HYP_LIST tac l else failwith "Invalid using pattern";; (* ------------------------------------------------------------------------- *) (* Basic tactic to use a theorem equal to the goal. Does *no* matching. *) (* ------------------------------------------------------------------------- *) let (ACCEPT_TAC: thm_tactic) = let propagate_thm th i [] = INSTANTIATE_ALL i th in fun th (asl,w) -> if aconv (concl th) w then null_meta,[],propagate_thm th else failwith "ACCEPT_TAC";; (* ------------------------------------------------------------------------- *) (* Create tactic from a conversion. This allows the conversion to return *) (* |- p rather than |- p = T on a term "p". It also eliminates any goals of *) (* the form "T" automatically. *) (* ------------------------------------------------------------------------- *) let (CONV_TAC: conv -> tactic) = let t_tm = `T` in fun conv ((asl,w) as g) -> let th = conv w in let tm = concl th in if aconv tm w then ACCEPT_TAC th g else let l,r = dest_eq tm in if not(aconv l w) then failwith "CONV_TAC: bad equation" else if r = t_tm then ACCEPT_TAC(EQT_ELIM th) g else let th' = SYM th in null_meta,[asl,r],fun i [th] -> EQ_MP (INSTANTIATE_ALL i th') th;; (* ------------------------------------------------------------------------- *) (* Tactics for equality reasoning. *) (* ------------------------------------------------------------------------- *) let (REFL_TAC: tactic) = fun ((asl,w) as g) -> try ACCEPT_TAC(REFL(rand w)) g with Failure _ -> failwith "REFL_TAC";; let (ABS_TAC: tactic) = fun (asl,w) -> try let l,r = dest_eq w in let lv,lb = dest_abs l and rv,rb = dest_abs r in let avoids = itlist (union o thm_frees o snd) asl (frees w) in let v = mk_primed_var avoids lv in null_meta,[asl,mk_eq(vsubst[v,lv] lb,vsubst[v,rv] rb)], fun i [th] -> let ath = ABS v th in EQ_MP (ALPHA (concl ath) (instantiate i w)) ath with Failure _ -> failwith "ABS_TAC";; let (MK_COMB_TAC: tactic) = fun (asl,gl) -> try let l,r = dest_eq gl in let f,x = dest_comb l and g,y = dest_comb r in null_meta,[asl,mk_eq(f,g); asl,mk_eq(x,y)], fun _ [th1;th2] -> MK_COMB(th1,th2) with Failure _ -> failwith "MK_COMB_TAC";; let (AP_TERM_TAC: tactic) = let tac = MK_COMB_TAC THENL [REFL_TAC; ALL_TAC] in fun gl -> try tac gl with Failure _ -> failwith "AP_TERM_TAC";; let (AP_THM_TAC: tactic) = let tac = MK_COMB_TAC THENL [ALL_TAC; REFL_TAC] in fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; let (BINOP_TAC: tactic) = let tac = MK_COMB_TAC THENL [AP_TERM_TAC; ALL_TAC] in fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; let (SUBST1_TAC: thm_tactic) = fun th -> CONV_TAC(SUBS_CONV [th]);; let SUBST_ALL_TAC rth = SUBST1_TAC rth THEN RULE_ASSUM_TAC (SUBS [rth]);; let BETA_TAC = CONV_TAC(REDEPTH_CONV BETA_CONV);; (* ------------------------------------------------------------------------- *) (* Just use an equation to substitute if possible and uninstantiable. *) (* ------------------------------------------------------------------------- *) let SUBST_VAR_TAC th = try let asm,eq = dest_thm th in let l,r = dest_eq eq in if aconv l r then ALL_TAC else if not (subset (frees eq) (freesl asm)) then fail() else if (is_const l || is_var l) && not(free_in l r) then SUBST_ALL_TAC th else if (is_const r || is_var r) && not(free_in r l) then SUBST_ALL_TAC(SYM th) else fail() with Failure _ -> failwith "SUBST_VAR_TAC";; (* ------------------------------------------------------------------------- *) (* Basic logical tactics. *) (* ------------------------------------------------------------------------- *) let (DISCH_TAC: tactic) = let f_tm = `F` in fun (asl,w) -> try let ant,c = dest_imp w in let th1 = ASSUME ant in null_meta,[("",th1)::asl,c], fun i [th] -> DISCH (instantiate i ant) th with Failure _ -> try let ant = dest_neg w in let th1 = ASSUME ant in null_meta,[("",th1)::asl,f_tm], fun i [th] -> NOT_INTRO(DISCH (instantiate i ant) th) with Failure _ -> failwith "DISCH_TAC";; let (MP_TAC: thm_tactic) = fun thm (asl,w) -> null_meta,[asl,mk_imp(concl thm,w)], fun i [th] -> MP th (INSTANTIATE_ALL i thm);; let (EQ_TAC: tactic) = fun (asl,w) -> try let l,r = dest_eq w in null_meta,[asl, mk_imp(l,r); asl, mk_imp(r,l)], fun _ [th1; th2] -> IMP_ANTISYM_RULE th1 th2 with Failure _ -> failwith "EQ_TAC";; let (UNDISCH_TAC: term -> tactic) = fun tm (asl,w) -> try let sthm,asl' = remove (fun (_,asm) -> aconv (concl asm) tm) asl in let thm = snd sthm in null_meta,[asl',mk_imp(tm,w)], fun i [th] -> MP th (INSTANTIATE_ALL i thm) with Failure _ -> failwith "UNDISCH_TAC";; let (SPEC_TAC: term * term -> tactic) = fun (t,x) (asl,w) -> try null_meta,[asl, mk_forall(x,subst[x,t] w)], fun i [th] -> SPEC (instantiate i t) th with Failure _ -> failwith "SPEC_TAC";; let (X_GEN_TAC: term -> tactic), (X_CHOOSE_TAC: term -> thm_tactic), (EXISTS_TAC: term -> tactic) = let tactic_type_compatibility_check pfx e g = let et = type_of e and gt = type_of g in if et = gt then () else failwith(pfx ^ ": expected type :"^string_of_type et^" but got :"^ string_of_type gt) in let X_GEN_TAC x' = if not(is_var x') then failwith "X_GEN_TAC: not a variable" else fun (asl,w) -> let x,bod = try dest_forall w with Failure _ -> failwith "X_GEN_TAC: Not universally quantified" in let _ = tactic_type_compatibility_check "X_GEN_TAC" x x' in let avoids = itlist (union o thm_frees o snd) asl (frees w) in if mem x' avoids then failwith "X_GEN_TAC: invalid variable" else let afn = CONV_RULE(GEN_ALPHA_CONV x) in null_meta,[asl,vsubst[x',x] bod], fun i [th] -> afn (GEN x' th) and X_CHOOSE_TAC x' xth = let xtm = concl xth in let x,bod = try dest_exists xtm with Failure _ -> failwith "X_CHOOSE_TAC: not existential" in let _ = tactic_type_compatibility_check "X_CHOOSE_TAC" x x' in let pat = vsubst[x',x] bod in let xth' = ASSUME pat in fun (asl,w) -> let avoids = itlist (union o frees o concl o snd) asl (union (frees w) (thm_frees xth)) in if mem x' avoids then failwith "X_CHOOSE_TAC: invalid variable" else null_meta,[("",xth')::asl,w], fun i [th] -> CHOOSE(x',INSTANTIATE_ALL i xth) th and EXISTS_TAC t (asl,w) = let v,bod = try dest_exists w with Failure _ -> failwith "EXISTS_TAC: Goal not existentially quantified" in let _ = tactic_type_compatibility_check "EXISTS_TAC" v t in null_meta,[asl,vsubst[t,v] bod], fun i [th] -> EXISTS (instantiate i w,instantiate i t) th in X_GEN_TAC,X_CHOOSE_TAC,EXISTS_TAC;; let (GEN_TAC: tactic) = fun (asl,w) -> try let x = fst(dest_forall w) in let avoids = itlist (union o thm_frees o snd) asl (frees w) in let x' = mk_primed_var avoids x in X_GEN_TAC x' (asl,w) with Failure _ -> failwith "GEN_TAC";; let (CHOOSE_TAC: thm_tactic) = fun xth -> try let x = fst(dest_exists(concl xth)) in fun (asl,w) -> let avoids = itlist (union o thm_frees o snd) asl (union (frees w) (thm_frees xth)) in let x' = mk_primed_var avoids x in X_CHOOSE_TAC x' xth (asl,w) with Failure _ -> failwith "CHOOSE_TAC";; let (CONJ_TAC: tactic) = fun (asl,w) -> try let l,r = dest_conj w in null_meta,[asl,l; asl,r],fun _ [th1;th2] -> CONJ th1 th2 with Failure _ -> failwith "CONJ_TAC";; let (DISJ1_TAC: tactic) = fun (asl,w) -> try let l,r = dest_disj w in null_meta,[asl,l],fun i [th] -> DISJ1 th (instantiate i r) with Failure _ -> failwith "DISJ1_TAC";; let (DISJ2_TAC: tactic) = fun (asl,w) -> try let l,r = dest_disj w in null_meta,[asl,r],fun i [th] -> DISJ2 (instantiate i l) th with Failure _ -> failwith "DISJ2_TAC";; let (DISJ_CASES_TAC: thm_tactic) = fun dth -> try let dtm = concl dth in let l,r = dest_disj dtm in let thl = ASSUME l and thr = ASSUME r in fun (asl,w) -> null_meta,[("",thl)::asl,w; ("",thr)::asl,w], fun i [th1;th2] -> DISJ_CASES (INSTANTIATE_ALL i dth) th1 th2 with Failure _ -> failwith "DISJ_CASES_TAC";; let (CONTR_TAC: thm_tactic) = let propagate_thm th i [] = INSTANTIATE_ALL i th in fun cth (asl,w) -> try let th = CONTR w cth in null_meta,[],propagate_thm th with Failure _ -> failwith "CONTR_TAC";; let (MATCH_ACCEPT_TAC:thm_tactic) = let propagate_thm th i [] = INSTANTIATE_ALL i th in let rawtac th (asl,w) = try let ith = PART_MATCH I th w in null_meta,[],propagate_thm ith with Failure _ -> failwith "ACCEPT_TAC" in fun th -> REPEAT GEN_TAC THEN rawtac th;; let (MATCH_MP_TAC :thm_tactic) = fun th -> let sth = try let tm = concl th in let avs,bod = strip_forall tm in let ant,con = dest_imp bod in let th1 = SPECL avs (ASSUME tm) in let th2 = UNDISCH th1 in let evs = filter (fun v -> vfree_in v ant && not (vfree_in v con)) avs in let th3 = itlist SIMPLE_CHOOSE evs (DISCH tm th2) in let tm3 = hd(hyp th3) in MP (DISCH tm (GEN_ALL (DISCH tm3 (UNDISCH th3)))) th with Failure _ -> failwith "MATCH_MP_TAC: Bad theorem" in let match_fun = PART_MATCH (snd o dest_imp) sth in fun (asl,w) -> try let xth = match_fun w in let lant = fst(dest_imp(concl xth)) in null_meta,[asl,lant], fun i [th] -> MP (INSTANTIATE_ALL i xth) th with Failure _ -> failwith "MATCH_MP_TAC: No match";; let (TRANS_TAC:thm->term->tactic) = fun th -> let ctm = snd(strip_forall(concl th)) in let cl,cr = dest_conj(lhand ctm) in let x = lhand cl and y = rand cl and z = rand cr in fun tm (asl,w as gl) -> let lop,r = dest_comb w in let op,l = dest_comb lop in let ilist = itlist2 type_match (map type_of [x;y;z])(map type_of [l;tm;r]) [] in let th' = INST_TYPE ilist th in (MATCH_MP_TAC th' THEN EXISTS_TAC tm) gl;; (* ------------------------------------------------------------------------- *) (* Theorem continuations. *) (* ------------------------------------------------------------------------- *) let (CONJUNCTS_THEN2:thm_tactic->thm_tactic->thm_tactic) = fun ttac1 ttac2 cth -> let c1,c2 = dest_conj(concl cth) in fun gl -> let ti,gls,jfn = (ttac1(ASSUME c1) THEN ttac2(ASSUME c2)) gl in let jfn' i ths = let th1,th2 = CONJ_PAIR(INSTANTIATE_ALL i cth) in PROVE_HYP th1 (PROVE_HYP th2 (jfn i ths)) in ti,gls,jfn';; let (CONJUNCTS_THEN: thm_tactical) = W CONJUNCTS_THEN2;; let (DISJ_CASES_THEN2:thm_tactic->thm_tactic->thm_tactic) = fun ttac1 ttac2 cth -> DISJ_CASES_TAC cth THENL [POP_ASSUM ttac1; POP_ASSUM ttac2];; let (DISJ_CASES_THEN: thm_tactical) = W DISJ_CASES_THEN2;; let (DISCH_THEN: thm_tactic -> tactic) = fun ttac -> DISCH_TAC THEN POP_ASSUM ttac;; let (X_CHOOSE_THEN: term -> thm_tactical) = fun x ttac th -> X_CHOOSE_TAC x th THEN POP_ASSUM ttac;; let (CHOOSE_THEN: thm_tactical) = fun ttac th -> CHOOSE_TAC th THEN POP_ASSUM ttac;; (* ------------------------------------------------------------------------- *) (* Various derived tactics and theorem continuations. *) (* ------------------------------------------------------------------------- *) let STRIP_THM_THEN = FIRST_TCL [CONJUNCTS_THEN; DISJ_CASES_THEN; CHOOSE_THEN];; let (ANTE_RES_THEN: thm_tactical) = fun ttac ante -> ASSUM_LIST (fun asl -> let tacs = mapfilter (fun imp -> ttac (MATCH_MP imp ante)) asl in if tacs = [] then failwith "IMP_RES_THEN" else EVERY tacs);; let (IMP_RES_THEN: thm_tactical) = fun ttac imp -> ASSUM_LIST (fun asl -> let tacs = mapfilter (fun ante -> ttac (MATCH_MP imp ante)) asl in if tacs = [] then failwith "IMP_RES_THEN" else EVERY tacs);; let STRIP_ASSUME_TAC = let DISCARD_TAC th = let tm = concl th in fun (asl,w as g) -> if exists (fun a -> aconv tm (concl(snd a))) asl then ALL_TAC g else failwith "DISCARD_TAC: not already present" in (REPEAT_TCL STRIP_THM_THEN) (fun gth -> FIRST [CONTR_TAC gth; ACCEPT_TAC gth; DISCARD_TAC gth; ASSUME_TAC gth]);; let STRUCT_CASES_THEN ttac = REPEAT_TCL STRIP_THM_THEN ttac;; let STRUCT_CASES_TAC = STRUCT_CASES_THEN (fun th -> SUBST1_TAC th ORELSE ASSUME_TAC th);; let STRIP_GOAL_THEN ttac = FIRST [GEN_TAC; CONJ_TAC; DISCH_THEN ttac];; let (STRIP_TAC: tactic) = fun g -> try STRIP_GOAL_THEN STRIP_ASSUME_TAC g with Failure _ -> failwith "STRIP_TAC";; let (UNDISCH_THEN:term->thm_tactic->tactic) = fun tm ttac (asl,w) -> let thp,asl' = remove (fun (_,th) -> aconv (concl th) tm) asl in ttac (snd thp) (asl',w);; let FIRST_X_ASSUM ttac = FIRST_ASSUM(fun th -> UNDISCH_THEN (concl th) ttac);; (* ------------------------------------------------------------------------- *) (* Subgoaling and freezing variables (latter is especially useful now). *) (* ------------------------------------------------------------------------- *) let (SUBGOAL_THEN: term -> thm_tactic -> tactic) = fun wa ttac (asl,w) -> let meta,gl,just = ttac (ASSUME wa) (asl,w) in meta,(asl,wa)::gl,fun i l -> PROVE_HYP (hd l) (just i (tl l));; let SUBGOAL_TAC s tm prfs = match prfs with p::ps -> (warn (ps <> []) "SUBGOAL_TAC: additional subproofs ignored"; SUBGOAL_THEN tm (LABEL_TAC s) THENL [p; ALL_TAC]) | [] -> failwith "SUBGOAL_TAC: no subproof given";; let (FREEZE_THEN :thm_tactical) = fun ttac th (asl,w) -> let meta,gl,just = ttac (ASSUME(concl th)) (asl,w) in meta,gl,fun i l -> PROVE_HYP th (just i l);; (* ------------------------------------------------------------------------- *) (* Metavariable tactics. *) (* ------------------------------------------------------------------------- *) let (X_META_EXISTS_TAC: term -> tactic) = fun t (asl,w) -> try if not (is_var t) then fail() else let v,bod = dest_exists w in ([t],null_inst),[asl,vsubst[t,v] bod], fun i [th] -> EXISTS (instantiate i w,instantiate i t) th with Failure _ -> failwith "X_META_EXISTS_TAC";; let META_EXISTS_TAC ((asl,w) as gl) = let v = fst(dest_exists w) in let avoids = itlist (union o frees o concl o snd) asl (frees w) in let v' = mk_primed_var avoids v in X_META_EXISTS_TAC v' gl;; let (META_SPEC_TAC: term -> thm -> tactic) = fun t thm (asl,w) -> let sth = SPEC t thm in ([t],null_inst),[(("",sth)::asl),w], fun i [th] -> PROVE_HYP (SPEC (instantiate i t) thm) th;; (* ------------------------------------------------------------------------- *) (* If all else fails! *) (* ------------------------------------------------------------------------- *) let (CHEAT_TAC:tactic) = fun (asl,w) -> ACCEPT_TAC(mk_thm([],w)) (asl,w);; (* ------------------------------------------------------------------------- *) (* Intended for time-consuming rules; delays evaluation till it sees goal. *) (* ------------------------------------------------------------------------- *) let RECALL_ACCEPT_TAC r a g = ACCEPT_TAC(time r a) g;; (* ------------------------------------------------------------------------- *) (* Split off antecedent of antecedent as a subgoal. *) (* ------------------------------------------------------------------------- *) let ANTS_TAC = let tm1 = `p /\ (q ==> r)` and tm2 = `p ==> q` in let th1,th2 = CONJ_PAIR(ASSUME tm1) in let th = itlist DISCH [tm1;tm2] (MP th2 (MP(ASSUME tm2) th1)) in MATCH_MP_TAC th THEN CONJ_TAC;; (* ------------------------------------------------------------------------- *) (* A printer for goals etc. *) (* ------------------------------------------------------------------------- *) let (print_goal:goal->unit) = let string_of_int3 n = if n < 10 then " "^string_of_int n else if n < 100 then " "^string_of_int n else string_of_int n in let print_hyp n (s,th) = open_hbox(); Format.print_string(string_of_int3 n); Format.print_string " ["; open_hvbox 0; print_qterm (concl th); close_box(); Format.print_string "]"; (if not (s = "") then (Format.print_string (" ("^s^")")) else ()); close_box(); Format.print_newline() in let rec print_hyps n asl = if asl = [] then () else (print_hyp n (hd asl); print_hyps (n + 1) (tl asl)) in fun (asl,w) -> Format.print_newline(); if asl <> [] then (print_hyps 0 (rev asl); Format.print_newline()) else (); print_qterm w; Format.print_newline();; let (print_goalstack:goalstack->unit) = let print_goalstate k gs = let (_,gl,_) = gs in let n = length gl in let s = if n = 0 then "No subgoals" else (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") ^" ("^(string_of_int n)^" total)" in Format.print_string s; Format.print_newline(); if gl = [] then () else do_list (print_goal o C el gl) (rev(0--(k-1))) in fun l -> if l = [] then Format.print_string "Empty goalstack" else if tl l = [] then let (_,gl,_ as gs) = hd l in print_goalstate 1 gs else let (_,gl,_ as gs) = hd l and (_,gl0,_) = hd(tl l) in let p = length gl - length gl0 in let p' = if p < 1 then 1 else p + 1 in print_goalstate p' gs;; (* ------------------------------------------------------------------------- *) (* Convert a tactic into a refinement on head subgoal in current state. *) (* ------------------------------------------------------------------------- *) let (by:tactic->refinement) = fun tac ((mvs,inst),gls,just) -> if gls = [] then failwith "No goal set" else let g = hd gls and ogls = tl gls in let ((newmvs,newinst),subgls,subjust) = tac g in let n = length subgls in let mvs' = union newmvs mvs and inst' = compose_insts inst newinst and gls' = subgls @ map (inst_goal newinst) ogls in let just' i ths = let i' = compose_insts inst' i in let cths,oths = chop_list n ths in let sths = (subjust i cths) :: oths in just i' sths in (mvs',inst'),gls',just';; (* ------------------------------------------------------------------------- *) (* Rotate the goalstate either way. *) (* ------------------------------------------------------------------------- *) let (rotate:int->refinement) = let rotate_p (meta,sgs,just) = let sgs' = (tl sgs)@[hd sgs] in let just' i ths = let ths' = (last ths)::(butlast ths) in just i ths' in (meta,sgs',just') and rotate_n (meta,sgs,just) = let sgs' = (last sgs)::(butlast sgs) in let just' i ths = let ths' = (tl ths)@[hd ths] in just i ths' in (meta,sgs',just') in fun n -> if n > 0 then funpow n rotate_p else funpow (-n) rotate_n;; (* ------------------------------------------------------------------------- *) (* Perform refinement proof, tactic proof etc. *) (* ------------------------------------------------------------------------- *) let (mk_goalstate:goal->goalstate) = fun (asl,w) -> if type_of w = bool_ty then null_meta,[asl,w], (fun inst [th] -> INSTANTIATE_ALL inst th) else failwith "mk_goalstate: Non-boolean goal";; let (TAC_PROOF : goal * tactic -> thm) = fun (g,tac) -> let gstate = mk_goalstate g in let _,sgs,just = by tac gstate in if sgs = [] then just null_inst [] else failwith "TAC_PROOF: Unsolved goals";; let prove(t,tac) = let th = TAC_PROOF(([],t),tac) in let t' = concl th in if t' = t then th else try EQ_MP (ALPHA t' t) th with Failure _ -> failwith "prove: justification generated wrong theorem";; (* ------------------------------------------------------------------------- *) (* Interactive "subgoal package" stuff. *) (* ------------------------------------------------------------------------- *) let current_goalstack = ref ([] :goalstack);; let (refine:refinement->goalstack) = fun r -> let l = !current_goalstack in if l = [] then failwith "No current goal" else let h = hd l in let res = r h :: l in current_goalstack := res; !current_goalstack;; let flush_goalstack() = let l = !current_goalstack in current_goalstack := [hd l];; let e tac = refine(by(VALID tac));; let r n = refine(rotate n);; let set_goal(asl,w) = current_goalstack := [mk_goalstate(map (fun t -> "",ASSUME t) asl,w)]; !current_goalstack;; let g t = let fvs = sort (<) (map (fst o dest_var) (frees t)) in (if fvs <> [] then let errmsg = end_itlist (fun s t -> s^", "^t) fvs in warn true ("Free variables in goal: "^errmsg) else ()); set_goal([],t);; let b() = let l = !current_goalstack in if length l = 1 then failwith "Can't back up any more" else current_goalstack := tl l; !current_goalstack;; let p() = !current_goalstack;; let top_realgoal() = let (_,((asl,w)::_),_)::_ = !current_goalstack in asl,w;; let top_goal() = let asl,w = top_realgoal() in map (concl o snd) asl,w;; let top_thm() = let (_,[],f)::_ = !current_goalstack in f null_inst [];; (* ------------------------------------------------------------------------- *) (* Install the goal-related printers. *) (* ------------------------------------------------------------------------- *) #install_printer print_goal;; #install_printer print_goalstack;; hol-light/theorems.ml000066400000000000000000000502441303454263000151320ustar00rootroot00000000000000(* ========================================================================= *) (* Additional theorems, mainly about quantifiers, and additional tactics. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* (c) Copyright, Marco Maggesi 2012 *) (* ========================================================================= *) needs "simp.ml";; (* ------------------------------------------------------------------------- *) (* More stuff about equality. *) (* ------------------------------------------------------------------------- *) let EQ_REFL = prove (`!x:A. x = x`, GEN_TAC THEN REFL_TAC);; let REFL_CLAUSE = prove (`!x:A. (x = x) <=> T`, GEN_TAC THEN MATCH_ACCEPT_TAC(EQT_INTRO(SPEC_ALL EQ_REFL)));; let EQ_SYM = prove (`!(x:A) y. (x = y) ==> (y = x)`, REPEAT GEN_TAC THEN DISCH_THEN(ACCEPT_TAC o SYM));; let EQ_SYM_EQ = prove (`!(x:A) y. (x = y) <=> (y = x)`, REPEAT GEN_TAC THEN EQ_TAC THEN MATCH_ACCEPT_TAC EQ_SYM);; let EQ_TRANS = prove (`!(x:A) y z. (x = y) /\ (y = z) ==> (x = z)`, REPEAT STRIP_TAC THEN PURE_ASM_REWRITE_TAC[] THEN REFL_TAC);; (* ------------------------------------------------------------------------- *) (* The following is a common special case of ordered rewriting. *) (* ------------------------------------------------------------------------- *) let AC acsuite = EQT_ELIM o PURE_REWRITE_CONV[acsuite; REFL_CLAUSE];; (* ------------------------------------------------------------------------- *) (* A couple of theorems about beta reduction. *) (* ------------------------------------------------------------------------- *) let BETA_THM = prove (`!(f:A->B) y. (\x. (f:A->B) x) y = f y`, REPEAT GEN_TAC THEN BETA_TAC THEN REFL_TAC);; let ABS_SIMP = prove (`!(t1:A) (t2:B). (\x. t1) t2 = t1`, REPEAT GEN_TAC THEN REWRITE_TAC[BETA_THM; REFL_CLAUSE]);; (* ------------------------------------------------------------------------- *) (* A few "big name" intuitionistic tautologies. *) (* ------------------------------------------------------------------------- *) let CONJ_ASSOC = prove (`!t1 t2 t3. t1 /\ t2 /\ t3 <=> (t1 /\ t2) /\ t3`, ITAUT_TAC);; let CONJ_SYM = prove (`!t1 t2. t1 /\ t2 <=> t2 /\ t1`, ITAUT_TAC);; let CONJ_ACI = prove (`(p /\ q <=> q /\ p) /\ ((p /\ q) /\ r <=> p /\ (q /\ r)) /\ (p /\ (q /\ r) <=> q /\ (p /\ r)) /\ (p /\ p <=> p) /\ (p /\ (p /\ q) <=> p /\ q)`, ITAUT_TAC);; let DISJ_ASSOC = prove (`!t1 t2 t3. t1 \/ t2 \/ t3 <=> (t1 \/ t2) \/ t3`, ITAUT_TAC);; let DISJ_SYM = prove (`!t1 t2. t1 \/ t2 <=> t2 \/ t1`, ITAUT_TAC);; let DISJ_ACI = prove (`(p \/ q <=> q \/ p) /\ ((p \/ q) \/ r <=> p \/ (q \/ r)) /\ (p \/ (q \/ r) <=> q \/ (p \/ r)) /\ (p \/ p <=> p) /\ (p \/ (p \/ q) <=> p \/ q)`, ITAUT_TAC);; let IMP_CONJ = prove (`p /\ q ==> r <=> p ==> q ==> r`, ITAUT_TAC);; let IMP_IMP = GSYM IMP_CONJ;; let IMP_CONJ_ALT = prove (`p /\ q ==> r <=> q ==> p ==> r`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* A couple of "distribution" tautologies are useful. *) (* ------------------------------------------------------------------------- *) let LEFT_OR_DISTRIB = prove (`!p q r. p /\ (q \/ r) <=> p /\ q \/ p /\ r`, ITAUT_TAC);; let RIGHT_OR_DISTRIB = prove (`!p q r. (p \/ q) /\ r <=> p /\ r \/ q /\ r`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Degenerate cases of quantifiers. *) (* ------------------------------------------------------------------------- *) let FORALL_SIMP = prove (`!t. (!x:A. t) = t`, ITAUT_TAC);; let EXISTS_SIMP = prove (`!t. (?x:A. t) = t`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* I also use this a lot (as a prelude to congruence reasoning). *) (* ------------------------------------------------------------------------- *) let EQ_IMP = ITAUT `(a <=> b) ==> a ==> b`;; (* ------------------------------------------------------------------------- *) (* Start building up the basic rewrites; we add a few more later. *) (* ------------------------------------------------------------------------- *) let EQ_CLAUSES = prove (`!t. ((T <=> t) <=> t) /\ ((t <=> T) <=> t) /\ ((F <=> t) <=> ~t) /\ ((t <=> F) <=> ~t)`, ITAUT_TAC);; let NOT_CLAUSES_WEAK = prove (`(~T <=> F) /\ (~F <=> T)`, ITAUT_TAC);; let AND_CLAUSES = prove (`!t. (T /\ t <=> t) /\ (t /\ T <=> t) /\ (F /\ t <=> F) /\ (t /\ F <=> F) /\ (t /\ t <=> t)`, ITAUT_TAC);; let OR_CLAUSES = prove (`!t. (T \/ t <=> T) /\ (t \/ T <=> T) /\ (F \/ t <=> t) /\ (t \/ F <=> t) /\ (t \/ t <=> t)`, ITAUT_TAC);; let IMP_CLAUSES = prove (`!t. (T ==> t <=> t) /\ (t ==> T <=> T) /\ (F ==> t <=> T) /\ (t ==> t <=> T) /\ (t ==> F <=> ~t)`, ITAUT_TAC);; extend_basic_rewrites [REFL_CLAUSE; EQ_CLAUSES; NOT_CLAUSES_WEAK; AND_CLAUSES; OR_CLAUSES; IMP_CLAUSES; FORALL_SIMP; EXISTS_SIMP; BETA_THM; let IMP_EQ_CLAUSE = prove (`((x = x) ==> p) <=> p`, REWRITE_TAC[EQT_INTRO(SPEC_ALL EQ_REFL); IMP_CLAUSES]) in IMP_EQ_CLAUSE];; extend_basic_congs [ITAUT `(p <=> p') ==> (p' ==> (q <=> q')) ==> (p ==> q <=> p' ==> q')`];; (* ------------------------------------------------------------------------- *) (* Rewrite rule for unique existence. *) (* ------------------------------------------------------------------------- *) let EXISTS_UNIQUE_THM = prove (`!P. (?!x:A. P x) <=> (?x. P x) /\ (!x x'. P x /\ P x' ==> (x = x'))`, GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_DEF]);; (* ------------------------------------------------------------------------- *) (* Trivial instances of existence. *) (* ------------------------------------------------------------------------- *) let EXISTS_REFL = prove (`!a:A. ?x. x = a`, GEN_TAC THEN EXISTS_TAC `a:A` THEN REFL_TAC);; let EXISTS_UNIQUE_REFL = prove (`!a:A. ?!x. x = a`, GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN REPEAT(EQ_TAC ORELSE STRIP_TAC) THENL [EXISTS_TAC `a:A`; ASM_REWRITE_TAC[]] THEN REFL_TAC);; (* ------------------------------------------------------------------------- *) (* Unwinding. *) (* ------------------------------------------------------------------------- *) let UNWIND_THM1 = prove (`!P (a:A). (?x. a = x /\ P x) <=> P a`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 SUBST1_TAC ACCEPT_TAC)); DISCH_TAC THEN EXISTS_TAC `a:A` THEN CONJ_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN REFL_TAC]);; let UNWIND_THM2 = prove (`!P (a:A). (?x. x = a /\ P x) <=> P a`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN MATCH_ACCEPT_TAC UNWIND_THM1);; let FORALL_UNWIND_THM2 = prove (`!P (a:A). (!x. x = a ==> P x) <=> P a`, REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[]; DISCH_TAC THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]);; let FORALL_UNWIND_THM1 = prove (`!P a. (!x. a = x ==> P x) <=> P a`, REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN MATCH_ACCEPT_TAC FORALL_UNWIND_THM2);; (* ------------------------------------------------------------------------- *) (* Permuting quantifiers. *) (* ------------------------------------------------------------------------- *) let SWAP_FORALL_THM = prove (`!P:A->B->bool. (!x y. P x y) <=> (!y x. P x y)`, ITAUT_TAC);; let SWAP_EXISTS_THM = prove (`!P:A->B->bool. (?x y. P x y) <=> (?y x. P x y)`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Universal quantifier and conjunction. *) (* ------------------------------------------------------------------------- *) let FORALL_AND_THM = prove (`!P Q. (!x:A. P x /\ Q x) <=> (!x. P x) /\ (!x. Q x)`, ITAUT_TAC);; let AND_FORALL_THM = prove (`!P Q. (!x. P x) /\ (!x. Q x) <=> (!x:A. P x /\ Q x)`, ITAUT_TAC);; let LEFT_AND_FORALL_THM = prove (`!P Q. (!x:A. P x) /\ Q <=> (!x:A. P x /\ Q)`, ITAUT_TAC);; let RIGHT_AND_FORALL_THM = prove (`!P Q. P /\ (!x:A. Q x) <=> (!x. P /\ Q x)`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Existential quantifier and disjunction. *) (* ------------------------------------------------------------------------- *) let EXISTS_OR_THM = prove (`!P Q. (?x:A. P x \/ Q x) <=> (?x. P x) \/ (?x. Q x)`, ITAUT_TAC);; let OR_EXISTS_THM = prove (`!P Q. (?x. P x) \/ (?x. Q x) <=> (?x:A. P x \/ Q x)`, ITAUT_TAC);; let LEFT_OR_EXISTS_THM = prove (`!P Q. (?x. P x) \/ Q <=> (?x:A. P x \/ Q)`, ITAUT_TAC);; let RIGHT_OR_EXISTS_THM = prove (`!P Q. P \/ (?x. Q x) <=> (?x:A. P \/ Q x)`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Existential quantifier and conjunction. *) (* ------------------------------------------------------------------------- *) let LEFT_EXISTS_AND_THM = prove (`!P Q. (?x:A. P x /\ Q) <=> (?x:A. P x) /\ Q`, ITAUT_TAC);; let RIGHT_EXISTS_AND_THM = prove (`!P Q. (?x:A. P /\ Q x) <=> P /\ (?x:A. Q x)`, ITAUT_TAC);; let TRIV_EXISTS_AND_THM = prove (`!P Q. (?x:A. P /\ Q) <=> (?x:A. P) /\ (?x:A. Q)`, ITAUT_TAC);; let LEFT_AND_EXISTS_THM = prove (`!P Q. (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)`, ITAUT_TAC);; let RIGHT_AND_EXISTS_THM = prove (`!P Q. P /\ (?x:A. Q x) <=> (?x:A. P /\ Q x)`, ITAUT_TAC);; let TRIV_AND_EXISTS_THM = prove (`!P Q. (?x:A. P) /\ (?x:A. Q) <=> (?x:A. P /\ Q)`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Only trivial instances of universal quantifier and disjunction. *) (* ------------------------------------------------------------------------- *) let TRIV_FORALL_OR_THM = prove (`!P Q. (!x:A. P \/ Q) <=> (!x:A. P) \/ (!x:A. Q)`, ITAUT_TAC);; let TRIV_OR_FORALL_THM = prove (`!P Q. (!x:A. P) \/ (!x:A. Q) <=> (!x:A. P \/ Q)`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Implication and quantifiers. *) (* ------------------------------------------------------------------------- *) let RIGHT_IMP_FORALL_THM = prove (`!P Q. (P ==> !x:A. Q x) <=> (!x. P ==> Q x)`, ITAUT_TAC);; let RIGHT_FORALL_IMP_THM = prove (`!P Q. (!x. P ==> Q x) <=> (P ==> !x:A. Q x)`, ITAUT_TAC);; let LEFT_IMP_EXISTS_THM = prove (`!P Q. ((?x:A. P x) ==> Q) <=> (!x. P x ==> Q)`, ITAUT_TAC);; let LEFT_FORALL_IMP_THM = prove (`!P Q. (!x. P x ==> Q) <=> ((?x:A. P x) ==> Q)`, ITAUT_TAC);; let TRIV_FORALL_IMP_THM = prove (`!P Q. (!x:A. P ==> Q) <=> ((?x:A. P) ==> (!x:A. Q))`, ITAUT_TAC);; let TRIV_EXISTS_IMP_THM = prove (`!P Q. (?x:A. P ==> Q) <=> ((!x:A. P) ==> (?x:A. Q))`, ITAUT_TAC);; (* ------------------------------------------------------------------------- *) (* Monotonicity theorems for logical operations w.r.t. implication. *) (* ------------------------------------------------------------------------- *) let MONO_AND = ITAUT `(A ==> B) /\ (C ==> D) ==> (A /\ C ==> B /\ D)`;; let MONO_OR = ITAUT `(A ==> B) /\ (C ==> D) ==> (A \/ C ==> B \/ D)`;; let MONO_IMP = ITAUT `(B ==> A) /\ (C ==> D) ==> ((A ==> C) ==> (B ==> D))`;; let MONO_NOT = ITAUT `(B ==> A) ==> (~A ==> ~B)`;; let MONO_FORALL = prove (`(!x:A. P x ==> Q x) ==> ((!x. P x) ==> (!x. Q x))`, REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; let MONO_EXISTS = prove (`(!x:A. P x ==> Q x) ==> ((?x. P x) ==> (?x. Q x))`, DISCH_TAC THEN DISCH_THEN(X_CHOOSE_TAC `x:A`) THEN EXISTS_TAC `x:A` THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* A generic "without loss of generality" lemma for symmetry. *) (* ------------------------------------------------------------------------- *) let WLOG_RELATION = prove (`!R P. (!x y. P x y ==> P y x) /\ (!x y. R x y \/ R y x) /\ (!x y. R x y ==> P x y) ==> !x y. P x y`, REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN STRIP_TAC THEN ASM_SIMP_TAC[]);; (* ------------------------------------------------------------------------- *) (* Alternative versions of unique existence. *) (* ------------------------------------------------------------------------- *) let EXISTS_UNIQUE_ALT = prove (`!P:A->bool. (?!x. P x) <=> (?x. !y. P y <=> (x = y))`, GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN EQ_TAC THENL [DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `x:A`) ASSUME_TAC) THEN EXISTS_TAC `x:A` THEN GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_ACCEPT_TAC]; DISCH_THEN(X_CHOOSE_TAC `x:A`) THEN ASM_REWRITE_TAC[GSYM EXISTS_REFL] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN REFL_TAC]);; let EXISTS_UNIQUE = prove (`!P:A->bool. (?!x. P x) <=> (?x. P x /\ !y. P y ==> (y = x))`, GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_ALT] THEN AP_TERM_TAC THEN ABS_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [ITAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN REWRITE_TAC[FORALL_AND_THM] THEN SIMP_TAC[] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN REWRITE_TAC[CONJ_ACI]);; (* ------------------------------------------------------------------------- *) (* DESTRUCT_TAC, FIX_TAC, INTRO_TAC and HYP_TAC, giving more brief and *) (* elegant ways of naming introduced variables and assumptions (from Marco *) (* Maggesi). *) (* ------------------------------------------------------------------------- *) let DESTRUCT_TAC,FIX_TAC,INTRO_TAC,HYP_TAC = (* ---------------------------------------------------------------------- *) (* Like GEN_TAC but fails instead of generating a primed variant when the *) (* variable occurs free in the context. *) (* ---------------------------------------------------------------------- *) let (PURE_GEN_TAC: tactic) = fun (asl,w) -> try let x = fst(dest_forall w) in let avoids = itlist (union o thm_frees o snd) asl (frees w) in if mem x avoids then fail() else X_GEN_TAC x (asl,w) with Failure _ -> failwith "PURE_GEN_TAC" (* ---------------------------------------------------------------------- *) (* Like X_GEN_TAC but needs only the name of the variable, not the type. *) (* ---------------------------------------------------------------------- *) and (NAME_GEN_TAC: string -> tactic) = fun s gl -> let ty = (snd o dest_var o fst o dest_forall o snd) gl in X_GEN_TAC (mk_var(s,ty)) gl and OBTAIN_THEN v ttac th = let ty = (snd o dest_var o fst o dest_exists o concl) th in X_CHOOSE_THEN (mk_var(v,ty)) ttac th and CONJ_LIST_TAC = end_itlist (fun t1 t2 -> CONJ_TAC THENL [t1; t2]) and NUM_DISJ_TAC n = if n <= 0 then failwith "NUM_DISJ_TAC" else REPLICATE_TAC (n-1) DISJ2_TAC THEN REPEAT DISJ1_TAC and NAME_PULL_FORALL_CONV = let SWAP_FORALL_CONV = REWR_CONV SWAP_FORALL_THM and AND_FORALL_CONV = GEN_REWRITE_CONV I [AND_FORALL_THM] and RIGHT_IMP_FORALL_CONV = GEN_REWRITE_CONV I [RIGHT_IMP_FORALL_THM] in fun s -> let rec PULL_FORALL tm = if is_forall tm then if name_of(fst(dest_forall tm)) = s then REFL tm else (BINDER_CONV PULL_FORALL THENC SWAP_FORALL_CONV) tm else if is_imp tm then (RAND_CONV PULL_FORALL THENC RIGHT_IMP_FORALL_CONV) tm else if is_conj tm then (BINOP_CONV PULL_FORALL THENC AND_FORALL_CONV) tm else fail () in PULL_FORALL in let pa_ident p = function Ident s::rest when p s -> s,rest | _ -> raise Noparse in let pa_label = pa_ident isalnum and pa_var = pa_ident isalpha in let fix_tac = let fix_var v = CONV_TAC (NAME_PULL_FORALL_CONV v) THEN PURE_GEN_TAC and fix_rename = function u,[v] -> CONV_TAC (NAME_PULL_FORALL_CONV v) THEN NAME_GEN_TAC u | u,_ -> NAME_GEN_TAC u in let vars = let pa_rename = let oname = possibly (a(Ident "/") ++ pa_var >> snd) in (a(Resword "[") ++ pa_var >> snd) ++ oname ++ a(Resword "]") >> fst in many ((pa_rename >> fix_rename) ||| (pa_var >> fix_var)) >> EVERY and star = possibly (a (Ident "*") >> K ()) in vars ++ star >> function tac,[] -> tac | tac,_ -> tac THEN REPEAT GEN_TAC and destruct_tac = let OBTAINL_THEN : string list -> thm_tactical = EVERY_TCL o map OBTAIN_THEN in let rec destruct inp = disj inp and disj inp = let DISJ_CASES_LIST = end_itlist DISJ_CASES_THEN2 in (listof conj (a(Resword "|")) "Disjunction" >> DISJ_CASES_LIST) inp and conj inp = (atleast 1 atom >> end_itlist CONJUNCTS_THEN2) inp and obtain inp = let obtain_prfx = let var_list = atleast 1 pa_var in (a(Ident "@") ++ var_list >> snd) ++ a(Resword ".") >> fst in (obtain_prfx ++ destruct >> uncurry OBTAINL_THEN) inp and atom inp = let label = function Ident "_"::res -> K ALL_TAC,res | Ident "+"::res -> MP_TAC,res | Ident s::res when isalnum s -> LABEL_TAC s,res | _ -> raise Noparse and paren = (a(Resword "(") ++ destruct >> snd) ++ a(Resword ")") >> fst in (obtain ||| label ||| paren) inp in destruct in let intro_tac = let number = function Ident s::rest -> (try check ((<=) 1) (int_of_string s), rest with Failure _ -> raise Noparse) | _ -> raise Noparse and pa_fix = a(Ident "!") ++ fix_tac >> snd and pa_dest = destruct_tac >> DISCH_THEN in let pa_prefix = elistof (pa_fix ||| pa_dest) (a(Resword ";")) "Prefix intro pattern" in let rec pa_intro toks = (pa_prefix ++ possibly pa_postfix >> uncurry (@) >> EVERY) toks and pa_postfix toks = (pa_conj ||| pa_disj) toks and pa_conj toks = let conjs = listof pa_intro (a(Ident "&")) "Intro pattern" >> CONJ_LIST_TAC in ((a(Resword "{") ++ conjs >> snd) ++ a(Resword "}") >> fst) toks and pa_disj toks = let disj = number >> NUM_DISJ_TAC in ((a(Ident "#") ++ disj >> snd) ++ pa_intro >> uncurry (THEN)) toks in pa_intro in let hyp_tac rule = let pa_action = function Resword ":" :: rest -> REMOVE_THEN,rest | Resword "->" :: rest -> USE_THEN,rest | _ -> raise Noparse in pa_label ++ possibly (pa_action ++ destruct_tac) >> (function | lbl,[action,tac] -> action lbl (tac o rule) | lbl,_ -> REMOVE_THEN lbl (LABEL_TAC lbl o rule)) in let DESTRUCT_TAC s = let tac,rest = (fix "Destruct pattern" destruct_tac o lex o explode) s in if rest=[] then tac else failwith "Garbage after destruct pattern" and INTRO_TAC s = let tac,rest = (fix "Introduction pattern" intro_tac o lex o explode) s in if rest=[] then tac else failwith "Garbage after intro pattern" and FIX_TAC s = let tac,rest = (fix_tac o lex o explode) s in if rest=[] then tac else failwith "FIX_TAC: invalid pattern" and HYP_TAC s rule = let tac,rest = (hyp_tac rule o lex o explode) s in if rest=[] then tac else failwith "HYP_TAC: invalid pattern" in DESTRUCT_TAC,FIX_TAC,INTRO_TAC,HYP_TAC;; let CLAIM_TAC s tm = SUBGOAL_THEN tm (DESTRUCT_TAC s);; hol-light/trivia.ml000066400000000000000000000062351303454263000146030ustar00rootroot00000000000000(* ========================================================================= *) (* Trivial odds and ends. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "class.ml";; (* ------------------------------------------------------------------------- *) (* Combinators. We don't bother with S and K, which seem of little use. *) (* ------------------------------------------------------------------------- *) parse_as_infix ("o",(26,"right"));; let o_DEF = new_definition `(o) (f:B->C) g = \x:A. f(g(x))`;; let I_DEF = new_definition `I = \x:A. x`;; let o_THM = prove (`!f:B->C. !g:A->B. !x:A. (f o g) x = f(g(x))`, PURE_REWRITE_TAC [o_DEF] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; let o_ASSOC = prove (`!f:C->D. !g:B->C. !h:A->B. f o (g o h) = (f o g) o h`, REPEAT GEN_TAC THEN REWRITE_TAC [o_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REFL_TAC);; let I_THM = prove (`!x:A. I x = x`, REWRITE_TAC [I_DEF]);; let I_O_ID = prove (`!f:A->B. (I o f = f) /\ (f o I = f)`, REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_DEF; I_THM]);; (* ------------------------------------------------------------------------- *) (* The theory "1" (a 1-element type). *) (* ------------------------------------------------------------------------- *) let EXISTS_ONE_REP = prove (`?b:bool. b`, EXISTS_TAC `T` THEN BETA_TAC THEN ACCEPT_TAC TRUTH);; let one_tydef = new_type_definition "1" ("one_ABS","one_REP") EXISTS_ONE_REP;; let one_DEF = new_definition `one = @x:1. T`;; let one = prove (`!v:1. v = one`, MP_TAC(GEN_ALL (SPEC `one_REP a` (CONJUNCT2 one_tydef))) THEN REWRITE_TAC[CONJUNCT1 one_tydef] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM (CONJUNCT1 one_tydef)] THEN ASM_REWRITE_TAC[]);; let one_axiom = prove (`!f g. f = (g:A->1)`, REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN ONCE_REWRITE_TAC[one] THEN REFL_TAC);; let one_INDUCT = prove (`!P. P one ==> !x. P x`, ONCE_REWRITE_TAC[one] THEN REWRITE_TAC[]);; let one_RECURSION = prove (`!e:A. ?fn. fn one = e`, GEN_TAC THEN EXISTS_TAC `\x:1. e:A` THEN BETA_TAC THEN REFL_TAC);; let one_Axiom = prove (`!e:A. ?!fn. fn one = e`, GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM; one_RECURSION] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN ONCE_REWRITE_TAC [one] THEN ASM_REWRITE_TAC[]);; (* ------------------------------------------------------------------------- *) (* Add the type "1" to the inductive type store. *) (* ------------------------------------------------------------------------- *) inductive_type_store := ("1",(1,one_INDUCT,one_RECURSION))::(!inductive_type_store);; hol-light/update_database.ml000066400000000000000000000215031303454263000164060ustar00rootroot00000000000000(* ========================================================================= *) (* Create search database from OCaml / modify search database dynamically. *) (* *) (* This file assigns to "theorems", which is a list of name-theorem pairs. *) (* The core system already has such a database set up. Use this file if you *) (* want to update the database beyond the core, so you can search it. *) (* *) (* The trickery to get at the OCaml environment is due to Roland Zumkeller. *) (* It works by copying some internal data structures and casting into the *) (* copy using Obj.magic. *) (* ========================================================================= *) (* Execute any OCaml expression given as a string. *) let exec = ignore o Toploop.execute_phrase false Format.std_formatter o !Toploop.parse_toplevel_phrase o Lexing.from_string;; type dummy;; (* ------------------------------------------------------------------------- *) (* Basic data structures copied from OCaml. May be version-dependent. *) (* ------------------------------------------------------------------------- *) type label = int;; (*** from ./typing/ident.ml: ***) type ident_t = { stamp: int; name: string; mutable flags: int };; type 'a tbl = Empty | Node of 'a tbl * 'a data * 'a tbl * int and 'a data = { ident: ident_t; data: 'a; previous: 'a data option };; (*** from ./typing/path.ml: ***) type path_t = Pident of ident_t | Pdot of path_t * string * int | Papply of path_t * path_t;; (*** from typing/types.ml: ***) exec ( "type type_expr = { mutable desc: type_desc; mutable level: int; mutable id: int } and type_desc = " ^ (if String.sub Sys.ocaml_version 0 1 = "4" then "Tvar of string option\n" else "Tvar\n") ^ " | Tarrow of label * type_expr * type_expr * commutable | Ttuple of type_expr list | Tconstr of path_t * type_expr list * abbrev_memo ref | Tobject of type_expr * (path_t * type_expr list) option ref | Tfield of string * field_kind * type_expr * type_expr | Tnil | Tlink of type_expr | Tsubst of type_expr | Tvariant of row_desc | Tunivar | Tpoly of type_expr * type_expr list and row_desc = { row_fields: (label * row_field) list; row_more: type_expr; row_bound: type_expr list; row_closed: bool; row_fixed: bool; row_name: (path_t * type_expr list) option } and row_field = Rpresent of type_expr option | Reither of bool * type_expr list * bool * row_field option ref | Rabsent and abbrev_memo = Mnil | Mcons of path_t * type_expr * type_expr * abbrev_memo | Mlink of abbrev_memo ref and field_kind = Fvar of field_kind option ref | Fpresent | Fabsent and commutable = Cok | Cunknown | Clink of commutable ref;; ");; type value_description = { val_type: type_expr; val_kind: dummy };; type module_type = Tmty_ident of path_t | Tmty_signature of signature | Tmty_functor of ident_t * module_type * module_type and signature = signature_item list and signature_item = Tsig_value of ident_t * value_description | Tsig_type of ident_t * dummy * dummy | Tsig_exception of ident_t * dummy | Tsig_module of ident_t * module_type * dummy | Tsig_modtype of ident_t * dummy | Tsig_class of ident_t * dummy * dummy | Tsig_cltype of ident_t * dummy * dummy;; (*** from ./typing/env.ml: ***) exec ( "type env_t = {\n" ^ (if String.sub Sys.ocaml_version 0 1 = "4" then "values: ((path_t * value_description) * bool ref) tbl;\n" else "values: (path_t * value_description) tbl;\n") ^ (if (let v = String.sub Sys.ocaml_version 0 4 in v = "3.09" || v = "3.10") then "" else "annotations: dummy;\n") ^ " constrs: dummy; labels: dummy;\n" ^ (if String.sub Sys.ocaml_version 0 1 = "4" then "constrs_by_path: dummy;\n" else "") ^ " types: dummy;\n" ^ (if String.sub Sys.ocaml_version 0 1 = "4" then "modules: ((path_t * module_type) * bool ref) tbl;\n" else "modules: (path_t * module_type) tbl;\n") ^ " modtypes: dummy; components: dummy; classes: dummy; cltypes: dummy; summary: dummy;\n" ^ (if String.sub Sys.ocaml_version 0 1 = "4" then "local_constraints: dummy; gadt_instances: dummy; in_signature: dummy; };;\n" else "};;\n"));; (* ------------------------------------------------------------------------- *) (* End of basic data structures copied from OCaml. *) (* ------------------------------------------------------------------------- *) (* Iterate over the entries of a table. *) let rec iterTbl (f : ident_t -> 'a -> unit) = function | Empty -> () | Node (t1,d,t2,_) -> f d.ident d.data; iterTbl f t1; iterTbl f t2;; (* If the given type is simple return its name, otherwise None. *) let rec get_simple_type = function | Tlink { desc = Tconstr (Pident p,[],_) } -> Some p.name | Tlink { desc = d } -> get_simple_type d | _ -> None;; (* Evaluate any OCaml expression given as a string. *) let eval n = exec ("let buf__ = ( " ^ n ^ " );;"); Obj.magic (Toploop.getvalue "buf__");; (* Register all theorems added since the last update. *) exec ( "let update_database = let lastStamp = ref 0 and currentStamp = ref 0 and thms = Hashtbl.create 5000 in let ifNew f i x = if i.stamp > !lastStamp then ((if i.stamp > !currentStamp then currentStamp := i.stamp); f i x) in let rec regVal pfx = ifNew (fun i vd -> let n = pfx ^ i.name in if n <> \"buf__\" then (if get_simple_type vd.val_type.desc = Some \"thm\" then Hashtbl.replace thms n (eval n) else Hashtbl.remove thms n)) and regMod pfx = ifNew (fun i mt -> match mt with | Tmty_signature sg -> let pfx' = pfx ^ i.name ^ \".\" in List.iter (function | Tsig_value (i',vd) -> regVal pfx' i' vd | Tsig_module (i',mt',_) -> regMod pfx' i' mt' | _ -> ()) sg | _ -> ()) in fun () -> let env = Obj.magic !Toploop.toplevel_env in " ^ (if String.sub Sys.ocaml_version 0 1 = "4" then "iterTbl (fun i ((_,vd),_) -> regVal \"\" i vd) env.values; iterTbl (fun i ((_,mt),_) -> regMod \"\" i mt) env.modules; " else "iterTbl (fun i (_,vd) -> regVal \"\" i vd) env.values; iterTbl (fun i (_,mt) -> regMod \"\" i mt) env.modules; ") ^ " lastStamp := !currentStamp; theorems := Hashtbl.fold (fun s t l -> (s,t)::l) thms [];; ");; (* ------------------------------------------------------------------------- *) (* Put an assignment of a theorem database in the named file. *) (* ------------------------------------------------------------------------- *) let make_database_assignment filename = update_database(); (let allnames = uniq(sort (<) (map fst (!theorems))) in let names = subtract allnames ["it"] in let entries = map (fun n -> "\""^n^"\","^n) names in let text = "needs \"help.ml\";;\n\n"^ "theorems :=\n[\n"^ end_itlist (fun a b -> a^";\n"^b) entries^"\n];;\n" in file_of_string filename text);; (* ------------------------------------------------------------------------- *) (* Search (automatically updates) *) (* ------------------------------------------------------------------------- *) let search = let rec immediatesublist l1 l2 = match (l1,l2) with [],_ -> true | _,[] -> false | (h1::t1,h2::t2) -> h1 = h2 && immediatesublist t1 t2 in let rec sublist l1 l2 = match (l1,l2) with [],_ -> true | _,[] -> false | (h1::t1,h2::t2) -> immediatesublist l1 l2 || sublist l1 t2 in let exists_subterm_satisfying p (n,th) = can (find_term p) (concl th) and name_contains s (n,th) = sublist (explode s) (explode n) in let rec filterpred tm = match tm with Comb(Var("",_),t) -> not o filterpred t | Comb(Var("",_),Var(pat,_)) -> name_contains pat | Comb(Var("",_),pat) -> exists_subterm_satisfying (aconv pat) | pat -> exists_subterm_satisfying (can (term_match [] pat)) in fun pats -> update_database(); let triv,nontriv = partition is_var pats in (if triv <> [] then warn true ("Ignoring plain variables in search: "^ end_itlist (fun s t -> s^", "^t) (map (fst o dest_var) triv)) else ()); (if nontriv = [] && triv <> [] then [] else sort (increasing fst) (itlist (filter o filterpred) pats (!theorems)));; (* ------------------------------------------------------------------------- *) (* Update to bring things back to current state. *) (* ------------------------------------------------------------------------- *) update_database();; hol-light/wf.ml000066400000000000000000000443441303454263000137240ustar00rootroot00000000000000(* ========================================================================= *) (* Theory of wellfounded relations. *) (* *) (* John Harrison, University of Cambridge Computer Laboratory *) (* *) (* (c) Copyright, University of Cambridge 1998 *) (* (c) Copyright, John Harrison 1998-2007 *) (* ========================================================================= *) needs "arith.ml";; (* ------------------------------------------------------------------------- *) (* Definition of wellfoundedness for arbitrary (infix) relation << *) (* ------------------------------------------------------------------------- *) parse_as_infix("<<",(12,"right"));; let WF = new_definition `WF(<<) <=> !P:A->bool. (?x. P(x)) ==> (?x. P(x) /\ !y. y << x ==> ~P(y))`;; (* ------------------------------------------------------------------------- *) (* Strengthen it to equality. *) (* ------------------------------------------------------------------------- *) let WF_EQ = prove (`WF(<<) <=> !P:A->bool. (?x. P(x)) <=> (?x. P(x) /\ !y. y << x ==> ~P(y))`, REWRITE_TAC[WF] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Equivalence of wellfounded induction. *) (* ------------------------------------------------------------------------- *) let WF_IND = prove (`WF(<<) <=> !P:A->bool. (!x. (!y. y << x ==> P(y)) ==> P(x)) ==> !x. P(x)`, REWRITE_TAC[WF] THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM(MP_TAC o SPEC `\x:A. ~P(x)`) THEN REWRITE_TAC[] THEN MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Equivalence of the "infinite descending chains" version. *) (* ------------------------------------------------------------------------- *) let WF_DCHAIN = prove (`WF(<<) <=> ~(?s:num->A. !n. s(SUC n) << s(n))`, REWRITE_TAC[WF; TAUT `(a <=> ~b) <=> (~a <=> b)`; NOT_FORALL_THM] THEN EQ_TAC THEN DISCH_THEN CHOOSE_TAC THENL [POP_ASSUM(MP_TAC o REWRITE_RULE[NOT_IMP]) THEN DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:A`) ASSUME_TAC) THEN SUBGOAL_THEN `!x:A. ?y. P(x) ==> P(y) /\ y << x` MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN DISCH_THEN(X_CHOOSE_THEN `f:A->A` STRIP_ASSUME_TAC) THEN CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION `(s(0) = a:A) /\ (!n. s(SUC n) = f(s n))`) THEN EXISTS_TAC `s:num->A` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!n. P(s n) /\ s(SUC n):A << s(n)` (fun th -> ASM_MESON_TAC[th]) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; EXISTS_TAC `\y:A. ?n:num. y = s(n)` THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Equivalent to just *uniqueness* part of recursion. *) (* ------------------------------------------------------------------------- *) let WF_UREC = prove (`WF(<<) ==> !H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> !(f:A->B) g. (!x. f x = H f x) /\ (!x. g x = H g x) ==> (f = g)`, REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[]);; let WF_UREC_WF = prove (`(!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> !(f:A->bool) g. (!x. f x = H f x) /\ (!x. g x = H g x) ==> (f = g)) ==> WF(<<)`, REWRITE_TAC[WF_IND] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\f x. P(x:A) \/ !z:A. z << x ==> f(z)`) THEN REWRITE_TAC[] THEN W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) THENL [MESON_TAC[]; DISCH_THEN(MP_TAC o SPECL [`P:A->bool`; `\x:A. T`]) THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Stronger form of recursion with "inductive invariant" (Krstic/Matthews). *) (* ------------------------------------------------------------------------- *) let WF_REC_INVARIANT = prove (`WF(<<) ==> !H S. (!f g x. (!z. z << x ==> (f z = g z) /\ S z (f z)) ==> (H f x = H g x) /\ S x (H f x)) ==> ?f:A->B. !x. (f x = H f x)`, let lemma = prove_inductive_relations_exist `!f:A->B x. (!z. z << x ==> R z (f z)) ==> R x (H f x)` in REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN X_CHOOSE_THEN `R:A->B->bool` STRIP_ASSUME_TAC lemma THEN SUBGOAL_THEN `!x:A. ?!y:B. R x y` (fun th -> ASM_MESON_TAC[th]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC BINDER_CONV [th]) THEN SUBGOAL_THEN `!x:A y:B. R x y ==> S x y` MP_TAC THEN ASM_MESON_TAC[]);; (* ------------------------------------------------------------------------- *) (* Equivalent to just *existence* part of recursion. *) (* ------------------------------------------------------------------------- *) let WF_REC = prove (`WF(<<) ==> !H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> ?f:A->B. !x. f x = H f x`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP WF_REC_INVARIANT) THEN EXISTS_TAC `\x:A y:B. T` THEN ASM_REWRITE_TAC[]);; let WF_REC_WF = prove (`(!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> ?f:A->num. !x. f x = H f x) ==> WF(<<)`, DISCH_TAC THEN REWRITE_TAC[WF_DCHAIN] THEN DISCH_THEN(X_CHOOSE_TAC `x:num->A`) THEN SUBGOAL_THEN `!n. (x:num->A)(@m. x(m) << x(n)) << x(n)` ASSUME_TAC THENL [CONV_TAC(BINDER_CONV SELECT_CONV) THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o SPEC `\f:A->num. \y:A. if ?p:num. y = x(p) then SUC(f(x(@m. x(m) << y))) else 0`) THEN REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `f:A->num` MP_TAC) THEN DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(x:num->A) n`) THEN SUBGOAL_THEN `!n. ?p. (x:num->A) n = x p` (fun th -> REWRITE_TAC[th]) THENL [MESON_TAC[]; DISCH_TAC] THEN SUBGOAL_THEN `!n:num. ?k. f(x(k):A) < f(x(n))` ASSUME_TAC THENL [GEN_TAC THEN EXISTS_TAC `@m:num. x(m):A << x(n)` THEN FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN REWRITE_TAC[LT]; MP_TAC(SPEC `\n:num. ?i:num. n = f(x(i):A)` num_WOP) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Combine the two versions of the recursion theorem. *) (* ------------------------------------------------------------------------- *) let WF_EREC = prove (`WF(<<) ==> !H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) ==> ?!f:A->B. !x. f x = H f x`, MESON_TAC[WF_REC; WF_UREC]);; (* ------------------------------------------------------------------------- *) (* Defining a recursive function via an existence condition. *) (* ------------------------------------------------------------------------- *) let WF_REC_EXISTS = prove (`WF((<<):A->A->bool) ==> !P. (!f g x y. (!z. z << x ==> f z = g z) ==> (P f x y <=> P g x y)) /\ (!f x. (!z. z << x ==> P f z (f z)) ==> ?y. P f x y) ==> ?f:A->B. !x. P f x (f x)`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `?f:A->B. !x. f x = @y. P f x y` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP WF_REC) THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:A->B` THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th] THEN ASSUME_TAC(GSYM th)) THEN CONV_TAC(BINDER_CONV SELECT_CONV) THEN FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [WF_IND]) THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Some preservation theorems for wellfoundedness. *) (* ------------------------------------------------------------------------- *) parse_as_infix("<<<",(12,"right"));; let WF_SUBSET = prove (`(!(x:A) y. x << y ==> x <<< y) /\ WF(<<<) ==> WF(<<)`, DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[WF] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN UNDISCH_TAC `!(x:A) (y:A). x << y ==> x <<< y` THEN MESON_TAC[]);; let WF_MEASURE_GEN = prove (`!m:A->B. WF(<<) ==> WF(\x x'. m x << m x')`, GEN_TAC THEN REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\y:B. !x:A. (m(x) = y) ==> P x`) THEN UNDISCH_TAC `!x. (!y. (m:A->B) y << m x ==> P y) ==> P x` THEN REWRITE_TAC[] THEN MESON_TAC[]);; let WF_LEX_DEPENDENT = prove (`!R:A->A->bool S:A->B->B->bool. WF(R) /\ (!a. WF(S a)) ==> WF(\(r1,s1) (r2,s2). R r1 r2 \/ (r1 = r2) /\ S r1 s1 s2)`, REPEAT GEN_TAC THEN REWRITE_TAC[WF] THEN STRIP_TAC THEN X_GEN_TAC `P:A#B->bool` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEN_REWRITE_TAC I [FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC [`a0:A`; `b0:B`] THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\a:A. ?b:B. P(a,b)`) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL [`a0:A`; `b0:B`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_THEN(X_CHOOSE_TAC `b1:B`) THEN FIRST_X_ASSUM(MP_TAC o SPECL [`a:A`; `\b. (P:A#B->bool) (a,b)`]) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `b1:B`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:B` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN DISCH_TAC THEN EXISTS_TAC `(a:A,b:B)` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN ASM_MESON_TAC[]);; let WF_LEX = prove (`!R:A->A->bool S:B->B->bool. WF(R) /\ WF(S) ==> WF(\(r1,s1) (r2,s2). R r1 r2 \/ (r1 = r2) /\ S s1 s2)`, SIMP_TAC[WF_LEX_DEPENDENT; ETA_AX]);; let WF_POINTWISE = prove (`WF((<<) :A->A->bool) /\ WF((<<<) :B->B->bool) ==> WF(\(x1,y1) (x2,y2). x1 << x2 /\ y1 <<< y2)`, STRIP_TAC THEN MATCH_MP_TAC(GEN_ALL WF_SUBSET) THEN EXISTS_TAC `\(x1,y1) (x2,y2). x1 << x2 \/ (x1:A = x2) /\ (y1:B) <<< (y2:B)` THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC TAUT; MATCH_MP_TAC WF_LEX THEN ASM_REWRITE_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Wellfoundedness properties of natural numbers. *) (* ------------------------------------------------------------------------- *) let WF_num = prove (`WF(<)`, REWRITE_TAC[WF_IND; num_WF]);; let WF_REC_num = prove (`!H. (!f g n. (!m. m < n ==> (f m = g m)) ==> (H f n = H g n)) ==> ?f:num->A. !n. f n = H f n`, MATCH_ACCEPT_TAC(MATCH_MP WF_REC WF_num));; (* ------------------------------------------------------------------------- *) (* Natural number measures (useful in program verification). *) (* ------------------------------------------------------------------------- *) let MEASURE = new_definition `MEASURE m = \x y. m(x) < m(y)`;; let WF_MEASURE = prove (`!m:A->num. WF(MEASURE m)`, REPEAT GEN_TAC THEN REWRITE_TAC[MEASURE] THEN MATCH_MP_TAC WF_MEASURE_GEN THEN MATCH_ACCEPT_TAC WF_num);; let MEASURE_LE = prove (`(!y. MEASURE m y a ==> MEASURE m y b) <=> m(a) <= m(b)`, REWRITE_TAC[MEASURE] THEN MESON_TAC[NOT_LE; LTE_TRANS; LT_REFL]);; (* ------------------------------------------------------------------------- *) (* Trivially, a WF relation is irreflexive and antisymmetric. *) (* ------------------------------------------------------------------------- *) let WF_ANTISYM = prove (`!(<<) x y:A. WF(<<) ==> ~(x << y /\ y << x)`, REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [WF]) THEN DISCH_THEN(MP_TAC o SPEC `\z:A. z = x \/ z = y`) THEN ASM_MESON_TAC[]);; let WF_REFL = prove (`!x:A. WF(<<) ==> ~(x << x)`, MESON_TAC[WF_ANTISYM]);; (* ------------------------------------------------------------------------- *) (* Even more trivially, the everywhere-false relation is wellfounded. *) (* ------------------------------------------------------------------------- *) let WF_FALSE = prove (`WF(\x y:A. F)`, REWRITE_TAC[WF]);; (* ------------------------------------------------------------------------- *) (* Tail recursion. *) (* ------------------------------------------------------------------------- *) let WF_REC_TAIL = prove (`!P g h. ?f:A->B. !x. f x = if P(x) then f(g x) else h x`, let lemma1 = prove (`~(P 0) ==> ((?n. P(SUC n)) <=> (?n. P(n)))`, MESON_TAC[num_CASES; NOT_SUC]) and lemma2 = prove (`(P 0) ==> ((!m. m < n ==> P(SUC m)) <=> (!m. m < SUC n ==> P(m)))`, REPEAT(DISCH_TAC ORELSE EQ_TAC) THEN INDUCT_TAC THEN ASM_MESON_TAC[LT_SUC; LT_0]) in REPEAT GEN_TAC THEN MP_TAC(GEN `x:A` (ISPECL [`x:A`; `\y:A n:num. g(y):A`] num_RECURSION)) THEN REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN(X_CHOOSE_THEN `s:A->num->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `\x:A. if ?n:num. ~P(s x n) then (h:A->B)(@y. ?n. (y = s x n) /\ ~P(s x n) /\ !m. m < n ==> P(s x m)) else something_arbitrary:B` THEN X_GEN_TAC `x:A` THEN SUBGOAL_THEN `!n x:A. s (g x) n :A = s x (SUC n)` ASSUME_TAC THENL [INDUCT_TAC THEN ASM_REWRITE_TAC[]; UNDISCH_THEN `!x:A n. s x (SUC n) :A = g (s x n)` (K ALL_TAC)] THEN ASM_CASES_TAC `(P:A->bool) x` THEN ASM_REWRITE_TAC[] THENL [ASM_SIMP_TAC[lemma1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[lemma2; lemma1]; COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN AP_TERM_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN X_GEN_TAC `y:A` THEN EQ_TAC THENL [SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LT_0]; ASM_MESON_TAC[LT]]]);; (* ------------------------------------------------------------------------- *) (* A more general mix of tail and wellfounded recursion. *) (* ------------------------------------------------------------------------- *) let WF_REC_TAIL_GENERAL = prove (`!P G H. WF(<<) /\ (!f g x. (!z. z << x ==> (f z = g z)) ==> (P f x <=> P g x) /\ G f x = G g x /\ H f x = H g x) /\ (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) /\ (!f x y. P f x /\ y << G f x ==> y << x) ==> ?f:A->B. !x. f x = if P f x then f(G f x) else H f x`, REPEAT STRIP_TAC THEN CHOOSE_THEN MP_TAC (prove_inductive_relations_exist `(!x:A. ~(P f x) ==> terminates f x) /\ (!x. P (f:A->B) x /\ terminates f (G f x) ==> terminates f x)`) THEN REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `?while. !f:A->B x:A. while f x = if P f x then while f (G f x) else x` (STRIP_ASSUME_TAC o GSYM) THENL [REWRITE_TAC[GSYM SKOLEM_THM; WF_REC_TAIL]; ALL_TAC] THEN SUBGOAL_THEN `?f:A->B. !x. f x = if terminates f x then H f (while f x :A) else anything` MP_TAC THENL [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP WF_REC) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] `(a = b) /\ (a /\ b ==> (x = y) /\ (f x = g x)) ==> ((if a then f x else d) = (if b then g y else d))`) THEN REPEAT STRIP_TAC THENL [SUBGOAL_THEN `!f g x. (!x y. P f x /\ y << G (f:A->B) x ==> y << x) /\ (!y:A. (!z:A. z << y ==> z << x) ==> (P f y = P g y) /\ (G f y = G g y)) ==> terminates f x ==> terminates g x` (fun th -> EQ_TAC THEN MATCH_MP_TAC th THEN ASM_MESON_TAC[]) THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN DISCH_TAC THEN ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; SUBGOAL_THEN `!x:A. terminates (f:A->B) x /\ (!y:A. (!z:A. z << y ==> z << x) ==> (P f y <=> P g y) /\ (G f y :A = G g y)) ==> (while f x :A = while g x)` (fun th -> MATCH_MP_TAC th THEN ASM_MESON_TAC[]) THEN REWRITE_TAC[IMP_CONJ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN SUBGOAL_THEN `!f:A->B. (!x:A y:A. P f x /\ y << G f x ==> y << x) ==> !x. terminates f x ==> !y. y << while f x ==> y << x` (fun th -> ASM_MESON_TAC[th]) THEN GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]; MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC(GSYM th) THEN MP_TAC th) THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:A` THEN ASM_CASES_TAC `P (f:A->B) (x:A) :bool` THEN ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Tactic to apply WF induction on a free "measured" term in the goal. *) (* ------------------------------------------------------------------------- *) let WF_INDUCT_TAC = let qqconv = let pth = prove (`(!x. P x ==> !y. Q x y) <=> !y x. P x ==> Q x y`, MESON_TAC[]) in GEN_REWRITE_CONV I [pth] and eqconv = let pth = prove (`(!m. P m ==> (m = e) ==> Q) <=> (P e ==> Q)`, MESON_TAC[]) in REWR_CONV pth in let rec qqconvs tm = try (qqconv THENC BINDER_CONV qqconvs) tm with Failure _ -> eqconv tm in fun tm (asl,w as gl) -> let fvs = frees tm and gv = genvar(type_of tm) in let pat = list_mk_forall(gv::fvs,mk_imp(mk_eq(gv,tm),w)) in let th0 = UNDISCH(PART_MATCH rand num_WF pat) in let th1 = MP (SPECL (tm::fvs) th0) (REFL tm) in let th2 = CONV_RULE(LAND_CONV qqconvs) (DISCH_ALL th1) in (MATCH_MP_TAC th2 THEN MAP_EVERY X_GEN_TAC fvs THEN CONV_TAC(LAND_CONV qqconvs) THEN DISCH_THEN ASSUME_TAC) gl;;